From d6b1195ce8ec9090113ae31a1dcece4bac145872 Mon Sep 17 00:00:00 2001 From: Cezary Kaliszyk Date: Tue, 26 Aug 2014 15:04:35 +0200 Subject: [PATCH] Update from HH --- 100/arithmetic.ml | 13 + 100/arithmetic_geometric_mean.ml | 95 + 100/ballot.ml | 347 + 100/bernoulli.ml | 274 + 100/bertrand.ml | 2843 + 100/birthday.ml | 232 + 100/cantor.ml | 97 + 100/cayley_hamilton.ml | 446 + 100/ceva.ml | 215 + 100/chords.ml | 65 + 100/circle.ml | 142 + 100/combinations.ml | 116 + 100/constructible.ml | 898 + 100/cosine.ml | 210 + 100/cubic.ml | 98 + 100/derangements.ml | 597 + 100/desargues.ml | 399 + 100/descartes.ml | 834 + 100/dirichlet.ml | 2082 + 100/div3.ml | 27 + 100/divharmonic.ml | 78 + 100/e_is_transcendental.ml | 2896 + 100/euler.ml | 387 + 100/feuerbach.ml | 213 + 100/four_squares.ml | 948 + 100/fourier.ml | 5892 ++ 100/friendship.ml | 753 + 100/fta.ml | 178 + 100/gcd.ml | 41 + 100/heron.ml | 42 + 100/inclusion_exclusion.ml | 418 + 100/independence.ml | 785 + 100/isosceles.ml | 237 + 100/konigsberg.ml | 236 + 100/lagrange.ml | 254 + 100/leibniz.ml | 302 + 100/lhopital.ml | 200 + 100/liouville.ml | 429 + 100/minkowski.ml | 285 + 100/morley.ml | 466 + 100/pascal.ml | 625 + 100/perfect.ml | 283 + 100/pick.ml | 3709 ++ 100/piseries.ml | 3311 ++ 100/platonic.ml | 2179 + 100/pnt.ml | 4316 ++ 100/polyhedron.ml | 2206 + 100/primerecip.ml | 211 + 100/ptolemy.ml | 69 + 100/pythagoras.ml | 30 + 100/quartic.ml | 202 + 100/ramsey.ml | 1278 + 100/ratcountable.ml | 68 + 100/realsuncountable.ml | 256 + 100/reciprocity.ml | 753 + 100/sqrt.ml | 42 + 100/stirling.ml | 597 + 100/subsequence.ml | 131 + 100/thales.ml | 87 + 100/triangular.ml | 70 + 100/two_squares.ml | 263 + 100/wilson.ml | 200 + Arithmetic/arithprov.ml | 570 + Arithmetic/definability.ml | 644 + Arithmetic/derived.ml | 980 + Arithmetic/fol.ml | 570 + Arithmetic/godel.ml | 531 + Arithmetic/make.ml | 30 + Arithmetic/pa.ml | 73 + Arithmetic/sigmacomplete.ml | 681 + Arithmetic/tarski.ml | 344 + Boyer_Moore/boyer-moore.ml | 22 + Boyer_Moore/clausal_form.ml | 350 + Boyer_Moore/counterexample.ml | 202 + Boyer_Moore/definitions.ml | 141 + Boyer_Moore/environment.ml | 260 + Boyer_Moore/equalities.ml | 179 + Boyer_Moore/generalize.ml | 566 + Boyer_Moore/induction.ml | 153 + Boyer_Moore/irrelevance.ml | 243 + Boyer_Moore/main.ml | 202 + Boyer_Moore/make.ml | 196 + Boyer_Moore/rewrite_rules.ml | 347 + Boyer_Moore/shells.ml | 333 + Boyer_Moore/struct_equal.ml | 354 + Boyer_Moore/support.ml | 215 + Boyer_Moore/terms_and_clauses.ml | 766 + Boyer_Moore/testset/arith.ml | 121 + Boyer_Moore/testset/list.ml | 50 + Boyer_Moore/waterfall.ml | 660 + Complex/complex_grobner.ml | 501 + Complex/complex_real.ml | 9 + Complex/complex_transc.ml | 321 + Complex/complexnumbers.ml | 912 + Complex/cpoly.ml | 977 + Complex/fundamental.ml | 683 + Complex/grobner_examples.ml | 589 + Complex/make.ml | 15 + Complex/quelim.ml | 923 + Complex/quelim_examples.ml | 185 + Examples/borsuk.ml | 185 + Examples/brunn_minkowski.ml | 1384 + Examples/combin.ml | 163 + Examples/cong.ml | 164 + Examples/cooper.ml | 1576 + Examples/dickson.ml | 85 + Examples/dlo.ml | 455 + Examples/forster.ml | 90 + Examples/gcdrecurrence.ml | 230 + Examples/harmonicsum.ml | 123 + Examples/hol88.ml | 1061 + Examples/holby.ml | 876 + Examples/inverse_bug_puzzle_miz3.ml | 489 + Examples/inverse_bug_puzzle_tac.ml | 461 + Examples/kb.ml | 295 + Examples/lagrange_lemma.ml | 99 + Examples/lucas_lehmer.ml | 412 + Examples/machin.ml | 850 + Examples/mangoldt.ml | 671 + Examples/mccarthy.ml | 193 + Examples/mizar.ml | 682 + Examples/multiwf.ml | 307 + Examples/pell.ml | 2295 + Examples/polylog.ml | 677 + Examples/prog.ml | 771 + Examples/prover9.ml | 568 + Examples/rectypes.ml | 475 + Examples/reduct.ml | 453 + Examples/schnirelmann.ml | 544 + Examples/solovay.ml | 416 + Examples/sos.ml | 1896 + Examples/ste.ml | 208 + Examples/sylvester_gallai.ml | 261 + Examples/update_database.ml | 181 + Examples/vitali.ml | 97 + IsabelleLight/isalight.ml | 19 + IsabelleLight/make.ml | 25 + IsabelleLight/meta_rules.ml | 1081 + IsabelleLight/new_tactics.ml | 353 + IsabelleLight/support.ml | 257 + Jordan/float.ml | 1825 + Jordan/jordan_curve_theorem.ml |59310 ++++++++++++++++++++ Jordan/lib_ext.ml | 99 + Jordan/make.ml | 31 + Jordan/metric_spaces.ml | 9170 +++ Jordan/misc_defs_and_lemmas.ml | 2285 + Jordan/num_ext_gcd.ml | 249 + Jordan/num_ext_nabs.ml | 96 + Jordan/parse_ext_override_interface.ml | 204 + Jordan/real_ext.ml | 218 + Jordan/real_ext_geom_series.ml | 49 + Jordan/tactics_ext.ml | 203 + Jordan/tactics_ext2.ml | 1486 + Jordan/tactics_fix.ml | 133 + Jordan/tactics_refine.ml | 106 + LP_arith/lp_arith.ml | 128 + LP_arith/lp_tests.ml | 65 + LP_arith/make.ml | 8 + Library/agm.ml | 131 + Library/analysis.ml | 6735 +++ Library/binary.ml | 184 + Library/binomial.ml | 323 + Library/calc_real.ml | 2293 + Library/card.ml | 1803 + Library/floor.ml | 643 + Library/integer.ml | 1014 + Library/isum.ml | 231 + Library/iter.ml | 153 + Library/multiplicative.ml | 415 + Library/permutations.ml | 831 + Library/pocklington.ml | 1721 + Library/poly.ml | 1690 + Library/pratt.ml | 1013 + Library/prime.ml | 2044 + Library/primitive.ml | 765 + Library/products.ml | 446 + Library/rstc.ml | 700 + Library/transc.ml | 6541 +++ Library/wo.ml | 834 + Minisat/dimacs_tools.ml | 309 + Minisat/make.ml | 9 + Minisat/minisat_parse.ml | 212 + Minisat/minisat_prove.ml | 261 + Minisat/minisat_resolve.ml | 129 + Minisat/sat_common_tools.ml | 119 + Minisat/sat_script.ml | 33 + Minisat/sat_solvers.ml | 79 + Minisat/sat_tools.ml | 177 + Minisat/taut.ml | 7792 +++ Mizarlight/duality.ml | 240 + Mizarlight/duality_holby.ml | 270 + Mizarlight/make.ml | 52 + Mizarlight/miz2a.ml | 245 + Mizarlight/pa_f.ml | 25 + Model/make.ml | 23 + Model/modelset.ml | 788 + Model/semantics.ml | 1116 + Model/syntax.ml | 648 + Multivariate/canal.ml | 3760 ++ Multivariate/cauchy.ml |18231 ++++++ Multivariate/clifford.ml | 979 + Multivariate/complex_database.ml |12130 ++++ Multivariate/complexes.ml | 2036 + Multivariate/convex.ml |11827 ++++ Multivariate/cross.ml | 279 + Multivariate/derivatives.ml | 2732 + Multivariate/determinants.ml | 3141 ++ Multivariate/dimension.ml | 6794 +++ Multivariate/flyspeck.ml | 7091 +++ Multivariate/gamma.ml | 3760 ++ Multivariate/geom.ml | 933 + Multivariate/integration.ml |17665 ++++++ Multivariate/make.ml | 36 + Multivariate/make_complex.ml | 49 + Multivariate/measure.ml |13308 +++++ Multivariate/misc.ml | 562 + Multivariate/moretop.ml | 7349 +++ Multivariate/multivariate_database.ml | 8892 +++ Multivariate/paths.ml |17066 ++++++ Multivariate/polytope.ml | 5855 ++ Multivariate/realanalysis.ml |15845 ++++++ Multivariate/tarski.ml | 261 + Multivariate/topology.ml |20293 +++++++ Multivariate/transcendentals.ml | 6981 +++ Multivariate/vectors.ml | 8658 +++ Multivariate/wlog.ml | 389 + Multivariate/wlog_examples.ml | 744 + Ntrie/ntrie.ml | 370 + Ntrie/ntrie_tests.ml | 181 + Permutation/make.ml | 14 + Permutation/morelist.ml | 250 + Permutation/nummax.ml | 90 + Permutation/permutation.ml | 105 + Permutation/permuted.ml | 152 + Permutation/qsort.ml | 103 + Proofrecording/diffs/basics.ml | 425 + Proofrecording/diffs/bool.ml | 451 + Proofrecording/diffs/depgraph.ml | 115 + Proofrecording/diffs/equal.ml | 309 + Proofrecording/diffs/hol.ml | 163 + Proofrecording/diffs/proofobjects_coq.ml | 1894 + Proofrecording/diffs/proofobjects_dummy.ml | 101 + Proofrecording/diffs/proofobjects_init.ml | 21 + Proofrecording/diffs/proofobjects_trt.ml | 888 + Proofrecording/diffs/tactics.ml | 869 + Proofrecording/diffs/thm.ml | 347 + Proofrecording/tools/init.ml | 11 + Proofrecording/tools/startcore.ml | 8 + QBF/make.ml | 10 + QBF/mygraph.ml | 18 + QBF/qbf.ml | 1005 + QBF/qbfr.ml | 106 + RichterHilbertAxiomGeometry/HilbertAxiom_read.ml | 3373 ++ RichterHilbertAxiomGeometry/Topology.ml | 3538 ++ .../UniversalPropCartProd.ml | 271 + RichterHilbertAxiomGeometry/error-checking.ml | 358 + RichterHilbertAxiomGeometry/from_topology.ml |18336 ++++++ .../inverse_bug_puzzle_read.ml | 503 + .../miz3/FontHilbertAxiom.ml | 3421 ++ RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml | 3421 ++ RichterHilbertAxiomGeometry/miz3/make.ml | 3 + RichterHilbertAxiomGeometry/readable.ml | 756 + RichterHilbertAxiomGeometry/thmFontHilbertAxiom.ml | 986 + Rqe/asym.ml | 3227 ++ Rqe/basic.ml | 36 + Rqe/condense.ml | 667 + Rqe/condense_thms.ml | 51 + Rqe/dedmatrix.ml | 238 + Rqe/dedmatrix_thms.ml | 158 + Rqe/defs.ml | 314 + Rqe/examples.ml | 1429 + Rqe/inferisign.ml | 241 + Rqe/inferisign_thms.ml | 1033 + Rqe/inferpsign.ml | 361 + Rqe/inferpsign_thms.ml | 377 + Rqe/lift_qelim.ml | 129 + Rqe/list_rewrites.ml | 36 + Rqe/main_thms.ml | 247 + Rqe/make.ml | 51 + Rqe/matinsert.ml | 125 + Rqe/matinsert_thms.ml | 6 + Rqe/num_calc_simp.ml | 50 + Rqe/pdivides.ml | 90 + Rqe/pdivides_thms.ml | 50 + Rqe/poly_ext.ml | 772 + Rqe/rewrites.ml | 90 + Rqe/rol.ml | 606 + Rqe/rqe_lib.ml | 143 + Rqe/rqe_list.ml | 313 + Rqe/rqe_main.ml | 671 + Rqe/rqe_num.ml | 34 + Rqe/rqe_real.ml | 475 + Rqe/rqe_tactics_ext.ml | 266 + Rqe/signs.ml | 352 + Rqe/signs_thms.ml | 136 + Rqe/simplify.ml | 189 + Rqe/testform.ml | 218 + Rqe/testform_thms.ml | 196 + Rqe/timers.ml | 120 + Rqe/util.ml | 96 + Rqe/work_thms.ml | 8279 +++ Tutorial/Abstractions_and_quantifiers.ml | 28 + Tutorial/Changing_proof_style.ml | 54 + Tutorial/Custom_inference_rules.ml | 176 + Tutorial/Custom_tactics.ml | 124 + Tutorial/Defining_new_types.ml | 124 + Tutorial/Embedding_of_logics_deep.ml | 116 + Tutorial/Embedding_of_logics_shallow.ml | 24 + .../HOL_as_a_functional_programming_language.ml | 178 + Tutorial/HOL_basics.ml | 5 + Tutorial/HOLs_number_systems.ml | 126 + Tutorial/Inductive_datatypes.ml | 76 + Tutorial/Inductive_definitions.ml | 90 + Tutorial/Linking_external_tools.ml | 154 + Tutorial/Number_theory.ml | 105 + Tutorial/Propositional_logic.ml | 35 + Tutorial/Real_analysis.ml | 86 + Tutorial/Recursive_definitions.ml | 65 + .../Semantics_of_programming_languages_deep.ml | 97 + .../Semantics_of_programming_languages_shallow.ml | 240 + Tutorial/Sets_and_functions.ml | 50 + Tutorial/Tactics_and_tacticals.ml | 53 + Tutorial/Vectors.ml | 117 + Tutorial/Wellfounded_induction.ml | 11 + Tutorial/all.ml | 2237 + Unity/aux_definitions.ml | 70 + Unity/make.ml | 22 + Unity/mk_comp_unity.ml | 551 + Unity/mk_ensures.ml | 710 + Unity/mk_gen_induct.ml | 30 + Unity/mk_leadsto.ml | 4464 ++ Unity/mk_state_logic.ml | 1036 + Unity/mk_unity_prog.ml | 993 + Unity/mk_unless.ml | 1060 + arith.ml | 1560 + basics.ml | 427 + bool.ml | 483 + calc_int.ml | 391 + calc_num.ml | 1491 + calc_rat.ml | 566 + canon.ml | 733 + cart.ml | 499 + class.ml | 483 + database.ml | 2289 + define.ml | 989 + drule.ml | 488 + equal.ml | 334 + grobner.ml | 698 + help.ml | 138 + hol.ml | 170 + impconv.ml | 1857 + ind_defs.ml | 463 + ind_types.ml | 1555 + int.ml | 1446 + itab.ml | 73 + iterate.ml | 2387 + lib.ml | 843 + lists.ml | 551 + make.ml | 54 + meson.ml | 831 + miz3/Samples/bug0.ml | 72 + miz3/Samples/bug1.ml | 52 + miz3/Samples/bug2.ml | 5 + miz3/Samples/bug3.ml | 3 + miz3/Samples/drinker.ml | 36 + miz3/Samples/forster.ml | 389 + miz3/Samples/icms.ml | 157 + miz3/Samples/irrat2.ml | 144 + miz3/Samples/lagrange.ml | 353 + miz3/Samples/lagrange1.ml | 466 + miz3/Samples/luxury.ml | 183 + miz3/Samples/other_mizs.ml | 424 + miz3/Samples/robbins.ml | 196 + miz3/Samples/sample.ml | 19 + miz3/Samples/samples.ml | 52 + miz3/Samples/talk.ml | 91 + miz3/Samples/tobias.ml | 65 + miz3/Samples/wishes.ml | 16 + miz3/make.ml | 2 + miz3/miz3.ml | 1890 + miz3/miz3_of_hol.ml | 237 + miz3/test.ml | 13 + nets.ml | 120 + normalizer.ml | 565 + nums.ml | 295 + pa_j.ml | 2027 + pa_j_3.07.ml | 2409 + pa_j_3.08.ml | 2186 + pa_j_3.09.ml | 2212 + pa_j_3.1x_5.xx.ml | 2027 + pa_j_3.1x_6.02.1.ml | 2863 + pa_j_3.1x_6.02.2.ml | 2845 + pa_j_3.1x_6.11.ml | 2976 + pa_j_3.1x_6.xx.ml | 2857 + pair.ml | 429 + parser.ml | 518 + preterm.ml | 450 + printer.ml | 544 + quot.ml | 162 + real.ml | 1482 + realarith.ml | 637 + realax.ml | 1971 + recursion.ml | 115 + sets.ml | 3183 ++ simp.ml | 561 + system.ml | 50 + tactics.ml | 925 + term.ml | 276 + theorems.ml | 477 + thm.ml | 243 + trivia.ml | 91 + type.ml | 143 + update_database.ml | 275 + wf.ml | 372 + 414 files changed, 539731 insertions(+), 0 deletions(-) create mode 100644 100/arithmetic.ml create mode 100644 100/arithmetic_geometric_mean.ml create mode 100644 100/ballot.ml create mode 100644 100/bernoulli.ml create mode 100644 100/bertrand.ml create mode 100644 100/birthday.ml create mode 100644 100/cantor.ml create mode 100644 100/cayley_hamilton.ml create mode 100644 100/ceva.ml create mode 100644 100/chords.ml create mode 100644 100/circle.ml create mode 100644 100/combinations.ml create mode 100644 100/constructible.ml create mode 100644 100/cosine.ml create mode 100644 100/cubic.ml create mode 100644 100/derangements.ml create mode 100644 100/desargues.ml create mode 100644 100/descartes.ml create mode 100644 100/dirichlet.ml create mode 100644 100/div3.ml create mode 100644 100/divharmonic.ml create mode 100644 100/e_is_transcendental.ml create mode 100644 100/euler.ml create mode 100644 100/feuerbach.ml create mode 100644 100/four_squares.ml create mode 100644 100/fourier.ml create mode 100644 100/friendship.ml create mode 100644 100/fta.ml create mode 100644 100/gcd.ml create mode 100644 100/heron.ml create mode 100644 100/inclusion_exclusion.ml create mode 100644 100/independence.ml create mode 100644 100/isosceles.ml create mode 100644 100/konigsberg.ml create mode 100644 100/lagrange.ml create mode 100644 100/leibniz.ml create mode 100644 100/lhopital.ml create mode 100644 100/liouville.ml create mode 100644 100/minkowski.ml create mode 100644 100/morley.ml create mode 100644 100/pascal.ml create mode 100644 100/perfect.ml create mode 100644 100/pick.ml create mode 100644 100/piseries.ml create mode 100644 100/platonic.ml create mode 100644 100/pnt.ml create mode 100644 100/polyhedron.ml create mode 100644 100/primerecip.ml create mode 100644 100/ptolemy.ml create mode 100644 100/pythagoras.ml create mode 100644 100/quartic.ml create mode 100644 100/ramsey.ml create mode 100644 100/ratcountable.ml create mode 100644 100/realsuncountable.ml create mode 100644 100/reciprocity.ml create mode 100644 100/sqrt.ml create mode 100644 100/stirling.ml create mode 100644 100/subsequence.ml create mode 100644 100/thales.ml create mode 100644 100/triangular.ml create mode 100644 100/two_squares.ml create mode 100644 100/wilson.ml create mode 100644 Arithmetic/arithprov.ml create mode 100644 Arithmetic/definability.ml create mode 100644 Arithmetic/derived.ml create mode 100644 Arithmetic/fol.ml create mode 100644 Arithmetic/godel.ml create mode 100644 Arithmetic/make.ml create mode 100644 Arithmetic/pa.ml create mode 100644 Arithmetic/sigmacomplete.ml create mode 100644 Arithmetic/tarski.ml create mode 100644 Boyer_Moore/boyer-moore.ml create mode 100644 Boyer_Moore/clausal_form.ml create mode 100644 Boyer_Moore/counterexample.ml create mode 100644 Boyer_Moore/definitions.ml create mode 100644 Boyer_Moore/environment.ml create mode 100644 Boyer_Moore/equalities.ml create mode 100644 Boyer_Moore/generalize.ml create mode 100644 Boyer_Moore/induction.ml create mode 100644 Boyer_Moore/irrelevance.ml create mode 100644 Boyer_Moore/main.ml create mode 100644 Boyer_Moore/make.ml create mode 100644 Boyer_Moore/rewrite_rules.ml create mode 100644 Boyer_Moore/shells.ml create mode 100644 Boyer_Moore/struct_equal.ml create mode 100644 Boyer_Moore/support.ml create mode 100644 Boyer_Moore/terms_and_clauses.ml create mode 100644 Boyer_Moore/testset/arith.ml create mode 100644 Boyer_Moore/testset/list.ml create mode 100644 Boyer_Moore/waterfall.ml create mode 100644 Complex/complex_grobner.ml create mode 100644 Complex/complex_real.ml create mode 100644 Complex/complex_transc.ml create mode 100644 Complex/complexnumbers.ml create mode 100644 Complex/cpoly.ml create mode 100644 Complex/fundamental.ml create mode 100644 Complex/grobner_examples.ml create mode 100644 Complex/make.ml create mode 100644 Complex/quelim.ml create mode 100644 Complex/quelim_examples.ml create mode 100644 Examples/borsuk.ml create mode 100644 Examples/brunn_minkowski.ml create mode 100644 Examples/combin.ml create mode 100644 Examples/cong.ml create mode 100644 Examples/cooper.ml create mode 100644 Examples/dickson.ml create mode 100644 Examples/dlo.ml create mode 100644 Examples/forster.ml create mode 100644 Examples/gcdrecurrence.ml create mode 100644 Examples/harmonicsum.ml create mode 100644 Examples/hol88.ml create mode 100644 Examples/holby.ml create mode 100644 Examples/inverse_bug_puzzle_miz3.ml create mode 100644 Examples/inverse_bug_puzzle_tac.ml create mode 100644 Examples/kb.ml create mode 100644 Examples/lagrange_lemma.ml create mode 100644 Examples/lucas_lehmer.ml create mode 100644 Examples/machin.ml create mode 100644 Examples/mangoldt.ml create mode 100644 Examples/mccarthy.ml create mode 100644 Examples/mizar.ml create mode 100644 Examples/multiwf.ml create mode 100644 Examples/pell.ml create mode 100644 Examples/polylog.ml create mode 100644 Examples/prog.ml create mode 100644 Examples/prover9.ml create mode 100644 Examples/rectypes.ml create mode 100644 Examples/reduct.ml create mode 100644 Examples/schnirelmann.ml create mode 100644 Examples/solovay.ml create mode 100644 Examples/sos.ml create mode 100644 Examples/ste.ml create mode 100644 Examples/sylvester_gallai.ml create mode 100644 Examples/update_database.ml create mode 100644 Examples/vitali.ml create mode 100644 IsabelleLight/isalight.ml create mode 100644 IsabelleLight/make.ml create mode 100644 IsabelleLight/meta_rules.ml create mode 100644 IsabelleLight/new_tactics.ml create mode 100644 IsabelleLight/support.ml create mode 100644 Jordan/float.ml create mode 100644 Jordan/jordan_curve_theorem.ml create mode 100644 Jordan/lib_ext.ml create mode 100644 Jordan/make.ml create mode 100644 Jordan/metric_spaces.ml create mode 100644 Jordan/misc_defs_and_lemmas.ml create mode 100644 Jordan/num_ext_gcd.ml create mode 100644 Jordan/num_ext_nabs.ml create mode 100644 Jordan/parse_ext_override_interface.ml create mode 100644 Jordan/real_ext.ml create mode 100644 Jordan/real_ext_geom_series.ml create mode 100644 Jordan/tactics_ext.ml create mode 100644 Jordan/tactics_ext2.ml create mode 100644 Jordan/tactics_fix.ml create mode 100644 Jordan/tactics_refine.ml create mode 100644 LP_arith/lp_arith.ml create mode 100644 LP_arith/lp_tests.ml create mode 100644 LP_arith/make.ml create mode 100644 Library/agm.ml create mode 100644 Library/analysis.ml create mode 100644 Library/binary.ml create mode 100644 Library/binomial.ml create mode 100644 Library/calc_real.ml create mode 100644 Library/card.ml create mode 100644 Library/floor.ml create mode 100644 Library/integer.ml create mode 100644 Library/isum.ml create mode 100644 Library/iter.ml create mode 100644 Library/multiplicative.ml create mode 100644 Library/permutations.ml create mode 100644 Library/pocklington.ml create mode 100644 Library/poly.ml create mode 100644 Library/pratt.ml create mode 100644 Library/prime.ml create mode 100644 Library/primitive.ml create mode 100644 Library/products.ml create mode 100644 Library/rstc.ml create mode 100644 Library/transc.ml create mode 100644 Library/wo.ml create mode 100644 Minisat/dimacs_tools.ml create mode 100644 Minisat/make.ml create mode 100644 Minisat/minisat_parse.ml create mode 100644 Minisat/minisat_prove.ml create mode 100644 Minisat/minisat_resolve.ml create mode 100644 Minisat/sat_common_tools.ml create mode 100644 Minisat/sat_script.ml create mode 100644 Minisat/sat_solvers.ml create mode 100644 Minisat/sat_tools.ml create mode 100644 Minisat/taut.ml create mode 100644 Mizarlight/duality.ml create mode 100644 Mizarlight/duality_holby.ml create mode 100644 Mizarlight/make.ml create mode 100644 Mizarlight/miz2a.ml create mode 100644 Mizarlight/pa_f.ml create mode 100644 Model/make.ml create mode 100644 Model/modelset.ml create mode 100644 Model/semantics.ml create mode 100644 Model/syntax.ml create mode 100644 Multivariate/canal.ml create mode 100644 Multivariate/cauchy.ml create mode 100644 Multivariate/clifford.ml create mode 100644 Multivariate/complex_database.ml create mode 100644 Multivariate/complexes.ml create mode 100644 Multivariate/convex.ml create mode 100644 Multivariate/cross.ml create mode 100644 Multivariate/derivatives.ml create mode 100644 Multivariate/determinants.ml create mode 100644 Multivariate/dimension.ml create mode 100644 Multivariate/flyspeck.ml create mode 100644 Multivariate/gamma.ml create mode 100644 Multivariate/geom.ml create mode 100644 Multivariate/integration.ml create mode 100644 Multivariate/make.ml create mode 100644 Multivariate/make_complex.ml create mode 100644 Multivariate/measure.ml create mode 100644 Multivariate/misc.ml create mode 100644 Multivariate/moretop.ml create mode 100644 Multivariate/multivariate_database.ml create mode 100644 Multivariate/paths.ml create mode 100644 Multivariate/polytope.ml create mode 100644 Multivariate/realanalysis.ml create mode 100644 Multivariate/tarski.ml create mode 100644 Multivariate/topology.ml create mode 100644 Multivariate/transcendentals.ml create mode 100644 Multivariate/vectors.ml create mode 100644 Multivariate/wlog.ml create mode 100644 Multivariate/wlog_examples.ml create mode 100644 Ntrie/ntrie.ml create mode 100644 Ntrie/ntrie_tests.ml create mode 100644 Permutation/make.ml create mode 100644 Permutation/morelist.ml create mode 100644 Permutation/nummax.ml create mode 100644 Permutation/permutation.ml create mode 100644 Permutation/permuted.ml create mode 100644 Permutation/qsort.ml create mode 100644 Proofrecording/diffs/basics.ml create mode 100644 Proofrecording/diffs/bool.ml create mode 100644 Proofrecording/diffs/depgraph.ml create mode 100644 Proofrecording/diffs/equal.ml create mode 100644 Proofrecording/diffs/hol.ml create mode 100644 Proofrecording/diffs/proofobjects_coq.ml create mode 100644 Proofrecording/diffs/proofobjects_dummy.ml create mode 100644 Proofrecording/diffs/proofobjects_init.ml create mode 100644 Proofrecording/diffs/proofobjects_trt.ml create mode 100644 Proofrecording/diffs/tactics.ml create mode 100644 Proofrecording/diffs/thm.ml create mode 100644 Proofrecording/tools/init.ml create mode 100644 Proofrecording/tools/startcore.ml create mode 100644 QBF/make.ml create mode 100644 QBF/mygraph.ml create mode 100644 QBF/qbf.ml create mode 100644 QBF/qbfr.ml create mode 100644 RichterHilbertAxiomGeometry/HilbertAxiom_read.ml create mode 100644 RichterHilbertAxiomGeometry/Topology.ml create mode 100644 RichterHilbertAxiomGeometry/UniversalPropCartProd.ml create mode 100644 RichterHilbertAxiomGeometry/error-checking.ml create mode 100644 RichterHilbertAxiomGeometry/from_topology.ml create mode 100644 RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml create mode 100644 RichterHilbertAxiomGeometry/miz3/FontHilbertAxiom.ml create mode 100644 RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml create mode 100644 RichterHilbertAxiomGeometry/miz3/make.ml create mode 100644 RichterHilbertAxiomGeometry/readable.ml create mode 100644 RichterHilbertAxiomGeometry/thmFontHilbertAxiom.ml create mode 100644 Rqe/asym.ml create mode 100644 Rqe/basic.ml create mode 100644 Rqe/condense.ml create mode 100644 Rqe/condense_thms.ml create mode 100644 Rqe/dedmatrix.ml create mode 100644 Rqe/dedmatrix_thms.ml create mode 100644 Rqe/defs.ml create mode 100644 Rqe/examples.ml create mode 100644 Rqe/inferisign.ml create mode 100644 Rqe/inferisign_thms.ml create mode 100644 Rqe/inferpsign.ml create mode 100644 Rqe/inferpsign_thms.ml create mode 100644 Rqe/lift_qelim.ml create mode 100644 Rqe/list_rewrites.ml create mode 100644 Rqe/main_thms.ml create mode 100644 Rqe/make.ml create mode 100644 Rqe/matinsert.ml create mode 100644 Rqe/matinsert_thms.ml create mode 100644 Rqe/num_calc_simp.ml create mode 100644 Rqe/pdivides.ml create mode 100644 Rqe/pdivides_thms.ml create mode 100644 Rqe/poly_ext.ml create mode 100644 Rqe/rewrites.ml create mode 100644 Rqe/rol.ml create mode 100644 Rqe/rqe_lib.ml create mode 100644 Rqe/rqe_list.ml create mode 100644 Rqe/rqe_main.ml create mode 100644 Rqe/rqe_num.ml create mode 100644 Rqe/rqe_real.ml create mode 100644 Rqe/rqe_tactics_ext.ml create mode 100644 Rqe/signs.ml create mode 100644 Rqe/signs_thms.ml create mode 100644 Rqe/simplify.ml create mode 100644 Rqe/testform.ml create mode 100644 Rqe/testform_thms.ml create mode 100644 Rqe/timers.ml create mode 100644 Rqe/util.ml create mode 100644 Rqe/work_thms.ml create mode 100644 Tutorial/Abstractions_and_quantifiers.ml create mode 100644 Tutorial/Changing_proof_style.ml create mode 100644 Tutorial/Custom_inference_rules.ml create mode 100644 Tutorial/Custom_tactics.ml create mode 100644 Tutorial/Defining_new_types.ml create mode 100644 Tutorial/Embedding_of_logics_deep.ml create mode 100644 Tutorial/Embedding_of_logics_shallow.ml create mode 100644 Tutorial/HOL_as_a_functional_programming_language.ml create mode 100644 Tutorial/HOL_basics.ml create mode 100644 Tutorial/HOLs_number_systems.ml create mode 100644 Tutorial/Inductive_datatypes.ml create mode 100644 Tutorial/Inductive_definitions.ml create mode 100644 Tutorial/Linking_external_tools.ml create mode 100644 Tutorial/Number_theory.ml create mode 100644 Tutorial/Propositional_logic.ml create mode 100644 Tutorial/Real_analysis.ml create mode 100644 Tutorial/Recursive_definitions.ml create mode 100644 Tutorial/Semantics_of_programming_languages_deep.ml create mode 100644 Tutorial/Semantics_of_programming_languages_shallow.ml create mode 100644 Tutorial/Sets_and_functions.ml create mode 100644 Tutorial/Tactics_and_tacticals.ml create mode 100644 Tutorial/Vectors.ml create mode 100644 Tutorial/Wellfounded_induction.ml create mode 100644 Tutorial/all.ml create mode 100644 Unity/aux_definitions.ml create mode 100644 Unity/make.ml create mode 100644 Unity/mk_comp_unity.ml create mode 100644 Unity/mk_ensures.ml create mode 100644 Unity/mk_gen_induct.ml create mode 100644 Unity/mk_leadsto.ml create mode 100644 Unity/mk_state_logic.ml create mode 100644 Unity/mk_unity_prog.ml create mode 100644 Unity/mk_unless.ml create mode 100644 arith.ml create mode 100644 basics.ml create mode 100644 bool.ml create mode 100644 calc_int.ml create mode 100644 calc_num.ml create mode 100644 calc_rat.ml create mode 100644 canon.ml create mode 100644 cart.ml create mode 100644 class.ml create mode 100644 database.ml create mode 100644 define.ml create mode 100644 drule.ml create mode 100644 equal.ml create mode 100644 grobner.ml create mode 100644 help.ml create mode 100644 hol.ml create mode 100644 impconv.ml create mode 100644 ind_defs.ml create mode 100644 ind_types.ml create mode 100644 int.ml create mode 100644 itab.ml create mode 100644 iterate.ml create mode 100644 lib.ml create mode 100644 lists.ml create mode 100644 make.ml create mode 100644 meson.ml create mode 100644 miz3/Samples/bug0.ml create mode 100644 miz3/Samples/bug1.ml create mode 100644 miz3/Samples/bug2.ml create mode 100644 miz3/Samples/bug3.ml create mode 100644 miz3/Samples/drinker.ml create mode 100644 miz3/Samples/forster.ml create mode 100644 miz3/Samples/icms.ml create mode 100644 miz3/Samples/irrat2.ml create mode 100644 miz3/Samples/lagrange.ml create mode 100644 miz3/Samples/lagrange1.ml create mode 100644 miz3/Samples/luxury.ml create mode 100644 miz3/Samples/other_mizs.ml create mode 100644 miz3/Samples/robbins.ml create mode 100644 miz3/Samples/sample.ml create mode 100644 miz3/Samples/samples.ml create mode 100644 miz3/Samples/talk.ml create mode 100644 miz3/Samples/tobias.ml create mode 100644 miz3/Samples/wishes.ml create mode 100644 miz3/make.ml create mode 100644 miz3/miz3.ml create mode 100644 miz3/miz3_of_hol.ml create mode 100644 miz3/test.ml create mode 100644 nets.ml create mode 100644 normalizer.ml create mode 100644 nums.ml create mode 100644 pa_j.ml create mode 100644 pa_j_3.07.ml create mode 100644 pa_j_3.08.ml create mode 100644 pa_j_3.09.ml create mode 100644 pa_j_3.1x_5.xx.ml create mode 100644 pa_j_3.1x_6.02.1.ml create mode 100644 pa_j_3.1x_6.02.2.ml create mode 100644 pa_j_3.1x_6.11.ml create mode 100644 pa_j_3.1x_6.xx.ml create mode 100644 pair.ml create mode 100644 parser.ml create mode 100644 preterm.ml create mode 100644 printer.ml create mode 100644 quot.ml create mode 100644 real.ml create mode 100644 realarith.ml create mode 100644 realax.ml create mode 100644 recursion.ml create mode 100644 sets.ml create mode 100644 simp.ml create mode 100644 system.ml create mode 100644 tactics.ml create mode 100644 term.ml create mode 100644 theorems.ml create mode 100644 thm.ml create mode 100644 trivia.ml create mode 100644 type.ml create mode 100644 update_database.ml create mode 100644 wf.ml diff --git a/100/arithmetic.ml b/100/arithmetic.ml new file mode 100644 index 0000000..cd3c9ea --- /dev/null +++ b/100/arithmetic.ml @@ -0,0 +1,13 @@ +(* ========================================================================= *) +(* Sum of an arithmetic series. *) +(* ========================================================================= *) + +let ARITHMETIC_PROGRESSION_LEMMA = prove + (`!n. nsum(0..n) (\i. a + d * i) = ((n + 1) * (2 * a + n * d)) DIV 2`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let ARITHMETIC_PROGRESSION = prove + (`!n. 1 <= n + ==> nsum(0..n-1) (\i. a + d * i) = (n * (2 * a + (n - 1) * d)) DIV 2`, + INDUCT_TAC THEN REWRITE_TAC[ARITHMETIC_PROGRESSION_LEMMA; SUC_SUB1] THEN + ARITH_TAC);; diff --git a/100/arithmetic_geometric_mean.ml b/100/arithmetic_geometric_mean.ml new file mode 100644 index 0000000..d553604 --- /dev/null +++ b/100/arithmetic_geometric_mean.ml @@ -0,0 +1,95 @@ +(* ========================================================================= *) +(* Arithmetic-geometric mean inequality. *) +(* ========================================================================= *) + +needs "Library/products.ml";; +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* There's already one proof of this in "Library/agm.ml". This one is from *) +(* an article by Michael Hirschhorn, Math. Intelligencer vol. 29, p7. *) +(* ------------------------------------------------------------------------- *) + +let LEMMA_1 = prove + (`!x n. x pow (n + 1) - (&n + &1) * x + &n = + (x - &1) pow 2 * sum(1..n) (\k. &k * x pow (n - k))`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ADD_CLAUSES] THENL + [REAL_ARITH_TAC; REWRITE_TAC[ARITH_RULE `1 <= SUC n`]] THEN + SIMP_TAC[ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; SUB_REFL] THEN + REWRITE_TAC[real_pow; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `k * x * x pow n = (k * x pow n) * x`] THEN + ASM_REWRITE_TAC[SUM_RMUL; REAL_MUL_ASSOC; REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_ADD] THEN REAL_ARITH_TAC);; + +let LEMMA_2 = prove + (`!n x. &0 <= x ==> &0 <= x pow (n + 1) - (&n + &1) * x + &n`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LEMMA_1] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE]);; + +let LEMMA_3 = prove + (`!n x. 1 <= n /\ (!i. 1 <= i /\ i <= n + 1 ==> &0 <= x i) + ==> x(n + 1) * (sum(1..n) x / &n) pow n + <= (sum(1..n+1) x / (&n + &1)) pow (n + 1)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `a = sum(1..n+1) x / (&n + &1)` THEN + ABBREV_TAC `b = sum(1..n) x / &n` THEN + SUBGOAL_THEN `x(n + 1) = (&n + &1) * a - &n * b` SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; LE_1; + REAL_ARITH `~(&n + &1 = &0)`] THEN + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; SUM_SING_NUMSEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= a /\ &0 <= b` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_DIV THEN + (CONJ_TAC THENL [MATCH_MP_TAC SUM_POS_LE_NUMSEG; REAL_ARITH_TAC]) THEN + ASM_SIMP_TAC[ARITH_RULE `p <= n ==> p <= n + 1`]; + ALL_TAC] THEN + ASM_CASES_TAC `b = &0` THEN + ASM_SIMP_TAC[REAL_POW_ZERO; LE_1; REAL_MUL_RZERO; REAL_POW_LE] THEN + MP_TAC(ISPECL [`n:num`; `a / b`] LEMMA_2) THEN ASM_SIMP_TAC[REAL_LE_DIV] THEN + REWRITE_TAC[REAL_ARITH `&0 <= x - a + b <=> a - b <= x`; REAL_POW_DIV] THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_POW_ADD] THEN UNDISCH_TAC `~(b = &0)` THEN + CONV_TAC REAL_FIELD);; + +let AGM = prove + (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) + ==> product(1..n) a <= (sum(1..n) a / &n) pow n`, + INDUCT_TAC THEN REWRITE_TAC[ARITH; PRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN X_GEN_TAC `x:num->real` THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH; SUM_SING_NUMSEG] THEN + REAL_ARITH_TAC; + REWRITE_TAC[ADD1] THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `x(n + 1) * (sum(1..n) x / &n) pow n` THEN + ASM_SIMP_TAC[LEMMA_3; GSYM REAL_OF_NUM_ADD; LE_1; + ARITH_RULE `i <= n ==> i <= n + 1`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[LE_REFL; LE_1; ARITH_RULE `i <= n ==> i <= n + 1`]]);; + +(* ------------------------------------------------------------------------- *) +(* Finally, reformulate in the usual way using roots. *) +(* ------------------------------------------------------------------------- *) + +needs "Library/transc.ml";; + +let AGM_ROOT = prove + (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) + ==> root n (product(1..n) a) <= sum(1..n) a / &n`, + INDUCT_TAC THEN REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `root(SUC n) ((sum(1..SUC n) a / &(SUC n)) pow (SUC n))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[AGM; ARITH_RULE `1 <= SUC n`] THEN + MATCH_MP_TAC PRODUCT_POS_LE THEN + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC POW_ROOT_POS THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; SUM_POS_LE_NUMSEG]]);; diff --git a/100/ballot.ml b/100/ballot.ml new file mode 100644 index 0000000..3138eda --- /dev/null +++ b/100/ballot.ml @@ -0,0 +1,347 @@ +(* ========================================================================= *) +(* Ballot problem. *) +(* ========================================================================= *) + +needs "Library/binomial.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Restricted function space. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-->",(13,"right"));; + +let funspace = new_definition + `(s --> t) = {f:A->B | (!x. x IN s ==> f(x) IN t) /\ + (!x. ~(x IN s) ==> f(x) = @y. T)}`;; + +let FUNSPACE_EMPTY = prove + (`({} --> t) = {(\x. @y. T)}`, + REWRITE_TAC[EXTENSION; IN_SING; funspace; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REWRITE_TAC[FUN_EQ_THM]);; + +let HAS_SIZE_FUNSPACE = prove + (`!s:A->bool t:B->bool m n. + s HAS_SIZE m /\ t HAS_SIZE n ==> (s --> t) HAS_SIZE (n EXP m)`, + REWRITE_TAC[HAS_SIZE; GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[CARD_CLAUSES; FINITE_RULES; FUNSPACE_EMPTY; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[EXP; ARITH]; + ALL_TAC] THEN + REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(x INSERT s) --> t = + IMAGE (\(y:B,g) u:A. if u = x then y else g(u)) + {y,g | y IN t /\ g IN s --> t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; funspace; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> d /\ a /\ b /\ c`] THEN + REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + X_GEN_TAC `f:A->B` THEN EQ_TAC THENL + [STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(f:A->B) x`; `\u. if u = x then @y. T else (f:A->B) u`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[IN_INSERT]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:B`; `g:A->B`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_MESON_TAC[IN_INSERT]]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ d <=> d /\ a /\ b`] THEN + REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REWRITE_TAC[FUN_EQ_THM; funspace; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN + X_GEN_TAC `u:A` THEN ASM_CASES_TAC `u:A = x` THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[CARD_CLAUSES; EXP] THEN + MATCH_MP_TAC HAS_SIZE_PRODUCT THEN ASM_MESON_TAC[]);; + +let FINITE_FUNSPACE = prove + (`!s t. FINITE s /\ FINITE t ==> FINITE(s --> t)`, + MESON_TAC[HAS_SIZE_FUNSPACE; HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of the problem. *) +(* ------------------------------------------------------------------------- *) + +let vote_INDUCT,vote_RECURSION = define_type + "vote = A | B";; + +let all_countings = new_definition + `all_countings a b = + let n = a + b in + CARD {f | f IN (1..n --> {A,B}) /\ + CARD { i | i IN 1..n /\ f(i) = A} = a /\ + CARD { i | i IN 1..n /\ f(i) = B} = b}`;; + +let valid_countings = new_definition + `valid_countings a b = + let n = a + b in + CARD {f | f IN (1..n --> {A,B}) /\ + CARD { i | i IN 1..n /\ f(i) = A} = a /\ + CARD { i | i IN 1..n /\ f(i) = B} = b /\ + !m. 1 <= m /\ m <= n + ==> CARD { i | i IN 1..m /\ f(i) = A} > + CARD { i | i IN 1..m /\ f(i) = B}}`;; + +(* ------------------------------------------------------------------------- *) +(* Various lemmas. *) +(* ------------------------------------------------------------------------- *) + +let vote_CASES = cases "vote" +and vote_DISTINCT = distinctness "vote";; + +let FINITE_COUNTINGS = prove + (`FINITE {f | f IN (1..n --> {A,B}) /\ P f}`, + MATCH_MP_TAC FINITE_RESTRICT THEN + MATCH_MP_TAC FINITE_FUNSPACE THEN + REWRITE_TAC[FINITE_NUMSEG; FINITE_INSERT; FINITE_RULES]);; + +let UNIV_VOTE = prove + (`(:vote) = {A,B}`, + REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY; vote_CASES]);; + +let ADD1_NOT_IN_NUMSEG = prove + (`!m n. ~((n + 1) IN m..n)`, + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; + +let NUMSEG_1_CLAUSES = prove + (`!n. 1..(n+1) = (n + 1) INSERT (1..n)`, + REWRITE_TAC[GSYM ADD1; NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`]);; + +let NUMSEG_RESTRICT_SUC = prove + (`{i | i IN 1..(n+1) /\ P i} = + if P(n + 1) then (n + 1) INSERT {i | i IN 1..n /\ P i} + else {i | i IN 1..n /\ P i}`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NUMSEG_1_CLAUSES; IN_INSERT] THEN + ASM_MESON_TAC[ADD1_NOT_IN_NUMSEG]);; + +let CARD_NUMSEG_RESTRICT_SUC = prove + (`CARD {i | i IN 1..(n+1) /\ P i} = + if P(n + 1) then CARD {i | i IN 1..n /\ P i} + 1 + else CARD {i | i IN 1..n /\ P i}`, + REPEAT GEN_TAC THEN REWRITE_TAC[NUMSEG_RESTRICT_SUC] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RESTRICT; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_ELIM_THM; ADD1_NOT_IN_NUMSEG; ADD1]);; + +let FORALL_RANGE_SUC = prove + (`(!i. 1 <= i /\ i <= n + 1 ==> P i) <=> + P(n + 1) /\ (!i. 1 <= i /\ i <= n ==> P i)`, + REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN + MESON_TAC[ARITH_RULE `1 <= n + 1`]);; + +let IN_NUMSEG_RESTRICT_FALSE = prove + (`m <= n + ==> (i IN 1..m /\ (if i = n + 1 then p i else q i) <=> i IN 1..m /\ q i)`, + REWRITE_TAC[IN_NUMSEG] THEN + MESON_TAC[ARITH_RULE `i <= m /\ m <= n ==> ~(i = n + 1)`]);; + +let CARD_NUMSEG_RESTRICT_EXTREMA = prove + (`(CARD {i | i IN 1..n /\ P i} = n <=> !i. 1 <= i /\ i <= n ==> P i) /\ + (CARD {i | i IN 1..n /\ P i} = 0 <=> !i. 1 <= i /\ i <= n ==> ~(P i))`, + SIMP_TAC[CARD_EQ_0; FINITE_RESTRICT; FINITE_NUMSEG] THEN + MP_TAC(ISPECL [`{i | i IN 1..n /\ P i}`; `1..n`] SUBSET_CARD_EQ) THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_ELIM_THM; CARD_NUMSEG_1] THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_NUMSEG; IN_ELIM_THM] THEN + MESON_TAC[]);; + +let VOTE_NOT_EQ = prove + (`(!x. ~(x = A) <=> x = B) /\ + (!x. ~(x = B) <=> x = A)`, + MESON_TAC[vote_CASES; vote_DISTINCT]);; + +let FUNSPACE_FIXED = prove + (`{f | f IN (s --> t) /\ (!i. i IN s ==> f i = a)} = + if s = {} \/ a IN t then {(\i. if i IN s then a else @x. T)} else {}`, + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN GEN_TAC THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM; funspace; NOT_IN_EMPTY; IN_SING] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; + +let COUNTING_LEMMA = prove + (`CARD {f | f IN (1..(n+1) --> {A,B}) /\ P f} = + CARD {f | f IN (1..n --> {A,B}) /\ P (\i. if i = n + 1 then A else f i)} + + CARD {f | f IN (1..n --> {A,B}) /\ P (\i. if i = n + 1 then B else f i)}`, + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `CARD {f | f IN (1..(n+1) --> {A,B}) /\ f(n+1) = A /\ P f} + + CARD {f | f IN (1..(n+1) --> {A,B}) /\ f(n+1) = B /\ P f}` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN + REWRITE_TAC[FINITE_COUNTINGS; EXTENSION; IN_INTER; IN_UNION] THEN + REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY] THEN + MESON_TAC[vote_CASES; vote_DISTINCT]; + ALL_TAC] THEN + BINOP_TAC THEN + MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN + EXISTS_TAC `\f i. if i = n + 1 then @x:vote. T else f i` THENL + [EXISTS_TAC `\f i. if i = n + 1 then A else f i`; + EXISTS_TAC `\f i. if i = n + 1 then B else f i`] THEN + REWRITE_TAC[FINITE_COUNTINGS] THEN + REWRITE_TAC[IN_ELIM_THM; funspace; GSYM UNIV_VOTE; IN_UNIV] THEN + REWRITE_TAC[NUMSEG_1_CLAUSES; IN_INSERT] THEN REPEAT STRIP_TAC THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `P x ==> x = y ==> P y`))) THEN + TRY(GEN_REWRITE_TAC I [FUN_EQ_THM]) THEN ASM_MESON_TAC[ADD1_NOT_IN_NUMSEG]);; + +(* ------------------------------------------------------------------------- *) +(* Recurrence relations. *) +(* ------------------------------------------------------------------------- *) + +let ALL_COUNTINGS_0 = prove + (`!a. all_countings a 0 = 1 /\ all_countings 0 a = 1`, + REWRITE_TAC[all_countings; CARD_NUMSEG_RESTRICT_EXTREMA; GSYM IN_NUMSEG; + LET_DEF; LET_END_DEF; ADD_CLAUSES; VOTE_NOT_EQ] THEN + REWRITE_TAC[FUNSPACE_FIXED; IN_INSERT] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH_SUC]);; + +let VALID_COUNTINGS_0 = prove + (`valid_countings 0 0 = 1 /\ + !a. valid_countings (SUC a) 0 = 1 /\ valid_countings 0 (SUC a) = 0`, + let lemma = prove + (`{x} INTER s = if x IN s then {x} else {}`, + COND_CASES_TAC THEN ASM SET_TAC[]) in + REWRITE_TAC[valid_countings; CARD_NUMSEG_RESTRICT_EXTREMA; GSYM IN_NUMSEG; + LET_DEF; LET_END_DEF; ADD_CLAUSES; VOTE_NOT_EQ; + TAUT `a /\ a /\ b <=> a /\ b`] THEN + REWRITE_TAC[CONJUNCT1 NUMSEG_CLAUSES; ARITH_EQ; NOT_IN_EMPTY] THEN + CONJ_TAC THENL + [REWRITE_TAC[funspace; IN_ELIM_THM; NOT_IN_EMPTY; GSYM FUN_EQ_THM] THEN + REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = + {x | P x /\ Q x} INTER {x | R x}`] THEN + REWRITE_TAC[FUNSPACE_FIXED; IN_INSERT; lemma] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + GEN_TAC THEN CONJ_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THENL + [X_GEN_TAC `k:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(ARITH_RULE `b = 0 /\ ~(a = 0) ==> a > b`) THEN + ASM_SIMP_TAC[CARD_NUMSEG_RESTRICT_EXTREMA] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (ARITH_RULE + `1 <= k /\ k <= a ==> 1 <= k /\ !i. i <= k ==> i <= a`)) THEN + ASM_SIMP_TAC[IN_NUMSEG; vote_DISTINCT] THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + EXISTS_TAC `1` THEN REWRITE_TAC[NUMSEG_SING; IN_SING] THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= SUC n`] THEN + MATCH_MP_TAC(ARITH_RULE `b = 0 /\ ~(a = 0) ==> ~(b > a)`) THEN + ONCE_REWRITE_TAC[SET_RULE `{x | x = a /\ P x} = {x | x = a /\ P a}`] THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= SUC n`] THEN + SIMP_TAC[vote_DISTINCT; SET_RULE `{x | F} = {} /\ {x | x = a} = {a}`; + CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH]]);; + +let ALL_COUNTINGS_SUC = prove + (`!a b. all_countings (a + 1) (b + 1) = + all_countings a (b + 1) + all_countings (a + 1) b`, + REPEAT GEN_TAC THEN REWRITE_TAC[all_countings] THEN + SUBST1_TAC(ARITH_RULE `(a + 1) + (b + 1) = (a + b + 1) + 1`) THEN + SUBST1_TAC(ARITH_RULE `(a + 1) + b = a + b + 1`) THEN + ABBREV_TAC `n = a + b + 1` THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + GEN_REWRITE_TAC LAND_CONV [COUNTING_LEMMA] THEN + REWRITE_TAC[] THEN BINOP_TAC THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[vote_DISTINCT] THEN + REWRITE_TAC[CARD_NUMSEG_RESTRICT_SUC] THEN + SIMP_TAC[IN_NUMSEG_RESTRICT_FALSE; LE_REFL; EQ_ADD_RCANCEL]);; + +let VALID_COUNTINGS_SUC = prove + (`!a b. valid_countings (a + 1) (b + 1) = + if a <= b then 0 + else valid_countings a (b + 1) + valid_countings (a + 1) b`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `b:num < a` THEN ASM_REWRITE_TAC[GSYM NOT_LT] THEN + REWRITE_TAC[valid_countings] THEN + SUBST1_TAC(ARITH_RULE `(a + 1) + (b + 1) = (a + b + 1) + 1`) THEN + SUBST1_TAC(ARITH_RULE `(a + 1) + b = a + b + 1`) THEN + ABBREV_TAC `n = a + b + 1` THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + GEN_REWRITE_TAC LAND_CONV [COUNTING_LEMMA] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[vote_DISTINCT] THEN + REWRITE_TAC[FORALL_RANGE_SUC] THEN + REWRITE_TAC[CARD_NUMSEG_RESTRICT_SUC] THEN + SIMP_TAC[IN_NUMSEG_RESTRICT_FALSE; LE_REFL; EQ_ADD_RCANCEL] THEN + SIMP_TAC[MESON[] `x = a /\ y = b /\ P x y <=> x = a /\ y = b /\ P a b`] THEN + ASM_REWRITE_TAC[GT; LT_ADD_RCANCEL] THEN + REWRITE_TAC[SET_RULE `{x | F} = EMPTY`; CARD_CLAUSES; ADD_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Main result. *) +(* ------------------------------------------------------------------------- *) + +let ALL_COUNTINGS = prove + (`!a b. all_countings a b = binom(a + b,a)`, + INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; BINOM_REFL; binom; ALL_COUNTINGS_0] THEN + INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; BINOM_REFL; binom; ALL_COUNTINGS_0] THEN + REWRITE_TAC[ARITH_RULE `1 = a + 1 <=> a = 0`; BINOM_EQ_0; + ARITH_RULE `a < SUC a`] THEN + REWRITE_TAC[ALL_COUNTINGS_SUC; ADD1] THEN + ASM_REWRITE_TAC[binom; GSYM ADD1] THEN + REWRITE_TAC[ADD_CLAUSES; ADD_AC]);; + +let VALID_COUNTINGS = prove + (`!a b. (a + b) * valid_countings a b = (a - b) * binom(a + b,a)`, + INDUCT_TAC THENL + [REWRITE_TAC[VALID_COUNTINGS_0; SUB_0; MULT_CLAUSES] THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[VALID_COUNTINGS_0; MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + INDUCT_TAC THENL + [REWRITE_TAC[VALID_COUNTINGS_0; ADD_CLAUSES; BINOM_REFL; SUB_0]; + ALL_TAC] THEN + REWRITE_TAC[ADD1; VALID_COUNTINGS_SUC] THEN REWRITE_TAC[GSYM ADD1] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[MULT_CLAUSES; ARITH_RULE `a <= b ==> SUC a - SUC b = 0`] THEN + MATCH_MP_TAC(NUM_RING + `~(a + b + 1 = 0) /\ + (SUC a + SUC b) * + ((SUC a + b) * (a + SUC b) * y + (a + SUC b) * (SUC a + b) * z) = + (SUC a + b) * (a + SUC b) * w + ==> (SUC a + SUC b) * (y + z) = w`) THEN + ASM_REWRITE_TAC[ADD_EQ_0; ARITH] THEN + MP_TAC(SPECL [`SUC b`; `a:num`] BINOM_FACT) THEN + MP_TAC(SPECL [`b:num`; `SUC a`] BINOM_FACT) THEN + MP_TAC(SPECL [`SUC b`; `SUC a`] BINOM_FACT) THEN + REWRITE_TAC[ADD_CLAUSES; FACT] THEN + SUBST1_TAC(ARITH_RULE `b + a:num = a + b`) THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t FACT_LT)) + [`a:num`; `b:num`; `a + b:num`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_SUB; REAL_OF_NUM_LE; LT_NZ; + ARITH_RULE `~(a <= b) ==> b <= SUC a /\ SUC b <= a /\ SUC b <= SUC a`] THEN + CONV_TAC REAL_RING);; + +let BALLOT = prove + (`!a b. &(valid_countings a b) = + if a <= b then if b = 0 then &1 else &0 + else (&a - &b) / (&a + &b) * &(all_countings a b)`, + REPEAT INDUCT_TAC THEN REWRITE_TAC[ALL_COUNTINGS_0; VALID_COUNTINGS_0] THEN + REWRITE_TAC[LE_REFL; REAL_MUL_LID; LE_0; NOT_SUC; CONJUNCT1 LE] THEN + SIMP_TAC[REAL_ADD_RID; REAL_SUB_RZERO; REAL_DIV_REFL; REAL_OF_NUM_EQ; + NOT_SUC; REAL_MUL_LID] THEN + MP_TAC(SPECL [`SUC a`; `SUC b`] VALID_COUNTINGS) THEN + REWRITE_TAC[GSYM ALL_COUNTINGS; LE_SUC] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `a <= b ==> (SUC a - SUC b) = 0`] THEN + REWRITE_TAC[MULT_EQ_0; MULT_CLAUSES; ADD_EQ_0; NOT_SUC; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_SUB; + ARITH_RULE `~(a <= b) ==> SUC b <= SUC a`] THEN + CONV_TAC REAL_FIELD);; diff --git a/100/bernoulli.ml b/100/bernoulli.ml new file mode 100644 index 0000000..9c70b67 --- /dev/null +++ b/100/bernoulli.ml @@ -0,0 +1,274 @@ +(* ========================================================================= *) +(* Bernoulli numbers and polynomials; sum of kth powers. *) +(* ========================================================================= *) + +needs "Library/binomial.ml";; +needs "Library/analysis.ml";; +needs "Library/transc.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* A couple of basic lemmas about new-style sums. *) +(* ------------------------------------------------------------------------- *) + +let SUM_DIFFS = prove + (`!a m n. m <= n + 1 ==> sum(m..n) (\i. a(i + 1) - a(i)) = a(n + 1) - a(m)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG] THENL + [REWRITE_TAC[ARITH_RULE `m <= 0 + 1 <=> m = 0 \/ m = 1`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ARITH; ADD_CLAUSES; REAL_SUB_REFL]; + SIMP_TAC[ARITH_RULE `m <= SUC n + 1 <=> m <= n + 1 \/ m = SUC n + 1`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[ADD1] THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_REFL; ARITH_RULE `~((n + 1) + 1 <= n + 1)`] THEN + MATCH_MP_TAC SUM_TRIV_NUMSEG THEN ARITH_TAC]);; + +let DIFF_SUM = prove + (`!f f' a b. + (!k. a <= k /\ k <= b ==> ((\x. f x k) diffl f'(k)) x) + ==> ((\x. sum(a..b) (f x)) diffl (sum(a..b) f')) x`, + REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[ARITH; DIFF_CONST; SUM_TRIV_NUMSEG; + ARITH_RULE `~(a <= SUC b) ==> b < a`] THEN + DISCH_TAC THEN MATCH_MP_TAC DIFF_ADD THEN + ASM_SIMP_TAC[LE_REFL; ARITH_RULE `k <= b ==> k <= SUC b`]);; + +(* ------------------------------------------------------------------------- *) +(* Bernoulli numbers. *) +(* ------------------------------------------------------------------------- *) + +let bernoulli = define + `(bernoulli 0 = &1) /\ + (!n. bernoulli(SUC n) = + --sum(0..n) (\j. &(binom(n + 2,j)) * bernoulli j) / (&n + &2))`;; + +(* ------------------------------------------------------------------------- *) +(* A slightly tidier-looking form of the recurrence. *) +(* ------------------------------------------------------------------------- *) + +let BERNOULLI = prove + (`!n. sum(0..n) (\j. &(binom(n + 1,j)) * bernoulli j) = + if n = 0 then &1 else &0`, + INDUCT_TAC THEN + REWRITE_TAC[bernoulli; SUM_CLAUSES_NUMSEG; GSYM ADD1; ADD_CLAUSES; binom; + REAL_MUL_LID; LE_0; NOT_SUC] THEN + SIMP_TAC[BINOM_LT; ARITH_RULE `n < SUC n`; BINOM_REFL; REAL_ADD_LID] THEN + REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN + MATCH_MP_TAC(REAL_FIELD `x = &n + &2 ==> s + x * --s / (&n + &2) = &0`) THEN + REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL; ARITH_RULE `~(n = n + 1)`] THEN + REWRITE_TAC[BINOM_REFL] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Bernoulli polynomials. *) +(* ------------------------------------------------------------------------- *) + +let bernpoly = new_definition + `bernpoly n x = sum(0..n) (\k. &(binom(n,k)) * bernoulli k * x pow (n - k))`;; + +(* ------------------------------------------------------------------------- *) +(* The key derivative recurrence. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_BERNPOLY = prove + (`!n x. ((bernpoly (SUC n)) diffl (&(SUC n) * bernpoly n x)) x`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[bernpoly; SUM_CLAUSES_NUMSEG; LE_0] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[SUB_REFL; real_pow; DIFF_CONST] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC DIFF_SUM THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL] THEN + DIFF_TAC THEN ASM_SIMP_TAC[ARITH_RULE `k <= n ==> ~(k = n + 1)`] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + ASM_SIMP_TAC[ARITH_RULE `k <= n ==> (n + 1) - k - 1 = n - k`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; ARITH_RULE `k <= n ==> k <= n + 1`] THEN + UNDISCH_TAC `k <= n:num` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_LE] THEN + ABBREV_TAC `z = x pow (n - k)` THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Hence the key stepping recurrence. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRALS_EQ = prove + (`!f g. (!x. ((\x. f(x) - g(x)) diffl &0) x) /\ f(&0) = g(&0) + ==> !x. f(x) = g(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. f(x) - g(x)`; `x:real`; `&0`] DIFF_ISCONST_ALL) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let RECURRENCE_BERNPOLY = prove + (`!n x. bernpoly n (x + &1) - bernpoly n x = &n * x pow (n - 1)`, + INDUCT_TAC THENL + [REWRITE_TAC[bernpoly; SUM_SING_NUMSEG; REAL_SUB_REFL; SUB_REFL; + real_pow; REAL_MUL_LZERO]; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRALS_EQ THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) (&(SUC n))`) THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + REPEAT(MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC) THEN + SIMP_TAC[SUC_SUB1; DIFF_CMUL; DIFF_POW; DIFF_BERNPOLY; ETA_AX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC DIFF_CHAIN THEN REWRITE_TAC[DIFF_BERNPOLY] THEN + DIFF_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[bernpoly; GSYM SUM_SUB_NUMSEG] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_POW_ONE; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; SUB_REFL; real_pow] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN + SIMP_TAC[ARITH_RULE `i <= n ==> SUC n - i = SUC(n - i)`] THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_MUL_RID] THEN + REWRITE_TAC[BERNOULLI; ADD1] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH; real_pow; REAL_MUL_LID] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN + ASM_REWRITE_TAC[ADD_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get the main result. *) +(* ------------------------------------------------------------------------- *) + +let SUM_OF_POWERS = prove + (`!n. sum(0..n) (\k. &k pow m) = + (bernpoly(SUC m) (&n + &1) - bernpoly(SUC m) (&0)) / (&m + &1)`, + GEN_TAC THEN ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum(0..n) (\i. bernpoly (SUC m) (&(i + 1)) - bernpoly (SUC m) (&i))` THEN + CONJ_TAC THENL + [REWRITE_TAC[RECURRENCE_BERNPOLY; GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; SUC_SUB1]; + SIMP_TAC[SUM_DIFFS; LE_0] THEN REWRITE_TAC[REAL_OF_NUM_ADD]]);; + +(* ------------------------------------------------------------------------- *) +(* Now explicit computations of the various terms on specific instances. *) +(* ------------------------------------------------------------------------- *) + +let SUM_CONV = + let pth = prove + (`sum(0..0) f = f 0 /\ sum(0..SUC n) f = sum(0..n) f + f(SUC n)`, + SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0]) in + let econv_0 = GEN_REWRITE_CONV I [CONJUNCT1 pth] + and econv_1 = GEN_REWRITE_CONV I [CONJUNCT2 pth] in + let rec sconv tm = + (econv_0 ORELSEC + (LAND_CONV(RAND_CONV num_CONV) THENC econv_1 THENC + COMB2_CONV (RAND_CONV sconv) (RAND_CONV NUM_SUC_CONV))) tm in + sconv;; + +let BINOM_CONV = + let pth = prove + (`a * b * x = FACT c ==> x = (FACT c) DIV (a * b)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN ARITH_TAC; + POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[LT_NZ; MULT_ASSOC; MULT_CLAUSES] THEN + MESON_TAC[LT_NZ; FACT_LT]]) in + let match_pth = MATCH_MP pth + and binom_tm = `binom` in + fun tm -> + let bop,lr = dest_comb tm in + if bop <> binom_tm then failwith "BINOM_CONV" else + let l,r = dest_pair lr in + let n = dest_numeral l and k = dest_numeral r in + if n let op,n = dest_comb tm in + if op <> b_tm or not(is_numeral n) then failwith "BERNOULLI_CONV" + else hd(BERNOULLIS(dest_small_numeral n));; + +let BERNPOLY_CONV = + let conv_1 = + REWR_CONV bernpoly THENC SUM_CONV THENC + TOP_DEPTH_CONV BETA_CONV THENC NUM_REDUCE_CONV + and conv_3 = + ONCE_DEPTH_CONV BINOM_CONV THENC REAL_POLY_CONV in + fun tm -> + let n = dest_small_numeral(lhand tm) in + let conv_2 = GEN_REWRITE_CONV ONCE_DEPTH_CONV (BERNOULLIS n) in + (conv_1 THENC conv_2 THENC conv_3) tm;; + +let SOP_CONV = + let pth = prove + (`sum(0..n) (\k. &k pow m) = + (\p. (p(&n + &1) - p(&0)) / (&m + &1)) + (\x. bernpoly (SUC m) x)`, + REWRITE_TAC[SUM_OF_POWERS]) in + let conv_0 = REWR_CONV pth in + REWR_CONV pth THENC + RAND_CONV(ABS_CONV(LAND_CONV NUM_SUC_CONV THENC BERNPOLY_CONV)) THENC + TOP_DEPTH_CONV BETA_CONV THENC + REAL_POLY_CONV;; + +let SOP_NUM_CONV = + let pth = prove + (`sum(0..n) (\k. &k pow p) = &m ==> nsum(0..n) (\k. k EXP p) = m`, + REWRITE_TAC[REAL_OF_NUM_POW; GSYM REAL_OF_NUM_SUM_NUMSEG; + REAL_OF_NUM_EQ]) in + let rule_1 = PART_MATCH (lhs o rand) pth in + fun tm -> + let th1 = rule_1 tm in + let th2 = SOP_CONV(lhs(lhand(concl th1))) in + MATCH_MP th1 th2;; + +(* ------------------------------------------------------------------------- *) +(* The example Bernoulli bragged about. *) +(* ------------------------------------------------------------------------- *) + +time SOP_NUM_CONV `nsum(0..1000) (\k. k EXP 10)`;; + +(* ------------------------------------------------------------------------- *) +(* The general formulas for moderate powers. *) +(* ------------------------------------------------------------------------- *) + +time SOP_CONV `sum(0..n) (\k. &k pow 0)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 1)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 2)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 3)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 4)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 5)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 6)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 7)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 8)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 9)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 10)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 11)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 12)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 13)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 14)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 15)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 16)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 17)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 18)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 19)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 20)`;; +time SOP_CONV `sum(0..n) (\k. &k pow 21)`;; diff --git a/100/bertrand.ml b/100/bertrand.ml new file mode 100644 index 0000000..ac8adce --- /dev/null +++ b/100/bertrand.ml @@ -0,0 +1,2843 @@ +(* ========================================================================= *) +(* Proof of Bertrand conjecture and weak form of prime number theorem. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; +needs "Library/analysis.ml";; +needs "Library/transc.ml";; +needs "Library/calc_real.ml";; +needs "Library/floor.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* A ridiculous ommission from the OCaml Num library. *) +(* ------------------------------------------------------------------------- *) + +let num_of_float = + let p22 = Pervasives.( ** ) 2.0 22.0 + and p44 = Pervasives.( ** ) 2.0 44.0 + and p66 = Pervasives.( ** ) 2.0 66.0 + and q22 = pow2 22 and q44 = pow2 44 and q66 = pow2 66 in + fun x -> + let y0,n = frexp x in + let u0 = int_of_float(y0 *. p22) in + let y1 = p22 *. y0 -. float_of_int u0 in + let u1 = int_of_float(y1 *. p22) in + let y2 = p22 *. y1 -. float_of_int u1 in + let u2 = int_of_float(y2 *. p22) in + let y3 = p22 *. y2 -. float_of_int u2 in + if y3 <> 0.0 then failwith "num_of_float: inexactness!" else + (Int u0 // q22 +/ Int u1 // q44 +/ Int u2 // q66) */ pow2 n;; + +(* ------------------------------------------------------------------------- *) +(* Integer truncated square root *) +(* ------------------------------------------------------------------------- *) + +let ISQRT = new_definition + `ISQRT n = @m. m EXP 2 <= n /\ n < (m + 1) EXP 2`;; + +let ISQRT_WORKS = prove + (`!n. ISQRT(n) EXP 2 <= n /\ n < (ISQRT(n) + 1) EXP 2`, + GEN_TAC THEN REWRITE_TAC[ISQRT] THEN CONV_TAC SELECT_CONV THEN + SUBGOAL_THEN `(?m. m EXP 2 <= n) /\ (?a. !m. m EXP 2 <= n ==> m <= a)` + MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[num_MAX] THEN + MATCH_MP_TAC MONO_EXISTS THEN + MESON_TAC[ARITH_RULE `~(m + 1 <= m)`; NOT_LE]] THEN + CONJ_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[ARITH; LE_0]; ALL_TAC] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN + MESON_TAC[LE_SQUARE_REFL; EXP_2; LE_TRANS]);; + +let ISQRT_0 = prove + (`ISQRT 0 = 0`, + MP_TAC(SPEC `0` ISQRT_WORKS) THEN + SIMP_TAC[ARITH_RULE `x <= 0 <=> (x = 0)`; EXP_EQ_0; ARITH_EQ]);; + +let ISQRT_UNIQUE = prove + (`!m n. (ISQRT n = m) <=> m EXP 2 <= n /\ n < (m + 1) EXP 2`, + REPEAT GEN_TAC THEN EQ_TAC THEN MP_TAC (SPEC `n:num` ISQRT_WORKS) THENL + [MESON_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(ISQRT n) EXP 2 < (m + 1) EXP 2 /\ + m EXP 2 < (ISQRT n + 1) EXP 2` + MP_TAC THENL + [ASM_MESON_TAC[LT_SUC_LE; LE_SUC_LT; LET_TRANS; LTE_TRANS]; + SIMP_TAC[num_CONV `2`; EXP_MONO_LT_SUC; GSYM LE_ANTISYM] THEN ARITH_TAC]);; + +let ISQRT_SUC = prove + (`!n. ISQRT(SUC n) = + if ?m. SUC n = m EXP 2 then SUC(ISQRT n) else ISQRT n`, + GEN_TAC THEN REWRITE_TAC[ISQRT_UNIQUE] THEN COND_CASES_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[ISQRT_WORKS; ARITH_RULE + `a <= n /\ n < b /\ ~(SUC n = a) /\ ~(SUC n = b) + ==> a <= SUC n /\ SUC n < b`]] THEN + CONJ_TAC THENL + [ALL_TAC; + MP_TAC(CONJUNCT2(SPEC `n:num` ISQRT_WORKS)) THEN + REWRITE_TAC[EXP_2; GSYM ADD1; MULT_CLAUSES; ADD_CLAUSES; LT_SUC] THEN + ARITH_TAC] THEN + POP_ASSUM(X_CHOOSE_TAC `m:num`) THEN + SUBGOAL_THEN `m = SUC(ISQRT n)` SUBST_ALL_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[LE_REFL]] THEN + SUBGOAL_THEN `ISQRT(n) EXP 2 < m EXP 2 /\ m EXP 2 <= SUC(ISQRT n) EXP 2` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[num_CONV `2`; EXP_MONO_LE_SUC; EXP_MONO_LT_SUC] THEN ARITH_TAC] THEN + MP_TAC(SPEC `n:num` ISQRT_WORKS) THEN REWRITE_TAC[ADD1] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[LT_SUC_LE; LE_SUC_LT]);; + +(* ------------------------------------------------------------------------- *) +(* To allow us to deal with ln(2) numerically using standard conversion. *) +(* ------------------------------------------------------------------------- *) + +let LN_2_COMPOSITION = prove + (`ln(&2) = + &7 * ln(&1 + inv(&8)) - &2 * ln(&1 + inv(&24)) - &4 * ln(&1 + inv(&80))`, + CONV_TAC(GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4 + [GSYM LN_POW; GSYM LN_MUL; GSYM LN_DIV; REAL_POW_LT; real_div; + REAL_LT_ADD; REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; ARITH]) THEN + AP_TERM_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Automatically process any ln(n) to allow us to use standard conversions. *) +(* ------------------------------------------------------------------------- *) + +let LN_N_CONV = + let pth = prove + (`x = (&1 + inv(&8)) pow n * (x / (&1 + inv(&8)) pow n)`, + CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + MATCH_MP_TAC REAL_POW_NZ THEN CONV_TAC REAL_RAT_REDUCE_CONV) + and qth = prove + (`&0 < x + ==> (ln((&1 + inv(&8)) pow n * x / (&1 + inv(&8)) pow n) = + &n * ln(&1 + inv(&8)) + ln(&1 + (x / (&1 + inv(&8)) pow n - &1)))`, + REWRITE_TAC[REAL_ARITH `&1 + (x - &1) = x`] THEN + SIMP_TAC[LN_MUL; LN_POW; REAL_LT_DIV; REAL_POW_LT; + REAL_RAT_REDUCE_CONV `&0 < &1 + inv(&8)`]) + and ln_tm = `ln` and x_tm = `x:real` and n_tm = `n:num` in + fun tm0 -> + let ltm,tm = dest_comb tm0 in + if ltm <> ln_tm then failwith "expected ln(ratconst)" else + let x = rat_of_term tm in + let rec dlog n y = + let y' = y +/ y // Int 8 in + if y' (ln(&2 pow n * x / &2 pow n) = + &n * ln(&2) + ln(&1 + (x / &2 pow n - &1)))`, + REWRITE_TAC[REAL_ARITH `&1 + (x - &1) = x`] THEN + SIMP_TAC[LN_MUL; LN_POW; REAL_LT_DIV; REAL_POW_LT; + REAL_RAT_REDUCE_CONV `&0 < &2`]) + and ln_tm = `ln` and x_tm = `x:real` and n_tm = `n:num` in + fun tm0 -> + let ltm,tm = dest_comb tm0 in + if ltm <> ln_tm then failwith "expected ln(ratconst)" else + let x = rat_of_term tm in + let rec dlog n y = + let y' = y */ Int 2 in + if y' &2 * floor(&n / &r) <= floor(&(2 * n + d) / &r) /\ + floor(&(2 * n + d) / &r) <= &2 * floor(&n / &r) + &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `floor(&n / &r) = floor((&n + &d / &2) / &r)` SUBST1_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + SUBGOAL_THEN `&2 * &n + &d = &2 * (&n + &d / &2)` SUBST1_TAC THENL + [SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_MUL_ASSOC; real_div] THEN + REWRITE_TAC[GSYM real_div; FLOOR_DOUBLE]] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN + MP_TAC(SPEC `&n / &r` FLOOR) THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n / &r` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_LE_ADDR] THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_INV_EQ]; + ALL_TAC] THEN + UNDISCH_TAC `&n / &r < floor (&n / &r) + &1` THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT] THEN + SIMP_TAC[REAL_LT_INTEGERS; FLOOR; INTEGER_CLOSED] THEN + MATCH_MP_TAC(REAL_ARITH `b < a ==> n + a <= c ==> n + b < c`) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Range bounds on ln(n!). *) +(* ------------------------------------------------------------------------- *) + +let LN_FACT = prove + (`!n. ln(&(FACT n)) = sum(1,n) (\d. ln(&d))`, + INDUCT_TAC THEN REWRITE_TAC[FACT; sum; LN_1] THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL; LN_MUL; REAL_OF_NUM_LT; FACT_LT; LT_0] THEN + ASM_REWRITE_TAC[ADD1] THEN REWRITE_TAC[ADD_AC; REAL_ADD_AC]);; + +let LN_FACT_BOUNDS = prove + (`!n. ~(n = 0) ==> abs(ln(&(FACT n)) - (&n * ln(&n) - &n)) <= &1 + ln(&n)`, + SUBGOAL_THEN + `!n. ~(n = 0) + ==> ?z. &n < z /\ z < &(n + 1) /\ + (&(n + 1) * ln(&(n + 1)) - &n * ln(&n) = ln(z) + &1)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x. x * ln(x)`; `\x. ln(x) + &1`; `&n`; `&(n + 1)`] + MVT_ALT) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `(n + &1) - n = &1`] THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_ARITH `a < a + &1`] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MP_TAC(SPEC `x:real` (DIFF_CONV `\x. x * ln(x)`)) THEN + SIMP_TAC[REAL_MUL_LID; REAL_MUL_RID; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `k:num->real`) THEN + SUBGOAL_THEN + `!n. &(n + 1) * ln(&(n + 1)) = sum(1,n) (\i. ln(k i) + &1)` + MP_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[sum; ADD_CLAUSES; LN_1; REAL_MUL_RZERO] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`; + ARITH_RULE `SUC(n + 1) = n + 2`] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[REAL_ARITH `(a - b = c) <=> (a = b + c)`] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_AC]; + ALL_TAC] THEN + REWRITE_TAC[SUM_ADD] THEN + CONV_TAC(LAND_CONV(BINDER_CONV(RAND_CONV(RAND_CONV(LAND_CONV + (LAND_CONV num_CONV)))))) THEN + REWRITE_TAC[ADD1; SUM_REINDEX; SUM_CONST] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a = b + c * &1) <=> (b = a - c)`] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!n. abs(sum(1,n+1) (\i. ln(&i)) - (&(n + 1) * ln (&(n + 1)) - &(n + 1))) + <= &1 + ln(&(n + 1))` + ASSUME_TAC THENL + [GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) + [GSYM REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x - (y - z)) <= a ==> abs(x - (y - (z + &1))) <= &1 + a`) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM th]) THEN + SUBGOAL_THEN + `sum(1,n + 1) (\i. ln (&i)) = sum(1,n) (\i. ln(&(i + 1)))` + SUBST1_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [SUM_DIFF] THEN + REWRITE_TAC[SUM_1; ADD_CLAUSES; LN_1; REAL_SUB_RZERO] THEN + GEN_REWRITE_TAC (funpow 3 LAND_CONV) [SYM(NUM_REDUCE_CONV `0 + 1`)] THEN + REWRITE_TAC[SUM_REINDEX] THEN REWRITE_TAC[ADD_AC]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SUB] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1,n) (\n. abs(ln(&(n + 1)) - ln(k n)))` THEN + REWRITE_TAC[ABS_SUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1,n) (\i. ln(&(i + 1)) - ln(&i))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a < b /\ b < c ==> abs(c - b) <= c - a`) THEN + SUBGOAL_THEN `&0 < &r /\ &r < k r /\ k r < &(r + 1)` MP_TAC THENL + [ALL_TAC; MESON_TAC[LN_MONO_LT; REAL_LT_TRANS]] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH_RULE `0 < r <=> 1 <= r`; + ARITH_RULE `~(r = 0) <=> 1 <= r`]; + ALL_TAC] THEN + REWRITE_TAC[SUM_SUB] THEN + REWRITE_TAC[GSYM(SPECL [`f:num->real`; `m:num`; `1`] SUM_REINDEX)] THEN + ONCE_REWRITE_TAC[SUM_DIFF] THEN + REWRITE_TAC[ARITH; SUM_2; SUM_1; LN_1; REAL_ADD_RID] THEN + ONCE_REWRITE_TAC[ARITH_RULE `2 + n = SUC(1 + n)`] THEN + REWRITE_TAC[sum; ADD_CLAUSES] THEN + REWRITE_TAC[ADD_AC] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - c - (a - c) = b`; REAL_LE_REFL]; + ALL_TAC] THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + ASM_REWRITE_TAC[ADD1; LN_FACT]);; + +(* ------------------------------------------------------------------------- *) +(* Some extra number-theoretic odds and ends are useful. *) +(* ------------------------------------------------------------------------- *) + +let primepow = new_definition + `primepow q <=> ?p k. 1 <= k /\ prime p /\ (q = p EXP k)`;; + +let aprimedivisor = new_definition + `aprimedivisor q = @p. prime p /\ p divides q`;; + +let PRIMEPOW_GE_2 = prove + (`!q. primepow q ==> 2 <= q`, + REWRITE_TAC[primepow; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`q:num`; `p:num`; `k:num`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p:num` THEN + ASM_SIMP_TAC[PRIME_GE_2] THEN GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN + REWRITE_TAC[LE_EXP] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]);; + +let PRIMEPOW_0 = prove + (`~(primepow 0)`, + MESON_TAC[NUM_REDUCE_CONV `2 <= 0`; PRIMEPOW_GE_2]);; + +let APRIMEDIVISOR_PRIMEPOW = prove + (`!p k. prime p /\ 1 <= k ==> (aprimedivisor(p EXP k) = p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aprimedivisor] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN + X_GEN_TAC `q:num` THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `1 <= k ==> (k = SUC(k - 1))`)) THEN + REWRITE_TAC[EXP] THEN + ASM_MESON_TAC[DIVIDES_REFL; DIVIDES_RMUL; PRIME_DIVEXP; PRIME_DIVPROD; + prime; PRIME_1]);; + +let APRIMEDIVISOR = prove + (`!n. ~(n = 1) ==> prime(aprimedivisor n) /\ (aprimedivisor n) divides n`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[aprimedivisor] THEN + CONV_TAC SELECT_CONV THEN ASM_SIMP_TAC[PRIME_FACTOR]);; + +let BIG_POWER_LEMMA = prove + (`!m n. 2 <= m ==> ?k. n <= m EXP k`, + REPEAT STRIP_TAC THEN EXISTS_TAC `SUC n` THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP (SUC n)` THEN + ASM_REWRITE_TAC[EXP_MONO_LE_SUC] THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; ARITH] THEN + UNDISCH_TAC `n <= 2 EXP SUC n` THEN REWRITE_TAC[EXP] THEN + MP_TAC(SPECL [`2:num`; `n:num`] EXP_EQ_0) THEN + REWRITE_TAC[ARITH] THEN SPEC_TAC(`2 EXP n`,`m:num`) THEN ARITH_TAC);; + +let PRIME_PRIMEPOW = prove + (`!p. prime p ==> primepow p`, + MESON_TAC[prime; primepow; LE_REFL; EXP_1]);; + +(* ------------------------------------------------------------------------- *) +(* Derive Bezout-type identity by finding gcd. *) +(* ------------------------------------------------------------------------- *) + +let rec bezout (m,n) = + if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0) + else if m <=/ n then + let q = quo_num n m and r = mod_num n m in + let (x,y) = bezout(m,r) in + (x -/ q */ y,y) + else let (x,y) = bezout(n,m) in (y,x);; + +(* ------------------------------------------------------------------------- *) +(* Conversion for "primepow" applied to particular numeral. *) +(* ------------------------------------------------------------------------- *) + +let PRIMEPOW_CONV = + let pth0 = prove + (`primepow 0 <=> F`, + REWRITE_TAC[primepow] THEN MESON_TAC[EXP_EQ_0; PRIME_0]) + and pth1 = prove + (`primepow 1 <=> F`, + REWRITE_TAC[primepow] THEN + MESON_TAC[EXP_EQ_1; PRIME_1; NUM_REDUCE_CONV `1 <= 0`]) + and pth2 = prove + (`prime p ==> 1 <= k /\ (q = p EXP k) ==> (primepow q <=> T)`, + MESON_TAC[primepow]) + and pth3 = prove + (`(p * x = r * y + 1) /\ ~(p = 1) /\ ~(r = 1) /\ (q = p * r * d) + ==> (primepow q <=> F)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[primepow] THEN + DISCH_THEN(X_CHOOSE_THEN `P:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(SPEC `r:num` PRIME_FACTOR) THEN + MP_TAC(SPEC `p:num` PRIME_FACTOR) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `P_p:num` MP_TAC) THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d_p:num` SUBST_ALL_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `P_r:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d_r:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `P_p divides P /\ P_r divides P` ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `k:num` THEN + ASM_MESON_TAC[divides; MULT_AC]; ALL_TAC] THEN + SUBGOAL_THEN `(P_p = P) /\ (P_r = P:num)` (CONJUNCTS_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN + ASM_MESON_TAC[DIVIDES_ADD_REVR; divides; MULT_AC; DIVIDES_ONE; prime]) + and p_tm = `p:num` and k_tm = `k:num` and q_tm = `q:num` + and r_tm = `r:num` and d_tm = `d:num` + and x_tm = `x:num` and y_tm = `y:num` and primepow_tm = `primepow` in + fun tm0 -> + let ptm,tm = dest_comb tm0 in + if ptm <> primepow_tm then failwith "expected primepow(numeral)" else + let q = dest_numeral tm in + if q =/ Int 0 then pth0 + else if q =/ Int 1 then pth1 else + match factor q with + [] -> failwith "internal failure in PRIMEPOW_CONV" + | [p,k] -> let th1 = INST [mk_numeral q,q_tm; + mk_numeral p,p_tm; + mk_numeral k,k_tm] pth2 in + let th2 = MP th1 (EQT_ELIM(PRIME_CONV(lhand(concl th1)))) in + MP th2 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th2)))) + | (p,_)::(r,_)::_ -> + let d = q // (p */ r) in + let (x,y) = bezout(p,r) in + let p,r,x,y = + if x 1 <= k /\ (q = p EXP k) ==> (aprimedivisor q = p)`, + MESON_TAC[APRIMEDIVISOR_PRIMEPOW]) + and p_tm = `p:num` and k_tm = `k:num` and q_tm = `q:num` + and aprimedivisor_tm = `aprimedivisor` in + fun tm0 -> + let ptm,tm = dest_comb tm0 in + if ptm <> aprimedivisor_tm then failwith "expected primepow(numeral)" else + let q = dest_numeral tm in + if q =/ Int 0 then failwith "APRIMEDIVISOR_CONV: not a prime power" else + match factor q with + [p,k] -> let th1 = INST [mk_numeral q,q_tm; + mk_numeral p,p_tm; + mk_numeral k,k_tm] pth in + let th2 = MP th1 (EQT_ELIM(PRIME_CONV(lhand(concl th1)))) in + MP th2 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th2)))) + | _ -> failwith "APRIMEDIVISOR_CONV: not a prime power";; + +(* ------------------------------------------------------------------------- *) +(* The Mangoldt function. *) +(* ------------------------------------------------------------------------- *) + +let mangoldt = new_definition + `mangoldt d = if primepow d then ln(&(aprimedivisor d)) else &0`;; + +let MANGOLDT_POS = prove + (`!d. &0 <= mangoldt d`, + GEN_TAC THEN REWRITE_TAC[mangoldt] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + ASM_MESON_TAC[APRIMEDIVISOR_PRIMEPOW; ARITH_RULE `2 <= a ==> 1 <= a`; + PRIME_GE_2; LN_POS; REAL_OF_NUM_LE; primepow]);; + +(* ------------------------------------------------------------------------- *) +(* The key lemma. *) +(* ------------------------------------------------------------------------- *) + +let LN_PRIMEFACT = prove + (`!n. ~(n = 0) + ==> (ln(&n) = + sum(1,n) (\d. if primepow d /\ d divides n + then ln(&(aprimedivisor d)) else &0))`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 1` THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(1,n) (\d. &0)` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[SUM_0; LN_1]; ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[PRIMEPOW_GE_2; DIVIDES_LE; NUM_REDUCE_CONV `2 <= 1`; + LE_TRANS]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [divides] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[ARITH_RULE `m < p * m <=> 1 * m < p * m`] THEN + SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `1 < p <=> 2 <= p`] THEN + ASM_SIMP_TAC[PRIME_GE_2]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + ASM_SIMP_TAC[LN_MUL; REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `?k. 1 <= k /\ (p EXP k) divides (p * m)` MP_TAC THENL + [EXISTS_TAC `1` THEN SIMP_TAC[EXP_1; DIVIDES_RMUL; DIVIDES_REFL; LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `?k. !j. 1 <= j /\ (p EXP j) divides (p * m) ==> j <= k` + MP_TAC THENL + [MP_TAC(SPECL [`p:num`; `p * m:num`] BIG_POWER_LEMMA) THEN + ASM_SIMP_TAC[PRIME_GE_2] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[MULT_EQ_0] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LE] THEN + DISCH_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `p EXP k` THEN + ASM_REWRITE_TAC[LT_EXP] THEN ASM_SIMP_TAC[PRIME_GE_2]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + GEN_REWRITE_TAC LAND_CONV [num_MAX] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `sum (1,m) + (\d. if primepow d /\ d divides m then ln (&(aprimedivisor d)) else &0) = + sum (1,p * m) + (\d. if primepow d /\ d divides m then ln (&(aprimedivisor d)) else &0)` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SUM_DIFF] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `1 + p * m = (1 + m) + (p * m - m)` SUBST1_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `1 * y <= x ==> (1 + x = (1 + y) + (x - y))`) THEN + SIMP_TAC[LE_MULT_RCANCEL] THEN + ASM_MESON_TAC[PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 <= p`]; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SUM_TWO] THEN + MATCH_MP_TAC(REAL_ARITH `(b = &0) ==> (a = a + b)`) THEN + SUBGOAL_THEN + `!d. d >= 1 + m + ==> ((if primepow d /\ d divides m then ln (&(aprimedivisor d)) + else &0) = &0)` + MP_TAC THENL + [X_GEN_TAC `d:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(1 + m <= d /\ d <= m)`]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_ZERO) THEN DISCH_THEN MATCH_MP_TAC THEN + ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SUM_DIFF] THEN REWRITE_TAC[SUM_1] THEN + REWRITE_TAC[PRIMEPOW_0; REAL_SUB_RZERO] THEN + SUBGOAL_THEN `1 + p * m = p EXP k + 1 + (p * m - p EXP k)` SUBST1_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `k <= p ==> (1 + p = k + 1 + (p - k))`) THEN + ASM_MESON_TAC[DIVIDES_LE; MULT_EQ_0]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_TWO] THEN + MATCH_MP_TAC(REAL_ARITH + `(a = a') /\ (l + b = c) ==> (l + a + b = a' + c)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN STRIP_TAC THEN + ASM_CASES_TAC `primepow d` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `d divides (p * m) <=> d divides m` + (fun th -> REWRITE_TAC[th]) THEN + UNDISCH_TAC `primepow d` THEN REWRITE_TAC[primepow] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN ASM_CASES_TAC `q = p:num` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> (a <=> b)`) THEN + REWRITE_TAC[DIVIDES_LMUL] THEN + MATCH_MP_TAC DIVIDES_TRANS THEN + EXISTS_TAC `p EXP (k - 1)` THEN CONJ_TAC THENL + [REWRITE_TAC[divides] THEN EXISTS_TAC `p EXP ((k - 1) - j)` THEN + REWRITE_TAC[GSYM EXP_ADD] THEN AP_TERM_TAC THEN + UNDISCH_TAC `p EXP j < p EXP k` THEN ASM_REWRITE_TAC[LT_EXP] THEN + ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `p EXP k divides (p * m)` THEN + FIRST_ASSUM((fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) + [th]) o MATCH_MP + (ARITH_RULE `1 <= k ==> (k = SUC(k - 1))`)) THEN + REWRITE_TAC[divides; EXP] THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EQ_TAC THEN REWRITE_TAC[DIVIDES_LMUL] THEN + REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + MP_TAC(AP_TERM `(divides) p` th)) THEN + SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN DISCH_TAC THEN + SUBGOAL_THEN `p divides (q EXP j) \/ p divides r` MP_TAC THENL + [ASM_MESON_TAC[PRIME_DIVPROD]; ALL_TAC] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [SUBGOAL_THEN `p divides q` MP_TAC THENL + [ASM_MESON_TAC[PRIME_DIVEXP]; ALL_TAC] THEN + ASM_MESON_TAC[prime; PRIME_1]; + ALL_TAC] THEN + UNDISCH_TAC `p * m = q EXP j * r` THEN + UNDISCH_TAC `p divides r` THEN + REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c:num`] THEN + SIMP_TAC[EQ_MULT_LCANCEL] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN REWRITE_TAC[SUM_1] THEN + REWRITE_TAC[REAL_ADD_ASSOC] THEN BINOP_TAC THENL + [SUBGOAL_THEN `primepow (p EXP k)` ASSUME_TAC THENL + [ASM_MESON_TAC[primepow]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~((p EXP k) divides m)` ASSUME_TAC THENL + [REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + MP_TAC(ARITH_RULE `~(k + 1 <= k)`) THEN REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ARITH_RULE `1 <= k + 1`] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[EXP_ADD; EXP_1] THEN + MESON_TAC[MULT_ASSOC; DIVIDES_REFL; DIVIDES_RMUL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ADD_RID] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_MESON_TAC[APRIMEDIVISOR_PRIMEPOW]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN STRIP_TAC THEN + ASM_CASES_TAC `primepow d` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `d divides (p * m) <=> d divides m` + (fun th -> REWRITE_TAC[th]) THEN + UNDISCH_TAC `primepow d` THEN REWRITE_TAC[primepow] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_CASES_TAC `q = p:num` THENL + [UNDISCH_THEN `q = p:num` SUBST_ALL_TAC THEN + DISCH_THEN SUBST_ALL_TAC THEN + MATCH_MP_TAC(TAUT `(b ==> a) /\ ~a ==> (a <=> b)`) THEN + REWRITE_TAC[DIVIDES_LMUL] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a + 1 <= b ==> a < b`)) THEN + REWRITE_TAC[LT_EXP] THEN ASM_SIMP_TAC[PRIME_GE_2; NOT_LT]; + ALL_TAC] THEN + DISCH_THEN SUBST_ALL_TAC THEN EQ_TAC THEN REWRITE_TAC[DIVIDES_LMUL] THEN + REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_THEN `r:num` MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + MP_TAC(AP_TERM `(divides) p` th)) THEN + SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN DISCH_TAC THEN + SUBGOAL_THEN `p divides (q EXP j) \/ p divides r` MP_TAC THENL + [ASM_MESON_TAC[PRIME_DIVPROD]; ALL_TAC] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [SUBGOAL_THEN `p divides q` MP_TAC THENL + [ASM_MESON_TAC[PRIME_DIVEXP]; ALL_TAC] THEN + ASM_MESON_TAC[prime; PRIME_1]; + ALL_TAC] THEN + UNDISCH_TAC `p * m = q EXP j * r` THEN + UNDISCH_TAC `p divides r` THEN + REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c:num`] THEN + SIMP_TAC[EQ_MULT_LCANCEL] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The key expansion using the Mangoldt function. *) +(* ------------------------------------------------------------------------- *) + +let MANGOLDT = prove + (`!n. ln(&(FACT n)) = sum(1,n) (\d. mangoldt(d) * floor(&n / &d))`, + GEN_TAC THEN REWRITE_TAC[LN_FACT] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum(1,n) (\m. sum(1,n) (\d. if primepow d /\ d divides m + then ln (&(aprimedivisor d)) + else &0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[LN_PRIMEFACT; ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `d < n + 1 ==> (n = d + (n - d))`)) THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[GSYM SUM_SPLIT] THEN + REWRITE_TAC[REAL_ARITH `(a = a + b) <=> (b = &0)`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(1 + d,n - d) (\k. &0)` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE + `1 <= d /\ 1 + d <= r /\ (r <= d \/ (d = 0)) ==> F`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SUM_SWAP] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[mangoldt] THEN + ASM_CASES_TAC `primepow d` THEN ASM_REWRITE_TAC[SUM_0; REAL_MUL_LZERO] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 <= d ==> ~(d = 0)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVISION) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + MAP_EVERY ABBREV_TAC [`q = n DIV d`; `r = n MOD d`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `floor (&(q * d + r) / &d) = &q` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN + REWRITE_TAC[INTEGER_CLOSED] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; + REAL_OF_NUM_LT; ARITH_RULE `0 < d <=> 1 <= d`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `r < d:num` THEN ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN + MATCH_MP_TAC(REAL_ARITH `(b = &0) /\ (a = c) ==> (a + b = c)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1 + q * d,r) (\x. &0)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[] THEN + X_GEN_TAC `s:num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `d divides s` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `1 + x <= y * z ==> x < z * y`)) THEN + ASM_SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `1 <= d ==> ~(d = 0)`] THEN + REWRITE_TAC[LT_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `d * (q + SUC e) < r + 1 + q * d` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_CLAUSES; GSYM ADD_ASSOC] THEN + REWRITE_TAC[ARITH_RULE `d * q + x < y + 1 + q * d <=> x <= y`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `a + b <= c ==> a <= c:num`)) THEN + ASM_REWRITE_TAC[NOT_LE]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SUM_DIFF] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM SUM_TWO] THEN + SIMP_TAC[SUM_1; DIVIDES_0; DIVIDES_LMUL; DIVIDES_REFL] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - b = a`] THEN + REWRITE_TAC[GSYM SUM_GROUP] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(0,q) (\x. ln (&(aprimedivisor d)))` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUM_CONST; REAL_MUL_AC]] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `1 <= d ==> (d = 1 + (d - 1))`)) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (funpow 2 LAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN + SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN + MATCH_MP_TAC(REAL_ARITH `(b = &0) ==> (a + b = a)`) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(m * d + 1,d - 1) (\x. &0)` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:num` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(d divides (t + 1))` MP_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + UNDISCH_TAC `t + m * d + 1 < d - 1 + m * d + 1` THEN + REWRITE_TAC[LT_ADD_RCANCEL] THEN + UNDISCH_TAC `d divides (t + m * d + 1)` THEN + ASM_CASES_TAC `t = 0` THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL + [ASM_MESON_TAC[DIVIDES_REFL; DIVIDES_LMUL; DIVIDES_ADD_REVR; + DIVIDES_ONE; PRIMEPOW_GE_2; NUM_REDUCE_CONV `2 <= 1`]; + DISCH_TAC THEN ARITH_TAC]; + ALL_TAC] THEN + UNDISCH_TAC `d divides (t + m * d + 1)` THEN + ONCE_REWRITE_TAC[ARITH_RULE `t + m * d + 1 = (t + 1) + m * d`] THEN + MESON_TAC[DIVIDES_REFL; DIVIDES_LMUL; DIVIDES_ADD_REVL]);; + +(* ------------------------------------------------------------------------- *) +(* The Chebyshev psi function. *) +(* ------------------------------------------------------------------------- *) + +let psi = new_definition + `psi(n) = sum(1,n) (\d. mangoldt(d))`;; + +(* ------------------------------------------------------------------------- *) +(* The key bounds on the psi function. *) +(* ------------------------------------------------------------------------- *) + +let PSI_BOUNDS_LN_FACT = prove + (`!n. ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2))) <= psi(n) /\ + psi(n) - psi(n DIV 2) <= ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2)))`, + X_GEN_TAC `k:num` THEN MP_TAC(SPECL [`k:num`; `2`] DIVISION) THEN + REWRITE_TAC[ARITH_EQ] THEN + MAP_EVERY ABBREV_TAC [`n = k DIV 2`; `d = k MOD 2`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC) THEN + REWRITE_TAC[psi; MANGOLDT] THEN + SUBGOAL_THEN + `sum (1,n) (\d. mangoldt d * floor (&n / &d)) = + sum (1,2 * n + d) (\d. mangoldt d * floor (&n / &d))` + SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `2 * n + d = n + (n + d)`] THEN + ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN + REWRITE_TAC[REAL_ARITH `(a = a + b) <=> (b = &0)`] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(1 + n,n + d) (\k. &0)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[FLOOR_EQ_0] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE + `1 + n <= r ==> 0 < r`)) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `1 + n <= r` THEN ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_CMUL; GSYM SUM_SUB] THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `m * f - &2 * m * f' = m * (f - &2 * f')`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MANGOLDT_POS] THEN + MATCH_MP_TAC(REAL_ARITH + `&2 * a <= b /\ b <= &2 * a + &1 + ==> b - &2 * a <= &1`) THEN + ASM_SIMP_TAC[FLOOR_DOUBLE_NUM; ARITH_RULE `0 < r <=> 1 <= r`]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum(1,2 * n + d) (\d. mangoldt d) - sum(1,n) (\d. mangoldt d) = + sum(1,2 * n + d) (\d. if d <= n then &0 else mangoldt d)` + SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `2 * n + d = n + (n + d)`] THEN + ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN + MATCH_MP_TAC(REAL_ARITH + `(c = &0) /\ (b = d) ==> ((a + b) - a = c + d)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(1,n) (\k. &0)` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[ARITH_RULE `r < n + 1 <=> r <= n`]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[ARITH_RULE `1 + n <= r ==> ~(r <= n)`]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_CMUL; GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `m * a - &2 * m * b = m * (a - &2 * b)`] THEN + COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[MANGOLDT_POS] THEN + ASM_SIMP_TAC[REAL_SUB_LE; FLOOR_DOUBLE_NUM; ARITH_RULE `0 < r <=> 1 <= r`]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `a = a * &1`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MANGOLDT_POS] THEN + MATCH_MP_TAC(REAL_ARITH `(b = &0) /\ &1 <= a ==> &1 <= a - &2 * b`) THEN + CONJ_TAC THENL + [REWRITE_TAC[FLOOR_EQ_0] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < r <=> 1 <= r`] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_POS] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_REWRITE_TAC[GSYM NOT_LE]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `(a = &1) ==> &1 <= a`) THEN + REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < r <=> 1 <= r`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_MUL; + REAL_OF_NUM_ADD] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Map the middle term into multiples of log(n). *) +(* ------------------------------------------------------------------------- *) + +let LN_FACT_DIFF_BOUNDS = prove + (`!n. abs((ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2)))) - &n * ln(&2)) + <= &4 * ln(if n = 0 then &1 else &n) + &3`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[FACT; MULT_CLAUSES; LN_1; DIV_0; ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN ASM_REWRITE_TAC[ARITH_EQ] THEN + MAP_EVERY ABBREV_TAC [`q = n DIV 2`; `r = n MOD 2`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_CASES_TAC `q = 0` THENL + [UNDISCH_TAC `~(q * 2 + r = 0)` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + ASM_SIMP_TAC[ARITH_RULE `r < 2 ==> ((r = 0) <=> ~(r = 1))`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[num_CONV `1`; FACT; MULT_CLAUSES] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LN_1] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_SUB_RZERO] THEN + REWRITE_TAC[REAL_NEG_0; REAL_SUB_LZERO; REAL_ADD_LID; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_NEG] THEN + MATCH_MP_TAC(REAL_ARITH `x <= &2 ==> x <= &3`) THEN + SUBST1_TAC(REAL_ARITH `&2 = &1 + &1`) THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= &1 ==> abs(x) <= &1 + &1`) THEN + ASM_SIMP_TAC[LN_POS; LN_LE; REAL_OF_NUM_LE; ARITH; REAL_LE_ADDL]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!a'. abs((a' - b) - c) <= d - abs(a' - a) ==> abs((a - b) - c) <= d`) THEN + EXISTS_TAC `ln(&(FACT(q * 2)))` THEN + MP_TAC(SPEC `q:num` LN_FACT_BOUNDS) THEN + MP_TAC(SPEC `q * 2` LN_FACT_BOUNDS) THEN + ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(a - (a2 - &2 * a1)) <= b - &2 * b1 - b2 + ==> abs(l2 - a2) <= b2 + ==> abs(l1 - a1) <= b1 + ==> abs((l2 - &2 * l1) - a) <= b`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + ASM_SIMP_TAC[LN_MUL; REAL_OF_NUM_LT; ARITH; + ARITH_RULE `0 < q <=> ~(q = 0)`] THEN + REWRITE_TAC[REAL_ARITH + `(q * &2 + r) * l2 - ((q * &2) * (lq + l2) - q * &2 - &2 * (q * lq - q)) = + r * l2`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `x <= a - b - c - d <=> x + b <= a - c - d`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `ln(&2) + ln(&q * &2 + &r)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 * y ==> abs(x) <= y`) THEN + SIMP_TAC[LN_POS_LT; REAL_LT_IMP_LE; REAL_LE_RMUL_EQ; + REAL_LE_MUL; REAL_POS; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN UNDISCH_TAC `r < 2` THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (ARITH_RULE + `r < 2 ==> (r = 0) \/ (r = 1)`)) + THENL + [REWRITE_TAC[ADD_CLAUSES; REAL_SUB_REFL; REAL_ADD_RID; REAL_ABS_NUM] THEN + MATCH_MP_TAC LN_POS THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_MUL] THEN + UNDISCH_TAC `~(q = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM ADD1; FACT] THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL; LN_MUL; REAL_OF_NUM_LT; + FACT_LT; LT_0] THEN + REWRITE_TAC[REAL_ARITH `abs(b - (a + b)) = abs a`] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(x) <= x`) THEN + MATCH_MP_TAC LN_POS THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `l2 + lnn <= (&4 * lnn + &3) - a - b + <=> a + b + l2 <= &3 * lnn + &3`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&3 * ln(&q * &2) + &3` THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH] THEN + ASM_SIMP_TAC[LN_MONO_LE; REAL_POS; REAL_OF_NUM_LT; + ARITH_RULE `0 < q <=> ~(q = 0)`; + REAL_ARITH `&0 < q /\ &0 <= r ==> &0 < q * &2 + r`; + REAL_ARITH `&0 < q ==> &0 < q * &2`] THEN + REWRITE_TAC[REAL_LE_ADDR; REAL_POS]] THEN + ASM_SIMP_TAC[LN_MUL; REAL_OF_NUM_LT; ARITH; + ARITH_RULE `0 < q <=> ~(q = 0)`] THEN + SUBGOAL_THEN `&0 <= ln(&2)` (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + MATCH_MP_TAC LN_POS THEN REWRITE_TAC[REAL_OF_NUM_LE; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Hence overall bounds in terms of n * log(2) + constant. *) +(* ------------------------------------------------------------------------- *) + +let PSI_BOUNDS_INDUCT = prove + (`!n. &n * ln(&2) - (&4 * ln (if n = 0 then &1 else &n) + &3) <= psi(n) /\ + psi(n) - psi(n DIV 2) + <= &n * ln(&2) + (&4 * ln (if n = 0 then &1 else &n) + &3)`, + MESON_TAC[PSI_BOUNDS_LN_FACT; LN_FACT_DIFF_BOUNDS; REAL_ARITH + `m <= a /\ b <= m /\ abs(m - n) <= k + ==> n - k <= a /\ b <= n + k`]);; + +(* ------------------------------------------------------------------------- *) +(* Evaluation of mangoldt(numeral). *) +(* ------------------------------------------------------------------------- *) + +let MANGOLDT_CONV = + GEN_REWRITE_CONV I [mangoldt] THENC + RATOR_CONV(LAND_CONV PRIMEPOW_CONV) THENC + GEN_REWRITE_CONV I [COND_CLAUSES] THENC + TRY_CONV(funpow 2 RAND_CONV APRIMEDIVISOR_CONV);; + +(* ------------------------------------------------------------------------- *) +(* More efficient version without two primality tests. *) +(* ------------------------------------------------------------------------- *) + +let MANGOLDT_CONV = + let pth0 = prove + (`mangoldt 0 = ln(&1)`, + REWRITE_TAC[mangoldt; primepow; LN_1] THEN + COND_CASES_TAC THEN ASM_MESON_TAC[EXP_EQ_0; PRIME_0]) + and pth1 = prove + (`mangoldt 1 = ln(&1)`, + REWRITE_TAC[mangoldt; primepow; LN_1] THEN COND_CASES_TAC THEN + ASM_MESON_TAC[EXP_EQ_1; PRIME_1; NUM_REDUCE_CONV `1 <= 0`]) + and pth2 = prove + (`prime p ==> 1 <= k /\ (q = p EXP k) ==> (mangoldt q = ln(&p))`, + SIMP_TAC[mangoldt; APRIMEDIVISOR_PRIMEPOW] THEN + COND_CASES_TAC THEN ASM_MESON_TAC[primepow]) + and pth3 = prove + (`(p * x = r * y + 1) /\ ~(p = 1) /\ ~(r = 1) /\ (q = p * r * d) + ==> (mangoldt q = ln(&1))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(primepow q)` + (fun th -> REWRITE_TAC[LN_1; th; mangoldt]) THEN + REWRITE_TAC[primepow] THEN + DISCH_THEN(X_CHOOSE_THEN `P:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(SPEC `r:num` PRIME_FACTOR) THEN + MP_TAC(SPEC `p:num` PRIME_FACTOR) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `P_p:num` MP_TAC) THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d_p:num` SUBST_ALL_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `P_r:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d_r:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `P_p divides P /\ P_r divides P` ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `k:num` THEN + ASM_MESON_TAC[divides; MULT_AC]; ALL_TAC] THEN + SUBGOAL_THEN `(P_p = P) /\ (P_r = P:num)` (CONJUNCTS_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[prime]; ALL_TAC] THEN + ASM_MESON_TAC[DIVIDES_ADD_REVR; divides; MULT_AC; DIVIDES_ONE; prime]) + and p_tm = `p:num` and k_tm = `k:num` and q_tm = `q:num` + and r_tm = `r:num` and d_tm = `d:num` + and x_tm = `x:num` and y_tm = `y:num` and mangoldt_tm = `mangoldt` in + fun tm0 -> + let ptm,tm = dest_comb tm0 in + if ptm <> mangoldt_tm then failwith "expected mangoldt(numeral)" else + let q = dest_numeral tm in + if q =/ Int 0 then pth0 + else if q =/ Int 1 then pth1 else + match factor q with + [] -> failwith "internal failure in MANGOLDT_CONV" + | [p,k] -> let th1 = INST [mk_numeral q,q_tm; + mk_numeral p,p_tm; + mk_numeral k,k_tm] pth2 in + let th2 = MP th1 (EQT_ELIM(PRIME_CONV(lhand(concl th1)))) in + MP th2 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th2)))) + | (p,_)::(r,_)::_ -> + let d = q // (p */ r) in + let (x,y) = bezout(p,r) in + let p,r,x,y = + if x psi(n) <= &133 / &128 * &n`, + let lemma = prove + (`a <= b /\ l <= a /\ rest ==> l <= a /\ l <= b /\ rest`, + MESON_TAC[REAL_LE_TRANS]) + and tac = time (CONV_TAC(LAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in + REWRITE_TAC[ARITH_RULE `n <= 128 <=> n < 129`] THEN + CONV_TAC EXPAND_CASES_CONV THEN REWRITE_TAC(PSI_LIST_300) THEN + REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REPEAT + ((MATCH_MP_TAC lemma THEN + CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN + GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) + ORELSE + (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) + ORELSE tac));; + +(* ------------------------------------------------------------------------- *) +(* As a multiple of log(2) is often more useful. *) +(* ------------------------------------------------------------------------- *) + +let PSI_UBOUND_128_LOG = prove + (`!n. n <= 128 ==> psi(n) <= (&3 / &2 * ln(&2)) * &n`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PSI_UBOUND_128) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV THENC REALCALC_REL_CONV));; + +(* ------------------------------------------------------------------------- *) +(* Useful "overpowering" lemma. *) +(* ------------------------------------------------------------------------- *) + +let OVERPOWER_LEMMA = prove + (`!f g d a. + f(a) <= g(a) /\ + (!x. a <= x ==> ((\x. g(x) - f(x)) diffl (d(x)))(x)) /\ + (!x. a <= x ==> &0 <= d(x)) + ==> !x. a <= x ==> f(x) <= g(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. g(x) - f(x)`; `d:real->real`; `a:real`; `x:real`] + MVT_ALT) THEN + UNDISCH_TAC `a <= x` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `x:real = a` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `fa <= ga /\ &0 <= d ==> (gx - fx - (ga - fa) = d) ==> fx <= gx`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Repeatedly extend range of explicit cases using recurrence. *) +(* ------------------------------------------------------------------------- *) + +let DOUBLE_CASES_RULE th = + let bod = snd(dest_forall(concl th)) in + let ant,cons = dest_imp bod in + let m = dest_numeral (rand ant) + and c = rat_of_term (lhand(lhand(rand cons))) in + let x = float_of_num(m +/ Int 1) in + let d = (4.0 *. log x +. 3.0) /. (x *. log 2.0) in + let c' = c // Int 2 +/ Int 1 +/ + (floor_num(num_of_float(1024.0 *. d)) +/ Int 2) // Int 1024 in + let c'' = max_num c c' in + let tm = mk_forall + (`n:num`, + subst [mk_numeral(Int 2 */ m),rand ant; + term_of_rat c'',lhand(lhand(rand cons))] bod) in + prove(tm, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC (mk_comb(`(<=) (n:num)`,mk_numeral m)) THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP th) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC LN_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `n:num` PSI_BOUNDS_INDUCT) THEN + SUBGOAL_THEN `~(n = 0)` (fun th -> REWRITE_TAC[th]) THENL + [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `pn2 <= ((a - &1) * l2) * n - logtm + ==> u <= v /\ pn - pn2 <= n * l2 + logtm ==> pn <= (a * l2) * n`) THEN + MP_TAC(SPEC `n DIV 2` th) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[LE_LDIV_EQ; ARITH] THEN + FIRST_ASSUM(UNDISCH_TAC o check ((not) o is_neg) o concl) THEN + ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + W(fun (asl,w) -> + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC(mk_comb(rator(lhand w),`&n / &2`))) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC LN_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_div] THEN + MATCH_MP_TAC(REAL_ARITH + `logtm <= ((c - a * b) * l2) * n + ==> (a * l2) * n * b <= (c * l2) * n - logtm`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBST1_TAC(REAL_ARITH `&n = &1 + (&n - &1)`) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `~(n <= b) ==> b + 1 <= n`)) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_OF_NUM_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `a <= n ==> a - &1 <= n - &1`)) THEN + ABBREV_TAC `x = &n - &1` THEN + CONV_TAC(LAND_CONV NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) THEN + SPEC_TAC(`x:real`,`x:real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MATCH_MP_TAC OVERPOWER_LEMMA THEN + W(fun (asl,w) -> + let th = DIFF_CONV + (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in + MP_TAC th) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; + REAL_MUL_RID; REAL_MUL_LID] THEN + W(fun (asl,w) -> + let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in + DISCH_TAC THEN EXISTS_TAC tm) THEN + CONJ_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_sub] THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= x ==> inv(&1 + x) <= inv(&1 + a) /\ + inv(&1 + a) <= b ==> inv(&1 + x) <= b`)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Bring it to the self-sustaining point. *) +(* ------------------------------------------------------------------------- *) + +let PSI_UBOUND_1024_LOG = funpow 3 DOUBLE_CASES_RULE PSI_UBOUND_128_LOG;; + +(* ------------------------------------------------------------------------- *) +(* A generic proof of the same kind that we're self-sustaining. *) +(* ------------------------------------------------------------------------- *) + +let PSI_BOUNDS_SUSTAINED_INDUCT = prove + (`&4 * ln(&1 + &2 pow j) + &3 <= (d * ln(&2)) * (&1 + &2 pow j) /\ + &4 / (&1 + &2 pow j) <= d * ln(&2) /\ &0 <= c /\ c / &2 + d + &1 <= c + ==> !k. j <= k /\ + (!n. n <= 2 EXP k ==> psi(n) <= (c * ln(&2)) * &n) + ==> !n. n <= 2 EXP (SUC k) ==> psi(n) <= (c * ln(&2)) * &n`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n <= 2 EXP k` THEN ASM_SIMP_TAC[] THEN + MP_TAC(SPEC `n:num` PSI_BOUNDS_INDUCT) THEN + SUBGOAL_THEN `~(n = 0)` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC(ARITH_RULE `!a. ~(a = 0) /\ ~(n <= a) ==> ~(n = 0)`) THEN + EXISTS_TAC `2 EXP k` THEN ASM_REWRITE_TAC[EXP_EQ_0; ARITH_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `pn2 <= ((a - &1) * l2) * n - logtm + ==> u <= v /\ pn - pn2 <= n * l2 + logtm ==> pn <= (a * l2) * n`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 2`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[LE_LDIV_EQ; ARITH] THEN + MATCH_MP_TAC(ARITH_RULE `n <= 2 * k ==> n < 2 * (k + 1)`) THEN + ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + W(fun (asl,w) -> + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC(mk_comb(rator(lhand w),`&n / &2`))) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LN_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_div] THEN + MATCH_MP_TAC(REAL_ARITH + `logtm <= ((c - a * b) * l2) * n + ==> (a * l2) * n * b <= (c * l2) * n - logtm`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d * ln (&2)) * &n` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[LN_POS; REAL_OF_NUM_LE; ARITH] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_REWRITE_TAC[REAL_ARITH `d <= c - &1 - c2 <=> c2 + d + &1 <= c`]] THEN + SUBST1_TAC(REAL_ARITH `&n = &1 + (&n - &1)`) THEN + SUBGOAL_THEN `&2 pow j <= &n - &1` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow k` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `~(n <= b) ==> b + 1 <= n`)) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_OF_NUM_LE] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `x = &n - &1` THEN SPEC_TAC(`x:real`,`x:real`) THEN + MATCH_MP_TAC OVERPOWER_LEMMA THEN + W(fun (asl,w) -> + let th = DIFF_CONV + (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in + MP_TAC th) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; + REAL_MUL_RID; REAL_MUL_LID] THEN + W(fun (asl,w) -> + let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in + DISCH_TAC THEN EXISTS_TAC tm) THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC(REAL_ARITH `&0 < a ==> a <= x ==> &0 < &1 + x`) THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= x ==> inv(&1 + x) <= inv(&1 + a) /\ + inv(&1 + a) <= b ==> inv(&1 + x) <= b`)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LE_LADD] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_ARITH + `&0 < x ==> &0 < &1 + x`]; + ALL_TAC] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + ASM_REWRITE_TAC[GSYM real_div]);; + +let PSI_BOUNDS_SUSTAINED = prove + (`(!n. n <= 2 EXP k ==> psi(n) <= (c * ln(&2)) * &n) + ==> &4 * ln(&1 + &2 pow k) + &3 + <= ((c / &2 - &1) * ln(&2)) * (&1 + &2 pow k) /\ + &4 / (&1 + &2 pow k) <= (c / &2 - &1) * ln(&2) /\ &0 <= c + ==> !n. psi(n) <= (c * ln(&2)) * &n`, + let lemma = prove + (`c / &2 + (c / &2 - &1) + &1 <= c`, + REWRITE_TAC[REAL_ARITH `c2 + (c2 - &1) + &1 = &2 * c2`] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ; REAL_LE_REFL]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o C CONJ lemma) THEN + ABBREV_TAC `d = c / &2 - &1` THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP PSI_BOUNDS_SUSTAINED_INDUCT) THEN + X_GEN_TAC `m:num` THEN + SUBGOAL_THEN `?j. m <= 2 EXP j` MP_TAC THENL + [EXISTS_TAC `m:num` THEN SPEC_TAC(`m:num`,`m:num`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[EXP] THEN MATCH_MP_TAC(ARITH_RULE + `~(a = 0) /\ m <= a ==> SUC m <= 2 * a`) THEN + ASM_REWRITE_TAC[EXP_EQ_0; ARITH_EQ]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`m:num`,`m:num`) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP 0` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[LE_EXP; ARITH_EQ; LE_0]; + ALL_TAC] THEN + ASM_CASES_TAC `k <= j:num` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `2 EXP (SUC j) <= 2 EXP k` + (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN + ASM_REWRITE_TAC[LE_EXP; ARITH] THEN + UNDISCH_TAC `~(k <= j:num)` THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Now apply it and get our reasonable bound. *) +(* ------------------------------------------------------------------------- *) + +let PSI_UBOUND_LOG = prove + (`!n. psi(n) <= (&4407 / &2048 * ln (&2)) * &n`, + MP_TAC PSI_UBOUND_1024_LOG THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 EXP 10`)) THEN + DISCH_THEN(MATCH_MP_TAC o MATCH_MP PSI_BOUNDS_SUSTAINED) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONJ_TAC THEN CONV_TAC REALCALC_REL_CONV);; + +let PSI_UBOUND_3_2 = prove + (`!n. psi(n) <= &3 / &2 * &n`, + GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&4407 / &2048 * ln (&2)) * &n` THEN + REWRITE_TAC[PSI_UBOUND_LOG] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONV_TAC REALCALC_REL_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Now get a lower bound. *) +(* ------------------------------------------------------------------------- *) + +let PSI_LBOUND_3_5 = prove + (`!n. 4 <= n ==> &3 / &5 * &n <= psi(n)`, + let lemma = prove + (`a <= b /\ b <= l /\ rest ==> a <= l /\ b <= l /\ rest`, + MESON_TAC[REAL_LE_TRANS]) + and tac = time (CONV_TAC(RAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in + GEN_TAC THEN ASM_CASES_TAC `n < 300` THENL + [POP_ASSUM MP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + CONV_TAC EXPAND_CASES_CONV THEN + REWRITE_TAC(PSI_LIST_300) THEN + REWRITE_TAC[LN_1; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REPEAT + ((MATCH_MP_TAC lemma THEN + CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN + GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) + ORELSE + (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) + ORELSE tac); + ALL_TAC] THEN + DISCH_THEN(K ALL_TAC) THEN + MP_TAC(CONJUNCT1 (SPEC `n:num` PSI_BOUNDS_INDUCT)) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= x ==> a <= x`) THEN + ASM_SIMP_TAC[ARITH_RULE `~(n < 300) ==> ~(n = 0)`] THEN + MATCH_MP_TAC(REAL_ARITH `c <= n * (b - a) ==> a * n <= n * b - c`) THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &11 * &n` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[real_sub] THEN CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONV_TAC REALCALC_REL_CONV] THEN + ABBREV_TAC `x = &n - &1` THEN + SUBGOAL_THEN `&n = &1 + x` SUBST1_TAC THENL + [EXPAND_TAC "x" THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&299 <= x` MP_TAC THENL + [EXPAND_TAC "x" THEN REWRITE_TAC[REAL_LE_SUB_LADD] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; ARITH] THEN + UNDISCH_TAC `~(n < 300)` THEN ARITH_TAC; + ALL_TAC] THEN + SPEC_TAC(`x:real`,`x:real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MATCH_MP_TAC OVERPOWER_LEMMA THEN + W(fun (asl,w) -> + let th = DIFF_CONV + (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in + MP_TAC th) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; + REAL_MUL_RID; REAL_MUL_LID] THEN + W(fun (asl,w) -> + let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in + DISCH_TAC THEN EXISTS_TAC tm) THEN + CONJ_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_LE] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&1 + &299)` THEN CONJ_TAC THENL + [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* Now the related theta function. *) +(* ========================================================================= *) + +let theta = new_definition + `theta(n) = sum(1,n) (\p. if prime p then ln(&p) else &0)`;; + +(* ------------------------------------------------------------------------- *) +(* An optimized rule to give theta(n) for all n <= some N. *) +(* ------------------------------------------------------------------------- *) + +let THETA_LIST = + let THETA_0 = prove + (`theta(0) = ln(&1)`, + REWRITE_TAC[theta; sum; LN_1]) + and THETA_SUC = prove + (`theta(SUC n) = theta(n) + (if prime(SUC n) then ln(&(SUC n)) else &0)`, + REWRITE_TAC[theta; sum; ADD1] THEN REWRITE_TAC[ADD_AC]) + and n_tm = `n:num` + and SIMPER_CONV = + NUM_REDUCE_CONV THENC + ONCE_DEPTH_CONV PRIME_CONV THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV + [COND_CLAUSES; REAL_ADD_LID; REAL_ADD_RID] THENC + SIMP_CONV [GSYM LN_MUL; REAL_OF_NUM_MUL; REAL_OF_NUM_LT; ARITH] in + let rec THETA_LIST n = + if n = 0 then [THETA_0] else + let ths = THETA_LIST (n - 1) in + let th1 = INST [mk_small_numeral(n-1),n_tm] THETA_SUC in + let th2 = GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [hd ths] th1 in + CONV_RULE SIMPER_CONV th2::ths in + THETA_LIST;; + +(* ------------------------------------------------------------------------- *) +(* Split up the psi sum to show close relationship with theta. *) +(* ------------------------------------------------------------------------- *) + +let PRIMEPOW_ODD_EVEN = prove + (`!p q j k. + ~(prime(p) /\ prime(q) /\ 1 <= j /\ (p EXP (2 * j) = q EXP (2 * k + 1)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `q divides p` ASSUME_TAC THENL + [MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `2 * j` THEN + UNDISCH_TAC `p EXP (2 * j) = q EXP (2 * k + 1)` THEN + REWRITE_TAC[EXP_ADD; EXP_1] THEN + ASM_MESON_TAC[divides; MULT_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN `q = p:num` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[prime]; ALL_TAC] THEN + UNDISCH_TAC `p EXP (2 * j) = p EXP (2 * k + 1)` THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[LE_EXP] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `~(p = 1)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + REWRITE_TAC[LE_ANTISYM] THEN + DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN]);; + +let PSI_SPLIT = prove + (`psi(n) = theta(n) + + sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) + then ln(&(aprimedivisor d)) else &0) + + sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) + then ln(&(aprimedivisor d)) else &0)`, + REWRITE_TAC[psi; theta; GSYM SUM_ADD] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[mangoldt; primepow] THEN + ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP k)` THEN + ASM_REWRITE_TAC[] THENL + [ALL_TAC; + SUBGOAL_THEN `~(?p k. 1 <= k /\ prime p /\ (r = p EXP (2 * k))) /\ + ~(?p k. 1 <= k /\ prime p /\ (r = p EXP (2 * k + 1))) /\ + ~(prime r)` + (fun th -> REWRITE_TAC[th; REAL_ADD_LID]) THEN + ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k /\ 1 <= 2 * k + 1`; + EXP_1; LE_REFL]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `m:num` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(SPECL [`m:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN + MAP_EVERY ABBREV_TAC [`k = m DIV 2`; `d = m MOD 2`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW] THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP (ARITH_RULE + `d < 2 ==> (d = 0) \/ (d = 1)`)) THEN + ASM_REWRITE_TAC[PRIME_EXP; ADD_EQ_0; MULT_EQ_0; ARITH_EQ] THENL + [UNDISCH_TAC `1 <= k * 2 + 0` THEN REWRITE_TAC[ADD_CLAUSES] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[ARITH] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(k * 2 = 1)` (fun th -> REWRITE_TAC[th]) THENL + [DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; ARITH_EVEN]; ALL_TAC] THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]) THEN + ASM_MESON_TAC[PRIMEPOW_ODD_EVEN; MULT_SYM; + ARITH_RULE `~(k = 0) ==> 1 <= k`]; + ALL_TAC] THEN + ASM_CASES_TAC `k = 0` THENL + [MATCH_MP_TAC(REAL_ARITH + `(a = a') /\ (b = &0) /\ (c = &0) ==> (a = a' + b + c)`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[ARITH; EXP_1]; ALL_TAC] THEN + CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[PRIMEPOW_ODD_EVEN; MULT_SYM]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN STRIP_TAC THEN + SUBGOAL_THEN `q divides p` ASSUME_TAC THENL + [MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `k * 2 + 1` THEN + UNDISCH_TAC `p EXP (k * 2 + 1) = q EXP (2 * j + 1)` THEN + REWRITE_TAC[EXP_ADD; EXP_1] THEN + ASM_MESON_TAC[divides; MULT_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN `q = p:num` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[prime]; ALL_TAC] THEN + UNDISCH_TAC `p EXP (k * 2 + 1) = p EXP (2 * j + 1)` THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[LE_EXP] THEN + ASM_CASES_TAC `p = 0` THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `p = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[LE_ANTISYM] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= j ==> ~(1 = 2 * j + 1)`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `(k * 2 + 1 = 1) <=> (k = 0)`; ARITH_EQ] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]) THEN + ASM_MESON_TAC[PRIMEPOW_ODD_EVEN; MULT_SYM; ARITH_RULE + `~(k = 0) ==> 1 <= k`]);; + +(* ------------------------------------------------------------------------- *) +(* General lemma about sums. *) +(* ------------------------------------------------------------------------- *) + +let SUM_SURJECT = prove + (`!f i m n p q. + (!r. m <= r /\ r < m + n ==> &0 <= f(i r)) /\ + (!s. p <= s /\ s < p + q /\ ~(f(s) = &0) + ==> ?r. m <= r /\ r < m + n /\ (i r = s)) + ==> sum(p,q) f <= sum(m,n) (\r. f(i r))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m,n) (\r. if p:num <= i(r) /\ i(r) < p + q + then f(i(r)) else &0)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_MESON_TAC[REAL_LE_REFL; ADD_AC]] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SPEC_TAC(`q:num`,`q:num`) THEN INDUCT_TAC THENL + [STRIP_TAC THEN REWRITE_TAC[sum] THEN + REWRITE_TAC[ARITH_RULE `~(p <= q /\ q < p + 0)`] THEN + REWRITE_TAC[SUM_0; REAL_LE_REFL]; + ALL_TAC] THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN STRIP_ASSUME_TAC th) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[ARITH_RULE `s < p + q ==> s < p + SUC q`]; + ALL_TAC] THEN + REWRITE_TAC[sum] THEN + SUBGOAL_THEN + `sum(m,n) (\r. if p <= i r /\ i r < p + SUC q then f (i r) else &0) = + sum(m,n) (\r. if p <= i r /\ i r < p + q then f (i r) else &0) + + sum(m,n) (\r. if i r = p + q then f(i r) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(i:num->num) r = p + q` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[LE_ADD; LT_REFL; ARITH_RULE `p + q < p + SUC q`] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]; + ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE + `r < p + SUC q <=> (r = p + q) \/ r < p + q`] THEN + REWRITE_TAC[REAL_ADD_RID]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `f <= s'' ==> s <= s' ==> s + f <= s' + s''`) THEN + UNDISCH_TAC + `!s. p <= s /\ s < p + SUC q /\ ~(f s = &0) + ==> (?r:num. m <= r /\ r < m + n /\ (i r = s))` THEN + DISCH_THEN(MP_TAC o SPEC `p + q:num`) THEN + ASM_CASES_TAC `f(p + q:num) = &0` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m,n) (\r. &0)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[ADD_SYM]; + ALL_TAC] THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `n = (s - m) + 1 + ((m + n) - (s + 1))` SUBST1_TAC THENL + [MAP_EVERY UNDISCH_TAC [`m <= s:num`; `s < m + n:num`] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SPLIT] THEN + ASM_SIMP_TAC[SUM_1; ARITH_RULE `m <= s ==> (m + (s - m) = s:num)`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y ==> a <= x + a + y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m,s - m) (\r. &0)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN + MAP_EVERY UNDISCH_TAC + [`m <= r:num`; `r < s - m + m:num`; `s < m + n:num`; `m <= s:num`] THEN + ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(s + 1,(m + n) - (s + 1)) (\r. &0)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_0; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN + MAP_EVERY UNDISCH_TAC + [`r < (m + n) - (s + 1) + s + 1:num`; + `s + 1 <= r`; `s < m + n:num`; `m <= s:num`] THEN + ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Apply this to show that one of the residuals is bounded by the other. *) +(* ------------------------------------------------------------------------- *) + +let PSI_RESIDUES_COMPARE_2 = prove + (`sum(2,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) + then ln(&(aprimedivisor d)) else &0) + <= sum(2,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) + then ln(&(aprimedivisor d)) else &0)`, + MP_TAC(SPECL + [`\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) + then ln(&(aprimedivisor d)) else &0`; + `\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP k) + then d * (aprimedivisor d) else d`; + `2`; `n:num`; `2`; `n:num`] SUM_SURJECT) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `r:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP k)` THEN + ASM_REWRITE_TAC[] THENL + [ALL_TAC; + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k + 1`]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + SUBGOAL_THEN `p EXP k * p = p EXP (k + 1)` SUBST1_TAC THENL + [REWRITE_TAC[EXP_ADD; EXP_1; MULT_AC]; ALL_TAC] THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; ARITH_RULE `1 <= k + 1`] THEN + ASM_MESON_TAC[LN_POS; REAL_OF_NUM_LE; PRIME_GE_2; REAL_LE_REFL; + ARITH_RULE `2 <= n ==> 1 <= n`]; + ALL_TAC] THEN + X_GEN_TAC `s:num` THEN + ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (s = p EXP (2 * k + 1))` THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + EXISTS_TAC `p EXP (2 * k)` THEN + COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k`]] THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; EXP_ADD; EXP_1; + ARITH_RULE `1 <= k ==> 1 <= 2 * k`] THEN + CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `2 <= n <=> ~(n = 0) /\ ~(n = 1)`; + EXP_EQ_0; EXP_EQ_1] THEN + ASM_MESON_TAC[PRIME_1; PRIME_0; + ARITH_RULE `1 <= k ==> ~(2 * k = 0)`]; + ALL_TAC] THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `p EXP (2 * k + 1)` THEN + ASM_REWRITE_TAC[LE_EXP] THEN + COND_CASES_TAC THEN UNDISCH_TAC `1 <= k` THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP k)` THEN + ASM_REWRITE_TAC[] THENL + [ALL_TAC; + REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + ASM_MESON_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k /\ 1 <= 2 * k + 1`]] THEN + FIRST_X_ASSUM(CHOOSE_THEN (K ALL_TAC)) THEN + ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ (r = p EXP (2 * k))` THEN + ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; + ARITH_RULE `1 <= k ==> 1 <= 2 * k`] THEN + SUBGOAL_THEN `p EXP (2 * k) * p = p EXP (2 * k + 1)` SUBST1_TAC THENL + [REWRITE_TAC[EXP_ADD; EXP_1; MULT_AC]; ALL_TAC] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; REAL_LE_REFL; + ARITH_RULE `1 <= k ==> 1 <= 2 * k + 1`]; + ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN + MATCH_MP_TAC(TAUT `(b ==> a) ==> ~a ==> b ==> c`) THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`p:num`; `k:num`] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `r:num` APRIMEDIVISOR) THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN + ABBREV_TAC `q = aprimedivisor r` THEN STRIP_TAC THEN + SUBGOAL_THEN `q divides p` ASSUME_TAC THENL + [MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `2 * k + 1` THEN + ASM_MESON_TAC[divides; MULT_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN `q = p:num` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[prime]; ALL_TAC] THEN + UNDISCH_TAC `r * p = p EXP (2 * k + 1)` THEN + REWRITE_TAC[EXP_ADD; EXP_1; EQ_MULT_RCANCEL] THEN + ASM_MESON_TAC[PRIME_0]);; + +let PSI_RESIDUES_COMPARE = prove + (`!n. sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k + 1)) + then ln(&(aprimedivisor d)) else &0) + <= sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) + then ln(&(aprimedivisor d)) else &0)`, + GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[sum; REAL_LE_REFL] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> (n = 1 + (n - 1))`)) THEN + REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN + MATCH_MP_TAC(REAL_ARITH + `b <= d /\ (a = &0) /\ (c = &0) ==> a + b <= c + d`) THEN + REWRITE_TAC[PSI_RESIDUES_COMPARE_2; ARITH] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_MESON_TAC[EXP_EQ_1; PRIME_1; ARITH_RULE + `1 <= k ==> ~(2 * k = 0) /\ ~(2 * k + 1 = 0)`]);; + +(* ------------------------------------------------------------------------- *) +(* The even residual reduces to the square root case. *) +(* ------------------------------------------------------------------------- *) + +let PSI_SQRT = prove + (`!n. psi(ISQRT(n)) = + sum(1,n) (\d. if ?p k. 1 <= k /\ prime p /\ (d = p EXP (2 * k)) + then ln(&(aprimedivisor d)) else &0)`, + REWRITE_TAC[psi] THEN INDUCT_TAC THEN + REWRITE_TAC[ISQRT_0; sum; ISQRT_SUC] THEN + ASM_CASES_TAC `?m. SUC n = m EXP 2` THENL + [ALL_TAC; + SUBGOAL_THEN `~(?p k. 1 <= k /\ prime p /\ (1 + n = p EXP (2 * k)))` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_MULT] THEN + ASM_MESON_TAC[ARITH_RULE `1 + n = SUC n`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ADD_RID]] THEN + ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL; sum] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `m:num`) THEN + SUBGOAL_THEN `1 + ISQRT n = m` SUBST1_TAC THENL + [SUBGOAL_THEN `(1 + ISQRT n) EXP 2 = SUC n` MP_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[num_CONV `2`; GSYM LE_ANTISYM] THEN + REWRITE_TAC[EXP_MONO_LE_SUC; EXP_MONO_LT_SUC]] THEN + MP_TAC(SPEC `n:num` ISQRT_SUC) THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(SPEC `SUC n` ISQRT_WORKS) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[num_CONV `2`; GSYM LE_ANTISYM] THEN + REWRITE_TAC[EXP_MONO_LE_SUC; EXP_MONO_LT_SUC] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN + REWRITE_TAC[mangoldt; primepow] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_MULT] THEN + REWRITE_TAC[GSYM LE_ANTISYM; EXP_MONO_LE_SUC; num_CONV `2`] THEN + REWRITE_TAC[LE_ANTISYM] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[aprimedivisor] THEN + REPEAT AP_TERM_TAC THEN ABS_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_TAC THEN REWRITE_TAC[EXP; EXP_1] THEN + ASM_MESON_TAC[DIVIDES_LMUL; PRIME_DIVPROD]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main comparison result. *) +(* ------------------------------------------------------------------------- *) + +let PSI_THETA = prove + (`!n. theta(n) + psi(ISQRT n) <= psi(n) /\ + psi(n) <= theta(n) + &2 * psi(ISQRT n)`, + GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [PSI_SPLIT] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [PSI_SPLIT] THEN + MP_TAC(SPEC `n:num` PSI_RESIDUES_COMPARE) THEN + REWRITE_TAC[GSYM PSI_SQRT] THEN + SIMP_TAC[REAL_MUL_2; GSYM REAL_ADD_ASSOC; REAL_LE_LADD; REAL_LE_ADDR] THEN + DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC SUM_POS_GEN THEN X_GEN_TAC `r:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[APRIMEDIVISOR_PRIMEPOW; + ARITH_RULE `1 <= k ==> 1 <= 2 * k + 1`] THEN + MATCH_MP_TAC LN_POS THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + ASM_MESON_TAC[PRIME_0; ARITH_RULE `~(p = 0) ==> 1 <= p`]);; + +(* ------------------------------------------------------------------------- *) +(* A trivial one-way comparison is immediate. *) +(* ------------------------------------------------------------------------- *) + +let THETA_LE_PSI = prove + (`!n. theta(n) <= psi(n)`, + GEN_TAC THEN REWRITE_TAC[theta; psi] THEN MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `p:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `prime p` THEN ASM_REWRITE_TAC[MANGOLDT_POS] THEN + ASM_SIMP_TAC[mangoldt; PRIME_PRIMEPOW] THEN + SUBGOAL_THEN `aprimedivisor p = p` + (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + ASM_MESON_TAC[APRIMEDIVISOR_PRIMEPOW; EXP_1; LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* A tighter bound on psi on a smaller range, to reduce later case analysis. *) +(* ------------------------------------------------------------------------- *) + +let PSI_UBOUND_30 = prove + (`!n. n <= 30 ==> psi(n) <= &65 / &64 * &n`, + let lemma = prove + (`a <= b /\ l <= a /\ rest ==> l <= a /\ l <= b /\ rest`, + MESON_TAC[REAL_LE_TRANS]) + and tac = time (CONV_TAC(LAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in + REWRITE_TAC[ARITH_RULE `n <= 30 <=> n < 31`] THEN + CONV_TAC EXPAND_CASES_CONV THEN REWRITE_TAC(PSI_LIST_300) THEN + REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REPEAT + ((MATCH_MP_TAC lemma THEN + CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN + GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) + ORELSE + (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) + ORELSE tac));; + +(* ------------------------------------------------------------------------- *) +(* Bounds for theta, derived from those for psi. *) +(* ------------------------------------------------------------------------- *) + +let THETA_UBOUND_3_2 = prove + (`!n. theta(n) <= &3 / &2 * &n`, + MESON_TAC[REAL_LE_TRANS; PSI_UBOUND_3_2; THETA_LE_PSI]);; + +let THETA_LBOUND_1_2 = prove + (`!n. 5 <= n ==> &1 / &2 * &n <= theta(n)`, + let lemma = prove + (`a <= b /\ b <= l /\ rest ==> a <= l /\ b <= l /\ rest`, + MESON_TAC[REAL_LE_TRANS]) + and tac = time (CONV_TAC(RAND_CONV LN_N2_CONV THENC REALCALC_REL_CONV)) in + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n >= 900` THENL + [MP_TAC(CONJUNCT2(SPEC `n:num` PSI_THETA)) THEN + MP_TAC(SPEC `n:num` PSI_LBOUND_3_5) THEN + ASM_SIMP_TAC[ARITH_RULE `n >= 900 ==> 4 <= n`] THEN + MATCH_MP_TAC(REAL_ARITH + `d <= (a - b) * n ==> a * n <= ps ==> ps <= th + d ==> b * n <= th`) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&3 / &2 * &(ISQRT n)` THEN + REWRITE_TAC[PSI_UBOUND_3_2] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBGOAL_THEN `&(ISQRT n) pow 2 <= (&n * &1 / &30) pow 2` MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ISQRT_WORKS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `(a * b) * (a * b) = a * a * b * b`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_LE_LDIV_EQ; + REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `n >= 900` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `n < 413` THENL + [UNDISCH_TAC `5 <= n` THEN UNDISCH_TAC `n < 413` THEN + SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC(THETA_LIST 412) THEN + REWRITE_TAC[LN_1; ARITH] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REPEAT + ((MATCH_MP_TAC lemma THEN + CONV_TAC(LAND_CONV REAL_RAT_REDUCE_CONV) THEN + GEN_REWRITE_TAC I [TAUT `T /\ a <=> a`]) + ORELSE + (CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) + ORELSE tac); + ALL_TAC] THEN + MP_TAC(CONJUNCT2(SPEC `n:num` PSI_THETA)) THEN + MP_TAC(SPEC `n:num` PSI_LBOUND_3_5) THEN + ASM_SIMP_TAC[ARITH_RULE `5 <= n ==> 4 <= n`] THEN + MATCH_MP_TAC(REAL_ARITH + `d <= (a - b) * n ==> a * n <= ps ==> ps <= th + d ==> b * n <= th`) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&65 / &64 * &(ISQRT n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC PSI_UBOUND_30 THEN + SUBGOAL_THEN `(ISQRT n) EXP (SUC 1) <= 30 EXP (SUC 1)` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[EXP_MONO_LE_SUC]] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN + REWRITE_TAC[ARITH; ISQRT_WORKS] THEN + UNDISCH_TAC `~(n >= 900)` THEN ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBGOAL_THEN `&(ISQRT n) pow 2 <= (&n * &16 / &325) pow 2` MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ISQRT_WORKS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `(a * b) * (a * b) = a * a * b * b`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ; + REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&413` THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(n < 413)` THEN ARITH_TAC);; + +(* ========================================================================= *) +(* Tighten the bounds on weak PNT to get the Bertrand conjecture. *) +(* ========================================================================= *) + +let FLOOR_POS = prove + (`!x. &0 <= x ==> &0 <= floor x`, + GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `x < &1` THENL + [ASM_MESON_TAC[FLOOR_EQ_0; REAL_LE_REFL]; ALL_TAC] THEN + MP_TAC(last(CONJUNCTS(SPEC `x:real` FLOOR))) THEN + UNDISCH_TAC `~(x < &1)` THEN REAL_ARITH_TAC);; + +let FLOOR_NUM_EXISTS = prove + (`!x. &0 <= x ==> ?k. floor x = &k`, + REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT1(SPEC `x:real` FLOOR)) THEN + REWRITE_TAC[integer] THEN + ASM_MESON_TAC[FLOOR_POS; REAL_ARITH `&0 <= x ==> (abs x = x)`]);; + +let FLOOR_DIV_INTERVAL = prove + (`!n d k. ~(d = 0) + ==> ((floor(&n / &d) = &k) = + if k = 0 then &n < &d + else &n / &(k + 1) < &d /\ &d <= &n / &k)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THENL + [ASM_REWRITE_TAC[FLOOR_EQ_0] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < d <=> ~(d = 0)`] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID; REAL_OF_NUM_LT]; + ALL_TAC] THEN + REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < d <=> ~(d = 0)`; ARITH_RULE `0 < k + 1`] THEN + REWRITE_TAC[REAL_MUL_AC; CONJ_ACI; REAL_OF_NUM_ADD]);; + +let FLOOR_DIV_EXISTS = prove + (`!n d. ~(d = 0) + ==> ?k. (floor(&n / &d) = &k) /\ + d * k <= n /\ n < d * (k + 1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?k. floor (&n / &d) = &k` MP_TAC THENL + [ASM_SIMP_TAC[FLOOR_NUM_EXISTS; REAL_LE_DIV; REAL_POS]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:num` THEN SIMP_TAC[] THEN ASM_SIMP_TAC[FLOOR_DIV_INTERVAL] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LE_0; ADD_CLAUSES; REAL_OF_NUM_LT] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < k + 1 /\ (~(k = 0) ==> 0 < k)`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + REWRITE_TAC[CONJ_ACI]);; + +let FLOOR_HALF_INTERVAL = prove + (`!n d. ~(d = 0) + ==> (floor (&n / &d) - &2 * floor (&(n DIV 2) / &d) = + if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k + then &1 else &0)`, + let lemma = prove(`ODD(k) ==> ~(k = 0)`,MESON_TAC[EVEN; NOT_EVEN]) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP FLOOR_DIV_EXISTS) THEN + FIRST_ASSUM(MP_TAC o SPEC `n DIV 2` o MATCH_MP FLOOR_DIV_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `k1:num` + (CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `k2:num` + (CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC)) THEN + MAP_EVERY UNDISCH_TAC [`n DIV 2 < d * (k1 + 1)`; `d * k1 <= n DIV 2`] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a ==> ~(b /\ c))`] THEN + SIMP_TAC[GSYM NOT_LE; LE_LDIV_EQ; LE_RDIV_EQ; ARITH_EQ; lemma; ADD_EQ_0] THEN + REWRITE_TAC[NOT_LE; NOT_IMP] THEN DISCH_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `d * 2 * k1 < d * (k2 + 1) /\ d * k2 < d * 2 * (k1 + 1)` + MP_TAC THENL [ASM_MESON_TAC[LET_TRANS; MULT_AC]; ALL_TAC] THEN + ASM_REWRITE_TAC[LT_MULT_LCANCEL] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (ARITH_RULE + `2 * k1 < k2 + 1 /\ k2 < 2 * (k1 + 1) + ==> (k2 = 2 * k1) \/ (k2 = 2 * k1 + 1)`)) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL; + REAL_ADD_SUB; REAL_SUB_REFL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `2 * k1 + 1`) THEN + ASM_REWRITE_TAC[ARITH_ODD; ODD_ADD; ODD_MULT] THEN + ASM_MESON_TAC[MULT_AC]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[ODD_EXISTS; ADD1] THEN + DISCH_THEN(X_CHOOSE_THEN `k3:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `d * 2 * k1 < d * ((2 * k3 + 1) + 1) /\ + d * (2 * k3 + 1) < d * 2 * (k1 + 1)` + MP_TAC THENL [ASM_MESON_TAC[LET_TRANS; MULT_AC]; ALL_TAC] THEN + ASM_REWRITE_TAC[LT_MULT_LCANCEL] THEN + DISCH_THEN(SUBST_ALL_TAC o MATCH_MP (ARITH_RULE + `2 * k1 < (2 * k3 + 1) + 1 /\ 2 * k3 + 1 < 2 * (k1 + 1) + ==> (k3 = k1)`)) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +let SUM_EXPAND_LEMMA = prove + (`!n m k. (m + 2 * k = n) + ==> (sum (1,n DIV (2 * k + 1)) + (\d. if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k + then mangoldt d else &0) = + sum (1,n) (\d. --(&1) pow (d + 1) * psi (n DIV d)) - + sum (1,2 * k) + (\d. --(&1) pow (d + 1) * psi (n DIV d)))`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[DIV_0; ADD_EQ_0; ARITH_EQ; REAL_SUB_REFL; sum]; ALL_TAC] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THENL + [DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[ADD_CLAUSES] THEN + ASM_SIMP_TAC[DIV_REFL; SUM_1; DIV_1; REAL_SUB_REFL] THEN + SUBGOAL_THEN `n DIV (n + 1) = 0` (fun th -> REWRITE_TAC[th; sum]) THEN + ASM_MESON_TAC[DIV_EQ_0; ARITH_RULE `n < n + 1 /\ ~(n + 1 = 0)`]; + ALL_TAC] THEN + ASM_CASES_TAC `m = 1` THENL + [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM ADD1; ARITH_RULE `1 + n = SUC n`] THEN + SIMP_TAC[DIV_REFL; NOT_SUC; sum; SUM_1] THEN + REWRITE_TAC[REAL_ADD_SUB; mangoldt] THEN + CONV_TAC(ONCE_DEPTH_CONV PRIMEPOW_CONV) THEN + REWRITE_TAC[COND_ID] THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN + SIMP_TAC[DIV_REFL; NOT_SUC] THEN REWRITE_TAC(LN_1::PSI_LIST 1); + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `m - 2`) THEN + ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 2 < m`] THEN + DISCH_TAC THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN ANTS_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV o TOP_DEPTH_CONV) + [ARITH_RULE `2 * SUC k = SUC(SUC(2 * k))`; sum] THEN + MATCH_MP_TAC(REAL_ARITH + `(s - ss = x + y) ==> (ss = a - ((b + x) + y)) ==> (s = a - b)`) THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; ARITH_EVEN; EVEN; EVEN_MULT] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; REAL_MUL_LNEG] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN + REWRITE_TAC[psi; GSYM real_sub] THEN + MATCH_MP_TAC(REAL_ARITH `!b. (a - b = d) /\ (b = c) ==> (a - c = d)`) THEN + EXISTS_TAC `sum (1,n DIV (SUC (2 * k) + 1)) + (\d. if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k + then mangoldt d else &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_DIFFERENCES_EQ THEN CONJ_TAC THENL + [MATCH_MP_TAC DIV_MONO2 THEN ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `r:num` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `2 * k + 1`) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH_ODD] THEN + ASM_REWRITE_TAC[ARITH_RULE `n <= r <=> n < 1 + r`] THEN + ASM_REWRITE_TAC[ARITH_RULE `n < r <=> 1 + n <= r`] THEN + ASM_REWRITE_TAC[ARITH_RULE `(2 * k + 1) + 1 = SUC(2 * k) + 1`]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_MORETERMS_EQ THEN CONJ_TAC THENL + [MATCH_MP_TAC DIV_MONO2 THEN ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `r:num` THEN + REWRITE_TAC[ARITH_RULE `2 * SUC k + 1 = 2 * k + 3`] THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * k) + 1 = 2 * k + 2`] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `oj:num` MP_TAC) THEN + REWRITE_TAC[ODD_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * k) + 1 = 2 * k + 2`] THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 + a <= b ==> a < b`)) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `a < 1 + b ==> a <= b`)) THEN + SIMP_TAC[GSYM NOT_LE; LE_RDIV_EQ; LE_LDIV_EQ; ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[NOT_LE] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(2 * j + 1) * r < (2 * k + 3) * r /\ + (2 * k + 2) * r < (2 * j + 2) * r` + MP_TAC THENL [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + ASM_CASES_TAC `r = 0` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST_ALL_TAC o MATCH_MP (ARITH_RULE + `2 * j + 1 < 2 * k + 3 /\ 2 * k + 2 < 2 * j + 2 ==> (j = k)`)) THEN + ASM_MESON_TAC[LET_TRANS; LT_REFL; MULT_AC]);; + +let FACT_EXPAND_PSI = prove + (`!n. ln(&(FACT(n))) - &2 * ln(&(FACT(n DIV 2))) = + sum(1,n) (\d. --(&1) pow (d + 1) * psi(n DIV d))`, + GEN_TAC THEN REWRITE_TAC[MANGOLDT] THEN + SUBGOAL_THEN + `sum (1,n DIV 2) (\d. mangoldt d * floor (&(n DIV 2) / &d)) = + sum (1,n) (\d. mangoldt d * floor (&(n DIV 2) / &d))` + SUBST1_TAC THENL + [SUBGOAL_THEN `n = n DIV 2 + (n - n DIV 2)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [th]) + THENL [MESON_TAC[SUB_ADD; DIV_LE; ADD_SYM; NUM_REDUCE_CONV `2 = 0`]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SPLIT] THEN + MATCH_MP_TAC(REAL_ARITH `(b = &0) ==> (a = a + b)`) THEN + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE; FLOOR_EQ_0] THEN DISJ2_TAC THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN + SUBGOAL_THEN `0 < r /\ n DIV 2 < r` MP_TAC THENL + [UNDISCH_TAC `1 + n DIV 2 <= r` THEN ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; REAL_MUL_LID]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_CMUL; GSYM SUM_SUB] THEN + REWRITE_TAC[REAL_ARITH `m * x - &2 * m * y = m * (x - &2 * y)`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum(1,n) (\d. if ?k. ODD k /\ n DIV (k + 1) < d /\ d <= n DIV k + then mangoldt d else &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[FLOOR_HALF_INTERVAL; ARITH_RULE `1 <= d ==> ~(d = 0)`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO]; + ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `n:num`; `0`] SUM_EXPAND_LEMMA) THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; sum; REAL_SUB_RZERO; DIV_1]);; + +(* ------------------------------------------------------------------------- *) +(* Show that we can get bounds by cutting off at odd/even points. *) +(* ------------------------------------------------------------------------- *) + +let PSI_MONO = prove + (`!m n. m <= n ==> psi(m) <= psi(n)`, + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; psi] THEN + REWRITE_TAC[GSYM SUM_SPLIT] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_ADDR] THEN + MATCH_MP_TAC SUM_POS_GEN THEN REWRITE_TAC[MANGOLDT_POS]);; + +let PSI_POS = prove + (`!n. &0 <= psi(n)`, + SUBGOAL_THEN `psi(0) = &0` (fun th -> MESON_TAC[th; PSI_MONO; LE_0]) THEN + REWRITE_TAC(LN_1::PSI_LIST 0));; + +let PSI_EXPANSION_CUTOFF = prove + (`!n m p. m <= p + ==> sum(1,2 * m) (\d. --(&1) pow (d + 1) * psi(n DIV d)) + <= sum(1,2 * p) (\d. --(&1) pow (d + 1) * psi(n DIV d)) /\ + sum(1,2 * p + 1) (\d. --(&1) pow (d + 1) * psi(n DIV d)) + <= sum(1,2 * m + 1) (\d. --(&1) pow (d + 1) * psi(n DIV d))`, + GEN_TAC THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + X_GEN_TAC `m:num` THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN + REWRITE_TAC[ARITH_RULE `2 * SUC n = SUC(SUC(2 * n))`; + ARITH_RULE `SUC(SUC n) + 1 = SUC(SUC(n + 1))`; sum] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `s1 <= s1' /\ s2' <= s2 + ==> &0 <= a + b /\ &0 <= --c + --d + ==> s1 <= (s1' + a) + b /\ (s2' + c) + d <= s2`)) THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; EVEN] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; REAL_MUL_LNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_ARITH `&0 <= a + --b <=> b <= a`] THEN + CONJ_TAC THEN MATCH_MP_TAC PSI_MONO THEN + MATCH_MP_TAC DIV_MONO2 THEN ARITH_TAC);; + +let FACT_PSI_BOUND_ODD = prove + (`!n k. ODD(k) + ==> ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2))) + <= sum(1,k) (\d. --(&1) pow (d + 1) * psi(n DIV d))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FACT_EXPAND_PSI] THEN + ASM_CASES_TAC `k <= n:num` THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH `(b = a) ==> a <= b`) THEN + MATCH_MP_TAC SUM_MORETERMS_EQ THEN + ASM_SIMP_TAC[ARITH_RULE `~(k <= n) ==> n <= k:num`] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN + DISJ2_TAC THEN SUBGOAL_THEN `n DIV r = 0` SUBST1_TAC THENL + [ASM_MESON_TAC[DIV_EQ_0; ARITH_RULE `1 + n <= r ==> n < r /\ ~(r = 0)`]; + REWRITE_TAC(LN_1::PSI_LIST 0)]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1,SUC(2 * n DIV 2)) + (\d. -- &1 pow (d + 1) * psi (n DIV d))` THEN + CONJ_TAC THENL + [ALL_TAC; + SUBGOAL_THEN `m <= n DIV 2` + (fun th -> SIMP_TAC[th; ADD1; PSI_EXPANSION_CUTOFF]) THEN + SIMP_TAC[LE_RDIV_EQ; ARITH_EQ] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC] THEN + MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN + MAP_EVERY ABBREV_TAC [`q = n DIV 2`; `r = n MOD 2`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [th]) + MP_TAC) THEN + REWRITE_TAC[ARITH_RULE `r < 2 <=> (r = 0) \/ (r = 1)`] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[ADD1; MULT_AC; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; sum; REAL_LE_ADDR] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; PSI_POS]);; + +let FACT_PSI_BOUND_EVEN = prove + (`!n k. EVEN(k) + ==> sum(1,k) (\d. --(&1) pow (d + 1) * psi(n DIV d)) + <= ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FACT_EXPAND_PSI] THEN + ASM_CASES_TAC `k <= n:num` THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH `(a = b) ==> a <= b`) THEN + MATCH_MP_TAC SUM_MORETERMS_EQ THEN + ASM_SIMP_TAC[ARITH_RULE `~(k <= n) ==> n <= k:num`] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN + DISJ2_TAC THEN SUBGOAL_THEN `n DIV r = 0` SUBST1_TAC THENL + [ASM_MESON_TAC[DIV_EQ_0; ARITH_RULE `1 + n <= r ==> n < r /\ ~(r = 0)`]; + REWRITE_TAC(LN_1::PSI_LIST 0)]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1,2 * n DIV 2) + (\d. -- &1 pow (d + 1) * psi (n DIV d))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `m <= n DIV 2` + (fun th -> SIMP_TAC[th; ADD1; PSI_EXPANSION_CUTOFF]) THEN + SIMP_TAC[LE_RDIV_EQ; ARITH_EQ] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN + MAP_EVERY ABBREV_TAC [`q = n DIV 2`; `r = n MOD 2`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [th]) + MP_TAC) THEN + REWRITE_TAC[ARITH_RULE `r < 2 <=> (r = 0) \/ (r = 1)`] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[ADD1; MULT_AC; ADD_CLAUSES; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; sum; REAL_LE_ADDR] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; PSI_POS]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, we will use these. *) +(* ------------------------------------------------------------------------- *) + +let FACT_PSI_BOUND_2_3 = prove + (`!n. psi(n) - psi(n DIV 2) + <= ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2))) /\ + ln(&(FACT n)) - &2 * ln(&(FACT (n DIV 2))) + <= psi(n) - psi(n DIV 2) + psi(n DIV 3)`, + GEN_TAC THEN + MP_TAC(SPECL [`n:num`; `2`] FACT_PSI_BOUND_EVEN) THEN + MP_TAC(SPECL [`n:num`; `3`] FACT_PSI_BOUND_ODD) THEN + REWRITE_TAC[ARITH] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[ARITH; REAL_ADD_LID; DIV_1] THEN + REWRITE_TAC[REAL_POW_NEG; ARITH; REAL_POW_ONE; REAL_MUL_LID] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence get a good lower bound on psi(n) - psi(n/2). *) +(* ------------------------------------------------------------------------- *) + +let PSI_DOUBLE_LEMMA = prove + (`!n. n >= 1200 ==> &n / &6 <= psi(n) - psi(n DIV 2)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `n:num` FACT_PSI_BOUND_2_3) THEN + MATCH_MP_TAC(REAL_ARITH + `b + p3 <= a ==> u <= v /\ a <= p - p2 + p3 ==> b <= p - p2`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&n / &6 + &n / &2` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_LADD] THEN MP_TAC(SPEC `n DIV 3` PSI_UBOUND_3_2) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&3 / &2 * &n / &3` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MP_TAC(SPECL [`n:num`; `3`] DIVISION) THEN ARITH_TAC; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + MP_TAC(SPEC `n:num` LN_FACT_DIFF_BOUNDS) THEN + MATCH_MP_TAC(REAL_ARITH + `ltm <= nl2 - a ==> abs(lf - nl2) <= ltm ==> a <= lf`) THEN + ASM_SIMP_TAC[ARITH_RULE `n >= 1200 ==> ~(n = 0)`] THEN + REWRITE_TAC[real_div; GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&n * &1 / &38` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + SIMP_TAC[REAL_LE_SUB_LADD] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC(RAND_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV] THEN + SUBST1_TAC(REAL_ARITH `&n = &1 + (&n - &1)`) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `n >= b ==> b <= n:num`)) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_OF_NUM_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `a <= n ==> a - &1 <= n - &1`)) THEN + ABBREV_TAC `x = &n - &1` THEN + CONV_TAC(LAND_CONV NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) THEN + SPEC_TAC(`x:real`,`x:real`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MATCH_MP_TAC OVERPOWER_LEMMA THEN + W(fun (asl,w) -> + let th = DIFF_CONV + (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in + MP_TAC th) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; + REAL_MUL_RID; REAL_MUL_LID] THEN + W(fun (asl,w) -> + let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in + DISCH_TAC THEN EXISTS_TAC tm) THEN + CONJ_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_sub] THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= x ==> inv(&1 + x) <= inv(&1 + a) /\ + inv(&1 + a) <= b ==> inv(&1 + x) <= b`)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Hence show that theta changes (could get a lower bound like n/10). *) +(* ------------------------------------------------------------------------- *) + +let THETA_DOUBLE_LEMMA = prove + (`!n. n >= 1200 ==> theta(n DIV 2) < theta(n)`, + REPEAT STRIP_TAC THEN + MP_TAC(CONJUNCT2 (SPEC `n:num` PSI_THETA)) THEN + MP_TAC(CONJUNCT1 (SPEC `n DIV 2` PSI_THETA)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PSI_DOUBLE_LEMMA) THEN + MP_TAC(SPEC `ISQRT(n DIV 2)` PSI_POS) THEN + SUBGOAL_THEN + `&2 * psi (ISQRT n) < &n / &6` + (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&3 / &2 * &(ISQRT n)` THEN + REWRITE_TAC[PSI_UBOUND_3_2] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN + SUBGOAL_THEN `(ISQRT n * 18) EXP (SUC 1) < n EXP (SUC 1)` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[EXP_MONO_LT_SUC]] THEN + REWRITE_TAC[EXP; EXP_1] THEN + MATCH_MP_TAC(ARITH_RULE `324 * i * i < a ==> (i * 18) * (i * 18) < a`) THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `324 * n` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM EXP_2; ISQRT_WORKS; LE_MULT_LCANCEL]; + REWRITE_TAC[LT_MULT_RCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Hence Bertrand for sufficiently large n. *) +(* ------------------------------------------------------------------------- *) + +let BIG_BERTRAND = prove + (`!n. n >= 2400 ==> ?p. prime(p) /\ n <= p /\ p <= 2 * n`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `2 * n` THETA_DOUBLE_LEMMA) THEN + ANTS_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> b /\ c ==> ~a`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `sum(n + 1,n) (\p. if prime p then ln (&p) else &0) = &0` + MP_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum(n + 1,n) (\r. &0)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN + ASM_SIMP_TAC[ARITH_RULE + `n + 1 <= r /\ r < n + n + 1 ==> n <= r /\ r <= 2 * n`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `(b + a = c) ==> (a = &0) ==> ~(b < c)`) THEN + REWRITE_TAC[theta] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[SUM_SPLIT] THEN + REWRITE_TAC[MULT_2]);; + +(* ------------------------------------------------------------------------- *) +(* Landau trick. Should be automatic but ARITH_RULE is a bit slow. *) +(* (Direct use of ARITH_RULE takes about 3 minutes on my current laptop.) *) +(* ------------------------------------------------------------------------- *) + +let LANDAU_TRICK = prove + (`!n. 0 < n /\ n < 2400 + ==> n <= 2 /\ 2 <= 2 * n \/ + n <= 3 /\ 3 <= 2 * n \/ + n <= 5 /\ 5 <= 2 * n \/ + n <= 7 /\ 7 <= 2 * n \/ + n <= 13 /\ 13 <= 2 * n \/ + n <= 23 /\ 23 <= 2 * n \/ + n <= 43 /\ 43 <= 2 * n \/ + n <= 83 /\ 83 <= 2 * n \/ + n <= 163 /\ 163 <= 2 * n \/ + n <= 317 /\ 317 <= 2 * n \/ + n <= 631 /\ 631 <= 2 * n \/ + n <= 1259 /\ 1259 <= 2 * n \/ + n <= 2503 /\ 2503 <= 2 * n`, + let lemma = TAUT + `(p /\ b1 ==> a1) /\ (~b1 ==> a2) ==> p ==> b1 /\ a1 \/ a2` in + GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> c \/ ~b`] THEN + REWRITE_TAC[GSYM DISJ_ASSOC] THEN + REPEAT(MATCH_MP_TAC lemma THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC]) THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Bertrand for all nonzero n using "Landau trick". *) +(* ------------------------------------------------------------------------- *) + +let BERTRAND = prove + (`!n. ~(n = 0) ==> ?p. prime p /\ n <= p /\ p <= 2 * n`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(ARITH_RULE `n >= 2400 \/ n < 2400`) THEN + ASM_SIMP_TAC[BIG_BERTRAND] THEN MP_TAC(SPEC `n:num` LANDAU_TRICK) THEN + ASM_REWRITE_TAC[ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + STRIP_TAC THEN + ASM_MESON_TAC(map (PRIME_CONV o curry mk_comb `prime` o mk_small_numeral) + [2;3;5;7;13;23;43;83;163;317;631;1259;2503]));; + +(* ========================================================================= *) +(* Weak form of the Prime Number Theorem. *) +(* ========================================================================= *) + +let pii = new_definition + `pii(n) = sum(1,n) (\p. if prime(p) then &1 else &0)`;; + +(* ------------------------------------------------------------------------- *) +(* An optimized rule to give pii(n) for all n <= some N. *) +(* ------------------------------------------------------------------------- *) + +let PII_LIST = + let PII_0 = prove + (`pii(0) = &0`, + REWRITE_TAC[pii; sum]) + and PII_SUC = prove + (`pii(SUC n) = pii(n) + (if prime(SUC n) then &1 else &0)`, + REWRITE_TAC[pii; sum; ADD1] THEN REWRITE_TAC[ADD_AC]) + and n_tm = `n:num` + and SIMPER_CONV = + NUM_REDUCE_CONV THENC + ONCE_DEPTH_CONV PRIME_CONV THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV [COND_CLAUSES] THENC + REAL_RAT_REDUCE_CONV in + let rec PII_LIST n = + if n = 0 then [PII_0] else + let ths = PII_LIST (n - 1) in + let th1 = INST [mk_small_numeral(n-1),n_tm] PII_SUC in + let th2 = GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [hd ths] th1 in + CONV_RULE SIMPER_CONV th2::ths in + PII_LIST;; + +(* ------------------------------------------------------------------------- *) +(* Prove the usual characterization. *) +(* ------------------------------------------------------------------------- *) + +let PRIMES_FINITE = prove + (`!n. FINITE {p | p <= n /\ prime(p)}`, + GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{p | p < SUC n}` THEN REWRITE_TAC[FINITE_NUMSEG_LT] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC);; + +let PII = prove + (`!n. pii(n) = &(CARD {p | p <= n /\ prime(p)})`, + INDUCT_TAC THENL + [SUBGOAL_THEN `{p | p <= 0 /\ prime p} = {}` + (fun th -> REWRITE_TAC(th::CARD_CLAUSES::PII_LIST 0)) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[LE; PRIME_0; NOT_IN_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN `{p | p <= SUC n /\ prime p} = + if prime(SUC n) then (SUC n) INSERT {p | p <= n /\ prime p} + else {p | p <= n /\ prime p}` + SUBST1_TAC THENL + [COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN + ASM_MESON_TAC[LE]; + ALL_TAC] THEN + REWRITE_TAC[pii; sum] THEN REWRITE_TAC[GSYM pii] THEN + REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN + SIMP_TAC[CARD_CLAUSES; PRIMES_FINITE] THEN COND_CASES_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + ASM_MESON_TAC[ARITH_RULE `~(SUC n <= n)`]; + REWRITE_TAC[REAL_OF_NUM_SUC]]);; + +(* ------------------------------------------------------------------------- *) +(* One bound is a simple consequence of the one for theta. *) +(* ------------------------------------------------------------------------- *) + +let PII_LBOUND = prove + (`!n. 3 <= n ==> &1 / &2 * (&n / ln(&n)) <= pii(n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; LN_POS_LT; REAL_OF_NUM_LT; + ARITH_RULE `3 <= n ==> 1 < n`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + FIRST_X_ASSUM(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC o MATCH_MP + (ARITH_RULE `3 <= n ==> (n = 3) \/ (n = 4) \/ 5 <= n`)) THEN + ASM_REWRITE_TAC(PII_LIST 4) THENL + [CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP THETA_LBOUND_1_2) THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> a <= x ==> a <= y`) THEN + REWRITE_TAC[theta; pii; GSYM SUM_CMUL] THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN + SUBGOAL_THEN `&0 < &r /\ &r <= &n` + (fun th -> MESON_TAC[th; LN_MONO_LE; REAL_LTE_TRANS]) THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `1 <= r` THEN UNDISCH_TAC `r < n + 1` THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* First prove the upper bound for the first 50 numbers, to start with. *) +(* ------------------------------------------------------------------------- *) + +let PII_UBOUND_CASES_50 = prove + (`!n. n < 50 ==> 3 <= n ==> ln(&n) * pii(n) <= &5 * &n`, + let tac = CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV THENC REALCALC_REL_CONV) in + CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC(PII_LIST 49) THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REPEAT(CONJ_TAC THENL [tac THEN NO_TAC; ALL_TAC]) THEN tac);; + +(* ------------------------------------------------------------------------- *) +(* An extra trivial pair of lemmas. *) +(* ------------------------------------------------------------------------- *) + +let THETA_POS = prove + (`!n. &0 <= theta n`, + GEN_TAC THEN REWRITE_TAC[theta] THEN + MATCH_MP_TAC SUM_POS_GEN THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[LE_REFL; LN_POS; REAL_OF_NUM_LE]);; + +let PII_MONO = prove + (`!m n. m <= n ==> pii(m) <= pii(n)`, + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; pii] THEN + REWRITE_TAC[GSYM SUM_SPLIT] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_ADDR] THEN + MATCH_MP_TAC SUM_POS_GEN THEN + GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let PII_POS = prove + (`!n. &0 <= pii(n)`, + SUBGOAL_THEN `pii(0) = &0` (fun th -> MESON_TAC[th; PII_MONO; LE_0]) THEN + REWRITE_TAC(LN_1::PII_LIST 0));; + +(* ------------------------------------------------------------------------- *) +(* The induction principle we can use. *) +(* ------------------------------------------------------------------------- *) + +let PII_CHANGE = prove + (`!m n. ~(m = 0) ==> ln(&m) * (pii n - pii m) <= &3 / &2 * &n`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `m <= n:num` THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a * (c - b) ==> a * (b - c) <= &0`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[LN_POS; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC PII_MONO THEN + UNDISCH_TAC `~(m <= n:num)` THEN ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `theta n` THEN REWRITE_TAC[THETA_UBOUND_3_2] THEN + MP_TAC(SPEC `m:num` THETA_POS) THEN + MATCH_MP_TAC(REAL_ARITH `a <= n - m ==> &0 <= m ==> a <= n`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[pii; theta; GSYM SUM_SPLIT; REAL_ADD_SUB] THEN + REWRITE_TAC[GSYM SUM_CMUL] THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL; REAL_MUL_RID] THEN + SUBGOAL_THEN `&0 < &m /\ &m <= &r` + (fun th -> MESON_TAC[th; LN_MONO_LE; REAL_LTE_TRANS]) THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `1 + m <= r` THEN UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC);; + +let PII_ISQRT_INDUCT = prove + (`!n. 50 <= n + ==> ln(&n) * pii(n) + <= &9 / &4 * (&3 / &2 * &n + ln(&(ISQRT(n))) * pii(ISQRT(n)))`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC LAND_CONV [real_div] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MP_TAC(SPECL [`ISQRT n`; `n:num`] PII_CHANGE) THEN + SUBGOAL_THEN `~(ISQRT n = 0)` ASSUME_TAC THENL + [MP_TAC(SPEC `n:num` ISQRT_WORKS) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[ARITH] THEN + DISCH_TAC THEN UNDISCH_TAC `50 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `a * p <= ls * p ==> ls * (p - ps) <= an ==> a * p <= an + ls * ps`) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[PII_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `ln((&(ISQRT n) + &1) pow 2)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `&0 < &n /\ &n <= (&(ISQRT n) + &1) pow 2` + (fun th -> MESON_TAC[th; REAL_LTE_TRANS; LN_MONO_LE]) THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE; + REAL_OF_NUM_LT] THEN + SIMP_TAC[ISQRT_WORKS; LT_IMP_LE] THEN + UNDISCH_TAC `50 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[LN_POW; REAL_POS; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH `a - b <= b * (d - &1) ==> a <= b * d`) THEN + ASM_SIMP_TAC[GSYM LN_DIV; REAL_ARITH `&0 < x ==> &0 < x + &1`; + REAL_OF_NUM_LT; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&(ISQRT n))` THEN + ASM_SIMP_TAC[LN_LE; REAL_POS; REAL_LE_INV_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + SUBGOAL_THEN `&7 <= &(ISQRT n)` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN + SUBGOAL_THEN `7 EXP 2 < (ISQRT n + 1) EXP 2` MP_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n:num` THEN + REWRITE_TAC[ISQRT_WORKS] THEN CONV_TAC NUM_REDUCE_CONV THEN + UNDISCH_TAC `50 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC] THEN ARITH_TAC; + ALL_TAC] THEN + SPEC_TAC(`&(ISQRT n)`,`x:real`) THEN + MATCH_MP_TAC OVERPOWER_LEMMA THEN + W(fun (asl,w) -> + let th = DIFF_CONV + (lhand(rator(rand(body(rand(lhand(rand(body(rand w))))))))) in + MP_TAC th) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; + REAL_MUL_RID; REAL_MUL_LID] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + W(fun (asl,w) -> + let tm = mk_abs(`x:real`,rand(rator(rand(body(rand(lhand w)))))) in + DISCH_TAC THEN EXISTS_TAC tm) THEN + CONJ_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[real_sub] THEN + CONV_TAC(ONCE_DEPTH_CONV LN_N2_CONV) THEN + CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + SIMP_TAC[LN_POS; REAL_LE_ADD; REAL_POS; REAL_ARITH `&7 <= x ==> &1 <= x`]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a bound by wellfounded induction. *) +(* ------------------------------------------------------------------------- *) + +let PII_UBOUND_5 = prove + (`!n. 3 <= n ==> pii(n) <= &5 * (&n / ln(&n))`, + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; LN_POS_LT; REAL_OF_NUM_LT; + ARITH_RULE `3 <= n ==> 1 < n`] THEN + GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `n < 50` THEN ASM_SIMP_TAC[PII_UBOUND_CASES_50] THEN + DISCH_THEN(MP_TAC o SPEC `ISQRT n`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + SUBGOAL_THEN `7 <= ISQRT n` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN + SUBGOAL_THEN `7 EXP 2 < (ISQRT n + 1) EXP 2` MP_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n:num` THEN + REWRITE_TAC[ISQRT_WORKS] THEN CONV_TAC NUM_REDUCE_CONV THEN + UNDISCH_TAC `50 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `7 <= n ==> 3 <= n`; + ARITH_RULE `50 <= n ==> 3 <= n`] THEN + ANTS_TAC THENL + [SUBGOAL_THEN `(ISQRT n) EXP 2 < n EXP 2` MP_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n:num` THEN + REWRITE_TAC[ISQRT_WORKS] THEN REWRITE_TAC[EXP_2] THEN + MATCH_MP_TAC(ARITH_RULE `1 * n < m ==> n < m`) THEN + REWRITE_TAC[LT_MULT_RCANCEL] THEN + UNDISCH_TAC `50 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC]; + ALL_TAC] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PII_ISQRT_INDUCT) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&9 / &4 * (&3 / &2 * &n + &5 * &(ISQRT n))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[REAL_LE_LADD]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `i * (a * c) <= n * (d - a * b) ==> a * (b * n + c * i) <= d * n`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(ISQRT n) * &7` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `ISQRT n * ISQRT n` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[LE_MULT_LCANCEL]; + REWRITE_TAC[GSYM EXP_2; ISQRT_WORKS]]);; diff --git a/100/birthday.ml b/100/birthday.ml new file mode 100644 index 0000000..845e9f3 --- /dev/null +++ b/100/birthday.ml @@ -0,0 +1,232 @@ +(* ========================================================================= *) +(* Birthday problem. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Restricted function space. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-->",(13,"right"));; + +let funspace = new_definition + `(s --> t) = {f:A->B | (!x. x IN s ==> f(x) IN t) /\ + (!x. ~(x IN s) ==> f(x) = @y. T)}`;; + +(* ------------------------------------------------------------------------- *) +(* Sizes. *) +(* ------------------------------------------------------------------------- *) + +let FUNSPACE_EMPTY = prove + (`({} --> t) = {(\x. @y. T)}`, + REWRITE_TAC[EXTENSION; IN_SING; funspace; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REWRITE_TAC[FUN_EQ_THM]);; + +let HAS_SIZE_FUNSPACE = prove + (`!s:A->bool t:B->bool m n. + s HAS_SIZE m /\ t HAS_SIZE n ==> (s --> t) HAS_SIZE (n EXP m)`, + REWRITE_TAC[HAS_SIZE; GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[CARD_CLAUSES; FINITE_RULES; FUNSPACE_EMPTY; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[EXP; ARITH]; + ALL_TAC] THEN + REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(x INSERT s) --> t = + IMAGE (\(y:B,g) u:A. if u = x then y else g(u)) + {y,g | y IN t /\ g IN s --> t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; funspace; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> d /\ a /\ b /\ c`] THEN + REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + X_GEN_TAC `f:A->B` THEN EQ_TAC THENL + [STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(f:A->B) x`; `\u. if u = x then @y. T else (f:A->B) u`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[IN_INSERT]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:B`; `g:A->B`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_MESON_TAC[IN_INSERT]]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ d <=> d /\ a /\ b`] THEN + REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REWRITE_TAC[FUN_EQ_THM; funspace; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN + X_GEN_TAC `u:A` THEN ASM_CASES_TAC `u:A = x` THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[CARD_CLAUSES; EXP] THEN + MATCH_MP_TAC HAS_SIZE_PRODUCT THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The restriction to injective functions. *) +(* ------------------------------------------------------------------------- *) + +let FACT_DIVIDES = prove + (`!m n. m <= n ==> ?d. FACT(n) = d * FACT(m)`, + REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT] THEN + ASM_MESON_TAC[MULT_AC; MULT_CLAUSES]);; + +let FACT_DIV_MULT = prove + (`!m n. m <= n ==> FACT n = (FACT(n) DIV FACT(m)) * FACT(m)`, + REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP FACT_DIVIDES) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + ASM_SIMP_TAC[DIV_MULT; GSYM LT_NZ; FACT_LT]);; + +let HAS_SIZE_FUNSPACE_INJECTIVE = prove + (`!s:A->bool t:B->bool m n. + s HAS_SIZE m /\ t HAS_SIZE n + ==> {f | f IN (s --> t) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)} + HAS_SIZE (if n < m then 0 else (FACT n) DIV (FACT(n - m)))`, + REWRITE_TAC[HAS_SIZE; GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[CARD_CLAUSES; FINITE_RULES; FUNSPACE_EMPTY; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN + ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES; FACT] THEN + SIMP_TAC[NOT_IN_EMPTY; LT; SUB_0; DIV_REFL; GSYM LT_NZ; FACT_LT] THEN + REWRITE_TAC[ARITH]; + ALL_TAC] THEN + REWRITE_TAC[GSYM HAS_SIZE] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{f | f IN (x INSERT s) --> t /\ + (!u v. u IN (x INSERT s) /\ v IN (x INSERT s) /\ f u = f v ==> u = v)} = + IMAGE (\(y:B,g) u:A. if u = x then y else g(u)) + {y,g | y IN t /\ + g IN {f | f IN (s --> (t DELETE y)) /\ + !u v. u IN s /\ v IN s /\ f u = f v ==> u = v}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; funspace; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> d /\ a /\ b /\ c`] THEN + REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + X_GEN_TAC `f:A->B` THEN EQ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(f:A->B) x`; `\u. if u = x then @y. T else (f:A->B) u`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; + REWRITE_TAC[IN_INSERT; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:B`; `g:A->B`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ d <=> d /\ a /\ b`] THEN + REWRITE_TAC[PAIR_EQ; EXISTS_PAIR_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REWRITE_TAC[FUN_EQ_THM; funspace; IN_ELIM_THM; IN_INSERT; IN_DELETE] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN + X_GEN_TAC `u:A` THEN ASM_CASES_TAC `u:A = x` THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[CARD_CLAUSES; EXP] THEN + SUBGOAL_THEN + `(if n < SUC (CARD s) then 0 else FACT n DIV FACT (n - SUC (CARD s))) = + n * (if (n - 1) < CARD(s:A->bool) then 0 + else FACT(n - 1) DIV FACT (n - 1 - CARD s))` + SUBST1_TAC THENL + [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT_0] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> (n - 1 < m <=> n < SUC m)`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `n - SUC(m) = n - 1 - m`] THEN + UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[FACT; SUC_SUB1] THEN DISCH_TAC THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[ADD_CLAUSES; FACT_LT; GSYM MULT_ASSOC] THEN + AP_TERM_TAC THEN MATCH_MP_TAC FACT_DIV_MULT THEN ARITH_TAC; + MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:B` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; CARD_DELETE]]);; + +(* ------------------------------------------------------------------------- *) +(* So the actual birthday result. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_DIFF = prove + (`!s t:A->bool m n. + s SUBSET t /\ s HAS_SIZE m /\ t HAS_SIZE n + ==> (t DIFF s) HAS_SIZE (n - m)`, + SIMP_TAC[HAS_SIZE; FINITE_DIFF] THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> t = s UNION (t DIFF s)`)) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + ASM_SIMP_TAC[CARD_UNION; FINITE_DIFF; ADD_SUB2; + SET_RULE `s INTER (t DIFF s) = {}`]);; + +let BIRTHDAY_THM = prove + (`!s:A->bool t:B->bool m n. + s HAS_SIZE m /\ t HAS_SIZE n + ==> {f | f IN (s --> t) /\ + ?x y. x IN s /\ y IN s /\ ~(x = y) /\ f(x) = f(y)} + HAS_SIZE (if m <= n then (n EXP m) - (FACT n) DIV (FACT(n - m)) + else n EXP m)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE + `{f:A->B | f IN (s --> t) /\ + ?x y. x IN s /\ y IN s /\ ~(x = y) /\ f(x) = f(y)} = + (s --> t) DIFF + {f | f IN (s --> t) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y)}`] THEN + REWRITE_TAC[ARITH_RULE + `(if a <= b then x - y else x) = x - (if b < a then 0 else y)`] THEN + MATCH_MP_TAC HAS_SIZE_DIFF THEN + ASM_SIMP_TAC[HAS_SIZE_FUNSPACE_INJECTIVE; HAS_SIZE_FUNSPACE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +(* ------------------------------------------------------------------------- *) +(* The usual explicit instantiation. *) +(* ------------------------------------------------------------------------- *) + +let FACT_DIV_SIMP = prove + (`!m n. m < n + ==> (FACT n) DIV (FACT m) = n * FACT(n - 1) DIV FACT(m)`, + GEN_TAC THEN REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[ARITH_RULE `(m + SUC d) - 1 - m = d`] THEN + REWRITE_TAC[ARITH_RULE `(m + SUC d) - 1 = m + d`; ADD_SUB2] THEN + GEN_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[FACT_LT; ARITH_RULE `x + 0 = x`] THEN REWRITE_TAC[FACT] THEN + SIMP_TAC[GSYM MULT_ASSOC; GSYM FACT_DIV_MULT; LE_ADD] THEN + REWRITE_TAC[ADD_CLAUSES; FACT]);; + +let BIRTHDAY_THM_EXPLICIT = prove + (`!s t. s HAS_SIZE 23 /\ t HAS_SIZE 365 + ==> 2 * CARD {f | f IN (s --> t) /\ + ?x y. x IN s /\ y IN s /\ ~(x = y) /\ f(x) = f(y)} + >= CARD (s --> t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BIRTHDAY_THM) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_SIZE_FUNSPACE) THEN + CONV_TAC(ONCE_DEPTH_CONV NUM_SUB_CONV) THEN + REPEAT(CHANGED_TAC + (SIMP_TAC[FACT_DIV_SIMP; ARITH_LE; ARITH_LT] THEN + CONV_TAC(ONCE_DEPTH_CONV NUM_SUB_CONV))) THEN + SIMP_TAC[DIV_REFL; GSYM LT_NZ; FACT_LT] THEN + REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV);; diff --git a/100/cantor.ml b/100/cantor.ml new file mode 100644 index 0000000..0385765 --- /dev/null +++ b/100/cantor.ml @@ -0,0 +1,97 @@ +(* ========================================================================= *) +(* Cantor's theorem. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Ad hoc version for whole type. *) +(* ------------------------------------------------------------------------- *) + +let CANTOR_THM_INJ = prove + (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, + REWRITE_TAC[INJECTIVE_LEFT_INVERSE; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:(A->bool)->A`; `g:A->(A->bool)`] THEN + DISCH_THEN(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN MESON_TAC[]);; + +let CANTOR_THM_SURJ = prove + (`~(?f:A->(A->bool). !s. ?x. f x = s)`, + REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:A->(A->bool)`; `f:(A->bool)->A`] THEN + DISCH_THEN(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Proper version for any set, in terms of cardinality operators. *) +(* ------------------------------------------------------------------------- *) + +let CANTOR = prove + (`!s:A->bool. s <_c {t | t SUBSET s}`, + GEN_TAC THEN REWRITE_TAC[lt_c] THEN CONJ_TAC THENL + [REWRITE_TAC[le_c] THEN EXISTS_TAC `(=):A->A->bool` THEN + REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; SUBSET; IN] THEN MESON_TAC[]; + REWRITE_TAC[LE_C; IN_ELIM_THM; SURJECTIVE_RIGHT_INVERSE] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `g:A->(A->bool)` THEN + DISCH_THEN(MP_TAC o SPEC `\x:A. s(x) /\ ~(g x x)`) THEN + REWRITE_TAC[SUBSET; IN; FUN_EQ_THM] THEN MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More explicit "injective" version as in Paul Taylor's book. *) +(* ------------------------------------------------------------------------- *) + +let CANTOR_THM_INJ' = prove + (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, + STRIP_TAC THEN + ABBREV_TAC `(g:A->A->bool) = \a. { b | !s. f(s) = a ==> b IN s}` THEN + MP_TAC(ISPEC `g:A->A->bool` + (REWRITE_RULE[NOT_EXISTS_THM] CANTOR_THM_SURJ)) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Another sequence of versions (Lawvere, Cantor, Taylor) taken from *) +(* http://ncatlab.org/nlab/show/Cantor%27s+theorem. *) +(* ------------------------------------------------------------------------- *) + +let CANTOR_LAWVERE = prove + (`!h:A->(A->B). + (!f:A->B. ?x:A. h(x) = f) ==> !n:B->B. ?x. n(x) = x`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `g:A->B = \a. (n:B->B) (h a a)` THEN + RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN + ASM_MESON_TAC[]);; + +let CANTOR = prove + (`!f:A->(A->bool). ~(!s. ?x. f x = s)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CANTOR_LAWVERE) THEN + DISCH_THEN(MP_TAC o SPEC `(~)`) THEN MESON_TAC[]);; + +let CANTOR_TAYLOR = prove + (`!f:(A->bool)->A. ~(!x y. f(x) = f(y) ==> x = y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\a:A. { b:A | !s. f(s) = a ==> b IN s}` + (REWRITE_RULE[NOT_EXISTS_THM] CANTOR)) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +let SURJECTIVE_COMPOSE = prove + (`(!y. ?x. f(x) = y) /\ (!z. ?y. g(y) = z) + ==> (!z. ?x. (g o f) x = z)`, + MESON_TAC[o_THM]);; + +let INJECTIVE_SURJECTIVE_PREIMAGE = prove + (`!f:A->B. (!x y. f(x) = f(y) ==> x = y) ==> !t. ?s. {x | f(x) IN s} = t`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `IMAGE (f:A->B) t` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ASM_MESON_TAC[]);; + +let CANTOR_JOHNSTONE = prove + (`!i:B->S f:B->S->bool. + ~((!x y. i(x) = i(y) ==> x = y) /\ (!s. ?z. f(z) = s))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `(IMAGE (f:B->S->bool)) o (\s:S->bool. {x | i(x) IN s})` + (REWRITE_RULE[NOT_EXISTS_THM] CANTOR)) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC SURJECTIVE_COMPOSE THEN + ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN + MATCH_MP_TAC INJECTIVE_SURJECTIVE_PREIMAGE THEN + ASM_REWRITE_TAC[]);; diff --git a/100/cayley_hamilton.ml b/100/cayley_hamilton.ml new file mode 100644 index 0000000..c1c893a --- /dev/null +++ b/100/cayley_hamilton.ml @@ -0,0 +1,446 @@ +(* ========================================================================= *) +(* The Cayley-Hamilton theorem (for real matrices). *) +(* ========================================================================= *) + +needs "Multivariate/complexes.ml";; + +(* ------------------------------------------------------------------------- *) +(* Powers of a square matrix (mpow) and sums of matrices (msum). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("mpow",(24,"left"));; + +let mpow = define + `(!A:real^N^N. A mpow 0 = (mat 1 :real^N^N)) /\ + (!A:real^N^N n. A mpow (SUC n) = A ** A mpow n)`;; + +let msum = new_definition + `msum = iterate (matrix_add)`;; + +let NEUTRAL_MATRIX_ADD = prove + (`neutral((+):real^N^M->real^N^M->real^N^M) = mat 0`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[MATRIX_ADD_RID; MATRIX_ADD_LID]);; + +let MONOIDAL_MATRIX_ADD = prove + (`monoidal((+):real^N^M->real^N^M->real^N^M)`, + REWRITE_TAC[monoidal; NEUTRAL_MATRIX_ADD] THEN + REWRITE_TAC[MATRIX_ADD_LID; MATRIX_ADD_ASSOC] THEN + REWRITE_TAC[MATRIX_ADD_SYM]);; + +let MSUM_CLAUSES = prove + (`(!(f:A->real^N^M). msum {} f = mat 0) /\ + (!x (f:A->real^N^M) s. + FINITE(s) + ==> (msum (x INSERT s) f = + if x IN s then msum s f else f(x) + msum s f))`, + REWRITE_TAC[msum; GSYM NEUTRAL_MATRIX_ADD] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; + +let MSUM_MATRIX_RMUL = prove + (`!(f:A->real^N^M) (A:real^P^N) s. + FINITE s ==> msum s (\i. f(i) ** A) = msum s f ** A`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[MSUM_CLAUSES; MATRIX_MUL_LZERO; MATRIX_ADD_RDISTRIB]);; + +let MSUM_MATRIX_LMUL = prove + (`!(f:A->real^P^N) (A:real^N^M) s. + FINITE s ==> msum s (\i. A ** f(i)) = A ** msum s f`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[MSUM_CLAUSES; MATRIX_MUL_RZERO; MATRIX_ADD_LDISTRIB]);; + +let MSUM_ADD = prove + (`!f g s. FINITE s ==> (msum s (\x. f(x) + g(x)) = msum s f + msum s g)`, + SIMP_TAC[msum; ITERATE_OP; MONOIDAL_MATRIX_ADD]);; + +let MSUM_CMUL = prove + (`!(f:A->real^N^M) c s. + FINITE s ==> msum s (\i. c %% f(i)) = c %% msum s f`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[MSUM_CLAUSES; MATRIX_CMUL_ADD_LDISTRIB; MATRIX_CMUL_RZERO]);; + +let MSUM_NEG = prove + (`!(f:A->real^N^M) s. + FINITE s ==> msum s (\i. --(f(i))) = --(msum s f)`, + ONCE_REWRITE_TAC[MATRIX_NEG_MINUS1] THEN + REWRITE_TAC[MSUM_CMUL]);; + +let MSUM_SUB = prove + (`!f g s. FINITE s ==> (msum s (\x. f(x) - g(x)) = msum s f - msum s g)`, + REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN + SIMP_TAC[MSUM_ADD; MSUM_CMUL]);; + +let MSUM_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> msum(m..n) f = f(m) + msum(m+1..n) f`, + SIMP_TAC[GSYM NUMSEG_LREC; MSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ARITH_TAC);; + +let MSUM_SUPPORT = prove + (`!f s. msum (support (+) f s) f = msum s f`, + SIMP_TAC[msum; iterate; SUPPORT_SUPPORT]);; + +let MSUM_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (msum s f = msum s g)`, + REWRITE_TAC[msum] THEN + MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; + +let MSUM_RESTRICT_SET = prove + (`!P s f. msum {x:A | x IN s /\ P x} f = + msum s (\x. if P x then f(x) else mat 0)`, + ONCE_REWRITE_TAC[GSYM MSUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_MATRIX_ADD; IN_ELIM_THM] THEN + REWRITE_TAC[MESON[] `~((if P x then f x else a) = a) <=> P x /\ ~(f x = a)`; + GSYM CONJ_ASSOC] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC MSUM_EQ THEN SIMP_TAC[IN_ELIM_THM]);; + +let MSUM_SING = prove + (`!f x. msum {x} f = f(x)`, + SIMP_TAC[MSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; MATRIX_ADD_RID]);; + +let MSUM_IMAGE = prove + (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> (msum (IMAGE f s) g = msum s (g o f))`, + REWRITE_TAC[msum; GSYM NEUTRAL_MATRIX_ADD] THEN + MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_MATRIX_ADD]);; + +let MSUM_OFFSET = prove + (`!p f m n. msum(m+p..n+p) f = msum(m..n) (\i. f(i + p))`, + SIMP_TAC[NUMSEG_OFFSET_IMAGE; MSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[o_DEF]);; + +let MSUM_COMPONENT = prove + (`!f:A->real^N^M i j s. + 1 <= i /\ i <= dimindex(:M) /\ + 1 <= j /\ j <= dimindex(:N) /\ + FINITE s + ==> (msum s f)$i$j = sum s (\a. f(a)$i$j)`, + REPLICATE_TAC 3 GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT DISCH_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[MSUM_CLAUSES; SUM_CLAUSES] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; COND_ID]);; + +let MSUM_CLAUSES_NUMSEG = prove + (`(!m. msum(m..0) f = if m = 0 then f(0) else mat 0) /\ + (!m n. msum(m..SUC n) f = if m <= SUC n then msum(m..n) f + f(SUC n) + else msum(m..n) f)`, + REWRITE_TAC[MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_MATRIX_ADD; + NEUTRAL_MATRIX_ADD; msum]);; + +let MPOW_ADD = prove + (`!A:real^N^N m n. A mpow (m + n) = A mpow m ** A mpow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; mpow; MATRIX_MUL_LID] THEN + REWRITE_TAC[MATRIX_MUL_ASSOC]);; + +let MPOW_1 = prove + (`!A:real^N^N. A mpow 1 = A`, + REWRITE_TAC[num_CONV `1`; mpow] THEN + REWRITE_TAC[SYM(num_CONV `1`); MATRIX_MUL_RID]);; + +let MPOW_SUC = prove + (`!A:real^N^N n. A mpow (SUC n) = A mpow n ** A`, + REWRITE_TAC[ADD1; MPOW_ADD; MPOW_1]);; + +(* ------------------------------------------------------------------------- *) +(* The main lemma underlying the proof. *) +(* ------------------------------------------------------------------------- *) + +let MATRIC_POLYFUN_EQ_0 = prove + (`!n A:num->real^N^M. + (!x. msum(0..n) (\i. x pow i %% A i) = mat 0) <=> + (!i. i IN 0..n ==> A i = mat 0)`, + SIMP_TAC[CART_EQ; MSUM_COMPONENT; MAT_COMPONENT; LAMBDA_BETA; + FINITE_NUMSEG; COND_ID; + ONCE_REWRITE_RULE[REAL_MUL_SYM] MATRIX_CMUL_COMPONENT] THEN + REWRITE_TAC[MESON[] + `(!x i. P i ==> !j. Q j ==> R x i j) <=> + (!i. P i ==> !j. Q j ==> !x. R x i j)`] THEN + REWRITE_TAC[REAL_POLYFUN_EQ_0] THEN MESON_TAC[]);; + +let MATRIC_POLY_LEMMA = prove + (`!(A:real^N^N) B (C:real^N^N) n. + (!x. msum (0..n) (\i. (x pow i) %% B i) ** (A - x %% mat 1) = C) + ==> C = mat 0`, + SIMP_TAC[GSYM MSUM_MATRIX_RMUL; FINITE_NUMSEG; MATRIX_SUB_LDISTRIB] THEN + REWRITE_TAC[MATRIX_MUL_RMUL] THEN ONCE_REWRITE_TAC[MATRIX_MUL_LMUL] THEN + ONCE_REWRITE_TAC[MATRIX_CMUL_ASSOC] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + SIMP_TAC[MSUM_SUB; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x. msum(0..SUC n) + (\i. x pow i %% (((if i = 0 then (--C:real^N^N) else mat 0) + + (if i <= n then B i ** (A:real^N^N) else mat 0)) - + (if i = 0 then mat 0 else B(i - 1) ** mat 1))) = + mat 0` + MP_TAC THENL + [SIMP_TAC[MATRIX_CMUL_SUB_LDISTRIB; MSUM_SUB; FINITE_NUMSEG; + MATRIX_CMUL_ADD_LDISTRIB; MSUM_ADD] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MATRIX_CMUL_RZERO] THEN + ONCE_REWRITE_TAC[MESON[] + `(if p then mat 0 else x) = (if ~p then x else mat 0)`] THEN + REWRITE_TAC[GSYM MSUM_RESTRICT_SET; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `(0 <= i /\ i <= SUC n) /\ i = 0 <=> i = 0`; + ARITH_RULE `(0 <= i /\ i <= SUC n) /\ i <= n <=> 0 <= i /\ i <= n`; + ARITH_RULE `(0 <= i /\ i <= SUC n) /\ ~(i = 0) <=> + 1 <= i /\ i <= SUC n`] THEN + REWRITE_TAC[SING_GSPEC; GSYM numseg; MSUM_SING; real_pow] THEN + REWRITE_TAC[MATRIX_CMUL_LID] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC ONCE_DEPTH_CONV [GSYM th]) THEN + REWRITE_TAC[MATRIX_NEG_SUB] THEN REWRITE_TAC[MATRIX_SUB; AC MATRIX_ADD_AC + `(((A:real^N^N) + --B) + B) + C = (--B + B) + A + C`] THEN + REWRITE_TAC[MATRIX_ADD_LNEG; MATRIX_ADD_LID] THEN + REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[ADD1; MSUM_OFFSET] THEN + REWRITE_TAC[ADD_CLAUSES; ADD_SUB; MATRIX_ADD_RNEG]; + REWRITE_TAC[MATRIC_POLYFUN_EQ_0; IN_NUMSEG; LE_0] THEN DISCH_TAC THEN + SUBGOAL_THEN `!i:num. B(n - i) = (mat 0:real^N^N)` MP_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN + REWRITE_TAC[LE_REFL; SUB_0; NOT_SUC; ARITH_RULE `~(SUC n <= n)`] THEN + REWRITE_TAC[MATRIX_ADD_LID; SUC_SUB1; MATRIX_MUL_RID] THEN + REWRITE_TAC[MATRIX_SUB_LZERO; MATRIX_NEG_EQ_0]; + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + DISJ_CASES_TAC(ARITH_RULE `n - SUC m = n - m \/ m < n`) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - m:num`) THEN + ASM_SIMP_TAC[ARITH_RULE `m < n ==> ~(n - m = 0)`; + ARITH_RULE `n - m <= SUC n /\ n - m <= n`] THEN + REWRITE_TAC[MATRIX_MUL_LZERO; MATRIX_ADD_LID; MATRIX_SUB_LZERO] THEN + REWRITE_TAC[MATRIX_MUL_RID; MATRIX_NEG_EQ_0] THEN + ASM_SIMP_TAC[ARITH_RULE `n - m - 1 = n - SUC m`]]; + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[SUB_REFL] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN + ASM_REWRITE_TAC[LE_0; MATRIX_MUL_LZERO; MATRIX_ADD_RID] THEN + REWRITE_TAC[MATRIX_SUB_RZERO; MATRIX_NEG_EQ_0]]]);; + +(* ------------------------------------------------------------------------- *) +(* Show that cofactor and determinant are n-1 and n degree polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLYFUN_N_CONST = prove + (`!c n. ?b. !x. c = sum(0..n) (\i. b i * x pow i)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\i. if i = 0 then c else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `(0 <= i /\ i <= n) /\ i = 0 <=> i = 0`] THEN + REWRITE_TAC[SING_GSPEC; SUM_SING; real_pow; REAL_MUL_RID]);; + +let POLYFUN_N_ADD = prove + (`!f g. (?b. !x. f(x) = sum(0..n) (\i. b i * x pow i)) /\ + (?c. !x. g(x) = sum(0..n) (\i. c i * x pow i)) + ==> ?d. !x. f(x) + g(x) = sum(0..n) (\i. d i * x pow i)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\i. (b:num->real) i + c i` THEN + ASM_REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_RDISTRIB]);; + +let POLYFUN_N_CMUL = prove + (`!f c. (?b. !x. f(x) = sum(0..n) (\i. b i * x pow i)) + ==> ?b. !x. c * f(x) = sum(0..n) (\i. b i * x pow i)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\i. c * (b:num->real) i` THEN + ASM_REWRITE_TAC[SUM_LMUL; GSYM REAL_MUL_ASSOC]);; + +let POLYFUN_N_SUM = prove + (`!f s. FINITE s /\ + (!a. a IN s ==> ?b. !x. f x a = sum(0..n) (\i. b i * x pow i)) + ==> ?b. !x. sum s (f x) = sum(0..n) (\i. b i * x pow i)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; FORALL_IN_INSERT; NOT_IN_EMPTY; POLYFUN_N_CONST] THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN + MATCH_MP_TAC POLYFUN_N_ADD THEN ASM_SIMP_TAC[]);; + +let POLYFUN_N_PRODUCT = prove + (`!f s n. FINITE s /\ + (!a:A. a IN s ==> ?c d. !x. f x a = c + d * x) /\ CARD(s) <= n + ==> ?b. !x. product s (f x) = sum(0..n) (\i. b i * x pow i)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; POLYFUN_N_CONST; FORALL_IN_INSERT] THEN + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES] THEN + INDUCT_TAC THENL [ARITH_TAC; REWRITE_TAC[LE_SUC]] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:num->real`) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `c:real` (X_CHOOSE_TAC `d:real`)) THEN + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `\i. (if i <= n then c * b i else &0) + + (if ~(i = 0) then d * b(i - 1) else &0)` THEN + X_GEN_TAC `x:real` THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; GSYM SUM_LMUL; REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE + `((0 <= i /\ i <= SUC n) /\ i <= n <=> 0 <= i /\ i <= n) /\ + ((0 <= i /\ i <= SUC n) /\ ~(i = 0) <=> 1 <= i /\ i <= SUC n)`] THEN + REWRITE_TAC[GSYM numseg] THEN + REWRITE_TAC[MESON[num_CONV `1`; ADD1] `1..SUC n = 0+1..n+1`] THEN + REWRITE_TAC[SUM_OFFSET; ADD_SUB; REAL_POW_ADD] THEN + BINOP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REAL_ARITH_TAC);; + +let COFACTOR_ENTRY_AS_POLYFUN = prove + (`!A:real^N^N x i j. + 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> ?c. !x. cofactor(A - x %% mat 1)$i$j = + sum(0..dimindex(:N)-1) (\i. c(i) * x pow i)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[cofactor; LAMBDA_BETA; det] THEN + MATCH_MP_TAC POLYFUN_N_SUM THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN + X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN + MATCH_MP_TAC POLYFUN_N_CMUL THEN + SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN ASM_ARITH_TAC; + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG]] THEN + ASM_REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN + MATCH_MP_TAC POLYFUN_N_CMUL THEN + MATCH_MP_TAC POLYFUN_N_PRODUCT THEN + SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_NUMSEG] THEN + ASM_REWRITE_TAC[IN_NUMSEG; IN_DELETE; CARD_NUMSEG_1; LE_REFL] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN + ASM_SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN STRIP_TAC THEN + ASM_CASES_TAC `(p:num->num) k = j` THEN ASM_REWRITE_TAC[] THENL + [REPEAT(EXISTS_TAC `&0`) THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `a - x * d:real = a + (--d) * x`] THEN MESON_TAC[]);; + +let DETERMINANT_AS_POLYFUN = prove + (`!A:real^N^N. + ?c. !x. det(A - x %% mat 1) = + sum(0..dimindex(:N)) (\i. c(i) * x pow i)`, + GEN_TAC THEN REWRITE_TAC[det] THEN + MATCH_MP_TAC POLYFUN_N_SUM THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN + X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN + MATCH_MP_TAC POLYFUN_N_CMUL THEN MATCH_MP_TAC POLYFUN_N_PRODUCT THEN + SIMP_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; LE_REFL; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN + ASM_SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `a - x * d:real = a + (--d) * x`] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence define characteristic polynomial coefficients. *) +(* ------------------------------------------------------------------------- *) + +let char_poly = new_specification ["char_poly"] + (REWRITE_RULE[SKOLEM_THM] DETERMINANT_AS_POLYFUN);; + +(* ------------------------------------------------------------------------- *) +(* Now the Cayley-Hamilton proof. *) +(* ------------------------------------------------------------------------- *) + +let COFACTOR_AS_MATRIC_POLYNOMIAL = prove + (`!A:real^N^N. ?C. + !x. cofactor(A - x %% mat 1) = + msum(0..dimindex(:N)-1) (\i. x pow i %% C i)`, + GEN_TAC THEN SIMP_TAC[CART_EQ; MSUM_COMPONENT; FINITE_NUMSEG] THEN + MP_TAC(ISPEC `A:real^N^N` COFACTOR_ENTRY_AS_POLYFUN) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[LAMBDA_SKOLEM] THEN + DISCH_THEN(X_CHOOSE_THEN `c:(num->real)^N^N` ASSUME_TAC) THEN + EXISTS_TAC `(\i. lambda j k. ((c:(num->real)^N^N)$j$k) i):num->real^N^N` THEN + MAP_EVERY X_GEN_TAC [`x:real`; `i:num`] THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_CMUL_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);; + +let MATRIC_POWER_DIFFERENCE = prove + (`!A:real^N^N x n. + A mpow (SUC n) - x pow (SUC n) %% mat 1 = + msum (0..n) (\i. x pow i %% A mpow (n - i)) ** (A - x %% mat 1)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[MSUM_CLAUSES_NUMSEG; real_pow; SUB_0; mpow] THEN + REWRITE_TAC[MATRIX_MUL_RID; MATRIX_CMUL_LID; MATRIX_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_RID]; + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `(A mpow SUC n - x pow SUC n %% mat 1) ** A + + (x pow (SUC n) %% mat 1 :real^N^N) ** (A - x %% mat 1:real^N^N)` THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MPOW_SUC] THEN + REWRITE_TAC[MATRIX_SUB_RDISTRIB; MATRIX_SUB_LDISTRIB] THEN + REWRITE_TAC[MATRIX_SUB; MATRIX_MUL_LMUL; MATRIX_MUL_LID] THEN + REWRITE_TAC[GSYM MATRIX_ADD_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_LNEG; MATRIX_ADD_LID] THEN + REWRITE_TAC[real_pow; MATRIX_CMUL_ASSOC] THEN REWRITE_TAC[REAL_MUL_AC]; + + ASM_REWRITE_TAC[MSUM_CLAUSES_NUMSEG; LE_0] THEN + REWRITE_TAC[SUB_REFL; mpow; MATRIX_ADD_RDISTRIB] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM MSUM_MATRIX_RMUL; FINITE_NUMSEG] THEN + MATCH_MP_TAC MSUM_EQ THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_MUL_LMUL] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `i <= n ==> SUC n - i = SUC(n - i)`] THEN + REWRITE_TAC[MPOW_SUC; GSYM MATRIX_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[MATRIX_SUB_LDISTRIB; MATRIX_SUB_RDISTRIB] THEN + REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_MUL_LMUL] THEN + REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]]]);; + +let MATRIC_CHARPOLY_DIFFERENCE = prove + (`!A:real^N^N. ?B. + !x. msum(0..dimindex(:N)) (\i. char_poly A i %% A mpow i) - + sum(0..dimindex(:N)) (\i. char_poly A i * x pow i) %% mat 1 = + msum(0..(dimindex(:N)-1)) (\i. x pow i %% B i) ** (A - x %% mat 1)`, + GEN_TAC THEN SPEC_TAC(`dimindex(:N)`,`n:num`) THEN + SPEC_TAC(`char_poly(A:real^N^N)`,`c:num->real`) THEN + GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[MSUM_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG; LE_0] THENL + [EXISTS_TAC `(\i. mat 0):num->real^N^N` THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[real_pow; MATRIX_MUL_LMUL; MATRIX_MUL_LZERO; mpow; + REAL_MUL_RID; MATRIX_CMUL_RZERO; MATRIX_SUB_REFL]; + FIRST_X_ASSUM(X_CHOOSE_TAC `B:num->real^N^N`) THEN + REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_ADD; MATRIX_CMUL_ADD_RDISTRIB] THEN + ONCE_REWRITE_TAC[AC MATRIX_ADD_AC + `(A + B) + (C + D):real^N^N = (A + C) + (B + D)`] THEN + ASM_REWRITE_TAC[GSYM MATRIX_SUB] THEN + REWRITE_TAC[GSYM MATRIX_CMUL_ASSOC; GSYM MATRIX_CMUL_SUB_LDISTRIB] THEN + REWRITE_TAC[MATRIC_POWER_DIFFERENCE; SUC_SUB1] THEN + EXISTS_TAC `(\i. (if i <= n - 1 then B i else mat 0) + + c(SUC n) %% A mpow (n - i)):num->real^N^N` THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[MATRIX_CMUL_ADD_LDISTRIB] THEN + SIMP_TAC[MSUM_ADD; FINITE_NUMSEG; MATRIX_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM MATRIX_MUL_LMUL] THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THENL + [REWRITE_TAC[COND_RAND; COND_RATOR; MATRIX_CMUL_RZERO] THEN + REWRITE_TAC[GSYM MSUM_RESTRICT_SET; IN_NUMSEG] THEN + REWRITE_TAC[numseg; ARITH_RULE + `(0 <= i /\ i <= n) /\ i <= n - 1 <=> 0 <= i /\ i <= n - 1`]; + SIMP_TAC[GSYM MSUM_CMUL; FINITE_NUMSEG; MATRIX_CMUL_ASSOC] THEN + REWRITE_TAC[REAL_MUL_SYM]]]);; + +let CAYLEY_HAMILTON = prove + (`!A:real^N^N. msum(0..dimindex(:N)) (\i. char_poly A i %% A mpow i) = mat 0`, + GEN_TAC THEN MATCH_MP_TAC MATRIC_POLY_LEMMA THEN MATCH_MP_TAC(MESON[] + `!g. (!x. g x = k) /\ (?a b c. !x. f a b c x = g x) + ==> ?a b c. !x. f a b c x = k`) THEN + EXISTS_TAC + `\x. (msum(0..dimindex(:N)) (\i. char_poly A i %% (A:real^N^N) mpow i) - + sum(0..dimindex(:N)) (\i. char_poly A i * x pow i) %% mat 1) + + sum(0..dimindex(:N)) (\i. char_poly A i * x pow i) %% mat 1` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[MATRIX_SUB; GSYM MATRIX_ADD_ASSOC; MATRIX_ADD_LNEG] THEN + REWRITE_TAC[MATRIX_ADD_RID]; + X_CHOOSE_THEN `B:num->real^N^N` (fun th -> ONCE_REWRITE_TAC[th]) + (ISPEC `A:real^N^N` MATRIC_CHARPOLY_DIFFERENCE) THEN + REWRITE_TAC[GSYM char_poly; GSYM MATRIX_MUL_LEFT_COFACTOR] THEN + REWRITE_TAC[GSYM MATRIX_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM COFACTOR_TRANSP; TRANSP_MATRIX_SUB] THEN + REWRITE_TAC[TRANSP_MATRIX_CMUL; TRANSP_MAT] THEN + X_CHOOSE_THEN `C:num->real^N^N` (fun th -> ONCE_REWRITE_TAC[th]) + (ISPEC `transp A:real^N^N` COFACTOR_AS_MATRIC_POLYNOMIAL) THEN + MAP_EVERY EXISTS_TAC + [`A:real^N^N`; `(\i. B i + C i):num->real^N^N`; `dimindex(:N)-1`] THEN + SIMP_TAC[GSYM MSUM_ADD; FINITE_NUMSEG; MATRIX_CMUL_ADD_LDISTRIB]]);; diff --git a/100/ceva.ml b/100/ceva.ml new file mode 100644 index 0000000..ce35d60 --- /dev/null +++ b/100/ceva.ml @@ -0,0 +1,215 @@ +(* ========================================================================= *) +(* #61: Ceva's theorem. *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; +needs "Examples/sos.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* We use the notion of "betweenness". *) +(* ------------------------------------------------------------------------- *) + +let BETWEEN_THM = prove + (`between x (a,b) <=> + ?u. &0 <= u /\ u <= &1 /\ x = u % a + (&1 - u) % b`, + REWRITE_TAC[BETWEEN_IN_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN + REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + AP_TERM_TAC THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas to reduce geometric concepts to more convenient forms. *) +(* ------------------------------------------------------------------------- *) + +let NORM_CROSS = prove + (`norm(a) * norm(b) * norm(c) = norm(d) * norm(e) * norm(f) <=> + (a dot a) * (b dot b) * (c dot c) = (d dot d) * (e dot e) * (f dot f)`, + let lemma = prove + (`!x y. &0 <= x /\ &0 <= y ==> (x pow 2 = y pow 2 <=> x = y)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_2] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN + ASM_MESON_TAC[REAL_LT_MUL2; REAL_LT_REFL]) in + REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_MUL] THEN + MATCH_MP_TAC(GSYM lemma) THEN SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]);; + +let COLLINEAR = prove + (`!a b c:real^2. + collinear {a:real^2,b,c} <=> + ((a$1 - b$1) * (b$2 - c$2) = (a$2 - b$2) * (b$1 - c$1))`, + let lemma = prove + (`~(y1 = &0) /\ x2 * y1 = x1 * y2 ==> ?c. x1 = c * y1 /\ x2 = c * y2`, + STRIP_TAC THEN EXISTS_TAC `x1 / y1` THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^2 = b` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_MUL_LZERO] THEN + REWRITE_TAC[COLLINEAR_SING; COLLINEAR_2; INSERT_AC]; + ALL_TAC] THEN + REWRITE_TAC[collinear] THEN EQ_TAC THENL + [DISCH_THEN(CHOOSE_THEN (fun th -> + MP_TAC(SPECL [`a:real^2`; `b:real^2`] th) THEN + MP_TAC(SPECL [`b:real^2`; `c:real^2`] th))) THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC `a - b:real^2` THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; ARITH; DE_MORGAN_THM] THEN STRIP_TAC THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; ARITH] + THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN(REPEAT_TCL STRIP_THM_THEN SUBST1_TAC)) THEN + MATCH_MP_TAC lemma THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* More or less automatic proof of the main direction. *) +(* ------------------------------------------------------------------------- *) + +let CEVA_WEAK = prove + (`!A B C X Y Z P:real^2. + ~(collinear {A,B,C}) /\ + between X (B,C) /\ between Y (A,C) /\ between Z (A,B) /\ + between P (A,X) /\ between P (B,Y) /\ between P (C,Z) + ==> dist(B,X) * dist(C,Y) * dist(A,Z) = + dist(X,C) * dist(Y,A) * dist(Z,B)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[dist; NORM_CROSS; COLLINEAR; BETWEEN_THM] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o check (is_var o lhs o concl))) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN + SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; + CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN + FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* More laborious proof of equivalence. *) +(* ------------------------------------------------------------------------- *) + +let CEVA = prove + (`!A B C X Y Z:real^2. + ~(collinear {A,B,C}) /\ + between X (B,C) /\ between Y (C,A) /\ between Z (A,B) + ==> (dist(B,X) * dist(C,Y) * dist(A,Z) = + dist(X,C) * dist(Y,A) * dist(Z,B) <=> + (?P. between P (A,X) /\ between P (B,Y) /\ between P (C,Z)))`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`A:real^2 = B`; `A:real^2 = C`; `B:real^2 = C`] THEN + ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[BETWEEN_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `x:real`) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `y:real`) + (X_CHOOSE_TAC `z:real`)) THEN + REPEAT(FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC)) THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN REWRITE_TAC[dist] THEN + REWRITE_TAC[VECTOR_ARITH `B - (x % B + (&1 - x) % C) = (&1 - x) % (B - C)`; + VECTOR_ARITH `(x % B + (&1 - x) % C) - C = x % (B - C)`] THEN + REWRITE_TAC[NORM_MUL] THEN + REWRITE_TAC[REAL_ARITH `(a * a') * (b * b') * (c * c') = + (a * b * c) * (a' * b' * c')`] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_MUL_RCANCEL; REAL_ENTIRE] THEN + ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1`; real_abs] THEN + EQ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR]) THEN + SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; FORALL_2; + VECTOR_ADD_COMPONENT; CART_EQ; VECTOR_MUL_COMPONENT; ARITH] THEN + CONV_TAC REAL_RING] THEN + DISCH_TAC THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + SUBGOAL_THEN + `?u v w. w = (&1 - u) * (&1 - x) /\ + v = (&1 - u) * x /\ + u = (&1 - v) * (&1 - y) /\ + u = (&1 - w) * z /\ + v = (&1 - w) * (&1 - z) /\ + w = (&1 - v) * y /\ + &0 <= u /\ u <= &1 /\ &0 <= v /\ v <= &1 /\ &0 <= w /\ w <= &1` + (STRIP_ASSUME_TAC o GSYM) THENL + [ALL_TAC; + EXISTS_TAC `u % A + v % B + w % C:real^2` THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`; EXISTS_TAC `w:real`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC] THEN + REWRITE_TAC[UNWIND_THM2] THEN + MATCH_MP_TAC(MESON[] + `(!x. p x /\ q x ==> r x) /\ (?x. p x /\ q x) + ==> (?x. p x /\ q x /\ r x)`) THEN + CONJ_TAC THENL + [GEN_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_neg o concl))) THEN + REWRITE_TAC[IMP_IMP] THEN + REPEAT(MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ (a /\ b /\ c ==> d) + ==> a ==> b /\ c /\ d`) THEN + CONJ_TAC THENL + [CONV_TAC REAL_RING ORELSE CONV_TAC REAL_SOS; ALL_TAC]) THEN + CONV_TAC REAL_SOS; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR]) THEN + ASM_CASES_TAC `x = &0` THENL + [EXISTS_TAC `&1 - y / (&1 - x + x * y)` THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_neg o concl))) THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + EXISTS_TAC `&1 - (&1 - z) / (x + (&1 - x) * (&1 - z))` THEN + SUBGOAL_THEN `~(x + (&1 - x) * (&1 - z) = &0)` MP_TAC THENL + [ALL_TAC; + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_neg o concl))) THEN + CONV_TAC REAL_FIELD] THEN + MATCH_MP_TAC(REAL_ARITH + `z * (&1 - x) < &1 ==> ~(x + (&1 - x) * (&1 - z) = &0)`) THEN + ASM_CASES_TAC `z = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1 * (&1 - x)` THEN + ASM_SIMP_TAC[REAL_LE_RMUL; REAL_ARITH `x <= &1 ==> &0 <= &1 - x`] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Just for geometric intuition, verify metrical version of "between". *) +(* This isn't actually needed in the proof. Moreover, this is now actually *) +(* the definition of "between" so this is all a relic. *) +(* ------------------------------------------------------------------------- *) + +let BETWEEN_SYM = prove + (`!u v w. between v (u,w) <=> between v (w,u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BETWEEN_THM] THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN TRY VECTOR_ARITH_TAC THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let BETWEEN_METRICAL = prove + (`!u v w:real^N. between v (u,w) <=> dist(u,v) + dist(v,w) = dist(u,w)`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + ONCE_REWRITE_TAC[BETWEEN_SYM] THEN REWRITE_TAC[BETWEEN_THM; dist] THEN + REWRITE_TAC[VECTOR_ARITH `x % u + (&1 - x) % v = v + x % (u - v)`] THEN + SUBST1_TAC(VECTOR_ARITH `u - w:real^N = (u - v) + (v - w)`) THEN + CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[NORM_TRIANGLE_EQ] THEN + EQ_TAC THENL + [ALL_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH `u - (u + x):real^N = --x`; NORM_NEG; + VECTOR_ARITH `(u + c % (w - u)) - w = (&1 - c) % (u - w)`] THEN + REWRITE_TAC[VECTOR_ARITH `a % --(c % (x - y)) = (a * c) % (y - x)`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; NORM_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `c <= &1 ==> abs(&1 - c) = &1 - c`; + REAL_ARITH `&0 <= c ==> abs c = c`] THEN + REWRITE_TAC[NORM_SUB; REAL_MUL_AC]] THEN + DISCH_TAC THEN ASM_CASES_TAC `&0 < norm(u - v:real^N) + norm(v - w)` THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `~(&0 < x + y) ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN + REWRITE_TAC[NORM_POS_LE; NORM_EQ_0; VECTOR_SUB_EQ] THEN + STRIP_TAC THEN EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS] THEN + VECTOR_ARITH_TAC] THEN + EXISTS_TAC `norm(u - v:real^N) / (norm(u - v) + norm(v - w))` THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LZERO; + REAL_MUL_LID; REAL_LE_ADDR; NORM_POS_LE] THEN + MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN + EXISTS_TAC `norm(u - v:real^N) + norm(v - w)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `x % (y + z % v) = x % y + (x * z) % v`] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_LMUL] THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN VECTOR_ARITH_TAC);; diff --git a/100/chords.ml b/100/chords.ml new file mode 100644 index 0000000..3ca66ac --- /dev/null +++ b/100/chords.ml @@ -0,0 +1,65 @@ +(* ========================================================================= *) +(* #55: Theorem on product of segments of chords. *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Geometric concepts. *) +(* ------------------------------------------------------------------------- *) + +let BETWEEN_THM = prove + (`between x (a,b) <=> + ?u. &0 <= u /\ u <= &1 /\ x = u % a + (&1 - u) % b`, + REWRITE_TAC[BETWEEN_IN_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN + REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + AP_TERM_TAC THEN VECTOR_ARITH_TAC);; + +let length = new_definition + `length(A:real^2,B:real^2) = norm(B - A)`;; + +(* ------------------------------------------------------------------------- *) +(* One more special reduction theorem to avoid square roots. *) +(* ------------------------------------------------------------------------- *) + +let lemma = prove + (`!x y. &0 <= x /\ &0 <= y ==> (x pow 2 = y pow 2 <=> x = y)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REAL_POW_2] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN + ASM_MESON_TAC[REAL_LT_MUL2; REAL_LT_REFL]);; + +let NORM_CROSS = prove + (`norm(a) * norm(b) = norm(c) * norm(d) <=> + (a dot a) * (b dot b) = (c dot c) * (d dot d)`, + REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_MUL] THEN + MATCH_MP_TAC(GSYM lemma) THEN SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Now the main theorem. *) +(* ------------------------------------------------------------------------- *) + +let SEGMENT_CHORDS = prove + (`!centre radius q r s t b. + between b (q,r) /\ between b (s,t) /\ + length(q,centre) = radius /\ length(r,centre) = radius /\ + length(s,centre) = radius /\ length(t,centre) = radius + ==> length(q,b) * length(b,r) = length(s,b) * length(b,t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[length; NORM_CROSS; BETWEEN_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) MP_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) MP_TAC) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN + (MP_TAC o AP_TERM `\x. x pow 2`)) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN REWRITE_TAC[NORM_POW_2] THEN + ABBREV_TAC `rad = radius pow 2` THEN POP_ASSUM_LIST(K ALL_TAC) THEN + SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; + CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN + CONV_TAC REAL_RING);; diff --git a/100/circle.ml b/100/circle.ml new file mode 100644 index 0000000..80338a6 --- /dev/null +++ b/100/circle.ml @@ -0,0 +1,142 @@ +(* ========================================================================= *) +(* Area of a circle. *) +(* ========================================================================= *) + +needs "Multivariate/measure.ml";; +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* Circle area. Should maybe extend WLOG tactics for such scaling. *) +(* ------------------------------------------------------------------------- *) + +let AREA_UNIT_CBALL = prove + (`measure(cball(vec 0:real^2,&1)) = pi`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE[`:1`,`:M`; `:2`,`:N`] FUBINI_SIMPLE_COMPACT) THEN + EXISTS_TAC `1` THEN + SIMP_TAC[DIMINDEX_1; DIMINDEX_2; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN + REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN + SUBGOAL_THEN `!t. abs(t) <= &1 <=> t IN real_interval[-- &1,&1]` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; BALL_1] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. &2 * sqrt(&1 - t pow 2)` THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN SIMP_TAC[IN_REAL_INTERVAL; MEASURE_INTERVAL] THEN + REWRITE_TAC[REAL_BOUNDS_LE; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN + DISCH_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) CONTENT_1 o rand o snd) THEN + REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[REAL_POW_ONE] THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> --x <= x`) THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; + REAL_ABS_NUM]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x. asn(x) + x * sqrt(&1 - x pow 2)`; + `\x. &2 * sqrt(&1 - x pow 2)`; + `-- &1`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN + REWRITE_TAC[ASN_1; ASN_NEG_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SQRT_0; REAL_MUL_RZERO; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH `x / &2 - --(x / &2) = x`] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + SIMP_TAC[REAL_CONTINUOUS_ON_ASN; IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_POW; + REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SQRT THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1 pow 2`] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM] THEN + REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LT] THEN REPEAT STRIP_TAC THEN + REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LID; REAL_POW_1; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RNEG; REAL_INV_MUL] THEN + ASM_REWRITE_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1] THEN + MATCH_MP_TAC(REAL_FIELD + `s pow 2 = &1 - x pow 2 /\ x pow 2 < &1 + ==> (inv s + x * --(&2 * x) * inv (&2) * inv s + s) = &2 * s`) THEN + ASM_SIMP_TAC[ABS_SQUARE_LT_1; SQRT_POW_2; REAL_SUB_LE; REAL_LT_IMP_LE]]);; + +let AREA_CBALL = prove + (`!z:real^2 r. &0 <= r ==> measure(cball(z,r)) = pi * r pow 2`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `r = &0` THENL + [ASM_SIMP_TAC[CBALL_SING; REAL_POW_2; REAL_MUL_RZERO] THEN + MATCH_MP_TAC MEASURE_UNIQUE THEN + REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_SING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`cball(vec 0:real^2,&1)`; `r:real`; `z:real^2`; `pi`] + HAS_MEASURE_AFFINITY) THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_CBALL; + AREA_UNIT_CBALL] THEN + ASM_REWRITE_TAC[real_abs; DIMINDEX_2] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_CBALL_0; IN_IMAGE] THEN REWRITE_TAC[IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH `dist(z,a + z) = norm a`; NORM_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `abs r * x <= r <=> abs r * x <= r * &1`] THEN + ASM_SIMP_TAC[real_abs; REAL_LE_LMUL; dist] THEN X_GEN_TAC `w:real^2` THEN + DISCH_TAC THEN EXISTS_TAC `inv(r) % (w - z):real^2` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN + CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_REWRITE_TAC[real_abs] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[]);; + +let AREA_BALL = prove + (`!z:real^2 r. &0 <= r ==> measure(ball(z,r)) = pi * r pow 2`, + SIMP_TAC[GSYM INTERIOR_CBALL; GSYM AREA_CBALL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN + SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; + +(* ------------------------------------------------------------------------- *) +(* Volume of a ball too, just for fun. *) +(* ------------------------------------------------------------------------- *) + +needs "Multivariate/wlog.ml";; + +let VOLUME_CBALL = prove + (`!z:real^3 r. &0 <= r ==> measure(cball(z,r)) = &4 / &3 * pi * r pow 3`, + GEOM_ORIGIN_TAC `z:real^3` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_COMPACT) THEN + EXISTS_TAC `1` THEN + SIMP_TAC[DIMINDEX_2; DIMINDEX_3; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN + REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN + SUBGOAL_THEN `!t. abs(t) <= r <=> t IN real_interval[--r,r]` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN + SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; + SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\t. pi * (r pow 2 * t - &1 / &3 * t pow 3)`; + `\t. pi * (r pow 2 - t pow 2)`; + `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC REAL_RING]);; + +let VOLUME_BALL = prove + (`!z:real^3 r. &0 <= r ==> measure(ball(z,r)) = &4 / &3 * pi * r pow 3`, + SIMP_TAC[GSYM INTERIOR_CBALL; GSYM VOLUME_CBALL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN + SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; diff --git a/100/combinations.ml b/100/combinations.ml new file mode 100644 index 0000000..5dd13d4 --- /dev/null +++ b/100/combinations.ml @@ -0,0 +1,116 @@ +(* ========================================================================= *) +(* Binomial coefficients and relation to number of combinations. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Binomial coefficients. *) +(* ------------------------------------------------------------------------- *) + +let binom = define + `(!n. binom(n,0) = 1) /\ + (!k. binom(0,SUC(k)) = 0) /\ + (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; + +let BINOM_LT = prove + (`!n k. n < k ==> (binom(n,k) = 0)`, + INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN + ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; + +let BINOM_REFL = prove + (`!n. binom(n,n) = 1`, + INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Usual "factorial" definition. *) +(* ------------------------------------------------------------------------- *) + +let BINOM_FACT = prove + (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, + INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; + +let BINOM_EXPLICIT = prove + (`!n k. binom(n,k) = + if n < k then 0 else FACT(n) DIV (FACT(k) * FACT(n - k))`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[BINOM_LT] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_LT; LE_EXISTS] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + SIMP_TAC[LT_MULT; FACT_LT; ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM BINOM_FACT] THEN + REWRITE_TAC[MULT_AC]);; + +(* ------------------------------------------------------------------------- *) +(* A tedious lemma. *) +(* ------------------------------------------------------------------------- *) + +let lemma = prove + (`~(a IN t) + ==> {u | u SUBSET (a:A INSERT t) /\ u HAS_SIZE (SUC m)} = + {u | u SUBSET t /\ u HAS_SIZE (SUC m)} UNION + IMAGE (\u. a INSERT u) {u | u SUBSET t /\ u HAS_SIZE m}`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `u:A->bool` THEN + ASM_CASES_TAC `(u:A->bool) SUBSET t` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `(u:A->bool) HAS_SIZE (SUC m)` THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `u DELETE (a:A)` THEN + REPEAT (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_SIZE_SUC]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC) THEN ASM SET_TAC[]; + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE_CLAUSES] THEN + EXISTS_TAC `a:A` THEN EXISTS_TAC `x':A->bool` THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The "number of combinations" formula. *) +(* ------------------------------------------------------------------------- *) + +let BINOM_INDUCT = prove + (`!P. (!n. P n 0) /\ + (!k. P 0 (SUC k)) /\ + (!n k. P n (SUC k) /\ P n k ==> P (SUC n) (SUC k)) + ==> !m n. P m n`, + GEN_TAC THEN STRIP_TAC THEN REPEAT INDUCT_TAC THEN ASM_MESON_TAC[]);; + +let NUMBER_OF_COMBINATIONS = prove + (`!n m s:A->bool. + s HAS_SIZE n + ==> {t | t SUBSET s /\ t HAS_SIZE m} HAS_SIZE binom(n,m)`, + MATCH_MP_TAC BINOM_INDUCT THEN REWRITE_TAC[binom] THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN CONV_TAC HAS_SIZE_CONV THEN + EXISTS_TAC `{}:A->bool` THEN SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_IN_EMPTY; HAS_SIZE_0] THEN SET_TAC[]; + SIMP_TAC[HAS_SIZE_0; SUBSET_EMPTY; HAS_SIZE_SUC] THEN SET_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN STRIP_TAC THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_SIZE_CLAUSES] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `t:A->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_SIMP_TAC[] THEN + UNDISCH_TAC `~(a:A IN t)` THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; HAS_SIZE_SUC] THEN + UNDISCH_TAC `~(a:A IN t)` THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit version. *) +(* ------------------------------------------------------------------------- *) + +let NUMBER_OF_COMBINATIONS_EXPLICIT = prove + (`!n m s:A->bool. + s HAS_SIZE n + ==> {t | t SUBSET s /\ t HAS_SIZE m} HAS_SIZE + (if n < m then 0 else FACT(n) DIV (FACT(m) * FACT(n - m)))`, + REWRITE_TAC[REWRITE_RULE[BINOM_EXPLICIT] NUMBER_OF_COMBINATIONS]);; diff --git a/100/constructible.ml b/100/constructible.ml new file mode 100644 index 0000000..0712bba --- /dev/null +++ b/100/constructible.ml @@ -0,0 +1,898 @@ +(* ========================================================================= *) +(* Non-constructibility of irrational cubic equation solutions. *) +(* *) +(* This gives the two classic impossibility results: trisecting an angle or *) +(* constructing the cube using traditional geometric constructions. *) +(* *) +(* This elementary proof (not using field extensions etc.) is taken from *) +(* Dickson's "First Course in the Theory of Equations", chapter III. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/floor.ml";; +needs "Multivariate/transcendentals.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* The critical lemma. *) +(* ------------------------------------------------------------------------- *) + +let STEP_LEMMA = prove + (`!P. (!n. P(&n)) /\ + (!x. P x ==> P(--x)) /\ + (!x. P x /\ ~(x = &0) ==> P(inv x)) /\ + (!x y. P x /\ P y ==> P(x + y)) /\ + (!x y. P x /\ P y ==> P(x * y)) + ==> !a b c z u v s. + P a /\ P b /\ P c /\ + z pow 3 + a * z pow 2 + b * z + c = &0 /\ + P u /\ P v /\ P(s * s) /\ z = u + v * s + ==> ?w. P w /\ w pow 3 + a * w pow 2 + b * w + c = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `v * s = &0` THENL + [ASM_REWRITE_TAC[REAL_ADD_RID] THEN MESON_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + MAP_EVERY ABBREV_TAC + [`A = a * s pow 2 * v pow 2 + &3 * s pow 2 * u * v pow 2 + + a * u pow 2 + u pow 3 + b * u + c`; + `B = s pow 2 * v pow 3 + &2 * a * u * v + &3 * u pow 2 * v + b * v`] THEN + SUBGOAL_THEN `A + B * s = &0` ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING; ALL_TAC] THEN + ASM_CASES_TAC `(P:real->bool) s` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `B = &0` ASSUME_TAC THENL + [UNDISCH_TAC `~P(s:real)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_FIELD + `A + B * s = &0 ==> ~(B = &0) ==> s = --A / B`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[real_div] THEN FIRST_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["A"; "B"] THEN + REWRITE_TAC[REAL_ARITH `x pow 3 = x * x * x`; REAL_POW_2] THEN + REPEAT(FIRST_ASSUM MATCH_ACCEPT_TAC ORELSE + (FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC)); + ALL_TAC] THEN + EXISTS_TAC `--(a + &2 * u)` THEN ASM_SIMP_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check ((not) o is_forall o concl))) THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Instantiate to square roots. *) +(* ------------------------------------------------------------------------- *) + +let STEP_LEMMA_SQRT = prove + (`!P. (!n. P(&n)) /\ + (!x. P x ==> P(--x)) /\ + (!x. P x /\ ~(x = &0) ==> P(inv x)) /\ + (!x y. P x /\ P y ==> P(x + y)) /\ + (!x y. P x /\ P y ==> P(x * y)) + ==> !a b c z u v s. + P a /\ P b /\ P c /\ + z pow 3 + a * z pow 2 + b * z + c = &0 /\ + P u /\ P v /\ P(s) /\ &0 <= s /\ z = u + v * sqrt(s) + ==> ?w. P w /\ w pow 3 + a * w pow 2 + b * w + c = &0`, + GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP STEP_LEMMA) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[SQRT_POW_2; REAL_POW_2]);; + +(* ------------------------------------------------------------------------- *) +(* Numbers definable by radicals involving square roots only. *) +(* ------------------------------------------------------------------------- *) + +let radical_RULES,radical_INDUCT,radical_CASES = new_inductive_definition + `(!x. rational x ==> radical x) /\ + (!x. radical x ==> radical (--x)) /\ + (!x. radical x /\ ~(x = &0) ==> radical (inv x)) /\ + (!x y. radical x /\ radical y ==> radical (x + y)) /\ + (!x y. radical x /\ radical y ==> radical (x * y)) /\ + (!x. radical x /\ &0 <= x ==> radical (sqrt x))`;; + +let RADICAL_RULES = prove + (`(!n. radical(&n)) /\ + (!x. rational x ==> radical x) /\ + (!x. radical x ==> radical (--x)) /\ + (!x. radical x /\ ~(x = &0) ==> radical (inv x)) /\ + (!x y. radical x /\ radical y ==> radical (x + y)) /\ + (!x y. radical x /\ radical y ==> radical (x - y)) /\ + (!x y. radical x /\ radical y ==> radical (x * y)) /\ + (!x y. radical x /\ radical y /\ ~(y = &0) ==> radical (x / y)) /\ + (!x n. radical x ==> radical(x pow n)) /\ + (!x. radical x /\ &0 <= x ==> radical (sqrt x))`, + SIMP_TAC[real_div; real_sub; radical_RULES; RATIONAL_NUM] THEN + GEN_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[radical_RULES; real_pow; RATIONAL_NUM]);; + +let RADICAL_TAC = + REPEAT(MATCH_ACCEPT_TAC (CONJUNCT1 RADICAL_RULES) ORELSE + (MAP_FIRST MATCH_MP_TAC(tl(tl(CONJUNCTS RADICAL_RULES))) THEN + REPEAT CONJ_TAC));; + +(* ------------------------------------------------------------------------- *) +(* Explicit "expressions" to support inductive proof. *) +(* ------------------------------------------------------------------------- *) + +let expression_INDUCT,expression_RECURSION = define_type + "expression = Constant real + | Negation expression + | Inverse expression + | Addition expression expression + | Multiplication expression expression + | Sqrt expression";; + +(* ------------------------------------------------------------------------- *) +(* Interpretation. *) +(* ------------------------------------------------------------------------- *) + +let value = define + `(value(Constant x) = x) /\ + (value(Negation e) = --(value e)) /\ + (value(Inverse e) = inv(value e)) /\ + (value(Addition e1 e2) = value e1 + value e2) /\ + (value(Multiplication e1 e2) = value e1 * value e2) /\ + (value(Sqrt e) = sqrt(value e))`;; + +(* ------------------------------------------------------------------------- *) +(* Wellformedness of an expression. *) +(* ------------------------------------------------------------------------- *) + +let wellformed = define + `(wellformed(Constant x) <=> rational x) /\ + (wellformed(Negation e) <=> wellformed e) /\ + (wellformed(Inverse e) <=> ~(value e = &0) /\ wellformed e) /\ + (wellformed(Addition e1 e2) <=> wellformed e1 /\ wellformed e2) /\ + (wellformed(Multiplication e1 e2) <=> wellformed e1 /\ wellformed e2) /\ + (wellformed(Sqrt e) <=> &0 <= value e /\ wellformed e)`;; + +(* ------------------------------------------------------------------------- *) +(* The set of radicals in an expression. *) +(* ------------------------------------------------------------------------- *) + +let radicals = define + `(radicals(Constant x) = {}) /\ + (radicals(Negation e) = radicals e) /\ + (radicals(Inverse e) = radicals e) /\ + (radicals(Addition e1 e2) = (radicals e1) UNION (radicals e2)) /\ + (radicals(Multiplication e1 e2) = (radicals e1) UNION (radicals e2)) /\ + (radicals(Sqrt e) = e INSERT (radicals e))`;; + +let FINITE_RADICALS = prove + (`!e. FINITE(radicals e)`, + MATCH_MP_TAC expression_INDUCT THEN + SIMP_TAC[radicals; FINITE_RULES; FINITE_UNION]);; + +let WELLFORMED_RADICALS = prove + (`!e. wellformed e ==> !r. r IN radicals(e) ==> &0 <= value r`, + MATCH_MP_TAC expression_INDUCT THEN + REWRITE_TAC[radicals; wellformed; NOT_IN_EMPTY; IN_UNION; IN_INSERT] THEN + MESON_TAC[]);; + +let RADICALS_WELLFORMED = prove + (`!e. wellformed e ==> !r. r IN radicals e ==> wellformed r`, + MATCH_MP_TAC expression_INDUCT THEN + REWRITE_TAC[radicals; wellformed; NOT_IN_EMPTY; IN_UNION; IN_INSERT] THEN + MESON_TAC[]);; + +let RADICALS_SUBSET = prove + (`!e r. r IN radicals e ==> radicals(r) SUBSET radicals(e)`, + MATCH_MP_TAC expression_INDUCT THEN + REWRITE_TAC[radicals; IN_UNION; NOT_IN_EMPTY; IN_INSERT; SUBSET] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Show that every radical is the interpretation of a wellformed expresion. *) +(* ------------------------------------------------------------------------- *) + +let RADICAL_EXPRESSION = prove + (`!x. radical x <=> ?e. wellformed e /\ x = value e`, + GEN_TAC THEN EQ_TAC THEN SPEC_TAC(`x:real`,`x:real`) THENL + [MATCH_MP_TAC radical_INDUCT THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_MESON_TAC[value; wellformed]; + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + MATCH_MP_TAC expression_INDUCT THEN + REWRITE_TAC[value; wellformed] THEN SIMP_TAC[radical_RULES]]);; + +(* ------------------------------------------------------------------------- *) +(* Nesting depth of radicals in an expression. *) +(* ------------------------------------------------------------------------- *) + +let LT_MAX = prove + (`!a b c. a < MAX b c <=> a < b \/ a < c`, + ARITH_TAC);; + +let depth = define + `(depth(Constant x) = 0) /\ + (depth(Negation e) = depth e) /\ + (depth(Inverse e) = depth e) /\ + (depth(Addition e1 e2) = MAX (depth e1) (depth e2)) /\ + (depth(Multiplication e1 e2) = MAX (depth e1) (depth e2)) /\ + (depth(Sqrt e) = 1 + depth e)`;; + +let IN_RADICALS_SMALLER = prove + (`!r s. s IN radicals(r) ==> depth(s) < depth(r)`, + MATCH_MP_TAC expression_INDUCT THEN REWRITE_TAC[radicals; depth] THEN + REWRITE_TAC[IN_UNION; NOT_IN_EMPTY; IN_INSERT; LT_MAX] THEN + MESON_TAC[ARITH_RULE `s = a \/ s < a ==> s < 1 + a`]);; + +let NOT_IN_OWN_RADICALS = prove + (`!r. ~(r IN radicals r)`, + MESON_TAC[IN_RADICALS_SMALLER; LT_REFL]);; + +let RADICALS_EMPTY_RATIONAL = prove + (`!e. wellformed e /\ radicals e = {} ==> rational(value e)`, + MATCH_MP_TAC expression_INDUCT THEN + REWRITE_TAC[wellformed; value; radicals; EMPTY_UNION; NOT_INSERT_EMPTY] THEN + REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[RATIONAL_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Crucial point about splitting off some "topmost" radical. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_MAX = prove + (`!s. FINITE s ==> ~(s = {}) ==> ?b:num. b IN s /\ !a. a IN s ==> a <= b`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_INSERT_EMPTY; IN_INSERT] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:num->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; UNWIND_THM2; LE_REFL] THEN + REWRITE_TAC[RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2] THEN + MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; + +let RADICAL_TOP = prove + (`!e. ~(radicals e = {}) + ==> ?r. r IN radicals e /\ + !s. s IN radicals(e) ==> ~(r IN radicals s)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `IMAGE depth (radicals e)` FINITE_MAX) THEN + ASM_SIMP_TAC[IMAGE_EQ_EMPTY; FINITE_IMAGE; FINITE_RADICALS] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN + MESON_TAC[IN_RADICALS_SMALLER; NOT_LT]);; + +(* ------------------------------------------------------------------------- *) +(* By rearranging the expression we can use it in a canonical way. *) +(* ------------------------------------------------------------------------- *) + +let RADICAL_CANONICAL_TRIVIAL = prove + (`!e r. + (r IN radicals e + ==> (?a b. + wellformed a /\ + wellformed b /\ + value e = value a + value b * sqrt (value r) /\ + radicals a SUBSET radicals e DELETE r /\ + radicals b SUBSET radicals e DELETE r /\ + radicals r SUBSET radicals e DELETE r)) + ==> wellformed e + ==> ?a b. wellformed a /\ + wellformed b /\ + value e = value a + value b * sqrt (value r) /\ + radicals a SUBSET (radicals e UNION radicals r) DELETE r /\ + radicals b SUBSET (radicals e UNION radicals r) DELETE r /\ + radicals r SUBSET (radicals e UNION radicals r) DELETE r`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `r IN radicals e` THEN ASM_SIMP_TAC[] THENL + [DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SET_TAC[]; + DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`e:expression`; `Constant(&0)`] THEN + ASM_REWRITE_TAC[wellformed; value; radicals] THEN + REWRITE_TAC[RATIONAL_NUM; REAL_MUL_LZERO; REAL_ADD_RID] THEN + UNDISCH_TAC `~(r IN radicals e)` THEN + MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN SET_TAC[]]);; + +let RADICAL_CANONICAL = prove + (`!e. wellformed e /\ ~(radicals e = {}) + ==> ?r. r IN radicals(e) /\ + ?a b. wellformed(Addition a (Multiplication b (Sqrt r))) /\ + value e = value(Addition a (Multiplication b (Sqrt r))) /\ + (radicals a) SUBSET (radicals(e) DELETE r) /\ + (radicals b) SUBSET (radicals(e) DELETE r) /\ + (radicals r) SUBSET (radicals(e) DELETE r)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP RADICAL_TOP) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:expression` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 <= value r /\ wellformed r` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[WELLFORMED_RADICALS; RADICALS_WELLFORMED]; ALL_TAC] THEN + MAP_EVERY UNDISCH_TAC [`wellformed e`; `r IN radicals e`] THEN + ASM_REWRITE_TAC[IMP_IMP; wellformed; value; GSYM CONJ_ASSOC] THEN + SPEC_TAC(`e:expression`,`e:expression`) THEN + MATCH_MP_TAC expression_INDUCT THEN + REWRITE_TAC[wellformed; radicals; value; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_INSERT; IN_UNION] THEN REPEAT CONJ_TAC THEN + X_GEN_TAC `e1:expression` THEN TRY(X_GEN_TAC `e2:expression`) THENL + [DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:expression`; `b:expression`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`Negation a`; `Negation b`] THEN + ASM_REWRITE_TAC[value; wellformed; radicals] THEN REAL_ARITH_TAC; + + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:expression`; `b:expression`] THEN + ASM_CASES_TAC `value b * sqrt(value r) = value a` THENL + [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC + [`Inverse(Multiplication (Constant(&2)) a)`; `Constant(&0)`] THEN + ASM_REWRITE_TAC[value; radicals; wellformed] THEN + REWRITE_TAC[RATIONAL_NUM; EMPTY_SUBSET; CONJ_ASSOC] THEN CONJ_TAC THENL + [UNDISCH_TAC `~(value a + value a = &0)` THEN CONV_TAC REAL_FIELD; + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]]; + ALL_TAC] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`Multiplication a (Inverse + (Addition (Multiplication a a) + (Multiplication (Multiplication b b) (Negation r))))`; + `Multiplication (Negation b) (Inverse + (Addition (Multiplication a a) + (Multiplication (Multiplication b b) (Negation r))))`] THEN + ASM_REWRITE_TAC[value; wellformed; radicals; UNION_SUBSET] THEN + UNDISCH_TAC `~(value b * sqrt (value r) = value a)` THEN + UNDISCH_TAC `~(value e1 = &0)` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SQRT_POW_2) THEN CONV_TAC REAL_FIELD; + + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o + MATCH_MP RADICAL_CANONICAL_TRIVIAL)) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`a1:expression`; `b1:expression`; `a2:expression`; `b2:expression`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`Addition a1 a2`; `Addition b1 b2`] THEN + ASM_REWRITE_TAC[value; wellformed; radicals] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN + MP_TAC(SPECL [`e1:expression`; `r:expression`] RADICALS_SUBSET) THEN + MP_TAC(SPECL [`e2:expression`; `r:expression`] RADICALS_SUBSET) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; + + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o + MATCH_MP RADICAL_CANONICAL_TRIVIAL)) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`a1:expression`; `b1:expression`; `a2:expression`; `b2:expression`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`Addition (Multiplication a1 a2) + (Multiplication (Multiplication b1 b2) r)`; + `Addition (Multiplication a1 b2) (Multiplication a2 b1)`] THEN + ASM_REWRITE_TAC[value; wellformed; radicals] THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP SQRT_POW_2) THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN + MP_TAC(SPECL [`e1:expression`; `r:expression`] RADICALS_SUBSET) THEN + MP_TAC(SPECL [`e2:expression`; `r:expression`] RADICALS_SUBSET) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; + + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + REPEAT(DISCH_THEN(K ALL_TAC)) THEN + MAP_EVERY EXISTS_TAC [`Constant(&0)`; `Constant(&1)`] THEN + REWRITE_TAC[wellformed; value; REAL_ADD_LID; REAL_MUL_LID] THEN + REWRITE_TAC[radicals; RATIONAL_NUM] THEN + MP_TAC(SPEC `r:expression` NOT_IN_OWN_RADICALS) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Now we quite easily get an inductive argument. *) +(* ------------------------------------------------------------------------- *) + +let CUBIC_ROOT_STEP = prove + (`!a b c. rational a /\ rational b /\ rational c + ==> !e. wellformed e /\ + ~(radicals e = {}) /\ + (value e) pow 3 + a * (value e) pow 2 + + b * (value e) + c = &0 + ==> ?e'. wellformed e' /\ + (radicals e') PSUBSET (radicals e) /\ + (value e') pow 3 + a * (value e') pow 2 + + b * (value e') + c = &0`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `e:expression` RADICAL_CANONICAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN + (X_CHOOSE_THEN `r:expression` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`eu:expression`; `ev:expression`] THEN + STRIP_TAC THEN + MP_TAC(SPEC `\x. ?ex. wellformed ex /\ + radicals ex SUBSET (radicals(e) DELETE r) /\ + value ex = x` + STEP_LEMMA_SQRT) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN EXISTS_TAC `Constant(&n)` THEN + REWRITE_TAC[wellformed; radicals; RATIONAL_NUM; value; EMPTY_SUBSET]; + X_GEN_TAC `x:real` THEN + DISCH_THEN(X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Negation ex` THEN + ASM_REWRITE_TAC[wellformed; radicals; value]; + X_GEN_TAC `x:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Inverse ex` THEN + ASM_REWRITE_TAC[wellformed; radicals; value]; + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `ey:expression` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `Addition ex ey` THEN + ASM_REWRITE_TAC[wellformed; radicals; value; UNION_SUBSET]; + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `ex:expression` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `ey:expression` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `Multiplication ex ey` THEN + ASM_REWRITE_TAC[wellformed; radicals; value; UNION_SUBSET]]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL + [`a:real`; `b:real`; `c:real`; + `value e`; `value eu`; `value ev`; `value r`]) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `Constant a` THEN + ASM_REWRITE_TAC[wellformed; radicals; EMPTY_SUBSET; value]; + ALL_TAC] THEN + CONJ_TAC THENL + [EXISTS_TAC `Constant b` THEN + ASM_REWRITE_TAC[wellformed; radicals; EMPTY_SUBSET; value]; + ALL_TAC] THEN + CONJ_TAC THENL + [EXISTS_TAC `Constant c` THEN + ASM_REWRITE_TAC[wellformed; radicals; EMPTY_SUBSET; value]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[wellformed]) THEN + ASM_REWRITE_TAC[value] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e':expression` THEN + ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main result. *) +(* ------------------------------------------------------------------------- *) + +let CUBIC_ROOT_RADICAL_INDUCT = prove + (`!a b c. rational a /\ rational b /\ rational c + ==> !n e. wellformed e /\ CARD (radicals e) = n /\ + (value e) pow 3 + a * (value e) pow 2 + + b * (value e) + c = &0 + ==> ?x. rational x /\ + x pow 3 + a * x pow 2 + b * x + c = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `e:expression` THEN + STRIP_TAC THEN ASM_CASES_TAC `radicals e = {}` THENL + [ASM_MESON_TAC[RADICALS_EMPTY_RATIONAL]; ALL_TAC] THEN + MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] CUBIC_ROOT_STEP) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:expression`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e':expression` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(radicals e')`) THEN ANTS_TAC THENL + [REWRITE_TAC[SYM(ASSUME `CARD(radicals e) = n`)] THEN + MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[FINITE_RADICALS]; + DISCH_THEN MATCH_MP_TAC THEN EXISTS_TAC `e':expression` THEN + ASM_REWRITE_TAC[]]);; + +let CUBIC_ROOT_RATIONAL = prove + (`!a b c. rational a /\ rational b /\ rational c /\ + (?x. radical x /\ x pow 3 + a * x pow 2 + b * x + c = &0) + ==> (?x. rational x /\ x pow 3 + a * x pow 2 + b * x + c = &0)`, + REWRITE_TAC[RADICAL_EXPRESSION] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] CUBIC_ROOT_RADICAL_INDUCT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`CARD(radicals e)`; `e:expression`] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Now go further to an *integer*, since the polynomial is monic. *) +(* ------------------------------------------------------------------------- *) + +prioritize_num();; + +let RATIONAL_LOWEST_LEMMA = prove + (`!p q. ~(q = 0) ==> ?p' q'. ~(q' = 0) /\ coprime(p',q') /\ p * q' = p' * q`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC num_WF THEN + X_GEN_TAC `q:num` THEN DISCH_TAC THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `coprime(p,q)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [coprime]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC) THEN + ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[DIVIDES_ZERO] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `p':num` SUBST_ALL_TAC) + (CONJUNCTS_THEN2 (X_CHOOSE_THEN `q':num` SUBST_ALL_TAC) ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `q':num`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [ARITH_RULE `a < b <=> 1 * a < b`] THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + ASM_SIMP_TAC[ARITH_RULE `~(d = 0) /\ ~(d = 1) ==> 1 < d`] THEN + DISCH_THEN(MP_TAC o SPEC `p':num`) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN + CONV_TAC NUM_RING);; + +prioritize_real();; + +let RATIONAL_LOWEST = prove + (`!x. rational x <=> ?p q. ~(q = 0) /\ coprime(p,q) /\ abs(x) = &p / &q`, + GEN_TAC THEN REWRITE_TAC[RATIONAL_ALT] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[]] THEN + STRIP_TAC THEN MP_TAC(SPECL [`p:num`; `q:num`] RATIONAL_LOWEST_LEMMA) THEN + ASM_REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + UNDISCH_TAC `~(q = 0)` THEN SIMP_TAC[GSYM REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN CONV_TAC REAL_FIELD);; + +let RATIONAL_ROOT_INTEGER = prove + (`!a b c x. integer a /\ integer b /\ integer c /\ rational x /\ + x pow 3 + a * x pow 2 + b * x + c = &0 + ==> integer x`, + REWRITE_TAC[RATIONAL_LOWEST; GSYM REAL_OF_NUM_EQ] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP(REAL_ARITH + `abs x = a ==> x = a \/ x = --a`)) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN + ASM_SIMP_TAC[REAL_FIELD + `~(q = &0) + ==> ((p / q) pow 3 + a * (p / q) pow 2 + b * (p / q) + c = &0 <=> + (p pow 3 = q * --(a * p pow 2 + b * p * q + c * q pow 2))) /\ + ((--(p / q)) pow 3 + a * (--(p / q)) pow 2 + + b * (--(p / q)) + c = &0 <=> + p pow 3 = q * (a * p pow 2 - b * p * q + c * q pow 2))`] THEN + (W(fun(asl,w) -> + SUBGOAL_THEN(mk_comb(`integer`,rand(rand(lhand w)))) MP_TAC THENL + [REPEAT(MAP_FIRST MATCH_MP_TAC (tl(CONJUNCTS INTEGER_CLOSED)) THEN + REPEAT CONJ_TAC) THEN + ASM_REWRITE_TAC[INTEGER_CLOSED]; + ALL_TAC])) THEN + REWRITE_TAC[integer] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN + DISCH_THEN(MP_TAC o AP_TERM `abs`) THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_EQ] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_SYM]) THEN + DISCH_THEN(MP_TAC o SPEC `3` o MATCH_MP COPRIME_EXP) THEN + REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `q:num`) THEN + ASM_CASES_TAC `q = 1` THEN + ASM_SIMP_TAC[REAL_DIV_1; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL] THEN + MESON_TAC[divides; DIVIDES_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we have our big final theorem. *) +(* ------------------------------------------------------------------------- *) + +let CUBIC_ROOT_INTEGER = prove + (`!a b c. integer a /\ integer b /\ integer c /\ + (?x. radical x /\ x pow 3 + a * x pow 2 + b * x + c = &0) + ==> (?x. integer x /\ x pow 3 + a * x pow 2 + b * x + c = &0)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] CUBIC_ROOT_RATIONAL) THEN + ASM_SIMP_TAC[RATIONAL_INTEGER] THEN + ASM_MESON_TAC[RATIONAL_ROOT_INTEGER]);; + +(* ------------------------------------------------------------------------- *) +(* Geometrical definitions. *) +(* ------------------------------------------------------------------------- *) + +let length = new_definition + `length(a:real^2,b:real^2) = norm(b - a)`;; + +let parallel = new_definition + `parallel (a:real^2,b:real^2) (c:real^2,d:real^2) <=> + (a$1 - b$1) * (c$2 - d$2) = (a$2 - b$2) * (c$1 - d$1)`;; + +let collinear3 = new_definition + `collinear3 (a:real^2) b c <=> parallel (a,b) (a,c)`;; + +let is_intersection = new_definition + `is_intersection p (a,b) (c,d) <=> collinear3 a p b /\ collinear3 c p d`;; + +let on_circle = new_definition + `on_circle x (centre,pt) <=> length(centre,x) = length(centre,pt)`;; + +(* ------------------------------------------------------------------------- *) +(* A trivial lemma. *) +(* ------------------------------------------------------------------------- *) + +let SQRT_CASES_LEMMA = prove + (`!x y. y pow 2 = x ==> &0 <= x /\ (sqrt(x) = y \/ sqrt(x) = --y)`, + REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + MP_TAC(SPEC `y:real` (GEN_ALL POW_2_SQRT)) THEN + MP_TAC(SPEC `--y` (GEN_ALL POW_2_SQRT)) THEN + REWRITE_TAC[GSYM REAL_POW_2; REAL_POW_NEG; ARITH] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Show that solutions to certain classes of equations are radical. *) +(* ------------------------------------------------------------------------- *) + +let RADICAL_LINEAR_EQUATION = prove + (`!a b x. radical a /\ radical b /\ ~(a = &0 /\ b = &0) /\ a * x + b = &0 + ==> radical x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(a = &0) /\ x = --b / a` + (fun th -> ASM_SIMP_TAC[th; RADICAL_RULES]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let RADICAL_SIMULTANEOUS_LINEAR_EQUATION = prove + (`!a b c d e f x. + radical a /\ radical b /\ radical c /\ + radical d /\ radical e /\ radical f /\ + ~(a * e = b * d /\ a * f = c * d /\ e * c = b * f) /\ + a * x + b * y = c /\ d * x + e * y = f + ==> radical(x) /\ radical(y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN + `~(a * e - b * d = &0) /\ + x = (e * c - b * f) / (a * e - b * d) /\ + y = (a * f - d * c) / (a * e - b * d)` + STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + ASM_SIMP_TAC[RADICAL_RULES]]);; + +let RADICAL_QUADRATIC_EQUATION = prove + (`!a b c x. radical a /\ radical b /\ radical c /\ + a * x pow 2 + b * x + c = &0 /\ + ~(a = &0 /\ b = &0 /\ c = &0) + ==> radical x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + MESON_TAC[RADICAL_LINEAR_EQUATION]; + ALL_TAC] THEN + STRIP_TAC THEN MATCH_MP_TAC RADICAL_LINEAR_EQUATION THEN + EXISTS_TAC `&2 * a` THEN + ASM_SIMP_TAC[RADICAL_RULES; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN + SUBGOAL_THEN `&0 <= b pow 2 - &4 * a * c /\ + ((&2 * a) * x + (b - sqrt(b pow 2 - &4 * a * c)) = &0 \/ + (&2 * a) * x + (b + sqrt(b pow 2 - &4 * a * c)) = &0)` + MP_TAC THENL + [REWRITE_TAC[real_sub; REAL_ARITH `a + (b + c) = &0 <=> c = --(a + b)`] THEN + REWRITE_TAC[REAL_EQ_NEG2] THEN MATCH_MP_TAC SQRT_CASES_LEMMA THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC REAL_RING; + STRIP_TAC THENL + [EXISTS_TAC `b - sqrt(b pow 2 - &4 * a * c)`; + EXISTS_TAC `b + sqrt(b pow 2 - &4 * a * c)`] THEN + ASM_REWRITE_TAC[] THEN RADICAL_TAC THEN ASM_REWRITE_TAC[]]);; + +let RADICAL_SIMULTANEOUS_LINEAR_QUADRATIC = prove + (`!a b c d e f x. + radical a /\ radical b /\ radical c /\ + radical d /\ radical e /\ radical f /\ + ~(d = &0 /\ e = &0 /\ f = &0) /\ + (x - a) pow 2 + (y - b) pow 2 = c /\ d * x + e * y = f + ==> radical x /\ radical y`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `d pow 2 + e pow 2` RADICAL_QUADRATIC_EQUATION) THEN + DISCH_THEN MATCH_MP_TAC THENL + [EXISTS_TAC `&2 * b * d * e - &2 * a * e pow 2 - &2 * d * f` THEN + EXISTS_TAC `b pow 2 * e pow 2 + a pow 2 * e pow 2 + + f pow 2 - c * e pow 2 - &2 * b * e * f`; + EXISTS_TAC `&2 * a * d * e - &2 * b * d pow 2 - &2 * f * e` THEN + EXISTS_TAC `a pow 2 * d pow 2 + b pow 2 * d pow 2 + + f pow 2 - c * d pow 2 - &2 * a * d * f`] THEN + (REPLICATE_TAC 3 + (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN + CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING; ALL_TAC] THEN + REWRITE_TAC[REAL_SOS_EQ_0] THEN REPEAT(POP_ASSUM MP_TAC) THEN + CONV_TAC REAL_RING));; + +let RADICAL_SIMULTANEOUS_QUADRATIC_QUADRATIC = prove + (`!a b c d e f x. + radical a /\ radical b /\ radical c /\ + radical d /\ radical e /\ radical f /\ + ~(a = d /\ b = e /\ c = f) /\ + (x - a) pow 2 + (y - b) pow 2 = c /\ + (x - d) pow 2 + (y - e) pow 2 = f + ==> radical x /\ radical y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC RADICAL_SIMULTANEOUS_LINEAR_QUADRATIC THEN + MAP_EVERY EXISTS_TAC + [`a:real`; `b:real`; `c:real`; `&2 * (d - a)`; `&2 * (e - b)`; + `(d pow 2 - a pow 2) + (e pow 2 - b pow 2) + (c - f)`] THEN + ASM_REWRITE_TAC[] THEN + REPLICATE_TAC 3 + (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Analytic criterion for constructibility. *) +(* ------------------------------------------------------------------------- *) + +let constructible_RULES,constructible_INDUCT,constructible_CASES = + new_inductive_definition + `(!x:real^2. rational(x$1) /\ rational(x$2) ==> constructible x) /\ +// Intersection of two non-parallel lines AB and CD + (!a b c d x. constructible a /\ constructible b /\ + constructible c /\ constructible d /\ + ~parallel (a,b) (c,d) /\ is_intersection x (a,b) (c,d) + ==> constructible x) /\ +// Intersection of a nontrivial line AB and circle with centre C, radius DE + (!a b c d e x. constructible a /\ constructible b /\ + constructible c /\ constructible d /\ + constructible e /\ + ~(a = b) /\ collinear3 a x b /\ length (c,x) = length(d,e) + ==> constructible x) /\ +// Intersection of distinct circles with centres A and D, radii BD and EF + (!a b c d e f x. constructible a /\ constructible b /\ + constructible c /\ constructible d /\ + constructible e /\ constructible f /\ + ~(a = d /\ length (b,c) = length (e,f)) /\ + length (a,x) = length (b,c) /\ length (d,x) = length (e,f) + ==> constructible x)`;; + +(* ------------------------------------------------------------------------- *) +(* Some "coordinate geometry" lemmas. *) +(* ------------------------------------------------------------------------- *) + +let RADICAL_LINE_LINE_INTERSECTION = prove + (`!a b c d x. + radical(a$1) /\ radical(a$2) /\ + radical(b$1) /\ radical(b$2) /\ + radical(c$1) /\ radical(c$2) /\ + radical(d$1) /\ radical(d$2) /\ + ~(parallel (a,b) (c,d)) /\ is_intersection x (a,b) (c,d) + ==> radical(x$1) /\ radical(x$2)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[parallel; collinear3; is_intersection] THEN STRIP_TAC THEN + MATCH_MP_TAC RADICAL_SIMULTANEOUS_LINEAR_EQUATION THEN + MAP_EVERY EXISTS_TAC + [`(b:real^2)$2 - (a:real^2)$2`; `(a:real^2)$1 - (b:real^2)$1`; + `(a:real^2)$2 * (a$1 - (b:real^2)$1) - (a:real^2)$1 * (a$2 - b$2)`; + `(d:real^2)$2 - (c:real^2)$2`; `(c:real^2)$1 - (d:real^2)$1`; + `(c:real^2)$2 * (c$1 - (d:real^2)$1) - (c:real^2)$1 * (c$2 - d$2)`] THEN + REPLICATE_TAC 6 + (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; + +let RADICAL_LINE_CIRCLE_INTERSECTION = prove + (`!a b c d e x. + radical(a$1) /\ radical(a$2) /\ + radical(b$1) /\ radical(b$2) /\ + radical(c$1) /\ radical(c$2) /\ + radical(d$1) /\ radical(d$2) /\ + radical(e$1) /\ radical(e$2) /\ + ~(a = b) /\ collinear3 a x b /\ length(c,x) = length(d,e) + ==> radical(x$1) /\ radical(x$2)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[length; NORM_EQ; collinear3; parallel] THEN + SIMP_TAC[CART_EQ; FORALL_2; dot; SUM_2; DIMINDEX_2; VECTOR_SUB_COMPONENT; + GSYM REAL_POW_2] THEN + STRIP_TAC THEN MATCH_MP_TAC RADICAL_SIMULTANEOUS_LINEAR_QUADRATIC THEN + MAP_EVERY EXISTS_TAC + [`(c:real^2)$1`; `(c:real^2)$2`; + `((e:real^2)$1 - (d:real^2)$1) pow 2 + (e$2 - d$2) pow 2`; + `(b:real^2)$2 - (a:real^2)$2`; + `(a:real^2)$1 - (b:real^2)$1`; + `a$2 * ((a:real^2)$1 - (b:real^2)$1) - a$1 * (a$2 - b$2)`] THEN + REPLICATE_TAC 6 + (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; + +let RADICAL_CIRCLE_CIRCLE_INTERSECTION = prove + (`!a b c d e f x. + radical(a$1) /\ radical(a$2) /\ + radical(b$1) /\ radical(b$2) /\ + radical(c$1) /\ radical(c$2) /\ + radical(d$1) /\ radical(d$2) /\ + radical(e$1) /\ radical(e$2) /\ + radical(f$1) /\ radical(f$2) /\ + length(a,x) = length(b,c) /\ + length(d,x) = length(e,f) /\ + ~(a = d /\ length(b,c) = length(e,f)) + ==> radical(x$1) /\ radical(x$2)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[length; NORM_EQ; collinear3; parallel] THEN + SIMP_TAC[CART_EQ; FORALL_2; dot; SUM_2; DIMINDEX_2; VECTOR_SUB_COMPONENT; + GSYM REAL_POW_2] THEN + STRIP_TAC THEN MATCH_MP_TAC RADICAL_SIMULTANEOUS_QUADRATIC_QUADRATIC THEN + MAP_EVERY EXISTS_TAC + [`(a:real^2)$1`; `(a:real^2)$2`; + `((c:real^2)$1 - (b:real^2)$1) pow 2 + (c$2 - b$2) pow 2`; + `(d:real^2)$1`; `(d:real^2)$2`; + `((f:real^2)$1 - (e:real^2)$1) pow 2 + (f$2 - e$2) pow 2`] THEN + REPLICATE_TAC 6 + (CONJ_TAC THENL [RADICAL_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* So constructible points have radical coordinates. *) +(* ------------------------------------------------------------------------- *) + +let CONSTRUCTIBLE_RADICAL = prove + (`!x. constructible x ==> radical(x$1) /\ radical(x$2)`, + MATCH_MP_TAC constructible_INDUCT THEN REPEAT CONJ_TAC THEN + REPEAT GEN_TAC THEN STRIP_TAC THENL + [ASM_SIMP_TAC[RADICAL_RULES]; + MATCH_MP_TAC RADICAL_LINE_LINE_INTERSECTION THEN ASM_MESON_TAC[]; + MATCH_MP_TAC RADICAL_LINE_CIRCLE_INTERSECTION THEN ASM_MESON_TAC[]; + MATCH_MP_TAC RADICAL_CIRCLE_CIRCLE_INTERSECTION THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Impossibility of doubling the cube. *) +(* ------------------------------------------------------------------------- *) + +let DOUBLE_THE_CUBE_ALGEBRA = prove + (`~(?x. radical x /\ x pow 3 = &2)`, + STRIP_TAC THEN MP_TAC(SPECL [`&0`; `&0`; `-- &2`] CUBIC_ROOT_INTEGER) THEN + SIMP_TAC[INTEGER_CLOSED; NOT_IMP] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + REWRITE_TAC[GSYM real_sub; REAL_SUB_0] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `abs`) THEN + REWRITE_TAC[REAL_ABS_POW] THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[integer]) THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_POW; REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(ARITH_RULE + `n EXP 3 <= 1 EXP 3 \/ 2 EXP 3 <= n EXP 3 ==> ~(n EXP 3 = 2)`) THEN + REWRITE_TAC[num_CONV `3`; EXP_MONO_LE_SUC] THEN ARITH_TAC);; + +let DOUBLE_THE_CUBE = prove + (`!x. x pow 3 = &2 ==> ~(constructible(vector[x; &0]))`, + GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP CONSTRUCTIBLE_RADICAL) THEN + REWRITE_TAC[VECTOR_2; RADICAL_RULES] THEN + ASM_MESON_TAC[DOUBLE_THE_CUBE_ALGEBRA]);; + +(* ------------------------------------------------------------------------- *) +(* Impossibility of trisecting *) +(* ------------------------------------------------------------------------- *) + +let COS_TRIPLE = prove + (`!x. cos(&3 * x) = &4 * cos(x) pow 3 - &3 * cos(x)`, + GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `&3 * x = x + x + x`; SIN_ADD; COS_ADD] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +let COS_PI3 = prove + (`cos(pi / &3) = &1 / &2`, + MP_TAC(SPEC `pi / &3` COS_TRIPLE) THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; COS_PI] THEN + REWRITE_TAC[REAL_RING + `-- &1 = &4 * c pow 3 - &3 * c <=> c = &1 / &2 \/ c = -- &1`] THEN + DISCH_THEN(DISJ_CASES_THEN2 ACCEPT_TAC MP_TAC) THEN + MP_TAC(SPEC `pi / &3` COS_POS_PI) THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let TRISECT_60_DEGREES_ALGEBRA = prove + (`~(?x. radical x /\ x pow 3 - &3 * x - &1 = &0)`, + STRIP_TAC THEN MP_TAC(SPECL [`&0`; `-- &3`; `-- &1`] CUBIC_ROOT_INTEGER) THEN + SIMP_TAC[INTEGER_CLOSED; NOT_IMP] THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; REAL_MUL_LNEG; GSYM real_sub] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `x pow 3 - &3 * x - &1 = &0 <=> x * (x pow 2 - &3) = &1`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `abs`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[integer]) THEN + REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC (ARITH_RULE + `n = 0 \/ n = 1 \/ n = 2 + (n - 2)`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `(&2 + m) pow 2 - &3 = m pow 2 + &4 * m + &1`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_POW; REAL_ABS_NUM; + REAL_OF_NUM_EQ; MULT_EQ_1] THEN + ARITH_TAC);; + +let TRISECT_60_DEGREES = prove + (`!y. ~(constructible(vector[cos(pi / &9); y]))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONSTRUCTIBLE_RADICAL) THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[VECTOR_2] THEN + DISCH_TAC THEN MP_TAC(SPEC `pi / &9` COS_TRIPLE) THEN + SIMP_TAC[REAL_ARITH `&3 * x / &9 = x / &3`; COS_PI3] THEN + REWRITE_TAC[REAL_ARITH + `&1 / &2 = &4 * c pow 3 - &3 * c <=> + (&2 * c) pow 3 - &3 * (&2 * c) - &1 = &0`] THEN + ASM_MESON_TAC[TRISECT_60_DEGREES_ALGEBRA; RADICAL_RULES]);; diff --git a/100/cosine.ml b/100/cosine.ml new file mode 100644 index 0000000..0a361fb --- /dev/null +++ b/100/cosine.ml @@ -0,0 +1,210 @@ +(* ========================================================================= *) +(* The law of cosines, of sines, and sum of angles of a triangle. *) +(* ========================================================================= *) + +needs "Multivariate/transcendentals.ml";; + +prioritize_vector();; + +(* ------------------------------------------------------------------------- *) +(* Angle between vectors (always 0 <= angle <= pi). *) +(* ------------------------------------------------------------------------- *) + +let vangle = new_definition + `vangle x y = if x = vec 0 \/ y = vec 0 then pi / &2 + else acs((x dot y) / (norm x * norm y))`;; + +(* ------------------------------------------------------------------------- *) +(* Traditional geometric notion of angle (but always 0 <= theta <= pi). *) +(* ------------------------------------------------------------------------- *) + +let angle = new_definition + `angle(a,b,c) = vangle (a - b) (c - b)`;; + +(* ------------------------------------------------------------------------- *) +(* Lemmas (more than we need for this result). *) +(* ------------------------------------------------------------------------- *) + +let VANGLE = prove + (`!x y:real^N. x dot y = norm(x) * norm(y) * cos(vangle x y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[vangle] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_LZERO; NORM_0; REAL_MUL_LZERO] THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_RZERO; NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c:real = c * a * b`] THEN + ASM_SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN + MATCH_MP_TAC(GSYM COS_ACS) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT; REAL_LT_MUL] THEN + MP_TAC(SPECL [`x:real^N`; `y:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN + REAL_ARITH_TAC);; + +let VANGLE_RANGE = prove + (`!x y:real^N. &0 <= vangle x y /\ vangle x y <= pi`, + REPEAT GEN_TAC THEN REWRITE_TAC[vangle] THEN COND_CASES_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN MATCH_MP_TAC ACS_BOUNDS THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> -- &1 * a <= x /\ x <= &1 * a`) THEN + REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS]);; + +let ORTHOGONAL_VANGLE = prove + (`!x y:real^N. orthogonal x y <=> vangle x y = pi / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[orthogonal; vangle] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN + EQ_TAC THENL + [SIMP_TAC[real_div; REAL_MUL_LZERO] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM real_div; GSYM COS_PI2] THEN + MATCH_MP_TAC ACS_COS THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + MP_TAC(SPECL [`x:real^N`; `y:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ; + REAL_LT_MUL; NORM_POS_LT] THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN + ASM_SIMP_TAC[COS_ACS; COS_PI2] THEN + REWRITE_TAC[real_div; REAL_ENTIRE; REAL_INV_EQ_0] THEN + ASM_REWRITE_TAC[NORM_EQ_0]]);; + +let VANGLE_EQ_PI = prove + (`!x y:real^N. vangle x y = pi ==> norm(x) % y + norm(y) % x = vec 0`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real^N`; `y:real^N`] VANGLE) THEN + ASM_REWRITE_TAC[COS_PI] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `--y:real^N`] NORM_CAUCHY_SCHWARZ_EQ) THEN + REWRITE_TAC[NORM_NEG; DOT_RNEG; VECTOR_MUL_RNEG] THEN + ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN + VECTOR_ARITH_TAC);; + +let ANGLE_EQ_PI = prove + (`!A B C:real^N. angle(A,B,C) = pi ==> dist(A,C) = dist(A,B) + dist(B,C)`, + REPEAT GEN_TAC THEN REWRITE_TAC[angle] THEN + DISCH_THEN(MP_TAC o MATCH_MP VANGLE_EQ_PI) THEN + REWRITE_TAC[VECTOR_ARITH `a + x % (b - c) = vec 0 <=> a = x % (c - b)`] THEN + GEN_REWRITE_TAC (funpow 3 LAND_CONV) [NORM_SUB] THEN + REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN + REWRITE_TAC[VECTOR_ARITH `(B - A) + (C - B):real^N = C - A`] THEN + REWRITE_TAC[dist; NORM_SUB]);; + +let SIN_ANGLE_POS = prove + (`!A B C. &0 <= sin(angle(A,B,C))`, + SIMP_TAC[SIN_POS_PI_LE; angle; VANGLE_RANGE]);; + +let ANGLE = prove + (`!A B C. (A - C) dot (B - C) = dist(A,C) * dist(B,C) * cos(angle(A,C,B))`, + REWRITE_TAC[angle; dist; GSYM VANGLE]);; + +let ANGLE_REFL = prove + (`!A B. angle(A,A,B) = pi / &2 /\ + angle(B,A,A) = pi / &2`, + REWRITE_TAC[angle; vangle; VECTOR_SUB_REFL]);; + +let ANGLE_REFL_MID = prove + (`!A B. ~(A = B) ==> angle(A,B,A) = &0`, + SIMP_TAC[angle; vangle; VECTOR_SUB_EQ; GSYM NORM_POW_2; GSYM REAL_POW_2; + REAL_DIV_REFL; ACS_1; REAL_POW_EQ_0; ARITH; NORM_EQ_0]);; + +let ANGLE_SYM = prove + (`!A B C. angle(A,B,C) = angle(C,B,A)`, + REWRITE_TAC[angle; vangle; VECTOR_SUB_EQ; DISJ_SYM; REAL_MUL_SYM; DOT_SYM]);; + +let ANGLE_RANGE = prove + (`!A B C. &0 <= angle(A,B,C) /\ angle(A,B,C) <= pi`, + REWRITE_TAC[angle; VANGLE_RANGE]);; + +(* ------------------------------------------------------------------------- *) +(* The law of cosines. *) +(* ------------------------------------------------------------------------- *) + +let LAW_OF_COSINES = prove + (`!A B C:real^N. + dist(B,C) pow 2 = dist(A,B) pow 2 + dist(A,C) pow 2 - + &2 * dist(A,B) * dist(A,C) * cos(angle(B,A,C))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[angle; ONCE_REWRITE_RULE[NORM_SUB] dist; GSYM VANGLE; + NORM_POW_2] THEN + VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The law of sines. *) +(* ------------------------------------------------------------------------- *) + +let LAW_OF_SINES = prove + (`!A B C:real^N. + sin(angle(A,B,C)) * dist(B,C) = sin(angle(B,A,C)) * dist(A,C)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN + SIMP_TAC[SIN_ANGLE_POS; DIST_POS_LE; REAL_LE_MUL; ARITH] THEN + REWRITE_TAC[REAL_POW_MUL; MATCH_MP + (REAL_ARITH `x + y = &1 ==> x = &1 - y`) (SPEC_ALL SIN_CIRCLE)] THEN + ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[ANGLE_REFL; COS_PI2] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM VECTOR_SUB_EQ]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM NORM_EQ_0]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_RING + `~(a = &0) ==> a pow 2 * x = a pow 2 * y ==> x = y`)) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM dist] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN + REWRITE_TAC[REAL_RING + `a * (&1 - x) * b = c * (&1 - y) * d <=> + a * b - a * b * x = c * d - c * d * y`] THEN + REWRITE_TAC[GSYM REAL_POW_MUL; GSYM ANGLE] THEN + REWRITE_TAC[REAL_POW_MUL; dist; NORM_POW_2] THEN + REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Hence the sum of the angles of a triangle. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_ANGLE_SUM_LEMMA = prove + (`!A B C:real^N. ~(A = B) /\ ~(A = C) /\ ~(B = C) + ==> cos(angle(B,A,C) + angle(A,B,C) + angle(B,C,A)) = -- &1`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM NORM_EQ_0] THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`C:real^N`; `B:real^N`; `A:real^N`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_SINES) THEN + MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_SINES) THEN + MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `A:real^N`] LAW_OF_SINES) THEN + REWRITE_TAC[COS_ADD; SIN_ADD; dist; NORM_SUB] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t SIN_CIRCLE)) + [`angle(B:real^N,A,C)`; `angle(A:real^N,B,C)`; `angle(B:real^N,C,A)`] THEN + REWRITE_TAC[COS_ADD; SIN_ADD; ANGLE_SYM] THEN CONV_TAC REAL_RING);; + +let COS_MINUS1_LEMMA = prove + (`!x. cos(x) = -- &1 /\ &0 <= x /\ x < &3 * pi ==> x = pi`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?n. integer n /\ x = n * pi` + (X_CHOOSE_THEN `nn:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + REWRITE_TAC[GSYM SIN_EQ_0] THENL + [MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `?n. nn = &n` (X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_MUL_POS_LE]) THEN + SIMP_TAC[PI_POS; REAL_ARITH `&0 < p ==> ~(p < &0) /\ ~(p = &0)`] THEN + ASM_MESON_TAC[INTEGER_POS; REAL_LT_LE]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_RING `n = &1 ==> n * p = p`) THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(ARITH_RULE `n < 3 /\ ~(n = 0) /\ ~(n = 2) ==> n = 1`) THEN + RULE_ASSUM_TAC(SIMP_RULE[REAL_LT_RMUL_EQ; PI_POS; REAL_OF_NUM_LT]) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[COS_0; REAL_MUL_LZERO; COS_NPI] THEN + REAL_ARITH_TAC);; + +let TRIANGLE_ANGLE_SUM = prove + (`!A B C:real^N. ~(A = B) /\ ~(A = C) /\ ~(B = C) + ==> angle(B,A,C) + angle(A,B,C) + angle(B,C,A) = pi`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_MINUS1_LEMMA THEN + ASM_SIMP_TAC[TRIANGLE_ANGLE_SUM_LEMMA; REAL_LE_ADD; ANGLE_RANGE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= p /\ &0 <= y /\ y <= p /\ &0 <= z /\ z <= p /\ + ~(x = p /\ y = p /\ z = p) + ==> x + y + z < &3 * p`) THEN + ASM_SIMP_TAC[ANGLE_RANGE] THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ANGLE_EQ_PI)) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM VECTOR_SUB_EQ])) THEN + REWRITE_TAC[GSYM NORM_EQ_0; dist; NORM_SUB] THEN REAL_ARITH_TAC);; diff --git a/100/cubic.ml b/100/cubic.ml new file mode 100644 index 0000000..49dcd97 --- /dev/null +++ b/100/cubic.ml @@ -0,0 +1,98 @@ +(* ========================================================================= *) +(* Cubic formula. *) +(* ========================================================================= *) + +needs "Complex/complex_transc.ml";; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* Define cube roots (it doesn't matter which one we choose here) *) +(* ------------------------------------------------------------------------- *) + +let ccbrt = new_definition + `ccbrt(z) = if z = Cx(&0) then Cx(&0) else cexp(clog(z) / Cx(&3))`;; + +let CCBRT = prove + (`!z. ccbrt(z) pow 3 = z`, + GEN_TAC THEN REWRITE_TAC[ccbrt] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_FIELD `z pow 3 = z * z * z:complex`; GSYM CEXP_ADD] THEN + REWRITE_TAC[COMPLEX_FIELD `z / Cx(&3) + z / Cx(&3) + z / Cx(&3) = z`] THEN + ASM_SIMP_TAC[CEXP_CLOG]);; + +(* ------------------------------------------------------------------------- *) +(* The reduction to a simpler form. *) +(* ------------------------------------------------------------------------- *) + +let CUBIC_REDUCTION = COMPLEX_FIELD + `~(a = Cx(&0)) /\ + x = y - b / (Cx(&3) * a) /\ + p = (Cx(&3) * a * c - b pow 2) / (Cx(&9) * a pow 2) /\ + q = (Cx(&9) * a * b * c - Cx(&2) * b pow 3 - Cx(&27) * a pow 2 * d) / + (Cx(&54) * a pow 3) + ==> (a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> + y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0))`;; + +(* ------------------------------------------------------------------------- *) +(* The solutions of the special form. *) +(* ------------------------------------------------------------------------- *) + +let CUBIC_BASIC = COMPLEX_FIELD + `!i t s. + s pow 2 = q pow 2 + p pow 3 /\ + (s1 pow 3 = if p = Cx(&0) then Cx(&2) * q else q + s) /\ + s2 = --s1 * (Cx(&1) + i * t) / Cx(&2) /\ + s3 = --s1 * (Cx(&1) - i * t) / Cx(&2) /\ + i pow 2 + Cx(&1) = Cx(&0) /\ + t pow 2 = Cx(&3) + ==> if p = Cx(&0) then + (y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0) <=> + y = s1 \/ y = s2 \/ y = s3) + else + ~(s1 = Cx(&0)) /\ + (y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0) <=> + (y = s1 - p / s1 \/ y = s2 - p / s2 \/ y = s3 - p / s3))`;; + +(* ------------------------------------------------------------------------- *) +(* Explicit formula for the roots (doesn't matter which square/cube roots). *) +(* ------------------------------------------------------------------------- *) + +let CUBIC = prove + (`~(a = Cx(&0)) + ==> let p = (Cx(&3) * a * c - b pow 2) / (Cx(&9) * a pow 2) + and q = (Cx(&9) * a * b * c - Cx(&2) * b pow 3 - Cx(&27) * a pow 2 * d) / + (Cx(&54) * a pow 3) in + let s = csqrt(q pow 2 + p pow 3) in + let s1 = if p = Cx(&0) then ccbrt(Cx(&2) * q) else ccbrt(q + s) in + let s2 = --s1 * (Cx(&1) + ii * csqrt(Cx(&3))) / Cx(&2) + and s3 = --s1 * (Cx(&1) - ii * csqrt(Cx(&3))) / Cx(&2) in + if p = Cx(&0) then + a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> + x = s1 - b / (Cx(&3) * a) \/ + x = s2 - b / (Cx(&3) * a) \/ + x = s3 - b / (Cx(&3) * a) + else + ~(s1 = Cx(&0)) /\ + (a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> + x = s1 - p / s1 - b / (Cx(&3) * a) \/ + x = s2 - p / s2 - b / (Cx(&3) * a) \/ + x = s3 - p / s3 - b / (Cx(&3) * a))`, + DISCH_TAC THEN REPEAT LET_TAC THEN + ABBREV_TAC `y = x + b / (Cx(&3) * a)` THEN + SUBGOAL_THEN + `a * x pow 3 + b * x pow 2 + c * x + d = Cx(&0) <=> + y pow 3 + Cx(&3) * p * y - Cx(&2) * q = Cx(&0)` + SUBST1_TAC THENL + [MATCH_MP_TAC CUBIC_REDUCTION THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "y" THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `x = a - b <=> x + b = (a:complex)`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CUBIC_BASIC THEN + MAP_EVERY EXISTS_TAC + [`ii`; `csqrt(Cx(&3))`; `csqrt (q pow 2 + p pow 3)`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CSQRT]; + ASM_MESON_TAC[CCBRT]; + MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_RING; + ASM_MESON_TAC[CSQRT]]);; diff --git a/100/derangements.ml b/100/derangements.ml new file mode 100644 index 0000000..24fa44a --- /dev/null +++ b/100/derangements.ml @@ -0,0 +1,597 @@ +(* ========================================================================= *) +(* #88: Formula for the number of derangements: round[n!/e] *) +(* ========================================================================= *) + +needs "Library/transc.ml";; +needs "Library/calc_real.ml";; +needs "Library/floor.ml";; + +let PAIR_BETA_THM = GEN_BETA_CONV `(\(x,y). P x y) (a,b)`;; + +(* ------------------------------------------------------------------------- *) +(* Domain and range of a relation. *) +(* ------------------------------------------------------------------------- *) + +let domain = new_definition + `domain r = {x | ?y. r(x,y)}`;; + +let range = new_definition + `range r = {y | ?x. r(x,y)}`;; + +(* ------------------------------------------------------------------------- *) +(* Relational composition. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("%",(26, "right"));; + +let compose = new_definition + `(r % s) (x,y) <=> ?z. r(x,z) /\ s(z,y)`;; + +(* ------------------------------------------------------------------------- *) +(* Identity relation on a domain. *) +(* ------------------------------------------------------------------------- *) + +let id = new_definition + `id(s) (x,y) <=> x IN s /\ x = y`;; + +(* ------------------------------------------------------------------------- *) +(* Converse relation. *) +(* ------------------------------------------------------------------------- *) + +let converse = new_definition + `converse(r) (x,y) = r(y,x)`;; + +(* ------------------------------------------------------------------------- *) +(* Transposition. *) +(* ------------------------------------------------------------------------- *) + +let swap = new_definition + `swap(a,b) (x,y) <=> x = a /\ y = b \/ x = b /\ y = a`;; + +(* ------------------------------------------------------------------------- *) +(* When a relation "pairs up" two sets bijectively. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("pairsup",(12,"right"));; + +let pairsup = new_definition + `r pairsup (s,t) <=> (r % converse(r) = id(s)) /\ (converse(r) % r = id(t))`;; + +(* ------------------------------------------------------------------------- *) +(* Special case of a permutation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("permutes",(12,"right"));; + +let permutes = new_definition + `r permutes s <=> r pairsup (s,s)`;; + +(* ------------------------------------------------------------------------- *) +(* Even more special case of derangement. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("deranges",(12,"right"));; + +let deranges = new_definition + `r deranges s <=> r permutes s /\ !x. ~(r(x,x))`;; + +(* ------------------------------------------------------------------------- *) +(* Trivial tactic for properties of relations. *) +(* ------------------------------------------------------------------------- *) + +let REL_TAC = + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM; PAIR_BETA_THM; + permutes; pairsup; domain; range; compose; id; converse; swap; + deranges; IN_INSERT; IN_DELETE; NOT_IN_EMPTY; IN_ELIM_THM] THEN + REWRITE_TAC[IN; EMPTY; INSERT; DELETE; UNION; IN_ELIM_THM; PAIR_EQ; + id; converse; swap] THEN + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o check (is_var o lhs o concl))) THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o check (is_var o rhs o concl))) THEN + ASM_MESON_TAC[];; + +let REL_RULE tm = prove(tm,REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some general properties of relations. *) +(* ------------------------------------------------------------------------- *) + +let CONVERSE_COMPOSE = prove + (`!r s. converse(r % s) = converse(s) % converse(r)`, + REL_TAC);; + +let CONVERSE_CONVERSE = prove + (`!r. converse(converse r) = r`, + REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* More "explicit" definition of pairing and permutation. *) +(* ------------------------------------------------------------------------- *) + +let PAIRSUP_EXPLICIT = prove + (`!p s t. + p pairsup (s,t) <=> + (!x y. p(x,y) ==> x IN s /\ y IN t) /\ + (!x. x IN s ==> ?!y. y IN t /\ p(x,y)) /\ + (!y. y IN t ==> ?!x. x IN s /\ p(x,y))`, + REL_TAC);; + +let PERMUTES_EXPLICIT = prove + (`!p s. p permutes s <=> + (!x y. p(x,y) ==> x IN s /\ y IN s) /\ + (!x. x IN s ==> ?!y. y IN s /\ p(x,y)) /\ + (!y. y IN s ==> ?!x. x IN s /\ p(x,y))`, + REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Other low-level properties. *) +(* ------------------------------------------------------------------------- *) + +let PAIRSUP_DOMRAN = prove + (`!p s t. p pairsup (s,t) ==> domain p = s /\ range p = t`, + REL_TAC);; + +let PERMUTES_DOMRAN = prove + (`!p s. p permutes s ==> domain p = s /\ range p = s`, + REL_TAC);; + +let PAIRSUP_FUNCTIONAL = prove + (`!p s t. p pairsup (s,t) ==> !x y y'. p(x,y) /\ p(x,y') ==> y = y'`, + REL_TAC);; + +let PERMUTES_FUNCTIONAL = prove + (`!p s. p permutes s ==> !x y y'. p(x,y) /\ p(x,y') ==> y = y'`, + REL_TAC);; + +let PAIRSUP_COFUNCTIONAL = prove + (`!p s t. p pairsup (s,t) ==> !x x' y. p(x,y) /\ p(x',y) ==> x = x'`, + REL_TAC);; + +let PERMUTES_COFUNCTIONAL = prove + (`!p s. p permutes s ==> !x x' y. p(x,y) /\ p(x',y) ==> x = x'`, + REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some more abstract properties. *) +(* ------------------------------------------------------------------------- *) + +let PAIRSUP_ID = prove + (`!s. id(s) pairsup (s,s)`, + REL_TAC);; + +let PERMUTES_ID = prove + (`!s. id(s) permutes s`, + REL_TAC);; + +let PAIRSUP_CONVERSE = prove + (`!p s t. p pairsup (s,t) ==> converse(p) pairsup (t,s)`, + REL_TAC);; + +let PERMUTES_CONVERSE = prove + (`!p s. p permutes s ==> converse(p) permutes s`, + REL_TAC);; + +let PAIRSUP_COMPOSE = prove + (`!p p' s t u. p pairsup (s,t) /\ p' pairsup (t,u) ==> (p % p') pairsup (s,u)`, + REL_TAC);; + +let PERMUTES_COMPOSE = prove + (`!p p' s. p permutes s /\ p' permutes s ==> (p % p') permutes s`, + REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Transpositions are permutations. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_SWAP = prove + (`swap(a,b) permutes {a,b}`, + REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Clausal theorems for cases on first set. *) +(* ------------------------------------------------------------------------- *) + +let PAIRSUP_EMPTY = prove + (`p pairsup ({},{}) <=> (p = {})`, + REL_TAC);; + +let PAIRSUP_INSERT = prove + (`!x:A s t:B->bool p. + p pairsup (x INSERT s,t) <=> + if x IN s then p pairsup (s,t) + else ?y q. y IN t /\ p = (x,y) INSERT q /\ q pairsup (s,t DELETE y)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SET_RULE `x IN s ==> x INSERT s = s`] THEN EQ_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC] THEN + DISCH_TAC THEN SUBGOAL_THEN `?y. y IN t /\ p(x:A,y:B)` MP_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REL_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:B` THEN STRIP_TAC THEN + EXISTS_TAC `p DELETE (x:A,y:B)` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Number of pairings and permutations. *) +(* ------------------------------------------------------------------------- *) + +let NUMBER_OF_PAIRINGS = prove + (`!n s:A->bool t:B->bool. + s HAS_SIZE n /\ t HAS_SIZE n + ==> {p | p pairsup (s,t)} HAS_SIZE (FACT n)`, + let lemma = prove + (`{p | ?y. y IN t /\ A y p} = UNIONS {{p | A y p} | y IN t} /\ + {p | ?q. p = (a,y) INSERT q /\ A y q} = + IMAGE (\q. (a,y) INSERT q) {q | A y q}`, + CONJ_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIONS; IN_IMAGE] THEN SET_TAC[]) in + INDUCT_TAC THEN REPEAT GEN_TAC THENL + [REWRITE_TAC[HAS_SIZE_CLAUSES] THEN + SIMP_TAC[PAIRSUP_EMPTY; SET_RULE `{x | x = a} = {a}`] THEN + SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH; FACT]; + ALL_TAC] THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [HAS_SIZE_CLAUSES] THEN + REWRITE_TAC[HAS_SIZE_SUC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REWRITE_TAC[PAIRSUP_INSERT; RIGHT_EXISTS_AND_THM; lemma; FACT] THEN + MATCH_MP_TAC HAS_SIZE_UNIONS THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[HAS_SIZE_SUC]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + ASM_SIMP_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + REPEAT STRIP_TAC THEN REWRITE_TAC[DISJOINT] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTER; IN_IMAGE; NOT_IN_EMPTY] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC]);; + +let NUMBER_OF_PERMUTATIONS = prove + (`!s n. s HAS_SIZE n ==> {p | p permutes s} HAS_SIZE (FACT n)`, + SIMP_TAC[permutes; NUMBER_OF_PAIRINGS]);; + +(* ------------------------------------------------------------------------- *) +(* Number of derangements (we need to justify this later). *) +(* ------------------------------------------------------------------------- *) + +let derangements = define + `(derangements 0 = 1) /\ + (derangements 1 = 0) /\ + (derangements(n + 2) = (n + 1) * (derangements n + derangements(n + 1)))`;; + +let DERANGEMENT_INDUCT = prove + (`!P. P 0 /\ P 1 /\ (!n. P n /\ P(n + 1) ==> P(n + 2)) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN + INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN + ASM_SIMP_TAC[ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Expanding a derangement. *) +(* ------------------------------------------------------------------------- *) + +let DERANGEMENT_ADD2 = prove + (`!p s x y. + p deranges s /\ ~(x IN s) /\ ~(y IN s) /\ ~(x = y) + ==> ((x,y) INSERT (y,x) INSERT p) deranges (x INSERT y INSERT s)`, + REL_TAC);; + +let DERANGEMENT_ADD1 = prove + (`!p s y x. p deranges s /\ ~(y IN s) /\ p(x,z) + ==> ((x,y) INSERT (y,z) INSERT (p DELETE (x,z))) + deranges (y INSERT s)`, + REL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Number of derangements. *) +(* ------------------------------------------------------------------------- *) + +let DERANGEMENT_EMPTY = prove + (`!p. p deranges {} <=> p = {}`, + REL_TAC);; + +let DERANGEMENT_SING = prove + (`!x p. ~(p deranges {x})`, + REL_TAC);; + +let NUMBER_OF_DERANGEMENTS = prove + (`!n s:A->bool. s HAS_SIZE n ==> {p | p deranges s} HAS_SIZE (derangements n)`, + MATCH_MP_TAC DERANGEMENT_INDUCT THEN REWRITE_TAC[derangements] THEN + REPEAT CONJ_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `{}:A#A->bool` THEN + ASM_REWRITE_TAC[DERANGEMENT_EMPTY; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_SING] THEN MESON_TAC[MEMBER_NOT_EMPTY]; + CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[DERANGEMENT_SING] THEN SET_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN X_GEN_TAC `t:A->bool` THEN + REWRITE_TAC[ARITH_RULE `n + 2 = SUC(n + 1)`; HAS_SIZE_CLAUSES] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN + `{p | p deranges (x:A INSERT s)} = + (IMAGE (\(y,p). (x,y) INSERT (y,x) INSERT p) + {(y,p) | y IN s /\ p IN {p | p deranges (s DELETE y)}}) UNION + (IMAGE (\(y,p). let z = @z. p(x,z) in + (x,y) INSERT (y,z) INSERT (p DELETE (x,z))) + {(y,p) | y IN s /\ + p IN {p | p deranges (x INSERT (s DELETE y))}})` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[TAUT `(a <=> b) <=> (b ==> a) /\ (a ==> b)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_UNION; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`; + FORALL_AND_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; PAIR_BETA_THM; IN_ELIM_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`y:A`; `p:A#A->bool`] THEN + STRIP_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `y IN s ==> s = y INSERT (s DELETE y)`)) THEN + MATCH_MP_TAC DERANGEMENT_ADD2 THEN ASM_REWRITE_TAC[IN_DELETE] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `z = @z. p(x:A,z:A)` THEN + SUBGOAL_THEN `(p:A#A->bool)(x:A,z:A)` STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + CONV_TAC SELECT_CONV THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `z:A IN s` STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + SUBGOAL_THEN `(x:A) INSERT s = y INSERT (x INSERT (s DELETE y))` + SUBST1_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC DERANGEMENT_ADD1 THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[IN_DELETE; IN_INSERT] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `p:A#A->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `?y. y IN s /\ p(x:A,y:A)` STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + REWRITE_TAC[IN_UNION] THEN ASM_CASES_TAC `(p:A#A->bool)(y,x)` THENL + [DISJ1_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `y:A,(p DELETE (y,x)) DELETE (x:A,y:A)` THEN + CONJ_TAC THENL + [REWRITE_TAC[PAIR_BETA_THM] THEN MAP_EVERY UNDISCH_TAC + [`(p:A#A->bool)(x,y)`; `(p:A#A->bool)(y,x)`] THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `?z. p(y:A,z:A)` STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z:A IN s` ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + DISJ2_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_BETA_THM] THEN + EXISTS_TAC `y:A` THEN + EXISTS_TAC `(x:A,z:A) INSERT ((p DELETE (x,y)) DELETE (y,z))` THEN + SUBGOAL_THEN + `(@w:A. ((x,z) INSERT (p DELETE (x,y) DELETE (y,z))) (x,w)) = z` + SUBST1_TAC THENL + [MATCH_MP_TAC SELECT_UNIQUE THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; PAIR_BETA_THM] THEN + REWRITE_TAC[IN; INSERT; DELETE; PAIR_BETA_THM; IN_ELIM_THM; PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN + ASM_CASES_TAC `u:A = x` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB] THEN MATCH_MP_TAC HAS_SIZE_UNION THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REWRITE_TAC[FUN_EQ_THM; INSERT; IN_ELIM_THM; FORALL_PAIR_THM; + PAIR_EQ] THEN + UNDISCH_TAC `~(x:A IN s)` THEN REL_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `(s:A->bool) HAS_SIZE (n + 1)` THEN + SIMP_TAC[HAS_SIZE; FINITE_DELETE; CARD_DELETE] THEN + ASM_REWRITE_TAC[ADD_SUB]; + + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN MAP_EVERY X_GEN_TAC + [`y:A`; `p:(A#A)->bool`; `y':A`; `p':(A#A->bool)`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + MAP_EVERY ABBREV_TAC [`z = @z. p(x:A,z:A)`; `z' = @z. p'(x:A,z:A)`] THEN + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + SUBGOAL_THEN `p(x:A,z:A) /\ p'(x:A,z':A)` STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + CONJ_TAC THEN CONV_TAC SELECT_CONV THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(K ALL_TAC o SYM)) THEN + SUBGOAL_THEN `z:A IN s /\ z':A IN s` STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THEN MP_TAC th) + THENL + [DISCH_THEN(MP_TAC o C AP_THM `(x:A,y:A)`) THEN + REWRITE_TAC[INSERT; DELETE; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_CASES_TAC `z':A = z` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM SUBST_ALL_TAC; + DISCH_THEN(MP_TAC o C AP_THM `(y:A,z:A)`) THEN + REWRITE_TAC[INSERT; DELETE; IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `a INSERT b INSERT s = a INSERT b INSERT t + ==> ~(a IN s) /\ ~(a IN t) /\ ~(b IN s) /\ ~(b IN t) ==> s = t`)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(s:A->bool) HAS_SIZE n + 1` THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE] THEN + ASM_SIMP_TAC[CARD_DELETE; CARD_CLAUSES; FINITE_DELETE] THEN + ASM_REWRITE_TAC[IN_DELETE] THEN ARITH_TAC; + + REWRITE_TAC[DISJOINT] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_INTER; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`y:A`; `p:A#A->bool`] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_BETA_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + STRIP_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:A`; `q:A#A->bool`] THEN + REWRITE_TAC[PAIR_BETA_THM; IN_ELIM_THM; PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ABBREV_TAC `w = @w. q(x:A,w:A)` THEN + SUBGOAL_THEN `(q:A#A->bool)(x:A,w:A)` STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + CONV_TAC SELECT_CONV THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `w:A IN s` STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN + ASM_CASES_TAC `w:A = z` THEN ASM_REWRITE_TAC[] THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; ALL_TAC] THEN + ASM_CASES_TAC `w:A = y` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `y:A = z` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC; ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REL_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Trivia. *) +(* ------------------------------------------------------------------------- *) + +let SUM_1 = prove + (`sum(0..1) f = f 0 + f 1`, + REWRITE_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG; LE_0]);; + +let SUM_2 = prove + (`sum(0..2) f = f 0 + f 1 + f 2`, + SIMP_TAC[num_CONV `2`; num_CONV `1`; SUM_CLAUSES_NUMSEG; LE_0; + REAL_ADD_AC]);; + +(* ------------------------------------------------------------------------- *) +(* The key result. *) +(* ------------------------------------------------------------------------- *) + +let DERANGEMENTS = prove + (`!n. ~(n = 0) + ==> &(derangements n) = + &(FACT n) * sum(0..n) (\k. --(&1) pow k / &(FACT k))`, + MATCH_MP_TAC DERANGEMENT_INDUCT THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[derangements; SUM_1] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[derangements; ARITH; SUM_2; SUM_1] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[ARITH_RULE `n + 2 = (n + 1) + 1`] THEN + SIMP_TAC[SUM_ADD_SPLIT; LE_0; SUM_SING_NUMSEG] THEN + REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[real_pow] THEN REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_ADD] THEN + MP_TAC(SPEC `n:num` FACT_LT) THEN UNDISCH_TAC `~(n = 0)` THEN + REWRITE_TAC[GSYM LT_NZ; REAL_POW_NEG; GSYM REAL_OF_NUM_LT; REAL_POW_ONE] THEN + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* A more "explicit" formula. We could sharpen 1/2 to 0.3678794+epsilon *) +(* ------------------------------------------------------------------------- *) + +let DERANGEMENTS_EXP = prove + (`!n. ~(n = 0) + ==> let e = exp(&1) in + abs(&(derangements n) - &(FACT n) / e) < &1 / &2`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DERANGEMENTS; LET_DEF; LET_END_DEF] THEN + REWRITE_TAC[real_div; GSYM REAL_EXP_NEG] THEN ASM_CASES_TAC `n < 5` THENL + [FIRST_X_ASSUM(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP + (ARITH_RULE `n < 5 ==> n = 0 \/ n = 1 \/ n = 2 \/ n = 3 \/ n = 4`)) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC(map (num_CONV o mk_small_numeral) (1--5)) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `abs x < a <=> --a < x /\ x < a`] THEN + REWRITE_TAC[real_sub] THEN CONJ_TAC THEN CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + MP_TAC(SPECL [`-- &1`; `n + 1`] MCLAURIN_EXP_LE) THEN + SIMP_TAC[PSUM_SUM_NUMSEG; ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[ARITH_RULE `(0 + n + 1) - 1 = n`; GSYM real_div] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `abs(a * b - a * (b + c)) = abs(a * c)`] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + SIMP_TAC[REAL_OF_NUM_LT; FACT_LT; REAL_FIELD + `&0 < a ==> a * b / ((&n + &1) * a) = b / (&n + &1)`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `exp(&1)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_EXP_MONO_LE] THEN + UNDISCH_TAC `abs(u) <= abs(-- &1)` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&3` THEN CONJ_TAC THENL + [CONV_TAC REALCALC_REL_CONV; ALL_TAC] THEN + UNDISCH_TAC `~(n < 5)` THEN REWRITE_TAC[NOT_LT; GSYM REAL_OF_NUM_LE] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence the critical "rounding" property. *) +(* ------------------------------------------------------------------------- *) + +let round = new_definition + `round x = @n. integer(n) /\ n - &1 / &2 <= x /\ x < n + &1 / &2`;; + +let ROUND_WORKS = prove + (`!x. integer(round x) /\ round x - &1 / &2 <= x /\ x < round x + &1 / &2`, + GEN_TAC THEN REWRITE_TAC[round] THEN CONV_TAC SELECT_CONV THEN + EXISTS_TAC `floor(x + &1 / &2)` THEN MP_TAC(SPEC `x + &1 / &2` FLOOR) THEN + SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let DERANGEMENTS_EXP = prove + (`!n. ~(n = 0) + ==> let e = exp(&1) in &(derangements n) = round(&(FACT n) / e)`, + REPEAT STRIP_TAC THEN LET_TAC THEN + MATCH_MP_TAC REAL_EQ_INTEGERS_IMP THEN + REWRITE_TAC[INTEGER_CLOSED; ROUND_WORKS] THEN + MP_TAC(SPEC `&(FACT n) / e` ROUND_WORKS) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DERANGEMENTS_EXP) THEN + ASM_REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Put them together. *) +(* ------------------------------------------------------------------------- *) + +let THE_DERANGEMENTS_FORMULA = prove + (`!n s. s HAS_SIZE n /\ ~(n = 0) + ==> FINITE {p | p deranges s} /\ + let e = exp(&1) in + &(CARD {p | p deranges s}) = round(&(FACT n) / e)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP NUMBER_OF_DERANGEMENTS) THEN + ASM_SIMP_TAC[HAS_SIZE; DERANGEMENTS_EXP]);; diff --git a/100/desargues.ml b/100/desargues.ml new file mode 100644 index 0000000..e0827fc --- /dev/null +++ b/100/desargues.ml @@ -0,0 +1,399 @@ +(* ========================================================================= *) +(* #87: Desargues's theorem. *) +(* ========================================================================= *) + +needs "Multivariate/cross.ml";; + +(* ------------------------------------------------------------------------- *) +(* A lemma we want to justify some of the axioms. *) +(* ------------------------------------------------------------------------- *) + +let NORMAL_EXISTS = prove + (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN + MP_TAC(ISPEC `{u:real^3,v}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; DIMINDEX_3] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD {u:real^3,v}` THEN CONJ_TAC THEN + SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Type of directions. *) +(* ------------------------------------------------------------------------- *) + +let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") + (MESON[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] `?x:real^3. ~(x = vec 0)`);; + +parse_as_infix("||",(11,"right"));; +parse_as_infix("_|_",(11,"right"));; + +let perpdir = new_definition + `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; + +let pardir = new_definition + `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; + +let DIRECTION_CLAUSES = prove + (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ + ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, + MESON_TAC[direction_tybij]);; + +let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) + (`(!x. x || x) /\ + (!x y. x || y <=> y || x) /\ + (!x y z. x || y /\ y || z ==> x || z)`, + REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let PARDIR_EQUIV = prove + (`!x y. ((||) x = (||) y) <=> x || y`, + REWRITE_TAC[FUN_EQ_THM] THEN + MESON_TAC[PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS]);; + +let DIRECTION_AXIOM_1 = prove + (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ + !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_2 = prove + (`!l l'. ?p. p _|_ l /\ p _|_ l'`, + REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN + MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; + +let DIRECTION_AXIOM_3 = prove + (`?p p' p''. + ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN MAP_EVERY + (fun t -> EXISTS_TAC t THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_3; ARITH]) + [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN + VEC3_TAC);; + +let DIRECTION_AXIOM_4_WEAK = prove + (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ + ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ + orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ + orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 2) cross (l cross basis 3) = vec 0)` + MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; + +let ORTHOGONAL_COMBINE = prove + (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) + ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_4 = prove + (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + p _|_ l /\ p' _|_ l /\ p'' _|_ l`, + MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; + +let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; + +let PERPDIR_WELLDEF = prove + (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let perpl,perpl_th = + lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) + "perpl" PERPDIR_WELLDEF;; + +let line_lift_thm = lift_theorem line_tybij + (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; + +let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; +let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; +let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; +let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; + +let point_tybij = new_type_definition "point" ("mk_point","dest_point") + (prove(`?x:line. T`,REWRITE_TAC[]));; + +parse_as_infix("on",(11,"right"));; + +let on = new_definition `p on l <=> perpl (dest_point p) l`;; + +let POINT_CLAUSES = prove + (`((p = p') <=> (dest_point p = dest_point p')) /\ + ((!p. P (dest_point p)) <=> (!l. P l)) /\ + ((?p. P (dest_point p)) <=> (?l. P l))`, + MESON_TAC[point_tybij]);; + +let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; + +let AXIOM_1 = prove + (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ + !l'. p on l' /\ p' on l' ==> (l' = l)`, + POINT_TAC LINE_AXIOM_1);; + +let AXIOM_2 = prove + (`!l l'. ?p. p on l /\ p on l'`, + POINT_TAC LINE_AXIOM_2);; + +let AXIOM_3 = prove + (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p on l /\ p' on l /\ p'' on l)`, + POINT_TAC LINE_AXIOM_3);; + +let AXIOM_4 = prove + (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p on l /\ p' on l /\ p'' on l`, + POINT_TAC LINE_AXIOM_4);; + +(* ------------------------------------------------------------------------- *) +(* Mappings from vectors in R^3 to projective lines and points. *) +(* ------------------------------------------------------------------------- *) + +let projl = new_definition + `projl x = mk_line((||) (mk_dir x))`;; + +let projp = new_definition + `projp x = mk_point(projl x)`;; + +(* ------------------------------------------------------------------------- *) +(* Mappings in the other direction, to (some) homogeneous coordinates. *) +(* ------------------------------------------------------------------------- *) + +let PROJL_TOTAL = prove + (`!l. ?x. ~(x = vec 0) /\ l = projl x`, + GEN_TAC THEN + SUBGOAL_THEN `?d. l = mk_line((||) d)` (CHOOSE_THEN SUBST1_TAC) THENL + [MESON_TAC[fst line_tybij; snd line_tybij]; + REWRITE_TAC[projl] THEN EXISTS_TAC `dest_dir d` THEN + MESON_TAC[direction_tybij]]);; + +let homol = new_specification ["homol"] + (REWRITE_RULE[SKOLEM_THM] PROJL_TOTAL);; + +let PROJP_TOTAL = prove + (`!p. ?x. ~(x = vec 0) /\ p = projp x`, + REWRITE_TAC[projp] THEN MESON_TAC[PROJL_TOTAL; point_tybij]);; + +let homop_def = new_definition + `homop p = homol(dest_point p)`;; + +let homop = prove + (`!p. ~(homop p = vec 0) /\ p = projp(homop p)`, + GEN_TAC THEN REWRITE_TAC[homop_def; projp; MESON[point_tybij] + `p = mk_point l <=> dest_point p = l`] THEN + MATCH_ACCEPT_TAC homol);; + +(* ------------------------------------------------------------------------- *) +(* Key equivalences of concepts in projective space and homogeneous coords. *) +(* ------------------------------------------------------------------------- *) + +let parallel = new_definition + `parallel x y <=> x cross y = vec 0`;; + +let ON_HOMOL = prove + (`!p l. p on l <=> orthogonal (homop p) (homol l)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homop; homol] THEN + REWRITE_TAC[on; projp; projl; REWRITE_RULE[] point_tybij] THEN + REWRITE_TAC[GSYM perpl_th; perpdir] THEN BINOP_TAC THEN + MESON_TAC[homol; homop; direction_tybij]);; + +let EQ_HOMOL = prove + (`!l l'. l = l' <=> parallel (homol l) (homol l')`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [homol] THEN + REWRITE_TAC[projl; MESON[fst line_tybij; snd line_tybij] + `mk_line((||) l) = mk_line((||) l') <=> (||) l = (||) l'`] THEN + REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir; parallel] THEN + MESON_TAC[homol; direction_tybij]);; + +let EQ_HOMOP = prove + (`!p p'. p = p' <=> parallel (homop p) (homop p')`, + REWRITE_TAC[homop_def; GSYM EQ_HOMOL] THEN + MESON_TAC[point_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* A "welldefinedness" result for homogeneous coordinate map. *) +(* ------------------------------------------------------------------------- *) + +let PARALLEL_PROJL_HOMOL = prove + (`!x. parallel x (homol(projl x))`, + GEN_TAC THEN REWRITE_TAC[parallel] THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN + ASM_REWRITE_TAC[CROSS_0] THEN MP_TAC(ISPEC `projl x` homol) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [projl] THEN + DISCH_THEN(MP_TAC o AP_TERM `dest_line`) THEN + REWRITE_TAC[MESON[fst line_tybij; snd line_tybij] + `dest_line(mk_line((||) l)) = (||) l`] THEN + REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir] THEN + ASM_MESON_TAC[direction_tybij]);; + +let PARALLEL_PROJP_HOMOP = prove + (`!x. parallel x (homop(projp x))`, + REWRITE_TAC[homop_def; projp; REWRITE_RULE[] point_tybij] THEN + REWRITE_TAC[PARALLEL_PROJL_HOMOL]);; + +let PARALLEL_PROJP_HOMOP_EXPLICIT = prove + (`!x. ~(x = vec 0) ==> ?a. ~(a = &0) /\ homop(projp x) = a % x`, + MP_TAC PARALLEL_PROJP_HOMOP THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[parallel; CROSS_EQ_0; COLLINEAR_LEMMA] THEN + GEN_TAC THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN + ASM_REWRITE_TAC[homop] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:real` THEN ASM_CASES_TAC `c = &0` THEN + ASM_REWRITE_TAC[homop; VECTOR_MUL_LZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Brackets, collinearity and their connection. *) +(* ------------------------------------------------------------------------- *) + +let bracket = define + `bracket[a;b;c] = det(vector[homop a;homop b;homop c])`;; + +let COLLINEAR = new_definition + `COLLINEAR s <=> ?l. !p. p IN s ==> p on l`;; + +let COLLINEAR_SINGLETON = prove + (`!a. COLLINEAR {a}`, + REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[AXIOM_1; AXIOM_3]);; + +let COLLINEAR_PAIR = prove + (`!a b. COLLINEAR{a,b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:point = b` THEN + ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SINGLETON] THEN + REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[AXIOM_1]);; + +let COLLINEAR_TRIPLE = prove + (`!a b c. COLLINEAR{a,b,c} <=> ?l. a on l /\ b on l /\ c on l`, + REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY]);; + +let COLLINEAR_BRACKET = prove + (`!p1 p2 p3. COLLINEAR {p1,p2,p3} <=> bracket[p1;p2;p3] = &0`, + let lemma = prove + (`!a b c x y. + x cross y = vec 0 /\ ~(x = vec 0) /\ + orthogonal a x /\ orthogonal b x /\ orthogonal c x + ==> orthogonal a y /\ orthogonal b y /\ orthogonal c y`, + REWRITE_TAC[orthogonal] THEN VEC3_TAC) in + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[COLLINEAR_TRIPLE; bracket; ON_HOMOL; LEFT_IMP_EXISTS_THM] THEN + MP_TAC homol THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[DET_3; orthogonal; DOT_3; VECTOR_3; CART_EQ; + DIMINDEX_3; FORALL_3; VEC_COMPONENT] THEN + CONV_TAC REAL_RING; + ASM_CASES_TAC `p1:point = p2` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_PAIR]; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[parallel; COLLINEAR_TRIPLE; bracket; EQ_HOMOP; ON_HOMOL] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `mk_line((||) (mk_dir(homop p1 cross homop p2)))` THEN + MATCH_MP_TAC lemma THEN EXISTS_TAC `homop p1 cross homop p2` THEN + ASM_REWRITE_TAC[ORTHOGONAL_CROSS] THEN + REWRITE_TAC[orthogonal] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + ONCE_REWRITE_TAC[CROSS_TRIPLE] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + ASM_REWRITE_TAC[DOT_CROSS_DET] THEN + REWRITE_TAC[GSYM projl; GSYM parallel; PARALLEL_PROJL_HOMOL]]);; + +(* ------------------------------------------------------------------------- *) +(* Rather crude shuffling of bracket triple into canonical order. *) +(* ------------------------------------------------------------------------- *) + +let BRACKET_SWAP,BRACKET_SHUFFLE = (CONJ_PAIR o prove) + (`bracket[x;y;z] = --bracket[x;z;y] /\ + bracket[x;y;z] = bracket[y;z;x] /\ + bracket[x;y;z] = bracket[z;x;y]`, + REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; + +let BRACKET_SWAP_CONV = + let conv = GEN_REWRITE_CONV I [BRACKET_SWAP] in + fun tm -> let th = conv tm in + let tm' = rand(rand(concl th)) in + if term_order tm tm' then th else failwith "BRACKET_SWAP_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Direct proof following Richter-Gebert's "Meditations on Ceva's Theorem", *) +(* except for a change of variable names. The degenerate conditions here are *) +(* just those that naturally get used in the proof. *) +(* ------------------------------------------------------------------------- *) + +let DESARGUES_DIRECT = prove + (`~COLLINEAR {A',B,S} /\ + ~COLLINEAR {A,P,C} /\ + ~COLLINEAR {A,P,R} /\ + ~COLLINEAR {A,C,B} /\ + ~COLLINEAR {A,B,R} /\ + ~COLLINEAR {C',P,A'} /\ + ~COLLINEAR {C',P,B} /\ + ~COLLINEAR {C',P,B'} /\ + ~COLLINEAR {C',A',S} /\ + ~COLLINEAR {C',A',B'} /\ + ~COLLINEAR {P,C,A'} /\ + ~COLLINEAR {P,C,B} /\ + ~COLLINEAR {P,A',R} /\ + ~COLLINEAR {P,B,Q} /\ + ~COLLINEAR {P,Q,B'} /\ + ~COLLINEAR {C,B,S} /\ + ~COLLINEAR {A',Q,B'} + ==> COLLINEAR {P,A',A} /\ + COLLINEAR {P,B,B'} /\ + COLLINEAR {P,C',C} /\ + COLLINEAR {B,C,Q} /\ + COLLINEAR {B',C',Q} /\ + COLLINEAR {A,R,C} /\ + COLLINEAR {A',C',R} /\ + COLLINEAR {B,S,A} /\ + COLLINEAR {A',S,B'} + ==> COLLINEAR {Q,S,R}`, + REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_BRACKET] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(bracket[P;A';A] = &0 + ==> bracket[P;A';R] * bracket[P;A;C] = + bracket[P;A';C] * bracket[P;A;R]) /\ + (bracket[P;B;B'] = &0 + ==> bracket[P;B;Q] * bracket[P;B';C'] = + bracket[P;B;C'] * bracket[P;B';Q]) /\ + (bracket[P;C';C] = &0 + ==> bracket[P;C';B] * bracket[P;C;A'] = + bracket[P;C';A'] * bracket[P;C;B]) /\ + (bracket[B;C;Q] = &0 + ==> bracket[B;C;P] * bracket[B;Q;S] = + bracket[B;C;S] * bracket[B;Q;P]) /\ + (bracket[B';C';Q] = &0 + ==> bracket[B';C';A'] * bracket[B';Q;P] = + bracket[B';C';P] * bracket[B';Q;A']) /\ + (bracket[A;R;C] = &0 + ==> bracket[A;R;P] * bracket[A;C;B] = + bracket[A;R;B] * bracket[A;C;P]) /\ + (bracket[A';C';R] = &0 + ==> bracket[A';C';P] * bracket[A';R;S] = + bracket[A';C';S] * bracket[A';R;P]) /\ + (bracket[B;S;A] = &0 + ==> bracket[B;S;C] * bracket[B;A;R] = + bracket[B;S;R] * bracket[B;A;C]) /\ + (bracket[A';S;B'] = &0 + ==> bracket[A';S;C'] * bracket[A';B';Q] = + bracket[A';S;Q] * bracket[A';B';C'])` + MP_TAC THENL + [REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + REPEAT(MATCH_MP_TAC(TAUT + `(c ==> d ==> b ==> e) ==> ((a ==> b) /\ c ==> a /\ d ==> e)`)) THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o MATCH_MP th)) THEN + REPEAT(ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING + `a = b /\ x:real = y ==> a * x = b * y`))) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[BRACKET_SHUFFLE] THEN + CONV_TAC(ONCE_DEPTH_CONV BRACKET_SWAP_CONV) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_NEG_EQ_0] THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `!b. (a ==> b) /\ (b ==> c) ==> a ==> c`) THEN + EXISTS_TAC `bracket[B;Q;S] * bracket[A';R;S] = + bracket[B;R;S] * bracket[A';Q;S]` THEN + CONJ_TAC THENL [POP_ASSUM MP_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; diff --git a/100/descartes.ml b/100/descartes.ml new file mode 100644 index 0000000..2b8013f --- /dev/null +++ b/100/descartes.ml @@ -0,0 +1,834 @@ +(* ========================================================================= *) +(* Rob Arthan's "Descartes's Rule of Signs by an Easy Induction". *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* A couple of handy lemmas. *) +(* ------------------------------------------------------------------------- *) + +let OPPOSITE_SIGNS = prove + (`!a b:real. a * b < &0 <=> &0 < a /\ b < &0 \/ a < &0 /\ &0 < b`, + REWRITE_TAC[REAL_ARITH `a * b < &0 <=> &0 < a * --b`; REAL_MUL_POS_LT] THEN + REAL_ARITH_TAC);; + +let VARIATION_SET_FINITE = prove + (`FINITE s ==> FINITE {p,q | p IN s /\ q IN s /\ P p q}`, + REWRITE_TAC[SET_RULE + `{p,q | p IN s /\ q IN t /\ R p q} = + {p,q | p IN s /\ q IN {q | q IN t /\ R p q}}`] THEN + SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_RESTRICT]);; + +(* ------------------------------------------------------------------------- *) +(* Variation in a sequence of coefficients. *) +(* ------------------------------------------------------------------------- *) + +let variation = new_definition + `variation s (a:num->real) = + CARD {(p,q) | p IN s /\ q IN s /\ p < q /\ + a(p) * a(q) < &0 /\ + !i. i IN s /\ p < i /\ i < q ==> a(i) = &0 }`;; + +let VARIATION_EQ = prove + (`!a b s. (!i. i IN s ==> a i = b i) ==> variation s a = variation s b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[variation] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + ASM_MESON_TAC[]);; + +let VARIATION_SUBSET = prove + (`!a s t. t SUBSET s /\ (!i. i IN (s DIFF t) ==> a i = &0) + ==> variation s a = variation t a`, + REWRITE_TAC[IN_DIFF; SUBSET] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[variation] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + ASM_MESON_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL]);; + +let VARIATION_SPLIT = prove + (`!a s n. + FINITE s /\ n IN s /\ ~(a n = &0) + ==> variation s a = variation {i | i IN s /\ i <= n} a + + variation {i | i IN s /\ n <= i} a`, + REWRITE_TAC[variation] THEN REPEAT STRIP_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN + ASM_SIMP_TAC[VARIATION_SET_FINITE; FINITE_RESTRICT] THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC; + REWRITE_TAC[IN_UNION; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC; + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `n:num` th) THEN ASM_REWRITE_TAC[] THEN ASSUME_TAC th) THEN + SIMP_TAC[TAUT `~(a /\ b) <=> ~b \/ ~a`] THEN MATCH_MP_TAC MONO_OR] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + TRY(FIRST_ASSUM MATCH_MP_TAC) THEN + FIRST_ASSUM(fun th -> MP_TAC(SPEC `n:num` th) THEN ASM_REWRITE_TAC[]) THEN + ASM_ARITH_TAC]);; + +let VARIATION_SPLIT_NUMSEG = prove + (`!a m n p. n IN m..p /\ ~(a n = &0) + ==> variation(m..p) a = variation(m..n) a + variation(n..p) a`, + REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP + (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> b /\ c ==> a ==> d`] + VARIATION_SPLIT)) THEN + REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN ASM_ARITH_TAC);; + +let VARIATION_1 = prove + (`!a n. variation {n} a = 0`, + REWRITE_TAC[variation; IN_SING] THEN + REWRITE_TAC[ARITH_RULE `p:num = n /\ q = n /\ p < q /\ X <=> F`] THEN + MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; NOT_IN_EMPTY]);; + +let VARIATION_2 = prove + (`!a m n. variation {m,n} a = if a(m) * a(n) < &0 then 1 else 0`, + GEN_TAC THEN MATCH_MP_TAC WLOG_LT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[INSERT_AC; VARIATION_1; GSYM REAL_NOT_LE; REAL_LE_SQUARE]; + REWRITE_TAC[INSERT_AC; REAL_MUL_SYM]; + REPEAT STRIP_TAC THEN REWRITE_TAC[variation; IN_INSERT; NOT_IN_EMPTY] THEN + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d /\ e <=> (a /\ b /\ c) /\ d /\ e`] THEN + ASM_SIMP_TAC[ARITH_RULE + `m:num < n + ==> ((p = m \/ p = n) /\ (q = m \/ q = n) /\ p < q <=> + p = m /\ q = n)`] THEN + REWRITE_TAC[MESON[] `(p = m /\ q = n) /\ X p q <=> + (p = m /\ q = n) /\ X m n`] THEN + REWRITE_TAC[ARITH_RULE `(i:num = m \/ i = n) /\ m < i /\ i < n <=> F`] THEN + ASM_CASES_TAC `a m * a(n:num) < &0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[SET_RULE `{p,q | p = a /\ q = b} = {(a,b)}`] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH]; + MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN + SIMP_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; NOT_IN_EMPTY]]]);; + +let VARIATION_3 = prove + (`!a m n p. + m < n /\ n < p + ==> variation {m,n,p} a = if a(n) = &0 then variation{m,p} a + else variation {m,n} a + variation{n,p} a`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [MATCH_MP_TAC VARIATION_SUBSET THEN ASM SET_TAC[]; + MP_TAC(ISPECL [`a:num->real`; `{m:num,n,p}`; `n:num`] VARIATION_SPLIT) THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN SUBST1_TAC THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_ARITH_TAC]);; + +let VARIATION_OFFSET = prove + (`!p m n a. variation(m+p..n+p) a = variation(m..n) (\i. a(i + p))`, + REPEAT GEN_TAC THEN REWRITE_TAC[variation] THEN + MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN MAP_EVERY EXISTS_TAC + [`\(i:num,j). i - p,j - p`; `\(i:num,j). i + p,j + p`] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + SIMP_TAC[VARIATION_SET_FINITE; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_NUMSEG; PAIR_EQ] THEN + REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `y < &0 ==> x = y ==> x < &0`)) THEN + BINOP_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `i - p:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC EQ_IMP] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The crucial lemma (roughly Lemma 2 in the paper). *) +(* ------------------------------------------------------------------------- *) + +let ARTHAN_LEMMA = prove + (`!n a b. + ~(a n = &0) /\ (b n = &0) /\ (!m. sum(0..m) a = b m) + ==> ?d. ODD d /\ variation (0..n) a = variation (0..n) b + d`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "*") THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN + ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> n = 1 \/ 2 <= n`)) + THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `1` THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + REWRITE_TAC[VARIATION_2; OPPOSITE_SIGNS] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `0` th) THEN MP_TAC(SPEC `1` th)) THEN + SIMP_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `?p. 1 < p /\ p <= n /\ ~(a p = &0)` MP_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `2 <= n ==> 1 < n`; LE_REFL]; + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[TAUT `a ==> ~(b /\ c /\ ~d) <=> a /\ b /\ c ==> d`] THEN + STRIP_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_THEN(MP_TAC o SPECL + [`(\i. if i + 1 = 1 then a 0 + a 1 else a(i + 1)):num->real`; + `(\i. b(i + 1)):num->real`]) THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1) /\ n - 1 + 1 = n`] THEN + REWRITE_TAC[GSYM(SPEC `1` VARIATION_OFFSET)] THEN ANTS_TAC THENL + [X_GEN_TAC `m:num` THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(0..m+1) a` THEN CONJ_TAC THENL + [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH_RULE `0 + 1 <= n + 1`] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN + AP_TERM_TAC THEN REWRITE_TAC[ARITH_RULE `2 = 1 + 1`; SUM_OFFSET] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN ARITH_TAC; + ASM_REWRITE_TAC[]]; + ABBREV_TAC `a':num->real = \m. if m = 1 then a 0 + a 1 else a m` THEN + ASM_SIMP_TAC[ARITH_RULE + `2 <= n ==> n - 1 + 1 = n /\ n - 1 - 1 + 1 = n - 1`] THEN + CONV_TAC NUM_REDUCE_CONV] THEN + SUBGOAL_THEN + `variation (1..n) a' = variation {1,p} a' + variation (p..n) a /\ + variation (0..n) a = variation {0,1,p} a + variation (p..n) a` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN MATCH_MP_TAC EQ_TRANS THENL + [EXISTS_TAC `variation(1..p) a' + variation(p..n) a'`; + EXISTS_TAC `variation(0..p) a + variation(p..n) a`] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN EXPAND_TAC "a'" THEN + REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; + BINOP_TAC THENL + [MATCH_MP_TAC VARIATION_SUBSET; MATCH_MP_TAC VARIATION_EQ] THEN + EXPAND_TAC "a'" THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REWRITE_TAC[IN_NUMSEG] THEN TRY(GEN_TAC THEN ASM_ARITH_TAC) THEN + (CONJ_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[IN_DIFF]]) THEN + REWRITE_TAC[IN_NUMSEG; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_ARITH_TAC]); + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (INT_ARITH + `a + b:int = c + d ==> c = (a + b) - d`)) THEN + REWRITE_TAC[INT_ARITH `a + b:int = c + d <=> d = (a + b) - c`] THEN + ASM_CASES_TAC `a 0 + a 1 = &0` THENL + [SUBGOAL_THEN `!i. 0 < i /\ i < p ==> b i = &0` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `i:num`) THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; + ARITH_RULE `0 < i ==> 0 + 1 <= i`] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LID] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(b:num->real) p = a p` ASSUME_TAC THENL + [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + SIMP_TAC[SUM_CLAUSES_RIGHT; ASSUME `1 < p`; + ARITH_RULE `1 < p ==> 0 < p /\ 0 <= p`] THEN + ASM_REWRITE_TAC[REAL_EQ_ADD_RCANCEL_0] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `variation(0..n) b = variation {0,p} b + variation(1..n) b` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `variation(0..p) b + variation(p..n) b` THEN CONJ_TAC THENL + [MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN REWRITE_TAC[IN_NUMSEG] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `p:num`) THEN + SIMP_TAC[SUM_CLAUSES_RIGHT; ASSUME `1 < p`; + ARITH_RULE `1 < p ==> 0 < p /\ 0 <= p`] THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `~(ap = &0) ==> s = &0 ==> ~(s + ap = &0)`)) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + BINOP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN + MATCH_MP_TAC VARIATION_SUBSET THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_NUMSEG; IN_INSERT; NOT_IN_EMPTY] THEN + (CONJ_TAC THENL [ASM_ARITH_TAC; REPEAT STRIP_TAC]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC]; + SUBGOAL_THEN `variation(0..n) b = variation {0,1} b + variation(1..n) b` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `variation(0..1) b + variation(1..n) b` THEN CONJ_TAC THENL + [MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN REWRITE_TAC[IN_NUMSEG] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `1`) THEN + SIMP_TAC[SUM_CLAUSES_NUMSEG; num_CONV `1`] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VARIATION_SUBSET THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_NUMSEG; IN_INSERT; NOT_IN_EMPTY] THEN + ARITH_TAC]; + SUBGOAL_THEN `(b:num->real) 1 = a 0 + a 1` ASSUME_TAC THENL + [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + SIMP_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC]]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `0`)) THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[SUM_SING_NUMSEG] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + ASM_SIMP_TAC[VARIATION_3; ARITH; OPPOSITE_SIGNS] THEN COND_CASES_TAC THEN + REWRITE_TAC[VARIATION_2; OPPOSITE_SIGNS; REAL_LT_REFL] THEN + EXPAND_TAC "a'" THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_SIMP_TAC[ARITH_RULE `1 < p ==> ~(p = 1)`; REAL_LT_REFL] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(BINDER_CONV(RAND_CONV(RAND_CONV INT_POLY_CONV))) THEN + REWRITE_TAC[INT_ARITH `x:int = y + --z <=> x + z = y`] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN + ASM_REWRITE_TAC[ODD_ADD; ARITH_ODD; ARITH_EVEN] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Relate even-ness or oddity of variation to signs of end coefficients. *) +(* ------------------------------------------------------------------------- *) + +let VARIATION_OPPOSITE_ENDS = prove + (`!a m n. + m <= n /\ ~(a m = &0) /\ ~(a n = &0) + ==> (ODD(variation(m..n) a) <=> a m * a n < &0)`, + REPEAT GEN_TAC THEN WF_INDUCT_TAC `n - m:num` THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `!i:num. m < i /\ i < n ==> a i = &0` THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `ODD(variation {m,n} a)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC VARIATION_SUBSET THEN + ASM_REWRITE_TAC[INSERT_SUBSET; IN_NUMSEG; IN_DIFF; EMPTY_SUBSET] THEN + REWRITE_TAC[LE_REFL; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + REWRITE_TAC[VARIATION_2] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[ARITH]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`n:num`; `p:num`] th) THEN + MP_TAC(SPECL [`p:num`; `m:num`] th)) THEN + ASM_SIMP_TAC[LT_IMP_LE] THEN + REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `ODD(variation(m..p) a + variation(p..n) a)` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC VARIATION_SPLIT_NUMSEG THEN + ASM_SIMP_TAC[LT_IMP_LE; IN_NUMSEG]; + ASM_REWRITE_TAC[ODD_ADD; OPPOSITE_SIGNS] THEN ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Polynomial with odd variation has at least one positive root. *) +(* This is the only "analytical" part of the proof. *) +(* ------------------------------------------------------------------------- *) + +let REAL_POLYFUN_SGN_AT_INFINITY = prove + (`!a n. ~(a n = &0) + ==> ?B. &0 < B /\ + !x. B <= abs x + ==> real_sgn(sum(0..n) (\i. a i * x pow i)) = + real_sgn(a n * x pow n)`, + let lemma = prove + (`abs(x) < abs(y) ==> real_sgn(x + y) = real_sgn y`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; SUM_SING_NUMSEG]; + ALL_TAC] THEN + ABBREV_TAC `B = sum (0..n-1) (\i. abs(a i)) / abs(a n)` THEN + SUBGOAL_THEN `&0 <= B` ASSUME_TAC THENL + [EXPAND_TAC "B" THEN SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS; SUM_POS_LE_NUMSEG]; + ALL_TAC] THEN + EXISTS_TAC `&1 + B` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_0; LE_1] THEN MATCH_MP_TAC lemma THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(0..n-1) (\i. abs(a i)) * abs x pow (n - 1)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC SUM_ABS_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `(x:real) pow n = x * x pow (n - 1)` SUBST1_TAC THENL + [SIMP_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN ASM_ARITH_TAC; + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC]]]);; + +let REAL_POLYFUN_HAS_POSITIVE_ROOT = prove + (`!a n. a 0 < &0 /\ &0 < a n + ==> ?x. &0 < x /\ sum(0..n) (\i. a i * x pow i) = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?x. &0 < x /\ &0 <= sum(0..n) (\i. a i * x pow i)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:num->real`; `n:num`] REAL_POLYFUN_SGN_AT_INFINITY) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real`)) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `real_sgn(a n * x pow n) = &1` SUBST1_TAC THEN + ASM_SIMP_TAC[REAL_SGN_EQ; REAL_LT_MUL; REAL_POW_LT; real_gt] THEN + REWRITE_TAC[REAL_LT_IMP_LE]; + MP_TAC(ISPECL [`\x. sum(0..n) (\i. a i * x pow i)`; + `&0`; `x:real`; `&0`] REAL_IVT_INCREASING) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; IN_REAL_INTERVAL; + REAL_POW_ZERO; COND_RAND] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG; LE_0] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real` THEN + SIMP_TAC[REAL_LT_LE] THEN ASM_CASES_TAC `y:real = &0` THEN + ASM_SIMP_TAC[REAL_POW_ZERO; COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN + REWRITE_TAC[SUM_DELTA; IN_NUMSEG; LE_0] THEN ASM_REAL_ARITH_TAC]]);; + +let ODD_VARIATION_POSITIVE_ROOT = prove + (`!a n. ODD(variation(0..n) a) + ==> ?x. &0 < x /\ sum(0..n) (\i. a i * x pow i) = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?M. !i. i IN 0..n /\ ~(a i = &0) ==> i <= M` MP_TAC THENL + [EXISTS_TAC `n:num` THEN SIMP_TAC[IN_NUMSEG]; ALL_TAC] THEN + SUBGOAL_THEN `?i. i IN 0..n /\ ~(a i = &0)` MP_TAC THENL + [MATCH_MP_TAC(MESON[] `((!i. P i ==> Q i) ==> F) ==> ?i. P i /\ ~Q i`) THEN + DISCH_TAC THEN SUBGOAL_THEN `variation (0..n) a = variation {0} a` + (fun th -> SUBST_ALL_TAC th THEN ASM_MESON_TAC[VARIATION_1; ODD]) THEN + MATCH_MP_TAC VARIATION_SUBSET THEN + ASM_SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[IN_NUMSEG; SING_SUBSET; LE_0]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> a ==> a /\ b ==> c`] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN REWRITE_TAC[num_MAX] THEN + REWRITE_TAC[TAUT `p ==> ~(q /\ r) <=> p /\ q ==> ~r`; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `p:num <= q` ASSUME_TAC THENL + [ASM_MESON_TAC[NOT_LT]; ALL_TAC] THEN + SUBGOAL_THEN `(a:num->real) p * a q < &0` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM VARIATION_OPPOSITE_ENDS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `ODD p ==> p = q ==> ODD q`)) THEN + MATCH_MP_TAC VARIATION_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG; IN_NUMSEG; IN_DIFF; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; REPEAT STRIP_TAC] THEN + FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_ARITH_TAC); + ALL_TAC] THEN + MP_TAC(ISPECL [`\i. (a:num->real)(p + i) / a q`; `q - p:num`] + REAL_POLYFUN_HAS_POSITIVE_ROOT) THEN + ASM_SIMP_TAC[ADD_CLAUSES; ARITH_RULE `p:num <= q ==> p + q - p = q`] THEN + ANTS_TAC THENL + [REWRITE_TAC[real_div; OPPOSITE_SIGNS; REAL_MUL_POS_LT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPPOSITE_SIGNS]) THEN + REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; GSYM REAL_INV_NEG] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_RING + `!a. y = a * x ==> x = &0 ==> y = &0`) THEN + EXISTS_TAC `(a:num->real) q * x pow p` THEN + REWRITE_TAC[GSYM SUM_LMUL; REAL_ARITH + `(aq * xp) * api / aq * xi:real = (aq / aq) * api * (xp * xi)`] THEN + ASM_CASES_TAC `(a:num->real) q = &0` THENL + [ASM_MESON_TAC[REAL_MUL_LZERO; REAL_LT_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_POW_ADD; REAL_DIV_REFL; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN MP_TAC(SPEC `p:num` SUM_OFFSET) THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC SUM_SUPERSET THEN + REWRITE_TAC[SUBSET_NUMSEG; IN_NUMSEG; IN_DIFF; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; REPEAT STRIP_TAC] THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN + FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_ARITH_TAC));; + +(* ------------------------------------------------------------------------- *) +(* Define root multiplicities. *) +(* ------------------------------------------------------------------------- *) + +let multiplicity = new_definition + `multiplicity f r = + @k. ?a n. ~(sum(0..n) (\i. a i * r pow i) = &0) /\ + !x. f(x) = (x - r) pow k * sum(0..n) (\i. a i * x pow i)`;; + +let MULTIPLICITY_UNIQUE = prove + (`!f a r b m k. + (!x. f(x) = (x - r) pow k * sum(0..m) (\j. b j * x pow j)) /\ + ~(sum(0..m) (\j. b j * r pow j) = &0) + ==> k = multiplicity f r`, + let lemma = prove + (`!i j f g. f real_continuous_on (:real) /\ g real_continuous_on (:real) /\ + ~(f r = &0) /\ ~(g r = &0) + ==> (!x. (x - r) pow i * f(x) = (x - r) pow j * g(x)) + ==> j = i`, + MATCH_MP_TAC WLOG_LT THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `F ==> p`) THEN + MP_TAC(ISPECL [`atreal r`; `f:real->real`; + `(f:real->real) r`; `&0`] + REALLIM_UNIQUE) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_ATREAL] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN + ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; + IN_UNIV]; + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\x:real. (x - r) pow (j - i) * g x` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; REAL_ARITH `&0 < abs(x - r) <=> ~(x = r)`] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_RING + `!a. a * x = a * y /\ ~(a = &0) ==> x = y`) THEN + EXISTS_TAC `(x - r:real) pow i` THEN + ASM_REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD; REAL_POW_EQ_0] THEN + ASM_SIMP_TAC[REAL_SUB_0; ARITH_RULE `i:num < j ==> i + j - i = j`]; + SUBST1_TAC(REAL_ARITH `&0 = &0 * (g:real->real) r`) THEN + MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC REALLIM_NULL_POW THEN + REWRITE_TAC[GSYM REALLIM_NULL; REALLIM_ATREAL_ID] THEN ASM_ARITH_TAC; + REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN + ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; + REAL_OPEN_UNIV; IN_UNIV]]]]) in + REPEAT STRIP_TAC THEN REWRITE_TAC[multiplicity] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `j:num` THEN EQ_TAC THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL + [REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + DISCH_THEN SUBST1_TAC THEN + MAP_EVERY EXISTS_TAC [`b:num->real`; `m:num`] THEN ASM_REWRITE_TAC[]]);; + +let MULTIPLICITY_WORKS = prove + (`!r n a. + (?i. i IN 0..n /\ ~(a i = &0)) + ==> ?b m. + ~(sum(0..m) (\i. b i * r pow i) = &0) /\ + !x. sum(0..n) (\i. a i * x pow i) = + (x - r) pow multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r * + sum(0..m) (\i. b i * x pow i)`, + REWRITE_TAC[multiplicity] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN + GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN + ASM_CASES_TAC `(a:num->real) n = &0` THENL + [ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2] + THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `a:num->real`) THEN + ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_0; LE_1] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `i:num` MP_TAC) THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i:num = n` THENL [ASM_MESON_TAC[]; ASM_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(K ALL_TAC) THEN + ASM_CASES_TAC `sum(0..n) (\i. a i * r pow i) = &0` THENL + [ASM_CASES_TAC `n = 0` THENL + [UNDISCH_TAC `sum (0..n) (\i. a i * r pow i) = &0` THEN + ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2; SUM_SING] THEN + REWRITE_TAC[real_pow; REAL_MUL_RID] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(GEN `x:real` (ISPECL [`a:num->real`; `x:real`; `r:real`; `n:num`] + REAL_SUB_POLYFUN)) THEN ASM_SIMP_TAC[LE_1; REAL_SUB_RZERO] THEN + ABBREV_TAC `b j = sum (j + 1..n) (\i. a i * r pow (i - j - 1))` THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `b:num->real`) THEN ANTS_TAC THENL + [EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_0] THEN + EXPAND_TAC "b" THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[SUB_ADD; LE_1; SUM_SING_NUMSEG; real_pow; REAL_MUL_RID; + ARITH_RULE `n - (n - 1) - 1 = 0`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (fun th -> + EXISTS_TAC `SUC k` THEN MP_TAC th)) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC]; + MAP_EVERY EXISTS_TAC [`0`; `a:num->real`; `n:num`] THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]]);; + +let MULTIPLICITY_OTHER_ROOT = prove + (`!a n r s. + ~(r = s) /\ (?i. i IN 0..n /\ ~(a i = &0)) + ==> multiplicity (\x. (x - r) pow m * sum(0..n) (\i. a i * x pow i)) s = + multiplicity (\x. sum(0..n) (\i. a i * x pow i)) s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_UNIQUE THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s:real`; `n:num`; `a:num->real`] + MULTIPLICITY_WORKS) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:num->real`; `p:num`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN + `?b q. !x. sum(0..q) (\j. b j * x pow j) = + (x - r) pow m * sum (0..p) (\i. c i * x pow i)` + MP_TAC THENL + [ALL_TAC; + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_RING `r * x = s * r * y <=> r = &0 \/ s * y = x`] THEN + ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0]] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`c:num->real`; `p:num`; `m:num`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN INDUCT_TAC THEN REPEAT GEN_TAC THENL + [MAP_EVERY EXISTS_TAC [`c:num->real`; `p:num`] THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `c:num->real`]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num->real`; `n:num`] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN + EXISTS_TAC `\i. (if 0 < i then a(i - 1) else &0) - + (if i <= n then r * a i else &0)` THEN + EXISTS_TAC `n + 1` THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG] THEN X_GEN_TAC `x:real` THEN + BINOP_TAC THENL + [MP_TAC(ARITH_RULE `0 <= n + 1`) THEN SIMP_TAC[SUM_CLAUSES_LEFT] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[SUM_OFFSET; LT_REFL] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; ARITH_RULE `0 < i + 1`] THEN + REWRITE_TAC[GSYM SUM_LMUL; ADD_SUB; REAL_POW_ADD; REAL_POW_1]; + SIMP_TAC[SUM_CLAUSES_RIGHT; LE_0; ARITH_RULE `0 < n + 1`] THEN + REWRITE_TAC[ADD_SUB; ARITH_RULE `~(n + 1 <= n)`] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM SUM_LMUL]] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* The main lemmas to be applied iteratively. *) +(* ------------------------------------------------------------------------- *) + +let VARIATION_POSITIVE_ROOT_FACTOR = prove + (`!a n r. + ~(a n = &0) /\ &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0 + ==> ?b. ~(b(n - 1) = &0) /\ + (!x. sum(0..n) (\i. a i * x pow i) = + (x - r) * sum(0..n-1) (\i. b i * x pow i)) /\ + ?d. ODD d /\ variation(0..n) a = variation(0..n-1) b + d`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; real_pow; REAL_MUL_RID] THEN MESON_TAC[]; + STRIP_TAC] THEN + ABBREV_TAC `b = \j. sum (j + 1..n) (\i. a i * r pow (i - j - 1))` THEN + EXISTS_TAC `b:num->real` THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "b" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[SUB_ADD; LE_1] THEN + ASM_SIMP_TAC[SUM_SING_NUMSEG; ARITH_RULE `n - (n - 1) - 1 = 0`] THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_RID]; + MP_TAC(GEN `x:real` (SPECL [`a:num->real`; `x:real`; `r:real`; `n:num`] + REAL_SUB_POLYFUN)) THEN + ASM_SIMP_TAC[LE_1; REAL_SUB_RZERO] THEN DISCH_THEN(K ALL_TAC) THEN + EXPAND_TAC "b" THEN REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(b:num->real) n = &0` ASSUME_TAC THENL + [EXPAND_TAC "b" THEN REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN + ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`n:num`; `\i. if i <= n then a i * (r:real) pow i else &0`; + `\i. if i <= n then --b i * (r:real) pow (i + 1) else &0`] + ARTHAN_LEMMA) THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_LT_IMP_NZ; REAL_NEG_0; + LE_REFL] THEN + ANTS_TAC THENL + [X_GEN_TAC `j:num` THEN EXPAND_TAC "b" THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `j:num <= n` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `!i:num. i <= j ==> i <= n` MP_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC)] THEN + REWRITE_TAC[REAL_ARITH `a:real = --b * c <=> a + b * c = &0`] THEN + REWRITE_TAC[GSYM SUM_RMUL; GSYM REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN + SIMP_TAC[ARITH_RULE `j + 1 <= k ==> k - j - 1 + j + 1 = k`] THEN + ASM_SIMP_TAC[SUM_COMBINE_R; LE_0]; + REWRITE_TAC[GSYM SUM_RESTRICT_SET; IN_NUMSEG] THEN + ASM_SIMP_TAC[ARITH_RULE + `~(j <= n) ==> ((0 <= i /\ i <= j) /\ i <= n <=> 0 <= i /\ i <= n)`] THEN + ASM_REWRITE_TAC[GSYM numseg]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE + `x':num = x /\ y' = y ==> x' = y' + d ==> x = y + d`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `variation(0..n) (\i. a i * r pow i)` THEN CONJ_TAC THENL + [MATCH_MP_TAC VARIATION_EQ THEN SIMP_TAC[IN_NUMSEG]; + ALL_TAC]; + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `variation(0..n) (\i. --b i * r pow (i + 1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VARIATION_EQ THEN SIMP_TAC[IN_NUMSEG]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `variation(0..n-1) (\i. --b i * r pow (i + 1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VARIATION_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG; IN_DIFF; IN_NUMSEG] THEN + CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `i:num` THEN STRIP_TAC] THEN + SUBGOAL_THEN `i:num = n` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ALL_TAC]] THEN + REWRITE_TAC[variation] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a * x) * (b * x'):real = (x * x') * a * b`] THEN + SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC; GSYM REAL_POW_ADD; + REAL_ARITH `--x * --y:real = x * y`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x * y < &0 <=> &0 < x * --y`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_POW_LT] THEN + ASM_SIMP_TAC[REAL_MUL_RNEG; REAL_ENTIRE; REAL_NEG_EQ_0; REAL_POW_EQ_0] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]]);; + +let VARIATION_POSITIVE_ROOT_MULTIPLE_FACTOR = prove + (`!r n a. + ~(a n = &0) /\ &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0 + ==> ?b k m. 0 < k /\ m < n /\ ~(b m = &0) /\ + (!x. sum(0..n) (\i. a i * x pow i) = + (x - r) pow k * sum(0..m) (\i. b i * x pow i)) /\ + ~(sum(0..m) (\j. b j * r pow j) = &0) /\ + ?d. EVEN d /\ variation(0..n) a = variation(0..m) b + k + d`, + GEN_TAC THEN MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; real_pow; REAL_MUL_RID] THEN MESON_TAC[]; + STRIP_TAC] THEN + MP_TAC(ISPECL [`a:num->real`; `n:num`; `r:real`] + VARIATION_POSITIVE_ROOT_FACTOR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `c:num->real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `sum(0..n-1) (\i. c i * r pow i) = &0` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `c:num->real`)] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real` THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_ASSOC] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[ADD1; ADD_ASSOC] THEN EXISTS_TAC `d - 1 + e`; + MAP_EVERY EXISTS_TAC [`c:num->real`; `1`; `n - 1`] THEN + ASM_REWRITE_TAC[REAL_POW_1] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + EXISTS_TAC `d - 1`] THEN + UNDISCH_TAC `ODD d` THEN GEN_REWRITE_TAC LAND_CONV [ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + ASM_REWRITE_TAC[SUC_SUB1; EVEN_ADD; EVEN_MULT; ARITH] THEN ARITH_TAC);; + +let VARIATION_POSITIVE_ROOT_MULTIPLICITY_FACTOR = prove + (`!r n a. + ~(a n = &0) /\ &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0 + ==> ?b m. m < n /\ ~(b m = &0) /\ + (!x. sum(0..n) (\i. a i * x pow i) = + (x - r) pow + (multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r) * + sum(0..m) (\i. b i * x pow i)) /\ + ~(sum(0..m) (\j. b j * r pow j) = &0) /\ + ?d. EVEN d /\ + variation(0..n) a = variation(0..m) b + + multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r + d`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP VARIATION_POSITIVE_ROOT_MULTIPLE_FACTOR) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + DISCH_TAC THEN + SUBGOAL_THEN `multiplicity (\x. sum(0..n) (\i. a i * x pow i)) r = k` + (fun th -> ASM_REWRITE_TAC[th]) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`b:num->real`; `m:num`] THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main theorem. *) +(* ------------------------------------------------------------------------- *) + +let DESCARTES_RULE_OF_SIGNS = prove + (`!f a n. f = (\x. sum(0..n) (\i. a i * x pow i)) /\ + (?i. i IN 0..n /\ ~(a i = &0)) + ==> ?d. EVEN d /\ + variation(0..n) a = + nsum {r | &0 < r /\ f(r) = &0} (\r. multiplicity f r) + d`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`a:num->real`; `n:num`] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + X_GEN_TAC `a:num->real` THEN ASM_CASES_TAC `(a:num->real) n = &0` THENL + [ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2] + THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN ANTS_TAC THENL + [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `a:num->real`)] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[IN_NUMSEG; ARITH_RULE `i <= n ==> i <= n - 1 \/ i = n`]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN + ASM_SIMP_TAC[LE_0; LE_1; SUM_CLAUSES_RIGHT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN + MATCH_MP_TAC VARIATION_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG; IN_DIFF; IN_NUMSEG] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; X_GEN_TAC `i:num` THEN STRIP_TAC] THEN + SUBGOAL_THEN `i:num = n` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]; + DISCH_THEN(K ALL_TAC)] THEN + ASM_CASES_TAC `{r | &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0} = {}` THENL + [ASM_REWRITE_TAC[NSUM_CLAUSES; ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1] THEN + ONCE_REWRITE_TAC[GSYM NOT_ODD] THEN + DISCH_THEN(MP_TAC o MATCH_MP ODD_VARIATION_POSITIVE_ROOT) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`r:real`; `n:num`; `a:num->real`] + VARIATION_POSITIVE_ROOT_MULTIPLICITY_FACTOR) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`b:num->real`; `m:num`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `b:num->real`) THEN ANTS_TAC THENL + [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_0]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:num` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d2:num` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + EXISTS_TAC `d1 + d2:num` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[EVEN_ADD]; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE + `x + y = z ==> (x + d1) + (y + d2):num = z + d1 + d2`) THEN + SUBGOAL_THEN + `{r | &0 < r /\ sum(0..n) (\i. a i * r pow i) = &0} = + r INSERT {r | &0 < r /\ sum(0..m) (\i. b i * r pow i) = &0}` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE `x IN s /\ s DELETE x = t ==> s = x INSERT t`) THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ONCE_ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DELETE] THEN + X_GEN_TAC `s:real` THEN + FIRST_X_ASSUM(K ALL_TAC o SPEC_VAR) THEN + ASM_CASES_TAC `s:real = r` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `FINITE {r | &0 < r /\ sum(0..m) (\i. b i * r pow i) = &0}` + MP_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{r | sum(0..m) (\i. b i * r pow i) = &0}` THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_POLYFUN_FINITE_ROOTS] THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[IN_NUMSEG; LE_0; LE_REFL]; + SIMP_TAC[NSUM_CLAUSES; IN_ELIM_THM] THEN DISCH_TAC] THEN + FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE `s1:num = s2 ==> s1 + m = m + s2`) THEN + MATCH_MP_TAC NSUM_EQ THEN + X_GEN_TAC `s:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun t -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [t]) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MULTIPLICITY_OTHER_ROOT THEN + REWRITE_TAC[MESON[] `(?i. P i /\ Q i) <=> ~(!i. P i ==> ~Q i)`] THEN + REPEAT STRIP_TAC THEN + UNDISCH_TAC `~(sum (0..m) (\j. b j * r pow j) = &0)` THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[REAL_MUL_LZERO; SUM_0]);; diff --git a/100/dirichlet.ml b/100/dirichlet.ml new file mode 100644 index 0000000..62e80b1 --- /dev/null +++ b/100/dirichlet.ml @@ -0,0 +1,2082 @@ +(* ========================================================================= *) +(* Dirichlet's theorem. *) +(* ========================================================================= *) + +needs "Library/products.ml";; +needs "Library/agm.ml";; +needs "Multivariate/transcendentals.ml";; +needs "Library/pocklington.ml";; +needs "Library/multiplicative.ml";; +needs "Examples/mangoldt.ml";; + +prioritize_real();; +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* Rearranging a certain kind of double sum. *) +(* ------------------------------------------------------------------------- *) + +let VSUM_VSUM_DIVISORS = prove + (`!f x. vsum (1..x) (\n. vsum {d | d divides n} (f n)) = + vsum (1..x) (\n. vsum (1..(x DIV n)) (\k. f (k * n) n))`, + SIMP_TAC[VSUM; FINITE_DIVISORS; LE_1] THEN + SIMP_TAC[VSUM; FINITE_NUMSEG; ITERATE_ITERATE_DIVISORS; + MONOIDAL_VECTOR_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* Useful approximation lemmas. *) +(* ------------------------------------------------------------------------- *) + +let REAL_EXP_1_LE_4 = prove + (`exp(&1) <= &4`, + ONCE_REWRITE_TAC[ARITH_RULE `&1 = &1 / &2 + &1 / &2`; REAL_EXP_ADD] THEN + REWRITE_TAC[REAL_ARITH `&4 = &2 * &2`; REAL_EXP_ADD] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MP_TAC(SPEC `&1 / &2` REAL_EXP_BOUND_LEMMA) THEN REAL_ARITH_TAC);; + +let DECREASING_LOG_OVER_N = prove + (`!n. 4 <= n ==> log(&n + &1) / (&n + &1) <= log(&n) / &n`, + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. clog z / z`; `\z. (Cx(&1) - clog(z)) / z pow 2`; + `Cx(&n)`; `Cx(&n + &1)`] COMPLEX_MVT_LINE) THEN + REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN + REWRITE_TAC[REAL_ARITH `~(n + &1 <= x /\ x <= n)`] THEN ANTS_TAC THENL + [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + SUBGOAL_THEN `&0 < Re w` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `w = Cx(&0)` THEN ASM_SIMP_TAC[RE_CX; REAL_LT_REFL] THEN + DISCH_TAC THEN UNDISCH_TAC `~(w = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD; + DISCH_THEN(X_CHOOSE_THEN `z:complex` + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN `&0 < &n /\ &0 < &n + &1` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_DIV; RE_CX; GSYM CX_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --x ==> a - b = x ==> a <= b`) THEN + REWRITE_TAC[RE_MUL_CX; GSYM REAL_MUL_LNEG] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + SUBGOAL_THEN `?u. z = Cx(u)` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[REAL; real]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IM_CX; RE_CX]) THEN + UNDISCH_THEN `T` (K ALL_TAC) THEN + SUBGOAL_THEN `&0 < u` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; RE_CX; + real_div; GSYM REAL_MUL_LNEG; REAL_NEG_SUB; GSYM REAL_POW_INV] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_SUB_LE] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM LOG_EXP] THEN + MATCH_MP_TAC LOG_MONO_LE_IMP THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN + MP_TAC REAL_EXP_1_LE_4 THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* An ad-hoc fact about complex n'th roots. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_COMPLEX_ROOT_NONTRIVIAL = prove + (`!a n. 2 <= n ==> ?z. z pow n = a /\ ~(z = Cx(&1))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `2 <= n ==> ~(n = 0)`)) THEN + ASM_CASES_TAC `a = Cx(&0)` THENL + [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_POW_ZERO] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + ASM_CASES_TAC `a = Cx(&1)` THENL + [EXISTS_TAC `cexp(Cx(&2) * Cx pi * ii * Cx(&1 / &n))` THEN + ASM_SIMP_TAC[COMPLEX_ROOT_UNITY_EQ_1; DIVIDES_ONE; + ARITH_RULE `2 <= n ==> ~(n = 1)`; COMPLEX_ROOT_UNITY]; + MATCH_MP_TAC(MESON[] + `(!x. ~Q x ==> ~P x) /\ (?x. P x) ==> (?x. P x /\ Q x)`) THEN + ASM_SIMP_TAC[COMPLEX_POW_ONE] THEN EXISTS_TAC `cexp(clog a / Cx(&n))` THEN + ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[CEXP_CLOG]]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of a Dirichlet character mod d. *) +(* ------------------------------------------------------------------------- *) + +let dirichlet_character = new_definition + `dirichlet_character d (c:num->complex) <=> + (!n. c(n + d) = c(n)) /\ + (!n. c(n) = Cx(&0) <=> ~coprime(n,d)) /\ + (!m n. c(m * n) = c(m) * c(n))`;; + +let DIRICHLET_CHARACTER_PERIODIC = prove + (`!d c n. dirichlet_character d c ==> c(n + d) = c(n)`, + SIMP_TAC[dirichlet_character]);; + +let DIRICHLET_CHARACTER_EQ_0 = prove + (`!d c n. dirichlet_character d c ==> (c(n) = Cx(&0) <=> ~coprime(n,d))`, + SIMP_TAC[dirichlet_character]);; + +let DIRICHLET_CHARACTER_MUL = prove + (`!d c m n. dirichlet_character d c ==> c(m * n) = c(m) * c(n)`, + SIMP_TAC[dirichlet_character]);; + +let DIRICHLET_CHARACTER_EQ_1 = prove + (`!d c. dirichlet_character d c ==> c(1) = Cx(&1)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIRICHLET_CHARACTER_MUL) THEN + DISCH_THEN(MP_TAC o repeat (SPEC `1`)) THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_FIELD `a = a * a <=> a = Cx(&0) \/ a = Cx(&1)`] THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_EQ_0] THEN + MESON_TAC[COPRIME_1; COPRIME_SYM]);; + +let DIRICHLET_CHARACTER_POW = prove + (`!d c m n. dirichlet_character d c ==> c(m EXP n) = c(m) pow n`, + REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[EXP; complex_pow] THENL + [ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN + ASM_REWRITE_TAC[]);; + +let DIRICHLET_CHARACTER_PERIODIC_GEN = prove + (`!d c m n. dirichlet_character d c ==> c(m * d + n) = c(n)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + GEN_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + ONCE_REWRITE_TAC[ARITH_RULE `(mk + d) + n:num = (mk + n) + d`] THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_PERIODIC]);; + +let DIRICHLET_CHARACTER_CONG = prove + (`!d c m n. + dirichlet_character d c /\ (m == n) (mod d) ==> c(m) = c(n)`, + REWRITE_TAC[CONG_CASES] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_PERIODIC_GEN]);; + +let DIRICHLET_CHARACTER_ROOT = prove + (`!d c n. dirichlet_character d c /\ coprime(d,n) + ==> c(n) pow phi(d) = Cx(&1)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP DIRICHLET_CHARACTER_EQ_1) THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[GSYM(MATCH_MP DIRICHLET_CHARACTER_POW th)]) THEN + MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN + EXISTS_TAC `d:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FERMAT_LITTLE THEN ASM_MESON_TAC[COPRIME_SYM]);; + +let DIRICHLET_CHARACTER_NORM = prove + (`!d c n. dirichlet_character d c + ==> norm(c n) = if coprime(d,n) then &1 else &0`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [ALL_TAC; + REWRITE_TAC[COMPLEX_NORM_ZERO] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; COPRIME_SYM]] THEN + ASM_CASES_TAC `d = 0` THENL + [ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; COMPLEX_NORM_CX; REAL_ABS_NUM; + COPRIME_0; COPRIME_SYM]; + ALL_TAC] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`; `n:num`] + DIRICHLET_CHARACTER_ROOT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN + REWRITE_TAC[COMPLEX_NORM_POW; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`norm((c:num->complex) n)`; `phi d`] REAL_POW_EQ_1_IMP) THEN + ASM_REWRITE_TAC[REAL_ABS_NORM] THEN + ASM_MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_1]);; + +(* ------------------------------------------------------------------------- *) +(* The principal character mod d. *) +(* ------------------------------------------------------------------------- *) + +let chi_0 = new_definition + `chi_0 d n = if coprime(n,d) then Cx(&1) else Cx(&0)`;; + +let DIRICHLET_CHARACTER_CHI_0 = prove + (`dirichlet_character d (chi_0 d)`, + REWRITE_TAC[dirichlet_character; chi_0] THEN + REWRITE_TAC[NUMBER_RULE `coprime(n + d,d) <=> coprime(n,d)`; + NUMBER_RULE `coprime(m * n,d) <=> coprime(m,d) /\ coprime(n,d)`] THEN + CONV_TAC COMPLEX_RING);; + +let DIRICHLET_CHARACTER_EQ_PRINCIPAL = prove + (`!d c. dirichlet_character d c + ==> (c = chi_0 d <=> !n. coprime(n,d) ==> c(n) = Cx(&1))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; chi_0] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0]);; + +let DIRICHLET_CHARACTER_NONPRINCIPAL = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> ?n. coprime(n,d) /\ ~(c n = Cx(&0)) /\ ~(c n = Cx(&1))`, + MESON_TAC[DIRICHLET_CHARACTER_EQ_PRINCIPAL; DIRICHLET_CHARACTER_EQ_0]);; + +let DIRICHLET_CHARACTER_0 = prove + (`!c. dirichlet_character 0 c <=> c = chi_0 0`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[DIRICHLET_CHARACTER_CHI_0] THEN + DISCH_TAC THEN REWRITE_TAC[chi_0; FUN_EQ_THM; COPRIME_0] THEN + X_GEN_TAC `n:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; DIRICHLET_CHARACTER_EQ_0; + COPRIME_0]);; + +let DIRICHLET_CHARACTER_1 = prove + (`!c. dirichlet_character 1 c <=> !n. c n = Cx(&1)`, + GEN_TAC THEN REWRITE_TAC[dirichlet_character; COPRIME_1] THEN EQ_TAC THENL + [STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`1`; `1`]) THEN + ASM_REWRITE_TAC[ARITH; COMPLEX_RING + `x = x * x <=> x = Cx(&0) \/ x = Cx(&1)`] THEN + DISCH_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD1] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `0`)) THEN ASM_REWRITE_TAC[ARITH] THEN + CONV_TAC COMPLEX_RING; + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING]);; + +let DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> ~(d = 0) /\ ~(d = 1)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `d = 0` THEN + ASM_REWRITE_TAC[DIRICHLET_CHARACTER_0; TAUT `~(p /\ ~p)`] THEN + ASM_CASES_TAC `d = 1` THEN + ASM_REWRITE_TAC[DIRICHLET_CHARACTER_1; chi_0; FUN_EQ_THM; COPRIME_1] THEN + CONV_TAC TAUT);; + +let DIRICHLET_CHARACTER_ZEROSUM = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> vsum(1..d) c = Cx(&0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o + MATCH_MP DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIRICHLET_CHARACTER_NONPRINCIPAL) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(COMPLEX_RING + `!x. x * c = c /\ ~(x = Cx(&1)) ==> c = Cx(&0)`) THEN + EXISTS_TAC `(c:num->complex) m` THEN + ASM_SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + MATCH_MP_TAC(MESON[] + `!t. vsum t f = vsum s f /\ vsum t g = vsum s g /\ vsum t f = vsum t g + ==> vsum s f = vsum s g`) THEN + EXISTS_TAC `{n | coprime(n,d) /\ n < d}` THEN + REPEAT(CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + SIMP_TAC[SUBSET; IN_NUMSEG; LT_IMP_LE; IN_ELIM_THM] THEN CONJ_TAC THEN + X_GEN_TAC `r:num` THENL + [ASM_CASES_TAC `r = 0` THENL [ALL_TAC; ASM_ARITH_TAC] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[COPRIME_0]; + ASM_CASES_TAC `coprime(r,d)` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `r:num = d` THEN ASM_REWRITE_TAC[LT_REFL] THENL + [ASM_MESON_TAC[COPRIME_REFL]; ASM_ARITH_TAC]; + REWRITE_TAC[COMPLEX_VEC_0] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; COMPLEX_MUL_RZERO]]]; + ALL_TAC]) THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[GSYM(MATCH_MP DIRICHLET_CHARACTER_MUL (CONJUNCT1 th))]) THEN + SIMP_TAC[VSUM; PHI_FINITE_LEMMA] THEN + MATCH_MP_TAC ITERATE_OVER_COPRIME THEN SIMP_TAC[MONOIDAL_VECTOR_ADD] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_CONG]);; + +let DIRICHLET_CHARACTER_ZEROSUM_MUL = prove + (`!d c n. dirichlet_character d c /\ ~(c = chi_0 d) + ==> vsum(1..d*n) c = Cx(&0)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; VSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH; COMPLEX_VEC_0] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + ASM_SIMP_TAC[VSUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; COMPLEX_ADD_LID] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[VSUM_OFFSET] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIRICHLET_CHARACTER_ZEROSUM) THEN + MATCH_MP_TAC VSUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN + ASM_REWRITE_TAC[] THEN NUMBER_TAC);; + +let DIRICHLET_CHARACTER_SUM_MOD = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> vsum(1..n) c = vsum(1..(n MOD d)) c`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP + DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL) THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + SIMP_TAC[VSUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_ZEROSUM_MUL; COMPLEX_ADD_LID] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[VSUM_OFFSET] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIRICHLET_CHARACTER_ZEROSUM) THEN + MATCH_MP_TAC VSUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUMBER_RULE);; + +(* ------------------------------------------------------------------------- *) +(* Finiteness of the set of characters (later we could get size = phi(d)). *) +(* ------------------------------------------------------------------------- *) + +let FINITE_DIRICHLET_CHARACTERS = prove + (`!d. FINITE {c | dirichlet_character d c}`, + GEN_TAC THEN ASM_CASES_TAC `d = 0` THENL + [ASM_SIMP_TAC[DIRICHLET_CHARACTER_0; SET_RULE `{x | x = a} = {a}`] THEN + SIMP_TAC[FINITE_RULES]; + ALL_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\c n. c(n MOD d)) + {c | (!m. m IN {m | m < d} + ==> c(m) IN (Cx(&0) INSERT + {z | z pow (phi d) = Cx(&1)})) /\ + (!m. ~(m IN {m | m < d}) + ==> c(m) = Cx(&0))}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_FUNSPACE THEN + ASM_SIMP_TAC[FINITE_NUMSEG_LT; FINITE_INSERT] THEN + MATCH_MP_TAC FINITE_COMPLEX_ROOTS_UNITY THEN + ASM_SIMP_TAC[PHI_LOWERBOUND_1_STRONG; LE_1]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `c:num->complex` THEN + DISCH_TAC THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_INSERT] THEN + EXISTS_TAC `\n:num. if n < d then c(n) else Cx(&0)` THEN + ASM_SIMP_TAC[DIVISION; FUN_EQ_THM] THEN CONJ_TAC THEN X_GEN_TAC `m:num` THENL + [MATCH_MP_TAC DIRICHLET_CHARACTER_CONG THEN EXISTS_TAC `d:num` THEN + ASM_MESON_TAC[CONG_MOD; CONG_SYM]; + ASM_MESON_TAC[DIRICHLET_CHARACTER_ROOT; COPRIME_SYM; + DIRICHLET_CHARACTER_EQ_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Very basic group structure. *) +(* ------------------------------------------------------------------------- *) + +let DIRICHLET_CHARACTER_MUL_CNJ = prove + (`!d c n. dirichlet_character d c /\ ~(c n = Cx(&0)) + ==> cnj(c n) * c n = Cx(&1) /\ c n * cnj(c n) = Cx(&1)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(COMPLEX_FIELD + `inv z = w /\ ~(z = Cx(&0)) ==> w * z = Cx(&1) /\ z * w = Cx(&1)`) THEN + ASM_REWRITE_TAC[COMPLEX_INV_CNJ] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM COMPLEX_NORM_NZ]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LT_REFL; COMPLEX_POW_ONE] THEN + REWRITE_TAC[COMPLEX_DIV_1]);; + +let DIRICHLET_CHARACTER_CNJ = prove + (`!d c. dirichlet_character d c ==> dirichlet_character d (\n. cnj(c n))`, + SIMP_TAC[dirichlet_character; CNJ_MUL; CNJ_EQ_CX]);; + +let DIRICHLET_CHARACTER_GROUPMUL = prove + (`!d c1 c2. dirichlet_character d c1 /\ dirichlet_character d c2 + ==> dirichlet_character d (\n. c1(n) * c2(n))`, + SIMP_TAC[dirichlet_character; COMPLEX_ENTIRE] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +let DIRICHLET_CHARACTER_GROUPINV = prove + (`!d c. dirichlet_character d c ==> (\n. cnj(c n) * c n) = chi_0 d`, + REPEAT STRIP_TAC THEN REWRITE_TAC[chi_0; FUN_EQ_THM] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [ASM_MESON_TAC[DIRICHLET_CHARACTER_MUL_CNJ; DIRICHLET_CHARACTER_EQ_0]; + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; COMPLEX_MUL_RZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* Orthogonality relations, a weak version of one first. *) +(* ------------------------------------------------------------------------- *) + +let DIRICHLET_CHARACTER_SUM_OVER_NUMBERS = prove + (`!d c. dirichlet_character d c + ==> vsum (1..d) c = if c = chi_0 d then Cx(&(phi d)) else Cx(&0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_ZEROSUM] THEN + FIRST_X_ASSUM SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[chi_0] THEN + SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_NUMSEG; GSYM COMPLEX_VEC_0] THEN + SIMP_TAC[phi; VSUM_CONST; FINITE_RESTRICT; FINITE_NUMSEG] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + X_GEN_TAC `x:num` THEN ASM_CASES_TAC `coprime(x,d)` THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_WEAK = prove + (`!d n. vsum {c | dirichlet_character d c} (\x. x n) = Cx(&0) \/ + coprime(n,d) /\ !c. dirichlet_character d c ==> c(n) = Cx(&1)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `coprime(n,d)` THENL + [ALL_TAC; + DISJ1_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC VSUM_EQ_0 THEN + ASM_SIMP_TAC[IN_ELIM_THM; COMPLEX_VEC_0; DIRICHLET_CHARACTER_EQ_0]] THEN + SUBGOAL_THEN + `!c'. dirichlet_character d c' + ==> vsum {c | dirichlet_character d c} + ((\c. c(n)) o (\c n. c'(n) * c(n))) = + vsum {c | dirichlet_character d c} (\c. c(n))` + MP_TAC THENL + [ALL_TAC; + SIMP_TAC[o_DEF; FINITE_DIRICHLET_CHARACTERS; VSUM_COMPLEX_LMUL] THEN + REWRITE_TAC[COMPLEX_RING `a * x = x <=> a = Cx(&1) \/ x = Cx(&0)`] THEN + ASM_MESON_TAC[]] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_INJECTION THEN + REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM] THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_GROUPMUL] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(\c n. cnj(c'(n:num)) * c n)`) THEN + REWRITE_TAC[FUN_EQ_THM] THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN + ASM_CASES_TAC `coprime(m,d)` THENL + [ALL_TAC; ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + MATCH_MP_TAC(COMPLEX_RING + `a * b = Cx(&1) ==> a * b * x = a * b * y ==> x = y`) THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_0; DIRICHLET_CHARACTER_MUL_CNJ]);; + +let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_POS = prove + (`!d n. real(vsum {c | dirichlet_character d c} (\c. c n)) /\ + &0 <= Re(vsum {c | dirichlet_character d c} (\c. c n))`, + MP_TAC DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_WEAK THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_CX; RE_CX; REAL_LE_REFL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_VSUM; + SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; RE_VSUM] THEN + MATCH_MP_TAC SUM_POS_LE] THEN + ASM_SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM; REAL_CX; RE_CX] THEN + REWRITE_TAC[REAL_POS]);; + +(* ------------------------------------------------------------------------- *) +(* A somewhat gruesome lemma about extending a character from a subgroup. *) +(* ------------------------------------------------------------------------- *) + +let CHARACTER_EXTEND_FROM_SUBGROUP = prove + (`!f h a d. + h SUBSET {x | x < d /\ coprime(x,d)} /\ + (1 IN h) /\ + (!x y. x IN h /\ y IN h ==> ((x * y) MOD d) IN h) /\ + (!x. x IN h ==> ?y. y IN h /\ (x * y == 1) (mod d)) /\ + (!x. x IN h ==> ~(f x = Cx(&0))) /\ + (!x y. x IN h /\ y IN h + ==> f((x * y) MOD d) = f(x) * f(y)) /\ + a IN {x | x < d /\ coprime(x,d)} DIFF h + ==> ?f' h'. (a INSERT h) SUBSET h' /\ + h' SUBSET {x | x < d /\ coprime(x,d)} /\ + (!x. x IN h ==> f'(x) = f(x)) /\ + ~(f' a = Cx(&1)) /\ + 1 IN h' /\ + (!x y. x IN h' /\ y IN h' ==> ((x * y) MOD d) IN h') /\ + (!x. x IN h' ==> ?y. y IN h' /\ (x * y == 1) (mod d)) /\ + (!x. x IN h' ==> ~(f' x = Cx(&0))) /\ + (!x y. x IN h' /\ y IN h' + ==> f'((x * y) MOD d) = f'(x) * f'(y))`, + REWRITE_TAC[IN_ELIM_THM; IN_DIFF; SUBSET] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1 < d` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN + SUBGOAL_THEN `?m x. 0 < m /\ x IN h /\ (a EXP m == x) (mod d)` MP_TAC THENL + [MAP_EVERY EXISTS_TAC [`phi d`; `1`] THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_1]; ALL_TAC] THEN + MATCH_MP_TAC FERMAT_LITTLE THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x s. x IN h ==> ((x EXP s) MOD d) IN h` ASSUME_TAC THENL + [REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN ASM_SIMP_TAC[EXP; MOD_LT] THEN + SUBGOAL_THEN `((x * (x EXP s) MOD d) MOD d) IN h` MP_TAC THEN + ASM_MESON_TAC[MOD_MULT_RMOD; ASSUME `1 <= d`; LE_1]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `am:num` STRIP_ASSUME_TAC) MP_TAC) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `0 < m ==> m = 1 \/ 2 <= m`)) + THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN UNDISCH_TAC `(a EXP 1 == am) (mod d)` THEN + ASM_SIMP_TAC[EXP_1; GSYM CONG_MOD_LT; MOD_LT] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o GEN `r:num` o SPEC `r MOD m`) THEN + ASM_SIMP_TAC[DIVISION; LE_1; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> b /\ c ==> ~a`] THEN DISCH_TAC THEN + SUBGOAL_THEN `!r x. x IN h /\ (a EXP r == x) (mod d) ==> m divides r` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DIVIDES_MOD; LE_1] THEN + REWRITE_TAC[ARITH_RULE `n = 0 <=> ~(0 < n)`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(a EXP (r MOD m)) MOD d` THEN + ASM_SIMP_TAC[CONG_RMOD; LE_1; CONG_REFL] THEN + UNDISCH_TAC `!x. x IN h ==> (?y. y IN h /\ (x * y == 1) (mod d))` THEN + DISCH_THEN(MP_TAC o SPEC `(a EXP (m * r DIV m)) MOD d`) THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM EXP_EXP] THEN + SUBGOAL_THEN + `(a EXP m) EXP (r DIV m) MOD d = (am EXP (r DIV m)) MOD d` + (fun th -> ASM_SIMP_TAC[th]) THEN + ASM_SIMP_TAC[GSYM CONG; LE_1] THEN + ASM_SIMP_TAC[CONG_LMOD; CONG_EXP; LE_1]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(a EXP r == x) (mod d)` THEN + MP_TAC(SPECL [`r:num`; `m:num`] DIVISION) THEN ASM_SIMP_TAC[LE_1] THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP_ADD] THEN + DISCH_THEN(MP_TAC o SPEC `y:num` o MATCH_MP + (NUMBER_RULE `!a. (x:num == y) (mod n) ==> (a * x == a * y) (mod n)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE + `(y * e * a == z) (mod n) + ==> (e * y == 1) (mod n) ==> (a == z) (mod n)`)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `a EXP (m * r DIV m) MOD d * y` THEN + ASM_SIMP_TAC[CONG_MULT; CONG_REFL; CONG_RMOD; LE_1]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONG; LE_1]; + ALL_TAC] THEN + MP_TAC(SPECL [`(f:num->complex) am`; `m:num`] + EXISTS_COMPLEX_ROOT_NONTRIVIAL) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?g. !x k. x IN h ==> g((x * a EXP k) MOD d) = f(x) * z pow k` + MP_TAC THENL + [REWRITE_TAC[MESON[] `(?g. !x a. p x ==> g(f a x) = h a x) <=> + (?g. !y x a. p x /\ f a x = y ==> g y = h a x)`] THEN + REWRITE_TAC[GSYM SKOLEM_THM] THEN + REWRITE_TAC[MESON[] + `(!y. ?z. !x k. p x /\ f x k = y ==> z = g x k) <=> + (!x k x' k'. p x /\ p x' /\ f x k = f x' k' ==> g x k = g x' k')`] THEN + ONCE_REWRITE_TAC[MESON[] + `(!x k y j. P x k y j) <=> (!k j x y. P x k y j)`] THEN + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `j:num`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN + ASM_SIMP_TAC[GSYM CONG; LE_1] THEN STRIP_TAC THEN + UNDISCH_TAC `k:num <= j` THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` SUBST_ALL_TAC) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `m divides i` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `!x. x IN h ==> (?y. y IN h /\ (x * y == 1) (mod d))` THEN + DISCH_THEN(MP_TAC o SPEC `y:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(z * x) MOD d` THEN ASM_SIMP_TAC[CONG_RMOD; LE_1] THEN + MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `y * a EXP k` THEN + REWRITE_TAC[COPRIME_LMUL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[COPRIME_EXP; COPRIME_SYM]; ALL_TAC] THEN + UNDISCH_TAC `(x * a EXP k == y * a EXP (k + i)) (mod d)` THEN + REWRITE_TAC[EXP_ADD] THEN UNDISCH_TAC `(y * z == 1) (mod d)` THEN + CONV_TAC NUMBER_RULE; + ALL_TAC] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `f((y * (am EXP r) MOD d) MOD d):complex` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[CONG_MOD_LT] THEN + MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `y * (a EXP m) EXP r` THEN CONJ_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN + ASM_SIMP_TAC[CONG_MULT; CONG_LMOD; CONG_REFL; LE_1] THEN + MATCH_MP_TAC CONG_EXP THEN ASM_MESON_TAC[CONG_SYM]; + ALL_TAC] THEN + MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a EXP k` THEN + CONJ_TAC THENL [ASM_MESON_TAC[COPRIME_EXP; COPRIME_SYM]; ALL_TAC] THEN + UNDISCH_TAC `(x * a EXP k == y * a EXP (k + m * r)) (mod d)` THEN + REWRITE_TAC[EXP_ADD; EXP_EXP] THEN CONV_TAC NUMBER_RULE; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN + SPEC_TAC(`r:num`,`s:num`) THEN INDUCT_TAC THEN + ASM_SIMP_TAC[EXP; MOD_LT; complex_pow; COMPLEX_MUL_RID] THENL + [UNDISCH_TAC + `!x y. x IN h /\ y IN h ==> f ((x * y) MOD d):complex = f x * f y` THEN + DISCH_THEN(MP_TAC o SPECL [`1`; `1`]) THEN + ASM_SIMP_TAC[MULT_CLAUSES; MOD_LT] THEN + UNDISCH_TAC `!x:num. x IN h ==> ~(f x = Cx (&0))` THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `f((am * (am EXP s) MOD d) MOD d):complex` THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[]] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[MOD_MULT_RMOD; ASSUME `1 <= d`; LE_1]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:num->complex` THEN + DISCH_THEN (LABEL_TAC "*") THEN + EXISTS_TAC `{(x * a EXP k) MOD d | x IN h /\ k IN (:num)}` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; IN_UNIV] THEN + X_GEN_TAC `x:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXISTS_TAC [`1`; `1`]; + MAP_EVERY EXISTS_TAC [`x:num`; `0`]] THEN + ASM_SIMP_TAC[EXP_1; MULT_CLAUSES; EXP; MOD_LT]; + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:num`; `x:num`; `k:num`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_SIMP_TAC[DIVISION; LE_1; COPRIME_MOD; COPRIME_LMUL] THEN + ASM_MESON_TAC[COPRIME_EXP; COPRIME_SYM]; + X_GEN_TAC `x:num` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPECL [`x:num`; `0`]) THEN + ASM_SIMP_TAC[MOD_LT; EXP; MULT_CLAUSES; complex_pow; COMPLEX_MUL_RID]; + REMOVE_THEN "*" (MP_TAC o SPECL [`1`; `1`]) THEN + ASM_SIMP_TAC[EXP_1; MULT_CLAUSES; MOD_LT; COMPLEX_POW_1] THEN + UNDISCH_TAC `!x y. x IN h /\ y IN h ==> f ((x * y) MOD d) = f x * f y` THEN + DISCH_THEN(MP_TAC o SPECL [`1`; `1`]) THEN + ASM_SIMP_TAC[MULT_CLAUSES; MOD_LT] THEN + UNDISCH_TAC `~(z = Cx(&1))` THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + MAP_EVERY EXISTS_TAC [`1`; `0`] THEN + ASM_SIMP_TAC[EXP; MULT_CLAUSES; MOD_LT]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`r:num`; `s:num`; `x:num`; `k:num`; `y:num`; `j:num`] THEN + STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + MAP_EVERY EXISTS_TAC [`(x * y) MOD d`; `j + k:num`] THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD; LE_1] THEN + REWRITE_TAC[EXP_ADD; MULT_AC]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:num`; `x:num`; `k:num`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + UNDISCH_TAC `!x. x IN h ==> (?y. y IN h /\ (x * y == 1) (mod d))` THEN + DISCH_THEN(MP_TAC o SPEC `x:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(z * a EXP ((phi d - 1) * k)) MOD d` THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `(x * a EXP k) * (z * a EXP ((phi d - 1) * k))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN ASM_SIMP_TAC[CONG_MOD; LE_1]; ALL_TAC] THEN + ONCE_REWRITE_TAC[ARITH_RULE + `(x * a) * (z * ak):num = (x * z) * (a * ak)`] THEN + GEN_REWRITE_TAC (LAND_CONV) [ARITH_RULE `1 = 1 * 1`] THEN + MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM EXP_ADD] THEN + SUBGOAL_THEN `k + (phi d - 1) * k = phi(d) * k` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `k + a * k = (a + 1) * k`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[SUB_ADD; PHI_LOWERBOUND_1_STRONG]; + ALL_TAC] THEN + REWRITE_TAC[GSYM EXP_EXP] THEN SUBST1_TAC(SYM(SPEC `k:num` EXP_ONE)) THEN + MATCH_MP_TAC CONG_EXP THEN ASM_SIMP_TAC[FERMAT_LITTLE]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0] THEN + UNDISCH_TAC `!x:num. x IN h ==> ~(f x = Cx (&0))` THEN + DISCH_THEN(MP_TAC o SPEC `am:num`) THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(ASSUME `z pow m = f(am:num)`)) THEN + REWRITE_TAC[COMPLEX_POW_EQ_0] THEN ASM_SIMP_TAC[LE_1]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`r:num`; `s:num`; `x:num`; `k:num`; `y:num`; `j:num`] THEN + STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `g(((x * y) MOD d * a EXP (k + j)) MOD d):complex` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD; LE_1] THEN + REWRITE_TAC[EXP_ADD; MULT_AC]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_MUL_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the key result that we can find a distinguishing character. *) +(* ------------------------------------------------------------------------- *) + +let DIRICHLET_CHARACTER_DISCRIMINATOR = prove + (`!d n. 1 < d /\ ~((n == 1) (mod d)) + ==> ?c. dirichlet_character d c /\ ~(c n = Cx(&1))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN + ASM_CASES_TAC `coprime(n,d)` THENL + [ALL_TAC; + EXISTS_TAC `chi_0 d` THEN + ASM_REWRITE_TAC[DIRICHLET_CHARACTER_CHI_0; chi_0] THEN + CONV_TAC COMPLEX_RING] THEN + MP_TAC(ISPECL [`\n:num. Cx(&1)`; `{1}`; `n MOD d`; `d:num`] + CHARACTER_EXTEND_FROM_SUBGROUP) THEN + ASM_SIMP_TAC[IN_SING; IN_ELIM_THM; IN_DIFF] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[SUBSET; MULT_CLAUSES; MOD_LT; LE_1; IN_SING; + IN_ELIM_THM; DIVISION; COPRIME_MOD; CONG_MOD_LT; + COMPLEX_MUL_LID; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN + ASM_MESON_TAC[COPRIME_1; COPRIME_SYM; CONG_REFL]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f0:num->complex`; `h0:num->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!m. m <= CARD {x | x < d /\ coprime(x,d)} + ==> ?f h. h SUBSET {x | x < d /\ coprime(x,d)} /\ + (1 IN h) /\ (n MOD d) IN h /\ + (!x y. x IN h /\ y IN h ==> ((x * y) MOD d) IN h) /\ + (!x. x IN h ==> ?y. y IN h /\ (x * y == 1) (mod d)) /\ + ~(f(n MOD d) = Cx(&1)) /\ + (!x. x IN h ==> ~(f x = Cx(&0))) /\ + (!x y. x IN h /\ y IN h + ==> f((x * y) MOD d) = f(x) * f(y)) /\ + m <= CARD h` + MP_TAC THENL + [MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(LABEL_TAC "*") THEN DISCH_TAC THEN + ASM_CASES_TAC `m = 0` THENL + [MAP_EVERY EXISTS_TAC [`f0:num->complex`; `h0:num->bool`] THEN + ASM_REWRITE_TAC[LE_0] THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP + (MATCH_MP (ARITH_RULE `~(m = 0) ==> m - 1 < m`) (ASSUME `~(m = 0)`))) THEN + ASM_SIMP_TAC[ARITH_RULE `x <= n ==> x - 1 <= n`; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:num->complex`; `h:num->bool`] THEN STRIP_TAC THEN + ASM_CASES_TAC `m <= CARD(h:num->bool)` THENL + [MAP_EVERY EXISTS_TAC [`f:num->complex`; `h:num->bool`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME `h SUBSET {x | x < d /\ coprime (x,d)}`) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(s = t) ==> ?a. a IN t /\ ~(a IN s)`)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM]] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:num->complex`; `h:num->bool`; `a:num`; `d:num`] + CHARACTER_EXTEND_FROM_SUBGROUP) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ff:num->complex` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `hh:num->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD((a:num) INSERT h)` THEN + SUBGOAL_THEN `FINITE(h:num->bool)` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x | x IN {x | x < d} /\ coprime(x,d)}` THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LT] THEN + ASM_REWRITE_TAC[IN_ELIM_THM]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[CARD_CLAUSES] THEN + UNDISCH_TAC `m - 1 <= CARD(h:num->bool)` THEN ARITH_TAC; + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x | x IN {x | x < d} /\ coprime(x,d)}` THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LT] THEN + ASM_REWRITE_TAC[IN_ELIM_THM]]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `CARD {x | x < d /\ coprime(x,d)}`) THEN + REWRITE_TAC[LE_REFL] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:num->complex`; `h:num->bool`] THEN + ASM_CASES_TAC `h = {x | x < d /\ coprime (x,d)}` THENL + [ALL_TAC; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN + REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC CARD_PSUBSET THEN + ASM_REWRITE_TAC[PSUBSET] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{x:num | x < d}` THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG_LT] THEN SET_TAC[]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + STRIP_TAC THEN + EXISTS_TAC `\n. if coprime(n,d) then f(n MOD d) else Cx(&0)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[dirichlet_character] THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `x:num` THENL + [REWRITE_TAC[NUMBER_RULE `coprime(x + d:num,d) <=> coprime(x,d)`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[GSYM CONG; LE_1] THEN CONV_TAC NUMBER_RULE; + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[COPRIME_MOD; DIVISION; LE_1]; + X_GEN_TAC `y:num` THEN REWRITE_TAC[COPRIME_LMUL] THEN + MAP_EVERY ASM_CASES_TAC [`coprime(x,d)`; `coprime(y,d)`] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `f(((x MOD d) * (y MOD d)) MOD d):complex` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN ASM_SIMP_TAC[MOD_MULT_MOD2; LE_1]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[DIVISION; COPRIME_MOD; LE_1]]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get the full second orthogonality relation. *) +(* ------------------------------------------------------------------------- *) + +let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_INEXPLICIT = prove + (`!d n. vsum {c | dirichlet_character d c} (\c. c n) = + if (n == 1) (mod d) + then Cx(&(CARD {c | dirichlet_character d c})) + else Cx(&0)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `d = 0` THENL + [ASM_REWRITE_TAC[CONG_MOD_0; DIRICHLET_CHARACTER_0; SET_RULE + `{x | x = a} = {a}`] THEN + SIMP_TAC[VSUM_CLAUSES; CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN + REWRITE_TAC[chi_0; COPRIME_0; VECTOR_ADD_RID] THEN REWRITE_TAC[ARITH]; + ALL_TAC] THEN + ASM_CASES_TAC `d = 1` THENL + [ASM_REWRITE_TAC[CONG_MOD_1; DIRICHLET_CHARACTER_1] THEN + REWRITE_TAC[GSYM FUN_EQ_THM; ETA_AX] THEN + ASM_REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN + SIMP_TAC[VSUM_CLAUSES; CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN + REWRITE_TAC[VECTOR_ADD_RID; ARITH]; + ALL_TAC] THEN + COND_CASES_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum {c | dirichlet_character d c} (\c. Cx(&1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; DIRICHLET_CHARACTER_CONG]; + SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; VSUM_CONST] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID]]; + MP_TAC(SPECL [`d:num`; `n:num`] + DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_WEAK) THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_DISCRIMINATOR; + ARITH_RULE `~(d = 0) /\ ~(d = 1) ==> 1 < d`]]);; + +let DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS = prove + (`!d n. 1 <= d + ==> vsum {c | dirichlet_character d c} (\c. c(n)) = + if (n == 1) (mod d) then Cx(&(phi d)) else Cx(&0)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_INEXPLICIT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\c n. (c:num->complex) n`; `{c | dirichlet_character d c}`; + `1..d`;] VSUM_SWAP) THEN + SIMP_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_INEXPLICIT; + DIRICHLET_CHARACTER_SUM_OVER_NUMBERS; FINITE_NUMSEG; + FINITE_DIRICHLET_CHARACTERS; ETA_AX] THEN + REWRITE_TAC[VSUM_DELTA; GSYM COMPLEX_VEC_0] THEN + REWRITE_TAC[IN_ELIM_THM; DIRICHLET_CHARACTER_CHI_0] THEN + DISCH_THEN SUBST1_TAC THEN + SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_NUMSEG] THEN + SUBGOAL_THEN `{j | j IN 1..d /\ (j == 1) (mod d)} = {1}` + (fun th -> SIMP_TAC[th; VSUM_SING]) THEN + REWRITE_TAC[EXTENSION; IN_SING; IN_ELIM_THM; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN EQ_TAC THEN ASM_SIMP_TAC[LE_REFL; CONG_REFL] THEN + ASM_CASES_TAC `d = 1` THEN ASM_SIMP_TAC[CONG_MOD_1; LE_ANTISYM] THEN + ASM_CASES_TAC `k:num = d` THENL + [ASM_REWRITE_TAC[NUMBER_RULE `(d == 1) (mod d) <=> d divides 1`] THEN + ASM_REWRITE_TAC[DIVIDES_ONE]; + STRIP_TAC THEN MATCH_MP_TAC CONG_IMP_EQ THEN EXISTS_TAC `d:num` THEN + ASM_REWRITE_TAC[LT_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* L-series, just at the point s = 1. *) +(* ------------------------------------------------------------------------- *) + +let Lfunction_DEF = new_definition + `Lfunction c = infsum (from 1) (\n. c(n) / Cx(&n))`;; + +let BOUNDED_LFUNCTION_PARTIAL_SUMS = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> bounded {vsum (1..n) c | n IN (:num)}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> + ONCE_REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_SUM_MOD th]) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `IMAGE (\n. vsum(1..n) c:complex) (0..d)` THEN + SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[SIMPLE_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV; IN_IMAGE] THEN + EXISTS_TAC `n MOD d` THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LT_IMP_LE; DIVISION; + DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL]);; + +let LFUNCTION = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> ((\n. c(n) / Cx(&n)) sums (Lfunction c)) (from 1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[Lfunction_DEF; SUMS_INFSUM] THEN + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX THEN + REPEAT(EXISTS_TAC `1`) THEN FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP BOUNDED_LFUNCTION_PARTIAL_SUMS th]) THEN + REWRITE_TAC[LIM_INV_N; GSYM CX_INV; REAL_CX; RE_CX] THEN + SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; LE_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* Other properties of conjugate characters. *) +(* ------------------------------------------------------------------------- *) + +let CNJ_CHI_0 = prove + (`!d n. cnj(chi_0 d n) = chi_0 d n`, + REPEAT GEN_TAC THEN REWRITE_TAC[chi_0] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CNJ_CX]);; + +let LFUNCTION_CNJ = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> Lfunction (\n. cnj(c n)) = cnj(Lfunction c)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[Lfunction_DEF] THEN + MATCH_MP_TAC INFSUM_UNIQUE THEN + ONCE_REWRITE_TAC[GSYM CNJ_CX] THEN + REWRITE_TAC[GSYM CNJ_DIV] THEN + REWRITE_TAC[SUMS_CNJ; CNJ_CX; GSYM Lfunction_DEF] THEN + ASM_MESON_TAC[LFUNCTION]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit bound on truncating the Lseries. *) +(* ------------------------------------------------------------------------- *) + +let LFUNCTION_PARTIAL_SUM = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> ?B. &0 < B /\ + !n. 1 <= n + ==> norm(Lfunction c - vsum(1..n) (\n. c(n) / Cx(&n))) + <= B / (&n + &1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`c:num->complex`; `\n. inv(Cx(&n))`; `1`; `1`] + SERIES_DIRICHLET_COMPLEX_EXPLICIT) THEN + REWRITE_TAC[LE_REFL] THEN FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP BOUNDED_LFUNCTION_PARTIAL_SUMS th]) THEN + REWRITE_TAC[LIM_INV_N; GSYM CX_INV; REAL_CX; RE_CX] THEN + SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; LE_ADD] THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_INV; REAL_ABS_NUM] THEN + REWRITE_TAC[CX_INV; GSYM complex_div; GSYM real_div] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. vsum(k+1..n) (\n. c(n) / Cx(&n))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP LFUNCTION) THEN + MP_TAC(ISPECL [`sequentially`; `vsum (1..k) (\n. c n / Cx (&n))`] + LIM_CONST) THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT; sums; FROM_INTER_NUMSEG] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k + 1` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `k + 1 <= m ==> k <= m`)) THEN + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + ASM_SIMP_TAC[VSUM_ADD_SPLIT; ARITH_RULE `1 <= k ==> 1 <= k + 1`] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= k + 1`; REAL_OF_NUM_ADD]]);; + +let LFUNCTION_PARTIAL_SUM_STRONG = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> ?B. &0 < B /\ + !n. norm(Lfunction c - vsum(1..n) (\n. c(n) / Cx(&n))) + <= B / (&n + &1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LFUNCTION_PARTIAL_SUM) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `max B (norm(Lfunction c))` THEN + ASM_SIMP_TAC[REAL_LT_MAX] THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; VECTOR_SUB_RZERO; ARITH] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_SIMP_TAC[LE_1] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* First key bound, when the Lfunction is not zero (as indeed it isn't). *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT_LEMMA = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> bounded + { Lfunction(c) * + vsum(1..x) (\n. c(n) * Cx(mangoldt n / &n)) - + vsum(1..x) (\n. c(n) * Cx(log(&n) / &n)) | x IN (:num)}`, + REWRITE_TAC[BOUNDED_POS; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + REPEAT STRIP_TAC THEN + SIMP_TAC[LOG_MANGOLDT_SUM; real_div; CX_MUL; GSYM VSUM_CX; FINITE_DIVISORS; + LE_1; GSYM VSUM_COMPLEX_LMUL; GSYM VSUM_COMPLEX_RMUL] THEN + REWRITE_TAC[VSUM_VSUM_DIVISORS] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; COMPLEX_INV_MUL; CX_MUL; CX_INV] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `(ck * cn) * cm * k * n:complex = (ck * k) * (cn * cm * n)`] THEN + SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_NUMSEG] THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION_PARTIAL_SUM_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&18 * B` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + X_GEN_TAC `x:num` THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN + REWRITE_TAC[FINITE_NUMSEG; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + REWRITE_TAC[real_abs; MANGOLDT_POS_LE] THEN ASM_CASES_TAC `x = 0` THEN + ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH; REAL_LE_MUL; REAL_LT_IMP_LE; + REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..x) (\n. B / &x * mangoldt n)` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B / &x * &18 * &x` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] PSI_BOUND]; + ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> B / x * &18 * x = &18 * B`; + REAL_OF_NUM_EQ; REAL_LE_REFL]]] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_MUL; + REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; MANGOLDT_POS_LE] THEN + REWRITE_TAC[real_div; REAL_ARITH `a * b * c <= d <=> (a * c) * b <= d`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[MANGOLDT_POS_LE] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B / (&(x DIV n) + &1)` THEN + ASM_REWRITE_TAC[GSYM complex_div] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INV_INV] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + SUBGOAL_THEN `1 <= x` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MP_TAC(SPECL [`x:num`; `n:num`] DIVISION) THEN ASM_ARITH_TAC);; + +let SUMMABLE_CHARACTER_LOG_OVER_N = prove + (`!c d. dirichlet_character d c /\ ~(c = chi_0 d) + ==> summable (from 1) (\n. c(n) * Cx(log(&n) / &n))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX THEN + MAP_EVERY EXISTS_TAC [`4`; `1`] THEN REWRITE_TAC[REAL_CX] THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP BOUNDED_LFUNCTION_PARTIAL_SUMS th]) THEN + CONJ_TAC THENL + [SIMP_TAC[DECREASING_LOG_OVER_N; GSYM REAL_OF_NUM_ADD; RE_CX]; + MP_TAC LIM_LOG_OVER_N THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + ASM_SIMP_TAC[CX_LOG; CX_DIV; LE_1; REAL_OF_NUM_LT]]);; + +let BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> bounded + { Lfunction(c) * + vsum(1..x) (\n. c(n) * Cx(mangoldt n / &n)) | x IN (:num)}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT_LEMMA) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_CHARACTER_LOG_OVER_N) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_SUMS_BOUNDED) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + REWRITE_TAC[SIMPLE_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE; + GSYM CONJ_ASSOC] THEN + X_GEN_TAC `n:num` THEN REPEAT(EXISTS_TAC `n:num`) THEN VECTOR_ARITH_TAC);; + +let BOUNDED_DIRICHLET_MANGOLDT_NONZERO = prove + (`!d c. + dirichlet_character d c /\ ~(c = chi_0 d) /\ ~(Lfunction c = Cx(&0)) + ==> bounded { vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) | x IN (:num)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_LFUNCTION_DIRICHLET_MANGOLDT) THEN + REWRITE_TAC[BOUNDED_POS; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; COMPLEX_NORM_NZ] THEN + ASM_MESON_TAC[COMPLEX_NORM_NZ; REAL_LT_DIV]);; + +(* ------------------------------------------------------------------------- *) +(* Now a bound when the Lfunction is zero (hypothetically). *) +(* ------------------------------------------------------------------------- *) + +let MANGOLDT_LOG_SUM = prove + (`!n. 1 <= n + ==> mangoldt(n) = --(sum {d | d divides n} (\d. mobius(d) * log(&d)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n. mangoldt n`; `\n. log(&n)`] MOBIUS_INVERSION) THEN + ASM_SIMP_TAC[LOG_MANGOLDT_SUM; LE_1] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {d | d divides n} (\x. mobius x * (log(&n) - log(&x)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `d:num` THEN + REWRITE_TAC[IN_ELIM_THM; DIVIDES_DIV_MULT] THEN + ABBREV_TAC `q = n DIV d` THEN + MAP_EVERY ASM_CASES_TAC [`q = 0`; `d = 0`] THEN + ASM_SIMP_TAC[MULT_CLAUSES; LE_1] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_MUL; LOG_MUL; REAL_OF_NUM_LT; LE_1] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_SUB_LDISTRIB; SUM_SUB; FINITE_DIVISORS; LE_1] THEN + ASM_SIMP_TAC[SUM_RMUL; REWRITE_RULE[ETA_AX] DIVISORSUM_MOBIUS] THEN + MATCH_MP_TAC(REAL_ARITH `a = &0 ==> a - b = --b`) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LOG_1] THEN REAL_ARITH_TAC]);; + +let BOUNDED_DIRICHLET_MANGOLDT_LEMMA = prove + (`!d c x. + dirichlet_character d c /\ ~(c = chi_0 d) /\ 1 <= x + ==> Cx(log(&x)) + vsum (1..x) (\n. c(n) * Cx(mangoldt n / &n)) = + vsum (1..x) (\n. c(n) / Cx(&n) * + vsum {d | d divides n} + (\d. Cx(mobius(d) * log(&x / &d))))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MANGOLDT_LOG_SUM] THEN + MATCH_MP_TAC(COMPLEX_RING `c - b = a ==> (a:complex) + b = c`) THEN + SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN + SIMP_TAC[CX_NEG; CX_DIV; GSYM VSUM_CX; FINITE_NUMSEG; FINITE_DIVISORS; + LE_1] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `c / d * x - c * --y / d:complex = c / d * (x + y)`] THEN + SIMP_TAC[GSYM VSUM_ADD; FINITE_DIVISORS; LE_1] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `vsum (1..x) + (\n. c n / Cx(&n) * vsum {d | d divides n} + (\d. Cx(mobius d * log(&x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + REWRITE_TAC[CX_MUL; GSYM COMPLEX_ADD_LDISTRIB] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM CX_ADD; CX_INJ] THEN + ASM_CASES_TAC `m = 0` THENL + [ASM_MESON_TAC[DIVIDES_ZERO; LE_1]; ALL_TAC] THEN + ASM_SIMP_TAC[LOG_DIV; REAL_OF_NUM_LT; LE_1] THEN REAL_ARITH_TAC; + SIMP_TAC[FINITE_DIVISORS; CX_MUL; SUM_RMUL; LE_1; VSUM_CX] THEN + SIMP_TAC[REWRITE_RULE[ETA_AX] DIVISORSUM_MOBIUS] THEN + SIMP_TAC[COND_RAND; COND_RATOR; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + ASM_SIMP_TAC[VSUM_DELTA; GSYM COMPLEX_VEC_0; IN_NUMSEG; LE_REFL] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] DIRICHLET_CHARACTER_EQ_1) THEN + ASM_SIMP_TAC[COMPLEX_MUL_LID; COMPLEX_DIV_1]]);; + +let SUM_LOG_OVER_X_BOUND = prove + (`!x. abs(sum(1..x) (\n. log(&x / &n) / &x)) <= &4`, + X_GEN_TAC `x:num` THEN ASM_CASES_TAC `x = 0` THENL + [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; REAL_ABS_NUM; REAL_POS]; + ALL_TAC] THEN + SIMP_TAC[real_div; SUM_RMUL; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (1..x) (\n. abs(log(&x / &n)))` THEN + REWRITE_TAC[SUM_ABS_NUMSEG] THEN + ASM_SIMP_TAC[real_abs; LOG_POS; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LID; REAL_OF_NUM_LE; LOG_DIV] THEN + REWRITE_TAC[SUM_SUB_NUMSEG; GSYM LOG_FACT] THEN + REWRITE_TAC[SUM_CONST_NUMSEG; ADD_SUB] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LOG_FACT_BOUNDS) THEN + MATCH_MP_TAC(REAL_ARITH + `&2 * l + abs(x) + &1 <= b + ==> abs(lf - (xl - x + &1)) <= &2 * l + ==> xl - lf <= b`) THEN + MATCH_MP_TAC(REAL_ARITH + `&1 <= x /\ l <= x ==> &2 * l + abs(x) + &1 <= &4 * x`) THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_1; LOG_LE_REFL]);; + +let BOUNDED_DIRICHLET_MANGOLDT_ZERO = prove + (`!d c. + dirichlet_character d c /\ ~(c = chi_0 d) /\ Lfunction c = Cx(&0) + ==> bounded { vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) + + Cx(log(&x)) | x IN (:num)}`, + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION_PARTIAL_SUM_STRONG) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SIMP_TAC[SET_RULE `{f x | x IN (:num)} = f 0 INSERT {f x | ~(x = 0)}`] THEN + REWRITE_TAC[BOUNDED_INSERT; ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] + BOUNDED_DIRICHLET_MANGOLDT_LEMMA) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_DIVISORS; LE_1] THEN + REWRITE_TAC[VSUM_VSUM_DIVISORS] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; CX_MUL; complex_div; COMPLEX_INV_MUL] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `((ck * cn) * k' * n') * m * l = (cn * m * n') * l * (ck * k')`] THEN + REWRITE_TAC[GSYM complex_div] THEN + SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + EXISTS_TAC `&4 * B` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + X_GEN_TAC `x:num` THEN DISCH_TAC THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum(1..x) (\n. inv(&n) * log(&x / &n) * B / (&(x DIV n) + &1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN + STRIP_TAC THEN REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN + FIRST_ASSUM(fun t -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM t]) THEN + COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_INV_EQ; REAL_POS] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[REAL_FIELD `&1 <= n ==> inv(n) * n = &1`; REAL_OF_NUM_LE; + REAL_ABS_MOBIUS]; + SIMP_TAC[CX_LOG; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN + SIMP_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + ASM_SIMP_TAC[LOG_POS; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; + REAL_MUL_LID; REAL_OF_NUM_LE]]; + ALL_TAC] THEN + SIMP_TAC[real_div; REAL_RING `a * l * B * i:real = ((l * i) * a) * B`] THEN + REWRITE_TAC[SUM_RMUL] THEN ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..x) (\n. log(&x / &n) / &x)` THEN + ASM_SIMP_TAC[REAL_ARITH `abs x <= a ==> x <= a`; SUM_LOG_OVER_X_BOUND] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[GSYM real_div; LOG_POS; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INV_INV] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MP_TAC(SPECL [`x:num`; `n:num`] DIVISION) THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Now the analogous result for the principal character. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL_LEMMA = prove + (`!d. 1 <= d + ==> norm(vsum(1..x) (\n. (chi_0 d n - Cx(&1)) * Cx(mangoldt n / &n))) + <= sum {p | prime p /\ p divides d} (\p. log(&p))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {p | prime p /\ p divides d} + (\p. sum {k | 1 <= k /\ p EXP k <= x} + (\k. log(&p) / &p pow k))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_SPECIAL_DIVISORS; LE_1] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `2 <= p /\ 1 <= p /\ 1 < p` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 < p /\ 1 <= p`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..x) (\k. log(&p) / &p pow k)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + ASM_SIMP_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM; SUBSET; REAL_POW_LE; + REAL_POS; REAL_LE_DIV; LOG_POS; REAL_OF_NUM_LE; + PRIME_GE_2; ARITH_RULE `2 <= p ==> 1 <= p`] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP k` THEN + ASM_SIMP_TAC[LT_POW2_REFL; LT_IMP_LE; EXP_MONO_LE]; + REWRITE_TAC[real_div; SUM_LMUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; LOG_POS_LT; REAL_OF_NUM_LT] THEN + SIMP_TAC[GSYM REAL_POW_INV; SUM_GP; REAL_INV_EQ_1; REAL_OF_NUM_EQ] THEN + COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT; REAL_LT_LDIV_EQ; + REAL_MUL_LID; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[real_pow] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x * y /\ &2 * x <= &1 + ==> x pow 1 - x * y <= &1 - x`) THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS; REAL_LE_MUL] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_OF_NUM_LT; + REAL_OF_NUM_LE; LE_1]]] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_SUM_PRODUCT o rand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_SPECIAL_DIVISORS; LE_1] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..x` THEN + SIMP_TAC[SUBSET; FINITE_NUMSEG; IN_NUMSEG; IN_ELIM_THM] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP k` THEN + ASM_SIMP_TAC[LT_POW2_REFL; LT_IMP_LE; EXP_MONO_LE; PRIME_GE_2]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN + REWRITE_TAC[FINITE_NUMSEG; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[chi_0; COND_RAND; COND_RATOR] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_SUB_LZERO] THEN + REWRITE_TAC[COMPLEX_NORM_CX; NORM_NEG; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[mangoldt; COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ABS_NUM] THEN + REWRITE_TAC[TAUT `(if a then &0 else if b then x else &0) = + (if ~a /\ b then x else &0)`] THEN + SIMP_TAC[GSYM real_div; GSYM SUM_RESTRICT_SET; FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_EQ_GENERAL THEN EXISTS_TAC `\(p,k). p EXP k` THEN + REWRITE_TAC[EXISTS_UNIQUE; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG; PAIR_EQ] THEN CONJ_TAC THENL + [X_GEN_TAC `y:num` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + UNDISCH_TAC `~(coprime(p EXP k,d))` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_PRIMEPOW; LE_1] THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`q:num`; `j:num`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[EQ_PRIME_EXP] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_PRIMEPOW; LE_1] THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[EXP_EQ_0; LE_1; PRIME_0]; ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW; REAL_ABS_DIV; REAL_ABS_POW; + REAL_ABS_NUM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = y ==> abs x = y`) THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; PRIME_IMP_NZ; LE_1] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `q:num` THEN REWRITE_TAC[] THEN EQ_TAC THENL + [ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_PRIME_PRIME]; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `k = SUC(k - 1)` SUBST1_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[EXP; DIVIDES_RMUL; DIVIDES_REFL]]]);; + +let BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL = prove + (`!d. 1 <= d + ==> bounded { vsum(1..x) (\n. chi_0 d n * Cx(mangoldt n / &n)) - + Cx(log(&x)) | x IN (:num)}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[bounded; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + EXISTS_TAC + `abs(sum {p | prime p /\ p divides d} (\p. log(&p))) + + abs(log(&0)) + &21` THEN + X_GEN_TAC `x:num` THEN ASM_CASES_TAC `x = 0` THENL + [ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; ARITH; VECTOR_SUB_LZERO] THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a + b ==> x <= a + abs y + b`) THEN + MATCH_MP_TAC(NORM_ARITH + `!s'. norm(s') <= p /\ norm(s - s' - l) <= &21 + ==> norm(s - l) <= abs p + &21`) THEN + EXISTS_TAC `vsum(1..x) (\n. (chi_0 d n - Cx(&1)) * Cx(mangoldt n / &n))` THEN + ASM_SIMP_TAC[BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL_LEMMA] THEN + SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN + REWRITE_TAC[COMPLEX_RING `c * x - (c - Cx(&1)) * x = x`] THEN + SIMP_TAC[GSYM CX_SUB; VSUM_CX; FINITE_NUMSEG; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC MERTENS_LEMMA THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The arithmetic-geometric mean that we want. *) +(* ------------------------------------------------------------------------- *) + +let SUM_OF_NUMBERS = prove + (`!n. nsum(0..n) (\i. i) = (n * (n + 1)) DIV 2`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let PRODUCT_POW_NSUM = prove + (`!s. FINITE s ==> product s (\i. z pow (f i)) = z pow (nsum s f)`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; NSUM_CLAUSES; real_pow; REAL_POW_ADD]);; + +let PRODUCT_SPECIAL = prove + (`!z i. product (0..n) (\i. z pow i) = z pow ((n * (n + 1)) DIV 2)`, + SIMP_TAC[PRODUCT_POW_NSUM; FINITE_NUMSEG; SUM_OF_NUMBERS]);; + +let AGM_SPECIAL = prove + (`!n t. &0 <= t + ==> (&n + &1) pow 2 * t pow n <= (sum(0..n) (\k. t pow k)) pow 2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`n + 1`; `\k. (t:real) pow (k - 1)`] AGM) THEN + ASM_SIMP_TAC[REAL_POW_LE; ARITH_RULE `1 <= n + 1`] THEN + SUBGOAL_THEN `1..n+1 = 0+1..n+1` SUBST1_TAC THENL + [REWRITE_TAC[ADD_CLAUSES]; ALL_TAC] THEN + REWRITE_TAC[SUM_OFFSET; PRODUCT_OFFSET; ADD_SUB] THEN + REWRITE_TAC[PRODUCT_SPECIAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] REAL_POW_LE2)) THEN + DISCH_THEN(MP_TAC o SPEC `2`) THEN + ASM_SIMP_TAC[PRODUCT_POS_LE_NUMSEG; REAL_POW_LE] THEN + REWRITE_TAC[REAL_POW_POW] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + SUBGOAL_THEN `2 * (n * (n + 1)) DIV 2 = n * (n + 1)` SUBST1_TAC THENL + [SUBGOAL_THEN `EVEN(n * (n + 1))` MP_TAC THENL + [REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN CONV_TAC TAUT; + SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH]]; + REWRITE_TAC[GSYM REAL_POW_POW] THEN DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] REAL_POW_LE2_REV)) THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_POW_2; REAL_LE_SQUARE] THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_OF_NUM_ADD] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_LE_RDIV_EQ; REAL_POW_LT; + REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[REAL_MUL_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* The trickiest part: the nonvanishing of L-series for real character. *) +(* Proof from Monsky's article (AMM 1993, pp. 861-2). *) +(* ------------------------------------------------------------------------- *) + +let DIVISORSUM_PRIMEPOW = prove + (`!f p k. prime p + ==> sum {m | m divides (p EXP k)} c = sum(0..k) (\i. c(p EXP i))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[DIVIDES_PRIMEPOW; SET_RULE + `{m | ?i. P i /\ m = f i} = IMAGE f {i | P i}`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[GSYM NUMSEG_LE] THEN MATCH_MP_TAC SUM_IMAGE THEN + ASM_SIMP_TAC[IN_ELIM_THM; EQ_EXP; FINITE_NUMSEG_LE] THEN + ASM_MESON_TAC[PRIME_0; PRIME_1]);; + +let DIVISORVSUM_PRIMEPOW = prove + (`!f p k. prime p + ==> vsum {m | m divides (p EXP k)} c = vsum(0..k) (\i. c(p EXP i))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[DIVIDES_PRIMEPOW; SET_RULE + `{m | ?i. P i /\ m = f i} = IMAGE f {i | P i}`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[GSYM NUMSEG_LE] THEN MATCH_MP_TAC VSUM_IMAGE THEN + ASM_SIMP_TAC[IN_ELIM_THM; EQ_EXP; FINITE_NUMSEG_LE] THEN + ASM_MESON_TAC[PRIME_0; PRIME_1]);; + +let DIRICHLET_CHARACTER_DIVISORSUM_EQ_1 = prove + (`!d c p k. dirichlet_character d c /\ prime p /\ p divides d + ==> vsum {m | m divides (p EXP k)} c = Cx(&1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `vsum {1} c : complex` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[VSUM_SING] THEN ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1]] THEN + MATCH_MP_TAC VSUM_SUPERSET THEN + SIMP_TAC[SUBSET; IN_SING; IN_ELIM_THM; DIVIDES_1] THEN + ASM_SIMP_TAC[DIVIDES_PRIMEPOW; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:num`; `i:num`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN + FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_EQ_0 th]) THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN REWRITE_TAC[COPRIME_REXP] THEN + ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[EXP] THEN + ASM_MESON_TAC[COPRIME_SYM; PRIME_COPRIME_EQ]);; + +let DIRICHLET_CHARACTER_REAL_CASES = prove + (`!d c. dirichlet_character d c /\ (!n. real(c n)) + ==> !n. c n = --Cx(&1) \/ c n = Cx(&0) \/ c n = Cx(&1)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIRICHLET_CHARACTER_NORM) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[REAL_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` SUBST1_TAC) THEN + REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_NEG; CX_INJ] THEN REAL_ARITH_TAC);; + +let DIRICHLET_CHARACTER_DIVISORSUM_PRIMEPOW_POS = prove + (`!d c p k. dirichlet_character d c /\ (!n. real(c n)) /\ prime p + ==> &0 <= Re(vsum {m | m divides (p EXP k)} c)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[RE_VSUM; FINITE_DIVISORS; EXP_EQ_0; PRIME_IMP_NZ] THEN + ASM_SIMP_TAC[DIVISORSUM_PRIMEPOW] THEN + FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_POW th]) THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] DIRICHLET_CHARACTER_REAL_CASES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM CX_POW; RE_CX; SUM_POS_LE_NUMSEG; + REAL_POW_LE; REAL_POS] THEN + MATCH_MP_TAC(REAL_ARITH `(s = if EVEN k then &1 else &0) ==> &0 <= s`) THEN + SPEC_TAC(`k:num`,`r:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[EVEN; SUM_CLAUSES_NUMSEG] THEN + ASM_REWRITE_TAC[complex_pow; RE_CX; LE_0] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[COMPLEX_POW_NEG; COMPLEX_POW_ONE; COMPLEX_MUL_LNEG; + COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG; COMPLEX_MUL_LID; + RE_NEG; RE_CX] THEN + REAL_ARITH_TAC);; + +let DIRICHLET_CHARACTER_DIVISORSUM_POS = prove + (`!d c n. dirichlet_character d c /\ (!n. real(c n)) /\ ~(n = 0) + ==> &0 <= Re(vsum {m | m divides n} c)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> n = 1 \/ 1 < n`)) + THENL + [ASM_SIMP_TAC[DIVIDES_ONE; SING_GSPEC; VSUM_SING] THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; RE_CX; REAL_POS]; + ALL_TAC] THEN + UNDISCH_TAC `1 < n` THEN SPEC_TAC(`n:num`,`n:num`) THEN + MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[DIRICHLET_CHARACTER_DIVISORSUM_PRIMEPOW_POS]] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN + MP_TAC(ISPEC `\m:num. Re(c m)` REAL_MULTIPLICATIVE_DIVISORSUM) THEN + REWRITE_TAC[real_multiplicative] THEN ANTS_TAC THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP DIRICHLET_CHARACTER_MUL th]) THEN + ASM_MESON_TAC[DIRICHLET_CHARACTER_EQ_1; RE_CX; REAL; CX_MUL]; + DISCH_THEN(MP_TAC o SPECL [`a:num`; `b:num`] o CONJUNCT2) THEN + ASM_SIMP_TAC[GSYM RE_VSUM; FINITE_DIVISORS; MULT_EQ_0; + ARITH_RULE `1 < n ==> ~(n = 0)`; REAL_LE_MUL]]);; + +let lemma = prove + (`!x n. &0 <= x /\ x <= &1 ==> &1 - &n * x <= (&1 - x) pow n`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[real_pow] THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 - x) * (&1 - &n * x)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= n * x * x ==> &1 - (n + &1) * x <= (&1 - x) * (&1 - n * x)`) THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_SQUARE]);; + +let LFUNCTION_NONZERO_REAL = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) /\ (!n. real(c n)) + ==> ~(Lfunction c = Cx(&0))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] + DIRICHLET_CHARACTER_NONPRINCIPAL_NONTRIVIAL) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!z. norm(z) < &1 + ==> summable (from 1) (\n. c(n) * z pow n / (Cx(&1) - z pow n))` + MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `2` THEN + MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n:num. Cx(&0)` THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; SUMMABLE_0] THEN + ASM_SIMP_TAC[COMPLEX_VEC_0; COMPLEX_POW_ZERO; IN_FROM; + ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(&2 * norm(z:complex) pow n)` THEN + REWRITE_TAC[REAL_CX; RE_CX] THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; NORM_POS_LE] THEN + ASM_SIMP_TAC[CX_MUL; CX_POW; SUMMABLE_COMPLEX_LMUL; COMPLEX_NORM_CX; + REAL_ABS_NORM; SUMMABLE_GP] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_ABS_POS; REAL_LE_MUL] THEN + REWRITE_TAC[TAUT `(p ==> (if q then x else T)) <=> p /\ q ==> x`] THEN + MP_TAC(SPECL [`norm(z:complex)`; `&1 / &2`] REAL_ARCH_POW_INV) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ABS_NUM; REAL_ABS_POW] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[complex_div; COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN + SUBST1_TAC(REAL_ARITH `&2 = inv(&1 / &2)`) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(NORM_ARITH + `norm(z) <= norm(w) - h ==> h <= norm(w - z)`) THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(z:complex) pow N` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; + ALL_TAC] THEN + REWRITE_TAC[summable; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:complex->complex` (LABEL_TAC "+")) THEN + ABBREV_TAC `b = \z n. inv(Cx(&n) * (Cx(&1) - z)) - + z pow n / (Cx(&1) - z pow n)` THEN + SUBGOAL_THEN + `!z:complex. norm(z) < &1 ==> ((\n. c(n) * b z n) sums --(f z)) (from 1)` + (LABEL_TAC "*") + THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "b" THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB; GSYM COMPLEX_SUB_LZERO] THEN + MATCH_MP_TAC SERIES_SUB THEN ASM_SIMP_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN + REWRITE_TAC[COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN + SUBST1_TAC(COMPLEX_RING `Cx(&0) = Cx(&0) * inv(Cx(&1) - z)`) THEN + MATCH_MP_TAC SERIES_COMPLEX_RMUL THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION) THEN + ASM_REWRITE_TAC[complex_div]; + ALL_TAC] THEN + SUBGOAL_THEN `!z. norm(z) < &1 + ==> ((\n. vsum {d | d divides n} (\d. c d) * z pow n) sums + f(z)) (from 1)` + (LABEL_TAC "+") THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN + SIMP_TAC[GSYM VSUM_COMPLEX_RMUL; FINITE_DIVISORS; LE_1] THEN + REWRITE_TAC[VSUM_VSUM_DIVISORS] THEN + REMOVE_THEN "+" (MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG; sums; FROM_INTER_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + SIMP_TAC[GSYM VSUM_SUB; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN + REWRITE_TAC[VSUM_GP; ARITH_RULE `n < 1 <=> n = 0`] THEN + SIMP_TAC[DIV_EQ_0; LE_1] THEN SIMP_TAC[GSYM NOT_LE] THEN + SUBGOAL_THEN `!k. 1 <= k ==> ~(z pow k = Cx(&1))` (fun th -> SIMP_TAC[th]) + THENL [ASM_MESON_TAC[COMPLEX_POW_EQ_1; LE_1; REAL_LT_REFL]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_POW_1; complex_div] THEN + REWRITE_TAC[COMPLEX_RING `(zx * i - (zx - w) * i) = w * i`] THEN + SIMP_TAC[COMPLEX_POW_POW] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\x. vsum (1..x) + (\n. z pow x * c n * + z pow (n - x MOD n) / (Cx(&1) - z pow n))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:num` THEN + REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_RING `(zx * cn) * zn = cn * zx * zn`] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN + AP_TERM_TAC THEN REWRITE_TAC[MULT_CLAUSES] THEN + MP_TAC(SPECL [`x:num`; `n:num`] DIVISION) THEN ASM_SIMP_TAC[LE_1] THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\x. Cx(norm(z) / (&1 - norm z)) * Cx(&x) * z pow x` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:num` THEN + REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN + REWRITE_TAC[FINITE_NUMSEG; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; + REAL_ABS_DIV; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `a * &x * b = &x * a * b`] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) + [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + FIRST_ASSUM(fun t -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM t]) THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_DIV; REAL_ABS_POS; + NORM_POS_LE; REAL_LE_MUL; REAL_MUL_LID; REAL_ABS_NORM] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + SIMP_TAC[complex_div; real_div; COMPLEX_NORM_MUL; COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[NORM_POS_LE; REAL_LE_INV_EQ] THEN + CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN + MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN + MATCH_MP_TAC(ARITH_RULE `m < r ==> 1 <= r - m`) THEN + ASM_SIMP_TAC[DIVISION; LE_1]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_ARITH `&0 < abs(x - a) <=> ~(a = x)`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(w) = &1 /\ norm(z) < &1 /\ norm(zn) <= norm(z) + ==> abs(&1 - norm(z)) <= norm(w - zn)`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NUM; COMPLEX_NORM_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN + MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN ASM_SIMP_TAC[LIM_N_TIMES_POWN]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(bounded + { (f:complex->complex)(t) | real t /\ &0 <= Re t /\ norm(t) < &1 })` + MP_TAC THENL + [REWRITE_TAC[BOUNDED_POS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[IMP_CONJ; FORALL_REAL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; RE_CX; IMP_IMP] THEN + REWRITE_TAC[REAL_ARITH `&0 <= x /\ abs x < &1 <=> &0 <= x /\ x < &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o + MATCH_MP PRIME_FACTOR) THEN + X_CHOOSE_TAC `N:num` (SPEC `&2 * (B + &1)` REAL_ARCH_SIMPLE) THEN + SUBGOAL_THEN `0 < N` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `t = &1 - inv(&(p EXP N)) / &2` THEN + SUBGOAL_THEN `&0 <= t /\ t < &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "t" THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < y /\ y <= &1 ==> &0 <= &1 - y / &2 /\ &1 - y / &2 < &1`) THEN + ASM_SIMP_TAC[REAL_INV_LE_1; REAL_LT_INV_EQ; REAL_OF_NUM_LE; + REAL_OF_NUM_LT; LE_1; EXP_EQ_0; PRIME_IMP_NZ]; + ALL_TAC] THEN + REMOVE_THEN "+" (MP_TAC o SPEC `Cx t`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; NOT_IMP] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN REWRITE_TAC[SERIES_FROM; LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` MP_TAC) THEN + SUBGOAL_THEN `?n. M <= n /\ 1 <= n /\ p EXP N <= n` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `p EXP N + M + 1` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `norm (f (Cx t):complex) <= B` THEN + MATCH_MP_TAC(NORM_ARITH + `B + &1 <= norm(x) ==> norm(y) <= B ==> ~(dist(x,y) < &1)`) THEN + MATCH_MP_TAC(REAL_ARITH + `a <= Re z /\ abs(Re z) <= norm z ==> a <= norm z`) THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN + SIMP_TAC[RE_VSUM; FINITE_NUMSEG; RE_MUL_CX; GSYM CX_POW] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (\k. p EXP k) (0..N)) + (\x. Re (vsum {d | d divides x} (\d. c d)) * t pow x)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; IN_DIFF; SUBSET; IN_ELIM_THM; + FORALL_IN_IMAGE] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] + DIRICHLET_CHARACTER_DIVISORSUM_POS) THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; LE_1; ETA_AX] THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP N` THEN + ASM_SIMP_TAC[LE_EXP; PRIME_IMP_NZ]] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[EQ_EXP] THEN ASM_MESON_TAC[PRIME_0; PRIME_1]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..N) (\k. &1 * &1 / &2)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; GSYM REAL_OF_NUM_ADD] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL + [MP_TAC(SPECL [`d:num`; `c:num->complex`; `p:num`; `k:num`] + DIRICHLET_CHARACTER_DIVISORSUM_EQ_1) THEN + ASM_SIMP_TAC[ETA_AX; RE_CX; REAL_LE_REFL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`inv(&(p EXP N)) / &2`; `p EXP k`] lemma) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[real_div; GSYM REAL_INV_MUL; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[EXP_EQ_0; MULT_EQ_0; ARITH; PRIME_IMP_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= a ==> a <= x ==> b <= x`) THEN + MATCH_MP_TAC(REAL_ARITH `x * y <= &1 ==> &1 / &2 <= &1 - x * y / &2`) THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; + EXP_EQ_0; PRIME_IMP_NZ] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE; LE_EXP] THEN + ASM_MESON_TAC[PRIME_0]; + ALL_TAC] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] + BOUNDED_LFUNCTION_PARTIAL_SUMS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN + REWRITE_TAC[BOUNDED_POS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `&2 * B` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC + `\n. vsum(from 1 INTER (0..n)) (\k. c k * b (z:complex) k :complex)` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN + REWRITE_TAC[FROM_INTER_NUMSEG] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`c:num->complex`; `(b:complex->num->complex) z`; + `B:real`; `1`] SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT) THEN + ASM_REWRITE_TAC[LE_REFL] THEN ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `1`) THEN + SUBGOAL_THEN `(b:complex->num->complex) z 1 = Cx(&1)` SUBST1_TAC THENL + [EXPAND_TAC "b" THEN + REWRITE_TAC[COMPLEX_POW_1; COMPLEX_INV_MUL; complex_div] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_INV_1] THEN + MATCH_MP_TAC COMPLEX_MUL_RINV THEN REWRITE_TAC[COMPLEX_SUB_0] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + UNDISCH_TAC `norm(Cx(&1)) < &1` THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_LT_REFL; REAL_ABS_NUM]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_NUM; REAL_MUL_RID] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LE_REFL]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` SUBST_ALL_TAC o + GEN_REWRITE_RULE I [REAL_EXISTS]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[RE_CX; COMPLEX_NORM_CX]) THEN + SUBGOAL_THEN `!n. &0 < sum(0..n) (\m. t pow m)` ASSUME_TAC THENL + [GEN_TAC THEN SIMP_TAC[LE_0; SUM_CLAUSES_LEFT; real_pow] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN + ASM_SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POW_LE]; + ALL_TAC] THEN + CONJ_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN EXPAND_TAC "b" THEN + REWRITE_TAC[GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; GSYM CX_MUL; + GSYM CX_INV; REAL_CX; RE_CX] + THENL + [ASM_SIMP_TAC[REAL_SUB_POW_L1; REAL_SUB_LE] THEN + ASM_REWRITE_TAC[real_div; REAL_INV_MUL] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; + LE_1; REAL_ARITH `abs t < &1 ==> &0 < &1 - t`] THEN + ASM_SIMP_TAC[real_div; REAL_FIELD + `abs(t) < &1 ==> (x * inv(&1 - t) * y) * (&1 - t) = x * y`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x / y * &n = (&n * x) / y`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n-1) (\m. t pow n)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[SUM_CONST_NUMSEG; ARITH_RULE `1 <= n ==> n - 1 + 1 = n`; + SUB_0; REAL_LE_REFL]; + REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_MONO_INV THEN REPEAT CONJ_TAC THEN + TRY ASM_REAL_ARITH_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_SUB_POW_L1; ARITH_RULE `1 <= n + 1`] THEN + REWRITE_TAC[ADD_SUB; REAL_INV_MUL; real_div] THEN + REWRITE_TAC[REAL_ARITH `x * t - y * t * z <= u * t - v * t * w <=> + t * (v * w - y * z) <= t * (u - x)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_FIELD + `&0 < y /\ &0 < z ==> x / y - w / z = (x * z - w * y) / (y * z)`] THEN + SUBGOAL_THEN `t pow n * sum (0..n) (\m. t pow m) - + t pow (n + 1) * sum (0..n - 1) (\m. t pow m) = t pow n` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL; GSYM REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[ARITH_RULE `(n + 1) + x = n + x + 1`] THEN + REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET); SUB_ADD; ADD_CLAUSES] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; GSYM SUM_LMUL; ADD_CLAUSES] THEN + ASM_SIMP_TAC[SUB_ADD; REAL_POW_ADD] THEN + REWRITE_TAC[REAL_ARITH `(x + y) - y:real = x`]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_MUL; GSYM REAL_OF_NUM_ADD; + REAL_OF_NUM_LE; + REAL_FIELD `&1 <= n ==> inv(n) - inv(n + &1) = inv(n * (n + &1))`] THEN + MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `2` THEN + REWRITE_TAC[ARITH] THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THEN REWRITE_TAC[REAL_LE_INV_EQ]) THEN + ASM_SIMP_TAC[REAL_POW_LE; SUM_POS_LE_NUMSEG] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `t:real`] AGM_SPECIAL) THEN + MP_TAC(SPECL [`n - 1`; `t:real`] AGM_SPECIAL) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; REAL_SUB_ADD] THEN + REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; + LE_1; REAL_ARITH `&0 < &n + &1`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE + [TAUT `a /\ b /\ c /\ d ==> e <=> b /\ d ==> a /\ c ==> e`] + REAL_LE_MUL2)) THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_ARITH `&0 <= &n + &1`] THEN + MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> b <= x ==> a <= y`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL; REAL_POW_MUL] THEN + REWRITE_TAC[REAL_MUL_AC]; + REWRITE_TAC[GSYM REAL_POW_ADD; REAL_POW_POW] THEN + MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Deduce nonvanishing of all the nonprincipal characters. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_DIFF_LOGMUL = prove + (`!f a. bounded {f x - Cx(log(&x)) * a | x IN (:num)} + ==> (!x. &0 <= Re(f x)) ==> &0 <= Re a`, + REPEAT GEN_TAC THEN + REWRITE_TAC[BOUNDED_POS; SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(ISPEC `exp((B + &1) / --(Re a))` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + SUBGOAL_THEN `abs(Re(f n - Cx(log(&n)) * a)) <= B` MP_TAC THENL + [ASM_MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LE_TRANS]; ALL_TAC] THEN + REWRITE_TAC[RE_SUB; RE_MUL_CX; REAL_NOT_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `B < l * --a /\ &0 <= f ==> B < abs(f - l * a)`) THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_NEG_GT0] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `log(exp((B + &1) / --Re a))` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[LOG_EXP; REAL_NEG_GT0; REAL_LT_DIV2_EQ] THEN REAL_ARITH_TAC; + MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT]]);; + +let LFUNCTION_NONZERO_NONPRINCIPAL = prove + (`!d c. dirichlet_character d c /\ ~(c = chi_0 d) + ==> ~(Lfunction c = Cx(&0))`, + let lemma = prove + (`{a,b,c} SUBSET s + ==> FINITE s + ==> !f. sum s f = sum (s DIFF {a,b,c}) f + sum {a,b,c} f`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_UNION_EQ THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]) in + GEN_TAC THEN ASM_CASES_TAC `d = 0` THENL + [ASM_MESON_TAC[DIRICHLET_CHARACTER_0]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\x c. vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) - + Cx(log(&x)) * + (if c = chi_0 d then Cx(&1) + else if Lfunction c = Cx(&0) then --Cx(&1) + else Cx(&0))`; + `(:num)`; + `{c | dirichlet_character d c}`] + BOUNDED_SUMS_IMAGES) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM] THEN + X_GEN_TAC `c:num->complex` THEN + ASM_CASES_TAC `c = chi_0 d` THEN + ASM_SIMP_TAC[COMPLEX_MUL_RID; BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL; + LE_1] THEN + ASM_CASES_TAC `Lfunction c = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_RNEG; COMPLEX_MUL_RZERO; + COMPLEX_MUL_RID; COMPLEX_SUB_RNEG] THEN + ASM_MESON_TAC[BOUNDED_DIRICHLET_MANGOLDT_ZERO; + BOUNDED_DIRICHLET_MANGOLDT_NONZERO; LE_1]; + ALL_TAC] THEN + SIMP_TAC[VSUM_SUB; FINITE_DIRICHLET_CHARACTERS; VSUM_COMPLEX_LMUL] THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_DIFF_LOGMUL) THEN + REWRITE_TAC[IN_UNIV] THEN ANTS_TAC THENL + [X_GEN_TAC `x:num` THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o funpow 2 rand o snd) THEN + REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; FINITE_NUMSEG] THEN + DISCH_THEN SUBST1_TAC THEN + SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_DIRICHLET_CHARACTERS] THEN + SIMP_TAC[RE_VSUM; FINITE_NUMSEG; RE_MUL_CX] THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS_POS; + REAL_LE_DIV; REAL_POS; MANGOLDT_POS_LE]; + ALL_TAC] THEN + SIMP_TAC[RE_VSUM; FINITE_DIRICHLET_CHARACTERS] THEN + REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN + REWRITE_TAC[RE_NEG; RE_CX] THEN DISCH_TAC THEN + X_GEN_TAC `c:num->complex` THEN STRIP_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LT]) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `{chi_0 d,c,(\n. cnj(c n))} SUBSET {c | dirichlet_character d c}` + MP_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_CHI_0; DIRICHLET_CHARACTER_CNJ]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC(REAL_ARITH `s <= &0 /\ t < &0 ==> s + t < &0`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= --x ==> x <= &0`) THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_POS_LE THEN + SIMP_TAC[FINITE_DIRICHLET_CHARACTERS; FINITE_DIFF] THEN + SIMP_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; IN_INSERT; NOT_IN_EMPTY; + FINITE_RULES] THEN + SUBGOAL_THEN `~(chi_0 d = (\n. cnj (c n)))` ASSUME_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `(\c n:num. cnj(c n))`) THEN + REWRITE_TAC[CNJ_CNJ; FUN_EQ_THM; CNJ_CHI_0] THEN + ASM_REWRITE_TAC[GSYM FUN_EQ_THM; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN `~(c = \n:num. cnj(c n))` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC[GSYM REAL_CNJ; FUN_EQ_THM] THEN + ASM_MESON_TAC[LFUNCTION_NONZERO_REAL]; + ALL_TAC] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] LFUNCTION_CNJ) THEN + ASM_SIMP_TAC[CNJ_EQ_CX] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence derive our boundedness result for all nonprincipal characters. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_DIRICHLET_MANGOLDT_NONPRINCIPAL = prove + (`!d c. + dirichlet_character d c /\ ~(c = chi_0 d) + ==> bounded { vsum(1..x) (\n. c n * Cx(mangoldt n / &n)) | x IN (:num)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_DIRICHLET_MANGOLDT_NONZERO THEN + EXISTS_TAC `d:num` THEN + ASM_MESON_TAC[LFUNCTION_NONZERO_NONPRINCIPAL]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main sum result. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_SUM_OVER_DIRICHLET_CHARACTERS = prove + (`!d l. 1 <= d /\ coprime(l,d) + ==> bounded { vsum {c | dirichlet_character d c} + (\c. c(l) * + vsum(1..x) (\n. c n * Cx (mangoldt n / &n))) - + Cx(log(&x)) | x IN (:num)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `!x. Cx(log(&x)) = + vsum {c | dirichlet_character d c} + (\c. if c = chi_0 d then Cx(log(&x)) else Cx(&0))` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [SIMP_TAC[VSUM_DELTA; GSYM COMPLEX_VEC_0] THEN + REWRITE_TAC[IN_ELIM_THM; DIRICHLET_CHARACTER_CHI_0]; + ALL_TAC] THEN + SIMP_TAC[GSYM VSUM_SUB; FINITE_DIRICHLET_CHARACTERS] THEN + MATCH_MP_TAC BOUNDED_SUMS_IMAGES THEN + REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; IN_ELIM_THM] THEN + X_GEN_TAC `c:num->complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `c = chi_0 d` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_DIRICHLET_MANGOLDT_PRINCIPAL) THEN + ASM_REWRITE_TAC[chi_0; COMPLEX_MUL_LID]; + REWRITE_TAC[COMPLEX_SUB_RZERO] THEN + MP_TAC(SPECL [`d:num`; `c:num->complex`] + BOUNDED_DIRICHLET_MANGOLDT_NONPRINCIPAL) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[BOUNDED_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN + FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP DIRICHLET_CHARACTER_NORM th]) THEN + REAL_ARITH_TAC]);; + +let DIRICHLET_MANGOLDT = prove + (`!d k. 1 <= d /\ coprime(k,d) + ==> bounded { Cx(&(phi d)) * vsum {n | n IN 1..x /\ (n == k) (mod d)} + (\n. Cx(mangoldt n / &n)) - + Cx(log(&x)) | x IN (:num)}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?l. (k * l == 1) (mod d)` CHOOSE_TAC THENL + [ASM_MESON_TAC[CONG_SOLVE]; ALL_TAC] THEN + MP_TAC(SPECL [`d:num`; `l:num`] BOUNDED_SUM_OVER_DIRICHLET_CHARACTERS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `(k * l == 1) (mod d)` THEN + CONV_TAC NUMBER_RULE; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN + X_GEN_TAC `x:num` THEN DISCH_THEN(K ALL_TAC) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG; FINITE_RESTRICT] THEN + SIMP_TAC[VSUM_RESTRICT_SET; FINITE_NUMSEG] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o lhand o snd) THEN + REWRITE_TAC[FINITE_DIRICHLET_CHARACTERS; FINITE_NUMSEG] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + MP_TAC(GSYM(SPEC `d:num` DIRICHLET_CHARACTER_MUL)) THEN + SIMP_TAC[IN_ELIM_THM] THEN DISCH_THEN(K ALL_TAC) THEN + SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_DIRICHLET_CHARACTERS] THEN + ASM_SIMP_TAC[DIRICHLET_CHARACTER_SUM_OVER_CHARACTERS] THEN + SUBGOAL_THEN `(l * n == 1) (mod d) <=> (n == k) (mod d)` SUBST1_TAC THENL + [UNDISCH_TAC `(k * l == 1) (mod d)` THEN CONV_TAC NUMBER_RULE; + COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_VEC_0]]);; + +let DIRICHLET_MANGOLDT_EXPLICIT = prove + (`!d k. 1 <= d /\ coprime (k,d) + ==> ?B. &0 < B /\ + !x. abs(sum {n | n IN 1..x /\ (n == k) (mod d)} + (\n. mangoldt n / &n) - + log(&x) / &(phi d)) <= B`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIRICHLET_MANGOLDT) THEN + REWRITE_TAC[BOUNDED_POS] THEN + SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + SIMP_TAC[VSUM_CX; FINITE_RESTRICT; FINITE_NUMSEG; + GSYM CX_SUB; GSYM CX_MUL; COMPLEX_NORM_CX] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B / &(phi d)` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; PHI_LOWERBOUND_1_STRONG; + REAL_LE_RDIV_EQ] THEN + X_GEN_TAC `n:num` THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; + LE_1; PHI_LOWERBOUND_1_STRONG; REAL_OF_NUM_EQ]);; + +let DIRICHLET_STRONG = prove + (`!d k. 1 <= d /\ coprime(k,d) + ==> ?B. &0 < B /\ + !x. abs(sum {p | p IN 1..x /\ prime p /\ (p == k) (mod d)} + (\p. log(&p) / &p) - + log(&x) / &(phi d)) <= B`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP DIRICHLET_MANGOLDT_EXPLICIT) THEN + EXISTS_TAC `B + &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num`) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x - y) <= a ==> abs(x - z) <= b ==> abs(y - z) <= b + a`) THEN + MP_TAC(SPECL [`x:num`; `{n | n IN 1..x /\ (n == k) (mod d)}`] + MERTENS_MANGOLDT_VERSUS_LOG) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM] THEN REWRITE_TAC[CONJ_ACI]);; + +(* ------------------------------------------------------------------------- *) +(* Ignore the density details and prove the main result. *) +(* ------------------------------------------------------------------------- *) + +let DIRICHLET = prove + (`!d k. 1 <= d /\ coprime(k,d) + ==> INFINITE {p | prime p /\ (p == k) (mod d)}`, + REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN MP_TAC(SPECL [`d:num`; `k:num`] DIRICHLET_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC + `max (exp(&(phi d) * + (&1 + B + sum {p | p IN 1..n /\ prime p /\ (p == k) (mod d)} + (\p. log(&p) / &p)))) + (max (&n) (&1))` + REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_MAX_LE; REAL_OF_NUM_LE] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - y) <= b ==> y < &1 + b + x`)) THEN + ASM_SIMP_TAC[REAL_NOT_LT; REAL_LE_RDIV_EQ; PHI_LOWERBOUND_1_STRONG; + REAL_OF_NUM_LT; LE_1] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LE_1] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x <= a ==> x = y ==> y <= a`)) THEN + REPLICATE_TAC 4 AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC);; diff --git a/100/div3.ml b/100/div3.ml new file mode 100644 index 0000000..1a6bea2 --- /dev/null +++ b/100/div3.ml @@ -0,0 +1,27 @@ +(* ========================================================================= *) +(* #85: divisibility by 3 rule *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; + +let EXP_10_CONG_3 = prove + (`!n. (10 EXP n == 1) (mod 3)`, + INDUCT_TAC THEN REWRITE_TAC[EXP; CONG_REFL] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `10 * 1` THEN CONJ_TAC THEN + ASM_SIMP_TAC[CONG_MULT; CONG_REFL] THEN + SIMP_TAC[CONG; ARITH] THEN CONV_TAC NUM_REDUCE_CONV);; + +let SUM_CONG_3 = prove + (`!d n. (nsum(0..n) (\i. 10 EXP i * d(i)) == nsum(0..n) (\i. d i)) (mod 3)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THENL + [REWRITE_TAC[EXP; MULT_CLAUSES; CONG_REFL]; ALL_TAC] THEN + REWRITE_TAC[LE_0] THEN MATCH_MP_TAC CONG_ADD THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV) [ARITH_RULE `d = 1 * d`] THEN + MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL; EXP_10_CONG_3]);; + +let DIVISIBILITY_BY_3 = prove + (`3 divides (nsum(0..n) (\i. 10 EXP i * d(i))) <=> + 3 divides (nsum(0..n) (\i. d i))`, + MATCH_MP_TAC CONG_DIVIDES THEN REWRITE_TAC[SUM_CONG_3]);; diff --git a/100/divharmonic.ml b/100/divharmonic.ml new file mode 100644 index 0000000..71e11e6 --- /dev/null +++ b/100/divharmonic.ml @@ -0,0 +1,78 @@ +(* ========================================================================= *) +(* Divergence of harmonic series. *) +(* ========================================================================= *) + +prioritize_real();; + +let HARMONIC_DIVERGES = prove + (`~(?s. !e. &0 < e + ==> ?N. !n. N <= n ==> abs(sum(1..n) (\i. &1 / &i) - s) < e)`, + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1 / &4`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `N + 1`) THEN REWRITE_TAC[LE_ADD] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(N + 1) + (N + 1)`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= (N + 1) + 1`] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 / &2 <= y + ==> abs((x + y) - s) < &1 / &4 ==> ~(abs(x - s) < &1 / &4)`) THEN + REWRITE_TAC[GSYM MULT_2] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum((N + 1) + 1 .. 2 * (N + 1)) (\i. &1 / &(2 * (N + 1)))` THEN + CONJ_TAC THENL + [SIMP_TAC[SUM_CONST_NUMSEG; ARITH_RULE `(2 * x + 1) - (x + 1) = x`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + MP_TAC(SPEC `n:num` REAL_POS) THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Formulation in terms of limits. *) +(* ------------------------------------------------------------------------- *) + +needs "Library/analysis.ml";; + +let HARMONIC_DIVERGES' = prove + (`~(convergent (\n. sum(1..n) (\i. &1 / &i)))`, + REWRITE_TAC[convergent; SEQ; GE; HARMONIC_DIVERGES]);; + +(* ------------------------------------------------------------------------- *) +(* Lower bound on the partial sums. *) +(* ------------------------------------------------------------------------- *) + +let HARMONIC_LEMMA = prove + (`!m. sum(1..2 EXP m) (\n. &1 / &n) >= &m / &2`, + REWRITE_TAC[real_ge] THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; MULT_2; SUM_SING_NUMSEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= 2 EXP m + 1`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `a <= x ==> b - a <= y ==> b <= x + y`)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM (CONJUNCT2 EXP); GSYM MULT_2] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(2 EXP m + 1..2 EXP (SUC m))(\n. &1 / &(2 EXP (SUC m)))` THEN + CONJ_TAC THENL + [SIMP_TAC[SUM_CONST_NUMSEG; EXP; ARITH_RULE `(2 * x + 1) - (x + 1) = x`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + MP_TAC(SPECL [`2`; `m:num`] EXP_EQ_0) THEN + REWRITE_TAC[ARITH] THEN REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN + CONV_TAC REAL_FIELD; + MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Germ of an alternative proof. *) +(* ------------------------------------------------------------------------- *) + +needs "Library/transc.ml";; + +let LOG_BOUND = prove + (`&0 < x /\ x < &1 ==> ln(&1 + x) >= x / &2`, + REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM LN_EXP] THEN + ASM_SIMP_TAC[LN_MONO_LE; REAL_EXP_POS_LT; REAL_LT_ADD; REAL_LT_01] THEN + MP_TAC(SPEC `x / &2` REAL_EXP_BOUND_LEMMA) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; diff --git a/100/e_is_transcendental.ml b/100/e_is_transcendental.ml new file mode 100644 index 0000000..df65ea3 --- /dev/null +++ b/100/e_is_transcendental.ml @@ -0,0 +1,2896 @@ +(* + * HOL Light proof that e is transcendental. + * + * This HOL Light proof and its relationship to the informal proof is + * described in : + * + * "Formalizing a Proof that e is Transcendental", Journal of Formal + * Reasoning, Vol 4, No 1. 2011. + * + * It follows the informal proof provided by the good folks at the + * planetmath website: + * + * http://planetmath.org/encyclopedia/EIsTranscendental2.html + * + * Note: the original proof script linked to in the above paper + * partitioned the proofs amongst several files, each encapsulated + * in an Ocaml module. This file has simply concatenated those files + * and hence the module structure persists. + * + * Jesse Bingham, Jan 2012 + * jesse.d.bingham@intel.com + * jesse.bingham@gmail.com + *) + +(* this is needed since the sum from the HOL core (iter.ml, i think) + * which is used below, gets overwritten when Library/analysis.ml is loaded. + *) +let OLD_SUM = sum;; + +(* required stuff from HOL Light library... *) +needs "Library/binomial.ml";; +needs "Library/analysis.ml";; +needs "Library/transc.ml";; +needs "Library/prime.ml";; +needs "Library/iter.ml";; +needs "Library/integer.ml";; +needs "Library/floor.ml";; +(* get def of transcendental from Harrison's Liouville proof *) +needs "100/liouville.ml";; + +prioritize_real();; + +(* + * A few misculaneous proof utility functions + *) + +(* A listified version of ADD_ASSUM *) +let ADD_ASSUMS lst thm = + let f x y = ADD_ASSUM y x in + List.fold_left f thm lst +;; +(* A tactic that takes a goal with an assumption A /\ B and replaces + * it with a goal with the two assumptions A and B + *) +let SPLIT_CONJOINED_ASSUMPT_TAC t = + (UNDISCH_TAC t) THEN + (ONCE_REWRITE_TAC [TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`]) THEN + (DISCH_TAC THEN DISCH_TAC) +;; +(* Adds an assumption and discharges it in one fell swoop *) +let ADD_ASSUM_DISCH ass thm = DISCH ass (ADD_ASSUM ass thm);; +(* BRW = Bolean ReWrite *) +let BRW t f = ONCE_REWRITE_RULE [TAUT t] f;; +(* Those two boolean rewrites come in handy *) +let BRW0 f = BRW `(X ==> Y ==> Z) <=> (X /\ Y ==> Z)` f;; +let BRW1 f = BRW `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)` f;; +(* a bunch of trivial real theorems that are useful for + * rewriting/simplifying/mesoning + *) +let rewrites0 = map REAL_ARITH [`&0 + (y:real) = y`;`(x:real) * &0 = &0`;`(&1:real) + &0 = &1`;`(x:real) * &1 = x`];; + +module Pm_lemma1 = struct + +let PDI_DEF = new_recursive_definition num_RECURSION + ` (poly_diff_iter p 0 = p) + /\ (poly_diff_iter p (SUC n) = poly_diff (poly_diff_iter p n)) + ` +let PDI_POLY_DIFF_COMM = prove( + `! p n.(poly_diff_iter (poly_diff p) n) = (poly_diff (poly_diff_iter p n))`, + STRIP_TAC THEN INDUCT_TAC THEN (ASM_SIMP_TAC [PDI_DEF]) +) + +let SODN = new_definition + `SODN p n = iterate poly_add (0..n) (\i.poly_diff_iter p i)` +;; +let SOD = new_definition `!p. SOD p = SODN p (LENGTH p)`;; + +let PHI = new_definition `Phi f x = (exp (-- x)) * (poly (SOD f) x)` + +let PLANETMATH_EQN_1_1_1 = prove( + `! x f.((Phi f) diffl ((exp (--x)) * ((poly (poly_diff (SOD f)) x) - (poly (SOD f) x))) )(x)`, + let lem1 = SPECL [`\x.exp (--x)`; + `\x.poly (SOD f) x`; + `--(exp (--x))`; + `poly (poly_diff (SOD f)) x`; + `x:real`] DIFF_MUL in + let EXP_NEG_X_DIFF = prove( + `!x. ((\x.exp (--x)) diffl (-- (exp (--x))))(x)`, + STRIP_TAC THEN DIFF_TAC THEN REAL_ARITH_TAC) in + let lem2 = SPEC `x:real` EXP_NEG_X_DIFF in + let lem3 = SPECL [`SOD f`;`x:real`] POLY_DIFF in + let lem4 = CONJ lem2 lem3 in + let lem5 = BETA_RULE (MP lem1 lem4) in + let lem6 = REAL_ARITH `(a*(b - c)) = (-- a*c) + (b*a)` in + let PHI_abs = prove( + `Phi f = \x.((exp (-- x)) * (poly (SOD f) x))`, + (PURE_REWRITE_TAC [SYM (ABS `x:real` (SPEC_ALL PHI))]) + THEN (ACCEPT_TAC (SYM (ETA_CONV `\x.(Phi f x)`)))) + in + (REPEAT STRIP_TAC) THEN + (REWRITE_TAC [PHI_abs]) THEN + (REWRITE_TAC [lem6]) THEN + (ACCEPT_TAC lem5) +) + +let POLY_SUB = prove( + `!p1 p2 x. poly (p1 ++ (neg p2)) x = poly p1 x - poly p2 x`, + (REWRITE_TAC [POLY_ADD;poly_neg;POLY_CMUL]) THEN REAL_ARITH_TAC +) +let ZERO_INSERT_NUMSEG = prove( + `!n. (0..n) = (0 INSERT (1..n))`, + let lem01 = SIMP_RULE [ARITH_RULE `0 <= n`] (SPECL [`0`;`n:num`] NUMSEG_LREC) in + let lem02 = SIMP_RULE [ARITH_RULE `0 + 1 = 1`] lem01 in + (ACCEPT_TAC (GEN_ALL (GSYM lem02))) +) +let PDI_POLYDIFF_SUC_LEMMA = prove( + `!f n .(poly_diff_iter (poly_diff f) n) = poly_diff_iter f (SUC n)`, + STRIP_TAC THEN INDUCT_TAC THENL + [ (SIMP_TAC [PDI_DEF]); + (ONCE_REWRITE_TAC [PDI_DEF]) THEN + (ONCE_REWRITE_TAC [PDI_DEF]) THEN + (SIMP_TAC [PDI_POLY_DIFF_COMM]) + ] +) +let SOD_POLY_DIFF_ITERATE = prove( + `!f .(SOD (poly_diff f)) = iterate (++) (1..(LENGTH f)) (\i.poly_diff_iter f i)`, + let lemA1 = SPECL [`1`;`0`] NUMSEG_EMPTY in + let lemA2 = SIMP_RULE [ARITH_RULE `0 < 1`] lemA1 in + let lem1 = MATCH_MP ITERATE_IMAGE_NONZERO MONOIDAL_POLY_ADD in + let lem2 = ISPECL [`poly_diff_iter f`;`SUC`;`0..(LENGTH (poly_diff f))`] lem1 in + let lem3 = SIMP_RULE [FINITE_NUMSEG] lem2 in + let lem4 = ONCE_REWRITE_RULE [ARITH_RULE `~(~(x=y) /\ (SUC x) = (SUC y))`] lem3 in + let lem5 = SIMP_RULE [] lem4 in + let lem6 = ISPECL [`0`;`n:num`;`1`] NUMSEG_OFFSET_IMAGE in + let lem7 = SIMP_RULE [ARITH_RULE `!m.m+1 = SUC m`] lem6 in + let lem8 = SIMP_RULE [ARITH_RULE `SUC 0 = 1`] lem7 in + let lem9 = ONCE_REWRITE_RULE [ETA_CONV `(\i. SUC i)`] lem8 in + let lem10 = ONCE_REWRITE_RULE [GSYM lem9] lem5 in + let lem11 = ONCE_REWRITE_RULE [GSYM (ETA_CONV `(\i. poly_diff_iter f i)`)] lem10 in + let lem12 = SIMP_RULE [o_DEF] lem11 in + let lemma0 = prove( + `! h t.SUC (LENGTH (poly_diff (CONS h t))) = LENGTH (CONS h t)`, + (SIMP_TAC [LENGTH_POLY_DIFF;LENGTH;PRE]) + ) in + (ONCE_REWRITE_TAC [SOD]) THEN (ONCE_REWRITE_TAC [SODN]) THEN + (ONCE_REWRITE_TAC [PDI_POLYDIFF_SUC_LEMMA ]) THEN LIST_INDUCT_TAC THENL + [ (SIMP_TAC [poly_diff;LENGTH]) THEN + (SIMP_TAC [GSYM lemma0;lem12]) THEN + (SIMP_TAC [NUMSEG_SING;MONOIDAL_POLY_ADD;ITERATE_SING]) THEN + (SIMP_TAC [lemA2;MATCH_MP ITERATE_CLAUSES_GEN MONOIDAL_POLY_ADD]) THEN + (ONCE_REWRITE_TAC [POLY_ADD_IDENT]) THEN + (SIMP_TAC [PDI_DEF;POLY_DIFF_CLAUSES]); + (SIMP_TAC [lem12;GSYM lemma0]) + ] +) +let ZERO_ITERATE_POLYADD_LEMMA = prove( + `!n f .iterate (++) (0 INSERT (1..n)) f + = (f 0) ++ iterate (++) (1..n) f`, + let lem0 = prove(`!n. ~(0 IN (1..n))`, + STRIP_TAC THEN (ONCE_REWRITE_TAC [IN_NUMSEG]) THEN + ARITH_TAC) in + let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in + let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in + let lem3 = CONJUNCT2 lem2 in + let lem4 = ISPECL [`f:(num -> (real)list)`;`0`;`1..n`] lem3 in + let lem5 = ISPECL [`poly_add`;`f:(num -> (real)list)`;`1..n` ] FINITE_SUPPORT in + let lem6 = SIMP_RULE [FINITE_NUMSEG] lem5 in + let lem7 = MP lem4 lem6 in + let lem9 = SIMP_RULE [lem0] lem7 in + (ACCEPT_TAC (GEN_ALL lem9)) +) +let SOD_SOD_POLYDIFF = prove( + `!f .(SOD f) = f ++ (SOD (poly_diff f))`, + (ONCE_REWRITE_TAC [SOD_POLY_DIFF_ITERATE]) THEN (ONCE_REWRITE_TAC [SOD]) THEN + (ONCE_REWRITE_TAC [SODN]) THEN + (ONCE_REWRITE_TAC [ZERO_INSERT_NUMSEG]) THEN + (ONCE_REWRITE_TAC [ZERO_ITERATE_POLYADD_LEMMA]) THEN + (BETA_TAC) THEN (SIMP_TAC [PDI_DEF]) +) +let SUC_INSERT_NUMSEG = prove( + `!n. (0..(SUC n)) = (SUC n) INSERT (0..n)`, + let lem01 = SIMP_RULE [ARITH_RULE `0 <= SUC n`] + (SPECL [`0`;`n:num`] NUMSEG_REC) in + ACCEPT_TAC (GEN_ALL lem01) +) +let SUC_NOT_IN_NUMSEG = prove( + `!m n. ~((SUC n) IN (m..n))`, + STRIP_TAC THEN (ONCE_REWRITE_TAC [IN_NUMSEG]) THEN ARITH_TAC +) +let SUC_ITERATE_PDI_POLYDIFF_LEMMA = prove( + `iterate (++) ((SUC n) INSERT (0..n)) (\i.poly_diff_iter (poly_diff p) i) = + (poly_diff_iter (poly_diff p) (SUC n)) ++ + iterate (++) (0..n) (\i.poly_diff_iter (poly_diff p) i)`, + let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in + let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in + let lem3 = CONJUNCT2 lem2 in + let lem4 = ISPECL [`(\i.poly_diff_iter (poly_diff p) i)`;`SUC n`;`0..n`] lem3 in + let lem5 = ISPECL [`poly_add`;`\i.poly_diff_iter (poly_diff p) i`;`0..n` ] FINITE_SUPPORT in + let lem6 = SIMP_RULE [FINITE_NUMSEG] lem5 in + let lem7 = MP lem4 lem6 in + let lem9 = SIMP_RULE [SPEC `0` SUC_NOT_IN_NUMSEG] lem7 in + ACCEPT_TAC lem9 +) +let SODN_POLY_DIFF_COMM = prove( + `!n p.(SODN (poly_diff p) n) = poly_diff (SODN p n)`, + let lem = MP (ISPEC `poly_add` ITERATE_SING) MONOIDAL_POLY_ADD in + let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in + let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in + let lem3 = CONJUNCT2 lem2 in + let lem10 = SIMP_RULE [GSYM SUC_INSERT_NUMSEG] SUC_ITERATE_PDI_POLYDIFF_LEMMA in + let lema00 = ISPECL [`(\i.poly_diff_iter (p) i)`;`SUC n`;`0..n`] lem3 in + let lema0 = SIMP_RULE [GSYM SUC_INSERT_NUMSEG] lema00 in + let lem15 = ISPECL [`poly_add`;`\i.poly_diff_iter (p) i`;`0..n` ] FINITE_SUPPORT in + let lem16 = SIMP_RULE [FINITE_NUMSEG] lem15 in + let lema1 = MP lema0 lem16 in + let lema2 = SIMP_RULE [SPEC `0` SUC_NOT_IN_NUMSEG] lema1 in + let lema3 = ONCE_REWRITE_RULE [GSYM SODN] lema2 in + INDUCT_TAC THENL + [ (ONCE_REWRITE_TAC [SODN]) THEN + (SIMP_TAC [NUMSEG_SING;ITERATE_SING]) THEN + (ONCE_REWRITE_TAC [lem]) THEN + (BETA_TAC) THEN + (SIMP_TAC [PDI_POLY_DIFF_COMM]) + ; + (ONCE_REWRITE_TAC [SODN]) THEN (ONCE_REWRITE_TAC [lem10]) THEN + (ONCE_REWRITE_TAC [GSYM SODN]) THEN (ASM_SIMP_TAC []) THEN + (ONCE_REWRITE_TAC [PDI_DEF ]) THEN + (ONCE_REWRITE_TAC [PDI_POLY_DIFF_COMM]) THEN + (ONCE_REWRITE_TAC [GSYM POLYDIFF_ADD]) THEN + STRIP_TAC THEN AP_TERM_TAC THEN + (ONCE_REWRITE_TAC [lema3]) THEN (SIMP_TAC [PDI_DEF]) + ] +) +let SUC_ITERATE_POLYADD_LEMMA = prove( + `!n f .iterate (++) ((SUC n) INSERT (0..n)) f + = (f (SUC n)) ++ iterate (++) (0..n) f`, + let lem1 = ISPEC `poly_add` ITERATE_CLAUSES_GEN in + let lem2 = SIMP_RULE [MONOIDAL_POLY_ADD] lem1 in + let lem3 = CONJUNCT2 lem2 in + let lem4 = ISPECL [`f:(num -> (real)list)`;`SUC n`;`0..n`] lem3 in + let lem5 = ISPECL [`poly_add`;`f:(num -> (real)list)`;`0..n` ] FINITE_SUPPORT in + let lem6 = SIMP_RULE [FINITE_NUMSEG] lem5 in + let lem7 = MP lem4 lem6 in + let lem9 = SIMP_RULE [SPEC `0` SUC_NOT_IN_NUMSEG] lem7 in + ACCEPT_TAC (GEN_ALL lem9) +) +let NUMSEG_LENGTH_POLYDIFF_LEMMA = prove( + `!f. (0..(LENGTH f)) = ((LENGTH f) INSERT (0..(LENGTH (poly_diff f))))`, + (SIMP_TAC [LENGTH_POLY_DIFF]) THEN (LIST_INDUCT_TAC) THENL + [ (SIMP_TAC [LENGTH;PRE]) THEN (SIMP_TAC [NUMSEG_CLAUSES]) THEN + (SIMP_TAC [INSERT_DEF;NOT_IN_EMPTY;IN]); + (SIMP_TAC [LENGTH;PRE]) THEN + (SIMP_TAC [ARITH_RULE `0 <= SUC n`;NUMSEG_REC]) + ] +) +let POLY_DIFF_LENGTH_LT = prove( + `!p. (~(p=[])) ==> (LENGTH (poly_diff p)) < (LENGTH p)`, + SIMP_TAC [LENGTH_POLY_DIFF;LENGTH_EQ_NIL; + ARITH_RULE `!n.(~(n=0)) ==> (PRE n) < n`] +);; +let POLY_DIFF_LENGTH_LE_SUC = prove( + `! p n . (LENGTH p <= SUC n) ==> (LENGTH (poly_diff p) <= n)`, + (REPEAT STRIP_TAC) THEN (ASM_CASES_TAC `p:(real)list =[]`) THENL + [ (ASM_SIMP_TAC [poly_diff;LENGTH]) THEN (ARITH_TAC); + (ASM_MESON_TAC [POLY_DIFF_LENGTH_LT;LT_SUC_LE;LTE_TRANS]) + ] +) +let PDI_LENGTH_AUX = prove( + `! n p. (LENGTH p <= n) ==> poly_diff_iter p n = []`, + INDUCT_TAC THENL + [ MESON_TAC [PDI_DEF;LENGTH_EQ_NIL;ARITH_RULE `n <= 0 <=> n = 0`]; + ASM_MESON_TAC [PDI_DEF;PDI_POLY_DIFF_COMM;POLY_DIFF_LENGTH_LE_SUC] ] +) +let PDI_LENGTH_NIL = prove( + `! p . poly_diff_iter p (LENGTH p) = []`, + SIMP_TAC [PDI_LENGTH_AUX;LE_REFL] +) +let SOD_POLYDIFF_THEOREM = prove( + `!f .(SOD (poly_diff f)) = (poly_diff (SOD f))`, + let lemmmag = prove( + `0 INSERT (0..0) = (0..0)`, + (SIMP_TAC [NUMSEG_SING]) THEN + (SIMP_TAC [INSERT_DEF;NOT_IN_EMPTY;IN])) in + let SUC_LENGTH_CONS = prove( + `SUC (LENGTH (t:(real)list)) = (LENGTH (CONS h t))`, + (SIMP_TAC [LENGTH])) in + (ONCE_REWRITE_TAC [SOD]) THEN + (ONCE_REWRITE_TAC [SODN_POLY_DIFF_COMM]) THEN + (ONCE_REWRITE_TAC [SODN]) THEN + (STRIP_TAC) THEN + (CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [NUMSEG_LENGTH_POLYDIFF_LEMMA]))) THEN + (SPEC_TAC (`f:(real)list`,`f:(real)list`)) THEN + (LIST_INDUCT_TAC) THENL + [ (SIMP_TAC [poly_diff]) THEN + (SIMP_TAC [LENGTH]) THEN + (SIMP_TAC [SUM_SING_NUMSEG ]) THEN + (SIMP_TAC [lemmmag]) + ; + (SIMP_TAC [LENGTH_POLY_DIFF]) THEN + (SIMP_TAC [LENGTH;PRE]) THEN + (CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [SUC_ITERATE_POLYADD_LEMMA]))) THEN + (SIMP_TAC [LENGTH;PRE]) THEN + (SIMP_TAC [GSYM SODN]) THEN + (ONCE_REWRITE_TAC [GSYM SODN]) THEN + (ONCE_REWRITE_TAC [SUC_LENGTH_CONS]) THEN + (ONCE_REWRITE_TAC [PDI_LENGTH_NIL]) THEN + (SIMP_TAC [POLY_ADD_CLAUSES ]); + ] +) +let SOD_SOD_DIFF_LEMMA = prove( + `!f x.(poly (SOD f) x) - (poly (poly_diff (SOD f)) x) = poly f x`, + MESON_TAC [SOD_SOD_POLYDIFF; POLY_ADD ; POLY_SUB;SOD_POLYDIFF_THEOREM; + REAL_ARITH `((x:real) + y) -y = x`] +) + +let PLANETMATH_EQN_1_1_2 = prove( + `!f x. + ((exp (--x)) * ((poly (poly_diff (SOD f)) x) - (poly (SOD f) x))) + = (-- (exp (--x))) * (poly f x)`, + let lem17 = prove(`!x y.(x - y) = (-- (y - x))`,REAL_ARITH_TAC) in + (REPEAT STRIP_TAC) THEN + (ONCE_REWRITE_TAC [lem17]) THEN (ONCE_REWRITE_TAC [SOD_SOD_DIFF_LEMMA]) + THEN REAL_ARITH_TAC +) + +let PLANETMATH_EQN_1_1_3 = prove( + `! x f.((Phi f) diffl (-- (exp (--x)) * (poly f x)))(x)`, + (ONCE_REWRITE_TAC [GSYM PLANETMATH_EQN_1_1_2]) THEN (ACCEPT_TAC PLANETMATH_EQN_1_1_1) +) +let PHI_CONTL = + let lem0 = SPECL [`Phi f`;`-- (exp (--x)) * (poly f x)`;`x:real`] DIFF_CONT in + GEN_ALL (MP lem0 (SPEC_ALL PLANETMATH_EQN_1_1_3)) + +let PHI_DIFFERENTIABLE = prove( + `!f x.(Phi f) differentiable x`, + (SIMP_TAC [differentiable]) THEN (REPEAT STRIP_TAC) THEN + (EXISTS_TAC `((exp (--x)) * ((poly (poly_diff (SOD f)) x) - (poly (SOD f) x)))`) + THEN (SIMP_TAC [PLANETMATH_EQN_1_1_1]) +) +let PLANETMATH_EQN_1_2 = + (* this one's a bit nasty *) + let FO_LEMMA2 = GEN_ALL (prove( + `((! l z. (C (l:real) (z:real)) ==> l = (l' z))) ==> ((? (l:real) (z:real) .(A z) /\ (B z) /\ (C l z) /\ (D l) ) ==> (? (z:real).((A z) /\ (B z) /\ (D (l' z)))))`, + let lem0 = prove(`(! (l:real) z.(C l (z:real)) ==> l = (l' z)) ==> ((C l z) = ((C l z) /\ l = (l' z)))`, MESON_TAC[]) in + let lem1 = UNDISCH lem0 in + (STRIP_TAC THEN (ONCE_REWRITE_TAC [lem1]) THEN (MESON_TAC[])) + )) in + let PROP_LEMMA = TAUT `! a b c d.((a /\ b /\ c) ==> d) = (b ==> c ==> a ==> d)` in + let MVT_SPEC = SPECL [`Phi f`;`&0`;`x:real`] MVT in + let MVT_SPEC2 = ONCE_REWRITE_RULE [PROP_LEMMA] MVT_SPEC in + let MVT_SPEC3 = UNDISCH MVT_SPEC2 in + let MVT_SPEC4 = UNDISCH MVT_SPEC3 in + let MVT_SPEC5 = UNDISCH MVT_SPEC4 in + let lem0 = prove(`! x. x - &0 = x`,REAL_ARITH_TAC) in + let MVT_SPEC6 = ONCE_REWRITE_RULE [lem0] MVT_SPEC5 in + let DIFF_UNIQ_SPEC1 = SPEC `Phi f` DIFF_UNIQ in + let DIFF_UNIQ_SPEC2 = SPEC `l:real` DIFF_UNIQ_SPEC1 in + let DIFF_UNIQ_SPEC3 = SPEC ` (-- (exp (--x)) * (poly f x)) ` DIFF_UNIQ_SPEC2 in + let DIFF_UNIQ_SPEC4 = SPEC `x:real` DIFF_UNIQ_SPEC3 in + let lem8 = SIMP_RULE [PLANETMATH_EQN_1_1_3] DIFF_UNIQ_SPEC4 in + let lem9 = GENL [`l:real`;`x:real`] lem8 in + let lem10 = SPECL [`\l x.((Phi f diffl l) x)`;`\z.(&0) ? z. (Q z x f)) + = (! (x:real) (f:(real)list). ? (z:real). (P x) ==> (Q z x f))`, + MESON_TAC []) in + ((CONV_RULE SKOLEM_CONV) + (ONCE_REWRITE_RULE [FO_LEM] + (GEN_ALL (DISCH_ALL PLANETMATH_EQN_1_2))))) + +let PLANETMATH_LEMMA_1 = prove( + `!x f. &0 < x + ==> poly (SOD f) (&0) * exp x = + poly (SOD f) x + x * exp (x - xi x f) * poly f (xi x f)`, + let lemA = CONJUNCT2 (CONJUNCT2 (UNDISCH (SPEC_ALL xi_DEF))) in + let lemB = ONCE_REWRITE_RULE [PHI] lemA in + let lemC = ONCE_REWRITE_RULE [REAL_ARITH `((A:real) - B = C) = (B = A - C)`] lemB in + let lemD = SIMP_RULE [REAL_NEG_0;REAL_EXP_0;REAL_MUL_LID] lemC in + let lem01 = ASSUME `A = ((exp (-- x))*B - (C *( -- (exp (-- y))) * D))` in + let lem02 = DISJ2 `exp x = &0` lem01 in + let lem03 = REWRITE_RULE [GSYM (SPEC `exp x` REAL_EQ_MUL_LCANCEL)] lem02 in + let lem04 = SIMP_RULE [REAL_EXP_NEG_MUL;REAL_EXP_ADD_MUL] lem03 in + let lem05 = SIMP_RULE [REAL_SUB_LDISTRIB] lem04 in + let lem07 = SIMP_RULE [REAL_MUL_ASSOC;REAL_EXP_NEG_MUL;REAL_MUL_LID] lem05 in + let fact00 = REAL_ARITH `(B:real) - ((expx * C) * (--expy)) * D = B + C * (expx * expy) * D` in + let lem08 = ONCE_REWRITE_RULE [fact00] lem07 in + let lem09 = SIMP_RULE [GSYM REAL_EXP_ADD] lem08 in + let lem10 = SIMP_RULE [prove(`(x:real) + -- y = x - y`, REAL_ARITH_TAC)] lem09 in + let lem11 = GEN_ALL (DISCH_ALL lem10) in + let lem12 = SPECL [`poly (SOD f) (&0)`; + `poly (SOD f) x`; + `x:real`; + `x:real`; + `xi x f`; + `poly f (xi x f)`] lem11 in + let lem13 = MP lem12 lemD in + let lem14 = SPECL [`exp x`;`poly (SOD f) (&0)`] REAL_MUL_SYM in + ACCEPT_TAC (GEN_ALL (DISCH_ALL (ONCE_REWRITE_RULE [lem14] lem13))) +) + +end;; + +module Pm_lemma2 = struct + +let POLY_MCLAURIN = prove( + `! p x. poly p x = + psum (0, LENGTH p) (\m.poly (poly_diff_iter p m) (&0) / &(FACT m) * x pow m)`, + let lem002 = SPECL [`poly p`;`\n.poly (poly_diff_iter p n)`] MCLAURIN_ALL_LE in + let lem003 = SIMP_RULE [Pm_lemma1.PDI_DEF;POLY_DIFF] lem002 in + let lem004 = REWRITE_RULE [ETA_CONV `(\x.poly l x)`] POLY_DIFF in + let lem005 = MATCH_MP lem003 (GEN `m:num` (SPECL [`poly_diff_iter p m`] lem004)) in + let lem007 = SPECL [`x:real`;`LENGTH (p:(real)list)`] lem005 in + let lem008 = ONCE_REWRITE_RULE [Pm_lemma1.PDI_LENGTH_NIL] lem007 in + let lem009 = ONCE_REWRITE_RULE [poly] lem008 in + let lem010 = SIMP_RULE [REAL_ARITH `!x. ((&0)/x) = &0`] lem009 in + let lem011 = SIMP_RULE [REAL_MUL_LZERO;REAL_ADD_RID] lem010 in + let lem012 = prove(`(? t . (A t) /\ B) ==> B`, MESON_TAC []) in + ACCEPT_TAC (GEN_ALL (MATCH_MP lem012 lem011)) +) +let DIFF_ADD_CONST_COMMUTE = prove( + `!f a l x . (f diffl l) (x + a) ==> ((\x. f (x + a)) diffl l) x`, + let lem01 = CONJ (SPEC_ALL DIFF_X) (SPECL [`a:real`;`x:real`] DIFF_CONST) in + let lem02 = BETA_RULE (MATCH_MP DIFF_ADD lem01) in + let lem03 = ONCE_REWRITE_RULE [REAL_ARITH `&1 + &0 = &1`] lem02 in + let lem04 = SPECL [`f:real->real`;`\(x:real).((x + a)):real`;`l:real`;`&1`] DIFF_CHAIN in + let MUL_ONE = REAL_ARITH `! x.(&1) * x = x /\ x * (&1) = x` in + let lem05 = ONCE_REWRITE_RULE [MUL_ONE] (BETA_RULE lem04) in + let lem06 = GEN_ALL (SIMP_RULE [lem03] lem05) in + ACCEPT_TAC lem06 +) +let POLY_DIFF_ADD_CONST_COMMUTE = prove( + `! p1 p2 a.(!x.(poly p2 x) = (poly p1 (x-a))) + ==> (!x . ((poly (poly_diff p2) x) = (poly (poly_diff p1) (x-a))))`, + let lem01 = SPECL + [`\x.poly p1 x`;`-- a:real`;`l:real`;`x:real`] + DIFF_ADD_CONST_COMMUTE in + let lem02 = ONCE_REWRITE_RULE [REAL_ARITH `w + --v = w - v`] (BETA_RULE lem01) in + let lem03 = SPECL [`p1:(real)list`;`(x:real) -a`] POLY_DIFF in + let lem04 = MATCH_MP lem02 lem03 in + let lem05 = ASSUME `!x.poly p2 x = poly p1 (x - a)` in + let lem06 = ONCE_REWRITE_RULE [GSYM lem05] lem04 in + let lem07 = SPECL [`p2:(real)list`;`x:real`] POLY_DIFF in + let lem08 = MATCH_MP DIFF_UNIQ (CONJ lem07 lem06) in + (REPEAT STRIP_TAC) THEN (ACCEPT_TAC lem08) +) + +let HARD_WON = prove( + `! p1 p2 a n.(!x.(poly p2 x) = (poly p1 (x-a))) + ==> ((\x.poly (poly_diff_iter p2 n) x) = (\x.(poly (poly_diff_iter p1 n) (x - a)))) `, + let lem = SPECL [`poly_diff_iter p1 n`;`poly_diff_iter p2 n`;`a:real`] POLY_DIFF_ADD_CONST_COMMUTE in + let tm = `(!x . poly p2 x = poly p1 (x -a )) ==> + (\x.poly (poly_diff_iter p2 n) x) = (\x. poly (poly_diff_iter p1 n) (x - a))` in + (STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC ) THEN + (INDUCT_TAC) THENL + [ SIMP_TAC [Pm_lemma1.PDI_DEF] ; + STRIP_TAC THEN (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (UNDISCH_TAC tm) THEN + (ASM_REWRITE_TAC[FUN_EQ_THM]) THEN (ACCEPT_TAC lem) + ] +) +(* if f:real->real is a function, let us call the function g x = f (x+a), + * where a is a constant, a "shifting" of f by a. if f is defined by a poly, + * i.e. a (real)list, then (poly_shift f a) is the (real)list defining + * the shifting of f by a. + *) +let POLY_SHIFT_DEF = new_recursive_definition list_RECURSION + ` (poly_shift [] a = []) + /\ (poly_shift (CONS c t) a = + (CONS c (poly_shift t a)) ++ (a ## (poly_shift t a)))` + +(* POLY_SHIFT simply says that poly_shift does what is supposed to do + *) +let POLY_SHIFT = prove( + `! p a x .(poly p (x + a)) = (poly (poly_shift p a) x)`, + let lem01 = ASSUME `! a x . poly t (x + a) = poly (poly_shift t a ) x` in + LIST_INDUCT_TAC THENL + [ + (ONCE_REWRITE_TAC [POLY_SHIFT_DEF;poly]) THEN (SIMP_TAC [poly]); + (REPEAT STRIP_TAC) THEN (ONCE_REWRITE_TAC [POLY_SHIFT_DEF]) THEN + (ONCE_REWRITE_TAC [POLY_ADD]) THEN (ONCE_REWRITE_TAC [POLY_CMUL]) THEN + (ONCE_REWRITE_TAC [poly;GSYM lem01]) THEN + (ONCE_REWRITE_TAC [GSYM lem01]) THEN (REAL_ARITH_TAC) + ] +) +let POLY_SHIFT_LENGTH = prove( + `! p a . (LENGTH (poly_shift p a)) = (LENGTH p)`, + + (LIST_INDUCT_TAC) THENL + [ (SIMP_TAC [POLY_SHIFT_DEF]); + (SIMP_TAC [POLY_SHIFT_DEF]) THEN + (ASM_SIMP_TAC + [LENGTH;POLY_CMUL_LENGTH;POLY_ADD_LENGTH; + ARITH_RULE `MAX (x:num) y = if (x > y) then x else y`; + ARITH_RULE `! n. SUC n >n`]) + ] +) +let POLY_TAYLOR = prove( + `! p x a. poly p x = + psum (0,LENGTH p) (\m.poly (poly_diff_iter p m) a/ &(FACT m) * (x - a) pow m)`, + let lem01 = SPEC `poly_shift p a` POLY_MCLAURIN in + let lem02 = SPECL [`p:(real)list`;`poly_shift p a`;`-- a:real`;`n:num`] HARD_WON in + let lem03 = GSYM ( SPECL [`p:(real)list`;`a:real`] POLY_SHIFT) in + let lem04 = SIMP_RULE [REAL_ARITH `a - --b = a + b`] lem02 in + let lem05 = ONCE_REWRITE_RULE [ETA_AX] (MP lem04 lem03) in + let lem06 = BETA_RULE (ONCE_REWRITE_RULE [lem05] lem01) in + let lem07 = ONCE_REWRITE_RULE [REAL_ARITH `&0 + a = a`] lem06 in + let lem08 = ONCE_REWRITE_RULE [GSYM POLY_SHIFT] lem07 in + let lem09 = ONCE_REWRITE_RULE [POLY_SHIFT_LENGTH] lem08 in + let lem10 = RATOR_CONV (ONCE_REWRITE_CONV [REAL_ARITH `(x:real) = (x + a) - a`]) `x pow m` in + let lem11 = ONCE_REWRITE_RULE [lem10] lem09 in + let lem12 = SPEC `(x - a):real` lem11 in + let lem13 = ONCE_REWRITE_RULE [REAL_ARITH `(x:real) - a + a = x`] lem12 in + ACCEPT_TAC (GEN_ALL lem13 ) +) +let PLANETMATH_LEMMA_2_A = prove( + `! p a x . poly p x = + ((\s .psum (0,LENGTH p) ((\m.poly (poly_diff_iter p m) a/ &(FACT m) * (s m)))) + (\m.(x - a) pow m))`, + BETA_TAC THEN (MATCH_ACCEPT_TAC POLY_TAYLOR) +) +let ITERATE_SUC_REC = prove( + `!(op:D -> D -> D) m n (f:num -> D) . + monoidal op ==> + (m <= SUC n) ==> + iterate op (m..(SUC n)) f + = op (f (SUC n)) (iterate op (m..n) f)`, + let lem0 = UNDISCH_ALL (SPEC_ALL (GSYM NUMSEG_REC)) in + let lem1 = ISPEC `op:D -> D -> D` ITERATE_CLAUSES_GEN in + let lem2 = CONJUNCT2 (UNDISCH lem1) in + let lem3 = ISPECL [`f:(num -> D)`;`SUC n`;`m..n`] lem2 in + let lem4 = SIMP_RULE [] (DISCH_ALL lem3) in + let lem50 = prove( + `!m n. ~((SUC n) IN (m..n))`, + STRIP_TAC THEN (ONCE_REWRITE_TAC [IN_NUMSEG]) THEN ARITH_TAC) in + let lem5 = SIMP_RULE [lem50;FINITE_SUPPORT;FINITE_NUMSEG] lem4 in + let lem6 = ADD_ASSUM `m <= SUC n` lem5 in + let lem7 = ONCE_REWRITE_RULE [lem0] lem6 in + SIMP_TAC [lem7] +);; +let ITERATE_POLY_ADD_PRE_REC = prove( + `!f n . n > 0 + ==> iterate (++) (0..n) f = (f n) ++ (iterate (++) (0..n-1) f)`, + MESON_TAC [ITERATE_CLAUSES_NUMSEG; MONOIDAL_POLY_ADD; POLY_ADD_SYM; + ARITH_RULE `0 <= x`; ARITH_RULE `n > 0 ==> n = SUC (n - 1)`] +);; +let PSUM_ITERATE = prove( + `! n m f. psum (m,n) f + = if (n > 0) then (iterate (+) (m..((n+m)-1)) f) else &0`, + let lem01 = ARITH_RULE `~(n+m=0) ==> (SUC n + m) -1 = SUC ((n + m) -1)` in + let lem02 = MP (ISPEC `(+)` ITERATE_SING) MONOIDAL_REAL_ADD in + let lem03 = prove( + `iterate (+) (m..SUC ((n + m) - 1)) f + = f (SUC ((n+m)-1)) + iterate (+) (m..(n+m)-1) f`, + MESON_TAC [ARITH_RULE `m <= SUC ((n+m)-1)`;ITERATE_CLAUSES_NUMSEG; + MONOIDAL_REAL_ADD;REAL_ADD_SYM]) in + let lem04 = UNDISCH (UNDISCH (ARITH_RULE `~(n+m=0) ==> n=0 ==> m-1 < m`)) in + let lem05 = SIMP_RULE [lem04] (SPECL [`m:num`;`m-1`] NUMSEG_EMPTY) in + INDUCT_TAC THENL + [ SIMP_TAC [ARITH_RULE `~(0 > 0)`;sum_DEF]; + (SIMP_TAC [ARITH_RULE `(SUC n) > 0`]) THEN (REPEAT STRIP_TAC) THEN + (ASM_CASES_TAC `n + m =0`) THENL + [ (REWRITE_TAC [UNDISCH (ARITH_RULE `n + m = 0 ==> n = 0`)]) THEN + (REWRITE_TAC [lem02;NUMSEG_SING;ARITH_RULE `(SUC 0 +m) -1 = m`]) THEN + (MESON_TAC [sum_DEF; ADD_CLAUSES;REAL_ARITH `&0 + x = x`]) ; + (ONCE_REWRITE_TAC [sum_DEF;UNDISCH lem01]) THEN + (REWRITE_TAC [lem03]) THEN (ASM_CASES_TAC `n = 0`) THEN + (ASM_SIMP_TAC + [ARITH_RULE `~(0 > 0)`;ADD_CLAUSES;REAL_ADD_LID;REAL_ADD_RID; + lem05;ITERATE_CLAUSES_GEN; MONOIDAL_REAL_ADD;NEUTRAL_REAL_ADD; + REAL_ADD_SYM;ADD_SYM;ARITH_RULE `~(n=0) ==> n>0 /\ SUC (n-1) = n`]) + ] + ] +);; +let FACT_DIV_RCANCELS = prove( + `!n x. x / &(FACT n) * &(FACT n) = x`, + MESON_TAC [REAL_ARITH `!x. &0 < x ==> ~(x = &0)`; + REAL_DIV_RMUL;FACT_LT;REAL_OF_NUM_LT] +) +let PLANETMATH_LEMMA_2_B = prove( + `! p (x:real) a . poly (SOD p) a = + ((\s .psum (0,LENGTH p) ((\m.poly (poly_diff_iter p m) a/ &(FACT m) * (s m)))) + (\m. &(FACT m)))`, + let lem6 = ISPECL [`(\i.poly_diff_iter p i)`;`LENGTH (p:(real)list)`] + ITERATE_POLY_ADD_PRE_REC in + let lem7 = UNDISCH lem6 in + let lem8 = UNDISCH (ARITH_RULE `~(LENGTH (p:(real)list) > 0) ==> (LENGTH p = 0)`) in + let lem9 = ONCE_REWRITE_RULE [LENGTH_EQ_NIL] lem8 in + BETA_TAC THEN (REPEAT STRIP_TAC) THEN (ONCE_REWRITE_TAC [FACT_DIV_RCANCELS]) THEN + (ONCE_REWRITE_TAC [PSUM_ITERATE]) THEN (ASM_CASES_TAC `LENGTH (p:(real)list) > 0`) THENL + [ (ASM_SIMP_TAC [Pm_lemma1.SOD;Pm_lemma1.SODN;ITERATE_RADD_POLYADD;ARITH_RULE `x + 0 = x`]) THEN + (AP_THM_TAC) THEN (AP_TERM_TAC) THEN (SIMP_TAC [lem7;Pm_lemma1.PDI_LENGTH_NIL;POLY_ADD_CLAUSES]); + (ASM_SIMP_TAC []) THEN + (SIMP_TAC + [lem9;poly;Pm_lemma1.SOD;Pm_lemma1.SODN;NUMSEG_SING;MONOIDAL_POLY_ADD;ITERATE_SING;LENGTH;Pm_lemma1.PDI_DEF]) + ] +) +end;; + + +module Pm_eqn4 = struct + +let N_IS_INT = prove( + `!n . integer (&n)`, + MESON_TAC [is_int] +) +let NEG_N_IS_INT = prove( + `!n . integer (--(&n))`, + MESON_TAC [is_int] +);; +let PLANETMATH_EQN_3 = prove( + `!f. 0 < nu + ==> poly (SOD f) (&0) * exp (&nu) = + poly (SOD f) (&nu) + + &nu * exp (&nu - xi (&nu) f) * poly f (xi (&nu) f)`, + let RW = SPECL [`0`;`nu:num`] REAL_OF_NUM_LT in + ACCEPT_TAC (ONCE_REWRITE_RULE [RW] (SPEC `(&nu):real` Pm_lemma1.PLANETMATH_LEMMA_1)) +) +(* the RHS of PLANETMATH_EQN_4 + * TBD: mentioned in paper + *) +let LHS = new_definition + `LHS c f = sum (0..(PRE (LENGTH c))) (\i.(EL i c)*(poly (SOD f) (&i)))` + +(* the LHS of PLANETMATH_EQN_4 + * TBD: mentioned in paper + *) +let RHS = new_definition + `RHS c f = -- sum (1..(PRE (LENGTH c)) ) + (\i. (&i) + * (EL i c) + * (exp ((&i) - (xi (&i) f))) + * (poly f (xi (&i) f)) + )` + +let E_POW_N = prove( + `!n.(exp (real_of_num 1)) pow n = exp(&n)`, + SIMP_TAC [GSYM REAL_EXP_N;REAL_MUL_RID]) + + +(* The proof was originally done with a slightly different transcendental + * predicate than found in Harrison's 100/liouville.ml it turns out the difference + * is that &0 satisfies my transcendental! Thankfully, it is easy to show that + * e != 0, and hence the two notions of transcendence are equivalent for e. + * So that I could eliminate even brining my muddled definition of + * transcendental into the proof, this file ultimately proves + * E_TRANSCENDENTAL_EQUIV, which allows the main proof to only mention + * Harrison's transcendental predicate. + *) + +let NO_CONST_TERM_POLY_ROOT = prove( + `!p . (~(x = &0) /\ ((HD p) = &0) /\ (poly p x = &0) /\ ~(p = [])) + ==> ((poly (TL p) x) = &0)`, + LIST_INDUCT_TAC THEN + (ASM_SIMP_TAC [HD;TL;NOT_CONS_NIL;poly]) THEN + (MESON_TAC [REAL_ARITH `((&0):real) + x = x`;REAL_ENTIRE]) +) + +let NEGATED_POLY_ROOT = prove( + `!p . (poly p x = &0) ==> (poly ((-- &1) ## p) x = &0)`, + MESON_TAC [POLY_CMUL;REAL_ARITH `(-- &1) * ((&0):real) = &0`] +) + +(* changes a polynomial p to p/x^k, where k is the lowest power + * of x where p has a non-zero coefficient. This amounts to + * just stripping off all leading zeros from the head of the list p. + *) +let POLY_NUKE = new_recursive_definition list_RECURSION + ` (poly_nuk [] = []) + /\ (poly_nuk (CONS (c:real) t) = + (if (c = &0) then (poly_nuk t) else (CONS c t)))` + +let POLY_NUKE_ROOT = prove( + `!p . ((~(x = &0)) /\ (poly p x = &0)) ==> (poly (poly_nuk p) x = &0)`, + LIST_INDUCT_TAC THENL + [ SIMP_TAC[POLY_NUKE]; + (ASM_CASES_TAC `(h:real) = &0`) THEN + (ASM_MESON_TAC [HD;TL;POLY_NUKE;NOT_CONS_NIL;NO_CONST_TERM_POLY_ROOT]) + ] +) +let POLY_NUKE_ZERO = prove( + `!p . (poly p = poly []) <=> (poly (poly_nuk p) = poly [])`, + LIST_INDUCT_TAC THEN (ASM_MESON_TAC [POLY_ZERO;ALL;POLY_NUKE]) +) +let POLY_CONST_NO_ROOTS = prove( + `! c. ~(poly [c] = poly []) ==> ~(poly [c] x = &0)`, + (MESON_TAC [poly;REAL_ENTIRE;POLY_ZERO;ALL; + REAL_ARITH `(x:real) + &0 = x`; + REAL_ARITH `(x:real) * &0 = &0`]) +) +let LENGTH_1 = prove( + `! lst . (LENGTH lst = 1) <=> (? x. lst = [x])`, + LIST_INDUCT_TAC THEN + (MESON_TAC [LENGTH;ARITH_RULE `SUC x = 1 <=> x = 0`;NOT_CONS_NIL;LENGTH_EQ_NIL]) +) +let SOUP_LEMMA = prove( + `!p . ~(x = &0) /\ ~(poly p = poly []) /\ (poly p x = &0) + ==> LENGTH (poly_nuk p) > 1`, + let l0 = ARITH_RULE `(~(n = 0) /\ ~(n = 1)) <=> n > 1` in + let l1 = UNDISCH (UNDISCH (BRW1 (SPEC_ALL POLY_NUKE_ROOT))) in + (ONCE_REWRITE_TAC [GSYM l0]) THEN (REPEAT STRIP_TAC) THENL + [ (ASM_MESON_TAC [LENGTH;LENGTH_EQ_NIL;POLY_NUKE_ZERO]); + (ASM_MESON_TAC [l1;POLY_CONST_NO_ROOTS;LENGTH_1;LENGTH;POLY_NUKE_ZERO]) ] +) + +let POLY_NUKE_HD_NONZERO = prove( + `!p . ~(poly p = poly []) ==> ~((HD (poly_nuk p)) = &0)`, + LIST_INDUCT_TAC THEN (ASM_CASES_TAC `(h:real) = &0`) THEN + (ASM_SIMP_TAC [HD;POLY_ZERO;ALL;POLY_NUKE]) +) + +let IS_INT_POLY_NUKE = prove( + `!p . (ALL integer p) ==> (ALL integer (poly_nuk p))`, + LIST_INDUCT_TAC THEN (ASM_MESON_TAC [ALL;POLY_NUKE;N_IS_INT]) +) + +let POLY_X_NOT_POLY_NIL = prove( + `~(poly [&0;&1] = poly [])`, + (SIMP_TAC [FUN_EQ_THM;POLY_X;poly;prove(`(~ ! x .P x) <=> (? x. ~ P x)`,MESON_TAC[])] ) + THEN (EXISTS_TAC `real_of_num 1`) THEN (REAL_ARITH_TAC) +) + +let NOT_TRANSCENDENTAL_ZERO = prove( + `~ (transcendental (&0))`, + (REWRITE_TAC [transcendental;algebraic]) THEN + (EXISTS_TAC `[&0 ; &1]:(real)list`) THEN + (MESON_TAC [POLY_X;POLY_X_NOT_POLY_NIL;ALL;N_IS_INT]) +) + +let ALL_IS_INT_POLY_CMUL = prove( + `! p c. (integer c) /\ (ALL integer p) ==> (ALL integer (c ## p))`, + (LIST_INDUCT_TAC) THEN (ASM_SIMP_TAC [poly_cmul;ALL;INTEGER_MUL]) +) + +(* + * Harrison's transcendental predicate from 100/liouville.ml is equivalent + * to my predicate conjoined with x != 0. + *) +let TRANSCENDENTAL_MY_TRANSCENDENTAL = prove( + `!x. transcendental x <=> + (~(x = &0) /\ + ~ ? c. (ALL integer c) + /\ ((LENGTH c) > 1) + /\ ((poly c x) = &0) + /\ (HD c) > &0 )`, + let contra_pos = TAUT `(~X ==> ~Y /\ ~Z) <=> ((Y \/ Z) ==> X)` in + let contra_pos2 = TAUT `((~X /\ ~Y) ==> ~Z) <=> (Z ==> ~X ==> Y)` in + let l0 = prove(`!c . LENGTH c > 1 ==> HD c > &0 ==> ~(poly c = poly [])`, + LIST_INDUCT_TAC THEN + (ASM_MESON_TAC [LENGTH_EQ_NIL;ARITH_RULE `n > 1 ==> ~(n = 0)`; + REAL_ARITH `(x:real) > &0 ==> ~(x = &0)`; + HD;ALL;POLY_ZERO])) in + let witness = `if ((&0) <= (HD (poly_nuk p))) + then (poly_nuk p) + else ((-- &1) ## (poly_nuk p))` in + let l2 = REAL_ARITH `!(x:real). (&0 <= x) /\ ~(x = &0) ==> x > &0` in + let l3 = prove( `! c p. LENGTH (c ## p) = LENGTH p`, + STRIP_TAC THEN LIST_INDUCT_TAC THEN + (ASM_SIMP_TAC [poly_cmul;LENGTH])) in + let POLY_CMUL_HD = prove( + `! x p . (~(p = [])) ==> HD (x ## p) = x * (HD p)`, + STRIP_TAC THEN LIST_INDUCT_TAC THEN (SIMP_TAC [NOT_CONS_NIL;poly_cmul;HD]) + ) in + (REWRITE_TAC [transcendental;algebraic]) THEN + (STRIP_TAC THEN EQ_TAC) THENL + [ (ONCE_REWRITE_TAC [contra_pos]) THEN STRIP_TAC THENL + [ASM_MESON_TAC [transcendental;algebraic; NOT_TRANSCENDENTAL_ZERO]; + (EXISTS_TAC `c:(real)list`) THEN + (ASM_MESON_TAC [l0; NOT_TRANSCENDENTAL_ZERO ])]; + (REWRITE_TAC [contra_pos2]) THEN + (STRIP_TAC THEN STRIP_TAC) THEN (ASM_SIMP_TAC [IS_INT_POLY_NUKE]) THEN + (EXISTS_TAC witness) THEN + (ASM_CASES_TAC `((&0) <= (HD (poly_nuk p)))`) THEN + (ASM_MESON_TAC [ IS_INT_POLY_NUKE;ALL_IS_INT_POLY_CMUL;NEG_N_IS_INT; + l2;POLY_NUKE_HD_NONZERO;NEGATED_POLY_ROOT;SOUP_LEMMA; + l3;POLY_NUKE_ROOT;POLY_NUKE_ZERO;POLY_CMUL_HD; + REAL_ARITH `~(&0 <= (x:real)) <=> ((-- &1) * x) > &0`]) + ] +) + +let E_TRANSCENDENTAL_EQUIV = prove( + `(transcendental (exp (&1))) <=> + (~ ? c. (ALL integer c) + /\ ((LENGTH c) > 1) + /\ ((poly c (exp (&1))) = &0) + /\ (HD c) > &0 )`, + MESON_TAC[TRANSCENDENTAL_MY_TRANSCENDENTAL; + REAL_EXP_POS_LT; REAL_ARITH `&0 < (x:real) ==> ~(&0 = x)`] +) + +(* TBD mentionedin paper *) +let PLANETMATH_EQN_4 = prove( + `(~ (transcendental (exp (&1)))) ==> ? c . + ((ALL integer c) /\ ((LENGTH c) > 1) /\ ((EL 0 c) > &0) /\ (! f .((LHS c f) = (RHS c f))))`, + let foo2 = prove( `(HD c) > (real_of_num 0) ==> EL 0 c > &0`,SIMP_TAC [EL]) in + let lem01 = SPECL [`f:num->real`;`0`;`0`;`PRE (LENGTH (c:(real)list))`] SUM_COMBINE_R in + let lem02 = ARITH_RULE `(0 <= 0 + 1 /\ 0 <= (PRE (LENGTH (c:(real)list))))` in + let lem03 = GSYM (MP lem01 (lem02) ) in + let lem06 = ISPECL [`f1:num->real`; + `f2:num->real`; + `1`;`(PRE (LENGTH (c:(real)list)))`] SUM_ADD in + let new0 = SPECL [`f:num->real`;`1`;`PRE (LENGTH (c:(real)list))`] PSUM_SUM_NUMSEG in + let new1 = SIMP_RULE [ARITH_RULE `~(1 = 0)`;ARITH_RULE `(1 + x) -1 = x`] new0 in + let new2 = ONCE_REWRITE_RULE [new1] lem06 in + let lem001 = REAL_ARITH `((A:real) * B * C * D + B * E) = (B * (A * C * D + E))` in + let lem0 = REAL_ARITH `(x:real) = x * (&1) - (&0) * y` in + let lem1 = GEN_ALL (ONCE_REWRITE_RULE [GSYM REAL_EXP_0] lem0) in + let lem2 = SPECL [`poly (SOD f) (&0)`; + ` exp (&0 - xi (&0) f) * poly f (xi (&0) f)`] lem1 in + let PLANETMATH_EQN_3_TWEAKED = + REWRITE_RULE + [REAL_ARITH `((A:real) = B+C) <=> (B = A -C)`] + PLANETMATH_EQN_3 + in + let lem21 = GEN `nu:num` (SPEC_ALL PLANETMATH_EQN_3_TWEAKED) in + let lem3 = CONJ lem21 lem2 in + let NUM_CASES_LEMMA = prove( + ` !P .((! n .(0 < n) ==> (P n)) /\ (P 0) ==> ! n . P n)`, + (REPEAT STRIP_TAC) THEN (SPEC_TAC (`n:num`,`n:num`)) THEN + INDUCT_TAC THEN (ASM_SIMP_TAC[]) THEN + (ASM_SIMP_TAC [ARITH_RULE `0 < (SUC n)`])) in + let lem4 = SPEC `(\nu.poly (SOD f) (&nu) = poly (SOD f) (&0) * exp (&nu) - &nu * (exp ((&nu) - xi (&nu) f)) * poly f (xi (&nu) f))` NUM_CASES_LEMMA in + let lem5 = BETA_RULE lem4 in + let lem6 = MP lem5 lem3 in + let lem100 = + SIMP_RULE + [ARITH_RULE `!n.0 <= n`;ARITH_RULE `(0:num) + 1 = 1`] + (ISPECL [`f:num->real`;`0`;`0`;`PRE (LENGTH (c:(real)list))`] SUM_COMBINE_R) in + let lem0001 = ASSUME `LENGTH (c:(real)list) > 1` in + let lem0002 = MATCH_MP (ARITH_RULE `(x:num) > 1 ==> ~(x=0)`) lem0001 in + let lem0003 = REWRITE_RULE [LENGTH_EQ_NIL] lem0002 in + let lem0004 = MATCH_MP POLY_SUM_EQUIV lem0003 in + let SUM_LMUL_NUMSEG = GEN_ALL (ISPECL [`f:num->real`;`c:real`;`n..m`] SUM_LMUL) in + (ONCE_REWRITE_TAC [E_TRANSCENDENTAL_EQUIV]) THEN + (ONCE_REWRITE_TAC [LHS;RHS]) THEN + (REPEAT STRIP_TAC) THEN + (EXISTS_TAC `c:(real)list`) THEN + (ONCE_REWRITE_TAC [GSYM REAL_RNEG_UNIQ]) THEN + (ONCE_REWRITE_TAC [lem03]) THEN + (ONCE_REWRITE_TAC [NUMSEG_CONV `0..0`]) THEN + (ONCE_REWRITE_TAC [SUM_SING] ) THEN + (ASM_SIMP_TAC[foo2]) THEN + (BETA_TAC) THEN + (ONCE_REWRITE_TAC [ARITH_RULE `0 + 1 = 1`] ) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(A:real) + B + C = (A + C) + B`] ) THEN + (ONCE_REWRITE_TAC [GSYM new2]) THEN + (BETA_TAC) THEN + (ONCE_REWRITE_TAC [lem001]) THEN + (CONV_TAC ((RAND_CONV o ABS_CONV o RATOR_CONV o RAND_CONV o RATOR_CONV) (PURE_ONCE_REWRITE_CONV [lem6]))) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(A:real) + B - A = B`]) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(EL 0 c) * (poly (SOD f) (&0)) = (EL 0 c) * (poly (SOD f) (&0)) * (&1)`]) THEN + (ONCE_REWRITE_TAC [GSYM REAL_EXP_0]) THEN + (ONCE_REWRITE_TAC [GSYM (BETA_CONV `(\x.(EL x c) * (poly (SOD f) (&0)) * exp (&x)) (0)`)]) THEN + (ONCE_REWRITE_TAC [GSYM (ISPEC `\x.(EL x c) * (poly (SOD f) (&0)) * exp (&x)` SUM_SING)]) THEN + (ONCE_REWRITE_TAC [GSYM (NUMSEG_CONV `0..0`)]) THEN + (ONCE_REWRITE_TAC [REAL_ADD_AC]) THEN + (ONCE_REWRITE_TAC [lem100]) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(A:real) * B * C = B * A * C`]) THEN + (ONCE_REWRITE_TAC [ SUM_LMUL_NUMSEG ]) THEN + (ONCE_REWRITE_TAC [GSYM E_POW_N]) THEN + (ONCE_REWRITE_TAC [GSYM lem0004]) THEN + (ASM_SIMP_TAC[]) THEN + (REAL_ARITH_TAC) + ) + +end;; + +module Pm_eqn5 = struct + +let POLY_MUL_ITER = new_recursive_definition num_RECURSION + `(poly_mul_iter f 0 = [&1]) /\ + (!n . poly_mul_iter f (SUC n) = (f (SUC n)) ** (poly_mul_iter f n))` + +let PLANETMATH_EQN_5 = + new_definition + `g n p = (&1/(&(FACT (p -1)))) ## + ((poly_exp [&0;&1] (p-1)) ** + (poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p))` + +end;; + + + +module Pm_eqn4_rhs = struct + +let ABS_LE_MUL2 = prove( + `!(w:real) x y z. abs(w) <= y /\ abs(x) <= z ==> abs(w * x) <= (y * z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[ABS_POS]) + +let SEPTEMBER_2009_LEMMA = prove( + `!x f n n'. + (!i.(0 <= i /\ i <= n) ==> (abs (poly (f i) x)) <= &(n')) ==> + (abs (poly (poly_mul_iter f n) x)) <= (&(n') pow n)`, + let lem0 = ASSUME `!i. 0 <= i /\ i <= SUC n ==> abs (poly (f i) x) <= &n'` in + let lem1 = SPEC `SUC n` lem0 in + let lem2 = SIMP_RULE [ARITH_RULE `0 <= SUC n /\ SUC n <= SUC n`] lem1 in + let lem3 = prove(`(!i:num.(P0 i) ==> (P1 i)) ==> (!i:num.((P1 i) ==> (Q i))) ==> (!i:num.((P0 i) ==> (Q i)))`, MESON_TAC[]) in + let lem4 = ARITH_RULE `!i.(0 <= i /\ i <= n) ==> (0 <= i /\ i <= SUC n)` in + let lem5 = GEN `Q:num->bool` (MATCH_MP lem3 lem4) in + let lem6 = ASSUME `!n'. (!i. 0 <= i /\ i <= n ==> abs (poly (f i) x) <= &n') ==> abs (poly (poly_mul_iter f n) x) <= &n' pow n` in + let lem7 = SPEC `n':num` lem6 in + let lem9 = UNDISCH (BETA_RULE (SPEC `\i. abs (poly (f (i:num)) x) <= &n'` lem5)) in + let lem11 = MP (lem7) (lem9) in + STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL + [ (REWRITE_TAC ([Pm_eqn5.POLY_MUL_ITER;poly;real_pow]@rewrites0)) + THEN (REAL_ARITH_TAC); + (STRIP_TAC) THEN (STRIP_TAC) THEN + (REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER;POLY_MUL;real_pow]) THEN + (MATCH_MP_TAC ABS_LE_MUL2) THEN + (SIMP_TAC [lem2;lem11]) + ] +) +let SEPTEMBER_2009_LEMMA_2 = prove( + `&0 < x /\ x < &n + ==> (!i. 0 <= i /\ i <= n ==> abs(poly [-- &i; &1] x) <= &n)`, + (REWRITE_TAC [GSYM REAL_LE]) THEN (REPEAT STRIP_TAC) THEN + (REWRITE_TAC ([poly]@rewrites0)) THEN + (REWRITE_TAC [REAL_ARITH `&0 <= -- &i + (x:real) <=> &i <= x`;real_abs]) THEN (ASM_CASES_TAC `&i <= (x:real)`) THENL + [ (ASM_SIMP_TAC []) THEN + (REWRITE_TAC [REAL_ARITH `-- &i + (x:real) = x - &i `]) THEN + (ASM_REAL_ARITH_TAC); + (ASM_SIMP_TAC []) THEN + (REWRITE_TAC [REAL_ARITH `--(-- &i + (x:real)) = &i - x `]) THEN + (ASM_REAL_ARITH_TAC) + ] +) + +let FACT_DIV_LCANCELS = prove( + `!n x. &(FACT n) * x / &(FACT n) = x`, + let lem0 = SPECL [`0`;`FACT n`] REAL_OF_NUM_LT in + let lem1 = ONCE_REWRITE_RULE [GSYM lem0] FACT_LT in + let lem2 = SPECL [`x:real`;`(&(FACT n)):real`] REAL_DIV_LMUL in + let lem3 = REAL_ARITH `!x:real. &0 < x ==> ~(x = &0)` in + let lem4 = MATCH_MP lem3 (SPEC_ALL lem1) in + ACCEPT_TAC (GEN_ALL (MP lem2 lem4)) +) +let NOVEMBER_LEMMA_1 = prove( + `p > 1 ==> + &0 < x /\ x < &n ==> + (abs(poly (g n p) x)) <= + (&1/(&(FACT (p -1)))) * ((&n) pow (p - 1)) * ((&n pow n) pow p)`, + let l0 = SPECL [`0`;`FACT (p-1)`] REAL_OF_NUM_LT in + let l2 = snd (EQ_IMP_RULE l0) in + let l3 = MP l2 (SPEC `(p:num) - 1` FACT_LT) in + let l4 = SPEC `(&(FACT (p - 1))):real` REAL_LE_LCANCEL_IMP in + let l5 = SIMP_RULE [l3] l4 in + let ll0 = snd (EQ_IMP_RULE (SPEC_ALL REAL_ABS_REFL)) in + let ll1 = IMP_TRANS (REAL_ARITH `(&0):real < x ==> &0 <= x`) ll0 in + let ll2 = UNDISCH ll1 in + let asses = [`(p:num) > 1`;`&0 < (x:real)`; `(x:real) < &n`] in + let j0 = SPECL [`p - 1`;`x:real`;`(&n):real`] REAL_POW_LE2 in + let j1 = REAL_ARITH `(&0) < (x:real) /\ x < (&n) ==> (&0 <=x /\ x <= (&n))` in + let j2 = UNDISCH_ALL (BRW1 (IMP_TRANS j1 j0)) in + let ll4 = SPECL [`(x:real) pow (p - 1)`;`((&n):real) pow (p - 1)`;`(abs (r:real)) pow p`] REAL_LE_MUL2 in + let ll5 = (SPECL [`x:real`;`(p:num) - 1`] REAL_POW_LE) in + let ll50 = UNDISCH (IMP_TRANS (REAL_ARITH `&0 < x ==> (&0) <= (x:real)`) ll5;) in + let ll6 = ADD_ASSUMS asses ll4 in + let ll7 = REAL_ARITH `(x:real) < y ==> x <= y` in + let ll8 = SIMP_RULE [j2;ll50;ll7;REAL_POW_LE;REAL_ABS_POS] ll6 in + let ll9 = ADD_ASSUM `p > 1` (SPEC `p:num` REAL_POW_LE2) in + let ll10 = UNDISCH (ARITH_RULE `p > 1 ==> ~(p = 0)`) in + let ll11 = SIMP_RULE [ll10] ll9 in + let ll12 = SPEC `abs (r:real)` ll11 in + let ll13 = SIMP_RULE [REAL_ABS_POS] ll12 in + let lem0 = UNDISCH (UNDISCH (BRW1 SEPTEMBER_2009_LEMMA_2)) in + let lem1 = MATCH_MP SEPTEMBER_2009_LEMMA lem0 in + let lem2 = DISCH_ALL (DISCH `(&0) < (x:real)` lem1) in + let lem3 = SPEC `SUC n` (GEN (`n:num`) lem2) in + (STRIP_TAC) THEN (STRIP_TAC) THEN + (ONCE_REWRITE_TAC [Pm_eqn5.PLANETMATH_EQN_5]) THEN + (ONCE_REWRITE_TAC [POLY_CMUL]) THEN + (ONCE_REWRITE_TAC [POLY_MUL]) THEN + (ONCE_REWRITE_TAC [POLY_EXP]) THEN + (ONCE_REWRITE_TAC [poly]) THEN + (ONCE_REWRITE_TAC [poly]) THEN + (ONCE_REWRITE_TAC [poly]) THEN + (REWRITE_TAC rewrites0) THEN + (ONCE_REWRITE_TAC [REAL_ABS_MUL]) THEN + (ONCE_REWRITE_TAC [REAL_ABS_MUL]) THEN + (ONCE_REWRITE_TAC [REAL_ABS_POW]) THEN + (ONCE_REWRITE_TAC [REAL_ABS_DIV]) THEN + (ONCE_REWRITE_TAC [ABS_N]) THEN + (MATCH_MP_TAC l5) THEN + (ONCE_REWRITE_TAC [REAL_MUL_ASSOC]) THEN + (SIMP_TAC [FACT_DIV_LCANCELS;REAL_ARITH `&1 * (x:real) = x`]) THEN + (SIMP_TAC [ll2]) THEN + (MATCH_MP_TAC ll8) THEN + (MATCH_MP_TAC ll13) THEN + (UNDISCH_TAC `&0 < (x:real)`) THEN + (UNDISCH_TAC `(x:real) < &n`) THEN + (SPEC_TAC (`n:num`,`n:num`)) THEN + INDUCT_TAC THENL [(REAL_ARITH_TAC); (ACCEPT_TAC lem3)] +) + +let NOVEMBER_LEMMA_2 = prove( + ` 1 <= v /\ v <= n + ==> ((&0) < ( xi (&v) f) /\ (xi (&v) f) < (&n))`, + let l0 = SPECL [`(&v):real`;`f:(real)list`] Pm_lemma1.xi_DEF in + let l1 = UNDISCH (ONCE_REWRITE_RULE [REAL_OF_NUM_LT] l0) in + let [l2;l3;_] = CONJUNCTS l1 in + let l4 = GEN_ALL (REAL_ARITH `(&v) <= y ==> z < (&v) ==> (z:real) < y`) in + let l6 = SPECL [`v:num`;`z:real`;`(&n):real`] l4 in + let l7 = UNDISCH l6 in + (ONCE_REWRITE_TAC [ TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`;ARITH_RULE `1 <= v <=> 0 < v` ]) THEN + (ONCE_REWRITE_TAC [GSYM REAL_OF_NUM_LE;GSYM REAL_OF_NUM_LT]) THEN + (STRIP_TAC) THEN (STRIP_TAC) THEN (SIMP_TAC [l2]) THEN + (MATCH_MP_TAC l7) THEN (ACCEPT_TAC l3) +) + +let REAL_LE_MUL3 = prove( + `! w0 x0 y0 w1 x1 (y1:real). + (&0 <= w0) ==> (&0 <= x0) ==> (&0 <= y0) ==> + (w0 <= w1) ==> (x0 <= x1) ==> (y0 <= y1) ==> + (w0 * x0 * y0) <= (w1 * x1 * y1)`, + let lst = [`w0:real`;`w1:real`;`(x0 * y0):real`;`(x1 * y1):real`] in + let c0 = SPECL lst REAL_LE_MUL2 in + MESON_TAC [c0;REAL_LE_MUL2;REAL_LE_MUL] +) + +let MAX_ABS_DEF = + new_recursive_definition list_RECURSION + ` (max_abs [] = &0) + /\ (max_abs (CONS h t) = real_max (real_abs h) (max_abs t))` + +let MAX_ABS_LE = prove( + `! cs i. + (0 <= i /\ i < (LENGTH cs) ==> + (real_abs (EL i cs)) <= (max_abs cs))`, + let l0 = UNDISCH (REAL_ARITH `~((abs h) <= max_abs t) ==> x <= (max_abs t) ==> x <= (abs h)`) in + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; + INDUCT_TAC THENL + [ (SIMP_TAC [HD;EL;MAX_ABS_DEF;REAL_MAX_MAX]); + (SIMP_TAC [TL;EL;MAX_ABS_DEF;REAL_MAX_MAX;LENGTH;LT_SUC]) THEN + (ASM_CASES_TAC `(real_abs h) <= (max_abs t)`) THEN + (ASM_SIMP_TAC [real_max;ARITH_RULE `0 <= y`;l0]) + ] + ] +) +let KEATS_PART_1 = prove( + `1 <= i /\ i <= PRE (LENGTH c) ==> ( &i * abs (EL i c) <= &i * max_abs c)`, + let keats12 = ARITH_RULE `1 <= i /\ i <= (PRE (LENGTH (c:(real)list))) ==> (0 <= i /\ i < LENGTH c)` in + let keats13 = IMP_TRANS keats12 (SPECL [`c:(real)list`;`i:num`] MAX_ABS_LE) in + let keats14 = SPECL [`real_of_num i`] REAL_LE_LMUL in + let keats15 = ARITH_RULE `(&0) <= (real_of_num i)` in + let keats16 = SIMP_RULE [keats15] keats14 in + let keats17 = UNDISCH keats13 in + let keats18 = MATCH_MP keats16 keats17 in + ACCEPT_TAC (DISCH_ALL keats18) +) +let KEATS_PART_2 = prove( + `(1 <= v /\ v <= PRE (LENGTH (c:(real)list))) ==> + abs (exp ((&v) - xi (&v) (g (PRE (LENGTH c)) p))) <= abs (exp (&(PRE (LENGTH (c:(real)list)))))`, + let j0 = ASSUME `1 <= v /\ (v:num) <= (PRE (LENGTH (c:(real)list)))` in + let j00 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_LE] (CONJUNCT2 j0) in + let j1 = REAL_ARITH `!n .(real_of_num v <= &n) ==> (&0 > --xi (&v) (g n p)) ==> (&n) > (&v) - (xi (&v) (g n p))` in +let j2 = MP (SPEC `PRE (LENGTH (c:(real)list))` j1) j00 in + let g_term = `g (PRE (LENGTH (c:(real)list))) p` in + let k33 = SPEC `PRE (LENGTH (c:(real)list))` (GEN `n:num` NOVEMBER_LEMMA_2) in + let k34 = SPEC g_term (GEN `f:(real)list` k33) in + let k35 = DISCH `1 <= v /\ v <= (PRE (LENGTH (c:(real)list)))` (CONJUNCT1 (UNDISCH k34)) in + let k36 = UNDISCH (SPEC `PRE (LENGTH (c:(real)list))` (GEN `n:num` k35)) in + let k37 = REAL_ARITH `!x. (real_of_num 0) < x ==> (real_of_num 0) > -- x` in + let k38 = MATCH_MP k37 k36 in + let k40 = MP j2 k38 in + let k41 = REAL_ARITH `!x (y:real).x > y ==> y <= x` in + let k42 = MATCH_MP k41 k40 in + let k42 = ONCE_REWRITE_RULE [GSYM REAL_EXP_MONO_LE] k42 in + let k43 = REAL_ARITH `!(x:real) . (&0) <= x ==> abs x = x` in + let k44 = GEN `x:real` (MATCH_MP k43 (SPEC `x:real` REAL_EXP_POS_LE)) in + let k45 = ONCE_REWRITE_RULE [GSYM k44] k42 in + let k46 = DISCH_ALL k45 in + let k47 = BRW0 (SIMP_RULE [ARITH_RULE `0 < v <=> 1 <= v`] k46) in + ACCEPT_TAC k47 +) +let KEATS_PART_3 = + UNDISCH + (prove( + `p > 1 ==> (1 <= i /\ i <= PRE (LENGTH (c:(real)list))) + ==> abs (poly (g (PRE (LENGTH c)) p) (xi (&i) (g (PRE (LENGTH c)) p))) <= + &1 / &(FACT (p - 1)) * + &(PRE (LENGTH c)) pow (p - 1) * + &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p`, + let k0 = UNDISCH NOVEMBER_LEMMA_2 in + let k1 = UNDISCH NOVEMBER_LEMMA_1 in + let k2 = GEN `x:real` k1 in + let k3 = SPEC `xi (real_of_num i) f` k2 in + let k5 = MATCH_MP k3 k0 in + let g_term = `g (PRE (LENGTH (c:(real)list))) p` in + let k6 = SPEC g_term (GEN `f:(real)list` k5) in + let k7 = SPEC `PRE (LENGTH (c:(real)list))` (GEN `n:num` (DISCH `1 <= v /\ v <= n` k6)) in + let k8 = DISCH `0 < v` k7 in + let k9 = BRW0 (SIMP_RULE [ARITH_RULE `0 < v <=> 1 <= v`] k8) in + MATCH_ACCEPT_TAC (DISCH_ALL k9) +)) + +let RHS_4_F5_LE_SUM = prove( + `abs (RHS c (g (PRE (LENGTH c)) p)) <= + sum (1..PRE (LENGTH c)) + (\i. &i * + abs (EL i c) * + abs (exp (&i - xi (&i) (g (PRE (LENGTH c)) p))) * + abs + (poly (g (PRE (LENGTH c)) p) (xi (&i) (g (PRE (LENGTH c)) p))))`, + let keats4 = REFL `abs (RHS c f)` in + let keats5 = (CONV_RULE (RAND_CONV (REWRITE_CONV [Pm_eqn4.RHS]))) keats4 in + let keats6 = REWRITE_RULE [REAL_ABS_NEG] keats5 in + let keats7 = + SPECL [`(\i.(&i) * (EL i c) * (exp (&i - (xi (&i) f))) * (poly f (xi + (&i) f)))`;`1`;`PRE (LENGTH (c:(real)list))`] SUM_ABS_NUMSEG in + let keats8 = ONCE_REWRITE_RULE [GSYM keats6] keats7 in + let keats9 = REWRITE_RULE [REAL_ABS_NUM;REAL_ABS_MUL] keats8 in + let g_term = `g (PRE (LENGTH (c:(real)list))) p` in + let keats10 = SPEC g_term (GEN `f:(real)list` keats9) in + ACCEPT_TAC keats10 +) + + +let RHS_4_BOUND_PRE = prove( + `abs (RHS c (g (PRE (LENGTH c)) p)) <= + (sum (1..PRE (LENGTH c)) &) * + (max_abs c * + abs (exp (&(PRE (LENGTH c)))) * + &1 / &(FACT (p - 1)) * + &(PRE (LENGTH c)) pow (p - 1) * + &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p)`, + let w0 = `(real_of_num i) * (real_abs (EL i c))` in + let w1 = `(real_of_num i) * (max_abs c)` in + let x0 = `abs (exp (&v - xi (&v) (g (PRE (LENGTH (c:(real)list))) p)))` + in + let x1 = `abs (exp (&(PRE (LENGTH (c:(real)list)))))` in + let y0 = `abs (poly (g (PRE (LENGTH (c:(real)list))) p) (xi (&i) (g (PRE + (LENGTH c)) p)))` in + let y1 = ` &1 / &(FACT (p - 1)) * &(PRE (LENGTH (c:(real)list))) pow (p - + 1) * &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p` in + let rename_free_var oo nn tt = SPEC nn (GEN oo tt) in + let v2i tt = rename_free_var `v:num` `i:num` tt in + let josh0 = SPECL [w0;x0;y0;w1;x1;y1] REAL_LE_MUL3 in + let josh2 = SPECL [`real_of_num i`;`real_abs (EL i c)`] REAL_LE_MUL in + let josh3 = SIMP_RULE [REAL_ABS_POS;REAL_ARITH `(real_of_num 0) <= &i`] josh2 + in + let josh4 = v2i (SIMP_RULE [josh3;REAL_ABS_POS] josh0) in + let josh5 = SIMP_RULE [UNDISCH KEATS_PART_1] josh4 in + let josh6 = SIMP_RULE [UNDISCH (v2i KEATS_PART_2)] josh5 in + let josh7 = SIMP_RULE [UNDISCH KEATS_PART_3] josh6 in + let josh8 = DISCH `1 <= i /\ i <= (PRE (LENGTH (c:(real)list)))` josh7 in + let f0 = `(\i. + &i * + abs (EL i c) * + abs (exp (&i - xi (&i) (g (PRE (LENGTH c)) p))) * + abs (poly (g (PRE (LENGTH c)) p) (xi (&i) (g (PRE (LENGTH c)) + p))))` in + let f1 = `(\i. + (&i * max_abs c) * + abs (exp (&(PRE (LENGTH c)))) * + &1 / &(FACT (p - 1)) * + &(PRE (LENGTH c)) pow (p - 1) * + &(PRE (LENGTH c)) pow PRE (LENGTH c) pow p)` in + let josh9 = SPECL [f0;f1;`1`;`PRE (LENGTH (c:(real)list))`] SUM_LE_NUMSEG + in + let josh10 = REWRITE_RULE [GSYM REAL_MUL_ASSOC] (BETA_RULE josh9) in + let josh11 = REWRITE_RULE [GSYM REAL_MUL_ASSOC] (GEN `i:num` josh8) in + let josh12 = MP josh10 josh11 in + let josh13 = CONJ RHS_4_F5_LE_SUM josh12 in + let josh14 = MATCH_MP REAL_LE_TRANS josh13 in + let josh15 = ONCE_REWRITE_RULE [SUM_RMUL] josh14 in + ACCEPT_TAC josh15 +) + +(* A reviewer of the Journal of Formalized Reasoning paper for this proof + * pointed out that the "abs" in "abs (exp (&(PRE (LENGTH c))))" of + * RHS_4_BOUND_PRE is redundant. So here that theorem is rewritten to + * remove that abs. + *) +let RHS_4_BOUND = + let l1 = MATCH_MP (SPEC `&0:real` REAL_LT_IMP_LE) + (SPEC `x:real` REAL_EXP_POS_LT) in + let l2 = REWRITE_RULE [GSYM REAL_ABS_REFL] l1 in + ONCE_REWRITE_RULE [l2] RHS_4_BOUND_PRE +;; + +let JESSE_POW_LEMMA = prove( + `(p:num) > 1 ==> !x.real_pow x p = x * (real_pow x (p-1))`, + let c0 = UNDISCH (ARITH_RULE `(p:num) > 1 ==> p = SUC (p - 1) `) in + STRIP_TAC THEN STRIP_TAC THEN + (CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [c0]))) THEN + (SIMP_TAC [real_pow]) +) +let JESSE_REAL_ABS_LE = prove( + `!(x:real) y.(abs x) <= y ==> (abs x) <= (abs y)`, + let int10 = UNDISCH (REAL_ARITH `(real_abs x) <= y ==> y = real_abs y`) in + (REPEAT STRIP_TAC) THEN (ASM_SIMP_TAC [GSYM int10]) +) +let OLDGERMAN_LEMMA = prove( + ` !C2 C e. + &0 < e + ==> (?N . !n. n >= N ==> + abs (C2 * inv (&(FACT n)) * C pow n - &0) < e)`, + let w0 = MATCH_MP SUM_SUMMABLE (SPEC `C:real` REAL_EXP_CONVERGES) in + let w1 = MATCH_MP SER_ZERO w0 in + let w2 = BETA_RULE w1 in + let w3 = SPEC `C2:real` SEQ_CONST in + let w4 = CONJ w3 w2 in + let w5 = BETA_RULE (MATCH_MP SEQ_MUL w4) in + let w6 = ONCE_REWRITE_RULE [REAL_ARITH `(C2:real) * (&0) = &0`] w5 in + let w7 = ONCE_REWRITE_RULE [SEQ] w6 in + let w8 = GEN_ALL (BETA_RULE w7) in + (REPEAT STRIP_TAC) THEN + (CHOOSE_TAC (UNDISCH (SPEC_ALL w8))) THEN + (EXISTS_TAC `SUC N`) THEN + (ASM_SIMP_TAC [ARITH_RULE `n' >= SUC n ==> n' >= n`]) +) + +let RHS_4_LT_ONE_MESSY = prove( + `?p0. !p. p > 1 ==> p> p0 ==> abs (RHS c (g (PRE (LENGTH c)) p)) < &1`, + let c1 = ONCE_REWRITE_RULE [ UNDISCH JESSE_POW_LEMMA ] RHS_4_BOUND in + let c2 = SPECL [`real_pow (&(PRE (LENGTH (c:(real)list)))) (p-1)`] + REAL_MUL_SYM in + let c3 = ONCE_REWRITE_RULE [ c2] c1 in + let c4 = ONCE_REWRITE_RULE [ GSYM REAL_MUL_ASSOC ] c3 in + let c5 = ONCE_REWRITE_RULE [ GSYM REAL_POW_MUL ] c4 in + let c6 = ONCE_REWRITE_RULE [REAL_MUL_SYM] (CONJUNCT2 real_pow) in + let c7 = ONCE_REWRITE_RULE [GSYM c6] c5 in + let c8 = REAL_ARITH `!x. (real_of_num 1)/x = inv x` in + let c9 = ONCE_REWRITE_RULE [c8] c7 in + let c10 = REAL_ARITH `!x y z.(inv x) * y * z = y * inv x * z` in + let c11 = ONCE_REWRITE_RULE [c10] c9 in + let t0 = + `sum (1..PRE (LENGTH c)) & * + max_abs c * + (exp (&(PRE (LENGTH c)))) * + &(PRE (LENGTH c)) pow PRE (LENGTH c)` in + let t1 = `real_of_num (PRE (LENGTH (c:(real)list))) pow SUC (PRE (LENGTH c))` + in + let int0 = SPECL [t0;t1;`real_of_num 1`] OLDGERMAN_LEMMA in + let int1 = SIMP_RULE [REAL_ARITH `(real_of_num 0) < &1`] int0 in + let int2 = SIMP_RULE [REAL_ARITH `x - (real_of_num 0) = x`] int1 in + let t8 = `!n. n >= N + ==> abs + ((sum (1..PRE (LENGTH c)) & * + max_abs c * + (exp (&(PRE (LENGTH c)))) * + &(PRE (LENGTH c)) pow PRE (LENGTH c)) * + inv (&(FACT n)) * + &(PRE (LENGTH c)) pow SUC (PRE (LENGTH c)) pow n) < + &1` in + let int5 = ASSUME t8 in + let int50 = REAL_ARITH `((x:real) * y * z * w) * (a * b) = x * y * z * w * a * + b` in + let int51 = ONCE_REWRITE_RULE [int50] int5 in + let int6 = SPEC `p - 1` int51 in + let int7 = ARITH_RULE ` (p > N ==> p - 1 >= N)` in + let int8 = UNDISCH (IMP_TRANS int7 int6) in + let int9 = ARITH_RULE `(x:real) <= y ==> y < (real_of_num 1) ==> x < (&1)` in + let int10 = MATCH_MP JESSE_REAL_ABS_LE c11 in + let int11 = MATCH_MP int9 int10 in + let int12 = MP int11 int8 in + (CHOOSE_TAC int2) THEN + (EXISTS_TAC `N:num`) THEN + (STRIP_TAC) THEN + (STRIP_TAC) THEN + (ONCE_REWRITE_TAC [ARITH_RULE `p > 0 ==> ((p:num) > N <=> p - 1 >= N)`]) THEN + (DISCH_TAC) THEN + (MATCH_ACCEPT_TAC int12) +) +let LT_ONE = prove( + `!c. ?p0. !p. p> p0 ==> abs (RHS c (g (PRE (LENGTH c)) p)) < &1`, + STRIP_TAC THEN (CHOOSE_TAC RHS_4_LT_ONE_MESSY) THEN (EXISTS_TAC `SUC p0`) THEN + (ASM_MESON_TAC [ARITH_RULE `p > SUC p0 ==> (p > p0 /\ p > 1)`]) +) +end;; + + + + +module Pm_eqn4_lhs = struct + +let N_IS_INT = prove( + `!n . integer (&n)`, + MESON_TAC [is_int] +) +let NEG_N_IS_INT = prove( + `!n . integer (--(&n))`, + MESON_TAC [is_int] +) +let INT_OF_REAL_ADD = prove( + `!x y.(integer x) /\ (integer y) + ==> (int_of_real (x + y)) = + (int_of_real x) + (int_of_real y)`, + SIMP_TAC[integer;int_add;int_rep;N_IS_INT;NEG_N_IS_INT] +) +let INT_OF_REAL_MUL = prove( + `!x y.(integer x) /\ (integer y) + ==> (int_of_real (x * y)) = + (int_of_real x) * (int_of_real y)`, + SIMP_TAC[is_int;int_mul;int_rep;N_IS_INT;NEG_N_IS_INT] +) + +let rec INT_OF_REAL_CONV_helper t = + let real_op_2_int_op t = + if (t = `real_add`) then `int_add` + else if (t = `real_sub`) then `int_sub` + else if (t = `real_mul`) then `int_mul` + else if (t = `real_pow`) then `int_pow` + else if (t = `real_neg`) then `int_neg` + else t + in + if (is_var t) then (mk_comb (`int_of_real`,t),[],[t]) + else if ((rator t) = `real_of_num`) then + (mk_comb (`int_of_real`, t),[t],[]) + else if ((rator t) = `real_neg`) then + let rand1 = rand t in + let (expr1,lst1,lst2) = INT_OF_REAL_CONV_helper rand1 in + let lst = lst1 @ [t] in + let expr = mk_comb (`int_neg`, expr1) in + (expr,lst,lst2) + else if ((rator (rator t)) = `real_pow`) then + let rand1 = rand (rator t) in + let exponent = rand t in + let (expr1,lst1,lst2) = INT_OF_REAL_CONV_helper rand1 in + let lst = lst1 @ [t] in + let expr = mk_comb (mk_comb (`int_pow`,expr1),exponent) in + (expr,lst,lst2) + else if ( ((rator (rator t)) = `real_add`) + or ((rator (rator t)) = `real_mul`) + or ((rator (rator t)) = `real_sub`) ) then + let int_op = real_op_2_int_op (rator (rator t)) in + let rand1 = rand (rator t) in + let rand2 = rand t in + let (expr1,lst11,lst12) = INT_OF_REAL_CONV_helper rand1 in + let (expr2,lst21,lst22) = INT_OF_REAL_CONV_helper rand2 in + let lst1 = lst11 @ lst21 @ [t] in + let lst2 = lst12 @ lst22 in + let expr = mk_comb (mk_comb (int_op,expr1),expr2) in + (expr,lst1,lst2) + else (t,[],[t]) + + +(* ------------------------------------------------------------------------- *) +(* I wrote an initial version of this, but John Harrison proposed this *) +(* version which is faster and also requires less theorems. *) +(* ------------------------------------------------------------------------- *) +let INT_OF_REAL_CONV = + let final_tweak = MATCH_MP(MESON[int_tybij] `real_of_int x = y ==> int_of_real y = x`) in + fun t -> + let (exp,real_sub_terms,is_int_assumpts) = INT_OF_REAL_CONV_helper t in + let is_int_assumpts = List.map (fun x -> mk_comb (`integer`,x)) is_int_assumpts in + let fexp = rand(concl(PURE_REWRITE_CONV[GSYM int_of_num] exp)) in + let rexp = mk_comb(`real_of_int`,fexp) + and ths = map (GEN_REWRITE_RULE I [CONJUNCT2 int_tybij] o ASSUME) is_int_assumpts in + let th3 = PURE_REWRITE_CONV(ths @ [int_pow_th; int_add_th; int_mul_th; int_sub_th; int_neg_th; int_of_num_th]) rexp in + itlist DISCH is_int_assumpts (final_tweak th3) + +let ALL_IS_INT = prove( + `! h t . (ALL integer (CONS h t)) ==> (integer h) /\ (ALL integer t)`, + SIMP_TAC [ALL] +) + +let ALL_IS_INT_POLY_ADD = prove( + `! p1 p2 . (ALL integer p1) /\ (ALL integer p2) ==> (ALL integer (p1 ++ p2))`, + let lem01 = UNDISCH (SPECL [`h:real`;`t:(real)list`] ALL_IS_INT) in + let [lem02;lem03] = CONJUNCTS lem01 in + let lem04 = UNDISCH (SPECL [`h':real`;`t':(real)list`] ALL_IS_INT) in + let [lem05;lem06] = CONJUNCTS lem04 in + let lem07 = CONJ lem02 lem05 in + let lem08 = MATCH_MP INTEGER_ADD lem07 in + let lem09 = ASSUME `! p2. ALL integer t /\ ALL integer p2 ==> ALL integer (t ++ p2)` in + let lem10 = SPEC `t':(real)list` lem09 in + let lem11 = CONJ lem03 lem06 in + let lem12 = MP lem10 lem11 in + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [poly_add]); + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [poly_add]); + (SIMP_TAC [poly_add]) THEN (ONCE_REWRITE_TAC [NOT_CONS_NIL]) THEN + (SIMP_TAC []) THEN (SIMP_TAC [HD;TL]) THEN (STRIP_TAC) THEN + (SIMP_TAC [ALL]) THEN + (CONJ_TAC) THENL [(ACCEPT_TAC lem08); (ACCEPT_TAC lem12)] + ] + ] +) +let ALL_IS_INT_POLY_CMUL = prove( + `! p c. (integer c) /\ (ALL integer p) ==> (ALL integer (c ## p))`, + (LIST_INDUCT_TAC) THEN (ASM_SIMP_TAC [poly_cmul;ALL;INTEGER_MUL]) +) + +let ALL_IS_INT_POLY_MUL = prove( + `! p1 p2 . (ALL integer p1) /\ (ALL integer p2) ==> (ALL integer (p1 ** p2))`, + let lem01 = UNDISCH (SPECL [`h:real`;`t:(real)list`] ALL_IS_INT) in + let lem02 = UNDISCH (SPECL [`h':real`;`t':(real)list`] ALL_IS_INT) in + let [lem03;lem04] = CONJUNCTS lem01 in + let [lem05;lem06] = CONJUNCTS lem02 in + let lem07 = MATCH_MP INTEGER_MUL (CONJ lem03 lem05) in + let lem08 = MATCH_MP ALL_IS_INT_POLY_CMUL (CONJ lem03 lem06) in + let lem09 = ASSUME `! p2. ALL integer t /\ ALL integer p2 ==> ALL integer (t ** p2)` in + let lem10 = SPEC `(CONS h' t'):(real)list` lem09 in + LIST_INDUCT_TAC THENL + [ (LIST_INDUCT_TAC THENL [(SIMP_TAC [ALL;poly_mul]);(SIMP_TAC [poly_mul])]); + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [poly_mul]) THEN + ((ASM_CASES_TAC `(t:(real)list) = []`) THENL + [ (ASM_SIMP_TAC [ALL;poly_cmul]) THEN (SIMP_TAC [poly_cmul]); + (ASM_SIMP_TAC [ALL;poly_cmul;poly_add]) THEN (SIMP_TAC [SPEC `0` N_IS_INT]) + ]); + (STRIP_TAC) THEN (ONCE_REWRITE_TAC [poly_mul] ) THEN + (ASM_CASES_TAC `(t:(real)list) = []`) THENL + [ (ASM_SIMP_TAC [ALL;poly_cmul]) THEN STRIP_TAC THENL + [(ACCEPT_TAC lem07) ;(ACCEPT_TAC lem08)]; + (ASM_SIMP_TAC []) THEN (MATCH_MP_TAC ALL_IS_INT_POLY_ADD) THEN + (CONJ_TAC) THENL + [ (MATCH_MP_TAC ALL_IS_INT_POLY_CMUL) THEN (CONJ_TAC) THENL + [(ACCEPT_TAC lem03) ; (ASM_SIMP_TAC[])]; + (SIMP_TAC [ALL]) THEN (CONJ_TAC) THENL + [(ACCEPT_TAC (SPEC `0` N_IS_INT)); (ASM_SIMP_TAC [lem04;lem10])] + ] + ] + ] + ] +) +let NOT_POLY_MUL_ITER_NIL = prove( + `! n . ~((poly_mul_iter (\i.[ -- &i; &1]) n) = [])`, + let lem02 = SIMP_RULE [NOT_CONS_NIL] (ISPEC `[ -- &(SUC n); &1]` NOT_POLY_MUL_NIL ) in + let lem03 = ISPEC `(poly_mul_iter (\i.[ -- &i; &1]) n)` lem02 in + let lem04 = UNDISCH lem03 in + INDUCT_TAC THENL + [ (SIMP_TAC [Pm_eqn5.POLY_MUL_ITER;NOT_CONS_NIL]); + (SIMP_TAC [Pm_eqn5.POLY_MUL_ITER;lem04]) + ] +) + +let ALL_IS_INT_POLY_MUL_ITER = prove( + `! n. (ALL integer (poly_mul_iter (\i.[-- &i; &1]) n))`, + let FOOBAR_LEMMA = prove( + `ALL integer [-- &(SUC n); &1]`, + (SIMP_TAC [ALL]) THEN (SIMP_TAC [N_IS_INT;NEG_N_IS_INT])) in + INDUCT_TAC THENL + [ (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN + (ONCE_REWRITE_TAC [ALL]) THEN (SIMP_TAC [ALL;N_IS_INT]); + (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN (BETA_TAC) THEN + (MATCH_MP_TAC ALL_IS_INT_POLY_MUL) THEN (CONJ_TAC) THENL + [(ACCEPT_TAC (FOOBAR_LEMMA)); (ASM_SIMP_TAC [])] + ] +) + +let ALL_IS_INT_POLY_EXP = prove( + `!n p. (ALL integer p) ==> (ALL integer (poly_exp p n))`, + let lem01 = ASSUME `! p. ALL integer p ==> ALL integer (poly_exp p n)` in + let lem02 = ASSUME ` ALL integer p` in + let lem03 = MP (SPEC_ALL lem01) lem02 in + let lem04 = CONJ lem02 lem03 in + let lem05 = MATCH_MP ALL_IS_INT_POLY_MUL lem04 in + INDUCT_TAC THENL + [ (ONCE_REWRITE_TAC [poly_exp]) THEN (ONCE_REWRITE_TAC [ALL]) THEN + (ONCE_REWRITE_TAC [ALL]) THEN (SIMP_TAC [SPEC `1` N_IS_INT]); + (ONCE_REWRITE_TAC [poly_exp]) THEN (REPEAT STRIP_TAC) THEN (ACCEPT_TAC lem05) + ] +) + +let BLAHBLAH = prove( + `! p1 p2. (LENGTH p1 <= LENGTH p2) ==> (&0 ## p1 ++ p2) = p2`, + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [LENGTH;poly_cmul;poly_add]); + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; + (ASM_SIMP_TAC [poly_cmul;poly_add;NOT_CONS_NIL;HD;TL; + REAL_ARITH `&0 * h + h' = h'`;LENGTH; + ARITH_RULE `(SUC x) <= (SUC y) <=> x <= y`]) ] + ] +) + +let BLAHBLAH3 = prove( + `! n h t. (LENGTH t) <= LENGTH (poly_exp [&0;&1] n ** CONS h t)`, + let lem04 = ASSUME `! h t . LENGTH t <= LENGTH (poly_exp [&0;&1] n ** CONS h t)` in + let lem05 = SPECL [`h:real`;`t:(real)list`] lem04 in + let lem06 = ARITH_RULE `!(x:num) y . x <= y ==> x <= SUC y` in + let lem07 = MATCH_MP lem06 lem05 in + let lem08 = GEN_ALL lem07 in + INDUCT_TAC THENL + [ (SIMP_TAC [poly_exp;poly_mul;poly_cmul;POLY_CMUL_LID;LENGTH]) THEN ARITH_TAC; + (SIMP_TAC [POLY_EXP_X_REC;poly_mul;NOT_POLY_EXP_X_NIL;poly_cmul;poly_add;NOT_CONS_NIL;LENGTH;TL]) THEN + (ASM_SIMP_TAC [BLAHBLAH]) THEN (ACCEPT_TAC lem08) + ] +) +let TELEVISION = prove ( + `!n p.(~ (p = [])) ==> EL n (poly_exp [&0;&1] n ** p) = HD p`, + let lem = MATCH_MP BLAHBLAH (SPEC_ALL BLAHBLAH3) in + INDUCT_TAC THENL + [ (SIMP_TAC [EL;poly_exp;POLY_MUL_CLAUSES]) THEN (LIST_INDUCT_TAC) THENL + [ (SIMP_TAC[]); (SIMP_TAC [NOT_CONS_NIL;POLY_CMUL_LID])]; + (SIMP_TAC [EL;POLY_EXP_X_REC;poly_mul;NOT_POLY_EXP_X_NIL]) THEN + LIST_INDUCT_TAC THENL + [ (SIMP_TAC []); + (SIMP_TAC [poly_cmul;poly_add;NOT_CONS_NIL;TL;HD]) THEN + (ASM_SIMP_TAC [lem;NOT_CONS_NIL;HD]) + ] + ] +) +let JOSHUA = prove( + `!i n p.(~ (p = [])) /\ (i < n) ==> EL i (poly_exp [&0;&1] n ** p) = &0`, + let lem0000 = SPECL [`t:(real)list`;`poly_exp [&0;&1] n ** (CONS h t)`] BLAHBLAH in + let lem0001 = MATCH_MP lem0000 (SPEC_ALL BLAHBLAH3) in + let lem0002 = ASSUME `! n p . ~(p = []) /\ i < n ==> EL i (poly_exp [&0;&1] n ** p) = &0` in + let lem0003 = SIMP_RULE [NOT_CONS_NIL] (SPECL [`n:num`;`(CONS (h:real) t)`] lem0002) in + INDUCT_TAC THENL + [ INDUCT_TAC THENL + [ ARITH_TAC ; + LIST_INDUCT_TAC THENL + [ (SIMP_TAC[]); + (SIMP_TAC [POLY_EXP_X_REC;EL;HD;poly_mul;NOT_POLY_EXP_NIL;NOT_CONS_NIL;HD_POLY_ADD;poly_cmul]) THEN + REAL_ARITH_TAC + ] + ]; + INDUCT_TAC THENL + [ ARITH_TAC; + (SIMP_TAC [EL;POLY_EXP_X_REC;poly_mul;NOT_POLY_EXP_NIL;NOT_CONS_NIL]) THEN + LIST_INDUCT_TAC THENL + [ (SIMP_TAC[]); + (SIMP_TAC [poly_cmul;poly_add;NOT_CONS_NIL;TL;lem0001]) THEN + (SIMP_TAC [ARITH_RULE `(SUC i) < (SUC n) <=> i < n`;lem0003]) + ] + ] + ] +) +let POLY_MUL_HD = prove( + `! p1 p2. (~(p1 = []) /\ ~(p2 = [])) ==> (HD (p1 ** p2)) = (HD p1) * (HD p2)`, + LIST_INDUCT_TAC THENL + [ (SIMP_TAC[]); + (LIST_INDUCT_TAC) THENL + [ (SIMP_TAC[]); + (SIMP_TAC [NOT_CONS_NIL]) THEN (ONCE_REWRITE_TAC [poly_mul]) THEN + (ASM_CASES_TAC `(t:(real)list) = []`) THENL + [ (ASM_SIMP_TAC [HD;poly_cmul]); + (ASM_SIMP_TAC [HD;poly_cmul;poly_add]) THEN + (SIMP_TAC [NOT_CONS_NIL;HD]) THEN (REAL_ARITH_TAC) + ] + ] + ] +) +let POLY_MUL_ITER_HD_FACTORIAL = prove( + `! n. (HD (poly_mul_iter (\i.[-- &i; &1]) n)) = ((-- &1) pow n) * (&(FACT n))`, + let lem01 = prove(`~([-- &(SUC n); &1] = [])`,SIMP_TAC [NOT_CONS_NIL]) in + let lem02 = ISPECL + [`[-- &(SUC n); &1]`;`poly_mul_iter (\i.[-- &i; &1]) n`] + POLY_MUL_HD in + let lem03 = CONJ lem01 (SPEC_ALL NOT_POLY_MUL_ITER_NIL) in + let lem04 = MP lem02 lem03 in + let lem05 = prove( + `!n. ((-- &1) pow n) = -- ((-- &1) pow (SUC n))`, + STRIP_TAC THEN (ONCE_REWRITE_TAC [pow]) THEN REAL_ARITH_TAC + ) in + INDUCT_TAC THENL + [ (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN (SIMP_TAC [HD;FACT]) THEN REAL_ARITH_TAC; + (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN BETA_TAC THEN + (ONCE_REWRITE_TAC [lem04]) THEN (ONCE_REWRITE_TAC [HD]) THEN + (ASM_SIMP_TAC []) THEN (ONCE_REWRITE_TAC [FACT]) THEN + (ONCE_REWRITE_TAC [GSYM REAL_OF_NUM_MUL]) THEN + (CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [lem05]))) THEN REAL_ARITH_TAC + ] +) +let PLANETMATH_THM_5_1 = prove( + `! n p. + p > 0 ==> + n > 0 ==> + ? As . + ((g n p) = (&1/(&(FACT (p - 1)))) ## As) + /\ (! i. i< (p-1) ==> (EL i As) = &0) + /\ ((EL (p-1) As) = ((-- &1) pow (n * p)) * ((&(FACT n)) pow p)) + /\ (ALL integer As)`, + let lem01 = SPECL [`poly_exp [&0;&1] (p - 1)`;`poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p`] ALL_IS_INT_POLY_MUL in + let lem02 = SPECL [`p-1`;`[&0;&1]`] ALL_IS_INT_POLY_EXP in + let lem03 = prove(`ALL integer [&0;&1]`, (REWRITE_TAC [ALL]) THEN (SIMP_TAC [N_IS_INT])) in + let lem04 = MP lem02 lem03 in + let lem05 = SPECL [`p:num`;`poly_mul_iter (\i.[-- &i; &1]) n`] ALL_IS_INT_POLY_EXP in + let lem06 = MP lem05 (SPEC_ALL ALL_IS_INT_POLY_MUL_ITER) in + let lem07 = MP lem01 (CONJ lem04 lem06) in + let lem08 = SPECL [`p-1`;`poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p`] TELEVISION in + let lem09 = SIMP_RULE [ NOT_POLY_EXP_NIL;NOT_POLY_MUL_ITER_NIL] lem08 in + let lem10 = SPECL [`i:num`;`p - 1`;`poly_exp (poly_mul_iter (\i. [ -- &i; &1]) n ) p`] JOSHUA in + let lem11 = SIMP_RULE [NOT_POLY_MUL_ITER_NIL;NOT_POLY_EXP_NIL] lem10 in + (REPEAT STRIP_TAC) THEN + (EXISTS_TAC `((poly_exp [&0;&1] (p-1)) ** (poly_exp (poly_mul_iter (\i.[-- &i; &1]) n) p))`) THEN + CONJ_TAC THENL + [ (ONCE_REWRITE_TAC [Pm_eqn5.PLANETMATH_EQN_5]) THEN (SIMP_TAC[]); + CONJ_TAC THENL + [ (SIMP_TAC [lem11]); + CONJ_TAC THENL + [ (ONCE_REWRITE_TAC [lem09]) THEN + (SPEC_TAC (`n:num`,`n:num`)) THEN + (INDUCT_TAC) THENL + [ (SIMP_TAC [NOT_CONS_NIL;HD_POLY_EXP;HD;Pm_eqn5.POLY_MUL_ITER;FACT;pow; + REAL_POW_ONE;ARITH_RULE `0 * p = 0`;REAL_ARITH `&1 * &1 = &1`]); + (SIMP_TAC [HD_POLY_EXP; NOT_POLY_MUL_ITER_NIL; POLY_MUL_ITER_HD_FACTORIAL]) THEN + (SIMP_TAC [REAL_POW_MUL;REAL_POW_POW;BLAHBLAH3]) ]; + ACCEPT_TAC lem07 ] + ] + ] +) +let as_def = + let ll01 = SPEC_ALL PLANETMATH_THM_5_1 in + let FO_LEMMA1 = prove(`((p > 0) ==> (n > 0) ==> (? z. C p n z)) + <=> (? z. (p > 0) ==> (n > 0) ==> C p n z)`,MESON_TAC[]) in + let ll02 = GEN_ALL (SIMP_RULE [FO_LEMMA1] ll01) in + let ll03 = ONCE_REWRITE_RULE [SKOLEM_CONV (concl ll02)] ll02 in + new_specification ["As"] ll03 +(* split up def of As into its four conjuncts *) +let g_eq_As + = (GEN_ALL o DISCH_ALL o CONJUNCT1 o UNDISCH o UNDISCH o SPEC_ALL) as_def +let prefix_As_zero + = (GEN_ALL o DISCH_ALL o CONJUNCT1 o CONJUNCT2 o UNDISCH o UNDISCH o SPEC_ALL) as_def +let fact_As + = (GEN_ALL o DISCH_ALL o CONJUNCT1 o CONJUNCT2 o CONJUNCT2 o UNDISCH o UNDISCH o SPEC_ALL) as_def +let ALL_integer_As + = (GEN_ALL o DISCH_ALL o CONJUNCT2 o CONJUNCT2 o CONJUNCT2 o UNDISCH o UNDISCH o SPEC_ALL) as_def + +let POLY_DIFF_AUX_LEM1 = prove( + `! i p k. i < (LENGTH p) ==> EL i (poly_diff_aux k p) = (EL i p) * &(i + k)`, + let lem0001 = ASSUME `! p k . i < LENGTH p ==> EL i (poly_diff_aux k p ) = EL i p * &(i + k)` in + let lem0002 = SPECL [` t:(real)list`;`SUC k`] lem0001 in + let lem0003 = prove(`SUC i < LENGTH (CONS (h:real) t) <=> i < LENGTH t`,(SIMP_TAC [LENGTH]) THEN ARITH_TAC) in + INDUCT_TAC THENL + [ LIST_INDUCT_TAC THENL + [ (SIMP_TAC [poly_diff_aux;LENGTH]) THEN ARITH_TAC; + (SIMP_TAC [poly_diff_aux;ARITH_RULE `0 + k = k`;poly_diff;LENGTH;EL;HD;TL]) THEN REAL_ARITH_TAC ]; + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; + (SIMP_TAC [poly_diff_aux;EL;TL]) THEN STRIP_TAC THEN + (SIMP_TAC [lem0003;lem0002;ARITH_RULE `i + SUC k = SUC i + k`]) ] + ] +) +let EL_POLY_DIFF = prove( + `! i p. i < (LENGTH (poly_diff p)) ==> EL i (poly_diff p) = (EL (SUC i) p) * &(SUC i)`, + let lem01 = SPECL [`SUC i`;`t:(real)list`;`1`] POLY_DIFF_AUX_LEM1 in + INDUCT_TAC THENL + [ LIST_INDUCT_TAC THENL + [ ((SIMP_TAC [LENGTH;poly_diff]) THEN ARITH_TAC); + (SIMP_TAC [LENGTH;PRE;EL;HD;TL;ARITH_RULE `SUC 0 = 1`;REAL_ARITH `x * &1 = x`;poly_diff;NOT_CONS_NIL]) THEN + (SPEC_TAC (`t:(real)list`,`t:(real)list`)) THEN + LIST_INDUCT_TAC THENL [(SIMP_TAC [LENGTH;poly_diff_aux]) THEN ARITH_TAC; + (SIMP_TAC [HD;poly_diff_aux;REAL_ARITH `&1 * h = h`])] + ]; + LIST_INDUCT_TAC THENL + [ ((SIMP_TAC [LENGTH;HD;poly_diff;REAL_ARITH `&1 * h = h`])) THEN ARITH_TAC; + (SIMP_TAC [poly_diff;NOT_CONS_NIL;TL;LENGTH_POLY_DIFF_AUX ]) THEN (SIMP_TAC [lem01;EL;TL]) THEN ARITH_TAC ] + ] +) +let POLY_AT_ZERO = prove( + `!p .(~(p = [])) ==> poly p (&0) = HD p`, + LIST_INDUCT_TAC THENL [ SIMP_TAC []; (SIMP_TAC [poly;HD]) THEN REAL_ARITH_TAC ] +) +let PDI_POLY_DIFF_COMM = prove( + `! p n.(poly_diff_iter (poly_diff p) n) = (poly_diff (poly_diff_iter p n))`, + STRIP_TAC THEN INDUCT_TAC THENL + [(SIMP_TAC [Pm_lemma1.PDI_DEF]); + (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (ASM_SIMP_TAC [])] +) +let EL_PDI_AT_ZERO = prove( + `!i p. (i < (LENGTH p)) + ==> ( poly (poly_diff_iter p i) (&0)) = ((EL i p) * (&(FACT i)))`, + let lem03 = prove(`SUC i < LENGTH (CONS (h:real) t) <=> i < LENGTH t`,(SIMP_TAC [LENGTH]) THEN ARITH_TAC) in + let lem04 = ASSUME `!p . i < LENGTH p ==> poly (poly_diff_iter p i) (&0) = EL i p * &(FACT i)` in + let lem05 = SIMP_RULE [LENGTH_POLY_DIFF;LENGTH;PRE] (SPEC `poly_diff (CONS h t)` lem04) in + let lem06 = prove(`i < LENGTH t ==> i < LENGTH (poly_diff (CONS h t))`,SIMP_TAC [LENGTH_POLY_DIFF;PRE;LENGTH]) in + INDUCT_TAC THENL + [ (LIST_INDUCT_TAC THENL + [(SIMP_TAC [LENGTH]) THEN ARITH_TAC; (SIMP_TAC [Pm_lemma1.PDI_DEF;FACT;EL;NOT_CONS_NIL;POLY_AT_ZERO]) THEN REAL_ARITH_TAC]); + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [LENGTH]) THEN ARITH_TAC; + (SIMP_TAC [Pm_lemma1.PDI_DEF;GSYM PDI_POLY_DIFF_COMM;lem03;lem05]) THEN + (SIMP_TAC [lem06;EL_POLY_DIFF;FACT;REAL_OF_NUM_MUL;GSYM REAL_MUL_ASSOC]) + ] + ] +) +let EL_PDI_AT_ZERO2 = prove( + `!i p. ((~ (p = [])) /\ (i <= (LENGTH p) - 1)) ==> ( poly (poly_diff_iter p i) (&0)) = ((EL i p) * (&(FACT i)))`, + STRIP_TAC THEN LIST_INDUCT_TAC THEN + (SIMP_TAC [NOT_CONS_NIL;LENGTH;ARITH_RULE `(i <= (SUC x) -1) <=> (i < (SUC x))`;EL_PDI_AT_ZERO]) +) +let POLY_CMUL_PDI = prove( + `!p c i. (poly_diff_iter (c ## p) i) = c ##(poly_diff_iter p i)`, + STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN (ASM_SIMP_TAC [Pm_lemma1.PDI_DEF;POLY_CMUL_POLY_DIFF]) +) +let LENGTH_g = prove( + `! n p . (LENGTH (g n p)) >= p `, + let lem00 = ARITH_RULE `SUC ((SUC p ) - 1) = SUC p` in + let lem01 = prove(`! n p. ~((poly_exp (poly_mul_iter (\i.[-- &i; &1]) n ) (SUC p)) = [])`, + SIMP_TAC [NOT_POLY_EXP_NIL; NOT_POLY_MUL_ITER_NIL]) in + let lem02 = MATCH_MP POLY_MUL_LENGTH2 (SPEC_ALL lem01) in + let lem03 = SPECL [`poly_exp [&0;&1] (SUC p - 1)`] lem02 in + let lem04 = SIMP_RULE [POLY_EXP_X_LENGTH] lem03 in + let lem05 = SIMP_RULE [lem00] lem04 in + (SIMP_TAC [Pm_eqn5.PLANETMATH_EQN_5;POLY_CMUL_LENGTH]) THEN STRIP_TAC THEN INDUCT_TAC THENL + [ ARITH_TAC; SIMP_TAC [lem05]] +) +let LENGTH_As = prove( + `! n p . p > 0 ==> n > 0 ==> LENGTH (As n p) >= p`, + let lem50 = ADD_ASSUM `p > 0` (ADD_ASSUM `n > 0` (SPEC_ALL LENGTH_g)) in + let lem51 = ONCE_REWRITE_RULE [UNDISCH_ALL (SPEC_ALL g_eq_As)] lem50 in + let lem52 = ONCE_REWRITE_RULE [POLY_CMUL_LENGTH] lem51 in + SIMP_TAC [lem52] +) +let REAL_MUL_RDIV = prove( + `!x y. ~(y = &0) ==> ((x * y) / y = x)`, + SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_RID] +) +let REAL_MUL_DIV_ASSOC = prove( + `!x y z.((x * z) / y = x * (z / y))`, + SIMP_TAC [real_div;GSYM REAL_MUL_ASSOC] +) +let IS_INT_FACT_DIV = prove( + `! n m. n >= m ==> integer ( (&(FACT n))/(&(FACT m)) )`, + let lem0 = SPEC_ALL (ONCE_REWRITE_RULE [GSYM (SPECL [`FACT n`;`0`] REAL_OF_NUM_EQ)] FACT_NZ) in + let lem1 = SPECL [`&(SUC n)`;`&(FACT n)`] REAL_MUL_RDIV in + let lem2 = MP lem1 lem0 in + let lem4 = ASSUME `! m. n >= m ==> integer (&(FACT n)/ &(FACT m))` in + let lem5 = UNDISCH (SPEC_ALL lem4) in + let lem6 = prove(`integer(&(SUC n))`,SIMP_TAC [N_IS_INT]) in + let lem7 = CONJ lem6 lem5 in + let lem8 = MATCH_MP INTEGER_MUL lem7 in + let lem9 = UNDISCH_ALL (ARITH_RULE `(~(n >= m)) ==> (SUC n >= m) ==> m = SUC n`) in + INDUCT_TAC THENL + [ (SIMP_TAC [ARITH_RULE `0 >= m ==> m = 0`;FACT_NZ;REAL_OF_NUM_EQ;REAL_DIV_REFL;N_IS_INT]); + (STRIP_TAC) THEN (ASM_CASES_TAC `(n:num) >= m`) THENL + [ (ASM_SIMP_TAC [FACT;GSYM REAL_OF_NUM_MUL;lem2;N_IS_INT]) THEN + (SIMP_TAC [FACT;GSYM REAL_OF_NUM_MUL;REAL_MUL_DIV_ASSOC;lem8]); + (STRIP_TAC) THEN + (SIMP_TAC [lem9;FACT_NZ;REAL_OF_NUM_EQ;REAL_DIV_REFL;N_IS_INT]) + ] + ] +) +let SATURDAY_LEMMA = prove( + `!x. p > 1 ==> m >= p ==> x * ((&(FACT m))/(&(FACT (p-1)))) = x * (&p) * ((&(FACT m))/(&(FACT p)))`, + let lem01 = UNDISCH (ARITH_RULE `p > 1 ==> SUC (p -1) = p`) in + let lem02 = ADD_ASSUM `p > 1` (SPEC `p - 1` (CONJUNCT2 FACT)) in + let lem03 = GSYM (ONCE_REWRITE_RULE [lem01] lem02) in + let lem04 = SPEC `&p` REAL_DIV_REFL in + let lem05 = ADD_ASSUM `p > 1` (SPECL [`p:num`;`0`] REAL_OF_NUM_EQ) in + let lem06 = SIMP_RULE [UNDISCH (ARITH_RULE `p > 1 ==> ~(p = 0)`)] lem05 in + let lem07 = GSYM (MP lem04 lem06) in + (REPEAT STRIP_TAC) THEN + (CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [GSYM REAL_MUL_LID]))) THEN + (ONCE_REWRITE_TAC [lem07]) THEN + (ONCE_REWRITE_TAC [real_div]) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `((x1:real) * x2) * x * (x3 * x4) = x * x1 * (x3 * (x2 * x4))`]) THEN + (ONCE_REWRITE_TAC [GSYM REAL_INV_MUL]) THEN + (ONCE_REWRITE_TAC [REAL_OF_NUM_MUL]) THEN + (SIMP_TAC [REAL_MUL_ASSOC;GSYM REAL_INV_MUL]) THEN + (ONCE_REWRITE_TAC [lem03]) THEN + (SIMP_TAC [REAL_MUL_ASSOC;GSYM REAL_OF_NUM_MUL]) +) +let SHRIVER = prove( + `!f0. (!i. m <= i /\ i <= SUC n ==> (f0 i)) + ==> (!i. m <= i /\ i <= n ==> (f0 i)) `, + let lem01 = UNDISCH_ALL (ARITH_RULE `i <= n ==> i <= SUC n`) in + let lem02 = CONJ (ASSUME `(m:num) <= (i:num)`) lem01 in + let lem03 = ASSUME `!i. m <= i /\ i <= SUC n ==> (f0 i)` in + let lem04 = SPEC_ALL lem03 in + let lem05 = MP lem04 lem02 in + (REPEAT STRIP_TAC) THEN (ACCEPT_TAC lem05) +) +let IS_INT_SUM = prove( + `!f n m.(!i.m <= i /\ i <= n ==> integer (f i)) ==> integer (sum (m..n) f)`, + let l0 = SPECL [`m:num`;`n:num`;`i:num`] IN_NUMSEG in + let l1 = SPECL [`m:num`;`SUC n`] NUMSEG_EMPTY in + let l2 = ADD_ASSUM `SUC n < m` l1 in + let l3 = ASM_REWRITE_RULE [] l2 in + let l4 = (UNDISCH o ARITH_RULE) `~(SUC n < m) ==> m <= SUC n` in + let l5 = ONCE_REWRITE_RULE [GSYM IN_NUMSEG] SHRIVER in + let l6 = SPEC `\(i:num).(integer (f i))` l5 in + let l7 = BETA_RULE l6 in + let l8 = ASSUME `! m. (!i. i IN m..n ==> integer (f i)) ==> integer (sum (m..n) f)` in + let l9 = SPEC_ALL l8 in + let l10 = UNDISCH (IMP_TRANS l7 l9) in + let jj0 = ARITH_RULE `(~(SUC n < m)) ==> m <= SUC n /\ (SUC n) <= SUC n` in + let jj1 = UNDISCH (ONCE_REWRITE_RULE [GSYM IN_NUMSEG] jj0) in + let jj2 = SPEC `SUC n` (ASSUME `!i. i IN m.. SUC n ==> integer (f i)`) in + let jj3 = (MP jj2 jj1) in + let l18 = CONJ l10 jj3 in + let l19 = MATCH_MP INTEGER_ADD l18 in + let l20 = DISCH `!i. i IN m..SUC n ==> integer (f i)` l19 in + let l21 = ASSUME `!i . i = 0 ==> integer (f 0)` in + let l22 = SIMP_RULE [] (SPEC `0` l21) in + (ONCE_REWRITE_TAC [GSYM l0]) THEN STRIP_TAC THEN + INDUCT_TAC THENL + [ STRIP_TAC THEN + (ASM_CASES_TAC `m = 0`) THENL + [ (ASM_SIMP_TAC []) THEN + (ONCE_REWRITE_TAC [NUMSEG_CONV `0..0`]) THEN + (ONCE_REWRITE_TAC [ SUM_SING]) THEN + (SIMP_TAC [IN_SING]) THEN (DISCH_TAC) THEN (SIMP_TAC [l22]); + (ASM_SIMP_TAC [NUMSEG_CLAUSES;SUM_CLAUSES;N_IS_INT]) + ]; + STRIP_TAC THEN (ASM_CASES_TAC `SUC n < m`) THENL + [ (ASM_SIMP_TAC [l3;SUM_CLAUSES;N_IS_INT]); + (ASM_SIMP_TAC [l4;SUM_CLAUSES_NUMSEG]) THEN + (ACCEPT_TAC l20) + ] + ] +) +let ALL_IMP_EL = prove( + `! (l:(a)list) i P. (ALL P l) ==> (i < LENGTH l) ==> P (EL i l)`, + SIMP_TAC[GSYM ALL_EL] +) +let KEY_LEMMA = prove( + `n > 0 ==> + p > 0 ==> + ! i . p <= i /\ i <= (LENGTH (As n p) - 1) ==> integer ((&(FACT i)/ &(FACT p)) * (EL i (As n p)))`, + let jem0 = ISPECL [`(As n p)`;`i:num`;`integer`] ALL_IMP_EL in + let jem1 = MP jem0 (UNDISCH (UNDISCH (SPEC_ALL ALL_integer_As))) in + let jem3 = ARITH_RULE `LENGTH (As n p) > 0 ==> ((i < LENGTH (As n p)) <=> i <= LENGTH (As n p) - 1)` in + let jem4 = UNDISCH_ALL ((SPEC_ALL LENGTH_As)) in + let jem5 = UNDISCH (ARITH_RULE `p > 0 ==> (LENGTH (As n p) >= p) ==> (LENGTH (As n p) > 0)`) in + let jem6 = MP jem5 jem4 in + let jem7 = MP jem3 jem6 in + let jem8 = ONCE_REWRITE_RULE [jem7] jem1 in + let kem0 = SPECL [`i:num`;`p:num`] IS_INT_FACT_DIV in + let kem1 = ADD_ASSUM `p <= (i:num)` (ADD_ASSUM `i <= (LENGTH (As n p) - 1)` kem0) in + let kem2 = SIMP_RULE [UNDISCH_ALL (ARITH_RULE `p <= i ==> i <= LENGTH (As n p) -1 ==> i >= p`)] kem1 in + (REPEAT STRIP_TAC) THEN (SIMP_TAC[UNDISCH jem8;kem2;INTEGER_MUL]) +) + +let KEY_LEMMA2 = prove( + `p > 1 ==> + n > 0 ==> + ? K0 . integer K0 + /\ (&1 / &(FACT ( p - 1))) * (sum (p.. LENGTH (As n p) -1) (\m. EL m (As n p) * &(FACT m))) = (&p) * K0`, + let lem0000 = SPEC `EL m (As n p)` SATURDAY_LEMMA in + let lem1000 = DISCH `m <= LENGTH (As n p) -1` (ADD_ASSUM `m <= LENGTH (As n p) -1` (UNDISCH_ALL lem0000)) in + let lem2000 = DISCH `(m:num) >= p` lem1000 in + let lem3000 = ONCE_REWRITE_RULE [ARITH_RULE `(m:num) >= p <=> p <= m`] lem2000 in + let lem4000 = ONCE_REWRITE_RULE [TAUT `(a ==> b ==> c) <=> ((a /\ b) ==> c)`] (GEN `m:num` lem3000) in + let lem5000 = MATCH_MP SUM_EQ_NUMSEG lem4000 in + let nem2 = SPECL [`\x.(&(FACT x)/ &(FACT p)) * (EL x (As n p))`;`LENGTH (As n p) - 1`;`p:num`] IS_INT_SUM in + let nem3 = BETA_RULE nem2 in + let nem4 = SIMP_RULE [UNDISCH (UNDISCH KEY_LEMMA)] nem3 in + let nem5 = ADD_ASSUM `p > 1` (DISCH `p > 0` nem4) in + let nem6 = SIMP_RULE [(UNDISCH o ARITH_RULE) `(p:num) > 1 ==> p > 0`] nem5 in + STRIP_TAC THEN STRIP_TAC THEN (ONCE_REWRITE_TAC [GSYM SUM_LMUL]) THEN + (BETA_TAC) THEN (ONCE_REWRITE_TAC [real_div]) THEN (ONCE_REWRITE_TAC [REAL_MUL_LID]) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(x1:real) * x2 * x3 = x2 * (x3 * x1)`]) THEN + (ONCE_REWRITE_TAC [GSYM real_div]) THEN (ONCE_REWRITE_TAC [lem5000]) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(x1:real) * x2 * x3 = x2 * (x3 * x1)`]) THEN + (ONCE_REWRITE_TAC [SUM_LMUL]) THEN + (EXISTS_TAC `sum (p .. LENGTH (As n p) -1) (\x. &(FACT x) / &(FACT p) * EL x (As n p))`) THEN + (SIMP_TAC [nem6]) +) +let NOT_g_NIL = prove( + `!n p . ~ ((g n p ) = [])`, + SIMP_TAC [Pm_eqn5.PLANETMATH_EQN_5; NOT_CONS_NIL; NOT_POLY_EXP_NIL; NOT_POLY_CMUL_NIL; + NOT_POLY_MUL_NIL;NOT_POLY_MUL_ITER_NIL] +) +let FACT_DIV_RCANCELS = prove( + `!n x. x / &(FACT n) * &(FACT n) = x`, + MESON_TAC [REAL_ARITH `!x. &0 < x ==> ~(x = &0)`; + REAL_DIV_RMUL;FACT_LT;REAL_OF_NUM_LT] +) + +let PSUM_ITERATE = prove( + `! n m f. psum (m,n) f + = if (n > 0) then (iterate (+) (m..((n+m)-1)) f) else &0`, + let lem01 = ARITH_RULE `~(n+m=0) ==> (SUC n + m) -1 = SUC ((n + m) -1)` in + let lem02 = MP (ISPEC `(+)` ITERATE_SING) MONOIDAL_REAL_ADD in + let lem03 = prove( + `iterate (+) (m..SUC ((n + m) - 1)) f + = f (SUC ((n+m)-1)) + iterate (+) (m..(n+m)-1) f`, + MESON_TAC [ARITH_RULE `m <= SUC ((n+m)-1)`;ITERATE_CLAUSES_NUMSEG; + MONOIDAL_REAL_ADD;REAL_ADD_SYM]) in + let lem04 = UNDISCH (UNDISCH (ARITH_RULE `~(n+m=0) ==> n=0 ==> m-1 < m`)) in + let lem05 = SIMP_RULE [lem04] (SPECL [`m:num`;`m-1`] NUMSEG_EMPTY) in + INDUCT_TAC THENL + [ SIMP_TAC [ARITH_RULE `~(0 > 0)`;sum_DEF]; + (SIMP_TAC [ARITH_RULE `(SUC n) > 0`]) THEN (REPEAT STRIP_TAC) THEN + (ASM_CASES_TAC `n + m =0`) THENL + [ (REWRITE_TAC [UNDISCH (ARITH_RULE `n + m = 0 ==> n = 0`)]) THEN + (REWRITE_TAC [lem02;NUMSEG_SING;ARITH_RULE `(SUC 0 +m) -1 = m`]) THEN + (MESON_TAC [sum_DEF; ADD_CLAUSES;REAL_ARITH `&0 + x = x`]) ; + (ONCE_REWRITE_TAC [sum_DEF;UNDISCH lem01]) THEN + (REWRITE_TAC [lem03]) THEN (ASM_CASES_TAC `n = 0`) THEN + (ASM_SIMP_TAC + [ARITH_RULE `~(0 > 0)`;ADD_CLAUSES;REAL_ADD_LID;REAL_ADD_RID; + lem05;ITERATE_CLAUSES_GEN; MONOIDAL_REAL_ADD;NEUTRAL_REAL_ADD; + REAL_ADD_SYM;ADD_SYM;ARITH_RULE `~(n=0) ==> n>0 /\ SUC (n-1) = n`]) + ] + ] +) + + +let PLANETMATH_EQN_5_2 = prove( + `p > 1 ==> + n > 0 ==> + (? K0. integer K0 + /\ poly (SOD (g n p)) (&0) = + &(FACT n) pow p * -- &1 pow (n * p) + &p * K0)`, + let lem01 = SPECL [`g n p`;`x:real`;`(&0):real`] Pm_lemma2.PLANETMATH_LEMMA_2_B in + let lem02 = GEN_ALL lem01 in + let lem03 = SPEC_ALL (BETA_RULE lem02) in + let lem04 = SIMP_RULE [FACT_DIV_RCANCELS] lem03 in + let lem05 = SIMP_RULE [PSUM_ITERATE] lem04 in + let lem06 = SIMP_RULE [ARITH_RULE `(n:num) + 0 = n`] lem05 in + let lem07 = ADD_ASSUM `n > 0` (ADD_ASSUM `p > 0` lem06) in + let lem08 = REWRITE_RULE [GSYM LENGTH_EQ_NIL;ARITH_RULE `~(x = 0) <=> x > 0`] NOT_g_NIL in + let lem09 = SIMP_RULE [lem08] lem07 in + let lem10 = CONV_RULE (RAND_CONV (REWRITE_CONV [UNDISCH_ALL (SPEC_ALL g_eq_As)])) lem09 in + let lem11 = SIMP_RULE [POLY_CMUL_LENGTH] lem10 in + let lem12 = SPECL [`m:num`;`(As n p)`] EL_PDI_AT_ZERO in + let lem13 = SIMP_RULE [POLY_CMUL_PDI;POLY_CMUL;lem12] lem11 in + let lem14 = GSYM (BETA `(\m. poly (poly_diff_iter (As n p) m) (&0)) m`) in + let lem15 = ISPECL [`(\m. poly (poly_diff_iter (As n p) m) (&0))`;`&1/ &(FACT (p - 1))`;`0..LENGTH (As n p) -1`] SUM_LMUL in + let lem16 = ONCE_REWRITE_RULE [lem14] lem13 in + let lem17 = ONCE_REWRITE_RULE [GSYM sum] lem16 in + let lem18 = SIMP_RULE [GSYM lem17] lem15 in + let lem20 = SPECL [`(\m. poly (poly_diff_iter (As n p) m) (&0))`;`(\m. EL m (As n p) * &(FACT m))`;`0`;`LENGTH (As n p) - 1`] SUM_EQ_NUMSEG in + let lem21 = ONCE_REWRITE_RULE [ARITH_RULE `0 <= i`] (BETA_RULE lem20) in + let lem22 = ADD_ASSUM `~(As n p = [])` (ONCE_REWRITE_RULE [EL_PDI_AT_ZERO2] lem21) in + let lem30 = SPECL [`i:num`;`As n p`] EL_PDI_AT_ZERO2 in + let lem31 = ASM_REWRITE_RULE [] (ADD_ASSUM `~(As n p = [])` lem30) in + let lem23 = ONCE_REWRITE_RULE [lem31] lem22 in + let lem24 = REWRITE_RULE [GSYM lem16] lem23 in + let lem25 = ONCE_REWRITE_RULE [lem24] lem18 in + let lem30 = ISPECL [`\m. EL m (As n p) * &(FACT m)`;`0`;`p-1`;`(LENGTH (As n p) - 1) - (p - 1)`] SUM_ADD_SPLIT in + let lem31 = SIMP_RULE [ARITH_RULE `0 <= x`] lem30 in + let lem32 = UNDISCH_ALL (ARITH_RULE `! x. x >= p ==> (p - 1) + (x - 1) - (p -1)= x - 1`) in + let lem33 = UNDISCH_ALL (SPEC_ALL LENGTH_As) in + let lem34 = SPEC `LENGTH (As n p)` lem32 in + let lem35 = MP lem34 lem33 in + let lem36 = ONCE_REWRITE_RULE [UNDISCH (ARITH_RULE `p > 1 ==> (p - 1) + 1 = p`);lem35] lem31 in + let lem37 = ONCE_REWRITE_RULE [lem36] lem25 in + let lem38 = SIMP_RULE [UNDISCH (ARITH_RULE `p > 1 ==> p > 0`)] (DISCH `p > 0` lem37) in + let lem39 = ISPECL [`\m. EL m (As n p) * &(FACT m)`;`0`;`p-2`;`1`] SUM_ADD_SPLIT in + let lem40 = ADD_ASSUM `n > 0` (ADD_ASSUM `p > 1` lem39) in + let lem41 = SIMP_RULE (map (UNDISCH o ARITH_RULE) [`p > 1 ==> p - 2 + 1 = p-1`;`p > 1 ==> (p - 2) + 1 = p - 1`]) lem40 in + let lem42 = SIMP_RULE [SUM_SING_NUMSEG;ARITH_RULE `0 <= x`] lem41 in + let lem45 = ADD_ASSUM `p > 1` (SPEC_ALL prefix_As_zero) in + let lem46 = SIMP_RULE [UNDISCH_ALL (ARITH_RULE `p > 1 ==> p > 0`)] lem45 in + let lem47 = UNDISCH (ONCE_REWRITE_RULE [UNDISCH_ALL (ARITH_RULE `p > 1 ==> (i < p-1 <=> i <= p-2)`)] lem46) in + let lem48 = SIMP_RULE [REAL_ARITH `((&0):real) + x = x`; SUM_EQ_0_NUMSEG;REAL_ARITH `((&0):real) * x = &0`;lem47] lem42 in + let lem49 = SIMP_RULE [UNDISCH (ARITH_RULE `p > 1 ==> p > 0`)] (ADD_ASSUM `p > 1` (SPEC_ALL fact_As)) in + let lem50 = SIMP_RULE [UNDISCH lem49] lem48 in + let lem51 = ONCE_REWRITE_RULE [lem50] lem38 in + let lem52 = SPECL [`p - 1`;`(&1):real`] FACT_DIV_RCANCELS in + let lem53 = SIMP_RULE [REAL_ARITH `(x:real) * (y * z) = (x * z) * y`;lem52;REAL_ARITH `(x:real) * (y + z) = (x * y) + (x * z)`] lem51 in + let lem54 = SIMP_RULE [REAL_ARITH `&1 * x = (x:real)`] lem53 in + let josh0 = UNDISCH_ALL KEY_LEMMA2 in + let josh1 = REAL_ARITH `!(y:real) x1 x2 . x1 = x2 <=> y + x1 = y + x2` in + let josh2 = SPEC `(&(FACT n) pow p * -- &1 pow (n * p)):real` josh1 in + let josh3 = ONCE_REWRITE_RULE [josh2] josh0 in + let josh4 = ONCE_REWRITE_RULE [GSYM lem54] josh3 in + let josh5 = DISCH `~ (As n p = [])` josh4 in + let jem4 = ADD_ASSUM `p > 1` ((SPEC_ALL LENGTH_As)) in + (* JOHN: the UNDISCH here is necessary... i don't think it should be *) + let jem5 = UNDISCH (SIMP_RULE [UNDISCH (ARITH_RULE `(p:num) > 1 ==> p > 0`)] jem4) in + let jem6 = UNDISCH (ARITH_RULE `p > 1 ==> (LENGTH (As n p) >= p) ==> ~((LENGTH (As n p) = 0))`) in + let jem7 = MP jem6 jem5 in + let jem8 = SIMP_RULE [LENGTH_EQ_NIL] jem7 in + let josh6 = MP josh5 jem8 in + let josh7 = DISCH_ALL josh6 in + let josh11 = ONCE_REWRITE_RULE [GSYM OLD_SUM] lem17 in + let josh12 = REWRITE_RULE [GSYM josh11] josh7 in + let josh13 = SIMP_RULE [] (DISCH_ALL josh12) in + let josh14 = BRW `(X ==> Y ==> Z ==> W) <=> ((X /\ Y /\ Z) ==> W)` josh13 in + let josh15 = ONCE_REWRITE_RULE [ARITH_RULE `(p > 0 /\ n > 0 /\ p > 1) <=> (p > 1 /\ n > 0)`] (DISCH_ALL josh14) in + let josh16 = BRW1 josh15 in + let josh17 = SIMP_RULE [PSUM_ITERATE;ARITH_RULE `~(0 > 0)`] josh16 in + ACCEPT_TAC josh17 +) +let PLANETMATH_DIVIDES_FACT_PRIME_1 = prove ( + `!p n. (prime p) /\ p > n ==> ~(num_divides p (FACT n))`, + (SIMP_TAC [DIVIDES_FACT_PRIME]) THEN ARITH_TAC +) +let INT_OF_REAL_NEG_NUM = prove( + `!(n:num).int_of_real (-- (real_of_num n)) = -- (int_of_real (real_of_num n))`, + SIMP_TAC [GSYM int_of_num;GSYM int_of_num_th;GSYM int_neg] +) +let ABS_EQ_ONE = prove( + `!(x:real) .((abs x) = &1) ==> ((x = &1) \/ (x = -- &1))`, + ARITH_TAC +) +let POW_NEG_1 = prove( + `!(x:num). (((-- (&1 :real)) pow x) = -- &1) \/ (((-- (&1 : real)) pow x) = &1)`, + let lem00 = ONCE_REWRITE_RULE [TAUT `x \/ y <=> y \/ x`] ABS_EQ_ONE in + let lem01 = (SPEC `(-- (&1 :real)) pow x` lem00) in + let lem02 = (SPEC `x:num` POW_M1) in + let lem03 = MP lem01 lem02 in + STRIP_TAC THEN (ACCEPT_TAC lem03) +) +let NUM_DIVIDES_INT_DIVIDES = prove( + `!(x:num) (y:num).(x divides y) <=> ((&x):int divides ((&y):int))`, + (ONCE_REWRITE_TAC [num_divides]) THEN (SIMP_TAC []) +) +let SON_OF_A_GUN = prove( + `! (p:num) (n:num) . + p > n + ==> (prime p) + ==> ~(int_divides (& p) (&(FACT n) pow p * -- &1 pow (n * p) ))`, + let POW_INT_NEG_1 = INT_OF_REAL_THM POW_NEG_1 in + let lem0000 = TAUT `(A /\ B ==> C) <=> (A ==> B ==> C)` in + let lem0001 = ONCE_REWRITE_RULE [lem0000] PLANETMATH_DIVIDES_FACT_PRIME_1 in + let lem0002 = UNDISCH_ALL (SPEC_ALL lem0001) in + let lem0008 = ONCE_REWRITE_RULE [TAUT `(x /\ y ==> z) <=> (x ==> ~z ==> ~y)`] PRIME_DIVEXP in + let lem0009 = SPECL [`p:num`;`p:num`;`FACT n`] lem0008 in + let lem0010 = UNDISCH lem0009 in + let lem0011 = MP lem0010 lem0002 in + STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + (DISJ_CASES_TAC (SPEC `(n * p):num` POW_INT_NEG_1)) THENL + [ (ASM_SIMP_TAC [INT_OF_NUM_POW; ARITH_RULE `x * (--(&1):int) = -- x`;ARITH_RULE `x * ((&1):int) = x`]) THEN + (ONCE_REWRITE_TAC [GSYM INT_DIVIDES_RNEG]) THEN + (ONCE_REWRITE_TAC [ARITH_RULE `-- -- (x:int) = x`]) THEN + (ONCE_REWRITE_TAC [GSYM NUM_DIVIDES_INT_DIVIDES]) THEN + (ACCEPT_TAC lem0011); + (ASM_SIMP_TAC [INT_OF_NUM_POW; ARITH_RULE `x * (--(&1):int) = -- x`;ARITH_RULE `x * ((&1):int) = x`]) THEN + (ONCE_REWRITE_TAC [GSYM NUM_DIVIDES_INT_DIVIDES]) THEN + (ACCEPT_TAC lem0011) + ] +) +let MAY_LEMMA = prove( + `(p:num) > (n:num) + ==> (prime p) + ==> ~(int_divides (& p) ((int_of_num (FACT n)) pow p * -- &1 pow (n * p) + &p * K0))`, + let lem00 = BRW `(x /\ y ==> z) <=> (x ==> ~z ==> ~y)` INT_DIVIDES_ADD_REVR in + let lem0 = prove(`int_divides ((&p):int) (&p * K0)`,INTEGER_TAC) in + let lem1 = (UNDISCH_ALL o SPEC_ALL) SON_OF_A_GUN in + let lem2 = SPECL [`(&p):int`;`((&p):int) * K0`; `(&(FACT n) pow p):int * + -- &1 pow (n * p)` ] lem00 in + let lem3 = MP (MP lem2 lem0) lem1 in + let lem4 = (DISCH_ALL lem3) in + let lem5 = ONCE_REWRITE_RULE [ARITH_RULE `(x:int) + y = y + x`] lem4 in + (ACCEPT_TAC lem5) +) +let PLANET_MATH_alpha_1 = prove( + `n > 0 ==> p > n ==> prime p ==> (integer (poly (SOD (g n p )) (&0)))`, + let a1 = UNDISCH (UNDISCH (ARITH_RULE `n > 0 ==> p > n ==> p > 1`)) in + let a2 = UNDISCH (SIMP_RULE [] (DISCH `n > 0` (MP PLANETMATH_EQN_5_2 a1))) in + let t1 = `integer K0 /\ + poly (SOD (g n p)) (&0) = + &(FACT n) pow p * -- &1 pow (n * p) + &p * K0` in + (STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC) THEN (CHOOSE_TAC a2) THEN + (SPLIT_CONJOINED_ASSUMPT_TAC t1) THEN (ASM_REWRITE_TAC[]) THEN + (ASM_SIMP_TAC [N_IS_INT;INTEGER_ADD;NEG_N_IS_INT;INTEGER_POW;INTEGER_MUL]) +) +let PLANET_MATH_alpha_2 = prove( + `n > 0 ==> p > n ==> prime p ==> + ( ~((&p) divides (int_of_real (poly (SOD (g n p )) (&0)))))`, + let t1 = `integer K0 /\ + poly (SOD (g n p)) (&0) = + &(FACT n) pow p * -- &1 pow (n * p) + &p * K0` in + let t = `((real_of_num (FACT n)) pow p) * (-- &1 pow (n * p)) + (&p * K0)` in + let arch0 = INT_OF_REAL_CONV t in + let a1 = UNDISCH (UNDISCH (ARITH_RULE `n > 0 ==> p > n ==> p > 1`)) in + let a2 = UNDISCH (SIMP_RULE [] (DISCH `n > 0` (MP PLANETMATH_EQN_5_2 a1))) in + let a3 = SPEC `int_of_real K0` (GEN `K0:int` MAY_LEMMA) in + let a4 = GSYM (UNDISCH arch0) in + let a5 = ONCE_REWRITE_RULE [a4] a3 in + STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN (CHOOSE_TAC a2) THEN + (SPLIT_CONJOINED_ASSUMPT_TAC t1) THEN (ASM_SIMP_TAC [a5]) +) +let INT_OF_REAL_NEG_INT_OF_NUM = prove( + `!n. int_of_real(-- (real_of_num n)) = -- int_of_num n`, + SIMP_TAC [int_of_num;INT_OF_REAL_NEG_NUM] +) +let PLANET_MATH_alpha_3 = prove( + `n > 0 ==> p > n ==> prime p ==> + (~((poly (SOD (g n p)) (&0)) = &0))`, + let lem0 = prove( + `!(x:num) (y:real). + (x > 0) ==> + (integer y) ==> + (~(&x divides (int_of_real y))) ==> + ~(y = &0)`, + MESON_TAC [is_int;INT_OF_NUM_GT;INT_DIVIDES_RNEG;REAL_OF_NUM_EQ;int_of_num;INT_OF_REAL_NEG_INT_OF_NUM;INT_OF_NUM_EQ;INT_DIVIDES_0]) in + let lem1 = ARITH_RULE `n > 0 ==> p > n ==> p > 0` in + MESON_TAC [lem0;lem1; PLANET_MATH_alpha_1; PLANET_MATH_alpha_2] +) +let PLANET_MATH_alpha = prove( + `n > 0 ==> p > n ==> prime p ==> + ( (integer (poly (SOD (g n p )) (&0))) + /\ ~((&p) divides (int_of_real (poly (SOD (g n p )) (&0)))) + /\ ~((poly (SOD (g n p)) (&0)) = &0))`, + SIMP_TAC [PLANET_MATH_alpha_1; PLANET_MATH_alpha_2; PLANET_MATH_alpha_3] +) +let REAL_FACT_NZ = prove( + `~((&(FACT n)) = (real_of_num 0))`, + let l0 = GSYM (SPECL [`FACT n`;`0`] REAL_OF_NUM_EQ) in + ACCEPT_TAC (SPEC_ALL (ONCE_REWRITE_RULE [l0] FACT_NZ)) +) + +let IS_INT_FACT_DIV_FACT_DIV_FACT = prove( + `! i k.integer ((&(FACT (i+k)))/(&(FACT i))/(&(FACT k)))`, + let l0 = MATCH_MP (ARITH_RULE `(~(x=0)) ==> 0 < x`) (SPEC `k:num` FACT_NZ) in + let l1 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_LT] l0 in + let l2 = MATCH_MP REAL_EQ_LDIV_EQ l1 in + (REPEAT STRIP_TAC) THEN (REWRITE_TAC [is_int;l2]) THEN + (EXISTS_TAC ` (binom(i+k,k))`) THEN DISJ1_TAC THEN + (MESON_TAC [BINOM_FACT;MULT_SYM;MULT_ASSOC;REAL_OF_NUM_MUL;REAL_OF_NUM_EQ]) +) + +(* if you replace the second SIMP_TAC with MESON_TAC, it fails!! + * (i alwasy thought MESON_TAC was strictly stronger than SIMP_TAC + *) +let POLY_CMUL_EL = prove( + `!p c i.(i < (LENGTH p)) ==> (EL i (c ## p)) = c * (EL i p)`, + let l0 = ARITH_RULE `(SUC i) < (SUC j) <=> i < j` in + LIST_INDUCT_TAC THENL + [ (SIMP_TAC [LENGTH;ARITH_RULE `~(n < (0:num))`]); + STRIP_TAC THEN INDUCT_TAC THENL + [ (SIMP_TAC [poly_cmul;HD;EL]); + (ASM_SIMP_TAC [LENGTH;poly_cmul;TL;EL;l0]) + ] + ] +) +let PDI_COEFF_FACT = prove( + `! k q i.(i < LENGTH (poly_diff_iter q k)) ==> + (EL i (poly_diff_iter q k)) = ((&(FACT (i+k)))/(&(FACT i))) * (EL (i+k) q)`, + let t0 = `!q i. i < LENGTH (poly_diff_iter q k) + ==> EL i (poly_diff_iter q k) = &(FACT (i + k)) / &(FACT i) * EL (i + k) q` in + let l0 = SPECL [`q:(real)list`;`SUC i`] ( ASSUME t0) in + let l1 = ONCE_REWRITE_RULE [ARITH_RULE `(SUC i) < x <=> i < (PRE x)`] l0 in + let l2 = ONCE_REWRITE_RULE [GSYM LENGTH_POLY_DIFF] l1 in + let l3 = ONCE_REWRITE_RULE [FACT;GSYM REAL_OF_NUM_MUL] l2 in + let l4 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_MUL] l3 in + let l5 = REWRITE_RULE [real_div;REAL_INV_MUL] l4 in + let l6 = REAL_ARITH `(w * (inv x) * y ) * z = (w * y * z) * (inv x)` in + let l9 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_LT] (ARITH_RULE `0 < SUC i`) in + let l10 = MATCH_MP REAL_EQ_RDIV_EQ l9 in + let l11 = ONCE_REWRITE_RULE [l6] l5 in + let l12 = ONCE_REWRITE_RULE [real_div] l10 in + let l13 = ONCE_REWRITE_RULE [l12] l11 in + INDUCT_TAC THENL + [ (REWRITE_TAC [Pm_lemma1.PDI_DEF;ARITH_RULE `i + 0 = i`]) THEN + (MESON_TAC [REAL_DIV_REFL;FACT_NZ;REAL_OF_NUM_EQ;REAL_ARITH `(real_of_num 1) * x = x`]); + (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN (SIMP_TAC [EL_POLY_DIFF]) THEN + (ONCE_REWRITE_TAC [ARITH_RULE `i + (SUC k) = (SUC i) + k`]) THEN + (ONCE_REWRITE_TAC [FACT]) THEN (ONCE_REWRITE_TAC [real_div]) THEN + (SIMP_TAC [l13;real_div;REAL_MUL_ASSOC]) + ] +) +(* I think this should hold if we replace [--a;&1] with an arbitrary polynomial q, + * however the existing ORDER* theorems would not be sufficient to prove it and + * I don't feel like putting in the effort right now + *) +let POLY_DIVIDES_POLY_DIFF = prove( + `!p n a. + (poly_divides (poly_exp [--a;&1] (SUC n)) p) + ==> (poly_divides (poly_exp [--a;&1] n) (poly_diff p))`, + let l0 = ARITH_RULE `op = SUC odp ==> SUC n <= op ==> n <= odp` in + let l1 = ARITH_RULE `(SUC n <= m ) ==> ~(m = 0)` in + MESON_TAC [l0;l1;POLY_DIFF_ZERO;ORDER_DIVIDES;ORDER_DIFF] +) +let POLY_DIVIDES_MUL = prove( + `!p1 p2 p3.poly_divides p1 p2 ==> poly_divides p1 (p2 ** p3)`, + (ONCE_REWRITE_TAC [divides]) THEN (REPEAT STRIP_TAC) THEN + (EXISTS_TAC `q ** p3`) THEN + (ASM_MESON_TAC [FUN_EQ_THM;POLY_MUL;POLY_MUL_ASSOC]) +) +let POLY_DIVIDES_MUL3 = prove( + `!p1 p2 p3.(poly_divides p1 p2) ==> (poly_divides p1 (p3 ** p2))`, + (ONCE_REWRITE_TAC [divides]) THEN (REPEAT STRIP_TAC) THEN + (EXISTS_TAC `p3 ** q`) THEN (UNDISCH_TAC `poly (p2) = poly (p1 ** q)`) THEN + (ONCE_REWRITE_TAC [FUN_EQ_THM]) THEN (REWRITE_TAC [POLY_MUL]) THEN + (MESON_TAC [REAL_MUL_ASSOC;REAL_MUL_SYM]) +) +let POLY_DIVIDES_POLY_MUL_ITER = prove( + `!f n v. 1 <= v ==> v <= n ==> poly_divides (f v) (poly_mul_iter f n)`, + let l1 = ARITH_RULE `~(v <= n) ==> (v <= SUC n) ==> v = SUC n` in + let l2 = UNDISCH (UNDISCH l1) in + STRIP_TAC THEN INDUCT_TAC THENL + [ ARITH_TAC; + (ONCE_REWRITE_TAC [Pm_eqn5.POLY_MUL_ITER]) THEN STRIP_TAC THEN + (ASM_CASES_TAC `v <= (n:num)`) THENL + [ ASM_MESON_TAC [POLY_DIVIDES_MUL3]; + STRIP_TAC THEN STRIP_TAC THEN + (MESON_TAC [l2;POLY_DIVIDES_MUL;POLY_DIVIDES_REFL]) ] + ] +) +(* + * This one was suprisingly tricky to prove... + *) +let POLY_DIVIDES_POLY_EXP2 = prove( + `!n p1 p2.(poly_divides p1 p2) ==> poly_divides (poly_exp p1 n) (poly_exp p2 n)`, + let t0 = `!p1 p2. + (?q. poly p2 = poly (p1 ** q)) + ==> (?q. poly (poly_exp p2 n) = poly (poly_exp p1 n ** q))` in + let l0 = ASSUME t0 in + let l1 = UNDISCH (REWRITE_RULE [divides] (SPEC_ALL l0)) in + let l3 = prove( + `(x2 = x5 * x6 /\ x1 = x4 * x7) ==> (x1:real) * x2 = (x4 * x5) * x6 * x7`, + MESON_TAC [REAL_MUL_SYM;REAL_MUL_ASSOC]) in + (ONCE_REWRITE_TAC [divides]) THEN INDUCT_TAC THENL + [ (MESON_TAC [divides;poly_exp;POLY_DIVIDES_REFL]); + (STRIP_TAC THEN STRIP_TAC THEN DISCH_TAC) THEN (CHOOSE_TAC l1) THEN + (UNDISCH_TAC `?q. poly p2 = poly (p1 ** q)`) THEN STRIP_TAC THEN + (ONCE_REWRITE_TAC [poly_exp]) THEN (EXISTS_TAC `q ** q'`) THEN + (REWRITE_TAC [poly_exp;FUN_EQ_THM;POLY_MUL]) THEN + (ASM_MESON_TAC [l3;FUN_EQ_THM;POLY_MUL]) + ] +) +let POLY_EXP_ONE = prove( + `!p .p = poly_exp p 1`, + MESON_TAC [poly_exp;ARITH_RULE `1 = SUC 0`;POLY_MUL_RID] +) +let POLY_DIVIDES_ROOT = prove( + `!p a.poly_divides [--a;&1] p ==> (poly p a) = &0`, + MESON_TAC [ORDER_ROOT;ORDER_DIVIDES;POLY_EXP_ONE; + ARITH_RULE `1 <= ord ==> ~(ord = 0)`] +) + +let POLY_DIVIDES_PDI = prove( + `!n p a. + (poly_divides (poly_exp [--a;&1] (SUC n)) p) + ==> (poly_divides [--a;&1] (poly_diff_iter p n))`, + let t0 = `!p a. poly_divides (poly_exp [--a; &1] (SUC n)) p + ==> poly_divides [--a; &1] (poly_diff_iter p n)` in + let l0 = ASSUME t0 in + let l1 = SPEC `poly_diff p` l0 in + let l2 = SPECL [`p:(real)list`;`SUC n`;`a:real`] POLY_DIVIDES_POLY_DIFF in + let l3 = UNDISCH l2 in + let l4 = MATCH_MP l1 l3 in + INDUCT_TAC THENL + [ (SIMP_TAC [poly_exp;POLY_MUL_RID;Pm_lemma1.PDI_DEF]); + (REPEAT STRIP_TAC) THEN (ASM_MESON_TAC [l4;Pm_lemma1.PDI_DEF;PDI_POLY_DIFF_COMM]) + ] +) +let POLY_DIVIDES_PDI2 = prove( + `!n m p a. + m > n + ==> (poly_divides (poly_exp [--a;&1] m) p) + ==> (poly_divides [--a;&1] (poly_diff_iter p n))`, + MESON_TAC [POLY_EXP_DIVIDES;POLY_DIVIDES_PDI; + ARITH_RULE `m > n <=> (SUC n) <= m`] +) +let TAIL_GUNNER = prove( + ` x < p ==> 1 <= v ==> v <= n ==> + poly (poly_diff_iter + (poly_exp [&0; &1] (p - 1) ** + poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p) + x) + (&v) + = &0 `, + MESON_TAC [POLY_DIVIDES_ROOT; ARITH_RULE `x < p <=> (p:num) > x`; + POLY_DIVIDES_PDI2; POLY_DIVIDES_MUL3; POLY_DIVIDES_POLY_EXP2; + POLY_DIVIDES_POLY_MUL_ITER] +) + +let IS_INT_POLY = prove( + `!p x.(integer x) ==> (ALL integer p) ==> integer (poly p x)`, + LIST_INDUCT_TAC THEN + (ASM_MESON_TAC [N_IS_INT;ALL;poly;INTEGER_ADD;INTEGER_MUL]) +) +(* surprising the MESON needs so much help with the rewrites here + * (i.e. i though i could just hit it with ASM_MESON_TAC with all four thms + *) +let INV_POLY_CMUL = prove( + `!y x . (~(x = &0)) ==> (x) ## (inv x) ## y = y`, + LIST_INDUCT_TAC THENL + [ ASM_MESON_TAC [poly_cmul]; + (REPEAT STRIP_TAC) THEN + (REWRITE_TAC [poly_cmul;REAL_MUL_ASSOC]) THEN + (ASM_MESON_TAC [REAL_MUL_RINV;REAL_MUL_LID]) + ] +) +let INV_POLY_CMUL2 = prove( + `!y x . (~(x = &0)) ==> (inv x) ## (x) ## y = y`, + MESON_TAC [INV_POLY_CMUL;REAL_INV_INV;REAL_INV_EQ_0] +) +(* the final ASM_MESON_TAC fails if poly_cmul is rolled into the thm list *) +let POLY_CMUL_EQUALS = prove( + `!z x y. (~(z = &0)) ==> ((x = y) <=> (z ## x = z ## y))`, + (REPEAT STRIP_TAC) THEN EQ_TAC THENL + [ (SIMP_TAC[]); + (SPEC_TAC (`x:(real)list`,`x:(real)list`)) THEN + (SPEC_TAC (`y:(real)list`,`y:(real)list`)) THEN + (LIST_INDUCT_TAC) THENL + [ LIST_INDUCT_TAC THENL + [ (SIMP_TAC [POLY_CMUL_CLAUSES]); + (ASM_MESON_TAC [POLY_CMUL_CLAUSES;NOT_CONS_NIL])]; + LIST_INDUCT_TAC THENL [ + (ASM_MESON_TAC [POLY_CMUL_CLAUSES;NOT_CONS_NIL]); + (ONCE_REWRITE_TAC [poly_cmul]) THEN + (ASM_MESON_TAC [REAL_EQ_LCANCEL_IMP;CONS_11])] + ] + ] +) +let PDI_LENGTH_THM = prove( + `!f n. LENGTH(poly_diff_iter f n) = (LENGTH f) - n`, + STRIP_TAC THEN INDUCT_TAC THENL + [ (SIMP_TAC [Pm_lemma1.PDI_DEF;ARITH_RULE `(x:num) - 0 = x`]); + (ONCE_REWRITE_TAC [Pm_lemma1.PDI_DEF]) THEN + (ONCE_REWRITE_TAC [LENGTH_POLY_DIFF]) THEN ASM_ARITH_TAC ] +) +let CAPTAINS_CLOTHES = prove( + `! k q. + (ALL integer q) ==> + ? r .(ALL integer r) /\ r = (inv (&(FACT k))) ## (poly_diff_iter q k)` + , + let e0 = `(inv (&(FACT k))) ## (poly_diff_iter q k)` in + let l1 = ONCE_REWRITE_RULE [GSYM (SPEC `inv (&(FACT k))` POLY_CMUL_LENGTH)] + PDI_COEFF_FACT in + let l2 = UNDISCH (SPEC_ALL l1) in + let l3 = prove(`i < LENGTH( inv (&(FACT k)) ## poly_diff_iter q k) + ==> (i + k) < LENGTH q`, + MESON_TAC [PDI_LENGTH_THM;POLY_CMUL_LENGTH; + ARITH_RULE `(i:num) < f -k ==> (i+k) < f`]) in + (REPEAT STRIP_TAC) THEN (EXISTS_TAC e0) THEN (SIMP_TAC []) THEN + (ASM_SIMP_TAC [ONCE_REWRITE_RULE [GSYM POLY_CMUL_LENGTH] POLY_CMUL_EL]) THEN + (ONCE_REWRITE_TAC [GSYM ALL_EL]) THEN (REPEAT STRIP_TAC) THEN + (ASM_SIMP_TAC [ONCE_REWRITE_RULE [GSYM POLY_CMUL_LENGTH] POLY_CMUL_EL]) THEN + (ONCE_REWRITE_TAC [l2]) THEN (ONCE_REWRITE_TAC [REAL_MUL_ASSOC]) THEN + (MATCH_MP_TAC INTEGER_MUL) THEN STRIP_TAC THENL + [ (MESON_TAC [IS_INT_FACT_DIV_FACT_DIV_FACT;REAL_MUL_SYM;real_div;REAL_MUL_ASSOC]); + (ASM_MESON_TAC [l3;ALL_IMP_EL]) ] +) +let MESSY_JESSE2 = prove( + `n > 0 ==> p > n ==> + (? (Bs:num->num->real). ! v . + (1 <= v) ==> (v <= n) ==> + ( (! i . (integer (Bs v i))) + /\ (poly (SOD (g n p)) (&v)) = + ((real_of_num 1) / (&(FACT (p - 1)))) * + (psum (0,LENGTH (g n p)) + (\i. (&(FACT i)) * (Bs v i))) + /\ (! i. (i < p) ==> (Bs v i) = &0) ))`, + let root_canal = REAL_ARITH `(x:real) * (&0) = &0` in + let bs = `\(v:num) . \(x:num). + if (x <= (LENGTH (g n p)) ) then + (poly + ((inv (&(FACT x))) ## + (poly_diff_iter + (poly_exp [&0; &1] (p - 1) ** + poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p) + x)) + (&v)) + else (&0)` in + let l0 = prove(`ALL integer [&0;&1]`,MESON_TAC [ALL;N_IS_INT]) in + let t0 = `(poly_exp [&0; &1] (p - 1) ** + poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p)` in + let l2 = SPECL [`i:num`;t0] CAPTAINS_CLOTHES in + let l3 = prove(`ALL integer (poly_exp [&0; &1] (p - 1) ** poly_exp (poly_mul_iter (\i. [-- &i; &1]) n) p)`,MESON_TAC[l0;ALL_IS_INT_POLY_MUL;ALL_IS_INT_POLY_EXP;ALL_IS_INT_POLY_MUL_ITER]) in + let l4 = MP l2 l3 in + let l7 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_EQ] FACT_NZ in + let l8 = (SIMP_RULE [l7]) (SPEC `(&(FACT i)):real` POLY_CMUL_EQUALS) in + (* these are not true for x =0, however we only use it for x= &(FACT i) *) + let l10_0 = SPECL [`y:(real)list`;`(real_of_num (FACT i))`] INV_POLY_CMUL in + let l12_0 = SPECL [`y:(real)list`;`(real_of_num (FACT i))`] INV_POLY_CMUL2 in + let l10 = SIMP_RULE [REAL_FACT_NZ] l10_0 in + let l12 = SIMP_RULE [REAL_FACT_NZ] l12_0 in + let l9 = ONCE_REWRITE_RULE [l8] l4 in + let l11 = GSYM (ONCE_REWRITE_RULE [l10] l9) in + let l133 = prove(` + (psum (0,m) (\i.(x i) * (if i <= m then (y i) else c))) = + (psum (0,m) (\i.(x i) * (y i)))`, + MESON_TAC [SUM_EQ;ARITH_RULE `(0 <= i /\ i < (m:num) + 0) ==> i <= m`]) in + let l18 = MATCH_MP REAL_MUL_RINV (SPEC `i:num` l7) in + let lass2 = SPECL [`g n p`;`x:real`;`v:real`] Pm_lemma2.PLANETMATH_LEMMA_2_B in + let lass3 = BETA_RULE lass2 in + let lass4 = CONV_RULE (RAND_CONV (RAND_CONV (REWRITE_CONV [Pm_eqn5.PLANETMATH_EQN_5]))) lass3 in + let lass5 = REWRITE_RULE [POLY_CMUL;POLY_CMUL_PDI] lass4 in + let lass6 = CONV_RULE (RAND_CONV (ONCE_REWRITE_CONV [GSYM (ISPEC `f:num->real` ETA_AX)])) (SPEC_ALL SUM_CMUL) in + let lass7 = ONCE_REWRITE_RULE [GSYM REAL_MUL_ASSOC] lass5 in + let lass8 = REWRITE_RULE [lass6] lass7 in + let lass10 = ONCE_REWRITE_RULE [REAL_MUL_DIV_ASSOC] lass8 in + let lass11 = ONCE_REWRITE_RULE [real_div] lass10 in + let lass12 = REAL_ARITH `((w:real) * x * y) * z = w * x * y * z` in + let lass13 = ONCE_REWRITE_RULE [lass12] lass11 in + let lass14 = REWRITE_RULE [lass6] lass13 in + let MUL_ONE = REAL_ARITH `! x.(&1) * x = x /\ x * (&1) = x` in + let lass15 = SIMP_RULE [REAL_MUL_LINV;REAL_FACT_NZ;MUL_ONE] lass14 in + STRIP_TAC THEN STRIP_TAC THEN (EXISTS_TAC bs) THEN (REPEAT STRIP_TAC) THENL + [ + (BETA_TAC THEN BETA_TAC) THEN (ASM_CASES_TAC `(i <= LENGTH (g n p))`) THENL + [ (ASM_SIMP_TAC[]) THEN (ASM_CASES_TAC `((i:num) < p)`) THENL + [ (ASM_MESON_TAC [POLY_CMUL;TAIL_GUNNER; + N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]); + (ASSUME_TAC (UNDISCH (ARITH_RULE `~(i < (p:num)) ==> (p <= i)`))) THEN + (CHOOSE_TAC l11) THEN + (SPLIT_CONJOINED_ASSUMPT_TAC (snd (dest_exists (concl l11)))) THEN + (ASM_REWRITE_TAC[l12]) THEN + (ASM_MESON_TAC [N_IS_INT;IS_INT_POLY]) + ]; + (ASM_MESON_TAC [N_IS_INT]) + ]; + (BETA_TAC) THEN (SIMP_TAC [l133]) THEN + (SIMP_TAC [POLY_CMUL;l18;REAL_MUL_ASSOC;REAL_MUL_LID]) THEN + (SIMP_TAC [lass15;REAL_INV_1OVER]); + BETA_TAC THEN (ASM_MESON_TAC [TAIL_GUNNER;POLY_CMUL;root_canal]) + ] +) +let INTEGER_PSUM = prove( + `!f m.(! i . i < m ==> integer (f i)) ==> (integer (psum (0,m) f))`, + let l0 = ASSUME `!i. i < SUC m ==> integer (f i)` in + let l1 = SPEC `m:num` l0 in + let l2 = SIMP_RULE [ARITH_RULE `m < SUC m`] l1 in + STRIP_TAC THEN INDUCT_TAC THENL + [ (MESON_TAC [sum;int_of_num;int_of_num_th;N_IS_INT]); + (SIMP_TAC [sum;ARITH_RULE `0 + (x:num) = x`]) THEN + (STRIP_TAC) THEN (MATCH_MP_TAC INTEGER_ADD) THEN + (ASM_MESON_TAC[l2;ARITH_RULE `(i:num) < m ==> i < SUC m`]) + ] +) +let INT_DIVIDES_PSUM = prove( + `!f m p.(! i . i < m ==> + ((integer (f i)) /\ (int_divides p (int_of_real (f i))))) + ==> (int_divides p (int_of_real (psum (0,m) f)))`, + let l0 = ASSUME `!i. i < SUC m ==> integer (f i) /\ p divides int_of_real (f i)` in + let l1 = SPEC `m:num` l0 in + let l2 = SIMP_RULE [ARITH_RULE `m < SUC m`] l1 in + let l3 = ASSUME `(!i. i < m ==> integer (f i)) ==> integer (psum (0,m) f)` in + let l4 = SPEC `i:num` l0 in + let l5 = DISCH `i < SUC m` ((CONJUNCT1 (UNDISCH l4))) in + let l8 = prove(`(!i.i < SUC m + ==> (integer (f i))) ==> (!i.i < m ==> (integer (f i)))`, + MESON_TAC [ARITH_RULE `i < m ==> i < SUC m`]) in + let ll1 = MP l8 (GEN_ALL l5) in + let ll2 = MP l3 ll1 in + let ll3 = MATCH_MP INT_OF_REAL_ADD (CONJ ll2 (CONJUNCT1 l2)) in + STRIP_TAC THEN INDUCT_TAC THENL + [ (MESON_TAC [sum;int_of_num;int_of_num_th;INT_DIVIDES_0]); + (SIMP_TAC [sum;ARITH_RULE `0 + (x:num) = x`]) THEN + (ASSUME_TAC (SPECL [`f:num->real`;`m:num`] INTEGER_PSUM)) THEN + (STRIP_TAC) THEN + (STRIP_TAC) THEN + (ONCE_REWRITE_TAC [ll3]) THEN + (MATCH_MP_TAC INT_DIVIDES_ADD) THEN + (CONJ_TAC) THENL + [ (ASM_MESON_TAC [ARITH_RULE `i < m ==> i < SUC m`]); + (ASM_MESON_TAC [ARITH_RULE `m < SUC m`]) + ] + ] +) +let PLANET_MATH_beta = prove( + `p > n ==> + n > 0 ==> + (! v. + (1 <= v /\ v <= n) ==> + ( (integer (poly (SOD (g n p )) (&v))) + /\ ((&p) divides (int_of_real (poly (SOD (g n p )) (&v)))) + ) + )`, + let l2 = GSYM (ONCE_REWRITE_RULE [REAL_MUL_SYM] real_div) in + let ll3 = ARITH_RULE `(int_of_num p) * &0 = &0` in + let l7 = UNDISCH (SPECL [`i:num`;`p:num`] IS_INT_FACT_DIV) in + let l11 = prove(`p > 0 ==> FACT p = p * (FACT (p-1))`, + MESON_TAC [FACT; ARITH_RULE `p > 0 ==> SUC (p -1) = p `]) in + let l12 = UNDISCH (UNDISCH (ARITH_RULE `(p:num) > n ==> n > 0 ==> p > 0`)) in + let l13 = MP l11 l12 in + let t9 = + `1 <= (v:num) ==> + v <= (n:num) ==> + (!v. 1 <= v + ==> v <= n + ==> (!i. integer (Bs v i)) /\ + poly (SOD (g n p)) (&v) = + &1 / &(FACT (p - 1)) * + psum (0,LENGTH (g n p)) (\i. &(FACT i) * Bs v i) /\ + (!i. i < p ==> Bs v i = &0)) ==> + (integer (Bs v i))` in + let lll0 = UNDISCH (UNDISCH (UNDISCH (prove(t9,MESON_TAC[])))) in + let l8 = REWRITE_RULE [l13;real_div;REAL_INV_MUL] l7 in + let l9 = REWRITE_RULE [N_IS_INT;GSYM REAL_OF_NUM_MUL] l8 in + let l10 = REWRITE_RULE [REAL_INV_MUL] l9 in + let l11 = MATCH_MP (INTEGER_MUL) (CONJ l10 lll0) in + let l12 = MATCH_MP INT_OF_REAL_MUL (CONJ (SPEC `p:num` N_IS_INT) l11) in + let l15 = GSYM l12 in + let lll8 = ARITH_RULE `p > n ==> n > 0 ==> ~(p = 0)` in + let lll9 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_EQ] lll8 in + let lll10 = UNDISCH (UNDISCH lll9) in + + let sc1 = prove (`(~((x:real) = &0)) ==> (x * y * inv x) = y`, + MESON_TAC [REAL_MUL_RID;REAL_MUL_ASSOC; + REAL_MUL_SYM;REAL_MUL_LINV;REAL_MUL_LID]) in + let sc2 = prove (`(~((x:real) = &0)) ==> (x * y * (inv x) * z) = y * z`, + MESON_TAC [sc1;REAL_MUL_ASSOC]) in + (REPEAT STRIP_TAC) THENL + [ (CHOOSE_TAC (UNDISCH (UNDISCH MESSY_JESSE2))) THEN + (ASM_SIMP_TAC []) THEN + (ONCE_REWRITE_TAC [GSYM SUM_CMUL]) THEN + (MATCH_MP_TAC INTEGER_PSUM) THEN + (REPEAT STRIP_TAC) THEN + BETA_TAC THEN + (ASM_CASES_TAC `i < (p:num)`) THENL + [ (ASM_SIMP_TAC [N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]); + (ASSUME_TAC (UNDISCH (ARITH_RULE `(~((i:num) < p)) ==> i >= p-1`))) THEN + (ASM_MESON_TAC [REAL_INV_1OVER;REAL_MUL_ASSOC; + IS_INT_FACT_DIV; l2;INTEGER_MUL]) + ]; + (CHOOSE_TAC (UNDISCH (UNDISCH MESSY_JESSE2))) THEN + (ASM_SIMP_TAC []) THEN + (ONCE_REWRITE_TAC [GSYM SUM_CMUL]) THEN + (MATCH_MP_TAC INT_DIVIDES_PSUM) THEN + (REPEAT STRIP_TAC) THENL + [ BETA_TAC THEN + (ASM_CASES_TAC `i < (p:num)`) THENL + [ (ASM_SIMP_TAC [N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]); + (ASSUME_TAC (UNDISCH (ARITH_RULE `(~((i:num) < p)) ==> i >= p-1`))) THEN + (ASM_MESON_TAC [REAL_INV_1OVER;REAL_MUL_ASSOC; + IS_INT_FACT_DIV; l2;INTEGER_MUL]) + ]; + (ONCE_REWRITE_TAC [int_divides]) THEN BETA_TAC THEN + (ASM_CASES_TAC `i < (p:num)`) THENL + [ (ASM_SIMP_TAC [N_IS_INT;REAL_ARITH `(x:real) * (&0) = &0`]) THEN + (EXISTS_TAC `int_of_num 0`) THEN + (MESON_TAC [ll3;int_of_num_th;int_of_num]); + (ASSUME_TAC (UNDISCH (ARITH_RULE `(~((i:num) < p)) ==> i >= p`))) THEN + (EXISTS_TAC `int_of_real (((&(FACT i))/(&(FACT p))) * (Bs (v:num) i))`) THEN + (ONCE_REWRITE_TAC [int_of_num]) THEN + (ONCE_REWRITE_TAC [l13]) THEN + (ONCE_REWRITE_TAC [N_IS_INT;GSYM REAL_OF_NUM_MUL]) THEN + (SIMP_TAC [ real_div]) THEN + (ONCE_REWRITE_TAC [ REAL_INV_MUL]) THEN + (ONCE_REWRITE_TAC [ REAL_MUL_LID]) THEN + (ONCE_REWRITE_TAC [l15]) THEN + (ASSUME_TAC lll10) THEN + (ONCE_REWRITE_TAC [REAL_MUL_ASSOC]) THEN + (ASM_MESON_TAC [sc2;REAL_MUL_SYM]) + ] + ] + ] +) + +let JUNE_LEMMA = prove( + `n > 0 ==> p > n ==> v <= n ==> integer (poly (SOD (g n p)) (&v))`, + let lem0 = CONJUNCT1 (UNDISCH_ALL PLANET_MATH_alpha) in + let lem1 = UNDISCH_ALL (SPEC_ALL (UNDISCH_ALL PLANET_MATH_beta)) in + let lem2 = DISCH `1 <= v /\ v <= n` (CONJUNCT1 lem1) in + let lem3 = SPEC `SUC v` (GEN `v:num` lem2) in + let lem4 = SIMP_RULE [ARITH_RULE `1 <= SUC v`] lem3 in + (STRIP_TAC THEN STRIP_TAC) THEN + (SPEC_TAC (`v:num`,`v:num`)) THEN + (INDUCT_TAC THENL [(SIMP_TAC [lem0]);(ACCEPT_TAC lem4)]) +) +let DIVIDES_SUM_NOT_ZERO = prove( + `!(x:int) (y:int) (z:int). + (~(z divides x)) /\ (z divides y) ==> ~(x + y = &0)`, + let l0 = ASSUME `(x:int) + y = &0` in + let l1 = ONCE_REWRITE_RULE [ARITH_RULE `((x:int) + y = &0) <=> (x = --y)`] l0 in + (REPEAT STRIP_TAC) THEN (UNDISCH_TAC `~((z:int) divides x)`) THEN + (REWRITE_TAC [l1]) THEN (UNDISCH_TAC `((z:int) divides y)`) THEN + (INTEGER_TAC) +) +let NUM_OF_INT_ABS = prove( + `!(x:num) (y:int).num_of_int (abs y) = x <=> abs y = &x`, +(* stupid... *) + let j0 = UNDISCH (prove(`(num_of_int (abs y) = x) ==> x = num_of_int (abs y)`,MESON_TAC [])) in + let j1 = ARITH_RULE `&0 <= ((abs y):int)` in + let j2 = MATCH_MP INT_OF_NUM_OF_INT j1 in + (REPEAT STRIP_TAC) THEN EQ_TAC THENL + [ (STRIP_TAC THEN SIMP_TAC [j0;j2]); + (ASM_SIMP_TAC [NUM_OF_INT_OF_NUM])] +) +let INT_DIVIDES_IMP_ABS_NUM_DIVIDES = prove( + `! (x:int) (y:num). + (x divides (&y)) ==> ((num_of_int (abs x)) divides y)`, + let w0 = ARITH_RULE `((&0):int) <= abs x` in + let w1 = fst (EQ_IMP_RULE (SPEC `abs (x:int)` NUM_OF_INT)) in + let w2 = MP w1 w0 in + let w3 = ARITH_RULE `((&0):int) <= x ==> abs x = x` in + let w4 = ARITH_RULE `(~(((&0):int) <= x)) ==> abs x = -- x` in + (REWRITE_TAC [int_divides;num_divides]) THEN + (REPEAT STRIP_TAC) THEN (ASM_REWRITE_TAC [w2]) THEN + (ASM_CASES_TAC `((&0):int) <= x`) THENL + [ (ONCE_REWRITE_TAC [UNDISCH w3]) THEN + (EXISTS_TAC `x':int`) THEN (REFL_TAC); + (ONCE_REWRITE_TAC [UNDISCH w4]) THEN + (EXISTS_TAC `--x':int`) THEN (ARITH_TAC) + ] +) +let INT_PRIME_NUM_PRIME = prove( + `!p. int_prime (&p) <=> prime p`, + (ONCE_REWRITE_TAC [int_prime;prime]) THEN + (MESON_TAC [divides;num_divides; + INT_ABS;INT_POS;INT_OF_NUM_EQ;INT_LT_IMP_NE;INT_GT; + ARITH_RULE `2 <= p ==> abs((&p):int) > &1`; + INT_DIVIDES_IMP_ABS_NUM_DIVIDES;NUM_OF_INT_ABS;PRIME_GE_2; + prime;int_prime ]) +) + +let DIVIDES_INT_OF_REAL_ADD = prove( + `!x y p.integer x /\ + integer y /\ + p divides (int_of_real x) /\ + p divides (int_of_real y) + ==> p divides (int_of_real (x + y))`, + SIMP_TAC [INT_OF_REAL_ADD;INT_DIVIDES_ADD] +) +let ITCHY_LEMMA = prove( + `! f p n. + (!v.1<= v /\ v <= n ==> + integer (f v) /\ + &p divides int_of_real (f v)) ==> + (&p divides int_of_real (sum (1..n) f))`, + let l0 = fst (EQ_IMP_RULE (SPECL [`1`;`0`] (GSYM NUMSEG_EMPTY))) in + let l1 = INTEGER_RULE `&p divides ((&0))` in + let l2 = SPEC `0` (GEN_ALL int_of_num) in + let l3 = ONCE_REWRITE_RULE [l2] l1 in + let l4 = SPECL [`f:num->real`;`n:num`;`1`] IS_INT_SUM in + let l5 = prove(`(!v. 1 <= v /\ v <= SUC n ==> integer (f v)) ==> (!i. 1 <= i /\ i <= n ==> integer (f i))`,MESON_TAC [ARITH_RULE `v <= n ==> v <= SUC n`]) in + let l6 = IMP_TRANS l5 l4 in + let l7 = prove(`(!v. 1 <= v /\ v <= SUC n ==> (integer (f v)) /\ (&p) divides int_of_real (f v)) ==> (&p) divides int_of_real (f (SUC n))`,MESON_TAC [ARITH_RULE `1 <= (SUC n) /\ SUC n <= SUC n`]) in + let l9 = prove(`(!v. 1 <= v /\ v <= SUC n ==> integer (f v)) ==> integer (f (SUC n))`,MESON_TAC [ARITH_RULE `1 <= SUC n /\ SUC n <= SUC n`]) in + let tm = `\(v:num).integer (f v) /\ (&p) divides int_of_real (f v)` in + let l10 = BETA_RULE (SPEC tm SHRIVER) in + let l11 = UNDISCH (SPEC `1` (GEN `m:num` l10)) in + STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL + [ SIMP_TAC [ARITH_RULE `0 < 1`;l0;SUM_CLAUSES;l3]; + DISCH_TAC THEN + (SIMP_TAC [SUM_CLAUSES_NUMSEG;ARITH_RULE `1 <= SUC n`]) THEN + (MATCH_MP_TAC DIVIDES_INT_OF_REAL_ADD) THEN (CONJ_TAC) THENL + [ ASM_SIMP_TAC [l6]; + CONJ_TAC THENL + [ ASM_SIMP_TAC [l9]; + CONJ_TAC THENL + [ ASM_SIMP_TAC [l11]; + ASM_SIMP_TAC [l7] ]]]] +) +let GOTTA_DO_DISHES_LEMMA = prove( + `!(x:real) (y:real). + (integer x) /\ (integer y) ==> + (?(z:int).(~(z divides (int_of_real x))) + /\ (z divides (int_of_real y))) + ==> ~(x + y = &0)`, + let mk_lemma x y = + let lem0 = SPECL [x;y;`z:int`] DIVIDES_SUM_NOT_ZERO in + let lem1 = TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)` in + UNDISCH (UNDISCH (ONCE_REWRITE_RULE [lem1] lem0)) + in + let mk_tac x y = + (ASM_REWRITE_TAC [GSYM int_of_num;INT_OF_REAL_NEG_INT_OF_NUM]) THEN + (STRIP_TAC) THEN + (REWRITE_TAC [GSYM int_neg_th;GSYM int_eq; GSYM int_add_th;GSYM int_of_num_th]) THEN + (ACCEPT_TAC (mk_lemma x y)) + in + (ONCE_REWRITE_TAC [is_int]) THEN + (STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC ) THENL + [ mk_tac `(&n):int` `(&n'):int` ; + mk_tac `(&n):int` `--(&n'):int` ; + mk_tac `--(&n):int` `(&n'):int` ; + mk_tac `--(&n):int` `--(&n'):int` + ] +) + +let RAINY_DAY = prove( + `! p x y. + prime p ==> + (&p) > x ==> + integer x ==> + x > (&0) ==> + integer y ==> + (((&p) divides (int_of_real (x * y))) + <=> ((&p) divides int_of_real y))`, + let ss3 = SPECL [`int_of_num n`;`(&p):int`] INT_PRIME_COPRIME_LT in + let ss4 = ONCE_REWRITE_RULE [ARITH_RULE `abs ((&x):int) = &x`] ss3 in + let ss40 = prove(`!(x:num) (y:num). (int_of_num x) < (int_of_num y) <=> (real_of_num x) < (real_of_num y)`,SIMP_TAC [INT_OF_NUM_LT;REAL_OF_NUM_LT]) in + let ss5 = ONCE_REWRITE_RULE [ss40;INT_COPRIME_SYM;INT_PRIME_NUM_PRIME] ss4 in + let ss6 = SPECL [`(&p):int`;`(&n):int`;`int_of_real y`] INT_COPRIME_DIVPROD in + let ss7 = ONCE_REWRITE_RULE [TAUT `(X /\ Y ==> Z) <=> (Y ==> X ==> Z)`] ss6 in + let ss8 = IMP_TRANS ss5 ss7 in + let ss9 = ONCE_REWRITE_RULE [TAUT `(A /\ B /\ C ==> D ==> E) <=> (A ==> B ==> C ==> D ==> E)`] ss8 in + let ss10 = UNDISCH ss9 in + (REPEAT STRIP_TAC) THEN (ASM_SIMP_TAC [INT_OF_REAL_MUL]) THEN + (EQ_TAC) THENL + [ (SIMP_TAC [INT_DIVIDES_LMUL]) THEN + (UNDISCH_TAC `integer x`) THEN + (ONCE_REWRITE_TAC [is_int]) THEN + (STRIP_TAC) THENL + [ (ASM_REWRITE_TAC[]) THEN + (ONCE_REWRITE_TAC [GSYM int_of_num]) THEN + (UNDISCH_TAC `(&(p:num)) > (x:real)`) THEN + (UNDISCH_TAC `(x:real) > &0`) THEN + (ASM_REWRITE_TAC []) THEN + (ONCE_REWRITE_TAC [REAL_ARITH `(y:real) > z <=> z < y`]) THEN + (ACCEPT_TAC ss10); + (ASM_ARITH_TAC) + ]; + (SIMP_TAC [INT_DIVIDES_LMUL]) + ] +) +let PLANET_MATH_gamma = prove( + `n > 0 ==> + p > n ==> + prime p ==> + &p > (EL 0 c) ==> + (EL 0 c) > (&0) ==> + n = PRE (LENGTH (c)) ==> + (ALL integer c) ==> + ( (integer (LHS c (g n p))) /\ ~((LHS c (g n p)) = &0))`, + let lemma01 = SPECL [`\i. EL i c * poly (SOD (g n p)) (&i)`;`n:num`;`k:num` ] IS_INT_SUM in + let lemma02 = BETA_RULE lemma01 in + let lemma021 = UNDISCH JUNE_LEMMA in + let lemma022 = UNDISCH_ALL (ARITH_RULE `n > 0 ==> p > n ==> p > 1`) in + let lemma023 = DISCH_ALL (SIMP_RULE [lemma022] lemma021) in + let lemma04 = UNDISCH (UNDISCH lemma023) in + let lemma08 = ISPECL [`c:(real)list`;`v:num`;`integer`] ALL_IMP_EL in + let lemma09 = ADD_ASSUM `n > 0` (UNDISCH lemma08) in + let lemma10 = ADD_ASSUM `n = PRE (LENGTH (c:(real)list))` lemma09 in + let lemma11 = ARITH_RULE `n > 0 ==> (n = PRE (LENGTH (c:(real)list))) ==> ((v < LENGTH c) <=> (v <= n))` in + let lemma12 = UNDISCH (UNDISCH lemma11) in + let lemma13 = ONCE_REWRITE_RULE [lemma12] lemma10 in + let lemma15 = CONJ (UNDISCH (UNDISCH lemma04)) (UNDISCH lemma13) in + let lemma16 = MATCH_MP INTEGER_MUL (ONCE_REWRITE_RULE [CONJ_SYM] lemma15) in + let lemma17 = DISCH `v <= (n:num)` lemma16 in + let lemma18 = ADD_ASSUM_DISCH `k <= (v:num)` lemma17 in + let lemma19 = ONCE_REWRITE_RULE [TAUT `(X ==> Y ==> Z) <=> ((X /\ Y) ==> Z)`] lemma18 in + let lemma20 = GEN `v:num` lemma19 in + let lemma21 = GEN `k:num` (MATCH_MP lemma02 lemma20) in + let lemma29 = SPEC `0` lemma21 in + let lemma30 = GSYM (ASSUME `n = PRE (LENGTH (c:(real)list))`) in + let lemma300 = SPECL [`f:(num -> real)`;`0`;`PRE (LENGTH (c:(real)list))`] SUM_CLAUSES_LEFT in + let lemma31 = ADD_ASSUM `n > 0` (ADD_ASSUM `n = PRE (LENGTH (c:(real)list))` lemma300) in + let lemma32 = MP lemma31 (ARITH_RULE `0 <= PRE (LENGTH (c:(real)list))`) in + let lemma0000 = BRW `(X ==> Y ==> Z) <=> ((X /\ Y) ==> Z)` GOTTA_DO_DISHES_LEMMA in + let lemmaa00 = UNDISCH PLANET_MATH_alpha in + let lemmaa03 = ARITH_RULE `n >0 ==> ((n = PRE (LENGTH (c:(real)list))) ==> 0 < (LENGTH c))` in + let lemmaa04 = ISPECL [`c:(real)list`;`0`;`integer`] ALL_IMP_EL in + let lemmaa05 = MP (UNDISCH lemmaa04) (UNDISCH (UNDISCH lemmaa03)) in + let c1 = ARITH_RULE `n > 0 ==> n = PRE (LENGTH (c:(real)list)) ==> 0 < (LENGTH (c:(real)list))` in + let c2 = UNDISCH (UNDISCH c1) in + let c3 = MP (UNDISCH lemmaa04) c2 in + let c4 = CONJUNCT1 (UNDISCH (UNDISCH (UNDISCH PLANET_MATH_alpha))) in + let c40 = CONJUNCT2 (UNDISCH (UNDISCH (UNDISCH PLANET_MATH_alpha))) in + let c5 = SPECL [`p:num`;`(EL 0 c):real`;`poly (SOD (g n p)) (&0)`] RAINY_DAY in + let c7 = ((UNDISCH (UNDISCH c5))) in + let c8 = SIMP_RULE [c3] c7 in + let c9 = UNDISCH c8 in + let c10 = SIMP_RULE [c4] c9 in + let d0 = UNDISCH PLANET_MATH_beta in + let d1 = BRW `(X ==> Y ==> Z) <=> (Y ==> X ==> Z)` d0 in + let d2 = SIMP_RULE [UNDISCH (ARITH_RULE `p > (n:num) ==> n > 0 ==> p > 1`)] d1 in + let d3 = UNDISCH d2 in + let d8 = CONJUNCT2 (UNDISCH (SPEC_ALL d3)) in + let d9 = SPECL [`(&p):int`;`int_of_real (EL v c)`;`int_of_real (poly (SOD (g n p)) (&v))`] INT_DIVIDES_LMUL in + let d10 = ADD_ASSUM `ALL integer c` d9 in + let d11 = ADD_ASSUM `n = PRE (LENGTH (c:(real)list))` d10 in + let d12 = ADD_ASSUM `1 <= v /\ v <= n` d11 in + let d13 = CONJUNCT1 (UNDISCH (SPEC_ALL d3)) in + let d14 = DISCH `1 <= v` (ADD_ASSUM `1 <= v` lemma13) in + let d15 = BRW `(X ==> Y ==> Z) <=> (X /\ Y ==> Z)` d14 in + let d16 = UNDISCH d15 in + let d17 = CONJ d16 d13 in + let d18 = GSYM (MATCH_MP INT_OF_REAL_MUL d17) in + let d19 = ONCE_REWRITE_RULE [d18] d12 in + let d20 = MP d19 d8 in + let d21 = UNDISCH (SPECL [`1`;`v:num`] (GEN `k:num` lemma20)) in + let d22 = CONJ d21 d20 in + let d23 = DISCH `1 <=v /\ v <= n` d22 in + let d24 = GEN `v:num` d23 in + let d25 = MATCH_MP ITCHY_LEMMA d24 in + ((REPEAT STRIP_TAC) THENL + [ (ONCE_REWRITE_TAC [Pm_eqn4.LHS]) THEN (SIMP_TAC [lemma30;lemma29]); + (UNDISCH_TAC `LHS c (g n p) = &0`) THEN + (REWRITE_TAC [Pm_eqn4.LHS]) THEN + (SIMP_TAC [lemma32;ARITH_RULE `0 + 1 = 1`]) THEN + (ONCE_REWRITE_TAC [lemma30]) THEN + (MATCH_MP_TAC lemma0000) THEN + (CONJ_TAC) THENL + [ (CONJ_TAC) THENL + [ (MATCH_MP_TAC INTEGER_MUL) THEN (ASM_SIMP_TAC [lemmaa00;lemmaa05]); + (ACCEPT_TAC (SPEC `1` lemma21)) + ]; + (EXISTS_TAC `(&p):int`) THEN (CONJ_TAC) THENL + [(ONCE_REWRITE_TAC [c10]) THEN (ASM_SIMP_TAC [c40]); + (ACCEPT_TAC d25) + ] + ] + ] ) +) +end;; + + + +module Finale = struct + +let IS_INT_NZ_ABS_GE_1 = prove ( + `!x. ((integer x) /\ ~(x = &0)) ==> ~(abs x < &1)`, + let lemmy0 = REAL_ARITH `(x:real) < y <=> ~(y <= x)` in + let lemmy1 = ONCE_REWRITE_RULE [lemmy0] REAL_NZ_IMP_LT in + let lemmy2 = REAL_ARITH `(real_neg x) = &0 <=> x = &0` in + let lemmy3 = REAL_ARITH `&0 <= (real_neg x) <=> x <= &0` in + (ONCE_REWRITE_TAC [is_int]) THEN + (ONCE_REWRITE_TAC [TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`]) THEN + (STRIP_TAC) THEN (STRIP_TAC) THENL + [ (ASM_REWRITE_TAC[]) THEN (SIMP_TAC [REAL_ABS_NUM] ) THEN + (ONCE_REWRITE_TAC [REAL_OF_NUM_LT;REAL_OF_NUM_EQ]) THEN + (ARITH_TAC); + (ASM_REWRITE_TAC[]) THEN (ONCE_REWRITE_TAC [real_abs]) THEN + (ONCE_REWRITE_TAC [lemmy2;lemmy3]) THEN + (ONCE_REWRITE_TAC [REAL_OF_NUM_EQ]) THEN + (SIMP_TAC [lemmy1;REAL_NEG_NEG]) THEN + (ONCE_REWRITE_TAC [REAL_OF_NUM_LT]) THEN (ARITH_TAC) + ] +) +let PBR_LEMMA = prove( + `!n1 n2 n3 p. p > MAX n1 (MAX n2 n3) ==> (p > n1 /\ p > n2 /\ p > n3)`, + (REWRITE_TAC [MAX]) THEN ARITH_TAC + +) +let BIGGER_PRIME_EXISTS = prove( + `!(n:num). ?p. prime p /\ p > n`, + let lem0 = prove(`{x | prime x} = prime`,SET_TAC[]) in + let lem1 = ARITH_RULE `p > n <=> ~(p <= (n:num))` in + MESON_TAC [PRIMES_INFINITE;lem0;lem1;IN_ELIM_THM;num_FINITE;INFINITE] +) +let BUD_LEMMA = prove( + `!(f:num->bool) (n1:num) (n2:num).((?(N:num) . !(p:num).p > N ==> f p) + ==> (? (p0:num).prime p0 /\ p0 > n1 /\ p0 > n2 /\ f p0))`, + let amigo3 = SPECL [`N:num`;`n1:num`;`n2:num`;`p:num`] PBR_LEMMA in + let amigo4 = UNDISCH amigo3 in + (REPEAT STRIP_TAC) THEN + (CHOOSE_TAC (SPEC `MAX N (MAX n1 n2)` BIGGER_PRIME_EXISTS )) THEN + (EXISTS_TAC `p:num`) THEN + (UNDISCH_TAC `prime p /\ p > MAX N (MAX n1 n2)`) THEN + (ONCE_REWRITE_TAC [TAUT `(X /\ Y ==> Z) <=> (X ==> Y ==> Z)`]) THEN + (DISCH_TAC THEN DISCH_TAC) THEN + (ASM_SIMP_TAC [amigo4]) +) + +let ALL_IMP_EL = prove( + `! (l:(a)list) i P. (ALL P l) ==> (i < LENGTH l) ==> P (EL i l)`, + SIMP_TAC[GSYM ALL_EL] +) + +let HAMMS_LEMMA = prove( + `~(?c. ALL integer c /\ + LENGTH c > 1 /\ + EL 0 c > &0 /\ + (!f. LHS c f = RHS c f))`, + let erica0 = UNDISCH_ALL Pm_eqn4_lhs.PLANET_MATH_gamma in + let erica1 = MATCH_MP IS_INT_NZ_ABS_GE_1 erica0 in + let erica2 = ASM_REWRITE_RULE [] erica1 in + let erica3 = SPEC_ALL Pm_eqn4_rhs.LT_ONE in + let erica4 = MATCH_MP BUD_LEMMA erica3 in + let erica5 = ADD_ASSUM `ALL integer c` erica4 in + let erica8 = ARITH_RULE `(n = PRE (LENGTH (c:(real)list))) ==> n > 0 ==> + 0 < (LENGTH c) ` in + let erica9 = UNDISCH (UNDISCH erica8) in + let erica10 = UNDISCH (ISPECL [`c:(real)list`;`0`;`integer`] ALL_IMP_EL) in + let erica11 = MP erica10 erica9 in + let erica12 = ONCE_REWRITE_RULE [is_int] erica11 in + let erica13 = ARITH_RULE `!n. ~(( -- (real_of_num n)) > &0)` in + let erica14 = prove( + `n = PRE (LENGTH c) ==> + n > 0 ==> + ALL integer c ==> + (EL 0 c) > &0 ==> + ?n. EL 0 c = &n`, + MESON_TAC [DISCH_ALL erica12;erica13] + ) in + let erica15 = UNDISCH_ALL erica14 in + let sim0 = SELECT_RULE (ASSUME (concl erica15)) in + let sim1 = DISCH (concl erica15) sim0 in + let sim2 = MP sim1 erica15 in + let erica18 = SPECL [`n:num`;`@n. EL 0 c = (real_of_num n)`] erica5 in + let erica19 = ONCE_REWRITE_RULE [GSYM REAL_OF_NUM_GT] erica18 in + let erica20 = ONCE_REWRITE_RULE [GSYM sim2] erica19 in + let erica21 = ONCE_REWRITE_RULE [REAL_OF_NUM_GT] erica20 in + let erica22 = DISCH `(real_of_num p) > EL 0 c` erica2 in + let erica23 = DISCH `(p:num) > n` erica22 in + let erica24 = DISCH `prime (p:num)` erica23 in + let erica25 = GEN `p:num` erica24 in + let erica28 = UNDISCH (ARITH_RULE `n = PRE (LENGTH (c:(real)list)) ==> ((n > 0) <=> (LENGTH c) > 1)`) in + let erica29 = UNDISCH (ONCE_REWRITE_RULE [erica28] (DISCH `n > 0` (erica25))) in + let erica30 = UNDISCH (ONCE_REWRITE_RULE [erica28] (DISCH `n > 0` (erica21))) in + (CONV_TAC NNF_CONV) THEN + (REPEAT STRIP_TAC) THEN + (ASM_MESON_TAC [DISCH_ALL erica29;DISCH_ALL erica30]) +) + +let TRANSCENDENTAL_E = prove( + `transcendental (exp (&1))`, + MESON_TAC [HAMMS_LEMMA;Pm_eqn4.PLANETMATH_EQN_4] +) + +end;; + +Finale.TRANSCENDENTAL_E;; diff --git a/100/euler.ml b/100/euler.ml new file mode 100644 index 0000000..65a2dbb --- /dev/null +++ b/100/euler.ml @@ -0,0 +1,387 @@ +(* ========================================================================= *) +(* Euler's partition theorem and other elementary partition theorems. *) +(* ========================================================================= *) + +loadt "Library/binary.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas. *) +(* ------------------------------------------------------------------------- *) + +let NSUM_BOUND_LEMMA = prove + (`!f a b n. nsum(a..b) f = n ==> !i. a <= i /\ i <= b ==> f(i) <= n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN + MATCH_MP_TAC NSUM_POS_BOUND THEN ASM_REWRITE_TAC[LE_REFL; FINITE_NUMSEG]);; + +let CARD_EQ_LEMMA = prove + (`!f:A->B g s t. + FINITE s /\ FINITE t /\ + (!x. x IN s ==> f(x) IN t) /\ + (!y. y IN t ==> g(y) IN s) /\ + (!x. x IN s ==> g(f x) = x) /\ + (!y. y IN t ==> f(g y) = y) + ==> FINITE s /\ FINITE t /\ CARD s = CARD t`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN + EXISTS_TAC `g:B->A` THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Breaking a number up into 2^something * odd_number. *) +(* ------------------------------------------------------------------------- *) + +let index = define + `index n = if n = 0 then 0 else if ODD n then 0 else SUC(index(n DIV 2))`;; + +let oddpart = define + `oddpart n = if n = 0 then 0 else if ODD n then n else oddpart(n DIV 2)`;; + +let INDEX_ODDPART_WORK = prove + (`!n. n = 2 EXP (index n) * oddpart n /\ (ODD(oddpart n) <=> ~(n = 0))`, + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[index; oddpart] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH; MULT_CLAUSES] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_ODD]) THEN + SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; EXP; GSYM MULT_ASSOC; + ARITH; ARITH_RULE `(2 * x) DIV 2 = x`; EQ_MULT_LCANCEL] THEN + ASM_MESON_TAC[ARITH_RULE `~(n = 0) /\ n = 2 * m ==> m < n /\ ~(m = 0)`]);; + +let INDEX_ODDPART_DECOMPOSITION = prove + (`!n. n = 2 EXP (index n) * oddpart n`, + MESON_TAC[INDEX_ODDPART_WORK]);; + +let ODD_ODDPART = prove + (`!n. ODD(oddpart n) <=> ~(n = 0)`, + MESON_TAC[INDEX_ODDPART_WORK]);; + +let ODDPART_LE = prove + (`!n. oddpart n <= n`, + GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [INDEX_ODDPART_DECOMPOSITION] THEN + MATCH_MP_TAC(ARITH_RULE `1 * x <= y * x ==> x <= y * x`) THEN + REWRITE_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH]);; + +let INDEX_ODDPART_UNIQUE = prove + (`!i m i' m'. ODD m /\ ODD m' + ==> (2 EXP i * m = 2 EXP i' * m' <=> i = i' /\ m = m')`, + REWRITE_TAC[ODD_EXISTS; ADD1] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM NUMPAIR; NUMPAIR_INJ] THEN + ARITH_TAC);; + +let INDEX_ODDPART = prove + (`!i m. ODD m ==> index(2 EXP i * m) = i /\ oddpart(2 EXP i * m) = m`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`i:num`; `m:num`; `index(2 EXP i * m)`; `oddpart(2 EXP i * m)`] + INDEX_ODDPART_UNIQUE) THEN + REWRITE_TAC[GSYM INDEX_ODDPART_DECOMPOSITION; ODD_ODDPART] THEN + ASM_REWRITE_TAC[MULT_EQ_0; EXP_EQ_0; ARITH] THEN ASM_MESON_TAC[ODD]);; + +(* ------------------------------------------------------------------------- *) +(* Partitions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("partitions",(12,"right"));; + +let partitions = new_definition + `p partitions n <=> (!i. ~(p i = 0) ==> 1 <= i /\ i <= n) /\ + nsum(1..n) (\i. p(i) * i) = n`;; + +let PARTITIONS_BOUND = prove + (`!p n. p partitions n ==> !i. p(i) <= n`, + REWRITE_TAC[GSYM NOT_LT] THEN SIMP_TAC[partitions] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1 <= i /\ i <= n` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `m < n ==> ~(n = 0)`]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `m = n ==> n < m ==> F`)) THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `nsum(1..n) (\j. if j = i then n else 0)` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[NSUM_DELTA; IN_NUMSEG; LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC NSUM_LT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_0] THEN + MATCH_MP_TAC LT_IMP_LE; + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC(ARITH_RULE `n < p /\ p * 1 <= p * k ==> n < p * k`) THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]);; + +let FINITE_PARTITIONS_LEMMA = prove + (`!m n. FINITE {p | (!i. p(i) <= n) /\ !i. m <= i ==> p(i) = 0}`, + INDUCT_TAC THEN GEN_TAC THENL + [SIMP_TAC[LE_0; TAUT `a /\ b <=> ~(b ==> ~a)`] THEN + SUBGOAL_THEN `{p | !i:num. p i = 0} = {(\n. 0)}` + (fun th -> SIMP_TAC[th; FINITE_RULES]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[FUN_EQ_THM]; + ALL_TAC] THEN + SUBGOAL_THEN + `{p | (!i. p i <= n) /\ (!i. SUC m <= i ==> p i = 0)} = + IMAGE (\(a,p) j. if j = m then a else p(j)) + {a,p | a IN 0..n /\ + p IN {p | (!i. p i <= n) /\ (!i. m <= i ==> p i = 0)}}` + (fun t -> ASM_SIMP_TAC[t; FINITE_IMAGE; FINITE_PRODUCT; FINITE_NUMSEG]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN X_GEN_TAC `p:num->num` THEN + EQ_TAC THENL + [STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(p:num->num) m`; `\i:num. if i = m then 0 else p i`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[PAIR_EQ; UNWIND_THM1; GSYM CONJ_ASSOC; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LE; ARITH_RULE `m <= i /\ ~(i = m) ==> SUC m <= i`]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `q:num->num`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + POP_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN + REWRITE_TAC[PAIR_EQ] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC[ARITH_RULE `SUC m <= i ==> m <= i /\ ~(i = m)`]]);; + +let FINITE_PARTITIONS = prove + (`!n. FINITE {p | p partitions n}`, + GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{p | (!i. p(i) <= n) /\ (!i. SUC n <= i ==> p(i) = 0)}` THEN + SIMP_TAC[FINITE_PARTITIONS_LEMMA; IN_ELIM_THM; SUBSET; PARTITIONS_BOUND] THEN + REWRITE_TAC[partitions; LE_SUC_LT] THEN MESON_TAC[NOT_LE]);; + +let FINITE_SUBSET_PARTITIONS = prove + (`!P n. FINITE {p | p partitions n /\ P p}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{p | p partitions n}` THEN + SIMP_TAC[FINITE_PARTITIONS; IN_ELIM_THM; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Mappings between "odd only" and "all distinct" partitions. *) +(* ------------------------------------------------------------------------- *) + +let odd_of_distinct = new_definition + `odd_of_distinct p = + \i. if ODD i then nsum {j | p(2 EXP j * i) = 1} (\j. 2 EXP j) else 0`;; + +let distinct_of_odd = new_definition + `distinct_of_odd p = \i. if (index i) IN bitset (p(oddpart i)) then 1 else 0`;; + +(* ------------------------------------------------------------------------- *) +(* The critical properties. *) +(* ------------------------------------------------------------------------- *) + +let ODD_ODD_OF_DISTINCT = prove + (`!p i. ~(odd_of_distinct p i = 0) ==> ODD i`, + REWRITE_TAC[odd_of_distinct] THEN MESON_TAC[]);; + +let DISTINCT_DISTINCT_OF_ODD = prove + (`!p i. distinct_of_odd p i <= 1`, + REWRITE_TAC[distinct_of_odd] THEN ARITH_TAC);; + +let SUPPORT_ODD_OF_DISTINCT = prove + (`!p. (!i. ~(p i = 0) ==> i <= n) + ==> !i. ~(odd_of_distinct p i = 0) ==> 1 <= i /\ i <= n`, + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[ODD; ARITH_RULE `1 <= i <=> ~(i = 0)`; ODD_ODD_OF_DISTINCT]; + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))] THEN + REWRITE_TAC[odd_of_distinct] THEN + ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[LE_0] THEN + SUBGOAL_THEN `FINITE {j | p (2 EXP j * i) = 1}` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET] THEN X_GEN_TAC `j:num` THEN + REWRITE_TAC[IN_ELIM_THM; LE_0] THEN DISCH_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP j * i` THEN + ASM_SIMP_TAC[ARITH_EQ] THEN + MATCH_MP_TAC(ARITH_RULE `j < ej /\ ej * 1 <= ej * i ==> j <= ej * i`) THEN + REWRITE_TAC[LT_POW2_REFL; LE_MULT_LCANCEL; EXP_EQ_0; ARITH] THEN + UNDISCH_TAC `~(i = 0)` THEN ARITH_TAC; + SIMP_TAC[ARITH_RULE `~((if p then x else 0) = 0) <=> p /\ ~(x = 0)`] THEN + ASM_SIMP_TAC[NSUM_EQ_0_IFF; EXP_EQ_0; ARITH] THEN + REWRITE_TAC[NOT_FORALL_THM; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `j:num`)) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP j * i` THEN + ASM_SIMP_TAC[ARITH; ARITH_RULE `i <= j * i <=> 1 * i <= j * i`] THEN + REWRITE_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= i <=> ~(i = 0)`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH]]);; + +let SUPPORT_DISTINCT_OF_ODD = prove + (`!p. (!i. p(i) * i <= n) /\ + (!i. ~(p i = 0) ==> ODD i) + ==> !i. ~(distinct_of_odd p i = 0) ==> 1 <= i /\ i <= n`, + REWRITE_TAC[distinct_of_odd] THEN + REWRITE_TAC[ARITH_RULE `(if a then 1 else 0) = 0 <=> ~a`] THEN + GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= i <=> ~(i = 0)`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `index 0 IN bitset (p (oddpart 0))` THEN + REWRITE_TAC[index; oddpart; ARITH] THEN + UNDISCH_THEN `!i. ~(p i = 0) ==> ODD i` (MP_TAC o SPEC `0`) THEN + SIMP_TAC[ARITH; BITSET_0; NOT_IN_EMPTY]; + ALL_TAC] THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BITSET_BOUND_LEMMA) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p(oddpart i) * oddpart i` THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [INDEX_ODDPART_DECOMPOSITION] THEN + ASM_REWRITE_TAC[LE_MULT_RCANCEL]);; + +let ODD_OF_DISTINCT_OF_ODD = prove + (`!p. (!i. ~(p(i) = 0) ==> ODD i) + ==> odd_of_distinct (distinct_of_odd p) = p`, + REWRITE_TAC[IN_ELIM_THM; odd_of_distinct; distinct_of_odd] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_SIMP_TAC[INDEX_ODDPART] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM BINARYSUM_BITSET] THEN + REWRITE_TAC[binarysum] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ]);; + +let DISTINCT_OF_ODD_OF_DISTINCT = prove + (`!p. (!i. ~(p i = 0) ==> 1 <= i /\ i <= n) /\ (!i. p(i) <= 1) + ==> distinct_of_odd (odd_of_distinct p) = p`, + REWRITE_TAC[distinct_of_odd; odd_of_distinct; IN_ELIM_THM] THEN + REWRITE_TAC[partitions; ODD_ODDPART] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[BITSET_0; NOT_IN_EMPTY] THENL + [ASM_MESON_TAC[ARITH_RULE `~(1 <= 0)`]; ALL_TAC] THEN + SUBGOAL_THEN `FINITE {j | p (2 EXP j * oddpart i) = 1}` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN REWRITE_TAC[LE_0] THEN + MATCH_MP_TAC(ARITH_RULE `!x. y <= x /\ 1 <= x /\ x <= n ==> y <= n`) THEN + EXISTS_TAC `2 EXP j * oddpart i` THEN ASM_SIMP_TAC[ARITH] THEN + MATCH_MP_TAC(ARITH_RULE `j < ej /\ 1 * ej <= i * ej ==> j <= ej * i`) THEN + REWRITE_TAC[LT_POW2_REFL; LE_MULT_RCANCEL] THEN + ASM_MESON_TAC[ODD_ODDPART; ODD; ARITH_RULE `1 <= n <=> ~(n = 0)`]; + ASM_SIMP_TAC[BITSET_BINARYSUM; GSYM binarysum; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM INDEX_ODDPART_DECOMPOSITION] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN + ASM_MESON_TAC[ARITH_RULE `i <= 1 ==> i = 0 \/ i = 1`]]);; + +let NSUM_DISTINCT_OF_ODD = prove + (`!p. (!i. ~(p i = 0) ==> 1 <= i /\ i <= n) /\ + (!i. p(i) * i <= n) /\ + (!i. ~(p(i) = 0) ==> ODD i) + ==> nsum(1..n) (\i. distinct_of_odd p i * i) = + nsum(1..n) (\i. p i * i)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[distinct_of_odd] THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV o LAND_CONV) + [GSYM BINARYSUM_BITSET] THEN + REWRITE_TAC[binarysum] THEN REWRITE_TAC[GSYM NSUM_RMUL] THEN + SIMP_TAC[NSUM_NSUM_PRODUCT; FINITE_BITSET; FINITE_NUMSEG] THEN + CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_ADD] THEN + SUBGOAL_THEN + `{x | x IN {i,j | i IN 1..n /\ j IN bitset(p i)} /\ + ~((\(i,j). 2 EXP j * i) x = 0)} = + {i,j | i IN 1..n /\ j IN bitset(p i)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[IN_NUMSEG; EXP_EQ_0; MULT_EQ_0; ARITH] THEN + MESON_TAC[ARITH_RULE `~(1 <= 0)`]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x | x IN 1 .. n /\ + ~((if index x IN bitset (p (oddpart x)) then 1 else 0) * x = 0)} = + {i | i IN 1..n /\ (index i) IN bitset (p(oddpart i))}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; MULT_EQ_0] THEN + REWRITE_TAC[IN_NUMSEG; ARITH_RULE `(if p then 1 else 0) = 0 <=> ~p`] THEN + MESON_TAC[ARITH_RULE `~(1 <= 0)`]; + ALL_TAC] THEN + MATCH_MP_TAC NSUM_EQ_GENERAL THEN + EXISTS_TAC `\(i,b). 2 EXP b * i` THEN + SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[ARITH_RULE + `(if p then 1 else 0) * x * y = (if p then x * y else 0)`] THEN + GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) [IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> a /\ b /\ (b ==> c)`] THEN + SIMP_TAC[] THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN + SUBGOAL_THEN `!i j. j IN bitset(p i) ==> ODD i` ASSUME_TAC THENL + [ASM_MESON_TAC[BITSET_0; NOT_IN_EMPTY]; ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `m:num` THEN STRIP_TAC THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`oddpart m`; `index m`] THEN + ASM_REWRITE_TAC[GSYM INDEX_ODDPART_DECOMPOSITION] THEN + ASM_MESON_TAC[ODDPART_LE; LE_TRANS; ARITH_RULE `1 <= x <=> ~(x = 0)`; + ODD_ODDPART; ODD]; + ASM_MESON_TAC[INDEX_ODDPART_UNIQUE]]; + MAP_EVERY X_GEN_TAC [`m:num`; `i:num`] THEN STRIP_TAC THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INDEX_ODDPART]] THEN CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + REWRITE_TAC[MULT_EQ_0; EXP_EQ_0; ARITH] THEN + ASM_MESON_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`]; + ASM_MESON_TAC[BITSET_BOUND_LEMMA; LE_MULT_RCANCEL; LE_TRANS]]]);; + +let DISTINCT_OF_ODD = prove + (`!p. p IN {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i} + ==> (distinct_of_odd p) IN {p | p partitions n /\ !i. p(i) <= 1}`, + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; partitions] THEN STRIP_TAC THEN + REWRITE_TAC[DISTINCT_DISTINCT_OF_ODD] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUPPORT_DISTINCT_OF_ODD; + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC NSUM_DISTINCT_OF_ODD] THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(p:num->num) i = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LE_0] THEN + ASM_MESON_TAC[NSUM_BOUND_LEMMA]);; + +let ODD_OF_DISTINCT = prove + (`!p. p IN {p | p partitions n /\ !i. p(i) <= 1} + ==> (odd_of_distinct p) IN + {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i}`, + GEN_TAC THEN REWRITE_TAC[partitions; IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[ODD_ODD_OF_DISTINCT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUPPORT_ODD_OF_DISTINCT]; ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `nsum(1..n) (\i. distinct_of_odd(odd_of_distinct p) i * i)` THEN + CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN + ASM_MESON_TAC[DISTINCT_OF_ODD_OF_DISTINCT]] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_DISTINCT_OF_ODD THEN + REWRITE_TAC[ODD_ODD_OF_DISTINCT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUPPORT_ODD_OF_DISTINCT]; ALL_TAC] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[odd_of_distinct] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_0; MULT_CLAUSES] THEN + REWRITE_TAC[GSYM NSUM_RMUL] THEN + SUBGOAL_THEN `FINITE {i:num | p(i) = 1}` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..n` THEN + REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN + ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[o_DEF] + `(\j. j) o (\j. 2 EXP j * i)`)] THEN + ASM_SIMP_TAC[GSYM NSUM_IMAGE; INDEX_ODDPART_UNIQUE] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `nsum {i | p(i) = 1} (\j. j)` THEN CONJ_TAC THENL + [MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `nsum {i | p(i) = 1} (\j. p(j) * j)` THEN CONJ_TAC THENL + [MATCH_MP_TAC EQ_IMP_LE THEN MATCH_MP_TAC NSUM_EQ THEN + SIMP_TAC[IN_ELIM_THM; MULT_CLAUSES]; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN + REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN + ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`]]);; + +(* ------------------------------------------------------------------------- *) +(* Euler's partition theorem: *) +(* *) +(* The number of partitions into distinct numbers is equal to the number of *) +(* partitions into odd numbers (and there are only finitely many of each). *) +(* ------------------------------------------------------------------------- *) + +let EULER_PARTITION_THEOREM = prove + (`FINITE {p | p partitions n /\ !i. p(i) <= 1} /\ + FINITE {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i} /\ + CARD {p | p partitions n /\ !i. p(i) <= 1} = + CARD {p | p partitions n /\ !i. ~(p(i) = 0) ==> ODD i}`, + MATCH_MP_TAC CARD_EQ_LEMMA THEN REWRITE_TAC[FINITE_SUBSET_PARTITIONS] THEN + MAP_EVERY EXISTS_TAC [`odd_of_distinct`; `distinct_of_odd`] THEN + REWRITE_TAC[ODD_OF_DISTINCT; DISTINCT_OF_ODD] THEN + CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN + REWRITE_TAC[IN_ELIM_THM; partitions] THEN STRIP_TAC THENL + [MATCH_MP_TAC DISTINCT_OF_ODD_OF_DISTINCT; + MATCH_MP_TAC ODD_OF_DISTINCT_OF_ODD] THEN + ASM_REWRITE_TAC[]);; diff --git a/100/feuerbach.ml b/100/feuerbach.ml new file mode 100644 index 0000000..5d9eb90 --- /dev/null +++ b/100/feuerbach.ml @@ -0,0 +1,213 @@ +(* ========================================================================= *) +(* Feuerbach's theorem. *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; + +(* ------------------------------------------------------------------------- *) +(* Algebraic condition for two circles to be tangent to each other. *) +(* ------------------------------------------------------------------------- *) + +let CIRCLES_TANGENT = prove + (`!r1 r2 c1 c2. + &0 <= r1 /\ &0 <= r2 /\ + (dist(c1,c2) = r1 + r2 \/ dist(c1,c2) = abs(r1 - r2)) + ==> c1 = c2 /\ r1 = r2 \/ + ?!x:real^2. dist(c1,x) = r1 /\ dist(c2,x) = r2`, + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC(MESON[] + `(!x y. P x y <=> Q y x) ==> ((!x y. P x y) <=> (!x y. Q x y))`) THEN + MESON_TAC[DIST_SYM; REAL_ADD_SYM; REAL_ABS_SUB]; ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `r1 = &0` THENL + [ASM_REWRITE_TAC[DIST_EQ_0; MESON[] `(?!x. a = x /\ P x) <=> P a`] THEN + REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `r2 = &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `r1 <= r2 ==> abs(r1 - r2) = r2 - r1`] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL + [DISJ2_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN + EXISTS_TAC `c1 + r1 / (r1 + r2) % (c2 - c1):real^2` THEN CONJ_TAC THENL + [REWRITE_TAC[dist; + VECTOR_ARITH `c1 - (c1 + a % (x - y)):real^2 = a % (y - x)`; + VECTOR_ARITH `z - (x + a % (z - x)):real^N = (a - &1) % (x - z)`] THEN + ASM_REWRITE_TAC[NORM_MUL; GSYM dist] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NEG; + REAL_FIELD `&0 < r1 /\ &0 < r2 + ==> r1 / (r1 + r2) - &1 = --r2 / (r1 + r2)`] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LT_ADD] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^2` THEN STRIP_TAC THEN + SUBGOAL_THEN `(y:real^2) IN segment[c1,c2]` MP_TAC THENL + [ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + ASM_MESON_TAC[DIST_SYM]; + REWRITE_TAC[IN_SEGMENT]] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `dist(c1:real^2,(&1 - u) % c1 + u % c2) = r1` THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % c1 + u % c2:real^N = c1 + u % (c2 - c1)`] THEN + REWRITE_TAC[NORM_ARITH `dist(x:real^2,x + y) = norm y`] THEN + ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN + REWRITE_TAC[VECTOR_ARITH `--(a % (x - y)):real^N = a % (y - x)`] THEN + ASM_REWRITE_TAC[NORM_MUL; GSYM dist; real_abs] THEN + DISCH_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]; + ASM_CASES_TAC `r1:real = r2` THENL + [ASM_MESON_TAC[REAL_SUB_REFL; DIST_EQ_0]; DISJ2_TAC] THEN + SUBGOAL_THEN `r1 < r2` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXISTS_UNIQUE] THEN + EXISTS_TAC `c2 + r2 / (r2 - r1) % (c1 - c2):real^2` THEN CONJ_TAC THENL + [REWRITE_TAC[dist; + VECTOR_ARITH `c1 - (c1 + a % (x - y)):real^2 = --(a % (x - y)) /\ + c1 - (c2 + a % (c1 - c2)):real^2 = (&1 - a) % (c1 - c2)`] THEN + ASM_REWRITE_TAC[NORM_MUL; NORM_NEG; GSYM dist] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NEG; + REAL_FIELD `r1 < r2 ==> &1 - r2 / (r2 - r1) = --(r1 / (r2 - r1))`] THEN + ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LT_IMP_LE] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^2` THEN STRIP_TAC THEN + SUBGOAL_THEN `(c1:real^2) IN segment[c2,y]` MP_TAC THENL + [ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_SEGMENT]] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; REAL_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN ASM_MESON_TAC[DIST_EQ_0; REAL_SUB_0]; + ALL_TAC] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `dist((&1 - u) % c2 + u % y:real^2,c2) = r2 - r1` THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % c1 + u % c2:real^N = c1 + u % (c2 - c1)`] THEN + REWRITE_TAC[NORM_ARITH `dist(x + y:real^2,x) = norm y`] THEN + ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN + REWRITE_TAC[VECTOR_ARITH `--(a % (x - y)):real^N = a % (y - x)`] THEN + ASM_REWRITE_TAC[NORM_MUL; GSYM dist; real_abs] THEN + REWRITE_TAC[VECTOR_ARITH + `c + v % ((c + u % (y - c)) - c):real^2 = c + v % u % (y - c)`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH + `y:real^2 = c + u % v % (y - c) <=> + (&1 - u * v) % (y - c) = vec 0`] THEN + DISJ1_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]]);; + +(* ------------------------------------------------------------------------- *) +(* Feuerbach's theorem *) +(* *) +(* Given a non-degenerate triangle abc, let the circle passing through *) +(* the midpoints of its sides (the "9 point circle") have center "ncenter" *) +(* and radius "nradius". Now suppose the circle with center "icenter" and *) +(* radius "iradius" is tangent to three sides (either internally or *) +(* externally to one side and two produced sides), meaning that it's either *) +(* the inscribed circle or one of the three escribed circles. Then the two *) +(* circles are tangent to each other, i.e. either they are identical or they *) +(* touch at exactly one point. *) +(* ------------------------------------------------------------------------- *) + +let FEUERBACH = prove + (`!a b c mbc mac mab pbc pac pab ncenter icenter nradius iradius. + ~(collinear {a,b,c}) /\ + midpoint(a,b) = mab /\ + midpoint(b,c) = mbc /\ + midpoint(c,a) = mac /\ + dist(ncenter,mbc) = nradius /\ + dist(ncenter,mac) = nradius /\ + dist(ncenter,mab) = nradius /\ + dist(icenter,pbc) = iradius /\ + dist(icenter,pac) = iradius /\ + dist(icenter,pab) = iradius /\ + collinear {a,b,pab} /\ orthogonal (a - b) (icenter - pab) /\ + collinear {b,c,pbc} /\ orthogonal (b - c) (icenter - pbc) /\ + collinear {a,c,pac} /\ orthogonal (a - c) (icenter - pac) + ==> ncenter = icenter /\ nradius = iradius \/ + ?!x:real^2. dist(ncenter,x) = nradius /\ dist(icenter,x) = iradius`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CIRCLES_TANGENT THEN + POP_ASSUM MP_TAC THEN MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ALL_TAC; ASM_MESON_TAC[DIST_POS_LE]]) + [`&0 <= nradius`; `&0 <= iradius`] THEN + ASM_REWRITE_TAC[dist; NORM_EQ_SQUARE] THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_ABS_POS; GSYM NORM_POW_2; GSYM dist] THEN + REWRITE_TAC[REAL_POW2_ABS] THEN POP_ASSUM_LIST(K ALL_TAC) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> b /\ c /\ d /\ a /\ e`] THEN + GEOM_ORIGIN_TAC `a:real^2` THEN + GEOM_NORMALIZE_TAC `b:real^2` THEN CONJ_TAC THENL + [REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^2` THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH; real_abs] THEN + GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_MUL_RID] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC)) THEN + REWRITE_TAC[COLLINEAR_3_2D] THEN + REWRITE_TAC[orthogonal; dist; NORM_POW_2] THEN + ASM_REWRITE_TAC[midpoint] THEN + REWRITE_TAC[DOT_2; DOT_LSUB; DOT_RSUB] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; VEC_COMPONENT; + VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* As a little bonus, verify that the circle passing through the *) +(* midpoints of the sides is indeed a 9-point circle, i.e. it passes *) +(* through the feet of the altitudes and the midpoints of the lines joining *) +(* the vertices to the orthocenter (where the alititudes intersect). *) +(* ------------------------------------------------------------------------- *) + +let NINE_POINT_CIRCLE_1 = prove + (`!a b c:real^2 mbc mac mab fbc fac fab ncenter nradius. + ~(collinear {a,b,c}) /\ + midpoint(a,b) = mab /\ + midpoint(b,c) = mbc /\ + midpoint(c,a) = mac /\ + dist(ncenter,mbc) = nradius /\ + dist(ncenter,mac) = nradius /\ + dist(ncenter,mab) = nradius /\ + collinear {a,b,fab} /\ orthogonal (a - b) (c - fab) /\ + collinear {b,c,fbc} /\ orthogonal (b - c) (a - fbc) /\ + collinear {c,a,fac} /\ orthogonal (c - a) (b - fac) + ==> dist(ncenter,fab) = nradius /\ + dist(ncenter,fbc) = nradius /\ + dist(ncenter,fac) = nradius`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> b /\ c /\ d /\ a /\ e`] THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC)) THEN + ASM_REWRITE_TAC[dist; NORM_EQ_SQUARE; REAL_POS] THEN + REWRITE_TAC[COLLINEAR_3_2D] THEN + REWRITE_TAC[orthogonal; dist; NORM_POW_2] THEN + ASM_REWRITE_TAC[midpoint] THEN + REWRITE_TAC[DOT_2; DOT_LSUB; DOT_RSUB] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + SIMP_TAC[] THEN CONV_TAC REAL_RING);; + +let NINE_POINT_CIRCLE_2 = prove + (`!a b c:real^2 mbc mac mab fbc fac fab ncenter nradius. + ~(collinear {a,b,c}) /\ + midpoint(a,b) = mab /\ + midpoint(b,c) = mbc /\ + midpoint(c,a) = mac /\ + dist(ncenter,mbc) = nradius /\ + dist(ncenter,mac) = nradius /\ + dist(ncenter,mab) = nradius /\ + collinear {a,b,fab} /\ orthogonal (a - b) (c - fab) /\ + collinear {b,c,fbc} /\ orthogonal (b - c) (a - fbc) /\ + collinear {c,a,fac} /\ orthogonal (c - a) (b - fac) /\ + collinear {oc,a,fbc} /\ collinear {oc,b,fac} /\ collinear{oc,c,fab} + ==> dist(ncenter,midpoint(oc,a)) = nradius /\ + dist(ncenter,midpoint(oc,b)) = nradius /\ + dist(ncenter,midpoint(oc,c)) = nradius`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> b /\ c /\ d /\ a /\ e`] THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC)) THEN + ASM_REWRITE_TAC[dist; NORM_EQ_SQUARE; REAL_POS] THEN + REWRITE_TAC[COLLINEAR_3_2D] THEN + REWRITE_TAC[orthogonal; dist; NORM_POW_2] THEN + ASM_REWRITE_TAC[midpoint] THEN + REWRITE_TAC[DOT_2; DOT_LSUB; DOT_RSUB] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + SIMP_TAC[] THEN CONV_TAC REAL_RING);; diff --git a/100/four_squares.ml b/100/four_squares.ml new file mode 100644 index 0000000..ed6f94c --- /dev/null +++ b/100/four_squares.ml @@ -0,0 +1,948 @@ +(* ========================================================================= *) +(* Theorems about representations as sums of 2 and 4 squares. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/analysis.ml";; (*** only for REAL_ARCH_LEAST! ***) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Definition of involution and various basic lemmas. *) +(* ------------------------------------------------------------------------- *) + +let involution = new_definition + `involution f s = !x. x IN s ==> f(x) IN s /\ (f(f(x)) = x)`;; + +let INVOLUTION_IMAGE = prove + (`!f s. involution f s ==> (IMAGE f s = s)`, + REWRITE_TAC[involution; EXTENSION; IN_IMAGE] THEN MESON_TAC[]);; + +let INVOLUTION_DELETE = prove + (`involution f s /\ a IN s /\ (f a = a) ==> involution f (s DELETE a)`, + REWRITE_TAC[involution; IN_DELETE] THEN MESON_TAC[]);; + +let INVOLUTION_STEPDOWN = prove + (`involution f s /\ a IN s ==> involution f (s DIFF {a, (f a)})`, + REWRITE_TAC[involution; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let INVOLUTION_NOFIXES = prove + (`involution f s ==> involution f {x | x IN s /\ ~(f x = x)}`, + REWRITE_TAC[involution; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INVOLUTION_SUBSET = prove + (`!f s t. involution f s /\ (!x. x IN t ==> f(x) IN t) /\ t SUBSET s + ==> involution f t`, + REWRITE_TAC[involution; SUBSET] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Involution with no fixpoints can only occur on finite set of even card *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_EVEN_STEP = prove + (`FINITE(s) /\ + involution f s /\ + (!x:A. x IN s ==> ~(f x = x)) /\ + a IN s + ==> FINITE(s DIFF {a, (f a)}) /\ + involution f (s DIFF {a, (f a)}) /\ + (!x:A. x IN (s DIFF {a, (f a)}) ==> ~(f x = x)) /\ + (CARD s = CARD(s DIFF {a, (f a)}) + 2)`, + SIMP_TAC[FINITE_DIFF; INVOLUTION_STEPDOWN; IN_DIFF] THEN STRIP_TAC THEN + SUBGOAL_THEN `s = (a:A) INSERT (f a) INSERT (s DIFF {a, (f a)})` MP_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[involution]; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DIFF; FINITE_INSERT] THEN + ASM_SIMP_TAC[IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN ARITH_TAC);; + +let INVOLUTION_EVEN_INDUCT = prove + (`!n s. FINITE(s) /\ (CARD s = n) /\ involution f s /\ + (!x:A. x IN s ==> ~(f x = x)) + ==> EVEN(CARD s)`, + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + ASM_CASES_TAC `s:A->bool = {}` THEN + ASM_REWRITE_TAC[CARD_CLAUSES; ARITH] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EXTENSION]) THEN + REWRITE_TAC[NOT_IN_EMPTY; NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(s DIFF {a:A, (f a)})`) THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `s DIFF {a:A, (f a)}`) THEN + MP_TAC INVOLUTION_EVEN_STEP THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < n + 2`] THEN + SIMP_TAC[EVEN_ADD; ARITH]);; + +let INVOLUTION_EVEN = prove + (`!s. FINITE(s) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) + ==> EVEN(CARD s)`, + MESON_TAC[INVOLUTION_EVEN_INDUCT]);; + +(* ------------------------------------------------------------------------- *) +(* So an involution with exactly one fixpoint has odd card domain. *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_FIX_ODD = prove + (`FINITE(s) /\ involution f s /\ (?!a:A. a IN s /\ (f a = a)) + ==> ODD(CARD s)`, + REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN STRIP_TAC THEN + SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; IN_DELETE; ODD; NOT_ODD] THEN + MATCH_MP_TAC INVOLUTION_EVEN THEN + ASM_SIMP_TAC[INVOLUTION_DELETE; FINITE_DELETE; IN_DELETE] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* And an involution on a set of odd finite card must have a fixpoint. *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_ODD = prove + (`!n s. FINITE(s) /\ involution f s /\ ODD(CARD s) + ==> ?a. a IN s /\ (f a = a)`, + REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[INVOLUTION_EVEN]);; + +(* ------------------------------------------------------------------------- *) +(* Consequently, if one involution has a unique fixpoint, other has one. *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_FIX_FIX = prove + (`!f g s. FINITE(s) /\ involution f s /\ involution g s /\ + (?!x. x IN s /\ (f x = x)) ==> ?x. x IN s /\ (g x = x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INVOLUTION_ODD THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INVOLUTION_FIX_ODD THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Formalization of Zagier's "one-sentence" proof over the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let zset = new_definition + `zset(a) = {(x,y,z) | x EXP 2 + 4 * y * z = a}`;; + +let zag = new_definition + `zag(x,y,z) = + if x + z < y then (x + 2 * z,z,y - (x + z)) + else if x < 2 * y then (2 * y - x, y, (x + z) - y) + else (x - 2 * y,(x + z) - y, y)`;; + +let tag = new_definition + `tag((x,y,z):num#num#num) = (x,z,y)`;; + +let ZAG_INVOLUTION_GENERAL = prove + (`0 < x /\ 0 < y /\ 0 < z ==> (zag(zag(x,y,z)) = (x,y,z))`, + REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[PAIR_EQ] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +let IN_TRIPLE = prove + (`(a,b,c) IN {(x,y,z) | P x y z} <=> P a b c`, + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[]);; + +let PRIME_SQUARE = prove + (`!n. ~prime(n * n)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[PRIME_0; MULT_CLAUSES] THEN + REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[ARITH] THEN + DISJ2_TAC THEN EXISTS_TAC `n:num` THEN + ASM_SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ARITH_RULE `n = n * 1`] THEN + ASM_SIMP_TAC[EQ_MULT_LCANCEL]);; + +let PRIME_4X = prove + (`!n. ~prime(4 * n)`, + GEN_TAC THEN REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN + DISJ2_TAC THEN EXISTS_TAC `2` THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN + ASM_SIMP_TAC[GSYM MULT_ASSOC; DIVIDES_RMUL; DIVIDES_REFL; ARITH_EQ] THEN + ASM_CASES_TAC `n = 0` THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let PRIME_XYZ_NONZERO = prove + (`prime(x EXP 2 + 4 * y * z) ==> 0 < x /\ 0 < y /\ 0 < z`, + CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[DE_MORGAN_THM; ARITH_RULE `~(0 < x) = (x = 0)`] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES; PRIME_SQUARE; PRIME_4X]);; + +let ZAG_INVOLUTION = prove + (`!p. prime(p) ==> involution zag (zset(p))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[involution; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN + REWRITE_TAC[zset; IN_TRIPLE] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + CONJ_TAC THENL + [REWRITE_TAC[zag] THEN REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_TRIPLE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + ASM_SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD; EXP_2; + GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_SUB; LT_IMP_LE] THEN + INT_ARITH_TAC; + MATCH_MP_TAC ZAG_INVOLUTION_GENERAL THEN + ASM_MESON_TAC[PRIME_XYZ_NONZERO]]);; + +let TAG_INVOLUTION = prove + (`!a. involution tag (zset a)`, + REWRITE_TAC[involution; tag; zset; FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_TRIPLE] THEN REWRITE_TAC[MULT_AC]);; + +let ZAG_LEMMA = prove + (`(zag(x,y,z) = (x,y,z)) ==> (y = x)`, + REWRITE_TAC[zag; INT_POW_2] THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[PAIR_EQ]) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +let ZSET_BOUND = prove + (`0 < y /\ 0 < z /\ (x EXP 2 + 4 * y * z = p) + ==> x <= p /\ y <= p /\ z <= p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONJ_TAC THENL + [MESON_TAC[EXP_2; LE_SQUARE_REFL; ARITH_RULE `(a <= b ==> a <= b + c)`]; + CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE `y <= z ==> y <= x + z`) THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MULT_SYM]; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `y <= 4 * a * y <=> 1 * y <= (4 * a) * y`] THEN + ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < a ==> 1 <= 4 * a`]]);; + +let ZSET_FINITE = prove + (`!p. prime(p) ==> FINITE(zset p)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `p + 1` FINITE_NUMSEG_LT) THEN + DISCH_THEN(fun th -> + MP_TAC(funpow 2 (MATCH_MP FINITE_PRODUCT o CONJ th) th)) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + FINITE_SUBSET) THEN + REWRITE_TAC[zset; SUBSET; FORALL_PAIR_THM; IN_TRIPLE] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN + REWRITE_TAC[IN_ELIM_THM; EXISTS_PAIR_THM; PAIR_EQ] THEN + REWRITE_TAC[ARITH_RULE `x < p + 1 <=> x <= p`; PAIR_EQ] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:num`; `y:num`; `z:num`] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + MAP_EVERY EXISTS_TAC [`y:num`; `z:num`] THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[ZSET_BOUND; PRIME_XYZ_NONZERO]);; + +let SUM_OF_TWO_SQUARES = prove + (`!p k. prime(p) /\ (p = 4 * k + 1) ==> ?x y. p = x EXP 2 + y EXP 2`, + SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?t. t IN zset(p) /\ (tag(t) = t)` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM; tag; PAIR_EQ] THEN + REWRITE_TAC[zset; IN_TRIPLE; EXP_2] THEN + ASM_MESON_TAC[ARITH_RULE `4 * x * y = (2 * x) * (2 * y)`]] THEN + MATCH_MP_TAC INVOLUTION_FIX_FIX THEN EXISTS_TAC `zag` THEN + ASM_SIMP_TAC[ZAG_INVOLUTION; TAG_INVOLUTION; ZSET_FINITE] THEN + REWRITE_TAC[EXISTS_UNIQUE_ALT] THEN EXISTS_TAC `1,1,k:num` THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[zset; zag; IN_TRIPLE; ARITH] THEN + REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `~(1 + k < 1)`; PAIR_EQ] THEN + ARITH_TAC] THEN + REWRITE_TAC[zset; IN_TRIPLE] THEN STRIP_TAC THEN + FIRST_ASSUM(SUBST_ALL_TAC o MATCH_MP ZAG_LEMMA) THEN + UNDISCH_TAC `x EXP 2 + 4 * x * z = 4 * k + 1` THEN + REWRITE_TAC[EXP_2; ARITH_RULE `x * x + 4 * x * z = x * (4 * z + x)`] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `prime p` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[prime] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:num`)) THEN + SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL + [UNDISCH_TAC `4 * k + 1 = 1 * (4 * z + 1)` THEN + REWRITE_TAC[MULT_CLAUSES; PAIR_EQ] THEN ARITH_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `(a = a * b) = (a * b = a * 1)`] THEN + ASM_SIMP_TAC[EQ_MULT_LCANCEL] THEN STRIP_TAC THENL + [UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0; ARITH_EQ]; + UNDISCH_TAC `4 * z + x = 1` THEN REWRITE_TAC[PAIR_EQ] THEN + ASM_CASES_TAC `z = 0` THENL + [ALL_TAC; UNDISCH_TAC `~(z = 0)` THEN ARITH_TAC] THEN + UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + ASM_CASES_TAC `x = 1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MULT_CLAUSES] THEN ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* General pigeonhole lemma. *) +(* ------------------------------------------------------------------------- *) + +let PIGEONHOLE_LEMMA = prove + (`!f:A->B g s t. + FINITE(s) /\ FINITE(t) /\ + (!x. x IN s ==> f(x) IN t) /\ + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) /\ + (!x. x IN s ==> g(x) IN t) /\ + (!x y. x IN s /\ y IN s /\ (g x = g y) ==> (x = y)) /\ + CARD(t) < 2 * CARD(s) + ==> ?x y. x IN s /\ y IN s /\ (f x = g y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE (f:A->B) s`; `IMAGE (g:A->B) s`] CARD_UNION) THEN + SUBGOAL_THEN `(CARD(IMAGE (f:A->B) s) = CARD s) /\ + (CARD(IMAGE (g:A->B) s) = CARD s)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[CARD_IMAGE_INJ]; ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + MATCH_MP_TAC(TAUT `(~a ==> c) /\ ~b ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_INTER; IN_IMAGE; NOT_IN_EMPTY] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `!t. t < 2 * s /\ p <= t ==> ~(p = s + s)`) THEN + EXISTS_TAC `CARD(t:B->bool)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, consider functions out of 0...(p-1)/2, mod p. *) +(* ------------------------------------------------------------------------- *) + +let PIGEONHOLE_LEMMA_P12 = prove + (`!f g p. + ODD(p) /\ + (!x. 2 * x < p ==> f(x) < p) /\ + (!x y. 2 * x < p /\ 2 * y < p /\ (f x = f y) ==> (x = y)) /\ + (!x. 2 * x < p ==> g(x) < p) /\ + (!x y. 2 * x < p /\ 2 * y < p /\ (g x = g y) ==> (x = y)) + ==> ?x y. 2 * x < p /\ 2 * y < p /\ (f x = g y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[ODD_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + MP_TAC(ISPECL [`f:num->num`; `g:num->num`; + `{x:num | 2 * x < 2 * k + 1}`; `{x:num | x < 2 * k + 1}`] + PIGEONHOLE_LEMMA) THEN + REWRITE_TAC[ADD1; ARITH_RULE `2 * x < 2 * k + 1 <=> x < k + 1`] THEN + REWRITE_TAC[FINITE_NUMSEG_LT; CARD_NUMSEG_LT] THEN + REWRITE_TAC[IN_ELIM_THM; ARITH_RULE `2 * k + 1 < 2 * (k + 1)`]);; + +(* ------------------------------------------------------------------------- *) +(* Show that \x. x^2 + a (mod p) satisfies the conditions. *) +(* ------------------------------------------------------------------------- *) + +let SQUAREMOD_INJ_LEMMA = prove + (`!p x d. prime(p) /\ 2 * (x + d) < p /\ + ((x + d) * (x + d) + m * p = x * x + n * p) + ==> (d = 0)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p divides d \/ p divides (2 * x + d)` MP_TAC THENL + [MATCH_MP_TAC PRIME_DIVPROD THEN ASM_REWRITE_TAC[divides] THEN + EXISTS_TAC `n - m:num` THEN REWRITE_TAC[LEFT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE `!a:num. (a + b + d = a + c) ==> (b = c - d)`) THEN + EXISTS_TAC `x * x:num` THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN ARITH_TAC; + DISCH_THEN(DISJ_CASES_THEN(MP_TAC o MATCH_MP DIVIDES_LE)) THEN + SIMP_TAC[ADD_EQ_0] THEN UNDISCH_TAC `2 * (x + d) < p` THEN ARITH_TAC]);; + +let SQUAREMOD_INJ = prove + (`!p. prime(p) + ==> (!x. 2 * x < p ==> (x EXP 2 + a) MOD p < p) /\ + (!x y. 2 * x < p /\ 2 * y < p /\ + ((x EXP 2 + a) MOD p = (y EXP 2 + a) MOD p) + ==> (x = y))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `x < a ==> ~(a = 0)`)) THEN + ASM_SIMP_TAC[DIVISION] THEN + SUBGOAL_THEN + `(x EXP 2 + a = (x EXP 2 + a) DIV p * p + (x EXP 2 + a) MOD p) /\ + (y EXP 2 + a = (y EXP 2 + a) DIV p * p + (y EXP 2 + a) MOD p)` + MP_TAC THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x2 + a = xp + b:num) /\ (y2 + a = yp + b) + ==> (x2 + yp = y2 + xp)`)) THEN + DISJ_CASES_THEN MP_TAC (SPECL [`x:num`; `y:num`] LE_CASES) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o + REWRITE_RULE[LE_EXISTS]) + THENL [ONCE_REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN + REWRITE_TAC[EXP_2; ARITH_RULE `(x + d = x) = (d = 0)`] THEN + ASM_MESON_TAC[SQUAREMOD_INJ_LEMMA]);; + +(* ------------------------------------------------------------------------- *) +(* Show that also a reflection mod p retains this property. *) +(* ------------------------------------------------------------------------- *) + +let REFLECT_INJ = prove + (`(!x. 2 * x < p ==> f(x) < p) /\ + (!x y. 2 * x < p /\ 2 * y < p /\ (f x = f y) ==> (x = y)) + ==> (!x. 2 * x < p ==> p - 1 - f(x) < p) /\ + (!x y. 2 * x < p /\ 2 * y < p /\ (p - 1 - f(x) = p - 1 - f(y)) + ==> (x = y))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[ARITH_RULE `2 * x < p ==> p - 1 - y < p`] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE + `x < p /\ y < p /\ (p - 1 - x = p - 1 - y) ==> (x = y)`) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main result. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_LEMMA_ODD = prove + (`!a p. prime(p) /\ ODD(p) + ==> ?n x y. 2 * x < p /\ 2 * y < p /\ + (n * p = x EXP 2 + y EXP 2 + a + 1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL [ASM_MESON_TAC[ODD]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. (x EXP 2 + a) MOD p`; + `\x. p - 1 - (x EXP 2 + 0) MOD p`; `p:num`] + PIGEONHOLE_LEMMA_P12) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT + `(a /\ b) /\ (c /\ d) ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC REFLECT_INJ] THEN + ASM_MESON_TAC[SQUAREMOD_INJ]; ALL_TAC] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `(x = p - 1 - y) ==> y < p ==> (x + y + 1 = p)`)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o C AP_THM `p:num` o AP_TERM `(MOD)`) THEN + SUBGOAL_THEN + `((x EXP 2 + a) MOD p + (y EXP 2 + 0) MOD p + 1) MOD p = + (x EXP 2 + y EXP 2 + a + 1) MOD p` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN + EXISTS_TAC `(x EXP 2 + a) DIV p + (y EXP 2) DIV p` THEN + REWRITE_TAC[ADD_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE + `(x2 + a = xd * p + xm) /\ (y2 = yd * p + ym) + ==> (x2 + y2 + a + 1 = (xm + ym + 1) + (xd + yd) * p)`) THEN + ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN + SUBGOAL_THEN `p MOD p = 0` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `1` THEN + UNDISCH_TAC `~(p = 0)` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC + [`(x EXP 2 + y EXP 2 + a + 1) DIV p`; `x:num`; `y:num`] THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `x EXP 2 + y EXP 2 + a + 1` o + MATCH_MP DIVISION) THEN + ASM_REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Avoid the additional conditions. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_LEMMA = prove + (`!a p. prime(p) + ==> ?n x y. 2 * x <= p /\ 2 * y <= p /\ + (n * p = x EXP 2 + y EXP 2 + a)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `EVEN(p)` THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [prime]) THEN + DISCH_THEN(MP_TAC o SPEC `2` o CONJUNCT2) THEN + ANTS_TAC THENL [ASM_MESON_TAC[EVEN_EXISTS; divides]; ALL_TAC] THEN + REWRITE_TAC[ARITH_EQ] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_CASES_TAC `EVEN(a)` THENL + [UNDISCH_TAC `EVEN a` THEN REWRITE_TAC[EVEN_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN + MAP_EVERY EXISTS_TAC [`k:num`; `0`; `0`] THEN + REWRITE_TAC[ARITH; ADD_CLAUSES] THEN ARITH_TAC; + UNDISCH_TAC `~(EVEN(a))` THEN REWRITE_TAC[NOT_EVEN; ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN + MAP_EVERY EXISTS_TAC [`k + 1`; `1`; `0`] THEN + REWRITE_TAC[ARITH; ADD_CLAUSES] THEN ARITH_TAC]; + ASM_CASES_TAC `a = 0` THENL + [MAP_EVERY EXISTS_TAC [`0`; `0`; `0`] THEN + ASM_REWRITE_TAC[LE_0; ADD_CLAUSES; MULT_CLAUSES; EXP_2]; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(a = 0) ==> (a = (a - 1) + 1)`)) THEN + MP_TAC(SPECL [`a - 1`; `p:num`] LAGRANGE_LEMMA_ODD) THEN + ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[LT_IMP_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* Aubrey's lemma showing that rationals suffice for sums of 4 squares. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let REAL_INTEGER_CLOSURES = prove + (`(!n. ?p. abs(&n) = &p) /\ + (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x + y) = &p) /\ + (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x - y) = &p) /\ + (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x * y) = &p) /\ + (!x r. (?n. abs(x) = &n) ==> ?p. abs(x pow r) = &p) /\ + (!x. (?n. abs(x) = &n) ==> ?p. abs(--x) = &p) /\ + (!x. (?n. abs(x) = &n) ==> ?p. abs(abs x) = &p)`, + MATCH_MP_TAC(TAUT + `x /\ c /\ d /\ e /\ f /\ (a /\ e ==> b) /\ a + ==> x /\ a /\ b /\ c /\ d /\ e /\ f`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_NUM] THEN MESON_TAC[]; + REWRITE_TAC[REAL_ABS_MUL] THEN MESON_TAC[REAL_OF_NUM_MUL]; + REWRITE_TAC[REAL_ABS_POW] THEN MESON_TAC[REAL_OF_NUM_POW]; + REWRITE_TAC[REAL_ABS_NEG]; REWRITE_TAC[REAL_ABS_ABS]; + REWRITE_TAC[real_sub] THEN MESON_TAC[]; ALL_TAC] THEN + SIMP_TAC[REAL_ARITH `&0 <= a ==> ((abs(x) = a) <=> (x = a) \/ (x = --a))`; + REAL_POS] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_OF_NUM_ADD] THENL + [MESON_TAC[]; ALL_TAC; ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[REAL_ARITH `(--a + b = c) <=> (a + c = b)`; + REAL_ARITH `(a + --b = c) <=> (b + c = a)`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + MESON_TAC[LE_EXISTS; ADD_SYM; LE_CASES]);; + +let REAL_NUM_ROUND = prove + (`!x. &0 <= x ==> ?n. abs(x - &n) <= &1 / &2`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP REAL_ARCH_LEAST REAL_LT_01)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_MUL_RID] THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `a <= x /\ x < a + &1 + ==> abs(x - a) * &2 <= &1 \/ abs(x - (a + &1)) * &2 <= &1`)) THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MESON_TAC[REAL_OF_NUM_ADD]);; + +let REAL_POS_ABS_MIDDLE = prove + (`!x n. &0 <= x /\ (abs(x - &n) = &1 / &2) + ==> (x = &(n - 1) + &1 / &2) \/ (x = &n + &1 / &2)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`1`; `n:num`] REAL_OF_NUM_SUB) THEN + DISJ_CASES_TAC(ARITH_RULE `(n = 0) \/ 1 <= n`) THEN + ASM_REWRITE_TAC[ARITH] THENL + [MP_TAC(REAL_RAT_REDUCE_CONV `&0 <= &1 / &2`) THEN REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH `n - &1 + a = n - (&1 - a)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC]);; + +let REAL_RAT_ABS_MIDDLE = prove + (`!m n p. (abs(&m / &p - &n) = &1 / &2) + ==> (&m / &p = &(n - 1) + &1 / &2) \/ (&m / &p = &n + &1 / &2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POS_ABS_MIDDLE THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS]);; + +let AUBREY_LEMMA_4 = prove + (`!m n p q r. + ~(m = 0) /\ ~(m = 1) /\ + ((&n / &m) pow 2 + (&p / &m) pow 2 + + (&q / &m) pow 2 + (&r / &m) pow 2 = &N) + ==> ?m' n' p' q' r'. + ~(m' = 0) /\ m' < m /\ + ((&n' / &m') pow 2 + (&p' / &m') pow 2 + + (&q' / &m') pow 2 + (&r' / &m') pow 2 = &N)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?n' p' q' r'. + (&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 < &1 \/ + (((&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 = &1) /\ + (m = 2) /\ (EVEN(n' + p' + q' + r') = EVEN(N)))` + MP_TAC THENL + [ASM_CASES_TAC + `?n' p' q' r'. (&n / &m = &n' + &1 / &2) /\ + (&p / &m = &p' + &1 / &2) /\ + (&q / &m = &q' + &1 / &2) /\ + (&r / &m = &r' + &1 / &2)` THENL + [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`n':num`; `p':num`; `q':num`] THEN + SUBGOAL_THEN `m = 2` SUBST_ALL_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`2`; `2 * n' + 1`; `2 * p' + 1`; `2 * q' + 1`; `2 * r' + 1`]) THEN + REWRITE_TAC[ARITH_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(EVEN(n' + p' + q' + r') <=> EVEN(N)) \/ + (EVEN(n' + p' + q' + r' + 1) <=> EVEN(N))` + DISJ_CASES_TAC THENL + [REWRITE_TAC[EVEN_ADD; ARITH_EVEN] THEN CONV_TAC TAUT; + EXISTS_TAC `r':num` THEN DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - a = b`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + EXISTS_TAC `r' + 1` THEN DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - a = b`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - (a + c) = b - c`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV]; + ALL_TAC] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_NUM_ROUND)) + [`&n / &m`; `&p / &m`; `&q / &m`; `&r / &m`] THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN + MAP_EVERY (fun t -> DISCH_THEN(X_CHOOSE_TAC t)) + [`r':num`; `q':num`; `p':num`; `n':num`] THEN + MAP_EVERY EXISTS_TAC [`n':num`; `p':num`; `q':num`; `r':num`] THEN + DISJ1_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!m. a <= m /\ b <= m /\ c <= m /\ d <= m /\ + ~((a = m) /\ (b = m) /\ (c = m) /\ (d = m)) /\ + &4 * m <= &1 + ==> a + b + c + d < &1`) THEN + EXISTS_TAC `(&1 / &2) pow 2` THEN + ONCE_REWRITE_TAC[SYM(SPEC `a - b` REAL_POW2_ABS)] THEN + ASM_SIMP_TAC[REAL_POW_LE2; REAL_ABS_POS; REAL_LE_DIV; REAL_POS] THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `(a * a = b * b) <=> ((a + b) * (a - b) = &0)`] THEN + REWRITE_TAC[REAL_ENTIRE] THEN + SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 < y ==> ~(x + y = &0)`; + REAL_ABS_POS; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_SUB_0] THEN + FIRST_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN + (MP_TAC o MATCH_MP REAL_RAT_ABS_MIDDLE)) THEN MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n':num`; `p':num`; `q':num`; `r':num`] THEN + DISCH_TAC THEN + ABBREV_TAC `s = &n - &m * &n'` THEN + ABBREV_TAC `t = &p - &m * &p'` THEN + ABBREV_TAC `u = &q - &m * &q'` THEN + ABBREV_TAC `v = &r - &m * &r'` THEN + ABBREV_TAC `N' = n' EXP 2 + p' EXP 2 + q' EXP 2 + r' EXP 2` THEN + UNDISCH_TAC `n' EXP 2 + p' EXP 2 + q' EXP 2 + r' EXP 2 = N'` THEN + DISCH_THEN(ASSUME_TAC o REWRITE_RULE + [GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW]) THEN + ABBREV_TAC `M = 2 * (n * n' + p * p' + q * q' + r * r')` THEN + UNDISCH_TAC `2 * (n * n' + p * p' + q * q' + r * r') = M` THEN + DISCH_THEN(ASSUME_TAC o REWRITE_RULE + [GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL; + GSYM REAL_OF_NUM_POW]) THEN + ASM_CASES_TAC `(&n / &m = &n') /\ (&p / &m = &p') /\ + (&q / &m = &q') /\ (&r / &m = &r')` THENL + [MAP_EVERY EXISTS_TAC [`1`; `n':num`; `p':num`; `q':num`; `r':num`] THEN + REWRITE_TAC[ARITH_EQ; REAL_DIV_1] THEN CONJ_TAC THENL + [UNDISCH_TAC `~(m = 0)` THEN UNDISCH_TAC `~(m = 1)` THEN ARITH_TAC; + UNDISCH_THEN + `(&n / &m) pow 2 + (&p / &m) pow 2 + + (&q / &m) pow 2 + (&r / &m) pow 2 = &N` + (SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2` + MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `&0 <= w /\ &0 <= x /\ &0 <= y /\ &0 <= z /\ + ~((w = &0) /\ (x = &0) /\ (y = &0) /\ (z = &0)) + ==> &0 < w + x + y + z`) THEN + REWRITE_TAC[REAL_POW_2; REAL_ENTIRE; REAL_LE_SQUARE] THEN + ASM_REWRITE_TAC[REAL_SUB_0]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o check (is_disj o concl)) THEN + SUBGOAL_THEN + `(&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 = + (s pow 2 + t pow 2 + u pow 2 + v pow 2) / &m pow 2` + MP_TAC THENL + [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&m pow 2` THEN + ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_DIV_RMUL; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_POW_MUL; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_DIV_RMUL; REAL_OF_NUM_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(&n / &m - &n') pow 2 + (&p / &m - &p') pow 2 + + (&q / &m - &q') pow 2 + (&r / &m - &r') pow 2 = + (&N + &N') - &M / &m` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&m pow 2` THEN + ASM_SIMP_TAC[REAL_POW_EQ_0; REAL_DIV_RMUL; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM(ASSUME `(&n / &m) pow 2 + (&p / &m) pow 2 + + (&q / &m) pow 2 + (&r / &m) pow 2 = &N`); + GSYM(ASSUME `&n' pow 2 + &p' pow 2 + &q' pow 2 + &r' pow 2 = &N'`); + GSYM(ASSUME + `&2 * (&n * &n' + &p * &p' + &q * &q' + &r * &r') = &M`)] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_POW_MUL; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_DIV_RMUL; REAL_OF_NUM_EQ; ASSUME `~(m = 0)`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_DIV_RMUL; REAL_OF_NUM_EQ; ASSUME `~(m = 0)`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - c < &1 <=> (a + b) - &1 < c`; + REAL_ARITH `((a + b) - c = &1) <=> ((a + b) - &1 = c)`; + REAL_ARITH `&0 < a - b <=> b < a`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < n <=> ~(n = 0)`; ASSUME `~(m = 0)`] THEN + REWRITE_TAC[REAL_ARITH `(a - &1) * m < M <=> a * m - M < m`; + REAL_ARITH `((a - &1) * m = M) <=> (a * m - M = m)`] THEN + REPEAT DISCH_TAC THEN + UNDISCH_TAC `(&N + &N') - &M / &m = + (s pow 2 + t pow 2 + u pow 2 + v pow 2) / &m pow 2` THEN + ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; + ARITH_RULE `0 < a <=> ~(a = 0)`] THEN + REWRITE_TAC[REAL_POW_2; REAL_SUB_RDISTRIB; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_OF_NUM_EQ; GSYM REAL_POW_2] THEN + ABBREV_TAC `m':num = (N + N') * m - M` THEN + SUBGOAL_THEN `(&N + &N') * &m - &M = &m'` + (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) + THENL + [EXPAND_TAC "m'" THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN + MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD; GSYM + REAL_OF_NUM_MUL] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN `~(m' = 0)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM(ASSUME `(&N + &N') * &m - &M = &m'`)] THEN + MATCH_MP_TAC(REAL_ARITH `b < a ==> ~(a - b = &0)`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!z. (&n' + s * z) pow 2 + (&p' + t * z) pow 2 + + (&q' + u * z) pow 2 + (&r' + v * z) pow 2 - &N = + (&m * z - &1) * (&m' * z + &N - &N')` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&m * &m' * z pow 2 + (&M - &2 * &m * &N') * z + &N' - &N` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_2; REAL_ARITH + `(n + s * z) * (n + s * z) + (p + t * z) * (p + t * z) + + (q + u * z) * (q + u * z) + (r + v * z) * (r + v * z) - N = + (s * s + t * t + u * u + v * v) * (z * z) + + (&2 * (n * s + p * t + q * u + r * v)) * z + + ((n * n + p * p + q * q + r * r) - N)`] THEN + ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN + MATCH_MP_TAC(REAL_ARITH + `(a = c) /\ (b = d) ==> (a + b + n - m = c + d + n - m)`) THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM(ASSUME + `&n' pow 2 + &p' pow 2 + &q' pow 2 + &r' pow 2 = &N'`); + GSYM(ASSUME + `&2 * (&n * &n' + &p * &p' + &q * &q' + &r * &r') = &M`)] THEN + MAP_EVERY EXPAND_TAC ["s"; "t"; "u"; "v"] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `(m * z - &1) * (m' * z + nn) = m * m' * z * z + + (m * z * nn - m' * z) - nn`] THEN + REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[REAL_ARITH `(a + n' - n = b - (n - n')) <=> (a = b)`] THEN + REWRITE_TAC[REAL_ARITH `a * z * b - c * z = (a * b - c) * z`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM(ASSUME `(&N + &N') * &m - &M = &m'`)] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + ABBREV_TAC `w = &n' + s * (&N' - &N) / &m'` THEN + ABBREV_TAC `x = &p' + t * (&N' - &N) / &m'` THEN + ABBREV_TAC `y = &q' + u * (&N' - &N) / &m'` THEN + ABBREV_TAC `z = &r' + v * (&N' - &N) / &m'` THEN + SUBGOAL_THEN `w pow 2 + x pow 2 + y pow 2 + z pow 2 = &N` + (SUBST1_TAC o SYM) THENL + [MAP_EVERY EXPAND_TAC ["w"; "x"; "y"; "z"] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a + b + c + d = e) <=> (a + b + c + d - e = &0)`] THEN + FIRST_ASSUM(SUBST1_TAC o SPEC `(&N' - &N) / &m'`) THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL + [EXISTS_TAC `m':num` THEN + SUBGOAL_THEN + `?a b c d. (abs(&n' * &m' + s * (&N' - &N)) = &a) /\ + (abs(&p' * &m' + t * (&N' - &N)) = &b) /\ + (abs(&q' * &m' + u * (&N' - &N)) = &c) /\ + (abs(&r' * &m' + v * (&N' - &N)) = &d)` + MP_TAC THENL + [MAP_EVERY EXPAND_TAC ["s"; "t"; "u"; "v"] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + MESON_TAC[REAL_INTEGER_CLOSURES]; ALL_TAC] THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) + [`a:num`; `b:num`; `c:num`; `d:num`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_OF_NUM_LT]) THEN + REWRITE_TAC[REAL_POW_DIV; REAL_POW2_ABS] THEN + REWRITE_TAC[GSYM REAL_POW_DIV] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM real_div; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `?n. abs((&N' - &N) / &2) = &n` ASSUME_TAC THENL + [REWRITE_TAC[GSYM(ASSUME + `&n' pow 2 + &p' pow 2 + &q' pow 2 + &r' pow 2 = &N'`)] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `EVEN(n' EXP 2 + p' EXP 2 + q' EXP 2 + r' EXP 2) = + EVEN N` + MP_TAC THENL + [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + REWRITE_TAC[EVEN_ADD; EVEN_EXP; ARITH_EQ]; + ALL_TAC] THEN + DISJ_CASES_THEN MP_TAC (TAUT `EVEN(N) \/ ~EVEN(N)`) THEN SIMP_TAC[] THEN + REWRITE_TAC[NOT_EVEN; EVEN_EXISTS; ODD_EXISTS] THEN + REPEAT(DISCH_THEN(CHOOSE_THEN SUBST1_TAC)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_ARITH `(&2 * x + &1) - (&2 * y + &1) = &2 * (x - y)`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RID] THEN MESON_TAC[REAL_INTEGER_CLOSURES]; + ALL_TAC] THEN + EXISTS_TAC `1` THEN REWRITE_TAC[ARITH_EQ] THEN + SUBGOAL_THEN + `?a b c d. (abs(&n' + s * (&N' - &N) / &2) = &a) /\ + (abs(&p' + t * (&N' - &N) / &2) = &b) /\ + (abs(&q' + u * (&N' - &N) / &2) = &c) /\ + (abs(&r' + v * (&N' - &N) / &2) = &d)` + MP_TAC THENL + [MAP_EVERY EXPAND_TAC ["s"; "t"; "u"; "v"] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + UNDISCH_TAC `?n. abs ((&N' - &N) / &2) = &n` THEN + MESON_TAC[REAL_INTEGER_CLOSURES]; ALL_TAC] THEN + REWRITE_TAC[ARITH; REAL_DIV_1] THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) + [`a:num`; `b:num`; `c:num`; `d:num`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN + ASM_REWRITE_TAC[REAL_POW2_ABS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main result. *) +(* ------------------------------------------------------------------------- *) + +let AUBREY_THM_4 = prove + (`(?q. ~(q = 0) /\ + ?a b c d. + (&a / &q) pow 2 + (&b / &q) pow 2 + + (&c / &q) pow 2 + (&d / &q) pow 2 = &N) + ==> ?a b c d. &a pow 2 + &b pow 2 + &c pow 2 + &d pow 2 = &N`, + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN + ASM_CASES_TAC `m = 1` THENL + [ASM_REWRITE_TAC[REAL_DIV_1; ARITH_EQ] THEN MESON_TAC[]; + STRIP_TAC THEN MP_TAC(SPEC `m:num` AUBREY_LEMMA_4) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The algebraic lemma. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_IDENTITY = REAL_ARITH + `(w1 pow 2 + x1 pow 2 + y1 pow 2 + z1 pow 2) * + (w2 pow 2 + x2 pow 2 + y2 pow 2 + z2 pow 2) = + (w1 * w2 - x1 * x2 - y1 * y2 - z1 * z2) pow 2 + + (w1 * x2 + x1 * w2 + y1 * z2 - z1 * y2) pow 2 + + (w1 * y2 - x1 * z2 + y1 * w2 + z1 * x2) pow 2 + + (w1 * z2 + x1 * y2 - y1 * x2 + z1 * w2) pow 2`;; + +(* ------------------------------------------------------------------------- *) +(* Now sum of 4 squares. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_REAL_NUM = prove + (`!n. ?w x y z. &n = &w pow 2 + &x pow 2 + &y pow 2 + &z pow 2`, + let lemma = prove + (`(?a. abs(w) = &a) /\ (?b. abs(x) = &b) /\ + (?c. abs(y) = &c) /\ (?d. abs(z) = &d) + ==> ?a b c d. w pow 2 + x pow 2 + y pow 2 + z pow 2 = + &a pow 2 + &b pow 2 + &c pow 2 + &d pow 2`, + STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ABS_NUM] THEN + MESON_TAC[]) in + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [REPEAT(EXISTS_TAC `0`) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [EXISTS_TAC `1` THEN REPEAT(EXISTS_TAC `0`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN + ASM_CASES_TAC `m = 1` THENL + [ALL_TAC; + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `p:num` th) THEN MP_TAC(SPEC `m:num` th)) THEN + ONCE_REWRITE_TAC[ARITH_RULE `m < p * m <=> 1 * m < p * m`] THEN + REWRITE_TAC[LT_MULT_RCANCEL] THEN + ONCE_REWRITE_TAC[ARITH_RULE `p < p * m <=> p * 1 < p * m`] THEN + REWRITE_TAC[LT_MULT_LCANCEL] THEN + UNDISCH_TAC `~(p * m = 0)` THEN REWRITE_TAC[MULT_EQ_0] THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(p = 1)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 < x <=> ~(x = 0) /\ ~(x = 1)`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`w1:num`; `x1:num`; `y1:num`; `z1:num`] THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`w2:num`; `x2:num`; `y2:num`; `z2:num`] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[LAGRANGE_IDENTITY] THEN + MATCH_MP_TAC lemma THEN REWRITE_TAC[REAL_OF_NUM_MUL] THEN + MESON_TAC[REAL_INTEGER_CLOSURES]] THEN + UNDISCH_TAC `m = 1` THEN DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[MULT_CLAUSES] THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LAGRANGE_LEMMA) THEN + DISCH_THEN(MP_TAC o SPEC `1 EXP 2 + 0 EXP 2`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`q:num`; `x:num`; `y:num`] THEN STRIP_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC AUBREY_THM_4 THEN + SUBGOAL_THEN `q * p < p EXP 2` MP_TAC THENL + [ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE + `(2 * x) * (2 * x) <= p * p /\ (2 * y) * (2 * y) <= p * p /\ + 2 * 2 <= p * p + ==> x * x + y * y + 1 < p * p`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC [`~(p = 0)`; `~(p = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[EXP_2; LT_MULT_RCANCEL] THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`; `c:num`; `d:num`] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(q = 0)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `0 * p = x EXP 2 + y EXP 2 + 1 EXP 2 + 0 EXP 2` THEN + DISCH_THEN(MP_TAC o SYM) THEN REWRITE_TAC[MULT_CLAUSES; EXP_2] THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN + SUBGOAL_THEN `&p = &q * &(q * p) / &q pow 2` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_MUL_ASSOC; real_div] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_POW_EQ_0; REAL_MUL_LINV; REAL_MUL_LID; + ASSUME `~(q = 0)`; REAL_OF_NUM_EQ]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; LAGRANGE_IDENTITY] THEN + SUBST1_TAC(SYM(ASSUME + `&q = &a pow 2 + &b pow 2 + &c pow 2 + &d pow 2`)) THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div; GSYM REAL_POW_DIV] THEN + EXISTS_TAC `q:num` THEN REWRITE_TAC[ASSUME `~(q = 0)`] THEN + REWRITE_TAC[REAL_POW_DIV] THEN + REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN + REWRITE_TAC[REAL_INV_EQ_0; REAL_POW_EQ_0; REAL_OF_NUM_EQ; + ASSUME `~(q = 0)`] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC lemma THEN + REWRITE_TAC[REAL_OF_NUM_MUL] THEN MESON_TAC[REAL_INTEGER_CLOSURES]);; + +(* ------------------------------------------------------------------------- *) +(* Also prove it for the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_NUM = prove + (`!n. ?w x y z. n = w EXP 2 + x EXP 2 + y EXP 2 + z EXP 2`, + GEN_TAC THEN MP_TAC(SPEC `n:num` LAGRANGE_REAL_NUM) THEN + REWRITE_TAC[REAL_POS; REAL_OF_NUM_POW; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* And for the integers. *) +(* ------------------------------------------------------------------------- *) + +prioritize_int();; + +let LAGRANGE_INT = prove + (`!a. &0 <= a <=> ?w x y z. a = w pow 2 + x pow 2 + y pow 2 + z pow 2`, + GEN_TAC THEN EQ_TAC THENL + [SPEC_TAC(`a:int`,`a:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN + X_GEN_TAC `n:num` THEN MP_TAC(SPEC `n:num` LAGRANGE_REAL_NUM) THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_POW; GSYM INT_OF_NUM_ADD] THEN + MESON_TAC[]; + STRIP_TAC THEN ASM_SIMP_TAC[INT_LE_SQUARE; INT_LE_ADD; INT_POW_2]]);; + +prioritize_num();; diff --git a/100/fourier.ml b/100/fourier.ml new file mode 100644 index 0000000..c87a038 --- /dev/null +++ b/100/fourier.ml @@ -0,0 +1,5892 @@ +(* ========================================================================= *) +(* L_p spaces, square integrable functions and basics of Fourier series. *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* Somewhat general lemmas, but perhaps not enough to be installed. *) +(* ------------------------------------------------------------------------- *) + +let SUM_NUMBERS = prove + (`!n. sum(0..n) (\r. &r) = (&n * (&n + &1)) / &2`, + INDUCT_TAC THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC);; + +let REAL_MAX_RPOW = prove + (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z + ==> max (x rpow z) (y rpow z) = (max x y) rpow z`, + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [MESON_TAC[REAL_ARITH `max x y:real = max y x`]; ALL_TAC] THEN + SIMP_TAC[RPOW_LE2; REAL_ARITH `max x y:real = if x <= y then y else x`]);; + +let REAL_MIN_RPOW = prove + (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z + ==> min (x rpow z) (y rpow z) = (min x y) rpow z`, + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [MESON_TAC[REAL_ARITH `min x y:real = min y x`]; ALL_TAC] THEN + SIMP_TAC[RPOW_LE2; REAL_ARITH `min x y:real = if x <= y then x else y`]);; + +let MEASURABLE_ON_LIFT_RPOW = prove + (`!f:real^N->real s y. + (\x. lift(f x)) measurable_on s /\ &0 < y + ==> (\x. lift(f x rpow y)) measurable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^N. lift(f x rpow y)) = + (lift o (\w. w rpow y) o drop) o (\x. lift(f x))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[o_DEF; DROP_VEC; RPOW_ZERO; LIFT_NUM; REAL_LT_IMP_NZ]]);; + +let LIM_RPOW_NULL = prove + (`!net p x:A->real. + ((lift o x) --> vec 0) net /\ &0 < p + ==> ((\i. lift(x(i) rpow p)) --> vec 0) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o ISPEC `lift o (\x. x rpow p) o drop` o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN + REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC);; + +let REAL_INTEGRABLE_REFLECT_AND_ADD = prove + (`!f a. f real_integrable_on real_interval[--a,a] + ==> f real_integrable_on real_interval[&0,a] /\ + (\x. f(--x)) real_integrable_on real_interval[&0,a] /\ + (\x. f x + f(--x)) real_integrable_on real_interval[&0,a]`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[REAL_NEG_NEG; ETA_AX]; + SIMP_TAC[REAL_INTEGRABLE_ADD]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_SUBINTERVAL)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN REAL_ARITH_TAC);; + +let REAL_INTEGRAL_REFLECT_AND_ADD = prove + (`!f a. f real_integrable_on real_interval[--a,a] + ==> real_integral (real_interval[--a,a]) f = + real_integral (real_interval[&0,a]) + (\x. f x + f(--x))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= a` THENL + [MP_TAC(SPECL [`f:real->real`; `--a:real`; `a:real`; `&0:real`] + REAL_INTEGRAL_COMBINE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRABLE_REFLECT_AND_ADD] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INTEGRAL_REFLECT] THEN + REWRITE_TAC[REAL_NEG_NEG; ETA_AX; REAL_NEG_0; REAL_ADD_AC]; + ASM_SIMP_TAC[REAL_INTEGRAL_NULL; + REAL_ARITH `~(&0 <= a) ==> a <= --a /\ a <= &0`]]);; + +(* ------------------------------------------------------------------------- *) +(* L_p spaces with respect to a set s. *) +(* ------------------------------------------------------------------------- *) + +let lspace = new_definition + `lspace s p = + {f:real^M->real^N | f measurable_on s /\ + (\x. lift(norm(f x) rpow p)) integrable_on s}`;; + +let LSPACE_ZERO = prove + (`!s. lspace s (&0) = + if measurable s then {f:real^M->real^N | f measurable_on s} else {}`, + REWRITE_TAC[lspace; RPOW_POW; real_pow; NORM_0; LIFT_NUM] THEN + GEN_TAC THEN REWRITE_TAC[INTEGRABLE_ON_CONST; VEC_EQ; ARITH_EQ] THEN + ASM_CASES_TAC `measurable(s:real^M->bool)` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let LSPACE_CONST = prove + (`!s p c. measurable s ==> (\x. c) IN lspace s p`, + SIMP_TAC[lspace; IN_ELIM_THM; INTEGRABLE_ON_CONST; + INTEGRABLE_IMP_MEASURABLE]);; + +let LSPACE_0 = prove + (`!s p. ~(p = &0) ==> (\x. vec 0) IN lspace s p`, + SIMP_TAC[lspace; IN_ELIM_THM; NORM_0; RPOW_ZERO; LIFT_NUM] THEN + SIMP_TAC[INTEGRABLE_IMP_MEASURABLE; INTEGRABLE_0]);; + +let LSPACE_CMUL = prove + (`!s p c f:real^M->real^N. + f IN lspace s p ==> (\x. c % f x) IN lspace s p`, + REPEAT GEN_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN + SIMP_TAC[NORM_MUL; RPOW_MUL; NORM_POS_LE; LIFT_CMUL] THEN + SIMP_TAC[MEASURABLE_ON_CMUL; INTEGRABLE_CMUL]);; + +let LSPACE_NEG = prove + (`!s p f:real^M->real^N. f IN lspace s p ==> (\x. --(f x)) IN lspace s p`, + REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`; LSPACE_CMUL]);; + +let LSPACE_ADD = prove + (`!s p f g:real^M->real^N. + &0 <= p /\ f IN lspace s p /\ g IN lspace s p + ==> (\x. f(x) + g(x)) IN lspace s p`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN ASM_CASES_TAC `p = &0` THEN + ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[LSPACE_ZERO] THEN + ASM_CASES_TAC `measurable(s:real^M->bool)` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; MEASURABLE_ON_ADD]; + ALL_TAC] THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_ON_ADD] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. lift(&2 rpow p * (norm((f:real^M->real^N) x) rpow p + + norm((g:real^M->real^N) x) rpow p))` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\x:real^M. lift(norm(f x + g x:real^N) rpow p)) = + (lift o (\y. y rpow p) o drop) o (\x. lift(norm(f x + g x)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_NORM THEN + MATCH_MP_TAC MEASURABLE_ON_ADD THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[LIFT_NUM]]; + REWRITE_TAC[LIFT_CMUL; LIFT_ADD] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 <= norm(f + g:real^N) rpow p /\ &0 <= norm f /\ &0 <= norm g /\ + norm(f + g) rpow p <= (norm f + norm g) rpow p) /\ + (&0 <= norm f /\ &0 <= norm g ==> (norm f + norm g) rpow p <= e) + ==> abs(norm(f + g) rpow p) <= e`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[NORM_POS_LE; RPOW_POS_LE; RPOW_LE2; NORM_TRIANGLE; RPOW_LE2; + REAL_LT_IMP_LE]; + SPEC_TAC(`norm((g:real^M->real^N) x)`,`z:real`) THEN + SPEC_TAC(`norm((f:real^M->real^N) x)`,`w:real`) THEN + MATCH_MP_TAC REAL_WLOG_LE THEN + CONJ_TAC THENL [MESON_TAC[REAL_ADD_SYM]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * z) rpow p` THEN CONJ_TAC THENL + [MATCH_MP_TAC RPOW_LE2 THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[RPOW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_ADDL; RPOW_POS_LE; REAL_POS]]]]);; + +let LSPACE_SUB = prove + (`!s p f g:real^M->real^N. + &0 <= p /\ f IN lspace s p /\ g IN lspace s p + ==> (\x. f(x) - g(x)) IN lspace s p`, + SIMP_TAC[VECTOR_SUB; LSPACE_ADD; LSPACE_NEG]);; + +let LSPACE_IMP_INTEGRABLE = prove + (`!s p f. f IN lspace s p ==> (\x. lift(norm(f x) rpow p)) integrable_on s`, + SIMP_TAC[lspace; IN_ELIM_THM]);; + +let LSPACE_NORM = prove + (`!s p f. f IN lspace s p ==> (\x. lift(norm(f x))) IN lspace s p`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN + SIMP_TAC[NORM_LIFT; REAL_ABS_NORM; MEASURABLE_ON_NORM]);; + +let LSPACE_VSUM = prove + (`!s p f:A->real^M->real^N t. + &0 < p /\ FINITE t /\ (!i. i IN t ==> (f i) IN lspace s p) + ==> (\x. vsum t (\i. f i x)) IN lspace s p`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; LSPACE_0; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[LSPACE_ADD; REAL_LT_IMP_LE; ETA_AX; IN_INSERT]);; + +let LSPACE_MAX = prove + (`!s p k f:real^M->real^N g:real^M->real^N. + f IN lspace s p /\ g IN lspace s p /\ &0 < p + ==> ((\x. lambda i. max (f x$i) (g x$i)):real^M->real^N) IN lspace s p`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MEASURABLE_ON_MAX] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC + `\x. lift(&(dimindex(:N)) rpow p * + max (norm((f:real^M->real^N) x) rpow p) + (norm((g:real^M->real^N) x) rpow p))` THEN + ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; + MEASURABLE_ON_MAX] THEN + CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN + CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + SIMP_TAC[RPOW_POS_LE; NORM_POS_LE]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_MAX_RPOW; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM RPOW_MUL; NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN + REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + GEN_REWRITE_TAC + (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `abs(x) <= y /\ abs(x') <= y' ==> abs(max x x') <= max y y'`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]]);; + +let LSPACE_MIN = prove + (`!s p k f:real^M->real^N g:real^M->real^N. + f IN lspace s p /\ g IN lspace s p /\ &0 < p + ==> ((\x. lambda i. min (f x$i) (g x$i)):real^M->real^N) IN lspace s p`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MEASURABLE_ON_MIN] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC + `\x. lift(&(dimindex(:N)) rpow p * + max (norm((f:real^M->real^N) x) rpow p) + (norm((g:real^M->real^N) x) rpow p))` THEN + ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; + MEASURABLE_ON_MIN] THEN + CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN + CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + SIMP_TAC[RPOW_POS_LE; NORM_POS_LE]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_MAX_RPOW; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM RPOW_MUL; NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN + REWRITE_TAC[LIFT_DROP] THEN MATCH_MP_TAC RPOW_LE2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + GEN_REWRITE_TAC + (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `abs(x) <= y /\ abs(x') <= y' ==> abs(min x x') <= max y y'`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]]);; + +let LSPACE_BOUNDED_MEASURABLE = prove + (`!s p f:real^M->real^N g:real^M->real^N. + &0 < p /\ f measurable_on s /\ g IN lspace s p /\ + (!x. x IN s ==> norm(f x) <= norm(g x)) + ==> f IN lspace s p`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[lspace; IN_ELIM_THM] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. lift(norm((g:real^M->real^N) x) rpow p)` THEN + ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE] THEN + ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN + REWRITE_TAC[REAL_ABS_RPOW; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[RPOW_LE2; REAL_LT_IMP_LE; NORM_POS_LE]);; + +let LSPACE_INTEGRABLE_PRODUCT = prove + (`!s p q f:real^M->real^N g:real^M->real^N. + &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\ + f IN lspace s p /\ g IN lspace s q + ==> (\x. lift(norm(f x) * norm(g x))) integrable_on s`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x) rpow p / p) + + lift(norm((g:real^M->real^N) x) rpow q / q)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o ABS_CONV o LAND_CONV) + [GSYM LIFT_DROP] THEN + MATCH_MP_TAC MEASURABLE_ON_DROP_MUL THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_NORM THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_ADD THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + REWRITE_TAC[LIFT_CMUL] THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[NORM_LIFT; REAL_ABS_MUL; REAL_ABS_NORM; LIFT_DROP; + DROP_ADD] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC YOUNG_INEQUALITY THEN + ASM_REWRITE_TAC[NORM_POS_LE]]);; + +let LSPACE_1 = prove + (`!f:real^M->real^N s. f IN lspace s (&1) <=> f absolutely_integrable_on s`, + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE; lspace; IN_ELIM_THM] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1]);; + +let LSPACE_MONO = prove + (`!f:real^M->real^N s p q. + f IN lspace s q /\ measurable s /\ &0 < p /\ p <= q + ==> f IN lspace s p`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. lift(max (&1) (norm((f:real^M->real^N) x) rpow q))` THEN + ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN + CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; INTEGRABLE_ON_CONST] THEN + REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + SIMP_TAC[RPOW_POS_LE; NORM_POS_LE; REAL_POS]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ABS_RPOW; REAL_ABS_NORM] THEN + DISJ_CASES_TAC(ISPECL [`&1`; `norm((f:real^M->real^N) x)`] REAL_LE_TOTAL) + THENL + [MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max z y`) THEN + MATCH_MP_TAC RPOW_MONO THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max y z`) THEN + MATCH_MP_TAC RPOW_1_LE THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REAL_ARITH_TAC]]);; + +let LSPACE_INCLUSION = prove + (`!s p q. measurable s /\ &0 < p /\ p <= q + ==> (lspace s q :(real^M->real^N)->bool) SUBSET (lspace s p)`, + REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `q:real` THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The corresponding seminorm; Hoelder and Minkowski inequalities. *) +(* ------------------------------------------------------------------------- *) + +let lnorm = new_definition + `lnorm s p f = + drop(integral s (\x. lift(norm(f x) rpow p))) rpow (inv p)`;; + +let LNORM_0 = prove + (`!s p. ~(p = &0) ==> lnorm s p (\x. vec 0) = &0`, + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[lnorm; NORM_0; RPOW_ZERO] THEN + ASM_REWRITE_TAC[LIFT_NUM; INTEGRAL_0; DROP_VEC; RPOW_ZERO; REAL_INV_EQ_0]);; + +let LNORM_NEG = prove + (`!s p f:real^M->real^N. lnorm s p (\x. --(f x)) = lnorm s p f`, + REWRITE_TAC[lnorm; NORM_NEG]);; + +let LNORM_MUL = prove + (`!s p f c. f IN lspace s p /\ ~(p = &0) + ==> lnorm s p (\x. c % f x) = abs(c) * lnorm s p f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm; NORM_MUL; RPOW_MUL; LIFT_CMUL] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL; LSPACE_IMP_INTEGRABLE] THEN + REWRITE_TAC[DROP_CMUL; RPOW_MUL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[RPOW_RPOW; REAL_ABS_POS; REAL_MUL_RINV] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1]);; + +let LNORM_EQ_0 = prove + (`!s p f. ~(p = &0) /\ f IN lspace s p + ==> (lnorm s p f = &0 <=> + negligible {x | x IN s /\ ~(f x = vec 0)})`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[lnorm; RPOW_EQ_0; REAL_INV_EQ_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN + ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL] THEN + SIMP_TAC[HAS_INTEGRAL_NEGLIGIBLE_EQ; lift; LAMBDA_BETA; NORM_POS_LE; + RPOW_POS_LE] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + SIMP_TAC[IN_ELIM_THM; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[FORALL_1; DIMINDEX_1; VEC_COMPONENT] THEN + ASM_REWRITE_TAC[RPOW_EQ_0; NORM_EQ_0; CART_EQ; VEC_COMPONENT]);; + +let LNORM_POS_LE = prove + (`!s p f. f IN lspace s p ==> &0 <= lnorm s p f`, + SIMP_TAC[lspace; IN_ELIM_THM; lnorm] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RPOW_POS_LE THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN + ASM_SIMP_TAC[LIFT_DROP; NORM_POS_LE; RPOW_POS_LE]);; + +let LNORM_NORM = prove + (`!s p f. lnorm s p (\x. lift(norm(f x))) = lnorm s p f`, + REWRITE_TAC[lnorm; NORM_LIFT; REAL_ABS_NORM]);; + +let LNORM_RPOW = prove + (`!s p f:real^M->real^N. + f IN lspace s p /\ ~(p = &0) + ==> (lnorm s p f) rpow p = + drop(integral s (\x. lift(norm(f x) rpow p)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN + ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; RPOW_RPOW; + LSPACE_IMP_INTEGRABLE; RPOW_POS_LE] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; RPOW_POW; REAL_POW_1]);; + +let INTEGRAL_LNORM_RPOW = prove + (`!s p f:real^M->real^N. + f IN lspace s p /\ ~(p = &0) + ==> integral s (\x. lift(norm(f x) rpow p)) = + lift((lnorm s p f) rpow p)`, + SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; LNORM_RPOW]);; + +let HOELDER_INEQUALITY = prove + (`!s p q f:real^M->real^N g:real^M->real^N. + &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\ + f IN lspace s p /\ g IN lspace s q + ==> drop(integral s (\x. lift(norm(f x) * norm(g x)))) + <= lnorm s p f * lnorm s q g`, + MP_TAC LSPACE_INTEGRABLE_PRODUCT THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= lnorm s p (f:real^M->real^N) /\ + &0 <= lnorm s q (g:real^M->real^N)` + MP_TAC THENL [ASM_SIMP_TAC[LNORM_POS_LE]; REWRITE_TAC[IMP_CONJ]] THEN + REPEAT + (GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + DISCH_THEN(DISJ_CASES_THEN2 MP_TAC ASSUME_TAC) THENL + [ASM_SIMP_TAC[LNORM_EQ_0; REAL_LT_IMP_NZ] THEN REPEAT DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 ==> x <= y`) THEN + ASM_SIMP_TAC[REAL_LE_MUL; LNORM_POS_LE; GSYM LIFT_EQ; LIFT_DROP] THEN + ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL; LIFT_NUM] THEN + SIMP_TAC[HAS_INTEGRAL_NEGLIGIBLE_EQ; lift; LAMBDA_BETA; NORM_POS_LE; + REAL_LE_MUL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SIMP_TAC[CART_EQ; SUBSET; IN_ELIM_THM; LAMBDA_BETA] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT] THEN + REWRITE_TAC[REAL_ENTIRE; CART_EQ; NORM_EQ_0; VEC_COMPONENT] THEN + MESON_TAC[]; + ALL_TAC]) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_MUL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + REWRITE_TAC[GSYM DROP_CMUL] THEN ASM_SIMP_TAC[GSYM INTEGRAL_CMUL] THEN + REWRITE_TAC[REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral s + (\x. lift(norm(inv(lnorm s p f) % (f:real^M->real^N) x) rpow p / p + + norm(inv(lnorm s q g) % (g:real^M->real^N) x) rpow q / q)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_SIMP_TAC[LIFT_DROP; INTEGRABLE_CMUL] THEN CONJ_TAC THENL + [REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC INTEGRABLE_ADD THEN + REWRITE_TAC[NORM_MUL; RPOW_MUL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; INTEGRABLE_CMUL; LIFT_CMUL]; + REWRITE_TAC[DROP_CMUL; LIFT_DROP; NORM_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[real_abs; LNORM_POS_LE; REAL_LT_IMP_NZ] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a * b) * (c * d:real) = (a * c) * (b * d)`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC YOUNG_INEQUALITY THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; LNORM_POS_LE; REAL_LE_INV_EQ]]; + REWRITE_TAC[LIFT_ADD; NORM_MUL; LIFT_CMUL; RPOW_MUL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + REWRITE_TAC[LIFT_CMUL; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[INTEGRAL_ADD; INTEGRABLE_CMUL; INTEGRAL_CMUL; + LSPACE_IMP_INTEGRABLE; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`; RPOW_INV] THEN + ASM_SIMP_TAC[INTEGRAL_LNORM_RPOW; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; + RPOW_POS_LT] THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]]);; + +let HOELDER_INEQUALITY_FULL = prove + (`!s p q f:real^M->real^N g:real^M->real^N. + &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 /\ + f IN lspace s p /\ g IN lspace s q + ==> (\x. lift(norm(f x) * norm(g x))) integrable_on s /\ + drop(integral s (\x. lift(norm(f x) * norm(g x)))) + <= lnorm s p f * lnorm s q g`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LSPACE_INTEGRABLE_PRODUCT) THEN + ASM_SIMP_TAC[HOELDER_INEQUALITY]);; + +let LNORM_TRIANGLE = prove + (`!s p f:real^M->real^N g:real^M->real^N. + f IN lspace s p /\ g IN lspace s p /\ &1 <= p + ==> lnorm s p (\x. f x + g x) <= lnorm s p f + lnorm s p g`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `p = &1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_SIMP_TAC[lnorm; + MESON[RPOW_POW; REAL_POW_1; REAL_INV_1] `x rpow (inv(&1)) = x`; + GSYM DROP_ADD; GSYM INTEGRAL_ADD; LSPACE_IMP_INTEGRABLE] THEN + MATCH_MP_TAC INTEGRAL_DROP_LE_MEASURABLE THEN + ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; INTEGRABLE_ADD] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1; LIFT_DROP; DROP_ADD] THEN + REWRITE_TAC[NORM_POS_LE; NORM_TRIANGLE] THEN + MATCH_MP_TAC MEASURABLE_ON_NORM THEN MATCH_MP_TAC MEASURABLE_ON_ADD THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 < p` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= lnorm s p (\x. (f:real^M->real^N) x + g x)` MP_TAC THENL + [ASM_SIMP_TAC[LNORM_POS_LE; LSPACE_ADD; REAL_ARITH `&1 <= p ==> &0 <= p`]; + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[LNORM_POS_LE; REAL_LE_ADD]] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `lnorm s p (\x. (f:real^M->real^N) x + g x) rpow (p - &1)` THEN + ASM_SIMP_TAC[RPOW_POS_LT] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_POW_1] THEN + ASM_SIMP_TAC[GSYM RPOW_POW; GSYM RPOW_ADD] THEN + ASM_SIMP_TAC[LSPACE_ADD; LNORM_RPOW; REAL_ARITH `p - &1 + &1 = p`; + REAL_ARITH `&1 <= p ==> &0 <= p /\ ~(p = &0)`] THEN + CONV_TAC(LAND_CONV(SUBS_CONV[REAL_ARITH `p = &1 + (p - &1)`])) THEN + ASM_SIMP_TAC[RPOW_ADD_ALT; NORM_POS_LE; REAL_ARITH + `&1 <= p ==> &1 + p - &1 = &0 ==> p - &1 = &0`] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1] THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `p:real`; `p / (p - &1)`; + `\x. lift(norm((g:real^M->real^N) x))`; + `\x. lift(norm((f:real^M->real^N)(x) + g(x)) rpow (p - &1))`] + HOELDER_INEQUALITY_FULL) THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `p:real`; `p / (p - &1)`; + `\x. lift(norm((f:real^M->real^N) x))`; + `\x. lift(norm((f:real^M->real^N)(x) + g(x)) rpow (p - &1))`] + HOELDER_INEQUALITY_FULL) THEN + ASM_SIMP_TAC[LSPACE_NORM; REAL_LT_DIV; REAL_SUB_LT; + REAL_ARITH `&1 < p ==> &0 < p`; + REAL_FIELD `&1 < p ==> inv(p) + inv(p / (p - &1)) = &1`] THEN + MATCH_MP_TAC(TAUT + `p /\ (q ==> r ==> s) ==> (p ==> q) ==> (p ==> r) ==> s`) THEN + CONJ_TAC THENL + [SIMP_TAC[lspace; IN_ELIM_THM; NORM_LIFT; REAL_ABS_NORM; REAL_ABS_RPOW; + RPOW_RPOW; NORM_POS_LE] THEN + ASM_SIMP_TAC[REAL_FIELD `&1 < p ==> (p - &1) * p / (p - &1) = p`] THEN + ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; LSPACE_ADD; + REAL_ARITH `&1 < p ==> &0 <= p`] THEN + MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + SUBGOAL_THEN `((\x. f x + g x):real^M->real^N) IN lspace s p` MP_TAC THENL + [ASM_SIMP_TAC[LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`]; + SIMP_TAC[lspace; IN_ELIM_THM; MEASURABLE_ON_NORM]]; + ALL_TAC] THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LNORM_NORM; REAL_ABS_RPOW] THEN + MATCH_MP_TAC(TAUT + `(p1 /\ p2 ==> b1 /\ b2 ==> c) ==> p1 /\ b1 ==> p2 /\ b2 ==> c`) THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2) THEN + ASM_SIMP_TAC[GSYM DROP_ADD; GSYM INTEGRAL_ADD] THEN + SUBGOAL_THEN + `lnorm s (p / (p - &1)) (\x. lift(norm (f x + g x) rpow (p - &1))) = + lnorm s p (\x. (f:real^M->real^N) x + g x) rpow (p - &1)` + SUBST1_TAC THENL + [REWRITE_TAC[lnorm] THEN + ASM_SIMP_TAC[RPOW_RPOW; INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; + NORM_LIFT; REAL_ABS_NORM; REAL_ABS_RPOW] THEN + ASM_SIMP_TAC[REAL_FIELD `&1 < p ==> (p - &1) * p / (p - &1) = p`] THEN + REWRITE_TAC[REAL_INV_DIV] THEN REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC(GSYM RPOW_RPOW) THEN + MATCH_MP_TAC INTEGRAL_DROP_POS THEN + ASM_SIMP_TAC[LIFT_DROP; RPOW_POS_LE; NORM_POS_LE; LSPACE_IMP_INTEGRABLE; + LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `i2 <= i1 ==> i1 <= f * y + g * y ==> i2 <= y * (f + g)`) THEN + MATCH_MP_TAC INTEGRAL_DROP_LE_MEASURABLE THEN + ASM_SIMP_TAC[INTEGRABLE_ADD] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]] THEN + (SUBGOAL_THEN `((\x. f x + g x):real^M->real^N) IN lspace s p` MP_TAC THENL + [ASM_SIMP_TAC[LSPACE_ADD; REAL_ARITH `&1 < p ==> &0 <= p`]; + SIMP_TAC[lspace; IN_ELIM_THM; MEASURABLE_ON_NORM]]); + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; LIFT_DROP; DROP_ADD] THEN + SIMP_TAC[NORM_TRIANGLE; REAL_LE_RMUL; NORM_POS_LE; RPOW_POS_LE; + REAL_LE_MUL]]);; + +let VSUM_LNORM = prove + (`!s p f:A->real^M->real^N t. + &1 <= p /\ FINITE t /\ (!i. i IN t ==> (f i) IN lspace s p) + ==> lnorm s p (\x. vsum t (\i. f i x)) <= sum t (\i. lnorm s p (f i))`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; LNORM_0; REAL_LE_REFL; + REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN + MAP_EVERY X_GEN_TAC [`i:A`; `u:A->bool`] THEN + REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `a <= x + y ==> y <= z ==> a <= x + z`) THEN + W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN + ASM_SIMP_TAC[ETA_AX; LSPACE_VSUM; REAL_ARITH `&1 <= p ==> &0 < p`]);; + +(* ------------------------------------------------------------------------- *) +(* The main lemma for Riesz-Fischer, as in Royden's book. *) +(* ------------------------------------------------------------------------- *) + +let LSPACE_SUMMABLE_UNIV = prove + (`!f:num->real^M->real^N p s. + &1 <= p /\ + (!i. f i IN lspace s p) /\ + real_summable (:num) (\i. lnorm s p (f i)) + ==> ?g. g IN lspace s p /\ + !e. &0 < e ==> eventually + (\n. lnorm s p (\x. vsum (0..n) (\i. f i x) - + g(x)) < e) + sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_SUMS_INFSUM]) THEN + ABBREV_TAC `M = real_infsum (:num) (\i. lnorm s p (f i:real^M->real^N))` THEN + DISCH_TAC THEN + ABBREV_TAC + `g = \n x:real^M. vsum(0..n) (\i. lift(norm(f i x:real^N)))` THEN + SUBGOAL_THEN `!n:num. lnorm s p (g n:real^M->real^1) <= M` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "g" THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_LNORM o lhand o snd) THEN + ASM_SIMP_TAC[FINITE_NUMSEG; LSPACE_NORM; ETA_AX] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[LNORM_NORM] THEN EXPAND_TAC "M" THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SET_RULE `s = UNIV INTER s`] THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC REAL_PARTIAL_SUMS_LE_INFSUM THEN + ASM_SIMP_TAC[LNORM_POS_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. (g n:real^M->real^1) IN lspace s p` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC LSPACE_VSUM THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[FINITE_NUMSEG]] THEN + ASM_SIMP_TAC[LSPACE_NORM; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num x:real^M. &0 <= drop(g n x)` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN + SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; LIFT_DROP] THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\i:num x:real^M. lift(drop(g i x) rpow p)`; `s:real^M->bool`] + BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN + REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [MATCH_MP_TAC(TAUT `b /\ a /\ c ==> a /\ b /\ c`) THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN + SIMP_TAC[DROP_VSUM; FINITE_NUMSEG] THEN + MATCH_MP_TAC RPOW_LE2 THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE]; + SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_LE_ADDR] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; NORM_POS_LE]; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k x. drop((g:num->real^M->real^1) k x) = norm(g k x)` + (fun th -> REWRITE_TAC[th]) + THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + ASM_REWRITE_TAC[real_abs]; + ALL_TAC] THEN + ASM_SIMP_TAC[LSPACE_IMP_INTEGRABLE; ETA_AX] THEN + REWRITE_TAC[bounded] THEN EXISTS_TAC `M rpow p` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[INTEGRAL_LNORM_RPOW; ETA_AX; + REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW] THEN + MATCH_MP_TAC RPOW_LE2 THEN + ASM_SIMP_TAC[REAL_ARITH `&1 <= p ==> &0 <= p`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= a ==> &0 <= abs x /\ abs x <= a`) THEN + ASM_SIMP_TAC[LNORM_POS_LE]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`hp:real^M->real^1`; `k:real^M->bool`] THEN + STRIP_TAC THEN + ABBREV_TAC `h:real^M->real^1 = \x. lift(drop(hp x) rpow (inv p))` THEN + SUBGOAL_THEN + `!x. x IN s DIFF k ==> ((\i. g i x) --> ((h:real^M->real^1) x)) sequentially` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`lift o (\x. x rpow (inv p)) o drop`; + `sequentially`; `\i. lift(drop((g:num->real^M->real^1) i x) rpow p)`; + `(hp:real^M->real^1) x`] + LIM_CONTINUOUS_FUNCTION) THEN + ASM_SIMP_TAC[] THEN ANTS_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EXPAND_TAC "h" THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN + ASM_SIMP_TAC[RPOW_RPOW; REAL_MUL_RINV; + REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1; LIFT_DROP; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN s DIFF k ==> summable (:num) (\i. (f:num->real^M->real^N) i x)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_LIFT_ABSCONV_IMP_CONV THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `(h:real^M->real^1) x` THEN + REWRITE_TAC[sums; INTER_UNIV] THEN + RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^M->real^N` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!n x. x IN s DIFF k + ==> norm(vsum (0..n) (\i. (f:num->real^M->real^N) i x)) <= drop(h x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM LIFT_DROP] THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\n. vsum (0..n) + (\i. lift(norm((f:num->real^M->real^N) i x)))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_SIMP_TAC[IN_DIFF]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; o_DEF; LIFT_DROP] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; NORM_POS_LE; FINITE_NUMSEG] THEN + UNDISCH_TAC `n:num <= m` THEN ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN s DIFF k ==> norm((l:real^M->real^N) x) <= drop(h x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. vsum ((:num) INTER (0..n)) + (\i. (f:num->real^M->real^N) i x)` THEN + ASM_SIMP_TAC[IN_DIFF; GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[INTER_UNIV]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[lspace; IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN + EXISTS_TAC `\n x. vsum (0..n) (\i. (f:num->real^M->real^N) i x)` THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SET_RULE `0..n = UNIV INTER (0..n)`] THEN + ASM_REWRITE_TAC[GSYM sums] THEN GEN_TAC THEN + REWRITE_TAC[INTER_UNIV] THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG]; + DISCH_TAC] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC + `\x. if x IN k then lift(norm(l x:real^N) rpow p) + else (hp:real^M->real^1) x` THEN + ASM_SIMP_TAC[MEASURABLE_ON_LIFT_RPOW; MEASURABLE_ON_NORM; ETA_AX; + REAL_ARITH `&1 <= p ==> &0 < p`] THEN + CONJ_TAC THENL + [UNDISCH_TAC `(hp:real^M->real^1) integrable_on s` THEN + MATCH_MP_TAC INTEGRABLE_SPIKE THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]; + REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM] THEN + GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[LIFT_DROP; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(h(x:real^M)) rpow p` THEN CONJ_TAC THENL + [MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; IN_DIFF] THEN + ASM_REAL_ARITH_TAC; + EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH `x = y pow 1 ==> x <= y`) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `drop(hp(x:real^M)) rpow (inv p * p)` THEN CONJ_TAC THENL + [MATCH_MP_TAC RPOW_RPOW THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\k. lift(drop((g:num->real^M->real^1) k x) rpow p)` THEN + ASM_SIMP_TAC[IN_DIFF; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_SIMP_TAC[LIFT_DROP; RPOW_POS_LE; EVENTUALLY_TRUE]; + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN + REWRITE_TAC[RPOW_POW]]]]; + DISCH_TAC] THEN + SUBGOAL_THEN `!x:real^M. x IN s DIFF k ==> &0 <= drop(h x)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN `!x:real^M. x IN s DIFF k ==> &0 <= drop(hp x)` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\k. lift(drop((g:num->real^M->real^1) k x) rpow p)` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP; RPOW_POS_LE] THEN + REWRITE_TAC[EVENTUALLY_TRUE]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n x. lift(norm(vsum (0..n) (\i. (f:num->real^M->real^N) i x) - l x) + rpow p)`; + `(\x. vec 0):real^M->real^1`; + `\x:real^M. &2 rpow p % lift(drop(h x) rpow p)`; + `s DIFF k:real^M->bool`] + DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[lnorm; INTEGRAL_0; REAL_INTEGRAL_0; INTEGRABLE_0] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + MATCH_MP_TAC LSPACE_IMP_INTEGRABLE THEN + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LSPACE_VSUM THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN EXPAND_TAC "h" THEN + REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `hp:real^M->real^1` THEN + EXISTS_TAC `{}:real^M->bool` THEN + ASM_SIMP_TAC[DIFF_EMPTY; NEGLIGIBLE_EMPTY; RPOW_RPOW] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 <= p ==> ~(p = &0)`] THEN + REWRITE_TAC[LIFT_DROP; RPOW_POW; REAL_POW_1] THEN + UNDISCH_TAC `(hp:real^M->real^1) integrable_on s` THEN + MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + REWRITE_TAC[DROP_CMUL; GSYM RPOW_MUL; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + REWRITE_TAC[REAL_ABS_NORM; LIFT_DROP; REAL_ABS_RPOW] THEN + MATCH_MP_TAC RPOW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) <= a /\ norm(y) <= a ==> norm(x - y) <= &2 * a`) THEN + ASM_SIMP_TAC[]; + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC LIM_RPOW_NULL THEN + CONJ_TAC THENL [REWRITE_TAC[o_DEF]; ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[GSYM LIM_NULL_NORM] THEN REWRITE_TAC[GSYM LIM_NULL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[sums; INTER_UNIV]) THEN + ASM_SIMP_TAC[]]; + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) + [GSYM LIFT_DROP] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ; o_DEF] LIM_RPOW_NULL)) THEN + DISCH_THEN(MP_TAC o SPEC `inv p:real`) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[tendsto; DIST_0; NORM_REAL; GSYM drop; LIFT_DROP] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + SUBGOAL_THEN + `!f:real^M->real^1. integral (s DIFF k) f = integral s f` + MP_TAC THENL [ALL_TAC; SIMP_TAC[REAL_ARITH `abs(x) < e ==> x < e`]] THEN + GEN_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]);; + +let LSPACE_SUMMABLE = prove + (`!f:num->real^M->real^N p s t. + &1 <= p /\ + (!i. i IN t ==> f i IN lspace s p) /\ + real_summable t (\i. lnorm s p (f i)) + ==> ?g. g IN lspace s p /\ + ((\n. lnorm s p (\x. vsum (t INTER (0..n)) (\i. f i x) - g x)) + ---> &0) sequentially`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUMMABLE_RESTRICT] THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`(\n:num x. if n IN t then f n x else vec 0):num->real^M->real^N`; + `p:real`; `s:real^M->bool`] LSPACE_SUMMABLE_UNIV) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN + ASM_SIMP_TAC[LSPACE_0; ETA_AX; REAL_ARITH `&1 <= p ==> ~(p = &0)`]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_summable]) THEN + REWRITE_TAC[real_summable] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[ETA_AX; LNORM_0; REAL_ARITH `&1 <= p ==> ~(p = &0)`]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN + ASM_CASES_TAC `(g:real^M->real^N) IN lspace s p` THEN + ASM_REWRITE_TAC[tendsto_real] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x = y ==> x < e ==> abs y < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_SIMP_TAC[REAL_ARITH `&1 <= p ==> &0 <= p`] THEN + MATCH_MP_TAC LSPACE_VSUM THEN + ASM_SIMP_TAC[FINITE_NUMSEG; REAL_ARITH `&1 <= p ==> &0 < p`] THEN + X_GEN_TAC `i:num` THEN ASM_CASES_TAC `(i:num) IN t` THEN + ASM_SIMP_TAC[ETA_AX; LSPACE_0; REAL_ARITH `&1 <= p ==> ~(p = &0)`]; + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN + REWRITE_TAC[SET_RULE `s INTER t = {x | x IN t /\ x IN s}`]]]);; + +(* ------------------------------------------------------------------------- *) +(* Completeness (Riesz-Fischer). *) +(* ------------------------------------------------------------------------- *) + +let RIESZ_FISCHER = prove + (`!f:num->real^M->real^N p s. + &1 <= p /\ (!n. (f n) IN lspace s p) /\ + (!e. &0 < e + ==> ?N. !m n. m >= N /\ n >= N + ==> lnorm s p (\x. f m x - f n x) < e) + ==> ?g. g IN lspace s p /\ + !e. &0 < e + ==> ?N. !n. n >= N + ==> lnorm s p (\x. f n x - g x) < e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?k:num->num. + (!n. k n < k (SUC n)) /\ + (!n. lnorm s p ((\x. f (k(SUC n)) x - f (k n) x):real^M->real^N) + < inv(&2 pow n))` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num->num`) THEN + MP_TAC(prove_recursive_functions_exist num_RECURSION + `k 0 = N 0 /\ + !n. k(SUC n) = MAX (k n + 1) (MAX (N n) (N(SUC n)))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `n < MAX (n + 1) m`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ARITH_TAC; SPEC_TAC(`n:num`,`n:num`)] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n x. f (k(SUC n)) x - (f:num->real^M->real^N) (k n) x`; + `p:real`; `s:real^M->bool`] LSPACE_SUMMABLE_UNIV) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[LSPACE_SUB; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN + MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN + EXISTS_TAC `\n. inv(&2) pow n` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_SUMMABLE_GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[GSYM REAL_INV_POW] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < y ==> abs x <= y`) THEN + ASM_SIMP_TAC[LNORM_POS_LE; LSPACE_SUB; ETA_AX; + REAL_ARITH `&1 <= p ==> &0 <= p`]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + EXISTS_TAC `\x. (g:real^M->real^N) x + f (k 0:num) x` THEN + ASM_SIMP_TAC[LSPACE_ADD; ETA_AX; REAL_ARITH `&1 <= p ==> &0 <= p`] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY] THEN + REWRITE_TAC[ADD1; VSUM_DIFFS_ALT; LE_0] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "+")) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; GE] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[ARITH_RULE `MAX N1 N2 <= n <=> N1 <= n /\ N2 <= n`] THEN + STRIP_TAC THEN REMOVE_THEN "+" (MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k(n + 1):num`; `n:num`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n + 1` THEN + CONJ_TAC THENL [ASM_ARITH_TAC; SPEC_TAC(`n + 1`,`m:num`)] THEN + INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN + MATCH_MP_TAC(ARITH_RULE + `m <= k m /\ k m < k(SUC m) ==> SUC m <= k(SUC m)`) THEN + ASM_REWRITE_TAC[]; + REPEAT DISCH_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `f n x - (g x + f (k 0) x):real^N = + (f (k (n + 1)) x - f (k 0) x - g x) + + --(f (k (n + 1)) x - f n x)`] THEN + W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN + ASM_SIMP_TAC[LSPACE_SUB; LSPACE_NEG; ETA_AX; + REAL_ARITH `&1 <= p ==> &0 <= p`] THEN + MATCH_MP_TAC(REAL_ARITH + `x < e / &2 /\ y < e / &2 ==> z <= x + y ==> z < e`) THEN + ASM_SIMP_TAC[LNORM_NEG; LSPACE_SUB; ETA_AX; + REAL_ARITH `&1 <= p ==> &0 <= p`]]]);; + +(* ------------------------------------------------------------------------- *) +(* A sort of dominated convergence theorem for L_p spaces. *) +(* ------------------------------------------------------------------------- *) + +let LSPACE_DOMINATED_CONVERGENCE = prove + (`!f:num->real^M->real^N g h:real^M->real^N s p k. + &0 < p /\ + (!n. (f n) IN lspace s p) /\ h IN lspace s p /\ + (!n x. x IN s ==> norm(f n x) <= norm(h x)) /\ + negligible k /\ + (!x. x IN s DIFF k ==> ((\n. f n x) --> g(x)) sequentially) + ==> g IN lspace s p /\ + ((\n. lnorm s p (\x. f n x - g x)) ---> &0) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\n x. lift(norm((f:num->real^M->real^N) n x) rpow p)`; + `\x. lift(norm((g:real^M->real^N) x) rpow p)`; + `\x. lift(norm((h:real^M->real^N) x) rpow p)`; + `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE o SPEC `k:num`) THEN + MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN + MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `x:real^M`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM; LIFT_DROP] THEN + MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o ISPEC + `(lift o (\x. x rpow p) o drop) o (lift o (norm:real^N->real))` o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN + REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_AT_LIFT_NORM] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC]; + STRIP_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN + EXISTS_TAC `f:num->real^M->real^N` THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE + [TAUT `a ==> b ==> c <=> b ==> a ==> c`] INTEGRABLE_SPIKE_SET)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]; + DISCH_TAC] THEN + SUBGOAL_THEN + `!x. x IN s DIFF k + ==> norm((g:real^M->real^N) x) <= norm((h:real^M->real^N) x)` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. (f:num->real^M->real^N) n x` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n x. lift(norm((f:num->real^M->real^N) n x - g x) rpow p)`; + `(\x. vec 0):real^M->real^1`; + `\x. lift(norm(&2 % (h:real^M->real^N) x) rpow p)`; + `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + SUBGOAL_THEN `(\x. (f:num->real^M->real^N) k x - g x) IN lspace s p` + MP_TAC THENL + [ASM_SIMP_TAC[LSPACE_SUB; REAL_LT_IMP_LE; ETA_AX]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + REWRITE_TAC[NORM_MUL; RPOW_MUL; LIFT_CMUL] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN + UNDISCH_TAC `(h:real^M->real^N) IN lspace s p` THEN + DISCH_THEN(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN + MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `x:real^M`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_RPOW; REAL_ABS_NORM; LIFT_DROP] THEN + MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) <= norm(z) /\ norm(y) <= norm z + ==> norm(x - y) <= norm(&2 % z:real^N)`) THEN + ASM_SIMP_TAC[IN_DIFF]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + UNDISCH_TAC + `!x. x IN s DIFF k + ==> ((\n. (f:num->real^M->real^N) n x) --> g x) sequentially` THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [LIM_NULL] THEN + DISCH_THEN(MP_TAC o ISPEC + `(lift o (\x. x rpow p) o drop) o (lift o (norm:real^N->real))` o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN + ASM_SIMP_TAC[NORM_0; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_DROP; LIFT_NUM] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_AT_LIFT_NORM] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o CONJUNCT2)] THEN + REWRITE_TAC[INTEGRAL_0; TENDSTO_REAL; lnorm; o_DEF; LIFT_DROP; LIFT_NUM] THEN + DISCH_THEN(MP_TAC o ISPEC `lift o (\x. x rpow inv p) o drop` o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[o_THM; DROP_VEC; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM] THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_LT_IMP_NZ; LIFT_NUM] THEN ANTS_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Approximation of functions in L_p by bounded ones and continuous ones. *) +(* ------------------------------------------------------------------------- *) + +let LSPACE_APPROXIMATE_BOUNDED = prove + (`!f:real^M->real^N s p e. + &0 < p /\ measurable s /\ f IN lspace s p /\ &0 < e + ==> ?g. g IN lspace s p /\ + bounded (IMAGE g s) /\ + lnorm s p (\x. f x - g x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(\n x. (lambda i. max (--(&n)) (min (&n) ((f:real^M->real^N)(x)$i)))) + :num->real^M->real^N`; + `f:real^M->real^N`; + `f:real^M->real^N`; + `s:real^M->bool`; `p:real`; `{}:real^M->bool`] + LSPACE_DOMINATED_CONVERGENCE) THEN + ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + MATCH_MP_TAC(TAUT + `b /\ c /\ a /\ (a /\ d ==> e) + ==> (a /\ b /\ c ==> d) ==> e`) THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(ISPEC + `sup(IMAGE (\i. abs((f:real^M->real^N) x$i)) (1..dimindex(:N)))` + REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_NUMSEG; NUMSEG_EMPTY; + NOT_LT; DIMINDEX_GE_1; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG; CART_EQ; LAMBDA_BETA] THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= n ==> max (--n) (min n x) = x`) THEN + ASM_MESON_TAC[REAL_OF_NUM_LE; REAL_LE_TRANS]; + X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `p:real`; `vec n:real^N`] LSPACE_CONST) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(f:real^M->real^N) IN lspace s p` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LSPACE_MIN)) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `p:real`; `--vec n:real^N`] LSPACE_CONST) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] LSPACE_MAX)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(MESON[] `x = y ==> x IN s ==> y IN s`) THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; + VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL; REAL_SUB_RZERO] THEN DISCH_TAC THEN + EXISTS_TAC + `(\x. (lambda i. max (-- &n) (min (&n) ((f:real^M->real^N) x$i)))) + :real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN + EXISTS_TAC `&(dimindex(:N)) * &n` THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + GEN_REWRITE_TAC + (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LAMBDA_BETA] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `abs(x) < e ==> x < e`) THEN + ONCE_REWRITE_TAC[GSYM LNORM_NEG] THEN + ASM_REWRITE_TAC[VECTOR_NEG_SUB]]]);; + +let LSPACE_APPROXIMATE_CONTINUOUS = prove + (`!f:real^M->real^N s p e. + &1 <= p /\ measurable s /\ f IN lspace s p /\ &0 < e + ==> ?g. g continuous_on (:real^M) /\ + g IN lspace s p /\ + lnorm s p (\x. f x - g x) < e`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 <= p ==> &0 < p`)) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `p:real`; `e / &2`] + LSPACE_APPROXIMATE_BOUNDED) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?k g. negligible k /\ + (!n. g n continuous_on (:real^M)) /\ + (!n x. x IN s ==> norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\ + (!x. x IN (s DIFF k) ==> ((\n. g n x) --> h x) sequentially)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))): + num->real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`] + CONTINUOUS_ON_CONST) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN + MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`] + CONTINUOUS_ON_CONST) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(c - a:real^N) <= norm(b - a) + ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. ((g:num->real^M->real^N) n) IN lspace s p` ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN + MATCH_MP_TAC LSPACE_BOUNDED_MEASURABLE THEN + EXISTS_TAC `(\x. B % vec 1):real^M->real^N` THEN + ASM_SIMP_TAC[LSPACE_CONST] THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator] + MEASURABLE_ON_RESTRICT) THEN + ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g:num->real^M->real^N`; `h:real^M->real^N`; + `(\x. B % vec 1):real^M->real^N`; + `s:real^M->bool`; `p:real`; `k:real^M->bool`] + LSPACE_DOMINATED_CONVERGENCE) THEN + ASM_SIMP_TAC[LSPACE_CONST] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN + EXISTS_TAC `(g:num->real^M->real^N) n` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x. f x - (g:num->real^M->real^N) n x) = + (\x. (f x - h x) + --(g n x - h x))` + SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) LNORM_TRIANGLE o lhand o snd) THEN + ASM_SIMP_TAC[LSPACE_SUB; ETA_AX; REAL_LT_IMP_LE; LSPACE_NEG] THEN + MATCH_MP_TAC(REAL_ARITH + `y < e / &2 /\ z < e / &2 ==> x <= y + z ==> x < e`) THEN + ASM_SIMP_TAC[LNORM_NEG; REAL_ARITH `abs x < e ==> x < e`]);; + +(* ------------------------------------------------------------------------- *) +(* Square-integrable real->real functions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("square_integrable_on",(12,"right"));; + +let square_integrable_on = new_definition + `f square_integrable_on s <=> + f real_measurable_on s /\ (\x. f(x) pow 2) real_integrable_on s`;; + +let SQUARE_INTEGRABLE_IMP_MEASURABLE = prove + (`!f s. f square_integrable_on s ==> f real_measurable_on s`, + SIMP_TAC[square_integrable_on]);; + +let SQUARE_INTEGRABLE_LSPACE = prove + (`!f s. f square_integrable_on s <=> + (lift o f o drop) IN lspace (IMAGE lift s) (&2)`, + REWRITE_TAC[square_integrable_on; lspace; IN_ELIM_THM] THEN + REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; RPOW_POW] THEN + REWRITE_TAC[o_THM; NORM_REAL; GSYM drop; LIFT_DROP] THEN + REWRITE_TAC[REAL_POW2_ABS; o_DEF]);; + +let SQUARE_INTEGRABLE_0 = prove + (`!s. (\x. &0) square_integrable_on s`, + REWRITE_TAC[square_integrable_on; REAL_MEASURABLE_ON_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_INTEGRABLE_0]);; + +let SQUARE_INTEGRABLE_NEG_EQ = prove + (`!f s. (\x. --(f x)) square_integrable_on s <=> f square_integrable_on s`, + REWRITE_TAC[square_integrable_on; REAL_MEASURABLE_ON_NEG_EQ; + REAL_POW_NEG; ARITH]);; + +let SQUARE_INTEGRABLE_NEG = prove + (`!f s. f square_integrable_on s ==> (\x. --(f x)) square_integrable_on s`, + REWRITE_TAC[SQUARE_INTEGRABLE_NEG_EQ]);; + +let SQUARE_INTEGRABLE_LMUL = prove + (`!f s c. f square_integrable_on s ==> (\x. c * f(x)) square_integrable_on s`, + SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_LMUL] THEN + SIMP_TAC[REAL_POW_MUL; REAL_INTEGRABLE_LMUL]);; + +let SQUARE_INTEGRABLE_RMUL = prove + (`!f s c. f square_integrable_on s ==> (\x. f(x) * c) square_integrable_on s`, + SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_RMUL] THEN + SIMP_TAC[REAL_POW_MUL; REAL_INTEGRABLE_RMUL]);; + +let SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_PRODUCT = prove + (`!f g s. f square_integrable_on s /\ g square_integrable_on s + ==> (\x. f(x) * g(x)) absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE] THEN + ASM_SIMP_TAC[REAL_MEASURABLE_ON_MUL; SQUARE_INTEGRABLE_IMP_MEASURABLE] THEN + MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `&2`; + `lift o f o drop`; `lift o g o drop`] + LSPACE_INTEGRABLE_PRODUCT) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[o_DEF; NORM_REAL; GSYM drop; LIFT_DROP; REAL_ABS_MUL]);; + +let SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT = prove + (`!f g s. f square_integrable_on s /\ g square_integrable_on s + ==> (\x. f(x) * g(x)) real_integrable_on s`, + SIMP_TAC[SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_PRODUCT; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; + +let SQUARE_INTEGRABLE_ADD = prove + (`!f g s. f square_integrable_on s /\ g square_integrable_on s + ==> (\x. f(x) + g(x)) square_integrable_on s`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_ADD; + SQUARE_INTEGRABLE_IMP_MEASURABLE] THEN + SIMP_TAC[REAL_ARITH `(x + y) pow 2 = (x pow 2 + y pow 2) + &2 * x * y`] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT; + REAL_INTEGRABLE_LMUL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[square_integrable_on]) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ADD]);; + +let SQUARE_INTEGRABLE_SUB = prove + (`!f g s. f square_integrable_on s /\ g square_integrable_on s + ==> (\x. f(x) - g(x)) square_integrable_on s`, + SIMP_TAC[real_sub; SQUARE_INTEGRABLE_ADD; SQUARE_INTEGRABLE_NEG_EQ]);; + +let SQUARE_INTEGRABLE_ABS = prove + (`!f g s. f square_integrable_on s ==> (\x. abs(f x)) square_integrable_on s`, + SIMP_TAC[square_integrable_on; REAL_MEASURABLE_ON_ABS; REAL_POW2_ABS]);; + +let SQUARE_INTEGRABLE_SUM = prove + (`!f s t. FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) + ==> (\x. sum t (\i. f i x)) square_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SQUARE_INTEGRABLE_0; IN_INSERT; SQUARE_INTEGRABLE_ADD; ETA_AX; + SUM_CLAUSES]);; + +let REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE = prove + (`!f a b. f real_continuous_on real_interval[a,b] + ==> f square_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[square_integrable_on] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN ASM_REWRITE_TAC[]]);; + +let SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove + (`!f s. f square_integrable_on s /\ real_measurable s + ==> f absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[GSYM LSPACE_1] THEN + MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `&2` THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE; + GSYM SQUARE_INTEGRABLE_LSPACE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let SQUARE_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f s. f square_integrable_on s /\ real_measurable s + ==> f real_integrable_on s`, + SIMP_TAC[SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; + +(* ------------------------------------------------------------------------- *) +(* The norm and inner product in L2. *) +(* ------------------------------------------------------------------------- *) + +let l2product = new_definition + `l2product s f g = real_integral s (\x. f(x) * g(x))`;; + +let l2norm = new_definition + `l2norm s f = sqrt(l2product s f f)`;; + +let L2NORM_LNORM = prove + (`!f s. f square_integrable_on s + ==> l2norm s f = lnorm (IMAGE lift s) (&2) (lift o f o drop)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[l2norm; lnorm; l2product] THEN + RULE_ASSUM_TAC(REWRITE_RULE[square_integrable_on]) THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; REAL_INTEGRAL] THEN + REWRITE_TAC[NORM_REAL; o_DEF; GSYM drop; LIFT_DROP; RPOW_POW] THEN + REWRITE_TAC[REAL_POW2_ABS] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(GSYM RPOW_SQRT) THEN + MATCH_MP_TAC INTEGRAL_DROP_POS THEN + REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; REAL_LE_POW_2] THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[REAL_INTEGRABLE_ON] o CONJUNCT2) THEN + REWRITE_TAC[o_DEF]);; + +let L2PRODUCT_SYM = prove + (`!s f g. l2product s f g = l2product s g f`, + REWRITE_TAC[l2product; REAL_MUL_SYM]);; + +let L2PRODUCT_POS_LE = prove + (`!s f. f square_integrable_on s ==> &0 <= l2product s f f`, + REWRITE_TAC[square_integrable_on; l2product] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[REAL_LE_SQUARE] THEN ASM_REWRITE_TAC[GSYM REAL_POW_2]);; + +let L2NORM_POW_2 = prove + (`!s f. f square_integrable_on s ==> (l2norm s f) pow 2 = l2product s f f`, + SIMP_TAC[l2norm; SQRT_POW_2; L2PRODUCT_POS_LE]);; + +let L2NORM_POS_LE = prove + (`!s f. f square_integrable_on s ==> &0 <= l2norm s f`, + SIMP_TAC[l2norm; SQRT_POS_LE; L2PRODUCT_POS_LE]);; + +let L2NORM_LE = prove + (`!s f g. f square_integrable_on s /\ g square_integrable_on s + ==> (l2norm s f <= l2norm s g <=> + l2product s f f <= l2product s g g)`, + SIMP_TAC[SQRT_MONO_LE_EQ; l2norm; SQRT_MONO_LE_EQ; L2PRODUCT_POS_LE]);; + +let L2NORM_EQ = prove + (`!s f g. f square_integrable_on s /\ g square_integrable_on s + ==> (l2norm s f = l2norm s g <=> + l2product s f f = l2product s g g)`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; L2NORM_LE]);; + +let SCHWARTZ_INEQUALITY_STRONG = prove + (`!f g s. f square_integrable_on s /\ + g square_integrable_on s + ==> l2product s (\x. abs(f x)) (\x. abs(g x)) + <= l2norm s f * l2norm s g`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE lift s`; `&2`; `&2`; + `lift o f o drop`; `lift o g o drop`] HOELDER_INEQUALITY) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; GSYM L2NORM_LNORM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + REWRITE_TAC[l2product] THEN + ASM_SIMP_TAC[REAL_INTEGRAL; SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT; + SQUARE_INTEGRABLE_ABS] THEN + REWRITE_TAC[NORM_REAL; o_DEF; GSYM drop; LIFT_DROP; REAL_LE_REFL]);; + +let SCHWARTZ_INEQUALITY_ABS = prove + (`!f g s. f square_integrable_on s /\ + g square_integrable_on s + ==> abs(l2product s f g) <= l2norm s f * l2norm s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `l2product s (\x. abs(f x)) (\x. abs(g x))` THEN + ASM_SIMP_TAC[SCHWARTZ_INEQUALITY_STRONG] THEN REWRITE_TAC[l2product] THEN + MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT; + SQUARE_INTEGRABLE_ABS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_LE_REFL]);; + +let SCHWARTZ_INEQUALITY = prove + (`!f g s. f square_integrable_on s /\ + g square_integrable_on s + ==> l2product s f g <= l2norm s f * l2norm s g`, + MESON_TAC[SCHWARTZ_INEQUALITY_ABS; + REAL_ARITH `abs x <= a ==> x <= a`]);; + +let L2NORM_TRIANGLE = prove + (`!f g s. f square_integrable_on s /\ + g square_integrable_on s + ==> l2norm s (\x. f x + g x) <= l2norm s f + l2norm s g`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE lift s`; `&2`; + `lift o f o drop`; `lift o g o drop`] LNORM_TRIANGLE) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; L2NORM_LNORM; + SQUARE_INTEGRABLE_ADD] THEN + REWRITE_TAC[o_DEF; LIFT_ADD]);; + +let L2PRODUCT_LADD = prove + (`!s f g h. + f square_integrable_on s /\ + g square_integrable_on s /\ + h square_integrable_on s + ==> l2product s (\x. f x + g x) h = + l2product s f h + l2product s g h`, + SIMP_TAC[l2product; REAL_ADD_RDISTRIB; REAL_INTEGRAL_ADD; + SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; + +let L2PRODUCT_RADD = prove + (`!s f g h. + f square_integrable_on s /\ + g square_integrable_on s /\ + h square_integrable_on s + ==> l2product s f (\x. g x + h x) = + l2product s f g + l2product s f h`, + SIMP_TAC[l2product; REAL_ADD_LDISTRIB; REAL_INTEGRAL_ADD; + SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; + +let L2PRODUCT_LSUB = prove + (`!s f g h. + f square_integrable_on s /\ + g square_integrable_on s /\ + h square_integrable_on s + ==> l2product s (\x. f x - g x) h = + l2product s f h - l2product s g h`, + SIMP_TAC[l2product; REAL_SUB_RDISTRIB; REAL_INTEGRAL_SUB; + SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; + +let L2PRODUCT_RSUB = prove + (`!s f g h. + f square_integrable_on s /\ + g square_integrable_on s /\ + h square_integrable_on s + ==> l2product s f (\x. g x - h x) = + l2product s f g - l2product s f h`, + SIMP_TAC[l2product; REAL_SUB_LDISTRIB; REAL_INTEGRAL_SUB; + SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; + +let L2PRODUCT_LZERO = prove + (`!s f. l2product s (\x. &0) f = &0`, + REWRITE_TAC[l2product; REAL_MUL_LZERO; REAL_INTEGRAL_0]);; + +let L2PRODUCT_RZERO = prove + (`!s f. l2product s f (\x. &0) = &0`, + REWRITE_TAC[l2product; REAL_MUL_RZERO; REAL_INTEGRAL_0]);; + +let L2PRODUCT_LSUM = prove + (`!s f g t. + FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) /\ + g square_integrable_on s + ==> l2product s (\x. sum t (\i. f i x)) g = + sum t (\i. l2product s (f i) g)`, + REPLICATE_TAC 3 GEN_TAC THEN + ASM_CASES_TAC `g square_integrable_on s` THEN ASM_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[L2PRODUCT_LZERO; SUM_CLAUSES; L2PRODUCT_LADD; + SQUARE_INTEGRABLE_SUM; ETA_AX; IN_INSERT]);; + +let L2PRODUCT_RSUM = prove + (`!s f g t. + FINITE t /\ (!i. i IN t ==> (f i) square_integrable_on s) /\ + g square_integrable_on s + ==> l2product s g (\x. sum t (\i. f i x)) = + sum t (\i. l2product s g (f i))`, + ONCE_REWRITE_TAC[L2PRODUCT_SYM] THEN REWRITE_TAC[L2PRODUCT_LSUM]);; + +let L2PRODUCT_LMUL = prove + (`!s c f g. + f square_integrable_on s /\ g square_integrable_on s + ==> l2product s (\x. c * f x) g = c * l2product s f g`, + SIMP_TAC[l2product; GSYM REAL_MUL_ASSOC; REAL_INTEGRAL_LMUL; + SQUARE_INTEGRABLE_IMP_INTEGRABLE_PRODUCT]);; + +let L2PRODUCT_RMUL = prove + (`!s c f g. + f square_integrable_on s /\ g square_integrable_on s + ==> l2product s f (\x. c * g x) = c * l2product s f g`, + ONCE_REWRITE_TAC[L2PRODUCT_SYM] THEN SIMP_TAC[L2PRODUCT_LMUL]);; + +let L2NORM_LMUL = prove + (`!f s c. f square_integrable_on s + ==> l2norm s (\x. c * f(x)) = abs(c) * l2norm s f`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[l2norm; L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL] THEN + ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_2] THEN + REWRITE_TAC[SQRT_MUL; POW_2_SQRT_ABS]);; + +let L2NORM_RMUL = prove + (`!f s c. f square_integrable_on s + ==> l2norm s (\x. f(x) * c) = l2norm s f * abs(c)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[L2NORM_LMUL]);; + +let L2NORM_NEG = prove + (`!f s. f square_integrable_on s ==> l2norm s (\x. --(f x)) = l2norm s f`, + ONCE_REWRITE_TAC[REAL_ARITH `--x:real = --(&1) * x`] THEN + SIMP_TAC[L2NORM_LMUL; REAL_ABS_NEG; REAL_ABS_NUM; REAL_MUL_LID]);; + +let L2NORM_SUB = prove + (`!f g s. f square_integrable_on s /\ g square_integrable_on s + ==> l2norm s (\x. f x - g x) = l2norm s (\x. g x - f x)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_NEG_SUB] THEN + ASM_SIMP_TAC[L2NORM_NEG; SQUARE_INTEGRABLE_SUB; ETA_AX]);; + +let L2_SUMMABLE = prove + (`!f s t. + (!i. i IN t ==> (f i) square_integrable_on s) /\ + real_summable t (\i. l2norm s (f i)) + ==> ?g. g square_integrable_on s /\ + ((\n. l2norm s (\x. sum (t INTER (0..n)) (\i. f i x) - g x)) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. (lift o f n o drop)`; + `&2`; `IMAGE lift s`; `t:num->bool`] + LSPACE_SUMMABLE) THEN + ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL + [UNDISCH_TAC `real_summable t (\i. l2norm s (f i))` THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[real_summable; real_sums; REALLIM_SEQUENTIALLY] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `e:real` THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `N:num` THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN + ASM_SIMP_TAC[GSYM L2NORM_LNORM; IN_INTER; ETA_AX]; + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` MP_TAC) THEN + SUBGOAL_THEN `g = (lift o (drop o g o lift) o drop)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN + ABBREV_TAC `h = drop o g o lift` THEN + REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN + DISCH_THEN(fun th -> EXISTS_TAC `h:real->real` THEN MP_TAC th) THEN + ASM_CASES_TAC `h square_integrable_on s` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[o_DEF; GSYM LIFT_SUB; REWRITE_RULE[o_DEF] (GSYM LIFT_SUM); + FINITE_NUMSEG; FINITE_INTER] THEN + SUBGOAL_THEN `!f. (\x. lift(f(drop x))) = (lift o f o drop)` + (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(GSYM L2NORM_LNORM) THEN + MATCH_MP_TAC SQUARE_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN + ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);; + +let L2_COMPLETE = prove + (`!f s. (!i. f i square_integrable_on s) /\ + (!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N + ==> l2norm s (\x. f m x - f n x) < e) + ==> ?g. g square_integrable_on s /\ + ((\n. l2norm s (\x. f n x - g x)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. lift o f n o drop`; `&2`; `IMAGE lift s`] + RIESZ_FISCHER) THEN + ASM_SIMP_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN ANTS_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` MP_TAC) THEN + SUBGOAL_THEN `g = (lift o (drop o g o lift) o drop)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN + ABBREV_TAC `h = drop o g o lift` THEN + REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE] THEN + DISCH_THEN(fun th -> EXISTS_TAC `h:real->real` THEN MP_TAC th) THEN + ASM_CASES_TAC `h square_integrable_on s` THEN ASM_REWRITE_TAC[]] THEN + (SUBGOAL_THEN `!f g. (\x. (lift o f o drop) x - (lift o g o drop) x) = + (lift o (\y. f y - g y) o drop)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB]; + ASM_SIMP_TAC[GSYM L2NORM_LNORM; SQUARE_INTEGRABLE_SUB; ETA_AX]]) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> abs(x - &0) = x`; GE; + L2NORM_POS_LE; SQUARE_INTEGRABLE_SUB; ETA_AX]);; + +let SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove + (`!f s e. real_measurable s /\ f square_integrable_on s /\ &0 < e + ==> ?g. g real_continuous_on (:real) /\ + g square_integrable_on s /\ + l2norm s (\x. f x - g x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `&2:real`; `e:real`] + LSPACE_APPROXIMATE_CONTINUOUS) THEN + ASM_REWRITE_TAC[GSYM SQUARE_INTEGRABLE_LSPACE; REAL_OF_NUM_LE; ARITH; + GSYM REAL_MEASURABLE_MEASURABLE] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `drop o g o lift` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_DROP; ETA_AX; + IMAGE_LIFT_UNIV]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[SQUARE_INTEGRABLE_LSPACE; o_DEF; LIFT_DROP; ETA_AX]; + DISCH_TAC THEN + ASM_SIMP_TAC[L2NORM_LNORM; SQUARE_INTEGRABLE_SUB; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> x = y ==> y < e`)) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB]]);; + +(* ------------------------------------------------------------------------- *) +(* Orthonormal system of L2 functions and their Fourier coefficients. *) +(* ------------------------------------------------------------------------- *) + +let orthonormal_system = new_definition + `orthonormal_system s w <=> + !m n. l2product s (w m) (w n) = if m = n then &1 else &0`;; + +let orthonormal_coefficient = new_definition + `orthonormal_coefficient s w f (n:num) = l2product s (w n) f`;; + +let ORTHONORMAL_SYSTEM_L2NORM = prove + (`!s w. orthonormal_system s w ==> !i. l2norm s (w i) = &1`, + SIMP_TAC[orthonormal_system; l2norm; SQRT_1]);; + +let ORTHONORMAL_PARTIAL_SUM_DIFF = prove + (`!s w a f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s /\ FINITE t + ==> l2norm s (\x. f(x) - sum t (\i. a i * w i x)) pow 2 = + (l2norm s f) pow 2 + sum t (\i. (a i) pow 2) - + &2 * sum t (\i. a i * orthonormal_coefficient s w f i)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. sum t (\i:num. a i * w i x)) square_integrable_on s` + ASSUME_TAC THENL + [ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; ETA_AX; FINITE_NUMSEG; + SQUARE_INTEGRABLE_LMUL]; + ALL_TAC] THEN + ASM_SIMP_TAC[L2NORM_POW_2; SQUARE_INTEGRABLE_SUB; ETA_AX; L2PRODUCT_LSUB] THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; ETA_AX; L2PRODUCT_RSUB] THEN + MATCH_MP_TAC(REAL_ARITH + `x' = x /\ b - &2 * x = c ==> a - x - (x' - b) = a + c`) THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[L2PRODUCT_SYM]; ALL_TAC] THEN + ASM_SIMP_TAC[L2PRODUCT_RSUM; ETA_AX; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; + SQUARE_INTEGRABLE_SUM] THEN + ASM_SIMP_TAC[L2PRODUCT_LSUM; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; + ETA_AX] THEN + ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + ASM_SIMP_TAC[L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN + ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA] THEN + REWRITE_TAC[orthonormal_coefficient; REAL_MUL_RID; GSYM REAL_POW_2] THEN + REWRITE_TAC[L2PRODUCT_SYM]);; + +let ORTHONORMAL_OPTIMAL_PARTIAL_SUM = prove + (`!s w a f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s /\ FINITE t + ==> l2norm s (\x. f(x) - + sum t (\i. orthonormal_coefficient s w f i * w i x)) + <= l2norm s (\x. f(x) - sum t (\i. a i * w i x))`, + REPEAT STRIP_TAC THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [L2NORM_LE; SQUARE_INTEGRABLE_SUM; ETA_AX; FINITE_NUMSEG; + GSYM L2NORM_POW_2; SQUARE_INTEGRABLE_LMUL; SQUARE_INTEGRABLE_SUB] THEN + ASM_SIMP_TAC[ORTHONORMAL_PARTIAL_SUM_DIFF] THEN + REWRITE_TAC[REAL_LE_LADD] THEN + ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_SUB] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH + `b pow 2 - &2 * b * b <= a pow 2 - &2 * a * b <=> &0 <= (a - b) pow 2`] THEN + REWRITE_TAC[REAL_LE_POW_2]);; + +let BESSEL_INEQUALITY = prove + (`!s w f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s /\ FINITE t + ==> sum t (\i. (orthonormal_coefficient s w f i) pow 2) + <= l2norm s f pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_PARTIAL_SUM_DIFF) THEN + DISCH_THEN(MP_TAC o SPEC `orthonormal_coefficient s w f`) THEN + REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a + b - &2 * b = a - b`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= p ==> p = x - y ==> y <= x`) THEN + REWRITE_TAC[REAL_LE_POW_2]);; + +let FOURIER_SERIES_SQUARE_SUMMABLE = prove + (`!s w f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s + ==> real_summable t (\i. (orthonormal_coefficient s w f i) pow 2)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[real_summable; real_sums; REALLIM_SEQUENTIALLY] THEN + MP_TAC(ISPECL + [`\n. sum(t INTER (0..n)) (\i. (orthonormal_coefficient s w f i) pow 2)`; + `l2norm s f pow 2`] CONVERGENT_BOUNDED_MONOTONE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`s:real->bool`; `w:num->real->real`; + `f:real->real`; `t INTER (0..n)`] BESSEL_INEQUALITY) THEN + ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= y`) THEN + SIMP_TAC[SUM_POS_LE; FINITE_INTER; FINITE_NUMSEG; REAL_LE_POW_2] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[FINITE_INTER; SUBSET_REFL; FINITE_NUMSEG; REAL_LE_POW_2]; + DISJ1_TAC THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[INTER_SUBSET; FINITE_NUMSEG; REAL_LE_POW_2; FINITE_INTER] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u INTER s SUBSET u INTER t`) THEN + REWRITE_TAC[SUBSET_NUMSEG] THEN ASM_ARITH_TAC]);; + +let ORTHONORMAL_FOURIER_PARTIAL_SUM_DIFF_SQUARED = prove + (`!s w a f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s /\ FINITE t + ==> l2norm s (\x. f x - + sum t (\i. orthonormal_coefficient s w f i * w i x)) + pow 2 = + l2norm s f pow 2 - sum t (\i. orthonormal_coefficient s w f i pow 2)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_PARTIAL_SUM_DIFF) THEN + DISCH_THEN(MP_TAC o SPEC `orthonormal_coefficient s w f`) THEN + REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH `a + b - &2 * b = a - b`]);; + +let FOURIER_SERIES_L2_SUMMABLE = prove + (`!s w f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s + ==> ?g. g square_integrable_on s /\ + ((\n. l2norm s + (\x. sum (t INTER (0..n)) + (\i. orthonormal_coefficient s w f i * w i x) - + g(x))) ---> &0) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC L2_COMPLETE THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; + SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `t:num->bool` o + MATCH_MP FOURIER_SERIES_SQUARE_SUMMABLE) THEN + REWRITE_TAC[REAL_SUMMABLE; summable; sums; CONVERGENT_EQ_CAUCHY] THEN + REWRITE_TAC[cauchy; GE] THEN + DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN + ASM_SIMP_TAC[REAL_POW_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC WLOG_LE THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THENL + [ASM_CASES_TAC `N:num <= m` THEN ASM_CASES_TAC `N:num <= n` THEN + ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC L2NORM_SUB THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUM; FINITE_INTER; FINITE_NUMSEG; + SQUARE_INTEGRABLE_LMUL; ETA_AX]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN EXISTS_TAC `2` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `m:num`]) THEN + SIMP_TAC[DIST_REAL; GSYM drop; DROP_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN + SUBGOAL_THEN + `!f. sum (t INTER (0..n)) f - sum (t INTER (0..m)) f = + sum (t INTER (m+1..n)) f` + (fun th -> REWRITE_TAC[th]) + THENL + [X_GEN_TAC `h:num->real` THEN + REWRITE_TAC[REAL_ARITH `a - b:real = c <=> b + c = a`] THEN + MATCH_MP_TAC SUM_UNION_EQ THEN + SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; EXTENSION; IN_INTER; NOT_IN_EMPTY; + IN_UNION; IN_NUMSEG] THEN + CONJ_TAC THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `(i:num) IN t` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN + ASM_SIMP_TAC[L2NORM_POW_2; SQUARE_INTEGRABLE_SUM; FINITE_INTER; + FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + ASM_SIMP_TAC[L2PRODUCT_RSUM; ETA_AX; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; + FINITE_INTER; SQUARE_INTEGRABLE_SUM] THEN + ASM_SIMP_TAC[L2PRODUCT_LSUM; SQUARE_INTEGRABLE_LMUL; FINITE_NUMSEG; + FINITE_INTER; ETA_AX] THEN + ASM_SIMP_TAC[L2PRODUCT_RMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + ASM_SIMP_TAC[L2PRODUCT_LMUL; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN + ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_POW_2; REAL_ARITH `x <= abs x`]);; + +let FOURIER_SERIES_L2_SUMMABLE_STRONG = prove + (`!s w f t. + orthonormal_system s w /\ (!i. (w i) square_integrable_on s) /\ + f square_integrable_on s + ==> ?g. g square_integrable_on s /\ + (!i. i IN t + ==> orthonormal_coefficient s w (\x. f x - g x) i = &0) /\ + ((\n. l2norm s + (\x. sum (t INTER (0..n)) + (\i. orthonormal_coefficient s w f i * w i x) - + g(x))) ---> &0) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `t:num->bool` o + MATCH_MP FOURIER_SERIES_L2_SUMMABLE) THEN + REWRITE_TAC[orthonormal_coefficient] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[orthonormal_coefficient] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC + `\n. l2product s (w i) + (\x. (f x - sum (t INTER (0..n)) (\i. l2product s (w i) f * w i x)) + + (sum (t INTER (0..n)) (\i. l2product s (w i) f * w i x) - g x))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_EVENTUALLY THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN GEN_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [L2PRODUCT_RADD; SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_SUM; + FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `i:num` THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[L2PRODUCT_RSUB; SQUARE_INTEGRABLE_SUM; L2PRODUCT_RSUM; + FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + ASM_SIMP_TAC[L2PRODUCT_RMUL; ETA_AX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthonormal_system]) THEN + ASM_SIMP_TAC[COND_RAND; REAL_MUL_RZERO] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[SUM_DELTA; IN_INTER; IN_NUMSEG; LE_0; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_SUB_REFL]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] REALLIM_NULL_COMPARISON)) THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SCHWARTZ_INEQUALITY_ABS o + lhand o snd) THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_SUM; + FINITE_INTER; FINITE_NUMSEG; SQUARE_INTEGRABLE_LMUL; ETA_AX] THEN + ASM_SIMP_TAC[ORTHONORMAL_SYSTEM_L2NORM; REAL_MUL_LID]]);; + +(* ------------------------------------------------------------------------- *) +(* Actual trigonometric orthogonality relations. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INTEGRABLE_ON_INTERVAL_TAC = + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC;; + +let HAS_REAL_INTEGRAL_SIN_NX = prove + (`!n. ((\x. sin(&n * x)) has_real_integral &0) (real_interval[--pi,pi])`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0; REAL_MUL_LZERO; SIN_0] THEN + MP_TAC(ISPECL + [`\x. --(inv(&n) * cos(&n * x))`; `\x. sin(&n * x)`; `--pi`; `pi`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + SIMP_TAC[REAL_ARITH `&0 <= pi ==> --pi <= pi`; PI_POS_LE] THEN + REWRITE_TAC[REAL_MUL_RNEG; SIN_NPI; COS_NPI; SIN_NEG; COS_NEG] THEN + REWRITE_TAC[REAL_SUB_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REAL_DIFF_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN + CONV_TAC REAL_FIELD);; + +let REAL_INTEGRABLE_SIN_CX = prove + (`!c. (\x. sin(c * x)) real_integrable_on real_interval[--pi,pi]`, + GEN_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);; + +let REAL_INTEGRAL_SIN_NX = prove + (`!n. real_integral (real_interval[--pi,pi]) (\x. sin(&n * x)) = &0`, + GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_SIN_NX]);; + +let HAS_REAL_INTEGRAL_COS_NX = prove + (`!n. ((\x. cos(&n * x)) has_real_integral (if n = 0 then &2 * pi else &0)) + (real_interval[--pi,pi])`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[COS_0; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `&2 * pi = &1 * (pi - --pi)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MP_TAC(ISPECL + [`\x. inv(&n) * sin(&n * x)`; `\x. cos(&n * x)`; `--pi`; `pi`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + SIMP_TAC[REAL_ARITH `&0 <= pi ==> --pi <= pi`; PI_POS_LE] THEN + REWRITE_TAC[REAL_MUL_RNEG; SIN_NPI; COS_NPI; SIN_NEG; COS_NEG] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_SUB_REFL] THEN + DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REAL_DIFF_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM REAL_OF_NUM_EQ]) THEN + CONV_TAC REAL_FIELD]);; + +let REAL_INTEGRABLE_COS_CX = prove + (`!c. (\x. cos(c * x)) real_integrable_on real_interval[--pi,pi]`, + GEN_TAC THEN REAL_INTEGRABLE_ON_INTERVAL_TAC);; + +let REAL_INTEGRAL_COS_NX = prove + (`!n. real_integral (real_interval[--pi,pi]) (\x. cos(&n * x)) = + if n = 0 then &2 * pi else &0`, + GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_COS_NX]);; + +let REAL_INTEGRAL_SIN_AND_COS = prove + (`!m n. real_integral (real_interval[--pi,pi]) + (\x. cos(&m * x) * cos(&n * x)) = + (if m = n then if n = 0 then &2 * pi else pi else &0) /\ + real_integral (real_interval[--pi,pi]) + (\x. cos(&m * x) * sin(&n * x)) = &0 /\ + real_integral (real_interval[--pi,pi]) + (\x. sin(&m * x) * cos(&n * x)) = &0 /\ + real_integral (real_interval[--pi,pi]) + (\x. sin(&m * x) * sin(&n * x)) = + (if m = n /\ ~(n = 0) then pi else &0)`, + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_SYM] THEN MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `m:num`] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_MUL_SIN_COS; REAL_MUL_COS_SIN; + REAL_MUL_COS_COS; REAL_MUL_SIN_SIN] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRAL_SUB; real_div; + REAL_INTEGRABLE_SIN_CX; REAL_INTEGRABLE_COS_CX; + REAL_INTEGRAL_RMUL; REAL_INTEGRABLE_SUB; REAL_INTEGRABLE_ADD] THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_SUB] THEN + REWRITE_TAC[REAL_INTEGRAL_SIN_NX; REAL_INTEGRAL_COS_NX] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO; REAL_ADD_LID] THEN + ASM_SIMP_TAC[ARITH_RULE `n:num <= m ==> (m - n = 0 <=> m = n)`] THEN + REWRITE_TAC[ADD_EQ_0] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ARITH `(a + a) * inv(&2) = a`; + REAL_MUL_LZERO] THEN + REAL_ARITH_TAC);; + +let REAL_INTEGRABLE_SIN_AND_COS = prove + (`!m n a b. + (\x. cos(&m * x) * cos(&n * x)) real_integrable_on real_interval[a,b] /\ + (\x. cos(&m * x) * sin(&n * x)) real_integrable_on real_interval[a,b] /\ + (\x. sin(&m * x) * cos(&n * x)) real_integrable_on real_interval[a,b] /\ + (\x. sin(&m * x) * sin(&n * x)) real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN REPEAT CONJ_TAC THEN + REAL_INTEGRABLE_ON_INTERVAL_TAC);; + +let trigonometric_set_def = new_definition + `trigonometric_set n = + if n = 0 then \x. &1 / sqrt(&2 * pi) + else if ODD n then \x. sin(&(n DIV 2 + 1) * x) / sqrt(pi) + else \x. cos(&(n DIV 2) * x) / sqrt(pi)`;; + +let trigonometric_set = prove + (`trigonometric_set 0 = (\x. cos(&0 * x) / sqrt(&2 * pi)) /\ + trigonometric_set (2 * n + 1) = (\x. sin(&(n + 1) * x) / sqrt(pi)) /\ + trigonometric_set (2 * n + 2) = (\x. cos(&(n + 1) * x) / sqrt(pi))`, + REWRITE_TAC[trigonometric_set_def; EVEN_ADD; EVEN_MULT; ARITH; ADD_EQ_0; + GSYM NOT_EVEN] THEN + REWRITE_TAC[ARITH_RULE `(2 * n + 1) DIV 2 = n`] THEN + REWRITE_TAC[ARITH_RULE `(2 * n + 2) DIV 2 = n + 1`] THEN + REWRITE_TAC[REAL_MUL_LZERO; COS_0]);; + +let TRIGONOMETRIC_SET_EVEN = prove + (`!k. trigonometric_set(2 * k) = + if k = 0 then \x. &1 / sqrt(&2 * pi) + else \x. cos(&k * x) / sqrt pi`, + INDUCT_TAC THEN + REWRITE_TAC[ARITH; trigonometric_set; REAL_MUL_LZERO; COS_0] THEN + REWRITE_TAC[NOT_SUC; ARITH_RULE `2 * SUC k = 2 * k + 2`] THEN + REWRITE_TAC[trigonometric_set; GSYM ADD1]);; + +let ODD_EVEN_INDUCT_LEMMA = prove + (`(!n:num. P 0) /\ (!n. P(2 * n + 1)) /\ (!n. P(2 * n + 2)) ==> !n. P n`, + REWRITE_TAC[FORALL_SIMP] THEN STRIP_TAC THEN + MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + MP_TAC(ISPEC `n:num` EVEN_OR_ODD) THEN + REWRITE_TAC[EVEN_EXISTS; ODD_EXISTS] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE + `SUC(2 * n) = 2 * n + 1 /\ SUC(2 * n + 1) = 2 * n + 2`]);; + +let ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET = prove + (`orthonormal_system (real_interval[--pi,pi]) trigonometric_set`, + REWRITE_TAC[orthonormal_system; l2product] THEN + MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `m:num` THEN + MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[trigonometric_set] THEN + REWRITE_TAC[REAL_ARITH `a / k * b / l:real = (inv(k) * inv(l)) * a * b`] THEN + SIMP_TAC[REAL_INTEGRAL_LMUL; REAL_INTEGRABLE_SIN_AND_COS] THEN + REWRITE_TAC[REAL_INTEGRAL_SIN_AND_COS] THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_MUL_RZERO] THEN + ASM_CASES_TAC `m:num = n` THEN + TRY (COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + TRY (MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC) THEN + ASM_REWRITE_TAC[ARITH_RULE `0 = a + b <=> a = 0 /\ b = 0`; + EQ_ADD_RCANCEL; EQ_MULT_LCANCEL] THEN + REWRITE_TAC[ARITH; REAL_MUL_RZERO] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_POW_2] THEN + SIMP_TAC[SQRT_POW_2; REAL_LE_MUL; REAL_POS; PI_POS_LE] THEN + MATCH_MP_TAC REAL_MUL_LINV THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let SQUARE_INTEGRABLE_TRIGONOMETRIC_SET = prove + (`!i. (trigonometric_set i) square_integrable_on real_interval[--pi,pi]`, + MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set] THEN + REWRITE_TAC[real_div] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Weierstrass for trigonometric polynomials. *) +(* ------------------------------------------------------------------------- *) + +let WEIERSTRASS_TRIG_POLYNOMIAL = prove + (`!f e. f real_continuous_on real_interval[--pi,pi] /\ + f(--pi) = f pi /\ &0 < e + ==> ?n a b. + !x. x IN real_interval[--pi,pi] + ==> abs(f x - sum(0..n) (\k. a k * sin(&k * x) + + b k * cos(&k * x))) < e`, + let lemma1 = prove + (`!f. f real_continuous_on (:real) /\ (!x. f(x + &2 * pi) = f x) + ==> !z. norm z = &1 + ==> (f o Im o clog) real_continuous + at z within {w | norm w = &1}`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `&0 <= Re z \/ Re z < &0`) THENL + [ALL_TAC; + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS] THEN + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN + EXISTS_TAC `Cx o f o (\x. x + pi) o Im o clog o (--)` THEN + EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN + CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN + STRIP_TAC THEN ASM_SIMP_TAC[CLOG_NEG; o_THM] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[IM_ADD; IM_SUB; IM_MUL_II; RE_CX; REAL_SUB_ADD] THEN + ASM_REWRITE_TAC[REAL_ARITH `(x + pi) + pi = x + &2 * pi`]; + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN CONTINUOUS_TAC; + REWRITE_TAC[GSYM o_ASSOC; GSYM REAL_CONTINUOUS_CONTINUOUS]]]] THEN + REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN + (CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_CLOG THEN + REWRITE_TAC[GSYM real] THEN DISCH_TAC THEN + UNDISCH_TAC `norm(z:complex) = &1` THEN + ASM_SIMP_TAC[REAL_NORM; RE_NEG; REAL_NEG_GT0] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC]) THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_COMPOSE THEN + REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN] THEN + TRY(MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_CONST; + REAL_CONTINUOUS_WITHIN_ID]) THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN + SIMP_TAC[IN_UNIV; WITHINREAL_UNIV]) in + let lemma2 = prove + (`!f. f real_continuous_on real_interval[--pi,pi] /\ f(--pi) = f pi + ==> !z. norm z = &1 + ==> (f o Im o clog) real_continuous + at z within {w | norm w = &1}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real->real`; `--pi`; `pi`] REAL_TIETZE_PERIODIC_INTERVAL) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `g:real->real` lemma1) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS] THEN + MATCH_MP_TAC(REWRITE_RULE + [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] + CONTINUOUS_TRANSFORM_WITHIN) THEN + EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN + X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN + STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[IN_REAL_INTERVAL; CLOG_WORKS; REAL_LT_IMP_LE]) in + REPEAT STRIP_TAC THEN + (CHOOSE_THEN MP_TAC o prove_inductive_relations_exist) + `(!c. poly2 (\x. c)) /\ + (!p q. poly2 p /\ poly2 q ==> poly2 (\x. p x + q x)) /\ + (!p q. poly2 p /\ poly2 q ==> poly2 (\x. p x * q x)) /\ + poly2 Re /\ poly2 Im` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o CONJUNCT1)) THEN + MP_TAC(ISPECL [`poly2:(complex->real)->bool`; `{z:complex | norm z = &1}`] + STONE_WEIERSTRASS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN CONJ_TAC THENL + [REWRITE_TAC[bounded; IN_ELIM_THM] THEN MESON_TAC[REAL_LE_REFL]; + ONCE_REWRITE_TAC[SET_RULE `{x | p x} = {x | x IN UNIV /\ p x}`] THEN + REWRITE_TAC[GSYM LIFT_EQ] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF; CLOSED_UNIV]]; + MATCH_MP_TAC(MESON[] + `(!x f. P f ==> R f x) ==> (!f. P f ==> !x. Q x ==> R f x)`) THEN + GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_MUL] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; + REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN]; + MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN + REWRITE_TAC[IN_ELIM_THM; COMPLEX_EQ; DE_MORGAN_THM] THEN STRIP_TAC THENL + [EXISTS_TAC `Re` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `Im` THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`(f:real->real) o Im o clog`; `e:real`]) THEN + ASM_SIMP_TAC[IN_ELIM_THM; lemma2] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC + `trigpoly = + \f. ?n a b. + f = \x. sum(0..n) (\k. a k * sin(&k * x) + b k * cos(&k * x))` THEN + SUBGOAL_THEN `!c:real. trigpoly(\x:real. c)` ASSUME_TAC THENL + [X_GEN_TAC `c:real` THEN EXPAND_TAC "trigpoly" THEN REWRITE_TAC[] THEN + EXISTS_TAC `0` THEN + REWRITE_TAC[SUM_SING_NUMSEG; REAL_MUL_LZERO; SIN_0; COS_0] THEN + MAP_EVERY EXISTS_TAC [`(\n. &0):num->real`; `(\n. c):num->real`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!f g:real->real. trigpoly f /\ trigpoly g ==> trigpoly(\x. f x + g x)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "trigpoly" THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`n1:num`; `a1:num->real`; `b1:num->real`; + `n2:num`; `a2:num->real`; `b2:num->real`] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN + MAP_EVERY EXISTS_TAC + [`MAX n1 n2`; + `(\n. (if n <= n1 then a1 n else &0) + + (if n <= n2 then a2 n else &0)):num->real`; + `(\n. (if n <= n1 then b1 n else &0) + + (if n <= n2 then b2 n else &0)):num->real`] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; FUN_EQ_THM; REAL_ADD_RDISTRIB] THEN + GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `a:real = e /\ b = g /\ c = f /\ d = h + ==> (a + b) + (c + d) = (e + f) + (g + h)`) THEN + REPEAT CONJ_TAC THEN + REWRITE_TAC[COND_RATOR; COND_RAND; REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN + MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN + REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!f s:num->bool. FINITE s /\ (!i. i IN s ==> trigpoly(f i)) + ==> trigpoly(\x:real. sum s (\i. f i x))` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[SUM_CLAUSES; IN_INSERT; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!f:real->real c. trigpoly f ==> trigpoly (\x. c * f x)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "trigpoly" THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`; `b:num->real`] THEN + DISCH_THEN SUBST1_TAC THEN MAP_EVERY EXISTS_TAC + [`n:num`; `\i. c * (a:num->real) i`; `\i. c * (b:num->real) i`] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; GSYM SUM_LMUL; GSYM REAL_MUL_ASSOC]; + ALL_TAC] THEN + SUBGOAL_THEN `!i. trigpoly(\x. sin(&i * x))` ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY EXISTS_TAC + [`k:num`; `\i:num. if i = k then &1 else &0`; `\i:num. &0`] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; COND_RAND; COND_RATOR] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_LID; IN_NUMSEG; LE_0; LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `!i. trigpoly(\x. cos(&i * x))` ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN EXPAND_TAC "trigpoly" THEN MAP_EVERY EXISTS_TAC + [`k:num`; `\i:num. &0`; `\i:num. if i = k then &1 else &0`] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; COND_RAND; COND_RATOR] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_LID; IN_NUMSEG; LE_0; LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i j. trigpoly(\x. sin(&i * x) * sin(&j * x)) /\ + trigpoly(\x. sin(&i * x) * cos(&j * x)) /\ + trigpoly(\x. cos(&i * x) * sin(&j * x)) /\ + trigpoly(\x. cos(&i * x) * cos(&j * x))` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC WLOG_LE THEN + CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI; REAL_MUL_AC]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_SIN_SIN; REAL_MUL_SIN_COS; REAL_MUL_COS_SIN; + REAL_MUL_COS_COS] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`; + REAL_ARITH `x - y:real = x + --(&1) * y`] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!f g:real->real. trigpoly f /\ trigpoly g ==> trigpoly(\x. f x * g x)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM + th]) THEN + REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL STRIP_THM_THEN SUBST1_TAC) THEN + REWRITE_TAC[REAL_MUL_SUM_NUMSEG] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH + `(ai * si + bi * ci) * (aj * sj + bj * cj):real = + ((ai * aj) * (si * sj) + (bi * bj) * (ci * cj)) + + ((ai * bj) * (si * cj) + (aj * bi) * (ci * sj))`] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!f:complex->real. poly2 f ==> trigpoly(\x. f(cexp(ii * Cx x)))` + (MP_TAC o SPEC `g:complex->real`) THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[RE_CEXP; IM_CEXP; RE_MUL_II; IM_CX; IM_MUL_II; RE_CX] THEN + ONCE_REWRITE_TAC[MESON[REAL_MUL_LID] + `cos x = cos(&1 * x) /\ sin x = sin(&1 * x)`] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "trigpoly" THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) + [`n:num`; `a:num->real`; `b:num->real`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + X_GEN_TAC `r:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `cexp(ii * Cx r)`) THEN + REWRITE_TAC[NORM_CEXP_II] THEN MATCH_MP_TAC(REAL_ARITH + `x = x' ==> abs(x - y) < e ==> abs(x' - y) < e`) THEN + REWRITE_TAC[o_DEF] THEN + ASM_CASES_TAC `r = --pi` THENL + [UNDISCH_THEN `r = --pi` SUBST_ALL_TAC THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN] THEN + REWRITE_TAC[COS_NEG; SIN_NEG; SIN_PI; COS_PI] THEN + REWRITE_TAC[CX_NEG; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN + ASM_REWRITE_TAC[CLOG_NEG_1; COMPLEX_ADD_RID; IM_MUL_II; RE_CX]; + ASM_SIMP_TAC[CLOG_CEXP; IM_MUL_II; RE_CX; REAL_LT_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* A bit of extra hacking round so that the ends of a function are OK. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INTEGRAL_TWEAK_ENDS = prove + (`!a b d e. + a < b /\ &0 < e + ==> ?f. f real_continuous_on real_interval[a,b] /\ + f(a) = d /\ f(b) = &0 /\ + l2norm (real_interval[a,b]) f < e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. (\x. if x <= a + inv(&n + &1) + then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0) + real_continuous_on real_interval[a,b]` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `a < a + inv(&n + &1)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_ADDR; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `a + inv(&n + &1) <= b` THENL + [SUBGOAL_THEN + `real_interval[a,b] = real_interval[a,a + inv(&n + &1)] UNION + real_interval[a + inv(&n + &1),b]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_CASES THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST] THEN + CONJ_TAC THENL + [SIMP_TAC[real_div; REAL_CONTINUOUS_ON_MUL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_ID]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + ASM_CASES_TAC `x:real = a + inv(&n + &1)` THENL + [ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_RZERO]; + ASM_REAL_ARITH_TAC]]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THEN + EXISTS_TAC `\x. ((&n + &1) * d) * ((a + inv(&n + &1)) - x)` THEN + SIMP_TAC[real_div; REAL_CONTINUOUS_ON_MUL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_ID] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC + (ISPECL [`\n x. (if x <= a + inv(&n + &1) + then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0) + pow 2`; + `\x:real. if x = a then d pow 2 else &0`; + `\x:real. (d:real) pow 2`; + `real_interval[a,b]`] + REAL_DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ON_POW]; + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]; + MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_POW] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_ABS] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ARITH `d * x <= d <=> &0 <= d * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - x * y <=> y * x <= &1`] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real = a` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_LE_INV_EQ; + REAL_ARITH `&0 <= &n + &1`] THEN + REWRITE_TAC[REAL_ADD_SUB] THEN + SIMP_TAC[REAL_FIELD `&0 < x ==> (x * d) * inv x = d`; + REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[REALLIM_CONST]; + MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(ISPEC `x - a:real` REAL_ARCH_INV) THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(TAUT `F ==> p`) THEN + SUBGOAL_THEN `inv(&n + &1) <= inv(&N)` MP_TAC THENL + [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC]]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `(e:real) pow 2`) THEN + ASM_SIMP_TAC[REAL_POW_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN + MP_TAC(ISPEC `b - a:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?n:num. N <= n /\ M <= n` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `M + N:num` THEN ARITH_TAC; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + EXISTS_TAC `\x. if x <= a + inv(&n + &1) + then ((&n + &1) * d) * ((a + inv(&n + &1)) - x) else &0` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MP_TAC(REAL_ARITH `&0 < &n + &1`) THEN + SIMP_TAC[REAL_LE_ADDR; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN + CONV_TAC REAL_FIELD; + SUBGOAL_THEN `inv(&n + &1) < b - a` MP_TAC THENL + [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&M)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL + [ASM_MESON_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; ALL_TAC] THEN + REWRITE_TAC[l2norm; l2product] THEN MATCH_MP_TAC SQRT_MONO_LT THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(i - l) < e ==> &0 <= i /\ l = &0 ==> i < e`)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_CONTINUOUS; REAL_CONTINUOUS_ON_POW] THEN + REWRITE_TAC[REAL_LE_POW_2]; + MP_TAC(ISPEC `real_interval[a,b]` REAL_INTEGRAL_0) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{a:real}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + SIMP_TAC[IN_DIFF; IN_SING]]]]);; + +let SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS_ENDS = prove + (`!f a b e. + f square_integrable_on real_interval[a,b] /\ a < b /\ &0 < e + ==> ?g. g real_continuous_on real_interval[a,b] /\ + g b = g a /\ + g square_integrable_on real_interval[a,b] /\ + l2norm (real_interval[a,b]) (\x. f x - g x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `real_interval[a,b]`; `e / &2`] + SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_MEASURABLE_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`a:real`; `b:real`; `(g:real->real) b - g a`; `e / &2`] + REAL_INTEGRAL_TWEAK_ENDS) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real->real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `h square_integrable_on real_interval[a,b]` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE]; ALL_TAC] THEN + EXISTS_TAC `\x. (g:real->real) x + h x` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + REAL_ARITH_TAC; + MATCH_MP_TAC SQUARE_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[REAL_ARITH `f - (g + h):real = (f - g) + --h`] THEN + W(MP_TAC o PART_MATCH (lhand o rand) L2NORM_TRIANGLE o lhand o snd) THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB; SQUARE_INTEGRABLE_NEG] THEN + MATCH_MP_TAC(REAL_ARITH + `y < e / &2 /\ z < e / &2 ==> x <= y + z ==> x < e`) THEN + ASM_SIMP_TAC[L2NORM_NEG]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main approximation result. *) +(* ------------------------------------------------------------------------- *) + +let WEIERSTRASS_L2_TRIG_POLYNOMIAL = prove + (`!f e. f square_integrable_on real_interval[--pi,pi] /\ &0 < e + ==> ?n a b. + l2norm (real_interval[--pi,pi]) + (\x. f x - sum(0..n) (\k. a k * sin(&k * x) + + b k * cos(&k * x))) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `e / &2`] + SQUARE_INTEGRABLE_APPROXIMATE_CONTINUOUS_ENDS) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `--pi < pi <=> &0 < pi`; PI_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real->real`; `e / &6`] WEIERSTRASS_TRIG_POLYNOMIAL) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC t) + [`n:num`; `u:num->real`; `v:num->real`] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + SUBGOAL_THEN + `!n u v. (\x. sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x))) + square_integrable_on (real_interval[--pi,pi])` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + GEN_TAC THEN DISCH_TAC THEN REAL_DIFFERENTIABLE_TAC; + ALL_TAC] THEN + EXISTS_TAC `l2norm (real_interval[--pi,pi]) (\x. f x - g x) + + l2norm (real_interval[--pi,pi]) (\x. g x - sum(0..n) + (\k. u k * sin(&k * x) + v k * cos(&k * x)))` THEN + CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) L2NORM_TRIANGLE o rand o snd) THEN + REWRITE_TAC[REAL_ARITH `(f - g) + (g - h):real = f - h`] THEN + ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y <= e / &2 ==> x + y < e`) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[l2norm; l2product; GSYM REAL_POW_2] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN + SUBGOAL_THEN + `(\x. g x - sum(0..n) (\k. u k * sin(&k * x) + v k * cos(&k * x))) + square_integrable_on (real_interval[--pi,pi])` + MP_TAC THENL [ASM_SIMP_TAC[SQUARE_INTEGRABLE_SUB]; ALL_TAC] THEN + REWRITE_TAC[square_integrable_on] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_INTEGRAL_POS; REAL_LE_POW_2] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral(real_interval[--pi,pi]) (\x. (e / &6) pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN X_GEN_TAC `x:real` THEN + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN + MATCH_MP_TAC(REAL_ARITH `abs x < e ==> abs(x) <= abs e`) THEN + ASM_SIMP_TAC[]; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `--pi <= pi <=> &0 <= pi`; + PI_POS_LE] THEN + REWRITE_TAC[real_div; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);; + +let WEIERSTRASS_L2_TRIGONOMETRIC_SET = prove + (`!f e. f square_integrable_on real_interval[--pi,pi] /\ &0 < e + ==> ?n a. + l2norm (real_interval[--pi,pi]) + (\x. f x - + sum(0..n) (\k. a k * trigonometric_set k x)) + < e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP WEIERSTRASS_L2_TRIG_POLYNOMIAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`; `b:num->real`] THEN + DISCH_TAC THEN EXISTS_TAC `2 * n + 1` THEN + SUBST1_TAC(ARITH_RULE `0 = 2 * 0`) THEN + REWRITE_TAC[SUM_PAIR; SUM_ADD_NUMSEG; trigonometric_set] THEN + EXISTS_TAC + `(\k. if k = 0 then sqrt(&2 * pi) * b 0 + else if EVEN k then sqrt pi * b(k DIV 2) + else if k <= 2 * n then sqrt pi * a((k + 1) DIV 2) + else &0):num->real` THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> y = x ==> y < e`)) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH; ADD_EQ_0; MULT_EQ_0] THEN + REWRITE_TAC[SUM_ADD_NUMSEG] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN BINOP_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN + SIMP_TAC[LE_0; ARITH_RULE `2 * i <= 2 * n <=> i <= n`] THEN + INDUCT_TAC THENL + [REWRITE_TAC[trigonometric_set; ARITH; LE_0] THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < s ==> (s * b) * c / s = b * c`) THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[NOT_SUC; ARITH_RULE `2 * (SUC i) = 2 * i + 2`] THEN + REWRITE_TAC[trigonometric_set; + ARITH_RULE `(2 * i + 2) DIV 2 = SUC i`] THEN + REWRITE_TAC[ADD1] THEN MATCH_MP_TAC(REAL_FIELD + `&0 < s ==> (s * b) * c / s = b * c`) THEN + MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]; + REWRITE_TAC[ARITH_RULE `2 * i + 1 = 2 * (i + 1) - 1`] THEN + REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN + REWRITE_TAC[GSYM ADD1; ARITH; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n /\ 2 * SUC n - 1 = 2 * n + 1`] THEN + REWRITE_TAC[ARITH_RULE `~(2 * n + 1 <= 2 * n)`; REAL_MUL_LZERO] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; REAL_ADD_RID] THEN + SIMP_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID; ARITH] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> 2 * i - 1 <= 2 * n`] THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * SUC i - 1) DIV 2 = SUC i`] THEN + DISCH_TAC THEN MATCH_MP_TAC(REAL_FIELD + `&0 < s ==> (s * b) * c / s = b * c`) THEN + MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]);; + +(* ------------------------------------------------------------------------- *) +(* Convergence w.r.t. L2 norm of trigonometric Fourier series. *) +(* ------------------------------------------------------------------------- *) + +let fourier_coefficient = new_definition + `fourier_coefficient = + orthonormal_coefficient (real_interval[--pi,pi]) trigonometric_set`;; + +let FOURIER_SERIES_L2 = prove + (`!f. f square_integrable_on real_interval[--pi,pi] + ==> ((\n. l2norm (real_interval[--pi,pi]) + (\x. f(x) - sum(0..n) (\i. fourier_coefficient f i * + trigonometric_set i x))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `e:real`] + WEIERSTRASS_L2_TRIGONOMETRIC_SET) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:num->real` THEN DISCH_TAC THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + REWRITE_TAC[fourier_coefficient] THEN MP_TAC(ISPECL + [`real_interval[--pi,pi]`; `trigonometric_set`; + `(\i. if i <= n then a i else &0):num->real`; + `f:real->real`; `0..m`] + ORTHONORMAL_OPTIMAL_PARTIAL_SUM) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET; + SQUARE_INTEGRABLE_TRIGONOMETRIC_SET; REAL_SUB_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a < e ==> x <= a ==> abs x < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC L2NORM_POS_LE THEN + MATCH_MP_TAC SQUARE_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SQUARE_INTEGRABLE_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SQUARE_INTEGRABLE_LMUL THEN + REWRITE_TAC[ETA_AX; SQUARE_INTEGRABLE_TRIGONOMETRIC_SET]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> y = x ==> y < e`)) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real` THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; LE_0] THEN + SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; LE_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Fourier coefficients go to 0 (weak form of Riemann-Lebesgue). *) +(* ------------------------------------------------------------------------- *) + +let TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE = prove + (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\x. trigonometric_set n x * f x) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; real_div] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; REAL_ABS_DIV] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; + SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN + SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);; + +let TRIGONOMETRIC_SET_MUL_INTEGRABLE = prove + (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\x. trigonometric_set n x * f x) + real_integrable_on real_interval[--pi,pi]`, + SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE]);; + +let ABSOLUTELY_INTEGRABLE_SIN_PRODUCT,ABSOLUTELY_INTEGRABLE_COS_PRODUCT = + (CONJ_PAIR o prove) + (`(!f k. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\x. sin(k * x) * f x) absolutely_real_integrable_on + real_interval[--pi,pi]) /\ + (!f k. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\x. cos(k * x) * f x) absolutely_real_integrable_on + real_interval[--pi,pi])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + (ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; real_div] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; COS_BOUND; SIN_BOUND]]));; + +let FOURIER_PRODUCTS_INTEGRABLE_STRONG = prove + (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> f real_integrable_on real_interval[--pi,pi] /\ + (!k. (\x. cos(k * x) * f x) real_integrable_on + real_interval[--pi,pi]) /\ + (!k. (\x. sin(k * x) * f x) real_integrable_on + real_interval[--pi,pi])`, + SIMP_TAC[ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; + ABSOLUTELY_INTEGRABLE_COS_PRODUCT; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; + +let FOURIER_PRODUCTS_INTEGRABLE = prove + (`!f. f square_integrable_on real_interval[--pi,pi] + ==> f real_integrable_on real_interval[--pi,pi] /\ + (!k. (\x. cos(k * x) * f x) real_integrable_on + real_interval[--pi,pi]) /\ + (!k. (\x. sin(k * x) * f x) real_integrable_on + real_interval[--pi,pi])`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC FOURIER_PRODUCTS_INTEGRABLE_STRONG THEN + ASM_SIMP_TAC[REAL_MEASURABLE_REAL_INTERVAL; + SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE]);; + +let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove + (`!f s e. real_measurable s /\ f absolutely_real_integrable_on s /\ &0 < e + ==> ?g. g real_continuous_on (:real) /\ + g absolutely_real_integrable_on s /\ + real_integral s (\x. abs(f x - g x)) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `&1:real`; `e:real`] + LSPACE_APPROXIMATE_CONTINUOUS) THEN + ASM_REWRITE_TAC[LSPACE_1; GSYM ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_OF_NUM_LE; + ARITH; GSYM REAL_MEASURABLE_MEASURABLE] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `drop o g o lift` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_DROP; ETA_AX; + IMAGE_LIFT_UNIV]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX]; + DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> x = y ==> y < e`)) THEN + REWRITE_TAC[lnorm; REAL_INV_1; RPOW_POW; REAL_POW_1] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN + ANTS_TAC THENL + [SUBGOAL_THEN + `(\x. f x - (drop o g o lift) x) absolutely_real_integrable_on s` + MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_real_integrable_on]] THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ETA_AX]; + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[o_DEF; NORM_LIFT; LIFT_DROP; NORM_REAL; GSYM drop; + DROP_SUB; LIFT_SUB]]]);; + +let RIEMANN_LEBESGUE_SQUARE_INTEGRABLE = prove + (`!s w f. + orthonormal_system s w /\ + (!i. w i square_integrable_on s) /\ + f square_integrable_on s + ==> (orthonormal_coefficient s w f ---> &0) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `(:num)` o + MATCH_MP FOURIER_SERIES_SQUARE_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMMABLE_IMP_TOZERO) THEN + SIMP_TAC[IN_UNIV; REALLIM_NULL_POW_EQ; ARITH; ETA_AX]);; + +let RIEMANN_LEBESGUE = prove + (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (fourier_coefficient f ---> &0) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real->real`; `real_interval[--pi,pi]`; `e / &2`] + ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_MEASURABLE_REAL_INTERVAL; + LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`real_interval[--pi,pi]`; `trigonometric_set`; `g:real->real`] + RIEMANN_LEBESGUE_SQUARE_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[ORTHONORMAL_SYSTEM_TRIGONOMETRIC_SET; + SQUARE_INTEGRABLE_TRIGONOMETRIC_SET] THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_SQUARE_INTEGRABLE THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `N:num <= n` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e / &2 ==> abs(y - z) <= x ==> y < e / &2 ==> z < e`)) THEN + MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= r ==> abs(abs x - abs y) <= r`) THEN + W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_SUB o + rand o lhand o snd) THEN + ASM_SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE] THEN + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN + ASM_SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE]; + SUBGOAL_THEN `(\x. (f:real->real) x - g x) absolutely_real_integrable_on + real_interval[--pi,pi]` + MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB]; ALL_TAC] THEN + SIMP_TAC[absolutely_real_integrable_on]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SUB] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + SPEC_TAC(`n:num`,`n:num`) THEN + MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; REAL_ABS_DIV] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; + SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN + SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]);; + +let RIEMANN_LEBESGUE_SIN = prove + (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\x. sin(&n * x) * f x)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N + 1` THEN MATCH_MP_TAC num_INDUCTION THEN + CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC)] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; + trigonometric_set; l2product; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a / sqrt pi * b = inv(sqrt pi) * a * b`] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; SQRT_POS_LT; PI_POS; + REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_ABS_DIV] THEN + REWRITE_TAC[ADD1] THEN + MATCH_MP_TAC(REAL_ARITH `d <= e ==> x < d ==> x < e`) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &4 ==> inv(&4) * abs x <= &1`) THEN + SIMP_TAC[SQRT_POS_LE; PI_POS_LE] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);; + +let RIEMANN_LEBESGUE_COS = prove + (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\x. cos(&n * x) * f x)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N + 1` THEN MATCH_MP_TAC num_INDUCTION THEN + CONJ_TAC THENL [ARITH_TAC; X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC)] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 2`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; + trigonometric_set; l2product; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a / sqrt pi * b = inv(sqrt pi) * a * b`] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; SQRT_POS_LT; PI_POS; + REAL_ARITH `&0 < x ==> &0 < abs x`; REAL_ABS_DIV] THEN + REWRITE_TAC[ADD1] THEN + MATCH_MP_TAC(REAL_ARITH `d <= e ==> x < d ==> x < e`) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &4 ==> inv(&4) * abs x <= &1`) THEN + SIMP_TAC[SQRT_POS_LE; PI_POS_LE] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);; + +let RIEMANN_LEBESGUE_SIN_HALF = prove + (`!f. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\x. sin((&n + &1 / &2) * x) * f x)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SIN_ADD; REAL_ADD_RDISTRIB] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `(\n. real_integral (real_interval[--pi,pi]) + (\x. sin(&n * x) * cos(&1 / &2 * x) * f x) + + real_integral (real_interval[--pi,pi]) + (\x. cos(&n * x) * sin(&1 / &2 * x) * f x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INTEGRAL_ADD; + MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC RIEMANN_LEBESGUE_SIN; + MATCH_MP_TAC RIEMANN_LEBESGUE_COS]] THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; + ABSOLUTELY_INTEGRABLE_COS_PRODUCT]);; + +let FOURIER_SUM_LIMIT_PAIR = prove + (`!f n t l. + f absolutely_real_integrable_on real_interval [--pi,pi] + ==> (((\n. sum(0..2*n) (\k. fourier_coefficient f k * + trigonometric_set k t)) ---> l) + sequentially <=> + ((\n. sum(0..n) (\k. fourier_coefficient f k * + trigonometric_set k t)) ---> l) + sequentially)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP RIEMANN_LEBESGUE) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "1")) THEN + SUBGOAL_THEN `&0 < e / &2` (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) + THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "2")) THEN + EXISTS_TAC `N1 + 2 * N2 + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + DISJ_CASES_THEN SUBST1_TAC + (ARITH_RULE `n = 2 * n DIV 2 \/ n = SUC(2 * n DIV 2)`) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THENL + [MATCH_MP_TAC(REAL_ARITH `abs x < e / &2 ==> abs x < e`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `abs(x - l) < e / &2 /\ abs y < e / &2 ==> abs((x + y) - l) < e`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x * y) <= abs(x) * &1 /\ abs(x) < e ==> abs(x * y) < e`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + SPEC_TAC(`SUC(2 * n DIV 2)`,`r:num`) THEN + MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[ADD1; trigonometric_set; REAL_ABS_DIV] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`; + SQRT_POS_LT; REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[COS_BOUND; SIN_BOUND] THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 <= &1 * abs x`) THEN + SUBST1_TAC(GSYM SQRT_1) THEN MATCH_MP_TAC SQRT_MONO_LE THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Express Fourier sum in terms of the special expansion at the origin. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_SUM_0 = prove + (`!f n. + sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = + sum (0..n DIV 2) + (\k. fourier_coefficient f (2 * k) * trigonometric_set (2 * k) (&0))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum (2 * 0..2 * (n DIV 2) + 1) + (\k. fourier_coefficient f k * trigonometric_set k (&0))` THEN + CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_SUPERSET THEN + REWRITE_TAC[IN_NUMSEG; SUBSET; LE_0] THEN + CONJ_TAC THENL [ARITH_TAC; GEN_TAC] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP (ARITH_RULE + `x <= 2 * n DIV 2 + 1 /\ ~(x <= n) ==> x = 2 * n DIV 2 + 1`)); + REWRITE_TAC[SUM_PAIR]] THEN + REWRITE_TAC[trigonometric_set; real_div; REAL_MUL_RZERO; SIN_0; + REAL_MUL_LZERO; REAL_ADD_RID]);; + +let FOURIER_SUM_0_EXPLICIT = prove + (`!f n. + sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = + (fourier_coefficient f 0 / sqrt(&2) + + sum (1..n DIV 2) (\k. fourier_coefficient f (2 * k))) / sqrt pi`, + REPEAT GEN_TAC THEN REWRITE_TAC[FOURIER_SUM_0] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_div; + REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN + REWRITE_TAC[MULT_CLAUSES; trigonometric_set; + REAL_MUL_LZERO; COS_0; real_div] THEN + BINOP_TAC THENL + [REWRITE_TAC[REAL_MUL_LID; SQRT_MUL; REAL_INV_MUL; GSYM REAL_MUL_ASSOC]; + REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[trigonometric_set; ARITH_RULE `2 * SUC i = 2 * i + 2`] THEN + REWRITE_TAC[REAL_MUL_RZERO; COS_0; real_div; REAL_MUL_LID]]);; + +let FOURIER_SUM_0_INTEGRALS = prove + (`!f n. + f absolutely_real_integrable_on real_interval[--pi,pi] + ==> sum (0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = + (real_integral(real_interval[--pi,pi]) f / &2 + + sum(1..n DIV 2) (\k. real_integral (real_interval[--pi,pi]) + (\x. cos(&k * x) * f x))) / pi`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FOURIER_SUM_0_EXPLICIT] THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN + REWRITE_TAC[trigonometric_set] THEN BINOP_TAC THENL + [REWRITE_TAC[COS_0; REAL_MUL_LZERO; real_div; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN + REWRITE_TAC[REAL_ARITH `((a * b) * c) * d:real = b * a * c * d`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + SIMP_TAC[GSYM SQRT_MUL; REAL_POS; PI_POS_LE; REAL_LE_MUL] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC POW_2_SQRT THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN STRIP_TAC THEN + REWRITE_TAC[trigonometric_set; ARITH_RULE `2 * SUC i = 2 * i + 2`] THEN + REWRITE_TAC[REAL_MUL_RZERO; COS_0; real_div; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(i * x) * i:real = x * i * i`] THEN + REWRITE_TAC[ADD1; GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_POW_2] THEN + MATCH_MP_TAC SQRT_POW_2 THEN REWRITE_TAC[PI_POS_LE]]);; + +let FOURIER_SUM_0_INTEGRAL = prove + (`!f n. + f absolutely_real_integrable_on real_interval[--pi,pi] + ==> sum(0..n) (\k. fourier_coefficient f k * trigonometric_set k (&0)) = + real_integral(real_interval[--pi,pi]) + (\x. (&1 / &2 + sum(1..n DIV 2) (\k. cos(&k * x))) * f x) / pi`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_0_INTEGRALS] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_SUM; FINITE_NUMSEG; + FOURIER_PRODUCTS_INTEGRABLE_STRONG; real_div; + GSYM REAL_INTEGRAL_ADD; + GSYM REAL_INTEGRAL_RMUL; REAL_INTEGRABLE_RMUL; ETA_AX; + REAL_INTEGRABLE_SUM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; SUM_RMUL] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* How Fourier coefficients behave under addition etc. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_COEFFICIENT_ADD = prove + (`!f g i. f absolutely_real_integrable_on real_interval[--pi,pi] /\ + g absolutely_real_integrable_on real_interval[--pi,pi] + ==> fourier_coefficient (\x. f x + g x) i = + fourier_coefficient f i + fourier_coefficient g i`, + SIMP_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN + SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE; REAL_ADD_LDISTRIB; + REAL_INTEGRAL_ADD]);; + +let FOURIER_COEFFICIENT_SUB = prove + (`!f g i. f absolutely_real_integrable_on real_interval[--pi,pi] /\ + g absolutely_real_integrable_on real_interval[--pi,pi] + ==> fourier_coefficient (\x. f x - g x) i = + fourier_coefficient f i - fourier_coefficient g i`, + SIMP_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN + SIMP_TAC[TRIGONOMETRIC_SET_MUL_INTEGRABLE; REAL_SUB_LDISTRIB; + REAL_INTEGRAL_SUB]);; + +let FOURIER_COEFFICIENT_CONST = prove + (`!c i. fourier_coefficient (\x. c) i = + if i = 0 then c * sqrt(&2 * pi) else &0`, + GEN_TAC THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product; + trigonometric_set] THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `0` HAS_REAL_INTEGRAL_COS_NX) THEN + DISCH_THEN(MP_TAC o SPEC `inv(sqrt(&2 * pi)) * c` o + MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < s /\ s pow 2 = &2 * pi ==> &2 * pi * inv(s) * c = c * s`) THEN + SIMP_TAC[SQRT_POW_2; REAL_LT_MUL; REAL_LE_MUL; REAL_POS; REAL_OF_NUM_LT; + ARITH; SQRT_POS_LT; PI_POS; REAL_LT_IMP_LE]; + X_GEN_TAC `n:num` THEN + MP_TAC(ISPEC `n + 1` HAS_REAL_INTEGRAL_SIN_NX) THEN + DISCH_THEN(MP_TAC o SPEC `inv(sqrt pi) * c` o + MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LZERO] THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_INTEGRAL_UNIQUE]; + X_GEN_TAC `n:num` THEN + MP_TAC(ISPEC `n + 1` HAS_REAL_INTEGRAL_COS_NX) THEN + DISCH_THEN(MP_TAC o SPEC `inv(sqrt pi) * c` o + MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LZERO] THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_INTEGRAL_UNIQUE; REAL_MUL_LZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* Shifting the origin for integration of periodic functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_PERIODIC_INTEGER_MULTIPLE = prove + (`!f:real->real a. + (!x. f(x + a) = f x) <=> (!x n. integer n ==> f(x + n * a) = f x)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[INTEGER_CLOSED; REAL_MUL_LID]] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x n. f(x + &n * a) = (f:real->real) x` ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; + REAL_ADD_ASSOC; REAL_MUL_LID]; + REWRITE_TAC[INTEGER_CASES] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_ARITH `(x + -- &n * a) + &n * a = x`]]);; + +let HAS_REAL_INTEGRAL_OFFSET = prove + (`!f i a b c. (f has_real_integral i) (real_interval[a,b]) + ==> ((\x. f(x + c)) has_real_integral i) + (real_interval[a - c,b - c])`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`&1`; `c:real`] o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY)) THEN + REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_LID; REAL_INV_1] THEN + REWRITE_TAC[REAL_ABS_1; REAL_MUL_LID; REAL_INV_1] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_REAL_INTERVAL; EXISTS_REFL; + REAL_ARITH `x - c:real = y <=> x = y + c`] THEN + REAL_ARITH_TAC);; + +let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_LEMMA = prove + (`!f i a b c. + (!x. f(x + (b - a)) = f(x)) /\ + (f has_real_integral i) (real_interval[a,a+c]) + ==> (f has_real_integral i) (real_interval[b,b+c])`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPEC `a - b:real` o MATCH_MP HAS_REAL_INTEGRAL_OFFSET) THEN + REWRITE_TAC[REAL_ARITH + `a - (a - b):real = b /\ (a + c) - (a - b) = b + c`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_EQ) THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + a - b:real`) THEN + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS = prove + (`!f i a b c. + (!x. f(x + (b - a)) = f x) /\ &0 <= c /\ a + c <= b /\ + (f has_real_integral i) (real_interval[a,b]) + ==> ((\x. f(x + c)) has_real_integral i) + (real_interval[a,b])`, + let tac = + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[a,b]` THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN CONJ_TAC THENL + [ASM_MESON_TAC[real_integrable_on]; ASM_REAL_ARITH_TAC] in + REPEAT STRIP_TAC THEN + CONJUNCTS_THEN SUBST1_TAC + (REAL_ARITH `a:real = (a + c) - c /\ b = (b + c) - c`) THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_OFFSET THEN + SUBGOAL_THEN + `((f has_real_integral (real_integral(real_interval[a,a+c]) f)) + (real_interval[a,a+c]) /\ + (f has_real_integral (real_integral(real_interval[a+c,b]) f)) + (real_interval[a+c,b])) /\ + ((f has_real_integral (real_integral(real_interval[a+c,b]) f)) + (real_interval[a+c,b]) /\ + (f has_real_integral (real_integral(real_interval[a,a+c]) f)) + (real_interval[b,b+c]))` + MP_TAC THENL + [REPEAT CONJ_TAC THEN TRY tac THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_LEMMA THEN + EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[] THEN tac; + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[TAUT `a /\ b /\ c /\ d ==> e <=> + c /\ d ==> a /\ b ==> e`] HAS_REAL_INTEGRAL_COMBINE))) THEN + REPEAT(ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN + ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; REAL_ADD_SYM]]);; + +let HAS_REAL_INTEGRAL_PERIODIC_OFFSET_WEAK = prove + (`!f i a b c. + (!x. f(x + (b - a)) = f x) /\ abs(c) <= b - a /\ + (f has_real_integral i) (real_interval[a,b]) + ==> ((\x. f(x + c)) has_real_integral i) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= c` THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`\x. (f:real->real)(--x)`; `i:real`; + `--b:real`; `--a:real`; `--c:real`] + HAS_REAL_INTEGRAL_PERIODIC_OFFSET_POS) THEN + ASM_REWRITE_TAC[REAL_NEG_ADD; HAS_REAL_INTEGRAL_REFLECT] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + X_GEN_TAC `x:real` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--x + (a - b):real`) THEN + REWRITE_TAC[REAL_ARITH `--(--a - --b):real = a - b`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN REAL_ARITH_TAC]);; + +let HAS_REAL_INTEGRAL_PERIODIC_OFFSET = prove + (`!f i a b c. + (!x. f(x + (b - a)) = f x) /\ + (f has_real_integral i) (real_interval[a,b]) + ==> ((\x. f(x + c)) has_real_integral i) (real_interval[a,b])`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC (REAL_ARITH `b <= a \/ a < b`) THEN + ASM_SIMP_TAC[HAS_REAL_INTEGRAL_NULL_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN + `((\x. f(x + (b - a) * frac(c / (b - a)))) has_real_integral i) + (real_interval[a,b])` + MP_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET_WEAK THEN + ASM_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `a < b /\ (b - a) * f < (b - a) * &1 + ==> abs(b - a) * f <= b - a`) THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_LMUL_EQ] THEN + ASM_REWRITE_TAC[real_abs; FLOOR_FRAC]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_EQ) THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN REWRITE_TAC[FRAC_FLOOR] THEN + ASM_SIMP_TAC[REAL_FIELD + `a < b ==> x + (b - a) * (c / (b - a) - f) = + (x + c) + --f * (b - a)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_PERIODIC_INTEGER_MULTIPLE]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[INTEGER_CLOSED; FLOOR]]);; + +let REAL_INTEGRABLE_PERIODIC_OFFSET = prove + (`!f a b c. + (!x. f(x + (b - a)) = f x) /\ + f real_integrable_on real_interval[a,b] + ==> (\x. f(x + c)) real_integrable_on real_interval[a,b]`, + REWRITE_TAC[real_integrable_on] THEN + MESON_TAC[HAS_REAL_INTEGRAL_PERIODIC_OFFSET]);; + +let ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET = prove + (`!f a b c. + (!x. f(x + (b - a)) = f x) /\ + f absolutely_real_integrable_on real_interval[a,b] + ==> (\x. f(x + c)) absolutely_real_integrable_on real_interval[a,b]`, + REWRITE_TAC[absolutely_real_integrable_on] THEN + REPEAT STRIP_TAC THEN + MP_TAC(GEN `f:real->real` (SPEC_ALL REAL_INTEGRABLE_PERIODIC_OFFSET)) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +let REAL_INTEGRAL_PERIODIC_OFFSET = prove + (`!f a b c. + (!x. f(x + (b - a)) = f x) /\ + f real_integrable_on real_interval[a,b] + ==> real_integral (real_interval[a,b]) (\x. f(x + c)) = + real_integral (real_interval[a,b]) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);; + +let FOURIER_OFFSET_TERM = prove + (`!f n t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) + ==> fourier_coefficient (\x. f(x + t)) (2 * n + 2) * + trigonometric_set (2 * n + 2) (&0) = + fourier_coefficient f (2 * n + 1) * + trigonometric_set (2 * n + 1) t + + fourier_coefficient f (2 * n + 2) * + trigonometric_set (2 * n + 2) t`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[trigonometric_set; fourier_coefficient; + orthonormal_coefficient] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; COS_0; REAL_MUL_RID] THEN + REWRITE_TAC[l2product] THEN + REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; GSYM REAL_INTEGRAL_RMUL; + FOURIER_PRODUCTS_INTEGRABLE_STRONG; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (a * c) * b`] THEN + REWRITE_TAC[REAL_MUL_SIN_SIN; REAL_MUL_COS_COS] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN + W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_ADD o + rand o rand o snd) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; real_div] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + ASM_REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[real_sub] THEN + MATCH_MP_TAC(REAL_ARITH + `abs x <= &1 /\ abs y <= &1 ==> abs((x + y) / &2) <= &1`) THEN + REWRITE_TAC[SIN_BOUND; COS_BOUND; REAL_ABS_NEG]]); + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH + `(cm - cp) / &2 * f + (cm + cp) / &2 * f = cm * f`] THEN + MP_TAC(ISPECL + [`\x. cos(&(n + 1) * (x - t)) * f x`; + `real_integral (real_interval[--pi,pi]) + (\x. cos(&(n + 1) * (x - t)) * f x)`; + `--pi`; `pi`; `t:real`] HAS_REAL_INTEGRAL_PERIODIC_OFFSET) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x. cos (&(n + 1) * (x - t)) * f x) real_integrable_on + real_interval[--pi,pi]` + MP_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; IN_UNIV; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC ODD_EVEN_INDUCT_LEMMA THEN + REWRITE_TAC[trigonometric_set; real_div] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + ASM_REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[COS_BOUND]]; + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_TAC] THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_ARITH + `n * ((x + &2 * pi) - t) = (&2 * n) * pi + n * (x - t)`] THEN + REWRITE_TAC[COS_ADD; SIN_NPI; COS_NPI; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_POW_NEG; REAL_MUL_LZERO; EVEN_MULT; ARITH] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_SUB_RZERO; REAL_MUL_LID]; + REWRITE_TAC[REAL_ARITH `(x + t) - t:real = x`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = a * c * b`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]);; + +let FOURIER_SUM_OFFSET = prove + (`!f n t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> sum(0..2*n) (\k. fourier_coefficient f k * + trigonometric_set k t) = + sum(0..2*n) (\k. fourier_coefficient (\x. f (x + t)) k * + trigonometric_set k (&0))`, + REPEAT STRIP_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN + BINOP_TAC THENL + [REWRITE_TAC[fourier_coefficient; trigonometric_set; l2product; + orthonormal_coefficient; REAL_MUL_LZERO; COS_0] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`\x:real. &1 / sqrt(&2 * pi) * f x`; + `--pi`; `pi`; `t:real`] REAL_INTEGRAL_PERIODIC_OFFSET) THEN + ASM_SIMP_TAC[REAL_ARITH `pi - --pi = &2 * pi`; REAL_INTEGRABLE_LMUL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; SUM_CLAUSES_NUMSEG; ARITH_EQ] THEN + SUBGOAL_THEN `1..2*n = 2*0+1..(2*(n-1)+1)+1` SUBST1_TAC THENL + [BINOP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_OFFSET; SUM_PAIR] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[ARITH_RULE `(k + 1) + 1 = k + 2`] THEN + ASM_SIMP_TAC[GSYM FOURIER_OFFSET_TERM] THEN + REWRITE_TAC[trigonometric_set; REAL_MUL_RZERO; COS_0; SIN_0] THEN + REAL_ARITH_TAC);; + +let FOURIER_SUM_OFFSET_UNPAIRED = prove + (`!f n t. + f absolutely_real_integrable_on real_interval [--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> sum(0..2*n) (\k. fourier_coefficient f k * + trigonometric_set k t) = + sum(0..n) (\k. fourier_coefficient (\x. f (x + t)) (2 * k) * + trigonometric_set (2 * k) (&0))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum(0..n) (\k. fourier_coefficient (\x. f (x + t)) (2 * k) * + trigonometric_set (2 * k) (&0) + + fourier_coefficient (\x. f (x + t)) (2 * k + 1) * + trigonometric_set (2 * k + 1) (&0))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_PAIR] THEN + REWRITE_TAC[GSYM ADD1; MULT_CLAUSES; SUM_CLAUSES_NUMSEG; LE_0]; + MATCH_MP_TAC SUM_EQ_NUMSEG THEN GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REAL_EQ_ADD_LCANCEL_0]] THEN + REWRITE_TAC[ADD1; trigonometric_set; real_div; REAL_MUL_RZERO] THEN + REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Express partial sums using Dirichlet kernel. *) +(* ------------------------------------------------------------------------- *) + +let dirichlet_kernel = new_definition + `dirichlet_kernel n x = + if x = &0 then &n + &1 / &2 + else sin((&n + &1 / &2) * x) / (&2 * sin(x / &2))`;; + +let DIRICHLET_KERNEL_0 = prove + (`!x. abs(x) < &2 * pi ==> dirichlet_kernel 0 x = &1 / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dirichlet_kernel] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_SYM; REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> inv(&2 * x) * x = inv(&2)`) THEN + DISCH_TAC THEN SUBGOAL_THEN `~(x * inv(&2) = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[] THEN MATCH_MP_TAC SIN_EQ_0_PI] THEN + ASM_REAL_ARITH_TAC);; + +let DIRICHLET_KERNEL_NEG = prove + (`!n x. dirichlet_kernel n (--x) = dirichlet_kernel n x`, + REPEAT GEN_TAC THEN REWRITE_TAC[dirichlet_kernel; REAL_NEG_EQ_0] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; real_div; SIN_NEG; + REAL_INV_NEG; REAL_NEG_NEG]);; + +let DIRICHLET_KERNEL_CONTINUOUS_STRONG = prove + (`!n. (dirichlet_kernel n) real_continuous_on + real_interval(--(&2 * pi),&2 * pi)`, + let lemma = prove + (`f real_differentiable (atreal a) /\ f(a) = b + ==> (f ---> b) (atreal a)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + MATCH_MP REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL) THEN + REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN ASM_MESON_TAC[]) in + SIMP_TAC[REAL_OPEN_REAL_INTERVAL; IN_REAL_INTERVAL; + REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[dirichlet_kernel] THEN ASM_CASES_TAC `x = &0` THENL + [ALL_TAC; + SUBGOAL_THEN + `(\x. sin((&k + &1 / &2) * x) / (&2 * sin(x / &2))) + real_continuous atreal x` + MP_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_DIV THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN + ASM_REWRITE_TAC[NETLIMIT_ATREAL] THEN ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `abs x` THEN + ASM_REAL_ARITH_TAC]] THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\x. sin((&k + &1 / &2) * x) / (&2 * sin(x / &2))` THEN + CONJ_TAC THENL + [SIMP_TAC[EVENTUALLY_ATREAL; REAL_ARITH + `&0 < abs(x - &0) <=> ~(x = &0)`] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]; + ALL_TAC] THEN + MATCH_MP_TAC LHOSPITAL THEN MAP_EVERY EXISTS_TAC + [`\x. (&k + &1 / &2) * cos((&k + &1 / &2) * x)`; + `\x. cos(x / &2)`; `&1`] THEN + REWRITE_TAC[REAL_LT_01; REAL_SUB_RZERO] THEN REPEAT STRIP_TAC THENL + [REAL_DIFF_TAC THEN REAL_ARITH_TAC; + REAL_DIFF_TAC THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI) THEN + MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC lemma THEN + REWRITE_TAC[REAL_MUL_RZERO; SIN_0] THEN REAL_DIFFERENTIABLE_TAC; + MATCH_MP_TAC lemma THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; real_div; SIN_0] THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_DIV_1] THEN + MATCH_MP_TAC REALLIM_DIV THEN + REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN CONJ_TAC THEN + MATCH_MP_TAC lemma THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; + real_div; COS_0; REAL_MUL_RID] THEN + REAL_DIFFERENTIABLE_TAC]);; + +let DIRICHLET_KERNEL_CONTINUOUS = prove + (`!n. (dirichlet_kernel n) real_continuous_on real_interval[--pi,pi]`, + GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval(--(&2 * pi),&2 * pi)` THEN + REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS_STRONG] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL = prove + (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\x. dirichlet_kernel n x * f x) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + ASM_REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS; ETA_AX; + REAL_CLOSED_REAL_INTERVAL]; + MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS; ETA_AX; + REAL_COMPACT_INTERVAL]]);; + +let COSINE_SUM_LEMMA = prove + (`!n x. (&1 / &2 + sum(1..n) (\k. cos(&k * x))) * sin(x / &2) = + sin((&n + &1 / &2) * x) / &2`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL + [ASM_REWRITE_TAC[REAL_ADD_LID; SUM_CLAUSES_NUMSEG; ARITH] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ADD_RID; REAL_MUL_SYM]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM SUM_RMUL] THEN + REWRITE_TAC[REAL_MUL_COS_SIN; real_div; REAL_SUB_RDISTRIB] THEN + SUBGOAL_THEN + `!k x. &k * x + x * inv(&2) = (&(k + 1) * x - x * inv(&2))` + (fun th -> REWRITE_TAC[th; SUM_DIFFS_ALT]) + THENL [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM real_div] THEN + REWRITE_TAC[REAL_ARITH `&1 * x - x / &2 = x / &2`] THEN + REWRITE_TAC[REAL_ARITH `(&n + &1) * x - x / &2 = (&n + &1 / &2) * x`] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN REAL_ARITH_TAC]);; + +let DIRICHLET_KERNEL_COSINE_SUM = prove + (`!n x. ~(x = &0) /\ abs(x) < &2 * pi + ==> dirichlet_kernel n x = &1 / &2 + sum(1..n) (\k. cos(&k * x))`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN + MATCH_MP_TAC(REAL_FIELD + `~(y = &0) /\ z * y = x / &2 ==> x / (&2 * y) = z`) THEN + REWRITE_TAC[COSINE_SUM_LEMMA] THEN + MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC);; + +let HAS_REAL_INTEGRAL_DIRICHLET_KERNEL = prove + (`!n. (dirichlet_kernel n has_real_integral pi) (real_interval[--pi,pi])`, + GEN_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\x. &1 / &2 + sum(1..n) (\k. cos(&k * x))` THEN + EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN + SIMP_TAC[REAL_ARITH `&0 < pi /\ --pi <= x /\ x <= pi ==> abs(x) < &2 * pi`; + DIRICHLET_KERNEL_COSINE_SUM; PI_POS] THEN + SUBGOAL_THEN `pi = pi + sum(1..n) (\k. &0)` MP_TAC THENL + [REWRITE_TAC[SUM_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `pi = (&1 / &2) * (pi - --pi)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MP_TAC(SPEC `k:num` HAS_REAL_INTEGRAL_COS_NX) THEN ASM_SIMP_TAC[LE_1]]);; + +let HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF = prove + (`!n. (dirichlet_kernel n has_real_integral (pi / &2)) + (real_interval[&0,pi])`, + GEN_TAC THEN + MP_TAC(ISPECL [`dirichlet_kernel n`; `--pi`; `pi`; `&0`; `pi`] + REAL_INTEGRABLE_SUBINTERVAL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MESON_TAC[HAS_REAL_INTEGRAL_DIRICHLET_KERNEL; real_integrable_on]; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC]; + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRAL] THEN DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [GSYM HAS_REAL_INTEGRAL_REFLECT]) THEN + REWRITE_TAC[DIRICHLET_KERNEL_NEG; ETA_AX; REAL_NEG_0] THEN DISCH_TAC THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[real_integrable_on]; ALL_TAC] THEN + MP_TAC(ISPECL + [`dirichlet_kernel n`; + `real_integral (real_interval [&0,pi]) (dirichlet_kernel n)`; + `real_integral (real_interval [&0,pi]) (dirichlet_kernel n)`; + `--pi`; `pi`; `&0`] HAS_REAL_INTEGRAL_COMBINE) THEN + ASM_REWRITE_TAC[GSYM REAL_MUL_2] THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + MATCH_MP_TAC(REAL_ARITH `x = pi ==> x = &2 * y ==> y = pi / &2`) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]);; + +let FOURIER_SUM_OFFSET_DIRICHLET_KERNEL = prove + (`!f n t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) = + real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * f(x + t)) / pi`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_UNPAIRED] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH] THEN + REWRITE_TAC[trigonometric_set; COS_0; REAL_MUL_LZERO] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `fourier_coefficient (\x. f(x + t)) 0 * &1 / sqrt(&2 * pi) + + sum (1..n) (\k. fourier_coefficient (\x. f(x + t)) (2 * k) / sqrt pi)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + SIMP_TAC[TRIGONOMETRIC_SET_EVEN; LE_1; REAL_MUL_RZERO; COS_0] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; + fourier_coefficient; orthonormal_coefficient; + trigonometric_set; l2product] THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [GSYM REAL_MUL_ASSOC; GSYM REAL_INTEGRAL_RMUL; GSYM REAL_INTEGRAL_ADD; + ABSOLUTELY_INTEGRABLE_COS_PRODUCT; + ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; + ABSOLUTELY_REAL_INTEGRABLE_LMUL; + TRIGONOMETRIC_SET_MUL_ABSOLUTELY_INTEGRABLE; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + GSYM REAL_INTEGRAL_SUM; FINITE_NUMSEG; + ABSOLUTELY_REAL_INTEGRABLE_RMUL; + ABSOLUTELY_REAL_INTEGRABLE_SUM; + ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL] THEN + MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; COS_0; REAL_ARITH + `a * b * c * b:real = (a * c) * b pow 2`] THEN + SIMP_TAC[REAL_POW_INV; SQRT_POW_2; REAL_LE_MUL; REAL_POS; PI_POS_LE; + REAL_LE_INV_EQ] THEN + REWRITE_TAC[REAL_INV_MUL; REAL_ARITH + `d * f * i = (&1 * f) * inv(&2) * i + y <=> i * f * (d - &1 / &2) = y`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(1..n) (\k. inv pi * f(x + t) * cos(&k * x))` THEN + CONJ_TAC THENL + [REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ARITH `x - &1 / &2 = y <=> x = &1 / &2 + y`] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[dirichlet_kernel] THENL + [REWRITE_TAC[REAL_MUL_RZERO; COS_0; SUM_CONST_NUMSEG; ADD_SUB] THEN + REAL_ARITH_TAC; + MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN + MATCH_MP_TAC(TAUT `a /\ b /\ ~d /\ (~c ==> e) + ==> (a /\ b /\ c ==> d) ==> e`) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + ASM_SIMP_TAC[REAL_FIELD + `~(y = &0) ==> (x / (&2 * y) = z <=> z * y = x / &2)`] THEN + REWRITE_TAC[COSINE_SUM_LEMMA]]; + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[TRIGONOMETRIC_SET_EVEN; LE_1] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_RING + `s * s:real = p ==> p * f * c = (c * s) * f * s`) THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; PI_POS_LE]]);; + +let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL = prove + (`!f t l. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> (((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> l) sequentially <=> + ((\n. real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * f(x + t))) + ---> pi * l) sequentially)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN + ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL] THEN + SUBGOAL_THEN `l = (l * pi) / pi` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SIMP_TAC[real_div; REALLIM_RMUL_EQ; PI_NZ; REAL_INV_EQ_0] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* A directly deduced sufficient condition for convergence at a point. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLE_FOURIER_CONVERGENCE_PERIODIC = prove + (`!f t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. (f(x + t) - f(t)) / sin(x / &2)) + absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> f(t)) sequentially`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN + MP_TAC(ISPECL [`\x. (f:real->real)(x) - f(t)`; `t:real`; `&0`] + FOURIER_SUM_LIMIT_DIRICHLET_KERNEL) THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + MATCH_MP_TAC(TAUT `(a ==> c) /\ b ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[FOURIER_COEFFICIENT_SUB; FOURIER_COEFFICIENT_CONST; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN + MATCH_MP_TAC(REAL_ARITH + `s:real = u /\ ft * t = x ==> (f0 - ft) * t + s = (f0 * t + u) - x`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LE_1; ARITH; REAL_SUB_RZERO]; + REWRITE_TAC[trigonometric_set; REAL_MUL_LZERO; COS_0] THEN + MATCH_MP_TAC(REAL_FIELD `&0 < s ==> (f * s) * &1 / s = f`) THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC]; + MP_TAC(ISPECL [`\x. (f:real->real)(x) - f(t)`; `t:real`; `&0`] + FOURIER_SUM_LIMIT_DIRICHLET_KERNEL) THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + SUBGOAL_THEN + `!n. real_integral (real_interval [--pi,pi]) + (\x. dirichlet_kernel n x * (f(x + t) - f(t))) = + real_integral (real_interval [--pi,pi]) + (\x. sin((&n + &1 / &2) * x) * + inv(&2) * (f(x + t) - f(t)) / sin(x / &2))` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN + MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* A more natural sufficient Hoelder condition at a point. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SIN_X2_ZEROS = prove + (`{x | sin(x / &2) = &0} = IMAGE (\n. &2 * pi * n) integer`, + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; SIN_EQ_0; REAL_ARITH + `y / &2 = n * pi <=> &2 * pi * n = y`] THEN + REWRITE_TAC[PI_NZ; REAL_RING + `&2 * pi * m = &2 * pi * n <=> pi = &0 \/ m = n`] THEN + MESON_TAC[IN]);; + +let HOELDER_FOURIER_CONVERGENCE_PERIODIC = prove + (`!f d M a t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ + &0 < d /\ &0 < a /\ + (!x. abs(x - t) < d ==> abs(f x - f t) <= M * abs(x - t) rpow a) + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> f t) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_FOURIER_CONVERGENCE_PERIODIC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !x. abs(x) < e + ==> abs((f (x + t) - f t) / sin (x / &2)) + <= &4 * abs M * abs(x) rpow (a - &1)` + STRIP_ASSUME_TAC THENL + [MP_TAC(REAL_DIFF_CONV + `((\x. sin(x / &2)) has_real_derivative w) (atreal (&0))`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COS_0; REAL_MUL_RID] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL; REALLIM_ATREAL] THEN + DISCH_THEN(MP_TAC o SPEC `&1 / &4`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SIN_0; REAL_SUB_RZERO] THEN DISCH_THEN + (X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN + EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `sin(x / &2) = &0` THENL + [ONCE_REWRITE_TAC[real_div] THEN ASM_REWRITE_TAC[REAL_INV_0] THEN + REWRITE_TAC[GSYM REAL_ABS_RPOW; GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_ADD_LID; + REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM REAL_ABS_RPOW; GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (REAL_ARITH + `abs(x - &1 / &2) < &1 / &4 ==> &1 / &4 <= abs(x)`)) THEN + SUBGOAL_THEN + `abs((f(x + t) - f t) / sin (x / &2)) = + abs(inv(sin(x / &2) / x)) * abs(f(x + t) - f t) / abs(x)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_INV] THEN + UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_ABS_POS; REAL_LE_DIV] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN + SUBST1_TAC(REAL_ARITH `&4 = inv(&1 / &4)`) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_ABS_NZ; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM REAL_POW_1] THEN + ASM_SIMP_TAC[GSYM RPOW_POW; GSYM RPOW_ADD; GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[REAL_ARITH `a - &1 + &1 = a`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `M * abs((x + t) - t) rpow a` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `(x + t) - t:real = x`] THEN + REWRITE_TAC[GSYM REAL_ABS_RPOW] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `real_bounded (IMAGE (\x. inv(sin(x / &2))) + (real_interval[--pi,pi] DIFF real_interval(--e,e)))` + MP_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_ATREAL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + DISCH_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN + SIMP_TAC[REAL_CLOSED_DIFF; REAL_CLOSED_REAL_INTERVAL; + REAL_OPEN_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN + REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET_DIFF]]; + SIMP_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_REAL_INTERVAL; IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN + MATCH_MP_TAC + REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x:real. max (B * abs(f(x + t) - f t)) + ((&4 * abs M) * abs(x) rpow (a - &1))` THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST]; + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[REAL_SIN_X2_ZEROS] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_LMUL; + ABSOLUTELY_REAL_INTEGRABLE_ABS; + ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + MP_TAC(ISPECL + [`\x. inv(a) * x rpow a`; `\x. x rpow (a - &1)`; `&0`; `pi`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN + REWRITE_TAC[PI_POS_LE] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_RPOW THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REAL_DIFF_TAC THEN + MAP_EVERY UNDISCH_TAC [`&0 < a`; `&0 < x`] THEN CONV_TAC REAL_FIELD]; + DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_REAL_INTEGRAL_INTEGRABLE)] THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE THEN + SIMP_TAC[RPOW_POS_LE; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[REAL_NEG_LE0; PI_POS_LE] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_NEG_NEG; REAL_NEG_0]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_INTEGRABLE_EQ)) THEN + SIMP_TAC[IN_REAL_INTERVAL; real_abs]; + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_CASES_TAC `abs(x) < e` THENL + [MATCH_MP_TAC(REAL_ARITH `x <= b ==> x <= max a b`) THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC]; + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= max a b`) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[GSYM real_div] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, a Lipschitz condition at the point. *) +(* ------------------------------------------------------------------------- *) + +let LIPSCHITZ_FOURIER_CONVERGENCE_PERIODIC = prove + (`!f d M t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ + &0 < d /\ (!x. abs(x - t) < d ==> abs(f x - f t) <= M * abs(x - t)) + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> f t) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOELDER_FOURIER_CONVERGENCE_PERIODIC THEN + MAP_EVERY EXISTS_TAC [`d:real`; `M:real`; `&1`] THEN + ASM_REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LT_01]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, if left and right derivatives both exist. *) +(* ------------------------------------------------------------------------- *) + +let BIDIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC = prove + (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ + f real_differentiable (atreal t within {x | t < x}) /\ + f real_differentiable (atreal t within {x | x < t}) + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> f t) sequentially`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[real_differentiable; HAS_REAL_DERIVATIVE_WITHINREAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `B1:real` (LABEL_TAC "1")) + (X_CHOOSE_THEN `B2:real` (LABEL_TAC "2"))) THEN + MATCH_MP_TAC LIPSCHITZ_FOURIER_CONVERGENCE_PERIODIC THEN + REMOVE_THEN "1" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN + REMOVE_THEN "2" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM; REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN + MAP_EVERY EXISTS_TAC [`min d1 d2:real`; `abs B1 + abs B2 + &1`] THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `x = t \/ t < x \/ x < t`) + THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_MUL_RZERO; REAL_LE_REFL]; + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_DIV; + REAL_ARITH `t < x ==> &0 < abs(x - t)`] THEN + REMOVE_THEN "1" (MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_ABS_DIV; + REAL_ARITH `x < t ==> &0 < abs(x - t)`] THEN + REMOVE_THEN "2" (MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* And in particular at points where the function is differentiable. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC = prove + (`!f t. f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ + f real_differentiable (atreal t) + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> f t) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC BIDIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + UNDISCH_TAC `f real_differentiable (atreal t)` THEN + REWRITE_TAC[real_differentiable] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Use reflection to halve the region of integration. *) +(* ------------------------------------------------------------------------- *) + +let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED = prove + (`!f n c. + f absolutely_real_integrable_on real_interval [--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) + ==> (\x. dirichlet_kernel n x * f(t + x)) + absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. dirichlet_kernel n x * f(t - x)) + absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. dirichlet_kernel n x * c) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THENL + [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + REWRITE_TAC[absolutely_real_integrable_on] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN + REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]]);; + +let ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART = prove + (`!f n d c. + f absolutely_real_integrable_on real_interval [--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ d <= pi + ==> (\x. dirichlet_kernel n x * f(t + x)) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. dirichlet_kernel n x * f(t - x)) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. dirichlet_kernel n x * c) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. dirichlet_kernel n x * (f(t + x) + f(t - x))) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. dirichlet_kernel n x * ((f(t + x) + f(t - x)) - c)) + absolutely_real_integrable_on real_interval[&0,d]`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP + ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED) ASSUME_TAC) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT + `(a /\ b /\ c) /\ (a /\ b /\ c ==> d /\ e) + ==> a /\ b /\ c /\ d /\ e`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN + ASM_REAL_ARITH_TAC; + SIMP_TAC[REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB; + ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_SUB]]);; + +let FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF = prove + (`!f n t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> sum(0..2*n) (\k. fourier_coefficient f k * trigonometric_set k t) - + l = + real_integral (real_interval[&0,pi]) + (\x. dirichlet_kernel n x * + ((f(t + x) + f(t - x)) - &2 * l)) / pi`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL] THEN + MATCH_MP_TAC(MATCH_MP (REAL_FIELD + `&0 < pi ==> x = y + pi * l ==> x / pi - l = y / pi`) PI_POS) THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD; + ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[MESON[REAL_ADD_SYM] + `dirichlet_kernel n x * f(x + t) = dirichlet_kernel n x * f(t + x)`] THEN + REWRITE_TAC[DIRICHLET_KERNEL_NEG; GSYM real_sub] THEN + MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF) THEN + DISCH_THEN(MP_TAC o SPEC `&2 * l` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN + REWRITE_TAC[REAL_ARITH `pi / &2 * &2 * l = pi * l`] THEN + DISCH_THEN(SUBST1_TAC o GSYM o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC(GSYM REAL_INTEGRAL_SUB) THEN + MP_TAC(GEN `c:real` (ISPECL [`f:real->real`; `n:num`; `pi`; `c:real`] + ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART)) THEN + ASM_REWRITE_TAC[REAL_LE_REFL; FORALL_AND_THM] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM REAL_ADD_LDISTRIB; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]);; + +let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_HALF = prove + (`!f t l. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> (((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> l) sequentially <=> + ((\n. real_integral (real_interval[&0,pi]) + (\x. dirichlet_kernel n x * + ((f(t + x) + f(t - x)) - &2 * l))) + ---> &0) sequentially)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN + GEN_REWRITE_TAC LAND_CONV [REALLIM_NULL] THEN + ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_RMUL_EQ THEN + MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Localization principle: convergence only depends on values "nearby". *) +(* ------------------------------------------------------------------------- *) + +let RIEMANN_LOCALIZATION_INTEGRAL = prove + (`!d f g. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + g absolutely_real_integrable_on real_interval[--pi,pi] /\ + &0 < d /\ (!x. abs(x) < d ==> f x = g x) + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * f(x)) - + real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * g(x))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * f(x)) - + real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * g(x)) = + real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * + (if abs(x) < d then &0 else f(x) - g(x)))` + (fun th -> REWRITE_TAC[th]) + THENL + [ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + GSYM REAL_INTEGRAL_SUB] THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN AP_TERM_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_ARITH `&0 = x - y <=> x = y`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * + (if abs x < d then &0 else f(x) - g(x))) = + real_integral (real_interval[--pi,pi]) + (\x. sin((&n + &1 / &2) * x) * + inv(&2) * + (if abs x < d then &0 else f(x) - g(x)) / + sin(x / &2))` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[dirichlet_kernel] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC]; + ALL_TAC] THEN + MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + SUBGOAL_THEN `real_bounded (IMAGE (\x. inv(sin(x / &2))) + (real_interval[--pi,pi] DIFF real_interval(--d,d)))` + MP_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_CONTINUOUS_INV THEN REWRITE_TAC[NETLIMIT_ATREAL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + DISCH_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN + SIMP_TAC[REAL_CLOSED_DIFF; REAL_CLOSED_REAL_INTERVAL; + REAL_OPEN_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN + REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET_DIFF]]; + SIMP_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_REAL_INTERVAL; IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN + MATCH_MP_TAC + REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x:real. B * abs(f(x) - g(x))` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN + ASM_SIMP_TAC[INTEGRABLE_IMP_REAL_MEASURABLE; REAL_MEASURABLE_ON_0; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + ABSOLUTELY_REAL_INTEGRABLE_SUB] THEN + SUBGOAL_THEN `{x | abs x < d} = real_interval(--d,d)` + (fun th -> REWRITE_TAC[th; REAL_LEBESGUE_MEASURABLE_INTERVAL]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + SUBGOAL_THEN `{x | sin(x / &2) = &0} = IMAGE (\n. &2 * pi * n) integer` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; SIN_EQ_0; REAL_ARITH + `y / &2 = n * pi <=> &2 * pi * n = y`] THEN + REWRITE_TAC[PI_NZ; REAL_RING + `&2 * pi * m = &2 * pi * n <=> pi = &0 \/ m = n`] THEN + MESON_TAC[IN]; + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ABS; + ABSOLUTELY_REAL_INTEGRABLE_SUB]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN COND_CASES_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ONCE_REWRITE_TAC[real_div] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]]);; + +let RIEMANN_LOCALIZATION_INTEGRAL_RANGE = prove + (`!d f. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + &0 < d /\ d <= pi + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\x. dirichlet_kernel n x * f(x)) - + real_integral (real_interval[--d,d]) + (\x. dirichlet_kernel n x * f(x))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPECL[`d:real`; `f:real->real`; + `\x. if x IN real_interval[--d,d] then f x else &0`] + RIEMANN_LOCALIZATION_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[MESON[] `(if p then if q then x else y else y) = + (if p /\ q then x else y)`] THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; GSYM IN_INTER] THEN + REWRITE_TAC[INTER; IN_REAL_INTERVAL] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 < d /\ d <= pi + ==> ((--pi <= x /\ x <= pi) /\ --d <= x /\ x <= d <=> + --d <= x /\ x <= d)`] THEN + REWRITE_TAC[GSYM real_interval] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC]; + REWRITE_TAC[MESON[REAL_MUL_RZERO] + `a * (if p then b else &0) = if p then a * b else &0`] THEN + SUBGOAL_THEN `real_interval[--d,d] SUBSET real_interval[--pi,pi]` + MP_TAC THENL + [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_INTEGRAL_RESTRICT th])]]);; + +let RIEMANN_LOCALIZATION = prove + (`!t d c f g. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + g absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ (!x. g(x + &2 * pi) = g(x)) /\ + &0 < d /\ (!x. abs(x - t) < d ==> f x = g x) + ==> (((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> c) sequentially <=> + ((\n. sum (0..n) + (\k. fourier_coefficient g k * trigonometric_set k t)) + ---> c) sequentially)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[FOURIER_SUM_LIMIT_DIRICHLET_KERNEL] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN + REWRITE_TAC[] THEN MATCH_MP_TAC RIEMANN_LOCALIZATION_INTEGRAL THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Localize the earlier integral. *) +(* ------------------------------------------------------------------------- *) + +let RIEMANN_LOCALIZATION_INTEGRAL_RANGE_HALF = prove + (`!d f. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + &0 < d /\ d <= pi + ==> ((\n. real_integral (real_interval[&0,pi]) + (\x. dirichlet_kernel n x * (f(x) + f(--x))) - + real_integral (real_interval[&0,d]) + (\x. dirichlet_kernel n x * (f(x) + f(--x)))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN MP_TAC + (SPECL [`d:real`; `f:real->real`] RIEMANN_LOCALIZATION_INTEGRAL_RANGE) THEN + MP_TAC(GEN `n:num` (ISPECL [`f:real->real`; `n:num`] + ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n. (\x. dirichlet_kernel n x * f x) absolutely_real_integrable_on + real_interval[--d,d]` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL) o SPEC `n:num`) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[DIRICHLET_KERNEL_NEG; GSYM REAL_ADD_LDISTRIB]]);; + +let FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART = prove + (`!f t l d. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ d <= pi + ==> (((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> l) sequentially <=> + ((\n. real_integral (real_interval[&0,d]) + (\x. dirichlet_kernel n x * + ((f(t + x) + f(t - x)) - &2 * l))) + ---> &0) sequentially)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_HALF] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN + REWRITE_TAC[REAL_ARITH `(x + y) - &2 * l = (x - l) + (y - l)`] THEN + MP_TAC(MESON[real_sub] `!x. (f:real->real)(t - x) = f(t + --x)`) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC RIEMANN_LOCALIZATION_INTEGRAL_RANGE_HALF THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]);; + +(* ------------------------------------------------------------------------- *) +(* Make a harmless simplifying tweak to the Dirichlet kernel. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND = prove + (`!f n s. real_integral s (\x. dirichlet_kernel n x * f x) = + real_integral s (\x. sin((&n + &1 / &2) * x) / (&2 * sin(x / &2)) * + f x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);; + +let REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND = prove + (`!f n s. (\x. dirichlet_kernel n x * f x) real_integrable_on s <=> + (\x. sin((&n + &1 / &2) * x) / (&2 * sin(x / &2)) * f x) + real_integrable_on s`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_SPIKE THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);; + +let FOURIER_SUM_LIMIT_SINE_PART = prove + (`!f t l d. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) /\ &0 < d /\ d <= pi + ==> (((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> l) sequentially <=> + ((\n. real_integral (real_interval[&0,d]) + (\x. sin((&n + &1 / &2) * x) * + ((f(t + x) + f(t - x)) - &2 * l) / x)) + ---> &0) sequentially)`, + let lemma0 = prove + (`!x. abs(sin(x) - x) <= abs(x) pow 3`, + GEN_TAC THEN MP_TAC(ISPECL [`0`; `Cx x`] TAYLOR_CSIN) THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; IM_CX] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_ABS_0] THEN + REWRITE_TAC[REAL_EXP_0; REAL_MUL_LID] THEN REAL_ARITH_TAC) in + let lemma1 = prove + (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= x pow 2`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs x` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM(CONJUNCT2 real_pow)] THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; ARITH] THEN + ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; REAL_MUL_RID] THEN + REWRITE_TAC[lemma0]) in + let lemma2 = prove + (`!x. abs(x) <= &1 / &2 ==> abs(x) / &2 <= abs(sin x)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` lemma0) THEN + MATCH_MP_TAC(REAL_ARITH + `&4 * x3 <= abs x ==> abs(s - x) <= x3 ==> abs(x) / &2 <= abs s`) THEN + REWRITE_TAC[REAL_ARITH + `&4 * x pow 3 <= x <=> x * x pow 2 <= x * (&1 / &2) pow 2`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN + ASM_REAL_ARITH_TAC) in + let lemma3 = prove + (`!x. ~(x = &0) /\ abs x <= &1 / &2 + ==> abs(inv(sin x) - inv x) <= &2 * abs x`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(sin x)` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ASM_CASES_TAC `sin x = &0` THENL + [MP_TAC(SPEC `x:real` SIN_EQ_0_PI) THEN + MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_SUB_LDISTRIB; REAL_MUL_RINV] THEN + REWRITE_TAC[REAL_ARITH `abs(&1 - s * inv x) = abs(s / x - &1)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(x:real) pow 2` THEN + ASM_SIMP_TAC[lemma1] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + MP_TAC(ISPEC `x:real` lemma2) THEN ASM_REAL_ARITH_TAC]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `d:real`] + FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN EXISTS_TAC + `\n. real_integral (real_interval[&0,d]) + (\x. sin((&n + &1 / &2) * x) * + (inv(&2 * sin(x / &2)) - inv x) * + ((f(t + x) + f(t - x)) - &2 * l))` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL + [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND] THEN + REWRITE_TAC[REAL_ARITH + `a * (inv y - inv x) * b:real = a / y * b - a / x * b`] THEN + REWRITE_TAC[REAL_ARITH `sin(y) * (a - b) / x = sin(y) / x * (a - b)`] THEN + MATCH_MP_TAC REAL_INTEGRAL_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST]; + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN + EXISTS_TAC `\x. dirichlet_kernel n x * (&2 * sin(x / &2)) / x * + ((f(t + x) + f(t - x)) - &2 * l)` THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL; REAL_MUL_ASSOC] THEN + STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_REWRITE_TAC[dirichlet_kernel] THEN + MATCH_MP_TAC(REAL_FIELD + `~(x = &0) /\ ~(y = &0) ==> a / x = a / (&2 * y) * (&2 * y) / x`) THEN + MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; SING_GSPEC] THEN + CONJ_TAC THEN MATCH_MP_TAC + REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + ALL_TAC]]] THEN + SUBGOAL_THEN `real_bounded (IMAGE (\x. &1 + (x / &2) pow 2) + (real_interval[--pi,pi]))` + MP_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[REAL_COMPACT_INTERVAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RID] THEN + ASM_REAL_ARITH_TAC; + REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(z - &1) <= y ==> abs(&1 + y) <= B ==> abs(z) <= B`) THEN + ASM_SIMP_TAC[REAL_FIELD + `~(x = &0) ==> (&2 * y) / x = y / (x / &2)`] THEN + MATCH_MP_TAC lemma1 THEN ASM_REAL_ARITH_TAC]]; + + SUBGOAL_THEN `real_interval[&0,d] SUBSET real_interval[--pi,pi]` + MP_TAC THENL + [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(fun th -> REWRITE_TAC + [GSYM(MATCH_MP REAL_INTEGRAL_RESTRICT th)])] THEN + REWRITE_TAC[MESON[REAL_MUL_LZERO; REAL_MUL_RZERO] + `(if p x then a x * b x * c x else &0) = + a x * (if p x then b x else &0) * c x`] THEN + MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN + REWRITE_TAC[REAL_MEASURABLE_ON_0; SET_RULE `{x | x IN s} = s`; + REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_SUB THEN CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN + SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; + REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; + REAL_CLOSED_UNIV] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[REAL_ARITH `&2 * x = &0 <=> x = &0`] THEN + REWRITE_TAC[REAL_SIN_X2_ZEROS] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[COUNTABLE_INTEGER]]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_bounded(IMAGE (\x. inv (&2 * sin (x / &2)) - inv x) + (real_interval[--pi,-- &1] UNION + real_interval[&1,pi]))` + MP_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + SIMP_TAC[REAL_COMPACT_INTERVAL; REAL_COMPACT_UNION] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC THEN MP_TAC(ISPEC `x / &2` SIN_EQ_0_PI) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_REAL_INTERVAL; IN_UNION] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `max B (&2)` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_CASES_TAC `abs(x) <= &1` THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_INV_0; SIN_0] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_INV_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(is - &2 * ix) <= &1 ==> abs(inv(&2) * is - ix) <= max B (&2)`) THEN + REWRITE_TAC[GSYM real_div] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) + [GSYM REAL_INV_DIV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * abs(x / &2)` THEN + CONJ_TAC THENL [MATCH_MP_TAC lemma3; ASM_REAL_ARITH_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Dini's test. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_DINI_TEST = prove + (`!f t l d. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) /\ + &0 < d /\ + (\x. abs((f(t + x) + f(t - x)) - &2 * l) / x) + real_integrable_on real_interval[&0,d] + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k t)) + ---> l) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `pi`] + FOURIER_SUM_LIMIT_SINE_PART) THEN + ASM_REWRITE_TAC[PI_POS; REAL_LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT) THEN + REWRITE_TAC[real_continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN + ASM_SIMP_TAC[IN_REAL_INTERVAL; REAL_LE_REFL; REAL_LT_IMP_LE] THEN + SIMP_TAC[REAL_INTEGRAL_NULL; REAL_LE_REFL] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ABBREV_TAC `dd = min d (min (k / &2) pi)` THEN + DISCH_THEN(MP_TAC o SPEC `dd:real`) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN ANTS_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < dd /\ dd <= d /\ dd <= pi /\ dd < k` + STRIP_ASSUME_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\x. ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on + real_interval[&0,dd]` + ASSUME_TAC THENL + [REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN + SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; + REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; + REAL_CLOSED_UNIV] THEN + MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`--pi`; `pi`] THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + REAL_INTEGRABLE_ADD; REAL_INTEGRABLE_SUB; + REAL_INTEGRABLE_CONST] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`&0:real`; `d:real`] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE + [TAUT `p ==> q ==> r <=> q ==> p ==> r`] + REAL_INTEGRABLE_SPIKE)) THEN + EXISTS_TAC `{}:real->bool` THEN REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY] THEN + SIMP_TAC[REAL_ABS_DIV; IN_REAL_INTERVAL; IN_DIFF] THEN + SIMP_TAC[real_abs]; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x. ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on + real_interval[dd,pi]` + ASSUME_TAC THENL + [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN + SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; + REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; + REAL_CLOSED_UNIV]; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN + EXISTS_TAC `inv dd:real` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL; REAL_ABS_INV] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `(!n. (\x. sin((&n + &1 / &2) * x) * + ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on + real_interval[&0,dd]) /\ + (!n. (\x. sin((&n + &1 / &2) * x) * + ((f(t + x) + f(t - x)) - &2 * l) / x) absolutely_real_integrable_on + real_interval[dd,pi])` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[SIN_BOUND]]); + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\x. if abs x < dd then &0 + else ((f:real->real)(t + x) - l) / x` + RIEMANN_LEBESGUE_SIN_HALF) THEN + SIMP_TAC[REAL_INTEGRAL_REFLECT_AND_ADD; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + FOURIER_PRODUCTS_INTEGRABLE_STRONG] THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[MESON[] `(if P x then if Q x then &0 else a x else &0) = + (if P x /\ ~Q x then a x else &0)`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + REWRITE_TAC[MESON[REAL_MUL_RZERO; REAL_MUL_LZERO] + `(if P x /\ Q x then a x * b x else &0) = + (if Q x then a x else &0) * (if P x then b x else &0)`] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; + ABSOLUTELY_REAL_INTEGRABLE_SUB; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_CASES THEN + REWRITE_TAC[REAL_MEASURABLE_ON_0] THEN CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_COMPL] THEN + REWRITE_TAC[REAL_ARITH `abs x < d <=> --d < x /\ x < d`] THEN + REWRITE_TAC[GSYM real_interval; REAL_LEBESGUE_MEASURABLE_INTERVAL]; + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN + SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; + REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; + REAL_CLOSED_UNIV]]; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + EXISTS_TAC `inv dd:real` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[REAL_NOT_LT] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_ABS_NUM; + REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_MUL_RNEG; SIN_NEG; REAL_MUL_LNEG] THEN + REWRITE_TAC[GSYM real_sub; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_ARITH + `(if p then &0 else a) - (if p then &0 else --b) = + (if p then &0 else a + b)`] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[MESON[REAL_MUL_RZERO] + `s * (if p then &0 else y) = (if ~p then s * y else &0)`] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[MESON[] + `(if p then if q then x else &0 else &0) = + (if p /\ q then x else &0)`] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 < dd /\ dd <= pi + ==> ((&0 <= x /\ x <= pi) /\ ~(abs x < dd) <=> + dd <= x /\ x <= pi)`] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL; REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[REAL_ARITH `(x - l) + (y - l) = (x + y) - &2 * l`] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `real_integral(real_interval[&0,dd]) f + + real_integral(real_interval[dd,pi]) f = + real_integral(real_interval[&0,pi]) f /\ + abs(real_integral(real_interval[&0,dd]) f) < e / &2 + ==> abs(real_integral(real_interval[dd,pi]) f - &0) < e / &2 + ==> abs(real_integral(real_interval[&0,pi]) f) < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `dd:real` THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_LT_IMP_LE]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs x < e / &2 ==> abs y <= x ==> abs y < e / &2`)) THEN + MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`&0`; `d:real`] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + SIMP_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ARITH + `&0 <= x ==> abs x = x`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_ABS_POS; SIN_BOUND]]]);; + +(* ------------------------------------------------------------------------- *) +(* Convergence for functions of bounded variation. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INTEGRAL_SIN_OVER_X_BOUND = prove + (`!a b c. + &0 <= a /\ &0 < c + ==> (\x. sin(c * x) / x) real_integrable_on real_interval[a,b] /\ + abs(real_integral (real_interval[a,b]) (\x. sin(c * x) / x)) <= &4`, + let lemma0 = prove + (`!a b. (\x. sin x) real_integrable_on (real_interval[a,b]) /\ + abs(real_integral (real_interval[a,b]) (\x. sin x)) <= &2`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a <= b` THENL + [MP_TAC(ISPECL [`\x. --(cos x)`; `\x. sin x`; `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REAL_ARITH_TAC; + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `abs x <= &1 /\ abs y <= &1 ==> abs(--y - --x) <= &2`) THEN + REWRITE_TAC[COS_BOUND]]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; + REAL_ABS_NUM; REAL_POS]]) in + let lemma1 = prove + (`!a b. &0 < a + ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\ + abs(real_integral (real_interval[a,b]) + (\x. sin x / x)) <= &4 / a`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a <= b` THENL + [MP_TAC(ISPECL [`\x. sin x`; `\x:real. --(inv x)`; `a:real`; `b:real`] + REAL_SECOND_MEAN_VALUE_THEOREM_FULL) THEN + ASM_REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; lemma0] THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_LE_NEG2; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `c:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_NEG) THEN + REWRITE_TAC[REAL_ARITH `--(--(inv y) * x):real = x / y`] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_NEG_NEG] THEN + MATCH_MP_TAC(REAL_ARITH + `inv b <= inv a /\ abs x <= inv a * &2 /\ abs y <= inv b * &2 + ==> abs(x + y) <= &4 / a`) THEN + ASM_SIMP_TAC[REAL_LE_INV2; REAL_ABS_MUL] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; lemma0] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_REFL; REAL_LE_INV_EQ] THEN + ASM_REAL_ARITH_TAC]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; + REAL_ABS_NUM; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC]) in + let lemma2 = prove + (`!x. &0 <= x ==> sin(x) <= x`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x <= &1` THENL + [ALL_TAC; ASM_MESON_TAC[SIN_BOUNDS; REAL_LE_TOTAL; REAL_LE_TRANS]] THEN + MP_TAC(ISPECL [`1`; `Cx x`] TAYLOR_CSIN) THEN + CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV; GSYM CX_NEG; + GSYM CX_ADD; GSYM CX_SUB] THEN + REWRITE_TAC[COMPLEX_NORM_CX; IM_CX; REAL_ABS_0; REAL_EXP_0] THEN + SIMP_TAC[REAL_POW_1; REAL_DIV_1; real_pow; + REAL_MUL_LNEG; REAL_MUL_LID] THEN + MATCH_MP_TAC(REAL_ARITH + `e <= t ==> abs(sin x - (x + --t)) <= e ==> sin x <= x`) THEN + ASM_REWRITE_TAC[real_abs; REAL_ARITH + `x pow 5 / &24 <= x pow 3 / &6 <=> + x pow 3 * x pow 2 <= x pow 3 * &2 pow 2`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_POW_LE] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC) in + let lemma3 = prove + (`!x. &0 <= x /\ x <= &2 ==> abs(sin x / x) <= &1`, + GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_SIMP_TAC[real_div; REAL_MUL_RZERO; REAL_INV_0; + REAL_ABS_NUM; REAL_POS]; + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_MUL_LID; + REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < abs x`] THEN + MATCH_MP_TAC(REAL_ARITH `s <= x /\ &0 <= s ==> abs s <= abs x`) THEN + ASM_SIMP_TAC[lemma2] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN + MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC]) in + let lemma4 = prove + (`!a b. &0 <= a /\ b <= &2 + ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\ + abs(real_integral (real_interval[a,b]) + (\x. sin x / x)) <= &2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL + [MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. &1):real->real` THEN + REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[lemma0]; + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[SING_GSPEC; REAL_NEGLIGIBLE_SING]]; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC lemma3 THEN ASM_REAL_ARITH_TAC]; + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval [a,b]) (\x. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC lemma3 THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN ASM_REAL_ARITH_TAC]]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; + REAL_ABS_NUM; REAL_POS]]) in + let lemma5 = prove + (`!a b. &0 <= a + ==> (\x. sin x / x) real_integrable_on real_interval[a,b] /\ + abs(real_integral (real_interval[a,b]) (\x. sin x / x)) <= &4`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `b <= &2` THENL + [ASM_MESON_TAC[lemma4; REAL_ARITH `x <= &2 ==> x <= &4`]; ALL_TAC] THEN + ASM_CASES_TAC `&2 <= a` THENL + [MP_TAC(SPECL [`a:real`; `b:real`] lemma1) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&2 <= a ==> &0 < a`] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + MP_TAC(ISPECL [`\x. sin x / x`; `a:real`; `b:real`; `&2`] + REAL_INTEGRABLE_COMBINE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[lemma4; REAL_LE_REFL]; + ASM_MESON_TAC[lemma1; REAL_ARITH `&0 < &2`]]; + DISCH_TAC] THEN + MP_TAC(ISPECL [`\x. sin x / x`; `a:real`; `b:real`; `&2`] + REAL_INTEGRAL_COMBINE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= &2 /\ abs(y) <= &2 ==> abs(x + y) <= &4`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[lemma4; REAL_LE_REFL]; + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &4 / &2`] THEN + ASM_MESON_TAC[lemma1; REAL_ARITH `&0 < &2`]]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL + [MP_TAC(ISPECL [`c * a:real`; `c * b:real`] lemma5) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_REAL_INTEGRAL_INTEGRAL] THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_REAL_INTEGRAL_STRETCH)) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ADD_RID; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN + ASM_SIMP_TAC[IMAGE_STRETCH_REAL_INTERVAL; REAL_LE_INV_EQ; REAL_LT_IMP_LE; + REAL_FIELD `&0 < c ==> inv c * c * a = a`; REAL_INV_MUL; real_div; + REAL_FIELD `&0 < c ==> c * s * inv c * inv x = s * inv x`; + REAL_FIELD `&0 < c ==> c * inv c * i = i /\ abs c = c`] THEN + REWRITE_TAC[GSYM real_div; REAL_INTERVAL_EQ_EMPTY] THEN + ASM_SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LMUL_EQ] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_INTEGRAL_NULL; REAL_LT_IMP_LE; + REAL_ABS_NUM; REAL_POS]]);; + +let FOURIER_JORDAN_BOUNDED_VARIATION = prove + (`!f x d. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) /\ + &0 < d /\ + f has_bounded_real_variation_on real_interval[x - d,x + d] + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k x)) + ---> ((reallim (atreal x within {l | l <= x}) f + + reallim (atreal x within {r | r >= x}) f) / &2)) + sequentially`, + let lemma = prove + (`!f l d. &0 < d + ==> ((f ---> l) (atreal (&0) within real_interval[&0,d]) <=> + (f ---> l) (atreal (&0) within {x | &0 <= x}))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_WITHINREAL_SET THEN + REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `d:real` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC) in + MAP_EVERY X_GEN_TAC [`f:real->real`; `t:real`; `d0:real`] THEN + STRIP_TAC THEN + ABBREV_TAC `s = (reallim (atreal t within {l | l <= t}) f + + reallim (atreal t within {r | r >= t}) f) / &2` THEN + MP_TAC(SPECL [`f:real->real`; `t:real`; `s:real`; `min d0 pi`] + FOURIER_SUM_LIMIT_SINE_PART) THEN + ASM_REWRITE_TAC[REAL_LT_MIN; PI_POS; REAL_ARITH `min d0 pi <= pi`] THEN + DISCH_THEN SUBST1_TAC THEN + ABBREV_TAC `h = \u. ((f:real->real)(t + u) + f(t - u)) - &2 * s` THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN ABBREV_TAC `d = min d0 pi` THEN + SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `h has_bounded_real_variation_on real_interval[&0,d]` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [HAS_BOUNDED_REAL_VARIATION_DARBOUX]) THEN + EXPAND_TAC "h" THEN REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_DARBOUX] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_REAL_INTERVAL] THEN + MAP_EVERY X_GEN_TAC [`f1:real->real`; `f2:real->real`] THEN STRIP_TAC THEN + EXISTS_TAC `\x. ((f1:real->real)(t + x) - f2(t - x)) - s` THEN + EXISTS_TAC `\x. ((f2:real->real)(t + x) - f1(t - x)) + s` THEN + ASM_REWRITE_TAC[REAL_ARITH `x - s <= y - s <=> x <= y`; REAL_LE_RADD] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `a <= a' /\ b' <= b ==> a - b <= a' - b'`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(h ---> &0) (atreal(&0) within {x | &0 <= x})` + ASSUME_TAC THENL + [EXPAND_TAC "h" THEN EXPAND_TAC "s" THEN + REWRITE_TAC[REAL_ARITH + `(f' + f) - &2 * (l + l') / &2 = (f - l) + (f' - l')`] THEN + MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL + [SUBGOAL_THEN + `?l. (f ---> l) (atreal t within {l | l <= t})` MP_TAC + THENL + [MP_TAC(ISPECL [`f:real->real`; `t - d0:real`; `t + d0:real`; `t:real`] + HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` (fun th -> + EXISTS_TAC `min d0 d1` THEN + CONJUNCTS_THEN2 ASSUME_TAC MP_TAC th)) THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SELECT_RULE) THEN + REWRITE_TAC[GSYM reallim] THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t - x:real` th)) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + REAL_ARITH_TAC]; + SUBGOAL_THEN + `?l. (f ---> l) (atreal t within {r | r >= t})` MP_TAC + THENL + [MP_TAC(ISPECL [`f:real->real`; `t - d0:real`; `t + d0:real`; `t:real`] + HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` (fun th -> + EXISTS_TAC `min d0 d1` THEN + CONJUNCTS_THEN2 ASSUME_TAC MP_TAC th)) THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SELECT_RULE) THEN + REWRITE_TAC[GSYM reallim] THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t + x:real` th)) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + REAL_ARITH_TAC]]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?k. &0 < k /\ k < d /\ + !n. (\x. sin ((&n + &1 / &2) * x) * h x / x) + real_integrable_on real_interval[&0,k] /\ + abs(real_integral (real_interval[&0,k]) + (\x. sin ((&n + &1 / &2) * x) * h x / x)) + <= e / &2` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `?h1 h2. + (!x y. x IN real_interval[&0,d] /\ y IN real_interval[&0,d] /\ x <= y + ==> h1 x <= h1 y) /\ + (!x y. x IN real_interval[&0,d] /\ y IN real_interval[&0,d] /\ x <= y + ==> h2 x <= h2 y) /\ + (h1 ---> &0) (atreal (&0) within {x | &0 <= x}) /\ + (h2 ---> &0) (atreal (&0) within {x | &0 <= x}) /\ + (!x. h x = h1 x - h2 x)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`h:real->real`; `&0`; `d:real`] + HAS_BOUNDED_REAL_VARIATION_DARBOUX) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h1:real->real`; `h2:real->real`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h1:real->real`; `&0`; `d:real`; `&0`] + INCREASING_RIGHT_LIMIT) THEN + ASM_REWRITE_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN + ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN + MP_TAC(ISPECL [`h2:real->real`; `&0`; `d:real`; `&0`] + INCREASING_RIGHT_LIMIT) THEN + ASM_REWRITE_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN + ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `l':real`) THEN + SUBGOAL_THEN `l':real = l` SUBST_ALL_TAC THENL + [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + MATCH_MP_TAC(ISPEC `atreal (&0) within {x | &0 <= x}` + REALLIM_UNIQUE) THEN + EXISTS_TAC `h:real->real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o + rand o snd) THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN + ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM; IN_SING] THEN + EXISTS_TAC `&1` THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REALLIM_SUB THEN + MAP_EVERY UNDISCH_TAC + [`(h1 ---> l) (atreal(&0) within real_interval[&0,d])`; + `(h2 ---> l') (atreal(&0) within real_interval[&0,d])`] THEN + ASM_SIMP_TAC[lemma]]; + EXISTS_TAC `\x. (h1:real->real)(x) - l` THEN + EXISTS_TAC `\x. (h2:real->real)(x) - l` THEN + ASM_REWRITE_TAC[REAL_ARITH `x - l <= y - l <=> x <= y`] THEN + ASM_REWRITE_TAC[GSYM REALLIM_NULL] THEN + MAP_EVERY UNDISCH_TAC + [`(h1 ---> l) (atreal(&0) within real_interval[&0,d])`; + `(h2 ---> l) (atreal(&0) within real_interval[&0,d])`] THEN + ASM_SIMP_TAC[lemma] THEN REPEAT DISCH_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `?k. &0 < k /\ k < d /\ abs(h1 k) < e / &16 /\ abs(h2 k) < e / &16` + MP_TAC THENL + [UNDISCH_TAC `(h2 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN + UNDISCH_TAC `(h1 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN + REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &16`) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC)] THEN + DISCH_THEN(MP_TAC o SPEC `e / &16`) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `min d (min k1 k2) / &2` THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`\x. sin((&n + &1 / &2) * x) / x`; `h1:real->real`; + `&0`; `k:real`; `&0`; `(h1:real->real) k`] + REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN + ASM_SIMP_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LE_REFL; REAL_ADD_LID; + REAL_ARITH `&0 < &n + &1 / &2`; REAL_MUL_LZERO] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + UNDISCH_TAC `(h1 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN + REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `--((h1:real->real) x)`) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `dd:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `min d (min x dd) / &2`)) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `h < &0 ==> h' <= h ==> ~(abs h' < --h)`)); + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `h * s / x:real = s * h / x`] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + DISCH_THEN(X_CHOOSE_THEN `c1:real` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL [`\x. sin((&n + &1 / &2) * x) / x`; `h2:real->real`; + `&0`; `k:real`; `&0`; `(h2:real->real) k`] + REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN + ASM_SIMP_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LE_REFL; REAL_ADD_LID; + REAL_ARITH `&0 < &n + &1 / &2`; REAL_MUL_LZERO] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + UNDISCH_TAC `(h2 ---> &0) (atreal (&0) within {x | &0 <= x})` THEN + REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `--((h2:real->real) x)`) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `dd:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `min d (min x dd) / &2`)) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `h < &0 ==> h' <= h ==> ~(abs h' < --h)`)); + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `h * s / x:real = s * h / x`] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + DISCH_THEN(X_CHOOSE_THEN `c2:real` STRIP_ASSUME_TAC)] THEN + REWRITE_TAC[REAL_ARITH + `s * (h - h') / x:real = s * h / x - s * h' / x`] THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_SUB; REAL_INTEGRAL_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= e / &16 * &4 /\ abs(y) <= e / &16 * &4 + ==> abs(x - y) <= e / &2`) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_SIMP_TAC[REAL_INTEGRAL_SIN_OVER_X_BOUND; REAL_LT_IMP_LE; + REAL_ARITH `&0 < &n + &1 / &2`]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `t:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [absolutely_real_integrable_on] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[GSYM absolutely_real_integrable_on; GSYM real_sub] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\x. h x / x) absolutely_real_integrable_on real_interval[k,d]` + ASSUME_TAC THENL + [REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + EXISTS_TAC `inv k:real` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC; + EXPAND_TAC "h" THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_ADD] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. (\x. sin((&n + &1 / &2) * x) * h x / x) absolutely_real_integrable_on + real_interval[k,d]` + ASSUME_TAC THENL + [GEN_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CLOSED_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[SIN_BOUND]]; + ALL_TAC] THEN + MP_TAC(ISPEC `\x. if k <= x /\ x <= d then h x / x else &0` + RIEMANN_LEBESGUE_SIN_HALF) THEN + REWRITE_TAC[absolutely_real_integrable_on] THEN + REWRITE_TAC[MESON[REAL_ABS_NUM] + `abs(if p then x else &0) = if p then abs x else &0`] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRAL_RESTRICT_UNIV; GSYM + REAL_INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[MESON[REAL_MUL_RZERO] + `(if P then s * (if Q then a else &0) else &0) = + (if P /\ Q then s * a else &0)`] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + REWRITE_TAC[MESON[] `(if P then if Q then x else &0 else &0) = + (if P /\ Q then x else &0)`] THEN + SUBGOAL_THEN `!x. (--pi <= x /\ x <= pi) /\ k <= x /\ x <= d <=> + k <= x /\ x <= d` + (fun th -> REWRITE_TAC[th]) + THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL; REAL_INTEGRAL_RESTRICT_UNIV; + REAL_INTEGRABLE_RESTRICT_UNIV] THEN + ASM_REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN + MATCH_MP_TAC(REAL_ARITH + `x + y = z ==> abs(x) <= e / &2 ==> abs(y) < e / &2 ==> abs(z) < e`) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `k:real` THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + ASM_REAL_ARITH_TAC);; + +let FOURIER_JORDAN_BOUNDED_VARIATION_SIMPLE = prove + (`!f x. f has_bounded_real_variation_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) + ==> ((\n. sum (0..n) + (\k. fourier_coefficient f k * trigonometric_set k x)) + ---> ((reallim (atreal x within {l | l <= x}) f + + reallim (atreal x within {r | r >= x}) f) / &2)) + sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FOURIER_JORDAN_BOUNDED_VARIATION THEN + EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [HAS_BOUNDED_REAL_VARIATION_DARBOUX]) THEN + STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INCREASING THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `!n. integer n + ==> f has_bounded_real_variation_on + real_interval [(&2 * n - &1) * pi,(&2 * n + &1) * pi]` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&2 * --n * pi` o + MATCH_MP HAS_BOUNDED_REAL_VARIATION_TRANSLATION) THEN + REWRITE_TAC[INTEGER_NEG; GSYM REAL_INTERVAL_TRANSLATION] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [REAL_PERIODIC_INTEGER_MULTIPLE]) THEN + DISCH_THEN(MP_TAC o GEN `x:real` o SPECL [`x:real`; `--n:real`]) THEN + ASM_REWRITE_TAC[REAL_ARITH `x + n * &2 * pi = &2 * n * pi + x`] THEN + ASM_REWRITE_TAC[INTEGER_NEG] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. f has_bounded_real_variation_on + real_interval[--pi,&(2 * n + 1) * pi]` + ASSUME_TAC THENL + [INDUCT_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID] THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `&((2 + 2 * n) + 1) * pi`; + `&(2 * n + 1) * pi`] + HAS_BOUNDED_REAL_VARIATION_ON_COMBINE) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_ARITH `--pi = --(&1) * pi`] THEN + SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_OF_NUM_LE] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_ARITH + `(&2 * n + &1) * pi = (&2 * (n + &1) - &1) * pi`] THEN + REWRITE_TAC[REAL_ARITH + `((&2 + &2 * n) + &1) * pi = (&2 * (n + &1) + &1) * pi`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n. f has_bounded_real_variation_on + real_interval[--(&(2 * m + 1)) * pi,&(2 * n + 1) * pi]` + ASSUME_TAC THENL + [INDUCT_TAC THEN + ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID; REAL_MUL_LNEG] THEN + X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`f:real->real`; `--(&((2 + 2 * m) + 1) * pi)`; + `&(2 * n + 1) * pi`; `--(&(2 * m + 1) * pi)`] + HAS_BOUNDED_REAL_VARIATION_ON_COMBINE) THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_OF_NUM_LE] THEN + REWRITE_TAC[REAL_LE_NEG2; REAL_ARITH `--a <= b <=> &0 <= a + b`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_ARITH + `--(&2 * m + &1) = &2 * --(m + &1) + &1`] THEN + REWRITE_TAC[REAL_ARITH + `--((&2 + &2 * m) + &1) = &2 * --(m + &1) - &1`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN SIMP_TAC[INTEGER_CLOSED]]; + ALL_TAC] THEN + MP_TAC(ISPEC `&2 * pi` REAL_ARCH) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `abs x + &3`) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MATCH_MP_TAC HAS_BOUNDED_REAL_VARIATION_ON_SUBSET THEN + EXISTS_TAC `real_interval[-- &(2 * N + 1) * pi,&(2 * N + 1) * pi]` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Cesaro summability of Fourier series using Fejer kernel. *) +(* ------------------------------------------------------------------------- *) + +let fejer_kernel = new_definition + `fejer_kernel n x = if n = 0 then &0 + else sum(0..n-1) (\r. dirichlet_kernel r x) / &n`;; + +let FEJER_KERNEL = prove + (`fejer_kernel n x = + if n = 0 then &0 + else if x = &0 then &n / &2 + else sin(&n / &2 * x) pow 2 / (&2 * &n * sin(x / &2) pow 2)`, + REWRITE_TAC[fejer_kernel; dirichlet_kernel] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[SUM_0] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[SUM_ADD_NUMSEG; SUM_CONST_NUMSEG; + REWRITE_RULE[ETA_AX] SUM_NUMBERS] THEN + ASM_SIMP_TAC[SUB_ADD; GSYM REAL_OF_NUM_SUB; LE_1; SUB_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM REAL_OF_NUM_EQ]) THEN + CONV_TAC REAL_FIELD; + ALL_TAC] THEN + ASM_CASES_TAC `sin(x / &2) = &0` THENL + [ASM_REWRITE_TAC[REAL_POW_ZERO; ARITH_EQ; REAL_MUL_RZERO; real_div; + REAL_INV_0; SUM_0; REAL_MUL_LZERO]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_FIELD + `~(n = &0) /\ ~(s = &0) /\ &2 * s pow 2 * l = r + ==> l / n = r / (&2 * n * s pow 2)`) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_EQ; GSYM SUM_LMUL] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(s = &0) ==> &2 * s pow 2 * a / (&2 * s) = s * a`] THEN + REWRITE_TAC[REAL_MUL_SIN_SIN] THEN + REWRITE_TAC[REAL_ARITH `x / &2 - (&n + &1 / &2) * x = --(&n * x)`; + REAL_ARITH `x / &2 + (&n + &1 / &2) * x = (&n + &1) * x`] THEN + REWRITE_TAC[real_div; SUM_RMUL; COS_NEG; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[SUM_DIFFS; LE_0; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[SUB_ADD; LE_1; REAL_SUB_COS] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; real_div; REAL_MUL_AC] THEN + REAL_ARITH_TAC);; + +let FEJER_KERNEL_CONTINUOUS_STRONG = prove + (`!n. (fejer_kernel n) real_continuous_on + real_interval(--(&2 * pi),&2 * pi)`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[fejer_kernel] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; DIRICHLET_KERNEL_CONTINUOUS_STRONG]);; + +let FEJER_KERNEL_CONTINUOUS = prove + (`!n. (fejer_kernel n) real_continuous_on real_interval[--pi,pi]`, + GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval(--(&2 * pi),&2 * pi)` THEN + REWRITE_TAC[FEJER_KERNEL_CONTINUOUS_STRONG] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL = prove + (`!f n. f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\x. fejer_kernel n x * f x) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + ASM_REWRITE_TAC[FEJER_KERNEL_CONTINUOUS; ETA_AX; + REAL_CLOSED_REAL_INTERVAL]; + MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[FEJER_KERNEL_CONTINUOUS; ETA_AX; + REAL_COMPACT_INTERVAL]]);; + +let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED = prove + (`!f n c. + f absolutely_real_integrable_on real_interval [--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) + ==> (\x. fejer_kernel n x * f(t + x)) + absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. fejer_kernel n x * f(t - x)) + absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. fejer_kernel n x * c) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL THENL + [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + REWRITE_TAC[absolutely_real_integrable_on] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN + REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]]);; + +let ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART = prove + (`!f n d c. + f absolutely_real_integrable_on real_interval [--pi,pi] /\ + (!x. f(x + &2 * pi) = f(x)) /\ d <= pi + ==> (\x. fejer_kernel n x * f(t + x)) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. fejer_kernel n x * f(t - x)) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. fejer_kernel n x * c) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. fejer_kernel n x * (f(t + x) + f(t - x))) + absolutely_real_integrable_on real_interval[&0,d] /\ + (\x. fejer_kernel n x * ((f(t + x) + f(t - x)) - c)) + absolutely_real_integrable_on real_interval[&0,d]`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP + ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED) ASSUME_TAC) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT + `(a /\ b /\ c) /\ (a /\ b /\ c ==> d /\ e) + ==> a /\ b /\ c /\ d /\ e`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN MP_TAC PI_POS THEN + ASM_REAL_ARITH_TAC; + SIMP_TAC[REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB; + ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_SUB]]);; + +let FOURIER_SUM_OFFSET_FEJER_KERNEL_HALF = prove + (`!f n t. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) /\ + 0 < n + ==> sum(0..n-1) (\r. sum (0..2*r) + (\k. fourier_coefficient f k * + trigonometric_set k t)) / &n - l = + real_integral (real_interval[&0,pi]) + (\x. fejer_kernel n x * + ((f(t + x) + f(t - x)) - &2 * l)) / pi`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LE_1; REAL_OF_NUM_EQ; REAL_FIELD + `~(n = &0) ==> (x / n - l = y <=> x - n * l = n * y)`] THEN + MP_TAC(ISPECL [`l:real`; `0`; `n - 1`] SUM_CONST_NUMSEG) THEN + ASM_SIMP_TAC[SUB_ADD; LE_1; SUB_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN + ASM_SIMP_TAC[FOURIER_SUM_OFFSET_DIRICHLET_KERNEL_HALF] THEN + REWRITE_TAC[real_div; SUM_RMUL; REAL_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) REAL_INTEGRAL_SUM o lhand o snd) THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_DIRICHLET_KERNEL_REFLECTED_PART; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + FINITE_NUMSEG; REAL_LE_REFL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SUM_RMUL] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_LMUL; REAL_LE_REFL; + ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + ASM_SIMP_TAC[fejer_kernel; LE_1] THEN MATCH_MP_TAC(REAL_FIELD + `~(n = &0) ==> s * f = n * s / n * f`) THEN + ASM_SIMP_TAC[LE_1; REAL_OF_NUM_EQ]);; + +let FOURIER_SUM_LIMIT_FEJER_KERNEL_HALF = prove + (`!f t l. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f (x + &2 * pi) = f x) + ==> (((\n. sum(0..n-1) (\r. sum (0..2*r) + (\k. fourier_coefficient f k * + trigonometric_set k t)) / &n) + ---> l) sequentially <=> + ((\n. real_integral (real_interval[&0,pi]) + (\x. fejer_kernel n x * + ((f(t + x) + f(t - x)) - &2 * l))) + ---> &0) sequentially)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM FOURIER_SUM_LIMIT_PAIR] THEN + GEN_REWRITE_TAC LAND_CONV [REALLIM_NULL] THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REALLIM_NULL_RMUL_EQ PI_NZ)] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EQ THEN MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + ASM_SIMP_TAC[FOURIER_SUM_OFFSET_FEJER_KERNEL_HALF; LE_1] THEN + ASM_SIMP_TAC[PI_POS; REAL_LT_IMP_NZ; REAL_DIV_RMUL; REAL_SUB_REFL]);; + +let HAS_REAL_INTEGRAL_FEJER_KERNEL = prove + (`!n. (fejer_kernel n has_real_integral (if n = 0 then &0 else pi)) + (real_interval[--pi,pi])`, + GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[fejer_kernel] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0] THEN + SUBGOAL_THEN `pi = sum(0..n-1) (\r. pi) / &n` + (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) + THENL + [ASM_SIMP_TAC[SUM_CONST_NUMSEG; SUB_ADD; LE_1; SUB_0] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]]);; + +let HAS_REAL_INTEGRAL_FEJER_KERNEL_HALF = prove + (`!n. (fejer_kernel n has_real_integral (if n = 0 then &0 else pi / &2)) + (real_interval[&0,pi])`, + GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[fejer_kernel] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0] THEN + SUBGOAL_THEN `pi / &2 = sum(0..n-1) (\r. pi / &2) / &n` + (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) + THENL + [ASM_SIMP_TAC[SUM_CONST_NUMSEG; SUB_ADD; LE_1; SUB_0] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM REAL_OF_NUM_EQ]) THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[FINITE_NUMSEG; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL_HALF]]);; + +let FEJER_KERNEL_POS_LE = prove + (`!n x. &0 <= fejer_kernel n x`, + REPEAT GEN_TAC THEN REWRITE_TAC[FEJER_KERNEL] THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV]) THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_POW_2] THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS]) THEN + REWRITE_TAC[REAL_LE_POW_2]);; + +let FOURIER_FEJER_CESARO_SUMMABLE = prove + (`!f x l r. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) /\ + (f ---> l) (atreal x within {x' | x' <= x}) /\ + (f ---> r) (atreal x within {x' | x' >= x}) + ==> ((\n. sum(0..n-1) (\m. sum (0..2*m) + (\k. fourier_coefficient f k * + trigonometric_set k x)) / &n) + ---> (l + r) / &2) + sequentially`, + MAP_EVERY X_GEN_TAC [`f:real->real`; `t:real`; `l:real`; `r:real`] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FOURIER_SUM_LIMIT_FEJER_KERNEL_HALF] THEN + REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN + ABBREV_TAC `h = \u. ((f:real->real)(t + u) + f(t - u)) - (l + r)` THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `(h ---> &0) (atreal(&0) within {x | &0 <= x})` + ASSUME_TAC THENL + [EXPAND_TAC "h" THEN REWRITE_TAC[REAL_ARITH + `(f' + f) - (l + l'):real = (f - l) + (f' - l')`] THEN + MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL + [UNDISCH_TAC `(f ---> l) (atreal t within {x' | x' <= t})` THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t - x:real` th)) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + REAL_ARITH_TAC; + UNDISCH_TAC `(f ---> r) (atreal t within {x' | x' >= t})` THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d1:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + X_GEN_TAC `x:real` THEN MP_TAC(SPEC `t + x:real` th)) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?k. &0 < k /\ k < pi /\ + (!x. &0 < x /\ x <= k ==> abs(h x) < e / &2 / pi)` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(h ---> &0) (atreal (&0) within {x | &0 <= x})` THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / pi`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; PI_POS; IN_ELIM_THM; REAL_SUB_RZERO; + LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:real` THEN STRIP_TAC THEN EXISTS_TAC `min k pi / &2` THEN + REPEAT(CONJ_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\n. real_integral (real_interval[k,pi]) + (\x. fejer_kernel n x * h x)) + ---> &0) sequentially` + MP_TAC THENL + [MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC + `\n. real_integral (real_interval[k,pi]) + (\x. abs(h x) / (&2 * sin(x / &2) pow 2)) / &n` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[REALLIM_1_OVER_N]] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[FEJER_KERNEL; LE_1] THEN + SUBGOAL_THEN + `(\x. h x / (&2 * sin(x / &2) pow 2)) + absolutely_real_integrable_on real_interval[k,pi]` + MP_TAC THENL + [REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS; + MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[REAL_COMPACT_INTERVAL]; + EXPAND_TAC "h" THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]; + REWRITE_TAC[real_sub; absolutely_real_integrable_on] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[GSYM absolutely_real_integrable_on] THEN + REWRITE_TAC[real_sub; REAL_NEG_NEG] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]]; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]] THEN + (REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[REAL_RING `&2 * x pow 2 = &0 <=> x = &0`] THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC SIN_POS_PI THEN + ASM_REAL_ARITH_TAC]); + DISCH_THEN(fun th -> ASSUME_TAC th THEN + MP_TAC(MATCH_MP ABSOLUTELY_REAL_INTEGRABLE_ABS th)) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_POW2_ABS] THEN DISCH_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [real_div] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_RMUL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_RMUL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_ABS_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1 * y`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; ABS_SQUARE_LE_1; SIN_BOUND] THEN + MATCH_MP_TAC(REAL_ARITH `x = y /\ &0 <= x ==> abs x <= y`) THEN + REWRITE_TAC[GSYM real_div; REAL_LE_INV_EQ] THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_POW_2] THEN + REWRITE_TAC[REAL_MUL_AC]; + DISCH_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. abs(h x) / (&2 * sin(x / &2) pow 2) * inv(&n)` THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_RMUL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN + EXISTS_TAC + `\x. sin(&n / &2 * x) pow 2 / (&2 * &n * sin(x / &2) pow 2) * h(x)` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `s * t * n * i * h:real = n * s * h * (t * i)`] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; ABS_SQUARE_LE_1; SIN_BOUND]]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `MAX 1 N` THEN + X_GEN_TAC `n:num` THEN + REWRITE_TAC[ARITH_RULE `MAX a b <= x <=> a <= x /\ b <= x`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\x. fejer_kernel n x * h x`; `&0`; `pi`; `k:real`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "h" THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + REAL_LE_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `abs x <= e / &2 ==> x + y = z ==> abs y < e / &2 ==> abs z < e`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,k]) + (\x. fejer_kernel n x * e / &2 / pi)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `real_integral (real_interval [&0,k]) (\x. fejer_kernel n x * h x) = + real_integral (real_interval [&0,k]) + (\x. fejer_kernel n x * (if x = &0 then &0 else h x))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{&0}` THEN SIMP_TAC[IN_DIFF; IN_SING] THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC [`\x. fejer_kernel n x * h x`; `{&0}`] THEN + SIMP_TAC[IN_DIFF; IN_SING; REAL_NEGLIGIBLE_SING] THEN + EXPAND_TAC "h" THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + REAL_LT_IMP_LE]; + MP_TAC(ISPECL + [`\x:real. e / &2 / pi`; `n:num`; `k:real`; `&0`] + ABSOLUTELY_REAL_INTEGRABLE_MUL_FEJER_KERNEL_REFLECTED_PART) THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST; REAL_LT_IMP_LE; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + REWRITE_TAC[FEJER_KERNEL_POS_LE] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_NUM; REAL_POS; + PI_POS_LE; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]; + MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_FEJER_KERNEL_HALF) THEN + ASM_SIMP_TAC[LE_1] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `real_integral (real_interval[&0,pi]) + (\x. fejer_kernel n x * e / &2 / pi)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[&0,pi]` THEN CONJ_TAC THENL + [ASM_MESON_TAC[real_integrable_on]; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[real_integrable_on]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[FEJER_KERNEL_POS_LE] THEN + REPEAT(MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC) THEN + MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC]; + FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / pi`) THEN + SIMP_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + REPEAT STRIP_TAC THEN SIMP_TAC[PI_POS; REAL_FIELD + `&0 < pi ==> pi / &2 * e / &2 / pi = e / &4`] THEN + ASM_REAL_ARITH_TAC]]);; + +let FOURIER_FEJER_CESARO_SUMMABLE_SIMPLE = prove + (`!f x l r. + f real_continuous_on (:real) /\ (!x. f(x + &2 * pi) = f x) + ==> ((\n. sum(0..n-1) (\m. sum (0..2*m) + (\k. fourier_coefficient f k * + trigonometric_set k x)) / &n) + ---> f(x)) + sequentially`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [REAL_ARITH `x = (x + x) / &2`] THEN + MATCH_MP_TAC FOURIER_FEJER_CESARO_SUMMABLE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS THEN + ASM_MESON_TAC[REAL_CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + CONJ_TAC THEN MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_ATREAL] THEN + ASM_MESON_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; + IN_UNIV]]);; diff --git a/100/friendship.ml b/100/friendship.ml new file mode 100644 index 0000000..ffc33cd --- /dev/null +++ b/100/friendship.ml @@ -0,0 +1,753 @@ +(* ========================================================================= *) +(* The friendship theorem. *) +(* *) +(* Proof from "Combinatorics Tutorial 2: Friendship Theorem", copyright *) +(* MathOlymp.com, 2001. Apparently due to J. Q. Longyear and T. D. Parsons. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; + +(* ------------------------------------------------------------------------- *) +(* Useful inductive breakdown principle ending at gcd. *) +(* ------------------------------------------------------------------------- *) + +let GCD_INDUCT = prove + (`!P. (!m n. P m /\ P (m + n) ==> P n) + ==> !m n. P m /\ P n ==> P (gcd(m,n))`, + GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN + WF_INDUCT_TAC `m + n:num` THEN REPEAT(POP_ASSUM MP_TAC) THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`n:num`; `m:num`] THEN + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [REWRITE_TAC[CONJ_ACI; GCD_SYM; ADD_SYM]; REPEAT STRIP_TAC] THEN + ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[GCD_0]; ALL_TAC] THEN + UNDISCH_TAC `!m n:num. P m /\ P (m + n) ==> P n` THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n - m:num`]) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[SUB_ADD; LT_IMP_LE] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n - m:num`]) THEN + REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ADD_SUB2; GCD_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* General theorems about loops in a sequence. *) +(* ------------------------------------------------------------------------- *) + +let LOOP_GCD = prove + (`!x m n. (!i. x(i + m) = x(i)) /\ (!i. x(i + n) = x(i)) + ==> !i. x(i + gcd(m,n)) = x(i)`, + GEN_TAC THEN MATCH_MP_TAC GCD_INDUCT THEN MESON_TAC[ADD_AC]);; + +let LOOP_COPRIME = prove + (`!x m n. (!i. x(i + m) = x(i)) /\ (!i. x(i + n) = x(i)) /\ coprime(m,n) + ==> !i. x i = x 0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN REWRITE_TAC[ADD1] THEN + ASM_MESON_TAC[LOOP_GCD; COPRIME_GCD]);; + +(* ------------------------------------------------------------------------- *) +(* General theorem about partition into equally-sized eqv classes. *) +(* ------------------------------------------------------------------------- *) + +let EQUIVALENCE_UNIFORM_PARTITION = prove + (`!R s k. FINITE s /\ + (!x. x IN s ==> R x x) /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x:A. x IN s ==> CARD {y | y IN s /\ R x y} = k) + ==> k divides (CARD s)`, + REPEAT GEN_TAC THEN + WF_INDUCT_TAC `CARD(s:A->bool)` THEN + ASM_CASES_TAC `s:A->bool = {}` THENL + [ASM_MESON_TAC[CARD_CLAUSES; DIVIDES_0]; REPEAT STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:A | y IN s /\ ~(R (a:A) y)}`) THEN + REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_PSUBSET THEN + ASM_SIMP_TAC[PSUBSET; SUBSET; EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ANTE_RES_THEN MP_TAC) ASSUME_TAC) THEN + DISCH_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN ASM SET_TAC[]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `CARD(s) = CARD {y | y IN s /\ (R:A->A->bool) a y} + + CARD {y | y IN s /\ ~(R a y)}` + (fun th -> ASM_SIMP_TAC[th; DIVIDES_ADD; DIVIDES_REFL]) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* With explicit restricted quantification. *) +(* ------------------------------------------------------------------------- *) + +let EQUIVALENCE_UNIFORM_PARTITION_RESTRICT = prove + (`!R s k. FINITE s /\ + (!x. x IN s ==> R x x) /\ + (!x y. x IN s /\ y IN s /\ R x y ==> R y x) /\ + (!x y z. x IN s /\ y IN s /\ z IN s /\ R x y /\ R y z ==> R x z) /\ + (!x:A. x IN s ==> CARD {y | y IN s /\ R x y} = k) + ==> k divides (CARD s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQUIVALENCE_UNIFORM_PARTITION THEN + EXISTS_TAC `\x y:A. x IN s /\ y IN s /\ R x y` THEN + SIMP_TAC[] THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* General theorem about pairing up elements of a set. *) +(* ------------------------------------------------------------------------- *) + +let ELEMENTS_PAIR_UP = prove + (`!s r. FINITE s /\ + (!x. x IN s ==> ~(r x x)) /\ + (!x y. x IN s /\ y IN s /\ r x y ==> r y x) /\ + (!x:A. x IN s ==> ?!y. y IN s /\ r x y) + ==> EVEN(CARD s)`, + REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(s:A->bool)` THEN + STRIP_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THEN + ASM_REWRITE_TAC[CARD_CLAUSES; ARITH] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + MP_TAC(ASSUME `!x:A. x IN s ==> (?!y:A. y IN s /\ r x y)`) THEN + DISCH_THEN(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ASSUME `a:A IN s`] THEN + DISCH_THEN(MP_TAC o EXISTENCE) THEN + DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A) DELETE b`) THEN + REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL + [ALL_TAC; + DISCH_TAC THEN + SUBGOAL_THEN `s = (a:A) INSERT b INSERT (s DELETE a DELETE b)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; FINITE_INSERT] THEN + REWRITE_TAC[IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[EVEN]] THEN + ASM_SIMP_TAC[FINITE_DELETE; IN_DELETE] THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + MP_TAC(ASSUME `!x:A. x IN s ==> (?!y. y IN s /\ r x y)`) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN REWRITE_TAC[ASSUME `x:A IN s`] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `y:A` THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cycles and paths. *) +(* ------------------------------------------------------------------------- *) + +let cycle = new_definition + `cycle r k x <=> (!i. r (x i) (x(i + 1))) /\ (!i. x(i + k) = x(i))`;; + +let path = new_definition + `path r k x <=> (!i. i < k ==> r (x i) (x(i + 1))) /\ + (!i. k < i ==> x(i) = @x. T)`;; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about these concepts. *) +(* ------------------------------------------------------------------------- *) + +let CYCLE_OFFSET = prove + (`!r k x:num->A. cycle r k x ==> !i m. x(m * k + i) = x(i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cycle] THEN STRIP_TAC THEN GEN_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + ASM_MESON_TAC[ADD_AC]);; + +let CYCLE_MOD = prove + (`!r k x:num->A. cycle r k x /\ ~(k = 0) ==> !i. x(i MOD k) = x(i)`, + MESON_TAC[CYCLE_OFFSET; DIVISION]);; + +let PATHS_MONO = prove + (`(!x y. r x y ==> s x y) ==> {x | path r k x} SUBSET {x | path s k x}`, + REWRITE_TAC[path; IN_ELIM_THM; SUBSET] THEN MESON_TAC[]);; + +let HAS_SIZE_PATHS = prove + (`!N m r k. (:A) HAS_SIZE N /\ (!x. {y | r x y} HAS_SIZE m) + ==> {x:num->A | path r k x} HAS_SIZE (N * m EXP k)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_CLAUSES] THENL + [SUBGOAL_THEN `{x:num->A | path r 0 x} = + IMAGE (\a i. if i = 0 then a else @x. T) (:A)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV; path; LT] THEN + REWRITE_TAC[FUN_EQ_THM; LT_NZ] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:num->A | path r (SUC k) x} = + IMAGE (\(x,a) i. if i = SUC k then a else x i) + {x,a | x IN {x | path r k x} /\ a IN {u | r (x k) u}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN + X_GEN_TAC `x:num->A` THEN REWRITE_TAC[PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REWRITE_TAC[FUN_EQ_THM; path; LT] THEN EQ_TAC THENL + [STRIP_TAC THEN EXISTS_TAC `\i. if i = SUC k then @x. T else x(i):A` THEN + EXISTS_TAC `x(SUC k):A` THEN SIMP_TAC[] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + SIMP_TAC[ARITH_RULE `~(k = SUC k) /\ (i < k ==> ~(i = SUC k))`] THEN + ASM_SIMP_TAC[ADD1; ARITH_RULE `i < k ==> ~(i + 1 = SUC k)`] THEN + ASM_MESON_TAC[ARITH_RULE `k < i /\ ~(i = k + 1) ==> SUC k < i`]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:num->A`; `a:A`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[ARITH_RULE `i = k \/ i < k ==> ~(i = SUC k)`] THEN + REWRITE_TAC[ARITH_RULE `i + 1 = SUC k <=> i = k`] THEN + ASM_MESON_TAC[ARITH_RULE `SUC k < i ==> ~(i = SUC k) /\ k < i`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ARITH_RULE `N * m * m EXP k = (N * m EXP k) * m`] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM] THEN + REWRITE_TAC[FUN_EQ_THM; path; PAIR_EQ] THEN REPEAT GEN_TAC THEN + STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i = SUC k` THEN + ASM_MESON_TAC[ARITH_RULE `k < SUC k`]; + ALL_TAC] THEN + ASM_SIMP_TAC[HAS_SIZE_PRODUCT_DEPENDENT]);; + +let FINITE_PATHS = prove + (`!r k. FINITE(:A) ==> FINITE {x:num->A | path r k x}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:num->A | path (\a b. T) k x}` THEN SIMP_TAC[PATHS_MONO] THEN + MP_TAC(ISPECL [`CARD(:A)`; `CARD(:A)`; `\a:A b:A. T`; `k:num`] + HAS_SIZE_PATHS) THEN + ANTS_TAC THEN ASM_SIMP_TAC[HAS_SIZE; SET_RULE `{y | T} = (:A)`]);; + +let HAS_SIZE_CYCLES = prove + (`!r k. FINITE(:A) /\ ~(k = 0) + ==> {x:num->A | cycle r k x} HAS_SIZE + CARD{x:num->A | path r k x /\ x(k) = x(0)}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:num->A | cycle r k x} = + IMAGE (\x i. x(i MOD k)) {x | path r k x /\ x(k) = x(0)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `x:num->A` THEN EQ_TAC THENL + [DISCH_TAC THEN + EXISTS_TAC `\i. if i <= k then x(i):A else @x. T` THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[FUN_EQ_THM; LT_IMP_LE; DIVISION] THEN + ASM_MESON_TAC[CYCLE_MOD]; + SIMP_TAC[path; LT_IMP_LE] THEN REWRITE_TAC[GSYM NOT_LT] THEN + SIMP_TAC[ARITH_RULE `i < k ==> ~(k < i + 1)`] THEN + ASM_MESON_TAC[cycle]; + REWRITE_TAC[LE_0; LE_REFL] THEN ASM_MESON_TAC[cycle; ADD_CLAUSES]]; + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:num->A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[cycle] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THENL + [ALL_TAC; + AP_TERM_TAC THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `1` THEN + REWRITE_TAC[MULT_CLAUSES]] THEN + SUBGOAL_THEN `y((i + 1) MOD k):A = y(i MOD k + 1)` SUBST1_TAC THENL + [ALL_TAC; ASM_MESON_TAC[path; DIVISION]] THEN + SUBGOAL_THEN `(i + 1) MOD k = (i MOD k + 1) MOD k` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `i DIV k` THEN + REWRITE_TAC[ARITH_RULE `i + 1 = (m + 1) + ik <=> i = ik + m`] THEN + ASM_MESON_TAC[DIVISION]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o CONJUNCT2 o SPEC `i:num` o MATCH_MP DIVISION) THEN + SPEC_TAC(`i MOD k`,`j:num`) THEN GEN_TAC THEN + ONCE_REWRITE_TAC[ARITH_RULE `j < k <=> j + 1 < k \/ j + 1 = k`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[MOD_LT] THEN AP_TERM_TAC THEN + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `1` THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[HAS_SIZE] THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:num->A | path r k x}` THEN + ASM_SIMP_TAC[FINITE_PATHS] THEN SET_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`x:num->A`; `y:num->A`] THEN SIMP_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[path; FUN_EQ_THM] THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`i:num`; `k:num`] LT_CASES) + THENL [ASM_MESON_TAC[MOD_LT]; ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN + ASM_MESON_TAC[MOD_0]);; + +let FINITE_CYCLES = prove + (`!r k. FINITE(:A) /\ ~(k = 0) ==> FINITE {x:num->A | cycle r k x}`, + MESON_TAC[HAS_SIZE_CYCLES; HAS_SIZE]);; + +let CARD_PATHCYCLES_STEP = prove + (`!N m r k. + (:A) HAS_SIZE N /\ ~(k = 0) /\ ~(m = 0) /\ + (!x:A. {y | r x y} HAS_SIZE m) /\ + (!x y. r x y ==> r y x) /\ + (!x y. ~(x = y) ==> ?!z. r x z /\ r z y) + ==> {x | path r (k + 2) x /\ x(k + 2) = x(0)} HAS_SIZE + (m * CARD {x | path r k x /\ x(k) = x(0)} + + CARD {x | path r (k) x /\ ~(x(k) = x(0))})`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE + `{x | path r (k + 2) x /\ x(k + 2) = x(0)} = + {x | path r (k + 2) x /\ x k = x 0 /\ x(k + 2) = x(0)} UNION + {x | path r (k + 2) x /\ ~(x k = x 0) /\ x(k + 2) = x(0)}`] THEN + MATCH_MP_TAC HAS_SIZE_UNION THEN GEN_REWRITE_TAC I [CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN CONJ_TAC THENL + [SUBGOAL_THEN + `{x:num->A | path r (k + 2) x /\ x k = x 0 /\ x (k + 2) = x 0} = + IMAGE (\(x,a) i. if i = k + 1 then a + else if i = k + 2 then x(0) + else x(i)) + {x,a | x IN {x | path r k x /\ x(k) = x(0)} /\ + a IN {u | r (x k) u}}` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; FUN_EQ_THM; PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC [`y:num->A`; `a:A`; `z:num->A`; `b:A`] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th THENL + [ALL_TAC; MESON_TAC[]]) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> X_GEN_TAC `i:num` THEN MP_TAC th) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `0` th)) THEN + REWRITE_TAC[ARITH_RULE `~(0 = k + 1) /\ ~(0 = k + 2)`] THEN + DISCH_TAC THEN ASM_CASES_TAC `k:num < i` THENL + [ASM_MESON_TAC[path]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN + ASM_MESON_TAC[ARITH_RULE `k < k + 1 /\ k < k + 2`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + MATCH_MP_TAC HAS_SIZE_PRODUCT_DEPENDENT THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_SIZE] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:num->A | path r k x}` THEN CONJ_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + ASM_MESON_TAC[HAS_SIZE; FINITE_PATHS]] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN + X_GEN_TAC `x:num->A` THEN EQ_TAC THENL + [STRIP_TAC THEN + EXISTS_TAC `\i. if i <= k then x(i):A else @x. T` THEN + EXISTS_TAC `(x:num->A) (k + 1)` THEN + REWRITE_TAC[IN_ELIM_THM; LE_REFL; LE_0] THEN + ASM_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[path; ARITH_RULE `k < k + 2`]] THEN + CONJ_TAC THENL + [ALL_TAC; + UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN + SIMP_TAC[path; LT_IMP_LE; ARITH_RULE `i < k ==> i + 1 <= k`] THEN + SIMP_TAC[GSYM NOT_LT] THEN + MESON_TAC[ARITH_RULE `i < k ==> i < k + 2`]] THEN + X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i = k + 2` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `i:num` o CONJUNCT2) THEN + ASM_REWRITE_TAC[ARITH_RULE + `k + 2 < i <=> ~(i <= k) /\ ~(i = k + 1) /\ ~(i = k + 2)`]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:num->A`; `b:A`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `0` th)) THEN + REWRITE_TAC[COND_ID; ARITH_RULE `~(0 = k + 1)`] THEN DISCH_TAC THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(LABEL_TAC "*") THEN CONJ_TAC THENL + [ALL_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `k + 2`) THEN + ASM_REWRITE_TAC[ARITH_RULE `~(k + 2 = k + 1)`]] THEN + CONJ_TAC THENL + [ALL_TAC; REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[ARITH_RULE `~(k = k + 2) /\ ~(k = k + 1)`]] THEN + UNDISCH_TAC `path r k (z:num->A)` THEN ASM_REWRITE_TAC[path] THEN + SIMP_TAC[ARITH_RULE + `k + 2 < i ==> k < i /\ ~(i = k + 1) /\ ~(i = k + 2)`] THEN + STRIP_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `i < k + 2 ==> ~(i = k + 2)`] THEN + REWRITE_TAC[ARITH_RULE `i + 1 = k + 2 <=> i = k + 1`] THEN + ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[ARITH_RULE `~(x + 1 = x)`]; ALL_TAC] THEN + REWRITE_TAC[EQ_ADD_RCANCEL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[ARITH_RULE `i < k + 2 /\ ~(i = k) /\ ~(i = k + 1) + ==> i < k`]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:num->A | path r (k + 2) x /\ ~(x k = x 0) /\ x (k + 2) = x 0} = + IMAGE (\x i. if i = k + 1 then @z. r (x k) z /\ r z (x 0) + else if i = k + 2 then x(0) + else x(i)) + {x | path r k x /\ ~(x(k) = x(0))}` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[HAS_SIZE] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:num->A | path r k x}` THEN CONJ_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + ASM_MESON_TAC[HAS_SIZE; FINITE_PATHS]] THEN + MAP_EVERY X_GEN_TAC [`x:num->A`; `y:num->A`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `k:num < i` THENL + [ASM_MESON_TAC[path]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN + ASM_MESON_TAC[ARITH_RULE `k < k + 1 /\ k < k + 2`]] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `x:num->A` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL + [STRIP_TAC THEN + EXISTS_TAC `\i. if i <= k then x(i):A else @x. T` THEN + ASM_REWRITE_TAC[LE_REFL; LE_0] THEN CONJ_TAC THENL + [ALL_TAC; + UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN + SIMP_TAC[path; LT_IMP_LE; ARITH_RULE `i < k ==> i + 1 <= k`] THEN + SIMP_TAC[GSYM NOT_LT] THEN + MESON_TAC[ARITH_RULE `i < k ==> i < k + 2`]] THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN + UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN REWRITE_TAC[path] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `k:num` th) THEN + MP_TAC(SPEC `k + 1` th)) THEN + REWRITE_TAC[ARITH_RULE `k < k + 2 /\ k + 1 < k + 2`] THEN + REWRITE_TAC[GSYM ADD_ASSOC; ARITH] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `i = k + 2` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `path r (k + 2) (x:num->A)` THEN REWRITE_TAC[path] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + ASM_MESON_TAC[ARITH_RULE `~(i <= k) /\ ~(i = k + 1) /\ ~(i = k + 2) + ==> k + 2 < i`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:num->A` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[ARITH_RULE + `~(k + 2 = k + 1) /\ ~(0 = k + 1) /\ ~(0 = k + 2) /\ ~(k = k + 1) /\ + ~(k = k + 2)`] THEN + REWRITE_TAC[path] THEN CONJ_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THENL + [REWRITE_TAC[ARITH_RULE `i + 1 = k + 2 <=> i = k + 1`] THEN + ASM_CASES_TAC `i = k + 1` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[ARITH_RULE `(k + 1) + 1 = k + 1 <=> F`] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `i < k + 2 ==> ~(i = k + 2)`] THEN + REWRITE_TAC[EQ_ADD_RCANCEL] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `path r k (y:num->A)` THEN REWRITE_TAC[path] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN + MAP_EVERY UNDISCH_TAC [`~(i:num = k)`; `~(i = k + 1)`; `i < k + 2`] THEN + ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `k + 2 < i ==> ~(i = k + 1) /\ ~(i = k + 2)`] THEN + ASM_MESON_TAC[path; ARITH_RULE `k + 2 < i ==> k < i`]);; + +(* ------------------------------------------------------------------------- *) +(* The first lemma about the number of cycles. *) +(* ------------------------------------------------------------------------- *) + +let shiftable = new_definition + `shiftable x y <=> ?k. !i. x(i) = y(i + k)`;; + +let SHIFTABLE_REFL = prove + (`!x. shiftable x x`, + REWRITE_TAC[shiftable] THEN MESON_TAC[ADD_CLAUSES]);; + +let SHIFTABLE_TRANS = prove + (`!x y z. shiftable x y /\ shiftable y z ==> shiftable x z`, + REWRITE_TAC[shiftable] THEN MESON_TAC[ADD_ASSOC]);; + +let SHIFTABLE_LOCAL = prove + (`!x y p r. cycle r p x /\ cycle r p y /\ ~(p = 0) + ==> (shiftable x y <=> ?k. k < p /\ !i. x(i) = y(i + k))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[shiftable] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN EXISTS_TAC `k MOD p` THEN + FIRST_ASSUM(MP_TAC o SPEC `k:num` o MATCH_MP DIVISION) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (BINDER_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + ASM_MESON_TAC[CYCLE_OFFSET; ADD_AC]);; + +let SHIFTABLE_SYM = prove + (`!x y p r. cycle r p x /\ cycle r p y /\ ~(p = 0) /\ shiftable x y + ==> shiftable y x`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ b /\ c) /\ d`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP SHIFTABLE_LOCAL) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[shiftable] THEN EXISTS_TAC `p - k:num` THEN + ASM_SIMP_TAC[ARITH_RULE `k < p ==> (i + (p - k)) + k = i + p:num`] THEN + ASM_MESON_TAC[cycle]);; + +let CYCLES_PRIME_LEMMA = prove + (`!r p x. FINITE(:A) /\ prime p /\ (!x. ~(r x x)) + ==> p divides CARD {x:num->A | cycle r p x}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + STRIP_TAC THEN MATCH_MP_TAC EQUIVALENCE_UNIFORM_PARTITION_RESTRICT THEN + EXISTS_TAC `shiftable:(num->A)->(num->A)->bool` THEN + ASM_SIMP_TAC[IN_ELIM_THM; FINITE_CYCLES] THEN + CONJ_TAC THENL [MESON_TAC[SHIFTABLE_REFL]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SHIFTABLE_SYM]; ALL_TAC] THEN + CONJ_TAC THENL [MESON_TAC[SHIFTABLE_TRANS]; ALL_TAC] THEN + X_GEN_TAC `x:num->A` THEN DISCH_TAC THEN + SUBGOAL_THEN `{y:num->A | cycle r p y /\ shiftable x y} HAS_SIZE p` + (fun th -> MESON_TAC[HAS_SIZE; th]) THEN + SUBGOAL_THEN `{y:num->A | cycle r p y /\ shiftable x y} = + IMAGE (\k i. x(i + k)) {k | k < p}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:num->A` THEN REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL + [ASM_MESON_TAC[SHIFTABLE_LOCAL; SHIFTABLE_SYM]; ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cycle]) THEN + ASM_REWRITE_TAC[cycle] THEN MESON_TAC[ADD_AC]; + ALL_TAC] THEN + MATCH_MP_TAC SHIFTABLE_SYM THEN + MAP_EVERY EXISTS_TAC [`p:num`; `r:A->A->bool`] THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cycle]) THEN + ASM_REWRITE_TAC[cycle; shiftable] THEN MESON_TAC[ADD_AC]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_LT] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC WLOG_LE THEN + REWRITE_TAC[FUN_EQ_THM] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `l:num`] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN `!i. x(i):A = x(0)` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[cycle]] THEN + MATCH_MP_TAC LOOP_COPRIME THEN EXISTS_TAC `p:num` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[cycle]; ALL_TAC] THEN + EXISTS_TAC `l + (p - k):num` THEN CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN + ONCE_REWRITE_TAC[ARITH_RULE `i + l + pk = (i + pk) + l:num`] THEN + ASSUM_LIST(REWRITE_TAC o map GSYM) THEN + SIMP_TAC[ARITH_RULE `k < p ==> (i + p - k) + k = i + p:num`; + ASSUME `k < p:num`] THEN + ASM_MESON_TAC[cycle]; + ALL_TAC] THEN + SUBGOAL_THEN `l + p - k = p + l - k:num` SUBST1_TAC THENL + [MAP_EVERY UNDISCH_TAC [`k < p:num`; `k <= l:num`] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[NUMBER_RULE `coprime(p,p + d) <=> coprime(d,p)`] THEN + MATCH_MP_TAC PRIME_COPRIME_LT THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The theorem itself. *) +(* ------------------------------------------------------------------------- *) + +let FRIENDSHIP = prove + (`!friend:person->person->bool. + FINITE(:person) /\ + (!x. ~(friend x x)) /\ + (!x y. friend x y ==> friend y x) /\ + (!x y. ~(x = y) ==> ?!z. friend x z /\ friend y z) + ==> ?u. !v. ~(v = u) ==> friend u v`, + REPEAT STRIP_TAC THEN UNDISCH_TAC + `!x y:person. ~(x = y) ==> ?!z:person. friend x z /\ friend y z` THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM; RIGHT_IMP_FORALL_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `mutualfriend:person->person->person`) THEN + SUBGOAL_THEN `!s:person->bool. FINITE s` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET_UNIV; FINITE_SUBSET]; ALL_TAC] THEN + ABBREV_TAC `degree = \p:person. CARD {q:person | friend p q}` THEN + SUBGOAL_THEN `!x y:person. ~(friend x y) ==> degree(x):num <= degree(y)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:person = y` THENL + [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + EXPAND_TAC "degree" THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD(IMAGE (\u. (mutualfriend:person->person->person) u y) + {q | friend (x:person) q})` THEN + CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC CARD_SUBSET THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`u1:person`; `u2:person`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`x:person`; `(mutualfriend:person->person->person) u1 y`; + `u1:person`; `u2:person`]) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x y:person. ~(friend x y) ==> degree x:num = degree y` + ASSUME_TAC THENL [ASM_MESON_TAC[LE_ANTISYM]; ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN + GEN_REWRITE_TAC RAND_CONV [NOT_EXISTS_THM] THEN + DISCH_THEN(ASSUME_TAC o REWRITE_RULE[NOT_FORALL_THM; NOT_IMP]) THEN + SUBGOAL_THEN `?m:num. !x:person. degree(x) = m` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(X_CHOOSE_THEN `b:person` STRIP_ASSUME_TAC o + SPEC `a:person`) THEN + ABBREV_TAC `c = (mutualfriend:person->person->person) a b` THEN + ABBREV_TAC `k = (degree:person->num) a` THEN EXISTS_TAC `k:num` THEN + SUBGOAL_THEN `(degree:person->num)(b) = k /\ ~(friend a b) /\ + friend a c /\ friend b c` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x:person. ~(x = c) ==> degree x = (k:num)` ASSUME_TAC THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!p:person. {q:person | friend p q} HAS_SIZE m` + ASSUME_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + SUBGOAL_THEN `~(m = 0)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `!p:person. {q:person | friend p q} HAS_SIZE m` THEN + ASM_REWRITE_TAC[HAS_SIZE_0; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `EVEN(m)` ASSUME_TAC THENL + [UNDISCH_TAC `!x:person. degree x = (m:num)` THEN + DISCH_THEN(SUBST1_TAC o SYM o SPEC `a:person`) THEN + EXPAND_TAC "degree" THEN MATCH_MP_TAC ELEMENTS_PAIR_UP THEN + EXISTS_TAC `\x y:person. friend a x /\ friend a y /\ friend x y` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[HAS_SIZE]; + ALL_TAC] THEN + ABBREV_TAC `N = CARD(:person)` THEN + SUBGOAL_THEN `N = m * (m - 1) + 1` ASSUME_TAC THENL + [ABBREV_TAC `t = {q:person | friend (a:person) q}` THEN + SUBGOAL_THEN `FINITE(t:person->bool) /\ CARD t = m` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + ABBREV_TAC + `u = \b:person. {c:person | friend b c /\ ~(c IN (a INSERT t))}` THEN + EXPAND_TAC "N" THEN + SUBGOAL_THEN `(:person) = (a INSERT t) UNION UNIONS {u(b) | b IN t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_UNIV; IN_UNION; IN_UNIONS] THEN + MAP_EVERY EXPAND_TAC ["t"; "u"] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `x:person` THEN + MATCH_MP_TAC(TAUT `(~a /\ ~b ==> c) ==> (a \/ b) \/ c`) THEN + STRIP_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INSERT; DE_MORGAN_THM] THEN + EXISTS_TAC `mutualfriend (a:person) (x:person) :person` THEN + EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `m * (m - 1) + 1 = (m + 1) + m * (m - 2)` SUBST1_TAC THENL + [SIMP_TAC[ARITH_RULE `a + 1 = (m + 1) + m * c <=> a = m * (1 + c)`] THEN + AP_TERM_TAC THEN UNDISCH_TAC `EVEN m` THEN + ASM_CASES_TAC `m = 1` THEN ASM_REWRITE_TAC[ARITH] THEN DISCH_TAC THEN + MAP_EVERY UNDISCH_TAC [`~(m = 0)`; `~(m = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `m + 1 = CARD((a:person) INSERT t)` SUBST1_TAC THENL + [ASM_SIMP_TAC[CARD_CLAUSES; ADD1] THEN EXPAND_TAC "t" THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `UNIONS {u b :person->bool | (b:person) IN t} HAS_SIZE m * (m - 2)` + MP_TAC THENL + [MATCH_MP_TAC HAS_SIZE_UNIONS THEN CONJ_TAC THENL + [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + EXPAND_TAC "u" THEN REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER] THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; IN_INSERT] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ASSUME `(b:person) IN t`) THEN EXPAND_TAC "t" THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN + `u (b:person) = + {q:person | friend q b} DELETE a DELETE (mutualfriend a b)` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["u"; "t"] THEN + REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_ELIM_THM] THEN + X_GEN_TAC `x:person` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:person`; `b:person`; + `(mutualfriend:person->person->person) a b`; `x:person`]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[CARD_DELETE; HAS_SIZE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `{q:person | friend q (b:person)} = {q | friend b q}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `m - 1 - 1 = m - 2`] THEN + ASM_MESON_TAC[HAS_SIZE]; + ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN + MATCH_MP_TAC CARD_UNION THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_INSERT; IN_INTER; NOT_IN_EMPTY; IN_UNIONS] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + MAP_EVERY EXPAND_TAC ["u"; "t"] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INSERT] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(m = 2)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + SUBGOAL_THEN `(:person) HAS_SIZE 3` MP_TAC THENL + [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:person`; `b:person`; `c:person`] THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN + STRIP_TAC THEN + UNDISCH_TAC `!u:person. ?v:person. ~(v = u) /\ ~friend u v` THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM] THEN + EXISTS_TAC `a:person` THEN + UNDISCH_TAC `!p:person. {q:person | friend p q} HAS_SIZE 2` THEN + DISCH_THEN(MP_TAC o SPEC `a:person`) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:person`; `y:person`] THEN + STRIP_TAC THEN X_GEN_TAC `z:person` THEN + UNDISCH_TAC `!x:person. x = a \/ x = b \/ x = c` THEN + DISCH_THEN(fun th -> MAP_EVERY (fun x -> MP_TAC(SPEC x th)) + [`x:person`; `y:person`; `z:person`]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `m - 1` PRIME_FACTOR) THEN ANTS_TAC THENL + [UNDISCH_TAC `~(m = 2)` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(p divides 1)` MP_TAC THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(NUMBER_RULE + `!x. p divides (x + 1) /\ p divides x ==> p divides 1`) THEN + EXISTS_TAC `m - 1` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 1 + 1 = m`] THEN + MATCH_MP_TAC PRIME_DIVEXP THEN EXISTS_TAC `p - 2` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NUMBER_RULE + `!q c K1 K2. + p divides q /\ p divides c /\ + c = (q + 1) * K1 + K2 /\ + K1 + K2 = ((q + 1) * q + 1) * nep2 + ==> p divides nep2`) THEN + MAP_EVERY EXISTS_TAC + [`m - 1`; `CARD {x:num->person | cycle friend p x}`; + `CARD {x:num->person | path friend (p-2) x /\ x (p-2) = x 0}`; + `CARD {x:num->person | path friend (p-2) x /\ ~(x (p-2) = x 0)}`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CYCLES_PRIME_LEMMA THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `3 <= p` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `2 <= p /\ ~(p = 2) ==> 3 <= p`) THEN + ASM_SIMP_TAC[PRIME_GE_2] THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM DIVIDES_2]) THEN + MP_TAC(DIVIDES_CONV `2 divides 1`) THEN REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(NUMBER_RULE + `!q. t divides q /\ m = q + 1 ==> t divides m ==> t divides w`) THEN + EXISTS_TAC `m - 1` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `~(m = 0) ==> m - 1 + 1 = m`] THEN CONJ_TAC THENL + [MP_TAC(ISPECL[`friend:person->person->bool`; `p:num`] HAS_SIZE_CYCLES) THEN + ANTS_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + SIMP_TAC[HAS_SIZE] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC HAS_SIZE_CARD THEN + SUBGOAL_THEN `p = (p - 2) + 2` (fun th -> + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_MESON_TAC[PRIME_GE_2; SUB_ADD]; ALL_TAC] THEN + MATCH_MP_TAC CARD_PATHCYCLES_STEP THEN EXISTS_TAC `N:num` THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + UNDISCH_TAC `3 <= p` THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`N:num`; `m:num`; `friend:person->person->bool`; `p - 2`] + HAS_SIZE_PATHS) THEN + ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + ASM_REWRITE_TAC[HAS_SIZE] THEN + DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN + MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[FINITE_PATHS] THEN SET_TAC[]);; diff --git a/100/fta.ml b/100/fta.ml new file mode 100644 index 0000000..390d055 --- /dev/null +++ b/100/fta.ml @@ -0,0 +1,178 @@ +(* ========================================================================= *) +(* The fundamental theorem of arithmetic (unique prime factorization). *) +(* ========================================================================= *) + +needs "Library/prime.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Definition of iterated product. *) +(* ------------------------------------------------------------------------- *) + +let nproduct = new_definition `nproduct = iterate ( * )`;; + +let NPRODUCT_CLAUSES = prove + (`(!f. nproduct {} f = 1) /\ + (!x f s. FINITE(s) + ==> (nproduct (x INSERT s) f = + if x IN s then nproduct s f else f(x) * nproduct s f))`, + REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; + +let NPRODUCT_EQ_1_EQ = prove + (`!s f. FINITE s ==> (nproduct s f = 1 <=> !x. x IN s ==> f(x) = 1)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[NPRODUCT_CLAUSES; IN_INSERT; MULT_EQ_1; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]);; + +let NPRODUCT_SPLITOFF = prove + (`!x:A f s. FINITE s + ==> nproduct s f = + (if x IN s then f(x) else 1) * nproduct (s DELETE x) f`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[MULT_CLAUSES; SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN + SUBGOAL_THEN `s = (x:A) INSERT (s DELETE x)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [th] THEN + ASM_SIMP_TAC[NPRODUCT_CLAUSES; FINITE_DELETE; IN_DELETE]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]);; + +let NPRODUCT_SPLITOFF_HACK = prove + (`!x:A f s. nproduct s f = + if FINITE s then + (if x IN s then f(x) else 1) * nproduct (s DELETE x) f + else nproduct s f`, + REPEAT STRIP_TAC THEN MESON_TAC[NPRODUCT_SPLITOFF]);; + +let NPRODUCT_EQ = prove + (`!f g s. FINITE s /\ (!x. x IN s ==> f x = g x) + ==> nproduct s f = nproduct s g`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; IN_INSERT]);; + +let NPRODUCT_EQ_GEN = prove + (`!f g s t. FINITE s /\ s = t /\ (!x. x IN s ==> f x = g x) + ==> nproduct s f = nproduct t g`, + MESON_TAC[NPRODUCT_EQ]);; + +let PRIME_DIVIDES_NPRODUCT = prove + (`!p s f. prime p /\ FINITE s /\ p divides (nproduct s f) + ==> ?x. x IN s /\ p divides (f x)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[PRIME_DIVPROD; DIVIDES_ONE; PRIME_1]);; + +let NPRODUCT_CANCEL_PRIME = prove + (`!s p m f j. + p EXP j * nproduct (s DELETE p) (\p. p EXP (f p)) = p * m + ==> prime p /\ FINITE s /\ (!x. x IN s ==> prime x) + ==> ~(j = 0) /\ + p EXP (j - 1) * nproduct (s DELETE p) (\p. p EXP (f p)) = m`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `j = 0` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(j = 0) ==> j = SUC(j - 1)`)) THEN + REWRITE_TAC[SUC_SUB1; EXP; GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN + MESON_TAC[PRIME_0]] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:num`; `s DELETE (p:num)`; `\p. p EXP (f p)`] + PRIME_DIVIDES_NPRODUCT) THEN + ANTS_TAC THENL [ASM_MESON_TAC[divides; FINITE_DELETE]; ALL_TAC] THEN + REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[PRIME_1; prime; PRIME_DIVEXP]);; + +(* ------------------------------------------------------------------------- *) +(* Fundamental Theorem of Arithmetic. *) +(* ------------------------------------------------------------------------- *) + +let FTA = prove + (`!n. ~(n = 0) + ==> ?!i. FINITE {p | ~(i p = 0)} /\ + (!p. ~(i p = 0) ==> prime p) /\ + n = nproduct {p | ~(i p = 0)} (\p. p EXP (i p))`, + ONCE_REWRITE_TAC[ARITH_RULE `n = nproduct s f <=> nproduct s f = n`] THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + SIMP_TAC[NPRODUCT_EQ_1_EQ; EXP_EQ_1; IN_ELIM_THM] THEN + REWRITE_TAC[FUN_EQ_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [EXISTS_TAC `\n:num. 0` THEN + REWRITE_TAC[SET_RULE `{p | F} = {}`; FINITE_RULES]; + REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `q:num` THEN ASM_CASES_TAC `q = 1` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIME_1]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + REWRITE_TAC[divides; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `m:num`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[PRIME_FACTOR_LT]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `i:num->num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\q:num. if q = p then i(q) + 1 else i(q)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `p INSERT {p:num | ~(i p = 0)}` THEN + ASM_SIMP_TAC[SUBSET; FINITE_INSERT; IN_INSERT; IN_ELIM_THM] THEN + MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN CONJ_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MP_TAC(ISPEC `p:num` NPRODUCT_SPLITOFF_HACK) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; ADD_EQ_0; ARITH] THEN + REWRITE_TAC[MULT_ASSOC] THEN BINOP_TAC THENL + [ASM_CASES_TAC `(i:num->num) p = 0` THEN + ASM_REWRITE_TAC[EXP_ADD; EXP_1; EXP; MULT_AC]; + ALL_TAC] THEN + MATCH_MP_TAC NPRODUCT_EQ_GEN THEN RULE_ASSUM_TAC(SIMP_RULE[]) THEN + ASM_SIMP_TAC[FINITE_DELETE; IN_DELETE; EXTENSION; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[ADD_EQ_0; ARITH] THEN MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC `p:num` NPRODUCT_SPLITOFF_HACK) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN + REWRITE_TAC[TAUT + `p /\ q /\ ((if p then x else y) = z) <=> p /\ q /\ x = z`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[MESON[EXP] `(if ~(x = 0) then p EXP x else 1) = p EXP x`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`j:num->num`; `k:num->num`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`\i:num. if i = p then j(i) - 1 else j(i)`; + `\i:num. if i = p then k(i) - 1 else k(i)`]) THEN + REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP NPRODUCT_CANCEL_PRIME)) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE + `!j k. {q | ~((if q = p then j q else k q) = 0)} DELETE p = + {q | ~(k q = 0)} DELETE p`] THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC + [`~(j(p:num) = 0)`; `~(k(p:num) = 0)`] THEN ARITH_TAC] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p:num | ~(j p = 0)}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; + ASM_MESON_TAC[SUB_0]; + FIRST_X_ASSUM(fun th -> SUBST1_TAC(SYM th) THEN AP_TERM_TAC) THEN + MATCH_MP_TAC NPRODUCT_EQ_GEN THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN + SIMP_TAC[IN_DELETE; IN_ELIM_THM]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p:num | ~(k p = 0)}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; + ASM_MESON_TAC[SUB_0]; + FIRST_X_ASSUM(fun th -> SUBST1_TAC(SYM th) THEN AP_TERM_TAC) THEN + MATCH_MP_TAC NPRODUCT_EQ_GEN THEN ASM_REWRITE_TAC[FINITE_DELETE] THEN + SIMP_TAC[IN_DELETE; IN_ELIM_THM]]);; diff --git a/100/gcd.ml b/100/gcd.ml new file mode 100644 index 0000000..af582a0 --- /dev/null +++ b/100/gcd.ml @@ -0,0 +1,41 @@ +(* ========================================================================= *) +(* Euclidean GCD algorithm. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; + +let egcd = define + `egcd(m,n) = if m = 0 then n + else if n = 0 then m + else if m <= n then egcd(m,n - m) + else egcd(m - n,n)`;; + +(* ------------------------------------------------------------------------- *) +(* Main theorems. *) +(* ------------------------------------------------------------------------- *) + +let EGCD_INVARIANT = prove + (`!m n d. d divides egcd(m,n) <=> d divides m /\ d divides n`, + GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `m + n` THEN + GEN_TAC THEN ONCE_REWRITE_TAC[egcd] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THEN + COND_CASES_TAC THEN + (W(fun (asl,w) -> FIRST_X_ASSUM(fun th -> + MP_TAC(PART_MATCH (lhs o snd o dest_forall o rand) th (lhand w)))) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + ASM_MESON_TAC[DIVIDES_SUB; DIVIDES_ADD; SUB_ADD; LE_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get the proper behaviour, and it's equal to the real GCD. *) +(* ------------------------------------------------------------------------- *) + +let EGCD_GCD = prove + (`!m n. egcd(m,n) = gcd(m,n)`, + ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN + MESON_TAC[EGCD_INVARIANT; DIVIDES_REFL]);; + +let EGCD = prove + (`!a b. (egcd (a,b) divides a /\ egcd (a,b) divides b) /\ + (!e. e divides a /\ e divides b ==> e divides egcd (a,b))`, + REWRITE_TAC[EGCD_GCD; GCD]);; diff --git a/100/heron.ml b/100/heron.ml new file mode 100644 index 0000000..cf5935a --- /dev/null +++ b/100/heron.ml @@ -0,0 +1,42 @@ +(* ========================================================================= *) +(* Heron's formula for the area of a triangle. *) +(* ========================================================================= *) + +needs "Multivariate/measure.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Eliminate square roots from formula by the usual method. *) +(* ------------------------------------------------------------------------- *) + +let SQRT_ELIM_TAC = + let sqrt_tm = `sqrt:real->real` in + let is_sqrt tm = is_comb tm & rator tm = sqrt_tm in + fun (asl,w) -> + let stms = setify(find_terms is_sqrt w) in + let gvs = map (genvar o type_of) stms in + (MAP_EVERY (MP_TAC o C SPEC SQRT_POW_2 o rand) stms THEN + EVERY (map2 (fun s v -> SPEC_TAC(s,v)) stms gvs)) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Main result. *) +(* ------------------------------------------------------------------------- *) + +let HERON = prove + (`!A B C:real^2. + let a = dist(C,B) + and b = dist(A,C) + and c = dist(B,A) in + let s = (a + b + c) / &2 in + measure(convex hull {A,B,C}) = sqrt(s * (s - a) * (s - b) * (s - c))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + REWRITE_TAC[MEASURE_TRIANGLE] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE THEN + SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS; REAL_POS] THEN + REWRITE_TAC[REAL_POW_DIV; REAL_POW2_ABS] THEN + REWRITE_TAC[dist; vector_norm] THEN + REWRITE_TAC[dot; SUM_2; DIMINDEX_2] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; ARITH; DIMINDEX_2] THEN + SQRT_ELIM_TAC THEN SIMP_TAC[REAL_LE_SQUARE; REAL_LE_ADD] THEN + CONV_TAC REAL_RING);; diff --git a/100/inclusion_exclusion.ml b/100/inclusion_exclusion.ml new file mode 100644 index 0000000..9e246c6 --- /dev/null +++ b/100/inclusion_exclusion.ml @@ -0,0 +1,418 @@ +(* ========================================================================= *) +(* Inclusion-exclusion principle, the usual and generalized forms. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Simple set theory lemmas. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_INSERT_EXISTS = prove + (`!s x:A t. s SUBSET (x INSERT t) <=> + s SUBSET t \/ ?u. u SUBSET t /\ s = x INSERT u`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC(TAUT `(a /\ ~b ==> c) ==> a ==> b \/ c`) THEN + DISCH_TAC THEN EXISTS_TAC `s DELETE (x:A)` THEN ASM SET_TAC[]);; + +let FINITE_SUBSETS_RESTRICT = prove + (`!s:A->bool p. FINITE s ==> FINITE {t | t SUBSET s /\ p t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN + ASM_SIMP_TAC[FINITE_POWERSET] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Versions for additive real functions, where the additivity applies only *) +(* to some specific subsets (e.g. cardinality of finite sets, measurable *) +(* sets with bounded measure). *) +(* ------------------------------------------------------------------------- *) + +let INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED = prove + (`!P (f:(A->bool)->real) (A:I->bool) (x:I->(A->bool)). + (!s t. P s /\ P t /\ DISJOINT s t + ==> f(s UNION t) = f(s) + f(t)) /\ + P {} /\ + (!s t. P s /\ P t ==> P(s INTER t) /\ P(s UNION t) /\ P(s DIFF t)) /\ + FINITE A /\ (!a. a IN A ==> P(x a)) + ==> f(UNIONS(IMAGE x A)) = + sum {B | B SUBSET A /\ ~(B = {})} + (\B. (-- &1) pow (CARD B + 1) * f(INTERS(IMAGE x B)))`, + let lemma = prove + (`{t | t SUBSET (a INSERT s) /\ P t} = + {t | t SUBSET s /\ P t} UNION + {a INSERT t |t| t SUBSET s /\ P(a INSERT t)}`, + REWRITE_TAC[SUBSET_INSERT_EXISTS] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]) in + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[HAS_SIZE] + `(!n s. s HAS_SIZE n ==> P s) ==> (!s. FINITE s ==> P s)`) THEN + MATCH_MP_TAC num_WF THEN MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[HAS_SIZE_CLAUSES; LEFT_IMP_EXISTS_THM] THEN CONJ_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; TAUT `~(p /\ ~p)`] THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; SUM_CLAUSES] THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`{}:A->bool`; `{}:A->bool`])) THEN + ASM_SIMP_TAC[UNION_EMPTY; DISJOINT_EMPTY] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`A0:I->bool`; `a:I`; `A:I->bool`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST1_TAC THEN X_GEN_TAC `x:I->A->bool` THEN + REWRITE_TAC[FORALL_IN_INSERT] THEN STRIP_TAC THEN + REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(f(x a) + f(UNIONS (IMAGE (x:I->(A->bool)) A))) - + f(x a INTER UNIONS (IMAGE x A)):real` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `P(x a) /\ P(UNIONS(IMAGE (x:I->(A->bool)) A))` + MP_TAC THENL + [ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `!b. b IN A ==> P((x:I->(A->bool)) b)` THEN + SUBGOAL_THEN `FINITE(A:I->bool)` MP_TAC THENL + [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + SPEC_TAC(`A:I->bool`,`u:I->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[IMAGE_CLAUSES; UNIONS_0; UNIONS_INSERT; FORALL_IN_INSERT]; + SPEC_TAC(`UNIONS(IMAGE (x:I->(A->bool)) A)`,`t:A->bool`) THEN + SPEC_TAC(`(x:I->(A->bool)) a`,`s:A->bool`) THEN + REPEAT STRIP_TAC THEN + UNDISCH_TAC `!s t:A->bool. P s /\ P t /\ DISJOINT s t + ==> f(s UNION t):real = f(s) + f(t)` THEN + DISCH_THEN(fun th -> + MP_TAC(ISPECL [`s INTER t:A->bool`; `t DIFF s:A->bool`] th) THEN + MP_TAC(ISPECL [`s:A->bool`; `t DIFF s:A->bool`] th)) THEN + ASM_SIMP_TAC[SET_RULE `s UNION (t DIFF s) = s UNION t`; + SET_RULE `(s INTER t) UNION (t DIFF s) = t`] THEN + REPEAT(ANTS_TAC THENL [SET_TAC[]; DISCH_TAC]) THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[INTER_UNIONS; SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LT] THEN + DISCH_THEN(MP_TAC o SPEC `A:I->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `\s. (x:I->(A->bool)) a INTER x s` th) THEN + MP_TAC(ISPEC `x:I->(A->bool)` th)) THEN + ASM_SIMP_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [HAS_SIZE]) THEN + REWRITE_TAC[lemma] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_UNION o rand o snd) THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT; FINITE_IMAGE] THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[IN_DISJOINT; EXISTS_IN_GSPEC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[NOT_INSERT_EMPTY; REAL_ARITH + `(fa + s) - fas:real = s + s' <=> fa - fas = s'`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `f((x:I->(A->bool)) a) + + sum {B | B SUBSET A /\ ~(B = {})} + (\B. --(&1) pow (CARD B) * + f(INTERS(IMAGE x (a INSERT B))))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `x - a:real = x + b <=> b = --a`] THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ THEN + REWRITE_TAC[IMAGE_CLAUSES; INTERS_INSERT; o_DEF; FORALL_IN_GSPEC] THEN + REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; + REWRITE_TAC[SET_RULE `{s | P s /\ ~(s = e)} = {s | P s} DELETE e`] THEN + ASM_SIMP_TAC[SUM_DELETE_CASES; GSYM DELETE; FINITE_POWERSET] THEN + REWRITE_TAC[IN_ELIM_THM; EMPTY_SUBSET; IMAGE_CLAUSES] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE_GEN] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[o_DEF; INTERS_1; CARD_CLAUSES; real_pow; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC SUM_EQ THEN + REWRITE_TAC[FORALL_IN_GSPEC; REAL_POW_ADD; REAL_POW_1] THEN + X_GEN_TAC `B:I->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `FINITE(B:I->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[CARD_CLAUSES; REAL_POW_ADD; real_pow] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_CLAUSES; real_pow] THEN REAL_ARITH_TAC]);; + +let INCLUSION_EXCLUSION_REAL_RESTRICTED = prove + (`!P (f:(A->bool)->real) (A:(A->bool)->bool). + (!s t. P s /\ P t /\ DISJOINT s t + ==> f(s UNION t) = f(s) + f(t)) /\ + P {} /\ + (!s t. P s /\ P t ==> P(s INTER t) /\ P(s UNION t) /\ P(s DIFF t)) /\ + FINITE A /\ (!a. a IN A ==> P(a)) + ==> f(UNIONS A) = + sum {B | B SUBSET A /\ ~(B = {})} + (\B. (-- &1) pow (CARD B + 1) * f(INTERS B))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(A->bool)->bool`; `f:(A->bool)->real`; + `A:(A->bool)->bool`; `\x:A->bool. x`] + INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED) THEN + ASM_REWRITE_TAC[IMAGE_ID]);; + +(* ------------------------------------------------------------------------- *) +(* Versions for unrestrictedly additive functions. *) +(* ------------------------------------------------------------------------- *) + +let INCLUSION_EXCLUSION_REAL_INDEXED = prove + (`!(f:(A->bool)->real) (A:I->bool) (x:I->(A->bool)). + (!s t. DISJOINT s t ==> f(s UNION t) = f(s) + f(t)) /\ FINITE A + ==> f(UNIONS(IMAGE x A)) = + sum {B | B SUBSET A /\ ~(B = {})} + (\B. (-- &1) pow (CARD B + 1) * f(INTERS(IMAGE x B)))`, + MP_TAC(ISPEC + `\x:A->bool. T` INCLUSION_EXCLUSION_REAL_RESTRICTED_INDEXED) THEN + REWRITE_TAC[]);; + +let INCLUSION_EXCLUSION_REAL = prove + (`!(f:(A->bool)->real) (A:(A->bool)->bool). + (!s t. DISJOINT s t ==> f(s UNION t) = f(s) + f(t)) /\ FINITE A + ==> f(UNIONS A) = + sum {B | B SUBSET A /\ ~(B = {})} + (\B. (-- &1) pow (CARD B + 1) * f(INTERS B))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:(A->bool)->real`; `A:(A->bool)->bool`; `\x:A->bool. x`] + INCLUSION_EXCLUSION_REAL_INDEXED) THEN + ASM_REWRITE_TAC[IMAGE_ID]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of cardinality, the most common case. *) +(* ------------------------------------------------------------------------- *) + +let INCLUSION_EXCLUSION = prove + (`!s:(A->bool)->bool. + FINITE s /\ (!k. k IN s ==> FINITE k) + ==> &(CARD(UNIONS s)) = + sum {t | t SUBSET s /\ ~(t = {})} + (\t. (-- &1) pow (CARD t + 1) * &(CARD(INTERS t)))`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\s:A->bool. FINITE s`; `\s:A->bool. &(CARD s)`; + `s:(A->bool)->bool`] INCLUSION_EXCLUSION_REAL_RESTRICTED) THEN + ASM_SIMP_TAC[FINITE_INTER; FINITE_UNION; FINITE_DIFF; FINITE_EMPTY] THEN + DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[CARD_UNION; DISJOINT; REAL_OF_NUM_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* A more conventional form. *) +(* ------------------------------------------------------------------------- *) + +let INCLUSION_EXCLUSION_USUAL = prove + (`!s:(A->bool)->bool. + FINITE s /\ (!k. k IN s ==> FINITE k) + ==> &(CARD(UNIONS s)) = + sum (1..CARD s) (\n. (-- &1) pow (n + 1) * + sum {t | t SUBSET s /\ t HAS_SIZE n} + (\t. &(CARD(INTERS t))))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INCLUSION_EXCLUSION] THEN + W(MP_TAC o PART_MATCH (lhs o rand) (ISPEC `CARD` SUM_IMAGE_GEN) o + lhand o snd) THEN + ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(MESON[] `s = t /\ sum t f = sum t g ==> sum s f = sum t g`) THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG; IN_ELIM_THM] THEN + REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + ASM_MESON_TAC[CHOOSE_SUBSET; CARD_SUBSET; FINITE_SUBSET; CARD_EQ_0; + HAS_SIZE]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG] THEN + STRIP_TAC THEN REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[IN_ELIM_THM; HAS_SIZE] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[CARD_EQ_0; ARITH_RULE `~(1 <= 0)`; FINITE_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A combinatorial lemma about subsets of a finite set. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_SUBSETS_RESTRICT = prove + (`!s:A->bool p. FINITE s ==> FINITE {t | t SUBSET s /\ p t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN + ASM_SIMP_TAC[FINITE_POWERSET] THEN SET_TAC[]);; + +let CARD_ADJUST_LEMMA = prove + (`!f:A->B s x y. + FINITE s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + x = y + CARD (IMAGE f s) + ==> x = y + CARD s`, + MESON_TAC[CARD_IMAGE_INJ]);; + +let CARD_SUBSETS_STEP = prove + (`!x:A s. FINITE s /\ ~(x IN s) /\ u SUBSET s + ==> CARD {t | t SUBSET (x INSERT s) /\ u SUBSET t /\ ODD(CARD t)} = + CARD {t | t SUBSET s /\ u SUBSET t /\ ODD(CARD t)} + + CARD {t | t SUBSET s /\ u SUBSET t /\ EVEN(CARD t)} /\ + CARD {t | t SUBSET (x INSERT s) /\ u SUBSET t /\ EVEN(CARD t)} = + CARD {t | t SUBSET s /\ u SUBSET t /\ EVEN(CARD t)} + + CARD {t | t SUBSET s /\ u SUBSET t /\ ODD(CARD t)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE[`:A`,`:B`] CARD_ADJUST_LEMMA) THEN + EXISTS_TAC `\u. (x:A) INSERT u` THEN + ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN + ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT; FINITE_INSERT] THEN CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER] THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> b ==> ~a`; FORALL_IN_IMAGE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `t:A->bool` THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNION; SUBSET_INSERT_EXISTS] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[RIGHT_OR_DISTRIB; LEFT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `v:A->bool` THEN + ASM_CASES_TAC `t = (x:A) INSERT v` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(v:A->bool) SUBSET s` THEN ASM_REWRITE_TAC[] THEN + BINOP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[CARD_CLAUSES; EVEN; NOT_ODD; FINITE_SUBSET; SUBSET] THEN + ASM_MESON_TAC[CARD_CLAUSES; EVEN; NOT_ODD; FINITE_SUBSET; SUBSET]));; + +let CARD_SUBSUPERSETS_EVEN_ODD = prove + (`!s u:A->bool. + FINITE u /\ s PSUBSET u + ==> CARD {t | s SUBSET t /\ t SUBSET u /\ EVEN(CARD t)} = + CARD {t | s SUBSET t /\ t SUBSET u /\ ODD(CARD t)}`, + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(u:A->bool)` THEN + REWRITE_TAC[PSUBSET_MEMBER] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (SET_RULE + `x IN s ==> s = x INSERT (s DELETE x)`)) THEN + MP_TAC(SET_RULE `~((x:A) IN (u DELETE x))`) THEN + ABBREV_TAC `v:A->bool = u DELETE x` THEN STRIP_TAC THEN + SUBGOAL_THEN `FINITE v /\ (s:A->bool) SUBSET v` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[FINITE_INSERT]; ALL_TAC] THEN + ASM_SIMP_TAC[CARD_SUBSETS_STEP] THEN ASM_CASES_TAC `s:A->bool = v` THENL + [REWRITE_TAC[CONJ_ASSOC; SUBSET_ANTISYM_EQ] THEN MATCH_ACCEPT_TAC ADD_SYM; + ASM_SIMP_TAC[CARD_CLAUSES; LT; PSUBSET]]);; + +let SUM_ALTERNATING_CANCELS = prove + (`!s:A->bool f. + FINITE s /\ + CARD {x | x IN s /\ EVEN(f x)} = CARD {x | x IN s /\ ODD(f x)} + ==> sum s (\x. (-- &1) pow (f x)) = &0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {x | x IN s /\ EVEN(f x)} (\x. (-- &1) pow (f x)) + + sum {x:A | x IN s /\ ODD(f x)} (\x. (-- &1) pow (f x))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN + ASM_SIMP_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNION; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_POW_NEG; REAL_POW_ONE; GSYM NOT_EVEN; SUM_CONST; + FINITE_RESTRICT; REAL_ARITH `x * &1 + x * -- &1 = &0`]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a general "Moebius inversion" inclusion-exclusion principle. *) +(* This "symmetric" form is from Ira Gessel: "Symmetric Inclusion-Exclusion" *) +(* ------------------------------------------------------------------------- *) + +let INCLUSION_EXCLUSION_SYMMETRIC = prove + (`!f g:(A->bool)->real. + (!s. FINITE s + ==> g(s) = sum {t | t SUBSET s} (\t. (-- &1) pow (CARD t) * f(t))) + ==> !s. FINITE s + ==> f(s) = sum {t | t SUBSET s} (\t. (-- &1) pow (CARD t) * g(t))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {t:A->bool | t SUBSET s} + (\t. (-- &1) pow (CARD t) * + sum {u | u IN {u | u SUBSET s} /\ u SUBSET t} + (\u. (-- &1) pow (CARD u) * f(u)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; SET_RULE + `s SUBSET t ==> (u SUBSET t /\ u SUBSET s <=> u SUBSET s)`] THEN + ASM_MESON_TAC[FINITE_SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_SUM_RESTRICT o lhs o snd) THEN + ASM_SIMP_TAC[FINITE_POWERSET] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[SUM_RMUL; IN_ELIM_THM] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {u | u SUBSET s} (\u:A->bool. if u = s then f(s) else &0)` THEN + CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUM_DELTA; IN_ELIM_THM; SUBSET_REFL]] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `u:A->bool` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[SUBSET_ANTISYM_EQ; SET_RULE `{x | x = a} = {a}`] THEN + REWRITE_TAC[SUM_SING; REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; REAL_POW_ONE; REAL_MUL_LID]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ENTIRE] THEN REPEAT DISJ1_TAC THEN + MATCH_MP_TAC SUM_ALTERNATING_CANCELS THEN + ASM_SIMP_TAC[FINITE_SUBSETS_RESTRICT; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + MATCH_MP_TAC CARD_SUBSUPERSETS_EVEN_ODD THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The more typical non-symmetric version. *) +(* ------------------------------------------------------------------------- *) + +let INCLUSION_EXCLUSION_MOBIUS = prove + (`!f g:(A->bool)->real. + (!s. FINITE s ==> g(s) = sum {t | t SUBSET s} f) + ==> !s. FINITE s + ==> f(s) = sum {t | t SUBSET s} + (\t. (-- &1) pow (CARD s - CARD t) * g(t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t. -- &1 pow CARD(t:A->bool) * f t`; `g:(A->bool)->real`] + INCLUSION_EXCLUSION_SYMMETRIC) THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[EVEN_ADD; REAL_POW_ONE; REAL_POW_NEG; REAL_MUL_LID; ETA_AX]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) ((-- &1) pow (CARD(s:A->bool)))`) THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD; GSYM MULT_2] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `u:A->bool` THEN REWRITE_TAC[IN_ELIM_THM; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_POW_SUB; REAL_ARITH `~(-- &1 = &0)`; CARD_SUBSET] THEN + REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A related principle for real functions. *) +(* ------------------------------------------------------------------------- *) + +(*** Not clear how useful this is + +needs "Library/products.ml";; + +let INCLUSION_EXCLUSION_REAL_FUNCTION = prove + (`!f s:A->bool. + FINITE s + ==> product s (\x. &1 - f x) = + sum {t | t SUBSET s} (\t. (-- &1) pow (CARD t) * product t f)`, + let lemma = prove + (`{t | ?u. u SUBSET s /\ t = x INSERT u} = + IMAGE (\s. x INSERT s) {t | t SUBSET s}`, + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN + MESON_TAC[]) in + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; SUBSET_EMPTY; SUM_SING; CARD_CLAUSES; real_pow; + SET_RULE `{x | x = a} = {a}`; REAL_MUL_RID] THEN + REWRITE_TAC[SUBSET_INSERT_EXISTS] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE `{t | p t \/ q t} = {t | p t} UNION {t | q t}`] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_UNION o rand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_POWERSET; lemma; FINITE_IMAGE] THEN + REWRITE_TAC[GSYM lemma] THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM SUM_LMUL; REAL_SUB_RDISTRIB; REAL_MUL_LID; real_sub] THEN + AP_TERM_TAC THEN REWRITE_TAC[lemma] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[o_THM; IN_ELIM_THM] THEN X_GEN_TAC `t:A->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `FINITE(t:A->bool) /\ ~(x IN t)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; FINITE_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[PRODUCT_CLAUSES; CARD_CLAUSES; real_pow] THEN REAL_ARITH_TAC);; + +***) diff --git a/100/independence.ml b/100/independence.ml new file mode 100644 index 0000000..3d6b7e8 --- /dev/null +++ b/100/independence.ml @@ -0,0 +1,785 @@ +(* ========================================================================= *) +(* Independence of the parallel postulate. The statement and some ideas are *) +(* taken from Tim Makarios's MSc thesis "A mechanical verification of the *) +(* independence of Tarski's Euclidean axiom". *) +(* *) +(* In the file Multivariate/tarski.ml it is shown that all 11 of Tarski's *) +(* axioms for geometry hold for the Euclidean plane `:real^2`, with *) +(* betweenness and congruence of segments as: *) +(* *) +(* B x y z <=> between y (x,z) *) +(* ab == pq <=> dist(a,b) = dist(p,q) *) +(* *) +(* The present file shows that the Klein model of the hyperbolic plane (type *) +(* `:plane`) satisfies all Tarski's axioms except that it satisfies the *) +(* negation of the Euclidean axiom (10), with betweenness and congruence of *) +(* segments as: *) +(* *) +(* B x y z <=> pbetween y (x,z) *) +(* ab == pq <=> pdist(a,b) = pdist(p,q) *) +(* *) +(* Collectively, these two results show that the Euclidean axiom is *) +(* independent of the others. For more references regarding Tarski's axioms *) +(* for geometry see "http://en.wikipedia.org/wiki/Tarski's_axioms". *) +(* ========================================================================= *) + +needs "Multivariate/tarski.ml";; +needs "Multivariate/cauchy.ml";; + +(* ------------------------------------------------------------------------- *) +(* The semimetric we will use, directly on real^N first. Choose a sensible *) +(* default outside unit ball so some handy theorems become unconditional. *) +(* ------------------------------------------------------------------------- *) + +let mdist = new_definition + `mdist(x:real^N,y:real^N) = + if norm(x) < &1 /\ norm(y) < &1 then + (&1 - x dot y) pow 2 / ((&1 - norm(x) pow 2) * (&1 - norm(y) pow 2)) - &1 + else dist(x,y)`;; + +let MDIST_INCREASES_ONLINE = prove + (`!a b x:real^N. + norm a < &1 /\ norm b < &1 /\ norm x < &1 /\ between x (a,b) /\ ~(x = b) + ==> mdist(a,x) < mdist(a,b)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL + [ASM_MESON_TAC[BETWEEN_REFL_EQ]; ALL_TAC] THEN + ASM_SIMP_TAC[mdist; real_div; REAL_INV_MUL] THEN + SUBGOAL_THEN + `norm(a:real^N) pow 2 < &1 /\ norm(b:real^N) pow 2 < &1 /\ + norm(x:real^N) pow 2 < &1` + MP_TAC THENL [ASM_SIMP_TAC[ABS_SQUARE_LT_1; REAL_ABS_NORM]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `a * inv x * inv b - &1 < c * inv x * d - &1 <=> + (a / b) / x < (c * d) / x`] THEN + SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * inv b) * c:real = (a * c) / b`] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN + SUBGOAL_THEN `(a:real^N) dot b < &1 /\ (a:real^N) dot x < &1` MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC(MESON[REAL_LET_TRANS; NORM_CAUCHY_SCHWARZ] + `norm(x) * norm(y) < &1 ==> (x:real^N) dot y < &1`) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_IN_SEGMENT]) THEN + REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `u:real` THEN + ASM_CASES_TAC `u = &1` THEN + ASM_SIMP_TAC[VECTOR_ARITH `(&1 - &1) % a + &1 % b:real^N = b`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[VECTOR_ARITH `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN + ABBREV_TAC `c:real^N = b - a` THEN + SUBGOAL_THEN `b:real^N = a + c` SUBST_ALL_TAC THENL + [EXPAND_TAC "c" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(SIMP_RULE[VECTOR_ARITH `a + c:real^N = a <=> c = vec 0`]) THEN + REWRITE_TAC[NORM_POW_2; VECTOR_ARITH + `(a + b:real^N) dot (a + b) = a dot a + &2 * a dot b + b dot b`] THEN + REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH + `(&1 - (a + x * b)) pow 2 * (&1 - (a + &2 * b + c)) < + (&1 - (a + b)) pow 2 * (&1 - (a + &2 * x * b + x * x * c)) <=> + &0 < (&1 - a - b * x) * ((&1 - a) * c + b pow 2) * (&1 - x) + + (&1 - a - b) * ((&1 - a) * c + b pow 2) * (&1 - x) * x`] THEN + MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC); + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC)] THEN + TRY ASM_REAL_ARITH_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN + MATCH_MP_TAC REAL_LTE_ADD THEN REWRITE_TAC[REAL_LE_POW_2] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[DOT_POS_LT; REAL_SUB_LT]);; + +let MDIST_REFL = prove + (`!x:real^N. mdist(x,x) = &0`, + GEN_TAC THEN REWRITE_TAC[mdist; DIST_REFL; NORM_POW_2; NORM_LT_SQUARE] THEN + CONV_TAC REAL_FIELD);; + +let MDIST_SYM = prove + (`!x y:real^N. mdist(x,y) = mdist(y,x)`, + REWRITE_TAC[mdist; CONJ_ACI; REAL_MUL_AC; DIST_SYM; DOT_SYM]);; + +let MDIST_POS_LT = prove + (`!x y:real^N. ~(x = y) ==> &0 < mdist(x,y)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `norm(x:real^N) < &1 /\ norm(y:real^N) < &1` THENL + [ASM_MESON_TAC[MDIST_INCREASES_ONLINE; MDIST_REFL; BETWEEN_REFL]; + ASM_SIMP_TAC[mdist; DIST_POS_LT]]);; + +let MDIST_POS_LE = prove + (`!x y:real^N. &0 <= mdist(x,y)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN + ASM_SIMP_TAC[MDIST_REFL; MDIST_POS_LT; REAL_LE_LT]);; + +let MDIST_EQ_0 = prove + (`!x y:real^N. mdist(x,y) = &0 <=> x = y`, + MESON_TAC[MDIST_REFL; MDIST_POS_LT; REAL_LT_REFL]);; + +let BETWEEN_COLLINEAR_MDIST_EQ = prove + (`!a b x:real^N. + norm(a) < &1 /\ norm(b) < &1 /\ norm(x) < &1 + ==> (between x (a,b) <=> + collinear {a, x, b} /\ + mdist(x,a) <= mdist (a,b) /\ mdist(x,b) <= mdist(a,b))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL + [SIMP_TAC[BETWEEN_IMP_COLLINEAR]; + REWRITE_TAC[COLLINEAR_BETWEEN_CASES]] THEN + ASM_MESON_TAC[MDIST_INCREASES_ONLINE; MDIST_SYM; REAL_LT_IMP_LE; + REAL_LE_REFL; BETWEEN_SYM; REAL_NOT_LE; BETWEEN_REFL]);; + +let CONTINUOUS_AT_LIFT_MDIST = prove + (`!a x:real^N. + norm(a) < &1 /\ norm(x) < &1 ==> (\x. lift(mdist(a,x))) continuous at x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_TRANSFORM_AT THEN EXISTS_TAC + `\x:real^N. lift((&1 - a dot x) pow 2 / + ((&1 - norm a pow 2) * (&1 - norm x pow 2)) - &1)` THEN + EXISTS_TAC `&1 - norm(x:real^N)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `dist(y,x) < &1 - norm x ==> norm y < &1`)) THEN ASM_SIMP_TAC[mdist]; + REWRITE_TAC[LIFT_SUB; real_div; LIFT_CMUL; REAL_INV_MUL] THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN SIMP_TAC[CONTINUOUS_CONST] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_MUL THEN CONJ_TAC) THEN + SIMP_TAC[CONTINUOUS_CONST; o_DEF; REAL_POW_2; LIFT_CMUL] THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_MUL); + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_INV)] THEN + ASM_SIMP_TAC[REAL_ARITH `x < &1 * &1 ==> ~(&1 - x = &0)`; REAL_LT_MUL2; + NORM_POS_LE; LIFT_SUB] THEN + SIMP_TAC[GSYM REAL_POW_2; NORM_POW_2; CONTINUOUS_CONST; CONTINUOUS_AT_ID; + CONTINUOUS_SUB; CONTINUOUS_LIFT_DOT2]]);; + +let HYPERBOLIC_MIDPOINT = prove + (`!a b:real^N. + norm a < &1 /\ norm b < &1 + ==> ?x. between x (a,b) /\ mdist(x,a) = mdist(x,b)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\x:real^N. lift(mdist(x,a) - mdist(x,b))`; `segment[a:real^N,b]`] + CONNECTED_CONTINUOUS_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[CONNECTED_SEGMENT; LIFT_SUB] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN ONCE_REWRITE_TAC[MDIST_SYM] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_LIFT_MDIST THEN + ASM_MESON_TAC[BETWEEN_NORM_LT; BETWEEN_IN_SEGMENT]; + REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; LIFT_DROP] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `lift(&0)`]) THEN + ASM_SIMP_TAC[MDIST_REFL; LIFT_DROP; ENDS_IN_SEGMENT; IN_IMAGE] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_ARITH `&0 - x <= &0 <=> &0 <= x`] THEN + ASM_SIMP_TAC[MDIST_POS_LE; LIFT_EQ; BETWEEN_IN_SEGMENT] THEN + ASM_MESON_TAC[REAL_SUB_0; MDIST_SYM]]);; + +let MDIST_EQ_ORIGIN = prove + (`!x:real^N y:real^N. + norm x < &1 /\ norm y < &1 + ==> (mdist(vec 0,x) = mdist(vec 0,y) <=> norm x = norm y)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[mdist; NORM_0; REAL_LT_01] THEN + REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_EQ_INV2; + REAL_ARITH `x - &1 = y - &1 <=> x = y`] THEN + REWRITE_TAC[REAL_ARITH `&1 - x = &1 - y <=> x = y`; + GSYM REAL_EQ_SQUARE_ABS; REAL_ABS_NORM]);; + +let MDIST_CONGRUENT_TRIPLES_0 = prove + (`!a b:real^N a' b':real^N. + norm a < &1 /\ norm b < &1 /\ norm a' < &1 /\ norm b' < &1 + ==> (mdist(vec 0,a) = mdist(vec 0,a') /\ mdist(a,b) = mdist(a',b') /\ + mdist(b,vec 0) = mdist(b',vec 0) <=> + dist(vec 0,a) = dist(vec 0,a') /\ dist(a,b) = dist(a',b') /\ + dist(b,vec 0) = dist(b',vec 0))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MDIST_EQ_ORIGIN; REWRITE_RULE[MDIST_SYM] MDIST_EQ_ORIGIN] THEN + REWRITE_TAC[DIST_0; NORM_0; REAL_LT_01] THEN MATCH_MP_TAC(TAUT + `(a /\ b ==> (x <=> y)) ==> (a /\ x /\ b <=> a /\ y /\ b)`) THEN + STRIP_TAC THEN ASM_SIMP_TAC[mdist; DIST_EQ; real_div; REAL_INV_MUL; REAL_RING + `x * a * b - &1 = y * a * b - &1 <=> x = y \/ a = &0 \/ b = &0`] THEN + REWRITE_TAC[dist; NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + REWRITE_TAC[GSYM REAL_EQ_SQUARE_ABS; NORM_POW_2] THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; real_abs; REAL_SUB_LE; REAL_SUB_0] THEN + ASM_SIMP_TAC[ABS_SQUARE_LT_1; REAL_ABS_NORM; REAL_LT_IMP_NE; REAL_LT_IMP_LE; + MESON[NORM_CAUCHY_SCHWARZ; REAL_LET_TRANS; NORM_POS_LE; + REAL_LT_MUL2; REAL_MUL_RID; REAL_LT_IMP_LE] + `norm x < &1 /\ norm y < &1 ==> x dot y < &1`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NORM_EQ]) THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Deduce existence of hyperbolic translations via the Poincare disc model. *) +(* Use orthogonal projection onto a hemisphere touching the unit disc, *) +(* then stereographic projection back from the other pole of the sphere plus *) +(* scaling. See Greenberg's "Euclidean & Non-Euclidean Geometries" fig 7.13. *) +(* ------------------------------------------------------------------------- *) + +let kleinify = new_definition + `kleinify z = Cx(&2 / (&1 + norm(z) pow 2)) * z`;; + +let poincarify = new_definition + `poincarify x = Cx((&1 - sqrt(&1 - norm(x) pow 2)) / norm(x) pow 2) * x`;; + +let KLEINIFY_0,POINCARIFY_0 = (CONJ_PAIR o prove) + (`kleinify (Cx(&0)) = Cx(&0) /\ poincarify (Cx(&0)) = Cx(&0)`, + REWRITE_TAC[kleinify; poincarify; COMPLEX_MUL_RZERO]);; + +let NORM_KLEINIFY = prove + (`!z. norm(kleinify z) = (&2 * norm(z)) / (&1 + norm(z) pow 2)`, + REWRITE_TAC[kleinify; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_DIV] THEN + SIMP_TAC[REAL_LE_POW_2; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`] THEN + REAL_ARITH_TAC);; + +let NORM_KLEINIFY_LT = prove + (`!z. norm(kleinify z) < &1 <=> ~(norm z = &1)`, + ASM_SIMP_TAC[NORM_KLEINIFY; REAL_LE_POW_2; REAL_LT_LDIV_EQ; REAL_MUL_LID; + REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN + SIMP_TAC[REAL_ARITH `&2 * z < (&1 + z pow 2) <=> &0 < (z - &1) pow 2`] THEN + REWRITE_TAC[REAL_POW_2; REAL_LT_SQUARE] THEN REAL_ARITH_TAC);; + +let NORM_POINCARIFY_LT = prove + (`!x. norm(x) < &1 ==> norm(poincarify x) < &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[poincarify; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `x * y <= &1 * y /\ y < &1 ==> x * y < &1`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_POW] THEN + ASM_CASES_TAC `x:real^2 = vec 0` THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; REAL_POW_LT; NORM_0] THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LID]] THEN + MATCH_MP_TAC(REAL_ARITH `s <= &1 /\ &1 - x <= s ==> abs(&1 - s) <= x`) THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LSQRT; MATCH_MP_TAC REAL_LE_RSQRT] THEN + REWRITE_TAC[REAL_SUB_LE; REAL_POS; REAL_MUL_LID; REAL_POW_ONE] THEN + ASM_SIMP_TAC[REAL_ARITH `(&1 - x) pow 2 <= &1 - x <=> &0 <= x * (&1 - x)`; + REAL_ARITH `&1 - x <= &1 <=> &0 <= x`; REAL_LE_MUL; REAL_POW_LE; + REAL_SUB_LE; ABS_SQUARE_LE_1; REAL_LT_IMP_LE; REAL_ABS_NORM; NORM_POS_LE]);; + +let KLEINIFY_POINCARIFY = prove + (`!x. norm(x) < &1 ==> kleinify(poincarify x) = x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[kleinify; poincarify] THEN MATCH_MP_TAC + (COMPLEX_RING `(~(x = Cx(&0)) ==> w * z = Cx(&1)) ==> w * z * x = x`) THEN + DISCH_TAC THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_POW] THEN + ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD + `~(y = &0) + ==> (&1 + (a / y pow 2 * y) pow 2) = (y pow 2 + a pow 2) / y pow 2`] THEN + REWRITE_TAC[REAL_POW2_ABS; real_div; REAL_INV_MUL; REAL_INV_INV] THEN + ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD + `~(y = &0) ==> (&2 * x * y pow 2) * z * inv(y pow 2) = &2 * x * z`] THEN + MATCH_MP_TAC(REAL_FIELD `&0 < y /\ &2 * y = x ==> &2 * inv(x) * y = &1`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_LSQRT THEN + REWRITE_TAC[REAL_POS; REAL_ARITH `&1 - x < &1 pow 2 <=> &0 < x`] THEN + ASM_SIMP_TAC[REAL_POW_LT; COMPLEX_NORM_NZ]; + SUBGOAL_THEN `sqrt(&1 - norm(x:real^2) pow 2) pow 2 = &1 - norm x pow 2` + MP_TAC THENL [MATCH_MP_TAC SQRT_POW_2; CONV_TAC REAL_FIELD]] THEN + ASM_SIMP_TAC[REAL_SUB_LE; ABS_SQUARE_LE_1; REAL_ABS_NORM; REAL_LT_IMP_LE]);; + +let POINCARIFY_KLEINIFY = prove + (`!x. norm(x) < &1 ==> poincarify(kleinify x) = x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[kleinify; poincarify] THEN + MATCH_MP_TAC(COMPLEX_RING + `(~(x = Cx(&0)) ==> w * z = Cx(&1)) ==> w * z * x = x`) THEN + DISCH_TAC THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; GSYM REAL_MUL_ASSOC; + REAL_INV_POW; REAL_POW_MUL] THEN + MATCH_MP_TAC(REAL_FIELD + `~(c = &0) /\ abs d < &1 /\ a * b = &2 * c pow 2 * (&1 + d) + ==> a * inv(&2) pow 2 * b * inv(c) pow 2 * &2 * inv(&1 + d) = &1`) THEN + ASM_REWRITE_TAC[REAL_ABS_POW; COMPLEX_NORM_ZERO; ABS_SQUARE_LT_1] THEN + ASM_SIMP_TAC[REAL_ABS_NORM; REAL_POW_LE; NORM_POS_LE; REAL_ARITH + `&0 <= x ==> abs(&1 + x) = &1 + x`] THEN + MATCH_MP_TAC(REAL_FIELD + `~(x = &0) /\ abs x < &1 /\ a = &2 * x / (&1 + x) + ==> a * (&1 + x) pow 2 = &2 * x * (&1 + x)`) THEN + ASM_REWRITE_TAC[REAL_ABS_NORM; COMPLEX_NORM_ZERO; REAL_ABS_POW; + ABS_SQUARE_LT_1; REAL_POW_EQ_0] THEN + MATCH_MP_TAC(REAL_ARITH `x = &1 - y ==> &1 - x = y`) THEN + MATCH_MP_TAC SQRT_UNIQUE THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - &2 * x / y <=> (&2 * x) / y <= &1`] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LE; NORM_POS_LE; REAL_ARITH + `&0 <= x ==> &0 < &1 + x`] THEN + REWRITE_TAC[REAL_ARITH `&2 * x <= &1 * (&1 + x) <=> x <= &1`] THEN + ASM_SIMP_TAC[ABS_SQUARE_LE_1; REAL_ABS_NORM; REAL_LT_IMP_LE] THEN + SUBGOAL_THEN `~(&1 + norm(x:complex) pow 2 = &0)` MP_TAC THENL + [ALL_TAC; CONV_TAC REAL_FIELD] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) < &1 ==> ~(&1 + x = &0)`) THEN + ASM_REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NORM; ABS_SQUARE_LT_1]);; + +let MDIST_KLEINIFY = prove + (`!w z. ~(norm w = &1) /\ ~(norm z = &1) + ==> mdist(kleinify w,kleinify z) = + &4 * (&1 / &2 + norm(w - z) pow 2 / + ((&1 - norm w pow 2) * (&1 - norm z pow 2))) pow 2 + - &1`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `(&4 * norm(w - z:real^2) pow 2 * + ((&1 - norm w pow 2) * (&1 - norm z pow 2) + norm(w - z) pow 2)) / + ((&1 - norm w pow 2) pow 2 * (&1 - norm z pow 2) pow 2)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[mdist; NORM_KLEINIFY_LT] THEN MATCH_MP_TAC(REAL_FIELD + `~(y = &0) /\ z = (w + &1) * y ==> z / y - &1 = w`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THEN + MATCH_MP_TAC (REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`) THEN + ASM_SIMP_TAC[REAL_POW_1_LT; NORM_KLEINIFY_LT; NORM_POS_LE; ARITH]; + REWRITE_TAC[kleinify; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM COMPLEX_CMUL; DOT_LMUL] THEN REWRITE_TAC[DOT_RMUL] THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_POW_LE; NORM_POS_LE; + REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`] THEN + MATCH_MP_TAC(REAL_FIELD + `(~(y' = &0) /\ ~(y = &0)) /\ + (y * y' - &4 * d) pow 2 = + b * (y pow 2 - &4 * x pow 2) * (y' pow 2 - &4 * x' pow 2) + ==> (&1 - &2 / y * &2 / y' * d) pow 2 = + b * (&1 - (&2 / y * x) pow 2) * (&1 - (&2 / y' * x') pow 2)`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN + MATCH_MP_TAC(REAL_ARITH `~(abs x = &1) ==> ~(&1 + x = &0)`) THEN + ASM_SIMP_TAC[REAL_ABS_POW; REAL_POW_EQ_1; REAL_ABS_NORM] THEN ARITH_TAC; + REWRITE_TAC[REAL_RING `(&1 + x) pow 2 - &4 * x = (&1 - x) pow 2`] THEN + MATCH_MP_TAC(REAL_FIELD + `(~(y = &0) /\ ~(y' = &0)) /\ a - y * y' = b + ==> a = (b / (y * y') + &1) * y * y'`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_POW_EQ_0; REAL_POW_EQ_1; REAL_ABS_NORM; ARITH; + REAL_ARITH `&1 - x = &0 <=> x = &1`]; + REWRITE_TAC[NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + REAL_ARITH_TAC]]]; + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[NORM_EQ_SQUARE; GSYM NORM_POW_2] THEN CONV_TAC REAL_FIELD]);; + +let MDIST_KLEINIFY_EQ = prove + (`!w z w' z'. + ~(norm w = &1) /\ ~(norm z = &1) /\ ~(norm w' = &1) /\ ~(norm z' = &1) /\ + norm(w - z) pow 2 * (&1 - norm w' pow 2) * (&1 - norm z' pow 2) = + norm(w' - z') pow 2 * (&1 - norm w pow 2) * (&1 - norm z pow 2) + ==> mdist(kleinify w,kleinify z) = mdist(kleinify w',kleinify z')`, + SIMP_TAC[MDIST_KLEINIFY; NORM_EQ_SQUARE; GSYM NORM_POW_2; REAL_POS] THEN + CONV_TAC REAL_FIELD);; + +let NORM_KLEINIFY_MOEBIUS_LT = prove + (`!w x. norm w < &1 /\ norm x < &1 + ==> norm(kleinify(moebius_function (&0) w x)) < &1`, + SIMP_TAC[MOEBIUS_FUNCTION_NORM_LT_1; NORM_KLEINIFY_LT; REAL_LT_IMP_NE]);; + +let MDIST_KLEINIFY_MOEBIUS = prove + (`!w x y. norm w < &1 /\ norm x < &1 /\ norm y < &1 + ==> mdist(kleinify(moebius_function (&0) w x), + kleinify(moebius_function (&0) w y)) = + mdist(kleinify x,kleinify y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MDIST_KLEINIFY_EQ THEN + ASM_SIMP_TAC[MOEBIUS_FUNCTION_NORM_LT_1; REAL_LT_IMP_NE] THEN + REWRITE_TAC[MOEBIUS_FUNCTION_SIMPLE] THEN + SUBGOAL_THEN + `~(Cx(&1) - cnj w * x = Cx(&0)) /\ ~(Cx(&1) - cnj w * y = Cx(&0))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN + MATCH_MP_TAC(MESON[REAL_LT_REFL] `norm(x) < norm(y) ==> ~(y = x)`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_NORM_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CNJ]; + ASM_SIMP_TAC[COMPLEX_FIELD + `~(Cx(&1) - cnj w * x = Cx(&0)) /\ ~(Cx(&1) - cnj w * y = Cx(&0)) + ==> (x - w) / (Cx (&1) - cnj w * x) - (y - w) / (Cx (&1) - cnj w * y) = + ((Cx(&1) - w * cnj w) * (x - y)) / + ((Cx (&1) - cnj w * x) * (Cx (&1) - cnj w * y))`] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN + ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD + `~(y = &0) /\ ~(y' = &0) + ==> (&1 - (x / y) pow 2) * (&1 - (x' / y') pow 2) = + ((y pow 2 - x pow 2) * (y' pow 2 - x' pow 2)) / (y * y') pow 2`] THEN + REWRITE_TAC[REAL_POW_DIV; COMPLEX_NORM_MUL] THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC(REAL_RING + `x * y:real = w * z ==> (x * i) * y = w * z * i`) THEN + REWRITE_TAC[GSYM COMPLEX_NORM_MUL] THEN REWRITE_TAC[NORM_POW_2; DOT_2] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; complex_sub; complex_mul; CX_DEF; + complex_add; RE; IM; cnj; complex_neg] THEN REAL_ARITH_TAC]);; + +let COLLINEAR_KLEINIFY_MOEBIUS = prove + (`!w x y z. norm w < &1 /\ norm x < &1 /\ norm y < &1 /\ norm z < &1 + ==> (collinear {kleinify(moebius_function (&0) w x), + kleinify(moebius_function (&0) w y), + kleinify(moebius_function (&0) w z)} <=> + collinear {kleinify x,kleinify y,kleinify z})`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COLLINEAR_3_2D; kleinify; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX] THEN + SIMP_TAC[NORM_POS_LE; REAL_POW_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`; + REAL_FIELD + `~(nx = &0) /\ ~(ny = &0) /\ ~(nz = &0) + ==> ((&2 / nz * rz - &2 / nx * rx) * (&2 / ny * iy - &2 / nx * ix) = + (&2 / ny * ry - &2 / nx * rx) * (&2 / nz * iz - &2 / nx * ix) <=> + (nx * rz - nz * rx) * (nx * iy - ny * ix) = + (nx * ry - ny * rx) * (nx * iz - nz * ix))`] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; MOEBIUS_FUNCTION_SIMPLE] THEN + ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN + REWRITE_TAC[RE_DIV_CX; GSYM CX_POW; IM_DIV_CX] THEN + SUBGOAL_THEN + `~(Cx (&1) - cnj w * x = Cx(&0)) /\ ~(Cx (&1) - cnj w * y = Cx(&0)) /\ + ~(Cx (&1) - cnj w * z = Cx(&0))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_SUB_0] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC(MESON[REAL_LT_REFL] `norm x < norm y ==> ~(y = x)`) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; COMPLEX_NORM_CX] THEN + ONCE_REWRITE_TAC[REAL_ARITH `abs(&1) = &1 * &1`] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD + `~(nx = &0) /\ ~(ny = &0) /\ ~(nz = &0) + ==>(((&1 + (nxw / nx) pow 2) * rz / nz pow 2 - + (&1 + (nzw / nz) pow 2) * rx / nx pow 2) * + ((&1 + (nxw / nx) pow 2) * iy / ny pow 2 - + (&1 + (nyw / ny) pow 2) * ix / nx pow 2) = + ((&1 + (nxw / nx) pow 2) * ry / ny pow 2 - + (&1 + (nyw / ny) pow 2) * rx / nx pow 2) * + ((&1 + (nxw / nx) pow 2) * iz / nz pow 2 - + (&1 + (nzw / nz) pow 2) * ix / nx pow 2) <=> + ((nx pow 2 + nxw pow 2) * rz - (nz pow 2 + nzw pow 2) * rx) * + ((nx pow 2 + nxw pow 2) * iy - (ny pow 2 + nyw pow 2) * ix) = + ((nx pow 2 + nxw pow 2) * ry - (ny pow 2 + nyw pow 2) * rx) * + ((nx pow 2 + nxw pow 2) * iz - (nz pow 2 + nzw pow 2) * ix))`] THEN + REWRITE_TAC[COMPLEX_SQNORM; complex_sub; complex_mul; complex_add; + complex_neg; cnj; CX_DEF; RE; IM] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN MATCH_MP_TAC(REAL_RING + `!a b. a * lhs = b * rhs /\ ~(a = &0) /\ ~(b = &0) + ==> (lhs = &0 <=> rhs = &0)`) THEN + EXISTS_TAC `Re x pow 2 + Im x pow 2 + &1` THEN + EXISTS_TAC `--(Re w pow 2 + Im w pow 2 - &1) pow 3 * + ((&1 - Re(x) pow 2 - Im(x) pow 2) * + (&1 - Re(w) pow 2 - Im(w) pow 2) + + &2 * (Re w - Re x) pow 2 + &2 * (Im w - Im x) pow 2)` THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM; REAL_POW_EQ_0; ARITH_EQ] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `&0 <= x + y ==> ~(x + y + &1 = &0)`) THEN + ASM_SIMP_TAC[GSYM COMPLEX_SQNORM; REAL_LE_POW_2]; + MATCH_MP_TAC(REAL_ARITH `x + y < &1 ==> ~(--(x + y - &1) = &0)`) THEN + ASM_SIMP_TAC[GSYM COMPLEX_SQNORM; REAL_POW_1_LT; NORM_POS_LE; ARITH]; + MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 <= y ==> ~(x + y = &0)`) THEN + SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL; REAL_POS; REAL_LE_POW_2] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &1 - x - y <=> x + y < &1`] THEN + ASM_SIMP_TAC[GSYM COMPLEX_SQNORM; REAL_POW_1_LT; NORM_POS_LE; ARITH]]);; + +let BETWEEN_KLEINIFY_MOEBIUS = prove + (`!w x y z. norm w < &1 /\ norm x < &1 /\ norm y < &1 /\ norm z < &1 + ==> (between (kleinify(moebius_function (&0) w x)) + (kleinify(moebius_function (&0) w y), + kleinify(moebius_function (&0) w z)) <=> + between (kleinify x) (kleinify y,kleinify z))`, + SIMP_TAC[BETWEEN_COLLINEAR_MDIST_EQ; NORM_KLEINIFY_MOEBIUS_LT; + NORM_KLEINIFY_LT; REAL_LT_IMP_NE; + COLLINEAR_KLEINIFY_MOEBIUS; MDIST_KLEINIFY_MOEBIUS]);; + +let hyperbolic_isometry = new_definition + `hyperbolic_isometry (f:real^2->real^2) <=> + (!x. norm x < &1 ==> norm(f x) < &1) /\ + (!x y. norm x < &1 /\ norm y < &1 ==> mdist(f x,f y) = mdist(x,y)) /\ + (!x y z. norm x < &1 /\ norm y < &1 /\ norm z < &1 + ==> (between (f x) (f y,f z) <=> between x (y,z)))`;; + +let HYPERBOLIC_TRANSLATION = prove + (`!w. norm w < &1 + ==> ?f:real^2->real^2 g:real^2->real^2. + hyperbolic_isometry f /\ hyperbolic_isometry g /\ + f(w) = vec 0 /\ g(vec 0) = w /\ + (!x. norm x < &1 ==> f(g x) = x) /\ + (!x. norm x < &1 ==> g(f x) = x)`, + REPEAT STRIP_TAC THEN SIMP_TAC[hyperbolic_isometry] THEN MAP_EVERY EXISTS_TAC + [`\x. kleinify(moebius_function(&0) (poincarify w) (poincarify x))`; + `\x. kleinify(moebius_function(&0) (--(poincarify w)) (poincarify x))`] THEN + ASM_SIMP_TAC[NORM_KLEINIFY_MOEBIUS_LT; NORM_POINCARIFY_LT; + MDIST_KLEINIFY_MOEBIUS; KLEINIFY_POINCARIFY; VECTOR_NEG_NEG; + BETWEEN_KLEINIFY_MOEBIUS; NORM_NEG; MOEBIUS_FUNCTION_COMPOSE; + POINCARIFY_KLEINIFY; MOEBIUS_FUNCTION_NORM_LT_1] THEN + ASM_SIMP_TAC[MOEBIUS_FUNCTION_SIMPLE; COMPLEX_SUB_REFL; complex_div; + COMPLEX_VEC_0; KLEINIFY_0; POINCARIFY_0; COMPLEX_MUL_LZERO; + COMPLEX_MUL_RZERO; COMPLEX_SUB_LZERO; COMPLEX_NEG_NEG; + COMPLEX_SUB_RZERO; COMPLEX_INV_1; COMPLEX_MUL_RID; + KLEINIFY_POINCARIFY]);; + +(* ------------------------------------------------------------------------- *) +(* Our model. *) +(* ------------------------------------------------------------------------- *) + +let plane_tybij = + let th = prove + (`?x:real^2. norm x < &1`, + EXISTS_TAC `vec 0:real^2` THEN NORM_ARITH_TAC) in + new_type_definition "plane" ("mk_plane","dest_plane") th;; + +let pbetween = new_definition + `pbetween y (x,z) <=> between (dest_plane y) (dest_plane x,dest_plane z)`;; + +let pdist = new_definition + `pdist(x,y) = mdist(dest_plane x,dest_plane y)`;; + +let DEST_PLANE_NORM_LT = prove + (`!x. norm(dest_plane x) < &1`, + MESON_TAC[plane_tybij]);; + +let DEST_PLANE_EQ = prove + (`!x y. dest_plane x = dest_plane y <=> x = y`, + MESON_TAC[plane_tybij]);; + +let FORALL_DEST_PLANE = prove + (`!P. (!x. P(dest_plane x)) <=> (!x. norm x < &1 ==> P x)`, + MESON_TAC[plane_tybij]);; + +let EXISTS_DEST_PLANE = prove + (`!P. (?x. P(dest_plane x)) <=> (?x. norm x < &1 /\ P x)`, + MESON_TAC[plane_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 1 (reflexivity for equidistance). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_1_NONEUCLIDEAN = prove + (`!a b. pdist(a,b) = pdist(b,a)`, + REWRITE_TAC[pdist; MDIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 2 (transitivity for equidistance). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_2_NONEUCLIDEAN = prove + (`!a b p q r s. + pdist(a,b) = pdist(p,q) /\ pdist(a,b) = pdist(r,s) + ==> pdist(p,q) = pdist(r,s)`, + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 3 (identity for equidistance). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_3_NONEUCLIDEAN = prove + (`!a b c. pdist(a,b) = pdist(c,c) ==> a = b`, + SIMP_TAC[FORALL_DEST_PLANE; pdist; MDIST_REFL; MDIST_EQ_0; DEST_PLANE_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 4 (segment construction). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_4_NONEUCLIDEAN = prove + (`!a q b c. ?x. pbetween a (q,x) /\ pdist(a,x) = pdist(b,c)`, + REWRITE_TAC[pbetween; pdist; FORALL_DEST_PLANE; EXISTS_DEST_PLANE] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `?d:real^2. norm d < &1 /\ mdist(b:real^2,c) = mdist(vec 0,d)` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `b:real^2` HYPERBOLIC_TRANSLATION) THEN + ASM_REWRITE_TAC[hyperbolic_isometry] THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN + `norm(a:real^2) < &1 /\ norm(q:real^2) < &1 /\ norm(d:real^2) < &1` + MP_TAC THENL [ASM_REWRITE_TAC[]; REPEAT(POP_ASSUM(K ALL_TAC))] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`d:real^2`; `q:real^2`; `a:real^2`] THEN + MATCH_MP_TAC(MESON[] `P(vec 0) /\ (P(vec 0) ==> !x. P x) ==> !x. P x`) THEN + REWRITE_TAC[NORM_0; REAL_LT_01] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `vec 0:real^2` TARSKI_AXIOM_4_EUCLIDEAN) THEN + MESON_TAC[DIST_0; MDIST_EQ_ORIGIN]; + DISCH_THEN(LABEL_TAC "*") THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `a:real^2` HYPERBOLIC_TRANSLATION) THEN + ASM_REWRITE_TAC[hyperbolic_isometry; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^2->real^2`; `g:real^2->real^2`] THEN + STRIP_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPECL [`(f:real^2->real^2) q`; `d:real^2`]) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^2` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:real^2->real^2) x` THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 5 (five-segments axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_5_NONEUCLIDEAN = prove + (`!a b c x a' b' c' x'. + ~(a = b) /\ + pdist(a,b) = pdist(a',b') /\ + pdist(a,c) = pdist(a',c') /\ + pdist(b,c) = pdist(b',c') /\ + pbetween b (a,x) /\ pbetween b' (a',x') /\ pdist(b,x) = pdist(b',x') + ==> pdist(c,x) = pdist(c',x')`, + REWRITE_TAC[FORALL_DEST_PLANE; pdist; pbetween; GSYM DEST_PLANE_EQ] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `b':real^2` HYPERBOLIC_TRANSLATION) THEN + MP_TAC(ISPEC `b:real^2` HYPERBOLIC_TRANSLATION) THEN + ASM_REWRITE_TAC[RIGHT_IMP_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[hyperbolic_isometry] THEN MAP_EVERY X_GEN_TAC + [`f:real^2->real^2`; `f':real^2->real^2`; `g:real^2->real^2`; + `g':real^2->real^2`] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(f:real^2->real^2) x`; `(f:real^2->real^2) c`; + `(g:real^2->real^2) x'`; `(g:real^2->real^2) c'`] + MDIST_CONGRUENT_TRIPLES_0) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(p ==> r) /\ q ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[MDIST_SYM]; ALL_TAC] THEN + MP_TAC(ISPECL [`(f:real^2->real^2) a`; `(f:real^2->real^2) c`; + `(g:real^2->real^2) a'`; `(g:real^2->real^2) c'`] + MDIST_CONGRUENT_TRIPLES_0) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM MDIST_CONGRUENT_TRIPLES_0] THEN CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [SYM(ASSUME `(f:complex->complex) b = vec 0`)] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [SYM(ASSUME `(g:complex->complex) b' = vec 0`)] THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[MDIST_SYM]; + STRIP_TAC THEN MP_TAC(ISPECL + [`(f:real^2->real^2) a`; `(f:real^2->real^2) b`; `(f:real^2->real^2) c`; + `(f:real^2->real^2) x`;`(g:real^2->real^2) a'`; `(g:real^2->real^2) b'`; + `(g:real^2->real^2) c'`; `(g:real^2->real^2) x'`] + TARSKI_AXIOM_5_EUCLIDEAN) THEN + SUBGOAL_THEN + `mdist((f:real^2->real^2) b,f x) = mdist((g:real^2->real^2) b',g x')` + MP_TAC THENL + [ASM_SIMP_TAC[]; + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MDIST_EQ_ORIGIN] THEN DISCH_TAC] THEN + ASM_MESON_TAC[DIST_SYM; DIST_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 6 (identity for between-ness). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_6_NONEUCLIDEAN = prove + (`!a b. pbetween b (a,a) ==> a = b`, + REWRITE_TAC[pbetween; FORALL_DEST_PLANE; GSYM DEST_PLANE_EQ] THEN + MESON_TAC[TARSKI_AXIOM_6_EUCLIDEAN]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 7 (Pasch's axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_7_NONEUCLIDEAN = prove + (`!a b c p q. + pbetween p (a,c) /\ pbetween q (b,c) + ==> ?x. pbetween x (p,b) /\ pbetween x (q,a)`, + REWRITE_TAC[pbetween; FORALL_DEST_PLANE; EXISTS_DEST_PLANE] THEN + MESON_TAC[BETWEEN_NORM_LT; TARSKI_AXIOM_7_EUCLIDEAN]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 8 (lower 2-dimensional axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_8_NONEUCLIDEAN = prove + (`?a b c. ~pbetween b (a,c) /\ ~pbetween c (b,a) /\ ~pbetween a (c,b)`, + REWRITE_TAC[pbetween; EXISTS_DEST_PLANE; NORM_LT_SQUARE; NORM_POW_2] THEN + MAP_EVERY (fun t -> EXISTS_TAC t THEN + SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV) + [`vec 0:real^2`; `(&1 / &2) % basis 1:real^2`; + `(&1 / &2) % basis 2:real^2`] THEN + REPEAT CONJ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN + SIMP_TAC[COLLINEAR_3_2D; VECTOR_MUL_COMPONENT; VEC_COMPONENT; ARITH; + BASIS_COMPONENT; DIMINDEX_2] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 9 (upper 2-dimensional axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_9_NONEUCLIDEAN = prove + (`!p q a b c. + ~(p = q) /\ + pdist(a,p) = pdist(a,q) /\ pdist(b,p) = pdist(b,q) /\ + pdist(c,p) = pdist(c,q) + ==> pbetween b (a,c) \/ pbetween c (b,a) \/ pbetween a (c,b)`, + REWRITE_TAC[pdist; pbetween; FORALL_DEST_PLANE; GSYM DEST_PLANE_EQ] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:real^2`; `q:real^2`] HYPERBOLIC_MIDPOINT) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `x:real^2` THEN + STRIP_TAC THEN MP_TAC(ISPEC `x:real^2` HYPERBOLIC_TRANSLATION) THEN + SUBGOAL_THEN `norm(x:real^2) < &1` ASSUME_TAC THENL + [ASM_MESON_TAC[BETWEEN_NORM_LT]; ONCE_REWRITE_TAC[BETWEEN_SYM]] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; hyperbolic_isometry] THEN + REWRITE_TAC[GSYM COLLINEAR_BETWEEN_CASES] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `collinear{(f:real^2->real^2) b,f c,f a}` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[COLLINEAR_BETWEEN_CASES]] THEN + SUBGOAL_THEN `mdist(f a,f p) = mdist(f a,f q) /\ + mdist(f b,f p) = mdist(f b,f q) /\ + mdist(f c,f p) = mdist(f c,f q) /\ + ~((f:real^2->real^2) q = f p)` + MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(f:real^2->real^2) q = --(f p)` SUBST1_TAC THENL + [SUBGOAL_THEN `between ((f:real^2->real^2) x) (f p,f q) /\ + mdist(f x,f p) = mdist(f x,f q)` + MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MDIST_EQ_ORIGIN] THEN + REWRITE_TAC[GSYM MIDPOINT_BETWEEN; midpoint; NORM_ARITH + `norm(a:real^N) = norm b <=> dist(a,vec 0) = dist(vec 0,b)`] THEN + VECTOR_ARITH_TAC; + REWRITE_TAC[mdist] THEN ASM_SIMP_TAC[NORM_NEG; real_div; REAL_INV_MUL] THEN + ASM_SIMP_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1; REAL_ABS_NORM; REAL_FIELD + `&0 < x /\ &0 < y + ==> (a * inv x * inv y - &1 = b * inv x * inv y - &1 <=> a = b)`] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = x <=> x = vec 0`] THEN + REWRITE_TAC[COLLINEAR_3_2D; VECTOR_SUB_COMPONENT; DOT_2; GSYM DOT_EQ_0; + VECTOR_NEG_COMPONENT] THEN CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 10 (Euclidean axiom). *) +(* ------------------------------------------------------------------------- *) + +let NOT_TARSKI_AXIOM_10_NONEUCLIDEAN = prove + (`~(!a b c d t. + pbetween d (a,t) /\ pbetween d (b,c) /\ ~(a = d) + ==> ?x y. pbetween b (a,x) /\ pbetween c (a,y) /\ pbetween t (x,y))`, + REWRITE_TAC[pbetween; FORALL_DEST_PLANE; EXISTS_DEST_PLANE; + GSYM DEST_PLANE_EQ; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + DISCH_THEN(MP_TAC o SPECL + [`vec 0:real^2`; `&1 / &2 % basis 1:real^2`; `&1 / &2 % basis 2:real^2`; + `&1 / &4 % basis 1 + &1 / &4 % basis 2:real^2`; + `&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2`]) THEN + REWRITE_TAC[NOT_IMP; CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN + REWRITE_TAC[IMP_CONJ] THEN REPEAT(GEN_TAC THEN DISCH_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN + SIMP_TAC[COLLINEAR_3_2D; BASIS_COMPONENT; DIMINDEX_2; ARITH; VEC_COMPONENT; + VECTOR_MUL_COMPONENT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_RZERO; + REAL_ARITH `&0 = &1 / &2 * x <=> x = &0`] THEN + REWRITE_TAC[REAL_ENTIRE] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MP_TAC(ISPECL [`x:real^2`; `1`] COMPONENT_LE_NORM) THEN + MP_TAC(ISPECL [`y:real^2`; `2`] COMPONENT_LE_NORM) THEN + SIMP_TAC[DIMINDEX_2; ARITH; BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `norm(&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2) pow 2 <= &1 / &2` + MP_TAC THENL + [SUBGOAL_THEN `(&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2)$2 = + (&3 / &5 % basis 1 + &3 / &5 % basis 2:real^2)$1` + MP_TAC THENL + [SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; ARITH; BASIS_COMPONENT; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN + ASM_SIMP_TAC[DIMINDEX_2; FORALL_2; DOT_2; VECTOR_ADD_COMPONENT; ARITH; + VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `a * &0 + y = x + b * &0 ==> abs x + abs y <= (&1 - u) * &1 + u * &1 + ==> abs x <= abs(&1 / &2) /\ abs y <= abs(&1 / &2)`)) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN REAL_ARITH_TAC]; + ALL_TAC]] THEN + SIMP_TAC[NORM_LT_SQUARE; NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LZERO; + DOT_LMUL; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_2; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `&5 / &12`; EXISTS_TAC `&1 / &2`; ALL_TAC] THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; ARITH; BASIS_COMPONENT; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 11 (Continuity). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_11_NONEUCLIDEAN = prove + (`!X Y. (?a. !x y. x IN X /\ y IN Y ==> pbetween x (a,y)) + ==> (?b. !x y. x IN X /\ y IN Y ==> pbetween b (x,y))`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `X:plane->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `Y:plane->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[pbetween; EXISTS_DEST_PLANE] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^2` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`IMAGE dest_plane X`; `IMAGE dest_plane Y`] + TARSKI_AXIOM_11_EUCLIDEAN) THEN REWRITE_TAC[IN_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; DEST_PLANE_NORM_LT; BETWEEN_NORM_LT]);; diff --git a/100/isosceles.ml b/100/isosceles.ml new file mode 100644 index 0000000..9655a63 --- /dev/null +++ b/100/isosceles.ml @@ -0,0 +1,237 @@ +(* ========================================================================= *) +(* Isosceles triangle theorem. *) +(* ========================================================================= *) + +needs "Multivariate/geom.ml";; + +(* ------------------------------------------------------------------------- *) +(* The theorem, according to Wikipedia. *) +(* ------------------------------------------------------------------------- *) + +let ISOSCELES_TRIANGLE_THEOREM = prove + (`!A B C:real^N. dist(A,C) = dist(B,C) ==> angle(C,A,B) = angle(A,B,C)`, + MP_TAC(INST_TYPE [`:N`,`:M`] CONGRUENT_TRIANGLES_SSS) THEN + MESON_TAC[DIST_SYM; ANGLE_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* The obvious converse. *) +(* ------------------------------------------------------------------------- *) + +let ISOSCELES_TRIANGLE_CONVERSE = prove + (`!A B C:real^N. angle(C,A,B) = angle(A,B,C) /\ ~(collinear {A,B,C}) + ==> dist(A,C) = dist(B,C)`, + MP_TAC(INST_TYPE [`:N`,`:M`] CONGRUENT_TRIANGLES_ASA_FULL) THEN + MESON_TAC[DIST_SYM; ANGLE_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Some other equivalents sometimes called the ITT (see the Web page *) +(* http://www.sonoma.edu/users/w/wilsonst/Courses/Math_150/Theorems/itt.html *) +(* ------------------------------------------------------------------------- *) + +let lemma = prove + (`!A B C D:real^N. + between D (A,B) + ==> (orthogonal (A - B) (C - D) <=> + angle(A,D,C) = pi / &2 /\ angle(B,D,C) = pi / &2)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `D:real^N = A` THENL + [DISCH_TAC THEN ASM_SIMP_TAC[ANGLE_REFL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ORTHOGONAL_LNEG] THEN + REWRITE_TAC[VECTOR_NEG_SUB; ORTHOGONAL_VECTOR_ANGLE; angle]; + ALL_TAC] THEN + ASM_CASES_TAC `D:real^N = B` THENL + [DISCH_TAC THEN ASM_SIMP_TAC[ANGLE_REFL] THEN + REWRITE_TAC[ORTHOGONAL_VECTOR_ANGLE; angle]; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `D:real^N`; `C:real^N`] + ANGLES_ALONG_LINE) THEN + ASM_REWRITE_TAC[ORTHOGONAL_VECTOR_ANGLE] THEN + MATCH_MP_TAC(REAL_ARITH + `x = z ==> x + y = p ==> (z = p / &2 <=> x = p / &2 /\ y = p / &2)`) THEN + REWRITE_TAC[angle] THEN MATCH_MP_TAC VECTOR_ANGLE_EQ_0_RIGHT THEN + ONCE_REWRITE_TAC[GSYM VECTOR_ANGLE_NEG2] THEN + REWRITE_TAC[VECTOR_NEG_SUB; GSYM angle] THEN + ASM_MESON_TAC[ANGLE_EQ_PI_OTHERS; BETWEEN_ANGLE]);; + +let ISOSCELES_TRIANGLE_1 = prove + (`!A B C D:real^N. + dist(A,C) = dist(B,C) /\ D = midpoint(A,B) + ==> angle(A,C,D) = angle(B,C,D)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`A:real^N`; `D:real^N`; `C:real^N`; + `B:real^N`; `D:real^N`; `C:real^N`] + CONGRUENT_TRIANGLES_SSS_FULL) THEN + ASM_REWRITE_TAC[DIST_MIDPOINT] THEN ASM_MESON_TAC[DIST_SYM; ANGLE_SYM]);; + +let ISOSCELES_TRIANGLE_2 = prove + (`!A B C D:real^N. + between D (A,B) /\ + dist(A,C) = dist(B,C) /\ angle(A,C,D) = angle(B,C,D) + ==> orthogonal (A - B) (C - D)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOSCELES_TRIANGLE_THEOREM) THEN + MP_TAC(ISPECL [`D:real^N`; `C:real^N`; `A:real^N`; + `D:real^N`; `C:real^N`; `B:real^N`] + CONGRUENT_TRIANGLES_SAS_FULL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM; ANGLE_SYM]; ALL_TAC] THEN + ASM_CASES_TAC `D:real^N = B` THEN + ASM_SIMP_TAC[DIST_EQ_0; DIST_REFL; VECTOR_SUB_REFL; ORTHOGONAL_0] THEN + ASM_CASES_TAC `D:real^N = A` THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN + ASM_SIMP_TAC[lemma] THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `D:real^N`; `C:real^N`] + ANGLES_ALONG_LINE) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let ISOSCELES_TRIANGLE_3 = prove + (`!A B C D:real^N. + between D (A,B) /\ + dist(A,C) = dist(B,C) /\ orthogonal (A - B) (C - D) + ==> D = midpoint(A,B)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = B` THEN + ASM_SIMP_TAC[BETWEEN_REFL_EQ; MIDPOINT_REFL] THEN + ASM_CASES_TAC `D:real^N = A` THENL + [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] PYTHAGORAS) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_LNEG; VECTOR_NEG_SUB]; ALL_TAC] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[GSYM dist] THEN + ASM_REWRITE_TAC[REAL_RING `a = x pow 2 + a <=> x = &0`; DIST_EQ_0]; + ALL_TAC] THEN + ASM_CASES_TAC `D:real^N = B` THENL + [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] PYTHAGORAS) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_LNEG; VECTOR_NEG_SUB]; ALL_TAC] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[GSYM dist] THEN + ASM_REWRITE_TAC[REAL_RING `a = x pow 2 + a <=> x = &0`; DIST_EQ_0]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[lemma; MIDPOINT_COLLINEAR; BETWEEN_IMP_COLLINEAR] THEN + STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOSCELES_TRIANGLE_THEOREM) THEN + MP_TAC(ISPECL + [`A:real^N`; `C:real^N`; `D:real^N`; + `B:real^N`; `C:real^N`; `D:real^N`] + CONGRUENT_TRIANGLES_SAS) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN + MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `a:real = a' /\ b = b' + ==> a + x + b = p ==> a' + x' + b' = p ==> x' = x`) THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ANGLE_SYM]] THEN + CONV_TAC SYM_CONV THEN + UNDISCH_TAC `angle(C:real^N,A,B) = angle (A,B,C)` THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC ANGLE_EQ_0_LEFT; + GEN_REWRITE_TAC RAND_CONV [ANGLE_SYM] THEN + MATCH_MP_TAC ANGLE_EQ_0_RIGHT] THEN + ASM_MESON_TAC[ANGLE_EQ_PI_OTHERS; BETWEEN_ANGLE]);; + +(* ------------------------------------------------------------------------- *) +(* Now the converses to those as well. *) +(* ------------------------------------------------------------------------- *) + +let ISOSCELES_TRIANGLE_4 = prove + (`!A B C D:real^N. + D = midpoint(A,B) /\ orthogonal (A - B) (C - D) + ==> dist(A,C) = dist(B,C)`, + REPEAT GEN_TAC THEN ASM_SIMP_TAC[IMP_CONJ; BETWEEN_MIDPOINT; lemma] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN + REPEAT DISCH_TAC THEN MATCH_MP_TAC CONGRUENT_TRIANGLES_SAS THEN + MAP_EVERY EXISTS_TAC [`D:real^N`; `D:real^N`] THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "D" THEN REWRITE_TAC[DIST_MIDPOINT]);; + +let ISOSCELES_TRIANGLE_5 = prove + (`!A B C D:real^N. + ~collinear{D,C,A} /\ between D (A,B) /\ + angle(A,C,D) = angle(B,C,D) /\ orthogonal (A - B) (C - D) + ==> dist(A,C) = dist(B,C)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `C:real^N = D` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + UNDISCH_TAC `~(C:real^N = D)` THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT; GSYM CONJ_ASSOC] THEN + ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `C:real^N = A` THENL + [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[ANGLE_REFL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_ANGLE]) THEN + ASM_CASES_TAC `D:real^N = A` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `D:real^N = B` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ARITH `x / &2 = &0 <=> x = &0`; + PI_NZ] THEN + DISCH_THEN(MP_TAC o MATCH_MP ANGLE_EQ_PI_OTHERS) THEN + MP_TAC PI_NZ THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `C:real^N = B` THENL + [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[ANGLE_REFL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BETWEEN_ANGLE]) THEN + ASM_CASES_TAC `D:real^N = B` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `D:real^N = A` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ARITH `&0 = x / &2 <=> x = &0`; + PI_NZ] THEN + DISCH_THEN(MP_TAC o MATCH_MP ANGLE_EQ_PI_OTHERS) THEN + MP_TAC PI_NZ THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[IMP_CONJ; lemma] THEN + REPEAT DISCH_TAC THEN MP_TAC( + ISPECL [`D:real^N`; `C:real^N`; `A:real^N`; + `D:real^N`; `C:real^N`; `B:real^N`] + CONGRUENT_TRIANGLES_ASA_FULL) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN + ONCE_REWRITE_TAC[ANGLE_SYM] THEN ASM_REWRITE_TAC[]);; + +let ISOSCELES_TRIANGLE_6 = prove + (`!A B C D:real^N. + ~collinear{D,C,A} /\ D = midpoint(A,B) /\ angle(A,C,D) = angle(B,C,D) + ==> dist(A,C) = dist(B,C)`, + REPEAT GEN_TAC THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`] LAW_OF_SINES) THEN + MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `D:real^N`] LAW_OF_SINES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + EXPAND_TAC "D" THEN REWRITE_TAC[DIST_MIDPOINT] THEN + ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_HALF; DIST_POS_LT; + SIN_ANGLE_EQ] THEN + STRIP_TAC THENL + [MP_TAC(ISPECL [`D:real^N`; `C:real^N`; `A:real^N`; + `D:real^N`; `C:real^N`; `B:real^N`] + CONGRUENT_TRIANGLES_AAS) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ANGLE_SYM] THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] + TRIANGLE_ANGLE_SUM) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `angle(A:real^N,B,C) = angle(C,B,D) /\ + angle(B,A,C) = angle(C,A,D)` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [ANGLE_SYM] THEN + MATCH_MP_TAC ANGLE_EQ_0_LEFT THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`] BETWEEN_MIDPOINT) THEN + ASM_REWRITE_TAC[BETWEEN_ANGLE] THEN EXPAND_TAC "D" THEN + REWRITE_TAC[MIDPOINT_EQ_ENDPOINT] THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[ANGLE_EQ_PI_OTHERS]; + ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ARITH `a + pi - a + x = pi <=> x = &0`] THEN + MAP_EVERY ASM_CASES_TAC + [`B:real^N = C`; `A:real^N = C`] THEN + ASM_REWRITE_TAC[ANGLE_REFL; REAL_ARITH `p / &2 = &0 <=> p = &0`] THEN + ASM_REWRITE_TAC[PI_NZ] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `A:real^N`] COLLINEAR_ANGLE) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~collinear{D:real^N,C,A}` THEN + MATCH_MP_TAC(TAUT `(q ==> p) ==> ~p ==> q ==> r`) THEN + ONCE_REWRITE_TAC[SET_RULE `{bd,c,a} = {c,a,bd}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[COLLINEAR_LEMMA] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN + EXPAND_TAC "D" THEN REWRITE_TAC[midpoint] THEN + REWRITE_TAC[VECTOR_ARITH `inv(&2) % (A + B) - A = inv(&2) % (B - A)`] THEN + MESON_TAC[VECTOR_MUL_ASSOC]]);; diff --git a/100/konigsberg.ml b/100/konigsberg.ml new file mode 100644 index 0000000..0cba5fd --- /dev/null +++ b/100/konigsberg.ml @@ -0,0 +1,236 @@ +(* ========================================================================= *) +(* Impossibility of Eulerian path for bridges of Koenigsberg. *) +(* ========================================================================= *) + +let edges = new_definition + `edges(E:E->bool,V:V->bool,Ter:E->V->bool) = E`;; + +let vertices = new_definition + `vertices(E:E->bool,V:V->bool,Ter:E->V->bool) = V`;; + +let termini = new_definition + `termini(E:E->bool,V:V->bool,Ter:E->V->bool) = Ter`;; + +(* ------------------------------------------------------------------------- *) +(* Definition of an undirected graph. *) +(* ------------------------------------------------------------------------- *) + +let graph = new_definition + `graph G <=> + !e. e IN edges(G) + ==> ?a b. a IN vertices(G) /\ b IN vertices(G) /\ + termini G e = {a,b}`;; + +let TERMINI_IN_VERTICES = prove + (`!G e v. graph G /\ e IN edges(G) /\ v IN termini G e ==> v IN vertices G`, + REWRITE_TAC[graph; EXTENSION; IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Connection in a graph. *) +(* ------------------------------------------------------------------------- *) + +let connects = new_definition + `connects G e (a,b) <=> termini G e = {a,b}`;; + +(* ------------------------------------------------------------------------- *) +(* Delete an edge in a graph. *) +(* ------------------------------------------------------------------------- *) + +let delete_edge = new_definition + `delete_edge e (E,V,Ter) = (E DELETE e,V,Ter)`;; + +let DELETE_EDGE_CLAUSES = prove + (`(!G. edges(delete_edge e G) = (edges G) DELETE e) /\ + (!G. vertices(delete_edge e G) = vertices G) /\ + (!G. termini(delete_edge e G) = termini G)`, + REWRITE_TAC[FORALL_PAIR_THM; delete_edge; edges; vertices; termini]);; + +let GRAPH_DELETE_EDGE = prove + (`!G e. graph G ==> graph(delete_edge e G)`, + REWRITE_TAC[graph; DELETE_EDGE_CLAUSES; IN_DELETE] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Local finiteness: set of edges with given endpoint is finite. *) +(* ------------------------------------------------------------------------- *) + +let locally_finite = new_definition + `locally_finite G <=> + !v. v IN vertices(G) ==> FINITE {e | e IN edges G /\ v IN termini G e}`;; + +(* ------------------------------------------------------------------------- *) +(* Degree of a vertex. *) +(* ------------------------------------------------------------------------- *) + +let localdegree = new_definition + `localdegree G v e = + if termini G e = {v} then 2 + else if v IN termini G e then 1 + else 0`;; + +let degree = new_definition + `degree G v = nsum {e | e IN edges G /\ v IN termini G e} (localdegree G v)`;; + +let DEGREE_DELETE_EDGE = prove + (`!G e:E v:V. + graph G /\ locally_finite G /\ e IN edges(G) + ==> degree G v = + if termini G e = {v} then degree (delete_edge e G) v + 2 + else if v IN termini G e then degree (delete_edge e G) v + 1 + else degree (delete_edge e G) v`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[degree; DELETE_EDGE_CLAUSES; IN_DELETE] THEN + SUBGOAL_THEN + `{e:E | e IN edges G /\ (v:V) IN termini G e} = + if v IN termini G e + then e INSERT {e' | (e' IN edges G /\ ~(e' = e)) /\ v IN termini G e'} + else {e' | (e' IN edges G /\ ~(e' = e)) /\ v IN termini G e'}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_INSERT] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `(v:V) IN termini G (e:E)` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + COND_CASES_TAC THENL [ASM_MESON_TAC[IN_SING; EXTENSION]; ALL_TAC] THEN + MATCH_MP_TAC NSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM; localdegree] THEN + REWRITE_TAC[DELETE_EDGE_CLAUSES]] THEN + SUBGOAL_THEN + `FINITE {e':E | (e' IN edges G /\ ~(e' = e)) /\ (v:V) IN termini G e'}` + (fun th -> SIMP_TAC[NSUM_CLAUSES; th]) + THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{e:E | e IN edges G /\ (v:V) IN termini G e}` THEN + SIMP_TAC[IN_ELIM_THM; SUBSET] THEN + ASM_MESON_TAC[locally_finite; TERMINI_IN_VERTICES]; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[localdegree] THEN + SUBGOAL_THEN + `nsum {e':E | (e' IN edges G /\ ~(e' = e)) /\ (v:V) IN termini G e'} + (localdegree (delete_edge e G) v) = + nsum {e' | (e' IN edges G /\ ~(e' = e)) /\ v IN termini G e'} + (localdegree G v)` + SUBST1_TAC THENL + [ALL_TAC; COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ARITH_TAC] THEN + MATCH_MP_TAC NSUM_EQ THEN SIMP_TAC[localdegree; DELETE_EDGE_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of Eulerian path. *) +(* ------------------------------------------------------------------------- *) + +let eulerian_RULES,eulerian_INDUCT,eulerian_CASES = new_inductive_definition + `(!G a. a IN vertices G /\ edges G = {} ==> eulerian G [] (a,a)) /\ + (!G a b c e es. e IN edges(G) /\ connects G e (a,b) /\ + eulerian (delete_edge e G) es (b,c) + ==> eulerian G (CONS e es) (a,c))`;; + +let EULERIAN_FINITE = prove + (`!G es ab. eulerian G es ab ==> FINITE (edges G)`, + MATCH_MP_TAC eulerian_INDUCT THEN + SIMP_TAC[DELETE_EDGE_CLAUSES; FINITE_DELETE; FINITE_RULES]);; + +(* ------------------------------------------------------------------------- *) +(* The main result. *) +(* ------------------------------------------------------------------------- *) + +let EULERIAN_ODD_LEMMA = prove + (`!G:(E->bool)#(V->bool)#(E->V->bool) es ab. + eulerian G es ab + ==> graph G + ==> FINITE(edges G) /\ + !v. v IN vertices G + ==> (ODD(degree G v) <=> + ~(FST ab = SND ab) /\ (v = FST ab \/ v = SND ab))`, + MATCH_MP_TAC eulerian_INDUCT THEN CONJ_TAC THENL + [SIMP_TAC[degree; NOT_IN_EMPTY; SET_RULE `{x | F} = {}`] THEN + SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; ARITH]; + ALL_TAC] THEN + SIMP_TAC[GRAPH_DELETE_EDGE; FINITE_DELETE; DELETE_EDGE_CLAUSES] THEN + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[GRAPH_DELETE_EDGE] THEN STRIP_TAC THEN + X_GEN_TAC `v:V` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`G:(E->bool)#(V->bool)#(E->V->bool)`; `e:E`; `v:V`] + DEGREE_DELETE_EDGE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[locally_finite] THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `edges(G:(E->bool)#(V->bool)#(E->V->bool))` THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`G:(E->bool)#(V->bool)#(E->V->bool)`; `e:E`] + TERMINI_IN_VERTICES) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connects]) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `b:V = a` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[SET_RULE `{a,a} = {v} <=> v = a`] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[ODD_ADD; ARITH]; + ALL_TAC] THEN + ASM_REWRITE_TAC[SET_RULE `{a,b} = {v} <=> a = b /\ a = v`] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[ODD_ADD; ARITH] THEN ASM_MESON_TAC[]);; + +let EULERIAN_ODD = prove + (`!G es a b. + graph G /\ eulerian G es (a,b) + ==> !v. v IN vertices G + ==> (ODD(degree G v) <=> ~(a = b) /\ (v = a \/ v = b))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP EULERIAN_ODD_LEMMA) THEN + ASM_SIMP_TAC[FST; SND]);; + +(* ------------------------------------------------------------------------- *) +(* Now the actual Koenigsberg configuration. *) +(* ------------------------------------------------------------------------- *) + +let KOENIGSBERG = prove + (`!G. vertices(G) = {0,1,2,3} /\ + edges(G) = {10,20,30,40,50,60,70} /\ + termini G (10) = {0,1} /\ + termini G (20) = {0,2} /\ + termini G (30) = {0,3} /\ + termini G (40) = {1,2} /\ + termini G (50) = {1,2} /\ + termini G (60) = {2,3} /\ + termini G (70) = {2,3} + ==> ~(?es a b. eulerian G es (a,b))`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `G:(num->bool)#(num->bool)#(num->num->bool)` EULERIAN_ODD) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[graph] THEN GEN_TAC THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[SET_RULE + `{a,b} = {x,y} <=> a = x /\ b = y \/ a = y /\ b = x`] THEN + MESON_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + ASM_REWRITE_TAC[degree; edges] THEN + SIMP_TAC[TAUT `a IN s /\ k IN t <=> ~(a IN s ==> ~(k IN t))`] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN + REWRITE_TAC[SET_RULE `{x | x = a \/ P(x)} = a INSERT {x | P(x)}`] THEN + REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN + SIMP_TAC[NSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + ASM_REWRITE_TAC[localdegree; IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + REWRITE_TAC[SET_RULE `{a,b} = {x} <=> x = a /\ a = b`] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `0` th) THEN MP_TAC(SPEC `1` th) THEN + MP_TAC(SPEC `2` th) THEN MP_TAC(SPEC `3` th)) THEN + REWRITE_TAC[ARITH] THEN ARITH_TAC);; + +(****** + +Maybe for completeness I should show the contrary: existence of Eulerian +circuit/walk if we do have the right properties, assuming the graph is +connected; cf: + +http://math.arizona.edu/~lagatta/class/fa05/m105/graphtheorynotes.pdf + + *****) diff --git a/100/lagrange.ml b/100/lagrange.ml new file mode 100644 index 0000000..7baff78 --- /dev/null +++ b/100/lagrange.ml @@ -0,0 +1,254 @@ +(* ========================================================================= *) +(* Very trivial group theory, just to reach Lagrange theorem. *) +(* ========================================================================= *) + +loadt "Library/prime.ml";; + +(* ------------------------------------------------------------------------- *) +(* Definition of what a group is. *) +(* ------------------------------------------------------------------------- *) + +let group = new_definition + `group(g,( ** ),i,(e:A)) <=> + (e IN g) /\ (!x. x IN g ==> i(x) IN g) /\ + (!x y. x IN g /\ y IN g ==> (x ** y) IN g) /\ + (!x y z. x IN g /\ y IN g /\ z IN g ==> (x ** (y ** z) = (x ** y) ** z)) /\ + (!x. x IN g ==> (x ** e = x) /\ (e ** x = x)) /\ + (!x. x IN g ==> (x ** i(x) = e) /\ (i(x) ** x = e))`;; + +(* ------------------------------------------------------------------------- *) +(* Notion of a subgroup. *) +(* ------------------------------------------------------------------------- *) + +let subgroup = new_definition + `subgroup h (g,( ** ),i,(e:A)) <=> h SUBSET g /\ group(h,( ** ),i,e)`;; + +(* ------------------------------------------------------------------------- *) +(* Lagrange theorem, introducing the coset representatives. *) +(* ------------------------------------------------------------------------- *) + +let GROUP_LAGRANGE_COSETS = prove + (`!g h ( ** ) i e. + group (g,( ** ),i,e:A) /\ subgroup h (g,( ** ),i,e) /\ FINITE g + ==> ?q. (CARD(g) = CARD(q) * CARD(h)) /\ + (!b. b IN g ==> ?a x. a IN q /\ x IN h /\ (b = a ** x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[group; subgroup; SUBSET] THEN STRIP_TAC THEN + ABBREV_TAC + `coset = \a:A. {b:A | b IN g /\ (?x:A. x IN h /\ (b = a ** x))}` THEN + SUBGOAL_THEN `!a:A. a IN g ==> a IN (coset a)` ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "coset" THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `FINITE(h:A->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `!a. FINITE((coset:A->A->bool) a)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "coset" THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `g:A->bool` THEN + ASM_SIMP_TAC[IN_ELIM_THM; SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a:A x:A y. a IN g /\ x IN g /\ y IN g /\ ((a ** x) :A = a ** y) + ==> (x = y)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(e:A ** x:A):A = e ** y` (fun th -> ASM_MESON_TAC[th]) THEN + SUBGOAL_THEN + `((i(a):A ** a:A) ** x) = (i(a) ** a) ** y` + (fun th -> ASM_MESON_TAC[th]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!a:A. a IN g ==> (CARD(coset a :A->bool) = CARD(h:A->bool))` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(coset:A->A->bool) (a:A) = IMAGE (\x. a ** x) (h:A->bool)` + SUBST1_TAC THENL + [EXPAND_TAC "coset" THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A y. x IN g /\ y IN g ==> (i(x ** y) = i(y) ** i(x))` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(x:A ** y:A) :A` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(x:A ** (y ** i(y))) ** i(x)` THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN g ==> (i(i(x)) = x)` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(i:A->A)(x)` THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a b. a IN g /\ b IN g + ==> ((coset:A->A->bool) a = coset b) \/ + ((coset a) INTER (coset b) = {})` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + ASM_CASES_TAC `((i:A->A)(b) ** a:A) IN (h:A->bool)` THENL + [DISJ1_TAC THEN EXPAND_TAC "coset" THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `!x:A. x IN h ==> (b ** (i(b) ** a:A) ** x = a ** x) /\ + (a ** i(i(b) ** a) ** x = b ** x)` + (fun th -> EQ_TAC THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[th]) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISJ2_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER] THEN + X_GEN_TAC `x:A` THEN EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `(a /\ b) /\ (a /\ c) <=> a /\ b /\ c`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `(i(b:A) ** a ** y):A = i(b) ** b ** z` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(i(b:A) ** a:A ** y):A = e ** z` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(i(b:A) ** a:A ** y):A = z` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `((i(b:A) ** a:A) ** y):A = z` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `((i(b:A) ** a:A) ** y) ** i(y) = z ** i(y)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(i(b:A) ** a:A) ** (y ** i(y)) = z ** i(y)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(i(b:A) ** a:A) ** e = z ** i(y)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(i(b:A) ** a:A):A = z ** i(y)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `{c:A | ?a:A. a IN g /\ (c = (@)(coset a))}` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> b /\ a`) THEN CONJ_TAC THENL + [X_GEN_TAC `b:A` THEN DISCH_TAC THEN + EXISTS_TAC `(@)((coset:A->A->bool) b)` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `b:A` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(@)((coset:A->A->bool) b) IN (coset b)` MP_TAC THENL + [REWRITE_TAC[IN] THEN MATCH_MP_TAC SELECT_AX THEN + ASM_MESON_TAC[IN]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RATOR_CONV) + [SYM th]) THEN + REWRITE_TAC[] THEN + ABBREV_TAC `C = (@)((coset:A->A->bool) b)` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(i:A->A)(c)` THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `q = {c:A | ?a:A. a IN g /\ (c = (@)(coset a))}` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!a:A b. a IN g /\ b IN g /\ a IN coset(b) ==> b IN coset(a)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "coset" THEN + REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `(i:A->A) c` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a:A b c. a IN coset(b) /\ b IN coset(c) /\ c IN g ==> a IN coset(c)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "coset" THEN + REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!a:A b:A. a IN coset(b) ==> a IN g` ASSUME_TAC THENL + [EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a:A b. a IN coset(b) /\ b IN g ==> (coset a = coset b)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION] THEN + MAP_EVERY UNDISCH_TAC + [`!a:A b:A. a IN coset(b) ==> a IN g`; + `!a:A b c. a IN coset(b) /\ b IN coset(c) /\ c IN g ==> a IN coset(c)`; + `!a:A b. a IN g /\ b IN g /\ a IN coset(b) ==> b IN coset(a)`] THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!a:A. a IN g ==> (@)(coset a):A IN (coset a)` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN UNDISCH_TAC `!a:A. a IN g ==> a IN coset a` THEN + DISCH_THEN(MP_TAC o SPEC `a:A`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN; SELECT_AX]; + ALL_TAC] THEN + SUBGOAL_THEN `!a:A. a IN q ==> a IN g` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a:A x:A a' x'. a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ + ((a' ** x') :A = a ** x) ==> (a' = a) /\ (x' = x)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `(c ==> a /\ b ==> d) ==> a /\ b /\ c ==> d`) THEN + STRIP_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `a1:A` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `a2:A` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `a:A IN g /\ a' IN g` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `((coset:A->A->bool) a1 = coset a) /\ (coset a2 = coset a')` + MP_TAC THENL + [CONJ_TAC THEN CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + ONCE_ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "coset" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `(x:A ** (i:A->A)(x')):A` THEN + ASM_SIMP_TAC[] THEN UNDISCH_TAC `(a':A ** x':A):A = a ** x` THEN + DISCH_THEN(MP_TAC o C AP_THM `(i:A->A) x'` o AP_TERM `(**):A->A->A`) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `g = IMAGE (\(a:A,x:A). (a ** x):A) {(a,x) | a IN q /\ x IN h}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[EXISTS_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ] THEN + REWRITE_TAC[CONJ_ASSOC; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `CARD {(a:A,x:A) | a IN q /\ x IN h}` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ] THEN REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC FINITE_PRODUCT THEN CONJ_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `g:A->bool` THEN + ASM_REWRITE_TAC[SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC CARD_PRODUCT THEN CONJ_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `g:A->bool` THEN + ASM_REWRITE_TAC[SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Traditional statement is only part of this. *) +(* ------------------------------------------------------------------------- *) + +let GROUP_LAGRANGE = prove + (`!g h ( ** ) i e. + group (g,( ** ),i,e:A) /\ subgroup h (g,( ** ),i,e) /\ FINITE g + ==> (CARD h) divides (CARD g)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP GROUP_LAGRANGE_COSETS) THEN + MESON_TAC[DIVIDES_LMUL; DIVIDES_REFL]);; diff --git a/100/leibniz.ml b/100/leibniz.ml new file mode 100644 index 0000000..1dde24c --- /dev/null +++ b/100/leibniz.ml @@ -0,0 +1,302 @@ +(* ========================================================================= *) +(* #26: Leibniz's series for pi *) +(* ========================================================================= *) + +needs "Library/transc.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Summability of alternating series. *) +(* ------------------------------------------------------------------------- *) + +let ALTERNATING_SUM_BOUNDS = prove + (`!a. (!n. a(2 * n + 1) <= &0 /\ &0 <= a(2 * n)) /\ + (!n. abs(a(n + 1)) <= abs(a(n))) + ==> !m n. (EVEN m ==> &0 <= sum(m,n) a /\ sum(m,n) a <= a(m)) /\ + (ODD m ==> a(m) <= sum(m,n) a /\ sum(m,n) a <= &0)`, + GEN_TAC THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[ODD; EVEN] THENL + [SIMP_TAC[sum; ODD_EXISTS; EVEN_EXISTS; LEFT_IMP_EXISTS_THM; ADD1] THEN + ASM_SIMP_TAC[REAL_LE_REFL]; + ALL_TAC] THEN + X_GEN_TAC `m:num` THEN + REWRITE_TAC[ARITH_RULE `SUC n = 1 + n`; GSYM SUM_SPLIT] THEN + FIRST_X_ASSUM(MP_TAC o check (is_conj o concl) o SPEC `SUC m`) THEN + REWRITE_TAC[ODD; EVEN; SUM_1] THEN REWRITE_TAC[ADD1; GSYM NOT_EVEN] THEN + UNDISCH_THEN `!n. abs(a(n + 1)) <= abs(a n)` (MP_TAC o SPEC `m:num`) THEN + ASM_CASES_TAC `EVEN m` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN + REWRITE_TAC[ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ADD1] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN REAL_ARITH_TAC]);; + +let ALTERNATING_SUM_BOUND = prove + (`!a. (!n. a(2 * n + 1) <= &0 /\ &0 <= a(2 * n)) /\ + (!n. abs(a(n + 1)) <= abs(a(n))) + ==> !m n. abs(sum(m,n) a) <= abs(a m)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ALTERNATING_SUM_BOUNDS) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN m` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let SUMMABLE_ALTERNATING = prove + (`!v. (!n. a(2 * n + 1) <= &0 /\ &0 <= a(2 * n)) /\ + (!n. abs(a(n + 1)) <= abs(a(n))) /\ a tends_num_real &0 + ==> summable a`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SER_CAUCHY] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [SEQ]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + ASM_MESON_TAC[ALTERNATING_SUM_BOUND; REAL_LET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Another version of the atan series. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ATN_POWSER_ALT = prove + (`!x. abs(x) < &1 + ==> (\n. (-- &1) pow n / &(2 * n + 1) * x pow (2 * n + 1)) + sums (atn x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_ATN_POWSER) THEN + FIRST_ASSUM(MP_TAC o C CONJ (ARITH_RULE `0 < 2`) o + MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_GROUP) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + REWRITE_TAC[SUM_2; EVEN_MULT; EVEN_ADD; ARITH_EVEN; ADD_SUB] THEN + ONCE_REWRITE_TAC[ARITH_RULE `n * 2 = 2 * n`] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ; REAL_MUL_LZERO; REAL_ADD_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Summability of the same series for x = 1. *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_LEIBNIZ = prove + (`summable (\n. (-- &1) pow n / &(2 * n + 1))`, + MATCH_MP_TAC SUMMABLE_ALTERNATING THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_ADD; REAL_POW_MUL; GSYM REAL_POW_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_ONE; real_div; REAL_MUL_LID; REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_LE_LNEG; REAL_ADD_RID; REAL_LE_INV_EQ; REAL_POS]; + GEN_TAC THEN REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; + REWRITE_TAC[SEQ; REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `&1` o MATCH_MP REAL_ARCH) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&1 < x * e ==> e * x <= y ==> &1 < y`)) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The tricky sum-bounding lemma. *) +(* ------------------------------------------------------------------------- *) + +let SUM_DIFFERENCES = prove + (`!a m n. m <= n + 1 ==> sum(m..n) (\i. a(i) - a(i+1)) = a(m) - a(n + 1)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `m <= 0 + 1 <=> m = 0 \/ m = 1`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN + ASM_SIMP_TAC[SUM_TRIV_NUMSEG; ARITH; REAL_SUB_REFL]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `m <= SUC n + 1 <=> m <= n + 1 \/ m = SUC n + 1`] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[SUM_TRIV_NUMSEG; ARITH_RULE `n < n + 1`; REAL_SUB_REFL] THEN + ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; + ARITH_RULE `m <= n + 1 ==> m <= SUC n /\ m <= SUC n + 1`] THEN + REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC);; + +let SUM_REARRANGE_LEMMA = prove + (`!a v m n. + m <= n + 1 + ==> sum(m..n+1) (\i. a i * v i) = + sum(m..n) (\k. sum(m..k) a * (v(k) - v(k+1))) + + sum(m..n+1) a * v(n+1)`, + REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_CLAUSES_NUMSEG; num_CONV `1`; ADD_CLAUSES] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[ARITH] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[ADD_CLAUSES; SUM_CLAUSES_NUMSEG] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_CASES_TAC `m = SUC(n + 1)` THENL + [ASM_REWRITE_TAC[LE_SUC; ARITH_RULE `~(n + 1 <= n)`] THEN + ASM_SIMP_TAC[SUM_TRIV_NUMSEG; ARITH_RULE + `n < SUC n /\ n < SUC(n + 1)`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ARITH_RULE + `m <= SUC n <=> m <= SUC(n + 1) /\ ~(m = SUC(n + 1))`] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_RDISTRIB; REAL_EQ_ADD_RCANCEL] THEN + REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG] THEN + ASM_SIMP_TAC[ARITH_RULE + `m <= SUC(n + 1) /\ ~(m = SUC(n + 1)) ==> m <= SUC n`] THEN + REWRITE_TAC[REAL_ARITH + `(s1 * (v - w) + x) + (s2 + y) * w = + (x + y * w) + (v - w) * s1 + w * s2`] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[REAL_ADD_LDISTRIB; GSYM SUM_CMUL; GSYM SUM_ADD_NUMSEG] THEN + REWRITE_TAC[REAL_SUB_ADD; REAL_SUB_RDISTRIB] THEN REAL_ARITH_TAC);; + +let SUM_BOUNDS_LEMMA = prove + (`!a v l u m n. + m <= n /\ + (!i. m <= i /\ i <= n ==> &0 <= v(i) /\ v(i+1) <= v(i)) /\ + (!k. m <= k /\ k <= n ==> l <= sum(m..k) a /\ sum(m..k) a <= u) + ==> l * v(m) <= sum(m..n) (\i. a(i) * v(i)) /\ + sum(m..n) (\i. a(i) * v(i)) <= u * v(m)`, + REPLICATE_TAC 5 GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[LE; SUM_CLAUSES_NUMSEG] THEN + SIMP_TAC[ARITH_RULE `m <= i /\ i = 0 <=> m = 0 /\ i = 0`] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN + SIMP_TAC[REAL_LE_RMUL]; + POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[ADD1]] THEN + SIMP_TAC[SUM_REARRANGE_LEMMA] THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. l * (v(k) - v(k + 1))) + l * v(n+1)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SUM_LMUL; SUM_DIFFERENCES] THEN REAL_ARITH_TAC; + ALL_TAC]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. u * (v(k) - v(k + 1))) + u * v(n+1)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[SUM_LMUL; SUM_DIFFERENCES] THEN REAL_ARITH_TAC]] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[REAL_LE_RMUL; LE_REFL] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_SUB_LE; ARITH_RULE `k <= n ==> k <= n + 1`]);; + +let SUM_BOUND_LEMMA = prove + (`!a v b m n. + m <= n /\ + (!i. m <= i /\ i <= n ==> &0 <= v(i) /\ v(i+1) <= v(i)) /\ + (!k. m <= k /\ k <= n ==> abs(sum(m..k) a) <= b) + ==> abs(sum(m..n) (\i. a(i) * v(i))) <= b * abs(v m)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `--b * k <= a /\ a <= b * k ==> abs(a) <= b * k`) THEN + ASM_SIMP_TAC[LE_REFL; real_abs] THEN + MATCH_MP_TAC SUM_BOUNDS_LEMMA THEN + ASM_REWRITE_TAC[REAL_BOUNDS_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the final theorem. *) +(* ------------------------------------------------------------------------- *) + +let LEIBNIZ_PI = prove + (`(\n. (-- &1) pow n / &(2 * n + 1)) sums (pi / &4)`, + REWRITE_TAC[GSYM ATN_1] THEN + ASSUME_TAC(MATCH_MP SUMMABLE_SUM SUMMABLE_LEIBNIZ) THEN + ABBREV_TAC `s = suminf(\n. (-- &1) pow n / &(2 * n + 1))` THEN + SUBGOAL_THEN `s = atn(&1)` (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(x - y)) ==> x = y`) THEN + ABBREV_TAC `e = abs(s - atn(&1))` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + REWRITE_TAC[SER_CAUCHY] THEN DISCH_THEN(MP_TAC o SPEC `e / &7`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\x. sum(0,N) (\n. (-- &1) pow n / &(2 * n + 1) * x pow (2 * n + 1))) + contl (&1)` + MP_TAC THENL + [MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC + `sum(0,N) (\n. (-- &1) pow n * &1 pow (2 * n))` THEN + MATCH_MP_TAC DIFF_SUM THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC DIFF_CMUL THEN + MP_TAC(SPECL [`2 * k + 1`; `&1`] DIFF_POW) THEN + DISCH_THEN(MP_TAC o SPEC `inv(&(2 * k + 1))` o MATCH_MP DIFF_CMUL) THEN + MATCH_MP_TAC(TAUT `a = b ==> a ==> b`) THEN + REWRITE_TAC[ADD_SUB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_POW_ONE] THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `atn contl (&1)` MP_TAC THENL + [MESON_TAC[DIFF_CONT; DIFF_ATN]; ALL_TAC] THEN + REWRITE_TAC[CONTL_LIM; LIM] THEN + REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; GSYM SUM_SUB] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN + REWRITE_TAC[GSYM SUM_NEG; REAL_NEG_SUB; GSYM REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_POW_ONE; GSYM REAL_SUB_LDISTRIB] THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC `x = &1 - min (min (d1 / &2) (d2 / &2)) (&1 / &2)` THEN + REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; DISCH_TAC]) THEN + SUBGOAL_THEN `&0 < x /\ x < &1 /\ abs x < &1` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_ALT) THEN + REWRITE_TAC[sums; SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [sums]) THEN + REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `e / &6`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `N + N1 + N2:num`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN + REWRITE_TAC[ADD_CLAUSES] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `abs(sum(N,N1+N2) (\n. -- &1 pow n / &(2 * n + 1) * x pow (2 * n + 1))) + < e / &6` + ASSUME_TAC THENL + [ASM_CASES_TAC `N1 + N2 = 0` THENL + [ASM_SIMP_TAC[sum; REAL_LT_DIV; REAL_OF_NUM_LT; REAL_ABS_NUM; ARITH]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x <= e / &7 /\ &0 < e ==> x < e / &6`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `e / &7 * abs(x pow (2 * N + 1))` THEN + CONJ_TAC THENL + [ALL_TAC; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + MAP_EVERY UNDISCH_TAC [`&0 < x`; `x < &1`] THEN REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[PSUM_SUM_NUMSEG] THEN MATCH_MP_TAC SUM_BOUND_LEMMA THEN + CONJ_TAC THENL [UNDISCH_TAC `~(N1 + N2 = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_POW_LT]; + REWRITE_TAC[ARITH_RULE `2 * (m + 1) + 1 = (2 * m + 1) + 2`] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_POW_ADD] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_POW_1_LE; REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `(k - N:num) + 1`]) THEN + SIMP_TAC[PSUM_SUM_NUMSEG; ADD_EQ_0; ARITH_EQ] THEN + ASM_SIMP_TAC[ARITH_RULE `N <= k ==> (N + (k - N) + 1) - 1 = k`] THEN + REWRITE_TAC[GE; LE_REFL; REAL_LT_IMP_LE]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `N1 + N2:num`]) THEN + REWRITE_TAC[GE; LE_REFL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs((slo + shi) - s) < e / &6 + ==> ~(abs(slo - s) < e / &3) ==> ~(abs(shi) < e / &7)`)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUB_LDISTRIB; SUM_SUB; REAL_MUL_RID]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(s1 - sx) < e / &6 + ==> ~(abs(sx - s) < e / &2) ==> ~(abs(s1 - s) < e / &3)`)) THEN + ASM_REAL_ARITH_TAC);; diff --git a/100/lhopital.ml b/100/lhopital.ml new file mode 100644 index 0000000..b0d100c --- /dev/null +++ b/100/lhopital.ml @@ -0,0 +1,200 @@ +(* ========================================================================= *) +(* #64: L'Hopital's rule. *) +(* ========================================================================= *) + +needs "Library/analysis.ml";; + +override_interface ("-->",`(tends_real_real)`);; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Cauchy mean value theorem. *) +(* ------------------------------------------------------------------------- *) + +let MVT2 = prove + (`!f g a b. + a < b /\ + (!x. a <= x /\ x <= b ==> f contl x /\ g contl x) /\ + (!x. a < x /\ x < b ==> f differentiable x /\ g differentiable x) + ==> ?z f' g'. a < z /\ z < b /\ (f diffl f') z /\ (g diffl g') z /\ + (f b - f a) * g' = (g b - g a) * f'`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. f(x) * (g(b) - g(a)) - g(x) * (f(b) - f(a))`; + `a:real`; `b:real`] MVT) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONT_SUB; CONT_MUL; CONT_CONST] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + REWRITE_TAC[differentiable] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `f':real`) (X_CHOOSE_TAC `g':real`)) THEN + EXISTS_TAC `f' * (g(b:real) - g a) - g' * (f b - f a)` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] DIFF_CMUL; DIFF_SUB]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real` THEN + REWRITE_TAC[REAL_ARITH + `(fb * (gb - ga) - gb * (fb - fa)) - + (fa * (gb - ga) - ga * (fb - fa)) = y <=> y = &0`] THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0; REAL_LT_IMP_NE] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN + UNDISCH_THEN `l = &0` SUBST_ALL_TAC THEN + UNDISCH_TAC + `!x. a < x /\ x < b ==> f differentiable x /\ g differentiable x` THEN + DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[differentiable] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `f':real`) (X_CHOOSE_TAC `g':real`)) THEN + MAP_EVERY EXISTS_TAC [`f':real`; `g':real`] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + MATCH_MP_TAC DIFF_UNIQ THEN + EXISTS_TAC `\x:real. f(x) * (g(b) - g(a)) - g(x) * (f(b) - f(a))` THEN + EXISTS_TAC `z:real` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] DIFF_CMUL; DIFF_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* First, assume f and g actually take value zero at c. *) +(* ------------------------------------------------------------------------- *) + +let LHOPITAL_WEAK = prove + (`!f g f' g' c L d. + &0 < d /\ + (!x. &0 < abs(x - c) /\ abs(x - c) < d + ==> (f diffl f'(x)) x /\ (g diffl g'(x)) x /\ ~(g'(x) = &0)) /\ + f(c) = &0 /\ g(c) = &0 /\ (f --> &0) c /\ (g --> &0) c /\ + ((\x. f'(x) / g'(x)) --> L) c + ==> ((\x. f(x) / g(x)) --> L) c`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `!x. &0 < abs(x - c) /\ abs(x - c) < d + ==> ?z. &0 < abs(z - c) /\ abs(z - c) < abs(x - c) /\ + f(x) * g'(z) = f'(z) * g(x)` + (LABEL_TAC "*") THENL + [X_GEN_TAC `x:real` THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `&0 < abs(x - c) /\ abs(x - c) < d + ==> c < x /\ x < c + d \/ c - d < x /\ x < c`)) THEN + STRIP_TAC THENL + [MP_TAC(SPECL + [`f:real->real`; `g:real->real`; `c:real`; `x:real`] MVT2) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o funpow 2 LAND_CONV) + [REAL_LE_LT] THEN + ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_IMP_LE; differentiable; + REAL_ARITH + `c < z /\ z <= x /\ x < c + d ==> &0 < abs(z - c) /\ abs(z - c) < d`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN GEN_REWRITE_TAC (funpow 4 RAND_CONV) [REAL_MUL_SYM] THEN + REPEAT STRIP_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC) THEN + ASM_MESON_TAC[DIFF_UNIQ; REAL_ARITH + `c < z /\ z < x /\ x < c + d ==> &0 < abs(z - c) /\ abs(z - c) < d`]]; + MP_TAC(SPECL + [`f:real->real`; `g:real->real`; `x:real`; `c:real`] MVT2) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV o RAND_CONV) + [REAL_LE_LT] THEN + ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_IMP_LE; differentiable; + REAL_ARITH + `c - d < x /\ x <= z /\ z < c ==> &0 < abs(z - c) /\ abs(z - c) < d`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_LNEG; REAL_EQ_NEG2] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + GEN_REWRITE_TAC (funpow 4 RAND_CONV) [REAL_MUL_SYM] THEN + REPEAT STRIP_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC) THEN + ASM_MESON_TAC[DIFF_UNIQ; REAL_ARITH + `c - d < x /\ x < z /\ z < c + ==> &0 < abs(z - c) /\ abs(z - c) < d`]]]; + ALL_TAC] THEN + REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `((\x. f' x / g' x) --> L) c` THEN REWRITE_TAC[LIM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d:real`; `r:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + UNDISCH_TAC + `!x. &0 < abs(x - c) /\ abs(x - c) < r ==> abs(f' x / g' x - L) < e` THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `z:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - l) < e ==> abs(y - l) < e`) THEN + MATCH_MP_TAC(REAL_FIELD + `~(gz = &0) /\ ~(gx = &0) /\ fx * gz = fz * gx ==> fz / gz = fx / gx`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + MP_TAC(ASSUME `&0 < abs(x - c)`) THEN DISCH_THEN(MP_TAC o MATCH_MP + (REAL_ARITH `&0 < abs(x - c) ==> c < x \/ x < c`)) THEN + REPEAT STRIP_TAC THENL + [MP_TAC(SPECL [`g:real->real`; `c:real`; `x:real`] ROLLE) THEN + ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [REAL_LE_LT] THEN + ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_TRANS; REAL_ARITH + `c < z /\ z <= x /\ abs(x - c) < d + ==> &0 < abs(z - c) /\ abs(z - c) < d`]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[differentiable; REAL_LT_TRANS; REAL_ARITH + `c < z /\ z < x /\ abs(x - c) < d + ==> &0 < abs(z - c) /\ abs(z - c) < d`]; + ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `w:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[DIFF_UNIQ]; + MP_TAC(SPECL [`g:real->real`; `x:real`; `c:real`] ROLLE) THEN + ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_LE_LT] THEN + ASM_MESON_TAC[CONTL_LIM; DIFF_CONT; REAL_LT_TRANS; REAL_ARITH + `x <= z /\ z < c /\ z < c /\ abs(x - c) < d + ==> &0 < abs(z - c) /\ abs(z - c) < d`]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[differentiable; REAL_LT_TRANS; REAL_ARITH + `x < z /\ z < c /\ abs(x - c) < d + ==> &0 < abs(z - c) /\ abs(z - c) < d`]; + ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `w:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[DIFF_UNIQ]]);; + +(* ------------------------------------------------------------------------- *) +(* Now generalize by continuity extension. *) +(* ------------------------------------------------------------------------- *) + +let LHOPITAL = prove + (`!f g f' g' c L d. + &0 < d /\ + (!x. &0 < abs(x - c) /\ abs(x - c) < d + ==> (f diffl f'(x)) x /\ (g diffl g'(x)) x /\ ~(g'(x) = &0)) /\ + (f --> &0) c /\ (g --> &0) c /\ ((\x. f'(x) / g'(x)) --> L) c + ==> ((\x. f(x) / g(x)) --> L) c`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`\x:real. if x = c then &0 else f(x)`; + `\x:real. if x = c then &0 else g(x)`; + `f':real->real`; `g':real->real`; + `c:real`; `L:real`; `d:real`] LHOPITAL_WEAK) THEN + SIMP_TAC[LIM; REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN + REWRITE_TAC[diffl] THEN STRIP_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[diffl] THENL + [MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. (f(x + h) - f x) / h`; + MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\h. (g(x + h) - g x) / h`; + ASM_MESON_TAC[]] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN + REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `abs(x - c)` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 < abs(x - c) /\ &0 < abs z /\ abs z < abs(x - c) ==> ~(x + z = c)`] THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM]);; diff --git a/100/liouville.ml b/100/liouville.ml new file mode 100644 index 0000000..dfae2f9 --- /dev/null +++ b/100/liouville.ml @@ -0,0 +1,429 @@ +(* ========================================================================= *) +(* Liouville approximation theorem. *) +(* ========================================================================= *) + +needs "Library/floor.ml";; +needs "Library/poly.ml";; + +(* ------------------------------------------------------------------------- *) +(* Definition of algebraic and transcendental. *) +(* ------------------------------------------------------------------------- *) + +let algebraic = new_definition + `algebraic(x) <=> ?p. ALL integer p /\ ~(poly p = poly []) /\ poly p x = &0`;; + +let transcendental = new_definition + `transcendental(x) <=> ~(algebraic x)`;; + +(* ------------------------------------------------------------------------- *) +(* Some trivialities. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INTEGER_EQ_0 = prove + (`!x. integer x /\ abs(x) < &1 ==> x = &0`, + MESON_TAC[REAL_ABS_INTEGER_LEMMA; REAL_NOT_LE]);; + +let FACT_LE_REFL = prove + (`!n. n <= FACT n`, + INDUCT_TAC THEN REWRITE_TAC[FACT; ARITH] THEN + MATCH_MP_TAC(ARITH_RULE `x * 1 <= a ==> x <= a`) THEN + REWRITE_TAC[LE_MULT_LCANCEL; NOT_SUC; FACT_LT; + ARITH_RULE `1 <= n <=> 0 < n`]);; + +let EXP_LE_REFL = prove + (`!a. 1 < a ==> !n. n <= a EXP n`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `n <= x ==> 1 * x < y ==> SUC n <= y`)) THEN + REWRITE_TAC[LT_MULT_RCANCEL; EXP_EQ_0] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Archimedian properties taken from Multivariate/misc.ml *) +(* ------------------------------------------------------------------------- *) + +let REAL_POW_LBOUND = prove + (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH + `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; + +let REAL_ARCH_POW = prove + (`!x y. &1 < x ==> ?n. y < x pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 + &n * (x - &1)` THEN + ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN + ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH + `&1 < x ==> &0 <= x - &1`]);; + +(* ------------------------------------------------------------------------- *) +(* Inequality variant of mean value theorem. *) +(* ------------------------------------------------------------------------- *) + +let MVT_INEQ = prove + (`!f f' a d M. + &0 < M /\ &0 < d /\ + (!x. abs(x - a) <= d ==> (f diffl f'(x)) x /\ abs(f' x) < M) + ==> !x. abs(x - a) <= d ==> abs(f x - f a) < M * d`, + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `x = a \/ x < a \/ a < x`) + THENL + [ASM_SIMP_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_MUL]; + MP_TAC(SPECL [`f:real->real`; `f':real->real`; `x:real`; `a:real`] + MVT_ALT); + MP_TAC(SPECL [`f:real->real`; `f':real->real`; `a:real`; `x:real`] + MVT_ALT)] THEN + (ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + ALL_TAC]) THEN + STRIP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ABS_SUB]; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d * abs(f'(z:real))` THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL; + MATCH_MP_TAC REAL_LT_LMUL THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC]) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Appropriate multiple of poly on rational is an integer. *) +(* ------------------------------------------------------------------------- *) + +let POLY_MULTIPLE_INTEGER = prove + (`!p q l. ALL integer l ==> integer(&q pow (LENGTH l) * poly l (&p / &q))`, + GEN_TAC THEN GEN_TAC THEN ASM_CASES_TAC `q = 0` THENL + [LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_MUL_RZERO; INTEGER_CLOSED] THEN + ASM_REWRITE_TAC[LENGTH; real_pow; REAL_MUL_LZERO; INTEGER_CLOSED]; + ALL_TAC] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_MUL_RZERO; INTEGER_CLOSED] THEN + REWRITE_TAC[LENGTH; real_pow; ALL] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH + `(q * qp) * (h + pq * pol) = q * h * qp + (q * pq) * (qp * pol)`] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(el 1 (CONJUNCTS INTEGER_CLOSED)) THEN + ASM_SIMP_TAC[INTEGER_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* First show any root is surrounded by an other-root-free zone. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATE_FINITE_SET = prove + (`!a s. FINITE s + ==> ~(a IN s) ==> ?d. &0 < d /\ !x. x IN s ==> d <= abs(x - a)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + EXISTS_TAC `min d (abs(x - a))` THEN + ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; GSYM REAL_ABS_NZ; REAL_SUB_0] THEN + ASM_MESON_TAC[REAL_LE_REFL]);; + +let POLY_ROOT_SEPARATE_LE = prove + (`!p x. poly p x = &0 /\ ~(poly p = poly []) + ==> ?d. &0 < d /\ + !x'. &0 < abs(x' - x) /\ abs(x' - x) < d + ==> ~(poly p x' = &0)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real`; `{x | poly p x = &0} DELETE x`] + SEPARATE_FINITE_SET) THEN + ASM_SIMP_TAC[POLY_ROOTS_FINITE_SET; FINITE_DELETE; IN_DELETE] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_SUB_0] THEN MESON_TAC[REAL_NOT_LT]);; + +let POLY_ROOT_SEPARATE_LT = prove + (`!p x. poly p x = &0 /\ ~(poly p = poly []) + ==> ?d. &0 < d /\ + !x'. &0 < abs(x' - x) /\ abs(x' - x) <= d + ==> ~(poly p x' = &0)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP POLY_ROOT_SEPARATE_LE) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &2` THEN ASM_MESON_TAC[REAL_ARITH + `&0 < d ==> &0 < d / &2 /\ (x <= d / &2 ==> x < d)`]);; + +(* ------------------------------------------------------------------------- *) +(* And also there is a positive bound on a polynomial in an interval. *) +(* ------------------------------------------------------------------------- *) + +let POLY_BOUND_INTERVAL = prove + (`!p d x. ?M. &0 < M /\ !x'. abs(x' - x) <= d ==> abs(poly p x') < M`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`poly p`; `x - d`; `x + d`] CONT_BOUNDED_ABS) THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] (SPEC_ALL POLY_CONT)] THEN + DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `&1 + abs M` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `M:real` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Now put these together to get the interval we need. *) +(* ------------------------------------------------------------------------- *) + +let LIOUVILLE_INTERVAL = prove + (`!p x. poly p x = &0 /\ ~(poly p = poly []) + ==> ?c. &0 < c /\ + (!x'. abs(x' - x) <= c + ==> abs(poly(poly_diff p) x') < &1 / c) /\ + (!x'. &0 < abs(x' - x) /\ abs(x' - x) <= c + ==> ~(poly p x' = &0))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:real list`; `x:real`] POLY_ROOT_SEPARATE_LT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`poly_diff p`; `d:real`; `x:real`] POLY_BOUND_INTERVAL) THEN + DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `min d (inv M)` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LE_MIN; REAL_LT_INV_EQ] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `M:real` THEN + ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN] THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Liouville's approximation theorem. *) +(* ------------------------------------------------------------------------- *) + +let LIOUVILLE = prove + (`!x. algebraic x + ==> ?n c. c > &0 /\ + !p q. ~(q = 0) ==> &p / &q = x \/ + abs(x - &p / &q) > c / &q pow n`, + GEN_TAC THEN REWRITE_TAC[algebraic; real_gt] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real list` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `LENGTH(l:real list)` THEN + MP_TAC(SPECL [`l:real list`; `x:real`] LIOUVILLE_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `q:num`] THEN DISCH_TAC THEN + ASM_CASES_TAC `&p / &q = x` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC + `!x'. &0 < abs(x' - x) /\ abs(x' - x) <= c ==> ~(poly l x' = &0)` THEN + DISCH_THEN(MP_TAC o SPEC `&p / &q`) THEN REWRITE_TAC[NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_SUB_0]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - y) <= d ==> d <= e ==> abs(y - x) <= e`)) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; REAL_LE_LDIV_EQ; LT_NZ] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_POW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(q = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&q pow (LENGTH(l:real list)) * poly l (&p / &q) = &0` + MP_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_OF_NUM_EQ]] THEN + MATCH_MP_TAC REAL_INTEGER_EQ_0 THEN + ASM_SIMP_TAC[POLY_MULTIPLE_INTEGER] THEN + MP_TAC(SPECL [`poly l`; `poly(poly_diff l)`; `x:real`; + `c / &q pow (LENGTH(l:real list))`; `&1 / c`] + MVT_INEQ) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LT_NZ; REAL_POW_LT] THEN + ANTS_TAC THENL + [REWRITE_TAC[REWRITE_RULE[ETA_AX] (SPEC_ALL POLY_DIFF)] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x <= d ==> d <= e ==> x <= e`)) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; REAL_LE_LDIV_EQ; LT_NZ] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_POW_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(q = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[GSYM real_div] THEN DISCH_THEN(MP_TAC o SPEC `&p / &q`) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; REAL_LT_RDIV_EQ; LT_NZ] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Corollary for algebraic irrationals. *) +(* ------------------------------------------------------------------------- *) + +let LIOUVILLE_IRRATIONAL = prove + (`!x. algebraic x /\ ~rational x + ==> ?n c. c > &0 /\ !p q. ~(q = 0) ==> abs(x - &p / &q) > c / &q pow n`, + REWRITE_TAC[RATIONAL_ALT] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LIOUVILLE) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + ASM_MESON_TAC[LIOUVILLE; REAL_ABS_DIV; REAL_ABS_NUM]);; + +(* ------------------------------------------------------------------------- *) +(* Liouville's constant. *) +(* ------------------------------------------------------------------------- *) + +let liouville = new_definition + `liouville = suminf (\n. &1 / &10 pow (FACT n))`;; + +(* ------------------------------------------------------------------------- *) +(* Some bounds on the partial sums and hence convergence. *) +(* ------------------------------------------------------------------------- *) + +let LIOUVILLE_SUM_BOUND = prove + (`!d n. ~(n = 0) + ==> sum(n..n+d) (\k. &1 / &10 pow FACT k) <= &2 / &10 pow (FACT n)`, + INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THENL + [REWRITE_TAC[ADD_CLAUSES; SUM_SING_NUMSEG; real_div] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_OF_NUM_LE; ARITH]; + ALL_TAC] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_ADD] THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC(REAL_ARITH `y <= x ==> &1 * x + y <= &2 * x`) THEN + REWRITE_TAC[ARITH_RULE `n + SUC d = (n + 1) + d`; GSYM real_div] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN REWRITE_TAC[ADD_EQ_0; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[GSYM REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH; FACT_MONO; LE_ADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&10 pow 1` THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC REAL_POW_MONO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM ADD1; FACT] THEN + MATCH_MP_TAC(ARITH_RULE + `1 * x <= SUC n * x /\ ~(n * x = 0) ==> 1 <= SUC n * x - x`) THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; MULT_EQ_0] THEN + REWRITE_TAC[GSYM LT_NZ; FACT_LT] THEN ARITH_TAC);; + +let LIOUVILLE_PSUM_BOUND = prove + (`!n d. ~(n = 0) + ==> sum(n,d) (\k. &1 / &10 pow FACT k) <= &2 / &10 pow (FACT n)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `d = 0` THEN + ASM_SIMP_TAC[sum; REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN + ASM_SIMP_TAC[PSUM_SUM_NUMSEG] THEN + ASM_SIMP_TAC[ARITH_RULE `~(d = 0) ==> (n + d) - 1 = n + (d - 1)`] THEN + ASM_SIMP_TAC[LIOUVILLE_SUM_BOUND]);; + +let LIOUVILLE_SUMS = prove + (`(\k. &1 / &10 pow FACT k) sums liouville`, + REWRITE_TAC[liouville] THEN MATCH_MP_TAC SUMMABLE_SUM THEN + REWRITE_TAC[SER_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `inv(e)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `2 * N + 1` THEN + REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&2 / &10 pow (FACT m)` THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs x <= a`) THEN + ASM_SIMP_TAC[SUM_POS; REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN + MATCH_MP_TAC LIOUVILLE_PSUM_BOUND THEN + UNDISCH_TAC `2 * N + 1 <= m` THEN ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e * &(2 * N + 1)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 < (n + &1 / &2) * e ==> &2 < e * (&2 * n + &1)`) THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; real_div; REAL_MUL_LID] THEN + UNDISCH_TAC `inv(e) <= &N` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `10 EXP m` THEN + REWRITE_TAC[FACT_LE_REFL; LE_EXP; ARITH] THEN SIMP_TAC[EXP_LE_REFL; ARITH]);; + +let LIOUVILLE_PSUM_LE = prove + (`!n. sum(0,n) (\k. &1 / &10 pow FACT k) <= liouville`, + GEN_TAC THEN REWRITE_TAC[suminf] THEN MATCH_MP_TAC SEQ_LE THEN + EXISTS_TAC `\j:num. sum(0,n) (\k. &1 / &10 pow FACT k)` THEN + EXISTS_TAC `\n:num. sum(0,n) (\k. &1 / &10 pow FACT k)` THEN + REWRITE_TAC[SEQ_CONST; GSYM sums; LIOUVILLE_SUMS] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN SIMP_TAC[GE; LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM SUM_SPLIT; ADD_CLAUSES; REAL_LE_ADDR] THEN + SIMP_TAC[SUM_POS; REAL_LE_DIV; REAL_POW_LE; REAL_POS]);; + +let LIOUVILLE_PSUM_LT = prove + (`!n. sum(0,n) (\k. &1 / &10 pow FACT k) < liouville`, + GEN_TAC THEN MP_TAC(SPEC `SUC n` LIOUVILLE_PSUM_LE) THEN SIMP_TAC[sum] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e ==> x + e <= y ==> x < y`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]);; + +let LIOVILLE_PSUM_DIFF = prove + (`!n. ~(n = 0) + ==> liouville + <= sum(0,n) (\k. &1 / &10 pow FACT k) + &2 / &10 pow (FACT n)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SEQ_LE THEN + EXISTS_TAC `\n. sum(0,n) (\k. &1 / &10 pow FACT k)` THEN + EXISTS_TAC + `\j:num. sum (0,n) (\k. &1 / &10 pow FACT k) + &2 / &10 pow FACT n` THEN + REWRITE_TAC[SEQ_CONST; GSYM sums; LIOUVILLE_SUMS] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN SIMP_TAC[GE; LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM SUM_SPLIT; REAL_LE_LADD] THEN + ASM_SIMP_TAC[ADD_CLAUSES; LIOUVILLE_PSUM_BOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Main proof. *) +(* ------------------------------------------------------------------------- *) + +let TRANSCENDENTAL_LIOUVILLE = prove + (`transcendental(liouville)`, + REWRITE_TAC[transcendental] THEN DISCH_THEN(MP_TAC o MATCH_MP LIOUVILLE) THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `c:real`] THEN + REWRITE_TAC[DE_MORGAN_THM; real_gt; REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(SPECL [`&10`; `&2 / c`] REAL_ARCH_POW) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN + ABBREV_TAC `n = m + k + 1` THEN + EXISTS_TAC `nsum(0..n-1) (\i. 10 EXP (FACT(n-1) - FACT i))` THEN + EXISTS_TAC `10 EXP (FACT(n-1))` THEN REWRITE_TAC[EXP_EQ_0; ARITH] THEN + SUBGOAL_THEN + `&(nsum(0..n-1) (\i. 10 EXP (FACT(n-1) - FACT i))) / &(10 EXP (FACT(n-1))) = + sum(0..n-1) (\k. &1 / &10 pow (FACT k))` + SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_OF_NUM_SUM_NUMSEG; GSYM SUM_LMUL] THEN + SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH; + FACT_MONO; real_div; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; REAL_POW_EQ_0; ARITH] THEN + REWRITE_TAC[REAL_MUL_LID]; + ALL_TAC] THEN + MP_TAC(GEN `f:num->real` + (SPECL [`f:num->real`; `0`; `m + k + 1`] PSUM_SUM_NUMSEG)) THEN + REWRITE_TAC[ADD_EQ_0; ARITH; ADD_CLAUSES] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + SIMP_TAC[LIOUVILLE_PSUM_LT; REAL_LT_IMP_NE] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + REWRITE_TAC[REAL_SUB_LE; LIOUVILLE_PSUM_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &10 pow (FACT n)` THEN + REWRITE_TAC[REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LIOVILLE_PSUM_DIFF THEN EXPAND_TAC "n" THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[LIOVILLE_PSUM_DIFF] THEN + REWRITE_TAC[REAL_OF_NUM_POW; GSYM EXP_MULT] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LT_NZ; EXP_EQ_0; ARITH] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&10 pow k` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LT_NZ; EXP_EQ_0; ARITH] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + REWRITE_TAC[GSYM EXP_ADD; LE_EXP; ARITH_EQ] THEN EXPAND_TAC "n" THEN + REWRITE_TAC[ARITH_RULE `(m + k + 1) - 1 = m + k`] THEN + REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; FACT] THEN + REWRITE_TAC[ARITH_RULE + `k + f * m <= SUC(m + k) * f <=> k <= (k + 1) * f`] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `k = k * 1`] THEN + MATCH_MP_TAC LE_MULT2 THEN REWRITE_TAC[LE_ADD] THEN + REWRITE_TAC[FACT_LT; ARITH_RULE `1 <= x <=> 0 < x`]);; diff --git a/100/minkowski.ml b/100/minkowski.ml new file mode 100644 index 0000000..717996e --- /dev/null +++ b/100/minkowski.ml @@ -0,0 +1,285 @@ +(* ========================================================================= *) +(* Minkowski's convex body theorem. *) +(* ========================================================================= *) + +needs "Multivariate/measure.ml";; + +(* ------------------------------------------------------------------------- *) +(* An ad hoc lemma. *) +(* ------------------------------------------------------------------------- *) + +let LEMMA = prove + (`!f:real^N->bool t s:real^N->bool. + FINITE { u | u IN f /\ ~(t u = {})} /\ + measurable s /\ &1 < measure s /\ + (!u. u IN f ==> measurable(t u)) /\ + s SUBSET UNIONS (IMAGE t f) /\ + (!u v. u IN f /\ v IN f /\ ~(u = v) ==> DISJOINT (t u) (t v)) /\ + (!u. u IN f ==> (IMAGE (\x. x - u) (t u)) SUBSET interval[vec 0,vec 1]) + ==> ?u v. u IN f /\ v IN f /\ ~(u = v) /\ + ~(DISJOINT (IMAGE (\x. x - u) (t u)) + (IMAGE (\x. x - v) (t v)))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN + PURE_REWRITE_TAC[NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ ~c /\ ~d) <=> a /\ b /\ ~c ==> d`] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`\u:real^N. IMAGE (\x:real^N. x - u) (t u)`; + `f:real^N->bool`] + HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG) THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; NOT_IMP] THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `x - u:real^N = --u + x`] THEN + ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ]; + ALL_TAC] THEN + MP_TAC(ISPECL [`vec 0:real^N`; `vec 1:real^N`] (CONJUNCT1 + HAS_MEASURE_INTERVAL)) THEN + REWRITE_TAC[CONTENT_UNIT] THEN + MATCH_MP_TAC(TAUT `(b /\ a ==> F) ==> a ==> ~b`) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] HAS_MEASURE_SUBSET)) THEN + ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; REAL_NOT_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&1 < a ==> a <= b ==> &1 < b`)) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS (IMAGE (t:real^N->real^N->bool) f))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `UNIONS (IMAGE (t:real^N->real^N->bool) f) = + UNIONS (IMAGE t {u | u IN f /\ ~(t u = {})})` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`t:real^N->real^N->bool`; `f:real^N->bool`] + HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG) THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; NOT_IMP] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN + REWRITE_TAC[VECTOR_ARITH `x - u:real^N = --u + x`] THEN + ASM_SIMP_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* This is also interesting, and Minkowski follows easily from it. *) +(* ------------------------------------------------------------------------- *) + +let BLICHFELDT = prove + (`!s:real^N->bool. + bounded s /\ measurable s /\ &1 < measure s + ==> ?x y. x IN s /\ y IN s /\ ~(x = y) /\ + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i - y$i)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{ u:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> integer(u$i) }`; + `\u. {x | (x:real^N) IN s /\ + !i. 1 <= i /\ i <= dimindex(:N) + ==> (u:real^N)$i <= x$i /\ x$i < u$i + &1 }`; + `s:real^N->bool`] + LEMMA) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [ALL_TAC; + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `x - u:real^N = y - v <=> x + (v - u) = y`] THEN + REWRITE_TAC[UNWIND_THM1] THEN STRIP_TAC THEN + EXISTS_TAC `x + (v - u):real^N` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `x = x + (v - u) <=> v:real^N = u`] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `x - (x + v - u) = u - v`; INTEGER_CLOSED]] THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `?N. !x:real^N i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < &N` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + MP_TAC(SPEC `B:real` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN + X_GEN_TAC `N:num` THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS]; + ALL_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `{u:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> integer (u$i) /\ abs(u$i) <= &N}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_CART THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN + STRIP_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `k:num`]) THEN + ASM_SIMP_TAC[] THEN REAL_ARITH_TAC; + X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC MEASURABLE_ALMOST THEN + EXISTS_TAC `s INTER interval[u:real^N,u + vec 1]` THEN + ASM_SIMP_TAC[MEASURABLE_INTER_INTERVAL] THEN + EXISTS_TAC `interval[u:real^N,u + vec 1] DIFF interval(u,u + vec 1)` THEN + REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN + MATCH_MP_TAC(SET_RULE + `s' SUBSET i /\ j INTER s' = j INTER s + ==> (s INTER i) UNION (i DIFF j) = s' UNION (i DIFF j)`) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL; IN_INTER; EXTENSION; + IN_ELIM_THM] THEN + CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN TRY EQ_TAC THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `(lambda i. floor((x:real^N)$i)):real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA; FLOOR]; + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[CART_EQ; REAL_EQ_INTEGERS] THEN + REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP; REAL_NOT_LT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[DISJOINT] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `k:num`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `u:real^N` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VEC_COMPONENT] THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The usual form of the theorem. *) +(* ------------------------------------------------------------------------- *) + +let MINKOWSKI = prove + (`!s:real^N->bool. + convex s /\ + bounded s /\ + (!x. x IN s ==> (--x) IN s) /\ + &2 pow dimindex(:N) < measure s + ==> ?u. ~(u = vec 0) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ + u IN s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. (&1 / &2) % x) s` BLICHFELDT) THEN + ASM_SIMP_TAC[MEASURABLE_SCALING; MEASURE_SCALING; MEASURABLE_CONVEX; + BOUNDED_SCALING] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div; REAL_POW_INV] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `inv(&2) % x:real^N = inv(&2) % y <=> x = y`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; GSYM REAL_SUB_LDISTRIB] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN + EXISTS_TAC `inv(&2) % (u - v):real^N` THEN + ASM_SIMP_TAC[VECTOR_ARITH `inv(&2) % (u - v):real^N = vec 0 <=> u = v`] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN + REWRITE_TAC[VECTOR_SUB; VECTOR_ADD_LDISTRIB] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* A slightly sharper variant for use when the set is also closed. *) +(* ------------------------------------------------------------------------- *) + +let MINKOWSKI_COMPACT = prove + (`!s:real^N->bool. + convex s /\ compact s /\ + (!x. x IN s ==> (--x) IN s) /\ + &2 pow dimindex(:N) <= measure s + ==> ?u. ~(u = vec 0) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)) /\ + u IN s`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; MEASURE_EMPTY; REAL_LT_POW2]; + ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = inv(&2) % a + inv(&2) % --a`) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; + `{u | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(u$i)} + DELETE (vec 0:real^N)`] + SEPARATE_COMPACT_CLOSED) THEN + REWRITE_TAC[EXTENSION; IN_DELETE; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(TAUT + `(~e ==> c) /\ a /\ b /\ (d ==> e) + ==> (a /\ b /\ c ==> d) ==> e`) THEN + CONJ_TAC THENL [MESON_TAC[]; ASM_REWRITE_TAC[]] THEN CONJ_TAC THENL + [MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_DELETE; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[CART_EQ; REAL_NOT_LT; NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((y - x:real^N)$k)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM; VECTOR_SUB_COMPONENT] THEN + ASM_MESON_TAC[REAL_EQ_INTEGERS; REAL_NOT_LE]; + ALL_TAC] THEN + SIMP_TAC[dist] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. (&1 + d / &2 / B) % x) s` MINKOWSKI) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONVEX_SCALING; BOUNDED_SCALING; COMPACT_IMP_BOUNDED] THEN + ASM_SIMP_TAC[MEASURABLE_COMPACT; MEASURE_SCALING] THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; IN_IMAGE] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH + `--(a % x):real^N = a % y <=> a % (x + y) = vec 0`] THEN + ASM_MESON_TAC[VECTOR_ADD_RINV]; + ALL_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `d <= m ==> m < n ==> d < n`)) THEN + REWRITE_TAC[REAL_ARITH `m < a * m <=> &0 < m * (a - &1)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_COMPACT; MEASURABLE_MEASURE_POS_LT] THEN + REWRITE_TAC[GSYM HAS_MEASURE_0] THEN + DISCH_THEN(SUBST_ALL_TAC o MATCH_MP MEASURE_UNIQUE) THEN + ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_POW2]; + ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_POW_LT_1 THEN + REWRITE_TAC[DIMINDEX_NONZERO] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> c /\ b /\ a`] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`u:real^N`; `(&1 + d / &2 / B) % u:real^N`]) THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + REWRITE_TAC[VECTOR_ARITH `u - (&1 + e) % u:real^N = --(e % u)`] THEN + REWRITE_TAC[NORM_NEG; NORM_MUL] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[REAL_NOT_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(d / &2 / B) * B` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN + ASM_REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN + UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC);; diff --git a/100/morley.ml b/100/morley.ml new file mode 100644 index 0000000..95a3038 --- /dev/null +++ b/100/morley.ml @@ -0,0 +1,466 @@ +(* ========================================================================= *) +(* Formalization of Alain Connes's paper "A new proof of Morley's theorem". *) +(* ========================================================================= *) + +needs "Library/iter.ml";; +needs "Multivariate/geom.ml";; + +(* ------------------------------------------------------------------------- *) +(* Reflection about the line[0,e^{i t}] *) +(* ------------------------------------------------------------------------- *) + +let reflect2d = new_definition + `reflect2d t = rotate2d t o cnj o rotate2d(--t)`;; + +let REFLECT2D_COMPOSE = prove + (`!s t. reflect2d s o reflect2d t = rotate2d (&2 * (s - t))`, + REWRITE_TAC[FUN_EQ_THM; o_THM; reflect2d] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[ROTATE2D_COMPLEX; CNJ_CEXP; CNJ_MUL; CNJ_CNJ] THEN + REWRITE_TAC[CNJ_II; CNJ_CX; CNJ_NEG; COMPLEX_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM CEXP_ADD] THEN + REWRITE_TAC[CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; CX_MUL] THEN + AP_TERM_TAC THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Rotation about point "a" by angle "t". *) +(* ------------------------------------------------------------------------- *) + +let rotate_about = new_definition + `rotate_about a t x = a + rotate2d t (x - a)`;; + +(* ------------------------------------------------------------------------- *) +(* Reflection across line (a,b). *) +(* ------------------------------------------------------------------------- *) + +let reflect_across = new_definition + `reflect_across (a,b) x = a + reflect2d (Arg(b - a)) (x - a)`;; + +let REFLECT_ACROSS_COMPOSE = prove + (`!a b c. + ~(b = a) /\ ~(c = a) + ==> reflect_across(a,b) o reflect_across(a,c) = + rotate_about a (&2 * Arg((b - a) / (c - a)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[reflect_across; FUN_EQ_THM; o_THM; rotate_about] THEN + REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN + REWRITE_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM] REFLECT2D_COMPOSE] THEN + X_GEN_TAC `x:complex` THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_2; ROTATE2D_ADD] THEN + ASM_SIMP_TAC[ROTATE2D_SUB_ARG; COMPLEX_SUB_0]);; + +let REFLECT_ACROSS_COMPOSE_ANGLE = prove + (`!a b c. + ~(b = a) /\ ~(c = a) /\ &0 <= Im((c - a) / (b - a)) + ==> reflect_across(a,c) o reflect_across(a,b) = + rotate_about a (&2 * angle(c,a,b))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ANGLE_SYM] THEN + ASM_SIMP_TAC[REFLECT_ACROSS_COMPOSE] THEN + ASM_SIMP_TAC[angle; VECTOR_ANGLE_ARG; COMPLEX_SUB_0; + REAL_SUB_ARG; ARG_LE_PI]);; + +let REFLECT_ACROSS_COMPOSE_INVOLUTION = prove + (`!a b. ~(a = b) ==> reflect_across(a,b) o reflect_across(a,b) = I`, + SIMP_TAC[REFLECT_ACROSS_COMPOSE; COMPLEX_DIV_REFL; COMPLEX_SUB_0] THEN + REWRITE_TAC[ARG_NUM; REAL_MUL_RZERO; rotate_about; FUN_EQ_THM] THEN + REWRITE_TAC[ROTATE2D_ZERO; I_THM] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let REFLECT_ACROSS_SYM = prove + (`!a b. reflect_across(a,b) = reflect_across(b,a)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `a:complex = b` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM; reflect_across; reflect2d; o_THM] THEN + REWRITE_TAC[ROTATE2D_COMPLEX; CNJ_CEXP; CNJ_MUL; CNJ_CX; CNJ_II] THEN + REWRITE_TAC[CX_NEG; COMPLEX_RING `--ii * --z = ii * z`] THEN + SUBGOAL_THEN `cexp(ii * Cx(Arg(b - a))) = (b - a) / Cx(norm(b - a)) /\ + cexp(ii * Cx(Arg(a - b))) = (a - b) / Cx(norm(a - b))` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(a = Cx(&0)) /\ a * b = c ==> b = c / a`) THEN + ASM_REWRITE_TAC[GSYM ARG; CX_INJ; NORM_EQ_0; VECTOR_SUB_EQ]; + REWRITE_TAC[COMPLEX_RING `a * a * cnj b = a pow 2 * cnj b`] THEN + SUBST1_TAC(ISPECL [`a:complex`; `b:complex`] NORM_SUB) THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[complex_div] THEN + MATCH_MP_TAC(COMPLEX_RING + `b - a = ((b - a) * n) pow 2 * (cnj za - cnj zb) + ==> a + ((b - a) * n) pow 2 * cnj za = + b + ((a - b) * n) pow 2 * cnj zb`) THEN + REWRITE_TAC[CNJ_SUB; COMPLEX_RING `(z - a) - (z - b):complex = b - a`] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `(b' - a') * (b - a) = n pow 2 /\ ~(n = Cx(&0)) + ==> b - a = ((b - a) * inv n) pow 2 * (b' - a')`) THEN + REWRITE_TAC[GSYM CNJ_SUB; COMPLEX_MUL_CNJ; CX_INJ] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; COMPLEX_SUB_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Some additional lemmas. *) +(* ------------------------------------------------------------------------- *) + +let ITER_ROTATE_ABOUT = prove + (`!n a t. ITER n (rotate_about a t) = rotate_about a (&n * t)`, + REWRITE_TAC[FUN_EQ_THM; rotate_about] THEN + REWRITE_TAC[VECTOR_ARITH `a + b:real^N = a + c <=> b = c`] THEN + INDUCT_TAC THEN REWRITE_TAC[ITER_ALT; REAL_MUL_LZERO; ROTATE2D_ZERO] THEN + REWRITE_TAC[VECTOR_ARITH `a + x - a:real^N = x`; GSYM REAL_OF_NUM_SUC] THEN + ASM_REWRITE_TAC[REAL_ADD_RDISTRIB; ROTATE2D_ADD] THEN + REPEAT GEN_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[rotate_about; REAL_MUL_LID] THEN VECTOR_ARITH_TAC);; + +let REAL_LE_IM_DIV_CYCLIC = prove + (`!a b c. &0 <= Im ((c - a) / (b - a)) <=> &0 <= Im((a - b) / (c - b))`, + REWRITE_TAC[IM_COMPLEX_DIV_GE_0] THEN + REWRITE_TAC[complex_mul; IM; IM_SUB; RE_SUB; IM_CNJ; CNJ_SUB; RE_CNJ] THEN + REAL_ARITH_TAC);; + +let ROTATE_ABOUT_INVERT = prove + (`rotate_about a t w = z <=> w = rotate_about a (--t) z`, + MATCH_MP_TAC(MESON[] + `(!x. f(g x) = x) /\ (!y. g(f y) = y) + ==> (f x = y <=> x = g y)`) THEN + REWRITE_TAC[rotate_about; VECTOR_ADD_SUB; GSYM ROTATE2D_ADD] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_RINV] THEN + REWRITE_TAC[ROTATE2D_ZERO] THEN VECTOR_ARITH_TAC);; + +let ROTATE_EQ_REFLECT_LEMMA = prove + (`!a b z t. + ~(b = a) /\ &2 * Arg((b - a) / (z - a)) = t + ==> rotate_about a t z = reflect_across (a,b) z`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rotate_about; reflect_across] THEN + AP_TERM_TAC THEN REWRITE_TAC[ROTATE2D_COMPLEX; reflect2d; o_THM] THEN + REWRITE_TAC[CNJ_MUL; COMPLEX_MUL_ASSOC; CNJ_CEXP; CNJ_II] THEN + REWRITE_TAC[CNJ_CX; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG; + GSYM CEXP_ADD; CX_NEG] THEN + REWRITE_TAC[COMPLEX_RING `ii * a + ii * a = ii * Cx(&2) * a`] THEN + ASM_CASES_TAC `z:complex = a` THEN + ASM_REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; COMPLEX_SUB_REFL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (COMPLEX_RING + `~(z = a) + ==> c * (z - a) pow 2 = b * cnj (z - a) * (z - a) + ==> c * (z - a) = b * cnj(z - a)`)) THEN + REWRITE_TAC[COMPLEX_MUL_CNJ] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [ARG] THEN + MATCH_MP_TAC(COMPLEX_RING + `(e1:complex) * e2 pow 2 = e3 ==> e1 * (n * e2) pow 2 = e3 * n pow 2`) THEN + REWRITE_TAC[GSYM CEXP_ADD; GSYM CEXP_N; CEXP_EQ] THEN + REWRITE_TAC[COMPLEX_RING + `ii * t + Cx(&2) * ii * z = ii * u + v * ii <=> + t + Cx(&2) * z - u = v`] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; GSYM CX_ADD; CX_INJ] THEN + EXPAND_TAC "t" THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `&2 * a = &2 * b <=> a = b`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + (b - c):real = a - (c - b)`] THEN + ASM_SIMP_TAC[REAL_SUB_ARG; COMPLEX_SUB_0] THEN COND_CASES_TAC THENL + [EXISTS_TAC `&0`; EXISTS_TAC `&2`] THEN + SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let ROTATE_EQ_REFLECT_PI_LEMMA = prove + (`!a b z t. + ~(b = a) /\ &2 * Arg((b - a) / (z - a)) = &4 * pi + t + ==> rotate_about a t z = reflect_across (a,b) z`, + REWRITE_TAC[REAL_ARITH `a = &4 * pi + t <=> t = a + --(&4 * pi)`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `rotate_about a (&2 * Arg((b - a) / (z - a))) z` THEN + CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC ROTATE_EQ_REFLECT_LEMMA THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[rotate_about; ROTATE2D_ADD] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[ROTATE2D_COMPLEX] THEN + REWRITE_TAC[EULER; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; COS_NEG; SIN_NEG] THEN + REWRITE_TAC[SIN_NPI; COS_NPI; REAL_EXP_NEG; REAL_EXP_0; CX_NEG] THEN + REWRITE_TAC[COMPLEX_NEG_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Algebraic characterization of equilateral triangle. *) +(* ------------------------------------------------------------------------- *) + +let EQUILATERAL_TRIANGLE_ALGEBRAIC = prove + (`!A B C j. + j pow 3 = Cx(&1) /\ ~(j = Cx(&1)) /\ + A + j * B + j pow 2 * C = Cx(&0) + ==> dist(A,B) = dist(B,C) /\ dist(C,A) = dist(B,C)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[dist] THEN + SUBGOAL_THEN `C - A:complex = j * (B - C) /\ A - B = j pow 2 * (B - C)` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + SUBGOAL_THEN `norm(j pow 3) = &1` MP_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]; + REWRITE_TAC[COMPLEX_NORM_POW; REAL_POW_EQ_1; ARITH; REAL_ABS_NORM] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1)] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The main algebraic lemma. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_GROUP_ITER_3 = prove + (`ITER 3 (\z. a * z + b) = (\z. a pow 3 * z + b * (Cx(&1) + a + a pow 2))`, + REWRITE_TAC[TOP_DEPTH_CONV num_CONV `3`] THEN + REWRITE_TAC[ITER; FUN_EQ_THM] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC COMPLEX_RING);; + +let AFFINE_GROUP_COMPOSE = prove + (`(\z. a1 * z + b1) o (\z. a2 * z + b2) = + (\z. (a1 * a2) * z + (b1 + a1 * b2))`, + REWRITE_TAC[o_THM; FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING);; + +let AFFINE_GROUP_I = prove + (`I = (\z. Cx(&1) * z + Cx(&0))`, + REWRITE_TAC[I_THM; FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING);; + +let AFFINE_GROUP_EQ = prove + (`!a b a' b. (\z. a * z + b) = (\z. a' * z + b') <=> a = a' /\ b = b'`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[FUN_EQ_THM] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&1)`) THEN + CONV_TAC COMPLEX_RING);; + +let AFFINE_GROUP_ROTATE_ABOUT = prove + (`!a t. rotate_about a t = + (\z. cexp(ii * Cx(t)) * z + (Cx(&1) - cexp(ii * Cx(t))) * a)`, + REWRITE_TAC[rotate_about; FUN_EQ_THM; ROTATE2D_COMPLEX] THEN + CONV_TAC COMPLEX_RING);; + +let ALGEBRAIC_LEMMA = prove + (`!a1 a2 a3 b1 b2 b3 A B C. + (\z. a3 * z + b3) ((\z. a1 * z + b1) B) = B /\ + (\z. a1 * z + b1) ((\z. a2 * z + b2) C) = C /\ + (\z. a2 * z + b2) ((\z. a3 * z + b3) A) = A /\ + ITER 3 (\z. a1 * z + b1) o ITER 3 (\z. a2 * z + b2) o + ITER 3 (\z. a3 * z + b3) = I /\ + ~(a1 * a2 * a3 = Cx(&1)) /\ + ~(a1 * a2 = Cx(&1)) /\ + ~(a2 * a3 = Cx(&1)) /\ + ~(a3 * a1 = Cx(&1)) + ==> (a1 * a2 * a3) pow 3 = Cx (&1) /\ + ~(a1 * a2 * a3 = Cx (&1)) /\ + C + (a1 * a2 * a3) * A + (a1 * a2 * a3) pow 2 * B = Cx(&0)`, + REWRITE_TAC[AFFINE_GROUP_ITER_3; AFFINE_GROUP_COMPOSE; AFFINE_GROUP_I; + AFFINE_GROUP_EQ] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + SUBGOAL_THEN + `(a1 * a2 * a3) * a1 pow 2 * a2 * + (a1 - a1 * a2 * a3) * (a2 - a1 * a2 * a3) * (a3 - a1 * a2 * a3) * + (C + (a1 * a2 * a3) * A + (a1 * a2 * a3) pow 2 * B) = Cx(&0)` + MP_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD + `a3 * (a1 * B + b1) + b3 = B + ==> ~(a1 * a3 = Cx(&1)) + ==> B = (a3 * b1 + b3) / (Cx(&1) - a1 * a3)`))) THEN + REPEAT(ANTS_TAC THENL + [ASM_MESON_TAC[COMPLEX_MUL_SYM]; DISCH_THEN SUBST1_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (COMPLEX_RING + `s = Cx(&0) ==> s + t = Cx(&0) ==> t = Cx(&0)`)); + REWRITE_TAC[COMPLEX_ENTIRE]] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* A tactic to avoid some duplication over cyclic permutations. *) +(* ------------------------------------------------------------------------- *) + +let CYCLIC_PERM_SUBGOAL_THEN = + let lemma = MESON[] + `(!A B C P Q R a b c g1 g2 g3. + Ant A B C P Q R a b c g1 g2 g3 ==> Cns A B C P Q R a b c g1 g2 g3) + ==> (!A B C P Q R a b c g1 g2 g3. + Ant A B C P Q R a b c g1 g2 g3 + ==> Ant B C A Q R P b c a g2 g3 g1) + ==> (!A B C P Q R a b c g1 g2 g3. + Ant A B C P Q R a b c g1 g2 g3 + ==> Cns A B C P Q R a b c g1 g2 g3 /\ + Cns B C A Q R P b c a g2 g3 g1 /\ + Cns C A B R P Q c a b g3 g1 g2)` + and vars = + [`A:complex`; `B:complex`; `C:complex`; + `P:complex`; `Q:complex`; `R:complex`; + `a:real`; `b:real`; `c:real`; + `g1:complex->complex`; `g2:complex->complex`; `g3:complex->complex`] in + fun t ttac (asl,w) -> + let asm = list_mk_conj (map (concl o snd) (rev asl)) in + let gnw = list_mk_forall(vars,mk_imp(asm,t)) in + let th1 = MATCH_MP lemma (ASSUME gnw) in + let tm1 = fst(dest_imp(concl th1)) in + let th2 = REWRITE_CONV[INSERT_AC; CONJ_ACI; ANGLE_SYM; EQ_SYM_EQ] tm1 in + let th3 = DISCH_ALL(MP th1 (EQT_ELIM th2)) in + (MP_TAC th3 THEN ANTS_TAC THENL + [POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT GEN_TAC THEN STRIP_TAC; + DISCH_THEN(MP_TAC o SPEC_ALL) THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; + DISCH_THEN(CONJUNCTS_THEN2 ttac MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN ttac)]]) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Morley's theorem a la Connes. *) +(* ------------------------------------------------------------------------- *) + +let MORLEY = prove + (`!A B C:real^2 P Q R. + ~collinear{A,B,C} /\ {P,Q,R} SUBSET convex hull {A,B,C} /\ + angle(A,B,R) = angle(A,B,C) / &3 /\ + angle(B,A,R) = angle(B,A,C) / &3 /\ + angle(B,C,P) = angle(B,C,A) / &3 /\ + angle(C,B,P) = angle(C,B,A) / &3 /\ + angle(C,A,Q) = angle(C,A,B) / &3 /\ + angle(A,C,Q) = angle(A,C,B) / &3 + ==> dist(R,P) = dist(P,Q) /\ dist(Q,R) = dist(P,Q)`, + MATCH_MP_TAC(MESON[] + `(!A B C. &0 <= Im((C - A) / (B - A)) \/ + &0 <= Im((B - A) / (C - A))) /\ + (!A B C. Property A B C ==> Property A C B) /\ + (!A B C. &0 <= Im((C - A) / (B - A)) ==> Property A B C) + ==> !A B C. Property A B C`) THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM IM_COMPLEX_INV_LE_0] THEN + REWRITE_TAC[COMPLEX_INV_DIV] THEN REAL_ARITH_TAC; + REPEAT GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`P:real^2`; `Q:real^2`; `R:real^2`] THEN + REWRITE_TAC[ANGLE_SYM; DIST_SYM; INSERT_AC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`P:real^2`; `R:real^2`; `Q:real^2`]) THEN + REWRITE_TAC[ANGLE_SYM; DIST_SYM; INSERT_AC] THEN MESON_TAC[]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC]) + [`A:real^2 = B`; `A:real^2 = C`; `B:real^2 = C`] THEN + STRIP_TAC THEN + FIRST_ASSUM(fun th -> + let th' = GEN_REWRITE_RULE I [REAL_LE_IM_DIV_CYCLIC] th in + let th'' = GEN_REWRITE_RULE I [REAL_LE_IM_DIV_CYCLIC] th' in + ASSUME_TAC th' THEN ASSUME_TAC th'') THEN + ABBREV_TAC `a = angle(C:real^2,A,B) / &3` THEN + ABBREV_TAC `b = angle(A:real^2,B,C) / &3` THEN + ABBREV_TAC `c = angle(B:real^2,C,A) / &3` THEN + ABBREV_TAC `g1 = rotate_about A (&2 * a)` THEN + ABBREV_TAC `g2 = rotate_about B (&2 * b)` THEN + ABBREV_TAC `g3 = rotate_about C (&2 * c)` THEN + CYCLIC_PERM_SUBGOAL_THEN + `ITER 3 g1 o ITER 3 g2 o ITER 3 g3 = (I:real^2->real^2)` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g1"; "g2"; "g3"] THEN + REWRITE_TAC[ITER_ROTATE_ABOUT] THEN + MAP_EVERY EXPAND_TAC ["a"; "b"; "c"] THEN + REWRITE_TAC[REAL_ARITH `&3 * &2 * a / &3 = &2 * a`] THEN + ASM_SIMP_TAC[GSYM REFLECT_ACROSS_COMPOSE_ANGLE] THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; REFLECT_ACROSS_SYM] THEN + ASM_SIMP_TAC[REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM] + REFLECT_ACROSS_COMPOSE_INVOLUTION]; + ALL_TAC] THEN + CYCLIC_PERM_SUBGOAL_THEN `&0 <= Im((P - B) / (C - B))` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INSERT_SUBSET]) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN + REWRITE_TAC[CONVEX_HULL_3; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[VECTOR_ARITH `(u % A + v % B + w % C) - B:real^N = + u % (A - B) + w % (C - B) + ((u + v + w) - &1) % B`] THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB; IM_ADD; COMPLEX_CMUL] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN + ASM_SIMP_TAC[IM_MUL_CX; COMPLEX_DIV_REFL; COMPLEX_SUB_0; IM_CX] THEN + SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CYCLIC_PERM_SUBGOAL_THEN `&0 <= Im((B - C) / (P - C))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM IM_COMPLEX_INV_LE_0; COMPLEX_INV_DIV] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INSERT_SUBSET]) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN + REWRITE_TAC[CONVEX_HULL_3; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[VECTOR_ARITH `(u % A + v % B + w % C) - C:real^N = + v % (B - C) + u % (A - C) + ((u + v + w) - &1) % C`] THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB; IM_ADD; COMPLEX_CMUL] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN + ASM_SIMP_TAC[IM_MUL_CX; COMPLEX_DIV_REFL; COMPLEX_SUB_0; IM_CX] THEN + SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= u * --a ==> u * a <= &0`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&0 <= --x <=> x <= &0`] THEN + ASM_REWRITE_TAC[GSYM IM_COMPLEX_INV_GE_0; COMPLEX_INV_DIV]; + ALL_TAC] THEN + CYCLIC_PERM_SUBGOAL_THEN + `~(P:real^2 = B) /\ ~(P = C)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `!x y z. ~(angle(x:real^2,y,z) / &3 = pi / &2)` + (fun th -> ASM_MESON_TAC[th; ANGLE_REFL]) THEN + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `a <= pi /\ &0 < pi ==> ~(a / &3 = pi / &2)`) THEN + REWRITE_TAC[ANGLE_RANGE; PI_POS]; + ALL_TAC] THEN + CYCLIC_PERM_SUBGOAL_THEN + `(g3:complex->complex)(g1(Q)) = Q` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g1"; "g3"] THEN + ONCE_REWRITE_TAC[ROTATE_ABOUT_INVERT] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `reflect_across(A,C) Q` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ROTATE_EQ_REFLECT_LEMMA THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [SYM(ASSUME `angle(C:real^2,A,Q) = a`)] THEN + REWRITE_TAC[angle] THEN ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN + ASM_SIMP_TAC[VECTOR_ANGLE_ARG; COMPLEX_SUB_0]; + ALL_TAC] THEN + CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[REFLECT_ACROSS_SYM] THEN + MATCH_MP_TAC ROTATE_EQ_REFLECT_PI_LEMMA THEN + ASM_REWRITE_TAC[GSYM REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_ARITH `&2 * a = &4 * pi + &2 * --c <=> + a = &2 * pi - c`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [SYM(ASSUME `angle(B:real^2,C,A) / &3 = c`)] THEN + ONCE_REWRITE_TAC[ANGLE_SYM] THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN + REWRITE_TAC[angle] THEN + ASM_SIMP_TAC[VECTOR_ANGLE_ARG; COMPLEX_SUB_0] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_DIV] THEN + MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[GSYM ARG_EQ_0] THEN + DISCH_TAC THEN + SUBGOAL_THEN `angle(A:real^2,C,Q) = &0` MP_TAC THENL + [REWRITE_TAC[angle] THEN ASM_SIMP_TAC[VECTOR_ANGLE_ARG; COMPLEX_SUB_0]; + ASM_REWRITE_TAC[REAL_ARITH `a / &3 = &0 <=> a = &0`]] THEN + ASM_MESON_TAC[COLLINEAR_ANGLE; ANGLE_SYM; INSERT_AC]; + ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE LAND_CONV [AFFINE_GROUP_ROTATE_ABOUT])) THEN + CYCLIC_PERM_SUBGOAL_THEN + `~(cexp(ii * Cx(&2 * a)) * cexp(ii * Cx(&2 * b)) = Cx(&1)) /\ + ~(cexp(ii * Cx(&2 * a)) * cexp(ii * Cx(&2 * b)) * + cexp(ii * Cx(&2 * c)) = Cx(&1))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM CEXP_ADD; GSYM COMPLEX_ADD_LDISTRIB; GSYM CX_ADD] THEN + MP_TAC(REAL_ARITH + `&0 <= a /\ &0 <= b /\ &0 <= c /\ &0 < pi /\ + &3 * a + &3 * b + &3 * c = pi /\ ~(&3 * c = pi) + ==> (&0 < &2 * a + &2 * b /\ &2 * a + &2 * b < &2 * pi) /\ + (&0 < &2 * a + &2 * b + &2 * c /\ + &2 * a + &2 * b + &2 * c < &2 * pi)`) THEN + ANTS_TAC THENL + [MAP_EVERY EXPAND_TAC ["a"; "b"; "c"] THEN + REWRITE_TAC[REAL_ARITH `&3 * x / &3 = x`; PI_POS] THEN + SIMP_TAC[ANGLE_RANGE; REAL_LE_DIV; REAL_POS] THEN CONJ_TAC THENL + [ASM_MESON_TAC[TRIANGLE_ANGLE_SUM; ADD_AC; ANGLE_SYM]; + ASM_MESON_TAC[COLLINEAR_ANGLE; ANGLE_SYM; INSERT_AC]]; + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + REWRITE_TAC[CEXP_II_NE_1; GSYM CX_ADD]]; + ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`a1 = cexp(ii * Cx(&2 * a))`; + `a2 = cexp(ii * Cx(&2 * b))`; + `a3 = cexp(ii * Cx(&2 * c))`; + `b1 = (Cx (&1) - a1) * A`; + `b2 = (Cx (&1) - a2) * B`; + `b3 = (Cx (&1) - a3) * C`] THEN + REPEAT DISCH_TAC THEN MATCH_MP_TAC EQUILATERAL_TRIANGLE_ALGEBRAIC THEN + EXISTS_TAC `a1 * a2 * a3:complex` THEN + MATCH_MP_TAC ALGEBRAIC_LEMMA THEN + MAP_EVERY EXISTS_TAC [`b1:complex`; `b2:complex`; `b3:complex`] THEN + PURE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[]);; diff --git a/100/pascal.ml b/100/pascal.ml new file mode 100644 index 0000000..00a702f --- /dev/null +++ b/100/pascal.ml @@ -0,0 +1,625 @@ +(* ========================================================================= *) +(* Pascal's hexagon theorem for projective and affine planes. *) +(* ========================================================================= *) + +needs "Multivariate/cross.ml";; + +(* ------------------------------------------------------------------------- *) +(* A lemma we want to justify some of the axioms. *) +(* ------------------------------------------------------------------------- *) + +let NORMAL_EXISTS = prove + (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN + MP_TAC(ISPEC `{u:real^3,v}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; DIMINDEX_3] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD {u:real^3,v}` THEN CONJ_TAC THEN + SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Type of directions. *) +(* ------------------------------------------------------------------------- *) + +let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") + (MESON[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] `?x:real^3. ~(x = vec 0)`);; + +parse_as_infix("||",(11,"right"));; +parse_as_infix("_|_",(11,"right"));; + +let perpdir = new_definition + `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; + +let pardir = new_definition + `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; + +let DIRECTION_CLAUSES = prove + (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ + ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, + MESON_TAC[direction_tybij]);; + +let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) + (`(!x. x || x) /\ + (!x y. x || y <=> y || x) /\ + (!x y z. x || y /\ y || z ==> x || z)`, + REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let PARDIR_EQUIV = prove + (`!x y. ((||) x = (||) y) <=> x || y`, + REWRITE_TAC[FUN_EQ_THM] THEN + MESON_TAC[PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS]);; + +let DIRECTION_AXIOM_1 = prove + (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ + !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_2 = prove + (`!l l'. ?p. p _|_ l /\ p _|_ l'`, + REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN + MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; + +let DIRECTION_AXIOM_3 = prove + (`?p p' p''. + ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN MAP_EVERY + (fun t -> EXISTS_TAC t THEN SIMP_TAC[BASIS_NONZERO; DIMINDEX_3; ARITH]) + [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN + VEC3_TAC);; + +let DIRECTION_AXIOM_4_WEAK = prove + (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ + ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ + orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ + orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 2) cross (l cross basis 3) = vec 0)` + MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; + +let ORTHOGONAL_COMBINE = prove + (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) + ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_4 = prove + (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + p _|_ l /\ p' _|_ l /\ p'' _|_ l`, + MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; + +let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; + +let PERPDIR_WELLDEF = prove + (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let perpl,perpl_th = + lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) + "perpl" PERPDIR_WELLDEF;; + +let line_lift_thm = lift_theorem line_tybij + (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; + +let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; +let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; +let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; +let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; + +let point_tybij = new_type_definition "point" ("mk_point","dest_point") + (prove(`?x:line. T`,REWRITE_TAC[]));; + +parse_as_infix("on",(11,"right"));; + +let on = new_definition `p on l <=> perpl (dest_point p) l`;; + +let POINT_CLAUSES = prove + (`((p = p') <=> (dest_point p = dest_point p')) /\ + ((!p. P (dest_point p)) <=> (!l. P l)) /\ + ((?p. P (dest_point p)) <=> (?l. P l))`, + MESON_TAC[point_tybij]);; + +let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; + +let AXIOM_1 = prove + (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ + !l'. p on l' /\ p' on l' ==> (l' = l)`, + POINT_TAC LINE_AXIOM_1);; + +let AXIOM_2 = prove + (`!l l'. ?p. p on l /\ p on l'`, + POINT_TAC LINE_AXIOM_2);; + +let AXIOM_3 = prove + (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p on l /\ p' on l /\ p'' on l)`, + POINT_TAC LINE_AXIOM_3);; + +let AXIOM_4 = prove + (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p on l /\ p' on l /\ p'' on l`, + POINT_TAC LINE_AXIOM_4);; + +(* ------------------------------------------------------------------------- *) +(* Mappings from vectors in R^3 to projective lines and points. *) +(* ------------------------------------------------------------------------- *) + +let projl = new_definition + `projl x = mk_line((||) (mk_dir x))`;; + +let projp = new_definition + `projp x = mk_point(projl x)`;; + +(* ------------------------------------------------------------------------- *) +(* Mappings in the other direction, to (some) homogeneous coordinates. *) +(* ------------------------------------------------------------------------- *) + +let PROJL_TOTAL = prove + (`!l. ?x. ~(x = vec 0) /\ l = projl x`, + GEN_TAC THEN + SUBGOAL_THEN `?d. l = mk_line((||) d)` (CHOOSE_THEN SUBST1_TAC) THENL + [MESON_TAC[fst line_tybij; snd line_tybij]; + REWRITE_TAC[projl] THEN EXISTS_TAC `dest_dir d` THEN + MESON_TAC[direction_tybij]]);; + +let homol = new_specification ["homol"] + (REWRITE_RULE[SKOLEM_THM] PROJL_TOTAL);; + +let PROJP_TOTAL = prove + (`!p. ?x. ~(x = vec 0) /\ p = projp x`, + REWRITE_TAC[projp] THEN MESON_TAC[PROJL_TOTAL; point_tybij]);; + +let homop_def = new_definition + `homop p = homol(dest_point p)`;; + +let homop = prove + (`!p. ~(homop p = vec 0) /\ p = projp(homop p)`, + GEN_TAC THEN REWRITE_TAC[homop_def; projp; MESON[point_tybij] + `p = mk_point l <=> dest_point p = l`] THEN + MATCH_ACCEPT_TAC homol);; + +(* ------------------------------------------------------------------------- *) +(* Key equivalences of concepts in projective space and homogeneous coords. *) +(* ------------------------------------------------------------------------- *) + +let parallel = new_definition + `parallel x y <=> x cross y = vec 0`;; + +let ON_HOMOL = prove + (`!p l. p on l <=> orthogonal (homop p) (homol l)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homop; homol] THEN + REWRITE_TAC[on; projp; projl; REWRITE_RULE[] point_tybij] THEN + REWRITE_TAC[GSYM perpl_th; perpdir] THEN BINOP_TAC THEN + MESON_TAC[homol; homop; direction_tybij]);; + +let EQ_HOMOL = prove + (`!l l'. l = l' <=> parallel (homol l) (homol l')`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [homol] THEN + REWRITE_TAC[projl; MESON[fst line_tybij; snd line_tybij] + `mk_line((||) l) = mk_line((||) l') <=> (||) l = (||) l'`] THEN + REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir; parallel] THEN + MESON_TAC[homol; direction_tybij]);; + +let EQ_HOMOP = prove + (`!p p'. p = p' <=> parallel (homop p) (homop p')`, + REWRITE_TAC[homop_def; GSYM EQ_HOMOL] THEN + MESON_TAC[point_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* A "welldefinedness" result for homogeneous coordinate map. *) +(* ------------------------------------------------------------------------- *) + +let PARALLEL_PROJL_HOMOL = prove + (`!x. parallel x (homol(projl x))`, + GEN_TAC THEN REWRITE_TAC[parallel] THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN + ASM_REWRITE_TAC[CROSS_0] THEN MP_TAC(ISPEC `projl x` homol) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [projl] THEN + DISCH_THEN(MP_TAC o AP_TERM `dest_line`) THEN + REWRITE_TAC[MESON[fst line_tybij; snd line_tybij] + `dest_line(mk_line((||) l)) = (||) l`] THEN + REWRITE_TAC[PARDIR_EQUIV] THEN REWRITE_TAC[pardir] THEN + ASM_MESON_TAC[direction_tybij]);; + +let PARALLEL_PROJP_HOMOP = prove + (`!x. parallel x (homop(projp x))`, + REWRITE_TAC[homop_def; projp; REWRITE_RULE[] point_tybij] THEN + REWRITE_TAC[PARALLEL_PROJL_HOMOL]);; + +let PARALLEL_PROJP_HOMOP_EXPLICIT = prove + (`!x. ~(x = vec 0) ==> ?a. ~(a = &0) /\ homop(projp x) = a % x`, + MP_TAC PARALLEL_PROJP_HOMOP THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[parallel; CROSS_EQ_0; COLLINEAR_LEMMA] THEN + GEN_TAC THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN + ASM_REWRITE_TAC[homop] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:real` THEN ASM_CASES_TAC `c = &0` THEN + ASM_REWRITE_TAC[homop; VECTOR_MUL_LZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Brackets, collinearity and their connection. *) +(* ------------------------------------------------------------------------- *) + +let bracket = define + `bracket[a;b;c] = det(vector[homop a;homop b;homop c])`;; + +let COLLINEAR = new_definition + `COLLINEAR s <=> ?l. !p. p IN s ==> p on l`;; + +let COLLINEAR_SINGLETON = prove + (`!a. COLLINEAR {a}`, + REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[AXIOM_1; AXIOM_3]);; + +let COLLINEAR_PAIR = prove + (`!a b. COLLINEAR{a,b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:point = b` THEN + ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SINGLETON] THEN + REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[AXIOM_1]);; + +let COLLINEAR_TRIPLE = prove + (`!a b c. COLLINEAR{a,b,c} <=> ?l. a on l /\ b on l /\ c on l`, + REWRITE_TAC[COLLINEAR; FORALL_IN_INSERT; NOT_IN_EMPTY]);; + +let COLLINEAR_BRACKET = prove + (`!p1 p2 p3. COLLINEAR {p1,p2,p3} <=> bracket[p1;p2;p3] = &0`, + let lemma = prove + (`!a b c x y. + x cross y = vec 0 /\ ~(x = vec 0) /\ + orthogonal a x /\ orthogonal b x /\ orthogonal c x + ==> orthogonal a y /\ orthogonal b y /\ orthogonal c y`, + REWRITE_TAC[orthogonal] THEN VEC3_TAC) in + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[COLLINEAR_TRIPLE; bracket; ON_HOMOL; LEFT_IMP_EXISTS_THM] THEN + MP_TAC homol THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[DET_3; orthogonal; DOT_3; VECTOR_3; CART_EQ; + DIMINDEX_3; FORALL_3; VEC_COMPONENT] THEN + CONV_TAC REAL_RING; + ASM_CASES_TAC `p1:point = p2` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_PAIR]; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[parallel; COLLINEAR_TRIPLE; bracket; EQ_HOMOP; ON_HOMOL] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `mk_line((||) (mk_dir(homop p1 cross homop p2)))` THEN + MATCH_MP_TAC lemma THEN EXISTS_TAC `homop p1 cross homop p2` THEN + ASM_REWRITE_TAC[ORTHOGONAL_CROSS] THEN + REWRITE_TAC[orthogonal] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + ONCE_REWRITE_TAC[CROSS_TRIPLE] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + ASM_REWRITE_TAC[DOT_CROSS_DET] THEN + REWRITE_TAC[GSYM projl; GSYM parallel; PARALLEL_PROJL_HOMOL]]);; + +(* ------------------------------------------------------------------------- *) +(* Conics and bracket condition for 6 points to be on a conic. *) +(* ------------------------------------------------------------------------- *) + +let homogeneous_conic = new_definition + `homogeneous_conic con <=> + ?a b c d e f. + ~(a = &0 /\ b = &0 /\ c = &0 /\ d = &0 /\ e = &0 /\ f = &0) /\ + con = {x:real^3 | a * x$1 pow 2 + b * x$2 pow 2 + c * x$3 pow 2 + + d * x$1 * x$2 + e * x$1 * x$3 + f * x$2 * x$3 = &0}`;; + +let projective_conic = new_definition + `projective_conic con <=> + ?c. homogeneous_conic c /\ con = {p | (homop p) IN c}`;; + +let HOMOGENEOUS_CONIC_BRACKET = prove + (`!con x1 x2 x3 x4 x5 x6. + homogeneous_conic con /\ + x1 IN con /\ x2 IN con /\ x3 IN con /\ + x4 IN con /\ x5 IN con /\ x6 IN con + ==> det(vector[x6;x1;x4]) * det(vector[x6;x2;x3]) * + det(vector[x5;x1;x3]) * det(vector[x5;x2;x4]) = + det(vector[x6;x1;x3]) * det(vector[x6;x2;x4]) * + det(vector[x5;x1;x4]) * det(vector[x5;x2;x3])`, + REPEAT GEN_TAC THEN REWRITE_TAC[homogeneous_conic; EXTENSION] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; DET_3; VECTOR_3] THEN + CONV_TAC REAL_RING);; + +let PROJECTIVE_CONIC_BRACKET = prove + (`!con p1 p2 p3 p4 p5 p6. + projective_conic con /\ + p1 IN con /\ p2 IN con /\ p3 IN con /\ + p4 IN con /\ p5 IN con /\ p6 IN con + ==> bracket[p6;p1;p4] * bracket[p6;p2;p3] * + bracket[p5;p1;p3] * bracket[p5;p2;p4] = + bracket[p6;p1;p3] * bracket[p6;p2;p4] * + bracket[p5;p1;p4] * bracket[p5;p2;p3]`, + REPEAT GEN_TAC THEN REWRITE_TAC[bracket; projective_conic] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC HOMOGENEOUS_CONIC_BRACKET THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Pascal's theorem with all the nondegeneracy principles we use directly. *) +(* ------------------------------------------------------------------------- *) + +let PASCAL_DIRECT = prove + (`!con x1 x2 x3 x4 x5 x6 x6 x8 x9. + ~COLLINEAR {x2,x5,x7} /\ + ~COLLINEAR {x1,x2,x5} /\ + ~COLLINEAR {x1,x3,x6} /\ + ~COLLINEAR {x2,x4,x6} /\ + ~COLLINEAR {x3,x4,x5} /\ + ~COLLINEAR {x1,x5,x7} /\ + ~COLLINEAR {x2,x5,x9} /\ + ~COLLINEAR {x1,x2,x6} /\ + ~COLLINEAR {x3,x6,x8} /\ + ~COLLINEAR {x2,x4,x5} /\ + ~COLLINEAR {x2,x4,x7} /\ + ~COLLINEAR {x2,x6,x8} /\ + ~COLLINEAR {x3,x4,x6} /\ + ~COLLINEAR {x3,x5,x8} /\ + ~COLLINEAR {x1,x3,x5} + ==> projective_conic con /\ + x1 IN con /\ x2 IN con /\ x3 IN con /\ + x4 IN con /\ x5 IN con /\ x6 IN con /\ + COLLINEAR {x1,x9,x5} /\ + COLLINEAR {x1,x8,x6} /\ + COLLINEAR {x2,x9,x4} /\ + COLLINEAR {x2,x7,x6} /\ + COLLINEAR {x3,x8,x4} /\ + COLLINEAR {x3,x7,x5} + ==> COLLINEAR {x7,x8,x9}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e /\ f /\ g /\ h ==> p <=> + a /\ b /\ c /\ d /\ e /\ f /\ g ==> h ==> p`] THEN + DISCH_THEN(MP_TAC o MATCH_MP PROJECTIVE_CONIC_BRACKET) THEN + REWRITE_TAC[COLLINEAR_BRACKET; IMP_IMP; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT `!q. (p ==> q) /\ (q ==> r) ==> p ==> r`) THEN + EXISTS_TAC + `bracket[x1;x2;x5] * bracket[x1;x3;x6] * + bracket[x2;x4;x6] * bracket[x3;x4;x5] = + bracket[x1;x2;x6] * bracket[x1;x3;x5] * + bracket[x2;x4;x5] * bracket[x3;x4;x6] /\ + bracket[x1;x5;x7] * bracket[x2;x5;x9] = + --bracket[x1;x2;x5] * bracket[x5;x9;x7] /\ + bracket[x1;x2;x6] * bracket[x3;x6;x8] = + bracket[x1;x3;x6] * bracket[x2;x6;x8] /\ + bracket[x2;x4;x5] * bracket[x2;x9;x7] = + --bracket[x2;x4;x7] * bracket[x2;x5;x9] /\ + bracket[x2;x4;x7] * bracket[x2;x6;x8] = + --bracket[x2;x4;x6] * bracket[x2;x8;x7] /\ + bracket[x3;x4;x6] * bracket[x3;x5;x8] = + bracket[x3;x4;x5] * bracket[x3;x6;x8] /\ + bracket[x1;x3;x5] * bracket[x5;x8;x7] = + --bracket[x1;x5;x7] * bracket[x3;x5;x8]` THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN + REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + REWRITE_TAC[IMP_CONJ] THEN + REPEAT(ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_RING + `a = b /\ x:real = y ==> a * x = b * y`))) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BRACKET]) THEN + REWRITE_TAC[REAL_MUL_AC] THEN ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[bracket; DET_3; VECTOR_3] THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* With longer but more intuitive non-degeneracy conditions, basically that *) +(* the 6 points divide into two groups of 3 and no 3 are collinear unless *) +(* they are all in the same group. *) +(* ------------------------------------------------------------------------- *) + +let PASCAL = prove + (`!con x1 x2 x3 x4 x5 x6 x6 x8 x9. + ~COLLINEAR {x1,x2,x4} /\ + ~COLLINEAR {x1,x2,x5} /\ + ~COLLINEAR {x1,x2,x6} /\ + ~COLLINEAR {x1,x3,x4} /\ + ~COLLINEAR {x1,x3,x5} /\ + ~COLLINEAR {x1,x3,x6} /\ + ~COLLINEAR {x2,x3,x4} /\ + ~COLLINEAR {x2,x3,x5} /\ + ~COLLINEAR {x2,x3,x6} /\ + ~COLLINEAR {x4,x5,x1} /\ + ~COLLINEAR {x4,x5,x2} /\ + ~COLLINEAR {x4,x5,x3} /\ + ~COLLINEAR {x4,x6,x1} /\ + ~COLLINEAR {x4,x6,x2} /\ + ~COLLINEAR {x4,x6,x3} /\ + ~COLLINEAR {x5,x6,x1} /\ + ~COLLINEAR {x5,x6,x2} /\ + ~COLLINEAR {x5,x6,x3} + ==> projective_conic con /\ + x1 IN con /\ x2 IN con /\ x3 IN con /\ + x4 IN con /\ x5 IN con /\ x6 IN con /\ + COLLINEAR {x1,x9,x5} /\ + COLLINEAR {x1,x8,x6} /\ + COLLINEAR {x2,x9,x4} /\ + COLLINEAR {x2,x7,x6} /\ + COLLINEAR {x3,x8,x4} /\ + COLLINEAR {x3,x7,x5} + ==> COLLINEAR {x7,x8,x9}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(fun th -> + MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN DISCH_TAC THEN + MP_TAC th THEN MATCH_MP_TAC PASCAL_DIRECT THEN + ASSUME_TAC(funpow 7 CONJUNCT2 th)) THEN + REPEAT CONJ_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[COLLINEAR_BRACKET; bracket; DET_3; VECTOR_3] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Homogenization and hence mapping from affine to projective plane. *) +(* ------------------------------------------------------------------------- *) + +let homogenize = new_definition + `(homogenize:real^2->real^3) x = vector[x$1; x$2; &1]`;; + +let projectivize = new_definition + `projectivize = projp o homogenize`;; + +let HOMOGENIZE_NONZERO = prove + (`!x. ~(homogenize x = vec 0)`, + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT; VECTOR_3; + homogenize] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Conic in affine plane. *) +(* ------------------------------------------------------------------------- *) + +let affine_conic = new_definition + `affine_conic con <=> + ?a b c d e f. + ~(a = &0 /\ b = &0 /\ c = &0 /\ d = &0 /\ e = &0 /\ f = &0) /\ + con = {x:real^2 | a * x$1 pow 2 + b * x$2 pow 2 + c * x$1 * x$2 + + d * x$1 + e * x$2 + f = &0}`;; + +(* ------------------------------------------------------------------------- *) +(* Relationships between affine and projective notions. *) +(* ------------------------------------------------------------------------- *) + +let COLLINEAR_PROJECTIVIZE = prove + (`!a b c. collinear{a,b,c} <=> + COLLINEAR{projectivize a,projectivize b,projectivize c}`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN + REWRITE_TAC[COLLINEAR_BRACKET; projectivize; o_THM; bracket] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `det(vector[homogenize a; homogenize b; homogenize c]) = &0` THEN + CONJ_TAC THENL + [REWRITE_TAC[homogenize; DOT_2; VECTOR_SUB_COMPONENT; DET_3; VECTOR_3] THEN + CONV_TAC REAL_RING; + MAP_EVERY (MP_TAC o C SPEC PARALLEL_PROJP_HOMOP) + [`homogenize a`; `homogenize b`; `homogenize c`] THEN + MAP_EVERY (MP_TAC o C SPEC HOMOGENIZE_NONZERO) + [`a:real^2`; `b:real^2`; `c:real^2`] THEN + MAP_EVERY (MP_TAC o CONJUNCT1 o C SPEC homop) + [`projp(homogenize a)`; `projp(homogenize b)`; `projp(homogenize c)`] THEN + REWRITE_TAC[parallel; cross; CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3; + DET_3; VEC_COMPONENT] THEN + CONV_TAC REAL_RING]);; + +let AFFINE_PROJECTIVE_CONIC = prove + (`!con. affine_conic con <=> ?con'. projective_conic con' /\ + con = {x | projectivize x IN con'}`, + REWRITE_TAC[affine_conic; projective_conic; homogeneous_conic] THEN + GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[MESON[] + `(?con' con a b c d e f. P con' con a b c d e f) <=> + (?a b d e f c con' con. P con' con a b c d e f)`] THEN + MAP_EVERY (fun s -> + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC(mk_var(s,`:real`)) THEN REWRITE_TAC[]) + ["a"; "b"; "c"; "d"; "e"; "f"] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[IN_ELIM_THM; projectivize; o_THM] THEN + BINOP_TAC THENL [CONV_TAC TAUT; AP_TERM_TAC] THEN + REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `x:real^2` THEN + MP_TAC(SPEC `x:real^2` HOMOGENIZE_NONZERO) THEN + DISCH_THEN(MP_TAC o MATCH_MP PARALLEL_PROJP_HOMOP_EXPLICIT) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[homogenize; VECTOR_3] THEN + UNDISCH_TAC `~(k = &0)` THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Hence Pascal's theorem for the affine plane. *) +(* ------------------------------------------------------------------------- *) + +let PASCAL_AFFINE = prove + (`!con x1 x2 x3 x4 x5 x6 x7 x8 x9:real^2. + ~collinear {x1,x2,x4} /\ + ~collinear {x1,x2,x5} /\ + ~collinear {x1,x2,x6} /\ + ~collinear {x1,x3,x4} /\ + ~collinear {x1,x3,x5} /\ + ~collinear {x1,x3,x6} /\ + ~collinear {x2,x3,x4} /\ + ~collinear {x2,x3,x5} /\ + ~collinear {x2,x3,x6} /\ + ~collinear {x4,x5,x1} /\ + ~collinear {x4,x5,x2} /\ + ~collinear {x4,x5,x3} /\ + ~collinear {x4,x6,x1} /\ + ~collinear {x4,x6,x2} /\ + ~collinear {x4,x6,x3} /\ + ~collinear {x5,x6,x1} /\ + ~collinear {x5,x6,x2} /\ + ~collinear {x5,x6,x3} + ==> affine_conic con /\ + x1 IN con /\ x2 IN con /\ x3 IN con /\ + x4 IN con /\ x5 IN con /\ x6 IN con /\ + collinear {x1,x9,x5} /\ + collinear {x1,x8,x6} /\ + collinear {x2,x9,x4} /\ + collinear {x2,x7,x6} /\ + collinear {x3,x8,x4} /\ + collinear {x3,x7,x5} + ==> collinear {x7,x8,x9}`, + REWRITE_TAC[COLLINEAR_PROJECTIVIZE; AFFINE_PROJECTIVE_CONIC] THEN + REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP PASCAL) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of a circle where nondegeneracy is simpler. *) +(* ------------------------------------------------------------------------- *) + +let COLLINEAR_NOT_COCIRCULAR = prove + (`!r c x y z:real^2. + dist(c,x) = r /\ dist(c,y) = r /\ dist(c,z) = r /\ + ~(x = y) /\ ~(x = z) /\ ~(y = z) + ==> ~collinear {x,y,z}`, + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM DOT_EQ_0] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; DOT_2] THEN + REWRITE_TAC[dist; NORM_EQ_SQUARE; CART_EQ; DIMINDEX_2; FORALL_2; + DOT_2; VECTOR_SUB_COMPONENT] THEN + CONV_TAC REAL_RING);; + +let PASCAL_AFFINE_CIRCLE = prove + (`!c r x1 x2 x3 x4 x5 x6 x7 x8 x9:real^2. + PAIRWISE (\x y. ~(x = y)) [x1;x2;x3;x4;x5;x6] /\ + dist(c,x1) = r /\ dist(c,x2) = r /\ dist(c,x3) = r /\ + dist(c,x4) = r /\ dist(c,x5) = r /\ dist(c,x6) = r /\ + collinear {x1,x9,x5} /\ + collinear {x1,x8,x6} /\ + collinear {x2,x9,x4} /\ + collinear {x2,x7,x6} /\ + collinear {x3,x8,x4} /\ + collinear {x3,x7,x5} + ==> collinear {x7,x8,x9}`, + GEN_TAC THEN GEN_TAC THEN + MP_TAC(SPEC `{x:real^2 | dist(c,x) = r}` PASCAL_AFFINE) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[PAIRWISE; ALL; IN_ELIM_THM] THEN + GEN_REWRITE_TAC LAND_CONV [IMP_IMP] THEN + DISCH_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT CONJ_TAC THEN MATCH_MP_TAC COLLINEAR_NOT_COCIRCULAR THEN + MAP_EVERY EXISTS_TAC [`r:real`; `c:real^2`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[affine_conic; dist; NORM_EQ_SQUARE] THEN + ASM_CASES_TAC `&0 <= r` THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXISTS_TAC + [`&1`; `&1`; `&0`; `-- &2 * (c:real^2)$1`; `-- &2 * (c:real^2)$2`; + `(c:real^2)$1 pow 2 + (c:real^2)$2 pow 2 - r pow 2`] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; + REPLICATE_TAC 5 (EXISTS_TAC `&0`) THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]]);; diff --git a/100/perfect.ml b/100/perfect.ml new file mode 100644 index 0000000..5791932 --- /dev/null +++ b/100/perfect.ml @@ -0,0 +1,283 @@ +(* ========================================================================= *) +(* Perfect number theorems. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* The sum-of-divisors function. *) +(* ------------------------------------------------------------------------- *) + +let sigma = new_definition + `sigma(n) = if n = 0 then 0 else nsum {d | d divides n} (\i. i)`;; + +(* ------------------------------------------------------------------------- *) +(* Definition of perfection. *) +(* ------------------------------------------------------------------------- *) + +let perfect = new_definition + `perfect n <=> ~(n = 0) /\ sigma(n) = 2 * n`;; + +(* ------------------------------------------------------------------------- *) +(* Various number-theoretic lemmas. *) +(* ------------------------------------------------------------------------- *) + +let ODD_POW2_MINUS1 = prove + (`!k. ~(k = 0) ==> ODD(2 EXP k - 1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `EVEN(2 EXP k) <=> EVEN((2 EXP k - 1) + 1)` MP_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[ARITH_RULE `k = k - 1 + 1 <=> ~(k = 0)`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH]; + ASM_REWRITE_TAC[GSYM NOT_EVEN; EVEN_ADD; EVEN_EXP; ARITH]]);; + +let EVEN_ODD_DECOMP = prove + (`!n. ~(n = 0) ==> ?r s. ODD s /\ n = 2 EXP r * s`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + MP_TAC(SPEC `n:num` EVEN_OR_ODD) THEN + REWRITE_TAC[EVEN_EXISTS; ODD_EXISTS] THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `m:num` SUBST_ALL_TAC)) THENL + [DISCH_THEN(MP_TAC o SPEC `m:num`) THEN + REWRITE_TAC[MULT_EQ_0; ARITH; ARITH_RULE `m < 2 * m <=> ~(m = 0)`] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `s:num` THEN DISCH_THEN(X_CHOOSE_TAC `r:num`) THEN + EXISTS_TAC `SUC r` THEN ASM_REWRITE_TAC[EXP; GSYM MULT_ASSOC]; + REPEAT(DISCH_THEN(K ALL_TAC)) THEN EXISTS_TAC `0` THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN MESON_TAC[]]);; + +let FINITE_DIVISORS = prove + (`!n. ~(n = 0) ==> FINITE {d | d divides n}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{d | d <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE]);; + +let MULT_EQ_COPRIME = prove + (`!a b x y. a * b = x * y /\ coprime(a,x) + ==> ?d. y = a * d /\ b = x * d`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `x:num`; `y:num`] COPRIME_DIVPROD) THEN + MP_TAC(SPECL [`x:num`; `a:num`; `b:num`] COPRIME_DIVPROD) THEN + REPEAT(ANTS_TAC THENL + [ASM_MESON_TAC[DIVIDES_REFL; DIVIDES_RMUL; COPRIME_SYM]; + REWRITE_TAC[divides] THEN STRIP_TAC]) THEN + UNDISCH_TAC `a * b = x * y` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE + `(a * x * u = x * a * v) <=> (a * x) * u = (a * x) * v`] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; MULT_EQ_0] THEN ASM_MESON_TAC[]);; + +let COPRIME_ODD_POW2 = prove + (`!k n. ODD(n) ==> coprime(2 EXP k,n)`, + SIMP_TAC[coprime; PRIME_2; DIVIDES_PRIMEPOW] THEN REWRITE_TAC[divides] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `ODD n` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[ODD_MULT; ODD_EXP; ARITH]);; + +let MULT_NSUM = prove + (`!s t. FINITE s /\ FINITE t + ==> nsum s f * nsum t g = + nsum {(x:A,y:B) | x IN s /\ y IN t} (\(x,y). f(x) * g(y))`, + SIMP_TAC[GSYM NSUM_NSUM_PRODUCT; NSUM_LMUL; NSUM_RMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Some elementary properties of the sigma function. *) +(* ------------------------------------------------------------------------- *) + +let SIGMA_0 = prove + (`sigma 0 = 0`, + REWRITE_TAC[sigma]);; + +let SIGMA_1 = prove + (`sigma(1) = 1`, + REWRITE_TAC[sigma; DIVIDES_ONE; SET_RULE `{d | d = 1} = {1}`] THEN + REWRITE_TAC[ARITH; NSUM_SING]);; + +let SIGMA_LBOUND = prove + (`!n. 1 < n ==> n + 1 <= sigma(n)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 0)`)) THEN + ASM_REWRITE_TAC[sigma] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `nsum {1,n} (\i. i)` THEN CONJ_TAC THENL + [SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[FINITE_DIVISORS] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT] THEN + MESON_TAC[DIVIDES_1; DIVIDES_REFL]]);; + +let SIGMA_MULT = prove + (`!a b. 1 < a /\ 1 < b ==> 1 + b + a * b <= sigma(a * b)`, + REPEAT STRIP_TAC THEN + EVERY_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 0)`)) THEN + ASM_REWRITE_TAC[sigma] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `nsum {1,b,a*b} (\i. i)` THEN CONJ_TAC THENL + [SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN + ONCE_REWRITE_TAC[ARITH_RULE `x = a * b <=> a * b = 1 * x`] THEN + ASM_REWRITE_TAC[EQ_MULT_RCANCEL] THEN + REWRITE_TAC[MULT_CLAUSES; MULT_EQ_1] THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[MULT_EQ_0] THEN + MATCH_MP_TAC NSUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_DIVISORS; MULT_EQ_0] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT] THEN + MESON_TAC[DIVIDES_1; DIVIDES_REFL; DIVIDES_LMUL]]);; + +let SIGMA_PRIME = prove + (`!p. prime(p) ==> sigma(p) = p + 1`, + GEN_TAC THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0; SIGMA_0; ARITH] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1; SIGMA_1; ARITH] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[sigma] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `nsum {1,p} (\i. i)` THEN + CONJ_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[prime; DIVIDES_1; DIVIDES_REFL]; + ASM_SIMP_TAC[NSUM_CLAUSES; IN_SING; FINITE_RULES; NOT_IN_EMPTY] THEN + ARITH_TAC]);; + +let SIGMA_PRIME_EQ = prove + (`!p. prime(p) <=> sigma(p) = p + 1`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIGMA_PRIME] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[prime; DE_MORGAN_THM] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[SIGMA_1; ARITH] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; divides; DE_MORGAN_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` SUBST_ALL_TAC) THEN + MP_TAC(SPECL [`a:num`; `b:num`] SIGMA_MULT) THEN + ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; SIGMA_0; ARITH] THEN + ASM_CASES_TAC `b = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; SIGMA_0; ARITH] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[MULT_EQ_1] THEN + ONCE_REWRITE_TAC[ARITH_RULE `a = a * b <=> a * b = a * 1`] THEN + REWRITE_TAC[EQ_MULT_LCANCEL] THEN ARITH_TAC);; + +let SIGMA_POW2 = prove + (`!k. sigma(2 EXP k) = 2 EXP (k + 1) - 1`, + GEN_TAC THEN REWRITE_TAC[sigma; EXP_EQ_0; ARITH] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `nsum {2 EXP i | i <= k} (\i. i)` THEN CONJ_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[DIVIDES_PRIMEPOW; PRIME_2; EXTENSION; IN_ELIM_THM]; + ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `x + 1 = y ==> x = y - 1`) THEN + SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LE] THENL + [REWRITE_TAC[SET_RULE `{2 EXP i | i = 0} = {2 EXP 0}`] THEN + REWRITE_TAC[ARITH; NSUM_SING]; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE + `{2 EXP i | i = SUC k \/ i <= k} = + (2 EXP (SUC k)) INSERT {2 EXP i | i <= k}`] THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[SET_RULE + `{2 EXP i | i <= k} = IMAGE (\i. 2 EXP i) {i | i <= k}`] THEN + SIMP_TAC[NSUM_CLAUSES; FINITE_IMAGE; FINITE_NUMSEG_LE] THEN + REWRITE_TAC[IN_IMAGE; GSYM LE_ANTISYM; LE_EXP; ARITH] THEN + REWRITE_TAC[LE_ANTISYM; IN_ELIM_THM; UNWIND_THM1] THEN + REWRITE_TAC[ARITH_RULE `~(SUC k <= k)`] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[GSYM ADD_ASSOC] THEN + REWRITE_TAC[EXP; EXP_ADD; ARITH] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Multiplicativity of sigma, the most interesting property. *) +(* ------------------------------------------------------------------------- *) + +let SIGMA_MULTIPLICATIVE = prove + (`!a b. coprime(a,b) ==> sigma(a * b) = sigma(a) * sigma(b)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[SIGMA_0; MULT_CLAUSES] THEN + ASM_CASES_TAC `b = 0` THEN ASM_REWRITE_TAC[SIGMA_0; MULT_CLAUSES] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[sigma; MULT_EQ_0] THEN + ASM_SIMP_TAC[FINITE_DIVISORS; MULT_NSUM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `nsum (IMAGE (\(x,y). x * y) + {x,y | x divides a /\ y divides b}) (\i. i)` THEN + CONJ_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + X_GEN_TAC `n:num` THEN EQ_TAC THEN REWRITE_TAC[DIVISION_DECOMP] THEN + REWRITE_TAC[divides] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[MULT_AC]; + ALL_TAC] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (lhs o rand) NSUM_IMAGE (lhand w))) THEN + REWRITE_TAC[o_DEF; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`w:num`; `x:num`; `y:num`; `z:num`] THEN + REWRITE_TAC[PAIR_EQ] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o + check (is_var o rand o concl))) THEN + REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN + ASM_MESON_TAC[COPRIME_DIVISORS; COPRIME_SYM; COPRIME_DIVPROD; + DIVIDES_RMUL; DIVIDES_REFL; MULT_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main theorems. *) +(* ------------------------------------------------------------------------- *) + +let PERFECT_EUCLID = prove + (`!k. prime(2 EXP k - 1) ==> perfect(2 EXP (k - 1) * (2 EXP k - 1))`, + GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[ARITH; PRIME_0] THEN + DISCH_TAC THEN + SUBGOAL_THEN `coprime(2 EXP (k - 1),2 EXP k - 1)` ASSUME_TAC THENL + [MATCH_MP_TAC COPRIME_ODD_POW2 THEN ASM_SIMP_TAC[ODD_POW2_MINUS1]; + ALL_TAC] THEN + ASM_SIMP_TAC[perfect; SIGMA_MULTIPLICATIVE; SIGMA_PRIME; SIGMA_POW2] THEN + ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> k - 1 + 1 = k`; EXP_EQ_0; + MULT_EQ_0; ARITH] THEN + CONJ_TAC THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN + AP_TERM_TAC THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC);; + +let PERFECT_EULER = prove + (`!n. EVEN(n) /\ perfect(n) + ==> ?k. prime(2 EXP k - 1) /\ n = 2 EXP (k - 1) * (2 EXP k - 1)`, + GEN_TAC THEN MP_TAC(SPEC `n:num` EVEN_ODD_DECOMP) THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[perfect]; ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM NOT_EVEN] THEN + MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[EVEN_EXP; EVEN_MULT; ARITH] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[perfect] THEN + ASM_SIMP_TAC[SIGMA_MULTIPLICATIVE; SIGMA_POW2; + COPRIME_ODD_POW2; GSYM NOT_EVEN] THEN + DISCH_TAC THEN EXISTS_TAC `r + 1` THEN + REWRITE_TAC[ADD_SUB; EQ_MULT_LCANCEL] THEN REWRITE_TAC[EXP_EQ_0; ARITH] THEN + FIRST_X_ASSUM(MP_TAC o check(is_eq o concl)) THEN + REWRITE_TAC[MULT_ASSOC; GSYM(CONJUNCT2 EXP); ADD1] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] MULT_EQ_COPRIME)) THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_ODD_POW2 THEN + SIMP_TAC[ODD_POW2_MINUS1; ADD_EQ_0; ARITH_EQ]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC) THEN + ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THENL + [ASM_MESON_TAC[EVEN]; ALL_TAC] THEN + ASM_CASES_TAC `d = 1` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; SIGMA_PRIME_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN + MATCH_MP_TAC(GSYM SUB_ADD) THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; EXP_EQ_0; ARITH]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN + MP_TAC(SPECL [`2 EXP (r + 1) - 1`; `d:num`] SIGMA_MULT) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ ~b ==> (a ==> b) ==> c`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `2 EXP 1 < a ==> 1 < a - 1`) THEN + REWRITE_TAC[LT_EXP; ARITH] THEN + UNDISCH_TAC `~(r = 0)` THEN ARITH_TAC; + MAP_EVERY UNDISCH_TAC [`~(d = 0)`; `~(d = 1)`] THEN ARITH_TAC; + REWRITE_TAC[NOT_LE] THEN EXPAND_TAC "s" THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB; MULT_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE `1 * d < x * d ==> x * d < 1 + d + x * d - d`) THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + MATCH_MP_TAC(ARITH_RULE `2 EXP 0 < a ==> 1 < a`) THEN + REWRITE_TAC[LT_EXP] THEN UNDISCH_TAC `~(r = 0)` THEN ARITH_TAC]);; diff --git a/100/pick.ml b/100/pick.ml new file mode 100644 index 0000000..c1a81d1 --- /dev/null +++ b/100/pick.ml @@ -0,0 +1,3709 @@ +(* ========================================================================= *) +(* Pick's theorem. *) +(* ========================================================================= *) + +needs "Multivariate/polytope.ml";; +needs "Multivariate/measure.ml";; +needs "Multivariate/moretop.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Misc lemmas. *) +(* ------------------------------------------------------------------------- *) + +let COLLINEAR_IMP_NEGLIGIBLE = prove + (`!s:real^2->bool. collinear s ==> negligible s`, + REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + MESON_TAC[NEGLIGIBLE_AFFINE_HULL_2; NEGLIGIBLE_SUBSET]);; + +let CONVEX_HULL_3_0 = prove + (`!a b:real^N. + convex hull {vec 0,a,b} = + {x % a + y % b | &0 <= x /\ &0 <= y /\ x + y <= &1}`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{c,a,b} = {a,b,c}`] THEN + REWRITE_TAC[CONVEX_HULL_3; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_ARITH_TAC; EXISTS_TAC `&1 - x - y` THEN ASM_ARITH_TAC]);; + +let INTERIOR_CONVEX_HULL_3_0 = prove + (`!a b:real^2. + ~(collinear {vec 0,a,b}) + ==> interior(convex hull {vec 0,a,b}) = + {x % a + y % b | &0 < x /\ &0 < y /\ x + y < &1}`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SET_RULE `{c,a,b} = {a,b,c}`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3] THEN + REWRITE_TAC[TAUT `a /\ x = &1 /\ b <=> x = &1 /\ a /\ b`] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH `x + y + z = &1 <=> &1 - x - y = z`; UNWIND_THM1] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +let MEASURE_CONVEX_HULL_2_TRIVIAL = prove + (`(!a:real^2. measure(convex hull {a}) = &0) /\ + (!a b:real^2. measure(convex hull {a,b}) = &0)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURE_EQ_0 THEN + MATCH_MP_TAC COLLINEAR_IMP_NEGLIGIBLE THEN + REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_HULL_SING] THEN + REWRITE_TAC[COLLINEAR_SING; COLLINEAR_SEGMENT]);; + +let NEGLIGIBLE_SEGMENT_2 = prove + (`!a b:real^2. negligible(segment[a,b])`, + SIMP_TAC[COLLINEAR_IMP_NEGLIGIBLE; COLLINEAR_SEGMENT]);; + +(* ------------------------------------------------------------------------- *) +(* Decomposing an additive function on a triangle. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_DECOMPOSITION = prove + (`!a b c d:real^2. + d IN convex hull {a,b,c} + ==> (convex hull {a,b,c} = + convex hull {d,b,c} UNION + convex hull {d,a,c} UNION + convex hull {d,a,b})`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNION_SUBSET] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`{a:real^2,b,c}`; `d:real^2`; `x:real^2`] + IN_CONVEX_HULL_EXCHANGE) THEN + ASM_REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY; IN_UNION] THEN + REPEAT(MATCH_MP_TAC MONO_OR THEN CONJ_TAC) THEN + SPEC_TAC(`x:real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_SIMP_TAC[HULL_INC; IN_INSERT]]);; + +let TRIANGLE_ADDITIVE_DECOMPOSITION = prove + (`!f:(real^2->bool)->real a b c d. + (!s t. compact s /\ compact t + ==> f(s UNION t) = f(s) + f(t) - f(s INTER t)) /\ + ~(a = b) /\ ~(a = c) /\ ~(b = c) /\ + ~affine_dependent {a,b,c} /\ d IN convex hull {a,b,c} + ==> f(convex hull {a,b,c}) = + (f(convex hull {a,b,d}) + + f(convex hull {a,c,d}) + + f(convex hull {b,c,d})) - + (f(convex hull {a,d}) + + f(convex hull {b,d}) + + f(convex hull {c,d})) + + f(convex hull {d})`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP TRIANGLE_DECOMPOSITION) THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [COMPACT_UNION; COMPACT_INTER; COMPACT_CONVEX_HULL; + FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY; + UNION_OVER_INTER] THEN + MP_TAC(ISPECL [`{a:real^2,b,c}`; `d:real^2`] + CONVEX_HULL_EXCHANGE_INTER) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT; NOT_IN_EMPTY; + SET_RULE `s SUBSET u /\ t SUBSET u ==> (s INTER t) SUBSET u`] THEN + ASM_REWRITE_TAC[INSERT_INTER; IN_INSERT; NOT_IN_EMPTY; INTER_EMPTY] THEN + DISCH_TAC THEN REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Vectors all of whose coordinates are integers. *) +(* ------------------------------------------------------------------------- *) + +let integral_vector = define + `integral_vector(x:real^N) <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i)`;; + +let INTEGRAL_VECTOR_VEC = prove + (`!n. integral_vector(vec n)`, + REWRITE_TAC[integral_vector; VEC_COMPONENT; INTEGER_CLOSED]);; + +let INTEGRAL_VECTOR_STDBASIS = prove + (`!i. integral_vector(basis i:real^N)`, + REWRITE_TAC[integral_vector] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN + COND_CASES_TAC THEN REWRITE_TAC[INTEGER_CLOSED]);; + +let INTEGRAL_VECTOR_ADD = prove + (`!x y:real^N. + integral_vector x /\ integral_vector y ==> integral_vector(x + y)`, + SIMP_TAC[integral_vector; VECTOR_ADD_COMPONENT; INTEGER_CLOSED]);; + +let INTEGRAL_VECTOR_SUB = prove + (`!x y:real^N. + integral_vector x /\ integral_vector y ==> integral_vector(x - y)`, + SIMP_TAC[integral_vector; VECTOR_SUB_COMPONENT; INTEGER_CLOSED]);; + +let INTEGRAL_VECTOR_ADD_LCANCEL = prove + (`!x y:real^N. + integral_vector x ==> (integral_vector(x + y) <=> integral_vector y)`, + MESON_TAC[INTEGRAL_VECTOR_ADD; INTEGRAL_VECTOR_SUB; + VECTOR_ARITH `(x + y) - x:real^N = y`]);; + +let FINITE_BOUNDED_INTEGER_POINTS = prove + (`!s:real^N->bool. bounded s ==> FINITE {x | x IN s /\ integral_vector x}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; integral_vector] THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> integer(x$i) /\ + (a:real^N)$i <= x$i /\ x$i <= (b:real^N)$i}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_INTSEG]; + ASM SET_TAC[]]);; + +let FINITE_TRIANGLE_INTEGER_POINTS = prove + (`!a b c:real^N. FINITE {x | x IN convex hull {a,b,c} /\ integral_vector x}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_BOUNDED_INTEGER_POINTS THEN + SIMP_TAC[FINITE_IMP_BOUNDED_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of a basis for the integer lattice. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INTEGRAL_VECTOR = prove + (`!f:real^N->real^N. + linear f + ==> ((!x. integral_vector x ==> integral_vector(f x)) <=> + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> integer(matrix f$i$j)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN + ABBREV_TAC `M = matrix(f:real^N->real^N)` THEN + SIMP_TAC[integral_vector; matrix_vector_mul; LAMBDA_BETA] THEN + EQ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `basis j:real^N`) THEN + REWRITE_TAC[GSYM integral_vector; INTEGRAL_VECTOR_STDBASIS] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[BASIS_COMPONENT; COND_RAND; COND_RATOR] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC INTEGER_SUM THEN + ASM_SIMP_TAC[INTEGER_CLOSED; IN_NUMSEG]]);; + +let INTEGRAL_BASIS_UNIMODULAR = prove + (`!f:real^N->real^N. + linear f /\ IMAGE f integral_vector = integral_vector + ==> abs(det(matrix f)) = &1`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE] THEN REWRITE_TAC[IN] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> integer(matrix(f:real^N->real^N)$i$j)` + ASSUME_TAC THENL [ASM_SIMP_TAC[GSYM LINEAR_INTEGRAL_VECTOR]; ALL_TAC] THEN + SUBGOAL_THEN + `?g:real^N->real^N. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]; ALL_TAC] THEN + SUBGOAL_THEN `!y. y:real^N IN span(IMAGE f (:real^N))` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; SPAN_UNIV] THEN SET_TAC[]] THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN + ASM_MESON_TAC[INTEGRAL_VECTOR_STDBASIS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> integer(matrix(g:real^N->real^N)$i$j)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM LINEAR_INTEGRAL_VECTOR] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `det(matrix(f:real^N->real^N)) * det(matrix(g:real^N->real^N)) = + det(matrix(I:real^N->real^N))` + MP_TAC THENL + [ASM_SIMP_TAC[GSYM DET_MUL; GSYM MATRIX_COMPOSE] THEN + REPEAT AP_TERM_TAC THEN ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o AP_TERM `abs:real->real`) THEN + REWRITE_TAC[MATRIX_I; DET_I; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[INTEGER_DET; INTEGER_ABS_MUL_EQ_1]);; + +(* ------------------------------------------------------------------------- *) +(* Pick's theorem for an elementary triangle. *) +(* ------------------------------------------------------------------------- *) + +let PICK_ELEMENTARY_TRIANGLE_0 = prove + (`!a b:real^2. + {x | x IN convex hull {vec 0,a,b} /\ integral_vector x} = {vec 0,a,b} + ==> measure(convex hull {vec 0,a,b}) = + if collinear {vec 0,a,b} then &0 else &1 / &2`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[MEASURE_EQ_0; COLLINEAR_IMP_NEGLIGIBLE; + COLLINEAR_CONVEX_HULL_COLLINEAR] THEN + POP_ASSUM MP_TAC THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC]) + [`a:real^2 = vec 0`; `b:real^2 = vec 0`; `a:real^2 = b`] THEN + DISCH_TAC THEN SUBGOAL_THEN `independent {a:real^2,b}` ASSUME_TAC THENL + [UNDISCH_TAC `~collinear{vec 0:real^2, a, b}` THEN + REWRITE_TAC[independent; CONTRAPOS_THM] THEN + REWRITE_TAC[dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{c,a,b} = {c,b,a}`]; ALL_TAC] THEN + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `a IN s ==> s SUBSET t ==> a IN t`)) THEN + MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `span{a,b} = (:real^2)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^2)`; `{a:real^2,b}`] CARD_EQ_DIM) THEN + ASM_REWRITE_TAC[SUBSET_UNIV; SUBSET; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; DIM_UNIV; DIMINDEX_2; ARITH]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_INSERT; + FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT] THEN STRIP_TAC THEN + MP_TAC(ISPEC `\x:real^2. transp(vector[a;b]:real^2^2) ** x` + INTEGRAL_BASIS_UNIMODULAR) THEN + REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR] THEN + REWRITE_TAC[DET_2; MEASURE_TRIANGLE; VECTOR_2; DET_TRANSP; VEC_COMPONENT] THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL + [REWRITE_TAC[IN] THEN + SIMP_TAC[LINEAR_INTEGRAL_VECTOR; MATRIX_VECTOR_MUL_LINEAR; LAMBDA_BETA; + MATRIX_OF_MATRIX_VECTOR_MUL; transp; DIMINDEX_2; ARITH] THEN + MAP_EVERY UNDISCH_TAC + [`integral_vector(a:real^2)`; `integral_vector(b:real^2)`] THEN + REWRITE_TAC[integral_vector; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; FORALL_2; DIMINDEX_2; VECTOR_2] THEN + REWRITE_TAC[CONJ_ACI]; + ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN REWRITE_TAC[IN] THEN + X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_VECTOR_2] THEN + REWRITE_TAC[MATRIX_VECTOR_COLUMN; TRANSP_TRANSP] THEN + REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_2; integral_vector; FORALL_2] THEN + SUBGOAL_THEN `(x:real^2) IN span{a,b}` MP_TAC THENL + [ASM_REWRITE_TAC[IN_UNIV]; ALL_TAC] THEN + REWRITE_TAC[SPAN_2; IN_UNIV; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real` THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `frac u % a + frac v % b:real^2`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(&1 - frac u) % a + (&1 - frac v) % b:real^2`) THEN + MATCH_MP_TAC(TAUT + `b' /\ (b' ==> b) /\ (a \/ a') /\ (c \/ c' ==> x) + ==> (a /\ b ==> c) ==> (a' /\ b' ==> c') ==> x`) THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `integral_vector(floor u % a + floor v % b:real^2)` + MP_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`integral_vector(a:real^2)`; `integral_vector(b:real^2)`] THEN + SIMP_TAC[integral_vector; DIMINDEX_2; FORALL_2; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[FLOOR; INTEGER_CLOSED]; + UNDISCH_TAC `integral_vector(x:real^2)` THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_VECTOR_SUB) THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `(x % a + y % b) - (u % a + v % b) = (x - u) % a + (y - v) % b`] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ARITH `u - x:real = y <=> u = x + y`] THEN + REWRITE_TAC[GSYM FLOOR_FRAC]]; + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % a + (&1 - v) % b = (a + b) - (u % a + v % b)`] THEN + ASM_SIMP_TAC[INTEGRAL_VECTOR_ADD; INTEGRAL_VECTOR_SUB]; + REWRITE_TAC[CONVEX_HULL_3_0; IN_ELIM_THM] THEN + SUBGOAL_THEN + `&0 <= frac u /\ &0 <= frac v /\ frac u + frac v <= &1 \/ + &0 <= &1 - frac u /\ &0 <= &1 - frac v /\ + (&1 - frac u) + (&1 - frac v) <= &1` + MP_TAC THENL + [MP_TAC(SPEC `u:real` FLOOR_FRAC) THEN + MP_TAC(SPEC `v:real` FLOOR_FRAC) THEN REAL_ARITH_TAC; + MESON_TAC[]]; + REWRITE_TAC + [VECTOR_ARITH `x % a + y % b = a <=> (x - &1) % a + y % b = vec 0`; + VECTOR_ARITH `x % a + y % b = b <=> x % a + (y - &1) % b = vec 0`] THEN + ASM_SIMP_TAC[INDEPENDENT_2; GSYM REAL_FRAC_EQ_0] THEN + MP_TAC(SPEC `u:real` FLOOR_FRAC) THEN + MP_TAC(SPEC `v:real` FLOOR_FRAC) THEN REAL_ARITH_TAC]);; + +let PICK_ELEMENTARY_TRIANGLE = prove + (`!a b c:real^2. + {x | x IN convex hull {a,b,c} /\ integral_vector x} = {a,b,c} + ==> measure(convex hull {a,b,c}) = + if collinear {a,b,c} then &0 else &1 / &2`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s = t ==> (!x. x IN s <=> x IN t) /\ s = t`)) THEN + REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(MP_TAC o SPEC `a:real^2`) THEN + REWRITE_TAC[IN_INSERT; IN_ELIM_THM] THEN + GEOM_ORIGIN_TAC `a:real^2`THEN + SIMP_TAC[INTEGRAL_VECTOR_ADD_LCANCEL; VECTOR_ADD_RID] THEN + REWRITE_TAC[PICK_ELEMENTARY_TRIANGLE_0]);; + +(* ------------------------------------------------------------------------- *) +(* Our form of Pick's theorem holds degenerately for a flat triangle. *) +(* ------------------------------------------------------------------------- *) + +let PICK_TRIANGLE_FLAT = prove + (`!a b c:real^2. + integral_vector a /\ integral_vector b /\ integral_vector c /\ + c IN segment[a,b] + ==> measure(convex hull {a,b,c}) = + &(CARD {x | x IN convex hull {a,b,c} /\ integral_vector x}) - + (&(CARD {x | x IN convex hull {b,c} /\ integral_vector x}) + + &(CARD {x | x IN convex hull {a,c} /\ integral_vector x}) + + &(CARD {x | x IN convex hull {a,b} /\ integral_vector x})) / &2 + + &1 / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN + SUBGOAL_THEN `convex hull {a:real^2,b,c} = segment[a,b]` SUBST1_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULLS_EQ THEN + ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN + SIMP_TAC[ENDS_IN_SEGMENT; HULL_INC; IN_INSERT]; + ALL_TAC] THEN + SUBGOAL_THEN `measure(segment[a:real^2,b]) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC MEASURE_EQ_0 THEN + MATCH_MP_TAC COLLINEAR_IMP_NEGLIGIBLE THEN + REWRITE_TAC[COLLINEAR_SEGMENT]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `&0 = c - (a + b + c) / &2 + &1 / &2 <=> a + b = c + &1`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + SUBGOAL_THEN + `segment[a:real^2,b] = segment[b,c] UNION segment[a,c]` + SUBST1_TAC THENL [ASM_MESON_TAC[SEGMENT_SYM; UNION_SEGMENT]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE + `{x | x IN (s UNION t) /\ P x} = + {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN + SIMP_TAC[CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT] THEN + MATCH_MP_TAC(ARITH_RULE + `z:num <= x /\ z = 1 ==> x + y = (x + y) - z + 1`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN + SIMP_TAC[FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT] THEN SET_TAC[]; + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} INTER {x | x IN t /\ P x} = + {x | x IN (s INTER t) /\ P x}`] THEN + SUBGOAL_THEN + `segment[b:real^2,c] INTER segment[a,c] = {c}` + SUBST1_TAC THENL [ASM_MESON_TAC[INTER_SEGMENT; SEGMENT_SYM]; ALL_TAC] THEN + SUBGOAL_THEN `{x:real^2 | x IN {c} /\ integral_vector x} = {c}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; ARITH; NOT_IN_EMPTY]]);; + +(* ------------------------------------------------------------------------- *) +(* Pick's theorem for a triangle. *) +(* ------------------------------------------------------------------------- *) + +let PICK_TRIANGLE_ALT = prove + (`!a b c:real^2. + integral_vector a /\ integral_vector b /\ integral_vector c + ==> measure(convex hull {a,b,c}) = + &(CARD {x | x IN convex hull {a,b,c} /\ integral_vector x}) - + (&(CARD {x | x IN convex hull {b,c} /\ integral_vector x}) + + &(CARD {x | x IN convex hull {a,c} /\ integral_vector x}) + + &(CARD {x | x IN convex hull {a,b} /\ integral_vector x})) / &2 + + &1 / &2`, + let tac a bc = + MATCH_MP_TAC CARD_PSUBSET THEN + REWRITE_TAC[FINITE_TRIANGLE_INTEGER_POINTS] THEN + REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> {x | x IN s /\ P x} SUBSET {x | x IN t /\ P x}`) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + ASM_SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT; HULL_INC]; + DISCH_TAC] THEN + SUBGOAL_THEN(subst[bc,`bc:real^2->bool`] + `convex hull {a:real^2,b,c} = convex hull bc`) + ASSUME_TAC THENL + [MATCH_MP_TAC CONVEX_HULLS_EQ THEN + ASM_SIMP_TAC[HULL_INC; IN_INSERT; INSERT_SUBSET; EMPTY_SUBSET] THEN + SUBGOAL_THEN(subst [a,`x:real^2`] `x IN convex hull {a:real^2,b,c}`) + MP_TAC THENL + [SIMP_TAC[HULL_INC; IN_INSERT]; ASM SET_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`{a:real^2,b,c}`; a] + EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT) THEN + ASM_REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] in + REPEAT GEN_TAC THEN + WF_INDUCT_TAC `CARD {x:real^2 | x IN convex hull {a,b,c} /\ + integral_vector x}` THEN + ASM_CASES_TAC `collinear{a:real^2,b,c}` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_BETWEEN_CASES]) THEN + REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`b:real^2`; `c:real^2`; `a:real^2`] PICK_TRIANGLE_FLAT); + MP_TAC(ISPECL [`a:real^2`; `c:real^2`; `b:real^2`] PICK_TRIANGLE_FLAT); + MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`] + PICK_TRIANGLE_FLAT)] THEN + (ANTS_TAC THENL [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER P`] THEN + REWRITE_TAC[INSERT_AC; REAL_ADD_AC]); + ALL_TAC] THEN + UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN + MAP_EVERY + (fun t -> ASM_CASES_TAC t THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC]) + [`a:real^2 = b`; `a:real^2 = c`; `b:real^2 = c`] THEN + DISCH_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC + `{x:real^2 | x IN convex hull {a, b, c} /\ integral_vector x} = + {a,b,c}` + THENL + [ASM_SIMP_TAC[PICK_ELEMENTARY_TRIANGLE] THEN + SUBGOAL_THEN + `{x | x IN convex hull {b,c} /\ integral_vector x} = {b,c} /\ + {x | x IN convex hull {a,c} /\ integral_vector x} = {a,c} /\ + {x | x IN convex hull {a,b} /\ integral_vector x} = {a:real^2,b}` + (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL + [REPEAT CONJ_TAC THEN + (FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `{x | x IN cs /\ P x} = s + ==> t SUBSET s /\ t SUBSET ct /\ ct SUBSET cs /\ + (s DIFF t) INTER ct = {} + ==> {x | x IN ct /\ P x} = t`)) THEN + REPEAT CONJ_TAC THENL + [SET_TAC[]; + MATCH_ACCEPT_TAC HULL_SUBSET; + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + ASM_REWRITE_TAC[INSERT_DIFF; IN_INSERT; NOT_IN_EMPTY; EMPTY_DIFF] THEN + MATCH_MP_TAC(SET_RULE `~(x IN s) ==> {x} INTER s = {}`) THEN + REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; GSYM BETWEEN_IN_SEGMENT] THEN + DISCH_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN + UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[INSERT_AC]]); + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN + `?d:real^2. d IN convex hull {a, b, c} /\ integral_vector d /\ + ~(d = a) /\ ~(d = b) /\ ~(d = c)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s = t) ==> t SUBSET s ==> ?d. d IN s /\ ~(d IN t)`)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_INSERT; IN_ELIM_THM] THEN + ASM_SIMP_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN + DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[HULL_INC; IN_INSERT]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [COLLINEAR_3_EQ_AFFINE_DEPENDENT]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`measure:(real^2->bool)->real`; + `a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`] + TRIANGLE_ADDITIVE_DECOMPOSITION) THEN + SIMP_TAC[MEASURE_UNION; MEASURABLE_COMPACT] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[MEASURE_CONVEX_HULL_2_TRIVIAL; REAL_ADD_RID; REAL_SUB_RZERO] THEN + MP_TAC(ISPECL + [`\s. &(CARD {x:real^2 | x IN s /\ integral_vector x})`; + `a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`] + TRIANGLE_ADDITIVE_DECOMPOSITION) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `{x | x IN (s UNION t) /\ P x} = + {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`; + SET_RULE `{x | x IN (s INTER t) /\ P x} = + {x | x IN s /\ P x} INTER {x | x IN t /\ P x}`] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `x:real = y + z - w <=> x + w = y + z`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(ARITH_RULE + `x:num = (y + z) - w /\ w <= z ==> x + w = y + z`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_UNION_GEN; + MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[INTER_SUBSET]] THEN + ASM_SIMP_TAC[FINITE_BOUNDED_INTEGER_POINTS; COMPACT_IMP_BOUNDED]; + DISCH_THEN SUBST1_TAC] THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `d:real^2`] th) THEN + MP_TAC(ISPECL [`a:real^2`; `c:real^2`; `d:real^2`] th) THEN + MP_TAC(ISPECL [`b:real^2`; `c:real^2`; `d:real^2`] th)) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [tac `a:real^2` `{b:real^2,c,d}`; DISCH_THEN SUBST1_TAC] THEN + ANTS_TAC THENL [tac `b:real^2` `{a:real^2,c,d}`; DISCH_THEN SUBST1_TAC] THEN + ANTS_TAC THENL [tac `c:real^2` `{a:real^2,b,d}`; DISCH_THEN SUBST1_TAC] THEN + SUBGOAL_THEN `{x:real^2 | x IN convex hull {d} /\ integral_vector x} = {d}` + SUBST1_TAC THENL + [REWRITE_TAC[CONVEX_HULL_SING] THEN ASM SET_TAC[]; ALL_TAC] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER P`] THEN + REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);; + +let PICK_TRIANGLE = prove + (`!a b c:real^2. + integral_vector a /\ integral_vector b /\ integral_vector c + ==> measure(convex hull {a,b,c}) = + if collinear {a,b,c} then &0 + else &(CARD {x | x IN interior(convex hull {a,b,c}) /\ + integral_vector x}) + + &(CARD {x | x IN frontier(convex hull {a,b,c}) /\ + integral_vector x}) / &2 - &1`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[MEASURE_EQ_0; COLLINEAR_IMP_NEGLIGIBLE; + COLLINEAR_CONVEX_HULL_COLLINEAR] THEN + ASM_SIMP_TAC[PICK_TRIANGLE_ALT] THEN + REWRITE_TAC[INTERIOR_OF_TRIANGLE; FRONTIER_OF_TRIANGLE] THEN + REWRITE_TAC[SET_RULE + `{x | x IN (s DIFF t) /\ P x} = + {x | x IN s /\ P x} DIFF {x | x IN t /\ P x}`] THEN + MATCH_MP_TAC(REAL_ARITH + `i + c = s /\ ccc = c + &3 + ==> s - ccc / &2 + &1 / &2 = i + c / &2 - &1`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(ARITH_RULE `y:num <= x /\ x - y = z ==> z + y = x`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET; MATCH_MP_TAC(GSYM CARD_DIFF)] THEN + ASM_SIMP_TAC[FINITE_BOUNDED_INTEGER_POINTS; + FINITE_IMP_BOUNDED_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> {x | x IN s /\ P x} SUBSET {x | x IN t /\ P x}`) THEN + REWRITE_TAC[UNION_SUBSET; SEGMENT_CONVEX_HULL] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + REWRITE_TAC[SET_RULE + `{x | x IN (s UNION t) /\ P x} = + {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN + SIMP_TAC[CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; + FINITE_INTER; FINITE_UNION; BOUNDED_SEGMENT; UNION_OVER_INTER] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} INTER {x | x IN t /\ P x} = + {x | x IN (s INTER t) /\ P x}`] THEN + SUBGOAL_THEN + `segment[b:real^2,c] INTER segment [c,a] = {c} /\ + segment[a,b] INTER segment [b,c] = {b} /\ + segment[a,b] INTER segment [c,a] = {a}` + (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL + [ASM_MESON_TAC[INTER_SEGMENT; SEGMENT_SYM; INSERT_AC]; ALL_TAC] THEN + ASM_SIMP_TAC[SET_RULE `P a ==> {x | x IN {a} /\ P x} = {a}`] THEN + ASM_CASES_TAC `b:real^2 = a` THENL + [ASM_MESON_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN + ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {b} INTER {a} = {}`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES; SUB_0] THEN + MATCH_MP_TAC(ARITH_RULE + `c:num <= ca /\ a <= ab /\ b <= bc /\ + bc' + ac' + ab' + a + b + c = ab + bc + ca + 3 + ==> bc' + ac' + ab' = (ab + (bc + ca) - c) - (b + a) + 3`) THEN + ASM_SIMP_TAC[CARD_SUBSET; SING_SUBSET; IN_ELIM_THM; ENDS_IN_SEGMENT; + FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT] THEN + SIMP_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES; FINITE_INSERT; + FINITE_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER P`] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL; INSERT_AC] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Parity lemma for segment crossing a polygon. *) +(* ------------------------------------------------------------------------- *) + +let PARITY_LEMMA = prove + (`!a b c d p x:real^2. + simple_path(p ++ linepath(a,b)) /\ + pathstart p = b /\ pathfinish p = a /\ + segment(a,b) INTER segment(c,d) = {x} /\ + segment[c,d] INTER path_image p = {} + ==> (c IN inside(path_image(p ++ linepath(a,b))) <=> + d IN outside(path_image(p ++ linepath(a,b))))`, + let lemma = prove + (`!a b x y:real^N. + collinear{y,a,b} /\ between x (a,b) /\ + dist(y,x) < dist(x,b) /\ dist(y,x) < dist(x,a) + ==> y IN segment(a,b)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_DIST_IN_OPEN_SEGMENT THEN + ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[between; DIST_SYM] THEN + NORM_ARITH_TAC) + and symlemma = prove + (`(!n. P(--n) <=> P (n)) /\ (!n. &0 < n dot x ==> P n) + ==> !n:real^N. ~(n dot x = &0) ==> P n`, + STRIP_TAC THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `~(x = &0) <=> &0 < x \/ &0 < --x`] THEN + REWRITE_TAC[GSYM DOT_LNEG] THEN ASM_MESON_TAC[]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:real^1->real^2`; `linepath(a:real^2,b)`] + SIMPLE_PATH_JOIN_LOOP_EQ) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(a:real^2) INSERT b INSERT c INSERT d INSERT path_image p`; + `x:real^2`] + DISTANCE_ATTAINS_INF) THEN + REWRITE_TAC[FORALL_IN_INSERT] THEN + ONCE_REWRITE_TAC[SET_RULE `a INSERT b INSERT c INSERT d INSERT s = + {a,b,c,d} UNION s`] THEN + ASM_SIMP_TAC[CLOSED_UNION; FINITE_IMP_CLOSED; CLOSED_PATH_IMAGE; + FINITE_INSERT; FINITE_EMPTY] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `cp:real^2` MP_TAC) THEN + DISJ_CASES_TAC(NORM_ARITH `cp = x \/ &0 < dist(x:real^2,cp)`) THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC(TAUT `~a ==> a /\ b ==> c`) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE `a = {x} ==> x IN a`)) THEN + REWRITE_TAC[open_segment; IN_DIFF; IN_UNION; IN_INSERT; NOT_IN_EMPTY; + IN_INTER; DE_MORGAN_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `p INTER s SUBSET u ==> x IN (s DIFF u) ==> ~(x IN p)`)) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; PATH_IMAGE_LINEPATH]; + ALL_TAC] THEN + ABBREV_TAC `e = dist(x:real^2,cp)` THEN FIRST_X_ASSUM(K ALL_TAC o SYM) THEN + DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN + RULE_ASSUM_TAC(REWRITE_RULE[ARC_LINEPATH_EQ]) THEN + MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`; `d:real^2`] + FINITE_INTER_COLLINEAR_OPEN_SEGMENTS) THEN + MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `d:real^2`; `c:real^2`] + FINITE_INTER_COLLINEAR_OPEN_SEGMENTS) THEN + SUBST1_TAC(MESON[SEGMENT_SYM] `segment(d:real^2,c) = segment(c,d)`) THEN + ASM_REWRITE_TAC[FINITE_SING; NOT_INSERT_EMPTY] THEN REPEAT DISCH_TAC THEN + SUBGOAL_THEN `~(a IN segment[c:real^2,d]) /\ ~(b IN segment[c,d])` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; + IN_INTER; NOT_IN_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN `~(c:real^2 = a) /\ ~(c = b) /\ ~(d = a) /\ ~(d = b)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN + SUBGOAL_THEN `x IN segment(a:real^2,b) /\ x IN segment(c,d)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_OPEN_SEGMENT_ALT] THEN STRIP_TAC THEN + SUBGOAL_THEN + `{c,d} INTER path_image(p ++ linepath(a:real^2,b)) = {}` + ASSUME_TAC THENL + [ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN + REWRITE_TAC[SET_RULE + `{c,d} INTER (s UNION t) = {} <=> + (~(c IN s) /\ ~(d IN s)) /\ ~(c IN t) /\ ~(d IN t)`] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ENDS_IN_SEGMENT; IN_INTER; NOT_IN_EMPTY]; + REWRITE_TAC[PATH_IMAGE_LINEPATH; GSYM BETWEEN_IN_SEGMENT] THEN + CONJ_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPEC `b - x:real^2` ORTHOGONAL_TO_VECTOR_EXISTS) THEN + REWRITE_TAC[DIMINDEX_2; LE_REFL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:real^2` THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:real^2) IN segment(a,b) /\ x IN segment(c,d)` MP_TAC THENL + [ASM SET_TAC[]; + SIMP_TAC[IN_OPEN_SEGMENT_ALT; GSYM BETWEEN_IN_SEGMENT] THEN STRIP_TAC] THEN + SUBGOAL_THEN `~collinear{a:real^2, b, c, d}` ASSUME_TAC THENL + [UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(n dot (d - x:real^2) = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM orthogonal] THEN DISCH_TAC THEN + MP_TAC(SPECL [`n:real^2`; `d - x:real^2`; `b - x:real^2`] + ORTHOGONAL_TO_ORTHOGONAL_2D) THEN + ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN + REWRITE_TAC[GSYM COLLINEAR_3] THEN DISCH_TAC THEN + UNDISCH_TAC `~collinear{a:real^2, b, c, d}` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {b,d,a,c}`] THEN + ASM_SIMP_TAC[COLLINEAR_4_3] THEN CONJ_TAC THENL + [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{b:real^2,x,a,d}` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[COLLINEAR_4_3]; SET_TAC[]] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,b,a}`] THEN + ASM_SIMP_TAC[BETWEEN_IMP_COLLINEAR]; + MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `{d:real^2,x,b,c}` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[COLLINEAR_4_3]; SET_TAC[]] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,b,a}`] THEN + ASM_SIMP_TAC[BETWEEN_IMP_COLLINEAR]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + MP_TAC th) THEN + SPEC_TAC(`n:real^2`,`n:real^2`) THEN + MATCH_MP_TAC symlemma THEN CONJ_TAC THENL + [REWRITE_TAC[ORTHOGONAL_RNEG; VECTOR_NEG_EQ_0]; ALL_TAC] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `n dot (c - x:real^2) < &0` ASSUME_TAC THENL + [UNDISCH_TAC `&0 < n dot (d - x:real^2)` THEN + SUBGOAL_THEN `(x:real^2) IN segment(c,d)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH + `d - ((&1 - u) % c + u % d):real^N = (&1 - u) % (d - c) /\ + c - ((&1 - u) % c + u % d) = --u % (d - c)`] THEN + REWRITE_TAC[DOT_RMUL; REAL_MUL_LNEG; REAL_ARITH `--x < &0 <=> &0 < x`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_SUB_LT]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y. y IN ball(x:real^2,e) + ==> y IN segment(a,b) \/ + &0 < n dot (y - x) \/ + n dot (y - x) < &0` + ASSUME_TAC THENL + [REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~c /\ ~b ==> a) ==> a \/ b \/ c`) THEN + REWRITE_TAC[REAL_ARITH `~(x < &0) /\ ~(&0 < x) <=> x = &0`] THEN + REWRITE_TAC[GSYM orthogonal] THEN DISCH_TAC THEN + MP_TAC(SPECL [`n:real^2`; `y - x:real^2`; `b - x:real^2`] + ORTHOGONAL_TO_ORTHOGONAL_2D) THEN + ANTS_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN + REWRITE_TAC[GSYM COLLINEAR_3] THEN DISCH_TAC THEN + MATCH_MP_TAC lemma THEN EXISTS_TAC `x:real^2` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LTE_TRANS; DIST_SYM]] THEN + ONCE_REWRITE_TAC[SET_RULE `{y,a,b} = {a,b,y}`] THEN + MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `x:real^2` THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `collinear{y:real^2, x, b}` THEN + MP_TAC(MATCH_MP BETWEEN_IMP_COLLINEAR (ASSUME + `between (x:real^2) (a,b)`)) THEN + SIMP_TAC[INSERT_AC]; + ALL_TAC] THEN + MP_TAC(SPEC `p ++ linepath(a:real^2,b)` JORDAN_INSIDE_OUTSIDE) THEN + ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `~(connected_component((:real^2) DIFF path_image(p ++ linepath (a,b))) c d)` + MP_TAC THENL + [DISCH_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `path_image(p ++ linepath(a:real^2,b))` o + MATCH_MP (SET_RULE + `~(x IN s <=> y IN t) + ==> !p. s UNION t = (:real^2) DIFF p /\ {x,y} INTER p = {} + ==> x IN s /\ y IN s \/ x IN t /\ y IN t`)) THEN + ASM_REWRITE_TAC[connected_component] THEN + ASM_REWRITE_TAC[SET_RULE `t SUBSET UNIV DIFF s <=> t INTER s = {}`] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; OUTSIDE_NO_OVERLAP]] THEN + MP_TAC(SPEC `p ++ linepath(a:real^2,b)` JORDAN_DISCONNECTED) THEN + ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + SUBGOAL_THEN + `!u v. u IN inside(path_image(p ++ linepath(a,b))) /\ + v IN outside(path_image(p ++ linepath(a,b))) + ==> connected_component + ((:real^2) DIFF path_image (p ++ linepath (a,b))) u v` + ASSUME_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [SYM(ASSUME `inside (path_image (p ++ linepath (a,b))) UNION + outside (path_image (p ++ linepath (a,b))) = + (:real^2) DIFF path_image (p ++ linepath (a,b))`)] THEN + REWRITE_TAC[IN_UNION; CONNECTED_IFF_CONNECTED_COMPONENT] THEN + STRIP_TAC THENL + [REWRITE_TAC[connected_component] THEN + EXISTS_TAC `inside(path_image(p ++ linepath(a:real^2,b)))`; + ASM_MESON_TAC[]; + ASM_MESON_TAC[CONNECTED_COMPONENT_SYM]; + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `outside(path_image(p ++ linepath(a:real^2,b)))`] THEN + ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + REWRITE_TAC[OUTSIDE_NO_OVERLAP; INSIDE_NO_OVERLAP]] THEN + SUBGOAL_THEN `(x:real^2) IN path_image(p ++ linepath(a,b))` ASSUME_TAC THENL + [ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN + REWRITE_TAC[IN_UNION; PATH_IMAGE_LINEPATH] THEN DISJ2_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[open_segment]) THEN ASM SET_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN STRIP_TAC THEN + UNDISCH_TAC + `frontier(inside(path_image(p ++ linepath(a:real^2,b)))) = + path_image(p ++ linepath(a,b))` THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^2`) THEN ASM_REWRITE_TAC[frontier] THEN + REWRITE_TAC[IN_DIFF; CLOSURE_APPROACHABLE] THEN + DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN + CONJ_TAC THENL + [REWRITE_TAC[connected_component] THEN + EXISTS_TAC `inside(path_image(p ++ linepath(a:real^2,b)))` THEN + ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + REWRITE_TAC[INSIDE_NO_OVERLAP]; + ALL_TAC] THEN + UNDISCH_TAC + `frontier(outside(path_image(p ++ linepath(a:real^2,b)))) = + path_image(p ++ linepath(a,b))` THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^2`) THEN ASM_REWRITE_TAC[frontier] THEN + REWRITE_TAC[IN_DIFF; CLOSURE_APPROACHABLE] THEN + DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:real^2` THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `z:real^2` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `outside(path_image(p ++ linepath(a:real^2,b)))` THEN + ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + REWRITE_TAC[OUTSIDE_NO_OVERLAP]] THEN + SUBGOAL_THEN + `!y. dist(y,x) < e /\ ~(y IN path_image(p ++ linepath (a,b))) + ==> connected_component + ((:real^2) DIFF path_image(p ++ linepath(a,b))) c y` + ASSUME_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `c:real^2` THEN + CONJ_TAC THENL [MATCH_MP_TAC CONNECTED_COMPONENT_SYM; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; OUTSIDE_NO_OVERLAP; IN_INTER; + NOT_IN_EMPTY]] THEN + X_GEN_TAC `y:real^2` THEN STRIP_TAC THEN + SUBGOAL_THEN `segment[c,d] INTER path_image(p ++ linepath(a,b)) = {x:real^2}` + ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `{c,d} INTER p = {} /\ (segment[c,d] DIFF {c,d}) INTER p = {x} + ==> segment[c,d] INTER p = {x}`) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATH_LINEPATH] THEN + MATCH_MP_TAC(SET_RULE + `cd INTER p = {} /\ l INTER (cd DIFF {c,d}) = {x} + ==> (cd DIFF {c,d}) INTER (p UNION l) = {x}`) THEN + ASM_REWRITE_TAC[GSYM open_segment; PATH_IMAGE_LINEPATH] THEN + MATCH_MP_TAC(SET_RULE + `~(a IN segment[c,d]) /\ ~(b IN segment[c,d]) /\ + segment(a,b) INTER segment(c,d) = {x} /\ + segment(a,b) = segment[a,b] DIFF {a,b} /\ + segment(c,d) = segment[c,d] DIFF {c,d} + ==> segment[a,b] INTER segment(c,d) = {x}`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[open_segment]; + ALL_TAC] THEN + UNDISCH_THEN + `!y. y IN ball(x:real^2,e) + ==> y IN segment(a,b) \/ &0 < n dot (y - x) \/ n dot (y - x) < &0` + (MP_TAC o SPEC `y:real^2`) THEN + REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THENL + [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + UNDISCH_TAC `~(y IN path_image(p ++ linepath(a:real^2,b)))` THEN + ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN + SIMP_TAC[CONTRAPOS_THM; open_segment; IN_DIFF; IN_UNION; + PATH_IMAGE_LINEPATH]; + DISCH_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `d:real^2` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `x + min (&1 / &2) (e / &2 / norm(d - x)) % (d - x):real^2` THEN + REWRITE_TAC[connected_component] THEN CONJ_TAC THENL + [EXISTS_TAC `segment[x:real^2,d] DELETE x` THEN + SIMP_TAC[CONVEX_SEMIOPEN_SEGMENT; CONVEX_CONNECTED] THEN + ASM_REWRITE_TAC[IN_DELETE; ENDS_IN_SEGMENT] THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `cd INTER p = {x} + ==> xd SUBSET cd + ==> (xd DELETE x) SUBSET (UNIV DIFF p)`)) THEN + REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN + UNDISCH_TAC `segment (a,b) INTER segment (c,d) = {x:real^2}` THEN + REWRITE_TAC[open_segment] THEN SET_TAC[]; + REWRITE_TAC[IN_SEGMENT; VECTOR_ARITH + `x + a % (y - x):real^N = (&1 - a) % x + a % y`] THEN + EXISTS_TAC `min (&1 / &2) (e / &2 / norm(d - x:real^2))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_LE_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE]; + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; + VECTOR_ARITH `x + a:real^N = x <=> a = vec 0`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min (&1 / &2) x = &0)`) THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]; + EXISTS_TAC `ball(x,e) INTER {w:real^2 | &0 < n dot (w - x)}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_CONNECTED THEN MATCH_MP_TAC CONVEX_INTER THEN + REWRITE_TAC[CONVEX_BALL; DOT_RSUB; REAL_SUB_LT] THEN + REWRITE_TAC[GSYM real_gt; CONVEX_HALFSPACE_GT]; + ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN + MATCH_MP_TAC(SET_RULE + `p SUBSET (UNIV DIFF b) /\ l INTER w = {} + ==> (b INTER w) SUBSET (UNIV DIFF (p UNION l))`) THEN + ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN + MATCH_MP_TAC(SET_RULE + `!t. t INTER u = {} /\ s SUBSET t ==> s INTER u = {}`) THEN + EXISTS_TAC `affine hull {x:real^2,b}` THEN CONJ_TAC THENL + [REWRITE_TAC[AFFINE_HULL_2; FORALL_IN_GSPEC; SET_RULE + `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SIMP_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN + REWRITE_TAC[DOT_RMUL; VECTOR_ARITH + `((&1 - v) % x + v % b) - x:real^N = v % (b - x)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthogonal]) THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL]; + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN + SIMP_TAC[SUBSET_HULL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + SIMP_TAC[HULL_INC; IN_INSERT] THEN + ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL] THEN + ONCE_REWRITE_TAC[SET_RULE `{x,b,a} = {a,x,b}`] THEN + MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM; dist] THEN + REWRITE_TAC[NORM_ARITH `norm(x - (x + a):real^N) = norm a`] THEN + REWRITE_TAC[VECTOR_ARITH `(x + a) - x:real^N = a`] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; + VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < e ==> abs(min (&1 / &2) x) < e`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_LT_DIV2_EQ] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[DOT_RMUL] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_LT_01]]; + REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[]]]; + DISCH_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `x + min (&1 / &2) (e / &2 / norm(c - x)) % (c - x):real^2` THEN + REWRITE_TAC[connected_component] THEN CONJ_TAC THENL + [EXISTS_TAC `segment[x:real^2,c] DELETE x` THEN + SIMP_TAC[CONVEX_SEMIOPEN_SEGMENT; CONVEX_CONNECTED] THEN + ASM_REWRITE_TAC[IN_DELETE; ENDS_IN_SEGMENT] THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `cd INTER p = {x} + ==> xd SUBSET cd + ==> (xd DELETE x) SUBSET (UNIV DIFF p)`)) THEN + REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN + UNDISCH_TAC `segment (a,b) INTER segment (c,d) = {x:real^2}` THEN + REWRITE_TAC[open_segment] THEN SET_TAC[]; + REWRITE_TAC[IN_SEGMENT; VECTOR_ARITH + `x + a % (y - x):real^N = (&1 - a) % x + a % y`] THEN + EXISTS_TAC `min (&1 / &2) (e / &2 / norm(c - x:real^2))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_LE_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE]; + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; + VECTOR_ARITH `x + a:real^N = x <=> a = vec 0`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min (&1 / &2) x = &0)`) THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]; + EXISTS_TAC `ball(x,e) INTER {w:real^2 | n dot (w - x) < &0}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_CONNECTED THEN MATCH_MP_TAC CONVEX_INTER THEN + REWRITE_TAC[CONVEX_BALL; DOT_RSUB; REAL_ARITH `a - b < &0 <=> a < b`; + CONVEX_HALFSPACE_LT]; + ASM_SIMP_TAC[PATHSTART_LINEPATH; PATH_IMAGE_JOIN; PATH_LINEPATH] THEN + MATCH_MP_TAC(SET_RULE + `p SUBSET (UNIV DIFF b) /\ l INTER w = {} + ==> (b INTER w) SUBSET (UNIV DIFF (p UNION l))`) THEN + ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN + MATCH_MP_TAC(SET_RULE + `!t. t INTER u = {} /\ s SUBSET t ==> s INTER u = {}`) THEN + EXISTS_TAC `affine hull {x:real^2,b}` THEN CONJ_TAC THENL + [REWRITE_TAC[AFFINE_HULL_2; FORALL_IN_GSPEC; SET_RULE + `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SIMP_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN + REWRITE_TAC[DOT_RMUL; VECTOR_ARITH + `((&1 - v) % x + v % b) - x:real^N = v % (b - x)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthogonal]) THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL]; + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN + SIMP_TAC[SUBSET_HULL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + SIMP_TAC[HULL_INC; IN_INSERT] THEN + ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL] THEN + ONCE_REWRITE_TAC[SET_RULE `{x,b,a} = {a,x,b}`] THEN + MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM; dist] THEN + REWRITE_TAC[NORM_ARITH `norm(x - (x + a):real^N) = norm a`] THEN + REWRITE_TAC[VECTOR_ARITH `(x + a) - x:real^N = a`] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; + VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < e ==> abs(min (&1 / &2) x) < e`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_LT_DIV2_EQ] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[DOT_RMUL; REAL_ARITH `x * y < &0 <=> &0 < x * --y`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < --x <=> x < &0`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_LT_01]]; + REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Polygonal path; 0 in the empty case is just for linear invariance. *) +(* Note that we *are* forced to assume non-emptiness for translation. *) +(* ------------------------------------------------------------------------- *) + +let polygonal_path = define + `polygonal_path[] = linepath(vec 0,vec 0) /\ + polygonal_path[a] = linepath(a,a) /\ + polygonal_path [a;b] = linepath(a,b) /\ + polygonal_path (CONS a (CONS b (CONS c l))) = + linepath(a,b) ++ polygonal_path(CONS b (CONS c l))`;; + +let POLYGONAL_PATH_CONS_CONS = prove + (`!a b p. ~(p = []) + ==> polygonal_path(CONS a (CONS b p)) = + linepath(a,b) ++ polygonal_path(CONS b p)`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[polygonal_path]);; + +let POLYGONAL_PATH_TRANSLATION = prove + (`!a b p. polygonal_path (MAP (\x. a + x) (CONS b p)) = + (\x. a + x) o (polygonal_path (CONS b p))`, + GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[MAP; polygonal_path; LINEPATH_TRANSLATION] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC list_INDUCT THEN + ASM_SIMP_TAC[MAP; polygonal_path; LINEPATH_TRANSLATION] THEN + REWRITE_TAC[JOINPATHS_TRANSLATION]);; + +add_translation_invariants [POLYGONAL_PATH_TRANSLATION];; + +let POLYGONAL_PATH_LINEAR_IMAGE = prove + (`!f p. linear f ==> polygonal_path (MAP f p) = f o polygonal_path p`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; MAP] THEN CONJ_TAC THENL + [REWRITE_TAC[LINEPATH_REFL; o_DEF; FUN_EQ_THM] THEN ASM_MESON_TAC[LINEAR_0]; + ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; MAP] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[LINEPATH_LINEAR_IMAGE]; + ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[polygonal_path; MAP] THEN + ASM_SIMP_TAC[GSYM JOINPATHS_LINEAR_IMAGE; GSYM LINEPATH_LINEAR_IMAGE]);; + +add_linear_invariants [POLYGONAL_PATH_LINEAR_IMAGE];; + +let PATHSTART_POLYGONAL_PATH = prove + (`!p. pathstart(polygonal_path p) = if p = [] then vec 0 else HD p`, + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; NOT_CONS_NIL; HD] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; HD; PATHSTART_JOIN]);; + +let PATHFINISH_POLYGONAL_PATH = prove + (`!p. pathfinish(polygonal_path p) = if p = [] then vec 0 else LAST p`, + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATHFINISH_LINEPATH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATHFINISH_LINEPATH; NOT_CONS_NIL; LAST] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATHFINISH_LINEPATH; PATHFINISH_JOIN]);; + +let VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH = prove + (`!p:(real^N)list. set_of_list p SUBSET path_image (polygonal_path p)`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[set_of_list; EMPTY_SUBSET] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[set_of_list; polygonal_path; PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[SEGMENT_REFL; INSERT_AC; SUBSET_REFL] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[set_of_list; polygonal_path] THEN CONJ_TAC THENL + [REWRITE_TAC[PATH_IMAGE_LINEPATH; INSERT_SUBSET; ENDS_IN_SEGMENT] THEN + REWRITE_TAC[EMPTY_SUBSET]; + REPEAT GEN_TAC THEN REPLICATE_TAC 3 DISCH_TAC THEN + ONCE_REWRITE_TAC[INSERT_SUBSET] THEN + SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + HD; NOT_CONS_NIL; IN_UNION; ENDS_IN_SEGMENT; PATH_IMAGE_LINEPATH] THEN + ASM SET_TAC[]]);; + +let ARC_POLYGONAL_PATH_IMP_DISTINCT = prove + (`!p:(real^N)list. arc(polygonal_path p) ==> PAIRWISE (\x y. ~(x = y)) p`, + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; ARC_LINEPATH_EQ] THEN + X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; ARC_LINEPATH_EQ] THEN + X_GEN_TAC `b:real^N` THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; ARC_LINEPATH_EQ] THEN CONJ_TAC THENL + [REWRITE_TAC[PAIRWISE; ALL]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN + REPLICATE_TAC 3 DISCH_TAC THEN + SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + HD; NOT_CONS_NIL; ARC_LINEPATH_EQ] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[PAIRWISE] THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[ALL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[IN_INTER; IN_SING; ENDS_IN_SEGMENT; PATH_IMAGE_LINEPATH] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] + (REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH))) THEN + ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM; DE_MORGAN_THM; GSYM ALL_MEM] THEN + MESON_TAC[]);; + +let PATH_POLYGONAL_PATH = prove + (`!p:(real^N)list. path(polygonal_path p)`, + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATH_LINEPATH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATH_LINEPATH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; PATH_LINEPATH] THEN + SIMP_TAC[PATH_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + NOT_CONS_NIL; HD; PATH_LINEPATH]);; + +let PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL = prove + (`!p. ~(p = []) + ==> path_image(polygonal_path p) SUBSET convex hull (set_of_list p)`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[] THEN GEN_TAC THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN CONJ_TAC THENL + [REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH; set_of_list] THEN + REWRITE_TAC[SEGMENT_REFL; CONVEX_HULL_SING] THEN SET_TAC[]; + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path] THEN CONJ_TAC THENL + [REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH; set_of_list] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL; SUBSET_REFL]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL; set_of_list] THEN + SIMP_TAC[HULL_MONO; INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[set_of_list] THEN + SET_TAC[]]]);; + +let PATH_IMAGE_POLYGONAL_PATH_SUBSET_SEGMENTS = prove + (`!p x:real^N. + arc(polygonal_path p) /\ 3 <= LENGTH p /\ + x IN path_image(polygonal_path p) + ==> ?a b. MEM a p /\ MEM b p /\ x IN segment[a,b] /\ + segment[a,b] SUBSET path_image(polygonal_path p) /\ + ~(pathstart(polygonal_path p) IN segment[a,b] /\ + pathfinish(polygonal_path p) IN segment[a,b])`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `b:real^N` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `c:real^N` THEN X_GEN_TAC `p:(real^N)list` THEN + REPEAT DISCH_TAC THEN REWRITE_TAC[polygonal_path] THEN + X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN + SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + ARC_JOIN_EQ; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATH_IMAGE_LINEPATH; ARC_LINEPATH] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC LAND_CONV [IN_UNION] THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN + ASM_REWRITE_TAC[MEM; SUBSET_UNION; ENDS_IN_SEGMENT] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS) THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL] THEN + DISCH_TAC THEN REWRITE_TAC[ARC_LINEPATH_EQ] THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE + `!p b. (s INTER p) SUBSET {b} /\ + x IN p /\ b IN s /\ ~(x = b) + ==> ~(x IN s)`) THEN + MAP_EVERY EXISTS_TAC + [`path_image(polygonal_path (CONS (b:real^N) (CONS c p)))`; + `b:real^N`] THEN + ASM_REWRITE_TAC[ENDS_IN_SEGMENT; PATHFINISH_IN_PATH_IMAGE]; + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[ARITH_RULE `3 <= SUC(SUC p) <=> ~(p = 0)`] THEN + REWRITE_TAC[LENGTH_EQ_NIL] THEN ASM_CASES_TAC `p:(real^N)list = []` THENL + [ASM_REWRITE_TAC[LENGTH; polygonal_path] THEN + REWRITE_TAC[PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN + UNDISCH_TAC + `x IN path_image(polygonal_path (CONS (b:real^N) (CONS c p)))` THEN + ASM_REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`b:real^N`; `c:real^N`] THEN + ASM_REWRITE_TAC[MEM; SUBSET_UNION; ENDS_IN_SEGMENT] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[polygonal_path; PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[ARC_LINEPATH_EQ] THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS) THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN SET_TAC[]; + ASM_REWRITE_TAC[LENGTH_EQ_NIL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real^N` THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[MEM]; + ASM_MESON_TAC[MEM]; + ASM_REWRITE_TAC[]; + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `(sab INTER p) SUBSET {b} + ==> !sde a. sde SUBSET p /\ + ~(b IN sde) /\ d IN sde /\ a IN sde /\ a IN sab + ==> F`) o el 2 o CONJUNCTS) THEN + MAP_EVERY EXISTS_TAC [`segment[d:real^N,e]`; `a:real^N`] THEN + ASM_REWRITE_TAC[ENDS_IN_SEGMENT] THEN ASM_MESON_TAC[]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Rotating the starting point to move a preferred vertex forward. *) +(* ------------------------------------------------------------------------- *) + +let SET_OF_LIST_POLYGONAL_PATH_ROTATE = prove + (`!p. ~(p = []) ==> set_of_list(CONS (LAST p) (BUTLAST p)) = set_of_list p`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [GSYM(MATCH_MP APPEND_BUTLAST_LAST th)]) THEN + REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN SET_TAC[]);; + +let PROPERTIES_POLYGONAL_PATH_SNOC = prove + (`!p d:real^N. + 2 <= LENGTH p + ==> path_image(polygonal_path(APPEND p [d])) = + path_image(polygonal_path p ++ linepath(LAST p,d)) /\ + (arc(polygonal_path(APPEND p [d])) <=> + arc(polygonal_path p ++ linepath(LAST p,d))) /\ + (simple_path(polygonal_path(APPEND p [d])) <=> + simple_path(polygonal_path p ++ linepath(LAST p,d)))`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[LENGTH; ARITH] THEN X_GEN_TAC `b:real^N` THEN + MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL + [REWRITE_TAC[APPEND; polygonal_path; LAST; NOT_CONS_NIL]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN REPEAT DISCH_TAC THEN + X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN REWRITE_TAC[APPEND] THEN + ONCE_REWRITE_TAC[LAST] THEN REWRITE_TAC[NOT_CONS_NIL] THEN + ONCE_REWRITE_TAC[polygonal_path] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[APPEND; LENGTH; ARITH_RULE `2 <= SUC(SUC n)`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SIMP_TAC[GSYM ARC_ASSOC; GSYM SIMPLE_PATH_ASSOC; PATHSTART_JOIN; + PATHFINISH_JOIN; PATHSTART_POLYGONAL_PATH; + PATHFINISH_POLYGONAL_PATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; NOT_CONS_NIL; HD] THEN + DISCH_TAC THEN CONJ_TAC THENL + [ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[UNION_ACI]; + ALL_TAC] THEN + ASM_CASES_TAC `a:real^N = d` THENL + [MATCH_MP_TAC(TAUT + `(~p /\ ~p') /\ (q <=> q') ==> (p <=> p') /\ (q <=> q')`) THEN + CONJ_TAC THENL + [REWRITE_TAC[ARC_SIMPLE_PATH; PATHSTART_JOIN; PATHFINISH_JOIN] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[PATHFINISH_POLYGONAL_PATH; NOT_CONS_NIL; LAST; + APPEND_EQ_NIL; LAST_APPEND]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_JOIN_LOOP_EQ o + lhs o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[PATHFINISH_POLYGONAL_PATH; PATHSTART_LINEPATH] THEN + REWRITE_TAC[NOT_CONS_NIL; HD; LAST; LAST_APPEND; APPEND_EQ_NIL]; + DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_JOIN_LOOP_EQ o + rhs o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + PATHFINISH_POLYGONAL_PATH] THEN + REWRITE_TAC[NOT_CONS_NIL; HD; LAST; LAST_APPEND; APPEND_EQ_NIL]; + DISCH_THEN SUBST1_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[PATHSTART_JOIN; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]; + MATCH_MP_TAC(TAUT + `((q <=> p) /\ (q' <=> p')) /\ (p <=> p') + ==> (p <=> p') /\ (q <=> q')`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC SIMPLE_PATH_EQ_ARC THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + PATHFINISH_POLYGONAL_PATH] THEN + ASM_REWRITE_TAC[NOT_CONS_NIL; HD; LAST; LAST_APPEND; APPEND_EQ_NIL]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) ARC_JOIN_EQ o lhs o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[NOT_CONS_NIL; HD]; + DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) ARC_JOIN_EQ o rhs o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_LINEPATH; PATHSTART_JOIN; + NOT_CONS_NIL; HD]; + DISCH_THEN SUBST1_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[PATHSTART_JOIN; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]]);; + +let PATH_IMAGE_POLYGONAL_PATH_ROTATE = prove + (`!p:(real^N)list. + 2 <= LENGTH p /\ LAST p = HD p + ==> path_image(polygonal_path(APPEND (TL p) [HD(TL p)])) = + path_image(polygonal_path p)`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `b:real^N` THEN REWRITE_TAC[HD; TL] THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN CONJ_TAC THENL + [REWRITE_TAC[LAST; APPEND; NOT_CONS_NIL] THEN MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN + REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[LAST; NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[GSYM LAST] THEN + DISCH_TAC THEN + SIMP_TAC[PROPERTIES_POLYGONAL_PATH_SNOC; LENGTH; + ARITH_RULE `2 <= SUC(SUC n)`] THEN + ONCE_REWRITE_TAC[LAST] THEN ASM_REWRITE_TAC[NOT_CONS_NIL] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [polygonal_path] THEN + RULE_ASSUM_TAC(REWRITE_RULE[LAST]) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; + LAST; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[UNION_ACI]);; + +let SIMPLE_PATH_POLYGONAL_PATH_ROTATE = prove + (`!p:(real^N)list. + 2 <= LENGTH p /\ LAST p = HD p + ==> (simple_path(polygonal_path(APPEND (TL p) [HD(TL p)])) = + simple_path(polygonal_path p))`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `b:real^N` THEN REWRITE_TAC[HD; TL] THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN CONJ_TAC THENL + [REWRITE_TAC[LAST; APPEND; NOT_CONS_NIL] THEN MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `p:(real^N)list`] THEN + REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[LAST; NOT_CONS_NIL] THEN ONCE_REWRITE_TAC[GSYM LAST] THEN + DISCH_TAC THEN + SIMP_TAC[PROPERTIES_POLYGONAL_PATH_SNOC; LENGTH; + ARITH_RULE `2 <= SUC(SUC n)`] THEN + ONCE_REWRITE_TAC[LAST] THEN ASM_REWRITE_TAC[NOT_CONS_NIL] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [polygonal_path] THEN + RULE_ASSUM_TAC(REWRITE_RULE[LAST]) THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + PATHFINISH_POLYGONAL_PATH; LAST; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[INSERT_AC; INTER_ACI; CONJ_ACI]);; + +let ROTATE_LIST_TO_FRONT_1 = prove + (`!P l a:A. + (!l. P(l) ==> 3 <= LENGTH l /\ LAST l = HD l) /\ + (!l. P(l) ==> P(APPEND (TL l) [HD(TL l)])) /\ + P l /\ MEM a l + ==> ?l'. EL 1 l' = a /\ P l'`, + let lemma0 = prove + (`!P. (!i. P i /\ 0 < i ==> P(i - 1)) /\ (?k. 0 < k /\ P k) + ==> P 1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!i:num. i < k ==> P(k - i)` MP_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_0] THEN DISCH_TAC THEN + REWRITE_TAC[ARITH_RULE `k - SUC i = k - i - 1`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `k - 1`) THEN + ASM_SIMP_TAC[ARITH_RULE `0 < k ==> k - 1 < k /\ k - (k - 1) = 1`]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?i l'. 0 < i /\ i < LENGTH l' /\ P l' /\ EL i l' = (a:A)` + MP_TAC THENL + [SUBGOAL_THEN `~(l:A list = [])` ASSUME_TAC THENL + [ASM_MESON_TAC[LENGTH; ARITH_RULE `~(3 <= 0)`]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [MEM_EXISTS_EL]) THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC (ARITH_RULE `i = 0 \/ 0 < i`) + THENL + [EXISTS_TAC `LENGTH(l:A list) - 2` THEN + EXISTS_TAC `(APPEND (TL l) [HD(TL l):A])` THEN + ASM_SIMP_TAC[LENGTH_APPEND; LENGTH_TL; EL_APPEND] THEN + REWRITE_TAC[LT_REFL; LENGTH; SUB_REFL; EL; HD] THEN + SUBGOAL_THEN `3 <= LENGTH(l:A list)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> n - 2 < n - 1`] THEN + ASM_SIMP_TAC[EL_TL; ARITH_RULE `3 <= n ==> n - 2 + 1 = n - 1`] THEN + ASM_MESON_TAC[LAST_EL]; + MAP_EVERY EXISTS_TAC [`i:num`; `l:A list`] THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] lemma0)) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m:A list` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `APPEND (TL m) [HD(TL m):A]` THEN + SUBGOAL_THEN `~(m:A list = [])` ASSUME_TAC THENL + [ASM_MESON_TAC[LENGTH; ARITH_RULE `~(3 <= 0)`]; ALL_TAC] THEN + ASM_SIMP_TAC[LENGTH_APPEND; LENGTH_TL; EL_APPEND] THEN + ASM_REWRITE_TAC[LENGTH] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN + ASM_SIMP_TAC[EL_TL; ARITH_RULE `0 < k ==> k - 1 + 1 = k`]]);; + +let ROTATE_LIST_TO_FRONT_0 = prove + (`!P l a:A. + (!l. P(l) ==> 3 <= LENGTH l /\ LAST l = HD l) /\ + (!l. P(l) ==> P(APPEND (TL l) [HD(TL l)])) /\ + P l /\ MEM a l + ==> ?l'. HD l' = a /\ P l'`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:A list->bool`; `l:A list`; `a:A`] + ROTATE_LIST_TO_FRONT_1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l':A list` THEN + STRIP_TAC THEN EXISTS_TAC `APPEND (TL l') [HD(TL l'):A]` THEN + ASM_SIMP_TAC[] THEN UNDISCH_TAC `EL 1 l' = (a:A)` THEN + SUBGOAL_THEN `3 <= LENGTH(l':A list)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SPEC_TAC(`l':A list`,`p:A list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + REWRITE_TAC[APPEND; HD; TL; num_CONV `1`; EL]);; + +(* ------------------------------------------------------------------------- *) +(* We can pick a transformation to make all y coordinates distinct. *) +(* ------------------------------------------------------------------------- *) + +let DISTINGUISHING_ROTATION_EXISTS_PAIR = prove + (`!x y. ~(x = y) + ==> FINITE {t | &0 <= t /\ t < &2 * pi /\ + (rotate2d t x)$2 = (rotate2d t y)$2}`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + ONCE_REWRITE_TAC[GSYM ROTATE2D_SUB] THEN + REWRITE_TAC[GSYM IM_DEF; GSYM real; GSYM ARG_EQ_0_PI] THEN + REWRITE_TAC[FINITE_UNION; SET_RULE + `{x | p x /\ q x /\ (r x \/ s x)} = + {x | p x /\ q x /\ r x} UNION {x | p x /\ q x /\ s x}`] THEN + CONJ_TAC THEN + MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET] + `(?a. s SUBSET {a}) ==> FINITE s`) THEN + MATCH_MP_TAC(SET_RULE + `(!x y. x IN s /\ y IN s ==> x = y) ==> ?a. s SUBSET {a}`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ARG_ROTATE2D_UNIQUE_2PI THEN EXISTS_TAC `x - y:complex` THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0]);; + +let DISTINGUISHING_ROTATION_EXISTS = prove + (`!s. FINITE s ==> ?t. pairwise (\x y. ~(x$2 = y$2)) (IMAGE (rotate2d t) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `INFINITE ({t | &0 <= t /\ t < &2 * pi} DIFF + UNIONS (IMAGE (\(x,y). {t | &0 <= t /\ t < &2 * pi /\ + (rotate2d t x)$2 = (rotate2d t y)$2}) + ({(x,y) | x IN s /\ y IN s /\ ~(x = y)})))` + MP_TAC THENL + [MATCH_MP_TAC INFINITE_DIFF_FINITE THEN + REWRITE_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN + CONJ_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[FINITE_UNIONS] THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{(x:real^2,y:real^2) | x IN s /\ y IN s}` THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT] THEN SET_TAC[]; + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[DISTINGUISHING_ROTATION_EXISTS_PAIR]]; + DISCH_THEN(MP_TAC o MATCH_MP (MESON[FINITE_EMPTY; INFINITE] + `INFINITE s ==> ~(s = {})`)) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[UNIONS_IMAGE; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[pairwise; IN_ELIM_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[ROTATE2D_EQ] THEN MESON_TAC[]]);; + +let DISTINGUISHING_ROTATION_EXISTS_POLYGON = prove + (`!p:(real^2)list. + ?f q. (?g. orthogonal_transformation g /\ f = MAP g) /\ + (!x y. MEM x q /\ MEM y q /\ ~(x = y) ==> ~(x$2 = y$2)) /\ + f q = p`, + GEN_TAC THEN MP_TAC(ISPEC + `set_of_list(p:(real^2)list)` DISTINGUISHING_ROTATION_EXISTS) THEN + REWRITE_TAC[FINITE_SET_OF_LIST; pairwise] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_SET_OF_LIST; ROTATE2D_EQ] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; GSYM CONJ_ASSOC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `MAP (rotate2d(--t))` THEN + EXISTS_TAC `MAP (rotate2d t) p` THEN + REWRITE_TAC[GSYM MAP_o; o_DEF; GSYM ROTATE2D_ADD] THEN + REWRITE_TAC[REAL_ADD_LINV; ROTATE2D_ZERO; MAP_ID] THEN + CONJ_TAC THENL [MESON_TAC[ORTHOGONAL_TRANSFORMATION_ROTATE2D]; ALL_TAC] THEN + REWRITE_TAC[GSYM IN_SET_OF_LIST; SET_OF_LIST_MAP] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[IN_SET_OF_LIST; ROTATE2D_EQ] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Proof that we can chop a polygon's inside in two. *) +(* ------------------------------------------------------------------------- *) + +let POLYGON_CHOP_IN_TWO = prove + (`!p:(real^2)list. + simple_path(polygonal_path p) /\ + pathfinish(polygonal_path p) = pathstart(polygonal_path p) /\ + 5 <= LENGTH p + ==> ?a b. ~(a = b) /\ MEM a p /\ MEM b p /\ + segment(a,b) SUBSET inside(path_image(polygonal_path p))`, + let wlog_lemma = MESON[] + `(!x. ?f:A->A y. transform f /\ nice y /\ f y = x) + ==> !P. (!f x. transform f ==> (P(f x) <=> P x)) /\ + (!x. nice x ==> P x) + ==> !x. P x` in + let between_lemma = prove + (`!a c u v m:real^N. + collinear {a,c,u,v,m} /\ m IN segment[u,v] /\ m IN segment(a,c) + ==> u IN segment(a,c) \/ v IN segment(a,c) \/ + segment[a,c] SUBSET segment[u,v]`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + REWRITE_TAC[INSERT_SUBSET; LEFT_IMP_EXISTS_THM; EMPTY_SUBSET] THEN + MAP_EVERY X_GEN_TAC [`origin:real^N`; `dir:real^N`] THEN + GEOM_ORIGIN_TAC `origin:real^N` THEN + REWRITE_TAC[AFFINE_HULL_2; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `dir:real^N = vec 0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; SEGMENT_REFL; SUBSET_REFL]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET_SEGMENT] THEN + ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REAL_ARITH_TAC) in + MATCH_MP_TAC(MATCH_MP wlog_lemma DISTINGUISHING_ROTATION_EXISTS_POLYGON) THEN + CONJ_TAC THENL + [REWRITE_TAC[MESON[] `(!x y. (?z. P z /\ x = f z) ==> Q x y) <=> + (!z y. P z ==> Q (f z) y)`] THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN + GEOM_TRANSFORM_TAC []; + ALL_TAC] THEN + X_GEN_TAC `q:(real^2)list` THEN DISCH_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `?b:real^2. MEM b q /\ !d. MEM d q ==> b$2 <= d$2` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `IMAGE (\x:real^2. x$2) (set_of_list q)` + INF_FINITE) THEN + SIMP_TAC[FINITE_SET_OF_LIST; FINITE_IMAGE] THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; SET_OF_LIST_EQ_EMPTY] THEN + UNDISCH_TAC `5 <= LENGTH(q:(real^2)list)` THEN + ASM_CASES_TAC `q:(real^2)list = []` THEN + ASM_REWRITE_TAC[LENGTH; ARITH; FORALL_IN_IMAGE] THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; IN_SET_OF_LIST] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^2` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?p:(real^2)list. + EL 1 p = b /\ LAST p = HD p /\ + LENGTH p = LENGTH q /\ set_of_list p = set_of_list q /\ + path_image(polygonal_path p) = path_image(polygonal_path q) /\ + simple_path(polygonal_path p) /\ + pathfinish(polygonal_path p) = pathstart(polygonal_path p)` + MP_TAC THENL + [MATCH_MP_TAC ROTATE_LIST_TO_FRONT_1 THEN EXISTS_TAC `q:(real^2)list` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY UNDISCH_TAC + [`pathfinish(polygonal_path(q:(real^2)list)) = + pathstart(polygonal_path q)`; + `5 <= LENGTH(q:(real^2)list)`] THEN + ASM_CASES_TAC `q:(real^2)list = []` THEN + ASM_REWRITE_TAC[LENGTH; ARITH] THEN + ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN + DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `l:(real^2)list` THEN + REWRITE_TAC[APPEND_EQ_NIL; NOT_CONS_NIL] THEN + ASM_CASES_TAC `l:(real^2)list = []` THENL + [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(TL l:(real^2)list = [])` ASSUME_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `LENGTH:(real^2)list->num`) THEN + ASM_SIMP_TAC[LENGTH; LENGTH_TL] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[LAST_APPEND; LENGTH_APPEND; LENGTH_TL; NOT_CONS_NIL] THEN + ASM_REWRITE_TAC[LAST; HD_APPEND; LENGTH] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + MAP_EVERY UNDISCH_TAC + [`HD(l:(real^2)list) = LAST l`; `5 <= LENGTH(q:(real^2)list)`; + `~(l:(real^2)list = [])`] THEN + ASM_REWRITE_TAC[] THEN + SPEC_TAC(`l:(real^2)list`,`l:(real^2)list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[HD; TL; APPEND] THEN + REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `a IN s /\ b IN s ==> s UNION {a} = b INSERT s`) THEN + ASM_REWRITE_TAC[LAST] THEN ONCE_ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LAST] THEN UNDISCH_TAC `5 <= LENGTH(CONS (h:real^2) t)` THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN + REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL; LENGTH] THEN + DISCH_TAC THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[EL] THEN ASM_ARITH_TAC; + EXISTS_TAC `LENGTH(t:(real^2)list) - 1` THEN + ASM_SIMP_TAC[LAST_EL] THEN ASM_ARITH_TAC]; + MATCH_MP_TAC PATH_IMAGE_POLYGONAL_PATH_ROTATE THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + MP_TAC(ISPEC `l:(real^2)list` SIMPLE_PATH_POLYGONAL_PATH_ROTATE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + UNDISCH_THEN `pathfinish(polygonal_path(q:(real^2)list)) = + pathstart(polygonal_path q)` (K ALL_TAC) THEN + UNDISCH_THEN `simple_path(polygonal_path(q:(real^2)list))` (K ALL_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `r:(real^2)list` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [EXTENSION] THEN + REWRITE_TAC[IN_SET_OF_LIST] THEN DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> REWRITE_TAC[GSYM th] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN + UNDISCH_THEN `MEM (b:real^2) r` (K ALL_TAC) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`r:(real^2)list`,`r:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a:real^2` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `b':real^2` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `c:real^2` THEN X_GEN_TAC `p:(real^2)list` THEN + REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN + REWRITE_TAC[num_CONV `1`; EL; HD; TL] THEN + ASM_CASES_TAC `b':real^2 = b` THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `5 <= SUC(SUC(SUC n)) <=> ~(n = 0) /\ 2 <= n`] THEN + ASM_CASES_TAC `p:(real^2)list = []` THEN ASM_REWRITE_TAC[LENGTH_EQ_NIL] THEN + ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS; LAST; NOT_CONS_NIL] THEN + REWRITE_TAC[PATHSTART_JOIN; PATHSTART_LINEPATH] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b:real^2`) THEN + REWRITE_TAC[MESON[MEM] `MEM b (CONS a (CONS b l))`] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`linepath(a:real^2,b)`; + `polygonal_path(CONS (b:real^2) (CONS c p))`] + SIMPLE_PATH_JOIN_IMP) THEN + ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS] THEN + REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_JOIN; PATHSTART_LINEPATH] THEN + REWRITE_TAC[ARC_LINEPATH_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (fun th -> ASSUME_TAC th THEN MP_TAC th) + MP_TAC) THEN + SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + NOT_CONS_NIL; HD] THEN + REWRITE_TAC[ARC_LINEPATH_EQ; GSYM CONJ_ASSOC; PATH_IMAGE_LINEPATH] THEN + SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; + HD; NOT_CONS_NIL] THEN + REWRITE_TAC[SET_RULE `s INTER (t UNION u) SUBSET v <=> + s INTER t SUBSET v /\ s INTER u SUBSET v`] THEN + ASM_CASES_TAC `a:real^2 = c` THENL + [DISCH_THEN(MP_TAC o CONJUNCT1) THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_SYM; INTER_ACI] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ_ALT] + FINITE_SUBSET)) THEN + REWRITE_TAC[FINITE_SEGMENT; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN STRIP_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `CONS (b:real^2) (CONS c p)` + ARC_POLYGONAL_PATH_IMP_DISTINCT) THEN + ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS] THEN + REWRITE_TAC[PAIRWISE; ALL] THEN REWRITE_TAC[GSYM ALL_MEM] THEN + REWRITE_TAC[MESON[] `(!x. P x ==> ~(a = x)) <=> ~(P a)`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(b:real^2)$2 < (a:real^2)$2 /\ + (b:real^2)$2 < (c:real^2)$2 /\ + (!v. MEM v p ==> (b:real^2)$2 < (v:real^2)$2)` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[MEM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~collinear{a:real^2,b,c}` ASSUME_TAC THENL + [REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN + SUBGOAL_THEN `FINITE(segment[a:real^2,b] INTER segment[b,c])` MP_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{a:real^2,b}` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + STRIP_TAC THENL + [SUBGOAL_THEN `segment[a:real^2,b] INTER segment[b,c] = segment[a,b]` + (fun th -> ASM_REWRITE_TAC[FINITE_SEGMENT; th]) THEN + REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`] THEN + ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; + DISCH_TAC THEN UNDISCH_TAC `b IN segment[c:real^2,a]` THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT] THEN + ASM_REWRITE_TAC[IN_SEGMENT; NOT_IN_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^2. x$2`) THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - u) * b < (&1 - u) * c /\ u * b < u * a + ==> ~(b = (&1 - u) * c + u * a)`) THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_SUB_LT]; + SUBGOAL_THEN `segment[a:real^2,b] INTER segment[b,c] = segment[b,c]` + (fun th -> ASM_REWRITE_TAC[FINITE_SEGMENT; th]) THEN + REWRITE_TAC[SET_RULE `s INTER t = t <=> t SUBSET s`] THEN + ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]]; + ALL_TAC] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + e <= (a:real^2)$2 - (b:real^2)$2 /\ + e <= (c:real^2)$2 - (b:real^2)$2 /\ + !v. MEM v p ==> e <= (v:real^2)$2 - (b:real^2)$2` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `IMAGE (\v. (v:real^2)$2 - (b:real^2)$2) + (set_of_list(CONS a (CONS b (CONS c p))) + DELETE b)` + INF_FINITE) THEN + ASM_SIMP_TAC[FINITE_SET_OF_LIST; FINITE_IMAGE; FINITE_DELETE] THEN + ANTS_TAC THENL + [REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[set_of_list; GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `a:real^2` THEN ASM_REWRITE_TAC[IN_DELETE; IN_INSERT]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN + ASM_REWRITE_TAC[set_of_list; FORALL_IN_INSERT; IMP_CONJ; IN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^2` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC) THEN + DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_SET_OF_LIST] THEN + DISCH_TAC THEN EXISTS_TAC `(d:real^2)$2 - (b:real^2)$2` THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INSERT; IN_SET_OF_LIST]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`a':real^2 = (&1 - e / (a$2 - b$2)) % b + e / (a$2 - b$2) % a`; + `c':real^2 = (&1 - e / (c$2 - b$2)) % b + e / (c$2 - b$2) % c`] THEN + SUBGOAL_THEN + `a' IN segment[b:real^2,a] /\ c' IN segment[b,c]` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN + REWRITE_TAC[IN_SEGMENT] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % a + u % b = (&1 - v) % a + v % b <=> + (u - v) % (b - a) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN + REWRITE_TAC[UNWIND_THM1] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; REAL_SUB_LE; + REAL_LE_LDIV_EQ; REAL_SUB_LT; REAL_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `~(a':real^2 = b) /\ ~(c':real^2 = b)` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LT_IMP_NZ]; + ALL_TAC] THEN + SUBGOAL_THEN `~collinear{a':real^2,b,c'}` ASSUME_TAC THENL + [UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN + MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN + REWRITE_TAC[VECTOR_ARITH `((&1 - u) % b + u % a) - b = u % (a - b)`] THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; DOT_LMUL; DOT_RMUL] THEN + MATCH_MP_TAC(REAL_FIELD + `~(a = &0) /\ ~(c = &0) + ==> (a * c * x) pow 2 = (a * a * y) * (c * c * z) + ==> x pow 2 = y * z`) THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LT_IMP_NZ]; + ALL_TAC] THEN + SUBGOAL_THEN `~(a':real^2 = c')` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~collinear{a':real^2,b,c'}` THEN + ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; + ALL_TAC] THEN + SUBGOAL_THEN `~affine_dependent{a':real^2,b,c'}` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3]; ALL_TAC] THEN + MP_TAC(ISPEC `{a':real^2,b,c'}` INTERIOR_CONVEX_HULL_EQ_EMPTY) THEN + REWRITE_TAC[DIMINDEX_2; HAS_SIZE; ARITH; FINITE_INSERT; FINITE_EMPTY] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN DISCH_TAC THEN + SUBGOAL_THEN `convex hull {a,b,c} INTER {x:real^2 | x$2 - b$2 <= e} = + convex hull {a',b,c'}` + ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN + REWRITE_TAC[CONVEX_HULL_3_ALT] THEN + REWRITE_TAC[SUBSET; IN_INTER; FORALL_IN_GSPEC; IMP_CONJ] THEN + REWRITE_TAC[IN_ELIM_THM; VECTOR_ARITH + `a + x:real^N = a + y <=> x = y`] THEN + MAP_EVERY X_GEN_TAC [`s:real`; `t:real`] THEN + REPLICATE_TAC 3 DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN + REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % b + u % a) - b:real^N = u % (a - b)`] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_ADD_SUB; VECTOR_SUB_COMPONENT] THEN STRIP_TAC THEN + EXISTS_TAC `(s * ((a:real^2)$2 - (b:real^2)$2)) / e` THEN + EXISTS_TAC `(t * ((c:real^2)$2 - (b:real^2)$2)) / e` THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_SUB_LT; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `a / e + b / e:real = (a + b) / e`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN BINOP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_FIELD + `y < x /\ &0 < e ==> s = (s * (x - y)) / e * e / (x - y)`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTER; IN_ELIM_THM] THEN + ASM_SIMP_TAC[HULL_INC; IN_INSERT; REAL_SUB_REFL; REAL_LT_IMP_LE] THEN + SIMP_TAC[REAL_LE_SUB_RADD; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LE; + CONVEX_CONVEX_HULL] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `a' IN segment[b:real^2,a]` THEN + SPEC_TAC(`a':real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN + SET_TAC[]; + EXPAND_TAC "a'"; + UNDISCH_TAC `c' IN segment[b:real^2,c]` THEN + SPEC_TAC(`c':real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MONO THEN + SET_TAC[]; + EXPAND_TAC "c'"] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH + `(&1 - u) * b + u * a <= e + b <=> (a - b) * u <= e`] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN + REWRITE_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `interior(convex hull {a,b,c}) INTER {x:real^2 | x$2 - b$2 < e} = + interior(convex hull {a',b,c'})` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_SUB_RADD; GSYM INTERIOR_HALFSPACE_COMPONENT_LE] THEN + ASM_REWRITE_TAC[GSYM INTERIOR_INTER; GSYM REAL_LE_SUB_RADD]; + ALL_TAC] THEN + SUBGOAL_THEN + `?d:real^2. d IN interior(convex hull {a',b,c'}) /\ ~(d$1 = b$1)` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `~(interior(convex hull {a':real^2,b,c'}) = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^2)$1 = (b:real^2)$1` THENL + [ALL_TAC; EXISTS_TAC `x:real^2` THEN ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `x + k / &2 % basis 1:real^2`) THEN ANTS_TAC THENL + [REWRITE_TAC[IN_BALL; NORM_ARITH `dist(x,x + e) = norm e`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; ARITH] THEN + UNDISCH_TAC `&0 < k` THEN REAL_ARITH_TAC; + DISCH_TAC] THEN + EXISTS_TAC `x + k / &2 % basis 1:real^2` THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[BASIS_COMPONENT; DIMINDEX_GE_1; ARITH; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> ~(b + k / &2 = b)`] THEN + REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `k / &2` THEN + ASM_REWRITE_TAC[REAL_HALF; SUBSET] THEN X_GEN_TAC `y:real^2` THEN + REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_BALL] THEN MATCH_MP_TAC(NORM_ARITH + `!a. dist(x + a,y) < k / &2 /\ norm(a) = k / &2 ==> dist(x,y) < k`) THEN + EXISTS_TAC `k / &2 % basis 1:real^2` THEN ASM_REWRITE_TAC[NORM_MUL] THEN + SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + UNDISCH_TAC `&0 < k` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `path_image(polygonal_path(CONS a (CONS b (CONS c p)))) + SUBSET {x:real^2 | x$2 >= b$2}` + MP_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC + `convex hull(set_of_list(CONS (a:real^2) (CONS b (CONS c p))))` THEN + SIMP_TAC[PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL; NOT_CONS_NIL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_GE] THEN + REWRITE_TAC[set_of_list; INSERT_SUBSET; IN_ELIM_THM; EMPTY_SUBSET] THEN + ASM_SIMP_TAC[SUBSET; IN_SET_OF_LIST; real_ge; IN_ELIM_THM; REAL_LT_IMP_LE; + REAL_LE_REFL]; + GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN + ASM_SIMP_TAC[POLYGONAL_PATH_CONS_CONS; NOT_CONS_NIL] THEN + REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_TAC] THEN + SUBGOAL_THEN + `(:real^2) DIFF {x | x$2 >= b$2} SUBSET + outside(path_image + (linepath(a,b) ++ linepath(b,c) ++ polygonal_path(CONS c p)))` + MP_TAC THENL + [MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN + REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_GE] THEN + ASM_REWRITE_TAC[SUBSET; real_ge; IN_ELIM_THM]; + REWRITE_TAC[SUBSET; real_ge; IN_ELIM_THM; IN_UNIV; + IN_DIFF; REAL_NOT_LE] THEN + DISCH_TAC] THEN + ABBREV_TAC + `d':real^2 = d - (&1 + (d:real^2)$2 - (b:real^2)$2) % basis 2` THEN + SUBGOAL_THEN `(d':real^2) IN outside(path_image + (linepath(a,b) ++ linepath(b,c) ++ polygonal_path(CONS c p)))` + ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "d'" THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a':real^2)$2 - (b:real^2)$2 = e /\ + (c':real^2)$2 - (b:real^2)$2 = e` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["a'"; "c'"] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `((&1 - u) * b + u * a) - b = u * (a - b)`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_ARITH `b < a ==> ~(a - b = &0)`]; + ALL_TAC] THEN + SUBGOAL_THEN `(b:real^2)$2 < (d:real^2)$2 /\ (d:real^2)$2 < (b:real^2)$2 + e` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(d:real^2) IN interior(convex hull {a',b,c'})` THEN + ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3_MINIMAL] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`r:real`; `s:real`; `t:real`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_EQ_SUB_RADD]) THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH + `r + s + t = &1 ==> s = &1 - (r + t)`)) THEN + REWRITE_TAC[REAL_ARITH + `b < r * x + (&1 - (r + t)) * b + t * x <=> (r + t) * b < (r + t) * x`; + REAL_ARITH + `r * (e + b) + (&1 - (r + t)) * b + t * (e + b) < b + e <=> + (r + t) * e < &1 * e`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_ADD; REAL_LT_RMUL_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d':real^2)$2 + &1 = (b:real^2)$2` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `convex hull {a':real^2,b,c'} SUBSET convex hull {a,b,c}` + ASSUME_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONVEX_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN + SIMP_TAC[HULL_INC; IN_INSERT] THEN CONJ_TAC THENL + [UNDISCH_TAC `(a':real^2) IN segment[b,a]` THEN + SPEC_TAC(`a':real^2`,`x:real^2`); + UNDISCH_TAC `(c':real^2) IN segment[b,c]` THEN + SPEC_TAC(`c':real^2`,`x:real^2`)] THEN + REWRITE_TAC[GSYM SUBSET] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(d' IN convex hull {a:real^2,b,c})` ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ ~(x IN t) ==> ~(x IN s)`) THEN + EXISTS_TAC `{x | (x:real^2)$2 >= (b:real^2)$2}` THEN + SIMP_TAC[SUBSET_HULL; CONVEX_HALFSPACE_COMPONENT_GE] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; real_ge] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(d' IN convex hull {a':real^2,b,c'})` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `~(segment[d:real^2,d'] INTER frontier(convex hull {a',b,c'}) = {})` + MP_TAC THENL + [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN + REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN CONJ_TAC THENL + [EXISTS_TAC `d:real^2` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN + ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; + EXISTS_TAC `d':real^2` THEN ASM_REWRITE_TAC[ENDS_IN_SEGMENT; IN_DIFF]]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^2` MP_TAC) THEN REWRITE_TAC[IN_INTER] THEN + ASM_CASES_TAC `x:real^2 = d` THENL + [ASM_REWRITE_TAC[IN_DIFF; frontier]; ALL_TAC] THEN + ASM_CASES_TAC `x:real^2 = d'` THENL + [ASM_REWRITE_TAC[IN_DIFF; frontier] THEN + SUBGOAL_THEN `closure(convex hull {a':real^2,b,c'}) = convex hull {a',b,c'}` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MESON_TAC[COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; FINITE_RULES]; + ALL_TAC] THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(d':real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(x:real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL + [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `x:real^2`] SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(x:real^2 = b)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(x:real^2)$2 < (b:real^2)$2 + e` ASSUME_TAC THENL + [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `x:real^2`] SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(x:real^2 = a) /\ ~(x = c)` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(x:real^2) IN (segment(b,a) UNION segment(b,c))` + ASSUME_TAC THENL + [UNDISCH_TAC `(x:real^2) IN frontier(convex hull {a':real^2,b,c'})` THEN + ASM_SIMP_TAC[open_segment; IN_UNION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN MATCH_MP_TAC(SET_RULE + `~(x IN u) /\ s SUBSET s' /\ t SUBSET t' + ==> x IN (s UNION t UNION u) ==> x IN s' \/ x IN t'`) THEN + ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`c':real^2`; `a':real^2`; `x:real^2`] + SEGMENT_HORIZONTAL) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `segment[d:real^2,d'] INTER path_image(polygonal_path(CONS c p)) = {}` + ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `!u. t SUBSET u /\ s INTER u = {} ==> s INTER t = {}`) THEN + EXISTS_TAC `{x:real^2 | x$2 >= (b:real^2)$2 + e}` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull(set_of_list(CONS c p)) :real^2->bool` THEN + SIMP_TAC[PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL; NOT_CONS_NIL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_GE; + set_of_list; INSERT_SUBSET] THEN + REWRITE_TAC[SUBSET; IN_SET_OF_LIST; IN_ELIM_THM] THEN + ASM_SIMP_TAC[real_ge; REAL_ARITH `b + e <= x <=> e <= x - b`]; + REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN + X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN + MP_TAC(ISPECL[`d:real^2`; `d':real^2`; `y:real^2`] SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; real_ge] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(d:real^2) IN interior(convex hull {a,b,c})` ASSUME_TAC THENL + [UNDISCH_TAC `(d:real^2) IN interior(convex hull {a', b, c'})` THEN + SPEC_TAC(`d:real^2`,`d:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(d':real^2 = d)` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_SEGMENT]; ALL_TAC] THEN + SUBGOAL_THEN + `!y:real^2. y IN segment[d,d'] /\ + y IN (segment (b,a) UNION segment (b,c)) + ==> y = x` + ASSUME_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `collinear {d:real^2,x,y}` MP_TAC THENL + [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + MAP_EVERY EXISTS_TAC [`d:real^2`; `d':real^2`] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL) THEN + ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; ENDS_IN_SEGMENT] THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION]; + ALL_TAC] THEN + REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN + ASM_SIMP_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `x:real^2 = y` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(x:real^2) IN frontier(convex hull {a,b,c}) /\ + (y:real^2) IN frontier(convex hull {a,b,c})` + MP_TAC THENL + [REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN + REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_UNION]) THEN ASM_MESON_TAC[SEGMENT_SYM]; + REWRITE_TAC[frontier; IN_DIFF]] THEN + ASM_CASES_TAC `y:real^2 = d` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`(d:real^2) IN segment (x,y)`; + `(y:real^2) IN segment [d,d']`; + `(x:real^2) IN segment(d,d')`] THEN + ASM_REWRITE_TAC[IN_SEGMENT] THEN + REPLICATE_TAC 2 (STRIP_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH + `d = (&1 - w) % ((&1 - u) % d + u % d') + w % ((&1 - v) % d + v % d') <=> + ((&1 - w) * u + w * v) % (d' - d) = vec 0`] THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ARITH + `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN + REWRITE_TAC[REAL_ENTIRE] THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `~(x IN interior(convex hull {a:real^2, b, c}))` THEN + UNDISCH_TAC `x IN segment (y:real^2,d)` THEN + SPEC_TAC(`x:real^2`,`x:real^2`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN + ASM_REWRITE_TAC[CONVEX_CONVEX_HULL]; + UNDISCH_TAC `~(y IN interior(convex hull {a:real^2, b, c}))` THEN + UNDISCH_TAC `y IN segment (d:real^2,x)` THEN + SPEC_TAC(`y:real^2`,`y:real^2`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN + ASM_REWRITE_TAC[CONVEX_CONVEX_HULL]]; + ALL_TAC] THEN + SUBGOAL_THEN `pathfinish(polygonal_path p) = (a:real^2)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[PATHFINISH_POLYGONAL_PATH]; ALL_TAC] THEN + SUBGOAL_THEN `segment(a:real^2,b) INTER segment(b,c) = {}` ASSUME_TAC THENL + [UNDISCH_TAC `segment[a:real^2,b] INTER segment[b,c] SUBSET {a, b}` THEN + REWRITE_TAC[SUBSET; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(d:real^2) IN inside(path_image + (linepath(a,b) ++ linepath(b,c) ++ polygonal_path(CONS c p)))` + ASSUME_TAC THENL + [UNDISCH_TAC `x IN segment(b:real^2,a) UNION segment (b,c)` THEN + REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL + [MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `d:real^2`; `d':real^2`; + `linepath(b:real^2,c) ++ polygonal_path(CONS c p)`; + `x:real^2`] PARITY_LEMMA) THEN + SUBGOAL_THEN + `path_image((linepath(b:real^2,c) ++ polygonal_path(CONS c p)) ++ + linepath(a,b)) = + path_image(linepath(a,b) ++ linepath(b:real^2,c) ++ + polygonal_path(CONS c p))` + SUBST1_TAC THENL + [MATCH_MP_TAC PATH_IMAGE_SYM THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + UNDISCH_TAC `pathfinish(linepath(a,b) ++ + linepath (b,c) ++ polygonal_path(CONS c p)):real^2 = a` THEN + ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_POLYGONAL_PATH]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_SYM o snd) THEN + ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN + ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[PATHFINISH_POLYGONAL_PATH] THEN + ASM_REWRITE_TAC[NOT_CONS_NIL; LAST]; + REWRITE_TAC[PATHSTART_JOIN; PATHSTART_LINEPATH]; + REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_POLYGONAL_PATH] THEN + ASM_REWRITE_TAC[NOT_CONS_NIL; LAST]; + MATCH_MP_TAC(SET_RULE + `x IN s /\ x IN t /\ (!y. y IN s /\ y IN t ==> y = x) + ==> s INTER t = {x}`) THEN + SUBST1_TAC(ISPECL[`a:real^2`; `b:real^2`] (CONJUNCT2 SEGMENT_SYM)) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SEGMENT_CLOSED_OPEN]) THEN ASM SET_TAC[]; + SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; + PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + ASM_REWRITE_TAC[SET_RULE `s INTER (t UNION u) = {} <=> + s INTER t = {} /\ s INTER u = {}`] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real^2` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `(y:real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL + [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `y:real^2`] + SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; + IN_INSERT; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `y:real^2 = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(SUBS[ISPECL [`a:real^2`; `b:real^2`] + (CONJUNCT2 SEGMENT_SYM)]) THEN + ASM_CASES_TAC `y:real^2 = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN + UNDISCH_THEN `y:real^2 = c` SUBST_ALL_TAC THEN + MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `c:real^2`] + SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN + ASM_REAL_ARITH_TAC]; + MP_TAC(ISPECL [`b:real^2`; `c:real^2`; `d:real^2`; `d':real^2`; + `polygonal_path(CONS c p) ++ linepath(a:real^2,b)`; + `x:real^2`] PARITY_LEMMA) THEN + SUBGOAL_THEN + `path_image((polygonal_path (CONS c p) ++ linepath (a,b)) ++ + linepath(b:real^2,c)) = + path_image(linepath(a,b) ++ linepath(b:real^2,c) ++ + polygonal_path(CONS c p))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; + NOT_CONS_NIL; HD; LAST] THEN + REWRITE_TAC[UNION_ACI]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) (GSYM SIMPLE_PATH_ASSOC) o snd) THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN SUBST1_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) SIMPLE_PATH_SYM o snd) THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN SUBST1_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) (GSYM SIMPLE_PATH_ASSOC) o + snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC]] THEN + ASM_SIMP_TAC[GSYM SIMPLE_PATH_ASSOC;PATHSTART_JOIN; + PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH; + NOT_CONS_NIL; HD; LAST]; + REWRITE_TAC[PATHSTART_JOIN; PATHSTART_POLYGONAL_PATH] THEN + REWRITE_TAC[NOT_CONS_NIL; HD]; + REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH]; + MATCH_MP_TAC(SET_RULE + `x IN s /\ x IN t /\ (!y. y IN s /\ y IN t ==> y = x) + ==> s INTER t = {x}`) THEN + SUBST1_TAC(ISPECL[`a:real^2`; `b:real^2`] (CONJUNCT2 SEGMENT_SYM)) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SEGMENT_CLOSED_OPEN]) THEN ASM SET_TAC[]; + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; NOT_CONS_NIL; HD; + PATH_IMAGE_LINEPATH; PATHFINISH_POLYGONAL_PATH; LAST] THEN + ASM_REWRITE_TAC[SET_RULE `s INTER (t UNION u) = {} <=> + s INTER t = {} /\ s INTER u = {}`] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real^2` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `(y:real^2)$1 = (d:real^2)$1` ASSUME_TAC THENL + [MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `y:real^2`] + SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; + IN_INSERT; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `y:real^2 = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(SUBS[ISPECL [`a:real^2`; `b:real^2`] + (CONJUNCT2 SEGMENT_SYM)]) THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + ASM_CASES_TAC `y:real^2 = a` THENL [ALL_TAC; ASM SET_TAC[]] THEN + UNDISCH_THEN `y:real^2 = a` SUBST_ALL_TAC THEN + MP_TAC(ISPECL [`d:real^2`; `d':real^2`; `a:real^2`] + SEGMENT_VERTICAL) THEN + ASM_REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION] THEN + ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `~affine_dependent{a:real^2,b,c}` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3]; ALL_TAC] THEN + ASM_CASES_TAC + `path_image(polygonal_path(CONS c p)) INTER + convex hull {a,b,c} SUBSET {a:real^2,c}` + THENL + [MAP_EVERY EXISTS_TAC [`a:real^2`; `c:real^2`] THEN + ASM_REWRITE_TAC[MEM] THEN X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN + MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN + EXISTS_TAC `d:real^2` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `segment[d:real^2,y]` THEN + REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `convex hull {a:real^2,b,c} DIFF (segment[a,b] UNION segment[b,c])` THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH; + PATHSTART_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `t INTER s SUBSET c + ==> c SUBSET (a UNION b) + ==> s DIFF (a UNION b) SUBSET UNIV DIFF (a UNION b UNION t)`)) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_UNION; ENDS_IN_SEGMENT]] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_DIFF] THEN CONJ_TAC THENL + [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `~(d IN frontier(convex hull {a:real^2,b,c}))` MP_TAC THENL + [ASM_REWRITE_TAC[frontier; IN_DIFF]; + REWRITE_TAC[FRONTIER_OF_TRIANGLE; SEGMENT_CONVEX_HULL] THEN SET_TAC[]]; + REWRITE_TAC[IN_DIFF; IN_UNION] THEN REPEAT STRIP_TAC THENL + [UNDISCH_TAC `y IN segment(a:real^2,c)` THEN + REWRITE_TAC[open_segment; IN_DIFF; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s /\ P x ==> x IN t`) THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN + MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `y:real^2` THEN + MAP_EVERY UNDISCH_TAC + [`y IN convex hull {a:real^2, b}`; `y IN segment(a:real^2,c)`] THEN + REWRITE_TAC[open_segment; GSYM SEGMENT_CONVEX_HULL; IN_DIFF] THEN + REWRITE_TAC[DE_MORGAN_THM; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IMP_IMP; GSYM BETWEEN_IN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o + MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN + REWRITE_TAC[INSERT_AC; IMP_IMP]; + UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`] THEN + MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `y:real^2` THEN + MAP_EVERY UNDISCH_TAC + [`y IN convex hull {b:real^2, c}`; `y IN segment(a:real^2,c)`] THEN + REWRITE_TAC[open_segment; GSYM SEGMENT_CONVEX_HULL; IN_DIFF] THEN + REWRITE_TAC[DE_MORGAN_THM; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IMP_IMP; GSYM BETWEEN_IN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o + MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN + REWRITE_TAC[INSERT_AC; IMP_IMP]]; + REWRITE_TAC[SET_RULE + `s DIFF (t UNION u) = (s DIFF t) INTER (s DIFF u)`] THEN + MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`convex hull {a:real^2,b,c}`; `convex hull{a:real^2,b}`] + FACE_OF_STILLCONVEX) THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC(TAUT + `p ==> (p <=> q /\ r /\ s) ==> r`) THEN + ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN + EXISTS_TAC `{a:real^2,b}` THEN SET_TAC[]; + MP_TAC(ISPECL [`convex hull {a:real^2,b,c}`; `convex hull{b:real^2,c}`] + FACE_OF_STILLCONVEX) THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC(TAUT + `p ==> (p <=> q /\ r /\ s) ==> r`) THEN + ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN + EXISTS_TAC `{b:real^2,c}` THEN SET_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `?n:real^2. + ~(n = vec 0) /\ orthogonal n (c - a) /\ + &0 < n dot (c - b)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `?n:real^2. ~(n = vec 0) /\ orthogonal n (c - a)` + STRIP_ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN + MATCH_MP_TAC ORTHOGONAL_TO_VECTOR_EXISTS THEN + REWRITE_TAC[DIMINDEX_2; LE_REFL]; + ALL_TAC] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH + `&0 < n dot (c - b) \/ &0 < --(n dot (c - b)) \/ + (n:real^2) dot (c - b) = &0`) + THENL + [EXISTS_TAC `n:real^2` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `--n:real^2` THEN ASM_REWRITE_TAC[DOT_LNEG] THEN + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; ORTHOGONAL_LNEG]; + UNDISCH_TAC `~collinear{a:real^2,b,c}` THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + MATCH_MP_TAC ORTHOGONAL_TO_ORTHOGONAL_2D THEN + EXISTS_TAC `n:real^2` THEN + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_RNEG] THEN + ASM_REWRITE_TAC[VECTOR_NEG_SUB] THEN + ASM_REWRITE_TAC[orthogonal]]; + ALL_TAC] THEN + SUBGOAL_THEN `n dot (a - b:real^2) = n dot (c - b)` ASSUME_TAC THENL + [REWRITE_TAC[DOT_RSUB; real_sub; REAL_EQ_ADD_RCANCEL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x = y <=> y - x = &0`] THEN + ASM_REWRITE_TAC[GSYM DOT_RSUB; GSYM orthogonal]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y:real^2. y IN convex hull {a,b,c} /\ ~(y = b) ==> &0 < n dot (y - b)` + ASSUME_TAC THENL + [REWRITE_TAC[CONVEX_HULL_3_ALT; FORALL_IN_GSPEC; IMP_CONJ] THEN + REWRITE_TAC[VECTOR_ARITH + `(a + u % (b - a) + v % (c - a)) - b = + (&1 - u - v) % (a - b) + v % (c - b)`] THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + MAP_EVERY X_GEN_TAC [`r:real`; `s:real`] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `(&1 - u - v) * x + v * x = (&1 - u) * x`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `r = &1 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + UNDISCH_TAC `~(a + r % (b - a) + s % (c - a):real^2 = b)` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_SUB_LT] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!y:real^2. y IN convex hull {a,b,c} ==> &0 <= n dot (y - b)` + ASSUME_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `y:real^2 = b` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO; REAL_LE_REFL] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y:real^2. y IN convex hull {a,b,c} ==> n dot (y - b) <= n dot (c - b)` + ASSUME_TAC THENL + [REWRITE_TAC[CONVEX_HULL_3_ALT; FORALL_IN_GSPEC] THEN + REWRITE_TAC[VECTOR_ARITH + `(a + u % (b - a) + v % (c - a)) - b = + (&1 - u - v) % (a - b) + v % (c - b)`] THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL; REAL_ARITH + `(&1 - u - v) * x + v * x <= x <=> &0 <= u * x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\x:real^2. n dot (x - b)`; + `path_image (polygonal_path(CONS c p)) INTER convex hull {a:real^2,b,c}`] + CONTINUOUS_ATTAINS_INF) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_INTER THEN + SIMP_TAC[COMPACT_PATH_IMAGE; PATH_POLYGONAL_PATH] THEN + SIMP_TAC[COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; + FINITE_INSERT; FINITE_EMPTY]; + ASM SET_TAC[]; + SUBGOAL_THEN + `(\x:real^2. n dot (x - b)) = (\x. n dot x) o (\x. x - b)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `?mx:real^2. + ~(mx = a) /\ ~(mx = c) /\ + mx IN path_image(polygonal_path(CONS c p)) INTER convex hull {a, b, c} /\ + (!y. y IN + path_image(polygonal_path(CONS c p)) INTER convex hull {a, b, c} + ==> n dot (mx - b) <= n dot (y - b))` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `mx:real^2` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `n dot (mx - b:real^2) <= n dot (c - b)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL + [EXISTS_TAC `mx:real^2` THEN ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN + UNDISCH_TAC `~(path_image(polygonal_path(CONS c p)) INTER + convex hull {a, b, c} SUBSET {a:real^2, c})` THEN + REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP; IN_INSERT; NOT_IN_EMPTY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `my:real^2` THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `n dot (mx - b:real^2)` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; + FIRST_X_ASSUM(CHOOSE_THEN (K ALL_TAC))] THEN + ABBREV_TAC `m = (n:real^2) dot (mx - b)` THEN + SUBGOAL_THEN `&0 < m` ASSUME_TAC THENL + [EXPAND_TAC "m" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST_ALL_TAC] THEN + UNDISCH_TAC + `segment[b:real^2,c] INTER path_image (polygonal_path (CONS c p)) + SUBSET {c}` THEN + REWRITE_TAC[SUBSET; IN_INTER] THEN + DISCH_THEN(MP_TAC o SPEC `b:real^2`) THEN + ASM_REWRITE_TAC[IN_SING; ENDS_IN_SEGMENT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?z:real^2. MEM z p /\ + z IN (convex hull {a,b,c} DIFF {a,c}) /\ + n dot (z - b) = m` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + MAP_EVERY EXISTS_TAC [`b:real^2`; `z:real^2`] THEN + ASM_REWRITE_TAC[MEM] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; DISCH_TAC] THEN + X_GEN_TAC `w:real^2` THEN DISCH_TAC THEN + MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN + EXISTS_TAC `d:real^2` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(z:real^2 = a) /\ ~(z = c)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(z:real^2) IN path_image(polygonal_path(CONS c p)) /\ + (z:real^2) IN path_image(polygonal_path p)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN + ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM]; + ALL_TAC] THEN + SUBGOAL_THEN `~(z IN segment[a:real^2,b]) /\ ~(z IN segment[b,c])` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~collinear{b:real^2,a,z} /\ ~collinear{b,c,z}` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN + MATCH_MP_TAC(SET_RULE + `!c. x IN c /\ ~(x IN (a INTER c)) /\ ~(x IN (b INTER c)) + ==> ~(x IN a) /\ ~(x IN b)`) THEN + EXISTS_TAC `convex hull {a:real^2,b,c}` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL; + INSERT_SUBSET; EMPTY_SUBSET; IN_INSERT] THEN + ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `segment(b:real^2,z) INTER segment[a,b] = {} /\ + segment(b,z) INTER segment[b,c] = {}` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + CONJ_TAC THEN X_GEN_TAC `v:real^2` THEN STRIP_TAC THENL + [UNDISCH_TAC `~collinear{b:real^2,a,z}`; + UNDISCH_TAC `~collinear{b:real^2,c,z}`] THEN + REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN + MATCH_MP_TAC COLLINEAR_3_TRANS THEN + EXISTS_TAC `v:real^2` THEN + UNDISCH_TAC `v IN segment(b:real^2,z)` THEN + REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[DE_MORGAN_THM; IMP_CONJ] THENL + [UNDISCH_TAC `v IN segment[a:real^2,b]`; + UNDISCH_TAC `v IN segment[b:real^2,c]`] THEN + ONCE_REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN + REWRITE_TAC[INSERT_AC] THEN SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `segment[b:real^2,z] SUBSET convex hull {a,b,c}` + ASSUME_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONVEX_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN + SIMP_TAC[HULL_INC; IN_INSERT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `segment(b:real^2,z) SUBSET convex hull {a,b,c}` + ASSUME_TAC THENL + [REWRITE_TAC[open_segment] THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `segment(b:real^2,z) INTER path_image(polygonal_path(CONS c p)) = {}` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `v:real^2` THEN STRIP_TAC THEN + SUBGOAL_THEN `m <= n dot (v - b:real^2)` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LE] THEN + UNDISCH_TAC `v IN segment(b:real^2,z)` THEN REWRITE_TAC[IN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[DOT_RMUL; VECTOR_ARITH + `((&1 - t) % a + t % b) - a:real^N = t % (b - a)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `t * m < m <=> &0 < m * (&1 - t)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT]; + ALL_TAC] THEN + SUBGOAL_THEN `segment(b:real^2,z) SUBSET interior(convex hull {a,b,c})` + ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `(convex hull {a:real^2,b,c}) DIFF frontier(convex hull {a,b,c})` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `s SUBSET u ==> s DIFF (u DIFF t) SUBSET t`) THEN + REWRITE_TAC[CLOSURE_SUBSET]] THEN + REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN MATCH_MP_TAC(SET_RULE + `s INTER a = {} /\ s INTER b = {} /\ s INTER c = {} /\ s SUBSET u + ==> s SUBSET u DIFF (a UNION b UNION c)`) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `v:real^2` THEN REWRITE_TAC[IN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^2. n dot (x - b)`) THEN + REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % c + u % a) - b = + (&1 - u) % (c - b) + u % (a - b)`] THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < m * (&1 - t) /\ m <= x ==> ~((&1 - s) * x + s * x = t * m)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[IN_INTER; IN_INSERT; HULL_INC] THEN MATCH_MP_TAC + (REWRITE_RULE[SUBSET] VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN + REWRITE_TAC[set_of_list; IN_INSERT]; + ALL_TAC] THEN + SUBGOAL_THEN + `?y:real^2. y IN segment(b,z) /\ y IN interior(convex hull {a',b,c'})` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[INTER; GSYM(ASSUME + `interior(convex hull {a, b, c}) INTER {x:real^2 | x$2 - b$2 < e} = + interior(convex hull {a', b, c'})`)] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE + `(?y. y IN s /\ P y) /\ s SUBSET t + ==> ?y. y IN s /\ y IN t /\ P y`) THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC + `b + min (&1 / &2) (e / &2 / norm(z - b)) % (z - b):real^2` THEN + CONJ_TAC THENL + [EXISTS_TAC `min (&1 / &2) (e / &2 / norm (z - b:real^2))` THEN + REPEAT CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC; VECTOR_ARITH_TAC] THEN + REWRITE_TAC[REAL_LT_MIN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; + REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_ADD_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x$2) <= norm x /\ norm x <= e / &2 /\ &0 < e ==> x$2 < e`) THEN + SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_2; ARITH] THEN + ASM_REWRITE_TAC[NORM_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(min (&1 / &2) x) <= x`) THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_DIV THEN + ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ]]; + ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `y:real^2` THEN + CONJ_TAC THENL + [REWRITE_TAC[connected_component] THEN + EXISTS_TAC `interior(convex hull {a':real^2,b,c'})` THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERIOR; CONVEX_CONVEX_HULL] THEN + SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF (a UNION b UNION c) <=> + s INTER a = {} /\ s INTER b = {} /\ s INTER c = {}`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ t INTER u = {} ==> s INTER u = {}`) THEN + EXISTS_TAC `interior(convex hull {a:real^2,b,c})` THEN + ASM_SIMP_TAC[SUBSET_INTERIOR] THEN + MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`] + FRONTIER_OF_TRIANGLE) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; frontier] THEN + MATCH_MP_TAC(SET_RULE + `!s. i SUBSET s /\ s SUBSET c + ==> c DIFF i = a UNION b ==> i INTER a = {}`) THEN + EXISTS_TAC `convex hull {a:real^2,b,c}` THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]; + MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ t INTER u = {} ==> s INTER u = {}`) THEN + EXISTS_TAC `interior(convex hull {a:real^2,b,c})` THEN + ASM_SIMP_TAC[SUBSET_INTERIOR] THEN + MP_TAC(ISPECL [`a:real^2`; `b:real^2`; `c:real^2`] + FRONTIER_OF_TRIANGLE) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; frontier] THEN + MATCH_MP_TAC(SET_RULE + `!s. i SUBSET s /\ s SUBSET c + ==> c DIFF i = a UNION b UNION d ==> i INTER b = {}`) THEN + EXISTS_TAC `convex hull {a:real^2,b,c}` THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]; + MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ u INTER t = {} ==> s INTER u = {}`) THEN + EXISTS_TAC `{x | (x:real^2)$2 - (b:real^2)$2 < e}` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; REAL_NOT_LT; IN_UNIV] THEN + MP_TAC(ISPEC `CONS (c:real^2) p` + PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL) THEN + REWRITE_TAC[NOT_CONS_NIL] THEN + MATCH_MP_TAC(SET_RULE + `t SUBSET {x | P x} ==> s SUBSET t ==> !x. x IN s ==> P x`) THEN + REWRITE_TAC[REAL_ARITH `e <= x - b <=> x >= b + e`] THEN + SIMP_TAC[SUBSET_HULL; CONVEX_HALFSPACE_COMPONENT_GE] THEN + REWRITE_TAC[set_of_list; REAL_ARITH `x >= b + e <=> e <= x - b`] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[SUBSET; IN_SET_OF_LIST; IN_ELIM_THM]]; + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `segment(b:real^2,z)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CONNECTED_SEGMENT] THEN + SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN ASM SET_TAC[]]] THEN + SUBGOAL_THEN + `?u v:real^2. + MEM u (CONS c p) /\ MEM v (CONS c p) /\ + mx IN segment[u,v] /\ + segment[u,v] SUBSET path_image(polygonal_path(CONS c p)) /\ + ~(a IN segment[u,v] /\ c IN segment[u,v]) /\ + n dot (u - b) <= m` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`CONS (c:real^2) p`; `mx:real^2`] + PATH_IMAGE_POLYGONAL_PATH_SUBSET_SEGMENTS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[LENGTH; ARITH_RULE `3 <= SUC n <=> 2 <= n`] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN + ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN + ASM_REWRITE_TAC[NOT_CONS_NIL; LAST; HD] THEN STRIP_TAC THEN + SUBGOAL_THEN `n dot (u - b) <= m \/ n dot (v - b:real^2) <= m` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_NOT_LT; GSYM DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `n dot (mx - b:real^2) = m` THEN + UNDISCH_TAC `(mx:real^2) IN segment[u,v]` THEN + REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % x + u % y) - a:real^N = + (&1 - u) % (x - a) + u % (y - a)`] THEN + MATCH_MP_TAC(REAL_ARITH `--x < --m ==> ~(x = m)`) THEN + REWRITE_TAC[GSYM DOT_LNEG] THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN ASM_REAL_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`u:real^2`; `v:real^2`] THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`v:real^2`; `u:real^2`] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `n dot (u - b:real^2) < n dot (c - b)` THENL + [SUBGOAL_THEN `~(u:real^2 = a) /\ ~(u = c)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN + UNDISCH_TAC `MEM (u:real^2) (CONS c p)` THEN + ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN EXISTS_TAC `u:real^2` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `mx:real^2 = u` THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] + VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN + ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`segment(u:real^2,mx)`; `convex hull {a:real^2,b,c}`] + CONNECTED_INTER_FRONTIER) THEN + REWRITE_TAC[CONNECTED_SEGMENT] THEN MATCH_MP_TAC(SET_RULE + `(s SUBSET c ==> u IN c) /\ s INTER f = {} /\ ~(s INTER c = {}) + ==> (~(s INTER c = {}) /\ ~(s DIFF c = {}) ==> ~(s INTER f = {})) + ==> u IN c`) THEN + REPEAT CONJ_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `closure(segment(u:real^2,mx)) SUBSET convex hull {a,b,c}` + MP_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONVEX_HULL THEN + SIMP_TAC[FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; + ASM_REWRITE_TAC[SUBSET; CLOSURE_SEGMENT] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ENDS_IN_SEGMENT]]; + REWRITE_TAC[FRONTIER_OF_TRIANGLE] THEN + MATCH_MP_TAC(SET_RULE + `!a b c t u. + s SUBSET t /\ t SUBSET u /\ + a IN ca /\ c IN ca /\ + ab INTER u SUBSET {a,b} /\ bc INTER u SUBSET {c} /\ + ~(b IN u) /\ s INTER ca = {} + ==> s INTER (ab UNION bc UNION ca) = {}`) THEN + MAP_EVERY EXISTS_TAC + [`a:real^2`; `b:real^2`; `c:real^2`; `segment[u:real^2,v]`; + `path_image(polygonal_path(CONS (c:real^2) p))`] THEN + ASM_REWRITE_TAC[ENDS_IN_SEGMENT; SUBSET_SEGMENT] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `CONS (c:real^2) p` + PATH_IMAGE_POLYGONAL_PATH_SUBSET_CONVEX_HULL) THEN + REWRITE_TAC[NOT_CONS_NIL] THEN MATCH_MP_TAC(SET_RULE + `~(x IN t) ==> s SUBSET t ==> ~(x IN s)`) THEN + MATCH_MP_TAC(SET_RULE + `!t. ~(b IN t) /\ s SUBSET t ==> ~(b IN s)`) THEN + EXISTS_TAC `{x:real^2 | (x:real^2)$2 >= (b:real^2)$2 + e}` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; real_ge; REAL_NOT_LE; REAL_LT_ADDR] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[GSYM real_ge; CONVEX_HALFSPACE_COMPONENT_GE] THEN + REWRITE_TAC[SUBSET; set_of_list; FORALL_IN_INSERT; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[IN_SET_OF_LIST; REAL_ARITH + `x >= b + e <=> e <= x - b`]; + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real^2` THEN REWRITE_TAC[IN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^2. n dot (x - b)`) THEN + REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % c + u % a) - b = + (&1 - u) % (c - b) + u % (a - b)`] THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN MATCH_MP_TAC(REAL_ARITH + `(&1 - t) * a < (&1 - t) * m /\ t * b <= t * m + ==> ~((&1 - s) * m + s * m = (&1 - t) * a + t * b)`) THEN + ASM_SIMP_TAC[REAL_LT_LMUL; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN + SIMP_TAC[IN_INTER; HULL_INC; IN_INSERT] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] + VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN + REWRITE_TAC[set_of_list; IN_INSERT]]; + ALL_TAC] THEN + ASM_CASES_TAC `mx IN interior(convex hull {a:real^2,b,c})` THENL + [UNDISCH_TAC `mx IN interior(convex hull {a:real^2,b,c})` THEN + REWRITE_TAC[IN_INTERIOR_CBALL; SUBSET; IN_CBALL] THEN + DISCH_THEN(X_CHOOSE_THEN `ee:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN + REWRITE_TAC[MESON[] + `(?x. (?u. P u /\ Q u /\ x = f u) /\ R x) <=> + (?u. P u /\ Q u /\ R(f u))`] THEN + EXISTS_TAC `min (&1 / &2) (ee / norm(u - mx:real^2))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < min (&1 / &2) x`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; + REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[dist; VECTOR_ARITH + `a - ((&1 - u) % a + u % b):real^N = u % (a - b)`] THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; + VECTOR_SUB_EQ] THEN + REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < x ==> abs(min (&1 / &2) x) <= x`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]; + ALL_TAC] THEN + MP_TAC(ISPEC `{a:real^2,b,c}` AFFINE_INDEPENDENT_SPAN_EQ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DIMINDEX_2] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + REWRITE_TAC[AFFINE_HULL_3; IN_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC `u:real^2`) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`r:real`; `s:real`; `t:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `mx IN convex hull {a:real^2,b,c}` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REWRITE_TAC[CONVEX_HULL_3] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + REWRITE_TAC[IN_INTER; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`rx:real`; `sx:real`; `tx:real`] THEN + ASM_CASES_TAC `rx = &0` THENL + [ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_LID] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN STRIP_TAC THEN + UNDISCH_TAC + `segment[b:real^2,c] INTER path_image(polygonal_path(CONS c p)) + SUBSET {c}` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `mx:real^2`) THEN + MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN + REWRITE_TAC[IN_SING] THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_INTER; SEGMENT_CONVEX_HULL] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[CONVEX_HULL_2; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `rx = &1` THENL + [ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `sx = &0 /\ tx = &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_RID]; + ALL_TAC] THEN + ASM_CASES_TAC `tx = &0` THENL + [ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_RID] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN STRIP_TAC THEN + UNDISCH_TAC + `segment[a:real^2,b] INTER path_image(polygonal_path(CONS c p)) + SUBSET {a,b}` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `mx:real^2`) THEN + MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST_ALL_TAC] THEN + UNDISCH_TAC `n dot (b - b:real^2) = m` THEN + REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_INTER; SEGMENT_CONVEX_HULL] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[CONVEX_HULL_2; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `tx = &1` THENL + [ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `sx = &0 /\ rx = &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID]; + ALL_TAC] THEN + ASM_CASES_TAC `sx = &1` THENL + [ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `rx = &0 /\ tx = &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; + VECTOR_ADD_RID] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `n dot (b - b:real^2) = m` THEN + REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `sx = &0` THENL + [ALL_TAC; + STRIP_TAC THEN + UNDISCH_TAC `~(mx IN interior(convex hull {a:real^2, b, c}))` THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`rx:real`; `sx:real`; `tx:real`] THEN + REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN + UNDISCH_THEN `sx = &0` SUBST_ALL_TAC THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_ADD_LID] THEN STRIP_TAC THEN + SUBGOAL_THEN + `&0 < rx /\ rx < &1 /\ &0 < tx /\ tx < &1` + STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_SEGMENT] THEN + SUBGOAL_THEN + `?q. q * (rx - r) <= rx /\ + q * (tx - t) <= tx /\ + &0 < q /\ q < &1` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC + `min (&1 / &2) + (min (if rx:real = r then &1 / &2 else rx / abs(rx - r)) + (if tx:real = t then &1 / &2 else tx / abs(tx - t)))` THEN + REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REPEAT CONJ_TAC THENL + [ASM_CASES_TAC `r:real = rx` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH + `~(x = y) ==> &0 < abs(x - y)`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= a /\ &0 <= x /\ &0 <= b ==> abs(min a (min x b)) <= x`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ASM_CASES_TAC `t:real = tx` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH + `~(x = y) ==> &0 < abs(x - y)`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= a /\ &0 <= x /\ &0 <= b ==> abs(min a (min b x)) <= x`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_ABS_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; + COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`(&1 - q) * rx + q * r`; + `q * s:real`; + `(&1 - q) * tx + q * t:real`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC] THEN + REWRITE_TAC[REAL_ARITH + `((&1 - q) * rx + q * r) + + q * s + + ((&1 - q) * tx + q * t) = + (rx + tx) + q * ((r + s + t) - (rx + tx))`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_ARITH + `&0 <= (&1 - q) * r + q * s <=> q * (r - s) <= r`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + UNDISCH_TAC `n dot (u - b:real^2) < n dot (c - b)` THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `(r % a + s % b + t % c) - b = + r % (a - b) + t % (c - b) + ((r + s + t) - &1) % b`] THEN + REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + REWRITE_TAC[REAL_ARITH + `r * x + s * x < x <=> &0 < (&1 - r - s) * x`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n dot (u - b) = m /\ n dot (c - b) = m` MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `!mx. n dot (u - b) <= m /\ + ~(n dot (u - b) < n dot (c - b)) /\ + n dot (mx - b) = m /\ + n dot (mx - b) <= n dot (c - b) + ==> n dot (u - b) = m /\ n dot (c - b) = m`) THEN + EXISTS_TAC `mx:real^2` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[IN_INTER; HULL_INC; IN_INSERT] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] + VERTICES_IN_PATH_IMAGE_POLYGONAL_PATH) THEN + REWRITE_TAC[set_of_list; IN_INSERT]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN + (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THEN + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) [`m <= m`; `~(m < m)`] THEN + SUBGOAL_THEN + `collinear {a:real^2,mx,c} /\ collinear {a,u,c}` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `!y:real^2. n dot (y - b) = m ==> collinear {a,y,c}` + (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN ASM_REWRITE_TAC[]) THEN + X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + MATCH_MP_TAC ORTHOGONAL_TO_ORTHOGONAL_2D THEN + EXISTS_TAC `n:real^2` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_RNEG] THEN + ASM_REWRITE_TAC[VECTOR_NEG_SUB] THEN + MAP_EVERY UNDISCH_TAC + [`n dot (y - b:real^2) = m`; `n dot (c - b:real^2) = m`] THEN + REWRITE_TAC[orthogonal; DOT_RSUB] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `mx:real^2 = u` THENL + [UNDISCH_THEN `mx:real^2 = u` SUBST_ALL_TAC THEN + UNDISCH_TAC `MEM (u:real^2) (CONS c p)` THEN + ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN EXISTS_TAC `u:real^2` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `mx:real^2 = v` THENL + [UNDISCH_THEN `mx:real^2 = v` SUBST_ALL_TAC THEN + UNDISCH_TAC `MEM (v:real^2) (CONS c p)` THEN + ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN EXISTS_TAC `v:real^2` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `collinear {a:real^2,c,mx,u}` ASSUME_TAC THENL + [ASM_SIMP_TAC[COLLINEAR_4_3] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,c,b} = {a,b,c}`] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `collinear {a:real^2,u,v}` ASSUME_TAC THENL + [MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `mx:real^2` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `{a:real^2,c,mx,u}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN + ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]]; + ALL_TAC] THEN + SUBGOAL_THEN `collinear {c:real^2,u,v}` ASSUME_TAC THENL + [MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `mx:real^2` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `{a:real^2,c,mx,u}` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN + ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]]; + ALL_TAC] THEN + ASM_CASES_TAC `u:real^2 = v` THENL + [UNDISCH_THEN `u:real^2 = v` SUBST_ALL_TAC THEN + ASM_MESON_TAC[SEGMENT_REFL; IN_SING]; + ALL_TAC] THEN + SUBGOAL_THEN `collinear {a:real^2,v,c}` ASSUME_TAC THENL + [MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `u:real^2` THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN + ASM_REWRITE_TAC[INSERT_AC]; + ALL_TAC] THEN + MP_TAC(ISPECL [`a:real^2`; `c:real^2`; `u:real^2`; `v:real^2`; + `mx:real^2`] between_lemma) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN SUBST1_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + MP_TAC(ISPECL [`{a:real^2,b,c}`; `{a:real^2,c}`] + AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL) THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL] THEN + MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `{a:real^2,c,mx,u}` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]]; + ALL_TAC] THEN + STRIP_TAC THENL + [EXISTS_TAC `u:real^2` THEN + MP_TAC(ASSUME `u IN segment(a:real^2,c)`) THEN + REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `MEM (u:real^2) (CONS c p)` THEN + ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(u:real^2) IN segment[a,c]` THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + SPEC_TAC(`u:real^2`,`u:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + EXISTS_TAC `v:real^2` THEN + MP_TAC(ASSUME `v IN segment(a:real^2,c)`) THEN + REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `MEM (v:real^2) (CONS c p)` THEN + ASM_REWRITE_TAC[MEM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [UNDISCH_TAC `(v:real^2) IN segment[a,c]` THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + SPEC_TAC(`v:real^2`,`v:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + UNDISCH_TAC `collinear {a:real^2, v, c}` THEN + ONCE_REWRITE_TAC[SET_RULE `{a,v,c} = {a,c,v}`] THEN + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN + REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH + `(u % a + v % c) - b:real^N = + u % (a - b) + v % (c - b) + ((u + v) - &1) % b`] THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL; REAL_SUB_REFL] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM REAL_ADD_RDISTRIB; + REAL_MUL_LID]]; + UNDISCH_TAC `segment[a:real^2,c] SUBSET segment[u,v]` THEN + ASM_REWRITE_TAC[SUBSET_SEGMENT]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the final Pick theorem by induction on number of polygon segments. *) +(* ------------------------------------------------------------------------- *) + +let PICK = prove + (`!p:(real^2)list. + (!x. MEM x p ==> integral_vector x) /\ + simple_path (polygonal_path p) /\ + pathfinish (polygonal_path p) = pathstart (polygonal_path p) + ==> measure(inside(path_image(polygonal_path p))) = + &(CARD {x | x IN inside(path_image(polygonal_path p)) /\ + integral_vector x}) + + &(CARD {x | x IN path_image(polygonal_path p) /\ + integral_vector x}) / &2 - &1`, + GEN_TAC THEN WF_INDUCT_TAC `LENGTH(p:(real^2)list)` THEN DISJ_CASES_TAC + (ARITH_RULE `LENGTH(p:(real^2)list) <= 4 \/ 5 <= LENGTH p`) THENL + [UNDISCH_TAC `LENGTH(p:(real^2)list) <= 4` THEN + POP_ASSUM(K ALL_TAC) THEN SPEC_TAC(`p:(real^2)list`,`p:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; SIMPLE_PATH_LINEPATH_EQ] THEN + X_GEN_TAC `a:real^2` THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[polygonal_path; SIMPLE_PATH_LINEPATH_EQ] THEN + X_GEN_TAC `b:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL + [REWRITE_TAC[polygonal_path; SIMPLE_PATH_LINEPATH_EQ; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `c:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL + [REPLICATE_TAC 4 (DISCH_THEN(K ALL_TAC)) THEN + REWRITE_TAC[polygonal_path] THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + ASM_CASES_TAC `c:real^2 = a` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + REWRITE_TAC[ARC_LINEPATH_EQ] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + SUBST1_TAC(ISPECL [`b:real^2`; `a:real^2`] (CONJUNCT1 SEGMENT_SYM)) THEN + REWRITE_TAC[INTER_IDEMPOT] THEN DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[FINITE_SEGMENT; FINITE_INSERT; FINITE_EMPTY]; + ALL_TAC] THEN + X_GEN_TAC `d:real^2` THEN MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL + [REPLICATE_TAC 5 (DISCH_THEN(K ALL_TAC)); + REWRITE_TAC[LENGTH; ARITH_RULE `~(SUC(SUC(SUC(SUC(SUC n)))) <= 4)`]] THEN + REWRITE_TAC[polygonal_path; PATHSTART_JOIN; PATHFINISH_JOIN] THEN + REWRITE_TAC[GSYM IN_SET_OF_LIST; set_of_list] THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_CASES_TAC `d:real^2 = a` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; + ARC_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN REWRITE_TAC[INSIDE_OF_TRIANGLE] THEN + REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE] THEN + SIMP_TAC[MEASURE_INTERIOR; NEGLIGIBLE_CONVEX_FRONTIER; + CONVEX_CONVEX_HULL; FINITE_IMP_BOUNDED_CONVEX_HULL; + FINITE_INSERT; FINITE_EMPTY] THEN + ASM_SIMP_TAC[PICK_TRIANGLE] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARC_LINEPATH_EQ] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[UNION_OVER_INTER] THEN + REWRITE_TAC[UNION_SUBSET] THEN STRIP_TAC THEN + SUBGOAL_THEN + `segment[b:real^2,c] INTER segment [c,a] = segment[b,c] \/ + segment[b,c] INTER segment [c,a] = segment[c,a] \/ + segment[a,b] INTER segment [b,c] = segment[b,c]` + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`; + SET_RULE `s INTER t = t <=> t SUBSET s`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_BETWEEN_CASES]) THEN + REWRITE_TAC[SUBSET_SEGMENT; BETWEEN_IN_SEGMENT; ENDS_IN_SEGMENT] THEN + REWRITE_TAC[SEGMENT_SYM; DISJ_ACI]; + UNDISCH_TAC `segment [b,c] SUBSET {c:real^2}`; + UNDISCH_TAC `segment [c,a] SUBSET {c:real^2}`; + UNDISCH_TAC `segment [b,c] SUBSET {a:real^2, b}`] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[FINITE_SEGMENT; FINITE_INSERT; FINITE_EMPTY]; + STRIP_TAC] THEN + MP_TAC(ISPEC `p:(real^2)list` POLYGON_CHOP_IN_TWO) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^2`;`b:real^2`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `?p':(real^2)list. + HD p' = a /\ + LENGTH p' = LENGTH p /\ + path_image(polygonal_path p') = path_image(polygonal_path p) /\ + set_of_list p' = set_of_list p /\ + simple_path(polygonal_path p') /\ + pathfinish(polygonal_path p') = pathstart(polygonal_path p')` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ROTATE_LIST_TO_FRONT_0 THEN + EXISTS_TAC `p:(real^2)list` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[ARITH_RULE `5 <= p ==> 3 <= p`] THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LENGTH] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY UNDISCH_TAC + [`pathfinish(polygonal_path(p:(real^2)list)) = + pathstart(polygonal_path p)`; + `5 <= LENGTH(p:(real^2)list)`] THEN + ASM_CASES_TAC `p:(real^2)list = []` THEN + ASM_REWRITE_TAC[LENGTH; ARITH] THEN + ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; PATHFINISH_POLYGONAL_PATH] THEN + DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `l:(real^2)list` THEN + REWRITE_TAC[APPEND_EQ_NIL; NOT_CONS_NIL] THEN + ASM_CASES_TAC `l:(real^2)list = []` THENL + [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(TL l:(real^2)list = [])` ASSUME_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `LENGTH:(real^2)list->num`) THEN + ASM_SIMP_TAC[LENGTH; LENGTH_TL] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[LAST_APPEND; LENGTH_APPEND; LENGTH_TL; NOT_CONS_NIL] THEN + ASM_REWRITE_TAC[LAST; HD_APPEND; LENGTH] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC PATH_IMAGE_POLYGONAL_PATH_ROTATE THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + MAP_EVERY UNDISCH_TAC + [`HD(l:(real^2)list) = LAST l`; `5 <= LENGTH(p:(real^2)list)`; + `~(l:(real^2)list = [])`] THEN + ASM_REWRITE_TAC[] THEN + SPEC_TAC(`l:(real^2)list`,`l:(real^2)list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[HD; TL; APPEND] THEN + REWRITE_TAC[SET_OF_LIST_APPEND; set_of_list] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `a IN s /\ b IN s ==> s UNION {a} = b INSERT s`) THEN + ASM_REWRITE_TAC[LAST] THEN ONCE_ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LAST] THEN UNDISCH_TAC `5 <= LENGTH(CONS (h:real^2) t)` THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH] THEN + REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL; LENGTH] THEN + DISCH_TAC THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[EL] THEN ASM_ARITH_TAC; + EXISTS_TAC `LENGTH(t:(real^2)list) - 1` THEN + ASM_SIMP_TAC[LAST_EL] THEN ASM_ARITH_TAC]; + MP_TAC(ISPEC `l:(real^2)list` SIMPLE_PATH_POLYGONAL_PATH_ROTATE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:real^2. MEM x p <=> MEM x p'` + (fun th -> REWRITE_TAC[th] THEN + RULE_ASSUM_TAC(REWRITE_RULE[th])) + THENL [ASM_REWRITE_TAC[GSYM IN_SET_OF_LIST]; ALL_TAC] THEN + MAP_EVERY (C UNDISCH_THEN (SUBST_ALL_TAC o SYM)) + [`set_of_list(p':(real^2)list) = set_of_list p`; + `path_image(polygonal_path(p':(real^2)list)) = + path_image (polygonal_path p)`; + `LENGTH(p':(real^2)list) = LENGTH(p:(real^2)list)`] THEN + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) + [`simple_path(polygonal_path(p:(real^2)list))`; + `pathfinish(polygonal_path(p:(real^2)list)) = + pathstart(polygonal_path p)`] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`p':(real^2)list`,`p:(real^2)list`) THEN + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `?q r. 2 <= LENGTH q /\ 2 <= LENGTH r /\ + LENGTH q + LENGTH r = LENGTH p + 1 /\ + set_of_list q UNION set_of_list r = set_of_list p /\ + pathstart(polygonal_path q) = pathstart(polygonal_path p) /\ + pathfinish(polygonal_path q) = (b:real^2) /\ + pathstart(polygonal_path r) = b /\ + pathfinish(polygonal_path r) = pathfinish(polygonal_path p) /\ + simple_path(polygonal_path q ++ polygonal_path r) /\ + path_image(polygonal_path q ++ polygonal_path r) = + path_image(polygonal_path p)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `simple_path(polygonal_path p) /\ + 2 <= LENGTH p /\ MEM (b:real^2) p /\ + ~(pathstart(polygonal_path p) = b) /\ + ~(pathfinish(polygonal_path p) = b)` + MP_TAC THENL + [ASM_SIMP_TAC[ARITH_RULE `5 <= p ==> 2 <= p`] THEN + ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; CONJ_ASSOC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MEM]; + POP_ASSUM_LIST(K ALL_TAC)] THEN + WF_INDUCT_TAC `LENGTH(p:(real^2)list)` THEN POP_ASSUM MP_TAC THEN + SPEC_TAC(`p:(real^2)list`,`p:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a:real^2` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `x:real^2` THEN + MATCH_MP_TAC list_INDUCT THEN CONJ_TAC THENL + [REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + MEM] THEN + MESON_TAC[]; + REWRITE_TAC[LENGTH; ARITH]] THEN + MAP_EVERY X_GEN_TAC [`y:real^2`; `l:(real^2)list`] THEN + REPLICATE_TAC 3 (DISCH_THEN(K ALL_TAC)) THEN DISCH_TAC THEN + REWRITE_TAC[polygonal_path] THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ONCE_REWRITE_TAC[MEM] THEN + ASM_CASES_TAC `a:real^2 = b` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[MEM] THEN + ASM_CASES_TAC `x:real^2 = b` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl) THEN STRIP_TAC THEN + EXISTS_TAC `[a:real^2;b]` THEN + EXISTS_TAC `CONS (b:real^2) (CONS y l)` THEN + ASM_REWRITE_TAC[polygonal_path; LENGTH] THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REPEAT(CONJ_TAC THENL [ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[set_of_list] THEN SET_TAC[]; + ALL_TAC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CONS (x:real^2) (CONS y l)`) THEN + REWRITE_TAC[LENGTH; ARITH_RULE `n < SUC n`] THEN ANTS_TAC THENL + [REWRITE_TAC[ARITH_RULE `2 <= SUC(SUC n)`] THEN + ONCE_REWRITE_TAC[MEM] THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SIMPLE_PATH_JOIN_IMP)) THEN + ASM_REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + SIMP_TAC[PATHFINISH_LINEPATH; ARC_IMP_SIMPLE_PATH]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`q:(real^2)list`; `r:(real^2)list`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`CONS (a:real^2) q`; `r:(real^2)list`] THEN + ASM_REWRITE_TAC[LENGTH; NOT_CONS_NIL; HD] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[set_of_list; SET_RULE + `(a INSERT s) UNION t = a INSERT (s UNION t)`]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]; + ALL_TAC] THEN + CONJ_TAC THENL + [UNDISCH_TAC `pathfinish(polygonal_path q) = (b:real^2)` THEN + REWRITE_TAC[PATHFINISH_POLYGONAL_PATH; LAST; NOT_CONS_NIL] THEN + UNDISCH_TAC `2 <= LENGTH(q:(real^2)list)` THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN + `polygonal_path(CONS (a:real^2) q) = + linepath(a,x) ++ polygonal_path q` + SUBST1_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`pathstart(polygonal_path q) = + pathstart(polygonal_path (CONS (x:real^2) (CONS y l)))`; + `2 <= LENGTH(q:(real^2)list)`] THEN + SPEC_TAC(`q:(real^2)list`,`q:(real^2)list`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[LENGTH; ARITH; polygonal_path] THEN + SIMP_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]; + ALL_TAC] THEN + SUBGOAL_THEN + `pathstart(polygonal_path(CONS x (CONS y l))) = (x:real^2)` + (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THENL + [REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD]; ALL_TAC] THEN + CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) SIMPLE_PATH_ASSOC o snd) THEN + ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH; NOT_CONS_NIL; HD] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + UNDISCH_TAC `simple_path(linepath(a:real^2,x) ++ + polygonal_path (CONS x (CONS y l)))` THEN + ASM_CASES_TAC `pathfinish(polygonal_path r) = (a:real^2)` THENL + [SUBGOAL_THEN + `pathfinish(polygonal_path(CONS (x:real^2) (CONS y l))) = a` + ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHFINISH_LINEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH] THEN + STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN + ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN + ASM_MESON_TAC[ARC_LINEPATH_EQ]; + SUBGOAL_THEN + `~(pathfinish(polygonal_path(CONS (x:real^2) (CONS y l))) = a)` + ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHSTART_LINEPATH; + PATHFINISH_JOIN] THEN + ASM_SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_JOIN] THEN + REWRITE_TAC[ARC_LINEPATH_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN + `arc(polygonal_path q ++ polygonal_path r:real^1->real^2)` + MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[ARC_JOIN_EQ; PATHFINISH_LINEPATH; PATHSTART_JOIN]] THEN + MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN + ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS) THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]]; + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN + SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_LINEPATH; NOT_CONS_NIL; HD; + PATHSTART_POLYGONAL_PATH] THEN + UNDISCH_THEN + `path_image(polygonal_path q ++ polygonal_path r) = + path_image(polygonal_path(CONS (x:real^2) (CONS y l)))` + (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHFINISH_JOIN; PATHFINISH_LINEPATH] THEN + SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `pathstart(polygonal_path p) = (a:real^2)` SUBST_ALL_TAC THENL + [UNDISCH_TAC `5 <= LENGTH(p:(real^2)list)` THEN + REWRITE_TAC[PATHSTART_POLYGONAL_PATH] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; ARITH]; + ALL_TAC] THEN + UNDISCH_THEN `pathfinish (polygonal_path p) = (a:real^2)` SUBST_ALL_TAC THEN + UNDISCH_THEN `path_image(polygonal_path q ++ polygonal_path r):real^2->bool = + path_image(polygonal_path p)` (SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN + `(!x:real^2. MEM x q ==> integral_vector x) /\ + (!x:real^2. MEM x r ==> integral_vector x)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM IN_SET_OF_LIST] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM IN_SET_OF_LIST; IN_UNION] THEN + UNDISCH_THEN + `(set_of_list q UNION set_of_list r):real^2->bool = set_of_list p` + (SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[IN_UNION]; + ALL_TAC] THEN + ABBREV_TAC `n = LENGTH(p:(real^2)list)` THEN + SUBGOAL_THEN `integral_vector(a:real^2) /\ integral_vector(b:real^2)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) + [`!x:real^2. MEM x p ==> integral_vector x`; + `MEM (a:real^2) p`; + `MEM (b:real^2) p`; + `HD p = (a:real^2)`; + `(set_of_list q UNION set_of_list r):real^2->bool = set_of_list p`; + `simple_path(polygonal_path p :real^1->real^2)`] THEN + SUBGOAL_THEN `3 <= LENGTH(q:(real^2)list)` ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + SPEC_TAC(`q:(real^2)list`,`q:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a0:real^2` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a1:real^2` THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[LENGTH; ARITH; ARITH_RULE `3 <= SUC(SUC(SUC n))`] THEN + REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REPEAT STRIP_TAC THEN + UNDISCH_THEN `a0:real^2 = a` SUBST_ALL_TAC THEN + UNDISCH_THEN `a1:real^2 = b` SUBST_ALL_TAC THEN + UNDISCH_TAC `segment(a:real^2,b) SUBSET + inside(path_image(linepath(a,b) ++ polygonal_path r))` THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH; PATHFINISH_LINEPATH] THEN + MATCH_MP_TAC(SET_RULE + `inside(s' UNION t) INTER (s' UNION t) = {} /\ ~(s = {}) /\ s SUBSET s' + ==> ~(s SUBSET inside(s' UNION t))`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP] THEN + ASM_REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SEGMENT_EQ_EMPTY]; + UNDISCH_THEN `2 <= LENGTH(q:(real^2)list)` (K ALL_TAC)] THEN + SUBGOAL_THEN `3 <= LENGTH(r:(real^2)list)` ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + SPEC_TAC(`r:(real^2)list`,`r:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a0:real^2` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + X_GEN_TAC `a1:real^2` THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[LENGTH; ARITH; ARITH_RULE `3 <= SUC(SUC(SUC n))`] THEN + REWRITE_TAC[polygonal_path; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REPEAT STRIP_TAC THEN + UNDISCH_THEN `a0:real^2 = b` SUBST_ALL_TAC THEN + UNDISCH_THEN `a1:real^2 = a` SUBST_ALL_TAC THEN + UNDISCH_TAC `segment(a:real^2,b) SUBSET + inside(path_image(polygonal_path q ++ linepath(b,a)))` THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH; PATHSTART_LINEPATH] THEN + ONCE_REWRITE_TAC[CONJUNCT1 SEGMENT_SYM] THEN + MATCH_MP_TAC(SET_RULE + `inside(t UNION s') INTER (t UNION s') = {} /\ ~(s = {}) /\ s SUBSET s' + ==> ~(s SUBSET inside(t UNION s'))`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP] THEN + ASM_REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SEGMENT_EQ_EMPTY]; + UNDISCH_THEN `2 <= LENGTH(r:(real^2)list)` (K ALL_TAC)] THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(ISPEC `CONS (a:real^2) r` th) THEN + MP_TAC(ISPEC `CONS (b:real^2) q` th)) THEN + REWRITE_TAC[LENGTH] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `polygonal_path(CONS (b:real^2) q) = linepath(b,a) ++ polygonal_path q` + SUBST_ALL_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SPEC_TAC(`q:(real^2)list`,`q:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[LENGTH; ARITH; polygonal_path] THEN + SIMP_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]; + ALL_TAC] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[MEM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[PATHSTART_LINEPATH]] THEN + UNDISCH_TAC + `simple_path(polygonal_path q ++ polygonal_path r :real^1->real^2)` THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; ARC_LINEPATH_EQ] THEN + STRIP_TAC THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET i + ==> c INTER i = {} + ==> (s UNION {a,b}) INTER c SUBSET {b,a}`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN + MATCH_MP_TAC(SET_RULE + `inside(s UNION t) INTER (s UNION t) = {} + ==> s INTER inside(s UNION t) = {}`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP]; + STRIP_TAC] THEN + REWRITE_TAC[LENGTH] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `polygonal_path(CONS (a:real^2) r) = linepath(a,b) ++ polygonal_path r` + SUBST_ALL_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SPEC_TAC(`r:(real^2)list`,`r:(real^2)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[LENGTH; ARITH] THEN + GEN_TAC THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[LENGTH; ARITH; polygonal_path] THEN + SIMP_TAC[PATHSTART_POLYGONAL_PATH; HD; NOT_CONS_NIL]; + ALL_TAC] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[MEM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[PATHSTART_LINEPATH]] THEN + UNDISCH_TAC + `simple_path(polygonal_path q ++ polygonal_path r :real^1->real^2)` THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; ARC_LINEPATH_EQ] THEN + STRIP_TAC THEN REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET i + ==> c INTER i = {} + ==> (s UNION {a,b}) INTER c SUBSET {a,b}`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN + MATCH_MP_TAC(SET_RULE + `inside(s UNION t) INTER (s UNION t) = {} + ==> t INTER inside(s UNION t) = {}`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP]; + STRIP_TAC] THEN + MP_TAC(ISPECL [`polygonal_path q:real^1->real^2`; + `reversepath(polygonal_path r):real^1->real^2`; + `linepath(a:real^2,b)`; `a:real^2`; `b:real^2`] + SPLIT_INSIDE_SIMPLE_CLOSED_CURVE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + SIMPLE_PATH_LINEPATH_EQ] THEN + UNDISCH_TAC + `simple_path(polygonal_path q ++ polygonal_path r :real^1->real^2)` THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATH_IMAGE_LINEPATH] THEN + ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH; ARC_IMP_SIMPLE_PATH; + SIMPLE_PATH_REVERSEPATH] THEN + STRIP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s INTER t SUBSET {a,b} /\ + a IN s /\ b IN s /\ a IN t /\ b IN t + ==> s INTER t = {a,b}`) THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + UNDISCH_TAC + `segment(a:real^2,b) SUBSET + inside(path_image(polygonal_path q ++ polygonal_path r))` THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN MATCH_MP_TAC(SET_RULE + `a IN t /\ b IN t /\ inside(t UNION u) INTER (t UNION u) = {} + ==> s SUBSET inside(t UNION u) + ==> t INTER (s UNION {a,b}) = {a,b}`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + UNDISCH_TAC + `segment(a:real^2,b) SUBSET + inside(path_image(polygonal_path q ++ polygonal_path r))` THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN] THEN MATCH_MP_TAC(SET_RULE + `a IN u /\ b IN u /\ inside(t UNION u) INTER (t UNION u) = {} + ==> s SUBSET inside(t UNION u) + ==> u INTER (s UNION {a,b}) = {a,b}`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET i + ==> inside(q UNION r) INTER (q UNION r) = {} /\ + inside(q UNION r) = i /\ + ~(s = {}) + ==> ~((s UNION {a,b}) INTER inside(q UNION r) = {})`)) THEN + ASM_REWRITE_TAC[INSIDE_NO_OVERLAP; SEGMENT_EQ_EMPTY] THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN]]; + ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + check (free_in `measure:(real^2->bool)->real` o concl))) THEN + UNDISCH_TAC + `segment(a:real^2,b) SUBSET + inside(path_image (polygonal_path q ++ polygonal_path r))` THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH] THEN + SUBST1_TAC(ISPECL [`b:real^2`; `a:real^2`] (CONJUNCT1 SEGMENT_SYM)) THEN + REPEAT STRIP_TAC THEN SUBST1_TAC(SYM(ASSUME + `inside(path_image(polygonal_path q) UNION segment [a,b]) UNION + inside(path_image(polygonal_path r) UNION segment [a,b]) UNION + (segment [a:real^2,b] DIFF {a, b}) = + inside + (path_image(polygonal_path q) UNION path_image(polygonal_path r))`)) THEN + REWRITE_TAC[SET_RULE + `{x | x IN (s UNION t) /\ P x} = + {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `measure(inside(path_image(polygonal_path q) UNION segment[a:real^2,b])) + + measure(inside(path_image (polygonal_path r) UNION segment [a,b]) UNION + segment [a,b] DIFF {a, b})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_INSIDE THEN + MATCH_MP_TAC COMPACT_UNION THEN + SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_SEGMENT; PATH_POLYGONAL_PATH]; + MATCH_MP_TAC MEASURABLE_UNION THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_INSIDE THEN + MATCH_MP_TAC COMPACT_UNION THEN + SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_SEGMENT; PATH_POLYGONAL_PATH]; + MATCH_MP_TAC MEASURABLE_DIFF THEN CONJ_TAC THEN + MATCH_MP_TAC MEASURABLE_COMPACT THEN REWRITE_TAC[COMPACT_SEGMENT] THEN + MATCH_MP_TAC FINITE_IMP_COMPACT THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]]; + ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `segment[a:real^2,b]` THEN + REWRITE_TAC[NEGLIGIBLE_SEGMENT_2] THEN SET_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `measure(inside(path_image(polygonal_path q) UNION segment[a:real^2,b])) + + measure(inside(path_image(polygonal_path r) UNION segment[a,b]))` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `segment[a:real^2,b]` THEN + REWRITE_TAC[NEGLIGIBLE_SEGMENT_2] THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + ONCE_REWRITE_TAC[SET_RULE `s UNION segment[a,b] = segment[a,b] UNION s`] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `CARD({x | x IN inside(segment[a,b] UNION path_image(polygonal_path q)) /\ + integral_vector x} UNION + {x | x IN inside(segment[a,b] UNION path_image(polygonal_path r)) /\ + integral_vector x} UNION + {x | x IN segment[a,b] DIFF {a, b} /\ integral_vector x}) = + CARD {x | x IN inside(segment[a,b] UNION path_image(polygonal_path q)) /\ + integral_vector x} + + CARD {x | x IN inside(segment[a,b] UNION path_image(polygonal_path r)) /\ + integral_vector x} + + CARD {x:real^2 | x IN segment[a,b] DIFF {a, b} /\ integral_vector x}` + SUBST1_TAC THENL + [(CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; FINITE_UNION; + BOUNDED_INSIDE; BOUNDED_UNION; BOUNDED_SEGMENT; + BOUNDED_PATH_IMAGE; BOUNDED_DIFF; PATH_POLYGONAL_PATH] THEN + MATCH_MP_TAC(ARITH_RULE + `pr = 0 /\ qrp = 0 ==> (q + (r + p) - pr) - qrp = q + r + p`) THEN + REWRITE_TAC[UNION_OVER_INTER] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} INTER {x | x IN t /\ P x} = + {x | x IN (s INTER t) /\ P x}`] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE + [SET_RULE `s UNION segment[a,b] = segment[a,b] UNION s`]) THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; UNION_EMPTY] THEN CONJ_TAC THEN + MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN + MATCH_MP_TAC(SET_RULE + `inside(s UNION t) INTER (s UNION t) = {} + ==> {x | x IN inside(s UNION t) INTER (s DIFF ab) /\ P x} = {}`) THEN + REWRITE_TAC[INSIDE_NO_OVERLAP]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH + `q + r = &2 * x + y + &2 + ==> (iq + q / &2 - &1) + (ir + r / &2 - &1) = + ((iq + ir + x) + y / &2 - &1)`) THEN + REWRITE_TAC[SET_RULE + `{x | x IN (s UNION t) /\ P x} = + {x | x IN s /\ P x} UNION {x | x IN t /\ P x}`] THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [CARD_UNION_GEN; FINITE_BOUNDED_INTEGER_POINTS; BOUNDED_SEGMENT; + BOUNDED_PATH_IMAGE; PATH_POLYGONAL_PATH; GSYM REAL_OF_NUM_SUB; + INTER_SUBSET; CARD_SUBSET; ARITH_RULE `x:num <= y ==> x <= y + z`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH + `&2 * ab + qr = &2 * x + qab + rab + &2 + ==> ((ab + q) - qab) + ((ab + r) - rab) = + &2 * x + ((q + r) - qr) + &2`) THEN + SUBGOAL_THEN + `{x | x IN segment[a,b] /\ integral_vector x} INTER + {x | x IN path_image(polygonal_path q) /\ integral_vector x} = {a,b} /\ + {x:real^2 | x IN segment[a,b] /\ integral_vector x} INTER + {x | x IN path_image(polygonal_path r) /\ integral_vector x} = {a,b}` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET inside(q UNION r) + ==> s = c DIFF {a,b} /\ a IN q /\ b IN q /\ a IN r /\ b IN r /\ + inside(q UNION r) INTER (q UNION r) = {} /\ + P a /\ P b /\ a IN c /\ b IN c + ==> {x | x IN c /\ P x} INTER {x | x IN q /\ P x} = {a,b} /\ + {x | x IN c /\ P x} INTER {x | x IN r /\ P x} = {a,b}`)) THEN + ASM_REWRITE_TAC[open_segment; INSIDE_NO_OVERLAP; ENDS_IN_SEGMENT] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:real^2 | x IN path_image(polygonal_path q) /\ integral_vector x} INTER + {x | x IN path_image(polygonal_path r) /\ integral_vector x} = {a,b}` + SUBST1_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SIMPLE_PATH_JOIN_IMP)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + MATCH_MP_TAC(SET_RULE + `P a /\ P b /\ a IN q /\ b IN q /\ a IN r /\ b IN r + ==> (q INTER r) SUBSET {a,b} + ==> {x | x IN q /\ P x} INTER {x | x IN r /\ P x} = {a,b}`) THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH + `x = y + &2 ==> &2 * x + &2 = &2 * y + &2 + &2 + &2`) THEN + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + SUBGOAL_THEN `(segment(a,b) UNION {a, b}) DIFF {a, b} = segment(a:real^2,b)` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `~(a IN s) /\ ~(b IN s) ==> (s UNION {a,b}) DIFF {a,b} = s`) THEN + REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SET_RULE + `P a /\ P b + ==> {x | x IN s UNION {a,b} /\ P x} = + a INSERT b INSERT {x | x IN s /\ P x}`] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_BOUNDED_INTEGER_POINTS; + BOUNDED_SEGMENT; FINITE_INSERT] THEN + ASM_REWRITE_TAC[IN_INSERT; IN_ELIM_THM; ENDS_NOT_IN_SEGMENT] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; ARITH_RULE `SUC(SUC n) = n + 2`]);; diff --git a/100/piseries.ml b/100/piseries.ml new file mode 100644 index 0000000..5bc84af --- /dev/null +++ b/100/piseries.ml @@ -0,0 +1,3311 @@ +(* ========================================================================= *) +(* Taylor series for tan and cot, via partial fractions expansion of cot. *) +(* ========================================================================= *) + +needs "Library/analysis.ml";; +needs "Library/transc.ml";; +needs "Library/floor.ml";; +needs "Library/poly.ml";; +needs "Examples/machin.ml";; +needs "Library/iter.ml";; + +(* ------------------------------------------------------------------------- *) +(* Compatibility stuff for some old proofs. *) +(* ------------------------------------------------------------------------- *) + +let REAL_LE_1_POW2 = prove + (`!n. &1 <= &2 pow n`, + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> 0 < n`; + EXP_LT_0; ARITH]);; + +let REAL_LT_1_POW2 = prove + (`!n. &1 < &2 pow n <=> ~(n = 0)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&2 pow 0`)) THEN + MATCH_MP_TAC REAL_POW_MONO_LT THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let REAL_POW2_CLAUSES = prove + (`(!n. &0 <= &2 pow n) /\ + (!n. &0 < &2 pow n) /\ + (!n. &0 <= inv(&2 pow n)) /\ + (!n. &0 < inv(&2 pow n)) /\ + (!n. inv(&2 pow n) <= &1) /\ + (!n. &1 - inv(&2 pow n) <= &1) /\ + (!n. &1 <= &2 pow n) /\ + (!n. &1 < &2 pow n <=> ~(n = 0)) /\ + (!n. &0 <= &1 - inv(&2 pow n)) /\ + (!n. &0 <= &2 pow n - &1) /\ + (!n. &0 < &1 - inv(&2 pow n) <=> ~(n = 0))`, + SIMP_TAC[REAL_LE_1_POW2; REAL_LT_1_POW2; REAL_SUB_LE; REAL_SUB_LT; + REAL_INV_LE_1] THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_INV_EQ; REAL_POW_LT; REAL_POW_LE; + REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH; + REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow 1)` THEN + ASM_SIMP_TAC[REAL_LE_INV2; REAL_POW_MONO; REAL_POW_LT; REAL_OF_NUM_LT; ARITH; + REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let REAL_INTEGER_CLOSURES = prove + (`(!n. ?p. abs(&n) = &p) /\ + (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x + y) = &p) /\ + (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x - y) = &p) /\ + (!x y. (?m. abs(x) = &m) /\ (?n. abs(y) = &n) ==> ?p. abs(x * y) = &p) /\ + (!x r. (?n. abs(x) = &n) ==> ?p. abs(x pow r) = &p) /\ + (!x. (?n. abs(x) = &n) ==> ?p. abs(--x) = &p) /\ + (!x. (?n. abs(x) = &n) ==> ?p. abs(abs x) = &p)`, + REWRITE_TAC[GSYM integer; INTEGER_CLOSED]);; + +let PI_APPROX_25_BITS = time PI_APPROX_BINARY_RULE 25;; + +(* ------------------------------------------------------------------------- *) +(* Convert a polynomial into a "canonical" list-based form. *) +(* ------------------------------------------------------------------------- *) + +let POLYMERIZE_CONV = + let pth = prove + (`a = poly [a] x`, + REWRITE_TAC[poly; REAL_MUL_RZERO; REAL_ADD_RID]) + and qth = prove + (`x * poly p x = poly (CONS (&0) p) x`, + REWRITE_TAC[poly; REAL_ADD_LID]) in + let conv_base = GEN_REWRITE_CONV I [pth] + and conv_zero = GEN_REWRITE_CONV I [qth] + and conv_step = GEN_REWRITE_CONV I [GSYM(CONJUNCT2 poly)] in + let is_add = is_binop `(+):real->real->real` + and is_mul = is_binop `(*):real->real->real` in + let rec conv tm = + if is_add tm then + let l,r = dest_comb tm in + let r1,r2 = dest_comb r in + let th1 = AP_TERM l (AP_TERM r1 (conv r2)) in + TRANS th1 (conv_step(rand(concl th1))) + else if is_mul tm then + let th1 = AP_TERM (rator tm) (conv (rand tm)) in + TRANS th1 (conv_zero(rand(concl th1))) + else conv_base tm in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Basic definition of cotangent. *) +(* ------------------------------------------------------------------------- *) + +let cot = new_definition + `cot x = cos x / sin x`;; + +let COT_TAN = prove + (`cot(x) = inv(tan(x))`, + REWRITE_TAC[cot; tan; REAL_INV_DIV]);; + +(* ------------------------------------------------------------------------- *) +(* We need to reverse sums to prove the grisly lemma below. *) +(* ------------------------------------------------------------------------- *) + +let SUM_PERMUTE_0 = prove + (`!n p. (!y. y < n ==> ?!x. x < n /\ (p(x) = y)) + ==> !f. sum(0,n)(\n. f(p n)) = sum(0,n) f`, + INDUCT_TAC THEN GEN_TAC THEN TRY(REWRITE_TAC[sum] THEN NO_TAC) THEN + DISCH_TAC THEN GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[LESS_SUC_REFL] THEN + CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC RAND_CONV [sum] THEN REWRITE_TAC[ADD_CLAUSES] THEN + ABBREV_TAC `q:num->num = \r. if r < k then p(r) else p(SUC r)` THEN + SUBGOAL_THEN `!y:num. y < n ==> ?!x. x < n /\ (q x = y)` MP_TAC THENL + [X_GEN_TAC `y:num` THEN DISCH_TAC THEN (MP_TAC o ASSUME) + `!y. y < (SUC n) ==> ?!x. x < (SUC n) /\ (p x = y)` THEN + DISCH_THEN(MP_TAC o SPEC `y:num`) THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MP th))] THEN + CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC o CONJUNCT1) THEN + CONJ_TAC THENL + [DISJ_CASES_TAC(SPECL [`x:num`; `k:num`] LTE_CASES) THENL + [EXISTS_TAC `x:num` THEN EXPAND_TAC "q" THEN BETA_TAC THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&k` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `k < (SUC n)` THEN + REWRITE_TAC[GSYM LT_SUC_LE; LE_ADD2]; + MP_TAC(ASSUME `k <= x:num`) THEN REWRITE_TAC[LE_LT] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST_ALL_TAC) THENL + [EXISTS_TAC `x - 1` THEN EXPAND_TAC "q" THEN BETA_TAC THEN + UNDISCH_TAC `k < x:num` THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN + DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[SUC_SUB1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[LT_SUC]) THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + UNDISCH_TAC `(k + d) < k:num` THEN + REWRITE_TAC[GSYM LE_SUC_LT] THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[GSYM NOT_LT; REWRITE_RULE[ADD_CLAUSES] LESS_ADD_SUC]; + SUBST_ALL_TAC(ASSUME `(p:num->num) x = n`) THEN + UNDISCH_TAC `y < n:num` THEN ASM_REWRITE_TAC[LT_REFL]]]; + SUBGOAL_THEN `!z. q z :num = p(if z < k then z else SUC z)` MP_TAC THENL + [GEN_TAC THEN EXPAND_TAC "q" THEN BETA_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + MAP_EVERY X_GEN_TAC [`x1:num`; `x2:num`] THEN STRIP_TAC THEN + UNDISCH_TAC `!y. y < (SUC n) ==> + ?!x. x < (SUC n) /\ (p x = y)` THEN + DISCH_THEN(MP_TAC o SPEC `y:num`) THEN + REWRITE_TAC[MATCH_MP LESS_SUC (ASSUME `y < n:num`)] THEN + CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(MP_TAC o SPECL [`if x1 < k then x1 else SUC x1`; + `if x2 < k then x2 else SUC x2`] o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[LT_SUC] THEN + MATCH_MP_TAC LESS_SUC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN + REPEAT COND_CASES_TAC THEN REWRITE_TAC[SUC_INJ] THENL + [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `~(x2 < k:num)` THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN + EXISTS_TAC `SUC x2` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]; + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN UNDISCH_TAC `~(x1 < k:num)` THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN + EXISTS_TAC `SUC x1` THEN ASM_REWRITE_TAC[LESS_SUC_REFL]]]]; + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [GSYM th]) THEN BETA_TAC THEN + UNDISCH_TAC `k < (SUC n)` THEN + REWRITE_TAC[LE_SUC; LT_SUC_LE; LE_ADD2] THEN + DISCH_THEN(X_CHOOSE_TAC `d:num` o MATCH_MP LESS_EQUAL_ADD) THEN + GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o ONCE_DEPTH_CONV) + [ASSUME `n = k + d:num`] THEN REWRITE_TAC[GSYM SUM_TWO] THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) + [ASSUME `n = k + d:num`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD_SUC)] THEN + REWRITE_TAC[GSYM SUM_TWO; sum; ADD_CLAUSES] THEN BETA_TAC THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN BINOP_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN + BETA_TAC THEN EXPAND_TAC "q" THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN + REWRITE_TAC[ASSUME `(p:num->num) k = n`; REAL_EQ_LADD] THEN + REWRITE_TAC[ADD1; SUM_REINDEX] THEN BETA_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN BETA_TAC THEN + REWRITE_TAC[GSYM NOT_LT] THEN DISCH_TAC THEN + EXPAND_TAC "q" THEN BETA_TAC THEN ASM_REWRITE_TAC[ADD1]]]);; + +let SUM_REVERSE_0 = prove + (`!n f. sum(0,n) f = sum(0,n) (\k. f((n - 1) - k))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`n:num`; `\x. (n - 1) - x`] SUM_PERMUTE_0) THEN + REWRITE_TAC[] THEN + W(C SUBGOAL_THEN (fun th -> SIMP_TAC[th]) o funpow 2 lhand o snd) THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + DISCH_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + EXISTS_TAC `n - 1 - m` THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let SUM_REVERSE = prove + (`!n m f. sum(m,n) f = sum(m,n) (\k. f(((n + 2 * m) - 1) - k))`, + REPEAT GEN_TAC THEN SUBST1_TAC(ARITH_RULE `m = 0 + m`) THEN + REWRITE_TAC[SUM_REINDEX] THEN + GEN_REWRITE_TAC LAND_CONV [SUM_REVERSE_0] THEN + REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ THEN + GEN_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN + DISCH_THEN(fun th -> AP_TERM_TAC THEN MP_TAC th) THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Following is lifted from fsincos taylor series. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_SIN = prove + (`!x n. abs(sin x - + sum(0,n) (\m. (if EVEN m then &0 + else -- &1 pow ((m - 1) DIV 2) / &(FACT m)) * + x pow m)) + <= inv(&(FACT n)) * abs(x) pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`sin`; `\n x. if n MOD 4 = 0 then sin(x) + else if n MOD 4 = 1 then cos(x) + else if n MOD 4 = 2 then --sin(x) + else --cos(x)`] MCLAURIN_ALL_LE) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [CONJ_TAC THENL + [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN + REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN + REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN + SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THEN + W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN + SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN + MP_TAC(SYM th)) THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + UNDISCH_TAC `r MOD 4 < 4` THEN + SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`; + ARITH_RULE `(x + 3) - 1 = x + 2`; + ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`; + ARITH_RULE `x * 4 = 2 * 2 * x`] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* The formulas marked with a star on p. 205 of Knopp's book. *) +(* ------------------------------------------------------------------------- *) + +let COT_HALF_TAN = prove + (`~(integer x) + ==> (cot(pi * x) = &1 / &2 * (cot(pi * x / &2) - tan(pi * x / &2)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[cot; tan] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + SUBGOAL_THEN `pi * x = &2 * pi * x / &2` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + ABBREV_TAC `y = pi * x / &2` THEN + REWRITE_TAC[COS_DOUBLE; SIN_DOUBLE] THEN + SUBGOAL_THEN `~(sin y = &0) /\ ~(cos y = &0)` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "y" THEN REWRITE_TAC[SIN_ZERO; COS_ZERO; real_div] THEN + CONJ_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b * c = d) <=> (b * a * c = d)`] THEN + SIMP_TAC[GSYM REAL_MUL_LNEG; REAL_EQ_MUL_RCANCEL; REAL_ENTIRE; + REAL_INV_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; REAL_LT_IMP_NZ; + PI_POS] THEN + REWRITE_TAC[OR_EXISTS_THM] THEN + REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN + DISCH_THEN(CHOOSE_THEN(DISJ_CASES_THEN (MP_TAC o AP_TERM `abs`) o + CONJUNCT2)) THEN + UNDISCH_TAC `~(integer x)` THEN + SIMP_TAC[integer; REAL_ABS_NEG; REAL_ABS_NUM; NOT_EXISTS_THM]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&2 * sin y * cos y` THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(h * (c * s' - s * c')) * t * s * c = + (t * h) * (c * c * s * s' - s * s * c * c')`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID; REAL_POW_2]);; + +let COT_HALF_POS = prove + (`~(integer x) + ==> (cot(pi * x) = &1 / &2 * (cot(pi * x / &2) + cot(pi * (x + &1) / &2)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[cot; COS_ADD; SIN_ADD; COS_PI2; SIN_PI2] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_SUB_LZERO] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + SUBGOAL_THEN `pi * x = &2 * pi * x / &2` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + ABBREV_TAC `y = pi * x / &2` THEN + REWRITE_TAC[COS_DOUBLE; SIN_DOUBLE] THEN + SUBGOAL_THEN `~(sin y = &0) /\ ~(cos y = &0)` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "y" THEN REWRITE_TAC[SIN_ZERO; COS_ZERO; real_div] THEN + CONJ_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b * c = d) <=> (b * a * c = d)`] THEN + SIMP_TAC[GSYM REAL_MUL_LNEG; REAL_EQ_MUL_RCANCEL; REAL_ENTIRE; + REAL_INV_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; REAL_LT_IMP_NZ; + PI_POS] THEN + REWRITE_TAC[OR_EXISTS_THM] THEN + REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN + DISCH_THEN(CHOOSE_THEN(DISJ_CASES_THEN (MP_TAC o AP_TERM `abs`) o + CONJUNCT2)) THEN + UNDISCH_TAC `~(integer x)` THEN + SIMP_TAC[integer; REAL_ABS_NEG; REAL_ABS_NUM; NOT_EXISTS_THM]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&2 * sin y * cos y` THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(h * c * s' + h * --s * c') * t * s * c = + (t * h) * (c * c * s * s' - s * s * c * c')`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID; REAL_POW_2]);; + +let COT_HALF_NEG = prove + (`~(integer x) + ==> (cot(pi * x) = &1 / &2 * (cot(pi * x / &2) + cot(pi * (x - &1) / &2)))`, + STRIP_TAC THEN ASM_SIMP_TAC[COT_HALF_POS] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBST1_TAC(REAL_ARITH `x + &1 = (x - &1) + &2`) THEN + ABBREV_TAC `y = x - &1` THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[cot; SIN_ADD; COS_ADD; SIN_PI; COS_PI] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_SUB_RZERO] THEN + REWRITE_TAC[real_div; REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_INV_NEG] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* By induction, the formula marked with the dagger. *) +(* ------------------------------------------------------------------------- *) + +let COT_HALF_MULTIPLE = prove + (`~(integer x) + ==> !n. cot(pi * x) = + sum(0,2 EXP n) + (\k. cot(pi * (x + &k) / &2 pow n) + + cot(pi * (x - &k) / &2 pow n)) / &2 pow (n + 1)`, + DISCH_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[EXP; real_pow; REAL_DIV_1; ADD_CLAUSES; REAL_POW_1] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_div; REAL_ADD_RID; REAL_SUB_RZERO; GSYM REAL_MUL_2] THEN + REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID; REAL_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum(0,2 EXP n) + (\k. &1 / &2 * (cot (pi * (x + &k) / &2 pow n / &2) + + cot (pi * ((x + &k) / &2 pow n + &1) / &2)) + + &1 / &2 * (cot (pi * (x - &k) / &2 pow n / &2) + + cot (pi * ((x - &k) / &2 pow n - &1) / &2))) / + &2 pow (n + 1)` THEN + CONJ_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN BINOP_TAC THENL + [MATCH_MP_TAC COT_HALF_POS THEN + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = &2 pow n * (x + &k) / &2 pow n - &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC; + SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; + MATCH_MP_TAC COT_HALF_NEG THEN + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = &2 pow n * (x - &k) / &2 pow n + &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC; + SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; SUM_CMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + ONCE_REWRITE_TAC[real_div] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + BINOP_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_pow; REAL_POW_ADD; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + SUBGOAL_THEN `!k. (x + &k) / &2 pow n + &1 = (x + &(2 EXP n + k)) / &2 pow n` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN + EXISTS_TAC `&2 pow n` THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; + REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_MUL_RID; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[REAL_ADD_AC]; ALL_TAC] THEN + SUBGOAL_THEN `!k. (x - &k) / &2 pow n - &1 = (x - &(2 EXP n + k)) / &2 pow n` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN + EXISTS_TAC `&2 pow n` THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; + REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_MUL_RID; GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXP; MULT_2; + GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM(CONJUNCT2 real_pow))] THEN + REWRITE_TAC[SUM_ADD] THEN + CONV_TAC(ONCE_DEPTH_CONV (ALPHA_CONV `j:num`)) THEN + REWRITE_TAC[REAL_ADD_AC; ADD_AC]);; + +let COT_HALF_KNOPP = prove + (`~(integer x) + ==> !n. cot(pi * x) = + cot(pi * x / &2 pow n) / &2 pow n + + sum(1,2 EXP n - 1) + (\k. cot(pi * (x + &k) / &2 pow (n + 1)) + + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1)`, + DISCH_TAC THEN GEN_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SPEC `n:num` o MATCH_MP COT_HALF_MULTIPLE) THEN + SUBGOAL_THEN `!f. sum(0,2 EXP n) f = f 0 + sum(1,2 EXP n - 1) f` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [GEN_TAC THEN SUBGOAL_THEN `2 EXP n = 1 + (2 EXP n - 1)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [SIMP_TAC[ARITH_RULE `~(x = 0) ==> (1 + (x - 1) = x)`; + EXP_EQ_0; ARITH_EQ]; ALL_TAC] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + REWRITE_TAC[SUM_1; REAL_ADD_AC]; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_RID; REAL_SUB_RZERO; GSYM REAL_MUL_2] THEN + GEN_REWRITE_TAC LAND_CONV [real_div] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `(&2 * cot (pi * x / &2 pow n)) / &2 pow (n + 1) + + sum(1,2 EXP n - 1) + (\k. &1 / &2 * (cot (pi * (x + &k) / &2 pow n / &2) + + cot (pi * ((x + &k) / &2 pow n - &1) / &2)) + + &1 / &2 * (cot (pi * (x - &k) / &2 pow n / &2) + + cot (pi * ((x - &k) / &2 pow n + &1) / &2))) / + &2 pow (n + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN BINOP_TAC THENL + [MATCH_MP_TAC COT_HALF_NEG THEN + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = &2 pow n * (x + &k) / &2 pow n - &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC; + SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; + MATCH_MP_TAC COT_HALF_POS THEN + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = &2 pow n * (x - &k) / &2 pow n + &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [SIMP_TAC[REAL_DIV_LMUL; REAL_POW2_CLAUSES; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC; + SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; SUM_CMUL] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (a + c) + (b + d)`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUM_ADD] THEN + GEN_REWRITE_TAC (funpow 2 (LAND_CONV o RAND_CONV) o RAND_CONV) + [SUM_REVERSE] THEN + SUBGOAL_THEN `(2 EXP n - 1 + 2 * 1) - 1 = 2 EXP n` SUBST1_TAC THENL + [SUBGOAL_THEN `~(2 EXP n = 0)` MP_TAC THENL + [REWRITE_TAC[EXP_EQ_0; ARITH_EQ]; + SPEC_TAC(`2 EXP n`,`m:num`) THEN ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_ADD] THEN + BINOP_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[LE_0; ADD_CLAUSES] THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_div] THEN + REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `(a = e) /\ (d = e) /\ (b = f) /\ (c = f) + ==> ((a + b) + (c + d) = (e + f) * &2)`) THEN + UNDISCH_TAC `k < 2 EXP n - 1 + 1` THEN + SIMP_TAC[ARITH_RULE `~(p = 0) ==> (k < p - 1 + 1 <=> k < p)`; + EXP_EQ_0; ARITH_EQ] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x. (x / &2 pow n + &1 = (x + &2 pow n) / &2 pow n) /\ + (x / &2 pow n - &1 = (x - &2 pow n) / &2 pow n)` + (fun th -> REWRITE_TAC[th]) + THENL + [SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_POW2_CLAUSES; REAL_ADD_RDISTRIB; + REAL_SUB_RDISTRIB; REAL_MUL_LID; REAL_DIV_RMUL; + REAL_LT_IMP_NZ]; + ALL_TAC] THEN + SUBGOAL_THEN `!x. x / &2 pow n / &2 = x / &2 pow (n + 1)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_POW_1; REAL_INV_MUL; + GSYM REAL_MUL_ASSOC]; ALL_TAC] THEN + ASM_SIMP_TAC[LT_IMP_LE; GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN + CONJ_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Bounds on the terms in this series. *) +(* ------------------------------------------------------------------------- *) + +let SIN_SUMDIFF_LEMMA = prove + (`!x y. sin(x + y) * sin(x - y) = (sin x + sin y) * (sin x - sin y)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_ARITH + `(x + y) * (x - y) = x * x - y * y`] THEN + REWRITE_TAC[SIN_ADD; real_sub; SIN_NEG; COS_NEG] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; GSYM REAL_MUL_ASSOC; + REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_ARITH + `(a = sx * sx + --(sy * sy)) <=> (a + sy * sy + --(sx * sx) = &0)`] THEN + REWRITE_TAC[REAL_ARITH + `a + --(sx * cy * cx * sy) + cx * sy * sx * cy + b = a + b`] THEN + REWRITE_TAC[REAL_ARITH + `(sx * cy * sx * cy + --(cx * sy * cx * sy)) + sy * sy + --(sx * sx) = + (sy * sy + (sx * sx + cx * cx) * (cy * cy)) - + (sx * sx + (sy * sy + cy * cy) * (cx * cx))`] THEN + REWRITE_TAC[REWRITE_RULE[REAL_POW_2] SIN_CIRCLE; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_SUB_REFL]);; + +let SIN_ZERO_LEMMA = prove + (`!x. (sin(pi * x) = &0) <=> integer(x)`, + REWRITE_TAC[integer; SIN_ZERO; EVEN_EXISTS] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c * d = c * b * a * d`] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_MUL_RNEG] THEN + SIMP_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB; + REAL_EQ_MUL_LCANCEL; PI_POS; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[NOT_IMP; NOT_FORALL_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + REWRITE_TAC[REAL_MUL_RNEG; OR_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH + `(abs(x) = a) <=> &0 <= a /\ ((x = a) \/ (x = --a))`] THEN + REWRITE_TAC[REAL_POS]);; + +let NOT_INTEGER_LEMMA = prove + (`~(x = &0) /\ abs(x) < &1 ==> ~(integer x)`, + ONCE_REWRITE_TAC[GSYM REAL_ABS_ZERO] THEN + CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[integer; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_LT] THEN + ARITH_TAC);; + +let NOT_INTEGER_DIV_POW2 = prove + (`~(integer x) ==> ~(integer(x / &2 pow n))`, + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = &2 pow n * x / &2 pow n` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES]; + SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]);; + +let SIN_ABS_LEMMA = prove + (`!x. abs(x) < pi ==> (abs(sin x) = sin(abs x))`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[SIN_0; REAL_ABS_NUM] THEN + REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `&0 <= x` THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [SUBGOAL_THEN `&0 < sin x` + (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE]) THEN + MATCH_MP_TAC SIN_POS_PI THEN ASM_REWRITE_TAC[real_abs] THEN + ASM_REWRITE_TAC[REAL_LT_LE]; + SUBGOAL_THEN `&0 < --(sin x)` + (fun th -> SIMP_TAC[th; SIN_NEG; + REAL_ARITH `&0 < --x ==> ~(&0 <= x)`]) THEN + REWRITE_TAC[GSYM SIN_NEG] THEN MATCH_MP_TAC SIN_POS_PI THEN + ASM_SIMP_TAC[REAL_ARITH `~(x = &0) /\ ~(&0 <= x) ==> &0 < --x`]]);; + +let SIN_EQ_LEMMA = prove + (`!x y. &0 <= x /\ x < pi / &2 /\ &0 <= y /\ y < pi / &2 + ==> ((sin x = sin y) <=> (x = y))`, + SUBGOAL_THEN + `!x y. &0 <= x /\ x < pi / &2 /\ &0 <= y /\ y < pi / &2 /\ x < y + ==> sin x < sin y` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[REAL_ARITH `~(x = y) <=> x < y \/ y < x`] THEN + ASM_MESON_TAC[]] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`sin`; `cos`; `x:real`; `y:real`] MVT_ALT) THEN + ASM_REWRITE_TAC[DIFF_SIN; REAL_EQ_SUB_RADD] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `x < a + x <=> &0 < a`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + MATCH_MP_TAC COS_POS_PI2 THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_LT_TRANS]);; + +let KNOPP_TERM_EQUIVALENT = prove + (`~(integer x) /\ k < 2 EXP n + ==> ((cot(pi * (x + &k) / &2 pow (n + 1)) + + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1) = + cot(pi * x / &2 pow (n + 1)) / &2 pow n / + (&1 - sin(pi * &k / &2 pow (n + 1)) pow 2 / + sin(pi * x / &2 pow (n + 1)) pow 2))`, + let lemma = prove + (`~(x = &0) /\ (x * a = b) ==> (a = b / x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `x:real` THEN + ASM_SIMP_TAC[REAL_DIV_LMUL]) in + REPEAT STRIP_TAC THEN SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_POW2_CLAUSES] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_POW_ADD] THEN + REWRITE_TAC[REAL_POW_1; real_div] THEN + GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC + `((a * b') * c) * b * &2 = (&2 * a) * c * b * b'`] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[real_div; REAL_ADD_LDISTRIB; REAL_SUB_LDISTRIB; + REAL_ADD_RDISTRIB; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_RID; GSYM real_div] THEN + ABBREV_TAC `a = pi * x / &2 pow (n + 1)` THEN + ABBREV_TAC `b = pi * &k / &2 pow (n + 1)` THEN + SUBGOAL_THEN + `~(sin(a + b) = &0) /\ + ~(sin a = &0) /\ + ~(sin(a - b) = &0) /\ + ~(&1 - sin(b) pow 2 / sin(a) pow 2 = &0)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(TAUT + `(a /\ b /\ c) /\ (b ==> d) ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[SIN_ZERO_LEMMA] THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC NOT_INTEGER_DIV_POW2 THEN + ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = (x + &k) - &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = (x - &k) + &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN(MP_TAC o AP_TERM `( * ) (sin(a) pow 2)`) THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_POW_2] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a * a = b * b) <=> ((a + b) * (a - b) = &0)`] THEN + REWRITE_TAC[GSYM SIN_SUMDIFF_LEMMA] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN + MAP_EVERY EXPAND_TAC ["a"; "b"] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[SIN_ZERO_LEMMA] THEN + REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THEN + MATCH_MP_TAC NOT_INTEGER_DIV_POW2 THENL + [UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = (x + &k) - &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SUBGOAL_THEN `x = (x - &k) + &k` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [REAL_ARITH_TAC; SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]]; + ALL_TAC] THEN + REWRITE_TAC[cot; TAN_ADD; real_sub] THEN REWRITE_TAC[GSYM real_sub] THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `sin(a + b)` THEN + ASM_SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL] THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `sin(a - b)` THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * (b + c * d) = a * b + c * a * d`] THEN + ASM_SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL] THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN + EXISTS_TAC `&1 - sin(b) pow 2 / sin(a) pow 2` THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * b * c * da = b * c * a * da`] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL] THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `sin(a) pow 2` THEN + ASM_REWRITE_TAC[REAL_POW_2; REAL_ENTIRE] THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `((sa * sa) * (&1 - sb2 * sa' * sa') * others = + (sa * sa) * v * w * x * y * sa') = + (others * (sa * sa - sb2 * (sa * sa') * (sa * sa')) = + sa * v * w * x * y * sa * sa')`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; REAL_MUL_RID] THEN + SUBGOAL_THEN `sin(a - b) * cos(a + b) + sin(a + b) * cos(a - b) = + sin(&2 * a)` + SUBST1_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM SIN_ADD] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SIN_DOUBLE] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH + `sa * samb * sapb * &2 * ca = (&2 * sa * ca) * samb * sapb`] THEN + AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[SIN_SUMDIFF_LEMMA] THEN REAL_ARITH_TAC);; + +let SIN_LINEAR_ABOVE = prove + (`!x. abs(x) < &1 ==> abs(sin x) <= &2 * abs(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real`; `2`] MCLAURIN_SIN) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_pow; REAL_POW_1] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_DIV_1; REAL_MUL_LID; REAL_POW_1; REAL_ADD_LID] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(a) <= abs(x) ==> abs(s - x) <= a ==> abs(s) <= &2 * abs(x)`) THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC; REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_ABS] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2 * &1` THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let SIN_LINEAR_BELOW = prove + (`!x. abs(x) < &2 ==> abs(sin x) >= abs(x) / &3`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real`; `3`] MCLAURIN_SIN) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_pow; REAL_POW_1] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_DIV_1; REAL_MUL_LID; REAL_POW_1; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + SIMP_TAC[real_ge; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `&3 * abs(a) <= &2 * abs(x) + ==> abs(s - x) <= a ==> abs(x) <= abs(s) * &3`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_ABS; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC(LAND_CONV(RAND_CONV(RAND_CONV num_CONV))) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE]);; + +let KNOPP_TERM_BOUND_LEMMA = prove + (`~(integer x) /\ k < 2 EXP n /\ &6 * abs(x) < &k + ==> abs(a / (&1 - sin(pi * &k / &2 pow (n + 1)) pow 2 / + sin(pi * x / &2 pow (n + 1)) pow 2)) + <= abs(a) / ((&k / (&6 * x)) pow 2 - &1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN + SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + MATCH_MP_TAC REAL_POW_LT2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + UNDISCH_TAC `&6 * abs(x) < &k` THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN + MATCH_MP_TAC REAL_LT_RDIV_EQ THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; GSYM REAL_ABS_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= y ==> x - &1 <= abs(&1 - y)`) THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_POW_DIV] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs(pi * &k / &2 pow (n + 1)) / &3) * + inv(&2 * abs(pi * x / &2 pow (n + 1)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `p * k * q' * k1 * k2 * p' * x' * q = + k * (k1 * k2) * x' * (p * p') * (q * q')`] THEN + SIMP_TAC[REAL_INV_INV; REAL_MUL_RINV; REAL_ABS_ZERO; + REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; PI_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ABS_DIV] THEN + GEN_REWRITE_TAC RAND_CONV [real_div] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_DIV; REAL_LE_MUL; + REAL_ABS_POS; REAL_POS] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM real_ge] THEN MATCH_MP_TAC SIN_LINEAR_BELOW THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM; + REAL_LT_LDIV_EQ; REAL_POW2_CLAUSES] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `pi * &2 pow n` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_LMUL_EQ; PI_POS; REAL_OF_NUM_POW; REAL_OF_NUM_LT]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW2_CLAUSES] THEN + MATCH_MP_TAC(C MATCH_MP PI_APPROX_25_BITS (REAL_ARITH + `abs(p - y) <= e ==> y + e <= a ==> p <= a`)) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[GSYM REAL_ABS_NZ; SIN_ZERO_LEMMA] THEN + ASM_SIMP_TAC[NOT_INTEGER_DIV_POW2] THEN + MATCH_MP_TAC SIN_LINEAR_ABOVE THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM; + REAL_LT_LDIV_EQ; REAL_POW2_CLAUSES] THEN + REWRITE_TAC[REAL_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&6)` THEN + CONV_TAC (LAND_CONV REAL_RAT_REDUCE_CONV) THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `abs(&k * pi)` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + SIMP_TAC[PI_POS; REAL_ARITH `&0 < x ==> &0 < abs x`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(&2 pow n * pi)` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[LT_IMP_LE]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_ABS_POW; REAL_ABS_NUM; + REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW2_CLAUSES] THEN + MATCH_MP_TAC(C MATCH_MP PI_APPROX_25_BITS (REAL_ARITH + `abs(p - y) <= e ==> abs y + e <= a ==> abs p <= a`)) THEN + CONV_TAC REAL_RAT_REDUCE_CONV]);; + +let KNOPP_TERM_BOUND = prove + (`~(integer x) /\ k < 2 EXP n /\ &6 * abs(x) < &k + ==> abs((cot(pi * (x + &k) / &2 pow (n + 1)) + + cot(pi * (x - &k) / &2 pow (n + 1))) / &2 pow (n + 1)) + <= abs(cot(pi * x / &2 pow (n + 1)) / &2 pow n) * + (&36 * x pow 2) / (&k pow 2 - &36 * x pow 2)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[KNOPP_TERM_EQUIVALENT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(cot(pi * x / &2 pow (n + 1)) / &2 pow n) / + ((&k / (&6 * x)) pow 2 - &1)` THEN + ASM_SIMP_TAC[KNOPP_TERM_BOUND_LEMMA] THEN + GEN_REWRITE_TAC LAND_CONV [real_div] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN AP_TERM_TAC THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&6 pow 2`)) THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN REWRITE_TAC[REAL_POW_DIV] THEN + SUBGOAL_THEN `&0 < (&6 * x) pow 2` + (fun th -> SIMP_TAC[th; REAL_EQ_RDIV_EQ; REAL_SUB_RDISTRIB; + REAL_MUL_LID; REAL_DIV_RMUL; REAL_LT_IMP_NZ]) THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT THEN + REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ] THEN + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN + SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the series we're looking at do in fact converge... *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_INVERSE_SQUARES_LEMMA = prove + (`(\n. inv(&(n + 1) * &(n + 2))) sums &1`, + REWRITE_TAC[sums] THEN + SUBGOAL_THEN + `!n. sum(0,n) (\m. inv(&(m + 1) * &(m + 2))) = &1 - inv(&(n + 1))` + (fun th -> REWRITE_TAC[th]) + THENL + [INDUCT_TAC THEN REWRITE_TAC[sum] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + REWRITE_TAC[REAL_ARITH `(&1 - a + b = &1 - c) <=> (b + c = a)`] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV_UNIQ THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_INV_MUL; REAL_MUL_ASSOC; REAL_ADD_LDISTRIB] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_RULE `~(n + 1 = 0)`] THEN + REWRITE_TAC[REAL_MUL_LID; ARITH_RULE `SUC(n + 1) = n + 2`] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `&(n + 2)` THEN + SIMP_TAC[REAL_ADD_RDISTRIB; real_div; GSYM REAL_MUL_ASSOC; REAL_OF_NUM_EQ; + REAL_MUL_LINV; ARITH_RULE `~(n + 2 = 0)`; REAL_MUL_LID; + REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN + MATCH_MP_TAC SEQ_SUB THEN REWRITE_TAC[SEQ_CONST] THEN + MATCH_MP_TAC SEQ_INV0 THEN X_GEN_TAC `x:real` THEN + X_CHOOSE_TAC `N:num` (SPEC `x:real` REAL_ARCH_SIMPLE) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[real_gt; GE] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH_RULE `a < b + 1 <=> a <= b`]);; + +let SUMMABLE_INVERSE_SQUARES = prove + (`summable (\n. inv(&n pow 2))`, + MATCH_MP_TAC SUM_SUMMABLE THEN + EXISTS_TAC `sum(0,2) (\n. inv(&n pow 2)) + + suminf (\n. inv(&(n + 2) pow 2))` THEN + MATCH_MP_TAC SER_OFFSET_REV THEN + MATCH_MP_TAC SER_ACONV THEN MATCH_MP_TAC SER_COMPARA THEN + EXISTS_TAC `\n. inv(&(n + 1) * &(n + 2))` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_SUMMABLE THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[SUMMABLE_INVERSE_SQUARES_LEMMA]] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_POW_2; REAL_INV_MUL; REAL_ABS_INV; REAL_ABS_NUM; + REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC);; + +let SUMMABLE_INVERSE_POWERS = prove + (`!m. 2 <= m ==> summable (\n. inv(&(n + 1) pow m))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\m. inv (&(m + 1) pow 2)` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN + MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN + ARITH_TAC; + REWRITE_TAC[summable] THEN + EXISTS_TAC + `suminf (\m. inv (&m pow 2)) - sum(0,1) (\m. inv (&m pow 2))` THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] SER_OFFSET) THEN + REWRITE_TAC[SUMMABLE_INVERSE_SQUARES]]);; + +let COT_TYPE_SERIES_CONVERGES = prove + (`!x. ~(integer x) ==> summable (\n. inv(&n pow 2 - x))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SER_ACONV THEN MATCH_MP_TAC SER_COMPARA THEN + EXISTS_TAC `\n. &2 / &n pow 2` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_SUMMABLE THEN + EXISTS_TAC `&2 * suminf (\n. inv(&n pow 2))` THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC SER_CMUL THEN + MATCH_MP_TAC SUMMABLE_SUM THEN + REWRITE_TAC[SUMMABLE_INVERSE_SQUARES]] THEN + MP_TAC(SPEC `&2 * abs x + &1` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GE] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < &n pow 2` + (fun th -> SIMP_TAC[th; REAL_LE_RDIV_EQ]) + THENL + [MATCH_MP_TAC REAL_POW_LT THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `&2 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN + REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `&0 < abs(&n pow 2 - x)` + (fun th -> SIMP_TAC[REAL_LE_LDIV_EQ; th]) + THENL + [REWRITE_TAC[GSYM REAL_ABS_NZ] THEN + UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + DISCH_TAC THEN + SUBST1_TAC(REAL_ARITH `x = &n pow 2 - (&n pow 2 - x)`) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + SIMP_TAC[integer; REAL_INTEGER_CLOSURES]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&2 * abs(x) + &1 <= a ==> a <= &2 * abs(a - x)`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N pow 2` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; EXP_2; LE_SQUARE_REFL]; + ASM_SIMP_TAC[REAL_POW_LE2; REAL_OF_NUM_LE; LE_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Now the rather tricky limiting argument gives the result. *) +(* ------------------------------------------------------------------------- *) + +let SIN_X_RANGE = prove + (`!x. abs(sin(x) - x) <= abs(x) pow 2 / &2`, + GEN_TAC THEN + MP_TAC(SPECL [`x:real`; `2`] MCLAURIN_SIN) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[ARITH; REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_DIV_1; REAL_POW_1; REAL_MUL_LID] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[REAL_MUL_AC]);; + +let SIN_X_X_RANGE = prove + (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= abs(x) / &2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM REAL_ABS_NZ] THEN + ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_POW_2; SIN_X_RANGE; GSYM real_div]);; + +let SIN_X_LIMIT = prove + (`((\x. sin(x) / x) tends_real_real &1)(&0)`, + REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN EXISTS_TAC `e:real` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) / &2` THEN + ASM_SIMP_TAC[SIN_X_X_RANGE; REAL_ABS_NZ] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < e` THEN REAL_ARITH_TAC);; + +let COT_X_LIMIT = prove + (`((\x. x * cot(x)) tends_real_real &1)(&0)`, + SUBGOAL_THEN `(cos tends_real_real &1)(&0)` MP_TAC THENL + [MP_TAC(SPEC `&0` DIFF_COS) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CONT) THEN + REWRITE_TAC[contl; REAL_ADD_LID; COS_0] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o C CONJ SIN_X_LIMIT) THEN + DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(&1 = &0)`)) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_DIV) THEN + REWRITE_TAC[REAL_DIV_1; cot] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC; REAL_INV_INV]);; + +let COT_LIMIT_LEMMA = prove + (`!x. ~(x = &0) + ==> (\n. (x / &2 pow n) * cot(x / &2 pow n)) tends_num_real &1`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC COT_X_LIMIT THEN REWRITE_TAC[LIM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_TAC THEN + X_CHOOSE_TAC `N:num` (SPEC `abs(x) / d` REAL_ARCH_POW2) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN + DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_POW2_CLAUSES; REAL_LT_DIV; GSYM REAL_ABS_NZ] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW2_CLAUSES] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow N` THEN + ASM_REWRITE_TAC[REAL_POW2_THM]);; + +let COT_LIMIT_LEMMA1 = prove + (`~(x = &0) + ==> (\n. (pi / &2 pow (n + 1)) * cot(pi * x / &2 pow (n + 1))) + tends_num_real (inv(x))`, + DISCH_TAC THEN + MP_TAC(SPEC `pi * x * inv(&2)` COT_LIMIT_LEMMA) THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ; PI_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `p * x * a * b * c = x * (p * (a * b)) * c`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + REWRITE_TAC[ADD1; GSYM real_div] THEN DISCH_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM REAL_MUL_LID] THEN + FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP REAL_MUL_LINV) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `x * p * q * c = x * (p * q) * c`] THEN + ASM_REWRITE_TAC[GSYM real_div]);; + +let COT_X_BOUND_LEMMA_POS = prove + (`?M. !x. &0 < x /\ abs(x) <= &1 ==> abs(x * cot(x)) <= M`, + MP_TAC COT_X_LIMIT THEN REWRITE_TAC[LIM] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`\x. x * cot(x)`; `d:real`; `&1`] CONT_BOUNDED_ABS) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MATCH_MP_TAC CONT_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[DIFF_X]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[cot] THEN MATCH_MP_TAC CONT_DIV THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; + MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `cos x` THEN REWRITE_TAC[DIFF_SIN]; + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC SIN_POS_PI THEN + SUBGOAL_THEN `&1 < pi` + (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS; REAL_LTE_TRANS]) THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `&1 + e < a ==> abs(p - a) <= e ==> &1 < p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN EXISTS_TAC `abs M + &2` THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`abs x`; `d:real`] REAL_LTE_TOTAL) THENL + [MATCH_MP_TAC(REAL_ARITH `abs(x - &1) < &1 ==> abs(x) <= abs(m) + &2`) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`]; + MATCH_MP_TAC(REAL_ARITH `x <= m ==> x <= abs(m) + &2`) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + MAP_EVERY UNDISCH_TAC [`&0 < x`; `abs(x) <= &1`; `d <= abs(x)`] THEN + REAL_ARITH_TAC]);; + +let COT_X_BOUND_LEMMA = prove + (`?M. !x. ~(x = &0) /\ abs(x) <= &1 ==> abs(x * cot(x)) <= M`, + X_CHOOSE_TAC `M:real` COT_X_BOUND_LEMMA_POS THEN + EXISTS_TAC `M:real` THEN X_GEN_TAC `x:real` THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `x * cot(x) = --x * cot(--x)` SUBST1_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[REAL_ABS_NEG]] THEN + REWRITE_TAC[cot; SIN_NEG; COS_NEG; real_div; REAL_INV_NEG; + REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let COT_PARTIAL_FRACTIONS = prove + (`~(integer x) + ==> (\n. (&2 * x pow 2) / (x pow 2 - &n pow 2)) sums + ((pi * x) * cot(pi * x) + &1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN + SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]; + ALL_TAC] THEN + ABBREV_TAC + `A = \n k. (pi * x / &2 pow n) * cot(pi * x / &2 pow n) + + (pi * x / &2 pow (n + 1)) * + sum(1,k) (\m. cot (pi * (x + &m) / &2 pow (n + 1)) + + cot (pi * (x - &m) / &2 pow (n + 1)))` THEN + ABBREV_TAC + `B = \n k. (pi * x / &2 pow (n + 1)) * + sum(k + 1,2 EXP n - 1 - k) + (\m. cot(pi * (x + &m) / &2 pow (n + 1)) + + cot(pi * (x - &m) / &2 pow (n + 1)))` THEN + SUBGOAL_THEN `!n. ~(x - &n = &0)` ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN + SUBGOAL_THEN `x = (x - &n) + &n` SUBST1_TAC THENL + [REAL_ARITH_TAC; ASM_SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(x + &n = &0)` ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN + SUBGOAL_THEN `x = (x + &n) - &n` SUBST1_TAC THENL + [REAL_ARITH_TAC; ASM_SIMP_TAC[integer; REAL_INTEGER_CLOSURES]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(x pow 2 - &n pow 2 = &0)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * a - b * b = (a + b) * (a - b)`] THEN + ASM_REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM]; ALL_TAC] THEN + SUBGOAL_THEN + `!n. (&2 * x) / (x pow 2 - &n pow 2) = inv(x + &n) + inv(x - &n)` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN + EXISTS_TAC `x pow 2 - &n pow 2` THEN ASM_SIMP_TAC[REAL_DIV_LMUL] THEN + REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * a - b * b = (a + b) * (a - b)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(p * m) * p' + (p * m) * m' = m * p * p' + p * m * m'`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!k. (\n. A n k) tends_num_real + (&1 + sum(1,k) (\n. (&2 * x pow 2) / (x pow 2 - &n pow 2)))` + ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN EXPAND_TAC "A" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SEQ_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC COT_LIMIT_LEMMA THEN + ASM_SIMP_TAC[REAL_ENTIRE; PI_POS; REAL_LT_IMP_NZ]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_CMUL] THEN MATCH_MP_TAC SEQ_SUM THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_POW_2; real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x * x) * d = x * (&2 * x) * d`] THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM real_div] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC SEQ_ADD THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(p * x * d) * cc = x * (p * d) * cc`] THEN + CONJ_TAC THEN MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[COT_LIMIT_LEMMA1]; ALL_TAC] THEN + SUBGOAL_THEN + `!k n. &6 * abs(x) < &k + ==> abs(B n k) + <= abs((pi * x / &2 pow (n + 1)) * + cot(pi * x / &2 pow (n + 1))) * + sum(k + 1,2 EXP n - 1 - k) + (\m. (&72 * x pow 2) / (&m pow 2 - &36 * x pow 2))` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + EXPAND_TAC "B" THEN REWRITE_TAC[GSYM SUM_CMUL] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH lhand SUM_ABS_LE (lhand w))) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN + REWRITE_TAC[ARITH_RULE + `k + 1 <= r /\ r < (p - 1 - k) + k + 1 <=> k < r /\ r < p`] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN + EXISTS_TAC `abs(inv(&2 pow (n + 1)))` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`; REAL_LT_INV_EQ; + REAL_POW2_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `abs(cot (pi * x / &2 pow (n + 1)) / &2 pow n) * + (&36 * x pow 2) / (&r pow 2 - &36 * x pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC KNOPP_TERM_BOUND THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `&k` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT]; ALL_TAC] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_POW_ADD; + REAL_ABS_MUL; REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + GEN_REWRITE_TAC RAND_CONV + [AC REAL_MUL_AC `a * b * c * d * e = b * c * d * a * e`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `!e. &0 < e + ==> ?N. !n k:num. N <= k /\ pi * abs(x) <= &2 pow (n + 1) + ==> abs(B n k) < e` + ASSUME_TAC THENL + [X_CHOOSE_TAC `Bd:real` COT_X_BOUND_LEMMA THEN + SUBGOAL_THEN + `!k n. &9 * abs x < &k + ==> abs(sum(k + 1,2 EXP n - 1 - k) + (\m. (&72 * x pow 2) / (&m pow 2 - &36 * x pow 2))) + <= &144 * x pow 2 / &k` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; SUM_CMUL] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_POW; REAL_POW2_ABS] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&144 * x * y = &72 * x * &2 * y`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * sum(k + 1,2 EXP n - 1 - k) (\m. inv(&m * &m))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_CMUL] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH lhand SUM_ABS_LE (lhand w))) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &r * &r - &36 * x * x` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_POW_2] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[REAL_POW_2] THEN + REWRITE_TAC[REAL_ARITH + `&0 < r * r - &36 * x * x <=> (&6 * x) * (&6 * x) < r * r`] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&k` THEN + ASM_REWRITE_TAC[REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `&9 * abs(x) < a ==> &6 * abs(x) < a`] THEN + UNDISCH_TAC `k + 1 <= r` THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LE_INV_EQ] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN + REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `&0 < &r` ASSUME_TAC THENL + [UNDISCH_TAC `k + 1 <= r` THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_MUL] THEN + REWRITE_TAC[REAL_ARITH `&1 * x <= &2 * (x - y) <=> &2 * y <= x`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &81 * x <= y ==> &2 * &36 * x <= y`) THEN + REWRITE_TAC[REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_ARITH `&81 * x * x = (&9 * x) * (&9 * x)`] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&k` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + UNDISCH_TAC `k + 1 <= r` THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[SUM_REINDEX] THEN + SUBGOAL_THEN `?d. k = 1 + d` (CHOOSE_THEN SUBST1_TAC) THENL + [REWRITE_TAC[GSYM LE_EXISTS] THEN + MATCH_MP_TAC(ARITH_RULE `0 < k ==> 1 <= k`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN + UNDISCH_TAC `&9 * abs(x) < &k` THEN REAL_ARITH_TAC; ALL_TAC] THEN + SPEC_TAC(`2 EXP n - 1 - (1 + d)`,`n:num`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o LAND_CONV) [ADD_SYM] THEN + REWRITE_TAC[SUM_REINDEX] THEN + REWRITE_TAC[ARITH_RULE `(r + 1) + 1 = r + 2`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(d,n) (\r. inv(&(r + 1) * &(r + 2)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN REPEAT STRIP_TAC THEN + SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_INV_EQ; REAL_OF_NUM_LT; + REAL_INV_MUL; ARITH_RULE `0 < n + 2`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. sum(d,n) (\r. inv (&(r + 1) * &(r + 2))) = + inv(&(d + 1)) - inv(&(d + n + 1))` + (fun th -> REWRITE_TAC[th]) + THENL + [INDUCT_TAC THEN REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN + ASM_REWRITE_TAC[REAL_ARITH + `((a - x) + y = a - z) <=> (y + z = x)`] THEN + REWRITE_TAC[GSYM ADD_ASSOC; REAL_INV_MUL; + ARITH_RULE `SUC(d + n + 1) = d + n + 2`] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN + EXISTS_TAC `&(d + n + 1) * &(d + n + 2)` THEN + REWRITE_TAC[REAL_ARITH + `(dn1' * dn2' + dn2') * (dn1 * dn2) = + (dn1 * dn1' + dn1) * (dn2 * dn2')`] THEN + SIMP_TAC[REAL_ENTIRE; REAL_MUL_RINV; REAL_OF_NUM_EQ; + ARITH_RULE `~(d + n + 1 = 0) /\ ~(d + n + 2 = 0)`] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; + REAL_OF_NUM_EQ; ARITH_RULE `~(d + n + 1 = 0)`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ADD_AC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x - y <= x`) THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?N. &9 * abs(x) + &1 <= &N /\ + (Bd * &144 * x pow 2) / e + &1 <= &N` + (X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) + THENL + [X_CHOOSE_TAC `N1:num` (SPEC `&9 * abs(x) + &1` REAL_ARCH_SIMPLE) THEN + X_CHOOSE_TAC `N2:num` + (SPEC `(Bd * &144 * x pow 2) / e + &1` REAL_ARCH_SIMPLE) THEN + EXISTS_TAC `N1 + N2:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + ASM_MESON_TAC[REAL_POS; + REAL_ARITH `a <= m /\ b <= n /\ &0 <= m /\ &0 <= n + ==> a <= m + n /\ b <= m + n`]; + ALL_TAC] THEN + EXISTS_TAC `N:num` THEN + MAP_EVERY X_GEN_TAC [`n:num`; `k:num`] THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC + `abs((pi * x / &2 pow (n + 1)) * cot (pi * x / &2 pow (n + 1))) * + sum(k + 1,2 EXP n - 1 - k) + (\m. (&72 * x pow 2) / (&m pow 2 - &36 * x pow 2))` THEN + CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&N` THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `&9 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `Bd * &144 * x pow 2 / &k` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `&0 < &k` (fun th -> SIMP_TAC[REAL_LT_LDIV_EQ; th]) THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `&9 * abs x + &1 <= &N` THEN REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `x + &1 <= y ==> x < y`]] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_ABS] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[real_div; REAL_ENTIRE; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; + REAL_MUL_ASSOC; REAL_LT_INV_EQ; PI_POS] THEN + SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW2_CLAUSES; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS] THEN + ASM_REWRITE_TAC[GSYM real_abs]; ALL_TAC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `&9 * abs x + &1 <= &N` THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `!n k. k < 2 EXP n + ==> ((pi * x) * + (cot (pi * x / &2 pow n) / &2 pow n + + sum (1,2 EXP n - 1) + (\k. cot(pi * (x + &k) / &2 pow (n + 1)) + + cot(pi * (x - &k) / &2 pow (n + 1))) / + &2 pow (n + 1)) = A n k + B n k)` + MP_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXPAND_TAC ["A"; "B"] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; GSYM REAL_ADD_LDISTRIB] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV o funpow 3 LAND_CONV) + [ARITH_RULE `x = 0 + x`] THEN + REWRITE_TAC[SUM_REINDEX] THEN + ONCE_REWRITE_TAC + [REWRITE_RULE[REAL_ARITH `(a = b - c) <=> (c + a = b)`] SUM_DIFF] THEN + ASM_SIMP_TAC[ARITH_RULE `n < p ==> (n + p - 1 - n = p - 1)`] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV o funpow 3 LAND_CONV) + [ARITH_RULE `x = 0 + x`] THEN + REWRITE_TAC[SUM_REINDEX] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COT_HALF_KNOPP) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN DISCH_TAC THEN + REWRITE_TAC[sums; SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC + `!e. &0 < e + ==> ?N. !n k:num. N <= k /\ pi * abs(x) <= &2 pow (n + 1) + ==> abs (B n k) < e` THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N1 + 1` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GE] THEN DISCH_TAC THEN + UNDISCH_TAC + `!k. (\n. A n k) tends_num_real + &1 + sum (1,k) (\n. (&2 * x pow 2) / (x pow 2 - &n pow 2))` THEN + DISCH_THEN(MP_TAC o SPEC `n - 1`) THEN REWRITE_TAC[SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN + SUBGOAL_THEN + `?m. n - 1 < 2 EXP m /\ N2 <= m /\ pi * abs(x) <= &2 pow (m + 1)` + MP_TAC THENL + [SUBGOAL_THEN `?m. &(n - 1) + &1 <= &m /\ &N2 <= &m /\ pi * abs(x) <= &m` + MP_TAC THENL + [X_CHOOSE_TAC `m1:num` (SPEC `&(n - 1) + &1` REAL_ARCH_SIMPLE) THEN + X_CHOOSE_TAC `m2:num` (SPEC `&N2` REAL_ARCH_SIMPLE) THEN + X_CHOOSE_TAC `m3:num` (SPEC `pi * abs(x)` REAL_ARCH_SIMPLE) THEN + EXISTS_TAC `m1 + m2 + m3:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= a /\ y <= b /\ z <= c /\ &0 <= a /\ &0 <= b /\ &0 <= c + ==> x <= a + b + c /\ y <= a + b + c /\ z <= a + b + c`) THEN + ASM_REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_LE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN + MATCH_MP_TAC(REAL_ARITH + `m <= m2 /\ m2 <= m22 + ==> x1 + &1 <= m /\ x2 <= m /\ x3 <= m + ==> x1 < m2 /\ x2 <= m /\ x3 <= m22`) THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN + REWRITE_TAC[REAL_ARITH `x <= x * &2 <=> &0 <= x`] THEN + REWRITE_TAC[REAL_POW2_CLAUSES] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_POW] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + SPEC_TAC(`m:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `SUC(2 EXP n)` THEN + ASM_REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[MULT_2; ADD1; LE_ADD_LCANCEL] THEN + REWRITE_TAC[num_CONV `1`; LE_SUC_LT; EXP_LT_0; ARITH_EQ]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e / &2 + e / &2` THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_LE_REFL; GSYM REAL_MUL_2; REAL_DIV_LMUL; + REAL_OF_NUM_EQ; ARITH_EQ]] THEN + UNDISCH_TAC + `!n k. k < 2 EXP n ==> ((pi * x) * cot (pi * x) = A n k + B n k)` THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n - 1`]) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(b) < e /\ abs((s - &1) - a) < e + ==> abs(s - ((a + b) + &1)) < e + e`) THEN + CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `N1 + 1 <= n` THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `sum (0,n) (\r. (&2 * x pow 2) / (x pow 2 - &r pow 2)) - &1 = + &1 + sum(1,n-1) (\r. (&2 * x pow 2) / (x pow 2 - &r pow 2))` + SUBST1_TAC THENL + [SUBGOAL_THEN `n = 1 + (n - 1)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [UNDISCH_TAC `N1 + 1 <= n` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + MATCH_MP_TAC(REAL_ARITH `(a = &2) ==> ((x + a) - &1 = &1 + x)`) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_DIV_REFL; REAL_POW_EQ_0] THEN + REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Expansion of each term as a power series. *) +(* ------------------------------------------------------------------------- *) + +let COT_PARTIAL_FRACTIONS_SUBTERM = prove + (`abs(x) < &n + ==> (\k. --(&2) * (x pow 2 / &n pow 2) pow (k + 1)) + sums ((&2 * x pow 2) / (x pow 2 - &n pow 2))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &n` ASSUME_TAC THENL + [UNDISCH_TAC `abs(x) < &n` THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\k. (x pow 2 / &n pow 2) pow k) sums + inv(&1 - (x pow 2 / &n pow 2))` + MP_TAC THENL + [MATCH_MP_TAC GP THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_POW_LT2; REAL_ABS_POS; ARITH_EQ]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o + SPEC `--(&2) * (x pow 2 / &n pow 2)` o MATCH_MP SER_CMUL) THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM(CONJUNCT2 real_pow)] THEN + REWRITE_TAC[ADD1]; ALL_TAC] THEN + REWRITE_TAC[real_div; GSYM REAL_INV_MUL; + GSYM REAL_MUL_ASSOC; REAL_MUL_LNEG] THEN + REWRITE_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_DIV_LMUL; REAL_POW_LT; REAL_LT_IMP_NZ]);; + +(* ------------------------------------------------------------------------- *) +(* General theorem about swapping a double series of positive terms. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_LE_CONST = prove + (`!a x l N. (!n. n >= N ==> x(n) <= a) /\ x tends_num_real l ==> l <= a`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SEQ_LE THEN + MAP_EVERY EXISTS_TAC [`x:num->real`; `\n:num. a:real`] THEN + ASM_REWRITE_TAC[SEQ_CONST] THEN ASM_MESON_TAC[]);; + +let SEQ_GE_CONST = prove + (`!a x l N. (!n. n >= N ==> a <= x(n)) /\ x tends_num_real l ==> a <= l`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SEQ_LE THEN + MAP_EVERY EXISTS_TAC [`\n:num. a:real`; `x:num->real`] THEN + ASM_REWRITE_TAC[SEQ_CONST] THEN ASM_MESON_TAC[]);; + +let SUM_SWAP_0 = prove + (`!m n. sum(0,m) (\i. sum(0,n) (\j. a i j)) = + sum(0,n) (\j. sum(0,m) (\i. a i j))`, + INDUCT_TAC THEN + ASM_SIMP_TAC[sum; SUM_CONST; REAL_MUL_RZERO; SUM_ADD]);; + +let SUM_SWAP = prove + (`!m1 m2 n1 n2. + sum(m1,m2) (\i. sum(n1,n2) (\j. a i j)) = + sum(n1,n2) (\j. sum(m1,m2) (\i. a i j))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o LAND_CONV) + [ARITH_RULE `m = 0 + m`] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) + [ARITH_RULE `m = 0 + m`] THEN + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV o LAND_CONV o LAND_CONV) + [ARITH_RULE `m = 0 + m`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV o LAND_CONV o LAND_CONV) + [ARITH_RULE `m = 0 + m`] THEN + REWRITE_TAC[SUM_REINDEX; SUM_SWAP_0]);; + +let SER_SWAPDOUBLE_POS = prove + (`!z a l. (!m n. &0 <= a m n) /\ (!m. (a m) sums (z m)) /\ z sums l + ==> ?s. (!n. (\m. a m n) sums (s n)) /\ s sums l`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!m:num n. sum(0,n) (a m) <= z m` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC SEQ_GE_CONST THEN + EXISTS_TAC `\n. sum(0,n) (a(m:num))` THEN + ASM_REWRITE_TAC[GSYM sums] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `p:num` THEN + SIMP_TAC[GE; LEFT_IMP_EXISTS_THM; LE_EXISTS] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + ASM_SIMP_TAC[GSYM SUM_DIFF; SUM_POS]; ALL_TAC] THEN + SUBGOAL_THEN `!m:num. &0 <= z m` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,n) (a(m:num))` THEN + ASM_SIMP_TAC[SUM_POS]; ALL_TAC] THEN + SUBGOAL_THEN `!n. sum(0,n) z <= l` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SEQ_GE_CONST THEN + EXISTS_TAC `\n. sum(0,n) z` THEN + ASM_REWRITE_TAC[GSYM sums] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `p:num` THEN + SIMP_TAC[GE; LEFT_IMP_EXISTS_THM; LE_EXISTS] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + ASM_SIMP_TAC[GSYM SUM_DIFF; SUM_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= l` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,n) z` THEN + ASM_SIMP_TAC[SUM_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `!e. &0 < e + ==> ?M N. !m n. M <= m /\ N <= n ==> + l - e <= sum(0,m) (\i. sum(0,n) (\j. a i j)) /\ + sum(0,m) (\i. sum(0,n) (\j. a i j)) <= l` + ASSUME_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC `z sums l` THEN + REWRITE_TAC[sums; SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; GE; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + SUBGOAL_THEN + `?N. !m n. m < M /\ n >= N + ==> abs(sum (0,n) (a m) - z m) < e / (&2 * &(M + 1))` + MP_TAC THENL + [SUBGOAL_THEN `&0 < e / (&2 * &(M + 1))` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_MUL; ARITH; + ARITH_RULE `0 < n + 1`]; ALL_TAC] THEN + SPEC_TAC(`e / (&2 * &(M + 1))`,`d:real`) THEN + SPEC_TAC(`M:num`,`n:num`) THEN + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN + UNDISCH_TAC `!m:num. (a m) sums (z m)` THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[sums; SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `N1:num`) THEN + EXISTS_TAC `N0 + N1:num` THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `p:num` THEN + REWRITE_TAC[LT] THEN + ASM_MESON_TAC[ARITH_RULE `a >= m + n ==> a >= m /\ a >= n:num`]; + ALL_TAC] THEN + REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MAP_EVERY EXISTS_TAC [`M:num`; `N:num`] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!s0. s0 <= s /\ s <= l /\ abs(s0 - l) < e + ==> l - e <= s /\ s <= l`) THEN + EXISTS_TAC `sum(0,M) (\i. sum (0,n) (\j. a i j))` THEN + CONJ_TAC THENL + [UNDISCH_TAC `M <= m:num` THEN + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + REWRITE_TAC[GSYM SUM_DIFF] THEN ASM_SIMP_TAC[SUM_POS]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0,m) z` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_LE THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e / &2 + e / &2` THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_LE_REFL; GSYM REAL_MUL_2; REAL_DIV_LMUL; + REAL_OF_NUM_EQ; ARITH_EQ]] THEN + MATCH_MP_TAC(REAL_ARITH + `!z. abs(x - z) <= e /\ abs(z - y) < e ==> abs(x - y) < e + e`) THEN + EXISTS_TAC `sum(0,M) z` THEN ASM_SIMP_TAC[LE_REFL] THEN + REWRITE_TAC[GSYM SUM_SUB] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&M * e / (&2 * &(M + 1))` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (b * c) * a * d`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_POS] THEN + SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < n + 1`] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE; LE_ADD]] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH lhand SUM_ABS_LE (lhand w))) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,M) (\n. e / (&2 * &(M + 1)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + ASM_SIMP_TAC[ADD_CLAUSES; REAL_LT_IMP_LE]; + REWRITE_TAC[SUM_CONST; REAL_LE_REFL]]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. sum(0,m) (\i. (a:num->num->real) i n) <= l` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,M+m) (\i. sum(0,N+n+1) (\j. a i j))` THEN + ASM_SIMP_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y /\ &0 <= z ==> x <= z + y`) THEN + ASM_SIMP_TAC[SUM_POS] THEN MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y /\ &0 <= z ==> x <= y + z`) THEN + ASM_SIMP_TAC[SUM_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(n,1) (\j. a (r:num) j)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_1; REAL_LE_REFL]; ALL_TAC] THEN + SUBST1_TAC(ARITH_RULE `n = 0 + n`) THEN REWRITE_TAC[SUM_REINDEX] THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + ASM_SIMP_TAC[SUM_POS; REAL_LE_ADDL]; ALL_TAC] THEN + SUBGOAL_THEN `!n:num. ?s. (\m. a m n) sums s` MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[sums; GSYM convergent] THEN + MATCH_MP_TAC SEQ_BCONV THEN CONJ_TAC THENL + [MATCH_MP_TAC SEQ_BOUNDED_2 THEN + MAP_EVERY EXISTS_TAC [`&0`; `l:real`] THEN ASM_SIMP_TAC[SUM_POS]; + REWRITE_TAC[mono] THEN DISJ1_TAC THEN + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + ASM_SIMP_TAC[SUM_POS; REAL_LE_ADDL]]; + ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `s:num->real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!e. &0 < e + ==> ?N. !n. N <= n + ==> l - e <= sum (0,n) s /\ sum(0,n) s <= l` + ASSUME_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + ONCE_REWRITE_TAC[SUM_SWAP_0] THEN DISCH_TAC THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `!s0. l - e <= s0 /\ s0 <= s ==> l - e <= s`) THEN + EXISTS_TAC `sum (0,n) (\j. sum (0,M) (\i. a i j))` THEN + ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SEQ_GE_CONST THEN + EXISTS_TAC `\m. sum(0,m) (\m. a m (r:num))` THEN + EXISTS_TAC `M:num` THEN ASM_REWRITE_TAC[GSYM sums] THEN + SIMP_TAC[GE; LEFT_IMP_EXISTS_THM; LE_EXISTS] THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_DIFF)] THEN + ASM_SIMP_TAC[SUM_POS; REAL_LE_ADDL]; ALL_TAC] THEN + MATCH_MP_TAC SEQ_LE_CONST THEN + EXISTS_TAC `\m. sum (0,n) (\j. sum (0,m) (\i. a i j))` THEN + REWRITE_TAC[] THEN EXISTS_TAC `0` THEN CONJ_TAC THENL + [X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN + ONCE_REWRITE_TAC[SUM_SWAP_0] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(0,m) z` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SEQ_SUM THEN X_GEN_TAC `m:num` THEN + ASM_REWRITE_TAC[GSYM sums]; ALL_TAC] THEN + REWRITE_TAC[sums; SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC + `!e. &0 < e + ==> (?N. !n. N <= n ==> l - e <= sum (0,n) s /\ sum (0,n) s <= l)` THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[GE] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN + DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `d < e ==> l - d <= x /\ x <= l ==> abs(x - l) < e`) THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get a power series for cot with nice convergence property. *) +(* ------------------------------------------------------------------------- *) + +let COT_PARTIAL_FRACTIONS_FROM1 = prove + (`~integer x + ==> (\n. (&2 * x pow 2) / (x pow 2 - &(n + 1) pow 2)) sums + (pi * x) * cot (pi * x) - &1`, + DISCH_TAC THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(integer x)` THEN + REWRITE_TAC[TAUT `(~b ==> ~a) <=> (a ==> b)`] THEN + SIMP_TAC[integer; REAL_ABS_NUM; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COT_PARTIAL_FRACTIONS) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN REWRITE_TAC[SUM_1] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b * b) * c = a * (b * b) * c`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ENTIRE; REAL_MUL_RID] THEN + REAL_ARITH_TAC);; + +let COT_ALT_POWSER = prove + (`!x. &0 < abs(x) /\ abs(x) < &1 + ==> ?s. (!n. (\m. &2 * (x pow 2 / &(m + 1) pow 2) pow (n + 1)) + sums s n) /\ + s sums --((pi * x) * cot(pi * x) - &1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_SWAPDOUBLE_POS THEN + EXISTS_TAC `\n. (--(&2) * x pow 2) / (x pow 2 - &(n + 1) pow 2)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[REAL_POS; REAL_POW_LE; REAL_LE_MUL; + REAL_POW_2; REAL_LE_DIV; REAL_LE_SQUARE]; + X_GEN_TAC `m:num` THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV) + [GSYM REAL_NEG_NEG] THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG] THEN + MATCH_MP_TAC SER_NEG THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC COT_PARTIAL_FRACTIONS_SUBTERM THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + REWRITE_TAC[real_div; REAL_MUL_LNEG] THEN + MATCH_MP_TAC SER_NEG THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC COT_PARTIAL_FRACTIONS_FROM1 THEN + UNDISCH_TAC `&0 < abs x` THEN UNDISCH_TAC `abs x < &1` THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> ~c <=> c ==> ~(a /\ b)`] THEN + SIMP_TAC[integer; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* General unpairing result. *) +(* ------------------------------------------------------------------------- *) + +let SER_INSERTZEROS = prove + (`(\n. c(2 * n)) sums l + ==> (\n. if ODD n then &0 else c(n)) sums l`, + REWRITE_TAC[sums; SEQ; GE] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `2 * N` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + DISJ_CASES_THEN MP_TAC (SPEC `n:num` EVEN_OR_ODD) THENL + [REWRITE_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[ONCE_REWRITE_RULE[MULT_SYM] (GSYM SUM_GROUP)] THEN + REWRITE_TAC[SUM_2; ODD_ADD; ODD_MULT; ARITH_ODD; REAL_ADD_RID] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `2 * N <= 2 * m` THEN ARITH_TAC; + REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[GSYM ODD_EXISTS] THEN REWRITE_TAC[sum] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[MULT_SYM] (GSYM SUM_GROUP)] THEN + REWRITE_TAC[SUM_2; ODD_ADD; ODD_MULT; ARITH_ODD; REAL_ADD_RID] THEN + ONCE_REWRITE_TAC[ARITH_RULE `0 + 2 * m = 2 * (0 + m)`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 sum)] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `2 * N <= SUC(2 * m)` THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Mangle this into a standard power series. *) +(* ------------------------------------------------------------------------- *) + +let COT_POWSER_SQUARED_FORM = prove + (`!x. &0 < abs(x) /\ abs(x) < pi + ==> (\n. &2 * (x / pi) pow (2 * (n + 1)) * + suminf (\m. inv (&(m + 1) pow (2 * (n + 1))))) + sums --(x * cot x - &1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x / pi` COT_ALT_POWSER) THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS] THEN + REWRITE_TAC[GSYM real_abs] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; PI_POS] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; PI_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `s sums --(x * cot(x) - &1)` THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SER_CMUL o SPEC `n:num`) THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2 * (x / pi) pow (2 * (n + 1)))`) THEN + REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ABS_CONV o + RAND_CONV o ONCE_DEPTH_CONV) + [REAL_POW_DIV] THEN + REWRITE_TAC[REAL_POW_POW] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ABS_CONV o + RAND_CONV o ONCE_DEPTH_CONV) + [real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * &2 * b * c = c * ((&2 * b) * a)`] THEN + SUBGOAL_THEN + `~(&2 * (x / pi) pow (2 * (n + 1)) = &0)` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH_EQ; REAL_POW_EQ_0] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN + REWRITE_TAC[real_div; REAL_ENTIRE; REAL_INV_EQ_0] THEN + ASM_SIMP_TAC[PI_POS; REAL_LT_IMP_NZ; + snd(EQ_IMP_RULE(SPEC_ALL REAL_ABS_NZ))]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN + DISCH_THEN(MP_TAC o AP_TERM `( * ) (&2 * (x / pi) pow (2 * (n + 1)))`) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [AC REAL_MUL_AC `a * b * c = (a * b) * c`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC]);; + +let COT_POWSER_SQUAREDAGAIN = prove + (`!x. &0 < abs(x) /\ abs(x) < pi + ==> (\n. (if n = 0 then &1 + else --(&2) * + suminf (\m. inv (&(m + 1) pow (2 * n))) / + pi pow (2 * n)) * + x pow (2 * n)) + sums (x * cot(x))`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COT_POWSER_SQUARED_FORM) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\n. if n = 0 then &1 else + --(&2 * (x / pi) pow (2 * n) * + suminf (\m. inv (&(m + 1) pow (2 * n))))) + sums (sum(0,1) (\n. if n = 0 then &1 else + --(&2 * (x / pi) pow (2 * n) * + suminf (\m. inv (&(m + 1) pow (2 * n))))) + + suminf (\n. if n + 1 = 0 then &1 else + --(&2 * (x / pi) pow (2 * (n + 1)) * + suminf (\m. inv (&(m + 1) pow (2 * (n + 1)))))))` + MP_TAC THENL + [MATCH_MP_TAC SER_OFFSET_REV THEN + REWRITE_TAC[ARITH_RULE `~(n + 1 = 0)`] THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC `x * cot(x) - &1` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUM_1; ARITH_RULE `~(n + 1 = 0)`] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + REWRITE_TAC[REAL_ARITH `&1 + x - &1 = x`] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; real_pow; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_POW_DIV; REAL_MUL_LNEG] THEN AP_TERM_TAC THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let COT_X_POWSER = prove + (`!x. &0 < abs(x) /\ abs(x) < pi + ==> (\n. (if n = 0 then &1 else if ODD n then &0 else + --(&2) * suminf (\m. inv (&(m + 1) pow n)) / pi pow n) * + x pow n) + sums (x * cot(x))`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COT_POWSER_SQUAREDAGAIN) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [ARITH_RULE `(n = 0) <=> (2 * n = 0)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_INSERTZEROS) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Hence use the double-angle formula to get a series for tangent. *) +(* ------------------------------------------------------------------------- *) + +let TAN_COT_DOUBLE = prove + (`!x. &0 < abs(x) /\ abs(x) < pi / &2 + ==> (tan(x) = cot(x) - &2 * cot(&2 * x))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sin x = &0)` ASSUME_TAC THENL + [REWRITE_TAC[SIN_ZERO] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN + REWRITE_TAC[OR_EXISTS_THM] THEN + REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + ASM_CASES_TAC `m = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; REAL_MUL_LZERO; REAL_LT_REFL] THEN + DISJ1_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN + SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(cos x = &0)` ASSUME_TAC THENL + [REWRITE_TAC[COS_ZERO] THEN + MAP_EVERY UNDISCH_TAC [`abs x < pi / &2`; `&0 < abs x`] THEN + REWRITE_TAC[IMP_IMP] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN + REWRITE_TAC[OR_EXISTS_THM; NOT_EVEN] THEN + REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + DISJ2_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN + SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(sin(&2 * x) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[SIN_ZERO] THEN + MAP_EVERY UNDISCH_TAC [`abs x < pi / &2`; `&0 < abs x`] THEN + REWRITE_TAC[IMP_IMP] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN + REWRITE_TAC[OR_EXISTS_THM] THEN + REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + ASM_CASES_TAC `m = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; REAL_MUL_LZERO; REAL_LT_REFL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISJ2_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN + SIMP_TAC[REAL_LT_DIV2_EQ; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; + REAL_OF_NUM_LT] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN + SIMP_TAC[REAL_LT_RMUL_EQ; PI_POS; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[tan; cot] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN + EXISTS_TAC `sin(&2 * x)` THEN ASM_REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(d * e - &2 * f * g) * h = h * d * e - &2 * f * (h * g)`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `sin(x)` THEN + ASM_SIMP_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC; + REAL_MUL_LINV; REAL_MUL_RID] THEN + GEN_REWRITE_TAC LAND_CONV + [AC REAL_MUL_AC `a * b * c * d = a * c * d * b`] THEN + MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN EXISTS_TAC `cos(x)` THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID] THEN + REWRITE_TAC[SIN_DOUBLE; COS_DOUBLE; REAL_POW_2] THEN + REWRITE_TAC[REAL_ARITH + `((&2 * s * c) * c - &2 * (c * c - s * s) * s) * c = + &2 * c * s * s * s`] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let TAN_POWSER_WEAK = prove + (`!x. &0 < abs(x) /\ abs(x) < pi / &2 + ==> (\n. (if EVEN n then &0 else + &2 * (&2 pow (n + 1) - &1) * + suminf (\m. inv (&(m + 1) pow (n + 1))) / pi pow (n + 1)) * + x pow n) + sums (tan x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x:real` COT_X_POWSER) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `pi / &2` THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ABS_NZ; REAL_MUL_LID] THEN + MP_TAC(SPEC `&2 * x` COT_X_POWSER) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_NUM; + REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [AC REAL_MUL_AC `a * (b * c) * d = (a * c) * b * d`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ABS_NZ; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN + ASM_SIMP_TAC[GSYM TAN_COT_DOUBLE] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN + DISCH_THEN(ASSUME_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN + ASM_REWRITE_TAC[SUM_1] THEN + REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_SUB_REFL; REAL_SUB_RZERO] THEN + REWRITE_TAC[ODD_ADD; ARITH_ODD; ADD_EQ_0; ARITH_EQ] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[NOT_ODD] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `x' * m2 * s * xp * x - x' * m2 * s * pn * t * xp * x = + (x' * x) * --m2 * (t * pn - &1) * s * xp`] THEN + ASM_SIMP_TAC[REAL_NEG_NEG; REAL_MUL_LINV; REAL_ABS_NZ; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let TAN_POWSER = prove + (`!x. abs(x) < pi / &2 + ==> (\n. (if EVEN n then &0 else + &2 * (&2 pow (n + 1) - &1) * + suminf (\m. inv (&(m + 1) pow (n + 1))) / pi pow (n + 1)) * + x pow n) + sums (tan x)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `&0 < abs(x)` THEN ASM_SIMP_TAC[TAN_POWSER_WEAK] THEN + DISCH_THEN(K ALL_TAC) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_ABS_NZ] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[TAN_0] THEN + W(fun (asl,w) -> MP_TAC(SPECL [lhand w; `0`] SER_0)) THEN + REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + UNDISCH_TAC `~(EVEN n)` THEN + REWRITE_TAC[NOT_EVEN; ODD_EXISTS; real_pow; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Add polynomials to differentiator's known functions, for next proofs. *) +(* ------------------------------------------------------------------------- *) + +let th = prove + (`(f diffl l)(x) ==> + ((\x. poly p (f x)) diffl (l * poly (poly_diff p) (f x)))(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(SPECL [`\x. poly p x`; `f:real->real`; + `poly (poly_diff p) (f(x:real))`; + `l:real`; `x:real`] DIFF_CHAIN) THEN + ASM_REWRITE_TAC[POLY_DIFF]) in +add_to_diff_net th;; + +(* ------------------------------------------------------------------------- *) +(* Main recurrence relation. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_CHAIN_TAN = prove + (`~(cos x = &0) + ==> ((\x. poly p (tan x)) diffl + (poly ([&1; &0; &1] ** poly_diff p) (tan x))) (x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[tan] THEN + W(MP_TAC o SPEC `x:real` o DIFF_CONV o lhand o rator o snd) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[POLY_MUL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[poly; REAL_MUL_RID; REAL_MUL_RZERO; REAL_ADD_RID; + REAL_ADD_LID] THEN + REWRITE_TAC[REAL_ARITH `a - --s * s = (s * s + a)`] THEN + REWRITE_TAC[GSYM REAL_POW_2; SIN_CIRCLE] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_POW2_ABS] THEN + ASM_SIMP_TAC[REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_EQ_LDIV_EQ] THEN + REWRITE_TAC[REAL_POW2_ABS] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM REAL_POW_MUL] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[SIN_CIRCLE]);; + +(* ------------------------------------------------------------------------- *) +(* Define tangent polynomials and tangent numbers on this pattern. *) +(* ------------------------------------------------------------------------- *) + +let tanpoly = new_recursive_definition num_RECURSION + `(tanpoly 0 = [&0; &1]) /\ + (!n. tanpoly (SUC n) = [&1; &0; &1] ** poly_diff(tanpoly n))`;; + +let TANPOLYS_RULE = + let pth1,pth2 = CONJ_PAIR tanpoly in + let base = [pth1] + and rule = GEN_REWRITE_RULE LAND_CONV [GSYM pth2] in + let poly_diff_tm = `poly_diff` + and poly_mul_tm = `( ** ) [&1; &0; &1]` in + let rec tanpolys n = + if n < 0 then [] + else if n = 0 then base else + let thl = tanpolys (n - 1) in + let th1 = AP_TERM poly_diff_tm (hd thl) in + let th2 = TRANS th1 (POLY_DIFF_CONV (rand(concl th1))) in + let th3 = AP_TERM poly_mul_tm th2 in + let th4 = TRANS th3 (POLY_MUL_CONV (rand(concl th3))) in + let th5 = rule th4 in + let th6 = CONV_RULE (LAND_CONV(RAND_CONV NUM_SUC_CONV)) th5 in + th6::thl in + rev o tanpolys;; + +let TANPOLY_CONV = + let tanpoly_tm = `tanpoly` in + fun tm -> + let l,r = dest_comb tm in + if l <> tanpoly_tm then failwith "TANPOLY_CONV" + else last(TANPOLYS_RULE(dest_small_numeral r));; + +let tannumber = new_definition + `tannumber n = poly (tanpoly n) (&0)`;; + +let TANNUMBERS_RULE,TANNUMBER_CONV = + let POLY_0_THM = prove + (`(poly [] (&0) = &0) /\ + (poly (CONS h t) (&0) = h)`, + REWRITE_TAC[poly; REAL_MUL_LZERO; REAL_ADD_RID]) in + let poly_tm = `poly` + and zero_tm = `&0` + and tannumber_tm = `tannumber` + and depoly_conv = GEN_REWRITE_CONV I [POLY_0_THM] + and tannumber_rule = GEN_REWRITE_RULE LAND_CONV [GSYM tannumber] in + let process th = + let th1 = AP_THM (AP_TERM poly_tm th) zero_tm in + let th2 = TRANS th1 (depoly_conv (rand(concl th1))) in + let th3 = tannumber_rule th2 in + th3 in + let TANNUMBERS_RULE = map process o TANPOLYS_RULE + and TANNUMBER_CONV tm = + let l,r = dest_comb tm in + if l <> tannumber_tm then failwith "TANNUMBER_CONV" else + process(last(TANPOLYS_RULE(dest_small_numeral r))) in + TANNUMBERS_RULE,TANNUMBER_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Chaining rules using the tangent polynomials. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_CHAIN_TAN_TANPOLYS = prove + (`~(cos x = &0) + ==> ((\x. poly (tanpoly n) (tan x)) diffl + (poly (tanpoly(SUC n)) (tan x))) (x)`, + REWRITE_TAC[tanpoly; DIFF_CHAIN_TAN]);; + +let th = prove + (`(f diffl l)(x) /\ ~(cos(f x) = &0) + ==> ((\x. poly (tanpoly n) (tan(f x))) diffl + (l * poly (tanpoly(SUC n)) (tan(f x))))(x)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(SPECL [`\x. poly (tanpoly n) (tan x)`; `f:real->real`; + `poly (tanpoly(SUC n)) (tan(f(x:real)))`; + `l:real`; `x:real`] DIFF_CHAIN) THEN + ASM_SIMP_TAC[DIFF_CHAIN_TAN_TANPOLYS]) in +add_to_diff_net th;; + +(* ------------------------------------------------------------------------- *) +(* Hence rewrite coefficients of tan and cot series in terms of tannumbers. *) +(* ------------------------------------------------------------------------- *) + +let TERMDIFF_ALT = prove + (`!f f' c k. + (!x. abs(x) < k ==> (\n. c(n) * x pow n) sums f(x)) + ==> (!x. abs(x) < k ==> (f diffl f'(x))(x)) + ==> (!x. abs(x) < k ==> (\n. (diffs c)(n) * x pow n) sums f'(x))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `summable (\n. diffs c n * x pow n) /\ + (f'(x) = suminf (\n. diffs c n * x pow n))` + MP_TAC THENL + [ALL_TAC; SIMP_TAC[SUMMABLE_SUM]] THEN + CONJ_TAC THENL + [UNDISCH_TAC `abs(x) < k` THEN SPEC_TAC(`x:real`,`x:real`) THEN + MATCH_MP_TAC TERMDIFF_CONVERGES THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[summable] THEN + EXISTS_TAC `(f:real->real) x` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + MATCH_MP_TAC DIFF_LCONST THEN + EXISTS_TAC `\x. f x - suminf (\n. c(n) * x pow n)` THEN + EXISTS_TAC `x:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFF_SUB THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC TERMDIFF_STRONG THEN + EXISTS_TAC `(abs(x) + k) / &2` THEN CONJ_TAC THENL + [REWRITE_TAC[summable] THEN + EXISTS_TAC `(f:real->real)((abs(x) + k) / &2)` THEN + FIRST_ASSUM MATCH_MP_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_LDIV_EQ; + REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < k` THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `k - abs(x)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `(a = b) /\ (c = d) ==> (a - b = c - d)`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `abs(x - y) < k - abs(x)` THEN REAL_ARITH_TAC);; + +let TAN_DERIV_POWSER = prove + (`!n x. abs(x) < pi / &2 + ==> (\m. ITER n diffs + (\i. if EVEN i + then &0 + else &2 * + (&2 pow (i + 1) - &1) * + suminf (\m. inv (&(m + 1) pow (i + 1))) / + pi pow (i + 1)) m * + x pow m) + sums (poly (tanpoly n) (tan x))`, + INDUCT_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[ITER; tanpoly; poly] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RZERO; REAL_MUL_RID] THEN + ASM_SIMP_TAC[TAN_POWSER]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP TERMDIFF_ALT) THEN + REWRITE_TAC[ITER] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC DIFF_CHAIN_TAN_TANPOLYS THEN + REWRITE_TAC[COS_ZERO] THEN + UNDISCH_TAC `abs x < pi / &2` THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN + REWRITE_TAC[OR_EXISTS_THM; NOT_EVEN] THEN + REWRITE_TAC[TAUT `a /\ b \/ a /\ c <=> a /\ (b \/ c)`] THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(x = a) \/ (x = --a) ==> &0 <= a ==> (abs(x) = a)`)) THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_LT_IMP_LE; PI_POS; REAL_POS] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `x = &1 * x`] THEN + SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + ARITH_TAC);; + +let ITER_DIFFS_LEMMA = prove + (`!n c. ITER n diffs c 0 = &(FACT n) * c(n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ITER_ALT; diffs; FACT; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_MUL_AC]);; + +let TANNUMBER_HARMONICSUMS = prove + (`!n. ODD n + ==> (&2 * (&2 pow (n + 1) - &1) * &(FACT n) * + suminf (\m. inv (&(m + 1) pow (n + 1))) / pi pow (n + 1) = + tannumber n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `&0`] TAN_DERIV_POWSER) THEN + SIMP_TAC[REAL_ABS_NUM; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + REWRITE_TAC[TAN_0; GSYM tannumber] THEN + MP_TAC(SPECL + [`\m. ITER n diffs + (\i. if EVEN i + then &0 + else &2 * + (&2 pow (i + 1) - &1) * + suminf (\m. inv (&(m + 1) pow (i + 1))) / pi pow (i + 1)) + m * + &0 pow m`; + `1`] SER_0) THEN + REWRITE_TAC[SUM_1] THEN + SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL REAL_POW_EQ_0)); + ARITH_RULE `1 <= n ==> ~(n = 0)`] THEN + REWRITE_TAC[REAL_MUL_RZERO; real_pow] THEN + ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_UNIQ) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ITER_DIFFS_LEMMA; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[GSYM NOT_ODD] THEN REWRITE_TAC[REAL_MUL_AC]);; + +let HARMONICSUMS_TANNUMBER = prove + (`!n. EVEN n /\ ~(n = 0) + ==> (suminf (\m. inv (&(m + 1) pow n)) / pi pow n = + tannumber(n - 1) / (&2 * &(FACT(n - 1)) * (&2 pow n - &1)))`, + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EVEN; NOT_EVEN] THEN + REWRITE_TAC[SUC_SUB1] THEN SIMP_TAC[GSYM TANNUMBER_HARMONICSUMS] THEN + REWRITE_TAC[ADD1] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (a * c * b) * d`] THEN + REWRITE_TAC[real_div] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b * c) * d = a * (b * c) * d`] THEN + REWRITE_TAC[GSYM real_div] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_DIV_LMUL THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT] THEN + REWRITE_TAC[REAL_SUB_LT] THEN + REWRITE_TAC[REAL_POW2_CLAUSES; ADD_EQ_0; ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* For uniformity, show that even tannumbers are zero. *) +(* ------------------------------------------------------------------------- *) + +let ODD_POLY_DIFF = prove + (`(!x. poly p (--x) = poly p x) + ==> (!x. poly (poly_diff p) (--x) = --(poly(poly_diff p) x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_UNIQ THEN + EXISTS_TAC `\x. poly p (--x)` THEN EXISTS_TAC `--x` THEN CONJ_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o SYM o HALF_MK_ABS o GSYM) THEN + REWRITE_TAC[CONV_RULE(ONCE_DEPTH_CONV ETA_CONV) POLY_DIFF]; + MP_TAC(SPECL [`\x. poly p x`; `\x. --x`; `poly (poly_diff p) x`; + `--(&1)`; `--x`] + DIFF_CHAIN) THEN + REWRITE_TAC[POLY_DIFF; REAL_MUL_RNEG; REAL_MUL_RID; REAL_NEG_NEG] THEN + DISCH_THEN MATCH_MP_TAC THEN + W(MP_TAC o SPEC `--x` o DIFF_CONV o lhand o rator o snd) THEN + REWRITE_TAC[]]);; + +let EVEN_POLY_DIFF = prove + (`(!x. poly p (--x) = --(poly p x)) + ==> (!x. poly (poly_diff p) (--x) = poly(poly_diff p) x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_UNIQ THEN + EXISTS_TAC `\x. poly p x` THEN EXISTS_TAC `--x` THEN + REWRITE_TAC[POLY_DIFF] THEN + FIRST_ASSUM(MP_TAC o + ONCE_REWRITE_RULE[REAL_ARITH `(a = --b) <=> (--a = b)`]) THEN + DISCH_THEN(SUBST1_TAC o HALF_MK_ABS o GSYM) THEN + REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NEG_NEG] THEN + MATCH_MP_TAC DIFF_NEG THEN + MP_TAC(SPECL [`\x. poly p x`; `\x. --x`; `poly (poly_diff p) x`; + `--(&1)`; `--x`] + DIFF_CHAIN) THEN + REWRITE_TAC[POLY_DIFF; REAL_MUL_RNEG; REAL_MUL_RID; REAL_NEG_NEG] THEN + DISCH_THEN MATCH_MP_TAC THEN + W(MP_TAC o SPEC `--x` o DIFF_CONV o lhand o rator o snd) THEN + REWRITE_TAC[]);; + +let TANPOLY_ODD_EVEN = prove + (`!n x. (poly (tanpoly n) (--x) = + if EVEN n then --(poly (tanpoly n) x) else poly (tanpoly n) x)`, + INDUCT_TAC THENL + [REWRITE_TAC[EVEN; tanpoly] THEN + CONV_TAC(ONCE_DEPTH_CONV POLY_DIFF_CONV) THEN + REWRITE_TAC[poly] THEN REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[EVEN] THEN + ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[tanpoly; POLY_MUL; ODD_POLY_DIFF; EVEN_POLY_DIFF] THEN + REWRITE_TAC[REAL_MUL_RNEG] THEN TRY AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; + +let TANNUMBER_EVEN = prove + (`!n. EVEN n ==> (tannumber n = &0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[tannumber] THEN + MATCH_MP_TAC(REAL_ARITH `(x = --x) ==> (x = &0)`) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_NEG_0] THEN + ASM_SIMP_TAC[TANPOLY_ODD_EVEN]);; + +(* ------------------------------------------------------------------------- *) +(* Hence get tidy series. *) +(* ------------------------------------------------------------------------- *) + +let TAYLOR_TAN_CONVERGES = prove + (`!x. abs(x) < pi / &2 + ==> (\n. tannumber n / &(FACT n) * x pow n) sums (tan x)`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP TAN_POWSER) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[real_div; TANNUMBER_EVEN; REAL_MUL_LZERO; REAL_MUL_RZERO]; + ALL_TAC] THEN + ASM_SIMP_TAC[HARMONICSUMS_TANNUMBER; EVEN_ADD; ARITH; ADD_EQ_0] THEN + REWRITE_TAC[ADD_SUB; real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * a' * d * b' * e = (c * d * e) * ((a * a') * (b * b'))`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN AP_TERM_TAC THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_MUL_RINV THEN + SIMP_TAC[REAL_ARITH `&1 < x ==> ~(x - &1 = &0)`; + REAL_POW2_CLAUSES; ADD_EQ_0; ARITH_EQ]);; + +let TAYLOR_X_COT_CONVERGES = prove + (`!x. &0 < abs(x) /\ abs(x) < pi + ==> (\n. (if n = 0 then &1 else + tannumber (n - 1) / ((&1 - &2 pow n) * &(FACT(n - 1)))) * + x pow n) + sums (x * cot(x))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COT_X_POWSER) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `ODD n` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `tannumber(n - 1) = &0` + (fun th -> SIMP_TAC[th; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]) THEN + MATCH_MP_TAC TANNUMBER_EVEN THEN + UNDISCH_TAC `ODD n` THEN + SUBGOAL_THEN `n = SUC(n - 1)` MP_TAC THENL + [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[ODD; NOT_ODD]; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[HARMONICSUMS_TANNUMBER; GSYM NOT_ODD] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `--(&2) * x * y * z * a = (&2 * y) * x * --a * z`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM REAL_INV_NEG; REAL_NEG_SUB; REAL_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Get a simple bound on the tannumbers. *) +(* ------------------------------------------------------------------------- *) + +let TANNUMBER_BOUND = prove + (`!n. abs(tannumber n) <= &4 * &(FACT n) * (&2 / pi) pow (n + 1)`, + GEN_TAC THEN DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THEN + ASM_SIMP_TAC[TANNUMBER_EVEN; GSYM TANNUMBER_HARMONICSUMS] THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [REAL_ABS_NUM; REAL_LE_MUL; REAL_POW_LE; REAL_POS; REAL_LE_DIV; + PI_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e = (a * d) * c * b * e`] THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `&2 * x <= &4 <=> x <= &2`] THEN + MP_TAC(SPEC `\m. inv (&(m + 1) pow (n + 1))` SER_ABS) THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; REAL_ABS_POW] THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN + UNDISCH_TAC `ODD n` THEN + SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `suminf (\m. inv(&(m + 1) pow 2))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SER_LE THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH_RULE `0 < n + 1`] THEN + MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + UNDISCH_TAC `ODD n` THEN + SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN ARITH_TAC; + MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN + UNDISCH_TAC `ODD n` THEN + SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN ARITH_TAC; + MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN REWRITE_TAC[LE_REFL]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,1) (\n. inv(&(n + 1) pow 2)) + + suminf (\n. inv(&((n + 1) + 1) pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `(y = x) ==> x <= y`) THEN + MATCH_MP_TAC SUM_UNIQ THEN + MATCH_MP_TAC SER_OFFSET_REV THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC + `suminf (\n. inv(&(n + 1) pow 2)) - + sum(0,1) (\n. inv(&(n + 1) pow 2))` THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] SER_OFFSET) THEN + MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN REWRITE_TAC[LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[SUM_1; ADD_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 + x <= &2 <=> x <= &1`] THEN + SUBST1_TAC(MATCH_MP SUM_UNIQ SUMMABLE_INVERSE_SQUARES_LEMMA) THEN + MATCH_MP_TAC SER_LE THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `m:num` THEN REWRITE_TAC[REAL_POW_2] THEN + REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + REWRITE_TAC[REAL_POW_2; REAL_INV_MUL; REAL_ABS_INV; REAL_ABS_NUM; + REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; + REWRITE_TAC[summable] THEN + EXISTS_TAC + `suminf (\n. inv(&(n + 1) pow 2)) - + sum(0,1) (\n. inv(&(n + 1) pow 2))` THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] SER_OFFSET) THEN + MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN REWRITE_TAC[LE_REFL]; + REWRITE_TAC[summable] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[SUMMABLE_INVERSE_SQUARES_LEMMA]]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_POW_INV] THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + SIMP_TAC[real_abs; PI_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM real_abs] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LT; REAL_LT_IMP_LE; PI_POS] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 <= x ==> abs(x - &1) <= x`) THEN + REWRITE_TAC[REAL_POW2_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Also get some harmonic sums. *) +(* ------------------------------------------------------------------------- *) + +let HARMONIC_SUMS = prove + (`!n. (\m. inv (&(m + 1) pow (2 * (n + 1)))) + sums (pi pow (2 * (n + 1)) * + tannumber(2 * n + 1) / + (&2 * (&2 pow (2 * (n + 1)) - &1) * &(FACT(2 * n + 1))))`, + GEN_TAC THEN + SUBGOAL_THEN `summable (\m. inv (&(m + 1) pow (2 * (n + 1))))` MP_TAC THENL + [MATCH_MP_TAC SUMMABLE_INVERSE_POWERS THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; REAL_POW_LT; PI_POS] THEN + REWRITE_TAC[ARITH_RULE `2 * n + 1 = 2 * (n + 1) - 1`] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = a * c * b`] THEN + MATCH_MP_TAC HARMONICSUMS_TANNUMBER THEN + REWRITE_TAC[MULT_EQ_0; ADD_EQ_0; ARITH; EVEN_MULT]);; + +let mk_harmonic = + let pth = prove + (`x * &1 / n = x / n`, + REWRITE_TAC[real_div; REAL_MUL_LID]) in + let final_RULE = CONV_RULE(TRY_CONV(GEN_REWRITE_CONV RAND_CONV [pth])) in + fun n -> + let th1 = SPEC(mk_small_numeral((n-1)/2)) HARMONIC_SUMS in + let th2 = CONV_RULE NUM_REDUCE_CONV th1 in + let th3 = CONV_RULE(ONCE_DEPTH_CONV TANNUMBER_CONV) th2 in + let th4 = CONV_RULE REAL_RAT_REDUCE_CONV th3 in + final_RULE th4;; + +(* ------------------------------------------------------------------------- *) +(* A little test. *) +(* ------------------------------------------------------------------------- *) + +map (fun n -> time mk_harmonic (2 * n)) (0--8);; + +(* ------------------------------------------------------------------------- *) +(* Isolate the most famous special case. *) +(* ------------------------------------------------------------------------- *) + +let EULER_HARMONIC_SUM = mk_harmonic 2;; + +(* ------------------------------------------------------------------------- *) +(* Canonical Taylor series for tan and cot with truncation bounds. *) +(* ------------------------------------------------------------------------- *) + +let TAYLOR_TAN_BOUND_GENERAL = prove + (`!x n. abs(x) <= &1 + ==> abs(tan x - sum (0,n) (\m. tannumber m / &(FACT m) * x pow m)) + <= &12 * (&2 / &3) pow (n + 1) * abs(x) pow n`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs(x) < pi / &2` MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP TAYLOR_TAN_CONVERGES) THEN + DISCH_THEN(fun th -> + ASSUME_TAC th THEN MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_ABS_IMP) THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC SEQ_LE_CONST THEN + EXISTS_TAC `\r. abs(sum(0,r) (\m. (tannumber(m + n) / &(FACT(m + n))) * + x pow (m + n)))` THEN + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN + W(MP_TAC o PART_MATCH lhand SUM_ABS_LE o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum(0,m) (\r. &4 * (&2 / pi) pow (r + n + 1) * abs(x pow (r + n)))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; + REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; FACT_LT] THEN + MP_TAC(SPEC `r + n:num` TANNUMBER_BOUND) THEN + REWRITE_TAC[REAL_MUL_AC; GSYM ADD_ASSOC]; ALL_TAC] THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN + REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ABS_POW; GSYM REAL_POW_MUL] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC] THEN + REWRITE_TAC[SUM_CMUL] THEN + SUBGOAL_THEN `&2 / pi * abs(x) < &2 / &3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / pi * &1` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; + PI_POS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; PI_POS] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `~(&2 / pi * abs(x) = &1)` ASSUME_TAC THENL + [UNDISCH_TAC `&2 / pi * abs x < &2 / &3` THEN + ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN + SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_POW_MUL; GSYM REAL_ABS_POW; + REAL_ABS_MUL; REAL_ABS_ABS] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; real_div; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= a ==> abs(p - a) <= e ==> b <= abs p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH + `&4 * x * y <= &12 * z <=> x * y <= z * &3`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL; real_div; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= a ==> abs(p - a) <= e ==> b <= abs p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + ASM_SIMP_TAC[GP_FINITE] THEN + REWRITE_TAC[REAL_ABS_DIV] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= &1 ==> abs(&1 - x) <= &1`) THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [REAL_POW_LE; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; + REAL_ABS_POS; PI_POS; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [REAL_POW_LE; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; + REAL_ABS_POS; PI_POS; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / pi * &1` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LE_DIV; REAL_POS; + REAL_LT_IMP_LE; PI_POS] THEN + SIMP_TAC[REAL_MUL_RID; REAL_LE_LDIV_EQ; PI_POS] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= a ==> abs(p - a) <= e ==> b <= &1 * p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_INV] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH + `x <= (&1 - a) * &1 ==> a <= abs(&1 - x)`) THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; PI_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= a ==> abs(p - a) <= e ==> b <= p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let TAYLOR_TAN_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) + ==> abs(tan x - + sum (0,n) (\m. tannumber(m) / &(FACT(m)) * x pow m)) + <= &12 * (&2 / &3) pow (n + 1) * inv(&2 pow (k * n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&12 * (&2 / &3) pow (n + 1) * abs(x) pow n` THEN + CONJ_TAC THENL + [MATCH_MP_TAC TAYLOR_TAN_BOUND_GENERAL THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN + REWRITE_TAC[REAL_POW2_THM; LE_0]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_LE_DIV; REAL_POS] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW_INV] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]]);; + +let TAYLOR_TANX_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) + ==> abs(tan x / x - + sum (0,n) (\m. tannumber(m+1) / &(FACT(m+1)) * x pow m)) + <= &12 * (&2 / &3) pow (n + 2) * inv(&2 pow (k * n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM SUM_CMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [AC REAL_MUL_AC `a * b * c = b * (a * c)`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + REWRITE_TAC[ADD1; SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET] THEN + REWRITE_TAC[SUM_1] THEN + CONV_TAC(ONCE_DEPTH_CONV TANNUMBER_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[real_pow] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&12 * (&2 / &3) pow ((n + 1) + 1) * abs(x) pow (n + 1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC TAYLOR_TAN_BOUND_GENERAL THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN + REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + REWRITE_TAC[GSYM ADD1; real_pow] THEN + GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC + `(a * b * c) * d = (a * b * d) * c`] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [REAL_LE_MUL; REAL_POW_LE; REAL_ABS_POS; REAL_LE_DIV; REAL_POS] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW_INV] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; + +let TAYLOR_TANX_SQRT_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ &0 < x + ==> abs(tan (sqrt x) / sqrt(x) - + sum(0,n) (\m. tannumber(2 * m + 1) / &(FACT(2 * m + 1)) * + x pow m)) + <= &12 * (&2 / &3) pow (2 * n + 2) * + inv(&2 pow (k DIV 2 * 2 * n))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`sqrt x`; `2 * n`; `k DIV 2`] TAYLOR_TANX_BOUND) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; DIV_EQ_0; ARITH_EQ; NOT_LT] THEN + SUBGOAL_THEN `&2 pow (k DIV 2) = sqrt(&2 pow (2 * (k DIV 2)))` + SUBST1_TAC THENL + [SIMP_TAC[SQRT_EVEN_POW2; EVEN_MULT; ARITH_EVEN; DIV_MULT; ARITH_EQ]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM SQRT_INV; REAL_LT_IMP_LE; REAL_POW2_CLAUSES] THEN + ASM_SIMP_TAC[real_abs; SQRT_POS_LT; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_POW2_CLAUSES] THEN + MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + MESON_TAC[LE_ADD; DIVISION; NUM_EQ_CONV `2 = 0`; MULT_SYM]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM SUM_GROUP] THEN + SIMP_TAC[SUM_2; TANNUMBER_EVEN; ARITH_EVEN; EVEN_ADD; EVEN_MULT] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ADD_RID] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_POW_POW; SQRT_POW_2; REAL_LT_IMP_LE]);; + +let TAYLOR_COT_BOUND_GENERAL = prove + (`!x n. abs(x) <= &1 /\ ~(x = &0) + ==> abs((&1 / x - cot x) - + sum (0,n) (\m. (tannumber m / + ((&2 pow (m+1) - &1) * &(FACT(m)))) * + x pow m)) + <= &4 * (abs(x) / &3) pow n`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL] THEN REWRITE_TAC[GSYM SUM_CMUL] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `x * a * y = a * x * y`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN REWRITE_TAC[ADD1] THEN + REWRITE_TAC[SUM_1; REAL_MUL_LZERO; REAL_SUB_RZERO; real_pow] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN `abs(x) < pi` MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ABS_NZ]) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP TAYLOR_X_COT_CONVERGES) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN + DISCH_THEN(ASSUME_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN + ASM_REWRITE_TAC[SUM_1; ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[real_pow; REAL_MUL_LID] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN + REWRITE_TAC[REAL_NEG_SUB] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_RNEG] THEN + REWRITE_TAC[GSYM REAL_INV_NEG] THEN + REWRITE_TAC[GSYM real_div] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[ADD_SUB] THEN + DISCH_THEN(fun th -> + ASSUME_TAC th THEN MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_ABS_IMP) THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC SEQ_LE_CONST THEN + FIRST_ASSUM(fun th -> + EXISTS_TAC(lhand(concl th)) THEN EXISTS_TAC `0` THEN + CONJ_TAC THENL [ALL_TAC; ACCEPT_TAC th]) THEN + X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH lhand SUM_ABS_LE o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum(0,m) (\r. &4 * + (&2 / pi) pow (r + n + 1) / (&2 pow (r + n + 1) - &1) * + abs(x pow (r + n + 1)))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC `a * b * c = (c * a) * b`] THEN + REWRITE_TAC[REAL_MUL_ASSOC; real_abs; REAL_SUB_LE] THEN + REWRITE_TAC[REAL_POW2_CLAUSES] THEN REWRITE_TAC[GSYM real_abs] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_SUB_LE; REAL_POW2_CLAUSES] THEN + SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_ABS_NUM; + REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; FACT_LT] THEN + MP_TAC(SPEC `r + n:num` TANNUMBER_BOUND) THEN + REWRITE_TAC[REAL_MUL_AC; GSYM ADD_ASSOC]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [AC REAL_MUL_AC `a * (b * c) * d = a * c * (b * d)`] THEN + REWRITE_TAC[REAL_ABS_POW; GSYM REAL_POW_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum(0,m) (\r. &8 * inv(&2 pow (r + n + 1)) * + ((&2 * inv pi) * abs x) pow (r + n + 1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&4 * x <= &8 * y <=> x <= &2 * y`] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [REAL_POW_LE; REAL_LE_MUL; REAL_ABS_POS; REAL_POS; + REAL_LT_IMP_LE; PI_POS; REAL_LE_INV_EQ] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_INV_INV] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; + ARITH; REAL_POW_LT] THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; real_pow] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 * x <= &2 * x - &1 <=> &1 <= x`] THEN + REWRITE_TAC[REAL_POW2_CLAUSES]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_POW_INV; GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `(&1 * x) * y = y * x`] THEN + REWRITE_TAC[GSYM real_div] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_ADD] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN + REWRITE_TAC[SUM_CMUL] THEN + SUBGOAL_THEN + `(&4 * abs x) * (abs x * &1 / &3) pow n = + &12 * (abs x / &3) pow (n + 1)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV + [AC REAL_MUL_AC `a * b * c * d * e = (a * e) * d * b * c`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&8 * &3 / &2`)) THEN + GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC + `(a * b) * c = (a * c) * b`] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_ABS] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= a ==> abs(p - a) <= e ==> b <= abs p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `abs(x) / pi < &1 / &3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&1 / pi` THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; PI_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e < a ==> abs(p - a) <= e ==> b < p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `~(abs(x) / pi = &1)` ASSUME_TAC THENL + [UNDISCH_TAC `abs x / pi < &1 / &3` THEN + ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN + SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + ASM_SIMP_TAC[GP_FINITE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x - &1 = --(&1 - x)`] THEN + REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= &1 ==> abs(&1 - x) <= &1`) THEN + SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_ABS_POS; + REAL_LT_IMP_LE; PI_POS] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_LE_INV_EQ; + REAL_LT_IMP_LE; PI_POS] THEN + SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; PI_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC PI_APPROX_25_BITS THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= a ==> abs(p - a) <= e ==> b <= &1 * p`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM real_div] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a ==> b <= &1 - a ==> b <= abs(&1 - x)`)) THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let TAYLOR_COT_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) + ==> abs((&1 / x - cot x) - + sum (0,n) (\m. (tannumber m / + ((&2 pow (m+1) - &1) * &(FACT(m)))) * + x pow m)) + <= &4 / &3 pow n * inv(&2 pow (k * n))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs(x) <= &1 /\ ~(x = &0)` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN + REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP TAYLOR_COT_BOUND_GENERAL) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[real_div; REAL_POW_MUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[GSYM REAL_POW_INV; GSYM REAL_POW_POW] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; REAL_ABS_POS] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV]);; + +let TAYLOR_COTX_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) + ==> abs((&1 / x - cot x) / x - + sum (0,n) (\m. (tannumber(m+1) / + ((&2 pow (m+2) - &1) * &(FACT(m+1)))) * + x pow m)) + <= (&4 / &3) / &3 pow n * inv(&2 pow (k * n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM SUM_CMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [AC REAL_MUL_AC `a * b * c = b * (a * c)`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + REWRITE_TAC[ARITH_RULE `n + 2 = (n + 1) + 1`] THEN + REWRITE_TAC[ADD1; SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET] THEN + REWRITE_TAC[SUM_1] THEN + CONV_TAC(ONCE_DEPTH_CONV TANNUMBER_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[real_pow] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN + SUBGOAL_THEN `abs(x) <= &1 /\ ~(x = &0)` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN + REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `n + 1` o MATCH_MP TAYLOR_COT_BOUND_GENERAL) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = ((a * d) * b) * c`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_POW_MUL; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM REAL_POW_POW; GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_INV_MUL; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_LE_DIV; REAL_POS] THEN + REWRITE_TAC[REAL_INV_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let TAYLOR_COTXX_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(x = &0) + ==> abs((&1 - x * cot(x)) - + sum(0,n) (\m. (tannumber (m-1) / + ((&2 pow m - &1) * &(FACT(m-1)))) * + x pow m)) + <= &12 / &3 pow n * inv(&2 pow (k * n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `abs(inv x)` THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_INV_EQ_0] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_RDISTRIB] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) + [AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN + SUBGOAL_THEN `abs(x) <= &1 /\ ~(x = &0)` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2 pow 0)`)) THEN + REWRITE_TAC[REAL_POW2_THM; LE_0]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `n - 1` o MATCH_MP TAYLOR_COT_BOUND_GENERAL) THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[sum] THEN + REWRITE_TAC[real_pow; real_div; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; MULT_CLAUSES; REAL_INV_MUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_DIV] THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2 pow 0)` THEN + REWRITE_TAC[REAL_POW2_THM; LE_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `n = (n - 1) + 1` MP_TAC THENL + [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (RAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN + REWRITE_TAC[SUB_0; ADD_SUB; SUM_1] THEN + SIMP_TAC[TANNUMBER_EVEN; EVEN] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ADD_RID] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) + [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM SUM_CMUL] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC(REAL_ARITH + `(s1 = s2) /\ a <= b ==> s1 <= a ==> s2 <= b`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_RID] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; GSYM REAL_MUL_ASSOC] THEN + REPEAT AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID]; ALL_TAC] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC; real_div] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_POW_INV] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + REWRITE_TAC[GSYM REAL_POW_INV] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD1] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REWRITE_TAC[REAL_ABS_POS; REAL_POW_INV]);; + +let TAYLOR_COTXX_SQRT_BOUND = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ &0 < x + ==> abs((&1 - sqrt(x) * cot(sqrt(x))) - + sum(0,n) (\m. (tannumber (2*m-1) / + ((&2 pow (2*m) - &1) * &(FACT(2*m-1)))) * + x pow m)) + <= &12 / &3 pow (2 * n) * inv(&2 pow (k DIV 2 * 2 * n))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`sqrt x`; `2 * n`; `k DIV 2`] TAYLOR_COTXX_BOUND) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; DIV_EQ_0; ARITH_EQ; NOT_LT] THEN + SUBGOAL_THEN `&2 pow (k DIV 2) = sqrt(&2 pow (2 * (k DIV 2)))` + SUBST1_TAC THENL + [SIMP_TAC[SQRT_EVEN_POW2; EVEN_MULT; ARITH_EVEN; DIV_MULT; ARITH_EQ]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM SQRT_INV; REAL_LT_IMP_LE; REAL_POW2_CLAUSES] THEN + ASM_SIMP_TAC[real_abs; SQRT_POS_LT; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN SIMP_TAC[REAL_POW2_CLAUSES] THEN + MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + MESON_TAC[LE_ADD; DIVISION; NUM_EQ_CONV `2 = 0`; MULT_SYM]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM SUM_GROUP] THEN + SUBGOAL_THEN `!n. EVEN(((n * 2) + 1) - 1)` ASSUME_TAC THENL + [INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; SUC_SUB1; SUB_0; + MULT_CLAUSES; SUB_REFL; ADD_SUB] THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH]; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_2; TANNUMBER_EVEN; ARITH_EVEN; EVEN_ADD; EVEN_MULT] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ADD_RID] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_POW_POW; SQRT_POW_2; REAL_LT_IMP_LE]);; diff --git a/100/platonic.ml b/100/platonic.ml new file mode 100644 index 0000000..306d04b --- /dev/null +++ b/100/platonic.ml @@ -0,0 +1,2179 @@ +(* ========================================================================= *) +(* The five Platonic solids exist and there are no others. *) +(* ========================================================================= *) + +needs "100/polyhedron.ml";; +needs "Multivariate/cross.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Some standard regular polyhedra (vertex coordinates from Wikipedia). *) +(* ------------------------------------------------------------------------- *) + +let std_tetrahedron = new_definition + `std_tetrahedron = + convex hull + {vector[&1;&1;&1],vector[-- &1;-- &1;&1], + vector[-- &1;&1;-- &1],vector[&1;-- &1;-- &1]}:real^3->bool`;; + +let std_cube = new_definition + `std_cube = + convex hull + {vector[&1;&1;&1],vector[&1;&1;-- &1], + vector[&1;-- &1;&1],vector[&1;-- &1;-- &1], + vector[-- &1;&1;&1],vector[-- &1;&1;-- &1], + vector[-- &1;-- &1;&1],vector[-- &1;-- &1;-- &1]}:real^3->bool`;; + +let std_octahedron = new_definition + `std_octahedron = + convex hull + {vector[&1;&0;&0],vector[-- &1;&0;&0], + vector[&0;&0;&1],vector[&0;&0;-- &1], + vector[&0;&1;&0],vector[&0;-- &1;&0]}:real^3->bool`;; + +let std_dodecahedron = new_definition + `std_dodecahedron = + let p = (&1 + sqrt(&5)) / &2 in + convex hull + {vector[&1;&1;&1],vector[&1;&1;-- &1], + vector[&1;-- &1;&1],vector[&1;-- &1;-- &1], + vector[-- &1;&1;&1],vector[-- &1;&1;-- &1], + vector[-- &1;-- &1;&1],vector[-- &1;-- &1;-- &1], + vector[&0;inv p;p],vector[&0;inv p;--p], + vector[&0;--inv p;p],vector[&0;--inv p;--p], + vector[inv p;p;&0],vector[inv p;--p;&0], + vector[--inv p;p;&0],vector[--inv p;--p;&0], + vector[p;&0;inv p],vector[--p;&0;inv p], + vector[p;&0;--inv p],vector[--p;&0;--inv p]}:real^3->bool`;; + +let std_icosahedron = new_definition + `std_icosahedron = + let p = (&1 + sqrt(&5)) / &2 in + convex hull + {vector[&0; &1; p],vector[&0; &1; --p], + vector[&0; -- &1; p],vector[&0; -- &1; --p], + vector[&1; p; &0],vector[&1; --p; &0], + vector[-- &1; p; &0],vector[-- &1; --p; &0], + vector[p; &0; &1],vector[--p; &0; &1], + vector[p; &0; -- &1],vector[--p; &0; -- &1]}:real^3->bool`;; + +(* ------------------------------------------------------------------------- *) +(* Slightly ad hoc conversions for computation in Q[sqrt(5)]. *) +(* Numbers are canonically represented as either a rational constant r or an *) +(* expression r1 + r2 * sqrt(5) where r2 is nonzero but r1 may be zero and *) +(* must be present. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT5_OF_RAT_CONV = + let pth = prove + (`p = p + &0 * sqrt(&5)`, + REAL_ARITH_TAC) in + let conv = REWR_CONV pth in + fun tm -> if is_ratconst tm then conv tm else REFL tm;; + +let REAL_RAT_OF_RAT5_CONV = + let pth = prove + (`p + &0 * sqrt(&5) = p`, + REAL_ARITH_TAC) in + GEN_REWRITE_CONV TRY_CONV [pth];; + +let REAL_RAT5_ADD_CONV = + let pth = prove + (`(a1 + b1 * sqrt(&5)) + (a2 + b2 * sqrt(&5)) = + (a1 + a2) + (b1 + b2) * sqrt(&5)`, + REAL_ARITH_TAC) in + REAL_RAT_ADD_CONV ORELSEC + (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC + GEN_REWRITE_CONV I [pth] THENC + LAND_CONV REAL_RAT_ADD_CONV THENC + RAND_CONV(LAND_CONV REAL_RAT_ADD_CONV) THENC + REAL_RAT_OF_RAT5_CONV);; + +let REAL_RAT5_SUB_CONV = + let pth = prove + (`(a1 + b1 * sqrt(&5)) - (a2 + b2 * sqrt(&5)) = + (a1 - a2) + (b1 - b2) * sqrt(&5)`, + REAL_ARITH_TAC) in + REAL_RAT_SUB_CONV ORELSEC + (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC + GEN_REWRITE_CONV I [pth] THENC + LAND_CONV REAL_RAT_SUB_CONV THENC + RAND_CONV(LAND_CONV REAL_RAT_SUB_CONV) THENC + REAL_RAT_OF_RAT5_CONV);; + +let REAL_RAT5_MUL_CONV = + let pth = prove + (`(a1 + b1 * sqrt(&5)) * (a2 + b2 * sqrt(&5)) = + (a1 * a2 + &5 * b1 * b2) + (a1 * b2 + a2 * b1) * sqrt(&5)`, + MP_TAC(ISPEC `&5` SQRT_POW_2) THEN CONV_TAC REAL_FIELD) in + REAL_RAT_MUL_CONV ORELSEC + (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC + GEN_REWRITE_CONV I [pth] THENC + LAND_CONV(COMB_CONV (RAND_CONV REAL_RAT_MUL_CONV) THENC + RAND_CONV REAL_RAT_MUL_CONV THENC + REAL_RAT_ADD_CONV) THENC + RAND_CONV(LAND_CONV + (BINOP_CONV REAL_RAT_MUL_CONV THENC REAL_RAT_ADD_CONV)) THENC + REAL_RAT_OF_RAT5_CONV);; + +let REAL_RAT5_INV_CONV = + let pth = prove + (`~(a pow 2 = &5 * b pow 2) + ==> inv(a + b * sqrt(&5)) = + a / (a pow 2 - &5 * b pow 2) + + --b / (a pow 2 - &5 * b pow 2) * sqrt(&5)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_SUB_0] THEN + SUBGOAL_THEN + `a pow 2 - &5 * b pow 2 = (a + b * sqrt(&5)) * (a - b * sqrt(&5))` + SUBST1_TAC THENL + [MP_TAC(SPEC `&5` SQRT_POW_2) THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONV_TAC REAL_FIELD]) in + fun tm -> + try REAL_RAT_INV_CONV tm with Failure _ -> + let th1 = PART_MATCH (lhs o rand) pth tm in + let th2 = MP th1 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th1)))) in + let th3 = CONV_RULE(funpow 2 RAND_CONV (funpow 2 LAND_CONV + REAL_RAT_NEG_CONV)) th2 in + let th4 = CONV_RULE(RAND_CONV(RAND_CONV(LAND_CONV + (RAND_CONV(LAND_CONV REAL_RAT_POW_CONV THENC + RAND_CONV(RAND_CONV REAL_RAT_POW_CONV THENC + REAL_RAT_MUL_CONV) THENC + REAL_RAT_SUB_CONV) THENC + REAL_RAT_DIV_CONV)))) th3 in + let th5 = CONV_RULE(RAND_CONV(LAND_CONV + (RAND_CONV(LAND_CONV REAL_RAT_POW_CONV THENC + RAND_CONV(RAND_CONV REAL_RAT_POW_CONV THENC + REAL_RAT_MUL_CONV) THENC + REAL_RAT_SUB_CONV) THENC + REAL_RAT_DIV_CONV))) th4 in + th5;; + +let REAL_RAT5_DIV_CONV = + GEN_REWRITE_CONV I [real_div] THENC + RAND_CONV REAL_RAT5_INV_CONV THENC + REAL_RAT5_MUL_CONV;; + +let REAL_RAT5_LE_CONV = + let lemma = prove + (`!x y. x <= y * sqrt(&5) <=> + x <= &0 /\ &0 <= y \/ + &0 <= x /\ &0 <= y /\ x pow 2 <= &5 * y pow 2 \/ + x <= &0 /\ y <= &0 /\ &5 * y pow 2 <= x pow 2`, + REPEAT GEN_TAC THEN MP_TAC(ISPEC `&5` SQRT_POW_2) THEN + REWRITE_TAC[REAL_POS] THEN DISCH_THEN(fun th -> + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN + REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_LE_SQUARE_ABS] THEN + MP_TAC(ISPECL [`sqrt(&5)`; `y:real`] (CONJUNCT1 REAL_LE_MUL_EQ)) THEN + SIMP_TAC[SQRT_POS_LT; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC) in + let pth = prove + (`(a1 + b1 * sqrt(&5)) <= (a2 + b2 * sqrt(&5)) <=> + a1 <= a2 /\ b1 <= b2 \/ + a2 <= a1 /\ b1 <= b2 /\ (a1 - a2) pow 2 <= &5 * (b2 - b1) pow 2 \/ + a1 <= a2 /\ b2 <= b1 /\ &5 * (b2 - b1) pow 2 <= (a1 - a2) pow 2`, + REWRITE_TAC[REAL_ARITH + `a + b * x <= a' + b' * x <=> a - a' <= (b' - b) * x`] THEN + REWRITE_TAC[lemma] THEN REAL_ARITH_TAC) in + REAL_RAT_LE_CONV ORELSEC + (BINOP_CONV REAL_RAT5_OF_RAT_CONV THENC + GEN_REWRITE_CONV I [pth] THENC + REAL_RAT_REDUCE_CONV);; + +let REAL_RAT5_EQ_CONV = + GEN_REWRITE_CONV I [GSYM REAL_LE_ANTISYM] THENC + BINOP_CONV REAL_RAT5_LE_CONV THENC + GEN_REWRITE_CONV I [AND_CLAUSES];; + +(* ------------------------------------------------------------------------- *) +(* Conversions for operations on 3D vectors with coordinates in Q[sqrt(5)] *) +(* ------------------------------------------------------------------------- *) + +let VECTOR3_SUB_CONV = + let pth = prove + (`vector[x1;x2;x3] - vector[y1;y2;y3]:real^3 = + vector[x1-y1; x2-y2; x3-y3]`, + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3] THEN + REWRITE_TAC[VECTOR_3; VECTOR_SUB_COMPONENT]) in + GEN_REWRITE_CONV I [pth] THENC RAND_CONV(LIST_CONV REAL_RAT5_SUB_CONV);; + +let VECTOR3_CROSS_CONV = + let pth = prove + (`(vector[x1;x2;x3]) cross (vector[y1;y2;y3]) = + vector[x2 * y3 - x3 * y2; x3 * y1 - x1 * y3; x1 * y2 - x2 * y1]`, + REWRITE_TAC[cross; VECTOR_3]) in + GEN_REWRITE_CONV I [pth] THENC + RAND_CONV(LIST_CONV(BINOP_CONV REAL_RAT5_MUL_CONV THENC REAL_RAT5_SUB_CONV));; + +let VECTOR3_EQ_0_CONV = + let pth = prove + (`vector[x1;x2;x3]:real^3 = vec 0 <=> + x1 = &0 /\ x2 = &0 /\ x3 = &0`, + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3] THEN + REWRITE_TAC[VECTOR_3; VEC_COMPONENT]) in + GEN_REWRITE_CONV I [pth] THENC + DEPTH_BINOP_CONV `(/\)` REAL_RAT5_EQ_CONV THENC + REWRITE_CONV[];; + +let VECTOR3_DOT_CONV = + let pth = prove + (`(vector[x1;x2;x3]:real^3) dot (vector[y1;y2;y3]) = + x1*y1 + x2*y2 + x3*y3`, + REWRITE_TAC[DOT_3; VECTOR_3]) in + GEN_REWRITE_CONV I [pth] THENC + DEPTH_BINOP_CONV `(+):real->real->real` REAL_RAT5_MUL_CONV THENC + RAND_CONV REAL_RAT5_ADD_CONV THENC + REAL_RAT5_ADD_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Put any irrational coordinates in our standard form. *) +(* ------------------------------------------------------------------------- *) + +let STD_DODECAHEDRON = prove + (`std_dodecahedron = + convex hull + { vector[&1; &1; &1], + vector[&1; &1; -- &1], + vector[&1; -- &1; &1], + vector[&1; -- &1; -- &1], + vector[-- &1; &1; &1], + vector[-- &1; &1; -- &1], + vector[-- &1; -- &1; &1], + vector[-- &1; -- &1; -- &1], + vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], + vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], + vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], + vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], + vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], + vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], + vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], + vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], + vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], + vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], + vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], + vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)]}`, + let golden_inverse = prove + (`inv((&1 + sqrt(&5)) / &2) = -- &1 / &2 + &1 / &2 * sqrt(&5)`, + MP_TAC(ISPEC `&5` SQRT_POW_2) THEN CONV_TAC REAL_FIELD) in + REWRITE_TAC[std_dodecahedron] THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[golden_inverse] THEN + REWRITE_TAC[REAL_ARITH `(&1 + s) / &2 = &1 / &2 + &1 / &2 * s`] THEN + REWRITE_TAC[REAL_ARITH `--(a + b * sqrt(&5)) = --a + --b * sqrt(&5)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[]);; + +let STD_ICOSAHEDRON = prove + (`std_icosahedron = + convex hull + { vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)], + vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], + vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)], + vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], + vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], + vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], + vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], + vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], + vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], + vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], + vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], + vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1]}`, + REWRITE_TAC[std_icosahedron] THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[REAL_ARITH `(&1 + s) / &2 = &1 / &2 + &1 / &2 * s`] THEN + REWRITE_TAC[REAL_ARITH `--(a + b * sqrt(&5)) = --a + --b * sqrt(&5)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit computation of facets. *) +(* ------------------------------------------------------------------------- *) + +let COMPUTE_FACES_2 = prove + (`!f s:real^3->bool. + FINITE s + ==> (f face_of (convex hull s) /\ aff_dim f = &2 <=> + ?x y z. x IN s /\ y IN s /\ z IN s /\ + let a = (z - x) cross (y - x) in + ~(a = vec 0) /\ + let b = a dot x in + ((!w. w IN s ==> a dot w <= b) \/ + (!w. w IN s ==> a dot w >= b)) /\ + f = convex hull (s INTER {x | a dot x = b}))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `?t:real^3->bool. t SUBSET s /\ f = convex hull t` + MP_TAC THENL + [MATCH_MP_TAC FACE_OF_CONVEX_HULL_SUBSET THEN + ASM_SIMP_TAC[FINITE_IMP_COMPACT]; + DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool` MP_TAC)] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_CONVEX_HULL]) THEN + MP_TAC(ISPEC `t:real^3->bool` AFFINE_BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^3->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(u:real^3->bool) HAS_SIZE 3` MP_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; AFFINE_INDEPENDENT_IMP_FINITE] THEN + REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN MATCH_MP_TAC(INT_ARITH + `aff_dim(u:real^3->bool) = &2 /\ aff_dim u = &(CARD u) - &1 + ==> &(CARD u):int = &3`) THEN CONJ_TAC + THENL [ASM_MESON_TAC[AFF_DIM_AFFINE_HULL]; ASM_MESON_TAC[AFF_DIM_UNIQUE]]; + ALL_TAC] THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN + REPLICATE_TAC 3 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REPEAT LET_TAC THEN + SUBGOAL_THEN `~collinear{x:real^3,y,z}` MP_TAC THENL + [ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `{x,y,z} = {z,x,y}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[GSYM CROSS_EQ_0] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:real^3) dot y = b /\ (a:real^3) dot z = b` + STRIP_ASSUME_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`(z - x) cross (y - x) = a`; `(a:real^3) dot x = b`] THEN VEC3_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`convex hull s:real^3->bool`; `convex hull t:real^3->bool`] + EXPOSED_FACE_OF_POLYHEDRON) THEN + ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; exposed_face_of] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a':real^3`; `b':real`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN + `aff_dim(t:real^3->bool) + <= aff_dim({x:real^3 | a dot x = b} INTER {x | a' dot x = b'})` + MP_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [SYM th]) THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN + REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t:real^3->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull t:real^3->bool` THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFF_DIM_HYPERPLANE; + AFFINE_HYPERPLANE; DIMINDEX_3] THEN + REPEAT(COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [SUBSET_HYPERPLANES]) THEN + ASM_REWRITE_TAC[HYPERPLANE_EQ_EMPTY] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (MP_TAC o SYM)) THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN + SUBGOAL_THEN `s SUBSET {x:real^3 | a dot x = b}` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull s:real^3->bool` THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `affine hull t:real^3->bool` THEN + REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN + ASM_SIMP_TAC[real_ge; REAL_LE_REFL]; + ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(TAUT `(~p /\ ~q ==> F) ==> p \/ q`) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_ge; REAL_NOT_LE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `u:real^3`) (X_CHOOSE_TAC `v:real^3`)) THEN + SUBGOAL_THEN `(a':real^3) dot u < b' /\ a' dot v < b'` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC + [SET_RULE `f x <= b /\ ~(f x = b) <=> + x IN {x | f x <= b} /\ ~(x IN {x | f x = b})`] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NE] THEN + SUBGOAL_THEN `(u:real^3) IN convex hull s /\ v IN convex hull s` + MP_TAC THENL [ASM_SIMP_TAC[HULL_INC]; ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `?w:real^3. w IN segment[u,v] /\ w IN {w | a' dot w = b'}` + MP_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN + MAP_EVERY EXISTS_TAC [`v:real^3`; `u:real^3`] THEN + ASM_SIMP_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT; REAL_LT_IMP_LE]; + REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[UNWIND_THM2; DOT_RADD; DOT_RMUL; CONJ_ASSOC] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH `a < b ==> a = b ==> F`) THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull t:real^3->bool` THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + REWRITE_TAC[SUBSET_INTER] THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN + REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN + REPEAT LET_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `convex hull (s INTER {x:real^3 | a dot x = b}) = + (convex hull s) INTER {x | a dot x = b}` + SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET_INTER; HULL_MONO; INTER_SUBSET] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN + REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]; + ALL_TAC] THEN + ASM_CASES_TAC `s SUBSET {x:real^3 | a dot x = b}` THENL + [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `convex hull (convex hull (s INTER {x:real^3 | a dot x = b}) UNION + convex hull (s DIFF {x | a dot x = b})) INTER + {x | a dot x = b}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> (s INTER u) SUBSET (t INTER u)`) THEN + MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC(SET_RULE + `s INTER t SUBSET (P hull (s INTER t)) /\ + s DIFF t SUBSET (P hull (s DIFF t)) + ==> s SUBSET (P hull (s INTER t)) UNION (P hull (s DIFF t))`) THEN + REWRITE_TAC[HULL_SUBSET]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CONVEX_HULL_UNION_NONEMPTY_EXPLICIT o + lhand o lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[CONVEX_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY] THEN ASM SET_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`p:real^3`; `u:real`; `q:real^3`] THEN + REPLICATE_TAC 4 DISCH_TAC THEN ASM_CASES_TAC `u = &0` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % p + &0 % q:real^N = p`] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x < y ==> ~(x = y)`) THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - u) * p = (&1 - u) * b /\ u * q < u * b + ==> (&1 - u) * p + u * q < b`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN + SET_TAC[]; + SIMP_TAC[IN_ELIM_THM]]; + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE + `(a:real^3) dot q < b <=> q IN {x | a dot x < b}`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LT] THEN + ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; REAL_LT_LE]]; + MATCH_MP_TAC(REAL_ARITH `x > y ==> ~(x = y)`) THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - u) * p = (&1 - u) * b /\ u * b < u * q + ==> (&1 - u) * p + u * q > b`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN + SET_TAC[]; + SIMP_TAC[IN_ELIM_THM]]; + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM real_gt]] THEN + ONCE_REWRITE_TAC[SET_RULE + `(a:real^3) dot q > b <=> q IN {x | a dot x > b}`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN + ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; real_gt; REAL_LT_LE]]]; + ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LE] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GE] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]]; + REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `aff_dim {x:real^3 | a dot x = b}` THEN CONJ_TAC THENL + [MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN + SET_TAC[]; + ASM_SIMP_TAC[AFF_DIM_HYPERPLANE; DIMINDEX_3] THEN INT_ARITH_TAC]; + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim {x:real^3,y,z}` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `~collinear{x:real^3,y,z}` MP_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{x,y,z} = {z,x,y}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + ASM_REWRITE_TAC[GSYM CROSS_EQ_0]; + REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT; DE_MORGAN_THM] THEN + STRIP_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + CONV_TAC INT_REDUCE_CONV; + MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM_REWRITE_TAC[INSERT_SUBSET] THEN + REWRITE_TAC[EMPTY_SUBSET] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC HULL_INC THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + MAP_EVERY UNDISCH_TAC + [`(z - x) cross (y - x) = a`; `(a:real^3) dot x = b`] THEN + VEC3_TAC]]]]);; + +let COMPUTE_FACES_2_STEP_1 = prove + (`!f v s t:real^3->bool. + (?x y z. x IN (v INSERT s) /\ y IN (v INSERT s) /\ z IN (v INSERT s) /\ + let a = (z - x) cross (y - x) in + ~(a = vec 0) /\ + let b = a dot x in + ((!w. w IN t ==> a dot w <= b) \/ + (!w. w IN t ==> a dot w >= b)) /\ + f = convex hull (t INTER {x | a dot x = b})) <=> + (?y z. y IN s /\ z IN s /\ + let a = (z - v) cross (y - v) in + ~(a = vec 0) /\ + let b = a dot v in + ((!w. w IN t ==> a dot w <= b) \/ + (!w. w IN t ==> a dot w >= b)) /\ + f = convex hull (t INTER {x | a dot x = b})) \/ + (?x y z. x IN s /\ y IN s /\ z IN s /\ + let a = (z - x) cross (y - x) in + ~(a = vec 0) /\ + let b = a dot x in + ((!w. w IN t ==> a dot w <= b) \/ + (!w. w IN t ==> a dot w >= b)) /\ + f = convex hull (t INTER {x | a dot x = b}))`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_INSERT] THEN MATCH_MP_TAC(MESON[] + `(!x y z. Q x y z ==> Q x z y) /\ + (!x y z. Q x y z ==> Q y x z) /\ + (!x z. ~(Q x x z)) + ==> ((?x y z. (x = v \/ P x) /\ (y = v \/ P y) /\ (z = v \/ P z) /\ + Q x y z) <=> + (?y z. P y /\ P z /\ Q v y z) \/ + (?x y z. P x /\ P y /\ P z /\ Q x y z))`) THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[VECTOR_SUB_REFL; CROSS_0] THEN + CONJ_TAC THEN REPEAT GEN_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + MAP_EVERY (SUBST1_TAC o VEC3_RULE) + [`(z - y) cross (x - y) = --((z - x) cross (y - x))`; + `(y - x) cross (z - x) = --((z - x) cross (y - x))`] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2; + real_ge] THEN + REWRITE_TAC[DISJ_ACI] THEN + REWRITE_TAC[VEC3_RULE + `((z - x) cross (y - x)) dot y = ((z - x) cross (y - x)) dot x`]);; + +let COMPUTE_FACES_2_STEP_2 = prove + (`!f u v s:real^3->bool. + (?y z. y IN (u INSERT s) /\ z IN (u INSERT s) /\ + let a = (z - v) cross (y - v) in + ~(a = vec 0) /\ + let b = a dot v in + ((!w. w IN t ==> a dot w <= b) \/ + (!w. w IN t ==> a dot w >= b)) /\ + f = convex hull (t INTER {x | a dot x = b})) <=> + (?z. z IN s /\ + let a = (z - v) cross (u - v) in + ~(a = vec 0) /\ + let b = a dot v in + ((!w. w IN t ==> a dot w <= b) \/ + (!w. w IN t ==> a dot w >= b)) /\ + f = convex hull (t INTER {x | a dot x = b})) \/ + (?y z. y IN s /\ z IN s /\ + let a = (z - v) cross (y - v) in + ~(a = vec 0) /\ + let b = a dot v in + ((!w. w IN t ==> a dot w <= b) \/ + (!w. w IN t ==> a dot w >= b)) /\ + f = convex hull (t INTER {x | a dot x = b}))`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_INSERT] THEN MATCH_MP_TAC(MESON[] + `(!x y. Q x y ==> Q y x) /\ + (!x. ~(Q x x)) + ==> ((?y z. (y = u \/ P y) /\ (z = u \/ P z) /\ + Q y z) <=> + (?z. P z /\ Q u z) \/ + (?y z. P y /\ P z /\ Q y z))`) THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[CROSS_REFL] THEN REPEAT GEN_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN SUBST1_TAC + (VEC3_RULE `(x - v) cross (y - v) = --((y - v) cross (x - v))`) THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2; + real_ge] THEN REWRITE_TAC[DISJ_ACI]);; + +let COMPUTE_FACES_TAC = + let lemma = prove + (`(x INSERT s) INTER {x | P x} = + if P x then x INSERT (s INTER {x | P x}) + else s INTER {x | P x}`, + COND_CASES_TAC THEN ASM SET_TAC[]) in + SIMP_TAC[COMPUTE_FACES_2; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[COMPUTE_FACES_2_STEP_1] THEN + REWRITE_TAC[COMPUTE_FACES_2_STEP_2] THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_CROSS_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN + REWRITE_TAC[real_ge] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_LE_CONV) THEN + REWRITE_TAC[INSERT_AC] THEN REWRITE_TAC[DISJ_ACI] THEN + REPEAT(CHANGED_TAC + (ONCE_REWRITE_TAC[lemma] THEN + CONV_TAC(ONCE_DEPTH_CONV + (LAND_CONV VECTOR3_DOT_CONV THENC REAL_RAT5_EQ_CONV))) THEN + REWRITE_TAC[]) THEN + REWRITE_TAC[INTER_EMPTY] THEN + REWRITE_TAC[INSERT_AC] THEN REWRITE_TAC[DISJ_ACI];; + +(* ------------------------------------------------------------------------- *) +(* Apply this to our standard Platonic solids to derive facets. *) +(* Note: this is quite slow and can take a couple of hours. *) +(* ------------------------------------------------------------------------- *) + +let TETRAHEDRON_FACETS = time prove + (`!f:real^3->bool. + f face_of std_tetrahedron /\ aff_dim f = &2 <=> + f = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1]} \/ + f = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1], vector[&1; &1; &1]} \/ + f = convex hull {vector[-- &1; -- &1; &1], vector[&1; -- &1; -- &1], vector[&1; &1; &1]} \/ + f = convex hull {vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1], vector[&1; &1; &1]}`, + GEN_TAC THEN REWRITE_TAC[std_tetrahedron] THEN COMPUTE_FACES_TAC);; + +let CUBE_FACETS = time prove + (`!f:real^3->bool. + f face_of std_cube /\ aff_dim f = &2 <=> + f = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1], vector[-- &1; &1; &1]} \/ + f = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1], vector[&1; -- &1; -- &1], vector[&1; -- &1; &1]} \/ + f = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1], vector[&1; &1; -- &1]} \/ + f = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; &1], vector[&1; -- &1; &1], vector[&1; &1; &1]} \/ + f = convex hull {vector[-- &1; &1; -- &1], vector[-- &1; &1; &1], vector[&1; &1; -- &1], vector[&1; &1; &1]} \/ + f = convex hull {vector[&1; -- &1; -- &1], vector[&1; -- &1; &1], vector[&1; &1; -- &1], vector[&1; &1; &1]}`, + GEN_TAC THEN REWRITE_TAC[std_cube] THEN COMPUTE_FACES_TAC);; + +let OCTAHEDRON_FACETS = time prove + (`!f:real^3->bool. + f face_of std_octahedron /\ aff_dim f = &2 <=> + f = convex hull {vector[-- &1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; -- &1]} \/ + f = convex hull {vector[-- &1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; &1]} \/ + f = convex hull {vector[-- &1; &0; &0], vector[&0; &1; &0], vector[&0; &0; -- &1]} \/ + f = convex hull {vector[-- &1; &0; &0], vector[&0; &1; &0], vector[&0; &0; &1]} \/ + f = convex hull {vector[&1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; -- &1]} \/ + f = convex hull {vector[&1; &0; &0], vector[&0; -- &1; &0], vector[&0; &0; &1]} \/ + f = convex hull {vector[&1; &0; &0], vector[&0; &1; &0], vector[&0; &0; -- &1]} \/ + f = convex hull {vector[&1; &0; &0], vector[&0; &1; &0], vector[&0; &0; &1]}`, + GEN_TAC THEN REWRITE_TAC[std_octahedron] THEN COMPUTE_FACES_TAC);; + +let ICOSAHEDRON_FACETS = time prove + (`!f:real^3->bool. + f face_of std_icosahedron /\ aff_dim f = &2 <=> + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1; &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt(&5)]}`, + GEN_TAC THEN REWRITE_TAC[STD_ICOSAHEDRON] THEN COMPUTE_FACES_TAC);; + +let DODECAHEDRON_FACETS = time prove + (`!f:real^3->bool. + f face_of std_dodecahedron /\ aff_dim f = &2 <=> + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; &1; -- &1], vector[-- &1; &1; &1]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[-- &1; -- &1; &1], vector[-- &1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[-- &1; -- &1; -- &1], vector[-- &1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1; -- &1], vector[&1; -- &1; -- &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[-- &1; -- &1; &1], vector[&1; -- &1; &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; -- &1; -- &1], vector[&1; -- &1; &1]} \/ + f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; &1; -- &1], vector[&1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[-- &1; &1; &1], vector[&1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5); &0], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; &1; -- &1], vector[&1; &1; &1]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; -- &1 / &2 + &1 / &2 * sqrt(&5)], vector[&1; -- &1; &1], vector[&1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); &1 / &2 + &1 / &2 * sqrt(&5)]} \/ + f = convex hull {vector[&1 / &2 + &1 / &2 * sqrt(&5); &0; &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&1; -- &1; -- &1], vector[&1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt(&5); -- &1 / &2 + -- &1 / &2 * sqrt(&5)]}`, + GEN_TAC THEN REWRITE_TAC[STD_DODECAHEDRON] THEN COMPUTE_FACES_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Given a coplanar set, return a hyperplane containing it. *) +(* Maps term s to theorem |- !x. x IN s ==> n dot x = d *) +(* Currently assumes |s| >= 3 but it would be trivial to do other cases. *) +(* ------------------------------------------------------------------------- *) + +let COPLANAR_HYPERPLANE_RULE = + let rec allsets m l = + if m = 0 then [[]] else + match l with + [] -> [] + | h::t -> map (fun g -> h::g) (allsets (m - 1) t) @ allsets m t in + let mk_sub = mk_binop `(-):real^3->real^3->real^3` + and mk_cross = mk_binop `cross` + and mk_dot = mk_binop `(dot):real^3->real^3->real` + and zerovec_tm = `vector[&0;&0;&0]:real^3` + and template = `(!x:real^3. x IN s ==> n dot x = d)` + and s_tm = `s:real^3->bool` + and n_tm = `n:real^3` + and d_tm = `d:real` in + let mk_normal [x;y;z] = mk_cross (mk_sub y x) (mk_sub z x) in + let eval_normal t = + (BINOP_CONV VECTOR3_SUB_CONV THENC VECTOR3_CROSS_CONV) (mk_normal t) in + let check_normal t = + let th = eval_normal t in + let n = rand(concl th) in + if n = zerovec_tm then failwith "check_normal" else n in + fun tm -> + let s = dest_setenum tm in + if length s < 3 then failwith "COPLANAR_HYPERPLANE_RULE: trivial" else + let n = tryfind check_normal (allsets 3 s) in + let d = rand(concl(VECTOR3_DOT_CONV(mk_dot n (hd s)))) in + let ptm = vsubst [tm,s_tm; n,n_tm; d,d_tm] template in + EQT_ELIM + ((REWRITE_CONV[FORALL_IN_INSERT; NOT_IN_EMPTY] THENC + DEPTH_BINOP_CONV `/\` + (LAND_CONV VECTOR3_DOT_CONV THENC REAL_RAT5_EQ_CONV) THENC + GEN_REWRITE_CONV DEPTH_CONV [AND_CLAUSES]) ptm);; + +(* ------------------------------------------------------------------------- *) +(* Explicit computation of edges, assuming hyperplane containing the set. *) +(* ------------------------------------------------------------------------- *) + +let COMPUTE_FACES_1 = prove + (`!s:real^3->bool n d. + (!x. x IN s ==> n dot x = d) + ==> FINITE s /\ ~(n = vec 0) + ==> !f. f face_of (convex hull s) /\ aff_dim f = &1 <=> + ?x y. x IN s /\ y IN s /\ + let a = n cross (y - x) in + ~(a = vec 0) /\ + let b = a dot x in + ((!w. w IN s ==> a dot w <= b) \/ + (!w. w IN s ==> a dot w >= b)) /\ + f = convex hull (s INTER {x | a dot x = b})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `?t:real^3->bool. t SUBSET s /\ f = convex hull t` + MP_TAC THENL + [MATCH_MP_TAC FACE_OF_CONVEX_HULL_SUBSET THEN + ASM_SIMP_TAC[FINITE_IMP_COMPACT]; + DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool` MP_TAC)] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_CONVEX_HULL]) THEN + MP_TAC(ISPEC `t:real^3->bool` AFFINE_BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^3->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(u:real^3->bool) HAS_SIZE 2` MP_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; AFFINE_INDEPENDENT_IMP_FINITE] THEN + REWRITE_TAC[GSYM INT_OF_NUM_EQ] THEN MATCH_MP_TAC(INT_ARITH + `aff_dim(u:real^3->bool) = &1 /\ aff_dim u = &(CARD u) - &1 + ==> &(CARD u):int = &2`) THEN CONJ_TAC + THENL [ASM_MESON_TAC[AFF_DIM_AFFINE_HULL]; ASM_MESON_TAC[AFF_DIM_UNIQUE]]; + ALL_TAC] THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + MAP_EVERY EXISTS_TAC [`x:real^3`; `y:real^3`] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + SUBGOAL_THEN `(x:real^3) IN s /\ y IN s` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT LET_TAC THEN + MP_TAC(ISPECL [`n:real^3`; `y - x:real^3`] NORM_AND_CROSS_EQ_0) THEN + ASM_SIMP_TAC[DOT_RSUB; VECTOR_SUB_EQ; REAL_SUB_0] THEN DISCH_TAC THEN + SUBGOAL_THEN `(a:real^3) dot y = b` ASSUME_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`n cross (y - x) = a`; `(a:real^3) dot x = b`] THEN VEC3_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`convex hull s:real^3->bool`; `convex hull t:real^3->bool`] + EXPOSED_FACE_OF_POLYHEDRON) THEN + ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; EXPOSED_FACE_OF_PARALLEL] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a':real^3`; `b':real`] THEN + SUBGOAL_THEN `~(convex hull t:real^3->bool = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^3` THEN + MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[]] THEN + ASM_CASES_TAC `convex hull t:real^3->bool = convex hull s` THEN + ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM AFFINE_HULL_CONVEX_HULL]) THEN + UNDISCH_THEN `convex hull t:real^3->bool = convex hull s` + (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFFINE_HULL_CONVEX_HULL]) THEN + REWRITE_TAC[SET_RULE `s = s INTER t <=> s SUBSET t`] THEN STRIP_TAC THEN + SUBGOAL_THEN `s SUBSET {x:real^3 | a dot x = b}` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `affine hull s:real^3->bool` THEN + REWRITE_TAC[HULL_SUBSET] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN + ASM SET_TAC[]; + CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN + ASM_SIMP_TAC[real_ge; REAL_LE_REFL]; + AP_TERM_TAC THEN ASM SET_TAC[]]]; + STRIP_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFFINE_HULL_CONVEX_HULL]) THEN + SUBGOAL_THEN + `aff_dim(t:real^3->bool) + <= aff_dim(({x:real^3 | a dot x = b} INTER {x:real^3 | a' dot x = b'}) + INTER {x | n dot x = d})` + MP_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM AFF_DIM_AFFINE_HULL] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [SYM th]) THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN MATCH_MP_TAC AFF_DIM_SUBSET THEN + REWRITE_TAC[SUBSET_INTER; INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `(x:real^3) IN convex hull t /\ y IN convex hull t` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; + ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFF_DIM_HYPERPLANE; + AFFINE_HYPERPLANE; DIMINDEX_3; AFFINE_INTER] THEN + ASM_CASES_TAC `{x:real^3 | a dot x = b} SUBSET {v | a' dot v = b'}` THEN + ASM_REWRITE_TAC[] THENL + [ALL_TAC; + REPEAT(COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `s INTER t SUBSET u ==> !x. x IN s /\ x IN t ==> x IN u`)) THEN + DISCH_THEN(MP_TAC o SPEC `x + n:real^3`) THEN + MATCH_MP_TAC(TAUT `p /\ q /\ ~r ==> (p /\ q ==> r) ==> s`) THEN + ASM_SIMP_TAC[IN_ELIM_THM; DOT_RADD] THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "a" THEN VEC3_TAC; + ALL_TAC; + ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL_0; DOT_EQ_0]] THEN + SUBGOAL_THEN `a' dot (x:real^3) = b'` SUBST1_TAC THENL + [SUBGOAL_THEN `(x:real^3) IN convex hull t` MP_TAC THENL + [MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(n:real^3) dot (x + a') = n dot x` MP_TAC THENL + [ALL_TAC; + SIMP_TAC[DOT_RADD] THEN REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x:real = d /\ y = d ==> x = y`) THEN + SUBGOAL_THEN + `affine hull s SUBSET {x:real^3 | n dot x = d}` + MP_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_SIMP_TAC[HULL_INC]]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_HYPERPLANES]) THEN + ASM_REWRITE_TAC[HYPERPLANE_EQ_EMPTY; HYPERPLANE_EQ_UNIV] THEN + DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC(SYM th)) THEN + DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(TAUT `(~p /\ ~q ==> F) ==> p \/ q`) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_ge; REAL_NOT_LE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `u:real^3`) (X_CHOOSE_TAC `v:real^3`)) THEN + SUBGOAL_THEN `(a':real^3) dot u < b' /\ a' dot v < b'` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC + [SET_RULE `f x <= b /\ ~(f x = b) <=> + x IN {x | f x <= b} /\ ~(x IN {x | f x = b})`] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NE] THEN + SUBGOAL_THEN `(u:real^3) IN convex hull s /\ v IN convex hull s` + MP_TAC THENL [ASM_SIMP_TAC[HULL_INC]; ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `?w:real^3. w IN segment[u,v] /\ w IN {w | a' dot w = b'}` + MP_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN + MAP_EVERY EXISTS_TAC [`v:real^3`; `u:real^3`] THEN + ASM_SIMP_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT; REAL_LT_IMP_LE]; + REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[UNWIND_THM2; DOT_RADD; DOT_RMUL; CONJ_ASSOC] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH `a < b ==> a = b ==> F`) THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REAL_ARITH_TAC]; + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull t:real^3->bool` THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[SUBSET_INTER] THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN + REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`] THEN + REPEAT LET_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `convex hull (s INTER {x:real^3 | a dot x = b}) = + (convex hull s) INTER {x | a dot x = b}` + SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET_INTER; HULL_MONO; INTER_SUBSET] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^3 | a dot x = b}` THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN + REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_HYPERPLANE]; + ALL_TAC] THEN + ASM_CASES_TAC `s SUBSET {x:real^3 | a dot x = b}` THENL + [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `convex hull (convex hull (s INTER {x:real^3 | a dot x = b}) UNION + convex hull (s DIFF {x | a dot x = b})) INTER + {x | a dot x = b}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> (s INTER u) SUBSET (t INTER u)`) THEN + MATCH_MP_TAC HULL_MONO THEN MATCH_MP_TAC(SET_RULE + `s INTER t SUBSET (P hull (s INTER t)) /\ + s DIFF t SUBSET (P hull (s DIFF t)) + ==> s SUBSET (P hull (s INTER t)) UNION (P hull (s DIFF t))`) THEN + REWRITE_TAC[HULL_SUBSET]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CONVEX_HULL_UNION_NONEMPTY_EXPLICIT o + lhand o lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[CONVEX_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY] THEN ASM SET_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`p:real^3`; `u:real`; `q:real^3`] THEN + REPLICATE_TAC 4 DISCH_TAC THEN ASM_CASES_TAC `u = &0` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % p + &0 % q:real^N = p`] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x < y ==> ~(x = y)`) THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - u) * p = (&1 - u) * b /\ u * q < u * b + ==> (&1 - u) * p + u * q < b`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN + SET_TAC[]; + SIMP_TAC[IN_ELIM_THM]]; + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE + `(a:real^3) dot q < b <=> q IN {x | a dot x < b}`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LT] THEN + ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; REAL_LT_LE]]; + MATCH_MP_TAC(REAL_ARITH `x > y ==> ~(x = y)`) THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - u) * p = (&1 - u) * b /\ u * b < u * q + ==> (&1 - u) * p + u * q > b`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `p IN {x:real^3 | a dot x = b}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HYPERPLANE] THEN + SET_TAC[]; + SIMP_TAC[IN_ELIM_THM]]; + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[GSYM real_gt]] THEN + ONCE_REWRITE_TAC[SET_RULE + `(a:real^3) dot q > b <=> q IN {x | a dot x > b}`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN + ASM_SIMP_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; real_gt; REAL_LT_LE]]]; + ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_LE] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + SIMP_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_HALFSPACE_GE] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]]; + ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim{x:real^3,y}` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[AFF_DIM_2] THEN + ASM_MESON_TAC[CROSS_0; VECTOR_SUB_REFL; INT_LE_REFL]; + MATCH_MP_TAC AFF_DIM_SUBSET THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + MAP_EVERY UNDISCH_TAC + [`n cross (y - x) = a`; `(a:real^3) dot x = b`] THEN + VEC3_TAC]] THEN + REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC + `aff_dim({x:real^3 | a dot x = b} INTER {x | n dot x = d})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFFINE_HYPERPLANE; + AFF_DIM_HYPERPLANE; DIMINDEX_3] THEN + REPEAT(COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + n:real^3` o + GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_SIMP_TAC[IN_ELIM_THM; DOT_RADD; REAL_EQ_ADD_LCANCEL_0; DOT_EQ_0] THEN + EXPAND_TAC "a" THEN VEC3_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Given a coplanar set, return exhaustive edge case theorem. *) +(* ------------------------------------------------------------------------- *) + +let COMPUTE_EDGES_CONV = + let lemma = prove + (`(x INSERT s) INTER {x | P x} = + if P x then x INSERT (s INTER {x | P x}) + else s INTER {x | P x}`, + COND_CASES_TAC THEN ASM SET_TAC[]) in + fun tm -> + let th1 = MATCH_MP COMPUTE_FACES_1 (COPLANAR_HYPERPLANE_RULE tm) in + let th2 = MP (CONV_RULE(LAND_CONV + (COMB2_CONV (RAND_CONV(PURE_REWRITE_CONV[FINITE_INSERT; FINITE_EMPTY])) + (RAND_CONV VECTOR3_EQ_0_CONV THENC + GEN_REWRITE_CONV I [NOT_CLAUSES]) THENC + GEN_REWRITE_CONV I [AND_CLAUSES])) th1) TRUTH in + CONV_RULE + (BINDER_CONV(RAND_CONV + (REWRITE_CONV[RIGHT_EXISTS_AND_THM] THENC + REWRITE_CONV[EXISTS_IN_INSERT; NOT_IN_EMPTY] THENC + REWRITE_CONV[FORALL_IN_INSERT; NOT_IN_EMPTY] THENC + ONCE_DEPTH_CONV VECTOR3_SUB_CONV THENC + ONCE_DEPTH_CONV VECTOR3_CROSS_CONV THENC + ONCE_DEPTH_CONV let_CONV THENC + ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV THENC + REWRITE_CONV[real_ge] THENC + ONCE_DEPTH_CONV VECTOR3_DOT_CONV THENC + ONCE_DEPTH_CONV let_CONV THENC + ONCE_DEPTH_CONV REAL_RAT5_LE_CONV THENC + REWRITE_CONV[INSERT_AC] THENC REWRITE_CONV[DISJ_ACI] THENC + REPEATC(CHANGED_CONV + (ONCE_REWRITE_CONV[lemma] THENC + ONCE_DEPTH_CONV(LAND_CONV VECTOR3_DOT_CONV THENC + REAL_RAT5_EQ_CONV) THENC + REWRITE_CONV[])) THENC + REWRITE_CONV[INTER_EMPTY] THENC + REWRITE_CONV[INSERT_AC] THENC REWRITE_CONV[DISJ_ACI] + ))) th2;; + +(* ------------------------------------------------------------------------- *) +(* Use this to prove the number of edges per face for each Platonic solid. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_LEMMA = prove + (`!x s n. 0 < n /\ ~(x IN s) /\ s HAS_SIZE (n - 1) + ==> (x INSERT s) HAS_SIZE n`, + REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT] THEN ASM_ARITH_TAC);; + +let EDGES_PER_FACE_TAC th = + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `CARD {e:real^3->bool | e face_of f /\ aff_dim(e) = &1}` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_FACE; FACE_OF_TRANS; FACE_OF_IMP_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPEC `f:real^3->bool` th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + W(fun (_,w) -> REWRITE_TAC[COMPUTE_EDGES_CONV(find_term is_setenum w)]) THEN + REWRITE_TAC[SET_RULE `x = a \/ x = b <=> x IN {a,b}`] THEN + REWRITE_TAC[GSYM IN_INSERT; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC + (MESON[HAS_SIZE] `s HAS_SIZE n ==> CARD s = n`) THEN + REPEAT + (MATCH_MP_TAC CARD_EQ_LEMMA THEN REPEAT CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN NO_TAC; + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; SEGMENT_EQ; DE_MORGAN_THM] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `~(a = c /\ b = d) /\ ~(a = d /\ b = c) /\ ~(a = b /\ c = d) + ==> ~({a,b} = {c,d})`) THEN + PURE_ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN + REWRITE_TAC[] THEN NO_TAC; + ALL_TAC]) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 HAS_SIZE_CLAUSES];; + +let TETRAHEDRON_EDGES_PER_FACE = prove + (`!f. f face_of std_tetrahedron /\ aff_dim(f) = &2 + ==> CARD {e | e face_of std_tetrahedron /\ aff_dim(e) = &1 /\ + e SUBSET f} = 3`, + EDGES_PER_FACE_TAC TETRAHEDRON_FACETS);; + +let CUBE_EDGES_PER_FACE = prove + (`!f. f face_of std_cube /\ aff_dim(f) = &2 + ==> CARD {e | e face_of std_cube /\ aff_dim(e) = &1 /\ + e SUBSET f} = 4`, + EDGES_PER_FACE_TAC CUBE_FACETS);; + +let OCTAHEDRON_EDGES_PER_FACE = prove + (`!f. f face_of std_octahedron /\ aff_dim(f) = &2 + ==> CARD {e | e face_of std_octahedron /\ aff_dim(e) = &1 /\ + e SUBSET f} = 3`, + EDGES_PER_FACE_TAC OCTAHEDRON_FACETS);; + +let DODECAHEDRON_EDGES_PER_FACE = prove + (`!f. f face_of std_dodecahedron /\ aff_dim(f) = &2 + ==> CARD {e | e face_of std_dodecahedron /\ aff_dim(e) = &1 /\ + e SUBSET f} = 5`, + EDGES_PER_FACE_TAC DODECAHEDRON_FACETS);; + +let ICOSAHEDRON_EDGES_PER_FACE = prove + (`!f. f face_of std_icosahedron /\ aff_dim(f) = &2 + ==> CARD {e | e face_of std_icosahedron /\ aff_dim(e) = &1 /\ + e SUBSET f} = 3`, + EDGES_PER_FACE_TAC ICOSAHEDRON_FACETS);; + +(* ------------------------------------------------------------------------- *) +(* Show that the Platonic solids are all full-dimensional. *) +(* ------------------------------------------------------------------------- *) + +let POLYTOPE_3D_LEMMA = prove + (`(let a = (z - x) cross (y - x) in + ~(a = vec 0) /\ ?w. w IN s /\ ~(a dot w = a dot x)) + ==> aff_dim(convex hull (x INSERT y INSERT z INSERT s:real^3->bool)) = &3`, + REPEAT GEN_TAC THEN LET_TAC THEN STRIP_TAC THEN + REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM DIMINDEX_3; AFF_DIM_LE_UNIV]; ALL_TAC] THEN + REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `aff_dim {w:real^3,x,y,z}` THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC AFF_DIM_SUBSET THEN ASM SET_TAC[]] THEN + ONCE_REWRITE_TAC[AFF_DIM_INSERT] THEN COND_CASES_TAC THENL + [SUBGOAL_THEN `w IN {w:real^3 | a dot w = a dot x}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN + UNDISCH_TAC `~(a:real^3 = vec 0)` THEN EXPAND_TAC "a" THEN VEC3_TAC; + ASM_REWRITE_TAC[IN_ELIM_THM]]; + UNDISCH_TAC `~(a:real^3 = vec 0)` THEN EXPAND_TAC "a" THEN + REWRITE_TAC[CROSS_EQ_0; GSYM COLLINEAR_3] THEN + REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT; INSERT_AC; DE_MORGAN_THM] THEN + STRIP_TAC THEN ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN INT_ARITH_TAC]);; + +let POLYTOPE_FULLDIM_TAC = + MATCH_MP_TAC POLYTOPE_3D_LEMMA THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_CROSS_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN CONJ_TAC THENL + [CONV_TAC(RAND_CONV VECTOR3_EQ_0_CONV) THEN REWRITE_TAC[]; + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN + REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) THEN + REWRITE_TAC[]];; + +let STD_TETRAHEDRON_FULLDIM = prove + (`aff_dim std_tetrahedron = &3`, + REWRITE_TAC[std_tetrahedron] THEN POLYTOPE_FULLDIM_TAC);; + +let STD_CUBE_FULLDIM = prove + (`aff_dim std_cube = &3`, + REWRITE_TAC[std_cube] THEN POLYTOPE_FULLDIM_TAC);; + +let STD_OCTAHEDRON_FULLDIM = prove + (`aff_dim std_octahedron = &3`, + REWRITE_TAC[std_octahedron] THEN POLYTOPE_FULLDIM_TAC);; + +let STD_DODECAHEDRON_FULLDIM = prove + (`aff_dim std_dodecahedron = &3`, + REWRITE_TAC[STD_DODECAHEDRON] THEN POLYTOPE_FULLDIM_TAC);; + +let STD_ICOSAHEDRON_FULLDIM = prove + (`aff_dim std_icosahedron = &3`, + REWRITE_TAC[STD_ICOSAHEDRON] THEN POLYTOPE_FULLDIM_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Complete list of edges for each Platonic solid. *) +(* ------------------------------------------------------------------------- *) + +let COMPUTE_EDGES_TAC defn fulldim facets = + GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + (vsubst[lhs(concl defn),`p:real^3->bool`] + `?f:real^3->bool. (f face_of p /\ aff_dim f = &2) /\ + (e face_of f /\ aff_dim e = &1)`) THEN + CONJ_TAC THENL + [EQ_TAC THENL [STRIP_TAC; MESON_TAC[FACE_OF_TRANS]] THEN + MP_TAC(ISPECL [lhs(concl defn); `e:real^3->bool`] + FACE_OF_POLYHEDRON_SUBSET_FACET) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[defn] THEN + MATCH_MP_TAC POLYHEDRON_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + CONJ_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN + ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN + CONV_TAC INT_REDUCE_CONV]; + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[facet_of] THEN + REWRITE_TAC[fulldim] THEN CONV_TAC INT_REDUCE_CONV THEN + ASM_MESON_TAC[FACE_OF_FACE]]; + REWRITE_TAC[facets] THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN + CONV_TAC(LAND_CONV(DEPTH_BINOP_CONV `\/` + (fun tm -> REWR_CONV (COMPUTE_EDGES_CONV(rand(rand(lhand tm)))) tm))) THEN + REWRITE_TAC[INSERT_AC] THEN REWRITE_TAC[DISJ_ACI]];; + +let TETRAHEDRON_EDGES = prove + (`!e. e face_of std_tetrahedron /\ aff_dim e = &1 <=> + e = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; -- &1]} \/ + e = convex hull {vector[-- &1; -- &1; &1], vector[&1; -- &1; -- &1]} \/ + e = convex hull {vector[-- &1; -- &1; &1], vector[&1; &1; &1]} \/ + e = convex hull {vector[-- &1; &1; -- &1], vector[&1; -- &1; -- &1]} \/ + e = convex hull {vector[-- &1; &1; -- &1], vector[&1; &1; &1]} \/ + e = convex hull {vector[&1; -- &1; -- &1], vector[&1; &1; &1]}`, + COMPUTE_EDGES_TAC + std_tetrahedron STD_TETRAHEDRON_FULLDIM TETRAHEDRON_FACETS);; + +let CUBE_EDGES = prove + (`!e. e face_of std_cube /\ aff_dim e = &1 <=> + e = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; -- &1; &1]} \/ + e = convex hull {vector[-- &1; -- &1; -- &1], vector[-- &1; &1; -- &1]} \/ + e = convex hull {vector[-- &1; -- &1; -- &1], vector[&1; -- &1; -- &1]} \/ + e = convex hull {vector[-- &1; -- &1; &1], vector[-- &1; &1; &1]} \/ + e = convex hull {vector[-- &1; -- &1; &1], vector[&1; -- &1; &1]} \/ + e = convex hull {vector[-- &1; &1; -- &1], vector[-- &1; &1; &1]} \/ + e = convex hull {vector[-- &1; &1; -- &1], vector[&1; &1; -- &1]} \/ + e = convex hull {vector[-- &1; &1; &1], vector[&1; &1; &1]} \/ + e = convex hull {vector[&1; -- &1; -- &1], vector[&1; -- &1; &1]} \/ + e = convex hull {vector[&1; -- &1; -- &1], vector[&1; &1; -- &1]} \/ + e = convex hull {vector[&1; -- &1; &1], vector[&1; &1; &1]} \/ + e = convex hull {vector[&1; &1; -- &1], vector[&1; &1; &1]}`, + COMPUTE_EDGES_TAC + std_cube STD_CUBE_FULLDIM CUBE_FACETS);; + +let OCTAHEDRON_EDGES = prove + (`!e. e face_of std_octahedron /\ aff_dim e = &1 <=> + e = convex hull {vector[-- &1; &0; &0], vector[&0; -- &1; &0]} \/ + e = convex hull {vector[-- &1; &0; &0], vector[&0; &1; &0]} \/ + e = convex hull {vector[-- &1; &0; &0], vector[&0; &0; -- &1]} \/ + e = convex hull {vector[-- &1; &0; &0], vector[&0; &0; &1]} \/ + e = convex hull {vector[&1; &0; &0], vector[&0; -- &1; &0]} \/ + e = convex hull {vector[&1; &0; &0], vector[&0; &1; &0]} \/ + e = convex hull {vector[&1; &0; &0], vector[&0; &0; -- &1]} \/ + e = convex hull {vector[&1; &0; &0], vector[&0; &0; &1]} \/ + e = convex hull {vector[&0; -- &1; &0], vector[&0; &0; -- &1]} \/ + e = convex hull {vector[&0; -- &1; &0], vector[&0; &0; &1]} \/ + e = convex hull {vector[&0; &1; &0], vector[&0; &0; -- &1]} \/ + e = convex hull {vector[&0; &1; &0], vector[&0; &0; &1]}`, + COMPUTE_EDGES_TAC + std_octahedron STD_OCTAHEDRON_FULLDIM OCTAHEDRON_FACETS);; + +let DODECAHEDRON_EDGES = prove + (`!e. e face_of std_dodecahedron /\ aff_dim e = &1 <=> + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[-- &1; -- &1; &1]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[-- &1; &1; &1]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[-- &1; -- &1; -- &1]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[-- &1; &1; -- &1]} \/ + e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1; -- &1; -- &1]} \/ + e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1; -- &1; &1]} \/ + e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1; &1; -- &1]} \/ + e = convex hull {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1; &1; &1]} \/ + e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[-- &1; -- &1; -- &1]} \/ + e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[-- &1; -- &1; &1]} \/ + e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[-- &1; &1; -- &1]} \/ + e = convex hull {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[-- &1; &1; &1]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[&1; -- &1; &1]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)], vector[&1; &1; &1]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&1; -- &1; -- &1]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&1; &1; -- &1]} \/ + e = convex hull {vector[-- &1; -- &1; -- &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; -- &1; &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; -- &1; -- &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; -- &1; &1], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; &1; -- &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; &1; &1], vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)], vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]}`, + COMPUTE_EDGES_TAC + STD_DODECAHEDRON STD_DODECAHEDRON_FULLDIM DODECAHEDRON_FACETS);; + +let ICOSAHEDRON_EDGES = prove + (`!e. e face_of std_icosahedron /\ aff_dim e = &1 <=> + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + e = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0], vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&1; &1 / &2 + &1 / &2 * sqrt (&5); &0], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)], vector[&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + e = convex hull {vector[&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)], vector[&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]}`, + COMPUTE_EDGES_TAC + STD_ICOSAHEDRON STD_ICOSAHEDRON_FULLDIM ICOSAHEDRON_FACETS);; + +(* ------------------------------------------------------------------------- *) +(* Enumerate all the vertices. *) +(* ------------------------------------------------------------------------- *) + +let COMPUTE_VERTICES_TAC defn fulldim edges = + GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + (vsubst[lhs(concl defn),`p:real^3->bool`] + `?e:real^3->bool. (e face_of p /\ aff_dim e = &1) /\ + (v face_of e /\ aff_dim v = &0)`) THEN + CONJ_TAC THENL + [EQ_TAC THENL [STRIP_TAC; MESON_TAC[FACE_OF_TRANS]] THEN + MP_TAC(ISPECL [lhs(concl defn); `v:real^3->bool`] + FACE_OF_POLYHEDRON_SUBSET_FACET) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[defn] THEN + MATCH_MP_TAC POLYHEDRON_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + CONJ_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN + ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN + CONV_TAC INT_REDUCE_CONV]; + REWRITE_TAC[facet_of] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^3->bool` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL [`f:real^3->bool`; `v:real^3->bool`] + FACE_OF_POLYHEDRON_SUBSET_FACET) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FACE_OF_POLYHEDRON_POLYHEDRON THEN + FIRST_ASSUM(fun th -> + EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [ALL_TAC; ACCEPT_TAC th]) THEN + REWRITE_TAC[defn] THEN + MATCH_MP_TAC POLYHEDRON_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + ASM_MESON_TAC[FACE_OF_FACE]; + DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN + ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN + CONV_TAC INT_REDUCE_CONV; + DISCH_THEN(MP_TAC o AP_TERM `aff_dim:(real^3->bool)->int`) THEN + ASM_REWRITE_TAC[fulldim; AFF_DIM_EMPTY] THEN + CONV_TAC INT_REDUCE_CONV]; + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[facet_of] THEN + ASM_REWRITE_TAC[fulldim] THEN CONV_TAC INT_REDUCE_CONV THEN + ASM_MESON_TAC[FACE_OF_FACE; FACE_OF_TRANS]]; + REWRITE_TAC[edges] THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN + REWRITE_TAC[AFF_DIM_EQ_0; RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[MESON[] + `v face_of s /\ v = {a} <=> {a} face_of s /\ v = {a}`] THEN + REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; FACE_OF_SING] THEN + REWRITE_TAC[EXTREME_POINT_OF_SEGMENT] THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN + REWRITE_TAC[DISJ_ACI]];; + +let TETRAHEDRON_VERTICES = prove + (`!v. v face_of std_tetrahedron /\ aff_dim v = &0 <=> + v = {vector [-- &1; -- &1; &1]} \/ + v = {vector [-- &1; &1; -- &1]} \/ + v = {vector [&1; -- &1; -- &1]} \/ + v = {vector [&1; &1; &1]}`, + COMPUTE_VERTICES_TAC + std_tetrahedron STD_TETRAHEDRON_FULLDIM TETRAHEDRON_EDGES);; + +let CUBE_VERTICES = prove + (`!v. v face_of std_cube /\ aff_dim v = &0 <=> + v = {vector [-- &1; -- &1; -- &1]} \/ + v = {vector [-- &1; -- &1; &1]} \/ + v = {vector [-- &1; &1; -- &1]} \/ + v = {vector [-- &1; &1; &1]} \/ + v = {vector [&1; -- &1; -- &1]} \/ + v = {vector [&1; -- &1; &1]} \/ + v = {vector [&1; &1; -- &1]} \/ + v = {vector [&1; &1; &1]}`, + COMPUTE_VERTICES_TAC + std_cube STD_CUBE_FULLDIM CUBE_EDGES);; + +let OCTAHEDRON_VERTICES = prove + (`!v. v face_of std_octahedron /\ aff_dim v = &0 <=> + v = {vector [-- &1; &0; &0]} \/ + v = {vector [&1; &0; &0]} \/ + v = {vector [&0; -- &1; &0]} \/ + v = {vector [&0; &1; &0]} \/ + v = {vector [&0; &0; -- &1]} \/ + v = {vector [&0; &0; &1]}`, + COMPUTE_VERTICES_TAC + std_octahedron STD_OCTAHEDRON_FULLDIM OCTAHEDRON_EDGES);; + +let DODECAHEDRON_VERTICES = prove + (`!v. v face_of std_dodecahedron /\ aff_dim v = &0 <=> + v = {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + v = {vector[-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + v = {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + v = {vector[-- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + v = {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + v = {vector[&1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + v = {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + v = {vector[&1 / &2 + &1 / &2 * sqrt (&5); &0; &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + v = {vector[-- &1; -- &1; -- &1]} \/ + v = {vector[-- &1; -- &1; &1]} \/ + v = {vector[-- &1; &1; -- &1]} \/ + v = {vector[-- &1; &1; &1]} \/ + v = {vector[&1; -- &1; -- &1]} \/ + v = {vector[&1; -- &1; &1]} \/ + v = {vector[&1; &1; -- &1]} \/ + v = {vector[&1; &1; &1]} \/ + v = {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + v = {vector[&0; -- &1 / &2 + &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + v = {vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + v = {vector[&0; &1 / &2 + -- &1 / &2 * sqrt (&5); &1 / &2 + &1 / &2 * sqrt (&5)]}`, + COMPUTE_VERTICES_TAC + STD_DODECAHEDRON STD_DODECAHEDRON_FULLDIM DODECAHEDRON_EDGES);; + +let ICOSAHEDRON_VERTICES = prove + (`!v. v face_of std_icosahedron /\ aff_dim v = &0 <=> + v = {vector [-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; -- &1]} \/ + v = {vector [-- &1 / &2 + -- &1 / &2 * sqrt (&5); &0; &1]} \/ + v = {vector [&1 / &2 + &1 / &2 * sqrt (&5); &0; -- &1]} \/ + v = {vector [&1 / &2 + &1 / &2 * sqrt (&5); &0; &1]} \/ + v = {vector [-- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + v = {vector [-- &1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + v = {vector [&1; -- &1 / &2 + -- &1 / &2 * sqrt (&5); &0]} \/ + v = {vector [&1; &1 / &2 + &1 / &2 * sqrt (&5); &0]} \/ + v = {vector [&0; -- &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + v = {vector [&0; -- &1; &1 / &2 + &1 / &2 * sqrt (&5)]} \/ + v = {vector [&0; &1; -- &1 / &2 + -- &1 / &2 * sqrt (&5)]} \/ + v = {vector [&0; &1; &1 / &2 + &1 / &2 * sqrt (&5)]}`, + COMPUTE_VERTICES_TAC + STD_ICOSAHEDRON STD_ICOSAHEDRON_FULLDIM ICOSAHEDRON_EDGES);; + +(* ------------------------------------------------------------------------- *) +(* Number of edges meeting at each vertex. *) +(* ------------------------------------------------------------------------- *) + +let EDGES_PER_VERTEX_TAC defn edges verts = + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + (vsubst[lhs(concl defn),`p:real^3->bool`] + `CARD {e | (e face_of p /\ aff_dim(e) = &1) /\ + (v:real^3->bool) face_of e}`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_FACE]; + ALL_TAC] THEN + MP_TAC(ISPEC `v:real^3->bool` verts) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + REWRITE_TAC[edges] THEN + REWRITE_TAC[SET_RULE + `{e | (P e \/ Q e) /\ R e} = + {e | P e /\ R e} UNION {e | Q e /\ R e}`] THEN + REWRITE_TAC[MESON[FACE_OF_SING] + `e = a /\ {x} face_of e <=> e = a /\ x extreme_point_of a`] THEN + REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; EXTREME_POINT_OF_SEGMENT] THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN + REWRITE_TAC[EMPTY_GSPEC; UNION_EMPTY] THEN + REWRITE_TAC[SET_RULE `{x | x = a} = {a}`] THEN + REWRITE_TAC[SET_RULE `{x} UNION s = x INSERT s`] THEN MATCH_MP_TAC + (MESON[HAS_SIZE] `s HAS_SIZE n ==> CARD s = n`) THEN + REPEAT + (MATCH_MP_TAC CARD_EQ_LEMMA THEN REPEAT CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN NO_TAC; + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; SEGMENT_EQ] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `~(a = c /\ b = d) /\ ~(a = d /\ b = c) /\ ~(a = b /\ c = d) + ==> ~({a,b} = {c,d})`) THEN + PURE_ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_EQ_0_CONV) THEN + REWRITE_TAC[] THEN NO_TAC; + ALL_TAC]) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 HAS_SIZE_CLAUSES];; + +let TETRAHEDRON_EDGES_PER_VERTEX = prove + (`!v. v face_of std_tetrahedron /\ aff_dim(v) = &0 + ==> CARD {e | e face_of std_tetrahedron /\ aff_dim(e) = &1 /\ + v SUBSET e} = 3`, + EDGES_PER_VERTEX_TAC + std_tetrahedron TETRAHEDRON_EDGES TETRAHEDRON_VERTICES);; + +let CUBE_EDGES_PER_VERTEX = prove + (`!v. v face_of std_cube /\ aff_dim(v) = &0 + ==> CARD {e | e face_of std_cube /\ aff_dim(e) = &1 /\ + v SUBSET e} = 3`, + EDGES_PER_VERTEX_TAC + std_cube CUBE_EDGES CUBE_VERTICES);; + +let OCTAHEDRON_EDGES_PER_VERTEX = prove + (`!v. v face_of std_octahedron /\ aff_dim(v) = &0 + ==> CARD {e | e face_of std_octahedron /\ aff_dim(e) = &1 /\ + v SUBSET e} = 4`, + EDGES_PER_VERTEX_TAC + std_octahedron OCTAHEDRON_EDGES OCTAHEDRON_VERTICES);; + +let DODECAHEDRON_EDGES_PER_VERTEX = prove + (`!v. v face_of std_dodecahedron /\ aff_dim(v) = &0 + ==> CARD {e | e face_of std_dodecahedron /\ aff_dim(e) = &1 /\ + v SUBSET e} = 3`, + EDGES_PER_VERTEX_TAC + STD_DODECAHEDRON DODECAHEDRON_EDGES DODECAHEDRON_VERTICES);; + +let ICOSAHEDRON_EDGES_PER_VERTEX = prove + (`!v. v face_of std_icosahedron /\ aff_dim(v) = &0 + ==> CARD {e | e face_of std_icosahedron /\ aff_dim(e) = &1 /\ + v SUBSET e} = 5`, + EDGES_PER_VERTEX_TAC + STD_ICOSAHEDRON ICOSAHEDRON_EDGES ICOSAHEDRON_VERTICES);; + +(* ------------------------------------------------------------------------- *) +(* Number of Platonic solids. *) +(* ------------------------------------------------------------------------- *) + +let MULTIPLE_COUNTING_LEMMA = prove + (`!R:A->B->bool s t. + FINITE s /\ FINITE t /\ + (!x. x IN s ==> CARD {y | y IN t /\ R x y} = m) /\ + (!y. y IN t ==> CARD {x | x IN s /\ R x y} = n) + ==> m * CARD s = n * CARD t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`R:A->B->bool`; `\x:A y:B. 1`; `s:A->bool`; `t:B->bool`] + NSUM_NSUM_RESTRICT) THEN + ASM_SIMP_TAC[NSUM_CONST; FINITE_RESTRICT] THEN ARITH_TAC);; + +let SIZE_ZERO_DIMENSIONAL_FACES = prove + (`!s:real^N->bool. + polyhedron s + ==> CARD {f | f face_of s /\ aff_dim f = &0} = + CARD {v | v extreme_point_of s} /\ + (FINITE {f | f face_of s /\ aff_dim f = &0} <=> + FINITE {v | v extreme_point_of s}) /\ + (!n. {f | f face_of s /\ aff_dim f = &0} HAS_SIZE n <=> + {v | v extreme_point_of s} HAS_SIZE n)`, + REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `{f | f face_of s /\ aff_dim f = &0} = + IMAGE (\v:real^N. {v}) {v | v extreme_point_of s}` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[AFF_DIM_SING; FACE_OF_SING; IN_ELIM_THM] THEN + REWRITE_TAC[AFF_DIM_EQ_0] THEN MESON_TAC[]; + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ; + MATCH_MP_TAC FINITE_IMAGE_INJ_EQ; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ_EQ] THEN + ASM_SIMP_TAC[FINITE_POLYHEDRON_EXTREME_POINTS] THEN SET_TAC[]]);; + +let PLATONIC_SOLIDS_LIMITS = prove + (`!p:real^3->bool m n. + polytope p /\ aff_dim p = &3 /\ + (!f. f face_of p /\ aff_dim(f) = &2 + ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ e SUBSET f} = m) /\ + (!v. v face_of p /\ aff_dim(v) = &0 + ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ v SUBSET e} = n) + ==> m = 3 /\ n = 3 \/ // Tetrahedron + m = 4 /\ n = 3 \/ // Cube + m = 3 /\ n = 4 \/ // Octahedron + m = 5 /\ n = 3 \/ // Dodecahedron + m = 3 /\ n = 5 // Icosahedron`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `p:real^3->bool` EULER_RELATION) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `m * CARD {f:real^3->bool | f face_of p /\ aff_dim f = &2} = + 2 * CARD {e | e face_of p /\ aff_dim e = &1} /\ + n * CARD {v | v face_of p /\ aff_dim v = &0} = + 2 * CARD {e | e face_of p /\ aff_dim e = &1}` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC MULTIPLE_COUNTING_LEMMA THENL + [EXISTS_TAC `\(f:real^3->bool) (e:real^3->bool). e SUBSET f`; + EXISTS_TAC `\(v:real^3->bool) (e:real^3->bool). v SUBSET e`] THEN + ONCE_REWRITE_TAC[SET_RULE `f face_of s <=> f IN {f | f face_of s}`] THEN + ASM_SIMP_TAC[FINITE_POLYTOPE_FACES; FINITE_RESTRICT] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN + X_GEN_TAC `e:real^3->bool` THEN STRIP_TAC THENL + [MP_TAC(ISPECL [`p:real^3->bool`; `e:real^3->bool`] + POLYHEDRON_RIDGE_TWO_FACETS) THEN + ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON] THEN ANTS_TAC THENL + [CONV_TAC INT_REDUCE_CONV THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC; + CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f1:real^3->bool`; `f2:real^3->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `CARD {f1:real^3->bool,f2}` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]; + ASM_SIMP_TAC[CARD_CLAUSES; IN_INSERT; FINITE_RULES; + NOT_IN_EMPTY; ARITH]]]; + SUBGOAL_THEN `?a b:real^3. e = segment[a,b]` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COMPACT_CONVEX_COLLINEAR_SEGMENT THEN + REPEAT CONJ_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC; + MATCH_MP_TAC FACE_OF_IMP_COMPACT THEN + EXISTS_TAC `p:real^3->bool` THEN + ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_COMPACT]; + ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; + MP_TAC(ISPEC `e:real^3->bool` AFF_DIM) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^3->bool` MP_TAC) THEN + ASM_REWRITE_TAC[INT_ARITH `&1:int = b - &1 <=> b = &2`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN + ASM_CASES_TAC `FINITE(b:real^3->bool)` THENL + [ALL_TAC; ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN `(b:real^3->bool) HAS_SIZE 2` MP_TAC THENL + [ASM_REWRITE_TAC[HAS_SIZE]; CONV_TAC(LAND_CONV HAS_SIZE_CONV)] THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + ASM_MESON_TAC[HULL_SUBSET]]; + ASM_CASES_TAC `a:real^3 = b` THENL + [UNDISCH_TAC `aff_dim(e:real^3->bool) = &1` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; AFF_DIM_SING; INT_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `CARD {v:real^3 | v extreme_point_of segment[a,b]}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN + EXISTS_TAC `\v:real^3. {v}` THEN + REWRITE_TAC[IN_ELIM_THM; FACE_OF_SING; AFF_DIM_SING] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[EXTREME_POINT_OF_SEGMENT] THEN + REWRITE_TAC[SET_RULE `{x | x = a \/ x = b} = {a,b}`] THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + X_GEN_TAC `v:real^3` THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN + ASM_MESON_TAC[FACE_OF_TRANS; FACE_OF_IMP_SUBSET]; + X_GEN_TAC `s:real^3->bool` THEN REWRITE_TAC[AFF_DIM_EQ_0] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^3` SUBST_ALL_TAC) THEN + REWRITE_TAC[EXISTS_UNIQUE] THEN EXISTS_TAC `v:real^3` THEN + ASM_REWRITE_TAC[GSYM FACE_OF_SING] THEN CONJ_TAC THENL + [ASM_MESON_TAC[FACE_OF_FACE]; SET_TAC[]]]; + ASM_REWRITE_TAC[EXTREME_POINT_OF_SEGMENT] THEN + REWRITE_TAC[SET_RULE `{x | x = a \/ x = b} = {a,b}`] THEN + ASM_SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; ARITH]]]]; + ALL_TAC] THEN + STRIP_TAC THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (ARITH_RULE + `(a + b) - c = 2 ==> a + b = c + 2`)) THEN + SUBGOAL_THEN `4 <= CARD {v:real^3->bool | v face_of p /\ aff_dim v = &0}` + ASSUME_TAC THENL + [ASM_SIMP_TAC[SIZE_ZERO_DIMENSIONAL_FACES; POLYTOPE_IMP_POLYHEDRON] THEN + MP_TAC(ISPEC `p:real^3->bool` POLYTOPE_VERTEX_LOWER_BOUND) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC[INT_OF_NUM_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `4 <= CARD {f:real^3->bool | f face_of p /\ aff_dim f = &2}` + ASSUME_TAC THENL + [MP_TAC(ISPEC `p:real^3->bool` POLYTOPE_FACET_LOWER_BOUND) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN + ASM_REWRITE_TAC[INT_OF_NUM_LE; facet_of] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONV_TAC INT_REDUCE_CONV THEN GEN_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[INT_ARITH `~(&2:int = -- &1)`; AFF_DIM_EMPTY]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `v + f = e + 2 ==> 4 <= v /\ 4 <= f ==> 6 <= e`)) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC + `CARD {e:real^3->bool | e face_of p /\ aff_dim e = &1} = 0` THEN + ASM_REWRITE_TAC[ARITH] THEN DISCH_TAC THEN + SUBGOAL_THEN `3 <= m` ASSUME_TAC THENL + [ASM_CASES_TAC `{f:real^3->bool | f face_of p /\ aff_dim f = &2} = {}` THENL + [UNDISCH_TAC + `4 <= CARD {f:real^3->bool | f face_of p /\ aff_dim f = &2}` THEN + ASM_REWRITE_TAC[CARD_CLAUSES] THEN ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^3->bool` MP_TAC) THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM o C MATCH_MP th)) THEN + MP_TAC(ISPEC `f:real^3->bool` POLYTOPE_FACET_LOWER_BOUND) THEN + ASM_REWRITE_TAC[facet_of] THEN CONV_TAC INT_REDUCE_CONV THEN + ANTS_TAC THENL [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE]; ALL_TAC] THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONV_TAC INT_REDUCE_CONV THEN X_GEN_TAC `e:real^3->bool` THEN + EQ_TAC THEN ASM_CASES_TAC `e:real^3->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THENL + [ASM_MESON_TAC[FACE_OF_TRANS; FACE_OF_IMP_SUBSET]; + ASM_MESON_TAC[FACE_OF_FACE]]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `3 <= m ==> ~(m = 0)`)) THEN + ASM_CASES_TAC `n = 0` THENL + [UNDISCH_THEN `n = 0` SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `0 * x = 2 * e ==> e = 0`)) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (NUM_RING + `v + f = e + 2 ==> !m n. m * n * v + n * m * f = m * n * (e + 2)`)) THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `m * 2 * e + n * 2 * e = m * n * (e + 2) <=> + e * 2 * (m + n) = m * n * (e + 2)`] THEN + ABBREV_TAC `E = CARD {e:real^3->bool | e face_of p /\ aff_dim e = &1}` THEN + ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; ARITH_RULE + `E * 2 * (n + 1) = n * (E + 2) <=> E * (n + 2) = 2 * n`] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + MATCH_MP_TAC(ARITH_RULE `n:num < m ==> ~(m = n)`) THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 * (m + 2)` THEN + CONJ_TAC THENL [ARITH_TAC; MATCH_MP_TAC LE_MULT2 THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 2` THENL + [ASM_REWRITE_TAC[ARITH_RULE `E * 2 * (n + 2) = n * 2 * (E + 2) <=> + E = n`] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (NUM_RING + `E * c = 2 * E ==> E = 0 \/ c = 2`)) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `3 <= n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `m * n < 2 * (m + n)` THENL + [DISCH_TAC; + DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + SUBGOAL_THEN `E * 2 * (m + n) <= E * m * n` MP_TAC THENL + [REWRITE_TAC[LE_MULT_LCANCEL] THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[ARITH_RULE `m * n * (E + 2) <= E * m * n <=> + 2 * m * n = 0`] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + REWRITE_TAC[MULT_EQ_0] THEN ASM_ARITH_TAC]] THEN + SUBGOAL_THEN `&m - &2:real < &4 /\ &n - &2 < &4` MP_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&n - &2`; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&m - &2`] THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_OF_NUM_LT; + ARITH_RULE `2 < n <=> 3 <= n`] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&4` THEN + REWRITE_TAC[REAL_ARITH `(m - &2) * (n - &2) < &4 <=> + m * n < &2 * (m + n)`] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; REAL_LE_SUB_LADD] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_LT_SUB_RADD; REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN + REWRITE_TAC[ARITH_RULE `m < 4 + 2 <=> m <= 5`] THEN + ASM_SIMP_TAC[ARITH_RULE + `3 <= m ==> (m <= 5 <=> m = 3 \/ m = 4 \/ m = 5)`] THEN + STRIP_TAC THEN UNDISCH_TAC `E * 2 * (m + n) = m * n * (E + 2)` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* If-and-only-if version. *) +(* ------------------------------------------------------------------------- *) + +let PLATONIC_SOLIDS = prove + (`!m n. + (?p:real^3->bool. + polytope p /\ aff_dim p = &3 /\ + (!f. f face_of p /\ aff_dim(f) = &2 + ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ e SUBSET f} = m) /\ + (!v. v face_of p /\ aff_dim(v) = &0 + ==> CARD {e | e face_of p /\ aff_dim(e) = &1 /\ v SUBSET e} = n)) <=> + m = 3 /\ n = 3 \/ // Tetrahedron + m = 4 /\ n = 3 \/ // Cube + m = 3 /\ n = 4 \/ // Octahedron + m = 5 /\ n = 3 \/ // Dodecahedron + m = 3 /\ n = 5 // Icosahedron`, + REPEAT GEN_TAC THEN EQ_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; PLATONIC_SOLIDS_LIMITS] THEN + STRIP_TAC THENL + [EXISTS_TAC `std_tetrahedron` THEN + ASM_REWRITE_TAC[TETRAHEDRON_EDGES_PER_VERTEX; TETRAHEDRON_EDGES_PER_FACE; + STD_TETRAHEDRON_FULLDIM] THEN + REWRITE_TAC[std_tetrahedron] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + EXISTS_TAC `std_cube` THEN + ASM_REWRITE_TAC[CUBE_EDGES_PER_VERTEX; CUBE_EDGES_PER_FACE; + STD_CUBE_FULLDIM] THEN + REWRITE_TAC[std_cube] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + EXISTS_TAC `std_octahedron` THEN + ASM_REWRITE_TAC[OCTAHEDRON_EDGES_PER_VERTEX; OCTAHEDRON_EDGES_PER_FACE; + STD_OCTAHEDRON_FULLDIM] THEN + REWRITE_TAC[std_octahedron] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + EXISTS_TAC `std_dodecahedron` THEN + ASM_REWRITE_TAC[DODECAHEDRON_EDGES_PER_VERTEX; DODECAHEDRON_EDGES_PER_FACE; + STD_DODECAHEDRON_FULLDIM] THEN + REWRITE_TAC[STD_DODECAHEDRON] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + EXISTS_TAC `std_icosahedron` THEN + ASM_REWRITE_TAC[ICOSAHEDRON_EDGES_PER_VERTEX; ICOSAHEDRON_EDGES_PER_FACE; + STD_ICOSAHEDRON_FULLDIM] THEN + REWRITE_TAC[STD_ICOSAHEDRON] THEN MATCH_MP_TAC POLYTOPE_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the regular polyhedra do have all edges and faces congruent. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("congruent",(12,"right"));; + +let congruent = new_definition + `(s:real^N->bool) congruent (t:real^N->bool) <=> + ?c f. orthogonal_transformation f /\ t = IMAGE (\x. c + f x) s`;; + +let CONGRUENT_SIMPLE = prove + (`(?A:real^3^3. orthogonal_matrix A /\ IMAGE (\x:real^3. A ** x) s = t) + ==> (convex hull s) congruent (convex hull t)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM))) THEN + SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN + REWRITE_TAC[congruent] THEN EXISTS_TAC `vec 0:real^3` THEN + EXISTS_TAC `\x:real^3. (A:real^3^3) ** x` THEN + REWRITE_TAC[VECTOR_ADD_LID; ORTHOGONAL_TRANSFORMATION_MATRIX] THEN + ASM_SIMP_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR]);; + +let CONGRUENT_SEGMENTS = prove + (`!a b c d:real^N. + dist(a,b) = dist(c,d) + ==> segment[a,b] congruent segment[c,d]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`b - a:real^N`; `d - c:real^N`] + ORTHOGONAL_TRANSFORMATION_EXISTS) THEN + ANTS_TAC THENL [POP_ASSUM MP_TAC THEN NORM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[congruent] THEN + EXISTS_TAC `c - (f:real^N->real^N) a` THEN + EXISTS_TAC `f:real^N->real^N` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + SUBGOAL_THEN + `(\x. (c - f a) + (f:real^N->real^N) x) = (\x. (c - f a) + x) o f` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CONVEX_HULL_LINEAR_IMAGE; SEGMENT_CONVEX_HULL; IMAGE_o; + GSYM CONVEX_HULL_TRANSLATION] THEN + REWRITE_TAC[IMAGE_CLAUSES] THEN + AP_TERM_TAC THEN BINOP_TAC THENL + [VECTOR_ARITH_TAC; AP_THM_TAC THEN AP_TERM_TAC] THEN + REWRITE_TAC[VECTOR_ARITH `d:real^N = c - a + b <=> b - a = d - c`] THEN + ASM_MESON_TAC[LINEAR_SUB]);; + +let compute_dist = + let mk_sub = mk_binop `(-):real^3->real^3->real^3` + and dot_tm = `(dot):real^3->real^3->real` in + fun v1 v2 -> let vth = VECTOR3_SUB_CONV(mk_sub v1 v2) in + let dth = CONV_RULE(RAND_CONV VECTOR3_DOT_CONV) + (MK_COMB(AP_TERM dot_tm vth,vth)) in + rand(concl dth);; + +let le_rat5 = + let mk_le = mk_binop `(<=):real->real->bool` and t_tm = `T` in + fun r1 r2 -> rand(concl(REAL_RAT5_LE_CONV(mk_le r1 r2))) = t_tm;; + +let three_adjacent_points s = + match s with + | x::t -> let (y,_)::(z,_)::_ = + sort (fun (_,r1) (_,r2) -> le_rat5 r1 r2) + (map (fun y -> y,compute_dist x y) t) in + x,y,z + | _ -> failwith "three_adjacent_points: no points";; + +let mk_33matrix = + let a11_tm = `a11:real` + and a12_tm = `a12:real` + and a13_tm = `a13:real` + and a21_tm = `a21:real` + and a22_tm = `a22:real` + and a23_tm = `a23:real` + and a31_tm = `a31:real` + and a32_tm = `a32:real` + and a33_tm = `a33:real` + and pat_tm = + `vector[vector[a11; a12; a13]; + vector[a21; a22; a23]; + vector[a31; a32; a33]]:real^3^3` in + fun [a11;a12;a13;a21;a22;a23;a31;a32;a33] -> + vsubst[a11,a11_tm; + a12,a12_tm; + a13,a13_tm; + a21,a21_tm; + a22,a22_tm; + a23,a23_tm; + a31,a31_tm; + a32,a32_tm; + a33,a33_tm] pat_tm;; + +let MATRIX_VECTOR_MUL_3 = prove + (`(vector[vector[a11;a12;a13]; + vector[a21; a22; a23]; + vector[a31; a32; a33]]:real^3^3) ** + (vector[x1;x2;x3]:real^3) = + vector[a11 * x1 + a12 * x2 + a13 * x3; + a21 * x1 + a22 * x2 + a23 * x3; + a31 * x1 + a32 * x2 + a33 * x3]`, + SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA] THEN + REWRITE_TAC[DIMINDEX_3; FORALL_3; SUM_3; VECTOR_3]);; + +let MATRIX_LEMMA = prove + (`!A:real^3^3. + A ** x1 = x2 /\ + A ** y1 = y2 /\ + A ** z1 = z2 <=> + (vector [x1; y1; z1]:real^3^3) ** (row 1 A:real^3) = + vector [x2$1; y2$1; z2$1] /\ + (vector [x1; y1; z1]:real^3^3) ** (row 2 A:real^3) = + vector [x2$2; y2$2; z2$2] /\ + (vector [x1; y1; z1]:real^3^3) ** (row 3 A:real^3) = + vector [x2$3; y2$3; z2$3]`, + SIMP_TAC[CART_EQ; transp; matrix_vector_mul; row; VECTOR_3; LAMBDA_BETA] THEN + REWRITE_TAC[FORALL_3; DIMINDEX_3; VECTOR_3; SUM_3] THEN REAL_ARITH_TAC);; + +let MATRIX_BY_CRAMER_LEMMA = prove + (`!A:real^3^3. + ~(det(vector[x1; y1; z1]:real^3^3) = &0) + ==> (A ** x1 = x2 /\ + A ** y1 = y2 /\ + A ** z1 = z2 <=> + A = lambda m k. det((lambda i j. + if j = k + then (vector[x2$m; y2$m; z2$m]:real^3)$i + else (vector[x1; y1; z1]:real^3^3)$i$j) + :real^3^3) / + det(vector[x1;y1;z1]:real^3^3))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [MATRIX_LEMMA] THEN + ASM_SIMP_TAC[CRAMER] THEN REWRITE_TAC[CART_EQ; row] THEN + SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[DIMINDEX_3; FORALL_3]);; + +let MATRIX_BY_CRAMER = prove + (`!A:real^3^3 x1 y1 z1 x2 y2 z2. + let d = det(vector[x1; y1; z1]:real^3^3) in + ~(d = &0) + ==> (A ** x1 = x2 /\ + A ** y1 = y2 /\ + A ** z1 = z2 <=> + A$1$1 = + (x2$1 * y1$2 * z1$3 + + x1$2 * y1$3 * z2$1 + + x1$3 * y2$1 * z1$2 - + x2$1 * y1$3 * z1$2 - + x1$2 * y2$1 * z1$3 - + x1$3 * y1$2 * z2$1) / d /\ + A$1$2 = + (x1$1 * y2$1 * z1$3 + + x2$1 * y1$3 * z1$1 + + x1$3 * y1$1 * z2$1 - + x1$1 * y1$3 * z2$1 - + x2$1 * y1$1 * z1$3 - + x1$3 * y2$1 * z1$1) / d /\ + A$1$3 = + (x1$1 * y1$2 * z2$1 + + x1$2 * y2$1 * z1$1 + + x2$1 * y1$1 * z1$2 - + x1$1 * y2$1 * z1$2 - + x1$2 * y1$1 * z2$1 - + x2$1 * y1$2 * z1$1) / d /\ + A$2$1 = + (x2$2 * y1$2 * z1$3 + + x1$2 * y1$3 * z2$2 + + x1$3 * y2$2 * z1$2 - + x2$2 * y1$3 * z1$2 - + x1$2 * y2$2 * z1$3 - + x1$3 * y1$2 * z2$2) / d /\ + A$2$2 = + (x1$1 * y2$2 * z1$3 + + x2$2 * y1$3 * z1$1 + + x1$3 * y1$1 * z2$2 - + x1$1 * y1$3 * z2$2 - + x2$2 * y1$1 * z1$3 - + x1$3 * y2$2 * z1$1) / d /\ + A$2$3 = + (x1$1 * y1$2 * z2$2 + + x1$2 * y2$2 * z1$1 + + x2$2 * y1$1 * z1$2 - + x1$1 * y2$2 * z1$2 - + x1$2 * y1$1 * z2$2 - + x2$2 * y1$2 * z1$1) / d /\ + A$3$1 = + (x2$3 * y1$2 * z1$3 + + x1$2 * y1$3 * z2$3 + + x1$3 * y2$3 * z1$2 - + x2$3 * y1$3 * z1$2 - + x1$2 * y2$3 * z1$3 - + x1$3 * y1$2 * z2$3) / d /\ + A$3$2 = + (x1$1 * y2$3 * z1$3 + + x2$3 * y1$3 * z1$1 + + x1$3 * y1$1 * z2$3 - + x1$1 * y1$3 * z2$3 - + x2$3 * y1$1 * z1$3 - + x1$3 * y2$3 * z1$1) / d /\ + A$3$3 = + (x1$1 * y1$2 * z2$3 + + x1$2 * y2$3 * z1$1 + + x2$3 * y1$1 * z1$2 - + x1$1 * y2$3 * z1$2 - + x1$2 * y1$1 * z2$3 - + x2$3 * y1$2 * z1$1) / d)`, + REPEAT GEN_TAC THEN CONV_TAC let_CONV THEN DISCH_TAC THEN + ASM_SIMP_TAC[MATRIX_BY_CRAMER_LEMMA] THEN + REWRITE_TAC[DET_3; CART_EQ] THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; VECTOR_3] THEN + REWRITE_TAC[FORALL_3; ARITH; VECTOR_3] THEN REWRITE_TAC[CONJ_ACI]);; + +let CONGRUENT_EDGES_TAC edges = + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN + REWRITE_TAC[edges] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC CONGRUENT_SEGMENTS THEN REWRITE_TAC[DIST_EQ] THEN + REWRITE_TAC[dist; NORM_POW_2] THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_SUB_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV VECTOR3_DOT_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) THEN + REWRITE_TAC[];; + +let CONGRUENT_FACES_TAC facets = + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN + REWRITE_TAC[facets] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + W(fun (asl,w) -> + let t1 = rand(lhand w) and t2 = rand(rand w) in + let (x1,y1,z1) = three_adjacent_points (dest_setenum t1) + and (x2,y2,z2) = three_adjacent_points (dest_setenum t2) in + let th1 = SPECL [`A:real^3^3`;x1;y1;z1;x2;y2;z2] MATRIX_BY_CRAMER in + let th2 = REWRITE_RULE[VECTOR_3; DET_3] th1 in + let th3 = CONV_RULE (DEPTH_CONV REAL_RAT5_MUL_CONV) th2 in + let th4 = CONV_RULE (DEPTH_CONV + (REAL_RAT5_ADD_CONV ORELSEC REAL_RAT5_SUB_CONV)) th3 in + let th5 = CONV_RULE let_CONV th4 in + let th6 = CONV_RULE(ONCE_DEPTH_CONV REAL_RAT5_DIV_CONV) th5 in + let th7 = CONV_RULE(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) th6 in + let th8 = MP th7 (EQT_ELIM(REWRITE_CONV[] (lhand(concl th7)))) in + let tms = map rhs (conjuncts(rand(concl th8))) in + let matt = mk_33matrix tms in + MATCH_MP_TAC CONGRUENT_SIMPLE THEN EXISTS_TAC matt THEN CONJ_TAC THENL + [REWRITE_TAC[ORTHOGONAL_MATRIX; CART_EQ] THEN + SIMP_TAC[transp; LAMBDA_BETA; matrix_mul; mat] THEN + REWRITE_TAC[DIMINDEX_3; SUM_3; FORALL_3; VECTOR_3; ARITH] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_MUL_CONV) THEN + CONV_TAC(DEPTH_CONV REAL_RAT5_ADD_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_EQ_CONV) THEN + REWRITE_TAC[] THEN NO_TAC; + REWRITE_TAC[IMAGE_CLAUSES; MATRIX_VECTOR_MUL_3] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT5_MUL_CONV) THEN + CONV_TAC(DEPTH_CONV REAL_RAT5_ADD_CONV) THEN + REWRITE_TAC[INSERT_AC]]);; + +let TETRAHEDRON_CONGRUENT_EDGES = prove + (`!e1 e2. e1 face_of std_tetrahedron /\ aff_dim e1 = &1 /\ + e2 face_of std_tetrahedron /\ aff_dim e2 = &1 + ==> e1 congruent e2`, + CONGRUENT_EDGES_TAC TETRAHEDRON_EDGES);; + +let TETRAHEDRON_CONGRUENT_FACETS = prove + (`!f1 f2. f1 face_of std_tetrahedron /\ aff_dim f1 = &2 /\ + f2 face_of std_tetrahedron /\ aff_dim f2 = &2 + ==> f1 congruent f2`, + CONGRUENT_FACES_TAC TETRAHEDRON_FACETS);; + +let CUBE_CONGRUENT_EDGES = prove + (`!e1 e2. e1 face_of std_cube /\ aff_dim e1 = &1 /\ + e2 face_of std_cube /\ aff_dim e2 = &1 + ==> e1 congruent e2`, + CONGRUENT_EDGES_TAC CUBE_EDGES);; + +let CUBE_CONGRUENT_FACETS = prove + (`!f1 f2. f1 face_of std_cube /\ aff_dim f1 = &2 /\ + f2 face_of std_cube /\ aff_dim f2 = &2 + ==> f1 congruent f2`, + CONGRUENT_FACES_TAC CUBE_FACETS);; + +let OCTAHEDRON_CONGRUENT_EDGES = prove + (`!e1 e2. e1 face_of std_octahedron /\ aff_dim e1 = &1 /\ + e2 face_of std_octahedron /\ aff_dim e2 = &1 + ==> e1 congruent e2`, + CONGRUENT_EDGES_TAC OCTAHEDRON_EDGES);; + +let OCTAHEDRON_CONGRUENT_FACETS = prove + (`!f1 f2. f1 face_of std_octahedron /\ aff_dim f1 = &2 /\ + f2 face_of std_octahedron /\ aff_dim f2 = &2 + ==> f1 congruent f2`, + CONGRUENT_FACES_TAC OCTAHEDRON_FACETS);; + +let DODECAHEDRON_CONGRUENT_EDGES = prove + (`!e1 e2. e1 face_of std_dodecahedron /\ aff_dim e1 = &1 /\ + e2 face_of std_dodecahedron /\ aff_dim e2 = &1 + ==> e1 congruent e2`, + CONGRUENT_EDGES_TAC DODECAHEDRON_EDGES);; + +let DODECAHEDRON_CONGRUENT_FACETS = prove + (`!f1 f2. f1 face_of std_dodecahedron /\ aff_dim f1 = &2 /\ + f2 face_of std_dodecahedron /\ aff_dim f2 = &2 + ==> f1 congruent f2`, + CONGRUENT_FACES_TAC DODECAHEDRON_FACETS);; + +let ICOSAHEDRON_CONGRUENT_EDGES = prove + (`!e1 e2. e1 face_of std_icosahedron /\ aff_dim e1 = &1 /\ + e2 face_of std_icosahedron /\ aff_dim e2 = &1 + ==> e1 congruent e2`, + CONGRUENT_EDGES_TAC ICOSAHEDRON_EDGES);; + +let ICOSAHEDRON_CONGRUENT_FACETS = prove + (`!f1 f2. f1 face_of std_icosahedron /\ aff_dim f1 = &2 /\ + f2 face_of std_icosahedron /\ aff_dim f2 = &2 + ==> f1 congruent f2`, + CONGRUENT_FACES_TAC ICOSAHEDRON_FACETS);; diff --git a/100/pnt.ml b/100/pnt.ml new file mode 100644 index 0000000..da2e04c --- /dev/null +++ b/100/pnt.ml @@ -0,0 +1,4316 @@ +(* ========================================================================= *) +(* "Second proof" of Prime Number Theorem from Newman's book. *) +(* ========================================================================= *) + +needs "Multivariate/cauchy.ml";; +needs "Library/pocklington.ml";; +needs "Examples/mangoldt.ml";; + +prioritize_real();; +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* A few miscelleneous lemmas. *) +(* ------------------------------------------------------------------------- *) + +let LT_NORM_CPOW_NUM = prove + (`!n s. &0 < Re s /\ 2 <= n ==> &1 < norm(Cx(&n) cpow s)`, + SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + ARITH_RULE `2 <= n ==> 0 < n`] THEN + REWRITE_TAC[GSYM REAL_EXP_0; REAL_EXP_MONO_LT] THEN + SIMP_TAC[REAL_LT_MUL; LOG_POS_LT; REAL_OF_NUM_LT; + ARITH_RULE `2 <= n ==> 1 < n`]);; + +let CPOW_NUM_NE_1 = prove + (`!n s. &0 < Re s /\ 2 <= n ==> ~(Cx(&n) cpow s = Cx(&1))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SYM o AP_TERM `norm:complex->real`) THEN + ASM_SIMP_TAC[LT_NORM_CPOW_NUM; COMPLEX_NORM_CX; REAL_ABS_NUM; + REAL_LT_IMP_NE]);; + +let FINITE_ATMOST = prove + (`!P n. FINITE {m:num | P m /\ m <= n}`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + SIMP_TAC[LE_0; FINITE_NUMSEG; SUBSET; IN_ELIM_THM; IN_NUMSEG]);; + +let PRIME_ATMOST_ALT = prove + (`{p | prime p /\ p <= n} = {p | p IN 1..n /\ prime p}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + X_GEN_TAC `p:num` THEN ASM_CASES_TAC `prime p` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* An auxiliary zeta function that's analytic in the right halfplane. *) +(* ------------------------------------------------------------------------- *) + +let nearzeta = new_definition + `nearzeta n s = infsum (from n) + (\m. (s - Cx(&1)) / Cx(&m) cpow s - + (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(m+1)) cpow (s - Cx(&1))))`;; + +(* ------------------------------------------------------------------------- *) +(* The actual zeta function, with analyticity of z_n(s) - 1/(s - 1)^{n-1} *) +(* ------------------------------------------------------------------------- *) + +let genzeta = new_definition + `genzeta n s = if s = Cx(&1) then complex_derivative (nearzeta n) (Cx(&1)) + else (nearzeta n s + Cx(&1) / Cx(&n) cpow (s - Cx(&1))) / + (s - Cx(&1))`;; + +let zeta = new_definition + `zeta s = genzeta 1 s`;; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about convergence and analyticity of the series. *) +(* ------------------------------------------------------------------------- *) + +let NEARZETA_BOUND_LEMMA = prove + (`!s n. ~(n = 0) /\ &0 <= Re s + &1 + ==> norm((s - Cx(&1)) / Cx(&n) cpow s - + (Cx(&1) / Cx(&n) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(n + 1)) cpow (s - Cx(&1)))) <= + norm(s * (s - Cx(&1)) / Cx(&n) cpow (s + Cx(&1)))`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\n z. if n = 0 then Cx(&1) / z cpow (s - Cx(&1)) + else if n = 1 then (Cx(&1) - s) / z cpow s + else s * (s - Cx(&1)) / z cpow (s + Cx(&1))`; + `1`; `segment[Cx(&n),Cx(&n) + Cx(&1)]`; + `norm(s * (s - Cx (&1)) / Cx(&n) cpow (s + Cx(&1)))`] COMPLEX_TAYLOR) THEN + REWRITE_TAC[ARITH] THEN ANTS_TAC THENL + [REWRITE_TAC[CONVEX_SEGMENT] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `z:complex`] THEN STRIP_TAC; + X_GEN_TAC `z:complex` THEN DISCH_TAC] THEN + (SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL + [MATCH_MP_TAC RE_POS_SEGMENT THEN + MAP_EVERY EXISTS_TAC [`Cx(&n)`; `Cx(&n) + Cx(&1)`] THEN + ASM_REWRITE_TAC[RE_ADD; RE_CX; REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN ASM_MESON_TAC[RE_CX; REAL_LT_REFL]; + ALL_TAC]) + THENL + [FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP + (ARITH_RULE `i <= 1 ==> i = 0 \/ i = 1`)) THEN + ASM_REWRITE_TAC[ARITH] THEN COMPLEX_DIFF_TAC THEN + ASM_REWRITE_TAC[CPOW_EQ_0] THEN + SIMP_TAC[COMPLEX_POW_2; CPOW_ADD; CPOW_SUB; CPOW_N; COMPLEX_POW_1] THEN + (SUBGOAL_THEN `~(z cpow s = Cx(&0))` MP_TAC THENL + [ASM_REWRITE_TAC[CPOW_EQ_0]; UNDISCH_TAC `~(z = Cx(&0))`]) THEN + CONV_TAC COMPLEX_FIELD; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_MUL; NORM_POS_LE] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ] THEN + SUBGOAL_THEN `real z` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_SEGMENT THEN + MAP_EVERY EXISTS_TAC [`Cx(&n)`; `Cx(&n) + Cx(&1)`] THEN + ASM_SIMP_TAC[REAL_CX; REAL_ADD]; + ALL_TAC] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[RE_ADD; RE_CX] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LT_NZ] THEN + UNDISCH_TAC `z IN segment[Cx (&n),Cx (&n) + Cx (&1)]` THEN + REWRITE_TAC[segment; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[RE_CMUL; RE_ADD; RE_CX] THEN + UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[NUMSEG_CONV `0..1`] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; COMPLEX_MUL_RID] THEN + DISCH_THEN(MP_TAC o SPECL [`Cx(&n)`; `Cx(&n) + Cx(&1)`]) THEN + REWRITE_TAC[ENDS_IN_SEGMENT; COMPLEX_NORM_CX; COMPLEX_ADD_SUB] THEN + REWRITE_TAC[VECTOR_ADD_RID; COMPLEX_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_DIV_1; REAL_MUL_RID] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; complex_div] THEN + CONV_TAC COMPLEX_RING);; + +let NORM_CPOW_LOWERBOUND = prove + (`!m s n. &m <= Re s /\ ~(n = 0) ==> &n pow m <= norm(Cx(&n) cpow s)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(&m * log(&n))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_OF_NUM_LT; LT_NZ; REAL_LE_REFL]; + REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[REAL_EXP_0; EXP_LOG; REAL_OF_NUM_LT; LT_NZ] THEN + SIMP_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]);; + +let ZETATERM_BOUND = prove + (`!s n m. &m <= Re s /\ ~(n = 0) + ==> norm(Cx(&1) / Cx(&n) cpow s) <= inv(&n pow m)`, + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_POW_LT; NORM_CPOW_LOWERBOUND; REAL_OF_NUM_LT; LT_NZ]);; + +let ZETA_CONVERGES_LEMMA = prove + (`!n s. &2 <= Re s ==> summable (from n) (\m. Cx(&1) / Cx(&m) cpow s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[summable] THEN + MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\n. inv(&n - &1) - inv(&(n + 1) - &1)` THEN CONJ_TAC THENL + [EXISTS_TAC `lift(inv(&n - &1))` THEN + MP_TAC(ISPECL [`\n. lift(inv(&n - &1))`; `n:num`] SERIES_DIFFS) THEN + REWRITE_TAC[o_DEF; LIFT_SUB] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC `1` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN + REWRITE_TAC[SEQ_HARMONIC]; + ALL_TAC] THEN + EXISTS_TAC `2` THEN REWRITE_TAC[GE; IN_FROM] THEN X_GEN_TAC `m:num` THEN + STRIP_TAC THEN ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_FIELD + `&2 <= x ==> inv(x - &1) - inv((x + &1) - &1) = inv(x * (x - &1))`] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&n pow 2 <= x ==> &n * (&n - &1) <= x`) THEN + MATCH_MP_TAC NORM_CPOW_LOWERBOUND THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC);; + +let ZETADIFF_CONVERGES = prove + (`!n s. &0 < Re(s) + ==> ((\m. Cx(&1) / Cx(&m) cpow s - Cx(&1) / Cx(&(m + 1)) cpow s) + sums Cx(&1) / Cx(&n) cpow s) (from n)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\m. Cx(&1) / Cx(&m) cpow s`; `n:num`] SERIES_DIFFS) THEN + REWRITE_TAC[CPOW_1; COMPLEX_DIV_1] THEN DISCH_THEN MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\n. lift(&1 / exp (Re s * log (&n)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + VECTOR_SUB_REFL; LE_1]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. &1 / (Re s * log(&n))` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LIFT] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_EXP; real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ (&0 <= x ==> &1 + u <= v) ==> &0 < x /\ u <= v`) THEN + REWRITE_TAC[REAL_EXP_LE_X] THEN + ASM_SIMP_TAC[LOG_POS_LT; REAL_LT_MUL; REAL_OF_NUM_LT; + ARITH_RULE `2 <= n ==> 1 < n`]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + MP_TAC(SPEC `exp(inv(Re s * e))` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN + REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N + 2` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN + SUBGOAL_THEN `&0 < log(&n)` ASSUME_TAC THENL + [MATCH_MP_TAC LOG_POS_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + UNDISCH_TAC `N + 2 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; + REAL_ARITH `&0 < x ==> abs x = x`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LT] THEN + ASM_REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&n` THEN ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[ARITH_RULE `N + 2 <= n ==> N <= n`] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC EXP_LOG THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC);; + +let NEARZETA_CONVERGES_LEMMA = prove + (`!n s. &1 <= Re s + ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - + (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) + sums nearzeta n s) (from n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; SUMS_INFSUM] THEN + REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\m. norm(s * (s - Cx(&1)) / Cx(&m) cpow (s + Cx(&1)))` THEN + CONJ_TAC THENL + [ALL_TAC; + EXISTS_TAC `1` THEN + ASM_SIMP_TAC[IN_FROM; GE; LE_1; NEARZETA_BOUND_LEMMA; + REAL_ARITH `&1 <= s ==> &0 <= s + &1`]] THEN + SUBGOAL_THEN + `summable (from n) + (\m. lift(((Cx (norm s) * Cx (norm (s - Cx (&1)))) * + Cx (&1) / Cx (&m) cpow Cx (Re s + &1))$1))` + MP_TAC THENL + [MATCH_MP_TAC SUMMABLE_COMPONENT THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN + MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC ZETA_CONVERGES_LEMMA THEN + REWRITE_TAC[RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM summable] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN EXISTS_TAC `1` THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_FROM; o_THM] THEN DISCH_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM RE_DEF] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; RE_MUL_CX; complex_div] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; REAL_MUL_LID; COMPLEX_NORM_INV] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + LE_1] THEN + REWRITE_TAC[GSYM CX_INV; RE_CX; RE_ADD]);; + +let GENZETA_CONVERGES = prove + (`!n s. &1 < Re s + ==> ((\m. Cx(&1) / Cx(&m) cpow s) sums genzeta n s) (from n)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP NEARZETA_CONVERGES_LEMMA o + MATCH_MP REAL_LT_IMP_LE) THEN + MP_TAC(SPECL [`n:num`; `s - Cx(&1)`] ZETADIFF_CONVERGES) THEN ANTS_TAC THENL + [REWRITE_TAC[RE_SUB; RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN + REWRITE_TAC[COMPLEX_RING `a + (b - a) = b:complex`; genzeta] THEN + COND_CASES_TAC THENL + [UNDISCH_TAC `&1 < Re s` THEN ASM_REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `inv(s - Cx(&1))` o + MATCH_MP SERIES_COMPLEX_LMUL) THEN + SUBGOAL_THEN `~(s - Cx(&1) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[complex_div; COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV] THEN + REWRITE_TAC[COMPLEX_MUL_AC; COMPLEX_ADD_AC]);; + +let ZETA_CONVERGES = prove + (`!s. &1 < Re s + ==> ((\n. Cx(&1) / Cx(&n) cpow s) sums zeta(s)) (from 1)`, + REWRITE_TAC[zeta; GENZETA_CONVERGES]);; + +(* ------------------------------------------------------------------------- *) +(* We need the series for the derivative at one stage, so do this now. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DERIVATIVE_ZETA_CONVERGES = prove + (`!s. &1 < Re s + ==> ((\n. --clog(Cx(&n)) / Cx(&n) cpow s) sums + complex_derivative zeta s) (from 1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n z. Cx(&1) / Cx(&n) cpow z`; + `\n z. --clog(Cx(&n)) / Cx(&n) cpow z`; + `{s | Re s > &1}`; + `from 1`] + SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX) THEN + REWRITE_TAC[OPEN_HALFSPACE_RE_GT; IN_ELIM_THM] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[IN_FROM] THEN REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN + CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; LE_1]; + ALL_TAC] THEN + POP_ASSUM(K ALL_TAC) THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[real_gt] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(Re z - &1) / &2`; + `\n. Cx(&1) / Cx(&n) cpow (Cx(&1 + (Re z - &1) / &2))`; + `42`] THEN + ASM_SIMP_TAC[REAL_HALF; REAL_SUB_LT] THEN CONJ_TAC THENL + [MP_TAC(SPEC `Cx(&1 + (Re z - &1) / &2)` ZETA_CONVERGES) THEN + ANTS_TAC THENL [REWRITE_TAC[RE_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MESON_TAC[summable]; + ALL_TAC] THEN + ASM_SIMP_TAC[IN_FROM; CPOW_REAL_REAL; REAL_OF_NUM_LT; RE_CX; REAL_CX; + LE_1; COMPLEX_NORM_DIV; NORM_CPOW_REAL] THEN + REWRITE_TAC[GSYM CX_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_CX; RE_CX; + real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_EXP_POS_LE] THEN + REWRITE_TAC[REAL_ABS_EXP; GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `--(a * x) <= --(b * x) <=> b * x <= a * x`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + MP_TAC(SPEC `z - y:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_NORM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; real_gt] THEN + MAP_EVERY X_GEN_TAC [`f:complex->complex`; `g:complex->complex`] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `s:complex`) THEN SIMP_TAC[ASSUME `&1 < Re s`] THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + FIRST_ASSUM(MP_TAC o SPEC `s:complex`) THEN SIMP_TAC[ASSUME `&1 < Re s`] THEN + DISCH_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `b /\ c /\ d ==> e <=> b /\ c ==> d ==> e`] + HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT) THEN + EXISTS_TAC `Re s - &1` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`\n. Cx(&1) / Cx(&n) cpow z`; `from 1`] THEN + SUBGOAL_THEN `&1 < Re z` (fun th -> ASM_SIMP_TAC[th; ZETA_CONVERGES]) THEN + MP_TAC(SPEC `z - s:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The zeta function is actually analytic on a larger set. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_NEARZETA_LEMMA = prove + (`!n. 1 <= n + ==> ?g g'. !s. s IN {s | Re(s) > &0} + ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - + (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) + sums g s) (from n) /\ + ((\m. (Cx(&1) - (s - Cx(&1)) * clog(Cx(&m))) / + Cx(&m) cpow s - + (clog(Cx(&(m + 1))) / + Cx(&(m + 1)) cpow (s - Cx(&1)) - + clog(Cx(&m)) / + Cx(&m) cpow (s - Cx(&1)))) + sums g' s) (from n) /\ + (g has_complex_derivative g' s) (at s)`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX THEN + REWRITE_TAC[OPEN_HALFSPACE_RE_GT] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `s:complex`] THEN + REWRITE_TAC[IN_ELIM_THM; real_gt; from] THEN STRIP_TAC THEN + COMPLEX_DIFF_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + ASM_REWRITE_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `s:complex` THEN REWRITE_TAC[IN_ELIM_THM; real_gt] THEN + DISCH_TAC THEN EXISTS_TAC `min (Re s / &2) (&1)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; REAL_HALF] THEN + EXISTS_TAC `\n. Cx(norm(s) + &2) pow 2 / + Cx(&n) cpow Cx((Re s / &2 + &1))` THEN + EXISTS_TAC `1` THEN CONJ_TAC THENL + [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN + MP_TAC(SPECL [`n:num`; `Cx(Re s / &2 + &1)`] GENZETA_CONVERGES) THEN + REWRITE_TAC[RE_CX] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN MESON_TAC[summable]; + ALL_TAC] THEN + CONJ_TAC THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[from; IN_ELIM_THM] THENL + [DISCH_TAC THEN + SUBGOAL_THEN `1 <= m` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1; + GSYM CX_DIV; GSYM CX_POW] THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_POW_LE THEN NORM_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) NEARZETA_BOUND_LEMMA o lhand o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_POW_2] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(w) = &1 /\ norm(z) <= x + &1 + ==> norm z <= abs(x + &2) /\ norm(z - w) <= abs(x + &2)`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ASM_NORM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_NORM_INV; NORM_CPOW_REAL; REAL_CX; RE_CX; + REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; RE_ADD; RE_CX] THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC);; + +let HOLOMORPHIC_NEARZETA_STRONG = prove + (`!n s. 1 <= n /\ &0 < Re s + ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - + (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) + sums (nearzeta n s)) (from n) /\ + ((\m. (Cx(&1) - (s - Cx(&1)) * clog(Cx(&m))) / + Cx(&m) cpow s - + (clog(Cx(&(m + 1))) / + Cx(&(m + 1)) cpow (s - Cx(&1)) - + clog(Cx(&m)) / + Cx(&m) cpow (s - Cx(&1)))) + sums (complex_derivative(nearzeta n) s)) (from n) /\ + ((nearzeta n) has_complex_derivative + complex_derivative(nearzeta n) s) (at s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_NEARZETA_LEMMA) THEN + REWRITE_TAC[IN_ELIM_THM; real_gt; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:complex->complex`; `g':complex->complex`] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [FORALL_AND_THM; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!s. &0 < Re s + ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - + (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) + sums nearzeta n s) (from n)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; SUMS_INFSUM] THEN + ASM_MESON_TAC[summable]; + ALL_TAC] THEN + SUBGOAL_THEN `!z. &0 < Re z ==> nearzeta n z = g z` ASSUME_TAC THENL + [ASM_MESON_TAC[SERIES_UNIQUE]; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN + `!z. &0 < Re z ==> ((nearzeta n) has_complex_derivative g' z) (at z)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`g:complex->complex`; `Re z`] THEN + ASM_SIMP_TAC[dist] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MP_TAC(SPEC `w - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DERIVATIVE]);; + +let NEARZETA_CONVERGES = prove + (`!n s. &0 < Re s + ==> ((\m. (s - Cx(&1)) / Cx(&m) cpow s - + (Cx(&1) / Cx(&m) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(m + 1)) cpow (s - Cx(&1)))) + sums nearzeta n s) (from n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; SUMS_INFSUM] THEN + MATCH_MP_TAC SUMMABLE_EQ_COFINITE THEN EXISTS_TAC `from(n + 1)` THEN + SUBGOAL_THEN + `from(n + 1) DIFF from n UNION from n DIFF from(n + 1) = {n}` + (fun th -> REWRITE_TAC[th; FINITE_INSERT; FINITE_RULES]) + THENL + [SIMP_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_SING] THEN ARITH_TAC; + MP_TAC(SPECL [`n + 1`; `s:complex`] HOLOMORPHIC_NEARZETA_STRONG) THEN + ASM_REWRITE_TAC[summable] THEN ANTS_TAC THENL [ARITH_TAC; MESON_TAC[]]]);; + +let SUMS_COMPLEX_DERIVATIVE_NEARZETA = prove + (`!n s. 1 <= n /\ &0 < Re s + ==> ((\m. (Cx(&1) - (s - Cx(&1)) * clog(Cx(&m))) / Cx(&m) cpow s - + (clog(Cx(&(m + 1))) / Cx(&(m + 1)) cpow (s - Cx(&1)) - + clog(Cx(&m)) / Cx(&m) cpow (s - Cx(&1)))) sums + (complex_derivative (nearzeta n) s)) (from n)`, + SIMP_TAC[HOLOMORPHIC_NEARZETA_STRONG]);; + +let HOLOMORPHIC_NEARZETA = prove + (`!n. 1 <= n ==> (nearzeta n) holomorphic_on {s | Re(s) > &0}`, + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; IN_ELIM_THM] THEN + REWRITE_TAC[real_gt] THEN MESON_TAC[HOLOMORPHIC_NEARZETA_STRONG]);; + +let COMPLEX_DIFFERENTIABLE_NEARZETA = prove + (`!n s. 1 <= n /\ &0 < Re s ==> (nearzeta n) complex_differentiable (at s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HOLOMORPHIC_NEARZETA_STRONG) THEN + MESON_TAC[complex_differentiable]);; + +let NEARZETA_1 = prove + (`!n. 1 <= n ==> nearzeta n (Cx(&1)) = Cx(&0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[nearzeta; COMPLEX_SUB_REFL] THEN + MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n:num. (vec 0:complex)` THEN + REWRITE_TAC[SERIES_0; GSYM COMPLEX_VEC_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; IN_FROM; complex_div] THEN X_GEN_TAC `m:num` THEN + DISCH_TAC THEN + SUBGOAL_THEN `~(m = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[complex_pow] THEN + CONV_TAC COMPLEX_RING);; + +let HOLOMORPHIC_ZETA = prove + (`zeta holomorphic_on {s | Re(s) > &0 /\ ~(s = Cx(&1))}`, + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[zeta; genzeta] THEN + MATCH_MP_TAC HOLOMORPHIC_TRANSFORM THEN + EXISTS_TAC `\z. (nearzeta 1 z + Cx(&1) / Cx(&1) cpow (z - Cx(&1))) / + (z - Cx(&1))` THEN + SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[IN_ELIM_THM; COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; + HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `{s | Re s > &0}` THEN + SIMP_TAC[HOLOMORPHIC_NEARZETA; LE_REFL; ETA_AX] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; + REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN + REWRITE_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]]);; + +let COMPLEX_DIFFERENTIABLE_AT_ZETA = prove + (`!s. &0 < Re s /\ ~(s = Cx(&1)) + ==> zeta complex_differentiable at s`, + MP_TAC HOLOMORPHIC_ZETA THEN + REWRITE_TAC[SET_RULE `{s | P s /\ ~(s = a)} = {s | P s} DELETE a`] THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DELETE; OPEN_HALFSPACE_RE_GT] THEN + REWRITE_TAC[complex_differentiable; IN_ELIM_THM; IN_DELETE; real_gt]);; + +(* ------------------------------------------------------------------------- *) +(* Euler product formula. Nice proof from Ahlfors' book avoiding any *) +(* messing round with the geometric series. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_DIVISORS_LEMMA = prove + (`!x p l k. + ((\n. x(p * n)) sums l) k + ==> ~(p = 0) /\ + (!n. (p * n) IN k <=> n IN k) + ==> (x sums l) {n | n IN k /\ p divides n}`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `p * N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV p`) THEN + ASM_SIMP_TAC[LE_RDIV_EQ] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (rand o rand) VSUM_IMAGE (lhand w))) THEN + ASM_SIMP_TAC[FINITE_INTER_NUMSEG; EQ_MULT_LCANCEL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTER; IN_NUMSEG] THEN + ASM_SIMP_TAC[LE_RDIV_EQ; divides; LE_0] THEN ASM_MESON_TAC[]);; + +let EULER_PRODUCT_LEMMA = prove + (`!s ps. &1 < Re s /\ FINITE ps /\ (!p. p IN ps ==> prime p) + ==> ((\n. Cx(&1) / Cx(&n) cpow s) sums + (cproduct ps (\p. Cx(&1) - inv(Cx(&p) cpow s)) * zeta s)) + {n | 1 <= n /\ !p. prime p /\ p divides n ==> ~(p IN ps)}`, + let lemma = prove + (`(x sums (k + l)) (s UNION t) /\ s INTER t = {} + ==> (x sums k) s ==> (x sums l) t`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[sums] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN REWRITE_TAC[VECTOR_ADD_SUB] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ABS_TAC THEN ASM_SIMP_TAC[SET_RULE + `s INTER t = {} + ==> t INTER u = (((s UNION t) INTER u) DIFF (s INTER u))`] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_DIFF THEN + REWRITE_TAC[FINITE_INTER_NUMSEG] THEN SET_TAC[]) in + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES] THEN + ASM_SIMP_TAC[ZETA_CONVERGES; COMPLEX_MUL_LID; NOT_IN_EMPTY; GSYM from] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `ps:num->bool`] THEN + REWRITE_TAC[IN_INSERT; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `inv(Cx(&p) cpow s)` o MATCH_MP + SERIES_COMPLEX_LMUL) THEN + REWRITE_TAC[complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `x * Cx(&1) * y = Cx(&1) * x * y`] THEN + REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN REWRITE_TAC[GSYM complex_div] THEN + ASM_SIMP_TAC[GSYM CPOW_MUL_REAL; REAL_CX; RE_CX; REAL_POS] THEN + REWRITE_TAC[GSYM CX_MUL; REAL_OF_NUM_MUL] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[] + (ISPEC `\n. Cx(&1) / Cx(&n) cpow s` SERIES_DIVISORS_LEMMA))) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[PRIME_DIVPROD_EQ] THEN + ASM_REWRITE_TAC[MULT_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[PRIME_PRIME_FACTOR; PRIME_1]; + ALL_TAC] THEN + MATCH_MP_TAC lemma THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_RING `a * x + (Cx(&1) - a) * x = x`] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC) THEN + SET_TAC[]);; + +let SUMMABLE_SUBZETA = prove + (`!s t. &1 < Re s /\ ~(0 IN t) + ==> summable t (\n. Cx (&1) / Cx (&n) cpow s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN + EXISTS_TAC `from 1` THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_FROM] THEN ASM_MESON_TAC[LE_1]; ALL_TAC] THEN + MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(&1) / Cx(&n) cpow (Cx(Re s))` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[summable] THEN EXISTS_TAC `zeta (Cx(Re s))` THEN + MATCH_MP_TAC ZETA_CONVERGES THEN ASM_REWRITE_TAC[RE_CX]; + SIMP_TAC[IN_FROM; LE_1; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + GSYM CX_DIV; REAL_LE_DIV; REAL_POS; REAL_EXP_POS_LE]; + EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0; IN_FROM] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_0; NORM_POS_LE] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CPOW_REAL; REAL_CX; RE_CX; + REAL_LE_REFL; REAL_OF_NUM_LT; LE_1]]);; + +let EULER_PRODUCT_MULTIPLY = prove + (`!s. &1 < Re s + ==> ((\n. cproduct {p | prime p /\ p <= n} + (\p. Cx(&1) - inv(Cx(&p) cpow s)) * zeta s) + --> Cx(&1)) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\n. infsum {m | 1 <= m /\ !p. prime p /\ p divides m + ==> ~(p IN {p | prime p /\ p <= n})} + (\n. Cx (&1) / Cx (&n) cpow s)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC EULER_PRODUCT_LEMMA THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `0..n` THEN REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; LE_0; IN_NUMSEG]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `?l. ((\n. Cx (&1) / Cx (&n) cpow Cx(Re s)) sums l) (from 1)` + MP_TAC THENL + [MP_TAC(SPEC `Cx(Re s)` ZETA_CONVERGES) THEN + ASM_SIMP_TAC[RE_CX] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SERIES_CAUCHY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF; GE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`s:complex`; + `{m | 1 <= m /\ (!p. prime p /\ p divides m ==> n < p)}`] + SUMMABLE_SUBZETA) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; ARITH] THEN + REWRITE_TAC[GSYM SUMS_INFSUM] THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (MP_TAC o SPEC `N1 + N2 + 1`)) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN SIMP_TAC[NOT_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `dist(x,z) < e / &2 /\ dist(y,z) <= dist(x,y) + dist(x,z) + ==> dist(x,y) < e / &2 ==> dist(y,z) < e`) THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2 + 1`) THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN + REWRITE_TAC[dist] THEN SUBGOAL_THEN + `vsum + ({m | 1 <= m /\ (!p. prime p /\ p divides m ==> n < p)} INTER + (0..N1 + N2 + 1)) + (\n. Cx (&1) / Cx (&n) cpow s) - Cx(&1) = + vsum + (({m | 1 <= m /\ (!p. prime p /\ p divides m ==> n < p)} INTER + (0..N1 + N2 + 1)) DELETE 1) + (\n. Cx (&1) / Cx (&n) cpow s)` + SUBST1_TAC THENL + [SIMP_TAC[VSUM_DELETE_CASES; FINITE_INTER_NUMSEG] THEN + REWRITE_TAC[IN_ELIM_THM; DIVIDES_ONE; IN_INTER] THEN + REWRITE_TAC[CPOW_1; COMPLEX_DIV_1] THEN + REWRITE_TAC[MESON[] `(!x. P x /\ x = 1 ==> Q x) <=> P 1 ==> Q 1`] THEN + REWRITE_TAC[PRIME_1; IN_NUMSEG; ARITH; ARITH_RULE `1 <= a + b + 1`]; + ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_NORM_VSUM_BOUND_SUBSET THEN + REWRITE_TAC[FINITE_INTER_NUMSEG] THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET; IN_DELETE; IN_INTER; IN_ELIM_THM; IN_NUMSEG; IN_FROM] THEN + ASM_MESON_TAC[PRIME_FACTOR; DIVIDES_LE; NUM_REDUCE_CONV `1 <= 0`; + LT_IMP_LE; LE_TRANS]; + ALL_TAC] THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_INTER; IN_FROM] THEN STRIP_TAC THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID; COMPLEX_NORM_INV] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; LE_1; + NORM_CPOW_REAL] THEN + SIMP_TAC[REAL_INV; REAL_CX; GSYM CX_INV; RE_CX; REAL_LE_REFL]);; + +let ZETA_NONZERO_LEMMA = prove + (`!s. &1 < Re s ==> ~(zeta s = Cx(&0))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP EULER_PRODUCT_MULTIPLY) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `&1 / &2`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; LE_REFL] THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; COMPLEX_NORM_CX] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let EULER_PRODUCT = prove + (`!s. &1 < Re s + ==> ((\n. cproduct {p | prime p /\ p <= n} + (\p. inv(Cx(&1) - inv(Cx(&p) cpow s)))) + --> zeta(s)) sequentially`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (PAT_CONV `\x. ((\n. x) --> x) sq`) + [GSYM COMPLEX_INV_INV] THEN + MATCH_MP_TAC LIM_COMPLEX_INV THEN + ASM_SIMP_TAC[COMPLEX_INV_EQ_0; ZETA_NONZERO_LEMMA] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP EULER_PRODUCT_MULTIPLY) THEN + DISCH_THEN(MP_TAC o SPEC `inv(zeta(s))` o MATCH_MP LIM_COMPLEX_RMUL) THEN + REWRITE_TAC[COMPLEX_MUL_LID; GSYM COMPLEX_MUL_ASSOC] THEN + ASM_SIMP_TAC[ZETA_NONZERO_LEMMA; COMPLEX_MUL_RINV; COMPLEX_MUL_RID] THEN + ASM_SIMP_TAC[GSYM CPRODUCT_INV; FINITE_ATMOST; COMPLEX_INV_INV]);; + +(* ------------------------------------------------------------------------- *) +(* Show that s = 1 is not a zero, just for tidiness. *) +(* ------------------------------------------------------------------------- *) + +let SUMS_GAMMA = prove + (`((\n. Cx(sum(1..n) (\i. &1 / &i - (log(&(i + 1)) - log(&i))))) --> + complex_derivative (nearzeta 1) (Cx(&1))) sequentially`, + MP_TAC(SPECL [`1`; `Cx(&1)`] SUMS_COMPLEX_DERIVATIVE_NEARZETA) THEN + SIMP_TAC[GSYM VSUM_CX; FINITE_NUMSEG; RE_CX; REAL_LT_01; LE_REFL] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; CPOW_N; sums] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[FROM_INTER_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ THEN + SIMP_TAC[IN_NUMSEG; CX_INJ; REAL_OF_NUM_EQ; ADD_EQ_0; ARITH; REAL_OF_NUM_LT; + ARITH_RULE `1 <= i ==> 0 < i /\ ~(i = 0)`; GSYM CX_LOG; + ARITH_RULE `0 < i + 1`] THEN + REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_SUB_RZERO] THEN + REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; REAL_DIV_1]);; + +let ZETA_1_NZ = prove + (`~(zeta(Cx(&1)) = Cx(&0))`, + REWRITE_TAC[zeta; genzeta] THEN DISCH_TAC THEN + SUBGOAL_THEN `&1 - log(&2) <= Re(complex_derivative (nearzeta 1) (Cx(&1)))` + MP_TAC THENL + [REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_LBOUND) THEN + EXISTS_TAC `\n. Cx(sum(1..n) (\i. &1 / &i - (log(&(i + 1)) - log(&i))))` THEN + REWRITE_TAC[SUMS_GAMMA; TRIVIAL_LIMIT_SEQUENTIALLY; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM RE_DEF; RE_CX] THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH; REAL_DIV_1; LOG_1] THEN + REWRITE_TAC[REAL_ARITH `a - b <= a - (b - &0) + c <=> &0 <= c`] THEN + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + SIMP_TAC[REAL_SUB_LE; GSYM LOG_DIV; REAL_OF_NUM_LT; + ARITH_RULE `2 <= x ==> 0 < x /\ 0 < x + 1`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SIMP_TAC[REAL_FIELD `&0 < x ==> (x + &1) / x = &1 + &1 / x`; + REAL_OF_NUM_LT; ARITH_RULE `2 <= x ==> 0 < x`] THEN + SIMP_TAC[LOG_LE; REAL_LE_DIV; REAL_POS]; + ASM_REWRITE_TAC[RE_CX; REAL_NOT_LE; REAL_SUB_LT] THEN + GEN_REWRITE_TAC I [GSYM REAL_EXP_MONO_LT] THEN + SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; ARITH] THEN + SUBGOAL_THEN `(&1 + &1 / &2) pow 2 <= exp(&1 / &2) pow 2` MP_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[REAL_EXP_LE_X]; + ALL_TAC] THEN + SIMP_TAC[GSYM REAL_EXP_N; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Lack of zeros on Re(s) >= 1. Nice proof from Bak & Newman. *) +(* ------------------------------------------------------------------------- *) + +let ZETA_MULTIPLE_BOUND = prove + (`!x y. real x /\ real y /\ &1 < Re x + ==> &1 <= norm(zeta(x) pow 3 * + zeta(x + ii * y) pow 4 * + zeta(x + Cx(&2) * ii * y) pow 2)`, + let lemma1 = prove + (`&0 <= a /\ &0 <= b /\ &0 <= c /\ + c * (&2 * a + b) pow 3 / &27 <= x + ==> c * a pow 2 * b <= x`, + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= x ==> a <= x`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH + `a pow 2 * b <= (&2 * a + b) pow 3 / &27 <=> + &0 <= (&8 / &27 * a + &1 / &27 * b) * (a - b) pow 2`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + ASM_REAL_ARITH_TAC) + and lemma2 = prove + (`-- &1 <= t /\ t <= &1 + ==> &0 <= &1 + r pow 2 - &2 * r * t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= (&1 - t) * (&1 + t) /\ &0 <= (r - t) pow 2 + ==> &0 <= &1 + r pow 2 - &2 * r * t`) THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_LBOUND) THEN + EXISTS_TAC + `\n. cproduct {p | prime p /\ p <= n} + (\p. inv(Cx(&1) - inv(Cx(&p) cpow x))) pow 3 * + cproduct {p | prime p /\ p <= n} + (\p. inv(Cx(&1) - inv(Cx(&p) cpow (x + ii * y)))) pow 4 * + cproduct {p | prime p /\ p <= n} + (\p. inv(Cx(&1) - + inv(Cx(&p) cpow (x + Cx(&2) * ii * y)))) pow 2` THEN + REWRITE_TAC[eventually; TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC) THEN + MATCH_MP_TAC LIM_COMPLEX_POW THEN + MATCH_MP_TAC EULER_PRODUCT THEN + RULE_ASSUM_TAC(REWRITE_RULE[real]) THEN + ASM_REWRITE_TAC[RE_ADD; RE_MUL_CX; RE_MUL_II; + REAL_NEG_0; REAL_ADD_RID; REAL_MUL_RZERO]; + ALL_TAC] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[SEQUENTIALLY; GE; LE_0] THEN + X_GEN_TAC `n:num` THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[GSYM COMPLEX_NORM_INV; COMPLEX_NORM_NZ; COMPLEX_INV_EQ_0] THEN + ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0; ARITH; COMPLEX_INV_EQ_0; + CPRODUCT_EQ_0; IN_ELIM_THM; FINITE_ATMOST] THEN + REWRITE_TAC[COMPLEX_RING `Cx(&1) - x = Cx(&0) <=> x = Cx(&1)`] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[TAUT `(~p \/ ~q) \/ ~r <=> p /\ q ==> ~r`] THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `(norm:complex->real) o inv`) THEN + REWRITE_TAC[COMPLEX_NORM_INV; o_THM; COMPLEX_NORM_CX; REAL_ABS_NUM; + REAL_INV_INV; REAL_INV_1] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_OF_NUM_LT; PRIME_IMP_NZ; LT_NZ; + REAL_EXP_EQ_1; REAL_CX; RE_CX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[real]) THEN + ASM_REWRITE_TAC[REAL_ENTIRE; RE_ADD; RE_MUL_CX; RE_MUL_II; + REAL_NEG_0; REAL_ADD_RID; REAL_MUL_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `&1 < x /\ &0 < y ==> ~(x = &0 \/ y = &0)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOG_POS_LT THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CPRODUCT_POW; FINITE_ATMOST; GSYM CPRODUCT_MUL] THEN + SIMP_TAC[GSYM CPRODUCT_INV; COMPLEX_INV_INV; FINITE_ATMOST] THEN + REWRITE_TAC[COMPLEX_INV_MUL; GSYM COMPLEX_POW_INV; COMPLEX_INV_INV] THEN + SIMP_TAC[NORM_CPRODUCT; FINITE_ATMOST; REAL_INV_1] THEN + MATCH_MP_TAC PRODUCT_LE_1 THEN SIMP_TAC[NORM_POS_LE; FINITE_ATMOST] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[CPOW_ADD; COMPLEX_MUL_2; GSYM COMPLEX_POW_2] THEN + REWRITE_TAC[COMPLEX_INV_MUL] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN + ASM_REWRITE_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[GSYM CEXP_NEG; GSYM CEXP_N] THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM o CONV_RULE(REWR_CONV REAL))) THEN + SIMP_TAC[GSYM CX_MUL; GSYM CX_NEG; GSYM CX_EXP; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_RING `--(ii * x) = ii * --x`] THEN + REWRITE_TAC[COMPLEX_RING `--(Cx(&2) * ii * x) = ii * Cx(&2) * --x`] THEN + REWRITE_TAC[CEXP_EULER] THEN + REWRITE_TAC[CCOS_NEG; CSIN_NEG; GSYM CX_SIN; GSYM CX_COS; GSYM CX_NEG; + GSYM CX_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + SIMP_TAC[REAL_RING `(z:real) pow 4 = (z pow 2) pow 2`; COMPLEX_SQNORM] THEN + REWRITE_TAC[COMPLEX_SQNORM] THEN + REWRITE_TAC[RE_SUB; RE_CX; RE_MUL_CX; RE_ADD; RE_MUL_II; + IM_SUB; IM_CX; IM_MUL_CX; IM_ADD; IM_MUL_II] THEN + REWRITE_TAC[REAL_NEG_0; REAL_ADD_RID; REAL_SUB_LZERO; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_RING + `(&1 - r * c) pow 2 + --(r * s) pow 2 = + &1 + r pow 2 * (s pow 2 + c pow 2) - &2 * r * c`] THEN + REWRITE_TAC[SIN_CIRCLE; REAL_POW_NEG; ARITH] THEN + ABBREV_TAC `r = exp(--(Re x * log(&p)))` THEN + REWRITE_TAC[COS_DOUBLE_COS; COS_NEG; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + ABBREV_TAC `t = cos(Re y * log(&p))` THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ARITH + `x - &2 * r * (&2 * y - &1) = x + &2 * r - &4 * r * y`] THEN + MP_TAC(SPEC `Re y * log(&p)` COS_BOUNDS) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < r /\ r < &1` MP_TAC THENL + [EXPAND_TAC "r" THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN + SUBST1_TAC(GSYM REAL_EXP_0) THEN REWRITE_TAC[REAL_EXP_MONO_LT] THEN + REWRITE_TAC[REAL_LT_LNEG; REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[LOG_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `1 < t <=> 2 <= t`; + PRIME_GE_2] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[REAL_ARITH `r < &1 ==> abs(&1 - r) = (&1 - r)`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN + MATCH_MP_TAC lemma1 THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_SUB_LE; lemma2] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH + `&1 + s + &2 * r - &4 * r * t = &1 + s - &2 * r * (&2 * t - &1)`] THEN + MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `-- &1 <= &2 * x pow 2 - &1 <=> &0 <= x * x`; + REAL_ARITH `&2 * t pow 2 - &1 <= &1 <=> t pow 2 <= &1 pow 2`; + REAL_LE_SQUARE] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `x pow 3 * y pow 3 / &27 <= &1 <=> (x * y) pow 3 <= &3 pow 3`] THEN + MATCH_MP_TAC REAL_POW_LE2_ODD THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[REAL_ARITH + `&2 * (&1 + r pow 2 - &2 * r * t) + &1 + r pow 2 + + &2 * r - &4 * r * t pow 2 = + (&3 + &3 * r pow 2) - &2 * r * (&2 * t pow 2 + &2 * t - &1)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 - r) * ((&3 + &3 * r pow 2) + &3 * r)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN + REWRITE_TAC[REAL_ARITH + `c - &2 * r * y <= c + &3 * r <=> &0 <= r * (&2 * y + &3)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&0 <= &2 * (&2 * t pow 2 + &2 * t - &1) + &3 <=> + &0 <= (t + &1 / &2) pow 2`] THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= r pow 3` MP_TAC THENL + [ASM_SIMP_TAC[REAL_POW_LE]; REAL_ARITH_TAC]);; + +let ZETA_NONZERO = prove + (`!s. &1 <= Re s ==> ~(zeta s = Cx(&0))`, + REWRITE_TAC[REAL_ARITH `&1 <= x <=> &1 < x \/ x = &1`] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[ZETA_NONZERO_LEMMA] THEN + SUBST1_TAC(SPEC `s:complex` COMPLEX_EXPAND) THEN + ASM_REWRITE_TAC[] THEN ABBREV_TAC `y = Im s` THEN ASM_CASES_TAC `y = &0` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; ZETA_1_NZ] THEN + DISCH_TAC THEN SUBGOAL_THEN + `~(&1 <= norm((Cx(&0) * + complex_derivative (\x. zeta(x + ii * Cx y)) (Cx(&1)) pow 4) * + zeta (Cx(&1) + Cx (&2) * ii * Cx(y)) pow 2))` + MP_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_MUL_LZERO] THEN REAL_ARITH_TAC; + SIMP_TAC[]] THEN + MATCH_MP_TAC(ISPEC `at (Cx(&1)) within {s | real s /\ &1 < Re s}` + LIM_NORM_LBOUND) THEN + EXISTS_TAC + `\x. zeta (x) pow 3 * zeta (x + ii * Cx(y)) pow 4 * + zeta (x + Cx (&2) * ii * Cx(y)) pow 2` THEN + REWRITE_TAC[eventually; TRIVIAL_LIMIT_WITHIN; WITHIN; AT] THEN + SUBGOAL_THEN `Cx(&1) limit_point_of {s | real s /\ &1 < Re s}` + ASSUME_TAC THENL + [REWRITE_TAC[LIMPT_APPROACHABLE_LE] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN EXISTS_TAC `Cx(&1 + e)` THEN + REWRITE_TAC[dist; CX_INJ; IN_ELIM_THM; REAL_CX; RE_CX] THEN + REWRITE_TAC[GSYM CX_SUB; REAL_ADD_SUB; COMPLEX_NORM_CX] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[IN_ELIM_THM; REAL_CX; ZETA_MULTIPLE_BOUND] THEN + MAP_EVERY EXISTS_TAC [`Cx(&3)`; `Cx(&2)`] THEN + REWRITE_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_CX; RE_CX] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM CONTINUOUS_WITHIN] THEN + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_POW THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_ZETA THEN + REWRITE_TAC[RE_ADD; RE_MUL_CX; RE_MUL_II; RE_II; RE_CX] THEN + REWRITE_TAC[COMPLEX_RING `x + y = x <=> y = Cx(&0)`] THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN + REAL_ARITH_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\x. (zeta x pow 3 * (x - Cx(&1)) pow 4) * + (zeta(x + ii * Cx y) / (x - Cx(&1))) pow 4` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [SIMP_TAC[LIM_WITHIN; GSYM DIST_NZ; COMPLEX_SUB_0; COMPLEX_FIELD + `~(x = Cx(&0)) + ==> (y * x pow 4) * (z / x) pow 4 - y * z pow 4 = Cx(&0)`] THEN + SIMP_TAC[dist; COMPLEX_VEC_0; COMPLEX_SUB_REFL; COMPLEX_NORM_0] THEN + MESON_TAC[REAL_LT_01]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LIM_COMPLEX_POW THEN + SUBGOAL_THEN `((\x. zeta (x + ii * Cx y)) has_complex_derivative + complex_derivative (\x. zeta (x + ii * Cx y)) (Cx (&1))) + (at (Cx (&1)) within {s | real s /\ &1 < Re s})` + MP_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN; COMPLEX_SUB_RZERO]] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN + SIMP_TAC[COMPLEX_DIFFERENTIABLE_ADD; COMPLEX_DIFFERENTIABLE_CONST; + COMPLEX_DIFFERENTIABLE_ID] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_ZETA THEN + ASM_REWRITE_TAC[RE_ADD; RE_MUL_II; COMPLEX_RING `x + y = x <=> y = Cx(&0)`; + IM_CX; COMPLEX_ENTIRE; II_NZ; RE_CX; CX_INJ] THEN + REAL_ARITH_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\x. (nearzeta 1 (x) + Cx(&1)) pow 3 * (x - Cx(&1))` THEN + CONJ_TAC THENL + [SIMP_TAC[LIM_WITHIN; CPOW_1; GSYM DIST_NZ; zeta; genzeta; COMPLEX_DIV_1; + COMPLEX_FIELD + `~(x:complex = a) + ==> b * (x - a) - (c / (x - a)) pow 3 * (x - a) pow 4 = + (b - c pow 3) * (x - a)`] THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_REFL] THEN + SIMP_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO; COMPLEX_NORM_0] THEN + MESON_TAC[REAL_LT_01]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_AT_WITHIN THEN SUBST1_TAC(COMPLEX_RING + `Cx(&0) = (nearzeta 1 (Cx(&1)) + Cx(&1)) pow 3 * (Cx(&1) - Cx(&1))`) THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN + SIMP_TAC[LIM_SUB; LIM_CONST; LIM_AT_ID] THEN + MATCH_MP_TAC LIM_COMPLEX_POW THEN MATCH_MP_TAC LIM_ADD THEN + REWRITE_TAC[LIM_CONST] THEN REWRITE_TAC[GSYM CONTINUOUS_AT] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_NEARZETA; + RE_CX; REAL_OF_NUM_LT; ARITH]);; + +let NEARZETA_NONZERO = prove + (`!s. &1 <= Re s ==> ~(nearzeta 1 s + Cx (&1) = Cx(&0))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ZETA_NONZERO) THEN + REWRITE_TAC[zeta; genzeta] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[NEARZETA_1; ARITH; CPOW_1] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* The logarithmic derivative of the zeta function. *) +(* ------------------------------------------------------------------------- *) + +let NORM_CLOG_BOUND = prove + (`norm(z) <= &1 / &2 ==> norm(clog(Cx(&1) - z)) <= &2 * norm(z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. clog(Cx(&1) - z)`; `\z. inv(z - Cx(&1))`; + `cball(Cx(&0),&1 / &2)`; `&2`] COMPLEX_DIFFERENTIABLE_BOUND) THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPECL [`z:complex`; `Cx(&0)`]) THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; CLOG_1] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[CENTRE_IN_CBALL] THEN REWRITE_TAC[IN_CBALL] THEN + ASM_REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + REWRITE_TAC[CONVEX_CBALL; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN CONJ_TAC THENL + [COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_RING `(Cx(&0) - Cx(&1)) * x = --x`] THEN + REWRITE_TAC[COMPLEX_NEG_INV; COMPLEX_NEG_SUB] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[RE_SUB; REAL_SUB_LT] THEN + MP_TAC(SPEC `w:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB; RE_CX] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&1 / &2)`)) THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + MP_TAC(SPEC `1` COMPLEX_NORM_NUM) THEN ASM_NORM_ARITH_TAC);; + +let LOGZETA_EXISTS = prove + (`?logzeta logzeta'. + !s. s IN {s | Re s > &1} + ==> ((\p. clog(Cx(&1) - inv(Cx(&p) cpow s))) + sums logzeta(s)) + {p | prime p} /\ + ((\p. clog(Cx(&p)) / (Cx(&p) cpow s - Cx(&1))) + sums logzeta'(s)) + {p | prime p} /\ + (logzeta has_complex_derivative logzeta'(s)) (at s)`, + MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX THEN + REWRITE_TAC[OPEN_HALFSPACE_RE_GT] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; real_gt] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ; + COMPLEX_SUB_LZERO; COMPLEX_MUL_LID; COMPLEX_FIELD + `~(x = Cx(&0)) ==> --(a * x) / x pow 2 = --(a / x)`] THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_INV_MUL] THEN + ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ; COMPLEX_FIELD + `~(y = Cx(&0)) ==> y * (Cx(&1) - inv(y)) = y - Cx(&1)`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[RE_SUB; REAL_SUB_LT] THEN + MATCH_MP_TAC(REAL_ARITH `!y. abs x <= y /\ y < w ==> x < w`) THEN + EXISTS_TAC `norm(inv (Cx (&p) cpow s))` THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN REWRITE_TAC[RE_CX] THEN + ASM_SIMP_TAC[COMPLEX_NORM_INV; NORM_CPOW_REAL; REAL_CX; RE_CX; + REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ] THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; GSYM REAL_EXP_0; REAL_EXP_MONO_LT] THEN + REWRITE_TAC[REAL_LT_LNEG; REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[LOG_POS_LT; REAL_OF_NUM_LT; ARITH_RULE `1 < p <=> 2 <= p`; + PRIME_GE_2] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; real_gt] THEN X_GEN_TAC `s:complex` THEN + DISCH_TAC THEN EXISTS_TAC `(Re(s) - &1) / &2` THEN + EXISTS_TAC `\p. Cx(&2) / Cx(&p) cpow (Cx(&1 + (Re(s) - &1) / &2))` THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT; RIGHT_EXISTS_AND_THM] THEN + CONJ_TAC THENL + [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SUMMABLE_SUBSET_COMPLEX THEN EXISTS_TAC `from 1` THEN + SIMP_TAC[CPOW_REAL_REAL; IN_FROM; REAL_CX; RE_CX; REAL_OF_NUM_LT; + ARITH_RULE `0 < n <=> 1 <= n`; GSYM CX_INV; REAL_LE_INV_EQ; + REAL_EXP_POS_LE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; IN_FROM; PRIME_GE_2; + ARITH_RULE `2 <= p ==> 1 <= p`] THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC `zeta(Cx(&1 + (Re s - &1) / &2))` THEN + ONCE_REWRITE_TAC[COMPLEX_RING `inv(x) = Cx(&1) * inv x`] THEN + REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC ZETA_CONVERGES THEN + REWRITE_TAC[RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [SIMP_TAC[CPOW_REAL_REAL; IN_FROM; REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ; + PRIME_IMP_NZ; GSYM CX_DIV; REAL_CX; REAL_LE_DIV; REAL_POS; + REAL_EXP_POS_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `summable (from 1) (\n. Cx (&1) / Cx (&n) cpow (Cx(&1 + (Re s - &1) / &2)))` + MP_TAC THENL + [REWRITE_TAC[summable] THEN + EXISTS_TAC `zeta(Cx(&1 + (Re s - &1) / &2))` THEN + MATCH_MP_TAC ZETA_CONVERGES THEN + REWRITE_TAC[RE_CX] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `&1 / &2` o MATCH_MP SERIES_GOESTOZERO) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num` THEN + DISCH_THEN(fun th -> + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[IN_FROM; PRIME_IMP_NZ; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * norm(inv(Cx(&p) cpow y))` THEN CONJ_TAC THENL + [MATCH_MP_TAC NORM_CLOG_BOUND THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a ==> y <= x ==> y <= a`)) THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID]; + SIMP_TAC[complex_div; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS]] THEN + REWRITE_TAC[GSYM CPOW_NEG] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL_MONO; REAL_CX; RE_CX; REAL_OF_NUM_LT; PRIME_GE_2; + ARITH_RULE `2 <= p ==> 1 < p`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_BALL_RE) THEN + REWRITE_TAC[RE_NEG; RE_CX] THEN REAL_ARITH_TAC);; + +let LOGZETA_PROPERTIES = + new_specification ["logzeta"; "logzeta'"] LOGZETA_EXISTS;; + +let [LOGZETA_CONVERGES; LOGZETA'_CONVERGES; HAS_COMPLEX_DERIVATIVE_LOGZETA] = + CONJUNCTS(REWRITE_RULE[IN_ELIM_THM; FORALL_AND_THM; real_gt; TAUT + `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] + LOGZETA_PROPERTIES);; + +let CEXP_LOGZETA = prove + (`!s. &1 < Re s ==> cexp(--(logzeta s)) = zeta s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC + `\n. cexp(vsum({p | prime p} INTER (0..n)) + (\p. --clog(Cx(&1) - inv(Cx(&p) cpow s))))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`cexp`; `--logzeta s`] CONTINUOUS_AT_SEQUENTIALLY) THEN + REWRITE_TAC[CONTINUOUS_AT_CEXP; o_DEF] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[GSYM sums] THEN + MATCH_MP_TAC SERIES_NEG THEN ASM_SIMP_TAC[LOGZETA_CONVERGES]; + SIMP_TAC[CEXP_VSUM; FINITE_INTER_NUMSEG] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\n. cproduct {p | prime p /\ p <= n} + (\p. inv(Cx(&1) - inv(Cx(&p) cpow s)))` THEN + ASM_SIMP_TAC[EULER_PRODUCT] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[VECTOR_SUB_EQ; numseg; LE_0] THEN + REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {x | P x /\ Q x}`] THEN + MATCH_MP_TAC CPRODUCT_EQ THEN X_GEN_TAC `p:num` THEN + REWRITE_TAC[IN_ELIM_THM; CEXP_NEG] THEN STRIP_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CEXP_CLOG THEN + REWRITE_TAC[COMPLEX_SUB_0] THEN + DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; REAL_OF_NUM_LT; RE_CX; REAL_ABS_NUM; + COMPLEX_NORM_INV; PRIME_IMP_NZ; LT_NZ; COMPLEX_NORM_CX; REAL_EXP_EQ_1] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + REWRITE_TAC[GSYM REAL_EXP_0; GSYM REAL_EXP_NEG; REAL_EXP_INJ] THEN + REWRITE_TAC[REAL_NEG_EQ_0; REAL_ENTIRE] THEN + ASM_SIMP_TAC[REAL_ARITH `&1 < s ==> ~(s = &0)`] THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC]);; + +let HAS_COMPLEX_DERIVATIVE_ZETA = prove + (`!s. &1 < Re s ==> (zeta has_complex_derivative + (--(logzeta'(s)) * zeta(s))) (at s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + EXISTS_TAC `\s. cexp(--(logzeta s))` THEN EXISTS_TAC `Re s - &1` THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CEXP_LOGZETA THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_BALL_RE) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN + ASM_SIMP_TAC[GSYM CEXP_LOGZETA; HAS_COMPLEX_DERIVATIVE_CEXP] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_NEG THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_LOGZETA]);; + +let COMPLEX_DERIVATIVE_ZETA = prove + (`!s. &1 < Re s + ==> complex_derivative zeta s = --(logzeta'(s)) * zeta(s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_ZETA]);; + +let CONVERGES_LOGZETA'' = prove + (`!s. &1 < Re s + ==> ((\p. Cx(log(&p)) / (Cx(&p) cpow s - Cx(&1))) sums + (--(complex_derivative zeta s / zeta s))) {p | prime p}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `--(complex_derivative zeta s / zeta s) = logzeta'(s)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[ZETA_NONZERO_LEMMA; COMPLEX_DERIVATIVE_ZETA; COMPLEX_FIELD + `~(b = Cx(&0)) ==> (--(a / b) = c <=> a = --c * b)`]; + MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\p. clog(Cx(&p)) / (Cx(&p) cpow s - Cx(&1))` THEN + ASM_SIMP_TAC[LOGZETA'_CONVERGES; IN_ELIM_THM] THEN + SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ]]);; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas about negating a path. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_NEGATEPATH = prove + (`!g. valid_path g ==> valid_path ((--) o g)`, + REWRITE_TAC[valid_path; o_DEF] THEN + ASM_SIMP_TAC[PIECEWISE_DIFFERENTIABLE_NEG]);; + +let PATHSTART_NEGATEPATH = prove + (`!g. pathstart((--) o g) = --(pathstart g)`, + REWRITE_TAC[pathstart; o_THM]);; + +let PATHFINISH_NEGATEPATH = prove + (`!g. pathfinish((--) o g) = --(pathfinish g)`, + REWRITE_TAC[pathfinish; o_THM]);; + +let PATH_IMAGE_NEGATEPATH = prove + (`!g. path_image((--) o g) = IMAGE (--) (path_image g)`, + REWRITE_TAC[path_image; IMAGE_o]);; + +let HAS_PATH_INTEGRAL_NEGATEPATH = prove + (`!g z. valid_path g /\ ((\z. f(--z)) has_path_integral (--i)) g + ==> (f has_path_integral i) ((--) o g)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[has_path_integral] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN + REWRITE_TAC[VECTOR_NEG_NEG] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN FIRST_ASSUM MP_TAC THEN + REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NEGLIGIBLE_FINITE] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN + REWRITE_TAC[IN_DIFF] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN REWRITE_TAC[o_DEF; GSYM COMPLEX_MUL_RNEG] THEN + AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_NEG THEN + ASM_SIMP_TAC[GSYM VECTOR_DERIVATIVE_WORKS; DIFFERENTIABLE_AT_WITHIN]);; + +let WINDING_NUMBER_NEGATEPATH = prove + (`!g z. valid_path g /\ ~(Cx(&0) IN path_image g) + ==> winding_number((--) o g,Cx(&0)) = winding_number(g,Cx(&0))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; VALID_PATH_NEGATEPATH; + PATH_IMAGE_NEGATEPATH; IN_IMAGE; UNWIND_THM2; + COMPLEX_RING `Cx(&0) = --x <=> x = Cx(&0)`] THEN + AP_TERM_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_NEGATEPATH THEN + ASM_REWRITE_TAC[COMPLEX_RING `--z - Cx(&0) = --(z - Cx(&0))`] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_NEG; COMPLEX_MUL_RNEG] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_NEG THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + ASM_SIMP_TAC[GSYM complex_div; PATH_INTEGRABLE_INVERSEDIFF]);; + +let PATH_INTEGRABLE_NEGATEPATH = prove + (`!g z. valid_path g /\ (\z. f(--z)) path_integrable_on g + ==> f path_integrable_on ((--) o g)`, + REWRITE_TAC[path_integrable_on] THEN + MESON_TAC[HAS_PATH_INTEGRAL_NEGATEPATH; COMPLEX_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Some bounding lemmas given by Newman. BOUND_LEMMA_2 is my variant since I *) +(* use a slightly different contour. *) +(* ------------------------------------------------------------------------- *) + +let BOUND_LEMMA_0 = prove + (`!z R. norm(z) = R + ==> Cx(&1) / z + z / Cx(R) pow 2 = Cx(&2 * Re z / R pow 2)`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN + REWRITE_TAC[GSYM complex_div] THEN ASM_REWRITE_TAC[COMPLEX_INV_CNJ] THEN + ASM_REWRITE_TAC[complex_div; GSYM COMPLEX_ADD_RDISTRIB] THEN + REWRITE_TAC[COMPLEX_ADD_CNJ; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_INV; COMPLEX_NORM_POW] THEN + REWRITE_TAC[CX_MUL; CX_DIV; CX_POW; complex_div; GSYM COMPLEX_MUL_ASSOC]);; + +let BOUND_LEMMA_1 = prove + (`!z R. norm(z) = R + ==> norm(Cx(&1) / z + z / Cx(R) pow 2) = &2 * abs(Re z) / R pow 2`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BOUND_LEMMA_0; COMPLEX_NORM_CX] THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NUM] THEN + ASM_MESON_TAC[NORM_ARITH `norm z = R ==> abs R = R`]);; + +let BOUND_LEMMA_2 = prove + (`!R x z. Re(z) = --x /\ abs(Im(z)) = R /\ &0 <= x /\ &0 < R + ==> norm (Cx (&1) / z + z / Cx R pow 2) <= &2 * x / R pow 2`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[NORM_LE_SQUARE; COMPLEX_SQNORM; DOT_SQUARE_NORM] THEN + REWRITE_TAC[REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV; REAL_LT_IMP_LE; REAL_POW_LT] THEN + REWRITE_TAC[complex_div] THEN + SUBST1_TAC(SPEC `z:complex` COMPLEX_INV_CNJ) THEN + ASM_SIMP_TAC[cnj; RE; IM; COMPLEX_MUL_LID; REAL_LE_MUL; REAL_POS] THEN + REWRITE_TAC[GSYM CX_POW; COMPLEX_SQNORM; RE; IM] THEN + ASM_REWRITE_TAC[REAL_RING `(--x:real) pow 2 = x pow 2`] THEN + REWRITE_TAC[GSYM CX_INV; complex_div] THEN + REWRITE_TAC[complex_mul; complex_add; RE; IM; RE_CX; IM_CX; + REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ADD_LID] THEN + ASM_REWRITE_TAC[REAL_RING `(--x:real) pow 2 = x pow 2`; + REAL_RING `(--x * a + --x * b:real) pow 2 = x pow 2 * (a + b) pow 2`; + REAL_RING `(--R * a + R * b:real) pow 2 = R pow 2 * (b - a) pow 2`] THEN + SUBGOAL_THEN `&0 < x pow 2 + R pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 < y ==> &0 < x + y`) THEN + ASM_SIMP_TAC[REAL_POW_LT] THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]; + ALL_TAC] THEN + SUBGOAL_THEN `Im z pow 2 = R pow 2` SUBST1_TAC THENL + [ASM_MESON_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_FIELD + `&0 < R pow 2 /\ &0 < x pow 2 + R pow 2 + ==> x pow 2 * (inv (x pow 2 + R pow 2) + inv (R pow 2)) pow 2 + + R pow 2 * (inv (R pow 2) - inv (x pow 2 + R pow 2)) pow 2 = + (x pow 4 + &5 * R pow 2 * x pow 2 + &4 * R pow 4) / + (x pow 2 + R pow 2) pow 2 * + (x pow 2 / R pow 4)`] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_FIELD + `&0 < R pow 2 ==> (&2 * x / R pow 2) pow 2 = &4 * x pow 2 / R pow 4`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + CONV_TAC(RAND_CONV REAL_POLY_CONV) THEN + REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_SIMP_TAC[REAL_POS; REAL_POW_LE; REAL_LT_IMP_LE]);; + +let BOUND_LEMMA_3 = prove + (`!a n. (!m. 1 <= m ==> norm(a(m)) <= &1) /\ + 1 <= n /\ &1 <= Re w /\ &0 < Re z + ==> norm(vsum(1..n) (\n. a(n) / Cx(&n) cpow (w - z))) + <= exp(Re(z) * log(&n)) * (&1 / &n + &1 / Re(z))`, + let lemma1 = prove + (`!n x. + &1 <= x + ==> sum(1..n) (\n. exp((x - &1) * log(&n))) <= + exp(x * log(&n + &1)) / x`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL + [ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUM_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + UNDISCH_TAC `&1 <= x` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n. n cpow (Cx(x) - Cx(&1))`; + `\n. n cpow (Cx(x)) / (Cx(x))`; + `1`; `n:num`] + SUM_INTEGRAL_UBOUND_INCREASING) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + CONJ_TAC THENL + [SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN + REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(Cx x = Cx(&0))` MP_TAC THENL + [REWRITE_TAC[CX_INJ] THEN UNDISCH_TAC `&1 <= x` THEN REAL_ARITH_TAC; + CONV_TAC COMPLEX_FIELD]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&1 <= b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_SUB; CPOW_REAL_REAL; REAL_CX; RE_CX; + REAL_ARITH `&1 <= x ==> &0 < x`] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = y /\ u <= v ==> x <= u ==> y <= v`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REWRITE_TAC[GSYM CX_SUB]; + ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + ARITH_RULE `0 < n <=> 1 <= n`; + REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[CPOW_1] THEN + REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x - y <= x`) THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN + UNDISCH_TAC `&1 <= x` THEN REAL_ARITH_TAC) + and lemma1' = prove + (`!n x. + &0 < x /\ x <= &1 + ==> sum(1..n) (\n. exp((x - &1) * log(&n))) <= + exp(x * log(&n)) / x`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL + [ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUM_CLAUSES] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_EXP_POS_LE; REAL_LT_IMP_LE]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT] THEN + REWRITE_TAC[LOG_1; REAL_MUL_RZERO; REAL_EXP_0; ARITH] THEN + ASM_CASES_TAC `2 <= n` THENL + [ALL_TAC; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN + SIMP_TAC[GSYM NUMSEG_EMPTY; SUM_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `n = 1` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[LOG_1; REAL_MUL_RZERO; REAL_EXP_0; real_div; REAL_MUL_LID; + REAL_ADD_RID; REAL_INV_1_LE]] THEN + MP_TAC(ISPECL + [`\n. n cpow (Cx(x) - Cx(&1))`; + `\n. n cpow (Cx(x)) / (Cx(x))`; + `2`; `n:num`] + SUM_INTEGRAL_UBOUND_DECREASING) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL + [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + CONJ_TAC THENL + [SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN + REWRITE_TAC[RE_CX] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(Cx x = Cx(&0))` MP_TAC THENL + [REWRITE_TAC[CX_INJ] THEN UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC; + CONV_TAC COMPLEX_FIELD]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&1 <= b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_SUB; CPOW_REAL_REAL; REAL_CX; RE_CX; + REAL_ARITH `&1 <= x ==> &0 < x`] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - x) * a <= (&1 - x) * b ==> (x - &1) * b <= (x - &1) * a`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x = y /\ &1 + u <= v ==> x <= u ==> &1 + y <= v`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[CPOW_1] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REWRITE_TAC[GSYM CX_SUB]; + ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + ARITH_RULE `2 <= i ==> 0 < i`] THEN + REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> &1 + a - x <= a`) THEN + ASM_SIMP_TAC[REAL_INV_1_LE; real_div; REAL_MUL_LID]) in + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..n) (\n. exp((Re(z) - &1) * log(&n)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CPOW_REAL; REAL_CX; + RE_CX; REAL_OF_NUM_LT; ARITH_RULE `0 < k <=> 1 <= k`] THEN + REWRITE_TAC[real_div; GSYM REAL_EXP_NEG] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_EXP_POS_LE; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; GSYM RE_NEG; COMPLEX_NEG_SUB] THEN + REWRITE_TAC[RE_SUB] THEN UNDISCH_TAC `&1 <= Re w` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `x = Re z` THEN + DISJ_CASES_TAC(ARITH_RULE `x <= &1 \/ &1 <= x`) THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `exp(x * log(&n)) / x` THEN + ASM_SIMP_TAC[lemma1'] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `x <= a + x <=> &0 <= a`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_EXP_POS_LE; REAL_LE_INV_EQ; REAL_POS]; + ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_1] THEN + MATCH_MP_TAC(REAL_ARITH + `b <= x * a /\ c <= x * d ==> c + b <= x * (a + d)`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID] THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; EXP_LOG; REAL_OF_NUM_LT; + ARITH_RULE `0 < n <=> 1 <= n`; REAL_LE_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `exp(x * log(&(n - 1) + &1)) / x` THEN CONJ_TAC THEN + ASM_SIMP_TAC[lemma1] THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= n ==> n - 1 + 1 = n`] THEN + REWRITE_TAC[REAL_LE_REFL; real_div; REAL_MUL_LID]]);; + +let BOUND_LEMMA_4 = prove + (`!a n m. (!m. 1 <= m ==> norm(a(m)) <= &1) /\ + 1 <= n /\ &1 <= Re w /\ &0 < Re z + ==> norm(vsum(n+1..m) (\n. a(n) / Cx(&n) cpow (w + z))) + <= &1 / (Re z * exp(Re z * log(&n)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(n+1..m) (\n. &1 / exp((Re(z) + &1) * log(&n)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `0 < r /\ 1 <= r` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CPOW_REAL; REAL_CX; + RE_CX; REAL_OF_NUM_LT] THEN + REWRITE_TAC[real_div; GSYM REAL_EXP_NEG] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_EXP_POS_LE; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; RE_NEG; COMPLEX_NEG_SUB] THEN + REWRITE_TAC[RE_ADD; REAL_LE_NEG2] THEN + UNDISCH_TAC `&1 <= Re w` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `x = Re z` THEN + ASM_CASES_TAC `n + 1 <= m` THENL + [ALL_TAC; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN + SIMP_TAC[GSYM NUMSEG_EMPTY; SUM_CLAUSES] THEN DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_LE_MUL; + REAL_EXP_POS_LE; REAL_LT_IMP_LE]] THEN + MP_TAC(ISPECL + [`\n. n cpow (--(Cx(x) + Cx(&1)))`; + `\n. --(n cpow (--(Cx(x)))) / Cx(x)`; + `n + 1`; `m:num`] + SUM_INTEGRAL_UBOUND_DECREASING) THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN + ANTS_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL + [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + CONJ_TAC THENL + [SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN + REWRITE_TAC[RE_CX] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_RING `--x - Cx(&1) = --(x + Cx(&1))`] THEN + SUBGOAL_THEN `~(Cx x = Cx(&0))` MP_TAC THENL + [REWRITE_TAC[CX_INJ] THEN UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC; + CONV_TAC COMPLEX_FIELD]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < a /\ &0 < b` STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN + MATCH_MP_TAC(REAL_ARITH `x * a <= x * b ==> --x * b <= --x * a`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC LOG_MONO_LE_IMP] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x = y /\ u <= v ==> x <= u ==> y <= v`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG] THEN + SUBGOAL_THEN `&0 < &k` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_EXP_NEG] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[CPOW_NEG] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `n + 1 <= m ==> 0 < m`)) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `1 <= n ==> 0 < n`)) THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX; REAL_OF_NUM_LT] THEN + REWRITE_TAC[GSYM CX_INV; GSYM CX_SUB; RE_CX; GSYM CX_DIV; GSYM CX_NEG] THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG; REAL_SUB_NEG2; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `x = z /\ &0 <= y ==> x - y <= z`) THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_EXP_POS_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Our overall bound does go to zero as N increases. *) +(* ------------------------------------------------------------------------- *) + +let OVERALL_BOUND_LEMMA = prove + (`!d M R. &0 < d + ==> !e. &0 < e + ==> ?N. !n. N <= n + ==> abs(&2 * pi / &n + + &6 * M * R / (d * exp (d * log (&n))) + + &4 * M / (R * log (&n)) pow 2) < e`, + ONCE_REWRITE_TAC[REAL_ARITH `abs x = abs(x - &0)`] THEN + REWRITE_TAC[GSYM REALLIM_SEQUENTIALLY] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_INV_MUL] THEN + REPEAT(MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC) THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_INV] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N] THENL + [MP_TAC(SPEC `Cx d` LIM_1_OVER_POWER) THEN ASM_REWRITE_TAC[RE_CX] THEN + REWRITE_TAC[REALLIM_COMPLEX; o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX; REAL_OF_NUM_LT; CX_INV; LE_1; + complex_div; COMPLEX_MUL_LID]; + MATCH_MP_TAC REALLIM_NULL_POW THEN REWRITE_TAC[REAL_INV_MUL; ARITH] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_LOG]]);; + +(* ------------------------------------------------------------------------- *) +(* Newman/Ingham analytic lemma (as in Newman's book). *) +(* ------------------------------------------------------------------------- *) + +let NEWMAN_INGHAM_THEOREM = prove + (`!f a. (!n. 1 <= n ==> norm(a(n)) <= &1) /\ + f analytic_on {z | Re(z) >= &1} /\ + (!z. Re(z) > &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)) + ==> !z. Re(z) >= &1 + ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)`, + REWRITE_TAC[real_ge; analytic_on; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `&1 <= w ==> w > &1 \/ w = &1`)) THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + ABBREV_TAC `R = max (&3 / e) (&1)` THEN + SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL + [EXPAND_TAC "R" THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `?d. &0 < d /\ d <= R /\ + (\z. f(w + z)) holomorphic_on {z | Re(z) >= --d /\ abs(Im z) <= R}` + (X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))) + THENL + [SUBGOAL_THEN + `?d. &0 < d /\ + (\z. f(w + z)) holomorphic_on {z | Re(z) >= --d /\ abs(Im z) <= R}` + (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) + THENL + [ALL_TAC; + EXISTS_TAC `min d R` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `{z | Re(z) >= --d /\ abs(Im z) <= R}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC] THEN + ABBREV_TAC `g = \z. (f:complex->complex) (w + z)` THEN + SUBGOAL_THEN + `!z. &0 <= Re z ==> ?e. &0 < e /\ g holomorphic_on ball (z,e)` + MP_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + UNDISCH_TAC + `!z. &1 <= Re z ==> (?e. &0 < e /\ f holomorphic_on ball (z,e))` THEN + DISCH_THEN(MP_TAC o SPEC `w + z:complex`) THEN + ASM_SIMP_TAC[RE_ADD;REAL_ARITH `&0 <= z ==> &1 <= &1 + z`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN + UNDISCH_TAC `f holomorphic_on ball(w + z,d)` THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_BALL; IN_IMAGE] THEN + REWRITE_TAC[COMPLEX_RING `x:complex = w + y <=> x - w = y`] THEN + REWRITE_TAC[UNWIND_THM1] THEN NORM_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `bs:complex->real`) THEN + MP_TAC(ISPECL [`complex(&0,--R)`; `complex(&0,R)`] COMPACT_INTERVAL) THEN + REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\z. {w | abs(Re(z - w)) < bs z / &2 /\ abs(Im(z - w)) < bs z / &2}) + (interval[complex(&0,--R),complex(&0,R)])`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[RE_SUB; IM_SUB; REAL_ARITH + `abs(x - a) < e /\ abs(y - b) < e <=> + a < x + e /\ a > x - e /\ b < y + e /\ b > y - e`] THEN + SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + REPEAT(MATCH_MP_TAC OPEN_INTER THEN STRIP_TAC) THEN + REWRITE_TAC[OPEN_HALFSPACE_IM_GT; OPEN_HALFSPACE_IM_LT; + OPEN_HALFSPACE_RE_GT; OPEN_HALFSPACE_RE_LT]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> x IN g x) ==> s SUBSET (UNIONS (IMAGE g s))`) THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN + ASM_MESON_TAC[REAL_HALF]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> c /\ b /\ a`] THEN + REWRITE_TAC[FINITE_SUBSET_IMAGE; RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> d /\ a /\ b /\ c`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inf (IMAGE (bs:complex->real) t) / &2` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `s SUBSET UNIONS (IMAGE g t) ==> ~(s = {}) ==> ~(t = {})`)) THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `complex(&0,&0)` THEN + REWRITE_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN + UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC; + DISCH_TAC] THEN + REWRITE_TAC[REAL_HALF] THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `t SUBSET s ==> (!x. x IN s ==> P x) ==> (!x. x IN t ==> P x)`)) THEN + REWRITE_TAC[IN_INTERVAL; FORALL_2; GSYM RE_DEF; DIMINDEX_2] THEN + REWRITE_TAC[RE] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN X_GEN_TAC `z:complex` THEN + REWRITE_TAC[IN_ELIM_THM; real_ge] THEN STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN + ASM_CASES_TAC `&0 <= Re z` THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable; OPEN_BALL; + CENTRE_IN_BALL]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `complex(&0,Im z)` o MATCH_MP (SET_RULE + `i SUBSET UNIONS s ==> !x. x IN i ==> x IN UNIONS s`)) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN + UNDISCH_TAC `abs(Im z) <= R` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `v:complex` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `Re v = &0` ASSUME_TAC THENL + [UNDISCH_TAC `(v:complex) IN t` THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `t SUBSET s ==> (x IN s ==> P x) ==> (x IN t ==> P x)`)) THEN + REWRITE_TAC[IN_INTERVAL; FORALL_2; GSYM RE_DEF; DIMINDEX_2] THEN + REWRITE_TAC[RE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; RE_SUB; IM_SUB; RE; IM] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN + UNDISCH_TAC + `!z. &0 <= Re z ==> &0 < bs z /\ g holomorphic_on ball (z,bs z)` THEN + DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; GSYM complex_differentiable] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_BALL] THEN + REWRITE_TAC[dist; complex_norm] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x < abs e ==> x < e`) THEN + ASM_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN + MATCH_MP_TAC SQRT_MONO_LT THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < b * b /\ x <= (b / &2) pow 2 /\ y <= (b / &2) pow 2 + ==> x + y < b pow 2`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_LE_SQUARE_ABS] THEN + ASM_SIMP_TAC[IM_SUB; REAL_ARITH `&0 < b ==> abs(b / &2) = b / &2`] THEN + ASM_SIMP_TAC[RE_SUB; REAL_LT_IMP_LE] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `--(x / &2) <= z ==> &2 * --z <= x`)) THEN + ASM_SIMP_TAC[REAL_LE_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(&0 <= Re z)` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?M. &0 < M /\ + !z. Re z >= --d /\ abs (Im z) <= R /\ Re(z) <= R + ==> norm(f(w + z):complex) <= M` + (X_CHOOSE_THEN `M:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2a"))) THENL + [MP_TAC(ISPEC `IMAGE (\z. f (w + z):complex) + {z | Re z >= --d /\ abs (Im z) <= R /\ Re(z) <= R}` + COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + CONTINUOUS_ON_SUBSET) THEN + SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(Cx(&0),&2 * R + d)` THEN + REWRITE_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL; dist] THEN + REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; IN_ELIM_THM] THEN + MP_TAC COMPLEX_NORM_LE_RE_IM THEN MATCH_MP_TAC MONO_FORALL THEN + UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_ARITH `x <= Im z <=> Im z >= x`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + REPEAT(MATCH_MP_TAC CLOSED_INTER THEN CONJ_TAC) THEN + REWRITE_TAC[CLOSED_HALFSPACE_RE_LE; CLOSED_HALFSPACE_IM_LE; + CLOSED_HALFSPACE_RE_GE; CLOSED_HALFSPACE_IM_GE]; + ALL_TAC] THEN + MP_TAC(SPECL [`d:real`; `M:real`; `R:real`] OVERALL_BOUND_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `&2 / &3 * e * pi`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; PI_POS; REAL_ARITH `&0 < &2 / &3`] THEN + DISCH_THEN(X_CHOOSE_THEN `N0:num` (LABEL_TAC "X")) THEN + EXISTS_TAC `N0 + 2` THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + REMOVE_THEN "X" (MP_TAC o SPEC `N:num`) THEN + ASM_SIMP_TAC[ARITH_RULE `N0 + 2 <= N ==> N0 <= N`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `~(N = 0) /\ 1 < N` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[FROM_INTER_NUMSEG] THEN + ABBREV_TAC `S_N(w) = vsum(1..N) (\n. a(n) / Cx(&n) cpow w)` THEN + REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + ABBREV_TAC `r_N(w) = (f:complex->complex)(w) - S_N(w)` THEN + ABBREV_TAC `A = partcirclepath(Cx(&0),R,--(pi / &2),pi / &2)` THEN + SUBGOAL_THEN + `valid_path A /\ + pathstart A = complex(&0,--R) /\ + pathfinish A = complex(&0,R) /\ + &0 < Re(winding_number(A,Cx(&0)))` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "A" THEN REWRITE_TAC[VALID_PATH_PARTCIRCLEPATH] THEN + REWRITE_TAC[PATHSTART_PARTCIRCLEPATH; PATHFINISH_PARTCIRCLEPATH] THEN + REWRITE_TAC[CEXP_EULER; SIN_NEG; COS_NEG; SIN_PI2; COS_PI2; + GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_EQ; RE_MUL_CX; RE_II; IM_II; IM_MUL_CX; RE; IM] THEN + REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC WINDING_NUMBER_PARTCIRCLEPATH_POS_LT THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_REFL] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `path_image A SUBSET {z | Re(z) >= &0 /\ norm(z) = R}` + ASSUME_TAC THENL + [EXPAND_TAC "A" THEN + ASM_SIMP_TAC[PATH_IMAGE_PARTCIRCLEPATH; REAL_LT_IMP_LE; PI_POS; + REAL_ARITH `--p < p <=> &0 < p`; REAL_HALF] THEN + REWRITE_TAC[SUBSET; COMPLEX_ADD_LID; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[RE_MUL_CX; RE_CEXP] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; COMPLEX_NORM_CX; RE_MUL_II] THEN + REWRITE_TAC[IM_CX; REAL_NEG_0; REAL_EXP_0; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`; real_ge] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_SIMP_TAC[COS_POS_PI_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `~(Cx(&0) IN path_image A)` ASSUME_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`)) THEN + REWRITE_TAC[IN_ELIM_THM; COMPLEX_NORM_0] THEN + UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `B = linepath(complex(&0,R),complex(--d,R)) ++ + linepath(complex(--d,R),complex(--d,--R)) ++ + linepath(complex(--d,--R),complex(&0,--R))` THEN + SUBGOAL_THEN + `valid_path B /\ + ~(Cx(&0) IN path_image B) /\ + &0 < Re(winding_number(B,Cx(&0)))` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "B" THEN + REPEAT(MATCH_MP_TAC WINDING_NUMBER_JOIN_POS_COMBINED THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + CONJ_TAC) THEN + (REWRITE_TAC[VALID_PATH_LINEPATH] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC WINDING_NUMBER_LINEPATH_POS_LT THEN + REWRITE_TAC[complex_mul; RE; IM; RE_SUB; RE_CNJ; IM_SUB; IM_CNJ; + RE_CX; IM_CX] THEN + CONV_TAC(RAND_CONV REAL_POLY_CONV) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH]]) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; segment; IN_ELIM_THM] THEN + REWRITE_TAC[COMPLEX_EQ; RE_CMUL; RE_ADD; RE_CX; RE; + IM_CMUL; IM_ADD; IM_CX; IM] THEN + REWRITE_TAC[REAL_ARITH `&0 = (&1 - u) * x + u * x <=> x = &0`] THEN + ASM_SIMP_TAC[REAL_NEG_EQ_0; REAL_LT_IMP_NZ]; + ALL_TAC] THEN + SUBGOAL_THEN + `pathstart B = complex(&0,R) /\ + pathfinish B = complex(&0,--R)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "B" THEN + SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH]; + ALL_TAC] THEN + SUBGOAL_THEN + `path_image B SUBSET {z | --d <= Re z /\ Re(z) <= &0 /\ abs(Im z) <= R}` + ASSUME_TAC THENL + [SUBGOAL_THEN + `convex {z | --d <= Re z /\ Re z <= &0 /\ abs (Im z) <= R}` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_BOUNDS_LE; + SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + REPEAT(MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC) THEN + REWRITE_TAC[REWRITE_RULE[real_ge] CONVEX_HALFSPACE_RE_GE; + REWRITE_RULE[real_ge] CONVEX_HALFSPACE_IM_GE; + CONVEX_HALFSPACE_RE_LE; CONVEX_HALFSPACE_IM_LE]; + ALL_TAC] THEN + EXPAND_TAC "B" THEN + REPEAT(MATCH_MP_TAC(SET_RULE + `path_image(p1 ++ p2) SUBSET path_image p1 UNION path_image p2 /\ + path_image p1 SUBSET s /\ path_image p2 SUBSET s + ==> path_image(p1 ++ p2) SUBSET s`) THEN + REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN CONJ_TAC) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[RE; IM] THEN + MAP_EVERY UNDISCH_TAC [`&0 < d`; `&0 < R`] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `valid_path(A ++ B) /\ + pathstart(A ++ B) = complex(&0,--R) /\ + pathfinish(A ++ B) = complex(&0,--R) /\ + ~(Cx(&0) IN path_image(A ++ B))` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + PATH_IMAGE_JOIN; IN_UNION; VALID_PATH_IMP_PATH]; + ALL_TAC] THEN + SUBGOAL_THEN `winding_number(A++B,Cx(&0)) = Cx(&1)` ASSUME_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_EQ_1 THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH; PATH_IMAGE_JOIN; IN_UNION; + WINDING_NUMBER_JOIN; REAL_LT_ADD; RE_ADD] THEN + MATCH_MP_TAC(REAL_ARITH `x < &1 /\ y < &1 ==> x + y < &2`) THEN + CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_1 THENL + [EXISTS_TAC `--Cx(&1)`; EXISTS_TAC `Cx(&1)`] THEN + ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC]) THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`)) THEN + REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_SUB_RZERO; IN_ELIM_THM] THEN + REWRITE_TAC[COMPLEX_MUL_RNEG; GSYM CX_MUL; RE_CX; IM_CX; RE_NEG] THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx(R) pow 2)) + has_path_integral (Cx(&2) * Cx pi * ii * f(w))) (A ++ B)` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) + z pow 2 / Cx(R) pow 2)`; + `{z | Re(z) >= --d /\ abs(Im z) <= R}`; + `A ++ B:real^1->complex`; + `Cx(&0)`] + CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_LID; CPOW_N] THEN + ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN + REWRITE_TAC[COMPLEX_RING `Cx(&1) + Cx(&0) pow 2 * z = Cx(&1)`] THEN + REWRITE_TAC[COMPLEX_MUL_RID] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `~(z = Cx(&0))` THEN REWRITE_TAC[] THEN + ABBREV_TAC `wever = inv(Cx R pow 2)` THEN CONV_TAC COMPLEX_FIELD] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `abs(x) <= a <=> x >= --a /\ x <= a`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + MATCH_MP_TAC CONVEX_INTER THEN REWRITE_TAC[CONVEX_HALFSPACE_RE_GE] THEN + MATCH_MP_TAC CONVEX_INTER THEN + REWRITE_TAC[CONVEX_HALFSPACE_IM_GE; CONVEX_HALFSPACE_IM_LE]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ADD] THEN + REWRITE_TAC[holomorphic_on] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + EXISTS_TAC `clog(Cx(&N)) * Cx(&N) cpow z` THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT THEN + ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `min d R:real` THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN + REWRITE_TAC[SUBSET; IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(n1) <= n /\ abs(n2) <= n + ==> n < min d R ==> n1 >= --d /\ abs n2 <= R`) THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM]; + ALL_TAC] THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; VALID_PATH_IMP_PATH; UNION_SUBSET] THEN + CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `~(x IN s) /\ s SUBSET t ==> s SUBSET (t DELETE x)`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THENL [ALL_TAC; REAL_ARITH_TAC] THEN + MP_TAC COMPLEX_NORM_GE_RE_IM THEN MATCH_MP_TAC MONO_FORALL THEN + UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE) THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_JOIN; IMP_CONJ] THEN + REWRITE_TAC[path_integrable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `integral_fA:complex` (LABEL_TAC "fA")) THEN + DISCH_THEN(X_CHOOSE_THEN `integral_fB:complex` (LABEL_TAC "fB")) THEN + SUBGOAL_THEN `integral_fA + integral_fB = Cx(&2) * Cx pi * ii * f(w:complex)` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC + [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; + `A ++ B:real^1->complex`] THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_JOIN]; + ALL_TAC] THEN + ABBREV_TAC `A' = (--) o (A:real^1->complex)` THEN + SUBGOAL_THEN + `valid_path A' /\ + pathstart A' = complex(&0,R) /\ + pathfinish A' = complex(&0,--R) /\ + ~(Cx(&0) IN path_image A') /\ + &0 < Re(winding_number(A',Cx(&0)))` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "A'" THEN + ASM_SIMP_TAC[VALID_PATH_NEGATEPATH; PATHSTART_NEGATEPATH; + PATHFINISH_NEGATEPATH; WINDING_NUMBER_NEGATEPATH; + PATH_IMAGE_NEGATEPATH] THEN + REWRITE_TAC[IN_IMAGE; COMPLEX_RING `Cx(&0) = --x <=> x = Cx(&0)`] THEN + ASM_REWRITE_TAC[UNWIND_THM2] THEN + SIMP_TAC[COMPLEX_EQ; RE_NEG; IM_NEG; RE; IM; REAL_NEG_0; REAL_NEGNEG]; + ALL_TAC] THEN + SUBGOAL_THEN + `valid_path(A ++ A') /\ + pathstart(A ++ A') = complex(&0,--R) /\ + pathfinish(A ++ A') = complex(&0,--R) /\ + ~(Cx(&0) IN path_image(A ++ A')) /\ + path_image(A ++ A') = path_image A UNION path_image A'` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; IN_UNION; + PATH_IMAGE_JOIN; VALID_PATH_IMP_PATH]; + ALL_TAC] THEN + SUBGOAL_THEN `path_image A' SUBSET {z | Re z <= &0 /\ norm z = R}` + ASSUME_TAC THENL + [EXPAND_TAC "A'" THEN REWRITE_TAC[path_image; IMAGE_o; SUBSET] THEN + ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[GSYM path_image] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> (!x. x IN t ==> P x) ==> (!x. x IN s ==> P x)`)) THEN + REWRITE_TAC[IN_ELIM_THM; RE_NEG; NORM_NEG] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `winding_number(A++A',Cx(&0)) = Cx(&1)` ASSUME_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_EQ_1 THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH; IN_UNION; + VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + WINDING_NUMBER_JOIN; REAL_LT_ADD; RE_ADD] THEN + MATCH_MP_TAC(REAL_ARITH `x < &1 /\ y < &1 ==> x + y < &2`) THEN + CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_1 THENL + [EXISTS_TAC `--Cx(&1)`; EXISTS_TAC `Cx(&1)`] THEN + ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC]) THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`)) THEN + REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_SUB_RZERO; IN_ELIM_THM] THEN + REWRITE_TAC[COMPLEX_MUL_RNEG; GSYM CX_MUL; RE_CX; IM_CX; RE_NEG] THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\z. S_N (w + z) * Cx (&N) cpow z * (Cx (&1) + z pow 2 * inv (Cx R pow 2))) + holomorphic_on (:complex)` + ASSUME_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM(ASSUME + `!w. vsum (1..N) (\n. a n / Cx (&n) cpow w) = S_N w`)] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_VSUM THEN + REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_DIV; + MATCH_MP_TAC HOLOMORPHIC_ON_MUL] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_CPOW_RIGHT; HOLOMORPHIC_ON_ID; CPOW_EQ_0; + HOLOMORPHIC_ON_CONST; REAL_OF_NUM_EQ; HOLOMORPHIC_ON_MUL; + ARITH_RULE `~(n = 0) <=> 1 <= n`; + HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_POW; CX_INJ]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\z. S_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx(R) pow 2)) + has_path_integral (Cx(&2) * Cx pi * ii * S_N(w))) (A ++ A')` + MP_TAC THENL + [MP_TAC(ISPECL + [`\z. S_N(w + z) * Cx(&N) cpow z * (Cx(&1) + z pow 2 / Cx(R) pow 2)`; + `cball(Cx(&0),R)`; + `A ++ A':real^1->complex`; + `Cx(&0)`] + CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN + ASM_REWRITE_TAC[CONVEX_CBALL; INTERIOR_CBALL; CENTRE_IN_BALL] THEN + ASM_REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_LID; CPOW_N] THEN + ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN + REWRITE_TAC[COMPLEX_RING `Cx(&1) + Cx(&0) pow 2 * z = Cx(&1)`] THEN + REWRITE_TAC[COMPLEX_MUL_RID] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `z = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `~(z = Cx(&0))` THEN REWRITE_TAC[] THEN + ABBREV_TAC `wever = inv(Cx R pow 2)` THEN CONV_TAC COMPLEX_FIELD] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN + ASM_REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `~(x IN s) /\ s SUBSET t ==> s SUBSET (t DELETE x)`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL; dist; COMPLEX_SUB_LZERO; + NORM_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE) THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_JOIN; IMP_CONJ] THEN + REWRITE_TAC[path_integrable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `integral_sA:complex` (LABEL_TAC "sA")) THEN + DISCH_THEN(X_CHOOSE_THEN `integral_sA':complex` (LABEL_TAC "sA'")) THEN + SUBGOAL_THEN + `integral_sA + integral_sA' = Cx(&2) * Cx pi * ii * S_N(w:complex)` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC + [`\z. S_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; + `A ++ A':real^1->complex`] THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_JOIN]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\z. S_N(w - z) * Cx (&N) cpow (--z) * (Cx (&1) / z + z / Cx R pow 2)) + has_path_integral integral_sA') A` + (LABEL_TAC "s'A") THENL + [SUBGOAL_THEN `(A:real^1->complex) = (--) o (--) o A` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_DEF; COMPLEX_NEG_NEG]; ALL_TAC] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_NEGATEPATH THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) + [GSYM COMPLEX_NEG_NEG] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_NEG THEN + REMOVE_THEN "sA'" MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; COMPLEX_SUB_RNEG; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_NEG; COMPLEX_MUL_LID] THEN + REWRITE_TAC[GSYM COMPLEX_NEG_ADD; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[COMPLEX_NEG_NEG]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\z. r_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx(R) pow 2)) + path_integrable_on A` + MP_TAC THENL + [REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN + REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN + MATCH_MP_TAC PATH_INTEGRABLE_SUB THEN + REWRITE_TAC[path_integrable_on] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `integral_rA:complex` THEN DISCH_THEN(LABEL_TAC "rA") THEN + SUBGOAL_THEN `integral_fA - integral_sA:complex = integral_rA` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN MAP_EVERY EXISTS_TAC + [`\z. r_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; + `A:real^1->complex`] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN + REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `r_N(w:complex) = ((integral_rA - integral_sA') + integral_fB) / + (Cx(&2) * Cx(pi) * ii)` + SUBST1_TAC THENL + [SIMP_TAC[COMPLEX_FIELD `~(z = Cx(&0)) ==> (x = y / z <=> z * x = y)`; + CX_2PII_NZ] THEN + REWRITE_TAC[GSYM(ASSUME `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB; GSYM COMPLEX_MUL_ASSOC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_eq o concl))) THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; + COMPLEX_NORM_II; REAL_MUL_RID; REAL_ABS_PI; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; PI_POS; REAL_ARITH `&0 < &2 * p <=> &0 < p`] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&4 * pi / R + &2 * pi / &N + + &6 * M * R / (d * exp(d * log(&N))) + + &4 * M / (R * log(&N)) pow 2` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH + `&4 * pi / R <= &4 * pi * (e / &3) /\ + y < &2 / &3 * e * pi + ==> &4 * pi / R + y < e * &2 * pi`) THEN + ASM_SIMP_TAC[REAL_ARITH `abs x < e ==> x < e`] THEN + SIMP_TAC[real_div; REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + REWRITE_TAC[GSYM real_div] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + EXPAND_TAC "R" THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x) <= &2 * a /\ norm(y) <= &2 * a + b /\ norm(z) <= c + ==> norm(x - y + z) <= &4 * a + b + c`) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL + [`\z. r_N(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; + `integral_rA:complex`; `Cx(&0)`; `R:real`; `--(pi / &2)`; `pi / &2`; + `&2 / R pow 2`; + `{complex(&0,R),complex(&0,--R)}`] + HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG) THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `p / &2 - --(p / &2) = p`; PI_POS_LE; + REAL_ARITH `--(p / &2) <= (p / &2) <=> &0 <= p`] THEN + ASM_SIMP_TAC[REAL_FIELD `~(r = &0) ==> &2 / r pow 2 * r * x = &2 * x / r`; + REAL_LT_IMP_NZ] THEN + DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `z:complex` THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN `norm(z) = R /\ &0 < Re z` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `path_image A SUBSET {z | Re z >= &0 /\ norm z = R}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; real_ge] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[REAL_LT_LE] THEN + REWRITE_TAC[NORM_EQ_SQUARE; DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN + ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[REAL_RING + `&0 pow 2 + x pow 2 = y pow 2 <=> x = y \/ x = --y`] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `~(z = complex(&0,--R))` THEN + UNDISCH_TAC `~(z = complex(&0,R))` THEN + ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 / (Re z * exp(Re z * log(&N))) * + exp(Re z * log(&N)) * (&2 * abs(Re z) / R pow 2)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[REAL_ARITH `&0 < z ==> abs z = z`] THEN + ASM_SIMP_TAC[REAL_EXP_NZ; REAL_LE_REFL; REAL_FIELD + `&0 < z /\ ~(e = &0) + ==> &1 / (z * e) * e * &2 * z / R pow 2 = &2 / R pow 2`]] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LE_REFL; NORM_CPOW_REAL; BOUND_LEMMA_1; + REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ]] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC + `\n. vsum(1..n) (\n. a n / Cx (&n) cpow (w + z)) - S_N(w + z)` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM(ASSUME + `!w. (f:complex->complex) w - S_N w = r_N w`)] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + MP_TAC(SPEC `w + z:complex` (ASSUME + `!z. Re z > &1 ==> ((\n. a n / Cx(&n) cpow z) sums f z) (from 1)`)) THEN + SIMP_TAC[RE_ADD; REAL_ARITH `&0 < z ==> &1 + z > &1`; + ASSUME `Re w = &1`; ASSUME `&0 < Re z`] THEN + REWRITE_TAC[sums; FROM_INTER_NUMSEG]; + ALL_TAC] THEN + EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM(ASSUME + `!w. vsum (1..N) (\n. a n / Cx (&n) cpow w) = S_N w`)] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum(N+1..n) (\n. a n / Cx(&n) cpow (w + z)))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC BOUND_LEMMA_4 THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= N <=> ~(N = 0)`]] THEN + MATCH_MP_TAC(NORM_ARITH `y + z = x ==> norm(x - y) <= norm(z)`) THEN + MP_TAC(SPECL [`1`; `N:num`; `n:num`] NUMSEG_COMBINE_R) THEN + ANTS_TAC THENL + [MAP_EVERY UNDISCH_TAC [`~(N = 0)`; `N + 1 <= n`] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC VSUM_UNION THEN + REWRITE_TAC[FINITE_NUMSEG; DISJOINT_NUMSEG] THEN ARITH_TAC; + + MP_TAC(ISPECL + [`\z. S_N(w - z) * Cx(&N) cpow (--z) * (Cx(&1) / z + z / Cx R pow 2)`; + `integral_sA':complex`; `Cx(&0)`; `R:real`; `--(pi / &2)`; `pi / &2`; + `&2 / R pow 2 + &2 / (&N * R)`; + `{complex(&0,R),complex(&0,--R)}`] + HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG) THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `&0 < R /\ ~(N = &0) + ==> (&2 / R pow 2 + &2 / (N * R)) * R * (p / &2 - --(p / &2)) = + &2 * p / R + &2 * p / N`] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_DIV; REAL_LE_MUL; REAL_POS; + REAL_LT_IMP_LE]; + ALL_TAC] THEN + ASM_SIMP_TAC[PI_POS; REAL_ARITH `&0 < x ==> --(x / &2) <= x / &2`] THEN + X_GEN_TAC `z:complex` THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN `norm(z) = R /\ &0 < Re z` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `path_image A SUBSET {z | Re z >= &0 /\ norm z = R}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; real_ge] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_SIMP_TAC[REAL_LT_LE] THEN + REWRITE_TAC[NORM_EQ_SQUARE; DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN + ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[REAL_RING + `&0 pow 2 + x pow 2 = y pow 2 <=> x = y \/ x = --y`] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `~(z = complex(&0,--R))` THEN + UNDISCH_TAC `~(z = complex(&0,R))` THEN + ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(exp (Re z * log (&N)) * (&1 / &N + &1 / Re z)) * + inv(exp(Re z * log(&N))) * (&2 * abs(Re z) / R pow 2)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[REAL_ARITH `&0 < z ==> abs z = z`] THEN + ASM_SIMP_TAC[REAL_EXP_NZ; REAL_FIELD + `~(e = &0) ==> (e * x) * inv(e) * y = x * y`] THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < x ==> (n + &1 / x) * &2 * x / y = &2 / y + &2 * x * n / y`] THEN + REWRITE_TAC[REAL_LE_LADD] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; LT_NZ; + REAL_FIELD `&0 < n /\ &0 < r + ==> (&2 * z * &1 / n / r pow 2) * n * r = &2 * z / r`] THEN + MATCH_MP_TAC(REAL_ARITH `x <= &1 ==> &2 * x <= &2`) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM(ASSUME + `!w. vsum (1..N) (\n. a n / Cx (&n) cpow w) = S_N w`)] THEN + MATCH_MP_TAC BOUND_LEMMA_3 THEN + ASM_REWRITE_TAC[REAL_LE_REFL; ARITH_RULE `1 <= N <=> ~(N = 0)`]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LE_REFL; NORM_CPOW_REAL; BOUND_LEMMA_1; + REAL_CX; RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[RE_NEG; REAL_MUL_LNEG; REAL_EXP_NEG; REAL_LE_REFL]; + + ALL_TAC] THEN + SUBGOAL_THEN + `(\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)) + path_integrable_on B` + MP_TAC THENL + [ASM_MESON_TAC[path_integrable_on]; ALL_TAC] THEN + EXPAND_TAC "B" THEN + SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; PATHSTART_JOIN; + PATHFINISH_JOIN; VALID_PATH_LINEPATH; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + REWRITE_TAC[path_integrable_on; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `integral_fC:complex` THEN DISCH_TAC THEN + X_GEN_TAC `integral_fD:complex` THEN DISCH_TAC THEN + X_GEN_TAC `integral_fC':complex` THEN DISCH_TAC THEN + SUBGOAL_THEN + `integral_fB:complex = integral_fC + integral_fD + integral_fC'` + SUBST1_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN + MAP_EVERY EXISTS_TAC + [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; + `B:real^1->complex`] THEN + ASM_SIMP_TAC[] THEN EXPAND_TAC "B" THEN + REPEAT(MATCH_MP_TAC HAS_PATH_INTEGRAL_JOIN THEN + ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_LINEPATH; + PATHFINISH_JOIN; VALID_PATH_LINEPATH; PATHSTART_LINEPATH]); + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(y) <= a /\ norm(x) <= &2 * b /\ norm(z) <= &2 * b + ==> norm(x + y + z) <= a + &4 * b`) THEN + CONJ_TAC THENL + [MP_TAC(SPECL + [`\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)`; + `integral_fD:complex`; + `complex (--d,R)`; `complex (--d,--R)`; + `M * inv(exp(d * log(&N))) * &3 / d`] + HAS_PATH_INTEGRAL_BOUND_LINEPATH) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + SUBGOAL_THEN `complex (--d,--R) - complex (--d,R) = + Cx(&2) * ii * Cx(--R)` + SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_EQ; RE_SUB; IM_SUB; RE_MUL_CX; IM_MUL_CX; + RE_CX; IM_CX; RE_MUL_II; IM_MUL_II; RE; IM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < R ==> abs(--R) = R`; REAL_ABS_NUM] THEN + CONV_TAC REAL_FIELD] THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_EXP_POS_LE; + REAL_LE_DIV; REAL_POS]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `Re z = --d` ASSUME_TAC THENL + [UNDISCH_TAC `z IN segment[complex(--d,R),complex(--d,--R)]` THEN + REWRITE_TAC[segment; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[RE_CMUL; RE_ADD; RE] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `segment[complex(--d,R),complex(--d,--R)] SUBSET + {z | abs(Im z) <= R}` + MP_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[REAL_ARITH `abs(x) <= r <=> x >= --r /\ x <= r`] THEN + SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`; + CONVEX_INTER; CONVEX_HALFSPACE_IM_LE; CONVEX_HALFSPACE_IM_GE] THEN + REWRITE_TAC[SET_RULE `{a,b} SUBSET s <=> a IN s /\ b IN s`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTER; IM] THEN + UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[real_ge; REAL_LE_REFL] THEN + MAP_EVERY UNDISCH_TAC [`&0 < R`; `&0 < d`] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[CPOW_REAL_REAL; NORM_CPOW_REAL; REAL_CX; RE_CX; + REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_EXP_NEG; REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `Re z = --d` THEN + ASM_REWRITE_TAC[RE_CX] THEN UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD + `~(z = Cx(&0)) /\ ~(R = Cx(&0)) + ==> Cx(&1) / z + z / R pow 2 = + (Cx(&1) + (z / R) pow 2) * inv(z)`] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `norm(i) = &1 /\ norm(z) <= &2 ==> norm(i + z) <= &3`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; REAL_POW_DIV] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; REAL_POW_LT; + CX_INJ; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_POW2_ABS] THEN + ASM_REWRITE_TAC[COMPLEX_SQNORM] THEN + MATCH_MP_TAC(REAL_ARITH + `d pow 2 <= R pow 2 /\ i pow 2 <= R pow 2 + ==> --d pow 2 + i pow 2 <= &2 * R pow 2`) THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN + MAP_EVERY UNDISCH_TAC + [`&0 < d`; `&0 < R`; `d <= R`; `abs(Im z) <= R`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(Re z)` THEN REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\z. --(inv(clog(Cx(&N)) pow 2)) * (Cx(&1) + z * clog(Cx(&N))) * + Cx(&N) cpow (--z)`; + `\z. z * Cx(&N) cpow (--z)`; + `linepath(Cx(&0),Cx(d))`; + `(:complex)`] PATH_INTEGRAL_PRIMITIVE) THEN + REWRITE_TAC[VALID_PATH_LINEPATH; SUBSET_UNIV; IN_UNIV] THEN ANTS_TAC THENL + [X_GEN_TAC `z:complex` THEN COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_ADD_LID; COMPLEX_MUL_LNEG] THEN + ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN + SUBGOAL_THEN `~(clog(Cx(&N)) = Cx(&0))` MP_TAC THENL + [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ; CX_INJ] THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT]; + ALL_TAC] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[COMPLEX_NEG_0; COMPLEX_MUL_LID; COMPLEX_MUL_LZERO; + COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_RING + `--x * y - --x * z:complex = x * (z - y)`] THEN + ASM_REWRITE_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; complex_pow] THEN + ASM_SIMP_TAC[CPOW_NEG; CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + LT_NZ; GSYM CX_LOG; GSYM CX_MUL; GSYM CX_INV; + GSYM CX_ADD; GSYM CX_SUB; GSYM CX_POW] THEN + REWRITE_TAC[REAL_ARITH `&1 - (&1 + d) = --d`] THEN + ABBREV_TAC + `integral_bound = + inv(log(&N) pow 2) * + (&1 - (&1 + d * log(&N)) * inv(exp(d * log (&N))))` THEN + SUBGOAL_THEN + `&0 <= integral_bound /\ integral_bound <= inv(log(&N) pow 2)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "integral_bound" THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_DIV2_EQ; REAL_LE_RDIV_EQ; + REAL_POW_LT; LOG_POS_LT; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_ARITH `&0 * x <= &1 - y /\ &1 - y <= &1 <=> + &0 <= y /\ y <= &1`] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_EXP_POS_LT] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_EXP_LE_X]] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; LOG_POS_LT; REAL_OF_NUM_LT]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&2) * Cx(M) / Cx(R) pow 2`) THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL + [UNDISCH_TAC + `((\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)) + has_path_integral integral_fC) + (linepath (complex (&0,R),complex (--d,R)))`; + UNDISCH_TAC + `((\z. f(w + z) * Cx(&N) cpow z * (Cx(&1) / z + z / Cx R pow 2)) + has_path_integral integral_fC') + (linepath (complex(--d,--R),complex(&0,--R)))`] THEN + REWRITE_TAC[HAS_PATH_INTEGRAL; VECTOR_DERIVATIVE_LINEPATH_AT] THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o C CONJ (ARITH_RULE `~(-- &1 = &0)`)) THEN + DISCH_THEN(MP_TAC o SPEC `vec 1:real^1` o + MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LNEG; VECTOR_NEG_0; + VECTOR_ADD_LID; VECTOR_NEG_NEG; REAL_POW_ONE; REAL_INV_1] THEN + REWRITE_TAC[VECTOR_ARITH `--x + y:real^1 = y - x`; VECTOR_SUB_REFL]] THEN + (SUBGOAL_THEN + `(!x. linepath(complex (&0,R),complex (--d,R)) x = + ii * Cx(R) - Cx(d * drop x)) /\ + (!x. linepath(Cx (&0),Cx d) x = Cx(d * drop x)) /\ + (complex(--d,R) - complex(&0,R) = --Cx(d)) /\ + (!x. linepath(complex (--d,--R),complex(&0,--R)) (vec 1 - x) = + --ii * Cx(R) - Cx(d * drop x)) /\ + (complex(&0,--R) - complex(--d,--R) = Cx(d))` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[linepath; COMPLEX_EQ; IM_CMUL; RE_CMUL; IM; RE; RE_SUB; + IM_SUB; IM_ADD; RE_ADD; RE_MUL_II; IM_MUL_II; RE_MUL_CX; + RE_II; IM_II; IM_MUL_CX; IM_CX; RE_CX; RE_NEG; IM_NEG; + DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[TAUT `a /\ b /\ c /\ d /\ e ==> f <=> + c /\ d ==> a /\ b /\ e ==> f`] + HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT)) THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[GSYM RE_DEF] THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV; RE_CX] THEN + REWRITE_TAC[real_div; GSYM REAL_POW_INV; REAL_POW_MUL; REAL_INV_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= (M * R) * (b - i) ==> (&2 * M * R) * i <= &2 * M * R * b`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_MUL; REAL_POW_LE; REAL_LE_INV_EQ; + REAL_LT_IMP_LE] THEN + ASM_REWRITE_TAC[REAL_POW_INV]] THEN + REWRITE_TAC[DIMINDEX_2; ARITH] THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + CPOW_REAL_REAL; LT_NZ] THEN + REWRITE_TAC[RE_MUL_II; RE_NEG; RE_II; RE_MUL_CX; RE_SUB; RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_NEG_0; COMPLEX_SUB_RZERO; + REAL_ARITH `&0 - d * x = --(d * x)`] THEN + GEN_REWRITE_TAC (RAND_CONV o TOP_DEPTH_CONV) + [GSYM CX_MUL; GSYM CX_INV; GSYM CX_POW; GSYM CX_DIV; RE_CX] THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> abs d = d`; REAL_LE_RMUL_EQ; + REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV + [REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_MUL_LNEG] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_EXP_POS_LT] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `&2 * M * r * d * x = M * (&2 * (d * x) * r)`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE; GSYM real_div] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[RE_MUL_II; IM_MUL_II; RE_SUB; IM_SUB; RE_CX; IM_CX; + COMPLEX_MUL_LNEG; RE_NEG; IM_NEG] THEN + SUBGOAL_THEN `&0 <= d * x /\ d * x <= d * &1` MP_TAC THENL + [ALL_TAC; + MAP_EVERY UNDISCH_TAC [`&0 < d`; `d <= R`] THEN REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LE_LMUL_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC BOUND_LEMMA_2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_MUL] THEN + REWRITE_TAC[RE_MUL_II; IM_MUL_II; RE_SUB; IM_SUB; RE_CX; IM_CX; + COMPLEX_MUL_LNEG; RE_NEG; IM_NEG] THEN + UNDISCH_TAC `&0 < R` THEN REAL_ARITH_TAC));; + +(* ------------------------------------------------------------------------- *) +(* The application is to any bounded a_n, not |a_n| <= 1, so... *) +(* ------------------------------------------------------------------------- *) + +let NEWMAN_INGHAM_THEOREM_BOUND = prove + (`!f a b. &0 < b /\ + (!n. 1 <= n ==> norm(a(n)) <= b) /\ + f analytic_on {z | Re(z) >= &1} /\ + (!z. Re(z) > &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)) + ==> !z. Re(z) >= &1 + ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\z:complex. inv(Cx(b)) * f z`; + `\n:num. inv(Cx(b)) * a n`] + NEWMAN_INGHAM_THEOREM) THEN + ASM_SIMP_TAC[ANALYTIC_ON_MUL; ANALYTIC_ON_CONST] THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[SERIES_COMPLEX_LMUL] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_INV] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ARITH `&0 < b ==> abs b = b`; + REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:complex` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `Cx b` o MATCH_MP SERIES_COMPLEX_LMUL) THEN + ASM_SIMP_TAC[complex_div; COMPLEX_MUL_ASSOC; COMPLEX_MUL_RINV; + CX_INJ; REAL_LT_IMP_NZ; COMPLEX_MUL_LID]);; + +let NEWMAN_INGHAM_THEOREM_STRONG = prove + (`!f a b. (!n. 1 <= n ==> norm(a(n)) <= b) /\ + f analytic_on {z | Re(z) >= &1} /\ + (!z. Re(z) > &1 ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)) + ==> !z. Re(z) >= &1 + ==> ((\n. a(n) / Cx(&n) cpow z) sums (f z)) (from 1)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC NEWMAN_INGHAM_THEOREM_BOUND THEN + EXISTS_TAC `abs b + &1` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[REAL_ARITH `x <= b ==> x <= abs b + &1`]);; + +(* ------------------------------------------------------------------------- *) +(* Newman's analytic function "f", re-using our "nearzeta" stuff. *) +(* ------------------------------------------------------------------------- *) + +let GENZETA_BOUND_LEMMA = prove + (`!n s m. ~(n = 0) /\ &1 < Re s /\ n + 1 <= m + ==> sum(n..m) (\x. norm(Cx(&1) / Cx(&x) cpow s)) + <= (&1 / &n + &1 / (Re s - &1)) * exp((&1 - Re s) * log(&n))`, + REPEAT STRIP_TAC THEN + SIMP_TAC[SUM_CLAUSES_LEFT; MATCH_MP (ARITH_RULE `n + 1 <= m ==> n <= m`) + (ASSUME `n + 1 <= m`)] THEN + MATCH_MP_TAC(REAL_ARITH `y <= a - x ==> x + y <= a`) THEN + MP_TAC(SPECL + [`\z. Cx(&1) / z cpow (Cx(Re s))`; + `\z. Cx(&1) / ((Cx(&1) - (Cx(Re s))) * z cpow (Cx(Re s) - Cx(&1)))`; + `n + 1`; `m:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(n + &1) - &1 = n`] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN COMPLEX_DIFF_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX_GEN]) THEN + STRIP_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ASM_REAL_ARITH_TAC] THEN + SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM LT_NZ]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL + [ASM_MESON_TAC[RE_CX; REAL_LT_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[CPOW_N; CPOW_SUB; COMPLEX_POW_1] THEN + REWRITE_TAC[COMPLEX_ENTIRE; complex_div] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN + CONJ_TAC THENL + [UNDISCH_TAC `~(z = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD; + ASM_REWRITE_TAC[COMPLEX_INV_EQ_0; CPOW_EQ_0; COMPLEX_SUB_0] THEN + REWRITE_TAC[CX_INJ] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < x /\ &0 < y` STRIP_ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT; GSYM LT_NZ]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; RE_CX; REAL_CX; GSYM CX_DIV] THEN + SIMP_TAC[real_div; REAL_MUL_LID; GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s * (y - x) ==> --(s * y) <= --(s * x)`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> x <= a ==> y <= b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `0 < r` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + COMPLEX_NORM_DIV; NORM_CPOW_REAL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_DIV; RE_CX; REAL_ABS_NUM]; + ALL_TAC] THEN + REWRITE_TAC[RE_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ --y <= e ==> x - y <= e`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (ARITH_RULE `n + 1 <= m ==> 0 < m`)) THEN + ASM_SIMP_TAC[GSYM CX_SUB; CPOW_REAL_REAL; REAL_CX; RE_CX; COMPLEX_NORM_DIV; + REAL_OF_NUM_LT; NORM_CPOW_REAL; LT_NZ] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_DIV; RE_CX] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_INV_NEG] THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_NEG_SUB] THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_EXP_POS_LE; REAL_SUB_LE; + REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_INV_MUL; GSYM REAL_EXP_NEG] THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_NEG_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `x <= n * e ==> i * e <= (n + i) * e - x`) THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LT_NZ; REAL_EXP_POS_LT; + REAL_FIELD `&0 < x /\ &0 < z ==> inv(x) * x / z = inv(z)`] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_EXP_NEG; REAL_LE_REFL]);; + +let GENZETA_BOUND = prove + (`!n s. ~(n = 0) /\ &1 < Re s + ==> norm(genzeta n s) <= + (&1 / &n + &1 / (Re s - &1)) * exp((&1 - Re s) * log(&n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\m. vsum(n..m) (\r. Cx(&1) / Cx(&r) cpow s)` THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP GENZETA_CONVERGES) THEN + SIMP_TAC[sums; FROM_INTER_NUMSEG; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + ASM_SIMP_TAC[GENZETA_BOUND_LEMMA]);; + +let NEARZETA_BOUND_SHARP = prove + (`!n s. ~(n = 0) /\ &0 < Re s + ==> norm(nearzeta n s) <= + norm(s * (s - Cx(&1))) * + (&1 / &n + &1 / Re s) / exp(Re s * log(&n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC + `\m. vsum(n..m) + (\r. (s - Cx(&1)) / Cx(&r) cpow s - + (Cx(&1) / Cx(&r) cpow (s - Cx(&1)) - + Cx(&1) / Cx(&(r + 1)) cpow (s - Cx(&1))))` THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP NEARZETA_CONVERGES) THEN + SIMP_TAC[sums; FROM_INTER_NUMSEG; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (n..m) + (\r. norm(s * (s - Cx (&1)) / Cx(&r) cpow (s + Cx(&1))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC NEARZETA_BOUND_LEMMA THEN CONJ_TAC THENL + [ASM_ARITH_TAC; ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a / b = a * Cx(&1) / b`] THEN + REWRITE_TAC[SUM_LMUL; COMPLEX_NORM_MUL; GSYM REAL_MUL_ASSOC] THEN + REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE]) THEN + W(MP_TAC o PART_MATCH (lhand o rand) GENZETA_BOUND_LEMMA o lhand o snd) THEN + ASM_REWRITE_TAC[RE_ADD; REAL_LT_ADDL; RE_CX] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[REAL_ARITH `(x + &1) - &1 = x`; + REAL_ARITH `(&1 - (s + &1)) * x = --(s * x)`] THEN + REWRITE_TAC[real_div; REAL_EXP_NEG; REAL_LE_REFL]);; + +let NEARZETA_BOUND = prove + (`!n s. ~(n = 0) /\ &0 < Re s + ==> norm(nearzeta n s) + <= ((norm(s) + &1) pow 3 / Re s) / exp (Re s * log (&n))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NEARZETA_BOUND_SHARP) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_EXP_POS_LE; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_RING `(x pow 3):real = x * x * x`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LE_ADD; REAL_LE_INV_EQ; + REAL_POS; REAL_LT_IMP_LE] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LE_ADD; REAL_LE_INV_EQ; + REAL_POS; REAL_LT_IMP_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH `norm(y) = b ==> norm(x - y) <= norm(x) + b`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `a + y <= (x + &1) * y <=> a <= x * y`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN + ASM_SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH; + ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[REAL_INV_1; GSYM real_div; REAL_LE_RDIV_EQ] THEN + MP_TAC(SPEC `s:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC);; + +let NEARNEWMAN_EXISTS = prove + (`?f. !s. s IN {s | Re(s) > &1 / &2} + ==> ((\p. clog(Cx(&p)) / Cx(&p) * nearzeta p s - + clog(Cx(&p)) / (Cx(&p) cpow s * (Cx(&p) cpow s - Cx(&1)))) + sums (f s)) {p | prime p} /\ + f complex_differentiable (at s)`, + MATCH_MP_TAC SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX THEN + REWRITE_TAC[OPEN_HALFSPACE_RE_GT] THEN + REWRITE_TAC[IN_ELIM_THM; real_gt] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + CONJ_TAC THENL + [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_MUL_AT THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_NEARZETA THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC]; + ALL_TAC] THEN + COMPLEX_DIFFERENTIABLE_TAC THEN + ASM_SIMP_TAC[COMPLEX_ENTIRE; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; + COMPLEX_SUB_0; PRIME_IMP_NZ; PRIME_GE_2; CPOW_NUM_NE_1; + REAL_ARITH `&1 / &2 < x ==> &0 < x`]; + ALL_TAC] THEN + X_GEN_TAC `s:complex` THEN STRIP_TAC THEN + EXISTS_TAC `min (&1 / &2) ((Re s - &1 / &2) / &2)` THEN + EXISTS_TAC `\p. Cx(&2 * (norm(s:complex) + &2) pow 3 + &2) * + clog(Cx(&p)) / + Cx(&p) cpow (Cx(&1 + (Re s - &1 / &2) / &4))` THEN + EXISTS_TAC `5` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SUMMABLE_SUBSET_COMPLEX THEN EXISTS_TAC `from 1` THEN + SIMP_TAC[IN_FROM; SUBSET; IN_ELIM_THM; GSYM CX_LOG; CPOW_REAL_REAL; + RE_CX; REAL_CX; REAL_OF_NUM_LT; LE_1; PRIME_IMP_NZ] THEN + SIMP_TAC[GSYM CX_DIV; REAL_CX; RE_CX; LOG_POS; REAL_OF_NUM_LE; + REAL_LE_DIV; REAL_EXP_POS_LE] THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC + `--(complex_derivative zeta (Cx(&1 + (Re s - &1 / &2) / &4)))` THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) + [GSYM COMPLEX_NEG_NEG] THEN + MATCH_MP_TAC SERIES_NEG THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_LNEG] THEN + REWRITE_TAC[GSYM complex_div] THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_ZETA_CONVERGES THEN + REWRITE_TAC[RE_CX] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THEN X_GEN_TAC `p:num` THENL + [SIMP_TAC[CPOW_REAL_REAL; REAL_CX; RE_CX; GSYM CX_LOG; REAL_OF_NUM_LT; + LT_NZ; PRIME_IMP_NZ; GSYM CX_DIV; GSYM CX_MUL] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 <= &2 * x + &2`) THEN + MATCH_MP_TAC REAL_POW_LE THEN NORM_ARITH_TAC; + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; + PRIME_GE_2]]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN + REWRITE_TAC[IN_BALL; REAL_LT_MIN; dist] THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= a * b /\ a * b <= abs a * b ==> x <= abs a * b`) THEN + SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; REAL_ABS_LE] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ADD_RDISTRIB] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x) <= a /\ norm(y) <= b ==> norm(x - y) <= a + b`) THEN + CONJ_TAC THENL + [REWRITE_TAC[CPOW_ADD; CX_ADD; CPOW_N; CX_INJ; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN + ASM_SIMP_TAC[PRIME_IMP_NZ; GSYM complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN + REWRITE_TAC[COMPLEX_POW_1; real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `x * a * b:real = a * x * b`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + W(MP_TAC o PART_MATCH (lhand o rand) NEARZETA_BOUND o lhand o snd) THEN + ASM_SIMP_TAC[PRIME_IMP_NZ] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[PRIME_IMP_NZ] THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x) * y = x * &2 * y`] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE; REAL_LE_INV_EQ; REAL_LE_MUL; + REAL_LT_IMP_LE; REAL_POS; REAL_LE_ADD; GSYM REAL_INV_MUL; + REAL_EXP_POS_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_NORM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_EXP_POS_LE] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; PRIME_IMP_NZ; + LT_NZ] THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[REAL_ARITH `--(a * p) <= --(b * p) <=> b * p <= a * p`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; + PRIME_GE_2] THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!y:complex. norm(x) <= &2 * norm(y) /\ norm(y) <= a + ==> norm(x) <= &2 * a`) THEN + EXISTS_TAC `clog(Cx(&p)) / Cx(&p) cpow (z + z)` THEN CONJ_TAC THENL + [REWRITE_TAC[CPOW_ADD; complex_div; COMPLEX_MUL_ASSOC; COMPLEX_INV_MUL] THEN + REWRITE_TAC[GSYM complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_DIV] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_INV_INV] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_ARITH `&0 < x * inv(&2) <=> &0 < x`; COMPLEX_NORM_NZ] THEN + ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ; + COMPLEX_VEC_0] THEN + MATCH_MP_TAC(NORM_ARITH + `&2 <= norm(a) /\ norm(b) = &1 ==> norm(a) * inv(&2) <= norm(a - b)`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + ARITH_RULE `5 <= p ==> 0 < p`] THEN + SUBST1_TAC(SYM(MATCH_MP EXP_LOG (REAL_ARITH `&0 < &2`))) THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 / &2 * log(&4)` THEN + SIMP_TAC[REAL_ARITH `l <= &1 / &2 * x <=> &2 * l <= x`; + GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; LOG_POS; REAL_OF_NUM_LE; ARITH; + LOG_MONO_LE_IMP; REAL_OF_NUM_LT; + ARITH_RULE `5 <= p ==> 4 <= p`] THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; REAL_CX; RE_CX; REAL_OF_NUM_LT; + ARITH_RULE `5 <= p ==> 0 < p`] THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[REAL_ARITH `--(a * p) <= --(b * p) <=> b * p <= a * p`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; + PRIME_GE_2] THEN + MP_TAC(SPEC `s - z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB; RE_ADD] THEN ASM_REAL_ARITH_TAC);; + +let nearnewman = new_specification ["nearnewman"] NEARNEWMAN_EXISTS;; + +let [CONVERGES_NEARNEWMAN; COMPLEX_DIFFERENTIABLE_NEARNEWMAN] = + CONJUNCTS(REWRITE_RULE[FORALL_AND_THM; IN_ELIM_THM; real_gt; + TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] + nearnewman);; + +let newman = new_definition + `newman(s) = (nearnewman(s) - (complex_derivative zeta s / zeta s)) / + (s - Cx(&1))`;; + +(* ------------------------------------------------------------------------- *) +(* Careful correlation of singularities of the various functions. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DERIVATIVE_ZETA = prove + (`!s. &0 < Re s /\ ~(s = Cx(&1)) + ==> complex_derivative zeta s = + complex_derivative (nearzeta 1) s / (s - Cx(&1)) - + (nearzeta 1 s + Cx(&1)) / (s - Cx(&1)) pow 2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] (GEN_ALL zeta); + REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] (GEN_ALL genzeta)] THEN + REWRITE_TAC[CPOW_1; complex_div; COMPLEX_MUL_LID; COMPLEX_INV_1] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + EXISTS_TAC `\s. (nearzeta 1 s + Cx(&1)) * inv(s - Cx(&1))` THEN + EXISTS_TAC `dist(Cx(&1),s)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN + CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + MP_TAC(SPECL + [`\z. nearzeta 1 z + Cx(&1)`; `complex_derivative(nearzeta 1) s`; + `\z. inv(z - Cx(&1))`; + `--Cx(&1) / (s - Cx(&1)) pow 2`; + `s:complex`] + HAS_COMPLEX_DERIVATIVE_MUL_AT) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + COMPLEX_DIFF_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN + CONV_TAC COMPLEX_FIELD] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; ETA_AX] THEN + MP_TAC(SPEC `1` HOLOMORPHIC_NEARZETA) THEN + SIMP_TAC[ARITH; HOLOMORPHIC_ON_OPEN; OPEN_HALFSPACE_RE_GT] THEN + ASM_SIMP_TAC[IN_ELIM_THM; GSYM complex_differentiable; real_gt]);; + +let ANALYTIC_ZETA_DERIVDIFF = prove + (`?a. (\z. if z = Cx(&1) then a + else (z - Cx(&1)) * complex_derivative zeta z - + complex_derivative zeta z / zeta z) + analytic_on {s | Re(s) >= &1}`, + EXISTS_TAC + `complex_derivative + (\z. (Cx(&1) - inv(nearzeta 1 z + Cx(&1))) * + ((z - Cx(&1)) * complex_derivative (nearzeta 1) z - + (nearzeta 1 z + Cx(&1)))) (Cx(&1))` THEN + MATCH_MP_TAC POLE_THEOREM_ANALYTIC_0 THEN + MAP_EVERY EXISTS_TAC + [`\z. (Cx(&1) - inv(nearzeta 1 z + Cx(&1))) * + ((z - Cx(&1)) * complex_derivative (nearzeta 1) z - + (nearzeta 1 z + Cx(&1)))`; + `Cx(&1)`] THEN + SIMP_TAC[NEARZETA_1; ARITH] THEN + REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_INV_1; COMPLEX_SUB_REFL; + COMPLEX_MUL_LZERO] THEN + CONJ_TAC THENL + [MATCH_MP_TAC ANALYTIC_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC ANALYTIC_ON_SUB THEN REWRITE_TAC[ANALYTIC_ON_CONST] THEN + MATCH_MP_TAC ANALYTIC_ON_INV THEN + ASM_SIMP_TAC[IN_ELIM_THM; real_ge; NEARZETA_NONZERO] THEN + MATCH_MP_TAC ANALYTIC_ON_ADD THEN REWRITE_TAC[ANALYTIC_ON_CONST; ETA_AX]; + MATCH_MP_TAC ANALYTIC_ON_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC ANALYTIC_ON_MUL THEN + SIMP_TAC[ETA_AX; ANALYTIC_ON_SUB; ANALYTIC_ON_CONST; + ANALYTIC_ON_ID] THEN MATCH_MP_TAC ANALYTIC_COMPLEX_DERIVATIVE; + MATCH_MP_TAC ANALYTIC_ON_ADD THEN + REWRITE_TAC[ANALYTIC_ON_CONST; ETA_AX]]] THEN + MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN EXISTS_TAC `{s | Re(s) > &0}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + SIMP_TAC[ETA_AX; ANALYTIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; + HOLOMORPHIC_NEARZETA; LE_REFL] THEN REAL_ARITH_TAC; + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN + DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP NEARZETA_NONZERO) THEN + MP_TAC(ISPECL [`\z. nearzeta 1 z + Cx(&1)`; `z:complex`; `Cx(&0)`] + CONTINUOUS_AT_AVOID) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_ADD THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_CONST; ETA_AX] THEN + MP_TAC(SPEC `1` HOLOMORPHIC_NEARZETA) THEN + SIMP_TAC[ARITH; HOLOMORPHIC_ON_OPEN; OPEN_HALFSPACE_RE_GT] THEN + REWRITE_TAC[complex_differentiable; IN_ELIM_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min e (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN + REWRITE_TAC[BALL_MIN_INTER; IN_INTER; IN_BALL; REAL_LT_MIN] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < Re w` ASSUME_TAC THENL + [MP_TAC(SPEC `z - w:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN ASM_NORM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_DERIVATIVE_ZETA] THEN + ASM_REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM] zeta; genzeta] THEN + REWRITE_TAC[CPOW_1; COMPLEX_DIV_1] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(w = Cx(&1))` THEN CONV_TAC COMPLEX_FIELD]);; + +let ANALYTIC_NEWMAN_VARIANT = prove + (`?c a. (\z. if z = Cx(&1) then a + else newman z + complex_derivative zeta z + c * zeta z) + analytic_on {s | Re(s) >= &1}`, + X_CHOOSE_TAC `c:complex` ANALYTIC_ZETA_DERIVDIFF THEN + EXISTS_TAC `--(c + nearnewman(Cx(&1)))` THEN + EXISTS_TAC + `complex_derivative + (\z. nearnewman z + + (if z = Cx(&1) + then c + else (z - Cx(&1)) * complex_derivative zeta z - + complex_derivative zeta z / zeta z) + + --(c + nearnewman (Cx(&1))) * (nearzeta 1 z + Cx(&1))) + (Cx(&1))` THEN + MATCH_MP_TAC POLE_THEOREM_ANALYTIC_0 THEN + MAP_EVERY EXISTS_TAC + [`\z. nearnewman z + + (if z = Cx(&1) then c + else (z - Cx(&1)) * complex_derivative zeta z - + complex_derivative zeta z / zeta z) + + --(c + nearnewman(Cx(&1))) * (nearzeta 1 z + Cx(&1))`; + `Cx(&1)`] THEN + SIMP_TAC[NEARZETA_1; LE_REFL] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ANALYTIC_ON_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN + EXISTS_TAC `{s | Re(s) > &1 / &2}` THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; ANALYTIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; + HOLOMORPHIC_ON_OPEN; real_gt; GSYM complex_differentiable; + COMPLEX_DIFFERENTIABLE_NEARNEWMAN] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC ANALYTIC_ON_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ANALYTIC_ON_MUL THEN REWRITE_TAC[ANALYTIC_ON_CONST] THEN + MATCH_MP_TAC ANALYTIC_ON_ADD THEN REWRITE_TAC[ANALYTIC_ON_CONST] THEN + MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN EXISTS_TAC `{s | Re(s) > &0}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + SIMP_TAC[ETA_AX; ANALYTIC_ON_OPEN; OPEN_HALFSPACE_RE_GT; + HOLOMORPHIC_NEARZETA; LE_REFL] THEN REAL_ARITH_TAC]; + REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REWRITE_TAC[newman] THEN + GEN_REWRITE_TAC (funpow 4 RAND_CONV o ONCE_DEPTH_CONV) [zeta] THEN + ASM_REWRITE_TAC[genzeta; CPOW_1; COMPLEX_DIV_1] THEN + UNDISCH_TAC `~(w = Cx(&1))` THEN CONV_TAC COMPLEX_FIELD; + SIMPLE_COMPLEX_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Hence apply the analytic lemma. *) +(* ------------------------------------------------------------------------- *) + +let CONVERGES_NEWMAN_PRIME = prove + (`!s. &1 < Re s + ==> ((\p. clog(Cx(&p)) / Cx(&p) * genzeta p s) sums newman(s)) + {p | prime p}`, + X_GEN_TAC `s:complex` THEN ASM_CASES_TAC `s = Cx(&1)` THEN + ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL; genzeta; newman] THEN + DISCH_TAC THEN REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC SERIES_COMPLEX_RMUL THEN REWRITE_TAC[GSYM complex_div] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGES_LOGZETA'') THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGES_NEARNEWMAN o MATCH_MP + (REAL_ARITH `&1 < x ==> &1 / &2 < x`)) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN + REWRITE_TAC[GSYM complex_sub] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC SUMS_IFF THEN X_GEN_TAC `p:num` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC(COMPLEX_RING + `c - b = a * m ==> (a:complex) * n - b + c = a * (n + m)`) THEN + ASM_SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ; complex_div] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_SUB_LDISTRIB] THEN + AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID; GSYM COMPLEX_INV_MUL] THEN + ASM_SIMP_TAC[CPOW_SUB; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ] THEN + REWRITE_TAC[COMPLEX_POW_1] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(ps = Cx(&1)) /\ ~(ps = Cx(&0)) /\ ~(p = Cx(&0)) + ==> inv(ps - Cx(&1)) - inv(ps * (ps - Cx(&1))) = + inv(p * ps / p)`) THEN + ASM_SIMP_TAC[CPOW_NUM_NE_1; PRIME_GE_2; REAL_ARITH `&1 < x ==> &0 < x`] THEN + ASM_SIMP_TAC[CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; PRIME_IMP_NZ]);; + +(* ------------------------------------------------------------------------- *) +(* Now swap the order of summation in the series. *) +(* ------------------------------------------------------------------------- *) + +let GENZETA_OFFSET = prove + (`!m n s. &1 < Re s /\ m <= n + ==> genzeta m s - vsum(m..n) (\k. Cx(&1) / Cx(&k) cpow s) = + genzeta (n + 1) s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`\k. Cx(&1) / Cx(&k) cpow s`; `from(n + 1)`] THEN + ASM_SIMP_TAC[GENZETA_CONVERGES] THEN + GEN_REWRITE_TAC (PAT_CONV `\n. (f sums (a - vsum(m..n) s)) k`) + [ARITH_RULE `n = (n + 1) - 1`] THEN + MATCH_MP_TAC SUMS_OFFSET THEN ASM_SIMP_TAC[GENZETA_CONVERGES] THEN + ASM_ARITH_TAC);; + +let NEWMAN_CONVERGES = prove + (`!s. &1 < Re s + ==> ((\n. vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p)) / + Cx(&n) cpow s) + sums (newman s)) (from 1)`, + let lemma = prove + (`vsum (1..n) (\m. vsum {p | prime p /\ p <= m} (\p. f p m)) = + vsum {p | prime p /\ p <= n} (\p. vsum (p..n) (\m. f p m))`, + SIMP_TAC[VSUM_VSUM_PRODUCT; FINITE_NUMSEG; FINITE_ATMOST] THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC `\(x:num,y:num). (y,x)`) THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ASM_ARITH_TAC) in + REPEAT STRIP_TAC THEN + REWRITE_TAC[sums; FROM_INTER_NUMSEG; LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGES_NEWMAN_PRIME) THEN + GEN_REWRITE_TAC LAND_CONV [sums] THEN + SUBGOAL_THEN `!n. {p | prime p} INTER (0..n) = {p | prime p /\ p <= n}` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_NUMSEG; LE_0]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_THEN `N0:num` (LABEL_TAC "0")) THEN + SUBGOAL_THEN + `((\n. Cx(&1 + &1 / (Re s - &1)) * + (clog(Cx(&n)) + Cx(&24)) / Cx(&n) cpow (s - Cx(&1))) + --> Cx(&0)) sequentially` + MP_TAC THENL + [MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC LIM_LOG_OVER_POWER_N; + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv x = Cx(&1) / x`] THEN + MATCH_MP_TAC LIM_1_OVER_POWER] THEN + REWRITE_TAC[RE_SUB; RE_CX] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; dist; COMPLEX_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "1")) THEN + EXISTS_TAC `N0 + N1 + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REMOVE_THEN "0" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x - y) <= e / &2 ==> norm(x - a) < e / &2 ==> norm(y - a) < e`) THEN + SIMP_TAC[complex_div; GSYM VSUM_COMPLEX_RMUL; FINITE_ATMOST] THEN + REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[lemma] THEN + SIMP_TAC[FINITE_ATMOST; GSYM VSUM_SUB] THEN SIMP_TAC[complex_div] THEN + SIMP_TAC[COMPLEX_MUL_ASSOC; VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN SIMP_TAC[GSYM complex_div] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv x = Cx(&1) / x`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `norm(vsum {p | prime p /\ p <= n} + (\p. clog(Cx(&p)) / Cx(&p) * genzeta (n + 1) s))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_ELIM_THM; GENZETA_OFFSET]; + ALL_TAC] THEN + SIMP_TAC[VSUM_COMPLEX_RMUL; FINITE_ATMOST] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `y <= x ==> x < e ==> y <= e`) THEN + REWRITE_TAC[complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN + REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN `~(n = 0) /\ 1 <= n` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP MERTENS) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - y) <= e ==> &0 <= y ==> abs(x) <= y + e`)) THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `x' <= x /\ y' = y ==> abs x <= y ==> x' <= y'`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN SIMP_TAC[FINITE_ATMOST; IN_ELIM_THM] THEN + X_GEN_TAC `p:num` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[GSYM CX_DIV; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x <= x`) THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; LOG_POS; REAL_OF_NUM_LE; LE_1]; + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[GSYM CX_ADD; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x = x`) THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_POS; LOG_POS; REAL_OF_NUM_LE; LE_1]]; + MP_TAC(SPECL [`n + 1`; `s:complex`] GENZETA_BOUND) THEN + ASM_REWRITE_TAC[ADD_EQ_0; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[complex_div; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_DIV; REAL_POS; REAL_SUB_LE; + REAL_LT_IMP_LE; REAL_EXP_POS_LE] THEN + CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH `a <= &1 ==> a + b <= abs(&1 + b)`) THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_NORM_INV; NORM_CPOW_REAL; REAL_CX; + RE_CX; REAL_OF_NUM_LT; LT_NZ] THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE; RE_SUB; RE_CX] THEN + REWRITE_TAC[REAL_ARITH `(&1 - s) * l <= --((s - &1) * m) <=> + (s - &1) * m <= (s - &1) * l`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC LOG_MONO_LE_IMP THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LT_NZ] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the main result of the analytic part. *) +(* ------------------------------------------------------------------------- *) + +let MAIN_RESULT = prove + (`?c. summable (from 1) + (\n. (vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p)) - + clog(Cx(&n)) + c) / Cx(&n))`, + MP_TAC ANALYTIC_NEWMAN_VARIANT THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:complex`; `singval:complex`] THEN DISCH_TAC THEN + EXISTS_TAC `c:complex` THEN MP_TAC(SPECL + [`\z. if z = Cx(&1) then singval + else newman z + complex_derivative zeta z + c * zeta z`; + `\n. vsum {p | prime p /\ p <= n} (\p. clog(Cx(&p)) / Cx(&p)) - + clog(Cx(&n)) + c`; + `&24 + norm(c:complex)`] + NEWMAN_INGHAM_THEOREM_STRONG) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN + REWRITE_TAC[RE_CX; real_ge; REAL_LE_REFL] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMS_SUMMABLE) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ) THEN + SIMP_TAC[IN_FROM; CPOW_N; CX_INJ; REAL_OF_NUM_EQ] THEN + SIMP_TAC[LE_1; COMPLEX_POW_1]] THEN + CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x - y) <= &24 ==> norm(x - y + c) <= &24 + norm c`) THEN + MP_TAC(SPEC `n:num` MERTENS) THEN ASM_SIMP_TAC[LE_1] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= a ==> y <= a`) THEN + REWRITE_TAC[GSYM COMPLEX_NORM_CX] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM VSUM_CX; CX_SUB; FINITE_ATMOST] THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LE_1] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM CX_LOG; CX_DIV; REAL_OF_NUM_LT; LT_NZ; PRIME_IMP_NZ]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[real_gt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN + DISCH_TAC THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB; COMPLEX_SUB_RDISTRIB] THEN + REWRITE_TAC[COMPLEX_ADD_ASSOC] THEN MATCH_MP_TAC SERIES_ADD THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SERIES_COMPLEX_LMUL THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ZETA_CONVERGES) THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID]] THEN + REWRITE_TAC[complex_sub] THEN MATCH_MP_TAC SERIES_ADD THEN + REWRITE_TAC[GSYM complex_div] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_LNEG] THEN + REWRITE_TAC[GSYM complex_div] THEN + ASM_SIMP_TAC[COMPLEX_DERIVATIVE_ZETA_CONVERGES]] THEN + ASM_SIMP_TAC[NEWMAN_CONVERGES]);; + +(* ------------------------------------------------------------------------- *) +(* The theorem relating summability and convergence. *) +(* ------------------------------------------------------------------------- *) + +let SUM_GOESTOZERO_LEMMA = prove + (`!a M N. + abs(sum(M..N) (\i. a(i) / &i)) <= d + ==> 0 < M /\ M < N /\ (!n. a(n) + log(&n) <= a(n + 1) + log(&n + &1)) + ==> a(M) <= d * &N / (&N - &M) + (&N - &M) / &M /\ + --a(N) <= d * &N / (&N - &M) + (&N - &M) / &M`, + REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `0 < N` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LT]) THEN + MATCH_MP_TAC(REAL_ARITH + `!a. a <= b /\ x <= a /\ y <= a ==> x <= b /\ y <= b`) THEN + EXISTS_TAC `d * &N / (&N - &M) + log(&N / &M)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_LADD] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < m /\ &0 < n + ==> n / m = &1 + (n - m) / m`] THEN + MATCH_MP_TAC LOG_LE THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN + SUBGOAL_THEN `!m n. &m <= &n ==> a m + log(&m) <= a n + log(&n)` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + CONJ_TAC THEN + (MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(d * &N) / (&N - &M + &1)` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC]) THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ (&0 <= x ==> x <= y) ==> x <= y`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `m < n ==> &0 < n - m + &1`; + REAL_LE_DIV; REAL_LE_MUL; REAL_MUL_LZERO; REAL_POS] THEN + DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(x * y) * z:real = y * (x * z)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sum(M..N) (\i. a(i) / &i))` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`); + MATCH_MP_TAC(REAL_ARITH `a <= --x ==> x <= abs a`)] THEN + (SUBGOAL_THEN `&N - &M + &1 = &((N + 1) - M)` SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_ADD; GSYM + REAL_OF_NUM_LE; REAL_ARITH `m < n ==> m <= n + &1`] THEN + REAL_ARITH_TAC; + ALL_TAC]) THEN + REWRITE_TAC[GSYM SUM_CONST_NUMSEG; GSYM SUM_NEG] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + (SUBGOAL_THEN `&0 < &n` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG; REAL_NEG_SUB; REAL_SUB_RNEG] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `(a M - log(&N * inv(&M))) * inv(&n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + ASM_SIMP_TAC[GSYM real_div; LOG_DIV] THEN + MATCH_MP_TAC(REAL_ARITH + `!x'. x' <= x /\ a - (x' - m) <= b ==> a - (x - m) <= b`) THEN + EXISTS_TAC `log(&n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `a - (x - y) <= b <=> a + y <= b + x`]; + EXISTS_TAC `(log(&N * inv(&M)) + a N) * inv(&n)` THEN CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `a * x <= a * y <=> --a * y <= --a * x`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[GSYM real_div; REAL_ARITH `--(x + y:real) = --y - x`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + ASM_SIMP_TAC[GSYM real_div; LOG_DIV] THEN + MATCH_MP_TAC(REAL_ARITH + `!x'. x <= x' /\ a <= y - x' + b ==> a <= y - x + b`) THEN + EXISTS_TAC `log(&n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= x - y + b <=> a + y <= b + x`]]);; + +let SUM_GOESTOZERO_THEOREM = prove + (`!a c. ((\i. a(i) / &i) real_sums c) (from 1) /\ + (!n. a(n) + log(&n) <= a(n + 1) + log(&n + &1)) + ==> (a ---> &0) sequentially`, + let lemma = prove + (`(!e. &0 < e /\ e < &1 / &4 ==> ?N:num. !n. N <= n ==> f(n) < e) + ==> (!e. &0 < e ==> ?N. !n. N <= n ==> f(n) < e)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &5)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MESON_TAC[REAL_LT_MIN]) in + REWRITE_TAC[LEFT_FORALL_IMP_THM; LEFT_EXISTS_AND_THM] THEN + REWRITE_TAC[REAL_SERIES_CAUCHY] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + MATCH_MP_TAC lemma THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(e / &8) pow 2`) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `e / &4` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `2 * N0 + N1 + 7` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MP_TAC(SPEC `&n * e / &4` FLOOR) THEN + MP_TAC(SPEC `&n * e / &4` FLOOR_POS) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN STRIP_TAC THEN + SUBGOAL_THEN `0 < k /\ 4 * k <= n` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[LT_NZ] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `&n * e / &4 < &0 + &1` THEN + REWRITE_TAC[REAL_NOT_LT; REAL_ADD_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N1 * e / &4` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LT_NZ] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_ARITH `&4 * x <= y <=> x <= y * inv(&4)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n * e / &4` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LT] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`n - k:num`; `n:num`]); + FIRST_ASSUM(MP_TAC o SPECL [`n:num`; `n + k:num`])] THEN + (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[FROM_INTER_NUMSEG_GEN] THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_GOESTOZERO_LEMMA) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) + THENL + [DISCH_THEN(MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC(REAL_ARITH `a < b ==> --x <= a ==> --b < x`); + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + MATCH_MP_TAC(REAL_ARITH `a < b ==> x <= a ==> x < b`)] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; ARITH_RULE `4 * k <= n ==> k <= n`; + GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `n - (n - k):real = k`; + REAL_ARITH `(n + k) - n:real = k`] THEN + MATCH_MP_TAC(REAL_ARITH + `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH + `(e / &8) pow 2 * x < e / &2 <=> e * e / &16 * x < e * &2`] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT; REAL_OF_NUM_LT; + ARITH_RULE `0 < k /\ 4 * k <= n ==> k < n`; + ARITH_RULE `~(n < 1) ==> 0 < n`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `n * e / &4 < k + &1 /\ &1 <= k ==> e / &16 * n < &2 * k`) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&n * e / &4` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH + `n * e / &4 < e / &2 * m <=> e * n < e * &2 * m`] THEN + REWRITE_TAC[REAL_ARITH `n < &2 * (n - k) <=> &2 * k < n`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `n * e / &4 < k + &1 /\ &1 <= k /\ (&1 / &4 + e / &16) * k < &1 * k + ==> e / &16 * (n + k) < &2 * k`) THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_OF_NUM_LE; REAL_OF_NUM_LT; + ARITH_RULE `1 <= n <=> 0 < n`] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `k <= n * e / &4 /\ &0 < n * e ==> k < e / &2 * n`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; + ARITH_RULE `~(n < 1) ==> 0 < n`]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence transform into the desired limit. *) +(* ------------------------------------------------------------------------- *) + +let MERTENS_LIMIT = prove + (`?c. ((\n. sum {p | prime p /\ p <= n} (\p. log(&p) / &p) - log(&n)) + ---> c) sequentially`, + X_CHOOSE_THEN `c:complex` MP_TAC MAIN_RESULT THEN + REWRITE_TAC[summable] THEN + DISCH_THEN(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--Re(c)` THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN + MATCH_MP_TAC SUM_GOESTOZERO_THEOREM THEN EXISTS_TAC `Re l` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP REAL_SUMS_RE) THEN + REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_SUMS_EQ) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + ASM_SIMP_TAC[RE_ADD; RE_DIV_CX; RE_SUB; REAL_SUB_RNEG] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LE_1; RE_CX] THEN + SIMP_TAC[RE_VSUM; FINITE_ATMOST] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[IN_ELIM_THM; GSYM CX_LOG; REAL_OF_NUM_LT; PRIME_IMP_NZ; LT_NZ; + GSYM CX_DIV; RE_CX]; + GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH + `s <= s' ==> (s - l - c) + l <= (s' - l' - c) + l'`) THEN + MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[FINITE_ATMOST] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THEN + X_GEN_TAC `p:num` THEN ASM_CASES_TAC `prime p` THEN ASM_REWRITE_TAC[] THENL + [ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC LOG_POS THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Reformulate the PNT using partial summation. *) +(* ------------------------------------------------------------------------- *) + +let PNT_PARTIAL_SUMMATION = prove + (`&(CARD {p | prime p /\ p <= n}) = + sum(1..n) + (\k. &k / log (&k) * + (sum {p | prime p /\ p <= k} (\p. log (&p) / &p) - + sum {p | prime p /\ p <= k - 1} (\p. log (&p) / &p)))`, + REWRITE_TAC[PRIME_ATMOST_ALT] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG; FINITE_RESTRICT] THEN + SIMP_TAC[FINITE_NUMSEG; SUM_RESTRICT_SET] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `p:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC (PAT_CONV `\x. l = a * (sum(1..x) f - s)`) + [MATCH_MP (ARITH_RULE `1 <= p ==> p = SUC(p - 1)`) th]) THEN + SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + REWRITE_TAC[REAL_ADD_SUB] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= p ==> SUC(p - 1) = p`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + MATCH_MP_TAC(REAL_FIELD `&0 < x /\ &0 < y ==> &1 = x / y * y / x`) THEN + ASM_SIMP_TAC[LOG_POS_LT; REAL_OF_NUM_LT; LE_1; PRIME_GE_2; + ARITH_RULE `2 <= p ==> 1 < p`]);; + +let SUM_PARTIAL_LIMIT = prove + (`!f e c M. + (!k. M <= k ==> &0 < f k) /\ + (!k. M <= k ==> f(k) <= f(k + 1)) /\ + ((\k. inv(f k)) ---> &0) sequentially /\ + (e ---> c) sequentially + ==> ((\n. (sum(1..n) (\k. e(k) * (f(k + 1) - f(k))) - e(n) * f(n + 1)) / + f(n + 1)) ---> &0) sequentially`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "g") (LABEL_TAC "e")) THEN + SUBGOAL_THEN `!k:num. M <= k ==> &0 <= f k` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + SIMP_TAC[tendsto_real] THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `?N. (!k. N <= k ==> &0 < f k) /\ + (!k. N <= k ==> f(k) <= f(k + 1)) /\ + (!k. N <= k ==> abs(e k - c) < d / &4)` + (X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) + THENL + [USE_THEN "e" (MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `d / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + ASM_MESON_TAC[ARITH_RULE `M + N <= (n:num) ==> M <= n /\ N <= n`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. N + 1 <= n + ==> abs((sum((N+1)..n) (\k. e k * (f (k + 1) - f k)) - + e(n) * f(n + 1)) + + c * f(N + 1)) + <= d / &2 * f(n + 1)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\k. (e k - c:real) * (f (k + 1) - f k)`; + `\k. d / &4 * (f (k + 1) - f k)`; + `(N+1)..n`] SUM_ABS_LE) THEN + REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_ABS_MUL; ARITH_RULE `N + 1 <= n ==> N <= n`; + REAL_ARITH `a <= b ==> abs(b - a) = b - a`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; ARITH_RULE `N + 1 <= n ==> N <= n`]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[SUM_SUB_NUMSEG] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SUM_PARTIAL_SUC] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) + [SUM_PARTIAL_SUC] THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= d * f1 /\ &0 <= dd /\ abs(en - cn) <= d / &4 * f1 + ==> abs(s - (cn - cN)) <= d / &4 * f1 - dd + ==> abs(s - en + cN) <= d / &2 * f1`) THEN + REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_SUB_RDISTRIB] THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LE_MUL) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_DIV; REAL_LT_IMP_LE; REAL_OF_NUM_LT; + ARITH; LE_ADD; ARITH_RULE `N + 1 <= n ==> N <= n + 1`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; ARITH_RULE `N + 1 <= n ==> N <= n`; + ARITH_RULE `N + 1 <= n ==> N <= n + 1`]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + USE_THEN "g" (MP_TAC o MATCH_MP REALLIM_LMUL) THEN + DISCH_THEN(MP_TAC o SPEC + `sum(1..N) (\k. e k * (f (k + 1) - f k)) - c * f(N + 1)`) THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP REAL_SEQ_OFFSET) THEN + REWRITE_TAC[REAL_MUL_RZERO; tendsto_real; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N + 1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `N + 1 <= n`)) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_INV] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_ARITH `&0 < x ==> abs x = x`; + ARITH_RULE `N + 1 <= n ==> N <= n + 1`; REAL_LT_LDIV_EQ] THEN + SUBGOAL_THEN `1 <= N + 1 /\ N <= n` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN + REAL_ARITH_TAC);; + +let SUM_PARTIAL_LIMIT_ALT = prove + (`!f e b c M. + (!k. M <= k ==> &0 < f k) /\ + (!k. M <= k ==> f(k) <= f(k + 1)) /\ + ((\k. inv(f k)) ---> &0) sequentially /\ + ((\n. f(n + 1) / f n) ---> b) sequentially /\ + (e ---> c) sequentially + ==> ((\n. (sum(1..n) (\k. e(k) * (f(k + 1) - f(k))) - e(n) * f(n + 1)) / + f(n)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\n. ((sum(1..n) (\k. e(k) * (f(k + 1) - f(k))) - e(n) * f(n + 1)) / + f(n + 1)) * (f(n + 1) / f(n))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `M:num` THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < a /\ &0 < b ==> x / b * b / a = x / a`; + ARITH_RULE `M <= n ==> M <= n + 1`]; + ALL_TAC] THEN + SUBST1_TAC(REAL_ARITH `&0 = &0 * b`) THEN + MATCH_MP_TAC REALLIM_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_PARTIAL_LIMIT THEN ASM_MESON_TAC[]);; + +let REALLIM_NA_OVER_N = prove + (`!a. ((\n. (&n + a) / &n) ---> &1) sequentially`, + GEN_TAC THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n:num. &1` THEN REWRITE_TAC[REALLIM_CONST] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[REALLIM_1_OVER_N]]);; + +let REALLIM_N_OVER_NA = prove + (`!a. ((\n. &n / (&n + &1)) ---> &1) sequentially`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_1] THEN + MATCH_MP_TAC REALLIM_INV THEN + REWRITE_TAC[REALLIM_NA_OVER_N] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let REALLIM_LOG1_OVER_LOG = prove + (`((\n. log(&n + &1) / log(&n)) ---> &1) sequentially`, + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. &1 + log(&1 + &1 / &n) / log(&n)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LOG_POS_LT; REAL_ARITH `&2 <= x ==> &1 < x`; + REAL_FIELD `&0 < x ==> (&1 + a / x = b / x <=> x + a = b)`] THEN + ASM_SIMP_TAC[GSYM LOG_MUL; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; + REAL_LE_DIV; REAL_POS; REAL_ARITH `&2 <= x ==> &0 < x`] THEN + AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN + EXISTS_TAC `\n. inv(&n)` THEN REWRITE_TAC[REALLIM_1_OVER_N] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div; REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + ASM_SIMP_TAC[LOG_POS; REAL_LE_INV_EQ; REAL_POS; + REAL_ARITH `&0 <= x ==> &1 <= &1 + x`] THEN + MATCH_MP_TAC LOG_LE THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * log(&2)` THEN + CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= abs b`) THEN + MATCH_MP_TAC LOG_MONO_LE_IMP THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC);; + +let REALLIM_LOG_OVER_LOG1 = prove + (`((\n. log(&n) / log(&n + &1)) ---> &1) sequentially`, + ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_1] THEN + MATCH_MP_TAC REALLIM_INV THEN + REWRITE_TAC[REALLIM_LOG1_OVER_LOG] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let ADHOC_BOUND_LEMMA = prove + (`!k. 1 <= k ==> abs((&k + &1) * (log(&k + &1) - log(&k)) - &1) + <= &2 / &k`, + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + GEN_TAC THEN DISCH_TAC THEN MP_TAC(ISPECL + [`\n z. if n = 0 then clog z + else if n = 1 then inv z + else --inv(z pow 2)`; + `Cx(&k + &1)`; `Cx(&k)`; `1`] + COMPLEX_TAYLOR_MVT) THEN + REWRITE_TAC[ARITH; ADD_EQ_0] THEN + CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_DIV_1; complex_pow; COMPLEX_POW_1; COMPLEX_VEC_0] THEN + REWRITE_TAC[GSYM CX_SUB; COMPLEX_ADD_RID; + REAL_ARITH `k - (k + &1) = -- &1`] THEN + REWRITE_TAC[CX_SUB; CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; + COMPLEX_NEG_NEG; COMPLEX_MUL_RID] THEN + ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`; `z:complex`] THEN + REWRITE_TAC[ARITH_RULE `n <= 1 <=> n = 0 \/ n = 1`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[ARITH] THEN + COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_MUL_LID; complex_div; COMPLEX_MUL_LNEG] THEN + REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX_GEN]) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `z:complex` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX_GEN]) THEN + STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &k /\ &0 < &k + &1` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[RE_ADD] THEN + ONCE_REWRITE_TAC[REAL_RING `w:real = z + u <=> w - z = u`] THEN + ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_INV; GSYM CX_ADD; GSYM CX_SUB; + GSYM CX_NEG; RE_CX] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) (&k + &1)`) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < x ==> x * (y - (z + --inv x)) = &1 - x * (z - y)`] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN + REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM CX_SUB; GSYM CX_MUL; GSYM CX_POW; GSYM CX_INV; RE_CX] THEN + REWRITE_TAC[REAL_POW_2; GSYM REAL_POW_INV; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c * d = (a * b:real) * (c * d)`] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; + REAL_ARITH `&0 < x ==> abs x = x`] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC);; + +let REALLIM_MUL_SERIES = prove + (`!x y z B. + eventually (\n. &0 < x n) sequentially /\ + eventually (\n. &0 < y n) sequentially /\ + eventually (\n. &0 < z n) sequentially /\ + ((\n. inv(z n)) ---> &0) sequentially /\ + eventually (\n. abs(sum (1..n) x / z(n)) <= B) sequentially /\ + ((\n. y(n) / x(n)) ---> &0) sequentially + ==> ((\n. sum (1..n) y / z(n)) ---> &0) sequentially`, + REWRITE_TAC[CONJ_ASSOC; GSYM EVENTUALLY_AND] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[tendsto_real] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ASSUME + `eventually (\n. &0 < x n /\ &0 < y n /\ &0 < z n) sequentially`) THEN + MP_TAC(ASSUME `((\n. y n / x n) ---> &0) sequentially`) THEN + REWRITE_TAC[tendsto_real] THEN + DISCH_THEN(MP_TAC o SPEC `e / (&2 * (&1 + abs B))`) THEN ANTS_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_HALF; IMP_IMP; GSYM EVENTUALLY_AND] THEN + GEN_REWRITE_TAC LAND_CONV [EVENTUALLY_SEQUENTIALLY] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ASSUME `((\n. inv (z n)) ---> &0) sequentially`) THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_LMUL) THEN + DISCH_THEN(MP_TAC o SPEC + `e / (&2 * (&1 + abs B)) * abs(sum(1..N) x) + abs(sum(1..N) y)`) THEN + REWRITE_TAC[REAL_MUL_RZERO; tendsto_real; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MP_TAC(ASSUME + `eventually (\n. abs (sum (1..n) x / z n) <= B) sequentially`) THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `1 <= N + 1 /\ N <= n` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `!x. abs(x) / z(n:num) = abs(x / z n)` + (fun th -> REWRITE_TAC[th]) + THENL + [ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ARITH `&0 < n ==> abs n = n`; + ARITH_RULE `N + 1 <= n ==> N <= n`]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM real_div] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!y'. abs(y) <= y' /\ abs(x) + y' < e ==> abs(x + y) < e`) THEN + EXISTS_TAC `e / (&2 * (&1 + abs B)) * sum(N+1..n) x / z n` THEN + CONJ_TAC THENL + [REWRITE_TAC[real_div; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + MATCH_MP_TAC SUM_ABS_LE THEN + ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ABS_MUL; REAL_ABS_INV; + REAL_ARITH `&0 < n ==> abs n = n`; + ARITH_RULE `N + 1 <= n ==> N <= n`; + REAL_LE_RMUL_EQ; REAL_LT_INV_EQ; REAL_MUL_ASSOC; + GSYM REAL_LE_LDIV_EQ] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x /\ abs x < y ==> x <= y`) THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; + ARITH_RULE `N + 1 <= n ==> N <= n`]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(d * abs xN + abs yN) < e / &2 + ==> d * abs xN = abs(d * xN) /\ abs(d * xN + xn) <= e / &2 + ==> abs(yN) + xn < e`)) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM; + GSYM REAL_ADD_LDISTRIB; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < n ==> abs n = n`; + REAL_ARITH `abs(&1 + abs B) = &1 + abs B`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(e * inv(&2) * i) * x = (e * inv(&2)) * x * i`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs B`] THEN + ASM_REAL_ARITH_TAC);; + +let REALLIM_MUL_SERIES_LIM = prove + (`!x y z l. + eventually (\n. &0 < x n) sequentially /\ + eventually (\n. &0 < y n) sequentially /\ + eventually (\n. &0 < z n) sequentially /\ + ((\n. inv(z n)) ---> &0) sequentially /\ + ((\n. sum (1..n) x / z(n)) ---> l) sequentially /\ + ((\n. y(n) / x(n)) ---> &0) sequentially + ==> ((\n. sum (1..n) y / z(n)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_MUL_SERIES THEN + EXISTS_TAC `x:num->real` THEN + MP_TAC(MATCH_MP REAL_CONVERGENT_IMP_BOUNDED + (ASSUME `((\n. sum (1..n) x / z n) ---> l) sequentially`)) THEN + REWRITE_TAC[real_bounded] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_SIMP_TAC[ALWAYS_EVENTUALLY; FORALL_IN_IMAGE; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Finally, the Prime Number Theorem! *) +(* ------------------------------------------------------------------------- *) + +let PNT = prove + (`((\n. &(CARD {p | prime p /\ p <= n}) / (&n / log(&n))) + ---> &1) sequentially`, + REWRITE_TAC[PNT_PARTIAL_SUMMATION] THEN + REWRITE_TAC[SUM_PARTIAL_PRE] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; SUB_REFL; CONJUNCT1 LE] THEN + SUBGOAL_THEN `{p | prime p /\ p = 0} = {}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + MESON_TAC[PRIME_IMP_NZ]; + ALL_TAC] THEN + REWRITE_TAC[SUM_CLAUSES; REAL_MUL_RZERO; REAL_SUB_RZERO] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\n. ((&n + &1) / log(&n + &1) * + sum {p | prime p /\ p <= n} (\p. log(&p) / &p) - + sum (1..n) + (\k. sum {p | prime p /\ p <= k} (\p. log(&p) / &p) * + ((&k + &1) / log(&k + &1) - &k / log(&k)))) / (&n / log(&n))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN SIMP_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_TRANSFORM THEN + EXISTS_TAC + `\n. ((&n + &1) / log(&n + &1) * log(&n) - + sum (1..n) + (\k. log(&k) * ((&k + &1) / log(&k + &1) - &k / log(&k)))) / + (&n / log(&n))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH + `(a * x - s) / b - (a * x' - s') / b:real = + ((s' - s) - (x' - x) * a) / b`] THEN + REWRITE_TAC[GSYM SUM_SUB_NUMSEG; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC SUM_PARTIAL_LIMIT_ALT THEN + EXISTS_TAC `&1` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `16` THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[MERTENS_LIMIT] THEN REWRITE_TAC[REAL_INV_DIV] THEN + SIMP_TAC[REAL_LT_DIV; LOG_POS_LT; REAL_OF_NUM_LT; + ARITH_RULE `16 <= n ==> 0 < n /\ 1 < n`] THEN + REWRITE_TAC[REALLIM_LOG_OVER_N] THEN CONJ_TAC THENL + [ALL_TAC; + MP_TAC(CONJ REALLIM_LOG_OVER_LOG1 (SPEC `&1` REALLIM_NA_OVER_N)) THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_MUL) THEN + REWRITE_TAC[REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_ADD_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; real_div; REAL_INV_MUL; REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_AC]] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MP_TAC(SPECL [`\z. z / clog z`; `\z. inv(clog z) - inv(clog z) pow 2`; + `Cx(&n)`; `Cx(&n + &1)`] + COMPLEX_MVT_LINE) THEN + REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN + REWRITE_TAC[REAL_ARITH `~(n + &1 <= x /\ x <= n)`] THEN ANTS_TAC THENL + [X_GEN_TAC `z:complex` THEN STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL + [SUBGOAL_THEN `~(z = Cx(&0))` MP_TAC THENL + [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < Re z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN + REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_ARITH `&16 <= x ==> &0 < x`] THEN + REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC LOG_POS_LT THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `z:complex` + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN + REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN `&0 < Re z /\ &0 < &n /\ &0 < &n + &1` STRIP_ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_POW; GSYM CX_INV; GSYM CX_SUB; + GSYM CX_DIV; RE_CX; GSYM CX_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_LE] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_SUB; REAL_MUL_RID] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN + REWRITE_TAC[REAL_ARITH `x pow 2 <= x <=> x * x <= x * &1`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC LOG_POS THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN + CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC LOG_MONO_LE_IMP THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN ONCE_REWRITE_TAC[SUM_PARTIAL_SUC] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\n. ((&n + &1) / log(&n + &1) * (log(&n) - log(&n + &1)) + + sum(1..n) (\k. (&k + &1) / log(&k + &1) * + (log(&k + &1) - log(&k)))) / (&n / log(&n))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[REAL_OF_NUM_ADD; LOG_1; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_SEQ_OFFSET_REV THEN EXISTS_TAC `1` THEN + REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC i`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `a * (x - y) + s + a * (y - x):real = s`] THEN + MATCH_MP_TAC REALLIM_TRANSFORM THEN + EXISTS_TAC + `\n. sum(1..n) (\k. &1 / log(&k + &1) - &1 / log(&k + &1) pow 2) / + ((&n + &1) / log(&n + &1))` THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_TRANSFORM_STRADDLE THEN + EXISTS_TAC `\n. ((&n + &2) / log (&n + &2) + + (sum(1..15) (\k. &1 / log(&k + &1) - &1 / log(&k + &1) pow 2) - + &17 / log (&17))) / ((&n + &1) / log (&n + &1))` THEN + EXISTS_TAC `\n. ((&n + &1) / log(&n + &1) + + (sum(1..15) (\k. &1 / log(&k + &1) - &1 / log(&k + &1) pow 2) - + &16 / log (&16))) / ((&n + &1) / log (&n + &1))` THEN + MP_TAC(GEN `n:num` (ISPECL + [`\z. Cx(&1) / clog(z + Cx(&1)) - Cx(&1) / (clog(z + Cx(&1))) pow 2`; + `\z. (z + Cx(&1)) / clog(z + Cx(&1))`; + `16`; `n:num`] + SUM_INTEGRAL_BOUNDS_DECREASING)) THEN + MATCH_MP_TAC(MESON[] + `(!n. P n ==> Q n) /\ ((!n. P n ==> R n) ==> s) + ==> (!n. P n /\ Q n ==> R n) ==> s`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN DISCH_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + STRIP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + COMPLEX_DIFF_TAC THEN + REWRITE_TAC[RE_ADD; RE_CX; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL + [SUBGOAL_THEN `~(z + Cx(&1) = Cx(&0))` MP_TAC THENL + [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN SIMP_TAC[RE_ADD; RE_CX] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM real]) THEN + REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[GSYM CX_ADD; GSYM CX_LOG; RE_CX; REAL_CX; + REAL_ARITH `&15 <= z ==> &0 < z + &1`; CX_INJ] THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC LOG_POS_LT THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `&15 <= y` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_ADD; GSYM CX_LOG; RE_CX; + REAL_ARITH `&15 <= x ==> &0 < x + &1`] THEN + REWRITE_TAC[GSYM CX_DIV; GSYM CX_SUB; RE_CX; GSYM CX_POW] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_POW_INV] THEN + REWRITE_TAC[REAL_ARITH + `x - x pow 2 <= y - y pow 2 <=> + (x + y) * (y - x) <= &1 * (y - x)`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + MATCH_MP_TAC(REAL_ARITH + `x <= inv(&2) /\ y <= x + ==> y + x <= &1 /\ &0 <= x - y`) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN + CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LOG_POS_LT THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC LOG_MONO_LE_IMP THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM real_div]; + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LOG_POS THEN REAL_ARITH_TAC] THEN + SUBGOAL_THEN `1 <= 15 + 1 /\ 15 <= n` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> + REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o C MATCH_MP (ASSUME `16 <= n`)) THEN + REWRITE_TAC[GSYM CX_ADD; REAL_ARITH `(n + &1) + &1 = n + &2`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; ARITH; + REAL_ARITH `&0 < &n + &1 /\ &0 < &n + &2`] THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN + REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL + [MP_TAC(CONJ REALLIM_LOG_OVER_LOG1 (SPEC `&1` REALLIM_NA_OVER_N)) THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_MUL) THEN + REWRITE_TAC[REAL_MUL_LID] THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP REAL_SEQ_OFFSET) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_ADD_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; real_div; REAL_INV_MUL; REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_AC]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[GSYM real_div; REAL_INV_DIV] THEN + MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_LOG_OVER_N)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM real_div]; + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LOG_POS THEN REAL_ARITH_TAC] THEN + SUBGOAL_THEN `1 <= 15 + 1 /\ 15 <= n` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> + REWRITE_TAC[GSYM(MATCH_MP SUM_COMBINE_R th)]) THEN + FIRST_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP (ASSUME `16 <= n`)) THEN + REWRITE_TAC[GSYM CX_ADD; REAL_ARITH `(n + &1) + &1 = n + &2`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; ARITH; + REAL_ARITH `&0 < &n + &1 /\ &0 < &n + &2`] THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; GSYM CX_SUB; RE_CX] THEN + REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n:num. &1` THEN REWRITE_TAC[REALLIM_CONST] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN X_GEN_TAC `n:num` THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < log(&n + &1)` ASSUME_TAC THENL + [ALL_TAC; POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD] THEN + MATCH_MP_TAC LOG_POS_LT THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[GSYM real_div; REAL_INV_DIV] THEN + MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_LOG_OVER_N)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD]]; + ALL_TAC] THEN + DISCH_TAC THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN + EXISTS_TAC `\n. sum(1..n) (\k. &1 / log(&k + &1) pow 2 + + &2 / (&k * log(&k + &1))) / + ((&n + &1) / log(&n + &1))` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL + [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_INV_DIV; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC LOG_POS; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ abs(a - b) <= y ==> abs(a - x - b) <= x + y`) THEN + CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC LOG_POS THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `&1 / l - m1 / l * x:real = --((m1 * x - &1) / l)`] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_MUL; real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[GSYM real_div; ADHOC_BOUND_LEMMA] THEN + REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`; REAL_LE_INV_EQ] THEN + MATCH_MP_TAC LOG_POS THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN + EXISTS_TAC `\n. sum(1..n) (\k. &3 / log(&k + &1) pow 2) / + ((&n + &1) / log(&n + &1))` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL + [EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[GSYM real_div] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_INV_DIV; REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC LOG_POS; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ y <= x + ==> abs(&1 * x + &2 * y) <= &3 * x`) THEN + SUBGOAL_THEN `&0 < log(&m + &1)` ASSUME_TAC THENL + [MATCH_MP_TAC LOG_POS_LT THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_POW_2; REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_MP_TAC LOG_LE THEN + REWRITE_TAC[REAL_POS]; + ALL_TAC] THEN + REWRITE_TAC[real_div; SUM_LMUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC REALLIM_MUL_SERIES_LIM THEN + MAP_EVERY EXISTS_TAC + [`\n. &1 / log(&n + &1) - &1 / log(&n + &1) pow 2`; `&1`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `16` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + SUBGOAL_THEN `&1 < log(&n + &1)` + (fun th -> SIMP_TAC[th; REAL_ARITH `&1 < x ==> &0 < x`; REAL_SUB_LT; + REAL_LT_MUL; REAL_ARITH `x < x pow 2 <=> &0 < x * (x - &1)`]) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN + CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC LOG_MONO_LT_IMP THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[REAL_LT_INV_EQ; LOG_POS_LT; REAL_POW_LT; + REAL_ARITH `&1 <= x ==> &1 < x + &1`; REAL_OF_NUM_LE]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[REAL_LT_INV_EQ; LOG_POS_LT; REAL_POW_LT; + REAL_ARITH `&1 <= x ==> &1 < x + &1`; REAL_OF_NUM_LE; + REAL_LT_DIV; REAL_ARITH `&0 < &n + &1`]; + MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_LOG_OVER_N)) THEN + REWRITE_TAC[REAL_INV_DIV; GSYM REAL_OF_NUM_ADD]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN + EXISTS_TAC `\n. &2 / log(&n + &1)` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN + MP_TAC(SPEC `1` (MATCH_MP REAL_SEQ_OFFSET REALLIM_1_OVER_LOG)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD]] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `42` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `&2 < log(&n + &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&4 * log(&2)` THEN + CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[GSYM LOG_POW; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC LOG_MONO_LT_IMP THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_INV; REAL_ABS_POW; + REAL_ARITH `&2 < x ==> abs x = x`] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_POW_LT; + REAL_ARITH `&2 < x ==> &0 < x`] THEN + ASM_SIMP_TAC[REAL_FIELD + `&2 < l ==> (inv(l) * &2) * l pow 2 = inv(inv(&2 * l))`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_INV_MUL; real_div; GSYM REAL_POW_INV; REAL_MUL_LID] THEN + MATCH_MP_TAC(REAL_ARITH + `l pow 2 <= l / &2 + ==> inv(&2) * l <= abs(l - l pow 2)`) THEN + REWRITE_TAC[REAL_ARITH `l pow 2 <= l / &2 <=> &0 <= (&1 / &2 - l) * l`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_SUB_LE; + ARITH_RULE `&2 < x ==> &0 <= x`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC);; diff --git a/100/polyhedron.ml b/100/polyhedron.ml new file mode 100644 index 0000000..712b050 --- /dev/null +++ b/100/polyhedron.ml @@ -0,0 +1,2206 @@ +(* ========================================================================= *) +(* Formalization of Jim Lawrence's proof of Euler's relation. *) +(* ========================================================================= *) + +needs "Multivariate/polytope.ml";; +needs "Library/binomial.ml";; +needs "100/inclusion_exclusion.ml";; +needs "100/combinations.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Interpret which "side" of a hyperplane a point is on. *) +(* ------------------------------------------------------------------------- *) + +let hyperplane_side = new_definition + `hyperplane_side (a,b) (x:real^N) = real_sgn (a dot x - b)`;; + +(* ------------------------------------------------------------------------- *) +(* Equivalence relation imposed by a hyperplane arrangement. *) +(* ------------------------------------------------------------------------- *) + +let hyperplane_equiv = new_definition + `hyperplane_equiv A x y <=> + !h. h IN A ==> hyperplane_side h x = hyperplane_side h y`;; + +let HYPERPLANE_EQUIV_REFL = prove + (`!A x. hyperplane_equiv A x x`, + REWRITE_TAC[hyperplane_equiv]);; + +let HYPERPLANE_EQUIV_SYM = prove + (`!A x y. hyperplane_equiv A x y <=> hyperplane_equiv A y x`, + REWRITE_TAC[hyperplane_equiv; EQ_SYM_EQ]);; + +let HYPERPLANE_EQUIV_TRANS = prove + (`!A x y z. + hyperplane_equiv A x y /\ hyperplane_equiv A y z + ==> hyperplane_equiv A x z`, + REWRITE_TAC[hyperplane_equiv] THEN MESON_TAC[]);; + +let HYPERPLANE_EQUIV_UNION = prove + (`!A B x y. hyperplane_equiv (A UNION B) x y <=> + hyperplane_equiv A x y /\ hyperplane_equiv B x y`, + REWRITE_TAC[hyperplane_equiv; IN_UNION] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cells of a hyperplane arrangement. *) +(* ------------------------------------------------------------------------- *) + +let hyperplane_cell = new_definition + `hyperplane_cell A c <=> ?x. c = hyperplane_equiv A x`;; + +let HYPERPLANE_CELL = prove + (`hyperplane_cell A c <=> ?x. c = {y | hyperplane_equiv A x y}`, + REWRITE_TAC[EXTENSION; hyperplane_cell; IN_ELIM_THM; IN] THEN + MESON_TAC[]);; + +let NOT_HYPERPLANE_CELL_EMPTY = prove + (`!A. ~(hyperplane_cell A {})`, + REWRITE_TAC[hyperplane_cell; EXTENSION; NOT_IN_EMPTY] THEN + MESON_TAC[HYPERPLANE_EQUIV_REFL; IN]);; + +let NONEMPTY_HYPERPLANE_CELL = prove + (`!A c. hyperplane_cell A c ==> ~(c = {})`, + MESON_TAC[NOT_HYPERPLANE_CELL_EMPTY]);; + +let UNIONS_HYPERPLANE_CELLS = prove + (`!A. UNIONS {c | hyperplane_cell A c} = (:real^N)`, + REWRITE_TAC[EXTENSION; IN_UNIONS; IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[hyperplane_cell] THEN MESON_TAC[HYPERPLANE_EQUIV_REFL; IN]);; + +let DISJOINT_HYPERPLANE_CELLS = prove + (`!A c1 c2. hyperplane_cell A c1 /\ hyperplane_cell A c2 /\ ~(c1 = c2) + ==> DISJOINT c1 c2`, + REWRITE_TAC[hyperplane_cell] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + ASM_REWRITE_TAC[IN_DISJOINT; IN; EXTENSION] THEN + ASM_MESON_TAC[HYPERPLANE_EQUIV_TRANS; HYPERPLANE_EQUIV_SYM]);; + +let DISJOINT_HYPERPLANE_CELLS_EQ = prove + (`!A c1 c2. hyperplane_cell A c1 /\ hyperplane_cell A c2 + ==> (DISJOINT c1 c2 <=> ~(c1 = c2))`, + MESON_TAC[NONEMPTY_HYPERPLANE_CELL; DISJOINT_HYPERPLANE_CELLS; + SET_RULE `DISJOINT s s <=> s = {}`]);; + +let HYPERPLANE_CELL_EMPTY = prove + (`hyperplane_cell {} c <=> c = (:real^N)`, + REWRITE_TAC[HYPERPLANE_CELL; NOT_IN_EMPTY; hyperplane_equiv] THEN + SET_TAC[]);; + +let HYPERPLANE_CELL_SING_CASES = prove + (`!a b c:real^N->bool. + hyperplane_cell {(a,b)} c + ==> c = {x | a dot x = b} \/ + c = {x | a dot x < b} \/ + c = {x | a dot x > b}`, + REWRITE_TAC[HYPERPLANE_CELL; hyperplane_equiv] THEN + REWRITE_TAC[FORALL_UNWIND_THM2; IN_SING; hyperplane_side] THEN + REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `y:real^N` MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC + (SPEC `(a:real^N) dot y - b` REAL_SGN_CASES) THEN + ASM_REWRITE_TAC[REAL_SGN_EQ] THEN + SIMP_TAC[REAL_SUB_0; REAL_SUB_LT; real_gt; + REAL_ARITH `x - y < &0 <=> x < y`]);; + +let HYPERPLANE_CELL_SING = prove + (`!a b c. + hyperplane_cell {(a,b)} c <=> + if a = vec 0 then c = (:real^N) + else c = {x | a dot x = b} \/ + c = {x | a dot x < b} \/ + c = {x | a dot x > b}`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [REWRITE_TAC[hyperplane_cell; hyperplane_equiv; EXTENSION; IN_UNIV] THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[hyperplane_equiv] THEN + ASM_SIMP_TAC[IN_SING; FORALL_UNWIND_THM2] THEN + REWRITE_TAC[hyperplane_side; DOT_LZERO]; + EQ_TAC THEN REWRITE_TAC[HYPERPLANE_CELL_SING_CASES] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[hyperplane_cell; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[hyperplane_equiv] THEN + ASM_SIMP_TAC[IN_SING; FORALL_UNWIND_THM2] THEN + REWRITE_TAC[hyperplane_side] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a dot x = b <=> a dot x - b = &0`; + REAL_ARITH `a > b <=> a - b > &0`; + REAL_ARITH `a < b <=> a - b < &0`] THEN + ONCE_REWRITE_TAC[GSYM REAL_SGN_EQ] THEN REWRITE_TAC[REAL_SUB_0] THEN + MATCH_MP_TAC(MESON[] + `(?x. f x = a) ==> (?x. !y. f y = a <=> f x = f y)`) THEN + REWRITE_TAC[REAL_SGN_EQ] THENL + [EXISTS_TAC `b / (a dot a) % a:real^N`; + EXISTS_TAC `(b - &1) / (a dot a) % a:real^N`; + EXISTS_TAC `(b + &1) / (a dot a) % a:real^N`] THEN + ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);; + +let HYPERPLANE_CELL_UNION = prove + (`!A B c:real^N->bool. + hyperplane_cell (A UNION B) c <=> + ~(c = {}) /\ + ?c1 c2. hyperplane_cell A c1 /\ + hyperplane_cell B c2 /\ + c = c1 INTER c2`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N->bool = {}` THENL + [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[HYPERPLANE_CELL; HYPERPLANE_EQUIV_UNION] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + REWRITE_TAC[MESON[] + `(?c1 c2. (?x. c1 = f x) /\ (?y. c2 = g y) /\ P c1 c2) <=> + (?x y. P (f x) (g y))`] THEN + EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[HYPERPLANE_EQUIV_TRANS; HYPERPLANE_EQUIV_SYM]);; + +let FINITE_HYPERPLANE_CELLS = prove + (`!A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cell A c}`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[HYPERPLANE_CELL_EMPTY; SING_GSPEC; FINITE_SING] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `A:(real^N#real)->bool`] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{ c1 INTER c2:real^N->bool | + c1 IN {c | hyperplane_cell A c} /\ + c2 IN {c | hyperplane_cell {(a,b)} c}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC + `{{x:real^N | a dot x = b},{x | a dot x < b},{x | a dot x > b}}` THEN + REWRITE_TAC[SUBSET; IN_SING; HYPERPLANE_CELL_SING_CASES; IN_ELIM_THM; + IN_INSERT; NOT_IN_EMPTY; FINITE_INSERT; FINITE_EMPTY]; + REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN MESON_TAC[INTER_COMM]]);; + +let FINITE_RESTRICT_HYPERPLANE_CELLS = prove + (`!P A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cell A c /\ P c}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{c:real^N->bool | hyperplane_cell A c}` THEN + ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLS] THEN SET_TAC[]);; + +let FINITE_SET_OF_HYPERPLANE_CELLS = prove + (`!A C. FINITE A /\ (!c:real^N->bool. c IN C ==> hyperplane_cell A c) + ==> FINITE C`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{c:real^N->bool | hyperplane_cell A c}` THEN + ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLS] THEN ASM SET_TAC[]);; + +let PAIRWISE_DISJOINT_HYPERPLANE_CELLS = prove + (`!A C. (!c. c IN C ==> hyperplane_cell A c) + ==> pairwise DISJOINT C`, + REWRITE_TAC[pairwise] THEN MESON_TAC[DISJOINT_HYPERPLANE_CELLS]);; + +let HYPERPLANE_CELL_INTER_OPEN_AFFINE = prove + (`!A c:real^N->bool. + FINITE A /\ hyperplane_cell A c + ==> ?s t. open s /\ affine t /\ c = s INTER t`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REWRITE_TAC[HYPERPLANE_CELL_EMPTY] THEN REPEAT STRIP_TAC THEN + REPEAT(EXISTS_TAC `(:real^N)`) THEN + ASM_REWRITE_TAC[AFFINE_UNIV; OPEN_UNIV; INTER_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `A:real^N#real->bool`] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN X_GEN_TAC `c':real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c1:real^N->bool`; `c:real^N->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN + STRIP_TAC THEN REWRITE_TAC[HYPERPLANE_CELL_SING] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN + ASM_REWRITE_TAC[INTER_UNIV]; + MAP_EVERY EXISTS_TAC + [`s:real^N->bool`; `{x:real^N | a dot x = b} INTER t`] THEN + ASM_REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC AFFINE_INTER THEN + ASM_REWRITE_TAC[AFFINE_HYPERPLANE]; + MAP_EVERY EXISTS_TAC + [`{x:real^N | a dot x < b} INTER s`; `t:real^N->bool`] THEN + ASM_REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC OPEN_INTER THEN + ASM_REWRITE_TAC[OPEN_HALFSPACE_LT]; + MAP_EVERY EXISTS_TAC + [`{x:real^N | a dot x > b} INTER s`; `t:real^N->bool`] THEN + ASM_REWRITE_TAC[INTER_ACI] THEN MATCH_MP_TAC OPEN_INTER THEN + ASM_REWRITE_TAC[OPEN_HALFSPACE_GT]]);; + +let HYPERPLANE_CELL_RELATIVELY_OPEN = prove + (`!A c:real^N->bool. + FINITE A /\ hyperplane_cell A c + ==> open_in (subtopology euclidean (affine hull c)) c`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HYPERPLANE_CELL_INTER_OPEN_AFFINE) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[OPEN_IN_EMPTY] THEN + SUBGOAL_THEN `affine hull (s INTER t:real^N->bool) = t` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `affine hull t:real^N->bool` THEN + ASM_REWRITE_TAC[AFFINE_HULL_EQ] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[INTER_COMM] + AFFINE_HULL_CONVEX_INTER_OPEN) THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX]; + ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_SIMP_TAC[OPEN_IN_OPEN_INTER]]);; + +let HYPERPLANE_CELL_RELATIVE_INTERIOR = prove + (`!A c:real^N->bool. + FINITE A /\ hyperplane_cell A c + ==> relative_interior c = c`, + MESON_TAC[RELATIVE_INTERIOR_OPEN_IN; HYPERPLANE_CELL_RELATIVELY_OPEN]);; + +let HYPERPLANE_CELL_CONVEX = prove + (`!A c:real^N->bool. hyperplane_cell A c ==> convex c`, + REPEAT GEN_TAC THEN REWRITE_TAC[HYPERPLANE_CELL] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` SUBST1_TAC) THEN + REWRITE_TAC[hyperplane_equiv] THEN + ONCE_REWRITE_TAC[SET_RULE `f x = f y <=> y IN {y | f x = f y}`] THEN + REWRITE_TAC[GSYM INTERS_IMAGE] THEN MATCH_MP_TAC CONVEX_INTERS THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN DISCH_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[hyperplane_side] THEN + REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC + (SPEC `(a:real^N) dot c - b` REAL_SGN_CASES) THEN + ASM_REWRITE_TAC[REAL_SGN_EQ] THEN + SIMP_TAC[REAL_SUB_0; REAL_ARITH `a - b > &0 <=> a > b`; + REAL_ARITH `a - b < &0 <=> a < b`] THEN + REWRITE_TAC[CONVEX_HALFSPACE_LT; CONVEX_HALFSPACE_GT; + CONVEX_HYPERPLANE]);; + +let HYPERPLANE_CELL_INTERS = prove + (`!A C. (!c:real^N->bool. c IN C ==> hyperplane_cell A c) /\ + ~(C = {}) /\ ~(INTERS C = {}) + ==> hyperplane_cell A (INTERS C)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HYPERPLANE_CELL; GSYM MEMBER_NOT_EMPTY] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + REWRITE_TAC[IN_INTERS] THEN DISCH_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THEN DISCH_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_TAC `c:real^N->bool`); + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN SIMP_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[HYPERPLANE_EQUIV_SYM; HYPERPLANE_EQUIV_TRANS]);; + +let HYPERPLANE_CELL_INTER = prove + (`!A s t:real^N->bool. + hyperplane_cell A s /\ hyperplane_cell A t /\ ~(s INTER t = {}) + ==> hyperplane_cell A (s INTER t)`, + REWRITE_TAC[GSYM INTERS_2] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HYPERPLANE_CELL_INTERS THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; NOT_INSERT_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* A cell complex is considered to be a union of such cells. *) +(* ------------------------------------------------------------------------- *) + +let hyperplane_cellcomplex = new_definition + `hyperplane_cellcomplex A s <=> + ?t. (!c. c IN t ==> hyperplane_cell A c) /\ + s = UNIONS t`;; + +let HYPERPLANE_CELLCOMPLEX_EMPTY = prove + (`!A:real^N#real->bool. hyperplane_cellcomplex A {}`, + GEN_TAC THEN REWRITE_TAC[hyperplane_cellcomplex] THEN + EXISTS_TAC `{}:(real^N->bool)->bool` THEN + REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0]);; + +let HYPERPLANE_CELL_CELLCOMPLEX = prove + (`!A c:real^N->bool. hyperplane_cell A c ==> hyperplane_cellcomplex A c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hyperplane_cellcomplex] THEN + EXISTS_TAC `{c:real^N->bool}` THEN + ASM_SIMP_TAC[IN_SING; UNIONS_1]);; + +let HYPERPLANE_CELLCOMPLEX_UNIONS = prove + (`!A C. (!s:real^N->bool. s IN C ==> hyperplane_cellcomplex A s) + ==> hyperplane_cellcomplex A (UNIONS C)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hyperplane_cellcomplex] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:(real^N->bool)->(real^N->bool)->bool` THEN DISCH_TAC THEN + EXISTS_TAC `UNIONS (IMAGE (f:(real^N->bool)->(real^N->bool)->bool) C)` THEN + REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[UNIONS_IMAGE]] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + ASM SET_TAC[]);; + +let HYPERPLANE_CELLCOMPLEX_UNION = prove + (`!A s t. + hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t + ==> hyperplane_cellcomplex A (s UNION t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; + +let HYPERPLANE_CELLCOMPLEX_UNIV = prove + (`!A. hyperplane_cellcomplex A (:real^N)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_HYPERPLANE_CELLS] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN + REWRITE_TAC[IN_ELIM_THM; HYPERPLANE_CELL_CELLCOMPLEX]);; + +let HYPERPLANE_CELLCOMPLEX_INTERS = prove + (`!A C. (!s:real^N->bool. s IN C ==> hyperplane_cellcomplex A s) + ==> hyperplane_cellcomplex A (INTERS C)`, + let lemma = prove + (`UNIONS s = UNIONS {t | t IN s /\ ~(t = {})}`, + REWRITE_TAC[UNIONS_GSPEC] THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[NOT_IN_EMPTY]) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `C:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; HYPERPLANE_CELLCOMPLEX_UNIV] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [hyperplane_cellcomplex] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:(real^N->bool)->(real^N->bool)->bool` THEN + DISCH_TAC THEN SUBGOAL_THEN + `C = {UNIONS((f:(real^N->bool)->(real^N->bool)->bool) s) | s IN C}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[INTERS_OVER_UNIONS] THEN ONCE_REWRITE_TAC[lemma] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HYPERPLANE_CELL_CELLCOMPLEX THEN + MATCH_MP_TAC HYPERPLANE_CELL_INTERS THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]);; + +let HYPERPLANE_CELLCOMPLEX_INTER = prove + (`!A s t. + hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t + ==> hyperplane_cellcomplex A (s INTER t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_INTERS THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; + +let HYPERPLANE_CELLCOMPLEX_COMPL = prove + (`!A s. hyperplane_cellcomplex A s + ==> hyperplane_cellcomplex A ((:real^N) DIFF s)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [hyperplane_cellcomplex] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `C:(real^N->bool)->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[UNIONS_INTERS; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_INTERS THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `(:real^N) DIFF c = UNIONS {c' | hyperplane_cell A c' /\ ~(c' = c)}` + SUBST1_TAC THENL + [SUBST1_TAC(SYM(ISPEC `A:real^N#real->bool` UNIONS_HYPERPLANE_CELLS)) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `c':real^N->bool` THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`A:real^N#real->bool`; `c:real^N->bool`; `c':real^N->bool`] + DISJOINT_HYPERPLANE_CELLS_EQ) THEN + ASM_SIMP_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN + ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX; IN_ELIM_THM]]);; + +let HYPERPLANE_CELLCOMPLEX_DIFF = prove + (`!A s t. + hyperplane_cellcomplex A s /\ hyperplane_cellcomplex A t + ==> hyperplane_cellcomplex A (s DIFF t)`, + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + SIMP_TAC[HYPERPLANE_CELLCOMPLEX_COMPL; HYPERPLANE_CELLCOMPLEX_INTER]);; + +let HYPERPLANE_CELLCOMPLEX_MONO = prove + (`!A B s:real^N->bool. + hyperplane_cellcomplex A s /\ A SUBSET B + ==> hyperplane_cellcomplex B s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [hyperplane_cellcomplex]) THEN + DISCH_THEN(X_CHOOSE_THEN `C:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `B:(real^N#real)->bool = A UNION (B DIFF A)` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[hyperplane_cellcomplex; HYPERPLANE_CELL_UNION] THEN + EXISTS_TAC `{c' INTER c:real^N->bool |c'| hyperplane_cell (B DIFF A) c' /\ + ~(c' INTER c = {})}` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `c':real^N->bool`] THEN + ASM_REWRITE_TAC[INTER_COMM]; + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [DISCH_TAC; MESON_TAC[]] THEN + MP_TAC(ISPEC `B DIFF A:(real^N#real)->bool` UNIONS_HYPERPLANE_CELLS) THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN ASM SET_TAC[]]);; + +let FINITE_HYPERPLANE_CELLCOMPLEXES = prove + (`!A. FINITE A ==> FINITE {c:real^N->bool | hyperplane_cellcomplex A c}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC + `IMAGE UNIONS {t | t SUBSET {c:real^N->bool | hyperplane_cell A c}}` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET; FINITE_HYPERPLANE_CELLS] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM; hyperplane_cellcomplex] THEN + MESON_TAC[]);; + +let FINITE_RESTRICT_HYPERPLANE_CELLCOMPLEXES = prove + (`!P A. FINITE A + ==> FINITE {c:real^N->bool | hyperplane_cellcomplex A c /\ P c}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{c:real^N->bool | hyperplane_cellcomplex A c}` THEN + ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLCOMPLEXES] THEN SET_TAC[]);; + +let FINITE_SET_OF_HYPERPLANE_CELLS = prove + (`!A C. FINITE A /\ (!c:real^N->bool. c IN C ==> hyperplane_cellcomplex A c) + ==> FINITE C`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{c:real^N->bool | hyperplane_cellcomplex A c}` THEN + ASM_SIMP_TAC[FINITE_HYPERPLANE_CELLCOMPLEXES] THEN ASM SET_TAC[]);; + +let CELL_SUBSET_CELLCOMPLEX = prove + (`!A s c:real^N->bool. + hyperplane_cell A c /\ hyperplane_cellcomplex A s + ==> (c SUBSET s <=> ~(DISJOINT c s))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [hyperplane_cellcomplex]) THEN + DISCH_THEN(X_CHOOSE_THEN `C:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN EQ_TAC THENL + [ASM_CASES_TAC `c:real^N->bool = {}` THENL + [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ASM SET_TAC[]]; + REWRITE_TAC[DISJOINT; INTER_UNIONS; GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `c':real^N->bool`] THEN + REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`A:(real^N#real)->bool`; `c:real^N->bool`; + `c':real^N->bool`] DISJOINT_HYPERPLANE_CELLS_EQ) THEN + ASM_SIMP_TAC[] THEN + ASM_CASES_TAC `c':real^N->bool = c` THENL + [DISCH_THEN(K ALL_TAC); ASM SET_TAC[]] THEN + MATCH_MP_TAC(SET_RULE `c IN C ==> c SUBSET UNIONS C`) THEN + ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Euler characteristic. *) +(* ------------------------------------------------------------------------- *) + +let euler_characteristic = new_definition + `euler_characteristic A (s:real^N->bool) = + sum {c | hyperplane_cell A c /\ c SUBSET s} + (\c. (-- &1) pow (num_of_int(aff_dim c)))`;; + +let EULER_CHARACTERISTIC_EMPTY = prove + (`euler_characteristic A {} = &0`, + REWRITE_TAC[euler_characteristic; SUBSET_EMPTY] THEN + MATCH_MP_TAC SUM_EQ_0 THEN + MATCH_MP_TAC(MESON[] `~(?x. x IN s) ==> (!x. x IN s ==> P x)`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[NONEMPTY_HYPERPLANE_CELL]);; + +let EULER_CHARACTERISTIC_CELL_UNIONS = prove + (`!A C. (!c:real^N->bool. c IN C ==> hyperplane_cell A c) + ==> euler_characteristic A (UNIONS C) = + sum C (\c. (-- &1) pow (num_of_int(aff_dim c)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[euler_characteristic] THEN + MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N->bool` THEN + EQ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `~(c:real^N->bool = {})` MP_TAC THENL + [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ALL_TAC] THEN + REWRITE_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_UNIONS] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c':real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(DISJOINT (c:real^N->bool) c')` MP_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[DISJOINT_HYPERPLANE_CELLS_EQ]]);; + +let EULER_CHARACTERISTIC_CELL = prove + (`!A c. hyperplane_cell A c + ==> euler_characteristic A c = (-- &1) pow (num_of_int(aff_dim c))`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN + ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELL_UNIONS; IN_SING; SUM_SING]);; + +let EULER_CHARACTERISTIC_CELLCOMPLEX_UNION = prove + (`!A s t:real^N->bool. + FINITE A /\ + hyperplane_cellcomplex A s /\ + hyperplane_cellcomplex A t /\ + DISJOINT s t + ==> euler_characteristic A (s UNION t) = + euler_characteristic A s + euler_characteristic A t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[euler_characteristic] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN + ASM_SIMP_TAC[FINITE_RESTRICT_HYPERPLANE_CELLS] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNION] THEN + CONJ_TAC THEN X_GEN_TAC `c:real^N->bool` THENL + [ASM_CASES_TAC `c:real^N->bool = {}` THENL + [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ASM SET_TAC[]]; + ASM_CASES_TAC `hyperplane_cell A (c:real^N->bool)` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `A:(real^N#real)->bool` CELL_SUBSET_CELLCOMPLEX) THEN + ASM_SIMP_TAC[HYPERPLANE_CELLCOMPLEX_UNION] THEN SET_TAC[]]);; + +let EULER_CHARACTERISTIC_CELLCOMPLEX_UNIONS = prove + (`!A C. FINITE A /\ + (!c:real^N->bool. c IN C ==> hyperplane_cellcomplex A c) /\ + pairwise DISJOINT C + ==> euler_characteristic A (UNIONS C) = + sum C (\c. euler_characteristic A c)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `FINITE(C:(real^N->bool)->bool)` THENL + [UNDISCH_TAC `FINITE(C:(real^N->bool)->bool)`; + ASM_MESON_TAC[FINITE_SET_OF_HYPERPLANE_CELLS]] THEN + SPEC_TAC(`C:(real^N->bool)->bool`,`C:(real^N->bool)->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[EULER_CHARACTERISTIC_EMPTY; SUM_CLAUSES; UNIONS_0] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_INSERT] THEN + W(MP_TAC o PART_MATCH (lhs o rand) EULER_CHARACTERISTIC_CELLCOMPLEX_UNION o + lhs o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_UNIONS THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + REWRITE_TAC[DISJOINT; INTER_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_INSERT; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[INTER_COMM]]; + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + ASM_REWRITE_TAC[pairwise] THEN ASM SET_TAC[]]);; + +let EULER_CHARACTERISTIC = prove + (`!A s:real^N->bool. + FINITE A + ==> euler_characteristic A s = + sum (0..dimindex(:N)) + (\d. (-- &1) pow d * + &(CARD {c | hyperplane_cell A c /\ c SUBSET s /\ + aff_dim c = &d}))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[euler_characteristic] THEN + MP_TAC(ISPECL [`\c:real^N->bool. aff_dim c`; + `\c:real^N->bool. (-- &1) pow (num_of_int(aff_dim c))`; + `{c:real^N->bool | hyperplane_cell A c /\ c SUBSET s}`; + `IMAGE int_of_num (0..dimindex(:N))`] + SUM_GROUP) THEN + SIMP_TAC[SUM_IMAGE; INT_OF_NUM_EQ; o_DEF; NUM_OF_INT_OF_NUM] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_RESTRICT_HYPERPLANE_CELLS] THEN + GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LE; INT_EXISTS_POS] THEN + EXISTS_TAC `aff_dim(c:real^N->bool)` THEN + REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_POS_LE] THEN + ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC] THEN + ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT_HYPERPLANE_CELLS] THEN + REWRITE_TAC[REAL_MUL_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the characteristic is invariant w.r.t. hyperplane arrangement. *) +(* ------------------------------------------------------------------------- *) + +let HYPERPLANE_CELLS_DISTINCT_LEMMA = prove + (`!a b. {x | a dot x = b} INTER {x | a dot x < b} = {} /\ + {x | a dot x = b} INTER {x | a dot x > b} = {} /\ + {x | a dot x < b} INTER {x | a dot x = b} = {} /\ + {x | a dot x < b} INTER {x | a dot x > b} = {} /\ + {x | a dot x > b} INTER {x | a dot x = b} = {} /\ + {x | a dot x > b} INTER {x | a dot x < b} = {}`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC);; + +let EULER_CHARACTERSTIC_LEMMA = prove + (`!A h s:real^N->bool. + FINITE A /\ hyperplane_cellcomplex A s + ==> euler_characteristic (h INSERT A) s = euler_characteristic A s`, + REWRITE_TAC[FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC + [`A:(real^N#real)->bool`; `a:real^N`; `b:real`; `s:real^N->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[hyperplane_cellcomplex] THEN + DISCH_THEN(X_CHOOSE_THEN `C:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN + `!c:real^N->bool. c IN C ==> hyperplane_cellcomplex A c /\ + hyperplane_cellcomplex ((a,b) INSERT A) c` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN + EXISTS_TAC `A:(real^N#real)->bool` THEN + ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX] THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `pairwise DISJOINT (C:(real^N->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[PAIRWISE_DISJOINT_HYPERPLANE_CELLS]; ALL_TAC] THEN + ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELLCOMPLEX_UNIONS; FINITE_INSERT] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `hyperplane_cell ((a,b) INSERT A) (c:real^N->bool)` THEN + ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELL] THEN + SUBGOAL_THEN `~(a:real^N = vec 0)` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + SIMP_TAC[CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN + REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN + REWRITE_TAC[HYPERPLANE_CELL_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + CONJ_TAC THENL [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[INTER_UNIV; UNWIND_THM1] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[euler_characteristic] THEN + ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN + REWRITE_TAC[HYPERPLANE_CELL_UNION] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum {c' INTER c |c'| hyperplane_cell {(a,b)} c' /\ ~(c' INTER c = {})} + (\c:real^N->bool. (-- &1) pow (num_of_int(aff_dim c)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `c':real^N->bool` THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c1:real^N->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `c2:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(DISJOINT c2 (c:real^N->bool))` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[DISJOINT_HYPERPLANE_CELLS_EQ]]; + DISCH_THEN(X_CHOOSE_THEN `c1:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[INTER_SUBSET] THEN + MAP_EVERY EXISTS_TAC [`c1:real^N->bool`; `c:real^N->bool`] THEN + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[HYPERPLANE_CELL_SING] THEN + SUBGOAL_THEN `~(c:real^N->bool = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]; ALL_TAC] THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {c} (\c:real^N->bool. (-- &1) pow num_of_int (aff_dim c))` THEN + CONJ_TAC THENL [ALL_TAC; SIMP_TAC[SUM_SING]] THEN + MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `c':real^N->bool` THEN + REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN + EQ_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `b:real`] HYPERPLANE_CELLS_DISTINCT_LEMMA) THEN + ASM SET_TAC[]; + ALL_TAC]) + [`c SUBSET {x:real^N | a dot x < b}`; + `c SUBSET {x:real^N | a dot x > b}`; + `c SUBSET {x:real^N | a dot x = b}`] THEN + SUBGOAL_THEN `~(c INTER {x:real^N | a dot x = b} = {})` ASSUME_TAC THENL + [SUBGOAL_THEN + `?u v:real^N. u IN c /\ ~(a dot u < b) /\ v IN c /\ ~(a dot v > b)` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[real_gt; REAL_NOT_LT; GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN SIMP_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `(a:real^N) dot u = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `(a:real^N) dot v = b` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + EXISTS_TAC `v + (b - a dot v) / (a dot u - a dot v) % (u - v):real^N` THEN + SUBGOAL_THEN `(a:real^N) dot v < a dot u` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[DOT_RADD; DOT_RMUL; DOT_RSUB; REAL_DIV_RMUL; REAL_SUB_LT; + REAL_LT_IMP_NZ; REAL_SUB_ADD2] THEN + REWRITE_TAC[VECTOR_ARITH + `v + a % (u - v):real^N = (&1 - a) % v + a % u`] THEN + MATCH_MP_TAC IN_CONVEX_SET THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_MESON_TAC[HYPERPLANE_CELL_CONVEX]; + ALL_TAC] THEN + SUBGOAL_THEN `~(c INTER {x:real^N | a dot x < b} = {}) /\ + ~(c INTER {x:real^N | a dot x > b} = {})` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `?u v:real^N. + u IN c /\ a dot u = b /\ v IN c /\ ~(a dot v = b) /\ ~(u = v)` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `open_in (subtopology euclidean (affine hull c)) (c:real^N->bool)` + MP_TAC THENL [ASM_MESON_TAC[HYPERPLANE_CELL_RELATIVELY_OPEN]; ALL_TAC] THEN + REWRITE_TAC[open_in] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `u:real^N`)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `u - e / &2 / norm(v - u) % (v - u):real^N`)) THEN + ANTS_TAC THENL + [REWRITE_TAC[NORM_ARITH `dist(u - a:real^N,u) = norm a`] THEN + REWRITE_TAC[VECTOR_ARITH `x - a % (y - z):real^N = x + a % (z - y)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REWRITE_TAC[REAL_ARITH `abs e / &2 < e <=> &0 < e`] THEN + MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]; + DISCH_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN + SUBGOAL_THEN `(a:real^N) dot v < b \/ a dot v > b` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `u - e / &2 / norm(v - u) % (v - u):real^N` THEN + ASM_REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN + REWRITE_TAC[REAL_ARITH `b - x * y > b <=> &0 < x * --y`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]] THEN + EXISTS_TAC `u - e / &2 / norm(v - u) % (v - u):real^N` THEN + ASM_REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN + REWRITE_TAC[REAL_ARITH `b - x * y > b <=> &0 < x * --y`; + REAL_ARITH `b - x < b <=> &0 < x`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {{x | a dot x = b} INTER c, + {x | a dot x > b} INTER c, + {x | a dot x < b} INTER c} + (\c:real^N->bool. (-- &1) pow (num_of_int(aff_dim c)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(MESON[] `s = t ==> sum s f = sum t f`) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `c':real^N->bool` THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2; GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN CONV_TAC TAUT; + ALL_TAC] THEN + SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; + IN_INSERT; NOT_IN_EMPTY] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + ASM_SIMP_TAC[HYPERPLANE_CELLS_DISTINCT_LEMMA; REAL_ADD_RID; SET_RULE + `s INTER t = {} /\ ~(c INTER s = {}) ==> ~(c INTER s = c INTER t)`] THEN + SUBGOAL_THEN + `aff_dim (c INTER {x:real^N | a dot x < b}) = aff_dim c /\ + aff_dim (c INTER {x:real^N | a dot x > b}) = aff_dim c` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN CONJ_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN + ASM_REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN + ASM_MESON_TAC[HYPERPLANE_CELL_CONVEX]; + ALL_TAC] THEN + SUBGOAL_THEN + `aff_dim c = aff_dim(c INTER {x:real^N | a dot x = b}) + &1` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`A:real^N#real->bool`; `c:real^N->bool`] + HYPERPLANE_CELL_INTER_OPEN_AFFINE) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SUBGOAL_THEN + `affine hull (s INTER t) = affine hull t /\ + affine hull ((s INTER t) INTER {x:real^N | a dot x = b}) = + affine hull (t INTER {x:real^N | a dot x = b})` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [REWRITE_TAC[INTER_ASSOC] THEN CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM] THEN + MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; AFFINE_IMP_CONVEX] THEN + ASM SET_TAC[]; + REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_SUB_ADD]) THEN + ASM SET_TAC[]]; + SUBGOAL_THEN `&0 <= aff_dim (c INTER {x:real^N | a dot x = b})` MP_TAC + THENL [REWRITE_TAC[AFF_DIM_POS_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN + SPEC_TAC(`aff_dim (c INTER {x:real^N | a dot x = b})`,`i:int`) THEN + REWRITE_TAC[GSYM INT_FORALL_POS] THEN + REWRITE_TAC[NUM_OF_INT_OF_NUM; INT_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_POW_ADD] THEN REAL_ARITH_TAC]);; + +let EULER_CHARACTERSTIC_INVARIANT = prove + (`!A B h s:real^N->bool. + FINITE A /\ FINITE B /\ + hyperplane_cellcomplex A s /\ hyperplane_cellcomplex B s + ==> euler_characteristic A s = euler_characteristic B s`, + SUBGOAL_THEN + `!A s:real^N->bool. + FINITE A /\ hyperplane_cellcomplex A s + ==> !B. FINITE B + ==> euler_characteristic (A UNION B) s = + euler_characteristic A s` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_REWRITE_TAC[UNION_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`h:real^N#real`; `B:real^N#real->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SET_RULE `s UNION (x INSERT t) = x INSERT (s UNION t)`] THEN + MATCH_MP_TAC EULER_CHARACTERSTIC_LEMMA THEN + ASM_REWRITE_TAC[FINITE_UNION] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN + EXISTS_TAC `A:real^N#real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `euler_characteristic (A UNION B) (s:real^N->bool)` THEN + ASM_MESON_TAC[UNION_COMM]]);; + +let EULER_CHARACTERISTIC_INCLUSION_EXCLUSION = prove + (`!A s:(real^N->bool)->bool. + FINITE A /\ FINITE s /\ (!k. k IN s ==> hyperplane_cellcomplex A k) + ==> euler_characteristic A (UNIONS s) = + sum {t | t SUBSET s /\ ~(t = {})} + (\t. (-- &1) pow (CARD t + 1) * + euler_characteristic A (INTERS t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`hyperplane_cellcomplex A :(real^N->bool)->bool`; + `euler_characteristic A :(real^N->bool)->real`; + `s:(real^N->bool)->bool`] + INCLUSION_EXCLUSION_REAL_RESTRICTED) THEN + ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELLCOMPLEX_UNION] THEN + SIMP_TAC[HYPERPLANE_CELLCOMPLEX_EMPTY; HYPERPLANE_CELLCOMPLEX_INTER; + HYPERPLANE_CELLCOMPLEX_UNION; HYPERPLANE_CELLCOMPLEX_DIFF]);; + +(* ------------------------------------------------------------------------- *) +(* Euler-type relation for full-dimensional proper polyhedral cones. *) +(* ------------------------------------------------------------------------- *) + +let EULER_POLYHEDRAL_CONE = prove + (`!s. polyhedron s /\ conic s /\ ~(interior s = {}) /\ ~(s = (:real^N)) + ==> sum (0..dimindex(:N)) + (\d. (-- &1) pow d * + &(CARD {f | f face_of s /\ aff_dim f = &d })) = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `affine hull s = (:real^N)` ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN + EXISTS_TAC `affine hull (interior s:real^N->bool)` THEN + SIMP_TAC[INTERIOR_SUBSET; HULL_MONO] THEN + MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]; + ALL_TAC] THEN + FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN + ASM_REWRITE_TAC[INTER_UNIV; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `H:(real^N->bool)->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(vec 0:real^N) IN s` ASSUME_TAC THENL + [ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN + ASM_MESON_TAC[SUBSET_EMPTY; INTERIOR_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN + `!h:real^N->bool. h IN H ==> ?a. ~(a = vec 0) /\ h = {x | a dot x <= &0}` + MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `a:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `b = &0` SUBST_ALL_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= b /\ ~(&0 < b) ==> b = &0`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(vec 0:real^N) IN INTERS H` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[IN_INTERS]] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]; + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `H DELETE (h:real^N->bool)`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC o CONJUNCT2) THEN + SUBGOAL_THEN `?e. &0 < e /\ e < &1 /\ + (e % x:real^N) IN h` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `min (&1 / &2) (b / ((a:real^N) dot x))` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RMUL] THEN + SUBGOAL_THEN `&0 < (a:real^N) dot x` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `b:real` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~((x:real^N) IN s)` THEN EXPAND_TAC "s" THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `H:(real^N->bool)->bool = h INSERT (H DELETE h)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[INTERS_INSERT; IN_INTER] THEN + ASM_REWRITE_TAC[IN_ELIM_THM]; + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_MIN_LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC]; + UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `x:real^N = inv e % e % x` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; + VECTOR_MUL_LID]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ] THEN + EXPAND_TAC "s" THEN + SUBGOAL_THEN `H:(real^N->bool)->bool = h INSERT (H DELETE h)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[INTERS_INSERT; IN_INTER] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `(x:real^N) IN INTERS (H DELETE h)` THEN + REWRITE_TAC[IN_INTERS] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `k:real^N->bool` THEN REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a':real^N`; `b':real`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 <= x ==> y <= x) /\ (&0 <= --x ==> &0 <= --y) /\ &0 <= b + ==> x <= b ==> y <= b`) THEN + REWRITE_TAC[DOT_RMUL; GSYM REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_ARITH `e * x <= x <=> &0 <= x * (&1 - e)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + SUBGOAL_THEN `(vec 0:real^N) IN INTERS H` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[IN_INTERS]] THEN + DISCH_THEN(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]]]; + FIRST_X_ASSUM(K ALL_TAC o SPEC `h:real^N->bool`)] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `fa:(real^N->bool)->real^N` THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o funpow 2 RAND_CONV) + [EQ_SYM_EQ] THEN + DISCH_TAC THEN ABBREV_TAC + `A = IMAGE (\h. (fa:(real^N->bool)->real^N) h,&0) H` THEN + SUBGOAL_THEN `FINITE(A:real^N#real->bool)` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `euler_characteristic A (s:real^N->bool)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[EULER_CHARACTERISTIC] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN + ASM_SIMP_TAC[FINITE_RESTRICT_HYPERPLANE_CELLS] THEN + EXISTS_TAC `relative_interior:(real^N->bool)->(real^N->bool)` THEN + EXISTS_TAC `closure:(real^N->bool)->(real^N->bool)` THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `closure(relative_interior f):real^N->bool = f` + ASSUME_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `closure f:real^N->bool` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_CLOSURE_RELATIVE_INTERIOR THEN + ASM_MESON_TAC[FACE_OF_IMP_CONVEX]; + REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC FACE_OF_IMP_CLOSED THEN + ASM_MESON_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CLOSURE] THEN + ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET_TRANS; + FACE_OF_IMP_SUBSET]] THEN + SUBGOAL_THEN `~(f:real^N->bool = {})` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM AFF_DIM_POS_LE; INT_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `?J. J SUBSET H /\ + f = INTERS {{x:real^N | fa h dot x <= &0} | h IN H} INTER + INTERS {{x | fa(h:real^N->bool) dot x = &0} | h IN J}` + ASSUME_TAC THENL + [ASM_CASES_TAC `f:real^N->bool = s` THENL + [EXISTS_TAC `{}:(real^N->bool)->bool` THEN + REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY; INTERS_0; INTER_UNIV; + SET_RULE `{f x | x | F} = {}`] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SYM(ASSUME `INTERS H = (s:real^N->bool)`)] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = x) ==> s = {f x | x IN s}`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + EXISTS_TAC + `{h:real^N->bool | h IN H /\ + f SUBSET s INTER {x:real^N | fa h dot x = &0}}` THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `H:(real^N->bool)->bool`; + `fa:(real^N->bool)->real^N`; + `\h:real^N->bool. &0`] + FACE_OF_POLYHEDRON_EXPLICIT) THEN + ASM_SIMP_TAC[INTER_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC `f:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `INTERS {{x:real^N | fa(h:real^N->bool) dot x <= &0} | h IN H} = s` + ASSUME_TAC THENL + [EXPAND_TAC "s" THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = x) ==> {f x | x IN s} = s`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `{h:real^N->bool | h IN H /\ + f SUBSET s INTER {x:real^N | fa h dot x = &0}} = + {}` + THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_INTER] THEN + ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ABBREV_TAC + `H' = IMAGE (\h:real^N->bool. {x:real^N | --(fa h) dot x <= &0}) H` THEN + SUBGOAL_THEN + `?J. FINITE J /\ + J SUBSET (H UNION H') /\ + f:real^N->bool = affine hull f INTER INTERS J` + MP_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `J:(real^N->bool)->bool` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `H UNION IMAGE (\h:real^N->bool. + {x:real^N | --(fa h) dot x <= &0}) J` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FINITE_UNION] THEN MATCH_MP_TAC FINITE_IMAGE THEN + ASM_MESON_TAC[FINITE_SUBSET]; + EXPAND_TAC "H'" THEN ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE `s SUBSET f /\ s = t ==> s = f INTER t`) THEN + REWRITE_TAC[HULL_SUBSET] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + REWRITE_TAC[INTERS_UNION] THEN MATCH_MP_TAC(SET_RULE + `s = s' /\ (!x. x IN s ==> (x IN t <=> x IN t')) + ==> s INTER t = s' INTER t'`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = x) ==> {f x | x IN s} = s`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTERS] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM; DOT_LNEG] THEN + REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`] THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV + [MESON[HAS_SIZE] + `(?f. FINITE f /\ P f) <=> (?n f. f HAS_SIZE n /\ P f)`] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `nn:num` + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `J:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!J'. J' PSUBSET J + ==> (f:real^N->bool) PSUBSET (affine hull f INTER INTERS J')` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(J':(real^N->bool)->bool)`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CARD_PSUBSET; HAS_SIZE]; ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM; HAS_SIZE] THEN + DISCH_THEN(MP_TAC o SPEC `J':(real^N->bool)->bool`) THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (~c ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[PSUBSET; FINITE_SUBSET; HAS_SIZE]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> ~(s = t) ==> s PSUBSET t`) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!h:real^N->bool. h IN J + ==> ?a. {x | a dot x <= &0} = h /\ + (h IN H /\ a = fa h \/ ?h'. h' IN H /\ a = --(fa h'))` + MP_TAC THENL + [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `(h:real^N->bool) IN (H UNION H')` MP_TAC THENL + [ASM SET_TAC[]; EXPAND_TAC "H'"] THEN + UNDISCH_THEN `(h:real^N->bool) IN J` (K ALL_TAC) THEN + SPEC_TAC(`h:real^N->bool`,`h:real^N->bool`) THEN + REWRITE_TAC[IN_UNION; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`; + FORALL_AND_THM; FORALL_IN_IMAGE] THEN + CONJ_TAC THEN X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THENL + [EXISTS_TAC `(fa:(real^N->bool)->real^N) h` THEN + ASM_SIMP_TAC[]; + EXISTS_TAC `--((fa:(real^N->bool)->real^N) h)` THEN + REWRITE_TAC[] THEN DISJ2_TAC THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `ga:(real^N->bool)->real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`f:real^N->bool`; `J:(real^N->bool)->bool`; + `ga:(real^N->bool)->real^N`; `\h:real^N->bool. &0`] + RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[HAS_SIZE]; + ASM_MESON_TAC[]; + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_NEG_EQ_0; SUBSET]]; + DISCH_TAC THEN ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN + `!h:real^N->bool. h IN J ==> h IN H /\ ga h:real^N = fa h` + ASSUME_TAC THENL + [SUBGOAL_THEN `~(relative_interior f:real^N->bool = {})` MP_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; FACE_OF_IMP_CONVEX]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN + DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN + SUBGOAL_THEN `(z:real^N) IN f /\ z IN s` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; FACE_OF_IMP_SUBSET; RELATIVE_INTERIOR_SUBSET]; + ALL_TAC] THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h':real^N->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(z:real^N) IN relative_interior f` THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[DOT_LNEG] THEN + UNDISCH_TAC `(z:real^N) IN s` THEN EXPAND_TAC "s" THEN + REWRITE_TAC[IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h':real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h':real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM(CONJUNCT2 th)]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th] THEN + MP_TAC(SYM th)) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `K:(real^N->bool)->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC(SYM th) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + REWRITE_TAC[IN_INTER; IN_INTERS; FORALL_IN_GSPEC; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(relative_interior f:real^N->bool = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; FACE_OF_IMP_CONVEX]; + ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT (J:(real^N->bool)->bool) K` ASSUME_TAC THENL + [UNDISCH_TAC `~(relative_interior f:real^N->bool = {})` THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN + REWRITE_TAC[IN_DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `relative_interior f = + INTERS {(if (h:real^N->bool) IN J then {x | fa h dot x < &0} + else if h IN K then {x:real^N | fa h dot x = &0} + else if relative_interior f SUBSET {x | fa h dot x = &0} + then {x | fa h dot x = &0} + else {x | fa h dot x < &0}) | h IN H}` + ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; AND_FORALL_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN + ASM_CASES_TAC `(h:real^N->bool) IN H` THENL + [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(h:real^N->bool) IN J` THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `(h:real^N->bool) IN K` THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_REFL] THEN + COND_CASES_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + REAL_ARITH_TAC] THEN + GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + REPEAT(COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[IN_ELIM_THM; REAL_LT_LE] THEN + CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [SET_RULE `~(s SUBSET t) <=> ?y. y IN s /\ ~(y IN t)`]) THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x:real = &0) ==> ~(x <= &0) \/ x < &0`)) + THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ASSUME `(x:real^N) IN relative_interior f`) THEN + REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_CBALL] THEN + SUBGOAL_THEN `~(y:real^N = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `x + e / norm(y - x) % (x - y):real^N`) THEN + SUBGOAL_THEN + `(x:real^N) IN affine hull f /\ y IN affine hull f` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET; HULL_SUBSET]; + ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL]] THEN + REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + r) = norm r`] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_SUB; + REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + DISCH_TAC] THEN + SUBGOAL_THEN `(x + e / norm(y - x) % (x - y):real^N) IN s` MP_TAC THENL + [ASM_MESON_TAC[SUBSET; FACE_OF_IMP_SUBSET]; ALL_TAC] THEN + EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [SYM(CONJUNCT2(MATCH_MP th (ASSUME `(h:real^N->bool) IN H`)))]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RADD; REAL_ADD_LID; DOT_RMUL] THEN + ASM_REWRITE_TAC[DOT_RSUB; REAL_SUB_LZERO; REAL_NOT_LE] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `~(relative_interior f:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; hyperplane_cell] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN + ONCE_ASM_REWRITE_TAC[] THEN EXPAND_TAC "A" THEN + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN MP_TAC th) THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [IN] THEN + REWRITE_TAC[hyperplane_equiv; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(MESON[] + `(!h. P h ==> (Q h <=> R h)) + ==> (!h. P h) ==> ((!h. Q h) <=> (!h. R h))`) THEN + X_GEN_TAC `h:real^N->bool` THEN + ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[hyperplane_side; REAL_SUB_RZERO] THEN + REPEAT(COND_CASES_TAC THEN + SIMP_TAC[IN_ELIM_THM] THENL [MESON_TAC[REAL_SGN_EQ]; ALL_TAC]) THEN + MESON_TAC[REAL_SGN_EQ]; + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + REWRITE_TAC[AFFINE_HULL_CLOSURE] THEN + ASM_REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `relative_interior c:real^N->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN + ASM_MESON_TAC[HYPERPLANE_CELL_CONVEX]; + ASM_MESON_TAC[HYPERPLANE_CELL_RELATIVE_INTERIOR]]] THEN + SUBGOAL_THEN + `?J. J SUBSET H /\ + c = INTERS {{x | (fa(h:real^N->bool)) dot x < &0} | h IN J} INTER + INTERS {{x:real^N | (fa h) dot x = &0} | h IN (H DIFF J)}` + MP_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HYPERPLANE_CELL]) THEN + EXPAND_TAC "A" THEN REWRITE_TAC[hyperplane_equiv; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REWRITE_TAC[hyperplane_side; REAL_SUB_RZERO] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [EQ_SYM_EQ] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN EXISTS_TAC + `{h:real^N->bool | h IN H /\ + real_sgn(fa h dot (z:real^N)) = -- &1}` THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} SUBSET s`] THEN + REWRITE_TAC[GSYM INTERS_UNION] THEN EXPAND_TAC "c" THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTERS] THEN REWRITE_TAC[IN_UNION] THEN + REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`; + FORALL_AND_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN + REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `h:real^N->bool` THEN + ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPEC `(fa:(real^N->bool)->real^N) h dot z` REAL_SGN_CASES) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_SGN_EQ] THEN + SUBGOAL_THEN `?x:real^N. x IN c /\ x IN s` MP_TAC THENL + [ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; NONEMPTY_HYPERPLANE_CELL]; + MATCH_MP_TAC(TAUT `~p ==> p ==> q`)] THEN + MAP_EVERY EXPAND_TAC ["s"; "c"] THEN + REWRITE_TAC[IN_INTERS; IN_ELIM_THM; NOT_EXISTS_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[REAL_SGN_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN + EXPAND_TAC "c" THEN + W(MP_TAC o PART_MATCH (lhand o rand) CLOSURE_INTER_CONVEX o + lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[CONVEX_INTERS; FORALL_IN_GSPEC; CONVEX_HALFSPACE_LT; + CONVEX_HYPERPLANE] THEN + W(MP_TAC o PART_MATCH (lhand o rand) RELATIVE_INTERIOR_OPEN o + lhand o lhand o rand o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC OPEN_INTERS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; OPEN_HALFSPACE_LT] THEN + MATCH_MP_TAC FINITE_IMAGE THEN ASM_MESON_TAC[FINITE_SUBSET]; + DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) RELATIVE_INTERIOR_OPEN_IN o + rand o lhand o rand o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(MESON[OPEN_IN_SUBTOPOLOGY_REFL] + `s SUBSET topspace tp /\ t = s + ==> open_in (subtopology tp t) s`) THEN + REWRITE_TAC[SUBSET_UNIV; TOPSPACE_EUCLIDEAN] THEN + REWRITE_TAC[AFFINE_HULL_EQ] THEN + SIMP_TAC[AFFINE_INTERS; AFFINE_HYPERPLANE; FORALL_IN_GSPEC]; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[NONEMPTY_HYPERPLANE_CELL]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + SIMP_TAC[CLOSURE_INTERS_CONVEX_OPEN; FORALL_IN_GSPEC; + CONVEX_HALFSPACE_LT; OPEN_HALFSPACE_LT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_FACE_OF; INTER_EMPTY] THEN + SUBGOAL_THEN + `IMAGE closure {{x | fa h dot x < &0} | h IN J} = + {{x | (fa:(real^N->bool)->real^N) h dot x <= &0} | h IN J}` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSURE_HALFSPACE_LT THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `closure (INTERS {{x | fa h dot x = &0} | h IN H DIFF J}) = + INTERS {{x | (fa:(real^N->bool)->real^N) h dot x = &0} | h IN H DIFF J}` + SUBST1_TAC THENL + [REWRITE_TAC[CLOSURE_EQ] THEN + SIMP_TAC[CLOSED_INTERS; FORALL_IN_GSPEC; CLOSED_HYPERPLANE]; + ALL_TAC] THEN + ASM_CASES_TAC `J:(real^N->bool)->bool = H` THENL + [ASM_REWRITE_TAC[DIFF_EQ_EMPTY; INTER_UNIV; NOT_IN_EMPTY; + SET_RULE `{f x | x | F} = {}`; INTERS_0] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_REFL o + MATCH_MP POLYHEDRON_IMP_CONVEX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + EXPAND_TAC "s" THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = x) ==> s = {f x | x IN s}`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `INTERS {{x | fa(h:real^N->bool) dot x <= &0} | h IN J} INTER + INTERS {{x:real^N | fa h dot x = &0} | h IN H DIFF J} = + INTERS {s INTER {x | fa h dot x = &0} | h IN H DIFF J}` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[INTERS_IMAGE] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + ASM_CASES_TAC `(y:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN + UNDISCH_TAC `(y:real^N) IN s` THEN EXPAND_TAC "s" THEN + REWRITE_TAC[IN_INTERS] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `h:real^N->bool` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; SET_TAC[]]; + UNDISCH_TAC `~((y:real^N) IN s)` THEN MATCH_MP_TAC + (TAUT `~q /\ (p ==> r) ==> ~r ==> (p <=> q)`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `h:real^N->bool` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [GSYM(CONJUNCT2 th)]) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + ASM_CASES_TAC `(h:real^N->bool) IN J` THEN + ASM_SIMP_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + MATCH_MP_TAC FACE_OF_INTERS THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX] THEN X_GEN_TAC `y:real^N` THEN + EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [GSYM(CONJUNCT2 th)]) THEN + REWRITE_TAC[IN_ELIM_THM]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!h. h IN H ==> hyperplane_cellcomplex A ((:real^N) DIFF h)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN + EXISTS_TAC `{((fa:(real^N->bool)->real^N) h,&0)}` THEN CONJ_TAC THENL + [MATCH_MP_TAC HYPERPLANE_CELL_CELLCOMPLEX THEN + ASM_SIMP_TAC[HYPERPLANE_CELL_SING] THEN REPEAT DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM(CONJUNCT2 th)]) THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; + EXPAND_TAC "A" THEN + REWRITE_TAC[IN_IMAGE; SUBSET; FORALL_UNWIND_THM2; IN_SING] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!h:real^N->bool. h IN H ==> hyperplane_cellcomplex A h` + ASSUME_TAC THENL + [ASM_MESON_TAC[HYPERPLANE_CELLCOMPLEX_COMPL; + SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]; + ALL_TAC] THEN + SUBGOAL_THEN `hyperplane_cellcomplex A (s:real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_INTERS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`A:real^N#real->bool`; + `INTERS H:real^N->bool`; + `(:real^N) DIFF INTERS H`] + EULER_CHARACTERISTIC_CELLCOMPLEX_UNION) THEN + REWRITE_TAC[SET_RULE `DISJOINT s (UNIV DIFF s)`] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[HYPERPLANE_CELLCOMPLEX_DIFF; HYPERPLANE_CELLCOMPLEX_UNIV]; + REWRITE_TAC[SET_RULE `s UNION (UNIV DIFF s) = UNIV`]] THEN + REWRITE_TAC[DIFF_INTERS] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `x = (--(&1)) pow (dimindex(:N)) /\ + y = (--(&1)) pow (dimindex(:N)) + ==> x = s + y ==> s = &0`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `euler_characteristic {} (:real^N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC EULER_CHARACTERSTIC_INVARIANT THEN + ASM_REWRITE_TAC[FINITE_EMPTY] THEN CONJ_TAC THENL + [MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN + EXISTS_TAC `{}:real^N#real->bool` THEN REWRITE_TAC[EMPTY_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC HYPERPLANE_CELL_CELLCOMPLEX THEN + REWRITE_TAC[HYPERPLANE_CELL_EMPTY]; + SIMP_TAC[EULER_CHARACTERISTIC_CELL; HYPERPLANE_CELL_EMPTY] THEN + REWRITE_TAC[AFF_DIM_UNIV; NUM_OF_INT_OF_NUM]]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) EULER_CHARACTERISTIC_INCLUSION_EXCLUSION o + lhand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {t | t SUBSET {(:real^N) DIFF t | t IN H} /\ ~(t = {})} + (\t. -- &1 pow (CARD t + 1) * (--(&1)) pow (dimindex(:N)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMP_CONJ; FORALL_SUBSET_IMAGE] THEN + X_GEN_TAC `J:(real^N->bool)->bool` THEN DISCH_TAC THEN + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_TAC THEN AP_TERM_TAC THEN + ABBREV_TAC `B = IMAGE (\h:real^N->bool. fa h:real^N,&0) J` THEN + SUBGOAL_THEN `(B:real^N#real->bool) SUBSET A` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `INTERS (IMAGE (\t. (:real^N) DIFF t) H) = + IMAGE (--) (interior s)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `H:(real^N->bool)->bool`; + `fa:(real^N->bool)->real^N`; + `\h:real^N->bool. &0`] + RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_SIMP_TAC[INTER_UNIV] THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR] THEN + DISCH_THEN(K ALL_TAC) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`; EXISTS_REFL] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_DIFF; IN_UNIV] THEN + MATCH_MP_TAC(TAUT `(c ==> b) /\ (a <=> c) ==> (a <=> b /\ c)`) THEN + CONJ_TAC THENL + [EXPAND_TAC "s" THEN REWRITE_TAC[IN_INTERS] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN + ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC(MESON[] + `(!h. P h ==> (Q h <=> R h)) + ==> ((!h. P h ==> Q h) <=> (!h. P h ==> R h))`) THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [SYM(CONJUNCT2(MATCH_MP th (ASSUME `(h:real^N->bool) IN H`)))]) THEN + REWRITE_TAC[IN_ELIM_THM; DOT_RNEG] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `hyperplane_cell B (INTERS (IMAGE (\t. (:real^N) DIFF t) J))` + ASSUME_TAC THENL + [SUBGOAL_THEN + `~(INTERS (IMAGE (\t. (:real^N) DIFF t) J) = {})` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[hyperplane_cell; GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + REWRITE_TAC[IN_UNIV; IN_DIFF] THEN + GEN_REWRITE_TAC RAND_CONV [EXTENSION] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN MP_TAC th) THEN + REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_DIFF; IN_UNIV] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [IN] THEN + REWRITE_TAC[hyperplane_equiv] THEN EXPAND_TAC "B" THEN + REWRITE_TAC[FORALL_IN_IMAGE; hyperplane_side] THEN + MATCH_MP_TAC(MESON[] + `(!h. P h ==> (Q h <=> R h)) + ==> (!h. P h) ==> ((!h. Q h) <=> (!h. R h))`) THEN + X_GEN_TAC `h:real^N->bool` THEN + ASM_CASES_TAC `(h:real^N->bool) IN J` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(h:real^N->bool) IN H` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP (ASSUME + `(h:real^N->bool) IN H`)) THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [SYM th] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) THEN + REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO; REAL_NOT_LE] THEN + MESON_TAC[REAL_SGN_EQ; real_gt]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `euler_characteristic B (INTERS (IMAGE (\t. (:real^N) DIFF t) J))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EULER_CHARACTERSTIC_INVARIANT THEN + ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX] THEN + CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC HYPERPLANE_CELLCOMPLEX_MONO THEN + EXISTS_TAC `B:real^N#real->bool` THEN + ASM_SIMP_TAC[HYPERPLANE_CELL_CELLCOMPLEX]; + ALL_TAC] THEN + ASM_SIMP_TAC[EULER_CHARACTERISTIC_CELL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC(MESON[NUM_OF_INT_OF_NUM] `i = &n ==> num_of_int i = n`) THEN + REWRITE_TAC[AFF_DIM_EQ_FULL] THEN + MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ t = UNIV ==> s = UNIV`) THEN + EXISTS_TAC `affine hull (INTERS (IMAGE (\t. (:real^N) DIFF t) H))` THEN + CONJ_TAC THENL [MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[IMAGE_EQ_EMPTY; OPEN_NEGATIONS; OPEN_INTERIOR]; + ALL_TAC] THEN + REWRITE_TAC[SUM_RMUL] THEN + MATCH_MP_TAC(REAL_RING `s = &1 ==> s * t = t`) THEN + MP_TAC(ISPECL [`\t:(real^N->bool)->bool. CARD t`; + `\t:(real^N->bool)->bool. (-- &1) pow (CARD t + 1)`; + `{t | t SUBSET + {(:real^N) DIFF t | t IN H} /\ ~(t = {})}`; + `1..CARD(H:(real^N->bool)->bool)`] + SUM_GROUP) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{t | t SUBSET {(:real^N) DIFF t | t IN H}}` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC FINITE_POWERSET THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE]; + GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_NUMSEG] THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_SUBSET_IMAGE; IMP_CONJ] THEN + X_GEN_TAC `J:(real^N->bool)->bool` THEN DISCH_TAC THEN + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN DISCH_TAC THEN + SUBGOAL_THEN `FINITE(J:(real^N->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[CARD_EQ_0; FINITE_IMAGE; ARITH_RULE `1 <= n <=> ~(n = 0)`; + IMAGE_EQ_EMPTY] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(J:(real^N->bool)->bool)` THEN + ASM_SIMP_TAC[CARD_SUBSET; CARD_IMAGE_LE]]; + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum (1..CARD(H:(real^N->bool)->bool)) + (\n. -- &1 pow (n + 1) * &(binom(CARD H,n)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN + SIMP_TAC[IN_ELIM_THM] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_CONST o lhand o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{t | t SUBSET {(:real^N) DIFF t | t IN H}}` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC FINITE_POWERSET THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE]; + DISCH_THEN SUBST1_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `CARD {t | t SUBSET {(:real^N) DIFF t | t IN H} /\ + t HAS_SIZE n}` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `t:(real^N->bool)->bool` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC `t:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_EMPTY] THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(p ==> r) ==> (p /\ q <=> p /\ r /\ q)`) THEN + SPEC_TAC(`t:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_SUBSET_IMAGE] THEN + ASM_MESON_TAC[FINITE_IMAGE; FINITE_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPECL [`CARD(H:(real^N->bool)->bool)`; + `n:num`; `{(:real^N) DIFF t | t IN H}`] + NUMBER_OF_COMBINATIONS) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[HAS_SIZE]] THEN + REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + ASM_REWRITE_TAC[GSYM FINITE_HAS_SIZE] THEN SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`CARD(H:(real^N->bool)->bool)`; `--(&1)`; `&1`] + REAL_BINOMIAL_THEOREM) THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID; REAL_ADD_LINV] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; REAL_POW_ADD; REAL_POW_ONE; LE_0] THEN + REWRITE_TAC[REAL_ARITH `(x * --(&1) pow 1) * y = --(y * x)`] THEN + REWRITE_TAC[real_pow; SUM_NEG; ADD_CLAUSES; REAL_MUL_RID] THEN + REWRITE_TAC[binom] THEN MATCH_MP_TAC(REAL_ARITH + `x = &0 ==> x = &1 + y ==> --y = &1`) THEN + REWRITE_TAC[REAL_POW_ZERO] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `CARD(H:(real^N->bool)->bool) = 0` THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Euler-Poincare relation for special (n-1)-dimensional polytope. *) +(* ------------------------------------------------------------------------- *) + +let EULER_POINCARE_LEMMA = prove + (`!p:real^N->bool. + 2 <= dimindex(:N) /\ polytope p /\ affine hull p = {x | x$1 = &1} + ==> sum (0..dimindex(:N)-1) + (\d. (-- &1) pow d * + &(CARD {f | f face_of p /\ aff_dim f = &d })) = &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`basis 1:real^N`; `&1`] AFF_DIM_HYPERPLANE) THEN + SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + ASM_CASES_TAC `p:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN + REWRITE_TAC[INT_ARITH `--(&1):int = x - &1 <=> x = &0`] THEN + SIMP_TAC[INT_OF_NUM_EQ; LE_1; DIMINDEX_GE_1]; + DISCH_TAC] THEN + ABBREV_TAC `s:real^N->bool = conic hull p` THEN + MP_TAC(ISPEC `s:real^N->bool` EULER_POLYHEDRAL_CONE) THEN + SUBGOAL_THEN + `!f. f SUBSET {x:real^N | x$1 = &1} + ==> (conic hull f) INTER {x:real^N | x$1 = &1} = f` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[HULL_SUBSET; SUBSET_INTER] THEN + REWRITE_TAC[SUBSET; CONIC_HULL_EXPLICIT; IN_INTER; IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_RID; VECTOR_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `k:real^N->bool` MP_TAC o + GEN_REWRITE_RULE I [polytope]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> SUBST1_TAC th THEN ASSUME_TAC th) THEN + MP_TAC(ISPEC `k:real^N->bool` CONVEX_CONE_HULL_SEPARATE_NONEMPTY) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONVEX_HULL_EQ_EMPTY]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC POLYHEDRON_CONVEX_CONE_HULL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN + SUBGOAL_THEN `conic(s:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CONIC_CONIC_HULL]; ALL_TAC] THEN + SUBGOAL_THEN `~(s = (:real^N))` ASSUME_TAC THENL + [DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `p:real^N->bool`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[HULL_SUBSET]; ALL_TAC] THEN + ASM_REWRITE_TAC[INTER_UNIV] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + UNDISCH_TAC `polytope(p:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC + `(lambda i. if i = 1 then &1 else B + &1):real^N`) THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_GE_1; LE_REFL; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_NOT_LE] THEN + MP_TAC(ISPECL + [`(lambda i. if i = 1 then &1 else B + &1):real^N`; `2`] + COMPONENT_LE_NORM) THEN + ASM_SIMP_TAC[ARITH; LAMBDA_BETA; DIMINDEX_GE_1; LE_REFL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(s:real^N->bool = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[CONIC_HULL_EQ_EMPTY]; ALL_TAC] THEN + MP_TAC(ISPEC `s:real^N->bool` CONIC_CONTAINS_0) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(interior(s:real^N->bool) = {})` ASSUME_TAC THENL + [DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` + EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `s SUBSET {x:real^N | x$1 = &1}` MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET h' ==> h SUBSET h' /\ ~(h PSUBSET h') ==> s SUBSET h`)) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_HYPERPLANE] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_SUBSET]; + DISCH_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `b:real`] AFF_DIM_HYPERPLANE) THEN + MP_TAC(ISPECL [`basis 1:real^N`; `&1`] AFF_DIM_HYPERPLANE) THEN + ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + MATCH_MP_TAC(INT_ARITH `a:int < b ==> a = n ==> ~(b = n)`) THEN + MATCH_MP_TAC AFF_DIM_PSUBSET THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `s PSUBSET t ==> s' = s /\ t' = t ==> s' PSUBSET t'`)) THEN + REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE] THEN + MP_TAC(ISPECL [`basis 1:real^N`; `&1`] AFFINE_HYPERPLANE) THEN + SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_GE_1; LE_REFL]]; + REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP] THEN + EXISTS_TAC `vec 0:real^N` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; VEC_COMPONENT] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!x:real^N. x IN s /\ ~(x = vec 0) ==> &0 < x$1` + ASSUME_TAC THENL + [EXPAND_TAC "s" THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_GSPEC; VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC REAL_LT_MUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(x:real^N) IN affine hull p` MP_TAC THENL + [ASM_MESON_TAC[HULL_SUBSET; SUBSET]; ASM_REWRITE_TAC[]] THEN + SIMP_TAC[IN_ELIM_THM; REAL_LT_01]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= x$1` ASSUME_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS; REAL_LT_IMP_LE]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_CLAUSES_LEFT o + lhand o lhand o snd) THEN + REWRITE_TAC[LE_0] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[AFF_DIM_EQ_0; real_pow; REAL_MUL_LID] THEN + SUBGOAL_THEN `{f | f face_of s /\ (?a:real^N. f = {a})} = {{vec 0}}` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `f:real^N->bool` THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `a:real^N`)) THEN + ASM_REWRITE_TAC[FACE_OF_SING] THEN + ASM_MESON_TAC[EXTREME_POINT_OF_CONIC]; + DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + ASM_REWRITE_TAC[FACE_OF_SING; extreme_point_of; IN_SEGMENT] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `u:real` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VEC_COMPONENT] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SUBGOAL_THEN `&0 < (a:real^N)$1 \/ &0 < (b:real^N)$1` DISJ_CASES_TAC THENL + [ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(&0 = a + b)`); + MATCH_MP_TAC(REAL_ARITH `&0 < b /\ &0 <= a ==> ~(&0 = a + b)`)] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LT_MUL; REAL_SUB_LT]]; + ALL_TAC] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC(REAL_ARITH `s = --t ==> (&0 + &1) + s = &0 ==> t = &1`) THEN + SUBGOAL_THEN `dimindex(:N) = (dimindex(:N)-1)+1` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_OFFSET; GSYM SUM_NEG] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN + EXISTS_TAC `\f:real^N->bool. f INTER {x | x$1 = &1}` THEN + EXISTS_TAC `\f:real^N->bool. conic hull f` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [DISJ1_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{f:real^N->bool | f face_of s}` THEN + ASM_SIMP_TAC[FINITE_POLYHEDRON_FACES] THEN SET_TAC[]; + REWRITE_TAC[IN_ELIM_THM; GSYM INT_OF_NUM_ADD]] THEN + SUBGOAL_THEN + `!f:real^N->bool. f face_of p ==> conic hull f INTER {x | x$1 = &1} = f` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `affine hull p:real^N->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET_TRANS]; + ASM_REWRITE_TAC[SUBSET_REFL]]; + ASM_SIMP_TAC[]] THEN + SUBGOAL_THEN + `!f:real^N->bool. f face_of s ==> f INTER {x | x$1 = &1} face_of p` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p = conic hull p INTER {x:real^N | x$1 = &1}` SUBST1_TAC + THENL [ASM_MESON_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]; ALL_TAC] THEN + MATCH_MP_TAC FACE_OF_SLICE THEN + ASM_REWRITE_TAC[CONVEX_STANDARD_HYPERPLANE]; + ASM_SIMP_TAC[]] THEN + SUBGOAL_THEN + `!f. f face_of s /\ &0 < aff_dim f + ==> conic hull (f INTER {x:real^N | x$1 = &1}) = f` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; CONIC_HULL_EXPLICIT; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_CONIC; conic]; + REWRITE_TAC[SUBSET; CONIC_HULL_EXPLICIT] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [SUBGOAL_THEN `?y:real^N. y IN f /\ ~(y = vec 0)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `a IN s /\ ~(s = {a}) ==> ?y. y IN s /\ ~(y = a)`) THEN + ASM_MESON_TAC[AFF_DIM_EQ_0; INT_LT_REFL]; + SUBGOAL_THEN `&0 < (y:real^N)$1` ASSUME_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN + EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN + EXISTS_TAC `inv(y$1) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV; + REAL_LT_IMP_NZ] THEN + ASM_MESON_TAC[FACE_OF_CONIC; conic; REAL_LE_INV_EQ; REAL_LT_IMP_LE]]; + SUBGOAL_THEN `&0 < (x:real^N)$1` ASSUME_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN + EXISTS_TAC `(x:real^N)$1` THEN EXISTS_TAC `inv(x$1) % x:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV; REAL_LT_IMP_LE; + REAL_LT_IMP_NZ; VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN + ASM_MESON_TAC[FACE_OF_CONIC; conic; REAL_LE_INV_EQ; REAL_LT_IMP_LE]]]; + ASM_SIMP_TAC[INT_ARITH `&0:int < &d + &1`]] THEN + SUBGOAL_THEN + `!f:real^N->bool. f face_of p ==> (conic hull f) face_of s` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CONIC_HULL_EMPTY; EMPTY_FACE_OF] THEN + REWRITE_TAC[face_of] THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC HULL_MONO THEN + ASM_MESON_TAC[FACE_OF_IMP_SUBSET]; + ASM_MESON_TAC[CONVEX_CONIC_HULL; FACE_OF_IMP_CONVEX]; + ALL_TAC] THEN + EXPAND_TAC "s" THEN REWRITE_TAC[CONIC_HULL_EXPLICIT; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`ca:real`; `a:real^N`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`cb:real`; `b:real^N`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`cx:real`; `x:real^N`] THEN STRIP_TAC THEN + ASM_CASES_TAC `cx % x:real^N = vec 0` THENL + [ASM_REWRITE_TAC[IN_SEGMENT] THEN + MATCH_MP_TAC(TAUT `(a ==> ~b) ==> a /\ b ==> c`) THEN + DISCH_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[CART_EQ] THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VEC_COMPONENT] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN + ONCE_REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN + SUBGOAL_THEN `&0 < (ca % a:real^N)$1 \/ &0 < (cb % b:real^N)$1` + DISJ_CASES_TAC THENL + [SUBGOAL_THEN `(ca % a:real^N) IN s /\ (cb % b:real^N) IN s` + (fun th -> ASM_MESON_TAC[th]) THEN + ASM_MESON_TAC[conic; HULL_SUBSET; SUBSET]; + MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(&0 = a + b)`); + MATCH_MP_TAC(REAL_ARITH `&0 < b /\ &0 <= a ==> ~(&0 = a + b)`)] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_LT_MUL; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_SUB_LT] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[conic; HULL_SUBSET; SUBSET]; + ALL_TAC] THEN + UNDISCH_TAC `~(cx % x:real^N = vec 0)` THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = a` THENL + [REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH + `x % a:real^N = y % a + z % b <=> (x - y) % a = z % b`] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [CART_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN + SUBGOAL_THEN `(a:real^N) IN affine hull p /\ b IN affine hull p` + MP_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN + REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`ca:real`; `a:real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL]]; + CONJ_TAC THENL [EXISTS_TAC `ca:real`; EXISTS_TAC `cb:real`] THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `x:real^N = b` THENL + [REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `u:real` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH + `x % b:real^N = y % a + z % b <=> (x - z) % b = y % a`] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [CART_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN + SUBGOAL_THEN `(a:real^N) IN affine hull p /\ b IN affine hull p` + MP_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN + REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_ENTIRE; + REAL_LT_IMP_NE; REAL_SUB_0] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL]; + MAP_EVERY EXISTS_TAC [`cb:real`; `b:real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; + CONJ_TAC THENL [EXISTS_TAC `ca:real`; EXISTS_TAC `cb:real`] THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(x:real^N) IN segment(a,b)` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_OPEN_SEGMENT]) THEN + ASM_REWRITE_TAC[IN_OPEN_SEGMENT] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_SEGMENT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [CART_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + SUBGOAL_THEN `(x:real^N) IN affine hull p /\ + a IN affine hull p /\ b IN affine hull p` + MP_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THEN + REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + DISCH_THEN(MP_TAC o AP_TERM `(%) (inv cx) :real^N->real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN + DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `inv(cx) * u * cb` THEN + REWRITE_TAC[REAL_ARITH `inv(cx) * x:real = x / cx`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_LT_LE] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a + b = cx ==> &0 <= a ==> b <= &1 * cx`)) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB] THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MAP_EVERY UNDISCH_TAC + [`(&1 - u) * ca + u * cb = cx`; `~(cx = &0)`] THEN + CONV_TAC REAL_FIELD]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [face_of]) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `x:real^N`]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + ASM_SIMP_TAC[]] THEN + SUBGOAL_THEN + `!f:real^N->bool. f face_of p /\ ~(f = {}) + ==> aff_dim(conic hull f) = aff_dim f + &1` + (LABEL_TAC "*") THENL + [ALL_TAC; + CONJ_TAC THEN X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `f INTER {x:real^N | x$1 = &1}`) THEN + ASM_SIMP_TAC[INT_ARITH `&0:int < &d + &1`; INT_EQ_ADD_RCANCEL] THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + SUBGOAL_THEN `?y:real^N. y IN f /\ ~(y = vec 0)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `a IN s /\ ~(s = {a}) ==> ?y. y IN s /\ ~(y = a)`) THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] + FACE_OF_CONIC) THEN + ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN REPEAT DISCH_TAC; + DISCH_TAC] THEN + UNDISCH_TAC `aff_dim(f:real^N->bool) = &d + &1` THEN + ASM_REWRITE_TAC[AFF_DIM_SING; AFF_DIM_EMPTY] THEN INT_ARITH_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < (y:real^N)$1` ASSUME_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; ALL_TAC] THEN + EXISTS_TAC `inv(y$1) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV; + REAL_LT_IMP_NZ] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] + FACE_OF_CONIC) THEN + ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN + REWRITE_TAC[conic] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]]; + REMOVE_THEN "*" (MP_TAC o SPEC `f:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + DISCH_TAC THEN UNDISCH_TAC `aff_dim(f:real^N->bool) = &d` THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN INT_ARITH_TAC]] THEN + X_GEN_TAC `f:real^N->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC(INT_ARITH `f < a /\ a <= f + &1 ==> a:int = f + &1`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC AFF_DIM_PSUBSET THEN + SIMP_TAC[PSUBSET; HULL_MONO; HULL_SUBSET] THEN + REWRITE_TAC[EXTENSION; NOT_FORALL_THM] THEN EXISTS_TAC `vec 0:real^N` THEN + MATCH_MP_TAC(TAUT `~p /\ q ==> ~(p <=> q)`) THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE `!t. ~(x IN t) /\ s SUBSET t ==> ~(x IN s)`) THEN + EXISTS_TAC `affine hull p:real^N->bool` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_ELIM_THM; VEC_COMPONENT] THEN REAL_ARITH_TAC; + MATCH_MP_TAC HULL_MONO THEN ASM_MESON_TAC[FACE_OF_IMP_SUBSET]]; + MATCH_MP_TAC(SET_RULE + `x IN s /\ s SUBSET P hull s ==> x IN P hull s`) THEN + ASM_SIMP_TAC[CONIC_CONTAINS_0; HULL_SUBSET; CONIC_CONIC_HULL] THEN + ASM_REWRITE_TAC[CONIC_HULL_EQ_EMPTY]]; + MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `aff_dim((vec 0:real^N) INSERT (affine hull f))` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[AFF_DIM_INSERT; AFF_DIM_AFFINE_HULL] THEN INT_ARITH_TAC] THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + MATCH_MP_TAC AFF_DIM_SUBSET THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[AFFINE_AFFINE_HULL; SUBSET; CONIC_HULL_EXPLICIT] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `c % x:real^N = vec 0 + c % (x - vec 0)`] THEN + MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC; IN_INSERT]]);; + +let EULER_POINCARE_SPECIAL = prove + (`!p:real^N->bool. + 2 <= dimindex(:N) /\ polytope p /\ affine hull p = {x | x$1 = &0} + ==> sum (0..dimindex(:N)-1) + (\d. (-- &1) pow d * + &(CARD {f | f face_of p /\ aff_dim f = &d })) = &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. basis 1 + x) p` EULER_POINCARE_LEMMA) THEN + ASM_REWRITE_TAC[POLYTOPE_TRANSLATION_EQ; AFFINE_HULL_TRANSLATION] THEN + ANTS_TAC THENL + [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[EXISTS_REFL; VECTOR_ARITH + `a + x:real^N = y <=> x = y - a`] THEN + SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; BASIS_COMPONENT; + DIMINDEX_GE_1; LE_REFL] THEN REAL_ARITH_TAC; + REWRITE_TAC[SET_RULE `{f | f face_of s /\ P f} = + {f | f IN {f | f face_of s} /\ P f}`] THEN + REWRITE_TAC[FACES_OF_TRANSLATION] THEN + REWRITE_TAC[SET_RULE `{y | y IN IMAGE f s /\ P y} = + {f x |x| x IN s /\ P(f x)}`] THEN + REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; IN_ELIM_THM] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SIMPLE_IMAGE_GEN] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] + `(!x y. Q x y ==> x = y) + ==> (!x y. P x /\ P y /\ Q x y ==> x = y)`) THEN + REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{f:real^N->bool | f face_of p}` THEN + ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Now Euler-Poincare for a general full-dimensional polytope. *) +(* ------------------------------------------------------------------------- *) + +let EULER_POINCARE_FULL = prove + (`!p:real^N->bool. + polytope p /\ aff_dim p = &(dimindex(:N)) + ==> sum (0..dimindex(:N)) + (\d. (-- &1) pow d * + &(CARD {f | f face_of p /\ aff_dim f = &d })) = &1`, + REPEAT STRIP_TAC THEN ABBREV_TAC + `f:real^N->real^(N,1)finite_sum = + \x. lambda i. if i = 1 then &0 else x$(i-1)` THEN + ABBREV_TAC `s = IMAGE (f:real^N->real^(N,1)finite_sum) p` THEN + MP_TAC(ISPEC `s:real^(N,1)finite_sum->bool` EULER_POINCARE_SPECIAL) THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; ADD_SUB] THEN + REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `2 <= n + 1 <=> 1 <= n`] THEN + SUBGOAL_THEN `linear(f:real^N->real^(N,1)finite_sum)` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN REWRITE_TAC[linear] THEN + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + EXPAND_TAC "s" THEN + ASM_SIMP_TAC[POLYTOPE_LINEAR_IMAGE; AFFINE_HULL_LINEAR_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EQ_FULL]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `y:real^(N,1)finite_sum` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real^N` SUBST1_TAC) THEN + EXPAND_TAC "f" THEN SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_GE_1]; + DISCH_TAC THEN + EXISTS_TAC `(lambda i. (y:real^(N,1)finite_sum)$(i+1)):real^N` THEN + EXPAND_TAC "f" THEN + REWRITE_TAC[CART_EQ; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1; + DIMINDEX_GE_1; ARITH_RULE `1 <= i /\ ~(i = 1) ==> 1 <= i - 1`; + ARITH_RULE `1 <= n /\ i <= n + 1 ==> i - 1 <= n`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + ASM_ARITH_TAC]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `!x y. (f:real^N->real^(N,1)finite_sum) x = f y <=> x = y` + ASSUME_TAC THENL + [EXPAND_TAC "f" THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1; + DIMINDEX_GE_1; ARITH_RULE `1 <= i /\ ~(i = 1) ==> 1 <= i - 1`; + ARITH_RULE `1 <= n /\ i <= n + 1 ==> i - 1 <= n`] THEN + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i + 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ADD_SUB] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + EXPAND_TAC "s" THEN + MP_TAC(ISPECL [`f:real^N->real^(N,1)finite_sum`; `p:real^N->bool`] + FACES_OF_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[SET_RULE `{f | f face_of s /\ P f} = + {f | f IN {f | f face_of s} /\ P f}`] THEN + ASM_REWRITE_TAC[SET_RULE `{y | y IN IMAGE f s /\ P y} = + {f x |x| x IN s /\ P(f x)}`] THEN + ASM_SIMP_TAC[AFF_DIM_INJECTIVE_LINEAR_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SIMPLE_IMAGE_GEN] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] + `(!x y. Q x y ==> x = y) + ==> (!x y. P x /\ P y /\ Q x y ==> x = y)`) THEN + ASM_REWRITE_TAC[INJECTIVE_IMAGE]; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{f:real^N->bool | f face_of p}` THEN + ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular the Euler relation in 3D. *) +(* ------------------------------------------------------------------------- *) + +let EULER_RELATION = prove + (`!p:real^3->bool. + polytope p /\ aff_dim p = &3 + ==> (CARD {v | v face_of p /\ aff_dim(v) = &0} + + CARD {f | f face_of p /\ aff_dim(f) = &2}) - + CARD {e | e face_of p /\ aff_dim(e) = &1} = 2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `p:real^3->bool` EULER_POINCARE_FULL) THEN + ASM_REWRITE_TAC[DIMINDEX_3] THEN + REWRITE_TAC[TOP_DEPTH_CONV num_CONV `3`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LNEG] THEN + SUBGOAL_THEN `{f:real^3->bool | f face_of p /\ aff_dim f = &3} = {p}` + (fun th -> SIMP_TAC[th; NOT_IN_EMPTY; FINITE_EMPTY; CARD_CLAUSES]) + THENL + [MATCH_MP_TAC(SET_RULE + `P a /\ (!x. P x ==> x = a) ==> {x | P x} = {a}`) THEN + ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN + X_GEN_TAC `f:real^3->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^3->bool`; `p:real^3->bool`] + FACE_OF_AFF_DIM_LT) THEN + ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; INT_LT_REFL]; + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_ARITH `((x + --y) + z) + -- &1:real = &1 <=> + x + z = y + &2`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ADD_SUB2]]);; diff --git a/100/primerecip.ml b/100/primerecip.ml new file mode 100644 index 0000000..ad9d9dc --- /dev/null +++ b/100/primerecip.ml @@ -0,0 +1,211 @@ +(* ========================================================================= *) +(* Divergence of prime reciprocal series. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Now load other stuff needed. *) +(* ------------------------------------------------------------------------- *) + +needs "100/bertrand.ml";; +needs "100/divharmonic.ml";; + +(* ------------------------------------------------------------------------- *) +(* Variant of induction. *) +(* ------------------------------------------------------------------------- *) + +let INDUCTION_FROM_1 = prove + (`!P. P 0 /\ P 1 /\ (!n. 1 <= n /\ P n ==> P(SUC n)) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[num_CONV `1`; ARITH_RULE `n = 0 \/ 1 <= n`]);; + +(* ------------------------------------------------------------------------- *) +(* Evaluate sums over explicit intervals. *) +(* ------------------------------------------------------------------------- *) + +let SUM_CONV = + let pth = prove + (`sum(1..1) f = f 1 /\ sum(1..SUC n) f = sum(1..n) f + f(SUC n)`, + SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; + ARITH_RULE `1 <= SUC n`; SUM_SING_NUMSEG]) in + let econv_0 = GEN_REWRITE_CONV I [CONJUNCT1 pth] + and econv_1 = GEN_REWRITE_CONV I [CONJUNCT2 pth] in + let rec sconv tm = + (econv_0 ORELSEC + (LAND_CONV(RAND_CONV num_CONV) THENC econv_1 THENC + COMB2_CONV (RAND_CONV sconv) (RAND_CONV NUM_SUC_CONV))) tm in + sconv;; + +(* ------------------------------------------------------------------------- *) +(* Lower bound relative to harmonic series. *) +(* ------------------------------------------------------------------------- *) + +let PRIMERECIP_HARMONIC_LBOUND = prove + (`!n. (&3 / (&16 * ln(&32))) * sum(1..n) (\i. &1 / &i) <= + sum(1..32 EXP n) (\i. if prime(i) then &1 / &i else &0)`, + MATCH_MP_TAC INDUCTION_FROM_1 THEN CONJ_TAC THENL + [SIMP_TAC[SUM_TRIV_NUMSEG; ARITH; SUM_SING_NUMSEG; REAL_MUL_RZERO] THEN + REWRITE_TAC[PRIME_1; REAL_LE_REFL]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[ARITH; SUM_SING_NUMSEG] THEN + CONV_TAC(RAND_CONV SUM_CONV) THEN REWRITE_TAC[] THEN + CONV_TAC(ONCE_DEPTH_CONV PRIME_CONV) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SYM(REAL_RAT_REDUCE_CONV `&2 pow 5`)] THEN + SIMP_TAC[LN_POW; REAL_OF_NUM_LT; ARITH; real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[LN_2_COMPOSITION; real_div; real_sub] THEN + CONV_TAC REALCALC_REL_CONV; + ALL_TAC] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REAL_ARITH + `b - a <= s2 - s1 ==> a <= s1 ==> b <= s2`) THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; REAL_ADD_SUB; ARITH_RULE `1 <= SUC n`] THEN + MP_TAC(SPEC `32 EXP n` PII_UBOUND_5) THEN ANTS_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `32 EXP 1` THEN + ASM_REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[ARITH]; + ALL_TAC] THEN + MP_TAC(SPEC `32 EXP (SUC n)` PII_LBOUND) THEN ANTS_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `32 EXP 1` THEN + ASM_REWRITE_TAC[LE_EXP] THEN REWRITE_TAC[ARITH] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP(REAL_ARITH + `a <= s1 /\ s2 <= b ==> a - b <= s1 - s2`)) THEN + SIMP_TAC[pii; PSUM_SUM_NUMSEG; EXP_EQ_0; ARITH; ADD_SUB2] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[EXP; ARITH_RULE `32 * n = n + 31 * n`] THEN + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; REAL_ADD_SUB] THEN + REWRITE_TAC[ARITH_RULE `n + 31 * n = 32 * n`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `inv(&32 pow (SUC n)) * + sum(32 EXP n + 1 .. 32 EXP SUC n) (\i. if prime i then &1 else &0)` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; REAL_MUL_RZERO] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `32 EXP n + 1 <= i` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[ARITH_RULE `~(0 < i) <=> i = 0`] THEN + REWRITE_TAC[LE; ARITH; ADD_EQ_0]] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM real_div; REAL_POW_LT; REAL_LE_RDIV_EQ; + REAL_OF_NUM_LT; ARITH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= x ==> b <= a ==> b <= x`)) THEN + SIMP_TAC[LN_POW; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_pow; GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[REAL_FIELD + `&1 / &2 * (&32 * n32) / (n1 * l) - &5 * n32 / (n * l) = + (n32 / l) * (&16 / n1 - &5 / n)`] THEN + REWRITE_TAC[REAL_FIELD + `(&3 / (&16 * l) * i) * &32 * n32 = (n32 / l) * (&6 * i)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; LN_POS; REAL_OF_NUM_LE; ARITH] THEN + REWRITE_TAC[real_div; REAL_ARITH + `&6 * &1 * n1 <= &16 * n1 - &5 * n <=> n <= inv(inv(&2)) * n1`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence an overall lower bound. *) +(* ------------------------------------------------------------------------- *) + +let PRIMERECIP_LBOUND = prove + (`!n. &3 / (&32 * ln(&32)) * &n + <= sum (1 .. 32 EXP (2 EXP n)) (\i. if prime i then &1 / &i else &0)`, + GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&3 / (&16 * ln(&32)) * sum (1 .. 2 EXP n) (\i. &1 / &i)` THEN + REWRITE_TAC[PRIMERECIP_HARMONIC_LBOUND] THEN + REWRITE_TAC[REAL_FIELD + `&3 / (&32 * ln(&32)) * &n = &3 / (&16 * ln(&32)) * (&n / &2)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REWRITE_RULE[real_ge] HARMONIC_LEMMA] THEN + SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; LN_POS; REAL_OF_NUM_LE; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* General lemma. *) +(* ------------------------------------------------------------------------- *) + +let UNBOUNDED_DIVERGENT = prove + (`!s. (!k. ?N. !n. n >= N ==> sum(1..n) s >= k) + ==> ~(convergent(\n. sum(1..n) s))`, + REWRITE_TAC[convergent; SEQ] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT_01] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `l + &1`) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN + DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN + REWRITE_TAC[LE_ADD; ONCE_REWRITE_RULE[ADD_SYM] LE_ADD; GE] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence divergence. *) +(* ------------------------------------------------------------------------- *) + +let PRIMERECIP_DIVERGES_NUMSEG = prove + (`~(convergent (\n. sum (1..n) (\i. if prime i then &1 / &i else &0)))`, + MATCH_MP_TAC UNBOUNDED_DIVERGENT THEN X_GEN_TAC `k:real` THEN + MP_TAC(SPEC `&3 / (&32 * ln(&32))` REAL_ARCH) THEN + SIMP_TAC[REAL_LT_DIV; LN_POS_LT; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(MP_TAC o SPEC `k:real`) THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `32 EXP (2 EXP N)` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; real_ge] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&N * &3 / (&32 * ln (&32))` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum(1 .. 32 EXP (2 EXP N)) (\i. if prime i then &1 / &i else &0)` THEN + REWRITE_TAC[PRIMERECIP_LBOUND] THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`; REAL_LE_ADDR] THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS]);; + +(* ------------------------------------------------------------------------- *) +(* A perhaps more intuitive formulation. *) +(* ------------------------------------------------------------------------- *) + +let PRIMERECIP_DIVERGES = prove + (`~(convergent (\n. sum {p | prime p /\ p <= n} (\p. &1 / &p)))`, + MP_TAC PRIMERECIP_DIVERGES_NUMSEG THEN + MATCH_MP_TAC(TAUT `(a <=> b) ==> ~a ==> ~b`) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL + [SUBGOAL_THEN `{p | prime p /\ p <= 0} = {}` + (fun th -> SIMP_TAC[SUM_CLAUSES; SUM_TRIV_NUMSEG; th; ARITH]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LE] THEN + MESON_TAC[PRIME_0]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + SUBGOAL_THEN + `{p | prime p /\ p <= SUC n} = + if prime(SUC n) then (SUC n) INSERT {p | prime p /\ p <= n} + else {p | prime p /\ p <= n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN + GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LE] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN + SUBGOAL_THEN `FINITE {p | prime p /\ p <= n}` + (fun th -> SIMP_TAC[SUM_CLAUSES; th]) + THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..n` THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; IN_ELIM_THM; SUBSET] THEN + MESON_TAC[PRIME_0; ARITH_RULE `1 <= i <=> ~(i = 0)`]; + REWRITE_TAC[IN_ELIM_THM; ARITH_RULE `~(SUC n <= n)`; REAL_ADD_AC]]);; diff --git a/100/ptolemy.ml b/100/ptolemy.ml new file mode 100644 index 0000000..71af8d6 --- /dev/null +++ b/100/ptolemy.ml @@ -0,0 +1,69 @@ +(* ========================================================================= *) +(* Ptolemy's theorem. *) +(* ========================================================================= *) + +needs "Multivariate/transcendentals.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some 2-vector special cases. *) +(* ------------------------------------------------------------------------- *) + +let DOT_VECTOR = prove + (`(vector [x1;y1] :real^2) dot (vector [x2;y2]) = x1 * x2 + y1 * y2`, + REWRITE_TAC[dot; DIMINDEX_2; SUM_2; VECTOR_2]);; + +(* ------------------------------------------------------------------------- *) +(* Lemma about distance between points with polar coordinates. *) +(* ------------------------------------------------------------------------- *) + +let DIST_SEGMENT_LEMMA = prove + (`!a1 a2. &0 <= a1 /\ a1 <= a2 /\ a2 <= &2 * pi /\ &0 <= radius + ==> dist(centre + radius % vector [cos(a1);sin(a1)] :real^2, + centre + radius % vector [cos(a2);sin(a2)]) = + &2 * radius * sin((a2 - a1) / &2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dist; vector_norm] THEN + MATCH_MP_TAC SQRT_UNIQUE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SIN_POS_PI_LE THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH `(c + r % x) - (c + r % y) = r % (x - y)`] THEN + REWRITE_TAC[VECTOR_ARITH `(r % x) dot (r % x) = (r pow 2) * (x dot x)`] THEN + REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_VECTOR] THEN + SUBST1_TAC(REAL_ARITH `a1 = &2 * a1 / &2`) THEN + SUBST1_TAC(REAL_ARITH `a2 = &2 * a2 / &2`) THEN + REWRITE_TAC[REAL_ARITH `(&2 * x - &2 * y) / &2 = x - y`] THEN + REWRITE_TAC[SIN_SUB; SIN_DOUBLE; COS_DOUBLE] THEN + MP_TAC(SPEC `a1 / &2` SIN_CIRCLE) THEN MP_TAC(SPEC `a2 / &2` SIN_CIRCLE) THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Hence the overall theorem. *) +(* ------------------------------------------------------------------------- *) + +let PTOLEMY = prove + (`!A B C D:real^2 a b c d centre radius. + A = centre + radius % vector [cos(a);sin(a)] /\ + B = centre + radius % vector [cos(b);sin(b)] /\ + C = centre + radius % vector [cos(c);sin(c)] /\ + D = centre + radius % vector [cos(d);sin(d)] /\ + &0 <= radius /\ + &0 <= a /\ a <= b /\ b <= c /\ c <= d /\ d <= &2 * pi + ==> dist(A,C) * dist(B,D) = + dist(A,B) * dist(C,D) + dist(A,D) * dist(B,C)`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o check (is_var o lhs o concl))) THEN + REPEAT + (W(fun (asl,w) -> + let t = find_term + (fun t -> can (PART_MATCH (lhs o rand) DIST_SEGMENT_LEMMA) t) w in + MP_TAC (PART_MATCH (lhs o rand) DIST_SEGMENT_LEMMA t) THEN + ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC])) THEN + REWRITE_TAC[REAL_ARITH `(x - y) / &2 = x / &2 - y / &2`] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t SIN_CIRCLE)) + [`a / &2`; `b / &2`; `c / &2`; `d / &2`] THEN + REWRITE_TAC[SIN_SUB; SIN_ADD; COS_ADD; SIN_PI; COS_PI] THEN + CONV_TAC REAL_RING);; diff --git a/100/pythagoras.ml b/100/pythagoras.ml new file mode 100644 index 0000000..f82bb69 --- /dev/null +++ b/100/pythagoras.ml @@ -0,0 +1,30 @@ +(* ========================================================================= *) +(* A "proof" of Pythagoras's theorem. Of course something similar is *) +(* implicit in the definition of "norm", but maybe this is still nontrivial. *) +(* ========================================================================= *) + +needs "Multivariate/misc.ml";; +needs "Multivariate/vectors.ml";; + +(* ------------------------------------------------------------------------- *) +(* Direct vector proof (could replace 2 by N and the proof still runs). *) +(* ------------------------------------------------------------------------- *) + +let PYTHAGORAS = prove + (`!A B C:real^2. + orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, + REWRITE_TAC[NORM_POW_2; orthogonal; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* A more explicit and laborious "componentwise" specifically for 2-vectors. *) +(* ------------------------------------------------------------------------- *) + +let PYTHAGORAS = prove + (`!A B C:real^2. + orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, + SIMP_TAC[NORM_POW_2; orthogonal; dot; SUM_2; DIMINDEX_2; + VECTOR_SUB_COMPONENT; ARITH] THEN + CONV_TAC REAL_RING);; diff --git a/100/quartic.ml b/100/quartic.ml new file mode 100644 index 0000000..6f39906 --- /dev/null +++ b/100/quartic.ml @@ -0,0 +1,202 @@ +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* First the R = 0 case. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_1 = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + R = &0 /\ + s pow 2 = y pow 2 - &4 * d /\ + D pow 2 = &3 * a pow 2 / &4 - &2 * b + &2 * s /\ + x = --a / &4 + R / &2 + D / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_RING);; + +let QUARTIC_2 = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + R = &0 /\ + s pow 2 = y pow 2 - &4 * d /\ + D pow 2 = &3 * a pow 2 / &4 - &2 * b + &2 * s /\ + x = --a / &4 + R / &2 - D / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_RING);; + +let QUARTIC_3 = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + R = &0 /\ + s pow 2 = y pow 2 - &4 * d /\ + E pow 2 = &3 * a pow 2 / &4 - &2 * b - &2 * s /\ + x = --a / &4 - R / &2 + E / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_RING);; + +let QUARTIC_4 = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + R = &0 /\ + s pow 2 = y pow 2 - &4 * d /\ + E pow 2 = &3 * a pow 2 / &4 - &2 * b - &2 * s /\ + x = --a / &4 - R / &2 - E / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_RING);; + + +(* ------------------------------------------------------------------------- *) +(* The R nonzero case. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_1' = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + ~(R = &0) /\ + D pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ + x = --a / &4 + R / &2 + D / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_FIELD);; + +let QUARTIC_2' = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + ~(R = &0) /\ + D pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ + x = --a / &4 + R / &2 - D / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_FIELD);; + +let QUARTIC_3' = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + ~(R = &0) /\ + E pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b - + (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ + x = --a / &4 - R / &2 + E / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_FIELD);; + +let QUARTIC_4' = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + ~(R = &0) /\ + E pow 2 = &3 * a pow 2 / &4 - R pow 2 - &2 * b - + (&4 * a * b - &8 * c - a pow 3) / (&4 * R) /\ + x = --a / &4 - R / &2 - E / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Combine them. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_1 = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + s pow 2 = y pow 2 - &4 * d /\ + (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + x = --a / &4 + R / &2 + D / &2 + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* A case split. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_1 = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + s pow 2 = y pow 2 - &4 * d /\ + (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b - + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + (x = --a / &4 + R / &2 + D / &2 \/ + x = --a / &4 - R / &2 + E / &2) + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* More general case split. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_CASES = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + s pow 2 = y pow 2 - &4 * d /\ + (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b - + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + (x = --a / &4 + R / &2 + D / &2 \/ + x = --a / &4 + R / &2 - D / &2 \/ + x = --a / &4 - R / &2 + E / &2 \/ + x = --a / &4 - R / &2 - E / &2) + ==> x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0`, + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Even this works --- great, that's nearly what we wanted. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_CASES = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + s pow 2 = y pow 2 - &4 * d /\ + (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b - + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) + ==> (x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0 <=> + x = --a / &4 + R / &2 + D / &2 \/ + x = --a / &4 + R / &2 - D / &2 \/ + x = --a / &4 - R / &2 + E / &2 \/ + x = --a / &4 - R / &2 - E / &2)`, + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* This is the automatic proof. *) +(* ------------------------------------------------------------------------- *) + +let QUARTIC_CASES = prove + (`y pow 3 - b * y pow 2 + (a * c - &4 * d) * y - + a pow 2 * d + &4 * b * d - c pow 2 = &0 /\ + R pow 2 = a pow 2 / &4 - b + y /\ + s pow 2 = y pow 2 - &4 * d /\ + (D pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b + &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b + + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) /\ + (E pow 2 = if R = &0 then &3 * a pow 2 / &4 - &2 * b - &2 * s + else &3 * a pow 2 / &4 - R pow 2 - &2 * b - + (&4 * a * b - &8 * c - a pow 3) / (&4 * R)) + ==> (x pow 4 + a * x pow 3 + b * x pow 2 + c * x + d = &0 <=> + x = --a / &4 + R / &2 + D / &2 \/ + x = --a / &4 + R / &2 - D / &2 \/ + x = --a / &4 - R / &2 + E / &2 \/ + x = --a / &4 - R / &2 - E / &2)`, + CONV_TAC REAL_FIELD);; diff --git a/100/ramsey.ml b/100/ramsey.ml new file mode 100644 index 0000000..3b6c792 --- /dev/null +++ b/100/ramsey.ml @@ -0,0 +1,1278 @@ +(* ======================================================================== *) +(* Infinite Ramsey's theorem. *) +(* *) +(* Port to HOL Light of a HOL88 proof done on 9th May 1994 *) +(* ======================================================================== *) + +(* ------------------------------------------------------------------------- *) +(* HOL88 compatibility. *) +(* ------------------------------------------------------------------------- *) + +let is_neg_imp tm = + is_neg tm or is_imp tm;; + +let dest_neg_imp tm = + try dest_imp tm with Failure _ -> + try (dest_neg tm,mk_const("F",[])) + with Failure _ -> failwith "dest_neg_imp";; + +(* ------------------------------------------------------------------------- *) +(* These get overwritten by the subgoal stuff. *) +(* ------------------------------------------------------------------------- *) + +let PROVE = prove;; + +let prove_thm((s:string),g,t) = prove(g,t);; + +(* ------------------------------------------------------------------------- *) +(* The quantifier movement conversions. *) +(* ------------------------------------------------------------------------- *) + +let (CONV_OF_RCONV: conv -> conv) = + let rec get_bv tm = + if is_abs tm then bndvar tm + else if is_comb tm then try get_bv (rand tm) with Failure _ -> get_bv (rator tm) + else failwith "" in + fun conv tm -> + let v = get_bv tm in + let th1 = conv tm in + let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in + TRANS th1 th2;; + +let (CONV_OF_THM: thm -> conv) = + CONV_OF_RCONV o REWR_CONV;; + +let (X_FUN_EQ_CONV:term->conv) = + fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;; + +let (FUN_EQ_CONV:conv) = + fun tm -> + let vars = frees tm in + let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in + if op = "fun" + then let varnm = + if (is_vartype ty1) then "x" else + hd(explode(fst(dest_type ty1))) in + let x = variant vars (mk_var(varnm,ty1)) in + X_FUN_EQ_CONV x tm + else failwith "FUN_EQ_CONV";; + +let (SINGLE_DEPTH_CONV:conv->conv) = + let rec SINGLE_DEPTH_CONV conv tm = + try conv tm with Failure _ -> + (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in + SINGLE_DEPTH_CONV;; + +let (SKOLEM_CONV:conv) = + SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);; + +let (X_SKOLEM_CONV:term->conv) = + fun v -> SKOLEM_CONV THENC GEN_ALPHA_CONV v;; + +let EXISTS_UNIQUE_CONV tm = + let v = bndvar(rand tm) in + let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in + let tm1 = rhs(concl th1) in + let vars = frees tm1 in + let v = variant vars v in + let v' = variant (v::vars) v in + let th2 = + (LAND_CONV(GEN_ALPHA_CONV v) THENC + RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC + GEN_ALPHA_CONV v)) tm1 in + TRANS th1 th2;; + +let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;; + +let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;; + +let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;; + +let FORALL_IMP_CONV = CONV_OF_RCONV + (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC + REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC + REWR_CONV LEFT_FORALL_IMP_THM);; + +let EXISTS_AND_CONV = CONV_OF_RCONV + (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC + REWR_CONV LEFT_EXISTS_AND_THM ORELSEC + REWR_CONV RIGHT_EXISTS_AND_THM);; + +let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;; + +let LEFT_AND_EXISTS_CONV tm = + let v = bndvar(rand(rand(rator tm))) in + (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;; + +let RIGHT_AND_EXISTS_CONV = + CONV_OF_THM RIGHT_AND_EXISTS_THM;; + +let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;; + +(* ------------------------------------------------------------------------- *) +(* The slew of named tautologies. *) +(* ------------------------------------------------------------------------- *) + +let AND1_THM = TAUT `!t1 t2. t1 /\ t2 ==> t1`;; + +let AND2_THM = TAUT `!t1 t2. t1 /\ t2 ==> t2`;; + +let AND_IMP_INTRO = TAUT `!t1 t2 t3. t1 ==> t2 ==> t3 = t1 /\ t2 ==> t3`;; + +let AND_INTRO_THM = TAUT `!t1 t2. t1 ==> t2 ==> t1 /\ t2`;; + +let BOOL_EQ_DISTINCT = TAUT `~(T <=> F) /\ ~(F <=> T)`;; + +let EQ_EXPAND = TAUT `!t1 t2. (t1 <=> t2) <=> t1 /\ t2 \/ ~t1 /\ ~t2`;; + +let EQ_IMP_THM = TAUT `!t1 t2. (t1 <=> t2) <=> (t1 ==> t2) /\ (t2 ==> t1)`;; + +let FALSITY = TAUT `!t. F ==> t`;; + +let F_IMP = TAUT `!t. ~t ==> t ==> F`;; + +let IMP_DISJ_THM = TAUT `!t1 t2. t1 ==> t2 <=> ~t1 \/ t2`;; + +let IMP_F = TAUT `!t. (t ==> F) ==> ~t`;; + +let IMP_F_EQ_F = TAUT `!t. t ==> F <=> (t <=> F)`;; + +let LEFT_AND_OVER_OR = TAUT + `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;; + +let LEFT_OR_OVER_AND = TAUT + `!t1 t2 t3. t1 \/ t2 /\ t3 <=> (t1 \/ t2) /\ (t1 \/ t3)`;; + +let NOT_AND = TAUT `~(t /\ ~t)`;; + +let NOT_F = TAUT `!t. ~t ==> (t <=> F)`;; + +let OR_ELIM_THM = TAUT + `!t t1 t2. t1 \/ t2 ==> (t1 ==> t) ==> (t2 ==> t) ==> t`;; + +let OR_IMP_THM = TAUT `!t1 t2. (t1 <=> t2 \/ t1) <=> t2 ==> t1`;; + +let OR_INTRO_THM1 = TAUT `!t1 t2. t1 ==> t1 \/ t2`;; + +let OR_INTRO_THM2 = TAUT `!t1 t2. t2 ==> t1 \/ t2`;; + +let RIGHT_AND_OVER_OR = TAUT + `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;; + +let RIGHT_OR_OVER_AND = TAUT + `!t1 t2 t3. t2 /\ t3 \/ t1 <=> (t2 \/ t1) /\ (t3 \/ t1)`;; + +(* ------------------------------------------------------------------------- *) +(* This is an overwrite -- is there any point in what I have? *) +(* ------------------------------------------------------------------------- *) + +let is_type = can get_type_arity;; + +(* ------------------------------------------------------------------------- *) +(* I suppose this is also useful. *) +(* ------------------------------------------------------------------------- *) + +let is_constant = can get_const_type;; + +(* ------------------------------------------------------------------------- *) +(* Misc. *) +(* ------------------------------------------------------------------------- *) + +let null l = l = [];; + +(* ------------------------------------------------------------------------- *) +(* Syntax. *) +(* ------------------------------------------------------------------------- *) + +let type_tyvars = type_vars_in_term o curry mk_var "x";; + +let find_match u = + let rec find_mt t = + try term_match [] u t with Failure _ -> + try find_mt(rator t) with Failure _ -> + try find_mt(rand t) with Failure _ -> + try find_mt(snd(dest_abs t)) + with Failure _ -> failwith "find_match" in + fun t -> let _,tmin,tyin = find_mt t in + tmin,tyin;; + +let rec mk_primed_var(name,ty) = + if can get_const_type name then mk_primed_var(name^"'",ty) + else mk_var(name,ty);; + +let subst_occs = + let rec subst_occs slist tm = + let applic,noway = partition (fun (i,(t,x)) -> aconv tm x) slist in + let sposs = map (fun (l,z) -> let l1,l2 = partition ((=) 1) l in + (l1,z),(l2,z)) applic in + let racts,rrest = unzip sposs in + let acts = filter (fun t -> not (fst t = [])) racts in + let trest = map (fun (n,t) -> (map (C (-) 1) n,t)) rrest in + let urest = filter (fun t -> not (fst t = [])) trest in + let tlist = urest @ noway in + if acts = [] then + if is_comb tm then + let l,r = dest_comb tm in + let l',s' = subst_occs tlist l in + let r',s'' = subst_occs s' r in + mk_comb(l',r'),s'' + else if is_abs tm then + let bv,bod = dest_abs tm in + let gv = genvar(type_of bv) in + let nbod = vsubst[gv,bv] bod in + let tm',s' = subst_occs tlist nbod in + alpha bv (mk_abs(gv,tm')),s' + else + tm,tlist + else + let tm' = (fun (n,(t,x)) -> subst[t,x] tm) (hd acts) in + tm',tlist in + fun ilist slist tm -> fst(subst_occs (zip ilist slist) tm);; + +(* ------------------------------------------------------------------------- *) +(* Note that the all-instantiating INST and INST_TYPE are not overwritten. *) +(* ------------------------------------------------------------------------- *) + +let INST_TY_TERM(substl,insttyl) th = + let th' = INST substl (INST_TYPE insttyl th) in + if hyp th' = hyp th then th' + else failwith "INST_TY_TERM: Free term and/or type variables in hypotheses";; + +(* ------------------------------------------------------------------------- *) +(* Conversions stuff. *) +(* ------------------------------------------------------------------------- *) + +let RIGHT_CONV_RULE (conv:conv) th = + TRANS th (conv(rhs(concl th)));; + +(* ------------------------------------------------------------------------- *) +(* Derived rules. *) +(* ------------------------------------------------------------------------- *) + +let NOT_EQ_SYM = + let pth = GENL [`a:A`; `b:A`] + (GEN_REWRITE_RULE I [GSYM CONTRAPOS_THM] (DISCH_ALL(SYM(ASSUME`a:A = b`)))) + and aty = `:A` in + fun th -> try let l,r = dest_eq(dest_neg(concl th)) in + MP (SPECL [r; l] (INST_TYPE [type_of l,aty] pth)) th + with Failure _ -> failwith "NOT_EQ_SYM";; + +let NOT_MP thi th = + try MP thi th with Failure _ -> + try let t = dest_neg (concl thi) in + MP(MP (SPEC t F_IMP) thi) th + with Failure _ -> failwith "NOT_MP";; + +let FORALL_EQ x = + let mkall = AP_TERM (mk_const("!",[type_of x,mk_vartype "A"])) in + fun th -> try mkall (ABS x th) + with Failure _ -> failwith "FORALL_EQ";; + +let EXISTS_EQ x = + let mkex = AP_TERM (mk_const("?",[type_of x,mk_vartype "A"])) in + fun th -> try mkex (ABS x th) + with Failure _ -> failwith "EXISTS_EQ";; + +let SELECT_EQ x = + let mksel = AP_TERM (mk_const("@",[type_of x,mk_vartype "A"])) in + fun th -> try mksel (ABS x th) + with Failure _ -> failwith "SELECT_EQ";; + +let RIGHT_BETA th = + try TRANS th (BETA_CONV(rhs(concl th))) + with Failure _ -> failwith "RIGHT_BETA";; + +let rec LIST_BETA_CONV tm = + try let rat,rnd = dest_comb tm in + RIGHT_BETA(AP_THM(LIST_BETA_CONV rat)rnd) + with Failure _ -> REFL tm;; + +let RIGHT_LIST_BETA th = TRANS th (LIST_BETA_CONV(snd(dest_eq(concl th))));; + +let LIST_CONJ = end_itlist CONJ ;; + +let rec CONJ_LIST n th = + try if n=1 then [th] else (CONJUNCT1 th)::(CONJ_LIST (n-1) (CONJUNCT2 th)) + with Failure _ -> failwith "CONJ_LIST";; + +let rec BODY_CONJUNCTS th = + if is_forall(concl th) then + BODY_CONJUNCTS (SPEC_ALL th) else + if is_conj (concl th) then + BODY_CONJUNCTS (CONJUNCT1 th) @ BODY_CONJUNCTS (CONJUNCT2 th) + else [th];; + +let rec IMP_CANON th = + let w = concl th in + if is_conj w then IMP_CANON (CONJUNCT1 th) @ IMP_CANON (CONJUNCT2 th) + else if is_imp w then + let ante,conc = dest_neg_imp w in + if is_conj ante then + let a,b = dest_conj ante in + IMP_CANON + (DISCH a (DISCH b (NOT_MP th (CONJ (ASSUME a) (ASSUME b))))) + else if is_disj ante then + let a,b = dest_disj ante in + IMP_CANON (DISCH a (NOT_MP th (DISJ1 (ASSUME a) b))) @ + IMP_CANON (DISCH b (NOT_MP th (DISJ2 a (ASSUME b)))) + else if is_exists ante then + let x,body = dest_exists ante in + let x' = variant (thm_frees th) x in + let body' = subst [x',x] body in + IMP_CANON + (DISCH body' (NOT_MP th (EXISTS (ante, x') (ASSUME body')))) + else + map (DISCH ante) (IMP_CANON (UNDISCH th)) + else if is_forall w then + IMP_CANON (SPEC_ALL th) + else [th];; + +let LIST_MP = rev_itlist (fun x y -> MP y x);; + +let DISJ_IMP = + let pth = TAUT`!t1 t2. t1 \/ t2 ==> ~t1 ==> t2` in + fun th -> + try let a,b = dest_disj(concl th) in MP (SPECL [a;b] pth) th + with Failure _ -> failwith "DISJ_IMP";; + +let IMP_ELIM = + let pth = TAUT`!t1 t2. (t1 ==> t2) ==> ~t1 \/ t2` in + fun th -> + try let a,b = dest_imp(concl th) in MP (SPECL [a;b] pth) th + with Failure _ -> failwith "IMP_ELIM";; + +let DISJ_CASES_UNION dth ath bth = + DISJ_CASES dth (DISJ1 ath (concl bth)) (DISJ2 (concl ath) bth);; + +let MK_ABS qth = + try let ov = bndvar(rand(concl qth)) in + let bv,rth = SPEC_VAR qth in + let sth = ABS bv rth in + let cnv = ALPHA_CONV ov in + CONV_RULE(BINOP_CONV cnv) sth + with Failure _ -> failwith "MK_ABS";; + +let HALF_MK_ABS th = + try let th1 = MK_ABS th in + CONV_RULE(LAND_CONV ETA_CONV) th1 + with Failure _ -> failwith "HALF_MK_ABS";; + +let MK_EXISTS qth = + try let ov = bndvar(rand(concl qth)) in + let bv,rth = SPEC_VAR qth in + let sth = EXISTS_EQ bv rth in + let cnv = GEN_ALPHA_CONV ov in + CONV_RULE(BINOP_CONV cnv) sth + with Failure _ -> failwith "MK_EXISTS";; + +let LIST_MK_EXISTS l th = itlist (fun x th -> MK_EXISTS(GEN x th)) l th;; + +let IMP_CONJ th1 th2 = + let A1,C1 = dest_imp (concl th1) and A2,C2 = dest_imp (concl th2) in + let a1,a2 = CONJ_PAIR (ASSUME (mk_conj(A1,A2))) in + DISCH (mk_conj(A1,A2)) (CONJ (MP th1 a1) (MP th2 a2));; + +let EXISTS_IMP x = + if not (is_var x) then failwith "EXISTS_IMP: first argument not a variable" + else fun th -> + try let ante,cncl = dest_imp(concl th) in + let th1 = EXISTS (mk_exists(x,cncl),x) (UNDISCH th) in + let asm = mk_exists(x,ante) in + DISCH asm (CHOOSE (x,ASSUME asm) th1) + with Failure _ -> failwith "EXISTS_IMP: variable free in assumptions";; + + +let CONJUNCTS_CONV (t1,t2) = + let rec build_conj thl t = + try let l,r = dest_conj t in + CONJ (build_conj thl l) (build_conj thl r) + with Failure _ -> find (fun th -> concl th = t) thl in + try IMP_ANTISYM_RULE + (DISCH t1 (build_conj (CONJUNCTS (ASSUME t1)) t2)) + (DISCH t2 (build_conj (CONJUNCTS (ASSUME t2)) t1)) + with Failure _ -> failwith "CONJUNCTS_CONV";; + +let CONJ_SET_CONV l1 l2 = + try CONJUNCTS_CONV (list_mk_conj l1, list_mk_conj l2) + with Failure _ -> failwith "CONJ_SET_CONV";; + +let FRONT_CONJ_CONV tml t = + let rec remove x l = + if hd l = x then tl l else (hd l)::(remove x (tl l)) in + try CONJ_SET_CONV tml (t::(remove t tml)) + with Failure _ -> failwith "FRONT_CONJ_CONV";; + +let CONJ_DISCH = + let pth = TAUT`!t t1 t2. (t ==> (t1 <=> t2)) ==> (t /\ t1 <=> t /\ t2)` in + fun t th -> + try let t1,t2 = dest_eq(concl th) in + MP (SPECL [t; t1; t2] pth) (DISCH t th) + with Failure _ -> failwith "CONJ_DISCH";; + +let rec CONJ_DISCHL l th = + if l = [] then th else CONJ_DISCH (hd l) (CONJ_DISCHL (tl l) th);; + +let rec GSPEC th = + let wl,w = dest_thm th in + if is_forall w then + GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) + else th;; + +let ANTE_CONJ_CONV tm = + try let (a1,a2),c = (dest_conj F_F I) (dest_imp tm) in + let imp1 = MP (ASSUME tm) (CONJ (ASSUME a1) (ASSUME a2)) and + imp2 = LIST_MP [CONJUNCT1 (ASSUME (mk_conj(a1,a2))); + CONJUNCT2 (ASSUME (mk_conj(a1,a2)))] + (ASSUME (mk_imp(a1,mk_imp(a2,c)))) in + IMP_ANTISYM_RULE (DISCH_ALL (DISCH a1 (DISCH a2 imp1))) + (DISCH_ALL (DISCH (mk_conj(a1,a2)) imp2)) + with Failure _ -> failwith "ANTE_CONJ_CONV";; + +let bool_EQ_CONV = + let check = let boolty = `:bool` in check (fun tm -> type_of tm = boolty) in + let clist = map (GEN `b:bool`) + (CONJUNCTS(SPEC `b:bool` EQ_CLAUSES)) in + let tb = hd clist and bt = hd(tl clist) in + let T = `T` and F = `F` in + fun tm -> + try let l,r = (I F_F check) (dest_eq tm) in + if l = r then EQT_INTRO (REFL l) else + if l = T then SPEC r tb else + if r = T then SPEC l bt else fail() + with Failure _ -> failwith "bool_EQ_CONV";; + +let COND_CONV = + let T = `T` and F = `F` and vt = genvar`:A` and vf = genvar `:A` in + let gen = GENL [vt;vf] in + let CT,CF = (gen F_F gen) (CONJ_PAIR (SPECL [vt;vf] COND_CLAUSES)) in + fun tm -> + let P,(u,v) = try dest_cond tm + with Failure _ -> failwith "COND_CONV: not a conditional" in + let ty = type_of u in + if (P=T) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CT)) else + if (P=F) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CF)) else + if (u=v) then SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) else + if (aconv u v) then + let cnd = AP_TERM (rator tm) (ALPHA v u) in + let thm = SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) in + TRANS cnd thm else + failwith "COND_CONV: can't simplify conditional";; + +let SUBST_MATCH eqth th = + let tm_inst,ty_inst = find_match (lhs(concl eqth)) (concl th) in + SUBS [INST tm_inst (INST_TYPE ty_inst eqth)] th;; + +let SUBST thl pat th = + let eqs,vs = unzip thl in + let gvs = map (genvar o type_of) vs in + let gpat = subst (zip gvs vs) pat in + let ls,rs = unzip (map (dest_eq o concl) eqs) in + let ths = map (ASSUME o mk_eq) (zip gvs rs) in + let th1 = ASSUME gpat in + let th2 = SUBS ths th1 in + let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in + let th4 = INST (zip ls gvs) th3 in + MP (rev_itlist (C MP) eqs th4) th;; + +(* let GSUBS = ... *) +(* let SUBS_OCCS = ... *) + +(* A poor thing but mine own. The old ones use mk_thm and the commented + out functions are bogus. *) + +let SUBST_CONV thvars template tm = + let thms,vars = unzip thvars in + let gvs = map (genvar o type_of) vars in + let gtemplate = subst (zip gvs vars) template in + SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; + +(* ------------------------------------------------------------------------- *) +(* Filtering rewrites. *) +(* ------------------------------------------------------------------------- *) + +let FILTER_PURE_ASM_REWRITE_RULE f thl th = + PURE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th + +and FILTER_ASM_REWRITE_RULE f thl th = + REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th + +and FILTER_PURE_ONCE_ASM_REWRITE_RULE f thl th = + PURE_ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th + +and FILTER_ONCE_ASM_REWRITE_RULE f thl th = + ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th;; + +let (FILTER_PURE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + PURE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) + +and (FILTER_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) + +and (FILTER_PURE_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + PURE_ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) + +and (FILTER_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Tacticals. *) +(* ------------------------------------------------------------------------- *) + +let (X_CASES_THENL: term list list -> thm_tactic list -> thm_tactic) = + fun varsl ttacl -> + end_itlist DISJ_CASES_THEN2 + (map (fun (vars,ttac) -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) + (zip varsl ttacl));; + +let (X_CASES_THEN: term list list -> thm_tactical) = + fun varsl ttac -> + end_itlist DISJ_CASES_THEN2 + (map (fun vars -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) varsl);; + +let (CASES_THENL: thm_tactic list -> thm_tactic) = + fun ttacl -> end_itlist DISJ_CASES_THEN2 (map (REPEAT_TCL CHOOSE_THEN) ttacl);; + +(* ------------------------------------------------------------------------- *) +(* Tactics. *) +(* ------------------------------------------------------------------------- *) + +let (DISCARD_TAC: thm_tactic) = + let truth = `T` in + fun th (asl,w) -> + if exists (aconv (concl th)) (truth::(map (concl o snd) asl)) + then ALL_TAC (asl,w) + else failwith "DISCARD_TAC";; + +let (CHECK_ASSUME_TAC: thm_tactic) = + fun gth -> + FIRST [CONTR_TAC gth; ACCEPT_TAC gth; + DISCARD_TAC gth; ASSUME_TAC gth];; + +let (FILTER_GEN_TAC: term -> tactic) = + fun tm (asl,w) -> + if is_forall w & not (tm = fst(dest_forall w)) then + GEN_TAC (asl,w) + else failwith "FILTER_GEN_TAC";; + +let (FILTER_DISCH_THEN: thm_tactic -> term -> tactic) = + fun ttac tm (asl,w) -> + if is_neg_imp w & not (free_in tm (fst(dest_neg_imp w))) then + DISCH_THEN ttac (asl,w) + else failwith "FILTER_DISCH_THEN";; + +let FILTER_STRIP_THEN ttac tm = + FIRST [FILTER_GEN_TAC tm; FILTER_DISCH_THEN ttac tm; CONJ_TAC];; + +let FILTER_DISCH_TAC = FILTER_DISCH_THEN STRIP_ASSUME_TAC;; + +let FILTER_STRIP_TAC = FILTER_STRIP_THEN STRIP_ASSUME_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Conversions for quantifier movement using proforma theorems. *) +(* ------------------------------------------------------------------------- *) + +(* let ....... *) + +(* ------------------------------------------------------------------------- *) +(* Resolution stuff. *) +(* ------------------------------------------------------------------------- *) + +let RES_CANON = + let not_elim th = + if is_neg (concl th) then true,(NOT_ELIM th) else (false,th) in + let rec canon fl th = + let w = concl th in + if (is_conj w) then + let (th1,th2) = CONJ_PAIR th in (canon fl th1) @ (canon fl th2) else + if ((is_imp w) & not(is_neg w)) then + let ante,conc = dest_neg_imp w in + if (is_conj ante) then + let a,b = dest_conj ante in + let cth = NOT_MP th (CONJ (ASSUME a) (ASSUME b)) in + let th1 = DISCH b cth and th2 = DISCH a cth in + (canon true (DISCH a th1)) @ (canon true (DISCH b th2)) else + if (is_disj ante) then + let a,b = dest_disj ante in + let ath = DISJ1 (ASSUME a) b and bth = DISJ2 a (ASSUME b) in + let th1 = DISCH a (NOT_MP th ath) and + th2 = DISCH b (NOT_MP th bth) in + (canon true th1) @ (canon true th2) else + if (is_exists ante) then + let v,body = dest_exists ante in + let newv = variant (thm_frees th) v in + let newa = subst [newv,v] body in + let th1 = NOT_MP th (EXISTS (ante, newv) (ASSUME newa)) in + canon true (DISCH newa th1) else + map (GEN_ALL o (DISCH ante)) (canon true (UNDISCH th)) else + if (is_eq w & (type_of (rand w) = `:bool`)) then + let (th1,th2) = EQ_IMP_RULE th in + (if fl then [GEN_ALL th] else []) @ (canon true th1) @ (canon true th2) else + if (is_forall w) then + let vs,body = strip_forall w in + let fvs = thm_frees th in + let vfn = fun l -> variant (l @ fvs) in + let nvs = itlist (fun v nv -> let v' = vfn nv v in (v'::nv)) vs [] in + canon fl (SPECL nvs th) else + if fl then [GEN_ALL th] else [] in + fun th -> try let args = map (not_elim o SPEC_ALL) (CONJUNCTS (SPEC_ALL th)) in + let imps = flat (map (map GEN_ALL o (uncurry canon)) args) in + check (fun l -> l <> []) imps + with Failure _ -> + failwith "RES_CANON: no implication is derivable from input thm.";; + +let IMP_RES_THEN,RES_THEN = + let MATCH_MP impth = + let sth = SPEC_ALL impth in + let matchfn = (fun (a,b,c) -> b,c) o + term_match [] (fst(dest_neg_imp(concl sth))) in + fun th -> NOT_MP (INST_TY_TERM (matchfn (concl th)) sth) th in + let check st l = (if l = [] then failwith st else l) in + let IMP_RES_THEN ttac impth = + let ths = try RES_CANON impth with Failure _ -> failwith "IMP_RES_THEN: no implication" in + ASSUM_LIST + (fun asl -> + let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asl)) ths [] in + let res = check "IMP_RES_THEN: no resolvents " l in + let tacs = check "IMP_RES_THEN: no tactics" (mapfilter ttac res) in + EVERY tacs) in + let RES_THEN ttac (asl,g) = + let asm = map snd asl in + let ths = itlist (@) (mapfilter RES_CANON asm) [] in + let imps = check "RES_THEN: no implication" ths in + let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asm)) imps [] in + let res = check "RES_THEN: no resolvents " l in + let tacs = check "RES_THEN: no tactics" (mapfilter ttac res) in + EVERY tacs (asl,g) in + IMP_RES_THEN,RES_THEN;; + +let IMP_RES_TAC th g = + try IMP_RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) th g + with Failure _ -> ALL_TAC g;; + +let RES_TAC g = + try RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) g + with Failure _ -> ALL_TAC g;; + +(* ------------------------------------------------------------------------- *) +(* Stuff for handling type definitions. *) +(* ------------------------------------------------------------------------- *) + +let prove_rep_fn_one_one th = + try let thm = CONJUNCT1 th in + let A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl thm))))) in + let _,[aty;rty] = dest_type (type_of R) in + let a = mk_primed_var("a",aty) in let a' = variant [a] a in + let a_eq_a' = mk_eq(a,a') and + Ra_eq_Ra' = mk_eq(mk_comb(R,a),mk_comb (R,a')) in + let th1 = AP_TERM A (ASSUME Ra_eq_Ra') in + let ga1 = genvar aty and ga2 = genvar aty in + let th2 = SUBST [SPEC a thm,ga1;SPEC a' thm,ga2] (mk_eq(ga1,ga2)) th1 in + let th3 = DISCH a_eq_a' (AP_TERM R (ASSUME a_eq_a')) in + GEN a (GEN a' (IMP_ANTISYM_RULE (DISCH Ra_eq_Ra' th2) th3)) + with Failure _ -> failwith "prove_rep_fn_one_one";; + +let prove_rep_fn_onto th = + try let [th1;th2] = CONJUNCTS th in + let r,eq = (I F_F rhs)(dest_forall(concl th2)) in + let RE,ar = dest_comb(lhs eq) and + sr = (mk_eq o (fun (x,y) -> y,x) o dest_eq) eq in + let a = mk_primed_var ("a",type_of ar) in + let sra = mk_eq(r,mk_comb(RE,a)) in + let ex = mk_exists(a,sra) in + let imp1 = EXISTS (ex,ar) (SYM(ASSUME eq)) in + let v = genvar (type_of r) and + A = rator ar and + s' = AP_TERM RE (SPEC a th1) in + let th = SUBST[SYM(ASSUME sra),v](mk_eq(mk_comb(RE,mk_comb(A,v)),v))s' in + let imp2 = CHOOSE (a,ASSUME ex) th in + let swap = IMP_ANTISYM_RULE (DISCH eq imp1) (DISCH ex imp2) in + GEN r (TRANS (SPEC r th2) swap) + with Failure _ -> failwith "prove_rep_fn_onto";; + +let prove_abs_fn_onto th = + try let [th1;th2] = CONJUNCTS th in + let a,(A,R) = (I F_F ((I F_F rator)o dest_comb o lhs)) + (dest_forall(concl th1)) in + let thm1 = EQT_ELIM(TRANS (SPEC (mk_comb (R,a)) th2) + (EQT_INTRO (AP_TERM R (SPEC a th1)))) in + let thm2 = SYM(SPEC a th1) in + let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) in + let ex = mk_exists(r,mk_conj(mk_eq(a,mk_comb(A,r)),mk_comb(P,r))) in + GEN a (EXISTS(ex,mk_comb(R,a)) (CONJ thm2 thm1)) + with Failure _ -> failwith "prove_abs_fn_onto";; + +let prove_abs_fn_one_one th = + try let [th1;th2] = CONJUNCTS th in + let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) and + A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl th1))))) in + let r' = variant [r] r in + let as1 = ASSUME(mk_comb(P,r)) and as2 = ASSUME(mk_comb(P,r')) in + let t1 = EQ_MP (SPEC r th2) as1 and t2 = EQ_MP (SPEC r' th2) as2 in + let eq = (mk_eq(mk_comb(A,r),mk_comb(A,r'))) in + let v1 = genvar(type_of r) and v2 = genvar(type_of r) in + let i1 = DISCH eq + (SUBST [t1,v1;t2,v2] (mk_eq(v1,v2)) (AP_TERM R (ASSUME eq))) and + i2 = DISCH (mk_eq(r,r')) (AP_TERM A (ASSUME (mk_eq(r,r')))) in + let thm = IMP_ANTISYM_RULE i1 i2 in + let disch = DISCH (mk_comb(P,r)) (DISCH (mk_comb(P,r')) thm) in + GEN r (GEN r' disch) + with Failure _ -> failwith "prove_abs_fn_one_one";; + +(* ------------------------------------------------------------------------- *) +(* AC rewriting needs to be wrapped up as a special conversion. *) +(* ------------------------------------------------------------------------- *) + +let AC_CONV(assoc,sym) = + let th1 = SPEC_ALL assoc + and th2 = SPEC_ALL sym in + let th3 = GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) [th2] th1 in + let th4 = SYM th1 in + let th5 = GEN_REWRITE_RULE RAND_CONV [th4] th3 in + EQT_INTRO o AC(end_itlist CONJ [th2; th4; th5]);; + +let AC_RULE ths = EQT_ELIM o AC_CONV ths;; + +(* ------------------------------------------------------------------------- *) +(* The order of picking conditionals is different! *) +(* ------------------------------------------------------------------------- *) + +let (COND_CASES_TAC :tactic) = + let is_good_cond tm = + try not(is_const(fst(dest_cond tm))) + with Failure _ -> false in + fun (asl,w) -> + let cond = find_term (fun tm -> is_good_cond tm & free_in tm w) w in + let p,(t,u) = dest_cond cond in + let inst = INST_TYPE [type_of t, `:A`] COND_CLAUSES in + let (ct,cf) = CONJ_PAIR (SPEC u (SPEC t inst)) in + DISJ_CASES_THEN2 + (fun th -> SUBST1_TAC (EQT_INTRO th) THEN + SUBST1_TAC ct THEN ASSUME_TAC th) + (fun th -> SUBST1_TAC (EQF_INTRO th) THEN + SUBST1_TAC cf THEN ASSUME_TAC th) + (SPEC p EXCLUDED_MIDDLE) + (asl,w) ;; + +(* ------------------------------------------------------------------------- *) +(* MATCH_MP_TAC allows universals on the right of implication. *) +(* Here's a crude hack to allow it. *) +(* ------------------------------------------------------------------------- *) + +let MATCH_MP_TAC th = + MATCH_MP_TAC th ORELSE + MATCH_MP_TAC(PURE_REWRITE_RULE[RIGHT_IMP_FORALL_THM] th);; + +(* ------------------------------------------------------------------------- *) +(* Various theorems have different names. *) +(* ------------------------------------------------------------------------- *) + +let ZERO_LESS_EQ = LE_0;; + +let LESS_EQ_MONO = LE_SUC;; + +let NOT_LESS = NOT_LT;; + +let LESS_0 = LT_0;; + +let LESS_EQ_REFL = LE_REFL;; + +let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));; + +let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));; + +let LESS_TRANS = LT_TRANS;; + +let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));; + +let LESS_SUC_REFL = prove(`!n. n < SUC n`,REWRITE_TAC[LT]);; + +let FACT_LESS = FACT_LT;; + +let LESS_EQ_SUC_REFL = prove(`!n. n <= SUC n`,REWRITE_TAC[LE; LE_REFL]);; + +let LESS_EQ_ADD = LE_ADD;; + +let GREATER_EQ = GE;; + +let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));; + +let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));; + +let LESS_IMP_LESS_OR_EQ = LT_IMP_LE;; + +let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));; + +let LESS_SUC = prove(`!m n. m < n ==> m < (SUC n)`,MESON_TAC[LT]);; + +let LESS_CASES = LTE_CASES;; + +let LESS_EQ = GSYM LE_SUC_LT;; + +let LESS_OR_EQ = LE_LT;; + +let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL + (REWRITE_RULE[ADD1] LT_EXISTS))));; + +let SUC_SUB1 = prove(`!m. SUC m - 1 = m`, + REWRITE_TAC[num_CONV `1`; SUB_SUC; SUB_0]);; + +let LESS_MONO_EQ = LT_SUC;; + +let LESS_ADD_SUC = prove (`!m n. m < m + SUC n`, + REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE; LE_ADD]);; + +let LESS_REFL = LT_REFL;; + +let INV_SUC_EQ = SUC_INJ;; + +let LESS_EQ_CASES = LE_CASES;; + +let LESS_EQ_TRANS = LE_TRANS;; + +let LESS_THM = CONJUNCT2 LT;; + +let GREATER = GT;; + +let LESS_EQ_0 = CONJUNCT1 LE;; + +let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));; + +let SUB_EQUAL_0 = SUB_REFL;; + +let SUB_MONO_EQ = SUB_SUC;; + +let NOT_SUC_LESS_EQ = prove (`!n m. ~(SUC n <= m) <=> m <= n`, + REWRITE_TAC[NOT_LE; LT] THEN + MESON_TAC[LE_LT]);; + +let SUC_NOT = GSYM NOT_SUC;; + +let LESS_LESS_CASES = prove(`!m n:num. (m = n) \/ m < n \/ n < m`, + MESON_TAC[LT_CASES]);; + +let NOT_LESS_EQUAL = NOT_LE;; + +let LESS_EQ_EXISTS = LE_EXISTS;; + +let LESS_MONO_ADD_EQ = LT_ADD_RCANCEL;; + +let LESS_LESS_EQ_TRANS = LTE_TRANS;; + +let SUB_SUB = ARITH_RULE + `!b c. c <= b ==> (!a:num. a - (b - c) = (a + c) - b)`;; + +let LESS_CASES_IMP = ARITH_RULE + `!m n:num. ~(m < n) /\ ~(m = n) ==> n < m`;; + +let SUB_LESS_EQ = ARITH_RULE + `!n m:num. (n - m) <= n`;; + +let SUB_EQ_EQ_0 = ARITH_RULE + `!m n:num. (m - n = m) <=> (m = 0) \/ (n = 0)`;; + +let SUB_LEFT_LESS_EQ = ARITH_RULE + `!m n p:num. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;; + +let SUB_LEFT_GREATER_EQ = + ARITH_RULE `!m n p:num. m >= (n - p) <=> (m + p) >= n`;; + +let LESS_EQ_LESS_TRANS = LET_TRANS;; + +let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; + +let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;; + +let SUB = ARITH_RULE + `(!m. 0 - m = 0) /\ + (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`;; + +let LESS_MULT_MONO = prove + (`!m i n. ((SUC n) * m) < ((SUC n) * i) <=> m < i`, + REWRITE_TAC[LT_MULT_LCANCEL; NOT_SUC]);; + +let LESS_MONO_MULT = prove + (`!m n p. m <= n ==> (m * p) <= (n * p)`, + SIMP_TAC[LE_MULT_RCANCEL]);; + +let LESS_MULT2 = prove + (`!m n. 0 < m /\ 0 < n ==> 0 < (m * n)`, + REWRITE_TAC[LT_MULT]);; + +let SUBSET_FINITE = prove + (`!s. FINITE s ==> (!t. t SUBSET s ==> FINITE t)`, + MESON_TAC[FINITE_SUBSET]);; + +let LESS_EQ_SUC = prove + (`!n. m <= SUC n <=> (m = SUC n) \/ m <= n`, + REWRITE_TAC[LE]);; + +let ANTE_RES_THEN ttac th = FIRST_ASSUM(fun t -> ttac (MATCH_MP t th));; + +let IMP_RES_THEN ttac th = FIRST_ASSUM(fun t -> ttac (MATCH_MP th t));; + +(* ------------------------------------------------------------------------ *) +(* Set theory lemmas. *) +(* ------------------------------------------------------------------------ *) + +let INFINITE_MEMBER = prove( + `!s. INFINITE(s:A->bool) ==> ?x. x IN s`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `~(s:A->bool = {})` MP_TAC THENL + [UNDISCH_TAC `INFINITE (s:A->bool)` THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INFINITE; FINITE_EMPTY]; + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + PURE_ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN + REWRITE_TAC[]]);; + +let INFINITE_CHOOSE = prove( + `!s:A->bool. INFINITE(s) ==> ((@) s) IN s`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_MEMBER) THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[IN] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[]);; + +let INFINITE_DELETE = prove( + `!(t:A->bool) x. INFINITE (t DELETE x) = INFINITE(t)`, + REWRITE_TAC[INFINITE; FINITE_DELETE]);; + +let INFINITE_INSERT = prove( + `!(x:A) t. INFINITE(x INSERT t) = INFINITE(t)`, + REWRITE_TAC[INFINITE; FINITE_INSERT]);; + +let SIZE_INSERT = prove( + `!(x:A) t. ~(x IN t) /\ t HAS_SIZE n ==> (x INSERT t) HAS_SIZE (SUC n)`, + SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_RULES]);; + +let SIZE_DELETE = prove( + `!(x:A) t. x IN t /\ t HAS_SIZE (SUC n) ==> (t DELETE x) HAS_SIZE n`, + SIMP_TAC[HAS_SIZE_SUC]);; + +let SIZE_EXISTS = prove( + `!s N. s HAS_SIZE (SUC N) ==> ?x:A. x IN s`, + SIMP_TAC[HAS_SIZE_SUC; GSYM MEMBER_NOT_EMPTY]);; + +let SUBSET_DELETE = prove( + `!s t (x:A). s SUBSET t ==> (s DELETE x) SUBSET t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `s:A->bool` THEN ASM_REWRITE_TAC[DELETE_SUBSET]);; + +let INFINITE_FINITE_CHOICE = prove( + `!n (s:A->bool). INFINITE(s) ==> ?t. t SUBSET s /\ t HAS_SIZE n`, + INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THENL + [EXISTS_TAC `{}:A->bool` THEN + REWRITE_TAC[HAS_SIZE; EMPTY_SUBSET; HAS_SIZE_0]; + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `s DELETE ((@) s :A)`) THEN + ASM_REWRITE_TAC[INFINITE_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `((@) s :A) INSERT t` THEN CONJ_TAC THENL + [REWRITE_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL + [MATCH_MP_TAC INFINITE_CHOOSE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + REWRITE_TAC[IN_DELETE] THEN CONV_TAC(EQT_INTRO o TAUT)]; + MATCH_MP_TAC SIZE_INSERT THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN UNDISCH_TAC `t SUBSET (s DELETE ((@) s:A))` THEN + REWRITE_TAC[SUBSET; IN_DELETE] THEN + DISCH_THEN(IMP_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]);; + +let IMAGE_WOP_LEMMA = prove( + `!N (t:num->bool) (u:A->bool). + u SUBSET (IMAGE f t) /\ u HAS_SIZE (SUC N) ==> + ?n v. (u = (f n) INSERT v) /\ + !y. y IN v ==> ?m. (y = f m) /\ n < m`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\n:num. ?y:A. y IN u /\ (y = f n)` num_WOP) THEN BETA_TAC THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + FIRST_ASSUM(X_CHOOSE_TAC `y:A` o MATCH_MP SIZE_EXISTS) THEN + FIRST_ASSUM(MP_TAC o SPEC `y:A` o REWRITE_RULE[SUBSET]) THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [MAP_EVERY EXISTS_TAC [`n:num`; `y:A`] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`m:num`; `u DELETE (x:A)`] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC INSERT_DELETE THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN + FIRST_ASSUM MATCH_ACCEPT_TAC; + X_GEN_TAC `z:A` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `z:A` o REWRITE_RULE[SUBSET]) THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[GSYM NOT_LESS_EQUAL] THEN + REWRITE_TAC[LESS_OR_EQ; DE_MORGAN_THM] THEN CONJ_TAC THENL + [DISCH_THEN(ANTE_RES_THEN (MP_TAC o CONV_RULE NOT_EXISTS_CONV)) THEN + DISCH_THEN(MP_TAC o SPEC `z:A`) THEN REWRITE_TAC[] THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `~(z:A = x)` THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------ *) +(* Lemma about finite colouring of natural numbers. *) +(* ------------------------------------------------------------------------ *) + +let COLOURING_LEMMA = prove( + `!M col s. (INFINITE(s) /\ !n:A. n IN s ==> col(n) <= M) ==> + ?c t. t SUBSET s /\ INFINITE(t) /\ !n:A. n IN t ==> (col(n) = c)`, + INDUCT_TAC THENL + [REWRITE_TAC[LESS_EQ_0] THEN REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`0`; `s:A->bool`] THEN + ASM_REWRITE_TAC[SUBSET_REFL]; + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `INFINITE { x:A | x IN s /\ (col x = SUC M) } \/ + INFINITE { x:A | x IN s /\ col x <= M}` + DISJ_CASES_TAC THENL + [UNDISCH_TAC `INFINITE(s:A->bool)` THEN + REWRITE_TAC[INFINITE; GSYM DE_MORGAN_THM; GSYM FINITE_UNION] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN(MATCH_MP_TAC o MATCH_MP SUBSET_FINITE) THEN + REWRITE_TAC[SUBSET; IN_UNION] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM LESS_EQ_SUC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`SUC M`; `{ x:A | x IN s /\ (col x = SUC M)}`] THEN + ASM_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `!n:A. n IN { x | x IN s /\ col x <= M } ==> col(n) <= M` + MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(MATCH_ACCEPT_TAC o CONJUNCT2); + FIRST_X_ASSUM(MP_TAC o SPECL [`col:A->num`; + `{ x:A | x IN s /\ col x <= M}`]) THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(TAUT `(c ==> d) ==> (b ==> c) ==> b ==> d`) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` (X_CHOOSE_TAC `t:A->bool`)) THEN + MAP_EVERY EXISTS_TAC [`c:num`; `t:A->bool`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{ x:A | x IN s /\ col x <= M }` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]]);; + +let COLOURING_THM = prove( + `!M col. (!n. col n <= M) ==> + ?c s. INFINITE(s) /\ !n:num. n IN s ==> (col(n) = c)`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPECL [`M:num`; `col:num->num`; `UNIV:num->bool`] COLOURING_LEMMA) THEN + ASM_REWRITE_TAC[num_INFINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` (X_CHOOSE_TAC `t:num->bool`)) THEN + MAP_EVERY EXISTS_TAC [`c:num`; `t:num->bool`] THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Simple approach via lemmas then induction over size of coloured sets. *) +(* ------------------------------------------------------------------------ *) + +let RAMSEY_LEMMA1 = prove( + `(!C s. INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE N ==> C(t) <= M) + ==> ?t c. INFINITE(t) /\ t SUBSET s /\ + (!u. u SUBSET t /\ u HAS_SIZE N ==> (C(u) = c))) + ==> !C s. INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) + ==> ?t c. INFINITE(t) /\ t SUBSET s /\ ~(((@) s) IN t) /\ + (!u. u SUBSET t /\ u HAS_SIZE N + ==> (C(((@) s) INSERT u) = c))`, + DISCH_THEN((THEN) (REPEAT STRIP_TAC) o MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `\u. C (((@) s :A) INSERT u):num`) THEN + DISCH_THEN(MP_TAC o SPEC `s DELETE ((@)s:A)`) THEN BETA_TAC THEN + ASM_REWRITE_TAC[INFINITE_DELETE] THEN + W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [UNDISCH_TAC `t SUBSET (s DELETE ((@) s :A))` THEN + REWRITE_TAC[SUBSET; IN_INSERT; IN_DELETE; NOT_IN_EMPTY] THEN + DISCH_TAC THEN GEN_TAC THEN DISCH_THEN DISJ_CASES_TAC THEN + ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC INFINITE_CHOOSE; + FIRST_ASSUM(ANTE_RES_THEN ASSUME_TAC)] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SIZE_INSERT THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN UNDISCH_TAC `t SUBSET (s DELETE ((@) s :A))` THEN + ASM_REWRITE_TAC[SUBSET; IN_DELETE] THEN + DISCH_THEN(MP_TAC o SPEC `(@)s:A`) THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`t:A->bool`; `c:num`] THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN + GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN(fun th -> REWRITE_TAC[th])); + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]);; + +let RAMSEY_LEMMA2 = prove( + `(!C s. INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) + ==> ?t c. INFINITE(t) /\ t SUBSET s /\ ~(((@) s) IN t) /\ + (!u. u SUBSET t /\ u HAS_SIZE N + ==> (C(((@) s) INSERT u) = c))) + ==> !C s. INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) + ==> ?t x col. (!n. col n <= M) /\ + (!n. (t n) SUBSET s) /\ + (!n. t(SUC n) SUBSET (t n)) /\ + (!n. ~((x n) IN (t n))) /\ + (!n. x(SUC n) IN (t n)) /\ + (!n. (x n) IN s) /\ + (!n u. u SUBSET (t n) /\ u HAS_SIZE N + ==> (C((x n) INSERT u) = col n))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:A->bool`; `\s (n:num). @t:A->bool. ?c:num. + INFINITE(t) /\ + t SUBSET s /\ + ~(((@) s) IN t) /\ + !u. u SUBSET t /\ u HAS_SIZE N ==> (C(((@) s) INSERT u) = c)`] + num_Axiom) THEN DISCH_THEN(MP_TAC o BETA_RULE o EXISTENCE) THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->(A->bool)` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!n:num. (f n) SUBSET (s:A->bool) /\ + ?c. INFINITE(f(SUC n)) /\ f(SUC n) SUBSET (f n) /\ + ~(((@)(f n)) IN (f(SUC n))) /\ + !u. u SUBSET (f(SUC n)) /\ u HAS_SIZE N ==> + (C(((@)(f n)) INSERT u) = c:num)` + MP_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC[SUBSET_REFL]; + FIRST_ASSUM(SUBST1_TAC o SPEC `0`) THEN CONV_TAC SELECT_CONV THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `f(n:num):A->bool` THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + FIRST_ASSUM(SUBST1_TAC o SPEC `SUC n`) THEN CONV_TAC SELECT_CONV THEN + FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN + TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC SUBSET_TRANS THEN + FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN + CONJ_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC])) THEN + MATCH_ACCEPT_TAC SUBSET_REFL]; + PURE_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; + FORALL_AND_THM] THEN + DISCH_THEN(REPEAT_TCL (CONJUNCTS_THEN2 ASSUME_TAC) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `col:num->num` o CONV_RULE SKOLEM_CONV) THEN + MAP_EVERY EXISTS_TAC + [`\n:num. f(SUC n):A->bool`; `\n:num. (@)(f n):A`] THEN + BETA_TAC THEN EXISTS_TAC `col:num->num` THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_FINITE_CHOICE o SPEC `n:num`) THEN + DISCH_THEN(CHOOSE_THEN MP_TAC o SPEC `N:num`) THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + ANTE_RES_THEN MP_TAC th) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL + [REWRITE_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + EXISTS_TAC `n:num` THEN MATCH_MP_TAC INFINITE_CHOOSE THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `f(SUC n):A->bool` THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC SIZE_INSERT THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `!n:num. ~(((@)(f n):A) IN (f(SUC n)))` THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_ACCEPT_TAC o REWRITE_RULE[SUBSET])]; + REPEAT CONJ_TAC THEN TRY (FIRST_ASSUM MATCH_ACCEPT_TAC) THENL + [GEN_TAC; INDUCT_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + EXISTS_TAC `SUC n`]] THEN + MATCH_MP_TAC INFINITE_CHOOSE THEN ASM_REWRITE_TAC[]]]);; + +let RAMSEY_LEMMA3 = prove( + `(!C s. INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) + ==> ?t x col. (!n. col n <= M) /\ + (!n. (t n) SUBSET s) /\ + (!n. t(SUC n) SUBSET (t n)) /\ + (!n. ~((x n) IN (t n))) /\ + (!n. x(SUC n) IN (t n)) /\ + (!n. (x n) IN s) /\ + (!n u. u SUBSET (t n) /\ u HAS_SIZE N + ==> (C((x n) INSERT u) = col n))) + ==> !C s. INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE (SUC N) ==> C(t) <= M) + ==> ?t c. INFINITE(t) /\ t SUBSET s /\ + (!u. u SUBSET t /\ u HAS_SIZE (SUC N) ==> (C(u) = c))`, + DISCH_THEN((THEN) (REPEAT STRIP_TAC) o MP_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`C:(A->bool)->num`; `s:A->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num->(A->bool)` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->A` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `col:num->num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`M:num`; `col:num->num`; `UNIV:num->bool`] + COLOURING_LEMMA) THEN ASM_REWRITE_TAC[num_INFINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:num->bool` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`IMAGE (x:num->A) t`; `c:num`] THEN + SUBGOAL_THEN `!m n. m <= n ==> (t n:A->bool) SUBSET (t m)` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[LESS_EQ_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; SUBSET_REFL] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t(m + d):A->bool` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. m < n ==> (x n:A) IN (t m)` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN + FIRST_ASSUM(MP_TAC o SPECL [`m:num`; `m + d`]) THEN + REWRITE_TAC[LESS_EQ_ADD; SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM ADD1; ADD_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. ((x:num->A) m = x n) <=> (m = n)` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`m:num`; `n:num`] LESS_LESS_CASES) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + FIRST_ASSUM(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `INFINITE(t:num->bool)` THEN + MATCH_MP_TAC INFINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_IMAGE] THEN GEN_TAC THEN + DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o CONJUNCT1)) THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP IMAGE_WOP_LEMMA) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `v:A->bool` MP_TAC)) THEN + DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `c = (col:num->num) n` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `u SUBSET (IMAGE (x:num->A) t)` THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `(x:num->A) n`) THEN + ASM_REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(CHOOSE_THEN STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `v = u DELETE ((x:num->A) n)` SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[DELETE_INSERT] THEN + REWRITE_TAC[EXTENSION; IN_DELETE; + TAUT `(a <=> a /\ b) <=> a ==> b`] THEN + GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[LESS_REFL]; + MATCH_MP_TAC SIZE_DELETE THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_INSERT]; FIRST_ASSUM MATCH_ACCEPT_TAC]]]]]);; + +let RAMSEY = prove( + `!M N C s. + INFINITE(s:A->bool) /\ + (!t. t SUBSET s /\ t HAS_SIZE N ==> C(t) <= M) + ==> ?t c. INFINITE(t) /\ t SUBSET s /\ + (!u. u SUBSET t /\ u HAS_SIZE N ==> (C(u) = c))`, + GEN_TAC THEN INDUCT_TAC THENL + [REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`s:A->bool`; `(C:(A->bool)->num) {}`] THEN + ASM_REWRITE_TAC[HAS_SIZE_0] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL]; + MAP_EVERY MATCH_MP_TAC [RAMSEY_LEMMA3; RAMSEY_LEMMA2; RAMSEY_LEMMA1] THEN + POP_ASSUM MATCH_ACCEPT_TAC]);; diff --git a/100/ratcountable.ml b/100/ratcountable.ml new file mode 100644 index 0000000..df40ca7 --- /dev/null +++ b/100/ratcountable.ml @@ -0,0 +1,68 @@ +(* ========================================================================= *) +(* Theorem 3: countability of rational numbers. *) +(* ========================================================================= *) + +needs "Library/card.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Definition of rational and countable. *) +(* ------------------------------------------------------------------------- *) + +let rational = new_definition + `rational(r) <=> ?p q. ~(q = 0) /\ (abs(r) = &p / &q)`;; + +let countable = new_definition + `countable s <=> s <=_c (UNIV:num->bool)`;; + +(* ------------------------------------------------------------------------- *) +(* Proof of the main result. *) +(* ------------------------------------------------------------------------- *) + +let COUNTABLE_RATIONALS = prove + (`countable { x:real | rational(x)}`, + REWRITE_TAC[countable] THEN TRANS_TAC CARD_LE_TRANS + `{ x:real | ?p q. x = &p / &q } *_c (UNIV:num->bool)` THEN + CONJ_TAC THENL + [REWRITE_TAC[LE_C; EXISTS_PAIR_THM; mul_c] THEN + EXISTS_TAC `\(x,b). if b = 0 then x else --x` THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[IN_ELIM_THM; rational; IN_UNIV; PAIR_EQ] THEN + MESON_TAC[REAL_ARITH `(abs(x) = a) ==> (x = a) \/ x = --a`]; + ALL_TAC] THEN + MATCH_MP_TAC CARD_MUL_ABSORB_LE THEN REWRITE_TAC[num_INFINITE] THEN + TRANS_TAC CARD_LE_TRANS `(UNIV *_c UNIV):num#num->bool` THEN CONJ_TAC THENL + [REWRITE_TAC[LE_C; EXISTS_PAIR_THM; mul_c; IN_UNIV] THEN + EXISTS_TAC `\(p,q). &p / &q` THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[IN_ELIM_THM; rational] THEN MESON_TAC[]; + MESON_TAC[CARD_MUL_ABSORB_LE; CARD_LE_REFL; num_INFINITE]]);; + +(* ------------------------------------------------------------------------- *) +(* Maybe I should actually prove equality? *) +(* ------------------------------------------------------------------------- *) + +let denumerable = new_definition + `denumerable s <=> s =_c (UNIV:num->bool)`;; + +let DENUMERABLE_RATIONALS = prove + (`denumerable { x:real | rational(x)}`, + REWRITE_TAC[denumerable; GSYM CARD_LE_ANTISYM] THEN + REWRITE_TAC[GSYM countable; COUNTABLE_RATIONALS] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `&` THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV; REAL_OF_NUM_EQ; rational] THEN + X_GEN_TAC `p:num` THEN MAP_EVERY EXISTS_TAC [`p:num`; `1`] THEN + REWRITE_TAC[REAL_DIV_1; REAL_ABS_NUM; ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Expand out the cardinal comparison definitions for explicitness. *) +(* ------------------------------------------------------------------------- *) + +let DENUMERABLE_RATIONALS_EXPAND = prove + (`?rat:num->real. (!n. rational(rat n)) /\ + (!x. rational x ==> ?!n. x = rat n)`, + MP_TAC DENUMERABLE_RATIONALS THEN REWRITE_TAC[denumerable] THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[eq_c] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; diff --git a/100/realsuncountable.ml b/100/realsuncountable.ml new file mode 100644 index 0000000..565d44f --- /dev/null +++ b/100/realsuncountable.ml @@ -0,0 +1,256 @@ +(* ========================================================================= *) +(* #22: non-denumerability of continuum (= uncountability of the reals). *) +(* ========================================================================= *) + +needs "Library/card.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Definition of countability. *) +(* ------------------------------------------------------------------------- *) + +let countable = new_definition + `countable s <=> s <=_c (UNIV:num->bool)`;; + +(* ------------------------------------------------------------------------- *) +(* Set of repeating digits and its countability. *) +(* ------------------------------------------------------------------------- *) + +let repeating = new_definition + `repeating = {s:num->bool | ?n. !m. m >= n ==> s m}`;; + +let BINARY_BOUND = prove +(`!n. nsum(0..n) (\i. if b(i) then 2 EXP i else 0) < 2 EXP (n + 1)`, + INDUCT_TAC THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THENL + [COND_CASES_TAC THEN REWRITE_TAC[ARITH]; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[LE_0; EXP_ADD; EXP_1; EXP] THEN + ARITH_TAC);; + +let BINARY_DIV_POW2 = prove + (`!n. (nsum(0..n) (\i. if b(i) then 2 EXP i else 0)) DIV (2 EXP (SUC n)) = 0`, + SIMP_TAC[ADD1; DIV_LT; BINARY_BOUND]);; + +let PLUS_MOD_REFL = prove + (`!a b. ~(b = 0) ==> (a + b) MOD b = a MOD b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_EQ THEN MESON_TAC[MULT_CLAUSES]);; + +let BINARY_PLUS_DIV_POW2 = prove + (`!n. (nsum(0..n) (\i. if b(i) then 2 EXP i else 0) + 2 EXP (SUC n)) + DIV (2 EXP (SUC n)) = 1`, + GEN_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN + EXISTS_TAC `nsum(0..n) (\i. if b(i) then 2 EXP i else 0)` THEN + ASM_REWRITE_TAC[BINARY_BOUND; ADD1] THEN + REWRITE_TAC[ADD_AC; MULT_CLAUSES]);; + +let BINARY_UNIQUE_LEMMA = prove + (`!n. nsum(0..n) (\i. if b(i) then 2 EXP i else 0) = + nsum(0..n) (\i. if c(i) then 2 EXP i else 0) + ==> !i. i <= n ==> (b(i) <=> c(i))`, + INDUCT_TAC THEN REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THENL + [SIMP_TAC[LE] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]); + REWRITE_TAC[LE_0]] THEN + REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THENL + [UNDISCH_THEN `i = SUC n` SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x DIV (2 EXP (SUC n))`) THEN + REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; BINARY_DIV_POW2; BINARY_PLUS_DIV_POW2] THEN + REWRITE_TAC[ARITH_EQ]; + FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x MOD (2 EXP (SUC n))`) THEN + REPEAT COND_CASES_TAC THEN + SIMP_TAC[ADD_CLAUSES; BINARY_BOUND; MOD_LT; PLUS_MOD_REFL; EXP_EQ_0; ARITH; + ADD1] THEN + ASM_MESON_TAC[LE_REFL]]);; + +let COUNTABLE_REPEATING = prove + (`countable repeating`, + REWRITE_TAC[countable] THEN + TRANS_TAC CARD_LE_TRANS `(UNIV:num->bool) *_c (UNIV:num->bool)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CARD_EQ_IMP_LE THEN REWRITE_TAC[CARD_SQUARE_NUM]] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC + `\s:num->bool. let n = minimal n. !m. m >= n ==> s m in + n,nsum(0..n) (\i. if s(i) then 2 EXP i else 0)` THEN + REWRITE_TAC[repeating; IN_ELIM_THM] THEN CONJ_TAC THENL + [GEN_TAC THEN LET_TAC THEN REWRITE_TAC[mul_c; IN_ELIM_THM; IN_UNIV] THEN + MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`s:num->bool`; `t:num->bool`] THEN + ONCE_REWRITE_TAC[MINIMAL] THEN + ABBREV_TAC `k = minimal n. !m. m >= n ==> s m` THEN + ABBREV_TAC `l = minimal n. !m. m >= n ==> t m` THEN + ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; PAIR_EQ] THEN + REPEAT(POP_ASSUM(K ALL_TAC)) THEN + ASM_CASES_TAC `l:num = k` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[FUN_EQ_THM; GE] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP BINARY_UNIQUE_LEMMA) THEN + ASM_MESON_TAC[LE_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Canonical digits and their uncountability. *) +(* ------------------------------------------------------------------------- *) + +let canonical = new_definition + `canonical = {s:num->bool | !n. ?m. m >= n /\ ~(s m)}`;; + +let UNCOUNTABLE_CANONICAL = prove + (`~countable canonical`, + REWRITE_TAC[countable] THEN STRIP_TAC THEN + MP_TAC (INST_TYPE [`:num`,`:A`] CANTOR_THM_UNIV) THEN + REWRITE_TAC[CARD_NOT_LT] THEN + MP_TAC(ISPECL [`canonical`; `repeating`] CARD_DISJOINT_UNION) THEN + ANTS_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM; + canonical; repeating; GE] THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `canonical UNION repeating = UNIV` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; + canonical; repeating; GE; IN_UNIV] THEN + MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN TRANS_TAC CARD_LE_TRANS `canonical +_c repeating` THEN + ASM_SIMP_TAC[CARD_EQ_IMP_LE] THEN + TRANS_TAC CARD_LE_TRANS `(UNIV:num->bool) +_c (UNIV:num->bool)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[countable; COUNTABLE_REPEATING; CARD_LE_ADD]; + MATCH_MP_TAC CARD_ADD_ABSORB_LE THEN + REWRITE_TAC[num_INFINITE; CARD_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Injection of canonical digits into the reals. *) +(* ------------------------------------------------------------------------- *) + +needs "Library/analysis.ml";; + +prioritize_real();; + +let SUM_BINSEQUENCE_LBOUND = prove + (`!m n. &0 <= sum(m,n) (\i. if s(i) then inv(&2 pow i) else &0)`, + MATCH_MP_TAC SUM_POS THEN GEN_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; REAL_LE_INV_EQ] THEN + SIMP_TAC[REAL_POW_LE; REAL_POS]);; + +let SUM_BINSEQUENCE_UBOUND_SHARP = prove + (`!s m n. sum(m,n) (\i. if s(i) then inv(&2 pow i) else &0) + <= &2 / &2 pow m - &2 / &2 pow (m + n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN + REWRITE_TAC[ADD_CLAUSES; REAL_SUB_REFL; REAL_LE_REFL] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ x + y <= a ==> x + (if b then y else &0) <= a`) THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x <= a ==> a + y <= b ==> x + y <= b`)) THEN + REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC);; + +let SUMMABLE_BINSEQUENCE = prove + (`!s. summable (\i. if s(i) then inv(&2 pow i) else &0)`, + GEN_TAC THEN REWRITE_TAC[summable; sums; GSYM convergent] THEN + MATCH_MP_TAC SEQ_ICONV THEN REWRITE_TAC[MR1_BOUNDED] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`&2`; `0`] THEN + REWRITE_TAC[GE; LE_0; LE_REFL] THEN X_GEN_TAC `n:num` THEN + MP_TAC(SPECL [`s:num->bool`; `0`; `n:num`] + SUM_BINSEQUENCE_UBOUND_SHARP) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a < b ==> x <= a ==> abs x < b`) THEN + REWRITE_TAC[SUM_BINSEQUENCE_LBOUND; real_pow; REAL_DIV_1; ADD_CLAUSES] THEN + REWRITE_TAC[REAL_ARITH `a - x < a <=> &0 < x`] THEN + SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; + GEN_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; LE_EXISTS] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> a + x >= a`) THEN + REWRITE_TAC[SUM_BINSEQUENCE_LBOUND]]);; + +let SUMS_BINSEQUENCE = prove + (`!s. (\i. if s(i) then inv(&2 pow i) else &0) sums + (suminf (\i. if s(i) then inv(&2 pow i) else &0))`, + SIMP_TAC[SUMMABLE_SUM; SUMMABLE_BINSEQUENCE]);; + +let SUM_BINSEQUENCE_UBOUND_LE = prove + (`!s m n. sum(m,n) (\i. if s(i) then inv(&2 pow i) else &0) <= &2 / &2 pow m`, + MP_TAC SUM_BINSEQUENCE_UBOUND_SHARP THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= b ==> x <= a - b ==> x <= a`) THEN + SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS]);; + +(* ------------------------------------------------------------------------- *) +(* The main injection and hence main theorem. *) +(* ------------------------------------------------------------------------- *) + +let SUMINF_INJ_LEMMA = prove + (`!s t n. ~(s n) /\ t n /\ + (!m. m < n ==> (s(m) <=> t(m))) /\ + (!n. ?m. m >= n /\ ~(s m)) + ==> suminf(\n. if s n then inv (&2 pow n) else &0) + < suminf(\n. if t n then inv (&2 pow n) else &0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `sum(0,n+1) (\n. if t n then inv (&2 pow n) else &0)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC + [`\k:num. sum(0,n+1) (\n. if t n then inv (&2 pow n) else &0)`; + `\n:num. sum(0,n) (\n. if t n then inv (&2 pow n) else &0)`] THEN + REWRITE_TAC[SEQ_CONST; GSYM sums; SUMS_BINSEQUENCE] THEN + EXISTS_TAC `n + 1` THEN X_GEN_TAC `m:num` THEN + REWRITE_TAC[GE; LE_EXISTS] THEN DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[GSYM ADD1] THEN + REWRITE_TAC[GSYM SUM_SPLIT; REAL_LE_ADDR; SUM_BINSEQUENCE_LBOUND]] THEN + ASM_REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN + UNDISCH_THEN `!n:num. ?m. m >= n /\ ~s m` (MP_TAC o SPEC `n + 1`) THEN + REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `sum(0,m) (\n. if s n then inv (&2 pow n) else &0) + inv(&2 pow m)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC + [`\n:num. sum(0,n) (\n. if s n then inv (&2 pow n) else &0)`; + `\k:num. sum(0,m) (\n. if s n then inv(&2 pow n) else &0) + + inv(&2 pow m)`] THEN + REWRITE_TAC[SEQ_CONST; GSYM sums; SUMS_BINSEQUENCE] THEN + EXISTS_TAC `m:num` THEN REWRITE_TAC[GE; LE_REFL] THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM SUM_SPLIT; REAL_LE_LADD; ADD_CLAUSES] THEN + DISJ_CASES_THEN SUBST_ALL_TAC (ARITH_RULE `p = 0 \/ p = 1 + PRE p`) THEN + SIMP_TAC[sum; REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + ONCE_REWRITE_TAC[GSYM SUM_SPLIT] THEN + ASM_REWRITE_TAC[SUM_1; REAL_ADD_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &2 pow (m + 1)` THEN + REWRITE_TAC[SUM_BINSEQUENCE_UBOUND_LE] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM SUM_SPLIT] THEN + ASM_REWRITE_TAC[ADD_CLAUSES; SUM_1; REAL_ADD_RID] THEN + MATCH_MP_TAC(REAL_ARITH `a = b /\ c < e - d ==> (a + c) + d < b + e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[LE_0; ADD_CLAUSES]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&2 / &2 pow (n + 1) - &2 / &2 pow ((n + 1) + r)` THEN + REWRITE_TAC[SUM_BINSEQUENCE_UBOUND_SHARP] THEN + MATCH_MP_TAC(REAL_ARITH `a = b /\ d < c ==> a - c < b - d`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC(REAL_FIELD `&0 < inv(x) ==> inv(x) < &2 / x`) THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]]);; + +let UNCOUNTABLE_REALS = prove + (`~countable(UNIV:real->bool)`, + MP_TAC UNCOUNTABLE_CANONICAL THEN REWRITE_TAC[CONTRAPOS_THM] THEN + REWRITE_TAC[countable] THEN DISCH_TAC THEN + TRANS_TAC CARD_LE_TRANS `UNIV:real->bool` THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[le_c] THEN + EXISTS_TAC `\s. suminf(\n. if s(n) then inv(&2 pow n) else &0)` THEN + REWRITE_TAC[IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`s:num->bool`; `t:num->bool`] THEN + REWRITE_TAC[canonical; IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN + GEN_REWRITE_TAC I [MESON[] `(!x. P x) <=> ~(?x. ~P x)`] THEN + ONCE_REWRITE_TAC[MINIMAL] THEN + ABBREV_TAC `n = minimal x. ~(s x <=> t x)` THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_var o rhs o concl)) THEN + ASM_CASES_TAC `(t:num->bool) n` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THENL + [MATCH_MP_TAC(REAL_ARITH `b < a ==> a = b ==> F`); + MATCH_MP_TAC(REAL_ARITH `a < b ==> a = b ==> F`)] THEN + MATCH_MP_TAC SUMINF_INJ_LEMMA THEN ASM_MESON_TAC[]);; diff --git a/100/reciprocity.ml b/100/reciprocity.ml new file mode 100644 index 0000000..2889d2e --- /dev/null +++ b/100/reciprocity.ml @@ -0,0 +1,753 @@ +(* ========================================================================= *) +(* Quadratic reciprocity. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Misc. lemmas. *) +(* ------------------------------------------------------------------------- *) + +let IN_NUMSEG_1 = prove + (`!p i. i IN 1..p - 1 <=> 0 < i /\ i < p`, + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; + +let EVEN_DIV = prove + (`!n. EVEN n <=> n = 2 * (n DIV 2)`, + GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN + MP_TAC(SPEC `n:num` (MATCH_MP DIVISION (ARITH_RULE `~(2 = 0)`))) THEN + ARITH_TAC);; + +let CONG_MINUS1_SQUARE = prove + (`2 <= p ==> ((p - 1) * (p - 1) == 1) (mod p)`, + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[cong; nat_mod; ARITH_RULE `(2 + x) - 1 = x + 1`] THEN + MAP_EVERY EXISTS_TAC [`0`; `d:num`] THEN ARITH_TAC);; + +let CONG_EXP_MINUS1 = prove + (`!p n. 2 <= p ==> ((p - 1) EXP n == if EVEN n then 1 else p - 1) (mod p)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH; CONG_REFL] THEN + MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `(p - 1) * (if EVEN n then 1 else p - 1)` THEN + ASM_SIMP_TAC[CONG_MULT; CONG_REFL; EVEN] THEN + ASM_CASES_TAC `EVEN n` THEN + ASM_SIMP_TAC[MULT_CLAUSES; CONG_REFL; CONG_MINUS1_SQUARE]);; + +let NOT_CONG_MINUS1 = prove + (`!p. 3 <= p ==> ~(p - 1 == 1) (mod p)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `(2 == 0) (mod p)` MP_TAC THENL + [MATCH_MP_TAC CONG_ADD_LCANCEL THEN EXISTS_TAC `p - 1` THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN + ASM_SIMP_TAC[ADD_CLAUSES; ARITH_RULE `3 <= p ==> (p - 1) + 2 = p + 1`] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `0 + 1` THEN CONJ_TAC THENL + [ASM_MESON_TAC[ADD_CLAUSES]; ALL_TAC] THEN + MATCH_MP_TAC CONG_ADD THEN + MESON_TAC[CONG_0; CONG_SYM; DIVIDES_REFL; CONG_REFL]; + REWRITE_TAC[CONG_0] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_ARITH_TAC]);; + +let CONG_COND_LEMMA = prove + (`!p x y. 3 <= p /\ + ((if x then 1 else p - 1) == (if y then 1 else p - 1)) (mod p) + ==> (x <=> y)`, + REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_MESON_TAC[CONG_SYM; NOT_CONG_MINUS1]);; + +let FINITE_SUBCROSS = prove + (`!s:A->bool t:B->bool. + FINITE s /\ FINITE t ==> FINITE {x,y | x IN s /\ y IN t /\ P x y}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `(s:A->bool) CROSS (t:B->bool)` THEN + ASM_SIMP_TAC[FINITE_CROSS; SUBSET; IN_CROSS; FORALL_PAIR_THM; + IN_ELIM_PAIR_THM]);; + +let CARD_SUBCROSS_DETERMINATE = prove + (`FINITE s /\ FINITE t /\ (!x. x IN s /\ p(x) ==> f(x) IN t) + ==> CARD {(x:A),(y:B) | x IN s /\ y IN t /\ y = f x /\ p x} = + CARD {x | x IN s /\ p(x)}`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN EXISTS_TAC `\(x:A,y:B). x` THEN + ASM_SIMP_TAC[FINITE_SUBCROSS; FORALL_PAIR_THM; EXISTS_UNIQUE_THM] THEN + REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + SIMP_TAC[IN_ELIM_THM; PAIR_EQ] THEN ASM_MESON_TAC[]);; + +let CARD_SUBCROSS_SWAP = prove + (`CARD {y,x | y IN 1..m /\ x IN 1..n /\ P x y} = + CARD {x,y | x IN 1..n /\ y IN 1..m /\ P x y}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN + EXISTS_TAC `\(x:num,y:num). (y,x)` THEN + ASM_SIMP_TAC[FINITE_SUBCROSS; FINITE_NUMSEG] THEN + REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN + SIMP_TAC[IN_ELIM_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* What it means to be a quadratic residue. I keep in the "mod p" as what *) +(* I think is a more intuitive notation. *) +(* *) +(* We might explicitly assume that the two numbers are coprime, ruling out *) +(* the degenerate case of 0 as a quadratic residue. But this seems simpler. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("is_quadratic_residue",(12,"right"));; + +let is_quadratic_residue = new_definition + `y is_quadratic_residue rel <=> ?x. (x EXP 2 == y) (rel)`;; + +(* ------------------------------------------------------------------------- *) +(* Alternative formulation for special cases. *) +(* ------------------------------------------------------------------------- *) + +let IS_QUADRATIC_RESIDUE = prove + (`!a p. ~(p = 0) /\ ~(p divides a) + ==> (a is_quadratic_residue (mod p) <=> + ?x. 0 < x /\ x < p /\ (x EXP 2 == a) (mod p))`, + REPEAT GEN_TAC THEN REWRITE_TAC[is_quadratic_residue; EXP_2] THEN + DISCH_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN EXISTS_TAC `x MOD p` THEN + ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL + [ASM_MESON_TAC[LT_NZ; GSYM DIVIDES_MOD; CONG_DIVIDES; DIVIDES_LMUL]; + UNDISCH_TAC `(x * x == a) (mod p)` THEN + ASM_SIMP_TAC[CONG; MOD_MULT_MOD2]]);; + +let IS_QUADRATIC_RESIDUE_COMMON = prove + (`!a p. prime p /\ coprime(a,p) + ==> (a is_quadratic_residue (mod p) <=> + ?x. 0 < x /\ x < p /\ (x EXP 2 == a) (mod p))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC IS_QUADRATIC_RESIDUE THEN + ASM_MESON_TAC[COPRIME_PRIME; DIVIDES_REFL; PRIME_0]);; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas about dual pairs; these would be more natural over Z. *) +(* ------------------------------------------------------------------------- *) + +let QUADRATIC_RESIDUE_PAIR_ADD = prove + (`!p x y. prime p + ==> (((x + y) EXP 2 == x EXP 2) (mod p) <=> + p divides y \/ p divides (2 * x + y))`, + REWRITE_TAC[NUM_RING `(x + y) EXP 2 = y * (y + 2 * x) + x EXP 2`] THEN + SIMP_TAC[CONG_ADD_RCANCEL_EQ_0; CONG_0; PRIME_DIVPROD_EQ; ADD_SYM]);; + +let QUADRATIC_RESIDUE_PAIR = prove + (`!p x y. prime p + ==> ((x EXP 2 == y EXP 2) (mod p) <=> + p divides (x + y) \/ p divides (dist(x,y)))`, + GEN_TAC THEN MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [MESON_TAC[DIST_SYM; CONG_SYM; ADD_SYM]; ALL_TAC] THEN + REWRITE_TAC[LE_EXISTS] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN ASM_SIMP_TAC[QUADRATIC_RESIDUE_PAIR_ADD] THEN + REWRITE_TAC[DIST_RADD_0; ARITH_RULE `x + x + d = 2 * x + d`; DISJ_ACI]);; + +let IS_QUADRATIC_RESIDUE_PAIR = prove + (`!a p. prime p /\ coprime(a,p) + ==> (a is_quadratic_residue (mod p) <=> + ?x y. 0 < x /\ x < p /\ 0 < y /\ y < p /\ x + y = p /\ + (x EXP 2 == a) (mod p) /\ (y EXP 2 == a) (mod p) /\ + !z. 0 < z /\ z < p /\ (z EXP 2 == a) (mod p) + ==> z = x \/ z = y)`, + SIMP_TAC[IS_QUADRATIC_RESIDUE_COMMON] THEN REPEAT STRIP_TAC THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`x:num`; `p - x:num`] THEN + ASM_SIMP_TAC[ARITH_RULE + `0 < x /\ x < p ==> 0 < p - x /\ p - x < p /\ x + (p - x) = p`] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP QUADRATIC_RESIDUE_PAIR) THENL + [DISCH_THEN(MP_TAC o SPECL [`x:num`; `p - x:num`]) THEN + ASM_SIMP_TAC[ARITH_RULE `x < p ==> x + (p - x) = p`; DIVIDES_REFL] THEN + ASM_MESON_TAC[CONG_TRANS; CONG_SYM]; + DISCH_THEN(MP_TAC o SPECL [`x:num`; `z:num`]) THEN + SUBGOAL_THEN `(x EXP 2 == z EXP 2) (mod p)` (fun th -> SIMP_TAC[th]) THENL + [ASM_MESON_TAC[CONG_TRANS; CONG_SYM]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP DIVIDES_CASES)) THEN + REWRITE_TAC[ADD_EQ_0; DIST_EQ_0] THEN REWRITE_TAC[dist] THEN + ASM_ARITH_TAC]);; + +let QUADRATIC_RESIDUE_PAIR_PRODUCT = prove + (`!p x. 0 < x /\ x < p /\ (x EXP 2 == a) (mod p) + ==> (x * (p - x) == (p - 1) * a) (mod p)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MP (ARITH_RULE `x < p ==> 1 <= p`)) THEN + SUBGOAL_THEN `(x * (p - x) + x EXP 2 == a * (p - 1) + a * 1) (mod p)` + MP_TAC THENL + [ASM_SIMP_TAC[LEFT_SUB_DISTRIB; EXP_2; SUB_ADD; + LE_MULT_LCANCEL; LT_IMP_LE] THEN + REWRITE_TAC[cong; nat_mod] THEN ASM_MESON_TAC[ADD_SYM; MULT_SYM]; + REWRITE_TAC[MULT_CLAUSES] THEN + ASM_MESON_TAC[CONG_ADD; CONG_TRANS; CONG_SYM; CONG_REFL; MULT_SYM; + CONG_ADD_RCANCEL]]);; + +(* ------------------------------------------------------------------------- *) +(* Define the Legendre symbol. *) +(* ------------------------------------------------------------------------- *) + +let legendre = new_definition + `(legendre:num#num->int)(a,p) = + if ~(coprime(a,p)) then &0 + else if a is_quadratic_residue (mod p) then &1 + else --(&1)`;; + +(* ------------------------------------------------------------------------- *) +(* Definition of iterated product. *) +(* ------------------------------------------------------------------------- *) + +let nproduct = new_definition `nproduct = iterate ( * )`;; + +let NPRODUCT_CLAUSES = prove + (`(!f. nproduct {} f = 1) /\ + (!x f s. FINITE(s) + ==> (nproduct (x INSERT s) f = + if x IN s then nproduct s f else f(x) * nproduct s f))`, + REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; + +let NPRODUCT_DELETE = prove + (`!s. FINITE s /\ a IN s + ==> f(a) * nproduct(s DELETE a) f = nproduct s f`, + SIMP_TAC[nproduct; ITERATE_DELETE; MONOIDAL_MUL]);; + +let CONG_NPRODUCT = prove + (`!f g s. FINITE s /\ (!x. x IN s ==> (f x == g x) (mod n)) + ==> (nproduct s f == nproduct s g) (mod n)`, + REWRITE_TAC[nproduct] THEN + MATCH_MP_TAC(MATCH_MP ITERATE_RELATED MONOIDAL_MUL) THEN + SIMP_TAC[CONG_REFL; CONG_MULT]);; + +let NPRODUCT_MULT = prove + (`!f g s. FINITE s + ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; MULT_AC; MULT_CLAUSES]);; + +let NPRODUCT_INJECTION = prove + (`!f p s. FINITE s /\ + (!x. x IN s ==> p x IN s) /\ + (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) + ==> nproduct s (f o p) = nproduct s f`, + REWRITE_TAC[nproduct] THEN MATCH_MP_TAC ITERATE_INJECTION THEN + REWRITE_TAC[MONOIDAL_MUL]);; + +let NPRODUCT_CONST = prove + (`!c s. FINITE s ==> nproduct s (\x. c) = c EXP (CARD s)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; CARD_CLAUSES; EXP]);; + +let NPRODUCT_DELTA_CONST = prove + (`!c s. FINITE s + ==> nproduct s (\x. if p(x) then c else 1) = + c EXP (CARD {x | x IN s /\ p(x)})`, + let lemma1 = prove + (`{x | x IN a INSERT s /\ p(x)} = + if p(a) then a INSERT {x | x IN s /\ p(x)} + else {x | x IN s /\ p(x)}`, + COND_CASES_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN + ASM_MESON_TAC[]) + and lemma2 = prove + (`FINITE s ==> FINITE {x | x IN s /\ p(x)}`, + MATCH_MP_TAC(ONCE_REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + FINITE_SUBSET) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]) in + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; CARD_CLAUSES; EXP; NOT_IN_EMPTY; + SET_RULE `{x | F} = {}`; lemma1] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; IN_ELIM_THM; lemma2; EXP; MULT_CLAUSES]);; + +let COPRIME_NPRODUCT = prove + (`!f p s. FINITE s /\ (!x. x IN s ==> coprime(p,f x)) + ==> coprime(p,nproduct s f)`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; COPRIME_1; IN_INSERT; COPRIME_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Factorial in terms of products. *) +(* ------------------------------------------------------------------------- *) + +let FACT_NPRODUCT = prove + (`!n. FACT(n) = nproduct(1..n) (\i. i)`, + INDUCT_TAC THEN + REWRITE_TAC[FACT; NUMSEG_CLAUSES; ARITH; NPRODUCT_CLAUSES] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= SUC n`; NPRODUCT_CLAUSES; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* General "pairing up" theorem for products. *) +(* ------------------------------------------------------------------------- *) + +let NPRODUCT_PAIRUP_INDUCT = prove + (`!f r n s k. s HAS_SIZE (2 * n) /\ + (!x:A. x IN s ==> ?!y. y IN s /\ ~(y = x) /\ + (f(x) * f(y) == k) (mod r)) + ==> (nproduct s f == k EXP n) (mod r)`, + GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + X_GEN_TAC `s:A->bool` THEN GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; HAS_SIZE_0; NPRODUCT_CLAUSES; EXP; CONG_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `s:A->bool = {}` THENL + [ASM_MESON_TAC[HAS_SIZE_0; ARITH_RULE `2 * n = 0 <=> n = 0`; HAS_SIZE]; + ALL_TAC] THEN + STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 < n`] THEN + FIRST_ASSUM(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ASSUME `(a:A) IN s`] THEN + REWRITE_TAC[EXISTS_UNIQUE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`(s DELETE a) DELETE (b:A)`; `k:num`]) THEN + SUBGOAL_THEN `s = (a:A) INSERT (b INSERT (s DELETE a DELETE b))` + (ASSUME_TAC o SYM) THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [UNDISCH_TAC `(s:A->bool) HAS_SIZE 2 * n` THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [SYM th]) THEN + SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES; FINITE_DELETE; + IMP_CONJ; IN_DELETE; IN_INSERT] THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:A` THEN ASM_REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(x:A) IN s`)) THEN + REWRITE_TAC[EXISTS_UNIQUE] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `y:A` THEN STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THENL + [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(b:A) IN s`)) THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`a:A`; `x:A`] o CONJUNCT2) THEN + ASM_MESON_TAC[MULT_SYM]; + ALL_TAC] THEN + DISCH_TAC THEN EXPAND_TAC "s" THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE[HAS_SIZE]) THEN + SIMP_TAC[NPRODUCT_CLAUSES; FINITE_INSERT; FINITE_DELETE] THEN + REWRITE_TAC[IN_INSERT; IN_DELETE; MULT_CLAUSES] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP + (ARITH_RULE `~(n = 0) ==> n = SUC(n - 1)`)) THEN + ASM_REWRITE_TAC[MULT_ASSOC; EXP] THEN DISCH_TAC THEN + MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The two cases. *) +(* ------------------------------------------------------------------------- *) + +let QUADRATIC_NONRESIDUE_FACT = prove + (`!a p. prime p /\ ODD(p) /\ + coprime(a,p) /\ ~(a is_quadratic_residue (mod p)) + ==> (a EXP ((p - 1) DIV 2) == FACT(p - 1)) (mod p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FACT_NPRODUCT] THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC NPRODUCT_PAIRUP_INDUCT THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o + GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + SIMP_TAC[SUC_SUB1; DIV_MULT; ARITH] THEN + REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG; ADD_SUB]; + ALL_TAC] THEN + ASM_CASES_TAC `p = 0` THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + ASM_SIMP_TAC[IN_NUMSEG; ARITH_RULE `1 <= x <=> 0 < x`; + ARITH_RULE `~(p = 0) ==> (x <= p - 1 <=> x < p)`] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `p:num`; `x:num`] CONG_SOLVE_UNIQUE_NONTRIVIAL) THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[is_quadratic_residue; EXP_2]);; + +let QUADRATIC_RESIDUE_FACT = prove + (`!a p. prime p /\ ODD(p) /\ + coprime(a,p) /\ a is_quadratic_residue (mod p) + ==> (a EXP ((p - 1) DIV 2) == FACT(p - 2)) (mod p)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONG_SYM] THEN + SUBGOAL_THEN `3 <= p /\ ~(p = 0)` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN UNDISCH_TAC `ODD(p)` THEN + ASM_CASES_TAC `p = 2` THEN ASM_REWRITE_TAC[ARITH] THEN + UNDISCH_TAC `~(p = 2)` THEN ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `a is_quadratic_residue (mod p)` THEN + ASM_SIMP_TAC[EXP_2; IS_QUADRATIC_RESIDUE_PAIR; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(x:num = y)` ASSUME_TAC THENL + [ASM_MESON_TAC[ODD_ADD]; ALL_TAC] THEN + MP_TAC(ISPECL [`\i:num. i`; `p:num`; `(p - 3) DIV 2`; + `(1..p-1) DELETE x DELETE y`; `a:num`] NPRODUCT_PAIRUP_INDUCT) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG_1; + CARD_DELETE; IN_DELETE; CARD_NUMSEG_1] THEN + SIMP_TAC[ARITH_RULE `p - 1 - 1 - 1 = p - 3`] THEN + ASM_SIMP_TAC[GSYM EVEN_DIV; EVEN_SUB; ARITH; NOT_EVEN] THEN + X_GEN_TAC `u:num` THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `p:num`; `u:num`] CONG_SOLVE_UNIQUE_NONTRIVIAL) THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN + DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN + ASM_MESON_TAC[CONG_SOLVE_UNIQUE; PRIME_0; PRIME_COPRIME_LT]; + ALL_TAC] THEN + MP_TAC(SPECL [`p:num`; `x:num`] QUADRATIC_RESIDUE_PAIR_PRODUCT) THEN + ASM_SIMP_TAC[EXP_2; IMP_IMP; ARITH_RULE `x + y = p ==> p - x = y`] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_MULT) THEN + ASM_SIMP_TAC[NPRODUCT_DELETE; GSYM MULT_ASSOC; IN_DELETE; + FINITE_DELETE; IN_NUMSEG_1; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[GSYM(CONJUNCT2 EXP); GSYM FACT_NPRODUCT; ARITH_RULE + `3 <= p ==> SUC((p - 3) DIV 2) = (p - 1) DIV 2`] THEN + ASM_SIMP_TAC[FACT; ARITH_RULE `3 <= p ==> p - 1 = SUC(p - 2)`] THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= p ==> SUC(p - 2) = p - 1`] THEN + ASM_MESON_TAC[COPRIME_MINUS1; CONG_MULT_LCANCEL; CONG_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* We immediately get one part of Wilson's theorem. *) +(* ------------------------------------------------------------------------- *) + +let WILSON_LEMMA = prove + (`!p. prime(p) ==> (FACT(p - 2) == 1) (mod p)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONG_SYM] THEN + FIRST_ASSUM(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC o MATCH_MP PRIME_ODD) + THENL [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC CONG_CONV; ALL_TAC] THEN + MP_TAC(SPECL [`1`; `p:num`] QUADRATIC_RESIDUE_FACT) THEN + ASM_MESON_TAC[is_quadratic_residue; COPRIME_SYM; COPRIME_1; CONG_REFL; + EXP_ONE; CONG_SYM]);; + +let WILSON_IMP = prove + (`!p. prime(p) ==> (FACT(p - 1) == p - 1) (mod p)`, + SIMP_TAC[FACT; PRIME_GE_2; ARITH_RULE `2 <= p ==> p - 1 = SUC(p - 2)`] THEN + MESON_TAC[CONG_MULT; MULT_CLAUSES; WILSON_LEMMA; CONG_REFL]);; + +let WILSON = prove + (`!p. ~(p = 1) ==> (prime p <=> (FACT(p - 1) == p - 1) (mod p))`, + X_GEN_TAC `n:num` THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[WILSON_IMP] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[LE_LT] THEN ASM_CASES_TAC `n:num = p` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `x < y ==> x <= y - 1`)) THEN + ASM_SIMP_TAC[GSYM DIVIDES_FACT_PRIME] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + SUBGOAL_THEN `p divides FACT(n - 1) <=> p divides (n - 1)` SUBST1_TAC THENL + [MATCH_MP_TAC CONG_DIVIDES THEN + MATCH_MP_TAC CONG_MOD_MULT THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN SUBGOAL_THEN `p divides 1` MP_TAC THENL + [MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `n - 1` THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`]; + REWRITE_TAC[DIVIDES_ONE] THEN ASM_MESON_TAC[PRIME_1]]);; + +(* ------------------------------------------------------------------------- *) +(* Using Wilson's theorem we can get the Euler criterion. *) +(* ------------------------------------------------------------------------- *) + +let EULER_CRITERION = prove + (`!a p. prime p /\ coprime(a,p) + ==> (a EXP ((p - 1) DIV 2) == + (if a is_quadratic_residue (mod p) then 1 else p - 1)) (mod p)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC o + MATCH_MP PRIME_ODD) THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COND_ID; EXP; CONG_REFL] THEN + ASM_MESON_TAC[WILSON_LEMMA; WILSON_IMP; CONG_TRANS; CONG_SYM; + QUADRATIC_RESIDUE_FACT; QUADRATIC_NONRESIDUE_FACT]);; + +(* ------------------------------------------------------------------------- *) +(* Gauss's Lemma. *) +(* ------------------------------------------------------------------------- *) + +let GAUSS_LEMMA_1 = prove + (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p + ==> nproduct(1..r) (\x. let b = (a * x) MOD p in + if b <= r then b else p - b) = + nproduct(1..r) (\x. x)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN + REWRITE_TAC[I_DEF] THEN MATCH_MP_TAC NPRODUCT_INJECTION THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + ABBREV_TAC `f = \x. let b = (a * x) MOD p in + if b <= r then b else p - b` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [GEN_TAC THEN EXPAND_TAC "f" THEN REWRITE_TAC[IN_NUMSEG] THEN + LET_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; EXPAND_TAC "p" THEN ARITH_TAC] THEN + REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[DIVISION; NOT_LE; SUB_EQ_0; PRIME_0]] THEN + EXPAND_TAC "b" THEN ASM_SIMP_TAC[GSYM DIVIDES_MOD; PRIME_IMP_NZ] THEN + ASM_SIMP_TAC[PRIME_DIVPROD_EQ] THEN STRIP_TAC THENL + [ASM_MESON_TAC[coprime; DIVIDES_REFL; PRIME_1]; + ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(1 <= 0)`; + ARITH_RULE `~(2 * r + 1 <= i /\ i <= r)`]]; + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN DISCH_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN REWRITE_TAC[IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_IMP_EQ THEN EXISTS_TAC `p:num` THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `i <= r ==> i < 2 * r + 1`] ; ALL_TAC]) THEN + MATCH_MP_TAC CONG_MULT_LCANCEL THEN EXISTS_TAC `a:num` THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `(if a then x else p - x) = (if b then y else p - y) ==> x < p /\ y < p + ==> x = y \/ x + y = p`)) THEN ASM_SIMP_TAC[DIVISION] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[CONG]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o C AP_THM `p:num` o AP_TERM `(MOD)`) THEN + ASM_SIMP_TAC[MOD_ADD_MOD] THEN ASM_SIMP_TAC[GSYM CONG] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_DIVIDES) THEN + ASM_SIMP_TAC[GSYM LEFT_ADD_DISTRIB; PRIME_DIVPROD_EQ; DIVIDES_REFL] THEN + STRIP_TAC THENL + [ASM_MESON_TAC[coprime; DIVIDES_REFL; PRIME_1]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= i ==> ~(i + j = 0)`] THEN + MAP_EVERY UNDISCH_TAC [`i <= r`; `j <= r`; `2 * r + 1 = p`] THEN ARITH_TAC);; + +let GAUSS_LEMMA_2 = prove + (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p + ==> (nproduct(1..r) (\x. let b = (a * x) MOD p in + if b <= r then b else p - b) == + (p - 1) EXP (CARD {x | x IN 1..r /\ r < (a * x) MOD p}) * + a EXP r * nproduct(1..r) (\x. x)) (mod p)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {x | x IN 1..r /\ (a * x) MOD p <= r}` THEN + MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC + `nproduct(1..r) (\x. (if x IN s then 1 else p - 1) * (a * x) MOD p)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONG_NPRODUCT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN LET_TAC THEN + EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; CONG_REFL] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN MATCH_MP_TAC CONG_SUB THEN + ASM_REWRITE_TAC[LE_MULT_RCANCEL; MULT_CLAUSES; CONG_REFL] THEN + REWRITE_TAC[ARITH_RULE `b <= p /\ (1 <= p \/ b = 0) <=> b <= p`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN + DISCH_THEN(MP_TAC o SPEC `a * i:num` o MATCH_MP DIVISION o + MATCH_MP (ARITH_RULE `2 <= p ==> ~(p = 0)`)) THEN + ASM_SIMP_TAC[LT_IMP_LE; cong; nat_mod] THEN DISCH_THEN(K ALL_TAC) THEN + MAP_EVERY EXISTS_TAC [`b:num`; `1`] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[NPRODUCT_MULT; FINITE_NUMSEG] THEN + MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[TAUT `(if p then x else y) = (if ~p then y else x)`] THEN + SIMP_TAC[NPRODUCT_DELTA_CONST; FINITE_NUMSEG] THEN + MATCH_MP_TAC EQ_IMP_CONG THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + EXPAND_TAC "s" THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[NOT_LT]; + ALL_TAC] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `nproduct(1..r) (\x. a * x)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[CONG_MOD; PRIME_IMP_NZ; CONG_NPRODUCT; FINITE_NUMSEG]; + SIMP_TAC[NPRODUCT_MULT; FINITE_NUMSEG; NPRODUCT_CONST; CARD_NUMSEG_1] THEN + REWRITE_TAC[CONG_REFL]]);; + +let GAUSS_LEMMA_3 = prove + (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p + ==> ((p - 1) EXP CARD {x | x IN 1..r /\ r < (a * x) MOD p} * + (if a is_quadratic_residue mod p then 1 else p - 1) == 1) (mod p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC + `(p - 1) EXP CARD {x | x IN 1..r /\ r < (a * x) MOD p} * a EXP r` THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL] THEN + SUBGOAL_THEN `r = (p - 1) DIV 2` + (fun th -> ASM_SIMP_TAC[th; EULER_CRITERION]) THEN + EXPAND_TAC "p" THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONG_MULT_RCANCEL THEN + EXISTS_TAC `nproduct (1..r) (\x. x)` THEN + ASM_SIMP_TAC[MULT_CLAUSES; GSYM MULT_ASSOC; + SIMP_RULE[GAUSS_LEMMA_1] GAUSS_LEMMA_2] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_NPRODUCT THEN + REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let GAUSS_LEMMA_4 = prove + (`prime p /\ coprime(a,p) /\ 2 * r + 1 = p + ==> ((if EVEN(CARD{x | x IN 1..r /\ r < (a * x) MOD p}) then 1 else p - 1) * + (if a is_quadratic_residue mod p then 1 else p - 1) == 1) (mod p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `(p - 1) EXP CARD {x | x IN 1..r /\ r < (a * x) MOD p} * + (if a is_quadratic_residue mod p then 1 else p - 1)` THEN + ASM_SIMP_TAC[GAUSS_LEMMA_3] THEN ONCE_REWRITE_TAC[CONG_SYM] THEN + ASM_SIMP_TAC[CONG_EXP_MINUS1; CONG_MULT; CONG_REFL; PRIME_GE_2]);; + +let GAUSS_LEMMA = prove + (`!a p r. prime p /\ coprime(a,p) /\ 2 * r + 1 = p + ==> (a is_quadratic_residue (mod p) <=> + EVEN(CARD {x | x IN 1..r /\ r < (a * x) MOD p}))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC CONG_COND_LEMMA THEN EXISTS_TAC `p:num` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + EXPAND_TAC "p" THEN ASM_CASES_TAC `r = 0` THENL + [REWRITE_TAC[ASSUME `r = 0`; ARITH; PRIME_1]; + UNDISCH_TAC `~(r = 0)` THEN ARITH_TAC]; + FIRST_ASSUM(MP_TAC o MATCH_MP GAUSS_LEMMA_4) THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[CONG_REFL]) THEN + REWRITE_TAC[MULT_CLAUSES] THEN MESON_TAC[CONG_SYM]]);; + +(* ------------------------------------------------------------------------- *) +(* A more symmetrical version. *) +(* ------------------------------------------------------------------------- *) + +let GAUSS_LEMMA_SYM = prove + (`!p q r s. prime p /\ prime q /\ coprime(p,q) /\ + 2 * r + 1 = p /\ 2 * s + 1 = q + ==> (q is_quadratic_residue (mod p) <=> + EVEN(CARD {x,y | x IN 1..r /\ y IN 1..s /\ + q * x < p * y /\ p * y <= q * x + r}))`, + ONCE_REWRITE_TAC[COPRIME_SYM] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`q:num`; `p:num`; `r:num`] GAUSS_LEMMA) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN AP_TERM_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `CARD {x,y | x IN 1..r /\ y IN 1..s /\ + y = (q * x) DIV p + 1 /\ r < (q * x) MOD p}` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBCROSS_DETERMINATE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; ARITH_RULE `1 <= x + 1`] THEN + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `p * (q * x) DIV p + r < q * r` MP_TAC THENL + [MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `q * x` THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + ASM_MESON_TAC[PRIME_IMP_NZ; LT_ADD_LCANCEL; DIVISION]; + MAP_EVERY EXPAND_TAC ["p"; "q"] THEN DISCH_THEN(MP_TAC o MATCH_MP + (ARITH_RULE `(2 * r + 1) * d + r < (2 * s + 1) * r + ==> (2 * r) * d < (2 * r) * s`)) THEN + SIMP_TAC[LT_MULT_LCANCEL; ARITH_RULE `x < y ==> x + 1 <= y`]]; + AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MP_TAC(MATCH_MP PRIME_IMP_NZ (ASSUME `prime p`)) THEN + DISCH_THEN(MP_TAC o SPEC `q * x` o MATCH_MP DIVISION) THEN + FIRST_ASSUM(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN + UNDISCH_TAC `2 * r + 1 = p` THEN ARITH_TAC; + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ALL_TAC; + DISCH_THEN SUBST_ALL_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `!p d. 2 * r + 1 = p /\ p * (d + 1) <= (d * p + m) + r ==> r < m`) THEN + MAP_EVERY EXISTS_TAC [`p:num`; `(q * x) DIV p`] THEN + ASM_MESON_TAC[DIVISION; PRIME_IMP_NZ]] THEN + MATCH_MP_TAC(ARITH_RULE `~(x <= y) /\ ~(y + 2 <= x) ==> x = y + 1`) THEN + REPEAT STRIP_TAC THENL + [SUBGOAL_THEN `y * p <= ((q * x) DIV p) * p` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL; PRIME_IMP_NZ]; ALL_TAC]; + SUBGOAL_THEN `((q * x) DIV p + 2) * p <= y * p` MP_TAC THENL + [ASM_SIMP_TAC[LE_MULT_RCANCEL; PRIME_IMP_NZ]; ALL_TAC]] THEN + MP_TAC(MATCH_MP PRIME_IMP_NZ (ASSUME `prime p`)) THEN + DISCH_THEN(MP_TAC o SPEC `q * x` o MATCH_MP DIVISION) THEN + ASM_ARITH_TAC]]);; + +let GAUSS_LEMMA_SYM' = prove + (`!p q r s. prime p /\ prime q /\ coprime(p,q) /\ + 2 * r + 1 = p /\ 2 * s + 1 = q + ==> (p is_quadratic_residue (mod q) <=> + EVEN(CARD {x,y | x IN 1..r /\ y IN 1..s /\ + p * y < q * x /\ q * x <= p * y + s}))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`q:num`; `p:num`; `s:num`; `r:num`] GAUSS_LEMMA_SYM) THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC LAND_CONV [CARD_SUBCROSS_SWAP] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; CONJ_ACI]);; + +(* ------------------------------------------------------------------------- *) +(* The main result. *) +(* ------------------------------------------------------------------------- *) + +let RECIPROCITY_SET_LEMMA = prove + (`!a b c d r s. + a UNION b UNION c UNION d = (1..r) CROSS (1..s) /\ + PAIRWISE DISJOINT [a;b;c;d] /\ CARD b = CARD c + ==> ((EVEN(CARD a) <=> EVEN(CARD d)) <=> ~(ODD r /\ ODD s))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `CARD(a:num#num->bool) + CARD(b:num#num->bool) + + CARD(c:num#num->bool) + CARD(d:num#num->bool) = r * s` + (fun th -> MP_TAC(AP_TERM `EVEN` th) THEN + ASM_REWRITE_TAC[EVEN_ADD; GSYM NOT_EVEN; EVEN_MULT] THEN + CONV_TAC TAUT) THEN + SUBGOAL_THEN + `FINITE(a:num#num->bool) /\ FINITE(b:num#num->bool) /\ + FINITE(c:num#num->bool) /\ FINITE(d:num#num->bool)` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `(1..r) CROSS (1..s)` THEN + SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `CARD:(num#num->bool)->num`) THEN + SIMP_TAC[CARD_CROSS; CARD_NUMSEG_1; FINITE_NUMSEG] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PAIRWISE]) THEN + REWRITE_TAC[PAIRWISE; DISJOINT; ALL] THEN + ASM_SIMP_TAC[CARD_UNION; FINITE_UNION; SET_RULE + `a INTER (b UNION c) = {} <=> a INTER b = {} /\ a INTER c = {}`]);; + +let RECIPROCITY_SIMPLE = prove + (`!p q r s. + prime p /\ + prime q /\ + coprime (p,q) /\ + 2 * r + 1 = p /\ + 2 * s + 1 = q + ==> ((q is_quadratic_residue (mod p) <=> + p is_quadratic_residue (mod q)) <=> + ~(ODD r /\ ODD s))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`; `q:num`; `r:num`; `s:num`] GAUSS_LEMMA_SYM) THEN + MP_TAC(SPECL [`p:num`; `q:num`; `r:num`; `s:num`] GAUSS_LEMMA_SYM') THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN SUBST1_TAC) THEN MATCH_MP_TAC RECIPROCITY_SET_LEMMA THEN + EXISTS_TAC `{x,y | x IN 1..r /\ y IN 1..s /\ q * x + r < p * y}` THEN + EXISTS_TAC `{x,y | x IN 1..r /\ y IN 1..s /\ p * y + s < q * x}` THEN + REPEAT CONJ_TAC THEN + REWRITE_TAC[PAIRWISE; DISJOINT; EXTENSION; NOT_IN_EMPTY; FORALL_PAIR_THM; + ALL; IN_UNION; IN_CROSS; IN_ELIM_PAIR_THM; IN_INTER] + THENL + [MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN + MAP_EVERY ASM_CASES_TAC [`x IN 1..r`; `y IN 1..s`] THEN ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `~(q * x = p * y)` (fun th -> MP_TAC th THEN ARITH_TAC) THEN + DISCH_THEN(MP_TAC o AP_TERM `(divides) p`) THEN + ASM_SIMP_TAC[PRIME_DIVPROD_EQ; DIVIDES_REFL] THEN STRIP_TAC THENL + [ASM_MESON_TAC[DIVIDES_REFL; PRIME_1; coprime]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + UNDISCH_TAC `x IN 1..r` THEN REWRITE_TAC[IN_NUMSEG] THEN + EXPAND_TAC "p" THEN ARITH_TAC; + ARITH_TAC; + MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN + REPEAT(EXISTS_TAC `\(x,y). (r + 1) - x,(s + 1) - y`) THEN + SIMP_TAC[FINITE_SUBCROSS; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_NUMSEG; PAIR_EQ] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `y:num`] THEN + SIMP_TAC[ARITH_RULE `x <= y ==> (y + 1) - ((y + 1) - x) = x`] THEN + SIMP_TAC[ARITH_RULE + `1 <= x /\ x <= y ==> 1 <= (y + 1) - x /\ (y + 1) - x <= y`] THEN + REWRITE_TAC[LEFT_SUB_DISTRIB] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `x <= y /\ v + y + z < x + u ==> (y - x) + z < u - v`) THEN + ASM_SIMP_TAC[LE_MULT_LCANCEL; ARITH_RULE `x <= r ==> x <= r + 1`] THEN + REWRITE_TAC[ARITH_RULE `a + x < y + a <=> x < y`] THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* In terms of the Legendre symbol. *) +(* ------------------------------------------------------------------------- *) + +let RECIPROCITY_LEGENDRE = prove + (`!p q. prime p /\ prime q /\ ODD p /\ ODD q /\ ~(p = q) + ==> legendre(p,q) * legendre(q,p) = + --(&1) pow ((p - 1) DIV 2 * (q - 1) DIV 2)`, + REPEAT STRIP_TAC THEN MAP_EVERY UNDISCH_TAC [`ODD q`; `ODD p`] THEN + REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN REWRITE_TAC[ADD1] THEN + REPEAT(DISCH_THEN (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th))) THEN + REWRITE_TAC[ARITH_RULE `((2 * s + 1) - 1) DIV 2 = s`] THEN + MP_TAC(SPECL [`p:num`; `q:num`; `r:num`; `s:num`] RECIPROCITY_SIMPLE) THEN + ASM_SIMP_TAC[DISTINCT_PRIME_COPRIME; INT_POW_NEG; EVEN_MULT; legendre] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_ODD; INT_POW_ONE] THEN + MAP_EVERY ASM_CASES_TAC [`EVEN r`; `EVEN s`] THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[TAUT `~(a <=> b) <=> (a <=> ~b)`] THEN DISCH_THEN(K ALL_TAC) THEN + ASM_CASES_TAC `p is_quadratic_residue (mod q)` THEN + ASM_REWRITE_TAC[INT_MUL_LNEG; INT_MUL_RNEG; INT_NEG_NEG; INT_MUL_LID]);; diff --git a/100/sqrt.ml b/100/sqrt.ml new file mode 100644 index 0000000..c282b2d --- /dev/null +++ b/100/sqrt.ml @@ -0,0 +1,42 @@ +(* ========================================================================= *) +(* Irrationality of sqrt(2) and more general results. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; (* For number-theoretic lemmas *) +needs "Library/floor.ml";; (* For definition of rationals *) +needs "Multivariate/vectors.ml";; (* For square roots *) + +(* ------------------------------------------------------------------------- *) +(* Most general irrationality of square root result. *) +(* ------------------------------------------------------------------------- *) + +let IRRATIONAL_SQRT_NONSQUARE = prove + (`!n. rational(sqrt(&n)) ==> ?m. n = m EXP 2`, + REWRITE_TAC[rational] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN + SIMP_TAC[SQRT_POW_2; REAL_POS] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [integer])) THEN + ASM_REWRITE_TAC[REAL_ABS_DIV] THEN DISCH_THEN(MP_TAC o MATCH_MP(REAL_FIELD + `p = (n / m) pow 2 ==> ~(m = &0) ==> m pow 2 * p = n pow 2`)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_ZERO]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + ASM_MESON_TAC[EXP_MULT_EXISTS; REAL_ABS_ZERO; REAL_OF_NUM_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, prime numbers. *) +(* ------------------------------------------------------------------------- *) + +let IRRATIONAL_SQRT_PRIME = prove + (`!p. prime p ==> ~rational(sqrt(&p))`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP IRRATIONAL_SQRT_NONSQUARE) THEN + REWRITE_TAC[PRIME_EXP; ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, sqrt(2) is irrational. *) +(* ------------------------------------------------------------------------- *) + +let IRRATIONAL_SQRT_2 = prove + (`~rational(sqrt(&2))`, + SIMP_TAC[IRRATIONAL_SQRT_PRIME; PRIME_2]);; diff --git a/100/stirling.ml b/100/stirling.ml new file mode 100644 index 0000000..7b396d0 --- /dev/null +++ b/100/stirling.ml @@ -0,0 +1,597 @@ +(* ========================================================================= *) +(* Stirling's approximation. *) +(* ========================================================================= *) + +needs "Library/analysis.ml";; +needs "Library/transc.ml";; + +override_interface("-->",`(tends_num_real)`);; + +(* ------------------------------------------------------------------------- *) +(* This is a handy induction for Wallis's product below. *) +(* ------------------------------------------------------------------------- *) + +let ODDEVEN_INDUCT = prove + (`!P. P 0 /\ P 1 /\ (!n. P n ==> P(n + 2)) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN + INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN + ASM_SIMP_TAC[ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* A particular limit we need below. *) +(* ------------------------------------------------------------------------- *) + +let LN_LIM_BOUND = prove + (`!n. ~(n = 0) ==> abs(&n * ln(&1 + &1 / &n) - &1) <= &1 / (&2 * &n)`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL [`&1 / &n`; `2`] MCLAURIN_LN_POS) THEN + ASM_SIMP_TAC[SUM_2; REAL_LT_DIV; REAL_OF_NUM_LT; LT_NZ; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_POW_1; REAL_POW_2; REAL_MUL_LNEG; REAL_MUL_RNEG; + REAL_NEG_NEG; REAL_MUL_LID; REAL_INV_1; REAL_POW_NEG; + REAL_POW_ONE; ARITH; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `~(x = &0) ==> x * (inv(x) + a) - &1 = x * a`] THEN + REWRITE_TAC[REAL_ARITH `n * --((i * i) * a) = --((n * i) * a * i)`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_MUL] THEN + ONCE_REWRITE_TAC[REAL_INV_MUL] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_POS] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_POS] THEN + UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC);; + +let LN_LIM_LEMMA = prove + (`(\n. &n * ln(&1 + &1 / &n)) --> &1`, + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) + [REAL_ARITH `a = (a - &1) + &1`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN + MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[SEQ_CONST] THEN + MATCH_MP_TAC SEQ_LE_0 THEN EXISTS_TAC `\n. &1 / &n` THEN + REWRITE_TAC[SEQ_HARMONIC] THEN + EXISTS_TAC `1` THEN REWRITE_TAC[ARITH_RULE `n >= 1 <=> ~(n = 0)`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 / (&2 * &n)` THEN ASM_SIMP_TAC[LN_LIM_BOUND] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `~(n = 0)` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Lemma for proving inequality via derivative and limit at infinity. *) +(* ------------------------------------------------------------------------- *) + +let POSITIVE_DIFF_LEMMA = prove + (`!f f'. (!x. &0 < x ==> (f diffl f'(x)) x /\ f'(x) < &0) /\ + (\n. f(&n)) --> &0 + ==> !n. ~(n = 0) ==> &0 < f(&n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN `!m p. n <= m /\ m < p ==> (f:real->real)(&p) < f(&m)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real->real`; `f':real->real`; `&m`; `&p`] MVT_ALT) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[LT_NZ; LTE_TRANS; REAL_OF_NUM_LT; REAL_LTE_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_EQ_SUB_RADD] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < z * --y ==> z * y + a < a`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_SUB_LT; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_ARITH `&0 < --x <=> x < &0`] THEN + ASM_MESON_TAC[LT_NZ; LTE_TRANS; REAL_OF_NUM_LT; REAL_LT_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN `f(&(n + 1)) < &0` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o SPECL [`n:num`; `n + 1`]) THEN ANTS_TAC THENL + [ARITH_TAC; UNDISCH_TAC `f(&n) <= &0` THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SEQ]) THEN + DISCH_THEN(MP_TAC o SPEC `--f(&(n + 1))`) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_ARITH `&0 < --x <=> x < &0`] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` (MP_TAC o SPEC `n + p + 2`)) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `y < &0 /\ z < y ==> abs(z) < --y ==> F`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary definition. *) +(* ------------------------------------------------------------------------- *) + +let stirling = new_definition + `stirling n = ln(&(FACT n)) - ((&n + &1 / &2) * ln(&n) - &n)`;; + +(* ------------------------------------------------------------------------- *) +(* This difference is a decreasing sequence. *) +(* ------------------------------------------------------------------------- *) + +let STIRLING_DIFF = prove + (`!n. ~(n = 0) + ==> stirling(n) - stirling(n + 1) = + (&n + &1 / &2) * ln((&n + &1) / &n) - &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[stirling] THEN + MATCH_MP_TAC(REAL_ARITH + `(f' - f) + x = (nl' - nl) /\ n' = n + &1 + ==> (f - (nl - n)) - (f' - (nl' - n')) = x - &1`) THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REWRITE_RULE[ADD1] FACT; GSYM REAL_OF_NUM_MUL] THEN + SIMP_TAC[LN_MUL; FACT_LT; ADD_EQ_0; ARITH; LT_NZ; REAL_OF_NUM_LT] THEN + ASM_SIMP_TAC[LN_DIV; REAL_OF_NUM_LT; ADD_EQ_0; ARITH; LT_NZ] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);; + +let STIRLING_DELTA_DERIV = prove + (`!x. &0 < x + ==> ((\x. ln ((x + &1) / x) - &1 / (x + &1 / &2)) diffl + (-- &1 / (x * (x + &1) * (&2 * x + &1) pow 2))) x`, + GEN_TAC THEN DISCH_TAC THEN + W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w))))) THEN + REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_DIV) THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_2] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +let STIRLING_DELTA_LIMIT = prove + (`(\n. ln ((&n + &1) / &n) - &1 / (&n + &1 / &2)) --> &0`, + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN + MATCH_MP_TAC SEQ_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SEQ_LE_0 THEN + EXISTS_TAC `\n. &1 / &n` THEN REWRITE_TAC[SEQ_HARMONIC] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GE; GSYM REAL_OF_NUM_LE] THEN + DISCH_TAC THEN MATCH_MP_TAC + (REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) + THEN CONJ_TAC THENL + [MATCH_MP_TAC LN_POS THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `&1 <= x ==> &0 < x`] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_FIELD `&1 <= x ==> (x + &1) / x = &1 + &1 / x`] THEN + MATCH_MP_TAC LN_LE THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS]; + MATCH_MP_TAC REAL_LE_DIV THEN REAL_ARITH_TAC; + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]);; + +let STIRLING_DECREASES = prove + (`!n. ~(n = 0) ==> stirling(n + 1) < stirling(n)`, + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN SIMP_TAC[STIRLING_DIFF] THEN + REWRITE_TAC[REAL_SUB_LT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1 / &2`] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + MATCH_MP_TAC POSITIVE_DIFF_LEMMA THEN + EXISTS_TAC `\x. -- &1 / (x * (x + &1) * (&2 * x + &1) pow 2)` THEN + SIMP_TAC[STIRLING_DELTA_DERIV; STIRLING_DELTA_LIMIT] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `--x < &0 <=> &0 < x`; REAL_LT_INV_EQ] THEN + REWRITE_TAC[REAL_POW_2] THEN + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* However a slight tweak gives an *increasing* sequence. *) +(* ------------------------------------------------------------------------- *) + +let OTHER_DERIV_LEMMA = prove + (`!x. &0 < x + ==> ((\x. &1 / (&12 * x * (x + &1) * (x + &1 / &2))) diffl + --(&3 * x pow 2 + &3 * x + &1 / &2) / + (&12 * (x * (x + &1) * (x + &1 / &2)) pow 2)) x`, + REPEAT STRIP_TAC THEN + W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w))))) THEN + REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_ENTIRE] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_2] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +let STIRLING_INCREASES = prove + (`!n. ~(n = 0) + ==> stirling(n + 1) - &1 / (&12 * (&(n + 1))) + > stirling(n) - &1 / (&12 * &n)`, + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `a - b > c - d <=> c - a < d - b`] THEN + SIMP_TAC[REAL_FIELD + `~(&n = &0) ==> &1 / (&12 * &n) - &1 / (&12 * (&n + &1)) = + &1 / (&12 * &n * (&n + &1))`] THEN + SIMP_TAC[REAL_OF_NUM_EQ; STIRLING_DIFF] THEN + REWRITE_TAC[REAL_ARITH `a * b - &1 < c <=> b * a < c + &1`] THEN + SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &n + &1 / &2`] THEN + REWRITE_TAC[REAL_ARITH `(&1 / x + &1) / y = &1 / x / y + &1 / y`] THEN + REWRITE_TAC[REAL_ARITH `a < b + c <=> &0 < b - (a - c)`] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC POSITIVE_DIFF_LEMMA THEN + EXISTS_TAC `\x. &1 / (x * (x + &1) * (&2 * x + &1) pow 2) - + (&3 * x pow 2 + &3 * x + &1 / &2) / + (&12 * (x * (x + &1) * (x + &1 / &2)) pow 2)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN + MATCH_MP_TAC SEQ_SUB THEN REWRITE_TAC[STIRLING_DELTA_LIMIT] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_FIELD + `inv(&12) * x * y * inv(&n + inv(&2)) = x * y * inv(&12 * &n + &6)`] THEN + GEN_REWRITE_TAC RAND_CONV [SYM(REAL_RAT_REDUCE_CONV `&0 * &0 * &0`)] THEN + REPEAT(MATCH_MP_TAC SEQ_MUL THEN CONJ_TAC) THEN + MP_TAC(SPEC `&1` SEQ_HARMONIC) THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUBSEQ) THENL + [DISCH_THEN(MP_TAC o SPECL [`1`; `1`]); + DISCH_THEN(MP_TAC o SPECL [`12`; `6`])] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; ARITH; MULT_CLAUSES]] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV + [REAL_ARITH `&1 / x - y / z = --y / z - -- &1 / x`] THEN + MATCH_MP_TAC DIFF_SUB THEN + ASM_SIMP_TAC[STIRLING_DELTA_DERIV; OTHER_DERIV_LEMMA]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `a - b < &0 <=> a < b`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; REAL_FIELD + `&0 < x + ==> &1 / (x * (x + &1) * (&2 * x + &1) pow 2) = + (&3 * x * (x + &1)) / + (&12 * (x * (x + &1) * (x + &1 / &2)) * + (x * (x + &1) * (x + &1 / &2)))`] THEN + ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_POW_2] THEN + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence it converges to *something*. *) +(* ------------------------------------------------------------------------- *) + +let STIRLING_UPPERBOUND = prove + (`!n. stirling(SUC n) <= &1`, + INDUCT_TAC THENL + [REWRITE_TAC[stirling] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `stirling(SUC n)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `SUC(SUC n) = SUC n + 1`] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC STIRLING_DECREASES THEN + ARITH_TAC);; + +let STIRLING_LOWERBOUND = prove + (`!n. -- &1 <= stirling(SUC n)`, + GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `stirling(SUC n) - &1 / (&12 * &(SUC n))` THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_ARITH `a - b <= a <=> &0 <= b`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_POS]] THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[stirling] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[LN_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `stirling(SUC n) - &1 / (&12 * &(SUC n))` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `SUC(SUC n) = SUC n + 1`] THEN + MATCH_MP_TAC(REAL_ARITH `b > a ==> a <= b`) THEN + MATCH_MP_TAC STIRLING_INCREASES THEN ARITH_TAC);; + +let STIRLING_MONO = prove + (`!m n. ~(m = 0) /\ m <= n ==> stirling n <= stirling m`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `stirling(m + d)` THEN + ASM_SIMP_TAC[ADD1; REAL_LT_IMP_LE; STIRLING_DECREASES; ADD_EQ_0]);; + +let STIRLING_CONVERGES = prove + (`?c. stirling --> c`, + ONCE_REWRITE_TAC[SEQ_SUC] THEN + REWRITE_TAC[GSYM convergent] THEN MATCH_MP_TAC SEQ_BCONV THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[mono; real_ge] THEN DISJ2_TAC THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC STIRLING_MONO THEN + POP_ASSUM MP_TAC THEN ARITH_TAC] THEN + REWRITE_TAC[MR1_BOUNDED; GE; LE_REFL] THEN + MAP_EVERY EXISTS_TAC [`&2`; `0`] THEN REWRITE_TAC[LE_0] THEN + SIMP_TAC[REAL_ARITH `-- &1 <= x /\ x <= &1 ==> abs(x) < &2`; + STIRLING_UPPERBOUND; STIRLING_LOWERBOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Now derive Wallis's infinite product. *) +(* ------------------------------------------------------------------------- *) + +let [PI2_LT; PI2_LE; PI2_NZ] = (CONJUNCTS o prove) + (`&0 < pi / &2 /\ &0 <= pi / &2 /\ ~(pi / &2 = &0)`, + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let WALLIS_PARTS = prove + (`!n. (&n + &2) * integral(&0,pi / &2) (\x. sin(x) pow (n + 2)) = + (&n + &1) * integral(&0,pi / &2) (\x. sin(x) pow n)`, + GEN_TAC THEN + MP_TAC(SPECL [`\x. sin(x) pow (n + 1)`; `\x. --cos(x)`; + `\x. (&n + &1) * sin(x) pow n * cos(x)`; + `\x. sin(x)`; `&0`; `pi / &2`] INTEGRAL_BY_PARTS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [SIMP_TAC[REAL_LT_IMP_LE; PI_POS; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC(ONCE_DEPTH_CONV INTEGRABLE_CONV) THEN REWRITE_TAC[] THEN + CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN DIFF_TAC THEN + REWRITE_TAC[REAL_OF_NUM_ADD; ADD_SUB] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SIN_PI2; COS_PI2; SIN_0; COS_0] THEN + REWRITE_TAC[REAL_ARITH `s pow k * s = s * s pow k`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow); ARITH_RULE `SUC(n + 1) = n + 2`] THEN + REWRITE_TAC[GSYM ADD1; real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_NEG_0; REAL_SUB_LZERO] THEN + REWRITE_TAC[C MATCH_MP (SPEC_ALL SIN_CIRCLE) (REAL_RING + `sin(x) pow 2 + cos(x) pow 2 = &1 + ==> (n * sn * cos(x)) * --cos(x) = (n * sn) * (sin(x) pow 2 - &1)`)] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + SUBGOAL_THEN + `integral(&0,pi / &2) + (\x. (&n + &1) * sin x pow (n + 2) - (&n + &1) * sin x pow n) = + (&n + &1) * (integral(&0,pi / &2) (\x. sin(x) pow (n + 2)) - + integral(&0,pi / &2) (\x. sin(x) pow n))` + (fun th -> SUBST1_TAC th THEN REAL_ARITH_TAC) THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `(&n + &1) * + integral(&0,pi / &2) (\x. sin x pow (n + 2) - sin x pow n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_CMUL; + AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_SUB] THEN + CONV_TAC(ONCE_DEPTH_CONV INTEGRABLE_CONV) THEN SIMP_TAC[PI2_LE]);; + +let WALLIS_PARTS' = prove + (`!n. integral(&0,pi / &2) (\x. sin(x) pow (n + 2)) = + (&n + &1) / (&n + &2) * integral(&0,pi / &2) (\x. sin(x) pow n)`, + MP_TAC WALLIS_PARTS THEN MATCH_MP_TAC MONO_FORALL THEN + CONV_TAC REAL_FIELD);; + +let WALLIS_0 = prove + (`integral(&0,pi / &2) (\x. sin(x) pow 0) = pi / &2`, + REWRITE_TAC[real_pow; REAL_DIV_1; REAL_MUL_LID] THEN + SIMP_TAC[INTEGRAL_CONST; REAL_LT_IMP_LE; PI_POS; REAL_LT_DIV; + REAL_OF_NUM_LT; ARITH; REAL_MUL_LID; REAL_SUB_RZERO]);; + +let WALLIS_1 = prove + (`integral(&0,pi / &2) (\x. sin(x) pow 1) = &1`, + MATCH_MP_TAC DEFINT_INTEGRAL THEN REWRITE_TAC[PI2_LE; REAL_POW_1] THEN + MP_TAC(SPECL [`\x. --cos(x)`; `\x. sin x`; `&0`; `pi / &2`] FTC1) THEN + REWRITE_TAC[COS_0; COS_PI2] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[PI2_LE] THEN + REPEAT STRIP_TAC THEN DIFF_TAC THEN REAL_ARITH_TAC);; + +let WALLIS_EVEN = prove + (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n)) = + (&(FACT(2 * n)) / (&2 pow n * &(FACT n)) pow 2) * pi / &2`, + INDUCT_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[WALLIS_0] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `2 * SUC n = 2 * n + 2`; WALLIS_PARTS'] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x) * y * z = (&2 * y) * (x * z)`] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_MUL] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[ARITH_RULE `2 * n + 2 = SUC(SUC(2 * n))`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_2; FACT; + GSYM REAL_OF_NUM_MUL] THEN + CONV_TAC REAL_FIELD);; + +let WALLIS_ODD = prove + (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n + 1)) = + (&2 pow n * &(FACT n)) pow 2 / &(FACT(2 * n + 1))`, + INDUCT_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[WALLIS_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `2 * SUC n + 1 = (2 * n + 1) + 2`; + WALLIS_PARTS'] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(&2 * x) * y * z = (x * z) * (&2 * y)`] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_MUL] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[ARITH_RULE `n + 2 = SUC(SUC n)`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_POW_2; FACT; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + MP_TAC(SPEC `2 * n + 1` FACT_LT) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN + CONV_TAC REAL_FIELD);; + +let WALLIS_QUOTIENT = prove + (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n)) / + integral(&0,pi / &2) (\x. sin(x) pow (2 * n + 1)) = + (&(FACT(2 * n)) * &(FACT(2 * n + 1))) / (&2 pow n * &(FACT n)) pow 4 * + pi / &2`, + GEN_TAC THEN REWRITE_TAC[WALLIS_EVEN; WALLIS_ODD] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_POW_INV; REAL_INV_INV] THEN + REAL_ARITH_TAC);; + +let WALLIS_QUOTIENT' = prove + (`!n. integral(&0,pi / &2) (\x. sin(x) pow (2 * n)) / + integral(&0,pi / &2) (\x. sin(x) pow (2 * n + 1)) * &2 / pi = + (&(FACT(2 * n)) * &(FACT(2 * n + 1))) / (&2 pow n * &(FACT n)) pow 4`, + GEN_TAC THEN REWRITE_TAC[WALLIS_QUOTIENT] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM REAL_INV_DIV] THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + MP_TAC PI2_NZ THEN CONV_TAC REAL_FIELD);; + +let WALLIS_MONO = prove + (`!m n. m <= n + ==> integral(&0,pi / &2) (\x. sin(x) pow n) + <= integral(&0,pi / &2) (\x. sin(x) pow m)`, + REWRITE_TAC[LE_EXISTS] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_LE THEN + CONV_TAC(ONCE_DEPTH_CONV INTEGRABLE_CONV) THEN REWRITE_TAC[PI2_LE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_POW_ADD] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE; MATCH_MP_TAC REAL_POW_1_LE] THEN + REWRITE_TAC[SIN_BOUNDS] THEN + (MP_TAC(SPEC `x:real` SIN_POS_PI_LE) THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN MP_TAC PI2_LT THEN REAL_ARITH_TAC));; + +let WALLIS_LT = prove + (`!n. &0 < integral(&0,pi / &2) (\x. sin(x) pow n)`, + MATCH_MP_TAC ODDEVEN_INDUCT THEN + REWRITE_TAC[WALLIS_0; WALLIS_1; PI2_LT; REAL_OF_NUM_LT; ARITH] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[WALLIS_PARTS'] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_DIV THEN REAL_ARITH_TAC);; + +let WALLIS_NZ = prove + (`!n. ~(integral(&0,pi / &2) (\x. sin(x) pow n) = &0)`, + MP_TAC WALLIS_LT THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let WALLIS_BOUNDS = prove + (`!n. integral(&0,pi / &2) (\x. sin(x) pow (n + 1)) + <= integral(&0,pi / &2) (\x. sin(x) pow n) /\ + integral(&0,pi / &2) (\x. sin(x) pow n) <= + (&n + &2) / (&n + &1) * integral(&0,pi / &2) (\x. sin(x) pow (n + 1))`, + GEN_TAC THEN SIMP_TAC[WALLIS_MONO; LE_ADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&n + &2) / (&n + &1) * + integral (&0,pi / &2) (\x. sin x pow (n + 2))` THEN + CONJ_TAC THENL + [REWRITE_TAC[WALLIS_PARTS'] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[WALLIS_MONO; ARITH_RULE `n + 1 <= n + 2`] THEN + MATCH_MP_TAC REAL_LE_DIV THEN REAL_ARITH_TAC);; + +let WALLIS_RATIO_BOUNDS = prove + (`!n. &1 <= integral(&0,pi / &2) (\x. sin(x) pow n) / + integral(&0,pi / &2) (\x. sin(x) pow (n + 1)) /\ + integral(&0,pi / &2) (\x. sin(x) pow n) / + integral(&0,pi / &2) (\x. sin(x) pow (n + 1)) <= (&n + &2) / (&n + &1)`, + GEN_TAC THEN CONJ_TAC THENL + [SIMP_TAC[REAL_LE_RDIV_EQ; WALLIS_LT; REAL_MUL_LID; WALLIS_BOUNDS]; + SIMP_TAC[REAL_LE_LDIV_EQ; WALLIS_LT; WALLIS_BOUNDS]]);; + +let WALLIS = prove + (`(\n. (&2 pow n * &(FACT n)) pow 4 / (&(FACT(2 * n)) * &(FACT(2 * n + 1)))) + --> pi / &2`, + ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC SEQ_INV THEN + CONJ_TAC THENL [ALL_TAC; MP_TAC PI2_NZ THEN CONV_TAC REAL_FIELD] THEN + REWRITE_TAC[GSYM WALLIS_QUOTIENT'] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN + GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [REAL_ARITH `x = (x - &1) + &1`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN + MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[SEQ_CONST] THEN + MATCH_MP_TAC SEQ_LE_0 THEN EXISTS_TAC `\n. &1 / &n` THEN + REWRITE_TAC[SEQ_HARMONIC] THEN EXISTS_TAC `1` THEN + REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!d. &1 <= x /\ x <= d /\ d - &1 <= e ==> abs(x - &1) <= e`) THEN + EXISTS_TAC `(&(2 * n) + &2) / (&(2 * n) + &1)` THEN + REWRITE_TAC[WALLIS_RATIO_BOUNDS] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_FIELD + `(&2 * &n + &2) / (&2 * &n + &1) - &1 = &1 / (&2 * &n + &1)`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence determine the actual value of the limit. *) +(* ------------------------------------------------------------------------- *) + +let LN_WALLIS = prove + (`(\n. &4 * &n * ln(&2) + &4 * ln(&(FACT n)) - + (ln(&(FACT(2 * n))) + ln(&(FACT(2 * n + 1))))) --> ln(pi / &2)`, + REWRITE_TAC[REAL_ARITH `&4 * x + &4 * y - z = &4 * (x + y) - z`] THEN + SUBGOAL_THEN `!n. &0 < &2 pow n` + (fun th -> SIMP_TAC[th; GSYM LN_POW; REAL_OF_NUM_LT; ARITH; GSYM LN_MUL; + FACT_LT; REAL_POW_LT; REAL_LT_MUL; GSYM LN_DIV]) THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC CONTL_SEQ THEN REWRITE_TAC[WALLIS] THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(pi / &2)` THEN + MP_TAC(SPEC `pi / &2` (DIFF_CONV `\x. ln(x)`)) THEN + SIMP_TAC[ETA_AX; PI2_LT; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_MUL_RID]);; + +let STIRLING = prove + (`(\n. ln(&(FACT n)) - ((&n + &1 / &2) * ln(&n) - &n + ln(&2 * pi) / &2)) + --> &0`, + REWRITE_TAC[REAL_ARITH `a - (b - c + d) = (a - (b - c)) - d`] THEN + SUBST1_TAC(SYM(SPEC `ln(&2 * pi) / &2` REAL_SUB_REFL)) THEN + MATCH_MP_TAC SEQ_SUB THEN REWRITE_TAC[SEQ_CONST] THEN + X_CHOOSE_THEN `C:real` MP_TAC STIRLING_CONVERGES THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[stirling] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`2`; `1`] o MATCH_MP SEQ_SUBSEQ) THEN + FIRST_ASSUM(MP_TAC o SPECL [`2`; `0`] o MATCH_MP SEQ_SUBSEQ) THEN + REWRITE_TAC[ARITH; ADD_CLAUSES; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_ADD) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SEQ_MUL o CONJ (SPEC `&4` SEQ_CONST)) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN + MP_TAC LN_WALLIS THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN + REWRITE_TAC[ARITH_RULE + `(a + &4 * x - (y + z)) - (&4 * (x - b) - ((y - c) + (z - d))) = + (a + &4 * b) - (c + d)`] THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN + SUBGOAL_THEN `C = ln(&2 * pi) / &2` (fun th -> REWRITE_TAC[th]) THEN + POP_ASSUM(MP_TAC o CONJ (SPEC `&2 * ln(&2)` SEQ_CONST)) THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_ADD) THEN + SIMP_TAC[LN_DIV; PI_POS; REAL_OF_NUM_LT; ARITH; LN_MUL] THEN + REWRITE_TAC[REAL_ARITH `&2 * l + p - l - (&4 * C - (C + C)) = + (l + p) - &2 * C`] THEN + SIMP_TAC[REAL_ARITH `C = (l + p) / &2 <=> (l + p) - &2 * C = &0`] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + SEQ_UNIQ) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_ARITH + `a + (b + &4 * (c - x)) - ((d - &2 * x) + (e - (&2 * x + &1))) = + (a + b + &4 * c + &1) - (d + e)`] THEN + REWRITE_TAC[REAL_ARITH `&2 * l + &4 * n * l + &4 * (n + &1 / &2) * x + &1 = + (&4 * n + &2) * (l + x) + &1`] THEN + ONCE_REWRITE_TAC[SEQ_SUC] THEN + SIMP_TAC[GSYM LN_MUL; REAL_OF_NUM_LT; ARITH; LT_0] THEN + REWRITE_TAC[GSYM SEQ_SUC] THEN + CONV_TAC(LAND_CONV(GEN_ALPHA_CONV `n:num`)) THEN + REWRITE_TAC[REAL_ARITH + `((&4 * n + &2) * l + &1) - ((&2 * n + &1 / &2) * l + z) = + (&2 * n + &3 / &2) * l + &1 - z`] THEN + REWRITE_TAC[REAL_ARITH + `(&2 * n + &3 / &2) * l + &1 - ((&2 * n + &1) + &1 / &2) * l' = + (&2 * n + &3 / &2) * (l - l') + &1`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&0 = -- &1 + &1`] THEN + MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[SEQ_CONST] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * (b - c) = --(a * (c - b))`] THEN + REWRITE_TAC[GSYM SEQ_NEG] THEN + ONCE_REWRITE_TAC[SEQ_SUC] THEN + SIMP_TAC[GSYM LN_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; LT_0; ARITH; + REAL_ARITH `&0 < &2 * &n + &1`] THEN + SIMP_TAC[REAL_OF_NUM_LT; LT_0; REAL_FIELD + `&0 < x ==> (&2 * x + &1) / (&2 * x) = &1 + &1 / (&2 * x)`] THEN + REWRITE_TAC[GSYM SEQ_SUC] THEN + CONV_TAC(LAND_CONV(GEN_ALPHA_CONV `n:num`)) THEN + MP_TAC SEQ_SUBSEQ THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o GENL [`f:num->real`; `l:real`] o + SPECL [`f:num->real`; `l:real`; `2`; `0`]) THEN + REWRITE_TAC[ADD_CLAUSES; ARITH; REAL_OF_NUM_MUL] THEN + DISCH_THEN MATCH_MP_TAC THEN CONV_TAC(LAND_CONV(GEN_ALPHA_CONV `n:num`)) THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&1 = &1 + &3 / &2 * &0`] THEN + MATCH_MP_TAC SEQ_ADD THEN REWRITE_TAC[LN_LIM_LEMMA] THEN + MATCH_MP_TAC SEQ_MUL THEN REWRITE_TAC[SEQ_CONST] THEN + MP_TAC LN_LIM_LEMMA THEN MP_TAC(SPEC `&1` SEQ_HARMONIC) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_MUL) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEQ_SUC] THEN + SIMP_TAC[real_div; REAL_MUL_LID; REAL_MUL_ASSOC; REAL_MUL_LINV; + REAL_MUL_RID; REAL_OF_NUM_EQ; NOT_SUC]);; diff --git a/100/subsequence.ml b/100/subsequence.ml new file mode 100644 index 0000000..1b4385f --- /dev/null +++ b/100/subsequence.ml @@ -0,0 +1,131 @@ +(* ========================================================================= *) +(* #73: Erdos-Szekeres theorem on ascending / descending subsequences. *) +(* ========================================================================= *) + +let lemma = prove + (`!f s. s = UNIONS (IMAGE (\a. {x | x IN s /\ f(x) = a}) (IMAGE f s))`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN GEN_TAC THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_IMAGE] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + REWRITE_TAC[UNWIND_THM2; GSYM CONJ_ASSOC; IN_ELIM_THM] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Pigeonhole lemma. *) +(* ------------------------------------------------------------------------- *) + +let PIGEONHOLE_LEMMA = prove + (`!f:A->B s n. + FINITE s /\ (n - 1) * CARD(IMAGE f s) < CARD s + ==> ?t a. t SUBSET s /\ t HAS_SIZE n /\ (!x. x IN t ==> f(x) = a)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPECL [`f:A->B`; `s:A->bool`] lemma) THEN DISCH_THEN(fun th -> + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [th]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[NOT_LT] THEN + STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN MATCH_MP_TAC + (REWRITE_RULE[SET_RULE `{t x | x IN s} = IMAGE t s`] CARD_UNIONS_LE) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_IMAGE] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE `~(n <= x) ==> x <= n - 1`) THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[] THEN + MP_TAC(ISPEC `{y | y IN s /\ (f:A->B) y = f x}` CHOOSE_SUBSET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Abbreviation for "monotonicity of f on s w.r.t. ordering r". *) +(* ------------------------------------------------------------------------- *) + +let mono_on = define + `mono_on (f:num->real) r s <=> + !i j. i IN s /\ j IN s /\ i <= j ==> r (f i) (f j)`;; + +let MONO_ON_SUBSET = prove + (`!s t. t SUBSET s /\ mono_on f r s ==> mono_on f r t`, + REWRITE_TAC[mono_on; SUBSET] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The main result. *) +(* ------------------------------------------------------------------------- *) + +let ERDOS_SZEKERES = prove + (`!f:num->real m n. + (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE (m + 1) /\ mono_on f (<=) s) \/ + (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE (n + 1) /\ mono_on f (>=) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!i. i IN (1..m*n+1) + ==> ?k. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE k /\ + mono_on f (<=) s /\ i IN s /\ (!j. j IN s ==> i <= j)) /\ + (!l. (?s. s SUBSET (1..m*n+1) /\ s HAS_SIZE l /\ + mono_on f (<=) s /\ i IN s /\ (!j. j IN s ==> i <= j)) + ==> l <= k)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`1`; `{i:num}`] THEN + ASM_SIMP_TAC[SUBSET; IN_SING; LE_REFL; HAS_SIZE; FINITE_INSERT] THEN + SIMP_TAC[FINITE_RULES; CARD_CLAUSES; NOT_IN_EMPTY; ARITH] THEN + SIMP_TAC[mono_on; IN_SING; REAL_LE_REFL]; + EXISTS_TAC `CARD(1..m*n+1)` THEN + ASM_MESON_TAC[CARD_SUBSET; FINITE_NUMSEG; HAS_SIZE]]; + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num->num` (LABEL_TAC "*" ))] THEN + ASM_CASES_TAC `?i. i IN (1..m*n+1) /\ m + 1 <= t(i)` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->bool` STRIP_ASSUME_TAC o CONJUNCT1) THEN + MP_TAC(ISPEC `s:num->bool` CHOOSE_SUBSET) THEN + ASM_MESON_TAC[HAS_SIZE; MONO_ON_SUBSET; SUBSET_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN `!i. i IN (1..m*n+1) ==> 1 <= t i /\ t i <= m` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_FORALL) THEN + X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `1` o CONJUNCT2) THEN + STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `~(m + 1 <= n) ==> n <= m`]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `{i:num}` THEN + ASM_SIMP_TAC[SUBSET; IN_SING; LE_REFL; HAS_SIZE; FINITE_INSERT] THEN + SIMP_TAC[FINITE_RULES; CARD_CLAUSES; NOT_IN_EMPTY; ARITH] THEN + SIMP_TAC[mono_on; IN_SING; REAL_LE_REFL]; + ALL_TAC] THEN + DISJ2_TAC THEN + SUBGOAL_THEN + `?s k:num. s SUBSET (1..m*n+1) /\ s HAS_SIZE (n + 1) /\ + !i. i IN s ==> t(i) = k` + MP_TAC THENL + [MATCH_MP_TAC PIGEONHOLE_LEMMA THEN + REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; ADD_SUB] THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `n * CARD(1..m)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CARD_NUMSEG_1] THEN ARITH_TAC] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IN_NUMSEG]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[mono_on] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + REWRITE_TAC[LE_LT; real_ge] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN + REMOVE_THEN "*" (fun th -> + MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->bool` STRIP_ASSUME_TAC o CONJUNCT1) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `k + 1` o CONJUNCT2) THEN + ASM_SIMP_TAC[ARITH_RULE `~(k + 1 <= k)`; GSYM REAL_NOT_LT] THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + DISCH_TAC THEN EXISTS_TAC `(i:num) INSERT s` THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + REWRITE_TAC[HAS_SIZE_CLAUSES; GSYM ADD1] THEN ASM_MESON_TAC[NOT_LT]; + ALL_TAC; + REWRITE_TAC[IN_INSERT]; + ASM_MESON_TAC[IN_INSERT; LE_REFL; LT_IMP_LE; LE_TRANS]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[mono_on]) THEN + REWRITE_TAC[mono_on; IN_INSERT] THEN + ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS; REAL_LT_IMP_LE; NOT_LE; + LT_REFL; LE_TRANS]);; diff --git a/100/thales.ml b/100/thales.ml new file mode 100644 index 0000000..1303c5e --- /dev/null +++ b/100/thales.ml @@ -0,0 +1,87 @@ +(* ========================================================================= *) +(* Thales's theorem. *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Geometric concepts. *) +(* ------------------------------------------------------------------------- *) + +let BETWEEN_THM = prove + (`between x (a,b) <=> + ?u. &0 <= u /\ u <= &1 /\ x = u % a + (&1 - u) % b`, + REWRITE_TAC[BETWEEN_IN_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN + REWRITE_TAC[CONVEX_HULL_2_ALT; IN_ELIM_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + AP_TERM_TAC THEN VECTOR_ARITH_TAC);; + +let length_def = new_definition + `length(A:real^2,B:real^2) = norm(B - A)`;; + +let is_midpoint = new_definition + `is_midpoint (m:real^2) (a,b) <=> m = (&1 / &2) % (a + b)`;; + +(* ------------------------------------------------------------------------- *) +(* This formulation works. *) +(* ------------------------------------------------------------------------- *) + +let THALES = prove + (`!centre radius a b c. + length(a,centre) = radius /\ + length(b,centre) = radius /\ + length(c,centre) = radius /\ + is_midpoint centre (a,b) + ==> orthogonal (c - a) (c - b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[length_def; BETWEEN_THM; is_midpoint] THEN + STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x pow 2`)) THEN + REWRITE_TAC[NORM_POW_2] THEN FIRST_ASSUM(MP_TAC o SYM) THEN + ABBREV_TAC `rad = radius pow 2` THEN POP_ASSUM_LIST(K ALL_TAC) THEN + SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; + orthogonal; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* But for another natural version, we need to use the reals. *) +(* ------------------------------------------------------------------------- *) + +needs "Examples/sos.ml";; + +(* ------------------------------------------------------------------------- *) +(* The following, which we need as a lemma, needs the reals specifically. *) +(* ------------------------------------------------------------------------- *) + +let MIDPOINT = prove + (`!m a b. between m (a,b) /\ length(a,m) = length(b,m) + ==> is_midpoint m (a,b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[length_def; BETWEEN_THM; is_midpoint; NORM_EQ] THEN + SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; + orthogonal; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_SOS);; + +(* ------------------------------------------------------------------------- *) +(* Now we get a more natural formulation of Thales's theorem. *) +(* ------------------------------------------------------------------------- *) + +let THALES = prove + (`!centre radius a b c:real^2. + length(a,centre) = radius /\ + length(b,centre) = radius /\ + length(c,centre) = radius /\ + between centre (a,b) + ==> orthogonal (c - a) (c - b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `is_midpoint centre (a,b)` MP_TAC THENL + [MATCH_MP_TAC MIDPOINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + UNDISCH_THEN `between (centre:real^2) (a,b)` (K ALL_TAC) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o AP_TERM `\x. x pow 2`)) THEN + REWRITE_TAC[length_def; is_midpoint; orthogonal; NORM_POW_2] THEN + ABBREV_TAC `rad = radius pow 2` THEN POP_ASSUM_LIST(K ALL_TAC) THEN + SIMP_TAC[dot; SUM_2; VECTOR_SUB_COMPONENT; DIMINDEX_2; VECTOR_ADD_COMPONENT; + orthogonal; CART_EQ; FORALL_2; VECTOR_MUL_COMPONENT; ARITH] THEN + CONV_TAC REAL_RING);; diff --git a/100/triangular.ml b/100/triangular.ml new file mode 100644 index 0000000..5477736 --- /dev/null +++ b/100/triangular.ml @@ -0,0 +1,70 @@ +(* ========================================================================= *) +(* Sum of reciprocals of triangular numbers. *) +(* ========================================================================= *) + +needs "Multivariate/misc.ml";; (*** Just for REAL_ARCH_INV! ***) + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Definition of triangular numbers. *) +(* ------------------------------------------------------------------------- *) + +let triangle = new_definition + `triangle n = (n * (n + 1)) DIV 2`;; + +(* ------------------------------------------------------------------------- *) +(* Mapping them into the reals: division is exact. *) +(* ------------------------------------------------------------------------- *) + +let REAL_TRIANGLE = prove + (`&(triangle n) = (&n * (&n + &1)) / &2`, + MATCH_MP_TAC(REAL_ARITH `&2 * x = y ==> x = y / &2`) THEN + REWRITE_TAC[triangle; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + SUBGOAL_THEN `EVEN(n * (n + 1))` MP_TAC THENL + [REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH] THEN CONV_TAC TAUT; + REWRITE_TAC[EVEN_EXISTS] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN MATCH_MP_TAC DIV_MULT THEN REWRITE_TAC[ARITH]]);; + +(* ------------------------------------------------------------------------- *) +(* Sum of a finite number of terms. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_FINITE_SUM = prove + (`!n. sum(1..n) (\k. &1 / &(triangle k)) = &2 - &2 / (&n + &1)`, + INDUCT_TAC THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_TRIANGLE; GSYM REAL_OF_NUM_SUC] THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Hence limit. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_CONVERGES = prove + (`!e. &0 < e + ==> ?N. !n. n >= N + ==> abs(sum(1..n) (\k. &1 / &(triangle k)) - &2) < e`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `2 * N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[TRIANGLE_FINITE_SUM; REAL_ARITH `abs(x - y - x) = abs y`] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* In terms of limits. *) +(* ------------------------------------------------------------------------- *) + +needs "Library/analysis.ml";; + +override_interface ("-->",`(tends_num_real)`);; + +let TRIANGLE_CONVERGES' = prove + (`(\n. sum(1..n) (\k. &1 / &(triangle k))) --> &2`, + REWRITE_TAC[SEQ; TRIANGLE_CONVERGES]);; diff --git a/100/two_squares.ml b/100/two_squares.ml new file mode 100644 index 0000000..7977233 --- /dev/null +++ b/100/two_squares.ml @@ -0,0 +1,263 @@ +(* ========================================================================= *) +(* Representation of primes == 1 (mod 4) as sum of 2 squares. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Definition of involution and various basic lemmas. *) +(* ------------------------------------------------------------------------- *) + +let involution = new_definition + `involution f s = !x. x IN s ==> f(x) IN s /\ (f(f(x)) = x)`;; + +let INVOLUTION_IMAGE = prove + (`!f s. involution f s ==> (IMAGE f s = s)`, + REWRITE_TAC[involution; EXTENSION; IN_IMAGE] THEN MESON_TAC[]);; + +let INVOLUTION_DELETE = prove + (`involution f s /\ a IN s /\ (f a = a) ==> involution f (s DELETE a)`, + REWRITE_TAC[involution; IN_DELETE] THEN MESON_TAC[]);; + +let INVOLUTION_STEPDOWN = prove + (`involution f s /\ a IN s ==> involution f (s DIFF {a, (f a)})`, + REWRITE_TAC[involution; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let INVOLUTION_NOFIXES = prove + (`involution f s ==> involution f {x | x IN s /\ ~(f x = x)}`, + REWRITE_TAC[involution; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INVOLUTION_SUBSET = prove + (`!f s t. involution f s /\ (!x. x IN t ==> f(x) IN t) /\ t SUBSET s + ==> involution f t`, + REWRITE_TAC[involution; SUBSET] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Involution with no fixpoints can only occur on finite set of even card *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_EVEN_STEP = prove + (`FINITE(s) /\ + involution f s /\ + (!x:A. x IN s ==> ~(f x = x)) /\ + a IN s + ==> FINITE(s DIFF {a, (f a)}) /\ + involution f (s DIFF {a, (f a)}) /\ + (!x:A. x IN (s DIFF {a, (f a)}) ==> ~(f x = x)) /\ + (CARD s = CARD(s DIFF {a, (f a)}) + 2)`, + SIMP_TAC[FINITE_DIFF; INVOLUTION_STEPDOWN; IN_DIFF] THEN STRIP_TAC THEN + SUBGOAL_THEN `s = (a:A) INSERT (f a) INSERT (s DIFF {a, (f a)})` MP_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[involution]; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DIFF; FINITE_INSERT] THEN + ASM_SIMP_TAC[IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN ARITH_TAC);; + +let INVOLUTION_EVEN_INDUCT = prove + (`!n s. FINITE(s) /\ (CARD s = n) /\ involution f s /\ + (!x:A. x IN s ==> ~(f x = x)) + ==> EVEN(CARD s)`, + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + ASM_CASES_TAC `s:A->bool = {}` THEN + ASM_REWRITE_TAC[CARD_CLAUSES; ARITH] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EXTENSION]) THEN + REWRITE_TAC[NOT_IN_EMPTY; NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(s DIFF {a:A, (f a)})`) THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `s DIFF {a:A, (f a)}`) THEN + MP_TAC INVOLUTION_EVEN_STEP THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < n + 2`] THEN + SIMP_TAC[EVEN_ADD; ARITH]);; + +let INVOLUTION_EVEN = prove + (`!s. FINITE(s) /\ involution f s /\ (!x:A. x IN s ==> ~(f x = x)) + ==> EVEN(CARD s)`, + MESON_TAC[INVOLUTION_EVEN_INDUCT]);; + +(* ------------------------------------------------------------------------- *) +(* So an involution with exactly one fixpoint has odd card domain. *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_FIX_ODD = prove + (`FINITE(s) /\ involution f s /\ (?!a:A. a IN s /\ (f a = a)) + ==> ODD(CARD s)`, + REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN STRIP_TAC THEN + SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; IN_DELETE; ODD; NOT_ODD] THEN + MATCH_MP_TAC INVOLUTION_EVEN THEN + ASM_SIMP_TAC[INVOLUTION_DELETE; FINITE_DELETE; IN_DELETE] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* And an involution on a set of odd finite card must have a fixpoint. *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_ODD = prove + (`!n s. FINITE(s) /\ involution f s /\ ODD(CARD s) + ==> ?a. a IN s /\ (f a = a)`, + REWRITE_TAC[GSYM NOT_EVEN] THEN MESON_TAC[INVOLUTION_EVEN]);; + +(* ------------------------------------------------------------------------- *) +(* Consequently, if one involution has a unique fixpoint, other has one. *) +(* ------------------------------------------------------------------------- *) + +let INVOLUTION_FIX_FIX = prove + (`!f g s. FINITE(s) /\ involution f s /\ involution g s /\ + (?!x. x IN s /\ (f x = x)) ==> ?x. x IN s /\ (g x = x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INVOLUTION_ODD THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INVOLUTION_FIX_ODD THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Formalization of Zagier's "one-sentence" proof over the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let zset = new_definition + `zset(a) = {(x,y,z) | x EXP 2 + 4 * y * z = a}`;; + +let zag = new_definition + `zag(x,y,z) = + if x + z < y then (x + 2 * z,z,y - (x + z)) + else if x < 2 * y then (2 * y - x, y, (x + z) - y) + else (x - 2 * y,(x + z) - y, y)`;; + +let tag = new_definition + `tag((x,y,z):num#num#num) = (x,z,y)`;; + +let ZAG_INVOLUTION_GENERAL = prove + (`0 < x /\ 0 < y /\ 0 < z ==> (zag(zag(x,y,z)) = (x,y,z))`, + REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[zag] THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[PAIR_EQ] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +let IN_TRIPLE = prove + (`(a,b,c) IN {(x,y,z) | P x y z} <=> P a b c`, + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[]);; + +let PRIME_SQUARE = prove + (`!n. ~prime(n * n)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[PRIME_0; MULT_CLAUSES] THEN + REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[ARITH] THEN + DISJ2_TAC THEN EXISTS_TAC `n:num` THEN + ASM_SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ARITH_RULE `n = n * 1`] THEN + ASM_SIMP_TAC[EQ_MULT_LCANCEL]);; + +let PRIME_4X = prove + (`!n. ~prime(4 * n)`, + GEN_TAC THEN REWRITE_TAC[prime; NOT_FORALL_THM; DE_MORGAN_THM] THEN + DISJ2_TAC THEN EXISTS_TAC `2` THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN + ASM_SIMP_TAC[GSYM MULT_ASSOC; DIVIDES_RMUL; DIVIDES_REFL; ARITH_EQ] THEN + ASM_CASES_TAC `n = 0` THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let PRIME_XYZ_NONZERO = prove + (`prime(x EXP 2 + 4 * y * z) ==> 0 < x /\ 0 < y /\ 0 < z`, + CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[DE_MORGAN_THM; ARITH_RULE `~(0 < x) = (x = 0)`] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES; PRIME_SQUARE; PRIME_4X]);; + +let ZAG_INVOLUTION = prove + (`!p. prime(p) ==> involution zag (zset(p))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[involution; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN + REWRITE_TAC[zset; IN_TRIPLE] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + CONJ_TAC THENL + [REWRITE_TAC[zag] THEN REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_TRIPLE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + ASM_SIMP_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD; EXP_2; + GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_SUB; LT_IMP_LE] THEN + INT_ARITH_TAC; + MATCH_MP_TAC ZAG_INVOLUTION_GENERAL THEN + ASM_MESON_TAC[PRIME_XYZ_NONZERO]]);; + +let TAG_INVOLUTION = prove + (`!a. involution tag (zset a)`, + REWRITE_TAC[involution; tag; zset; FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_TRIPLE] THEN REWRITE_TAC[MULT_AC]);; + +let ZAG_LEMMA = prove + (`(zag(x,y,z) = (x,y,z)) ==> (y = x)`, + REWRITE_TAC[zag; INT_POW_2] THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[PAIR_EQ]) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC);; + +let ZSET_BOUND = prove + (`0 < y /\ 0 < z /\ (x EXP 2 + 4 * y * z = p) + ==> x <= p /\ y <= p /\ z <= p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONJ_TAC THENL + [MESON_TAC[EXP_2; LE_SQUARE_REFL; ARITH_RULE `(a <= b ==> a <= b + c)`]; + CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE `y <= z ==> y <= x + z`) THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MULT_SYM]; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `y <= 4 * a * y <=> 1 * y <= (4 * a) * y`] THEN + ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < a ==> 1 <= 4 * a`]]);; + +let ZSET_FINITE = prove + (`!p. prime(p) ==> FINITE(zset p)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `p + 1` FINITE_NUMSEG_LT) THEN + DISCH_THEN(fun th -> + MP_TAC(funpow 2 (MATCH_MP FINITE_PRODUCT o CONJ th) th)) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + FINITE_SUBSET) THEN + REWRITE_TAC[zset; SUBSET; FORALL_PAIR_THM; IN_TRIPLE] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN + REWRITE_TAC[IN_ELIM_THM; EXISTS_PAIR_THM; PAIR_EQ] THEN + REWRITE_TAC[ARITH_RULE `x < p + 1 <=> x <= p`; PAIR_EQ] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:num`; `y:num`; `z:num`] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + MAP_EVERY EXISTS_TAC [`y:num`; `z:num`] THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[ZSET_BOUND; PRIME_XYZ_NONZERO]);; + +let SUM_OF_TWO_SQUARES = prove + (`!p k. prime(p) /\ (p = 4 * k + 1) ==> ?x y. p = x EXP 2 + y EXP 2`, + SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?t. t IN zset(p) /\ (tag(t) = t)` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM; tag; PAIR_EQ] THEN + REWRITE_TAC[zset; IN_TRIPLE; EXP_2] THEN + ASM_MESON_TAC[ARITH_RULE `4 * x * y = (2 * x) * (2 * y)`]] THEN + MATCH_MP_TAC INVOLUTION_FIX_FIX THEN EXISTS_TAC `zag` THEN + ASM_SIMP_TAC[ZAG_INVOLUTION; TAG_INVOLUTION; ZSET_FINITE] THEN + REWRITE_TAC[EXISTS_UNIQUE_ALT] THEN EXISTS_TAC `1,1,k:num` THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `y:num`; `z:num`] THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[zset; zag; IN_TRIPLE; ARITH] THEN + REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `~(1 + k < 1)`; PAIR_EQ] THEN + ARITH_TAC] THEN + REWRITE_TAC[zset; IN_TRIPLE] THEN STRIP_TAC THEN + FIRST_ASSUM(SUBST_ALL_TAC o MATCH_MP ZAG_LEMMA) THEN + UNDISCH_TAC `x EXP 2 + 4 * x * z = 4 * k + 1` THEN + REWRITE_TAC[EXP_2; ARITH_RULE `x * x + 4 * x * z = x * (4 * z + x)`] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `prime p` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[prime] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:num`)) THEN + SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL + [UNDISCH_TAC `4 * k + 1 = 1 * (4 * z + 1)` THEN + REWRITE_TAC[MULT_CLAUSES; PAIR_EQ] THEN ARITH_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `(a = a * b) = (a * b = a * 1)`] THEN + ASM_SIMP_TAC[EQ_MULT_LCANCEL] THEN STRIP_TAC THENL + [UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0; ARITH_EQ]; + UNDISCH_TAC `4 * z + x = 1` THEN REWRITE_TAC[PAIR_EQ] THEN + ASM_CASES_TAC `z = 0` THENL + [ALL_TAC; UNDISCH_TAC `~(z = 0)` THEN ARITH_TAC] THEN + UNDISCH_TAC `4 * k + 1 = x * (4 * z + x)` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + ASM_CASES_TAC `x = 1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MULT_CLAUSES] THEN ARITH_TAC]]);; diff --git a/100/wilson.ml b/100/wilson.ml new file mode 100644 index 0000000..3d7f34d --- /dev/null +++ b/100/wilson.ml @@ -0,0 +1,200 @@ +(* ========================================================================= *) +(* Wilson's theorem. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Definition of iterated product. *) +(* ------------------------------------------------------------------------- *) + +let product = new_definition `product = iterate ( * )`;; + +let PRODUCT_CLAUSES = prove + (`(!f. product {} f = 1) /\ + (!x f s. FINITE(s) + ==> (product (x INSERT s) f = + if x IN s then product s f else f(x) * product s f))`, + REWRITE_TAC[product; GSYM NEUTRAL_MUL] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Factorial in terms of products. *) +(* ------------------------------------------------------------------------- *) + +let FACT_PRODUCT = prove + (`!n. FACT(n) = product(1..n) (\i. i)`, + INDUCT_TAC THEN + REWRITE_TAC[FACT; NUMSEG_CLAUSES; ARITH; PRODUCT_CLAUSES] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= SUC n`; PRODUCT_CLAUSES; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; + +let FACT_PRODUCT_ALT = prove + (`!n. FACT(n) = product(2..n) (\i. i)`, + GEN_TAC THEN REWRITE_TAC[FACT_PRODUCT] THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THEN + ASM_REWRITE_TAC[num_CONV `1`; NUMSEG_CLAUSES] THEN + REWRITE_TAC[ARITH; PRODUCT_CLAUSES; FACT] THEN + ASM_SIMP_TAC[GSYM NUMSEG_LREC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; MULT_CLAUSES] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* General "pairing up" theorem for products. *) +(* ------------------------------------------------------------------------- *) + +let PRODUCT_PAIRUP_INDUCT = prove + (`!f r n s. FINITE s /\ CARD s = n /\ + (!x:A. x IN s ==> ?!y. y IN s /\ ~(y = x) /\ + (f(x) * f(y) == 1) (mod r)) + ==> (product s f == 1) (mod r)`, + GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + X_GEN_TAC `s:A->bool` THEN ASM_CASES_TAC `s:A->bool = {}` THEN + ASM_REWRITE_TAC[PRODUCT_CLAUSES; CONG_REFL] THEN STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[CARD_EQ_0]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + FIRST_ASSUM(MP_TAC o SPEC `n - 2`) THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 2 < n`] THEN + FIRST_ASSUM(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[ASSUME `(a:A) IN s`] THEN + REWRITE_TAC[EXISTS_UNIQUE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(s DELETE a) DELETE (b:A)`) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[FINITE_DELETE] THEN + SIMP_TAC[FINITE_DELETE; ASSUME `FINITE(s:A->bool)`; CARD_DELETE] THEN + ASM_REWRITE_TAC[IN_DELETE] THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(x:A) IN s`)) THEN + REWRITE_TAC[EXISTS_UNIQUE] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `y:A` THEN STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THENL + [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(b:A) IN s`)) THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`a:A`; `x:A`] o CONJUNCT2) THEN + ASM_MESON_TAC[MULT_SYM]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `s = (a:A) INSERT (b INSERT (s DELETE a DELETE b))` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_INSERT; FINITE_DELETE; + ASSUME `FINITE(s:A->bool)`] THEN + ASM_REWRITE_TAC[IN_INSERT; IN_DELETE; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_ASSOC] THEN + ONCE_REWRITE_TAC[SYM(NUM_REDUCE_CONV `1 * 1`)] THEN + MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[]);; + +let PRODUCT_PAIRUP = prove + (`!f r s. FINITE s /\ + (!x:A. x IN s ==> ?!y. y IN s /\ ~(y = x) /\ + (f(x) * f(y) == 1) (mod r)) + ==> (product s f == 1) (mod r)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_PAIRUP_INDUCT THEN + EXISTS_TAC `CARD(s:A->bool)` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence Wilson's theorem. *) +(* ------------------------------------------------------------------------- *) + +let WILSON = prove + (`!p. prime(p) ==> (FACT(p - 1) == p - 1) (mod p)`, + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `p = 0` THENL [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + ASM_CASES_TAC `p = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + ASM_CASES_TAC `p = 2` THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[CONG_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `FACT(p - 1) = FACT(p - 2) * (p - 1)` SUBST1_TAC THENL + [SUBGOAL_THEN `p - 1 = SUC(p - 2)` + (fun th -> REWRITE_TAC[th; FACT; MULT_AC]) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `x = 1 * x`] THEN + MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL] THEN + REWRITE_TAC[FACT_PRODUCT_ALT] THEN MATCH_MP_TAC PRODUCT_PAIRUP THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + MP_TAC(SPECL [`p:num`; `x:num`] CONG_UNIQUE_INVERSE_PRIME) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MATCH_MP_TAC MONO_EXISTS; + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC] THEN + X_GEN_TAC `y:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `y = 1` THEN + ASM_REWRITE_TAC[ARITH_RULE `2 <= y <=> 0 < y /\ ~(y = 1)`] THEN + UNDISCH_TAC `(x * y == 1) (mod p)` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + ASM_SIMP_TAC[CONG; MOD_LT; ARITH_RULE `x <= p - 2 /\ ~(p = 0) ==> x < p`; + ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 1 < p`] THEN + UNDISCH_TAC `2 <= x` THEN ARITH_TAC; + MATCH_MP_TAC(ARITH_RULE `y < p /\ ~(y = p - 1) ==> y <= p - 2`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + UNDISCH_TAC `(x * y == 1) (mod p)` THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN SUBGOAL_THEN `(x + 1 == 0) (mod p)` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[CONG_0] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + MAP_EVERY UNDISCH_TAC [`2 <= x`; `x <= p - 2`] THEN ARITH_TAC] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `x * p:num` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[CONG_0] THEN MESON_TAC[divides; MULT_SYM]] THEN + SUBGOAL_THEN `x * p = x + x * (p - 1)` SUBST1_TAC THENL + [REWRITE_TAC[LEFT_SUB_DISTRIB; MULT_CLAUSES] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_MP_TAC(GSYM SUB_ADD) THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `x = x * 1`] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN + UNDISCH_TAC `~(p = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC CONG_ADD THEN + ASM_REWRITE_TAC[CONG_REFL]; + FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN `((x + 1) * (x - 1) == 0) (mod p)` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[CONG_0] THEN + DISCH_THEN(MP_TAC o CONJ (ASSUME `prime p`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP PRIME_DIVPROD) THEN + DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP DIVIDES_LE)) THEN + MAP_EVERY UNDISCH_TAC + [`2 <= x`; `x <= p - 2`; `~(p = 1)`; `~(p = 0)`] THEN + ARITH_TAC] THEN + ONCE_REWRITE_TAC[GSYM(SPEC `1` CONG_ADD_LCANCEL_EQ)] THEN + SUBGOAL_THEN `1 + (x + 1) * (x - 1) = x * x` + (fun th -> ASM_REWRITE_TAC[th; ARITH]) THEN + REWRITE_TAC[LEFT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `(x + 1) * 1 <= (x + 1) * x + ==> 1 + (x + 1) * x - (x + 1) * 1 = x * x`) THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN UNDISCH_TAC `2 <= x` THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* And in fact we have a converse. *) +(* ------------------------------------------------------------------------- *) + +let WILSON_EQ = prove + (`!p. ~(p = 1) ==> (prime p <=> (FACT(p - 1) == p - 1) (mod p))`, + X_GEN_TAC `n:num` THEN DISCH_TAC THEN EQ_TAC THEN SIMP_TAC[WILSON] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[LE_LT] THEN ASM_CASES_TAC `n:num = p` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE `x < y ==> x <= y - 1`)) THEN + ASM_SIMP_TAC[GSYM DIVIDES_FACT_PRIME] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + SUBGOAL_THEN `p divides FACT(n - 1) <=> p divides (n - 1)` SUBST1_TAC THENL + [MATCH_MP_TAC CONG_DIVIDES THEN + MATCH_MP_TAC CONG_MOD_MULT THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN SUBGOAL_THEN `p divides 1` MP_TAC THENL + [MATCH_MP_TAC DIVIDES_ADD_REVR THEN EXISTS_TAC `n - 1` THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`]; + REWRITE_TAC[DIVIDES_ONE] THEN ASM_MESON_TAC[PRIME_1]]);; diff --git a/Arithmetic/arithprov.ml b/Arithmetic/arithprov.ml new file mode 100644 index 0000000..ab308ff --- /dev/null +++ b/Arithmetic/arithprov.ml @@ -0,0 +1,570 @@ +(* ========================================================================= *) +(* Proof that provability is definable; weak form of Godel's theorem. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary predicate: all numbers in an iterated-pair "list". *) +(* ------------------------------------------------------------------------- *) + +let ALLN_DEF = + let th = prove + (`!P. ?ALLN. !z. + ALLN z <=> + if ?x y. z = NPAIR x y + then P (@x. ?y. NPAIR x y = z) /\ + ALLN (@y. ?x. NPAIR x y = z) + else T`, + GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + BINOP_TAC THENL [ALL_TAC; FIRST_ASSUM MATCH_MP_TAC] THEN + FIRST_ASSUM(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[NPAIR_INJ; RIGHT_EXISTS_AND_THM; EXISTS_REFL; + SELECT_REFL; NPAIR_LT; LEFT_EXISTS_AND_THM]) in + new_specification ["ALLN"] (REWRITE_RULE[SKOLEM_THM] th);; + +let ALLN = prove + (`(ALLN P 0 <=> T) /\ + (ALLN P (NPAIR x y) <=> P x /\ ALLN P y)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [ALLN_DEF] THEN + REWRITE_TAC[NPAIR_NONZERO] THEN + REWRITE_TAC[NPAIR_INJ; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[EXISTS_REFL; GSYM EXISTS_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Valid term. *) +(* ------------------------------------------------------------------------- *) + +let TERM1 = new_definition + `TERM1 x y <=> + (?l u. (x = l) /\ (y = NPAIR (NPAIR 0 u) l)) \/ + (?l. (x = l) /\ (y = NPAIR (NPAIR 1 0) l)) \/ + (?t l. (x = NPAIR t l) /\ (y = NPAIR (NPAIR 2 t) l)) \/ + (?n s t l. ((n = 3) \/ (n = 4)) /\ + (x = NPAIR s (NPAIR t l)) /\ + (y = NPAIR (NPAIR n (NPAIR s t)) l))`;; + +let TERM = new_definition + `TERM n <=> RTC TERM1 0 (NPAIR n 0)`;; + +let isagterm = new_definition + `isagterm n <=> ?t. n = gterm t`;; + +let TERM_LEMMA1 = prove + (`!x y. TERM1 x y ==> ALLN isagterm x ==> ALLN isagterm y`, + REPEAT GEN_TAC THEN REWRITE_TAC[TERM1] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN; isagterm] THEN + MESON_TAC[gterm; NUMBER_SURJ]);; + +let TERM_LEMMA2 = prove + (`!t a. RTC TERM1 a (NPAIR (gterm t) a)`, + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[gterm] THEN + MESON_TAC[RTC_INC; RTC_TRANS; TERM1]);; + +let TERM_THM = prove + (`!n. TERM n <=> ?t. n = gterm t`, + GEN_TAC THEN REWRITE_TAC[TERM] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[TERM_LEMMA2]] THEN + SUBGOAL_THEN `!x y. RTC TERM1 x y ==> ALLN isagterm x ==> ALLN isagterm y` + (fun th -> MESON_TAC[ALLN; isagterm; th]) THEN + MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[TERM_LEMMA1] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Valid formula. *) +(* ------------------------------------------------------------------------- *) + +let FORM1 = new_definition + `FORM1 x y <=> + (?l. (x = l) /\ (y = NPAIR (NPAIR 0 0) l)) \/ + (?l. (x = l) /\ (y = NPAIR (NPAIR 0 1) l)) \/ + (?n s t l. ((n = 1) \/ (n = 2) \/ (n = 3)) /\ + TERM s /\ TERM t /\ + (x = l) /\ + (y = NPAIR (NPAIR n (NPAIR s t)) l)) \/ + (?p l. (x = NPAIR p l) /\ + (y = NPAIR (NPAIR 4 p) l)) \/ + (?n p q l. ((n = 5) \/ (n = 6) \/ (n = 7) \/ (n = 8)) /\ + (x = NPAIR p (NPAIR q l)) /\ + (y = NPAIR (NPAIR n (NPAIR p q)) l)) \/ + (?n u p l. ((n = 9) \/ (n = 10)) /\ + (x = NPAIR p l) /\ + (y = NPAIR (NPAIR n (NPAIR u p)) l))`;; + +let FORM = new_definition + `FORM n <=> RTC FORM1 0 (NPAIR n 0)`;; + +let isagform = new_definition + `isagform n <=> ?t. n = gform t`;; + +let FORM_LEMMA1 = prove + (`!x y. FORM1 x y ==> ALLN isagform x ==> ALLN isagform y`, + REPEAT GEN_TAC THEN REWRITE_TAC[FORM1] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN; isagform] THEN + MESON_TAC[gform; TERM_THM; NUMBER_SURJ]);; + +(*** Following really blows up if we just use FORM1 + *** instead of manually breaking up the conjuncts + ***) + +let FORM_LEMMA2 = prove + (`!p a. RTC FORM1 a (NPAIR (gform p) a)`, + MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[gform] THEN + REPEAT CONJ_TAC THEN + MESON_TAC[RTC_INC; RTC_TRANS; TERM_THM; + REWRITE_RULE[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] + (snd(EQ_IMP_RULE (SPEC_ALL FORM1)))]);; + +let FORM_THM = prove + (`!n. FORM n <=> ?p. n = gform p`, + GEN_TAC THEN REWRITE_TAC[FORM] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[FORM_LEMMA2]] THEN + SUBGOAL_THEN `!x y. RTC FORM1 x y ==> ALLN isagform x ==> ALLN isagform y` + (fun th -> MESON_TAC[ALLN; isagform; th]) THEN + MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FORM_LEMMA1] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Term without particular variable. *) +(* ------------------------------------------------------------------------- *) + +let FREETERM1 = new_definition + `FREETERM1 m x y <=> + (?l u. ~(u = m) /\ (x = l) /\ (y = NPAIR (NPAIR 0 u) l)) \/ + (?l. (x = l) /\ (y = NPAIR (NPAIR 1 0) l)) \/ + (?t l. (x = NPAIR t l) /\ (y = NPAIR (NPAIR 2 t) l)) \/ + (?n s t l. ((n = 3) \/ (n = 4)) /\ + (x = NPAIR s (NPAIR t l)) /\ + (y = NPAIR (NPAIR n (NPAIR s t)) l))`;; + +let FREETERM = new_definition + `FREETERM m n <=> RTC (FREETERM1 m) 0 (NPAIR n 0)`;; + +let isafterm = new_definition + `isafterm m n <=> ?t. ~(m IN IMAGE number (FVT t)) /\ (n = gterm t)`;; + +let ISAFTERM = prove + (`(~(number x = m) ==> isafterm m (NPAIR 0 (number x))) /\ + isafterm m (NPAIR 1 0) /\ + (isafterm m t ==> isafterm m (NPAIR 2 t)) /\ + (isafterm m s /\ isafterm m t ==> isafterm m (NPAIR 3 (NPAIR s t))) /\ + (isafterm m s /\ isafterm m t ==> isafterm m (NPAIR 4 (NPAIR s t)))`, + REWRITE_TAC[isafterm; gterm] THEN REPEAT CONJ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `V x`; + EXISTS_TAC `Z`; + DISCH_THEN(X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Suc t`; + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `s ++ t`; + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `s ** t`] THEN + ASM_REWRITE_TAC[gterm; FVT; IMAGE_UNION; NOT_IN_EMPTY; IN_SING; IN_UNION; + IMAGE_CLAUSES]);; + +let FREETERM_LEMMA1 = prove + (`!m x y. FREETERM1 m x y ==> ALLN (isafterm m) x ==> ALLN (isafterm m) y`, + REPEAT GEN_TAC THEN REWRITE_TAC[FREETERM1] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN + MESON_TAC[ISAFTERM; NUMBER_SURJ]);; + +let FREETERM_LEMMA2 = prove + (`!m t a. ~(m IN IMAGE number (FVT t)) + ==> RTC (FREETERM1 m) a (NPAIR (gterm t) a)`, + GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[gterm; FVT; NOT_IN_EMPTY; IN_SING; IN_UNION; + IMAGE_CLAUSES; IMAGE_UNION] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN + REPEAT CONJ_TAC THEN + TRY(REPEAT GEN_TAC THEN DISCH_THEN + (fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC th)) THEN + ASM_REWRITE_TAC[] THEN + MESON_TAC[RTC_INC; RTC_TRANS; FREETERM1]);; + +let FREETERM_THM = prove + (`!m n. FREETERM m n <=> ?t. ~(m IN IMAGE number (FVT(t))) /\ (n = gterm t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FREETERM] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[FREETERM_LEMMA2]] THEN + SUBGOAL_THEN `!x y. RTC (FREETERM1 m) x y + ==> ALLN (isafterm m) x ==> ALLN (isafterm m) y` + (fun th -> MESON_TAC[ALLN; isagterm; isafterm; th]) THEN + MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FREETERM_LEMMA1] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Formula without particular free variable. *) +(* ------------------------------------------------------------------------- *) + +let FREEFORM1 = new_definition + `FREEFORM1 m x y <=> + (?l. (x = l) /\ (y = NPAIR (NPAIR 0 0) l)) \/ + (?l. (x = l) /\ (y = NPAIR (NPAIR 0 1) l)) \/ + (?n s t l. ((n = 1) \/ (n = 2) \/ (n = 3)) /\ + FREETERM m s /\ FREETERM m t /\ + (x = l) /\ + (y = NPAIR (NPAIR n (NPAIR s t)) l)) \/ + (?p l. (x = NPAIR p l) /\ + (y = NPAIR (NPAIR 4 p) l)) \/ + (?n p q l. ((n = 5) \/ (n = 6) \/ (n = 7) \/ (n = 8)) /\ + (x = NPAIR p (NPAIR q l)) /\ + (y = NPAIR (NPAIR n (NPAIR p q)) l)) \/ + (?n u p l. ((n = 9) \/ (n = 10)) /\ + (x = NPAIR p l) /\ + (y = NPAIR (NPAIR n (NPAIR u p)) l)) \/ + (?n p l. ((n = 9) \/ (n = 10)) /\ + (x = l) /\ FORM p /\ + (y = NPAIR (NPAIR n (NPAIR m p)) l))`;; + +let FREEFORM = new_definition + `FREEFORM m n <=> RTC (FREEFORM1 m) 0 (NPAIR n 0)`;; + +let isafform = new_definition + `isafform m n <=> ?p. ~(m IN IMAGE number (FV p)) /\ (n = gform p)`;; + +let ISAFFORM = prove + (`isafform m (NPAIR 0 0) /\ + isafform m (NPAIR 0 1) /\ + (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 1 (NPAIR s t))) /\ + (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 2 (NPAIR s t))) /\ + (isafterm m s /\ isafterm m t ==> isafform m (NPAIR 3 (NPAIR s t))) /\ + (isafform m p ==> isafform m (NPAIR 4 p)) /\ + (isafform m p /\ isafform m q ==> isafform m (NPAIR 5 (NPAIR p q))) /\ + (isafform m p /\ isafform m q ==> isafform m (NPAIR 6 (NPAIR p q))) /\ + (isafform m p /\ isafform m q ==> isafform m (NPAIR 7 (NPAIR p q))) /\ + (isafform m p /\ isafform m q ==> isafform m (NPAIR 8 (NPAIR p q))) /\ + (isafform m p ==> isafform m (NPAIR 9 (NPAIR x p))) /\ + (isafform m p ==> isafform m (NPAIR 10 (NPAIR x p))) /\ + (isagform p ==> isafform m (NPAIR 9 (NPAIR m p))) /\ + (isagform p ==> isafform m (NPAIR 10 (NPAIR m p)))`, + let tac0 = DISCH_THEN(X_CHOOSE_THEN `p:form` STRIP_ASSUME_TAC) + and tac1 = + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s:term` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t:term` STRIP_ASSUME_TAC)) + and tac2 = + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:form` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `q:form` STRIP_ASSUME_TAC)) in + REWRITE_TAC[isafform; gform; isagform; isafterm] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `False`; + EXISTS_TAC `True`; + tac1 THEN EXISTS_TAC `s === t`; + tac1 THEN EXISTS_TAC `s << t`; + tac1 THEN EXISTS_TAC `s <<= t`; + tac0 THEN EXISTS_TAC `Not p`; + tac2 THEN EXISTS_TAC `p && q`; + tac2 THEN EXISTS_TAC `p || q`; + tac2 THEN EXISTS_TAC `p --> q`; + tac2 THEN EXISTS_TAC `p <-> q`; + tac0 THEN EXISTS_TAC `!!(denumber x) p`; + tac0 THEN EXISTS_TAC `??(denumber x) p`; + tac0 THEN EXISTS_TAC `!!(denumber m) p`; + tac0 THEN EXISTS_TAC `??(denumber m) p`] THEN + ASM_REWRITE_TAC[FV; IN_DELETE; NOT_IN_EMPTY; IN_SING; IN_UNION; gform; + NUMBER_DENUMBER; IMAGE_CLAUSES; IMAGE_UNION] THEN + ASM SET_TAC[NUMBER_DENUMBER]);; + +let FREEFORM_LEMMA1 = prove + (`!x y. FREEFORM1 m x y ==> ALLN (isafform m) x ==> ALLN (isafform m) y`, + REPEAT GEN_TAC THEN REWRITE_TAC[FREEFORM1] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN + REWRITE_TAC[FREETERM_THM; GSYM isafterm] THEN + REWRITE_TAC[FORM_THM; GSYM isagform] THEN MESON_TAC[ISAFFORM]);; + +let FREEFORM_LEMMA2 = prove + (`!m p a. ~(m IN IMAGE number (FV p)) + ==> RTC (FREEFORM1 m) a (NPAIR (gform p) a)`, + let lemma = prove + (`m IN IMAGE number (s DELETE k) <=> + m IN IMAGE number s /\ ~(m = number k)`, + SET_TAC[NUMBER_INJ]) in + GEN_TAC THEN MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[gform; FV; NOT_IN_EMPTY; IN_DELETE; IN_SING; IN_UNION; + lemma; IMAGE_UNION; IMAGE_CLAUSES] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN + REPEAT CONJ_TAC THEN + TRY(REPEAT GEN_TAC THEN DISCH_THEN + (fun th -> GEN_TAC THEN STRIP_TAC THEN MP_TAC th)) THEN + ASM_REWRITE_TAC[] THEN + MESON_TAC[RTC_INC; RTC_TRANS; FORM_THM; + REWRITE_RULE[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`; + FREETERM_THM] + (snd(EQ_IMP_RULE (SPEC_ALL FREEFORM1)))]);; + +let FREEFORM_THM = prove + (`!m n. FREEFORM m n <=> ?p. ~(m IN IMAGE number (FV p)) /\ (n = gform p)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FREEFORM] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[FREEFORM_LEMMA2]] THEN + SUBGOAL_THEN `!x y. RTC (FREEFORM1 m) x y + ==> ALLN (isafform m) x ==> ALLN (isafform m) y` + (fun th -> MESON_TAC[ALLN; isagform; isafform; th]) THEN + MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[FREEFORM_LEMMA1] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetization of logical axioms --- autogenerated. *) +(* ------------------------------------------------------------------------- *) + +let AXIOM,AXIOM_THM = + let th0 = prove + (`((?x p. P (number x) (gform p) /\ ~(x IN FV(p))) <=> + (?x p. FREEFORM x p /\ P x p)) /\ + ((?x t. P (number x) (gterm t) /\ ~(x IN FVT(t))) <=> + (?x t. FREETERM x t /\ P x t))`, + REWRITE_TAC[FREETERM_THM; FREEFORM_THM] THEN CONJ_TAC THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + REWRITE_TAC[UNWIND_THM2; IN_IMAGE] THEN + ASM_MESON_TAC[IN_IMAGE; NUMBER_DENUMBER]) + and th1 = prove + (`((?p. P(gform p)) <=> (?p. FORM(p) /\ P p)) /\ + ((?t. P(gterm t)) <=> (?t. TERM(t) /\ P t))`, + MESON_TAC[FORM_THM; TERM_THM]) + and th2 = prove + (`(?x. P(number x)) <=> (?x. P x)`, + MESON_TAC[NUMBER_DENUMBER]) in + let th = (REWRITE_CONV[GSYM GFORM_INJ] THENC + REWRITE_CONV[gform; gterm] THENC + REWRITE_CONV[th0] THENC REWRITE_CONV[th1] THENC + REWRITE_CONV[th2] THENC + REWRITE_CONV[RIGHT_AND_EXISTS_THM]) + (rhs(concl(SPEC `a:form` axiom_CASES))) in + let dtm = mk_eq(`(AXIOM:num->bool) a`, + subst [`a:num`,`gform a`] (rhs(concl th))) in + let AXIOM = new_definition dtm in + let AXIOM_THM = prove + (`!p. AXIOM(gform p) <=> axiom p`, + REWRITE_TAC[axiom_CASES; AXIOM; th]) in + AXIOM,AXIOM_THM;; + +(* ------------------------------------------------------------------------- *) +(* Prove also that all AXIOMs are in fact numbers of formulas. *) +(* ------------------------------------------------------------------------- *) + +let GTERM_CASES_ALT = prove + (`(gterm u = NPAIR 0 x <=> u = V(denumber x))`, + REWRITE_TAC[GSYM GTERM_CASES; NUMBER_DENUMBER]);; + +let GFORM_CASES_ALT = prove + (`(gform r = NPAIR 9 (NPAIR x n) <=> + (?p. r = !!(denumber x) p /\ gform p = n)) /\ + (gform r = NPAIR 10 (NPAIR x n) <=> + (?p. r = ??(denumber x) p /\ gform p = n))`, + REWRITE_TAC[GSYM GFORM_CASES; NUMBER_DENUMBER]);; + +let AXIOM_FORMULA = prove + (`!a. AXIOM a ==> ?p. a = gform p`, + REWRITE_TAC[AXIOM; FREEFORM_THM; FREETERM_THM; FORM_THM; TERM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC(BINDER_CONV SYM_CONV) THEN + REWRITE_TAC[GFORM_CASES; GTERM_CASES; + GTERM_CASES_ALT; GFORM_CASES_ALT] THEN + MESON_TAC[NUMBER_DENUMBER]);; + +let AXIOM_THM_STRONG = prove + (`!a. AXIOM a <=> ?p. axiom p /\ (a = gform p)`, + MESON_TAC[AXIOM_THM; AXIOM_FORMULA]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetization of the full logical inference rules. *) +(* ------------------------------------------------------------------------- *) + +let PROV1 = new_definition + `PROV1 A x y <=> + (?a. (AXIOM a \/ a IN A) /\ (y = NPAIR a x)) \/ + (?p q l. (x = NPAIR (NPAIR 7 (NPAIR p q)) (NPAIR p l)) /\ + (y = NPAIR q l)) \/ + (?p u l. (x = NPAIR p l) /\ (y = NPAIR (NPAIR 9 (NPAIR u p)) l))`;; + +let PROV = new_definition + `PROV A n <=> RTC (PROV1 A) 0 (NPAIR n 0)`;; + +let isaprove = new_definition + `isaprove A n <=> ?p. (gform p = n) /\ A |-- p`;; + +let PROV_LEMMA1 = prove + (`!A p q. PROV1 (IMAGE gform A) x y + ==> ALLN (isaprove A) x ==> ALLN (isaprove A) y`, + REPEAT GEN_TAC THEN REWRITE_TAC[PROV1] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; ALLN] THEN + REWRITE_TAC[isaprove] THEN REPEAT CONJ_TAC THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[AXIOM_THM_STRONG; proves_RULES]; + ASM_MESON_TAC[IN_IMAGE; GFORM_INJ; proves_RULES; gform]; + ALL_TAC; + ASM_MESON_TAC[NUMBER_DENUMBER; + IN_IMAGE; GFORM_INJ; proves_RULES; gform]] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[gform; NPAIR_INJ; ARITH_EQ] THEN + MAP_EVERY X_GEN_TAC [`P:form`; `Q:form`] THEN + DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (STRIP_ASSUME_TAC o GSYM) MP_TAC) THEN + ASM_REWRITE_TAC[GFORM_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2] THEN + ASM_MESON_TAC[proves_RULES]);; + +let PROV_LEMMA2 = prove + (`!A p. A |-- p ==> !a. RTC (PROV1 (IMAGE gform A)) a (NPAIR (gform p) a)`, + GEN_TAC THEN MATCH_MP_TAC proves_INDUCT THEN REWRITE_TAC[gform] THEN + MESON_TAC[RTC_INC; RTC_TRANS; PROV1; IN_IMAGE; AXIOM_THM]);; + +let PROV_THM_STRONG = prove + (`!A n. PROV (IMAGE gform A) n <=> ?p. A |-- p /\ (gform p = n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[PROV] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[PROV_LEMMA2]] THEN + SUBGOAL_THEN + `!x y. RTC (PROV1 (IMAGE gform A)) x y + ==> ALLN (isaprove A) x ==> ALLN (isaprove A) y` + (fun th -> MESON_TAC[ALLN; isaprove; GFORM_INJ; th]) THEN + MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[PROV_LEMMA1] THEN MESON_TAC[]);; + +let PROV_THM = prove + (`!A p. PROV (IMAGE gform A) (gform p) <=> A |-- p`, + MESON_TAC[PROV_THM_STRONG; GFORM_INJ]);; + +(* ------------------------------------------------------------------------- *) +(* Now really objectify all that. *) +(* ------------------------------------------------------------------------- *) + +let arith_term1,ARITH_TERM1 = OBJECTIFY [] "arith_term1" TERM1;; + +let FV_TERM1 = prove + (`!s t. FV(arith_term1 s t) = (FVT s) UNION (FVT t)`, + FV_TAC[arith_term1; FVT_PAIR; FVT_NUMERAL]);; + +let arith_term,ARITH_TERM = OBJECTIFY_RTC ARITH_TERM1 "arith_term" TERM;; + +let FV_TERM = prove + (`!t. FV(arith_term t) = FVT t`, + FV_TAC[arith_term; FV_RTC; FV_TERM1; FVT_PAIR; FVT_NUMERAL]);; + +let arith_form1,ARITH_FORM1 = + OBJECTIFY [ARITH_TERM] "arith_form1" FORM1;; + +let FV_FORM1 = prove + (`!s t. FV(arith_form1 s t) = (FVT s) UNION (FVT t)`, + FV_TAC[arith_form1; FV_TERM; FVT_PAIR; FVT_NUMERAL]);; + +let arith_form,ARITH_FORM = OBJECTIFY_RTC ARITH_FORM1 "arith_form" FORM;; + +let FV_FORM = prove + (`!t. FV(arith_form t) = FVT t`, + FV_TAC[arith_form; FV_RTC; FV_FORM1; FVT_PAIR; FVT_NUMERAL]);; + +let arith_freeterm1,ARITH_FREETERM1 = + OBJECTIFY [] "arith_freeterm1" FREETERM1;; + +let FV_FREETERM1 = prove + (`!s t u. FV(arith_freeterm1 s t u) = (FVT s) UNION (FVT t) UNION (FVT u)`, + FV_TAC[arith_freeterm1; FVT_PAIR; FVT_NUMERAL]);; + +let arith_freeterm,ARITH_FREETERM = + OBJECTIFY_RTCP ARITH_FREETERM1 "arith_freeterm" FREETERM;; + +let FV_FREETERM = prove + (`!s t. FV(arith_freeterm s t) = (FVT s) UNION (FVT t)`, + FV_TAC[arith_freeterm; FV_RTCP; FV_FREETERM1; FVT_PAIR; FVT_NUMERAL]);; + +let arith_freeform1,ARITH_FREEFORM1 = + OBJECTIFY [ARITH_FREETERM; ARITH_FORM] "arith_freeform1" FREEFORM1;; + +let FV_FREEFORM1 = prove + (`!s t u. FV(arith_freeform1 s t u) = (FVT s) UNION (FVT t) UNION (FVT u)`, + FV_TAC[arith_freeform1; FV_FREETERM; FV_FORM; FVT_PAIR; FVT_NUMERAL]);; + +let arith_freeform,ARITH_FREEFORM = + OBJECTIFY_RTCP ARITH_FREEFORM1 "arith_freeform" FREEFORM;; + +let FV_FREEFORM = prove + (`!s t. FV(arith_freeform s t) = (FVT s) UNION (FVT t)`, + FV_TAC[arith_freeform; FV_RTCP; FV_FREEFORM1; FVT_PAIR; FVT_NUMERAL]);; + +let arith_axiom,ARITH_AXIOM = + OBJECTIFY [ARITH_FORM; ARITH_FREEFORM; ARITH_FREETERM; ARITH_TERM] + "arith_axiom" AXIOM;; + +let FV_AXIOM = prove + (`!t. FV(arith_axiom t) = FVT t`, + FV_TAC[arith_axiom; FV_FREETERM; FV_FREEFORM; FV_TERM; FV_FORM; + FVT_PAIR; FVT_NUMERAL]);; + +(* ------------------------------------------------------------------------- *) +(* Parametrization by A means it's easier to do these cases manually. *) +(* ------------------------------------------------------------------------- *) + +let arith_prov1,ARITH_PROV1 = + let PROV1' = REWRITE_RULE[IN] PROV1 in + OBJECTIFY [ASSUME `!v n. holds v (A n) <=> Ax (termval v n)`; ARITH_AXIOM] + "arith_prov1" PROV1';; + +let ARITH_PROV1 = prove + (`(!v t. holds v (A t) <=> Ax(termval v t)) + ==> (!v s t. + holds v (arith_prov1 A s t) <=> + PROV1 Ax (termval v s) (termval v t))`, + REWRITE_TAC[arith_prov1; holds; HOLDS_FORMSUBST] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[termval; valmod; o_THM; ARITH_EQ; ARITH_PAIR; + TERMVAL_NUMERAL; ARITH_AXIOM] THEN + REWRITE_TAC[PROV1; IN]);; + +let FV_PROV1 = prove + (`(!t. FV(A t) = FVT t) ==> !s t. FV(arith_prov1 A s t) = FVT(s) UNION FVT(t)`, + FV_TAC[arith_prov1; FV_AXIOM; FVT_NUMERAL; FVT_PAIR]);; + +let arith_prov = new_definition + `arith_prov A n = + formsubst ((0 |-> n) V) + (arith_rtc (arith_prov1 A) (numeral 0) + (arith_pair (V 0) (numeral 0)))`;; + +let ARITH_PROV = prove + (`!Ax A. (!v t. holds v (A t) <=> Ax(termval v t)) + ==> !v n. holds v (arith_prov A n) <=> PROV Ax (termval v n)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ARITH_PROV1) THEN + DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN + CONV_TAC(TOP_DEPTH_CONV ETA_CONV) THEN DISCH_TAC THEN + ASM_REWRITE_TAC[arith_prov; HOLDS_FORMSUBST] THEN + REWRITE_TAC[termval; valmod; o_DEF; TERMVAL_NUMERAL; ARITH_PAIR] THEN + REWRITE_TAC[PROV]);; + +let FV_PROV = prove + (`(!t. FV(A t) = FVT t) ==> !t. FV(arith_prov A t) = FVT t`, + FV_TAC[arith_prov; FV_PROV1; FV_RTC; FVT_NUMERAL; FVT_PAIR]);; + +(* ------------------------------------------------------------------------- *) +(* Our final conclusion. *) +(* ------------------------------------------------------------------------- *) + +let PROV_DEFINABLE = prove + (`!Ax. definable {gform p | p IN Ax} ==> definable {gform p | Ax |-- p}`, + GEN_TAC THEN REWRITE_TAC[definable; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `A:form` (X_CHOOSE_TAC `x:num`)) THEN + MP_TAC(SPECL [`IMAGE gform Ax`; `\t. formsubst ((x |-> t) V) A`] + ARITH_PROV) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[HOLDS_FORMSUBST] THEN + REWRITE_TAC[o_THM; VALMOD_BASIC; IMAGE; IN_ELIM_THM]; + ALL_TAC] THEN + REWRITE_TAC[PROV_THM_STRONG] THEN DISCH_TAC THEN + EXISTS_TAC `arith_prov (\t. formsubst ((x |-> t) V) A) (V x)` THEN + ASM_REWRITE_TAC[termval] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The crudest conclusion: truth undefinable, provability not, so: *) +(* ------------------------------------------------------------------------- *) + +let GODEL_CRUDE = prove + (`!Ax. definable {gform p | p IN Ax} ==> ?p. ~(true p <=> Ax |-- p)`, + REPEAT STRIP_TAC THEN MP_TAC TARSKI_THEOREM THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PROV_DEFINABLE) THEN + MATCH_MP_TAC(TAUT `(~c ==> (a <=> b)) ==> a ==> ~b ==> c`) THEN + SIMP_TAC[NOT_EXISTS_THM]);; diff --git a/Arithmetic/definability.ml b/Arithmetic/definability.ml new file mode 100644 index 0000000..03a7f07 --- /dev/null +++ b/Arithmetic/definability.ml @@ -0,0 +1,644 @@ +(* ========================================================================= *) +(* Definability in arithmetic of important notions. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Pairing operation. *) +(* ------------------------------------------------------------------------- *) + +let NPAIR = new_definition + `NPAIR x y = (x + y) EXP 2 + x + 1`;; + +let NPAIR_NONZERO = prove + (`!x y. ~(NPAIR x y = 0)`, + REWRITE_TAC[NPAIR; ADD_EQ_0; ARITH]);; + +let NPAIR_INJ_LEMMA = prove + (`x1 + y1 < x2 + y2 ==> NPAIR x1 y1 < NPAIR x2 y2`, + STRIP_TAC THEN REWRITE_TAC[NPAIR; EXP_2] THEN + REWRITE_TAC[ARITH_RULE `x + y + 1 < u + v + 1 <=> x + y < u + v`] THEN + MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `SUC(x1 + y1) * SUC(x1 + y1)` THEN CONJ_TAC THENL + [ARITH_TAC; ASM_MESON_TAC[LE_TRANS; LE_ADD; LE_MULT2; LE_SUC_LT]]);; + +let NPAIR_INJ = prove + (`(NPAIR x y = NPAIR x' y') <=> (x = x') /\ (y = y')`, + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `x' + y' = x + y` ASSUME_TAC THENL + [ASM_MESON_TAC[LT_CASES; NPAIR_INJ_LEMMA; LT_REFL]; + UNDISCH_TAC `NPAIR x y = NPAIR x' y'` THEN + UNDISCH_TAC `x' + y' = x + y` THEN + SIMP_TAC[NPAIR; EXP_2] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Decreasingness. *) +(* ------------------------------------------------------------------------- *) + +let NPAIR_LT = prove + (`!x y. x < NPAIR x y /\ y < NPAIR x y`, + REPEAT GEN_TAC THEN REWRITE_TAC[NPAIR] THEN + REWRITE_TAC[ARITH_RULE `x < a + x + 1`] THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `(x + y) + x + 1` THEN + REWRITE_TAC[LE_ADD_RCANCEL; EXP_2; LE_SQUARE_REFL] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary concepts needed. NB: these are Delta so can be negated freely. *) +(* ------------------------------------------------------------------------- *) + +let primepow = new_definition + `primepow p x <=> prime(p) /\ ?n. x = p EXP n`;; + +let divides_DELTA = prove + (`m divides n <=> ?x. x <= n /\ n = m * x`, + REWRITE_TAC[divides] THEN ASM_CASES_TAC `m = 0` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN + AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `~(m = 0) ==> 1 <= m`)) THEN + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; + RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + MESON_TAC[]);; + +let prime_DELTA = prove + (`prime(p) <=> 2 <= p /\ !n. n < p ==> n divides p ==> n = 1`, + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[ARITH; PRIME_0] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[ARITH; PRIME_1] THEN EQ_TAC THENL + [ASM_MESON_TAC[prime; LT_REFL; PRIME_GE_2]; + ASM_MESON_TAC[prime; DIVIDES_LE; LE_LT]]);; + +let primepow_DELTA = prove + (`primepow p x <=> + prime(p) /\ ~(x = 0) /\ + !z. z <= x ==> z divides x ==> z = 1 \/ p divides z`, + REWRITE_TAC[primepow; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN + ASM_CASES_TAC `prime(p)` THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + ASM_REWRITE_TAC[EXP_EQ_0] THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `z:num` o MATCH_MP PRIME_COPRIME) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `p divides z` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP COPRIME_EXP) THEN + ASM_MESON_TAC[COPRIME; DIVIDES_REFL]; + SPEC_TAC(`x:num`,`x:num`) THEN MATCH_MP_TAC num_WF THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = 1` THENL + [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[EXP]; ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN + STRIP_TAC THEN + UNDISCH_TAC `!z. z <= x ==> z divides x /\ ~(z = 1) ==> p divides z` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `q = 1` THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `q <= x` ASSUME_TAC THENL + [ASM_MESON_TAC[DIVIDES_LE]; ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `p divides x` MP_TAC THENL + [ASM_MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN DISCH_THEN(X_CHOOSE_TAC `y:num`) THEN + SUBGOAL_THEN `y < x` (ANTE_RES_THEN MP_TAC) THENL + [MATCH_MP_TAC PRIME_FACTOR_LT THEN + EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `y = 0` THENL + [UNDISCH_TAC `x = p * y` THEN ASM_REWRITE_TAC[MULT_CLAUSES]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!z. z <= y ==> z divides y /\ ~(z = 1) ==> p divides z` + (fun th -> REWRITE_TAC[th]) THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE + [IMP_IMP]) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `y:num` THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `y = 1 * y`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_REWRITE_TAC[GSYM NOT_LT] THEN + REWRITE_TAC[num_CONV `1`; LT; DE_MORGAN_THM] THEN + ASM_MESON_TAC[PRIME_0; PRIME_1]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVIDES_LMUL THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[EXP]]]);; + +(* ------------------------------------------------------------------------- *) +(* Sigma-representability of reflexive transitive closure. *) +(* ------------------------------------------------------------------------- *) + +let PSEQ = new_recursive_definition num_RECURSION + `(PSEQ p f m 0 = 0) /\ + (PSEQ p f m (SUC n) = f m + p * PSEQ p f (SUC m) n)`;; + +let PSEQ_SPLIT = prove + (`!f p n m r. + PSEQ p f m (n + r) = PSEQ p f m n + p EXP n * PSEQ p f (m + n) r`, + GEN_TAC THEN GEN_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP; MULT_CLAUSES; PSEQ] THEN + ASM_REWRITE_TAC[GSYM ADD_ASSOC; EQ_ADD_LCANCEL] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_AC; ADD_CLAUSES]);; + +let PSEQ_1 = prove + (`PSEQ p f m 1 = f m`, + REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; MULT_CLAUSES; PSEQ]);; + +let PSEQ_BOUND = prove + (`!n. ~(p = 0) /\ (!i. i < n ==> f i < p) ==> PSEQ p f 0 n < p EXP n`, + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN + INDUCT_TAC THENL [REWRITE_TAC[PSEQ; EXP; ARITH]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`f:num->num`; `p:num`; `n:num`; `0`; `1`] + PSEQ_SPLIT) THEN + SIMP_TAC[ADD1; ADD_CLAUSES] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `p EXP n + p EXP n * PSEQ p f n 1` THEN + ASM_SIMP_TAC[LT_ADD_RCANCEL; ARITH_RULE `i < n ==> i < SUC n`] THEN + REWRITE_TAC[ARITH_RULE `p + p * q = p * (q + 1)`] THEN + ASM_REWRITE_TAC[EXP_ADD; LE_MULT_LCANCEL; EXP_EQ_0] THEN + MATCH_MP_TAC(ARITH_RULE `x < p ==> x + 1 <= p`) THEN + ASM_SIMP_TAC[EXP_1; PSEQ_1; LT]);; + +let RELPOW_LEMMA_1 = prove + (`(f 0 = x) /\ + (f n = y) /\ + (!i. i < n ==> R (f i) (f(SUC i))) + ==> ?p. (?i. i <= n /\ p <= SUC(FACT(f i))) /\ + prime p /\ + (?m. m < p EXP (SUC n) /\ + x < p /\ y < p /\ + (?qx. m = x + p * qx) /\ + (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\ + !q. q < p EXP n + ==> primepow p q + ==> ?r. r < q /\ + ?a. a < p /\ + ?b. b < p /\ + R a b /\ + ?s. s <= m /\ + (m = + r + q * (a + p * (b + p * s))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?j. j <= n /\ !i. i <= n ==> f i <= f j` MP_TAC THENL + [SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + INDUCT_TAC THENL + [SIMP_TAC[LE] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + DISJ_CASES_TAC(ARITH_RULE `f(SUC n) <= f(j) \/ f(j) <= f(SUC n)`) THENL + [EXISTS_TAC `j:num` THEN + ASM_SIMP_TAC[ARITH_RULE `j <= n ==> j <= SUC n`] THEN + REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; + EXISTS_TAC `SUC n` THEN REWRITE_TAC[LE_REFL] THEN + REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LE_REFL] THEN ASM_MESON_TAC[LE_TRANS]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `ibig:num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `(f:num->num) ibig` EUCLID_BOUND) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `p:num` THEN CONJ_TAC THENL + [EXISTS_TAC `ibig:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!i. i <= n ==> f i < p` ASSUME_TAC THENL + [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN + EXISTS_TAC `PSEQ p f 0 (SUC n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC PSEQ_BOUND THEN ASM_SIMP_TAC[LT_SUC_LE]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[LE_0]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[PSEQ] THEN MESON_TAC[]; + MP_TAC(SPECL [`f:num->num`; `p:num`; `n:num`; `0`; `1`] PSEQ_SPLIT) THEN + ASM_SIMP_TAC[ADD1; ADD_CLAUSES] THEN + DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f 0 n` THEN + ASM_SIMP_TAC[PSEQ_BOUND; PSEQ_1; LT_IMP_LE]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN + ASM_SIMP_TAC[primepow; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN X_GEN_TAC `i:num` THEN DISCH_THEN(K ALL_TAC) THEN + ASM_REWRITE_TAC[LT_EXP] THEN STRIP_TAC THEN + MP_TAC(SPECL [`f:num->num`; `p:num`; `i:num`; `0`; `SUC n - i`] + PSEQ_SPLIT) THEN + ASM_SIMP_TAC[ARITH_RULE `i < n ==> (i + SUC n - i = SUC n)`] THEN + DISCH_THEN(K ALL_TAC) THEN + EXISTS_TAC `PSEQ p f 0 i` THEN REWRITE_TAC[EQ_ADD_LCANCEL] THEN + ASM_REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ADD_CLAUSES] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[PSEQ_BOUND; LT_TRANS; LT_IMP_LE]; ALL_TAC] THEN + MP_TAC(SPECL [`f:num->num`; `p:num`; `1`; `i:num`; `n - i`] + PSEQ_SPLIT) THEN + ASM_SIMP_TAC[ARITH_RULE `i < n ==> (1 + n - i = SUC n - i)`] THEN + DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f i 1` THEN + ASM_REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL; EXP_1] THEN + ASM_SIMP_TAC[PSEQ_1; LT_IMP_LE] THEN + MP_TAC(SPECL [`f:num->num`; `p:num`; `1`; `i + 1`; `n - i - 1`] + PSEQ_SPLIT) THEN + ASM_SIMP_TAC[ARITH_RULE `i < n ==> (1 + n - i - 1 = n - i)`] THEN + DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `PSEQ p f (i + 1) 1` THEN + ASM_REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL; EXP_1] THEN + ASM_SIMP_TAC[PSEQ_1; ARITH_RULE `i < n ==> i + 1 <= n`] THEN + ASM_SIMP_TAC[GSYM ADD1] THEN REWRITE_TAC[ADD1] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC; ADD_ASSOC] THEN + MATCH_MP_TAC(ARITH_RULE `1 * a <= c ==> a <= b + c`) THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; EXP_EQ_0]);; + +let RELPOW_LEMMA_2 = prove + (`prime p /\ x < p /\ y < p /\ + (?qx. m = x + p * qx) /\ + (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\ + (!q. q < p EXP n + ==> primepow p q + ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\ + r < q /\ a < p /\ b < p /\ R a b) + ==> RELPOW n R x y`, + STRIP_TAC THEN REWRITE_TAC[RELPOW_SEQUENCE] THEN + EXISTS_TAC `\i. (m DIV (p EXP i)) MOD p` THEN + SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + REWRITE_TAC[EXP; DIV_1] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `qx:num` THEN + ASM_REWRITE_TAC[ADD_AC; MULT_AC]; + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[ASSUME `y < p`; MULT_CLAUSES; ADD_CLAUSES] THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `ry:num` THEN + REWRITE_TAC[ASSUME `m = ry + p EXP n * y`] THEN + ASM_REWRITE_TAC[ADD_AC; MULT_AC]; + ALL_TAC] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p EXP i`) THEN + ASM_SIMP_TAC[LT_EXP; PRIME_GE_2] THEN + ASM_REWRITE_TAC[primepow] THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(R:num->num->bool) a b` THEN + MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN BINOP_TAC THENL + [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `b + p * s` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_AC; MULT_AC]; + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `s:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `r + a * p EXP i` THEN + CONJ_TAC THENL + [REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[ADD_AC; MULT_AC]; ALL_TAC] THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `p EXP i + a * p EXP i` THEN + ASM_REWRITE_TAC[LT_ADD_RCANCEL] THEN + REWRITE_TAC[ARITH_RULE `p + q * p = (q + 1) * p`] THEN + ASM_REWRITE_TAC[LE_MULT_RCANCEL; EXP_EQ_0] THEN + UNDISCH_TAC `a < p` THEN ARITH_TAC]);; + +let RELPOW_LEMMA = prove + (`RELPOW n R x y <=> + ?m p. prime p /\ x < p /\ y < p /\ + (?qx. m = x + p * qx) /\ + (?ry. ry < p EXP n /\ (m = ry + p EXP n * y)) /\ + !q. q < p EXP n + ==> primepow p q + ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\ + r < q /\ a < p /\ b < p /\ R a b`, + EQ_TAC THENL + [ALL_TAC; REWRITE_TAC[RELPOW_LEMMA_2; LEFT_IMP_EXISTS_THM]] THEN + REWRITE_TAC[RELPOW_SEQUENCE] THEN + DISCH_THEN(CHOOSE_THEN(MP_TAC o GEN_ALL o MATCH_MP RELPOW_LEMMA_1)) THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[] THEN MESON_TAC[]);; + +let RTC_SIGMA = prove + (`RTC R x y <=> + ?m p Q. primepow p Q /\ x < p /\ y < p /\ + (?s. m = x + p * s) /\ + (?r. r < Q /\ (m = r + Q * y)) /\ + !q. q < Q + ==> primepow p q + ==> ?r a b s. (m = r + q * (a + p * (b + p * s))) /\ + r < q /\ a < p /\ b < p /\ R a b`, + REWRITE_TAC[RTC_RELPOW] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + REWRITE_TAC[RELPOW_LEMMA] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_TAC THEN EXISTS_TAC `p EXP n` THEN ASM_REWRITE_TAC[primepow] THEN + MESON_TAC[]; + REWRITE_TAC[primepow] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[GSYM primepow] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 3 BINDER_CONV) + [LEFT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV) + [SWAP_EXISTS_THM] THEN + REWRITE_TAC[UNWIND_THM2] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM RELPOW_LEMMA]]);; + +(* ------------------------------------------------------------------------- *) +(* Partially automate actual definability in object language. *) +(* ------------------------------------------------------------------------- *) + +let arith_pair = new_definition + `arith_pair s t = (s ++ t) ** (s ++ t) ++ s ++ Suc Z`;; + +let ARITH_PAIR = prove + (`!s t v. termval v (arith_pair s t) = NPAIR (termval v s) (termval v t)`, + REWRITE_TAC[termval; arith_pair; NPAIR; EXP_2; ARITH_SUC]);; + +let FVT_PAIR = prove + (`FVT(arith_pair s t) = FVT(s) UNION FVT(t)`, + REWRITE_TAC[arith_pair; FVT] THEN SET_TAC[]);; + +let OBJECTIFY = + let is_add = is_binop `(+):num->num->num` + and is_mul = is_binop `(*):num->num->num` + and is_le = is_binop `(<=):num->num->bool` + and is_lt = is_binop `(<):num->num->bool` + and zero_tm = `0` + and suc_tm = `SUC` + and osuc_tm = `Suc` + and oz_tm = `Z` + and ov_tm = `V` + and oadd_tm = `(++)` + and omul_tm = `(**)` + and oeq_tm = `(===)` + and ole_tm = `(<<=)` + and olt_tm = `(<<)` + and oiff_tm = `(<->)` + and oimp_tm = `(-->)` + and oand_tm = `(&&)` + and oor_tm = `(||)` + and onot_tm = `Not` + and oall_tm = `!!` + and oex_tm = `??` + and numeral_tm = `numeral` + and assign_tm = `(|->):num->term->(num->term)->(num->term)` + and term_ty = `:term` + and form_ty = `:form` + and num_ty = `:num` + and formsubst_tm = `formsubst` + and holdsv_tm = `holds v` + and v_tm = `v:num->num` in + let objectify1 fn op env tm = mk_comb(op,fn env (rand tm)) in + let objectify2 fn op env tm = + mk_comb(mk_comb(op,fn env (lhand tm)),fn env (rand tm)) in + fun defs -> + let defs' = [TERMVAL_NUMERAL; ARITH_PAIR] @ defs in + let rec objectify_term env tm = + if is_var tm then mk_comb(ov_tm,apply env tm) + else if tm = zero_tm then oz_tm + else if is_numeral tm then mk_comb(numeral_tm,tm) + else if is_add tm then objectify2 objectify_term oadd_tm env tm + else if is_mul tm then objectify2 objectify_term omul_tm env tm + else if is_comb tm & rator tm = suc_tm + then objectify1 objectify_term osuc_tm env tm + else + let f,args = strip_comb tm in + let args' = map (objectify_term env) args in + try let dth = find + (fun th -> fst(strip_comb(rand(snd(strip_forall(concl th))))) = f) + defs' in + let l,r = dest_eq(snd(strip_forall(concl dth))) in + list_mk_comb(fst(strip_comb(rand l)),args') + with Failure _ -> + let ty = itlist (mk_fun_ty o type_of) args' form_ty in + let v = mk_var(fst(dest_var f),ty) in + list_mk_comb(v,args') in + let rec objectify_formula env fm = + if is_forall fm then + let x,bod = dest_forall fm in + let n = mk_small_numeral + (itlist (max o dest_small_numeral) (ran env) 0 + 1) in + mk_comb(mk_comb(oall_tm,n),objectify_formula ((x |-> n) env) bod) + else if is_exists fm then + let x,bod = dest_exists fm in + let n = mk_small_numeral + (itlist (max o dest_small_numeral) (ran env) 0 + 1) in + mk_comb(mk_comb(oex_tm,n),objectify_formula ((x |-> n) env) bod) + else if is_iff fm then objectify2 objectify_formula oiff_tm env fm + else if is_imp fm then objectify2 objectify_formula oimp_tm env fm + else if is_conj fm then objectify2 objectify_formula oand_tm env fm + else if is_disj fm then objectify2 objectify_formula oor_tm env fm + else if is_neg fm then objectify1 objectify_formula onot_tm env fm + else if is_le fm then objectify2 objectify_term ole_tm env fm + else if is_lt fm then objectify2 objectify_term olt_tm env fm + else if is_eq fm then objectify2 objectify_term oeq_tm env fm + else objectify_term env fm in + fun nam th -> + let ptm,tm = dest_eq(snd(strip_forall(concl th))) in + let vs = filter (fun v -> type_of v = num_ty) (snd(strip_comb ptm)) in + let ns = 1--(length vs) in + let env = itlist2 (fun v n -> v |-> mk_small_numeral n) vs ns undefined in + let otm = objectify_formula env tm in + let vs' = map (fun v -> mk_var(fst(dest_var v),term_ty)) vs in + let stm = itlist2 + (fun v n a -> mk_comb(mk_comb(mk_comb(assign_tm,mk_small_numeral + n),v),a)) + vs' ns ov_tm in + let rside = mk_comb(mk_comb(formsubst_tm,stm),otm) in + let vs'' = subtract (frees rside) vs' @ vs' in + let lty = itlist (mk_fun_ty o type_of) vs'' (type_of rside) in + let lside = list_mk_comb(mk_var(nam,lty),vs'') in + let def = mk_eq(lside,rside) in + let dth = new_definition def in + let clside = lhs(snd(strip_forall(concl dth))) in + let etm = mk_comb(holdsv_tm,clside) in + let thm = + (REWRITE_CONV ([dth; holds; HOLDS_FORMSUBST] @ defs') THENC + REWRITE_CONV [termval; ARITH_EQ; o_THM; valmod] THENC + GEN_REWRITE_CONV I [GSYM th]) etm in + dth,DISCH_ALL (GENL (v_tm::vs') thm);; + +(* ------------------------------------------------------------------------- *) +(* Some sort of common tactic for free variables. *) +(* ------------------------------------------------------------------------- *) + +let FV_TAC ths = + let ths' = ths @ + [FV; FORMSUBST_FV; FVT; TERMSUBST_FVT; IN_ELIM_THM; + NOT_IN_EMPTY; IN_UNION; IN_DELETE; IN_SING] + and tac = + REWRITE_TAC[DISJ_ACI; TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC; UNWIND_THM2; ARITH_EQ] THEN + REWRITE_TAC[valmod; ARITH_EQ; FVT] THEN REWRITE_TAC[DISJ_ACI] in + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + ASM_REWRITE_TAC ths' THEN tac THEN ASM_SIMP_TAC ths' THEN tac;; + +(* ------------------------------------------------------------------------- *) +(* So do the formula-level stuff (more) automatically. *) +(* ------------------------------------------------------------------------- *) + +let arith_divides,ARITH_DIVIDES = + OBJECTIFY [] "arith_divides" divides_DELTA;; + +let FV_DIVIDES = prove + (`!s t. FV(arith_divides s t) = FVT(s) UNION FVT(t)`, + FV_TAC[arith_divides]);; + +let arith_prime,ARITH_PRIME = + OBJECTIFY [ARITH_DIVIDES] "arith_prime" prime_DELTA;; + +let FV_PRIME = prove + (`!t. FV(arith_prime t) = FVT(t)`, + FV_TAC[arith_prime; FVT_NUMERAL; FV_DIVIDES]);; + +let arith_primepow,ARITH_PRIMEPOW = + OBJECTIFY [ARITH_PRIME; ARITH_DIVIDES] "arith_primepow" primepow_DELTA;; + +let FV_PRIMEPOW = prove + (`!s t. FV(arith_primepow s t) = FVT(s) UNION FVT(t)`, + FV_TAC[arith_primepow; FVT_NUMERAL; FV_DIVIDES; FV_PRIME]);; + +let arith_rtc,ARITH_RTC = + OBJECTIFY + [ARITH_PRIMEPOW; + ASSUME `!v s t. holds v (R s t) <=> r (termval v s) (termval v t)`] + "arith_rtc" RTC_SIGMA;; + +let FV_RTC = prove + (`!R. (!s t. FV(R s t) = FVT(s) UNION FVT(t)) + ==> !s t. FV(arith_rtc R s t) = FVT(s) UNION FVT(t)`, + FV_TAC[arith_rtc; FV_PRIMEPOW]);; + +(* ------------------------------------------------------------------------- *) +(* Automate RTC constructions, including parametrized ones. *) +(* ------------------------------------------------------------------------- *) + +let OBJECTIFY_RTC = + let pth = prove + (`(!v x y. holds v (f x y) <=> f' (termval v x) (termval v y)) + ==> !g. (!n. g n = formsubst ((0 |-> n) V) + (arith_rtc f (numeral 0) + (arith_pair (V 0) (numeral 0)))) + ==> !v n. holds v (g n) <=> RTC f' 0 (NPAIR (termval v n) 0)`, + DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN SIMP_TAC[HOLDS_FORMSUBST] THEN + REWRITE_TAC[termval; o_DEF; ARITH_EQ; valmod; + ARITH_PAIR; TERMVAL_NUMERAL]) in + fun def nam th -> + let th1 = MATCH_MP pth def in + let v = fst(dest_forall(concl th1)) in + let th2 = SPEC (mk_var(nam,type_of v)) th1 in + let dth = new_definition (fst(dest_imp(concl th2))) in + dth,ONCE_REWRITE_RULE[GSYM th] (MATCH_MP th2 dth);; + +let RTCP = new_definition + `RTCP R m x y <=> RTC (R m) x y`;; + +let RTCP_SIGMA = REWRITE_RULE[GSYM RTCP] + (INST [`(R:num->num->num->bool) m`,`R:num->num->bool`] RTC_SIGMA);; + +let arith_rtcp,ARITH_RTCP = + OBJECTIFY + [ARITH_PRIMEPOW; + ASSUME `!v m s t. holds v (R m s t) <=> + r (termval v m) (termval v s) (termval v t)`] + "arith_rtcp" RTCP_SIGMA;; + +let ARITH_RTC_PARAMETRIZED = REWRITE_RULE[RTCP] ARITH_RTCP;; + +let FV_RTCP = prove + (`!R. (!s t u. FV(R s t u) = FVT(s) UNION FVT(t) UNION FVT(u)) + ==> !s t u. FV(arith_rtcp R s t u) = FVT(s) UNION FVT(t) UNION FVT(u)`, + FV_TAC[arith_rtcp; FV_PRIMEPOW]);; + +let OBJECTIFY_RTCP = + let pth = prove + (`(!v m x y. holds v (f m x y) <=> + f' (termval v m) (termval v x) (termval v y)) + ==> !g. (!m n. g m n = formsubst ((1 |-> m) ((0 |-> n) V)) + (arith_rtcp f (V 1) (numeral 0) + (arith_pair (V 0) (numeral 0)))) + ==> !v m n. holds v (g m n) <=> + RTC (f' (termval v m)) 0 (NPAIR (termval v n) 0)`, + DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC_PARAMETRIZED) THEN + SIMP_TAC[HOLDS_FORMSUBST] THEN + REWRITE_TAC[termval; o_DEF; ARITH_EQ; valmod; + ARITH_PAIR; TERMVAL_NUMERAL]) in + fun def nam th -> + let th1 = MATCH_MP pth def in + let v = fst(dest_forall(concl th1)) in + let th2 = SPEC (mk_var(nam,type_of v)) th1 in + let dth = new_definition (fst(dest_imp(concl th2))) in + dth,ONCE_REWRITE_RULE[GSYM th] (MATCH_MP th2 dth);; + +(* ------------------------------------------------------------------------- *) +(* Generic result about primitive recursion. *) +(* ------------------------------------------------------------------------- *) + +let PRIMREC_SIGMA = prove + (`(fn 0 = e) /\ + (!n. fn (SUC n) = f (fn n) n) + ==> !x y. RTC (\x y. ?n r. (x = NPAIR n r) /\ (y = NPAIR (SUC n) (f r n))) + (NPAIR 0 e) (NPAIR x y) <=> + (fn(x) = y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN + ONCE_REWRITE_TAC[RTC_CASES_L] THEN ASM_REWRITE_TAC[NPAIR_INJ; NOT_SUC] THEN + REWRITE_TAC[SUC_INJ; RIGHT_AND_EXISTS_THM] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + ASM_REWRITE_TAC[UNWIND_THM2] THEN ASM_MESON_TAC[]);; + +let arith_primrecstep = new_definition + `arith_primrecstep R s t = + (formsubst ((0 |-> s) ((1 |-> t) V)) + (?? 2 (?? 3 (?? 4 + (V 0 === arith_pair (V 2) (V 3) && + V 1 === arith_pair (Suc(V 2)) (V 4) && + R (V 3) (V 2) (V 4))))))`;; + +let ARITH_PRIMRECSTEP = prove + (`(!v x y z. holds v (R x y z) <=> + (f (termval v x) (termval v y) = termval v z)) + ==> !v s t. holds v (arith_primrecstep R s t) <=> + ?n r. (termval v s = NPAIR n r) /\ + (termval v t = NPAIR (SUC n) (f r n))`, + STRIP_TAC THEN + ASM_REWRITE_TAC[arith_primrecstep; holds; HOLDS_FORMSUBST] THEN + ASM_REWRITE_TAC[termval; valmod; o_DEF; ARITH_EQ; ARITH_PAIR] THEN + MESON_TAC[]);; + +let FV_PRIMRECSTEP = prove + (`!R. (!s t u. FV(R s t u) SUBSET (FVT(s) UNION FVT(t) UNION FVT(u))) + ==> !s t. FV(arith_primrecstep R s t) = FVT(s) UNION FVT(t)`, + REWRITE_TAC[SUBSET; IN_UNION] THEN FV_TAC[arith_primrecstep; FVT_PAIR] THEN + GEN_TAC THEN MATCH_MP_TAC(TAUT `~a ==> (a \/ b <=> b)`) THEN + DISCH_THEN(CHOOSE_THEN + (CONJUNCTS_THEN2(ANTE_RES_THEN MP_TAC) ASSUME_TAC)) THEN + ASM_REWRITE_TAC[FVT; IN_SING]);; + +let arith_primrec = new_definition + `arith_primrec R c s t = + arith_rtc (arith_primrecstep R) + (arith_pair Z c) (arith_pair s t)`;; + +let ARITH_PRIMREC = prove + (`!fn e f R c. + (fn 0 = e) /\ (!n. fn (SUC n) = f (fn n) n) /\ + (!v. termval v c = e) /\ + (!v x y z. holds v (R x y z) <=> + (f (termval v x) (termval v y) = termval v z)) + ==> !v s t. holds v (arith_primrec R c s t) <=> + (fn(termval v s) = termval v t)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ARITH_PRIMRECSTEP) THEN + DISCH_THEN(MP_TAC o MATCH_MP ARITH_RTC) THEN + CONV_TAC(TOP_DEPTH_CONV ETA_CONV) THEN + SIMP_TAC[arith_primrec; ARITH_PAIR; termval] THEN + ASM_SIMP_TAC[PRIMREC_SIGMA]);; + +let FV_PRIMREC = prove + (`!R c. (FVT c = {}) /\ + (!s t u. FV(R s t u) SUBSET (FVT(s) UNION FVT(t) UNION FVT(u))) + ==> !s t. FV(arith_primrec R c s t) = FVT(s) UNION FVT(t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[arith_primrec] THEN + ASM_SIMP_TAC[FV_RTC; FVT_PAIR; FV_PRIMRECSTEP; + UNION_EMPTY; UNION_ACI; FVT]);; diff --git a/Arithmetic/derived.ml b/Arithmetic/derived.ml new file mode 100644 index 0000000..616c232 --- /dev/null +++ b/Arithmetic/derived.ml @@ -0,0 +1,980 @@ +(* ========================================================================= *) +(* Derived properties of provability. *) +(* ========================================================================= *) + +let negativef = new_definition + `negativef p = ?q. p = q --> False`;; + +let negatef = new_definition + `negatef p = if negativef p then @q. p = q --> False else p --> False`;; + +(* ------------------------------------------------------------------------- *) +(* The primitive basis, separated into its named components. *) +(* ------------------------------------------------------------------------- *) + +let axiom_addimp = prove + (`!A p q. A |-- p --> (q --> p)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_distribimp = prove + (`!A p q r. A |-- (p --> q --> r) --> (p --> q) --> (p --> r)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_doubleneg = prove + (`!A p. A |-- ((p --> False) --> False) --> p`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_allimp = prove + (`!A x p q. A |-- (!!x (p --> q)) --> (!!x p) --> (!!x q)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_impall = prove + (`!A x p. ~(x IN FV p) ==> A |-- p --> !!x p`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_existseq = prove + (`!A x t. ~(x IN FVT t) ==> A |-- ??x (V x === t)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_eqrefl = prove + (`!A t. A |-- t === t`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_funcong = prove + (`(!A s t. A |-- s === t --> Suc s === Suc t) /\ + (!A s t u v. A |-- s === t --> u === v --> s ++ u === t ++ v) /\ + (!A s t u v. A |-- s === t --> u === v --> s ** u === t ** v)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_predcong = prove + (`(!A s t u v. A |-- s === t --> u === v --> s === u --> t === v) /\ + (!A s t u v. A |-- s === t --> u === v --> s << u --> t << v) /\ + (!A s t u v. A |-- s === t --> u === v --> s <<= u --> t <<= v)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_iffimp1 = prove + (`!A p q. A |-- (p <-> q) --> p --> q`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_iffimp2 = prove + (`!A p q. A |-- (p <-> q) --> q --> p`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_impiff = prove + (`!A p q. A |-- (p --> q) --> (q --> p) --> (p <-> q)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_true = prove + (`A |-- True <-> (False --> False)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_not = prove + (`!A p. A |-- Not p <-> (p --> False)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_and = prove + (`!A p q. A |-- (p && q) <-> (p --> q --> False) --> False`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_or = prove + (`!A p q. A |-- (p || q) <-> Not(Not p && Not q)`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let axiom_exists = prove + (`!A x p. A |-- (??x p) <-> Not(!!x (Not p))`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +let assume = prove + (`!A p. p IN A ==> A |-- p`, + MESON_TAC[proves_RULES]);; + +let modusponens = prove + (`!A p. A |-- (p --> q) /\ A |-- p ==> A |-- q`, + MESON_TAC[proves_RULES]);; + +let gen = prove + (`!A p x. A |-- p ==> A |-- !!x p`, + MESON_TAC[proves_RULES]);; + +(* ------------------------------------------------------------------------- *) +(* Some purely propositional schemas and derived rules. *) +(* ------------------------------------------------------------------------- *) + +let iff_imp1 = prove + (`!A p q. A |-- p <-> q ==> A |-- p --> q`, + MESON_TAC[modusponens; axiom_iffimp1]);; + +let iff_imp2 = prove + (`!A p q. A |-- p <-> q ==> A |-- q --> p`, + MESON_TAC[modusponens; axiom_iffimp2]);; + +let imp_antisym = prove + (`!A p q. A |-- p --> q /\ A |-- q --> p ==> A |-- p <-> q`, + MESON_TAC[modusponens; axiom_impiff]);; + +let add_assum = prove + (`!A p q. A |-- q ==> A |-- p --> q`, + MESON_TAC[modusponens; axiom_addimp]);; + +let imp_refl = prove + (`!A p. A |-- p --> p`, + MESON_TAC[modusponens; axiom_distribimp; axiom_addimp]);; + +let imp_add_assum = prove + (`!A p q r. A |-- q --> r ==> A |-- (p --> q) --> (p --> r)`, + MESON_TAC[modusponens; axiom_distribimp; add_assum]);; + +let imp_unduplicate = prove + (`!A p q. A |-- p --> p --> q ==> A |-- p --> q`, + MESON_TAC[modusponens; axiom_distribimp; imp_refl]);; + +let imp_trans = prove + (`!A p q. A |-- p --> q /\ A |-- q --> r ==> A |-- p --> r`, + MESON_TAC[modusponens; imp_add_assum]);; + +let imp_swap = prove + (`!A p q r. A |-- p --> q --> r ==> A |-- q --> p --> r`, + MESON_TAC[imp_trans; axiom_addimp; modusponens; axiom_distribimp]);; + +let imp_trans_chain_2 = prove + (`!A p q1 q2 r. A |-- p --> q1 /\ A |-- p --> q2 /\ A |-- q1 --> q2 --> r + ==> A |-- p --> r`, + ASM_MESON_TAC[imp_trans; imp_swap; imp_unduplicate]);; + +let imp_trans_th = prove + (`!A p q r. A |-- (q --> r) --> (p --> q) --> (p --> r)`, + MESON_TAC[imp_trans; axiom_addimp; axiom_distribimp]);; + +let imp_add_concl = prove + (`!A p q r. A |-- p --> q ==> A |-- (q --> r) --> (p --> r)`, + MESON_TAC[modusponens; imp_swap; imp_trans_th]);; + +let imp_trans2 = prove + (`!A p q r s. A |-- p --> q --> r /\ A |-- r --> s ==> A |-- p --> q --> s`, + MESON_TAC[imp_add_assum; modusponens; imp_trans_th]);; + +let imp_swap_th = prove + (`!A p q r. A |-- (p --> q --> r) --> (q --> p --> r)`, + MESON_TAC[imp_trans; axiom_distribimp; imp_add_concl; axiom_addimp]);; + +let contrapos = prove + (`!A p q. A |-- p --> q ==> A |-- Not q --> Not p`, + MESON_TAC[imp_trans; iff_imp1; axiom_not; imp_add_concl; iff_imp2]);; + +let imp_truefalse = prove + (`!p q. A |-- (q --> False) --> p --> (p --> q) --> False`, + MESON_TAC[imp_trans; imp_trans_th; imp_swap_th]);; + +let imp_insert = prove + (`!A p q r. A |-- p --> r ==> A |-- p --> q --> r`, + MESON_TAC[imp_trans; axiom_addimp]);; + +let imp_mono_th = prove + (`A |-- (p' --> p) --> (q --> q') --> (p --> q) --> (p' --> q')`, + MESON_TAC[imp_trans; imp_swap; imp_trans_th]);; + +let ex_falso = prove + (`!A p. A |-- False --> p`, + MESON_TAC[imp_trans; axiom_addimp; axiom_doubleneg]);; + +let imp_contr = prove + (`!A p q. A |-- (p --> False) --> (p --> r)`, + MESON_TAC[imp_add_assum; ex_falso]);; + +let imp_contrf = prove + (`!A p r. A |-- p --> negatef p --> r`, + REPEAT GEN_TAC THEN REWRITE_TAC[negatef; negativef] THEN + COND_CASES_TAC THEN POP_ASSUM STRIP_ASSUME_TAC THEN + ASM_REWRITE_TAC[form_INJ] THEN + ASM_MESON_TAC[imp_contr; imp_swap]);; + +let contrad = prove + (`!A p. A |-- (p --> False) --> p ==> A |-- p`, + MESON_TAC[modusponens; axiom_distribimp; imp_refl; axiom_doubleneg]);; + +let bool_cases = prove + (`!p q. A |-- p --> q /\ A |-- (p --> False) --> q ==> A |-- q`, + MESON_TAC[contrad; imp_trans; imp_add_concl]);; + +let imp_false_rule = prove + (`!p q r. A |-- (q --> False) --> p --> r + ==> A |-- ((p --> q) --> False) --> r`, + MESON_TAC[imp_add_concl; imp_add_assum; ex_falso; axiom_addimp; imp_swap; + imp_trans; axiom_doubleneg; imp_unduplicate]);; + +let imp_true_rule = prove + (`!A p q r. A |-- (p --> False) --> r /\ A |-- q --> r + ==> A |-- (p --> q) --> r`, + MESON_TAC[imp_insert; imp_swap; modusponens; imp_trans_th; bool_cases]);; + +let truth = prove + (`!A. A |-- True`, + MESON_TAC[modusponens; axiom_true; imp_refl; iff_imp2]);; + +let and_left = prove + (`!A p q. A |-- p && q --> p`, + MESON_TAC[imp_add_assum; axiom_addimp; imp_trans; imp_add_concl; + axiom_doubleneg; imp_trans; iff_imp1; axiom_and]);; + +let and_right = prove + (`!A p q. A |-- p && q --> q`, + MESON_TAC[axiom_addimp; imp_trans; imp_add_concl; axiom_doubleneg; + iff_imp1; axiom_and]);; + +let and_pair = prove + (`!A p q. A |-- p --> q --> p && q`, + MESON_TAC[iff_imp2; axiom_and; imp_swap_th; imp_add_assum; imp_trans2; + modusponens; imp_swap; imp_refl]);; + +let META_AND = prove + (`!A p q. A |-- p && q <=> A |-- p /\ A |-- q`, + MESON_TAC[and_left; and_right; and_pair; modusponens]);; + +let shunt = prove + (`!A p q r. A |-- p && q --> r ==> A |-- p --> q --> r`, + MESON_TAC[modusponens; imp_add_assum; and_pair]);; + +let ante_conj = prove + (`!A p q r. A |-- p --> q --> r ==> A |-- p && q --> r`, + MESON_TAC[imp_trans_chain_2; and_left; and_right]);; + +let not_not_false = prove + (`!A p. A |-- (p --> False) --> False <-> p`, + MESON_TAC[imp_antisym; axiom_doubleneg; imp_swap; imp_refl]);; + +let iff_sym = prove + (`!A p q. A |-- p <-> q <=> A |-- q <-> p`, + MESON_TAC[iff_imp1; iff_imp2; imp_antisym]);; + +let iff_trans = prove + (`!A p q r. A |-- p <-> q /\ A |-- q <-> r ==> A |-- p <-> r`, + MESON_TAC[iff_imp1; iff_imp2; imp_trans; imp_antisym]);; + +let not_not = prove + (`!A p. A |-- Not(Not p) <-> p`, + MESON_TAC[iff_trans; not_not_false; axiom_not; imp_antisym; imp_add_concl; + iff_imp1; iff_imp2]);; + +let contrapos_eq = prove + (`!A p q. A |-- Not p --> Not q <=> A |-- q --> p`, + MESON_TAC[contrapos; not_not; iff_imp1; iff_imp2; imp_trans]);; + +let or_left = prove + (`!A p q. A |-- q --> p || q`, + MESON_TAC[imp_trans; not_not; iff_imp2; and_right; contrapos; axiom_or]);; + +let or_right = prove + (`!A p q. A |-- p --> p || q`, + MESON_TAC[imp_trans; not_not; iff_imp2; and_left; contrapos; axiom_or]);; + +let ante_disj = prove + (`!A p q r. A |-- p --> r /\ A |-- q --> r + ==> A |-- p || q --> r`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM contrapos_eq] THEN + MESON_TAC[imp_trans; imp_trans_chain_2; and_pair; contrapos_eq; not_not; + axiom_or; iff_imp1; iff_imp2; imp_trans]);; + +let iff_def = prove + (`!A p q. A |-- (p <-> q) <-> (p --> q) && (q --> p)`, + MESON_TAC[imp_antisym; imp_trans_chain_2; axiom_iffimp1; axiom_iffimp2; + and_pair; axiom_impiff; imp_trans_chain_2; and_left; and_right]);; + +let iff_refl = prove + (`!A p. A |-- p <-> p`, + MESON_TAC[imp_antisym; imp_refl]);; + +(* ------------------------------------------------------------------------- *) +(* Equality rules. *) +(* ------------------------------------------------------------------------- *) + +let eq_sym = prove + (`!A s t. A |-- s === t --> t === s`, + MESON_TAC[axiom_eqrefl; modusponens; imp_swap; axiom_predcong]);; + +let icongruence_general = prove + (`!A p x s t tm. + A |-- s === t --> + termsubst ((x |-> s) v) tm === termsubst ((x |-> t) v) tm`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[termsubst] THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[axiom_eqrefl; add_assum]; + GEN_TAC THEN REWRITE_TAC[valmod] THEN + COND_CASES_TAC THEN REWRITE_TAC[imp_refl] THEN + MESON_TAC[axiom_eqrefl; add_assum]; + MESON_TAC[imp_trans; axiom_funcong]; + MESON_TAC[imp_trans; axiom_funcong; imp_swap; imp_unduplicate]; + MESON_TAC[imp_trans; axiom_funcong; imp_swap; imp_unduplicate]]);; + +let icongruence = prove + (`!A x s t tm. + A |-- s === t --> termsubst (x |=> s) tm === termsubst (x |=> t) tm`, + REWRITE_TAC[assign; icongruence_general]);; + +let icongruence_var = prove + (`!A x t tm. + A |-- V x === t --> tm === termsubst (x |=> t) tm`, + MESON_TAC[icongruence; TERMSUBST_TRIV; ASSIGN_TRIV]);; + +(* ------------------------------------------------------------------------- *) +(* First-order rules. *) +(* ------------------------------------------------------------------------- *) + +let gen_right = prove + (`!A x p q. ~(x IN FV(p)) /\ A |-- p --> q + ==> A |-- p --> !!x q`, + MESON_TAC[axiom_allimp; modusponens; gen; imp_trans; axiom_impall]);; + +let genimp = prove + (`!x p q. A |-- p --> q ==> A |-- (!!x p) --> (!!x q)`, + MESON_TAC[modusponens; axiom_allimp; gen]);; + +let eximp = prove + (`!x p q. A |-- p --> q ==> A |-- (??x p) --> (??x q)`, + MESON_TAC[contrapos; genimp; contrapos; imp_trans; iff_imp1; iff_imp2; + axiom_exists]);; + +let exists_imp = prove + (`!A x p q. A |-- ??x (p --> q) /\ ~(x IN FV(q)) ==> A |-- (!!x p) --> q`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `A |-- (q --> False) --> !!x (p --> Not(p --> q))` + ASSUME_TAC THENL + [MATCH_MP_TAC gen_right THEN + ASM_REWRITE_TAC[FV; IN_UNION; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[iff_imp2; axiom_not; imp_trans2; imp_truefalse]; + ALL_TAC] THEN + SUBGOAL_THEN `A |-- (q --> False) --> !!x p --> !!x (Not(p --> q))` + ASSUME_TAC THENL + [ASM_MESON_TAC[imp_trans; axiom_allimp]; ALL_TAC] THEN + SUBGOAL_THEN `A |-- ((q --> False) --> !!x (Not(p --> q))) + --> (q --> False) --> False` + ASSUME_TAC THENL + [ASM_MESON_TAC[modusponens; iff_imp1; axiom_exists; axiom_not; imp_trans_th]; + ALL_TAC] THEN + ASM_MESON_TAC[imp_trans; imp_swap; axiom_doubleneg]);; + +let subspec = prove + (`!A x t p q. ~(x IN FVT(t)) /\ ~(x IN FV(q)) /\ A |-- V x === t --> p --> q + ==> A |-- (!!x p) --> q`, + MESON_TAC[exists_imp; modusponens; eximp; axiom_existseq]);; + +let subalpha = prove + (`!A x y p q. ((x = y) \/ ~(x IN FV(q)) /\ ~(y IN FV(p))) /\ + A |-- V x === V y --> p --> q + ==> A |-- (!!x p) --> (!!y q)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = y:num` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_MESON_TAC[genimp; modusponens; axiom_eqrefl]; + ALL_TAC] THEN + MATCH_MP_TAC gen_right THEN ASM_REWRITE_TAC[FV; IN_DELETE] THEN + MATCH_MP_TAC subspec THEN EXISTS_TAC `V y` THEN + ASM_REWRITE_TAC[FVT; IN_SING]);; + +(* ------------------------------------------------------------------------- *) +(* We'll perform induction on this measure. *) +(* ------------------------------------------------------------------------- *) + +let complexity = new_recursive_definition form_RECURSION + `(complexity False = 1) /\ + (complexity True = 1) /\ + (!s t. complexity (s === t) = 1) /\ + (!s t. complexity (s << t) = 1) /\ + (!s t. complexity (s <<= t) = 1) /\ + (!p. complexity (Not p) = complexity p + 3) /\ + (!p q. complexity (p && q) = complexity p + complexity q + 6) /\ + (!p q. complexity (p || q) = complexity p + complexity q + 16) /\ + (!p q. complexity (p --> q) = complexity p + complexity q + 1) /\ + (!p q. complexity (p <-> q) = 2 * (complexity p + complexity q) + 9) /\ + (!x p. complexity (!!x p) = complexity p + 1) /\ + (!x p. complexity (??x p) = complexity p + 8)`;; + +let COMPLEXITY_FORMSUBST = prove + (`!p i. complexity(formsubst i p) = complexity p`, + MATCH_MP_TAC form_INDUCT THEN + SIMP_TAC[formsubst; complexity; LET_DEF; LET_END_DEF]);; + +let isubst_general = prove + (`!A p x v s t. A |-- s === t + --> formsubst ((x |-> s) v) p + --> formsubst ((x |-> t) v) p`, + GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `complexity p` THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`p:form`,`p:form`) THEN + MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[formsubst; complexity] THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[imp_refl; add_assum]; + MESON_TAC[imp_refl; add_assum]; + MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general]; + MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general]; + MESON_TAC[imp_trans_chain_2; axiom_predcong; icongruence_general]; + X_GEN_TAC `p:form` THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `p --> False`) THEN + REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[formsubst] THEN + MESON_TAC[axiom_not; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; + MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(p --> q --> False) --> False`) THEN + REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[formsubst] THEN + MESON_TAC[axiom_and; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; + MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `Not(Not p && Not q)`) THEN + REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[formsubst] THEN + MESON_TAC[axiom_or; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; + MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `p:form` th) THEN + MP_TAC(SPEC `q:form` th)) THEN + REWRITE_TAC[ARITH_RULE `p < p + q + 1 /\ q < p + q + 1`] THEN + MESON_TAC[imp_mono_th; eq_sym; imp_trans; imp_trans_chain_2]; + MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(p --> q) && (q --> p)`) THEN + REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[formsubst] THEN + MESON_TAC[iff_def; iff_imp1; iff_imp2; imp_swap; imp_trans; imp_trans2]; + ALL_TAC; + MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `Not(!!x (Not p))`) THEN + REWRITE_TAC[complexity] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[formsubst] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[FV] THEN REPEAT LET_TAC THEN + ASM_MESON_TAC[axiom_exists; iff_imp1; iff_imp2; imp_swap; imp_trans; + imp_trans2]] THEN + MAP_EVERY X_GEN_TAC [`u:num`; `p:form`] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `a < b + 1 <=> a <= b`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`v:num`; `i:num->term`; `s:term`; `t:term`] THEN + MAP_EVERY ABBREV_TAC + [`x = if ?y. y IN FV (!! u p) /\ u IN FVT ((v |-> s) i y) + then VARIANT (FV (formsubst ((u |-> V u) ((v |-> s) i)) p)) + else u`; + `y = if ?y. y IN FV (!! u p) /\ u IN FVT ((v |-> t) i y) + then VARIANT (FV (formsubst ((u |-> V u) ((v |-> t) i)) p)) + else u`] THEN + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + SUBGOAL_THEN `~(x IN FV(formsubst ((v |-> s) i) (!!u p))) /\ + ~(y IN FV(formsubst ((v |-> t) i) (!!u p)))` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["x"; "y"] THEN CONJ_TAC THEN + (COND_CASES_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM]] THEN + MATCH_MP_TAC NOT_IN_VARIANT THEN REWRITE_TAC[FV_FINITE] THEN + REWRITE_TAC[SUBSET; FORMSUBST_FV; IN_ELIM_THM; FV; IN_DELETE] THEN + REWRITE_TAC[valmod] THEN MESON_TAC[FVT; IN_SING]); + ALL_TAC] THEN + ASM_CASES_TAC `v:num = u` THENL + [ASM_REWRITE_TAC[VALMOD_VALMOD_BASIC] THEN + MATCH_MP_TAC add_assum THEN MATCH_MP_TAC subalpha THEN + ASM_SIMP_TAC[LE_REFL] THEN + ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [UNDISCH_TAC `~(x IN FV (formsubst ((v |-> s) i) (!! u p)))`; + UNDISCH_TAC `~(y IN FV (formsubst ((v |-> t) i) (!! u p)))`] THEN + ASM_REWRITE_TAC[FORMSUBST_FV; FV; IN_ELIM_THM; IN_DELETE] THEN + MATCH_MP_TAC MONO_NOT THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `w:num` THEN ASM_CASES_TAC `w:num = u` THEN + ASM_REWRITE_TAC[VALMOD_BASIC; FVT; IN_SING] THEN + ASM_REWRITE_TAC[valmod; FVT; IN_SING]; + ALL_TAC] THEN + SUBGOAL_THEN + `?z. ~(z IN FVT s) /\ ~(z IN FVT t) /\ + A |-- !!x (formsubst ((u |-> V x) ((v |-> s) i)) p) + --> !!z (formsubst ((u |-> V z) ((v |-> s) i)) p) /\ + A |-- !!z (formsubst ((u |-> V z) ((v |-> t) i)) p) + --> !!y (formsubst ((u |-> V y) ((v |-> t) i)) p)` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(X_CHOOSE_THEN `z:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC imp_trans THEN + EXISTS_TAC `(!!z (formsubst ((v |-> s) ((u |-> V z) i)) p)) + --> (!!z (formsubst ((v |-> t) ((u |-> V z) i)) p))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC imp_trans THEN + EXISTS_TAC `!!z (formsubst ((v |-> s) ((u |-> V z) i)) p + --> formsubst ((v |-> t) ((u |-> V z) i)) p)` THEN + REWRITE_TAC[axiom_allimp] THEN + ASM_SIMP_TAC[complexity; LE_REFL; FV; IN_UNION; gen_right]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP VALMOD_SWAP th]) THEN + ASM_MESON_TAC[imp_mono_th; modusponens]] THEN + MP_TAC(SPEC + `FVT(s) UNION FVT(t) UNION + FV(formsubst ((u |-> V x) ((v |-> s) i)) p) UNION + FV(formsubst ((u |-> V y) ((v |-> t) i)) p)` VARIANT_FINITE) THEN + REWRITE_TAC[FINITE_UNION; FV_FINITE; FVT_FINITE] THEN + W(fun (_,w) -> ABBREV_TAC(mk_comb(`(=) (z:num)`,lhand(rand(lhand w))))) THEN + REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN + EXISTS_TAC `z:num` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC subalpha THEN ASM_SIMP_TAC[LE_REFL] THENL + [ASM_CASES_TAC `z:num = x` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(x IN FV (formsubst ((v |-> s) i) (!! u p)))`; + ASM_CASES_TAC `z:num = y` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(y IN FV (formsubst ((v |-> t) i) (!! u p)))`] THEN + ASM_REWRITE_TAC[FORMSUBST_FV; FV; IN_ELIM_THM; IN_DELETE] THEN + MATCH_MP_TAC MONO_NOT THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `w:num` THEN ASM_CASES_TAC `w:num = u` THEN + ASM_REWRITE_TAC[VALMOD_BASIC; FVT; IN_SING] THEN + ASM_REWRITE_TAC[valmod; FVT; IN_SING]);; + +let isubst = prove + (`!A p x s t. A |-- s === t + --> formsubst (x |=> s) p --> formsubst (x |=> t) p`, + REWRITE_TAC[assign; isubst_general]);; + +let isubst_var = prove + (`!A p x t. A |-- V x === t --> p --> formsubst (x |=> t) p`, + MESON_TAC[FORMSUBST_TRIV; ASSIGN_TRIV; isubst]);; + +let alpha = prove + (`!A x z p. ~(z IN FV p) ==> A |-- (!!x p) --> !!z (formsubst (x |=> V z) p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC subalpha THEN CONJ_TAC THENL + [ALL_TAC; MESON_TAC[isubst_var]] THEN + REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN] THEN + ASM_MESON_TAC[IN_SING; FVT]);; + +(* ------------------------------------------------------------------------- *) +(* To conclude cleanly, useful to have all variables. *) +(* ------------------------------------------------------------------------- *) + +let VARS = new_recursive_definition form_RECURSION + `(VARS False = {}) /\ + (VARS True = {}) /\ + (VARS (s === t) = FVT s UNION FVT t) /\ + (VARS (s << t) = FVT s UNION FVT t) /\ + (VARS (s <<= t) = FVT s UNION FVT t) /\ + (VARS (Not p) = VARS p) /\ + (VARS (p && q) = VARS p UNION VARS q) /\ + (VARS (p || q) = VARS p UNION VARS q) /\ + (VARS (p --> q) = VARS p UNION VARS q) /\ + (VARS (p <-> q) = VARS p UNION VARS q) /\ + (VARS (!! x p) = x INSERT VARS p) /\ + (VARS (?? x p) = x INSERT VARS p)`;; + +let VARS_FINITE = prove + (`!p. FINITE(VARS p)`, + MATCH_MP_TAC form_INDUCT THEN + ASM_SIMP_TAC[VARS; FINITE_RULES; FVT_FINITE; FINITE_UNION; FINITE_DELETE]);; + +let FV_SUBSET_VARS = prove + (`!p. FV(p) SUBSET VARS(p)`, + REWRITE_TAC[SUBSET] THEN + MATCH_MP_TAC form_INDUCT THEN REWRITE_TAC[FV; VARS] THEN + REWRITE_TAC[IN_INSERT; IN_UNION; IN_DELETE] THEN MESON_TAC[]);; + +let TERMSUBST_TWICE_GENERAL = prove + (`!x z t v s. ~(z IN FVT s) + ==> (termsubst ((x |-> t) v) s = + termsubst ((z |-> t) v) (termsubst (x |=> V z) s))`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[termsubst; ASSIGN; valmod; FVT; IN_SING; IN_UNION] THEN + MESON_TAC[termsubst; ASSIGN]);; + +let TERMSUBST_TWICE = prove + (`!x z t s. ~(z IN FVT s) + ==> (termsubst (x |=> t) s = + termsubst (z |=> t) (termsubst (x |=> V z) s))`, + MESON_TAC[assign; TERMSUBST_TWICE_GENERAL]);; + +let FORMSUBST_TWICE_GENERAL = prove + (`!p i j. + (!x. x IN VARS p ==> safe_for x i) + ==> formsubst j (formsubst i p) = formsubst (termsubst j o i) p`, + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[VARS; FORALL_IN_INSERT; IN_UNION; NOT_IN_EMPTY; FORALL_AND_THM; + TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + SIMP_TAC[FORMSUBST_SAFE_FOR] THEN + REWRITE_TAC[formsubst; TERMSUBST_TERMSUBST] THEN SIMP_TAC[] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN + STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`i:num->term`; `j:num->term`] THEN + STRIP_TAC THEN + REWRITE_TAC[FV; FORMSUBST_FV; TERMSUBST_FVT; o_THM; + IN_ELIM_THM; IN_DELETE] THEN + (SUBGOAL_THEN + `(?y. ((?y'. y' IN FV p /\ y IN FVT ((x |-> V x) i y')) /\ ~(y = x)) /\ + x IN FVT (j y)) <=> + (?y. (y IN FV p /\ ~(y = x)) /\ + (?y'. y' IN FVT (i y) /\ x IN FVT (j y')))` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `y:num` THEN + ASM_CASES_TAC `y IN FV p` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VALMOD; FVT; IN_SING] THEN MESON_TAC[]; ALL_TAC] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `z:num` THEN + ASM_CASES_TAC `x IN FVT(j(z:num))` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[VALMOD] THEN ASM_MESON_TAC[safe_for]; + ALL_TAC] THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `{x' | ?y. (?y'. y' IN FV p /\ y IN FVT ((x |-> V x) i y')) /\ + x' IN FVT ((x |-> V x) j y)} = + {x' | ?y. y IN FV p /\ x' IN FVT ((x |-> V x) (termsubst j o i) y)}` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:num` THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `y:num` THEN + ASM_CASES_TAC `y IN FV p` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `y:num = x` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[VALMOD; FVT; IN_SING; UNWIND_THM2] THEN + REWRITE_TAC[o_THM; TERMSUBST_FVT; IN_ELIM_THM] THEN + ASM_MESON_TAC[safe_for]; + ABBREV_TAC `z = VARIANT + {x' | ?y. y IN FV p /\ x' IN FVT ((x |-> V x) (termsubst j o i) y)}`]; + ALL_TAC]) THEN + AP_TERM_TAC THEN FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhs o rand) th o lhs o snd)) THEN + ASM_SIMP_TAC[SAFE_FOR_VALMOD; FVT; IN_SING] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC FORMSUBST_EQ THEN + X_GEN_TAC `y:num` THEN DISCH_TAC THEN + REWRITE_TAC[VALMOD; o_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[termsubst; VALMOD] THEN + MATCH_MP_TAC TERMSUBST_EQ THEN + X_GEN_TAC `w:num` THEN REWRITE_TAC[VALMOD] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[safe_for]);; + +let FORMSUBST_TWICE = prove + (`!z p x t. ~(z IN VARS p) + ==> (formsubst (z |=> t) (formsubst (x |=> V z) p) = + formsubst (x |=> t) p)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) FORMSUBST_TWICE_GENERAL o lhs o snd) THEN + REWRITE_TAC[SAFE_FOR_ASSIGN; FVT; IN_SING] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC FORMSUBST_EQ THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[o_THM; VALMOD; ASSIGN] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[termsubst; ASSIGN] THEN + ASM_MESON_TAC[FV_SUBSET_VARS; SUBSET]);; + +let ispec_lemma = prove + (`!A x p t. ~(x IN FVT(t)) ==> A |-- !!x p --> formsubst (x |=> t) p`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC subspec THEN + EXISTS_TAC `t:term` THEN ASM_REWRITE_TAC[isubst_var] THEN + ASM_REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN] THEN + ASM_MESON_TAC[FVT; IN_SING]);; + +let ispec = prove + (`!A x p t. A |-- !!x p --> formsubst (x |=> t) p`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x IN FVT(t)` THEN + ASM_SIMP_TAC[ispec_lemma] THEN + ABBREV_TAC `z = VARIANT (FVT t UNION VARS p)` THEN + MATCH_MP_TAC imp_trans THEN + EXISTS_TAC `!!z (formsubst (x |=> V z) p)` THEN CONJ_TAC THENL + [MATCH_MP_TAC alpha THEN EXPAND_TAC "z" THEN + MATCH_MP_TAC NOT_IN_VARIANT THEN + REWRITE_TAC[FINITE_UNION; SUBSET; IN_UNION] THEN + MESON_TAC[SUBSET; FVT_FINITE; VARS_FINITE; FV_SUBSET_VARS]; + SUBGOAL_THEN + `formsubst (x |=> t) p = + formsubst (z |=> t) (formsubst (x |=> V z) p)` + SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM FORMSUBST_TWICE); MATCH_MP_TAC ispec_lemma] THEN + EXPAND_TAC "z" THEN MATCH_MP_TAC NOT_IN_VARIANT THEN + REWRITE_TAC[VARS_FINITE; FVT_FINITE; FINITE_UNION] THEN + SIMP_TAC[SUBSET; IN_UNION]]);; + +let spec = prove + (`!A x p t. A |-- !!x p ==> A |-- formsubst (x |=> t) p`, + MESON_TAC[ispec; modusponens]);; + +let spec_var = prove + (`!A x p. A |-- !!x p ==> A |-- p`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `V x` o MATCH_MP spec) THEN + SIMP_TAC[ASSIGN_TRIV; FORMSUBST_TRIVIAL]);; + +let instantiation = prove + (`!A v p. A |-- p ==> A |-- formsubst v p`, + let lemma = prove + (`!A p v. (!x y. x IN FV p /\ y IN FV p /\ x IN FVT(v y) + ==> x = y /\ v x = V x) /\ + A |-- p + ==> A |-- formsubst v p`, + REPEAT GEN_TAC THEN + WF_INDUCT_TAC `CARD {x | x IN FV(p) /\ ~(v x = V x)}` THEN + ASM_CASES_TAC `!x. x IN FV p ==> v x = V x` THEN + ASM_SIMP_TAC[FORMSUBST_TRIVIAL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:num` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:form`; `(x |-> V x) v`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC CARD_PSUBSET THEN SIMP_TAC[FINITE_RESTRICT; FV_FINITE] THEN + REWRITE_TAC[PSUBSET_ALT] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; VALMOD; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[VALMOD; IN_ELIM_THM] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + ANTS_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[VALMOD] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[FVT; IN_SING] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `formsubst v p = formsubst ((x |-> v x) v) p` + SUBST1_TAC THENL [SIMP_TAC[VALMOD_TRIVIAL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `x:num` o MATCH_MP gen) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] modusponens) THEN + MATCH_MP_TAC exists_imp THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; NOT_EXISTS_THM; VALMOD] THEN + ASM SET_TAC[]] THEN + MATCH_MP_TAC modusponens THEN EXISTS_TAC `??x (V x === v x)` THEN + SIMP_TAC[eximp; isubst_general] THEN ASM_MESON_TAC[axiom_existseq]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?n. !x. x IN VARS p \/ x IN FV(formsubst v p) ==> x < n` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `SUC(SETMAX(VARS p UNION FV(formsubst v p)))` THEN + REWRITE_TAC[GSYM IN_UNION; LT_SUC_LE] THEN MATCH_MP_TAC SETMAX_MEMBER THEN + REWRITE_TAC[FINITE_UNION; VARS_FINITE; FV_FINITE]; + ALL_TAC] THEN + SUBGOAL_THEN + `formsubst v p = + formsubst (\i. v(i - n)) (formsubst (\i. V(i + n)) p)` + SUBST1_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) FORMSUBST_TWICE_GENERAL o + rand o snd) THEN + REWRITE_TAC[safe_for; FVT; IN_SING] THEN ANTS_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `~(x + n:num < n)`]; + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[o_DEF; termsubst; ADD_SUB; ETA_AX]]; + MATCH_MP_TAC lemma THEN REWRITE_TAC[FVT] THEN CONJ_TAC THENL + [REWRITE_TAC[FORMSUBST_FV; FVT; IN_SING] THEN + REWRITE_TAC[SET_RULE `{x | ?y. y IN s /\ x = f y} = IMAGE f s`] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:num` THEN DISCH_TAC THEN REWRITE_TAC[ADD_SUB; FVT] THEN + X_GEN_TAC `y:num` THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + n:num`) THEN + MATCH_MP_TAC(TAUT `~p /\ q ==> (r \/ q ==> p) ==> s`) THEN + CONJ_TAC THENL [ARITH_TAC; REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM]] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC lemma THEN REWRITE_TAC[FVT; IN_SING] THEN + ASM_MESON_TAC[ARITH_RULE `x < n /\ y < n ==> ~(x = y + n)`; + FV_SUBSET_VARS; SUBSET]]]);; + +(* ------------------------------------------------------------------------- *) +(* Monotonicity and the deduction theorem. *) +(* ------------------------------------------------------------------------- *) + +let PROVES_MONO = prove + (`!A B p. A SUBSET B /\ A |-- p ==> B |-- p`, + GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC proves_INDUCT THEN ASM_MESON_TAC[proves_RULES; SUBSET]);; + +let DEDUCTION_LEMMA = prove + (`!A p q. p INSERT A |-- q /\ closed p ==> A |-- p --> q`, + GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `r:form` THENL + [REWRITE_TAC[IN_INSERT] THEN MESON_TAC[proves_RULES; add_assum; imp_refl]; + MESON_TAC[modusponens; axiom_distribimp]; + ASM_MESON_TAC[gen_right; closed; NOT_IN_EMPTY]]);; + +let DEDUCTION = prove + (`!A p q. closed p ==> (A |-- p --> q <=> p INSERT A |-- q)`, + MESON_TAC[DEDUCTION_LEMMA; modusponens; IN_INSERT; proves_RULES; + PROVES_MONO; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A few more derived rules. *) +(* ------------------------------------------------------------------------- *) + +let eq_trans = prove + (`!A s t u. A |-- s === t --> t === u --> s === u`, + MESON_TAC[axiom_predcong; modusponens; imp_swap; axiom_eqrefl; imp_trans; + eq_sym]);; + +let spec_right = prove + (`!A p q x. A |-- p --> !!x q ==> A |-- p --> formsubst (x |=> t) q`, + MESON_TAC[imp_trans; ispec]);; + +let eq_trans_rule = prove + (`!A s t u. A |-- s === t /\ A |-- t === u ==> A |-- s === u`, + MESON_TAC[modusponens; eq_trans]);; + +let eq_sym_rule = prove + (`!A s t. A |-- s === t <=> A |-- t === s`, + MESON_TAC[modusponens; eq_sym]);; + +let allimp = prove + (`!A x p q. A |-- p --> q ==> A |-- !!x p --> !!x q`, + MESON_TAC[axiom_allimp; modusponens; gen]);; + +let alliff = prove + (`!A x p q. A |-- p <-> q ==> A |-- !!x p <-> !!x q`, + MESON_TAC[allimp; iff_imp1; iff_imp2; imp_antisym]);; + +let exiff = prove + (`!A x p q. A |-- p <-> q ==> A |-- ??x p <-> ??x q`, + MESON_TAC[eximp; iff_imp1; iff_imp2; imp_antisym]);; + +let cong_suc = prove + (`!A s t. A |-- s === t ==> A |-- Suc s === Suc t`, + MESON_TAC[modusponens; axiom_funcong]);; + +let cong_add = prove + (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s ++ u === t ++ v`, + MESON_TAC[modusponens; axiom_funcong]);; + +let cong_mul = prove + (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s ** u === t ** v`, + MESON_TAC[modusponens; axiom_funcong]);; + +let cong_eq = prove + (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s === u <-> t === v`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC imp_antisym THEN + ASM_MESON_TAC[modusponens; axiom_predcong; eq_sym]);; + +let cong_le = prove + (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s <<= u <-> t <<= v`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC imp_antisym THEN + ASM_MESON_TAC[modusponens; axiom_predcong; eq_sym]);; + +let cong_lt = prove + (`!A s t u v. A |-- s === t /\ A |-- u === v ==> A |-- s << u <-> t << v`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC imp_antisym THEN + ASM_MESON_TAC[modusponens; axiom_predcong; eq_sym]);; + +let iexists = prove + (`!A x t p. A |-- formsubst (x |=> t) p --> ??x p`, + REPEAT GEN_TAC THEN TRANS_TAC imp_trans `Not(!!x (Not p))` THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[axiom_exists; iff_imp2]] THEN + TRANS_TAC imp_trans `Not(formsubst (x |=> t) (Not p))` THEN + REWRITE_TAC[contrapos_eq; ispec] THEN REWRITE_TAC[formsubst] THEN + MESON_TAC[not_not; iff_imp2]);; + +let exists_intro = prove + (`!A x t p. A |-- formsubst (x |=> t) p ==> A |-- ??x p`, + MESON_TAC[iexists; modusponens]);; + +let impex = prove + (`!A x p. ~(x IN FV p) ==> A |-- (??x p) --> p`, + REPEAT STRIP_TAC THEN TRANS_TAC imp_trans `Not(Not p)` THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[not_not; iff_imp1]] THEN + TRANS_TAC imp_trans `Not(!!x (Not p))` THEN + ASM_SIMP_TAC[contrapos_eq; axiom_impall; FV] THEN + MESON_TAC[axiom_exists; iff_imp1]);; + +let ichoose = prove + (`!A x p q. A |-- !!x (p --> q) /\ ~(x IN FV q) ==> A |-- (??x p) --> q`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP spec_var) THEN + DISCH_THEN(MP_TAC o SPEC `x:num` o MATCH_MP eximp) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] imp_trans) THEN + ASM_SIMP_TAC[impex]);; + +let eq_trans_imp = prove + (`A |-- s === s' /\ A |-- t === t' ==> A |-- s === t --> s' === t'`, + MESON_TAC[axiom_predcong; modusponens]);; + +(* ------------------------------------------------------------------------- *) +(* Some conversions for performing explicit substitution operations in what *) +(* we hope is the common case where no variable renaming occurs. *) +(* ------------------------------------------------------------------------- *) + +let fv_theorems = ref + [FV; FV_AXIOM; FV_DIAGONALIZE; FV_DIVIDES; FV_FINITE; FV_FIXPOINT; FV_FORM; + FV_FORM1; FV_FREEFORM; FV_FREEFORM1; FV_FREETERM; FV_FREETERM1; + FV_GNUMERAL; FV_GNUMERAL1; FV_GNUMERAL1'; FV_GSENTENCE; + FV_HSENTENCE; FV_PRIME; FV_PRIMEPOW; FV_PRIMREC; FV_PRIMRECSTEP; FV_PROV; + FV_PROV1; FV_QDIAG; FV_QSUBST; FV_RTC; FV_RTCP; FV_SUBSET_VARS; FV_TERM; + FV_TERM1; FVT; FVT_NUMERAL];; + +let IN_FV_RULE ths tm = + try EQT_ELIM + ((GEN_REWRITE_CONV TOP_DEPTH_CONV + ([IN_UNION; IN_DELETE; NOT_IN_EMPTY; IN_INSERT] @ + ths @ !fv_theorems) THENC + NUM_REDUCE_CONV) tm) + with Failure _ -> ASSUME tm;; + +let rec SAFE_FOR_RULE tm = + try PART_MATCH I SAFE_FOR_V tm + with Failure _ -> + try let th1 = PART_MATCH lhand SAFE_FOR_ASSIGN tm in + let th2 = IN_FV_RULE [] (rand(concl th1)) in + EQ_MP (SYM th1) th2 + with Failure _ -> + let th1 = PART_MATCH rand SAFE_FOR_VALMOD tm in + let l,r = dest_conj(lhand(concl th1)) in + let th2 = CONJ (SAFE_FOR_RULE l) (IN_FV_RULE [] r) in + MP th1 th2;; + +let VALMOD_CONV = + GEN_REWRITE_CONV TOP_DEPTH_CONV [ASSIGN; VALMOD] THENC NUM_REDUCE_CONV;; + +let TERMSUBST_NUMERAL = prove + (`!v n. termsubst v (numeral n) = numeral n`, + SIMP_TAC[TERMSUBST_TRIVIAL; FVT_NUMERAL; NOT_IN_EMPTY]);; + +let rec TERMSUBST_CONV tm = + (GEN_REWRITE_CONV I [CONJ TERMSUBST_NUMERAL (CONJUNCT1 termsubst)] ORELSEC + (GEN_REWRITE_CONV I [el 1 (CONJUNCTS termsubst)] THENC + VALMOD_CONV) ORELSEC + (GEN_REWRITE_CONV I [el 2 (CONJUNCTS termsubst)] THENC + RAND_CONV TERMSUBST_CONV) ORELSEC + (GEN_REWRITE_CONV I [funpow 3 CONJUNCT2 termsubst] THENC + BINOP_CONV TERMSUBST_CONV)) tm;; + +let rec FORMSUBST_CONV tm = + (GEN_REWRITE_CONV I + [el 0 (CONJUNCTS formsubst); el 1 (CONJUNCTS formsubst)] ORELSEC + (GEN_REWRITE_CONV I + [el 2 (CONJUNCTS formsubst); el 3 (CONJUNCTS formsubst); + el 4 (CONJUNCTS formsubst)] THENC BINOP_CONV TERMSUBST_CONV) ORELSEC + (GEN_REWRITE_CONV I [el 5 (CONJUNCTS formsubst)] THENC + RAND_CONV FORMSUBST_CONV) ORELSEC + (GEN_REWRITE_CONV I + [el 6 (CONJUNCTS formsubst); el 7 (CONJUNCTS formsubst); + el 8 (CONJUNCTS formsubst); el 9 (CONJUNCTS formsubst)] THENC + BINOP_CONV FORMSUBST_CONV) ORELSEC + ((fun tm -> + let th = + try PART_MATCH (lhand o rand) (CONJUNCT1 FORMSUBST_SAFE_FOR) tm + with Failure _ -> + PART_MATCH (lhand o rand) (CONJUNCT2 FORMSUBST_SAFE_FOR) tm in + MP th (SAFE_FOR_RULE (lhand(concl th)))) THENC + RAND_CONV FORMSUBST_CONV)) tm;; + +(* ------------------------------------------------------------------------- *) +(* Hence a more convenient specialization rule. *) +(* ------------------------------------------------------------------------- *) + +let spec_var_rule th = MATCH_MP spec_var th;; + +let spec_all_rule = repeat spec_var_rule;; + +let instantiate_rule ilist th = + let v_tm = `(|->):num->term->(num->term)->(num->term)` in + let v = itlist (fun (t,x) v -> + mk_comb(mk_comb(mk_comb(v_tm,mk_small_numeral x),t),v)) ilist `V` in + CONV_RULE (RAND_CONV FORMSUBST_CONV) + (SPEC v (MATCH_MP instantiation th));; + +let specl_rule tms th = + let avs = striplist (dest_binop `!!`) (rand(concl th)) in + let vs = fst(chop_list(length tms) avs) in + let ilist = map2 (fun t v -> (t,dest_small_numeral v)) tms vs in + instantiate_rule ilist (funpow (length vs) spec_var_rule th);; + +let spec_rule t th = specl_rule [t] th;; + +let gen_rule t th = SPEC (mk_small_numeral t) (MATCH_MP gen th);; + +let gens_tac ns (asl,w) = + let avs,bod = nsplit dest_forall ns w in + let nvs = map (curry mk_comb `V` o mk_small_numeral) ns in + let bod' = subst (zip nvs avs) bod in + let th = GENL avs (instantiate_rule (zip avs ns) (ASSUME bod')) in + MATCH_MP_TAC (DISCH_ALL th) (asl,w);; + +let gen_tac n = gens_tac [n];; diff --git a/Arithmetic/fol.ml b/Arithmetic/fol.ml new file mode 100644 index 0000000..0dc0b0c --- /dev/null +++ b/Arithmetic/fol.ml @@ -0,0 +1,570 @@ +(* ========================================================================= *) +(* First order logic based on the language of arithmetic. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Syntax of terms. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("++",(20,"right"));; +parse_as_infix("**",(22,"right"));; + +let term_INDUCT,term_RECURSION = define_type + "term = Z + | V num + | Suc term + | ++ term term + | ** term term";; + +let term_CASES = prove_cases_thm term_INDUCT;; + +let term_DISTINCT = distinctness "term";; + +let term_INJ = injectivity "term";; + +(* ------------------------------------------------------------------------- *) +(* Syntax of formulas. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("===",(18,"right"));; +parse_as_infix("<<",(18,"right"));; +parse_as_infix("<<=",(18,"right"));; + +parse_as_infix("&&",(16,"right"));; +parse_as_infix("||",(15,"right"));; +parse_as_infix("-->",(14,"right"));; +parse_as_infix("<->",(13,"right"));; + +let form_INDUCT,form_RECURSION = define_type + "form = False + | True + | === term term + | << term term + | <<= term term + | Not form + | && form form + | || form form + | --> form form + | <-> form form + | !! num form + | ?? num form";; + +let form_CASES = prove_cases_thm form_INDUCT;; + +let form_DISTINCT = distinctness "form";; + +let form_INJ = injectivity "form";; + +(* ------------------------------------------------------------------------- *) +(* Semantics of terms and formulas in the standard model. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("|->",(22,"right"));; + +let valmod = new_definition + `(x |-> a) (v:A->B) = \y. if y = x then a else v(y)`;; + +let termval = new_recursive_definition term_RECURSION + `(termval v Z = 0) /\ + (termval v (V n) = v(n)) /\ + (termval v (Suc t) = SUC (termval v t)) /\ + (termval v (s ++ t) = termval v s + termval v t) /\ + (termval v (s ** t) = termval v s * termval v t)`;; + +let holds = new_recursive_definition form_RECURSION + `(holds v False <=> F) /\ + (holds v True <=> T) /\ + (holds v (s === t) <=> (termval v s = termval v t)) /\ + (holds v (s << t) <=> (termval v s < termval v t)) /\ + (holds v (s <<= t) <=> (termval v s <= termval v t)) /\ + (holds v (Not p) <=> ~(holds v p)) /\ + (holds v (p && q) <=> holds v p /\ holds v q) /\ + (holds v (p || q) <=> holds v p \/ holds v q) /\ + (holds v (p --> q) <=> holds v p ==> holds v q) /\ + (holds v (p <-> q) <=> (holds v p <=> holds v q)) /\ + (holds v (!! x p) <=> !a. holds ((x|->a) v) p) /\ + (holds v (?? x p) <=> ?a. holds ((x|->a) v) p)`;; + +let true_def = new_definition + `true p <=> !v. holds v p`;; + +let VALMOD = prove + (`!v x y a. ((x |-> y) v) a = if a = x then y else v(a)`, + REWRITE_TAC[valmod]);; + +let VALMOD_BASIC = prove + (`!v x y. (x |-> y) v x = y`, + REWRITE_TAC[valmod]);; + +let VALMOD_VALMOD_BASIC = prove + (`!v a b x. (x |-> a) ((x |-> b) v) = (x |-> a) v`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; + +let VALMOD_REPEAT = prove + (`!v x. (x |-> v(x)) v = v`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; + +let FORALL_VALMOD = prove + (`!x. (!v a. P((x |-> a) v)) <=> (!v. P v)`, + MESON_TAC[VALMOD_REPEAT]);; + +let VALMOD_SWAP = prove + (`!v x y a b. + ~(x = y) ==> ((x |-> a) ((y |-> b) v) = (y |-> b) ((x |-> a) v))`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; + +let VALMOD_TRIVIAL = prove + (`!v x. v x = t ==> (x |-> t) v = v`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Assignment. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("|=>",(22,"right"));; + +let assign = new_definition + `(x |=> a) = (x |-> a) V`;; + +let ASSIGN = prove + (`!x y a. (x |=> a) y = if y = x then a else V(y)`, + REWRITE_TAC[assign; valmod]);; + +let ASSIGN_TRIV = prove + (`!x. (x |=> V x) = V`, + REWRITE_TAC[VALMOD_REPEAT; assign]);; + +(* ------------------------------------------------------------------------- *) +(* Variables in a term and free variables in a formula. *) +(* ------------------------------------------------------------------------- *) + +let FVT = new_recursive_definition term_RECURSION + `(FVT Z = {}) /\ + (FVT (V n) = {n}) /\ + (FVT (Suc t) = FVT t) /\ + (FVT (s ++ t) = (FVT s) UNION (FVT t)) /\ + (FVT (s ** t) = (FVT s) UNION (FVT t))`;; + +let FV = new_recursive_definition form_RECURSION + `(FV False = {}) /\ + (FV True = {}) /\ + (FV (s === t) = (FVT s) UNION (FVT t)) /\ + (FV (s << t) = (FVT s) UNION (FVT t)) /\ + (FV (s <<= t) = (FVT s) UNION (FVT t)) /\ + (FV (Not p) = FV p) /\ + (FV (p && q) = (FV p) UNION (FV q)) /\ + (FV (p || q) = (FV p) UNION (FV q)) /\ + (FV (p --> q) = (FV p) UNION (FV q)) /\ + (FV (p <-> q) = (FV p) UNION (FV q)) /\ + (FV (!!x p) = (FV p) DELETE x) /\ + (FV (??x p) = (FV p) DELETE x)`;; + +let FVT_FINITE = prove + (`!t. FINITE(FVT t)`, + MATCH_MP_TAC term_INDUCT THEN + SIMP_TAC[FVT; FINITE_RULES; FINITE_INSERT; FINITE_UNION]);; + +let FV_FINITE = prove + (`!p. FINITE(FV p)`, + MATCH_MP_TAC form_INDUCT THEN + SIMP_TAC[FV; FVT_FINITE; FINITE_RULES; FINITE_DELETE; FINITE_UNION]);; + +(* ------------------------------------------------------------------------- *) +(* Logical axioms. *) +(* ------------------------------------------------------------------------- *) + +let axiom_RULES,axiom_INDUCT,axiom_CASES = new_inductive_definition + `(!p q. axiom(p --> (q --> p))) /\ + (!p q r. axiom((p --> q --> r) --> (p --> q) --> (p --> r))) /\ + (!p. axiom(((p --> False) --> False) --> p)) /\ + (!x p q. axiom((!!x (p --> q)) --> (!!x p) --> (!!x q))) /\ + (!x p. ~(x IN FV p) ==> axiom(p --> !!x p)) /\ + (!x t. ~(x IN FVT t) ==> axiom(??x (V x === t))) /\ + (!t. axiom(t === t)) /\ + (!s t. axiom((s === t) --> (Suc s === Suc t))) /\ + (!s t u v. axiom(s === t --> u === v --> s ++ u === t ++ v)) /\ + (!s t u v. axiom(s === t --> u === v --> s ** u === t ** v)) /\ + (!s t u v. axiom(s === t --> u === v --> s === u --> t === v)) /\ + (!s t u v. axiom(s === t --> u === v --> s << u --> t << v)) /\ + (!s t u v. axiom(s === t --> u === v --> s <<= u --> t <<= v)) /\ + (!p q. axiom((p <-> q) --> p --> q)) /\ + (!p q. axiom((p <-> q) --> q --> p)) /\ + (!p q. axiom((p --> q) --> (q --> p) --> (p <-> q))) /\ + axiom(True <-> (False --> False)) /\ + (!p. axiom(Not p <-> (p --> False))) /\ + (!p q. axiom((p && q) <-> (p --> q --> False) --> False)) /\ + (!p q. axiom((p || q) <-> Not(Not p && Not q))) /\ + (!x p. axiom((??x p) <-> Not(!!x (Not p))))`;; + +(* ------------------------------------------------------------------------- *) +(* Deducibility from additional set of nonlogical axioms. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("|--",(11,"right"));; + +let proves_RULES,proves_INDUCT,proves_CASES = new_inductive_definition + `(!p. axiom p \/ p IN A ==> A |-- p) /\ + (!p q. A |-- (p --> q) /\ A |-- p ==> A |-- q) /\ + (!p x. A |-- p ==> A |-- (!!x p))`;; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas. *) +(* ------------------------------------------------------------------------- *) + +let TERMVAL_VALUATION = prove + (`!t v v'. (!x. x IN FVT(t) ==> (v'(x) = v(x))) + ==> (termval v' t = termval v t)`, + MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[termval; FVT; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[]);; + +let HOLDS_VALUATION = prove + (`!p v v'. + (!x. x IN (FV p) ==> (v'(x) = v(x))) + ==> (holds v' p <=> holds v p)`, + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[FV; holds; IN_UNION; IN_DELETE] THEN + SIMP_TAC[TERMVAL_VALUATION] THEN + REWRITE_TAC[valmod] THEN REPEAT STRIP_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[]);; + +let TERMVAL_VALMOD_OTHER = prove + (`!v x a t. ~(x IN FVT t) ==> (termval ((x |-> a) v) t = termval v t)`, + MESON_TAC[TERMVAL_VALUATION; VALMOD]);; + +let HOLDS_VALMOD_OTHER = prove + (`!v x a p. ~(x IN FV p) ==> (holds ((x |-> a) v) p <=> holds v p)`, + MESON_TAC[HOLDS_VALUATION; VALMOD]);; + +(* ------------------------------------------------------------------------- *) +(* Proof of soundness. *) +(* ------------------------------------------------------------------------- *) + +let AXIOMS_TRUE = prove + (`!p. axiom p ==> true p`, + MATCH_MP_TAC axiom_INDUCT THEN + REWRITE_TAC[true_def] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[holds] THENL + [CONV_TAC TAUT; + CONV_TAC TAUT; + SIMP_TAC[]; + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC HOLDS_VALUATION THEN + REWRITE_TAC[valmod] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_MESON_TAC[]; + EXISTS_TAC `termval v t` THEN + REWRITE_TAC[termval; valmod] THEN + MATCH_MP_TAC TERMVAL_VALUATION THEN + GEN_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_MESON_TAC[]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + SIMP_TAC[termval]; + CONV_TAC TAUT; + CONV_TAC TAUT; + CONV_TAC TAUT; + MESON_TAC[]]);; + +let THEOREMS_TRUE = prove + (`!A p. (!q. q IN A ==> true q) /\ A |-- p ==> true p`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC proves_INDUCT THEN + ASM_SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[IN; AXIOMS_TRUE] THEN + SIMP_TAC[holds; true_def]);; + +(* ------------------------------------------------------------------------- *) +(* Variant variables for use in renaming substitution. *) +(* ------------------------------------------------------------------------- *) + +let MAX_SYM = prove + (`!x y. MAX x y = MAX y x`, + ARITH_TAC);; + +let MAX_ASSOC = prove + (`!x y z. MAX x (MAX y z) = MAX (MAX x y) z`, + ARITH_TAC);; + +let SETMAX = new_definition + `SETMAX s = ITSET MAX s 0`;; + +let VARIANT = new_definition + `VARIANT s = SETMAX s + 1`;; + +let SETMAX_LEMMA = prove + (`(SETMAX {} = 0) /\ + (!x s. FINITE s ==> + (SETMAX (x INSERT s) = if x IN s then SETMAX s + else MAX x (SETMAX s)))`, + REWRITE_TAC[SETMAX] THEN MATCH_MP_TAC FINITE_RECURSION THEN + REWRITE_TAC[MAX] THEN REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`x:num <= s`; `y:num <= s`; `x:num <= y`; `y <= x`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_CASES; LE_TRANS; LE_ANTISYM]);; + +let SETMAX_MEMBER = prove + (`!s. FINITE s ==> !x. x IN s ==> x <= SETMAX s`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC [SETMAX_LEMMA] THEN + ASM_REWRITE_TAC[MAX] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[LE_REFL] THEN + ASM_MESON_TAC[LE_CASES; LE_TRANS]);; + +let SETMAX_THM = prove + (`(SETMAX {} = 0) /\ + (!x s. FINITE s ==> + (SETMAX (x INSERT s) = MAX x (SETMAX s)))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC [SETMAX_LEMMA] THEN + COND_CASES_TAC THEN REWRITE_TAC[MAX] THEN + COND_CASES_TAC THEN ASM_MESON_TAC[SETMAX_MEMBER]);; + +let SETMAX_UNION = prove + (`!s t. FINITE(s UNION t) + ==> (SETMAX(s UNION t) = MAX (SETMAX s) (SETMAX t))`, + let lemma = prove(`(x INSERT s) UNION t = x INSERT (s UNION t)`,SET_TAC[]) in + SUBGOAL_THEN `!t. FINITE(t) ==> !s. FINITE(s) ==> + (SETMAX(s UNION t) = MAX (SETMAX s) (SETMAX t))` + (fun th -> MESON_TAC[th; FINITE_UNION]) THEN + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNION_EMPTY; SETMAX_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[MAX; LE_0]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[lemma] THEN + ASM_SIMP_TAC [SETMAX_THM; FINITE_UNION] THEN + REWRITE_TAC[MAX_ASSOC]);; + +let VARIANT_FINITE = prove + (`!s:num->bool. FINITE(s) ==> ~(VARIANT(s) IN s)`, + REWRITE_TAC[VARIANT] THEN + MESON_TAC[SETMAX_MEMBER; ARITH_RULE `~(x + 1 <= x)`]);; + +let VARIANT_THM = prove + (`!p. ~(VARIANT(FV p) IN FV(p))`, + GEN_TAC THEN MATCH_MP_TAC VARIANT_FINITE THEN REWRITE_TAC[FV_FINITE]);; + +let NOT_IN_VARIANT = prove + (`!s t. FINITE s /\ t SUBSET s ==> ~(VARIANT(s) IN t)`, + MESON_TAC[SUBSET; VARIANT_FINITE]);; + +(* ------------------------------------------------------------------------- *) +(* Substitution within terms. *) +(* ------------------------------------------------------------------------- *) + +let termsubst = new_recursive_definition term_RECURSION + `(termsubst v Z = Z) /\ + (!x. termsubst v (V x) = v(x)) /\ + (!t. termsubst v (Suc t) = Suc(termsubst v t)) /\ + (!s t. termsubst v (s ++ t) = termsubst v s ++ termsubst v t) /\ + (!s t. termsubst v (s ** t) = termsubst v s ** termsubst v t)`;; + +let TERMVAL_TERMSUBST = prove + (`!v i t. termval v (termsubst i t) = termval (termval v o i) t`, + GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termval; termsubst; o_THM]);; + +let TERMSUBST_TERMSUBST = prove + (`!i j t. termsubst j (termsubst i t) = termsubst (termsubst j o i) t`, + GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termval; termsubst; o_THM]);; + +let TERMSUBST_TRIV = prove + (`!t. termsubst V t = t`, + MATCH_MP_TAC term_INDUCT THEN SIMP_TAC[termsubst]);; + +let TERMSUBST_EQ = prove + (`!t v v'. (!x. x IN (FVT t) ==> (v'(x) = v(x))) + ==> (termsubst v' t = termsubst v t)`, + MATCH_MP_TAC term_INDUCT THEN + SIMP_TAC[termsubst; FVT; IN_SING; IN_UNION] THEN MESON_TAC[]);; + +let TERMSUBST_FVT = prove + (`!t i. FVT(termsubst i t) = {x | ?y. y IN FVT(t) /\ x IN FVT(i y)}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[FVT; termsubst] THEN + REWRITE_TAC[IN_UNION; IN_SING; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let TERMSUBST_ASSIGN = prove + (`!x s t. ~(x IN FVT t) ==> (termsubst (x |=> s) t = t)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM TERMSUBST_TRIV] THEN + MATCH_MP_TAC TERMSUBST_EQ THEN + REWRITE_TAC[ASSIGN] THEN ASM_MESON_TAC[]);; + +let TERMSUBST_TRIVIAL = prove + (`!v t. (!x. x IN FVT t ==> v x = V x) ==> termsubst v t = t`, + MESON_TAC[TERMSUBST_EQ; TERMSUBST_TRIV]);; + +(* ------------------------------------------------------------------------- *) +(* Formula substitution --- somewhat less trivial. *) +(* ------------------------------------------------------------------------- *) + +let formsubst = new_recursive_definition form_RECURSION + `(formsubst v False = False) /\ + (formsubst v True = True) /\ + (formsubst v (s === t) = termsubst v s === termsubst v t) /\ + (formsubst v (s << t) = termsubst v s << termsubst v t) /\ + (formsubst v (s <<= t) = termsubst v s <<= termsubst v t) /\ + (formsubst v (Not p) = Not(formsubst v p)) /\ + (formsubst v (p && q) = formsubst v p && formsubst v q) /\ + (formsubst v (p || q) = formsubst v p || formsubst v q) /\ + (formsubst v (p --> q) = formsubst v p --> formsubst v q) /\ + (formsubst v (p <-> q) = formsubst v p <-> formsubst v q) /\ + (formsubst v (!!x q) = + let z = if ?y. y IN FV(!!x q) /\ x IN FVT(v(y)) + then VARIANT(FV(formsubst ((x |-> V x) v) q)) else x in + !!z (formsubst ((x |-> V(z)) v) q)) /\ + (formsubst v (??x q) = + let z = if ?y. y IN FV(??x q) /\ x IN FVT(v(y)) + then VARIANT(FV(formsubst ((x |-> V x) v) q)) else x in + ??z (formsubst ((x |-> V(z)) v) q))`;; + +let FORMSUBST_PROPERTIES = prove + (`!p. (!i. FV(formsubst i p) = {x | ?y. y IN FV(p) /\ x IN FVT(i y)}) /\ + (!i v. holds v (formsubst i p) = holds (termval v o i) p)`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[FV; holds; formsubst; TERMSUBST_FVT; IN_ELIM_THM; NOT_IN_EMPTY; + IN_UNION; TERMVAL_TERMSUBST] THEN + REPEAT(CONJ_TAC THENL [MESON_TAC[];ALL_TAC]) THEN CONJ_TAC THEN + (MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN STRIP_TAC THEN + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num->term` THEN + LET_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + SUBGOAL_THEN `~(?y. y IN (FV(p) DELETE x) /\ z IN FVT(i y))` + ASSUME_TAC THENL + [EXPAND_TAC "z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `formsubst ((x |-> V x) i) p` VARIANT_THM) THEN + ASM_REWRITE_TAC[valmod; IN_DELETE; CONTRAPOS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; + ALL_TAC] THEN + CONJ_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[FV; IN_DELETE; holds] THENL + [REWRITE_TAC[LEFT_AND_EXISTS_THM; valmod] THEN AP_TERM_TAC THEN + ABS_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[FVT; IN_SING; IN_DELETE]; + AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HOLDS_VALUATION THEN + GEN_TAC THEN REWRITE_TAC[valmod; o_DEF] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[termval] THEN DISCH_TAC THEN + MATCH_MP_TAC TERMVAL_VALUATION THEN GEN_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_MESON_TAC[IN_DELETE]]));; + +let FORMSUBST_FV = prove + (`!p i. FV(formsubst i p) = {x | ?y. y IN FV(p) /\ x IN FVT(i y)}`, + REWRITE_TAC[FORMSUBST_PROPERTIES]);; + +let HOLDS_FORMSUBST = prove + (`!p i v. holds v (formsubst i p) <=> holds (termval v o i) p`, + REWRITE_TAC[FORMSUBST_PROPERTIES]);; + +let FORMSUBST_EQ = prove + (`!p i j. (!x. x IN FV(p) ==> (i(x) = j(x))) + ==> (formsubst i p = formsubst j p)`, + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[FV; formsubst; IN_UNION; IN_DELETE] THEN + SIMP_TAC[] THEN REWRITE_TAC[CONJ_ASSOC] THEN + GEN_REWRITE_TAC I [GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [MESON_TAC[TERMSUBST_EQ]; ALL_TAC] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN + (DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`i:num->term`; `j:num->term`] THEN + DISCH_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF; form_INJ] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN SIMP_TAC[] THEN + CONJ_TAC THENL + [ALL_TAC; + DISCH_THEN(K ALL_TAC) THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[valmod] THEN ASM_SIMP_TAC[]] THEN + AP_THM_TAC THEN BINOP_TAC THENL + [ASM_MESON_TAC[]; + AP_TERM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[valmod] THEN ASM_MESON_TAC[]]));; + +let FORMSUBST_TRIV = prove + (`!p. formsubst V p = p`, + MATCH_MP_TAC form_INDUCT THEN + SIMP_TAC[formsubst; TERMSUBST_TRIV] THEN + REWRITE_TAC[FVT; IN_SING; FV; IN_DELETE] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; VALMOD_REPEAT] THEN + ASM_MESON_TAC[]);; + +let FORMSUBST_TRIVIAL = prove + (`!v p. (!x. x IN FV(p) ==> v x = V x) ==> formsubst v p = p`, + MESON_TAC[FORMSUBST_EQ; FORMSUBST_TRIV]);; + +(* ------------------------------------------------------------------------- *) +(* Predicate ensuring that a substitution will not cause variable renaming. *) +(* ------------------------------------------------------------------------- *) + +let safe_for = new_definition + `safe_for x v <=> !y. x IN FVT(v y) ==> y = x`;; + +let SAFE_FOR_V = prove + (`!x. safe_for x V`, + SIMP_TAC[safe_for; FVT; IN_SING]);; + +let SAFE_FOR_VALMOD = prove + (`!v x y t. safe_for x v /\ (x IN FVT t ==> y = x) + ==> safe_for x ((y |-> t) v)`, + REWRITE_TAC[safe_for; VALMOD] THEN MESON_TAC[]);; + +let SAFE_FOR_ASSIGN = prove + (`!x y t. safe_for x (y |=> t) <=> x IN FVT t ==> y = x`, + REWRITE_TAC[safe_for; ASSIGN] THEN MESON_TAC[FVT; IN_SING]);; + +let FORMSUBST_SAFE_FOR = prove + (`(!v x p. safe_for x v + ==> formsubst v (!! x p) = !!x (formsubst ((x |-> V x) v) p)) /\ + (!v x p. safe_for x v + ==> formsubst v (?? x p) = ??x (formsubst ((x |-> V x) v) p))`, + REWRITE_TAC[safe_for; formsubst; LET_DEF; LET_END_DEF; FV] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Quasi-substitution. *) +(* ------------------------------------------------------------------------- *) + +let qsubst = new_definition + `qsubst (x,t) p = ??x (V x === t && p)`;; + +let FV_QSUBST = prove + (`!x n p. FV(qsubst (x,t) p) = (FV(p) UNION FVT(t)) DELETE x`, + REWRITE_TAC[qsubst; FV; FVT] THEN SET_TAC[]);; + +let HOLDS_QSUBST = prove + (`!v t p v. ~(x IN FVT(t)) + ==> (holds v (qsubst (x,t) p) <=> + holds ((x |-> termval v t) v) p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!v z. termval ((x |-> z) v) t = termval v t` ASSUME_TAC THENL + [REWRITE_TAC[valmod] THEN ASM_MESON_TAC[TERMVAL_VALUATION]; + ASM_REWRITE_TAC[holds; qsubst; termval; VALMOD_BASIC; UNWIND_THM2]]);; + +(* ------------------------------------------------------------------------- *) +(* The numeral mapping. *) +(* ------------------------------------------------------------------------- *) + +let numeral = new_recursive_definition num_RECURSION + `(numeral 0 = Z) /\ + (!n. numeral (SUC n) = Suc(numeral n))`;; + +let TERMVAL_NUMERAL = prove + (`!v n. termval v (numeral n) = n`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[termval;numeral]);; + +let FVT_NUMERAL = prove + (`!n. FVT(numeral n) = {}`, + INDUCT_TAC THEN ASM_REWRITE_TAC[FVT; numeral]);; + +(* ------------------------------------------------------------------------- *) +(* Closed-ness. *) +(* ------------------------------------------------------------------------- *) + +let closed = new_definition + `closed p <=> (FV p = {})`;; diff --git a/Arithmetic/godel.ml b/Arithmetic/godel.ml new file mode 100644 index 0000000..ce3eac4 --- /dev/null +++ b/Arithmetic/godel.ml @@ -0,0 +1,531 @@ +(* ========================================================================= *) +(* Godel's theorem in its true form. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Classes of formulas, via auxiliary "shared" inductive definition. *) +(* ------------------------------------------------------------------------- *) + +let sigmapi_RULES,sigmapi_INDUCT,sigmapi_CASES = new_inductive_definition + `(!b n. sigmapi b n False) /\ + (!b n. sigmapi b n True) /\ + (!b n s t. sigmapi b n (s === t)) /\ + (!b n s t. sigmapi b n (s << t)) /\ + (!b n s t. sigmapi b n (s <<= t)) /\ + (!b n p. sigmapi (~b) n p ==> sigmapi b n (Not p)) /\ + (!b n p q. sigmapi b n p /\ sigmapi b n q ==> sigmapi b n (p && q)) /\ + (!b n p q. sigmapi b n p /\ sigmapi b n q ==> sigmapi b n (p || q)) /\ + (!b n p q. sigmapi (~b) n p /\ sigmapi b n q ==> sigmapi b n (p --> q)) /\ + (!b n p q. (!b. sigmapi b n p) /\ (!b. sigmapi b n q) + ==> sigmapi b n (p <-> q)) /\ + (!n x p. sigmapi T n p /\ ~(n = 0) ==> sigmapi T n (??x p)) /\ + (!n x p. sigmapi F n p /\ ~(n = 0) ==> sigmapi F n (!!x p)) /\ + (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) + ==> sigmapi b n (??x (V x << t && p))) /\ + (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) + ==> sigmapi b n (??x (V x <<= t && p))) /\ + (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) + ==> sigmapi b n (!!x (V x << t --> p))) /\ + (!b n x p t. sigmapi b n p /\ ~(x IN FVT t) + ==> sigmapi b n (!!x (V x <<= t --> p))) /\ + (!b c n p. sigmapi b n p ==> sigmapi c (n + 1) p)`;; + +let SIGMA = new_definition `SIGMA = sigmapi T`;; +let PI = new_definition `PI = sigmapi F`;; +let DELTA = new_definition `DELTA n p <=> SIGMA n p /\ PI n p`;; + +let SIGMAPI_PROP = prove + (`(!n b. sigmapi b n False <=> T) /\ + (!n b. sigmapi b n True <=> T) /\ + (!n b s t. sigmapi b n (s === t) <=> T) /\ + (!n b s t. sigmapi b n (s << t) <=> T) /\ + (!n b s t. sigmapi b n (s <<= t) <=> T) /\ + (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\ + (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\ + (sigmapi b n q /\ sigmapi (~b) n q))`, + REWRITE_TAC[sigmapi_RULES] THEN + GEN_REWRITE_TAC DEPTH_CONV [AND_FORALL_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_SUB1] THEN + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN + REWRITE_TAC[form_DISTINCT; form_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1; + FORALL_BOOL_THM] THEN + REWRITE_TAC[ARITH_RULE `~(0 = n + 1)`] THEN + REWRITE_TAC[ARITH_RULE `(SUC m = n + 1) <=> (n = m)`; UNWIND_THM2] THEN + ASM_REWRITE_TAC[] THEN + BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[ADD1] THEN + REWRITE_TAC[CONJ_ACI] THEN + REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN + MESON_TAC[sigmapi_RULES]);; + +let SIGMAPI_MONO_LEMMA = prove + (`(!b n p. sigmapi b n p ==> sigmapi b (n + 1) p) /\ + (!b n p. ~(n = 0) /\ sigmapi b (n - 1) p ==> sigmapi b n p) /\ + (!b n p. ~(n = 0) /\ sigmapi (~b) (n - 1) p ==> sigmapi b n p)`, + CONJ_TAC THENL + [REPEAT STRIP_TAC; + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> (n = (n - 1) + 1)`))] THEN + POP_ASSUM MP_TAC THEN ASM_MESON_TAC[sigmapi_RULES]);; + +let SIGMAPI_REV_EXISTS = prove + (`!n b x p. sigmapi b n (??x p) ==> sigmapi b n p`, + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN + REWRITE_TAC[form_DISTINCT; form_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIGMAPI_PROP] THEN + ASM_MESON_TAC[ARITH_RULE `n < n + 1`; sigmapi_RULES]);; + +let SIGMAPI_REV_FORALL = prove + (`!n b x p. sigmapi b n (!!x p) ==> sigmapi b n p`, + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN + REWRITE_TAC[form_DISTINCT; form_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIGMAPI_PROP] THEN + ASM_MESON_TAC[ARITH_RULE `n < n + 1`; sigmapi_RULES]);; + +let SIGMAPI_CLAUSES_CODE = prove + (`(!n b. sigmapi b n False <=> T) /\ + (!n b. sigmapi b n True <=> T) /\ + (!n b s t. sigmapi b n (s === t) <=> T) /\ + (!n b s t. sigmapi b n (s << t) <=> T) /\ + (!n b s t. sigmapi b n (s <<= t) <=> T) /\ + (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\ + (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\ + (sigmapi b n q /\ sigmapi (~b) n q)) /\ + (!n b x p. sigmapi b n (??x p) <=> + if b /\ ~(n = 0) \/ + ?q t. (p = (V x << t && q) \/ p = (V x <<= t && q)) /\ + ~(x IN FVT t) + then sigmapi b n p + else ~(n = 0) /\ sigmapi (~b) (n - 1) (??x p)) /\ + (!n b x p. sigmapi b n (!!x p) <=> + if ~b /\ ~(n = 0) \/ + ?q t. (p = (V x << t --> q) \/ p = (V x <<= t --> q)) /\ + ~(x IN FVT t) + then sigmapi b n p + else ~(n = 0) /\ sigmapi (~b) (n - 1) (!!x p))`, + REWRITE_TAC[SIGMAPI_PROP] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [sigmapi_CASES] THEN + REWRITE_TAC[form_DISTINCT; form_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + ONCE_REWRITE_TAC[TAUT `a \/ b \/ c \/ d <=> (b \/ c) \/ (a \/ d)`] THEN + REWRITE_TAC[CONJ_ASSOC; OR_EXISTS_THM; GSYM RIGHT_OR_DISTRIB] THEN + REWRITE_TAC[TAUT + `(if b /\ c \/ d then e else c /\ f) <=> + d /\ e \/ c /\ ~d /\ (if b then e else f)`] THEN + MATCH_MP_TAC(TAUT `(a <=> a') /\ (~a' ==> (b <=> b')) + ==> (a \/ b <=> a' \/ b')`) THEN + (CONJ_TAC THENL + [REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[SIGMAPI_PROP] THEN + SIMP_TAC[]; + ALL_TAC]) THEN + (ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH_RULE `~(0 = n + 1)`]) THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> (n = m + 1 <=> m = n - 1)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + W(fun (asl,w) -> ASM_CASES_TAC (find_term is_exists w)) THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THENL + [DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_EXISTS)) THEN + DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN + ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]; + ASM_CASES_TAC `b:bool` THEN + ASM_REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THENL + [DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_EXISTS)) THEN + DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN + ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]; + REWRITE_TAC[EXISTS_BOOL_THM] THEN + REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN + ONCE_REWRITE_TAC[sigmapi_CASES] THEN + REWRITE_TAC[form_DISTINCT; form_INJ] THEN ASM_MESON_TAC[]]; + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_FORALL)) THEN + DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN + ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]; + ASM_CASES_TAC `b:bool` THEN + ASM_REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THENL + [REWRITE_TAC[EXISTS_BOOL_THM] THEN + REWRITE_TAC[TAUT `(a \/ b <=> a) <=> (b ==> a)`] THEN + ONCE_REWRITE_TAC[sigmapi_CASES] THEN + REWRITE_TAC[form_DISTINCT; form_INJ] THEN ASM_MESON_TAC[]; + DISCH_THEN(CHOOSE_THEN(MP_TAC o MATCH_MP SIGMAPI_REV_FORALL)) THEN + DISCH_THEN(MP_TAC o MATCH_MP(last(CONJUNCTS sigmapi_RULES))) THEN + ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `~(n = 0) ==> 1 <= n`]]]);; + +let SIGMAPI_CLAUSES = prove + (`(!n b. sigmapi b n False <=> T) /\ + (!n b. sigmapi b n True <=> T) /\ + (!n b s t. sigmapi b n (s === t) <=> T) /\ + (!n b s t. sigmapi b n (s << t) <=> T) /\ + (!n b s t. sigmapi b n (s <<= t) <=> T) /\ + (!n b p. sigmapi b n (Not p) <=> sigmapi (~b) n p) /\ + (!n b p q. sigmapi b n (p && q) <=> sigmapi b n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p || q) <=> sigmapi b n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p --> q) <=> sigmapi (~b) n p /\ sigmapi b n q) /\ + (!n b p q. sigmapi b n (p <-> q) <=> (sigmapi b n p /\ sigmapi (~b) n p) /\ + (sigmapi b n q /\ sigmapi (~b) n q)) /\ + (!n b x p. sigmapi b n (??x p) <=> + if b /\ ~(n = 0) \/ + ?q t. (p = (V x << t && q) \/ p = (V x <<= t && q)) /\ + ~(x IN FVT t) + then sigmapi b n p + else 2 <= n /\ sigmapi (~b) (n - 1) p) /\ + (!n b x p. sigmapi b n (!!x p) <=> + if ~b /\ ~(n = 0) \/ + ?q t. (p = (V x << t --> q) \/ p = (V x <<= t --> q)) /\ + ~(x IN FVT t) + then sigmapi b n p + else 2 <= n /\ sigmapi (~b) (n - 1) p)`, + REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [SIGMAPI_CLAUSES_CODE] THEN + REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[ARITH] THEN + BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [SIGMAPI_CLAUSES_CODE] THEN + ASM_REWRITE_TAC[ARITH_RULE `~(n - 1 = 0) <=> 2 <= n`] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Show that it respects substitution. *) +(* ------------------------------------------------------------------------- *) + +let SIGMAPI_FORMSUBST = prove + (`!p v n b. sigmapi b n p ==> sigmapi b n (formsubst v p)`, + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[SIGMAPI_CLAUSES; formsubst] THEN SIMP_TAC[] THEN + REWRITE_TAC[AND_FORALL_THM] THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN + MATCH_MP_TAC(TAUT `(a ==> b /\ c) ==> (a ==> b) /\ (a ==> c)`) THEN + DISCH_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`i:num->term`; `n:num`; `b:bool`] THEN + REWRITE_TAC[FV] THEN LET_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[SIGMAPI_CLAUSES] THEN + ONCE_REWRITE_TAC[TAUT + `((if p \/ q then x else y) ==> (if p \/ q' then x' else y')) <=> + (p /\ x ==> x') /\ + (~p ==> (if q then x else y) ==> (if q' then x' else y'))`] THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN + CONJ_TAC THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(TAUT + `(p ==> p') /\ (x ==> x') /\ (y ==> y') /\ (y ==> x) + ==> (if p then x else y) ==> (if p' then x' else y')`) THEN + ASM_SIMP_TAC[SIGMAPI_MONO_LEMMA; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[formsubst; form_INJ; termsubst] THEN + REWRITE_TAC[form_DISTINCT] THEN + ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ d <=> b /\ c /\ a /\ d`] THEN + REWRITE_TAC[UNWIND_THM1; termsubst; VALMOD_BASIC] THEN + REWRITE_TAC[TERMSUBST_FVT; IN_ELIM_THM; NOT_EXISTS_THM] THEN + X_GEN_TAC `y:num` THEN REWRITE_TAC[valmod] THEN + (COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [SYM th]) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[FV; FVT] THEN + REWRITE_TAC[IN_DELETE; IN_UNION; IN_SING; GSYM DISJ_ASSOC] THEN + REWRITE_TAC[TAUT `(a \/ b \/ c) /\ ~a <=> ~a /\ b \/ ~a /\ c`] THEN + (COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN + W(fun (asl,w) -> let t = lhand(rand w) in + MP_TAC(SPEC (rand(rand t)) VARIANT_THM) THEN + SPEC_TAC(t,`u:num`)) THEN + REWRITE_TAC[CONTRAPOS_THM; FORMSUBST_FV; IN_ELIM_THM; FV] THEN + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `y:num` THEN + ASM_REWRITE_TAC[valmod; IN_UNION]);; + +(* ------------------------------------------------------------------------- *) +(* Hence all our main concepts are OK. *) +(* ------------------------------------------------------------------------- *) + +let SIGMAPI_TAC ths = + REPEAT STRIP_TAC THEN + REWRITE_TAC ths THEN + TRY(MATCH_MP_TAC SIGMAPI_FORMSUBST) THEN + let ths' = ths @ [SIGMAPI_CLAUSES; form_DISTINCT; + form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; GSYM EXISTS_REFL; + FVT; IN_SING; ARITH_EQ] in + REWRITE_TAC ths' THEN ASM_SIMP_TAC ths';; + +let SIGMAPI_DIVIDES = prove + (`!n s t. sigmapi b n (arith_divides s t)`, + SIGMAPI_TAC[arith_divides]);; + +let SIGMAPI_PRIME = prove + (`!n t. sigmapi b n (arith_prime t)`, + SIGMAPI_TAC[arith_prime; SIGMAPI_DIVIDES]);; + +let SIGMAPI_PRIMEPOW = prove + (`!n s t. sigmapi b n (arith_primepow s t)`, + SIGMAPI_TAC[arith_primepow; SIGMAPI_DIVIDES; SIGMAPI_PRIME]);; + +let SIGMAPI_RTC = prove + (`(!s t. sigmapi T 1 (R s t)) + ==> !s t. sigmapi T 1 (arith_rtc R s t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[arith_rtc] THEN + MATCH_MP_TAC SIGMAPI_FORMSUBST THEN + REWRITE_TAC[SIGMAPI_CLAUSES; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; + GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ; SIGMAPI_DIVIDES; + SIGMAPI_PRIME; SIGMAPI_PRIMEPOW; form_DISTINCT] THEN + ASM_REWRITE_TAC[]);; + +let SIGMAPI_RTCP = prove + (`(!s t u. sigmapi T 1 (R s t u)) + ==> !s t u. sigmapi T 1 (arith_rtcp R s t u)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[arith_rtcp] THEN + MATCH_MP_TAC SIGMAPI_FORMSUBST THEN + REWRITE_TAC[SIGMAPI_CLAUSES; form_INJ; GSYM CONJ_ASSOC; UNWIND_THM1; + GSYM EXISTS_REFL; FVT; IN_SING; ARITH_EQ; SIGMAPI_DIVIDES; + SIGMAPI_PRIME; SIGMAPI_PRIMEPOW; form_DISTINCT] THEN + ASM_REWRITE_TAC[]);; + +let SIGMAPI_TERM1 = prove + (`!s t. sigmapi T 1 (arith_term1 s t)`, + SIGMAPI_TAC[arith_term1]);; + +let SIGMAPI_TERM = prove + (`!t. sigmapi T 1 (arith_term t)`, + SIGMAPI_TAC[arith_term; SIGMAPI_RTC; SIGMAPI_TERM1]);; + +let SIGMAPI_FORM1 = prove + (`!s t. sigmapi T 1 (arith_form1 s t)`, + SIGMAPI_TAC[arith_form1; SIGMAPI_TERM]);; + +let SIGMAPI_FORM = prove + (`!t. sigmapi T 1 (arith_form t)`, + SIGMAPI_TAC[arith_form; SIGMAPI_RTC; SIGMAPI_FORM1]);; + +let SIGMAPI_FREETERM1 = prove + (`!s t u. sigmapi T 1 (arith_freeterm1 s t u)`, + SIGMAPI_TAC[arith_freeterm1]);; + +let SIGMAPI_FREETERM = prove + (`!s t. sigmapi T 1 (arith_freeterm s t)`, + SIGMAPI_TAC[arith_freeterm; SIGMAPI_FREETERM1; SIGMAPI_RTCP]);; + +let SIGMAPI_FREEFORM1 = prove + (`!s t u. sigmapi T 1 (arith_freeform1 s t u)`, + SIGMAPI_TAC[arith_freeform1; SIGMAPI_FREETERM; SIGMAPI_FORM]);; + +let SIGMAPI_FREEFORM = prove + (`!s t. sigmapi T 1 (arith_freeform s t)`, + SIGMAPI_TAC[arith_freeform; SIGMAPI_FREEFORM1; SIGMAPI_RTCP]);; + +let SIGMAPI_AXIOM = prove + (`!t. sigmapi T 1 (arith_axiom t)`, + SIGMAPI_TAC[arith_axiom; SIGMAPI_FREEFORM; SIGMAPI_FREETERM; SIGMAPI_FORM; + SIGMAPI_TERM]);; + +let SIGMAPI_PROV1 = prove + (`!A. (!t. sigmapi T 1 (A t)) ==> !s t. sigmapi T 1 (arith_prov1 A s t)`, + SIGMAPI_TAC[arith_prov1; SIGMAPI_AXIOM]);; + +let SIGMAPI_PROV = prove + (`(!t. sigmapi T 1 (A t)) ==> !t. sigmapi T 1 (arith_prov A t)`, + SIGMAPI_TAC[arith_prov; SIGMAPI_PROV1; SIGMAPI_RTC]);; + +let SIGMAPI_PRIMRECSTEP = prove + (`(!s t u. sigmapi T 1 (R s t u)) + ==> !s t. sigmapi T 1 (arith_primrecstep R s t)`, + SIGMAPI_TAC[arith_primrecstep]);; + +let SIGMAPI_PRIMREC = prove + (`(!s t u. sigmapi T 1 (R s t u)) + ==> !s t. sigmapi T 1 (arith_primrec R c s t)`, + SIGMAPI_TAC[arith_primrec; SIGMAPI_PRIMRECSTEP; SIGMAPI_RTC]);; + +let SIGMAPI_GNUMERAL1 = prove + (`!s t. sigmapi T 1 (arith_gnumeral1 s t)`, + SIGMAPI_TAC[arith_gnumeral1]);; + +let SIGMAPI_GNUMERAL = prove + (`!s t. sigmapi T 1 (arith_gnumeral s t)`, + SIGMAPI_TAC[arith_gnumeral; arith_gnumeral1'; + SIGMAPI_GNUMERAL1; SIGMAPI_RTC]);; + +let SIGMAPI_QSUBST = prove + (`!x n p. sigmapi T 1 p ==> sigmapi T 1 (qsubst(x,n) p)`, + SIGMAPI_TAC[qsubst]);; + +let SIGMAPI_QDIAG = prove + (`!x s t. sigmapi T 1 (arith_qdiag x s t)`, + SIGMAPI_TAC[arith_qdiag; SIGMAPI_GNUMERAL]);; + +let SIGMAPI_DIAGONALIZE = prove + (`!x p. sigmapi T 1 p ==> sigmapi T 1 (diagonalize x p)`, + SIGMAPI_TAC[diagonalize; SIGMAPI_QDIAG; + SIGMAPI_FORMSUBST; LET_DEF; LET_END_DEF]);; + +let SIGMAPI_FIXPOINT = prove + (`!x p. sigmapi T 1 p ==> sigmapi T 1 (fixpoint x p)`, + SIGMAPI_TAC[fixpoint; qdiag; SIGMAPI_QSUBST; SIGMAPI_DIAGONALIZE]);; + +(* ------------------------------------------------------------------------- *) +(* The Godel sentence, "H" being Sigma and "G" being Pi. *) +(* ------------------------------------------------------------------------- *) + +let hsentence = new_definition + `hsentence Arep = + fixpoint 0 (arith_prov Arep (arith_pair (numeral 4) (V 0)))`;; + +let gsentence = new_definition + `gsentence Arep = Not(hsentence Arep)`;; + +let FV_HSENTENCE = prove + (`!Arep. (!t. FV(Arep t) = FVT t) ==> (FV(hsentence Arep) = {})`, + SIMP_TAC[hsentence; FV_FIXPOINT; FV_PROV] THEN + REWRITE_TAC[FVT_PAIR; FVT_NUMERAL; FVT; UNION_EMPTY; DELETE_INSERT; + EMPTY_DELETE]);; + +let FV_GSENTENCE = prove + (`!Arep. (!t. FV(Arep t) = FVT t) ==> (FV(gsentence Arep) = {})`, + SIMP_TAC[gsentence; FV_HSENTENCE; FV]);; + +let SIGMAPI_HSENTENCE = prove + (`!Arep. (!t. sigmapi T 1 (Arep t)) ==> sigmapi T 1 (hsentence Arep)`, + SIGMAPI_TAC[hsentence; SIGMAPI_FIXPOINT; SIGMAPI_PROV]);; + +let SIGMAPI_GSENTENCE = prove + (`!Arep. (!t. sigmapi T 1 (Arep t)) ==> sigmapi F 1 (gsentence Arep)`, + SIGMAPI_TAC[gsentence; SIGMAPI_HSENTENCE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the key fixpoint properties. *) +(* ------------------------------------------------------------------------- *) + +let HSENTENCE_FIX_STRONG = prove + (`!A Arep. + (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A) + ==> !v. holds v (hsentence Arep) <=> A |-- Not(hsentence Arep)`, + REWRITE_TAC[hsentence; true_def; HOLDS_FIXPOINT] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ARITH_PROV) THEN + REWRITE_TAC[IN] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + DISCH_TAC THEN ASM_REWRITE_TAC[ARITH_PAIR; TERMVAL_NUMERAL] THEN + REWRITE_TAC[termval; valmod; GSYM gform] THEN REWRITE_TAC[PROV_THM]);; + +let HSENTENCE_FIX = prove + (`!A Arep. + (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A) + ==> (true(hsentence Arep) <=> A |-- Not(hsentence Arep))`, + REWRITE_TAC[true_def] THEN MESON_TAC[HSENTENCE_FIX_STRONG]);; + +let GSENTENCE_FIX = prove + (`!A Arep. + (!v t. holds v (Arep t) <=> (termval v t) IN IMAGE gform A) + ==> (true(gsentence Arep) <=> ~(A |-- gsentence Arep))`, + REWRITE_TAC[true_def; holds; gsentence] THEN + MESON_TAC[HSENTENCE_FIX_STRONG]);; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary concepts. *) +(* ------------------------------------------------------------------------- *) + +let ground = new_definition + `ground t <=> (FVT t = {})`;; + +let complete_for = new_definition + `complete_for P A <=> !p. P p /\ true p ==> A |-- p`;; + +let sound_for = new_definition + `sound_for P A <=> !p. P p /\ A |-- p ==> true p`;; + +let consistent = new_definition + `consistent A <=> ~(?p. A |-- p /\ A |-- Not p)`;; + +let CONSISTENT_ALT = prove + (`!A p. A |-- p /\ A |-- Not p <=> A |-- False`, + MESON_TAC[proves_RULES; axiom_RULES]);; + +(* ------------------------------------------------------------------------- *) +(* The purest and most symmetric and beautiful form of G1. *) +(* ------------------------------------------------------------------------- *) + +let DEFINABLE_BY_ONEVAR = prove + (`definable_by (SIGMA 1) s <=> + ?p x. SIGMA 1 p /\ (FV p = {x}) /\ !v. holds v p <=> (v x) IN s`, + REWRITE_TAC[definable_by; SIGMA] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `p:form` (X_CHOOSE_TAC `x:num`)) THEN + EXISTS_TAC `(V x === V x) && formsubst (\y. if y = x then V x else Z) p` THEN + EXISTS_TAC `x:num` THEN ASM_SIMP_TAC[SIGMAPI_CLAUSES; SIGMAPI_FORMSUBST] THEN + ASM_REWRITE_TAC[HOLDS_FORMSUBST; FORMSUBST_FV; FV; holds] THEN + REWRITE_TAC[COND_RAND; EXTENSION; IN_ELIM_THM; IN_SING; FVT; IN_UNION; + COND_EXPAND; NOT_IN_EMPTY; o_THM; termval] THEN + MESON_TAC[]);; + +let CLOSED_NOT_TRUE = prove + (`!p. closed p ==> (true(Not p) <=> ~(true p))`, + REWRITE_TAC[closed; true_def; holds] THEN + MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);; + +let G1 = prove + (`!A. definable_by (SIGMA 1) (IMAGE gform A) + ==> ?G. PI 1 G /\ closed G /\ + (sound_for (PI 1 INTER closed) A ==> true G /\ ~(A |-- G)) /\ + (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`, + GEN_TAC THEN + REWRITE_TAC[sound_for; INTER; IN_ELIM_THM; DEFINABLE_BY_ONEVAR] THEN + DISCH_THEN(X_CHOOSE_THEN `Arep:form` (X_CHOOSE_THEN `a:num` + STRIP_ASSUME_TAC)) THEN + MP_TAC(SPECL [`A:form->bool`; `\t. formsubst ((a |-> t) V) Arep`] + GSENTENCE_FIX) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[HOLDS_FORMSUBST] THEN REWRITE_TAC[termval; valmod; o_THM]; + ALL_TAC] THEN + STRIP_TAC THEN EXISTS_TAC `gsentence (\t. formsubst ((a |-> t) V) Arep)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c /\ d) ==> a /\ b /\ c /\ d`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[PI] THEN MATCH_MP_TAC SIGMAPI_GSENTENCE THEN + RULE_ASSUM_TAC(REWRITE_RULE[SIGMA]) THEN ASM_SIMP_TAC[SIGMAPI_FORMSUBST]; + REWRITE_TAC[closed] THEN MATCH_MP_TAC FV_GSENTENCE THEN + ASM_REWRITE_TAC[FORMSUBST_FV; EXTENSION; IN_ELIM_THM; IN_SING; + valmod; UNWIND_THM2]; + ALL_TAC] THEN + ABBREV_TAC `G = gsentence (\t. formsubst ((a |-> t) V) Arep)` THEN + REPEAT STRIP_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN + SUBGOAL_THEN `true(Not G)` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN + REWRITE_TAC[SIGMA; SIGMAPI_CLAUSES] THEN ASM_MESON_TAC[closed; FV; PI]; + ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP CLOSED_NOT_TRUE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `true False` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[true_def; holds]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[closed; IN; SIGMA; SIGMAPI_CLAUSES; FV] THEN + ASM_MESON_TAC[CONSISTENT_ALT]);; + +(* ------------------------------------------------------------------------- *) +(* Some more familiar variants. *) +(* ------------------------------------------------------------------------- *) + +let COMPLETE_SOUND_SENTENCE = prove + (`consistent A /\ complete_for (sigmapi (~b) n INTER closed) A + ==> sound_for (sigmapi b n INTER closed) A`, + REWRITE_TAC[consistent; sound_for; complete_for; IN; INTER; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> X_GEN_TAC `p:form` THEN MP_TAC(SPEC `Not p` th)) THEN + REWRITE_TAC[SIGMAPI_CLAUSES] THEN + REWRITE_TAC[closed; FV; true_def; holds] THEN + ASM_MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);; + +let G1_TRAD = prove + (`!A. consistent A /\ + complete_for (SIGMA 1 INTER closed) A /\ + definable_by (SIGMA 1) (IMAGE gform A) + ==> ?G. PI 1 G /\ closed G /\ true G /\ ~(A |-- G) /\ + (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`, + REWRITE_TAC[SIGMA] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `A:form->bool` G1) THEN ASM_REWRITE_TAC[SIGMA; PI] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[COMPLETE_SOUND_SENTENCE]);; diff --git a/Arithmetic/make.ml b/Arithmetic/make.ml new file mode 100644 index 0000000..f3c66df --- /dev/null +++ b/Arithmetic/make.ml @@ -0,0 +1,30 @@ +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Some additional mathematical background. *) +(* ------------------------------------------------------------------------- *) + +loadt "Library/rstc.ml";; +loadt "Library/prime.ml";; + +(* ------------------------------------------------------------------------- *) +(* The basics of first order logic and our inference system. *) +(* ------------------------------------------------------------------------- *) + +loadt "Arithmetic/fol.ml";; + +(* ------------------------------------------------------------------------- *) +(* The incompleteness results. *) +(* ------------------------------------------------------------------------- *) + +loadt "Arithmetic/definability.ml";; +loadt "Arithmetic/tarski.ml";; +loadt "Arithmetic/arithprov.ml";; +loadt "Arithmetic/godel.ml";; + +(* ------------------------------------------------------------------------- *) +(* Sigma-1 completeness of Robinson arithmetic. *) +(* ------------------------------------------------------------------------- *) + +loadt "Arithmetic/derived.ml";; +loadt "Arithmetic/sigmacomplete.ml";; diff --git a/Arithmetic/pa.ml b/Arithmetic/pa.ml new file mode 100644 index 0000000..8bd35c7 --- /dev/null +++ b/Arithmetic/pa.ml @@ -0,0 +1,73 @@ +(* ========================================================================= *) +(* Two interesting axiom systems: full Peano Arithmetic and Robinson's Q. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* We define PA as an "inductive" predicate because the pattern-matching *) +(* is a bit nicer, but of course we could just define the term explicitly. *) +(* In effect, the returned PA_CASES would be our explicit definition. *) +(* *) +(* The induction axiom is done a little strangely in order to avoid using *) +(* substitution as a primitive concept. *) +(* ------------------------------------------------------------------------- *) + +let PA_RULES,PA_INDUCT,PA_CASES = new_inductive_definition + `(!s. PA(Not (Z === Suc(s)))) /\ + (!s t. PA(Suc(s) === Suc(t) --> s === t)) /\ + (!t. PA(t ++ Z === t)) /\ + (!s t. PA(s ++ Suc(t) === Suc(s ++ t))) /\ + (!t. PA(t ** Z === Z)) /\ + (!s t. PA(s ** Suc(t) === s ** t ++ s)) /\ + (!p i j. ~(j IN FV(p)) + ==> PA + ((??i (V i === Z && p)) && + (!!j (??i (V i === V j && p) + --> ??i (V i === Suc(V j) && p))) + --> !!i p))`;; + +let PA_SOUND = prove + (`!A p. (!a. a IN A ==> true a) /\ (PA UNION A) |-- p ==> true p`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC THEOREMS_TRUE THEN + EXISTS_TAC `PA UNION A` THEN + ASM_SIMP_TAC[IN_UNION; TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[IN] THEN MATCH_MP_TAC PA_INDUCT THEN + REWRITE_TAC[true_def; holds; termval] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; EXP; SUC_INJ; NOT_SUC] THEN ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`q:form`; `i:num`; `j:num`] THEN + ASM_CASES_TAC `j:num = i` THEN + ASM_REWRITE_TAC[VALMOD; VALMOD_VALMOD_BASIC] THEN + SIMP_TAC[HOLDS_VALMOD_OTHER] THENL [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[UNWIND_THM2] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!a b v. holds ((i |-> a) ((j |-> b) v)) q <=> holds ((i |-> a) v) q` + (fun th -> REWRITE_TAC[th]) + THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLDS_VALUATION THEN + ASM_REWRITE_TAC[valmod] THEN ASM_MESON_TAC[]; + GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Robinson's axiom system Q. *) +(* *) +(* <<(forall m n. S(m) = S(n) ==> m = n) /\ *) +(* (forall n. ~(n = 0) <=> exists m. n = S(m)) /\ *) +(* (forall n. 0 + n = n) /\ *) +(* (forall m n. S(m) + n = S(m + n)) /\ *) +(* (forall n. 0 * n = 0) /\ *) +(* (forall m n. S(m) * n = n + m * n) /\ *) +(* (forall m n. m <= n <=> exists d. m + d = n) /\ *) +(* (forall m n. m < n <=> S(m) <= n)>>;; *) +(* ------------------------------------------------------------------------- *) + +let robinson = new_definition + `robinson = + (!!0 (!!1 (Suc(V 0) === Suc(V 1) --> V 0 === V 1))) && + (!!1 (Not(V 1 === Z) <-> ??0 (V 1 === Suc(V 0)))) && + (!!1 (Z ++ V 1 === V 1)) && + (!!0 (!!1 (Suc(V 0) ++ V 1 === Suc(V 0 ++ V 1)))) && + (!!1 (Z ** V 1 === Z)) && + (!!0 (!!1 (Suc(V 0) ** V 1 === V 1 ++ V 0 ** V 1))) && + (!!0 (!!1 (V 0 <<= V 1 <-> ??2 (V 0 ++ V 2 === V 1)))) && + (!!0 (!!1 (V 0 << V 1 <-> Suc(V 0) <<= V 1)))`;; diff --git a/Arithmetic/sigmacomplete.ml b/Arithmetic/sigmacomplete.ml new file mode 100644 index 0000000..b56ae16 --- /dev/null +++ b/Arithmetic/sigmacomplete.ml @@ -0,0 +1,681 @@ +(* ========================================================================= *) +(* Sigma_1 completeness of Robinson's axioms Q. *) +(* ========================================================================= *) + +let robinson = new_definition + `robinson = + (!!0 (!!1 (Suc(V 0) === Suc(V 1) --> V 0 === V 1))) && + (!!1 (Not(V 1 === Z) <-> ??0 (V 1 === Suc(V 0)))) && + (!!1 (Z ++ V 1 === V 1)) && + (!!0 (!!1 (Suc(V 0) ++ V 1 === Suc(V 0 ++ V 1)))) && + (!!1 (Z ** V 1 === Z)) && + (!!0 (!!1 (Suc(V 0) ** V 1 === V 1 ++ V 0 ** V 1))) && + (!!0 (!!1 (V 0 <<= V 1 <-> ??2 (V 0 ++ V 2 === V 1)))) && + (!!0 (!!1 (V 0 << V 1 <-> Suc(V 0) <<= V 1)))`;; + +(* ------------------------------------------------------------------------- *) +(* Individual "axioms" and their instances. *) +(* ------------------------------------------------------------------------- *) + +let [suc_inj; num_cases; add_0; add_suc; mul_0; mul_suc; le_def; lt_def] = + CONJUNCTS(REWRITE_RULE[META_AND] (GEN_REWRITE_RULE RAND_CONV [robinson] + (MATCH_MP assume (SET_RULE `robinson IN {robinson}`))));; + +let suc_inj' = prove + (`!s t. {robinson} |-- Suc(s) === Suc(t) --> s === t`, + REWRITE_TAC[specl_rule [`s:term`; `t:term`] suc_inj]);; + +let num_cases' = prove + (`!t z. ~(z IN FVT t) + ==> {robinson} |-- (Not(t === Z) <-> ??z (t === Suc(V z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `t:term` (MATCH_MP spec num_cases)) THEN + REWRITE_TAC[formsubst] THEN + CONV_TAC(ONCE_DEPTH_CONV TERMSUBST_CONV) THEN + REWRITE_TAC[FV; FVT; SET_RULE `({1} UNION {0}) DELETE 0 = {1} DIFF {0}`] THEN + REWRITE_TAC[IN_DIFF; IN_SING; UNWIND_THM2; GSYM CONJ_ASSOC; ASSIGN] THEN + REWRITE_TAC[ARITH_EQ] THEN LET_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] iff_trans) THEN + SUBGOAL_THEN `~(z' IN FVT t)` ASSUME_TAC THENL + [EXPAND_TAC "z'" THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> s UNION {a} = s`; + VARIANT_FINITE; FVT_FINITE]; + MATCH_MP_TAC imp_antisym THEN + ASM_CASES_TAC `z':num = z` THEN ASM_REWRITE_TAC[imp_refl] THEN + CONJ_TAC THEN MATCH_MP_TAC ichoose THEN + ASM_REWRITE_TAC[FV; IN_DELETE; IN_UNION; IN_SING; FVT] THEN + MATCH_MP_TAC gen THEN MATCH_MP_TAC imp_trans THENL + [EXISTS_TAC `formsubst (z |=> V z') (t === Suc(V z))`; + EXISTS_TAC `formsubst (z' |=> V z) (t === Suc(V z'))`] THEN + REWRITE_TAC[iexists] THEN REWRITE_TAC[formsubst] THEN + ASM_REWRITE_TAC[termsubst; ASSIGN] THEN + MATCH_MP_TAC(MESON[imp_refl] `p = q ==> A |-- p --> q`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC TERMSUBST_TRIVIAL THEN REWRITE_TAC[ASSIGN] THEN + ASM_MESON_TAC[]]);; + +let add_0' = prove + (`!t. {robinson} |-- Z ++ t === t`, + REWRITE_TAC[spec_rule `t:term` add_0]);; + +let add_suc' = prove + (`!s t. {robinson} |-- Suc(s) ++ t === Suc(s ++ t)`, + REWRITE_TAC[specl_rule [`s:term`; `t:term`] add_suc]);; + +let mul_0' = prove + (`!t. {robinson} |-- Z ** t === Z`, + REWRITE_TAC[spec_rule `t:term` mul_0]);; + +let mul_suc' = prove + (`!s t. {robinson} |-- Suc(s) ** t === t ++ s ** t`, + REWRITE_TAC[specl_rule [`s:term`; `t:term`] mul_suc]);; + +let lt_def' = prove + (`!s t. {robinson} |-- (s << t <-> Suc(s) <<= t)`, + REWRITE_TAC[specl_rule [`s:term`; `t:term`] lt_def]);; + +(* ------------------------------------------------------------------------- *) +(* All ground terms can be evaluated by proof. *) +(* ------------------------------------------------------------------------- *) + +let SIGMA1_COMPLETE_ADD = prove + (`!m n. {robinson} |-- numeral m ++ numeral n === numeral(m + n)`, + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; numeral] THEN + ASM_MESON_TAC[add_0'; add_suc'; axiom_funcong; eq_trans; modusponens]);; + +let SIGMA1_COMPLETE_MUL = prove + (`!m n. {robinson} |-- (numeral m ** numeral n === numeral(m * n))`, + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; numeral] THENL + [ASM_MESON_TAC[mul_0']; ALL_TAC] THEN + GEN_TAC THEN MATCH_MP_TAC eq_trans_rule THEN + EXISTS_TAC `numeral(n) ++ numeral(m * n)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[mul_suc'; eq_trans_rule; axiom_funcong; imp_trans; + modusponens; imp_swap;add_assum; axiom_eqrefl]; + ASM_MESON_TAC[SIGMA1_COMPLETE_ADD; ADD_SYM; eq_trans_rule]]);; + +let SIGMA1_COMPLETE_TERM = prove + (`!v t n. FVT t = {} /\ termval v t = n + ==> {robinson} |-- (t === numeral n)`, + let lemma = prove(`(!n. p /\ (x = n) ==> P n) <=> p ==> P x`,MESON_TAC[]) in + GEN_TAC THEN MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[termval;FVT; NOT_INSERT_EMPTY] THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[numeral] THEN + MESON_TAC[axiom_eqrefl; add_assum]; + ALL_TAC] THEN + REWRITE_TAC[lemma] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + RULE_ASSUM_TAC(REWRITE_RULE[EMPTY_UNION]) THEN ASM_REWRITE_TAC[numeral] THEN + MESON_TAC[SIGMA1_COMPLETE_ADD; SIGMA1_COMPLETE_MUL; + cong_suc; cong_add; cong_mul; eq_trans_rule]);; + +(* ------------------------------------------------------------------------- *) +(* Convenient stepping theorems for atoms and other useful lemmas. *) +(* ------------------------------------------------------------------------- *) + +let canonize_clauses = + let lemma0 = MESON[imp_refl; imp_swap; modusponens; axiom_doubleneg] + `!A p. A |-- (p --> False) --> False <=> A |-- p` + and lemma1 = MESON[iff_imp1; iff_imp2; modusponens; imp_trans] + `A |-- p <-> q + ==> (A |-- p <=> A |-- q) /\ (A |-- p --> False <=> A |-- q --> False)` in + itlist (CONJ o MATCH_MP lemma1 o SPEC_ALL) + [axiom_true; axiom_not; axiom_and; axiom_or; iff_def; axiom_exists] + lemma0 +and false_imp = MESON[imp_truefalse; modusponens] + `A |-- p /\ A |-- q --> False ==> A |-- (p --> q) --> False` +and true_imp = MESON[axiom_addimp; modusponens; ex_falso; imp_trans] + `A |-- p --> False \/ A |-- q ==> A |-- p --> q`;; + +let CANONIZE_TAC = + REWRITE_TAC[canonize_clauses; imp_refl] THEN + REPEAT((MATCH_MP_TAC false_imp THEN CONJ_TAC) ORELSE + MATCH_MP_TAC true_imp THEN + REWRITE_TAC[canonize_clauses; imp_refl]);; + +let suc_inj_eq = prove + (`!s t. {robinson} |-- Suc s === Suc t <-> s === t`, + MESON_TAC[suc_inj'; axiom_funcong; imp_antisym]);; + +let suc_le_eq = prove + (`!s t. {robinson} |-- Suc s <<= Suc t <-> s <<= t`, + gens_tac [0;1] THEN + TRANS_TAC iff_trans `??2 (Suc(V 0) ++ V 2 === Suc(V 1))` THEN + REWRITE_TAC[itlist spec_rule [`Suc(V 1)`; `Suc(V 0)`] le_def] THEN + TRANS_TAC iff_trans `??2 (V 0 ++ V 2 === V 1)` THEN + GEN_REWRITE_TAC RAND_CONV [iff_sym] THEN + REWRITE_TAC[itlist spec_rule [`V 1`; `V 0`] le_def] THEN + MATCH_MP_TAC exiff THEN + TRANS_TAC iff_trans `Suc(V 0 ++ V 2) === Suc(V 1)` THEN + REWRITE_TAC[suc_inj_eq] THEN MATCH_MP_TAC cong_eq THEN + REWRITE_TAC[axiom_eqrefl; add_suc']);; + +let le_iff_lt = prove + (`!s t. {robinson} |-- s <<= t <-> s << Suc t`, + REPEAT GEN_TAC THEN TRANS_TAC iff_trans `Suc s <<= Suc t` THEN + ONCE_REWRITE_TAC[iff_sym] THEN + REWRITE_TAC[suc_le_eq; lt_def']);; + +let suc_lt_eq = prove + (`!s t. {robinson} |-- Suc s << Suc t <-> s << t`, + MESON_TAC[iff_sym; iff_trans; le_iff_lt; lt_def']);; + +let not_suc_eq_0 = prove + (`!t. {robinson} |-- Suc t === Z --> False`, + gen_tac 1 THEN + SUBGOAL_THEN `{robinson} |-- Not(Suc(V 1) === Z)` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[canonize_clauses]] THEN + SUBGOAL_THEN `{robinson} |-- ?? 0 (Suc(V 1) === Suc(V 0))` MP_TAC THENL + [MATCH_MP_TAC exists_intro THEN EXISTS_TAC `V 1` THEN + CONV_TAC(RAND_CONV FORMSUBST_CONV) THEN REWRITE_TAC[axiom_eqrefl]; + MESON_TAC[iff_imp2; modusponens; spec_rule `Suc(V 1)` num_cases]]);; + +let not_suc_le_0 = prove + (`!t. {robinson} |-- Suc t <<= Z --> False`, + X_GEN_TAC `s:term` THEN + SUBGOAL_THEN `{robinson} |-- !!0 (Suc(V 0) <<= Z --> False)` MP_TAC THENL + [ALL_TAC; DISCH_THEN(ACCEPT_TAC o spec_rule `s:term`)] THEN + MATCH_MP_TAC gen THEN + SUBGOAL_THEN `{robinson} |-- ?? 2 (Suc (V 0) ++ V 2 === Z) --> False` + MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN + MATCH_MP_TAC iff_imp1 THEN + ACCEPT_TAC(itlist spec_rule [`Z`; `Suc(V 0)`] le_def)] THEN + MATCH_MP_TAC ichoose THEN REWRITE_TAC[FV; NOT_IN_EMPTY] THEN + MATCH_MP_TAC gen THEN TRANS_TAC imp_trans `Suc(V 0 ++ V 2) === Z` THEN + REWRITE_TAC[not_suc_eq_0] THEN MATCH_MP_TAC iff_imp1 THEN + MATCH_MP_TAC cong_eq THEN REWRITE_TAC[axiom_eqrefl] THEN + REWRITE_TAC[add_suc']);; + +let not_lt_0 = prove + (`!t. {robinson} |-- t << Z --> False`, + MESON_TAC[not_suc_le_0; lt_def'; imp_trans; iff_imp1]);; + +(* ------------------------------------------------------------------------- *) +(* Evaluation of atoms built from numerals by proof. *) +(* ------------------------------------------------------------------------- *) + +let add_0_right = prove + (`!n. {robinson} |-- numeral n ++ Z === numeral n`, + GEN_TAC THEN MP_TAC(ISPECL [`n:num`; `0`] SIGMA1_COMPLETE_ADD) THEN + REWRITE_TAC[numeral; ADD_CLAUSES]);; + +let ATOM_EQ_FALSE = prove + (`!m n. ~(m = n) ==> {robinson} |-- numeral m === numeral n --> False`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [MESON_TAC[eq_sym; imp_trans]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN INDUCT_TAC THEN + REWRITE_TAC[numeral; not_suc_eq_0; LT_SUC; SUC_INJ] THEN + ASM_MESON_TAC[suc_inj_eq; imp_trans; iff_imp1; iff_imp2]);; + +let ATOM_LE_FALSE = prove + (`!m n. n < m ==> {robinson} |-- numeral m <<= numeral n --> False`, + INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN + INDUCT_TAC THEN REWRITE_TAC[numeral; not_suc_le_0; LT_SUC] THEN + ASM_MESON_TAC[suc_le_eq; imp_trans; iff_imp1; iff_imp2]);; + +let ATOM_LT_FALSE = prove + (`!m n. n <= m ==> {robinson} |-- numeral m << numeral n --> False`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LT_SUC_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP ATOM_LE_FALSE) THEN + REWRITE_TAC[numeral] THEN + ASM_MESON_TAC[lt_def'; imp_trans; iff_imp1; iff_imp2]);; + +let ATOM_EQ_TRUE = prove + (`!m n. m = n ==> {robinson} |-- numeral m === numeral n`, + MESON_TAC[axiom_eqrefl]);; + +let ATOM_LE_TRUE = prove + (`!m n. m <= n ==> {robinson} |-- numeral m <<= numeral n`, + SUBGOAL_THEN `!m n. {robinson} |-- numeral m <<= numeral(m + n)` + MP_TAC THENL [ALL_TAC; MESON_TAC[LE_EXISTS]] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC modusponens THEN + EXISTS_TAC `?? 2 (numeral m ++ V 2 === numeral(m + n))` THEN + CONJ_TAC THENL + [MP_TAC(itlist spec_rule [`numeral(m + n)`; `numeral m`] le_def) THEN + MESON_TAC[iff_imp2]; + MATCH_MP_TAC exists_intro THEN EXISTS_TAC `numeral n` THEN + CONV_TAC(RAND_CONV FORMSUBST_CONV) THEN + REWRITE_TAC[SIGMA1_COMPLETE_ADD]]);; + +let ATOM_LT_TRUE = prove + (`!m n. m < n ==> {robinson} |-- numeral m << numeral n`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM LE_SUC_LT] THEN + DISCH_THEN(MP_TAC o MATCH_MP ATOM_LE_TRUE) THEN + REWRITE_TAC[numeral] THEN + ASM_MESON_TAC[lt_def'; modusponens; iff_imp1; iff_imp2]);; + +(* ------------------------------------------------------------------------- *) +(* A kind of case analysis rule; might make it induction in case of PA. *) +(* ------------------------------------------------------------------------- *) + +let FORMSUBST_FORMSUBST_SAME_NONE = prove + (`!s t x p. + FVT t = {x} /\ FVT s = {} + ==> formsubst (x |=> s) (formsubst (x |=> t) p) = + formsubst (x |=> termsubst (x |=> s) t) p`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!y. safe_for y (x |=> termsubst (x |=> s) t)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[SAFE_FOR_ASSIGN; TERMSUBST_FVT; ASSIGN] THEN + ASM SET_TAC[FVT]; + ALL_TAC] THEN + MATCH_MP_TAC form_INDUCT THEN + ASM_SIMP_TAC[FORMSUBST_SAFE_FOR; SAFE_FOR_ASSIGN; IN_SING; NOT_IN_EMPTY] THEN + SIMP_TAC[formsubst] THEN + MATCH_MP_TAC(TAUT `(p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN BINOP_TAC THEN + REWRITE_TAC[TERMSUBST_TERMSUBST] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN X_GEN_TAC `y:num` THEN + REWRITE_TAC[ASSIGN] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[termsubst; ASSIGN]; + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`y:num`; `p:form`] THEN DISCH_TAC THEN + (ASM_CASES_TAC `y:num = x` THENL + [ASM_REWRITE_TAC[assign; VALMOD_VALMOD_BASIC] THEN + SIMP_TAC[VALMOD_TRIVIAL; FORMSUBST_TRIV]; + SUBGOAL_THEN `!u. (y |-> V y) (x |=> u) = (x |=> u)` + (fun th -> ASM_REWRITE_TAC[th]) THEN + GEN_TAC THEN MATCH_MP_TAC VALMOD_TRIVIAL THEN + ASM_REWRITE_TAC[ASSIGN]])]);; + +let num_cases_rule = prove + (`!p x. {robinson} |-- formsubst (x |=> Z) p /\ + {robinson} |-- formsubst (x |=> Suc(V x)) p + ==> {robinson} |-- p`, + let lemma = prove + (`!A p x t. A |-- formsubst (x |=> t) p ==> A |-- V x === t --> p`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] modusponens) THEN + MATCH_MP_TAC imp_swap THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM FORMSUBST_TRIV] THEN + CONV_TAC(funpow 3 RAND_CONV(SUBS_CONV[SYM(SPEC `x:num` ASSIGN_TRIV)])) THEN + TRANS_TAC imp_trans `t === V x` THEN REWRITE_TAC[isubst; eq_sym]) in + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM FORMSUBST_TRIV] THEN + CONV_TAC(RAND_CONV(SUBS_CONV[SYM(SPEC `x:num` ASSIGN_TRIV)])) THEN + SUBGOAL_THEN `?z. ~(z = x) /\ ~(z IN VARS p)` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `VARIANT(x INSERT VARS p)` THEN + REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM IN_INSERT] THEN + MATCH_MP_TAC NOT_IN_VARIANT THEN + SIMP_TAC[VARS_FINITE; FINITE_INSERT; SUBSET_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + ONCE_REWRITE_TAC[GSYM(MATCH_MP FORMSUBST_TWICE th)]) THEN + SUBGOAL_THEN `~(x IN FV(formsubst (x |=> V z) p))` MP_TAC THENL + [REWRITE_TAC[FORMSUBST_FV; IN_ELIM_THM; ASSIGN; NOT_EXISTS_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FVT] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SPEC_TAC(`formsubst (x |=> V z) p`,`p:form`) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC spec THEN MATCH_MP_TAC gen THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP lemma) THEN + DISCH_THEN(MP_TAC o SPEC `x:num` o MATCH_MP gen) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] ichoose)) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP lemma) THEN ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP ante_disj) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] modusponens) THEN + MP_TAC(ISPECL [`V z`; `x:num`] num_cases') THEN + ASM_REWRITE_TAC[FVT; IN_SING] THEN + DISCH_THEN(MP_TAC o MATCH_MP iff_imp1) THEN + REWRITE_TAC[canonize_clauses] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] imp_trans) THEN + MESON_TAC[imp_swap; axiom_not; iff_imp1; imp_trans]);; + +(* ------------------------------------------------------------------------- *) +(* Now full Sigma-1 completeness. *) +(* ------------------------------------------------------------------------- *) + +let SIGMAPI1_COMPLETE = prove + (`!v p b. sigmapi b 1 p /\ closed p + ==> (b /\ holds v p ==> {robinson} |-- p) /\ + (~b /\ ~holds v p ==> {robinson} |-- p --> False)`, + let lemma1 = prove + (`!x n p. (!m. m < n ==> {robinson} |-- formsubst (x |=> numeral m) p) + ==> {robinson} |-- !!x (V x << numeral n --> p)`, + GEN_TAC THEN INDUCT_TAC THEN X_GEN_TAC `p:form` THEN DISCH_TAC THEN + REWRITE_TAC[numeral] THENL + [ASM_MESON_TAC[gen; imp_trans; ex_falso; not_lt_0]; ALL_TAC] THEN + MATCH_MP_TAC gen THEN MATCH_MP_TAC num_cases_rule THEN + EXISTS_TAC `x:num` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[formsubst] THEN MATCH_MP_TAC add_assum THEN + REWRITE_TAC[GSYM numeral] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[formsubst; termsubst; TERMSUBST_NUMERAL; ASSIGN] THEN + TRANS_TAC imp_trans `V x << numeral n` THEN + CONJ_TAC THENL [MESON_TAC[suc_lt_eq; iff_imp1]; ALL_TAC] THEN + MATCH_MP_TAC spec_var THEN EXISTS_TAC `x:num` THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC m`) THEN + ASM_REWRITE_TAC[LT_SUC] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) FORMSUBST_FORMSUBST_SAME_NONE o + rand o snd) THEN + REWRITE_TAC[FVT; FVT_NUMERAL] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[termsubst; ASSIGN; numeral]) in + let lemma2 = prove + (`!x n p. (!m. m <= n ==> {robinson} |-- formsubst (x |=> numeral m) p) + ==> {robinson} |-- !!x (V x <<= numeral n --> p)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`x:num`; `SUC n`; `p:form`] lemma1) THEN + ASM_REWRITE_TAC[LT_SUC_LE] THEN DISCH_TAC THEN MATCH_MP_TAC gen THEN + FIRST_ASSUM(MP_TAC o MATCH_MP spec_var) THEN REWRITE_TAC[numeral] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN + MESON_TAC[iff_imp1; le_iff_lt]) in + let lemma3 = prove + (`!v x t p. + FVT t = {} /\ + (!m. m < termval v t + ==> {robinson} |-- formsubst (x |=> numeral m) p) + ==> {robinson} |-- !!x (V x << t --> p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC gen THEN + FIRST_ASSUM(MP_TAC o MATCH_MP spec_var o MATCH_MP lemma1) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN + MATCH_MP_TAC iff_imp1 THEN MATCH_MP_TAC cong_lt THEN + REWRITE_TAC[axiom_eqrefl] THEN MATCH_MP_TAC SIGMA1_COMPLETE_TERM THEN + ASM_MESON_TAC[]) + and lemma4 = prove + (`!v x t p. + FVT t = {} /\ + (!m. m <= termval v t + ==> {robinson} |-- formsubst (x |=> numeral m) p) + ==> {robinson} |-- !!x (V x <<= t --> p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC gen THEN + FIRST_ASSUM(MP_TAC o MATCH_MP spec_var o MATCH_MP lemma2) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN + MATCH_MP_TAC iff_imp1 THEN MATCH_MP_TAC cong_le THEN + REWRITE_TAC[axiom_eqrefl] THEN MATCH_MP_TAC SIGMA1_COMPLETE_TERM THEN + ASM_MESON_TAC[]) + and lemma5 = prove + (`!A x p q. A |-- !!x (p --> Not q) ==> A |-- !!x (Not(p && q))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC gen THEN + FIRST_ASSUM(MP_TAC o MATCH_MP spec_var) THEN + REWRITE_TAC[canonize_clauses] THEN + MESON_TAC[imp_trans; axiom_not; iff_imp1; iff_imp2]) in + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[closed] THEN + WF_INDUCT_TAC `complexity p` THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`p:form`,`p:form`) THEN + MATCH_MP_TAC form_INDUCT THEN + REWRITE_TAC[SIGMAPI_CLAUSES; complexity; ARITH] THEN + REWRITE_TAC[MESON[] `(if p then q else F) <=> p /\ q`] THEN + ONCE_REWRITE_TAC + [TAUT `a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ i /\ j /\ k /\ l <=> + (a /\ b) /\ (c /\ d /\ e) /\ f /\ (g /\ h /\ i /\ j) /\ (k /\ l)`] THEN + CONJ_TAC THENL + [CONJ_TAC THEN DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[holds] THEN + MESON_TAC[imp_refl; truth]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`s:term`; `t:term`] THEN + DISCH_THEN(K ALL_TAC) THEN X_GEN_TAC `b:bool` THEN + REWRITE_TAC[FV; EMPTY_UNION] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`v:num->num`; `t:term`; `termval v t`] + SIGMA1_COMPLETE_TERM) THEN + MP_TAC(ISPECL [`v:num->num`; `s:term`; `termval v s`] + SIGMA1_COMPLETE_TERM) THEN + ASM_REWRITE_TAC[IMP_IMP] THENL + [DISCH_THEN(MP_TAC o MATCH_MP cong_eq); + DISCH_THEN(MP_TAC o MATCH_MP cong_lt); + DISCH_THEN(MP_TAC o MATCH_MP cong_le)] THEN + STRIP_TAC THEN REWRITE_TAC[holds; NOT_LE; NOT_LT] THEN + (REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o + MATCH_MP(REWRITE_RULE[IMP_CONJ] modusponens) o MATCH_MP iff_imp2); + FIRST_X_ASSUM(MATCH_MP_TAC o + MATCH_MP(REWRITE_RULE[IMP_CONJ] imp_trans) o MATCH_MP iff_imp1)]) THEN + ASM_SIMP_TAC[ATOM_EQ_FALSE; ATOM_EQ_TRUE; ATOM_LT_FALSE; ATOM_LT_TRUE; + ATOM_LE_FALSE; ATOM_LE_TRUE]; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `p:form` THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `p:form`) THEN + ANTS_TAC THENL [ARITH_TAC; DISCH_TAC] THEN + X_GEN_TAC `b:bool` THEN REWRITE_TAC[FV] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `~b`) THEN ASM_REWRITE_TAC[holds] THEN + BOOL_CASES_TAC `b:bool` THEN CANONIZE_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`p:form`; `q:form`] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_TAC THEN X_GEN_TAC `b:bool` THEN REWRITE_TAC[FV; EMPTY_UNION] THEN + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `p:form` th) THEN MP_TAC(SPEC `q:form` th)) THEN + (ANTS_TAC THENL [ARITH_TAC; ALL_TAC]) THEN + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN + (ANTS_TAC THENL [ARITH_TAC; ASM_REWRITE_TAC[IMP_IMP]]) THEN + ASM_REWRITE_TAC[holds; canonize_clauses] THENL + [DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `b:bool`)); + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `b:bool`)); + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `~b`) (MP_TAC o SPEC `b:bool`)); + DISCH_THEN(CONJUNCTS_THEN(fun th -> + MP_TAC(SPEC `~b` th) THEN MP_TAC(SPEC `b:bool` th)))] THEN + ASM_REWRITE_TAC[] THEN BOOL_CASES_TAC `b:bool` THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CANONIZE_TAC THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT + `~(p <=> q) ==> (p /\ ~q ==> r) /\ (~p /\ q ==> s) ==> r \/ s`)) THEN + REPEAT STRIP_TAC THEN CANONIZE_TAC) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`x:num`; `p:form`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[canonize_clauses; holds] THEN + DISCH_TAC THEN X_GEN_TAC `b:bool` THENL + [BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; FV] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`q:form`; `t:term`] THEN DISCH_THEN + (CONJUNCTS_THEN2 (DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THEN + REWRITE_TAC[SIGMAPI_CLAUSES; FV; holds] THEN + (ASM_CASES_TAC `FVT t = {}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN + (ASM_CASES_TAC `FV(q) SUBSET {x}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT2)) THEN + ABBREV_TAC `n = termval v t` THEN + ASM_SIMP_TAC[TERMVAL_VALMOD_OTHER; termval; VALMOD] THENL + [DISCH_TAC THEN MATCH_MP_TAC lemma3; + DISCH_TAC THEN MATCH_MP_TAC lemma4] THEN + EXISTS_TAC `v:num->num` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral m) q`) THEN + REWRITE_TAC[complexity; COMPLEXITY_FORMSUBST] THEN + (ANTS_TAC THENL [ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `T`)]) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[SIGMAPI_FORMSUBST] THEN + REWRITE_TAC[FORMSUBST_FV; ASSIGN] THEN + REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN + REWRITE_TAC[FVT_NUMERAL; NOT_IN_EMPTY; FVT; IN_SING] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[HOLDS_FORMSUBST] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN + X_GEN_TAC `y:num` THEN + (ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]]) THEN + ASM_REWRITE_TAC[o_DEF; ASSIGN; VALMOD; TERMVAL_NUMERAL]; + STRIP_TAC THEN REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC imp_trans THEN + EXISTS_TAC `formsubst (x |=> numeral n) p` THEN REWRITE_TAC[ispec] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral n) p`) THEN + REWRITE_TAC[COMPLEXITY_FORMSUBST; ARITH_RULE `n < n + 1`] THEN + DISCH_THEN(MP_TAC o SPEC `F`) THEN + ASM_SIMP_TAC[SIGMAPI_FORMSUBST; IMP_IMP] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [UNDISCH_TAC `FV (!! x p) = {}` THEN + REWRITE_TAC[FV; FORMSUBST_FV; SET_RULE + `s DELETE a = {} <=> s = {} \/ s = {a}`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_SING; EMPTY_GSPEC; + ASSIGN; UNWIND_THM2; FVT_NUMERAL]; + UNDISCH_TAC `~holds((x |-> n) v) p` THEN + REWRITE_TAC[HOLDS_FORMSUBST; CONTRAPOS_THM] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN + RULE_ASSUM_TAC(REWRITE_RULE[FV]) THEN X_GEN_TAC `y:num` THEN + ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[o_THM; ASSIGN; VALMOD; TERMVAL_NUMERAL]]]; + BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[FV] THEN STRIP_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral n) (Not p)`) THEN + REWRITE_TAC[COMPLEXITY_FORMSUBST; complexity] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `F`)] THEN + ASM_SIMP_TAC[IMP_IMP; SIGMAPI_CLAUSES; SIGMAPI_FORMSUBST] THEN + ANTS_TAC THENL + [REWRITE_TAC[FORMSUBST_FV; ASSIGN] THEN + REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN + REWRITE_TAC[FVT_NUMERAL; NOT_IN_EMPTY; FVT; FV; IN_SING] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + UNDISCH_TAC `holds ((x |-> n) v) p` THEN + REWRITE_TAC[formsubst; holds; HOLDS_FORMSUBST] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN + RULE_ASSUM_TAC(REWRITE_RULE[FV]) THEN X_GEN_TAC `y:num` THEN + ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[o_THM; ASSIGN; VALMOD; TERMVAL_NUMERAL]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] imp_trans) THEN + REWRITE_TAC[ispec]]; + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; FV] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`q:form`; `t:term`] THEN DISCH_THEN + (CONJUNCTS_THEN2 (DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THEN + REWRITE_TAC[SIGMAPI_CLAUSES; FV; holds] THEN + (ASM_CASES_TAC `FVT t = {}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN + (ASM_CASES_TAC `FV(q) SUBSET {x}` THENL [ALL_TAC; ASM SET_TAC[]]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT2)) THEN + ABBREV_TAC `n = termval v t` THEN + ASM_SIMP_TAC[TERMVAL_VALMOD_OTHER; termval; VALMOD] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN + DISCH_TAC THEN MATCH_MP_TAC lemma5 THENL + [MATCH_MP_TAC lemma3; MATCH_MP_TAC lemma4] THEN + EXISTS_TAC `v:num->num` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `formsubst (x |=> numeral m) (Not q)`) THEN + REWRITE_TAC[complexity; COMPLEXITY_FORMSUBST] THEN + (ANTS_TAC THENL [ARITH_TAC; DISCH_THEN(MP_TAC o SPEC `T`)]) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[SIGMAPI_FORMSUBST; SIGMAPI_CLAUSES] THEN + REWRITE_TAC[FORMSUBST_FV; FV; ASSIGN] THEN + REPLICATE_TAC 2 (ONCE_REWRITE_TAC[COND_RAND]) THEN + REWRITE_TAC[FVT_NUMERAL; NOT_IN_EMPTY; FVT; IN_SING] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[HOLDS_FORMSUBST; holds; CONTRAPOS_THM] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLDS_VALUATION THEN + X_GEN_TAC `y:num` THEN + (ASM_CASES_TAC `y:num = x` THENL [ALL_TAC; ASM SET_TAC[]]) THEN + ASM_REWRITE_TAC[o_DEF; ASSIGN; VALMOD; TERMVAL_NUMERAL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a nice alternative form of Goedel's theorem for any consistent *) +(* sigma_1-definable axioms A that extend (i.e. prove) the Robinson axioms. *) +(* ------------------------------------------------------------------------- *) + +let G1_ROBINSON = prove + (`!A. definable_by (SIGMA 1) (IMAGE gform A) /\ + consistent A /\ A |-- robinson + ==> ?G. PI 1 G /\ + closed G /\ + true G /\ + ~(A |-- G) /\ + (sound_for (SIGMA 1 INTER closed) A ==> ~(A |-- Not G))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC G1_TRAD THEN + ASM_REWRITE_TAC[complete_for; INTER; IN_ELIM_THM] THEN + X_GEN_TAC `p:form` THEN REWRITE_TAC[IN; true_def] THEN STRIP_TAC THEN + MATCH_MP_TAC modusponens THEN EXISTS_TAC `robinson` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PROVES_MONO THEN + EXISTS_TAC `{}:form->bool` THEN REWRITE_TAC[EMPTY_SUBSET] THEN + W(MP_TAC o PART_MATCH (lhs o rand) DEDUCTION o snd) THEN + MP_TAC(ISPECL [`I:num->num`; `p:form`; `T`] SIGMAPI1_COMPLETE) THEN + ASM_REWRITE_TAC[GSYM SIGMA] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[robinson; closed; FV; FVT] THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* More metaproperties of axioms systems now we have some derived rules. *) +(* ------------------------------------------------------------------------- *) + +let complete = new_definition + `complete A <=> !p. closed p ==> A |-- p \/ A |-- Not p`;; + +let sound = new_definition + `sound A <=> !p. A |-- p ==> true p`;; + +let semcomplete = new_definition + `semcomplete A <=> !p. true p ==> A |-- p`;; + +let generalize = new_definition + `generalize vs p = ITLIST (!!) vs p`;; + +let closure = new_definition + `closure p = generalize (list_of_set(FV p)) p`;; + +let TRUE_GENERALIZE = prove + (`!vs p. true(generalize vs p) <=> true p`, + REWRITE_TAC[generalize; true_def] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[ITLIST; holds] THEN GEN_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MESON_TAC[VALMOD_REPEAT]);; + +let PROVABLE_GENERALIZE = prove + (`!A p vs. A |-- generalize vs p <=> A |-- p`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[generalize] THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ITLIST] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MESON_TAC[spec; gen; FORMSUBST_TRIV; ASSIGN_TRIV]);; + +let FV_GENERALIZE = prove + (`!p vs. FV(generalize vs p) = FV(p) DIFF (set_of_list vs)`, + GEN_TAC THEN REWRITE_TAC[generalize] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[set_of_list; DIFF_EMPTY; ITLIST] THEN + ASM_REWRITE_TAC[FV] THEN SET_TAC[]);; + +let CLOSED_CLOSURE = prove + (`!p. closed(closure p)`, + REWRITE_TAC[closed; closure; FV_GENERALIZE] THEN + SIMP_TAC[SET_OF_LIST_OF_SET; FV_FINITE; DIFF_EQ_EMPTY]);; + +let TRUE_CLOSURE = prove + (`!p. true(closure p) <=> true p`, + REWRITE_TAC[closure; TRUE_GENERALIZE]);; + +let PROVABLE_CLOSURE = prove + (`!A p. A |-- closure p <=> A |-- p`, + REWRITE_TAC[closure; PROVABLE_GENERALIZE]);; + +let DEFINABLE_DEFINABLE_BY = prove + (`definable = definable_by (\x. T)`, + REWRITE_TAC[FUN_EQ_THM; definable; definable_by]);; + +let DEFINABLE_ONEVAR = prove + (`definable s <=> ?p x. (FV p = {x}) /\ !v. holds v p <=> (v x) IN s`, + REWRITE_TAC[definable] THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `p:form` (X_CHOOSE_TAC `x:num`)) THEN + EXISTS_TAC `(V x === V x) && formsubst (\y. if y = x then V x else Z) p` THEN + EXISTS_TAC `x:num` THEN + ASM_REWRITE_TAC[HOLDS_FORMSUBST; FORMSUBST_FV; FV; holds] THEN + REWRITE_TAC[COND_RAND; EXTENSION; IN_ELIM_THM; IN_SING; FVT; IN_UNION; + COND_EXPAND; NOT_IN_EMPTY; o_THM; termval] THEN + MESON_TAC[]);; + +let CLOSED_TRUE_OR_FALSE = prove + (`!p. closed p ==> true p \/ true(Not p)`, + REWRITE_TAC[closed; true_def; holds] THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[HOLDS_VALUATION; NOT_IN_EMPTY]);; + +let SEMCOMPLETE_IMP_COMPLETE = prove + (`!A. semcomplete A ==> complete A`, + REWRITE_TAC[semcomplete; complete] THEN MESON_TAC[CLOSED_TRUE_OR_FALSE]);; + +let SOUND_CLOSED = prove + (`sound A <=> !p. closed p /\ A |-- p ==> true p`, + REWRITE_TAC[sound] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MESON_TAC[TRUE_CLOSURE; PROVABLE_CLOSURE; CLOSED_CLOSURE]);; + +let SOUND_IMP_CONSISTENT = prove + (`!A. sound A ==> consistent A`, + REWRITE_TAC[sound; consistent; CONSISTENT_ALT] THEN + SUBGOAL_THEN `~(true False)` (fun th -> MESON_TAC[th]) THEN + REWRITE_TAC[true_def; holds]);; + +let SEMCOMPLETE_SOUND_EQ_CONSISTENT = prove + (`!A. semcomplete A ==> (sound A <=> consistent A)`, + REWRITE_TAC[semcomplete] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN + REWRITE_TAC[SOUND_IMP_CONSISTENT] THEN + REWRITE_TAC[consistent; SOUND_CLOSED] THEN + ASM_MESON_TAC[CLOSED_TRUE_OR_FALSE]);; diff --git a/Arithmetic/tarski.ml b/Arithmetic/tarski.ml new file mode 100644 index 0000000..404e6bd --- /dev/null +++ b/Arithmetic/tarski.ml @@ -0,0 +1,344 @@ +(* ========================================================================= *) +(* Arithmetization of syntax and Tarski's theorem. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* This is to fake the fact that we might really be using strings. *) +(* ------------------------------------------------------------------------- *) + +let number = new_definition + `number(x) = 2 * (x DIV 2) + (1 - x MOD 2)`;; + +let denumber = new_definition + `denumber = number`;; + +let NUMBER_DENUMBER = prove + (`(!s. denumber(number s) = s) /\ + (!n. number(denumber n) = n)`, + REWRITE_TAC[number; denumber] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + SIMP_TAC[ARITH_RULE `x < 2 ==> (2 * y + x) DIV 2 = y`; + MOD_MULT_ADD; MOD_LT; GSYM DIVISION; ARITH_EQ; + ARITH_RULE `1 - m < 2`; ARITH_RULE `x < 2 ==> 1 - (1 - x) = x`]);; + +let NUMBER_INJ = prove + (`!x y. number(x) = number(y) <=> x = y`, + MESON_TAC[NUMBER_DENUMBER]);; + +let NUMBER_SURJ = prove + (`!y. ?x. number(x) = y`, + MESON_TAC[NUMBER_DENUMBER]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetization. *) +(* ------------------------------------------------------------------------- *) + +let gterm = new_recursive_definition term_RECURSION + `(gterm (V x) = NPAIR 0 (number x)) /\ + (gterm Z = NPAIR 1 0) /\ + (gterm (Suc t) = NPAIR 2 (gterm t)) /\ + (gterm (s ++ t) = NPAIR 3 (NPAIR (gterm s) (gterm t))) /\ + (gterm (s ** t) = NPAIR 4 (NPAIR (gterm s) (gterm t)))`;; + +let gform = new_recursive_definition form_RECURSION + `(gform False = NPAIR 0 0) /\ + (gform True = NPAIR 0 1) /\ + (gform (s === t) = NPAIR 1 (NPAIR (gterm s) (gterm t))) /\ + (gform (s << t) = NPAIR 2 (NPAIR (gterm s) (gterm t))) /\ + (gform (s <<= t) = NPAIR 3 (NPAIR (gterm s) (gterm t))) /\ + (gform (Not p) = NPAIR 4 (gform p)) /\ + (gform (p && q) = NPAIR 5 (NPAIR (gform p) (gform q))) /\ + (gform (p || q) = NPAIR 6 (NPAIR (gform p) (gform q))) /\ + (gform (p --> q) = NPAIR 7 (NPAIR (gform p) (gform q))) /\ + (gform (p <-> q) = NPAIR 8 (NPAIR (gform p) (gform q))) /\ + (gform (!! x p) = NPAIR 9 (NPAIR (number x) (gform p))) /\ + (gform (?? x p) = NPAIR 10 (NPAIR (number x) (gform p)))`;; + +(* ------------------------------------------------------------------------- *) +(* Injectivity. *) +(* ------------------------------------------------------------------------- *) + +let GTERM_INJ = prove + (`!s t. (gterm s = gterm t) <=> (s = t)`, + MATCH_MP_TAC term_INDUCT THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + GEN_TAC; + GEN_TAC THEN DISCH_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC] THEN + MATCH_MP_TAC term_INDUCT THEN + ASM_REWRITE_TAC[term_DISTINCT; term_INJ; gterm; + NPAIR_INJ; NUMBER_INJ; ARITH_EQ]);; + +let GFORM_INJ = prove + (`!p q. (gform p = gform q) <=> (p = q)`, + MATCH_MP_TAC form_INDUCT THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + ALL_TAC; + GEN_TAC THEN GEN_TAC; + GEN_TAC THEN GEN_TAC; + GEN_TAC THEN GEN_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC; + REPEAT GEN_TAC THEN STRIP_TAC] THEN + MATCH_MP_TAC form_INDUCT THEN + ASM_REWRITE_TAC[form_DISTINCT; form_INJ; gform; NPAIR_INJ; ARITH_EQ] THEN + REWRITE_TAC[GTERM_INJ; NUMBER_INJ]);; + +(* ------------------------------------------------------------------------- *) +(* Useful case theorems. *) +(* ------------------------------------------------------------------------- *) + +let GTERM_CASES = prove + (`((gterm u = NPAIR 0 (number x)) <=> (u = V x)) /\ + ((gterm u = NPAIR 1 0) <=> (u = Z)) /\ + ((gterm u = NPAIR 2 n) <=> (?t. (u = Suc t) /\ (gterm t = n))) /\ + ((gterm u = NPAIR 3 (NPAIR m n)) <=> + (?s t. (u = s ++ t) /\ (gterm s = m) /\ (gterm t = n))) /\ + ((gterm u = NPAIR 4 (NPAIR m n)) <=> + (?s t. (u = s ** t) /\ (gterm s = m) /\ (gterm t = n)))`, + STRUCT_CASES_TAC(SPEC `u:term` term_CASES) THEN + ASM_REWRITE_TAC[gterm; NPAIR_INJ; ARITH_EQ; NUMBER_INJ; + term_DISTINCT; term_INJ] THEN + MESON_TAC[]);; + +let GFORM_CASES = prove + (`((gform r = NPAIR 0 0) <=> (r = False)) /\ + ((gform r = NPAIR 0 1) <=> (r = True)) /\ + ((gform r = NPAIR 1 (NPAIR m n)) <=> + (?s t. (r = s === t) /\ (gterm s = m) /\ (gterm t = n))) /\ + ((gform r = NPAIR 2 (NPAIR m n)) <=> + (?s t. (r = s << t) /\ (gterm s = m) /\ (gterm t = n))) /\ + ((gform r = NPAIR 3 (NPAIR m n)) <=> + (?s t. (r = s <<= t) /\ (gterm s = m) /\ (gterm t = n))) /\ + ((gform r = NPAIR 4 n) = (?p. (r = Not p) /\ (gform p = n))) /\ + ((gform r = NPAIR 5 (NPAIR m n)) <=> + (?p q. (r = p && q) /\ (gform p = m) /\ (gform q = n))) /\ + ((gform r = NPAIR 6 (NPAIR m n)) <=> + (?p q. (r = p || q) /\ (gform p = m) /\ (gform q = n))) /\ + ((gform r = NPAIR 7 (NPAIR m n)) <=> + (?p q. (r = p --> q) /\ (gform p = m) /\ (gform q = n))) /\ + ((gform r = NPAIR 8 (NPAIR m n)) <=> + (?p q. (r = p <-> q) /\ (gform p = m) /\ (gform q = n))) /\ + ((gform r = NPAIR 9 (NPAIR (number x) n)) <=> + (?p. (r = !!x p) /\ (gform p = n))) /\ + ((gform r = NPAIR 10 (NPAIR (number x) n)) <=> + (?p. (r = ??x p) /\ (gform p = n)))`, + STRUCT_CASES_TAC(SPEC `r:form` form_CASES) THEN + ASM_REWRITE_TAC[gform; NPAIR_INJ; ARITH_EQ; NUMBER_INJ; + form_DISTINCT; form_INJ] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Definability of "godel number of numeral n". *) +(* ------------------------------------------------------------------------- *) + +let gnumeral = new_definition + `gnumeral m n = (gterm(numeral m) = n)`;; + +let arith_gnumeral1 = new_definition + `arith_gnumeral1 a b = formsubst ((3 |-> a) ((4 |-> b) V)) + (??0 (??1 + (V 3 === arith_pair (V 0) (V 1) && + V 4 === arith_pair (Suc(V 0)) (arith_pair (numeral 2) (V 1)))))`;; + +let ARITH_GNUMERAL1 = prove + (`!v a b. holds v (arith_gnumeral1 a b) <=> + ?x y. termval v a = NPAIR x y /\ + termval v b = NPAIR (SUC x) (NPAIR 2 y)`, + REWRITE_TAC[arith_gnumeral1; holds; HOLDS_FORMSUBST] THEN + REWRITE_TAC[termval; ARITH_EQ; o_THM; valmod; ARITH_PAIR; TERMVAL_NUMERAL]);; + +let FV_GNUMERAL1 = prove + (`!s t. FV(arith_gnumeral1 s t) = FVT s UNION FVT t`, + REWRITE_TAC[arith_gnumeral1] THEN FV_TAC[FVT_PAIR; FVT_NUMERAL]);; + +let arith_gnumeral1' = new_definition + `arith_gnumeral1' x y = arith_rtc arith_gnumeral1 x y`;; + +let ARITH_GNUMERAL1' = prove + (`!v s t. holds v (arith_gnumeral1' s t) <=> + RTC (\a b. ?x y. a = NPAIR x y /\ + b = NPAIR (SUC x) (NPAIR 2 y)) + (termval v s) (termval v t)`, + REWRITE_TAC[arith_gnumeral1'] THEN MATCH_MP_TAC ARITH_RTC THEN + REWRITE_TAC[ARITH_GNUMERAL1]);; + +let FV_GNUMERAL1' = prove + (`!s t. FV(arith_gnumeral1' s t) = FVT s UNION FVT t`, + SIMP_TAC[arith_gnumeral1'; FV_RTC; FV_GNUMERAL1]);; + +let arith_gnumeral = new_definition + `arith_gnumeral n p = + formsubst ((0 |-> n) ((1 |-> p) V)) + (arith_gnumeral1' (arith_pair Z (numeral 3)) + (arith_pair (V 0) (V 1)))`;; + +let ARITH_GNUMERAL = prove + (`!v s t. holds v (arith_gnumeral s t) <=> + gnumeral (termval v s) (termval v t)`, + REWRITE_TAC[arith_gnumeral; holds; HOLDS_FORMSUBST; + ARITH_GNUMERAL1'; ARITH_PAIR; TERMVAL_NUMERAL] THEN + REWRITE_TAC[termval; ARITH_EQ; o_THM; valmod] THEN + MP_TAC(INST + [`(gterm o numeral)`,`fn:num->num`; + `3`,`e:num`; + `\a:num b:num. NPAIR 2 a`,`f:num->num->num`] PRIMREC_SIGMA) THEN + ANTS_TAC THENL + [REWRITE_TAC[gterm; numeral; o_THM] THEN REWRITE_TAC[NPAIR; ARITH]; + SIMP_TAC[gnumeral; o_THM]]);; + +let FV_GNUMERAL = prove + (`!s t. FV(arith_gnumeral s t) = FVT(s) UNION FVT(t)`, + REWRITE_TAC[arith_gnumeral] THEN + FV_TAC[FV_GNUMERAL1'; FVT_PAIR; FVT_NUMERAL]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonal substitution. *) +(* ------------------------------------------------------------------------- *) + +let qdiag = new_definition + `qdiag x q = qsubst (x,numeral(gform q)) q`;; + +let arith_qdiag = new_definition + `arith_qdiag x s t = + formsubst ((1 |-> s) ((2 |-> t) V)) + (?? 3 + (arith_gnumeral (V 1) (V 3) && + arith_pair (numeral 10) (arith_pair (numeral(number x)) + (arith_pair (numeral 5) + (arith_pair (arith_pair (numeral 1) + (arith_pair (arith_pair (numeral 0) (numeral(number x))) (V 3))) + (V 1)))) === + V 2))`;; + +let QDIAG_FV = prove + (`FV(qdiag x q) = FV(q) DELETE x`, + REWRITE_TAC[qdiag; FV_QSUBST; FVT_NUMERAL; UNION_EMPTY]);; + +let HOLDS_QDIAG = prove + (`!v x q. holds v (qdiag x q) = holds ((x |-> gform q) v) q`, + SIMP_TAC[qdiag; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY; TERMVAL_NUMERAL]);; + +let ARITH_QDIAG = prove + (`(termval v s = gform p) + ==> (holds v (arith_qdiag x s t) <=> (termval v t = gform(qdiag x p)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[qdiag; qsubst; arith_qdiag; gform; gterm] THEN + ASM_REWRITE_TAC[HOLDS_FORMSUBST; holds; termval; TERMVAL_NUMERAL; + gnumeral; ARITH_GNUMERAL; ARITH_PAIR] THEN + ASM_REWRITE_TAC[o_DEF; valmod; ARITH_EQ; termval] THEN MESON_TAC[]);; + +let FV_QDIAG = prove + (`!x s t. FV(arith_qdiag x s t) = FVT(s) UNION FVT(t)`, + REWRITE_TAC[arith_qdiag; FORMSUBST_FV; FV; FV_GNUMERAL; FVT_PAIR; + UNION_EMPTY; FVT_NUMERAL; FVT; TERMSUBST_FVT] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[DISJ_ACI; IN_DELETE; IN_UNION; IN_SING] THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC; UNWIND_THM2; ARITH_EQ] THEN + REWRITE_TAC[valmod; ARITH_EQ; DISJ_ACI]);; + +(* ------------------------------------------------------------------------- *) +(* Hence diagonalization of a predicate. *) +(* ------------------------------------------------------------------------- *) + +let diagonalize = new_definition + `diagonalize x q = + let y = VARIANT(x INSERT FV(q)) in + ??y (arith_qdiag x (V x) (V y) && formsubst ((x |-> V y) V) q)`;; + +let FV_DIAGONALIZE = prove + (`!x q. FV(diagonalize x q) = x INSERT (FV q)`, + REPEAT GEN_TAC THEN REWRITE_TAC[diagonalize] THEN LET_TAC THEN + REWRITE_TAC[FV; FV_QDIAG; FORMSUBST_FV; EXTENSION; IN_INSERT; IN_DELETE; + IN_UNION; IN_ELIM_THM; FVT; NOT_IN_EMPTY] THEN + X_GEN_TAC `u:num` THEN + SUBGOAL_THEN `~(y = x) /\ !z. z IN FV(q) ==> ~(y = z)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]; + ALL_TAC] THEN + ASM_CASES_TAC `u:num = x` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `u:num = y` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[valmod; COND_RAND; FVT; IN_SING; COND_EXPAND] THEN + ASM_MESON_TAC[]);; + +let ARITH_DIAGONALIZE = prove + (`(v x = gform p) + ==> !q. holds v (diagonalize x q) <=> holds ((x |-> gform(qdiag x p)) v) q`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diagonalize] THEN LET_TAC THEN + REWRITE_TAC[holds] THEN + SUBGOAL_THEN `!a. holds ((y |-> a) v) (arith_qdiag x (V x) (V y)) <=> + (termval ((y |-> a) v) (V y) = gform(qdiag x p))` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC ARITH_QDIAG THEN REWRITE_TAC[termval; valmod] THEN + SUBGOAL_THEN `~(x:num = y)` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]; + ALL_TAC] THEN + REWRITE_TAC[HOLDS_FORMSUBST; termval; VALMOD_BASIC; UNWIND_THM2] THEN + MATCH_MP_TAC HOLDS_VALUATION THEN + X_GEN_TAC `u:num` THEN DISCH_TAC THEN + REWRITE_TAC[o_THM; termval; valmod] THEN + COND_CASES_TAC THEN REWRITE_TAC[termval] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[VARIANT_FINITE; FINITE_INSERT; FV_FINITE; IN_INSERT]);; + +(* ------------------------------------------------------------------------- *) +(* And hence the fixed point. *) +(* ------------------------------------------------------------------------- *) + +let fixpoint = new_definition + `fixpoint x q = qdiag x (diagonalize x q)`;; + +let FV_FIXPOINT = prove + (`!x p. FV(fixpoint x p) = FV(p) DELETE x`, + REWRITE_TAC[fixpoint; FV_QDIAG; QDIAG_FV; FV_DIAGONALIZE; + FVT_NUMERAL] THEN + SET_TAC[]);; + +let HOLDS_FIXPOINT = prove + (`!x p v. holds v (fixpoint x p) <=> + holds ((x |-> gform(fixpoint x p)) v) p`, + REPEAT GEN_TAC THEN SIMP_TAC[fixpoint; holds; HOLDS_QDIAG] THEN + SUBGOAL_THEN + `((x |-> gform(diagonalize x p)) v) x = gform (diagonalize x p)` + MP_TAC THENL [REWRITE_TAC[VALMOD_BASIC]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ARITH_DIAGONALIZE th]) THEN + REWRITE_TAC[VALMOD_VALMOD_BASIC]);; + +let HOLDS_IFF_FIXPOINT = prove + (`!x p v. holds v + (fixpoint x p <-> qsubst (x,numeral(gform(fixpoint x p))) p)`, + SIMP_TAC[holds; HOLDS_FIXPOINT; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY; + TERMVAL_NUMERAL]);; + +let CARNAP = prove + (`!x q. ?p. (FV(p) = FV(q) DELETE x) /\ + true (p <-> qsubst (x,numeral(gform p)) q)`, + REPEAT GEN_TAC THEN EXISTS_TAC `fixpoint x q` THEN + REWRITE_TAC[true_def; HOLDS_IFF_FIXPOINT; FV_FIXPOINT]);; + +(* ------------------------------------------------------------------------- *) +(* Hence Tarski's theorem on the undefinability of truth. *) +(* ------------------------------------------------------------------------- *) + +let definable_by = new_definition + `definable_by P s <=> ?p x. P p /\ (!v. holds v p <=> (v(x)) IN s)`;; + +let definable = new_definition + `definable s <=> ?p x. !v. holds v p <=> (v(x)) IN s`;; + +let TARSKI_THEOREM = prove + (`~(definable {gform p | true p})`, + REWRITE_TAC[definable; IN_ELIM_THM; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`p:form`; `x:num`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`x:num`; `Not p`] CARNAP) THEN + DISCH_THEN(X_CHOOSE_THEN `q:form` (MP_TAC o CONJUNCT2)) THEN + SIMP_TAC[true_def; holds; HOLDS_QSUBST; FVT_NUMERAL; NOT_IN_EMPTY] THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[VALMOD_BASIC; TERMVAL_NUMERAL] THEN + REWRITE_TAC[true_def; GFORM_INJ] THEN MESON_TAC[]);; diff --git a/Boyer_Moore/boyer-moore.ml b/Boyer_Moore/boyer-moore.ml new file mode 100644 index 0000000..d180a94 --- /dev/null +++ b/Boyer_Moore/boyer-moore.ml @@ -0,0 +1,22 @@ +(******************************************************************************) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +let paths = [".";!hol_dir ^ "/Boyer_Moore"] +in map (fun st -> load_on_path paths st) + ["support.ml"; + "struct_equal.ml"; + "shells.ml"; + "environment.ml"; + "clausal_form.ml"; + "waterfall.ml"; + "rewrite_rules.ml"; + "definitions.ml"; + "terms_and_clauses.ml"; + "equalities.ml"; + "induction.ml"; + "counterexample.ml"; + "generalize.ml"; + "irrelevance.ml"; + "main.ml"];; diff --git a/Boyer_Moore/clausal_form.ml b/Boyer_Moore/clausal_form.ml new file mode 100644 index 0000000..87d324b --- /dev/null +++ b/Boyer_Moore/clausal_form.ml @@ -0,0 +1,350 @@ +(******************************************************************************) +(* FILE : clausal_form.ml *) +(* DESCRIPTION : Functions for putting a formula into clausal form. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 13th May 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 12th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +let IMP_DISJ_THM = TAUT `!t1 t2. t1 ==> t2 <=> ~t1 \/ t2`;; +let RIGHT_OR_OVER_AND = TAUT `!t1 t2 t3. t2 /\ t3 \/ t1 <=> (t2 \/ t1) /\ (t3 \/ t1)`;; +let LEFT_OR_OVER_AND = TAUT `!t1 t2 t3. t1 \/ t2 /\ t3 <=> (t1 \/ t2) /\ (t1 \/ t3)`;; + +(*============================================================================*) +(* Theorems for normalizing Boolean terms *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* EQ_EXPAND = |- (x = y) = ((~x \/ y) /\ (~y \/ x)) *) +(*----------------------------------------------------------------------------*) + +let EQ_EXPAND = + prove + (`(x = y) = ((~x \/ y) /\ (~y \/ x))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* IMP_EXPAND = |- (x ==> y) = (~x \/ y) *) +(*----------------------------------------------------------------------------*) + +let IMP_EXPAND = SPEC `y:bool` (SPEC `x:bool` IMP_DISJ_THM);; + +(*----------------------------------------------------------------------------*) +(* COND_EXPAND = |- (x => y | z) = ((~x \/ y) /\ (x \/ z)) *) +(*----------------------------------------------------------------------------*) + +let COND_EXPAND = + prove + (`(if x then y else z) = ((~x \/ y) /\ (x \/ z))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + BOOL_CASES_TAC `z:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* NOT_NOT_NORM = |- ~~x = x *) +(*----------------------------------------------------------------------------*) + +let NOT_NOT_NORM = SPEC `x:bool` (CONJUNCT1 NOT_CLAUSES);; + +(*----------------------------------------------------------------------------*) +(* NOT_CONJ_NORM = |- ~(x /\ y) = (~x \/ ~y) *) +(*----------------------------------------------------------------------------*) + +let NOT_CONJ_NORM = CONJUNCT1 (SPEC `y:bool` (SPEC `x:bool` DE_MORGAN_THM));; + +(*----------------------------------------------------------------------------*) +(* NOT_DISJ_NORM = |- ~(x \/ y) = (~x /\ ~y) *) +(*----------------------------------------------------------------------------*) + +let NOT_DISJ_NORM = CONJUNCT2 (SPEC `y:bool` (SPEC `x:bool` DE_MORGAN_THM));; + +(*----------------------------------------------------------------------------*) +(* LEFT_DIST_NORM = |- x \/ (y /\ z) = (x \/ y) /\ (x \/ z) *) +(*----------------------------------------------------------------------------*) + +let LEFT_DIST_NORM = + SPEC `z:bool` (SPEC `y:bool` (SPEC `x:bool` LEFT_OR_OVER_AND));; + +(*----------------------------------------------------------------------------*) +(* RIGHT_DIST_NORM = |- (x /\ y) \/ z = (x \/ z) /\ (y \/ z) *) +(*----------------------------------------------------------------------------*) + +let RIGHT_DIST_NORM = + SPEC `y:bool` (SPEC `x:bool` (SPEC `z:bool` RIGHT_OR_OVER_AND));; + +(*----------------------------------------------------------------------------*) +(* CONJ_ASSOC_NORM = |- (x /\ y) /\ z = x /\ (y /\ z) *) +(*----------------------------------------------------------------------------*) + +let CONJ_ASSOC_NORM = + SYM (SPEC `z:bool` (SPEC `y:bool` (SPEC `x:bool` CONJ_ASSOC)));; + +(*----------------------------------------------------------------------------*) +(* DISJ_ASSOC_NORM = |- (x \/ y) \/ z = x \/ (y \/ z) *) +(*----------------------------------------------------------------------------*) + +let DISJ_ASSOC_NORM = + SYM (SPEC `z:bool` (SPEC `y:bool` (SPEC `x:bool` DISJ_ASSOC)));; + +(*============================================================================*) +(* Conversions for rewriting Boolean terms *) +(*============================================================================*) + +let COND_EXPAND_CONV = REWR_CONV COND_EXPAND;; +let CONJ_ASSOC_NORM_CONV = REWR_CONV CONJ_ASSOC_NORM;; +let DISJ_ASSOC_NORM_CONV = REWR_CONV DISJ_ASSOC_NORM;; +let EQ_EXPAND_CONV = REWR_CONV EQ_EXPAND;; +let IMP_EXPAND_CONV = REWR_CONV IMP_EXPAND;; +let LEFT_DIST_NORM_CONV = REWR_CONV LEFT_DIST_NORM;; +let NOT_CONJ_NORM_CONV = REWR_CONV NOT_CONJ_NORM;; +let NOT_DISJ_NORM_CONV = REWR_CONV NOT_DISJ_NORM;; +let NOT_NOT_NORM_CONV = REWR_CONV NOT_NOT_NORM;; +let RIGHT_DIST_NORM_CONV = REWR_CONV RIGHT_DIST_NORM;; + +(*----------------------------------------------------------------------------*) +(* NOT_CONV : conv *) +(* *) +(* |- !t. ~~t = t *) +(* |- ~T = F *) +(* |- ~F = T *) +(*----------------------------------------------------------------------------*) + +let NOT_CONV = +try ( + let [th1;th2;th3] = CONJUNCTS NOT_CLAUSES + in fun tm -> + (let arg = dest_neg tm + in if (is_T arg) then th2 + else if (is_F arg) then th3 + else SPEC (dest_neg arg) th1 + ) +) with Failure _ -> failwith "NOT_CONV";; + +(*----------------------------------------------------------------------------*) +(* AND_CONV : conv *) +(* *) +(* |- T /\ t = t *) +(* |- t /\ T = t *) +(* |- F /\ t = F *) +(* |- t /\ F = F *) +(* |- t /\ t = t *) +(*----------------------------------------------------------------------------*) + +let AND_CONV = +try ( + let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL AND_CLAUSES)) + in fun tm -> + (let (arg1,arg2) = dest_conj tm + in if (is_T arg1) then SPEC arg2 th1 + else if (is_T arg2) then SPEC arg1 th2 + else if (is_F arg1) then SPEC arg2 th3 + else if (is_F arg2) then SPEC arg1 th4 + else if (arg1 = arg2) then SPEC arg1 th5 + else failwith "" + ) + ) with Failure _ -> failwith "AND_CONV" ;; + +(*----------------------------------------------------------------------------*) +(* OR_CONV : conv *) +(* *) +(* |- T \/ t = T *) +(* |- t \/ T = T *) +(* |- F \/ t = t *) +(* |- t \/ F = t *) +(* |- t \/ t = t *) +(*----------------------------------------------------------------------------*) + +let OR_CONV = +try ( + let [th1;th2;th3;th4;th5] = map GEN_ALL (CONJUNCTS (SPEC_ALL OR_CLAUSES)) + in fun tm -> + (let (arg1,arg2) = dest_disj tm + in if (is_T arg1) then SPEC arg2 th1 + else if (is_T arg2) then SPEC arg1 th2 + else if (is_F arg1) then SPEC arg2 th3 + else if (is_F arg2) then SPEC arg1 th4 + else if (arg1 = arg2) then SPEC arg1 th5 + else failwith "" + ) +) with Failure _ -> failwith "OR_CONV";; + +(*============================================================================*) +(* Conversions for obtaining `clausal' form *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* EQ_IMP_COND_ELIM_CONV : (term -> bool) -> conv *) +(* *) +(* Eliminates Boolean equalities, Boolean conditionals, and implications from *) +(* terms consisting of =,==>,COND,/\,\/,~ and atoms. The atoms are specified *) +(* by the predicate that the conversion takes as its first argument. *) +(*----------------------------------------------------------------------------*) + +let rec EQ_IMP_COND_ELIM_CONV is_atom tm = +try + (if (is_atom tm) then ALL_CONV tm + else if (is_neg tm) then (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) tm + else if (is_eq tm) then + ((RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC + (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) THENC + EQ_EXPAND_CONV) tm + else if (is_imp tm) then + ((RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC + (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) THENC + IMP_EXPAND_CONV) tm + else if (is_cond tm) then + ((RATOR_CONV + (RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)))) THENC + (RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC + (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom)) THENC + COND_EXPAND_CONV) tm + else ((RATOR_CONV (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) THENC + (RAND_CONV (EQ_IMP_COND_ELIM_CONV is_atom))) tm + ) with Failure _ -> failwith "EQ_IMP_COND_ELIM_CONV";; + +(*----------------------------------------------------------------------------*) +(* MOVE_NOT_DOWN_CONV : (term -> bool) -> conv -> conv *) +(* *) +(* Moves negations down through a term consisting of /\,\/,~ and atoms. The *) +(* atoms are specified by a predicate (first argument). When a negation has *) +(* reached an atom, the conversion `conv' (second argument) is applied to the *) +(* negation of the atom. `conv' is also applied to any non-negated atoms *) +(* encountered. T and F are eliminated. *) +(*----------------------------------------------------------------------------*) + +let rec MOVE_NOT_DOWN_CONV is_atom conv tm = +try + (if (is_atom tm) then (conv tm) + else if (is_neg tm) + then ((let tm' = rand tm + in if (is_atom tm') then ((conv THENC (TRY_CONV NOT_CONV)) tm) + else if (is_neg tm') then (NOT_NOT_NORM_CONV THENC + (MOVE_NOT_DOWN_CONV is_atom conv)) tm + else if (is_conj tm') then + (NOT_CONJ_NORM_CONV THENC + (RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) + THENC + (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC + (TRY_CONV AND_CONV)) tm + else if (is_disj tm') then + (NOT_DISJ_NORM_CONV THENC + (RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) + THENC + (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC + (TRY_CONV OR_CONV)) tm + else failwith "")) + else if (is_conj tm) then + ((RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) THENC + (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC + (TRY_CONV AND_CONV)) tm + else if (is_disj tm) then + ((RATOR_CONV (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv))) THENC + (RAND_CONV (MOVE_NOT_DOWN_CONV is_atom conv)) THENC + (TRY_CONV OR_CONV)) tm + else failwith "" + ) with Failure _ -> failwith "MOVE_NOT_DOWN_CONV";; + +(*----------------------------------------------------------------------------*) +(* CONJ_LINEAR_CONV : conv *) +(* *) +(* Linearizes conjuncts using the following conversion applied recursively: *) +(* *) +(* "(x /\ y) /\ z" *) +(* ================================ *) +(* |- (x /\ y) /\ z = x /\ (y /\ z) *) +(*----------------------------------------------------------------------------*) + +let rec CONJ_LINEAR_CONV tm = +try + (if ((is_conj tm) & (is_conj (rand (rator tm)))) + then (CONJ_ASSOC_NORM_CONV THENC + (RAND_CONV (TRY_CONV CONJ_LINEAR_CONV)) THENC + (TRY_CONV CONJ_LINEAR_CONV)) tm + else failwith "" + ) with Failure _ -> failwith "CONJ_LINEAR_CONV";; + +(*----------------------------------------------------------------------------*) +(* CONJ_NORM_FORM_CONV : conv *) +(* *) +(* Puts a term involving /\ and \/ into conjunctive normal form. Anything *) +(* other than /\ and \/ is taken to be an atom and is not processed. *) +(* *) +(* The conjunction returned is linear, i.e. the conjunctions are associated *) +(* to the right. Each conjunct is a linear disjunction. *) +(*----------------------------------------------------------------------------*) + +let rec CONJ_NORM_FORM_CONV tm = +try + (if (is_disj tm) then + (if (is_conj (rand (rator tm))) then + ((RATOR_CONV + (RAND_CONV ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC + (RAND_CONV CONJ_NORM_FORM_CONV)))) THENC + (RAND_CONV CONJ_NORM_FORM_CONV) THENC + RIGHT_DIST_NORM_CONV THENC + (RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC + (RAND_CONV CONJ_NORM_FORM_CONV) THENC + (TRY_CONV CONJ_LINEAR_CONV)) tm + else if (is_conj (rand tm)) then + ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC + (RAND_CONV ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC + (RAND_CONV CONJ_NORM_FORM_CONV))) THENC + LEFT_DIST_NORM_CONV THENC + (RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC + (RAND_CONV CONJ_NORM_FORM_CONV) THENC + (TRY_CONV CONJ_LINEAR_CONV)) tm + else if (is_disj (rand (rator tm))) then + (DISJ_ASSOC_NORM_CONV THENC CONJ_NORM_FORM_CONV) tm + else (let th = RAND_CONV CONJ_NORM_FORM_CONV tm + in let tm' = rhs (concl th) + in if (is_conj (rand tm')) + then (TRANS th (CONJ_NORM_FORM_CONV tm')) + else th)) + else if (is_conj tm) then + ((RATOR_CONV (RAND_CONV CONJ_NORM_FORM_CONV)) THENC + (RAND_CONV CONJ_NORM_FORM_CONV) THENC + (TRY_CONV CONJ_LINEAR_CONV)) tm + else ALL_CONV tm + ) with Failure _ -> failwith "CONJ_NORM_FORM_CONV";; + +(*----------------------------------------------------------------------------*) +(* has_boolean_args_and_result : term -> bool *) +(* *) +(* Yields true if and only if the term is of type ":bool", and if it is a *) +(* function application, all the arguments are of type ":bool". *) +(*----------------------------------------------------------------------------*) + +let has_boolean_args_and_result tm = +try + (let args = snd (strip_comb tm) + in let types = (type_of tm)::(map type_of args) + in (subtract (setify types) [`:bool`]) = [] ) + with Failure _ -> (type_of tm = `:bool`);; + +(*----------------------------------------------------------------------------*) +(* CLAUSAL_FORM_CONV : conv *) +(* *) +(* Puts into clausal form terms consisting of =,==>,COND,/\,\/,~ and atoms. *) +(*----------------------------------------------------------------------------*) + +let CLAUSAL_FORM_CONV tm = +try ( + let is_atom tm = + (not (has_boolean_args_and_result tm)) or (is_var tm) or (is_const tm) + in + ((EQ_IMP_COND_ELIM_CONV is_atom) THENC + (MOVE_NOT_DOWN_CONV is_atom ALL_CONV) THENC + CONJ_NORM_FORM_CONV) tm + ) with Failure _ -> failwith "CLAUSAL_FORM_CONV";; diff --git a/Boyer_Moore/counterexample.ml b/Boyer_Moore/counterexample.ml new file mode 100644 index 0000000..6945ece --- /dev/null +++ b/Boyer_Moore/counterexample.ml @@ -0,0 +1,202 @@ +(******************************************************************************) +(* FILE : counterexample.ml *) +(* DESCRIPTION : Simple counterexample checker *) +(* Based on ideas and suggestions from S. Wilson *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* Reference of how many examples will be tried on each check. *) +(* Set to 0 to turn off counterexample checker. *) +(*----------------------------------------------------------------------------*) + +let counter_check_num = ref 5;; + +let counter_checks t = + counter_check_num := t;; + + +(*----------------------------------------------------------------------------*) +(* Reference to count how many counterexamples were found during a proof. *) +(*----------------------------------------------------------------------------*) + +let counterexamples = ref 0;; + +let inc_counterexamples () = counterexamples := !counterexamples + 1 ; ();; + + +(*----------------------------------------------------------------------------*) +(* inst_type *) +(*----------------------------------------------------------------------------*) +(* Hacky function to instantiate types. *) +(* I'm surprised there is no such function in HOL Light (or perhaps I just *) +(* haven't found it yet?). *) +(*----------------------------------------------------------------------------*) +(* Creates a variable of the given type. Instantiates the term using "inst" *) +(* then returns the type of the resulting term. *) +(*----------------------------------------------------------------------------*) + +let inst_type : (hol_type * hol_type) list -> hol_type -> hol_type = + fun ins ty -> + let tm = mk_var ("x",ty) in + let itm = inst ins tm in + type_of itm;; + + +(*----------------------------------------------------------------------------*) +(* shell_type_match *) +(*----------------------------------------------------------------------------*) +(* Does a deep search to check if a type can be properly grounded to a *) +(* combination of types defined in the shell. *) +(* Returns the type instantiation pairs to make it happen. *) +(* Variable types are instantiated by `:num`. *) +(*----------------------------------------------------------------------------*) +(* If the type is an instance of a type constructor (is_type) then it is *) +(* split. The name of the constructor is looked up in the system shells list. *) +(* The arguments are checked recursively. *) +(* If it's not an instance of a type constructor, we try to replace it by *) +(* `:num`. *) +(*----------------------------------------------------------------------------*) + +let rec shell_type_match : hol_type -> (hol_type * hol_type) list = + fun ty -> + if (is_type ty) then + let tys,tyargs = dest_type ty in + let info = try sys_shell_info tys + with Failure _ -> failwith ("No shell defined for type '" ^ + (string_of_type ty) ^ "'") in + itlist union (map shell_type_match tyargs) [] + else + try type_match ty `:num` [] + with Failure _ -> failwith ("Unknown type '" ^ + (string_of_type ty) ^ "' that doesn't match 'num'!");; + + +(*----------------------------------------------------------------------------*) +(* HL_rewrite_ground_term : term -> term *) +(* *) +(* Uses HOL Light's REWRITE_CONV to rewrite a ground term. *) +(* The function and accessor definitions are used as rewrite rules. *) +(* This reduces valid expressions to `T`. *) +(*----------------------------------------------------------------------------*) + +let HL_rewrite_ground_term tm = +(* ((proof_print_newline) o (proof_print_term) o (proof_print_string "Checking:")) tm ;*) + if (frees tm = []) then +(* let rules = (union ((flat o defs) ()) (all_accessor_thms ())) *) +(* let rules = (union (rewrite_rules ()) (all_accessor_thms ())) *) + let numred = try (rhs o concl o NUM_REDUCE_CONV) tm with Failure _ -> tm in + if (is_T numred) then numred else + let rew = REWRITE_CONV (union (rewrite_rules ()) (all_accessor_thms ())) + in (rhs o concl o rew) tm + else failwith ("rewrite_ground_term: free vars in term: " ^ (string_of_term tm));; + + + +let HL_rewrite_ground_term' tm = + if (frees tm = []) then +(* let rules = (union ((flat o defs) ()) (all_accessor_thms ())) *) + let rules = (union ((flat o defs) ()) (all_accessor_thms ())) in + let arith_rules = [PRE;ADD;MULT;EXP;EVEN;ODD;LE;LT;GE;GT;SUB] in +(* Need to apply preprocessing similar to add_def in environment.ml *) + let rew = REWRITE_CONV (ARITH :: (subtract rules arith_rules)) + in (rhs o concl o rew) tm + else failwith ("rewrite_ground_term: free vars in term: " ^ (string_of_term tm));; + +(*----------------------------------------------------------------------------*) +(* random_example : int -> hol_type -> term *) +(*----------------------------------------------------------------------------*) +(* Creates a random example of a given type. *) +(* The first argument is a maximum depth so as to control the size of the *) +(* example. *) +(*----------------------------------------------------------------------------*) +(* Uses "shell_type_match" in order to ground the type to a combination of *) +(* types defined as shells. Therefore, all variable types are instantiated to *) +(* `:num`. *) +(* Instantiates the arg_types of the shell for each constructor, then uses *) +(* mk_cons_type to create proper types for the constructors. Having those and *) +(* by using mk_mconst creates the constructors as terms. *) +(* random_example is called recursively for every constructor argument, while *) +(* decreasing the maxdepth to ensure termination. *) +(* If maxdepth is reached, we just pick randomly one of the base *) +(* constructors. *) +(*----------------------------------------------------------------------------*) +(* NOTE: The current version can still afford a few optimisations. *) +(* eg. The preprocessing so as to ground the given type should only happen *) +(* once. *) +(* NOTE: We could optimise this function further by accommodating the *) +(* constructors as terms (rather than or in addition to strings) within the *) +(* shell. *) +(*----------------------------------------------------------------------------*) + +let random_example : int -> hol_type -> term = + let rec random_example': int->int->hol_type->term = + fun origdepth maxdepth ty -> + let tyi = shell_type_match ty in + let ty' = inst_type tyi ty in + let tystr,typarams = dest_type ty' in + let sinfo = sys_shell_info tystr in + let ocons = shell_constructors sinfo in + let sh_arg_types = shell_arg_types sinfo in + + let arg_type_pairs = zip sh_arg_types typarams in + let arg_types_matches = try + itlist (fun (x,y) l -> type_match x y l) arg_type_pairs tyi + with Failure _ -> failwith "Shell argument types cannot be matched." in + + let mk_cons_type = fun arglist -> + List.fold_left (fun ty i -> mk_type ("fun",[i;ty])) ty' (rev arglist) in + let inst_cons = map (fun x,y,_ -> x,map (inst_type arg_types_matches) y) ocons in + let mk_cons = fun x,y -> + try let n = num_of_string x in (mk_numeral n),y + with Failure _ -> mk_mconst(x,(mk_cons_type y)),y in + let cons = map mk_cons inst_cons in + + let terminal_filter = fun (_,l) -> (l=[]) in + let tcons,ntcons = partition terminal_filter cons in + + if (maxdepth > 1) then + let prob = 200/((maxdepth-1)*3) in +(* let newdepth = origdepth / (length cons) in*) + let newdepth = maxdepth - 1 in + let selcons = if ((Random.int 100) <= prob) then tcons else ntcons in + let cconstm,cconsargs = List.nth selcons (Random.int (length selcons)) in + let args = (map (random_example' origdepth newdepth) cconsargs) in + List.fold_left (fun x y -> mk_comb (x,y)) cconstm args + else + (fst o hd) tcons + in fun maxdepth ty -> random_example' maxdepth maxdepth ty;; + +(* print_string "*" ; print_term cconstm ; print_string "*" ; print_type (type_of cconstm); print_newline (); *) +(* map (fun x -> print_term x ; print_string ":" ; print_type (type_of x); print_newline()) args ; *) +(* print_newline (); *) + + +let random_grounding maxdepth tm = + let vars = frees tm in + let types = map type_of vars in + let examples = map (random_example maxdepth) types in + let pairs = zip vars examples in + let insts = map (fun v,e -> term_match [] v e) pairs in + itlist instantiate insts tm;; + + +let counter_check_once maxdepth tm = + let tm' = random_grounding maxdepth tm in + let tm'' = HL_rewrite_ground_term tm' in + if (is_T(tm'')) then true else let junk = + warn (!proof_printing) ("Found counterexample for " ^ string_of_term(tm) ^ " : " ^ string_of_term(tm')) in + inc_counterexamples() ; false;; + +let rec counter_check_n maxdepth n tm = + if (n<=0) then true + else if (counter_check_once maxdepth tm) then counter_check_n maxdepth (n-1) tm + else false;; + +let counter_check maxdepth tm = + counter_check_n maxdepth !counter_check_num tm;; diff --git a/Boyer_Moore/definitions.ml b/Boyer_Moore/definitions.ml new file mode 100644 index 0000000..38291fd --- /dev/null +++ b/Boyer_Moore/definitions.ml @@ -0,0 +1,141 @@ +(******************************************************************************) +(* FILE : definitions.ml *) +(* DESCRIPTION : Using definitions. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 6th June 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 3rd August 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* recursive_calls : string -> term -> term list *) +(* *) +(* Function to compute the occurrences of applications of a constant in a *) +(* term. The first argument is the name of the constant. The second argument *) +(* is the term to be examined. If there are no occurrences, an empty list is *) +(* returned. The function assumes that the term does not contain *) +(* abstractions. *) +(*----------------------------------------------------------------------------*) + +let rec recursive_calls name tm = + try (let (f,args) = strip_comb tm + in if (try(fst (dest_const f) = name) with Failure _ -> false) + then [tm] + else itlist List.append (map (recursive_calls name) args) []) + with Failure _ -> [];; + +(*----------------------------------------------------------------------------*) +(* is_subterm : term -> term -> bool *) +(* *) +(* Function to compute whether one term is a subterm of another. *) +(*----------------------------------------------------------------------------*) + +let rec is_subterm subterm tm = +try( if (tm = subterm) + then true + else ((is_subterm subterm (rator tm)) or (is_subterm subterm (rand tm))) + )with Failure _ -> false;; + +(*----------------------------------------------------------------------------*) +(* no_new_terms : term -> term -> bool *) +(* *) +(* Function to determine whether all of the arguments of an application *) +(* "f x1 ... xn" are subterms of a term. *) +(*----------------------------------------------------------------------------*) + +let no_new_terms app tm = +try + (let args = snd (strip_comb app) + in itlist (fun x y -> x & y) (map (fun arg -> is_subterm arg tm) args) true + ) with Failure _ -> failwith "no_new_terms";; + +(*----------------------------------------------------------------------------*) +(* hide_fun_call : term -> term -> term *) +(* *) +(* Function to replace occurrences of a particular function call in a term *) +(* with a genvar, so that `no_new_terms' can be used to look for arguments in *) +(* a term less the original call. *) +(*----------------------------------------------------------------------------*) + +let hide_fun_call app tm = + let var = genvar (type_of app) + in subst [(var,app)] tm;; + +(*----------------------------------------------------------------------------*) +(* is_explicit_value : term -> bool *) +(* *) +(* Function to compute whether a term is an explicit value. An explicit value *) +(* is either T or F or an application of a shell constructor to explicit *) +(* values. A `bottom object' corresponds to an application to no arguments. *) +(* I have also made numeric constants explicit values, since they are *) +(* equivalent to some number of applications of SUC to 0. *) +(*----------------------------------------------------------------------------*) + +let is_explicit_value tm = + let rec is_explicit_value' constructors tm = + (is_T tm) or (is_F tm) or ((is_const tm) & (type_of tm = `:num`)) or + (let (f,args) = strip_comb tm + in (try(mem (fst (dest_const f)) constructors) with Failure _ -> false) & + (forall (is_explicit_value' constructors) args)) + in is_explicit_value' (all_constructors ()) tm;; + +(*----------------------------------------------------------------------------*) +(* more_explicit_values : term -> term -> bool *) +(* *) +(* Returns true if and only if a new function call (second argument) has more *) +(* arguments that are explicit values than the old function call (first *) +(* argument). *) +(*----------------------------------------------------------------------------*) + +let more_explicit_values old_call new_call = +try + (let (f1,args1) = strip_comb old_call + and (f2,args2) = strip_comb new_call + in if (f1 = f2) + then let n1 = length (filter is_explicit_value args1) + and n2 = length (filter is_explicit_value args2) + in n2 > n1 + else failwith "" ) with Failure _ -> failwith "more_explicit_values";; + +(*----------------------------------------------------------------------------*) +(* good_properties : term list -> term -> term -> term -> bool *) +(* *) +(* Function to determine whether the recursive calls in the expansion of a *) +(* function call have good properties. The first argument is a list of *) +(* assumptions currently being made. The second argument is the original *) +(* call. The third argument is the (simplified) expansion of the call, and *) +(* the fourth argument is the term currently being processed and which *) +(* contains the function call. *) +(*----------------------------------------------------------------------------*) + +(*< Boyer and Moore's heuristic +let good_properties assumps call body_of_call tm = + let rec in_assumps tm assumps = + if (assumps = []) + then false + else if (is_subterm tm (hd assumps)) + then true + else in_assumps tm (tl assumps) + in + (let name = fst (dest_const (fst (strip_comb call))) + and body_less_call = hide_fun_call call tm + in let rec_calls = recursive_calls name body_of_call + in let bools = map (fun rc -> (no_new_terms rc body_less_call) or + (in_assumps rc assumps) or + (more_explicit_values call rc)) rec_calls + in itlist (fun x y -> x & y) bools true + ) with Failure _ -> failwith "good_properties";; +>*) + +(* For HOL implementation, the restricted form of definitions allows all *) +(* recursive calls to be considered to have good properties. *) + +let good_properties assumps call body_of_call tm = true;; diff --git a/Boyer_Moore/environment.ml b/Boyer_Moore/environment.ml new file mode 100644 index 0000000..b6a845f --- /dev/null +++ b/Boyer_Moore/environment.ml @@ -0,0 +1,260 @@ +(******************************************************************************) +(* FILE : environment.ml *) +(* DESCRIPTION : Environment of definitions and pre-proved theorems for use *) +(* in automation. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 8th May 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 12th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +let my_gen_terms = ref ([]:term list);; +let bm_steps = ref (0,0);; + + +let rec GSPEC th = + let wl,w = dest_thm th in + if is_forall w then + GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) + else th;; + +let LIST_CONJ = end_itlist CONJ ;; + +let rec CONJ_LIST n th = + try if n=1 then [th] else (CONJUNCT1 th)::(CONJ_LIST (n-1) (CONJUNCT2 th)) + with Failure _ -> failwith "CONJ_LIST";; + +(*----------------------------------------------------------------------------*) +(* Reference variable to hold the defining theorems for operators currently *) +(* defined within the system. Each definition is stored as a triple. The *) +(* first component is the name of the operator. The second is the number of *) +(* the recursive argument. If the operator is not defined recursively, this *) +(* number is zero. The third component is a list of pairs of type constructor *) +(* names and the theorems that define the behaviour of the operator for each *) +(* constructor. If the operator is not recursive, the constructor names are *) +(* empty (null) strings. *) +(*----------------------------------------------------------------------------*) + +let system_defs = ref ([] : (string * (int * (string * thm) list)) list);; + +(*----------------------------------------------------------------------------*) +(* new_def : thm -> void *) +(* *) +(* Make a new definition available. Checks that theorem has no hypotheses, *) +(* then splits it into conjuncts. The variables for each conjunct are *) +(* specialised and then the conjuncts are made into equations. *) +(* *) +(* For each equation, a triple is obtained, consisting of the name of the *) +(* function on the LHS, the number of the recursive argument, and the name of *) +(* the constructor used in that argument. This process fails if the LHS is *) +(* not an application of a constant (possibly to zero arguments), or if more *) +(* than one of the arguments is anything other than a variable. The argument *) +(* that is not a variable must be an application of a constructor. If the *) +(* function is not recursive, the argument number returned is zero. *) +(* *) +(* Having obtained a triple for each equation, a check is made that the first *) +(* two components are the same for each equation. Then, the equations are *) +(* saved together with constructor names for each, and the name of the *) +(* operator being defined, and the number of the recursive argument. *) +(*----------------------------------------------------------------------------*) + +let new_def th = +try + (let make_into_eqn th = + let tm = concl th + in if (is_eq tm) then th + else if (is_neg tm) then EQF_INTRO th + else EQT_INTRO th + and get_constructor th = + let tm = lhs (concl th) + in let (f,args) = strip_comb tm + in let name = fst (dest_const f) + in let bools = number_list (map is_var args) + in let i = itlist (fun (b,i) n -> if ((not b) & (n = 0)) then i + else if b then n else failwith "") bools 0 + in if (i = 0) + then ((name,i),"") + else ((name,i),fst (dest_const (fst (strip_comb (el (i-1) args))))) + in let ([],tm) = dest_thm th + in let ths = CONJ_LIST (length (conj_list tm)) th + in let ths' = map SPEC_ALL ths + in let eqs = map make_into_eqn ths' + in let constructs = map get_constructor eqs + in let (xl,yl) = hashI setify (List.split constructs) + in let (name,i) = if (length xl = 1) then (hd xl) else failwith "" + in system_defs := (name,(i,List.combine yl eqs))::(!system_defs) + ) with Failure _ -> failwith "new_def";; + +(*----------------------------------------------------------------------------*) +(* defs : void -> thm list list *) +(* *) +(* Returns a list of lists of theorems currently being used as definitions. *) +(* Each list in the list is for one operator. *) +(*----------------------------------------------------------------------------*) + +let defs () = map ((map snd) o snd o snd) (!system_defs);; +let defs_names () = map fst (!system_defs);; + +(*----------------------------------------------------------------------------*) +(* get_def : string -> (string # int # (string # thm) list) *) +(* *) +(* Function to obtain the definition information of a named operator. *) +(*----------------------------------------------------------------------------*) + +let get_def name = try ( assoc name (!system_defs) ) with Failure _ -> failwith "get_def";; + +(*----------------------------------------------------------------------------*) +(* Reference variable for a list of theorems currently proved in the system. *) +(* These theorems are available to the automatic proof procedures for use as *) +(* rewrite rules. The elements of the list are actually pairs of theorems. *) +(* The first theorem is that specified by the user. The second is an *) +(* equivalent theorem in a standard form. *) +(*----------------------------------------------------------------------------*) + +let system_rewrites = ref ([] : (thm * thm) list);; + +(*----------------------------------------------------------------------------*) +(* CONJ_IMP_IMP_IMP = |- x /\ y ==> z = x ==> y ==> z *) +(*----------------------------------------------------------------------------*) + +let CONJ_IMP_IMP_IMP = + prove + (`((x /\ y) ==> z) = (x ==> (y ==> z))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + BOOL_CASES_TAC `z:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* CONJ_UNDISCH : thm -> thm *) +(* *) +(* Undischarges the conjuncts of the antecedant of an implication. *) +(* e.g. |- x /\ (y /\ z) /\ w ==> x ---> x, y /\ z, w |- x *) +(* *) +(* Has to check for negations, because UNDISCH processes them when we don't *) +(* want it to. *) +(*----------------------------------------------------------------------------*) + +let rec CONJ_UNDISCH th = +try + (let th' = CONV_RULE (REWR_CONV CONJ_IMP_IMP_IMP) th + in let th'' = UNDISCH th' + in CONJ_UNDISCH th'') + with Failure _ -> try (if not (is_neg (concl th)) then UNDISCH th else failwith "") + with Failure _ -> failwith "CONJ_UNDISCH";; + +(*----------------------------------------------------------------------------*) +(* new_rewrite_rule : thm -> void *) +(* *) +(* Make a new rewrite rule available. Checks that theorem has no hypotheses. *) +(* The theorem is saved together with an equivalent theorem in a standard *) +(* form. Theorems are fully generalized, then specialized with unique *) +(* variable names (genvars), and then standardized as follows: *) +(* *) +(* |- (h1 /\ ... /\ hn) ==> (l = r) ---> h1, ..., hn |- l = r *) +(* |- (h1 /\ ... /\ hn) ==> ~b ---> h1, ..., hn |- b = F *) +(* |- (h1 /\ ... /\ hn) ==> b ---> h1, ..., hn |- b = T *) +(* |- l = r ---> |- l = r *) +(* |- ~b ---> |- b = F *) +(* |- b ---> |- b = T *) +(* *) +(* A conjunction of rules may be given. The function will treat each conjunct *) +(* in the theorem as a separate rule. *) +(*----------------------------------------------------------------------------*) + +let rec new_rewrite_rule th = +try (if (is_conj (concl th)) + then (map new_rewrite_rule (CONJUNCTS th); ()) + else let ([],tm) = dest_thm th + in let th' = GSPEC (GEN_ALL th) + in let th'' = try (CONJ_UNDISCH th') with Failure _ -> th' + in let tm'' = concl th'' + in let th''' = + (if (is_eq tm'') then th'' + else if (is_neg tm'') then EQF_INTRO th'' + else EQT_INTRO th'') + in system_rewrites := (th,th''')::(!system_rewrites) + ) with Failure _ -> failwith "new_rewrite_rule";; + +(*----------------------------------------------------------------------------*) +(* rewrite_rules : void -> thm list *) +(* *) +(* Returns the list of theorems currently being used as rewrites, in the form *) +(* they were originally given by the user. *) +(*----------------------------------------------------------------------------*) + +let rewrite_rules () = map fst (!system_rewrites);; + +(*----------------------------------------------------------------------------*) +(* Reference variable to hold the generalisation lemmas currently known to *) +(* the system. *) +(*----------------------------------------------------------------------------*) + +let system_gen_lemmas = ref ([] : thm list);; + +(*----------------------------------------------------------------------------*) +(* new_gen_lemma : thm -> void *) +(* *) +(* Make a new generalisation lemma available. *) +(* Checks that the theorem has no hypotheses. *) +(*----------------------------------------------------------------------------*) + +let new_gen_lemma th = + if ((hyp th) = []) + then system_gen_lemmas := th::(!system_gen_lemmas) + else failwith "new_gen_lemma";; + +(*----------------------------------------------------------------------------*) +(* gen_lemmas : void -> thm list *) +(* *) +(* Returns the list of theorems currently being used as *) +(* generalisation lemmas. *) +(*----------------------------------------------------------------------------*) + +let gen_lemmas () = !system_gen_lemmas;; + + + +(*----------------------------------------------------------------------------*) +(* max_var_depth : term -> int *) +(* *) +(* Returns the maximum depth of any variable in a term. *) +(* eg. max_var_depth `PRE (a + SUC c)` = 4 *) +(* max_var_depth `a` = 1 *) +(* max_var_depth `PRE (5 + SUC 2)` = 0 *) +(* max_var_depth `PRE (a + SUC 2)` = 3 *) +(*----------------------------------------------------------------------------*) +(* This is primarily used to limit non-termination. If max_var_depth exceeds *) +(* a limit the system will fail. *) +(* The algorithm is simple: *) +(* if constant,numeral,etc then 0 *) +(* else if variable then 1 *) +(* else if definition,constructor,accessor then *) +(* if (max_var_depth of arguments) > 0 then result + 1 *) +(* else 0 *) +(* else if any other combination then max_var_depth of arguments *) +(*----------------------------------------------------------------------------*) + + +let rec max_var_depth tm = + if (is_var tm) then 1 + else if ((is_numeral tm) + or (is_const tm) + or (is_T tm) or (is_F tm)) then 0 + else try + let (f,args) = strip_comb tm in + let fn = (fst o dest_const) f in + let l = flat [defs_names();all_constructors();all_accessors()] in + if (mem fn l) then + let x = itlist max (map max_var_depth args) 0 in + if (x>0) then x+1 else 0 + else itlist max (map max_var_depth args) 0 + with Failure _ -> 0;; diff --git a/Boyer_Moore/equalities.ml b/Boyer_Moore/equalities.ml new file mode 100644 index 0000000..6429e3f --- /dev/null +++ b/Boyer_Moore/equalities.ml @@ -0,0 +1,179 @@ +(******************************************************************************) +(* FILE : equalities.ml *) +(* DESCRIPTION : Using equalities. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 19th June 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 7th August 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* is_explicit_value_template : term -> bool *) +(* *) +(* Function to compute whether a term is an explicit value template. *) +(* An explicit value template is a non-variable term composed entirely of *) +(* T or F or variables or applications of shell constructors. *) +(* A `bottom object' corresponds to an application to no arguments. I have *) +(* also made numeric constants valid components of explicit value templates, *) +(* since they are equivalent to some number of applications of SUC to 0. *) +(*----------------------------------------------------------------------------*) + +let is_explicit_value_template tm = + let rec is_explicit_value_template' constructors tm = + (is_T tm) or (is_F tm) or ((is_const tm) & (type_of tm = `:num`)) or + (is_var tm) or (is_numeral tm) or + (let (f,args) = strip_comb tm + in (try(mem (fst (dest_const f)) constructors) with Failure _ -> false) & + (forall (is_explicit_value_template' constructors) args)) + in (not (is_var tm)) & + (is_explicit_value_template' (all_constructors ()) tm);; + +(*----------------------------------------------------------------------------*) +(* subst_conv : thm -> conv *) +(* *) +(* Substitution conversion. Given a theorem |- l = r, it replaces all *) +(* occurrences of l in the term with r. *) +(*----------------------------------------------------------------------------*) + +let subst_conv th tm = SUBST_CONV [(th,lhs (concl th))] tm tm;; + +(*----------------------------------------------------------------------------*) +(* use_equality_subst : bool -> bool -> thm -> conv *) +(* *) +(* Function to perform substitution when using equalities. The first argument *) +(* is a Boolean that controls which side of an equation substitution is to *) +(* take place on. The second argument is also a Boolean, indicating whether *) +(* or not we have decided to cross-fertilize. The third argument is a *) +(* substitution theorem of the form: *) +(* *) +(* t' = s' |- t' = s' *) +(* *) +(* If we are not cross-fertilizing, s' is substituted for t' throughout the *) +(* term. If we are cross-fertilizing, the behaviour depends on the structure *) +(* of the term, tm: *) +(* *) +(* (a) if tm is "l = r", substitute s' for t' in either r or l. *) +(* (b) if tm is "~(l = r)", substitute s' for t' throughout tm. *) +(* (c) otherwise, do not substitute. *) +(*----------------------------------------------------------------------------*) + +(* The heuristic above is modified so that in case (c) a substitution does *) +(* take place. This reduces the chances of an invalid subgoal (clause) being *) +(* generated, and has been shown to be a better option for certain examples. *) + +let use_equality_subst right cross_fert th tm = + try (if cross_fert + then if (is_eq tm) then + (if right + then RAND_CONV (subst_conv th) tm + else RATOR_CONV (RAND_CONV (subst_conv th)) tm) + else if ((is_neg tm) & (try(is_eq (rand tm)) with Failure _ -> false)) then subst_conv th tm + else (* ALL_CONV tm *) subst_conv th tm + else subst_conv th tm + ) with Failure _ -> failwith "use_equality_subst";; + +(*----------------------------------------------------------------------------*) +(* EQ_EQ_IMP_DISJ_EQ = *) +(* |- !x x' y y'. (x = x') /\ (y = y') ==> (x \/ y = x' \/ y') *) +(*----------------------------------------------------------------------------*) + +let EQ_EQ_IMP_DISJ_EQ = + prove + (`!x x' y y'. (x = x') /\ (y = y') ==> ((x \/ y) = (x' \/ y'))`, + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* DISJ_EQ : thm -> thm -> thm *) +(* *) +(* |- x = x' |- y = y' *) +(* ------------------------ *) +(* |- (x \/ y) = (x' \/ y') *) +(*----------------------------------------------------------------------------*) + +let DISJ_EQ th1 th2 = +try + (let (x,x') = dest_eq (concl th1) + and (y,y') = dest_eq (concl th2) + in MP (SPECL [x;x';y;y'] EQ_EQ_IMP_DISJ_EQ) (CONJ th1 th2) + ) with Failure _ -> failwith "DISJ_EQ";; + +(*----------------------------------------------------------------------------*) +(* use_equality_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* Heuristic for using equalities, and in particular for cross-fertilizing. *) +(* Given a clause, the function looks for a literal of the form ~(s' = t') *) +(* where t' occurs in another literal and is not an explicit value template. *) +(* If no such literal is present, the function looks for a literal of the *) +(* form ~(t' = s') where t' occurs in another literal and is not an explicit *) +(* value template. If a substitution literal of one of these two forms is *) +(* found, substitution takes place as follows. *) +(* *) +(* If the clause is an induction step, and there is an equality literal *) +(* mentioning t' on the RHS (or LHS if the substitution literal was *) +(* ~(t' = s')), and s' is not an explicit value, the function performs a *) +(* cross-fertilization. The substitution function is called for each literal *) +(* other than the substitution literal. Each call results in a theorem of the *) +(* form: *) +(* *) +(* t' = s' |- old_lit = new_lit *) +(* *) +(* If the clause is an induction step and s' is not an explicit value, the *) +(* substitution literal is rewritten to F, and so will subsequently be *) +(* eliminated. Otherwise this literal is unchanged. The theorems for each *) +(* literal are recombined using the DISJ_EQ rule, and the new clause is *) +(* returned. See the comments for the substitution heuristic for a *) +(* description of how the original clause is proved from the new clause. *) +(*----------------------------------------------------------------------------*) + +let use_equality_heuristic (tm,(ind:bool)) = +try (let checkx (tml1,tml2) t' = + (not (is_explicit_value_template t')) & + ((exists (is_subterm t') tml1) or (exists (is_subterm t') tml2)) + in let rec split_disjuncts side prevl tml = + if (can (check (checkx (prevl,tl tml)) o side o dest_neg) (hd tml)) + then (prevl,tml) + else split_disjuncts side ((hd tml)::prevl) (tl tml) + in let is_subterm_of_side side subterm tm = + (try(is_subterm subterm (side tm)) with Failure _ -> false) + in let literals = disj_list tm + in let (right,(overs,neq'::unders)) = + try (true,(hashI rev) (split_disjuncts rhs [] literals)) with Failure _ -> + (false,(hashI rev) (split_disjuncts lhs [] literals)) + in let side = if right then rhs else lhs + in let flipth = if right then ALL_CONV neq' else RAND_CONV SYM_CONV neq' + in let neq = rhs (concl flipth) + in let eq = dest_neg neq + in let (s',t') = dest_eq eq + in let delete = ind & (not (is_explicit_value s')) + in let cross_fert = delete & + ((exists (is_subterm_of_side side t') overs) or + (exists (is_subterm_of_side side t') unders)) + in let sym_eq = mk_eq (t',s') + in let sym_neq = mk_neg sym_eq + in let ass1 = EQ_MP (SYM flipth) (NOT_EQ_SYM (ASSUME sym_neq)) + and ass2 = ASSUME sym_eq + in let subsfun = use_equality_subst right cross_fert ass2 + in let overths = map subsfun overs + and neqth = + if delete + then TRANS (RAND_CONV (RAND_CONV (subst_conv ass2)) neq) + (ISPEC s' NOT_EQ_F) + else ADD_ASSUM sym_eq (REFL neq) + and underths = map subsfun unders + in let neqth' = TRANS flipth neqth + in let th1 = itlist DISJ2 overs (try DISJ1 ass1 (list_mk_disj unders) with Failure _ -> ass1) + and th2 = itlist DISJ_EQ overths (end_itlist DISJ_EQ (neqth'::underths)) + and th3 = SPEC sym_eq EXCLUDED_MIDDLE + in let tm' = rhs (concl th2) + in let proof th = DISJ_CASES th3 (EQ_MP (SYM th2) th) th1 + in (proof_print_string_l "-> Use Equality Heuristic" () ; ([(tm',ind)],apply_proof (proof o hd) [tm'])) + ) with Failure _ -> failwith "use_equality_heuristic`"; diff --git a/Boyer_Moore/generalize.ml b/Boyer_Moore/generalize.ml new file mode 100644 index 0000000..d4cfbfd --- /dev/null +++ b/Boyer_Moore/generalize.ml @@ -0,0 +1,566 @@ +(******************************************************************************) +(* FILE : generalize.ml *) +(* DESCRIPTION : Generalization. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 21st June 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 12th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* is_generalizable : string list -> term -> bool *) +(* *) +(* Function to determine whether or not a term has the correct properties to *) +(* be generalizable. It takes a list of accessor function names as its first *) +(* argument. This is for efficiency. It could compute them itself, but if an *) +(* external function is going to call is_generalizable many times it is *) +(* better for the external function to compute the list of accessors. *) +(*----------------------------------------------------------------------------*) + +let is_generalizable accessors tm = + not ((is_var tm) or + (is_explicit_value_template tm) or + (is_eq tm) or + (try(mem ((fst o dest_const o fst o strip_comb) tm) accessors) +with Failure _ -> false));; + +(*----------------------------------------------------------------------------*) +(* generalizable_subterms : string list -> term -> term list *) +(* *) +(* Computes the generalizable subterms of a literal, given a list of accessor *) +(* function names. *) +(*----------------------------------------------------------------------------*) + +let generalizable_subterms accessors tm = + try (setify (find_bm_terms (is_generalizable accessors) tm) + ) with Failure _ -> failwith "generalizable_subterms";; + +(*----------------------------------------------------------------------------*) +(* minimal_common_subterms : term list -> term list *) +(* *) +(* Given a list of terms, this function removes from the list any term that *) +(* has one of the other terms as a proper subterm. It also eliminates any *) +(* duplicates. *) +(*----------------------------------------------------------------------------*) + +let minimal_common_subterms tml = + let tml' = setify tml + in filter + (fun tm -> not (exists (fun tm' -> (is_subterm tm' tm) & (not (tm' = tm))) tml')) + tml';; + +(*----------------------------------------------------------------------------*) +(* to_be_generalized : term -> term list -> term -> bool *) +(* *) +(* This function decides whether a subterm of a literal should be generalized.*) +(* It takes a literal, a list of other literals, and a subterm of the literal *) +(* as arguments. The subterm should be generalized if it occurs in one of the *) +(* other literals, or if the literal is an equality and it occurs on both *) +(* sides, or if the literal is the negation of an equality and the subterm *) +(* occurs on both sides. *) +(*----------------------------------------------------------------------------*) + +let to_be_generalized tm tml gen = + try (let (l,r) = dest_eq (dest_neg tm) + in if ((is_subterm gen l) & (is_subterm gen r)) + then true + else failwith "") with Failure _ -> + try (let (l,r) = dest_eq tm + in if ((is_subterm gen l) & (is_subterm gen r)) + then true + else failwith "") with Failure _ -> + (exists (is_subterm gen) tml);; + +(*----------------------------------------------------------------------------*) +(* terms_to_be_generalized : term -> term list *) +(* *) +(* Given a clause, this function determines the subterms of the clause that *) +(* are to be generalized. For each literal, the function computes the *) +(* generalizable subterms. It then filters out those subterms that are not to *) +(* be generalized. It only looks at the remaining literals when doing this, *) +(* not at those already processed. This is legitimate because if the subterm *) +(* occurs in a previous literal, it would have already been added to the main *) +(* list of subterms that should be generalized. Before returning this main *) +(* list, the function removes any non-minimal common subterms. This operation *) +(* also removes any duplicates. *) +(*----------------------------------------------------------------------------*) + +let terms_to_be_generalized tm = + let accessors = (all_accessors ()) @ (all_constructors()) + in let rec terms_to_be_generalized' tml = + if (tml = []) + then [] + else let h::t = tml + in let gens = generalizable_subterms accessors h + in let gens' = filter (to_be_generalized h t) gens + in gens' @ (terms_to_be_generalized' t) + in minimal_common_subterms (terms_to_be_generalized' (disj_list tm));; + +(*----------------------------------------------------------------------------*) +(* distinct_var : term list -> type -> term *) +(* *) +(* Function to generate a sensibly-named variable of a specified type. *) +(* Variables that the new variable must be distinct from can be specified in *) +(* the first argument. The new variable will be named according to the first *) +(* letter of the top-level constructor in the specified type, or if the type *) +(* is a simple polymorphic type, the name `x' is used. The actual name will *) +(* be this name followed by zero or more apostrophes. *) +(*----------------------------------------------------------------------------*) + +let distinct_var vars ty = + let letter = try((hd o explode o fst o dest_type) ty) with Failure _ -> "x" + in variant vars (mk_var (letter,ty));; + +(*----------------------------------------------------------------------------*) +(* distinct_vars : term list -> type list -> term list *) +(* *) +(* Generates new variables using `distinct_var' for each of the types in the *) +(* given list. The function ensures that each of the new variables are *) +(* distinct from each other, as well as from the argument list of variables. *) +(*----------------------------------------------------------------------------*) + +let rec distinct_vars vars tyl = + if (tyl = []) + then [] + else let var = distinct_var vars (hd tyl) + in var::(distinct_vars (var::vars) (tl tyl));; + +(*----------------------------------------------------------------------------*) +(* apply_gen_lemma : term -> thm -> thm *) +(* *) +(* Given a term to be generalized and a generalization lemma, this function *) +(* tries to apply the lemma to the term. The result, if successful, is a *) +(* specialization of the lemma. *) +(* *) +(* The function checks that the lemma has no hypotheses, and then extracts a *) +(* list of subterms of the conclusion that match the given term and contain *) +(* all the free variables of the conclusion. The second condition prevents *) +(* new variables being introduced into the goal clause. The ordering of the *) +(* subterms in the list is dependent on the implementation of `find_terms', *) +(* but probably doesn't matter anyway, because the function tries each of *) +(* them until it finds one that is acceptable. *) +(* *) +(* Each subterm is tried as follows. A matching between the subterm and the *) +(* term to be generalized is obtained. This is used to instantiate the lemma. *) +(* The function then checks that when the conclusion of this new theorem is *) +(* generalized (by replacing the term to be generalized with a variable), the *) +(* function symbol of the term to be generalized no longer appears in it. *) +(*----------------------------------------------------------------------------*) + +let apply_gen_lemma tm th = +try + (let apply_gen_lemma' subtm = + (let (_,tm_bind,ty_bind) = term_match [] subtm tm + in let (insts,vars) = List.split tm_bind + in let th' = ((SPECL insts) o (GENL vars) o (INST_TYPE ty_bind)) th + in let gen_conc = subst [(genvar (type_of tm),tm)] (concl th') + and f = fst (strip_comb tm) + in if (is_subterm f gen_conc) + then failwith "" + else th') + in let ([],conc) = dest_thm th + in let conc_vars = frees conc + in let good_subterm subtm = + ((can (term_match [] subtm) tm) & ((subtract conc_vars (frees subtm)) = [])) + in let subtms = rev (find_terms good_subterm conc) + in tryfind apply_gen_lemma' subtms + ) with Failure _ -> failwith "apply_gen_lemma";; + +(*----------------------------------------------------------------------------*) +(* applicable_gen_lemmas : term list -> thm list *) +(* *) +(* Computes instantiations of generalization lemmas applicable to a list of *) +(* terms, the terms to be generalized. *) +(*----------------------------------------------------------------------------*) + +let applicable_gen_lemmas tml = + flat (map (fun tm -> mapfilter (apply_gen_lemma tm) (gen_lemmas ())) tml);; + +(*----------------------------------------------------------------------------*) +(* generalize_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* Generalization heuristic. *) +(* *) +(* This function first computes the terms to be generalized in a clause. It *) +(* fails if there are none. It then obtains a list of instantiated *) +(* generalization lemmas for these terms. Each of these lemmas is transformed *) +(* to a theorem of the form |- x = F. If the original lemma was a negation, *) +(* x is the argument of the negation. Otherwise x is the negation of the *) +(* original lemma. *) +(* *) +(* The negated lemmas are added to the clause, and the result is generalized *) +(* by replacing each of the terms to be generalized by new distinct *) +(* variables. This generalized clause is returned together with a proof of *) +(* the original clause from it. *) +(* *) +(* The proof begins by specializing the variables that were used to replace *) +(* the generalized terms. The theorem is then of the form: *) +(* *) +(* |- lemma1 \/ lemma2 \/ ... \/ lemman \/ original_clause (1) *) +(* *) +(* We have a theorem |- lemmai = F for each i between 1 and n. Consider the *) +(* first of these. From it, the following theorem can be obtained: *) +(* *) +(* |- lemma1 \/ lemma2 \/ ... \/ lemman \/ original_clause = *) +(* F \/ lemma2 \/ ... \/ lemman \/ original_clause *) +(* *) +(* Simplifying using |- F \/ x = x, this gives: *) +(* *) +(* |- lemma1 \/ lemma2 \/ ... \/ lemman \/ original_clause = *) +(* lemma2 \/ ... \/ lemman \/ original_clause *) +(* *) +(* From this theorem and (1), we obtain: *) +(* *) +(* |- lemma2 \/ ... \/ lemman \/ original_clause *) +(* *) +(* Having repeated this process for each of the lemmas, the proof eventually *) +(* returns a theorem for the original clause, i.e. |- original_clause. *) +(*----------------------------------------------------------------------------*) + +let generalize_heuristic (tm,(ind:bool)) = +try + (let NEGATE th = + let ([],tm) = dest_thm th + in if (is_neg tm) + then EQF_INTRO th + else EQF_INTRO + (CONV_RULE + (REWR_CONV + (SYM (SPEC_ALL (hd (CONJUNCTS NOT_CLAUSES))))) th) + and ELIM_LEMMA lemma th = + let rest = snd (dest_disj (concl th)) + in EQ_MP (CONV_RULE (RAND_CONV (REWR_CONV F_OR)) + (AP_THM (AP_TERM `(\/)` lemma) rest)) th + in let gen_terms = check (fun l -> not (l = [])) (terms_to_be_generalized tm) + in let lemmas = map NEGATE (applicable_gen_lemmas gen_terms) + in let tm' = itlist (curry mk_disj) (map (lhs o concl) lemmas) tm + in let new_vars = distinct_vars (frees tm') (map type_of gen_terms) + in let tm'' = subst (lcombinep (new_vars,gen_terms)) tm' + in let countercheck = try counter_check 5 tm'' with Failure _ -> + warn true "Could not generate counter example!" ; true + in if (countercheck = true) then let proof th'' = + let th' = SPECL gen_terms (GENL new_vars th'') + in rev_itlist ELIM_LEMMA lemmas th' + in (proof_print_string_l "-> Generalize Heuristic"() ; my_gen_terms := tm''::!my_gen_terms ; ([(tm'',ind)],apply_proof (proof o hd) [tm''])) + else failwith "Counter example failure!" + ) with Failure _ -> failwith "generalize_heuristic";; + + +(* Implementation of Aderhold's Generalization techniques: *) + +let is_constructor_eq constructor v tm = + try ( +let (a,b) = dest_eq tm +in let cand_c = ( if ( v = a ) then b + else if ( v = b ) then a + else failwith "" ) +in let cand_name = (fst o dest_const o fst o strip_comb) cand_c +in constructor = cand_name +(* then cand_name else failwith ""*) +) with Failure _ -> false;; + + +let is_constructor_neq constructor v tm = + try ( +let tm' = dest_neg tm +in let (a,b) = dest_eq tm' +in let cand_c = ( if ( v = a ) then b + else if ( v = b ) then a + else failwith "" ) +in let cand_name = (fst o dest_const o fst o strip_comb) cand_c +in constructor = cand_name +) with Failure _ -> false;; + + +let infer_constructor v tm = +try ( + print_term v;print_string " XXX ";print_term tm;print_newline(); + let v_ty = (fst o dest_type) (type_of v) + in let clist = map fst3 ((shell_constructors o sys_shell_info) v_ty) + in let conjs = conj_list tm + in let check_constructor_eq c v tms = + let res = map (is_constructor_eq c v) tms + in if (mem true res) then true + else false + in let check_constructor_neq c v tms = + let res = map (is_constructor_neq c v) tms + in if (mem true res) then true + else false + in let check_constructor c all_constr v tms = + if (check_constructor_eq c v tms) then true + else let constrs = subtract all_constr [c] + in let res = map (fun c -> check_constructor_neq c v tms) constrs + in if (mem false res) then false + else true + in let res = map (fun c -> check_constructor c clist v conjs) clist + in let reslist = List.combine res clist + in assoc true reslist +) with Failure _ -> failwith "infer_constructor";; + +let get_rec_pos_of_fun f = +try ( + (fst o get_def o fst o dest_const) f + ) with Failure _ -> 0;; + +let rec is_in_rec_pos subtm tm = + let (op,args) = strip_comb tm + in try ( + let rec_argn = get_rec_pos_of_fun op + in if ( (el (rec_argn - 1) args) = subtm ) + then true + else failwith "" + ) with Failure _ -> mem true (map (is_in_rec_pos subtm) args) ;; + +let is_var_in_rec_pos v tm = +try ( + if (not (is_var v)) then false + else if (not (mem v (frees tm))) then false + else is_in_rec_pos v tm +) with Failure _ -> false;; + +let eliminateSelectors tm = +try ( + let vars = frees tm + in let vars' = filter (not o (fun v -> is_var_in_rec_pos v tm )) vars + in if (vars' = []) then tm + else let rec find_candidate vars tm = + if ( vars = [] ) then failwith "find_candidate" + else let var = (hd vars) in try ( (var,infer_constructor var tm) ) + with Failure _ -> find_candidate (tl vars) tm + in let (var,constr) = find_candidate vars' tm + in let v_ty = (fst o dest_type) (type_of var) + in let s_info = sys_shell_info v_ty + in let new_vars = distinct_vars vars (shell_constructor_arg_types constr s_info) + in let new_subtm = list_mk_icomb constr new_vars + in let new_tm = subst [new_subtm,var] tm + in (snd o dest_eq o concl) (REWRITE_CONV (map snd (shell_constructor_accessors constr s_info)) new_tm) +) with Failure _ -> failwith "eliminateSelectors";; + + +let all_variables = + let rec vars(acc,tm) = + if is_var tm then tm::acc + else if is_const tm then acc + else if is_abs tm then + let v,bod = dest_abs tm in + vars(v::acc,bod) + else + let l,r = dest_comb tm in + vars(vars(acc,r),l) in + fun tm -> vars([],tm);; + +let all_equations = + let rec eqs(acc,tm) = + if is_eq tm then tm::acc + else if is_var tm then acc + else if is_const tm then acc + else if is_abs tm then + let v,bod = dest_abs tm in + eqs(acc,bod) + else + let l,r = dest_comb tm in + eqs(eqs(acc,r),l) in + fun tm -> eqs([],tm);; + +let rec contains_any tm args = + if is_var tm then false + else if is_numeral tm then false + else if is_const tm then mem ((fst o dest_const) tm) args + else if is_abs tm then + let v,bod = dest_abs tm in + contains_any v args + else + let l,r = dest_comb tm in + (contains_any l args) or (contains_any r args);; + +let is_rec_type tm = try( mem ((fst o dest_type o type_of) tm) (shells()) ) with Failure _ -> false;; + +let is_generalizable_subterm bad tm = + (is_rec_type tm) & + not ( (is_var tm) or + (is_const tm) or + (is_numeral tm) or + (contains_any tm bad) );; + +(*----------------------------------------------------------------------------*) +(* A set S of terms is called a suitable proposal for some formula phi if each*) +(* t' in S is a generalizable subterm of phi and if there is some t' in S that*) +(* occurs at least twice in phi. *) +(* Here gens is assumed to be the generalizable subterms of phi as found by *) +(* find_bm_terms. This means that it will contain t' as many times as it was *) +(* found in phi. Therefore, the occurences of t' in gens are equivalent to its*) +(* occurences in phi. *) +(*----------------------------------------------------------------------------*) + +let is_suitable_proposal s phi gens = + ( forall (fun tm -> mem tm gens) s ) & (exists (fun tm -> lcount tm gens > 1) s);; + + +let checksuitableeq = ref true;; (* equation criterion *) +let newisgen = ref true;; (* Use Aderhold's (true) or Boulton's (false) is_generalizable for terms *) + +let is_eq_suitable t eq = + if (not !checksuitableeq) then true + else if (not (is_eq eq)) then false + else let l,r = dest_eq eq in + if ((is_subterm t r) & (is_subterm t l)) then true + else length(find_bm_terms ((=) t) eq) > 1;; + + +let generateProposals tm phi = + let rec generateProposals' bad tm phi gens = + let p = [] in + if (is_eq tm) + then let (t1,t2) = dest_eq tm + in let p1 = (generateProposals' bad t1 phi gens) + in let p1' = if (is_suitable_proposal [t1] phi gens) then p1@[[t1]] else p1 + in let p = p @ filter (exists (fun t -> is_eq_suitable t tm)) p1' + in let p2 = (generateProposals' bad t2 phi gens) + in let p2' = if (is_suitable_proposal [t2] phi gens) then p2@[[t2]] else p2 + in p @ filter (exists (fun t -> is_eq_suitable t tm)) p2' + else if (is_comb tm) + then let (op,args) = strip_comb tm + in let recpos = get_rec_pos_of_fun op + in let s = if (recpos > 0) then [el (recpos-1) args] else [] + in let p = if (is_suitable_proposal s phi gens) then p@[s] else p + in p @ flat (map (fun tm -> generateProposals' bad tm phi gens) args) + else p + in let bad = (all_accessors()) @ (all_constructors()) + in let gens = if (!newisgen) then find_bm_terms (is_generalizable_subterm bad) phi + else find_bm_terms (is_generalizable bad) phi + in generateProposals' bad tm phi gens;; + +let proposal_induction_test s phi = + let newvars = distinct_vars (frees phi) (map (type_of) s) + in let subs = List.combine newvars s + in let newterm = subst subs phi + in let (unfl,fl) = possible_inductions newterm + in if (exists (fun v -> (mem v (unfl@fl)) ) newvars ) then true else false;; + +let get_proposal_term_occs s phi = + let gens = find_bm_terms (fun tm -> true) phi + in let scount = map (fun tm -> lcount tm gens) s + in itlist (+) scount 0;; + +let organizeProposals s phi = + let stest = map (fun prop -> (prop,proposal_induction_test prop phi)) s + in let indok = filter (((=) true) o snd) stest + in let s' = if (indok = []) then (proof_print_string_l "Weak Generalization" (map fst stest)) else (map fst indok) + in if (length s' = 1) then hd s' + else let scounted = (rev o sort_on_snd) (map (fun prop -> (prop,lcount prop s')) s') + in let smax = (snd o hd) scounted + in let s'' = map fst (filter (((=) smax) o snd) scounted) + in if (length s'' = 1) then hd s'' + else let soccscounted = (rev o sort_on_snd) (map (fun prop -> (prop,get_proposal_term_occs prop phi)) s'') + in (fst o hd) soccscounted;; + +let generalizeCommonSubterms tm = + let props = generateProposals tm tm + in if (props = []) then failwith "" + else let s = organizeProposals props tm + in let newvars = distinct_vars (frees tm) (map type_of s) + in let varcomb = List.combine newvars s + in (subst varcomb tm,varcomb);; + +let rec separate f v v' allrpos tm = + let replace tm v v' rpos = + if (not rpos) then tm + else if (tm = v) then v' + else (separate f v v' allrpos tm) + in if (is_comb tm) then ( + let (op,args) = strip_comb tm + in let recpos = get_rec_pos_of_fun op + in if ((allrpos) & not (op = `(=)`)) + then (list_mk_comb (op,(map (fun (t,i) -> replace t v v' ((i = recpos) or (recpos = 0))) (number_list args)))) + else if (op = `(=)`) + then (list_mk_comb(op,[replace (hd args) v v' true;replace ((hd o tl) args) v v' true])) + else if (op = f) + then (list_mk_comb (op,(map (fun (t,i) -> replace t v v' (i = recpos)) (number_list args)))) + else (list_mk_comb (op,(map (separate f v v' allrpos) args))) + ) + else tm;; + + +let rec generalized_apart_successfully v v' tm tm' = + if (tm' = v') then true + else if (is_eq tm) then ( let (tm1,tm2) = dest_eq tm + in let (tm1',tm2') = dest_eq tm' + in (generalized_apart_successfully v v' tm1 tm1') + & (generalized_apart_successfully v v' tm2 tm2') ) + else ( let av = all_variables tm + in let av' = all_variables tm' + in let varsub = List.combine av av' + in ((mem (v,v') varsub) & (mem v av')) );; + +let useful_apart_generalization v v' tm gen = + let eqssub = List.combine (all_equations tm) (all_equations gen) + in let eqsok = forall (fun (x,y) -> (x=y) or (generalized_apart_successfully v v' x y)) eqssub + in let countercheck = try counter_check 5 gen with Failure s -> + warn true ("Could not generate counter example: " ^ s) ; true + in eqsok & (generalized_apart_successfully v v' tm gen) & countercheck;; + +let generalize_Apart tm = + let is_fun tm = (try( mem ((fst o dest_const o fst o strip_comb) tm) (defs_names ()) ) with Failure _ -> false) + in let fs = find_bm_terms is_fun tm + in let dfs = map strip_comb fs + in let find_f (op,args) dfs = ( + let r = get_rec_pos_of_fun op + in let arg_filter args args' = + (let v = el (r-1) args + in (is_var v) & (mem v (snd (remove_el r args')))) + in let match_filter (op',args') = + ((op' = op) & (arg_filter args args')) + in can (find match_filter) dfs ) + in let (f,args) = try( find (fun (op,args) -> find_f (op,args) dfs) dfs ) with Failure _ -> failwith "" + in let v = el ((get_rec_pos_of_fun f) -1) args + in let v' = distinct_var (flat (map frees args)) (type_of v) + in let gen = separate f v v' false tm + in if (useful_apart_generalization v v' tm gen) then (gen,[v',v]) + else let pcs = map fst dfs + in let restpcs = subtract pcs [f] + in let recposs = map get_rec_pos_of_fun restpcs + in let recpos = try (find ((<) 0) recposs) with Failure _ -> 0 + in let gen = if (forall (fun x -> (x = 0) or (x = recpos)) recposs) + then separate f v v' true tm + else failwith "not same recpos for all functions" + in if (useful_apart_generalization v v' tm gen) then (gen,[v',v]) + else failwith "failed";; + +(*----------------------------------------------------------------------------*) +(* Reference flag to check if a term has already been generalized so as to *) +(* avoid multiple proposal generalization because of the waterfall loop. *) +(*----------------------------------------------------------------------------*) +let checkgen = ref true;; + +let generalize_heuristic_ext (tm,(ind:bool)) = +if (mem tm !my_gen_terms & !checkgen) then failwith "" +else +try + (let ELIM_LEMMA lemma th = + let rest = snd (dest_disj (concl th)) + in EQ_MP (CONV_RULE (RAND_CONV (REWR_CONV F_OR)) + (AP_THM (AP_TERM `(\/)` lemma) rest)) th + in let (tm',subs) = try( generalize_Apart tm ) with Failure _ -> (tm,[]) + in let (new_vars,gen_terms) = List.split subs + in let (tm'',subs) = try( generalizeCommonSubterms tm' ) with Failure _ -> (tm',[]) + in if (tm = tm'') then failwith "" + else let (new_vars',gen_terms') = List.split subs + in let gen_terms = gen_terms@gen_terms' and new_vars = new_vars @ new_vars' + in let lemmas = [] + in let countercheck = try counter_check 5 tm'' with Failure s -> + warn true ("Could not generate counter example: " ^ s) ; true + in if (countercheck = true) then let proof th'' = + let th' = SPECL gen_terms (GENL new_vars th'') + in rev_itlist ELIM_LEMMA lemmas th' + in (proof_print_string_l "-> Generalize Heuristic"() ; my_gen_terms := tm''::!my_gen_terms ; ([(tm'',ind)],apply_proof (proof o hd) [tm''])) + else failwith "Counter example failure!" + ) with Failure _ -> failwith "generalize_heuristic";; + diff --git a/Boyer_Moore/induction.ml b/Boyer_Moore/induction.ml new file mode 100644 index 0000000..d9c72d0 --- /dev/null +++ b/Boyer_Moore/induction.ml @@ -0,0 +1,153 @@ +(******************************************************************************) +(* FILE : induction.ml *) +(* DESCRIPTION : Induction. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 26th June 1991 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +let (CONV_OF_RCONV: conv -> conv) = + let rec get_bv tm = + if is_abs tm then bndvar tm + else if is_comb tm then + try get_bv (rand tm) with Failure _ -> get_bv (rator tm) + else failwith "" in + fun conv tm -> + let v = get_bv tm in + let th1 = conv tm in + let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in + TRANS th1 th2;; + +let (CONV_OF_THM: thm -> conv) = + CONV_OF_RCONV o REWR_CONV;; + +let RIGHT_IMP_FORALL_CONV = CONV_OF_THM RIGHT_IMP_FORALL_THM;; +(* Does this work?? *) + +(*----------------------------------------------------------------------------*) +(* is_rec_const_app : term -> bool *) +(* *) +(* This function returns true if the term it is given is an application of a *) +(* currently known recursive function constant. *) +(*----------------------------------------------------------------------------*) + +let is_rec_const_app tm = +try (let (f,args) = strip_comb tm + in let (n,defs) = (get_def o fst o dest_const) f + in (n > 0) & + ((length o snd o strip_comb o lhs o concl o snd o hd) defs = length args) + ) with Failure _ -> false;; + + +(*----------------------------------------------------------------------------*) +(* possible_inductions : term -> (term list # term list) *) +(* *) +(* Function to compute two lists of variables on which induction could be *) +(* performed. The first list of variables for which the induction is unflawed *) +(* and the second is of variables for which the induction is flawed. *) +(* *) +(* From a list of applications of recursive functions, the arguments are *) +(* split into those that are in a recursive argument position and those that *) +(* are not. Possible inductions are on the variables in the recursive *) +(* argument positions, but if the variable also appears in a non-recursive *) +(* argument position then the induction is flawed. *) +(*----------------------------------------------------------------------------*) + +let possible_inductions tm = + let apps = find_bm_terms is_rec_const_app tm + in let (rec_args,other_args) = + List.split (map (fun app -> let (f,args) = strip_comb app + in let name = fst (dest_const f) + in let n = (fst o get_def) name + in remove_el n args) apps) + in let vars = setify (filter is_var rec_args) + in let others = setify (flat other_args) + in partition (fun v -> not (mem v others)) vars;; + +(*----------------------------------------------------------------------------*) +(* DEPTH_FORALL_CONV : conv -> conv *) +(* *) +(* Given a term of the form "!x1 ... xn. t", this function applies the *) +(* argument conversion to "t". *) +(*----------------------------------------------------------------------------*) + +let rec DEPTH_FORALL_CONV conv tm = + if (is_forall tm) + then RAND_CONV (ABS_CONV (DEPTH_FORALL_CONV conv)) tm + else conv tm;; + +(*----------------------------------------------------------------------------*) +(* induction_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* Heuristic for induction. It performs one of the possible unflawed *) +(* inductions on a clause, or failing that, one of the flawed inductions. *) +(* The heuristic fails if no inductions are possible. *) +(* *) +(* Having obtained a variable on which to perform induction, the function *) +(* computes the name of the top-level type constructor in the type of the *) +(* variable. The appropriate induction theorem is then obtained from the *) +(* shell environment. The theorem is specialised for the argument clause and *) +(* beta-reduction is performed at the appropriate places. *) +(* *) +(* The resulting theorem will be of the form: *) +(* *) +(* |- (case1 /\ ... /\ casen) ==> (!x. f[x]) ( * ) *) +(* *) +(* So, if we can establish casei for each i, we shall have |- !x. f[x]. When *) +(* specialised with the induction variable, this theorem has the original *) +(* clause as its conclusion. Each casei is of one of these forms: *) +(* *) +(* !x1 ... xn. s ==> (!y1 ... ym. t) *) +(* !x1 ... xn. t *) +(* *) +(* where the yi's do not appear in s. We simplify the casei's that have the *) +(* first form by proving theorems like: *) +(* *) +(* |- (!x1 ... xn. s ==> (!y1 ... ym. t)) = *) +(* (!x1 ... xn y1 ... ym. s ==> t) *) +(* *) +(* For consistency, theorems of the form |- (!x1 ... xn. t) = (!x1 ... xn. t) *) +(* are proved for the casei's that have the second form. The bodies of the *) +(* right-hand sides of these equations are returned as the new goal clauses. *) +(* A body that is an implication is taken to be an inductive step and so is *) +(* returned paired with true. Bodies that are not implications are paired *) +(* with false. *) +(* *) +(* The proof of the original clause from these new clauses proceeds as *) +(* follows. The universal quantifications that were stripped from the *) +(* right-hand sides are restored by generalizing the theorems. From the *) +(* equations we can then obtain theorems for the left-hand sides. These are *) +(* conjoined and used to satisfy the antecedant of the theorem ( * ). As *) +(* described above, specialising the resulting theorem gives a theorem for *) +(* the original clause. *) +(*----------------------------------------------------------------------------*) + +let induction_heuristic (tm,(ind:bool)) = +try + (let (unflawed,flawed) = possible_inductions tm + in let var = try (hd unflawed) with Failure _ -> (hd flawed) + in let ty_name = fst (dest_type (type_of var)) + in let induct_thm = (sys_shell_info ty_name).induct + in let P = mk_abs (var,tm) + in let th1 = ISPEC P induct_thm + in let th2 = + CONV_RULE + (ONCE_DEPTH_CONV + (fun tm -> if (rator tm = P) then BETA_CONV tm else failwith "")) th1 + in let new_goals = conj_list (rand (rator (concl th2))) + in let ths = + map (REPEATC (DEPTH_FORALL_CONV RIGHT_IMP_FORALL_CONV)) new_goals + in let (varsl,tml) = List.split (map (strip_forall o rhs o concl) ths) + in let proof thl = + let thl' = map (uncurry GENL) (lcombinep (varsl,thl)) + in let thl'' = map (fun (eq,th) -> EQ_MP (SYM eq) th) (lcombinep (ths,thl')) + in SPEC var (MP th2 (LIST_CONJ thl'')) + in (map (fun tm -> (tm,((is_imp tm) & (not (is_neg tm))))) tml, + apply_proof proof tml) + ) with Failure _ -> failwith "induction_heuristic";; diff --git a/Boyer_Moore/irrelevance.ml b/Boyer_Moore/irrelevance.ml new file mode 100644 index 0000000..a563927 --- /dev/null +++ b/Boyer_Moore/irrelevance.ml @@ -0,0 +1,243 @@ +(******************************************************************************) +(* FILE : irrelevance.ml *) +(* DESCRIPTION : Eliminating irrelevance. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 25th June 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 12th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +let DISJ_IMP = + let pth = TAUT`!t1 t2. t1 \/ t2 ==> ~t1 ==> t2` in + fun th -> + try let a,b = dest_disj(concl th) in MP (SPECL [a;b] pth) th + with Failure _ -> failwith "DISJ_IMP";; + +let IMP_ELIM = + let pth = TAUT`!t1 t2. (t1 ==> t2) ==> ~t1 \/ t2` in + fun th -> + try let a,b = dest_imp(concl th) in MP (SPECL [a;b] pth) th + with Failure _ -> failwith "IMP_ELIM";; + +(*----------------------------------------------------------------------------*) +(* partition_literals : (term # int) list -> (term # int) list list *) +(* *) +(* Function to partition a list of numbered terms into lists that share *) +(* variables. A term in one partition has no variables in common with any *) +(* term in one of the other partitions. Within a partition the terms are *) +(* ordered as they were in the input list. *) +(* *) +(* The function begins by putting every term in a separate partition. It then *) +(* tries to merge the first partition with one of the others. Two partitions *) +(* can be merged if they have at least one variable in common. If a merge can *) +(* be done, the process is repeated for the new head of the partition list. *) +(* This continues until a merge cannot take place (this causes a failure in *) +(* `merge_partitions' due to an attempt to split an empty list into a head *) +(* and a tail). When this happens, the head partition is separated from the *) +(* others because it cannot have any variables in common with the others. The *) +(* entire process is repeated for the remaining partitions. This goes on *) +(* until the list is exhausted. *) +(* *) +(* When as much merging as possible has been done, the terms within each *) +(* partition are sorted based on the number they are paired with. *) +(*----------------------------------------------------------------------------*) + +let partition_literals tmnl = + let rec merge_partitions partition partitions = + if (partitions = []) then failwith "merge_partitions" + else let h::t = partitions + in if ((intersect ((freesl o map fst) partition) + ((freesl o map fst) h)) = []) + then h::(merge_partitions partition t) + else (partition @ h)::t + and repeated_merge partitions = + if (partitions = []) + then [] + else let h::t = partitions + in try repeated_merge (merge_partitions h t) + with Failure _ -> h::(repeated_merge t) + in map sort_on_snd (repeated_merge (map (fun tmn -> [tmn]) tmnl));; + +(*----------------------------------------------------------------------------*) +(* contains_recursive_fun : term list -> bool *) +(* *) +(* Determines whether a list of terms (a partition) mentions a recursive *) +(* function. A constant that does not have a definition in the environment is *) +(* taken to be non-recursive. *) +(*----------------------------------------------------------------------------*) + +let contains_recursive_fun tml = + let consts = flat (mapfilter (find_terms is_const) tml) + in let names = setify (map (fst o dest_const) consts) + in exists (fun name -> not (try ((fst o get_def) name = 0) with Failure _ -> true)) names;; + +(*----------------------------------------------------------------------------*) +(* is_singleton_rec_app : term list -> bool *) +(* *) +(* Returns true if the list of terms (a partition) given as argument is a *) +(* single literal whose atom is of the form (f v1 ... vn) where f is a *) +(* recursive function and the vi are distinct variables. *) +(*----------------------------------------------------------------------------*) + +let is_singleton_rec_app tml = +try ( + match (tml) with + | [tm] -> + let tm' = if (is_neg tm) then (rand tm) else tm + in let (f,args) = strip_comb tm' + in let name = fst (dest_const f) + in (not ((fst o get_def) name = 0)) & + (forall is_var args) & + (distinct args) + | _ -> false + ) with Failure _ -> false;; + +(*----------------------------------------------------------------------------*) +(* merge_numbered_lists : ( # int) list -> ( # int) list -> ( # int) list *) +(* *) +(* Merges two numbered lists. The lists must be in increasing order by the *) +(* number, and no number may appear more than once in a list or appear in *) +(* both lists. The result will then be ordered by the numbers. *) +(*----------------------------------------------------------------------------*) + +let rec merge_numbered_lists xnl1 xnl2 = + if (xnl1 = []) then xnl2 + else if (xnl2 = []) then xnl1 + else let ((x1,n1)::t1) = xnl1 + and ((x2,n2)::t2) = xnl2 + in if (n1 < n2) + then (x1,n1)::(merge_numbered_lists t1 xnl2) + else (x2,n2)::(merge_numbered_lists xnl1 t2);; + +(*----------------------------------------------------------------------------*) +(* find_irrelevant_literals : term -> ((term # int) list # (term # int) list) *) +(* *) +(* Given a clause, this function produces two lists of term/integer pairs. *) +(* The first list is of literals deemed to be irrelevant. The second list is *) +(* the remaining literals. The number with each literal is its position in *) +(* the original clause. *) +(*----------------------------------------------------------------------------*) + +let find_irrelevant_literals tm = + let can_be_falsified tmnl = + let tml = map fst tmnl + in (not (contains_recursive_fun tml)) or (is_singleton_rec_app tml) + and tmnll = partition_literals (number_list (disj_list tm)) + in let (irrels,rels) = partition can_be_falsified tmnll + in (itlist merge_numbered_lists irrels [], + itlist merge_numbered_lists rels []);; + +(*----------------------------------------------------------------------------*) +(* DISJ_UNDISCH : thm -> thm *) +(* *) +(* A |- x \/ y *) +(* ------------- DISJ_UNDISCH *) +(* A, ~x |- y *) +(*----------------------------------------------------------------------------*) + +let DISJ_UNDISCH th = try UNDISCH (DISJ_IMP th) with Failure _ -> failwith "DISJ_UNDISCH";; + +(*----------------------------------------------------------------------------*) +(* DISJ_DISCH : term -> thm -> thm *) +(* *) +(* A, ~x |- y *) +(* ------------- DISJ_DISCH "x:bool" *) +(* A |- x \/ y *) +(*----------------------------------------------------------------------------*) + +let DISJ_DISCH tm th = +try + (CONV_RULE (RATOR_CONV (RAND_CONV (REWR_CONV NOT_NOT_NORM))) + (IMP_ELIM (DISCH (mk_neg tm) th)) + ) with Failure _ -> failwith "DISJ_DISCH";; + +(*----------------------------------------------------------------------------*) +(* BUILD_DISJ : ((term # int) list # (term # int) list) -> thm -> thm *) +(* *) +(* Function to build a disjunctive theorem from another theorem that has as *) +(* its conclusion a subset of the disjuncts. The first argument is a pair of *) +(* term/integer lists. Each list contains literals (disjuncts) and their *) +(* position within the required result. The first list is of those disjuncts *) +(* not in the theorem. The second list is of disjuncts in the theorem. Both *) +(* lists are assumed to be ordered by their numbers (increasing order). *) +(* *) +(* Example: *) +(* *) +(* BUILD_DISJ ([("x2",2);("x5",5);("x6",6)],[("x1",1);("x3",3);("x4",4)]) *) +(* |- x1 \/ x3 \/ x4 *) +(* *) +(* The required result is: *) +(* *) +(* |- x1 \/ x2 \/ x3 \/ x4 \/ x5 \/ x6 *) +(* *) +(* The first step is to undischarge all the disjuncts except for the last: *) +(* *) +(* ~x1, ~x3 |- x4 *) +(* *) +(* The disjuncts not in the theorem, and which are to come after x4, are now *) +(* `added' to the theorem. (Note that we have to undischarge all but the last *) +(* disjunct in order to get the correct associativity of OR (\/) at this *) +(* stage): *) +(* *) +(* ~x1, ~x3 |- x4 \/ x5 \/ x6 *) +(* *) +(* We now repeatedly either discharge one of the assumptions, or add a *) +(* disjunct from the `outs' list, according to the values of the numbers *) +(* associated with the terms: *) +(* *) +(* ~x1 |- x3 \/ x4 \/ x5 \/ x6 *) +(* *) +(* ~x1 |- x2 \/ x3 \/ x4 \/ x5 \/ x6 *) +(* *) +(* |- x1 \/ x2 \/ x3 \/ x4 \/ x5 \/ x6 *) +(*----------------------------------------------------------------------------*) + +let BUILD_DISJ (outs,ins) inth = +try (let rec rebuild rev_outs rev_ins th = + if (rev_ins = []) + then if (rev_outs = []) + then th + else rebuild (tl rev_outs) rev_ins (DISJ2 (fst (hd rev_outs)) th) + else if (rev_outs = []) + then rebuild rev_outs (tl rev_ins) (DISJ_DISCH (fst (hd rev_ins)) th) + else let (inh::int) = rev_ins + and (outh::outt) = rev_outs + in if (snd inh > snd outh) + then rebuild rev_outs int (DISJ_DISCH (fst inh) th) + else rebuild outt rev_ins (DISJ2 (fst outh) th) + in let last_in = snd (last ins) + in let (under_outs,over_outs) = partition (fun (_,n) -> n > last_in) outs + in let over_ins = butlast ins + in let th1 = funpow (length over_ins) DISJ_UNDISCH inth + in let th2 = try (DISJ1 th1 (list_mk_disj (map fst under_outs))) with Failure _ -> th1 + in rebuild (rev over_outs) (rev over_ins) th2 + ) with Failure _ -> failwith "BUILD_DISJ";; + +(*----------------------------------------------------------------------------*) +(* irrelevance_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* Heuristic for eliminating irrelevant literals. The function splits the *) +(* literals into two sets: those that are irrelevant and those that are not. *) +(* If there are no relevant terms left, the heuristic fails in a way that *) +(* indicates the conjecture cannot be proved. If there are no irrelevant *) +(* literals, the function fails indicating that it cannot do anything with *) +(* the clause. In all other circumstances the function returns a new clause *) +(* consisting of only the relevant literals, together with a proof of the *) +(* original clause from this new clause. *) +(*----------------------------------------------------------------------------*) + +let irrelevance_heuristic (tm,(ind:bool)) = + let (outs,ins) = find_irrelevant_literals tm + in if (ins = []) then failwith "cannot prove" + else if (outs = []) then failwith "irrelevance_heuristic" + else let tm' = list_mk_disj (map fst ins) + and proof = BUILD_DISJ (outs,ins) + in (proof_print_string_l "-> Irrelevance Heuristic" () ; ([(tm',ind)],apply_proof (proof o hd) [tm']));; diff --git a/Boyer_Moore/main.ml b/Boyer_Moore/main.ml new file mode 100644 index 0000000..23a4659 --- /dev/null +++ b/Boyer_Moore/main.ml @@ -0,0 +1,202 @@ +(******************************************************************************) +(* FILE : main.ml *) +(* DESCRIPTION : The main functions for the Boyer-Moore-style prover. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 27th June 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 13th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* BOYER_MOORE : conv *) +(* *) +(* Boyer-Moore-style automatic theorem prover. *) +(* Given a term "tm", attempts to prove |- tm. *) +(*----------------------------------------------------------------------------*) + +let BOYER_MOORE_MESON tm = +my_gen_terms := []; +counterexamples := 0; +proof_print_depth := 0; +bm_steps := (0,0); +try (proof_print_newline + (FILTERED_WATERFALL + [taut_heuristic; + clausal_form_heuristic; + setify_heuristic; + meson_heuristic; + subst_heuristic; + HL_simplify_heuristic; + use_equality_heuristic; + generalize_heuristic_ext; + irrelevance_heuristic] + induction_heuristic [] + (tm,false)) + ) with Failure _ -> failwith "BOYER_MOORE";; + +let BOYER_MOORE_GEN tm = +my_gen_terms := []; +counterexamples := 0; + proof_print_depth := 0; +bm_steps := (0,0); +try (proof_print_newline + (FILTERED_WATERFALL + [taut_heuristic; + clausal_form_heuristic; + setify_heuristic; + subst_heuristic; + HL_simplify_heuristic; + use_equality_heuristic; + generalize_heuristic_ext; + irrelevance_heuristic] + induction_heuristic [] + (tm,false)) + ) with Failure _ -> failwith "BOYER_MOORE";; + +let BOYER_MOORE_EXT tm = +my_gen_terms := []; +counterexamples := 0; + proof_print_depth := 0; +bm_steps := (0,0); +try (proof_print_newline + (FILTERED_WATERFALL + [taut_heuristic; + clausal_form_heuristic; + setify_heuristic; + subst_heuristic; + use_equality_heuristic; + HL_simplify_heuristic; +(* meson_heuristic; *) + generalize_heuristic; + irrelevance_heuristic] + induction_heuristic [] + (tm,false)) + ) with Failure _ -> failwith "BOYER_MOORE";; + +let BOYER_MOORE tm = +counterexamples := 0; +my_gen_terms := []; + proof_print_depth := 0; +bm_steps := (0,0); +try (proof_print_newline + (WATERFALL + [clausal_form_heuristic; + subst_heuristic; + simplify_heuristic; + use_equality_heuristic; + generalize_heuristic; + irrelevance_heuristic] + induction_heuristic + (tm,false)) + ) with Failure _ -> failwith "BOYER_MOORE";; + +(*----------------------------------------------------------------------------*) +(* BOYER_MOORE_CONV : conv *) +(* *) +(* Boyer-Moore-style automatic theorem prover. *) +(* Given a term "tm", attempts to prove |- tm = T. *) +(*----------------------------------------------------------------------------*) + +let BOYER_MOORE_CONV tm = +try (EQT_INTRO (BOYER_MOORE tm)) with Failure _ -> failwith "BOYER_MOORE_CONV";; + +(*----------------------------------------------------------------------------*) +(* HEURISTIC_TAC : *) +(* ((term # bool) -> ((term # bool) list # proof)) list -> tactic *) +(* *) +(* Tactic to do automatic proof using a list of heuristics. The tactic will *) +(* fail if it thinks the goal is not a theorem. Otherwise it will either *) +(* prove the goal, or return as subgoals the conjectures it couldn't handle. *) +(* *) +(* If the `proof_printing' flag is set to true, the tactic displays each new *) +(* conjecture it generates, prints blank lines between subconjectures which *) +(* resulted from a split, and prints a final blank line when it can do no *) +(* more. *) +(* *) +(* Given a goal, the tactic constructs an implication from it, so that the *) +(* hypotheses are made available. It then tries to prove this implication. *) +(* When it can do no more, the function splits the clauses that it couldn't *) +(* prove into disjuncts. The last disjunct is assumed to be a conclusion, and *) +(* the rest are taken to be hypotheses. These new goals are returned together *) +(* with a proof of the original goal. *) +(* *) +(* The proof takes a list of theorems for the subgoals and discharges the *) +(* hypotheses so that the theorems are in clausal form. These clauses are *) +(* then used to prove the implication that was constructed from the original *) +(* goal. Finally the antecedants of this implication are undischarged to give *) +(* a theorem for the original goal. *) +(*----------------------------------------------------------------------------*) + +let HEURISTIC_TAC heuristics (asl,w) = + proof_print_depth := 0; try + (let negate tm = if (is_neg tm) then (rand tm) else (mk_neg tm) + and NEG_DISJ_DISCH tm th = + if (is_neg tm) + then DISJ_DISCH (rand tm) th + else CONV_RULE (REWR_CONV IMP_DISJ_THM) (DISCH tm th) + in let tm = list_mk_imp (asl,w) + in let tree = proof_print_newline + (waterfall (clausal_form_heuristic::heuristics) (tm,false)) + in let tml = map fst (fringe_of_clause_tree tree) + in let disjsl = map disj_list tml + in let goals = map (fun disjs -> (map negate (butlast disjs),last disjs)) disjsl + in let proof thl = + let thl' = map (fun (th,goal)-> itlist NEG_DISJ_DISCH (fst goal) th) + (lcombinep (thl,goals)) + in funpow (length asl) UNDISCH (prove_clause_tree tree thl') + in (goals,proof) + ) with Failure _ -> failwith "HEURISTIC_TAC";; + +(*----------------------------------------------------------------------------*) +(* BOYER_MOORE_TAC : tactic *) +(* *) +(* Tactic to do automatic proof using Boyer & Moore's heuristics. The tactic *) +(* will fail if it thinks the goal is not a theorem. Otherwise it will either *) +(* prove the goal, or return as subgoals the conjectures it couldn't handle. *) +(*----------------------------------------------------------------------------*) + +let BOYER_MOORE_TAC aslw = +try (HEURISTIC_TAC + [subst_heuristic; + simplify_heuristic; + use_equality_heuristic; + generalize_heuristic; + irrelevance_heuristic; + induction_heuristic] + aslw + ) with Failure _ -> failwith "BOYER_MOORE_TAC";; + +(*----------------------------------------------------------------------------*) +(* BM_SIMPLIFY_TAC : tactic *) +(* *) +(* Tactic to do automatic simplification using Boyer & Moore's heuristics. *) +(* The tactic will fail if it thinks the goal is not a theorem. Otherwise, it *) +(* will either prove the goal or return the simplified conjectures as *) +(* subgoals. *) +(*----------------------------------------------------------------------------*) + +let BM_SIMPLIFY_TAC aslw = + try (HEURISTIC_TAC [subst_heuristic;simplify_heuristic] aslw + ) with Failure _ -> failwith "BM_SIMPLIFY_TAC";; + +(*----------------------------------------------------------------------------*) +(* BM_INDUCT_TAC : tactic *) +(* *) +(* Tactic which attempts to do a SINGLE induction using Boyer & Moore's *) +(* heuristics. The cases of the induction are returned as subgoals. *) +(*----------------------------------------------------------------------------*) + +let BM_INDUCT_TAC aslw = +try (let induct = ref true + in let once_induction_heuristic x = + if !induct then (induct := false; induction_heuristic x) else failwith "" + in HEURISTIC_TAC [once_induction_heuristic] aslw + ) with Failure _ -> failwith "BM_INDUCT_TAC";; diff --git a/Boyer_Moore/make.ml b/Boyer_Moore/make.ml new file mode 100644 index 0000000..c4cbf51 --- /dev/null +++ b/Boyer_Moore/make.ml @@ -0,0 +1,196 @@ +(* ========================================================================= *) +(* Load in Petros Papapanagiotou's Boyer-Moore code and try examples. *) +(* ========================================================================= *) + +loads "Boyer_Moore/boyer-moore.ml";; + +(* ------------------------------------------------------------------------- *) +(* Slight variant of Petros's eval.ml file. *) +(* ------------------------------------------------------------------------- *) + +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Shortcuts for the various evaluation versions: *) +(* ------------------------------------------------------------------------- *) + +let BM = BOYER_MOORE;; (* Pure re-implementation of R.Boulton's work. *) +let BME = BOYER_MOORE_EXT;; (* Extended with early termination heuristics and HOL Light features. *) +let BMG = BOYER_MOORE_GEN;; (* Further extended with M.Aderhold's generalization techniques. *) + +let RBM = new_rewrite_rule o BOYER_MOORE;; +let RBME = new_rewrite_rule o BOYER_MOORE_EXT;; +let RBMG = new_rewrite_rule o BOYER_MOORE_GEN;; + +(* ------------------------------------------------------------------------- *) +(* Add a theorem as a new function definition and rewrite rule. *) +(* Adding it as a rewrite rule should no longer be necessary after the *) +(* latest (July 2009) bugfixes but it doesn't do any harm either. *) +(* ------------------------------------------------------------------------- *) + +let new_stuff x = (new_def x ; new_rewrite_rule x);; + +(* ------------------------------------------------------------------------- *) +(* Test sets extracted from the proven theorems in HOL Light's arith.ml and *) +(* list.ml. *) +(* ------------------------------------------------------------------------- *) + +loads "Boyer_Moore/testset/arith.ml";; (* Arithmetic test set *) +loads "Boyer_Moore/testset/list.ml";; (* List test set *) + +(* ------------------------------------------------------------------------- *) +(* Reloads all the necessary definitions and rules for the evaluation of the *) +(* test sets above. *) +(* ------------------------------------------------------------------------- *) + +let bm_reset () = + +system_defs := []; +system_rewrites := []; + +new_stuff ADD; +new_stuff MULT; +new_stuff SUB; +new_stuff LE; +new_stuff LT; +new_stuff GE; +new_stuff GT; +new_rewrite_rule (ARITH_RULE `1=SUC(0)`); +new_stuff EXP; +new_stuff FACT; +new_stuff ODD; +new_stuff EVEN; + +new_rewrite_rule NOT_SUC; +new_rewrite_rule SUC_INJ; +new_rewrite_rule PRE; + +new_stuff HD; +new_stuff TL; +new_stuff APPEND; +new_stuff REVERSE; +new_stuff LENGTH; +new_stuff MAP; +new_stuff LAST; +new_stuff REPLICATE; +new_stuff NULL; +new_stuff ALL; +new_stuff EX; +new_stuff ITLIST; +new_stuff MEM; +new_stuff ALL2_DEF; +new_rewrite_rule ALL2; +new_stuff MAP2_DEF; +new_rewrite_rule MAP2; +new_stuff EL; +new_stuff FILTER; +new_stuff ASSOC; +new_stuff ITLIST2_DEF; +new_rewrite_rule ITLIST2; +new_stuff ZIP_DEF; +new_rewrite_rule ZIP; + +new_rewrite_rule NOT_CONS_NIL; +new_rewrite_rule CONS_11 ;; + +bm_reset();; + +(* ------------------------------------------------------------------------- *) +(* Test functions. They use the Unix library to measure time. *) +(* Unfortunately this means that they do not load properly in Cygwin. *) +(* ------------------------------------------------------------------------- *) + +#load "unix.cma";; +open Unix;; +open Printf;; + + +(* ------------------------------------------------------------------------- *) +(* Reference of the remaining theory to be proven. Load a list of theorems *) +(* that you want the evaluation to run through. *) +(* eg. remaining_theory := !mytheory;; *) +(* Then use nexttm (see below) to evaluate one of the BOYER_MOORE_* *) +(* procedures over the list. *) +(* ------------------------------------------------------------------------- *) + +let remaining_theory = ref ([]:term list);; + +let currenttm = ref `p`;; + +(* ------------------------------------------------------------------------- *) +(* Tries a theorem-proving procedure f on arg. *) +(* Returns a truth value of whether the procedure succeeded in finding a *) +(* proof and a pair of timestamps taken from the start and the end of the *) +(* procedure. *) +(* ------------------------------------------------------------------------- *) + +let bm_time f arg = + let t1=Unix.times () in + let resu = try (if (can dest_thm (f arg)) then true else false) with Failure _ -> false in + let t2=Unix.times () in (resu,(t1,t2));; + (* printf "User time: %f - system time: %f\n%!" (t2.tms_utime -. t1.tms_utime) (t2.tms_stime -. t1.tms_stime);; *) + + +(* ------------------------------------------------------------------------- *) +(* Uses bm_time to try a Boyer-Moore theorem-proving procedure f on tm. *) +(* Prints out all the evaluation information that is collected and returns *) +(* the list of generalizations made during the proof. *) +(* ------------------------------------------------------------------------- *) + +let bm_test f tm = + let pfpt = (print_term tm ; print_newline() ; proof_printer false) in + let (resu,(t1,t2)) = bm_time f tm in + let pfpt = proof_printer pfpt in + printf "Proven: %b - Time: %f - Steps: %d - Inductions: %d - Gen terms: %d - Over gens: %d \\\\\n" resu +(t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; + !my_gen_terms;; + +(* ------------------------------------------------------------------------- *) +(* Another version of bm_test but with a more compact printout. *) +(* Returns unit (). *) +(* ------------------------------------------------------------------------- *) + +let bm_test2 f tm = + let pfpt = (print_term tm ; print_newline() ; proof_printer false) in + let (resu,(t1,t2)) = bm_time f tm in + let pfpt = proof_printer pfpt in + printf "& %b & %f & %d & %d & %d & %d \\\\\n" resu (t2.tms_utime -. t1.tms_utime) (fst !bm_steps) (snd !bm_steps) (length !my_gen_terms) (!counterexamples) ; + ();; + +(* ------------------------------------------------------------------------- *) +(* Convenient function for evaluation. *) +(* Uses f to try and prove the next term in !remaining_theory by bm_test2 *) +(* ------------------------------------------------------------------------- *) + +let nexttm f = + if (!remaining_theory = []) then failwith "No more" + else currenttm := hd !remaining_theory ; remaining_theory := tl !remaining_theory ; + bm_test2 f !currenttm;; + +(* ------------------------------------------------------------------------- *) +(* Reruns evaluation on the same term that was last loaded with nexttm. *) +(* ------------------------------------------------------------------------- *) + +let sametm f = bm_test2 f !currenttm;; + + +(* ========================================================================= *) + + +(* ------------------------------------------------------------------------- *) +(* Just one example. *) +(* ------------------------------------------------------------------------- *) + +bm_test BME `m + n:num = n + m`;; + +(* ------------------------------------------------------------------------- *) +(* Note that these don't all terminate, so need more delicacy really. *) +(* Should carefully reconstruct the cases in Petros's thesis, also maybe *) +(* using a timeout. *) +(* ------------------------------------------------------------------------- *) + +(**** +do_list (bm_test BME) (!mytheory);; + +do_list (bm_test BME) (!mytheory2);; + ****) diff --git a/Boyer_Moore/rewrite_rules.ml b/Boyer_Moore/rewrite_rules.ml new file mode 100644 index 0000000..7ab7bb8 --- /dev/null +++ b/Boyer_Moore/rewrite_rules.ml @@ -0,0 +1,347 @@ +(******************************************************************************) +(* FILE : rewrite_rules.ml *) +(* DESCRIPTION : Using axioms and lemmas as rewrite rules. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 14th May 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 15th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* is_permutative : term -> bool *) +(* *) +(* Determines whether or not an equation is permutative (the left-hand and *) +(* right-hand sides are instances of one another). A permutative equation may *) +(* cause looping when it is used for rewriting. *) +(*----------------------------------------------------------------------------*) + +let is_permutative tm = + try (let (l,r) = dest_eq tm + in let bind1 = term_match [] l r + and bind2 = term_match [] r l + in true + ) with Failure _ -> false;; + + +(*----------------------------------------------------------------------------*) +(* lex_smaller_term : term -> term -> bool *) +(* *) +(* Computes whether the first term is `alphabetically' smaller than the *) +(* second term. Used to avoid looping when rewriting with permutative rules. *) +(* *) +(* A constant is considered to be smaller than a variable which in turn is *) +(* considered to be smaller than an application. Two variables or two *) +(* constants are compared alphabetically by name. An application (f1 x1) is *) +(* considered to be smaller than another application (f2 x2) if either f1 is *) +(* smaller than f2, or f1 equals f2 and x1 is smaller than x2. *) +(*----------------------------------------------------------------------------*) + +let rec lex_smaller_term tm1 tm2 = +try + (if (is_const tm1) then + (if (is_const tm2) + then let (name1,type1) = dest_const tm1 + and (name2,type2) = dest_const tm2 + in (if (type1 = type2) + then name1 < name2 + else failwith "" ) + else true) + else if (is_var tm1) then + (if (is_const tm2) then false + else if (is_var tm2) + then let (name1,type1) = dest_var tm1 + and (name2,type2) = dest_var tm2 + in (if (type1 = type2) + then name1 < name2 + else failwith "" ) + else true) + else if (is_comb tm1) then + (if (is_comb tm2) + then let (rator1,rand1) = dest_comb tm1 + and (rator2,rand2) = dest_comb tm2 + in (lex_smaller_term rator1 rator2) or + ((rator1 = rator2) & (lex_smaller_term rand1 rand2)) + else false) + else failwith "" + ) with Failure _ -> failwith "lex_smaller_term";; + +(*----------------------------------------------------------------------------*) +(* inst_eq_thm : ((term # term) list # (type # type) list) -> thm -> thm *) +(* *) +(* Instantiates a theorem (possibly having hypotheses) with a binding. *) +(* Assumes the conclusion is an equality, so that discharging then undisching *) +(* cannot cause parts of the conclusion to be moved into the hypotheses. *) +(*----------------------------------------------------------------------------*) + +let inst_eq_thm (tm_bind,ty_bind) th = + let (insts,vars) = List.split tm_bind + in (UNDISCH_ALL o (SPECL insts) o (GENL vars) o + (INST_TYPE ty_bind) o DISCH_ALL) th;; + +(*----------------------------------------------------------------------------*) +(* applicable_rewrites : term -> thm list *) +(* *) +(* Returns the results of rewriting the term with those rewrite rules that *) +(* are applicable to it. A rewrite rule is not applicable if it's permutative *) +(* and the rewriting does not produce an alphabetically smaller term. *) +(*----------------------------------------------------------------------------*) + +let applicable_rewrites tm = + let applicable_rewrite tm th = + let conc = concl th + in let (_,tm_bind,ty_bind) = term_match [] (lhs conc) tm + in let instth = inst_eq_thm (tm_bind,ty_bind) th + in if (is_permutative conc) + then (let (l,r) = dest_eq (concl instth) + in if (lex_smaller_term r l) + then instth + else failwith "") + else instth + in mapfilter ((applicable_rewrite tm) o snd) !system_rewrites;; + +(*----------------------------------------------------------------------------*) +(* ARGS_CONV : conv -> conv *) +(* *) +(* Applies a conversion to every argument of an application of the form *) +(* "f x1 ... xn". *) +(*----------------------------------------------------------------------------*) + +let rec ARGS_CONV conv tm = +try ( + ((RATOR_CONV (ARGS_CONV conv)) THENC (RAND_CONV conv)) tm + ) with Failure _ -> ALL_CONV tm;; + +(*----------------------------------------------------------------------------*) +(* assump_inst_hyps : term list -> *) +(* term -> *) +(* term list -> *) +(* ((term # term) list # (type # type) list) *) +(* *) +(* Searches a list of hypotheses for one that matches the specified *) +(* assumption such that the variables instantiated are precisely those in the *) +(* list of variables given. If such a hypothesis is found, the binding *) +(* produced by the match is returned. *) +(*----------------------------------------------------------------------------*) + +let rec assump_inst_hyps vars assump hyps = + try(let (_,tm_bind,ty_bind) = term_match [] (hd hyps) assump + in let bind = (tm_bind,ty_bind) + in if (set_eq vars (map snd (fst bind))) + then bind + else failwith "") + with Failure _ -> try (assump_inst_hyps vars assump (tl hyps)) + with Failure _ -> failwith "assump_inst_hyps";; + +(*----------------------------------------------------------------------------*) +(* assumps_inst_hyps : term list -> *) +(* term list -> *) +(* term list -> *) +(* ((term # term) list # (type # type) list) *) +(* *) +(* Searches a list of hypotheses and a list of assumptions for a pairing that *) +(* match (the assumption is an instance of the hypothesis) such that the *) +(* variables instantiated are precisely those in the list of variables given. *) +(* If such a pair is found, the binding produced by the match is returned. *) +(*----------------------------------------------------------------------------*) + +let rec assumps_inst_hyps vars assumps hyps = + try (assump_inst_hyps vars (hd assumps) hyps) + with Failure _ -> try (assumps_inst_hyps vars (tl assumps) hyps) + with Failure _ -> failwith "assumps_inst_hyps";; + +(*----------------------------------------------------------------------------*) +(* inst_frees_in_hyps : term list -> thm -> thm *) +(* *) +(* Takes a theorem (possibly with hypotheses) and computes a list of *) +(* variables that are free in the hypotheses but not in the conclusion. *) +(* If this list of variables is empty the original theorem is returned. *) +(* The function also takes a list of assumptions as another argument. Once it *) +(* has the list of variables it searches for an assumption and a hypothesis *) +(* such that the hypothesis matches the assumption binding precisely those *) +(* variables in the list. If this is successful the original theorem is *) +(* returned having had the variables in the list instantiated. *) +(*----------------------------------------------------------------------------*) + +let inst_frees_in_hyps assumps th = + try (let hyps = hyp th + in let hyp_frees = setify (flat (map frees hyps)) + in let vars = subtract hyp_frees (frees (concl th)) + in if (vars = []) + then th + else let bind = assumps_inst_hyps vars assumps hyps + in inst_eq_thm bind th + ) with Failure _ -> failwith "inst_frees_in_hyps";; + +(*----------------------------------------------------------------------------*) +(* NOT_IMP_EQ_EQ_EQ_OR = |- (~x ==> (y = y')) = ((y \/ x) = (y' \/ x)) *) +(*----------------------------------------------------------------------------*) + +let NOT_IMP_EQ_EQ_EQ_OR = + prove + (`(~x ==> (y = y')) = ((y \/ x) = (y' \/ x))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + BOOL_CASES_TAC `y':bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* IMP_EQ_EQ_EQ_OR_NOT = |- (x ==> (y = y')) = ((y \/ ~x) = (y' \/ ~x)) *) +(*----------------------------------------------------------------------------*) + +let IMP_EQ_EQ_EQ_OR_NOT = + prove + (`(x ==> (y = y')) = ((y \/ ~x) = (y' \/ ~x))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + BOOL_CASES_TAC `y':bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* NOT_IMP_EQ_OR_EQ_EQ_OR_OR = *) +(* |- (~x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (x \/ t)) = (y' \/ (x \/ t))) *) +(*----------------------------------------------------------------------------*) + +let NOT_IMP_EQ_OR_EQ_EQ_OR_OR = + prove + (`(~x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (x \/ t)) = (y' \/ (x \/ t)))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + BOOL_CASES_TAC `y':bool` THEN + BOOL_CASES_TAC `t:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* IMP_EQ_OR_EQ_EQ_OR_NOT_OR = *) +(* |- (x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (~x \/ t)) = (y' \/ (~x \/ t))) *) +(*----------------------------------------------------------------------------*) + +let IMP_EQ_OR_EQ_EQ_OR_NOT_OR = + prove + (`(x ==> ((y \/ t) = (y' \/ t))) = ((y \/ (~x \/ t)) = (y' \/ (~x \/ t)))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `y:bool` THEN + BOOL_CASES_TAC `y':bool` THEN + BOOL_CASES_TAC `t:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* IMP_EQ_EQ_EQ_NOT_OR = |- (x ==> (t = t')) = ((~x \/ t) = (~x \/ t')) *) +(*----------------------------------------------------------------------------*) + +let IMP_EQ_EQ_EQ_NOT_OR = + prove + (`(x ==> (t = t')) = ((~x \/ t) = (~x \/ t'))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `t:bool` THEN + BOOL_CASES_TAC `t':bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* IMP_NOT_EQ_EQ_EQ_OR = |- (~x ==> (t = t')) = ((x \/ t) = (x \/ t')) *) +(*----------------------------------------------------------------------------*) + +let IMP_NOT_EQ_EQ_EQ_OR = + prove + (`(~x ==> (t = t')) = ((x \/ t) = (x \/ t'))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `t:bool` THEN + BOOL_CASES_TAC `t':bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* T_OR = |- T \/ t = T *) +(* OR_T = |- t \/ T = T *) +(* F_OR = |- F \/ t = t *) +(* OR_F = |- t \/ F = t *) +(*----------------------------------------------------------------------------*) + +let [T_OR;OR_T;F_OR;OR_F;_] = CONJUNCTS (SPEC_ALL OR_CLAUSES);; + +(*----------------------------------------------------------------------------*) +(* UNDER_DISJ_DISCH : term -> thm -> thm *) +(* *) +(* A, ~x |- y \/ t = y' \/ t A, x |- y \/ t = y' \/ t *) +(* ------------------------------- --------------------------------- *) +(* A |- y \/ x \/ t = y' \/ x \/ t A |- y \/ ~x \/ t = y' \/ ~x \/ t *) +(* *) +(* A, ~x |- y = y' A, x |- y = y' *) +(* --------------------- ----------------------- *) +(* A |- y \/ x = y' \/ x A |- y \/ ~x = y' \/ ~x *) +(* *) +(* The function assumes that y is a literal, so it is valid to test the LHS *) +(* of the theorem to see if it is a disjunction in order to determine which *) +(* rule to use. *) +(*----------------------------------------------------------------------------*) + +let UNDER_DISJ_DISCH tm th = +try + (let rewrite = + if (is_disj (lhs (concl th))) + then if (is_neg tm) + then NOT_IMP_EQ_OR_EQ_EQ_OR_OR + else IMP_EQ_OR_EQ_EQ_OR_NOT_OR + else if (is_neg tm) + then NOT_IMP_EQ_EQ_EQ_OR + else IMP_EQ_EQ_EQ_OR_NOT + in CONV_RULE (REWR_CONV rewrite) (DISCH tm th) + ) with Failure _ -> failwith "UNDER_DISJ_DISCH";; + +(*----------------------------------------------------------------------------*) +(* OVER_DISJ_DISCH : term -> thm -> thm *) +(* *) +(* A, ~x |- t = t' A, x |- t = t' *) +(* --------------------- ----------------------- *) +(* A |- x \/ t = x \/ t' A |- ~x \/ t = ~x \/ t' *) +(*----------------------------------------------------------------------------*) + +let OVER_DISJ_DISCH tm th = + try (let rewrite = + if (is_neg tm) + then IMP_NOT_EQ_EQ_EQ_OR + else IMP_EQ_EQ_EQ_NOT_OR + in CONV_RULE (REWR_CONV rewrite) (DISCH tm th) + ) with Failure _ -> failwith "OVER_DISJ_DISCH";; + +(*----------------------------------------------------------------------------*) +(* MULTI_DISJ_DISCH : (term list # term list) -> thm -> thm *) +(* *) +(* Examples: *) +(* *) +(* MULTI_DISJ_DISCH (["x1"; "x2"],["~x3"; "x4"]) x1, ~x3, x4, x2 |- y = y' *) +(* ---> *) +(* |- ~x1 \/ ~x2 \/ y \/ x3 \/ ~x4 = ~x1 \/ ~x2 \/ y' \/ x3 \/ ~x4 *) +(* *) +(* *) +(* MULTI_DISJ_DISCH (["x1"; "x2"],["~x3"; "x4"]) x1, ~x3, x4, x2 |- y = F *) +(* ---> *) +(* |- ~x1 \/ ~x2 \/ y \/ x3 \/ ~x4 = ~x1 \/ ~x2 \/ x3 \/ ~x4 *) +(* *) +(* *) +(* MULTI_DISJ_DISCH (["x1"; "x2"],["~x3"; "x4"]) x1, ~x3, x4, x2 |- y = T *) +(* ---> *) +(* |- ~x1 \/ ~x2 \/ y \/ x3 \/ ~x4 = T *) +(*----------------------------------------------------------------------------*) + +let MULTI_DISJ_DISCH (overs,unders) th = +try + (let th1 = itlist UNDER_DISJ_DISCH unders th + in let tm1 = rhs (concl th1) + in let th2 = + if (try(is_T (fst (dest_disj tm1))) with Failure _ -> false) then + (CONV_RULE (RAND_CONV (REWR_CONV T_OR)) th1) + else if (try(is_F (fst (dest_disj tm1))) with Failure _ -> false) then + (CONV_RULE (RAND_CONV (REWR_CONV F_OR)) th1) + else th1 + in let tm2 = rhs (concl th2) + in let rule = + if (is_T tm2) then CONV_RULE (RAND_CONV (REWR_CONV OR_T)) else I + in itlist (fun tm th -> rule (OVER_DISJ_DISCH tm th)) overs th2 + ) with Failure _ -> failwith "MULTI_DISJ_DISCH";; diff --git a/Boyer_Moore/shells.ml b/Boyer_Moore/shells.ml new file mode 100644 index 0000000..65da947 --- /dev/null +++ b/Boyer_Moore/shells.ml @@ -0,0 +1,333 @@ +(******************************************************************************) +(* FILE : shells.ml *) +(* DESCRIPTION : Vague approximation in ML to Boyer-Moore "shell" principle *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 8th May 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 12th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +(*----------------------------------------------------------------------------*) +(* ML datatype for holding information about a recursive logical type. *) +(*----------------------------------------------------------------------------*) + +type constructor_info = + string * (* Constructor name *) + hol_type list * (* Argument types *) + (string * thm) list;; (* Accessor functions *) + + +type shell_info = + {arg_types : hol_type list; (* Argument types for type constructor *) + constructors : + constructor_info list; (* Constructors for the type *) + axiom : thm; (* Type axiom *) + induct : thm; (* Induction theorem *) + cases : thm; (* Cases theorem *) + distinct : thm list; (* Constructors distinct *) + one_one : thm list; (* Constructors one-one *) + struct_conv : conv -> conv};; + +type shell = Shell of string * shell_info;; + +(*----------------------------------------------------------------------------*) +(* Reference variable holding the currently defined system shells. *) +(*----------------------------------------------------------------------------*) + +let system_shells = ref ([]:shell list);; + +(*----------------------------------------------------------------------------*) +(* Function to find the details of a named shell from a list of shells. *) +(*----------------------------------------------------------------------------*) + +let rec shell_info (shl:shell list) name = + if (shl = []) + then failwith "shell_info" + else match (hd shl) with Shell (sh_name,info) -> + (if (sh_name = name) + then info + else shell_info (tl shl) name);; + +(*----------------------------------------------------------------------------*) +(* Function to find the details of a named shell from the shells currently *) +(* defined in the system. *) +(*----------------------------------------------------------------------------*) + +let sys_shell_info name = shell_info !system_shells name;; + +(*----------------------------------------------------------------------------*) +(* Functions to extract the components of shell information. *) +(*----------------------------------------------------------------------------*) +let shell_constructors info = info.constructors;; +let shell_accessor_thms info = + ((map snd) o flat o (map thd3) o shell_constructors) info;; +let shell_arg_types info = info.arg_types;; + +(* +let shell_arg_types info = fst info +and shell_constructors info = (fst o snd) info +and shell_axiom info = (fst o snd o snd) info +and shell_induct info = (fst o snd o snd o snd) info +and shell_cases info = (fst o snd o snd o snd o snd) info +and shell_distinct info = (fst o snd o snd o snd o snd o snd) info +and shell_one_one info = (fst o snd o snd o snd o snd o snd o snd) info +and shell_struct_conv info = (snd o snd o snd o snd o snd o snd o snd) info;; +*) + +(*----------------------------------------------------------------------------*) +(* Function to extract details of a named constructor from shell information. *) +(*----------------------------------------------------------------------------*) + +let shell_constructor name (info:shell_info) = + let rec shell_constructor' name triples = + if (triples = []) + then failwith "shell_constructor" + else let (con_name,arg_types,accessors) = (hd triples) + in if (con_name = name) + then (arg_types,accessors) + else shell_constructor' name (tl triples) + in shell_constructor' name (info.constructors);; + +(*----------------------------------------------------------------------------*) +(* Functions to extract the argument types and the accessor functions for a *) +(* particular constructor. The source is a set of shell information. *) +(*----------------------------------------------------------------------------*) + +let shell_constructor_arg_types name info = + fst (shell_constructor name info) +and shell_constructor_accessors name info = + snd (shell_constructor name info);; + +(*----------------------------------------------------------------------------*) +(* shells : void -> string list *) +(* *) +(* Function to compute the names of the currently defined system shells. *) +(*----------------------------------------------------------------------------*) + +let shells () = + let rec shells' shl = + if (shl = []) + then [] + else match (hd shl) with (Shell (name,_)) -> (name::(shells' (tl shl))) + in shells' !system_shells;; + +(*----------------------------------------------------------------------------*) +(* all_constructors : void -> string list *) +(* *) +(* Returns a list of all the shell constructors (and bottom values) available *) +(* in the system. *) +(*----------------------------------------------------------------------------*) + +let all_constructors () = + flat (map (map fst3 o shell_constructors o sys_shell_info) (shells ()));; + +(*----------------------------------------------------------------------------*) +(* all_accessors : void -> string list *) +(* *) +(* Returns a list of all the shell accessors available in the system. *) +(*----------------------------------------------------------------------------*) + +let all_accessors () = + flat (map (flat o map (map fst o thd3) o shell_constructors o + sys_shell_info) (shells ()));; + +let all_accessor_thms () = + flat (map (shell_accessor_thms o sys_shell_info) (shells ()));; + +(*----------------------------------------------------------------------------*) +(* `Shell' for natural numbers. *) +(*----------------------------------------------------------------------------*) + +let num_shell = + let axiom = num_Axiom + and induct = num_INDUCTION + and cases = num_CASES + and distinct = [NOT_SUC] + and one_one = [SUC_INJ] +(* and pre = PRE *) + in Shell + ("num", + {arg_types = []; + constructors = + [("0",[],[]);("SUC",[`:num`],[("PRE",CONJUNCT2 PRE)])]; + axiom = axiom; + induct = induct; + cases = cases; + distinct = distinct; + one_one = one_one; + struct_conv = ONE_STEP_RECTY_EQ_CONV + (induct,distinct,one_one)});; + +(*----------------------------------------------------------------------------*) +(* `Shell' for lists. *) +(*----------------------------------------------------------------------------*) + +let list_shell = + let axiom = new_axiom `!x f. ?!fn1. (fn1 [] = x) /\ (!h t. fn1 (CONS h t) = f (fn1 t) h t)` +(* |- !x f. ?!fn1. (fn1 [] = x) /\ (!h t. fn1 (CONS h t) = f (fn1 t) h t) *) + and induct = list_INDUCT + and cases = list_CASES + and distinct = [NOT_CONS_NIL] + and one_one = [CONS_11] + in Shell + ("list", + {arg_types = [`:'a`]; + constructors = + [("NIL",[],[]); + ("CONS", + [`:'a`;`:('a)list`],[("HD",HD);("TL",TL)])]; + axiom = axiom; + induct = induct; + cases = cases; + distinct = distinct; + one_one = one_one; + struct_conv = ONE_STEP_RECTY_EQ_CONV + (induct,distinct,one_one)});; + +(*----------------------------------------------------------------------------*) +(* Set-up the system shell to reflect the basic HOL system. *) +(*----------------------------------------------------------------------------*) + +system_shells := [list_shell;num_shell];; + +(*----------------------------------------------------------------------------*) +(* define_shell : string -> string -> (string # string list) list -> void *) +(* *) +(* Function for defining a new HOL type together with accessor functions, and *) +(* making a new Boyer-Moore shell from these definitions. If the type already *) +(* exists the function attempts to load the corresponding theorems from the *) +(* current theory hierarchy and use them to make the shell. *) +(* *) +(* The first two arguments correspond to the arguments taken by `define_type' *) +(* and the third argument defines the accessor functions. This is a list of *) +(* constructor names each with names of accessors. The function assumes that *) +(* there are no accessors for a constructor that doesn't appear in the list, *) +(* so it is not necessary to include an entry for a nullary constructor. For *) +(* other constructors there must be one accessor name for each argument and *) +(* they should be given in the correct order. The function ignores any item *) +(* in the list with a constructor name that does not belong to the type. *) +(* *) +(* The constructor and accessor names must all be distinct and must not be *) +(* the names of existing constants. *) +(* *) +(* Example: *) +(* *) +(* define_shell `sexp` `sexp = Nil | Atom * | Cons sexp sexp` *) +(* [(`Atom`,[`Tok`]);(`Cons`,[`Car`;`Cdr`])];; *) +(* *) +(* This results in the following theorems being stored in the current theory *) +(* (or these are the theorems the function would expect to find in the theory *) +(* hierarchy if the type already exists): *) +(* *) +(* sexp (type axiom) *) +(* sexp_Induct (induction theorem) *) +(* sexp_one_one (injectivity of constructors) *) +(* sexp_distinct (distinctness of constructors) *) +(* sexp_cases (cases theorem) *) +(* *) +(* The following definitions for the accessor functions are also stored: *) +(* *) +(* Tok |- !x. Tok(Atom x) = x *) +(* Car |- !s1 s2. Car(Cons s1 s2) = s1 *) +(* Cdr |- !s1 s2. Cdr(Cons s1 s2) = s2 *) +(* *) +(* In certain cases the distinctness or injectivity theorems may not exist, *) +(* when nothing is saved for them. *) +(* *) +(* Finally, a new Boyer-Moore shell is added based on the definitions and *) +(* theorems. *) +(*----------------------------------------------------------------------------*) +(* +let define_shell name syntax accessors = + let find_theory s = + letrec f s l = + if (null l) + then failwith `find_theory` + else if can (theorem (hd l)) s + then hd l + else f s (tl l) + in f s (ancestry ()) + in + let mk_def_eq (name,comb,arg) = + let ty = mk_type(`fun`,[type_of comb;type_of arg]) + in mk_eq(mk_comb(mk_var(name,ty),comb),arg) + in + let define_accessor axiom (name,tm) = + (name,new_recursive_definition false axiom name tm) + in + let define_accessors axiom (comb,specs) = + map (\(name,arg). define_accessor axiom (name,mk_def_eq (name,comb,arg))) + specs + in + if (mem name (shells ())) + then failwith `define_shell -- shell already exists` + else + let defined = is_type name + in let theory = + if defined + then (find_theory name ? + failwith (`define_shell -- no axiom found for type ` ^ name)) + else current_theory () + in let name_Axiom = + if defined + then theorem theory name + else define_type name syntax + in let name_Induct = + if defined + then theorem theory (name ^ `_Induct`) + else save_thm((name ^ `_Induct`),prove_induction_thm name_Axiom) + and name_one_ones = + if defined + then (CONJUNCTS (theorem theory (name ^ `_one_one`)) + ?\s if (can prove_constructors_one_one name_Axiom) + then failwith s + else []) + else ((CONJUNCTS o save_thm) + ((name ^ `_one_one`),prove_constructors_one_one name_Axiom) + ? []) + and name_distincts = + if defined + then (CONJUNCTS (theorem theory (name ^ `_distinct`)) + ?\s if (can prove_constructors_distinct name_Axiom) + then failwith s + else []) + else ((CONJUNCTS o save_thm) + ((name ^ `_distinct`),prove_constructors_distinct name_Axiom) + ? []) + in let name_cases = + if defined + then theorem theory (name ^ `_cases`) + else save_thm((name ^ `_cases`),prove_cases_thm name_Induct) + in let ty = (type_of o fst o dest_forall o concl) name_cases + in let ty_args = snd (dest_type ty) + in let cases = (disjuncts o snd o dest_forall o concl) name_cases + in let combs = map (rhs o snd o strip_exists) cases + in let constrs_and_args = map (((fst o dest_const) # I) o strip_comb) combs + in let (constrs,arg_types) = + split (map (I # (map type_of)) constrs_and_args) + in let acc_specs = + map (\(c,args). combine((snd (assoc c accessors) ? []),args) + ? failwith + (`define_shell -- ` ^ + `incorrect number of accessors for constructor ` ^ c)) + constrs_and_args + in let acc_defs = + if defined + then map (map ((\acc. (acc,definition theory acc)) o fst)) acc_specs + else map (define_accessors name_Axiom) (combine (combs,acc_specs)) + in let name_shell = + Shell (name,ty_args,combine(constrs,combine(arg_types,acc_defs)), + name_Axiom,name_Induct,name_cases, + name_distincts,name_one_ones, + ONE_STEP_RECTY_EQ_CONV + (name_Induct,name_distincts,name_one_ones)) + in do (system_shells := name_shell.system_shells);; +*) diff --git a/Boyer_Moore/struct_equal.ml b/Boyer_Moore/struct_equal.ml new file mode 100644 index 0000000..ed4d97d --- /dev/null +++ b/Boyer_Moore/struct_equal.ml @@ -0,0 +1,354 @@ +(******************************************************************************) +(* FILE : struct_equal.ml *) +(* DESCRIPTION : Proof procedure for simplifying an equation between two *) +(* data-structures of the same type. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton & T.F.Melham *) +(* DATE : 4th June 1992 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 14th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +let subst_occs = + let rec subst_occs slist tm = + let applic,noway = partition (fun (i,(t,x)) -> aconv tm x) slist in + let sposs = map (fun (l,z) -> let l1,l2 = partition ((=) 1) l in + (l1,z),(l2,z)) applic in + let racts,rrest = unzip sposs in + let acts = filter (fun t -> not (fst t = [])) racts in + let trest = map (fun (n,t) -> (map (C (-) 1) n,t)) rrest in + let urest = filter (fun t -> not (fst t = [])) trest in + let tlist = urest @ noway in + if acts = [] then + if is_comb tm then + let l,r = dest_comb tm in + let l',s' = subst_occs tlist l in + let r',s'' = subst_occs s' r in + mk_comb(l',r'),s'' + else if is_abs tm then + let bv,bod = dest_abs tm in + let gv = genvar(type_of bv) in + let nbod = vsubst[gv,bv] bod in + let tm',s' = subst_occs tlist nbod in + alpha bv (mk_abs(gv,tm')),s' + else + tm,tlist + else + let tm' = (fun (n,(t,x)) -> subst[t,x] tm) (hd acts) in + tm',tlist in + fun ilist slist tm -> fst(subst_occs (zip ilist slist) tm);; + +let GSUBS substfn ths th = + let ls = map (lhs o concl) ths + in let vars = map (genvar o type_of) ls + in let w = substfn (List.combine ls vars) (concl th) + in SUBST (List.combine ths vars) w th ;; + +let SUBS_OCCS nlths th = + try (let (nll, ths) = unzip nlths + in GSUBS (subst_occs nll) ths th + ) with Failure _ -> failwith "SUBS_OCCS";; + +(*----------------------------------------------------------------------------*) +(* VAR_NOT_EQ_STRUCT_OF_VAR_CONV : (thm # thm list # thm list) -> conv *) +(* *) +(* Proof method developed through discussion between *) +(* R. Boulton, T. Melham and A. Pitts. *) +(* *) +(* This conversion can be used to prove that a variable is not equal to a *) +(* structure containing that variable as a proper subterm. The structures are *) +(* restricted to applications of constructors from a single recursive type. *) +(* The leaf nodes must be either variables or 0-ary constructors of the type. *) +(* *) +(* The theorems taken as arguments are the induction, distinctness and *) +(* injectivity theorems for the recursive type, as proved by the functions: *) +(* *) +(* prove_induction_thm *) +(* prove_constructors_distinct *) +(* prove_constructors_one_one *) +(* *) +(* Since the latter two functions may fail, the distinctness and injectivity *) +(* theorems are passed around as lists of conjuncts, so that a failure *) +(* results in an empty list. *) +(* *) +(* Examples of input terms: *) +(* *) +(* ~(l = CONS h l) *) +(* ~(CONS h1 (CONS h2 l) = l) *) +(* ~(n = SUC(SUC(SUC n))) *) +(* ~(t = TWO (ONE u) (THREE v (ONE t) (TWO u (ONE t)))) *) +(* *) +(* where the last example is for the type defined by: *) +(* *) +(* test = ZERO | ONE test | TWO test test | THREE test test test *) +(* *) +(* The procedure works by first generalising the structure to eliminate any *) +(* irrelevant substructures. If the variable occurs more than once in the *) +(* structure the more deeply nested occurrences are replaced by new variables *) +(* because multiple occurrences of the variable prevent the induction from *) +(* working. The generalised term for the last example is: *) +(* *) +(* TWO a (THREE v (ONE t) b) *) +(* *) +(* The procedure then forms a conjunction of the inequalities for this term *) +(* and all of its `rotations': *) +(* *) +(* !t. (!a v b. ~(t = TWO a (THREE v (ONE t) b))) /\ *) +(* (!a v b. ~(t = THREE v (ONE (TWO a t)) b)) /\ *) +(* (!a v b. ~(t = ONE (TWO a (THREE v t b)))) *) +(* *) +(* This can be proved by a straightforward structural induction. The reason *) +(* for including the rotations is that the induction hypothesis required for *) +(* the proof of the original generalised term is the rotation of it. *) +(* *) +(* The procedure could be optimised by detecting duplicated rotations. For *) +(* example it is not necessary to prove: *) +(* *) +(* !n. ~(n = SUC(SUC(SUC n))) /\ *) +(* ~(n = SUC(SUC(SUC n))) /\ *) +(* ~(n = SUC(SUC(SUC n))) *) +(* *) +(* in order to prove "~(n = SUC(SUC(SUC n)))" because the structure is its *) +(* own rotations. It is sufficient to prove: *) +(* *) +(* !n. ~(n = SUC(SUC(SUC n))) *) +(* *) +(* The procedure currently uses backwards proof. It would probably be more *) +(* efficient to use forwards proof. *) +(*----------------------------------------------------------------------------*) + +let VAR_NOT_EQ_STRUCT_OF_VAR_CONV = +try( let number_list l = + let rec number_list' n l = + if (l = []) + then [] + else (hd l,n)::(number_list' (n + 1) (tl l)) + in number_list' 1 l + in let name = fst o dest_const + in let occurrences constrs v st = + let rec occurrences' v st path = + if (not (type_of st = type_of v)) then [] + else if (st = v) then [rev path] + else if (is_var st) then [] + else let (f,args) = + (check ( ((can (C assoc constrs)) o name o fst) )) (strip_comb st) +(* Boulton was using hashI here... but I don't know why *) + in flat (map (fun (arg,n) -> occurrences' v arg (n::path)) + (number_list args)) + in occurrences' v st [] + in let min_length l = + let rec min_length' (x,n) l = + if (l = []) + then x + else if (length (hd l) < n) + then min_length' (hd l,length (hd l)) (tl l) + else min_length' (x,n) (tl l) + in if (l = []) + then failwith "min_length" + else min_length' (hd l,length (hd l)) (tl l) + in let rec generalise (st,occ) = + let rec replace_side_structs (n,argn',binding) m args = + if (args = []) + then ([],[]) + else let m' = m + 1 + and arg = hd args + in let (rest,bind) = + replace_side_structs (n,argn',binding) m' (tl args) + in if (m' = n) then ((argn'::rest),(binding @ bind)) + else if (is_var arg) then ((arg::rest),((arg,arg)::bind)) + else let var = genvar (type_of arg) + in ((var::rest),((var,arg)::bind)) + in if (occ = []) + then (st,[]) + else let (f,args) = strip_comb st + and (n::occ') = occ + in let (argn',binding) = generalise (el (n-1) args,occ') + in let (args',bind) = + replace_side_structs (n,argn',binding) 0 args + in (list_mk_comb (f,args'),bind) + in let rec constr_apps v (st,occ) = + let rec replace_argn (n,argn') m args = + if (args = []) + then [] + else let m' = m + 1 + in if (m' = n) + then argn'::(tl args) + else (hd args)::(replace_argn (n,argn') m' (tl args)) + in if (occ = []) + then [] + else let (f,args) = strip_comb st + and (n::occ') = occ + in let args' = replace_argn (n,v) 0 args + in (list_mk_comb (f,args'))::(constr_apps v (el (n-1) args,occ')) + in let rotations l = + let rec rotations' l n = + if (n < 1) + then [] + else l::(rotations' ((tl l) @ [hd l]) (n - 1)) + in rotations' l (length l) + in let two_constrs = (hash (fst o strip_comb) (fst o strip_comb)) o + dest_eq o dest_neg o snd o strip_forall o concl + in let flip (x,y) = (y,x) + in let DEPTH_SYM = GEN_ALL o NOT_EQ_SYM o SPEC_ALL + in let rec arg_types ty = + try (match (dest_type ty) with + | ("fun",[argty;rest]) -> argty::(arg_types rest) + | _ -> []) + with Failure _ -> [] + in let name_and_args = ((hash I) arg_types) o dest_const + in + fun (induction,distincts,oneOnes) -> + let half_distincts = map (fun th -> ((hash name) name) (two_constrs th), th) distincts + in let distincts = half_distincts @ (map ((hash flip) DEPTH_SYM) half_distincts) + in let ind_goals = + (conjuncts o fst o dest_imp o snd o dest_forall o concl) induction + in let constrs = + map (name_and_args o fst o strip_comb o rand o snd o strip_forall o + snd o (splitlist dest_imp) o snd o strip_forall) ind_goals + in + fun tm -> + (let (l,r) = dest_eq (dest_neg tm) + in let (flipped,v,st) = + if (is_var l) + then if (is_var r) then failwith "" else (false,l,r) + else if (is_var r) + then (true,r,l) + else failwith "" + in let occ = min_length (occurrences constrs v st) + in let (st',bind) = generalise (st,occ) + in let (vars,subterms) = List.split bind + in let apps = constr_apps v (st',occ) + in let rotats = + map (end_itlist (fun t1 t2 -> subst [(t2,v)] t1)) (rotations apps) + in let uneqs = map (mk_neg o (curry mk_eq v)) rotats + in let conj = + mk_forall (v,list_mk_conj (map (curry list_mk_forall vars) uneqs)) + in let th1 = + prove (conj,INDUCT_TAC_ induction THEN + ASM_REWRITE_TAC (oneOnes @ (map snd distincts))) + in let th2 = (hd o CONJUNCTS o (SPEC v)) th1 + in let th3 = SPECL subterms th2 + in let th4 = if flipped then (NOT_EQ_SYM th3) else th3 + in EQT_INTRO (CONV_RULE (C ALPHA tm) th4) + )) with Failure _ -> failwith "VAR_NOT_EQ_STRUCT_OF_VAR_CONV";; + +(*----------------------------------------------------------------------------*) +(* CONJS_CONV : conv -> conv *) +(* *) +(* Written by T.F.Melham. *) +(* Modified by R.J.Boulton. *) +(* *) +(* Apply a given conversion to a sequence of conjuncts. *) +(* *) +(* * need to check T case *) +(* * need to flatten conjuncts on RHS *) +(*----------------------------------------------------------------------------*) + +let CONJS_CONV = +try( + let is st th = try(fst(dest_const(rand(concl th))) = st) with Failure _ -> false + in let v1 = genvar `:bool` and v2 = genvar `:bool` + in let fthm1 = + let th1 = ASSUME (mk_eq(v1,`F`)) + in let cnj = mk_conj(v1,v2) + in let th1 = DISCH cnj (EQ_MP th1 (CONJUNCT1 (ASSUME cnj))) + in let th2 = DISCH `F` (CONTR cnj (ASSUME `F`)) + in DISCH (mk_eq(v1,`F`)) (IMP_ANTISYM_RULE th1 th2) + in let fthm2 = CONV_RULE(ONCE_DEPTH_CONV(REWR_CONV CONJ_SYM)) fthm1 + in let fandr th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] fthm1) th + in let fandl th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] fthm2) th + in let tthm1 = + let th1 = ASSUME (mk_eq(v1,`T`)) + in let th2 = SUBS_OCCS [[2],th1] (REFL (mk_conj(v1,v2))) + in DISCH (mk_eq(v1,`T`)) (ONCE_REWRITE_RULE [] th2) + in let tthm2 = CONV_RULE(ONCE_DEPTH_CONV(REWR_CONV CONJ_SYM)) tthm1 + in let tandr th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] tthm1) th + in let tandl th tm = MP (INST [(lhs(concl th),v1);(tm,v2)] tthm2) th + in let rec cconv conv tm = + (let (c,cs) = dest_conj tm + in let cth = conv c + in if (is "F" cth) then fandr cth cs else + let csth = cconv conv cs + in if (is "F" csth) then fandl csth c + else if (is "T" cth) then TRANS (tandr cth cs) csth + else if (is "T" csth) then TRANS (tandl csth c) cth + else try (MK_COMB((AP_TERM `(/\)` cth),csth)) with Failure _ -> conv tm ) + in fun conv tm -> cconv conv tm) with Failure _ -> failwith "CONJS_CONV";; + +(*----------------------------------------------------------------------------*) +(* ONE_STEP_RECTY_EQ_CONV : (thm # thm list # thm list) -> conv -> conv *) +(* *) +(* Single step conversion for equality between structures of a single *) +(* recursive type. *) +(* *) +(* Based on code written by T.F.Melham. *) +(* *) +(* The theorems taken as arguments are the induction, distinctness and *) +(* injectivity theorems for the recursive type, as proved by the functions: *) +(* *) +(* prove_induction_thm *) +(* prove_constructors_distinct *) +(* prove_constructors_one_one *) +(* *) +(* Since the latter two functions may fail, the distinctness and injectivity *) +(* theorems are passed around as lists of conjuncts. *) +(* *) +(* If one side of the equation is a variable and that variable appears in the *) +(* other side (nested in a structure) the equation is proved false. *) +(* *) +(* If the top-level constructors on the two sides of the equation are *) +(* distinct the equation is proved false. *) +(* *) +(* If the top-level constructors on the two sides of the equation are the *) +(* same a conjunction of equations is generated, one equation for each *) +(* argument of the constructor. The conversion given as argument is then *) +(* applied to each conjunct. If any of the applications of this conversion *) +(* fail, so will the entire call. *) +(* *) +(* In other conditions the function fails. *) +(*----------------------------------------------------------------------------*) +(* Taken from HOL90 *) + +let ONE_STEP_RECTY_EQ_CONV (induction,distincts,oneOnes) = + let NOT_EQ_CONV = + EQF_INTRO o EQT_ELIM o + (VAR_NOT_EQ_STRUCT_OF_VAR_CONV (induction,distincts,oneOnes)) o + mk_neg + in let INJ_REW = GEN_REWRITE_CONV I oneOnes +(* Deleted empty_rewrites - GEN_REWRITE_CONV different in hol light - hope it works *) + in let ths1 = map SPEC_ALL distincts + in let ths2 = map (GEN_ALL o EQF_INTRO o NOT_EQ_SYM) ths1 + in let dths = ths2 @ (map (GEN_ALL o EQF_INTRO) ths1) + in let DIST_REW = GEN_REWRITE_CONV I dths + in fun conv -> NOT_EQ_CONV ORELSEC + DIST_REW ORELSEC + (INJ_REW THENC (CONJS_CONV conv)) ORELSEC + (fun tm -> failwith "ONE_STEP_RECTY_EQ_CONV") + +(*----------------------------------------------------------------------------*) +(* RECTY_EQ_CONV : (thm # thm list # thm list) -> conv *) +(* *) +(* Function to simplify as far as possible an equation between two structures *) +(* of some type, the type being specified by the triple of theorems. The *) +(* structures may involve variables. The result may be a conjunction of *) +(* equations simpler than the original. *) +(*----------------------------------------------------------------------------*) + +let RECTY_EQ_CONV (induction,distincts,oneOnes) = +try ( + let one_step_conv = ONE_STEP_RECTY_EQ_CONV (induction,distincts,oneOnes) + and REFL_CONV tm = + let (l,r) = dest_eq tm + in if (l = r) + then EQT_INTRO (REFL l) + else failwith "REFL_CONV" + in let rec conv tm = + (one_step_conv conv ORELSEC REFL_CONV ORELSEC ALL_CONV) tm + in fun tm -> conv tm ) with Failure _ -> failwith "RECTY_EQ_CONV";; diff --git a/Boyer_Moore/support.ml b/Boyer_Moore/support.ml new file mode 100644 index 0000000..801b52d --- /dev/null +++ b/Boyer_Moore/support.ml @@ -0,0 +1,215 @@ +(******************************************************************************) +(* FILE : support.ml *) +(* DESCRIPTION : Miscellaneous supporting definitions for Boyer-Moore *) +(* style prover in HOL. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 6th June 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 21st June 1991 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : 2008 *) +(******************************************************************************) + +let SUBST thl pat th = + let eqs,vs = unzip thl in + let gvs = map (genvar o type_of) vs in + let gpat = subst (zip gvs vs) pat in + let ls,rs = unzip (map (dest_eq o concl) eqs) in + let ths = map (ASSUME o mk_eq) (zip gvs rs) in + let th1 = ASSUME gpat in + let th2 = SUBS ths th1 in + let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in + let th4 = INST (zip ls gvs) th3 in + MP (rev_itlist (C MP) eqs th4) th;; + +let SUBST_CONV thvars template tm = + let thms,vars = unzip thvars in + let gvs = map (genvar o type_of) vars in + let gtemplate = subst (zip gvs vars) template in + SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; + +let CONTRAPOS = + let a = `a:bool` and b = `b:bool` in + let pth = ITAUT `(a ==> b) ==> (~b ==> ~a)` in + fun th -> + try let P,Q = dest_imp(concl th) in + MP (INST [P,a; Q,b] pth) th + with Failure _ -> failwith "CONTRAPOS";; + +let NOT_EQ_SYM = + let pth = GENL [`a:A`; `b:A`] + (CONTRAPOS(DISCH_ALL(SYM(ASSUME`a:A = b`)))) + and aty = `:A` in + fun th -> try let l,r = dest_eq(dest_neg(concl th)) in + MP (SPECL [r; l] (INST_TYPE [type_of l,aty] pth)) th + with Failure _ -> failwith "NOT_EQ_SYM";; + + +let hash f g (x,y) = (f x,g y);; +let hashI f (x,y) = hash f I (x,y);; + +let fst3 (x,_,_) = x;; +let snd3 (_,x,_) = x;; +let thd3 (_,_,x) = x;; + +let lcombinep (x,y) = List.combine x y;; +let lcount x l = length ( filter ((=) x) l );; + + +let list_mk_imp (tms,tm) = + if (tms = []) then tm + else try itlist (fun p q -> mk_imp (p,q)) tms tm with Failure _ -> failwith "list_mk_imp";; + +let INDUCT_TAC_ thm = MATCH_MP_TAC thm THEN + CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN GEN_TAC THEN DISCH_TAC] ;; + +(*--------------------------------------------------------------------------*) +(* distinct : ''a list -> bool *) +(* *) +(* Checks whether the elements of a list are all distinct. *) +(*--------------------------------------------------------------------------*) + +let rec distinct x = + if (x = []) then true + else not (mem (hd x) (tl x)) & distinct (tl x);; + + +(*----------------------------------------------------------------------------*) +(* Discriminator functions for T (true) and F (false) *) +(*----------------------------------------------------------------------------*) + +let is_T = let T = `T` in fun tm -> tm = T +and is_F = let F = `F` in fun tm -> tm = F;; + +(*--------------------------------------------------------------------------*) +(* conj_list : term -> term list *) +(* *) +(* Splits a conjunction into conjuncts. Only recursively splits the right *) +(* conjunct. *) +(*--------------------------------------------------------------------------*) + +let rec conj_list tm = + try( + let (tm1,tm2) = dest_conj tm + in tm1::(conj_list tm2) + ) with Failure _ -> [tm];; + +(*--------------------------------------------------------------------------*) +(* disj_list : term -> term list *) +(* *) +(* Splits a disjunction into disjuncts. Only recursively splits the right *) +(* disjunct. *) +(*--------------------------------------------------------------------------*) + +let rec disj_list tm = + try( + let (tm1,tm2) = dest_disj tm + in tm1::(disj_list tm2) + ) with Failure _ -> [tm];; + +(*----------------------------------------------------------------------------*) +(* number_list : * list -> ( * # int) list *) +(* *) +(* Numbers a list of elements, *) +(* e.g. [`a`;`b`;`c`] ---> [(`a`,1);(`b`,2);(`c`,3)]. *) +(*----------------------------------------------------------------------------*) + +let number_list l = + let rec number_list' n l = + if ( l = [] ) then [] + else (hd l,n)::(number_list' (n + 1) (tl l)) + in number_list' 1 l;; + +(*----------------------------------------------------------------------------*) +(* insert_on_snd : ( * # int) -> ( * # int) list -> ( * # int) list *) +(* *) +(* Insert a numbered element into an ordered list, *) +(* e.g. insert_on_snd (`c`,3) [(`a`,1);(`b`,2);(`d`,4)] ---> *) +(* [(`a`,1); (`b`,2); (`c`,3); (`d`,4)] *) +(*----------------------------------------------------------------------------*) + +let rec insert_on_snd (x,n) l = + if (l = []) + then [(x,n)] + else let h = hd l + in if (n < snd h) + then (x,n)::l + else h::(insert_on_snd (x,n) (tl l));; + +(*----------------------------------------------------------------------------*) +(* sort_on_snd : ( * # int) list -> ( * # int) list *) +(* *) +(* Sort a list of pairs, of which the second component is an integer, *) +(* e.g. sort_on_snd [(`c`,3);(`d`,4);(`a`,1);(`b`,2)] ---> *) +(* [(`a`,1); (`b`,2); (`c`,3); (`d`,4)] *) +(*----------------------------------------------------------------------------*) + +let rec sort_on_snd l = + if (l = []) + then [] + else (insert_on_snd (hd l) (sort_on_snd (tl l)));; + +(*----------------------------------------------------------------------------*) +(* conj_list : term -> term list *) +(* *) +(* Splits a conjunction into conjuncts. Only recursively splits the right *) +(* conjunct. *) +(*----------------------------------------------------------------------------*) + +let rec conj_list tm = + try + (let (tm1,tm2) = dest_conj tm + in tm1::(conj_list tm2)) + with Failure _ -> [tm];; + +(*----------------------------------------------------------------------------*) +(* disj_list : term -> term list *) +(* *) +(* Splits a disjunction into disjuncts. Only recursively splits the right *) +(* disjunct. *) +(*----------------------------------------------------------------------------*) + +let rec disj_list tm = + try + (let (tm1,tm2) = dest_disj tm + in tm1::(disj_list tm2)) + with Failure _ -> [tm];; + +(*----------------------------------------------------------------------------*) +(* find_bm_terms : (term -> bool) -> term -> term list *) +(* *) +(* Function to find all subterms in a term that satisfy a given predicate p, *) +(* breaking down terms as if they were Boyer-Moore logic expressions. *) +(* In particular, the operator of a function application is only processed if *) +(* it is of zero arity, i.e. there are no arguments. *) +(*----------------------------------------------------------------------------*) + +let find_bm_terms p tm = + try + (let rec accum tml p tm = + let tml' = if (p tm) then (tm::tml) else tml + in ( let args = snd (strip_comb tm) + in ( try ( rev_itlist (fun tm tml -> accum tml p tm) args tml' ) with Failure _ -> tml' ) ) + in accum [] p tm + ) with Failure _ -> failwith "find_bm_terms";; + +(*----------------------------------------------------------------------------*) +(* remove_el : int -> * list -> ( * # * list) *) +(* *) +(* Removes a specified (by numerical position) element from a list. *) +(*----------------------------------------------------------------------------*) + +let rec remove_el n l = + if ((l = []) or (n < 1)) + then failwith "remove_el" + else if (n = 1) + then (hd l,tl l) + else let (x,l') = remove_el (n - 1) (tl l) + in (x,(hd l)::l');; + diff --git a/Boyer_Moore/terms_and_clauses.ml b/Boyer_Moore/terms_and_clauses.ml new file mode 100644 index 0000000..89f874a --- /dev/null +++ b/Boyer_Moore/terms_and_clauses.ml @@ -0,0 +1,766 @@ + +(******************************************************************************) +(* FILE : terms_and_clauses.ml *) +(* DESCRIPTION : Rewriting terms and simplifying clauses. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 7th June 1991 *) +(* *) +(* MODIFIED : R.J.Boulton *) +(* DATE : 16th October 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +let SUBST_CONV thvars template tm = + let thms,vars = unzip thvars in + let gvs = map (genvar o type_of) vars in + let gtemplate = subst (zip gvs vars) template in + SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; + + +let bool_EQ_CONV = + let check = let boolty = `:bool` in check (fun tm -> type_of tm = boolty) in + let clist = map (GEN `b:bool`) + (CONJUNCTS(SPEC `b:bool` EQ_CLAUSES)) in + let tb = hd clist and bt = hd(tl clist) in + let T = `T` and F = `F` in + fun tm -> + try let l,r = (I F_F check) (dest_eq tm) in + if l = r then EQT_INTRO (REFL l) else + if l = T then SPEC r tb else + if r = T then SPEC l bt else fail() + with Failure _ -> failwith "bool_EQ_CONV";; + +(*----------------------------------------------------------------------------*) +(* rewrite_with_lemmas : (term list -> term list -> conv) -> *) +(* term list -> term list -> conv *) +(* *) +(* Function to rewrite with known lemmas (rewrite rules) in the reverse order *) +(* in which they were introduced. Applies the first applicable lemma, or if *) +(* none are applicable it leaves the term unchanged. *) +(* *) +(* A rule is applicable if its LHS matches the term, and it does not violate *) +(* the `alphabetical' ordering rule if it is a permutative rule. To be *) +(* applicable, the hypotheses of the rules must be satisfied. The function *) +(* takes a general rewrite rule, a chain of hypotheses and a list of *) +(* assumptions as arguments. It uses these to try to satisfy the hypotheses. *) +(* If a hypotheses is in the assumption list, it is assumed. Otherwise a *) +(* check is made that the hypothesis is not already a goal of the proof *) +(* procedure. This is to prevent looping. If it's not already a goal, the *) +(* function attempts to rewrite the hypotheses, with it added to the chain of *) +(* hypotheses. *) +(* *) +(* Before trying to establish the hypotheses of a rewrite rule, it is *) +(* necessary to instantiate any free variables in the hypotheses. This is *) +(* done by trying to find an instantiation that makes one of the hypotheses *) +(* equal to a term in the assumption list. *) +(*----------------------------------------------------------------------------*) + +let rewrite_with_lemmas rewrite hyp_chain assumps tm = + let rewrite_hyp h = +try (EQT_INTRO (ASSUME (find (fun tm -> tm = h) assumps))) with Failure _ -> + (if (mem h hyp_chain) + then ALL_CONV h + else rewrite (h::hyp_chain) assumps h) + in + let rec try_rewrites assumps ths = + if (ths = []) + then failwith "try_rewrites" + else (try (let th = inst_frees_in_hyps assumps (hd ths) + in let hyp_ths = map (EQT_ELIM o rewrite_hyp) (hyp th) + in itlist PROVE_HYP hyp_ths th) + with Failure _ -> (try_rewrites assumps (tl ths)) + ) + in try (try_rewrites assumps (applicable_rewrites tm)) with Failure _ -> ALL_CONV tm;; + +(*----------------------------------------------------------------------------*) +(* rewrite_explicit_value : conv *) +(* *) +(* Explicit values are normally unchanged by rewriting, but in the case of a *) +(* numeric constant, it is expanded out into SUC form. *) +(*----------------------------------------------------------------------------*) + +let rec rewrite_explicit_value tm = + let rec conv tm = (num_CONV THENC TRY_CONV (RAND_CONV conv)) tm + in ((TRY_CONV conv) THENC + (TRY_CONV (ARGS_CONV rewrite_explicit_value))) tm;; + +(*----------------------------------------------------------------------------*) +(* COND_T = |- (T => t1 | t2) = t1 *) +(* COND_F = |- (F => t1 | t2) = t2 *) +(*----------------------------------------------------------------------------*) + +let [COND_T;COND_F] = CONJUNCTS (SPEC_ALL COND_CLAUSES);; + +(*----------------------------------------------------------------------------*) +(* COND_LEFT = *) +(* |- !b x x' y. (b ==> (x = x')) ==> ((b => x | y) = (b => x' | y)) *) +(*----------------------------------------------------------------------------*) + +let COND_LEFT = + prove + (`!b x x' (y:'a). (b ==> (x = x')) ==> ((if b then x else y) = (if b then x' else y))`, + REPEAT GEN_TAC THEN + BOOL_CASES_TAC `b:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* COND_RIGHT = *) +(* |- !b y y' x. (~b ==> (y = y')) ==> ((b => x | y) = (b => x | y')) *) +(*----------------------------------------------------------------------------*) + +let COND_RIGHT = + prove + (`!b y y' (x:'a). (~b ==> (y = y')) ==> ((if b then x else y) = (if b then x else y'))`, + REPEAT GEN_TAC THEN + BOOL_CASES_TAC `b:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* COND_ID = |- !b t. (b => t | t) = t *) +(*----------------------------------------------------------------------------*) + +(* Already defined in HOL *) + +(*----------------------------------------------------------------------------*) +(* COND_RIGHT_F = |- (b => b | F) = b *) +(*----------------------------------------------------------------------------*) + +let COND_RIGHT_F = + prove + (`(if b then b else F) = b`, + BOOL_CASES_TAC `b:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* COND_T_F = |- (b => T | F) = b *) +(*----------------------------------------------------------------------------*) + +let COND_T_F = + prove + (`(if b then T else F) = b`, + BOOL_CASES_TAC `b:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* rewrite_conditional : (term list -> conv) -> term list -> conv *) +(* *) +(* Rewriting conditionals. Takes a general rewrite function and a list of *) +(* assumptions as arguments. *) +(* *) +(* The function assumes that the term it is given is of the form "b => x | y" *) +(* First it recursively rewrites b to b'. If b' is T or F, the conditional is *) +(* reduced to x or y, respectively. The result is then rewritten recursively. *) +(* If b' is not T or F, both x and y are rewritten, under suitable additional *) +(* assumptions about b'. An attempt is then made to rewrite the new *) +(* conditional with one of the following: *) +(* *) +(* (b => x | x) ---> x *) +(* (b => b | F) ---> b *) +(* (b => T | F) ---> b *) +(* *) +(* The three rules are tried in the order shown above. *) +(*----------------------------------------------------------------------------*) + +let rewrite_conditional rewrite assumps tm = +try (let th1 = RATOR_CONV (RATOR_CONV (RAND_CONV (rewrite assumps))) tm + in let tm1 = rhs (concl th1) + in let (b',(x,y)) = dest_cond tm1 + in if (is_T b') then + TRANS th1 (((REWR_CONV COND_T) THENC (rewrite assumps)) tm1) + else if (is_F b') then + TRANS th1 (((REWR_CONV COND_F) THENC (rewrite assumps)) tm1) + else let th2 = DISCH b' (rewrite (b'::assumps) x) + in let x' = rand (rand (concl th2)) + in let th3 = MP (ISPECL [b';x;x';y] COND_LEFT) th2 + in let tm3 = rhs (concl th3) + in let notb' = mk_neg b' + in let th4 = DISCH notb' (rewrite (notb'::assumps) y) + in let y' = rand (rand (concl th4)) + in let th5 = MP (ISPECL [b';y;y';x'] COND_RIGHT) th4 + in let th6 = ((REWR_CONV COND_ID) ORELSEC + (REWR_CONV COND_RIGHT_F) ORELSEC + (TRY_CONV (REWR_CONV COND_T_F))) (rhs (concl th5)) + in TRANS (TRANS (TRANS th1 th3) th5) th6 + ) with Failure _ -> failwith "rewrite_conditional";; + +(*----------------------------------------------------------------------------*) +(* EQ_T = |- (x = T) = x *) +(*----------------------------------------------------------------------------*) + +let EQ_T = + prove + (`(x = T) = x`, + BOOL_CASES_TAC `x:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* EQ_EQ = |- (x = (y = z)) = ((y = z) => (x = T) | (x = F)) *) +(*----------------------------------------------------------------------------*) + +let EQ_EQ = + prove + (`(x = ((y:'a) = z)) = (if (y = z) then (x = T) else (x = F))`, + BOOL_CASES_TAC `x:bool` THEN + BOOL_CASES_TAC `(y:'a) = z` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* EQ_F = |- (x = F) = (x => F | T) *) +(*----------------------------------------------------------------------------*) + +let EQ_F = + prove + (`(x = F) = (if x then F else T)`, + BOOL_CASES_TAC `x:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* prove_terms_not_eq : term -> term -> thm *) +(* *) +(* Function to prove that the left-hand and right-hand sides of an equation *) +(* are not equal. Works with Boolean constants, explicit values, and terms *) +(* involving constructors and variables. *) +(*----------------------------------------------------------------------------*) + +let prove_terms_not_eq l r = + let rec STRUCT_CONV tm = + (bool_EQ_CONV ORELSEC + NUM_EQ_CONV ORELSEC + (fun tm -> let (l,r) = dest_eq tm + in let ty_name = (fst o dest_type) (type_of l) + in let (ty_info:shell_info) = sys_shell_info ty_name + in let ty_conv = ty_info.struct_conv + in ty_conv STRUCT_CONV tm) ORELSEC + (* REFL_CONV ORELSEC Omitted because it cannot generate false *) + ALL_CONV) tm + in try(let th = STRUCT_CONV (mk_eq (l,r)) + in if (is_F (rhs (concl th))) then th else failwith "" + ) with Failure _ -> failwith "prove_terms_not_eq";; + +(*----------------------------------------------------------------------------*) +(* rewrite_equality : (term list -> term list -> conv) -> *) +(* term list -> term list -> conv *) +(* *) +(* Function for rewriting equalities. Takes a general rewrite function, a *) +(* chain of hypotheses and a list of assumptions as arguments. *) +(* *) +(* The left-hand and right-hand sides of the equality are rewritten *) +(* recursively. If the two sides are then identical, the term is rewritten to *) +(* T. If it can be shown that the two sides are not equal, the term is *) +(* rewritten to F. Otherwise, the function rewrites with the first of the *) +(* following rules that is applicable (or it leaves the term unchanged if *) +(* none are applicable): *) +(* *) +(* (x = T) ---> x *) +(* (x = (y = z)) ---> ((y = z) => (x = T) | (x = F)) *) +(* (x = F) ---> (x => F | T) *) +(* *) +(* The result is then rewritten using the known lemmas (rewrite rules). *) +(*----------------------------------------------------------------------------*) + +let rewrite_equality rewrite hyp_chain assumps tm = +try (let th1 = ((RATOR_CONV (RAND_CONV (rewrite hyp_chain assumps))) THENC + (RAND_CONV (rewrite hyp_chain assumps))) tm + in let tm1 = rhs (concl th1) + in let (l,r) = dest_eq tm1 + in if (l = r) + then TRANS th1 (EQT_INTRO (ISPEC l EQ_REFL)) + else try(TRANS th1 (prove_terms_not_eq l r)) + with Failure _ -> (let th2 = ((REWR_CONV EQ_T) ORELSEC + (REWR_CONV EQ_EQ) ORELSEC + (TRY_CONV (REWR_CONV EQ_F))) tm1 + in let th3 = rewrite_with_lemmas + rewrite hyp_chain assumps (rhs (concl th2)) + in TRANS (TRANS th1 th2) th3) + ) with Failure _ -> failwith "rewrite_equality";; + +(*----------------------------------------------------------------------------*) +(* rewrite_application : *) +(* (term -> string list -> term list -> term list -> conv) -> *) +(* term -> string list -> term list -> term list -> conv *) +(* *) +(* Function for rewriting applications. It takes a general rewriting function,*) +(* a literal (the literal containing the function call), a list of names of *) +(* functions that are tentatively being opened up, a chain of hypotheses, and *) +(* a list of assumptions as arguments. *) +(* *) +(* The function begins by rewriting the arguments. It then determines the *) +(* name of the function being applied. If this is a constructor, no further *) +(* rewriting is done. Otherwise, from the function name, the number of the *) +(* argument used for recursion (or zero if the definition is not recursive) *) +(* and expansion theorems for each possible constructor are obtained. If the *) +(* function is not recursive the call is opened up and the body is rewritten. *) +(* If the function has no definition, the application is rewritten using the *) +(* known lemmas. *) +(* *) +(* If the definition is recursive, but this function has already been *) +(* tentatively opened up, the version of the application with the arguments *) +(* rewritten is returned. *) +(* *) +(* Otherwise, the application is rewritten with the known lemmas. If any of *) +(* the lemmas are applicable the result of the rewrite is returned. Otherwise *) +(* the function determines the name of the constructor appearing in the *) +(* recursive argument, and looks up its details. If this process fails due to *) +(* either the recursive argument not being an application of a constructor, *) +(* or because the constructor is not known, the function call cannot be *) +(* expanded, so the original call (with arguments rewritten) is returned. *) +(* *) +(* Provided a valid constructor is present in the recursive argument position *) +(* the call is tentatively opened up. The body is rewritten with the name of *) +(* the function added to the `tentative openings' list. (Actually, the name *) +(* is not added to the list if the recursive argument of the call was an *) +(* explicit value). The result is compared with the unopened call to see if *) +(* it has good properties. If it does, the simplified body is returned. *) +(* Otherwise the unopened call is returned. *) +(*----------------------------------------------------------------------------*) + +let rewrite_application rewrite lit funcs hyp_chain assumps tm = +try (let th1 = ARGS_CONV (rewrite lit funcs hyp_chain assumps) tm + in let tm1 = rhs (concl th1) + in let (f,args) = strip_comb tm1 + in let name = fst (dest_const f) + in + if (mem name (all_constructors ())) + then th1 + else try + (let (i,constructors) = get_def name + in if (i = 0) then + (let th2 = REWR_CONV (snd (hd constructors)) tm1 + in let th3 = rewrite lit funcs hyp_chain assumps (rhs (concl th2)) + in TRANS (TRANS th1 th2) th3) + else if (mem name funcs) then th1 + else let th2 = + rewrite_with_lemmas (rewrite lit funcs) hyp_chain assumps tm1 + in let tm2 = rhs (concl th2) + in if (tm2 = tm1) + then try (let argi = el (i-1) args + in let constructor = + (try (fst (dest_const (fst (strip_comb argi)))) with Failure _ -> "") + in (let th = assoc constructor constructors + in let th3 = REWR_CONV th tm1 + in let tm3 = rhs (concl th3) + in let funcs' = + if (is_explicit_value argi) + then funcs + else name::funcs + in let th4 = + rewrite lit funcs' hyp_chain assumps tm3 + in let tm4 = rhs (concl th4) + in if (good_properties assumps tm1 tm4 lit) + then TRANS (TRANS th1 th3) th4 + else th1) + ) with Failure _ -> th1 + else TRANS th1 th2) + with Failure "get_def" -> + (TRANS th1 (rewrite_with_lemmas (rewrite lit funcs) hyp_chain assumps tm1)) + ) with Failure _ -> failwith "rewrite_application";; + +(*----------------------------------------------------------------------------*) +(* rewrite_term : term -> string list -> term list -> term list -> conv *) +(* *) +(* Function for rewriting a term. Arguments are as follows: *) +(* *) +(* lit : the literal containing the term to be rewritten. *) +(* funcs : names of functions that have been tentatively opened up. *) +(* hyp_chain : hypotheses that we are trying to satisfy by parent calls. *) +(* assumps : a list of assumptions. *) +(* tm : the term to be rewritten. *) +(*----------------------------------------------------------------------------*) + +let rec rewrite_term lit funcs hyp_chain assumps tm = +try (EQT_INTRO (ASSUME (find (fun t -> t = tm) assumps))) with Failure _ -> +try (EQF_INTRO (ASSUME (find (fun t -> t = mk_neg tm) assumps))) with Failure _ -> +try (let rewrite = rewrite_term lit funcs + in if (is_var tm) then ALL_CONV tm + else if (is_explicit_value tm) then rewrite_explicit_value tm + else if (is_cond tm) then rewrite_conditional (rewrite hyp_chain) assumps tm + else if (is_eq tm) then rewrite_equality rewrite hyp_chain assumps tm + else rewrite_application rewrite_term lit funcs hyp_chain assumps tm + ) with Failure _ -> failwith "rewrite_term";; + +(*----------------------------------------------------------------------------*) +(* COND_RAND = |- !f b x y. f (b => x | y) = (b => f x | f y) *) +(*----------------------------------------------------------------------------*) + +(* Already defined in HOL *) + +(*----------------------------------------------------------------------------*) +(* COND_RATOR = |- !b f g x. (b => f | g) x = (b => f x | g x) *) +(*----------------------------------------------------------------------------*) + +(* Already defined in HOL *) + +(*----------------------------------------------------------------------------*) +(* MOVE_COND_UP_CONV : conv *) +(* *) +(* Moves all conditionals in a term up to the top-level. Checks to see if the *) +(* term contains any conditionals before it starts to do inference. This *) +(* improves the performance significantly. Alternatively, failure could be *) +(* used to avoid rebuilding unchanged sub-terms. This would be even more *) +(* efficient. *) +(*----------------------------------------------------------------------------*) + +let rec MOVE_COND_UP_CONV tm = +try(if (not (can (find_term is_cond) tm)) then ALL_CONV tm + else if (is_cond tm) then + ((RATOR_CONV (RATOR_CONV (RAND_CONV MOVE_COND_UP_CONV))) THENC + (RATOR_CONV (RAND_CONV MOVE_COND_UP_CONV)) THENC + (RAND_CONV MOVE_COND_UP_CONV)) tm + else if (is_comb tm) then + (let (op,arg) = dest_comb tm + in if (is_cond op) then + ((REWR_CONV COND_RATOR) THENC MOVE_COND_UP_CONV) tm + else if (is_cond arg) then + ((REWR_CONV COND_RAND) THENC MOVE_COND_UP_CONV) tm + else (let th = ((RATOR_CONV MOVE_COND_UP_CONV) THENC + (RAND_CONV MOVE_COND_UP_CONV)) tm + in let tm' = rhs (concl th) + in if (tm' = tm) + then th + else TRANS th (MOVE_COND_UP_CONV tm'))) + else ALL_CONV tm + ) with Failure _ -> failwith "MOVE_COND_UP_CONV";; + +(*----------------------------------------------------------------------------*) +(* COND_OR = |- (b => x | y) \/ z = (~b \/ x \/ z) /\ (b \/ y \/ z) *) +(*----------------------------------------------------------------------------*) + +let COND_OR = + prove + (`(if b then x else y) \/ z <=> ((~b \/ x \/ z) /\ (b \/ y \/ z))`, + BOOL_CASES_TAC `b:bool` THEN + REWRITE_TAC []);; + +(*----------------------------------------------------------------------------*) +(* COND_EXPAND = |- (x => y | z) = ((~x \/ y) /\ (x \/ z)) *) +(*----------------------------------------------------------------------------*) + +(* Already proved *) + +(*----------------------------------------------------------------------------*) +(* NOT_NOT_NORM = |- ~~x = x *) +(*----------------------------------------------------------------------------*) + +(* Already proved *) + +(*----------------------------------------------------------------------------*) +(* LEFT_OR_OVER_AND = |- !t1 t2 t3. t1 \/ t2 /\ t3 = (t1 \/ t2) /\ (t1 \/ t3) *) +(*----------------------------------------------------------------------------*) + +(* Already available in HOL *) + +(*----------------------------------------------------------------------------*) +(* MOVE_NOT_THRU_CONDS_CONV : conv *) +(* *) +(* Function to push a negation down through (possibly) nested conditionals. *) +(* Eliminates any double-negations that may be introduced. *) +(*----------------------------------------------------------------------------*) + +let rec MOVE_NOT_THRU_CONDS_CONV tm = + try (if (is_neg tm) + then if (is_cond (rand tm)) + then ((REWR_CONV COND_RAND) THENC + (RATOR_CONV (RAND_CONV MOVE_NOT_THRU_CONDS_CONV)) THENC + (RAND_CONV MOVE_NOT_THRU_CONDS_CONV)) tm + else TRY_CONV (REWR_CONV NOT_NOT_NORM) tm + else ALL_CONV tm + ) with Failure _ -> failwith "MOVE_NOT_THRU_CONDS_CONV";; + +(*----------------------------------------------------------------------------*) +(* EXPAND_ONE_COND_CONV : conv *) +(* *) +(* The function takes a term which it assumes to be either a conditional or *) +(* the disjunction of a conditional and some other term, and applies one of *) +(* the following rewrites as appropriate: *) +(* *) +(* |- (b => x | y) = (~b \/ x) /\ (b \/ y) *) +(* *) +(* |- (b => x | y) \/ z = (~b \/ x \/ z) /\ (b \/ y \/ z) *) +(* *) +(* If b happens to be a conditional, the negation of ~b is moved down through *) +(* the conditional (and any nested conditionals). *) +(*----------------------------------------------------------------------------*) + +let EXPAND_ONE_COND_CONV tm = +try (((REWR_CONV COND_OR) ORELSEC (REWR_CONV COND_EXPAND)) THENC + (RATOR_CONV (RAND_CONV (RATOR_CONV (RAND_CONV MOVE_NOT_THRU_CONDS_CONV))))) + tm with Failure _ -> failwith "EXPAND_ONE_COND_CONV";; + +(*----------------------------------------------------------------------------*) +(* OR_OVER_ANDS_CONV : conv -> conv *) +(* *) +(* Distributes an OR over an arbitrary tree of conjunctions and applies a *) +(* conversion to each of the disjunctions that make up the new conjunction. *) +(*----------------------------------------------------------------------------*) + +let rec OR_OVER_ANDS_CONV conv tm = + if (is_disj tm) + then if (is_conj (rand tm)) + then ((REWR_CONV LEFT_OR_OVER_AND) THENC + (RATOR_CONV (RAND_CONV (OR_OVER_ANDS_CONV conv))) THENC + (RAND_CONV (OR_OVER_ANDS_CONV conv))) tm + else conv tm + else ALL_CONV tm;; + +(*----------------------------------------------------------------------------*) +(* EXPAND_COND_CONV : conv *) +(* *) +(* The function takes a term which it assumes to be either a conditional or *) +(* the disjunction of a conditional and some other term, and expands the *) +(* conditional into a disjunction using one of: *) +(* *) +(* |- (b => x | y) = (~b \/ x) /\ (b \/ y) *) +(* *) +(* |- (b => x | y) \/ z = (~b \/ x \/ z) /\ (b \/ y \/ z) *) +(* *) +(* The b, x and y may themselves be conditionals. If so, the function expands *) +(* these as well, and so on, until there are no more conditionals. At each *) +(* stage disjunctions are distributed over conjunctions so that the final *) +(* result is a conjunction `tree' where each of the conjuncts is a *) +(* disjunction. The depth of a disjunction in the conjunction tree indicates *) +(* the number of literals that have been added to the disjunction compared to *) +(* the original term. *) +(*----------------------------------------------------------------------------*) + +let rec EXPAND_COND_CONV tm = + try (EXPAND_ONE_COND_CONV THENC + (RATOR_CONV (RAND_CONV ((RAND_CONV EXPAND_COND_CONV) THENC + (OR_OVER_ANDS_CONV EXPAND_COND_CONV)))) THENC + (RAND_CONV ((RAND_CONV EXPAND_COND_CONV) THENC + (OR_OVER_ANDS_CONV EXPAND_COND_CONV)))) tm + with Failure _ -> ALL_CONV tm;; + +(*----------------------------------------------------------------------------*) +(* SPLIT_CLAUSE_ON_COND_CONV : int -> conv *) +(* *) +(* The function takes a number n and a term which it assumes to be a *) +(* disjunction of literals in which the (n-1)th argument has had all *) +(* conditionals moved to the top level. *) +(* *) +(* The function dives down to the (n-1)th literal (disjunct) and expands the *) +(* conditionals into disjunctions, resulting in a conjunction `tree' in which *) +(* each conjunct is a disjunction. *) +(* *) +(* As the function `backs out' from the (n-1)th literal it distributes the *) +(* ORs over the conjunction tree. *) +(*----------------------------------------------------------------------------*) + +let SPLIT_CLAUSE_ON_COND_CONV n tm = + try (funpow n (fun conv -> (RAND_CONV conv) THENC (OR_OVER_ANDS_CONV ALL_CONV)) + EXPAND_COND_CONV tm + ) with Failure _ -> failwith "SPLIT_CLAUSE_ON_COND_CONV";; + +(*----------------------------------------------------------------------------*) +(* simplify_one_literal : int -> term -> (thm # int) *) +(* *) +(* Attempts to simplify one literal of a clause assuming the negations of the *) +(* other literals. The number n specifies which literal to rewrite. If n = 0, *) +(* the first literal is rewritten. The function fails if n is out of range. *) +(* *) +(* If the literal to be simplified is negative, the function simplifies the *) +(* corresponding atom, and negates the result. If this new result is T or F, *) +(* the clause is rebuilt by discharging the assumptions. This process may *) +(* reduce the number of literals in the clause, so the theorem returned is *) +(* paired with -1 (except when processing the last literal of a clause in *) +(* which case returning 0 will, like -1, cause a failure when an attempt is *) +(* made to simplify the next literal, but is safer because it can't cause *) +(* looping if the literal has not been removed. This is the case when the *) +(* last literal has been rewritten to F. In this situation, the discharging *) +(* function does not eliminate the literal). *) +(* *) +(* If the simplified literal contains conditionals, these are brought up to *) +(* the top-level. The clause is then rebuilt by discharging. If no *) +(* conditionals were present the theorem is returned with 0, indicating that *) +(* the number of literals has not changed. Otherwise the clause is split into *) +(* a conjunction of clauses, so that the conditionals are eliminated, and the *) +(* result is returned with the number 1 to indicate that the number of *) +(* literals has increased. *) +(*----------------------------------------------------------------------------*) + +let simplify_one_literal n tm = +try (let negate tm = if (is_neg tm) then (rand tm) else (mk_neg tm) + and NEGATE th = + let tm = rhs (concl th) + and th' = AP_TERM `(~)` th + in if (is_T tm) then TRANS th' (el 1 (CONJUNCTS NOT_CLAUSES)) + else if (is_F tm) then TRANS th' (el 2 (CONJUNCTS NOT_CLAUSES)) + else th' + in let (overs,y,unders) = match (chop_list n (disj_list tm)) with + | (overs,y::unders) -> (overs,y,unders) + | _ -> failwith "" +(* ) with Failure _ -> failwith "" *) + in let overs' = map negate overs + and unders' = map negate unders + in let th1 = + if (is_neg y) + then NEGATE (rewrite_term y [] [] (overs' @ unders') (rand y)) + else rewrite_term y [] [] (overs' @ unders') y + in let tm1 = rhs (concl th1) + in if ((is_T tm1) or (is_F tm1)) + then (MULTI_DISJ_DISCH (overs',unders') th1, + if (unders = []) then 0 else (-1)) + else let th2 = TRANS th1 (MOVE_COND_UP_CONV tm1) + in let tm2 = rhs (concl th2) + in let th3 = MULTI_DISJ_DISCH (overs',unders') th2 + in if (is_cond tm2) + then (CONV_RULE (RAND_CONV (SPLIT_CLAUSE_ON_COND_CONV n)) th3,1) + else (th3,0) + ) with Failure _ -> failwith "simplify_one_literal";; + +(*----------------------------------------------------------------------------*) +(* simplify_clause : int -> term -> (term list # proof) *) +(* simplify_clauses : int -> term -> (term list # proof) *) +(* *) +(* Functions for simplifying a clause by rewriting each literal in turn *) +(* assuming the negations of the others. *) +(* *) +(* The integer argument to simplify_clause should be zero initially. It will *) +(* then attempt to simplify the first literal. If the result is true, no new *) +(* clauses are produced. Otherwise, the function proceeds to simplify the *) +(* next literal. This has to be done differently according to the changes *) +(* that took place when simplifying the first literal. *) +(* *) +(* If there was a reduction in the number of literals, this must have been *) +(* due to the literal being shown to be false, because the true case has *) +(* already been eliminated. So, there must be one less literal, and so n is *) +(* unchanged on the recursive call. If there was no change in the number of *) +(* literals, n is incremented by 1. Otherwise, not only have new literals *) +(* been introduced, but also the clause has been split into a conjunction of *) +(* clauses. simplify_clauses is called to handle this case. *) +(* *) +(* When all the literals have been processed, n will become out of range and *) +(* cause a failure. This is trapped, and the simplified clause is returned. *) +(* *) +(* When the clause has been split into a conjunction of clauses, the depth of *) +(* a clause in the tree of conjunctions indicates how many literals have been *) +(* added to that clause. simplify_clauses recursively splits conjunctions, *) +(* incrementing n as it proceeds, until it reaches a clause. It then calls *) +(* simplify_clause to deal with the clause. *) +(*----------------------------------------------------------------------------*) + +let rec simplify_clause n tm = +try (let (th,change_flag) = simplify_one_literal n tm + in let tm' = rhs (concl th) + in if (is_T tm') + then ([],apply_proof ( fun ths -> EQT_ELIM th) []) + else let (tms,proof) = + if (change_flag < 0) then simplify_clause n tm' + else if (change_flag = 0) then simplify_clause (n + 1) tm' + else simplify_clauses (n + 1) tm' + in (tms,(fun ths -> EQ_MP (SYM th) (proof ths)))) + with Failure _ -> ([tm],apply_proof hd [tm]) + +and simplify_clauses n tm = +try (let (tm1,tm2) = dest_conj tm + in let (tms1,proof1) = simplify_clauses (n + 1) tm1 + and (tms2,proof2) = simplify_clauses (n + 1) tm2 + in (tms1 @ tms2, + fun ths -> let (ths1,ths2) = chop_list (length tms1) ths + in CONJ (proof1 ths1) (proof2 ths2))) + with Failure _ -> (simplify_clause n tm);; + + +let HL_simplify_clause tm = +try ( + let rules = itlist union [rewrite_rules();flat (defs());all_accessor_thms()] [] in + let th = SIMP_CONV rules tm + in let tm' = rhs (concl th) + in let tmc = try (rand o concl o COND_ELIM_CONV) tm' with Failure _ -> tm' in + if (is_T tm') + then ([],apply_proof ( fun ths -> EQT_ELIM th ) []) + else ([tm'],apply_proof ((EQ_MP (SYM th)) o hd) [tm']) + ) + with Failure _ -> ([tm],apply_proof hd [tm]) + +(*----------------------------------------------------------------------------*) +(* simplify_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* Wrapper for simplify_clause. This function has the correct type and *) +(* properties to be used as a `heuristic'. In particular, if the result of *) +(* simplify_clause is a single clause identical to the input clause, *) +(* a failure is generated. *) +(*----------------------------------------------------------------------------*) + +let simplify_heuristic (tm,(ind:bool)) = +try (let (tms,proof) = simplify_clause 0 tm + in if (tms = [tm]) + then failwith "" + else (proof_print_string_l "-> Simplify Heuristic" () ; (map (fun tm -> (tm,ind)) tms,proof)) + ) with Failure _ -> failwith "simplify_heuristic";; + +let HL_simplify_heuristic (tm,(ind:bool)) = +try (let (tms,proof) = HL_simplify_clause tm + in if (tms = [tm]) + then failwith "" + else (proof_print_string_l "-> HL Simplify Heuristic" () ; (map (fun tm -> (tm,ind)) tms,proof)) + ) with Failure _ -> failwith "HL_simplify_heuristic";; + +(*----------------------------------------------------------------------------*) +(* NOT_EQ_F = |- !x. ~(x = x) = F *) +(*----------------------------------------------------------------------------*) + +let NOT_EQ_F = + GEN_ALL + (TRANS (AP_TERM `(~)` (SPEC_ALL REFL_CLAUSE)) + (el 1 (CONJUNCTS NOT_CLAUSES)));; + +(*----------------------------------------------------------------------------*) +(* subst_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* `Heuristic' for eliminating from a clause, a negated equality between a *) +(* variable and another term not containing the variable. For example, given *) +(* the clause: *) +(* *) +(* x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 *) +(* *) +(* the function returns the clause: *) +(* *) +(* x1 \/ F \/ x3 \/ f t \/ x5 *) +(* *) +(* So, all occurrences of x are replaced by t, and the equality x = t is *) +(* `thrown away'. The F could be eliminated, but the simplification heuristic *) +(* will deal with it, so there is no point in duplicating the code. *) +(* *) +(* The function fails if there are no equalities that can be eliminated. *) +(* *) +(* The function proves the following three theorems: *) +(* *) +(* ~(x = t) |- x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 *) +(* *) +(* x = t |- x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 = *) +(* x1 \/ F \/ x3 \/ f t \/ x5 *) +(* *) +(* |- (x = t) \/ ~(x = t) *) +(* *) +(* and returns the term "x1 \/ F \/ x3 \/ f t \/ x5" to be proved. When given *) +(* this term as a theorem, it is possible to prove from the second theorem: *) +(* *) +(* x = t |- x1 \/ ~(x = t) \/ x3 \/ f x \/ x5 *) +(* *) +(* which together with the first and third theorems yields a theorem for the *) +(* original clause. *) +(*----------------------------------------------------------------------------*) + +let subst_heuristic (tm,(ind:bool)) = +try (let checkx (v,t) = (is_var v) & (not (mem v (frees t))) + in let rec split_disjuncts tml = + if (can (check (checkx o dest_eq o dest_neg)) (hd tml)) + then ([],tml) + else (fun (l1,l2) -> ((hd tml)::l1,l2)) (split_disjuncts (tl tml)) + in let (overs,neq::unders) = split_disjuncts (disj_list tm) + in let eq = dest_neg neq + in let (v,t) = dest_eq eq + in let ass = ASSUME neq + in let th1 = itlist DISJ2 overs (try DISJ1 ass (list_mk_disj unders) with Failure _ -> ass) + and th2 = SUBS [ISPEC t NOT_EQ_F] (SUBST_CONV [(ASSUME eq,v)] tm tm) + and th3 = SPEC eq EXCLUDED_MIDDLE + in let tm' = rhs (concl th2) + in let proof th = DISJ_CASES th3 (EQ_MP (SYM th2) th) th1 + in (proof_print_string_l "-> Subst Heuristic" () ; ([(tm',ind)],apply_proof (proof o hd) [tm'])) + ) with Failure _ -> failwith "subst_heuristic";; diff --git a/Boyer_Moore/testset/arith.ml b/Boyer_Moore/testset/arith.ml new file mode 100644 index 0000000..8c2c2be --- /dev/null +++ b/Boyer_Moore/testset/arith.ml @@ -0,0 +1,121 @@ +let mytheory = ref [ +`m + 0 = m`; +`m + (SUC n) = SUC(m + n)`; +`m + n = n + m`; +`m + (n + p) = (m + n) + p`; +`(m + n) + p = m + (n + p)`; +`(m + n = 0) <=> (m = 0) /\ (n = 0)`; +`(m + n = m + p) <=> (n = p)`; +`(m + p = n + p) <=> (m = n)`; +`(m + n = m) <=> (n = 0)`; +`(m + n = n) <=> (m = 0)`; +`SUC m = m + SUC(0)`; +`m * 0 = 0`; +`m * (SUC n) = m + (m * n)`; +`(0 * n = 0) /\ (m * 0 = 0) /\ (1 * n = n) /\ (m * 1 = m) /\ ((SUC m) * n = (m * n) + n) /\ (m * (SUC n) = m + (m * n))`; +`m * n = n * m`; +`m * (n + p) = (m * n) + (m * p)`; +`(m + n) * p = (m * p) + (n * p)`; +`m * (n * p) = (m * n) * p`; +`(m * n = 0) <=> (m = 0) \/ (n = 0)`; +`(m * n = m * p) <=> (m = 0) \/ (n = p)`; +`(m * p = n * p) <=> (m = n) \/ (p = 0)`; +`SUC(SUC(0)) * n = n + n`; +`(m * n = SUC(0)) <=> (m = SUC(0)) /\ (n = SUC(0))`; +`(m EXP n = 0) <=> (m = 0) /\ ~(n = 0)`; +`m EXP (n + p) = (m EXP n) * (m EXP p)`; +`SUC(0) EXP n = SUC(0)`; +`n EXP SUC(0) = n`; +`n EXP SUC(SUC(0)) = n * n`; +`(m * n) EXP p = m EXP p * n EXP p`; +`m EXP (n * p) = (m EXP n) EXP p`; +`(SUC m <= n) <=> (m < n)`; +`(m < SUC n) <=> (m <= n)`; +`(SUC m <= SUC n) <=> (m <= n)`; +`(SUC m < SUC n) <=> (m < n)`; +`0 <= n`; +`0 < SUC n`; +`n <= n`; +`~(n < n)`; +`(m <= n /\ n <= m) <=> (m = n)`; +`~(m < n /\ n < m)`; +`~(m <= n /\ n < m)`; +`~(m < n /\ n <= m)`; +`m <= n /\ n <= p ==> m <= p`; +`m < n /\ n < p ==> m < p`; +`m <= n /\ n < p ==> m < p`; +`m < n /\ n <= p ==> m < p`; +`m <= n \/ n <= m`; +`(m < n) \/ (n < m) \/ (m = n)`; +`m <= n \/ n < m`; +`m < n \/ n <= m`; +`0 < n <=> ~(n = 0)`; +`(m <= n) <=> (m < n) \/ (m = n)`; +`(m < n) <=> (m <= n) /\ ~(m = n)`; +`~(m <= n) <=> (n < m)`; +`~(m < n) <=> n <= m`; +`m < n ==> m <= n`; +`(m = n) ==> m <= n`; +`m <= m + n`; +`n <= m + n`; +`(m < m + n) <=> (0 < n)`; +`(n < m + n) <=> (0 < m)`; +`(m + n) <= (m + p) <=> n <= p`; +`(m + p) <= (n + p) <=> (m <= n)`; +`(m + n) < (m + p) <=> n < p`; +`(m + p) < (n + p) <=> (m < n)`; +`m <= p /\ n <= q ==> m + n <= p + q`; +`m <= p /\ n < q ==> m + n < p + q`; +`m < p /\ n <= q ==> m + n < p + q`; +`m < p /\ n < q ==> m + n < p + q`; +`(0 < m * n) <=> (0 < m) /\ (0 < n)`; +`m <= n /\ p <= q ==> m * p <= n * q`; +`~(m = 0) /\ n < p ==> m * n < m * p`; +`(m * n) <= (m * p) <=> (m = 0) \/ n <= p`; +`(m * p) <= (n * p) <=> (m <= n) \/ (p = 0)`; +`(m * n) < (m * p) <=> ~(m = 0) /\ n < p`; +`(m * p) < (n * p) <=> (m < n) /\ ~(p = 0)`; +`(SUC m = SUC n) <=> (m = n)`; +`m < n /\ p < q ==> m * p < n * q`; +`n <= n * n`; +`(P m n <=> P n m) /\ (m <= n ==> P m n) ==> P m n`; +`(P m m) /\ (P m n <=> P n m) /\ (m < n ==> P m n) ==> P m y`; +`((m < n ==> P m) ==> P n) ==> P n`; +`~(EVEN n) <=> ODD n`; +`~(ODD n) <=> EVEN n`; +`EVEN n \/ ODD n`; +`~(EVEN n /\ ODD n)`; +`EVEN(m + n) <=> (EVEN m <=> EVEN n)`; +`EVEN(m * n) <=> EVEN(m) \/ EVEN(n)`; +`EVEN(m EXP n) <=> EVEN(m) /\ ~(n = 0)`; +`ODD(m + n) <=> ~(ODD m <=> ODD n)`; +`ODD(m * n) <=> ODD(m) /\ ODD(n)`; +`ODD(m EXP n) <=> ODD(m) \/ (n = 0)`; +`EVEN(SUC(SUC(0)) * n)`; +`ODD(SUC(SUC(SUC(0)) * n))`; +`(0 - m = 0) /\ (m - 0 = m)`; +`PRE(SUC m - n) = m - n`; +`SUC m - SUC n = m - n`; +`n - n = 0`; +`(m + n) - n = m`; +`(m + n) - m = n`; +`(m - n = 0) <=> m <= n`; +`m - (m + n) = 0`; +`n - (m + n) = 0`; +`n <= m ==> ((m - n) + n = m)`; +`(m + n) - (m + p) = n - p`; +`(m + p) - (n + p) = m - n`; +`m * (n - p) = m * n - m * p`; +`(m - n) * p = m * p - n * p`; +`!n. SUC n - SUC(0) = n`; +`EVEN(m - n) <=> m <= n \/ (EVEN(m) <=> EVEN(n))`; +`ODD(m - n) <=> n < m /\ ~(ODD m <=> ODD n)`; +`0 < FACT n`; +`1 <= FACT n`; +`m <= n ==> FACT m <= FACT n`; +`0 < x EXP n <=> ~(x = 0) \/ (n = 0)`; +`x EXP m < x EXP n <=> SUC(SUC(0)) <= x /\ m < n \/ (x = 0) /\ ~(m = 0) /\ (n = 0)`; +`x EXP m <= x EXP n <=> if x = 0 then (m = 0) ==> (n = 0) else (x = 1) \/ m <= n`; +`~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`; +`P(PRE n) <=> n = SUC m \/ m = 0 /\ n = 0 ==> P m` +] diff --git a/Boyer_Moore/testset/list.ml b/Boyer_Moore/testset/list.ml new file mode 100644 index 0000000..25f6105 --- /dev/null +++ b/Boyer_Moore/testset/list.ml @@ -0,0 +1,50 @@ +let mytheory2 = ref [ +`(ZIP [] [] = []) /\ (ZIP (CONS h1 t1) (CONS h2 t2) = CONS (h1,h2) (ZIP t1 t2))`; +`~(CONS h t = [])`; +`(LAST [h:A] = h) /\ (LAST (CONS h (CONS k t)) = LAST (CONS k t))`; +`APPEND (l:A list) [] = l`; +`APPEND (l:A list) (APPEND m n) = APPEND (APPEND l m) n`; +`REVERSE (APPEND (l:A list) m) = APPEND (REVERSE m) (REVERSE l)`; +`REVERSE(REVERSE (l:A list)) = l`; +`(CONS h1 t1 = CONS h2 t2) <=> (h1 = h2) /\ (t1 = t2)`; +`LENGTH(APPEND (l:A list) (m:A list)) = LENGTH l + LENGTH m`; +`MAP (f:A->B) (APPEND l1 l2) = APPEND (MAP f l1) (MAP f l2)`; +`LENGTH (MAP (f:A->B) l) = LENGTH l`; +`(LENGTH (l:A list) = 0) <=> (l = [])`; +`(LENGTH l = SUC n) /\ (l = CONS h t) ==> (LENGTH t = n)`; +`ALL (\x. f x = g x) l ==> (MAP f l = MAP g l)`; +`(MEM x l /\ P x ==> Q x) /\ ALL P l ==> ALL Q l`; +`~(EX P l) <=> ALL (\x. ~(P x)) l`; +`~(ALL P l) <=> EX (\x. ~(P x)) l`; +`ALL P (MAP f l) <=> ALL (P o f) l`; +`ALL (\x. T) l`; +`ALL2 (\x y. f x = f y) l m ==> (MAP f l = MAP f m)`; +`ALL2 P (MAP f l) l <=> ALL (\a. P (f a) a) l`; +`ALL (\x. f(x) = x) l ==> (MAP f l = l)`; +`ALL2 (\x y. P x /\ Q x y) l m <=> ALL P l /\ ALL2 Q l m`; +`ITLIST f (APPEND l1 l2) a = ITLIST f l1 (ITLIST f l2 a)`; +`ITLIST f (APPEND l [a]) b = ITLIST f l (f a b)`; +`ALL (\x. P x ==> Q x) l /\ ALL P l ==> ALL Q l`; +`ALL P l /\ ALL Q l <=> ALL (\x. P x /\ Q x) l`; +`(MEM x l /\ P x ==> Q x) /\ EX P l ==> EX Q l`; +`(MEM x l ==> P x) <=> ALL P l`; +`LENGTH(REPLICATE n x) = n`; +`EX P (MAP f l) <=> EX (P o f) l`; +`(ALL (P x) l) <=> ALL (\s. P x s) l`; +`MEM x (APPEND l1 l2) <=> MEM x l1 \/ MEM x l2`; +`FILTER P (APPEND l1 l2) = APPEND (FILTER P l1) (FILTER P l2)`; +`FILTER P (MAP f l) = MAP f (FILTER (P o f) l)`; +`MEM x (FILTER P l) <=> P x /\ MEM x l`; +`(LENGTH l1 = LENGTH l2) ==> (MAP FST (ZIP l1 l2) = l1)`; +`(LENGTH l1 = LENGTH l2) ==> (MAP SND (ZIP l1 l2) = l2)`; +`MEM (x,ASSOC x l) l <=> MEM x (MAP FST l)`; +`ALL P (APPEND l1 l2) <=> ALL P l1 /\ ALL P l2`; +`n < LENGTH l ==> MEM (EL n l) l`; +`ALL2 P (MAP f l) (MAP g m) = ALL2 (\x y. P (f x) (g y)) l m`; +`ALL2 P l m /\ ALL2 Q l m <=> ALL2 (\x y. P x y /\ Q x y) l m`; +`ALL2 P l l <=> ALL (\x. P x x) l`; +`(APPEND l m = []) <=> (l = []) /\ (m = [])`; +`(LENGTH l = LENGTH m) ==> (LENGTH(MAP2 f l m) = LENGTH m)`; +`(P x ==> Q x) ==> ALL P l ==> ALL Q l`; +`((P:A->B->bool) x y ==> Q x y) ==> ALL2 P l l' ==> ALL2 Q l l'` +] diff --git a/Boyer_Moore/waterfall.ml b/Boyer_Moore/waterfall.ml new file mode 100644 index 0000000..5a3a84d --- /dev/null +++ b/Boyer_Moore/waterfall.ml @@ -0,0 +1,660 @@ +(******************************************************************************) +(* FILE : waterfall.ml *) +(* DESCRIPTION : `Waterfall' of heuristics. Clauses pour over. *) +(* Some evaporate. Others collect in a pool to be cleaned up. *) +(* Heuristics that act on a clause send the new clauses to *) +(* the top of the waterfall. *) +(* *) +(* READS FILES : *) +(* WRITES FILES : *) +(* *) +(* AUTHOR : R.J.Boulton *) +(* DATE : 9th May 1991 *) +(* *) +(* LAST MODIFIED : R.J.Boulton *) +(* DATE : 12th August 1992 *) +(* *) +(* LAST MODIFIED : P. Papapanagiotou (University of Edinburgh) *) +(* DATE : July 2009 *) +(******************************************************************************) + +(*============================================================================*) +(* Some auxiliary functions *) +(*============================================================================*) + + +(*----------------------------------------------------------------------------*) +(* proves : thm -> term -> bool *) +(* *) +(* Returns true if and only if the theorem proves the term without making any *) +(* assumptions. *) +(*----------------------------------------------------------------------------*) + +let proves th tm = + (let (hyp,concl) = dest_thm th + in (hyp = []) & (concl = tm));; + +(*----------------------------------------------------------------------------*) +(* apply_proof : proof -> term list -> proof *) +(* *) +(* Converts a proof into a new proof that checks that the theorems it is *) +(* given have no hypotheses and have conclusions equal to the specified *) +(* terms. Used to make a proof robust. *) +(*----------------------------------------------------------------------------*) + +let apply_proof f tms ths = +try + (if (itlist (fun (tm,th) b -> (proves th tm) & b) (List.combine tms ths) true) + then (f ths) + else failwith "" + ) with Failure _ -> failwith "apply_proof";; + +(*============================================================================*) +(* The `waterfall' for heuristics *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* proof_printing : bool *) +(* *) +(* Assignable variable. If true, clauses are printed as they are `poured' *) +(* over the waterfall. *) +(*----------------------------------------------------------------------------*) + +let proof_printing = ref false;; + +(*----------------------------------------------------------------------------*) +(* proof_printer : bool -> bool *) +(* *) +(* Function for setting the flag that controls the printing of clauses as *) +(* are `poured' over the waterfall. *) +(*----------------------------------------------------------------------------*) + +let proof_printer state = + let old_state = !proof_printing + in proof_printing := state; old_state;; + +(*----------------------------------------------------------------------------*) +(* proof_print_depth : int *) +(* *) +(* Assignable variable. A number indicating the `depth' of the proof and more *) +(* practically the number of spaces printed before a term. *) +(*----------------------------------------------------------------------------*) + +let proof_print_depth = ref 0;; + +(*----------------------------------------------------------------------------*) +(* inc_print_depth : * -> * *) +(* *) +(* Identity function that has the side-effect of incrementing the *) +(* print_proof_depth. *) +(*----------------------------------------------------------------------------*) + +let inc_print_depth x = (proof_print_depth := !proof_print_depth + 1; x);; + +(*----------------------------------------------------------------------------*) +(* dec_print_depth : * -> * *) +(* *) +(* Identity function that has the side-effect of decrementing the *) +(* print_proof_depth. *) +(*----------------------------------------------------------------------------*) + +let dec_print_depth x = + if (!proof_print_depth < 1) + then (proof_print_depth := 0; x) + else (proof_print_depth := !proof_print_depth - 1; x);; + +(*----------------------------------------------------------------------------*) +(* proof_print_term : term -> term *) +(* *) +(* Identity function on terms that has the side effect of printing the term *) +(* if the `proof_printing' flag is set to true. *) +(*----------------------------------------------------------------------------*) + +let proof_print_term tm = + if !proof_printing + then (print_string (implode (replicate " " !proof_print_depth)); + print_term tm; print_newline () ; tm) + else tm;; + +let proof_print_thm thm = + if !proof_printing + then ( print_thm thm; print_newline (); print_newline());; + +let proof_print_tmi (tm,i) = + if !proof_printing + then ( proof_print_term tm; print_string " ("; print_bool i; print_string ")"; (tm,i) ) + else (tm,i);; + + +(* +let proof_print_clause cl = + if !proof_printing + then ( + match cl with + | Clause_proved thm -> (print_thm thm; print_newline (); cl) + | _ -> cl + ) + else cl;; +*) +(*----------------------------------------------------------------------------*) +(* proof_print_newline : * -> * *) +(* *) +(* Identity function that has the side effect of printing a newline if the *) +(* `proof_printing' flag is set to true. *) +(*----------------------------------------------------------------------------*) + +let proof_print_newline x = + if !proof_printing + then (print_newline (); x) + else x;; + +let proof_print_string s x = + if !proof_printing + then (print_string s; x) + else x;; + +let proof_print_string_l s x = + if !proof_printing + then (print_string s; print_newline (); x) + else x;; + +(*----------------------------------------------------------------------------*) +(* Recursive type for holding partly processed clauses. *) +(* *) +(* A clause is either still to be proved, has been proved, or can be proved *) +(* once sub-clauses have been. A clause that is still to be proved carries a *) +(* flag indicating whether or not it is an induction step. *) +(*----------------------------------------------------------------------------*) + +type clause_tree = Clause of (term * bool) + | Clause_proved of thm + | Clause_split of clause_tree list * (thm list -> thm);; + +let rec proof_print_clausetree cl = + if !proof_printing + then ( proof_print_string_l "Clause tree:" (); match cl with + | Clause (tm,bool) -> (print_term tm; print_newline ()) + | Clause_proved thm -> (print_thm thm; print_newline()) + | Clause_split (tlist,proof) -> (print_string "Split -> "; print_int (length tlist); print_newline () ; + let void = map proof_print_clausetree tlist in () ));; + +(*----------------------------------------------------------------------------*) +(* waterfall : ((term # bool) -> ((term # bool) list # proof)) list -> *) +(* (term # bool) -> *) +(* clause_tree *) +(* *) +(* `Waterfall' of heuristics. Takes a list of heuristics and a term as *) +(* arguments. Each heuristic should fail if it can do nothing with its input. *) +(* Otherwise the heuristic should return a list of new clauses to be proved *) +(* together with a proof of the original clause from these new clauses. *) +(* *) +(* Clauses that are not processed by any of the heuristics are placed in a *) +(* leaf node of the tree, to be proved later. The heuristics are attempted in *) +(* turn. If a heuristic returns an empty list of new clauses, the proof is *) +(* applied to an empty list, and the resultant theorem is placed in the tree *) +(* as a leaf node. Otherwise, the tree is split, and each of the new clauses *) +(* is passed to ALL of the heuristics. *) +(*----------------------------------------------------------------------------*) + +let nth_tail n l = if (n > length l) then [] + else let rec repeattl l i = + if ( i = 0 ) then l + else tl (repeattl l (i-1)) + in repeattl l n;; + + +let rec waterfall heuristics tmi = + bm_steps := hashI ((+) 1) !bm_steps; + let rec flow_on_down rest_of_heuristics tmi = + if (is_F (fst tmi)) then (failwith "cannot prove") + else if (rest_of_heuristics = []) then (Clause tmi) + else try ((let (tms,f) = hd rest_of_heuristics tmi + in if (tms = []) then (proof_print_string "Proven:" (); proof_print_thm (f []) ; Clause_proved (f [])) + else if ((tl tms) = []) then + (Clause_split ([waterfall heuristics (hd tms)],f)) + else Clause_split + ((dec_print_depth o + map (waterfall heuristics o proof_print_newline) o + inc_print_depth) tms, + f)) + )with Failure s -> (if (s = "cannot prove") + then failwith s + else (flow_on_down (tl rest_of_heuristics) tmi) + ) + in flow_on_down heuristics (proof_print_tmi tmi);; + + +let rec filtered_waterfall heuristics warehouse tmi = + bm_steps := hashI ((+) 1) !bm_steps; + if (max_var_depth (fst tmi) > 12) then let void = (warn true "Reached maximum depth!") in failwith "cannot prove" + else + let heurn = try (assoc (fst tmi) warehouse) with Failure _ -> 0 in + let warehouse = (if (heurn > 0) then + let void = proof_print_string ("Warehouse kicking in! Skipping " ^ string_of_int(heurn) ^ " heuristic(s)") () ; in + let void = proof_print_newline () in + (List.remove_assoc (fst tmi) warehouse) else (warehouse)) in + let rec flow_on_down rest_of_heuristics tmi it = + if (is_F (fst tmi)) then (failwith "cannot prove") + else let rest_of_heuristics = nth_tail heurn rest_of_heuristics in + if (rest_of_heuristics = []) then (Clause tmi) + else try (let (tms,f) = hd rest_of_heuristics tmi + in if (tms = []) then (proof_print_string "Proven:" (); proof_print_thm (f []) ; Clause_proved (f [])) + else if ((tl tms) = []) then Clause_split ([filtered_waterfall heuristics (((fst tmi),it)::warehouse) (hd tms)],f) + else Clause_split + ((dec_print_depth o + map (filtered_waterfall heuristics (((fst tmi),it)::warehouse) o proof_print_newline) o + inc_print_depth) tms, + f) + )with Failure s -> ( + if (s = "cannot prove") + then failwith s + else (flow_on_down (tl rest_of_heuristics) tmi (it+1)) + ) + in flow_on_down heuristics ((hashI proof_print_term) tmi) 1;; + +(* in + let fringe = fringe_of_clause_tree restree in + if (fringe = []) then restree + else ( waterfall_warehouse := ((fst tmi),it)::(!waterfall_warehouse) ; restree ) *) + + +(*----------------------------------------------------------------------------*) +(* fringe_of_clause_tree : clause_tree -> (term # bool) list *) +(* *) +(* Computes the fringe of a clause_tree, including in the resultant list only *) +(* those clauses that remain to be proved. *) +(*----------------------------------------------------------------------------*) + +let rec fringe_of_clause_tree tree = + match tree with + | (Clause tmi) -> [tmi] + | (Clause_proved _) -> [] + | (Clause_split (trees,_)) -> (flat (map fringe_of_clause_tree trees));; + +(*----------------------------------------------------------------------------*) +(* prove_clause_tree : clause_tree -> proof *) +(* *) +(* Given a clause_tree, returns a proof that if given theorems for the *) +(* unproved clauses in the tree, returns a theorem for the clause at the root *) +(* of the tree. The list of theorems must be in the same order as the clauses *) +(* appear in the fringe of the tree. *) +(*----------------------------------------------------------------------------*) + +let prove_clause_tree tree ths = +try( + let rec prove_clause_trees trees ths = + if (trees = []) then ([],ths) + else let (th,ths') = prove_clause_tree' (hd trees) ths + in let (thl,ths'') = prove_clause_trees (tl trees) ths' + in (th::thl,ths'') + and prove_clause_tree' tree ths = + match tree with + | (Clause (tm,_)) -> + (let th = hd ths + in if (proves th tm) + then (th,tl ths) + else failwith "prove_clause_tree") + | (Clause_proved th) -> (th,ths) + | (Clause_split (trees,f)) -> + (let (thl,ths') = prove_clause_trees trees ths + in (f thl,ths')) + in (let (th,[]) = (prove_clause_tree' tree ths) in th) + ) with Failure _ -> failwith "prove_clause_tree";; + +(*============================================================================*) +(* Eliminating instances in the `pool' of clauses remaining to be proved *) +(* *) +(* Constructing partial orderings is probably overkill. It may only be *) +(* necessary to split the clauses into two sets, one of most general clauses *) +(* and the rest. This would still be computationally intensive, but it would *) +(* avoid comparing two clauses that are both instances of some other clause. *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* inst_of : term -> term -> thm -> thm *) +(* *) +(* Takes two terms and computes whether the first is an instance of the *) +(* second. If this is the case, a proof of the first term from the second *) +(* (assuming they are formulae) is returned. Otherwise the function fails. *) +(*----------------------------------------------------------------------------*) + +let inst_of tm patt = +try( + (let (_,tm_bind,ty_bind) = term_match [] patt tm + in let (insts,vars) = List.split tm_bind + in let f = (SPECL insts) o (GENL vars) o (INST_TYPE ty_bind) + in fun th -> apply_proof (f o hd) [patt] [th] + )) with Failure _ -> failwith "inst_of";; + +(*----------------------------------------------------------------------------*) +(* Recursive datatype for a partial ordering of terms using the *) +(* `is an instance of' relation. *)let proof_print_thm thm = + if !proof_printing + then ( print_thm thm; print_newline (); print_newline());; + +(* *) +(* The leaf nodes of the tree are terms that have no instances. The other *) +(* nodes have a list of instance trees and proofs of each instance from the *) +(* term at that node. *) +(* *) +(* Each term carries a number along with it. This is used to keep track of *) +(* where the term came from in a list. The idea is to take the fringe of a *) +(* clause tree, number the elements, then form partial orderings so that *) +(* only the most general theorems have to be proved. *) +(*----------------------------------------------------------------------------*) + +type inst_tree = No_insts of (term * int) + | Insts of (term * int * (inst_tree * (thm -> thm)) list);; + +(*----------------------------------------------------------------------------*) +(* insert_into_inst_tree : (term # int) -> inst_tree -> inst_tree *) +(* insert_into_inst_trees : (term # int # (thm -> thm)) -> *) +(* (inst_tree # (thm -> thm)) list -> *) +(* (inst_tree # (thm -> thm)) list *) +(* *) +(* Mutually recursive functions for constructing partial orderings, ordered *) +(* by `is an instance of' relation. The algorithm is grossly inefficient. *) +(* Structures are repeatedly destroyed and rebuilt. Reference variables *) +(* should be used for efficiency. *) +(* *) +(* Inserting into a single tree: *) +(* *) +(* If tm' is an instance of tm, tm is put in the root node, with the old tree *) +(* as its single child. If tm is not an instance of tm', the function fails. *) +(* Assume now that tm is an instance of tm'. If the tree is a leaf, it is *) +(* made into a branch and tm is inserted as the one and only child. If the *) +(* tree is a branch, an attempt is made to insert tm in the list of *) +(* sub-trees. If this fails, tm is added as a leaf to the list of instances. *) +(* Note that if tm is not an instance of tm', then it cannot be an instance *) +(* of the instances of tm'. *) +(* *) +(* Inserting into a list of trees: *) +(* *) +(* The list of trees carry proofs with them. The list is split into those *) +(* whose root is an instance of tm, and those whose root is not. The proof *) +(* associated with a tree that is an instance is replaced by a proof of the *) +(* term from tm. If the list of trees that are instances is non-empty, they *) +(* are made children of a node containing tm, and this new tree is added to *) +(* the list of trees that are n't instances. If tm has instances in the list, *) +(* it cannot be the case that tm is an instance of one of the other trees in *) +(* the list, for the trees in a list must be unrelated. *) +(* *) +(* If there are no instances of tm in the list of trees, an attempt is made *) +(* to insert tm into the list. If it is unrelated to all of the trees, this *) +(* attempt fails, in which case tm is made into a leaf and added to the list. *) +(*----------------------------------------------------------------------------*) + +let rec insert_into_inst_tree (tm,n) tree = + match tree with + | (No_insts (tm',n')) -> + (try ( (let f = inst_of tm' tm + in Insts (tm,n,[No_insts (tm',n'),f])) + ) with Failure _ -> try( let f = inst_of tm tm' + in Insts (tm',n',[No_insts (tm,n),f])) with Failure _ -> failwith "insert_into_inst_tree" + ) + | (Insts (tm',n',insts)) -> + (try (let f = inst_of tm' tm + in Insts (tm,n,[Insts (tm',n',insts),f])) + with Failure _ -> try(let f = inst_of tm tm' + in try( Insts (tm',n',insert_into_inst_trees (tm,n,f) insts)) + with Failure _ -> (Insts (tm',n',(No_insts (tm,n),f)::insts)) + ) + with Failure _ -> failwith "insert_into_inst_tree" ) +and insert_into_inst_trees (tm,n,f) insts = + let rec instances (tm,n) insts = + if (insts = []) + then ([],[]) + else let (not_instl,instl) = instances (tm,n) (tl insts) + and (h,f) = hd insts + in let (tm',n') = + match h with + | (No_insts (tm',n')) -> (tm',n') + | (Insts (tm',n',_)) -> (tm',n') + in (try( (let f' = inst_of tm' tm + in (not_instl,(h,f')::instl)) + ) with Failure _ -> ((h,f)::not_instl,instl) + ) + and insert_into_inst_trees' (tm,n) trees = + if (trees = []) + then failwith "insert_into_inst_trees'" + else (try( ((insert_into_inst_tree (tm,n) (hd trees))::(tl trees)) + ) with Failure _ -> ((hd trees)::(insert_into_inst_trees' (tm,n) (tl trees))) + ) + in let (not_instl,instl) = instances (tm,n) insts + in if (instl = []) + then try( (lcombinep o (hashI (insert_into_inst_trees' (tm,n)))) (List.split insts) + ) with Failure _ -> ((No_insts (tm,n),f)::insts) + else (Insts (tm,n,instl),f)::not_instl;; + +(*----------------------------------------------------------------------------*) +(* mk_inst_trees : (term # int) list -> inst_tree list *) +(* *) +(* Constructs a partial ordering of terms under the `is an instance of' *) +(* relation from a list of numbered terms. *) +(* *) +(* A dummy proof is passed to the call of insert_into_inst_trees. The result *) +(* of the call has a proof associated with the root of each tree. These *) +(* proofs are dummies and so are discarded before the final result is *) +(* returned. *) +(*----------------------------------------------------------------------------*) + +let mk_inst_trees tmnl = + let rec mk_inst_trees' insts tmnl = + if (tmnl = []) + then insts + else let (tm,n) = hd tmnl + in mk_inst_trees' + (insert_into_inst_trees (tm,n,I) insts) (tl tmnl) + in map fst (mk_inst_trees' [] tmnl);; + +(*----------------------------------------------------------------------------*) +(* roots_of_inst_trees : inst_tree list -> term list *) +(* *) +(* Computes the terms at the roots of a list of partial orderings. *) +(*----------------------------------------------------------------------------*) + +let rec roots_of_inst_trees trees = + if (trees = []) + then [] + else let tm = + match (hd trees) with + | (No_insts (tm,_)) -> tm + | (Insts (tm,_,_)) -> tm + in tm::(roots_of_inst_trees (tl trees));; + +(*----------------------------------------------------------------------------*) +(* prove_inst_tree : inst_tree -> thm -> (thm # int) list *) +(* *) +(* Given a partial ordering of terms and a theorem for its root, returns a *) +(* list of theorems for the terms in the tree. *) +(*----------------------------------------------------------------------------*) + +let rec prove_inst_tree tree th = + match tree with + | (No_insts (tm,n)) -> + (if (proves th tm) then [(th,n)] else failwith "prove_inst_tree") + | (Insts (tm,n,insts)) -> + (if (proves th tm) + then (th,n)::(flat (map (fun (tr,f) -> prove_inst_tree tr (f th)) insts)) + else failwith "prove_inst_tree");; + +(*----------------------------------------------------------------------------*) +(* prove_inst_trees : inst_tree list -> thm list -> thm list *) +(* *) +(* Given a list of partial orderings of terms and a list of theorems for *) +(* their roots, returns a sorted list of theorems for the terms in the trees. *) +(* The sorting is done based on the integer labels attached to each term in *) +(* the trees. *) +(*----------------------------------------------------------------------------*) + +let prove_inst_trees trees ths = + try ( map fst + (sort_on_snd (flat (map (uncurry prove_inst_tree) (lcombinep (trees,ths))))) + ) with Failure _ -> failwith "prove_inst_trees";; + +(*----------------------------------------------------------------------------*) +(* prove_pool : conv -> term list -> thm list *) +(* *) +(* Attempts to prove the pool of clauses left over from the waterfall, by *) +(* applying the conversion, conv, to the most general clauses. *) +(*----------------------------------------------------------------------------*) + +let prove_pool conv tml = + let tmnl = number_list tml + in let trees = mk_inst_trees tmnl + in let most_gen_terms = roots_of_inst_trees trees + in let ths = map conv most_gen_terms + in prove_inst_trees trees ths;; + +(*============================================================================*) +(* Boyer-Moore prover *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* WATERFALL : ((term # bool) -> ((term # bool) list # proof)) list -> *) +(* ((term # bool) -> ((term # bool) list # proof)) -> *) +(* (term # bool) -> *) +(* thm *) +(* *) +(* Boyer-Moore style automatic proof procedure. Takes a list of heuristics, *) +(* and a single heuristic that does induction, as arguments. The result is a *) +(* function that, given a term and a Boolean, attempts to prove the term. The *) +(* Boolean is used to indicate whether the term is the step of an induction. *) +(* It will normally be set to false for an external call. *) +(*----------------------------------------------------------------------------*) + +let rec WATERFALL heuristics induction (tm,(ind:bool)) = + let conv tm = + proof_print_string "Doing induction on:" () ; bm_steps := hash ((+) 1) ((+) 1) !bm_steps ; + let void = proof_print_term tm ; proof_print_newline () + in let (tmil,proof) = induction (tm,false) + in dec_print_depth + (proof + (map (WATERFALL heuristics induction) (inc_print_depth tmil))) + in let void = proof_print_newline () + in let tree = waterfall heuristics (tm,ind) + in let tmil = fringe_of_clause_tree tree + in let thl = prove_pool conv (map fst tmil) + in prove_clause_tree tree thl;; + + +let rec FILTERED_WATERFALL heuristics induction warehouse (tm,(ind:bool)) = + let conv tm = +(* let constr_check = ind && not((find_bm_terms (fun t -> count_constructors t > 5) tm) = []) in *) + let constr_check = (max_var_depth tm > 12) in + if (constr_check) then let void = (warn true "Reached maximum depth!") in failwith "cannot prove" + else + let heurn = try (assoc tm warehouse) with Failure _ -> 0 in + let warehouse = (if (heurn > 0) then (List.remove_assoc tm warehouse) else (warehouse)) in + if (heurn > length heuristics) then ( warn true "Induction loop detected."; failwith "cannot prove" ) + else + proof_print_string "Doing induction on:" (); bm_steps := hash ((+) 1) ((+) 1) !bm_steps ; + let void = proof_print_term tm ; proof_print_newline () in + let (tmil,proof) = induction (tm,false) + in dec_print_depth + (proof + (map (FILTERED_WATERFALL heuristics induction ((tm,(length heuristics) + 1)::warehouse)) (inc_print_depth tmil))) + in let void = proof_print_newline () + in let tree = filtered_waterfall heuristics [] (tm,ind) +(* in let void = proof_print_clausetree tree *) + in let tmil = fringe_of_clause_tree tree + in let thl = prove_pool conv (map fst tmil) + in prove_clause_tree tree thl;; + +(*============================================================================*) +(* Some sample heuristics *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* conjuncts_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* `Heuristic' for splitting a conjunction into a list of conjuncts. *) +(* Right conjuncts are split recursively. *) +(* Fails if the argument term is not a conjunction. *) +(*----------------------------------------------------------------------------*) + +let conjuncts_heuristic (tm,(i:bool)) = + let tms = conj_list tm + in if (length tms = 1) + then failwith "conjuncts_heuristic" + else (map (fun tm -> (tm,i)) tms,apply_proof LIST_CONJ tms);; + +(*----------------------------------------------------------------------------*) +(* refl_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* `Heuristic' for proving that terms of the form "x = x" are true. Fails if *) +(* the argument term is not of this form. Otherwise it returns an empty list *) +(* of new clauses, and a proof of the original term. *) +(*----------------------------------------------------------------------------*) + +let refl_heuristic (tm,(i:bool)) = + try(if (lhs tm = rhs tm) + then (([]:(term * bool) list),apply_proof (fun ths -> REFL (lhs tm)) []) + else failwith "" + ) with Failure _ -> failwith "refl_heuristic";; + +(*----------------------------------------------------------------------------*) +(* clausal_form_heuristic : (term # bool) -> ((term # bool) list # proof) *) +(* *) +(* `Heuristic' that tests a term to see if it is in clausal form, and if not *) +(* converts it to clausal form and returns the resulting clauses as new *) +(* `goals'. It is critical for efficiency that the normalization is only done *) +(* if the term is not in clausal form. Note that the functions `conjuncts' *) +(* and `disjuncts' are not used for the testing because they split trees of *) +(* conjuncts (disjuncts) rather than simply `linear' con(dis)junctions. *) +(* If the term is in clausal form, but is not a single clause, it is split *) +(* into single clauses. If the term is in clausal form but contains Boolean *) +(* constants, the normalizer is applied to it. A single new goal will be *) +(* produced in this case unless the result of the normalization was true. *) +(*----------------------------------------------------------------------------*) + +let clausal_form_heuristic (tm,(i:bool)) = +try (let is_atom tm = + (not (has_boolean_args_and_result tm)) or (is_var tm) or (is_const tm) + in let is_literal tm = + (is_atom tm) or ((is_neg tm) & (try (is_atom (rand tm)) with Failure _ -> false)) + in let is_clause tm = forall is_literal (disj_list tm) + in let result_string = fun tms -> let s = length tms + in let plural = if (s=1) then "" else "s" + in ("-> Clausal Form Heuristic (" ^ string_of_int(s) ^ " clause" ^ plural ^ ")") + in if (forall is_clause (conj_list tm)) & + (not (free_in `T` tm)) & (not (free_in `F` tm)) + then if (is_conj tm) + then let tms = conj_list tm + in (proof_print_string_l (result_string tms) () ; + (map (fun tm -> (tm,i)) tms,apply_proof LIST_CONJ tms)) + else failwith "" + else let th = CLAUSAL_FORM_CONV tm + in let tm' = rhs (concl th) + in if (is_T tm') + then (proof_print_string_l "-> Clausal Form Heuristic" () ; ([],apply_proof (fun _ -> EQT_ELIM th) [])) + else let tms = conj_list tm' + in (proof_print_string_l (result_string tms) () ; + (map (fun tm -> (tm,i)) tms, + apply_proof ((EQ_MP (SYM th)) o LIST_CONJ) tms)) + ) with Failure _ -> failwith "clausal_form_heuristic";; + +let meson_heuristic (tm,(i:bool)) = + try( let meth = MESON (rewrite_rules()) tm in + (([]:(term * bool) list),apply_proof (fun ths -> meth) []) + ) with Failure _ -> failwith "meson_heuristic";; + +let taut_heuristic (tm,(i:bool)) = + try( let tautthm = TAUT tm in (proof_print_string_l "-> Tautology Heuristic" () ; + (([]:(term * bool) list),apply_proof (fun ths -> tautthm) [])) + ) with Failure _ -> failwith "taut_heuristic";; + +let setify_heuristic (tm,(i:bool)) = +try ( + if (not (is_disj tm)) then failwith "" + else + let tms = disj_list tm + in let tms' = setify tms + in let tm' = list_mk_disj tms' + in if ((length tms) = (length tms')) then failwith "" + else let th = TAUT (mk_imp (tm',tm)) + in (proof_print_string_l "-> Setify Heuristic" () ; + ([tm',i],apply_proof ((MP th) o hd) [tm'])) + ) + with Failure _ -> failwith "setify_heuristic";; + diff --git a/Complex/complex_grobner.ml b/Complex/complex_grobner.ml new file mode 100644 index 0000000..30d8b17 --- /dev/null +++ b/Complex/complex_grobner.ml @@ -0,0 +1,501 @@ +(* ========================================================================= *) +(* Grobner basis algorithm. *) +(* ========================================================================= *) + +needs "Complex/complexnumbers.ml";; +needs "Complex/quelim.ml";; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* Utility functions. *) +(* ------------------------------------------------------------------------- *) + +let allpairs f l1 l2 = + itlist ((@) o C map l2 o f) l1 [];; + +let rec merge ord l1 l2 = + match l1 with + [] -> l2 + | h1::t1 -> match l2 with + [] -> l1 + | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2) + else h2::(merge ord l1 t2);; + +let sort ord = + let rec mergepairs l1 l2 = + match (l1,l2) with + ([s],[]) -> s + | (l,[]) -> mergepairs [] l + | (l,[s1]) -> mergepairs (s1::l) [] + | (l,(s1::s2::ss)) -> mergepairs ((merge ord s1 s2)::l) ss in + fun l -> if l = [] then [] else mergepairs [] (map (fun x -> [x]) l);; + +(* ------------------------------------------------------------------------- *) +(* Type for recording history, i.e. how a polynomial was obtained. *) +(* ------------------------------------------------------------------------- *) + +type history = + Start of int + | Mmul of (num * (int list)) * history + | Add of history * history;; + +(* ------------------------------------------------------------------------- *) +(* Conversion of leaves, i.e. variables and constant rational constants. *) +(* ------------------------------------------------------------------------- *) + +let grob_var vars tm = + let res = map (fun i -> if i = tm then 1 else 0) vars in + if exists (fun x -> x <> 0) res then [Int 1,res] else failwith "grob_var";; + +let grob_const = + let cx_tm = `Cx` in + fun vars tm -> + try let l,r = dest_comb tm in + if l = cx_tm then + let x = rat_of_term r in + if x =/ Int 0 then [] else [x,map (fun v -> 0) vars] + else failwith "" + with Failure _ -> failwith "grob_const";; + +(* ------------------------------------------------------------------------- *) +(* Monomial ordering. *) +(* ------------------------------------------------------------------------- *) + +let morder_lt = + let rec lexorder l1 l2 = + match (l1,l2) with + [],[] -> false + | (x1::o1,x2::o2) -> x1 > x2 or x1 = x2 & lexorder o1 o2 + | _ -> failwith "morder: inconsistent monomial lengths" in + fun m1 m2 -> let n1 = itlist (+) m1 0 + and n2 = itlist (+) m2 0 in + n1 < n2 or n1 = n2 & lexorder m1 m2;; + +let morder_le m1 m2 = morder_lt m1 m2 or (m1 = m2);; + +let morder_gt m1 m2 = morder_lt m2 m1;; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic on canonical polynomials. *) +(* ------------------------------------------------------------------------- *) + +let grob_neg = map (fun (c,m) -> (minus_num c,m));; + +let rec grob_add l1 l2 = + match (l1,l2) with + ([],l2) -> l2 + | (l1,[]) -> l1 + | ((c1,m1)::o1,(c2,m2)::o2) -> + if m1 = m2 then + let c = c1+/c2 and rest = grob_add o1 o2 in + if c =/ Int 0 then rest else (c,m1)::rest + else if morder_lt m2 m1 then (c1,m1)::(grob_add o1 l2) + else (c2,m2)::(grob_add l1 o2);; + +let grob_sub l1 l2 = grob_add l1 (grob_neg l2);; + +let grob_mmul (c1,m1) (c2,m2) = (c1*/c2,map2 (+) m1 m2);; + +let rec grob_cmul cm pol = map (grob_mmul cm) pol;; + +let rec grob_mul l1 l2 = + match l1 with + [] -> [] + | (h1::t1) -> grob_add (grob_cmul h1 l2) (grob_mul t1 l2);; + +let rec grob_pow vars l n = + if n < 0 then failwith "grob_pow: negative power" + else if n = 0 then [Int 1,map (fun v -> 0) vars] + else grob_mul l (grob_pow vars l (n - 1));; + +(* ------------------------------------------------------------------------- *) +(* Monomial division operation. *) +(* ------------------------------------------------------------------------- *) + +let mdiv (c1,m1) (c2,m2) = + (c1//c2, + map2 (fun n1 n2 -> if n1 < n2 then failwith "mdiv" else n1-n2) m1 m2);; + +(* ------------------------------------------------------------------------- *) +(* Lowest common multiple of two monomials. *) +(* ------------------------------------------------------------------------- *) + +let mlcm (c1,m1) (c2,m2) = (Int 1,map2 max m1 m2);; + +(* ------------------------------------------------------------------------- *) +(* Reduce monomial cm by polynomial pol, returning replacement for cm. *) +(* ------------------------------------------------------------------------- *) + +let reduce1 cm (pol,hpol) = + match pol with + [] -> failwith "reduce1" + | cm1::cms -> try let (c,m) = mdiv cm cm1 in + (grob_cmul (minus_num c,m) cms, + Mmul((minus_num c,m),hpol)) + with Failure _ -> failwith "reduce1";; + +(* ------------------------------------------------------------------------- *) +(* Try this for all polynomials in a basis. *) +(* ------------------------------------------------------------------------- *) + +let reduceb cm basis = tryfind (fun p -> reduce1 cm p) basis;; + +(* ------------------------------------------------------------------------- *) +(* Reduction of a polynomial (always picking largest monomial possible). *) +(* ------------------------------------------------------------------------- *) + +let rec reduce basis (pol,hist) = + match pol with + [] -> (pol,hist) + | cm::ptl -> try let q,hnew = reduceb cm basis in + reduce basis (grob_add q ptl,Add(hnew,hist)) + with Failure _ -> + let q,hist' = reduce basis (ptl,hist) in + cm::q,hist';; + +(* ------------------------------------------------------------------------- *) +(* Check for orthogonality w.r.t. LCM. *) +(* ------------------------------------------------------------------------- *) + +let orthogonal l p1 p2 = + snd l = snd(grob_mmul (hd p1) (hd p2));; + +(* ------------------------------------------------------------------------- *) +(* Compute S-polynomial of two polynomials. *) +(* ------------------------------------------------------------------------- *) + +let spoly cm ph1 ph2 = + match (ph1,ph2) with + ([],h),p -> ([],h) + | p,([],h) -> ([],h) + | (cm1::ptl1,his1),(cm2::ptl2,his2) -> + (grob_sub (grob_cmul (mdiv cm cm1) ptl1) + (grob_cmul (mdiv cm cm2) ptl2), + Add(Mmul(mdiv cm cm1,his1), + Mmul(mdiv (minus_num(fst cm),snd cm) cm2,his2)));; + +(* ------------------------------------------------------------------------- *) +(* Make a polynomial monic. *) +(* ------------------------------------------------------------------------- *) + +let monic (pol,hist) = + if pol = [] then (pol,hist) else + let c',m' = hd pol in + (map (fun (c,m) -> (c//c',m)) pol, + Mmul((Int 1 // c',map (K 0) m'),hist));; + +(* ------------------------------------------------------------------------- *) +(* The most popular heuristic is to order critical pairs by LCM monomial. *) +(* ------------------------------------------------------------------------- *) + +let forder ((c1,m1),_) ((c2,m2),_) = morder_lt m1 m2;; + +(* ------------------------------------------------------------------------- *) +(* Stupid stuff forced on us by lack of equality test on num type. *) +(* ------------------------------------------------------------------------- *) + +let rec poly_lt p q = + match (p,q) with + p,[] -> false + | [],q -> true + | (c1,m1)::o1,(c2,m2)::o2 -> + c1 c1 =/ c2 & m1 = m2) p1 p2;; + +let memx ((p1,h1),(p2,h2)) ppairs = + not (exists (fun ((q1,_),(q2,_)) -> poly_eq p1 q1 & poly_eq p2 q2) ppairs);; + +(* ------------------------------------------------------------------------- *) +(* Buchberger's second criterion. *) +(* ------------------------------------------------------------------------- *) + +let criterion2 basis (lcm,((p1,h1),(p2,h2))) opairs = + exists (fun g -> not(poly_eq (fst g) p1) & not(poly_eq (fst g) p2) & + can (mdiv lcm) (hd(fst g)) & + not(memx (align(g,(p1,h1))) (map snd opairs)) & + not(memx (align(g,(p2,h2))) (map snd opairs))) basis;; + +(* ------------------------------------------------------------------------- *) +(* Test for hitting constant polynomial. *) +(* ------------------------------------------------------------------------- *) + +let constant_poly p = + length p = 1 & forall ((=) 0) (snd(hd p));; + +(* ------------------------------------------------------------------------- *) +(* Grobner basis algorithm. *) +(* ------------------------------------------------------------------------- *) + +let rec grobner histories basis pairs = + print_string(string_of_int(length basis)^" basis elements and "^ + string_of_int(length pairs)^" critical pairs"); + print_newline(); + match pairs with + [] -> rev histories,basis + | (l,(p1,p2))::opairs -> + let (sp,hist) = monic (reduce basis (spoly l p1 p2)) in + if sp = [] or criterion2 basis (l,(p1,p2)) opairs + then grobner histories basis opairs else + let sph = sp,Start(length histories) in + if constant_poly sp + then grobner ((sp,hist)::histories) (sph::basis) [] else + let rawcps = + map (fun p -> mlcm (hd(fst p)) (hd sp),align(p,sph)) basis in + let newcps = filter + (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) rawcps in + grobner ((sp,hist)::histories) (sph::basis) + (merge forder opairs (sort forder newcps));; + +(* ------------------------------------------------------------------------- *) +(* Overall function. *) +(* ------------------------------------------------------------------------- *) + +let groebner pols = + let npols = map2 (fun p n -> p,Start n) pols (0--(length pols - 1)) in + let phists = filter (fun (p,_) -> p <> []) npols in + let bas0 = map monic phists in + let bas = map2 (fun (p,h) n -> p,Start n) bas0 + ((length bas0)--(2 * length bas0 - 1)) in + let prs0 = allpairs (fun x y -> x,y) bas bas in + let prs1 = filter (fun ((x,_),(y,_)) -> poly_lt x y) prs0 in + let prs2 = map (fun (p,q) -> mlcm (hd(fst p)) (hd(fst q)),(p,q)) prs1 in + let prs3 = filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) prs2 in + grobner (rev bas0 @ rev phists) bas (mergesort forder prs3);; + +(* ------------------------------------------------------------------------- *) +(* Alternative orthography. *) +(* ------------------------------------------------------------------------- *) + +let gr'o'bner = groebner;; + +(* ------------------------------------------------------------------------- *) +(* Conversion from HOL term. *) +(* ------------------------------------------------------------------------- *) + +let grobify_term = + let neg_tm = `(--):complex->complex` + and add_tm = `(+):complex->complex->complex` + and sub_tm = `(-):complex->complex->complex` + and mul_tm = `(*):complex->complex->complex` + and pow_tm = `(pow):complex->num->complex` in + let rec grobify_term vars tm = + try grob_var vars tm with Failure _ -> + try grob_const vars tm with Failure _ -> + let lop,r = dest_comb tm in + if lop = neg_tm then grob_neg(grobify_term vars r) else + let op,l = dest_comb lop in + if op = pow_tm then + grob_pow vars (grobify_term vars l) (dest_small_numeral r) + else + (if op = add_tm then grob_add else if op = sub_tm then grob_sub + else if op = mul_tm then grob_mul else failwith "unknown term") + (grobify_term vars l) (grobify_term vars r) in + fun vars tm -> + try grobify_term vars tm with Failure _ -> failwith "grobify_term";; + +let grobvars = + let neg_tm = `(--):complex->complex` + and add_tm = `(+):complex->complex->complex` + and sub_tm = `(-):complex->complex->complex` + and mul_tm = `(*):complex->complex->complex` + and pow_tm = `(pow):complex->num->complex` in + let rec grobvars tm acc = + if is_complex_const tm then acc + else if not (is_comb tm) then tm::acc else + let lop,r = dest_comb tm in + if lop = neg_tm then grobvars r acc + else if not (is_comb lop) then tm::acc else + let op,l = dest_comb lop in + if op = pow_tm then grobvars l acc + else if op = mul_tm or op = sub_tm or op = add_tm + then grobvars l (grobvars r acc) + else tm::acc in + fun tm -> setify(grobvars tm []);; + +let grobify_equations = + let zero_tm = `Cx(&0)` + and sub_tm = `(-):complex->complex->complex` + and complex_ty = `:complex` in + let grobify_equation vars tm = + let l,r = dest_eq tm in + if r <> zero_tm then grobify_term vars (mk_comb(mk_comb(sub_tm,l),r)) + else grobify_term vars l in + fun tm -> + let cjs = conjuncts tm in + let rawvars = itlist + (fun eq acc -> let l,r = dest_eq eq in + union (union (grobvars l) (grobvars r)) acc) cjs [] in + let vars = sort (fun x y -> x < y) rawvars in + vars,map(grobify_equation vars) cjs;; + +(* ------------------------------------------------------------------------- *) +(* Printer. *) +(* ------------------------------------------------------------------------- *) + +let string_of_monomial vars (c,m) = + let xns = filter (fun (x,y) -> y <> 0) (map2 (fun x y -> x,y) vars m) in + let xnstrs = map + (fun (x,n) -> x^(if n = 1 then "" else "^"^(string_of_int n))) xns in + if xns = [] then Num.string_of_num c else + let basstr = if c =/ Int 1 then "" else (Num.string_of_num c)^" * " in + basstr ^ end_itlist (fun s t -> s^" * "^t) xnstrs;; + +let string_of_polynomial vars l = + if l = [] then "0" else + end_itlist (fun s t -> s^" + "^t) (map (string_of_monomial vars) l);; + +(* ------------------------------------------------------------------------- *) +(* Resolve a proof. *) +(* ------------------------------------------------------------------------- *) + +let rec resolve_proof vars prf = + match prf with + Start n -> + [n,[Int 1,map (K 0) vars]] + | Mmul(pol,lin) -> + let lis = resolve_proof vars lin in + map (fun (n,p) -> n,grob_cmul pol p) lis + | Add(lin1,lin2) -> + let lis1 = resolve_proof vars lin1 + and lis2 = resolve_proof vars lin2 in + let dom = setify(union (map fst lis1) (map fst lis2)) in + map (fun n -> let a = try assoc n lis1 with Failure _ -> [] + and b = try assoc n lis2 with Failure _ -> [] in + n,grob_add a b) dom;; + +(* ------------------------------------------------------------------------- *) +(* Convert a polynomial back to HOL. *) +(* ------------------------------------------------------------------------- *) + +let holify_polynomial = + let complex_ty = `:complex` + and pow_tm = `(pow):complex->num->complex` + and mk_mul = mk_binop `(*):complex->complex->complex` + and mk_add = mk_binop `(+):complex->complex->complex` + and zero_tm = `Cx(&0)` + and add_tm = `(+):complex->complex->complex` + and mul_tm = `(*):complex->complex->complex` + and complex_term_of_rat = curry mk_comb `Cx` o term_of_rat in + let holify_varpow (v,n) = + if n = 1 then v + else list_mk_comb(pow_tm,[v;mk_small_numeral n]) in + let holify_monomial vars (c,m) = + let xps = map holify_varpow (filter (fun (_,n) -> n <> 0) (zip vars m)) in + end_itlist mk_mul (complex_term_of_rat c :: xps) in + let holify_polynomial vars p = + if p = [] then zero_tm + else end_itlist mk_add (map (holify_monomial vars) p) in + holify_polynomial;; + +(* ------------------------------------------------------------------------- *) +(* Recursively find the set of basis elements involved. *) +(* ------------------------------------------------------------------------- *) + +let dependencies = + let rec dependencies prf acc = + match prf with + Start n -> n::acc + | Mmul(pol,lin) -> dependencies lin acc + | Add(lin1,lin2) -> dependencies lin1 (dependencies lin2 acc) in + fun prf -> setify(dependencies prf []);; + +let rec involved deps sofar todo = + match todo with + [] -> sort (<) sofar + | (h::hs) -> + if mem h sofar then involved deps sofar hs + else involved deps (h::sofar) (el h deps @ hs);; + +(* ------------------------------------------------------------------------- *) +(* Refute a conjunction of equations in HOL. *) +(* ------------------------------------------------------------------------- *) + +let GROBNER_REFUTE = + let add_tm = `(+):complex->complex->complex` + and mul_tm = `(*):complex->complex->complex` in + let APPLY_pth = MATCH_MP(SIMPLE_COMPLEX_ARITH + `(x = y) ==> (x + Cx(--(&1)) * (y + Cx(&1)) = Cx(&0)) ==> F`) + and MK_ADD th1 th2 = MK_COMB(AP_TERM add_tm th1,th2) in + let rec holify_lincombs vars cjs prfs = + match prfs with + [] -> cjs + | (p::ps) -> + if p = [] then holify_lincombs vars (cjs @ [TRUTH]) ps else + let holis = map (fun (n,q) -> n,holify_polynomial vars q) p in + let ths = + map (fun (n,m) -> AP_TERM (mk_comb(mul_tm,m)) (el n cjs)) holis in + let th = CONV_RULE(BINOP_CONV COMPLEX_POLY_CONV) + (end_itlist MK_ADD ths) in + holify_lincombs vars (cjs @ [th]) ps in + fun tm -> + let vars,pols = grobify_equations tm in + let (prfs,gb) = groebner pols in + let (_,prf) = + find (fun (p,h) -> length p = 1 & forall ((=)0) (snd(hd p))) gb in + let deps = map (dependencies o snd) prfs + and depl = dependencies prf in + let need = involved deps [] depl in + let pprfs = + map2 (fun p n -> if mem n need then resolve_proof vars (snd p) else []) + prfs (0--(length prfs - 1)) + and ppr = resolve_proof vars prf in + let ths = CONJUNCTS(ASSUME tm) in + let th = last + (holify_lincombs vars ths (snd(chop_list(length ths) (pprfs @ [ppr])))) in + CONV_RULE COMPLEX_RAT_EQ_CONV th;; + +(* ------------------------------------------------------------------------- *) +(* Overall conversion. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_ARITH = + let pth0 = SIMPLE_COMPLEX_ARITH `(x = y) <=> (x - y = Cx(&0))` + and pth1 = prove + (`!x. ~(x = Cx(&0)) <=> ?z. z * x + Cx(&1) = Cx(&0)`, + CONV_TAC(time FULL_COMPLEX_QUELIM_CONV)) + and pth2a = prove + (`!x y u v. ~(x = y) \/ ~(u = v) <=> + ?w z. w * (x - y) + z * (u - v) + Cx(&1) = Cx(&0)`, + CONV_TAC(time FULL_COMPLEX_QUELIM_CONV)) + and pth2b = prove + (`!x y. ~(x = y) <=> ?z. z * (x - y) + Cx(&1) = Cx(&0)`, + CONV_TAC(time FULL_COMPLEX_QUELIM_CONV)) + and pth3 = TAUT `(p ==> F) ==> (~q <=> p) ==> q` in + let GEN_PRENEX_CONV = + GEN_REWRITE_CONV REDEPTH_CONV + [AND_FORALL_THM; + LEFT_AND_FORALL_THM; + RIGHT_AND_FORALL_THM; + LEFT_OR_FORALL_THM; + RIGHT_OR_FORALL_THM; + OR_EXISTS_THM; + LEFT_OR_EXISTS_THM; + RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM] in + let INITIAL_CONV = + NNF_CONV THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth1] THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth2a] THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth2b] THENC + ONCE_DEPTH_CONV(GEN_REWRITE_CONV I [pth0] o + check ((<>) `Cx(&0)` o rand)) THENC + GEN_PRENEX_CONV THENC + DNF_CONV in + fun tm -> + let avs = frees tm in + let tm' = list_mk_forall(avs,tm) in + let th1 = INITIAL_CONV(mk_neg tm') in + let evs,bod = strip_exists(rand(concl th1)) in + if is_forall bod then failwith "COMPLEX_ARITH: non-universal formula" else + let djs = disjuncts bod in + let th2 = end_itlist SIMPLE_DISJ_CASES(map GROBNER_REFUTE djs) in + let th3 = itlist SIMPLE_CHOOSE evs th2 in + SPECL avs (MATCH_MP (MATCH_MP pth3 (DISCH_ALL th3)) th1);; diff --git a/Complex/complex_real.ml b/Complex/complex_real.ml new file mode 100644 index 0000000..8098b25 --- /dev/null +++ b/Complex/complex_real.ml @@ -0,0 +1,9 @@ +(* ========================================================================= *) +(* Trivial restriction of complex Groebner bases to reals. *) +(* ========================================================================= *) + +let GROBNER_REAL_ARITH = + let trans_conv = GEN_REWRITE_CONV TOP_SWEEP_CONV + [GSYM CX_INJ; CX_POW; CX_MUL; CX_ADD; CX_NEG; CX_SUB] in + fun tm -> let th = trans_conv tm in + EQ_MP (SYM th) (COMPLEX_ARITH(rand(concl th)));; diff --git a/Complex/complex_transc.ml b/Complex/complex_transc.ml new file mode 100644 index 0000000..71dc894 --- /dev/null +++ b/Complex/complex_transc.ml @@ -0,0 +1,321 @@ +(* ========================================================================= *) +(* Complex transcendental functions. *) +(* ========================================================================= *) + +needs "Library/transc.ml";; +needs "Library/floor.ml";; +needs "Complex/complexnumbers.ml";; + +unparse_as_infix "exp";; +remove_interface "exp";; + +(* ------------------------------------------------------------------------- *) +(* Complex square roots. *) +(* ------------------------------------------------------------------------- *) + +let csqrt = new_definition + `csqrt(z) = if Im(z) = &0 then + if &0 <= Re(z) then complex(sqrt(Re(z)),&0) + else complex(&0,sqrt(--Re(z))) + else complex(sqrt((norm(z) + Re(z)) / &2), + (Im(z) / abs(Im(z))) * + sqrt((norm(z) - Re(z)) / &2))`;; + +let COMPLEX_NORM_GE_RE_IM = prove + (`!z. abs(Re(z)) <= norm(z) /\ abs(Im(z)) <= norm(z)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN + REWRITE_TAC[complex_norm] THEN + CONJ_TAC THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_ADDL; REAL_POW_2; REAL_LE_SQUARE]);; + +let CSQRT = prove + (`!z. csqrt(z) pow 2 = z`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_POW_2; csqrt] THEN COND_CASES_TAC THENL + [COND_CASES_TAC THEN + ASM_REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_RZERO; REAL_MUL_LZERO; + REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_ADD_LID; COMPLEX_EQ] THEN + REWRITE_TAC[REAL_NEG_EQ; GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`]; + ALL_TAC] THEN + REWRITE_TAC[complex_mul; RE; IM] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(s * s - (i * s') * (i * s') = s * s - (i * i) * (s' * s')) /\ + (s * i * s' + (i * s')* s = &2 * i * s * s')`] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + SUBGOAL_THEN `&0 <= norm(z) + Re(z) /\ &0 <= norm(z) - Re(z)` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; GSYM SQRT_MUL; SQRT_POW_2] THEN + REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW2_ABS; + REAL_POW_EQ_0; REAL_DIV_REFL] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `(m + r) - (m - r) = r * &2`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * a' * b = (a * a') * (b * b:real)`] THEN + REWRITE_TAC[REAL_DIFFSQ] THEN + REWRITE_TAC[complex_norm; GSYM REAL_POW_2] THEN + SIMP_TAC[SQRT_POW_2; REAL_LE_ADD; + REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_POW_MUL] THEN + REWRITE_TAC[POW_2_SQRT_ABS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `&2 * (i * a') * a * h = i * (&2 * h) * a * a'`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LID; GSYM real_div] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ABS_ZERO; REAL_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Complex exponential. *) +(* ------------------------------------------------------------------------- *) + +let cexp = new_definition + `cexp z = Cx(exp(Re z)) * complex(cos(Im z),sin(Im z))`;; + +let CX_CEXP = prove + (`!x. Cx(exp x) = cexp(Cx x)`, + REWRITE_TAC[cexp; CX_DEF; RE; IM; SIN_0; COS_0] THEN + REWRITE_TAC[GSYM CX_DEF; GSYM CX_MUL; REAL_MUL_RID]);; + +let CEXP_0 = prove + (`cexp(Cx(&0)) = Cx(&1)`, + REWRITE_TAC[GSYM CX_CEXP; REAL_EXP_0]);; + +let CEXP_ADD = prove + (`!w z. cexp(w + z) = cexp(w) * cexp(z)`, + REWRITE_TAC[COMPLEX_EQ; cexp; complex_mul; complex_add; RE; IM; CX_DEF] THEN + REWRITE_TAC[REAL_EXP_ADD; SIN_ADD; COS_ADD] THEN CONV_TAC REAL_RING);; + +let CEXP_MUL = prove + (`!n z. cexp(Cx(&n) * z) = cexp(z) pow n`, + INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; CEXP_0] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; COMPLEX_ADD_RDISTRIB; CX_ADD] THEN + ASM_REWRITE_TAC[CEXP_ADD; COMPLEX_MUL_LID] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +let CEXP_NONZERO = prove + (`!z. ~(cexp z = Cx(&0))`, + GEN_TAC THEN REWRITE_TAC[cexp; COMPLEX_ENTIRE; CX_INJ; REAL_EXP_NZ] THEN + REWRITE_TAC[CX_DEF; RE; IM; COMPLEX_EQ] THEN + MP_TAC(SPEC `Im z` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +let CEXP_NEG_LMUL = prove + (`!z. cexp(--z) * cexp(z) = Cx(&1)`, + REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_ADD_LINV; CEXP_0]);; + +let CEXP_NEG_RMUL = prove + (`!z. cexp(z) * cexp(--z) = Cx(&1)`, + REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_ADD_RINV; CEXP_0]);; + +let CEXP_NEG = prove + (`!z. cexp(--z) = inv(cexp z)`, + MESON_TAC[CEXP_NEG_LMUL; COMPLEX_MUL_LINV_UNIQ]);; + +let CEXP_SUB = prove + (`!w z. cexp(w - z) = cexp(w) / cexp(z)`, + REWRITE_TAC[complex_sub; complex_div; CEXP_NEG; CEXP_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* Complex trig functions. *) +(* ------------------------------------------------------------------------- *) + +let ccos = new_definition + `ccos z = (cexp(ii * z) + cexp(--ii * z)) / Cx(&2)`;; + +let csin = new_definition + `csin z = (cexp(ii * z) - cexp(--ii * z)) / (Cx(&2) * ii)`;; + +let CX_CSIN,CX_CCOS = (CONJ_PAIR o prove) + (`(!x. Cx(sin x) = csin(Cx x)) /\ (!x. Cx(cos x) = ccos(Cx x))`, + REWRITE_TAC[csin; ccos; cexp; CX_DEF; ii; RE; IM; complex_mul; complex_add; + REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_SUB_RZERO; + REAL_MUL_LID; complex_neg; REAL_EXP_0; REAL_ADD_LID; + REAL_MUL_LNEG; REAL_NEG_0; REAL_ADD_RID; complex_sub; + SIN_NEG; COS_NEG; GSYM REAL_MUL_2; GSYM real_sub; + complex_div; REAL_SUB_REFL; complex_inv; REAL_SUB_RNEG] THEN + CONJ_TAC THEN GEN_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC REAL_RING);; + +let CSIN_0 = prove + (`csin(Cx(&0)) = Cx(&0)`, + REWRITE_TAC[GSYM CX_CSIN; SIN_0]);; + +let CCOS_0 = prove + (`ccos(Cx(&0)) = Cx(&1)`, + REWRITE_TAC[GSYM CX_CCOS; COS_0]);; + +let CSIN_CIRCLE = prove + (`!z. csin(z) pow 2 + ccos(z) pow 2 = Cx(&1)`, + GEN_TAC THEN REWRITE_TAC[csin; ccos] THEN + MP_TAC(SPEC `ii * z` CEXP_NEG_LMUL) THEN + MP_TAC COMPLEX_POW_II_2 THEN REWRITE_TAC[COMPLEX_MUL_LNEG] THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_ADD = prove + (`!w z. csin(w + z) = csin(w) * ccos(z) + ccos(w) * csin(z)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; + +let CCOS_ADD = prove + (`!w z. ccos(w + z) = ccos(w) * ccos(z) - csin(w) * csin(z)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_FIELD);; + +let CSIN_NEG = prove + (`!z. csin(--z) = --(csin(z))`, + REWRITE_TAC[csin; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN + GEN_TAC THEN MP_TAC COMPLEX_POW_II_2 THEN + CONV_TAC COMPLEX_FIELD);; + +let CCOS_NEG = prove + (`!z. ccos(--z) = ccos(z)`, + REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN + GEN_TAC THEN MP_TAC COMPLEX_POW_II_2 THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_DOUBLE = prove + (`!z. csin(Cx(&2) * z) = Cx(&2) * csin(z) * ccos(z)`, + REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CSIN_ADD] THEN + CONV_TAC COMPLEX_RING);; + +let CCOS_DOUBLE = prove + (`!z. ccos(Cx(&2) * z) = (ccos(z) pow 2) - (csin(z) pow 2)`, + REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* Euler and de Moivre formulas. *) +(* ------------------------------------------------------------------------- *) + +let CEXP_EULER = prove + (`!z. cexp(ii * z) = ccos(z) + ii * csin(z)`, + REWRITE_TAC[ccos; csin] THEN MP_TAC COMPLEX_POW_II_2 THEN + CONV_TAC COMPLEX_FIELD);; + +let DEMOIVRE = prove + (`!z n. (ccos z + ii * csin z) pow n = + ccos(Cx(&n) * z) + ii * csin(Cx(&n) * z)`, + REWRITE_TAC[GSYM CEXP_EULER; GSYM CEXP_MUL] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_COMPLEX = prove + (`!P. (?z. P (Re z) (Im z)) <=> ?x y. P x y`, + MESON_TAC[RE; IM; COMPLEX]);; + +let COMPLEX_UNIMODULAR_POLAR = prove + (`!z. (norm z = &1) ==> ?x. z = complex(cos(x),sin(x))`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow):real->num->real`) THEN + REWRITE_TAC[complex_norm] THEN + SIMP_TAC[REAL_POW_2; REWRITE_RULE[REAL_POW_2] SQRT_POW_2; + REAL_LE_SQUARE; REAL_LE_ADD] THEN + REWRITE_TAC[GSYM REAL_POW_2; REAL_MUL_LID] THEN + DISCH_THEN(X_CHOOSE_TAC `t:real` o MATCH_MP CIRCLE_SINCOS) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM]);; + +let SIN_INTEGER_2PI = prove + (`!n. integer n ==> sin((&2 * pi) * n) = &0`, + REWRITE_TAC[integer; REAL_ARITH `abs(x) = &n <=> x = &n \/ x = -- &n`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; SIN_NEG] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; SIN_DOUBLE] THEN + REWRITE_TAC[REAL_ARITH `pi * &n = &n * pi`; SIN_NPI] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_NEG_0]);; + +let COS_INTEGER_2PI = prove + (`!n. integer n ==> cos((&2 * pi) * n) = &1`, + REWRITE_TAC[integer; REAL_ARITH `abs(x) = &n <=> x = &n \/ x = -- &n`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; COS_NEG] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; COS_DOUBLE] THEN + REWRITE_TAC[REAL_ARITH `pi * &n = &n * pi`; SIN_NPI; COS_NPI] THEN + REWRITE_TAC[REAL_POW_POW] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[GSYM REAL_POW_POW; REAL_POW_2] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_ONE; REAL_SUB_RZERO]);; + +let SINCOS_PRINCIPAL_VALUE = prove + (`!x. ?y. (--pi < y /\ y <= pi) /\ (sin(y) = sin(x) /\ cos(y) = cos(x))`, + GEN_TAC THEN EXISTS_TAC `pi - (&2 * pi) * frac((pi - x) / (&2 * pi))` THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_ARITH `--p < p - x <=> x < (&2 * p) * &1`; + REAL_ARITH `p - x <= p <=> (&2 * p) * &0 <= x`; + REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_LT_MUL; + PI_POS; REAL_OF_NUM_LT; ARITH; FLOOR_FRAC]; + REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LDISTRIB] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ; + PI_POS; REAL_ARITH `a - (a - b - c):real = b + c`; SIN_ADD; COS_ADD] THEN + SIMP_TAC[FLOOR_FRAC; SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN + CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Complex logarithms (the conventional principal value). *) +(* ------------------------------------------------------------------------- *) + +let clog = new_definition + `clog z = @w. cexp(w) = z /\ --pi < Im(w) /\ Im(w) <= pi`;; + +let CLOG_WORKS = prove + (`!z. ~(z = Cx(&0)) + ==> cexp(clog z) = z /\ --pi < Im(clog z) /\ Im(clog z) <= pi`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[clog] THEN CONV_TAC SELECT_CONV THEN + REWRITE_TAC[cexp; EXISTS_COMPLEX] THEN + EXISTS_TAC `ln(norm(z:complex))` THEN + SUBGOAL_THEN `exp(ln(norm(z:complex))) = norm(z)` SUBST1_TAC THENL + [ASM_MESON_TAC[REAL_EXP_LN; COMPLEX_NORM_NZ]; ALL_TAC] THEN + MP_TAC(SPEC `z / Cx(norm z)` COMPLEX_UNIMODULAR_POLAR) THEN ANTS_TAC THENL + [ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[COMPLEX_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `x:real` SINCOS_PRINCIPAL_VALUE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CX_INJ; COMPLEX_DIV_LMUL; COMPLEX_NORM_ZERO]);; + +let CEXP_CLOG = prove + (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z`, + SIMP_TAC[CLOG_WORKS]);; + +(* ------------------------------------------------------------------------- *) +(* Unwinding number. *) +(* ------------------------------------------------------------------------- *) + +let unwinding = new_definition + `unwinding(z) = (z - clog(cexp z)) / (Cx(&2 * pi) * ii)`;; + +let COMPLEX_II_NZ = prove + (`~(ii = Cx(&0))`, + MP_TAC COMPLEX_POW_II_2 THEN CONV_TAC COMPLEX_RING);; + +let UNWINDING_2PI = prove + (`Cx(&2 * pi) * ii * unwinding(z) = z - clog(cexp z)`, + REWRITE_TAC[unwinding; COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC COMPLEX_DIV_LMUL THEN + REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; COMPLEX_II_NZ] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* An example of how to get nice identities with unwinding number. *) +(* ------------------------------------------------------------------------- *) + +let CLOG_MUL = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> clog(w * z) = + clog(w) + clog(z) - + Cx(&2 * pi) * ii * unwinding(clog w + clog z)`, + REWRITE_TAC[UNWINDING_2PI; + COMPLEX_RING `w + z - ((w + z) - c) = c:complex`] THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG]);; diff --git a/Complex/complexnumbers.ml b/Complex/complexnumbers.ml new file mode 100644 index 0000000..ef2f172 --- /dev/null +++ b/Complex/complexnumbers.ml @@ -0,0 +1,912 @@ +(* ========================================================================= *) +(* Basic definitions and properties of complex numbers. *) +(* ========================================================================= *) + +needs "Library/transc.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Definition of complex number type. *) +(* ------------------------------------------------------------------------- *) + +let complex_tybij_raw = + new_type_definition "complex" ("complex","coords") + (prove(`?x:real#real. T`,REWRITE_TAC[]));; + +let complex_tybij = REWRITE_RULE [] complex_tybij_raw;; + +(* ------------------------------------------------------------------------- *) +(* Real and imaginary parts of a number. *) +(* ------------------------------------------------------------------------- *) + +let RE_DEF = new_definition + `Re(z) = FST(coords(z))`;; + +let IM_DEF = new_definition + `Im(z) = SND(coords(z))`;; + +(* ------------------------------------------------------------------------- *) +(* Set up overloading. *) +(* ------------------------------------------------------------------------- *) + +do_list overload_interface + ["+",`complex_add:complex->complex->complex`; + "-",`complex_sub:complex->complex->complex`; + "*",`complex_mul:complex->complex->complex`; + "/",`complex_div:complex->complex->complex`; + "--",`complex_neg:complex->complex`; + "pow",`complex_pow:complex->num->complex`; + "inv",`complex_inv:complex->complex`];; + +let prioritize_complex() = prioritize_overload(mk_type("complex",[]));; + +(* ------------------------------------------------------------------------- *) +(* Complex absolute value (modulus). *) +(* ------------------------------------------------------------------------- *) + +make_overloadable "norm" `:A->real`;; +overload_interface("norm",`complex_norm:complex->real`);; + +let complex_norm = new_definition + `norm(z) = sqrt(Re(z) pow 2 + Im(z) pow 2)`;; + +(* ------------------------------------------------------------------------- *) +(* Imaginary unit (too inconvenient to use "i"!) *) +(* ------------------------------------------------------------------------- *) + +let ii = new_definition + `ii = complex(&0,&1)`;; + +(* ------------------------------------------------------------------------- *) +(* Injection from reals. *) +(* ------------------------------------------------------------------------- *) + +let CX_DEF = new_definition + `Cx(a) = complex(a,&0)`;; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations. *) +(* ------------------------------------------------------------------------- *) + +let complex_neg = new_definition + `--z = complex(--(Re(z)),--(Im(z)))`;; + +let complex_add = new_definition + `w + z = complex(Re(w) + Re(z),Im(w) + Im(z))`;; + +let complex_sub = new_definition + `w - z = w + --z`;; + +let complex_mul = new_definition + `w * z = complex(Re(w) * Re(z) - Im(w) * Im(z), + Re(w) * Im(z) + Im(w) * Re(z))`;; + +let complex_inv = new_definition + `inv(z) = complex(Re(z) / (Re(z) pow 2 + Im(z) pow 2), + --(Im(z)) / (Re(z) pow 2 + Im(z) pow 2))`;; + +let complex_div = new_definition + `w / z = w * inv(z)`;; + +let complex_pow = new_recursive_definition num_RECURSION + `(x pow 0 = Cx(&1)) /\ + (!n. x pow (SUC n) = x * x pow n)`;; + +(* ------------------------------------------------------------------------- *) +(* Various handy rewrites. *) +(* ------------------------------------------------------------------------- *) + +let RE = prove + (`(Re(complex(x,y)) = x)`, + REWRITE_TAC[RE_DEF; complex_tybij]);; + +let IM = prove + (`Im(complex(x,y)) = y`, + REWRITE_TAC[IM_DEF; complex_tybij]);; + +let COMPLEX = prove + (`complex(Re(z),Im(z)) = z`, + REWRITE_TAC[IM_DEF; RE_DEF; complex_tybij]);; + +let COMPLEX_EQ = prove + (`!w z. (w = z) <=> (Re(w) = Re(z)) /\ (Im(w) = Im(z))`, + REWRITE_TAC[RE_DEF; IM_DEF; GSYM PAIR_EQ] THEN MESON_TAC[complex_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* Crude tactic to automate very simple algebraic equivalences. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLE_COMPLEX_ARITH_TAC = + REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF; + complex_add; complex_neg; complex_sub; complex_mul] THEN + REAL_ARITH_TAC;; + +let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Basic algebraic properties that can be proved automatically by this. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_ADD_SYM = prove + (`!x y. x + y = y + x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_ASSOC = prove + (`!x y z. x + y + z = (x + y) + z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_LID = prove + (`!x. Cx(&0) + x = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_LINV = prove + (`!x. --x + x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_SYM = prove + (`!x y. x * y = y * x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_ASSOC = prove + (`!x y z. x * y * z = (x * y) * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LID = prove + (`!x. Cx(&1) * x = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_LDISTRIB = prove + (`!x y z. x * (y + z) = x * y + x * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_AC = prove + (`(m + n = n + m) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_AC = prove + (`(m * n = n * m) /\ ((m * n) * p = m * n * p) /\ (m * n * p = n * m * p)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_RID = prove + (`!x. x + Cx(&0) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RID = prove + (`!x. x * Cx(&1) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_RINV = prove + (`!x. x + --x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_RDISTRIB = prove + (`!x y z. (x + y) * z = x * z + y * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_LCANCEL = prove + (`!x y z. (x + y = x + z) <=> (y = z)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_RCANCEL = prove + (`!x y z. (x + z = y + z) <=> (x = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RZERO = prove + (`!x. x * Cx(&0) = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LZERO = prove + (`!x. Cx(&0) * x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_NEG = prove + (`!x. --(--x) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RNEG = prove + (`!x y. x * --y = --(x * y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LNEG = prove + (`!x y. --x * y = --(x * y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_ADD = prove + (`!x y. --(x + y) = --x + --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_0 = prove + (`--Cx(&0) = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_LCANCEL_0 = prove + (`!x y. (x + y = x) <=> (y = Cx(&0))`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_RCANCEL_0 = prove + (`!x y. (x + y = y) <=> (x = Cx(&0))`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_LNEG_UNIQ = prove + (`!x y. (x + y = Cx(&0)) <=> (x = --y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_RNEG_UNIQ = prove + (`!x y. (x + y = Cx(&0)) <=> (y = --x)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_LMUL = prove + (`!x y. --(x * y) = --x * y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_RMUL = prove + (`!x y. --(x * y) = x * --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_MUL2 = prove + (`!x y. --x * --y = x * y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_ADD = prove + (`!x y. x - y + y = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_ADD2 = prove + (`!x y. y + x - y = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_REFL = prove + (`!x. x - x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_0 = prove + (`!x y. (x - y = Cx(&0)) <=> (x = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_EQ_0 = prove + (`!x. (--x = Cx(&0)) <=> (x = Cx(&0))`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_SUB = prove + (`!x y. --(x - y) = y - x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_SUB = prove + (`!x y. (x + y) - x = y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_EQ = prove + (`!x y. (--x = y) <=> (x = --y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_MINUS1 = prove + (`!x. --x = --Cx(&1) * x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_SUB = prove + (`!x y. x - y - x = --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD2_SUB2 = prove + (`!a b c d. (a + b) - (c + d) = a - c + b - d`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_LZERO = prove + (`!x. Cx(&0) - x = --x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_RZERO = prove + (`!x. x - Cx(&0) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_LNEG = prove + (`!x y. --x - y = --(x + y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_RNEG = prove + (`!x y. x - --y = x + y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_NEG2 = prove + (`!x y. --x - --y = y - x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_TRIANGLE = prove + (`!a b c. a - b + b - c = a - c`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_SUB_LADD = prove + (`!x y z. (x = y - z) <=> (x + z = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_SUB_RADD = prove + (`!x y z. (x - y = z) <=> (x = z + y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_SUB2 = prove + (`!x y. x - (x - y) = y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_SUB2 = prove + (`!x y. x - (x + y) = --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_DIFFSQ = prove + (`!x y. (x + y) * (x - y) = x * x - y * y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_NEG2 = prove + (`!x y. (--x = --y) <=> (x = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_LDISTRIB = prove + (`!x y z. x * (y - z) = x * y - x * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_RDISTRIB = prove + (`!x y z. (x - y) * z = x * z - y * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_2 = prove + (`!x. &2 * x = x + x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Homomorphic embedding properties for Cx mapping. *) +(* ------------------------------------------------------------------------- *) + +let CX_INJ = prove + (`!x y. (Cx(x) = Cx(y)) <=> (x = y)`, + REWRITE_TAC[CX_DEF; COMPLEX_EQ; RE; IM]);; + +let CX_NEG = prove + (`!x. Cx(--x) = --(Cx(x))`, + REWRITE_TAC[CX_DEF; complex_neg; RE; IM; REAL_NEG_0]);; + +let CX_INV = prove + (`!x. Cx(inv x) = inv(Cx x)`, + GEN_TAC THEN + REWRITE_TAC[CX_DEF; complex_inv; RE; IM] THEN + REWRITE_TAC[real_div; REAL_NEG_0; REAL_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_EQ; REAL_POW_2; REAL_MUL_RZERO; RE; IM] THEN + REWRITE_TAC[REAL_ADD_RID; REAL_INV_MUL] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[REAL_MUL_RINV]);; + +let CX_ADD = prove + (`!x y. Cx(x + y) = Cx(x) + Cx(y)`, + REWRITE_TAC[CX_DEF; complex_add; RE; IM; REAL_ADD_LID]);; + +let CX_SUB = prove + (`!x y. Cx(x - y) = Cx(x) - Cx(y)`, + REWRITE_TAC[complex_sub; real_sub; CX_ADD; CX_NEG]);; + +let CX_MUL = prove + (`!x y. Cx(x * y) = Cx(x) * Cx(y)`, + REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_ADD_RID]);; + +let CX_DIV = prove + (`!x y. Cx(x / y) = Cx(x) / Cx(y)`, + REWRITE_TAC[complex_div; real_div; CX_MUL; CX_INV]);; + +let CX_POW = prove + (`!x n. Cx(x pow n) = Cx(x) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; real_pow; CX_MUL]);; + +let CX_ABS = prove + (`!x. Cx(abs x) = Cx(norm(Cx(x)))`, + REWRITE_TAC[CX_DEF; complex_norm; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; + +let COMPLEX_NORM_CX = prove + (`!x. norm(Cx(x)) = abs(x)`, + REWRITE_TAC[GSYM CX_INJ; CX_ABS]);; + +(* ------------------------------------------------------------------------- *) +(* A convenient lemma that we need a few times below. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_ENTIRE = prove + (`!x y. (x * y = Cx(&0)) <=> (x = Cx(&0)) \/ (y = Cx(&0))`, + REWRITE_TAC[COMPLEX_EQ; complex_mul; RE; IM; CX_DEF; GSYM REAL_SOS_EQ_0] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Powers. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_POW_ADD = prove + (`!x m n. x pow (m + n) = x pow m * x pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; complex_pow; + COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC]);; + +let COMPLEX_POW_POW = prove + (`!x m n. (x pow m) pow n = x pow (m * n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; MULT_CLAUSES; COMPLEX_POW_ADD]);; + +let COMPLEX_POW_1 = prove + (`!x. x pow 1 = x`, + REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID]);; + +let COMPLEX_POW_2 = prove + (`!x. x pow 2 = x * x`, + REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1]);; + +let COMPLEX_POW_NEG = prove + (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; EVEN] THEN + ASM_CASES_TAC `EVEN n` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG]);; + +let COMPLEX_POW_ONE = prove + (`!n. Cx(&1) pow n = Cx(&1)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID]);; + +let COMPLEX_POW_MUL = prove + (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_AC]);; + +let COMPLEX_POW_II_2 = prove + (`ii pow 2 = --Cx(&1)`, + REWRITE_TAC[ii; COMPLEX_POW_2; complex_mul; CX_DEF; RE; IM; complex_neg] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let COMPLEX_POW_EQ_0 = prove + (`!x n. (x pow n = Cx(&0)) <=> (x = Cx(&0)) /\ ~(n = 0)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[NOT_SUC; complex_pow; COMPLEX_ENTIRE] THENL + [SIMPLE_COMPLEX_ARITH_TAC; CONV_TAC TAUT]);; + +(* ------------------------------------------------------------------------- *) +(* Norms (aka "moduli"). *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_NORM_CX = prove + (`!x. norm(Cx x) = abs(x)`, + GEN_TAC THEN REWRITE_TAC[complex_norm; CX_DEF; RE; IM] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; + +let COMPLEX_NORM_POS = prove + (`!z. &0 <= norm(z)`, + SIMP_TAC[complex_norm; SQRT_POS_LE; REAL_POW_2; + REAL_LE_SQUARE; REAL_LE_ADD]);; + +let COMPLEX_ABS_NORM = prove + (`!z. abs(norm z) = norm z`, + REWRITE_TAC[real_abs; COMPLEX_NORM_POS]);; + +let COMPLEX_NORM_ZERO = prove + (`!z. (norm z = &0) <=> (z = Cx(&0))`, + GEN_TAC THEN REWRITE_TAC[complex_norm] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_0] THEN + SIMP_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADD; REAL_POS; SQRT_INJ] THEN + REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF] THEN + SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH + `&0 <= x /\ &0 <= y ==> ((x + y = &0) <=> (x = &0) /\ (y = &0))`] THEN + REWRITE_TAC[REAL_ENTIRE]);; + +let COMPLEX_NORM_NUM = prove + (`norm(Cx(&n)) = &n`, + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);; + +let COMPLEX_NORM_0 = prove + (`norm(Cx(&0)) = &0`, + MESON_TAC[COMPLEX_NORM_ZERO]);; + +let COMPLEX_NORM_NZ = prove + (`!z. &0 < norm(z) <=> ~(z = Cx(&0))`, + MESON_TAC[COMPLEX_NORM_ZERO; COMPLEX_ABS_NORM; REAL_ABS_NZ]);; + +let COMPLEX_NORM_NEG = prove + (`!z. norm(--z) = norm(z)`, + REWRITE_TAC[complex_neg; complex_norm; REAL_POW_2; RE; IM] THEN + GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let COMPLEX_NORM_MUL = prove + (`!w z. norm(w * z) = norm(w) * norm(z)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[complex_norm; complex_mul; RE; IM] THEN + SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let COMPLEX_NORM_POW = prove + (`!z n. norm(z pow n) = norm(z) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; real_pow; COMPLEX_NORM_NUM; COMPLEX_NORM_MUL]);; + +let COMPLEX_NORM_INV = prove + (`!z. norm(inv z) = inv(norm z)`, + GEN_TAC THEN REWRITE_TAC[complex_norm; complex_inv; RE; IM] THEN + REWRITE_TAC[REAL_POW_2; real_div] THEN + REWRITE_TAC[REAL_ARITH `(r * d) * r * d + (--i * d) * --i * d = + (r * r + i * i) * d * d:real`] THEN + ASM_CASES_TAC `Re z * Re z + Im z * Im z = &0` THENL + [ASM_REWRITE_TAC[REAL_INV_0; SQRT_0; REAL_MUL_LZERO]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN + SIMP_TAC[GSYM SQRT_MUL; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LE_ADD; + REAL_LE_SQUARE] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * a * b * b:real = (a * b) * (a * b)`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; SQRT_1]);; + +let COMPLEX_NORM_DIV = prove + (`!w z. norm(w / z) = norm(w) / norm(z)`, + REWRITE_TAC[complex_div; real_div; COMPLEX_NORM_INV; COMPLEX_NORM_MUL]);; + +let COMPLEX_NORM_TRIANGLE = prove + (`!w z. norm(w + z) <= norm(w) + norm(z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm; complex_add; RE; IM] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs(x) <= abs(y) ==> x <= y`) THEN + SIMP_TAC[SQRT_POS_LE; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; + REAL_LE_SQUARE_ABS; SQRT_POW_2] THEN + GEN_REWRITE_TAC RAND_CONV[REAL_ARITH + `(a + b) * (a + b) = a * a + b * b + &2 * a * b`] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + SIMP_TAC[SQRT_POW_2; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_ARITH + `(rw + rz) * (rw + rz) + (iw + iz) * (iw + iz) <= + (rw * rw + iw * iw) + (rz * rz + iz * iz) + &2 * other <=> + rw * rz + iw * iz <= other`] THEN + SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs(x) <= abs(y) ==> x <= y`) THEN + SIMP_TAC[SQRT_POS_LE; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; + REAL_LE_SQUARE_ABS; SQRT_POW_2; REAL_LE_MUL] THEN + REWRITE_TAC[REAL_ARITH + `(rw * rz + iw * iz) * (rw * rz + iw * iz) <= + (rw * rw + iw * iw) * (rz * rz + iz * iz) <=> + &0 <= (rw * iz - rz * iw) * (rw * iz - rz * iw)`] THEN + REWRITE_TAC[REAL_LE_SQUARE]);; + +let COMPLEX_NORM_TRIANGLE_SUB = prove + (`!w z. norm(w) <= norm(w + z) + norm(z)`, + MESON_TAC[COMPLEX_NORM_TRIANGLE; COMPLEX_NORM_NEG; COMPLEX_ADD_ASSOC; + COMPLEX_ADD_RINV; COMPLEX_ADD_RID]);; + +let COMPLEX_NORM_ABS_NORM = prove + (`!w z. abs(norm w - norm z) <= norm(w - z)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `a - b <= x /\ b - a <= x ==> abs(a - b) <= x:real`) THEN + MESON_TAC[COMPLEX_NEG_SUB; COMPLEX_NORM_NEG; REAL_LE_SUB_RADD; complex_sub; + COMPLEX_NORM_TRIANGLE_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* Complex conjugate. *) +(* ------------------------------------------------------------------------- *) + +let cnj = new_definition + `cnj(z) = complex(Re(z),--(Im(z)))`;; + +(* ------------------------------------------------------------------------- *) +(* Conjugation is an automorphism. *) +(* ------------------------------------------------------------------------- *) + +let CNJ_INJ = prove + (`!w z. (cnj(w) = cnj(z)) <=> (w = z)`, + REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_EQ_NEG2]);; + +let CNJ_CNJ = prove + (`!z. cnj(cnj z) = z`, + REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_NEG_NEG]);; + +let CNJ_CX = prove + (`!x. cnj(Cx x) = Cx x`, + REWRITE_TAC[cnj; COMPLEX_EQ; CX_DEF; REAL_NEG_0; RE; IM]);; + +let COMPLEX_NORM_CNJ = prove + (`!z. norm(cnj z) = norm(z)`, + REWRITE_TAC[complex_norm; cnj; REAL_POW_2] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; RE; IM; REAL_NEG_NEG]);; + +let CNJ_NEG = prove + (`!z. cnj(--z) = --(cnj z)`, + REWRITE_TAC[cnj; complex_neg; COMPLEX_EQ; RE; IM]);; + +let CNJ_INV = prove + (`!z. cnj(inv z) = inv(cnj z)`, + REWRITE_TAC[cnj; complex_inv; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[real_div; REAL_NEG_NEG; REAL_POW_2; + REAL_MUL_LNEG; REAL_MUL_RNEG]);; + +let CNJ_ADD = prove + (`!w z. cnj(w + z) = cnj(w) + cnj(z)`, + REWRITE_TAC[cnj; complex_add; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let CNJ_SUB = prove + (`!w z. cnj(w - z) = cnj(w) - cnj(z)`, + REWRITE_TAC[complex_sub; CNJ_ADD; CNJ_NEG]);; + +let CNJ_MUL = prove + (`!w z. cnj(w * z) = cnj(w) * cnj(z)`, + REWRITE_TAC[cnj; complex_mul; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let CNJ_DIV = prove + (`!w z. cnj(w / z) = cnj(w) / cnj(z)`, + REWRITE_TAC[complex_div; CNJ_MUL; CNJ_INV]);; + +let CNJ_POW = prove + (`!z n. cnj(z pow n) = cnj(z) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; CNJ_MUL; CNJ_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Conversion of (complex-type) rational constant to ML rational number. *) +(* ------------------------------------------------------------------------- *) + +let is_complex_const = + let cx_tm = `Cx` in + fun tm -> + is_comb tm & + let l,r = dest_comb tm in l = cx_tm & is_ratconst r;; + +let dest_complex_const = + let cx_tm = `Cx` in + fun tm -> + let l,r = dest_comb tm in + if l = cx_tm then rat_of_term r + else failwith "dest_complex_const";; + +let mk_complex_const = + let cx_tm = `Cx` in + fun r -> + mk_comb(cx_tm,term_of_rat r);; + +(* ------------------------------------------------------------------------- *) +(* Conversions to perform operations if coefficients are rational constants. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_RAT_MUL_CONV = + GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; + +let COMPLEX_RAT_ADD_CONV = + GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; + +let COMPLEX_RAT_EQ_CONV = + GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;; + +let COMPLEX_RAT_POW_CONV = + let x_tm = `x:real` + and n_tm = `n:num` in + let pth = SYM(SPECL [x_tm; n_tm] CX_POW) in + fun tm -> + let lop,r = dest_comb tm in + let op,bod = dest_comb lop in + let th1 = INST [rand bod,x_tm; r,n_tm] pth in + let tm1,tm2 = dest_comb(concl th1) in + if rand tm1 <> tm then failwith "COMPLEX_RAT_POW_CONV" else + let tm3,tm4 = dest_comb tm2 in + TRANS th1 (AP_TERM tm3 (REAL_RAT_REDUCE_CONV tm4));; + +(* ------------------------------------------------------------------------- *) +(* Instantiate polynomial normalizer. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_POLY_CLAUSES = prove + (`(!x y z. x + (y + z) = (x + y) + z) /\ + (!x y. x + y = y + x) /\ + (!x. Cx(&0) + x = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x y. x * y = y * x) /\ + (!x. Cx(&1) * x = x) /\ + (!x. Cx(&0) * x = Cx(&0)) /\ + (!x y z. x * (y + z) = x * y + x * z) /\ + (!x. x pow 0 = Cx(&1)) /\ + (!x n. x pow (SUC n) = x * x pow n)`, + REWRITE_TAC[complex_pow] THEN SIMPLE_COMPLEX_ARITH_TAC) +and COMPLEX_POLY_NEG_CLAUSES = prove + (`(!x. --x = Cx(-- &1) * x) /\ + (!x y. x - y = x + Cx(-- &1) * y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_POLY_NEG_CONV,COMPLEX_POLY_ADD_CONV,COMPLEX_POLY_SUB_CONV, + COMPLEX_POLY_MUL_CONV,COMPLEX_POLY_POW_CONV,COMPLEX_POLY_CONV = + SEMIRING_NORMALIZERS_CONV COMPLEX_POLY_CLAUSES COMPLEX_POLY_NEG_CLAUSES + (is_complex_const, + COMPLEX_RAT_ADD_CONV,COMPLEX_RAT_MUL_CONV,COMPLEX_RAT_POW_CONV) + (<);; + +let COMPLEX_RAT_INV_CONV = + GEN_REWRITE_CONV I [GSYM CX_INV] THENC RAND_CONV REAL_RAT_INV_CONV;; + +let COMPLEX_POLY_CONV = + let neg_tm = `(--):complex->complex` + and inv_tm = `inv:complex->complex` + and add_tm = `(+):complex->complex->complex` + and sub_tm = `(-):complex->complex->complex` + and mul_tm = `(*):complex->complex->complex` + and div_tm = `(/):complex->complex->complex` + and pow_tm = `(pow):complex->num->complex` + and div_conv = REWR_CONV complex_div in + let rec COMPLEX_POLY_CONV tm = + if not(is_comb tm) or is_complex_const tm then REFL tm else + let lop,r = dest_comb tm in + if lop = neg_tm then + let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in + TRANS th1 (COMPLEX_POLY_NEG_CONV (rand(concl th1))) + else if lop = inv_tm then + let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in + TRANS th1 (TRY_CONV COMPLEX_RAT_INV_CONV (rand(concl th1))) + else if not(is_comb lop) then REFL tm else + let op,l = dest_comb lop in + if op = pow_tm then + let th1 = AP_THM (AP_TERM op (COMPLEX_POLY_CONV l)) r in + TRANS th1 (TRY_CONV COMPLEX_POLY_POW_CONV (rand(concl th1))) + else if op = add_tm or op = mul_tm or op = sub_tm then + let th1 = MK_COMB(AP_TERM op (COMPLEX_POLY_CONV l), + COMPLEX_POLY_CONV r) in + let fn = if op = add_tm then COMPLEX_POLY_ADD_CONV + else if op = mul_tm then COMPLEX_POLY_MUL_CONV + else COMPLEX_POLY_SUB_CONV in + TRANS th1 (fn (rand(concl th1))) + else if op = div_tm then + let th1 = div_conv tm in + TRANS th1 (COMPLEX_POLY_CONV (rand(concl th1))) + else REFL tm in + COMPLEX_POLY_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Complex number version of usual ring procedure. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_MUL_LINV = prove + (`!z. ~(z = Cx(&0)) ==> (inv(z) * z = Cx(&1))`, + REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN + REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);; + +let COMPLEX_MUL_RINV = prove + (`!z. ~(z = Cx(&0)) ==> (z * inv(z) = Cx(&1))`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[COMPLEX_MUL_LINV]);; + +let COMPLEX_RING,complex_ideal_cofactors = + let ring_pow_tm = `(pow):complex->num->complex` + and COMPLEX_INTEGRAL = prove + (`(!x. Cx(&0) * x = Cx(&0)) /\ + (!x y z. (x + y = x + z) <=> (y = z)) /\ + (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, + REWRITE_TAC[COMPLEX_ENTIRE; SIMPLE_COMPLEX_ARITH + `(w * y + x * z = w * z + x * y) <=> + (w - x) * (y - z) = Cx(&0)`] THEN + SIMPLE_COMPLEX_ARITH_TAC) + and COMPLEX_RABINOWITSCH = prove + (`!x y:complex. ~(x = y) <=> ?z. (x - y) * z = Cx(&1)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_SUB_0] THEN + MESON_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LZERO; + SIMPLE_COMPLEX_ARITH `~(Cx(&1) = Cx(&0))`]) + and init = ALL_CONV in + let pure,ideal = + RING_AND_IDEAL_CONV + (dest_complex_const,mk_complex_const,COMPLEX_RAT_EQ_CONV, + `(--):complex->complex`,`(+):complex->complex->complex`, + `(-):complex->complex->complex`,`(inv):complex->complex`, + `(*):complex->complex->complex`,`(/):complex->complex->complex`, + `(pow):complex->num->complex`, + COMPLEX_INTEGRAL,COMPLEX_RABINOWITSCH,COMPLEX_POLY_CONV) in + (fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)))), + ideal;; + +(* ------------------------------------------------------------------------- *) +(* Most basic properties of inverses. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_INV_0 = prove + (`inv(Cx(&0)) = Cx(&0)`, + REWRITE_TAC[complex_inv; CX_DEF; RE; IM; real_div; REAL_MUL_LZERO; + REAL_NEG_0]);; + +let COMPLEX_INV_MUL = prove + (`!w z. inv(w * z) = inv(w) * inv(z)`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`w = Cx(&0)`; `z = Cx(&0)`] THEN + ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN + REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);; + +let COMPLEX_INV_1 = prove + (`inv(Cx(&1)) = Cx(&1)`, + REWRITE_TAC[complex_inv; CX_DEF; RE; IM] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1]);; + +let COMPLEX_POW_INV = prove + (`!x n. (inv x) pow n = inv(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_INV_1; COMPLEX_INV_MUL]);; + +let COMPLEX_INV_INV = prove + (`!x:complex. inv(inv x) = x`, + GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_INV_0] THEN + POP_ASSUM MP_TAC THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t COMPLEX_MUL_RINV)) + [`x:complex`; `inv(x):complex`] THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* And also field procedure. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_FIELD = + let prenex_conv = + TOP_DEPTH_CONV BETA_CONV THENC + PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; complex_div; + COMPLEX_INV_INV; COMPLEX_INV_MUL; GSYM REAL_POW_INV] THENC + NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC + PRENEX_CONV + and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV + and is_inv = + let inv_tm = `inv:complex->complex` + and is_div = is_binop `(/):complex->complex->complex` in + fun tm -> (is_div tm or (is_comb tm & rator tm = inv_tm)) & + not(is_complex_const(rand tm)) + and lemma_inv = MESON[COMPLEX_MUL_RINV] + `!x. x = Cx(&0) \/ x * inv(x) = Cx(&1)` + and dcases = MATCH_MP(TAUT `(p \/ q) /\ (r \/ s) ==> (p \/ r) \/ q /\ s`) in + let cases_rule th1 th2 = dcases (CONJ th1 th2) in + let BASIC_COMPLEX_FIELD tm = + let is_freeinv t = is_inv t & free_in t tm in + let itms = setify(map rand (find_terms is_freeinv tm)) in + let dth = if itms = [] then TRUTH + else end_itlist cases_rule (map (C SPEC lemma_inv) itms) in + let tm' = mk_imp(concl dth,tm) in + let th1 = setup_conv tm' in + let ths = map COMPLEX_RING (conjuncts(rand(concl th1))) in + let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in + MP (EQ_MP (SYM th1) (end_itlist CONJ ths)) dth in + fun tm -> + let th0 = prenex_conv tm in + let tm0 = rand(concl th0) in + let avs,bod = strip_forall tm0 in + let th1 = setup_conv bod in + let ths = map BASIC_COMPLEX_FIELD (conjuncts(rand(concl th1))) in + EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; + +(* ------------------------------------------------------------------------- *) +(* Properties of inverses, divisions are now mostly automatic. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_POW_DIV = prove + (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`, + REWRITE_TAC[complex_div; COMPLEX_POW_MUL; COMPLEX_POW_INV]);; + +let COMPLEX_DIV_REFL = prove + (`!x. ~(x = Cx(&0)) ==> (x / x = Cx(&1))`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_EQ_MUL_LCANCEL = prove + (`!x y z. (x * y = x * z) <=> (x = Cx(&0)) \/ (y = z)`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_EQ_MUL_RCANCEL = prove + (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = Cx(&0))`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_MUL_RINV_UNIQ = prove + (`!w z. w * z = Cx(&1) ==> inv w = z`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_MUL_LINV_UNIQ = prove + (`!w z. w * z = Cx(&1) ==> inv z = w`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIV_LMUL = prove + (`!w z. ~(z = Cx(&0)) ==> z * w / z = w`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIV_RMUL = prove + (`!w z. ~(z = Cx(&0)) ==> w / z * z = w`, + CONV_TAC COMPLEX_FIELD);; diff --git a/Complex/cpoly.ml b/Complex/cpoly.ml new file mode 100644 index 0000000..5b84dc0 --- /dev/null +++ b/Complex/cpoly.ml @@ -0,0 +1,977 @@ +(* ========================================================================= *) +(* Properties of complex polynomials (not canonically represented). *) +(* ========================================================================= *) + +needs "Complex/complexnumbers.ml";; + +prioritize_complex();; + +parse_as_infix("++",(16,"right"));; +parse_as_infix("**",(20,"right"));; +parse_as_infix("##",(20,"right"));; +parse_as_infix("divides",(14,"right"));; +parse_as_infix("exp",(22,"right"));; + +do_list override_interface + ["++",`poly_add:complex list->complex list->complex list`; + "**",`poly_mul:complex list->complex list->complex list`; + "##",`poly_cmul:complex->complex list->complex list`; + "neg",`poly_neg:complex list->complex list`; + "divides",`poly_divides:complex list->complex list->bool`; + "exp",`poly_exp:complex list -> num -> complex list`; + "diff",`poly_diff:complex list->complex list`];; + +let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Polynomials. *) +(* ------------------------------------------------------------------------- *) + +let poly = new_recursive_definition list_RECURSION + `(poly [] x = Cx(&0)) /\ + (poly (CONS h t) x = h + x * poly t x)`;; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations on polynomials. *) +(* ------------------------------------------------------------------------- *) + +let poly_add = new_recursive_definition list_RECURSION + `([] ++ l2 = l2) /\ + ((CONS h t) ++ l2 = + (if l2 = [] then CONS h t + else CONS (h + HD l2) (t ++ TL l2)))`;; + +let poly_cmul = new_recursive_definition list_RECURSION + `(c ## [] = []) /\ + (c ## (CONS h t) = CONS (c * h) (c ## t))`;; + +let poly_neg = new_definition + `neg = (##) (--(Cx(&1)))`;; + +let poly_mul = new_recursive_definition list_RECURSION + `([] ** l2 = []) /\ + ((CONS h t) ** l2 = + if t = [] then h ## l2 + else (h ## l2) ++ CONS (Cx(&0)) (t ** l2))`;; + +let poly_exp = new_recursive_definition num_RECURSION + `(p exp 0 = [Cx(&1)]) /\ + (p exp (SUC n) = p ** p exp n)`;; + +(* ------------------------------------------------------------------------- *) +(* Useful clausifications. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD_CLAUSES = prove + (`([] ++ p2 = p2) /\ + (p1 ++ [] = p1) /\ + ((CONS h1 t1) ++ (CONS h2 t2) = CONS (h1 + h2) (t1 ++ t2))`, + REWRITE_TAC[poly_add; NOT_CONS_NIL; HD; TL] THEN + SPEC_TAC(`p1:complex list`,`p1:complex list`) THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_add]);; + +let POLY_CMUL_CLAUSES = prove + (`(c ## [] = []) /\ + (c ## (CONS h t) = CONS (c * h) (c ## t))`, + REWRITE_TAC[poly_cmul]);; + +let POLY_NEG_CLAUSES = prove + (`(neg [] = []) /\ + (neg (CONS h t) = CONS (--h) (neg t))`, + REWRITE_TAC[poly_neg; POLY_CMUL_CLAUSES; + COMPLEX_MUL_LNEG; COMPLEX_MUL_LID]);; + +let POLY_MUL_CLAUSES = prove + (`([] ** p2 = []) /\ + ([h1] ** p2 = h1 ## p2) /\ + ((CONS h1 (CONS k1 t1)) ** p2 = + h1 ## p2 ++ CONS (Cx(&0)) (CONS k1 t1 ** p2))`, + REWRITE_TAC[poly_mul; NOT_CONS_NIL]);; + +(* ------------------------------------------------------------------------- *) +(* Various natural consequences of syntactic definitions. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD = prove + (`!p1 p2 x. poly (p1 ++ p2) x = poly p1 x + poly p2 x`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_add; poly; COMPLEX_ADD_LID] THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[NOT_CONS_NIL; HD; TL; poly; COMPLEX_ADD_RID] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_CMUL = prove + (`!p c x. poly (c ## p) x = c * poly p x`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly; poly_cmul] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_NEG = prove + (`!p x. poly (neg p) x = --(poly p x)`, + REWRITE_TAC[poly_neg; POLY_CMUL] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_MUL = prove + (`!x p1 p2. poly (p1 ** p2) x = poly p1 x * poly p2 x`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[poly_mul; poly; COMPLEX_MUL_LZERO; POLY_CMUL; POLY_ADD] THEN + SPEC_TAC(`h:complex`,`h:complex`) THEN + SPEC_TAC(`t:complex list`,`t:complex list`) THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC[poly_mul; POLY_CMUL; POLY_ADD; poly; POLY_CMUL; + COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; NOT_CONS_NIL] THEN + ASM_REWRITE_TAC[POLY_ADD; POLY_CMUL; poly] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_EXP = prove + (`!p n x. poly (p exp n) x = (poly p x) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[poly_exp; complex_pow; POLY_MUL] THEN + REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD_RZERO = prove + (`!p. poly (p ++ []) = poly p`, + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; poly; COMPLEX_ADD_RID]);; + +let POLY_MUL_ASSOC = prove + (`!p q r. poly (p ** (q ** r)) = poly ((p ** q) ** r)`, + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]);; + +let POLY_EXP_ADD = prove + (`!d n p. poly(p exp (n + d)) = poly(p exp n ** p exp d)`, + REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_MUL; ADD_CLAUSES; poly_exp; poly] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Key property that f(a) = 0 ==> (x - a) divides p(x). Very delicate! *) +(* ------------------------------------------------------------------------- *) + +let POLY_LINEAR_REM = prove + (`!t h. ?q r. CONS h t = [r] ++ [--a; Cx(&1)] ** q`, + LIST_INDUCT_TAC THEN REWRITE_TAC[] THENL + [GEN_TAC THEN EXISTS_TAC `[]:complex list` THEN + EXISTS_TAC `h:complex` THEN + REWRITE_TAC[poly_add; poly_mul; poly_cmul; NOT_CONS_NIL] THEN + REWRITE_TAC[HD; TL; COMPLEX_ADD_RID]; + X_GEN_TAC `k:complex` THEN + POP_ASSUM(STRIP_ASSUME_TAC o SPEC `h:complex`) THEN + EXISTS_TAC `CONS (r:complex) q` THEN EXISTS_TAC `r * a + k` THEN + ASM_REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN + REWRITE_TAC[CONS_11] THEN CONJ_TAC THENL + [SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + SPEC_TAC(`q:complex list`,`q:complex list`) THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN + REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_LID] THEN + REWRITE_TAC[COMPLEX_ADD_AC]]);; + +let POLY_LINEAR_DIVIDES = prove + (`!a p. (poly p a = Cx(&0)) <=> (p = []) \/ ?q. p = [--a; Cx(&1)] ** q`, + GEN_TAC THEN LIST_INDUCT_TAC THENL + [REWRITE_TAC[poly]; ALL_TAC] THEN + EQ_TAC THEN STRIP_TAC THENL + [DISJ2_TAC THEN STRIP_ASSUME_TAC(SPEC_ALL POLY_LINEAR_REM) THEN + EXISTS_TAC `q:complex list` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `r = Cx(&0)` SUBST_ALL_TAC THENL + [UNDISCH_TAC `poly (CONS h t) a = Cx(&0)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_ADD; POLY_MUL] THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; + COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_ADD_LINV] THEN SIMPLE_COMPLEX_ARITH_TAC; + REWRITE_TAC[poly_mul] THEN REWRITE_TAC[NOT_CONS_NIL] THEN + SPEC_TAC(`q:complex list`,`q:complex list`) THEN LIST_INDUCT_TAC THENL + [REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; + HD; TL; COMPLEX_ADD_LID]; + REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; + HD; TL; COMPLEX_ADD_LID]]]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly] THEN + REWRITE_TAC[POLY_MUL] THEN REWRITE_TAC[poly] THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_ADD_LINV] THEN SIMPLE_COMPLEX_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Thanks to the finesse of the above, we can use length rather than degree. *) +(* ------------------------------------------------------------------------- *) + +let POLY_LENGTH_MUL = prove + (`!q. LENGTH([--a; Cx(&1)] ** q) = SUC(LENGTH q)`, + let lemma = prove + (`!p h k a. LENGTH (k ## p ++ CONS h (a ## p)) = SUC(LENGTH p)`, + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[poly_cmul; POLY_ADD_CLAUSES; LENGTH]) in + REWRITE_TAC[poly_mul; NOT_CONS_NIL; lemma]);; + +(* ------------------------------------------------------------------------- *) +(* Thus a nontrivial polynomial of degree n has no more than n roots. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ROOTS_INDEX_LEMMA = prove + (`!n. !p. ~(poly p = poly []) /\ (LENGTH p = n) + ==> ?i. !x. (poly p x = Cx(&0)) ==> ?m. m <= n /\ (x = i m)`, + INDUCT_TAC THENL + [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a. poly p a = Cx(&0)` THENL + [UNDISCH_TAC `?a. poly p a = Cx(&0)` THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + UNDISCH_TAC `~(poly ([-- a; Cx(&1)] ** q) = poly [])` THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[POLY_LENGTH_MUL; SUC_INJ] THEN + DISCH_TAC THEN ASM_CASES_TAC `poly q = poly []` THENL + [ASM_REWRITE_TAC[POLY_MUL; poly; COMPLEX_MUL_RZERO; FUN_EQ_THM]; + DISCH_THEN(K ALL_TAC)] THEN + DISCH_THEN(MP_TAC o SPEC `q:complex list`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `i:num->complex`) THEN + EXISTS_TAC `\m. if m = SUC n then a:complex else i m` THEN + REWRITE_TAC[POLY_MUL; LE; COMPLEX_ENTIRE] THEN + X_GEN_TAC `x:complex` THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(fun th -> EXISTS_TAC `SUC n` THEN MP_TAC th) THEN + REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC; + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC]; + UNDISCH_TAC `~(?a. poly p a = Cx(&0))` THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; + +let POLY_ROOTS_INDEX_LENGTH = prove + (`!p. ~(poly p = poly []) + ==> ?i. !x. (poly p(x) = Cx(&0)) ==> ?n. n <= LENGTH p /\ (x = i n)`, + MESON_TAC[POLY_ROOTS_INDEX_LEMMA]);; + +let POLY_ROOTS_FINITE_LEMMA = prove + (`!p. ~(poly p = poly []) + ==> ?N i. !x. (poly p(x) = Cx(&0)) ==> ?n:num. n < N /\ (x = i n)`, + MESON_TAC[POLY_ROOTS_INDEX_LENGTH; LT_SUC_LE]);; + +let FINITE_LEMMA = prove + (`!i N P. (!x. P x ==> ?n:num. n < N /\ (x = i n)) + ==> ?a. !x. P x ==> norm(x) < a`, + GEN_TAC THEN ONCE_REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN INDUCT_TAC THENL + [REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `P:complex->bool` THEN + POP_ASSUM(MP_TAC o SPEC `\z. P z /\ ~(z = (i:num->complex) N)`) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN + EXISTS_TAC `abs(a) + norm(i(N:num)) + &1` THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[LT] THEN + SUBGOAL_THEN `(!x. norm(x) < abs(a) + norm(x) + &1) /\ + (!x y. norm(x) < a ==> norm(x) < abs(a) + norm(y) + &1)` + (fun th -> MP_TAC th THEN MESON_TAC[]) THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT GEN_TAC THEN MP_TAC(SPEC `y:complex` COMPLEX_NORM_POS) THEN + REAL_ARITH_TAC);; + +let POLY_ROOTS_FINITE = prove + (`!p. ~(poly p = poly []) <=> + ?N i. !x. (poly p(x) = Cx(&0)) ==> ?n:num. n < N /\ (x = i n)`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE_LEMMA] THEN + REWRITE_TAC[FUN_EQ_THM; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM; poly] THEN + MP_TAC(GENL [`i:num->complex`; `N:num`] + (SPECL [`i:num->complex`; `N:num`; `\x. poly p x = Cx(&0)`] + FINITE_LEMMA)) THEN + REWRITE_TAC[] THEN MESON_TAC[REAL_ARITH `~(abs(x) < x)`; COMPLEX_NORM_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Hence get entirety and cancellation for polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ENTIRE_LEMMA = prove + (`!p q. ~(poly p = poly []) /\ ~(poly q = poly []) + ==> ~(poly (p ** q) = poly [])`, + REPEAT GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (X_CHOOSE_TAC `i2:num->complex`)) THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (X_CHOOSE_TAC `i1:num->complex`)) THEN + EXISTS_TAC `N1 + N2:num` THEN + EXISTS_TAC `\n:num. if n < N1 then i1(n):complex else i2(n - N1)` THEN + X_GEN_TAC `x:complex` THEN REWRITE_TAC[COMPLEX_ENTIRE; POLY_MUL] THEN + DISCH_THEN(DISJ_CASES_THEN (ANTE_RES_THEN (X_CHOOSE_TAC `n:num`))) THENL + [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN ARITH_TAC; + EXISTS_TAC `N1 + n:num` THEN ASM_REWRITE_TAC[LT_ADD_LCANCEL] THEN + REWRITE_TAC[ARITH_RULE `~(m + n < m:num)`] THEN + AP_TERM_TAC THEN ARITH_TAC]);; + +let POLY_ENTIRE = prove + (`!p q. (poly (p ** q) = poly []) <=> + (poly p = poly []) \/ (poly q = poly [])`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[POLY_ENTIRE_LEMMA]; + REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO; poly]]);; + +let POLY_MUL_LCANCEL = prove + (`!p q r. (poly (p ** q) = poly (p ** r)) <=> + (poly p = poly []) \/ (poly q = poly r)`, + let lemma1 = prove + (`!p q. (poly (p ++ neg q) = poly []) <=> (poly p = poly q)`, + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; poly] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(p + --q = Cx(&0)) <=> (p = q)`]) in + let lemma2 = prove + (`!p q r. poly (p ** q ++ neg(p ** r)) = poly (p ** (q ++ neg(r)))`, + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; POLY_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC) in + ONCE_REWRITE_TAC[GSYM lemma1] THEN + REWRITE_TAC[lemma2; POLY_ENTIRE] THEN + REWRITE_TAC[lemma1]);; + +let POLY_EXP_EQ_0 = prove + (`!p n. (poly (p exp n) = poly []) <=> (poly p = poly []) /\ ~(n = 0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN + REWRITE_TAC[LEFT_AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[poly_exp; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; + CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_SUC] THEN + ASM_REWRITE_TAC[POLY_MUL; poly; COMPLEX_ENTIRE] THEN + CONV_TAC TAUT);; + +let POLY_PRIME_EQ_0 = prove + (`!a. ~(poly [a ; Cx(&1)] = poly [])`, + GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1) - a`) THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_EXP_PRIME_EQ_0 = prove + (`!a n. ~(poly ([a ; Cx(&1)] exp n) = poly [])`, + MESON_TAC[POLY_EXP_EQ_0; POLY_PRIME_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* Can also prove a more "constructive" notion of polynomial being trivial. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ZERO_LEMMA = prove + (`!h t. (poly (CONS h t) = poly []) ==> (h = Cx(&0)) /\ (poly t = poly [])`, + let lemma = REWRITE_RULE[FUN_EQ_THM; poly] POLY_ROOTS_FINITE in + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN + ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[COMPLEX_ADD_LID]; + DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN + POP_ASSUM MP_TAC THEN SIMPLE_COMPLEX_ARITH_TAC] THEN + CONV_TAC CONTRAPOS_CONV THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[lemma]) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (X_CHOOSE_TAC `i:num->complex`)) THEN + MP_TAC(SPECL + [`i:num->complex`; `N:num`; `\x. poly t x = Cx(&0)`] FINITE_LEMMA) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(abs(a) + &1)`) THEN + REWRITE_TAC[COMPLEX_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o MATCH_MP + (ASSUME `!x. (poly t x = Cx(&0)) ==> norm(x) < a`)) THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]);; + +let POLY_ZERO = prove + (`!p. (poly p = poly []) <=> ALL (\c. c = Cx(&0)) p`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN ASM_REWRITE_TAC[]; + POP_ASSUM(SUBST1_TAC o SYM) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FUN_EQ_THM; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Basics of divisibility. *) +(* ------------------------------------------------------------------------- *) + +let divides = new_definition + `p1 divides p2 <=> ?q. poly p2 = poly (p1 ** q)`;; + +let POLY_PRIMES = prove + (`!a p q. [a; Cx(&1)] divides (p ** q) <=> + [a; Cx(&1)] divides p \/ [a; Cx(&1)] divides q`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides; POLY_MUL; FUN_EQ_THM; poly] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `r:complex list` (MP_TAC o SPEC `--a`)) THEN + REWRITE_TAC[COMPLEX_ENTIRE; GSYM complex_sub; + COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO] THEN + DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN + (POP_ASSUM(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN + REWRITE_TAC[COMPLEX_NEG_NEG] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (X_CHOOSE_THEN `s:complex list` SUBST_ALL_TAC)) THENL + [EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; COMPLEX_MUL_RZERO]; + EXISTS_TAC `s:complex list` THEN GEN_TAC THEN + REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]); + DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_TAC `s:complex list`)) THEN + ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `s ** q`; EXISTS_TAC `p ** s`] THEN + GEN_TAC THEN REWRITE_TAC[POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC]);; + +let POLY_DIVIDES_REFL = prove + (`!p. p divides p`, + GEN_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[Cx(&1)]` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_DIVIDES_TRANS = prove + (`!p q r. p divides q /\ q divides r ==> p divides r`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN + EXISTS_TAC `t ** s` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]);; + +let POLY_DIVIDES_EXP = prove + (`!p m n. m <= n ==> (p exp m) divides (p exp n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; POLY_DIVIDES_REFL] THEN + MATCH_MP_TAC POLY_DIVIDES_TRANS THEN + EXISTS_TAC `p exp (m + d)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `p:complex list` THEN + REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_EXP_DIVIDES = prove + (`!p q m n. (p exp n) divides q /\ m <= n ==> (p exp m) divides q`, + MESON_TAC[POLY_DIVIDES_TRANS; POLY_DIVIDES_EXP]);; + +let POLY_DIVIDES_ADD = prove + (`!p q r. p divides q /\ p divides r ==> p divides (q ++ r)`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN + EXISTS_TAC `t ++ s` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_DIVIDES_SUB = prove + (`!p q r. p divides q /\ p divides (q ++ r) ==> p divides r`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex list` ASSUME_TAC) THEN + EXISTS_TAC `s ++ neg(t)` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL; POLY_NEG] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB; COMPLEX_MUL_RNEG] THEN + ASM_REWRITE_TAC[] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_DIVIDES_SUB2 = prove + (`!p q r. p divides r /\ p divides (q ++ r) ==> p divides q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DIVIDES_SUB THEN + EXISTS_TAC `r:complex list` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `p divides (q ++ r)` THEN + REWRITE_TAC[divides; POLY_ADD; FUN_EQ_THM; POLY_MUL] THEN + DISCH_THEN(X_CHOOSE_TAC `s:complex list`) THEN + EXISTS_TAC `s:complex list` THEN + X_GEN_TAC `x:complex` THEN POP_ASSUM(MP_TAC o SPEC `x:complex`) THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_DIVIDES_ZERO = prove + (`!p q. (poly p = poly []) ==> q divides p`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `[]:complex list` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* At last, we can consider the order of a root. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ORDER_EXISTS = prove + (`!a d. !p. (LENGTH p = d) /\ ~(poly p = poly []) + ==> ?n. ([--a; Cx(&1)] exp n) divides p /\ + ~(([--a; Cx(&1)] exp (SUC n)) divides p)`, + GEN_TAC THEN + (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) + `(!p q. mulexp 0 p q = q) /\ + (!p q n. mulexp (SUC n) p q = p ** (mulexp n p q))` THEN + SUBGOAL_THEN + `!d. !p. (LENGTH p = d) /\ ~(poly p = poly []) + ==> ?n q. (p = mulexp (n:num) [--a; Cx(&1)] q) /\ + ~(poly q a = Cx(&0))` + MP_TAC THENL + [INDUCT_TAC THENL + [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `p:complex list` THEN + ASM_CASES_TAC `poly p a = Cx(&0)` THENL + [STRIP_TAC THEN UNDISCH_TAC `poly p a = Cx(&0)` THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN + UNDISCH_TAC + `!p. (LENGTH p = d) /\ ~(poly p = poly []) + ==> ?n q. (p = mulexp (n:num) [--a; Cx(&1)] q) /\ + ~(poly q a = Cx(&0))` THEN + DISCH_THEN(MP_TAC o SPEC `q:complex list`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[POLY_LENGTH_MUL; POLY_ENTIRE; + DE_MORGAN_THM; SUC_INJ]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` + (X_CHOOSE_THEN `s:complex list` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `SUC n` THEN EXISTS_TAC `s:complex list` THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THEN EXISTS_TAC `0` THEN EXISTS_TAC `p:complex list` THEN + ASM_REWRITE_TAC[]]; + DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` + (X_CHOOSE_THEN `s:complex list` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[divides] THEN CONJ_TAC THENL + [EXISTS_TAC `s:complex list` THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL; poly] THEN + SIMPLE_COMPLEX_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `r:complex list` MP_TAC) THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `~(poly s a = Cx(&0))` THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[poly; poly_exp; POLY_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; + REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[poly_exp] THEN + REWRITE_TAC[GSYM POLY_MUL_ASSOC; POLY_MUL_LCANCEL] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a + Cx(&1)`) THEN + REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC; + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]]]);; + +let POLY_ORDER = prove + (`!p a. ~(poly p = poly []) + ==> ?!n. ([--a; Cx(&1)] exp n) divides p /\ + ~(([--a; Cx(&1)] exp (SUC n)) divides p)`, + MESON_TAC[POLY_ORDER_EXISTS; POLY_EXP_DIVIDES; LE_SUC_LT; LT_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of order. *) +(* ------------------------------------------------------------------------- *) + +let order = new_definition + `order a p = @n. ([--a; Cx(&1)] exp n) divides p /\ + ~(([--a; Cx(&1)] exp (SUC n)) divides p)`;; + +let ORDER = prove + (`!p a n. ([--a; Cx(&1)] exp n) divides p /\ + ~(([--a; Cx(&1)] exp (SUC n)) divides p) <=> + (n = order a p) /\ + ~(poly p = poly [])`, + REPEAT GEN_TAC THEN REWRITE_TAC[order] THEN + EQ_TAC THEN STRIP_TAC THENL + [SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL + [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[divides] THEN + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `[]:complex list` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]; + ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[]]; + ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV] THEN + ASM_MESON_TAC[POLY_ORDER]);; + +let ORDER_THM = prove + (`!p a. ~(poly p = poly []) + ==> ([--a; Cx(&1)] exp (order a p)) divides p /\ + ~(([--a; Cx(&1)] exp (SUC(order a p))) divides p)`, + MESON_TAC[ORDER]);; + +let ORDER_UNIQUE = prove + (`!p a n. ~(poly p = poly []) /\ + ([--a; Cx(&1)] exp n) divides p /\ + ~(([--a; Cx(&1)] exp (SUC n)) divides p) + ==> (n = order a p)`, + MESON_TAC[ORDER]);; + +let ORDER_POLY = prove + (`!p q a. (poly p = poly q) ==> (order a p = order a q)`, + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[order; divides; FUN_EQ_THM; POLY_MUL]);; + +let ORDER_ROOT = prove + (`!p a. (poly p a = Cx(&0)) <=> (poly p = poly []) \/ ~(order a p = 0)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN + ASM_REWRITE_TAC[poly] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN + ASM_CASES_TAC `p:complex list = []` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:complex list` SUBST_ALL_TAC) THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN + ASM_REWRITE_TAC[poly_exp; DE_MORGAN_THM] THEN DISJ2_TAC THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `q:complex list` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC; + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN + UNDISCH_TAC `~(order a p = 0)` THEN + SPEC_TAC(`order a p`,`n:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; NOT_SUC] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `s:complex list` SUBST1_TAC) THEN + REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC]);; + +let ORDER_DIVIDES = prove + (`!p a n. ([--a; Cx(&1)] exp n) divides p <=> + (poly p = poly []) \/ n <= order a p`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN + ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[divides] THEN EXISTS_TAC `[]:complex list` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]; + ASM_MESON_TAC[ORDER_THM; POLY_EXP_DIVIDES; NOT_LE; LE_SUC_LT]]);; + +let ORDER_DECOMP = prove + (`!p a. ~(poly p = poly []) + ==> ?q. (poly p = poly (([--a; Cx(&1)] exp (order a p)) ** q)) /\ + ~([--a; Cx(&1)] divides q)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_THM) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o SPEC `a:complex`) THEN + DISCH_THEN(X_CHOOSE_TAC `q:complex list` o REWRITE_RULE[divides]) THEN + EXISTS_TAC `q:complex list` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `r: complex list` o REWRITE_RULE[divides]) THEN + UNDISCH_TAC `~([-- a; Cx(&1)] exp SUC (order a p) divides p)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `r:complex list` THEN + ASM_REWRITE_TAC[POLY_MUL; FUN_EQ_THM; poly_exp] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Important composition properties of orders. *) +(* ------------------------------------------------------------------------- *) + +let ORDER_MUL = prove + (`!a p q. ~(poly (p ** q) = poly []) ==> + (order a (p ** q) = order a p + order a q)`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `(order a p + order a q = order a (p ** q)) /\ + ~(poly (p ** q) = poly [])` + MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[GSYM ORDER] THEN CONJ_TAC THENL + [MP_TAC(CONJUNCT1 (SPEC `a:complex` + (MATCH_MP ORDER_THM (ASSUME `~(poly p = poly [])`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `r: complex list` o REWRITE_RULE[divides]) THEN + MP_TAC(CONJUNCT1 (SPEC `a:complex` + (MATCH_MP ORDER_THM (ASSUME `~(poly q = poly [])`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `s: complex list` o REWRITE_RULE[divides]) THEN + REWRITE_TAC[divides; FUN_EQ_THM] THEN EXISTS_TAC `s ** r` THEN + ASM_REWRITE_TAC[POLY_MUL; POLY_EXP_ADD] THEN SIMPLE_COMPLEX_ARITH_TAC; + X_CHOOSE_THEN `r: complex list` STRIP_ASSUME_TAC + (SPEC `a:complex` (MATCH_MP ORDER_DECOMP + (ASSUME `~(poly p = poly [])`))) THEN + X_CHOOSE_THEN `s: complex list` STRIP_ASSUME_TAC + (SPEC `a:complex` (MATCH_MP ORDER_DECOMP + (ASSUME `~(poly q = poly [])`))) THEN + ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_EXP_ADD; POLY_MUL; poly_exp] THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex list` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `[--a; Cx(&1)] divides (r ** s)` MP_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[POLY_PRIMES]] THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `t:complex list` THEN + SUBGOAL_THEN `poly ([-- a; Cx(&1)] exp (order a p) ** r ** s) = + poly ([-- a; Cx(&1)] exp (order a p) ** + ([-- a; Cx(&1)] ** t))` + MP_TAC THENL + [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN + SUBGOAL_THEN `poly ([-- a; Cx(&1)] exp (order a q) ** + [-- a; Cx(&1)] exp (order a p) ** r ** s) = + poly ([-- a; Cx(&1)] exp (order a q) ** + [-- a; Cx(&1)] exp (order a p) ** + [-- a; Cx(&1)] ** t)` + MP_TAC THENL + [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + REWRITE_TAC[COMPLEX_MUL_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Normalization of a polynomial. *) +(* ------------------------------------------------------------------------- *) + +let normalize = new_recursive_definition list_RECURSION + `(normalize [] = []) /\ + (normalize (CONS h t) = + if normalize t = [] then if h = Cx(&0) then [] else [h] + else CONS h (normalize t))`;; + +let POLY_NORMALIZE = prove + (`!p. poly (normalize p) = poly p`, + LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN + ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN + UNDISCH_TAC `poly (normalize t) = poly t` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID]);; + +let LENGTH_NORMALIZE_LE = prove + (`!p. LENGTH(normalize p) <= LENGTH p`, + LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; normalize; LE_REFL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LENGTH; LE_SUC] THEN + COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The degree of a polynomial. *) +(* ------------------------------------------------------------------------- *) + +let degree = new_definition + `degree p = PRE(LENGTH(normalize p))`;; + +let DEGREE_ZERO = prove + (`!p. (poly p = poly []) ==> (degree p = 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[degree] THEN + SUBGOAL_THEN `normalize p = []` SUBST1_TAC THENL + [POP_ASSUM MP_TAC THEN SPEC_TAC(`p:complex list`,`p:complex list`) THEN + REWRITE_TAC[POLY_ZERO] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; ALL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `normalize t = []` (fun th -> REWRITE_TAC[th]) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[LENGTH; PRE]]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the degree is welldefined. *) +(* ------------------------------------------------------------------------- *) + +let POLY_CONS_EQ = prove + (`(poly (CONS h1 t1) = poly (CONS h2 t2)) <=> + (h1 = h2) /\ (poly t1 = poly t2)`, + REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[poly]] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(a = b) <=> (a + --b = Cx(&0))`] THEN + REWRITE_TAC[GSYM POLY_NEG; GSYM POLY_ADD] THEN DISCH_TAC THEN + SUBGOAL_THEN `poly (CONS h1 t1 ++ neg(CONS h2 t2)) = poly []` MP_TAC THENL + [ASM_REWRITE_TAC[poly; FUN_EQ_THM]; ALL_TAC] THEN + REWRITE_TAC[poly_neg; poly_cmul; poly_add; NOT_CONS_NIL; HD; TL] THEN + DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN + SIMP_TAC[poly; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID]);; + +let POLY_NORMALIZE_ZERO = prove + (`!p. (poly p = poly []) <=> (normalize p = [])`, + REWRITE_TAC[POLY_ZERO] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; normalize] THEN + ASM_CASES_TAC `normalize t = []` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_CONS_NIL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL]);; + +let POLY_NORMALIZE_EQ_LEMMA = prove + (`!p q. (poly p = poly q) ==> (normalize p = normalize q)`, + LIST_INDUCT_TAC THENL + [MESON_TAC[POLY_NORMALIZE_ZERO]; ALL_TAC] THEN + LIST_INDUCT_TAC THENL + [MESON_TAC[POLY_NORMALIZE_ZERO]; ALL_TAC] THEN + REWRITE_TAC[POLY_CONS_EQ] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[normalize] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t':complex list`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +let POLY_NORMALIZE_EQ = prove + (`!p q. (poly p = poly q) <=> (normalize p = normalize q)`, + MESON_TAC[POLY_NORMALIZE_EQ_LEMMA; POLY_NORMALIZE]);; + +let DEGREE_WELLDEF = prove + (`!p q. (poly p = poly q) ==> (degree p = degree q)`, + SIMP_TAC[degree; POLY_NORMALIZE_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Degree of a product with a power of linear terms. *) +(* ------------------------------------------------------------------------- *) + +let NORMALIZE_EQ = prove + (`!p. ~(LAST p = Cx(&0)) ==> (normalize p = p)`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN + REWRITE_TAC[normalize; LAST] THEN REPEAT GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[normalize]));; + +let NORMAL_DEGREE = prove + (`!p. ~(LAST p = Cx(&0)) ==> (degree p = LENGTH p - 1)`, + SIMP_TAC[degree; NORMALIZE_EQ] THEN REPEAT STRIP_TAC THEN ARITH_TAC);; + +let LAST_LINEAR_MUL_LEMMA = prove + (`!p a b x. + LAST(a ## p ++ CONS x (b ## p)) = if p = [] then x else b * LAST(p)`, + LIST_INDUCT_TAC THEN + REWRITE_TAC[poly_cmul; poly_add; LAST; HD; TL; NOT_CONS_NIL] THEN + REPEAT GEN_TAC THEN + SUBGOAL_THEN `~(a ## t ++ CONS (b * h) (b ## t) = [])` + ASSUME_TAC THENL + [SPEC_TAC(`t:complex list`,`t:complex list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; + +let LAST_LINEAR_MUL = prove + (`!p. ~(p = []) ==> (LAST([a; Cx(&1)] ** p) = LAST p)`, + SIMP_TAC[poly_mul; NOT_CONS_NIL; LAST_LINEAR_MUL_LEMMA; COMPLEX_MUL_LID]);; + +let NORMAL_NORMALIZE = prove + (`!p. ~(normalize p = []) ==> ~(LAST(normalize p) = Cx(&0))`, + LIST_INDUCT_TAC THEN REWRITE_TAC[normalize] THEN + POP_ASSUM MP_TAC THEN ASM_CASES_TAC `normalize t = []` THEN + ASM_REWRITE_TAC[LAST; NOT_CONS_NIL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LAST]);; + +let LINEAR_MUL_DEGREE = prove + (`!p a. ~(poly p = poly []) ==> (degree([a; Cx(&1)] ** p) = degree(p) + 1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `degree([a; Cx(&1)] ** normalize p) = degree(normalize p) + 1` + MP_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o + GEN_REWRITE_RULE RAND_CONV [POLY_NORMALIZE_ZERO]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NORMAL_NORMALIZE) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LAST_LINEAR_MUL) THEN + SIMP_TAC[NORMAL_DEGREE] THEN REPEAT STRIP_TAC THEN + SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX_NEG_NEG)) THEN + REWRITE_TAC[POLY_LENGTH_MUL] THEN + UNDISCH_TAC `~(normalize p = [])` THEN + SPEC_TAC(`normalize p`,`p:complex list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL; LENGTH] THEN ARITH_TAC; + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN + TRY(AP_THM_TAC THEN AP_TERM_TAC) THEN MATCH_MP_TAC DEGREE_WELLDEF THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_NORMALIZE]]);; + +let LINEAR_POW_MUL_DEGREE = prove + (`!n a p. degree([a; Cx(&1)] exp n ** p) = + if poly p = poly [] then 0 else degree p + n`, + INDUCT_TAC THEN REWRITE_TAC[poly_exp] THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree(p)` THEN CONJ_TAC THENL + [MATCH_MP_TAC DEGREE_WELLDEF THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO; + COMPLEX_ADD_RID; COMPLEX_MUL_LID]; + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `degree []` THEN CONJ_TAC THENL + [MATCH_MP_TAC DEGREE_WELLDEF THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[degree; LENGTH; normalize; ARITH]]]; + REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC DEGREE_WELLDEF THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO; + COMPLEX_ADD_RID; COMPLEX_MUL_LID]]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `degree([a; Cx (&1)] exp n ** ([a; Cx (&1)] ** p))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DEGREE_WELLDEF THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_AC]; ALL_TAC] THEN + ASM_REWRITE_TAC[POLY_ENTIRE] THEN + ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[LINEAR_MUL_DEGREE] THEN + SUBGOAL_THEN `~(poly [a; Cx (&1)] = poly [])` + (fun th -> REWRITE_TAC[th] THEN ARITH_TAC) THEN + REWRITE_TAC[POLY_NORMALIZE_EQ] THEN + REWRITE_TAC[normalize; CX_INJ; REAL_OF_NUM_EQ; ARITH; NOT_CONS_NIL]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the order of a root (or nonroot!) is bounded by degree. *) +(* ------------------------------------------------------------------------- *) + +let ORDER_DEGREE = prove + (`!a p. ~(poly p = poly []) ==> order a p <= degree p`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_THM) THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[divides] o CONJUNCT1) THEN + DISCH_THEN(X_CHOOSE_THEN `q:complex list` ASSUME_TAC) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN + ASM_REWRITE_TAC[LINEAR_POW_MUL_DEGREE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[POLY_MUL] THENL + [UNDISCH_TAC `~(poly p = poly [])` THEN + SIMP_TAC[FUN_EQ_THM; POLY_MUL; poly; COMPLEX_MUL_RZERO]; + DISCH_TAC THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Tidier versions of finiteness of roots. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ROOTS_FINITE_SET = prove + (`!p. ~(poly p = poly []) ==> FINITE { x | poly p x = Cx(&0)}`, + GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `i:num->complex` ASSUME_TAC) THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:complex | ?n:num. n < N /\ (x = i n)}` THEN + CONJ_TAC THENL + [SPEC_TAC(`N:num`,`N:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + INDUCT_TAC THENL + [SUBGOAL_THEN `{x:complex | ?n. n < 0 /\ (x = i n)} = {}` + (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; + SUBGOAL_THEN `{x:complex | ?n. n < SUC N /\ (x = i n)} = + (i N) INSERT {x:complex | ?n. n < N /\ (x = i n)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LT] THEN MESON_TAC[]; + MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN ASM_REWRITE_TAC[]]]; + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM]]);; + +(* ------------------------------------------------------------------------- *) +(* Conversions to perform operations if coefficients are rational constants. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_RAT_MUL_CONV = + GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; + +let COMPLEX_RAT_ADD_CONV = + GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; + +let COMPLEX_RAT_EQ_CONV = + GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;; + +let POLY_CMUL_CONV = + let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul] + and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] in + let rec POLY_CMUL_CONV tm = + (cmul_conv0 ORELSEC + (cmul_conv1 THENC + LAND_CONV COMPLEX_RAT_MUL_CONV THENC + RAND_CONV POLY_CMUL_CONV)) tm in + POLY_CMUL_CONV;; + +let POLY_ADD_CONV = + let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES)) + and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] in + let rec POLY_ADD_CONV tm = + (add_conv0 ORELSEC + (add_conv1 THENC + LAND_CONV COMPLEX_RAT_ADD_CONV THENC + RAND_CONV POLY_ADD_CONV)) tm in + POLY_ADD_CONV;; + +let POLY_MUL_CONV = + let mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES] + and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)] + and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] in + let rec POLY_MUL_CONV tm = + (mul_conv0 ORELSEC + (mul_conv1 THENC POLY_CMUL_CONV) ORELSEC + (mul_conv2 THENC + LAND_CONV POLY_CMUL_CONV THENC + RAND_CONV(RAND_CONV POLY_MUL_CONV) THENC + POLY_ADD_CONV)) tm in + POLY_MUL_CONV;; + +let POLY_NORMALIZE_CONV = + let pth = prove + (`normalize (CONS h t) = + (\n. if n = [] then if h = Cx(&0) then [] else [h] else CONS h n) + (normalize t)`, + REWRITE_TAC[normalize]) in + let norm_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 normalize] + and norm_conv1 = GEN_REWRITE_CONV I [pth] + and norm_conv2 = GEN_REWRITE_CONV DEPTH_CONV + [COND_CLAUSES; NOT_CONS_NIL; EQT_INTRO(SPEC_ALL EQ_REFL)] in + let rec POLY_NORMALIZE_CONV tm = + (norm_conv0 ORELSEC + (norm_conv1 THENC + RAND_CONV POLY_NORMALIZE_CONV THENC + BETA_CONV THENC + RATOR_CONV(RAND_CONV(RATOR_CONV(LAND_CONV COMPLEX_RAT_EQ_CONV))) THENC + norm_conv2)) tm in + POLY_NORMALIZE_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Now we're finished with polynomials... *) +(* ------------------------------------------------------------------------- *) + +(************** keep this for now + +do_list reduce_interface + ["divides",`poly_divides:complex list->complex list->bool`; + "exp",`poly_exp:complex list -> num -> complex list`; + "diff",`poly_diff:complex list->complex list`];; + +unparse_as_infix "exp";; + + ****************) diff --git a/Complex/fundamental.ml b/Complex/fundamental.ml new file mode 100644 index 0000000..bc72df1 --- /dev/null +++ b/Complex/fundamental.ml @@ -0,0 +1,683 @@ +(* ========================================================================= *) +(* Fundamental theorem of algebra. *) +(* ========================================================================= *) + +needs "Complex/complex_transc.ml";; +needs "Complex/cpoly.ml";; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* A cute trick to reduce magnitude of unimodular number. *) +(* ------------------------------------------------------------------------- *) + +let SQRT_SOS_LT_1 = prove + (`!x y. sqrt(x pow 2 + y pow 2) < &1 <=> x pow 2 + y pow 2 < &1`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN + REWRITE_TAC[REAL_POW_2] THEN + SIMP_TAC[SQRT_MONO_LT_EQ; REAL_POS; REAL_LE_ADD; REAL_LE_SQUARE]);; + +let SQRT_SOS_EQ_1 = prove + (`!x y. (sqrt(x pow 2 + y pow 2) = &1) <=> (x pow 2 + y pow 2 = &1)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN + REWRITE_TAC[REAL_POW_2] THEN + SIMP_TAC[SQRT_INJ; REAL_POS; REAL_LE_ADD; REAL_LE_SQUARE]);; + +let UNIMODULAR_REDUCE_NORM = prove + (`!z. (norm(z) = &1) + ==> norm(z + Cx(&1)) < &1 \/ + norm(z - Cx(&1)) < &1 \/ + norm(z + ii) < &1 \/ + norm(z - ii) < &1`, + GEN_TAC THEN + REWRITE_TAC[ii; CX_DEF; complex_add; complex_sub; complex_neg; complex_norm; + RE; IM; REAL_ADD_RID; REAL_NEG_0; SQRT_SOS_LT_1; SQRT_SOS_EQ_1] THEN + SIMP_TAC[REAL_POW_2; + REAL_ARITH `a * a + (b + c) * (b + c) = + (a * a + b * b) + (&2 * b * c + c * c)`; + REAL_ARITH `(b + c) * (b + c) + a * a = + (b * b + a * a) + (&2 * b * c + c * c)`] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `&1 + x < &1 <=> &0 < --x`] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_ARITH + `~(abs(a) <= &1 /\ abs(b) <= &1) + ==> &0 < --a + --(&1) \/ &0 < a + --(&1) \/ + &0 < --b + --(&1) \/ &0 < b + --(&1)`) THEN + STRIP_TAC THEN UNDISCH_TAC `Re z * Re z + Im z * Im z = &1` THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `(&2 * r) * (&2 * r) <= &1 /\ (&2 * i) * (&2 * i) <= &1 + ==> ~(r * r + i * i = &1)`) THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + ASM_SIMP_TAC[REAL_POW_1_LE; REAL_ABS_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we can always reduce modulus of 1 + b z^n if nonzero *) +(* ------------------------------------------------------------------------- *) + +let REDUCE_POLY_SIMPLE = prove + (`!b n. ~(b = Cx(&0)) /\ ~(n = 0) + ==> ?z. norm(Cx(&1) + b * z pow n) < &1`, + GEN_TAC THEN MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `EVEN(n)` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_SIMP_TAC[ARITH_RULE `~(2 * m = 0) ==> m < 2 * m /\ ~(m = 0)`] THEN + DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN EXISTS_TAC `csqrt w` THEN + ASM_REWRITE_TAC[GSYM COMPLEX_POW_POW; CSQRT]; ALL_TAC] THEN + MP_TAC(SPEC `Cx(norm b) / b` UNIMODULAR_REDUCE_NORM) THEN ANTS_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[COMPLEX_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO]; + ALL_TAC] THEN DISCH_TAC THEN + SUBGOAL_THEN `?v. norm(Cx(norm b) / b + v pow n) < &1` MP_TAC THENL + [SUBGOAL_THEN `(Cx(&1) pow n = Cx(&1)) /\ + (--Cx(&1) pow n = --Cx(&1)) /\ + (((ii pow n = ii) /\ (--ii pow n = --ii)) \/ + ((ii pow n = --ii) /\ (--ii pow n = ii)))` + MP_TAC THENL + [ALL_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[complex_sub]) THEN ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN + SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[complex_pow; COMPLEX_POW_NEG; EVEN; EVEN_MULT; ARITH_EVEN] THEN + REWRITE_TAC[GSYM COMPLEX_POW_POW] THEN + REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_POW_II_2; COMPLEX_MUL_LID; + COMPLEX_POW_NEG] THEN + COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:complex` ASSUME_TAC) THEN + EXISTS_TAC `v / Cx(root(n) (norm b))` THEN + REWRITE_TAC[COMPLEX_POW_DIV; GSYM CX_POW] THEN + SUBGOAL_THEN `root n (norm b) pow n = norm b` SUBST1_TAC THENL + [UNDISCH_TAC `~(EVEN n)` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN SIMP_TAC[EVEN; ROOT_POW_POS; COMPLEX_NORM_POS]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `norm(Cx(norm b) / b)` THEN + REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_ADD_LDISTRIB] THEN + REWRITE_TAC[COMPLEX_MUL_RID; REAL_MUL_RID] THEN + SUBGOAL_THEN `norm(Cx(norm b) / b) = &1` SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; COMPLEX_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; COMPLEX_NORM_ZERO]; ALL_TAC] THEN + REWRITE_TAC[REAL_LT_01; complex_div] THEN + ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC + `(m * b') * b * p * m' = (m * m') * (b * b') * p`] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LID; + CX_INJ; COMPLEX_NORM_ZERO] THEN + ASM_REWRITE_TAC[GSYM complex_div]);; + +(* ------------------------------------------------------------------------- *) +(* Basic lemmas about polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_CMUL_MAP = prove + (`!p c x. poly (MAP (( * ) c) p) x = c * poly p x`, + LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; poly; COMPLEX_MUL_RZERO] THEN + ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; + +let POLY_0 = prove + (`!p x. ALL (\b. b = Cx(&0)) p ==> (poly p x = Cx(&0))`, + LIST_INDUCT_TAC THEN + ASM_SIMP_TAC[ALL; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]);; + +let POLY_BOUND_EXISTS = prove + (`!p r. ?m. &0 < m /\ !z. norm(z) <= r ==> norm(poly p z) <= m`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + LIST_INDUCT_TAC THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[poly; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_LT_01; REAL_POS]; ALL_TAC] THEN + POP_ASSUM(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&1 + norm(h) + abs(r * m)` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 < &1 + x + y`; + REAL_ABS_POS; COMPLEX_NORM_POS] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + REWRITE_TAC[poly] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(h) + norm(z * poly t z)` THEN + REWRITE_TAC[COMPLEX_NORM_TRIANGLE] THEN + MATCH_MP_TAC(REAL_ARITH `y <= z ==> x + y <= &1 + x + abs(z)`) THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[COMPLEX_NORM_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Offsetting the variable in a polynomial gives another of same degree. *) +(* ------------------------------------------------------------------------- *) + +let POLY_OFFSET_LEMMA = prove + (`!a p. ?b q. (LENGTH q = LENGTH p) /\ + !x. poly (CONS b q) x = (a + x) * poly p x`, + GEN_TAC THEN LIST_INDUCT_TAC THENL + [EXISTS_TAC `Cx(&0)` THEN EXISTS_TAC `[]:complex list` THEN + REWRITE_TAC[poly; LENGTH; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]; + ALL_TAC] THEN + POP_ASSUM STRIP_ASSUME_TAC THEN + EXISTS_TAC `a * h` THEN EXISTS_TAC `CONS (b + h) q` THEN + ASM_REWRITE_TAC[LENGTH; poly] THEN X_GEN_TAC `x:complex ` THEN + FIRST_ASSUM(MP_TAC o SPEC `x:complex`) THEN + REWRITE_TAC[poly] THEN DISCH_THEN(MP_TAC o AP_TERM `( * ) x`) THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let POLY_OFFSET = prove + (`!a p. ?q. (LENGTH q = LENGTH p) /\ !x. poly q x = poly p (a + x)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; poly] THENL + [EXISTS_TAC `[]:complex list` THEN REWRITE_TAC[poly; LENGTH]; ALL_TAC] THEN + POP_ASSUM(X_CHOOSE_THEN `p:complex list` (STRIP_ASSUME_TAC o GSYM)) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`a:complex`; `p:complex list`] POLY_OFFSET_LEMMA) THEN + DISCH_THEN(X_CHOOSE_THEN `b:complex` (X_CHOOSE_THEN `r: complex list` + (STRIP_ASSUME_TAC o GSYM))) THEN + EXISTS_TAC `CONS (h + b) r` THEN ASM_REWRITE_TAC[LENGTH] THEN + REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Bolzano-Weierstrass type property for closed disc in complex plane. *) +(* ------------------------------------------------------------------------- *) + +let METRIC_BOUND_LEMMA = prove + (`!x y. norm(x - y) <= abs(Re(x) - Re(y)) + abs(Im(x) - Im(y))`, + REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm] THEN + MATCH_MP_TAC(REAL_ARITH + `a <= abs(abs x + abs y) ==> a <= abs x + abs y`) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM POW_2_SQRT_ABS] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN + REWRITE_TAC[complex_add; complex_sub; complex_neg; RE; IM] THEN + REWRITE_TAC[GSYM real_sub] THEN + REWRITE_TAC[REAL_ARITH `(a + b) * (a + b) = a * a + b * b + &2 * a * b`] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ARITH `a + b <= abs a + abs b + &2 * abs c`]);; + +let BOLZANO_WEIERSTRASS_COMPLEX_DISC = prove + (`!s r. (!n. norm(s n) <= r) + ==> ?f z. subseq f /\ + !e. &0 < e ==> ?N. !n. n >= N ==> norm(s(f n) - z) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `Re o (s:num->complex)` SEQ_MONOSUB) THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->num` MP_TAC) THEN + REWRITE_TAC[o_THM] THEN STRIP_TAC THEN + MP_TAC(SPEC `Im o (s:num->complex) o (f:num->num)` SEQ_MONOSUB) THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->num` MP_TAC) THEN + REWRITE_TAC[o_THM] THEN STRIP_TAC THEN + EXISTS_TAC `(f:num->num) o (g:num->num)` THEN + SUBGOAL_THEN `convergent (\n. Re(s(f n :num))) /\ + convergent (\n. Im(s((f:num->num)(g n))))` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC SEQ_BCONV THEN ASM_REWRITE_TAC[bounded] THEN + MAP_EVERY EXISTS_TAC [`r + &1`; `&0`; `0`] THEN + REWRITE_TAC[GE; LE_0; MR1_DEF; REAL_SUB_LZERO; REAL_ABS_NEG] THEN + X_GEN_TAC `n:num` THEN + W(fun (_,w) -> FIRST_ASSUM(MP_TAC o SPEC (funpow 3 rand (lhand w)))) THEN + REWRITE_TAC[complex_norm] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b <= r ==> a < r + &1`) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM POW_2_SQRT_ABS] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LE_ADDR; REAL_LE_ADDL]; + ALL_TAC] THEN + REWRITE_TAC[convergent; SEQ; GE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `x:real`) (X_CHOOSE_TAC `y:real`)) THEN + EXISTS_TAC `complex(x,y)` THEN CONJ_TAC THENL + [MAP_EVERY UNDISCH_TAC [`subseq f`; `subseq g`] THEN + REWRITE_TAC[subseq; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC + `!e. &0 < e + ==> (?N. !n. N <= n ==> abs(Re(s ((f:num->num) n)) - x) < e)` THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * e / &2` THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH; REAL_LE_REFL]] THEN + W(MP_TAC o PART_MATCH lhand METRIC_BOUND_LEMMA o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH + `a < c /\ b < c ==> x <= a + b ==> x < &2 * c`) THEN + REWRITE_TAC[o_THM; RE; IM] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[LE_ADD; SEQ_SUBLE; LE_TRANS; ADD_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Polynomial is continuous. *) +(* ------------------------------------------------------------------------- *) + +let POLY_CONT = prove + (`!p z e. &0 < e + ==> ?d. &0 < d /\ !w. &0 < norm(w - z) /\ norm(w - z) < d + ==> norm(poly p w - poly p z) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`z:complex`; `p:complex list`] POLY_OFFSET) THEN + DISCH_THEN(X_CHOOSE_THEN `q:complex list` (MP_TAC o CONJUNCT2)) THEN + DISCH_THEN(MP_TAC o GEN `w:complex` o SYM o SPEC `w - z`) THEN + REWRITE_TAC[COMPLEX_SUB_ADD2] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN + REWRITE_TAC[COMPLEX_SUB_REFL] THEN + SPEC_TAC(`q:complex list`,`p:complex list`) THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly] THENL + [EXISTS_TAC `e:real` THEN + ASM_REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_CX; REAL_ABS_NUM]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; COMPLEX_ADD_SUB] THEN + MP_TAC(SPECL [`t:complex list`; `&1`] POLY_BOUND_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`&1`; `e / m:real`] REAL_DOWN2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_01] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN + STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d * m:real` THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_MESON_TAC[REAL_LT_TRANS; REAL_LT_IMP_LE; COMPLEX_NORM_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a polynomial attains minimum on a closed disc in the complex plane. *) +(* ------------------------------------------------------------------------- *) + +let POLY_MINIMUM_MODULUS_DISC = prove + (`!p r. ?z. !w. norm(w) <= r ==> norm(poly p z) <= norm(poly p w)`, + let lemma = prove + (`P /\ (m = --x) /\ --x < y <=> (--x = m) /\ P /\ m < y`, + MESON_TAC[]) in + REPEAT GEN_TAC THEN + ASM_CASES_TAC `&0 <= r` THENL + [ALL_TAC; ASM_MESON_TAC[COMPLEX_NORM_POS; REAL_LE_TRANS]] THEN + MP_TAC(SPEC `\x. ?z. norm(z) <= r /\ (norm(poly p z) = --x)` + REAL_SUP_EXISTS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`--norm(poly p (Cx(&0)))`; `Cx(&0)`] THEN + ASM_REWRITE_TAC[REAL_NEG_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM]; + EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_ARITH `(a = --b) <=> (--b = a:real)`] THEN + REWRITE_TAC[REAL_ARITH `x < &1 <=> --(&1) < --x`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[REAL_ARITH `&0 <= x ==> --(&1) < x`; COMPLEX_NORM_POS]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real` MP_TAC) THEN + ONCE_REWRITE_TAC[REAL_ARITH `a < b <=> --b < --a:real`] THEN + ABBREV_TAC `m = --s:real` THEN + DISCH_THEN(MP_TAC o GEN `y:real` o SPEC `--y:real`) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; lemma] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(--a = b) <=> (a = --b:real)`] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `m:real` th)) THEN + REWRITE_TAC[REAL_LT_REFL; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN + REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `m + inv(&(SUC n))`) THEN + REWRITE_TAC[REAL_LT_ADDR; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0] THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`s:num->complex`; `r:real`] + BOLZANO_WEIERSTRASS_COMPLEX_DISC) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->num` (X_CHOOSE_THEN `z:complex` + STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `z:complex` THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `norm(poly p z) = m` (fun th -> ASM_SIMP_TAC[th]) THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(a - b)) ==> (a = b)`) THEN DISCH_TAC THEN + ABBREV_TAC `e = abs(norm(poly p z) - m)` THEN + MP_TAC(SPECL [`p:complex list`; `z:complex`; `e / &2`] POLY_CONT) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!w. norm(w - z) < d ==> norm(poly p w - poly p z) < e / &2` + MP_TAC THENL + [X_GEN_TAC `u:complex` THEN + ASM_CASES_TAC `u = z:complex` THEN + ASM_SIMP_TAC[COMPLEX_SUB_REFL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0]; ALL_TAC] THEN + FIRST_ASSUM(K ALL_TAC o check (is_conj o lhand o + snd o dest_forall o concl)) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` ASSUME_TAC) THEN + MP_TAC(SPEC `&2 / e` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN + SUBGOAL_THEN `norm(poly p (s((f:num->num) (N1 + N2))) - poly p z) < e / &2` + MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[LE_ADD]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!m. abs(norm(psfn) - m) < e2 /\ + &2 * e2 <= abs(norm(psfn) - m) + norm(psfn - pz) + ==> norm(psfn - pz) < e2 ==> F`) THEN + EXISTS_TAC `m:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&(SUC(N1 + N2)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `m <= x /\ x < m + e ==> abs(x - m:real) < e`) THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `m + inv(&(SUC(f(N1 + N2:num))))` THEN + ASM_REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0; LE_SUC; SEQ_SUBLE]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N2` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]; ALL_TAC] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + EXPAND_TAC "e" THEN + MATCH_MP_TAC(REAL_ARITH + `abs(norm(psfn) - norm(pz)) <= norm(psfn - pz) + ==> abs(norm(pz) - m) <= abs(norm(psfn) - m) + norm(psfn - pz)`) THEN + REWRITE_TAC[COMPLEX_NORM_ABS_NORM]);; + +(* ------------------------------------------------------------------------- *) +(* Nonzero polynomial in z goes to infinity as z does. *) +(* ------------------------------------------------------------------------- *) + +let POLY_INFINITY = prove + (`!p a. EX (\b. ~(b = Cx(&0))) p + ==> !d. ?r. !z. r <= norm(z) ==> d <= norm(poly (CONS a p) z)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[EX] THEN X_GEN_TAC `a:complex` THEN + ASM_CASES_TAC `EX (\b. ~(b = Cx(&0))) t` THEN ASM_REWRITE_TAC[] THENL + [X_GEN_TAC `d:real` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `r:real` o SPEC `d + norm(a)`) THEN + EXISTS_TAC `&1 + abs(r)` THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[poly] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(z * poly (CONS h t) z) - norm(a)` THEN CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + REWRITE_TAC[REAL_LE_SUB_RADD; COMPLEX_NORM_TRIANGLE_SUB]] THEN + REWRITE_TAC[REAL_LE_SUB_LADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * norm(poly (CONS h t) z)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `&1 + abs(r) <= x ==> r <= x`]; + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[COMPLEX_NORM_POS] THEN + ASM_MESON_TAC[REAL_ARITH `&1 + abs(r) <= x ==> &1 <= x`]]; + RULE_ASSUM_TAC(REWRITE_RULE[NOT_EX]) THEN + ASM_SIMP_TAC[poly; POLY_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + DISCH_TAC THEN X_GEN_TAC `d:real` THEN + EXISTS_TAC `(abs(d) + norm(a)) / norm(h)` THEN X_GEN_TAC `z:complex` THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `mzh <= mazh + ma ==> abs(d) + ma <= mzh ==> d <= mazh`) THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + REWRITE_TAC[COMPLEX_NORM_TRIANGLE_SUB]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence polynomial's modulus attains its minimum somewhere. *) +(* ------------------------------------------------------------------------- *) + +let POLY_MINIMUM_MODULUS = prove + (`!p. ?z. !w. norm(poly p z) <= norm(poly p w)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly; REAL_LE_REFL] THEN + ASM_CASES_TAC `EX (\b. ~(b = Cx(&0))) t` THENL + [FIRST_ASSUM(MP_TAC o SPEC `h:complex` o MATCH_MP POLY_INFINITY) THEN + DISCH_THEN(MP_TAC o SPEC `norm(poly (CONS h t) (Cx(&0)))`) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` ASSUME_TAC) THEN + MP_TAC(SPECL [`CONS (h:complex) t`; `abs(r)`] + POLY_MINIMUM_MODULUS_DISC) THEN + REWRITE_TAC[GSYM(CONJUNCT2 poly)] THEN + ASM_MESON_TAC[REAL_ARITH `r <= z \/ z <= abs(r)`; REAL_LE_TRANS; + COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_POS]; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN + REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o MATCH_MP POLY_0) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Constant function (non-syntactic characterization). *) +(* ------------------------------------------------------------------------- *) + +let constant = new_definition + `constant f = !w z. f(w) = f(z)`;; + +let NONCONSTANT_LENGTH = prove + (`!p. ~constant(poly p) ==> 2 <= LENGTH p`, + REWRITE_TAC[constant] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[poly] THEN + REWRITE_TAC[LENGTH; ARITH_RULE `2 <= SUC n <=> ~(n = 0)`] THEN + SIMP_TAC[TAUT `~a ==> ~b <=> b ==> a`; LENGTH_EQ_NIL; poly] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Decomposition of polynomial, skipping zero coefficients after the first. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DECOMPOSE_LEMMA = prove + (`!p. ~(!z. ~(z = Cx(&0)) ==> (poly p z = Cx(&0))) + ==> ?k a q. ~(a = Cx(&0)) /\ + (SUC(LENGTH q + k) = LENGTH p) /\ + !z. poly p z = z pow k * poly (CONS a q) z`, + LIST_INDUCT_TAC THENL [REWRITE_TAC[poly]; ALL_TAC] THEN + ASM_CASES_TAC `h = Cx(&0)` THENL + [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [poly] THEN + ASM_SIMP_TAC[COMPLEX_ADD_LID; COMPLEX_ENTIRE] THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex` + (X_CHOOSE_THEN `q:complex list` STRIP_ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC [`k + 1`; `a:complex`; `q:complex list`] THEN + ASM_REWRITE_TAC[poly; LENGTH; GSYM ADD1; ADD_CLAUSES] THEN + REWRITE_TAC[COMPLEX_ADD_LID; complex_pow; GSYM COMPLEX_MUL_ASSOC]; + DISCH_THEN(K ALL_TAC) THEN + MAP_EVERY EXISTS_TAC [`0`; `h:complex`; `t:complex list`] THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; ADD_CLAUSES; LENGTH]]);; + +let POLY_DECOMPOSE = prove + (`!p. ~constant(poly p) + ==> ?k a q. ~(a = Cx(&0)) /\ ~(k = 0) /\ + (LENGTH q + k + 1 = LENGTH p) /\ + !z. poly p z = poly p (Cx(&0)) + + z pow k * poly (CONS a q) z`, + LIST_INDUCT_TAC THENL [REWRITE_TAC[constant; poly]; ALL_TAC] THEN + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN + MP_TAC(SPEC `t:complex list` POLY_DECOMPOSE_LEMMA) THEN ANTS_TAC THENL + [POP_ASSUM MP_TAC THEN REWRITE_TAC[constant; poly] THEN + REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`; COMPLEX_EQ_ADD_LCANCEL] THEN + SIMP_TAC[TAUT `~a ==> b <=> a \/ b`; GSYM COMPLEX_ENTIRE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex` + (X_CHOOSE_THEN `q:complex list` STRIP_ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC [`SUC k`; `a:complex`; `q:complex list`] THEN + ASM_REWRITE_TAC[ADD_CLAUSES; GSYM ADD1; LENGTH; NOT_SUC] THEN + ASM_REWRITE_TAC[poly; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; complex_pow] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC]);; + +let POLY_REPLICATE_APPEND = prove + (`!n p x. poly (APPEND (REPLICATE n (Cx(&0))) p) x = x pow n * poly p x`, + INDUCT_TAC THEN + REWRITE_TAC[REPLICATE; APPEND; complex_pow; COMPLEX_MUL_LID] THEN + ASM_REWRITE_TAC[poly; COMPLEX_ADD_LID] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Fundamental theorem. *) +(* ------------------------------------------------------------------------- *) + +let FUNDAMENTAL_THEOREM_OF_ALGEBRA = prove + (`!p. ~constant(poly p) ==> ?z. poly p z = Cx(&0)`, + SUBGOAL_THEN + `!n p. (LENGTH p = n) /\ ~constant(poly p) ==> ?z. poly p z = Cx(&0)` + (fun th -> MESON_TAC[th]) THEN + MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + X_GEN_TAC `p:complex list` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NONCONSTANT_LENGTH) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + X_CHOOSE_TAC `c:complex` (SPEC `p:complex list` POLY_MINIMUM_MODULUS) THEN + ASM_CASES_TAC `poly p c = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`c:complex`; `p:complex list`] POLY_OFFSET) THEN + DISCH_THEN(X_CHOOSE_THEN `q:complex list` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) ASSUME_TAC) THEN + SUBGOAL_THEN `~constant(poly q)` ASSUME_TAC THENL + [UNDISCH_TAC `~(constant(poly p))` THEN + SUBGOAL_THEN `!z. poly q (z - c) = poly p z` + (fun th -> MESON_TAC[th; constant]) THEN + ASM_MESON_TAC[SIMPLE_COMPLEX_ARITH `a + (x - a) = x`]; ALL_TAC] THEN + SUBGOAL_THEN `poly p c = poly q (Cx(&0))` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN + SUBGOAL_THEN `!w. norm(poly q (Cx(&0))) <= norm(poly q w)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + POP_ASSUM_LIST(MAP_EVERY (fun th -> + if free_in `p:complex list` (concl th) + then ALL_TAC else ASSUME_TAC th)) THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN + ABBREV_TAC `a0 = poly q (Cx(&0))` THEN + SUBGOAL_THEN + `!z. poly q z = poly (MAP (( * ) (inv(a0))) q) z * a0` + ASSUME_TAC THENL + [REWRITE_TAC[POLY_CMUL_MAP] THEN + ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `(a * b) * c = b * c * a`] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_RID]; + ALL_TAC] THEN + ABBREV_TAC `r = MAP (( * ) (inv(a0))) q` THEN + SUBGOAL_THEN `LENGTH(q:complex list) = LENGTH(r:complex list)` + SUBST_ALL_TAC THENL + [EXPAND_TAC "r" THEN REWRITE_TAC[LENGTH_MAP]; ALL_TAC] THEN + SUBGOAL_THEN `~(constant(poly r))` ASSUME_TAC THENL + [UNDISCH_TAC `~constant(poly q)` THEN + ASM_REWRITE_TAC[constant; COMPLEX_EQ_MUL_RCANCEL] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `poly r (Cx(&0)) = Cx(&1)` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM COMPLEX_MUL_LID] THEN + ASM_SIMP_TAC[COMPLEX_EQ_MUL_RCANCEL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + POP_ASSUM_LIST(MAP_EVERY (fun th -> + if free_in `q:complex list` (concl th) + then ALL_TAC else ASSUME_TAC th)) THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; COMPLEX_NORM_NZ; COMPLEX_NORM_MUL; + REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLY_DECOMPOSE) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (X_CHOOSE_THEN `a:complex` + (X_CHOOSE_THEN `s:complex list` MP_TAC))) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) MP_TAC) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `k + 1 = n` THENL + [UNDISCH_TAC `LENGTH(s:complex list) + k + 1 = n` THEN + ASM_REWRITE_TAC[ARITH_RULE `(s + m = m) <=> (s = 0)`; LENGTH_EQ_NIL] THEN + REWRITE_TAC[LENGTH_EQ_NIL] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + MATCH_MP_TAC REDUCE_POLY_SIMPLE THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC [`k + 1 = n`; `2 <= n`] THEN ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k + 1`) THEN ANTS_TAC THENL + [UNDISCH_TAC `~(k + 1 = n)` THEN + UNDISCH_TAC `LENGTH(s:complex list) + k + 1 = n` THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC + `CONS (Cx(&1)) (APPEND (REPLICATE (k - 1) (Cx(&0))) [a])`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[LENGTH; LENGTH_APPEND; LENGTH_REPLICATE] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[constant; POLY_REPLICATE_APPEND; poly] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(&1)`]) THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_POW_ONE; SIMPLE_COMPLEX_ARITH + `(a = a + b) <=> (b = Cx(&0))`] THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; ALL_TAC] THEN + REWRITE_TAC[constant; POLY_REPLICATE_APPEND; poly] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `a * b * c = (a * b) * c`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 complex_pow)] THEN + ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> (SUC(k - 1) = k)`] THEN + DISCH_THEN(X_CHOOSE_TAC `w:complex`) THEN + MP_TAC(SPECL [`s:complex list`; `norm(w)`] POLY_BOUND_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(w = Cx(&0))` ASSUME_TAC THENL + [UNDISCH_TAC `Cx(&1) + w pow k * a = Cx(&0)` THEN + ONCE_REWRITE_TAC[TAUT `a ==> ~b <=> b ==> ~a`] THEN + DISCH_THEN SUBST1_TAC THEN + UNDISCH_TAC `~(k = 0)` THEN SPEC_TAC(`k:num`,`k:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_ADD_RID; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + MP_TAC(SPECL [`&1`; `inv(norm(w) pow (k + 1) * m)`] REAL_DOWN2) THEN + ASM_SIMP_TAC[REAL_LT_01; REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT; + COMPLEX_NORM_NZ] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Cx(t) * w` THEN REWRITE_TAC[COMPLEX_POW_MUL] THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB; GSYM COMPLEX_MUL_ASSOC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SIMPLE_COMPLEX_ARITH + `(a + w = Cx(&0)) ==> (w = --a)`)) THEN + REWRITE_TAC[GSYM CX_NEG; GSYM CX_POW; GSYM CX_MUL] THEN + REWRITE_TAC[COMPLEX_ADD_ASSOC; GSYM CX_ADD] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm(Cx(&1 + t pow k * -- &1)) + + norm(Cx(t pow k) * w pow k * Cx t * w * poly s (Cx t * w))` THEN + REWRITE_TAC[COMPLEX_NORM_TRIANGLE] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x < t /\ t <= &1 ==> abs(&1 + t * --(&1)) + x < &1`) THEN + REWRITE_TAC[COMPLEX_NORM_POS] THEN + ASM_SIMP_TAC[REAL_POW_1_LE; REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_MUL] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POW_LE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_SIMP_TAC[REAL_POW_LT] THEN + ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC `a * b * c * d = b * (c * a) * d`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 complex_pow)] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; ADD1; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs t * norm(w pow (k + 1)) * m` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN + FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[COMPLEX_NORM_POS] THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ARITH + `&0 < t /\ t < &1 ==> abs(t) <= &1`]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; COMPLEX_NORM_POW; + REAL_POW_LT; COMPLEX_NORM_NZ] THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; + REAL_ARITH `&0 < t /\ t < x ==> abs(t) < x`]);; + +(* ------------------------------------------------------------------------- *) +(* Alternative version with a syntactic notion of constant polynomial. *) +(* ------------------------------------------------------------------------- *) + +let FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT = prove + (`!p. ~(?a l. ~(a = Cx(&0)) /\ ALL (\b. b = Cx(&0)) l /\ (p = CONS a l)) + ==> ?z. poly p z = Cx(&0)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly; CONS_11] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + ONCE_REWRITE_TAC[AC CONJ_ACI `a /\ b /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + ASM_CASES_TAC `h = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_ADD_LID] THENL + [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]; ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 poly)] THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_ALGEBRA THEN + UNDISCH_TAC `~ALL (\b. b = Cx (&0)) t` THEN + REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[constant; poly; REAL_EQ_LADD] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&0)` o ONCE_REWRITE_RULE[SWAP_FORALL_THM]) THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[COMPLEX_ENTIRE; TAUT `a \/ b <=> ~a ==> b`] THEN + SPEC_TAC(`t:complex list`,`p:complex list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[ALL] THEN + ASM_CASES_TAC `h = Cx(&0)` THEN + ASM_SIMP_TAC[poly; COMPLEX_ADD_LID; COMPLEX_ENTIRE] THEN + MP_TAC(SPECL [`t:complex list`; `&1`] POLY_BOUND_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`norm(h) / m`; `&1`] REAL_DOWN2) THEN + ASM_SIMP_TAC[REAL_LT_01; REAL_LT_DIV; COMPLEX_NORM_NZ] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(x)`) THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(x + y = Cx(&0)) <=> (y = --x)`] THEN + DISCH_THEN(MP_TAC o AP_TERM `norm`) THEN REWRITE_TAC[COMPLEX_NORM_NEG] THEN + MATCH_MP_TAC(REAL_ARITH `abs(a) < abs(b) ==> ~(a = b)`) THEN + REWRITE_TAC[real_abs; COMPLEX_NORM_POS] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(h) / m * m` THEN + CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[REAL_LE_REFL; REAL_DIV_RMUL; REAL_LT_IMP_NZ]] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) * m` THEN + ASM_SIMP_TAC[REAL_LT_RMUL; REAL_ARITH `&0 < x /\ x < a ==> abs(x) < a`] THEN + ASM_MESON_TAC[REAL_LE_LMUL; REAL_ABS_POS; COMPLEX_NORM_CX; + REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`]);; diff --git a/Complex/grobner_examples.ml b/Complex/grobner_examples.ml new file mode 100644 index 0000000..468e64d --- /dev/null +++ b/Complex/grobner_examples.ml @@ -0,0 +1,589 @@ +(* ========================================================================= *) +(* Examples of using the Grobner basis procedure. *) +(* ========================================================================= *) + +time COMPLEX_ARITH + `!a b c. + (a * x pow 2 + b * x + c = Cx(&0)) /\ + (a * y pow 2 + b * y + c = Cx(&0)) /\ + ~(x = y) + ==> (a * (x + y) + b = Cx(&0))`;; + +time COMPLEX_ARITH + `!a b c. + (a * x pow 2 + b * x + c = Cx(&0)) /\ + (Cx(&2) * a * y pow 2 + Cx(&2) * b * y + Cx(&2) * c = Cx(&0)) /\ + ~(x = y) + ==> (a * (x + y) + b = Cx(&0))`;; + +(* ------------------------------------------------------------------------- *) +(* Another example. *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `~((y_1 = Cx(&2) * y_3) /\ + (y_2 = Cx(&2) * y_4) /\ + (y_1 * y_3 = y_2 * y_4) /\ + ((y_1 pow 2 - y_2 pow 2) * z = Cx(&1)))`;; + +time COMPLEX_ARITH + `!y_1 y_2 y_3 y_4. + (y_1 = Cx(&2) * y_3) /\ + (y_2 = Cx(&2) * y_4) /\ + (y_1 * y_3 = y_2 * y_4) + ==> (y_1 pow 2 = y_2 pow 2)`;; + +(* ------------------------------------------------------------------------- *) +(* Angle at centre vs. angle at circumference. *) +(* Formulation from "Real quantifier elimination in practice" paper. *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `~((c pow 2 = a pow 2 + b pow 2) /\ + (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\ + (y0 * t1 = a + x0) /\ + (y0 * t2 = a - x0) /\ + ((Cx(&1) - t1 * t2) * t = t1 + t2) /\ + (u * (b * t - a) = Cx(&1)) /\ + (v1 * a + v2 * x0 + v3 * y0 = Cx(&1)))`;; + +time COMPLEX_ARITH + `(c pow 2 = a pow 2 + b pow 2) /\ + (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\ + (y0 * t1 = a + x0) /\ + (y0 * t2 = a - x0) /\ + ((Cx(&1) - t1 * t2) * t = t1 + t2) /\ + (~(a = Cx(&0)) \/ ~(x0 = Cx(&0)) \/ ~(y0 = Cx(&0))) + ==> (b * t = a)`;; + +time COMPLEX_ARITH + `(c pow 2 = a pow 2 + b pow 2) /\ + (c pow 2 = x0 pow 2 + (y0 - b) pow 2) /\ + (y0 * t1 = a + x0) /\ + (y0 * t2 = a - x0) /\ + ((Cx(&1) - t1 * t2) * t = t1 + t2) /\ + (~(a = Cx(&0)) /\ ~(x0 = Cx(&0)) /\ ~(y0 = Cx(&0))) + ==> (b * t = a)`;; + +(* ------------------------------------------------------------------------- *) +(* Another example (note we rule out points 1, 2 or 3 coinciding). *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `((x1 - x0) pow 2 + (y1 - y0) pow 2 = + (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ + ((x2 - x0) pow 2 + (y2 - y0) pow 2 = + (x3 - x0) pow 2 + (y3 - y0) pow 2) /\ + ((x1 - x0') pow 2 + (y1 - y0') pow 2 = + (x2 - x0') pow 2 + (y2 - y0') pow 2) /\ + ((x2 - x0') pow 2 + (y2 - y0') pow 2 = + (x3 - x0') pow 2 + (y3 - y0') pow 2) /\ + (a12 * (x1 - x2) + b12 * (y1 - y2) = Cx(&1)) /\ + (a13 * (x1 - x3) + b13 * (y1 - y3) = Cx(&1)) /\ + (a23 * (x2 - x3) + b23 * (y2 - y3) = Cx(&1)) /\ + ~((x1 - x0) pow 2 + (y1 - y0) pow 2 = Cx(&0)) + ==> (x0' = x0) /\ (y0' = y0)`;; + +time COMPLEX_ARITH + `~(((x1 - x0) pow 2 + (y1 - y0) pow 2 = + (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ + ((x2 - x0) pow 2 + (y2 - y0) pow 2 = + (x3 - x0) pow 2 + (y3 - y0) pow 2) /\ + ((x1 - x0') pow 2 + (y1 - y0') pow 2 = + (x2 - x0') pow 2 + (y2 - y0') pow 2) /\ + ((x2 - x0') pow 2 + (y2 - y0') pow 2 = + (x3 - x0') pow 2 + (y3 - y0') pow 2) /\ + (a12 * (x1 - x2) + b12 * (y1 - y2) = Cx(&1)) /\ + (a13 * (x1 - x3) + b13 * (y1 - y3) = Cx(&1)) /\ + (a23 * (x2 - x3) + b23 * (y2 - y3) = Cx(&1)) /\ + (z * (x0' - x0) = Cx(&1)) /\ + (z' * (y0' - y0) = Cx(&1)) /\ + (z'' * ((x1 - x0) pow 2 + (y1 - y0) pow 2) = Cx(&1)) /\ + (z''' * ((x1 - x09) pow 2 + (y1 - y09) pow 2) = Cx(&1)))`;; + +(* ------------------------------------------------------------------------- *) +(* These are pure algebraic simplification. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_4 = time COMPLEX_ARITH + `(((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * + ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2))) = + ((((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2))`;; + +let LAGRANGE_8 = time COMPLEX_ARITH + `((p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * + (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2)) = + ((p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1* w2) pow 2 + + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1* v2) pow 2 + + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1* u2) pow 2 + + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1* t2) pow 2 + + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1* s2) pow 2 + + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1* r2) pow 2 + + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1* q2) pow 2 + + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1* p2) pow 2)`;; + +let LIOUVILLE = time COMPLEX_ARITH + `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) = + (Cx(&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) + + Cx(&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;; + +let FLECK = time COMPLEX_ARITH + `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 3) = + (Cx(&1 / &60) * ((x1 + x2 + x3) pow 6 + (x1 + x2 - x3) pow 6 + + (x1 - x2 + x3) pow 6 + (x1 - x2 - x3) pow 6 + + (x1 + x2 + x4) pow 6 + (x1 + x2 - x4) pow 6 + + (x1 - x2 + x4) pow 6 + (x1 - x2 - x4) pow 6 + + (x1 + x3 + x4) pow 6 + (x1 + x3 - x4) pow 6 + + (x1 - x3 + x4) pow 6 + (x1 - x3 - x4) pow 6 + + (x2 + x3 + x4) pow 6 + (x2 + x3 - x4) pow 6 + + (x2 - x3 + x4) pow 6 + (x2 - x3 - x4) pow 6) + + Cx(&1 / &30) * ((x1 + x2) pow 6 + (x1 - x2) pow 6 + + (x1 + x3) pow 6 + (x1 - x3) pow 6 + + (x1 + x4) pow 6 + (x1 - x4) pow 6 + + (x2 + x3) pow 6 + (x2 - x3) pow 6 + + (x2 + x4) pow 6 + (x2 - x4) pow 6 + + (x3 + x4) pow 6 + (x3 - x4) pow 6) + + Cx(&3 / &5) * (x1 pow 6 + x2 pow 6 + x3 pow 6 + x4 pow 6))`;; + +let HURWITZ = time COMPLEX_ARITH + `!x1 x2 x3 x4. + (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 4 = + Cx(&1 / &840) * ((x1 + x2 + x3 + x4) pow 8 + + (x1 + x2 + x3 - x4) pow 8 + + (x1 + x2 - x3 + x4) pow 8 + + (x1 + x2 - x3 - x4) pow 8 + + (x1 - x2 + x3 + x4) pow 8 + + (x1 - x2 + x3 - x4) pow 8 + + (x1 - x2 - x3 + x4) pow 8 + + (x1 - x2 - x3 - x4) pow 8) + + Cx(&1 / &5040) * ((Cx(&2) * x1 + x2 + x3) pow 8 + + (Cx(&2) * x1 + x2 - x3) pow 8 + + (Cx(&2) * x1 - x2 + x3) pow 8 + + (Cx(&2) * x1 - x2 - x3) pow 8 + + (Cx(&2) * x1 + x2 + x4) pow 8 + + (Cx(&2) * x1 + x2 - x4) pow 8 + + (Cx(&2) * x1 - x2 + x4) pow 8 + + (Cx(&2) * x1 - x2 - x4) pow 8 + + (Cx(&2) * x1 + x3 + x4) pow 8 + + (Cx(&2) * x1 + x3 - x4) pow 8 + + (Cx(&2) * x1 - x3 + x4) pow 8 + + (Cx(&2) * x1 - x3 - x4) pow 8 + + (Cx(&2) * x2 + x3 + x4) pow 8 + + (Cx(&2) * x2 + x3 - x4) pow 8 + + (Cx(&2) * x2 - x3 + x4) pow 8 + + (Cx(&2) * x2 - x3 - x4) pow 8 + + (x1 + Cx(&2) * x2 + x3) pow 8 + + (x1 + Cx(&2) * x2 - x3) pow 8 + + (x1 - Cx(&2) * x2 + x3) pow 8 + + (x1 - Cx(&2) * x2 - x3) pow 8 + + (x1 + Cx(&2) * x2 + x4) pow 8 + + (x1 + Cx(&2) * x2 - x4) pow 8 + + (x1 - Cx(&2) * x2 + x4) pow 8 + + (x1 - Cx(&2) * x2 - x4) pow 8 + + (x1 + Cx(&2) * x3 + x4) pow 8 + + (x1 + Cx(&2) * x3 - x4) pow 8 + + (x1 - Cx(&2) * x3 + x4) pow 8 + + (x1 - Cx(&2) * x3 - x4) pow 8 + + (x2 + Cx(&2) * x3 + x4) pow 8 + + (x2 + Cx(&2) * x3 - x4) pow 8 + + (x2 - Cx(&2) * x3 + x4) pow 8 + + (x2 - Cx(&2) * x3 - x4) pow 8 + + (x1 + x2 + Cx(&2) * x3) pow 8 + + (x1 + x2 - Cx(&2) * x3) pow 8 + + (x1 - x2 + Cx(&2) * x3) pow 8 + + (x1 - x2 - Cx(&2) * x3) pow 8 + + (x1 + x2 + Cx(&2) * x4) pow 8 + + (x1 + x2 - Cx(&2) * x4) pow 8 + + (x1 - x2 + Cx(&2) * x4) pow 8 + + (x1 - x2 - Cx(&2) * x4) pow 8 + + (x1 + x3 + Cx(&2) * x4) pow 8 + + (x1 + x3 - Cx(&2) * x4) pow 8 + + (x1 - x3 + Cx(&2) * x4) pow 8 + + (x1 - x3 - Cx(&2) * x4) pow 8 + + (x2 + x3 + Cx(&2) * x4) pow 8 + + (x2 + x3 - Cx(&2) * x4) pow 8 + + (x2 - x3 + Cx(&2) * x4) pow 8 + + (x2 - x3 - Cx(&2) * x4) pow 8) + + Cx(&1 / &84) * ((x1 + x2) pow 8 + (x1 - x2) pow 8 + + (x1 + x3) pow 8 + (x1 - x3) pow 8 + + (x1 + x4) pow 8 + (x1 - x4) pow 8 + + (x2 + x3) pow 8 + (x2 - x3) pow 8 + + (x2 + x4) pow 8 + (x2 - x4) pow 8 + + (x3 + x4) pow 8 + (x3 - x4) pow 8) + + Cx(&1 / &840) * ((Cx(&2) * x1) pow 8 + (Cx(&2) * x2) pow 8 + + (Cx(&2) * x3) pow 8 + (Cx(&2) * x4) pow 8)`;; + +let SCHUR = time COMPLEX_ARITH + `Cx(&22680) * (x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 5 = + Cx(&9) * ((Cx(&2) * x1) pow 10 + + (Cx(&2) * x2) pow 10 + + (Cx(&2) * x3) pow 10 + + (Cx(&2) * x4) pow 10) + + Cx(&180) * ((x1 + x2) pow 10 + (x1 - x2) pow 10 + + (x1 + x3) pow 10 + (x1 - x3) pow 10 + + (x1 + x4) pow 10 + (x1 - x4) pow 10 + + (x2 + x3) pow 10 + (x2 - x3) pow 10 + + (x2 + x4) pow 10 + (x2 - x4) pow 10 + + (x3 + x4) pow 10 + (x3 - x4) pow 10) + + ((Cx(&2) * x1 + x2 + x3) pow 10 + + (Cx(&2) * x1 + x2 - x3) pow 10 + + (Cx(&2) * x1 - x2 + x3) pow 10 + + (Cx(&2) * x1 - x2 - x3) pow 10 + + (Cx(&2) * x1 + x2 + x4) pow 10 + + (Cx(&2) * x1 + x2 - x4) pow 10 + + (Cx(&2) * x1 - x2 + x4) pow 10 + + (Cx(&2) * x1 - x2 - x4) pow 10 + + (Cx(&2) * x1 + x3 + x4) pow 10 + + (Cx(&2) * x1 + x3 - x4) pow 10 + + (Cx(&2) * x1 - x3 + x4) pow 10 + + (Cx(&2) * x1 - x3 - x4) pow 10 + + (Cx(&2) * x2 + x3 + x4) pow 10 + + (Cx(&2) * x2 + x3 - x4) pow 10 + + (Cx(&2) * x2 - x3 + x4) pow 10 + + (Cx(&2) * x2 - x3 - x4) pow 10 + + (x1 + Cx(&2) * x2 + x3) pow 10 + + (x1 + Cx(&2) * x2 - x3) pow 10 + + (x1 - Cx(&2) * x2 + x3) pow 10 + + (x1 - Cx(&2) * x2 - x3) pow 10 + + (x1 + Cx(&2) * x2 + x4) pow 10 + + (x1 + Cx(&2) * x2 - x4) pow 10 + + (x1 - Cx(&2) * x2 + x4) pow 10 + + (x1 - Cx(&2) * x2 - x4) pow 10 + + (x1 + Cx(&2) * x3 + x4) pow 10 + + (x1 + Cx(&2) * x3 - x4) pow 10 + + (x1 - Cx(&2) * x3 + x4) pow 10 + + (x1 - Cx(&2) * x3 - x4) pow 10 + + (x2 + Cx(&2) * x3 + x4) pow 10 + + (x2 + Cx(&2) * x3 - x4) pow 10 + + (x2 - Cx(&2) * x3 + x4) pow 10 + + (x2 - Cx(&2) * x3 - x4) pow 10 + + (x1 + x2 + Cx(&2) * x3) pow 10 + + (x1 + x2 - Cx(&2) * x3) pow 10 + + (x1 - x2 + Cx(&2) * x3) pow 10 + + (x1 - x2 - Cx(&2) * x3) pow 10 + + (x1 + x2 + Cx(&2) * x4) pow 10 + + (x1 + x2 - Cx(&2) * x4) pow 10 + + (x1 - x2 + Cx(&2) * x4) pow 10 + + (x1 - x2 - Cx(&2) * x4) pow 10 + + (x1 + x3 + Cx(&2) * x4) pow 10 + + (x1 + x3 - Cx(&2) * x4) pow 10 + + (x1 - x3 + Cx(&2) * x4) pow 10 + + (x1 - x3 - Cx(&2) * x4) pow 10 + + (x2 + x3 + Cx(&2) * x4) pow 10 + + (x2 + x3 - Cx(&2) * x4) pow 10 + + (x2 - x3 + Cx(&2) * x4) pow 10 + + (x2 - x3 - Cx(&2) * x4) pow 10) + + Cx(&9) * ((x1 + x2 + x3 + x4) pow 10 + + (x1 + x2 + x3 - x4) pow 10 + + (x1 + x2 - x3 + x4) pow 10 + + (x1 + x2 - x3 - x4) pow 10 + + (x1 - x2 + x3 + x4) pow 10 + + (x1 - x2 + x3 - x4) pow 10 + + (x1 - x2 - x3 + x4) pow 10 + + (x1 - x2 - x3 - x4) pow 10)`;; + +(* ------------------------------------------------------------------------- *) +(* Intersection of diagonals of a parallelogram is their midpoint. *) +(* Kapur "...Dixon resultants, Groebner Bases, and Characteristic Sets", 3.1 *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `(x1 = u3) /\ + (x1 * (u2 - u1) = x2 * u3) /\ + (x4 * (x2 - u1) = x1 * (x3 - u1)) /\ + (x3 * u3 = x4 * u2) /\ + ~(u1 = Cx(&0)) /\ + ~(u3 = Cx(&0)) + ==> (x3 pow 2 + x4 pow 2 = (u2 - x3) pow 2 + (u3 - x4) pow 2)`;; + +(* ------------------------------------------------------------------------- *) +(* Chou's formulation of same property. *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `(u1 * x1 - u1 * u3 = Cx(&0)) /\ + (u3 * x2 - (u2 - u1) * x1 = Cx(&0)) /\ + (x1 * x4 - (x2 - u1) * x3 - u1 * x1 = Cx(&0)) /\ + (u3 * x4 - u2 * x3 = Cx(&0)) /\ + ~(u1 = Cx(&0)) /\ + ~(u3 = Cx(&0)) + ==> (Cx(&2) * u2 * x4 + Cx(&2) * u3 * x3 - u3 pow 2 - u2 pow 2 = Cx(&0))`;; + +(* ------------------------------------------------------------------------- *) +(* Perpendicular lines property; from Kapur's earlier paper. *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `(y1 * y3 + x1 * x3 = Cx(&0)) /\ + (y3 * (y2 - y3) + (x2 - x3) * x3 = Cx(&0)) /\ + ~(x3 = Cx(&0)) /\ + ~(y3 = Cx(&0)) + ==> (y1 * (x2 - x3) = x1 * (y2 - y3))`;; + +(* ------------------------------------------------------------------------- *) +(* Simson's theorem (Chou, p7). *) +(* ------------------------------------------------------------------------- *) + +time COMPLEX_ARITH + `(Cx(&2) * u2 * x2 + Cx(&2) * u3 * x1 - u3 pow 2 - u2 pow 2 = Cx(&0)) /\ + (Cx(&2) * u1 * x2 - u1 pow 2 = Cx(&0)) /\ + (--(x3 pow 2) + Cx(&2) * x2 * x3 + Cx(&2) * u4 * x1 - u4 pow 2 = Cx(&0)) /\ + (u3 * x5 + (--u2 + u1) * x4 - u1 * u3 = Cx(&0)) /\ + ((u2 - u1) * x5 + u3 * x4 + (--u2 + u1) * x3 - u3 * u4 = Cx(&0)) /\ + (u3 * x7 - u2 * x6 = Cx(&0)) /\ + (u2 * x7 + u3 * x6 - u2 * x3 - u3 * u4 = Cx(&0)) /\ + ~(Cx(&4) * u1 * u3 = Cx(&0)) /\ + ~(Cx(&2) * u1 = Cx(&0)) /\ + ~(--(u3 pow 2) - u2 pow 2 + Cx(&2) * u1 * u2 - u1 pow 2 = Cx(&0)) /\ + ~(u3 = Cx(&0)) /\ + ~(--(u3 pow 2) - u2 pow 2 = Cx(&0)) /\ + ~(u2 = Cx(&0)) + ==> (x4 * x7 + (--x5 + x3) * x6 - x3 * x4 = Cx(&0))`;; + +(* ------------------------------------------------------------------------- *) +(* Determinants from Coq convex hull paper (some require reals or order). *) +(* ------------------------------------------------------------------------- *) + +let det3 = new_definition + `det3(a11,a12,a13, + a21,a22,a23, + a31,a32,a33) = + a11 * (a22 * a33 - a32 * a23) - + a12 * (a21 * a33 - a31 * a23) + + a13 * (a21 * a32 - a31 * a22)`;; + +let DET_TRANSPOSE = prove + (`det3(a1,b1,c1,a2,b2,c2,a3,b3,c3) = + det3(a1,a2,a3,b1,b2,b3,c1,c2,c3)`, + REWRITE_TAC[det3] THEN CONV_TAC(time COMPLEX_ARITH));; + +let sdet3 = new_definition + `sdet3(p,q,r) = det3(FST p,SND p,Cx(&1), + FST q,SND q,Cx(&1), + FST r,SND r,Cx(&1))`;; + +let SDET3_PERMUTE_1 = prove + (`sdet3(p,q,r) = sdet3(q,r,p)`, + REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; + +let SDET3_PERMUTE_2 = prove + (`sdet3(p,q,r) = --(sdet3(p,r,q))`, + REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; + +let SDET_SUM = prove + (`sdet3(p,q,r) - sdet3(t,q,r) - sdet3(p,t,r) - sdet3(p,q,t) = Cx(&0)`, + REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; + +let SDET_CRAMER = prove + (`sdet3(s,t,q) * sdet3(t,p,r) = sdet3(t,q,r) * sdet3(s,t,p) + + sdet3(t,p,q) * sdet3(s,t,r)`, + REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; + +let SDET_NZ = prove + (`!p q r. ~(sdet3(p,q,r) = Cx(&0)) + ==> ~(p = q) /\ ~(q = r) /\ ~(r = p)`, + REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ; sdet3; det3] THEN + CONV_TAC(time COMPLEX_ARITH));; + +let SDET_LINCOMB = prove + (`(FST p * sdet3(i,j,k) = + FST i * sdet3(j,k,p) + FST j * sdet3(k,i,p) + FST k * sdet3(i,j,p)) /\ + (SND p * sdet3(i,j,k) = + SND i * sdet3(j,k,p) + SND j * sdet3(k,i,p) + SND k * sdet3(i,j,p))`, + REWRITE_TAC[sdet3; det3] THEN CONV_TAC(time COMPLEX_ARITH));; + +(***** I'm not sure if this is true; there must be some + sufficient degenerate conditions.... + +let th = prove + (`~(~(xp pow 2 + yp pow 2 = Cx(&0)) /\ + ~(xq pow 2 + yq pow 2 = Cx(&0)) /\ + ~(xr pow 2 + yr pow 2 = Cx(&0)) /\ + (det3(xp,yp,Cx(&1), + xq,yq,Cx(&1), + xr,yr,Cx(&1)) = Cx(&0)) /\ + (det3(yp,xp pow 2 + yp pow 2,Cx(&1), + yq,xq pow 2 + yq pow 2,Cx(&1), + yr,xr pow 2 + yr pow 2,Cx(&1)) = Cx(&0)) /\ + (det3(xp,xp pow 2 + yp pow 2,Cx(&1), + xq,xq pow 2 + yq pow 2,Cx(&1), + xr,xr pow 2 + yr pow 2,Cx(&1)) = Cx(&0)))`, + REWRITE_TAC[det3] THEN + CONV_TAC(time COMPLEX_ARITH));; + +***************) + +(* ------------------------------------------------------------------------- *) +(* Some geometry concepts (just "axiomatic" in this file). *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let collinear = new_definition + `collinear (a:real#real) b c <=> + ((FST a - FST b) * (SND b - SND c) = + (SND a - SND b) * (FST b - FST c))`;; + +let parallel = new_definition + `parallel (a,b) (c,d) <=> + ((FST a - FST b) * (SND c - SND d) = (SND a - SND b) * (FST c - FST d))`;; + +let perpendicular = new_definition + `perpendicular (a,b) (c,d) <=> + ((FST a - FST b) * (FST c - FST d) + (SND a - SND b) * (SND c - SND d) = + &0)`;; + +let oncircle_with_diagonal = new_definition + `oncircle_with_diagonal a (b,c) = perpendicular (b,a) (c,a)`;; + +let length = new_definition + `length (a,b) = sqrt((FST a - FST b) pow 2 + (SND a - SND b) pow 2)`;; + +let lengths_eq = new_definition + `lengths_eq (a,b) (c,d) <=> + ((FST a - FST b) pow 2 + (SND a - SND b) pow 2 = + (FST c - FST d) pow 2 + (SND c - SND d) pow 2)`;; + +let is_midpoint = new_definition + `is_midpoint b (a,c) <=> + (&2 * FST b = FST a + FST c) /\ + (&2 * SND b = SND a + SND c)`;; + +(* ------------------------------------------------------------------------- *) +(* Chou isn't explicit about this. *) +(* ------------------------------------------------------------------------- *) + +let is_intersection = new_definition + `is_intersection p (a,b) (c,d) <=> + collinear a p b /\ collinear c p d`;; + +(* ------------------------------------------------------------------------- *) +(* This is used in some degenerate conditions. See Chou, p18. *) +(* ------------------------------------------------------------------------- *) + +let isotropic = new_definition + `isotropic (a,b) = perpendicular (a,b) (a,b)`;; + +(* ------------------------------------------------------------------------- *) +(* This increases degree, but sometimes makes complex assertion useful. *) +(* ------------------------------------------------------------------------- *) + +let distinctpairs = new_definition + `distinctpairs pprs <=> + ~(ITLIST (\(a,b) pr. ((FST a - FST b) pow 2 + (SND a - SND b) pow 2) * pr) + pprs (&1) = &0)`;; + +(* ------------------------------------------------------------------------- *) +(* Simple tactic to remove defined concepts and expand coordinates. *) +(* ------------------------------------------------------------------------- *) + +let (EXPAND_COORDS_TAC:tactic) = + let complex2_ty = `:real#real` in + fun (asl,w) -> + (let fvs = filter (fun v -> type_of v = complex2_ty) (frees w) in + MAP_EVERY (fun v -> SPEC_TAC(v,v)) fvs THEN + GEN_REWRITE_TAC DEPTH_CONV [FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN + REPEAT GEN_TAC) (asl,w);; + +let PAIR_BETA_THM = prove + (`(\(x,y). P x y) (a,b) = P a b`, + CONV_TAC(LAND_CONV GEN_BETA_CONV) THEN REFL_TAC);; + +let GEOM_TAC = + EXPAND_COORDS_TAC THEN + GEN_REWRITE_TAC TOP_DEPTH_CONV + [collinear; parallel; perpendicular; oncircle_with_diagonal; + length; lengths_eq; is_midpoint; is_intersection; distinctpairs; + isotropic; ITLIST; PAIR_BETA_THM; BETA_THM; PAIR_EQ; FST; SND];; + +(* ------------------------------------------------------------------------- *) +(* Centroid (Chou, example 142). *) +(* ------------------------------------------------------------------------- *) + +let CENTROID = time prove + (`is_midpoint d (b,c) /\ + is_midpoint e (a,c) /\ + is_midpoint f (a,b) /\ + is_intersection m (b,e) (a,d) + ==> collinear c f m`, + GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; + +(* ------------------------------------------------------------------------- *) +(* Gauss's theorem (Chou, example 15). *) +(* ------------------------------------------------------------------------- *) + +let GAUSS = time prove + (`collinear x a0 a3 /\ + collinear x a1 a2 /\ + collinear y a2 a3 /\ + collinear y a1 a0 /\ + is_midpoint m1 (a1,a3) /\ + is_midpoint m2 (a0,a2) /\ + is_midpoint m3 (x,y) + ==> collinear m1 m2 m3`, + GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; + +(* ------------------------------------------------------------------------- *) +(* Simson's theorem (Chou, example 288). *) +(* ------------------------------------------------------------------------- *) + +(**** These are all hideously slow. At least the first one works. + I haven't had the patience to try the rest. + +let SIMSON = time prove + (`lengths_eq (O,a) (O,b) /\ + lengths_eq (O,a) (O,c) /\ + lengths_eq (d,O) (O,a) /\ + perpendicular (e,d) (b,c) /\ + collinear e b c /\ + perpendicular (f,d) (a,c) /\ + collinear f a c /\ + perpendicular (g,d) (a,b) /\ + collinear g a b /\ + ~(collinear a c b) /\ + ~(lengths_eq (a,b) (a,a)) /\ + ~(lengths_eq (a,c) (a,a)) /\ + ~(lengths_eq (b,c) (a,a)) + ==> collinear e f g`, + GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; + +let SIMSON = time prove + (`lengths_eq (O,a) (O,b) /\ + lengths_eq (O,a) (O,c) /\ + lengths_eq (d,O) (O,a) /\ + perpendicular (e,d) (b,c) /\ + collinear e b c /\ + perpendicular (f,d) (a,c) /\ + collinear f a c /\ + perpendicular (g,d) (a,b) /\ + collinear g a b /\ + ~(a = b) /\ ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d) /\ ~(c = d) + ==> collinear e f g`, + GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; + +let SIMSON = time prove + (`lengths_eq (O,a) (O,b) /\ + lengths_eq (O,a) (O,c) /\ + lengths_eq (d,O) (O,a) /\ + perpendicular (e,d) (b,c) /\ + collinear e b c /\ + perpendicular (f,d) (a,c) /\ + collinear f a c /\ + perpendicular (g,d) (a,b) /\ + collinear g a b /\ + ~(collinear a c b) /\ + ~(isotropic (a,b)) /\ + ~(isotropic (a,c)) /\ + ~(isotropic (b,c)) /\ + ~(isotropic (a,d)) /\ + ~(isotropic (b,d)) /\ + ~(isotropic (c,d)) + ==> collinear e f g`, + GEOM_TAC THEN CONV_TAC GROBNER_REAL_ARITH);; + +****************) diff --git a/Complex/make.ml b/Complex/make.ml new file mode 100644 index 0000000..266ecf3 --- /dev/null +++ b/Complex/make.ml @@ -0,0 +1,15 @@ +needs "Library/analysis.ml";; (* Basic real analysis *) +needs "Library/transc.ml";; (* Real transcendental functions *) +needs "Library/floor.ml";; (* Floor and frac functions *) + +needs "Complex/complexnumbers.ml";; (* Basic complex number defs *) +needs "Complex/complex_transc.ml";; (* Complex transcendental functions *) + +needs "Complex/cpoly.ml";; (* Complex polynomials *) +needs "Complex/fundamental.ml";; (* Fundamental theorem of algebra *) +needs "Complex/quelim.ml";; (* Quantifier elimination algorithm *) +needs "Complex/complex_grobner.ml";; (* Grobner bases with HOL proofs *) +needs "Complex/complex_real.ml";; (* Special case of reals *) + +needs "Complex/quelim_examples.ml";; (* Examples of using quantifier elim *) +needs "Complex/grobner_examples.ml";; (* Examples of using Grobner bases *) diff --git a/Complex/quelim.ml b/Complex/quelim.ml new file mode 100644 index 0000000..a628f29 --- /dev/null +++ b/Complex/quelim.ml @@ -0,0 +1,923 @@ +(* ========================================================================= *) +(* Naive quantifier elimination for complex numbers. *) +(* ========================================================================= *) + +needs "Complex/fundamental.ml";; + +let NULLSTELLENSATZ_LEMMA = prove + (`!n p q. (!x. (poly p x = Cx(&0)) ==> (poly q x = Cx(&0))) /\ + (degree p = n) /\ ~(n = 0) + ==> p divides (q exp n)`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`p:complex list`; `q:complex list`] THEN + ASM_CASES_TAC `?a. poly p a = Cx(&0)` THENL + [ALL_TAC; + DISCH_THEN(K ALL_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[TAUT `a ==> b <=> ~b ==> ~a`] + FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:complex`; `zeros:complex list`] THEN + STRIP_TAC THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `[inv(k)] ** q exp n` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN X_GEN_TAC `z:complex` THEN + ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_RINV; COMPLEX_MUL_LID; + poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; POLY_0]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + GEN_REWRITE_TAC LAND_CONV [ORDER_ROOT] THEN + ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[DEGREE_ZERO] THEN MESON_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`p:complex list`; `a:complex`; `order a p`] ORDER) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP ORDER_DEGREE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:complex`) THEN + REWRITE_TAC[ASSUME `poly p a = Cx(&0)`] THEN + REWRITE_TAC[POLY_LINEAR_DIVIDES] THEN + ASM_CASES_TAC `q:complex list = []` THENL + [DISCH_TAC THEN MATCH_MP_TAC POLY_DIVIDES_ZERO THEN + UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp] THEN DISCH_TAC THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_LZERO; poly]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:complex list` SUBST_ALL_TAC) THEN + UNDISCH_TAC `[--a; Cx (&1)] exp (order a p) divides p` THEN + GEN_REWRITE_TAC LAND_CONV [divides] THEN + DISCH_THEN(X_CHOOSE_THEN `s:complex list` ASSUME_TAC) THEN + SUBGOAL_THEN `~(poly s = poly [])` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~(poly p = poly [])` THEN + ASM_REWRITE_TAC[POLY_ENTIRE]; ALL_TAC] THEN + ASM_CASES_TAC `degree s = 0` THENL + [SUBGOAL_THEN `?k. ~(k = Cx(&0)) /\ (poly s = poly [k])` MP_TAC THENL + [EXISTS_TAC `LAST(normalize s)` THEN + ASM_SIMP_TAC[NORMAL_NORMALIZE; GSYM POLY_NORMALIZE_ZERO] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM POLY_NORMALIZE] THEN + UNDISCH_TAC `degree s = 0` THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [POLY_NORMALIZE_ZERO]) THEN + REWRITE_TAC[degree] THEN + SPEC_TAC(`normalize s`,`s:complex list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL] THEN + REWRITE_TAC[LENGTH; PRE; poly; LAST] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:complex` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[divides] THEN + EXISTS_TAC `[inv(k)] ** [--a; Cx (&1)] exp (n - order a p) ** r exp n` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_EXP; COMPLEX_POW_MUL] THEN + X_GEN_TAC `z:complex` THEN + ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC + `(a * b) * c * d * e = ((d * a) * (c * b)) * e`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN ASM_SIMP_TAC[SUB_ADD] THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN + ASM_SIMP_TAC[COMPLEX_MUL_LINV; COMPLEX_MUL_RID]; ALL_TAC] THEN + SUBGOAL_THEN `degree s < n` ASSUME_TAC THENL + [EXPAND_TAC "n" THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN + REWRITE_TAC[LINEAR_POW_MUL_DEGREE] THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(order a p = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `degree s`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`s:complex list`; `r:complex list`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + UNDISCH_TAC + `!x. (poly p x = Cx(&0)) ==> (poly([--a; Cx (&1)] ** r) x = Cx(&0))` THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[POLY_MUL; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_ENTIRE] THEN + MATCH_MP_TAC(TAUT `~a ==> (a \/ b ==> b)`) THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `(--a + z * Cx(&1) = Cx(&0)) <=> (z = a)`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `poly s a = Cx (&0)` THEN + ASM_REWRITE_TAC[POLY_LINEAR_DIVIDES; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:complex list` SUBST_ALL_TAC) THEN + UNDISCH_TAC `~([--a; Cx (&1)] exp SUC (order a p) divides p)` THEN + REWRITE_TAC[divides] THEN + EXISTS_TAC `u:complex list` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[POLY_MUL; poly_exp; COMPLEX_MUL_AC; FUN_EQ_THM]; + ALL_TAC] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `u:complex list` ASSUME_TAC) THEN + EXISTS_TAC + `u ** [--a; Cx(&1)] exp (n - order a p) ** r exp (n - degree s)` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_EXP; COMPLEX_POW_MUL] THEN + X_GEN_TAC `z:complex` THEN + ONCE_REWRITE_TAC[AC COMPLEX_MUL_AC + `(ap * s) * u * anp * rns = (anp * ap) * rns * s * u`] THEN + REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN + ASM_SIMP_TAC[SUB_ADD] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM POLY_MUL] THEN + SUBST1_TAC(SYM(ASSUME `poly (r exp degree s) = poly (s ** u)`)) THEN + REWRITE_TAC[POLY_EXP; GSYM COMPLEX_POW_ADD] THEN + ASM_SIMP_TAC[SUB_ADD; LT_IMP_LE]);; + +let NULLSTELLENSATZ_UNIVARIATE = prove + (`!p q. (!x. (poly p x = Cx(&0)) ==> (poly q x = Cx(&0))) <=> + p divides (q exp (degree p)) \/ + ((poly p = poly []) /\ (poly q = poly []))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THENL + [ASM_REWRITE_TAC[poly] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN + REWRITE_TAC[degree; normalize; LENGTH; ARITH; poly_exp] THEN + ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL; poly; + COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN + ASM_CASES_TAC `degree p = 0` THENL + [ALL_TAC; + MP_TAC(SPECL [`degree p`; `p:complex list`; `q:complex list`] + NULLSTELLENSATZ_LEMMA) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EQ_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL] THEN + DISCH_THEN(CHOOSE_THEN (MP_TAC o SPEC `z:complex`)) THEN + ASM_REWRITE_TAC[POLY_EXP; COMPLEX_MUL_LZERO; COMPLEX_POW_EQ_0]] THEN + ASM_REWRITE_TAC[poly_exp] THEN + SUBGOAL_THEN `?k. ~(k = Cx(&0)) /\ (poly p = poly [k])` MP_TAC THENL + [SUBST1_TAC(SYM(SPEC `p:complex list` POLY_NORMALIZE)) THEN + EXISTS_TAC `LAST(normalize p)` THEN + ASM_SIMP_TAC[NORMAL_NORMALIZE; GSYM POLY_NORMALIZE_ZERO] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM POLY_NORMALIZE] THEN + UNDISCH_TAC `degree p = 0` THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [POLY_NORMALIZE_ZERO]) THEN + REWRITE_TAC[degree] THEN + SPEC_TAC(`normalize p`,`p:complex list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL] THEN + REWRITE_TAC[LENGTH; PRE; poly; LAST] THEN + SIMP_TAC[LENGTH_EQ_NIL; POLY_NORMALIZE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:complex` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[divides; poly; FUN_EQ_THM; POLY_MUL] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + EXISTS_TAC `[inv(k)]` THEN + ASM_REWRITE_TAC[divides; poly; FUN_EQ_THM; POLY_MUL] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV]);; + +(* ------------------------------------------------------------------------- *) +(* Useful lemma I should have proved ages ago. *) +(* ------------------------------------------------------------------------- *) + +let CONSTANT_DEGREE = prove + (`!p. constant(poly p) <=> (degree p = 0)`, + GEN_TAC THEN REWRITE_TAC[constant] THEN EQ_TAC THENL + [DISCH_THEN(ASSUME_TAC o GSYM o SPEC `Cx(&0)`) THEN + SUBGOAL_THEN `degree [poly p (Cx(&0))] = 0` MP_TAC THENL + [REWRITE_TAC[degree; normalize] THEN + COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `(x = y) ==> (x = 0) ==> (y = 0)`) THEN + MATCH_MP_TAC DEGREE_WELLDEF THEN + REWRITE_TAC[FUN_EQ_THM; poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + FIRST_ASSUM(ACCEPT_TAC o GSYM); + ONCE_REWRITE_TAC[GSYM POLY_NORMALIZE] THEN REWRITE_TAC[degree] THEN + SPEC_TAC(`normalize p`,`l:complex list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[poly] THEN + SIMP_TAC[LENGTH; PRE; LENGTH_EQ_NIL; poly; COMPLEX_MUL_RZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* It would be nicer to prove this without using algebraic closure... *) +(* ------------------------------------------------------------------------- *) + +let DIVIDES_DEGREE_LEMMA = prove + (`!n p q. (degree(p) = n) + ==> n <= degree(p ** q) \/ (poly(p ** q) = poly [])`, + INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `p:complex list` FUNDAMENTAL_THEOREM_OF_ALGEBRA) THEN + ASM_REWRITE_TAC[CONSTANT_DEGREE; NOT_SUC] THEN + DISCH_THEN(X_CHOOSE_THEN `a:complex` MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THENL + [REWRITE_TAC[POLY_MUL; poly; COMPLEX_MUL_LZERO; FUN_EQ_THM]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `r:complex list` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `poly (([--a; Cx (&1)] ** r) ** q) = + poly ([--a; Cx (&1)] ** (r ** q))` + ASSUME_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; POLY_MUL; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`r ** q`; `--a`] LINEAR_MUL_DEGREE) THEN + ASM_CASES_TAC `poly (r ** q) = poly []` THENL + [REWRITE_TAC[FUN_EQ_THM] THEN + ONCE_REWRITE_TAC[POLY_MUL] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `n <= degree(r ** q) \/ (poly(r ** q) = poly [])` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[ARITH_RULE `SUC n <= m + 1 <=> n <= m`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM] THEN + ONCE_REWRITE_TAC[POLY_MUL] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO]] THEN + MP_TAC(SPECL [`r:complex list`; `--a`] LINEAR_MUL_DEGREE) THEN ANTS_TAC THENL + [UNDISCH_TAC `~(poly (r ** q) = poly [])` THEN + REWRITE_TAC[TAUT `~b ==> ~a <=> a ==> b`] THEN + SIMP_TAC[poly; FUN_EQ_THM; POLY_MUL; COMPLEX_ENTIRE]; ALL_TAC] THEN + DISCH_THEN SUBST_ALL_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `degree r + 1 = SUC n` THEN ARITH_TAC);; + +let DIVIDES_DEGREE = prove + (`!p q. p divides q ==> degree(p) <= degree(q) \/ (poly q = poly [])`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:complex list` THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP DEGREE_WELLDEF) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIVIDES_DEGREE_LEMMA]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations on multivariate polynomials. *) +(* ------------------------------------------------------------------------- *) + +let MPOLY_BASE_CONV = + let pth_0 = prove + (`Cx(&0) = poly [] x`, + REWRITE_TAC[poly]) + and pth_1 = prove + (`c = poly [c] x`, + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) + and pth_var = prove + (`x = poly [Cx(&0); Cx(&1)] x`, + REWRITE_TAC[poly; COMPLEX_ADD_LID; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_RID]) + and zero_tm = `Cx(&0)` + and c_tm = `c:complex` + and x_tm = `x:complex` in + let rec MPOLY_BASE_CONV avs tm = + if avs = [] then REFL tm + else if tm = zero_tm then INST [hd avs,x_tm] pth_0 + else if tm = hd avs then + let th1 = INST [tm,x_tm] pth_var in + let th2 = + (LAND_CONV + (COMB2_CONV (RAND_CONV (MPOLY_BASE_CONV (tl avs))) + (LAND_CONV (MPOLY_BASE_CONV (tl avs))))) + (rand(concl th1)) in + TRANS th1 th2 + else + let th1 = MPOLY_BASE_CONV (tl avs) tm in + let th2 = INST [hd avs,x_tm; rand(concl th1),c_tm] pth_1 in + TRANS th1 th2 in + MPOLY_BASE_CONV;; + +let MPOLY_NORM_CONV = + let pth_0 = prove + (`poly [Cx(&0)] x = poly [] x`, + REWRITE_TAC[poly; COMPLEX_ADD_RID; COMPLEX_MUL_RZERO]) + and pth_1 = prove + (`poly [poly [] y] x = poly [] x`, + REWRITE_TAC[poly; COMPLEX_ADD_RID; COMPLEX_MUL_RZERO]) in + let conv_fwd = REWR_CONV(CONJUNCT2 poly) + and conv_bck = REWR_CONV(GSYM(CONJUNCT2 poly)) + and conv_0 = GEN_REWRITE_CONV I [pth_0] + and conv_1 = GEN_REWRITE_CONV I [pth_1] in + let rec NORM0_CONV tm = + (conv_0 ORELSEC + (conv_fwd THENC RAND_CONV(RAND_CONV NORM0_CONV) THENC conv_bck THENC + TRY_CONV NORM0_CONV)) tm + and NORM1_CONV tm = + (conv_1 ORELSEC + (conv_fwd THENC RAND_CONV(RAND_CONV NORM1_CONV) THENC conv_bck THENC + TRY_CONV NORM1_CONV)) tm in + fun avs -> TRY_CONV(if avs = [] then NORM0_CONV else NORM1_CONV);; + +let MPOLY_ADD_CONV,MPOLY_TADD_CONV = + let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES)) + and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] + and add_conv = REWR_CONV(GSYM POLY_ADD) in + let rec MPOLY_ADD_CONV avs tm = + if avs = [] then COMPLEX_RAT_ADD_CONV tm else + (add_conv THENC LAND_CONV(MPOLY_TADD_CONV avs) THENC + MPOLY_NORM_CONV (tl avs)) tm + and MPOLY_TADD_CONV avs tm = + (add_conv0 ORELSEC + (add_conv1 THENC + LAND_CONV (MPOLY_ADD_CONV (tl avs)) THENC + RAND_CONV (MPOLY_TADD_CONV avs))) tm in + MPOLY_ADD_CONV,MPOLY_TADD_CONV;; + +let MPOLY_CMUL_CONV,MPOLY_TCMUL_CONV,MPOLY_MUL_CONV,MPOLY_TMUL_CONV = + let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul] + and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] + and cmul_conv = REWR_CONV(GSYM POLY_CMUL) + and mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES] + and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)] + and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] + and mul_conv = REWR_CONV(GSYM POLY_MUL) in + let rec MPOLY_CMUL_CONV avs tm = + (cmul_conv THENC LAND_CONV(MPOLY_TCMUL_CONV avs)) tm + and MPOLY_TCMUL_CONV avs tm = + (cmul_conv0 ORELSEC + (cmul_conv1 THENC + LAND_CONV (MPOLY_MUL_CONV (tl avs)) THENC + RAND_CONV (MPOLY_TCMUL_CONV avs))) tm + and MPOLY_MUL_CONV avs tm = + if avs = [] then COMPLEX_RAT_MUL_CONV tm else + (mul_conv THENC LAND_CONV(MPOLY_TMUL_CONV avs)) tm + and MPOLY_TMUL_CONV avs tm = + (mul_conv0 ORELSEC + (mul_conv1 THENC MPOLY_TCMUL_CONV avs) ORELSEC + (mul_conv2 THENC + COMB2_CONV (RAND_CONV(MPOLY_TCMUL_CONV avs)) + (COMB2_CONV (RAND_CONV(MPOLY_BASE_CONV (tl avs))) + (MPOLY_TMUL_CONV avs)) THENC + MPOLY_TADD_CONV avs)) tm in + MPOLY_CMUL_CONV,MPOLY_TCMUL_CONV,MPOLY_MUL_CONV,MPOLY_TMUL_CONV;; + +let MPOLY_SUB_CONV = + let pth = prove + (`(poly p x - poly q x) = (poly p x + Cx(--(&1)) * poly q x)`, + SIMPLE_COMPLEX_ARITH_TAC) in + let APPLY_PTH_CONV = REWR_CONV pth in + fun avs -> + APPLY_PTH_CONV THENC + RAND_CONV(LAND_CONV (MPOLY_BASE_CONV (tl avs)) THENC + MPOLY_CMUL_CONV avs) THENC + MPOLY_ADD_CONV avs;; + +let MPOLY_POW_CONV = + let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 complex_pow] + and cnv_1 = GEN_REWRITE_CONV I [CONJUNCT2 complex_pow] in + let rec MPOLY_POW_CONV avs tm = + try (cnv_0 THENC MPOLY_BASE_CONV avs) tm with Failure _ -> + (RAND_CONV num_CONV THENC + cnv_1 THENC (RAND_CONV (MPOLY_POW_CONV avs)) THENC + MPOLY_MUL_CONV avs) tm in + MPOLY_POW_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Recursive conversion to polynomial form. *) +(* ------------------------------------------------------------------------- *) + +let POLYNATE_CONV = + let ELIM_SUB_CONV = REWR_CONV + (SIMPLE_COMPLEX_ARITH `x - y = x + Cx(--(&1)) * y`) + and ELIM_NEG_CONV = REWR_CONV + (SIMPLE_COMPLEX_ARITH `--x = Cx(--(&1)) * x`) + and ELIM_POW_0_CONV = GEN_REWRITE_CONV I [CONJUNCT1 complex_pow] + and ELIM_POW_1_CONV = + RAND_CONV num_CONV THENC GEN_REWRITE_CONV I [CONJUNCT2 complex_pow] in + let rec ELIM_POW_CONV tm = + (ELIM_POW_0_CONV ORELSEC (ELIM_POW_1_CONV THENC RAND_CONV ELIM_POW_CONV)) + tm in + let polynet = itlist (uncurry net_of_conv) + [`x pow n`,(fun cnv avs -> LAND_CONV (cnv avs) THENC MPOLY_POW_CONV avs); + `x * y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_MUL_CONV avs); + `x + y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_ADD_CONV avs); + `x - y`,(fun cnv avs -> BINOP_CONV (cnv avs) THENC MPOLY_SUB_CONV avs); + `--x`,(fun cnv avs -> ELIM_NEG_CONV THENC (cnv avs))] + empty_net in + let rec POLYNATE_CONV avs tm = + try snd(hd(lookup tm polynet)) POLYNATE_CONV avs tm + with Failure _ -> MPOLY_BASE_CONV avs tm in + POLYNATE_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Cancellation conversion. *) +(* ------------------------------------------------------------------------- *) + +let POLY_PAD_RULE = + let pth = prove + (`(poly p x = Cx(&0)) ==> (poly (CONS (Cx(&0)) p) x = Cx(&0))`, + SIMP_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID]) in + let MATCH_pth = MATCH_MP pth in + fun avs th -> + let th1 = MATCH_pth th in + CONV_RULE(funpow 3 LAND_CONV (MPOLY_BASE_CONV (tl avs))) th1;; + +let POLY_CANCEL_EQ_CONV = + let pth_1 = prove + (`(p = Cx(&0)) /\ ~(a = Cx(&0)) + ==> !q b. (q = Cx(&0)) <=> (a * q - b * p = Cx(&0))`, + SIMP_TAC[COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO; COMPLEX_ENTIRE]) in + let MATCH_CANCEL_THM = MATCH_MP pth_1 in + let rec POLY_CANCEL_EQ_CONV avs n ath eth tm = + let m = length(dest_list(lhand(lhand tm))) in + if m < n then REFL tm else + let th1 = funpow (m - n) (POLY_PAD_RULE avs) eth in + let th2 = MATCH_CANCEL_THM (CONJ th1 ath) in + let th3 = SPECL [lhs tm; last(dest_list(lhand(lhs tm)))] th2 in + let th4 = CONV_RULE(RAND_CONV(LAND_CONV + (BINOP_CONV(MPOLY_CMUL_CONV avs)))) th3 in + let th5 = CONV_RULE(RAND_CONV(LAND_CONV (MPOLY_SUB_CONV avs))) th4 in + TRANS th5 (POLY_CANCEL_EQ_CONV avs n ath eth (rand(concl th5))) in + POLY_CANCEL_EQ_CONV;; + +let RESOLVE_EQ_RAW = + let pth = prove + (`(poly [] x = Cx(&0)) /\ + (poly [c] x = c)`, + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in + let REWRITE_pth = GEN_REWRITE_CONV LAND_CONV [pth] in + let rec RESOLVE_EQ asm tm = + try EQT_INTRO(find (fun th -> concl th = tm) asm) with Failure _ -> + let tm' = mk_neg tm in + try EQF_INTRO(find (fun th -> concl th = tm') asm) with Failure _ -> + try let th1 = REWRITE_pth tm in + TRANS th1 (RESOLVE_EQ asm (rand(concl th1))) + with Failure _ -> COMPLEX_RAT_EQ_CONV tm in + RESOLVE_EQ;; + +let RESOLVE_EQ asm tm = + let th = RESOLVE_EQ_RAW asm tm in + try EQF_ELIM th with Failure _ -> EQT_ELIM th;; + +let RESOLVE_EQ_THEN = + let MATCH_pth = MATCH_MP + (TAUT `(p ==> (q <=> q1)) /\ (~p ==> (q <=> q2)) + ==> (q <=> (p /\ q1 \/ ~p /\ q2))`) in + fun asm tm yfn nfn -> + try let th = RESOLVE_EQ asm tm in + if is_neg(concl th) then nfn (th::asm) th else yfn (th::asm) th + with Failure _ -> + let tm' = mk_neg tm in + let yth = DISCH tm (yfn (ASSUME tm :: asm) (ASSUME tm)) + and nth = DISCH tm' (nfn (ASSUME tm' :: asm) (ASSUME tm')) in + MATCH_pth (CONJ yth nth);; + +let POLY_CANCEL_ENE_CONV avs n ath eth tm = + if is_neg tm then RAND_CONV(POLY_CANCEL_EQ_CONV avs n ath eth) tm + else POLY_CANCEL_EQ_CONV avs n ath eth tm;; + +let RESOLVE_NE = + let NEGATE_NEGATE_RULE = GEN_REWRITE_RULE I [TAUT `p <=> (~p <=> F)`] in + fun asm tm -> + try let th = RESOLVE_EQ asm (rand tm) in + if is_neg(concl th) then EQT_INTRO th + else NEGATE_NEGATE_RULE th + with Failure _ -> REFL tm;; + +(* ------------------------------------------------------------------------- *) +(* Conversion for division of polynomials. *) +(* ------------------------------------------------------------------------- *) + +let LAST_CONV = GEN_REWRITE_CONV REPEATC [LAST_CLAUSES];; + +let LENGTH_CONV = + let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 LENGTH] + and cnv_1 = GEN_REWRITE_CONV I [CONJUNCT2 LENGTH] in + let rec LENGTH_CONV tm = + try cnv_0 tm with Failure _ -> + (cnv_1 THENC RAND_CONV LENGTH_CONV THENC NUM_SUC_CONV) tm in + LENGTH_CONV;; + +let EXPAND_EX_BETA_CONV = + let pth = prove(`EX P [c] = P c`,REWRITE_TAC[EX]) in + let cnv_0 = GEN_REWRITE_CONV I [CONJUNCT1 EX] + and cnv_1 = GEN_REWRITE_CONV I [pth] + and cnv_2 = GEN_REWRITE_CONV I [CONJUNCT2 EX] in + let rec EXPAND_EX_BETA_CONV tm = + try (cnv_1 THENC BETA_CONV) tm with Failure _ -> try + (cnv_2 THENC COMB2_CONV (RAND_CONV BETA_CONV) + EXPAND_EX_BETA_CONV) tm + with Failure _ -> cnv_0 tm in + EXPAND_EX_BETA_CONV;; + +let POLY_DIVIDES_PAD_RULE = + let pth = prove + (`p divides q ==> p divides (CONS (Cx(&0)) q)`, + REWRITE_TAC[divides; FUN_EQ_THM; POLY_MUL; poly; COMPLEX_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `r:complex list` ASSUME_TAC) THEN + EXISTS_TAC `[Cx(&0); Cx(&1)] ** r` THEN + ASM_REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_ADD_RID; + COMPLEX_MUL_RID; POLY_MUL] THEN + REWRITE_TAC[COMPLEX_MUL_AC]) in + let APPLY_pth = MATCH_MP pth in + fun avs n tm -> + funpow n + (CONV_RULE(RAND_CONV(LAND_CONV(MPOLY_BASE_CONV (tl avs)))) o APPLY_pth) + (SPEC tm POLY_DIVIDES_REFL);; + +let POLY_DIVIDES_PAD_CONST_RULE = + let pth = prove + (`p divides q ==> !a. p divides (a ## q)`, + REWRITE_TAC[FUN_EQ_THM; divides; POLY_CMUL; POLY_MUL] THEN + DISCH_THEN(X_CHOOSE_THEN `r:complex list` ASSUME_TAC) THEN + X_GEN_TAC `a:complex` THEN EXISTS_TAC `[a] ** r` THEN + ASM_REWRITE_TAC[POLY_MUL; poly] THEN SIMPLE_COMPLEX_ARITH_TAC) in + let APPLY_pth = MATCH_MP pth in + fun avs n a tm -> + let th1 = POLY_DIVIDES_PAD_RULE avs n tm in + let th2 = SPEC a (APPLY_pth th1) in + CONV_RULE(RAND_CONV(MPOLY_TCMUL_CONV avs)) th2;; + +let EXPAND_EX_BETA_RESOLVE_CONV asm tm = + let th1 = EXPAND_EX_BETA_CONV tm in + let djs = disjuncts(rand(concl th1)) in + let th2 = end_itlist MK_DISJ (map (RESOLVE_NE asm) djs) in + TRANS th1 th2;; + +let POLY_DIVIDES_CONV = + let pth_0 = prove + (`LENGTH q < LENGTH p + ==> ~(LAST p = Cx(&0)) + ==> (p divides q <=> ~(EX (\c. ~(c = Cx(&0))) q))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[NOT_EX; GSYM POLY_ZERO] THEN EQ_TAC THENL + [ALL_TAC; + SIMP_TAC[divides; POLY_MUL; FUN_EQ_THM] THEN + DISCH_TAC THEN EXISTS_TAC `[]:complex list` THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO]] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_DEGREE) THEN + MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> (a \/ b ==> b)`) THEN + DISCH_TAC THEN REWRITE_TAC[NOT_LE] THEN ASM_SIMP_TAC[NORMAL_DEGREE] THEN + REWRITE_TAC[degree] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `lq < lp ==> ~(lq = 0) /\ dq <= lq - 1 ==> dq < lp - 1`)) THEN + CONJ_TAC THENL [ASM_MESON_TAC[LENGTH_EQ_NIL]; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `m <= n ==> PRE m <= n - 1`) THEN + REWRITE_TAC[LENGTH_NORMALIZE_LE]) in + let APPLY_pth0 = PART_MATCH (lhand o rand o rand) pth_0 in + let pth_1 = prove + (`~(a = Cx(&0)) + ==> p divides p' + ==> (!x. a * poly q x - poly p' x = poly r x) + ==> (p divides q <=> p divides r)`, + DISCH_TAC THEN REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:complex list` THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `s:complex list` MP_TAC) THENL + [DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC `a ## s ++ --(Cx(&1)) ## t` THEN + REWRITE_TAC[POLY_MUL; POLY_ADD; POLY_CMUL] THEN + REWRITE_TAC[poly] THEN SIMPLE_COMPLEX_ARITH_TAC; + REWRITE_TAC[POLY_MUL] THEN DISCH_TAC THEN + EXISTS_TAC `[inv(a)] ** (t ++ s)` THEN + X_GEN_TAC `z:complex` THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[POLY_MUL; POLY_ADD; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + SUBGOAL_THEN `a * poly q z = (poly t z + poly s z) * poly p z` + MP_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `z:complex`) THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o AP_TERM `( * ) (inv a)`) THEN + ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV; COMPLEX_MUL_LID]]) in + let MATCH_pth1 = MATCH_MP pth_1 in + let rec DIVIDE_STEP_CONV avs sfn n tm = + let m = length(dest_list(rand tm)) in + if m < n then REFL tm else + let th1 = POLY_DIVIDES_PAD_CONST_RULE avs (m - n) + (last(dest_list(rand tm))) (lhand tm) in + let th2 = MATCH_MP (sfn tm) th1 in + let av,bod = dest_forall(lhand(concl th2)) in + let tm1 = vsubst [hd avs,av] (lhand bod) in + let th3 = (LAND_CONV (MPOLY_CMUL_CONV avs) THENC MPOLY_SUB_CONV avs) tm1 in + let th4 = MATCH_MP th2 (GEN (hd avs) th3) in + TRANS th4 (DIVIDE_STEP_CONV avs sfn n (rand(concl th4))) in + let zero_tm = `Cx(&0)` in + fun asm avs tm -> + let ath = RESOLVE_EQ asm (mk_eq(last(dest_list(lhand tm)),zero_tm)) in + let sfn = PART_MATCH (lhand o rand o rand) (MATCH_pth1 ath) + and n = length(dest_list(lhand tm)) in + let th1 = DIVIDE_STEP_CONV avs sfn n tm in + let th2 = APPLY_pth0 (rand(concl th1)) in + let th3 = (BINOP_CONV LENGTH_CONV THENC NUM_LT_CONV) (lhand(concl th2)) in + let th4 = MP th2 (EQT_ELIM th3) in + let th5 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th4 in + let th6 = TRANS th1 (MP th5 ath) in + CONV_RULE(RAND_CONV(RAND_CONV(EXPAND_EX_BETA_RESOLVE_CONV asm))) th6;; + +(* ------------------------------------------------------------------------- *) +(* Apply basic Nullstellensatz principle. *) +(* ------------------------------------------------------------------------- *) + +let BASIC_QUELIM_CONV = + let pth_1 = prove + (`((?x. (poly p x = Cx(&0)) /\ ~(poly [] x = Cx(&0))) <=> F) /\ + ((?x. ~(poly [] x = Cx(&0))) <=> F) /\ + ((?x. ~(poly [c] x = Cx(&0))) <=> ~(c = Cx(&0))) /\ + ((?x. (poly [] x = Cx(&0))) <=> T) /\ + ((?x. (poly [c] x = Cx(&0))) <=> (c = Cx(&0)))`, + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in + let APPLY_pth1 = GEN_REWRITE_CONV I [pth_1] in + let pth_2 = prove + (`~(LAST(CONS a (CONS b p)) = Cx(&0)) + ==> ((?x. poly (CONS a (CONS b p)) x = Cx(&0)) <=> T)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `CONS (a:complex) (CONS b p)` + FUNDAMENTAL_THEOREM_OF_ALGEBRA_ALT) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[NOT_EXISTS_THM; CONS_11] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(ALL (\c. c = Cx(&0)) (CONS b p))` + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]) THEN + UNDISCH_TAC `~(LAST (CONS a (CONS b p)) = Cx (&0))` THEN + ONCE_REWRITE_TAC[LAST] THEN REWRITE_TAC[NOT_CONS_NIL] THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + SPEC_TAC(`p:complex list`,`p:complex list`) THEN + LIST_INDUCT_TAC THEN ONCE_REWRITE_TAC[LAST] THEN + REWRITE_TAC[ALL; NOT_CONS_NIL] THEN + STRIP_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_imp o concl) THEN + REWRITE_TAC[LAST] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ALL]) in + let APPLY_pth2 = PART_MATCH (lhand o rand) pth_2 in + let pth_2b = prove + (`(?x. ~(poly p x = Cx(&0))) <=> EX (\c. ~(c = Cx(&0))) p`, + REWRITE_TAC[GSYM NOT_FORALL_THM] THEN + ONCE_REWRITE_TAC[TAUT `(~a <=> b) <=> (a <=> ~b)`] THEN + REWRITE_TAC[NOT_EX; GSYM POLY_ZERO; poly; FUN_EQ_THM]) in + let APPLY_pth2b = GEN_REWRITE_CONV I [pth_2b] in + let pth_3 = prove + (`~(LAST(CONS a p) = Cx(&0)) + ==> ((?x. (poly (CONS a p) x = Cx(&0)) /\ ~(poly q x = Cx(&0))) <=> + ~((CONS a p) divides (q exp (LENGTH p))))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`CONS (a:complex) p`; `q:complex list`] + NULLSTELLENSATZ_UNIVARIATE) THEN + ASM_SIMP_TAC[degree; NORMALIZE_EQ; LENGTH; PRE] THEN + SUBGOAL_THEN `~(poly (CONS a p) = poly [])` + (fun th -> REWRITE_TAC[th] THEN MESON_TAC[]) THEN + REWRITE_TAC[POLY_ZERO] THEN POP_ASSUM MP_TAC THEN + SPEC_TAC(`p:complex list`,`p:complex list`) THEN + REWRITE_TAC[LAST] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; ALL; NOT_CONS_NIL] THEN + POP_ASSUM MP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[ALL] THEN + CONV_TAC TAUT) in + let APPLY_pth3 = PART_MATCH (lhand o rand) pth_3 in + let POLY_EXP_DIVIDES_CONV = + let pth_4 = prove + (`(!x. (poly (q exp n) x = poly r x)) + ==> (p divides (q exp n) <=> p divides r)`, + SIMP_TAC[divides; POLY_EXP; FUN_EQ_THM]) in + let APPLY_pth4 = MATCH_MP pth_4 + and poly_tm = `poly` + and REWR_POLY_EXP_CONV = REWR_CONV POLY_EXP in + let POLY_EXP_DIVIDES_CONV avs tm = + let tm1 = mk_comb(mk_comb(poly_tm,rand tm),hd avs) in + let th1 = REWR_POLY_EXP_CONV tm1 in + let th2 = TRANS th1 (MPOLY_POW_CONV avs (rand(concl th1))) in + PART_MATCH lhand (APPLY_pth4 (GEN (hd avs) th2)) tm in + POLY_EXP_DIVIDES_CONV in + fun asm avs tm -> + try APPLY_pth1 tm with Failure _ -> + try let th1 = APPLY_pth2 tm in + let th2 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th1 in + let th3 = try MATCH_MP th2 (RESOLVE_EQ asm (rand(lhand(concl th2)))) + with Failure _ -> failwith "Sanity failure (2a)" in + th3 + with Failure _ -> try + let th1 = APPLY_pth2b tm in + TRANS th1 (EXPAND_EX_BETA_RESOLVE_CONV asm (rand(concl th1))) + with Failure _ -> + let th1 = APPLY_pth3 tm in + let th2 = CONV_RULE(LAND_CONV(RAND_CONV(LAND_CONV LAST_CONV))) th1 in + let th3 = try MATCH_MP th2 (RESOLVE_EQ asm (rand(lhand(concl th2)))) + with Failure _ -> failwith "Sanity failure (2b)" in + let th4 = CONV_RULE (funpow 4 RAND_CONV LENGTH_CONV) th3 in + let th5 = + CONV_RULE(RAND_CONV(RAND_CONV(POLY_EXP_DIVIDES_CONV avs))) th4 in + CONV_RULE(RAND_CONV(RAND_CONV(POLY_DIVIDES_CONV asm avs))) th5;; + +(* ------------------------------------------------------------------------- *) +(* Put into canonical form by multiplying inequalities. *) +(* ------------------------------------------------------------------------- *) + +let POLY_NE_MULT_CONV = + let pth = prove + (`~(poly p x = Cx(&0)) /\ ~(poly q x = Cx(&0)) <=> + ~(poly p x * poly q x = Cx(&0))`, + REWRITE_TAC[COMPLEX_ENTIRE; DE_MORGAN_THM]) in + let APPLY_pth = REWR_CONV pth in + let rec POLY_NE_MULT_CONV avs tm = + if not(is_conj tm) then REFL tm else + let l,r = dest_conj tm in + let th1 = MK_COMB(AP_TERM (rator(rator tm)) (POLY_NE_MULT_CONV avs l), + POLY_NE_MULT_CONV avs r) in + let th2 = TRANS th1 (APPLY_pth (rand(concl th1))) in + CONV_RULE(RAND_CONV(RAND_CONV(LAND_CONV(MPOLY_MUL_CONV avs)))) th2 in + POLY_NE_MULT_CONV;; + +let CORE_QUELIM_CONV = + let CONJ_AC_RULE = AC CONJ_ACI in + let CORE_QUELIM_CONV asm avs tm = + let ev,bod = dest_exists tm in + let cjs = conjuncts bod in + let eqs,neqs = partition is_eq cjs in + if eqs = [] then + let th1 = MK_EXISTS ev (POLY_NE_MULT_CONV avs bod) in + TRANS th1 (BASIC_QUELIM_CONV asm avs (rand(concl th1))) + else if length eqs > 1 then failwith "CORE_QUELIM_CONV: Sanity failure" + else if neqs = [] then BASIC_QUELIM_CONV asm avs tm else + let tm1 = mk_conj(hd eqs,list_mk_conj neqs) in + let th1 = CONJ_AC_RULE(mk_eq(bod,tm1)) in + let th2 = CONV_RULE(funpow 2 RAND_CONV(POLY_NE_MULT_CONV avs)) th1 in + let th3 = MK_EXISTS ev th2 in + TRANS th3 (BASIC_QUELIM_CONV asm avs (rand(concl th3))) in + CORE_QUELIM_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Main elimination coversion (for a single quantifier). *) +(* ------------------------------------------------------------------------- *) + +let RESOLVE_EQ_NE = + let DNE_RULE = GEN_REWRITE_RULE I + [TAUT `((p <=> T) <=> (~p <=> F)) /\ ((p <=> F) <=> (~p <=> T))`] in + fun asm tm -> + if is_neg tm then DNE_RULE(RESOLVE_EQ_RAW asm (rand tm)) + else RESOLVE_EQ_RAW asm tm;; + +let COMPLEX_QUELIM_CONV = + let pth_0 = prove + (`((poly [] x = Cx(&0)) <=> T) /\ + ((poly [] x = Cx(&0)) /\ p <=> p)`, + REWRITE_TAC[poly]) + and pth_1 = prove + (`(~(poly [] x = Cx(&0)) <=> F) /\ + (~(poly [] x = Cx(&0)) /\ p <=> F)`, + REWRITE_TAC[poly]) + and pth_2 = prove + (`(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`, + CONV_TAC TAUT) + and zero_tm = `Cx(&0)` + and true_tm = `T` in + let ELIM_ZERO_RULE = GEN_REWRITE_RULE RAND_CONV [pth_0] + and ELIM_NONZERO_RULE = GEN_REWRITE_RULE RAND_CONV [pth_1] + and INCORP_ASSUM_THM = MATCH_MP pth_2 + and CONJ_AC_RULE = AC CONJ_ACI in + let POLY_CONST_CONV = + let pth = prove + (`((poly [c] x = y) <=> (c = y)) /\ + (~(poly [c] x = y) <=> ~(c = y))`, + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID]) in + TRY_CONV(GEN_REWRITE_CONV I [pth]) in + let EXISTS_TRIV_CONV = REWR_CONV EXISTS_SIMP + and EXISTS_PUSH_CONV = REWR_CONV RIGHT_EXISTS_AND_THM + and AND_SIMP_CONV = GEN_REWRITE_CONV DEPTH_CONV + [TAUT `(p /\ F <=> F) /\ (p /\ T <=> p) /\ + (F /\ p <=> F) /\ (T /\ p <=> p)`] + and RESOLVE_OR_CONST_CONV asm tm = + try RESOLVE_EQ_NE asm tm with Failure _ -> POLY_CONST_CONV tm + and false_tm = `F` in + let rec COMPLEX_QUELIM_CONV asm avs tm = + let ev,bod = dest_exists tm in + let cjs = conjuncts bod in + let cjs_set = setify cjs in + if length cjs_set < length cjs then + let th1 = CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs_set)) in + let th2 = MK_EXISTS ev th1 in + TRANS th2 (COMPLEX_QUELIM_CONV asm avs (rand(concl th2))) + else + let eqs,neqs = partition is_eq cjs in + let lens = map (length o dest_list o lhand o lhs) eqs + and nens = map (length o dest_list o lhand o lhs o rand) neqs in + try let zeq = el (index 0 lens) eqs in + if cjs = [zeq] then BASIC_QUELIM_CONV asm avs tm else + let cjs' = zeq::(subtract cjs [zeq]) in + let th1 = ELIM_ZERO_RULE(CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs'))) in + let th2 = MK_EXISTS ev th1 in + TRANS th2 (COMPLEX_QUELIM_CONV asm avs (rand(concl th2))) + with Failure _ -> try + let zne = el (index 0 nens) neqs in + if cjs = [zne] then BASIC_QUELIM_CONV asm avs tm else + let cjs' = zne::(subtract cjs [zne]) in + let th1 = ELIM_NONZERO_RULE + (CONJ_AC_RULE(mk_eq(bod,list_mk_conj cjs'))) in + CONV_RULE (RAND_CONV EXISTS_TRIV_CONV) (MK_EXISTS ev th1) + with Failure _ -> try + let ones = map snd (filter (fun (n,_) -> n = 1) + (zip lens eqs @ zip nens neqs)) in + if ones = [] then failwith "" else + let cjs' = subtract cjs ones in + if cjs' = [] then + let th1 = MK_EXISTS ev (SUBS_CONV(map POLY_CONST_CONV cjs) bod) in + TRANS th1 (EXISTS_TRIV_CONV (rand(concl th1))) + else + let tha = SUBS_CONV (map (RESOLVE_OR_CONST_CONV asm) ones) + (list_mk_conj ones) in + let thb = CONV_RULE (RAND_CONV AND_SIMP_CONV) tha in + if rand(concl thb) = false_tm then + let thc = MK_CONJ thb (REFL(list_mk_conj cjs')) in + let thd = CONV_RULE(RAND_CONV AND_SIMP_CONV) thc in + let the = CONJ_AC_RULE(mk_eq(bod,lhand(concl thd))) in + let thf = MK_EXISTS ev (TRANS the thd) in + CONV_RULE(RAND_CONV EXISTS_TRIV_CONV) thf + else + let thc = MK_CONJ thb (REFL(list_mk_conj cjs')) in + let thd = CONJ_AC_RULE(mk_eq(bod,lhand(concl thc))) in + let the = MK_EXISTS ev (TRANS thd thc) in + let th4 = TRANS the(EXISTS_PUSH_CONV(rand(concl the))) in + let tm4 = rand(concl th4) in + let th5 = COMPLEX_QUELIM_CONV asm avs (rand tm4) in + TRANS th4 (AP_TERM (rator tm4) th5) + with Failure _ -> + if eqs = [] or + (length eqs = 1 & + (let ceq = mk_eq(last(dest_list(lhand(lhs(hd eqs)))),zero_tm) in + try concl(RESOLVE_EQ asm ceq) = mk_neg ceq with Failure _ -> false) & + (let h = hd lens in forall (fun n -> n < h) nens)) + then + CORE_QUELIM_CONV asm avs tm + else + let n = end_itlist min lens in + let eq = el (index n lens) eqs in + let pol = lhand(lhand eq) in + let atm = last(dest_list pol) in + let zeq = mk_eq(atm,zero_tm) in + RESOLVE_EQ_THEN asm zeq + (fun asm' yth -> + let th0 = TRANS yth (MPOLY_BASE_CONV (tl avs) zero_tm) in + let th1 = + GEN_REWRITE_CONV + (LAND_CONV o LAND_CONV o funpow (n - 1) RAND_CONV o LAND_CONV) + [th0] eq in + let th2 = LAND_CONV(MPOLY_NORM_CONV avs) (rand(concl th1)) in + let th3 = MK_EXISTS ev (SUBS_CONV[TRANS th1 th2] bod) in + TRANS th3 (COMPLEX_QUELIM_CONV asm' avs (rand(concl th3)))) + (fun asm' nth -> + let oth = subtract cjs [eq] in + if oth = [] then COMPLEX_QUELIM_CONV asm' avs tm else + let eth = ASSUME eq in + let ths = map (POLY_CANCEL_ENE_CONV avs n nth eth) oth in + let th1 = DISCH eq (end_itlist MK_CONJ ths) in + let th2 = INCORP_ASSUM_THM th1 in + let th3 = TRANS (CONJ_AC_RULE(mk_eq(bod,lhand(concl th2)))) th2 in + let th4 = MK_EXISTS ev th3 in + TRANS th4 (COMPLEX_QUELIM_CONV asm' avs (rand(concl th4)))) in + fun asm avs -> time(COMPLEX_QUELIM_CONV asm avs);; + +(* ------------------------------------------------------------------------- *) +(* NNF conversion doing "conditionals" ~(p /\ q \/ ~p /\ r) intelligently. *) +(* ------------------------------------------------------------------------- *) + +let NNF_COND_CONV = + let NOT_EXISTS_UNIQUE_THM = prove + (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`, + REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in + let tauts = + [TAUT `~(~p) <=> p`; + TAUT `~(p /\ q) <=> ~p \/ ~q`; + TAUT `~(p \/ q) <=> ~p /\ ~q`; + TAUT `~(p ==> q) <=> p /\ ~q`; + TAUT `p ==> q <=> ~p \/ q`; + NOT_FORALL_THM; + NOT_EXISTS_THM; + EXISTS_UNIQUE_THM; + NOT_EXISTS_UNIQUE_THM; + TAUT `~(p <=> q) <=> (p /\ ~q) \/ (~p /\ q)`; + TAUT `(p <=> q) <=> (p /\ q) \/ (~p /\ ~q)`; + TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in + GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; + +(* ------------------------------------------------------------------------- *) +(* Overall procedure for multiple quantifiers in any first order formula. *) +(* ------------------------------------------------------------------------- *) + +let FULL_COMPLEX_QUELIM_CONV = + let ELIM_FORALL_CONV = + let pth = prove(`(!x. P x) <=> ~(?x. ~(P x))`,MESON_TAC[]) in + REWR_CONV pth in + let ELIM_EQ_CONV = + let pth = SIMPLE_COMPLEX_ARITH `(x = y) <=> (x - y = Cx(&0))` + and zero_tm = `Cx(&0)` in + let REWR_pth = REWR_CONV pth in + fun avs tm -> + if rand tm = zero_tm then LAND_CONV(POLYNATE_CONV avs) tm + else (REWR_pth THENC LAND_CONV(POLYNATE_CONV avs)) tm in + let SIMP_DNF_CONV = + GEN_REWRITE_CONV TOP_DEPTH_CONV (basic_rewrites()) THENC + NNF_COND_CONV THENC DNF_CONV in + let DISTRIB_EXISTS_CONV = GEN_REWRITE_CONV I [EXISTS_OR_THM] in + let TRIV_EXISTS_CONV = GEN_REWRITE_CONV I [EXISTS_SIMP] in + let complex_ty = `:complex` in + let FINAL_SIMP_CONV = + GEN_REWRITE_CONV DEPTH_CONV [CX_INJ] THENC + REAL_RAT_REDUCE_CONV THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV (basic_rewrites()) in + let rec FULL_COMPLEX_QUELIM_CONV avs tm = + if is_forall tm then + let th1 = ELIM_FORALL_CONV tm in + let th2 = FULL_COMPLEX_QUELIM_CONV avs (rand(concl th1)) in + TRANS th1 th2 + else if is_neg tm then + AP_TERM (rator tm) (FULL_COMPLEX_QUELIM_CONV avs (rand tm)) + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + let thl = FULL_COMPLEX_QUELIM_CONV avs l + and thr = FULL_COMPLEX_QUELIM_CONV avs r in + MK_COMB(AP_TERM(rator(rator tm)) thl,thr) + else if is_exists tm then + let ev,bod = dest_exists tm in + let th0 = FULL_COMPLEX_QUELIM_CONV (ev::avs) bod in + let th1 = MK_EXISTS ev (CONV_RULE(RAND_CONV SIMP_DNF_CONV) th0) in + TRANS th1 (DISTRIB_AND_COMPLEX_QUELIM_CONV (ev::avs) (rand(concl th1))) + else if is_eq tm then + ELIM_EQ_CONV avs tm + else failwith "unexpected type of formula" + and DISTRIB_AND_COMPLEX_QUELIM_CONV avs tm = + try TRIV_EXISTS_CONV tm + with Failure _ -> try + (DISTRIB_EXISTS_CONV THENC + BINOP_CONV (DISTRIB_AND_COMPLEX_QUELIM_CONV avs)) tm + with Failure _ -> COMPLEX_QUELIM_CONV [] avs tm in + fun tm -> + let avs = filter (fun t -> type_of t = complex_ty) (frees tm) in + (FULL_COMPLEX_QUELIM_CONV avs THENC FINAL_SIMP_CONV) tm;; diff --git a/Complex/quelim_examples.ml b/Complex/quelim_examples.ml new file mode 100644 index 0000000..8e5d021 --- /dev/null +++ b/Complex/quelim_examples.ml @@ -0,0 +1,185 @@ +(* ========================================================================= *) +(* Some examples of full complex quantifier elimination. *) +(* ========================================================================= *) + +let th = time prove + (`!x y. (x pow 2 = Cx(&2)) /\ (y pow 2 = Cx(&3)) + ==> ((x * y) pow 2 = Cx(&6))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`!x a. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0)) + ==> (x pow 4 + Cx(&1) = Cx(&0))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`!a x. (a pow 2 = Cx(&2)) /\ (x pow 2 + a * x + Cx(&1) = Cx(&0)) + ==> (x pow 4 + Cx(&1) = Cx(&0))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`~(?a x y. (a pow 2 = Cx(&2)) /\ + (x pow 2 + a * x + Cx(&1) = Cx(&0)) /\ + (y * (x pow 4 + Cx(&1)) + Cx(&1) = Cx(&0)))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`!x. ?y. x pow 2 = y pow 3`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`!x y z a b. (a + b) * (x - y + z) - (a - b) * (x + y + z) = + Cx(&2) * (b * x + b * z - a * y)`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`!a b. ~(a = b) ==> ?x y. (y * x pow 2 = a) /\ (y * x pow 2 + x = b)`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ + (a * y pow 2 + b * y + c = Cx(&0)) /\ + ~(x = y) + ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +let th = time prove + (`~(!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ + (a * y pow 2 + b * y + c = Cx(&0)) + ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0)))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +(** geometric example from ``Algorithms for Computer Algebra'': + right triangle where perp. bisector of hypotenuse passes through the + right angle is isoseles. + **) + +let th = time prove + (`!y_1 y_2 y_3 y_4. + (y_1 = Cx(&2) * y_3) /\ + (y_2 = Cx(&2) * y_4) /\ + (y_1 * y_3 = y_2 * y_4) + ==> (y_1 pow 2 = y_2 pow 2)`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +(** geometric example: gradient condition for two lines to be non-parallel. + **) + +let th = time prove + (`!a1 b1 c1 a2 b2 c2. + ~(a1 * b2 = a2 * b1) + ==> ?x y. (a1 * x + b1 * y = c1) /\ (a2 * x + b2 * y = c2)`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +(*********** Apparently takes too long + +let th = time prove + (`!a b c x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ + (a * y pow 2 + b * y + c = Cx(&0)) /\ + (!z. (a * z pow 2 + b * z + c = Cx(&0)) + ==> (z = x) \/ (z = y)) + ==> (a * x * y = c) /\ (a * (x + y) + b = Cx(&0))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + +*************) + +(* ------------------------------------------------------------------------- *) +(* Any three points determine a circle. Not true in complex number version! *) +(* ------------------------------------------------------------------------- *) + +(******** And it takes a lot of memory! + +let th = time prove + (`~(!x1 y1 x2 y2 x3 y3. + ?x0 y0. ((x1 - x0) pow 2 + (y1 - y0) pow 2 = + (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ + ((x2 - x0) pow 2 + (y2 - y0) pow 2 = + (x3 - x0) pow 2 + (y3 - y0) pow 2))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + + **************) + +(* ------------------------------------------------------------------------- *) +(* To show we don't need to consider only closed formulas. *) +(* Can eliminate some, then deal with the rest manually and painfully. *) +(* ------------------------------------------------------------------------- *) + +let th = time prove + (`(?x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ + (a * y pow 2 + b * y + c = Cx(&0)) /\ + ~(x = y)) <=> + (a = Cx(&0)) /\ (b = Cx(&0)) /\ (c = Cx(&0)) \/ + ~(a = Cx(&0)) /\ ~(b pow 2 = Cx(&4) * a * c)`, + CONV_TAC(LAND_CONV FULL_COMPLEX_QUELIM_CONV) THEN + REWRITE_TAC[poly; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; REAL_OF_NUM_EQ; ARITH] THEN + ASM_CASES_TAC `a = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THENL + [ASM_CASES_TAC `b = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO]; + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `b * b * c * Cx(--(&1)) + a * c * c * Cx(&4) = + c * (Cx(&4) * a * c - b * b)`] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `b * b * b * Cx(--(&1)) + a * b * c * Cx (&4) = + b * (Cx(&4) * a * c - b * b)`] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `b * b * Cx (&1) + a * c * Cx(--(&4)) = + Cx(--(&1)) * (Cx(&4) * a * c - b * b)`] THEN + REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_SUB_0; CX_INJ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `c = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_POW_2; COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[EQ_SYM_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* Do the same thing directly. *) +(* ------------------------------------------------------------------------- *) + +(**** This seems barely feasible + +let th = time prove + (`!a b c. + (?x y. (a * x pow 2 + b * x + c = Cx(&0)) /\ + (a * y pow 2 + b * y + c = Cx(&0)) /\ + ~(x = y)) <=> + (a = Cx(&0)) /\ (b = Cx(&0)) /\ (c = Cx(&0)) \/ + ~(a = Cx(&0)) /\ ~(b pow 2 = Cx(&4) * a * c)`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + + ****) + +(* ------------------------------------------------------------------------- *) +(* More ambitious: determine a unique circle. Also not true over complexes. *) +(* (consider the points (k, k i) where i is the imaginary unit...) *) +(* ------------------------------------------------------------------------- *) + +(********** Takes too long, I think, and too much memory too + +let th = prove + (`~(!x1 y1 x2 y2 x3 y3 x0 y0 x0' y0'. + ((x1 - x0) pow 2 + (y1 - y0) pow 2 = + (x2 - x0) pow 2 + (y2 - y0) pow 2) /\ + ((x2 - x0) pow 2 + (y2 - y0) pow 2 = + (x3 - x0) pow 2 + (y3 - y0) pow 2) /\ + ((x1 - x0') pow 2 + (y1 - y0') pow 2 = + (x2 - x0') pow 2 + (y2 - y0') pow 2) /\ + ((x2 - x0') pow 2 + (y2 - y0') pow 2 = + (x3 - x0') pow 2 + (y3 - y0') pow 2) + ==> (x0 = x0') /\ (y0 = y0'))`, + CONV_TAC FULL_COMPLEX_QUELIM_CONV);; + + *************) + +(* ------------------------------------------------------------------------- *) +(* Side of a triangle in terms of its bisectors; Kapur survey 5.1. *) +(* ------------------------------------------------------------------------- *) + +(************* +let th = time FULL_COMPLEX_QUELIM_CONV + `?b c. (p1 = ai pow 2 * (b + c) pow 2 - c * b * (c + b - a) * (c + b + a)) /\ + (p2 = ae pow 2 * (c - b) pow 2 - c * b * (a + b - c) * (a - b + a)) /\ + (p3 = be pow 2 * (c - a) pow 2 - a * c * (a + b - c) * (c + b - a))`;; + + *************) diff --git a/Examples/borsuk.ml b/Examples/borsuk.ml new file mode 100644 index 0000000..09551e9 --- /dev/null +++ b/Examples/borsuk.ml @@ -0,0 +1,185 @@ +(* ========================================================================= *) +(* Borsuk-Ulam theorem for an ordinary 2-sphere in real^3. *) +(* From Andrew Browder's article, AMM vol. 113 (2006), pp. 935-6 *) +(* ========================================================================= *) + +needs "Multivariate/moretop.ml";; + +(* ------------------------------------------------------------------------- *) +(* The Borsuk-Ulam theorem for the unit sphere. *) +(* ------------------------------------------------------------------------- *) + +let THEOREM_1 = prove + (`!f:real^3->real^2. + f continuous_on {x | norm(x) = &1} + ==> ?x. norm(x) = &1 /\ f(--x) = f(x)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN + PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + DISCH_TAC THEN + ABBREV_TAC `(g:real^3->real^2) = \x. f(x) - f(--x)` THEN + ABBREV_TAC `k = \z. (g:real^3->real^2) + (vector[Re z; Im z; sqrt(&1 - norm z pow 2)])` THEN + MP_TAC(ISPECL [`k:complex->complex`; `Cx(&0)`; `&1`] + CONTINUOUS_LOGARITHM_ON_CBALL) THEN + MATCH_MP_TAC(TAUT `a /\ (a /\ b ==> c) ==> (a ==> b) ==> c`) THEN + CONJ_TAC THENL + [CONJ_TAC THENL + [EXPAND_TAC "k" THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_COMPONENTWISE] THEN + SIMP_TAC[DIMINDEX_3; FORALL_3; VECTOR_3; ETA_AX] THEN + REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_WITHIN_COMPOSE) THEN + SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_POW; + REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_NORM_WITHIN] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN + EXISTS_TAC `{t | &0 <= t}` THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SQRT_STRONG] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_CBALL; IN_ELIM_THM; dist; + COMPLEX_SUB_LZERO; NORM_NEG; REAL_SUB_LE] THEN + REWRITE_TAC[ABS_SQUARE_LE_1; REAL_ABS_NORM]; + ALL_TAC] THEN + EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[linear] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC; + REWRITE_TAC[GSYM IMAGE_o]]] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `{x:real^3 | norm x = &1}` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_ELIM_THM] THEN + SIMP_TAC[NORM_EQ_1; DOT_3; VECTOR_3; VECTOR_NEG_COMPONENT; dist; + DIMINDEX_3; ARITH; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG] THEN + REWRITE_TAC[REAL_NEG_MUL2] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC; + X_GEN_TAC `z:complex` THEN + REWRITE_TAC[dist; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG] THEN + DISCH_TAC THEN MAP_EVERY EXPAND_TAC ["k"; "g"] THEN + REWRITE_TAC[COMPLEX_RING `x - y = Cx(&0) <=> y = x`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NORM_EQ_1; DOT_3; VECTOR_3]] THEN + REWRITE_TAC[GSYM REAL_POW_2; COMPLEX_SQNORM] THEN + REWRITE_TAC[REAL_ARITH `r + i + s = &1 <=> s = &1 - (r + i)`] THEN + MATCH_MP_TAC SQRT_POW_2 THEN REWRITE_TAC[GSYM COMPLEX_SQNORM] THEN + ASM_SIMP_TAC[REAL_SUB_LE; ABS_SQUARE_LE_1; REAL_ABS_NORM]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `m = \z:complex. (h(z) - h(--z)) / (Cx pi * ii)` THEN + SUBGOAL_THEN + `!z:complex. norm(z) = &1 ==> cexp(Cx pi * ii * m z) = cexp(Cx pi * ii)` + MP_TAC THENL + [EXPAND_TAC "m" THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB; complex_div; COMPLEX_SUB_RDISTRIB] THEN + SIMP_TAC[CX_INJ; PI_NZ; CEXP_SUB; COMPLEX_FIELD + `~(p = Cx(&0)) ==> p * ii * h * inv(p * ii) = h`] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `cexp(h z) = k z /\ cexp(h(--z:complex)) = k(--z)` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[dist; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[EULER; RE_MUL_CX; IM_MUL_CX; RE_II; IM_II; COMPLEX_ADD_RID; + REAL_MUL_RZERO; REAL_MUL_RID; SIN_PI; COS_PI; REAL_EXP_0; + COMPLEX_MUL_RZERO; COMPLEX_MUL_LID] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(y = Cx(&0)) /\ x = -- y ==> x / y = Cx(-- &1)`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[dist; IN_CBALL; COMPLEX_SUB_LZERO; NORM_NEG; REAL_LE_REFL]; + MAP_EVERY EXPAND_TAC ["k"; "g"] THEN + REWRITE_TAC[COMPLEX_NEG_SUB] THEN BINOP_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; FORALL_3; VECTOR_3; VECTOR_NEG_COMPONENT; + DIMINDEX_3; ARITH; RE_NEG; IM_NEG; NORM_NEG; REAL_NEG_NEG] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SQRT_0; REAL_NEG_0]]; + ALL_TAC] THEN + REWRITE_TAC[CEXP_EQ; CX_MUL] THEN + SIMP_TAC[CX_INJ; PI_NZ; COMPLEX_FIELD + `~(p = Cx(&0)) + ==> (p * ii * m = p * ii + (t * n * p) * ii <=> m = t * n + Cx(&1))`] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL] THEN DISCH_THEN(LABEL_TAC "*") THEN + SUBGOAL_THEN + `?n. !z. z IN {z | norm(z) = &1} ==> (m:complex->complex)(z) = n` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[NORM_ARITH `norm z = dist(vec 0,z)`] THEN + SIMP_TAC[GSYM sphere; CONNECTED_SPHERE; DIMINDEX_2; LE_REFL]; + ALL_TAC] THEN + CONJ_TAC THENL + [EXPAND_TAC "m" THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN + SIMP_TAC[CONTINUOUS_ON_CONST; COMPLEX_ENTIRE; II_NZ; CX_INJ; PI_NZ] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[linear] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC; + REWRITE_TAC[GSYM IMAGE_o]]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; NORM_NEG; IN_CBALL; + COMPLEX_SUB_LZERO; dist; IN_ELIM_THM; REAL_LE_REFL]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + REMOVE_THEN "*" (fun th -> MP_TAC(SPEC `w:complex` th) THEN + MP_TAC(SPEC `z:complex` th)) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CHOOSE_THEN + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC))) THEN + REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `~(abs(x - y) < &1) ==> &1 <= abs((&2 * x + &1) - (&2 * y + &1))`) THEN + ASM_SIMP_TAC[GSYM REAL_EQ_INTEGERS] THEN ASM_MESON_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `v:complex`)] THEN + SUBGOAL_THEN + `?n. integer n /\ !z:complex. norm z = &1 ==> m z = Cx(&2 * n + &1)` + MP_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `Cx(&1)`) THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real` MP_TAC) THEN EXPAND_TAC "m" THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `--Cx(&1)` th) THEN + MP_TAC(SPEC `Cx(&1)` th)) THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[complex_div; COMPLEX_SUB_RDISTRIB] THEN + MATCH_MP_TAC(COMPLEX_RING + `~(z = Cx(&0)) ==> a - b = z ==> ~(b - a = z)`) THEN + REWRITE_TAC[CX_INJ; REAL_ARITH `&2 * n + &1 = &0 <=> n = --(&1 / &2)`] THEN + UNDISCH_TAC `integer n` THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN + SIMP_TAC[] THEN DISCH_TAC THEN REWRITE_TAC[integer] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_DIV; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `a / &2 = n <=> a = &2 * n`] THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* The Borsuk-Ulam theorem for a general sphere. *) +(* ------------------------------------------------------------------------- *) + +let BORSUK_ULAM = prove + (`!f:real^3->real^2 a r. + &0 <= r /\ f continuous_on {z | norm(z - a) = r} + ==> ?x. norm(x) = r /\ f(a + x) = f(a - x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x. (f:real^3->real^2) (a + r % x)` THEOREM_1) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM]; + DISCH_THEN(X_CHOOSE_THEN `x:real^3` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `r % x:real^3` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a - r % x:real^3 = a + r % --x`]] THEN + ASM_SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL] THEN ASM_REAL_ARITH_TAC);; diff --git a/Examples/brunn_minkowski.ml b/Examples/brunn_minkowski.ml new file mode 100644 index 0000000..1da2ec0 --- /dev/null +++ b/Examples/brunn_minkowski.ml @@ -0,0 +1,1384 @@ +(* ========================================================================= *) +(* Brunn-Minkowski theorem and related results. *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* First, the special case of a box. *) +(* ------------------------------------------------------------------------- *) + +let BRUNN_MINKOWSKI_INTERVAL = prove + (`!a b c d:real^N. + ~(interval[a,b] = {}) /\ ~(interval[c,d] = {}) + ==> root (dimindex(:N)) + (measure {x + y | x IN interval[a,b] /\ y IN interval[c,d]}) + >= root (dimindex(:N)) (measure(interval[a,b])) + + root (dimindex(:N)) (measure(interval[c,d]))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUMS_INTERVALS; real_ge] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_CASES_TAC `measure(interval[a:real^N,b]) = &0` THENL + [ASM_SIMP_TAC[ROOT_0; DIMINDEX_GE_1; LE_1; REAL_ADD_LID; + ROOT_MONO_LE_EQ; MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN + ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL; + VECTOR_ADD_COMPONENT; + REAL_ARITH `a <= b /\ c <= d ==> a + c <= b + d`] THEN + MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + SIMP_TAC[MEASURABLE_MEASURE_EQ_0; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN STRIP_TAC] THEN + ASM_CASES_TAC `measure(interval[c:real^N,d]) = &0` THENL + [ASM_SIMP_TAC[ROOT_0; DIMINDEX_GE_1; LE_1; REAL_ADD_RID; + ROOT_MONO_LE_EQ; MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN + ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL; + VECTOR_ADD_COMPONENT; + REAL_ARITH `a <= b /\ c <= d ==> a + c <= b + d`] THEN + MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + SIMP_TAC[MEASURABLE_MEASURE_EQ_0; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN STRIP_TAC] THEN + ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL; VECTOR_ADD_COMPONENT; + REAL_ARITH `a <= b /\ c <= d ==> a + c <= b + d`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + W(MP_TAC o PART_MATCH (rand o rand) REAL_LE_LDIV_EQ o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ROOT_POS_LT THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; PRODUCT_POS_LT_NUMSEG; IN_NUMSEG; + REAL_ARITH `a < b /\ c < d ==> &0 < (b + d) - (a + c)`; + DIMINDEX_GE_1; LE_1]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[GSYM REAL_ROOT_DIV] THEN + REWRITE_TAC[GSYM PRODUCT_DIV_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum (1..dimindex(:N)) + (\i. ((b:real^N)$i - (a:real^N)$i) / + ((b$i + d$i) - (a$i + c$i))) / &(dimindex(:N)) + + sum (1..dimindex(:N)) + (\i. ((d:real^N)$i - (c:real^N)$i) / + ((b$i + d$i) - (a$i + c$i))) / &(dimindex(:N))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) REAL_ROOT_LE o snd) THEN + (ANTS_TAC THENL + [SIMP_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_EQ; DIMINDEX_GE_1; LE_1; + REAL_LE_RDIV_EQ; REAL_MUL_LZERO] THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC AGM THEN + SIMP_TAC[HAS_SIZE_NUMSEG_1; DIMINDEX_GE_1; LE_1; IN_NUMSEG]]) THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN + ASM_SIMP_TAC[REAL_FIELD + `a < b /\ c < d + ==> (b - a) * inv((b + d) - (a + c)) + + (d - c) * inv((b + d) - (a + c)) = &1`] THEN + REWRITE_TAC[SUM_CONST_NUMSEG; ADD_SUB] THEN + ASM_SIMP_TAC[REAL_MUL_RID; REAL_MUL_RINV; REAL_LE_REFL; + REAL_OF_NUM_EQ; DIMINDEX_NONZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* Now for a finite union of boxes. *) +(* ------------------------------------------------------------------------- *) + +let BRUNN_MINKOWSKI_ELEMENTARY = prove + (`!s t:real^N->bool. + (s = {} <=> t = {}) /\ (?d. d division_of s) /\ (?d. d division_of t) + ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) + >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`s:real^N->bool`; `t:real^N->bool`; + `d1:(real^N->bool)->bool`; `d2:(real^N->bool)->bool`] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`] THEN + SIMP_TAC[MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO] THEN + STRIP_TAC THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN + ONCE_REWRITE_TAC[TAUT `p ==> q /\ r ==> s <=> q /\ p /\ r ==> s`]] THEN + X_CHOOSE_THEN `n:num` MP_TAC (ISPEC + `CARD(d1:(real^N->bool)->bool) + CARD(d2:(real^N->bool)->bool)` + (GSYM EXISTS_REFL)) THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) + [`t:real^N->bool`; `s:real^N->bool`; + `d2:(real^N->bool)->bool`; `d1:(real^N->bool)->bool`; `n:num`] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[MESON[] + `(!m. m < n ==> !a b c d. f a b = m /\ stuff a b c d ==> other a b c d) <=> + (!a b c d. f a b:num < n /\ stuff a b c d ==> other a b c d)`] THEN + DISCH_TAC THEN + MATCH_MP_TAC(MESON[] + `(!d d' s s'. P d d' s s' ==> P d' d s' s) /\ + (!d d' s s'. ~(2 <= CARD d) /\ ~(2 <= CARD d') ==> P d d' s s') /\ + (!d d' s s'. negligible s ==> P d d' s s') /\ + (!d d' s s'. 2 <= CARD d /\ ~(negligible s) /\ ~(negligible s') + ==> P d d' s s') + ==> !d d' s s'. P d d' s s'`) THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + CONJ_TAC THENL [REWRITE_TAC[ADD_SYM; CONJ_ACI]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x = y ==> x >= a + b ==> y >= b + a`) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]; + REPEAT GEN_TAC THEN + ASM_CASES_TAC `FINITE(d1:(real^N->bool)->bool) /\ + FINITE(d2:(real^N->bool)->bool)` + THENL [ALL_TAC; REWRITE_TAC[division_of] THEN ASM_MESON_TAC[]] THEN + ASM_SIMP_TAC[CARD_EQ_0; ARITH_RULE `~(2 <= n) <=> n = 0 \/ n = 1`] THEN + ASM_CASES_TAC `d1:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[EMPTY_DIVISION_OF] THEN MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `d2:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[EMPTY_DIVISION_OF] THEN MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `(d1:(real^N->bool)->bool) HAS_SIZE 1 /\ + (d2:(real^N->bool)->bool) HAS_SIZE 1` + MP_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN + CONV_TAC(LAND_CONV(BINOP_CONV HAS_SIZE_CONV)) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->bool` SUBST_ALL_TAC) + (X_CHOOSE_THEN `v:real^N->bool` SUBST_ALL_TAC)) THEN + STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of; UNIONS_1; IN_SING]) THEN + REPEAT(FIRST_X_ASSUM + (CONJUNCTS_THEN2 MP_TAC + (SUBST_ALL_TAC o SYM o CONJUNCT2) o CONJUNCT2)) THEN + REWRITE_TAC[FORALL_UNWIND_THM2] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BRUNN_MINKOWSKI_INTERVAL THEN + ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `measure(s:real^N->bool) = &0` SUBST1_TAC THENL + [ASM_SIMP_TAC[MEASURE_EQ_0]; ALL_TAC] THEN + SIMP_TAC[ROOT_0; DIMINDEX_NONZERO; REAL_ADD_LID; real_ge] THEN + MATCH_MP_TAC ROOT_MONO_LE THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN + SUBGOAL_THEN `?a:real^N. a IN s` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) t)` THEN CONJ_TAC THENL + [REWRITE_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_TRANSLATION_EQ] THEN + CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]] THEN + SUBGOAL_THEN + `!d1 d2 s t i j k. + CARD d1 + CARD d2 = n /\ + 1 <= k /\ k <= dimindex(:N) /\ ~(i = j) /\ + i IN d1 /\ i SUBSET {x:real^N | x$k <= &0} /\ + j IN d1 /\ j SUBSET {x | x$k >= &0} /\ + ~(negligible i) /\ ~(negligible j) /\ + ~(s = {}) /\ ~(t = {}) /\ ~(negligible s) /\ ~(negligible t) /\ + d1 division_of s /\ d2 division_of t + ==> root(dimindex (:N)) (measure {x + y | x IN s /\ y IN t}) >= + root(dimindex (:N)) (measure s) + root(dimindex (:N)) (measure t)` + MP_TAC THENL + [ALL_TAC; + POP_ASSUM(LABEL_TAC "*") THEN DISCH_THEN(LABEL_TAC "+") THEN + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?i:real^N->bool. i IN d1 /\ interior i = {}` THENL + [REMOVE_THEN "+" (K ALL_TAC) THEN REMOVE_THEN "*" MP_TAC THEN + DISCH_THEN(MP_TAC o SPECL + [`{i:real^N->bool | i IN d1 /\ ~(interior i = {})}`; + `d2:(real^N->bool)->bool`; + `UNIONS {i:real^N->bool | i IN d1 /\ ~(interior i = {})}`; + `t:real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [EXPAND_TAC "n" THEN REWRITE_TAC[LT_ADD_RCANCEL] THEN + MATCH_MP_TAC CARD_PSUBSET THEN CONJ_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[DIVISION_OF_FINITE]]; + DISCH_TAC THEN + SUBGOAL_THEN + `negligible(UNIONS {i | i IN d1 /\ ~(interior i = {})} UNION + UNIONS {i:real^N->bool | i IN d1 /\ interior i = {}})` + MP_TAC THENL + [ASM_REWRITE_TAC[UNION_EMPTY] THEN + MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN + ASM_MESON_TAC[DIVISION_OF_FINITE]; + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; NEGLIGIBLE_INTERVAL]]; + REWRITE_TAC[GSYM UNIONS_UNION; SET_RULE + `{x | x IN s /\ ~Q x} UNION {x | x IN s /\ Q x} = s`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC DIVISION_OF_SUBSET THEN + EXISTS_TAC `d1:(real^N->bool)->bool` THEN + CONJ_TAC THENL [ASM_MESON_TAC[division_of]; SET_TAC[]]]; + MATCH_MP_TAC(REAL_ARITH + `c' <= c /\ a' = a + ==> c' >= a' + b ==> c >= a + b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC ROOT_MONO_LE THEN REWRITE_TAC[DIMINDEX_NONZERO] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ELEMENTARY_COMPACT]] THEN + MATCH_MP_TAC COMPACT_UNIONS THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN + ASM_MESON_TAC[COMPACT_INTERVAL]; + MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + MATCH_MP_TAC(SET_RULE + `s' SUBSET s + ==> {f x y | x IN s' /\ y IN t} SUBSET + {f x y | x IN s /\ y IN t}`) THEN + SUBGOAL_THEN `s:real^N->bool = UNIONS d1` SUBST1_TAC THENL + [ASM_MESON_TAC[division_of]; + MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]]]; + AP_TERM_TAC THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `UNIONS {i:real^N->bool | i IN d1 /\ interior i = {}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN + ASM_MESON_TAC[DIVISION_OF_FINITE]; + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ] THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; NEGLIGIBLE_INTERVAL]]; + MATCH_MP_TAC(SET_RULE + `s' UNION s'' = s + ==> (s' DIFF s) UNION (s DIFF s') SUBSET s''`) THEN + REWRITE_TAC[GSYM UNIONS_UNION; SET_RULE + `{x | x IN s /\ ~Q x} UNION {x | x IN s /\ Q x} = s`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN + ASM_REWRITE_TAC[]]]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN + REMOVE_THEN "*" (K ALL_TAC) THEN + SUBGOAL_THEN + `?d:(real^N->bool)->bool. d SUBSET d1 /\ d HAS_SIZE 2` + MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP CHOOSE_SUBSET o + MATCH_MP DIVISION_OF_FINITE) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV HAS_SIZE_CONV)) THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` MP_TAC) THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `j:real^N->bool` MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN + REWRITE_TAC[UNWIND_THM2; INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN + MP_TAC(ASSUME `d1 division_of (s:real^N->bool)`) THEN + REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`i:real^N->bool`; `j:real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?u v w z. i = interval[u:real^N,v] /\ j = interval[w:real^N,z]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[DIVISION_OF]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM INTERIOR_INTER; INTER_INTERVAL] THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_EQ_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SIMP_TAC[LAMBDA_BETA; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_LE_BETWEEN] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `min v z <= a /\ a <= max u w + ==> u < v /\ w < z + ==> u <= a /\ v <= a /\ a <= w /\ a <= z \/ + w <= a /\ z <= a /\ a <= u /\ a <= v`)) THEN + ANTS_TAC THENL + [UNDISCH_TAC `!i:real^N->bool. i IN d1 ==> ~(interior i = {})` THEN + DISCH_THEN(fun th -> MP_TAC(ISPEC `interval[u:real^N,v]` th) THEN + MP_TAC(ISPEC `interval[w:real^N,z]` th)) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_NE_EMPTY] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`IMAGE (IMAGE (\x:real^N. x - a % basis k)) d1`; + `d2:(real^N->bool)->bool`; + `IMAGE (\x:real^N. x - a % basis k) s`; + `t:real^N->bool`]) + THENL + [DISCH_THEN(MP_TAC o SPECL + [`IMAGE (\x:real^N. x - a % basis k) i`; + `IMAGE (\x:real^N. x - a % basis k) j`; `k:num`]); + DISCH_THEN(MP_TAC o SPECL + [`IMAGE (\x:real^N. x - a % basis k) j`; + `IMAGE (\x:real^N. x - a % basis k) i`; `k:num`])] THEN + (ASM_REWRITE_TAC[] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "n" THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_FINITE]] THEN + MATCH_MP_TAC(MESON[] + `(!x y. Q x y ==> R x y) + ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN + REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC(SET_RULE + `(!x y. f x = f y ==> x = y) /\ ~(s = t) + ==> ~(IMAGE f s = IMAGE f t)`) THEN + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT; REAL_MUL_RID; REAL_LE_SUB_RADD; REAL_ADD_LID] THEN + REWRITE_TAC[IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; real_ge] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT; REAL_MUL_RID; REAL_LE_SUB_LADD; REAL_ADD_LID] THEN + REWRITE_TAC[IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN + ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN + ASM_MESON_TAC[NEGLIGIBLE_INTERVAL; INTERIOR_CLOSED_INTERVAL]; + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN + ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN + ASM_MESON_TAC[NEGLIGIBLE_INTERVAL; INTERIOR_CLOSED_INTERVAL]; + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN + ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ]; + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN + ASM_REWRITE_TAC[DIVISION_OF_TRANSLATION]; + MATCH_MP_TAC(REAL_ARITH + `a = a' /\ b = b' ==> a >= b + c ==> a' >= b' + c`) THEN + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN + REWRITE_TAC[MEASURE_TRANSLATION] THEN + REWRITE_TAC[GSYM VECTOR_ADD_ASSOC; SET_RULE + `{f x y | x IN IMAGE g s /\ y IN t} = + {f (g x) y | x IN s /\ y IN t}`] THEN + REWRITE_TAC[SET_RULE + `{a + x + y:real^N | x IN s /\ y IN t} = + IMAGE (\z. a + z) {x + y | x IN s /\ y IN t}`] THEN + REWRITE_TAC[MEASURE_TRANSLATION]])]] THEN + SUBGOAL_THEN + `!d1 d2 s t i j k. + CARD d1 + CARD d2 = n /\ + 1 <= k /\ k <= dimindex(:N) /\ ~(i = j) /\ + i IN d1 /\ i SUBSET {x:real^N | x$k <= &0} /\ ~(negligible i) /\ + j IN d1 /\ j SUBSET {x | x$k >= &0} /\ ~(negligible j) /\ + measure(t INTER {x | x$k <= &0}) / measure t = + measure(s INTER {x | x$k <= &0}) / measure s /\ + measure(t INTER {x | x$k >= &0}) / measure t = + measure(s INTER {x | x$k >= &0}) / measure s /\ + ~(s = {}) /\ ~(t = {}) /\ ~(negligible s) /\ ~(negligible t) /\ + d1 division_of s /\ d2 division_of t + ==> root(dimindex (:N)) (measure {x + y | x IN s /\ y IN t}) >= + root(dimindex (:N)) (measure s) + root(dimindex (:N)) (measure t)` + MP_TAC THENL + [ALL_TAC; + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < measure(s:real^N->bool) /\ &0 < measure(t:real^N->bool)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_ELEMENTARY]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a. measure(t INTER {x:real^N | x$k <= a}) / measure t = + measure(s INTER {x:real^N | x$k <= &0}) / measure s` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `&0 <= measure(s INTER {x:real^N | x$k <= &0}) / measure s /\ + measure(s INTER {x:real^N | x$k <= &0}) / measure s <= &1` + MP_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LZERO] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_POS_LE; + REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; + SET_TAC[]]] THEN + MATCH_MP_TAC MEASURABLE_COMPACT THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + SPEC_TAC(`measure(s INTER {x:real^N | x$k <= &0}) / measure s`, + `u:real`)] THEN + X_GEN_TAC `u:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `?b:real. &0 < b /\ !x:real^N. x IN t ==> abs(x$k) <= b` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `bounded(t:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[ELEMENTARY_BOUNDED]; REWRITE_TAC[BOUNDED_POS]] THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a. a IN real_interval[--b,b] /\ + measure (t INTER {x:real^N | x$k <= a}) / measure t = u` + (fun th -> MESON_TAC[th]) THEN + MATCH_MP_TAC REAL_IVT_INCREASING THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&0 <= u ==> x = &0 ==> x <= u`)) THEN + REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN + MATCH_MP_TAC MEASURE_EQ_0 THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | x$k = --b}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; GSYM REAL_LE_ANTISYM] THEN + ASM_MESON_TAC[REAL_ARITH `abs x <= b ==> --b <= x`]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `u <= &1 ==> x = &1 ==> u <= x`)) THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_MUL_LID] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_ARITH `abs x <= b ==> x <= b`]] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE THEN + ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`d1:(real^N->bool)->bool`; + `IMAGE (IMAGE (\x:real^N. x - a % basis k)) d2`; + `s:real^N->bool`; + `IMAGE (\x:real^N. x - a % basis k) t`; + `i:real^N->bool`; `j:real^N->bool`; `k:num`]) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x - a:real^N = --a + x`] THEN + ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ; DIVISION_OF_TRANSLATION] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [EXPAND_TAC "n" THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_FINITE]] THEN + MATCH_MP_TAC(MESON[] + `(!x y. Q x y ==> R x y) + ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN + REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x. --(a % basis k) + x) t INTER {x:real^N | x$k >= &0} = + IMAGE (\x. --(a % basis k) + x) (t INTER {x | x$k >= a}) /\ + IMAGE (\x. --(a % basis k) + x) t INTER {x:real^N | x$k <= &0} = + IMAGE (\x. --(a % basis k) + x) (t INTER {x | x$k <= a})` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN + MATCH_MP_TAC(SET_RULE + `!g. (!x. f(x) IN s' <=> x IN s) /\ (!x. g(f x) = x) + ==> IMAGE f t INTER s' = IMAGE f (t INTER s)`) THEN + ASM_SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT; VECTOR_NEG_COMPONENT] THEN + EXISTS_TAC `\x:real^N. a % basis k + x` THEN + (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]); + ALL_TAC] THEN + REWRITE_TAC[MEASURE_TRANSLATION] THEN MATCH_MP_TAC(REAL_FIELD + `&0 < s /\ &0 < t /\ t' / t = s' / s /\ s' + s'' = s /\ t' + t'' = t + ==> t' / t = s' / s /\ t'' / t = s'' / s`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN + (REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_COMPACT THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + MATCH_MP_TAC MEASURABLE_COMPACT THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + MATCH_MP_TAC(SET_RULE + `(!x. P x \/ Q x) + ==> s INTER {x | P x} UNION s INTER {x | Q x} = s`) THEN + REAL_ARITH_TAC; + REWRITE_TAC[SET_RULE `(t INTER {x | P x}) INTER (t INTER {x | Q x}) = + t INTER {x | P x /\ Q x}`] THEN + MATCH_MP_TAC(MESON[NEGLIGIBLE_SUBSET; INTER_SUBSET] + `negligible t ==> negligible(s INTER t)`) THEN + REWRITE_TAC[REAL_ARITH `x <= a /\ x >= a <=> x = a`] THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE]]); + REWRITE_TAC[MEASURE_TRANSLATION] THEN MATCH_MP_TAC(REAL_ARITH + `a' = a ==> a' >= b ==> a >= b`) THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `{f x y | x IN s /\ y IN IMAGE g t} = + {f x (g y) | x IN s /\ y IN t}`] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x + a + y:real^N = a + x + y`] THEN + REWRITE_TAC[SET_RULE + `{a + x + y:real^N | x IN s /\ y IN t} = + IMAGE (\z. a + z) {x + y | x IN s /\ y IN t}`] THEN + REWRITE_TAC[MEASURE_TRANSLATION]]] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[real_ge] THEN + SUBGOAL_THEN `measurable(s:real^N->bool) /\ measurable(t:real^N->bool)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[MEASURABLE_ELEMENTARY]; ALL_TAC] THEN + SUBGOAL_THEN `measurable {x + y:real^N | x IN s /\ y IN t}` ASSUME_TAC THENL + [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < measure(s:real^N->bool) /\ &0 < measure(t:real^N->bool)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[MEASURABLE_MEASURE_POS_LT]; ALL_TAC] THEN + SUBGOAL_THEN `FINITE(d1:(real^N->bool)->bool) /\ + FINITE(d2:(real^N->bool)->bool)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_LE_ROOT o snd) THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; ROOT_POS_LE; REAL_LE_ADD] THEN + DISCH_THEN SUBST1_TAC THEN + ABBREV_TAC `dl = {l INTER {x:real^N | x$k <= &0} |l| + l IN d1 DELETE j /\ ~(l INTER {x | x$k <= &0} = {})}` THEN + ABBREV_TAC `dr = {l INTER {x:real^N | x$k >= &0} |l| + l IN d1 DELETE i /\ ~(l INTER {x | x$k >= &0} = {})}` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `measure {x + y:real^N | x IN UNIONS dl /\ y IN (t INTER {x | x$k <= &0})} + + measure {x + y | x IN UNIONS dr /\ y IN (t INTER {x | x$k >= &0})}` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `measure {x + y:real^N | x IN (s INTER {x | x$k <= &0}) /\ + y IN (t INTER {x | x$k <= &0})} + + measure {x + y:real^N | x IN (s INTER {x | x$k >= &0}) /\ + y IN (t INTER {x | x$k >= &0})}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + (MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_UNIONS THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + ASM_SIMP_TAC[IN_DELETE; FINITE_DELETE; FINITE_IMAGE; + FINITE_RESTRICT; IMP_CONJ] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; COMPACT_INTERVAL]; + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]]; + MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + MATCH_MP_TAC(SET_RULE + `s SUBSET s' ==> {x + y:real^N | x IN s /\ y IN t} SUBSET + {x + y:real^N | x IN s' /\ y IN t}`) THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[IN_DELETE; IN_INTER; IN_ELIM_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN + ASM_MESON_TAC[IN_UNIONS]]); + ALL_TAC] THEN + SUBGOAL_THEN + `s = (s INTER {x:real^N | x$k <= &0}) UNION (s INTER {x | x$k >= &0}) /\ + t = (t INTER {x:real^N | x$k <= &0}) UNION (t INTER {x | x$k >= &0})` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. P x \/ Q x) + ==> s = (s INTER {x | P x}) UNION (s INTER {x | Q x})`) THEN + REAL_ARITH_TAC; + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th])] THEN + W(MP_TAC o PART_MATCH (rand o rand) + MEASURE_NEGLIGIBLE_UNION o lhand o snd) THEN + ANTS_TAC THENL + [REPEAT(CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + ALL_TAC]) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | x$k = &0}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MATCH_MP_TAC(SET_RULE + `s SUBSET {x | P x} /\ t SUBSET {x | Q x} + ==> (s INTER t) SUBSET {x | P x /\ Q x}`) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + SIMP_TAC[IN_INTER; IN_ELIM_THM; REAL_LE_ADD; VECTOR_ADD_COMPONENT; + real_ge; REAL_ARITH `x <= &0 /\ y <= &0 ==> x + y <= &0`]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNION THEN CONJ_TAC THEN + MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + CONJ_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + CONJ_TAC THEN MATCH_MP_TAC COMPACT_UNION THEN CONJ_TAC THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + SET_TAC[]]] THEN + SUBGOAL_THEN + `&0 < measure(s INTER {x:real^N | x$k <= &0}) /\ + &0 < measure(s INTER {x:real^N | x$k >= &0})` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTER_HALFSPACE_GE] THEN + CONJ_TAC THENL + [UNDISCH_TAC `~negligible(i:real^N->bool)`; + UNDISCH_TAC `~negligible(j:real^N->bool)`] THEN + REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + NEGLIGIBLE_SUBSET) THEN + ASM_REWRITE_TAC[SUBSET_INTER] THEN + UNDISCH_TAC `d1 division_of (s:real^N->bool)` THEN + REWRITE_TAC[division_of] THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`dl:(real^N->bool)->bool`; + `{l INTER {x:real^N | x$k <= &0} |l| + l IN d2 /\ ~(l INTER {x | x$k <= &0} = {})}`; + `UNIONS dl :real^N->bool`; + `t INTER {x:real^N | x$k <= &0}`] th) THEN + MP_TAC(SPECL [`dr:(real^N->bool)->bool`; + `{l INTER {x:real^N | x$k >= &0} |l| + l IN d2 /\ ~(l INTER {x | x$k >= &0} = {})}`; + `UNIONS dr :real^N->bool`; + `t INTER {x:real^N | x$k >= &0}`] th)) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [EXPAND_TAC "n" THEN MATCH_MP_TAC LTE_ADD2 THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD(d1 DELETE (i:real^N->bool))` THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE + `CARD {x | x IN IMAGE f s /\ P x} <= CARD(IMAGE f s) /\ + CARD(IMAGE f s) <= CARD s + ==> CARD {x | x IN IMAGE f s /\ P x} <= CARD s`) THEN + ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DELETE] THEN SET_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIONS] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `j INTER {x:real^N | x$k >= &0}` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; MEMBER_NOT_EMPTY] THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_DELETE; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL + [EXISTS_TAC `j:real^N->bool` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ s SUBSET t ==> ~(s INTER t = {})`) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of]]; + DISCH_TAC THEN + UNDISCH_TAC `measure (t INTER {x:real^N | x$k >= &0}) / measure t = + measure (s INTER {x:real^N | x$k >= &0}) / measure s` THEN + ASM_SIMP_TAC[MEASURE_EMPTY; REAL_EQ_RDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + REWRITE_TAC[division_of] THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN + CONJ_TAC THENL + [FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `x IN s ==> x SUBSET UNIONS s`) THEN + ASM SET_TAC[]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `interior(s) INTER interior(s') = {} /\ + interior(s INTER t) SUBSET interior s /\ + interior(s' INTER t) SUBSET interior s' + ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN + ASM_MESON_TAC[division_of]]; + REWRITE_TAC[division_of] THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN + REPEAT CONJ_TAC THENL + [FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> s INTER u SUBSET t INTER u`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `interior(s) INTER interior(s') = {} /\ + interior(s INTER t) SUBSET interior s /\ + interior(s' INTER t) SUBSET interior s' + ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN + ASM_MESON_TAC[division_of]; + REWRITE_TAC[SET_RULE `{x | x IN s /\ ~(x = a)} = s DELETE a`] THEN + GEN_REWRITE_TAC LAND_CONV [SET_RULE `s = {} UNION s`] THEN + REWRITE_TAC[GSYM UNIONS_INSERT] THEN + REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = x INSERT s`] THEN + REWRITE_TAC[UNIONS_INSERT; UNION_EMPTY] THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[division_of]]]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [EXPAND_TAC "n" THEN MATCH_MP_TAC LTE_ADD2 THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD(d1 DELETE (j:real^N->bool))` THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE + `CARD {x | x IN IMAGE f s /\ P x} <= CARD(IMAGE f s) /\ + CARD(IMAGE f s) <= CARD s + ==> CARD {x | x IN IMAGE f s /\ P x} <= CARD s`) THEN + ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DELETE] THEN SET_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIONS] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `i INTER {x:real^N | x$k <= &0}` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; MEMBER_NOT_EMPTY] THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_DELETE; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL + [EXISTS_TAC `i:real^N->bool` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ s SUBSET t ==> ~(s INTER t = {})`) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[division_of]]; + DISCH_TAC THEN + UNDISCH_TAC `measure (t INTER {x:real^N | x$k <= &0}) / measure t = + measure (s INTER {x:real^N | x$k <= &0}) / measure s` THEN + ASM_SIMP_TAC[MEASURE_EMPTY; REAL_EQ_RDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + REWRITE_TAC[division_of] THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN + CONJ_TAC THENL + [FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `x IN s ==> x SUBSET UNIONS s`) THEN + ASM SET_TAC[]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `interior(s) INTER interior(s') = {} /\ + interior(s INTER t) SUBSET interior s /\ + interior(s' INTER t) SUBSET interior s' + ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN + ASM_MESON_TAC[division_of]]; + REWRITE_TAC[division_of] THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_IN_IMAGE; IN_DELETE] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_DELETE] THEN + REPEAT CONJ_TAC THENL + [FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> s INTER u SUBSET t INTER u`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `interior(s) INTER interior(s') = {} /\ + interior(s INTER t) SUBSET interior s /\ + interior(s' INTER t) SUBSET interior s' + ==> interior(s INTER t) INTER interior(s' INTER t) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN + ASM_MESON_TAC[division_of]; + REWRITE_TAC[SET_RULE `{x | x IN s /\ ~(x = a)} = s DELETE a`] THEN + GEN_REWRITE_TAC LAND_CONV [SET_RULE `s = {} UNION s`] THEN + REWRITE_TAC[GSYM UNIONS_INSERT] THEN + REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = x INSERT s`] THEN + REWRITE_TAC[UNIONS_INSERT; UNION_EMPTY] THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_MESON_TAC[division_of]]]; + ALL_TAC] THEN + REWRITE_TAC[real_ge; IMP_IMP] THEN + SUBGOAL_THEN + `compact(UNIONS dl:real^N->bool) /\ compact(UNIONS dr:real^N->bool)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC COMPACT_UNIONS THEN + MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE; FINITE_DELETE] THEN + REWRITE_TAC[IMP_CONJ; IN_ELIM_THM; FORALL_IN_IMAGE; IN_DELETE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[division_of; COMPACT_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `measurable(UNIONS dl:real^N->bool) /\ + measurable(UNIONS dr:real^N->bool)` + STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[MEASURABLE_COMPACT]; ALL_TAC] THEN + SUBGOAL_THEN + `measurable { x + y:real^N | + x IN UNIONS dl /\ y IN t INTER {x | x$k <= &0}} /\ + measurable { x + y:real^N | + x IN UNIONS dr /\ y IN t INTER {x | &0 <= x$k}}` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN + MATCH_MP_TAC COMPACT_SUMS THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> x >= &0`; + CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE] THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + ALL_TAC] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [REAL_LE_ROOT; DIMINDEX_NONZERO; REAL_LE_ADD; ROOT_POS_LE; + MEASURE_POS_LE; MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTER_HALFSPACE_GE; REAL_ARITH `&0 <= x <=> x >= &0`] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= a' + b' ==> a' <= a /\ b' <= b ==> x <= a + b`) THEN + SUBGOAL_THEN + `measure(UNIONS dl :real^N->bool) = + measure(s INTER {x:real^N | x$k <= &0}) /\ + measure(UNIONS dr :real^N->bool) = + measure(s INTER {x:real^N | x$k >= &0})` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [MAP_EVERY EXPAND_TAC ["dl"; "dr"] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + {t | t IN IMAGE f s /\ ~(t = a)}`] THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ ~(x = a)} = s DELETE a`] THEN + CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SET_RULE `s = {} UNION s`] THEN + REWRITE_TAC[GSYM UNIONS_INSERT] THEN + REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = x INSERT s`] THEN + REWRITE_TAC[UNIONS_INSERT; UNION_EMPTY] THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE; GSYM INTER_UNIONS] THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | x$k = &0}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ t DIFF s SUBSET u + ==> (s DIFF t UNION t DIFF s) SUBSET u`) THEN + REWRITE_TAC[SET_RULE `s INTER u DIFF t INTER u = (s DIFF t) INTER u`] THEN + (SUBGOAL_THEN `s:real^N->bool = UNIONS d1` SUBST1_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM; real_ge; SET_RULE + `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] + THENL + [MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER u SUBSET u INTER t`); + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`)] THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `root (dimindex (:N)) (measure (s INTER {x:real^N | x$k <= &0})) + + root (dimindex (:N)) (measure (t INTER {x:real^N | x$k <= &0})) = + root (dimindex (:N)) (measure (s INTER {x | x$k <= &0})) * + (&1 + root (dimindex (:N)) (measure (t INTER {x | x$k <= &0})) / + root (dimindex (:N)) (measure (s INTER {x | x$k <= &0}))) /\ + root (dimindex (:N)) (measure (s INTER {x:real^N | x$k >= &0})) + + root (dimindex (:N)) (measure (t INTER {x:real^N | x$k >= &0})) = + root (dimindex (:N)) (measure (s INTER {x | x$k >= &0})) * + (&1 + root (dimindex (:N)) (measure (t INTER {x | x$k >= &0})) / + root (dimindex (:N)) (measure (s INTER {x | x$k >= &0})))` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN + MATCH_MP_TAC(REAL_FIELD `&0 < s ==> s + t = s * (&1 + t / s)`) THEN + ASM_SIMP_TAC[ROOT_POS_LT; DIMINDEX_NONZERO]; + ALL_TAC] THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; GSYM REAL_ROOT_DIV; MEASURE_POS_LE; + MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE] THEN + SUBGOAL_THEN + `measure(t INTER {x:real^N | x$k <= &0}) / + measure(s INTER {x:real^N | x$k <= &0}) = measure t / measure s /\ + measure(t INTER {x:real^N | x$k >= &0}) / + measure(s INTER {x:real^N | x$k >= &0}) = measure t / measure s` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [MATCH_MP_TAC(REAL_FIELD + `tn / t = sn / s /\ tp / t = sp / s /\ + &0 < sp /\ &0 < sn /\ &0 < s /\ &0 < t + ==> tn / sn = t / s /\ tp / sp = t / s`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_POW_MUL] THEN + ASM_SIMP_TAC[REAL_POW_ROOT; DIMINDEX_NONZERO; MEASURE_POS_LE; + MEASURABLE_INTER_HALFSPACE_LE; MEASURABLE_INTER_HALFSPACE_GE] THEN + SUBGOAL_THEN + `measure (s INTER {x | x$k <= &0}) + measure (s INTER {x | x$k >= &0}) = + root (dimindex(:N)) (measure(s:real^N->bool)) pow (dimindex(:N))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_POW_ROOT; DIMINDEX_NONZERO; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN + ASM_SIMP_TAC[MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTER_HALFSPACE_GE] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | x$k = &0}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM; real_ge] THEN SET_TAC[]]; + ASM_SIMP_TAC[GSYM REAL_ROOT_MUL; MEASURE_POS_LE; DIMINDEX_NONZERO; + REAL_LE_DIV; GSYM REAL_POW_MUL; + REAL_ADD_LDISTRIB; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Now for open sets. *) +(* ------------------------------------------------------------------------- *) + +let BRUNN_MINKOWSKI_OPEN = prove + (`!s t:real^N->bool. + (s = {} <=> t = {}) /\ bounded s /\ open s /\ bounded t /\ open t + ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) + >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[SET_RULE `{x + y:real^N | x IN {} /\ y IN {}} = {}`; + REAL_LE_REFL; MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO; + real_ge; REAL_ADD_LID] THEN + STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `atreal(&0) within {e | &0 <= e}` REALLIM_UBOUND) THEN + EXISTS_TAC `\e. root (dimindex(:N)) (measure(s:real^N->bool) - e) + + root (dimindex(:N)) (measure(t:real^N->bool) - e)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\e. (measure(s:real^N->bool) - e) rpow (inv(&(dimindex(:N)))) + + (measure(t:real^N->bool) - e) rpow (inv(&(dimindex(:N))))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO; + MEASURE_OPEN_POS_LT] THEN + REPEAT STRIP_TAC THEN BINOP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_ROOT_RPOW THEN + REWRITE_TAC[DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ROOT_RPOW; MEASURE_OPEN_POS_LT; DIMINDEX_NONZERO; + REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `measure(s:real^N->bool) = measure s - &0`] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[GSYM(REWRITE_CONV [o_DEF] + `(\x. x rpow y) o (\e. s - e)`)] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_WITHIN_ID; + REAL_CONTINUOUS_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]; + W(MP_TAC o PART_MATCH (lhand o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o + rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION; IN_SING] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO; + MEASURE_OPEN_POS_LT] THEN + X_GEN_TAC `e:real` THEN REWRITE_TAC[real_abs] THEN + ASM_CASES_TAC `&0 <= e` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MAP_EVERY (fun l -> MP_TAC(ISPECL l OPEN_MEASURABLE_INNER_DIVISION)) + [[`t:real^N->bool`; `e:real`]; [`s:real^N->bool`; `e:real`]] THEN + ASM_SIMP_TAC[MEASURABLE_OPEN; GSYM REAL_LT_SUB_RADD] THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `E:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`UNIONS D:real^N->bool`; `UNIONS E:real^N->bool`] + BRUNN_MINKOWSKI_ELEMENTARY) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[MEASURE_EMPTY; REAL_ARITH `e < s ==> ~(s - e < &0)`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `s1 <= r1 /\ s2 <= r2 /\ rs <= s + ==> rs >= r1 + r2 ==> s1 + s2 <= s`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; REAL_SUB_LE; REAL_LT_IMP_LE] THEN + SUBGOAL_THEN + `measurable {x + y :real^N | x IN UNIONS D /\ y IN UNIONS E}` + ASSUME_TAC THENL + [MATCH_MP_TAC MEASURABLE_COMPACT THEN MATCH_MP_TAC COMPACT_SUMS THEN + ASM_MESON_TAC[ELEMENTARY_COMPACT]; + MATCH_MP_TAC MEASURE_SUBSET] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC MEASURABLE_OPEN THEN + ASM_SIMP_TAC[BOUNDED_SUMS; OPEN_SUMS]]);; + +(* ------------------------------------------------------------------------- *) +(* Now for convex sets. *) +(* ------------------------------------------------------------------------- *) + +let BRUNN_MINKOWSKI_CONVEX = prove + (`!s t:real^N->bool. + (s = {} <=> t = {}) /\ bounded s /\ convex s /\ bounded t /\ convex t + ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) + >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[BRUNN_MINKOWSKI_OPEN; OPEN_EMPTY] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM MEASURE_INTERIOR; NEGLIGIBLE_CONVEX_FRONTIER; real_ge] THEN + ASM_CASES_TAC `interior s:real^N->bool = {}` THENL + [ASM_SIMP_TAC[MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO; REAL_ADD_LID] THEN + MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_INTERIOR] THEN + SUBGOAL_THEN `?a:real^N. a IN s` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) t)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURE_TRANSLATION; MEASURE_INTERIOR; + NEGLIGIBLE_CONVEX_FRONTIER; REAL_LE_REFL]; + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_CONVEX; + CONVEX_SUMS; BOUNDED_SUMS] THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `interior t:real^N->bool = {}` THENL + [ASM_SIMP_TAC[MEASURE_EMPTY; ROOT_0; DIMINDEX_NONZERO; REAL_ADD_RID] THEN + MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_INTERIOR] THEN + SUBGOAL_THEN `?a:real^N. a IN t` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) s)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURE_TRANSLATION; MEASURE_INTERIOR; + NEGLIGIBLE_CONVEX_FRONTIER; REAL_LE_REFL]; + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_CONVEX; + CONVEX_SUMS; BOUNDED_SUMS] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ADD_SYM] THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `root (dimindex (:N)) + (measure {x + y:real^N | x IN interior s /\ y IN interior t})` THEN + ASM_SIMP_TAC[GSYM real_ge; BRUNN_MINKOWSKI_OPEN; BOUNDED_INTERIOR; + OPEN_INTERIOR] THEN + REWRITE_TAC[real_ge] THEN MATCH_MP_TAC ROOT_MONO_LE THEN + REWRITE_TAC[DIMINDEX_NONZERO] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE; BOUNDED_SUMS; + MEASURABLE_CONVEX; BOUNDED_INTERIOR; CONVEX_SUMS; CONVEX_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE + `s' SUBSET s /\ t' SUBSET t + ==> {x + y:real^N | x IN s' /\ y IN t'} SUBSET + {x + y | x IN s /\ y IN t}`) THEN + REWRITE_TAC[INTERIOR_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Now for compact sets. *) +(* ------------------------------------------------------------------------- *) + +let INTERS_SUMS_CLOSED_BALL_SEQUENTIAL = prove + (`!s:real^N->bool. + closed s + ==> INTERS {{x + d | x IN s /\ d IN ball(vec 0,inv(&n + &1))} | + n IN (:num)} = s`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] SEPARATE_POINT_CLOSED) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:real^N`; `e:real^N`] THEN + REWRITE_TAC[IN_BALL_0] THEN STRIP_TAC THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(y + e:real^N,y) = norm e`] THEN + SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + DISCH_TAC THEN X_GEN_TAC `n:num` THEN + MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID; REAL_LT_INV_EQ] THEN + REAL_ARITH_TAC]);; + +let MEASURE_SUMS_COMPACT_EPSILON = prove + (`!s:real^N->bool. + compact s + ==> ((\e. measure {x + d | x IN s /\ d IN ball(vec 0,e)}) + ---> measure s) + (atreal (&0) within {e | &0 <= e})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\n. {x + d:real^N | x IN s /\ d IN ball(vec 0,inv(&n + &1))}` + HAS_MEASURE_NESTED_INTERS) THEN + ASM_SIMP_TAC[INTERS_SUMS_CLOSED_BALL_SEQUENTIAL; COMPACT_IMP_CLOSED] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; + COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THEN + GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `t' SUBSET t + ==> {x + y:real^N | x IN s /\ y IN t'} SUBSET + {x + y | x IN s /\ y IN t}`) THEN + MATCH_MP_TAC SUBSET_BALL THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM(REWRITE_RULE[o_DEF] TENDSTO_REAL)] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; REALLIM_WITHINREAL] THEN + STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `inv(&N + &1)` THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `d:real` THEN REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO] THEN + ASM_CASES_TAC `abs d = d` THENL + [FIRST_X_ASSUM SUBST1_TAC THEN STRIP_TAC; ASM_REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN + MATCH_MP_TAC(REAL_ARITH + `m <= m1 /\ m1 <= m2 + ==> abs(m2 - m) < e ==> abs(m1 - m) < e`) THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; + COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] + THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; + MATCH_MP_TAC(SET_RULE + `t' SUBSET t + ==> {x + y:real^N | x IN s /\ y IN t'} SUBSET + {x + y | x IN s /\ y IN t}`) THEN + MATCH_MP_TAC SUBSET_BALL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]);; + +let BRUNN_MINKOWSKI_COMPACT = prove + (`!s t:real^N->bool. + (s = {} <=> t = {}) /\ compact s /\ compact t + ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) + >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, + let lemma1 = prove + (`{ x + y:real^N | x IN {x + d | x IN s /\ d IN ball(vec 0,e)} /\ + y IN {y + d | y IN t /\ d IN ball(vec 0,e)}} = + { z + d | z IN {x + y | x IN s /\ y IN t} /\ d IN ball(vec 0,&2 * e) }`, + MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + REWRITE_TAC[IN_ELIM_THM; IN_BALL_0] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `k:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `x + y:real^N` THEN EXISTS_TAC `d + k:real^N` THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + ASM_SIMP_TAC[NORM_ARITH + `norm(d:real^N) < e /\ norm(k) < e ==> norm(d + k) < &2 * e`] THEN + EXISTS_TAC `x:real^N` THEN EXISTS_TAC `y:real^N` THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `x + inv(&2) % d:real^N` THEN + EXISTS_TAC `y + inv(&2) % d:real^N` THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN CONJ_TAC THENL + [EXISTS_TAC `x:real^N`; EXISTS_TAC `y:real^N`] THEN + EXISTS_TAC `inv(&2) % d:real^N` THEN + ASM_REWRITE_TAC[NORM_MUL] THEN ASM_REAL_ARITH_TAC]) + and lemma2 = prove + (`(f ---> l) (atreal (&0) within {e | &0 <= e}) + ==> ((\e. f(&2 * e)) ---> l) (atreal (&0) within {e | &0 <= e})`, + REWRITE_TAC[REALLIM_WITHINREAL] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[BRUNN_MINKOWSKI_OPEN; OPEN_EMPTY; BOUNDED_EMPTY] THEN + STRIP_TAC THEN REWRITE_TAC[real_ge] THEN + MATCH_MP_TAC(ISPEC `atreal (&0) within {e | &0 <= e}` REALLIM_LE) THEN + EXISTS_TAC + `\e. root (dimindex(:N)) + (measure {x + d:real^N | x IN s /\ d IN ball(vec 0,e)}) + + root (dimindex(:N)) + (measure {x + d:real^N | x IN t /\ d IN ball(vec 0,e)})` THEN + EXISTS_TAC + `\e. root (dimindex(:N)) + (measure { x + y:real^N | + x IN {x + d | x IN s /\ d IN ball(vec 0,e)} /\ + y IN {y + d | y IN t /\ d IN ball(vec 0,e)}})` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [REAL_ROOT_RPOW; DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_COMPACT; + MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; + COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REALLIM_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + MATCH_MP_TAC MEASURE_SUMS_COMPACT_EPSILON THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[lemma1] THEN MATCH_MP_TAC lemma2 THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 6) + [REAL_ROOT_RPOW; DIMINDEX_NONZERO; MEASURE_POS_LE; MEASURABLE_COMPACT; + MEASURABLE_OPEN; BOUNDED_SUMS; OPEN_SUMS; COMPACT_SUMS; + COMPACT_IMP_BOUNDED; BOUNDED_BALL; OPEN_BALL] THEN + MATCH_MP_TAC REALLIM_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + MATCH_MP_TAC MEASURE_SUMS_COMPACT_EPSILON THEN + ASM_SIMP_TAC[COMPACT_SUMS]; + W(MP_TAC o PART_MATCH (lhand o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o + rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION; IN_SING] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `e:real` THEN + REWRITE_TAC[GSYM real_ge] THEN + MATCH_MP_TAC BRUNN_MINKOWSKI_OPEN THEN + SIMP_TAC[OPEN_SUMS; OPEN_BALL] THEN + ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL; COMPACT_IMP_BOUNDED] THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Finally, for an arbitrary measurable set. In this general case, the *) +(* measurability of the sum-set is needed as an additional hypothesis. *) +(* ------------------------------------------------------------------------- *) + +let BRUNN_MINKOWSKI_MEASURABLE = prove + (`!s t:real^N->bool. + (s = {} <=> t = {}) /\ measurable s /\ measurable t /\ + measurable {x + y | x IN s /\ y IN t} + ==> root (dimindex(:N)) (measure {x + y | x IN s /\ y IN t}) + >= root (dimindex(:N)) (measure s) + root (dimindex(:N)) (measure t)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[BRUNN_MINKOWSKI_OPEN; OPEN_EMPTY; BOUNDED_EMPTY] THEN + STRIP_TAC THEN REWRITE_TAC[real_ge] THEN + ASM_CASES_TAC `measure(s:real^N->bool) = &0` THENL + [ASM_SIMP_TAC[ROOT_0; DIMINDEX_NONZERO; REAL_ADD_LID] THEN + MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE] THEN + SUBGOAL_THEN `?a:real^N. a IN s` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) t)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]; + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ] THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `measure(t:real^N->bool) = &0` THENL + [ASM_SIMP_TAC[ROOT_0; DIMINDEX_NONZERO; REAL_ADD_RID] THEN + MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; MEASURE_POS_LE] THEN + SUBGOAL_THEN `?a:real^N. a IN t` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(IMAGE (\x:real^N. a + x) s)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURE_TRANSLATION; REAL_LE_REFL]; + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [VECTOR_ADD_SYM] THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 < measure(s:real^N->bool) /\ + &0 < measure(t:real^N->bool)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[MEASURABLE_MEASURE_POS_LT; MEASURABLE_MEASURE_EQ_0]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPEC `atreal(&0) within {e | &0 <= e}` REALLIM_UBOUND) THEN + EXISTS_TAC `\e. root (dimindex(:N)) (measure(s:real^N->bool) - e) + + root (dimindex(:N)) (measure(t:real^N->bool) - e)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\e. (measure(s:real^N->bool) - e) rpow (inv(&(dimindex(:N)))) + + (measure(t:real^N->bool) - e) rpow (inv(&(dimindex(:N))))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO; + MEASURE_OPEN_POS_LT] THEN + REPEAT STRIP_TAC THEN BINOP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_ROOT_RPOW THEN + REWRITE_TAC[DIMINDEX_NONZERO] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ROOT_RPOW; MEASURE_OPEN_POS_LT; DIMINDEX_NONZERO; + REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `measure(s:real^N->bool) = measure s - &0`] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[GSYM(REWRITE_CONV [o_DEF] + `(\x. x rpow y) o (\e. s - e)`)] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_WITHIN_ID; + REAL_CONTINUOUS_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]; + W(MP_TAC o PART_MATCH (lhand o rand) TRIVIAL_LIMIT_WITHIN_REALINTERVAL o + rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION; IN_SING] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[IN_ELIM_THM] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + EXISTS_TAC `min (measure(s:real^N->bool)) (measure(t:real^N->bool))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; IN_ELIM_THM; REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN REWRITE_TAC[real_abs] THEN + ASM_CASES_TAC `&0 <= e` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MAP_EVERY (fun l -> MP_TAC(ISPECL l MEASURABLE_INNER_COMPACT)) + [[`t:real^N->bool`; `e:real`]; [`s:real^N->bool`; `e:real`]] THEN + ASM_SIMP_TAC[MEASURABLE_OPEN; GSYM REAL_LT_SUB_RADD] THEN + DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s':real^N->bool`; `t':real^N->bool`] + BRUNN_MINKOWSKI_COMPACT) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[MEASURE_EMPTY; REAL_ARITH `e < s ==> ~(s - e < &0)`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `s1 <= r1 /\ s2 <= r2 /\ rs <= s + ==> rs >= r1 + r2 ==> s1 + s2 <= s`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC ROOT_MONO_LE THEN + ASM_SIMP_TAC[DIMINDEX_NONZERO; REAL_SUB_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[MEASURE_POS_LE; COMPACT_SUMS; MEASURABLE_COMPACT] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURE_POS_LE; COMPACT_SUMS; MEASURABLE_COMPACT] THEN + ASM SET_TAC[]]);; diff --git a/Examples/combin.ml b/Examples/combin.ml new file mode 100644 index 0000000..2406b5d --- /dev/null +++ b/Examples/combin.ml @@ -0,0 +1,163 @@ +(* ========================================================================= *) +(* Church-Rosser property for combinatory logic (S and K combinators). *) +(* *) +(* This is adapted from a HOL4 develoment, itself derived from an old HOL88 *) +(* example by Tom Melham and Juanito Camilleri. For a detailed discussion, *) +(* see pp. 29-39 of the following paper: *) +(* *) +(* http://www.comlab.ox.ac.uk/tom.melham/pub/Camilleri-1992-RID.pdf *) +(* ========================================================================= *) + +needs "Examples/reduct.ml";; + +(* ------------------------------------------------------------------------- *) +(* Definition of confluence. *) +(* ------------------------------------------------------------------------- *) + +let confluent = define + `confluent R <=> + !x y z. RTC R x y /\ RTC R x z ==> ?u. RTC R y u /\ RTC R z u`;; + +let confluent_diamond_RTC = prove + (`!R. confluent R <=> CR(RTC R)`, + REWRITE_TAC[confluent; CR]);; + +(* ------------------------------------------------------------------------- *) +(* Basic term structure: S and K combinators and function application ("%"). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("%",(20,"left"));; + +let cl_INDUCT,cl_RECURSION = define_type "cl = S | K | % cl cl";; + +(* ------------------------------------------------------------------------- *) +(* Reduction relation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-->",(12,"right"));; + +let redn_rules, redn_ind, redn_cases = new_inductive_definition + `(!x y f. x --> y ==> f % x --> f % y) /\ + (!f g x. f --> g ==> f % x --> g % x) /\ + (!x y. K % x % y --> x) /\ + (!f g x. S % f % g % x --> (f % x) % (g % x))`;; + +(* ------------------------------------------------------------------------- *) +(* A different, "parallel", reduction relation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-||->",(12,"right"));; + +let predn_rules, predn_ind, predn_cases = new_inductive_definition + `(!x. x -||-> x) /\ + (!x y u v. x -||-> y /\ u -||-> v ==> x % u -||-> y % v) /\ + (!x y. K % x % y -||-> x) /\ + (!f g x. S % f % g % x -||-> (f % x) % (g % x))`;; + +(* ------------------------------------------------------------------------- *) +(* Abbreviations for their reflexive-transitive closures. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-->*",(12,"right"));; +parse_as_infix("-||->*",(12,"right"));; + +let RTCredn = define `(-->*) = RTC(-->)`;; +let RTCpredn = define `(-||->*) = RTC(-||->)`;; + +let RTCredn_rules = REWRITE_RULE[SYM RTCredn] (ISPEC `(-->)` RTC_RULES);; +let RTCredn_ind = REWRITE_RULE[SYM RTCredn] (ISPEC `(-->)` RTC_INDUCT);; +let RTCpredn_rules = REWRITE_RULE[SYM RTCpredn] (ISPEC `(-||->)` RTC_RULES);; +let RTCpredn_ind = REWRITE_RULE[SYM RTCpredn] (ISPEC `(-||->)` RTC_INDUCT);; + +(* ------------------------------------------------------------------------- *) +(* Prove that the two RTCs are actually the same. *) +(* ------------------------------------------------------------------------- *) + +let RTCredn_RTCpredn = prove + (`!x y. x -->* y ==> x -||->* y`, + REWRITE_TAC[RTCredn; RTCpredn] THEN MATCH_MP_TAC RTC_MONO THEN + MATCH_MP_TAC redn_ind THEN MESON_TAC[predn_rules]);; + +let RTCredn_ap_monotonic = prove + (`!x y. x -->* y ==> !z. x % z -->* y % z /\ z % x -->* z % y`, + MATCH_MP_TAC RTCredn_ind THEN MESON_TAC[RTCredn_rules; redn_rules]);; + +let predn_RTCredn = prove + (`!x y. x -||-> y ==> x -->* y`, + MATCH_MP_TAC predn_ind THEN + MESON_TAC[RTCredn_rules; redn_rules; RTCredn_ap_monotonic]);; + +let RTCpredn_RTCredn = prove + (`!x y. x -||->* y ==> x -->* y`, + MATCH_MP_TAC RTCpredn_ind THEN MESON_TAC[predn_RTCredn; RTCredn_rules]);; + +let RTCpredn_EQ_RTCredn = prove + (`(-||->*) = (-->*)`, + REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[RTCpredn_RTCredn; RTCredn_RTCpredn]);; + +(* ------------------------------------------------------------------------- *) +(* Now prove diamond property for "-||->" reduction. *) +(* ------------------------------------------------------------------------- *) + +let characterise t = + SIMP_RULE[distinctness "cl"; injectivity "cl"; GSYM EXISTS_REFL; + RIGHT_EXISTS_AND_THM; GSYM CONJ_ASSOC; UNWIND_THM1] + (SPEC t predn_cases);; + +let Sx_PREDN = prove + (`!x y. S % x -||-> y <=> ?z. y = S % z /\ x -||-> z`, + REWRITE_TAC[characterise `S % x`] THEN + MESON_TAC[predn_rules; characterise `S`]);; + +let Kx_PREDN = prove + (`!x y. K % x -||-> y <=> ?z. y = K % z /\ x -||-> z`, + REWRITE_TAC[characterise `K % x`] THEN + MESON_TAC[predn_rules; characterise `K`]);; + +let Kxy_PREDN = prove + (`!x y z. K % x % y -||-> z <=> + (?u v. z = K % u % v /\ x -||-> u /\ y -||-> v) \/ z = x`, + REWRITE_TAC[characterise `K % x % y`] THEN + MESON_TAC[predn_rules; Kx_PREDN]);; + +let Sxy_PREDN = prove + (`!x y z. S % x % y -||-> z <=> + ?u v. z = S % u % v /\ x -||-> u /\ y -||-> v`, + REWRITE_TAC[characterise `S % x % y`] THEN + MESON_TAC[predn_rules; characterise `S`; Sx_PREDN]);; + +let Sxyz_PREDN = prove + (`!w x y z. S % w % x % y -||-> z <=> + (?p q r. z = S % p % q % r /\ + w -||-> p /\ x -||-> q /\ y -||-> r) \/ + z = (w % y) % (x % y)`, + REWRITE_TAC[characterise `S % w % x % y`] THEN + MESON_TAC[predn_rules; Sxy_PREDN]);; + +let predn_diamond_lemma = prove + (`!x y. x -||-> y ==> !z. x -||-> z ==> ?u. y -||-> u /\ z -||-> u`, + ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a /\ b`] THEN + MATCH_MP_TAC predn_ind THEN SIMP_TAC[predn_rules] THEN REPEAT CONJ_TAC THENL + [MESON_TAC[predn_rules]; + REPEAT STRIP_TAC THEN UNDISCH_THEN `x % u -||-> z` + (STRIP_ASSUME_TAC o SIMP_RULE[characterise `x % y`]) THENL + [ASM_MESON_TAC[predn_rules]; + ASM_MESON_TAC[predn_rules]; + SUBGOAL_THEN `?w. y = K % w /\ z -||-> w` MP_TAC; + SUBGOAL_THEN `?p q. y = S % p % q /\ f -||-> p /\ g -||-> q` MP_TAC] THEN + ASM_MESON_TAC[Kx_PREDN; Sxy_PREDN; predn_rules]; + REWRITE_TAC[Kxy_PREDN] THEN MESON_TAC[predn_rules]; + REWRITE_TAC[Sxyz_PREDN] THEN MESON_TAC[predn_rules]]);; + +let predn_diamond = prove + (`CR (-||->)`, + MESON_TAC[CR; predn_diamond_lemma]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we have confluence of the main reduction. *) +(* ------------------------------------------------------------------------- *) + +let confluent_redn = prove + (`confluent(-->)`, + MESON_TAC[confluent_diamond_RTC; RTCpredn_EQ_RTCredn; RTCredn; RTCpredn; + RTC_CR; predn_diamond]);; diff --git a/Examples/cong.ml b/Examples/cong.ml new file mode 100644 index 0000000..84518f0 --- /dev/null +++ b/Examples/cong.ml @@ -0,0 +1,164 @@ +(* ========================================================================= *) +(* Integer congruences. *) +(* ========================================================================= *) + +prioritize_int();; + +(* ------------------------------------------------------------------------- *) +(* Combined rewrite, for later proofs. *) +(* ------------------------------------------------------------------------- *) + +let CONG = prove + (`(x == y) (mod n) <=> ?q. x - y = q * n`, + REWRITE_TAC[int_congruent; int_divides] THEN MESON_TAC[INT_MUL_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Trivial consequences. *) +(* ------------------------------------------------------------------------- *) + +let CONG_MOD_0 = prove + (`(x == y) (mod (&0)) <=> (x = y)`, + INTEGER_TAC);; + +let CONG_MOD_1 = prove + (`(x == y) (mod (&1))`, + INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Congruence is an equivalence relation. *) +(* ------------------------------------------------------------------------- *) + +let CONG_REFL = prove + (`!n x. (x == x) (mod n)`, + INTEGER_TAC);; + +let CONG_SYM = prove + (`!n x y. (x == y) (mod n) ==> (y == x) (mod n)`, + INTEGER_TAC);; + +let CONG_TRANS = prove + (`!n x y z. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, + INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Congruences are indeed congruences. *) +(* ------------------------------------------------------------------------- *) + +let CONG_ADD = prove + (`!n x1 x2 y1 y2. + (x1 == x2) (mod n) /\ (y1 == y2) (mod n) ==> (x1 + y1 == x2 + y2) (mod n)`, + INTEGER_TAC);; + +let CONG_NEG = prove + (`!n x1 x2. (x1 == x2) (mod n) ==> (--x1 == --x2) (mod n)`, + INTEGER_TAC);; + +let CONG_SUB = prove + (`!n x1 x2 y1 y2. + (x1 == x2) (mod n) /\ (y1 == y2) (mod n) ==> (x1 - y1 == x2 - y2) (mod n)`, + INTEGER_TAC);; + +let CONG_MUL = prove + (`!n x1 x2 y1 y2. + (x1 == x2) (mod n) /\ (y1 == y2) (mod n) ==> (x1 * y1 == x2 * y2) (mod n)`, + INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Various other trivial properties of congruences. *) +(* ------------------------------------------------------------------------- *) + +let CONG_MOD_NEG = prove + (`!x y n. (x == y) (mod (--n)) <=> (x == y) (mod n)`, + INTEGER_TAC);; + +let CONG_MOD_ABS = prove + (`!x y n. (x == y) (mod (abs n)) <=> (x == y) (mod n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[INT_ABS] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CONG_MOD_NEG]);; + +let CONG_MULTIPLE = prove + (`!m n. (m * n == &0) (mod n)`, + INTEGER_TAC);; + +let CONG_SELF = prove + (`!n. (n == &0) (mod n)`, + INTEGER_TAC);; + +let CONG_SELF_ABS = prove + (`!n. (abs(n) == &0) (mod n)`, + ONCE_REWRITE_TAC[GSYM CONG_MOD_ABS] THEN REWRITE_TAC[CONG_SELF]);; + +let CONG_MOD_1 = prove + (`(x == y) (mod &1)`, + INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Can choose a representative, either positive or with minimal magnitude. *) +(* ------------------------------------------------------------------------- *) + +let CONG_REP_POS_POS = prove + (`!n x. &0 <= x /\ ~(n = &0) + ==> ?y. &0 <= y /\ y < abs(n) /\ (x == y) (mod n)`, + REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[GSYM INT_FORALL_POS] THEN + MAP_EVERY X_GEN_TAC [`n:int`; `k:num`] THEN + ONCE_REWRITE_TAC[GSYM CONG_MOD_ABS] THEN + MP_TAC(SPEC `n:int` INT_ABS_POS) THEN + ONCE_REWRITE_TAC[INT_ARITH `(n = &0) <=> (abs n = &0)`] THEN + SPEC_TAC(`abs n`,`n:int`) THEN REWRITE_TAC[GSYM INT_FORALL_POS] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN + EXISTS_TAC `&(k MOD n)` THEN + REWRITE_TAC[CONG; INT_OF_NUM_LE; INT_OF_NUM_LT] THEN + ASM_SIMP_TAC[DIVISION; LE_0] THEN EXISTS_TAC `&(k DIV n)` THEN + REWRITE_TAC[INT_ARITH `(x - y = z) <=> (x = z + y)`] THEN + REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN + ASM_SIMP_TAC[DIVISION]);; + +let CONG_REP_POS = prove + (`!n x. ~(n = &0) ==> ?y. &0 <= y /\ y < abs(n) /\ (x == y) (mod n)`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(INT_ARITH `&0 <= x \/ &0 <= --x`) THEN + ASM_SIMP_TAC[CONG_REP_POS_POS] THEN + MP_TAC(SPECL [`n:int`; `--x`] CONG_REP_POS_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:int` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `y = &0` THENL + [EXISTS_TAC `y:int` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONG_NEG) THEN + ASM_REWRITE_TAC[INT_NEG_0; INT_NEG_NEG]; + ALL_TAC] THEN + EXISTS_TAC `abs(n) - y` THEN + ASM_SIMP_TAC[INT_ARITH `y < abs(n) ==> &0 <= abs(n) - y`; + INT_ARITH `&0 <= y /\ ~(y = &0) ==> abs(n) - y < abs(n)`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONG_NEG) THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_SYM) THEN + DISCH_THEN(MP_TAC o CONJ (SPEC `abs n` CONG_SELF)) THEN + REWRITE_TAC[CONG_MOD_ABS] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_ADD) THEN + REWRITE_TAC[INT_NEG_NEG; INT_ADD_LID] THEN + MESON_TAC[INT_ARITH `x + --y = x - y`; CONG_SYM]);; + +let CONG_REP_MIN = prove + (`!n x. ~(n = &0) + ==> ?y. --(abs n) <= &2 * y /\ &2 * y < abs n /\ (x == y) (mod n)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONG_REP_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `y:int` STRIP_ASSUME_TAC o SPEC `x:int`) THEN + MP_TAC(INT_ARITH + `&0 <= y /\ y < abs n + ==> --(abs n) <= &2 * y /\ &2 * y < abs(n) \/ + --(abs n) <= &2 * (y - abs(n)) /\ &2 * (y - abs(n)) < abs(n)`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [ASM_MESON_TAC[CONG_REP_POS; INT_LT_IMP_LE]; ALL_TAC] THEN + EXISTS_TAC `y - abs(n)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `n:int` CONG_SELF_ABS) THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_SYM) THEN + UNDISCH_TAC `(x == y) (mod n)` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_SUB) THEN + REWRITE_TAC[INT_ARITH `x - &0 = x`]);; + +let CONG_REP_MIN_ABS = prove + (`!n x. ~(n = &0) ==> ?y. &2 * abs(y) <= abs(n) /\ (x == y) (mod n)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONG_REP_MIN) THEN + DISCH_THEN(MP_TAC o SPEC `x:int`) THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[] THEN INT_ARITH_TAC);; diff --git a/Examples/cooper.ml b/Examples/cooper.ml new file mode 100644 index 0000000..0c79417 --- /dev/null +++ b/Examples/cooper.ml @@ -0,0 +1,1576 @@ +(* ========================================================================= *) +(* Implementation of Cooper's algorithm via proforma theorems. *) +(* ========================================================================= *) + +prioritize_int();; + +(* ------------------------------------------------------------------------- *) +(* Basic syntax on integer terms. *) +(* ------------------------------------------------------------------------- *) + +let dest_mul = dest_binop `(*)`;; +let dest_add = dest_binop `(+)`;; + +(* ------------------------------------------------------------------------- *) +(* Divisibility. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("divides",(12,"right"));; + +let divides = new_definition + `a divides b <=> ?x. b = a * x`;; + +(* ------------------------------------------------------------------------- *) +(* Trivial lemmas about integers. *) +(* ------------------------------------------------------------------------- *) + +let INT_DOWN2 = prove + (`!a b. ?c. !x. x < c ==> x < a /\ x < b`, + MESON_TAC[INT_LE_TOTAL; INT_LET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Trivial lemmas about divisibility. *) +(* ------------------------------------------------------------------------- *) + +let DIVIDES_ADD = prove + (`!d a b. d divides a /\ d divides b ==> d divides (a + b)`, + MESON_TAC[divides; INT_ADD_LDISTRIB]);; + +let DIVIDES_SUB = prove + (`!d a b. d divides a /\ d divides b ==> d divides (a - b)`, + MESON_TAC[divides; INT_SUB_LDISTRIB]);; + +let DIVIDES_ADD_REVR = prove + (`!d a b. d divides a /\ d divides (a + b) ==> d divides b`, + MESON_TAC[DIVIDES_SUB; INT_ARITH `(a + b) - a = b`]);; + +let DIVIDES_ADD_REVL = prove + (`!d a b. d divides b /\ d divides (a + b) ==> d divides a`, + MESON_TAC[DIVIDES_SUB; INT_ARITH `(a + b) - b = a`]);; + +let DIVIDES_LMUL = prove + (`!d a x. d divides a ==> d divides (x * a)`, + ASM_MESON_TAC[divides; INT_ARITH `a * b * c = b * a * c`]);; + +let DIVIDES_RNEG = prove + (`!d a. d divides (--a) <=> d divides a`, + REWRITE_TAC[divides] THEN MESON_TAC[INT_MUL_RNEG; INT_NEG_NEG]);; + +let DIVIDES_LNEG = prove + (`!d a. (--d) divides a <=> d divides a`, + REWRITE_TAC[divides] THEN + MESON_TAC[INT_MUL_RNEG; INT_MUL_LNEG; INT_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* More specialized lemmas (see footnotes on p4 and p5). *) +(* ------------------------------------------------------------------------- *) + +let INT_DOWN_MUL_LT = prove + (`!x y d. &0 < d ==> ?c. x + c * d < y`, + MESON_TAC[INT_ARCH; INT_LT_REFL; + INT_ARITH `x - y < c * d <=> x + --c * d < y`]);; + +let INT_MOD_LEMMA = prove + (`!d x. &0 < d ==> ?c. &1 <= x + c * d /\ x + c * d <= d`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:int`; `&0`] o MATCH_MP INT_DOWN_MUL_LT) THEN + DISCH_THEN(X_CHOOSE_TAC `c0:int`) THEN + SUBGOAL_THEN `?c1. &0 <= c1 /\ --(x + c0 * d) < c1 * d` MP_TAC THENL + [SUBGOAL_THEN `?c1. --(x + c0 * d) < c1 * d` MP_TAC THENL + [ASM_MESON_TAC[INT_ARCH; INT_ARITH `&0 < d ==> ~(d = &0)`]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN + MATCH_MP_TAC(INT_ARITH + `(&0 < --c1 ==> &0 < --cd) /\ xcod < &0 + ==> --xcod < cd ==> &0 <= c1`) THEN + ASM_SIMP_TAC[GSYM INT_MUL_LNEG; INT_LT_MUL]; ALL_TAC] THEN + REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`; GSYM NOT_FORALL_THM] THEN + REWRITE_TAC[GSYM INT_FORALL_POS] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[INT_ARITH `--(x + a * d) < b * d <=> &1 <= x + (a + b) * d`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c0 + &n` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + UNDISCH_TAC `&1 <= x + (c0 + &n) * d` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `SUC n - 1 = n`] THENL + [REWRITE_TAC[SUB_0; LT_REFL; INT_ADD_RID] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN INT_ARITH_TAC; + REWRITE_TAC[GSYM INT_OF_NUM_SUC; LT] THEN INT_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Shadow for restricted class of formulas. *) +(* ------------------------------------------------------------------------- *) + +let cform_INDUCT,cform_RECURSION = define_type + "cform = Lt int + | Gt int + | Eq int + | Ne int + | Divides int int + | Ndivides int int + | And cform cform + | Or cform cform + | Nox bool";; + +(* ------------------------------------------------------------------------- *) +(* Interpretation of a cform. *) +(* ------------------------------------------------------------------------- *) + +let interp = new_recursive_definition cform_RECURSION + `(interp x (Lt e) <=> x + e < &0) /\ + (interp x (Gt e) <=> x + e > &0) /\ + (interp x (Eq e) <=> (x + e = &0)) /\ + (interp x (Ne e) <=> ~(x + e = &0)) /\ + (interp x (Divides c e) <=> c divides (x + e)) /\ + (interp x (Ndivides c e) <=> ~(c divides (x + e))) /\ + (interp x (And p q) <=> interp x p /\ interp x q) /\ + (interp x (Or p q) <=> interp x p \/ interp x q) /\ + (interp x (Nox P) <=> P)`;; + +(* ------------------------------------------------------------------------- *) +(* The "minus infinity" and "plus infinity" variants. *) +(* ------------------------------------------------------------------------- *) + +let minusinf = new_recursive_definition cform_RECURSION + `(minusinf (Lt e) = Nox T) /\ + (minusinf (Gt e) = Nox F) /\ + (minusinf (Eq e) = Nox F) /\ + (minusinf (Ne e) = Nox T) /\ + (minusinf (Divides c e) = Divides c e) /\ + (minusinf (Ndivides c e) = Ndivides c e) /\ + (minusinf (And p q) = And (minusinf p) (minusinf q)) /\ + (minusinf (Or p q) = Or (minusinf p) (minusinf q)) /\ + (minusinf (Nox P) = Nox P)`;; + +let plusinf = new_recursive_definition cform_RECURSION + `(plusinf (Lt e) = Nox F) /\ + (plusinf (Gt e) = Nox T) /\ + (plusinf (Eq e) = Nox F) /\ + (plusinf (Ne e) = Nox T) /\ + (plusinf (Divides c e) = Divides c e) /\ + (plusinf (Ndivides c e) = Ndivides c e) /\ + (plusinf (And p q) = And (plusinf p) (plusinf q)) /\ + (plusinf (Or p q) = Or (plusinf p) (plusinf q)) /\ + (plusinf (Nox P) = Nox P)`;; + +(* ------------------------------------------------------------------------- *) +(* All the "dividing" things divide the given constant (e.g. their LCM). *) +(* ------------------------------------------------------------------------- *) + +let alldivide = new_recursive_definition cform_RECURSION + `(alldivide d (Lt e) <=> T) /\ + (alldivide d (Gt e) <=> T) /\ + (alldivide d (Eq e) <=> T) /\ + (alldivide d (Ne e) <=> T) /\ + (alldivide d (Divides c e) <=> c divides d) /\ + (alldivide d (Ndivides c e) <=> c divides d) /\ + (alldivide d (And p q) <=> alldivide d p /\ alldivide d q) /\ + (alldivide d (Or p q) <=> alldivide d p /\ alldivide d q) /\ + (alldivide d (Nox P) <=> T)`;; + +(* ------------------------------------------------------------------------- *) +(* A-sets and B-sets. *) +(* ------------------------------------------------------------------------- *) + +let aset = new_recursive_definition cform_RECURSION + `(aset (Lt e) = {(--e)}) /\ + (aset (Gt e) = {}) /\ + (aset (Eq e) = {(--e + &1)}) /\ + (aset (Ne e) = {(--e)}) /\ + (aset (Divides c e) = {}) /\ + (aset (Ndivides c e) = {}) /\ + (aset (And p q) = (aset p) UNION (aset q)) /\ + (aset (Or p q) = (aset p) UNION (aset q)) /\ + (aset (Nox P) = {})`;; + +let bset = new_recursive_definition cform_RECURSION + `(bset (Lt e) = {}) /\ + (bset (Gt e) = {(--e)}) /\ + (bset (Eq e) = {(--(e + &1))}) /\ + (bset (Ne e) = {(--e)}) /\ + (bset (Divides c e) = {}) /\ + (bset (Ndivides c e) = {}) /\ + (bset (And p q) = (bset p) UNION (bset q)) /\ + (bset (Or p q) = (bset p) UNION (bset q)) /\ + (bset (Nox P) = {})`;; + +(* ------------------------------------------------------------------------- *) +(* The key minimality case analysis for the integers. *) +(* ------------------------------------------------------------------------- *) + +let INT_EXISTS_CASES = prove + (`(?x. P x) <=> (!y. ?x. x < y /\ P x) \/ (?x. P x /\ !y. y < x ==> ~P y)`, + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_TAC `x:int`) THEN + MATCH_MP_TAC(TAUT `(~b ==> a) ==> a \/ b`) THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM; + NOT_IMP] THEN + STRIP_TAC THEN X_GEN_TAC `y:int` THEN + DISJ_CASES_TAC(INT_ARITH `x < y \/ &0 <= x - y`) THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!n. ?y. y < x - &n /\ P y` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[INT_FORALL_POS] THEN + DISCH_THEN(MP_TAC o SPEC `x - y`) THEN + ASM_REWRITE_TAC[INT_ARITH `x - (x - y) = y`]] THEN + INDUCT_TAC THEN + REWRITE_TAC[INT_SUB_RZERO; GSYM INT_OF_NUM_SUC] THEN + ASM_MESON_TAC[INT_ARITH `z < y /\ y < x - &n ==> z < x - (&n + &1)`]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas towards the main theorems (following my book). *) +(* ------------------------------------------------------------------------- *) + +let MINUSINF_LEMMA = prove + (`!p. ?y. !x. x < y ==> (interp x p <=> interp x (minusinf p))`, + MATCH_MP_TAC cform_INDUCT THEN + REWRITE_TAC[interp; minusinf] THEN + MATCH_MP_TAC(TAUT + `(a /\ b /\ c /\ d) /\ (e /\ f) ==> a /\ b /\ c /\ d /\ e /\ f`) THEN + CONJ_TAC THENL + [MESON_TAC[INT_ARITH `x < --a ==> x + a < &0`; INT_GT; + INT_LT_ANTISYM; INT_LT_REFL]; + ALL_TAC] THEN + CONJ_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN STRIP_TAC THEN + MP_TAC(SPECL [`a:int`; `b:int`] INT_DOWN2) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[]);; + +let MINUSINF_REPEATS = prove + (`!p c d x. alldivide d p + ==> (interp x (minusinf p) <=> interp (x + c * d) (minusinf p))`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN MATCH_MP_TAC cform_INDUCT THEN + SIMP_TAC[interp; minusinf; alldivide] THEN + ONCE_REWRITE_TAC[INT_ARITH `(x + d) + y = (x + y) + d`] THEN + MESON_TAC[DIVIDES_LMUL; DIVIDES_ADD_REVL; DIVIDES_ADD]);; + +let NOMINIMAL_EQUIV = prove + (`alldivide d p /\ &0 < d + ==> ((!y. ?x. x < y /\ interp x p) <=> + ?j. &1 <= j /\ j <= d /\ interp j (minusinf p))`, + ASM_MESON_TAC[MINUSINF_LEMMA; MINUSINF_REPEATS; INT_DOWN_MUL_LT; + INT_DOWN2; INT_MOD_LEMMA]);; + +let BDISJ_REPEATS_LEMMA = prove + (`!d p. alldivide d p /\ &0 < d + ==> !x. interp x p /\ ~(interp (x - d) p) + ==> ?j b. &1 <= j /\ j <= d /\ b IN bset p /\ (x = b + j)`, + GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> b ==> a ==> c`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC cform_INDUCT THEN + REWRITE_TAC[interp; alldivide; bset; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(TAUT `(a /\ b /\ c /\ d /\ e /\ f) /\ g /\ h + ==> a /\ b /\ c /\ d /\ e /\ f /\ g /\ h`) THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[TAUT `~a \/ a`; + TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`; + TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`; + TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`; + DE_MORGAN_THM; IN_UNION; EXISTS_OR_THM; FORALL_AND_THM]] THEN + REPEAT STRIP_TAC THENL + [ALL_TAC; + MAP_EVERY EXISTS_TAC [`x + a`; `--a`]; + MAP_EVERY EXISTS_TAC [`&1`; `--a - &1`]; + MAP_EVERY EXISTS_TAC [`d:int`; `--a`]; + ASM_MESON_TAC[INT_ARITH `(x - y) + z = (x + z) - y`; DIVIDES_SUB]; + ASM_MESON_TAC[INT_ARITH `(x - y) + z = (x + z) - y`; + INT_ARITH `(x - y) + y = x`; DIVIDES_ADD]] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[IN_SING] THEN INT_ARITH_TAC);; + +let MAINTHM_B = prove + (`!p d. alldivide d p /\ &0 < d + ==> ((?x. interp x p) <=> + ?j. &1 <= j /\ j <= d /\ + (interp j (minusinf p) \/ + ?b. b IN bset p /\ interp (b + j) p))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`; EXISTS_OR_THM] THEN + MATCH_MP_TAC(TAUT + `!a1 a2. (a <=> a1 \/ a2) /\ (a1 <=> b) /\ (a2 ==> c) /\ (c ==> a) + ==> (a <=> b \/ c)`) THEN + EXISTS_TAC `!y. ?x. x < y /\ interp x p` THEN + EXISTS_TAC `?x. interp x p /\ !y. y < x ==> ~(interp y p)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM INT_EXISTS_CASES]; + ASM_MESON_TAC[NOMINIMAL_EQUIV]; + ALL_TAC; + MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x - d`))) THEN + ASM_SIMP_TAC[INT_ARITH `&0 < d ==> x - d < x`] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`d:int`; `p:cform`] BDISJ_REPEATS_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:int`) THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Deduce the other one by a symmetry argument rather than a similar proof. *) +(* ------------------------------------------------------------------------- *) + +let mirror = new_recursive_definition cform_RECURSION + `(mirror (Lt e) = Gt(--e)) /\ + (mirror (Gt e) = Lt(--e)) /\ + (mirror (Eq e) = Eq(--e)) /\ + (mirror (Ne e) = Ne(--e)) /\ + (mirror (Divides c e) = Divides c (--e)) /\ + (mirror (Ndivides c e) = Ndivides c (--e)) /\ + (mirror (And p q) = And (mirror p) (mirror q)) /\ + (mirror (Or p q) = Or (mirror p) (mirror q)) /\ + (mirror (Nox P) = Nox P)`;; + +let INTERP_MIRROR_LEMMA = prove + (`!p x. interp (--x) (mirror p) <=> interp x p`, + MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[mirror; interp] THEN + REWRITE_TAC[GSYM INT_NEG_ADD; DIVIDES_RNEG] THEN INT_ARITH_TAC);; + +let INTERP_MIRROR = prove + (`!p x. interp x (mirror p) <=> interp (--x) p`, + MESON_TAC[INTERP_MIRROR_LEMMA; INT_NEG_NEG]);; + +let BSET_MIRROR = prove + (`!p. bset(mirror p) = IMAGE (--) (aset p)`, + MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[mirror; aset; bset] THEN + REWRITE_TAC[IMAGE_CLAUSES; IMAGE_UNION] THEN + REWRITE_TAC[EXTENSION; IN_SING] THEN INT_ARITH_TAC);; + +let MINUSINF_MIRROR = prove + (`!p. minusinf (mirror p) = mirror (plusinf p)`, + MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[plusinf; minusinf; mirror]);; + +let PLUSINF_MIRROR = prove + (`!p. plusinf p = mirror(minusinf (mirror p))`, + MATCH_MP_TAC cform_INDUCT THEN + SIMP_TAC[plusinf; minusinf; mirror; INT_NEG_NEG]);; + +let ALLDIVIDE_MIRROR = prove + (`!p d. alldivide d (mirror p) = alldivide d p`, + MATCH_MP_TAC cform_INDUCT THEN SIMP_TAC[mirror; alldivide]);; + +let EXISTS_NEG = prove + (`(?x. P(--x)) <=> (?x. P(x))`, + MESON_TAC[INT_NEG_NEG]);; + +let FORALL_NEG = prove + (`(!x. P(--x)) <=> (!x. P x)`, + MESON_TAC[INT_NEG_NEG]);; + +let EXISTS_MOD_IMP = prove + (`!P d. (!c x. P(x + c * d) <=> P(x)) /\ (?j. &1 <= j /\ j <= d /\ P(--j)) + ==> ?j. &1 <= j /\ j <= d /\ P(j)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `d:int = j` THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`--(&2)`; `d:int`]) THEN + ASM_REWRITE_TAC[INT_ARITH `d + --(&2) * d = --d`] THEN + ASM_MESON_TAC[INT_LE_REFL]; + FIRST_X_ASSUM(MP_TAC o SPECL [`&1`; `--j`]) THEN + ASM_REWRITE_TAC[INT_ARITH `--j + &1 * d = d - j`] THEN + DISCH_TAC THEN EXISTS_TAC `d - j` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC [`&1 <= j`; `j <= d`; `~(d:int = j)`] THEN + INT_ARITH_TAC]);; + +let EXISTS_MOD_EQ = prove + (`!P d. (!c x. P(x + c * d) <=> P(x)) + ==> ((?j. &1 <= j /\ j <= d /\ P(--j)) <=> + (?j. &1 <= j /\ j <= d /\ P(j)))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MP_TAC(SPEC `P:int->bool` EXISTS_MOD_IMP); + MP_TAC(SPEC `\x. P(--x):bool` EXISTS_MOD_IMP)] THEN + DISCH_THEN(MP_TAC o SPEC `d:int`) THEN ASM_REWRITE_TAC[INT_NEG_NEG] THEN + ASM_REWRITE_TAC[INT_ARITH `--(x + c * d) = --x + --c * d`; FORALL_NEG] THEN + MESON_TAC[]);; + +let MAINTHM_A = prove + (`!p d. alldivide d p /\ &0 < d + ==> ((?x. interp x p) <=> + ?j. &1 <= j /\ j <= d /\ + (interp j (plusinf p) \/ + ?a. a IN aset p /\ interp (a - j) p))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM EXISTS_NEG] THEN + REWRITE_TAC[GSYM INTERP_MIRROR] THEN + MP_TAC(SPECL [`mirror p`; `d:int`] MAINTHM_B) THEN + ASM_REWRITE_TAC[ALLDIVIDE_MIRROR] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`; + TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`; EXISTS_OR_THM] THEN + BINOP_TAC THENL + [ALL_TAC; + REWRITE_TAC[INTERP_MIRROR; MINUSINF_MIRROR; BSET_MIRROR] THEN + REWRITE_TAC[INT_ARITH `--(b + j) = --b - j`; IN_IMAGE] THEN + MESON_TAC[INT_NEG_NEG]] THEN + REWRITE_TAC[PLUSINF_MIRROR] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ALLDIVIDE_MIRROR]) THEN + SPEC_TAC(`mirror p`,`q:cform`) THEN REWRITE_TAC[INTERP_MIRROR] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM EXISTS_MOD_EQ) THEN + ASM_SIMP_TAC[GSYM MINUSINF_REPEATS]);; + +(* ------------------------------------------------------------------------- *) +(* Proforma for elimination of coefficient of main variable. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_MULTIPLE_THM_1 = prove + (`(?x. P(&1 * x)) <=> ?x. P(x)`, + REWRITE_TAC[INT_MUL_LID]);; + +let EXISTS_MULTIPLE_THM = prove + (`(?x. P(c * x)) <=> ?x. c divides x /\ P(x)`, + MESON_TAC[divides]);; + +(* ------------------------------------------------------------------------- *) +(* Ordering of variables determined by a list, *with* trivial default. *) +(* ------------------------------------------------------------------------- *) + +let rec earlier vars x y = + match vars with + z::ovs -> if z = y then false + else if z = x then true + else earlier ovs x y + | [] -> x < y;; + +(* ------------------------------------------------------------------------- *) +(* Conversion of integer constant to ML rational number. *) +(* This is a tweaked copy of the real-type versions in "real.ml". *) +(* ------------------------------------------------------------------------- *) + +let is_num_const = + let ptm = `&` in + fun tm -> try let l,r = dest_comb tm in + l = ptm & is_numeral r + with Failure _ -> false;; + +let mk_num_const,dest_num_const = + let ptm = `&` in + (fun n -> mk_comb(ptm,mk_numeral n)), + (fun tm -> let l,r = dest_comb tm in + if l = ptm then dest_numeral r + else failwith "dest_num_const");; + +let is_int_const = + let ptm = `(--)` in + fun tm -> + is_num_const tm or + try let l,r = dest_comb tm in + l = ptm & is_num_const r + with Failure _ -> false;; + +let mk_int_const,dest_int_const = + let ptm = `(--)` in + (fun n -> if n if try rator tm = ptm with Failure _ -> false then + minus_num (dest_num_const(rand tm)) + else dest_num_const tm);; + +(* ------------------------------------------------------------------------- *) +(* Similar tweaks of all the REAL_INT_..._CONV arith convs in real.ml *) +(* ------------------------------------------------------------------------- *) + +let INT_LE_CONV,INT_LT_CONV, + INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV = + let tth = + TAUT `(F /\ F <=> F) /\ (F /\ T <=> F) /\ + (T /\ F <=> F) /\ (T /\ T <=> T)` in + let nth = TAUT `(~T <=> F) /\ (~F <=> T)` in + let NUM2_EQ_CONV = + COMB2_CONV (RAND_CONV NUM_EQ_CONV) NUM_EQ_CONV THENC + GEN_REWRITE_CONV I [tth] in + let NUM2_NE_CONV = + RAND_CONV NUM2_EQ_CONV THENC + GEN_REWRITE_CONV I [nth] in + let [pth_le1; pth_le2a; pth_le2b; pth_le3] = (CONJUNCTS o prove) + (`(--(&m) <= &n <=> T) /\ + (&m <= &n <=> m <= n) /\ + (--(&m) <= --(&n) <=> n <= m) /\ + (&m <= --(&n) <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[INT_LE_NEG2] THEN + REWRITE_TAC[INT_LE_LNEG; INT_LE_RNEG] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE; LE_0] THEN + REWRITE_TAC[LE; ADD_EQ_0]) in + let INT_LE_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_le1]; + GEN_REWRITE_CONV I [pth_le2a; pth_le2b] THENC NUM_LE_CONV; + GEN_REWRITE_CONV I [pth_le3] THENC NUM2_EQ_CONV] in + let [pth_lt1; pth_lt2a; pth_lt2b; pth_lt3] = (CONJUNCTS o prove) + (`(&m < --(&n) <=> F) /\ + (&m < &n <=> m < n) /\ + (--(&m) < --(&n) <=> n < m) /\ + (--(&m) < &n <=> ~((m = 0) /\ (n = 0)))`, + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; + GSYM NOT_LE; GSYM INT_NOT_LE] THEN + CONV_TAC TAUT) in + let INT_LT_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_lt1]; + GEN_REWRITE_CONV I [pth_lt2a; pth_lt2b] THENC NUM_LT_CONV; + GEN_REWRITE_CONV I [pth_lt3] THENC NUM2_NE_CONV] in + let [pth_ge1; pth_ge2a; pth_ge2b; pth_ge3] = (CONJUNCTS o prove) + (`(&m >= --(&n) <=> T) /\ + (&m >= &n <=> n <= m) /\ + (--(&m) >= --(&n) <=> m <= n) /\ + (--(&m) >= &n <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; INT_GE] THEN + CONV_TAC TAUT) in + let INT_GE_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_ge1]; + GEN_REWRITE_CONV I [pth_ge2a; pth_ge2b] THENC NUM_LE_CONV; + GEN_REWRITE_CONV I [pth_ge3] THENC NUM2_EQ_CONV] in + let [pth_gt1; pth_gt2a; pth_gt2b; pth_gt3] = (CONJUNCTS o prove) + (`(--(&m) > &n <=> F) /\ + (&m > &n <=> n < m) /\ + (--(&m) > --(&n) <=> m < n) /\ + (&m > --(&n) <=> ~((m = 0) /\ (n = 0)))`, + REWRITE_TAC[pth_lt1; pth_lt2a; pth_lt2b; pth_lt3; INT_GT] THEN + CONV_TAC TAUT) in + let INT_GT_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_gt1]; + GEN_REWRITE_CONV I [pth_gt2a; pth_gt2b] THENC NUM_LT_CONV; + GEN_REWRITE_CONV I [pth_gt3] THENC NUM2_NE_CONV] in + let [pth_eq1a; pth_eq1b; pth_eq2a; pth_eq2b] = (CONJUNCTS o prove) + (`((&m = &n) <=> (m = n)) /\ + ((--(&m) = --(&n)) <=> (m = n)) /\ + ((--(&m) = &n) <=> (m = 0) /\ (n = 0)) /\ + ((&m = --(&n)) <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[GSYM INT_LE_ANTISYM; GSYM LE_ANTISYM] THEN + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; LE; LE_0] THEN + CONV_TAC TAUT) in + let INT_EQ_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_eq1a; pth_eq1b] THENC NUM_EQ_CONV; + GEN_REWRITE_CONV I [pth_eq2a; pth_eq2b] THENC NUM2_EQ_CONV] in + INT_LE_CONV,INT_LT_CONV, + INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV;; + +let INT_NEG_CONV = + let pth = prove + (`(--(&0) = &0) /\ + (--(--(&x)) = &x)`, + REWRITE_TAC[INT_NEG_NEG; INT_NEG_0]) in + GEN_REWRITE_CONV I [pth];; + +let INT_MUL_CONV = + let pth0 = prove + (`(&0 * &x = &0) /\ + (&0 * --(&x) = &0) /\ + (&x * &0 = &0) /\ + (--(&x) * &0 = &0)`, + REWRITE_TAC[INT_MUL_LZERO; INT_MUL_RZERO]) + and pth1,pth2 = (CONJ_PAIR o prove) + (`((&m * &n = &(m * n)) /\ + (--(&m) * --(&n) = &(m * n))) /\ + ((--(&m) * &n = --(&(m * n))) /\ + (&m * --(&n) = --(&(m * n))))`, + REWRITE_TAC[INT_MUL_LNEG; INT_MUL_RNEG; INT_NEG_NEG] THEN + REWRITE_TAC[INT_OF_NUM_MUL]) in + FIRST_CONV + [GEN_REWRITE_CONV I [pth0]; + GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_MULT_CONV; + GEN_REWRITE_CONV I [pth2] THENC RAND_CONV(RAND_CONV NUM_MULT_CONV)];; + +let INT_ADD_CONV = + let neg_tm = `(--)` in + let amp_tm = `&` in + let add_tm = `(+)` in + let dest = dest_binop `(+)` in + let m_tm = `m:num` and n_tm = `n:num` in + let pth0 = prove + (`(--(&m) + &m = &0) /\ + (&m + --(&m) = &0)`, + REWRITE_TAC[INT_ADD_LINV; INT_ADD_RINV]) in + let [pth1; pth2; pth3; pth4; pth5; pth6] = (CONJUNCTS o prove) + (`(--(&m) + --(&n) = --(&(m + n))) /\ + (--(&m) + &(m + n) = &n) /\ + (--(&(m + n)) + &m = --(&n)) /\ + (&(m + n) + --(&m) = &n) /\ + (&m + --(&(m + n)) = --(&n)) /\ + (&m + &n = &(m + n))`, + REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_NEG_ADD] THEN + REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN + REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID] THEN + ONCE_REWRITE_TAC[INT_ADD_SYM] THEN + REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN + REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID]) in + GEN_REWRITE_CONV I [pth0] ORELSEC + (fun tm -> + try let l,r = dest tm in + if rator l = neg_tm then + if rator r = neg_tm then + let th1 = INST [rand(rand l),m_tm; rand(rand r),n_tm] pth1 in + let tm1 = rand(rand(rand(concl th1))) in + let th2 = AP_TERM neg_tm (AP_TERM amp_tm (NUM_ADD_CONV tm1)) in + TRANS th1 th2 + else + let m = rand(rand l) and n = rand r in + let m' = dest_numeral m and n' = dest_numeral n in + if m' <=/ n' then + let p = mk_numeral (n' -/ m') in + let th1 = INST [m,m_tm; p,n_tm] pth2 in + let th2 = NUM_ADD_CONV (rand(rand(lhand(concl th1)))) in + let th3 = AP_TERM (rator tm) (AP_TERM amp_tm (SYM th2)) in + TRANS th3 th1 + else + let p = mk_numeral (m' -/ n') in + let th1 = INST [n,m_tm; p,n_tm] pth3 in + let th2 = NUM_ADD_CONV (rand(rand(lhand(lhand(concl th1))))) in + let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_THM (AP_TERM add_tm th3) (rand tm) in + TRANS th4 th1 + else + if rator r = neg_tm then + let m = rand l and n = rand(rand r) in + let m' = dest_numeral m and n' = dest_numeral n in + if n' <=/ m' then + let p = mk_numeral (m' -/ n') in + let th1 = INST [n,m_tm; p,n_tm] pth4 in + let th2 = NUM_ADD_CONV (rand(lhand(lhand(concl th1)))) in + let th3 = AP_TERM add_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_THM th3 (rand tm) in + TRANS th4 th1 + else + let p = mk_numeral (n' -/ m') in + let th1 = INST [m,m_tm; p,n_tm] pth5 in + let th2 = NUM_ADD_CONV (rand(rand(rand(lhand(concl th1))))) in + let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_TERM (rator tm) th3 in + TRANS th4 th1 + else + let th1 = INST [rand l,m_tm; rand r,n_tm] pth6 in + let tm1 = rand(rand(concl th1)) in + let th2 = AP_TERM amp_tm (NUM_ADD_CONV tm1) in + TRANS th1 th2 + with Failure _ -> failwith "INT_ADD_CONV");; + +let INT_SUB_CONV = + GEN_REWRITE_CONV I [INT_SUB] THENC + TRY_CONV(RAND_CONV INT_NEG_CONV) THENC + INT_ADD_CONV;; + +let INT_POW_CONV = + let n = `n:num` and x = `x:num` in + let pth1,pth2 = (CONJ_PAIR o prove) + (`(&x pow n = &(x EXP n)) /\ + ((--(&x)) pow n = if EVEN n then &(x EXP n) else --(&(x EXP n)))`, + REWRITE_TAC[INT_OF_NUM_POW; INT_POW_NEG]) in + let tth = prove + (`((if T then x:int else y) = x) /\ ((if F then x:int else y) = y)`, + REWRITE_TAC[]) in + let neg_tm = `(--)` in + (GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_EXP_CONV) ORELSEC + (GEN_REWRITE_CONV I [pth2] THENC + RATOR_CONV(RATOR_CONV(RAND_CONV NUM_EVEN_CONV)) THENC + GEN_REWRITE_CONV I [tth] THENC + (fun tm -> if rator tm = neg_tm then RAND_CONV(RAND_CONV NUM_EXP_CONV) tm + else RAND_CONV NUM_EXP_CONV tm));; + +(* ------------------------------------------------------------------------- *) +(* Handy utility functions for int arithmetic terms. *) +(* ------------------------------------------------------------------------- *) + +let dest_add = dest_binop `(+)`;; +let dest_mul = dest_binop `(*)`;; +let dest_pow = dest_binop `(pow)`;; +let dest_sub = dest_binop `(-)`;; + +let is_add = is_binop `(+)`;; +let is_mul = is_binop `(*)`;; +let is_pow = is_binop `(pow)`;; +let is_sub = is_binop `(-)`;; + +(* ------------------------------------------------------------------------- *) +(* Instantiate the normalizer. *) +(* ------------------------------------------------------------------------- *) + +let POLYNOMIAL_NORMALIZERS = + let sth = prove + (`(!x y z. x + (y + z) = (x + y) + z) /\ + (!x y. x + y = y + x) /\ + (!x. &0 + x = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x y. x * y = y * x) /\ + (!x. &1 * x = x) /\ + (!x. &0 * x = &0) /\ + (!x y z. x * (y + z) = x * y + x * z) /\ + (!x. x pow 0 = &1) /\ + (!x n. x pow (SUC n) = x * x pow n)`, + REWRITE_TAC[INT_POW] THEN INT_ARITH_TAC) + and rth = prove + (`(!x. --x = --(&1) * x) /\ + (!x y. x - y = x + --(&1) * y)`, + INT_ARITH_TAC) + and is_semiring_constant = is_int_const + and SEMIRING_ADD_CONV = INT_ADD_CONV + and SEMIRING_MUL_CONV = INT_MUL_CONV + and SEMIRING_POW_CONV = INT_POW_CONV in + let NORMALIZERS = + SEMIRING_NORMALIZERS_CONV sth rth + (is_semiring_constant, + SEMIRING_ADD_CONV,SEMIRING_MUL_CONV,SEMIRING_POW_CONV) in + fun vars -> NORMALIZERS(earlier vars);; + +let POLYNOMIAL_NEG_CONV vars = + let cnv,_,_,_,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; + +let POLYNOMIAL_ADD_CONV vars = + let _,cnv,_,_,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; + +let POLYNOMIAL_SUB_CONV vars = + let _,_,cnv,_,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; + +let POLYNOMIAL_MUL_CONV vars = + let _,_,_,cnv,_,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; + +let POLYNOMIAL_POW_CONV vars = + let _,_,_,_,cnv,_ = POLYNOMIAL_NORMALIZERS vars in cnv;; + +let POLYNOMIAL_CONV vars = + let _,_,_,_,_,cnv = POLYNOMIAL_NORMALIZERS vars in cnv;; + +(* ------------------------------------------------------------------------- *) +(* Slight variants of these functions for procedure below. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_CMUL = + let mul_tm = `(*)` in + fun vars n tm -> + POLYNOMIAL_MUL_CONV vars (mk_comb(mk_comb(mul_tm,mk_int_const n),tm));; + +(* ------------------------------------------------------------------------- *) +(* Linearize a formula, dealing with non-strict inequalities. *) +(* ------------------------------------------------------------------------- *) + +let LINEARIZE_CONV = + let rew_conv = GEN_REWRITE_CONV I + [CONJ (REFL `c divides e`) + (INT_ARITH + `(s < t <=> &0 < t - s) /\ + (~(s < t) <=> &0 < (s + &1) - t) /\ + (s > t <=> &0 < s - t) /\ + (~(s > t) <=> &0 < (t + &1) - s) /\ + (s <= t <=> &0 < (t + &1) - s) /\ + (~(s <= t) <=> &0 < s - t) /\ + (s >= t <=> &0 < (s + &1) - t) /\ + (~(s >= t) <=> &0 < t - s) /\ + ((s = t) <=> (&0 = s - t))`)] + and true_tm = `T` and false_tm = `F` in + let rec conv vars tm = + try (rew_conv THENC RAND_CONV(POLYNOMIAL_CONV vars)) tm with Failure _ -> + if is_exists tm or is_forall tm then + let x = bndvar(rand tm) in BINDER_CONV (conv (x::vars)) tm + else if is_neg tm then + RAND_CONV (conv vars) tm + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + BINOP_CONV (conv vars) tm + else if tm = true_tm or tm = false_tm then REFL tm + else failwith "LINEARIZE_CONV: Unexpected term type" in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Get the coefficient of x, assumed to be first term, if there at all. *) +(* ------------------------------------------------------------------------- *) + +let coefficient x tm = + try let l,r = dest_add tm in + if l = x then Int 1 else + let c,y = dest_mul l in + if y = x then dest_int_const c else Int 0 + with Failure _ -> try + let c,y = dest_mul tm in + if y = x then dest_int_const c else Int 0 + with Failure _ -> Int 1;; + +(* ------------------------------------------------------------------------- *) +(* Find (always positive) LCM of all the multiples of x in formula tm. *) +(* ------------------------------------------------------------------------- *) + +let lcm_num x y = abs_num((x */ y) // gcd_num x y);; + +let rec formlcm x tm = + if is_neg tm then formlcm x (rand tm) + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + lcm_num (formlcm x (lhand tm)) (formlcm x (rand tm)) + else if is_forall tm or is_exists tm then + formlcm x (body(rand tm)) + else if not(mem x (frees tm)) then Int 1 + else let c = coefficient x (rand tm) in + if c =/ Int 0 then Int 1 else c;; + +(* ------------------------------------------------------------------------- *) +(* Switch from "x [+ ...]" to "&1 * x [+ ...]" to suit later proforma. *) +(* ------------------------------------------------------------------------- *) + +let MULTIPLY_1_CONV = + let conv_0 = REWR_CONV(INT_ARITH `x = &1 * x`) + and conv_1 = REWR_CONV(INT_ARITH `x + a = &1 * x + a`) in + fun vars tm -> + let x = hd vars in + if tm = x then conv_0 tm + else if is_add tm & lhand tm = x then conv_1 tm + else REFL tm;; + +(* ------------------------------------------------------------------------- *) +(* Adjust all coefficients of x (head variable) to match l in formula tm. *) +(* ------------------------------------------------------------------------- *) + +let ADJUSTCOEFF_CONV = + let op_eq = `(=):int->int->bool` + and op_lt = `(<):int->int->bool` + and op_gt = `(>):int->int->bool` + and op_divides = `(divides):int->int->bool` + and c_tm = `c:int` + and d_tm = `d:int` + and e_tm = `e:int` in + let pth_divides = prove + (`~(d = &0) ==> (c divides e <=> (d * c) divides (d * e))`, + SIMP_TAC[divides; GSYM INT_MUL_ASSOC; INT_EQ_MUL_LCANCEL]) + and pth_eq = prove + (`~(d = &0) ==> ((&0 = e) <=> (&0 = d * e))`, + DISCH_TAC THEN CONV_TAC(BINOP_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[INT_ENTIRE]) + and pth_lt_pos = prove + (`&0 < d ==> (&0 < e <=> &0 < d * e)`, + DISCH_TAC THEN SUBGOAL_THEN `&0 < e <=> d * &0 < d * e` SUBST1_TAC THENL + [ASM_SIMP_TAC[INT_LT_LMUL_EQ]; REWRITE_TAC[INT_MUL_RZERO]]) + and pth_gt_pos = prove + (`&0 < d ==> (&0 > e <=> &0 > d * e)`, + DISCH_TAC THEN REWRITE_TAC[INT_GT] THEN + SUBGOAL_THEN `e < &0 <=> d * e < d * &0` SUBST1_TAC THENL + [ASM_SIMP_TAC[INT_LT_LMUL_EQ]; REWRITE_TAC[INT_MUL_RZERO]]) + and true_tm = `T` and false_tm = `F` in + let pth_lt_neg = prove + (`d < &0 ==> (&0 < e <=> &0 > d * e)`, + REWRITE_TAC[INT_ARITH `&0 > d * e <=> &0 < --d * e`; + INT_ARITH `d < &0 <=> &0 < --d`; pth_lt_pos]) + and pth_gt_neg = prove + (`d < &0 ==> (&0 > e <=> &0 < d * e)`, + REWRITE_TAC[INT_ARITH `&0 < d * e <=> &0 > --d * e`; + INT_ARITH `d < &0 <=> &0 < --d`; pth_gt_pos]) in + let rec ADJUSTCOEFF_CONV vars l tm = + if tm = true_tm or tm = false_tm then REFL tm + else if is_exists tm or is_forall tm then + BINDER_CONV (ADJUSTCOEFF_CONV vars l) tm + else if is_neg tm then + RAND_CONV (ADJUSTCOEFF_CONV vars l) tm + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + BINOP_CONV (ADJUSTCOEFF_CONV vars l) tm + else + let lop,t = dest_comb tm in + let op,z = dest_comb lop in + let c = coefficient (hd vars) t in + if c =/ Int 0 then REFL tm else + let th1 = + if c =/ l then REFL tm else + let m = l // c in + let th0 = if op = op_eq then pth_eq + else if op = op_divides then pth_divides + else if op = op_lt then + if m >/ Int 0 then pth_lt_pos else pth_lt_neg + else if op = op_gt then + if m >/ Int 0 then pth_gt_pos else pth_gt_neg + else failwith "ADJUSTCOEFF_CONV: unknown predicate" in + let th1 = INST [mk_int_const m,d_tm; z,c_tm; t,e_tm] th0 in + let tm1 = lhand(concl th1) in + let th2 = if is_neg tm1 then EQF_ELIM(INT_EQ_CONV(rand tm1)) + else EQT_ELIM(INT_LT_CONV tm1) in + let th3 = MP th1 th2 in + if op = op_divides then + let th3 = MP th1 th2 in + let tm2 = rand(concl th3) in + let l,r = dest_comb tm2 in + let th4 = AP_TERM (rator l) (INT_MUL_CONV (rand l)) in + let th5 = AP_THM th4 r in + let tm3 = rator(rand(concl th5)) in + let th6 = TRANS th5 (AP_TERM tm3 (LINEAR_CMUL vars m t)) in + TRANS th3 th6 + else + let tm2 = rator(rand(concl th3)) in + TRANS th3 (AP_TERM tm2 (LINEAR_CMUL vars m t)) in + if l =/ Int 1 then + CONV_RULE(funpow 2 RAND_CONV (MULTIPLY_1_CONV vars)) th1 + else th1 in + ADJUSTCOEFF_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Now normalize all the x terms to have same coefficient and eliminate it. *) +(* ------------------------------------------------------------------------- *) + +let NORMALIZE_COEFF_CONV = + let c_tm = `c:int` + and pth = prove + (`(?x. P(c * x)) <=> (?x. c divides x /\ P x)`, + REWRITE_TAC[GSYM EXISTS_MULTIPLE_THM]) in + let NORMALIZE_COEFF_CONV vars tm = + let x,bod = dest_exists tm in + let l = formlcm x tm in + let th1 = ADJUSTCOEFF_CONV (x::vars) l tm in + let th2 = if l =/ Int 1 then EXISTS_MULTIPLE_THM_1 + else INST [mk_int_const l,c_tm] pth in + TRANS th1 (REWR_CONV th2 (rand(concl th1))) in + NORMALIZE_COEFF_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Convert to shadow syntax. *) +(* ------------------------------------------------------------------------- *) + +let SHADOW_CONV = + let pth_trivial = prove + (`P = interp x (Nox P)`, + REWRITE_TAC[interp]) + and pth_composite = prove + (`(interp x p /\ interp x q <=> interp x (And p q)) /\ + (interp x p \/ interp x q <=> interp x (Or p q))`, + REWRITE_TAC[interp]) + and pth_literal_nontrivial = prove + (`(&0 > x + e <=> interp x (Lt e)) /\ + (&0 < x + e <=> interp x (Gt e)) /\ + ((&0 = x + e) <=> interp x (Eq e)) /\ + (~(&0 = x + e) <=> interp x (Ne e)) /\ + (c divides (x + e) <=> interp x (Divides c e)) /\ + (~(c divides (x + e)) <=> interp x (Ndivides c e))`, + REWRITE_TAC[interp; INT_ADD_RID] THEN INT_ARITH_TAC) + and pth_literal_trivial = prove + (`(&0 > x <=> interp x (Lt(&0))) /\ + (&0 < x <=> interp x (Gt(&0))) /\ + ((&0 = x) <=> interp x (Eq(&0))) /\ + (~(&0 = x) <=> interp x (Ne(&0))) /\ + (c divides x <=> interp x (Divides c (&0))) /\ + (~(c divides x) <=> interp x (Ndivides c (&0)))`, + REWRITE_TAC[interp; INT_ADD_RID] THEN INT_ARITH_TAC) in + let rewr_composite = GEN_REWRITE_CONV I [pth_composite] + and rewr_literal = GEN_REWRITE_CONV I [pth_literal_nontrivial] ORELSEC + GEN_REWRITE_CONV I [pth_literal_trivial] + and x_tm = `x:int` and p_tm = `P:bool` in + let rec SHADOW_CONV x tm = + if not (mem x (frees tm)) then + INST [tm,p_tm; x,x_tm] pth_trivial + else if is_conj tm or is_disj tm then + let l,r = try dest_conj tm with Failure _ -> dest_disj tm in + let thl = SHADOW_CONV x l and thr = SHADOW_CONV x r in + let th1 = MK_COMB(AP_TERM (rator(rator tm)) thl,thr) in + TRANS th1 (rewr_composite(rand(concl th1))) + else rewr_literal tm in + fun tm -> + let x,bod = dest_exists tm in + MK_EXISTS x (SHADOW_CONV x bod);; + +(* ------------------------------------------------------------------------- *) +(* Get the LCM of the dividing things. *) +(* ------------------------------------------------------------------------- *) + +let dplcm = + let divides_tm = `Divides` + and ndivides_tm = `Ndivides` + and and_tm = `And` + and or_tm = `Or` in + let rec dplcm tm = + let hop,args = strip_comb tm in + if hop = divides_tm or hop = ndivides_tm then dest_int_const (hd args) + else if hop = and_tm or hop = or_tm + then end_itlist lcm_num (map dplcm args) + else Int 1 in + dplcm;; + +(* ------------------------------------------------------------------------- *) +(* Conversion for true formulas "(--) &m divides (--) &n". *) +(* ------------------------------------------------------------------------- *) + +let PROVE_DIVIDES_CONV_POS = + let pth = prove + (`(p * m = n) ==> &p divides &n`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `&m` THEN + REWRITE_TAC[INT_OF_NUM_MUL]) + and m_tm = `m:num` and n_tm = `n:num` and p_tm = `p:num` in + fun tm -> + let n = rand(rand tm) + and p = rand(lhand tm) in + let m = mk_numeral(dest_numeral n // dest_numeral p) in + let th1 = INST [m,m_tm; n,n_tm; p,p_tm] pth in + EQT_INTRO(MP th1 (NUM_MULT_CONV (lhand(lhand(concl th1)))));; + +let PROVE_DIVIDES_CONV = + GEN_REWRITE_CONV REPEATC [DIVIDES_LNEG; DIVIDES_RNEG] THENC + PROVE_DIVIDES_CONV_POS;; + +(* ------------------------------------------------------------------------- *) +(* General version that works for positive and negative. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVIDES_NUM = prove + (`&p divides &n <=> ?m. (n = p * m)`, + REWRITE_TAC[divides] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:int` MP_TAC) THEN + DISJ_CASES_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) + (SPEC `x:int` INT_IMAGE) THEN + DISCH_THEN(MP_TAC o AP_TERM `abs:int->int`) THEN + REWRITE_TAC[INT_ABS_MUL; INT_ABS_NUM; INT_ABS_NEG] THEN + REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_EQ] THEN MESON_TAC[]; + MESON_TAC[INT_OF_NUM_MUL]]);; + +let INT_DIVIDES_POS_CONV = + let pth = prove + (`(&p divides &n) <=> (p = 0) /\ (n = 0) \/ ~(p = 0) /\ (n MOD p = 0)`, + REWRITE_TAC[INT_DIVIDES_NUM] THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN EQ_TAC THENL + [ASM_MESON_TAC[MOD_MULT]; + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN MESON_TAC[MULT_SYM]]) in + GEN_REWRITE_CONV I [pth] THENC NUM_REDUCE_CONV;; + +let INT_DIVIDES_CONV = + GEN_REWRITE_CONV REPEATC [DIVIDES_LNEG; DIVIDES_RNEG] THENC + INT_DIVIDES_POS_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Conversion for "alldivide d p" (which should be true!) *) +(* ------------------------------------------------------------------------- *) + +let ALLDIVIDE_CONV = + let pth_atom = prove + (`(alldivide d (Lt e) <=> T) /\ + (alldivide d (Gt e) <=> T) /\ + (alldivide d (Eq e) <=> T) /\ + (alldivide d (Ne e) <=> T) /\ + (alldivide d (Nox P) <=> T)`, + REWRITE_TAC[alldivide]) + and pth_div = prove + (`(alldivide d (Divides c e) <=> c divides d) /\ + (alldivide d (Ndivides c e) <=> c divides d)`, + REWRITE_TAC[alldivide]) + and pth_comp = prove + (`(alldivide d (And p q) <=> alldivide d p /\ alldivide d q) /\ + (alldivide d (Or p q) <=> alldivide d p /\ alldivide d q)`, + REWRITE_TAC[alldivide]) + and pth_taut = TAUT `(T /\ T <=> T)` in + let basnet = + itlist (fun th -> enter [] (lhand(concl th),REWR_CONV th)) + (CONJUNCTS pth_atom) + (itlist (fun th -> enter [] (lhand(concl th), + REWR_CONV th THENC PROVE_DIVIDES_CONV)) + (CONJUNCTS pth_div) empty_net) + and comp_rewr = GEN_REWRITE_CONV I [pth_comp] in + let rec alldivide_conv tm = + try tryfind (fun f -> f tm) (lookup tm basnet) with Failure _ -> + let th = (comp_rewr THENC BINOP_CONV alldivide_conv) tm in + TRANS th pth_taut in + alldivide_conv;; + +(* ------------------------------------------------------------------------- *) +(* Conversion for "?b. b IN bset p /\ P b";; *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_IN_BSET_CONV = + let pth_false = prove + (`((?b. b IN bset (Lt e) /\ P b) <=> F) /\ + ((?b. b IN bset (Divides c e) /\ P b) <=> F) /\ + ((?b. b IN bset (Ndivides c e) /\ P b) <=> F) /\ + ((?b. b IN bset(Nox Q) /\ P b) <=> F)`, + REWRITE_TAC[bset; NOT_IN_EMPTY]) + and pth_neg = prove + (`((?b. b IN bset (Gt e) /\ P b) <=> P(--e)) /\ + ((?b. b IN bset (Ne e) /\ P b) <=> P(--e))`, + REWRITE_TAC[bset; IN_SING; INT_MUL_LID; UNWIND_THM2]) + and pth_add = prove + (`(?b. b IN bset (Eq e) /\ P b) <=> P(--(e + &1))`, + REWRITE_TAC[bset; IN_SING; INT_MUL_LID; UNWIND_THM2]) + and pth_comp = prove + (`((?b. b IN bset (And p q) /\ P b) <=> + (?b. b IN bset p /\ P b) \/ + (?b. b IN bset q /\ P b)) /\ + ((?b. b IN bset (Or p q) /\ P b) <=> + (?b. b IN bset p /\ P b) \/ + (?b. b IN bset q /\ P b))`, + REWRITE_TAC[bset; IN_UNION] THEN MESON_TAC[]) + and taut = TAUT `(F \/ P <=> P) /\ (P \/ F <=> P)` in + let conv_neg vars = + LAND_CONV(LAND_CONV(POLYNOMIAL_NEG_CONV vars)) + and conv_add vars = + LAND_CONV(LAND_CONV(RAND_CONV(POLYNOMIAL_ADD_CONV vars) THENC + POLYNOMIAL_NEG_CONV vars)) + and conv_comp = GEN_REWRITE_CONV I [pth_comp] in + let net1 = + itlist (fun th -> enter [] (lhand(concl th),K (REWR_CONV th))) + (CONJUNCTS pth_false) empty_net in + let net2 = + itlist (fun th -> enter [] (lhand(concl th), + let cnv = K (REWR_CONV th) in fun v -> cnv v THENC conv_neg v)) + (CONJUNCTS pth_neg) net1 in + let basnet = + enter [] (lhand(concl pth_add), + let cnv = K (REWR_CONV pth_add) in fun v -> cnv v THENC conv_add v) + net2 in + let rec baseconv vars tm = + try tryfind (fun f -> f vars tm) (lookup tm basnet) with Failure _ -> + (conv_comp THENC BINOP_CONV (baseconv vars)) tm in + let finconv = + GEN_REWRITE_CONV DEPTH_CONV [taut] THENC + PURE_REWRITE_CONV [DISJ_ACI] in + fun vars tm -> (baseconv vars THENC finconv) tm;; + +(* ------------------------------------------------------------------------- *) +(* Naive conversion for "minusinf p". *) +(* ------------------------------------------------------------------------- *) + +let MINUSINF_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV [minusinf];; + +(* ------------------------------------------------------------------------- *) +(* Conversion for "interp s p" where s is a canonical linear form. *) +(* ------------------------------------------------------------------------- *) + +let INTERP_CONV = + let pth_trivial = prove + (`interp x (Nox P) <=> P`, + REWRITE_TAC[interp]) + and pth_comp = prove + (`(interp x (And p q) <=> interp x p /\ interp x q) /\ + (interp x (Or p q) <=> interp x p \/ interp x q)`, + REWRITE_TAC[interp]) + and pth_pos,pth_neg = (CONJ_PAIR o prove) + (`((interp x (Lt e) <=> &0 > x + e) /\ + (interp x (Gt e) <=> &0 < x + e) /\ + (interp x (Eq e) <=> (&0 = x + e)) /\ + (interp x (Divides c e) <=> c divides (x + e))) /\ + ((interp x (Ne e) <=> ~(&0 = x + e)) /\ + (interp x (Ndivides c e) <=> ~(c divides (x + e))))`, + REWRITE_TAC[interp] THEN INT_ARITH_TAC) in + let conv_pos vars = RAND_CONV(POLYNOMIAL_ADD_CONV vars) + and conv_neg vars = RAND_CONV(RAND_CONV(POLYNOMIAL_ADD_CONV vars)) + and conv_comp = GEN_REWRITE_CONV I [pth_comp] in + let net1 = + itlist (fun th -> enter [] (lhand(concl th),K (REWR_CONV th))) + (CONJUNCTS pth_trivial) empty_net in + let net2 = + itlist (fun th -> enter [] (lhand(concl th), + let cnv = K (REWR_CONV th) in fun v -> cnv v THENC conv_pos v)) + (CONJUNCTS pth_pos) net1 in + let basnet = + itlist (fun th -> enter [] (lhand(concl th), + let cnv = K (REWR_CONV th) in fun v -> cnv v THENC conv_neg v)) + (CONJUNCTS pth_neg) net2 in + let rec baseconv vars tm = + try tryfind (fun f -> f vars tm) (lookup tm basnet) with Failure _ -> + (conv_comp THENC BINOP_CONV (baseconv vars)) tm in + baseconv;; + +(* ------------------------------------------------------------------------- *) +(* Expand `?j. &1 <= j /\ j <= &[n] /\ P[j]` cases. *) +(* ------------------------------------------------------------------------- *) + +let EXPAND_INT_CASES_CONV = + let pth_base = prove + (`(?j. n <= j /\ j <= n /\ P(j)) <=> P(n)`, + MESON_TAC[INT_LE_ANTISYM]) + and pth_step = prove + (`(?j. &1 <= j /\ j <= &(SUC n) /\ P(j)) <=> + (?j. &1 <= j /\ j <= &n /\ P(j)) \/ P(&(SUC n))`, + REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN + REWRITE_TAC[INT_ARITH `x <= y + &1 <=> (x = y + &1) \/ x < y + &1`] THEN + REWRITE_TAC[INT_LT_DISCRETE; INT_LE_RADD] THEN + MESON_TAC[INT_ARITH `&0 <= x ==> &1 <= x + &1`; INT_POS; INT_LE_REFL]) in + let base_conv = REWR_CONV pth_base + and step_conv = + BINDER_CONV(RAND_CONV(LAND_CONV(funpow 2 RAND_CONV num_CONV))) THENC + REWR_CONV pth_step THENC + RAND_CONV(ONCE_DEPTH_CONV NUM_SUC_CONV) in + let rec conv tm = + try base_conv tm with Failure _ -> + (step_conv THENC LAND_CONV conv) tm in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Canonicalize "t + c" in all "interp (t + c) P"s assuming t is canonical. *) +(* ------------------------------------------------------------------------- *) + +let CANON_INTERP_ADD = + let pat = `interp (t + c) P` in + fun vars -> + let net = net_of_conv pat (LAND_CONV(POLYNOMIAL_ADD_CONV vars)) + empty_net in + ONCE_DEPTH_CONV(REWRITES_CONV net);; + +(* ------------------------------------------------------------------------- *) +(* Conversion to evaluate constant expressions. *) +(* ------------------------------------------------------------------------- *) + +let EVAL_CONSTANT_CONV = + let net = + itlist (uncurry net_of_conv) + ([`x < y`,INT_LT_CONV; + `x > y`,INT_GT_CONV; + `x:int = y`,INT_EQ_CONV; + `x divides y`,INT_DIVIDES_CONV] @ + map (fun t -> t,REWR_CONV(REWRITE_CONV[] t)) + [`~F`; `~T`; `a /\ T`; `T /\ a`; `a /\ F`; `F /\ a`; + `a \/ T`; `T \/ a`; `a \/ F`; `F \/ a`]) + empty_net in + DEPTH_CONV(REWRITES_CONV net);; + +(* ------------------------------------------------------------------------- *) +(* Basic quantifier elimination conversion. *) +(* ------------------------------------------------------------------------- *) + +let BASIC_COOPER_CONV = + let p_tm = `p:cform` + and d_tm = `d:int` in + let pth_B = SPECL [p_tm; d_tm] MAINTHM_B in + fun vars tm -> + let x,bod = dest_exists tm in + let th1 = (NORMALIZE_COEFF_CONV vars THENC SHADOW_CONV) tm in + let p = rand(snd(dest_exists(rand(concl th1)))) in + let th2 = INST [p,p_tm; mk_int_const(dplcm p),d_tm] pth_B in + let tm2a,tm2b = dest_conj(lhand(concl th2)) in + let th3 = + CONJ (EQT_ELIM(ALLDIVIDE_CONV tm2a)) (EQT_ELIM(INT_LT_CONV tm2b)) in + let th4 = TRANS th1 (MP th2 th3) in + let th5 = CONV_RULE(RAND_CONV(BINDER_CONV(funpow 2 RAND_CONV(LAND_CONV + MINUSINF_CONV)))) th4 in + let th6 = CONV_RULE(RAND_CONV(BINDER_CONV(funpow 3 RAND_CONV + (EXISTS_IN_BSET_CONV vars)))) th5 in + let th7 = CONV_RULE(RAND_CONV EXPAND_INT_CASES_CONV) th6 in + let th8 = CONV_RULE(RAND_CONV(CANON_INTERP_ADD vars)) th7 in + let th9 = CONV_RULE(RAND_CONV(ONCE_DEPTH_CONV(INTERP_CONV vars))) th8 in + CONV_RULE(RAND_CONV EVAL_CONSTANT_CONV) th9;; + +(* ------------------------------------------------------------------------- *) +(* NNF transformation that also eliminates negated inequalities. *) +(* ------------------------------------------------------------------------- *) + +let NNF_POSINEQ_CONV = + let pth = prove + (`(~(&0 < x) <=> &0 < &1 - x) /\ + (~(&0 > x) <=> &0 < &1 + x)`, + REWRITE_TAC[INT_NOT_LT; INT_GT] THEN + REWRITE_TAC[INT_LT_DISCRETE; INT_GT_DISCRETE] THEN + INT_ARITH_TAC) in + let conv1 vars = REWR_CONV(CONJUNCT1 pth) THENC + RAND_CONV (POLYNOMIAL_SUB_CONV vars) + and conv2 vars = REWR_CONV(CONJUNCT2 pth) THENC + RAND_CONV (POLYNOMIAL_ADD_CONV vars) + and pat1 = `~(&0 < x)` and pat2 = `~(&0 > x)` + and net = itlist (fun t -> net_of_conv (lhand t) (REWR_CONV(TAUT t))) + [`~(~ p) <=> p`; `~(p /\ q) <=> ~p \/ ~q`; + `~(p \/ q) <=> ~p /\ ~q`] empty_net in + fun vars -> + let net' = net_of_conv pat1 (conv1 vars) + (net_of_conv pat2 (conv2 vars) net) in + TOP_SWEEP_CONV(REWRITES_CONV net');; + +(* ------------------------------------------------------------------------- *) +(* Overall function. *) +(* ------------------------------------------------------------------------- *) + +let COOPER_CONV = + let FORALL_ELIM_CONV = GEN_REWRITE_CONV I + [prove(`(!x. P x) <=> ~(?x. ~(P x))`,MESON_TAC[])] + and not_tm = `(~)` in + let rec conv vars tm = + if is_conj tm or is_disj tm then + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + MK_COMB(AP_TERM op (conv vars l),conv vars r) + else if is_neg tm then + let l,r = dest_comb tm in + AP_TERM l (conv vars r) + else if is_exists tm then + let x,bod = dest_exists tm in + let th1 = MK_EXISTS x (conv (x::vars) bod) in + TRANS th1 (BASIC_COOPER_CONV vars (rand(concl th1))) + else if is_forall tm then + let x,bod = dest_forall tm in + let th1 = AP_TERM not_tm (conv (x::vars) bod) in + let th2 = CONV_RULE(RAND_CONV (NNF_POSINEQ_CONV (x::vars))) th1 in + let th3 = MK_EXISTS x th2 in + let th4 = CONV_RULE(RAND_CONV (BASIC_COOPER_CONV vars)) th3 in + let th5 = CONV_RULE(RAND_CONV (NNF_POSINEQ_CONV (x::vars))) + (AP_TERM not_tm th4) in + TRANS (FORALL_ELIM_CONV tm) th5 + else REFL tm in + let init_CONV = + PRESIMP_CONV THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV + [INT_ABS; + INT_ARITH `max m n = if m <= n then n else m`; + INT_ARITH `min m n = if m <= n then m else n`] THENC + CONDS_ELIM_CONV THENC NNF_CONV in + fun tm -> + let vars = frees tm in + let th1 = (init_CONV THENC LINEARIZE_CONV vars) tm in + let th2 = TRANS th1 (conv vars (rand(concl th1))) in + TRANS th2 (EVAL_CONSTANT_CONV(rand(concl th2)));; + +(* ------------------------------------------------------------------------- *) +(* Examples from the book. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV `!x y. x < y ==> &2 * x + &1 < &2 * y`;; + +time COOPER_CONV `!x y. ~(&2 * x + &1 = &2 * y)`;; + +time COOPER_CONV + `?x y. x > &0 /\ y >= &0 /\ (&3 * x - &5 * y = &1)`;; + +time COOPER_CONV `?x y z. &4 * x - &6 * y = &1`;; + +time COOPER_CONV `!x. b < x ==> a <= x`;; + +time COOPER_CONV `!x. a < &3 * x ==> b < &3 * x`;; + +time COOPER_CONV `!x y. x <= y ==> &2 * x + &1 < &2 * y`;; + +time COOPER_CONV `(?d. y = &65 * d) ==> (?d. y = &5 * d)`;; + +time COOPER_CONV `!y. (?d. y = &65 * d) ==> (?d. y = &5 * d)`;; + +time COOPER_CONV `!x y. ~(&2 * x + &1 = &2 * y)`;; + +time COOPER_CONV `!x y z. (&2 * x + &1 = &2 * y) ==> x + y + z > &129`;; + +time COOPER_CONV `!x. a < x ==> b < x`;; + +time COOPER_CONV `!x. a <= x ==> b < x`;; + +(* ------------------------------------------------------------------------- *) +(* Formula examples from Cooper's paper. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV `!a b. ?x. a < &20 * x /\ &20 * x < b`;; + +time COOPER_CONV `?x. a < &20 * x /\ &20 * x < b`;; + +time COOPER_CONV `!b. ?x. a < &20 * x /\ &20 * x < b`;; + +time COOPER_CONV `!a. ?b. a < &4 * b + &3 * a \/ (~(a < b) /\ a > b + &1)`;; + +time COOPER_CONV `?y. !x. x + &5 * y > &1 /\ &13 * x - y > &1 /\ x + &2 < &0`;; + +(* ------------------------------------------------------------------------- *) +(* More of my own. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV `!x y. x >= &0 /\ y >= &0 + ==> &12 * x - &8 * y < &0 \/ &12 * x - &8 * y > &2`;; + +time COOPER_CONV `?x y. &5 * x + &3 * y = &1`;; + +time COOPER_CONV `?x y. &5 * x + &10 * y = &1`;; + +time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&5 * x - &6 * y = &1)`;; + +time COOPER_CONV `?w x y z. &2 * w + &3 * x + &4 * y + &5 * z = &1`;; + +time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&5 * x - &3 * y = &1)`;; + +time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&3 * x - &5 * y = &1)`;; + +time COOPER_CONV `?x y. x >= &0 /\ y >= &0 /\ (&6 * x - &3 * y = &1)`;; + +time COOPER_CONV `!x y. ~(x = &0) ==> &5 * y < &6 * x \/ &5 * y > &6 * x`;; + +time COOPER_CONV + `!x y. ~(&5 divides x) /\ ~(&6 divides y) ==> ~(&6 * x = &5 * y)`;; + +time COOPER_CONV `!x y. ~(&5 divides x) ==> ~(&6 * x = &5 * y)`;; + +time COOPER_CONV `!x y. ~(&6 * x = &5 * y)`;; + +time COOPER_CONV `!x y. (&6 * x = &5 * y) ==> (?d. y = &3 * d)`;; + +time COOPER_CONV `(&6 * x = &5 * y) ==> (?d. y = &3 * d)`;; + +(* ------------------------------------------------------------------------- *) +(* Positive variant of the Bezout theorem (see the exercise). *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV + `!z. z > &7 ==> ?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = z)`;; + +time COOPER_CONV + `!z. z > &2 ==> ?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = z)`;; + +time COOPER_CONV `!z. z <= &7 ==> + ((?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = z)) <=> + ~(?x y. x >= &0 /\ y >= &0 /\ (&3 * x + &5 * y = &7 - z)))`;; + +(* ------------------------------------------------------------------------- *) +(* Basic result about congruences. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV `!x. ~(&2 divides x) /\ &3 divides (x - &1) <=> + &12 divides (x - &1) \/ &12 divides (x - &7)`;; + +time COOPER_CONV `!x. ~(?m. x = &2 * m) /\ (?m. x = &3 * m + &1) <=> + (?m. x = &12 * m + &1) \/ (?m. x = &12 * m + &7)`;; + +(* ------------------------------------------------------------------------- *) +(* Something else. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV + `!x. ~(&2 divides x) + ==> &4 divides (x - &1) \/ + &8 divides (x - &1) \/ + &8 divides (x - &3) \/ + &6 divides (x - &1) \/ + &14 divides (x - &1) \/ + &14 divides (x - &9) \/ + &14 divides (x - &11) \/ + &24 divides (x - &5) \/ + &24 divides (x - &11)`;; + +(* ------------------------------------------------------------------------- *) +(* Testing fix for an earlier version with negative result from formlcm. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV + `!a b v_1 v_2 v_3. + (a + &2 = b) /\ (v_3 = b - a + &1) /\ (v_2 = b - &2) /\ (v_1 = &3) ==> F`;; + +(* ------------------------------------------------------------------------- *) +(* Inspired by the Collatz conjecture. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV + `?a b. ~(a = &1) /\ ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ + (a = b)`;; + +time COOPER_CONV + `?a b. a > &1 /\ b > &1 /\ + ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ + (a = b)`;; + +time COOPER_CONV + `?b. a > &1 /\ b > &1 /\ + ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ + ((&2 * a = b) \/ (&2 * a = &3 * b + &1))`;; + +(*************** These seem to take a long time + +time COOPER_CONV + `?a b. a > &1 /\ b > &1 /\ + ((&2 * b = a) \/ (&2 * b = &3 * a + &1)) /\ + ((&2 * a = b) \/ (&2 * a = &3 * b + &1))`;; + +let fm = (dnf ** parse) + `((2 * b = a) \/ (2 * b = &3 * a + 1)) /\ + ((2 * c = b) \/ (2 * c = &3 * b + 1)) /\ + ((2 * d = c) \/ (2 * d = &3 * c + 1)) /\ + ((2 * e = d) \/ (2 * e = &3 * d + 1)) /\ + ((2 * f = e) \/ (2 * f = &3 * e + 1)) /\ + (f = a)`;; + +let fms = + map (itlist (fun x p -> Exists(x,And(Atom(R(`>`,[Var x; Fn(`1`,[])])),p))) + [`b`; `c`; `d`; `e`; `f`]) + (disjuncts fm);; + +let fm = el &15 fms;; +integer_qelim fm;; + +******************) + +(* ------------------------------------------------------------------------- *) +(* More old examples. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV + `?x. &5 * x + x + x < x \/ + (y = &7 - x) /\ &33 + z < x /\ x + &1 <= &2 * y \/ + &3 divides &4 * x + z /\ (x + y + z = &7 * z)`;; + +time COOPER_CONV + `?x. &5 * x + x + x < x \/ + (y = &7 - x) /\ + &33 + z < x /\ + x + &1 <= &2 * y \/ + &3 divides (&4 * x + z) /\ + (x + y + z = &7 * z)`;; + +time COOPER_CONV + `?x. &5 * x + x + x < x \/ + (y = &7 - x) /\ + &33 + z < x /\ + x + &1 <= &2 * y \/ + &3 divides (&4 * x + z) /\ + (x + y + z = &7 * z)`;; + +(**** This also seems very slow; one quantifier less maybe? + +time COOPER_CONV + `?z y x. &5 * x + x + x < x \/ + (y = &7 - x) /\ + &33 + z < x /\ + x + &1 <= &2 * y \/ + &3 divides (&4 * x + z) /\ + (x + y + z = &7 * z)`;; + +time COOPER_CONV + `?y x. &5 * x + x + x < x \/ + (y = &7 - x) /\ + &33 + z < x /\ + x + &1 <= &2 * y \/ + &3 divides (&4 * x + z) /\ + (x + y + z = &7 * z)`;; + +*****) + +time COOPER_CONV + `?x. x + &1 < &2 * y /\ + &3 divides (&4 * x + z) /\ + (&6 * x + y + z = &7 * z)`;; + +time COOPER_CONV + `?x. &5 * x + x + x < x \/ + (y = &7 - x) /\ + &33 + z < x /\ + x + &1 < &2 * y \/ + &3 divides (&4 * x + z) /\ + (x + y + z = &7 * z)`;; + +(* ------------------------------------------------------------------------- *) +(* Stamp problem. *) +(* ------------------------------------------------------------------------- *) + +time COOPER_CONV `!x. x >= &8 ==> ?u v. u >= &0 /\ v >= &0 /\ + (x = &3 * u + &5 * v)`;; + +time COOPER_CONV `!x. x >= &10 ==> ?u v. u >= &0 /\ v >= &0 /\ + (x = &3 * u + &7 * v)`;; + +time COOPER_CONV `!x. x >= &30 ==> ?u v. u >= &0 /\ v >= &0 /\ + (x = &3 * u + &7 * v)`;; + +(* ------------------------------------------------------------------------- *) +(* Decision procedures in the style of INT_ARITH and ARITH_RULE. *) +(* *) +(* Really I should locate the free alien subterms. *) +(* ------------------------------------------------------------------------- *) + +let INT_COOPER tm = + let fvs = frees tm in + let tm' = list_mk_forall(fvs,tm) in + SPECL fvs (EQT_ELIM(COOPER_CONV tm'));; + +let COOPER_RULE tm = + let fvs = frees tm in + let tm' = list_mk_forall(fvs,tm) in + let th = (NUM_TO_INT_CONV THENC COOPER_CONV) tm' in + SPECL fvs (EQT_ELIM th);; + +(* ------------------------------------------------------------------------- *) +(* Examples. *) +(* ------------------------------------------------------------------------- *) + +time INT_COOPER `abs(x) < &1 ==> (x = &0)`;; + +time COOPER_RULE `ODD n ==> 2 * n DIV 2 < n`;; + +time COOPER_RULE `!n. EVEN(n) ==> (2 * n DIV 2 = n)`;; + +time COOPER_RULE `!n. ODD n <=> 2 * n DIV 2 < n`;; + +(**** This seems quite slow (maybe not very) as well +time COOPER_RULE `n DIV 3 <= n DIV 2`;; + ****) + +(*** This one too? +time COOPER_RULE `!x. ?y. if EVEN x then x = 2 * y else x = 2 * (y - 1) + 1`;; + ***) + +time COOPER_RULE `!n. n >= 8 ==> ?a b. n = 3 * a + 5 * b`;; diff --git a/Examples/dickson.ml b/Examples/dickson.ml new file mode 100644 index 0000000..5476190 --- /dev/null +++ b/Examples/dickson.ml @@ -0,0 +1,85 @@ +(* ========================================================================= *) +(* Dickson's lemma. *) +(* ========================================================================= *) + +let MINIMIZING_CHOICE = prove + (`!(m:A->num) s. (?x. P x) ==> ?a. P a /\ !b. P b ==> m(a) <= m(b)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM NOT_LT] THEN + MP_TAC(ISPEC `\n. ?x. P x /\ (m:A->num) x = n` num_WOP) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The Nash-Williams minimal bad sequence argument for some predicate `bad` *) +(* that is a "safety property" in the Lamport/Alpern/Schneider sense. *) +(* ------------------------------------------------------------------------- *) + +let MINIMAL_BAD_SEQUENCE = prove + (`!(bad:(num->A)->bool) (m:A->num). + (!x. ~bad x ==> ?n. !y. (!k. k < n ==> y k = x k) ==> ~bad y) /\ + (?x. bad x) + ==> ?y. bad y /\ + !z n. bad z /\ (!k. k < n ==> z k = y k) ==> m(y n) <= m(z n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN + `?x. !n. (x:num->A) n = + @a. (?y. bad y /\ (!k. k < n ==> y k = x k) /\ y n = a) /\ + !z. bad z /\ (!k. k < n ==> z k = x k) + ==> (m:A->num)(a) <= m(z n)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!n. (?y:num->A. bad y /\ (!k. k < n ==> y k = x k) /\ y n = x n) /\ + !z. bad z /\ (!k. k < n ==> z k = x k) ==> m(x n):num <= m(z n)` + ASSUME_TAC THENL [ALL_TAC; EXISTS_TAC `x:num->A` THEN ASM_MESON_TAC[]] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(fun th -> DISCH_TAC THEN SUBST1_TAC(SPEC `n:num` th)) THEN + CONV_TAC SELECT_CONV THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[TAUT `(p /\ q /\ r) /\ s <=> r /\ p /\ q /\ s`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM1] THEN + REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC MINIMIZING_CHOICE THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN SIMP_TAC[LT] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Dickson's Lemma itself. *) +(* ------------------------------------------------------------------------- *) + +let DICKSON = prove + (`!n x:num->num->num. ?i j. i < j /\ (!k. k < n ==> x i k <= x j k)`, + ABBREV_TAC + `bad = \n x:num->num->num. !i j. i < j ==> ?k. k < n /\ x j k < x i k` THEN + SUBGOAL_THEN `!n:num x:num->num->num. ~(bad n x)` MP_TAC THENL + [ALL_TAC; EXPAND_TAC "bad" THEN MESON_TAC[NOT_LT]] THEN + INDUCT_TAC THENL [EXPAND_TAC "bad" THEN MESON_TAC[LT]; ALL_TAC] THEN + REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x. bad (SUC n) (x:num->num->num) /\ + !y j. bad (SUC n) y /\ (!i. i < j ==> y i = x i) + ==> x j n <= y j n` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MINIMAL_BAD_SEQUENCE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:num->num->num` THEN EXPAND_TAC "bad" THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + EXISTS_TAC `SUC j` THEN X_GEN_TAC `y:num->num->num` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LT_SUC_LE] THEN + REWRITE_TAC[LE_LT] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN ASM_MESON_TAC[]; + SUBGOAL_THEN `~(bad (n:num) (x:num->num->num))` MP_TAC THENL + [ASM_MESON_TAC[]; EXPAND_TAC "bad" THEN REWRITE_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN + MP_TAC(ASSUME `bad (SUC n) (x:num->num->num):bool`) THEN + EXPAND_TAC "bad" THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[LT] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[LT_REFL] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `\k. if k < i then (x:num->num->num) k else x (j + k - i)`) THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[LT_REFL; SUB_REFL; ADD_CLAUSES; NOT_IMP; NOT_LE] THEN + SIMP_TAC[] THEN UNDISCH_TAC `bad (SUC n) (x:num->num->num):bool` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN EXPAND_TAC "bad" THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_MESON_TAC[LT_TRANS; ARITH_RULE + `(a:num < i /\ ~(b < i) /\ i < j ==> a < j + b - i) /\ + (~(a < i) /\ a < b /\ i < j ==> j + a - i < j + b - i)`]]);; diff --git a/Examples/dlo.ml b/Examples/dlo.ml new file mode 100644 index 0000000..3399d5b --- /dev/null +++ b/Examples/dlo.ml @@ -0,0 +1,455 @@ +(* ========================================================================= *) +(* Dense linear order decision procedure for reals, by Sean McLaughlin. *) +(* ========================================================================= *) + +prioritize_real();; + +(* ---------------------------------------------------------------------- *) +(* Util *) +(* ---------------------------------------------------------------------- *) + +let list_conj = + let t_tm = `T` in + fun l -> if l = [] then t_tm else end_itlist (curry mk_conj) l;; + +let mk_lt = mk_binop `(<)`;; + +(* ---------------------------------------------------------------------- *) +(* cnnf *) +(* ---------------------------------------------------------------------- *) + +let DOUBLE_NEG_CONV = + let dn_thm = TAUT `!x. ~(~ x) <=> x` in + let dn_conv = + fun tm -> + let tm' = dest_neg (dest_neg tm) in + ISPEC tm' dn_thm in + dn_conv;; + +let IMP_CONV = + let i_thm = TAUT `!a b. (a ==> b) <=> (~a \/ b)` in + let i_conv = + fun tm -> + let (a,b) = dest_imp tm in + ISPECL [a;b] i_thm in + i_conv;; + +let BEQ_CONV = + let beq_thm = TAUT `!a b. (a = b) <=> (a /\ b \/ ~a /\ ~b)` in + let beq_conv = + fun tm -> + let (a,b) = dest_eq tm in + ISPECL [a;b] beq_thm in + beq_conv;; + +let NEG_AND_CONV = + let na_thm = TAUT `!a b. ~(a /\ b) <=> (~a \/ ~b)` in + let na_conv = + fun tm -> + let (a,b) = dest_conj (dest_neg tm) in + ISPECL [a;b] na_thm in + na_conv;; + +let NEG_OR_CONV = + let no_thm = TAUT `!a b. ~(a \/ b) <=> (~a /\ ~b)` in + let no_conv = + fun tm -> + let (a,b) = dest_disj (dest_neg tm) in + ISPECL [a;b] no_thm in + no_conv;; + +let NEG_IMP_CONV = + let ni_thm = TAUT `!a b. ~(a ==> b) <=> (a /\ ~b)` in + let ni_conv = + fun tm -> + let (a,b) = dest_imp (dest_neg tm) in + ISPECL [a;b] ni_thm in + ni_conv;; + +let NEG_BEQ_CONV = + let nbeq_thm = TAUT `!a b. ~(a = b) <=> (a /\ ~b \/ ~a /\ b)` in + let nbeq_conv = + fun tm -> + let (a,b) = dest_eq (dest_neg tm) in + ISPECL [a;b] nbeq_thm in + nbeq_conv;; + + +(* tm = (p /\ q0) \/ (~p /\ q1) *) +let dest_cases tm = + try + let (l,r) = dest_disj tm in + let (p,q0) = dest_conj l in + let (np,q1) = dest_conj r in + if mk_neg p = np then (p,q0,q1) else failwith "not a cases term" + with Failure _ -> failwith "not a cases term";; + +let is_cases = can dest_cases;; + +let CASES_CONV = + let c_thm = + TAUT `!p q0 q1. ~(p /\ q0 \/ ~p /\ q1) <=> (p /\ ~q0 \/ ~p /\ ~q1)` in + let cc = + fun tm -> + let (p,q0,q1) = dest_cases tm in + ISPECL [p;q0;q1] c_thm in + cc;; + +let QE_SIMPLIFY_CONV = + let NOT_EXISTS_UNIQUE_THM = prove + (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`, + REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in + let tauts = + [TAUT `~(~p) <=> p`; + TAUT `~(p /\ q) <=> ~p \/ ~q`; + TAUT `~(p \/ q) <=> ~p /\ ~q`; + TAUT `~(p ==> q) <=> p /\ ~q`; + TAUT `p ==> q <=> ~p \/ q`; + NOT_FORALL_THM; + NOT_EXISTS_THM; + EXISTS_UNIQUE_THM; + NOT_EXISTS_UNIQUE_THM; + TAUT `~(p = q) <=> (p /\ ~q) \/ (~p /\ q)`; + TAUT `(p = q) <=> (p /\ q) \/ (~p /\ ~q)`; + TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in + GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; + +let CNNF_CONV = + let refl_conj = REFL `(/\)` + and refl_disj = REFL `(\/)` in + fun lfn_conv -> + let rec cnnf_conv tm = + if is_conj tm then + let (p,q) = dest_conj tm in + let thm1 = cnnf_conv p in + let thm2 = cnnf_conv q in + MK_COMB (MK_COMB (refl_conj,thm1),thm2) + else if is_disj tm then + let (p,q) = dest_disj tm in + let thm1 = cnnf_conv p in + let thm2 = cnnf_conv q in + MK_COMB (MK_COMB (refl_disj,thm1),thm2) + else if is_imp tm then + let (p,q) = dest_imp tm in + let thm1 = cnnf_conv (mk_neg p) in + let thm2 = cnnf_conv q in + TRANS (IMP_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) + else if is_iff tm then + let (p,q) = dest_eq tm in + let pthm = cnnf_conv p in + let qthm = cnnf_conv q in + let npthm = cnnf_conv (mk_neg p) in + let nqthm = cnnf_conv (mk_neg q) in + let thm1 = MK_COMB(MK_COMB(refl_conj,pthm),qthm) in + let thm2 = MK_COMB(MK_COMB(refl_conj,npthm),nqthm) in + TRANS (BEQ_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) + else if is_neg tm then + let tm' = dest_neg tm in + if is_neg tm' then + let tm'' = dest_neg tm' in + let thm = cnnf_conv tm in + TRANS (DOUBLE_NEG_CONV tm'') thm + else if is_conj tm' then + let (p,q) = dest_conj tm' in + let thm1 = cnnf_conv (mk_neg p) in + let thm2 = cnnf_conv (mk_neg q) in + TRANS (NEG_AND_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) + else if is_cases tm' then + let (p,q0,q1) = dest_cases tm in + let thm1 = cnnf_conv (mk_conj(p,mk_neg q0)) in + let thm2 = cnnf_conv (mk_conj(mk_neg p,mk_neg q1)) in + TRANS (CASES_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) + else if is_disj tm' then + let (p,q) = dest_disj tm' in + let thm1 = cnnf_conv (mk_neg p) in + let thm2 = cnnf_conv (mk_neg q) in + TRANS (NEG_OR_CONV tm) (MK_COMB(MK_COMB(refl_conj,thm1),thm2)) + else if is_imp tm' then + let (p,q) = dest_imp tm' in + let thm1 = cnnf_conv p in + let thm2 = cnnf_conv (mk_neg q) in + TRANS (NEG_IMP_CONV tm) (MK_COMB(MK_COMB(refl_conj,thm1),thm2)) + else if is_iff tm' then + let (p,q) = dest_eq tm' in + let pthm = cnnf_conv p in + let qthm = cnnf_conv q in + let npthm = cnnf_conv (mk_neg p) in + let nqthm = cnnf_conv (mk_neg q) in + let thm1 = MK_COMB (MK_COMB(refl_conj,pthm),nqthm) in + let thm2 = MK_COMB(MK_COMB(refl_conj,npthm),qthm) in + TRANS (NEG_BEQ_CONV tm) (MK_COMB(MK_COMB(refl_disj,thm1),thm2)) + else lfn_conv tm + else lfn_conv tm in + QE_SIMPLIFY_CONV THENC cnnf_conv THENC QE_SIMPLIFY_CONV;; + + +(* + +let tests = [ +`~(a /\ b)`; +`~(a \/ b)`; +`~(a ==> b)`; +`~(a:bool <=> b)`; +`~ ~ a`; +];; + +map (CNNF_CONV (fun x -> REFL x)) tests;; +*) + + +(* ---------------------------------------------------------------------- *) +(* Real Lists *) +(* ---------------------------------------------------------------------- *) + +let MINL = new_recursive_definition list_RECURSION + `(MINL [] default = default) /\ + (MINL (CONS h t) default = min h (MINL t default))`;; + +let MAXL = new_recursive_definition list_RECURSION + `(MAXL [] default = default) /\ + (MAXL (CONS h t) default = max h (MAXL t default))`;; + +let MAX_LT = prove + (`!x y z. max x y < z <=> x < z /\ y < z`, + REWRITE_TAC[real_max] THEN MESON_TAC[REAL_LET_TRANS; REAL_LE_TOTAL]);; + +let MIN_GT = prove + (`!x y z. x < real_min y z <=> x < y /\ x < z`, + REWRITE_TAC[real_min] THEN MESON_TAC[REAL_LTE_TRANS; REAL_LE_TOTAL]);; + +let ALL_LT_LEMMA = prove + (`!left x lefts. ALL (\l. l < x) (CONS left lefts) <=> MAXL lefts left < x`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAXL; ALL] THEN + SPEC_TAC(`t:real list`,`t:real list`) THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ALL; MAXL; MAX_LT] THEN ASM_MESON_TAC[MAX_LT]);; + +let ALL_GT_LEMMA = prove + (`!right x rights. + ALL (\r. x < r) (CONS right rights) <=> x < MINL rights right`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MINL; ALL] THEN + SPEC_TAC(`t:real list`,`t:real list`) THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ALL; MINL; MIN_GT] THEN ASM_MESON_TAC[MIN_GT]);; + +(* ---------------------------------------------------------------------- *) +(* Axioms *) +(* ---------------------------------------------------------------------- *) + +let REAL_DENSE = prove + (`!x y. x < y ==> ?z. x < z /\ z < y`, + REPEAT STRIP_TAC THEN EXISTS_TAC `(x + y) / &2` THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let REAL_LT_EXISTS = prove(`!x. ?y. x < y`, + GEN_TAC THEN + EXISTS_TAC `x + &1` THEN + REAL_ARITH_TAC);; + +let REAL_GT_EXISTS = prove(`!x. ?y. y < x`, + GEN_TAC THEN + EXISTS_TAC `x - &1` THEN + REAL_ARITH_TAC);; + +(* ---------------------------------------------------------------------- *) +(* lfn_dlo *) +(* ---------------------------------------------------------------------- *) + +let LFN_DLO_CONV = + PURE_REWRITE_CONV[ + REAL_ARITH `~(s < t) <=> ((s = t) \/ (t < s))`; + REAL_ARITH `~(s = t) <=> (s < t \/ t < s)`; + ];; + +(* ------------------------------------------------------------------------- *) +(* Proforma theorems to support the main inference step. *) +(* ------------------------------------------------------------------------- *) + +let PROFORMA_LEFT = prove + (`!l ls. (?x. ALL (\l. l < x) (CONS l ls)) <=> T`, + REWRITE_TAC[ALL_LT_LEMMA] THEN MESON_TAC[REAL_LT_EXISTS]);; + +let PROFORMA_RIGHT = prove + (`!r rs. (?x. ALL (\r. x < r) (CONS r rs)) <=> T`, + REWRITE_TAC[ALL_GT_LEMMA] THEN MESON_TAC[REAL_GT_EXISTS]);; + +let PROFORMA_BOTH = prove + (`!l ls r rs. + (?x. ALL (\l. l < x) (CONS l ls) /\ ALL (\r. x < r) (CONS r rs)) <=> + ALL (\l. ALL (\r. l < r) (CONS r rs)) (CONS l ls)`, + REWRITE_TAC[ALL_LT_LEMMA; ALL_GT_LEMMA] THEN + MESON_TAC[REAL_DENSE; REAL_LT_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Deal with ?x. *) +(* ------------------------------------------------------------------------- *) + +let mk_rlist = let ty = `:real` in fun x -> mk_list(x,ty);; + +let expand_all = PURE_REWRITE_RULE + [ALL; BETA_THM; GSYM CONJ_ASSOC; TAUT `a /\ T <=> a`];; + +let DLO_EQ_CONV fm = + let x,p = dest_exists fm in + let xl,xr = partition (fun t -> rand t = x) (conjuncts p) in + let lefts = map lhand xl and rights = map rand xr in + let th1 = + if lefts = [] then SPECL [hd rights; mk_rlist(tl rights)] PROFORMA_RIGHT + else if rights = [] then SPECL [hd lefts; mk_rlist(tl lefts)] PROFORMA_LEFT + else SPECL [hd lefts; mk_rlist(tl lefts); hd rights; mk_rlist(tl rights)] + PROFORMA_BOTH in + let th2 = CONV_RULE (LAND_CONV(GEN_ALPHA_CONV x)) (expand_all th1) in + let p' = snd(dest_exists(lhand(concl th2))) in + let th3 = MK_EXISTS x (CONJ_ACI_RULE(mk_eq(p,p'))) in + TRANS th3 th2;; + +(* ------------------------------------------------------------------------- *) +(* Deal with general ?x. *) +(* ------------------------------------------------------------------------- *) + +let eq_triv_conv = + let pth_triv = prove + (`((?x. x = x) <=> T) /\ + ((?x. x = t) <=> T) /\ + ((?x. t = x) <=> T) /\ + ((?x. (x = t) /\ P x) <=> P t) /\ + ((?x. (t = x) /\ P x) <=> P t)`, + MESON_TAC[]) in + GEN_REWRITE_CONV I [pth_triv] + +and eq_refl_conv = + let pth_refl = prove + (`(?x. (x = x) /\ P x) <=> (?x. P x)`, + MESON_TAC[]) in + GEN_REWRITE_CONV I [pth_refl] + +and lt_refl_conv = + GEN_REWRITE_CONV DEPTH_CONV + [REAL_LT_REFL; AND_CLAUSES; EXISTS_SIMP];; + +let rec DLOBASIC_CONV fm = + try let x,p = dest_exists fm in + let cjs = conjuncts p in + try let eq = find (fun e -> is_eq e & (lhs e = x or rhs e = x)) cjs in + let cjs' = eq::setify(subtract cjs [eq]) in + let p' = list_mk_conj cjs' in + let th1 = MK_EXISTS x (CONJ_ACI_RULE(mk_eq(p,p'))) in + let fm' = rand(concl th1) in + try TRANS th1 (eq_triv_conv fm') with Failure _ -> + TRANS th1 ((eq_refl_conv THENC DLOBASIC_CONV) fm') + with Failure _ -> + if mem (mk_lt x x) cjs then lt_refl_conv fm + else DLO_EQ_CONV fm + with Failure _ -> (print_qterm fm; failwith "dlobasic");; + +(* ------------------------------------------------------------------------- *) +(* Overall quantifier elimination. *) +(* ------------------------------------------------------------------------- *) + +let AFN_DLO_CONV vars = + PURE_REWRITE_CONV[ + REAL_ARITH `s <= t <=> ~(t < s)`; + REAL_ARITH `s >= t <=> ~(s < t)`; + REAL_ARITH `s > t <=> t < s` + ];; + +let dest_binop_op tm = + try + let f,r = dest_comb tm in + let op,l = dest_comb f in + (l,r,op) + with Failure _ -> failwith "dest_binop_op";; + +let forall_thm = prove(`!P. (!x. P x) <=> ~ (?x. ~ P x)`,MESON_TAC[]) +and or_exists_conv = PURE_REWRITE_CONV[OR_EXISTS_THM] +and triv_exists_conv = REWR_CONV EXISTS_SIMP +and push_exists_conv = REWR_CONV RIGHT_EXISTS_AND_THM +and not_tm = `(~)` +and or_tm = `(\/)` +and t_tm = `T` +and f_tm = `F`;; + +let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = + let rec qelift_conv vars fm = + if fm = t_tm or fm = f_tm then REFL fm + else if is_neg fm then + let thm1 = qelift_conv vars (dest_neg fm) in + MK_COMB(REFL not_tm,thm1) + else if is_conj fm or is_disj fm or is_imp fm or is_iff fm then + let (p,q,op) = dest_binop_op fm in + let thm1 = qelift_conv vars p in + let thm2 = qelift_conv vars q in + MK_COMB(MK_COMB((REFL op),thm1),thm2) + else if is_forall fm then + let (x,p) = dest_forall fm in + let nex_thm = BETA_RULE (ISPEC (mk_abs(x,p)) forall_thm) in + let elim_thm = qelift_conv vars (mk_exists(x,mk_neg p)) in + TRANS nex_thm (MK_COMB (REFL not_tm,elim_thm)) + else if is_exists fm then + let (x,p) = dest_exists fm in + let thm1 = qelift_conv (x::vars) p in + let thm1a = MK_EXISTS x thm1 in + let thm2 = nfn_conv (rhs(concl thm1)) in + let thm2a = MK_EXISTS x thm2 in + let djs = disjuncts (rhs (concl thm2)) in + let djthms = map (qelim x vars) djs in + let thm3 = end_itlist + (fun thm1 thm2 -> MK_COMB(MK_COMB (REFL or_tm,thm1),thm2)) djthms in + let split_ex_thm = GSYM (or_exists_conv (lhs (concl thm3))) in + let thm3a = TRANS split_ex_thm thm3 in + TRANS (TRANS thm1a thm2a) thm3a + else + afn_conv vars fm + and qelim x vars p = + let cjs = conjuncts p in + let ycjs,ncjs = partition (mem x o frees) cjs in + if ycjs = [] then triv_exists_conv(mk_exists(x,p)) + else if ncjs = [] then qfn_conv vars (mk_exists(x,p)) else + let th1 = CONJ_ACI_RULE + (mk_eq(p,mk_conj(list_mk_conj ncjs,list_mk_conj ycjs))) in + let th2 = CONV_RULE (RAND_CONV push_exists_conv) (MK_EXISTS x th1) in + let t1,t2 = dest_comb (rand(concl th2)) in + TRANS th2 (AP_TERM t1 (qfn_conv vars t2)) in + fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; + +let QELIM_DLO_CONV = + (LIFT_QELIM_CONV AFN_DLO_CONV ((CNNF_CONV LFN_DLO_CONV) THENC DNF_CONV) + (fun v -> DLOBASIC_CONV)) THENC (REWRITE_CONV[]);; + +(* ---------------------------------------------------------------------- *) +(* Test *) +(* ---------------------------------------------------------------------- *) + +let tests = [ + `!x y. ?z. z < x /\ z < y`; + `?z. x < x /\ z < y`; + `?z. x < z /\ z < y`; + `!x. x < a ==> x < b`; + `!a b. (!x. (x < a) <=> (x < b)) <=> (a = b)`; (* long time *) + `!x. ?y. x < y`; + `!x y z. x < y /\ y < z ==> x < z`; + `!x y. x < y \/ (x = y) \/ y < x`; + `!x y. x < y \/ (x = y) \/ y < x`; + `?x y. x < y /\ y < x`; + `!x y. ?z. z < x /\ x < y`; + `!x y. ?z. z < x /\ z < y`; + `!x y. x < y ==> ?z. x < z /\ z < y`; + `!x y. ~(x = y) ==> ?u. u < x /\ (y < u \/ x < y)`; + `?x. x = x:real`; + `?x.(x = x) /\ (x = y)`; + `?z. x < z /\ z < y`; + `?z. x <= z /\ z <= y`; + `?z. x < z /\ z <= y`; + `!x y z. ?u. u < x /\ u < y /\ u < z`; + `!y. x < y /\ y < z ==> w < z`; + `!x y . x < y`; + `?z. z < x /\ x < y`; + `!a b. (!x. x < a ==> x < b) <=> (a <= b)`; + `!x. x < a ==> x < b`; + `!x. x < a ==> x <= b`; + `!a b. ?x. ~(x = a) \/ ~(x = b) \/ (a = b:real)`; + `!x y. x <= y \/ x > y`; + `!x y. x <= y \/ x < y` +];; + +map (time QELIM_DLO_CONV) tests;; diff --git a/Examples/forster.ml b/Examples/forster.ml new file mode 100644 index 0000000..4ec3dc3 --- /dev/null +++ b/Examples/forster.ml @@ -0,0 +1,90 @@ +prioritize_num();; + +let FORSTER_PUZZLE = prove + (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, + REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN + SUBGOAL_THEN `!n m. f(m) < n ==> m <= f m` ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[LT] THEN + INDUCT_TAC THEN ASM_MESON_TAC[LE_0; LE_SUC_LT; LET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!n. n <= f n` ASSUME_TAC THENL + [ASM_MESON_TAC[LT]; ALL_TAC] THEN + SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL + [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. m < n ==> f(m) < f(n)` ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LT; LT_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. (f m < f n) <=> m < n` ASSUME_TAC THENL + [ASM_MESON_TAC[LT_CASES; LT_ANTISYM; LT_REFL]; ALL_TAC] THEN + ASM_MESON_TAC[LE_ANTISYM; LT_SUC_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Alternative; shorter but less transparent and taking longer to run. *) +(* ------------------------------------------------------------------------- *) + +let FORSTER_PUZZLE = prove + (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, + REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN + SUBGOAL_THEN `!n m. f(m) < n ==> m <= f m` ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[LT] THEN + INDUCT_TAC THEN ASM_MESON_TAC[LE_0; LE_SUC_LT; LET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!n. n <= f n` ASSUME_TAC THENL + [ASM_MESON_TAC[LT]; ALL_TAC] THEN + SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL + [ASM_MESON_TAC[LET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. m < n ==> f(m) < f(n)` ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[LT; LT_TRANS]; ALL_TAC] THEN + ASM_MESON_TAC[LE_ANTISYM; LT_CASES; LT_ANTISYM; LT_REFL; LT_SUC_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Robin Milner's proof. *) +(* ------------------------------------------------------------------------- *) + +let FORSTER_PUZZLE = prove + (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, + REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN + SUBGOAL_THEN `!m n. m <= f(n + m)` ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[LE_0; ADD_CLAUSES; LE_SUC_LT] THEN + ASM_MESON_TAC[LET_TRANS; SUB_ADD]; ALL_TAC] THEN + SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL + [ASM_MESON_TAC[LET_TRANS; LE_TRANS; ADD_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. m <= n ==> f(m) <= f(n)` ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN + ASM_MESON_TAC[LE; LE_REFL; LT_IMP_LE; LE_TRANS]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM LE_ANTISYM] THEN + ASM_MESON_TAC[LT_SUC_LE; NOT_LT; ADD_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* A variant of Robin's proof avoiding explicit use of addition. *) +(* ------------------------------------------------------------------------- *) + +let FORSTER_PUZZLE = prove + (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, + REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN + SUBGOAL_THEN `!m n. m <= n ==> m <= f(n)` ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[LE_0] THEN + INDUCT_TAC THEN REWRITE_TAC[LE; NOT_SUC] THEN + ASM_MESON_TAC[LE_SUC_LT; LET_TRANS; LE_REFL; LT_IMP_LE; LE_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL + [ASM_MESON_TAC[NOT_LE]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. m <= n ==> f(m) <= f(n)` ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN + ASM_MESON_TAC[LE; LE_REFL; LT_IMP_LE; LE_TRANS]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM LE_ANTISYM] THEN + ASM_MESON_TAC[LT_SUC_LE; NOT_LT; ADD_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* The shortest? *) +(* ------------------------------------------------------------------------- *) + +let FORSTER_PUZZLE = prove + (`(!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n`, + REWRITE_TAC[GT; GSYM ADD1] THEN STRIP_TAC THEN + SUBGOAL_THEN `!m n. m <= f(n + m)` ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[LE_0; ADD_CLAUSES; LE_SUC_LT] THEN + ASM_MESON_TAC[LET_TRANS; SUB_ADD]; ALL_TAC] THEN + SUBGOAL_THEN `!n. f(n) < f(SUC n)` ASSUME_TAC THENL + [ASM_MESON_TAC[LET_TRANS; LE_TRANS; ADD_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. f(m) < f(n) ==> m < n` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_MESON_TAC[LT_LE; LE_0; LTE_TRANS; LE_SUC_LT]; + ALL_TAC] THEN + ASM_MESON_TAC[LE_ANTISYM; ADD_CLAUSES; LT_SUC_LE]);; diff --git a/Examples/gcdrecurrence.ml b/Examples/gcdrecurrence.ml new file mode 100644 index 0000000..1ae0896 --- /dev/null +++ b/Examples/gcdrecurrence.ml @@ -0,0 +1,230 @@ +(* ========================================================================= *) +(* Some divisibility properties of certain linear integer recurrences. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/integer.ml";; + +prioritize_int();; + +(* ------------------------------------------------------------------------- *) +(* A customized induction principle. *) +(* ------------------------------------------------------------------------- *) + +let INDUCT_SPECIAL = prove + (`!P. (!n. P 0 n) /\ + (!m n. P m n <=> P n m) /\ + (!m n. P m n ==> P n (m + n)) + ==> !m n. P m n`, + GEN_TAC THEN STRIP_TAC THEN + REPEAT GEN_TAC THEN WF_INDUCT_TAC `m + n:num` THEN + ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISJ_CASES_THEN MP_TAC (ARITH_RULE `m <= n:num \/ n <= m`) THEN + REWRITE_TAC[LE_EXISTS] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THENL + [ALL_TAC; ASM (GEN_REWRITE_TAC I) []] THEN + MATCH_MP_TAC(ASSUME `!m n:num. P m n ==> P n (m + n)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The main results; to literally apply integer gcd we need nonnegativity. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVISORS_RECURRENCE = prove + (`!G a b. G(0) = &0 /\ G(1) = &1 /\ + coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) + ==> !d m n. d divides (G m) /\ d divides (G n) <=> + d divides G(gcd(m,n))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. coprime(G(n + 1),b)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[ARITH; ARITH_RULE `SUC n + 1 = n + 2`] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NUMBER_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n. coprime(G(n + 1),G n)` ASSUME_TAC THENL + [INDUCT_TAC THENL [ASM_REWRITE_TAC[ARITH] THEN NUMBER_TAC; ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o SPEC `n:num`)) THEN + ASM_REWRITE_TAC[ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!m p. G(m + 1 + p) = G(m + 1) * G(p + 1) + b * G(m) * G(p)` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [ASM_REWRITE_TAC[ADD_CLAUSES; ADD_AC] THEN INTEGER_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC m + 1 + p = (m + p) + 2`] THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC m + 1 = m + 2`] THEN + ASM_REWRITE_TAC[ARITH_RULE `(m + p) + 1 = m + 1 + p`] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[ARITH; ADD_CLAUSES] THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC(m + p) = m + 1 + p`] THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC(m + 1) = m + 2`; ARITH] THEN + REWRITE_TAC[ADD1] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!m p:num. gcd(G(m + p),G m) = gcd(G m,G p)` ASSUME_TAC THENL + [INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; EQT_INTRO(SPEC_ALL INT_GCD_SYM)] THEN + ASM_REWRITE_TAC[ADD1; ARITH_RULE `(m + p) + 1 = m + 1 + p`] THEN + GEN_TAC THEN SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS] THEN + MP_TAC(SPEC `m:num` (ASSUME `!n. coprime(G(n + 1),b)`)) THEN + MP_TAC(SPEC `m:num` (ASSUME `!n. coprime(G(n + 1),G n)`)) THEN + INTEGER_TAC; + ALL_TAC] THEN + GEN_TAC THEN MATCH_MP_TAC INDUCT_SPECIAL THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[GCD_0; INT_DIVIDES_0]; MESON_TAC[GCD_SYM]; ALL_TAC] THEN + ASM_MESON_TAC[GCD_ADD; INT_DIVIDES_GCD; INT_GCD_SYM; ADD_SYM; GCD_SYM]);; + +let INT_GCD_RECURRENCE = prove + (`!G a b. G(0) = &0 /\ G(1) = &1 /\ + coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) /\ + (!n. &0 <= G n) + ==> !m n. gcd(G m,G n) = G(gcd(m,n))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[GSYM INT_DIVIDES_ANTISYM_POS; INT_GCD_POS] THEN + REWRITE_TAC[INT_DIVIDES_ANTISYM_DIVISORS; INT_DIVIDES_GCD] THEN + ASM_MESON_TAC[INT_DIVISORS_RECURRENCE]);; + +(* ------------------------------------------------------------------------- *) +(* Natural number variants of the same results. *) +(* ------------------------------------------------------------------------- *) + +let GCD_RECURRENCE = prove + (`!G a b. G(0) = 0 /\ G(1) = 1 /\ + coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) + ==> !m n. gcd(G m,G n) = G(gcd(m,n))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`& o (G:num->num)`; `&a:int`; `&b:int`] + INT_GCD_RECURRENCE) THEN + ASM_REWRITE_TAC[o_THM; GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + ASM_SIMP_TAC[GSYM num_coprime; INT_POS; GSYM NUM_GCD; INT_OF_NUM_EQ]);; + +let DIVISORS_RECURRENCE = prove + (`!G a b. G(0) = 0 /\ G(1) = 1 /\ + coprime(a,b) /\ (!n. G(n + 2) = a * G(n + 1) + b * G(n)) + ==> !d m n. d divides (G m) /\ d divides (G n) <=> + d divides G(gcd(m,n))`, + REWRITE_TAC[GSYM DIVIDES_GCD] THEN MESON_TAC[DIVISORS_EQ; GCD_RECURRENCE]);; + +(* ------------------------------------------------------------------------- *) +(* Application 1: Mersenne numbers. *) +(* ------------------------------------------------------------------------- *) + +let GCD_MERSENNE = prove + (`!m n. gcd(2 EXP m - 1,2 EXP n - 1) = 2 EXP (gcd(m,n)) - 1`, + SIMP_TAC[GSYM INT_OF_NUM_EQ; NUM_GCD; GSYM INT_OF_NUM_SUB; + GSYM INT_OF_NUM_POW; EXP_LT_0; ARITH; + ARITH_RULE `1 <= n <=> 0 < n`] THEN + MATCH_MP_TAC INT_GCD_RECURRENCE THEN + MAP_EVERY EXISTS_TAC [`&3`; `-- &2`] THEN + REWRITE_TAC[INT_POW_ADD; INT_LE_SUB_LADD] THEN + CONV_TAC INT_REDUCE_CONV THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM(INT_REDUCE_CONV `&2 * &2 - &1`)] THEN + SPEC_TAC(`&2`,`t:int`) THEN INTEGER_TAC; + INT_ARITH_TAC; + GEN_TAC THEN MATCH_MP_TAC INT_POW_LE_1 THEN INT_ARITH_TAC]);; + +let DIVIDES_MERSENNE = prove + (`!m n. (2 EXP m - 1) divides (2 EXP n - 1) <=> m divides n`, + REPEAT GEN_TAC THEN + REWRITE_TAC[DIVIDES_GCD_LEFT; GCD_MERSENNE] THEN + SIMP_TAC[EXP_EQ_0; EQ_EXP; ARITH_EQ; ARITH_RULE + `~(x = 0) /\ ~(y = 0) ==> (x - 1 = y - 1 <=> x = y)`]);; + +(* ------------------------------------------------------------------------- *) +(* Application 2: the Fibonacci series. *) +(* ------------------------------------------------------------------------- *) + +let fib = define + `fib 0 = 0 /\ fib 1 = 1 /\ !n. fib(n + 2) = fib(n + 1) + fib(n)`;; + +let GCD_FIB = prove + (`!m n. gcd(fib m,fib n) = fib(gcd(m,n))`, + MATCH_MP_TAC GCD_RECURRENCE THEN + REPEAT(EXISTS_TAC `1`) THEN REWRITE_TAC[fib; COPRIME_1] THEN ARITH_TAC);; + +let FIB_EQ_0 = prove + (`!n. fib n = 0 <=> n = 0`, + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib] THEN + MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[fib; ARITH_RULE `SUC(SUC n) = n + 2`; ADD_EQ_0] THEN + SIMP_TAC[ADD1; ADD_EQ_0; ARITH_EQ] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[fib; ARITH_EQ]);; + +let FIB_INCREASES_LE = prove + (`!m n. m <= n ==> fib m <= fib n`, + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + REWRITE_TAC[LE_REFL; LE_TRANS] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH] THEN + REWRITE_TAC[ADD1; fib; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + ARITH_TAC);; + +let FIB_INCREASES_LT = prove + (`!m n. 2 <= m /\ m < n ==> fib m < fib n`, + INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN + REPEAT STRIP_TAC THEN TRANS_TAC LTE_TRANS `fib(m + 2)` THEN + ASM_SIMP_TAC[FIB_INCREASES_LE; ARITH_RULE `m + 2 <= n <=> SUC m < n`] THEN + REWRITE_TAC[fib; ADD1; ARITH_RULE `m < m + n <=> ~(n = 0)`; FIB_EQ_0] THEN + ASM_ARITH_TAC);; + +let FIB_EQ_1 = prove + (`!n. fib n = 1 <=> n = 1 \/ n = 2`, + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[fib; ARITH] THEN + REWRITE_TAC[fib; ARITH_RULE `SUC(SUC n) = n + 2`] THEN + REWRITE_TAC[FIB_EQ_0; ADD_EQ_0; ARITH; ARITH_RULE + `m + n = 1 <=> m = 0 /\ n = 1 \/ m = 1 /\ n = 0`] THEN + ARITH_TAC);; + +let DIVIDES_FIB = prove + (`!m n. (fib m) divides (fib n) <=> m divides n \/ n = 0 \/ m = 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[DIVIDES_GCD_LEFT; GCD_FIB] THEN + MP_TAC(SPECL [`gcd(m:num,n)`; `m:num`] DIVIDES_LE) THEN REWRITE_TAC[GCD] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[GCD_0; fib; FIB_EQ_0; ARITH] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[GCD_0] THEN + ASM_CASES_TAC `gcd(m:num,n) = m` THEN ASM_REWRITE_TAC[LE_LT] THEN + ASM_CASES_TAC `gcd(m:num,n) = 0` THENL + [ASM_MESON_TAC[GCD_ZERO]; ALL_TAC] THEN + ASM_CASES_TAC `m:num = n` THEN ASM_REWRITE_TAC[GCD_REFL; LT_REFL] THEN + ASM_CASES_TAC `2 <= gcd(m,n)` THENL + [MP_TAC(SPECL [`gcd(m:num,n)`; `m:num`] FIB_INCREASES_LT) THEN + ASM_ARITH_TAC; + ASM_CASES_TAC `gcd(m,n) = 1` THENL [ASM_REWRITE_TAC[]; ASM_ARITH_TAC] THEN + DISCH_TAC THEN CONV_TAC(LAND_CONV SYM_CONV) THEN + REWRITE_TAC[FIB_EQ_1; fib] THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Application 3: solutions of the Pell equation x^2 = (a^2 - 1) y^2 + 1. *) +(* All solutions are of the form (pellx a n,pelly a n); see Examples/pell.ml *) +(* ------------------------------------------------------------------------- *) + +let pellx = define + `(!a. pellx a 0 = 1) /\ + (!a. pellx a 1 = a) /\ + (!a n. pellx a (n + 2) = 2 * a * pellx a (n + 1) - pellx a n)`;; + +let pelly = define + `(!a. pelly a 0 = 0) /\ + (!a. pelly a 1 = 1) /\ + (!a n. pelly a (n + 2) = 2 * a * pelly a (n + 1) - pelly a (n))`;; + +let PELLY_INCREASES = prove + (`!a n. ~(a = 0) ==> pelly a n <= pelly a (n + 1)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[pelly; ARITH; LE_1; ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + TRANS_TAC LE_TRANS `2 * pelly a (n + 1) - pelly a n` THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `a:num <= b ==> a - c <= b - c`) THEN + REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN ASM_ARITH_TAC);; + +let GCD_PELLY = prove + (`!a m n. ~(a = 0) ==> gcd(pelly a m,pelly a n) = pelly a (gcd(m,n))`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_EQ; NUM_GCD] THEN + MATCH_MP_TAC INT_GCD_RECURRENCE THEN + MAP_EVERY EXISTS_TAC [`&2 * &a:int`; `-- &1:int`] THEN + REWRITE_TAC[pelly; INT_POS; INT_COPRIME_NEG; INT_COPRIME_1] THEN + GEN_TAC THEN REWRITE_TAC[INT_OF_NUM_MUL; MULT_ASSOC] THEN + REWRITE_TAC[INT_ARITH `a + -- &1 * b:int = a - b`] THEN + MATCH_MP_TAC(GSYM INT_OF_NUM_SUB) THEN + TRANS_TAC LE_TRANS `1 * pelly a (n + 1)` THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_SIMP_TAC[MULT_CLAUSES; PELLY_INCREASES] THEN ASM_ARITH_TAC);; diff --git a/Examples/harmonicsum.ml b/Examples/harmonicsum.ml new file mode 100644 index 0000000..06e4e47 --- /dev/null +++ b/Examples/harmonicsum.ml @@ -0,0 +1,123 @@ +(* ========================================================================= *) +(* Nice little result that harmonic sum never gives an integer. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/products.ml";; +needs "Library/floor.ml";; + +(* ------------------------------------------------------------------------- *) +(* In any contiguous range, index (order) of 2 has a strict maximum. *) +(* ------------------------------------------------------------------------- *) + +let NUMSEG_MAXIMAL_INDEX_2 = prove + (`!m n. 1 <= m /\ m <= n + ==> ?k. k IN m..n /\ + !l. l IN m..n /\ ~(l = k) ==> index 2 l < index 2 k`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\x. x IN IMAGE (index 2) (m..n)` num_MAX) THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_NUMSEG] THEN + ASM_REWRITE_TAC[MEMBER_NOT_EMPTY; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [MESON_TAC[INDEX_TRIVIAL_BOUND; LE_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN ASM_SIMP_TAC[LT_LE] THEN X_GEN_TAC `l:num` THEN STRIP_TAC THEN + MP_TAC(SPECL [`l:num`; `2`] INDEX_DECOMPOSITION_PRIME) THEN + MP_TAC(SPECL [`k:num`; `2`] INDEX_DECOMPOSITION_PRIME) THEN + REWRITE_TAC[PRIME_2; LEFT_IMP_EXISTS_THM; COPRIME_2] THEN + ASM_CASES_TAC `k = 0` THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + ASM_CASES_TAC `l = 0` THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + X_GEN_TAC `p:num` THEN STRIP_TAC THEN X_GEN_TAC `q:num` THEN STRIP_TAC THEN + DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(ARITH_RULE `~(l:num = k) ==> l < k \/ k < l`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + MAP_EVERY EXPAND_TAC ["k"; "l"] THEN + REWRITE_TAC[LT_MULT_LCANCEL; EXP_EQ_0; ARITH_EQ] THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `2 EXP index 2 k * (q + 1)`); + FIRST_X_ASSUM(MP_TAC o SPEC `2 EXP index 2 k * (p + 1)`)] THEN + ASM_SIMP_TAC[INDEX_MUL; PRIME_2; EXP_EQ_0; ADD_EQ_0; ARITH; NOT_IMP; + INDEX_EXP; INDEX_REFL] THEN + REWRITE_TAC[ARITH_RULE `n * 1 + k <= n <=> k = 0`; INDEX_EQ_0] THEN + ASM_REWRITE_TAC[ADD_EQ_0; ARITH; DIVIDES_2; EVEN_ADD; NOT_EVEN] THEN + MATCH_MP_TAC(ARITH_RULE + `!p. m <= e * q /\ e * (q + 1) <= e * p /\ e * p <= n + ==> m <= e * (q + 1) /\ e * (q + 1) <= n`) + THENL [EXISTS_TAC `p:num`; EXISTS_TAC `q:num`] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence the result. *) +(* ------------------------------------------------------------------------- *) + +let NONINTEGER_HARMONIC = prove + (`!m n. 1 <= m /\ 1 < n /\ m <= n ==> ~(integer (sum(m..n) (\k. inv(&k))))`, + let lemma = prove + (`!m n. 1 <= m + ==> sum(m..n) (\k. inv(&k)) = + (sum(m..n) (\k. product ((m..n) DELETE k) (\i. &i))) / + product(m..n) (\i. &i)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div; GSYM SUM_RMUL] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_FIELD + `~(x = &0) /\ ~(z = &0) /\ x * y = z + ==> inv x = y * inv z`) THEN + ASM_SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; REAL_OF_NUM_EQ] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + MP_TAC(ISPECL [`\i. &i`; `m..n`; `k:num`] PRODUCT_DELETE) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `n:num = m` THENL + [ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN + REWRITE_TAC[REAL_ARITH `inv x = &1 / x`; INTEGER_DIV; DIVIDES_ONE] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[lemma] THEN + SIMP_TAC[GSYM REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; GSYM REAL_OF_NUM_SUM; + FINITE_DELETE; INTEGER_DIV] THEN + SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`m:num`; `n:num`] NUMSEG_MAXIMAL_INDEX_2) THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`\i. nproduct((m..n) DELETE i) (\j. j)`; `m..n`; `k:num`] + NSUM_DELETE) THEN + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ABBREV_TAC `i = index 2 (nproduct ((m..n) DELETE k) (\j. j))` THEN + MATCH_MP_TAC(EQT_ELIM( + (REWRITE_CONV[IMP_CONJ; CONTRAPOS_THM] THENC (EQT_INTRO o NUMBER_RULE)) + `!p. p divides r /\ p divides n /\ ~(p divides m) + ==> ~(r divides (m + n))`)) THEN + EXISTS_TAC `2 EXP (i + 1)` THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC DIVIDES_NSUM THEN + REWRITE_TAC[FINITE_NUMSEG; FINITE_DELETE; IN_NUMSEG; IN_DELETE] THEN + X_GEN_TAC `l:num` THEN STRIP_TAC; + ALL_TAC] THEN + REWRITE_TAC[PRIMEPOW_DIVIDES_INDEX] THEN + SIMP_TAC[ARITH; DE_MORGAN_THM; NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_DELETE; + IN_NUMSEG; IN_DELETE] + THENL + [DISJ2_TAC THEN + MP_TAC(ISPECL [`\i:num. i`; `m..n`; `k:num`] NPRODUCT_DELETE) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + DISCH_THEN(MP_TAC o AP_TERM `index 2`) THEN IMP_REWRITE_TAC[INDEX_MUL] THEN + SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_DELETE; PRIME_2] THEN + REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `m:num` th) THEN MP_TAC(SPEC `n:num` th)) THEN + ASM_ARITH_TAC; + DISJ2_TAC THEN + MP_TAC(ISPECL [`\i:num. i`; `m..n`; `l:num`] NPRODUCT_DELETE) THEN + MP_TAC(ISPECL [`\i:num. i`; `m..n`; `k:num`] NPRODUCT_DELETE) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o AP_TERM `index 2`)) THEN + IMP_REWRITE_TAC[INDEX_MUL] THEN + SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_DELETE; PRIME_2] THEN + REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `l:num`) THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; diff --git a/Examples/hol88.ml b/Examples/hol88.ml new file mode 100644 index 0000000..2f2adbc --- /dev/null +++ b/Examples/hol88.ml @@ -0,0 +1,1061 @@ +(* ========================================================================= *) +(* HOL88 compatibility: various things missing or different in HOL Light. *) +(* ========================================================================= *) + +let (upto) = (--);; + +let is_neg_imp tm = + is_neg tm or is_imp tm;; + +let dest_neg_imp tm = + try dest_imp tm with Failure _ -> + try (dest_neg tm,mk_const("F",[])) + with Failure _ -> failwith "dest_neg_imp";; + +(* ------------------------------------------------------------------------- *) +(* I removed this recently. Note that it's intuitionistically valid. *) +(* ------------------------------------------------------------------------- *) + +let CONTRAPOS = + let a = `a:bool` and b = `b:bool` in + let pth = ITAUT `(a ==> b) ==> (~b ==> ~a)` in + fun th -> + try let P,Q = dest_imp(concl th) in + MP (INST [P,a; Q,b] pth) th + with Failure _ -> failwith "CONTRAPOS";; + +(* ------------------------------------------------------------------------- *) +(* I also got rid of this; it's mainly used inside DISCH_TAC anyway. *) +(* ------------------------------------------------------------------------- *) + +let NEG_DISCH = + let falsity = `F` in + fun t th -> + try if concl th = falsity then NOT_INTRO(DISCH t th) else DISCH t th + with Failure _ -> failwith "NEG_DISCH";; + +(* ------------------------------------------------------------------------- *) +(* These were never used (by me). *) +(* ------------------------------------------------------------------------- *) + +let SELECT_ELIM th1 (v,th2) = + try let P, SP = dest_comb(concl th1) in + let th3 = DISCH (mk_comb(P,v)) th2 in + MP (INST [SP,v] th3) th1 + with Failure _ -> failwith "SELECT_ELIM";; + +let SELECT_INTRO = + let P = `P:A->bool` and x = `x:A` in + let pth = SPECL [P; x] SELECT_AX in + fun th -> + try let f,arg = dest_comb(concl th) in + MP (PINST [type_of x,aty] [f,P; arg,x] pth) th + with Failure _ -> failwith "SELECT_INTRO";; + +(* ------------------------------------------------------------------------- *) +(* Again, I never use this so I removed it from the core. *) +(* ------------------------------------------------------------------------- *) + +let EXT = + let f = `f:A->B` and g = `g:A->B` in + let pth = prove + (`(!x. (f:A->B) x = g x) ==> (f = g)`, + MATCH_ACCEPT_TAC EQ_EXT) in + fun th -> + try let x,bod = dest_forall(concl th) in + let l,r = dest_eq bod in + let l',r' = rator l, rator r in + let th1 = PINST [type_of x,aty; type_of l,bty] [l',f; r',g] pth in + MP th1 th + with Failure _ -> failwith "EXT";; + +(* ------------------------------------------------------------------------- *) +(* These get overwritten by the subgoal stuff. *) +(* ------------------------------------------------------------------------- *) + +let PROVE = prove;; + +let prove_thm((s:string),g,t) = prove(g,t);; + +(* ------------------------------------------------------------------------- *) +(* The quantifier movement conversions. *) +(* ------------------------------------------------------------------------- *) + +let (CONV_OF_RCONV: conv -> conv) = + let rec get_bv tm = + if is_abs tm then bndvar tm + else if is_comb tm then + try get_bv (rand tm) with Failure _ -> get_bv (rator tm) + else failwith "" in + fun conv tm -> + let v = get_bv tm in + let th1 = conv tm in + let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in + TRANS th1 th2;; + +let (CONV_OF_THM: thm -> conv) = + CONV_OF_RCONV o REWR_CONV;; + +let (X_FUN_EQ_CONV:term->conv) = + fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;; + +let (FUN_EQ_CONV:conv) = + fun tm -> + let vars = frees tm in + let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in + if op = "fun" + then let varnm = + if (is_vartype ty1) then "x" else + hd(explode(fst(dest_type ty1))) in + let x = variant vars (mk_var(varnm,ty1)) in + X_FUN_EQ_CONV x tm + else failwith "FUN_EQ_CONV";; + +let (SINGLE_DEPTH_CONV:conv->conv) = + let rec SINGLE_DEPTH_CONV conv tm = + try conv tm with Failure _ -> + (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in + SINGLE_DEPTH_CONV;; + +let (SKOLEM_CONV:conv) = + SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);; + +let (X_SKOLEM_CONV:term->conv) = + fun v -> SKOLEM_CONV THENC GEN_ALPHA_CONV v;; + +let EXISTS_UNIQUE_CONV tm = + let v = bndvar(rand tm) in + let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in + let tm1 = rhs(concl th1) in + let vars = frees tm1 in + let v = variant vars v in + let v' = variant (v::vars) v in + let th2 = + (LAND_CONV(GEN_ALPHA_CONV v) THENC + RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC + GEN_ALPHA_CONV v)) tm1 in + TRANS th1 th2;; + +let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;; + +let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;; + +let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;; + +let FORALL_IMP_CONV = CONV_OF_RCONV + (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC + REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC + REWR_CONV LEFT_FORALL_IMP_THM);; + +let EXISTS_AND_CONV = CONV_OF_RCONV + (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC + REWR_CONV LEFT_EXISTS_AND_THM ORELSEC + REWR_CONV RIGHT_EXISTS_AND_THM);; + +let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;; + +let LEFT_AND_EXISTS_CONV tm = + let v = bndvar(rand(rand(rator tm))) in + (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;; + +let RIGHT_AND_EXISTS_CONV = + CONV_OF_THM RIGHT_AND_EXISTS_THM;; + +let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;; + +(* ------------------------------------------------------------------------- *) +(* Paired beta conversion (now just a special case of GEN_BETA_CONV). *) +(* ------------------------------------------------------------------------- *) + +let PAIRED_BETA_CONV = + let pth = (EQT_ELIM o REWRITE_CONV [EXISTS_THM; GABS_DEF]) + `!P:A->bool. (?) P ==> P((GABS) P)` + and pth1 = GSYM PASSOC_DEF and pth2 = GSYM UNCURRY_DEF in + let dest_geq = dest_binary "GEQ" in + let GEQ_RULE = CONV_RULE(REWR_CONV(GSYM GEQ_DEF)) + and UNGEQ_RULE = CONV_RULE(REWR_CONV GEQ_DEF) in + let rec UNCURRY_CONV fn vs = + try let l,r = dest_pair vs in + try let r1,r2 = dest_pair r in + let lr = mk_pair(l,r1) in + let th0 = UNCURRY_CONV fn (mk_pair(lr,r2)) in + let th1 = ISPECL [rator(rand(concl th0));l;r1;r2] pth1 in + TRANS th0 th1 + with Failure _ -> + let th0 = UNCURRY_CONV fn l in + let fn' = rand(concl th0) in + let th1 = UNCURRY_CONV fn' r in + let th2 = ISPECL [rator fn';l;r] pth2 in + TRANS (TRANS (AP_THM th0 r) th1) th2 + with Failure _ -> REFL(mk_comb(fn,vs)) in + fun tm -> + try BETA_CONV tm with Failure _ -> + let gabs,args = dest_comb tm in + let fn,bod = dest_binder "GABS" gabs in + let avs,eqv = strip_forall bod in + let l,r = dest_geq eqv in + let pred = list_mk_abs(avs,r) in + let th0 = rev_itlist + (fun v th -> CONV_RULE(RAND_CONV BETA_CONV) (AP_THM th v)) + avs (REFL pred) in + let th1 = TRANS (SYM(UNCURRY_CONV pred (rand l))) th0 in + let th1a = GEQ_RULE th1 in + let etm = list_mk_icomb "?" [rand gabs] in + let th2 = EXISTS(etm,rator (lhand(concl th1a))) (GENL avs th1a) in + let th3 = SPECL (striplist dest_pair args) (BETA_RULE(MATCH_MP pth th2)) in + UNGEQ_RULE th3;; + +(* ------------------------------------------------------------------------- *) +(* The slew of named tautologies. *) +(* ------------------------------------------------------------------------- *) + +let AND1_THM = TAUT `!t1 t2. t1 /\ t2 ==> t1`;; + +let AND2_THM = TAUT `!t1 t2. t1 /\ t2 ==> t2`;; + +let AND_IMP_INTRO = TAUT `!t1 t2 t3. t1 ==> t2 ==> t3 <=> t1 /\ t2 ==> t3`;; + +let AND_INTRO_THM = TAUT `!t1 t2. t1 ==> t2 ==> t1 /\ t2`;; + +let BOOL_EQ_DISTINCT = TAUT `~(T <=> F) /\ ~(F <=> T)`;; + +let EQ_EXPAND = TAUT `!t1 t2. (t1 <=> t2) <=> t1 /\ t2 \/ ~t1 /\ ~t2`;; + +let EQ_IMP_THM = TAUT `!t1 t2. (t1 <=> t2) <=> (t1 ==> t2) /\ (t2 ==> t1)`;; + +let FALSITY = TAUT `!t. F ==> t`;; + +let F_IMP = TAUT `!t. ~t ==> t ==> F`;; + +let IMP_DISJ_THM = TAUT `!t1 t2. t1 ==> t2 <=> ~t1 \/ t2`;; + +let IMP_F = TAUT `!t. (t ==> F) ==> ~t`;; + +let IMP_F_EQ_F = TAUT `!t. t ==> F <=> (t <=> F)`;; + +let LEFT_AND_OVER_OR = TAUT + `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;; + +let LEFT_OR_OVER_AND = TAUT + `!t1 t2 t3. t1 \/ t2 /\ t3 <=> (t1 \/ t2) /\ (t1 \/ t3)`;; + +let NOT_AND = TAUT `~(t /\ ~t)`;; + +let NOT_F = TAUT `!t. ~t ==> (t <=> F)`;; + +let OR_ELIM_THM = TAUT + `!t t1 t2. t1 \/ t2 ==> (t1 ==> t) ==> (t2 ==> t) ==> t`;; + +let OR_IMP_THM = TAUT `!t1 t2. (t1 <=> t2 \/ t1) <=> t2 ==> t1`;; + +let OR_INTRO_THM1 = TAUT `!t1 t2. t1 ==> t1 \/ t2`;; + +let OR_INTRO_THM2 = TAUT `!t1 t2. t2 ==> t1 \/ t2`;; + +let RIGHT_AND_OVER_OR = TAUT + `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;; + +let RIGHT_OR_OVER_AND = TAUT + `!t1 t2 t3. t2 /\ t3 \/ t1 <=> (t2 \/ t1) /\ (t3 \/ t1)`;; + +(* ------------------------------------------------------------------------- *) +(* This is an overwrite -- is there any point in what I have? *) +(* ------------------------------------------------------------------------- *) + +let is_type = can get_type_arity;; + +(* ------------------------------------------------------------------------- *) +(* I suppose this is also useful. *) +(* ------------------------------------------------------------------------- *) + +let is_constant = can get_const_type;; + +(* ------------------------------------------------------------------------- *) +(* Misc. *) +(* ------------------------------------------------------------------------- *) + +let null l = l = [];; + +let combine(a,b) = zip a b;; + +let split = unzip;; + +(* ------------------------------------------------------------------------- *) +(* Syntax. *) +(* ------------------------------------------------------------------------- *) + +let type_tyvars = type_vars_in_term o curry mk_var "x";; + +let find_match u = + let rec find_mt t = + try term_match [] u t with Failure _ -> + try find_mt(rator t) with Failure _ -> + try find_mt(rand t) with Failure _ -> + try find_mt(snd(dest_abs t)) + with Failure _ -> failwith "find_match" in + fun t -> let _,tmin,tyin = find_mt t in + tmin,tyin;; + +let rec mk_primed_var(name,ty) = + if can get_const_type name then mk_primed_var(name^"'",ty) + else mk_var(name,ty);; + +let subst_occs = + let rec subst_occs slist tm = + let applic,noway = partition (fun (i,(t,x)) -> aconv tm x) slist in + let sposs = map (fun (l,z) -> let l1,l2 = partition ((=) 1) l in + (l1,z),(l2,z)) applic in + let racts,rrest = unzip sposs in + let acts = filter (fun t -> not (fst t = [])) racts in + let trest = map (fun (n,t) -> (map (C (-) 1) n,t)) rrest in + let urest = filter (fun t -> not (fst t = [])) trest in + let tlist = urest @ noway in + if acts = [] then + if is_comb tm then + let l,r = dest_comb tm in + let l',s' = subst_occs tlist l in + let r',s'' = subst_occs s' r in + mk_comb(l',r'),s'' + else if is_abs tm then + let bv,bod = dest_abs tm in + let gv = genvar(type_of bv) in + let nbod = vsubst[gv,bv] bod in + let tm',s' = subst_occs tlist nbod in + alpha bv (mk_abs(gv,tm')),s' + else + tm,tlist + else + let tm' = (fun (n,(t,x)) -> subst[t,x] tm) (hd acts) in + tm',tlist in + fun ilist slist tm -> fst(subst_occs (zip ilist slist) tm);; + +(* ------------------------------------------------------------------------- *) +(* Note that the all-instantiating INST and INST_TYPE are not overwritten. *) +(* ------------------------------------------------------------------------- *) + +let INST_TY_TERM(substl,insttyl) th = + let th' = INST substl (INST_TYPE insttyl th) in + if hyp th' = hyp th then th' + else failwith "INST_TY_TERM: Free term and/or type variables in hypotheses";; + +(* ------------------------------------------------------------------------- *) +(* Conversions stuff. *) +(* ------------------------------------------------------------------------- *) + +let RIGHT_CONV_RULE (conv:conv) th = + TRANS th (conv(rhs(concl th)));; + +(* ------------------------------------------------------------------------- *) +(* Derived rules. *) +(* ------------------------------------------------------------------------- *) + +let NOT_EQ_SYM = + let pth = GENL [`a:A`; `b:A`] + (CONTRAPOS(DISCH_ALL(SYM(ASSUME`a:A = b`)))) + and aty = `:A` in + fun th -> try let l,r = dest_eq(dest_neg(concl th)) in + MP (SPECL [r; l] (INST_TYPE [type_of l,aty] pth)) th + with Failure _ -> failwith "NOT_EQ_SYM";; + +let NOT_MP thi th = + try MP thi th with Failure _ -> + try let t = dest_neg (concl thi) in + MP(MP (SPEC t F_IMP) thi) th + with Failure _ -> failwith "NOT_MP";; + +let FORALL_EQ x = + let mkall = AP_TERM (mk_const("!",[type_of x,mk_vartype "A"])) in + fun th -> try mkall (ABS x th) + with Failure _ -> failwith "FORALL_EQ";; + +let EXISTS_EQ x = + let mkex = AP_TERM (mk_const("?",[type_of x,mk_vartype "A"])) in + fun th -> try mkex (ABS x th) + with Failure _ -> failwith "EXISTS_EQ";; + +let SELECT_EQ x = + let mksel = AP_TERM (mk_const("@",[type_of x,mk_vartype "A"])) in + fun th -> try mksel (ABS x th) + with Failure _ -> failwith "SELECT_EQ";; + +let RIGHT_BETA th = + try TRANS th (BETA_CONV(rhs(concl th))) + with Failure _ -> failwith "RIGHT_BETA";; + +let rec LIST_BETA_CONV tm = + try let rat,rnd = dest_comb tm in + RIGHT_BETA(AP_THM(LIST_BETA_CONV rat)rnd) + with Failure _ -> REFL tm;; + +let RIGHT_LIST_BETA th = TRANS th (LIST_BETA_CONV(snd(dest_eq(concl th))));; + +let LIST_CONJ = end_itlist CONJ ;; + +let rec CONJ_LIST n th = + try if n=1 then [th] else (CONJUNCT1 th)::(CONJ_LIST (n-1) (CONJUNCT2 th)) + with Failure _ -> failwith "CONJ_LIST";; + +let rec BODY_CONJUNCTS th = + if is_forall(concl th) then + BODY_CONJUNCTS (SPEC_ALL th) else + if is_conj (concl th) then + BODY_CONJUNCTS (CONJUNCT1 th) @ BODY_CONJUNCTS (CONJUNCT2 th) + else [th];; + +let rec IMP_CANON th = + let w = concl th in + if is_conj w then IMP_CANON (CONJUNCT1 th) @ IMP_CANON (CONJUNCT2 th) + else if is_imp w then + let ante,conc = dest_neg_imp w in + if is_conj ante then + let a,b = dest_conj ante in + IMP_CANON + (DISCH a (DISCH b (NOT_MP th (CONJ (ASSUME a) (ASSUME b))))) + else if is_disj ante then + let a,b = dest_disj ante in + IMP_CANON (DISCH a (NOT_MP th (DISJ1 (ASSUME a) b))) @ + IMP_CANON (DISCH b (NOT_MP th (DISJ2 a (ASSUME b)))) + else if is_exists ante then + let x,body = dest_exists ante in + let x' = variant (thm_frees th) x in + let body' = subst [x',x] body in + IMP_CANON + (DISCH body' (NOT_MP th (EXISTS (ante, x') (ASSUME body')))) + else + map (DISCH ante) (IMP_CANON (UNDISCH th)) + else if is_forall w then + IMP_CANON (SPEC_ALL th) + else [th];; + +let LIST_MP = rev_itlist (fun x y -> MP y x);; + +let DISJ_IMP = + let pth = TAUT`!t1 t2. t1 \/ t2 ==> ~t1 ==> t2` in + fun th -> + try let a,b = dest_disj(concl th) in MP (SPECL [a;b] pth) th + with Failure _ -> failwith "DISJ_IMP";; + +let IMP_ELIM = + let pth = TAUT`!t1 t2. (t1 ==> t2) ==> ~t1 \/ t2` in + fun th -> + try let a,b = dest_imp(concl th) in MP (SPECL [a;b] pth) th + with Failure _ -> failwith "IMP_ELIM";; + +let DISJ_CASES_UNION dth ath bth = + DISJ_CASES dth (DISJ1 ath (concl bth)) (DISJ2 (concl ath) bth);; + +let MK_ABS qth = + try let ov = bndvar(rand(concl qth)) in + let bv,rth = SPEC_VAR qth in + let sth = ABS bv rth in + let cnv = ALPHA_CONV ov in + CONV_RULE(BINOP_CONV cnv) sth + with Failure _ -> failwith "MK_ABS";; + +let HALF_MK_ABS th = + try let th1 = MK_ABS th in + CONV_RULE(LAND_CONV ETA_CONV) th1 + with Failure _ -> failwith "HALF_MK_ABS";; + +let MK_EXISTS qth = + try let ov = bndvar(rand(concl qth)) in + let bv,rth = SPEC_VAR qth in + let sth = EXISTS_EQ bv rth in + let cnv = GEN_ALPHA_CONV ov in + CONV_RULE(BINOP_CONV cnv) sth + with Failure _ -> failwith "MK_EXISTS";; + +let LIST_MK_EXISTS l th = itlist (fun x th -> MK_EXISTS(GEN x th)) l th;; + +let IMP_CONJ th1 th2 = + let A1,C1 = dest_imp (concl th1) and A2,C2 = dest_imp (concl th2) in + let a1,a2 = CONJ_PAIR (ASSUME (mk_conj(A1,A2))) in + DISCH (mk_conj(A1,A2)) (CONJ (MP th1 a1) (MP th2 a2));; + +let EXISTS_IMP x = + if not (is_var x) then failwith "EXISTS_IMP: first argument not a variable" + else fun th -> + try let ante,cncl = dest_imp(concl th) in + let th1 = EXISTS (mk_exists(x,cncl),x) (UNDISCH th) in + let asm = mk_exists(x,ante) in + DISCH asm (CHOOSE (x,ASSUME asm) th1) + with Failure _ -> + failwith "EXISTS_IMP: variable free in assumptions";; + +let CONJUNCTS_CONV (t1,t2) = + let rec build_conj thl t = + try let l,r = dest_conj t in + CONJ (build_conj thl l) (build_conj thl r) + with Failure _ -> find (fun th -> concl th = t) thl in + try IMP_ANTISYM_RULE + (DISCH t1 (build_conj (CONJUNCTS (ASSUME t1)) t2)) + (DISCH t2 (build_conj (CONJUNCTS (ASSUME t2)) t1)) + with Failure _ -> failwith "CONJUNCTS_CONV";; + +let CONJ_SET_CONV l1 l2 = + try CONJUNCTS_CONV (list_mk_conj l1, list_mk_conj l2) + with Failure _ -> failwith "CONJ_SET_CONV";; + +let FRONT_CONJ_CONV tml t = + let rec remove x l = + if hd l = x then tl l else (hd l)::(remove x (tl l)) in + try CONJ_SET_CONV tml (t::(remove t tml)) + with Failure _ -> failwith "FRONT_CONJ_CONV";; + +let CONJ_DISCH = + let pth = TAUT`!t t1 t2. (t ==> (t1 = t2)) ==> (t /\ t1 <=> t /\ t2)` in + fun t th -> + try let t1,t2 = dest_eq(concl th) in + MP (SPECL [t; t1; t2] pth) (DISCH t th) + with Failure _ -> failwith "CONJ_DISCH";; + +let rec CONJ_DISCHL l th = + if l = [] then th else CONJ_DISCH (hd l) (CONJ_DISCHL (tl l) th);; + +let rec GSPEC th = + let wl,w = dest_thm th in + if is_forall w then + GSPEC (SPEC (genvar (type_of (fst (dest_forall w)))) th) + else th;; + +let ANTE_CONJ_CONV tm = + try let (a1,a2),c = (dest_conj F_F I) (dest_imp tm) in + let imp1 = MP (ASSUME tm) (CONJ (ASSUME a1) (ASSUME a2)) and + imp2 = LIST_MP [CONJUNCT1 (ASSUME (mk_conj(a1,a2))); + CONJUNCT2 (ASSUME (mk_conj(a1,a2)))] + (ASSUME (mk_imp(a1,mk_imp(a2,c)))) in + IMP_ANTISYM_RULE (DISCH_ALL (DISCH a1 (DISCH a2 imp1))) + (DISCH_ALL (DISCH (mk_conj(a1,a2)) imp2)) + with Failure _ -> failwith "ANTE_CONJ_CONV";; + +let bool_EQ_CONV = + let check = let boolty = `:bool` in check (fun tm -> type_of tm = boolty) in + let clist = map (GEN `b:bool`) + (CONJUNCTS(SPEC `b:bool` EQ_CLAUSES)) in + let tb = hd clist and bt = hd(tl clist) in + let T = `T` and F = `F` in + fun tm -> + try let l,r = (I F_F check) (dest_eq tm) in + if l = r then EQT_INTRO (REFL l) else + if l = T then SPEC r tb else + if r = T then SPEC l bt else fail() + with Failure _ -> failwith "bool_EQ_CONV";; + +let COND_CONV = + let T = `T` and F = `F` and vt = genvar`:A` and vf = genvar `:A` in + let gen = GENL [vt;vf] in + let CT,CF = (gen F_F gen) (CONJ_PAIR (SPECL [vt;vf] COND_CLAUSES)) in + fun tm -> + let P,(u,v) = try dest_cond tm + with Failure _ -> failwith "COND_CONV: not a conditional" in + let ty = type_of u in + if (P=T) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CT)) else + if (P=F) then SPEC v (SPEC u (INST_TYPE [ty,`:A`] CF)) else + if (u=v) then SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) else + if (aconv u v) then + let cnd = AP_TERM (rator tm) (ALPHA v u) in + let thm = SPEC u (SPEC P (INST_TYPE [ty,`:A`] COND_ID)) in + TRANS cnd thm else + failwith "COND_CONV: can't simplify conditional";; + +let SUBST_MATCH eqth th = + let tm_inst,ty_inst = find_match (lhs(concl eqth)) (concl th) in + SUBS [INST tm_inst (INST_TYPE ty_inst eqth)] th;; + +let SUBST thl pat th = + let eqs,vs = unzip thl in + let gvs = map (genvar o type_of) vs in + let gpat = subst (zip gvs vs) pat in + let ls,rs = unzip (map (dest_eq o concl) eqs) in + let ths = map (ASSUME o mk_eq) (zip gvs rs) in + let th1 = ASSUME gpat in + let th2 = SUBS ths th1 in + let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in + let th4 = INST (zip ls gvs) th3 in + MP (rev_itlist (C MP) eqs th4) th;; + +(* ------------------------------------------------------------------------- *) +(* A poor thing but my own. The original (bogus) code used mk_thm. *) +(* I haven't bothered with GSUBS and SUBS_OCCS. *) +(* ------------------------------------------------------------------------- *) + +let SUBST_CONV thvars template tm = + let thms,vars = unzip thvars in + let gvs = map (genvar o type_of) vars in + let gtemplate = subst (zip gvs vars) template in + SUBST (zip thms gvs) (mk_eq(template,gtemplate)) (REFL tm);; + +(* ------------------------------------------------------------------------- *) +(* Filtering rewrites. *) +(* ------------------------------------------------------------------------- *) + +let FILTER_PURE_ASM_REWRITE_RULE f thl th = + PURE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th + +and FILTER_ASM_REWRITE_RULE f thl th = + REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th + +and FILTER_PURE_ONCE_ASM_REWRITE_RULE f thl th = + PURE_ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th + +and FILTER_ONCE_ASM_REWRITE_RULE f thl th = + ONCE_REWRITE_RULE ((map ASSUME (filter f (hyp th))) @ thl) th;; + +let (FILTER_PURE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + PURE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) + +and (FILTER_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) + +and (FILTER_PURE_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + PURE_ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w) + +and (FILTER_ONCE_ASM_REWRITE_TAC: (term->bool) -> thm list -> tactic) = + fun f thl (asl,w) -> + ONCE_REWRITE_TAC (filter (f o concl) (map snd asl) @ thl) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Tacticals. *) +(* ------------------------------------------------------------------------- *) + +let DISJ_CASES_THENL = + end_itlist DISJ_CASES_THEN2;; + +let (X_CASES_THENL: term list list -> thm_tactic list -> thm_tactic) = + fun varsl ttacl -> + end_itlist DISJ_CASES_THEN2 + (map (fun (vars,ttac) -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) + (zip varsl ttacl));; + +let (X_CASES_THEN: term list list -> thm_tactical) = + fun varsl ttac -> + end_itlist DISJ_CASES_THEN2 + (map (fun vars -> EVERY_TCL (map X_CHOOSE_THEN vars) ttac) varsl);; + +let (CASES_THENL: thm_tactic list -> thm_tactic) = + fun ttacl -> end_itlist DISJ_CASES_THEN2 (map (REPEAT_TCL CHOOSE_THEN) ttacl);; + +(* ------------------------------------------------------------------------- *) +(* Tactics. *) +(* ------------------------------------------------------------------------- *) + +let (DISCARD_TAC: thm_tactic) = + let truth = `T` in + fun th (asl,w) -> + if exists (aconv (concl th)) (truth::(map (concl o snd) asl)) + then ALL_TAC (asl,w) + else failwith "DISCARD_TAC";; + +let (GSUBST_TAC:((term * term)list->term->term)->thm list -> tactic) = + fun substfn ths (asl,w) -> + let ls,rs = split (map (dest_eq o concl) ths) in + let vars = map (genvar o type_of) ls in + let base = substfn (combine(vars,ls)) w in + let rfn i thl = + match thl with + [th] -> SUBST (combine(map SYM ths, vars)) base th + | _ -> failwith "" in + null_meta, + [asl,subst (combine(rs,vars)) base], + rfn;; + +let SUBST_TAC = GSUBST_TAC subst;; + +let SUBST_OCCS_TAC nlths = + let nll,ths = split nlths in GSUBST_TAC (subst_occs nll) ths;; + +let (CHECK_ASSUME_TAC: thm_tactic) = + fun gth -> + FIRST [CONTR_TAC gth; ACCEPT_TAC gth; + DISCARD_TAC gth; ASSUME_TAC gth];; + +let (FILTER_GEN_TAC: term -> tactic) = + fun tm (asl,w) -> + if is_forall w & not (tm = fst(dest_forall w)) then + GEN_TAC (asl,w) + else failwith "FILTER_GEN_TAC";; + +let (FILTER_DISCH_THEN: thm_tactic -> term -> tactic) = + fun ttac tm (asl,w) -> + if is_neg_imp w & not (free_in tm (fst(dest_neg_imp w))) then + DISCH_THEN ttac (asl,w) + else failwith "FILTER_DISCH_THEN";; + +let FILTER_STRIP_THEN ttac tm = + FIRST [FILTER_GEN_TAC tm; FILTER_DISCH_THEN ttac tm; CONJ_TAC];; + +let FILTER_DISCH_TAC = FILTER_DISCH_THEN STRIP_ASSUME_TAC;; + +let FILTER_STRIP_TAC = FILTER_STRIP_THEN STRIP_ASSUME_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Resolution stuff. *) +(* ------------------------------------------------------------------------- *) + +let RES_CANON = + let not_elim th = + if is_neg (concl th) then true,(NOT_ELIM th) else (false,th) in + let rec canon fl th = + let w = concl th in + if (is_conj w) then + let (th1,th2) = CONJ_PAIR th in (canon fl th1) @ (canon fl th2) else + if ((is_imp w) & not(is_neg w)) then + let ante,conc = dest_neg_imp w in + if (is_conj ante) then + let a,b = dest_conj ante in + let cth = NOT_MP th (CONJ (ASSUME a) (ASSUME b)) in + let th1 = DISCH b cth and th2 = DISCH a cth in + (canon true (DISCH a th1)) @ (canon true (DISCH b th2)) else + if (is_disj ante) then + let a,b = dest_disj ante in + let ath = DISJ1 (ASSUME a) b and bth = DISJ2 a (ASSUME b) in + let th1 = DISCH a (NOT_MP th ath) and + th2 = DISCH b (NOT_MP th bth) in + (canon true th1) @ (canon true th2) else + if (is_exists ante) then + let v,body = dest_exists ante in + let newv = variant (thm_frees th) v in + let newa = subst [newv,v] body in + let th1 = NOT_MP th (EXISTS (ante, newv) (ASSUME newa)) in + canon true (DISCH newa th1) else + map (GEN_ALL o (DISCH ante)) (canon true (UNDISCH th)) else + if (is_eq w & (type_of (rand w) = `:bool`)) then + let (th1,th2) = EQ_IMP_RULE th in + (if fl then [GEN_ALL th] else []) @ + (canon true th1) @ (canon true th2) else + if (is_forall w) then + let vs,body = strip_forall w in + let fvs = thm_frees th in + let vfn = fun l -> variant (l @ fvs) in + let nvs = itlist + (fun v nv -> let v' = vfn nv v in (v'::nv)) vs [] in + canon fl (SPECL nvs th) else + if fl then [GEN_ALL th] else [] in + fun th -> try let args = map (not_elim o SPEC_ALL) + (CONJUNCTS (SPEC_ALL th)) in + let imps = flat (map (map GEN_ALL o (uncurry canon)) args) in + check ((not) o (=) []) imps + with Failure _ -> + failwith + "RES_CANON: no implication is derivable from input thm.";; + +let IMP_RES_THEN,RES_THEN = + let MATCH_MP impth = + let sth = SPEC_ALL impth in + let matchfn = (fun (a,b,c) -> b,c) o + term_match [] (fst(dest_neg_imp(concl sth))) in + fun th -> NOT_MP (INST_TY_TERM (matchfn (concl th)) sth) th in + let check st l = (if l = [] then failwith st else l) in + let IMP_RES_THEN ttac impth = + let ths = try RES_CANON impth + with Failure _ -> failwith "IMP_RES_THEN: no implication" in + ASSUM_LIST + (fun asl -> + let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asl)) ths [] in + let res = check "IMP_RES_THEN: no resolvents " l in + let tacs = check "IMP_RES_THEN: no tactics" (mapfilter ttac res) in + EVERY tacs) in + let RES_THEN ttac (asl,g) = + let asm = map snd asl in + let ths = itlist (@) (mapfilter RES_CANON asm) [] in + let imps = check "RES_THEN: no implication" ths in + let l = itlist (fun th -> (@) (mapfilter (MATCH_MP th) asm)) imps [] in + let res = check "RES_THEN: no resolvents " l in + let tacs = check "RES_THEN: no tactics" (mapfilter ttac res) in + EVERY tacs (asl,g) in + IMP_RES_THEN,RES_THEN;; + +let IMP_RES_TAC th g = + try IMP_RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) th g + with Failure _ -> ALL_TAC g;; + +let RES_TAC g = + try RES_THEN (REPEAT_GTCL IMP_RES_THEN STRIP_ASSUME_TAC) g + with Failure _ -> ALL_TAC g;; + +(* ------------------------------------------------------------------------- *) +(* Stuff for handling type definitions. *) +(* ------------------------------------------------------------------------- *) + +let prove_rep_fn_one_one th = + try let thm = CONJUNCT1 th in + let A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl thm))))) in + let _,[aty;rty] = dest_type (type_of R) in + let a = mk_primed_var("a",aty) in let a' = variant [a] a in + let a_eq_a' = mk_eq(a,a') and + Ra_eq_Ra' = mk_eq(mk_comb(R,a),mk_comb (R,a')) in + let th1 = AP_TERM A (ASSUME Ra_eq_Ra') in + let ga1 = genvar aty and ga2 = genvar aty in + let th2 = SUBST [SPEC a thm,ga1;SPEC a' thm,ga2] (mk_eq(ga1,ga2)) th1 in + let th3 = DISCH a_eq_a' (AP_TERM R (ASSUME a_eq_a')) in + GEN a (GEN a' (IMP_ANTISYM_RULE (DISCH Ra_eq_Ra' th2) th3)) + with Failure _ -> failwith "prove_rep_fn_one_one";; + +let prove_rep_fn_onto th = + try let [th1;th2] = CONJUNCTS th in + let r,eq = (I F_F rhs)(dest_forall(concl th2)) in + let RE,ar = dest_comb(lhs eq) and + sr = (mk_eq o (fun (x,y) -> y,x) o dest_eq) eq in + let a = mk_primed_var ("a",type_of ar) in + let sra = mk_eq(r,mk_comb(RE,a)) in + let ex = mk_exists(a,sra) in + let imp1 = EXISTS (ex,ar) (SYM(ASSUME eq)) in + let v = genvar (type_of r) and + A = rator ar and + s' = AP_TERM RE (SPEC a th1) in + let th = SUBST[SYM(ASSUME sra),v](mk_eq(mk_comb(RE,mk_comb(A,v)),v))s' in + let imp2 = CHOOSE (a,ASSUME ex) th in + let swap = IMP_ANTISYM_RULE (DISCH eq imp1) (DISCH ex imp2) in + GEN r (TRANS (SPEC r th2) swap) + with Failure _ -> failwith "prove_rep_fn_onto";; + +let prove_abs_fn_onto th = + try let [th1;th2] = CONJUNCTS th in + let a,(A,R) = (I F_F ((I F_F rator)o dest_comb o lhs)) + (dest_forall(concl th1)) in + let thm1 = EQT_ELIM(TRANS (SPEC (mk_comb (R,a)) th2) + (EQT_INTRO (AP_TERM R (SPEC a th1)))) in + let thm2 = SYM(SPEC a th1) in + let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) in + let ex = mk_exists(r,mk_conj(mk_eq(a,mk_comb(A,r)),mk_comb(P,r))) in + GEN a (EXISTS(ex,mk_comb(R,a)) (CONJ thm2 thm1)) + with Failure _ -> failwith "prove_abs_fn_onto";; + +let prove_abs_fn_one_one th = + try let [th1;th2] = CONJUNCTS th in + let r,P = (I F_F (rator o lhs)) (dest_forall(concl th2)) and + A,R = (I F_F rator) (dest_comb(lhs(snd(dest_forall(concl th1))))) in + let r' = variant [r] r in + let as1 = ASSUME(mk_comb(P,r)) and as2 = ASSUME(mk_comb(P,r')) in + let t1 = EQ_MP (SPEC r th2) as1 and t2 = EQ_MP (SPEC r' th2) as2 in + let eq = (mk_eq(mk_comb(A,r),mk_comb(A,r'))) in + let v1 = genvar(type_of r) and v2 = genvar(type_of r) in + let i1 = DISCH eq + (SUBST [t1,v1;t2,v2] (mk_eq(v1,v2)) (AP_TERM R (ASSUME eq))) and + i2 = DISCH (mk_eq(r,r')) (AP_TERM A (ASSUME (mk_eq(r,r')))) in + let thm = IMP_ANTISYM_RULE i1 i2 in + let disch = DISCH (mk_comb(P,r)) (DISCH (mk_comb(P,r')) thm) in + GEN r (GEN r' disch) + with Failure _ -> failwith "prove_abs_fn_one_one";; + +(* ------------------------------------------------------------------------- *) +(* AC rewriting needs to be wrapped up as a special conversion. *) +(* ------------------------------------------------------------------------- *) + +let AC_CONV(associative,commutative) tm = + try + let op = (rator o rator o lhs o snd o strip_forall o concl) commutative in + let ty = (hd o snd o dest_type o type_of) op in + let x = mk_var("x",ty) and y = mk_var("y",ty) and z = mk_var("z",ty) in + let xy = mk_comb(mk_comb(op,x),y) and yz = mk_comb(mk_comb(op,y),z) + and yx = mk_comb(mk_comb(op,y),x) in + let comm = PART_MATCH I commutative (mk_eq(xy,yx)) + and ass = PART_MATCH I (SYM (SPEC_ALL associative)) + (mk_eq(mk_comb(mk_comb(op,xy),z),mk_comb(mk_comb(op,x),yz))) in + let asc = TRANS (SUBS [comm] (SYM ass)) (INST[(x,y); (y,x)] ass) in + let init = TOP_DEPTH_CONV (REWR_CONV ass) tm in + let gl = rhs (concl init) in + + let rec bubble head expr = + let ((xop,l),r) = (dest_comb F_F I) (dest_comb expr) in + if xop = op then + if l = head then REFL expr else + if r = head then INST [(l,x); (r,y)] comm + else let subb = bubble head r in + let eqv = AP_TERM (mk_comb(xop,l)) subb + and ((yop,l'),r') = (dest_comb F_F I) + (dest_comb (snd (dest_eq (concl subb)))) in + TRANS eqv (INST[(l,x); (l',y); (r',z)] asc) + else failwith "" in + + let rec asce (l,r) = + if l = r then REFL l + else let ((zop,l'),r') = (dest_comb F_F I) (dest_comb l) in + if zop = op then + let beq = bubble l' r in + let rt = snd (dest_eq (concl beq)) in + TRANS (AP_TERM (mk_comb(op,l')) + (asce ((snd (dest_comb l)),(snd (dest_comb rt))))) + (SYM beq) + else failwith "" in + + EQT_INTRO (EQ_MP (SYM init) (asce (dest_eq gl))) + with _ -> failwith "AC_CONV";; + +let AC_RULE ths = EQT_ELIM o AC_CONV ths;; + +(* ------------------------------------------------------------------------- *) +(* The order of picking conditionals is different! *) +(* ------------------------------------------------------------------------- *) + +let (COND_CASES_TAC :tactic) = + let is_good_cond tm = + try not(is_const(fst(dest_cond tm))) + with Failure _ -> false in + fun (asl,w) -> + let cond = find_term (fun tm -> is_good_cond tm & free_in tm w) w in + let p,(t,u) = dest_cond cond in + let inst = INST_TYPE [type_of t, `:A`] COND_CLAUSES in + let (ct,cf) = CONJ_PAIR (SPEC u (SPEC t inst)) in + DISJ_CASES_THEN2 + (fun th -> SUBST1_TAC (EQT_INTRO th) THEN + SUBST1_TAC ct THEN ASSUME_TAC th) + (fun th -> SUBST1_TAC (EQF_INTRO th) THEN + SUBST1_TAC cf THEN ASSUME_TAC th) + (SPEC p EXCLUDED_MIDDLE) + (asl,w) ;; + +(* ------------------------------------------------------------------------- *) +(* MATCH_MP_TAC allows universals on the right of implication. *) +(* Here's a crude hack to allow it. *) +(* ------------------------------------------------------------------------- *) + +let MATCH_MP_TAC th = + MATCH_MP_TAC th ORELSE + MATCH_MP_TAC(PURE_REWRITE_RULE[RIGHT_IMP_FORALL_THM] th);; + +(* ------------------------------------------------------------------------- *) +(* Various theorems have different names. *) +(* ------------------------------------------------------------------------- *) + +let ZERO_LESS_EQ = LE_0;; + +let LESS_EQ_MONO = LE_SUC;; + +let NOT_LESS = NOT_LT;; + +let LESS_0 = LT_0;; + +let LESS_EQ_REFL = LE_REFL;; + +let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));; + +let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));; + +let LESS_TRANS = LT_TRANS;; + +let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));; + +let LESS_SUC_REFL = prove(`!n. n < SUC n`,REWRITE_TAC[LT]);; + +let FACT_LESS = FACT_LT;; + +let LESS_EQ_SUC_REFL = prove(`!n. n <= SUC n`,REWRITE_TAC[LE; LE_REFL]);; + +let LESS_EQ_ADD = LE_ADD;; + +let GREATER_EQ = GE;; + +let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));; + +let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));; + +let LESS_IMP_LESS_OR_EQ = LT_IMP_LE;; + +let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));; + +let LESS_SUC = prove(`!m n. m < n ==> m < (SUC n)`,MESON_TAC[LT]);; + +let LESS_CASES = LTE_CASES;; + +let LESS_EQ = GSYM LE_SUC_LT;; + +let LESS_OR_EQ = LE_LT;; + +let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL + (REWRITE_RULE[ADD1] LT_EXISTS))));; + +let SUC_SUB1 = ARITH_RULE `!m. SUC m - 1 = m`;; + +let LESS_MONO_EQ = LT_SUC;; + +let LESS_ADD_SUC = ARITH_RULE `!m n. m < m + SUC n`;; + +let LESS_REFL = LT_REFL;; + +let INV_SUC_EQ = SUC_INJ;; + +let LESS_EQ_CASES = LE_CASES;; + +let LESS_EQ_TRANS = LE_TRANS;; + +let LESS_THM = CONJUNCT2 LT;; + +let GREATER = GT;; + +let LESS_EQ_0 = CONJUNCT1 LE;; + +let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));; + +let SUB_EQUAL_0 = SUB_REFL;; + +let SUB_MONO_EQ = SUB_SUC;; + +let NOT_SUC_LESS_EQ = ARITH_RULE `!n m. ~(SUC n <= m) <=> m <= n`;; + +let SUC_NOT = GSYM NOT_SUC;; + +let LESS_LESS_CASES = ARITH_RULE `!m n:num. (m = n) \/ m < n \/ n < m`;; + +let NOT_LESS_EQUAL = NOT_LE;; + +let LESS_EQ_EXISTS = LE_EXISTS;; + +let LESS_MONO_ADD_EQ = LT_ADD_RCANCEL;; + +let LESS_LESS_EQ_TRANS = LTE_TRANS;; + +let SUB_SUB = ARITH_RULE + `!b c. c <= b ==> (!a:num. a - (b - c) = (a + c) - b)`;; + +let LESS_CASES_IMP = ARITH_RULE + `!m n:num. ~(m < n) /\ ~(m = n) ==> n < m`;; + +let SUB_LESS_EQ = ARITH_RULE `!n m:num. (n - m) <= n`;; + +let SUB_EQ_EQ_0 = ARITH_RULE `!m n:num. (m - n = m) = (m = 0) \/ (n = 0)`;; + +let SUB_LEFT_LESS_EQ = ARITH_RULE + `!m n p:num. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;; + +let SUB_LEFT_GREATER_EQ = + ARITH_RULE `!m n p:num. m >= (n - p) <=> (m + p) >= n`;; + +let LESS_EQ_LESS_TRANS = LET_TRANS;; + +let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; + +let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;; + +let SUB = ARITH_RULE + `(!m. 0 - m = 0) /\ + (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`;; + +let LESS_MULT_MONO = prove + (`!m i n. ((SUC n) * m) < ((SUC n) * i) <=> m < i`, + REWRITE_TAC[LT_MULT_LCANCEL; NOT_SUC]);; + +let LESS_MONO_MULT = prove + (`!m n p. m <= n ==> (m * p) <= (n * p)`, + SIMP_TAC[LE_MULT_RCANCEL]);; + +let LESS_MULT2 = prove + (`!m n. 0 < m /\ 0 < n ==> 0 < (m * n)`, + REWRITE_TAC[LT_MULT]);; + +let SUBSET_FINITE = prove + (`!s. FINITE s ==> (!t. t SUBSET s ==> FINITE t)`, + MESON_TAC[FINITE_SUBSET]);; + +let LESS_EQ_SUC = prove + (`!n. m <= SUC n <=> (m = SUC n) \/ m <= n`, + REWRITE_TAC[LE]);; + +(* ------------------------------------------------------------------------- *) +(* Restore traditional (low) parse status of "=". *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("=",(2,"right"));; diff --git a/Examples/holby.ml b/Examples/holby.ml new file mode 100644 index 0000000..498d13a --- /dev/null +++ b/Examples/holby.ml @@ -0,0 +1,876 @@ +(* ========================================================================= *) +(* A HOL "by" tactic, doing Mizar-like things, trying something that is *) +(* sufficient for HOL's basic rules, trying a few other things like *) +(* arithmetic, and finally if all else fails using MESON_TAC[]. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* More refined net lookup that double-checks conditions like matchability. *) +(* ------------------------------------------------------------------------- *) + +let matching_enter tm y net = + enter [] (tm,((fun tm' -> can (term_match [] tm) tm'),y)) net;; + +let unconditional_enter (tm,y) net = + enter [] (tm,((fun t -> true),y)) net;; + +let conditional_enter (tm,condy) net = + enter [] (tm,condy) net;; + +let careful_lookup tm net = + map snd (filter (fun (c,y) -> c tm) (lookup tm net));; + +(* ------------------------------------------------------------------------- *) +(* Transform theorem list to simplify, eliminate redundant connectives and *) +(* split the problem into (generally multiple) subproblems. Then, call the *) +(* prover given as the first argument on each component. *) +(* ------------------------------------------------------------------------- *) + +let SPLIT_THEN = + let action_false th f oths = th + and action_true th f oths = f oths + and action_conj th f oths = + f (CONJUNCT1 th :: CONJUNCT2 th :: oths) + and action_disj th f oths = + let th1 = f (ASSUME(lhand(concl th)) :: oths) + and th2 = f (ASSUME(rand(concl th)) :: oths) in + DISJ_CASES th th1 th2 + and action_taut tm = + let pfun = PART_MATCH lhs (TAUT tm) in + let prule th = EQ_MP (pfun (concl th)) th in + lhand tm,(fun th f oths -> f(prule th :: oths)) in + let enet = itlist unconditional_enter + [`F`,action_false; + `T`,action_true; + `p /\ q`,action_conj; + `p \/ q`,action_disj; + action_taut `(p ==> q) <=> ~p \/ q`; + action_taut `~F <=> T`; + action_taut `~T <=> F`; + action_taut `~(~p) <=> p`; + action_taut `~(p /\ q) <=> ~p \/ ~q`; + action_taut `~(p \/ q) <=> ~p /\ ~q`; + action_taut `~(p ==> q) <=> p /\ ~q`; + action_taut `p /\ F <=> F`; + action_taut `F /\ p <=> F`; + action_taut `p /\ T <=> p`; + action_taut `T /\ p <=> p`; + action_taut `p \/ F <=> p`; + action_taut `F \/ p <=> p`; + action_taut `p \/ T <=> T`; + action_taut `T \/ p <=> T`] + (let tm,act = action_taut `~(p <=> q) <=> p /\ ~q \/ ~p /\ q` in + let cond tm = type_of(rand(rand tm)) = bool_ty in + conditional_enter (tm,(cond,act)) + (let tm,act = action_taut `(p <=> q) <=> p /\ q \/ ~p /\ ~q` in + let cond tm = type_of(rand tm) = bool_ty in + conditional_enter (tm,(cond,act)) empty_net)) in + fun prover -> + let rec splitthen splat tosplit = + match tosplit with + [] -> prover (rev splat) + | th::oths -> + let funs = careful_lookup (concl th) enet in + if funs = [] then splitthen (th::splat) oths + else (hd funs) th (splitthen splat) oths in + splitthen [];; + +(* ------------------------------------------------------------------------- *) +(* A similar thing that also introduces Skolem constants (but not functions) *) +(* and does some slight first-order simplification like trivial miniscoping. *) +(* ------------------------------------------------------------------------- *) + +let SPLIT_FOL_THEN = + let action_false th f splat oths = th + and action_true th f splat oths = f oths + and action_conj th f splat oths = + f (CONJUNCT1 th :: CONJUNCT2 th :: oths) + and action_disj th f splat oths = + let th1 = f (ASSUME(lhand(concl th)) :: oths) + and th2 = f (ASSUME(rand(concl th)) :: oths) in + DISJ_CASES th th1 th2 + and action_exists th f splat oths = + let v,bod = dest_exists(concl th) in + let vars = itlist (union o thm_frees) (oths @ splat) (thm_frees th) in + let v' = variant vars v in + let th' = ASSUME (subst [v',v] bod) in + CHOOSE (v',th) (f (th'::oths)) + and action_taut tm = + let pfun = PART_MATCH lhs (TAUT tm) in + let prule th = EQ_MP (pfun (concl th)) th in + lhand tm,(fun th f splat oths -> f(prule th :: oths)) + and action_fol tm = + let pfun = PART_MATCH lhs (prove(tm,MESON_TAC[])) in + let prule th = EQ_MP (pfun (concl th)) th in + lhand tm,(fun th f splat oths -> f(prule th :: oths)) in + let enet = itlist unconditional_enter + [`F`,action_false; + `T`,action_true; + `p /\ q`,action_conj; + `p \/ q`,action_disj; + `?x. P x`,action_exists; + action_taut `~(~p) <=> p`; + action_taut `~(p /\ q) <=> ~p \/ ~q`; + action_taut `~(p \/ q) <=> ~p /\ ~q`; + action_fol `~(!x. P x) <=> (?x. ~(P x))`; + action_fol `(!x. P x /\ Q x) <=> (!x. P x) /\ (!x. Q x)`] + empty_net in + fun prover -> + let rec splitthen splat tosplit = + match tosplit with + [] -> prover (rev splat) + | th::oths -> + let funs = careful_lookup (concl th) enet in + if funs = [] then splitthen (th::splat) oths + else (hd funs) th (splitthen splat) splat oths in + splitthen [];; + +(* ------------------------------------------------------------------------- *) +(* Do the basic "semantic correlates" stuff. *) +(* This is more like NNF than Mizar's version. *) +(* ------------------------------------------------------------------------- *) + +let CORRELATE_RULE = + PURE_REWRITE_RULE + [TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`; + TAUT `(a ==> b) <=> ~a \/ b`; + DE_MORGAN_THM; + TAUT `~(~a) <=> a`; + TAUT `~T <=> F`; + TAUT `~F <=> T`; + TAUT `T /\ p <=> p`; + TAUT `p /\ T <=> p`; + TAUT `F /\ p <=> F`; + TAUT `p /\ F <=> F`; + TAUT `T \/ p <=> T`; + TAUT `p \/ T <=> T`; + TAUT `F \/ p <=> p`; + TAUT `p \/ F <=> p`; + GSYM CONJ_ASSOC; GSYM DISJ_ASSOC; + prove(`(?x. P x) <=> ~(!x. ~(P x))`,MESON_TAC[])];; + +(* ------------------------------------------------------------------------- *) +(* Look for an immediate contradictory pair of theorems. This is quadratic, *) +(* but I doubt if that's much of an issue in practice. We could do something *) +(* fancier, but need to be careful over alpha-equivalence if sorting. *) +(* ------------------------------------------------------------------------- *) + +let THMLIST_CONTR_RULE = + let CONTR_PAIR_THM = UNDISCH_ALL(TAUT `p ==> ~p ==> F`) + and p_tm = `p:bool` in + fun ths -> + let ths_n,ths_p = partition (is_neg o concl) ths in + let th_n = find (fun thn -> let tm = rand(concl thn) in + exists (aconv tm o concl) ths_p) ths_n in + let tm = rand(concl th_n) in + let th_p = find (aconv tm o concl) ths_p in + itlist PROVE_HYP [th_p; th_n] (INST [tm,p_tm] CONTR_PAIR_THM);; + +(* ------------------------------------------------------------------------- *) +(* Hence something similar to Mizar's "prechecker". *) +(* ------------------------------------------------------------------------- *) + +let PRECHECKER_THEN prover = + SPLIT_THEN (fun ths -> try THMLIST_CONTR_RULE ths + with Failure _ -> + SPLIT_FOL_THEN prover (map CORRELATE_RULE ths));; + +(* ------------------------------------------------------------------------- *) +(* Lazy equations for use in congruence closure. *) +(* ------------------------------------------------------------------------- *) + +type lazyeq = Lazy of (term * term) * (unit -> thm);; + +let cache f = + let store = ref TRUTH in + fun () -> let th = !store in + if is_eq(concl th) then th else + let th' = f() in + (store := th'; th');; + +let lazy_eq th = + Lazy((dest_eq(concl th)),(fun () -> th));; + +let lazy_eval (Lazy(_,f)) = f();; + +let REFL' t = Lazy((t,t),cache(fun () -> REFL t));; + +let SYM' = fun (Lazy((t,t'),f)) -> Lazy((t',t),cache(fun () -> SYM(f ())));; + +let TRANS' = + fun (Lazy((s,s'),f)) (Lazy((t,t'),g)) -> + if not(aconv s' t) then failwith "TRANS'" + else Lazy((s,t'),cache(fun () -> TRANS (f ()) (g ())));; + +let MK_COMB' = + fun (Lazy((s,s'),f),Lazy((t,t'),g)) -> + Lazy((mk_comb(s,t),mk_comb(s',t')),cache(fun () -> MK_COMB (f (),g ())));; + +let concl' = fun (Lazy(tmp,g)) -> tmp;; + +(* ------------------------------------------------------------------------- *) +(* Successors of a term, and predecessor function. *) +(* ------------------------------------------------------------------------- *) + +let successors tm = + try let f,x = dest_comb tm in [f;x] + with Failure _ -> [];; + +let predecessor_function tms = + itlist (fun x -> itlist (fun y f -> (y |-> insert x (tryapplyd f y [])) f) + (successors x)) + tms undefined;; + +(* ------------------------------------------------------------------------- *) +(* A union-find structure for equivalences, with theorems for edges. *) +(* ------------------------------------------------------------------------- *) + +type termnode = Nonterminal of lazyeq | Terminal of term * term list;; + +type termequivalence = Equivalence of (term,termnode)func;; + +let rec terminus (Equivalence f as eqv) a = + match (apply f a) with + Nonterminal(th) -> let b = snd(concl' th) in + let th',n = terminus eqv b in + TRANS' th th',n + | Terminal(t,n) -> (REFL' t,n);; + +let tryterminus eqv a = + try terminus eqv a with Failure _ -> (REFL' a,[a]);; + +let canonize eqv a = fst(tryterminus eqv a);; + +let equate th (Equivalence f as eqv) = + let a,b = concl' th in + let (ath,na) = tryterminus eqv a + and (bth,nb) = tryterminus eqv b in + let a' = snd(concl' ath) and b' = snd(concl' bth) in + Equivalence + (if a' = b' then f else + if length na <= length nb then + let th' = TRANS' (TRANS' (SYM' ath) th) bth in + (a' |-> Nonterminal th') ((b' |-> Terminal(b',na@nb)) f) + else + let th' = TRANS'(SYM'(TRANS' th bth)) ath in + (b' |-> Nonterminal th') ((a' |-> Terminal(a',na@nb)) f));; + +let unequal = Equivalence undefined;; + +let equated (Equivalence f) = dom f;; + +let prove_equal eqv (s,t) = + let sth = canonize eqv s and tth = canonize eqv t in + TRANS' (canonize eqv s) (SYM'(canonize eqv t));; + +let equivalence_class eqv a = snd(tryterminus eqv a);; + +(* ------------------------------------------------------------------------- *) +(* Prove composite terms equivalent based on 1-step congruence. *) +(* ------------------------------------------------------------------------- *) + +let provecongruent eqv (tm1,tm2) = + let f1,x1 = dest_comb tm1 + and f2,x2 = dest_comb tm2 in + MK_COMB'(prove_equal eqv (f1,f2),prove_equal eqv (x1,x2));; + +(* ------------------------------------------------------------------------- *) +(* Merge equivalence classes given equation "th", using congruence closure. *) +(* ------------------------------------------------------------------------- *) + +let rec emerge th (eqv,pfn) = + let s,t = concl' th in + let sth = canonize eqv s and tth = canonize eqv t in + let s' = snd(concl' sth) and t' = snd(concl' tth) in + if s' = t' then (eqv,pfn) else + let sp = tryapplyd pfn s' [] and tp = tryapplyd pfn t' [] in + let eqv' = equate th eqv in + let stth = canonize eqv' s' in + let sttm = snd(concl' stth) in + let pfn' = (sttm |-> union sp tp) pfn in + itlist (fun (u,v) (eqv,pfn as eqp) -> + try let thuv = provecongruent eqv (u,v) in emerge thuv eqp + with Failure _ -> eqp) + (allpairs (fun u v -> (u,v)) sp tp) (eqv',pfn');; + +(* ------------------------------------------------------------------------- *) +(* Find subterms of "tm" that contain as a subterm one of the "tms" terms. *) +(* This is intended to be more efficient than the obvious "find_terms ...". *) +(* ------------------------------------------------------------------------- *) + +let rec supersubterms tms tm = + let ltms,tms' = + if mem tm tms then [tm],filter (fun t -> t <> tm) tms + else [],tms in + if tms' = [] then ltms else + let stms = + try let l,r = dest_comb tm in + union (supersubterms tms' l) (supersubterms tms' r) + with Failure _ -> [] in + if stms = [] then ltms + else tm::stms;; + +(* ------------------------------------------------------------------------- *) +(* Find an appropriate term universe for overall terms "tms". *) +(* ------------------------------------------------------------------------- *) + +let term_universe tms = + setify (itlist ((@) o supersubterms tms) tms []);; + +(* ------------------------------------------------------------------------- *) +(* Congruence closure of "eqs" over term universe "tms". *) +(* ------------------------------------------------------------------------- *) + +let congruence_closure tms eqs = + let pfn = predecessor_function tms in + let eqv,_ = itlist emerge eqs (unequal,pfn) in + eqv;; + +(* ------------------------------------------------------------------------- *) +(* Prove that "eq" follows from "eqs" by congruence closure. *) +(* ------------------------------------------------------------------------- *) + +let CCPROVE eqs eq = + let tps = dest_eq eq :: map concl' eqs in + let otms = itlist (fun (x,y) l -> x::y::l) tps [] in + let tms = term_universe(setify otms) in + let eqv = congruence_closure tms eqs in + prove_equal eqv (dest_eq eq);; + +(* ------------------------------------------------------------------------- *) +(* Inference rule for `eq1 /\ ... /\ eqn ==> eq` *) +(* ------------------------------------------------------------------------- *) + +let CONGRUENCE_CLOSURE tm = + if is_imp tm then + let eqs,eq = dest_imp tm in + DISCH eqs (lazy_eval(CCPROVE (map lazy_eq (CONJUNCTS(ASSUME eqs))) eq)) + else lazy_eval(CCPROVE [] tm);; + +(* ------------------------------------------------------------------------- *) +(* Inference rule for contradictoriness of set of +ve and -ve eqns. *) +(* ------------------------------------------------------------------------- *) + +let CONGRUENCE_CLOSURE_CONTR ths = + let nths,pths = partition (is_neg o concl) ths in + let peqs = filter (is_eq o concl) pths + and neqs = filter (is_eq o rand o concl) nths in + let tps = map (dest_eq o concl) peqs @ map (dest_eq o rand o concl) neqs in + let otms = itlist (fun (x,y) l -> x::y::l) tps [] in + let tms = term_universe(setify otms) in + let eqv = congruence_closure tms (map lazy_eq peqs) in + let prover th = + let eq = dest_eq(rand(concl th)) in + let lth = prove_equal eqv eq in + EQ_MP (EQF_INTRO th) (lazy_eval lth) in + tryfind prover neqs;; + +(* ------------------------------------------------------------------------- *) +(* Attempt to prove equality between terms/formulas based on equivalence. *) +(* Note that ABS sideconditions are only checked at inference-time... *) +(* ------------------------------------------------------------------------- *) + +let ABS' v = + fun (Lazy((s,t),f)) -> + Lazy((mk_abs(v,s),mk_abs(v,t)), + cache(fun () -> ABS v (f ())));; + +let ALPHA_EQ' s' t' = + fun (Lazy((s,t),f) as inp) -> + if s' = s & t' = t then inp else + Lazy((s',t'), + cache(fun () -> EQ_MP (ALPHA (mk_eq(s,t)) (mk_eq(s',t'))) + (f ())));; + +let rec PROVE_EQUAL eqv (tm1,tm2 as tmp) = + if tm1 = tm2 then REFL' tm1 else + try prove_equal eqv tmp with Failure _ -> + if is_comb tm1 & is_comb tm2 then + let f1,x1 = dest_comb tm1 + and f2,x2 = dest_comb tm2 in + MK_COMB'(PROVE_EQUAL eqv (f1,f2),PROVE_EQUAL eqv (x1,x2)) + else if is_abs tm1 & is_abs tm2 then + let x1,bod1 = dest_abs tm1 + and x2,bod2 = dest_abs tm2 in + let gv = genvar(type_of x1) in + ALPHA_EQ' tm1 tm2 + (ABS' x1 (PROVE_EQUAL eqv (vsubst[gv,x1] bod1,vsubst[gv,x2] bod2))) + else failwith "PROVE_EQUAL";; + +let PROVE_EQUIVALENT eqv tm1 tm2 = lazy_eval (PROVE_EQUAL eqv (tm1,tm2));; + +(* ------------------------------------------------------------------------- *) +(* Complementary version for formulas. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_COMPLEMENTARY eqv th1 th2 = + let tm1 = concl th1 and tm2 = concl th2 in + if is_neg tm1 then + let th = PROVE_EQUIVALENT eqv (rand tm1) tm2 in + EQ_MP (EQF_INTRO th1) (EQ_MP (SYM th) th2) + else if is_neg tm2 then + let th = PROVE_EQUIVALENT eqv (rand tm2) tm1 in + EQ_MP (EQF_INTRO th2) (EQ_MP (SYM th) th1) + else failwith "PROVE_COMPLEMENTARY";; + +(* ------------------------------------------------------------------------- *) +(* Check equality under equivalence with "env" mapping for first term. *) +(* ------------------------------------------------------------------------- *) + +let rec test_eq eqv (tm1,tm2) env = + if is_comb tm1 & is_comb tm2 then + let f1,x1 = dest_comb tm1 + and f2,x2 = dest_comb tm2 in + test_eq eqv (f1,f2) env & test_eq eqv (x1,x2) env + else if is_abs tm1 & is_abs tm2 then + let x1,bod1 = dest_abs tm1 + and x2,bod2 = dest_abs tm2 in + let gv = genvar(type_of x1) in + test_eq eqv (vsubst[gv,x1] bod1,vsubst[gv,x2] bod2) env + else if is_var tm1 & can (rev_assoc tm1) env then + test_eq eqv (rev_assoc tm1 env,tm2) [] + else can (prove_equal eqv) (tm1,tm2);; + +(* ------------------------------------------------------------------------- *) +(* Map a term to its equivalence class modulo equivalence *) +(* ------------------------------------------------------------------------- *) + +let rec term_equivs eqv tm = + let l = equivalence_class eqv tm in + if l <> [tm] then l + else if is_comb tm then + let f,x = dest_comb tm in + allpairs (curry mk_comb) (term_equivs eqv f) (term_equivs eqv x) + else if is_abs tm then + let v,bod = dest_abs tm in + let gv = genvar(type_of v) in + map (fun t -> alpha v (mk_abs(gv,t))) (term_equivs eqv (vsubst [gv,v] bod)) + else [tm];; + +(* ------------------------------------------------------------------------- *) +(* Replace "outer" universal variables with genvars. This is "outer" in the *) +(* second sense, i.e. universals not in scope of an existential or negation. *) +(* ------------------------------------------------------------------------- *) + +let rec GENSPEC th = + let tm = concl th in + if is_forall tm then + let v = bndvar(rand tm) in + let gv = genvar(type_of v) in + GENSPEC(SPEC gv th) + else if is_conj tm then + let th1,th2 = CONJ_PAIR th in + CONJ (GENSPEC th1) (GENSPEC th2) + else if is_disj tm then + let th1 = GENSPEC(ASSUME(lhand tm)) + and th2 = GENSPEC(ASSUME(rand tm)) in + let th3 = DISJ1 th1 (concl th2) + and th4 = DISJ2 (concl th1) th2 in + DISJ_CASES th th3 th4 + else th;; + +(* ------------------------------------------------------------------------- *) +(* Simple first-order matching. *) +(* ------------------------------------------------------------------------- *) + +let rec term_fmatch vars vtm ctm env = + if mem vtm vars then + if can (rev_assoc vtm) env then + term_fmatch vars (rev_assoc vtm env) ctm env + else if aconv vtm ctm then env else (ctm,vtm)::env + else if is_comb vtm & is_comb ctm then + let fv,xv = dest_comb vtm + and fc,xc = dest_comb ctm in + term_fmatch vars fv fc (term_fmatch vars xv xc env) + else if is_abs vtm & is_abs ctm then + let xv,bodv = dest_abs vtm + and xc,bodc = dest_abs ctm in + let gv = genvar(type_of xv) and gc = genvar(type_of xc) in + let gbodv = vsubst [gv,xv] bodv + and gbodc = vsubst [gc,xc] bodc in + term_fmatch (gv::vars) gbodv gbodc ((gc,gv)::env) + else if vtm = ctm then env + else failwith "term_fmatch";; + +let rec check_consistency env = + match env with + [] -> true + | (c,v)::es -> forall (fun (c',v') -> v' <> v or c' = c) es;; + +let separate_insts env = + let tyin = itlist (fun (c,v) -> type_match (type_of v) (type_of c)) + env [] in + let ifn(c,v) = (inst tyin c,inst tyin v) in + let tmin = setify (map ifn env) in + if check_consistency tmin then (tmin,tyin) + else failwith "separate_insts";; + +let first_order_match vars vtm ctm env = + let env' = term_fmatch vars vtm ctm env in + if can separate_insts env' then env' else failwith "first_order_match";; + +(* ------------------------------------------------------------------------- *) +(* Try to match all leaves to negation of auxiliary propositions. *) +(* ------------------------------------------------------------------------- *) + +let matchleaves = + let rec matchleaves vars vtm ctms env cont = + if is_conj vtm then + try matchleaves vars (rand vtm) ctms env cont + with Failure _ -> matchleaves vars (lhand vtm) ctms env cont + else if is_disj vtm then + matchleaves vars (lhand vtm) ctms env + (fun e -> matchleaves vars (rand vtm) ctms e cont) + else + tryfind (fun ctm -> cont (first_order_match vars vtm ctm env)) ctms in + fun vars vtm ctms env -> matchleaves vars vtm ctms env (fun e -> e);; + +(* ------------------------------------------------------------------------- *) +(* Now actually do the refutation once theorem is instantiated. *) +(* ------------------------------------------------------------------------- *) + +let rec REFUTE_LEAVES eqv cths th = + let tm = concl th in + if is_conj tm then + try REFUTE_LEAVES eqv cths (CONJUNCT1 th) + with Failure _ -> REFUTE_LEAVES eqv cths (CONJUNCT2 th) + else if is_disj tm then + let th1 = REFUTE_LEAVES eqv cths (ASSUME(lhand tm)) + and th2 = REFUTE_LEAVES eqv cths (ASSUME(rand tm)) in + DISJ_CASES th th1 th2 + else + tryfind (PROVE_COMPLEMENTARY eqv th) cths;; + +(* ------------------------------------------------------------------------- *) +(* Hence the Mizar "unifier" for given universal formula. *) +(* ------------------------------------------------------------------------- *) + +let negate tm = if is_neg tm then rand tm else mk_neg tm;; + +let MIZAR_UNIFIER eqv ths th = + let gth = GENSPEC th in + let vtm = concl gth in + let vars = subtract (frees vtm) (frees(concl th)) + and ctms = map (negate o concl) ths in + let allctms = itlist (union o term_equivs eqv) ctms [] in + let env = matchleaves vars vtm allctms [] in + let tmin,tyin = separate_insts env in + REFUTE_LEAVES eqv ths (PINST tyin tmin gth);; + +(* ------------------------------------------------------------------------- *) +(* Deduce disequalities of subterms and add symmetric versions at the end. *) +(* ------------------------------------------------------------------------- *) + +let rec DISEQUALITIES ths = + match ths with + [] -> [] + | th::oths -> + let t1,t2 = dest_eq (rand(concl th)) in + let f1,args1 = strip_comb t1 + and f2,args2 = strip_comb t2 in + if f1 <> f2 or length args1 <> length args2 + then th::(GSYM th)::(DISEQUALITIES oths) else + let zargs = zip args1 args2 in + let diffs = filter (fun (a1,a2) -> a1 <> a2) zargs in + if length diffs <> 1 then th::(GSYM th)::(DISEQUALITIES oths) else + let eths = map (fun (a1,a2) -> + if a1 = a2 then REFL a1 else ASSUME(mk_eq(a1,a2))) zargs in + let th1 = rev_itlist (fun x y -> MK_COMB(y,x)) eths (REFL f1) in + let th2 = + MP (GEN_REWRITE_RULE I [GSYM CONTRAPOS_THM] (DISCH_ALL th1)) th in + th::(GSYM th)::(DISEQUALITIES(th2::oths));; + +(* ------------------------------------------------------------------------- *) +(* Get such a starting inequality from complementary literals. *) +(* ------------------------------------------------------------------------- *) + +let ATOMINEQUALITIES th1 th2 = + let t1 = concl th1 and t2' = concl th2 in + let t2 = dest_neg t2' in + let f1,args1 = strip_comb t1 + and f2,args2 = strip_comb t2 in + if f1 <> f2 or length args1 <> length args2 then [] else + let zargs = zip args1 args2 in + let diffs = filter (fun (a1,a2) -> a1 <> a2) zargs in + if length diffs <> 1 then [] else + let eths = map (fun (a1,a2) -> + if a1 = a2 then REFL a1 else ASSUME(mk_eq(a1,a2))) zargs in + let th3 = rev_itlist (fun x y -> MK_COMB(y,x)) eths (REFL f1) in + let th4 = EQ_MP (TRANS th3 (EQF_INTRO th2)) th1 in + let th5 = NOT_INTRO(itlist (DISCH o mk_eq) diffs th4) in + [itlist PROVE_HYP [th1; th2] th5];; + +(* ------------------------------------------------------------------------- *) +(* Basic prover. *) +(* ------------------------------------------------------------------------- *) + +let BASIC_MIZARBY ths = + try let nths,pths = partition (is_neg o concl) ths in + let peqs,pneqs = partition (is_eq o concl) pths + and neqs,nneqs = partition (is_eq o rand o concl) nths in + let tps = map (dest_eq o concl) peqs @ + map (dest_eq o rand o concl) neqs in + let otms = itlist (fun (x,y) l -> x::y::l) tps [] in + let tms = term_universe(setify otms) in + let eqv = congruence_closure tms (map lazy_eq peqs) in + let eqprover th = + let s,t = dest_eq(rand(concl th)) in + let th' = PROVE_EQUIVALENT eqv s t in + EQ_MP (EQF_INTRO th) th' + and contrprover thp thn = + let th = PROVE_EQUIVALENT eqv (concl thp) (rand(concl thn)) in + EQ_MP (TRANS th (EQF_INTRO thn)) thp in + try tryfind eqprover neqs with Failure _ -> + try tryfind (fun thp -> tryfind (contrprover thp) nneqs) pneqs + with Failure _ -> + let new_neqs = unions(allpairs ATOMINEQUALITIES pneqs nneqs) in + let allths = pneqs @ nneqs @ peqs @ DISEQUALITIES(neqs @ new_neqs) in + tryfind (MIZAR_UNIFIER eqv allths) + (filter (is_forall o concl) allths) + with Failure _ -> failwith "BASIC_MIZARBY";; + +(* ------------------------------------------------------------------------- *) +(* Put it all together. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_REFUTER ths = PRECHECKER_THEN BASIC_MIZARBY ths;; + +(* ------------------------------------------------------------------------- *) +(* The Mizar prover for getting a conclusion from hypotheses. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_BY = + let pth = TAUT `(~p ==> F) <=> p` and p_tm = `p:bool` in + fun ths tm -> + let tm' = mk_neg tm in + let th0 = ASSUME tm' in + let th1 = MIZAR_REFUTER (th0::ths) in + EQ_MP (INST [tm,p_tm] pth) (DISCH tm' th1);; + +(* ------------------------------------------------------------------------- *) +(* As a standalone prover of formulas. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_RULE tm = MIZAR_BY [] tm;; + +(* ------------------------------------------------------------------------- *) +(* Some additional stuff for HOL. *) +(* ------------------------------------------------------------------------- *) + +let HOL_BY = + let BETASET_CONV = + TOP_DEPTH_CONV GEN_BETA_CONV THENC REWRITE_CONV[IN_ELIM_THM] + and BUILTIN_CONV tm = + try EQT_ELIM(NUM_REDUCE_CONV tm) with Failure _ -> + try EQT_ELIM(REAL_RAT_REDUCE_CONV tm) with Failure _ -> + try ARITH_RULE tm with Failure _ -> + try REAL_ARITH tm with Failure _ -> + failwith "BUILTIN_CONV" in + fun ths tm -> + try MIZAR_BY ths tm with Failure _ -> + try tryfind (fun th -> PART_MATCH I th tm) ths with Failure _ -> + try let avs,bod = strip_forall tm in + let gvs = map (genvar o type_of) avs in + let gtm = vsubst (zip gvs avs) bod in + let th = tryfind (fun th -> PART_MATCH I th gtm) ths in + let gth = GENL gvs th in + EQ_MP (ALPHA (concl gth) tm) gth + with Failure _ -> try + (let ths' = map BETA_RULE ths + and th' = TOP_DEPTH_CONV BETA_CONV tm in + let tm' = rand(concl th') in + try EQ_MP (SYM th') (tryfind (fun th -> PART_MATCH I th tm') ths) + with Failure _ -> try EQ_MP (SYM th') (BUILTIN_CONV tm') + with Failure _ -> + let ths'' = map (CONV_RULE BETASET_CONV) ths' + and th'' = TRANS th' (BETASET_CONV tm') in + EQ_MP (SYM th'') (prove(rand(concl th''),MESON_TAC ths''))) + with Failure _ -> failwith "HOL_BY";; + +(* ------------------------------------------------------------------------- *) +(* Standalone prover, breaking down an implication first. *) +(* ------------------------------------------------------------------------- *) + +let HOL_RULE tm = + try let l,r = dest_imp tm in + DISCH l (HOL_BY (CONJUNCTS(ASSUME l)) r) + with Failure _ -> HOL_BY [] tm;; + +(* ------------------------------------------------------------------------- *) +(* Tautology examples (Pelletier problems). *) +(* ------------------------------------------------------------------------- *) + +let prop_1 = time HOL_RULE + `p ==> q <=> ~q ==> ~p`;; + +let prop_2 = time HOL_RULE + `~ ~p <=> p`;; + +let prop_3 = time HOL_RULE + `~(p ==> q) ==> q ==> p`;; + +let prop_4 = time HOL_RULE + `~p ==> q <=> ~q ==> p`;; + +let prop_5 = time HOL_RULE + `(p \/ q ==> p \/ r) ==> p \/ (q ==> r)`;; + +let prop_6 = time HOL_RULE + `p \/ ~p`;; + +let prop_7 = time HOL_RULE + `p \/ ~ ~ ~p`;; + +let prop_8 = time HOL_RULE + `((p ==> q) ==> p) ==> p`;; + +let prop_9 = time HOL_RULE + `(p \/ q) /\ (~p \/ q) /\ (p \/ ~q) ==> ~(~q \/ ~q)`;; + +let prop_10 = time HOL_RULE + `(q ==> r) /\ (r ==> p /\ q) /\ (p ==> q /\ r) ==> (p <=> q)`;; + +let prop_11 = time HOL_RULE + `p <=> p`;; + +let prop_12 = time HOL_RULE + `((p <=> q) <=> r) <=> (p <=> (q <=> r))`;; + +let prop_13 = time HOL_RULE + `p \/ q /\ r <=> (p \/ q) /\ (p \/ r)`;; + +let prop_14 = time HOL_RULE + `(p <=> q) <=> (q \/ ~p) /\ (~q \/ p)`;; + +let prop_15 = time HOL_RULE + `p ==> q <=> ~p \/ q`;; + +let prop_16 = time HOL_RULE + `(p ==> q) \/ (q ==> p)`;; + +let prop_17 = time HOL_RULE + `p /\ (q ==> r) ==> s <=> (~p \/ q \/ s) /\ (~p \/ ~r \/ s)`;; + +(* ------------------------------------------------------------------------- *) +(* Congruence closure examples. *) +(* ------------------------------------------------------------------------- *) + +time HOL_RULE + `(f(f(f(f(f(x))))) = x) /\ (f(f(f(x))) = x) ==> (f(x) = x)`;; + +time HOL_RULE + `(f(f(f(f(f(f(x)))))) = x) /\ (f(f(f(f(x)))) = x) ==> (f(f(x)) = x)`;; + +time HOL_RULE `(f a = a) ==> (f(f a) = a)`;; + +time HOL_RULE + `(a = f a) /\ ((g b (f a))=(f (f a))) /\ ((g a b)=(f (g b a))) + ==> (g a b = a)`;; + +time HOL_RULE + `((s(s(s(s(s(s(s(s(s(s(s(s(s(s(s a)))))))))))))))=a) /\ + ((s (s (s (s (s (s (s (s (s (s a))))))))))=a) /\ + ((s (s (s (s (s (s a))))))=a) + ==> (a = s a)`;; + +time HOL_RULE `(u = v) ==> (P u <=> P v)`;; + +time HOL_RULE + `(b + c + d + e + f + g + h + i + j + k + l + m = + m + l + k + j + i + h + g + f + e + d + c + b) + ==> (a + b + c + d + e + f + g + h + i + j + k + l + m = + a + m + l + k + j + i + h + g + f + e + d + c + b)`;; + +time HOL_RULE + `(f(f(f(f(a)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ + something(irrelevant) /\ (11 + 12 = 23) /\ + (f(f(f(f(b)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ + ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ + P(f(f(f(a)))) ==> P(f(a))`;; + +time HOL_RULE + `((a = b) \/ (c = d)) /\ ((a = c) \/ (b = d)) ==> (a = d) \/ (b = c)`;; + +(* ------------------------------------------------------------------------- *) +(* Various combined examples. *) +(* ------------------------------------------------------------------------- *) + +time HOL_RULE + `(f(f(f(f(a:A)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ + something(irrelevant) /\ (11 + 12 = 23) /\ + (f(f(f(f(b:A)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ + ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ + P(f(a)) /\ ~(f(f(f(a))) = f(a)) ==> ?x. P(f(f(f(x))))`;; + +time HOL_RULE + `(f(f(f(f(a:A)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ + something(irrelevant) /\ (11 + 12 = 23) /\ + (f(f(f(f(b:A)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ + ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ + P(f(a)) + ==> P(f(f(f(a))))`;; + +time HOL_RULE + `(f(f(f(f(a:A)))) = a) /\ (f(f(f(f(f(f(a)))))) = a) /\ + something(irrelevant) /\ (11 + 12 = 23) /\ + (f(f(f(f(b:A)))) = f(f(f(f(f(f(f(f(f(f(c))))))))))) /\ + ~(otherthing) /\ ~(f(a) = a) /\ ~(f(b) = b) /\ + P(f(a)) + ==> ?x. P(f(f(f(x))))`;; + +time HOL_RULE + `(a = f a) /\ ((g b (f a))=(f (f a))) /\ ((g a b)=(f (g b a))) /\ + (!x y. ~P (g x y)) + ==> ~P(a)`;; + +time HOL_RULE + `(!x y. x + y = y + x) /\ (1 + 2 = x) /\ (x = 3) ==> (3 = 2 + 1)`;; + +time HOL_RULE + `(!x:num y. x + y = y + x) ==> (1 + 2 = 2 + 1)`;; + +time HOL_RULE + `(!x:num y. ~(x + y = y + x)) ==> ~(1 + 2 = 2 + 1)`;; + +time HOL_RULE + `(1 + 2 = 2 + 1) ==> ?x:num y. x + y = y + x`;; + +time HOL_RULE + `(1 + x = x + 1) ==> ?x:num y. x + y = y + x`;; + +time (HOL_BY []) `?x. P x ==> !y. P y`;; + +(* ------------------------------------------------------------------------- *) +(* Testing the HOL extensions. *) +(* ------------------------------------------------------------------------- *) + +time HOL_RULE `1 + 1 = 2`;; + +time HOL_RULE `(\x. x + 1) 2 = 2 + 1`;; + +time HOL_RULE `!x. x < 2 ==> 2 * x <= 3`;; + +time HOL_RULE `y IN {x | x < 2} <=> y < 2`;; + +time HOL_RULE `(!x. (x = a) \/ x > a) ==> (1 + x = a) \/ 1 + x > a`;; + +time HOL_RULE `(\(x,y). x + y)(1,2) + 5 = (1 + 2) + 5`;; + +(* ------------------------------------------------------------------------- *) +(* These and only these should go to MESON. *) +(* ------------------------------------------------------------------------- *) + +print_string "***** Now the following (only) should use MESON"; +print_newline();; + +time HOL_RULE `?x y. x = y`;; + +time HOL_RULE `(!Y X Z. p(X,Y) /\ p(Y,Z) ==> p(X,Z)) /\ + (!Y X Z. q(X,Y) /\ q(Y,Z) ==> q(X,Z)) /\ + (!Y X. q(X,Y) ==> q(Y,X)) /\ + (!X Y. p(X,Y) \/ q(X,Y)) + ==> p(a,b) \/ q(c,d)`;; + +time HOL_BY [PAIR_EQ] `(1,2) IN {(x,y) | x < y} <=> 1 < 2`;; + +HOL_BY [] `?x. !y. P x ==> P y`;; diff --git a/Examples/inverse_bug_puzzle_miz3.ml b/Examples/inverse_bug_puzzle_miz3.ml new file mode 100644 index 0000000..ece5e80 --- /dev/null +++ b/Examples/inverse_bug_puzzle_miz3.ml @@ -0,0 +1,489 @@ +(* ========================================================================= *) +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* Proof of the Bug Puzzle conjecture of the HOL Light tutorial: *) +(* Any two triples with the same oriented area can be connected in *) +(* 5 moves or less (FiveMovesOrLess). Also a proof that 4 moves is not *) +(* enough, with an explicit counterexample. This result (NOTENOUGH_4) *) +(* is due to John Harrison, as is much of the basic vector code, and *) +(* the definition of move, which defines a closed subset *) +(* {(A,B,C,A',B',C') | move (A,B,C) (A',B',C')} subset R^6 x R^6 *) +(* and also a result FiveMovesOrLess_STRONG that handles the degenerate *) +(* case (the two triples not required to be non-collinear), which has a *) +(* very satisfying answer using this "closed" definition of move. *) +(* *) +(* The mathematical proofs are essentially due to Tom Hales. The *) +(* code is all in miz3, and was an attempt to explore Freek Wiedijk's *) +(* vision of mixing the procedural and declarative proof styles. *) +(* ========================================================================= *) + +needs "Multivariate/determinants.ml";; + +#load "unix.cma";; +loadt "miz3/miz3.ml";; + +new_type_abbrev("triple",`:real^2#real^2#real^2`);; + +default_prover := ("ya prover", + fun thl -> REWRITE_TAC thl THEN CONV_TAC (HOL_BY thl));; + +horizon := 0;; +timeout := 500;; + +let VEC2_TAC = + SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; + vector_add; vec; dot; orthogonal; basis; + vector_neg; vector_sub; vector_mul; ARITH] THEN + CONV_TAC REAL_RING;; + +let COLLINEAR_3_2Dzero = thm `; + !y z:real^2. collinear{vec 0,y,z} <=> + z$1 * y$2 = y$1 * z$2 + by REWRITE_TAC[COLLINEAR_3_2D] THEN VEC2_TAC; +`;; + +let Noncollinear_3ImpliesDistinct = thm `; + !a b c:real^N. ~collinear {a,b,c} ==> ~(a = b) /\ ~(a = c) /\ ~(b = c) + by COLLINEAR_BETWEEN_CASES, BETWEEN_REFL; +`;; + +let collinearSymmetry = thm `; + let A B C be real^N; + thus collinear {A,B,C} ==> collinear {A,C,B} /\ collinear {B,A,C} /\ + collinear {B,C,A} /\ collinear {C,A,B} /\ collinear {C,B,A} + + proof + {A,C,B} SUBSET {A,B,C} /\ {B,A,C} SUBSET {A,B,C} /\ {B,C,A} SUBSET {A,B,C} /\ + {C,A,B} SUBSET {A,B,C} /\ {C,B,A} SUBSET {A,B,C} by SET_RULE; + qed by -, COLLINEAR_SUBSET; +`;; + +let Noncollinear_2Span = thm `; + let u v w be real^2; + assume ~collinear {vec 0,v,w} [H1]; + thus ? s t. s % v + t % w = u + + proof + !n r. ~(r < n) /\ r <= MIN n n ==> r = n [easy_arith] by ARITH_RULE; + ~(w$1 * v$2 = v$1 * w$2) [H1'] by H1, COLLINEAR_3_2Dzero; + consider M such that + M = transp(vector[v;w]):real^2^2 [Mexists]; + det M = v$1 * w$2 - w$1 * v$2 by -, DIMINDEX_2, SUM_2, TRANSP_COMPONENT, VECTOR_2, LAMBDA_BETA, ARITH, CART_EQ, FORALL_2, DET_2; + ~(det M = &0) by -, H1', REAL_ARITH; + consider x s t such that + M ** x = u /\ s = x$1 /\ t = x$2 by -, easy_arith, DET_EQ_0_RANK, RANK_BOUND, MATRIX_FULL_LINEAR_EQUATIONS; + v$1 * s + w$1 * t = u$1 /\ v$2 * s + w$2 * t = u$2 by Mexists, -, SIMP_TAC[matrix_vector_mul; DIMINDEX_2; SUM_2; TRANSP_COMPONENT; VECTOR_2; LAMBDA_BETA; ARITH; CART_EQ; FORALL_2] THEN MESON_TAC[]; + s % v + t % w = u by -, REAL_MUL_SYM, VECTOR_MUL_COMPONENT, VECTOR_ADD_COMPONENT, VEC2_TAC; + qed by -; +`;; + +let oriented_area = new_definition + `oriented_area (a:real^2,b:real^2,c:real^2) = + ((b$1 - a$1) * (c$2 - a$2) - (c$1 - a$1) * (b$2 - a$2)) / &2`;; + +let oriented_areaSymmetry = thm `; + !A B C A' B' C':real^2. + oriented_area (A,B,C) = oriented_area(A',B',C') ==> + oriented_area (B,C,A) = oriented_area (B',C',A') /\ + oriented_area (C,A,B) = oriented_area (C',A',B') /\ + oriented_area (A,C,B) = oriented_area (A',C',B') /\ + oriented_area (B,A,C) = oriented_area (B',A',C') /\ + oriented_area (C,B,A) = oriented_area (C',B',A') + by REWRITE_TAC[oriented_area] THEN VEC2_TAC; +`;; + +let move = new_definition + `!A B C A' B' C':real^2. move (A,B,C) (A',B',C') <=> + (B = B' /\ C = C' /\ collinear {vec 0,C - B,A' - A} \/ + A = A' /\ C = C' /\ collinear {vec 0,C - A,B' - B} \/ + A = A' /\ B = B' /\ collinear {vec 0,B - A,C' - C})`;; + +let moveInvariant = thm `; + let p p' be triple; + assume move p p' [H1]; + thus oriented_area p = oriented_area p' + + proof + consider X Y Z X' Y' Z' such that + p = X,Y,Z /\ p' = X',Y',Z' [pDef] by PAIR_SURJECTIVE; + move (X,Y,Z) (X',Y',Z') by -, H1; + oriented_area (X,Y,Z) = oriented_area (X',Y',Z') by -, SIMP_TAC[move; oriented_area; COLLINEAR_3; COLLINEAR_3_2Dzero] THEN VEC2_TAC; + qed by -, pDef; +`;; + +let reachable = new_definition + `!p p'. + reachable p p' <=> ?n. ?s. + s 0 = p /\ s n = p' /\ + (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; + +let reachableN = new_definition + `!p p'. !n. + reachableN p p' n <=> ?s. + s 0 = p /\ s n = p' /\ + (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; + +let ReachLemma = thm `; + !p p'. reachable p p' <=> ?n. reachableN p p' n + by reachable, reachableN; +`;; + +let reachableN_CLAUSES = thm `; + ! p p'. (reachableN p p' 0 <=> p = p') /\ + ! n. reachableN p p' (SUC n) <=> ? q. reachableN p q n /\ move q p' + + proof + let p p' be triple; + consider s0 such that + s0 = \m:num. p'; + reachableN p p' 0 <=> p = p' [0CLAUSE] by -, reachableN, LT, LE_0; + ! n. reachableN p p' (SUC n) ==> ? q. reachableN p q n /\ move q p' [Imp1] + proof + let n be num; + assume reachableN p p' (SUC n) [H1]; + consider s such that + s 0 = p /\ s (SUC n) = p' /\ !m. m < SUC n ==> move (s m) (s (SUC m)) [sDef] by H1, LE_0, reachableN; + consider q such that q = s n; + qed by sDef, -, LE_0, reachableN, LT; + ! n. (? q. reachableN p q n /\ move q p') ==> reachableN p p' (SUC n) + proof + let n be num; + assume ? q. reachableN p q n /\ move q p'; + consider q such that + reachableN p q n /\ move q p' [qExists] by -; + consider s such that + s 0 = p /\ s n = q /\ !m. m < n ==> move (s m) (s (SUC m)) [sDef] by -, reachableN, LT, LE_0; + consider t such that + t = \m. if m < SUC n then s m else p'; + t 0 = p /\ t (SUC n) = p' /\ !m. m < SUC n ==> move (t m) (t (SUC m)) [tProp] by qExists, sDef, -, LT_0, LT_REFL, LT, LT_SUC; + qed by -, reachableN, LT, LE_0; + qed by 0CLAUSE, Imp1, -; +`;; + +let reachableInvariant = thm `; + !p p':triple. reachable p p' ==> + oriented_area p = oriented_area p' + + proof + !n. !p p'. reachableN p p' n ==> oriented_area p = oriented_area p' by INDUCT_TAC THEN ASM_MESON_TAC[reachableN_CLAUSES; moveInvariant]; + qed by -, ReachLemma; +`;; + +let move2Cond = new_definition + `move2Cond (A,B,C) (A',B',C') <=> + ~collinear {B,A,A'} /\ ~collinear {A',B,B'} \/ + ~collinear {A,B,B'} /\ ~collinear {B',A,A'}`;; + +let reachableN_Two = thm `; + !P0 P2:triple. reachableN P0 P2 2 <=> + ?P1. move P0 P1 /\ move P1 P2 + by ONE, TWO, reachableN_CLAUSES; +`;; + +let reachableN_Three = thm `; + !P0 P3:triple. reachableN P0 P3 3 <=> + ?P1 P2. move P0 P1 /\ move P1 P2 /\ move P2 P3 + + proof + 3 = SUC 2 by ARITH_RULE; + qed by -, reachableN_Two, reachableN_CLAUSES; +`;; + +let reachableN_Four = thm `; + !P0 P4:triple. reachableN P0 P4 4 <=> + ?P1 P2 P3. move P0 P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 + + proof + 4 = SUC 3 by ARITH_RULE; + qed by -, reachableN_Three, reachableN_CLAUSES; +`;; + +let moveSymmetry = thm `; + let A B C A' B' C' be real^2; + assume move (A,B,C) (A',B',C') [H1]; + thus move (B,C,A) (B',C',A') /\ move (C,A,B) (C',A',B') /\ + move (A,C,B) (A',C',B') /\ move (B,A,C) (B',A',C') /\ move (C,B,A) (C',B',A') + + proof + !A B C A':real^2. collinear {vec 0, C - B, A' - A} ==> + collinear {vec 0, B - C, A' - A} by REWRITE_TAC[COLLINEAR_3_2Dzero] THEN VEC2_TAC; + qed by H1, -, move; +`;; + +let reachableNSymmetry = thm `; + ! A B C A' B' C' n. reachableN (A,B,C) (A',B',C') n ==> + reachableN (B,C,A) (B',C',A') n /\ reachableN (C,A,B) (C',A',B') n /\ + reachableN (A,C,B) (A',C',B') n /\ reachableN (B,A,C) (B',A',C') n /\ + reachableN (C,B,A) (C',B',A') n + + proof + let A B C be real^2; + consider Q such that Q = \n A' B' C'. + reachableN (B,C,A) (B',C',A') n /\ reachableN (C,A,B) (C',A',B') n /\ + reachableN (A,C,B) (A',C',B') n /\ reachableN (B,A,C) (B',A',C') n /\ + reachableN (C,B,A) (C',B',A') n [Qdef]; + consider P such that + P = \n. ! A' B' C'. reachableN (A,B,C) (A',B',C') n ==> Q n A' B' C' [Pdef]; + P 0 [Base] by -, Qdef, reachableN_CLAUSES, PAIR_EQ; + !n. P n ==> P (SUC n) + proof + let n be num; + assume P n [Pn]; + ! A' B' C'. reachableN (A,B,C) (A',B',C') (SUC n) ==> Q (SUC n) A' B' C' + proof + let A' B' C' be real^2; + assume reachableN (A,B,C) (A',B',C') (SUC n); + consider X Y Z such that + reachableN (A,B,C) (X,Y,Z) n /\ move (X,Y,Z) (A',B',C') [XYZdef] by -, reachableN_CLAUSES, PAIR_SURJECTIVE; + qed by -, Qdef, Pdef, Pn, XYZdef, moveSymmetry, reachableN_CLAUSES; + qed by -, Pdef; + !n. P n by Base, -, INDUCT_TAC; + qed by -, Pdef, Qdef; +`;; + +let ORIENTED_AREA_COLLINEAR_CONG = thm `; + let A B C A' B' C' be real^2; + assume oriented_area (A,B,C) = oriented_area (A',B',C') [H1]; + thus collinear {A,B,C} <=> collinear {A',B',C'} + by H1, REWRITE_TAC[COLLINEAR_3_2D; oriented_area] THEN CONV_TAC REAL_RING; +`;; + +let Basic2move_THM = thm `; + let A B C A' be real^2; + assume ~collinear {A,B,C} [H1]; + assume ~collinear {B,A,A'} [H2]; + thus ? X. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) + + proof + !r. r % (A - B) = (--r) % (B - A) /\ r % (A - B) = r % (A - B) + &0 % (C - B) [add0vector_mul] by VEC2_TAC; + ~ ? r. A' - A = r % (A - B) [H2'] by H2, COLLINEAR_3, COLLINEAR_LEMMA, -; + consider r t such that + A' - A = r % (A - B) + t % (C - B) [rExists] by H1, COLLINEAR_3, Noncollinear_2Span; + ~(t = &0) [tNonzero] by -, add0vector_mul, H2'; + consider s X such that + s = r / t /\ X = C + s % (A - B) [Xexists] by rExists; + A' - A = (t * s) % (A - B) + t % (C - B) by rExists, -, tNonzero, REAL_DIV_LMUL; + A' - A = t % (X - B) [tProp] by -, Xexists, VEC2_TAC; + X - C = (-- s) % (B - A) by -, Xexists, VEC2_TAC; + collinear {vec 0,B - A,X - C} /\ collinear {vec 0,X - B,A' - A} by -, tProp, COLLINEAR_LEMMA; + qed by -, move; +`;; + +let FourStepMoveAB = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} [H1]; + assume ~collinear {B,A,A'} /\ ~collinear {A',B,B'} [H2]; + thus ? X Y. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) /\ + move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y) + + proof + consider X such that + move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) [ABX] by H1, H2, -, Basic2move_THM; + ~collinear {A,B,X} /\ ~collinear {A',B,X} by H1, -, moveInvariant, ORIENTED_AREA_COLLINEAR_CONG; + ~collinear {B,A',X} by -, collinearSymmetry; + consider Y such that + move (B,A',X) (B,A',Y) /\ move (B,A',Y) (B',A',Y) by -, H2, Basic2move_THM; + move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y) by -, moveSymmetry; + qed by -, ABX; +`;; + +let FourStepMoveABBAreach = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} [H1]; + assume move2Cond (A,B,C) (A',B',C') [H2]; + thus ? Y. reachableN (A,B,C) (A',B',Y) 4 + + proof + cases by H2, move2Cond; + suppose ~collinear {B,A,A'} /\ ~collinear {A',B,B'}; + qed by H1, -, FourStepMoveAB, reachableN_Four; + suppose ~collinear {A,B,B'} /\ ~collinear {B',A,A'} [Case2]; + ~collinear {B,A,C} by H1, collinearSymmetry; + consider X Y such that + move (B,A,C) (B,A,X) /\ move (B,A,X) (B',A,X) /\ + move (B',A,X) (B',A,Y) /\ move (B',A,Y) (B',A',Y) by -, Case2, FourStepMoveAB; + qed by -, moveSymmetry, reachableN_Four; + end; +`;; + +let NotMove2Impliescollinear = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; + assume ~(A = A') /\ ~(B = B') [H2]; + assume ~move2Cond (A,B,C) (A',B',C') [H3]; + thus collinear {A,B,A',B'} + + proof + ~(A = B) /\ ~(A' = B') [Distinct] by H1, Noncollinear_3ImpliesDistinct; + {A,B,A',B'} SUBSET {A,A',B,B'} /\ {A,B,A',B'} SUBSET {B,B',A',A} /\ + {A,B,A',B'} SUBSET {A',B',B,A} [set4symmetry] by SET_RULE; + cases by H3, move2Cond; + suppose collinear {B,A,A'} /\ collinear {A,B,B'}; + collinear {A,B,A'} /\ collinear {A,B,B'} by -, collinearSymmetry; + qed by Distinct, -, COLLINEAR_4_3; + suppose collinear {B,A,A'} /\ collinear {B',A,A'}; + collinear {A,A',B} /\ collinear {A,A',B'} by -, collinearSymmetry; + collinear {A,A',B,B'} by H2, -, COLLINEAR_4_3; + qed by -, set4symmetry, COLLINEAR_SUBSET; + suppose collinear {A',B,B'} /\ collinear {A,B,B'}; + collinear {B,B',A'} /\ collinear {B,B',A} by -, collinearSymmetry; + collinear {B,B',A',A} by H2, -, COLLINEAR_4_3; + qed by -, set4symmetry, COLLINEAR_SUBSET; + suppose collinear {A',B,B'} /\ collinear {B',A,A'}; + collinear {A',B',B} /\ collinear {A',B',A} by -, collinearSymmetry; + collinear {A',B',B,A} by Distinct, -, COLLINEAR_4_3; + qed by -, set4symmetry, COLLINEAR_SUBSET; + end; +`;; + +let DistinctImplies2moveable = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; + assume ~(A = A') /\ ~(B = B') /\ ~(C = C') [H2]; + thus move2Cond (A,B,C) (A',B',C') \/ move2Cond (B,C,A) (B',C',A') + + proof + {A, B, B'} SUBSET {A, B, A', B'} /\ {B,B',C} SUBSET {B,C,B',C'} [3subset4] by SET_RULE; + ~collinear {B,C,A} /\ ~collinear {B',C',A'} [H1'] by H1, collinearSymmetry; + assume ~(move2Cond (A,B,C) (A',B',C') \/ move2Cond (B,C,A) (B',C',A')); + ~move2Cond (A,B,C) (A',B',C') /\ ~move2Cond (B,C,A) (B',C',A') by -; + collinear {A, B, A', B'} /\ collinear {B,C,B',C'} by H1, H1', -, H2, NotMove2Impliescollinear; + collinear {A, B, B'} /\ collinear {B,B',C} by -, 3subset4, COLLINEAR_SUBSET; + collinear {A, B, C} by -, H2, COLLINEAR_3_TRANS; + qed by -, H1; +`;; + +let SameCdiffAB = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; + assume C = C' /\ ~(A = A') /\ ~(B = B') [H2]; + thus ? Y. reachableN (A,B,C) (Y,B',C') 2 \/ reachableN (A,B,C) (A',B',Y) 4 + + proof + {B,B',A} SUBSET {A,B,A',B'} /\ {A,B,C} SUBSET {B,B',A,C} [easy_set] by SET_RULE; + cases; + suppose ~collinear {C,B,B'}; + consider X such that + move (B,C,A) (B,C,X) /\ move (B,C,X) (B',C',X) by H1, collinearSymmetry, -, H2, Basic2move_THM; + qed by -, reachableN_Two, reachableNSymmetry; + suppose move2Cond (A,B,C) (A',B',C'); + qed by H1, -, FourStepMoveABBAreach; + suppose collinear {C,B,B'} /\ ~move2Cond (A,B,C) (A',B',C'); + collinear {B,B',A} /\ collinear {B,B',C} by H1, H2, -, NotMove2Impliescollinear, easy_set, COLLINEAR_SUBSET, collinearSymmetry; + qed by -, H2, COLLINEAR_4_3, easy_set, COLLINEAR_SUBSET, H1; + end; +`;; + +let FourMovesToCorrectTwo = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} /\ ~collinear {A',B',C'} [H1]; + thus ? n. n < 5 /\ ? Y. reachableN (A,B,C) (A',B',Y) n \/ + reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n + + proof + ~collinear {B,C,A} /\ ~collinear {B',C',A'} /\ ~collinear {C,A,B} /\ ~collinear {C',A',B'} [H1'] by H1, collinearSymmetry; + 0 < 5 /\ 2 < 5 /\ 3 < 5 /\ 4 < 5 [easy_arith] by ARITH_RULE; + cases; + suppose A = A' /\ B = B' /\ C = C' \/ A = A' /\ B = B' /\ ~(C = C') \/ + A = A' /\ ~(B = B') /\ C = C' \/ ~(A = A') /\ B = B' /\ C = C'; + reachableN (A,B,C) (A',B',C') 0 \/ reachableN (A,B,C) (A',B',C) 0 \/ + reachableN (A,B,C) (A',B,C') 0 \/ reachableN (A,B,C) (A,B',C') 0 by -, reachableN_CLAUSES; + qed by -, easy_arith; + suppose A = A' /\ ~(B = B') /\ ~(C = C') \/ + ~(A = A') /\ B = B' /\ ~(C = C') \/ ~(A = A') /\ ~(B = B') /\ C = C'; + qed by H1, H1', -, SameCdiffAB, reachableNSymmetry, easy_arith; + suppose ~(A = A') /\ ~(B = B') /\ ~(C = C'); + move2Cond (A,B,C) (A',B',C') \/ move2Cond (B,C,A) (B',C',A') by H1, -, DistinctImplies2moveable; + qed by H1, H1', -, FourStepMoveABBAreach, reachableNSymmetry, reachableN_Four, easy_arith; + end; +`;; + +let CorrectFinalPoint = thm `; + let A B C A' C' be real^2; + assume oriented_area (A,B,C) = oriented_area (A,B,C') [H1]; + thus move (A,B,C) (A,B,C') + + proof + ((B$1 - A$1) * (C$2 - A$2) - (C$1 - A$1) * (B$2 - A$2)) / &2 = + ((B$1 - A$1) * (C'$2 - A$2) - (C'$1 - A$1) * (B$2 - A$2)) / &2 by H1, oriented_area; + (C$1 - C'$1) * (B$2 - A$2) = (B$1 - A$1) * (C$2 - C'$2) by -, REAL_ARITH; + (C' - C)$1 * (B - A)$2 = (B - A)$1 * (C' - C)$2 by -, VEC2_TAC; + collinear {vec 0, B - A, C' - C} by -, COLLINEAR_3_2Dzero; + qed by -, move; +`;; + +let FiveMovesOrLess = thm `; + let A B C A' B' C' be real^2; + assume ~collinear {A,B,C} [H1]; + assume oriented_area (A,B,C) = oriented_area (A',B',C') [H2]; + thus ? n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n + + proof + ~collinear {A',B',C'} [H1'] by H1, H2, ORIENTED_AREA_COLLINEAR_CONG; + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~(A' = B') /\ ~(A' = C') /\ ~(B' = C') [Distinct] by H1, -, Noncollinear_3ImpliesDistinct; + consider n Y such that + n < 5 /\ (reachableN (A,B,C) (A',B',Y) n \/ + reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n) [2Correct] by H1, H1', FourMovesToCorrectTwo; + cases by 2Correct; + suppose reachableN (A,B,C) (A',B',Y) n [Case]; + oriented_area (A',B',Y) = oriented_area (A',B',C') by H2, -, ReachLemma, reachableInvariant; + move (A',B',Y) (A',B',C') by -, Distinct, CorrectFinalPoint; + qed by Case, -, reachableN_CLAUSES, 2Correct, LE_SUC_LT; + suppose reachableN (A,B,C) (A',Y,C') n [Case]; + oriented_area (A',C',Y) = oriented_area (A',C',B') by H2, -, ReachLemma, reachableInvariant, oriented_areaSymmetry; + move (A',Y,C') (A',B',C') by -, Distinct, CorrectFinalPoint, moveSymmetry; + qed by Case, -, reachableN_CLAUSES, 2Correct, LE_SUC_LT; + suppose reachableN (A,B,C) (Y,B',C') n [Case]; + oriented_area (B',C',Y) = oriented_area (B',C',A') by H2, -, ReachLemma, reachableInvariant, oriented_areaSymmetry; + move (Y,B',C') (A',B',C') by -, Distinct, CorrectFinalPoint, moveSymmetry; + qed by Case, -, reachableN_CLAUSES, 2Correct, LE_SUC_LT; + end; +`;; + +let NOTENOUGH_4 = thm `; + ?p0 p4. oriented_area p0 = oriented_area p4 /\ ~reachableN p0 p4 4 + + proof + consider p0 p4 such that + p0 = vector [&0;&0]:real^2,vector [&0;&1]:real^2,vector [&1;&0]:real^2 /\ + p4 = vector [&1;&1]:real^2,vector [&1;&2]:real^2,vector [&2;&1]:real^2 [p04Def]; + oriented_area p0 = oriented_area p4 [equal_areas] by -, ASM_REWRITE_TAC[oriented_area] THEN VEC2_TAC; + ~reachableN p0 p4 4 by p04Def, ASM_REWRITE_TAC[reachableN_Four; NOT_EXISTS_THM; FORALL_PAIR_THM; move; COLLINEAR_3_2Dzero; FORALL_VECTOR_2] THEN VEC2_TAC; + qed by equal_areas, -; +`;; + +let reachableN_Five = thm `; + !P0 P5:triple. reachableN P0 P5 5 <=> + ?P1 P2 P3 P4. move P0 P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 /\ move P4 P5 + + proof + 5 = SUC 4 by ARITH_RULE; + qed by -, reachableN_CLAUSES, reachableN_Four; +`;; + +let EasyCollinearMoves = thm `; + (!A A' B:real^2. move (A:real^2,B,B) (A',B,B)) /\ + !A B B' C:real^2. collinear {A:real^2,B,C} /\ collinear {A,B',C} + ==> move (A,B,C) (A,B',C) + by REWRITE_TAC[move; COLLINEAR_3_2D] THEN VEC2_TAC; +`;; + +let FiveMovesOrLess_STRONG = thm `; + let A B C A' B' C' be real^2; + assume oriented_area (A,B,C) = oriented_area (A',B',C') [H1]; + thus ?n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n + + proof + {A,C,C} = {A,C} /\ {B',C,C} = {B',C} /\ {B',B',C} = {B',C} /\ {B',B',C'} = {B',C'} [easy_sets] by SET_RULE; + cases; + suppose ~collinear {A,B,C}; + qed by -, H1, FiveMovesOrLess; + suppose collinear {A,B,C} [ABCcol]; + collinear {A',B',C'} [A'B'C'col] by -, H1, ORIENTED_AREA_COLLINEAR_CONG; + consider P1 P2 P3 P4 such that + P1 = A,C,C /\ P2 = B',C,C /\ P3 = B',B',C /\ P4 = B',B',C'; + move (A,B,C) P1 /\ move P1 P2 /\ move P2 P3 /\ move P3 P4 /\ move P4 (A',B',C') by -, ABCcol, A'B'C'col, easy_sets, COLLINEAR_2, collinearSymmetry, moveSymmetry, EasyCollinearMoves; + qed by -, reachableN_Five, LE_REFL; + end; +`;; diff --git a/Examples/inverse_bug_puzzle_tac.ml b/Examples/inverse_bug_puzzle_tac.ml new file mode 100644 index 0000000..fd74ea5 --- /dev/null +++ b/Examples/inverse_bug_puzzle_tac.ml @@ -0,0 +1,461 @@ +(* ========================================================================= *) +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* Proof of the Bug Puzzle conjecture of the HOL Light tutorial: Any two *) +(* triples of points in the plane with the same oriented area can be *) +(* connected in 5 moves or less (FivemovesOrLess). Much of the code is *) +(* due to John Harrison: a proof (NOTENOUGH_4) showing this is the best *) +(* possible result; an early version of Noncollinear_2Span; the *) +(* definition of move, which defines a closed subset *) +(* {(A,B,C,A',B',C') | move (A,B,C) (A',B',C')} of R^6 x R^6, *) +(* i.e. the zero set of a continuous function; FivemovesOrLess_STRONG, *) +(* which handles the degenerate case (collinear or non-distinct triples), *) +(* giving a satisfying answer using this "closed" definition of move. *) +(* *) +(* The mathematical proofs are essentially due to Tom Hales. The code *) +(* tries to mix declarative and procedural proof styles, using ideas due *) +(* to John Harrison (section 12.1 "Towards more readable proofs" of the *) +(* HOL Light tutorial), Freek Wiedijk (arxiv.org/pdf/1201.3601 "A *) +(* Synthesis of the Procedural and Declarative Styles of Interactive *) +(* Theorem Proving"), Marco Maggesi, who wrote the tactic constructs *) +(* INTRO_TAC & HYP, which goes well with the older SUBGOAL_TAC, and Petros *) +(* Papapanagiotou, coauthor of IsabelleLight, who wrote BuildExist below, a *) +(* a crucial part of consider. *) +(* ========================================================================= *) + +needs "Multivariate/determinants.ml";; + +new_type_abbrev("triple",`:real^2#real^2#real^2`);; + +let so = fun tac -> FIRST_ASSUM MP_TAC THEN tac;; + +let BuildExist x t = + let try_type tp tm = + try inst (type_match (type_of tm) tp []) tm + with Failure _ -> tm in + + (* Check if two variables match allowing only type instantiations: *) + let vars_match tm1 tm2 = + let inst = try term_match [] tm1 tm2 with Failure _ -> [],[tm2,tm1],[] in + match inst with + [],[],_ -> tm2 + | _ -> failwith "vars_match: no match" in + + (* Find the type of a matching variable in t. *) + let tp = try type_of (tryfind (vars_match x) (frees t)) + with Failure _ -> + warn true ("BuildExist: `" ^ string_of_term x ^ "` not be found in + `" ^ string_of_term t ^ "`") ; + type_of x in + (* Try to force x to type tp. *) + let x' = try_type tp x in + mk_exists (x',t);; + +let consider vars_SuchThat t prfs lab = + (* Functions ident and parse_using borrowed from HYP in tactics.ml *) + let ident = function + Ident s::rest when isalnum s -> s,rest + | _ -> raise Noparse in + let parse_using = many ident in + let rec findSuchThat = function + n -> if String.sub vars_SuchThat n 9 = "such that" then n + else findSuchThat (n + 1) in + let n = findSuchThat 1 in + let vars = String.sub vars_SuchThat 0 (n - 1) in + let xl = map parse_term ((fst o parse_using o lex o explode) vars) in + let tm = itlist BuildExist xl t in + match prfs with + p::ps -> (warn (ps <> []) "consider: additional subproofs ignored"; + SUBGOAL_THEN tm (DESTRUCT_TAC ("@" ^ vars ^ "." ^ lab)) + THENL [p; ALL_TAC]) + | [] -> failwith "consider: no subproof given";; + +let cases sDestruct disjthm tac = + SUBGOAL_TAC "" disjthm tac THEN FIRST_X_ASSUM + (DESTRUCT_TAC sDestruct);; + +let raa lab t tac = SUBGOAL_THEN (mk_imp(t, `F`)) (LABEL_TAC lab) THENL + [INTRO_TAC lab; tac];; + +let VEC2_TAC = + SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; + vector_add; vec; dot; orthogonal; basis; + vector_neg; vector_sub; vector_mul; ARITH] THEN + CONV_TAC REAL_RING;; + +let COLLINEAR_3_2Dzero = prove + (`!y z:real^2. collinear{vec 0,y,z} <=> + z$1 * y$2 = y$1 * z$2`, + REWRITE_TAC[COLLINEAR_3_2D] THEN VEC2_TAC);; + +let Noncollinear_3ImpliesDistinct = prove + (`~collinear {a,b,c} ==> ~(a = b) /\ ~(a = c) /\ ~(b = c)`, + MESON_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_REFL]);; + +let collinearSymmetry = prove +(`collinear {A,B,C} + ==> collinear {A,C,B} /\ collinear {B,A,C} /\ + collinear {B,C,A} /\ collinear {C,A,B} /\ collinear {C,B,A}`, + MESON_TAC[SET_RULE `{A,C,B} SUBSET {A,B,C} /\ {B,A,C} SUBSET {A,B,C} /\ + {B,C,A} SUBSET {A,B,C} /\ {C,A,B} SUBSET {A,B,C} /\ {C,B,A} SUBSET {A,B,C}`; + COLLINEAR_SUBSET]);; + +let Noncollinear_2Span = prove + (`!u v w:real^2. ~collinear {vec 0,v,w} ==> ? s t. s % v + t % w = u`, + INTRO_TAC "!u v w; H1" THEN + SUBGOAL_TAC "H1'" `~(v$1 * w$2 - (w:real^2)$1 * (v:real^2)$2 = &0)` + [HYP MESON_TAC "H1" [COLLINEAR_3_2Dzero; REAL_SUB_0]] THEN + consider "M such that" + `M = transp(vector[v:real^2;w:real^2]):real^2^2` [MESON_TAC[]] "Mexists" THEN + SUBGOAL_TAC "MatMult" `~(det (M:real^2^2) = &0) /\ + (! x. (M ** x)$1 = (v:real^2)$1 * x$1 + (w:real^2)$1 * x$2 /\ + (M ** x)$2 = v$2 * x$1 + w$2 * x$2)` + [HYP SIMP_TAC "H1' Mexists" [matrix_vector_mul; DIMINDEX_2; SUM_2; + TRANSP_COMPONENT; VECTOR_2; LAMBDA_BETA; ARITH; CART_EQ; FORALL_2; DET_2] THEN VEC2_TAC] THEN + consider "x such that" `(M:real^2^2) ** x = u` + [so (MESON_TAC [ARITH_RULE `~(r < n) /\ r <= MIN n n ==> r = n`; + DET_EQ_0_RANK; RANK_BOUND; MATRIX_FULL_LINEAR_EQUATIONS])] "xDef" THEN + MAP_EVERY EXISTS_TAC [`(x:real^2)$1`; `(x:real^2)$2`] THEN SUBGOAL_TAC "" + `(x:real^2)$1 * (v:real^2)$1 + (x:real^2)$2 * (w:real^2)$1 = (u:real^2)$1 /\ + x$1 * v$2 + x$2 * w$2 = u$2` [HYP MESON_TAC "MatMult xDef" [REAL_MUL_SYM]] + THEN so (SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; vector_add; vector_mul; ARITH]));; + +let oriented_area = new_definition + `oriented_area (a:real^2,b:real^2,c:real^2) = + ((b$1 - a$1) * (c$2 - a$2) - (c$1 - a$1) * (b$2 - a$2)) / &2`;; + +let oriented_areaSymmetry = prove + (`oriented_area (A,B,C) = oriented_area(A',B',C') ==> + oriented_area (B,C,A) = oriented_area (B',C',A') /\ + oriented_area (C,A,B) = oriented_area (C',A',B') /\ + oriented_area (A,C,B) = oriented_area (A',C',B') /\ + oriented_area (B,A,C) = oriented_area (B',A',C') /\ + oriented_area (C,B,A) = oriented_area (C',B',A')`, + REWRITE_TAC[oriented_area] THEN VEC2_TAC);; + +let move = new_definition + `!A B C A' B' C':real^2. move (A,B,C) (A',B',C') <=> + (B = B' /\ C = C' /\ collinear {vec 0,C - B,A' - A} \/ + A = A' /\ C = C' /\ collinear {vec 0,C - A,B' - B} \/ + A = A' /\ B = B' /\ collinear {vec 0,B - A,C' - C})`;; + +let moveInvariant = prove + (`!p p'. move p p' ==> oriented_area p = oriented_area p'`, + REWRITE_TAC[FORALL_PAIR_THM; move; oriented_area; COLLINEAR_LEMMA; vector_mul] THEN VEC2_TAC);; + +let reachable = new_definition + `!p p'. + reachable p p' <=> ?n. ?s. + s 0 = p /\ s n = p' /\ + (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; + +let reachableN = new_definition + `!p p'. !n. + reachableN p p' n <=> ?s. + s 0 = p /\ s n = p' /\ + (!m. 0 <= m /\ m < n ==> move (s m) (s (SUC m)))`;; + +let ReachLemma = prove + (`!p p'. reachable p p' <=> ?n. reachableN p p' n`, + REWRITE_TAC[reachable; reachableN]);; + +let reachableN_CLAUSES = prove + (`! p p'. (reachableN p p' 0 <=> p = p') /\ + ! n. reachableN p p' (SUC n) <=> ? q. reachableN p q n /\ move q p'`, + INTRO_TAC "!p p'" THEN + consider "s0 such that" `s0 = \m:num. p':triple` [MESON_TAC[]] "s0exists" THEN + SUBGOAL_TAC "0CLAUSE" `reachableN p p' 0 <=> p = p'` + [HYP MESON_TAC "s0exists" [LE_0; reachableN; LT]] THEN SUBGOAL_TAC "Imp1" + `! n. reachableN p p' (SUC n) ==> ? q. reachableN p q n /\ move q p'` + [INTRO_TAC "!n; H1" THEN + consider "s such that" + `s 0 = p /\ s (SUC n) = p' /\ !m. m < SUC n ==> move (s m) (s (SUC m))` + [HYP MESON_TAC "H1" [LE_0; reachableN]] "sDef" THEN + consider "q such that" `q:triple = s n` [MESON_TAC[]] "qDef" THEN + HYP MESON_TAC "sDef qDef" [LE_0; reachableN; LT]] THEN SUBGOAL_TAC "Imp2" + `!n. (? q. reachableN p q n /\ move q p') ==> reachableN p p' (SUC n)` + [INTRO_TAC "!n" THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + INTRO_TAC "!q; nReach; move_qp'" THEN + consider "s such that" + `s 0 = p /\ s n = q /\ !m. m < n ==> move (s m) (s (SUC m))` + [HYP MESON_TAC "nReach" [reachableN; LT; LE_0]] "sDef" THEN + REWRITE_TAC[reachableN; LT; LE_0] THEN + EXISTS_TAC `\m. if m < SUC n then s m else p':triple` THEN + HYP MESON_TAC "sDef move_qp'" [LT_0; LT_REFL; LT; LT_SUC]] THEN + HYP MESON_TAC "0CLAUSE Imp1 Imp2" []);; + +let reachableInvariant = prove + (`!p p'. reachable p p' ==> oriented_area p = oriented_area p'`, + SIMP_TAC[ReachLemma; LEFT_IMP_EXISTS_THM; SWAP_FORALL_THM] THEN + INDUCT_TAC THEN ASM_MESON_TAC[reachableN_CLAUSES; moveInvariant]);; + +let move2Cond = new_definition + `! A B A' B':real^2. move2Cond A B A' B' <=> + ~collinear {B,A,A'} /\ ~collinear {A',B,B'} \/ + ~collinear {A,B,B'} /\ ~collinear {B',A,A'}`;; + +let reachableN_One = prove + (`reachableN P0 P1 1 <=> move P0 P1`, + MESON_TAC[ONE; reachableN; reachableN_CLAUSES]);; + +let reachableN_Two = prove + (`reachableN P0 P2 2 <=> ?P1. move P0 P1 /\ move P1 P2`, + MESON_TAC[TWO; reachableN_One; reachableN_CLAUSES]);; + +let reachableN_Three = prove + (`reachableN P0 P3 3 <=> ?P1 P2. move P0 P1 /\ move P1 P2 /\ move P2 P3`, + MESON_TAC[ARITH_RULE `3 = SUC 2`; reachableN_Two; reachableN_CLAUSES]);; + +let reachableN_Four = prove + (`reachableN P0 P4 4 <=> ?P1 P2 P3. move P0 P1 /\ move P1 P2 /\ + move P2 P3 /\ move P3 P4`, + MESON_TAC[ARITH_RULE `4 = SUC 3`; reachableN_Three; reachableN_CLAUSES]);; + +let reachableN_Five = prove + (`reachableN P0 P5 5 <=> ?P1 P2 P3 P4. move P0 P1 /\ move P1 P2 /\ + move P2 P3 /\ move P3 P4 /\ move P4 P5`, + REWRITE_TAC[ARITH_RULE `5 = SUC 4`; reachableN_CLAUSES] THEN + MESON_TAC[reachableN_Four]);; + +let moveSymmetry = prove + (`move (A,B,C) (A',B',C') ==> + move (B,C,A) (B',C',A') /\ move (C,A,B) (C',A',B') /\ + move (A,C,B) (A',C',B') /\ move (B,A,C) (B',A',C') /\ move (C,B,A) (C',B',A')`, + SUBGOAL_TAC "" `!A B C A':real^2. collinear {vec 0, C - B, A' - A} + ==> collinear {vec 0, B - C, A' - A}` + [REWRITE_TAC[COLLINEAR_3_2Dzero] THEN VEC2_TAC] THEN + so (REWRITE_TAC[move]) THEN MESON_TAC[]);; + +let reachableNSymmetry = prove + (`! n. ! A B C A' B' C'. reachableN (A,B,C) (A',B',C') n ==> +reachableN (B,C,A) (B',C',A') n /\ reachableN (C,A,B) (C',A',B') n /\ +reachableN (A,C,B) (A',C',B') n /\ reachableN (B,A,C) (B',A',C') n /\ +reachableN (C,B,A) (C',B',A') n`, + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[reachableN_CLAUSES] THEN + SIMP_TAC[PAIR_EQ] THEN + INTRO_TAC "!n;nStep; !A B C A' B' C'" THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`X:real^2`; `Y:real^2`; `Z:real^2`] THEN + INTRO_TAC "XYZexists" THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY EXISTS_TAC [`(Y,Z,X):triple`; `(Z,X,Y):triple`; + `(X,Z,Y):triple`; `(Y,X,Z):triple`; `(Z,Y,X):triple`] THEN + HYP SIMP_TAC "nStep XYZexists" [moveSymmetry]);; + +let ORIENTED_AREA_COLLINEAR_CONG = prove + (`! A B C A' B' C. + oriented_area (A,B,C) = oriented_area (A',B',C') + ==> (collinear {A,B,C} <=> collinear {A',B',C'})`, + REWRITE_TAC[COLLINEAR_3_2D; oriented_area] THEN CONV_TAC REAL_RING);; + +let Basic2move_THM = prove + (`! A B C A'. ~collinear {A,B,C} /\ ~collinear {B,A,A'} ==> + ?X. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X)`, + INTRO_TAC "!A B C A'; H1 H2" THEN SUBGOAL_TAC "add0vector_mul" + `!r. r % ((A:real^2) - B) = (--r) % (B - A) /\ + r % (A - B) = r % (A - B) + &0 % (C - B)` [VEC2_TAC] THEN + SUBGOAL_TAC "H2'" `~ ? r. A' - (A:real^2) = r % (A - B)` + [so (HYP MESON_TAC "H2" [COLLINEAR_3; COLLINEAR_LEMMA])] THEN + consider "r t such that" `A' - (A:real^2) = r % (A - B) + t % (C - B)` + [HYP MESON_TAC "H1" [COLLINEAR_3; Noncollinear_2Span]] "rExists" THEN + SUBGOAL_TAC "tNonzero" `~(t = &0)` + [so (HYP MESON_TAC "add0vector_mul H2'" [])] THEN + consider "s X such that" `s = r / t /\ X:real^2 = C + s % (A - B)` + [HYP MESON_TAC "rExists" []] "Xexists" THEN + SUBGOAL_TAC "" `A' - (A:real^2) = (t * s) % (A - B) + t % (C - B)` + [so (HYP MESON_TAC "rExists tNonzero" [REAL_DIV_LMUL])] THEN SUBGOAL_TAC "" + `A' - (A:real^2) = t % (X - B) /\ X - C = (-- s) % (B - (A:real^2))` + [(so (HYP REWRITE_TAC "Xexists" [])) THEN VEC2_TAC] THEN SUBGOAL_TAC "" + `collinear {vec 0,B - (A:real^2),X - C} /\ collinear {vec 0,X - B,A' - A}` + [so (HYP MESON_TAC "" [COLLINEAR_LEMMA])] THEN so (MESON_TAC [move]));; + +let FourStepMoveAB = prove + (`!A B C A' B'. ~collinear {A,B,C} ==> + ~collinear {B,A,A'} /\ ~collinear {A',B,B'} ==> + ? X Y. move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X) /\ + move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y)`, + INTRO_TAC "!A B C A' B'; H1; H2" THEN + consider "X such that" `move (A,B,C) (A,B,X) /\ move (A,B,X) (A',B,X)` + [HYP MESON_TAC "H1 H2" [Basic2move_THM]]"ABX" THEN + SUBGOAL_TAC "" `~collinear {(A:real^2),B,X} /\ ~collinear {A',B,X}` + [so (HYP MESON_TAC "H1" [moveInvariant; ORIENTED_AREA_COLLINEAR_CONG])] + THEN SUBGOAL_TAC "" `~collinear {(B:real^2),A',X}` + [so (MESON_TAC [collinearSymmetry])] THEN + consider "Y such that" `move (B,A',X) (B,A',Y) /\ move (B,A',Y) (B',A',Y)` + [so (HYP MESON_TAC "H2" [Basic2move_THM])] "BA'Y" THEN + SUBGOAL_TAC "" `move (A',B,X) (A',B,Y) /\ move (A',B,Y) (A',B',Y)` + [HYP MESON_TAC "BA'Y" [moveSymmetry]] THEN so (HYP MESON_TAC "ABX" []));; + +let FourStepMoveABBAreach = prove + (`!A B C A' B'. ~collinear {A,B,C} /\ move2Cond A B A' B' ==> + ? Y. reachableN (A,B,C) (A',B',Y) 4`, + INTRO_TAC "!A B C A' B'; H1 H2" THEN + cases "Case1 | Case2" + `~collinear {B,(A:real^2),A'} /\ ~collinear {A',B,B'} \/ + ~collinear {A,B,B'} /\ ~collinear {B',A,A'}` + [HYP MESON_TAC "H2" [move2Cond]] + THENL + [so (HYP MESON_TAC "H1" [FourStepMoveAB; reachableN_Four]); + SUBGOAL_TAC "" `~collinear {B,(A:real^2),C}` + [HYP MESON_TAC "H1" [collinearSymmetry]]] THEN + SUBGOAL_TAC "" `~collinear {B,(A:real^2),C}` + [HYP MESON_TAC "H1" [collinearSymmetry]] THEN + consider "X Y such that" + `move (B,A,C) (B,A,X) /\ move (B,A,X) (B',A,X) /\ + move (B',A,X) (B',A,Y) /\ move (B',A,Y) (B',A',Y)` + [so (HYP MESON_TAC "Case2" [FourStepMoveAB])] "BAX" THEN + HYP MESON_TAC "BAX" [moveSymmetry; reachableN_Four]);; + +let NotMove2ImpliesCollinear = prove + (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} /\ + ~(A = A') /\ ~(B = B') /\ ~move2Cond A B A' B' ==> + collinear {A,B,A',B'}`, + INTRO_TAC "!A B C A' B' C'; H1 H1' H2 H2' H3" THEN + SUBGOAL_TAC "Distinct" `~((A:real^2) = B) /\ ~((A':real^2) = B')` + [HYP MESON_TAC "H1 H1'" [Noncollinear_3ImpliesDistinct]] THEN + SUBGOAL_TAC "set4symmetry" `{(A:real^2),B,A',B'} SUBSET {A,A',B,B'} /\ + {A,B,A',B'} SUBSET {B,B',A',A} /\ {A,B,A',B'} SUBSET {A',B',B,A}` [SET_TAC[]] THEN + cases "Case1 | Case2 | Case3 | Case4" + `collinear {B,(A:real^2),A'} /\ collinear {A,B,B'} \/ + collinear {B,A,A'} /\ collinear {B',A,A'} \/ + collinear {A',B,B'} /\ collinear {A,B,B'} \/ + collinear {A',B,B'} /\ collinear {B',A,A'}` + [HYP MESON_TAC "H3" [move2Cond]] THEN + so (HYP MESON_TAC "Distinct H2 H2' set4symmetry" + [collinearSymmetry; COLLINEAR_4_3; COLLINEAR_SUBSET]));; + +let DistinctImplies2moveable = prove + (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} /\ + ~(A = A') /\ ~(B = B') /\ ~(C = C') ==> + move2Cond A B A' B' \/ move2Cond B C B' C'`, + INTRO_TAC "!A B C A' B' C'; H1 H1' H2a H2b H2c" THEN SUBGOAL_TAC "3subset4" + `{(A:real^2),B,B'} SUBSET {A,B,A',B'} /\ {B,B',C} SUBSET {B,C,B',C'}` + [SET_TAC[]] THEN + raa "Con" `~move2Cond A B A' B' /\ + ~move2Cond B C B' C'` (HYP MESON_TAC "Con" []) THEN + SUBGOAL_TAC "" `collinear {(A:real^2),B,A',B'} /\ collinear {B,C,B',C'}` + [so (HYP MESON_TAC "H1 H1' H2a H2b H2c" [collinearSymmetry; NotMove2ImpliesCollinear])] + THEN SUBGOAL_TAC "" `collinear {(A:real^2),B,C}` + [so (HYP MESON_TAC "3subset4 H2a H2b H2c" [COLLINEAR_SUBSET; COLLINEAR_3_TRANS])] + THEN so (HYP MESON_TAC "H1 H1'" []));; + +let SameCdiffAB = prove + (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} ==> + C = C' /\ ~(A = A') /\ ~(B = B') ==> + ? Y. reachableN (A,B,C) (Y,B',C') 2 \/ reachableN (A,B,C) (A',B',Y) 4`, + INTRO_TAC "!A B C A' B' C'; H1; H2" THEN SUBGOAL_TAC "easy_set" + `{B,B',(A:real^2)} SUBSET {A,B,A',B'} /\ {A,B,C} SUBSET {B,B',A,C}` [SET_TAC[]] THEN + cases "Ncol | move | col_Nmove" + `~collinear {C,B,B'} \/ + move2Cond A B A' B' \/ + collinear {C,B,B'} /\ ~move2Cond A B A' B'` + [MESON_TAC[]] THENL + [consider "X such that" `move (B,C,A) (B,C,X) /\ move (B,C,X) (B',C',X)` + [so (HYP MESON_TAC "easy_set H1 H2" [collinearSymmetry; Basic2move_THM])] "BCX" + THEN HYP MESON_TAC "BCX" [reachableN_Two; reachableNSymmetry]; + so (HYP MESON_TAC "H1" [FourStepMoveABBAreach]); + SUBGOAL_TAC "" `collinear {(B:real^2),B',A} /\ collinear {B,B',C}` + [so (HYP MESON_TAC "H1 H2 easy_set" + [NotMove2ImpliesCollinear; COLLINEAR_SUBSET; collinearSymmetry])] THEN + so (HYP MESON_TAC "H2 easy_set H1" [COLLINEAR_4_3; COLLINEAR_SUBSET])]);; + +let FourMovesToCorrectTwo = prove + (`!A B C A' B' C'. ~collinear {A,B,C} /\ ~collinear {A',B',C'} ==> + ? n. n < 5 /\ ? Y. reachableN (A,B,C) (A',B',Y) n \/ + reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n`, + INTRO_TAC "!A B C A' B' C'; H1" THEN + SUBGOAL_TAC "H1'" `~collinear {B,C,(A:real^2)} /\ + ~collinear{B',C',(A':real^2)} /\ ~collinear {C,A,B} /\ ~collinear {C',A',B'}` + [HYP MESON_TAC "H1" [collinearSymmetry]] THEN + SUBGOAL_TAC "easy_arith" `0 < 5 /\ 2 < 5 /\ 3 < 5 /\ 4 < 5` [ARITH_TAC] THEN + cases "case01 | case2 | case3" + `((A:real^2) = A' /\ (B:real^2) = B' /\ (C:real^2) = C' \/ + A = A' /\ B = B' /\ ~(C = C') \/ A = A' /\ ~(B = B') /\ C = C' \/ + ~(A = A') /\ B = B' /\ C = C') \/ + (A = A' /\ ~(B = B') /\ ~(C = C') \/ + ~(A = A') /\ B = B' /\ ~(C = C') \/ ~(A = A') /\ ~(B = B') /\ C = C') \/ + ~(A = A') /\ ~(B = B') /\ ~(C = C')` + [MESON_TAC []] THENL + [so (HYP MESON_TAC "easy_arith" [reachableN_CLAUSES]); + so (HYP MESON_TAC "H1 H1' easy_arith" [SameCdiffAB; reachableNSymmetry]); + EXISTS_TAC `4` THEN HYP SIMP_TAC "easy_arith" [] THEN + so (HYP MESON_TAC "H1 H1'" [DistinctImplies2moveable; FourStepMoveABBAreach; + reachableNSymmetry; reachableN_Four])]);; + +let CorrectFinalPoint = prove + (`oriented_area (A,B,C) = oriented_area (A,B,C') ==> + move (A,B,C) (A,B,C')`, + REWRITE_TAC [move; oriented_area; COLLINEAR_3_2Dzero] THEN VEC2_TAC);; + +let FiveMovesOrLess = prove + (`!A B C A' B' C'. ~collinear {A,B,C} ==> + oriented_area (A,B,C) = oriented_area (A',B',C') ==> + ? n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n`, + INTRO_TAC "!A B C A' B' C'; H1; H2" THEN + SUBGOAL_TAC "H1'" `~collinear {(A':real^2),B',C'}` + [HYP MESON_TAC "H1 H2" [ORIENTED_AREA_COLLINEAR_CONG]] THEN + SUBGOAL_TAC "Distinct" `~((A:real^2) = B) /\ ~(A = C) /\ ~(B = C) /\ + ~((A':real^2) = B') /\ ~(A' = C') /\ ~(B' = C')` + [so (HYP MESON_TAC "H1" [Noncollinear_3ImpliesDistinct])] THEN + consider "n Y such that" + `n < 5 /\ (reachableN (A,B,C) (A',B',Y) n \/ + reachableN (A,B,C) (A',Y,C') n \/ reachableN (A,B,C) (Y,B',C') n)` + [HYP MESON_TAC "H1 H1'" [FourMovesToCorrectTwo]] "2Correct" THEN + cases "A'B'Y | A'YC' | YB'C'" + `reachableN (A,B,C) (A',B',Y) n \/ + reachableN (A,B,C) (A',Y,C') n \/ + reachableN (A,B,C) (Y,B',C') n` [HYP MESON_TAC "2Correct" []] THENL + [SUBGOAL_TAC "" `oriented_area (A',B',Y) = oriented_area (A',B',C')` + [so (HYP MESON_TAC "H2" [ReachLemma; reachableInvariant])] THEN + SUBGOAL_TAC "" `move (A',B',Y) (A',B',C')` + [so (HYP MESON_TAC "Distinct" [CorrectFinalPoint])] THEN + so (HYP MESON_TAC "A'B'Y 2Correct" [reachableN_CLAUSES; LE_SUC_LT]); + SUBGOAL_TAC "" `oriented_area (A',C',Y) = oriented_area (A',C',B')` + [so (HYP MESON_TAC "H2" [ReachLemma; reachableInvariant; oriented_areaSymmetry])] + THEN SUBGOAL_TAC "" `move (A',Y,C') (A',B',C')` + [so (HYP MESON_TAC "Distinct" [CorrectFinalPoint; moveSymmetry])] THEN + so (HYP MESON_TAC "A'YC' 2Correct" [reachableN_CLAUSES; LE_SUC_LT]); +SUBGOAL_TAC "" `oriented_area (B',C',Y) = oriented_area (B',C',A')` + [so (HYP MESON_TAC "H2" [ReachLemma; reachableInvariant; oriented_areaSymmetry])] + THEN SUBGOAL_TAC "" `move (Y,B',C') (A',B',C')` + [so (HYP MESON_TAC "Distinct" [CorrectFinalPoint; moveSymmetry])] THEN + so (HYP MESON_TAC "YB'C' 2Correct" [reachableN_CLAUSES; LE_SUC_LT])]);; + +let NOTENOUGH_4 = prove + (`?p0 p4. oriented_area p0 = oriented_area p4 /\ ~reachableN p0 p4 4`, + consider "p0 p4 such that" + `p0:triple = vector [&0;&0],vector [&0;&1],vector [&1;&0] /\ + p4:triple = vector [&1;&1],vector [&1;&2],vector [&2;&1]` + [MESON_TAC []] "p04Def" THEN + SUBGOAL_TAC "equal_areas" `oriented_area p0 = oriented_area p4` + [HYP REWRITE_TAC "p04Def" [oriented_area] THEN VEC2_TAC] THEN + SUBGOAL_TAC "" `~reachableN p0 p4 4` + [HYP REWRITE_TAC "p04Def" [reachableN_Four; NOT_EXISTS_THM; FORALL_PAIR_THM; move; COLLINEAR_3_2Dzero; FORALL_VECTOR_2] THEN VEC2_TAC] THEN + so (HYP MESON_TAC "equal_areas" []));; + +let FiveMovesOrLess_STRONG = prove + (`!A B C A' B' C'. + oriented_area (A,B,C) = oriented_area (A',B',C') ==> + ?n. n <= 5 /\ reachableN (A,B,C) (A',B',C') n`, + INTRO_TAC "!A B C A' B' C'; H1" THEN + SUBGOAL_TAC "EZcollinear" + `(!X Y:real^2. collinear {X,Y,Y}) /\ + (!A B A'. move (A,B,B) (A',B,B)) /\ + !A B C B'. (collinear {A,B,C} /\ collinear {A,B',C} ==> + move (A,B,C) (A,B',C))` + [REWRITE_TAC[move; COLLINEAR_3_2D] THEN VEC2_TAC] THEN + cases "ABCncol | ABCcol" + `~collinear {(A:real^2),B,C} \/ collinear {A,B,C}` + [MESON_TAC []] THENL + [so (HYP MESON_TAC "H1" [FiveMovesOrLess]); + SUBGOAL_TAC "A'B'C'col" `collinear {(A':real^2),B',C'}` + [so (HYP MESON_TAC "H1" [ORIENTED_AREA_COLLINEAR_CONG])] THEN + consider "P1 P2 P3 P4 such that" + `P1:triple = A,C,C /\ P2:triple = B',C,C /\ P3 = B',B',C /\ + P4:triple = B',B',C'` [MESON_TAC []] "P1234exist" THEN + SUBGOAL_TAC "" `move (A,B,C) (P1:triple) /\ move P1 P2 /\ + move P2 P3 /\ move P3 P4 /\ move P4 (A',B',C')` + [HYP MESON_TAC "ABCcol A'B'C'col EZcollinear P1234exist" + [collinearSymmetry; moveSymmetry]] THEN + so (MESON_TAC [reachableN_Five; LE_REFL])]);; diff --git a/Examples/kb.ml b/Examples/kb.ml new file mode 100644 index 0000000..108c8a1 --- /dev/null +++ b/Examples/kb.ml @@ -0,0 +1,295 @@ +(* ========================================================================= *) +(* Knuth-Bendix completion done by HOL inference. John Harrison 2005 *) +(* *) +(* This was written by fairly mechanical modification of the code at *) +(* *) +(* http://www.cl.cam.ac.uk/users/jrh/atp/order.ml *) +(* http://www.cl.cam.ac.uk/users/jrh/atp/completion.ml *) +(* *) +(* for HOL's slightly different term structure, with ad hoc term *) +(* manipulations replaced by inference on equational theorems. We also have *) +(* the optimization of throwing left-reducible rules back into the set of *) +(* critical pairs. However, we don't prioritize smaller critical pairs or *) +(* anything like that; this is still a very naive implementation. *) +(* *) +(* For something very similar done 15 years ago, see Konrad Slind's Master's *) +(* thesis: "An Implementation of Higher Order Logic", U Calgary 1991. *) +(* ========================================================================= *) + +let is_realvar w x = is_var x & not(mem x w);; + +let rec real_strip w tm = + if mem tm w then tm,[] else + let l,r = dest_comb tm in + let f,args = real_strip w l in f,args@[r];; + +(* ------------------------------------------------------------------------- *) +(* Construct a weighting function. *) +(* ------------------------------------------------------------------------- *) + +let weight lis (f,n) (g,m) = + let i = index f lis and j = index g lis in + i > j or i = j & n > m;; + +(* ------------------------------------------------------------------------- *) +(* Generic lexicographic ordering function. *) +(* ------------------------------------------------------------------------- *) + +let rec lexord ord l1 l2 = + match (l1,l2) with + (h1::t1,h2::t2) -> if ord h1 h2 then length t1 = length t2 + else h1 = h2 & lexord ord t1 t2 + | _ -> false;; + +(* ------------------------------------------------------------------------- *) +(* Lexicographic path ordering. Note that we also use the weights *) +(* to define the set of constants, so they don't literally have to be *) +(* constants in the HOL sense. *) +(* ------------------------------------------------------------------------- *) + +let rec lpo_gt w s t = + if is_realvar w t then not(s = t) & mem t (frees s) + else if is_realvar w s or is_abs s or is_abs t then false else + let f,fargs = real_strip w s and g,gargs = real_strip w t in + exists (fun si -> lpo_ge w si t) fargs or + forall (lpo_gt w s) gargs & + (f = g & lexord (lpo_gt w) fargs gargs or + weight w (f,length fargs) (g,length gargs)) +and lpo_ge w s t = (s = t) or lpo_gt w s t;; + +(* ------------------------------------------------------------------------- *) +(* Unification. Again we have the weights "w" fixing the set of constants. *) +(* ------------------------------------------------------------------------- *) + +let rec istriv w env x t = + if is_realvar w t then t = x or defined env t & istriv w env x (apply env t) + else if is_const t then false else + let f,args = strip_comb t in + exists (istriv w env x) args & failwith "cyclic";; + +let rec unify w env tp = + match tp with + ((Var(_,_) as x),t) | (t,(Var(_,_) as x)) when not(mem x w) -> + if defined env x then unify w env (apply env x,t) + else if istriv w env x t then env else (x|->t) env + | (Comb(f,x),Comb(g,y)) -> unify w (unify w env (x,y)) (f,g) + | (s,t) -> if s = t then env else failwith "unify: not unifiable";; + +(* ------------------------------------------------------------------------- *) +(* Full unification, unravelling graph into HOL-style instantiation list. *) +(* ------------------------------------------------------------------------- *) + +let fullunify w (s,t) = + let env = unify w undefined (s,t) in + let th = map (fun (x,t) -> (t,x)) (graph env) in + let rec subs t = + let t' = vsubst th t in + if t' = t then t else subs t' in + map (fun (t,x) -> (subs t,x)) th;; + +(* ------------------------------------------------------------------------- *) +(* Construct "overlaps": ways of rewriting subterms using unification. *) +(* ------------------------------------------------------------------------- *) + +let LIST_MK_COMB f ths = rev_itlist (fun s t -> MK_COMB(t,s)) ths (REFL f);; + +let rec listcases fn rfn lis acc = + match lis with + [] -> acc + | h::t -> fn h (fun i h' -> rfn i (h'::map REFL t)) @ + listcases fn (fun i t' -> rfn i (REFL h::t')) t acc;; + +let rec overlaps w th tm rfn = + let l,r = dest_eq(concl th) in + if not (is_comb tm) then [] else + let f,args = strip_comb tm in + listcases (overlaps w th) (fun i a -> rfn i (LIST_MK_COMB f a)) args + (try [rfn (fullunify w (l,tm)) th] with Failure _ -> []);; + +(* ------------------------------------------------------------------------- *) +(* Rename variables canonically to avoid clashes or remove redundancy. *) +(* ------------------------------------------------------------------------- *) + +let fixvariables s th = + let fvs = subtract (frees(concl th)) (freesl(hyp th)) in + let gvs = map2 (fun v n -> mk_var(s^string_of_int n,type_of v)) + fvs (1--(length fvs)) in + INST (zip gvs fvs) th;; + +let renamepair (th1,th2) = fixvariables "x" th1,fixvariables "y" th2;; + +(* ------------------------------------------------------------------------- *) +(* Find all critical pairs. *) +(* ------------------------------------------------------------------------- *) + +let crit1 w eq1 eq2 = + let l1,r1 = dest_eq(concl eq1) + and l2,r2 = dest_eq(concl eq2) in + overlaps w eq1 l2 (fun i th -> TRANS (SYM(INST i th)) (INST i eq2));; + +let thm_union l1 l2 = + itlist (fun th ths -> let th' = fixvariables "x" th in + let tm = concl th' in + if exists (fun th'' -> concl th'' = tm) ths then ths + else th'::ths) + l1 l2;; + +let critical_pairs w tha thb = + let th1,th2 = renamepair (tha,thb) in + if concl th1 = concl th2 then crit1 w th1 th2 else + filter (fun th -> let l,r = dest_eq(concl th) in l <> r) + (thm_union (crit1 w th1 th2) (thm_union (crit1 w th2 th1) []));; + +(* ------------------------------------------------------------------------- *) +(* Normalize an equation and try to orient it. *) +(* ------------------------------------------------------------------------- *) + +let normalize_and_orient w eqs th = + let th' = GEN_REWRITE_RULE TOP_DEPTH_CONV eqs th in + let s',t' = dest_eq(concl th') in + if lpo_ge w s' t' then th' else if lpo_ge w t' s' then SYM th' + else failwith "Can't orient equation";; + +(* ------------------------------------------------------------------------- *) +(* Print out status report to reduce user boredom. *) +(* ------------------------------------------------------------------------- *) + +let status(eqs,crs) eqs0 = + if eqs = eqs0 & (length crs) mod 1000 <> 0 then () else + (print_string(string_of_int(length eqs)^" equations and "^ + string_of_int(length crs)^" pending critical pairs"); + print_newline());; + +(* ------------------------------------------------------------------------- *) +(* Basic completion, throwing back left-reducible rules. *) +(* ------------------------------------------------------------------------- *) + +let left_reducible eqs eq = + can (CHANGED_CONV(GEN_REWRITE_CONV (LAND_CONV o ONCE_DEPTH_CONV) eqs)) + (concl eq);; + +let rec complete w (eqs,crits) = + match crits with + (eq::ocrits) -> + let trip = + try let eq' = normalize_and_orient w eqs eq in + let s',t' = dest_eq(concl eq') in + if s' = t' then (eqs,ocrits) else + let crits',eqs' = partition(left_reducible [eq']) eqs in + let eqs'' = eq'::eqs' in + eqs'', + ocrits @ crits' @ itlist ((@) o critical_pairs w eq') eqs'' [] + with Failure _ -> + if exists (can (normalize_and_orient w eqs)) ocrits + then (eqs,ocrits@[eq]) + else failwith "complete: no orientable equations" in + status trip eqs; complete w trip + | [] -> eqs;; + +(* ------------------------------------------------------------------------- *) +(* Overall completion. *) +(* ------------------------------------------------------------------------- *) + +let complete_equations wts eqs = + let eqs' = map (normalize_and_orient wts []) eqs in + complete wts ([],eqs');; + +(* ------------------------------------------------------------------------- *) +(* Knuth-Bendix example 4: the inverse property. *) +(* ------------------------------------------------------------------------- *) + +complete_equations [`1`; `(*):num->num->num`; `i:num->num`] + [SPEC_ALL(ASSUME `!a b. i(a) * a * b = b`)];; + +(* ------------------------------------------------------------------------- *) +(* Knuth-Bendix example 6: central groupoids. *) +(* ------------------------------------------------------------------------- *) + +complete_equations [`(*):num->num->num`] + [SPEC_ALL(ASSUME `!a b c. (a * b) * (b * c) = b`)];; + +(* ------------------------------------------------------------------------- *) +(* Knuth-Bendix example 9: cancellation law. *) +(* ------------------------------------------------------------------------- *) + +complete_equations + [`1`; `( * ):num->num->num`; `(+):num->num->num`; `(-):num->num->num`] + (map SPEC_ALL (CONJUNCTS (ASSUME + `(!a b:num. a - a * b = b) /\ + (!a b:num. a * b - b = a) /\ + (!a. a * 1 = a) /\ + (!a. 1 * a = a)`)));; + +(* ------------------------------------------------------------------------- *) +(* Another example: pure congruence closure (no variables). *) +(* ------------------------------------------------------------------------- *) + +complete_equations [`c:A`; `f:A->A`] + (map SPEC_ALL (CONJUNCTS (ASSUME + `((f(f(f(f(f c))))) = c:A) /\ (f(f(f c)) = c)`)));; + +(* ------------------------------------------------------------------------- *) +(* Knuth-Bendix example 1: group theory. *) +(* ------------------------------------------------------------------------- *) + +let eqs = map SPEC_ALL (CONJUNCTS (ASSUME + `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ + (!x y z. (x * y) * z = x * y * z)`));; + +complete_equations [`1`; `(*):num->num->num`; `i:num->num`] eqs;; + +(* ------------------------------------------------------------------------- *) +(* Near-rings (from Aichinger's Diplomarbeit). *) +(* ------------------------------------------------------------------------- *) + +let eqs = map SPEC_ALL (CONJUNCTS (ASSUME + `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z))`));; + +let nreqs = +complete_equations + [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`] eqs;; + +(*** This weighting also works OK, though the system is a bit bigger + +let nreqs = +complete_equations + [`0`; `(+):num->num->num`; `( * ):num->num->num`; `INV`] eqs;; + +****) + +(* ------------------------------------------------------------------------- *) +(* A "completion" tactic. *) +(* ------------------------------------------------------------------------- *) + +let COMPLETE_TAC w th = + let eqs = map SPEC_ALL (CONJUNCTS(SPEC_ALL th)) in + let eqs' = complete_equations w eqs in + MAP_EVERY (ASSUME_TAC o GEN_ALL) eqs';; + +(* ------------------------------------------------------------------------- *) +(* Solve example problems in groups and near-rings. *) +(* ------------------------------------------------------------------------- *) + +g `(!x. 1 * x = x) /\ + (!x. i(x) * x = 1) /\ + (!x y z. (x * y) * z = x * y * z) + ==> !x y. i(y) * i(i(i(x * i(y)))) * x = 1`;; + +e (DISCH_THEN(COMPLETE_TAC [`1`; `(*):num->num->num`; `i:num->num`]));; +e (ASM_REWRITE_TAC[]);; + +g `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) + ==> (neg 0 * (x * y + z + neg(neg(w + z))) + neg(neg b + neg a) = + a + b)`;; + +e (DISCH_THEN(COMPLETE_TAC + [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`]));; +e (ASM_REWRITE_TAC[]);; diff --git a/Examples/lagrange_lemma.ml b/Examples/lagrange_lemma.ml new file mode 100644 index 0000000..7f2155a --- /dev/null +++ b/Examples/lagrange_lemma.ml @@ -0,0 +1,99 @@ +(* ========================================================================= *) +(* Nice test for ring procedure and ordered rewriting: Lagrange lemma. *) +(* ========================================================================= *) + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Do the problems the (relatively) efficient way using the normalizer. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_4 = time prove + (`((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * + ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2)) = + (((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2)`, + CONV_TAC REAL_RING);; + +let LAGRANGE_8 = time prove + (`(p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * + (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2) + = (p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1 * w2) pow 2 + + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1 * v2) pow 2 + + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1 * u2) pow 2 + + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1 * t2) pow 2 + + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1 * s2) pow 2 + + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1 * r2) pow 2 + + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1 * q2) pow 2 + + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1 * p2) pow 2`, + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Or we can just use REAL_ARITH, which is also reasonably fast. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_4 = time prove + (`((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * + ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2)) = + (((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2)`, + REAL_ARITH_TAC);; + +let LAGRANGE_8 = time prove + (`(p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * + (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2) + = (p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1 * w2) pow 2 + + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1 * v2) pow 2 + + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1 * u2) pow 2 + + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1 * t2) pow 2 + + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1 * s2) pow 2 + + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1 * r2) pow 2 + + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1 * q2) pow 2 + + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1 * p2) pow 2`, + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* But they can be done (slowly) simply by ordered rewriting. *) +(* ------------------------------------------------------------------------- *) + +let LAGRANGE_4 = time prove + (`((x1 pow 2) + (x2 pow 2) + (x3 pow 2) + (x4 pow 2)) * + ((y1 pow 2) + (y2 pow 2) + (y3 pow 2) + (y4 pow 2)) = + (((((x1*y1) - (x2*y2)) - (x3*y3)) - (x4*y4)) pow 2) + + (((((x1*y2) + (x2*y1)) + (x3*y4)) - (x4*y3)) pow 2) + + (((((x1*y3) - (x2*y4)) + (x3*y1)) + (x4*y2)) pow 2) + + (((((x1*y4) + (x2*y3)) - (x3*y2)) + (x4*y1)) pow 2)`, + REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB; + REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; + REAL_ARITH `a + (b - c) = (a + b) - c`; + REAL_ARITH `a - (b - c) = a + (c - b)`; + REAL_ARITH `(a - b) + c = (a + c) - b`; + REAL_ARITH `(a - b) - c = a - (b + c)`; + REAL_ARITH `(a - b = c) = (a = b + c)`; + REAL_ARITH `(a = b - c) = (a + c = b)`; + REAL_ADD_AC; REAL_MUL_AC]);; + +let LAGRANGE_8 = time prove + (`(p1 pow 2 + q1 pow 2 + r1 pow 2 + s1 pow 2 + t1 pow 2 + u1 pow 2 + v1 pow 2 + w1 pow 2) * + (p2 pow 2 + q2 pow 2 + r2 pow 2 + s2 pow 2 + t2 pow 2 + u2 pow 2 + v2 pow 2 + w2 pow 2) + = (p1 * p2 - q1 * q2 - r1 * r2 - s1 * s2 - t1 * t2 - u1 * u2 - v1 * v2 - w1 * w2) pow 2 + + (p1 * q2 + q1 * p2 + r1 * s2 - s1 * r2 + t1 * u2 - u1 * t2 - v1 * w2 + w1 * v2) pow 2 + + (p1 * r2 - q1 * s2 + r1 * p2 + s1 * q2 + t1 * v2 + u1 * w2 - v1 * t2 - w1 * u2) pow 2 + + (p1 * s2 + q1 * r2 - r1 * q2 + s1 * p2 + t1 * w2 - u1 * v2 + v1 * u2 - w1 * t2) pow 2 + + (p1 * t2 - q1 * u2 - r1 * v2 - s1 * w2 + t1 * p2 + u1 * q2 + v1 * r2 + w1 * s2) pow 2 + + (p1 * u2 + q1 * t2 - r1 * w2 + s1 * v2 - t1 * q2 + u1 * p2 - v1 * s2 + w1 * r2) pow 2 + + (p1 * v2 + q1 * w2 + r1 * t2 - s1 * u2 - t1 * r2 + u1 * s2 + v1 * p2 - w1 * q2) pow 2 + + (p1 * w2 - q1 * v2 + r1 * u2 + s1 * t2 - t1 * s2 - u1 * r2 + v1 * q2 + w1 * p2) pow 2`, + REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB; + REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB; + REAL_ARITH `a + (b - c) = (a + b) - c`; + REAL_ARITH `a - (b - c) = a + (c - b)`; + REAL_ARITH `(a - b) + c = (a + c) - b`; + REAL_ARITH `(a - b) - c = a - (b + c)`; + REAL_ARITH `(a - b = c) = (a = b + c)`; + REAL_ARITH `(a = b - c) = (a + c = b)`; + REAL_ADD_AC; REAL_MUL_AC]);; diff --git a/Examples/lucas_lehmer.ml b/Examples/lucas_lehmer.ml new file mode 100644 index 0000000..98ef136 --- /dev/null +++ b/Examples/lucas_lehmer.ml @@ -0,0 +1,412 @@ +(* ========================================================================= *) +(* The Lucas-Lehmer test. *) +(* ========================================================================= *) + +needs "Library/iter.ml";; +needs "Library/pocklington.ml";; +needs "Library/floor.ml";; +needs "Multivariate/vectors.ml";; +needs "100/sqrt.ml";; + +(* ------------------------------------------------------------------------- *) +(* Relate real powers to iteration. *) +(* ------------------------------------------------------------------------- *) + +let REAL_POW_ITER = prove + (`!x n. x pow n = ITER n (\y. x * y) (&1)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ITER; real_pow]);; + +(* ------------------------------------------------------------------------- *) +(* Basic definition of the Lucas-Lehmer sequence. To avoid troubles with *) +(* cutoff subtraction and keep things in N we use m^2 + (p - 2) not m^2 - 2. *) +(* ------------------------------------------------------------------------- *) + +let llseq = define + `llseq p 0 = 4 MOD p /\ + llseq p (SUC n) = ((llseq p n) EXP 2 + (p - 2)) MOD p`;; + +(* ------------------------------------------------------------------------- *) +(* Closed form for the Lucas-Lehmer sequence. *) +(* ------------------------------------------------------------------------- *) + +let LLSEQ_CLOSEDFORM = prove + (`!p n. ~(p = 0) + ==> ?x. llseq p n = x MOD p /\ + &x = (&2 + sqrt(&3)) pow (2 EXP n) + + (&2 - sqrt(&3)) pow (2 EXP n)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THENL + [EXISTS_TAC `4` THEN REWRITE_TAC[llseq; EXP] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x EXP 2 - 2` THEN ASM_REWRITE_TAC[llseq] THEN + SUBGOAL_THEN `2 <= x EXP 2` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `2 EXP 2 <= x ==> 2 <= x`) THEN + REWRITE_TAC[EXP_MONO_LE; ARITH_EQ] THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= y /\ y pow 1 <= y pow n /\ &0 <= z pow n + ==> x <= y pow n + z pow n`) THEN + REPEAT CONJ_TAC THENL + [SIMP_TAC[REAL_LE_ADDR; SQRT_POS_LE; REAL_POS]; + MATCH_MP_TAC REAL_POW_MONO THEN + SIMP_TAC[LE_1; EXP_EQ_0; ARITH_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 <= &2 + x`) THEN + SIMP_TAC[SQRT_POS_LE; REAL_POS]; + MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN CONV_TAC REAL_RAT_REDUCE_CONV]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_CASES_TAC `p = 1` THENL [ASM_REWRITE_TAC[MOD_1]; ALL_TAC] THEN + TRANS_TAC EQ_TRANS `(x EXP 2 + (p - 2)) MOD p` THEN CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[ARITH_RULE + `2 <= x /\ ~(p = 0) /\ ~(p = 1) ==> x + p - 2 = (x - 2) + p`]] THEN + FIRST_ASSUM(fun t -> ONCE_REWRITE_TAC[GSYM(MATCH_MP MOD_ADD_MOD t)]) THENL + [ASM_MESON_TAC[MOD_EXP_MOD]; + ASM_SIMP_TAC[MOD_REFL; ADD_CLAUSES; MOD_MOD_REFL]]; + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[ADD1; EXP_ADD; GSYM REAL_POW_MUL; REAL_ARITH + `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN + REWRITE_TAC[REAL_ARITH `(&2 + s) * (&2 - s) = &4 - s pow 2`] THEN + REWRITE_TAC[REAL_SQRT_POW_2; REAL_ABS_NUM; GSYM REAL_POW_POW] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_ONE] THEN CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The main Lucas-Lehmer theorem. *) +(* ------------------------------------------------------------------------- *) + +let LUCAS_LEHMER = prove + (`!p. 2 <= p /\ llseq (2 EXP p - 1) (p - 2) = 0 ==> prime(2 EXP p - 1)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[PRIME_PRIME_FACTOR_SQRT] THEN + SUBGOAL_THEN `2 <= 2 EXP p - 1` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `2 EXP 2 <= x ==> 2 <= x - 1`) THEN + REWRITE_TAC[LE_EXP] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REPEAT(MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN + CONJ_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_GE_2) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IMP_NZ) THEN + ABBREV_TAC + `equiv = + \x y. ?a b. integer a /\ integer b /\ + x - y = (a + b * sqrt(&3)) * &q` THEN + SUBGOAL_THEN `!x:real. (x == x) equiv` ASSUME_TAC THENL + [REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + GEN_TAC THEN REPEAT(EXISTS_TAC `&0`) THEN + REWRITE_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y:real. (x == y) equiv <=> (y == x) equiv` + ASSUME_TAC THENL + [MATCH_MP_TAC(MESON[] + `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN + REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + MESON_TAC[INTEGER_CLOSED; REAL_ARITH + `x - y:real = (a + b * s) * q ==> y - x = (--a + --b * s) * q`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y z:real. (x == y) equiv /\ (y == z) equiv ==> (x == z) equiv` + ASSUME_TAC THENL + [REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + MESON_TAC[INTEGER_CLOSED; REAL_ARITH + `x - y = (a + b * s) * q /\ + y - z = (a' + b' * s) * q + ==> x - z:real = ((a + a') + (b + b') * s) * q`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k. ?a b. (&2 + sqrt(&3)) pow k = &a + &b * sqrt(&3)` + STRIP_ASSUME_TAC THENL + [INDUCT_TAC THENL + [MAP_EVERY EXISTS_TAC [`1`; `0`] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(X_CHOOSE_THEN `a:num` MP_TAC) THEN + REWRITE_TAC[real_pow; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b:num` THEN DISCH_THEN SUBST1_TAC THEN + MAP_EVERY EXISTS_TAC [`2 * a + 3 * b`; `2 * b + a`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + MP_TAC(SPEC `&3` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RING]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. ((&2 + sqrt(&3)) * x == (&2 + sqrt(&3)) * y) equiv <=> + (x == y) equiv` + ASSUME_TAC THENL + [SUBGOAL_THEN + `!x y:real. (x == y) equiv <=> (x - y == &0) equiv` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN SIMP_TAC[REAL_SUB_RZERO]; + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB]] THEN + REPEAT GEN_TAC THEN SPEC_TAC(`x - y:real`,`x:real`) THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN EQ_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_TAC THENL + [MAP_EVERY EXISTS_TAC [`&2 * u - &3 * v`; `&2 * v - u`]; + MAP_EVERY EXISTS_TAC [`&2 * u + &3 * v`; `&2 * v + u`]] THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN + MP_TAC(SPEC `&3` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `((&2 + sqrt(&3)) pow (2 EXP (p - 1)) == -- &1) equiv` + ASSUME_TAC THENL + [UNDISCH_THEN `!x y:real. (x == y) equiv <=> (y == x) equiv` + (K ALL_TAC) THEN + MP_TAC(ISPECL [`2 EXP p - 1`; `p - 2`] LLSEQ_CLOSEDFORM) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + ASM_SIMP_TAC[MOD_EQ_0; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` (MP_TAC o + AP_TERM `(*) ((&2 + sqrt(&3)) pow (2 EXP (p - 2)))`)) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_POW_2; REAL_POW_POW] THEN + REWRITE_TAC[REAL_ARITH `(&2 + s) * (&2 - s) = &4 - s pow 2`] THEN + REWRITE_TAC[REAL_SQRT_POW_2; REAL_ABS_NUM] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE] THEN + REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= p ==> SUC(p - 2) = p - 1`] THEN + SUBGOAL_THEN + `?a b. (&2 + sqrt(&3)) pow (2 EXP (p - 2)) = &a + &b * sqrt(&3)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + REWRITE_TAC[REAL_SUB_RNEG] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `s:num` SUBST1_TAC o + REWRITE_RULE[divides]) THEN + MAP_EVERY EXISTS_TAC [`&a * &r * &s`; `&b * &r * &s`] THEN + SIMP_TAC[INTEGER_CLOSED; GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((&2 + sqrt(&3)) pow (2 EXP p) == &1) equiv` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cong]) THEN + REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ARITH + `a - -- &1 = b <=> a = b - &1`] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `p = (p - 1) + 1` SUBST1_TAC THENL + [UNDISCH_TAC `2 <= p` THEN ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[EXP_ADD; GSYM REAL_POW_POW] THEN + EXISTS_TAC `&q * (a pow 2 + &3 * b pow 2) - &2 * a` THEN + EXISTS_TAC `&2 * a * b * &q - &2 * b` THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC]) THEN + CONV_TAC NUM_REDUCE_CONV THEN + MP_TAC(SPEC `&3` SQRT_POW_2) THEN REWRITE_TAC[REAL_POS] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `?k. 0 < k /\ k <= 2 EXP p - 1 /\ + !n. ((&2 + sqrt(&3)) pow n == &1) equiv <=> k divides n` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `\x y:real. (x == y) equiv` ORDER_EXISTENCE_CARD) THEN + REWRITE_TAC[REAL_POW_ITER] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC + (MESON[CARD_SUBSET; FINITE_SUBSET; LE_TRANS; CARD_IMAGE_LE; FINITE_IMAGE] + `!f:num#num->A t. s SUBSET IMAGE f t /\ FINITE t /\ CARD t <= n + ==> FINITE s /\ CARD s <= n`) THEN + EXISTS_TAC `\(a,b) y. (y == &a + &b * sqrt(&3)) equiv` THEN + EXISTS_TAC `(0..q-1) CROSS (0..q-1)` THEN + SIMP_TAC[CARD_CROSS; FINITE_CROSS; FINITE_NUMSEG; CARD_NUMSEG] THEN + ASM_SIMP_TAC[SUB_ADD; SUB_0; LE_1; GSYM EXP_2; SUBSET] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; IN_IMAGE; EXISTS_PAIR_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_CROSS; GSYM REAL_POW_ITER] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:num` MP_TAC o SPEC `n:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `b:num`) THEN + MAP_EVERY EXISTS_TAC [`a MOD q`; `b MOD q`] THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_0; DIVISION; FUN_EQ_THM; + ARITH_RULE `a <= q - 1 <=> a = 0 \/ a < q`] THEN + MATCH_MP_TAC(MESON[] + `(a == b) equiv /\ + ((a == b) equiv ==> !x. (x == a) equiv <=> (x == b) equiv) + ==> !x. (x == a) equiv <=> (x == b) equiv`) THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + MAP_EVERY EXISTS_TAC [`&(a DIV q)`; `&(b DIV q)`] THEN + REWRITE_TAC[INTEGER_CLOSED; REAL_RING + `(a + b * s) - (a' + b' * s):real = (a'' + b'' * s) * q <=> + a + b * s = (a'' * q + a') + (b'' * q + b') * s`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN + ASM_SIMP_TAC[GSYM DIVISION]; + SUBGOAL_THEN `k divides 2 EXP p` MP_TAC THENL + [ASM_MESON_TAC[]; SIMP_TAC[DIVIDES_PRIMEPOW; PRIME_2]] THEN + REWRITE_TAC[LE_LT; RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2] THEN + ASM_SIMP_TAC[ARITH_RULE `k <= p - 1 ==> (k = p <=> p = 0)`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH_EQ] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `((&2 + sqrt (&3)) pow (2 EXP (p - 1)) == &1) (equiv)` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN SIMP_TAC[DIVIDES_EXP_LE; LE_REFL] THEN + ASM_SIMP_TAC[ARITH_RULE `i < p ==> i <= p - 1`]; + ALL_TAC] THEN + SUBGOAL_THEN `(&1 == -- &1) (equiv)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[cong] THEN EXPAND_TAC "equiv" THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[REAL_ARITH `&1 - -- &1 = &2`] THEN + ASM_CASES_TAC `b = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + DISCH_THEN(MP_TAC o AP_TERM `abs`) THEN REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `?q. abs a = &q` (CHOOSE_THEN SUBST1_TAC) + THENL [ASM_MESON_TAC[integer]; REWRITE_TAC[REAL_ABS_NUM]] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + MP_TAC PRIME_2 THEN REWRITE_TAC[prime; ARITH_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `q:num`) THEN ANTS_TAC THENL + [REWRITE_TAC[divides] THEN ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[NUM_REDUCE_CONV `2 <= 1`]; ALL_TAC] THEN + SUBGOAL_THEN `2 divides (2 EXP p - 1) + 2` MP_TAC THENL + [MATCH_MP_TAC DIVIDES_ADD THEN ASM_REWRITE_TAC[DIVIDES_REFL]; + ASM_SIMP_TAC[ARITH_RULE `~(n - 1 = 0) ==> n - 1 + 2 = n + 1`]] THEN + REWRITE_TAC[DIVIDES_2; EVEN_ADD; EVEN_EXP; ARITH] THEN + UNDISCH_TAC `2 <= p` THEN ARITH_TAC; + DISCH_THEN(MP_TAC o MATCH_MP (REAL_FIELD + `&2 = (a + b * x) * q + ==> ~(b = &0) ==> x = (&2 - a * q) / (b * q)`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `rational`) THEN + SIMP_TAC[IRRATIONAL_SQRT_PRIME; PRIME_CONV `prime 3`] THEN + ASM_MESON_TAC[RATIONAL_CLOSED; INTEGER_CLOSED]]]);; + +(* ------------------------------------------------------------------------- *) +(* Actual evaluation of the LL sequence. *) +(* ------------------------------------------------------------------------- *) + +let ll_verbose = ref false;; + +let LUCAS_LEHMER_RULE = + let pth_base = prove + (`llseq (2 EXP p - 1) 0 = 4 MOD (2 EXP p - 1)`, + REWRITE_TAC[llseq]) + and pth_step = prove + (`llseq (2 EXP p - 1) n = m + ==> m * m + q = 2 EXP p * q + 2 + r /\ r < 2 EXP p - 1 + ==> llseq (2 EXP p - 1) (SUC n) = r`, + REWRITE_TAC[llseq] THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[LT] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SIMP_TAC[MOD_1; ARITH_RULE `r < 1 <=> r = 0`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN + EXISTS_TAC `q + 1` THEN ASM_REWRITE_TAC[EXP_2] THEN + MATCH_MP_TAC(ARITH_RULE `!p:num. (x + p) + y = p + z ==> x + y = z`) THEN + EXISTS_TAC `q:num` THEN + ASM_REWRITE_TAC[RIGHT_ADD_DISTRIB; LEFT_SUB_DISTRIB; MULT_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE + `x + y - 1 + w = u + v + z + r + 2 /\ 2 EXP 2 <= y /\ w * 1 <= v + ==> x + y - 1 - 2 = u + (v - w + z) + r`) THEN + REWRITE_TAC[LE_MULT_LCANCEL; LE_EXP; EXP_EQ_0; ARITH_RULE + `1 <= n <=> ~(n = 0)`] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC) + and pconv_tt = GEN_REWRITE_CONV I [TAUT `T /\ T <=> T`] + and p_tm = `p:num` and n_tm = `n:num` and m_tm = `m:num` + and q_tm = `q:num` and r_tm = `r:num` in + let ariconv = + let BINOP2_CONV conv1 conv2 = COMB2_CONV (RAND_CONV conv1) conv2 in + (BINOP2_CONV (BINOP2_CONV (LAND_CONV NUM_MULT_CONV THENC NUM_ADD_CONV) + (BINOP2_CONV NUM_MULT_CONV NUM_ADD_CONV THENC + NUM_ADD_CONV) THENC + NUM_EQ_CONV) + NUM_LT_CONV THENC pconv_tt) in + fun p -> + let th_base = CONV_RULE(RAND_CONV NUM_REDUCE_CONV) + (INST [mk_small_numeral p,p_tm] pth_base) + and th_step = CONV_RULE(RAND_CONV(LAND_CONV NUM_REDUCE_CONV)) + (INST [mk_small_numeral p,p_tm] pth_step) + and pp1 = pow2 p -/ Int 1 in + let rec lucas_lehmer k = + if k = 0 then th_base,dest_numeral(rand(concl th_base)) else + let th1,mval = lucas_lehmer (k - 1) in + let gofer() = + let mtm = rand(concl th1) in + let yval = power_num mval (Int 2) in + let qval = quo_num yval pp1 and rval = mod_num yval pp1 -/ Int 2 in + let th3 = INST [mk_small_numeral(k - 1),n_tm; mtm,m_tm; + mk_numeral qval,q_tm; mk_numeral rval,r_tm] th_step in + let th4 = MP th3 th1 in + let th5 = MP th4 (EQT_ELIM(ariconv(lhand(concl th4)))) in + CONV_RULE (LAND_CONV(RAND_CONV NUM_SUC_CONV)) th5,rval in + if !ll_verbose then + (Format.print_string("Iteration "^string_of_int k^" of "^ + string_of_int(p-2)); + Format.print_newline(); + time gofer()) + else gofer() in + let th1,y = lucas_lehmer (p - 2) in + if y <>/ Int 0 then failwith "LUCAS_LEHMER_RULE: not a prime" else + let th2 = SPEC(mk_small_numeral p) LUCAS_LEHMER in + let th3 = CONV_RULE + (LAND_CONV(RAND_CONV(LAND_CONV + (RAND_CONV NUM_SUB_CONV THENC K th1)))) th2 in + MP th3 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th3))));; + +(* ------------------------------------------------------------------------- *) +(* Time a few small examples. *) +(* ------------------------------------------------------------------------- *) + +ll_verbose := false;; + +time LUCAS_LEHMER_RULE 3;; +time LUCAS_LEHMER_RULE 5;; +time LUCAS_LEHMER_RULE 7;; +time LUCAS_LEHMER_RULE 13;; +time LUCAS_LEHMER_RULE 17;; +time LUCAS_LEHMER_RULE 19;; +time LUCAS_LEHMER_RULE 31;; +time LUCAS_LEHMER_RULE 61;; +time LUCAS_LEHMER_RULE 89;; +time LUCAS_LEHMER_RULE 107;; +time LUCAS_LEHMER_RULE 127;; +time LUCAS_LEHMER_RULE 521;; +time LUCAS_LEHMER_RULE 607;; + +(* ------------------------------------------------------------------------- *) +(* These take a while, so they're commented out here. *) +(* ------------------------------------------------------------------------- *) + +(*** + +ll_verbose := true;; + +time LUCAS_LEHMER_RULE 1279;; +time LUCAS_LEHMER_RULE 2203;; +time LUCAS_LEHMER_RULE 2281;; +time LUCAS_LEHMER_RULE 3217;; +time LUCAS_LEHMER_RULE 4253;; +time LUCAS_LEHMER_RULE 4423;; +time LUCAS_LEHMER_RULE 9689;; +time LUCAS_LEHMER_RULE 9941;; +time LUCAS_LEHMER_RULE 11213;; +time LUCAS_LEHMER_RULE 19937;; +time LUCAS_LEHMER_RULE 21701;; +time LUCAS_LEHMER_RULE 23209;; +time LUCAS_LEHMER_RULE 44497;; +time LUCAS_LEHMER_RULE 86243;; +time LUCAS_LEHMER_RULE 110503;; +time LUCAS_LEHMER_RULE 132049;; +time LUCAS_LEHMER_RULE 216091;; +time LUCAS_LEHMER_RULE 756839;; +time LUCAS_LEHMER_RULE 859433;; +time LUCAS_LEHMER_RULE 1257787;; +time LUCAS_LEHMER_RULE 1398269;; +time LUCAS_LEHMER_RULE 2976221;; +time LUCAS_LEHMER_RULE 3021377;; +time LUCAS_LEHMER_RULE 6972593;; +time LUCAS_LEHMER_RULE 13466917;; +time LUCAS_LEHMER_RULE 20996011;; +time LUCAS_LEHMER_RULE 24036583;; +time LUCAS_LEHMER_RULE 25964951;; +time LUCAS_LEHMER_RULE 30402457;; + +****) diff --git a/Examples/machin.ml b/Examples/machin.ml new file mode 100644 index 0000000..f6bb5f0 --- /dev/null +++ b/Examples/machin.ml @@ -0,0 +1,850 @@ +(* ========================================================================= *) +(* Derivation of Machin's formula and other similar ones. *) +(* ========================================================================= *) + +needs "Library/transc.ml";; + +let REAL_LE_1_POW2 = prove + (`!n. &1 <= &2 pow n`, + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> 0 < n`; + EXP_LT_0; ARITH]);; + +let REAL_LT_1_POW2 = prove + (`!n. &1 < &2 pow n <=> ~(n = 0)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&2 pow 0`)) THEN + MATCH_MP_TAC REAL_POW_MONO_LT THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let REAL_POW2_CLAUSES = prove + (`(!n. &0 <= &2 pow n) /\ + (!n. &0 < &2 pow n) /\ + (!n. &0 <= inv(&2 pow n)) /\ + (!n. &0 < inv(&2 pow n)) /\ + (!n. inv(&2 pow n) <= &1) /\ + (!n. &1 - inv(&2 pow n) <= &1) /\ + (!n. &1 <= &2 pow n) /\ + (!n. &1 < &2 pow n <=> ~(n = 0)) /\ + (!n. &0 <= &1 - inv(&2 pow n)) /\ + (!n. &0 <= &2 pow n - &1) /\ + (!n. &0 < &1 - inv(&2 pow n) <=> ~(n = 0))`, + SIMP_TAC[REAL_LE_1_POW2; REAL_LT_1_POW2; REAL_SUB_LE; REAL_SUB_LT; + REAL_INV_LE_1] THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_INV_EQ; REAL_POW_LT; REAL_POW_LE; + REAL_OF_NUM_LE; REAL_OF_NUM_LT; ARITH; + REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow 1)` THEN + ASM_SIMP_TAC[REAL_LE_INV2; REAL_POW_MONO; REAL_POW_LT; REAL_OF_NUM_LT; ARITH; + REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let REAL_POW2_THM = prove + (`&0 < &2 pow n /\ + &1 <= &2 pow n /\ + (&1 < &2 pow n <=> ~(n = 0)) /\ + (&2 pow m <= &2 pow n <=> m <= n) /\ + (&2 pow m < &2 pow n <=> m < n) /\ + (inv(&2 pow m) <= inv(&2 pow n) <=> n <= m) /\ + (inv(&2 pow m) < inv(&2 pow n) <=> n < m)`, + REWRITE_TAC[REAL_POW2_CLAUSES] THEN + SUBGOAL_THEN `!m n. &2 pow m <= &2 pow n <=> m <= n` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH] THEN + CONV_TAC CONTRAPOS_CONV THEN + SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; REAL_POW_MONO_LT; REAL_OF_NUM_LT; + NOT_LE; ARITH]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN REWRITE_TAC[GSYM NOT_LE] THEN + SUBGOAL_THEN `!m n. inv(&2 pow m) <= inv(&2 pow n) <=> &2 pow n <= &2 pow m` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[REAL_LE_INV2; REAL_POW2_CLAUSES] THEN + CONV_TAC CONTRAPOS_CONV THEN + SIMP_TAC[REAL_NOT_LE; REAL_LT_INV2; REAL_POW2_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Compound errors given bounds in assumptions. *) +(* ------------------------------------------------------------------------- *) + +let BOUND_SUMPROD_RULE = + let pth_add = REAL_ARITH + `abs(x1) <= b1 /\ abs(x2) <= b2 ==> abs(x1 + x2) <= b1 + b2` + and pth_sub = REAL_ARITH + `abs(x1) <= b1 /\ abs(x2) <= b2 ==> abs(x1 - x2) <= b1 + b2` + and pth_mul = prove + (`abs(x1) <= b1 /\ abs(x2) <= b2 ==> abs(x1 * x2) <= b1 * b2`, + REWRITE_TAC[REAL_ABS_MUL] THEN + SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS]) + and pth_neg = REAL_ARITH + `abs(x1) <= b1 ==> abs(--x1) <= b1` + and pth_pow = prove + (`abs(x) <= b1 ==> abs(x pow n) <= b1 pow n`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]) + and pth_abs = REAL_ARITH `abs(x) <= b ==> abs(abs(x)) <= b` + and pth_triv = REAL_ARITH `abs(x) <= abs(x)` + and n_tm = `n:num` in + let rec BOUND_SUMPROD_RULE (asl,w) = + let tm = rator w in + try tryfind (fun (_,th) -> if rator(concl th) = tm then th + else fail()) asl + with Failure _ -> try + let pth,th = tryfind + (fun pth -> pth,PART_MATCH (rator o rand) pth tm) + [pth_neg; pth_abs] in + let th1 = BOUND_SUMPROD_RULE (asl,lhand(concl th)) in + MATCH_MP pth th1 + with Failure _ -> try + let pth = INST [funpow 3 rand tm,n_tm] pth_pow in + let th = PART_MATCH (rator o rand) pth tm in + let th1 = BOUND_SUMPROD_RULE (asl,lhand(concl th)) in + MATCH_MP (INST [funpow 3 rand tm,n_tm] pth_pow) th1 + with Failure _ -> try + let pth,th = tryfind + (fun pth -> pth,PART_MATCH (rator o rand) pth tm) + [pth_add; pth_sub; pth_mul] in + let trm = lhand(concl th) in + let th1 = BOUND_SUMPROD_RULE (asl,lhand trm) + and th2 = BOUND_SUMPROD_RULE (asl,rand trm) in + MATCH_MP pth (CONJ th1 th2) + with Failure _ -> + PART_MATCH rator pth_triv tm in + BOUND_SUMPROD_RULE;; + +let BOUND_SUMPROD_TAC = + let tac = + let pth = + REAL_ARITH `x <= a ==> (!b. a <= b ==> x <= b) /\ + (!b. a < b ==> x < b)` in + fun th -> + let th1,th2 = CONJ_PAIR(MATCH_MP pth th) in + MATCH_MP_TAC th1 ORELSE MATCH_MP_TAC th2 + and le_tm = `(<=):real->real->bool` in + fun (asl,w as gl) -> + let l,r = dest_comb w in + let gv = genvar(type_of r) in + let tm = mk_comb(mk_comb(le_tm,rand l),gv) in + let th = BOUND_SUMPROD_RULE(asl,tm) in + tac th gl;; + +(* ------------------------------------------------------------------------- *) +(* Power series for atn. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ATN_POWSER_SUMMABLE = prove + (`!x. abs(x) < &1 + ==> summable (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC REAL_LE_LDIV THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_OF_NUM_LT; EVEN; LT_NZ]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN + ASM_MESON_TAC[REAL_OF_NUM_LE; EVEN; ARITH_RULE `1 <= n <=> ~(n = 0)`]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN + MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; + +let REAL_ATN_POWSER_DIFFS_SUMMABLE = prove + (`!x. abs(x) < &1 + ==> summable (\n. diffs (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n)) n * + x pow n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_ABS_POS; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN + MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; + +let REAL_ATN_POWSER_DIFFS_SUM = prove + (`!x. abs(x) < &1 + ==> (\n. diffs (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n) + sums (inv(&1 + x pow 2))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUMMABLE) THEN + DISCH_THEN(fun th -> MP_TAC(MATCH_MP SUMMABLE_SUM th) THEN + MP_TAC(MATCH_MP SER_PAIR th)) THEN + SUBGOAL_THEN + `(\n. sum (2 * n,2) (\n. diffs + (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)) = + (\n. --(x pow 2) pow n)` + SUBST1_TAC THENL + [ABS_TAC THEN + CONV_TAC(LAND_CONV(LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)))) THEN + REWRITE_TAC[sum; diffs; ADD_CLAUSES; EVEN_MULT; ARITH_EVEN; EVEN] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LZERO; + REAL_MUL_RZERO] THEN + SIMP_TAC[ARITH_RULE `SUC n - 1 = n`; DIV_MULT; ARITH_EQ] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW_POW] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]; ALL_TAC] THEN + SUBGOAL_THEN `(\n. --(x pow 2) pow n) sums inv (&1 + x pow 2)` MP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `&1 + x = &1 - (--x)`] THEN + MATCH_MP_TAC GP THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL2; REAL_ABS_POS]; ALL_TAC] THEN + MESON_TAC[SUM_UNIQ]);; + +let REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE = prove + (`!x. abs(x) < &1 + ==> summable + (\n. diffs (diffs + (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n))) n * x pow n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. &(SUC n) * abs(x) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_ABS_POS; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_MUL_LID; + REAL_ABS_NUM; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SER_RATIO THEN + SUBGOAL_THEN `?c. abs(x) < c /\ c < &1` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `(&1 + abs(x)) / &2` THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?N. !n. n >= N ==> &(SUC(SUC n)) * abs(x) <= &(SUC n) * c` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[real_pow; REAL_ABS_MUL; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_ABS] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[]] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO] THEN + EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS] THEN UNDISCH_TAC `abs(x) < c` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x + &1 <= y <=> &1 <= y - x * &1`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + SUBGOAL_THEN `?N. &1 <= &N * (c / abs x - &1)` STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC `N:num` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&1 <= x ==> x <= y ==> &1 <= y`)) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b ==> a <= b + &1`; + REAL_OF_NUM_LE; REAL_LE_RADD] THEN + REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; + REAL_LT_IMP_LE]] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_SUB_LADD; REAL_ADD_LID; + REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; + REAL_ARCH_SIMPLE]);; + +let REAL_ATN_POWSER_DIFFL = prove + (`!x. abs(x) < &1 + ==> ((\x. suminf (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)) + diffl (inv(&1 + x pow 2))) x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUM) THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN + MATCH_MP_TAC TERMDIFF THEN + SUBGOAL_THEN `?K. abs(x) < abs(K) /\ abs(K) < &1` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `(&1 + abs(x)) / &2` THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ABS_DIV; REAL_ABS_NUM; + REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_ATN_POWSER_SUMMABLE; REAL_ATN_POWSER_DIFFS_SUMMABLE; + REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE]);; + +let REAL_ATN_POWSER = prove + (`!x. abs(x) < &1 + ==> (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) + sums (atn x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + SUBGOAL_THEN + `suminf (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) = atn(x)` + (fun th -> REWRITE_TAC[th]) THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a = b) <=> (a - b = &0)`] THEN + SUBGOAL_THEN + `suminf (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * &0 pow n) - + atn(&0) = &0` + MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `(a = &0) /\ (b = &0) ==> (a - b = &0)`) THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN + MP_TAC(SPEC `&0` GP) THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP SER_CMUL) THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN + MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + CONV_TAC SYM_CONV THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN ASM_MESON_TAC[EVEN]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM TAN_0] THEN + MATCH_MP_TAC TAN_ATN THEN + SIMP_TAC[PI2_BOUNDS; REAL_ARITH `&0 < x ==> --x < &0`]]; + ALL_TAC] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MP_TAC(SPEC `\x. suminf (\n. (if EVEN n then &0 + + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) - + atn x` DIFF_ISCONST_END_SIMPLE) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ x < &0`)) + THENL + [DISCH_THEN(MP_TAC o SPECL [`&0`; `x:real`]); + CONV_TAC(RAND_CONV SYM_CONV) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `&0`])] THEN + (REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs(u) < &1` (MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFL) THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o C CONJ (SPEC `u:real` DIFF_ATN)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN + REWRITE_TAC[REAL_SUB_REFL]));; + +(* ------------------------------------------------------------------------- *) +(* A more Taylor-like version with a simply bounded remainder term. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_ATN_SIMPLE = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(k = 0) + ==> abs(atn x - + sum(0,n) (\m. (if EVEN m then &0 + else --(&1) pow ((m - 1) DIV 2) / &m) * + x pow m)) + <= &2 * abs(x) pow n`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `abs(x) < &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[REAL_ARITH `a < &1 <=> &0 < &1 - a`; REAL_POW2_CLAUSES]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER) THEN + DISCH_THEN(fun th -> ASSUME_TAC(SYM(MATCH_MP SUM_UNIQ th)) THEN + MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_OFFSET) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(r) <= e ==> (f - s = r) ==> abs(f - s) <= e`) THEN + SUBGOAL_THEN + `(\m. abs(x) pow (m + n)) sums (abs(x) pow n) * inv(&1 - abs(x))` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP GP o MATCH_MP (REAL_ARITH + `abs(x) < &1 ==> abs(abs x) < &1`)) THEN + DISCH_THEN(MP_TAC o SPEC `abs(x) pow n` o MATCH_MP SER_CMUL) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_POW_ADD]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `suminf (\m. abs(x) pow (m + n))` THEN CONJ_TAC THENL + [ALL_TAC; + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_ABS_POS; REAL_POW_LE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ONCE_REWRITE_TAC[REAL_ARITH `a <= &1 - b <=> b <= &1 - a`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN + ASM_SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; + ARITH_RULE `~(k = 0) ==> 1 <= k`]] THEN + SUBGOAL_THEN + `!m. abs((if EVEN (m + n) then &0 + else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * + x pow (m + n)) + <= abs(x) pow (m + n)` + ASSUME_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_POW_LE; REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_MESON_TAC[EVEN]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `suminf (\m. abs((if EVEN (m + n) then &0 + else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * + x pow (m + n)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SER_ABS THEN MATCH_MP_TAC SER_COMPARA THEN + EXISTS_TAC `\m. abs(x) pow (m + n)` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUM_SUMMABLE]; ALL_TAC] THEN + MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SER_COMPARA THEN + EXISTS_TAC `\m. abs(x) pow (m + n)` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[SUM_SUMMABLE]);; + +let MCLAURIN_ATN_APPROX = prove + (`!x n k. abs(x) <= inv(&2 pow k) /\ ~(k = 0) + ==> abs(atn x - + sum(0,n) (\m. (if EVEN m then &0 + else --(&1) pow ((m - 1) DIV 2) / &m) * + x pow m)) + <= inv(&2 pow (n * k - 1))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[sum; REAL_SUB_RZERO; MULT_CLAUSES; SUB_0] THEN + MP_TAC(SPECL [`x:real`; `2`; `k:num`] MCLAURIN_ATN_SIMPLE) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(y) + d <= e ==> abs(x - y) <= d ==> abs(x) <= e`) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_pow; REAL_POW_1] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_1; REAL_ADD_LID] THEN + SUBGOAL_THEN `abs(x) <= inv(&2)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 pow k)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN + ASM_SIMP_TAC[REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; + ARITH_RULE `~(k = 0) ==> 1 <= k`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2) + &2 * inv(&2) pow 2` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[REAL_POW_1] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; + REAL_POW_LE2; REAL_OF_NUM_LE; REAL_ABS_POS]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * abs(x) pow n` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MCLAURIN_ATN_SIMPLE THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_POW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; + ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0] THEN + REWRITE_TAC[REAL_INV_DIV; REAL_POW_1] THEN REWRITE_TAC[real_div] THEN + SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REWRITE_TAC[REAL_ABS_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Rules to return approximations to atn(x) good to 2^-p given |x| <= 2^-k. *) +(* ------------------------------------------------------------------------- *) + +let mclaurin_atn_rule,MCLAURIN_ATN_RULE = + let x_tm = `x:real` + and n_tm = `n:num` + and k_tm = `k:num` + and inv_tm = `inv` + and le_tm = `(<=):real->real->bool` + and pow2_tm = `(pow) (&2)` in + let pth = SPECL [x_tm; n_tm; k_tm] MCLAURIN_ATN_APPROX + and CLEAN_RULE = REWRITE_RULE[real_pow] + and MATCH_REAL_LE_TRANS = MATCH_MP REAL_LE_TRANS + and num_0 = Int 0 + and num_1 = Int 1 in + let mclaurin_atn_rule k0 p0 = + if k0 = 0 then failwith "mclaurin_atn_rule: must have |x| <= 1/2" else + let k = Int k0 + and p = Int p0 in + let n = Num.int_of_num(ceiling_num ((p +/ k) // k)) in + let ns = if n mod 2 = 0 then 0--(n - 1) else 0--(n - 2) in + map (fun m -> if m mod 2 = 0 then num_0 else + (if (m - 1) mod 4 = 0 then I else minus_num) + (num_1 // Int m)) ns + and MCLAURIN_ATN_RULE k0 p0 = + if k0 = 0 then failwith "MCLAURIN_ATN_RULE: must have |x| <= 1/2" else + let k = Int k0 + and p = Int p0 in + let n = ceiling_num ((p +/ k) // k) in + let th1 = INST [mk_numeral k,k_tm; mk_numeral n,n_tm] pth in + let th2 = ASSUME (lhand(lhand(concl th1))) + and th3 = EQF_ELIM(NUM_REDUCE_CONV(rand(rand(lhand(concl th1))))) in + let th4 = MP th1 (CONJ th2 th3) in + let th5 = CONV_RULE(ONCE_DEPTH_CONV REAL_HORNER_SUM_CONV) th4 in + let th6 = CLEAN_RULE th5 in + let th7 = CONV_RULE (NUM_REDUCE_CONV THENC LAND_CONV REAL_RAT_REDUCE_CONV) + (BETA_RULE th6) in + let tm1 = mk_comb(inv_tm,mk_comb(pow2_tm,mk_numeral p)) in + let tm2 = mk_comb(mk_comb(le_tm,rand(concl th7)),tm1) in + let th8 = EQT_ELIM((NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) tm2) in + let th9 = MATCH_REAL_LE_TRANS (CONJ th7 th8) in + GEN x_tm (DISCH_ALL th9) in + mclaurin_atn_rule,MCLAURIN_ATN_RULE;; + +(* ------------------------------------------------------------------------- *) +(* Lemmas for Machin-type formulas. *) +(* ------------------------------------------------------------------------- *) + +let TAN_ADD_ATN_SIDECOND = prove + (`!x y. ~(x * y = &1) ==> ~(cos(atn x + atn y) = &0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[COS_ADD; REAL_ARITH `(a - b = &0) <=> (a = b)`] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) (inv(cos(atn x)))`) THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; COS_ATN_NZ; REAL_MUL_LID] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) (inv(cos(atn y)))`) THEN + SIMP_TAC[REAL_MUL_LINV; COS_ATN_NZ; REAL_MUL_LID; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (c * b) * (d * a)`] THEN + ASM_REWRITE_TAC[GSYM tan; GSYM real_div; ATN_TAN]);; + +let ATN_ADD = prove + (`!x y. ~(x * y = &1) /\ + abs(atn x + atn y) < pi / &2 + ==> (atn(x) + atn(y) = atn((x + y) / (&1 - x * y)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `tan(atn(x) + atn(y)) = (x + y) / (&1 - x * y)` MP_TAC THENL + [ASM_SIMP_TAC[ATN_TAN; TAN_ADD; COS_ATN_NZ; TAN_ADD_ATN_SIDECOND]; + DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN + ASM_SIMP_TAC[TAN_ATN; REAL_ARITH `abs(x) < e ==> --e < x /\ x < e`]]);; + +let ATN_ADD_SMALL_LEMMA_POS = prove + (`!x y. &0 < y /\ x * y < &1 + ==> atn(x) + atn(y) < pi / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN + SUBGOAL_THEN `pi / &2 - atn y = atn(tan(pi / &2 - atn y))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC TAN_ATN THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < a ==> --a < a - x /\ a - x < a`) THEN + REWRITE_TAC[ATN_BOUNDS] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ATN_0] THEN + ASM_SIMP_TAC[ATN_MONO_LT]; + MATCH_MP_TAC ATN_MONO_LT THEN REWRITE_TAC[TAN_COT; ATN_TAN] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_LT_IMP_NZ]]);; + +let ATN_ADD_SMALL_LEMMA = prove + (`!x y. abs(x * y) < &1 ==> abs(atn(x) + atn(y)) < pi / &2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `--a < x /\ x < a /\ --a < y /\ y < a /\ + (&0 < y ==> x + y < a) /\ + (&0 < --y ==> --x + --y < a) + ==> abs(x + y) < a`) THEN + REWRITE_TAC[ATN_BOUNDS] THEN CONJ_TAC THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ATN_NEG] THEN + MATCH_MP_TAC ATN_ADD_SMALL_LEMMA_POS THEN + ASM_SIMP_TAC[REAL_ARITH `abs(x) < &1 ==> x < &1`; + REAL_ARITH `--x * -- y = x * y`] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&0 < y ==> (z <= &0 ==> y <= &0) ==> &0 < z`)) THEN + MATCH_MP_TAC(REAL_ARITH + `(y < &0 ==> z < &0) /\ ((y = &0) ==> (z = &0)) + ==> y <= &0 ==> z <= &0`) THEN + SIMP_TAC[ATN_0; GSYM ATN_NEG] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ATN_0] THEN + SIMP_TAC[ATN_MONO_LT]);; + +let ATN_ADD_SMALL = prove + (`!x y. abs(x * y) < &1 + ==> (atn(x) + atn(y) = atn((x + y) / (&1 - x * y)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ATN_ADD THEN + ASM_SIMP_TAC[ATN_ADD_SMALL_LEMMA] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let ATN_ADD_CONV = + let match_fn = PART_MATCH (lhand o rand) ATN_ADD_SMALL in + let overall_fn = + C MP TRUTH o + CONV_RULE + (COMB2_CONV REAL_RAT_REDUCE_CONV + (RAND_CONV REAL_RAT_REDUCE_CONV)) o + match_fn in + fun tm -> if is_ratconst(rand(rand tm)) & + is_ratconst(rand(lhand tm)) + then overall_fn tm + else failwith "ATN_ADD_CONV: Atn of nonconstant";; + +let ATN_CMUL_CONV = + let pth_base = prove + (`(&0 * atn(x) = &0) /\ + (&1 * atn(x) = atn(x))`, + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID]) + and pth_0,pth_1 = (CONJ_PAIR o prove) + (`(&(NUMERAL(BIT0 n)) * atn(x) = + &(NUMERAL n) * atn(x) + &(NUMERAL n) * atn(x)) /\ + (&(NUMERAL(BIT1 n)) * atn(x) = + atn(x) + &(NUMERAL n) * atn(x) + &(NUMERAL n) * atn(x))`, + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC) in + let rewr_base = GEN_REWRITE_CONV I [pth_base] + and rewr_0 = GEN_REWRITE_CONV I [pth_0] + and rewr_1 = GEN_REWRITE_CONV I [pth_1] in + let rec ATN_CMUL_CONV tm = + if not (is_ratconst(rand(rand tm))) then failwith "ATN_CMUL_CONV" else + try rewr_base tm with Failure _ -> + try let th1 = rewr_0 tm in + let tm1 = rand(concl th1) in + let th2 = ATN_CMUL_CONV(rand tm1) in + let th3 = MK_COMB(AP_TERM (rator(rator tm1)) th2,th2) in + let th4 = TRANS th3 (ATN_ADD_CONV(rand(concl th3))) in + TRANS th1 th4 + with Failure _ -> + let th1 = rewr_1 tm in + let tm1 = rand(rand(concl th1)) in + let th2 = ATN_CMUL_CONV(rand tm1) in + let th3 = MK_COMB(AP_TERM (rator(rator tm1)) th2,th2) in + let th4 = TRANS th3 (ATN_ADD_CONV(rand(concl th3))) in + let th5 = AP_TERM (rator(rand(concl th1))) th4 in + let th6 = TRANS th5 (ATN_ADD_CONV(rand(concl th5))) in + TRANS th1 th6 in + ATN_CMUL_CONV;; + +let ATN_SUB_CONV = + let pth = prove + (`(atn(x) - atn(y) = atn(x) + atn(--y))`, + REWRITE_TAC[real_sub; ATN_NEG]) in + GEN_REWRITE_CONV I [pth] THENC + RAND_CONV(RAND_CONV REAL_RAT_NEG_CONV) THENC + ATN_ADD_CONV;; + +let MACHIN_CONV = + DEPTH_CONV(ATN_ADD_CONV ORELSEC ATN_SUB_CONV ORELSEC ATN_CMUL_CONV);; + +let MACHIN_RULE tm = SYM(TRANS (MACHIN_CONV tm) ATN_1);; + +let MACHIN_1 = time MACHIN_RULE `&4 * atn(&1 / &5) - atn(&1 / &239)`;; +let MACHIN_2 = time MACHIN_RULE `atn(&1 / &2) + atn(&1 / &3)`;; +let MACHIN_3 = time MACHIN_RULE `&2 * atn(&1 / &2) - atn(&1 / &7)`;; +let MACHIN_4 = time MACHIN_RULE `&2 * atn(&1 / &3) + atn(&1 / &7)`;; + +let EULER = time MACHIN_RULE `&5 * atn(&1 / &7) + &2 * atn (&3 / &79)`;; + +let GAUSS_MACHIN = time MACHIN_RULE + `&12 * atn(&1 / &18) + &8 * atn (&1 / &57) - &5 * atn(&1 / &239)`;; + +let STRASSNITZKY_MACHIN = time MACHIN_RULE + `atn(&1 / &2) + atn (&1 / &5) + atn(&1 / &8)`;; + +let MACHINLIKE_1 = time MACHIN_RULE + `&6 * atn(&1 / &8) + &2 * atn(&1 / &57) + atn(&1 / &239)`;; +let MACHINLIKE_2 = time MACHIN_RULE + `&4 * atn(&1 / &5) - &1 * atn(&1 / &70) + atn(&1 / &99)`;; +let MACHINLIKE_3 = time MACHIN_RULE + `&1 * atn(&1 / &2) + &1 * atn(&1 / &5) + atn(&1 / &8)`;; +let MACHINLIKE_4 = time MACHIN_RULE + `&8 * atn(&1 / &10) - &1 * atn(&1 / &239) - &4 * atn(&1 / &515)`;; +let MACHINLIKE_5 = time MACHIN_RULE + `&5 * atn(&1 / &7) + &4 * atn(&1 / &53) + &2 * atn(&1 / &4443)`;; + +(***** Hopefully this one would work, but it takes a long time + +let HWANG_MACHIN = time MACHIN_RULE + `&183 * atn(&1 / &239) + &32 * atn(&1 / &1023) - + &68 * atn(&1 / &5832) + &12 * atn(&1 / &110443) - + &12 * atn(&1 / &4841182) - &100 * atn(&1 / &6826318)`;; + + *****) + +(* ------------------------------------------------------------------------- *) +(* Approximate the arctan of a rational number. *) +(* ------------------------------------------------------------------------- *) + +let rec POLY l x = + if l = [] then num_0 + else hd l +/ (x */ POLY (tl l) x);; + +let atn_approx_conv,ATN_APPROX_CONV = + let atn_tm = `atn` + and num_0 = Int 0 + and num_1 = Int 1 + and num_2 = Int 2 in + let rec log_2 x = if x <=/ num_1 then log_2 (num_2 */ x) -/ num_1 + else if x >/ num_2 then log_2 (x // num_2) +/ num_1 + else num_1 in + let pth = prove + (`!p. abs(atn(&0) - &0) <= inv(&2 pow p)`, + SIMP_TAC[ATN_0; REAL_SUB_REFL; REAL_ABS_NUM; REAL_LE_INV_EQ; + REAL_POW_LE; REAL_POS]) in + let atn_approx_conv p r = + if r =/ num_0 then num_0 else + let k = Num.int_of_num(minus_num(log_2(abs_num r))) in + if k < 1 then failwith "atn_approx_conv: argument too big" else + let rats = mclaurin_atn_rule k p in + POLY rats r + and ATN_APPROX_CONV p tm = + let atm,rtm = dest_comb tm in + if atm <> atn_tm then failwith "ATN_APPROX_CONV" else + let r = rat_of_term rtm in + if r =/ num_0 then SPEC (mk_small_numeral p) pth else + let k = Num.int_of_num(minus_num(log_2(abs_num r))) in + if k < 1 then failwith "ATN_APPROX_CONV: argument too big" else + let th1 = MCLAURIN_ATN_RULE k p in + let th2 = SPEC rtm th1 in + let th3 = MP th2 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th2)))) in + CONV_RULE(LAND_CONV(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV))) th3 in + atn_approx_conv,ATN_APPROX_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Approximate pi using this and a Machin-type formula. *) +(* ------------------------------------------------------------------------- *) + +let pi_approx_rule,PI_APPROX_RULE = + let const_1_8 = Int 1 // Int 8 + and const_1_57 = Int 1 // Int 57 + and const_1_239 = Int 1 // Int 239 + and const_24 = Int 24 + and const_8 = Int 8 + and const_4 = Int 4 + and tm_1_8 = `atn(&1 / &8)` + and tm_1_57 = `atn(&1 / &57)` + and tm_1_239 = `atn(&1 / &239)` + and q1_tm = `q1:num` + and q2_tm = `q2:num` + and p_tm = `p:num` in + let pth = prove + (`(q1 = p + 5) /\ + (q2 = p + 6) /\ + abs(atn(&1 / &8) - a1) <= inv(&2 pow q1) /\ + abs(atn(&1 / &57) - a2) <= inv(&2 pow q2) /\ + abs(atn(&1 / &239) - a3) <= inv(&2 pow q2) + ==> abs(pi - (&24 * a1 + &8 * a2 + &4 * a3)) <= inv(&2 pow p)`, + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(inv(&2 pow 2))` THEN + SIMP_TAC[REAL_POW2_CLAUSES; REAL_ARITH `&0 < x ==> &0 < abs(x)`] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_POW_ADD] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div; MACHINLIKE_1] THEN + REWRITE_TAC[REAL_ARITH `(x1 + x2 + x3) - (y1 + y2 + y3) = + (x1 - y1) + (x2 - y2) + (x3 - y3)`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN BOUND_SUMPROD_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_LE_RMUL_EQ; REAL_POW2_CLAUSES] THEN + CONV_TAC REAL_RAT_REDUCE_CONV) in + let pi_approx_rule p = + let q1 = p + 5 + and q2 = p + 6 in + let a1 = atn_approx_conv q1 const_1_8 + and a2 = atn_approx_conv q2 const_1_57 + and a3 = atn_approx_conv q2 const_1_239 in + const_24 */ a1 +/ const_8 */ a2 +/ const_4 */ a3 + and PI_APPROX_RULE p = + let q1 = p + 5 + and q2 = p + 6 in + let th1 = ATN_APPROX_CONV q1 tm_1_8 + and th2 = ATN_APPROX_CONV q2 tm_1_57 + and th3 = ATN_APPROX_CONV q2 tm_1_239 in + let th4 = INST [mk_small_numeral p,p_tm; + mk_small_numeral q1,q1_tm; + mk_small_numeral q2,q2_tm] pth in + let th5 = EQT_ELIM(NUM_REDUCE_CONV(lhand(lhand(concl th4)))) + and th6 = EQT_ELIM(NUM_REDUCE_CONV(lhand(rand(lhand(concl th4))))) in + let th7 = MATCH_MP th4 (end_itlist CONJ [th5; th6; th1; th2; th3]) in + CONV_RULE(LAND_CONV(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV))) th7 in + pi_approx_rule,PI_APPROX_RULE;; + +(* ------------------------------------------------------------------------- *) +(* A version that yields a fraction with power of two denominator. *) +(* ------------------------------------------------------------------------- *) + +let pi_approx_binary_rule,PI_APPROX_BINARY_RULE = + let pth = prove + (`abs(x - r) <= inv(&2 pow (SUC p)) + ==> !a. abs(&2 pow p * r - a) <= inv(&2) + ==> abs(x - a / &2 pow p) <= inv(&2 pow p)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - r) <= q ==> abs(r - r') <= p - q ==> abs(x - r') <= p`)) THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow p)` THEN + SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs(x)`; REAL_POW2_THM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN + SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; GSYM real_div; + REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_POW2_CLAUSES; + REAL_DIV_POW2; REAL_OF_NUM_EQ; ARITH_EQ; + LE_REFL; ARITH_RULE `~(SUC p <= p)`; + ARITH_RULE `SUC p - p = 1`; SUB_REFL] THEN + UNDISCH_TAC `abs (&2 pow p * r - a) <= inv (&2)` THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV) + and num_2 = Int 2 in + let pi_approx_binary_rule p = + let ppow = power_num num_2 (Int p) in + let r = pi_approx_rule (p + 1) in + let a = round_num (ppow */ r) in + a // ppow + and PI_APPROX_BINARY_RULE p = + let ppow = power_num num_2 (Int p) in + let th1 = PI_APPROX_RULE (p + 1) in + let th2 = CONV_RULE(funpow 3 RAND_CONV num_CONV) th1 in + let r = rat_of_term(rand(rand(lhand(concl th2)))) in + let th3 = SPEC (mk_realintconst(round_num(ppow */ r))) (MATCH_MP pth th2) in + let th4 = MP th3 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th3)))) in + CONV_RULE(LAND_CONV(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV))) th4 in + pi_approx_binary_rule,PI_APPROX_BINARY_RULE;; + +(* ------------------------------------------------------------------------- *) +(* Rule to expand atn(r) for rational r into more easily calculable bits. *) +(* ------------------------------------------------------------------------- *) + +let ATN_EXPAND_CONV = + let num_0 = Int 0 + and num_1 = Int 1 + and num_2 = Int 2 + and eighth = Int 1 // Int 8 + and atn_tm = `atn` + and eighth_tm = `&1 / &8` + and mk_mul = mk_binop `(*)` + and mk_add = mk_binop `(+)` + and amp_tm = `&` in + let home_in = + let rec homein n x = + let x' = (x -/ eighth) // (num_1 +/ x */ eighth) in + if x' + let ltm,rtm = dest_comb tm in + if ltm <> atn_tm then failwith "ATN_EXPAND_CONV" else + let r = rat_of_term rtm in + let (x,n) = home_in r in + let xtm = mk_add (mk_mul (mk_comb(amp_tm,mk_small_numeral n)) + (mk_comb(atn_tm,eighth_tm))) + (mk_comb(atn_tm,term_of_rat x)) in + SYM(MACHIN_CONV xtm);; diff --git a/Examples/mangoldt.ml b/Examples/mangoldt.ml new file mode 100644 index 0000000..90c42a3 --- /dev/null +++ b/Examples/mangoldt.ml @@ -0,0 +1,671 @@ +(* ========================================================================= *) +(* Mangoldt function and elementary Chebyshev/Mertens results. *) +(* ========================================================================= *) + +needs "Library/pocklington.ml";; +needs "Multivariate/transcendentals.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Useful approximation/bound lemmas, simple rather than sharp. *) +(* ------------------------------------------------------------------------- *) + +let LOG_FACT = prove + (`!n. log(&(FACT n)) = sum(1..n) (\d. log(&d))`, + INDUCT_TAC THEN + SIMP_TAC[FACT; SUM_CLAUSES_NUMSEG; LOG_1; ARITH; ARITH_RULE `1 <= SUC n`] THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL; LOG_MUL; REAL_OF_NUM_LT; FACT_LT; LT_0] THEN + ASM_REWRITE_TAC[ADD1] THEN REWRITE_TAC[ADD_AC; REAL_ADD_AC]);; + +let SUM_DIVISORS_FLOOR_LEMMA = prove + (`!n d. ~(d = 0) + ==> sum(1..n) (\m. if d divides m then &1 else &0) = floor(&n / &d)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[FLOOR_DIV_DIV] THEN + SIMP_TAC[GSYM SUM_RESTRICT_SET; FINITE_NUMSEG; SUM_CONST; FINITE_RESTRICT; + REAL_MUL_RID; REAL_OF_NUM_EQ] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC BIJECTIONS_CARD_EQ THEN + MAP_EVERY EXISTS_TAC [`\m:num. m DIV d`; `\m:num. m * d`] THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; LE_1; DIV_MULT; DIVIDES_DIV_MULT; + FINITE_NUMSEG; ONCE_REWRITE_RULE[MULT_SYM] DIV_MULT; + DIV_MONO; LE_1] THEN + ASM_SIMP_TAC[LE_RDIV_EQ; MULT_EQ_0; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + CONJ_TAC THENL [GEN_TAC THEN STRIP_TAC; ARITH_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN ASM_SIMP_TAC[DIV_EQ_0] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ARITH_RULE `d = 1 * d`] THEN + ASM_SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `n < 1 <=> n = 0`] THEN + ASM_MESON_TAC[MULT_CLAUSES]);; + +let LOG_2_BOUNDS = prove + (`&1 / &2 <= log(&2) /\ log(&2) <= &1`, + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM LOG_EXP] THEN + MP_TAC(SPEC `inv(&2)` REAL_EXP_BOUND_LEMMA); + GEN_REWRITE_TAC RAND_CONV [GSYM LOG_EXP] THEN + MP_TAC(SPEC `&1` REAL_EXP_LE_X)] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC EQ_IMP THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC LOG_MONO_LE THEN + REWRITE_TAC[REAL_EXP_POS_LT; REAL_OF_NUM_LT; ARITH]);; + +let LOG_LE_REFL = prove + (`!n. ~(n = 0) ==> log(&n) <= &n`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x <= y - &1 ==> x <= y`) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [REAL_ARITH `n = &1 + (n - &1)`] THEN + MATCH_MP_TAC LOG_LE THEN + REWRITE_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC);; + +let LOG_FACT_BOUNDS = prove + (`!n. ~(n = 0) + ==> abs(log(&(FACT n)) - (&n * log(&n) - &n + &1)) <= &2 * log(&n)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[num_CONV `1`; FACT] THEN + REWRITE_TAC[ARITH; LOG_1] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[LOG_FACT] THEN + REWRITE_TAC[REAL_ARITH `abs(x - y) <= e <=> x <= y + e /\ y - e <= x`] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL[`\z. clog(z)`; `\z. z * clog z - z`; `1`; `n:num`] + SUM_INTEGRAL_UBOUND_INCREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN REPEAT STRIP_TAC THENL + [COMPLEX_DIFF_TAC THEN CONJ_TAC THEN UNDISCH_TAC `&1 <= Re x` THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX] THENL + [REAL_ARITH_TAC; + UNDISCH_TAC `~(x = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM LT_NZ]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN + ASM_REAL_ARITH_TAC]; + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < a /\ &0 < b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; RE_CX; LOG_MONO_LE_IMP]]; + ALL_TAC]; + ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + REWRITE_TAC[LOG_1; REAL_ADD_LID; ARITH] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> n = 1 \/ 2 <= n`)) + THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + REWRITE_TAC[LOG_1; SUM_CLAUSES] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL[`\z. clog(z)`; `\z. z * clog z - z`; `2`; `n:num`] + SUM_INTEGRAL_LBOUND_INCREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL + [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN REPEAT STRIP_TAC THENL + [COMPLEX_DIFF_TAC THEN CONJ_TAC THEN UNDISCH_TAC `&1 <= Re x` THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX] THENL + [REAL_ARITH_TAC; + UNDISCH_TAC `~(x = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]; + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < a /\ &0 < b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; RE_CX; LOG_MONO_LE_IMP]]; + ALL_TAC]] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH `y <= x /\ a <= b ==> x <= a ==> y <= b`) THEN + ASM_SIMP_TAC[GSYM CX_LOG; SUM_EQ_NUMSEG; REAL_OF_NUM_LT; LE_1; CLOG_1; + ARITH_RULE `2 <= n ==> 0 < n`; RE_CX; + REAL_ARITH `&0 < &n + &1`; REAL_EQ_IMP_LE] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; GSYM CX_ADD; RE_CX] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RNEG] THENL + [REWRITE_TAC[REAL_ARITH + `(n + &1) * l' - (n + &1) + &1 <= (n * l - n + &1) + k * l <=> + (n + &1) * l' <= (n + k) * l + &1`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&n + &1) * (log(&n) + &1 / &n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `x <= y + z <=> x - y <= z`] THEN + ASM_SIMP_TAC[GSYM LOG_DIV; REAL_OF_NUM_LT; LT_NZ; + REAL_ARITH `&0 < &n + &1`; + REAL_FIELD `&0 < x ==> (x + &1) / x = &1 + &1 / x`] THEN + MATCH_MP_TAC LOG_LE THEN SIMP_TAC[REAL_LE_DIV; REAL_POS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `(n + &1) * (l + n') <= (n + k) * l + &1 <=> + n' * (n + &1) <= (k - &1) * l + &1`] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_LE_RADD; REAL_FIELD + `~(n = &0) ==> &1 / n * (n + &1) = inv(n) + &1`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `log(&2)` THEN + REWRITE_TAC[LOG_2_BOUNDS] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + SUBGOAL_THEN `&0 <= log(&n)` MP_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC LOG_POS THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The Mangoldt function and its key expansion. *) +(* ------------------------------------------------------------------------- *) + +let mangoldt = new_definition + `mangoldt n = if ?p k. 1 <= k /\ prime p /\ n = p EXP k + then log(&(@p. prime p /\ p divides n)) + else &0`;; + +let MANGOLDT_1 = prove + (`mangoldt 1 = &0`, + REWRITE_TAC[mangoldt] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[EXP_EQ_1] THEN MESON_TAC[PRIME_1; ARITH_RULE `~(1 <= 0)`]);; + +let MANGOLDT_PRIMEPOW = prove + (`!p k. prime p ==> mangoldt(p EXP k) = if 1 <= k then log(&p) else &0`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[mangoldt] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + ASM_SIMP_TAC[EQ_PRIME_EXP; LE_1] THEN + REWRITE_TAC[TAUT `~(a /\ b ==> ~(c /\ d)) <=> d /\ c /\ a /\ b`] THEN + ASM_REWRITE_TAC[UNWIND_THM1] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT AP_TERM_TAC THEN + ASM_SIMP_TAC[DIVIDES_PRIMEPOW] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + ASM_MESON_TAC[PRIME_DIVEXP; prime; PRIME_1; DIVIDES_REFL; EXP_1]);; + +let MANGOLDT_POS_LE = prove + (`!n. &0 <= mangoldt n`, + GEN_TAC THEN ASM_CASES_TAC `?p k. 1 <= k /\ prime p /\ n = p EXP k` THENL + [FIRST_X_ASSUM(REPEAT_TCL CHOOSE_THEN STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[MANGOLDT_PRIMEPOW] THEN MATCH_MP_TAC LOG_POS THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; + ASM_REWRITE_TAC[mangoldt; REAL_LE_REFL]]);; + +let LOG_MANGOLDT_SUM = prove + (`!n. ~(n = 0) ==> log(&n) = sum {d | d divides n} (\d. mangoldt(d))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[LOG_1; DIVIDES_ONE; SET_RULE `{x | x = a} = {a}`] THEN + REWRITE_TAC[SUM_SING; mangoldt] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[EXP_EQ_1] THEN MESON_TAC[PRIME_1; ARITH_RULE `~(1 <= 0)`]; + ALL_TAC] THEN + SUBGOAL_THEN `1 < n` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SPEC_TAC(`n:num`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MATCH_MP_TAC INDUCT_COPRIME THEN REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[LOG_MUL; GSYM REAL_OF_NUM_MUL; REAL_OF_NUM_LT; + ARITH_RULE `1 < a ==> 0 < a`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum ({d | d divides a} UNION {d | d divides b}) (\d. mangoldt d)` THEN + CONJ_TAC THEN CONV_TAC SYM_CONV THENL + [MATCH_MP_TAC SUM_UNION_NONZERO THEN REWRITE_TAC[IN_INTER] THEN + ASM_SIMP_TAC[FINITE_DIVISORS; ARITH_RULE `1 < n ==> ~(n = 0)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[coprime; MANGOLDT_1]; + MATCH_MP_TAC SUM_SUPERSET THEN REWRITE_TAC[UNION_SUBSET; IN_UNION] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; DIVIDES_LMUL; DIVIDES_RMUL] THEN + X_GEN_TAC `d:num` THEN STRIP_TAC THEN REWRITE_TAC[mangoldt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[PRIME_DIVPROD_POW]]; + ALL_TAC] THEN + ASM_SIMP_TAC[DIVIDES_PRIMEPOW; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[SET_RULE `{d | ?i. i <= k /\ d = p EXP i} = + IMAGE (\i. p EXP i) {i | i <= k}`] THEN + ASM_SIMP_TAC[EQ_EXP; SUM_IMAGE; PRIME_GE_2; + ARITH_RULE `2 <= p ==> ~(p = 0) /\ ~(p = 1)`] THEN + ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; o_DEF] THEN + ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; IN_ELIM_THM; FINITE_NUMSEG_LE] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[GSYM numseg] THEN + ASM_SIMP_TAC[LOG_POW; PRIME_IMP_NZ; REAL_OF_NUM_LT; LT_NZ] THEN + SIMP_TAC[SUM_CONST; CARD_NUMSEG_1; FINITE_NUMSEG]);; + +let MANGOLDT = prove + (`!n. log(&(FACT n)) = sum(1..n) (\d. mangoldt(d) * floor(&n / &d))`, + GEN_TAC THEN REWRITE_TAC[LOG_FACT] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(1..n) (\m. sum {d | d divides m} (\d. mangoldt d))` THEN + SIMP_TAC[LOG_MANGOLDT_SUM; SUM_EQ_NUMSEG; LE_1] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum (1..n) (\m. sum (1..n) + (\d. mangoldt d * (if d divides m then &1 else &0)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN + STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_SIMP_TAC[LE_1; FINITE_DIVISORS; IN_ELIM_THM; REAL_MUL_RZERO; + REAL_MUL_RID; SUBSET; IN_NUMSEG] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE_STRONG) THEN + ASM_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `d:num` THEN + ASM_SIMP_TAC[SUM_DIVISORS_FLOOR_LEMMA; LE_1; SUM_LMUL]]);; + +(* ------------------------------------------------------------------------- *) +(* The Chebyshev psi function and the key bounds on it. *) +(* ------------------------------------------------------------------------- *) + +let PSI_BOUND_INDUCT = prove + (`!n. ~(n = 0) + ==> sum(1..2*n) (\d. mangoldt(d)) - + sum(1..n) (\d. mangoldt(d)) <= &9 * &n`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (n+1..2 * n) (\d. mangoldt d)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[REAL_EQ_SUB_RADD] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN + ONCE_REWRITE_TAC[UNION_COMM] THEN REWRITE_TAC[FINITE_NUMSEG] THEN + ASM_SIMP_TAC[NUMSEG_COMBINE_R; ARITH_RULE + `~(n = 0) ==> 1 <= n + 1 /\ n <= 2 * n`] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum (n+1..2*n) + (\d. mangoldt(d) * (floor(&(2 * n) / &d) - &2 * floor(&n / &d)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[MANGOLDT_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= a /\ b = &0 ==> &1 <= a - &2 * b`) THEN + SUBGOAL_THEN `~(r = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[FLOOR_DIV_DIV; FLOOR_NUM; REAL_OF_NUM_LE; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[DIV_EQ_0; LE_RDIV_EQ] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum (1..2*n) + (\d. mangoldt(d) * (floor(&(2 * n) / &d) - &2 * floor(&n / &d)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET THEN + REWRITE_TAC[FINITE_NUMSEG; IN_DIFF; IN_NUMSEG] THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `~(r = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[MANGOLDT_POS_LE] THEN + ASM_SIMP_TAC[FLOOR_DIV_DIV; REAL_NEG_SUB; REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE; MULT_DIV_LE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `m * (f1 - &2 * f2) = m * f1 - &2 * m * f2`] THEN + REWRITE_TAC[SUM_SUB_NUMSEG; SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..2*n) (\d. mangoldt(d) * floor(&(2 * n) / &d)) - + &2 * sum(1..n) (\d. mangoldt(d) * floor(&n / &d))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `y' <= y ==> x - y <= x - y'`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC SUM_SUBSET THEN + REWRITE_TAC[FINITE_NUMSEG; IN_DIFF; IN_NUMSEG] THEN + SIMP_TAC[FLOOR_DIV_DIV; LE_1; FLOOR_NUM; REAL_LE_MUL; REAL_POS; + MANGOLDT_POS_LE] THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM MANGOLDT] THEN + MAP_EVERY (MP_TAC o C SPEC LOG_FACT_BOUNDS) [`n:num`; `2 * n`] THEN + ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `a2 + e2 + &2 * (e1 - a1) <= m + ==> abs(f2 - a2) <= e2 ==> abs(f1 - a1) <= e1 ==> f2 - &2 * f1 <= m`) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_MUL; LOG_MUL; REAL_OF_NUM_LT; LT_NZ; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `&6 * log(&n) + (&2 * log(&2) - &1) * &1 + (&2 * log(&2)) * &n` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&6 * &n + (&2 * log(&2) - &1) * &n + (&2 * log(&2)) * &n` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN + ASM_SIMP_TAC[LOG_LE_REFL; REAL_LE_LMUL; REAL_POS; REAL_LE_RADD] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`]; + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS]] THEN + MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC);; + +let PSI_BOUND_EXP = prove + (`!n. sum(1..2 EXP n) (\d. mangoldt(d)) <= &9 * &(2 EXP n)`, + INDUCT_TAC THEN + SIMP_TAC[EXP; SUM_SING_NUMSEG; MANGOLDT_1; REAL_LE_MUL; REAL_POS] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `s1 <= &9 * e ==> s2 - s1 <= &9 * e ==> s2 <= &9 * &2 * e`)) THEN + MATCH_MP_TAC PSI_BOUND_INDUCT THEN + REWRITE_TAC[EXP_EQ_0; ARITH]);; + +let PSI_BOUND = prove + (`!n. sum(1..n) (\d. mangoldt(d)) <= &18 * &n`, + GEN_TAC THEN ASM_CASES_TAC `n <= 1` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..1) (\d. mangoldt d)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET; ALL_TAC] THEN + REWRITE_TAC[SUM_SING_NUMSEG; FINITE_NUMSEG; IN_DIFF; IN_NUMSEG] THEN + SIMP_TAC[MANGOLDT_POS_LE; MANGOLDT_1; REAL_LE_MUL; REAL_POS] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `?k. n <= 2 EXP k /\ !l. l < k ==> ~(n <= 2 EXP l)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM num_WOP] THEN EXISTS_TAC `n:num` THEN + MP_TAC(SPEC `n:num` LT_POW2_REFL) THEN REWRITE_TAC[EXP] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..2 EXP k) (\d. mangoldt d)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET THEN + REWRITE_TAC[FINITE_NUMSEG; IN_DIFF; IN_NUMSEG; MANGOLDT_POS_LE] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&9 * &(2 EXP k)` THEN + REWRITE_TAC[PSI_BOUND_EXP] THEN + ASM_CASES_TAC `k = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(k = 0) ==> k = SUC(k - 1)`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; EXP; REAL_OF_NUM_LE] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Now Mertens's first theorem. *) +(* ------------------------------------------------------------------------- *) + +let MERTENS_LEMMA = prove + (`!n. ~(n = 0) ==> abs(sum(1..n) (\d. mangoldt(d) / &d) - log(&n)) <= &21`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `&n` THEN ASM_SIMP_TAC[REAL_OF_NUM_LT; LT_NZ] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB; GSYM SUM_LMUL] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LOG_FACT_BOUNDS) THEN REWRITE_TAC[MANGOLDT] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(n - &1) <= n /\ abs(s' - s) <= (k - &1) * n - a + ==> abs(s' - (nl - n + &1)) <= a + ==> abs(s - nl) <= n * k`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> abs(x - &1) <= x`) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[REAL_ARITH `n * i / x:real = i * n / x`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..n) (\i. mangoldt i)` THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ --x <= y ==> abs(x) <= y`) THEN + REWRITE_TAC[GSYM SUM_NEG; REAL_ARITH + `--(a * (x - y)):real = a * (y - x)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN SIMP_TAC[] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL; + MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL] THEN + ASM_REWRITE_TAC[MANGOLDT_POS_LE; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN + MP_TAC(SPEC `&n / &i` FLOOR) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= (k - &2) * n /\ l <= n ==> x <= k * n - &2 * l`) THEN + ASM_SIMP_TAC[LOG_LE_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[PSI_BOUND]);; + +let MERTENS_MANGOLDT_VERSUS_LOG = prove + (`!n s. s SUBSET (1..n) + ==> abs (sum s (\d. mangoldt d / &d) - + sum {p | prime p /\ p IN s} (\p. log (&p) / &p)) <= &3`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUBSET_EMPTY] THEN + DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; SUM_CLAUSES] THEN REAL_ARITH_TAC; + DISCH_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sum (1..n) (\d. mangoldt d / &d) - + sum {p | prime p /\ p IN 1..n} (\p. log (&p) / &p))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `FINITE(s:num->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + ASM_SIMP_TAC[SUM_RESTRICT_SET; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[GSYM SUM_SUB; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE; MATCH_MP_TAC SUM_SUBSET_SIMPLE] THEN + ASM_SIMP_TAC[IN_DIFF; FINITE_NUMSEG; REAL_SUB_LE] THEN + X_GEN_TAC `x:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_DIV; MANGOLDT_POS_LE; REAL_POS] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM EXP_1] THEN + ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; LE_REFL; REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `{p | prime p /\ p IN 1..n} = {p | prime p /\ p <= n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + MESON_TAC[ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum(1..n) (\d. mangoldt d / &d) - + sum {p | prime p /\ p <= n} (\p. log (&p) / &p) = + sum {p EXP k | prime p /\ p EXP k <= n /\ k >= 2} (\d. mangoldt d / &d)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `sum {p | prime p /\ p <= n} (\p. log (&p) / &p) = + sum {p | prime p /\ p <= n} (\d. mangoldt d / &d)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM EXP_1] THEN + ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; ARITH]; + ALL_TAC] THEN + REWRITE_TAC[REAL_EQ_SUB_RADD] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum {p EXP k | prime p /\ p EXP k <= n /\ k >= 1} + (\d. mangoldt d / &d)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[IN_ELIM_THM; SUBSET; IN_NUMSEG] THEN + CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; EXP_EQ_0] THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN + REWRITE_TAC[mangoldt] THEN ASM_MESON_TAC[GE]; + ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + MESON_TAC[PRIME_EXP; ARITH_RULE `~(1 >= 2)`]; + REWRITE_TAC[ARITH_RULE `k >= 1 <=> k >= 2 \/ k = 1`] THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[EXP_1]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS; MANGOLDT_POS_LE]THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum {p | p IN 1..n /\ prime p} + (\p. sum (2..n) (\k. log(&p) / &p pow k))` THEN + CONJ_TAC THENL + [SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG; FINITE_RESTRICT] THEN + MATCH_MP_TAC SUM_LE_INCLUDED THEN EXISTS_TAC `\(p,k). p EXP k` THEN + SIMP_TAC[FINITE_PRODUCT; FINITE_NUMSEG; FINITE_RESTRICT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN + SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; REAL_LE_DIV; REAL_POW_LE; REAL_POS; + LOG_POS; REAL_OF_NUM_LE] THEN + X_GEN_TAC `x:num` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_SIMP_TAC[MANGOLDT_PRIMEPOW; GSYM REAL_OF_NUM_POW; REAL_LE_REFL; + ARITH_RULE `k >= 2 ==> 1 <= k /\ 2 <= k`] THEN + ASM_SIMP_TAC[PRIME_IMP_NZ; ARITH_RULE `1 <= k <=> ~(k = 0)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_SIMP_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN + ASM_SIMP_TAC[PRIME_IMP_NZ; LE_EXP] THEN ASM_ARITH_TAC; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP k` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP k` THEN + ASM_SIMP_TAC[LT_POW2_REFL; LT_IMP_LE; EXP_MONO_LE; PRIME_GE_2]]; + ALL_TAC] THEN + REWRITE_TAC[real_div; SUM_LMUL; GSYM REAL_POW_INV; SUM_GP] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {p | p IN 1..n /\ prime p} + (\p. log(&p) / (&p * (&p - &1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN SIMP_TAC[FINITE_NUMSEG; FINITE_RESTRICT] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN + ASM_SIMP_TAC[REAL_INV_EQ_1; REAL_OF_NUM_EQ; PRIME_GE_2; + ARITH_RULE `2 <= p ==> ~(p = 1)`] THEN + STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_LE_DIV; REAL_LE_MUL; REAL_SUB_LE; + REAL_OF_NUM_LE; LOG_POS; LE_0] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= y * z /\ x * z <= a ==> (x - y) * z <= a`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_INV_EQ; REAL_POS; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (2..n) (\p. log(&p) / (&p * (&p - &1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET THEN SIMP_TAC[FINITE_NUMSEG; FINITE_RESTRICT] THEN + REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN + CONJ_TAC THENL [MESON_TAC[PRIME_GE_2]; ALL_TAC] THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`; + REAL_LE_MUL; REAL_POS; REAL_SUB_LE; REAL_LE_DIV]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (2..n) (\m. log(&m) / (&m - &1) pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[LOG_POS; REAL_OF_NUM_LE; ARITH_RULE `2 <= p ==> 1 <= p`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_POW_2; REAL_LE_RMUL_EQ; REAL_LT_MUL; REAL_LT_IMP_LE; + REAL_SUB_LT; REAL_OF_NUM_LT; ARITH_RULE `1 < p <=> 2 <= p`; + REAL_ARITH `x - &1 <= x`]; + ALL_TAC] THEN + ASM_CASES_TAC `n < 2` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM NUMSEG_EMPTY]); + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT])] THEN + ASM_SIMP_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= &1 /\ y <= e - &1 ==> x + y <= e`) THEN + CONJ_TAC THENL [MP_TAC LOG_2_BOUNDS THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `n < 3` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM NUMSEG_EMPTY]); + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT])] THEN + ASM_SIMP_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MP_TAC(ISPECL + [`\z. clog(z) / (z - Cx(&1)) pow 2`; + `\z. clog(z - Cx(&1)) - clog(z) - clog(z) / (z - Cx(&1))`; + `3`; `n:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN X_GEN_TAC `z:complex` THEN + STRIP_TAC THENL + [COMPLEX_DIFF_TAC THEN SIMP_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_LID] THEN + ASM_SIMP_TAC[RE_SUB; RE_CX; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_ARITH `&2 <= x ==> &1 < x /\ &0 < x`] THEN + SUBGOAL_THEN `~(z = Cx(&0)) /\ ~(z = Cx(&1))` MP_TAC THENL + [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `&2 <= Re z` THEN + ASM_REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN + MP_TAC(SPECL [`\z. clog(z) / (z - Cx(&1)) pow 2`; + `\z. inv(z * (z - Cx(&1)) pow 2) - + Cx(&2) * clog(z) / (z - Cx(&1)) pow 3`; + `Cx(x)`; `Cx(y)`] COMPLEX_MVT_LINE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN X_GEN_TAC `z:complex` THEN + REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=> + a <= x /\ x <= b \/ b < a /\ b <= x /\ x <= a`] THEN + STRIP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + COMPLEX_DIFF_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN `~(z = Cx(&0)) /\ ~(z = Cx(&1))` MP_TAC THENL + [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[RE_CX; IM_CX] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `x <= y <=> x - y <= &0`] THEN + DISCH_THEN(X_CHOOSE_THEN `w:complex` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[GSYM CX_SUB; RE_MUL_CX] THEN + REWRITE_TAC[REAL_ARITH `a * (y - x) <= &0 <=> &0 <= --a * (y - x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LE] THEN + REWRITE_TAC[RE_SUB; REAL_NEG_SUB; REAL_SUB_LE] THEN + SUBGOAL_THEN `real w` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN + ABBREV_TAC `u = Re w` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN + ASM_SIMP_TAC[REAL_ARITH + `x <= y + ==> (x <= u /\ u <= y \/ y <= u /\ u <= x <=> x <= u /\ u <= y)`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&0 < u /\ &1 < u /\ &2 <= u` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; + GSYM CX_MUL; GSYM CX_INV; RE_CX] THEN + REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL; REAL_MUL_ASSOC; + REAL_RING `(x:real) pow 3 = x * x pow 2`] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_INV_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC(REAL_ARITH + `a * b <= &1 /\ &1 / &2 <= c ==> b * a <= &2 * c`) THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `log(&2)` THEN + REWRITE_TAC[LOG_2_BOUNDS] THEN MATCH_MP_TAC LOG_MONO_LE_IMP THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> x <= a ==> y <= b`) THEN + CONJ_TAC THENL [MATCH_MP_TAC SUM_EQ_NUMSEG; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_SUB; GSYM CX_LOG; GSYM CX_DIV; REAL_SUB_LT; ARITH; + RE_CX; REAL_OF_NUM_LT; ARITH_RULE `3 <= n ==> 0 < n /\ 1 < n`; + GSYM CX_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[LOG_1; REAL_ARITH `a - (&0 - x - x / &1) = a + &2 * x`] THEN + MATCH_MP_TAC(REAL_ARITH + `a <= e - &2 /\ x <= &1 ==> a + &2 * x <= e`) THEN + REWRITE_TAC[LOG_2_BOUNDS] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b /\ --c <= e ==> a - b - c <= e`) THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_ARITH `--x <= &0 <=> &0 <= x`] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_SUB_LE; LOG_POS; REAL_OF_NUM_LE; + REAL_OF_NUM_LT; LOG_MONO_LE_IMP; REAL_ARITH `x - &1 <= x`; REAL_SUB_LT; + LE_0; ARITH_RULE `3 <= n ==> 1 <= n /\ 1 < n`]);; + +let MERTENS = prove + (`!n. ~(n = 0) + ==> abs(sum {p | prime p /\ p <= n} + (\p. log(&p) / &p) - log(&n)) <= &24`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP MERTENS_LEMMA) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(s1 - s2) <= k - e ==> abs(s1 - l) <= e ==> abs(s2 - l) <= k`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBGOAL_THEN `{p | prime p /\ p <= n} = {p | prime p /\ p IN 1..n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + MESON_TAC[ARITH_RULE `2 <= p ==> 1 <= p`; PRIME_GE_2]; + MATCH_MP_TAC MERTENS_MANGOLDT_VERSUS_LOG THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; diff --git a/Examples/mccarthy.ml b/Examples/mccarthy.ml new file mode 100644 index 0000000..1c771f5 --- /dev/null +++ b/Examples/mccarthy.ml @@ -0,0 +1,193 @@ +(***************************************************************************** +* +* mp.ml +* +* An HOL mechanization of the compiler correctness proof of McCarthy and +* Painter from 1967. +* +* From a HOL-4 original by Robert Bauer and Ray Toal +* +* HOL Light proof by John Harrison, 21st April 2004 +* +*****************************************************************************) + +(* ------------------------------------------------------------------------- *) +(* Define a type of strings, not already there in HOL Light. *) +(* We don't use any particular properties of the type in the proof below. *) +(* ------------------------------------------------------------------------- *) + +let string_INDUCT,string_RECURSION = + define_type "string = String (int list)";; + +(* ------------------------------------------------------------------------- *) +(* The definitions from Robert's file. *) +(* ------------------------------------------------------------------------- *) + +(* + * The source language + * ------------------- + * + * Syntax: + * + * The language contains only expressions of three kinds: (1) simple + * numeric literals, (2) simple variables, and (3) plus expressions. + *) + +let exp_INDUCT,exp_RECURSION = + define_type "exp = Lit num + | Var string + | Plus exp exp";; + +(* + * Semantics: + * + * Expressions evaluated in a state produce a result. There are no + * side effects. A state is simply a mapping from variables to + * values. The semantic function is called E. + *) + +let E_DEF = new_recursive_definition exp_RECURSION + `(E (Lit n) s = n) + /\ (E (Var v) s = s v) + /\ (E (Plus e1 e2) s = E e1 s + E e2 s)`;; + +(* + * The object language + * ------------------- + * + * Syntax: + * + * The target machine has a single accumulator (Acc) and an infinite + * set of numbered registers (Reg 0, Reg 1, Reg 2, and so on). The + * accumulator and registers together are called cells. There are four + * instructions: LI (load immediate into accumulator), LOAD (load the + * contents of a numbered register into the accumulator), STO (store + * the accumulator value into a numbered register) and ADD (add the + * contents of a numbered register into the accumulator). + *) + +let cell_INDUCT,cell_RECURSION = + define_type "cell = Acc + | Reg num";; + +let inst_INDUCT,inst_RECURSION = + define_type "inst = LI num + | LOAD num + | STO num + | ADD num";; + +(* + * update x z s is the state that is just like s except that x now + * maps to z. This definition applies to any kind of state. + *) + +let update_def = + new_definition `update x z s y = if (y = x) then z else s y`;; + +(* + * Semantics: + * + * First, the semantics of the execution of a single instruction. + * The semantic function is called S. Executing an instruction in + * a machine state produces a new machine state. Here a machine + * state is a mapping from cells to values. + *) + +let S_DEF = new_recursive_definition inst_RECURSION + `(S (LI n) s = update Acc n s) + /\ (S (LOAD r) s = update Acc (s (Reg r)) s) + /\ (S (STO r) s = update (Reg r) (s Acc) s) + /\ (S (ADD r) s = update Acc (s (Reg r) + s Acc) s)`;; + +(* + * Next we give the semantics of a list of instructions with the + * semantic function S'. The execution of an intruction list + * in an initial state is given by executing the first instruction + * in the list in the initial state, which produce a new state s1, + * and taking the execution of the rest of the list in s1. + *) + +let S'_DEF = new_recursive_definition list_RECURSION + `(S' [] s = s) + /\ (S' (CONS inst rest) s = S' rest (S inst s))`;; + +(* + * The compiler + * ------------ + * + * Each source language expression is compiled into a list of + * instructions. The compilation is done using a symbol table + * which maps source language indentifiers into target machine + * register numbers, and a parameter r which tells the next + * available free register. + *) + +let C_DEF = new_recursive_definition exp_RECURSION + `(C (Lit n) map r = [LI n]) + /\ (C (Var v) map r = [LOAD (map v)]) + /\ (C (Plus e1 e2) map r = + APPEND + (APPEND (C e1 map r) [STO r]) + (APPEND (C e2 map (r + 1)) [ADD r]))`;; + +(* ------------------------------------------------------------------------- *) +(* My key lemmas; UPDATE_DIFFERENT and S'_APPEND are the same as Robert's. *) +(* ------------------------------------------------------------------------- *) + +let cellth = CONJ (distinctness "cell") (injectivity "cell");; + +let S'_APPEND = prove + (`!p1 p2 s. S' (APPEND p1 p2) s = S' p2 (S' p1 s)`, + LIST_INDUCT_TAC THEN ASM_SIMP_TAC[S'_DEF; APPEND]);; + +let UPDATE_DIFFERENT = prove + (`!x y z s. ~(x = y) ==> (update x z s y = s y)`, + SIMP_TAC[update_def]);; + +let UPDATE_SAME = prove + (`!x z s. update x z s x = z`, + SIMP_TAC[update_def]);; + +(* + * The Correctness Condition + * ------------------------- + * + * The correctness condition is this: + * + * For every expression e, symbol table map, source state s, + * target state s', register number r: + * + * If all source variables map to registers LESS THAN r, + * and if the value of every variable v in s is exactly + * the same as the value in s' of the register to which + * v is mapped by map, THEN + * + * When e is compiled with map and first free register r, + * and then executed in the state s', in the resulting + * machine state S'(C e map r): + * + * the accumulator will contain E e s and every register + * with number x less than r will have the same value as + * it does in s'. + * + * The Proof + * --------- + * + * The proof can be done by induction and careful application of SIMP_TAC[] + * using the lemmas isolated above. + * + * The only "hack" is to throw in GSYM SKOLEM_THM and EXISTS_REFL to dispose + * of state existence subgoals of the form `?s. !v. s v = t[v]`, which + * otherwise would not be proven automatically by the simplifier. + *) + +let CORRECTNESS_THEOREM = prove + (`!e map s s' r. + (!v. map v < r) ==> + (!v. s v = s' (Reg (map v))) ==> + (S' (C e map r) s' Acc = E e s) /\ + (!x. (x < r) ==> (S' (C e map r) s' (Reg x) = s' (Reg x)))`, + MATCH_MP_TAC exp_INDUCT THEN + REWRITE_TAC[E_DEF; S_DEF; S'_DEF; update_def; C_DEF; S'_APPEND] THEN + SIMP_TAC[ARITH_RULE `(x < y ==> x < y + 1 /\ ~(x = y)) /\ x < x + 1`; cellth; + UPDATE_SAME; UPDATE_DIFFERENT; GSYM SKOLEM_THM; EXISTS_REFL]);; diff --git a/Examples/mizar.ml b/Examples/mizar.ml new file mode 100644 index 0000000..2edf565 --- /dev/null +++ b/Examples/mizar.ml @@ -0,0 +1,682 @@ +(* ========================================================================= *) +(* Mizar-style proofs integrated with the HOL goalstack. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* ========================================================================= *) + +let old_parse_term = parse_term;; + +(* ------------------------------------------------------------------------- *) +(* This version of CHOOSE is more convenient to "itlist". *) +(* ------------------------------------------------------------------------- *) + +let IMP_CHOOSE_RULE = + let P = `P:A->bool` + and Q = `Q:bool` + and pth = prove + (`(!x:A. P x ==> Q) ==> ((?) P ==> Q)`, + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM]) in + fun v th -> + let ant,con = dest_imp (concl th) in + let pred = mk_abs(v,ant) in + let tm = concl th in + let q = rand tm in + let th1 = BETA_CONV(mk_comb(pred,v)) in + let th2 = PINST [type_of v,aty] [pred,P; q,Q] pth in + let th3 = AP_THM (AP_TERM (rator(rator tm)) th1) q in + let th4 = GEN v (EQ_MP (SYM th3) th) in + MP th2 th4;; + +(* ------------------------------------------------------------------------- *) +(* Some preterm operations we need. *) +(* ------------------------------------------------------------------------- *) + +let rec split_ppair ptm = + match ptm with + Combp(Combp(Varp(",",dpty),ptm1),ptm2) -> ptm1::(split_ppair ptm2) + | _ -> [ptm];; + +let pmk_conj(ptm1,ptm2) = + Combp(Combp(Varp("/\\",dpty),ptm1),ptm2);; + +let pmk_exists(v,ptm) = + Combp(Varp("?",dpty),Absp(v,ptm));; + +(* ------------------------------------------------------------------------- *) +(* Typecheck a preterm into a term in an environment of (typed) variables. *) +(* ------------------------------------------------------------------------- *) + +let typecheck_in_env env ptm = + let penv = itlist + (fun v acc -> let n,ty = dest_var v in (n,pretype_of_type ty)::acc) + env [] in + (term_of_preterm o retypecheck penv) ptm;; + +(* ------------------------------------------------------------------------- *) +(* Converts a labelled preterm (using "and"s) into a single conjunction. *) +(* ------------------------------------------------------------------------- *) + +let delabel lfs = end_itlist (curry pmk_conj) (map snd lfs);; + +(* ------------------------------------------------------------------------- *) +(* These special constants are replaced by useful bits when encountered: *) +(* *) +(* thesis -- Current thesis (i.e. conclusion of goal). *) +(* *) +(* antecedent -- antecedent of goal, if applicable *) +(* *) +(* contradiction -- falsity *) +(* *) +(* ... -- Right hand side of previous conclusion. *) +(* ------------------------------------------------------------------------- *) + +let thesis = new_definition + `thesis = F`;; + +let antecedent = new_definition + `antecedent = F`;; + +let contradiction = new_definition + `contradiction = F`;; + +let iter_rhs = new_definition + `... = @x:A. F`;; + +(* ------------------------------------------------------------------------- *) +(* This function performs the replacement, and typechecks in current env. *) +(* *) +(* The replacement of "..." is done specially, since it also adds a "then". *) +(* ------------------------------------------------------------------------- *) + +let mizarate_term = + let atm = `antecedent` + and ttm = `thesis` + and ctm = `contradiction` in + let f_tm = `F` in + let filter_env fvs = + let env1 = map dest_var fvs in + let sizes = map + (fun (v,_) -> v,length (filter ((=) v o fst) env1)) env1 in + let env2 = filter (fun (v,_) -> assoc v sizes = 1) env1 in + map mk_var env2 in + let goal_lconsts (asl,w) = + itlist (union o frees o concl o snd) asl (frees w) in + fun (asl,w as gl) ptm -> + let lconsts = goal_lconsts gl in + let tm = typecheck_in_env (filter_env lconsts) ptm in + let ant = try fst(dest_imp w) with Failure _ -> atm in + subst [w,ttm; ant,atm; f_tm,ctm] tm;; + +(* ------------------------------------------------------------------------- *) +(* The following is occasionally useful as a hack. *) +(* ------------------------------------------------------------------------- *) + +let LIMITED_REWRITE_CONV = + let LIMITED_ONCE_REWRITE_CONV ths = + GEN_REWRITE_CONV ONCE_DEPTH_CONV ths THENC + GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net()) [] in + fun n ths tm -> + funpow n (CONV_RULE(RAND_CONV(LIMITED_ONCE_REWRITE_CONV ths))) + (REFL tm);; + +(* ------------------------------------------------------------------------- *) +(* The default prover. *) +(* ------------------------------------------------------------------------- *) + +let DEFAULT_PROVER = + let FREEZE_THENL fn ths x = + let ths' = map (ASSUME o concl) ths in + let th = fn ths' x in + itlist PROVE_HYP ths th in + let REWRITE_PROVER ths tm = + if length ths < 2 then + EQT_ELIM(LIMITED_REWRITE_CONV 3 ths tm) + else + let ths' = tl ths in + let th' = CONV_RULE (LIMITED_REWRITE_CONV 4 ths') (hd ths) in + EQT_ELIM(LIMITED_REWRITE_CONV 4 (th'::ths') tm) in + fun ths tm -> + let sths = itlist (union o CONJUNCTS) ths [] in + try prove(tm,MAP_FIRST MATCH_ACCEPT_TAC sths) + with Failure _ -> try + FREEZE_THENL REWRITE_PROVER ths tm + with Failure _ -> + prove(tm,GEN_MESON_TAC 0 30 1 ths);; + +let default_prover = ref DEFAULT_PROVER;; + +let prover_list = ref + ["rewriting",(fun ths tm -> EQT_ELIM(REWRITE_CONV ths tm))];; + +(* ------------------------------------------------------------------------- *) +(* "arithmetic",(fun ths tm -> *) +(* let tm' = itlist (curry mk_imp o concl) ths tm in *) +(* let th = REAL_ARITH tm' in *) +(* rev_itlist (C MP) ths th);; *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* Produce a "default" label for various constructs where applicable. *) +(* ------------------------------------------------------------------------- *) + +let default_assumptions = ref false;; + +let mklabel s = + if s = "" & !default_assumptions then "*" + else s;; + +(* ------------------------------------------------------------------------- *) +(* Augment assumptions, throwing away an *unnamed* previous step. *) +(* ------------------------------------------------------------------------- *) + +let augments = + let augment nw asl = + if asl = [] then [nw] + else if fst(hd asl) = "" then nw::(tl asl) + else nw::asl in + fun labs th asl -> + let ths,thl = nsplit CONJ_PAIR (tl labs) th in + itlist augment (zip (map mklabel labs) (ths@[thl])) asl;; + +(* ------------------------------------------------------------------------- *) +(* Wrapper for labels in justification list (use K for preproved theorems). *) +(* ------------------------------------------------------------------------- *) + +let L s asl = + if s = "" then snd(hd asl) else ((assoc s asl):thm);; + +(* ------------------------------------------------------------------------- *) +(* Perform justification, given asl and target. *) +(* ------------------------------------------------------------------------- *) + +let JUSTIFY (prover,tlist) asl tm = + let xthms = map (C I asl) tlist in + let proof_fn = + if prover = "" then !default_prover + else assoc prover (!prover_list) in + let ithms = map snd (filter ((=) "*" o fst) asl) in + proof_fn (xthms @ ithms) tm;; + +(* ------------------------------------------------------------------------- *) +(* Either do justification or split off subproof then call ttac with result. *) +(* ------------------------------------------------------------------------- *) + +let JUSTIFY_THEN wtm ((pr,tls) as jdata) ttac (asl,w as gl) = + if pr = "proof" then + SUBGOAL_THEN wtm ttac gl + else + let wth = JUSTIFY jdata asl wtm in + ttac wth gl;; + +(* ------------------------------------------------------------------------- *) +(* Utilise a conclusion. *) +(* ------------------------------------------------------------------------- *) + +let (MIZAR_CONCLUSION_TAC:thm_tactic) = + let t_tm = `T` in + let CONJ_ASSOC_RULE = + EQT_ELIM o + GEN_REWRITE_RULE RAND_CONV [EQT_INTRO(SPEC_ALL EQ_REFL)] o + PURE_REWRITE_CONV[GSYM CONJ_ASSOC] in + fun th (asl,w as gl) -> + let cjs = conjuncts(concl th) in + let cjs1,cjs2 = chop_list(length cjs) (conjuncts w) in + if cjs2 = [] then + let th' = EQ_MP (CONJ_ASSOC_RULE(mk_eq(concl th,w))) th in + null_meta,[asl,t_tm],fun i _ -> INSTANTIATE i th' + else + let w1 = list_mk_conj cjs1 + and w2 = list_mk_conj cjs2 in + let w12 = mk_conj(w1,w2) in + let th' = EQ_MP (CONJ_ASSOC_RULE(mk_eq(concl th,w1))) th in + let wth = CONJ_ASSOC_RULE(mk_eq(w,w12)) in + (SUBST1_TAC wth THEN CONJ_TAC THENL [ACCEPT_TAC th'; ALL_TAC]) gl;; + +(* ------------------------------------------------------------------------- *) +(* Transitivity chain stuff; store a list of useful transitivity theorems. *) +(* ------------------------------------------------------------------------- *) + +let mizar_transitivity_net = ref empty_net;; + +let add_mizar_transitivity_theorem th = + let pat = fst(dest_imp(snd(strip_forall(concl th)))) in + mizar_transitivity_net := + enter [] (pat,MATCH_MP th) (!mizar_transitivity_net);; + +let TRANSITIVITY_CHAIN th1 th2 ttac = + let tm1 = concl th1 + and tm2 = concl th2 in + let th = + if is_eq tm1 then + EQ_MP (SYM (AP_THM (AP_TERM (rator(rator tm2)) th1) (rand tm2))) th2 + else if is_eq tm2 then + EQ_MP (AP_TERM (rator tm1) th2) th1 + else + let th12 = CONJ th1 th2 in + tryfind (fun rule -> rule th12) + (lookup (concl th12) (!mizar_transitivity_net)) in + ttac th;; + +(* ------------------------------------------------------------------------- *) +(* Perform terminal or initial step. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_SUBSTEP_TAC = + fun labs thm (asl,w) -> + let asl' = augments labs thm asl in + null_meta,[asl',w], + K(function [th] -> PROVE_HYP thm th | _ -> fail());; + +let MIZAR_BISTEP_TAC = + fun termflag labs jth -> + if termflag then + MIZAR_SUBSTEP_TAC labs jth THEN + MIZAR_CONCLUSION_TAC jth + else + MIZAR_SUBSTEP_TAC labs jth;; + +let MIZAR_STEP_TAC = + fun termflag lfs (pr,tls as jdata) (asl,w as gl) -> + let tm = mizarate_term gl (delabel lfs) in + if try fst(dest_const(lhand tm)) = "..." with Failure _ -> false then + let thp = snd(hd asl) in + let lhd = rand(concl thp) in + let tm' = mk_comb(mk_comb(rator(rator tm),lhd),rand tm) in + JUSTIFY_THEN tm' (pr,tls) + (fun th -> TRANSITIVITY_CHAIN thp th + (MIZAR_BISTEP_TAC termflag (map fst lfs))) gl + else + JUSTIFY_THEN tm (pr,tls) + (MIZAR_BISTEP_TAC termflag (map fst lfs)) gl;; + +(* ------------------------------------------------------------------------- *) +(* Perform an "end": finish the trivial goal. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_END_TAC = ACCEPT_TAC TRUTH;; + +(* ------------------------------------------------------------------------- *) +(* Perform "assume " *) +(* ------------------------------------------------------------------------- *) + +let (MIZAR_ASSUME_TAC: (string * preterm) list -> tactic) = + let f_tm = `F` + and CONTRA_HACK = CONV_RULE(REWR_CONV(TAUT `(~p ==> F) <=> p`)) in + fun lfs (asl,w as gl) -> + let tm = mizarate_term gl (delabel lfs) in + if try aconv (dest_neg tm) w with Failure _ -> false then + (null_meta,[augments (map fst lfs) (ASSUME tm) asl,f_tm], + (fun i -> function [th] -> CONTRA_HACK(DISCH (instantiate i tm) th) + | _ -> fail())) + else if try aconv tm (fst(dest_imp w)) with Failure _ -> false then + (null_meta,[augments (map fst lfs) (ASSUME tm) asl,rand w], + (fun i -> function [th] -> DISCH (instantiate i tm) th + | _ -> fail())) + else failwith "MIZAR_ASSUME_REF: Bad thesis";; + +(* ------------------------------------------------------------------------- *) +(* Perform "let ,..., [be ]" *) +(* ------------------------------------------------------------------------- *) + +let (MIZAR_LET_TAC: preterm list * hol_type list -> tactic) = + fun (vlist,tys) (asl,w as gl) -> + let ty = if tys = [] then type_of(fst(dest_forall w)) else hd tys in + let pty = pretype_of_type ty in + let mk_varb v = + (term_of_preterm o retypecheck []) (Typing(v,pty)) in + let vs = map mk_varb vlist in + MAP_EVERY X_GEN_TAC vs gl;; + +(* ------------------------------------------------------------------------- *) +(* Perform "take " *) +(* ------------------------------------------------------------------------- *) + +let (MIZAR_TAKE_TAC: preterm -> tactic) = + fun ptm (asl,w as gl) -> + let ptm' = Typing(ptm,pretype_of_type(type_of(fst(dest_exists w)))) in + let tm = mizarate_term (asl,w) ptm' in + EXISTS_TAC tm gl;; + +(* ------------------------------------------------------------------------- *) +(* Perform "suffices to prove
by ". *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_SUFFICES_TAC = + fun new0 ((pr,tlist) as jdata) (asl,w as gl) -> + let nw = mizarate_term gl (end_itlist (curry pmk_conj) new0) in + JUSTIFY_THEN (mk_imp(nw,w)) jdata + (fun jth (asl,w) -> + null_meta,[asl,nw], + (fun i -> function [th] -> MP (INSTANTIATE_ALL i jth) th + | _ -> fail())) gl;; + +(* ------------------------------------------------------------------------- *) +(* Perform "set " *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_SET_TAC = + fun (lab,ptm) (asl,w as gl) -> + let tm = mizarate_term gl ptm in + let v,t = dest_eq tm in + CHOOSE_THEN (fun th -> SUBST_ALL_TAC th THEN + LABEL_TAC (mklabel lab) (SYM th)) + (EXISTS(mk_exists(v,mk_eq(t,v)),t) (REFL t)) gl;; + +(* ------------------------------------------------------------------------- *) +(* Perform "consider such that by ". *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_CONSIDER_TAC = + fun vars0 lfs ((pr,tls) as jdata) (asl,w as gl) -> + let ptm = itlist (curry pmk_exists) vars0 (delabel lfs) in + let etm = mizarate_term gl ptm in + let vars,tm = nsplit dest_exists vars0 etm in + JUSTIFY_THEN etm jdata + (fun jth (asl,w) -> + null_meta,[augments (map fst lfs) (ASSUME tm) asl,w], + (fun i -> function [th] -> MP (itlist IMP_CHOOSE_RULE vars + (DISCH (instantiate i tm) th)) jth + | _ -> fail())) gl;; + +(* ------------------------------------------------------------------------- *) +(* Perform "given such that ". *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_GIVEN_TAC = + fun vars0 lfs (asl,w as gl) -> + let ant = fst(dest_imp w) in + let gvars,gbod = nsplit dest_exists vars0 ant in + let tvars = map2 + (fun p v -> Typing(p,pretype_of_type(snd(dest_var v)))) vars0 gvars in + let ptm = itlist (curry pmk_exists) tvars (delabel lfs) in + let etm = mizarate_term gl ptm in + let vars,tm = nsplit dest_exists vars0 etm in + if try aconv ant etm with Failure _ -> false then + null_meta,[augments (map fst lfs) (ASSUME tm) asl,rand w], + (fun i -> function [th] -> DISCH ant + (MP (itlist IMP_CHOOSE_RULE vars + (DISCH (instantiate i tm) th)) + (ASSUME ant)) + | _ -> fail()) + else failwith "MIZAR_GIVEN_TAC: Bad thesis";; + +(* ------------------------------------------------------------------------- *) +(* Initialize a case split. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_PER_CASES_TAC = + fun jdata (asl,w as gl) -> + null_meta,[gl], + K(function [th] -> + let ghyps = itlist (union o hyp o snd) asl [] in + let rogues = subtract (hyp th) ghyps in + if rogues = [] then th + else if tl rogues = [] then + let thm = JUSTIFY jdata asl (hd rogues) in + PROVE_HYP thm th + else failwith "MIZAR_PER_CASES_ATAC: Too many suppositions" + | _ -> fail());; + +(* ------------------------------------------------------------------------- *) +(* Perform a case split. NB! This tactic is not "valid" in the LCF sense. *) +(* We could make it so, but that would force classical logic! *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_SUPPOSE_TAC = + fun lfs (asl,w as gl) -> + let asm = mizarate_term gl (delabel lfs) in + let ghyps = itlist (union o hyp o snd) asl [] in + null_meta, + [augments (map fst lfs) (ASSUME asm) asl,w; gl], + K(function [th1; th2] -> + let hyp1 = hyp th1 + and hyp2 = hyp th2 in + let asm1 = subtract hyp1 ghyps + and asm2 = subtract hyp2 ghyps in + if asm1 = [] then th1 else if asm2 = [] then th2 + else if tl asm1 = [] & tl asm2 = [] then + DISJ_CASES (ASSUME(mk_disj(hd asm1,hd asm2))) th1 th2 + else failwith "MIZAR_SUPPOSE_TAC: Too many suppositions" + | _ -> fail());; + +let MIZAR_SUPPOSE_REF lfs = + by (MIZAR_SUPPOSE_TAC lfs) o by (TRY MIZAR_END_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Terminate a case split. *) +(* ------------------------------------------------------------------------- *) + +let MIZAR_RAW_ENDCASE_TAC = + let pth = ITAUT `F ==> p` + and p = `p:bool` in + fun (asl,w) -> + let th = UNDISCH (INST [w,p] pth) in + null_meta,[],fun _ _ -> th;; + +let MIZAR_ENDCASE_REF = + by MIZAR_RAW_ENDCASE_TAC o by (TRY MIZAR_END_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Parser-processor for textual version of Mizar proofs. *) +(* ------------------------------------------------------------------------- *) + +let add_mizar_words,subtract_mizar_words = + let l = ["assume"; "take"; "set"; "given"; "such"; "that"; + "proof"; "end"; "consider"; "suffices"; "to"; "show"; + "per"; "cases"; "endcase"; "suppose"; "be"; + "then"; "thus"; "hence"; "by"; "so"] in + (fun () -> reserve_words l), + (fun () -> unreserve_words l);; + +let parse_preform l = + let ptm,rst = parse_preterm l in + let ptm' = Typing(ptm,Ptycon("bool",[])) in + ptm',rst;; + +let parse_fulltype l = + let pty,rst = parse_pretype l in + type_of_pretype pty,rst;; + +let parse_ident l = + match (hd l) with + Ident n -> n,tl l + | _ -> raise Noparse;; + +let parse_string l = + match (hd l) with + Ident n -> n,tl l + | Resword n -> n,tl l;; + +let rec parse_lform oldlab l = + match l with + (Ident n)::(Resword ":")::rst -> + if oldlab = "" then parse_lform n rst + else failwith "Too many labels" + | _ -> let fm,rst = parse_preform l in (oldlab,fm),rst;; + +let parse_lforms oldlab = + listof (parse_lform oldlab) (a (Resword "and")) "labelled formula";; + +let parse_just tlink l = + if l = [] then + if tlink then ("",[L""]),l + else ("",[]),l else + match (hd l) with + Resword "by" -> + let pot,rem = parse_string (tl l) in + if rem = [] or hd rem <> Ident "," & hd rem <> Ident "with" then + if can (assoc pot) (!prover_list) then + (pot,if tlink then [L""] else []),rem + else + ("",if tlink then [L""; L pot] else [L pot]),rem + else if hd rem = Ident "," then + let oths,rst = listof parse_string (a (Ident ",")) "theorem name" + (tl rem) in + let ths = if tlink then ""::pot::oths else pot::oths in + ("",map L ths),rst + else + let oths,rst = listof parse_string (a (Ident ",")) "theorem name" + (tl rem) in + let ths = if tlink then ""::oths else oths in + (pot,map L ths),rst + | Resword "proof" -> + ("proof",[]),tl l + | _ -> + if tlink then ("",[L""]),l + else ("",[]),l;; + +let rec parse_step tlink l = + (a (Resword "assume") ++ parse_lforms "" + >> (by o MIZAR_ASSUME_TAC o snd) + || a (Resword "let") ++ (parse_preterm >> split_ppair) ++ + possibly (a (Resword "be") ++ parse_fulltype >> snd) + >> (fun ((_,vnames),ty) -> by (MIZAR_LET_TAC (vnames,ty))) + || a (Resword "take") ++ parse_preterm + >> (by o MIZAR_TAKE_TAC o snd) + || a (Resword "set") ++ parse_lforms "" + >> (itlist (by o MIZAR_SET_TAC) o snd) + || a (Resword "consider") ++ + (parse_preterm >> split_ppair) ++ + a (Resword "such") ++ + a (Resword "that") ++ + parse_lforms "" ++ + parse_just tlink + >> (fun (((((_,vars),_),_),lf),jst) -> by (MIZAR_CONSIDER_TAC vars lf jst)) + || a (Resword "given") ++ + (parse_preterm >> split_ppair) ++ + a (Resword "such") ++ + a (Resword "that") ++ + parse_lforms "" + >> (fun ((((_,vars),_),_),lf) -> by (MIZAR_GIVEN_TAC vars lf)) + || a (Resword "suffices") ++ + a (Resword "to") ++ + a (Resword "show") ++ + parse_lforms "" ++ + parse_just tlink + >> (fun ((((_,_),_),lf),jst) -> by (MIZAR_SUFFICES_TAC (map snd lf) jst)) + || a (Resword "per") ++ + a (Resword "cases") ++ + parse_just tlink + >> (fun ((_,_),jst) -> by (MIZAR_PER_CASES_TAC jst)) + || a (Resword "suppose") ++ + parse_lforms "" + >> (fun (_,lf) -> MIZAR_SUPPOSE_REF lf) + || a (Resword "endcase") + >> K MIZAR_ENDCASE_REF + || a (Resword "end") + >> K (by MIZAR_END_TAC) + || a (Resword "then") ++ parse_step true + >> snd + || a (Resword "so") ++ parse_step true + >> snd + || a (Resword "hence") ++ + parse_lforms "" ++ + parse_just true + >> (fun ((_,lf),jst) -> by (MIZAR_STEP_TAC true lf jst)) + || a (Resword "thus") ++ + parse_lforms "" ++ + parse_just tlink + >> (fun ((_,lf),jst) -> by (MIZAR_STEP_TAC true lf jst)) + || parse_lforms "" ++ parse_just tlink + >> (fun (lf,jst) -> by (MIZAR_STEP_TAC false lf jst))) l;; + +(* ------------------------------------------------------------------------- *) +(* From now on, quotations evaluate to preterms. *) +(* ------------------------------------------------------------------------- *) + +let run_steps lexemes = + let rec compose_steps lexemes gs = + if lexemes = [] then gs else + let rf,rest = parse_step false lexemes in + let gs' = rf gs in + if rest <> [] & hd rest = Resword ";" then compose_steps (tl rest) gs' + else compose_steps rest gs' in + refine (compose_steps lexemes);; + +(* ------------------------------------------------------------------------- *) +(* Include some theorems. *) +(* ------------------------------------------------------------------------- *) + +do_list add_mizar_transitivity_theorem + [LE_TRANS; LT_TRANS; LET_TRANS; LTE_TRANS];; + +do_list add_mizar_transitivity_theorem + [INT_LE_TRANS; INT_LT_TRANS; INT_LET_TRANS; INT_LTE_TRANS];; + +do_list add_mizar_transitivity_theorem + [REAL_LE_TRANS; REAL_LT_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS];; + +do_list add_mizar_transitivity_theorem + [SUBSET_TRANS; PSUBSET_TRANS; PSUBSET_SUBSET_TRANS; SUBSET_PSUBSET_TRANS];; + +(* ------------------------------------------------------------------------- *) +(* Simple example: Knaster-Tarski fixpoint theorem. *) +(* ------------------------------------------------------------------------- *) + +add_mizar_words();; + +hide_constant "<=";; + +(*** Set up goal ***) + +g `!f. (!x y. x <= y /\ y <= x ==> (x = y)) /\ + (!x y z. x <= y /\ y <= z ==> x <= z) /\ + (!x y. x <= y ==> f x <= f y) /\ + (!X. ?s:A. (!x. x IN X ==> s <= x) /\ + (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) + ==> ?x. f x = x`;; + +(*** Start parsing quotations as Mizar directives ***) + +let parse_term = run_steps o lex o explode;; + +(*** Label the external facts needed ***) + +e(LABEL_TAC "IN_ELIM_THM" IN_ELIM_THM);; +e(LABEL_TAC "BETA_THM" BETA_THM);; + +(*** The proof itself ***) + + `let f be A->A; + assume L:antecedent; + antisymmetry: (!x y. x <= y /\ y <= x ==> (x = y)) by L; + transitivity: (!x y z. x <= y /\ y <= z ==> x <= z) by L; + monotonicity: (!x y. x <= y ==> f x <= f y) by L; + least_upper_bound: + (!X. ?s:A. (!x. x IN X ==> s <= x) /\ + (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) by L; + set Y_def: Y = {b | f b <= b}; + Y_thm: !b. b IN Y <=> f b <= b by Y_def,IN_ELIM_THM,BETA_THM; + consider a such that + lub: (!x. x IN Y ==> a <= x) /\ + (!a'. (!x. x IN Y ==> a' <= x) ==> a' <= a) + by least_upper_bound; + take a; + !b. b IN Y ==> f a <= b + proof + let b be A; + assume b_in_Y: b IN Y; + then L0: f b <= b by Y_thm; + a <= b by b_in_Y, lub; + so f a <= f b by monotonicity; + hence f a <= b by L0, transitivity; + end; + so Part1: f(a) <= a by lub; + so f(f(a)) <= f(a) by monotonicity; + so f(a) IN Y by Y_thm; + so a <= f(a) by lub; + hence thesis by Part1, antisymmetry; +end`;; + +(*** Get the theorem ***) + +top_thm();; + +(* ------------------------------------------------------------------------- *) +(* Back to normal. *) +(* ------------------------------------------------------------------------- *) + +let parse_term = old_parse_term;; diff --git a/Examples/multiwf.ml b/Examples/multiwf.ml new file mode 100644 index 0000000..d9e6d16 --- /dev/null +++ b/Examples/multiwf.ml @@ -0,0 +1,307 @@ +(* ========================================================================= *) +(* Part 1: Background theories. *) +(* ========================================================================= *) + +let EMPTY_IS_FINITE = prove + (`!s. (s = EMPTY) ==> FINITE s`, + SIMP_TAC[FINITE_RULES]);; + +let SING_IS_FINITE = prove + (`!s a. (s = {a}) ==> FINITE s`, + SIMP_TAC[FINITE_INSERT; FINITE_RULES]);; + +let UNION_NONZERO = prove + (`{a | ~(f a + g a = 0)} = {a | ~(f a = 0)} UNION {a | ~(g a = 0)}`, + REWRITE_TAC[ADD_EQ_0; EXTENSION; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of type of finite multisets with a few basic operations. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("mmember",(11,"right"));; +parse_as_infix("munion",(16,"right"));; +parse_as_infix("mdiff",(18,"left"));; + +let multiset_tybij_th = prove + (`?f. FINITE {a:A | ~(f a = 0)}`, + EXISTS_TAC `\a:A. 0` THEN + SIMP_TAC[EMPTY_IS_FINITE; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]);; + +let multiset_tybij = new_type_definition + "multiset" ("multiset","multiplicity") multiset_tybij_th;; + +let mempty = new_definition + `mempty = multiset (\b. 0)`;; + +let mmember = new_definition + `a mmember M <=> ~(multiplicity M a = 0)`;; + +let msing = new_definition + `msing a = multiset (\b. if b = a then 1 else 0)`;; + +let munion = new_definition + `M munion N = multiset(\b. multiplicity M b + multiplicity N b)`;; + +let mdiff = new_definition + `M mdiff N = multiset(\b. multiplicity M b - multiplicity N b)`;; + +(* ------------------------------------------------------------------------- *) +(* Extensionality for multisets. *) +(* ------------------------------------------------------------------------- *) + +let MEXTENSION = prove + (`(M = N) = !a. multiplicity M a = multiplicity N a`, + REWRITE_TAC[GSYM FUN_EQ_THM] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + MESON_TAC[multiset_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of multisets. *) +(* ------------------------------------------------------------------------- *) + +let MULTIPLICITY_MULTISET = prove + (`FINITE {a | ~(f a = 0)} /\ (f a = y) ==> (multiplicity(multiset f) a = y)`, + SIMP_TAC[multiset_tybij]);; + +let MEMPTY = prove + (`multiplicity mempty a = 0`, + REWRITE_TAC[mempty] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN + SIMP_TAC[EMPTY_IS_FINITE; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]);; + +let MSING = prove + (`multiplicity (msing (a:A)) b = if b = a then 1 else 0`, + REWRITE_TAC[msing] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN + REWRITE_TAC[] THEN MATCH_MP_TAC SING_IS_FINITE THEN EXISTS_TAC `a:A` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[ARITH_EQ]);; + +let MUNION = prove + (`multiplicity (M munion N) a = multiplicity M a + multiplicity N a`, + REWRITE_TAC[munion] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN + REWRITE_TAC[UNION_NONZERO; FINITE_UNION] THEN SIMP_TAC[multiset_tybij] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[multiset_tybij]);; + +let MDIFF = prove + (`multiplicity (M mdiff N) (a:A) = multiplicity M a - multiplicity N a`, + REWRITE_TAC[mdiff] THEN MATCH_MP_TAC MULTIPLICITY_MULTISET THEN + REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{a:A | ~(multiplicity M a = 0)}` THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; multiset_tybij] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[multiset_tybij] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some trivial properties of multisets that we use later. *) +(* ------------------------------------------------------------------------- *) + +let MUNION_MEMPTY = prove + (`~(M munion (msing(a:A)) = mempty)`, + REWRITE_TAC[MEXTENSION; MEMPTY; MSING; MUNION] THEN + DISCH_THEN(MP_TAC o SPEC `a:A`) THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ]);; + +let MMEMBER_MUNION = prove + (`x mmember (M munion N) <=> x mmember M \/ x mmember N`, + REWRITE_TAC[mmember; MUNION; ADD_EQ_0; DE_MORGAN_THM]);; + +let MMEMBER_MSING = prove + (`x mmember (msing a) <=> (x = a)`, + REWRITE_TAC[mmember; MSING] THEN COND_CASES_TAC THEN REWRITE_TAC[ARITH_EQ]);; + +let MUNION_EMPTY = prove + (`M munion mempty = M`, + REWRITE_TAC[MEXTENSION; MUNION; MEMPTY; ADD_CLAUSES]);; + +let MUNION_ASSOC = prove + (`M1 munion (M2 munion M3) = (M1 munion M2) munion M3`, + REWRITE_TAC[MEXTENSION; MUNION; ADD_ASSOC]);; + +let MUNION_AC = prove + (`(M1 munion M2 = M2 munion M1) /\ + ((M1 munion M2) munion M3 = M1 munion M2 munion M3) /\ + (M1 munion M2 munion M3 = M2 munion M1 munion M3)`, + REWRITE_TAC[MEXTENSION; MUNION; ADD_AC]);; + +let MUNION_11 = prove + (`(M1 munion N = M2 munion N) <=> (M1 = M2)`, + REWRITE_TAC[MEXTENSION; MUNION; EQ_ADD_RCANCEL]);; + +let MUNION_INUNION = prove + (`a mmember (M munion (msing b)) /\ ~(b = a) ==> a mmember M`, + REWRITE_TAC[mmember; MUNION; MSING; ADD_EQ_0] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ]);; + +let MMEMBER_MDIFF = prove + (`(a:A) mmember M ==> (M = (M mdiff (msing a)) munion (msing a))`, + REWRITE_TAC[mmember; MEXTENSION; MUNION; MDIFF; MSING] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(multiplicity M (a:A) = 0)` THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Induction principle for multisets. *) +(* ------------------------------------------------------------------------- *) + +let MULTISET_INDUCT_LEMMA1 = prove + (`(!M. ({a | ~(multiplicity M a = 0)} SUBSET s) ==> P M) /\ + (!a:A M. P M ==> P (M munion (msing a))) + ==> !n M. (multiplicity M a = n) /\ + {a:A | ~(multiplicity M a = 0)} SUBSET (a INSERT s) + ==> P M`, + STRIP_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `{a:A | ~(multiplicity M a = 0)} SUBSET (a INSERT s)` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT] THEN ASM_MESON_TAC[]; + SUBGOAL_THEN `M = (M mdiff (msing(a:A))) munion (msing a)` SUBST1_TAC THENL + [MATCH_MP_TAC MMEMBER_MDIFF THEN ASM_REWRITE_TAC[mmember; NOT_SUC]; + ALL_TAC] THEN + MAP_EVERY (MATCH_MP_TAC o ASSUME) + [`!a:A M. P M ==> P (M munion msing a)`; + `!M. (multiplicity M a = n) /\ + {a:A | ~(multiplicity M a = 0)} SUBSET (a INSERT s) + ==> P M`] THEN + ASM_REWRITE_TAC[MDIFF; MSING; ARITH_RULE `SUC n - 1 = n`] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{a:A | ~(multiplicity M a = 0)}` THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; CONTRAPOS_THM; SUB_0]]);; + +let MULTISET_INDUCT_LEMMA2 = prove + (`P mempty /\ + (!a:A M. P M ==> P (M munion (msing a))) + ==> !s. FINITE s ==> !M. {a:A | ~(multiplicity M a = 0)} SUBSET s ==> P M`, + STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `M:(A)multiset = mempty` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[MEXTENSION; MEMPTY]; X_GEN_TAC `a:A`] THEN + REPEAT STRIP_TAC THEN MP_TAC MULTISET_INDUCT_LEMMA1 THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM EXISTS_REFL]);; + +let MULTISET_INDUCT = prove + (`P mempty /\ + (!a:A M. P M ==> P (M munion (msing a))) + ==> !M. P M`, + DISCH_THEN(MP_TAC o MATCH_MP MULTISET_INDUCT_LEMMA2) THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP] THEN + GEN_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + EXISTS_TAC `{a:A | ~(multiplicity M a = 0)}` THEN + REWRITE_TAC[SUBSET_REFL; multiset_tybij] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN REWRITE_TAC[multiset_tybij]);; + +(* ========================================================================= *) +(* Part 2: Transcription of Tobias's paper. *) +(* ========================================================================= *) + +parse_as_infix("<<",(12,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Wellfounded part of a relation. *) +(* ------------------------------------------------------------------------- *) + +let WFP_RULES,WFP_INDUCT,WFP_CASES = new_inductive_definition + `!x. (!y. y << x ==> WFP(<<) y) ==> WFP(<<) x`;; + +(* ------------------------------------------------------------------------- *) +(* Wellfounded part induction. *) +(* ------------------------------------------------------------------------- *) + +let WFP_PART_INDUCT = prove + (`!P. (!x. x IN WFP(<<) /\ (!y. y << x ==> P(y)) ==> P(x)) + ==> !x:A. x IN WFP(<<) ==> P(x)`, + GEN_TAC THEN REWRITE_TAC[IN] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a /\ b`] THEN + MATCH_MP_TAC WFP_INDUCT THEN ASM_MESON_TAC[WFP_RULES]);; + +(* ------------------------------------------------------------------------- *) +(* A relation is wellfounded iff WFP is the whole universe. *) +(* ------------------------------------------------------------------------- *) + +let WFP_WF = prove + (`WF(<<) <=> (WFP(<<) = UNIV:A->bool)`, + EQ_TAC THENL + [REWRITE_TAC[WF_IND; EXTENSION; IN; UNIV] THEN MESON_TAC[WFP_RULES]; + DISCH_TAC THEN MP_TAC WFP_PART_INDUCT THEN + ASM_REWRITE_TAC[IN; UNIV; WF_IND]]);; + +(* ------------------------------------------------------------------------- *) +(* The multiset order. *) +(* ------------------------------------------------------------------------- *) + +let morder = new_definition + `morder(<<) N M <=> ?M0 a K. (M = M0 munion (msing a)) /\ + (N = M0 munion K) /\ + (!b. b mmember K ==> b << a)`;; + +(* ------------------------------------------------------------------------- *) +(* We separate off this part from the proof of LEMMA_2_1. *) +(* ------------------------------------------------------------------------- *) + +let LEMMA_2_0 = prove + (`morder(<<) N (M0 munion (msing a)) + ==> (?M. morder(<<) M M0 /\ (N = M munion (msing a))) \/ + (?K. (N = M0 munion K) /\ (!b:A. b mmember K ==> b << a))`, + GEN_REWRITE_TAC LAND_CONV [morder] THEN + DISCH_THEN(EVERY_TCL (map X_CHOOSE_THEN + [`M1:(A)multiset`; `b:A`; `K:(A)multiset`]) STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `b:A = a` THENL + [DISJ2_TAC THEN UNDISCH_THEN `b:A = a` SUBST_ALL_TAC THEN + EXISTS_TAC `K:(A)multiset` THEN ASM_MESON_TAC[MUNION_11]; DISJ1_TAC] THEN + SUBGOAL_THEN `?M2. M1 = M2 munion (msing(a:A))` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `M1 mdiff (msing(a:A))` THEN + MAP_EVERY MATCH_MP_TAC [MMEMBER_MDIFF; MUNION_INUNION] THEN + UNDISCH_TAC `M0 munion (msing a) = M1 munion (msing(b:A))` THEN + ASM_REWRITE_TAC[MEXTENSION; MUNION; MSING; mmember] THEN + DISCH_THEN(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN + ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `M2 munion K:(A)multiset` THEN ASM_REWRITE_TAC[MUNION_AC] THEN + REWRITE_TAC[morder] THEN + MAP_EVERY EXISTS_TAC [`M2:(A)multiset`; `b:A`; `K:(A)multiset`] THEN + UNDISCH_TAC `M0 munion msing (a:A) = M1 munion msing b` THEN + ASM_REWRITE_TAC[MUNION_AC] THEN MESON_TAC[MUNION_AC; MUNION_11]);; + +(* ------------------------------------------------------------------------- *) +(* The sequence of lemmas from Tobias's paper. *) +(* ------------------------------------------------------------------------- *) + +let LEMMA_2_1 = prove + (`(!M b:A. b << a /\ M IN WFP(morder(<<)) + ==> (M munion (msing b)) IN WFP(morder(<<))) /\ + M0 IN WFP(morder(<<)) /\ + (!M. morder(<<) M M0 ==> (M munion (msing a)) IN WFP(morder(<<))) + ==> (M0 munion (msing a)) IN WFP(morder(<<))`, + STRIP_TAC THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC WFP_RULES THEN + X_GEN_TAC `N:(A)multiset` THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP LEMMA_2_0) THENL + [ASM_MESON_TAC[IN]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + SPEC_TAC(`N:(A)multiset`,`N:(A)multiset`) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC MULTISET_INDUCT THEN REPEAT STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[MUNION_ASSOC; MMEMBER_MUNION; MMEMBER_MSING]) THEN + ASM_MESON_TAC[IN; MUNION_EMPTY]);; + +let LEMMA_2_2 = prove + (`(!M b. b << a /\ M IN WFP(morder(<<)) + ==> (M munion (msing b)) IN WFP(morder(<<))) + ==> !M. M IN WFP(morder(<<)) ==> (M munion (msing a)) IN WFP(morder(<<))`, + STRIP_TAC THEN MATCH_MP_TAC WFP_PART_INDUCT THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LEMMA_2_1 THEN ASM_REWRITE_TAC[]);; + +let LEMMA_2_3 = prove + (`WF(<<) + ==> !a M. M IN WFP(morder(<<)) ==> (M munion (msing a)) IN WFP(morder(<<))`, + REWRITE_TAC[WF_IND] THEN DISCH_THEN MATCH_MP_TAC THEN MESON_TAC[LEMMA_2_2]);; + +let LEMMA_2_4 = prove + (`WF(<<) ==> !M. M IN WFP(morder(<<))`, + DISCH_TAC THEN MATCH_MP_TAC MULTISET_INDUCT THEN CONJ_TAC THENL + [REWRITE_TAC[IN] THEN MATCH_MP_TAC WFP_RULES THEN + REWRITE_TAC[morder; MUNION_MEMPTY]; + ASM_SIMP_TAC[LEMMA_2_3]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the final result. *) +(* ------------------------------------------------------------------------- *) + +let MORDER_WF = prove + (`WF(<<) ==> WF(morder(<<))`, + SIMP_TAC[WFP_WF; EXTENSION; IN_UNIV; LEMMA_2_4]);; diff --git a/Examples/pell.ml b/Examples/pell.ml new file mode 100644 index 0000000..c34de65 --- /dev/null +++ b/Examples/pell.ml @@ -0,0 +1,2295 @@ +(* ========================================================================= *) +(* Analysis of solutions to Pell equation *) +(* ========================================================================= *) + +needs "Library/analysis.ml";; +needs "Library/transc.ml";; +needs "Library/prime.ml";; + +prioritize_real();; + +let PELL_INDUCTION = prove + (`P 0 /\ P 1 /\ (!n. P n /\ P (n + 1) ==> P(n + 2)) ==> !n. P n`, + STRIP_TAC THEN + SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> REWRITE_TAC[th]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + ASM_SIMP_TAC[ADD1; ARITH_RULE `SUC(n + 1) = n + 2`]);; + +(* ------------------------------------------------------------------------- *) +(* Useful number-theoretic basics *) +(* ------------------------------------------------------------------------- *) + +let ROOT_NONPOWER = prove + (`!p q d n. ~(q = 0) /\ (p EXP n = d * q EXP n) ==> ?a. d = a EXP n`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[EXP; MULT_CLAUSES] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `q:num`; `p:num`] DIVIDES_EXP2_REV) THEN + ASM_REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `d:num`) THEN + REWRITE_TAC[EQT_INTRO(SPEC_ALL MULT_SYM)] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` SUBST_ALL_TAC) THEN + EXISTS_TAC `a:num` THEN + UNDISCH_TAC `(a * q) EXP n = d * q EXP n` THEN + ASM_SIMP_TAC[MULT_EXP; EQ_MULT_RCANCEL; EXP_EQ_0]);; + +let INTEGER_SUB_LEMMA = prove + (`!x y. ?n. (&x - &y) pow 2 = &n pow 2`, + REPEAT STRIP_TAC THEN + DISJ_CASES_THEN MP_TAC (SPECL [`&x`; `&y`] REAL_LE_TOTAL) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN DISCH_TAC THENL + [EXISTS_TAC `y - x:num`; EXISTS_TAC `x - y:num`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +let SQRT_LINEAR_EQ = prove + (`!a u v x y. + 2 <= a + ==> ((&u + &v * sqrt(&a pow 2 - &1) = &x + &y * sqrt(&a pow 2 - &1)) <=> + (u = x) /\ (v = y))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + REWRITE_TAC[REAL_ARITH `(a + b = c + d) <=> (a - c = d - b)`] THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN + DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN + REWRITE_TAC[REAL_POW_MUL] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `2 <= a ==> 1 <= a`] THEN + X_CHOOSE_TAC `p:num` (SPECL [`u:num`; `x:num`] INTEGER_SUB_LEMMA) THEN + X_CHOOSE_TAC `q:num` (SPECL [`y:num`; `v:num`] INTEGER_SUB_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `2 <= a ==> 1 <= a`]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`p:num`; `q:num`; `a EXP 2 - 1`; `2`] ROOT_NONPOWER) THEN + ASM_REWRITE_TAC[EQT_INTRO(SPEC_ALL MULT_SYM)] THEN + MATCH_MP_TAC(TAUT `~b /\ (a ==> c) ==> ((~a ==> b) ==> c)`) THEN + CONJ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `b:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP + (ARITH_RULE `(a - 1 = b) ==> 1 < a ==> (a - b = 1)`)) THEN + SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 EXP))) THEN + ASM_REWRITE_TAC[LT_EXP; ARITH_LE; ARITH_LT] THEN + REWRITE_TAC[EXP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a - b = 1) ==> (a = b + 1)`)) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; GSYM + REAL_OF_NUM_POW] THEN + REWRITE_TAC[REAL_POW_2] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REAL_ARITH `(a * a = b * b + &1) ==> ((a + b) * (a - b) = &1)`)) THEN + DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN + REWRITE_TAC[REAL_POW_MUL] THEN + X_CHOOSE_TAC `c:num` (SPECL [`a:num`; `b:num`] INTEGER_SUB_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; EXP_ONE; EXP_EQ_1; MULT_EQ_1; ARITH_EQ] THEN + UNDISCH_TAC `2 <= a` THEN ARITH_TAC; + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `p EXP 2 = 0 EXP 2 * (a EXP 2 - 1)` THEN + REWRITE_TAC[ARITH; MULT_CLAUSES; EXP_EQ_0] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `(&u - &x) pow 2 = &0 pow 2` THEN + UNDISCH_TAC `(&y - &v) pow 2 = &0 pow 2` THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_EQ_0; ARITH_EQ; REAL_SUB_0] THEN + SIMP_TAC[REAL_OF_NUM_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* Recurrence defining the solutions. *) +(* ------------------------------------------------------------------------- *) + +let X_DEF = + let th = prove + (`!a. ?X. !n. X n = if n = 0 then 1 + else if n = 1 then a + else 2 * a * X(n-1) - X(n-2)`, + GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + BINOP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `n - m < n <=> ~(m = 0) /\ ~(n = 0)`; ARITH_EQ]) in + new_specification ["X"] (REWRITE_RULE[SKOLEM_THM] th);; + +let X_CLAUSES = prove + (`(!a. X a 0 = 1) /\ + (!a. X a 1 = a) /\ + (!a n. X a (n + 2) = 2 * a * X a (n + 1) - X a (n))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [X_DEF] THEN + REWRITE_TAC[ARITH_EQ; ADD_EQ_0; ARITH_RULE `~(n + 2 = 1)`] THEN + REWRITE_TAC[ARITH_RULE `((n + 2) - 2 = n) /\ ((n + 2) - 1 = n + 1)`]);; + +let Y_DEF = + let th = prove + (`!a. ?Y. !n. Y n = if n = 0 then 0 + else if n = 1 then 1 + else 2 * a * Y(n-1) - Y(n-2)`, + GEN_TAC THEN MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + BINOP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `n - m < n <=> ~(m = 0) /\ ~(n = 0)`; ARITH_EQ]) in + new_specification ["Y"] (REWRITE_RULE[SKOLEM_THM] th);; + +let Y_CLAUSES = prove + (`(!a. Y a 0 = 0) /\ + (!a. Y a 1 = 1) /\ + (!a n. Y a (n + 2) = 2 * a * Y a (n + 1) - Y a (n))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [Y_DEF] THEN + REWRITE_TAC[ARITH_EQ; ADD_EQ_0; ARITH_RULE `~(n + 2 = 1)`] THEN + REWRITE_TAC[ARITH_RULE `((n + 2) - 2 = n) /\ ((n + 2) - 1 = n + 1)`]);; + +(* ------------------------------------------------------------------------- *) +(* An obvious but tiresome lemma: the Xs and Ys increase. *) +(* ------------------------------------------------------------------------- *) + +let X_INCREASES = prove + (`!a n. ~(a = 0) ==> X a n <= X a (n + 1)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[X_CLAUSES; ADD_CLAUSES; + ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + GEN_REWRITE_TAC RAND_CONV [X_DEF] THEN + ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; + ARITH_RULE `(n + 1 = 1) <=> (n = 0)`] THEN + REWRITE_TAC[ADD_SUB] THEN + MATCH_MP_TAC(ARITH_RULE `a + b <= c ==> a <= c - b:num`) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 * X a n` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[LE_MULT_LCANCEL; ARITH_EQ] THEN + UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`a:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `a <= b + a:num`]] THEN + MATCH_MP_TAC(ARITH_RULE `b <= a ==> a + b <= 2 * a`) THEN + SUBGOAL_THEN `n = (n - 1) + 1` SUBST1_TAC THENL + [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `((n + 1) + 1) - 2 = n`] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC);; + +let Y_INCREASES = prove + (`!a n. ~(a = 0) ==> Y a n <= Y a (n + 1)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[Y_CLAUSES; ADD_CLAUSES; LE_0] THEN + GEN_REWRITE_TAC RAND_CONV [Y_DEF] THEN + ASM_REWRITE_TAC[ADD_EQ_0; ARITH_EQ; + ARITH_RULE `(n + 1 = 1) <=> (n = 0)`] THEN + REWRITE_TAC[ADD_SUB] THEN + MATCH_MP_TAC(ARITH_RULE `a + b <= c ==> a <= c - b:num`) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 * Y a n` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[LE_MULT_LCANCEL; ARITH_EQ] THEN + UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`a:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `a <= b + a:num`]] THEN + MATCH_MP_TAC(ARITH_RULE `b <= a ==> a + b <= 2 * a`) THEN + SUBGOAL_THEN `n = (n - 1) + 1` SUBST1_TAC THENL + [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `((n + 1) + 1) - 2 = n`] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Show that the expression is a power of the basis. *) +(* ------------------------------------------------------------------------- *) + +let XY_POWER_POS = prove + (`!a n. ~(a = 0) ==> (&(X a n) + &(Y a n) * sqrt(&a pow 2 - &1) = + (&a + sqrt(&a pow 2 - &1)) pow n)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[X_DEF; Y_DEF] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; real_pow] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_1; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN + `(&(2 * a * X a (n - 1) - X a (n - 2)) = + &(2 * a * X a (n - 1)) - &(X a (n - 2))) /\ + (&(2 * a * Y a (n - 1) - Y a (n - 2)) = + &(2 * a * Y a (n - 1)) - &(Y a (n - 2)))` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN MATCH_MP_TAC(GSYM REAL_OF_NUM_SUB) THEN + MATCH_MP_TAC(ARITH_RULE + `x <= y /\ y <= 2 * a * y ==> x <= 2 * a * y`) THEN + ASM_SIMP_TAC[ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> (n - 1 = (n - 2) + 1)`] THEN + ASM_SIMP_TAC[X_INCREASES; Y_INCREASES] THEN + REWRITE_TAC[MULT_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `(x1 - x2) + (y1 - y2) * a = (x1 + y1 * a) - (x2 + y2 * a)`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_ADD_LDISTRIB] THEN + ASM_SIMP_TAC[ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> n - 2 < n /\ n - 1 < n`] THEN + ASM_SIMP_TAC[ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> (n - 1 = 1 + (n - 2))`] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; REAL_POW_1] THEN + REWRITE_TAC[REAL_ARITH `a * b - b = (a - &1) * b`] THEN + SUBGOAL_THEN `n = 2 + (n - 2)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; + REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +let XY_POWER_NEG = prove + (`!a n. ~(a = 0) ==> (&(X a n) - &(Y a n) * sqrt(&a pow 2 - &1) = + (&a - sqrt(&a pow 2 - &1)) pow n)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[X_DEF; Y_DEF] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO; real_pow] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_1; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN + `(&(2 * a * X a (n - 1) - X a (n - 2)) = + &(2 * a * X a (n - 1)) - &(X a (n - 2))) /\ + (&(2 * a * Y a (n - 1) - Y a (n - 2)) = + &(2 * a * Y a (n - 1)) - &(Y a (n - 2)))` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN MATCH_MP_TAC(GSYM REAL_OF_NUM_SUB) THEN + MATCH_MP_TAC(ARITH_RULE + `x <= y /\ y <= 2 * a * y ==> x <= 2 * a * y`) THEN + ASM_SIMP_TAC[ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> (n - 1 = (n - 2) + 1)`] THEN + ASM_SIMP_TAC[X_INCREASES; Y_INCREASES] THEN + REWRITE_TAC[MULT_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `(x1 - x2) - (y1 - y2) * a = (x1 - y1 * a) - (x2 - y2 * a)`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_SUB_LDISTRIB] THEN + ASM_SIMP_TAC[ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> n - 2 < n /\ n - 1 < n`] THEN + ASM_SIMP_TAC[ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> (n - 1 = 1 + (n - 2))`] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; REAL_POW_1] THEN + REWRITE_TAC[REAL_ARITH `a * b - b = (a - &1) * b`] THEN + SUBGOAL_THEN `n = 2 + (n - 2)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) + THENL + [MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_ADD] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_POW_2; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; + REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence all members of recurrence relations are Pell solutions. *) +(* ------------------------------------------------------------------------- *) + +let XY_ARE_SOLUTIONS = prove + (`!a n. ~(a = 0) + ==> ((X a n) EXP 2 = (a EXP 2 - 1) * (Y a n) EXP 2 + 1)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP XY_POWER_NEG) THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP XY_POWER_POS) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> + MP_TAC(MK_COMB(AP_TERM `( * )` (CONJUNCT1 th),CONJUNCT2 th))) THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_ARITH `(x + y) * (x - y) = x * x - y * y`] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (a * c) * (b * d)`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; + REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + REWRITE_TAC[REAL_ARITH `a - (a - &1) = &1`; REAL_POW_ONE] THEN + REWRITE_TAC[REAL_EQ_SUB_RADD] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `1 <= a <=> ~(a = 0)`]; + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; + REAL_OF_NUM_POW] THEN + REWRITE_TAC[MULT_AC; ADD_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* And they are all solutions. *) +(* ------------------------------------------------------------------------- *) + +let X_DEGENERATE = prove + (`!n. X 1 n = 1`, + MATCH_MP_TAC PELL_INDUCTION THEN SIMP_TAC[X_CLAUSES; ARITH]);; + +let Y_DEGENERATE = prove + (`!n. Y 1 n = n`, + MATCH_MP_TAC PELL_INDUCTION THEN SIMP_TAC[Y_CLAUSES] THEN + REPEAT STRIP_TAC THEN ARITH_TAC);; + +let REAL_ARCH_POW = prove + (`!x y. &1 < x /\ &1 < y + ==> ?n. x pow n <= y /\ y < x pow (SUC n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `ln(x)` REAL_ARCH_LEAST) THEN ASM_SIMP_TAC[LN_POS_LT] THEN + DISCH_THEN(MP_TAC o SPEC `ln(y)`) THEN + ASM_SIMP_TAC[LN_POS_LT; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[GSYM LN_POW; REAL_ARITH `&1 < x ==> &0 < x`; + REAL_POW_LT; LN_MONO_LT; LN_MONO_LE]);; + +let SOLUTIONS_INDUCTION = prove + (`!a x y. + ~(a = 0) /\ ~(a = 1) /\ ~(y = 0) /\ + (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) + ==> ?x' y'. x' < x /\ y' < y /\ + (x' EXP 2 = (a EXP 2 - 1) * y' EXP 2 + 1) /\ + (&x + &y * sqrt(&a pow 2 - &1) = + (&x' + &y' * sqrt(&a pow 2 - &1)) * + (&a + sqrt(&a pow 2 - &1)))`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `a * x - (a EXP 2 - 1) * y` THEN + EXISTS_TAC `a * y - x:num` THEN + SUBGOAL_THEN `x <= a * y:num` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[GSYM(SPECL [`x:num`; `y:num`; `1`] EXP_MONO_LE_SUC)] THEN + ASM_REWRITE_TAC[ARITH_SUC] THEN + REWRITE_TAC[GSYM ADD1; LE_SUC_LT] THEN + REWRITE_TAC[MULT_EXP; LT_MULT_RCANCEL] THEN + REWRITE_TAC[ARITH_RULE `a - 1 < a <=> ~(a = 0)`] THEN + ASM_REWRITE_TAC[EXP_EQ_0]; ALL_TAC] THEN + SUBGOAL_THEN `(a EXP 2 - 1) * y <= a * x:num` ASSUME_TAC THENL + [SUBGOAL_THEN `(a EXP 2 - 1) * y EXP 2 < a * x * y` MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[MULT_ASSOC; EXP_2; LT_MULT_RCANCEL; LT_IMP_LE]] THEN + REWRITE_TAC[GSYM LE_SUC_LT; ADD1] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + REWRITE_TAC[EXP_2; GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN + DISJ2_TAC THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `d /\ (d ==> a /\ b /\ c) + ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN + EXISTS_TAC `&a - sqrt(&a pow 2 - &1)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH `(a + b) * (a - b) = a * a - b * b`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[REAL_ARITH `a - (a - b) = b`; REAL_MUL_RID] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN + REWRITE_TAC[REAL_ARITH + `(x + y * s) * (a - s) = (a * x - (s * s) * y) + (a * y - x) * s`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + SUBGOAL_THEN + `(&x - &y * sqrt(&a pow 2 - &1)) = + (&(a * x - (a EXP 2 - 1) * y) - &(a * y - x) * sqrt (&a pow 2 - &1)) * + (&a - sqrt(&a pow 2 - &1))` + MP_TAC THENL + [MATCH_MP_TAC REAL_EQ_RCANCEL_IMP THEN + EXISTS_TAC `&a + sqrt(&a pow 2 - &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `~(a = --b) ==> ~(a + b = &0)`) THEN + DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow)`) THEN + REWRITE_TAC[REAL_POW_NEG; ARITH] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH `(a - b) * (a + b) = a * a - b * b`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[REAL_ARITH `a - (a - b) = b`; REAL_MUL_RID] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN + REWRITE_TAC[REAL_ARITH + `(x - y * s) * (a + s) = (a * x - (s * s) * y) - (a * y - x) * s`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + DISCH_THEN(fun th1 -> DISCH_THEN (fun th2 -> + MP_TAC(MK_COMB(AP_TERM `( * )` th1,th2)))) THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (c * a) * (d * b)`] THEN + REWRITE_TAC[REAL_ARITH `(a + b) * (a - b) = a * a - b * b`] THEN + REWRITE_TAC[REAL_ARITH `(a - b) * (a + b) = a * a - b * b`] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * b) = (c * a) * (b * b)`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[REAL_ARITH `a - (a - b) = b`; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_POW] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_MUL] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `((a * b + &1) - b * a = x - y) ==> (x = y + &1)`)) THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; + REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN + ABBREV_TAC `u = a * x - (a EXP 2 - 1) * y` THEN + ABBREV_TAC `v = a * y - x:num` THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[MULT_SYM]) THEN + REWRITE_TAC[MULT_AC] THEN + MATCH_MP_TAC(TAUT `(a <=> b) /\ (~a /\ ~b ==> F) ==> a /\ b`) THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM(SPEC `1` EXP_MONO_LT_SUC)] THEN + ASM_REWRITE_TAC[ARITH_SUC] THEN + REWRITE_TAC[LT_ADD_RCANCEL; LT_MULT_LCANCEL] THEN + REWRITE_TAC[num_CONV `2`; EXP_MONO_LT_SUC] THEN + MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN + REWRITE_TAC[SUB_EQ_0; ARITH_SUC; NOT_LE] THEN + SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 EXP))) THEN + REWRITE_TAC[LT_EXP] THEN REWRITE_TAC[ARITH] THEN + MATCH_MP_TAC(ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[NOT_LT] THEN STRIP_TAC THEN + UNDISCH_TAC + `&x + &y * sqrt (&a pow 2 - &1) = + (&u + &v * sqrt (&a pow 2 - &1)) * (&a + sqrt (&a pow 2 - &1))` THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a < b ==> ~(a = b)`) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(&u + &v * sqrt (&a pow 2 - &1)) * &1` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; SQRT_POS_LE; REAL_POW_LE_1; + REAL_SUB_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT; LT_NZ] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `0 EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1` THEN + DISCH_THEN(MP_TAC o SYM) THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; SQRT_POS_LE; REAL_POW_LE_1; + REAL_SUB_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&1 < x /\ &0 <= y ==> &1 < x + y`) THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; SQRT_POS_LE; REAL_POW_LE_1; + REAL_SUB_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN + MATCH_MP_TAC(ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 1 < a`) THEN + ASM_REWRITE_TAC[]);; + +let SOLUTIONS_ARE_XY = prove + (`!a x y. + ~(a = 0) /\ + (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) + ==> ?n. (x = X a n) /\ (y = Y a n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = 1` THENL + [ASM_REWRITE_TAC[ARITH; MULT_CLAUSES; ADD_CLAUSES; EXP_2] THEN + SIMP_TAC[MULT_EQ_1; X_DEGENERATE; Y_DEGENERATE; GSYM EXISTS_REFL]; + ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?n. &x + &y * sqrt(&a pow 2 - &1) = + (&a + sqrt(&a pow 2 - &1)) pow n` + MP_TAC THENL + [UNDISCH_TAC `x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1` THEN + SPEC_TAC(`x:num`,`x:num`) THEN SPEC_TAC(`y:num`,`y:num`) THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `y0:num` THEN DISCH_TAC THEN + X_GEN_TAC `x0:num` THEN + ASM_CASES_TAC `y0 = 0` THENL + [ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES; MULT_EQ_1] THEN + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `0` THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; real_pow]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`a:num`; `x0:num`; `y0:num`] SOLUTIONS_INDUCTION) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x1:num` (X_CHOOSE_THEN `y1:num` + STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y1:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x1:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + EXISTS_TAC `SUC n` THEN REWRITE_TAC[real_pow; REAL_MUL_AC]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM XY_POWER_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN + ASM_SIMP_TAC[SQRT_LINEAR_EQ; + ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`]);; + +(* ------------------------------------------------------------------------- *) +(* Addition formulas. *) +(* ------------------------------------------------------------------------- *) + +let ADDITION_FORMULA_POS = prove + (`!a m n. + ~(a = 0) + ==> ((X a (m + n) = X a m * X a n + (a EXP 2 - 1) * Y a m * Y a n) /\ + (Y a (m + n) = X a m * Y a n + X a n * Y a m))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a = 1` THENL + [ASM_REWRITE_TAC[X_DEGENERATE; Y_DEGENERATE] THEN + REWRITE_TAC[ARITH; MULT_CLAUSES] THEN REWRITE_TAC[ADD_AC]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `m + n:num`] XY_POWER_POS) THEN + MP_TAC(SPECL [`a:num`; `m:num`] XY_POWER_POS) THEN + MP_TAC(SPECL [`a:num`; `n:num`] XY_POWER_POS) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_ADD] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH + `(a + b * s) * (c + d * s) = (a * c + (s * s) * b * d) + + (a * d + b * c) * s`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_LINEAR_EQ; + ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`] THEN + REWRITE_TAC[MULT_AC]);; + +let ADDITION_FORMULA_NEG = prove + (`!a m n. + ~(a = 0) /\ m <= n + ==> ((X a (n - m) = X a m * X a n - (a EXP 2 - 1) * Y a m * Y a n) /\ + (Y a (n - m) = X a m * Y a n - X a n * Y a m))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `a = 1` THENL + [ASM_REWRITE_TAC[X_DEGENERATE; Y_DEGENERATE] THEN + REWRITE_TAC[ARITH; MULT_CLAUSES]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `n - m:num`] XY_POWER_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM + `( * ) (((&a - sqrt (&a pow 2 - &1)) * + (&a + sqrt (&a pow 2 - &1))) pow m)`) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `(x - y) * (x + y) = x * x - y * y`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; + REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + REWRITE_TAC[REAL_ARITH `x - (x - &1) = &1`] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_POW_ONE; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM REAL_POW_ADD] THEN + ASM_SIMP_TAC[ARITH_RULE `m <= n ==> (m + (n - m) = n:num)`] THEN + MP_TAC(SPECL [`a:num`; `m:num`] XY_POWER_NEG) THEN + MP_TAC(SPECL [`a:num`; `n:num`] XY_POWER_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH + `(a - b * s) * (c + d * s) = (a * c - (s * s) * b * d) + + (a * d - b * c) * s`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE_1; + REAL_OF_NUM_LE; ARITH_RULE `~(a = 0) ==> 1 <= a`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a + b * s = (x1 - x2) + (y1 - y2) * s) = + ((a + x2) + (b + y2) * s = x1 + y1 * s)`] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_LINEAR_EQ; + ARITH_RULE `~(a = 0) /\ ~(a = 1) ==> 2 <= a`] THEN + DISCH_THEN(CONJUNCTS_THEN(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* Some stronger monotonicity theorems for Y. *) +(* ------------------------------------------------------------------------- *) + +let Y_INCREASES_SUC = prove + (`!a n. ~(a = 0) ==> Y a n < Y a (SUC n)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ADD1; ADDITION_FORMULA_POS] THEN + REWRITE_TAC[X_CLAUSES; Y_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE `1 * y <= ay /\ ~(x = 0) ==> y < x * 1 + ay`) THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + MATCH_MP_TAC(ARITH_RULE + `!n. (n = 1) /\ n <= m ==> ~(m = 0)`) THEN + EXISTS_TAC `X a 0` THEN CONJ_TAC THENL + [REWRITE_TAC[X_CLAUSES]; ALL_TAC] THEN + SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN + REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[LE_TRANS; X_INCREASES]);; + +let Y_INCREASES_LT = prove + (`!a m n. ~(a = 0) /\ m < n ==> Y a m < Y a n`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [LT_EXISTS] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN DISCH_TAC THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `Y a (SUC m)` THEN + ASM_SIMP_TAC[Y_INCREASES_SUC] THEN + REWRITE_TAC[ARITH_RULE `m + SUC d = SUC m + d`] THEN + SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN + ASM_MESON_TAC[ADD1; LE_TRANS; Y_INCREASES]);; + +let Y_INCREASES_LE = prove + (`!a m n. ~(a = 0) /\ m <= n ==> Y a m <= Y a n`, + REWRITE_TAC[LE_LT] THEN MESON_TAC[LE_REFL; Y_INCREASES_LT]);; + +let Y_INJ = prove + (`!a m n. ~(a = 0) ==> ((Y a m = Y a n) <=> (m = n))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + MP_TAC(SPEC `a:num` Y_INCREASES_LT) THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[LT_CASES; LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* One for X (to get the same as Y, need a /= 1). *) +(* ------------------------------------------------------------------------- *) + +let X_INCREASES_LE = prove + (`!a m n. ~(a = 0) /\ m <= n ==> X a m <= X a n`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN + DISCH_THEN(K ALL_TAC) THEN SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN + REWRITE_TAC[ADD1] THEN ASM_MESON_TAC[LE_TRANS; X_INCREASES]);; + +let X_INCREASES_LT = prove + (`!a m n. ~(a = 0) /\ ~(a = 1) /\ m < n ==> X a m < X a n`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LE_SUC_LT] THEN + STRIP_TAC THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `X a (SUC m)` THEN + ASM_SIMP_TAC[X_INCREASES_LE] THEN + SPEC_TAC(`m:num`,`p:num`) THEN + INDUCT_TAC THEN ASM_SIMP_TAC[ARITH; X_CLAUSES; ARITH_RULE + `~(a = 0) /\ ~(a = 1) ==> 1 < a`] THEN + REWRITE_TAC[ARITH_RULE `SUC(SUC p) = p + 2`] THEN + REWRITE_TAC[X_CLAUSES; ADD1] THEN + MATCH_MP_TAC(ARITH_RULE `a <= b /\ c < b ==> a < 2 * b - c`) THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `X a (SUC p)` THEN + ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[LE_MULT_RCANCEL; ADD1] THEN DISJ1_TAC THEN + MAP_EVERY UNDISCH_TAC [`~(a = 0)`; `~(a = 1)`] THEN ARITH_TAC);; + +let X_INCREASES_SUC = prove + (`!a n. ~(a = 0) /\ ~(a = 1) ==> X a n < X a (SUC n)`, + SIMP_TAC[X_INCREASES_LT; LT]);; + +let X_INJ = prove + (`!a m n. ~(a = 0) /\ ~(a = 1) ==> ((X a m = X a n) <=> (m = n))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + MP_TAC(SPEC `a:num` X_INCREASES_LT) THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[LT_CASES; LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Coprimality of "X a n" and "Y a n". *) +(* ------------------------------------------------------------------------- *) + +let XY_COPRIME = prove + (`!a n. ~(a = 0) ==> coprime(X a n,Y a n)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP XY_ARE_SOLUTIONS) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + REWRITE_TAC[coprime; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[NOT_IMP] THEN + REWRITE_TAC[divides] THEN STRIP_TAC THEN ASM_REWRITE_TAC[EXP_2] THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV o LAND_CONV) + [AC MULT_AC `a * d * x * d * x = d * d * a * x * x:num`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a = b + 1) ==> (a - b = 1)`)) THEN + ASM_REWRITE_TAC[GSYM LEFT_SUB_DISTRIB; MULT_EQ_1]);; + +(* ------------------------------------------------------------------------- *) +(* Divisibility properties. *) +(* ------------------------------------------------------------------------- *) + +let Y_DIVIDES_LEMMA = prove + (`!a k n. ~(a = 0) ==> (Y a n) divides (Y a (n * k))`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[Y_CLAUSES; DIVIDES_0] THEN + ASM_SIMP_TAC[ADDITION_FORMULA_POS] THEN + UNDISCH_TAC `Y a n divides Y a (n * k)` THEN + SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:num` THEN DISCH_TAC THEN + EXISTS_TAC `X a n * d + X a (n * k)` THEN + REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC; ADD_AC]);; + +let Y_DIVIDES = prove + (`!a m n. ~(a = 0) ==> ((Y a m) divides (Y a n) <=> m divides n)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + GEN_REWRITE_TAC LAND_CONV [divides] THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; Y_DIVIDES_LEMMA]] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THEN + ASM_CASES_TAC `m = 0` THENL + [ASM_REWRITE_TAC[Y_CLAUSES; DIVIDES_ZERO] THEN + MATCH_MP_TAC(ARITH_RULE + `!n. (n = 1) /\ n <= m ==> ~(m = 0)`) THEN + EXISTS_TAC `Y a 1` THEN CONJ_TAC THENL + [REWRITE_TAC[Y_CLAUSES]; ALL_TAC] THEN + ASM_SIMP_TAC[Y_INCREASES_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`]; + ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `q = n DIV m` THEN ABBREV_TAC `r = n MOD m` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `r = 0` THEN + ASM_SIMP_TAC[ADD_CLAUSES; DIVIDES_LMUL; DIVIDES_REFL] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[ADDITION_FORMULA_POS] THEN + SUBGOAL_THEN `~((Y a m) divides (X a (q * m) * Y a r))` MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN DISCH_TAC THEN + MATCH_MP_TAC DIVIDES_ADD_REVL THEN + EXISTS_TAC `X a r * Y a (q * m)` THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [MULT_SYM] THEN + ASM_SIMP_TAC[DIVIDES_LMUL; Y_DIVIDES_LEMMA]] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] COPRIME_DIVPROD)) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`a:num`; `q * m:num`] XY_COPRIME) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + REWRITE_TAC[coprime; NOT_FORALL_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_MESON_TAC[DIVIDES_TRANS; Y_DIVIDES_LEMMA]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_SIMP_TAC[DE_MORGAN_THM; NOT_LE; Y_INCREASES_LT] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 Y_CLAUSES)] THEN ASM_SIMP_TAC[Y_INJ]);; + +(* ------------------------------------------------------------------------- *) +(* This lemma would be trivial from binomial theorem. *) +(* ------------------------------------------------------------------------- *) + +let BINOMIAL_TRIVIALITY = prove + (`!x y d n. ?p q. + (&x + &y * sqrt(&d)) pow (n + 2) = + &x pow (n + 2) + + &(n + 2) * &x pow (n + 1) * &y * sqrt(&d) + + &(((n + 1) * (n + 2)) DIV 2) * &x pow n * &y pow 2 * &d + + &p * &y pow 3 + &q * &y pow 3 * sqrt(&d)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REPEAT(EXISTS_TAC `0`) THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_1; real_pow; REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL_POW_2] THEN + REWRITE_TAC[REAL_ARITH + `(x + y) * (x + y) = x * x + &2 * x * y + y * y`] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (a * b) = (a * a) * b * b`] THEN + SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_POS]; ALL_TAC] THEN + GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o TOP_DEPTH_CONV) + [ADD_CLAUSES; real_pow] THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `q:num` SUBST1_TAC)) THEN + REWRITE_TAC[REAL_ARITH + `(x + y) * (xn + xn1 + xn2 + p + q) = + (x * xn) + (x * xn1 + y * xn) + (x * xn2 + y * xn1) + + (y * xn2 + p * x + q * y) + (p * y + q * x)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `x * n2 * xn1 * y * d + (y * d) * xn2 = (n2 * x * xn1 + xn2) * y * d`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + REWRITE_TAC[ARITH_RULE `SUC(n + m) = n + SUC m`] THEN + REWRITE_TAC[ARITH_RULE `SUC n + m = n + SUC m`] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&n * x + x = (&n + &1) * x`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; ARITH_RULE `(n + 2) + 1 = n + 3`] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; GSYM REAL_MUL_ASSOC; REAL_EQ_LADD] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `x * n12 * xn * y2 * d + y * s * n2 * xn1 * y * s + a = + (n12 * (x * xn) * y2 * d + n2 * xn1 * (y * y) * (s * s)) + a`] THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM(CONJUNCT2 real_pow)] THEN + SIMP_TAC[SQRT_POW_2; REAL_POS] THEN + REWRITE_TAC[ADD1; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN + SUBGOAL_THEN `&(((n + 1) * (n + 2)) DIV 2) + &(n + 2) = + &(((n + 2) * (n + 3)) DIV 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIV_UNIQ THEN + EXISTS_TAC `0` THEN REWRITE_TAC[ARITH; ADD_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `(n + 2) * (n + 3) = n * n + 5 * n + 6`] THEN + REWRITE_TAC[ARITH_RULE + `(x + 5 * n + 6 = (y + n + 2) * 2) <=> (x + 3 * n + 2 = 2 * y)`] THEN + REWRITE_TAC[ARITH_RULE `n * n + 3 * n + 2 = (n + 1) * (n + 2)`] THEN + SUBGOAL_THEN `EVEN((n + 1) * (n + 2))` MP_TAC THENL + [REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH_EVEN] THEN + CONV_TAC(EQT_INTRO o TAUT); ALL_TAC] THEN + SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ]; ALL_TAC] THEN + REWRITE_TAC[REAL_EQ_LADD] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `q * y3 * s * y * s = q * y * y3 * s * s`] THEN + SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_POS] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `y * s * nn * xn * y2 * d = nn * d * xn * (y * y2) * s`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + EXISTS_TAC `p * x + q * y * d:num` THEN REWRITE_TAC[ARITH_SUC] THEN + EXISTS_TAC `((n + 1) * (n + 2)) DIV 2 * d * x EXP n + + p * y + q * x` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_AC] THEN REWRITE_TAC[REAL_ADD_AC]);; + +(* ------------------------------------------------------------------------- *) +(* A lower bound theorem. *) +(* ------------------------------------------------------------------------- *) + +let Y_LOWERBOUND = prove + (`!a n. (2 * a - 1) EXP n <= Y a (n + 1)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH; Y_CLAUSES] THEN + ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[ARITH; MULT_CLAUSES; LE_0] THEN + REWRITE_TAC[ARITH_RULE `SUC n + 1 = n + 2`; Y_CLAUSES] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(2 * a - 1) * Y a (n + 1)` THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB; MULT_CLAUSES; GSYM MULT_ASSOC] THEN + MATCH_MP_TAC(ARITH_RULE `a <= b ==> c - b <= c - a:num`) THEN + ASM_SIMP_TAC[Y_INCREASES]);; + +let Y_UPPERBOUND = prove + (`!a n. Y a (n + 1) <= (2 * a) EXP n`, + GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; ADD_CLAUSES; Y_CLAUSES; LE_REFL] THEN + REWRITE_TAC[ARITH_RULE `SUC(n + 1) = n + 2`; Y_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE `a <= b ==> a - c <= b:num`) THEN + ASM_REWRITE_TAC[MULT_ASSOC; LE_MULT_LCANCEL]);; + +(* ------------------------------------------------------------------------- *) +(* Now a key congruence. *) +(* ------------------------------------------------------------------------- *) + +let XY_Y3_CONGRUENCE = prove + (`!a n k. ~(a = 0) + ==> ?q. Y a (n * k) = + k * (X a n) EXP (k - 1) * Y a n + q * (Y a n) EXP 3`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `k = 0` THENL + [EXISTS_TAC `0` THEN + ASM_REWRITE_TAC[Y_CLAUSES; MULT_CLAUSES; ADD_CLAUSES; SUB_0]; ALL_TAC] THEN + ASM_CASES_TAC `a = 1` THENL + [ASM_REWRITE_TAC[X_DEGENERATE; Y_DEGENERATE; EXP_ONE] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC]; ALL_TAC] THEN + ASM_CASES_TAC `k = 1` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; SUB_REFL; EXP] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `n * k:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + MP_TAC(SPECL [`a:num`; `n:num`] XY_POWER_POS) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN `2 <= k` MP_TAC THENL + [MAP_EVERY UNDISCH_TAC [`~(k = 0)`; `~(k = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` + (SUBST1_TAC o ONCE_REWRITE_RULE[ADD_SYM])) THEN + MP_TAC(SPECL [`X a n`; `Y a n`; `a EXP 2 - 1`; `d:num`] + BINOMIAL_TRIVIALITY) THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` (X_CHOOSE_THEN `q:num` SUBST1_TAC)) THEN + ONCE_REWRITE_TAC[REAL_ARITH + `x1 + y1 + x2 + x3 + y2 = (x1 + x2 + x3) + (y1 + y2)`] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&a pow 2 - &1 = &(a EXP 2 - 1)` (SUBST1_TAC o SYM) THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN MATCH_MP_TAC REAL_OF_NUM_SUB THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_POW_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(a = 0) ==> 1 <= a`]; ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_LINEAR_EQ; + ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 2 <= p`] THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `(d + 2) - 1 = d + 1`] THEN + EXISTS_TAC `q:num` THEN REWRITE_TAC[GSYM MULT_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* The other key divisibility result. *) +(* ------------------------------------------------------------------------- *) + +let Y2_DIVIDES = prove + (`!a m n. ~(a = 0) + ==> (((Y a m) EXP 2) divides (Y a n) <=> (m * Y a m) divides n)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = 0` THENL + [ASM_REWRITE_TAC[Y_CLAUSES; MULT_CLAUSES; DIVIDES_ZERO; EXP_2] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM(CONJUNCT1 Y_CLAUSES)] THEN + ASM_SIMP_TAC[Y_INJ]; ALL_TAC] THEN + SUBGOAL_THEN `~(Y a m = 0)` ASSUME_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM(CONJUNCT1 Y_CLAUSES)] THEN + ASM_SIMP_TAC[Y_INJ]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT + `!c. (a ==> c) /\ (b ==> c) /\ (c ==> (a <=> b)) ==> (a <=> b)`) THEN + EXISTS_TAC `m divides n` THEN REPEAT CONJ_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `(Y a m) divides (Y a n)` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[Y_DIVIDES]] THEN + UNDISCH_TAC `((Y a m) EXP 2) divides (Y a n)` THEN + REWRITE_TAC[divides; EXP_2; GSYM MULT_ASSOC] THEN MESON_TAC[]; + REWRITE_TAC[divides; GSYM MULT_ASSOC] THEN MESON_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [divides] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + MP_TAC(SPECL [`a:num`; `m:num`; `k:num`] XY_Y3_CONGRUENCE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `((Y a m) EXP 2) divides (k * (X a m) EXP (k - 1) * Y a m)` THEN + CONJ_TAC THENL + [REWRITE_TAC[num_CONV `3`; EXP] THEN + MESON_TAC[DIVIDES_ADD; DIVIDES_ADD_REVL; DIVIDES_LMUL; DIVIDES_REFL]; + ALL_TAC] THEN + REWRITE_TAC[MULT_ASSOC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MULT_SYM] THEN + REWRITE_TAC[EXP_2; GSYM MULT_ASSOC] THEN + ASM_SIMP_TAC[DIVIDES_LMUL2_EQ] THEN + EQ_TAC THEN SIMP_TAC[DIVIDES_RMUL] THEN + DISCH_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN + EXISTS_TAC `X a m EXP (k - 1)` THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COPRIME_EXP THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[XY_COPRIME]);; + +(* ------------------------------------------------------------------------- *) +(* Some more congruences. *) +(* ------------------------------------------------------------------------- *) + +let Y_N_MOD2 = prove + (`!a n. ~(a = 0) ==> ?q. Y a n = 2 * q + n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[Y_CLAUSES] THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP Y_INCREASES) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `2 * q1 + n <= 2 * q2 + n + 1 <=> q1 <= q2`] THEN + DISCH_TAC THEN + EXISTS_TAC `(2 * a * q2 - q1) + (a - 1) * (n + 1)` THEN + MATCH_MP_TAC(ARITH_RULE + `v <= u /\ y <= x /\ (2 * (x + z) + w + v = 2 * y + u) + ==> (u - v = 2 * ((x - y) + z) + w)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[LEFT_ADD_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `x <= u /\ y <= v ==> 2 * x + y <= 2 * u + v + w`) THEN + REWRITE_TAC[MULT_ASSOC] THEN CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THENL + [MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC] THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; + REWRITE_TAC[MULT_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN + MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; + UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`a:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[ARITH_RULE `SUC a - 1 = a`] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + ARITH_TAC]);; + +let Y_N_MODA1 = prove + (`!a n. ~(a = 0) ==> ?q. Y a n = q * (a - 1) + n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + ASM_CASES_TAC `a = 1` THENL + [ASM_REWRITE_TAC[SUB_REFL; Y_DEGENERATE; MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[Y_CLAUSES] THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP Y_INCREASES) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `q1 + n <= q2 + n + 1 <=> q1 <= q2 + 1`] THEN + ASM_CASES_TAC `q2 = 0` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `a <= 1 <=> (a = 0) \/ (a = 1)`] THEN + ASM_REWRITE_TAC[MULT_EQ_0; MULT_EQ_1] THEN + ASM_REWRITE_TAC[ARITH_RULE `(a - 1 = 0) <=> (a = 0) \/ (a = 1)`] THEN + SIMP_TAC[ARITH_RULE `(a - 1 = 1) <=> (a = 2)`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THENL + [EXISTS_TAC `2 * (n + 1)` THEN + UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`b:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[ARITH_RULE `SUC n - 1 = n`] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE `(a + c = b) ==> (b - a = c:num)`) THEN + ARITH_TAC; + REWRITE_TAC[MULT_ASSOC; ARITH] THEN + REWRITE_TAC[ARITH_RULE `4 * (n + 1) - (1 + n) = 3 * (n + 1)`] THEN + EXISTS_TAC `2 * n + 1` THEN ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + EXISTS_TAC `2 * (n + 1) + 2 * a * q2 - q1` THEN MP_TAC th) THEN + UNDISCH_TAC `~(a = 1)` THEN + UNDISCH_TAC `~(a = 0)` THEN SPEC_TAC(`a:num`,`b:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[ARITH_RULE `(SUC n = 1) <=> (n = 0)`] THEN DISCH_TAC THEN + REWRITE_TAC[ARITH_RULE `SUC n - 1 = n`] THEN DISCH_TAC THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; RIGHT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `v <= u /\ y <= x /\ (u + y = z + x + w + v) + ==> (u - v = (z + (x - y)) + w:num)`) THEN + REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[MULT_ASSOC] THEN MATCH_MP_TAC LE_MULT2 THEN + ASM_REWRITE_TAC[ARITH_RULE `q1 + n <= q2 + n + 1 <=> q1 <= q2 + 1`] THEN + REWRITE_TAC[MULT_CLAUSES] THEN ARITH_TAC; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `q2 * b + 1` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `a + 1 <= b <=> a < b`] THEN + ASM_SIMP_TAC[LT_MULT_RCANCEL] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[MULT_ASSOC] THEN + ASM_SIMP_TAC[LT_MULT_RCANCEL] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ARITH_TAC; + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN ARITH_TAC]);; + +let X_CONGRUENT = prove + (`!a b c n. ~(a = 0) ==> ?q. X (a + b * c) n = X a n + q * c`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + ASM_CASES_TAC `b * c = 0` THENL + [GEN_TAC THEN EXISTS_TAC `0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN + UNDISCH_TAC `~(b * c = 0)` THEN + REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[X_CLAUSES] THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + EXISTS_TAC `b:num` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE + `2 * (x + y) * (u + v) = 2 * x * u + 2 * u * y + 2 * (x + y) * v`] THEN + EXISTS_TAC `(2 * X a (n + 1) * b + 2 * (a + b * c) * q2) - q1` THEN + MATCH_MP_TAC(ARITH_RULE + `a <= x /\ b <= y + z:num /\ ((x - a) + ((y + z) - b) = u) + ==> ((x + y + z) - (a + b) = u)`) THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB; RIGHT_ADD_DISTRIB; GSYM MULT_ASSOC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `1 * X a (n + 1)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MULT_CLAUSES; X_INCREASES]; ALL_TAC] THEN + REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `X (a + b * c) n` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `X (a + b * c) (n + 1)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[X_INCREASES; ADD_EQ_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN + REWRITE_TAC[GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]; + MATCH_MP_TAC(ARITH_RULE `a <= y ==> a <= 2 * (x + y)`) THEN + ONCE_REWRITE_TAC[AC MULT_AC `a * b * c * d = (a * b) * (c * d:num)`] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]]);; + +let Y_CONGRUENT = prove + (`!a b c n. ~(a = 0) ==> ?q. Y (a + b * c) n = Y a n + q * c`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + ASM_CASES_TAC `b * c = 0` THENL + [GEN_TAC THEN EXISTS_TAC `0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN + UNDISCH_TAC `~(b * c = 0)` THEN + REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC PELL_INDUCTION THEN REWRITE_TAC[Y_CLAUSES] THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `q1:num`; `q2:num`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE + `2 * (x + y) * (u + v) = 2 * x * u + 2 * u * y + 2 * (x + y) * v`] THEN + EXISTS_TAC `(2 * Y a (n + 1) * b + 2 * (a + b * c) * q2) - q1` THEN + MATCH_MP_TAC(ARITH_RULE + `a <= x /\ b <= y + z:num /\ ((x - a) + ((y + z) - b) = u) + ==> ((x + y + z) - (a + b) = u)`) THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB; RIGHT_ADD_DISTRIB; GSYM MULT_ASSOC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `1 * Y a (n + 1)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MULT_CLAUSES; Y_INCREASES]; ALL_TAC] THEN + REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `Y (a + b * c) n` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `Y (a + b * c) (n + 1)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[Y_INCREASES; ADD_EQ_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN + REWRITE_TAC[GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]; + MATCH_MP_TAC(ARITH_RULE `a <= y ==> a <= 2 * (x + y)`) THEN + ONCE_REWRITE_TAC[AC MULT_AC `a * b * c * d = (a * b) * (c * d:num)`] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; MULT_EQ_0; ARITH_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* A more important congruence. *) +(* ------------------------------------------------------------------------- *) + +let X_CONGRUENT_2NJ_POS = prove + (`!a n j. ~(a = 0) ==> ?q. X a (2 * n + j) + X a j = q * X a n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `n:num`; `n + j:num`] ADDITION_FORMULA_POS) THEN + ASM_REWRITE_TAC[ARITH_RULE `n + n + j = 2 * n + j`] THEN + DISCH_THEN(SUBST1_TAC o CONJUNCT1) THEN + MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] ADDITION_FORMULA_POS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN + ONCE_REWRITE_TAC[ARITH_RULE + `(xn * a + d * yn * (xn * yj + xj * yn)) + xj = + xn * (a + d * yn * yj) + xj * (d * yn * yn + 1)`] THEN + ASM_SIMP_TAC[GSYM XY_ARE_SOLUTIONS; GSYM EXP_2] THEN + REWRITE_TAC[EXP_2; ARITH_RULE + `xn * a + xj * xn * xn = (a + xj * xn) * xn:num`] THEN + MESON_TAC[]);; + +let X_CONGRUENT_4NJ_POS = prove + (`!a n j. ~(a = 0) ==> ?q. X a (4 * n + j) = q * X a n + X a j`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `n:num`; `2 * n + j`] X_CONGRUENT_2NJ_POS) THEN + ASM_REWRITE_TAC[ARITH_RULE `2 * n + 2 * n + j = 4 * n + j`] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o C AP_THM `X a j` o AP_TERM `(+):num->num->num`) THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] X_CONGRUENT_2NJ_POS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `q2:num` MP_TAC) THEN + DISCH_THEN SUBST1_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(y + q2 = q1 + x) ==> x <= y ==> (y = (q1 - q2) + x:num)`)) THEN + ASM_SIMP_TAC[X_INCREASES_LE; ARITH_RULE `j <= 4 * n + j`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN + MESON_TAC[]);; + +let X_CONGRUENT_4MNJ_POS = prove + (`!a m n j. ~(a = 0) ==> ?q. X a (4 * m * n + j) = q * X a n + X a j`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THENL + [REPEAT GEN_TAC THEN EXISTS_TAC `0` THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; ALL_TAC] THEN + UNDISCH_TAC `!n j. ?q. X a (4 * m * n + j) = q * X a n + X a j` THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` ASSUME_TAC) THEN + MP_TAC(SPECL [`a:num`; `n:num`; `4 * m * n + j`] X_CONGRUENT_4NJ_POS) THEN + ASM_REWRITE_TAC[ARITH_RULE + `4 * (m * n + n) + j = 4 * n + 4 * m * n + j`] THEN + DISCH_THEN(X_CHOOSE_THEN `q2:num` SUBST1_TAC) THEN + EXISTS_TAC `q2 + q1:num` THEN ARITH_TAC);; + +let X_CONGRUENT_2NJ_NEG_LEMMA = prove + (`!a n j. ~(a = 0) /\ j <= n ==> ?q. X a (2 * n - j) + X a j = q * X a n`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `j = n:num` THENL + [EXISTS_TAC `2` THEN ASM_REWRITE_TAC[MULT_2; ADD_SUB]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `n:num`; `n - j:num`] ADDITION_FORMULA_POS) THEN + ASM_SIMP_TAC[ARITH_RULE `j <= n ==> (n + n - j = 2 * n - j)`] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `j:num`; `n:num`] ADDITION_FORMULA_NEG) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(X a j * X a n - (a EXP 2 - 1) * Y a j * Y a n) + + (X a j * X a n - (a EXP 2 - 1) * Y a j * Y a n)` THEN + REWRITE_TAC[ARITH_RULE + `((xn * a + b) + c = (a + d) * xn) <=> (b + c = xn * d:num)`] THEN + REWRITE_TAC[LEFT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `b <= a /\ e <= d /\ (e + a + c = d + b) + ==> ((a - b) + c = d - e:num)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[LE_MULT_LCANCEL] THEN REPEAT DISJ2_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `(c = a - b) ==> 1 <= c ==> b <= a`)) THEN + SUBST1_TAC(SYM(SPEC `a:num` (el 1 (CONJUNCTS Y_CLAUSES)))) THEN + MATCH_MP_TAC Y_INCREASES_LE THEN + ASM_SIMP_TAC[ARITH_RULE `j <= n ==> (1 <= n - j <=> ~(j = n))`]; + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `(c = a - b) ==> 1 <= c ==> b <= a`)) THEN + SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 X_CLAUSES))) THEN + MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[LE_0]; + REWRITE_TAC[ARITH_RULE + `xn * a * yj * yn + a * yn * xj * yn + xj = + xj * (a * yn * yn + 1) + a * yn * xn * yj`] THEN + ASM_SIMP_TAC[GSYM XY_ARE_SOLUTIONS; GSYM EXP_2] THEN + REWRITE_TAC[EXP_2; MULT_AC]]);; + +let X_CONGRUENT_2NJ_NEG = prove + (`!a n j. ~(a = 0) /\ j <= 2 * n ==> ?q. X a (2 * n - j) + X a j = q * X a n`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `j <= n:num` THEN ASM_SIMP_TAC[X_CONGRUENT_2NJ_NEG_LEMMA] THEN + MP_TAC(SPECL [`a:num`; `n:num`; `2 * n - j`] X_CONGRUENT_2NJ_NEG_LEMMA) THEN + ASM_SIMP_TAC[ARITH_RULE `~(j <= n) ==> 2 * n - j <= n`] THEN + ASM_SIMP_TAC[ARITH_RULE `y <= x ==> (x - (x - y) = y:num)`] THEN + SIMP_TAC[ADD_AC]);; + +(* ------------------------------------------------------------------------- *) +(* The cute GCD fact given by Smorynski. *) +(* ------------------------------------------------------------------------- *) + +let XY_GCD_LEMMA = prove + (`!a m n. ~(a = 0) /\ m < n + ==> (gcd(Y a m,Y a n) = Y a (gcd(m,n)))`, + GEN_TAC THEN ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `a = 1` THEN ASM_REWRITE_TAC[Y_DEGENERATE] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES; GCD_0] THEN + ABBREV_TAC `q = n DIV m` THEN ABBREV_TAC `r = n MOD m` THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `r:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [EXPAND_TAC "n" THEN ASM_SIMP_TAC[ADDITION_FORMULA_POS] THEN + GEN_REWRITE_TAC LAND_CONV [GCD_SYM] THEN MATCH_MP_TAC GCD_EQ THEN + X_GEN_TAC `d:num` THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC(TAUT + `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `d divides (X a (q * m) * Y a r)` THEN CONJ_TAC THENL + [SUBGOAL_THEN `d divides (Y a (q * m))` MP_TAC THENL + [ASM_MESON_TAC[Y_DIVIDES; DIVIDES_TRANS; DIVIDES_LMUL; DIVIDES_REFL]; + ALL_TAC] THEN + MESON_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL; + DIVIDES_ADD_REVL]; + ALL_TAC] THEN + EQ_TAC THEN SIMP_TAC[DIVIDES_LMUL] THEN + SUBGOAL_THEN `coprime(d,X a (q * m))` + (fun th -> MESON_TAC[COPRIME_DIVPROD; th]) THEN + SUBGOAL_THEN `d divides (Y a (q * m))` MP_TAC THENL + [ASM_MESON_TAC[Y_DIVIDES; DIVIDES_TRANS; DIVIDES_LMUL; DIVIDES_REFL]; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `q * m:num`] XY_COPRIME) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[coprime] THEN + X_GEN_TAC `e:num` THEN STRIP_TAC THEN + UNDISCH_TAC `coprime (X a (q * m),Y a (q * m))` THEN + REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `e:num`) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[DIVIDES_TRANS]; + AP_TERM_TAC THEN EXPAND_TAC "n" THEN + GEN_REWRITE_TAC I [GSYM DIVIDES_ANTISYM] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN NUMBER_TAC]);; + +let XY_GCD = prove + (`!a m n. ~(a = 0) ==> (gcd(Y a m,Y a n) = Y a (gcd(m,n)))`, + REPEAT STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`m:num`; `n:num`] LT_CASES) + THENL + [ASM_SIMP_TAC[XY_GCD_LEMMA]; + ONCE_REWRITE_TAC[GCD_SYM] THEN ASM_SIMP_TAC[XY_GCD_LEMMA]; + ASM_REWRITE_TAC[GCD_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* The "step-down" lemma. *) +(* ------------------------------------------------------------------------- *) + +let STEP_DOWN_LEMMA = prove + (`!a i j n q. + ~(a = 0) /\ ~(a = 1) /\ + i <= j /\ j <= 2 * n /\ + (X a j = q * X a n + X a i) + ==> (i = j) \/ ((a = 2) /\ (n = 1) /\ (i = 0) /\ (j = 2))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `j <= n:num` THENL + [ASM_CASES_TAC `i = j:num` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `i < n:num` ASSUME_TAC THENL + [ASM_MESON_TAC[LTE_TRANS; LT_LE]; ALL_TAC] THEN + UNDISCH_TAC `X a j = q * X a n + X a i` THEN + ASM_CASES_TAC `q = 0` THEN + ASM_SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; X_INJ] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`a:num`; `j:num`; `n:num`] X_INCREASES_LE) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + MATCH_MP_TAC(ARITH_RULE `1 <= b /\ 1 * x <= qx ==> ~(qx + b <= x)`) THEN + SIMP_TAC[LE_MULT_RCANCEL] THEN + ASM_SIMP_TAC[ARITH_RULE `~(x = 0) ==> 1 <= x`] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN + ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN + ASM_CASES_TAC `n = 0` THENL + [UNDISCH_TAC `i <= j:num` THEN UNDISCH_TAC `j <= 2 * n` THEN + ASM_SIMP_TAC[LE; MULT_CLAUSES]; ALL_TAC] THEN + ASM_CASES_TAC `i <= n:num` THENL + [MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] X_CONGRUENT_2NJ_NEG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN + UNDISCH_TAC `X a j = q * X a n + X a i` THEN + ASM_CASES_TAC `q = 0` THEN + ASM_SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; X_INJ] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a + b + c = d:num) ==> (a + c = d - b)`)) THEN + REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN + ASM_CASES_TAC `i = n:num` THENL + [ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + n = q * n) ==> (x = q * n - 1 * n)`)) THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN + ASM_CASES_TAC `q1 - q - 1 = 0` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN + ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE + `j < n /\ 1 * n <= a * n ==> ~(j = a * n)`) THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `~(x = 0) ==> 1 <= x`] THEN + MATCH_MP_TAC X_INCREASES_LT THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(j <= n:num)` THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `q1 - q = 0` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0] THEN + MATCH_MP_TAC(TAUT `~c ==> a /\ c ==> b`) THEN + REWRITE_TAC[ARITH_RULE `~(n = 0) <=> 1 <= n`] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN + ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(~b ==> a ==> c) ==> a ==> b \/ c`) THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 1` THENL + [UNDISCH_TAC `j <= 2 * n` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + UNDISCH_TAC `~(j <= n:num)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `~(j <= 1) /\ j <= 2 ==> (j = 2)`)) THEN + DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[] THEN + UNDISCH_THEN `n = 1` SUBST_ALL_TAC THEN + SUBGOAL_THEN `i = 0` SUBST_ALL_TAC THENL + [MAP_EVERY UNDISCH_TAC [`i <= 1`; `~(i = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `X a (2 * 1 - 2) + X a 0 = (q1 - q) * X a 1` THEN + REWRITE_TAC[ARITH; X_CLAUSES] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + MATCH_MP_TAC(ARITH_RULE + `~(a = 0) /\ ~(a = 1) /\ a <= 2 ==> (a = 2)`) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_THEN `(q1 - q) * a = 2` (SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_SIMP_TAC[ARITH_RULE `~(q = 0) ==> 1 <= q`]; ALL_TAC] THEN + UNDISCH_TAC `X a (2 * n - j) + X a i = (q1 - q) * X a n` THEN + MATCH_MP_TAC(TAUT `~b ==> b ==> a`) THEN + MATCH_MP_TAC(ARITH_RULE + `s < x /\ x <= q * x ==> ~(s = q * x:num)`) THEN + CONJ_TAC THENL + [ALL_TAC; + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + ASM_SIMP_TAC[ARITH_RULE `~(q = 0) ==> 1 <= q`]] THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `2 * X a (n - 1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `a <= c /\ b <= c ==> a + b <= 2 * c`) THEN + CONJ_TAC THEN MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(j <= n:num)` THEN ARITH_TAC; + UNDISCH_TAC `~(i = n:num)` THEN UNDISCH_TAC `i <= n:num` THEN + ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `n - 1 = (n - 2) + 1` SUBST1_TAC THENL + [UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(n = 1)` THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n = (n - 2) + 2` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(n = 1)` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[X_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE `z < x /\ 3 * x <= y ==> 2 * x < y - z`) THEN + ASM_SIMP_TAC[X_INCREASES_LT; ARITH_RULE `n < n + 1`] THEN + REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + UNDISCH_TAC `~(a = 1)` THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `n:num`; `j:num`] X_CONGRUENT_2NJ_NEG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN + MP_TAC(SPECL [`a:num`; `n:num`; `i:num`] X_CONGRUENT_2NJ_NEG) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q2:num` MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a = b) /\ (c = d) ==> (a + d = b + c:num)`)) THEN + REWRITE_TAC[ARITH_RULE + `((x + i) + q1 = q2 + y + q3 + i) <=> (x + q1 = y + q2 + q3:num)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + q1 = y + q2) ==> y <= x ==> (x = y + (q2 - q1:num))`)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `i <= j:num` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; GSYM RIGHT_SUB_DISTRIB] THEN + ASM_CASES_TAC `(q2 + q) - q1 = 0` THENL + [ASM_SIMP_TAC[ADD_CLAUSES; MULT_CLAUSES; X_INJ] THEN + MATCH_MP_TAC(TAUT `(a ==> b) ==> (a ==> b \/ c)`) THEN + UNDISCH_TAC `j <= 2 * n` THEN UNDISCH_TAC `i <= j:num` THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + MATCH_MP_TAC(ARITH_RULE + `1 * xi <= qxn /\ 1 <= xj ==> ~(xi = xj + qxn)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LE_MULT2 THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`] THEN + MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(i <= n:num)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN + MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[LE_0]);; + +let STEP_DOWN_LEMMA_4_ASYM = prove + (`!a i j n q. + ~(a = 0) /\ ~(a = 1) /\ + 0 < i /\ i <= n /\ j < 4 * n /\ + (X a i + q * X a n = X a j) + ==> (j = i) \/ (j = 4 * n - i)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `j <= 2 * n` THENL + [MP_TAC(SPECL [`a:num`; `i:num`; `j:num`; `n:num`; `q:num`] + STEP_DOWN_LEMMA) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `X a i + q * X a n = X a j` THEN + SIMP_TAC[ADD_AC; MULT_AC] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + SUBGOAL_THEN `X a i <= X a j` MP_TAC THENL + [ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + ASM_SIMP_TAC[X_INCREASES_LT; NOT_LE]; ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < i ==> ~(i = 0)`]; ALL_TAC] THEN + DISJ_CASES_TAC(SPECL [`i:num`; `4 * n - j`] LE_CASES) THEN + (MP_TAC(SPECL [`a:num`; `n:num`; `2 * n - (4 * n - j)`] + X_CONGRUENT_2NJ_POS) THEN + MP_TAC(SPECL [`a:num`; `n:num`; `4 * n - j`] X_CONGRUENT_2NJ_NEG) THEN + ASM_SIMP_TAC[ARITH_RULE `~(j <= 2 * n) ==> 4 * n - j <= 2 * n`] THEN + ASM_SIMP_TAC[ARITH_RULE + `j < 4 * n /\ ~(j <= 2 * n) + ==> (2 * n + 2 * n - (4 * n - j) = j)`] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `q2:num` MP_TAC) THEN + SUBST1_TAC(SYM(ASSUME `X a i + q * X a n = X a j`)) THEN + UNDISCH_TAC + `X a (2 * n - (4 * n - j)) + X a (4 * n - j) = q1 * X a n` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a + b = c) /\ (d + a = e) ==> (b + e = c + d:num)`))) + THENL + [DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + q1 = q2 + y + q3) + ==> y <= x ==> (x = ((q2 + q3) - q1) + y:num)`)); + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + q1 = q2 + y + q3) + ==> x <= y ==> (y = (q1 - (q2 + q3)) + x:num)`))] THEN + REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; GSYM RIGHT_ADD_DISTRIB] THEN + ASM_SIMP_TAC[X_INCREASES_LE] THEN DISCH_TAC THENL + [MP_TAC(SPECL [`a:num`; `i:num`; `4 * n - j`; `n:num`; `(q1 + q) - q2:num`] + STEP_DOWN_LEMMA) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `~(j <= 2 * n)` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < i ==> ~(i = 0)`] THEN + DISCH_TAC THEN DISJ2_TAC THEN UNDISCH_TAC `j < 4 * n` THEN ARITH_TAC; + MP_TAC(SPECL [`a:num`; `4 * n - j`; `i:num`; `n:num`; `q2:num - (q1 + q)`] + STEP_DOWN_LEMMA) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN UNDISCH_TAC `i <= n:num` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[SUB_EQ_0; GSYM NOT_LT] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + DISJ2_TAC THEN UNDISCH_TAC `j < 4 * n` THEN ARITH_TAC]);; + +let STEP_DOWN_LEMMA_4 = prove + (`!a i j n q1 q2. + ~(a = 0) /\ ~(a = 1) /\ + 0 < i /\ i <= n /\ j < 4 * n /\ + (X a i + q1 * X a n = X a j + q2 * X a n) + ==> (j = i) \/ (j = 4 * n - i)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `j < i:num` THENL + [UNDISCH_TAC `X a i + q1 * X a n = X a j + q2 * X a n` THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + q1 = y + q2) ==> y < x ==> (x = y + (q2 - q1:num))`)) THEN + ASM_SIMP_TAC[X_INCREASES_LT; GSYM RIGHT_SUB_DISTRIB] THEN + ASM_CASES_TAC `q2 - q1 = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; X_INJ]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(i = j + q * n) ==> 1 <= j /\ 1 * n <= q * n ==> ~(i <= n)`)) THEN + ASM_SIMP_TAC[X_INCREASES_LE] THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; + ARITH_RULE `~(q2 - q1 = 0) ==> 1 <= q2 - q1`] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN + ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `i:num`; `j:num`; `n:num`; `q1 - q2:num`] + STEP_DOWN_LEMMA_4_ASYM) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `(i + q1 = j + q2) /\ ~(j < i) ==> (i + q1 - q2 = j:num)`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + ASM_SIMP_TAC[NOT_LT; X_INCREASES_LE]);; + +let STEP_DOWN_LEMMA_STRONG_ASYM = prove + (`!a i j n c. + ~(a = 0) /\ ~(a = 1) /\ + 0 < i /\ i <= n /\ + (X a i + c * X a n = X a j) + ==> (?q. j = i + 4 * n * q) \/ + (?q. j + i = 4 * n * q)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`j:num`; `4 * n`] DIVISION) THEN + ABBREV_TAC `q = j DIV (4 * n)` THEN ABBREV_TAC `k = j MOD (4 * n)` THEN + ANTS_TAC THENL + [UNDISCH_TAC `0 < i` THEN UNDISCH_TAC `i <= n:num` THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + MP_TAC(SPECL [`a:num`; `q:num`; `n:num`; `k:num`] X_CONGRUENT_4MNJ_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN + SUBST1_TAC(ARITH_RULE `4 * q * n + k = q * 4 * n + k`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN + ASM_CASES_TAC `k < i:num` THENL + [UNDISCH_TAC `X a i + c * X a n = q1 * X a n + X a k` THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a + q1 = q2 + b) ==> b < a ==> (a = (q2 - q1) + b:num)`)) THEN + ASM_SIMP_TAC[X_INCREASES_LT] THEN REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN + ASM_CASES_TAC `q1 - c = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; X_INJ] THEN + DISCH_TAC THEN DISJ1_TAC THEN EXISTS_TAC `q:num` THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + REWRITE_TAC[ADD_AC; MULT_AC]; + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + MATCH_MP_TAC(ARITH_RULE + `a <= b /\ 1 <= c ==> ~(a = b + c)`) THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 1 * n`] THEN + MATCH_MP_TAC LE_MULT2 THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[X_INCREASES_LE; LT_IMP_LE]; + SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 X_CLAUSES))) THEN + ASM_SIMP_TAC[X_INCREASES_LE; LE_0]]]; + MP_TAC(SPECL [`a:num`; `i:num`; `k:num`; `n:num`; `c - q1:num`] + STEP_DOWN_LEMMA_4_ASYM) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `X a i + c * X a n = q1 * X a n + X a k` THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a + q1 = q2 + b) ==> ~(b < a) ==> (a + (q1 - q2)= b:num)`)) THEN + REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[NOT_LT] THEN + MATCH_MP_TAC X_INCREASES_LE THEN ASM_REWRITE_TAC[GSYM NOT_LT]; + ALL_TAC] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [DISJ1_TAC THEN EXISTS_TAC `q:num` THEN + UNDISCH_THEN `q * 4 * n + k = j` (SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[MULT_AC; ADD_AC]; + DISJ2_TAC THEN EXISTS_TAC `q + 1` THEN + UNDISCH_THEN `q * 4 * n + k = j` (SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE + `(a' = a) /\ i <= b ==> (a + (b - i) + i = a' + b:num)`) THEN + REWRITE_TAC[MULT_AC] THEN + UNDISCH_TAC `i <= n:num` THEN ARITH_TAC]]);; + +let STEP_DOWN_LEMMA_STRONG = prove + (`!a i j n c1 c2. + ~(a = 0) /\ ~(a = 1) /\ 0 < i /\ i <= n /\ + (X a i + c1 * X a n = X a j + c2 * X a n) + ==> (?q. j = i + 4 * n * q) \/ + (?q. j + i = 4 * n * q)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `j < i:num` THENL + [UNDISCH_TAC `X a i + c1 * X a n = X a j + c2 * X a n` THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + q1 = y + q2) ==> y < x ==> (x = y + (q2 - q1:num))`)) THEN + ASM_SIMP_TAC[X_INCREASES_LT; GSYM RIGHT_SUB_DISTRIB] THEN + ASM_CASES_TAC `c2 - c1 = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; X_INJ] THEN + DISCH_THEN(K ALL_TAC) THEN DISJ1_TAC THEN + EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(i = j + q * n) ==> 1 <= j /\ 1 * n <= q * n ==> ~(i <= n)`)) THEN + ASM_SIMP_TAC[X_INCREASES_LE] THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; + ARITH_RULE `~(q2 - q1 = 0) ==> 1 <= q2 - q1`] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 X_CLAUSES)] THEN + ASM_SIMP_TAC[X_INCREASES_LE; LE_0]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `i:num`; `j:num`; `n:num`; `c1 - c2:num`] + STEP_DOWN_LEMMA_STRONG_ASYM) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `(i + q1 = j + q2) /\ ~(j < i) ==> (i + q1 - q2 = j:num)`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + ASM_SIMP_TAC[NOT_LT; X_INCREASES_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Diophantine nature of the Y sequence. *) +(* ------------------------------------------------------------------------- *) + +let Y_DIOPH = prove + (`~(a = 0) /\ ~(a = 1) /\ ~(y = 0) + ==> ((y = Y a k) <=> + ?x u v r b p q s t c d. + 0 < r /\ + (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) /\ + (u EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1) /\ + (s EXP 2 = (b EXP 2 - 1) * t EXP 2 + 1) /\ + (v = r * y EXP 2) /\ + (b = 1 + 4 * p * y) /\ + (b = a + q * u) /\ + (s = x + c * u) /\ + (t = k + 4 * d * y) /\ + k <= y)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + MP_TAC(SPECL [`a:num`; `x:num`; `y:num`] SOLUTIONS_ARE_XY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` (STRIP_ASSUME_TAC o GSYM)) THEN + MP_TAC(SPECL [`a:num`; `u:num`; `v:num`] SOLUTIONS_ARE_XY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (STRIP_ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN `~(b = 0)` ASSUME_TAC THENL + [SUBST1_TAC(SYM(ASSUME `1 + 4 * p * y = b`)) THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN + MP_TAC(SPECL [`b:num`; `s:num`; `t:num`] SOLUTIONS_ARE_XY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (STRIP_ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN `y <= v:num` ASSUME_TAC THENL + [SUBST1_TAC(SYM(ASSUME `r * y EXP 2 = v`)) THEN REWRITE_TAC[EXP_2] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `y = 1 * y`] THEN + REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= a <=> ~(a = 0)`; MULT_EQ_0] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < r ==> ~(r = 0)`]; ALL_TAC] THEN + SUBGOAL_THEN `i <= n:num` ASSUME_TAC THENL + [UNDISCH_TAC `y <= v:num` THEN + SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN + SUBST1_TAC(SYM(ASSUME `Y a n = v`)) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + ASM_SIMP_TAC[NOT_LE; Y_INCREASES_LT]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `q:num`; `u:num`; `j:num`] X_CONGRUENT) THEN + REWRITE_TAC[ASSUME `~(a = 0)`; ASSUME `a + q * u = b:num`] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` MP_TAC) THEN + SUBST1_TAC(ASSUME `X b j = s`) THEN + SUBST1_TAC(SYM(ASSUME `x + c * u = s:num`)) THEN + SUBST1_TAC(SYM(ASSUME `X a i = x`)) THEN + SUBST1_TAC(SYM(ASSUME `X a n = u`)) THEN DISCH_TAC THEN + SUBGOAL_THEN `~(i = 0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(y = 0)` THEN + REWRITE_TAC[TAUT `~a ==> ~b <=> b ==> a`] THEN + EXPAND_TAC "y" THEN SIMP_TAC[Y_CLAUSES; ASSUME `~(a = 0)`]; + ALL_TAC] THEN + SUBGOAL_THEN `(?q. j = i + 4 * n * q) \/ (?q. j + i = 4 * n * q)` + ASSUME_TAC THENL + [MATCH_MP_TAC STEP_DOWN_LEMMA_STRONG THEN + MAP_EVERY EXISTS_TAC [`a:num`; `c:num`; `q1:num`] THEN + ASM_SIMP_TAC[ARITH_RULE `~(i = 0) ==> 0 < i`]; ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `i:num`; `n:num`] Y2_DIVIDES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `r:num`) THEN + SUBST1_TAC(SYM(ASSUME `r * y EXP 2 = v`)) THEN + REWRITE_TAC[EQT_INTRO(SPEC_ALL MULT_SYM)] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:num` (ASSUME_TAC o SYM)) THEN + UNDISCH_TAC `(?q. j = i + 4 * n * q) \/ (?q. j + i = 4 * n * q:num)` THEN + UNDISCH_THEN `(i * y) * d1 = n:num` (SUBST1_TAC o SYM) THEN DISCH_TAC THEN + SUBGOAL_THEN `(?q. j = i + q * 4 * Y a i) \/ + (?q. j + i = q * 4 * Y a i)` + MP_TAC THENL + [FIRST_ASSUM(UNDISCH_TAC o check is_disj o concl) THEN + REWRITE_TAC[OR_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:num` + (fun th -> EXISTS_TAC `i * d1 * d2:num` THEN MP_TAC th)) THEN + SUBST1_TAC(ASSUME `Y a i = y`) THEN REWRITE_TAC[MULT_AC]; + FIRST_X_ASSUM(K ALL_TAC o check (is_disj o concl)) THEN + DISCH_TAC] THEN + MP_TAC(SPECL [`b:num`; `j:num`] Y_N_MODA1) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d3:num` MP_TAC) THEN + SUBST1_TAC(SYM(ASSUME `1 + 4 * p * y = b`)) THEN REWRITE_TAC[ADD_SUB2] THEN + SUBST1_TAC(SYM(ASSUME `k + 4 * d * y = t`)) THEN DISCH_TAC THEN + SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN AP_TERM_TAC THEN + SUBGOAL_THEN `(?q1 q2. k + q1 * 4 * Y a i = i + q2 * 4 * Y a i) \/ + (?q. i + k = q * 4 * Y a i)` + MP_TAC THENL + [UNDISCH_TAC `(?q. j = i + q * 4 * Y a i) \/ + (?q. j + i = q * 4 * Y a i)` THEN + MATCH_MP_TAC(TAUT + `(a1 ==> b1) /\ (a2 ==> b2) ==> a1 \/ a2 ==> b1 \/ b2`) THEN + CONJ_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `k + 4 * d * y = d3 * 4 * p * y + j` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `d4:num` SUBST1_TAC) THEN + DISCH_THEN(fun th -> + EXISTS_TAC `d:num` THEN + EXISTS_TAC `d3 * p + d4:num` THEN MP_TAC th) THEN + SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]; + DISCH_THEN(MP_TAC o C AP_THM `i:num` o + AP_TERM `(+):num->num->num`) THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d4:num` SUBST1_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(k + q1 + i = q2) ==> (i + k = q2 - q1:num)`)) THEN + DISCH_THEN SUBST1_TAC THEN + SUBST1_TAC(SYM(ASSUME `Y a i = y`)) THEN + REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; MULT_ASSOC; + GSYM RIGHT_SUB_DISTRIB] THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + REWRITE_TAC[ARITH_RULE + `(d3 * 4 * p + d4 * 4) - 4 * x = + ((d3 * p + d4) - x) * 4`] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN + EXISTS_TAC `(d3 * p + d4) - d:num` THEN REFL_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= Y a i` ASSUME_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `i <= Y a i` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:num`; `i:num`] Y_N_MODA1) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(X_CHOOSE_THEN `q4:num` (X_CHOOSE_THEN `q5:num` MP_TAC)) THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`q4:num`; `q5:num`] LT_CASES) + THENL + [DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(k + q4 = i + q5) ==> q4 < q5:num ==> (k = i + (q5 - q4))`)) THEN + REWRITE_TAC[MULT_ASSOC; LT_MULT_RCANCEL; GSYM RIGHT_SUB_DISTRIB] THEN + ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN + UNDISCH_TAC `k <= y:num` THEN + MATCH_MP_TAC(TAUT `(a ==> ~b) ==> b ==> a ==> c`) THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(ARITH_RULE `1 * y < k * y ==> ~(i + k * y <= y)`) THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + UNDISCH_TAC `q4 < q5:num` THEN ARITH_TAC; + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(k + q4 = i + q5) ==> q5 < q4:num ==> (i = k + (q4 - q5))`)) THEN + REWRITE_TAC[MULT_ASSOC; LT_MULT_RCANCEL; GSYM RIGHT_SUB_DISTRIB] THEN + ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN + UNDISCH_TAC `i <= Y a i` THEN + MATCH_MP_TAC(TAUT `(a ==> ~b) ==> b ==> a ==> c`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(ARITH_RULE `1 * y < k * y ==> ~(i + k * y <= y)`) THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + UNDISCH_TAC `q5 < q4:num` THEN ARITH_TAC; + ASM_SIMP_TAC[EQ_ADD_RCANCEL]]; + DISCH_THEN(X_CHOOSE_THEN `q6:num` MP_TAC) THEN + ASM_CASES_TAC `q6 = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_EQ_0] THEN + UNDISCH_TAC `k <= Y a i` THEN UNDISCH_TAC `i <= Y a i` THEN + SUBST1_TAC(ASSUME `Y a i = y`) THEN + MATCH_MP_TAC(ARITH_RULE + `2 * y < ay ==> i <= y ==> k <= y ==> (i + k = ay) ==> (i = k)`) THEN + REWRITE_TAC[MULT_ASSOC; LT_MULT_RCANCEL] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(q6 = 0)` THEN ARITH_TAC]] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN ABBREV_TAC `x = X a k` THEN + SUBGOAL_THEN `x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1` (ASSUME_TAC o SYM) THENL + [MAP_EVERY EXPAND_TAC ["x"; "y"] THEN + SIMP_TAC[XY_ARE_SOLUTIONS; ASSUME `~(a = 0)`]; ALL_TAC] THEN + EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `m = 2 * k * Y a k` THEN + ABBREV_TAC `u = X a m` THEN ABBREV_TAC `v = Y a m` THEN + SUBGOAL_THEN `u EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1` (ASSUME_TAC o SYM) THENL + [MAP_EVERY EXPAND_TAC ["u"; "v"] THEN + SIMP_TAC[XY_ARE_SOLUTIONS; ASSUME `~(a = 0)`]; ALL_TAC] THEN + EXISTS_TAC `u:num` THEN EXISTS_TAC `v:num` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(y EXP 2) divides v` MP_TAC THENL + [SUBST1_TAC(SYM(ASSUME `Y a m = v`)) THEN + SUBST1_TAC(SYM(ASSUME `Y a k = y`)) THEN + SIMP_TAC[Y2_DIVIDES; ASSUME `~(a = 0)`] THEN + SUBST1_TAC(SYM(ASSUME `2 * k * Y a k = m`)) THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `2` THEN + REWRITE_TAC[MULT_AC]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` (ASSUME_TAC o SYM)) THEN + EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `r = 0` THENL + [UNDISCH_TAC `y EXP 2 * r = v` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN REWRITE_TAC[LT_REFL] THEN + UNDISCH_TAC `Y a m = v` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `m = 0` ASSUME_TAC THENL + [UNDISCH_TAC `Y a m = 0` THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 Y_CLAUSES)] THEN + SIMP_TAC[Y_INJ; ASSUME `~(a = 0)`] THEN + REWRITE_TAC[Y_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `k = 0` ASSUME_TAC THENL + [UNDISCH_TAC `2 * k * Y a k = m` THEN + REWRITE_TAC[ASSUME `m = 0`; MULT_EQ_0; ARITH_EQ] THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 Y_CLAUSES)] THEN + SIMP_TAC[Y_INJ; ASSUME `~(a = 0)`] THEN + REWRITE_TAC[Y_CLAUSES; EQ_SYM]; ALL_TAC] THEN + UNDISCH_TAC `Y a k = y` THEN ASM_REWRITE_TAC[Y_CLAUSES]; + ALL_TAC] THEN + ASM_SIMP_TAC[ARITH_RULE `~(r = 0) ==> 0 < r`] THEN + SUBGOAL_THEN `ODD(u)` ASSUME_TAC THENL + [UNDISCH_TAC `(a EXP 2 - 1) * v EXP 2 + 1 = u EXP 2` THEN + DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EXP_2; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + SUBGOAL_THEN `EVEN v` (fun th -> REWRITE_TAC[GSYM NOT_EVEN; th]) THEN + SUBST1_TAC(SYM(ASSUME `Y a m = v`)) THEN + MP_TAC(SPECL [`a:num`; `m:num`] Y_N_MOD2) THEN + SIMP_TAC[ASSUME `~(a = 0)`; LEFT_IMP_EXISTS_THM] THEN + SUBST1_TAC(SYM(ASSUME `2 * k * Y a k = m`)) THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN]; ALL_TAC] THEN + SUBGOAL_THEN `?b0 q6 q7. (b0 = 1 + q6 * 4 * y) /\ (b0 = a + q7 * u)` + MP_TAC THENL + [MATCH_MP_TAC CHINESE_REMAINDER THEN + UNDISCH_TAC `ODD u` THEN + ASM_CASES_TAC `u = 0` THEN ASM_REWRITE_TAC[ARITH_ODD] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH_EQ] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_MUL THEN + CONJ_TAC THENL + [SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN + MATCH_MP_TAC COPRIME_MUL THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`u:num`; `2`] PRIME_COPRIME) THEN REWRITE_TAC[PRIME_2] THEN + MATCH_MP_TAC(TAUT `~b /\ (a ==> d) /\ (c ==> d) + ==> a \/ b \/ c ==> d`) THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `ODD u` THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + SIMP_TAC[divides; LEFT_IMP_EXISTS_THM; ODD_MULT; ARITH_ODD]; + ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[COPRIME_1]; + REWRITE_TAC[COPRIME_SYM]]; + MP_TAC(SPECL [`a:num`; `m:num`] XY_COPRIME) THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(ASSUME `y EXP 2 * r = v`)) THEN + REWRITE_TAC[coprime; EXP_2] THEN + MESON_TAC[DIVIDES_RMUL; DIVIDES_LMUL]]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` (X_CHOOSE_THEN `p:num` + (X_CHOOSE_THEN `q:num` (STRIP_ASSUME_TAC o GSYM)))) THEN + MAP_EVERY EXISTS_TAC [`b:num`; `p:num`; `q:num`] THEN + ONCE_REWRITE_TAC[ARITH_RULE `1 + 4 * p * y = 1 + p * 4 * y`] THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `s = X b k` THEN ABBREV_TAC `t = Y b k` THEN + EXISTS_TAC `s:num` THEN EXISTS_TAC `t:num` THEN + SUBST1_TAC(ARITH_RULE `r * y EXP 2 = y EXP 2 * r`) THEN + ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(ASSUME `X b k = s`)) THEN + SUBST1_TAC(SYM(ASSUME `Y b k = t`)) THEN + SUBGOAL_THEN `~(b = 0)` ASSUME_TAC THENL + [UNDISCH_THEN `1 + p * 4 * y = b` (SUBST1_TAC o SYM) THEN + ONCE_REWRITE_TAC[TAUT `~b ==> a ==> b ==> ~a`] THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ]; ALL_TAC] THEN + SIMP_TAC[XY_ARE_SOLUTIONS; ASSUME `~(b = 0)`] THEN + MP_TAC(SPECL [`a:num`; `q:num`; `u:num`; `k:num`] X_CONGRUENT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` (ASSUME_TAC o SYM)) THEN + EXISTS_TAC `c:num` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`b:num`; `k:num`] Y_N_MODA1) THEN + SUBST1_TAC(SYM(ASSUME `1 + p * 4 * y = b`)) THEN + REWRITE_TAC[ADD_EQ_0; ADD_SUB2; ARITH_EQ] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q8:num` SUBST1_TAC) THEN + EXISTS_TAC `q8 * p:num` THEN REWRITE_TAC[MULT_AC; ADD_AC] THEN + MP_TAC(SPECL [`a:num`; `k:num`] Y_N_MODA1) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* A ratio approaches a^n for large enough k. *) +(* ------------------------------------------------------------------------- *) + +let BINOMIALISH_LEMMA = prove + (`!m n. m EXP n * (m - n) <= m * (m - 1) EXP n`, + GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; SUB_0; MULT_CLAUSES; LE_REFL] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(m - 1) * m EXP n * (m - n)` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MULT_ASSOC] THEN + ONCE_REWRITE_TAC[AC MULT_AC `a * b * c = b * a * c:num`] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + REWRITE_TAC[LEFT_SUB_DISTRIB; RIGHT_SUB_DISTRIB; MULT_CLAUSES] THEN + ONCE_REWRITE_TAC[ARITH_RULE `a - (b + c) = a - c - b:num`] THEN + MATCH_MP_TAC(ARITH_RULE `c <= b ==> a - b <= a - c:num`) THEN ARITH_TAC; + GEN_REWRITE_TAC RAND_CONV + [AC MULT_AC `m * (m - 1) * n = (m - 1) * m * n`] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]]);; + +let XY_EXP_LEMMA = prove + (`!a k n. + ~(a = 0) /\ + 2 * n * a EXP n < k + ==> abs(&(Y (a * k) (n + 1)) / &(Y k (n + 1)) - &a pow n) < &1 / &2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(k = 0)` ASSUME_TAC THENL + [FIRST_ASSUM(ACCEPT_TAC o MATCH_MP (ARITH_RULE + `a < k ==> ~(k = 0)`)); ALL_TAC] THEN + SUBGOAL_THEN `0 < Y k (n + 1)` ASSUME_TAC THENL + [SUBST1_TAC(SYM(SPEC `k:num` (CONJUNCT1 Y_CLAUSES))) THEN + ASM_SIMP_TAC[Y_INCREASES_LT; ARITH_RULE `0 < n + 1`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `abs(&(Y k (n + 1)))` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN + ASM_SIMP_TAC[REAL_ABS_NUM; REAL_LT_IMP_NZ; + REAL_OF_NUM_LT; REAL_DIV_LMUL] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_ASSOC] THEN + SIMP_TAC[GSYM real_div; REAL_OF_NUM_LT; ARITH; REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `!lx ly ux uy. + lx <= x /\ x <= ux /\ ly <= y /\ y <= uy /\ + &2 * uy < &2 * lx + d /\ &2 * ux < &2 * ly + d + ==> abs(x - y) * &2 < d`) THEN + MAP_EVERY EXISTS_TAC + [`&((2 * a * k - 1) EXP n)`; `&((2 * k - 1) EXP n) * &a pow n`; + `&((2 * a * k) EXP n)`; `&((2 * k) EXP n) * &a pow n`] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; Y_LOWERBOUND; Y_UPPERBOUND; + REAL_LE_RMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; + ARITH_RULE `~(a = 0) ==> 0 < a`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN + MATCH_MP_TAC(ARITH_RULE + `!x:num. x <= c /\ a < b + x /\ d < e + x ==> a < b + c /\ d < e + c`) THEN + EXISTS_TAC `(2 * k - 1) EXP n` THEN REWRITE_TAC[Y_LOWERBOUND] THEN + REWRITE_TAC[GSYM MULT_EXP; GSYM MULT_ASSOC] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB; GSYM MULT_ASSOC] THEN + SUBST1_TAC(AC MULT_AC `2 * k * a = 2 * a * k`) THEN + REWRITE_TAC[MULT_CLAUSES] THEN + MATCH_MP_TAC(ARITH_RULE + `b' <= b /\ a < b' + c ==> a < b + c /\ a < b' + c:num`) THEN + CONJ_TAC THENL + [REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + SPEC_TAC(`n:num`,`m:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 EXP; LE_REFL] THEN + REWRITE_TAC[EXP_MONO_LE_SUC] THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + SUBST1_TAC(AC MULT_AC `2 * a * k = 2 * k * a`) THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) + [ARITH_RULE `a = 1 * a`] THEN + REWRITE_TAC[MULT_ASSOC; GSYM RIGHT_SUB_DISTRIB] THEN + REWRITE_TAC[MULT_EXP] THEN + REWRITE_TAC[ARITH_RULE `2 * e * a + e = (2 * a + 1) * e`] THEN + REWRITE_TAC[GSYM MULT_EXP; GSYM MULT_ASSOC] THEN + SUBST1_TAC(AC MULT_AC `2 * k * a = a * 2 * k`) THEN + ONCE_REWRITE_TAC[MULT_EXP] THEN REWRITE_TAC[MULT_ASSOC] THEN + SUBGOAL_THEN `(2 * k) * (2 * a EXP n) * (2 * k) EXP n < + (2 * k) * (2 * a EXP n + 1) * (2 * k - 1) EXP n` + MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[LT_MULT_LCANCEL; MULT_EQ_0; ARITH_EQ]] THEN + GEN_REWRITE_TAC RAND_CONV + [AC MULT_AC `(2 * k) * l * m = l * (2 * k) * m`] THEN + MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `(2 * a EXP n + 1) * (2 * k) EXP n * (2 * k - n)` THEN + CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[LE_MULT_LCANCEL; BINOMIALISH_LEMMA]] THEN + REWRITE_TAC[ARITH_RULE + `(2 * k) * (2 * an) * 2kn < a2na * 2kn * kmn <=> + 2kn * 4 * k * an < 2kn * a2na * kmn`] THEN + ASM_SIMP_TAC[LT_MULT_LCANCEL; EXP_EQ_0; MULT_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[LEFT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE `a + b < c ==> a < c - b:num`) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + REWRITE_TAC[ARITH_RULE `4 * k * an + x < 2 * an * 2 * k + y <=> x < y`] THEN + ONCE_REWRITE_TAC[AC MULT_AC `2 * a * n = 2 * n * a`] THEN + UNDISCH_TAC `2 * n * a EXP n < k` THEN + MATCH_MP_TAC(ARITH_RULE + `n * 1 <= x ==> 2 * x < k ==> 2 * x + n < 2 * k`) THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_REWRITE_TAC[EXP_EQ_0]);; + +let ABS_LT_REPRESENTATION = prove + (`!x y z. + ~(y = 0) + ==> (abs(&x / &y - &z) < &1 / &2 <=> + 4 * x EXP 2 + 4 * (y * z) EXP 2 < 8 * x * y * z + y EXP 2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&4 * (&x / &y - &z) pow 2 < &1` THEN CONJ_TAC THENL + [SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&2 * &2`)) THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_POW_MUL] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN EQ_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [SYM(REAL_RAT_REDUCE_CONV `&1 pow 2`)] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + SIMP_TAC[ARITH_EQ; REAL_POW_LT2; REAL_LE_MUL; REAL_POS; REAL_ABS_POS]; + ONCE_REWRITE_TAC[TAUT `a ==> b <=> ~b ==> ~a`] THEN + REWRITE_TAC[REAL_NOT_LT] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) + [SYM(REAL_RAT_REDUCE_CONV `&1 pow 2`)] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + SIMP_TAC[ARITH_EQ; REAL_POW_LE2; REAL_LE_MUL; REAL_POS; REAL_ABS_POS]]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&4 * (&x - &y * &z) pow 2 < &y pow 2` THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[GSYM REAL_ABS_POW] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ; REAL_POW_EQ_0; + ARITH_EQ; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div; GSYM REAL_POW_DIV] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN + AP_TERM_TAC THEN + ASM_SIMP_TAC[GSYM real_div; REAL_DIV_LMUL; REAL_OF_NUM_EQ]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +let Y_EQ_0 = prove + (`!a n. ~(a = 0) ==> ((Y a n = 0) <=> (n = 0))`, + REPEAT STRIP_TAC THEN + SUBST1_TAC(SYM(SPEC `a:num` (CONJUNCT1 Y_CLAUSES))) THEN + ASM_SIMP_TAC[Y_INJ] THEN REWRITE_TAC[Y_CLAUSES]);; + +let XY_EXP = prove + (`~(a = 0) + ==> ((a EXP n = p) <=> + ?k x y z. (Y (a * k) (n + 1) = x) /\ + (Y k (n + 1) = y) /\ + (Y a (n + 1) = z) /\ + 2 * n * z < k /\ + 4 * x EXP 2 + 4 * (y * p) EXP 2 < 8 * x * y * p + y EXP 2)`, + let lemma1 = prove + (`(?x y z. (a = x) /\ (b = y) /\ (c = z) /\ P x y z) <=> P a b c`, + MESON_TAC[]) + and lemma2 = + CONV_RULE(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) + (SPEC_ALL ABS_LT_REPRESENTATION) in + REPEAT STRIP_TAC THEN REWRITE_TAC[lemma1] THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV o LAND_CONV) + [ARITH_RULE `n < k <=> n < k /\ ~(k = 0)`] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + ASM_SIMP_TAC[lemma2; Y_EQ_0; ADD_EQ_0; ARITH_EQ] THEN + REWRITE_TAC[NOT_IMP] THEN + REWRITE_TAC[ARITH_RULE `n < k /\ ~(k = 0) <=> n < k`] THEN + EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN + EXISTS_TAC `2 * n * Y a (n + 1) + 1` THEN + REWRITE_TAC[ARITH_RULE `c < c + 1`; GSYM REAL_OF_NUM_POW] THEN + MATCH_MP_TAC XY_EXP_LEMMA THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE `a <= b ==> 2 * a < 2 * b + 1`) THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(2 * a - 1) EXP n` THEN + REWRITE_TAC[Y_LOWERBOUND] THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[CONJUNCT1 EXP; LE_REFL; EXP_MONO_LE_SUC] THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(SPECL [`a:num`; `k:num`; `n:num`] XY_EXP_LEMMA) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `2 * a < k ==> b <= a ==> 2 * b < k`)) THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(2 * a - 1) EXP n` THEN + REWRITE_TAC[Y_LOWERBOUND] THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[CONJUNCT1 EXP; LE_REFL; EXP_MONO_LE_SUC] THEN + UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - a) < e1 /\ abs(x - b) < e2 ==> abs(a - b) < e1 + e2`)) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `abs(a - b) < &1 + ==> a + &1 <= b \/ (a = b) \/ b + &1 <= a ==> (a = b)`)) THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_ADD; + REAL_OF_NUM_EQ; REAL_OF_NUM_LE] THEN + DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SUM_OF_SQUARES = prove + (`(x pow 2 + y pow 2 = &0) <=> (x = &0) /\ (y = &0)`, + REWRITE_TAC[REAL_POW_2] THEN EQ_TAC THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(a + b = &0) ==> &0 <= a /\ &0 <= b ==> (a = &0) /\ (b = &0)`)) THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems for conjunction and disjunction. *) +(* ------------------------------------------------------------------------- *) + +let DIOPH_CONJ = prove + (`(x1 = x2) /\ (y1 = y2) <=> + (x1 * x1 + x2 * x2 + y1 * y1 + y2 * y2 = 2 * x1 * x2 + 2 * y1 * y2)`, + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM REAL_SUM_OF_SQUARES] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +let DIOPH_DISJ = prove + (`(x1 = x2) \/ (y1 = y2) <=> + (x1 * y1 + x2 * y2 = x1 * y2 + x2 * y1)`, + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM REAL_ENTIRE] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Inequalities. *) +(* ------------------------------------------------------------------------- *) + +let DIOPH_LE = prove + (`x <= y <=> ?d:num. x + d = y`, + REWRITE_TAC[LE_EXISTS] THEN + AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[ADD_AC; EQ_SYM_EQ]);; + +let DIOPH_LT = prove + (`x < y <=> ?d. x + d + 1 = y`, + REWRITE_TAC[LT_EXISTS] THEN + REWRITE_TAC[ADD1] THEN + AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[ADD_AC; EQ_SYM_EQ]);; + +let DIOPH_NE = prove + (`~(x = y) <=> x < y \/ y < x:num`, + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Exponentiation (from the Pell stuff). *) +(* ------------------------------------------------------------------------- *) + +let Y_0 = prove + (`!k. Y 0 k = if k = 1 then 1 else 0`, + INDUCT_TAC THEN REWRITE_TAC[Y_CLAUSES; ARITH_EQ] THEN + SPEC_TAC(`k:num`,`k:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[Y_CLAUSES; ARITH] THEN + REWRITE_TAC[ARITH_RULE `SUC(SUC n) = n + 2`; Y_CLAUSES; ARITH] THEN + REWRITE_TAC[MULT_CLAUSES; SUB_0; ARITH_RULE `~(k + 2 = 1)`]);; + +let Y_0_TRIV = prove + (`!k. (Y 0 k = 0) <=> ~(k = 1)`, + GEN_TAC THEN REWRITE_TAC[Y_0] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_EQ]);; + +let DIOPH_Y = prove + (`(Y a k = y) <=> + (a = 0) /\ (k = 1) /\ (y = 1) \/ + (a = 0) /\ ~(k = 1) /\ (y = 0) \/ + (k = 0) /\ (y = 0) \/ + (a = 1) /\ (y = k) \/ + ~(a = 0) /\ ~(k = 0) /\ ~(a = 1) /\ ~(y = 0) /\ + ?x u v r b p q s t c d. + 0 < r /\ + (x EXP 2 = (a EXP 2 - 1) * y EXP 2 + 1) /\ + (u EXP 2 = (a EXP 2 - 1) * v EXP 2 + 1) /\ + (s EXP 2 = (b EXP 2 - 1) * t EXP 2 + 1) /\ + (v = r * y EXP 2) /\ + (b = 1 + 4 * p * y) /\ + (b = a + q * u) /\ + (s = x + c * u) /\ + (t = k + 4 * d * y) /\ + k <= y`, + ASM_CASES_TAC `a = 0` THENL + [ASM_CASES_TAC `y = 0` THENL + [ASM_REWRITE_TAC[Y_0_TRIV; ARITH_EQ] THEN ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES; ARITH_EQ] THEN + ASM_REWRITE_TAC[ARITH_EQ] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[EXP_2; MULT_EQ_1] THEN + REWRITE_TAC[Y_0] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_EQ] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[Y_CLAUSES] THENL + [REWRITE_TAC[EQ_SYM_EQ] THEN CONV_TAC(EQT_INTRO o TAUT); ALL_TAC] THEN + ASM_CASES_TAC `a = 1` THEN ASM_REWRITE_TAC[Y_DEGENERATE] THENL + [REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN + ASM_CASES_TAC `y = 0` THEN ASM_SIMP_TAC[Y_EQ_0] THEN + GEN_REWRITE_TAC LAND_CONV [EQ_SYM_EQ] THEN ASM_SIMP_TAC[Y_DIOPH]);; + +let DIOPH_EXP_LEMMA = prove + (`(m EXP n = p) <=> + (m = 0) /\ (n = 0) /\ (p = 1) \/ + (m = 0) /\ ~(n = 0) /\ (p = 0) \/ + ~(m = 0) /\ + ?k x y z. (Y (m * k) (n + 1) = x) /\ + (Y k (n + 1) = y) /\ + (Y m (n + 1) = z) /\ + 2 * n * z < k /\ + 4 * x EXP 2 + 4 * (y * p) EXP 2 < 8 * x * y * p + y EXP 2`, + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[ARITH_EQ] THENL + [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES; NOT_SUC] THEN + REWRITE_TAC[EQ_SYM_EQ]; ALL_TAC] THEN + ASM_SIMP_TAC[XY_EXP]);; + +let DIOPH_EXP = + let th1 = REWRITE_RULE[DIOPH_Y] DIOPH_EXP_LEMMA in + let th2 = REWRITE_RULE[EXP_2] th1 in + let th3 = REWRITE_RULE[DIOPH_NE; DIOPH_LT; DIOPH_LE] th2 in + let th4 = REWRITE_RULE[ADD_CLAUSES; ARITH_EQ; ADD_EQ_0; + ARITH_RULE `(n + 1 = 1) = (n = 0)`; ADD_ASSOC; + EQ_ADD_RCANCEL] th3 in + let th5 = REWRITE_RULE[GSYM ADD_ASSOC] th4 in + REWRITE_RULE + [OR_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] th5;; + +(****** This takes about an hour to compute, and longer to print out! + +let DIOPH_EXP_ONE_EQUATION = + REWRITE_RULE[DIOPH_CONJ; DIOPH_DISJ] DIOPH_EXP;; + + *******) diff --git a/Examples/polylog.ml b/Examples/polylog.ml new file mode 100644 index 0000000..e3556c5 --- /dev/null +++ b/Examples/polylog.ml @@ -0,0 +1,677 @@ +(* ========================================================================= *) +(* Pi series in Bailey/Borwein/Plouffe "polylogarithmic constants" paper. *) +(* ========================================================================= *) + +needs "Library/transc.ml";; + +let FACTOR_1X4_LEMMA = prove + (`!x. (x * x + x * sqrt (&2) + &1) * (x * x - x * sqrt (&2) + &1) = + &1 + x pow 4`, + REWRITE_TAC[REAL_ARITH + `(a + b + c) * (a - b + c) = &2 * a * c + a * a - b * b + c * c`] THEN + REWRITE_TAC[REAL_ARITH + `&2 * (x * x) * &1 + a - (x * s) * x * s + &1 * &1 = + (&2 - s * s) * x * x + (&1 + a)`] THEN + SIMP_TAC[REWRITE_RULE[REAL_POW_2] SQRT_POW_2; REAL_POS] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO; REAL_ADD_LID] THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `SUC(SUC(SUC(SUC 0)))`)) THEN + REWRITE_TAC[real_pow; REAL_MUL_ASSOC; REAL_MUL_RID]);; + +let MAGIC_DERIVATIVE = prove + (`!x. abs(x) < &1 + ==> ((\x. ln((x - &1) pow 2) + + ln((x + &1) pow 2) + + ln((x pow 2 + x * sqrt(&2) + &1) / + (x pow 2 - x * sqrt(&2) + &1)) + + &2 * atn(x * sqrt(&2) + &1) + + &2 * atn(x * sqrt(&2) - &1) + + &2 * atn(x pow 2) - + ln(x pow 4 + &1)) + diffl ((&4 * sqrt(&2) - + &8 * x pow 3 - + &4 * sqrt(&2) * x pow 4 - + &8 * x pow 5) / (&1 - x pow 8)))(x)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o SPEC `x:real` o DIFF_CONV o lhand o rator o snd) THEN + REWRITE_TAC[IMP_IMP] THEN + MATCH_MP_TAC(TAUT + `a /\ (a ==> (b <=> c)) ==> (a ==> b) ==> c`) THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT + `a /\ (a ==> c) /\ (a /\ c ==> b) /\ d /\ e + ==> e /\ d /\ b /\ a /\ c`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 + 2`)) THEN + REWRITE_TAC[REAL_POW_ADD; REAL_LE_SQUARE]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_ADD_SYM] THEN + ONCE_REWRITE_TAC[GSYM FACTOR_1X4_LEMMA] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN + SIMP_TAC[REAL_POW_2; REAL_ENTIRE; DE_MORGAN_THM]; + STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `inv((x pow 2 - x * sqrt (&2) + &1) * + (x pow 2 - x * sqrt (&2) + &1)) * + ((x pow 2 - x * sqrt (&2) + &1) * + (x pow 2 - x * sqrt (&2) + &1)) * + (x pow 2 + x * sqrt (&2) + &1) / + (x pow 2 - x * sqrt (&2) + &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ; GSYM REAL_POW_2] THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`; + REAL_POW_EQ_0] THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_DIV_LMUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_POW_2; FACTOR_1X4_LEMMA] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 + 2`)) THEN + REWRITE_TAC[REAL_POW_ADD; REAL_LE_SQUARE]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ENTIRE; DE_MORGAN_THM] THEN + REWRITE_TAC[REAL_LE_REFL; REAL_MUL_LID]; + REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE] THEN + UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE] THEN + UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + STRIP_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_MUL_LID; REAL_MUL_RID; + REAL_SUB_RZERO; REAL_SUB_LZERO; REAL_SUB_REFL; + REAL_ADD_LID; REAL_ADD_RID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_POW_1] THEN + REWRITE_TAC[REAL_ARITH + `(a + b) * (x - y + z) - (a - b) * (x + y + z) = + &2 * (b * x + b * z - a * y)`] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH + `s * x * x + s - (&2 * x) * x * s = s * (&1 - x * x)`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e * inv(a) * f = + (a * inv a) * b * c * d * e * f`] THEN + REWRITE_TAC[REAL_ARITH + `&1 + (x * s + &1) * (x * s + &1) = + &2 + &2 * x * s + (s * s) * x * x`] THEN + REWRITE_TAC[REAL_ARITH + `&1 + (x * s - &1) * (x * s - &1) = + &2 + &2 * x * --s + (s * s) * x * x`] THEN + SIMP_TAC[REWRITE_RULE[REAL_POW_2] SQRT_POW_2; REAL_POS] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `&2 + &2 * x = &2 * (&1 + x)`] THEN + REWRITE_TAC[REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_ARITH + `&1 + x * (a + b) = (&1 + x * a) + x * b`] THEN + REWRITE_TAC[REAL_MUL_RNEG] THEN REWRITE_TAC[GSYM real_sub] THEN + REWRITE_TAC[REAL_ARITH `(&1 + x * a) + x * x = x * x + x * a + &1`] THEN + REWRITE_TAC[REAL_ARITH `(&1 - x * a) + x * x = x * x - x * a + &1`] THEN + REWRITE_TAC[REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH `inv(x) * y * z * x = (x * inv(x)) * y * z`] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_EQ; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH + `p' * n * &2 * s2 * aa * n' * n' = + (n' * n) * (p' * n') * &2 * s2 * aa`] THEN + MP_TAC(SPEC `x pow 2` REAL_LE_SQUARE) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_POW_2] THEN + REWRITE_TAC[REAL_POW_POW; ARITH] THEN + REWRITE_TAC[GSYM FACTOR_1X4_LEMMA; REAL_ENTIRE; DE_MORGAN_THM] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN + SUBGOAL_THEN + `!other. inv(x * x + x * sqrt (&2) + &1) * sqrt (&2) + + inv(x * x - x * sqrt (&2) + &1) * sqrt (&2) + other = + other + &2 * sqrt(&2) * (&1 + x * x) * + inv(x * x + x * sqrt (&2) + &1) * + inv(x * x - x * sqrt (&2) + &1)` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [GEN_TAC THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN + EXISTS_TAC `(x * x + x * sqrt (&2) + &1) * + (x * x - x * sqrt (&2) + &1)` THEN + MATCH_MP_TAC(TAUT `~a /\ (~a ==> b) ==> ~a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[FACTOR_1X4_LEMMA] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`) THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 + 2`)) THEN + REWRITE_TAC[REAL_POW_ADD; REAL_LE_SQUARE]; ALL_TAC] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH + `(x * y) * (a + b + c) = (x * a) * y + (y * b) * x + x * y * c`] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV] THEN + REWRITE_TAC[REAL_ARITH + `(a + b + x * other = x * (other + c)) <=> (a + b = x * c)`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `p * n * x * y * z * p' * n' = + (p * p') * (n * n') * x * y * z`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH + `a * (x - y + z) + a * (x + y + z) = &2 * a * (x + z)`] THEN + REWRITE_TAC[REAL_ADD_AC]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; FACTOR_1X4_LEMMA] THEN + SUBGOAL_THEN `~(x + &1 = &0) /\ ~(x - &1 = &0)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [UNDISCH_TAC `&0 < (x + &1) pow 2`; + UNDISCH_TAC `&0 < (x - &1) pow 2`] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN + SIMP_TAC[REAL_POW_EQ_0; ARITH_EQ]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH + `i4 * &2 * s * (&1 - x2) + other + &2 * s * (&1 + x2) * i4 = + &4 * s * i4 + other`] THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&1 - x pow 8` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`) THEN + SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 4`)) THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 pow 4`)) THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN MATCH_MP_TAC REAL_POW_LT2 THEN + REWRITE_TAC[ARITH_EQ; REAL_POW_2; REAL_LE_SQUARE] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 pow 2`)) THEN + MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[REAL_ABS_POS; ARITH_EQ]; ALL_TAC] THEN + SIMP_TAC[GSYM real_div; REAL_DIV_LMUL] THEN + SUBGOAL_THEN `!x. &1 - x pow 8 = (&1 + x pow 4) * (&1 - x pow 4)` + (fun th -> REWRITE_TAC[th]) + THENL + [SUBST1_TAC(SYM(NUM_REDUCE_CONV `4 * 2`)) THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM(CONJUNCT2 real_pow)] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SUBST1_TAC(SPECL [`x pow 4`; `&1`] REAL_ADD_SYM) THEN + REWRITE_TAC[real_div; REAL_ARITH + `a + b + c1 * c2 * x + x * d - x * e = + (a + b) + x * (c1 * c2 + d - e)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(p * m) * (x + inv(p) * y) = m * x * p + (p * inv(p)) * m * y`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID] THEN + UNDISCH_TAC `~(&1 - x pow 4 = &0)` THEN + SUBGOAL_THEN `!x. &1 - x pow 4 = (&1 + x pow 2) * (&1 - x pow 2)` + (fun th -> REWRITE_TAC[th]) + THENL + [SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 2`)) THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `~(&1 - x pow 2 = &0)` THEN + SUBGOAL_THEN `!x. &1 - x pow 2 = (&1 + x) * (&1 - x)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(x12 * (p1 + p2) * (m1 - m2)) * (m' * &2 + p' * &2) * other = + --(&2) * x12 * other * + ((p2 + p1) * (m2 - m1) * m' + (m2 - m1) * (p2 + p1) * p')`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV] THEN + CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN + REWRITE_TAC[real_pow] THEN CONV_TAC NUM_REDUCE_CONV THEN + REAL_ARITH_TAC);; + +let POLYLOG_CONVERGES = prove + (`!a b x. ~(a = 0) /\ ~(b = 0) /\ abs(x) < &1 + ==> summable (\n. x pow (a * n + b) / &(a * n + b))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x) pow (a * n + b)` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_DIV; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[real_div] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_INV_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; GSYM REAL_POW_POW] THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC `abs(x) pow b * inv(&1 - abs(x) pow a)` THEN + MATCH_MP_TAC SER_CMUL THEN + MATCH_MP_TAC GP THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_ABS] THEN + SUBST1_TAC(SYM(SPEC `a:num` REAL_POW_ONE)) THEN + MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[REAL_ABS_POS]);; + +let POLYLOG_DERIVATIVE = prove + (`!a b x. ~(a = 0) /\ ~(b = 0) /\ abs(x) < &1 + ==> ((\x. suminf (\n. x pow (a * n + b) / &(a * n + b))) diffl + (x pow (b - 1) / (&1 - x pow a)))(x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs(x pow a) < &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_POW] THEN + SUBST1_TAC(SYM(SPEC `a:num` REAL_POW_ONE)) THEN + MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; ALL_TAC] THEN + MP_TAC(SPEC `x pow a` GP) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `((\x. suminf (\n. inv(&(a * n + b)) * x pow n)) diffl + (suminf (\n. diffs (\n. inv(&(a * n + b))) n * (x pow a) pow n)))(x pow a)` + MP_TAC THENL + [MATCH_MP_TAC TERMDIFF_STRONG THEN + EXISTS_TAC `(abs(x pow a) + &1) / &2` THEN + ABBREV_TAC `k = (abs(x pow a) + &1) / &2` THEN + SUBGOAL_THEN `abs(x pow a) < abs(k) /\ abs(k) < &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; + REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x pow a) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(k) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div; REAL_ABS_DIV; + GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `~(b = 0) ==> 0 < a + b`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; + ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs k)` THEN + ASM_SIMP_TAC[GP; REAL_ABS_ABS]; ALL_TAC] THEN + REWRITE_TAC[diffs] THEN + MP_TAC(SPECL [`a:num`; `x:real`] DIFF_POW) THEN + REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN + REWRITE_TAC[] THEN + MP_TAC(SPECL [`b:num`; `x:real`] DIFF_POW) THEN + REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `summable (\n. &(SUC n) / &(a * SUC n + b) * (x pow a) pow (SUC n - 1))` + ASSUME_TAC THENL + [REWRITE_TAC[SUC_SUB1] THEN MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x pow a) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + REWRITE_TAC[GSYM REAL_ABS_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_ABS_DIV; REAL_ABS_NUM; + ARITH_RULE `~(b = 0) ==> 0 < a + b /\ 1 <= a + b`; + REAL_MUL_LID; REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC(ARITH_RULE `1 * n <= b ==> n <= b + c`) THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs(x pow a))` THEN + ASM_SIMP_TAC[GP; REAL_ABS_ABS]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP(SPECL [`f:num->real`; `1`] SER_OFFSET_REV) o + REWRITE_RULE[ADD1]) THEN + REWRITE_TAC[SUM_1] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID] THEN + REWRITE_TAC[GSYM real_div] THEN + CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV(ALPHA_CONV `n:num`))) THEN + REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[ADD1] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_CMUL) THEN + DISCH_THEN(MP_TAC o SPEC `&a * x pow (a - 1) * x pow b`) THEN + SUBGOAL_THEN + `summable (\n. inv(&(a * n + b)) * x pow a pow n)` + MP_TAC THENL + [MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x pow a) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_INV_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC `inv(&1 - abs(x pow a))` THEN + ASM_SIMP_TAC[GP; REAL_ABS_ABS]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_CMUL) THEN + DISCH_THEN(MP_TAC o SPEC `&b * x pow (b - 1)`) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_ADD) THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `!n. (&a * x pow (a - 1) * x pow b) * + &n / &(a * n + b) * x pow a pow (n - 1) + + (&b * x pow (b - 1)) * inv(&(a * n + b)) * x pow a pow n = + x pow (a * n + b - 1)` + (fun th -> REWRITE_TAC[th]) + THENL + [X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[SUB_0; real_pow; MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_ADD_LID; GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_DIV_LMUL; REAL_OF_NUM_EQ]; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_ADD; GSYM REAL_POW_POW] THEN + SUBGOAL_THEN `(x pow a) pow n = x pow a * (x pow a) pow (n - 1)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + AP_TERM_TAC THEN UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_POW] THEN + SUBGOAL_THEN `x pow a = x * x pow (a - 1)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + AP_TERM_TAC THEN UNDISCH_TAC `~(a = 0)` THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `x pow b = x * x pow (b - 1)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + AP_TERM_TAC THEN UNDISCH_TAC `~(b = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH + `a * xa1 * x * xb1 * n * i * xan1 + b * xb1 * i * x * xa1 * xan1 = + x * xa1 * xan1 * xb1 * (a * n + b) * i`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_MUL_RID; REAL_OF_NUM_EQ; + ARITH_RULE `~(b = 0) ==> ~(a + b = 0)`]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN + SUBGOAL_THEN + `x pow (b - 1) / (&1 - x pow a) = suminf (\n. x pow (a * n + b - 1))` + (SUBST1_TAC o SYM) THENL + [MATCH_MP_TAC SUM_UNIQ THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; real_div] THEN + MATCH_MP_TAC SER_CMUL THEN + ASM_SIMP_TAC[GSYM REAL_POW_POW; GP]; ALL_TAC] THEN + SIMP_TAC[REAL_MUL_AC] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[diffl] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + LIM_TRANSFORM) THEN + REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&1 - abs(x)` THEN + ASM_REWRITE_TAC[REAL_SUB_LT; REAL_SUB_RZERO] THEN + X_GEN_TAC `h:real` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `(a = a') /\ &0 < b ==> abs(a - a') < b`) THEN + ASM_REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `abs(x + h) < &1` ASSUME_TAC THENL + [UNDISCH_TAC `abs(h) < &1 - abs(x)` THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `!z. abs(z) < &1 + ==> (suminf (\n. z pow (a * n + b) / &(a * n + b)) = + z pow b * suminf (\n. inv (&(a * n + b)) * z pow a pow n))` + (fun th -> ASM_SIMP_TAC[th]) THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN + MATCH_MP_TAC(GSYM SUM_UNIQ) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC SER_CMUL THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + MATCH_MP_TAC SUMMABLE_SUM THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(z pow a) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_INV_LE_1; REAL_OF_NUM_LE; + ARITH_RULE `~(b = 0) ==> 1 <= a + b`]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN + EXISTS_TAC `inv(&1 - abs(z pow a))` THEN + MATCH_MP_TAC GP THEN REWRITE_TAC[REAL_ABS_ABS; REAL_ABS_POW] THEN + SUBST1_TAC(SYM(SPEC `a:num` REAL_POW_ONE)) THEN + MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; + +let POLYLOG_THM = prove + (`(\n. inv(&16 pow n) * (&4 / &(8 * n + 1) - + &2 / &(8 * n + 4) - + &1 / &(8 * n + 5) - + &1 / &(8 * n + 6))) + sums pi`, + SUBGOAL_THEN + `!x. abs(x) < &1 + ==> ((\x. suminf (\n. &4 * sqrt(&2) * x pow (8 * n + 1) / &(8 * n + 1) - + &8 * x pow (8 * n + 4) / &(8 * n + 4) - + &4 * sqrt(&2) * x pow (8 * n + 5) / &(8 * n + 5) - + &8 * x pow (8 * n + 6) / &(8 * n + 6))) + diffl + (&4 * sqrt(&2) - + &8 * x pow 3 - + &4 * sqrt(&2) * x pow 4 - + &8 * x pow 5) / (&1 - x pow 8))(x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`8`; `1`; `x:real`] POLYLOG_DERIVATIVE) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[real_pow] THEN + DISCH_THEN(MP_TAC o SPEC `&4 * sqrt(&2)` o MATCH_MP DIFF_CMUL) THEN + MP_TAC(SPECL [`8`; `4`; `x:real`] POLYLOG_DERIVATIVE) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `&8` o MATCH_MP DIFF_CMUL) THEN + MP_TAC(SPECL [`8`; `5`; `x:real`] POLYLOG_DERIVATIVE) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `&4 * sqrt(&2)` o MATCH_MP DIFF_CMUL) THEN + MP_TAC(SPECL [`8`; `6`; `x:real`] POLYLOG_DERIVATIVE) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `&8` o MATCH_MP DIFF_CMUL) THEN + REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_ADD_RDISTRIB; + GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `a - (b + c + d) = a - b - c - d`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_RID] THEN + REWRITE_TAC[diffl] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + LIM_TRANSFORM) THEN + REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&1 - abs(x)` THEN + ASM_REWRITE_TAC[REAL_SUB_LT; REAL_SUB_RZERO] THEN + X_GEN_TAC `h:real` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `(a = a') /\ &0 < b ==> abs(a - a') < b`) THEN + ASM_REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `abs(x + h) < &1` ASSUME_TAC THENL + [UNDISCH_TAC `abs(h) < &1 - abs(x)` THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `!z. abs(z) < &1 + ==> (suminf + (\n. (&4 * sqrt (&2)) * z pow (8 * n + 1) / &(8 * n + 1) - + &8 * z pow (8 * n + 4) / &(8 * n + 4) - + (&4 * sqrt (&2)) * z pow (8 * n + 5) / &(8 * n + 5) - + &8 * z pow (8 * n + 6) / &(8 * n + 6)) = + (&4 * sqrt (&2)) * suminf (\n. z pow (8 * n + 1) / &(8 * n + 1)) - + &8 * suminf (\n. z pow (8 * n + 4) / &(8 * n + 4)) - + (&4 * sqrt (&2)) * suminf (\n. z pow (8 * n + 5) / &(8 * n + 5)) - + &8 * suminf (\n. z pow (8 * n + 6) / &(8 * n + 6)))` + (fun th -> ASM_SIMP_TAC[th]) THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN + MATCH_MP_TAC(GSYM SUM_UNIQ) THEN + REPEAT(MATCH_MP_TAC SER_SUB THEN CONJ_TAC) THEN + MATCH_MP_TAC SER_CMUL THEN + MATCH_MP_TAC SUMMABLE_SUM THEN + MATCH_MP_TAC POLYLOG_CONVERGES THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN + MP_TAC(SPEC + `\x. suminf (\n. &4 * sqrt (&2) * x pow (8 * n + 1) / &(8 * n + 1) - + &8 * x pow (8 * n + 4) / &(8 * n + 4) - + &4 * sqrt (&2) * x pow (8 * n + 5) / &(8 * n + 5) - + &8 * x pow (8 * n + 6) / &(8 * n + 6)) - + (ln ((x - &1) pow 2) + + ln((x + &1) pow 2) + + ln((x pow 2 + x * sqrt (&2) + &1) / + (x pow 2 - x * sqrt (&2) + &1)) + + &2 * atn (x * sqrt (&2) + &1) + + &2 * atn (x * sqrt (&2) - &1) + + &2 * atn (x pow 2) - ln (x pow 4 + &1))` DIFF_ISCONST_END_SIMPLE) THEN + DISCH_THEN(MP_TAC o SPECL [`&0`; `inv(sqrt(&2))`]) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [SIMP_TAC[SQRT_POS_LT; REAL_LT_INV_EQ; REAL_OF_NUM_LT; ARITH] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `abs(x) < &1` MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `!a. &0 <= x /\ x <= a /\ a < &1 ==> abs(x) < &1`) THEN + EXISTS_TAC `inv(sqrt(&2))` THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&1)`)) THEN + MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_LT_01] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `sqrt((&5 / &4) pow 2)` THEN CONJ_TAC THENL + [SIMP_TAC[POW_2_SQRT; REAL_LE_DIV; REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + DISCH_THEN(fun th -> MP_TAC(MATCH_MP MAGIC_DERIVATIVE th) THEN + ANTE_RES_THEN MP_TAC th) THEN + ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN + REWRITE_TAC[REAL_SUB_REFL]; ALL_TAC] THEN + SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL REAL_POW_EQ_0)); + ARITH_RULE `~(b = 0) ==> ~(a + b = 0)`; + ARITH_EQ] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[GSYM real_div; REAL_ADD_LID; REAL_ADD_RID] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_DIV_1; LN_1; ATN_1; ATN_NEG; ATN_0] THEN + REWRITE_TAC[REAL_ARITH `a * b + a * --b + c = c`] THEN + SUBGOAL_THEN `suminf (\n. &0) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM SUM_UNIQ) THEN + MP_TAC(SPECL [`\n:num. &0`; `0`] SER_0) THEN REWRITE_TAC[sum]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_SUB_REFL] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_LT_INV_EQ; + SQRT_POS_LT; REAL_OF_NUM_LT; ARITH_LE; ARITH_LT] THEN + SUBGOAL_THEN `inv(sqrt(&2)) pow 4 = inv(sqrt(&2)) pow 2 pow 2` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_POW; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN + SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBGOAL_THEN + `!other. ln((inv (sqrt (&2)) - &1) pow 2) + + ln((inv (sqrt (&2)) + &1) pow 2) + other = + ln(&1 / &4) + other` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [GEN_TAC THEN REWRITE_TAC[REAL_ADD_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `&0 < (inv(sqrt(&2)) - &1) pow 2 /\ + &0 < (inv(sqrt (&2)) + &1) pow 2` + (fun th -> SIMP_TAC[GSYM LN_MUL; th]) + THENL + [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < &1 ==> ~(x - &1 = &0) /\ ~(x + &1 = &0)`) THEN + SIMP_TAC[REAL_LT_INV_EQ; SQRT_POS_LT; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sqrt((&4 / &5) pow 2)` THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[POW_2_SQRT; REAL_LE_DIV; REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + SIMP_TAC[GSYM SQRT_INV; REAL_POS] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_ARITH `(x - &1) * (x + &1) = x * x - &1`] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN + SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[ATN_0; REAL_MUL_RZERO; REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `l1 + l2 + a + y - l3 = (l1 + l2 - l3) + a + y`] THEN + SIMP_TAC[GSYM LN_DIV; GSYM LN_MUL; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; + ARITH_LE; ARITH_LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LN_1; REAL_ADD_LID] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; real_div; REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `!n. inv(sqrt (&2)) pow (8 * n) = inv(&16 pow n)` + (fun th -> REWRITE_TAC[th]) + THENL + [SUBST1_TAC(SYM(NUM_REDUCE_CONV `2 * 4`)) THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN + SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM REAL_POW_INV] THEN + REWRITE_TAC[real_div; REAL_MUL_LID]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN + SUBGOAL_THEN `!x. x pow 5 = x * x pow 4` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[GSYM(CONJUNCT2 real_pow); ARITH]; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_1] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * s * i * b - c - d * s * (i * e) * f - g = + (s * i) * a * b - c - (s * i) * d * e * f - g`] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; SQRT_POS_LT; REAL_OF_NUM_LT; + ARITH_LT; ARITH_LE] THEN + SUBGOAL_THEN `!x. x pow 6 = (x pow 2) pow 3` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[REAL_POW_POW; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `!x. x pow 4 = (x pow 2) pow 2` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[REAL_POW_POW; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `inv(sqrt(&2)) pow 2 = &1 / &2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_INV; real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN + SIMP_TAC[SQRT_POW_2; REAL_POS]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN + SUBGOAL_THEN + `summable + (\n. inv (&16 pow n) * + (&4 / &(8 * n + 1) - + &2 / &(8 * n + 4) - + &1 / &(8 * n + 5) - + &1 / &(8 * n + 6)))` + MP_TAC THENL + [MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. &8 / &16 pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ABS_POW; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_NUM; REAL_LE_REFL] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(v) <= &1 /\ abs(w) <= &1 /\ abs(x) <= &1 /\ abs(y) <= &1 + ==> abs(&4 * v - &2 * w - &1 * x - &1 * y) <= &8`) THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBST1_TAC(SYM REAL_INV_1) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `&8 / (&1 - inv(&16))` THEN + REWRITE_TAC[real_div; GSYM REAL_POW_INV] THEN + MATCH_MP_TAC SER_CMUL THEN + MATCH_MP_TAC GP THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + MP_TAC(SPEC `atn(&1 / &2)` TAN_COT) THEN + REWRITE_TAC[ATN_TAN] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o AP_TERM `atn`) THEN REWRITE_TAC[REAL_DIV_1] THEN + MATCH_MP_TAC(REAL_ARITH + `(a = d - c) ==> (a = b) ==> (b + c = d)`) THEN + MATCH_MP_TAC TAN_ATN THEN REWRITE_TAC[PI2_PI4] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < p4 + ==> --(&2 * p4) < &2 * p4 - x /\ &2 * p4 - x < &2 * p4`) THEN + CONJ_TAC THENL + [SUBST1_TAC(SYM ATN_0) THEN MATCH_MP_TAC ATN_MONO_LT THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC ATN_LT_PI4_POS THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; diff --git a/Examples/prog.ml b/Examples/prog.ml new file mode 100644 index 0000000..0c01c2d --- /dev/null +++ b/Examples/prog.ml @@ -0,0 +1,771 @@ +(* ========================================================================= *) +(* Simple WHILE-language with relational semantics. *) +(* ========================================================================= *) + +prioritize_num();; + +parse_as_infix("refined",(12,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Logical operations "lifted" to predicates, for readability. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("AND",(20,"right"));; +parse_as_infix("OR",(16,"right"));; +parse_as_infix("IMP",(13,"right"));; +parse_as_infix("IMPLIES",(12,"right"));; + +let FALSE = new_definition + `FALSE = \x:S. F`;; + +let TRUE = new_definition + `TRUE = \x:S. T`;; + +let NOT = new_definition + `NOT p = \x:S. ~(p x)`;; + +let AND = new_definition + `p AND q = \x:S. p x /\ q x`;; + +let OR = new_definition + `p OR q = \x:S. p x \/ q x`;; + +let ANDS = new_definition + `ANDS P = \x:S. !p. P p ==> p x`;; + +let ORS = new_definition + `ORS P = \x:S. ?p. P p /\ p x`;; + +let IMP = new_definition + `p IMP q = \x:S. p x ==> q x`;; + +(* ------------------------------------------------------------------------- *) +(* This one is different, corresponding to "subset". *) +(* ------------------------------------------------------------------------- *) + +let IMPLIES = new_definition + `p IMPLIES q <=> !x:S. p x ==> q x`;; + +(* ------------------------------------------------------------------------- *) +(* Simple procedure to prove tautologies at the predicate level. *) +(* ------------------------------------------------------------------------- *) + +let PRED_TAUT = + let tac = + REWRITE_TAC[FALSE; TRUE; NOT; AND; OR; ANDS; ORS; IMP; + IMPLIES; FUN_EQ_THM] THEN MESON_TAC[] in + fun tm -> prove(tm,tac);; + +(* ------------------------------------------------------------------------- *) +(* Some applications. *) +(* ------------------------------------------------------------------------- *) + +let IMPLIES_TRANS = PRED_TAUT + `!p q r. p IMPLIES q /\ q IMPLIES r ==> p IMPLIES r`;; + +(* ------------------------------------------------------------------------- *) +(* Enumerated type of basic commands, and other derived commands. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("Seq",(26,"right"));; + +let command_INDUCTION,command_RECURSION = define_type + "command = Assign (S->S) + | Seq command command + | Ite (S->bool) command command + | While (S->bool) command";; + +let SKIP = new_definition + `SKIP = Assign I`;; + +let ABORT = new_definition + `ABORT = While TRUE SKIP`;; + +let IF = new_definition + `IF e c = Ite e c SKIP`;; + +let DO = new_definition + `DO c e = c Seq (While e c)`;; + +let ASSERT = new_definition + `ASSERT g = Ite g SKIP ABORT`;; + +(* ------------------------------------------------------------------------- *) +(* Annotation commands, to allow insertion of loop (in)variants. *) +(* ------------------------------------------------------------------------- *) + +let AWHILE = new_definition + `AWHILE (i:S->bool) (v:S->S->bool) (e:S->bool) c = While e c`;; + +let ADO = new_definition + `ADO (i:S->bool) (v:S->S->bool) c (e:S->bool) = DO c e`;; + +(* ------------------------------------------------------------------------- *) +(* Useful properties of type constructors for commands. *) +(* ------------------------------------------------------------------------- *) + +let command_DISTINCT = + distinctness "command";; + +let command_INJECTIVE = + injectivity "command";; + +(* ------------------------------------------------------------------------- *) +(* Relational semantics of commands. *) +(* ------------------------------------------------------------------------- *) + +let sem_RULES,sem_INDUCT,sem_CASES = new_inductive_definition + `(!f s. sem(Assign f) s (f s)) /\ + (!c1 c2 s s' s''. sem(c1) s s' /\ sem(c2) s' s'' + ==> sem(c1 Seq c2) s s'') /\ + (!e c1 c2 s s'. e s /\ sem(c1) s s' ==> sem(Ite e c1 c2) s s') /\ + (!e c1 c2 s s'. ~(e s) /\ sem(c2) s s' ==> sem(Ite e c1 c2) s s') /\ + (!e c s. ~(e s) ==> sem(While e c) s s) /\ + (!e c s s' s''. e s /\ sem(c) s s' /\ sem(While e c) s' s'' + ==> sem(While e c) s s'')`;; + +(* ------------------------------------------------------------------------- *) +(* A more "denotational" view of the semantics. *) +(* ------------------------------------------------------------------------- *) + +let SEM_ASSIGN = prove + (`sem(Assign f) s s' <=> (s' = f s)`, + GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN + REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; + +let SEM_SEQ = prove + (`sem(c1 Seq c2) s s' <=> ?s''. sem c1 s s'' /\ sem c2 s'' s'`, + GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN + REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; + +let SEM_ITE = prove + (`sem(Ite e c1 c2) s s' <=> e s /\ sem c1 s s' \/ + ~(e s) /\ sem c2 s s'`, + GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN + REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; + +let SEM_SKIP = prove + (`sem(SKIP) s s' <=> (s' = s)`, + REWRITE_TAC[SKIP; SEM_ASSIGN; I_THM]);; + +let SEM_IF = prove + (`sem(IF e c) s s' <=> e s /\ sem c s s' \/ ~(e s) /\ (s = s')`, + REWRITE_TAC[IF; SEM_ITE; SEM_SKIP; EQ_SYM_EQ]);; + +let SEM_WHILE = prove + (`sem(While e c) s s' <=> sem(IF e (c Seq While e c)) s s'`, + GEN_REWRITE_TAC LAND_CONV [sem_CASES] THEN + REWRITE_TAC[FUN_EQ_THM; SEM_IF; SEM_SEQ] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN MESON_TAC[]);; + +let SEM_ABORT = prove + (`sem(ABORT) s s' <=> F`, + let lemma = prove + (`!c s s'. sem c s s' ==> ~(c = ABORT)`, + MATCH_MP_TAC sem_INDUCT THEN + REWRITE_TAC[command_DISTINCT; command_INJECTIVE; ABORT] THEN + REWRITE_TAC[FUN_EQ_THM; TRUE] THEN MESON_TAC[]) in + MESON_TAC[lemma]);; + +let SEM_DO = prove + (`sem(DO c e) s s' <=> sem(c Seq IF e (DO c e)) s s'`, + REWRITE_TAC[DO; SEM_SEQ; GSYM SEM_WHILE]);; + +let SEM_ASSERT = prove + (`sem(ASSERT g) s s' <=> g s /\ (s' = s)`, + REWRITE_TAC[ASSERT; SEM_ITE; SEM_SKIP; SEM_ABORT]);; + +(* ------------------------------------------------------------------------- *) +(* Proofs that all commands are deterministic. *) +(* ------------------------------------------------------------------------- *) + +let deterministic = new_definition + `deterministic r <=> !s s1 s2. r s s1 /\ r s s2 ==> (s1 = s2)`;; + +let DETERMINISM = prove + (`!c:(S)command. deterministic(sem c)`, + REWRITE_TAC[deterministic] THEN SUBGOAL_THEN + `!c s s1. sem c s s1 ==> !s2:S. sem c s s2 ==> (s1 = s2)` + (fun th -> MESON_TAC[th]) THEN + MATCH_MP_TAC sem_INDUCT THEN CONJ_TAC THENL + [ALL_TAC; REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[sem_CASES] THEN + REWRITE_TAC[command_DISTINCT; command_INJECTIVE] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Termination, weakest liberal precondition and weakest precondition. *) +(* ------------------------------------------------------------------------- *) + +let terminates = new_definition + `terminates c s <=> ?s'. sem c s s'`;; + +let wlp = new_definition + `wlp c q s <=> !s'. sem c s s' ==> q s'`;; + +let wp = new_definition + `wp c q s <=> terminates c s /\ wlp c q s`;; + +(* ------------------------------------------------------------------------- *) +(* Dijkstra's healthiness conditions (the last because of determinism). *) +(* ------------------------------------------------------------------------- *) + +let WP_TOTAL = prove + (`!c. (wp c FALSE = FALSE)`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; FALSE] THEN MESON_TAC[]);; + +let WP_MONOTONIC = prove + (`q IMPLIES r ==> wp c q IMPLIES wp c r`, + REWRITE_TAC[IMPLIES; wp; wlp; terminates] THEN MESON_TAC[]);; + +let WP_CONJUNCTIVE = prove + (`(wp c q) AND (wp c r) = wp c (q AND r)`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; AND] THEN MESON_TAC[]);; + +let WP_DISJUNCTIVE = prove + (`(wp c p) OR (wp c q) = wp c (p OR q)`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; OR; terminates] THEN + MESON_TAC[REWRITE_RULE[deterministic] DETERMINISM]);; + +(* ------------------------------------------------------------------------- *) +(* Weakest preconditions for the primitive and derived commands. *) +(* ------------------------------------------------------------------------- *) + +let WP_ASSIGN = prove + (`!f q. wp (Assign f) q = q o f`, + REWRITE_TAC[wp; wlp; terminates; o_THM; FUN_EQ_THM; SEM_ASSIGN] THEN + MESON_TAC[]);; + +let WP_SEQ = prove + (`!c1 c2 q. wp (c1 Seq c2) q = wp c1 (wp c2 q)`, + REWRITE_TAC[wp; wlp; terminates; SEM_SEQ; FUN_EQ_THM] THEN + MESON_TAC[REWRITE_RULE[deterministic] DETERMINISM]);; + +let WP_ITE = prove + (`!e c1 c2 q. wp (Ite e c1 c2) q = (e AND wp c1 q) OR (NOT e AND wp c2 q)`, + REWRITE_TAC[wp; wlp; terminates; SEM_ITE; FUN_EQ_THM; AND; OR; NOT] THEN + MESON_TAC[]);; + +let WP_WHILE = prove + (`!e c. wp (IF e (c Seq While e c)) q = wp (While e c) q`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; GSYM SEM_WHILE]);; + +let WP_SKIP = prove + (`!q. wp SKIP q = q`, + REWRITE_TAC[FUN_EQ_THM; SKIP; WP_ASSIGN; I_THM; o_THM]);; + +let WP_ABORT = prove + (`!q. wp ABORT q = FALSE`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; SEM_ABORT; FALSE]);; + +let WP_IF = prove + (`!e c q. wp (IF e c) q = (e AND wp c q) OR (NOT e AND q)`, + REWRITE_TAC[IF; WP_ITE; WP_SKIP]);; + +let WP_DO = prove + (`!e c. wp (c Seq IF e (DO c e)) q = wp (DO c e) q`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; GSYM SEM_DO]);; + +let WP_ASSERT = prove + (`!g q. wp (ASSERT g) q = g AND q`, + REWRITE_TAC[wp; wlp; terminates; SEM_ASSERT; FUN_EQ_THM; AND] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Rules for total correctness. *) +(* ------------------------------------------------------------------------- *) + +let correct = new_definition + `correct p c q <=> p IMPLIES (wp c q)`;; + +let CORRECT_PRESTRENGTH = prove + (`!p p' c q. p IMPLIES p' /\ correct p' c q ==> correct p c q`, + REWRITE_TAC[correct; IMPLIES_TRANS]);; + +let CORRECT_POSTWEAK = prove + (`!p c q q'. correct p c q' /\ q' IMPLIES q ==> correct p c q`, + REWRITE_TAC[correct] THEN MESON_TAC[WP_MONOTONIC; IMPLIES_TRANS]);; + +let CORRECT_ASSIGN = prove + (`!p f q. (p IMPLIES (\s. q(f s))) ==> correct p (Assign f) q`, + REWRITE_TAC[correct; WP_ASSIGN; IMPLIES; o_THM]);; + +let CORRECT_SEQ = prove + (`!p q r c1 c2. + correct p c1 r /\ correct r c2 q ==> correct p (c1 Seq c2) q`, + REWRITE_TAC[correct; WP_SEQ; o_THM] THEN + MESON_TAC[WP_MONOTONIC; IMPLIES_TRANS]);; + +let CORRECT_ITE = prove + (`!p e c1 c2 q. + correct (p AND e) c1 q /\ correct (p AND (NOT e)) c2 q + ==> correct p (Ite e c1 c2) q`, + REWRITE_TAC[correct; WP_ITE; AND; NOT; IMPLIES; OR] THEN MESON_TAC[]);; + +let CORRECT_WHILE = prove + (`! (<<) p c q e invariant. + WF(<<) /\ + p IMPLIES invariant /\ + (NOT e) AND invariant IMPLIES q /\ + (!X:S. correct + (invariant AND e AND (\s. X = s)) c (invariant AND (\s. s << X))) + ==> correct p (While e c) q`, + REWRITE_TAC[correct; IMPLIES; IN; AND; NOT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!s:S. invariant s ==> wp (While e c) q s` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND]) THEN + X_GEN_TAC `s:S` THEN REPEAT DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM WP_WHILE] THEN + REWRITE_TAC[WP_IF; WP_SEQ; AND; OR; NOT; o_THM] THEN + ASM_CASES_TAC `(e:S->bool) s` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `wp c (\x:S. invariant x /\ x << s) (s:S) :bool` MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(\x:S. invariant x /\ x << (s:S)) IMPLIES wp (While e c) q` + MP_TAC THENL [REWRITE_TAC[IMPLIES] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MESON_TAC[WP_MONOTONIC; IMPLIES]);; + +let CORRECT_SKIP = prove + (`!p q. (p IMPLIES q) ==> correct p SKIP q`, + REWRITE_TAC[correct; WP_SKIP]);; + +let CORRECT_ABORT = prove + (`!p q. F ==> correct p ABORT q`, + REWRITE_TAC[]);; + +let CORRECT_IF = prove + (`!p e c q. + correct (p AND e) c q /\ (p AND (NOT e)) IMPLIES q + ==> correct p (IF e c) q`, + REWRITE_TAC[correct; WP_IF; AND; NOT; IMPLIES; OR] THEN MESON_TAC[]);; + +let CORRECT_DO = prove + (`! (<<) p q c invariant. + WF(<<) /\ + (e AND invariant) IMPLIES p /\ + ((NOT e) AND invariant) IMPLIES q /\ + (!X:S. correct + (p AND (\s. X = s)) c (invariant AND (\s. s << X))) + ==> correct p (DO c e) q`, + REPEAT STRIP_TAC THEN REWRITE_TAC[DO] THEN + MATCH_MP_TAC CORRECT_SEQ THEN EXISTS_TAC `invariant:S->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[correct; GSYM WP_CONJUNCTIVE] THEN + REWRITE_TAC[AND; IMPLIES] THEN MESON_TAC[]; + MATCH_MP_TAC CORRECT_WHILE THEN + MAP_EVERY EXISTS_TAC [`(<<) :S->S->bool`; `invariant:S->bool`] THEN + ASM_REWRITE_TAC[IMPLIES] THEN X_GEN_TAC `X:S` THEN + MATCH_MP_TAC CORRECT_PRESTRENGTH THEN + EXISTS_TAC `p AND (\s:S. X = s)` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(e:S->bool) AND invariant IMPLIES p` THEN + REWRITE_TAC[AND; IMPLIES] THEN MESON_TAC[]]);; + +let CORRECT_ASSERT = prove + (`!p g q. p IMPLIES (g AND q) ==> correct p (ASSERT g) q`, + REWRITE_TAC[correct; WP_ASSERT]);; + +(* ------------------------------------------------------------------------- *) +(* VCs for the basic commands (in fact only assign should be needed). *) +(* ------------------------------------------------------------------------- *) + +let VC_ASSIGN = prove + (`p IMPLIES (q o f) ==> correct p (Assign f) q`, + REWRITE_TAC[o_DEF; CORRECT_ASSIGN]);; + +let VC_SKIP = prove + (`p IMPLIES q ==> correct p SKIP q`, + REWRITE_TAC[CORRECT_SKIP]);; + +let VC_ABORT = prove + (`F ==> correct p ABORT q`, + MATCH_ACCEPT_TAC CORRECT_ABORT);; + +let VC_ASSERT = prove + (`p IMPLIES (b AND q) ==> correct p (ASSERT b) q`, + REWRITE_TAC[CORRECT_ASSERT]);; + +(* ------------------------------------------------------------------------- *) +(* VCs for composite commands other than sequences. *) +(* ------------------------------------------------------------------------- *) + +let VC_ITE = prove + (`correct (p AND e) c1 q /\ correct (p AND NOT e) c2 q + ==> correct p (Ite e c1 c2) q`, + REWRITE_TAC[CORRECT_ITE]);; + +let VC_IF = prove + (`correct (p AND e) c q /\ p AND NOT e IMPLIES q + ==> correct p (IF e c) q`, + REWRITE_TAC[CORRECT_IF]);; + +let VC_AWHILE_VARIANT = prove + (`WF(<<) /\ + p IMPLIES invariant /\ + (NOT e) AND invariant IMPLIES q /\ + (!X. correct + (invariant AND e AND (\s. X = s)) c (invariant AND (\s. s << X))) + ==> correct p (AWHILE invariant (<<) e c) q`, + REWRITE_TAC[AWHILE; CORRECT_WHILE]);; + +let VC_AWHILE_MEASURE = prove + (`p IMPLIES invariant /\ + (NOT e) AND invariant IMPLIES q /\ + (!X. correct + (invariant AND e AND (\s:S. X = m(s))) + c + (invariant AND (\s. m(s) < X))) + ==> correct p (AWHILE invariant (MEASURE m) e c) q`, + STRIP_TAC THEN MATCH_MP_TAC VC_AWHILE_VARIANT THEN + ASM_REWRITE_TAC[WF_MEASURE] THEN + X_GEN_TAC `X:S` THEN FIRST_ASSUM(MP_TAC o SPEC `(m:S->num) X`) THEN + REWRITE_TAC[correct; AND; IMPLIES; MEASURE] THEN MESON_TAC[]);; + +let VC_ADO_VARIANT = prove + (`WF(<<) /\ + (e AND invariant) IMPLIES p /\ + ((NOT e) AND invariant) IMPLIES q /\ + (!X. correct + (p AND (\s. X = s)) c (invariant AND (\s. s << X))) + ==> correct p (ADO invariant (<<) c e) q`, + REWRITE_TAC[ADO; CORRECT_DO]);; + +let VC_ADO_MEASURE = prove + (`(e AND invariant) IMPLIES p /\ + ((NOT e) AND invariant) IMPLIES q /\ + (!X. correct + (p AND (\s:S. X = m(s))) c (invariant AND (\s. m(s) < X))) + ==> correct p (ADO invariant (MEASURE m) c e) q`, + STRIP_TAC THEN MATCH_MP_TAC VC_ADO_VARIANT THEN + ASM_REWRITE_TAC[WF_MEASURE] THEN + X_GEN_TAC `X:S` THEN FIRST_ASSUM(MP_TAC o SPEC `(m:S->num) X`) THEN + REWRITE_TAC[correct; AND; IMPLIES; MEASURE] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* VCs for sequences of commands, using intelligence where possible. *) +(* ------------------------------------------------------------------------- *) + +let VC_SEQ_ASSERT_LEFT = prove + (`p IMPLIES b /\ correct b c q ==> correct p (ASSERT b Seq c) q`, + MESON_TAC[CORRECT_SEQ; CORRECT_ASSERT; CORRECT_PRESTRENGTH; + PRED_TAUT `(p IMPLIES b) ==> (p IMPLIES b AND p)`]);; + +let VC_SEQ_ASSERT_RIGHT = prove + (`correct p c b /\ b IMPLIES q ==> correct p (c Seq (ASSERT b)) q`, + MESON_TAC[CORRECT_SEQ; CORRECT_ASSERT; + PRED_TAUT `(p IMPLIES b) ==> (p IMPLIES p AND b)`]);; + +let VC_SEQ_ASSERT_MIDDLE = prove + (`correct p c b /\ correct b c' q + ==> correct p (c Seq (ASSERT b) Seq c') q`, + MESON_TAC[CORRECT_SEQ; CORRECT_ASSERT; PRED_TAUT `b IMPLIES b AND b`]);; + +let VC_SEQ_ASSIGN_LEFT = prove + (`(p o f = p) /\ (f o f = f) /\ + correct (p AND (\s:S. s = f s)) c q + ==> correct p ((Assign f) Seq c) q`, + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC CORRECT_SEQ THEN EXISTS_TAC `p AND (\s:S. s = f s)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VC_ASSIGN THEN + ASM_REWRITE_TAC[IMPLIES; AND; o_THM]);; + +let VC_SEQ_ASSIGN_RIGHT = prove + (`correct p c (q o f) ==> correct p (c Seq (Assign f)) q`, + MESON_TAC[CORRECT_SEQ; VC_ASSIGN; PRED_TAUT `(p:S->bool) IMPLIES p`]);; + +(* ------------------------------------------------------------------------- *) +(* Parser for correctness assertions. *) +(* ------------------------------------------------------------------------- *) + +let rec dive_to_var ptm = + match ptm with + Varp(_,_) as vp -> vp | Typing(t,_) -> dive_to_var t | _ -> fail();; + +let reserve_program_words,unreserve_program_words = + let words = ["var"; "end"; "skip"; "abort"; + ":="; "if"; "then"; "else"; "while"; "do"] in + (fun () -> reserve_words words), + (fun () -> unreserve_words words);; + +reserve_program_words();; + +let parse_program,parse_program_assertion = + let assign_ptm = Varp("Assign",dpty) + and seq_ptm = Varp("Seq",dpty) + and ite_ptm = Varp("Ite",dpty) + and while_ptm = Varp("While",dpty) + and skip_ptm = Varp("SKIP",dpty) + and abort_ptm = Varp("ABORT",dpty) + and if_ptm = Varp("IF",dpty) + and do_ptm = Varp("DO",dpty) + and assert_ptm = Varp("ASSERT",dpty) + and awhile_ptm = Varp("AWHILE",dpty) + and ado_ptm = Varp("ADO",dpty) in + let pmk_pair(ptm1,ptm2) = Combp(Combp(Varp(",",dpty),ptm1),ptm2) in + let varname ptm = + match dive_to_var ptm with Varp(n,_) -> n | _ -> fail() in + let rec assign s v e = + match s with + Combp(Combp(pop,lptm),rptm) -> + if varname pop = "," then + Combp(Combp(pop,assign lptm v e),assign rptm v e) + else fail() + | _ -> if varname s = v then e else s in + let lmk_assign s v e = Combp(assign_ptm,Absp(s,assign s v e)) + and lmk_seq c cs = + if cs = [] then c else Combp(Combp(seq_ptm,c),hd cs) + and lmk_ite e c1 c2 = Combp(Combp(Combp(ite_ptm,e),c1),c2) + and lmk_while e c = Combp(Combp(while_ptm,e),c) + and lmk_skip _ = skip_ptm + and lmk_abort _ = abort_ptm + and lmk_if e c = Combp(Combp(if_ptm,e),c) + and lmk_do c e = Combp(Combp(do_ptm,c),e) + and lmk_assert e = Combp(assert_ptm,e) + and lmk_awhile i v e c = Combp(Combp(Combp(Combp(awhile_ptm,i),v),e),c) + and lmk_ado i v c e = Combp(Combp(Combp(Combp(ado_ptm,i),v),c),e) in + let lmk_gwhile al e c = + if al = [] then lmk_while e c + else lmk_awhile (fst(hd al)) (snd(hd al)) e c + and lmk_gdo al c e = + if al = [] then lmk_do c e + else lmk_ado (fst(hd al)) (snd(hd al)) c e in + let expression s = parse_preterm >> (fun p -> Absp(s,p)) in + let identifier = + function ((Ident n)::rest) -> n,rest + | _ -> raise Noparse in + let variant s = + a (Ident "variant") ++ parse_preterm + >> snd + || a (Ident "measure") ++ expression s + >> fun (_,m) -> Combp(Varp("MEASURE",dpty),m) in + let annotation s = + a (Resword "[") ++ a (Ident "invariant") ++ expression s ++ + a (Resword ";") ++ variant s ++ a (Resword "]") + >> fun (((((_,_),i),_),v),_) -> (i,v) in + let rec command s i = + (a (Resword "(") ++ commands s ++ a (Resword ")") + >> (fun ((_,c),_) -> c) + || a (Resword "skip") + >> lmk_skip + || a (Resword "abort") + >> lmk_abort + || a (Resword "if") ++ expression s ++ a (Resword "then") ++ command s ++ + possibly (a (Resword "else") ++ command s >> snd) + >> (fun ((((_,e),_),c),cs) -> if cs = [] then lmk_if e c + else lmk_ite e c (hd cs)) + || a (Resword "while") ++ expression s ++ a (Resword "do") ++ + possibly (annotation s) ++ command s + >> (fun ((((_,e),_),al),c) -> lmk_gwhile al e c) + || a (Resword "do") ++ possibly (annotation s) ++ + command s ++ a (Resword "while") ++ expression s + >> (fun ((((_,al),c),_),e) -> lmk_gdo al c e) + || a (Resword "{") ++ expression s ++ a (Resword "}") + >> (fun ((_,e),_) -> lmk_assert e) + || identifier ++ a (Resword ":=") ++ parse_preterm + >> (fun ((v,_),e) -> lmk_assign s v e)) i + and commands s i = + (command s ++ possibly (a (Resword ";") ++ commands s >> snd) + >> (fun (c,cs) -> lmk_seq c cs)) i in + let program i = + let ((_,s),_),r = + (a (Resword "var") ++ parse_preterm ++ a (Resword ";")) i in + let c,r' = (commands s ++ a (Resword "end") >> fst) r in + (s,c),r' in + let assertion = + a (Ident "correct") ++ parse_preterm ++ program ++ parse_preterm + >> fun (((_,p),(s,c)),q) -> + Combp(Combp(Combp(Varp("correct",dpty),Absp(s,p)),c),Absp(s,q)) in + (program >> snd),assertion;; + +(* ------------------------------------------------------------------------- *) +(* Introduce the variables in the VCs. *) +(* ------------------------------------------------------------------------- *) + +let STATE_GEN_TAC = + let PAIR_CONV = REWR_CONV(GSYM PAIR) in + let rec repair vs v acc = + try let l,r = dest_pair vs in + let th = PAIR_CONV v in + let tm = rand(concl th) in + let rtm = rator tm in + let lth,acc1 = repair l (rand rtm) acc in + let rth,acc2 = repair r (rand tm) acc1 in + TRANS th (MK_COMB(AP_TERM (rator rtm) lth,rth)),acc2 + with Failure _ -> REFL v,((v,vs)::acc) in + fun (asl,w) -> + let abstm = find_term (fun t -> not (is_abs t) & is_gabs t) w in + let vs = fst(dest_gabs abstm) in + let v = genvar(type_of(fst(dest_forall w))) in + let th,gens = repair vs v [] in + (X_GEN_TAC v THEN SUBST1_TAC th THEN + MAP_EVERY SPEC_TAC gens THEN REPEAT GEN_TAC) (asl,w);; + +let STATE_GEN_TAC' = + let PAIR_CONV = REWR_CONV(GSYM PAIR) in + let rec repair vs v acc = + try let l,r = dest_pair vs in + let th = PAIR_CONV v in + let tm = rand(concl th) in + let rtm = rator tm in + let lth,acc1 = repair l (rand rtm) acc in + let rth,acc2 = repair r (rand tm) acc1 in + TRANS th (MK_COMB(AP_TERM (rator rtm) lth,rth)),acc2 + with Failure _ -> REFL v,((v,vs)::acc) in + fun (asl,w) -> + let abstm = find_term (fun t -> not (is_abs t) & is_gabs t) w in + let vs0 = fst(dest_gabs abstm) in + let vl0 = striplist dest_pair vs0 in + let vl = map (variant (variables (list_mk_conj(w::map (concl o snd) asl)))) + vl0 in + let vs = end_itlist (curry mk_pair) vl in + let v = genvar(type_of(fst(dest_forall w))) in + let th,gens = repair vs v [] in + (X_GEN_TAC v THEN SUBST1_TAC th THEN + MAP_EVERY SPEC_TAC gens THEN REPEAT GEN_TAC) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Tidy up a verification condition. *) +(* ------------------------------------------------------------------------- *) + +let VC_UNPACK_TAC = + REWRITE_TAC[IMPLIES; o_THM; FALSE; TRUE; AND; OR; NOT; IMP] THEN + STATE_GEN_TAC THEN CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC];; + +(* ------------------------------------------------------------------------- *) +(* Calculate a (pseudo-) weakest precondition for command. *) +(* ------------------------------------------------------------------------- *) + +let find_pwp = + let wptms = + (map (snd o strip_forall o concl) + [WP_ASSIGN; WP_ITE; WP_SKIP; WP_ABORT; WP_IF; WP_ASSERT]) @ + [`wp (AWHILE i v e c) q = i`; `wp (ADO i v c e) q = i`] in + let conv tm = + tryfind (fun t -> rand (instantiate (term_match [] (lhand t) tm) t)) + wptms in + fun tm q -> conv(mk_comb(list_mk_icomb "wp" [tm],q));; + +(* ------------------------------------------------------------------------- *) +(* Tools for automatic VC generation from annotated program. *) +(* ------------------------------------------------------------------------- *) + +let VC_SEQ_TAC = + let is_seq = is_binary "Seq" + and strip_seq = striplist (dest_binary "Seq") + and is_assert tm = + try fst(dest_const(rator tm)) = "ASSERT" with Failure _ -> false + and is_assign tm = + try fst(dest_const(rator tm)) = "Assign" with Failure _ -> false + and SIDE_TAC = + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN STATE_GEN_TAC THEN + PURE_REWRITE_TAC[IMPLIES; o_THM; FALSE; TRUE; AND; OR; NOT; IMP] THEN + CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ] THEN NO_TAC in + let ADJUST_TAC ptm ptm' ((_,w) as gl) = + let w' = subst [ptm',ptm] w in + let th = EQT_ELIM(REWRITE_CONV[correct; WP_SEQ] (mk_eq(w,w'))) in + GEN_REWRITE_TAC I [th] gl in + fun (asl,w) -> + let cptm,q = dest_comb w in + let cpt,ptm = dest_comb cptm in + let ctm,p = dest_comb cpt in + let ptms = strip_seq ptm in + let seq = rator(rator ptm) in + try let atm = find is_assert ptms in + let i = index atm ptms in + if i = 0 then + let ptm' = mk_binop seq (hd ptms) (list_mk_binop seq (tl ptms)) in + (ADJUST_TAC ptm ptm' THEN + MATCH_MP_TAC VC_SEQ_ASSERT_LEFT THEN CONJ_TAC THENL + [VC_UNPACK_TAC; ALL_TAC]) (asl,w) + else if i = length ptms - 1 then + let ptm' = mk_binop seq (list_mk_binop seq (butlast ptms)) + (last ptms) in + (ADJUST_TAC ptm ptm' THEN + MATCH_MP_TAC VC_SEQ_ASSERT_RIGHT THEN CONJ_TAC THENL + [ALL_TAC; VC_UNPACK_TAC]) (asl,w) + else + let l,mr = chop_list (index atm ptms) ptms in + let ptm' = mk_binop seq (list_mk_binop seq l) + (mk_binop seq (hd mr) (list_mk_binop seq (tl mr))) in + (ADJUST_TAC ptm ptm' THEN + MATCH_MP_TAC VC_SEQ_ASSERT_MIDDLE THEN CONJ_TAC) (asl,w) + with Failure "find" -> try + if is_assign (hd ptms) then + let ptm' = mk_binop seq (hd ptms) (list_mk_binop seq (tl ptms)) in + (ADJUST_TAC ptm ptm' THEN + MATCH_MP_TAC VC_SEQ_ASSIGN_LEFT THEN REPEAT CONJ_TAC THENL + [SIDE_TAC; SIDE_TAC; ALL_TAC]) (asl,w) + else fail() + with Failure _ -> + let ptm' = mk_binop seq + (list_mk_binop seq (butlast ptms)) (last ptms) in + let pwp = find_pwp (rand ptm') q in + (ADJUST_TAC ptm ptm' THEN MATCH_MP_TAC CORRECT_SEQ THEN + EXISTS_TAC pwp THEN CONJ_TAC) + (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Tactic to apply a 1-step VC generation. *) +(* ------------------------------------------------------------------------- *) + +let VC_STEP_TAC = + let tacnet = + itlist (enter []) + [`correct p SKIP q`, + MATCH_MP_TAC VC_SKIP THEN VC_UNPACK_TAC; + `correct p (ASSERT b) q`, + MATCH_MP_TAC VC_ASSERT THEN VC_UNPACK_TAC; + `correct p (Assign f) q`, + MATCH_MP_TAC VC_ASSIGN THEN VC_UNPACK_TAC; + `correct p (Ite e c1 c2) q`, + MATCH_MP_TAC VC_ITE THEN CONJ_TAC; + `correct p (IF e c) q`, + MATCH_MP_TAC VC_IF THEN CONJ_TAC THENL [ALL_TAC; VC_UNPACK_TAC]; + `correct p (AWHILE i (MEASURE m) e c) q`, + MATCH_MP_TAC VC_AWHILE_MEASURE THEN REPEAT CONJ_TAC THENL + [VC_UNPACK_TAC; VC_UNPACK_TAC; GEN_TAC]; + `correct p (AWHILE i v e c) q`, + MATCH_MP_TAC VC_AWHILE_VARIANT THEN REPEAT CONJ_TAC THENL + [ALL_TAC; VC_UNPACK_TAC; VC_UNPACK_TAC; STATE_GEN_TAC']; + `correct p (ADO i (MEASURE m) c e) q`, + MATCH_MP_TAC VC_ADO_MEASURE THEN REPEAT CONJ_TAC THENL + [VC_UNPACK_TAC; VC_UNPACK_TAC; STATE_GEN_TAC']; + `correct p (ADO i v c e) q`, + MATCH_MP_TAC VC_ADO_VARIANT THEN REPEAT CONJ_TAC THENL + [ALL_TAC; VC_UNPACK_TAC; VC_UNPACK_TAC; STATE_GEN_TAC']; + `correct p (c1 Seq c2) q`, + VC_SEQ_TAC] empty_net in + fun (asl,w) -> FIRST(lookup w tacnet) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Final packaging to strip away the program completely. *) +(* ------------------------------------------------------------------------- *) + +let VC_TAC = REPEAT VC_STEP_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Some examples. *) +(* ------------------------------------------------------------------------- *) + +install_parser ("correct",parse_program_assertion);; + +let EXAMPLE_FACTORIAL = prove + (`correct + T + var x,y,n; + x := 0; + y := 1; + while x < n do [invariant x <= n /\ (y = FACT x); measure n - x] + (x := x + 1; + y := y * x) + end + y = FACT n`, + VC_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[FACT; LE_0]; + REWRITE_TAC[CONJ_ASSOC; NOT_LT; LE_ANTISYM] THEN MESON_TAC[]; + REWRITE_TAC[GSYM ADD1; FACT] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[MULT_AC] THEN UNDISCH_TAC `x < n` THEN ARITH_TAC]);; + +delete_parser "correct";; diff --git a/Examples/prover9.ml b/Examples/prover9.ml new file mode 100644 index 0000000..f03c241 --- /dev/null +++ b/Examples/prover9.ml @@ -0,0 +1,568 @@ +(* ========================================================================= *) +(* Interface to prover9. *) +(* ========================================================================= *) + +(**** NB: this is the "prover9" command invoked by HOL Light. + **** If this doesn't work, set an explicit path to the prover9 binary + ****) + +let prover9 = "prover9";; + +(* ------------------------------------------------------------------------- *) +(* Debugging mode (true = keep the Prover9 input and output files) *) +(* ------------------------------------------------------------------------- *) + +let prover9_debugging = ref false;; + +(* ------------------------------------------------------------------------- *) +(* Prover9 options. Set to "" for the Prover9 default. *) +(* ------------------------------------------------------------------------- *) + +let prover9_options = ref +("clear(auto_inference).\n"^ + "clear(auto_denials).\n"^ + "clear(auto_limits).\n"^ + "set(neg_binary_resolution).\n"^ + "set(binary_resolution).\n"^ + "set(paramodulation).\n");; + +(* ------------------------------------------------------------------------- *) +(* Find the variables, functions, and predicates excluding equality. *) +(* ------------------------------------------------------------------------- *) + +let rec functions fvs tm (vacc,facc,racc as acc) = + if is_var tm then + if mem tm fvs then (vacc,insert tm facc,racc) + else (insert tm vacc,facc,racc) + else if is_abs tm then acc else + let f,args = strip_comb tm in + itlist (functions fvs) args (vacc,insert f facc,racc);; + +let rec signature fvs tm (vacc,facc,racc as acc) = + if is_neg tm then signature fvs (rand tm) acc + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + signature fvs (lhand tm) (signature fvs (rand tm) acc) + else if is_forall tm or is_exists tm or is_uexists tm then + signature fvs (body(rand tm)) acc + else if is_eq tm then + functions fvs (lhand tm) (functions fvs (rand tm) acc) + else if is_abs tm then acc else + let r,args = strip_comb tm in + itlist (functions fvs) args (vacc,facc,insert r racc);; + +(* ------------------------------------------------------------------------- *) +(* Shadow first-order syntax. Literal sign is true = positive. *) +(* ------------------------------------------------------------------------- *) + +type folterm = Variable of string | Function of string * folterm list;; + +type literal = Literal of bool * string * folterm list;; + +(* ------------------------------------------------------------------------- *) +(* Translate clause into shadow syntax. *) +(* ------------------------------------------------------------------------- *) + +let rec translate_term (trans_var,trans_fun,trans_rel as trp) tm = + let f,args = strip_comb tm in + if defined trans_fun f then + Function(apply trans_fun f,map (translate_term trp) args) + else if is_var tm then Variable(apply trans_var tm) + else failwith("unknown function"^ + (try fst(dest_const tm) with Failure _ -> "??"));; + +let translate_atom (trans_var,trans_fun,trans_rel as trp) tm = + if is_eq tm then + Literal(true,"=",[translate_term trp (lhand tm); + translate_term trp (rand tm)]) + else + let r,args = strip_comb tm in + Literal(true,apply trans_rel r,map (translate_term trp) args);; + +let rec translate_clause trp tm = + if is_disj tm then + translate_clause trp (lhand tm) @ translate_clause trp (rand tm) + else if is_neg tm then + let Literal(s,r,args) = translate_atom trp (rand tm) in + [Literal(not s,r,args)] + else [translate_atom trp tm];; + +(* ------------------------------------------------------------------------- *) +(* Create Prover9 input file for a set of clauses. *) +(* ------------------------------------------------------------------------- *) + +let rec prover9_of_term tm = + match tm with + Variable(s) -> s + | Function(f,[]) -> f + | Function(f,args) -> + f^"("^ + end_itlist (fun s t -> s^","^t) (map prover9_of_term args) ^ + ")";; + +let prover9_of_literal lit = + match lit with + Literal(s,r,[]) -> if s then r else "-"^r + | Literal(s,"=",[l;r]) -> + (if s then "(" else "-(")^ + (prover9_of_term l) ^ " = " ^ (prover9_of_term r)^")" + | Literal(s,r,args) -> + (if s then "" else "-")^r^"("^ + end_itlist (fun s t -> s^","^t) (map prover9_of_term args) ^ + ")";; + +let rec prover9_of_clause cls = + match cls with + [] -> failwith "prover9_of_clause: empty clause" + | [l] -> prover9_of_literal l + | l::ls -> prover9_of_literal l ^ " | " ^ prover9_of_clause ls;; + +(* ------------------------------------------------------------------------- *) +(* Parse S-expressions. *) +(* ------------------------------------------------------------------------- *) + +type sexp = Atom of string | List of sexp list;; + +let atom inp = + match inp with + Resword "("::rst -> raise Noparse + | Resword ")"::rst -> raise Noparse + | Resword s::rst -> Atom s,rst + | Ident s::rst -> Atom s,rst + | [] -> raise Noparse;; + +let rec sexpression inp = + ( atom + || (a (Resword "(") ++ many sexpression ++ a (Resword ")") >> + (fun ((_,l),_) -> List l))) + inp;; + +(* ------------------------------------------------------------------------- *) +(* Skip to beginning of proof object. *) +(* ------------------------------------------------------------------------- *) + +let rec skipheader i s = + if String.sub s i 28 = ";; BEGINNING OF PROOF OBJECT" + then String.sub s (i + 28) (String.length s - i - 28) + else skipheader (i + 1) s;; + +(* ------------------------------------------------------------------------- *) +(* Parse a proof step. *) +(* ------------------------------------------------------------------------- *) + +let parse_proofstep ps = + match ps with + List[Atom id; just; formula; Atom "NIL"] -> (id,just,formula) + | _ -> failwith "unexpected proofstep";; + +(* ------------------------------------------------------------------------- *) +(* Convert sexp representation of formula to shadow syntax. *) +(* ------------------------------------------------------------------------- *) + +let rec folterm_of_sexp sexp = + match sexp with + Atom(s) when String.sub s 0 1 = "v" -> Variable s + | Atom(s) -> Function(s,[]) + | List(Atom f::args) -> Function(f,map folterm_of_sexp args) + | _ -> failwith "folterm_of_sexp: malformed sexpression term representation";; + +let folatom_of_sexp sexp = + match sexp with + Atom(r) -> Literal(true,r,[]) + | List(Atom r::args) -> Literal(true,r,map folterm_of_sexp args) + | _ -> failwith "folatom_of_sexp: malformed sexpression atom representation";; + +let folliteral_of_sexp sexp = + match sexp with + List[Atom "not";sex] -> let Literal(s,r,args) = folatom_of_sexp sex in + Literal(not s,r,args) + | _ -> folatom_of_sexp sexp;; + +let rec folclause_of_sexp sexp = + match sexp with + List[Atom "or";sex1;sex2] -> + folclause_of_sexp sex1 @ folclause_of_sexp sex2 + | _ -> [folliteral_of_sexp sexp];; + +(* ------------------------------------------------------------------------- *) +(* Convert shadow syntax back into HOL (sometimes given expected type). *) +(* Make a crude type postcorrection for equations between variables based *) +(* on their types in other terms, if applicable. *) +(* It might be nicer to use preterms to get a systematic use of context, but *) +(* this is a pretty simple problem. *) +(* ------------------------------------------------------------------------- *) + +let rec hol_of_folterm (btrans_fun,btrans_rel as trp) ty tm = + match tm with + Variable(x) -> variant (ran btrans_fun) (mk_var(x,ty)) + | Function(fs,args) -> + let f = apply btrans_fun fs in + let tys,rty = nsplit dest_fun_ty args (type_of f) in + list_mk_comb(f,map2 (hol_of_folterm trp) tys args);; + +let hol_of_folliteral (btrans_fun,btrans_rel as trp) lit = + match lit with + Literal(s,"false",[]) -> if s then mk_const("F",[]) + else mk_neg(mk_const("F",[])) + | Literal(s,"=",[l;r]) -> + let tml_prov = hol_of_folterm trp aty l + and tmr_prov = hol_of_folterm trp aty r in + let ty = if type_of tml_prov <> aty then type_of tml_prov + else if type_of tmr_prov <> aty then type_of tmr_prov + else aty in + let ptm = mk_eq(hol_of_folterm trp ty l,hol_of_folterm trp ty r) in + if s then ptm else mk_neg ptm + | Literal(s,rs,args) -> + let r = apply btrans_rel rs in + let tys,rty = nsplit dest_fun_ty args (type_of r) in + let ptm = list_mk_comb(r,map2 (hol_of_folterm trp) tys args) in + if s then ptm else mk_neg ptm;; + +let is_truevar (bf,_) tm = is_var tm & not(mem tm (ran bf));; + +let rec hol_of_folclause trp cls = + match cls with + [] -> mk_const("F",[]) + | [c] -> hol_of_folliteral trp c + | c::cs -> let rawcls = map (hol_of_folliteral trp) cls in + let is_truevar tm = is_var tm & + not(mem tm (ran(fst trp))) & + not(mem tm (ran(snd trp))) in + let und,dec = partition + (fun t -> is_eq t & is_truevar(lhs t) & is_truevar(rhs t)) + rawcls in + if und = [] or dec = [] then list_mk_disj rawcls else + let cxt = map dest_var (filter is_truevar (freesl dec)) in + let correct t = + try let l,r = dest_eq t in + let ls = fst(dest_var l) and rs = fst(dest_var r) in + let ty = try assoc ls cxt with Failure _ -> assoc rs cxt in + mk_eq(mk_var(ls,ty),mk_var(rs,ty)) + with Failure _ -> t in + list_mk_disj(map correct rawcls);; + +(* ------------------------------------------------------------------------- *) +(* Composed map from sexp to HOL items. *) +(* ------------------------------------------------------------------------- *) + +let hol_of_term trp ty sexp = hol_of_folterm trp ty (folterm_of_sexp sexp);; + +let hol_of_literal trp sexp = hol_of_folliteral trp (folliteral_of_sexp sexp);; + +let hol_of_clause trp sexp = hol_of_folclause trp (folclause_of_sexp sexp);; + +(* ------------------------------------------------------------------------- *) +(* Follow paramodulation path *) +(* ------------------------------------------------------------------------- *) + +let rec PARA_SUBS_CONV path eth tm = + match path with + [] -> if lhs(concl eth) = tm then eth else failwith "PARA_SUBS_CONV" + | n::rpt -> let f,args = strip_comb tm in + funpow (length args - n) RATOR_CONV (RAND_CONV + (PARA_SUBS_CONV rpt eth)) tm;; + +(* ------------------------------------------------------------------------- *) +(* Pull forward disjunct in clause using prover9/Ivy director string. *) +(* ------------------------------------------------------------------------- *) + +let FRONT1_DISJ_CONV = + GEN_REWRITE_CONV I [TAUT `a \/ b \/ c <=> b \/ a \/ c`] ORELSEC + GEN_REWRITE_CONV I [TAUT `a \/ b <=> b \/ a`];; + +let rec FRONT_DISJ_CONV l tm = + match l with + [] | ((Atom "1")::_) -> REFL tm + | (Atom "2")::t -> (RAND_CONV (FRONT_DISJ_CONV t) THENC + FRONT1_DISJ_CONV) tm + | _ -> failwith "unexpected director string in clause";; + +(* ------------------------------------------------------------------------- *) +(* For using paramodulating equation, more convenient to put at the back. *) +(* ------------------------------------------------------------------------- *) + +let AP_IMP = + let pp = MATCH_MP(TAUT `(a ==> b) ==> !x. x \/ a ==> x \/ b`) in + fun t -> SPEC t o pp;; + +let rec PARA_BACK_CONV eqdir tm = + match eqdir with + [Atom "1"] when not(is_disj tm) -> REFL tm + | [Atom "2"] when not(is_disj tm) -> SYM_CONV tm + | Atom "2"::eqs -> RAND_CONV (PARA_BACK_CONV eqs) tm + | [Atom "1"; Atom f] when is_disj tm -> + let th1 = if f = "2" then LAND_CONV SYM_CONV tm else REFL tm in + let tm' = rand(concl th1) in + let djs = disjuncts tm' in + let th2 = DISJ_ACI_RULE(mk_eq(tm',list_mk_disj(tl djs @ [hd djs]))) in + TRANS th1 th2 + | _ -> failwith "PARA_BACK_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Do direct resolution on front clauses. *) +(* ------------------------------------------------------------------------- *) + +let RESOLVE = + let resrules = map (MATCH_MP o TAUT) + [`a /\ ~a ==> F`; + `~a /\ a ==> F`; + `a /\ (~a \/ b) ==> b`; + `~a /\ (a \/ b) ==> b`; + `(a \/ b) /\ ~a ==> b`; + `(~a \/ b) /\ a ==> b`; + `(a \/ b) /\ (~a \/ c) ==> b \/ c`; + `(~a \/ b) /\ (a \/ c) ==> b \/ c`] in + fun th1 th2 -> let th = CONJ th1 th2 in tryfind (fun f -> f th) resrules;; + +(* ------------------------------------------------------------------------- *) +(* AC rearrangement of disjunction but maybe correcting proforma types in *) +(* the target term for equations between variables. *) +(* ------------------------------------------------------------------------- *) + +let ACI_CORRECT th tm = + try EQ_MP (DISJ_ACI_RULE(mk_eq(concl th,tm))) th with Failure _ -> + let cxt = map dest_var (frees(concl th)) in + let rec correct t = + if is_disj t then mk_disj(correct(lhand t),correct(rand t)) + else if is_neg t then mk_neg(correct(rand t)) else + (try let l,r = dest_eq t in + let ls = fst(dest_var l) and rs = fst(dest_var r) in + let ty = try assoc ls cxt with Failure _ -> assoc rs cxt in + mk_eq(mk_var(ls,ty),mk_var(rs,ty)) + with Failure _ -> t) in + let tm' = correct tm in + EQ_MP (DISJ_ACI_RULE(mk_eq(concl th,tm'))) th;; + +(* ------------------------------------------------------------------------- *) +(* Process proof step. *) +(* ------------------------------------------------------------------------- *) + +let rec PROVER9_PATH_CONV l conv = + match l with + Atom "2"::t -> RAND_CONV(PROVER9_PATH_CONV t conv) + | Atom "1"::t -> LAND_CONV(PROVER9_PATH_CONV t conv) + | [] -> conv + | _ -> failwith "PROVER9_PATH_CONV:unknown path";; + +let PROVER9_FLIP_CONV tm = + if is_neg tm then RAND_CONV SYM_CONV tm else SYM_CONV tm;; + +let process_proofstep ths trp asms (lab,just,fm) = + let tm = hol_of_clause trp fm in + match just with + List[Atom "input"] -> + if is_eq tm & lhs tm = rhs tm then REFL(rand tm) else + tryfind (fun th -> PART_MATCH I th tm) ths + | List[Atom "flip"; Atom n; List path] -> + let th = apply asms n in + let nth = CONV_RULE(PROVER9_PATH_CONV path PROVER9_FLIP_CONV) th in + if concl nth = tm then nth + else failwith "Inconsistency from flip" + | List[Atom "instantiate"; Atom "0"; List[List[x;Atom".";y]]] -> + let th = REFL(hol_of_term trp aty y) in + if concl th = tm then th + else failwith "Inconsistency from instantiation of reflexivity" + | List[Atom "instantiate"; Atom n; List i] -> + let th = apply asms n + and ilist = map (fun (List[Atom x;Atom"."; y]) -> (y,x)) i in + let xs = map + (fun (y,x) -> find_term (fun v -> is_var v & fst(dest_var v) = x) + (concl th)) ilist in + let ys = map2 + (fun (y,x) v -> hol_of_term trp (type_of v) y) ilist xs in + INST (zip ys xs) th + | List[Atom "paramod"; Atom eqid; List eqdir; Atom tmid; List dir] -> + let eth = CONV_RULE (PARA_BACK_CONV eqdir) (apply asms eqid) + and tth = apply asms tmid + and path = (map (fun (Atom s) -> int_of_string s) dir) in + let etm = concl eth in + let th = + if is_disj etm then + let djs = disjuncts etm in + let eq = last djs in + let fth = CONV_RULE (PARA_SUBS_CONV path (ASSUME eq)) tth in + MP (itlist AP_IMP (butlast djs) (DISCH eq fth)) eth + else CONV_RULE(PARA_SUBS_CONV path eth) tth in + if concl th = tm then th + else failwith "Inconsistency from paramodulation" + | List[Atom "resolve"; Atom l1; List path1; Atom l2; List path2] -> + let th1 = CONV_RULE (FRONT_DISJ_CONV path1) (apply asms l1) + and th2 = CONV_RULE (FRONT_DISJ_CONV path2) (apply asms l2) in + let th3 = RESOLVE th1 th2 in + ACI_CORRECT th3 tm + | List[Atom "propositional"; Atom l] -> + let th1 = apply asms l in + ACI_CORRECT th1 tm + | _ -> failwith "process_proofstep: no translation";; + +let rec process_proofsteps ths trp asms steps = + match steps with + [] -> asms,[] + | ((lab,_,_) as st)::sts -> + (try let th = process_proofstep ths trp asms st in + process_proofsteps ths trp ((lab |-> th) asms) sts + with _ -> asms,steps);; + +(* ------------------------------------------------------------------------- *) +(* Main refutation procedure for clauses *) +(* ------------------------------------------------------------------------- *) + +let PROVER9_REFUTE ths = + let fvs = itlist (fun th -> union (freesl(hyp th))) ths [] in + let fovars,functions,relations = + signature fvs (end_itlist (curry mk_conj) (map concl ths)) ([],[],[]) in + let trans_var = + itlist2 (fun f n -> f |-> "x"^string_of_int n) + fovars (1--length fovars) undefined + and trans_fun = + itlist2 (fun f n -> f |-> "f"^string_of_int n) + functions (1--length functions) undefined + and trans_rel = + itlist2 (fun f n -> f |-> "R"^string_of_int n) + relations (1--length relations) undefined in + let cls = + map (translate_clause (trans_var,trans_fun,trans_rel) o concl) ths in + let p9cls = map (fun c -> prover9_of_clause c ^".\n") cls in + let p9str = "clear(bell).\n"^ !prover9_options ^ + "formulas(sos).\n"^ + itlist (^) p9cls + "end_of_list.\n" in + let filename_in = Filename.temp_file "prover9" ".in" + and filename_out = Filename.temp_file "prover9" ".out" in + let _ = file_of_string filename_in p9str in + let retcode = Sys.command + (prover9 ^ " -f " ^ filename_in ^ " | prooftrans ivy >" ^ filename_out) in + if retcode <> 0 then failwith "Prover9 call apparently failed" else + let p9proof = string_of_file filename_out in + let _ = if !prover9_debugging then () + else (ignore(Sys.remove filename_in); + ignore(Sys.remove filename_out)) in + let List sexps,unp = sexpression(lex(explode(skipheader 0 p9proof))) in + (if unp <> [Ident ";;"; Ident "END"; Ident "OF"; + Ident "PROOF"; Ident "OBJECT"] + then (Format.print_string "Unexpected proof object tail"; + Format.print_newline()) + else ()); + let btrans_fun = itlist (fun (x,y) -> y |-> x) (graph trans_fun) undefined + and btrans_rel = itlist (fun (x,y) -> y |-> x) (graph trans_rel) undefined + and proof = map parse_proofstep sexps in + let asms,undone = + process_proofsteps ths (btrans_fun,btrans_rel) undefined proof in + find (fun th -> concl th = mk_const("F",[])) (map snd (graph asms));; + +(* ------------------------------------------------------------------------- *) +(* Hence a prover. *) +(* ------------------------------------------------------------------------- *) + +let PROVER9 = + let prule = MATCH_MP(TAUT `(~p ==> F) ==> p`) + and false_tm = `F` and true_tm = `T` in + let init_conv = + TOP_DEPTH_CONV BETA_CONV THENC + PRESIMP_CONV THENC + CONDS_ELIM_CONV THENC + NNFC_CONV THENC CNF_CONV THENC + DEPTH_BINOP_CONV `(/\)` (SKOLEM_CONV THENC PRENEX_CONV) THENC + GEN_REWRITE_CONV REDEPTH_CONV + [RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM DISJ_ASSOC] THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM CONJ_ASSOC] in + fun tm -> + let tm' = mk_neg tm in + let ith = init_conv tm' in + let itm = rand(concl ith) in + if itm = true_tm then failwith "PROVER9: formula is trivially false" else + if itm = false_tm then prule(fst(EQ_IMP_RULE ith)) else + let evs,bod = strip_exists itm in + let ths = map SPEC_ALL (CONJUNCTS(ASSUME bod)) in + let ths' = end_itlist (@) (map (CONJUNCTS o CONV_RULE CNF_CONV) ths) in + let rth = PROVER9_REFUTE ths' in + let eth = itlist SIMPLE_CHOOSE evs rth in + let sth = PROVE_HYP (UNDISCH(fst(EQ_IMP_RULE ith))) eth in + prule(DISCH tm' sth);; + +(* ------------------------------------------------------------------------- *) +(* Examples. *) +(* ------------------------------------------------------------------------- *) + +let FRIEND_0 = time PROVER9 + `(!x:P. ~friend(x,x)) /\ ~(a:P = b) /\ (!x y. friend(x,y) ==> friend(y,x)) + ==> (!x. ?y z. friend(x,y) /\ ~friend(x,z)) \/ + (!x. ?y z. ~(y = z) /\ ~friend(x,y) /\ ~friend(x,z))`;; + +let FRIEND_1 = time PROVER9 + `(!x:P. ~friend(x,x)) /\ a IN s /\ b IN s /\ ~(a:P = b) /\ + (!x y. friend(x,y) ==> friend(y,x)) + ==> (!x. x IN s ==> ?y z. y IN s /\ z IN s /\ friend(x,y) /\ ~friend(x,z)) \/ + (!x. x IN s ==> ?y z. y IN s /\ z IN s /\ + ~(y = z) /\ ~friend(x,y) /\ ~friend(x,z))`;; + +let LOS = time PROVER9 + `(!x y z. P(x,y) /\ P(y,z) ==> P(x,z)) /\ + (!x y z. Q(x,y) /\ Q(y,z) ==> Q(x,z)) /\ + (!x y. Q(x,y) ==> Q(y,x)) /\ + (!x y. P(x,y) \/ Q(x,y)) /\ + ~P(a,b) /\ ~Q(c,d) + ==> F`;; + +let CONWAY_1 = time PROVER9 + `(!x. 0 + x = x) /\ + (!x y. x + y = y + x) /\ + (!x y z. x + (y + z) = (x + y) + z) /\ + (!x. 1 * x = x) /\ (!x. x * 1 = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x. 0 * x = 0) /\ (!x. x * 0 = 0) /\ + (!x y z. x * (y + z) = (x * y) + (x * z)) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) /\ + (!x y. star(x * y) = 1 + x * star(y * x) * y) /\ + (!x y. star(x + y) = star(star(x) * y) * star(x)) + ==> star(star(star(1))) = star(star(1))`;; + +let CONWAY_2 = time PROVER9 + `(!x. 0 + x = x) /\ + (!x y. x + y = y + x) /\ + (!x y z. x + (y + z) = (x + y) + z) /\ + (!x. 1 * x = x) /\ (!x. x * 1 = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x. 0 * x = 0) /\ (!x. x * 0 = 0) /\ + (!x y z. x * (y + z) = (x * y) + (x * z)) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) /\ + (!x y. star(x * y) = 1 + x * star(y * x) * y) /\ + (!x y. star(x + y) = star(star(x) * y) * star(x)) + ==> !a. star(star(star(star(a)))) = star(star(star(a)))`;; + +let ECKMAN_HILTON_1 = time PROVER9 + `(!x. 1 * x = x) /\ + (!x. x * 1 = x) /\ + (!x. 1 + x = x) /\ + (!x. x + 1 = x) /\ + (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) + ==> !a b. a * b = a + b`;; + +let ECKMAN_HILTON_2 = time PROVER9 + `(!x. 1 * x = x) /\ + (!x. x * 1 = x) /\ + (!x. 1 + x = x) /\ + (!x. x + 1 = x) /\ + (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) + ==> !a b. a * b = b * a`;; + +let ECKMAN_HILTON_3 = time PROVER9 + `(!x. 1 * x = x) /\ + (!x. x * 1 = x) /\ + (!x. 0 + x = x) /\ + (!x. x + 0 = x) /\ + (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) + ==> !a b. a * b = b * a`;; + +let ECKMAN_HILTON_4 = time PROVER9 + `(!x. 1 * x = x) /\ + (!x. x * 1 = x) /\ + (!x. 0 + x = x) /\ + (!x. x + 0 = x) /\ + (!w x y z. (w * x) + (y * z) = (w + y) * (x + z)) + ==> !a b. a + b = a * b`;; + +let DOUBLE_DISTRIB = time PROVER9 + `(!x y z. (x * y) * z = (x * z) * (y * z)) /\ + (!x y z. z * (x * y) = (z * x) * (z * y)) + ==> !a b c. (a * b) * (c * a) = (a * c) * (b * a)`;; diff --git a/Examples/rectypes.ml b/Examples/rectypes.ml new file mode 100644 index 0000000..541d947 --- /dev/null +++ b/Examples/rectypes.ml @@ -0,0 +1,475 @@ +(* ========================================================================= *) +(* Some (mutually, nested) recursive types from various sources. *) +(* ========================================================================= *) + +time define_type "Term = Var A B | App bool Termlist; + Termlist = Empty | Consp Term Termlist";; + +time define_type "List = Nil | Cons A List";; + +time define_type "Btree = Leaf A | Node B Btree Btree";; + +time define_type "Command = Assign ind Expression + | If Expression Command + | Ite Expression Command Command + | While Expression Command + | Do Command Expression; + Expression = Constant num + | Variable ind + | Summ Expression Expression + | Product Expression Expression";; + +time define_type "testa = empty_testa | cons_testa testa testb; + testb = contentb L testc; + testc = connection M testa";; + +time define_type "atexp = Varb ind | Let dec exp; + exp = Exp1 atexp | Exp2 exp atexp | Exp3 matching; + matching = Match1 rule | Matches rule matching; + rule = Rule pat exp; + dec = Val valbind | Local dec dec | Decs dec dec; + valbind = Single pat exp | Multi pat exp valbind | Rec valbind; + pat = Wild | Varpat ind";; + +time define_type "tri = ONE | TWO | THREE";; + +(* ------------------------------------------------------------------------- *) +(* A couple from Steve Brackin's work. *) +(* ------------------------------------------------------------------------- *) + +time define_type "T = X1 | X2 | X3 | X4 | X5 | X6 | X7 | X8 | X9 | X10 | X11 | + X12 | X13 | X14 | X15 | X16 | X17 | X18 | X19 | X20 | X21 | + X22 | X23 | X24 | X25 | X26 | X27 | X28 | X29 | X30 | X31 | + X32 | X33 | X34";; + +time define_type "TY1 = NoF__ | Fk__ A TY2; + TY2 = Ta__ bool | Td__ bool | Tf__ TY1 | Tk__ bool | Tp__ bool + | App__ A TY1 TY2 TY3 | Pair__ TY2 TY2; + TY3 = NoS__ | Fresh__ TY2 | Trustworthy__ A + | PrivateKey__ A B C | PublicKey__ A B C + | Conveyed__ A TY2 | Possesses__ A TY2 | Received__ A TY2 + | Recognizes__ A TY2 | NeverMalFromSelf__ A B TY2 + | Sends__ A TY2 B | SharedSecret__ A TY2 B + | Believes__ A TY3 | And__ TY3 TY3";; + +(* ------------------------------------------------------------------------- *) +(* Some with nesting of various kinds, plus required auxiliaries. *) +(* ------------------------------------------------------------------------- *) + +let term_INDUCTION,term_RECURSION = time define_type + "term = Vari int | Fni int (term list)";; + +let bintree_INDUCTION,bintree_RECURSION = time define_type + "bintree = Leafb | Branchb (bintree # bintree)";; + +let etree_INDUCTION,etree_RECURSION = time define_type + "etree = Terminal | Nonterminal (num + etree)";; + +let ptree_INDUCTION,ptree_RECURSION = time define_type + "ptree = Only (ptree option)";; + +let mut_INDUCTION,mut_RECURSION = time define_type + "mutual = Mutual A mutual D otherone | Friend D otherone; + otherone = Great C | Expectations mutual otherone";; + +let groof_INDUCTION,groof_RECURSION = time define_type + "groof = Wu bool + | Wibble (A,groof,L)mutual + | Wobble groof groof";; + +let biterm_INDUCTION,biterm_RECURSION = time define_type + "biterm = Variab int + | Fnapp (biterm list + biterm list)";; + +let triterm_INDUCTION,triterm_RECURSION = time define_type + "triterm = Var0 int + | Fun2 (triterm list + triterm list) + | Fun1 (triterm list)";; + +let xtree_INDUCTION,xtree_RECURSION = time define_type + "xtree = Leafx A + | Branchx (xtree list)";; + +let simper_INDUCTION,simper_RECURSION = time define_type + "simper = Leaves A B + | Bough (simper xtree)";; + +let array_INDUCTION,array_RECURSION = time define_type + "array = Array num (A list)";; + +let value_INDUCTION,value_RECURSION = time define_type + "value = Integer num + | Boolean bool + | List_of (value list) + | Tree_of (value xtree) + | Array_of (value array)";; + +let example_INDUCTION,example_RECURSION = time define_type + "command = Assignment (num list # expression list) + | Sequence (command list); + expression = Numeral num + | Plus (expression # expression) + | Valof command";; + +let zonk_INDUCTION,zonk_RECURSION = time define_type + "zonk = Stonk ((zonk,pink,A)mutual)list # expression + | Tonk zonk (pink list) + | Honk num; + pink = Floyd (zonk # pink) + | Purple num + | Rain (A # pink)";; + +(* ------------------------------------------------------------------------- *) +(* Example from Konrad Slind: 68000 instruction set. *) +(* ------------------------------------------------------------------------- *) + +time define_type "Size = Byte | Word | Long";; + +time define_type "DataRegister + = RegD0 + | RegD1 + | RegD2 + | RegD3 + | RegD4 + | RegD5 + | RegD6 + | RegD7";; + +time define_type "AddressRegister + = RegA0 + | RegA1 + | RegA2 + | RegA3 + | RegA4 + | RegA5 + | RegA6 + | RegA7";; + +time define_type "DataOrAddressRegister + = data DataRegister + | address AddressRegister";; + +time define_type "Condition + = Hi + | Ls + | Cc + | Cs + | Ne + | Eq + | Vc + | Vs + | Pl + | Mi + | Ge + | Lt + | Gt + | Le";; + +time define_type "AddressingMode + = immediate num + | direct DataOrAddressRegister + | indirect AddressRegister + | postinc AddressRegister + | predec AddressRegister + | indirectdisp num AddressRegister + | indirectindex num AddressRegister DataOrAddressRegister Size + | absolute num + | pcdisp num + | pcindex num DataOrAddressRegister Size";; + +time define_type "M68kInstruction + = ABCD AddressingMode AddressingMode + | ADD Size AddressingMode AddressingMode + | ADDA Size AddressingMode AddressRegister + | ADDI Size num AddressingMode + | ADDQ Size num AddressingMode + | ADDX Size AddressingMode AddressingMode + | AND Size AddressingMode AddressingMode + | ANDI Size num AddressingMode + | ANDItoCCR num + | ANDItoSR num + | ASL Size AddressingMode DataRegister + | ASLW AddressingMode + | ASR Size AddressingMode DataRegister + | ASRW AddressingMode + | Bcc Condition Size num + | BTST Size AddressingMode AddressingMode + | BCHG Size AddressingMode AddressingMode + | BCLR Size AddressingMode AddressingMode + | BSET Size AddressingMode AddressingMode + | BRA Size num + | BSR Size num + | CHK AddressingMode DataRegister + | CLR Size AddressingMode + | CMP Size AddressingMode DataRegister + | CMPA Size AddressingMode AddressRegister + | CMPI Size num AddressingMode + | CMPM Size AddressRegister AddressRegister + | DBT DataRegister num + | DBF DataRegister num + | DBcc Condition DataRegister num + | DIVS AddressingMode DataRegister + | DIVU AddressingMode DataRegister + | EOR Size DataRegister AddressingMode + | EORI Size num AddressingMode + | EORItoCCR num + | EORItoSR num + | EXG DataOrAddressRegister DataOrAddressRegister + | EXT Size DataRegister + | ILLEGAL + | JMP AddressingMode + | JSR AddressingMode + | LEA AddressingMode AddressRegister + | LINK AddressRegister num + | LSL Size AddressingMode DataRegister + | LSLW AddressingMode + | LSR Size AddressingMode DataRegister + | LSRW AddressingMode + | MOVE Size AddressingMode AddressingMode + | MOVEtoCCR AddressingMode + | MOVEtoSR AddressingMode + | MOVEfromSR AddressingMode + | MOVEtoUSP AddressingMode + | MOVEfromUSP AddressingMode + | MOVEA Size AddressingMode AddressRegister + | MOVEMto Size AddressingMode DataOrAddressRegister list + | MOVEMfrom Size DataOrAddressRegister list AddressingMode + | MOVEP Size AddressingMode AddressingMode + | MOVEQ num DataRegister + | MULS AddressingMode DataRegister + | MULU AddressingMode DataRegister + | NBCD AddressingMode + | NEG Size AddressingMode + | NEGX Size AddressingMode + | NOP + | NOT Size AddressingMode + | OR Size AddressingMode AddressingMode + | ORI Size num AddressingMode + | ORItoCCR num + | ORItoSR num + | PEA AddressingMode + | RESET + | ROL Size AddressingMode DataRegister + | ROLW AddressingMode + | ROR Size AddressingMode DataRegister + | RORW AddressingMode + | ROXL Size AddressingMode DataRegister + | ROXLW AddressingMode + | ROXR Size AddressingMode DataRegister + | ROXRW AddressingMode + | RTE + | RTR + | RTS + | SBCD AddressingMode AddressingMode + | ST AddressingMode + | SF AddressingMode + | Scc Condition AddressingMode + | STOP num + | SUB Size AddressingMode AddressingMode + | SUBA Size AddressingMode AddressingMode + | SUBI Size num AddressingMode + | SUBQ Size num AddressingMode + | SUBX Size AddressingMode AddressingMode + | SWAP DataRegister + | TAS AddressingMode + | TRAP num + | TRAPV + | TST Size AddressingMode + | UNLK AddressRegister";; + +(* ------------------------------------------------------------------------- *) +(* Example from Myra VanInwegen: part of the syntax of SML. *) +(* ------------------------------------------------------------------------- *) + +let string_INDUCTION,string_RECURSION = time define_type + "string = EMPTY_STRING | CONS_STRING num string";; + +let strid_INDUCTION,strid_RECURSION = time define_type + "strid = STRID string; + var = VAR string; + con = CON string; + scon = SCINT int | SCSTR string; + excon = EXCON string; + label = LABEL string";; + +let nonemptylist_INDUCTION,nonemptylist_RECURSION = time define_type + "nonemptylist = Head_and_tail A (A list)";; + +let long_INDUCTION,long_RECURSION = time define_type + "long = BASE A | QUALIFIED strid long";; + +let myra_INDUCTION,myra_RECURSION = time define_type + "atpat_e = WILDCARDatpat_e + | SCONatpat_e scon + | VARatpat_e var + | CONatpat_e (con long) + | EXCONatpat_e (excon long) + | RECORDatpat_e (patrow_e option) + | PARatpat_e pat_e; + + patrow_e = DOTDOTDOT_e + | PATROW_e label pat_e (patrow_e option); + + pat_e = ATPATpat_e atpat_e + | CONpat_e (con long) atpat_e + | EXCONpat_e (excon long) atpat_e + | LAYEREDpat_e var pat_e; + + conbind_e = CONBIND_e con (conbind_e option); + + datbind_e = DATBIND_e conbind_e (datbind_e option); + + exbind_e = EXBIND1_e excon (exbind_e option) + | EXBIND2_e excon (excon long) (exbind_e option); + + atexp_e = SCONatexp_e scon + | VARatexp_e (var long) + | CONatexp_e (con long) + | EXCONatexp_e (excon long) + | RECORDatexp_e (exprow_e option) + | LETatexp_e dec_e exp_e + | PARatexp_e exp_e; + + exprow_e = EXPROW_e label exp_e (exprow_e option); + + exp_e = ATEXPexp_e atexp_e + | APPexp_e exp_e atexp_e + | HANDLEexp_e exp_e match_e + | RAISEexp_e exp_e + | FNexp_e match_e; + + match_e = MATCH_e mrule_e (match_e option); + + mrule_e = MRULE_e pat_e exp_e; + + dec_e = VALdec_e valbind_e + | DATATYPEdec_e datbind_e + | ABSTYPEdec_e datbind_e dec_e + | EXCEPTdec_e exbind_e + | LOCALdec_e dec_e dec_e + | OPENdec_e ((strid long) nonemptylist) + | EMPTYdec_e + | SEQdec_e dec_e dec_e; + + valbind_e = PLAINvalbind_e pat_e exp_e (valbind_e option) + | RECvalbind_e valbind_e";; + +(* ------------------------------------------------------------------------- *) +(* Example from Daryl Stewart: a Verilog grammar. *) +(* ------------------------------------------------------------------------- *) + +let daryl_INDUCTION,daryl_RECURSION = time define_type + "Source_text + = module string (string list) (Module_item list) + | Source_textMeta string; + Module_item + = declaration Declaration + | initial Statement + | always Statement + | assign Lvalue Exprn + | Module_itemMeta string; + Declaration + = reg_declaration (Range option) (string list) + | net_declaration (Range option) (string list) + | input_declaration (Range option) (string list) + | output_declaration (Range option) (string list) + | DeclarationMeta string; + Range = range Exprn Exprn | RangeMeta string; + Statement + = clock_statement Clock Statement_or_null + | blocking_assignment Lvalue Exprn + | non_blocking_assignment Lvalue Exprn + | conditional_statement + Exprn Statement_or_null (Statement_or_null option) + | case_statement Exprn (Case_item list) + | while_loop Exprn Statement + | repeat_loop Exprn Statement + | for_loop + Lvalue Exprn Exprn Lvalue Exprn Statement + | forever_loop Statement + | disable string + | seq_block (string option) (Statement list) + | StatementMeta string; + Statement_or_null + = statement Statement | null_statement | Statement_or_nullMeta string; + Clock + = posedge string + | negedge string + | clock string + | ClockMeta string; + Case_item + = case_item (Exprn list) Statement_or_null + | default_case_item Statement_or_null + | Case_itemMeta string; + Exprn + = plus Exprn Exprn + | minus Exprn Exprn + | lshift Exprn Exprn + | rshift Exprn Exprn + | lt Exprn Exprn + | leq Exprn Exprn + | gt Exprn Exprn + | geq Exprn Exprn + | logeq Exprn Exprn + | logneq Exprn Exprn + | caseeq Exprn Exprn + | caseneq Exprn Exprn + | bitand Exprn Exprn + | bitxor Exprn Exprn + | bitor Exprn Exprn + | logand Exprn Exprn + | logor Exprn Exprn + | conditional Exprn Exprn Exprn + | positive Primary + | negative Primary + | lognot Primary + | bitnot Primary + | reducand Primary + | reducxor Primary + | reducor Primary + | reducnand Primary + | reducxnor Primary + | reducnor Primary + | primary Primary + | ExpressionMeta string; + Primary + = primary_number Number + | primary_IDENTIFIER string + | primary_bit_select string Exprn + | primary_part_select string Exprn Exprn + | primary_gen_bit_select Exprn Exprn + | primary_gen_part_select Exprn Exprn Exprn + | primary_concatenation Concatenation + | primary_multiple_concatenation Multiple_concatenation + | brackets Exprn + | PrimaryMeta string; + Lvalue + = lvalue string + | lvalue_bit_select string Exprn + | lvalue_part_select string Exprn Exprn + | lvalue_concatenation Concatenation + | LvalueMeta string; + Number + = decimal string + | based string option string + | NumberMeta string; + Concatenation + = concatenation (Exprn list) | ConcatenationMeta string; + Multiple_concatenation + = multiple_concatenation Exprn (Exprn list) + | Multiple_concatenationMeta string; + meta + = Meta_Source_text Source_text + | Meta_Module_item Module_item + | Meta_Declaration Declaration + | Meta_Range Range + | Meta_Statement Statement + | Meta_Statement_or_null Statement_or_null + | Meta_Clock Clock + | Meta_Case_item Case_item + | Meta_Expression Exprn + | Meta_Primary Primary + | Meta_Lvalue Lvalue + | Meta_Number Number + | Meta_Concatenation Concatenation + | Meta_Multiple_concatenation Multiple_concatenation";; diff --git a/Examples/reduct.ml b/Examples/reduct.ml new file mode 100644 index 0000000..471e3bf --- /dev/null +++ b/Examples/reduct.ml @@ -0,0 +1,453 @@ +(* ========================================================================= *) +(* General "reduction" properties of binary relations, *) +(* ========================================================================= *) + +needs "Library/rstc.ml";; + +(* ------------------------------------------------------------------------- *) +(* Field of a binary relation. *) +(* ------------------------------------------------------------------------- *) + +let FL = new_definition + `FL(R) x <=> (?y:A. R x y) \/ (?y. R y x)`;; + +(* ------------------------------------------------------------------------ *) +(* Normality of a term w.r.t. a reduction relation *) +(* ------------------------------------------------------------------------ *) + +let NORMAL = new_definition + `NORMAL(R:A->A->bool) x <=> ~(?y. R x y)`;; + +(* ------------------------------------------------------------------------ *) +(* Full Church-Rosser property. *) +(* *) +(* Note that we deviate from most term rewriting literature which call this *) +(* the "diamond property" and calls a relation "Church-Rosser" iff its RTC *) +(* has the diamond property. But this seems simpler and more natural. *) +(* ------------------------------------------------------------------------ *) + +let CR = new_definition + `CR(R:A->A->bool) <=> !x y1 y2. R x y1 /\ R x y2 ==> ?z. R y1 z /\ R y2 z`;; + +(* ------------------------------------------------------------------------ *) +(* Weak Church-Rosser property, i.e. the rejoining may take several steps. *) +(* ------------------------------------------------------------------------ *) + +let WCR = new_definition + `WCR(R:A->A->bool) <=> + !x y1 y2. R x y1 /\ R x y2 ==> ?z. RTC R y1 z /\ RTC R y2 z`;; + +(* ------------------------------------------------------------------------ *) +(* (Weak) normalization: every term has a normal form. *) +(* ------------------------------------------------------------------------ *) + +let WN = new_definition + `WN(R:A->A->bool) <=> !x. ?y. RTC R x y /\ NORMAL(R) y`;; + +(* ------------------------------------------------------------------------ *) +(* Strong normalization: every reduction sequence terminates (Noetherian) *) +(* ------------------------------------------------------------------------ *) + +let SN = new_definition + `SN(R:A->A->bool) <=> ~(?seq. !n. R (seq n) (seq (SUC n)))`;; + +(* ------------------------------------------------------------------------- *) +(* Definition of a tree. *) +(* ------------------------------------------------------------------------- *) + +let TREE = new_definition + `TREE(R:A->A->bool) <=> + (!y. ~(TC R y y)) /\ + ?a. a IN FL(R) /\ + !y. y IN FL(R) ==> (y = a) \/ TC R a y /\ ?!x. R x y`;; + +(* ------------------------------------------------------------------------- *) +(* Local finiteness (finitely branching). *) +(* ------------------------------------------------------------------------- *) + +let LF = new_definition + `LF(R:A->A->bool) <=> !x. FINITE {y | R x y}`;; + +(* ------------------------------------------------------------------------- *) +(* Wellfoundedness apparatus for SN relations. *) +(* ------------------------------------------------------------------------- *) + +let SN_WF = prove + (`!R:A->A->bool. SN(R) <=> WF(INV R)`, + REWRITE_TAC[SN; WF_DCHAIN; INV]);; + +let SN_PRESERVE = prove + (`!R:A->A->bool. SN(R) <=> !P. (!x. P x ==> ?y. P y /\ R x y) ==> ~(?x. P x)`, + REWRITE_TAC[SN_WF; WF; INV] THEN MESON_TAC[]);; + +let SN_NOETHERIAN = prove + (`!R:A->A->bool. SN(R) <=> !P. (!x. (!y. R x y ==> P y) ==> P x) ==> !x. P x`, + REWRITE_TAC[WF_IND; SN_WF; INV]);; + +(* ------------------------------------------------------------------------ *) +(* Normality and weak normalization is preserved by transitive closure. *) +(* ------------------------------------------------------------------------ *) + +let NORMAL_TC = prove + (`!R:A->A->bool. NORMAL(TC R) x <=> NORMAL(R) x`, + REWRITE_TAC[NORMAL] THEN MESON_TAC[TC_CASES_R; TC_INC]);; + +let NORMAL_RTC = prove + (`!R:A->A->bool. NORMAL(R) x ==> !y. RTC R x y <=> (x = y)`, + ONCE_REWRITE_TAC[GSYM NORMAL_TC] THEN + REWRITE_TAC[NORMAL; RTC; RC_EXPLICIT] THEN MESON_TAC[]);; + +let WN_TC = prove + (`!R:A->A->bool. WN(TC R) <=> WN R`, + REWRITE_TAC[WN; NORMAL_TC; RTC; TC_IDEMP]);; + +(* ------------------------------------------------------------------------- *) +(* Wellfoundedness and strong normalization are too. *) +(* ------------------------------------------------------------------------- *) + +let WF_TC = prove + (`!R:A->A->bool. WF(TC R) <=> WF(R)`, + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[WF_SUBSET; TC_INC]; + REWRITE_TAC[WF] THEN DISCH_TAC THEN X_GEN_TAC `P:A->bool` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\y:A. ?z. P z /\ TC(R) z y`) THEN + REWRITE_TAC[] THEN MESON_TAC[TC_CASES_L]]);; + +(******************* Alternative --- intuitionistic --- proof + +let WF_TC = prove + (`!R:A->A->bool. WF(TC R) <=> WF(R)`, + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[WF_SUBSET; TC_INC]; + REWRITE_TAC[WF_IND]] THEN + DISCH_TAC THEN GEN_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\z:A. !u:A. TC(R) u z ==> P(u)`) THEN + REWRITE_TAC[] THEN MESON_TAC[TC_CASES_L]);; + +let WF_TC_EXPLICIT = prove + (`!R:A->A->bool. WF(R) ==> WF(TC(R))`, + GEN_TAC THEN REWRITE_TAC[WF_IND] THEN DISCH_TAC THEN + GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\z:A. !u:A. TC(R) u z ==> P(u)`) THEN + REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `z:A` THEN + FIRST_ASSUM MATCH_MP_TAC THEN SPEC_TAC(`z:A`,`z:A`) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) + [RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + DISCH_TAC THEN X_GEN_TAC `u:A` THEN + ONCE_REWRITE_TAC[TC_CASES_L] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_TAC THEN + MATCH_MP_TAC(ASSUME `!x:A. (!y. TC R y x ==> P y) ==> P x`) THEN + X_GEN_TAC `v:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `u:A` THEN CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; + DISCH_THEN(X_CHOOSE_THEN `w:A` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `w:A` THEN + CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; + +***********************) + +let SN_TC = prove + (`!R:A->A->bool. SN(TC R) <=> SN R`, + GEN_TAC THEN REWRITE_TAC[SN_WF; GSYM TC_INV; WF_TC]);; + +(* ------------------------------------------------------------------------ *) +(* Strong normalization implies normalization *) +(* ------------------------------------------------------------------------ *) + +let SN_WN = prove + (`!R:A->A->bool. SN(R) ==> WN(R)`, + GEN_TAC THEN REWRITE_TAC[SN_WF; WF; WN] THEN DISCH_TAC THEN + X_GEN_TAC `a:A` THEN POP_ASSUM(MP_TAC o SPEC `\y:A. RTC R a y`) THEN + REWRITE_TAC[INV; NORMAL] THEN MESON_TAC[RTC_REFL; RTC_TRANS_L]);; + +(* ------------------------------------------------------------------------ *) +(* Reflexive closure preserves Church-Rosser property (pretty trivial) *) +(* ------------------------------------------------------------------------ *) + +let RC_CR = prove + (`!R:A->A->bool. CR(R) ==> CR(RC R)`, + REWRITE_TAC[CR; RC_EXPLICIT] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* The strip lemma leads us halfway to the fact that transitive x *) +(* closure preserves the Church-Rosser property. It's no harder / \ *) +(* to prove it for two separate reduction relations. This then / y2 *) +(* allows us to prove the desired theorem simply by using the / / *) +(* strip lemma twice with a bit of conjunct-swapping. y1 / *) +(* \ / *) +(* The diagram on the right shows the use of the variables. z *) +(* ------------------------------------------------------------------------ *) + +let STRIP_LEMMA = prove + (`!R S. (!x y1 y2. R x y1 /\ S x y2 ==> ?z:A. S y1 z /\ R y2 z) ==> + (!x y1 y2. TC R x y1 /\ S x y2 ==> ?z:A. S y1 z /\ TC R y2 z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> (b ==> c)`] THEN + REWRITE_TAC[GSYM RIGHT_IMP_FORALL_THM] THEN + MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[TC_INC; TC_TRANS]);; + +(* ------------------------------------------------------------------------ *) +(* Transitive closure preserves Church-Rosser property. *) +(* ------------------------------------------------------------------------ *) + +let TC_CR = prove + (`!R:A->A->bool. CR(R) ==> CR(TC R)`, + GEN_TAC THEN REWRITE_TAC[CR] THEN DISCH_TAC THEN + MATCH_MP_TAC STRIP_LEMMA THEN REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + RULE_INDUCT_TAC STRIP_LEMMA THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Reflexive transitive closure preserves Church-Rosser property. *) +(* ------------------------------------------------------------------------ *) + +let RTC_CR = prove + (`!R:A->A->bool. CR(R) ==> CR(RTC R)`, + REWRITE_TAC[RTC] THEN MESON_TAC[RC_CR; TC_CR]);; + +(* ------------------------------------------------------------------------ *) +(* Equivalent `Church-Rosser` property for the equivalence relation. *) +(* ------------------------------------------------------------------------ *) + +let STC_CR = prove + (`!R:A->A->bool. CR(RTC R) <=> + !x y. RSTC R x y ==> ?z:A. RTC R x z /\ RTC R y z`, + GEN_TAC THEN REWRITE_TAC[CR] THEN EQ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC RSTC_INDUCT THEN + ASM_MESON_TAC[RTC_REFL; RTC_INC; RTC_TRANS]; + MESON_TAC[RSTC_INC_RTC; RSTC_SYM; RSTC_TRANS]]);; + +(* ------------------------------------------------------------------------ *) +(* Under normalization, Church-Rosser is equivalent to uniqueness of NF *) +(* ------------------------------------------------------------------------ *) + +let NORM_CR = prove + (`!R:A->A->bool. WN(R) ==> + (CR(RTC R) <=> (!x y1 y2. RTC R x y1 /\ NORMAL(R) y1 /\ + RTC R x y2 /\ NORMAL(R) y2 ==> (y1 = y2)))`, + GEN_TAC THEN REWRITE_TAC[CR; WN] THEN DISCH_TAC THEN EQ_TAC THENL + [MESON_TAC[NORMAL_RTC]; ASM_MESON_TAC[RTC_TRANS]]);; + +(* ------------------------------------------------------------------------ *) +(* Normalizing and Church-Rosser iff every term has a unique normal form *) +(* ------------------------------------------------------------------------ *) + +let CR_NORM = prove + (`!R:A->A->bool. WN(R) /\ CR(RTC R) <=> !x. ?!y. RTC R x y /\ NORMAL(R) y`, + GEN_TAC THEN ONCE_REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + REWRITE_TAC[FORALL_AND_THM; GSYM WN] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP NORM_CR th]) THEN + REWRITE_TAC[CONJ_ASSOC]);; + +(* ------------------------------------------------------------------------ *) +(* Newman's lemma: weak Church-Rosser plus x *) +(* strong normalization implies full Church- / \ *) +(* Rosser. By the above (and SN ==> WN) it z1 z2 *) +(* is sufficient to show normal forms are / | | \ *) +(* unique. We use the Noetherian induction / \ / \ *) +(* form of SN, so we need only prove that if / z \ *) +(* some term has multiple normal forms, so / | \ *) +(* does a `successor`. See the diagram on the / | \ *) +(* right for the use of variables. y1 w y2 *) +(* ------------------------------------------------------------------------ *) + +let NEWMAN_LEMMA = prove + (`!R:A->A->bool. SN(R) /\ WCR(R) ==> CR(RTC R)`, + GEN_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SN_WN) THEN + DISCH_THEN(fun th -> ASSUME_TAC(REWRITE_RULE[WN] th) THEN MP_TAC th) THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP NORM_CR th]) THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND; SN_WF]) THEN + REWRITE_TAC[INV] THEN X_GEN_TAC `x:A` THEN REPEAT STRIP_TAC THEN + MAP_EVERY UNDISCH_TAC [`RTC R (x:A) y1`; `RTC R (x:A) y2`] THEN + ONCE_REWRITE_TAC[RTC_CASES_R] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `z2:A`)) THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `z1:A`)) THENL + [ASM_MESON_TAC[];ASM_MESON_TAC[NORMAL];ASM_MESON_TAC[NORMAL]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [WCR]) THEN + ASM_MESON_TAC[RTC_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* A variant of Koenig's lemma. *) +(* ------------------------------------------------------------------------- *) + +let LF_TC_FINITE = prove + (`!R. LF(R) /\ SN(R) ==> !x:A. FINITE {y | TC(R) x y}`, + GEN_TAC THEN REWRITE_TAC[LF] THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND; SN_WF; INV]) THEN + GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN + `{y:A | TC(R) x y} = {y | R x y} UNION + (UNIONS { s | ?z. R x z /\ (s = {y | TC(R) z y})})` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIONS] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[IN] THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [TC_CASES_R] THEN + AP_TERM_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[FINITE_UNION; FINITE_UNIONS] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\z:A. {y | TC R z y}`; `{z | (R:A->A->bool) x z}`] + FINITE_IMAGE_EXPAND) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN; IN_ELIM_THM]; + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [IN_ELIM_THM] THEN + REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; + +let SN_NOLOOP = prove + (`!R:A->A->bool. SN(R) ==> !z. ~(TC(R) z z)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM SN_TC] THEN + SPEC_TAC(`TC(R:A->A->bool)`,`R:A->A->bool`) THEN + GEN_TAC THEN REWRITE_TAC[SN_WF; INV; WF] THEN + DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `\x:A. x = z`) THEN + REWRITE_TAC[] THEN MESON_TAC[]);; + +let RELPOW_RTC = prove + (`!R:A->A->bool. !n x y. RELPOW n R x y ==> RTC(R) x y`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[RELPOW] THEN + ASM_MESON_TAC[RTC_REFL; RTC_TRANS_L]);; + +let RTC_TC_LEMMA = prove + (`!R x:A. {y:A | RTC(R) x y} = x INSERT {y:A | TC(R) x y}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN + REWRITE_TAC[RTC; RC_EXPLICIT; DISJ_ACI; EQ_SYM_EQ]);; + +let HAS_SIZE_SUBSET = prove + (`!s:A->bool t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ s SUBSET t ==> m <= n`, + REWRITE_TAC[HAS_SIZE] THEN MESON_TAC[CARD_SUBSET]);; + +let FC_FINITE_BOUND_LEMMA = prove + (`!R. (!z. ~(TC R z z)) + ==> !n. {y:A | RTC(R) x y} HAS_SIZE n + ==> !m y. RELPOW m R x y ==> m <= n`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC o + REWRITE_RULE[RELPOW_SEQUENCE]) THEN + SUBGOAL_THEN `!i. i <= m ==> RELPOW i R (x:A) (f i)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[RELPOW] THEN + REWRITE_TAC[LE_SUC_LT] THEN ASM_MESON_TAC[LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN `{z:A | ?i:num. i < m /\ (z = f i)} SUBSET {y | RTC R x y}` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[RELPOW_RTC; LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `!p. p <= m ==> {z:A | ?i. i < p /\ (z = f i)} HAS_SIZE p` + (fun th -> ASSUME_TAC(MATCH_MP th (SPEC `m:num` LE_REFL))) THENL + [ALL_TAC; + MATCH_MP_TAC HAS_SIZE_SUBSET THEN + EXISTS_TAC `{z:A | ?i. i < m /\ (z = f i)}` THEN + EXISTS_TAC `{y:A | RTC(R) x y}` THEN ASM_REWRITE_TAC[]] THEN + INDUCT_TAC THEN DISCH_TAC THENL + [REWRITE_TAC[HAS_SIZE_0; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; LT]; + ALL_TAC] THEN + SUBGOAL_THEN `{z:A | ?i. i < SUC p /\ (z = f i)} = + f(p) INSERT {z | ?i. i < p /\ (z = f i)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN + REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE; CARD_CLAUSES; SUC_INJ] THEN + SUBGOAL_THEN `{z:A | ?i. i < p /\ (z = f i)} HAS_SIZE p` MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `SUC p <= m` THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (CONJUNCT2 CARD_CLAUSES) th]) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[FINITE_INSERT] THEN + UNDISCH_TAC `f p IN {z:A | ?i:num. i < p /\ (z = f i)}` THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN + X_GEN_TAC `q:num` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `TC(R) ((f:num->A) q) (f p)` (fun th -> ASM_MESON_TAC[th]) THEN + UNDISCH_TAC `SUC p <= m` THEN UNDISCH_TAC `q < p` THEN + REWRITE_TAC[LT_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN + MATCH_MP_TAC TC_INC THEN FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `SUC (SUC q) <= m` THEN ARITH_TAC; + DISCH_TAC THEN MATCH_MP_TAC TC_TRANS_L THEN + EXISTS_TAC `(f:num->A)(q + SUC d)` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[ADD_CLAUSES]] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `SUC (q + SUC (SUC d)) <= m` THEN ARITH_TAC]);; + +let FC_FINITE_BOUND = prove + (`!R (x:A). FINITE {y | RTC(R) x y} /\ + (!z. ~(TC R z z)) + ==> ?N. !n y. RELPOW n R x y ==> n <= N`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_TAC THEN EXISTS_TAC `CARD {y:A | RTC(R) x y}` THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP FC_FINITE_BOUND_LEMMA) THEN + ASM_REWRITE_TAC[HAS_SIZE]);; + +let BOUND_SN = prove + (`!R. (!x:A. ?N. !n y. RELPOW n R x y ==> n <= N) ==> SN(R)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SN_WF; WF_DCHAIN; INV] THEN + DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:num->A) 0`) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` + (MP_TAC o SPECL [`SUC N`; `f(SUC N):A`])) THEN + REWRITE_TAC[GSYM NOT_LT; LT] THEN + SUBGOAL_THEN `!n. RELPOW n R (f 0 :A) (f n)` (fun th -> REWRITE_TAC[th]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[RELPOW] THEN ASM_MESON_TAC[]);; + +let LF_SN_BOUND = prove + (`!R. LF(R) ==> (SN(R) <=> !x:A. ?N. !n y. RELPOW n R x y ==> n <= N)`, + GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUND_SN] THEN + DISCH_TAC THEN GEN_TAC THEN MATCH_MP_TAC FC_FINITE_BOUND THEN CONJ_TAC THENL + [SPEC_TAC(`x:A`,`x:A`) THEN REWRITE_TAC[RTC_TC_LEMMA; FINITE_INSERT] THEN + MATCH_MP_TAC LF_TC_FINITE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SN_NOLOOP THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Koenig's lemma. *) +(* ------------------------------------------------------------------------- *) + +let TREE_FL = prove + (`!R. TREE(R) ==> ?a:A. FL(R) = {y | RTC(R) a y}`, + GEN_TAC THEN REWRITE_TAC[TREE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `a:A` THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[RTC; RC_EXPLICIT] THEN + MESON_TAC[]; ONCE_REWRITE_TAC[RTC_CASES_L] THEN ASM_MESON_TAC[IN; FL]]);; + +let KOENIG_LEMMA = prove + (`!R:A->A->bool. TREE(R) /\ LF(R) /\ SN(R) ==> FINITE (FL R)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` SUBST1_TAC o MATCH_MP TREE_FL) THEN + REWRITE_TAC[RTC_TC_LEMMA; FINITE_INSERT] THEN + SPEC_TAC(`a:A`,`a:A`) THEN MATCH_MP_TAC LF_TC_FINITE THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Rephrasing in terms of joinability. *) +(* ------------------------------------------------------------------------- *) + +let JOINABLE = new_definition + `JOINABLE R s t <=> ?u. RTC R s u /\ RTC R t u`;; + +let JOINABLE_REFL = prove + (`!R t. JOINABLE R t t`, + REWRITE_TAC[JOINABLE] THEN MESON_TAC[RTC_CASES]);; + +let JOINABLE_SYM = prove + (`!R s t. JOINABLE R s t <=> JOINABLE R t s`, + REWRITE_TAC[JOINABLE] THEN MESON_TAC[]);; + +let JOINABLE_TRANS_R = prove + (`!R s t u. R s t /\ JOINABLE R t u ==> JOINABLE R s u`, + REWRITE_TAC[JOINABLE] THEN MESON_TAC[RTC_CASES_R]);; + +let CR_RSTC_JOINABLE = prove + (`!R. CR(RTC R) ==> !x:A y. RSTC(R) x y <=> JOINABLE(R) x y`, + GEN_TAC THEN REWRITE_TAC[STC_CR; JOINABLE] THEN + ASM_MESON_TAC[RSTC_TRANS; RSTC_SYM; RSTC_INC_RTC]);; + +(* ------------------------------------------------------------------------- *) +(* CR is equivalent to transitivity of joinability. *) +(* ------------------------------------------------------------------------- *) + +let JOINABLE_TRANS = prove + (`!R. CR(RTC R) <=> + !x y z. JOINABLE(R) x y /\ JOINABLE(R) y z ==> JOINABLE(R) x z`, + REWRITE_TAC[CR; JOINABLE] THEN MESON_TAC[RTC_REFL; RTC_TRANS; RTC_SYM]);; diff --git a/Examples/schnirelmann.ml b/Examples/schnirelmann.ml new file mode 100644 index 0000000..a647557 --- /dev/null +++ b/Examples/schnirelmann.ml @@ -0,0 +1,544 @@ +(* ========================================================================= *) +(* Schnirelmann density and its basic properties (not Mann's theorem yet). *) +(* ========================================================================= *) + +needs "Multivariate/misc.ml";; +needs "Library/products.ml";; +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* The basic definition. *) +(* ------------------------------------------------------------------------- *) + +let count = new_definition + `count s n = CARD (s INTER (1..n))`;; + +let schnirelmann = new_definition + `schnirelmann s = inf { &(count s n) / &n | 1 <= n}`;; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of the "count" function. *) +(* ------------------------------------------------------------------------- *) + +let COUNT_BOUND = prove + (`!s. count s n <= n`, + GEN_TAC THEN REWRITE_TAC[count] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN SET_TAC[]);; + +let COUNT_UNIV = prove + (`!n. count (:num) n = n`, + REWRITE_TAC[count; INTER_UNIV; CARD_NUMSEG_1]);; + +let COUNT_MONO = prove + (`!s t n. s SUBSET t ==> count s n <= count t n`, + REPEAT STRIP_TAC THEN REWRITE_TAC[count] THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN ASM SET_TAC[]);; + +let COUNT_INSENSITIVE = prove + (`!s t n. (!m. 1 <= m ==> (m IN s <=> m IN t)) + ==> count s n = count t n`, + REPEAT STRIP_TAC THEN REWRITE_TAC[count] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The straightforward properties of Schnirelmann density. *) +(* ------------------------------------------------------------------------- *) + +let SCHNIRELMANN_UBOUND,SCHNIRELMANN_LBOUND = (CONJ_PAIR o prove) + (`(!n. 1 <= n ==> schnirelmann s <= &(count s n) / &n) /\ + (!b. (!n. 1 <= n ==> b <= &(count s n) / &n) ==> b <= schnirelmann s)`, + MP_TAC(ISPEC `{ &(count s n) / &n | 1 <= n}` INF) THEN + SIMP_TAC[SET_RULE `(!x. x IN {f x | P x} ==> Q x) <=> !x. P x ==> Q(f x)`; + GSYM schnirelmann] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [SET_TAC[LE_REFL]; ALL_TAC] THEN + EXISTS_TAC `&0` THEN SIMP_TAC[REAL_LE_DIV; REAL_POS]; + MESON_TAC[]]);; + +let SCHNIRELMANN_UBOUND_MUL = prove + (`!n s. schnirelmann s * &n <= &(count s n)`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_POS] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; + SCHNIRELMANN_UBOUND]);; + +let SCHNIRELMANN_BOUNDS = prove + (`!s. &0 <= schnirelmann s /\ schnirelmann s <= &1`, + GEN_TAC THEN REWRITE_TAC[schnirelmann] THEN + MATCH_MP_TAC REAL_INF_BOUNDS THEN + CONJ_TAC THENL [SET_TAC[LE_REFL]; ALL_TAC] THEN + SIMP_TAC[SET_RULE `(!x. x IN {f x | P x} ==> Q x) <=> !x. P x ==> Q(f x)`; + REAL_LE_DIV; REAL_POS; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE; COUNT_BOUND]);; + +let SCHNIRELMANN_MONO = prove + (`!s t. s SUBSET t ==> schnirelmann s <= schnirelmann t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHNIRELMANN_LBOUND THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(count s n) / &n` THEN ASM_SIMP_TAC[SCHNIRELMANN_UBOUND] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; COUNT_MONO]);; + +let SCHNIRELMANN_INSENSITIVE = prove + (`!s t. (!n. 1 <= n ==> (n IN s <=> n IN t)) + ==> schnirelmann s = schnirelmann t`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COUNT_INSENSITIVE) THEN + SIMP_TAC[schnirelmann]);; + +let SCHNIRELMANN_SENSITIVE = prove + (`!s k. 1 <= k /\ ~(k IN s) ==> schnirelmann s <= &1 - &1 / &k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(count s k) / &k` THEN + ASM_SIMP_TAC[SCHNIRELMANN_UBOUND] THEN + ASM_SIMP_TAC[REAL_FIELD `&1 <= x ==> (&1 - &1 / x) = (x - &1) / x`; + REAL_OF_NUM_LE; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[REAL_OF_NUM_SUB; REAL_OF_NUM_LE; count] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[FINITE_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_INTER] THEN + ASM_MESON_TAC[ARITH_RULE `1 <= k ==> (x <= k - 1 <=> x <= k /\ ~(x = k))`]);; + +let SCHNIRELMANN_SENSITIVE_1 = prove + (`!s. ~(1 IN s) ==> schnirelmann s = &0`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:num->bool`; `1`] SCHNIRELMANN_SENSITIVE) THEN + MP_TAC(SPEC `s:num->bool` SCHNIRELMANN_BOUNDS) THEN + ASM_REWRITE_TAC[LE_REFL] THEN REAL_ARITH_TAC);; + +let SCHNIRELMANN_UNIV = prove + (`schnirelmann(:num) = &1`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; SCHNIRELMANN_BOUNDS] THEN + MATCH_MP_TAC SCHNIRELMANN_LBOUND THEN + SIMP_TAC[COUNT_UNIV; REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_1; REAL_LE_REFL]);; + +let SCHNIRELMANN_EQ_1 = prove + (`!s. schnirelmann s = &1 <=> !n. 1 <= n ==> n IN s`, + GEN_TAC THEN EQ_TAC THENL + [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_UNIV; NOT_IMP] THEN + DISCH_THEN(CHOOSE_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SCHNIRELMANN_SENSITIVE) THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> s <= &1 - x ==> ~(s = &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; ARITH]; + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SCHNIRELMANN_UNIV] THEN + MATCH_MP_TAC SCHNIRELMANN_INSENSITIVE THEN + ASM_REWRITE_TAC[IN_UNIV]]);; + +(* ------------------------------------------------------------------------- *) +(* Sum-sets. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("+++",(16,"right"));; + +let sumset = new_definition + `s +++ t = {x + y:num | x IN s /\ y IN t}`;; + +let SUMSET_0 = prove + (`!s t. 0 IN s /\ 0 IN t ==> 0 IN (s +++ t)`, + SIMP_TAC[sumset; IN_ELIM_THM] THEN MESON_TAC[ADD_CLAUSES]);; + +let SUMSET_SUPERSET_LZERO = prove + (`!s t. 0 IN s ==> t SUBSET (s +++ t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; sumset; IN_ELIM_THM] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`0`; `n:num`] THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; + +let SUMSET_SUPERSET_RZERO = prove + (`!s t. 0 IN t ==> s SUBSET (s +++ t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; sumset; IN_ELIM_THM] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`n:num`; `0`] THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; + +let SUMSET_SYM = prove + (`!s t. s +++ t = t +++ s`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; sumset] THEN MESON_TAC[ADD_SYM]);; + +let SUMSET_ASSOC = prove + (`!s t u. s +++ (t +++ u) = (s +++ t) +++ u`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; sumset] THEN MESON_TAC[ADD_ASSOC]);; + +let NEUTRAL_SUMSET = prove + (`neutral(+++) = {0}`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `s:num->bool` THEN + REWRITE_TAC[sumset; IN_ELIM_THM; EXTENSION; IN_SING] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `{0}`) THEN REWRITE_TAC[IN_SING]; ALL_TAC] THEN + MESON_TAC[ADD_CLAUSES]);; + +let MONOIDAL_SUMSET = prove + (`monoidal (+++)`, + REWRITE_TAC[monoidal; NEUTRAL_SUMSET; SUMSET_ASSOC] THEN + REWRITE_TAC[EQT_INTRO(SPEC_ALL SUMSET_SYM)] THEN + REWRITE_TAC[EXTENSION; sumset; IN_ELIM_THM; IN_SING] THEN + MESON_TAC[ADD_CLAUSES]);; + +let SUMSET_0_ITER = prove + (`!a s. FINITE s /\ (!k. k IN s ==> 0 IN a k) ==> 0 IN iterate(+++) s a`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_SUMSET; NEUTRAL_SUMSET; IN_SING] THEN + SIMP_TAC[IN_INSERT; SUMSET_0]);; + +(* ------------------------------------------------------------------------- *) +(* Basic Schnirelmann theorem. *) +(* ------------------------------------------------------------------------- *) + +let SCHNIRELMAN_LEMMA = prove + (`!s t n. 0 IN (s INTER t) /\ count s n + count t n >= n ==> n IN (s +++ t)`, + REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + ASM_CASES_TAC `(n:num) IN s` THENL + [ASM_MESON_TAC[SUMSET_SUPERSET_RZERO; SUBSET]; ALL_TAC] THEN + ASM_CASES_TAC `(n:num) IN t` THENL + [ASM_MESON_TAC[SUMSET_SUPERSET_LZERO; SUBSET]; ALL_TAC] THEN + ASM_CASES_TAC `n = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `~((s INTER (1..n-1)) INTER (IMAGE (\b. n - b) (t INTER (1..n-1))) = {})` + MP_TAC THENL + [MATCH_MP_TAC CARD_UNION_OVERLAP THEN + SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG; GT] THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(1..n-1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN + REWRITE_TAC[SUBSET; IN_UNION; FORALL_IN_IMAGE; FORALL_AND_THM; + TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CARD_NUMSEG_1] THEN + MATCH_MP_TAC(ARITH_RULE `~(n = 0) /\ n <= x ==> n - 1 < x`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `s + t:num >= n ==> a = s /\ b = t ==> n <= a + b`)) THEN + SUBGOAL_THEN `CARD(IMAGE (\b. n - b) (t INTER (1..n-1))) = count t (n - 1)` + SUBST1_TAC THENL + [REWRITE_TAC[count] THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN + SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[count] THEN CONJ_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[EXTENSION; IN_INTER; IN_NUMSEG; + ARITH_RULE `~(n = 0) ==> (x <= n - 1 <=> x <= n /\ ~(x = n))`] THEN + ASM_MESON_TAC[]; + UNDISCH_TAC `~(n IN s +++ t)` THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_IMAGE; IN_NUMSEG; + NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:num` THEN REWRITE_TAC[sumset; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `b:num`)) THEN + MAP_EVERY EXISTS_TAC [`a:num`; `b:num`] THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]);; + +let SCHNIRELMANN_THEOREM = prove + (`!s t. 0 IN (s INTER t) /\ schnirelmann s + schnirelmann t >= &1 + ==> s +++ t = (:num)`, + REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_MESON_TAC[SUMSET_SUPERSET_LZERO; SUBSET; IN_INTER]; ALL_TAC] THEN + MATCH_MP_TAC SCHNIRELMAN_LEMMA THEN ASM_REWRITE_TAC[IN_INTER] THEN + REWRITE_TAC[GE; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN REWRITE_TAC[GSYM real_div] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a + b >= &1 ==> a <= x /\ b <= y ==> &1 <= x + y`)) THEN + CONJ_TAC THEN MATCH_MP_TAC SCHNIRELMANN_UBOUND THEN ASM_ARITH_TAC);; + +let SCHNIRELMANN_THEOREM_2 = prove + (`!s. 0 IN s /\ schnirelmann s >= &1 / &2 ==> s +++ s = (:num)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHNIRELMANN_THEOREM THEN + ASM_REWRITE_TAC[IN_INTER] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Additional additivity properties and full Schnirelmann theorem. *) +(* ------------------------------------------------------------------------- *) + +let ENUMERATION_LEMMA = prove + (`!n s p. s HAS_SIZE n /\ (!k. k IN s ==> 1 <= k /\ k <= p) + ==> ?a:num->num. + a(0) = 0 /\ + a(n + 1) = p + 1 /\ + s = IMAGE a (1..n) /\ + (!j k. j <= n /\ k <= n + 1 /\ j < k ==> a(j) < a(k)) /\ + (!j k. j <= n /\ k <= n + 1 /\ j <= k ==> a(j) <= a(k))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(<=):num->num->bool` TOPOLOGICAL_SORT) THEN + REWRITE_TAC[LE_TRANS; LE_ANTISYM] THEN + DISCH_THEN(MP_TAC o SPECL [`n:num`; `s:num->bool`]) THEN + ASM_REWRITE_TAC[NOT_LE; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\i. if 1 <= i then if i <= n then f i else p + 1 else 0` THEN + ASM_REWRITE_TAC[ARITH; ARITH_RULE `1 <= n + 1 /\ ~(n + 1 <= n)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN + CONJ_TAC THENL [MESON_TAC[LE_LT]; ALL_TAC] THEN + SUBGOAL_THEN `!k. 1 <= k /\ k <= n ==> 1 <= f(k) /\ f(k) <= p` + ASSUME_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th)) THEN + ASM_ARITH_TAC);; + +let CARD_INTER_0_1 = prove + (`!n s. 0 IN s ==> CARD(s INTER (0..n)) = SUC(CARD(s INTER (1..n)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `s INTER (0..n) = 0 INSERT (s INTER (1..n))` SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `a IN s /\ (t = a INSERT u) + ==> (s INTER t = a INSERT (s INTER u))`) THEN + ASM_REWRITE_TAC[EXTENSION; IN_INSERT; IN_NUMSEG] THEN ARITH_TAC; + SIMP_TAC[CARD_CLAUSES; FINITE_INTER; FINITE_NUMSEG; IN_INTER; ARITH; + IN_NUMSEG; GSYM REAL_OF_NUM_SUC]]);; + +let SCHNIRELMANN_SUMSET = prove + (`!s t. 0 IN (s INTER t) + ==> schnirelmann(s +++ t) + >= (schnirelmann s + schnirelmann t) - + schnirelmann s * schnirelmann t`, + REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[real_ge] THEN + MATCH_MP_TAC SCHNIRELMANN_LBOUND THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + MP_TAC(SPECL [`count s n`; `s INTER (1..n)`; `n:num`] ENUMERATION_LEMMA) THEN + SIMP_TAC[count; HAS_SIZE; FINITE_INTER; FINITE_NUMSEG] THEN + SIMP_TAC[IN_INTER; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->num` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `A = CARD(s INTER (1..n))` THEN + SUBGOAL_THEN `!k. k <= A ==> (a:num->num)(k) IN s /\ a(k) <= n` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `(a:num->num)(k)`) THEN + DISJ_CASES_TAC(ARITH_RULE `k = 0 \/ 1 <= k`) THEN + ASM_REWRITE_TAC[LE_0; IN_INTER; IN_NUMSEG] THEN + MATCH_MP_TAC(TAUT `d ==> (a /\ b /\ c <=> d) ==> a /\ c`) THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(CARD ((s +++ t) INTER (0..n))) - &1` THEN CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[CARD_INTER_0_1; SUMSET_0; GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_LE_SUB_LADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `&(CARD(UNIONS(IMAGE (\i. (IMAGE (\b. a i + b) + (t INTER (0..(a(i+1) - a(i) - 1))))) + (0..A))))` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC CARD_SUBSET THEN + SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN X_GEN_TAC `l:num` THEN + REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THENL + [REWRITE_TAC[sumset; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN + MATCH_MP_TAC(ARITH_RULE + `a(k) < a(k + 1) /\ a(k + 1) <= n + 1 /\ l <= a(k + 1) - a(k) - 1 + ==> a(k) + l <= n`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `k:num = A` THEN ASM_REWRITE_TAC[LE_REFL] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k + 1`)) THEN ASM_ARITH_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNIONS o rand o rand o snd) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FINITE_INTER] THEN + SUBGOAL_THEN + `!i j. i IN 0..A /\ j IN 0..A /\ ~(i = j) + ==> IMAGE (\b. a i + b) (t INTER (0..a (i + 1) - a i - 1)) INTER + IMAGE (\b. a j + b) (t INTER (0..a (j + 1) - a j - 1)) = {}` + (LABEL_TAC "*") THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE + `IMAGE f s INTER t = {} <=> !x. x IN s ==> ~(f x IN t)`] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG; IN_INTER]) THEN + SUBGOAL_THEN `a(i + 1):num <= a(j) \/ a(j + 1) <= a(i)` MP_TAC THENL + [FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(i = j) ==> i + 1 <= j \/ j + 1 <= i`)) + THENL [DISJ1_TAC; DISJ2_TAC] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num->num)(i) < a(i + 1) /\ a(j) < a(j + 1)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) NSUM_IMAGE_NONZERO o + rand o rand o snd) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[INTER_ACI] THEN SIMP_TAC[CARD_CLAUSES]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + SIMP_TAC[EQ_ADD_LCANCEL; CARD_IMAGE_INJ; FINITE_INTER; FINITE_NUMSEG] THEN + SIMP_TAC[REAL_OF_NUM_SUM; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum(0..A) (\i. schnirelmann t * &(a(i + 1) - a(i) - 1) + &1)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[CARD_INTER_0_1; SUMSET_0; GSYM REAL_OF_NUM_SUC] THEN + SIMP_TAC[GSYM count; SCHNIRELMANN_UBOUND_MUL; REAL_LE_RADD]] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; SUM_CONST_NUMSEG] THEN + REWRITE_TAC[SUB_0; GSYM REAL_OF_NUM_ADD; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum(0..A) (\i. schnirelmann t * (&(a(i + 1)) - &(a i) - &1)) + &A` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_LE_RADD] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `a(i):num < a(i + 1)` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_OF_NUM_SUB; LT_IMP_LE; ARITH_RULE `a < b ==> 1 <= b - a`; + REAL_LE_REFL]] THEN + REWRITE_TAC[SUM_LMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a - b - c:real = --((b - a) + c)`] THEN + REWRITE_TAC[SUM_NEG; SUM_ADD_NUMSEG; SUM_DIFFS; LE_0] THEN + ASM_REWRITE_TAC[REAL_ARITH `--(&0 - a + b) = a - b`; SUM_CONST_NUMSEG] THEN + REWRITE_TAC[SUB_0; GSYM REAL_OF_NUM_ADD; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `(n + &1) - (a + &1) = n - a`] THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - t) * s * n <= (&1 - t) * a + ==> ((s + t) - s * t) * n <= t * (n - a) + a`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN EXPAND_TAC "A" THEN + REWRITE_TAC[REAL_SUB_LE; SCHNIRELMANN_UBOUND_MUL; GSYM count] THEN + REWRITE_TAC[SCHNIRELMANN_BOUNDS]);; + +(* ------------------------------------------------------------------------- *) +(* Now an iterative form. *) +(* ------------------------------------------------------------------------- *) + +let SCHNIRELMANN_SUMSET_GEN = prove + (`!a s. FINITE s /\ (!i:A. i IN s ==> 0 IN a i) + ==> schnirelmann(iterate(+++) s a) + >= &1 - product s (\i. &1 - schnirelmann(a i))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; real_ge; REAL_SUB_REFL; SCHNIRELMANN_BOUNDS] THEN + MAP_EVERY X_GEN_TAC [`k:A`; `s:A->bool`] THEN STRIP_TAC THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[IN_INSERT]; DISCH_TAC] THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_SUMSET] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 - (&1 - schnirelmann(a(k:A))) * + (&1 - schnirelmann(iterate (+++) s a))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `a <= b ==> &1 - b <= &1 - a`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[REAL_SUB_LE; SCHNIRELMANN_BOUNDS] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - s) * (&1 - t) <= u <=> + u >= (s + t) - s * t`] THEN + MATCH_MP_TAC SCHNIRELMANN_SUMSET THEN + ASM_SIMP_TAC[IN_INTER; IN_INSERT; SUMSET_0_ITER]]);; + +let SCHNIRELMANN_SUMSET_POW = prove + (`!i s. FINITE i /\ 0 IN s + ==> schnirelmann(iterate(+++) i (\k:A. s)) + >= &1 - (&1 - schnirelmann s) pow (CARD i)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\i:A. (s:num->bool)`; `i:A->bool`] + SCHNIRELMANN_SUMSET_GEN) THEN + ASM_SIMP_TAC[PRODUCT_CONST]);; + +let SCHNIRELMANN = prove + (`!s. 0 IN s /\ schnirelmann s > &0 + ==> ?k. !i. i HAS_SIZE k ==> iterate(+++) i (\a:A. s) = (:num)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN + MP_TAC(ISPECL [`&1 - schnirelmann s`; `&1 / &2`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `2 * n` THEN + X_GEN_TAC `i:A->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?j k:A->bool. i = j UNION k /\ j INTER k = {} /\ + j HAS_SIZE n /\ k HAS_SIZE n` + (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN2 SUBST1_TAC STRIP_ASSUME_TAC)) + THENL + [FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP CHOOSE_SUBSET) THEN + ASM_REWRITE_TAC[ARITH_RULE `n <= 2 * n`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:A->bool` THEN + STRIP_TAC THEN EXISTS_TAC `i DIFF j:A->bool` THEN + MATCH_MP_TAC(TAUT + `(a /\ b /\ c) /\ (a /\ b /\ c ==> d) ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [ARITH_RULE `n = 2 * n - n`] THEN + MATCH_MP_TAC HAS_SIZE_DIFF THEN ASM_REWRITE_TAC[HAS_SIZE]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM DISJOINT; HAS_SIZE]) THEN + ASM_SIMP_TAC[MONOIDAL_SUMSET; ITERATE_UNION] THEN + MATCH_MP_TAC SCHNIRELMANN_THEOREM THEN + ASM_SIMP_TAC[SUMSET_0_ITER; IN_INTER] THEN + MP_TAC(SPECL [`j:A->bool`; `s:num->bool`] SCHNIRELMANN_SUMSET_POW) THEN + MP_TAC(SPECL [`k:A->bool`; `s:num->bool`] SCHNIRELMANN_SUMSET_POW) THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `a < &1 / &2 ==> y >= &1 - a ==> x >= &1 - a ==> x + y >= &1`) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A more direct version, without the techicality of 0 and sumsets. *) +(* ------------------------------------------------------------------------- *) + +let SCHNIRELMANN_DIRECT = prove + (`!s. schnirelmann s > &0 + ==> ?k. !n. ?m f. m <= k /\ (!i. i IN 1..m ==> f(i) IN s) /\ + n = nsum (1..m) f`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `?k. !i:num->bool. + i HAS_SIZE k ==> iterate (+++) i (\a. 0 INSERT s) = (:num)` + MP_TAC THENL + [MATCH_MP_TAC SCHNIRELMANN THEN REWRITE_TAC[IN_INSERT] THEN + POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC SCHNIRELMANN_INSENSITIVE THEN + SIMP_TAC[IN_INSERT; LE_1]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(MP_TAC o SPEC `1..k`) THEN + REWRITE_TAC[EXTENSION; HAS_SIZE_NUMSEG_1; IN_UNIV] THEN + MATCH_MP_TAC MONO_FORALL THEN + SPEC_TAC(`k:num`,`k:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + INDUCT_TAC THEN SIMP_TAC[NUMSEG_CLAUSES; ARITH; ARITH_RULE `1 <= SUC k`] THEN + SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_SUMSET; FINITE_NUMSEG] THENL + [REWRITE_TAC[NEUTRAL_SUMSET; IN_SING] THEN GEN_TAC THEN + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `0` THEN + SIMP_TAC[NSUM_CLAUSES_NUMSEG; CARD_CLAUSES; EMPTY_SUBSET; FINITE_RULES; + IN_NUMSEG; LE_REFL; ARITH] THEN + REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`]; + ALL_TAC] THEN + REWRITE_TAC[IN_NUMSEG; ARITH_RULE `~(SUC n <= n)`] THEN + ONCE_REWRITE_TAC[sumset] THEN REWRITE_TAC[IN_ELIM_THM; IN_INSERT] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(X_CHOOSE_THEN `x:num` MP_TAC) THEN + ASM_CASES_TAC `x = 0` THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL + [ASM_MESON_TAC[IN_NUMSEG; ARITH_RULE `x <= k ==> x <= SUC k`]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:num`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `f:num->num`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`SUC m`; `\i. if i = SUC m then x:num else f i`] THEN + ASM_SIMP_TAC[LE_SUC; LE; NSUM_CLAUSES_NUMSEG] THEN CONJ_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `~(SUC n <= n)`; IN_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `1 = SUC m \/ 1 <= m`] THEN + GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN AP_TERM_TAC THEN + MATCH_MP_TAC NSUM_EQ THEN + ASM_MESON_TAC[ARITH_RULE `~(SUC n <= n)`; IN_NUMSEG]);; diff --git a/Examples/solovay.ml b/Examples/solovay.ml new file mode 100644 index 0000000..6f8b4bf --- /dev/null +++ b/Examples/solovay.ml @@ -0,0 +1,416 @@ +(* ========================================================================= *) +(* Simple universal variant of Bob Solovay's procedure for vector spaces. *) +(* ========================================================================= *) + +needs "Multivariate/misc.ml";; +needs "Multivariate/vectors.ml";; + +(* ------------------------------------------------------------------------- *) +(* Initial simplification so we just use dot products between vectors. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_SUB_ELIM_THM = prove + (`(--x = --(&1) % x) /\ + (x - y = x + --(&1) % y)`, + VECTOR_ARITH_TAC);; + +let NORM_ELIM_THM = prove + (`!P t. P (norm t) = !x. &0 <= x /\ (x pow 2 = (t:real^N) dot t) ==> P x`, + GEN_TAC THEN REWRITE_TAC[vector_norm] THEN + MESON_TAC[DOT_POS_LE; SQRT_POW2; SQRT_UNIQUE; + REAL_POW_2; REAL_POW2_ABS; REAL_ABS_POS]);; + +let NORM_ELIM_CONV = + let dest_norm tm = + let nm,v = dest_comb tm in + if fst(dest_const nm) <> "vector_norm" then failwith "dest_norm" + else v in + let is_norm = can dest_norm in + fun tm -> + let t = find_term (fun t -> is_norm t & free_in t tm) tm in + let v = dest_norm t in + let w = genvar(type_of t) in + let th1 = ISPECL [mk_abs(w,subst[w,t] tm); v] NORM_ELIM_THM in + CONV_RULE(COMB2_CONV (RAND_CONV BETA_CONV) + (BINDER_CONV(RAND_CONV BETA_CONV))) th1;; + +let NORM_ELIM_TAC = + CONV_TAC NORM_ELIM_CONV THEN GEN_TAC;; + +let SOLOVAY_TAC = + REWRITE_TAC[orthogonal; GSYM DOT_EQ_0] THEN + REWRITE_TAC[VECTOR_EQ] THEN + REWRITE_TAC[VECTOR_SUB_ELIM_THM] THEN + REWRITE_TAC[NORM_EQ; NORM_LE; NORM_LT; real_gt; real_ge] THEN + REPEAT NORM_ELIM_TAC THEN + REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL];; + +(* ------------------------------------------------------------------------- *) +(* Iterative Gram-Schmidt type process. *) +(* ------------------------------------------------------------------------- *) + +let component = new_definition + `component (b:real^N) x = (b dot x) / (b dot b)`;; + +let COMPONENT_ORTHOGONAL = prove + (`!b:real^N x. orthogonal b (x - (component b x) % b)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL + [ASM_REWRITE_TAC[orthogonal; DOT_LZERO]; ALL_TAC] THEN + ASM_SIMP_TAC[orthogonal; component] THEN + REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN + ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);; + +let ORTHOGONAL_SUM_LEMMA = prove + (`!cs vs. + ALL (orthogonal x) vs /\ orthogonal x z /\ (LENGTH cs = LENGTH vs) + ==> orthogonal x (ITLIST2 (\a v s. a % v + s) cs vs z)`, + LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[NOT_CONS_NIL; NOT_SUC; ITLIST2; LENGTH; ALL] THEN + ASM_SIMP_TAC[ORTHOGONAL_CLAUSES; SUC_INJ]);; + +let GRAM_SCHMIDT_LEMMA = prove + (`!w:real^N vs. ?u as. + ALL (orthogonal u) vs /\ (LENGTH as = LENGTH vs) /\ + (w = ITLIST2 (\a v s. a % v + s) as vs u)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC list_INDUCT THEN + SIMP_TAC[ALL; LENGTH; ITLIST2; LENGTH_EQ_NIL] THEN CONJ_TAC THENL + [X_GEN_TAC `w:real^N` THEN EXISTS_TAC `w:real^N` THEN + EXISTS_TAC `[]:real list` THEN REWRITE_TAC[ITLIST2]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`v:real^N`; `vs:(real^N)list`] THEN + REWRITE_TAC[LENGTH_EQ_CONS] THEN DISCH_TAC THEN X_GEN_TAC `w:real^N` THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `w:real^N` th) THEN MP_TAC(SPEC `v:real^N` th)) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` (X_CHOOSE_THEN `cs:real list` + (STRIP_ASSUME_TAC o GSYM))) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N` (X_CHOOSE_THEN `as:real list` + (STRIP_ASSUME_TAC o GSYM))) THEN + MP_TAC(ISPECL [`z:real^N`; `u:real^N`] COMPONENT_ORTHOGONAL) THEN + ABBREV_TAC `k = component z (u:real^N)` THEN + ABBREV_TAC `x = u - k % z :real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC + [`x:real^N`; `CONS k (MAP2 (\a c. a - k * c) as cs)`] THEN + REWRITE_TAC[CONS_11; RIGHT_EXISTS_AND_THM; GSYM CONJ_ASSOC; UNWIND_THM1] THEN + SUBGOAL_THEN `ALL (orthogonal(x:real^N)) vs` ASSUME_TAC THENL + [UNDISCH_TAC `ALL (orthogonal(z:real^N)) vs` THEN + UNDISCH_TAC `ALL (orthogonal(u:real^N)) vs` THEN + REWRITE_TAC[IMP_IMP; AND_ALL] THEN + MATCH_MP_TAC MONO_ALL THEN REWRITE_TAC[] THEN + EXPAND_TAC "x" THEN SIMP_TAC[ORTHOGONAL_CLAUSES]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [EXPAND_TAC "v" THEN MATCH_MP_TAC ORTHOGONAL_SUM_LEMMA THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ORTHOGONAL_SYM]; + FIRST_ASSUM ACCEPT_TAC; + ASM_MESON_TAC[LENGTH_MAP2]; + ALL_TAC] THEN + REWRITE_TAC[ITLIST2; VECTOR_ARITH `(a = b + c:real^N) = (c = a - b)`] THEN + MAP_EVERY EXPAND_TAC ["v"; "w"; "x"] THEN + UNDISCH_TAC `LENGTH(vs:(real^N)list) = LENGTH(cs:real list)` THEN + UNDISCH_TAC `LENGTH(vs:(real^N)list) = LENGTH(as:real list)` THEN + REWRITE_TAC[IMP_CONJ] THEN + MAP_EVERY (fun v -> SPEC_TAC(v,v)) + [`vs:(real^N)list`; `cs:real list`; `as:real list`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[NOT_CONS_NIL; NOT_SUC; ITLIST2; LENGTH; ALL; SUC_INJ; MAP2] THEN + ASM_SIMP_TAC[] THEN REPEAT DISCH_TAC THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence this is a simple equality. *) +(* ------------------------------------------------------------------------- *) + +let SOLOVAY_LEMMA = prove + (`!P vs. (!w:real^N. P w vs) = + (!as u. ALL (orthogonal u) vs /\ (LENGTH as = LENGTH vs) + ==> P (ITLIST2 (\a v s. a % v + s) as vs u) vs)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + X_GEN_TAC `w:real^N` THEN + MP_TAC(ISPECL [`w:real^N`; `vs:(real^N)list`] GRAM_SCHMIDT_LEMMA) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Set up the specific instances to get rid of list stuff. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_LENGTH_CLAUSES = prove + (`((!l. (LENGTH l = 0) ==> P l) = P []) /\ + ((!l. (LENGTH l = SUC n) ==> P l) = + (!h t. (LENGTH t = n) ==> P (CONS h t)))`, + MESON_TAC[LENGTH; LENGTH_EQ_NIL; NOT_SUC; LENGTH_EQ_CONS]);; + +let ORTHOGONAL_SIMP_CLAUSES = prove + (`orthogonal u x + ==> (u dot x = &0) /\ (x dot u = &0) /\ + (u dot (a % x) = &0) /\ ((a % x) dot u = &0) /\ + (u dot (a % x + y) = u dot y) /\ ((a % x + y) dot u = y dot u) /\ + (u dot (y + a % x) = u dot y) /\ ((y + a % x) dot u = y dot u)`, + SIMP_TAC[orthogonal; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [DOT_SYM] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RID]);; + +(* ------------------------------------------------------------------------- *) +(* A nicer proforma version. *) +(* ------------------------------------------------------------------------- *) + +let ITLIST2_0_LEMMA = prove + (`!u as vs. ITLIST2 (\a v s. a % v + s) as vs u = + ITLIST2 (\a v s. a % v + s) as vs (vec 0) + u`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ITLIST2_DEF; VECTOR_ADD_LID] THEN + ASM_REWRITE_TAC[VECTOR_ADD_ASSOC]);; + +let SOLOVAY_PROFORMA_EQ = prove + (`(!w:real^N. P (MAP ((dot) w) (CONS w vs)) vs) = + (!u. ALL (orthogonal u) vs + ==> !as. (LENGTH as = LENGTH vs) + ==> P (CONS + ((ITLIST2 (\a v s. a % v + s) as vs (vec 0)) dot + (ITLIST2 (\a v s. a % v + s) as vs (vec 0)) + + u dot u) + (MAP ((dot) + (ITLIST2 (\a v s. a % v + s) as vs (vec 0))) + vs)) + vs)`, + MP_TAC(ISPEC `\w:real^N vs. P (MAP ((dot) w) (CONS w vs)) vs :bool` + SOLOVAY_LEMMA) THEN + REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `u:real^N` THEN REWRITE_TAC[] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `as:(real)list` THEN REWRITE_TAC[IMP_IMP] THEN + MATCH_MP_TAC(TAUT `(a ==> (b = c)) ==> (a ==> b <=> a ==> c)`) THEN + STRIP_TAC THEN REWRITE_TAC[MAP] THEN BINOP_TAC THEN + REWRITE_TAC[CONS_11] THEN ONCE_REWRITE_TAC[ITLIST2_0_LEMMA] THEN + REWRITE_TAC[VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_ARITH + `(a + u) dot (a + u) = a dot a + &2 * (u dot a) + u dot u`] THEN + REWRITE_TAC[REAL_ARITH `(a + &2 * b + c = a + c) <=> (b = &0)`] THEN + GEN_REWRITE_TAC (RAND_CONV o BINOP_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[DOT_LADD] THEN CONJ_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SPEC_TAC(`vs:(real^N)list`,`vs:(real^N)list`) THEN + SPEC_TAC(`as:(real)list`,`as:(real)list`) THEN + REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_SUC] THEN + REWRITE_TAC[ALL; ITLIST2; DOT_RZERO; SUC_INJ] THEN + ASM_SIMP_TAC[DOT_RADD] THEN + REWRITE_TAC[REAL_ADD_RID; DOT_RMUL] THEN + SIMP_TAC[orthogonal] THEN REWRITE_TAC[REAL_MUL_RZERO]; + MATCH_MP_TAC MAP_EQ THEN + REWRITE_TAC[REAL_ARITH `(a + b = a) <=> (b = &0)`] THEN + MATCH_MP_TAC ALL_IMP THEN EXISTS_TAC `orthogonal (u:real^N)` THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[orthogonal]]);; + +(* ------------------------------------------------------------------------- *) +(* The implication that we normally use. *) +(* ------------------------------------------------------------------------- *) + +let SOLOVAY_PROFORMA = prove + (`!P vs. + (!c. &0 <= c + ==> !as. (LENGTH as = LENGTH vs) + ==> P (CONS ((ITLIST2 (\a v s. a % v + s) as vs (vec 0)) dot + (ITLIST2 (\a v s. a % v + s) as vs (vec 0)) + c) + (MAP ((dot) + (ITLIST2 (\a v s. a % v + s) as vs (vec 0))) + vs)) + vs) + ==> !w:real^N. P (MAP ((dot) w) (CONS w vs)) vs`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC RAND_CONV [SOLOVAY_PROFORMA_EQ] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[DOT_POS_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Automatically set up an implication for n (+1 eliminated) quantifier. *) +(* ------------------------------------------------------------------------- *) + +let SOLOVAY_RULE = + let v_tm = `v:(real^N)list` and d_tm = `d:real list` + and elv_tm = `EL:num->(real^N)list->real^N` + and eld_tm = `EL:num->(real)list->real` + and rn_ty = `:real^N` + and rewr_rule = REWRITE_RULE + [MAP; EL; HD; TL; LENGTH; FORALL_LENGTH_CLAUSES; + ITLIST2; VECTOR_ADD_RID; VECTOR_ADD_LID; DOT_LZERO] + and sewr_rule = PURE_ONCE_REWRITE_RULE[DOT_SYM] in + fun n -> + let args = + map (fun i -> mk_comb(mk_comb(elv_tm,mk_small_numeral i),v_tm)) + (0--(n-1)) @ + map (fun i -> mk_comb(mk_comb(eld_tm,mk_small_numeral i),d_tm)) + (1--n) @ + [mk_comb(mk_comb(eld_tm,mk_small_numeral 0),d_tm)] in + let pty = itlist (mk_fun_ty o type_of) args bool_ty in + let p_tm = list_mk_abs([d_tm;v_tm],list_mk_comb(mk_var("P",pty),args)) + and vs = make_args "v" [] (replicate rn_ty n) in + let th1 = ISPECL [p_tm; mk_list(vs,rn_ty)] SOLOVAY_PROFORMA in + let th2 = rewr_rule(CONV_RULE(TOP_DEPTH_CONV num_CONV) th1) in + let th3 = sewr_rule th2 in + itlist (fun v -> MATCH_MP MONO_FORALL o GEN v) vs th3;; + +(* ------------------------------------------------------------------------- *) +(* Now instantiate it to some special cases. *) +(* ------------------------------------------------------------------------- *) + +let MK_SOLOVAY_PROFORMA = + let preths = map SOLOVAY_RULE (0--9) in + fun n -> if n < 10 then el n preths else SOLOVAY_RULE n;; + +(* ------------------------------------------------------------------------- *) +(* Apply it to a goal. *) +(* ------------------------------------------------------------------------- *) + +let is_vector_ty ty = + match ty with + Tyapp("cart",[Tyapp("real",[]);_]) -> true + | _ -> false;; + +let SOLOVAY_REDUCE_TAC (asl,w) = + let avs = sort (<) (filter (is_vector_ty o type_of) (frees w)) in + (REWRITE_TAC[DOT_SYM] THEN + MAP_EVERY (fun v -> SPEC_TAC(v,v)) (rev avs) THEN + MATCH_MP_TAC(MK_SOLOVAY_PROFORMA (length avs - 1)) THEN + REWRITE_TAC[DOT_LADD; DOT_LMUL; DOT_RADD; DOT_RMUL; DOT_LZERO; + DOT_RZERO] THEN + REPEAT GEN_TAC) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Overall tactic. *) +(* ------------------------------------------------------------------------- *) + +let SOLOVAY_VECTOR_TAC = + REWRITE_TAC[dist; real_gt; real_ge; NORM_LT; NORM_LE; GSYM DOT_POS_LT] THEN + REPEAT GEN_TAC THEN SOLOVAY_TAC THEN + REWRITE_TAC[DOT_LZERO; DOT_RZERO] THEN + REPEAT SOLOVAY_REDUCE_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_MUL_LID; REAL_MUL_RID; + REAL_ADD_LID; REAL_ADD_RID] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; GSYM CONJ_ASSOC] THEN + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG; + REAL_MUL_LID; REAL_MUL_RID; GSYM real_sub];; + +(* ------------------------------------------------------------------------- *) +(* An example where REAL_RING then works. *) +(* ------------------------------------------------------------------------- *) + +let PYTHAGORAS = prove + (`!A B C:real^N. + orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_RING);; + +(*** Actually in this case we can fairly easily do things manually, though + we do need to explicitly use symmetry of the dot product. + +let PYTHAGORAS = prove + (`!A B C:real^N. + orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, + REWRITE_TAC[NORM_POW_2; orthogonal; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + CONV_TAC REAL_RING);; + + ***) + +(* ------------------------------------------------------------------------- *) +(* Examples. *) +(* ------------------------------------------------------------------------- *) + +needs "Examples/sos.ml";; + +let EXAMPLE_1 = prove + (`!x y:real^N. x dot y <= norm x * norm y`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + +let EXAMPLE_2 = prove + (`!x y:real^N. a % (x + y) = a % x + a % y`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + +(*** Takes a few minutes but does work + +let EXAMPLE_3 = prove + (`!x y:real^N. norm (x + y) <= norm x + norm y`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + +****) + +let EXAMPLE_4 = prove + (`!x y z. x dot (y + z) = (x dot y) + (x dot z)`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + +let EXAMPLE_5 = prove + (`!x y. (x dot x = &0) ==> (x dot y = &0)`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + +(* ------------------------------------------------------------------------- *) +(* This is NORM_INCREASES_ONLINE. *) +(* ------------------------------------------------------------------------- *) + +g `!a d:real^N. + ~(d = vec 0) ==> norm (a + d) > norm a \/ norm (a - d) > norm a`;; + +time e SOLOVAY_VECTOR_TAC;; + +time e (CONV_TAC REAL_SOS);; + +(* ------------------------------------------------------------------------- *) +(* DIST_INCREASES_ONLINE *) +(* ------------------------------------------------------------------------- *) + +g `!b a d:real^N. + ~(d = vec 0) ==> dist(a,b + d) > dist(a,b) \/ dist(a,b - d) > dist(a,b)`;; + +time e SOLOVAY_VECTOR_TAC;; + +time e (CONV_TAC REAL_SOS);; + +(* ------------------------------------------------------------------------- *) +(* This one doesn't seem to work easily, but I think it does eventually. *) +(* ------------------------------------------------------------------------- *) + +(**** +let EXAMPLE_6 = prove + (`!a x. norm(a % x) = abs(a) * norm x`;; + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + ****) + +let EXAMPLE_7 = prove + (`!x. abs(norm x) = norm x`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; + +(*** But this is (at least) really slow + +let EXAMPLE_8 = prove + (`!x y. abs(norm(x) - norm(y)) <= abs(norm(x - y))`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; +****) + +(* ------------------------------------------------------------------------- *) +(* One from separating hyperplanes with a richer structure. *) +(* ------------------------------------------------------------------------- *) + +needs "Rqe/make.ml";; + +let EXAMPLE_9 = prove + (`!x:real^N y. x dot y > &0 ==> ?u. &0 < u /\ norm(u % y - x) < norm x`, + SOLOVAY_VECTOR_TAC THEN + W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC REAL_QELIM_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Even richer set of quantifier alternations. *) +(* ------------------------------------------------------------------------- *) + +let EXAMPLE_10 = prove + (`!x:real^N y. + x dot y > &0 + ==> ?u. &0 < u /\ + !v. &0 < v /\ v <= u ==> norm(v % y - x) < norm x`, + SOLOVAY_VECTOR_TAC THEN + W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC REAL_QELIM_CONV);; diff --git a/Examples/sos.ml b/Examples/sos.ml new file mode 100644 index 0000000..90c05d8 --- /dev/null +++ b/Examples/sos.ml @@ -0,0 +1,1896 @@ +(* ========================================================================= *) +(* Nonlinear universal reals procedure using SOS decomposition. *) +(* ========================================================================= *) + +prioritize_real();; + +let debugging = ref false;; + +exception Sanity;; + +exception Unsolvable;; + +(* ------------------------------------------------------------------------- *) +(* Turn a rational into a decimal string with d sig digits. *) +(* ------------------------------------------------------------------------- *) + +let decimalize = + let rec normalize y = + if abs_num y =/ Int 1 then normalize (y // Int 10) + 1 + else 0 in + fun d x -> + if x =/ Int 0 then "0.0" else + let y = abs_num x in + let e = normalize y in + let z = pow10(-e) */ y +/ Int 1 in + let k = round_num(pow10 d */ z) in + (if x a + | h::t -> itern (k + 1) t f (f h k a);; + +let rec iter (m,n) f a = + if n < m then a + else iter (m+1,n) f (f m a);; + +(* ------------------------------------------------------------------------- *) +(* The main types. *) +(* ------------------------------------------------------------------------- *) + +type vector = int*(int,num)func;; + +type matrix = (int*int)*(int*int,num)func;; + +type monomial = (term,int)func;; + +type poly = (monomial,num)func;; + +(* ------------------------------------------------------------------------- *) +(* Assignment avoiding zeros. *) +(* ------------------------------------------------------------------------- *) + +let (|-->) x y a = if y =/ Int 0 then a else (x |-> y) a;; + +(* ------------------------------------------------------------------------- *) +(* This can be generic. *) +(* ------------------------------------------------------------------------- *) + +let element (d,v) i = tryapplyd v i (Int 0);; + +let mapa f (d,v) = + d,foldl (fun a i c -> (i |--> f(c)) a) undefined v;; + +let is_zero (d,v) = is_undefined v;; + +(* ------------------------------------------------------------------------- *) +(* Vectors. Conventionally indexed 1..n. *) +(* ------------------------------------------------------------------------- *) + +let vec_0 n = (n,undefined:vector);; + +let vec_dim (v:vector) = fst v;; + +let vec_const c n = + if c =/ Int 0 then vec_0 n + else (n,itlist (fun k -> k |-> c) (1--n) undefined :vector);; + +let vec_1 = vec_const (Int 1);; + +let vec_cmul c (v:vector) = + let n = vec_dim v in + if c =/ Int 0 then vec_0 n + else n,mapf (fun x -> c */ x) (snd v) + +let vec_neg (v:vector) = (fst v,mapf minus_num (snd v) :vector);; + +let vec_add (v1:vector) (v2:vector) = + let m = vec_dim v1 and n = vec_dim v2 in + if m <> n then failwith "vec_add: incompatible dimensions" else + (n,combine (+/) (fun x -> x =/ Int 0) (snd v1) (snd v2) :vector);; + +let vec_sub v1 v2 = vec_add v1 (vec_neg v2);; + +let vec_dot (v1:vector) (v2:vector) = + let m = vec_dim v1 and n = vec_dim v2 in + if m <> n then failwith "vec_add: incompatible dimensions" else + foldl (fun a i x -> x +/ a) (Int 0) + (combine ( */ ) (fun x -> x =/ Int 0) (snd v1) (snd v2));; + +let vec_of_list l = + let n = length l in + (n,itlist2 (|->) (1--n) l undefined :vector);; + +(* ------------------------------------------------------------------------- *) +(* Matrices; again rows and columns indexed from 1. *) +(* ------------------------------------------------------------------------- *) + +let matrix_0 (m,n) = ((m,n),undefined:matrix);; + +let dimensions (m:matrix) = fst m;; + +let matrix_const c (m,n as mn) = + if m <> n then failwith "matrix_const: needs to be square" + else if c =/ Int 0 then matrix_0 mn + else (mn,itlist (fun k -> (k,k) |-> c) (1--n) undefined :matrix);; + +let matrix_1 = matrix_const (Int 1);; + +let matrix_cmul c (m:matrix) = + let (i,j) = dimensions m in + if c =/ Int 0 then matrix_0 (i,j) + else (i,j),mapf (fun x -> c */ x) (snd m);; + +let matrix_neg (m:matrix) = (dimensions m,mapf minus_num (snd m) :matrix);; + +let matrix_add (m1:matrix) (m2:matrix) = + let d1 = dimensions m1 and d2 = dimensions m2 in + if d1 <> d2 then failwith "matrix_add: incompatible dimensions" + else (d1,combine (+/) (fun x -> x =/ Int 0) (snd m1) (snd m2) :matrix);; + +let matrix_sub m1 m2 = matrix_add m1 (matrix_neg m2);; + +let row k (m:matrix) = + let i,j = dimensions m in + (j, + foldl (fun a (i,j) c -> if i = k then (j |-> c) a else a) undefined (snd m) + : vector);; + +let column k (m:matrix) = + let i,j = dimensions m in + (i, + foldl (fun a (i,j) c -> if j = k then (i |-> c) a else a) undefined (snd m) + : vector);; + +let transp (m:matrix) = + let i,j = dimensions m in + ((j,i),foldl (fun a (i,j) c -> ((j,i) |-> c) a) undefined (snd m) :matrix);; + +let diagonal (v:vector) = + let n = vec_dim v in + ((n,n),foldl (fun a i c -> ((i,i) |-> c) a) undefined (snd v) : matrix);; + +let matrix_of_list l = + let m = length l in + if m = 0 then matrix_0 (0,0) else + let n = length (hd l) in + (m,n),itern 1 l (fun v i -> itern 1 v (fun c j -> (i,j) |-> c)) undefined;; + +(* ------------------------------------------------------------------------- *) +(* Monomials. *) +(* ------------------------------------------------------------------------- *) + +let monomial_eval assig (m:monomial) = + foldl (fun a x k -> a */ power_num (apply assig x) (Int k)) + (Int 1) m;; + +let monomial_1 = (undefined:monomial);; + +let monomial_var x = (x |=> 1 :monomial);; + +let (monomial_mul:monomial->monomial->monomial) = + combine (+) (fun x -> false);; + +let monomial_pow (m:monomial) k = + if k = 0 then monomial_1 + else mapf (fun x -> k * x) m;; + +let monomial_divides (m1:monomial) (m2:monomial) = + foldl (fun a x k -> tryapplyd m2 x 0 >= k & a) true m1;; + +let monomial_div (m1:monomial) (m2:monomial) = + let m = combine (+) (fun x -> x = 0) m1 (mapf (fun x -> -x) m2) in + if foldl (fun a x k -> k >= 0 & a) true m then m + else failwith "monomial_div: non-divisible";; + +let monomial_degree x (m:monomial) = tryapplyd m x 0;; + +let monomial_lcm (m1:monomial) (m2:monomial) = + (itlist (fun x -> x |-> max (monomial_degree x m1) (monomial_degree x m2)) + (union (dom m1) (dom m2)) undefined :monomial);; + +let monomial_multidegree (m:monomial) = foldl (fun a x k -> k + a) 0 m;; + +let monomial_variables m = dom m;; + +(* ------------------------------------------------------------------------- *) +(* Polynomials. *) +(* ------------------------------------------------------------------------- *) + +let eval assig (p:poly) = + foldl (fun a m c -> a +/ c */ monomial_eval assig m) (Int 0) p;; + +let poly_0 = (undefined:poly);; + +let poly_isconst (p:poly) = foldl (fun a m c -> m = monomial_1 & a) true p;; + +let poly_var x = ((monomial_var x) |=> Int 1 :poly);; + +let poly_const c = + if c =/ Int 0 then poly_0 else (monomial_1 |=> c);; + +let poly_cmul c (p:poly) = + if c =/ Int 0 then poly_0 + else mapf (fun x -> c */ x) p;; + +let poly_neg (p:poly) = (mapf minus_num p :poly);; + +let poly_add (p1:poly) (p2:poly) = + (combine (+/) (fun x -> x =/ Int 0) p1 p2 :poly);; + +let poly_sub p1 p2 = poly_add p1 (poly_neg p2);; + +let poly_cmmul (c,m) (p:poly) = + if c =/ Int 0 then poly_0 + else if m = monomial_1 then mapf (fun d -> c */ d) p + else foldl (fun a m' d -> (monomial_mul m m' |-> c */ d) a) poly_0 p;; + +let poly_mul (p1:poly) (p2:poly) = + foldl (fun a m c -> poly_add (poly_cmmul (c,m) p2) a) poly_0 p1;; + +let poly_div (p1:poly) (p2:poly) = + if not(poly_isconst p2) then failwith "poly_div: non-constant" else + let c = eval undefined p2 in + if c =/ Int 0 then failwith "poly_div: division by zero" + else poly_cmul (Int 1 // c) p1;; + +let poly_square p = poly_mul p p;; + +let rec poly_pow p k = + if k = 0 then poly_const (Int 1) + else if k = 1 then p + else let q = poly_square(poly_pow p (k / 2)) in + if k mod 2 = 1 then poly_mul p q else q;; + +let poly_exp p1 p2 = + if not(poly_isconst p2) then failwith "poly_exp: not a constant" else + poly_pow p1 (Num.int_of_num (eval undefined p2));; + +let degree x (p:poly) = foldl (fun a m c -> max (monomial_degree x m) a) 0 p;; + +let multidegree (p:poly) = + foldl (fun a m c -> max (monomial_multidegree m) a) 0 p;; + +let poly_variables (p:poly) = + foldr (fun m c -> union (monomial_variables m)) p [];; + +(* ------------------------------------------------------------------------- *) +(* Order monomials for human presentation. *) +(* ------------------------------------------------------------------------- *) + +let humanorder_varpow (x1,k1) (x2,k2) = x1 < x2 or x1 = x2 & k1 > k2;; + +let humanorder_monomial = + let rec ord l1 l2 = match (l1,l2) with + _,[] -> true + | [],_ -> false + | h1::t1,h2::t2 -> humanorder_varpow h1 h2 or h1 = h2 & ord t1 t2 in + fun m1 m2 -> m1 = m2 or + ord (sort humanorder_varpow (graph m1)) + (sort humanorder_varpow (graph m2));; + +(* ------------------------------------------------------------------------- *) +(* Conversions to strings. *) +(* ------------------------------------------------------------------------- *) + +let string_of_vector min_size max_size (v:vector) = + let n_raw = vec_dim v in + if n_raw = 0 then "[]" else + let n = max min_size (min n_raw max_size) in + let xs = map (string_of_num o element v) (1--n) in + "[" ^ end_itlist (fun s t -> s ^ ", " ^ t) xs ^ + (if n_raw > max_size then ", ...]" else "]");; + +let string_of_matrix max_size (m:matrix) = + let i_raw,j_raw = dimensions m in + let i = min max_size i_raw and j = min max_size j_raw in + let rstr = map (fun k -> string_of_vector j j (row k m)) (1--i) in + "["^end_itlist(fun s t -> s^";\n "^t) rstr ^ + (if j > max_size then "\n ...]" else "]");; + +let rec string_of_term t = + if (is_comb t) then + let (a,b) = (dest_comb t) in + "("^(string_of_term a)^" "^(string_of_term b)^")" + else if (is_abs t) then + let (a,b) = (dest_abs t) in + "(\\"^(string_of_term a)^"."^(string_of_term b)^")" + else if (is_const t) then + let (a,_) = (dest_const t) in a + else if (is_var t) then + let (a,_) = (dest_var t) in a + else failwith "string_of_term";; + +let string_of_varpow x k = + if k = 1 then string_of_term x else string_of_term x^"^"^string_of_int k;; + +let string_of_monomial m = + if m = monomial_1 then "1" else + let vps = List.fold_right (fun (x,k) a -> string_of_varpow x k :: a) + (sort humanorder_varpow (graph m)) [] in + end_itlist (fun s t -> s^"*"^t) vps;; + +let string_of_cmonomial (c,m) = + if m = monomial_1 then string_of_num c + else if c =/ Int 1 then string_of_monomial m + else string_of_num c ^ "*" ^ string_of_monomial m;; + +let string_of_poly (p:poly) = + if p = poly_0 then "<<0>>" else + let cms = sort (fun (m1,_) (m2,_) -> humanorder_monomial m1 m2) (graph p) in + let s = + List.fold_left (fun a (m,c) -> + if c >";; + +(* ------------------------------------------------------------------------- *) +(* Printers. *) +(* ------------------------------------------------------------------------- *) + +let print_vector v = Format.print_string(string_of_vector 0 20 v);; + +let print_matrix m = Format.print_string(string_of_matrix 20 m);; + +let print_monomial m = Format.print_string(string_of_monomial m);; + +let print_poly m = Format.print_string(string_of_poly m);; + +#install_printer print_vector;; +#install_printer print_matrix;; +#install_printer print_monomial;; +#install_printer print_poly;; + +(* ------------------------------------------------------------------------- *) +(* Conversion from HOL term. *) +(* ------------------------------------------------------------------------- *) + +let poly_of_term = + let neg_tm = `(--):real->real` + and add_tm = `(+):real->real->real` + and sub_tm = `(-):real->real->real` + and mul_tm = `(*):real->real->real` + and inv_tm = `(inv):real->real` + and div_tm = `(/):real->real->real` + and pow_tm = `(pow):real->num->real` + and zero_tm = `&0:real` + and real_ty = `:real` in + let rec poly_of_term tm = + if tm = zero_tm then poly_0 + else if is_ratconst tm then poly_const(rat_of_term tm) + else if not(is_comb tm) then poly_var tm else + let lop,r = dest_comb tm in + if lop = neg_tm then poly_neg(poly_of_term r) + else if lop = inv_tm then + let p = poly_of_term r in + if poly_isconst p then poly_const(Int 1 // eval undefined p) + else failwith "poly_of_term: inverse of non-constant polyomial" + else if not(is_comb lop) then poly_var tm else + let op,l = dest_comb lop in + if op = pow_tm & is_numeral r then + poly_pow (poly_of_term l) (dest_small_numeral r) + else if op = add_tm then poly_add (poly_of_term l) (poly_of_term r) + else if op = sub_tm then poly_sub (poly_of_term l) (poly_of_term r) + else if op = mul_tm then poly_mul (poly_of_term l) (poly_of_term r) + else if op = div_tm then + let p = poly_of_term l and q = poly_of_term r in + if poly_isconst q then poly_cmul (Int 1 // eval undefined q) p + else failwith "poly_of_term: division by non-constant polynomial" + else poly_var tm in + fun tm -> if type_of tm = real_ty then poly_of_term tm + else failwith "poly_of_term: term does not have real type";; + +(* ------------------------------------------------------------------------- *) +(* String of vector (just a list of space-separated numbers). *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_vector (v:vector) = + let n = vec_dim v in + let strs = map (decimalize 20 o element v) (1--n) in + end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";; + +(* ------------------------------------------------------------------------- *) +(* String for block diagonal matrix numbered k. *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_blockdiagonal k m = + let pfx = string_of_int k ^" " in + let ents = + foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in + let entss = sort (increasing fst) ents in + itlist (fun ((b,i,j),c) a -> + pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^ + " " ^ decimalize 20 c ^ "\n" ^ a) entss "";; + +(* ------------------------------------------------------------------------- *) +(* String for a matrix numbered k, in SDPA sparse format. *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_matrix k (m:matrix) = + let pfx = string_of_int k ^ " 1 " in + let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a) + (snd m) [] in + let mss = sort (increasing fst) ms in + itlist (fun ((i,j),c) a -> + pfx ^ string_of_int i ^ " " ^ string_of_int j ^ + " " ^ decimalize 20 c ^ "\n" ^ a) mss "";; + +(* ------------------------------------------------------------------------- *) +(* String in SDPA sparse format for standard SDP problem: *) +(* *) +(* X = v_1 * [M_1] + ... + v_m * [M_m] - [M_0] must be PSD *) +(* Minimize obj_1 * v_1 + ... obj_m * v_m *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_problem comment obj mats = + let m = length mats - 1 + and n,_ = dimensions (hd mats) in + "\"" ^ comment ^ "\"\n" ^ + string_of_int m ^ "\n" ^ + "1\n" ^ + string_of_int n ^ "\n" ^ + sdpa_of_vector obj ^ + itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a) + (1--length mats) mats "";; + +(* ------------------------------------------------------------------------- *) +(* More parser basics. *) +(* ------------------------------------------------------------------------- *) + +let word s = + end_itlist (fun p1 p2 -> (p1 ++ p2) >> (fun (s,t) -> s^t)) + (map a (explode s));; +let token s = + many (some isspace) ++ word s ++ many (some isspace) + >> (fun ((_,t),_) -> t);; + +let decimal = + let numeral = some isnum in + let decimalint = atleast 1 numeral >> (Num.num_of_string o implode) in + let decimalfrac = atleast 1 numeral + >> (fun s -> Num.num_of_string(implode s) // pow10 (length s)) in + let decimalsig = + decimalint ++ possibly (a "." ++ decimalfrac >> snd) + >> (function (h,[]) -> h | (h,[x]) -> h +/ x) in + let signed prs = + a "-" ++ prs >> (minus_num o snd) + || a "+" ++ prs >> snd + || prs in + let exponent = (a "e" || a "E") ++ signed decimalint >> snd in + signed decimalsig ++ possibly exponent + >> (function (h,[]) -> h | (h,[x]) -> h */ power_num (Int 10) x);; + +let mkparser p s = + let x,rst = p(explode s) in + if rst = [] then x else failwith "mkparser: unparsed input";; + +let parse_decimal = mkparser decimal;; + +(* ------------------------------------------------------------------------- *) +(* Parse back a vector. *) +(* ------------------------------------------------------------------------- *) + +let parse_sdpaoutput,parse_csdpoutput = + let vector = + token "{" ++ listof decimal (token ",") "decimal" ++ token "}" + >> (fun ((_,v),_) -> vec_of_list v) in + let parse_vector = mkparser vector in + let rec skipupto dscr prs inp = + (dscr ++ prs >> snd + || some (fun c -> true) ++ skipupto dscr prs >> snd) inp in + let ignore inp = (),[] in + let sdpaoutput = + skipupto (word "xVec" ++ token "=") + (vector ++ ignore >> fst) in + let csdpoutput = + (decimal ++ many(a " " ++ decimal >> snd) >> (fun (h,t) -> h::t)) ++ + (a " " ++ a "\n" ++ ignore) >> (vec_of_list o fst) in + mkparser sdpaoutput,mkparser csdpoutput;; + +(* ------------------------------------------------------------------------- *) +(* Also parse the SDPA output to test success (CSDP yields a return code). *) +(* ------------------------------------------------------------------------- *) + +let sdpa_run_succeeded = + let rec skipupto dscr prs inp = + (dscr ++ prs >> snd + || some (fun c -> true) ++ skipupto dscr prs >> snd) inp in + let prs = skipupto (word "phase.value" ++ token "=") + (possibly (a "p") ++ possibly (a "d") ++ + (word "OPT" || word "FEAS")) in + fun s -> try prs (explode s); true with Noparse -> false;; + +(* ------------------------------------------------------------------------- *) +(* The default parameters. Unfortunately this goes to a fixed file. *) +(* ------------------------------------------------------------------------- *) + +let sdpa_default_parameters = +"100 unsigned int maxIteration; +1.0E-7 double 0.0 < epsilonStar; +1.0E2 double 0.0 < lambdaStar; +2.0 double 1.0 < omegaStar; +-1.0E5 double lowerBound; +1.0E5 double upperBound; +0.1 double 0.0 <= betaStar < 1.0; +0.2 double 0.0 <= betaBar < 1.0, betaStar <= betaBar; +0.9 double 0.0 < gammaStar < 1.0; +1.0E-7 double 0.0 < epsilonDash; +";; + +(* ------------------------------------------------------------------------- *) +(* These were suggested by Makoto Yamashita for problems where we are *) +(* right at the edge of the semidefinite cone, as sometimes happens. *) +(* ------------------------------------------------------------------------- *) + +let sdpa_alt_parameters = +"1000 unsigned int maxIteration; +1.0E-7 double 0.0 < epsilonStar; +1.0E4 double 0.0 < lambdaStar; +2.0 double 1.0 < omegaStar; +-1.0E5 double lowerBound; +1.0E5 double upperBound; +0.1 double 0.0 <= betaStar < 1.0; +0.2 double 0.0 <= betaBar < 1.0, betaStar <= betaBar; +0.9 double 0.0 < gammaStar < 1.0; +1.0E-7 double 0.0 < epsilonDash; +";; + +let sdpa_params = sdpa_alt_parameters;; + +(* ------------------------------------------------------------------------- *) +(* CSDP parameters; so far I'm sticking with the defaults. *) +(* ------------------------------------------------------------------------- *) + +let csdp_default_parameters = +"axtol=1.0e-8 +atytol=1.0e-8 +objtol=1.0e-8 +pinftol=1.0e8 +dinftol=1.0e8 +maxiter=100 +minstepfrac=0.9 +maxstepfrac=0.97 +minstepp=1.0e-8 +minstepd=1.0e-8 +usexzgap=1 +tweakgap=0 +affine=0 +printlevel=1 +";; + +let csdp_params = csdp_default_parameters;; + +(* ------------------------------------------------------------------------- *) +(* Now call SDPA on a problem and parse back the output. *) +(* ------------------------------------------------------------------------- *) + +let run_sdpa dbg obj mats = + let input_file = Filename.temp_file "sos" ".dat-s" in + let output_file = + String.sub input_file 0 (String.length input_file - 6) ^ ".out" + and params_file = Filename.concat (!temp_path) "param.sdpa" in + file_of_string input_file (sdpa_of_problem "" obj mats); + file_of_string params_file sdpa_params; + Sys.command("cd "^ !temp_path ^ + "; sdpa "^input_file ^ " " ^ output_file ^ + (if dbg then "" else "> /dev/null")); + let op = string_of_file output_file in + if not(sdpa_run_succeeded op) then failwith "sdpa: call failed" else + let res = parse_sdpaoutput op in + ((if dbg then () + else (Sys.remove input_file; Sys.remove output_file)); + res);; + +let sdpa obj mats = run_sdpa (!debugging) obj mats;; + +(* ------------------------------------------------------------------------- *) +(* The same thing with CSDP. *) +(* ------------------------------------------------------------------------- *) + +let run_csdp dbg obj mats = + let input_file = Filename.temp_file "sos" ".dat-s" in + let output_file = + String.sub input_file 0 (String.length input_file - 6) ^ ".out" + and params_file = Filename.concat (!temp_path) "param.csdp" in + file_of_string input_file (sdpa_of_problem "" obj mats); + file_of_string params_file csdp_params; + let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^ + " " ^ output_file ^ + (if dbg then "" else "> /dev/null")) in + let op = string_of_file output_file in + let res = parse_csdpoutput op in + ((if dbg then () + else (Sys.remove input_file; Sys.remove output_file)); + rv,res);; + +let csdp obj mats = + let rv,res = run_csdp (!debugging) obj mats in + (if rv = 1 or rv = 2 then failwith "csdp: Problem is infeasible" + else if rv = 3 then + (Format.print_string "csdp warning: Reduced accuracy"; + Format.print_newline()) + else if rv <> 0 then failwith("csdp: error "^string_of_int rv) + else ()); + res;; + +(* ------------------------------------------------------------------------- *) +(* Try some apparently sensible scaling first. Note that this is purely to *) +(* get a cleaner translation to floating-point, and doesn't affect any of *) +(* the results, in principle. In practice it seems a lot better when there *) +(* are extreme numbers in the original problem. *) +(* ------------------------------------------------------------------------- *) + +let scale_then = + let common_denominator amat acc = + foldl (fun a m c -> lcm_num (denominator c) a) acc amat + and maximal_element amat acc = + foldl (fun maxa m c -> max_num maxa (abs_num c)) acc amat in + fun solver obj mats -> + let cd1 = itlist common_denominator mats (Int 1) + and cd2 = common_denominator (snd obj) (Int 1) in + let mats' = map (mapf (fun x -> cd1 */ x)) mats + and obj' = vec_cmul cd2 obj in + let max1 = itlist maximal_element mats' (Int 0) + and max2 = maximal_element (snd obj') (Int 0) in + let scal1 = pow2 (20-int_of_float(log(float_of_num max1) /. log 2.0)) + and scal2 = pow2 (20-int_of_float(log(float_of_num max2) /. log 2.0)) in + let mats'' = map (mapf (fun x -> x */ scal1)) mats' + and obj'' = vec_cmul scal2 obj' in + solver obj'' mats'';; + +(* ------------------------------------------------------------------------- *) +(* Round a vector to "nice" rationals. *) +(* ------------------------------------------------------------------------- *) + +let nice_rational n x = round_num (n */ x) // n;; + +let nice_vector n = mapa (nice_rational n);; + +(* ------------------------------------------------------------------------- *) +(* Reduce linear program to SDP (diagonal matrices) and test with CSDP. This *) +(* one tests A [-1;x1;..;xn] >= 0 (i.e. left column is negated constants). *) +(* ------------------------------------------------------------------------- *) + +let linear_program_basic a = + let m,n = dimensions a in + let mats = map (fun j -> diagonal (column j a)) (1--n) + and obj = vec_const (Int 1) m in + let rv,res = run_csdp false obj mats in + if rv = 1 or rv = 2 then false + else if rv = 0 then true + else failwith "linear_program: An error occurred in the SDP solver";; + +(* ------------------------------------------------------------------------- *) +(* Alternative interface testing A x >= b for matrix A, vector b. *) +(* ------------------------------------------------------------------------- *) + +let linear_program a b = + let m,n = dimensions a in + if vec_dim b <> m then failwith "linear_program: incompatible dimensions" else + let mats = diagonal b :: map (fun j -> diagonal (column j a)) (1--n) + and obj = vec_const (Int 1) m in + let rv,res = run_csdp false obj mats in + if rv = 1 or rv = 2 then false + else if rv = 0 then true + else failwith "linear_program: An error occurred in the SDP solver";; + +(* ------------------------------------------------------------------------- *) +(* Test whether a point is in the convex hull of others. Rather than use *) +(* computational geometry, express as linear inequalities and call CSDP. *) +(* This is a bit lazy of me, but it's easy and not such a bottleneck so far. *) +(* ------------------------------------------------------------------------- *) + +let in_convex_hull pts pt = + let pts1 = (1::pt) :: map (fun x -> 1::x) pts in + let pts2 = map (fun p -> map (fun x -> -x) p @ p) pts1 in + let n = length pts + 1 + and v = 2 * (length pt + 1) in + let m = v + n - 1 in + let mat = + (m,n), + itern 1 pts2 (fun pts j -> itern 1 pts (fun x i -> (i,j) |-> Int x)) + (iter (1,n) (fun i -> (v + i,i+1) |-> Int 1) undefined) in + linear_program_basic mat;; + +(* ------------------------------------------------------------------------- *) +(* Filter down a set of points to a minimal set with the same convex hull. *) +(* ------------------------------------------------------------------------- *) + +let minimal_convex_hull = + let augment1 (m::ms) = if in_convex_hull ms m then ms else ms@[m] in + let augment m ms = funpow 3 augment1 (m::ms) in + fun mons -> + let mons' = itlist augment (tl mons) [hd mons] in + funpow (length mons') augment1 mons';; + +(* ------------------------------------------------------------------------- *) +(* Stuff for "equations" (generic A->num functions). *) +(* ------------------------------------------------------------------------- *) + +let equation_cmul c eq = + if c =/ Int 0 then undefined else mapf (fun d -> c */ d) eq;; + +let equation_add eq1 eq2 = combine (+/) (fun x -> x =/ Int 0) eq1 eq2;; + +let equation_eval assig eq = + let value v = apply assig v in + foldl (fun a v c -> a +/ value(v) */ c) (Int 0) eq;; + +(* ------------------------------------------------------------------------- *) +(* Eliminate among linear equations: return unconstrained variables and *) +(* assignments for the others in terms of them. We give one pseudo-variable *) +(* "one" that's used for a constant term. *) +(* ------------------------------------------------------------------------- *) + + +let eliminate_equations = + let rec extract_first p l = + match l with + [] -> failwith "extract_first" + | h::t -> if p(h) then h,t else + let k,s = extract_first p t in + k,h::s in + let rec eliminate vars dun eqs = + match vars with + [] -> if forall is_undefined eqs then dun +else raise Unsolvable + | v::vs -> + try let eq,oeqs = extract_first (fun e -> defined e v) eqs in + let a = apply eq v in + let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in + let elim e = + let b = tryapplyd e v (Int 0) in + if b =/ Int 0 then e else + equation_add e (equation_cmul (minus_num b // a) eq) in + eliminate vs ((v |-> eq') (mapf elim dun)) (map elim oeqs) + with Failure _ -> eliminate vs dun eqs in + fun one vars eqs -> + let assig = eliminate vars undefined eqs in + let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in + setify vs,assig;; + +(* ------------------------------------------------------------------------- *) +(* Eliminate all variables, in an essentially arbitrary order. *) +(* ------------------------------------------------------------------------- *) + +let eliminate_all_equations one = + let choose_variable eq = + let (v,_) = choose eq in + if v = one then + let eq' = undefine v eq in + if is_undefined eq' then failwith "choose_variable" else + let (w,_) = choose eq' in w + else v in + let rec eliminate dun eqs = + match eqs with + [] -> dun + | eq::oeqs -> + if is_undefined eq then eliminate dun oeqs else + let v = choose_variable eq in + let a = apply eq v in + let eq' = equation_cmul (Int(-1) // a) (undefine v eq) in + let elim e = + let b = tryapplyd e v (Int 0) in + if b =/ Int 0 then e else + equation_add e (equation_cmul (minus_num b // a) eq) in + eliminate ((v |-> eq') (mapf elim dun)) (map elim oeqs) in + fun eqs -> + let assig = eliminate undefined eqs in + let vs = foldl (fun a x f -> subtract (dom f) [one] @ a) [] assig in + setify vs,assig;; + +(* ------------------------------------------------------------------------- *) +(* Solve equations by assigning arbitrary numbers. *) +(* ------------------------------------------------------------------------- *) + +let solve_equations one eqs = + let vars,assigs = eliminate_all_equations one eqs in + let vfn = itlist (fun v -> (v |-> Int 0)) vars (one |=> Int(-1)) in + let ass = + combine (+/) (fun c -> false) (mapf (equation_eval vfn) assigs) vfn in + if forall (fun e -> equation_eval ass e =/ Int 0) eqs + then undefine one ass else raise Sanity;; + +(* ------------------------------------------------------------------------- *) +(* Hence produce the "relevant" monomials: those whose squares lie in the *) +(* Newton polytope of the monomials in the input. (This is enough according *) +(* to Reznik: "Extremal PSD forms with few terms", Duke Math. Journal, *) +(* vol 45, pp. 363--374, 1978. *) +(* *) +(* These are ordered in sort of decreasing degree. In particular the *) +(* constant monomial is last; this gives an order in diagonalization of the *) +(* quadratic form that will tend to display constants. *) +(* ------------------------------------------------------------------------- *) + +let newton_polytope pol = + let vars = poly_variables pol in + let mons = map (fun m -> map (fun x -> monomial_degree x m) vars) (dom pol) + and ds = map (fun x -> (degree x pol + 1) / 2) vars in + let all = itlist (fun n -> allpairs (fun h t -> h::t) (0--n)) ds [[]] + and mons' = minimal_convex_hull mons in + let all' = + filter (fun m -> in_convex_hull mons' (map (fun x -> 2 * x) m)) all in + map (fun m -> itlist2 (fun v i a -> if i = 0 then a else (v |-> i) a) + vars m monomial_1) (rev all');; + +(* ------------------------------------------------------------------------- *) +(* Diagonalize (Cholesky/LDU) the matrix corresponding to a quadratic form. *) +(* ------------------------------------------------------------------------- *) + +let diag m = + let nn = dimensions m in + let n = fst nn in + if snd nn <> n then failwith "diagonalize: non-square matrix" else + let rec diagonalize i m = + if is_zero m then [] else + let a11 = element m (i,i) in + if a11 a1k // a11) v in + let m' = + (n,n), + iter (i+1,n) (fun j -> + iter (i+1,n) (fun k -> + ((j,k) |--> (element m (j,k) -/ element v j */ element v' k)))) + undefined in + (a11,v')::diagonalize (i + 1) m' in + diagonalize 1 m;; + +(* ------------------------------------------------------------------------- *) +(* Adjust a diagonalization to collect rationals at the start. *) +(* ------------------------------------------------------------------------- *) + +let deration d = + if d = [] then Int 0,d else + let adj(c,l) = + let a = foldl (fun a i c -> lcm_num a (denominator c)) (Int 1) (snd l) // + foldl (fun a i c -> gcd_num a (numerator c)) (Int 0) (snd l) in + (c // (a */ a)),mapa (fun x -> a */ x) l in + let d' = map adj d in + let a = itlist (lcm_num o denominator o fst) d' (Int 1) // + itlist (gcd_num o numerator o fst) d' (Int 0) in + (Int 1 // a),map (fun (c,l) -> (a */ c,l)) d';; + +(* ------------------------------------------------------------------------- *) +(* Enumeration of monomials with given multidegree bound. *) +(* ------------------------------------------------------------------------- *) + +let rec enumerate_monomials d vars = + if d < 0 then [] + else if d = 0 then [undefined] + else if vars = [] then [monomial_1] else + let alts = + map (fun k -> let oths = enumerate_monomials (d - k) (tl vars) in + map (fun ks -> if k = 0 then ks else (hd vars |-> k) ks) oths) + (0--d) in + end_itlist (@) alts;; + +(* ------------------------------------------------------------------------- *) +(* Enumerate products of distinct input polys with degree <= d. *) +(* We ignore any constant input polynomials. *) +(* Give the output polynomial and a record of how it was derived. *) +(* ------------------------------------------------------------------------- *) + +let rec enumerate_products d pols = + if d = 0 then [poly_const num_1,Rational_lt num_1] else if d < 0 then [] else + match pols with + [] -> [poly_const num_1,Rational_lt num_1] + | (p,b)::ps -> let e = multidegree p in + if e = 0 then enumerate_products d ps else + enumerate_products d ps @ + map (fun (q,c) -> poly_mul p q,Product(b,c)) + (enumerate_products (d - e) ps);; + +(* ------------------------------------------------------------------------- *) +(* Multiply equation-parametrized poly by regular poly and add accumulator. *) +(* ------------------------------------------------------------------------- *) + +let epoly_pmul p q acc = + foldl (fun a m1 c -> + foldl (fun b m2 e -> + let m = monomial_mul m1 m2 in + let es = tryapplyd b m undefined in + (m |-> equation_add (equation_cmul c e) es) b) + a q) acc p;; + +(* ------------------------------------------------------------------------- *) +(* Usual operations on equation-parametrized poly. *) +(* ------------------------------------------------------------------------- *) + +let epoly_cmul c l = + if c =/ Int 0 then undefined else mapf (equation_cmul c) l;; + + + + +(* ------------------------------------------------------------------------- *) +(* Convert regular polynomial. Note that we treat (0,0,0) as -1. *) +(* ------------------------------------------------------------------------- *) + +let epoly_of_poly p = + foldl (fun a m c -> (m |-> ((0,0,0) |=> minus_num c)) a) undefined p;; + +(* ------------------------------------------------------------------------- *) +(* String for block diagonal matrix numbered k. *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_blockdiagonal k m = + let pfx = string_of_int k ^" " in + let ents = + foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in + let entss = sort (increasing fst) ents in + itlist (fun ((b,i,j),c) a -> + pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^ + " " ^ decimalize 20 c ^ "\n" ^ a) entss "";; + +(* ------------------------------------------------------------------------- *) +(* SDPA for problem using block diagonal (i.e. multiple SDPs) *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_blockproblem comment nblocks blocksizes obj mats = + let m = length mats - 1 in + "\"" ^ comment ^ "\"\n" ^ + string_of_int m ^ "\n" ^ + string_of_int nblocks ^ "\n" ^ + (end_itlist (fun s t -> s^" "^t) (map string_of_int blocksizes)) ^ + "\n" ^ + sdpa_of_vector obj ^ + itlist2 (fun k m a -> sdpa_of_blockdiagonal (k - 1) m ^ a) + (1--length mats) mats "";; + +(* ------------------------------------------------------------------------- *) +(* Hence run CSDP on a problem in block diagonal form. *) +(* ------------------------------------------------------------------------- *) + +let run_csdp dbg nblocks blocksizes obj mats = + let input_file = Filename.temp_file "sos" ".dat-s" in + let output_file = + String.sub input_file 0 (String.length input_file - 6) ^ ".out" + and params_file = Filename.concat (!temp_path) "param.csdp" in + file_of_string input_file + (sdpa_of_blockproblem "" nblocks blocksizes obj mats); + file_of_string params_file csdp_params; + let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^ + " " ^ output_file ^ + (if dbg then "" else "> /dev/null")) in + let op = string_of_file output_file in + let res = parse_csdpoutput op in + ((if dbg then () + else (Sys.remove input_file; Sys.remove output_file)); + rv,res);; + +let csdp nblocks blocksizes obj mats = + let rv,res = run_csdp (!debugging) nblocks blocksizes obj mats in + (if rv = 1 or rv = 2 then failwith "csdp: Problem is infeasible" + else if rv = 3 then + (Format.print_string "csdp warning: Reduced accuracy"; + Format.print_newline()) + else if rv <> 0 then failwith("csdp: error "^string_of_int rv) + else ()); + res;; + +(* ------------------------------------------------------------------------- *) +(* 3D versions of matrix operations to consider blocks separately. *) +(* ------------------------------------------------------------------------- *) + +let bmatrix_add = combine (+/) (fun x -> x =/ Int 0);; + +let bmatrix_cmul c bm = + if c =/ Int 0 then undefined + else mapf (fun x -> c */ x) bm;; + +let bmatrix_neg = bmatrix_cmul (Int(-1));; + +let bmatrix_sub m1 m2 = bmatrix_add m1 (bmatrix_neg m2);; + +(* ------------------------------------------------------------------------- *) +(* Smash a block matrix into components. *) +(* ------------------------------------------------------------------------- *) + +let blocks blocksizes bm = + map (fun (bs,b0) -> + let m = foldl + (fun a (b,i,j) c -> if b = b0 then ((i,j) |-> c) a else a) + undefined bm in + let d = foldl (fun a (i,j) c -> max a (max i j)) 0 m in + (((bs,bs),m):matrix)) + (zip blocksizes (1--length blocksizes));; + +(* ------------------------------------------------------------------------- *) +(* Positiv- and Nullstellensatz. Flag "linf" forces a linear representation. *) +(* ------------------------------------------------------------------------- *) + +let real_positivnullstellensatz_general linf d eqs leqs pol = + let vars = itlist (union o poly_variables) (pol::eqs @ map fst leqs) [] in + let monoid = + if linf then + (poly_const num_1,Rational_lt num_1):: + (filter (fun (p,c) -> multidegree p <= d) leqs) + else enumerate_products d leqs in + let nblocks = length monoid in + let mk_idmultiplier k p = + let e = d - multidegree p in + let mons = enumerate_monomials e vars in + let nons = zip mons (1--length mons) in + mons, + itlist (fun (m,n) -> (m |-> ((-k,-n,n) |=> Int 1))) nons undefined in + let mk_sqmultiplier k (p,c) = + let e = (d - multidegree p) / 2 in + let mons = enumerate_monomials e vars in + let nons = zip mons (1--length mons) in + mons, + itlist (fun (m1,n1) -> + itlist (fun (m2,n2) a -> + let m = monomial_mul m1 m2 in + if n1 > n2 then a else + let c = if n1 = n2 then Int 1 else Int 2 in + let e = tryapplyd a m undefined in + (m |-> equation_add ((k,n1,n2) |=> c) e) a) + nons) + nons undefined in + let sqmonlist,sqs = unzip(map2 mk_sqmultiplier (1--length monoid) monoid) + and idmonlist,ids = unzip(map2 mk_idmultiplier (1--length eqs) eqs) in + let blocksizes = map length sqmonlist in + let bigsum = + itlist2 (fun p q a -> epoly_pmul p q a) eqs ids + (itlist2 (fun (p,c) s a -> epoly_pmul p s a) monoid sqs + (epoly_of_poly(poly_neg pol))) in + let eqns = foldl (fun a m e -> e::a) [] bigsum in + let pvs,assig = eliminate_all_equations (0,0,0) eqns in + let qvars = (0,0,0)::pvs in + let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in + let mk_matrix v = + foldl (fun m (b,i,j) ass -> if b < 0 then m else + let c = tryapplyd ass v (Int 0) in + if c =/ Int 0 then m else + ((b,j,i) |-> c) (((b,i,j) |-> c) m)) + undefined allassig in + let diagents = foldl + (fun a (b,i,j) e -> if b > 0 & i = j then equation_add e a else a) + undefined allassig in + let mats = map mk_matrix qvars + and obj = length pvs, + itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (Int 0))) + undefined in + let raw_vec = if pvs = [] then vec_0 0 + else scale_then (csdp nblocks blocksizes) obj mats in + let find_rounding d = + (if !debugging then + (Format.print_string("Trying rounding with limit "^string_of_num d); + Format.print_newline()) + else ()); + let vec = nice_vector d raw_vec in + let blockmat = iter (1,vec_dim vec) + (fun i a -> bmatrix_add (bmatrix_cmul (element vec i) (el i mats)) a) + (bmatrix_neg (el 0 mats)) in + let allmats = blocks blocksizes blockmat in + vec,map diag allmats in + let vec,ratdias = + if pvs = [] then find_rounding num_1 + else tryfind find_rounding (map Num.num_of_int (1--31) @ + map pow2 (5--66)) in + let newassigs = + itlist (fun k -> el (k - 1) pvs |-> element vec k) + (1--vec_dim vec) ((0,0,0) |=> Int(-1)) in + let finalassigs = + foldl (fun a v e -> (v |-> equation_eval newassigs e) a) newassigs + allassig in + let poly_of_epoly p = + foldl (fun a v e -> (v |--> equation_eval finalassigs e) a) + undefined p in + let mk_sos mons = + let mk_sq (c,m) = + c,itlist (fun k a -> (el (k - 1) mons |--> element m k) a) + (1--length mons) undefined in + map mk_sq in + let sqs = map2 mk_sos sqmonlist ratdias + and cfs = map poly_of_epoly ids in + let msq = filter (fun (a,b) -> b <> []) (map2 (fun a b -> a,b) monoid sqs) in + let eval_sq sqs = itlist + (fun (c,q) -> poly_add (poly_cmul c (poly_mul q q))) sqs poly_0 in + let sanity = + itlist (fun ((p,c),s) -> poly_add (poly_mul p (eval_sq s))) msq + (itlist2 (fun p q -> poly_add (poly_mul p q)) cfs eqs + (poly_neg pol)) in + if not(is_undefined sanity) then raise Sanity else + cfs,map (fun (a,b) -> snd a,b) msq;; + +(* ------------------------------------------------------------------------- *) +(* Iterative deepening. *) +(* ------------------------------------------------------------------------- *) + +let rec deepen f n = + try print_string "Searching with depth limit "; + print_int n; print_newline(); f n + with Failure _ -> deepen f (n + 1);; + +(* ------------------------------------------------------------------------- *) +(* The ordering so we can create canonical HOL polynomials. *) +(* ------------------------------------------------------------------------- *) + +let dest_monomial mon = sort (increasing fst) (graph mon);; + +let monomial_order = + let rec lexorder l1 l2 = + match (l1,l2) with + [],[] -> true + | vps,[] -> false + | [],vps -> true + | ((x1,n1)::vs1),((x2,n2)::vs2) -> + if x1 < x2 then true + else if x2 < x1 then false + else if n1 < n2 then false + else if n2 < n1 then true + else lexorder vs1 vs2 in + fun m1 m2 -> + if m2 = monomial_1 then true else if m1 = monomial_1 then false else + let mon1 = dest_monomial m1 and mon2 = dest_monomial m2 in + let deg1 = itlist ((+) o snd) mon1 0 + and deg2 = itlist ((+) o snd) mon2 0 in + if deg1 < deg2 then false else if deg1 > deg2 then true + else lexorder mon1 mon2;; + +let dest_poly p = + map (fun (m,c) -> c,dest_monomial m) + (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p));; + +(* ------------------------------------------------------------------------- *) +(* Map back polynomials and their composites to HOL. *) +(* ------------------------------------------------------------------------- *) + +let term_of_varpow = + let pow_tm = `(pow):real->num->real` in + fun x k -> + if k = 1 then x else mk_comb(mk_comb(pow_tm,x),mk_small_numeral k);; + +let term_of_monomial = + let one_tm = `&1:real` + and mul_tm = `(*):real->real->real` in + fun m -> if m = monomial_1 then one_tm else + let m' = dest_monomial m in + let vps = itlist (fun (x,k) a -> term_of_varpow x k :: a) m' [] in + end_itlist (fun s t -> mk_comb(mk_comb(mul_tm,s),t)) vps;; + +let term_of_cmonomial = + let mul_tm = `(*):real->real->real` in + fun (m,c) -> + if m = monomial_1 then term_of_rat c + else if c =/ num_1 then term_of_monomial m + else mk_comb(mk_comb(mul_tm,term_of_rat c),term_of_monomial m);; + +let term_of_poly = + let zero_tm = `&0:real` + and add_tm = `(+):real->real->real` in + fun p -> + if p = poly_0 then zero_tm else + let cms = map term_of_cmonomial + (sort (fun (m1,_) (m2,_) -> monomial_order m1 m2) (graph p)) in + end_itlist (fun t1 t2 -> mk_comb(mk_comb(add_tm,t1),t2)) cms;; + +let term_of_sqterm (c,p) = + Product(Rational_lt c,Square(term_of_poly p));; + +let term_of_sos (pr,sqs) = + if sqs = [] then pr + else Product(pr,end_itlist (fun a b -> Sum(a,b)) (map term_of_sqterm sqs));; + +(* ------------------------------------------------------------------------- *) +(* Interface to HOL. *) +(* ------------------------------------------------------------------------- *) + +let REAL_NONLINEAR_PROVER translator (eqs,les,lts) = + let eq0 = map (poly_of_term o lhand o concl) eqs + and le0 = map (poly_of_term o lhand o concl) les + and lt0 = map (poly_of_term o lhand o concl) lts in + let eqp0 = map (fun (t,i) -> t,Axiom_eq i) (zip eq0 (0--(length eq0 - 1))) + and lep0 = map (fun (t,i) -> t,Axiom_le i) (zip le0 (0--(length le0 - 1))) + and ltp0 = map (fun (t,i) -> t,Axiom_lt i) (zip lt0 (0--(length lt0 - 1))) in + let keq,eq = partition (fun (p,_) -> multidegree p = 0) eqp0 + and klep,lep = partition (fun (p,_) -> multidegree p = 0) lep0 + and kltp,ltp = partition (fun (p,_) -> multidegree p = 0) ltp0 in + let trivial_axiom (p,ax) = + match ax with + Axiom_eq n when eval undefined p <>/ num_0 -> el n eqs + | Axiom_le n when eval undefined p el n les + | Axiom_lt n when eval undefined p <=/ num_0 -> el n lts + | _ -> failwith "not a trivial axiom" in + try let th = tryfind trivial_axiom (keq @ klep @ kltp) in + CONV_RULE (LAND_CONV REAL_POLY_CONV THENC REAL_RAT_RED_CONV) th + with Failure _ -> + let pol = itlist poly_mul (map fst ltp) (poly_const num_1) in + let leq = lep @ ltp in + let tryall d = + let e = multidegree pol in + let k = if e = 0 then 0 else d / e in + let eq' = map fst eq in + tryfind (fun i -> d,i,real_positivnullstellensatz_general false d eq' leq + (poly_neg(poly_pow pol i))) + (0--k) in + let d,i,(cert_ideal,cert_cone) = deepen tryall 0 in + let proofs_ideal = + map2 (fun q (p,ax) -> Eqmul(term_of_poly q,ax)) cert_ideal eq + and proofs_cone = map term_of_sos cert_cone + and proof_ne = + if ltp = [] then Rational_lt num_1 else + let p = end_itlist (fun s t -> Product(s,t)) (map snd ltp) in + funpow i (fun q -> Product(p,q)) (Rational_lt num_1) in + let proof = end_itlist (fun s t -> Sum(s,t)) + (proof_ne :: proofs_ideal @ proofs_cone) in + print_string("Translating proof certificate to HOL"); + print_newline(); + translator (eqs,les,lts) proof;; + +(* ------------------------------------------------------------------------- *) +(* A wrapper that tries to substitute away variables first. *) +(* ------------------------------------------------------------------------- *) + +let REAL_NONLINEAR_SUBST_PROVER = + let zero = `&0:real` + and mul_tm = `( * ):real->real->real` + and shuffle1 = + CONV_RULE(REWR_CONV(REAL_ARITH `a + x = (y:real) <=> x = y - a`)) + and shuffle2 = + CONV_RULE(REWR_CONV(REAL_ARITH `x + a = (y:real) <=> x = y - a`)) in + let rec substitutable_monomial fvs tm = + match tm with + Var(_,Tyapp("real",[])) when not (mem tm fvs) -> Int 1,tm + | Comb(Comb(Const("real_mul",_),c),(Var(_,_) as t)) + when is_ratconst c & not (mem t fvs) + -> rat_of_term c,t + | Comb(Comb(Const("real_add",_),s),t) -> + (try substitutable_monomial (union (frees t) fvs) s + with Failure _ -> substitutable_monomial (union (frees s) fvs) t) + | _ -> failwith "substitutable_monomial" + and isolate_variable v th = + match lhs(concl th) with + x when x = v -> th + | Comb(Comb(Const("real_add",_),(Var(_,Tyapp("real",[])) as x)),t) + when x = v -> shuffle2 th + | Comb(Comb(Const("real_add",_),s),t) -> + isolate_variable v(shuffle1 th) in + let make_substitution th = + let (c,v) = substitutable_monomial [] (lhs(concl th)) in + let th1 = AP_TERM (mk_comb(mul_tm,term_of_rat(Int 1 // c))) th in + let th2 = CONV_RULE(BINOP_CONV REAL_POLY_MUL_CONV) th1 in + CONV_RULE (RAND_CONV REAL_POLY_CONV) (isolate_variable v th2) in + fun translator -> + let rec substfirst(eqs,les,lts) = + try let eth = tryfind make_substitution eqs in + let modify = + CONV_RULE(LAND_CONV(SUBS_CONV[eth] THENC REAL_POLY_CONV)) in + substfirst(filter (fun t -> lhand(concl t) <> zero) (map modify eqs), + map modify les,map modify lts) + with Failure _ -> REAL_NONLINEAR_PROVER translator (eqs,les,lts) in + substfirst;; + +(* ------------------------------------------------------------------------- *) +(* Overall function. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SOS = + let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] + and pure = GEN_REAL_ARITH REAL_NONLINEAR_SUBST_PROVER in + fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; + +(* ------------------------------------------------------------------------- *) +(* Add hacks for division. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SOSFIELD = + let inv_tm = `inv:real->real` in + let prenex_conv = + TOP_DEPTH_CONV BETA_CONV THENC + PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; real_div; + REAL_INV_INV; REAL_INV_MUL; GSYM REAL_POW_INV] THENC + NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC + PRENEX_CONV + and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV + and core_rule t = + try REAL_ARITH t + with Failure _ -> try REAL_RING t + with Failure _ -> REAL_SOS t + and is_inv = + let is_div = is_binop `(/):real->real->real` in + fun tm -> (is_div tm or (is_comb tm & rator tm = inv_tm)) & + not(is_ratconst(rand tm)) in + let BASIC_REAL_FIELD tm = + let is_freeinv t = is_inv t & free_in t tm in + let itms = setify(map rand (find_terms is_freeinv tm)) in + let hyps = map (fun t -> SPEC t REAL_MUL_RINV) itms in + let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in + let itms' = map (curry mk_comb inv_tm) itms in + let gvs = map (genvar o type_of) itms' in + let tm'' = subst (zip gvs itms') tm' in + let th1 = setup_conv tm'' in + let cjs = conjuncts(rand(concl th1)) in + let ths = map core_rule cjs in + let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in + rev_itlist (C MP) hyps (INST (zip itms' gvs) th2) in + fun tm -> + let th0 = prenex_conv tm in + let tm0 = rand(concl th0) in + let avs,bod = strip_forall tm0 in + let th1 = setup_conv bod in + let ths = map BASIC_REAL_FIELD (conjuncts(rand(concl th1))) in + EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; + +(* ------------------------------------------------------------------------- *) +(* Integer version. *) +(* ------------------------------------------------------------------------- *) + +let INT_SOS = + let atom_CONV = + let pth = prove + (`(~(x <= y) <=> y + &1 <= x:int) /\ + (~(x < y) <=> y <= x) /\ + (~(x = y) <=> x + &1 <= y \/ y + &1 <= x) /\ + (x < y <=> x + &1 <= y)`, + REWRITE_TAC[INT_NOT_LE; INT_NOT_LT; INT_NOT_EQ; INT_LT_DISCRETE]) in + GEN_REWRITE_CONV I [pth] + and bub_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV + [int_eq; int_le; int_lt; int_ge; int_gt; + int_of_num_th; int_neg_th; int_add_th; int_mul_th; + int_sub_th; int_pow_th; int_abs_th; int_max_th; int_min_th] in + let base_CONV = TRY_CONV atom_CONV THENC bub_CONV in + let NNF_NORM_CONV = GEN_NNF_CONV false + (base_CONV,fun t -> base_CONV t,base_CONV(mk_neg t)) in + let init_CONV = + GEN_REWRITE_CONV DEPTH_CONV [FORALL_SIMP; EXISTS_SIMP] THENC + GEN_REWRITE_CONV DEPTH_CONV [INT_GT; INT_GE] THENC + CONDS_ELIM_CONV THENC NNF_NORM_CONV in + let p_tm = `p:bool` + and not_tm = `(~)` in + let pth = TAUT(mk_eq(mk_neg(mk_neg p_tm),p_tm)) in + fun tm -> + let th0 = INST [tm,p_tm] pth + and th1 = NNF_NORM_CONV(mk_neg tm) in + let th2 = REAL_SOS(mk_neg(rand(concl th1))) in + EQ_MP th0 (EQ_MP (AP_TERM not_tm (SYM th1)) th2);; + +(* ------------------------------------------------------------------------- *) +(* Natural number version. *) +(* ------------------------------------------------------------------------- *) + +let SOS_RULE tm = + let avs = frees tm in + let tm' = list_mk_forall(avs,tm) in + let th1 = NUM_TO_INT_CONV tm' in + let th2 = INT_SOS (rand(concl th1)) in + SPECL avs (EQ_MP (SYM th1) th2);; + +(* ------------------------------------------------------------------------- *) +(* Now pure SOS stuff. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Some combinatorial helper functions. *) +(* ------------------------------------------------------------------------- *) + +let rec allpermutations l = + if l = [] then [[]] else + itlist (fun h acc -> map (fun t -> h::t) + (allpermutations (subtract l [h])) @ acc) l [];; + +let allvarorders l = + map (fun vlis x -> index x vlis) (allpermutations l);; + +let changevariables_monomial zoln (m:monomial) = + foldl (fun a x k -> (assoc x zoln |-> k) a) monomial_1 m;; + +let changevariables zoln pol = + foldl (fun a m c -> (changevariables_monomial zoln m |-> c) a) + poly_0 pol;; + +(* ------------------------------------------------------------------------- *) +(* Return to original non-block matrices. *) +(* ------------------------------------------------------------------------- *) + +let sdpa_of_vector (v:vector) = + let n = vec_dim v in + let strs = map (decimalize 20 o element v) (1--n) in + end_itlist (fun x y -> x ^ " " ^ y) strs ^ "\n";; + +let sdpa_of_blockdiagonal k m = + let pfx = string_of_int k ^" " in + let ents = + foldl (fun a (b,i,j) c -> if i > j then a else ((b,i,j),c)::a) [] m in + let entss = sort (increasing fst) ents in + itlist (fun ((b,i,j),c) a -> + pfx ^ string_of_int b ^ " " ^ string_of_int i ^ " " ^ string_of_int j ^ + " " ^ decimalize 20 c ^ "\n" ^ a) entss "";; + +let sdpa_of_matrix k (m:matrix) = + let pfx = string_of_int k ^ " 1 " in + let ms = foldr (fun (i,j) c a -> if i > j then a else ((i,j),c)::a) + (snd m) [] in + let mss = sort (increasing fst) ms in + itlist (fun ((i,j),c) a -> + pfx ^ string_of_int i ^ " " ^ string_of_int j ^ + " " ^ decimalize 20 c ^ "\n" ^ a) mss "";; + +let sdpa_of_problem comment obj mats = + let m = length mats - 1 + and n,_ = dimensions (hd mats) in + "\"" ^ comment ^ "\"\n" ^ + string_of_int m ^ "\n" ^ + "1\n" ^ + string_of_int n ^ "\n" ^ + sdpa_of_vector obj ^ + itlist2 (fun k m a -> sdpa_of_matrix (k - 1) m ^ a) + (1--length mats) mats "";; + +let run_sdpa dbg obj mats = + let input_file = Filename.temp_file "sos" ".dat-s" in + let output_file = + String.sub input_file 0 (String.length input_file - 6) ^ ".out" + and params_file = Filename.concat (!temp_path) "param.sdpa" in + file_of_string input_file (sdpa_of_problem "" obj mats); + file_of_string params_file sdpa_params; + Sys.command("cd "^(!temp_path)^"; sdpa "^input_file ^ " " ^ output_file ^ + (if dbg then "" else "> /dev/null")); + let op = string_of_file output_file in + if not(sdpa_run_succeeded op) then failwith "sdpa: call failed" else + let res = parse_sdpaoutput op in + ((if dbg then () + else (Sys.remove input_file; Sys.remove output_file)); + res);; + +let sdpa obj mats = run_sdpa (!debugging) obj mats;; + +let run_csdp dbg obj mats = + let input_file = Filename.temp_file "sos" ".dat-s" in + let output_file = + String.sub input_file 0 (String.length input_file - 6) ^ ".out" + and params_file = Filename.concat (!temp_path) "param.csdp" in + file_of_string input_file (sdpa_of_problem "" obj mats); + file_of_string params_file csdp_params; + let rv = Sys.command("cd "^(!temp_path)^"; csdp "^input_file ^ + " " ^ output_file ^ + (if dbg then "" else "> /dev/null")) in + let op = string_of_file output_file in + let res = parse_csdpoutput op in + ((if dbg then () + else (Sys.remove input_file; Sys.remove output_file)); + rv,res);; + +let csdp obj mats = + let rv,res = run_csdp (!debugging) obj mats in + (if rv = 1 or rv = 2 then failwith "csdp: Problem is infeasible" + else if rv = 3 then + (Format.print_string "csdp warning: Reduced accuracy"; + Format.print_newline()) + else if rv <> 0 then failwith("csdp: error "^string_of_int rv) + else ()); + res;; + +(* ------------------------------------------------------------------------- *) +(* Sum-of-squares function with some lowbrow symmetry reductions. *) +(* ------------------------------------------------------------------------- *) + +let sumofsquares_general_symmetry tool pol = + let vars = poly_variables pol + and lpps = newton_polytope pol in + let n = length lpps in + let sym_eqs = + let invariants = filter + (fun vars' -> + is_undefined(poly_sub pol (changevariables (zip vars vars') pol))) + (allpermutations vars) in + let lpps2 = allpairs monomial_mul lpps lpps in + let lpp2_classes = + setify(map (fun m -> + setify(map (fun vars' -> changevariables_monomial (zip vars vars') m) + invariants)) lpps2) in + let lpns = zip lpps (1--length lpps) in + let lppcs = + filter (fun (m,(n1,n2)) -> n1 <= n2) + (allpairs + (fun (m1,n1) (m2,n2) -> (m1,m2),(n1,n2)) lpns lpns) in + let clppcs = end_itlist (@) + (map (fun ((m1,m2),(n1,n2)) -> + map (fun vars' -> + (changevariables_monomial (zip vars vars') m1, + changevariables_monomial (zip vars vars') m2),(n1,n2)) + invariants) + lppcs) in + let clppcs_dom = setify(map fst clppcs) in + let clppcs_cls = map (fun d -> filter (fun (e,_) -> e = d) clppcs) + clppcs_dom in + let eqvcls = map (setify o map snd) clppcs_cls in + let mk_eq cls acc = + match cls with + [] -> raise Sanity + | [h] -> acc + | h::t -> map (fun k -> (k |-> Int(-1)) (h |=> Int 1)) t @ acc in + itlist mk_eq eqvcls [] in + let eqs = foldl (fun a x y -> y::a) [] + (itern 1 lpps (fun m1 n1 -> + itern 1 lpps (fun m2 n2 f -> + let m = monomial_mul m1 m2 in + if n1 > n2 then f else + let c = if n1 = n2 then Int 1 else Int 2 in + (m |-> ((n1,n2) |-> c) (tryapplyd f m undefined)) f)) + (foldl (fun a m c -> (m |-> ((0,0)|=>c)) a) + undefined pol)) @ + sym_eqs in + let pvs,assig = eliminate_all_equations (0,0) eqs in + let allassig = itlist (fun v -> (v |-> (v |=> Int 1))) pvs assig in + let qvars = (0,0)::pvs in + let diagents = + end_itlist equation_add (map (fun i -> apply allassig (i,i)) (1--n)) in + let mk_matrix v = + ((n,n), + foldl (fun m (i,j) ass -> let c = tryapplyd ass v (Int 0) in + if c =/ Int 0 then m else + ((j,i) |-> c) (((i,j) |-> c) m)) + undefined allassig :matrix) in + let mats = map mk_matrix qvars + and obj = length pvs, + itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (Int 0))) + undefined in + let raw_vec = if pvs = [] then vec_0 0 else tool obj mats in + let find_rounding d = + (if !debugging then + (Format.print_string("Trying rounding with limit "^string_of_num d); + Format.print_newline()) + else ()); + let vec = nice_vector d raw_vec in + let mat = iter (1,vec_dim vec) + (fun i a -> matrix_add (matrix_cmul (element vec i) (el i mats)) a) + (matrix_neg (el 0 mats)) in + deration(diag mat) in + let rat,dia = + if pvs = [] then + let mat = matrix_neg (el 0 mats) in + deration(diag mat) + else + tryfind find_rounding (map Num.num_of_int (1--31) @ + map pow2 (5--66)) in + let poly_of_lin(d,v) = + d,foldl(fun a i c -> (el (i - 1) lpps |-> c) a) undefined (snd v) in + let lins = map poly_of_lin dia in + let sqs = map (fun (d,l) -> poly_mul (poly_const d) (poly_pow l 2)) lins in + let sos = poly_cmul rat (end_itlist poly_add sqs) in + if is_undefined(poly_sub sos pol) then rat,lins else raise Sanity;; + +let sumofsquares = sumofsquares_general_symmetry csdp;; + +(* ------------------------------------------------------------------------- *) +(* Pure HOL SOS conversion. *) +(* ------------------------------------------------------------------------- *) + +let SOS_CONV = + let mk_square = + let pow_tm = `(pow)` and two_tm = `2` in + fun tm -> mk_comb(mk_comb(pow_tm,tm),two_tm) + and mk_prod = mk_binop `(*)` + and mk_sum = mk_binop `(+)` in + fun tm -> + let k,sos = sumofsquares(poly_of_term tm) in + let mk_sqtm(c,p) = + mk_prod (term_of_rat(k */ c)) (mk_square(term_of_poly p)) in + let tm' = end_itlist mk_sum (map mk_sqtm sos) in + let th = REAL_POLY_CONV tm and th' = REAL_POLY_CONV tm' in + TRANS th (SYM th');; + +(* ------------------------------------------------------------------------- *) +(* Attempt to prove &0 <= x by direct SOS decomposition. *) +(* ------------------------------------------------------------------------- *) + +let PURE_SOS_TAC = + let tac = + MATCH_ACCEPT_TAC(REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE) ORELSE + MATCH_ACCEPT_TAC REAL_LE_SQUARE ORELSE + (MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) ORELSE + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV THENC REAL_RAT_LE_CONV) in + REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN + GEN_REWRITE_TAC I [GSYM REAL_SUB_LE] THEN + CONV_TAC(RAND_CONV SOS_CONV) THEN + REPEAT tac THEN NO_TAC;; + +let PURE_SOS tm = prove(tm,PURE_SOS_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Examples. *) +(* ------------------------------------------------------------------------- *) + +(***** + +time REAL_SOS + `a1 >= &0 /\ a2 >= &0 /\ + (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + &2) /\ + (a1 * b1 + a2 * b2 = &0) + ==> a1 * a2 - b1 * b2 >= &0`;; + +time REAL_SOS `&3 * x + &7 * a < &4 /\ &3 < &2 * x ==> a < &0`;; + +time REAL_SOS + `b pow 2 < &4 * a * c ==> ~(a * x pow 2 + b * x + c = &0)`;; + +time REAL_SOS + `(a * x pow 2 + b * x + c = &0) ==> b pow 2 >= &4 * a * c`;; + +time REAL_SOS + `&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 + ==> x pow 2 + y pow 2 < &1 \/ + (x - &1) pow 2 + y pow 2 < &1 \/ + x pow 2 + (y - &1) pow 2 < &1 \/ + (x - &1) pow 2 + (y - &1) pow 2 < &1`;; + +time REAL_SOS + `&0 <= b /\ &0 <= c /\ &0 <= x /\ &0 <= y /\ + (x pow 2 = c) /\ (y pow 2 = a pow 2 * c + b) + ==> a * c <= y * x`;; + +time REAL_SOS + `&0 <= x /\ &0 <= y /\ &0 <= z /\ x + y + z <= &3 + ==> x * y + x * z + y * z >= &3 * x * y * z`;; + +time REAL_SOS + `(x pow 2 + y pow 2 + z pow 2 = &1) ==> (x + y + z) pow 2 <= &3`;; + +time REAL_SOS + `(w pow 2 + x pow 2 + y pow 2 + z pow 2 = &1) + ==> (w + x + y + z) pow 2 <= &4`;; + +time REAL_SOS + `x >= &1 /\ y >= &1 ==> x * y >= x + y - &1`;; + +time REAL_SOS + `x > &1 /\ y > &1 ==> x * y > x + y - &1`;; + +time REAL_SOS + `abs(x) <= &1 + ==> abs(&64 * x pow 7 - &112 * x pow 5 + &56 * x pow 3 - &7 * x) <= &1`;; + +time REAL_SOS + `abs(x - z) <= e /\ abs(y - z) <= e /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> abs((u * x + v * y) - z) <= e`;; + +(* ------------------------------------------------------------------------- *) +(* One component of denominator in dodecahedral example. *) +(* ------------------------------------------------------------------------- *) + +time REAL_SOS + `&2 <= x /\ x <= &125841 / &50000 /\ + &2 <= y /\ y <= &125841 / &50000 /\ + &2 <= z /\ z <= &125841 / &50000 + ==> &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z) >= &0`;; + +(* ------------------------------------------------------------------------- *) +(* Over a larger but simpler interval. *) +(* ------------------------------------------------------------------------- *) + +time REAL_SOS + `&2 <= x /\ x <= &4 /\ &2 <= y /\ y <= &4 /\ &2 <= z /\ z <= &4 + ==> &0 <= &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)`;; + +(* ------------------------------------------------------------------------- *) +(* We can do 12. I think 12 is a sharp bound; see PP's certificate. *) +(* ------------------------------------------------------------------------- *) + +time REAL_SOS + `&2 <= x /\ x <= &4 /\ &2 <= y /\ y <= &4 /\ &2 <= z /\ z <= &4 + ==> &12 <= &2 * (x * z + x * y + y * z) - (x * x + y * y + z * z)`;; + +(* ------------------------------------------------------------------------- *) +(* Gloptipoly example. *) +(* ------------------------------------------------------------------------- *) + +(*** This works but normalization takes minutes + +time REAL_SOS + `(x - y - &2 * x pow 4 = &0) /\ &0 <= x /\ x <= &2 /\ &0 <= y /\ y <= &3 + ==> y pow 2 - &7 * y - &12 * x + &17 >= &0`;; + + ***) + +(* ------------------------------------------------------------------------- *) +(* Inequality from sci.math (see "Leon-Sotelo, por favor"). *) +(* ------------------------------------------------------------------------- *) + +time REAL_SOS + `&0 <= x /\ &0 <= y /\ (x * y = &1) + ==> x + y <= x pow 2 + y pow 2`;; + +time REAL_SOS + `&0 <= x /\ &0 <= y /\ (x * y = &1) + ==> x * y * (x + y) <= x pow 2 + y pow 2`;; + +time REAL_SOS + `&0 <= x /\ &0 <= y ==> x * y * (x + y) pow 2 <= (x pow 2 + y pow 2) pow 2`;; + +(* ------------------------------------------------------------------------- *) +(* Some examples over integers and natural numbers. *) +(* ------------------------------------------------------------------------- *) + +time SOS_RULE `!m n. 2 * m + n = (n + m) + m`;; +time SOS_RULE `!n. ~(n = 0) ==> (0 MOD n = 0)`;; +time SOS_RULE `!m n. m < n ==> (m DIV n = 0)`;; +time SOS_RULE `!n:num. n <= n * n`;; +time SOS_RULE `!m n. n * (m DIV n) <= m`;; +time SOS_RULE `!n. ~(n = 0) ==> (0 DIV n = 0)`;; +time SOS_RULE `!m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`;; +time SOS_RULE `!a b n. ~(a = 0) ==> (n <= b DIV a <=> a * n <= b)`;; + +(* ------------------------------------------------------------------------- *) +(* This is particularly gratifying --- cf hideous manual proof in arith.ml *) +(* ------------------------------------------------------------------------- *) + +(*** This doesn't now seem to work as well as it did; what changed? + +time SOS_RULE + `!a b c d. ~(b = 0) /\ b * c < (a + 1) * d ==> c DIV d <= a DIV b`;; + + ***) + +(* ------------------------------------------------------------------------- *) +(* Key lemma for injectivity of Cantor-type pairing functions. *) +(* ------------------------------------------------------------------------- *) + +time SOS_RULE + `!x1 y1 x2 y2. ((x1 + y1) EXP 2 + x1 + 1 = (x2 + y2) EXP 2 + x2 + 1) + ==> (x1 + y1 = x2 + y2)`;; + +time SOS_RULE + `!x1 y1 x2 y2. ((x1 + y1) EXP 2 + x1 + 1 = (x2 + y2) EXP 2 + x2 + 1) /\ + (x1 + y1 = x2 + y2) + ==> (x1 = x2) /\ (y1 = y2)`;; + +time SOS_RULE + `!x1 y1 x2 y2. + (((x1 + y1) EXP 2 + 3 * x1 + y1) DIV 2 = + ((x2 + y2) EXP 2 + 3 * x2 + y2) DIV 2) + ==> (x1 + y1 = x2 + y2)`;; + +time SOS_RULE + `!x1 y1 x2 y2. + (((x1 + y1) EXP 2 + 3 * x1 + y1) DIV 2 = + ((x2 + y2) EXP 2 + 3 * x2 + y2) DIV 2) /\ + (x1 + y1 = x2 + y2) + ==> (x1 = x2) /\ (y1 = y2)`;; + +(* ------------------------------------------------------------------------- *) +(* Reciprocal multiplication (actually just ARITH_RULE does these). *) +(* ------------------------------------------------------------------------- *) + +time SOS_RULE `x <= 127 ==> ((86 * x) DIV 256 = x DIV 3)`;; + +time SOS_RULE `x < 2 EXP 16 ==> ((104858 * x) DIV (2 EXP 20) = x DIV 10)`;; + +(* ------------------------------------------------------------------------- *) +(* This is more impressive since it's really nonlinear. See REMAINDER_DECODE *) +(* ------------------------------------------------------------------------- *) + +time SOS_RULE `0 < m /\ m < n ==> ((m * ((n * x) DIV m + 1)) DIV n = x)`;; + +(* ------------------------------------------------------------------------- *) +(* Some conversion examples. *) +(* ------------------------------------------------------------------------- *) + +time SOS_CONV + `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;; + +time SOS_CONV + `x pow 4 - (&2 * y * z + &1) * x pow 2 + + (y pow 2 * z pow 2 + &2 * y * z + &2)`;; + +time SOS_CONV `&4 * x pow 4 + + &4 * x pow 3 * y - &7 * x pow 2 * y pow 2 - &2 * x * y pow 3 + + &10 * y pow 4`;; + +time SOS_CONV `&4 * x pow 4 * y pow 6 + x pow 2 - x * y pow 2 + y pow 2`;; + +time SOS_CONV + `&4096 * (x pow 4 + x pow 2 + z pow 6 - &3 * x pow 2 * z pow 2) + &729`;; + +time SOS_CONV + `&120 * x pow 2 - &63 * x pow 4 + &10 * x pow 6 + + &30 * x * y - &120 * y pow 2 + &120 * y pow 4 + &31`;; + +time SOS_CONV + `&9 * x pow 2 * y pow 4 + &9 * x pow 2 * z pow 4 + &36 * x pow 2 * y pow 3 + + &36 * x pow 2 * y pow 2 - &48 * x * y * z pow 2 + &4 * y pow 4 + + &4 * z pow 4 - &16 * y pow 3 + &16 * y pow 2`;; + +time SOS_CONV + `(x pow 2 + y pow 2 + z pow 2) * + (x pow 4 * y pow 2 + x pow 2 * y pow 4 + + z pow 6 - &3 * x pow 2 * y pow 2 * z pow 2)`;; + +time SOS_CONV + `x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z + &3`;; + +(*** I think this will work, but normalization is slow + +time SOS_CONV + `&100 * (x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z) + &212`;; + + ***) + +time SOS_CONV + `&100 * ((&2 * x - &2) pow 2 + (x pow 3 - &8 * x - &2) pow 2) - &588`;; + +time SOS_CONV + `x pow 2 * (&120 - &63 * x pow 2 + &10 * x pow 4) + &30 * x * y + + &30 * y pow 2 * (&4 * y pow 2 - &4) + &31`;; + +(* ------------------------------------------------------------------------- *) +(* Example of basic rule. *) +(* ------------------------------------------------------------------------- *) + +time PURE_SOS + `!x. x pow 4 + y pow 4 + z pow 4 - &4 * x * y * z + x + y + z + &3 + >= &1 / &7`;; + +time PURE_SOS + `&0 <= &98 * x pow 12 + + -- &980 * x pow 10 + + &3038 * x pow 8 + + -- &2968 * x pow 6 + + &1022 * x pow 4 + + -- &84 * x pow 2 + + &2`;; + +time PURE_SOS + `!x. &0 <= &2 * x pow 14 + + -- &84 * x pow 12 + + &1022 * x pow 10 + + -- &2968 * x pow 8 + + &3038 * x pow 6 + + -- &980 * x pow 4 + + &98 * x pow 2`;; + +(* ------------------------------------------------------------------------- *) +(* From Zeng et al, JSC vol 37 (2004), p83-99. *) +(* All of them work nicely with pure SOS_CONV, except (maybe) the one noted. *) +(* ------------------------------------------------------------------------- *) + +PURE_SOS + `x pow 6 + y pow 6 + z pow 6 - &3 * x pow 2 * y pow 2 * z pow 2 >= &0`;; + +PURE_SOS `x pow 4 + y pow 4 + z pow 4 + &1 - &4*x*y*z >= &0`;; + +PURE_SOS `x pow 4 + &2*x pow 2*z + x pow 2 - &2*x*y*z + &2*y pow 2*z pow 2 + +&2*y*z pow 2 + &2*z pow 2 - &2*x + &2* y*z + &1 >= &0`;; + +(**** This is harder. Interestingly, this fails the pure SOS test, it seems. + Yet only on rounding(!?) Poor Newton polytope optimization or something? + But REAL_SOS does finally converge on the second run at level 12! + +REAL_SOS +`x pow 4*y pow 4 - &2*x pow 5*y pow 3*z pow 2 + x pow 6*y pow 2*z pow 4 + &2*x +pow 2*y pow 3*z - &4* x pow 3*y pow 2*z pow 3 + &2*x pow 4*y*z pow 5 + z pow +2*y pow 2 - &2*z pow 4*y*x + z pow 6*x pow 2 >= &0`;; + + ****) + +PURE_SOS +`x pow 4 + &4*x pow 2*y pow 2 + &2*x*y*z pow 2 + &2*x*y*w pow 2 + y pow 4 + z +pow 4 + w pow 4 + &2*z pow 2*w pow 2 + &2*x pow 2*w + &2*y pow 2*w + &2*x*y + +&3*w pow 2 + &2*z pow 2 + &1 >= &0`;; + +PURE_SOS +`w pow 6 + &2*z pow 2*w pow 3 + x pow 4 + y pow 4 + z pow 4 + &2*x pow 2*w + +&2*x pow 2*z + &3*x pow 2 + w pow 2 + &2*z*w + z pow 2 + &2*z + &2*w + &1 >= +&0`;; + +*****) diff --git a/Examples/ste.ml b/Examples/ste.ml new file mode 100644 index 0000000..8540abf --- /dev/null +++ b/Examples/ste.ml @@ -0,0 +1,208 @@ +(* ========================================================================= *) +(* Abstract version of symbolic trajectory evaluation. *) +(* *) +(* Based on the paper "Symbolic Trajectory Evaluation in a Nutshell" *) +(* by Tom Melham & Ashish Darbari, 2002 (still unpublished?) *) +(* ========================================================================= *) + +parse_as_infix("&&",(16,"right"));; +parse_as_infix("<<=",(14,"right"));; +parse_as_infix(">->",(13,"right"));; +parse_as_infix(">~~>",(6,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Some type of nodes that we don't really care much about. *) +(* ------------------------------------------------------------------------- *) + +let node_INDUCT,node_RECURSION = define_type + "node = Node num";; + +(* ------------------------------------------------------------------------- *) +(* Also "abstract" propositional formulas (i.e. we never unfold "eval"). *) +(* ------------------------------------------------------------------------- *) + +let propform_INDUCT,propform_RECURSION = define_type + "propform = Propform (num->bool)->bool";; + +let eval = new_recursive_definition propform_RECURSION + `eval (Propform p) v = p v`;; + +(* ------------------------------------------------------------------------- *) +(* Quaternary lattice. *) +(* ------------------------------------------------------------------------- *) + +let quat_INDUCT,quat_RECURSION = define_type + "quat = X | ZERO | ONE | TOP";; + +let quat_DISTINCT = prove_constructors_distinct quat_RECURSION;; + +(* ------------------------------------------------------------------------- *) +(* Basic lattice operations. *) +(* ------------------------------------------------------------------------- *) + +let qle = new_definition + `x <<= y <=> x = X \/ y = TOP \/ x = y`;; + +let qjoin = new_definition + `x && y = if x <<= y then y else if y <<= x then x else TOP`;; + +(* ------------------------------------------------------------------------- *) +(* Trivial lemmas about the quaternary lattice. *) +(* ------------------------------------------------------------------------- *) + +let QLE_REFL = prove + (`!x. x <<= x`, + REWRITE_TAC[qle]);; + +let QLE_TRANS = prove + (`!x y z. x <<= y /\ y <<= z ==> x <<= z`, + REPEAT(MATCH_MP_TAC quat_INDUCT THEN REPEAT CONJ_TAC) THEN + REWRITE_TAC[qle; quat_DISTINCT]);; + +let QLE_LJOIN = prove + (`!x y z. x && y <<= z <=> x <<= z /\ y <<= z`, + REPEAT(MATCH_MP_TAC quat_INDUCT THEN REPEAT CONJ_TAC) THEN + REWRITE_TAC[qjoin; qle; quat_DISTINCT]);; + +let QLE_RJOIN = prove + (`!x y. x <<= x && y /\ y <<= x && y`, + REPEAT(MATCH_MP_TAC quat_INDUCT THEN REPEAT CONJ_TAC) THEN + REWRITE_TAC[qjoin; qle; quat_DISTINCT]);; + +(* ------------------------------------------------------------------------- *) +(* Choice expressions. *) +(* ------------------------------------------------------------------------- *) + +let choice = new_definition + `b >-> x = if b then x else X`;; + +let QLE_CHOICE = prove + (`(b >-> x) <<= y <=> b ==> x <<= y`, + REPEAT GEN_TAC THEN REWRITE_TAC[choice] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN REWRITE_TAC[qle]);; + +(* ------------------------------------------------------------------------- *) +(* Basic type of trajectory formulas. *) +(* ------------------------------------------------------------------------- *) + +let trajform_INDUCT,trajform_RECURSION = define_type + "trajform = Is_0 node + | Is_1 node + | Andj trajform trajform + | When trajform propform + | Next trajform";; + +(* ------------------------------------------------------------------------- *) +(* Semantics. *) +(* ------------------------------------------------------------------------- *) + +let tholds = new_recursive_definition trajform_RECURSION + `(tholds (Is_0 nd) seq v <=> ZERO <<= seq 0 nd v) /\ + (tholds (Is_1 nd) seq v <=> ONE <<= seq 0 nd v) /\ + (tholds (Andj tf1 tf2) seq v <=> tholds tf1 seq v /\ tholds tf2 seq v) /\ + (tholds (When tf1 p) seq v <=> eval p v ==> tholds tf1 seq v) /\ + (tholds (Next(tf1)) seq v <=> tholds tf1 (\t. seq(t + 1)) v)`;; + +(* ------------------------------------------------------------------------- *) +(* Defining sequence. *) +(* ------------------------------------------------------------------------- *) + +let defseq = new_recursive_definition trajform_RECURSION + `(defseq (Is_0 n) t nd v = ((n = nd) /\ (t = 0)) >-> ZERO) /\ + (defseq (Is_1 n) t nd v = ((n = nd) /\ (t = 0)) >-> ONE) /\ + (defseq (Andj tf1 tf2) t nd v = defseq tf1 t nd v && defseq tf2 t nd v) /\ + (defseq (When tf1 p) t nd v = eval p v >-> defseq tf1 t nd v) /\ + (defseq (Next(tf1)) t nd v = ~(t = 0) >-> defseq tf1 (t - 1) nd v)`;; + +(* ------------------------------------------------------------------------- *) +(* Proof of the key property. *) +(* ------------------------------------------------------------------------- *) + +let DEFSEQ_MINIMAL = prove + (`!tf seq v. tholds tf seq v <=> !t nd. defseq tf t nd v <<= seq t nd v`, + let cases_lemma = prove + (`(!t. P t) <=> P 0 /\ !t. P(SUC t)`,MESON_TAC[num_CASES]) in + MATCH_MP_TAC trajform_INDUCT THEN REWRITE_TAC[defseq; tholds] THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[QLE_CHOICE] THEN MESON_TAC[]; + REPEAT GEN_TAC THEN REWRITE_TAC[QLE_CHOICE] THEN MESON_TAC[]; + SIMP_TAC[QLE_LJOIN; FORALL_AND_THM]; + REWRITE_TAC[QLE_CHOICE] THEN MESON_TAC[]; + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[cases_lemma] THEN + ASM_REWRITE_TAC[QLE_CHOICE; NOT_SUC; ADD1; ADD_SUB]]);; + +(* ------------------------------------------------------------------------- *) +(* Notion of a trajectory w.r.t. a next-state function. *) +(* ------------------------------------------------------------------------- *) + +let trajectory = new_definition + `trajectory next seq v <=> !t nd. next(seq t) nd v <<= seq (t + 1) nd v`;; + +(* ------------------------------------------------------------------------- *) +(* Defining trajectory of a formula. *) +(* ------------------------------------------------------------------------- *) + +let deftraj = new_recursive_definition num_RECURSION + `(deftraj step tf 0 nd v = defseq tf 0 nd v) /\ + (deftraj step tf (SUC t) nd v = + defseq tf (SUC t) nd v && step(deftraj step tf t) nd v)`;; + +(* ------------------------------------------------------------------------- *) +(* Obviously this is at least as strong as the defining sequence. *) +(* ------------------------------------------------------------------------- *) + +let DEFTRAJ_DEFSEQ = prove + (`!tf t nd v. defseq tf t nd v <<= deftraj step tf t nd v`, + GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[deftraj; QLE_REFL; QLE_RJOIN]);; + +(* ------------------------------------------------------------------------- *) +(* ...and it is indeed a trajectory. *) +(* ------------------------------------------------------------------------- *) + +let TRAJECTORY_DEFTRAJ = prove + (`!step tf v. trajectory step (deftraj step tf) v`, + REPEAT GEN_TAC THEN REWRITE_TAC[trajectory] THEN + REWRITE_TAC[GSYM ADD1; deftraj; QLE_RJOIN]);; + +(* ------------------------------------------------------------------------- *) +(* Monotonicity of next-state function. *) +(* ------------------------------------------------------------------------- *) + +let monotonic = new_definition + `monotonic next v <=> + !s1 s2. (!nd. s1 nd v <<= s2 nd v) ==> !nd. next s1 nd v <<= next s2 nd v`;; + +(* ------------------------------------------------------------------------- *) +(* Minimality property of defining trajectory (needs monotonicity). *) +(* ------------------------------------------------------------------------- *) + +let DEFTRAJ_MINIMAL = prove + (`!step v. + monotonic step v + ==> !tf seq. trajectory step seq v + ==> (tholds tf seq v <=> + !t nd. deftraj step tf t nd v <<= seq t nd v)`, + REWRITE_TAC[monotonic; trajectory; RIGHT_IMP_FORALL_THM] THEN + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[DEFSEQ_MINIMAL; DEFTRAJ_DEFSEQ; QLE_TRANS]] THEN + DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[deftraj; QLE_LJOIN] THEN + ASM_MESON_TAC[DEFSEQ_MINIMAL; QLE_TRANS; ADD1]);; + +(* ------------------------------------------------------------------------- *) +(* Basic semantic notion in STE. *) +(* ------------------------------------------------------------------------- *) + +let ste = new_definition + `(A >~~> C) ckt v <=> + !seq. trajectory ckt seq v /\ tholds A seq v ==> tholds C seq v`;; + +(* ------------------------------------------------------------------------- *) +(* The "fundamental theorem of STE". *) +(* ------------------------------------------------------------------------- *) + +let STE_THM = prove + (`monotonic ckt v + ==> ((A >~~> C) ckt v <=> !t nd. defseq C t nd v <<= deftraj ckt A t nd v)`, + MESON_TAC[ste; DEFTRAJ_MINIMAL; DEFSEQ_MINIMAL; DEFTRAJ_DEFSEQ; + TRAJECTORY_DEFTRAJ; QLE_TRANS]);; diff --git a/Examples/sylvester_gallai.ml b/Examples/sylvester_gallai.ml new file mode 100644 index 0000000..e854fcf --- /dev/null +++ b/Examples/sylvester_gallai.ml @@ -0,0 +1,261 @@ +(* ========================================================================= *) +(* The Sylvester-Gallai theorem. *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; + +(* ------------------------------------------------------------------------- *) +(* The main lemma that we reduce things to. *) +(* ------------------------------------------------------------------------- *) + +let SYLVESTER_GALLAI_LEMMA = prove + (`!p q b c:real^2. + between b (q,c) /\ ~(p IN affine hull {q,c}) /\ + orthogonal (p - q) (c - q) /\ ~(c = b) /\ ~(c = q) + ==> ~(b IN affine hull {p,c}) /\ + ?x. x IN affine hull {p,c} /\ dist(b,x) < dist(p,q)`, + GEOM_ORIGIN_TAC `q:real^2` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `c:real^2` THEN + X_GEN_TAC `c:real` THEN + ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`pp:real^2`; `bb:real^2`] THEN + REWRITE_TAC[BETWEEN_IN_SEGMENT; SEGMENT_CONVEX_HULL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + CONVEX_HULL_SUBSET_AFFINE_HULL)) THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN + REWRITE_TAC[SPAN_SING; IN_ELIM_THM; IN_UNIV; VECTOR_MUL_ASSOC] THEN + DISCH_THEN(X_CHOOSE_THEN `bc:real` SUBST_ALL_TAC) THEN + ABBREV_TAC `b:real = bc * c` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[VECTOR_SUB_RZERO; orthogonal; DOT_2] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_ADD_RID] THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ; VECTOR_MUL_EQ_0] THEN + ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM SEGMENT_CONVEX_HULL]) THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between; DIST_0] THEN + REWRITE_TAC[dist; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN + SIMP_TAC[NORM_BASIS; REAL_MUL_RID; DIMINDEX_2; ARITH] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `abs c = abs b + abs(b - c) + ==> &0 < c ==> &0 <= b /\ (b < c \/ b = c)`)) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `?p. ~(p = &0) /\ pp:real^2 = p % basis 2` + (CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) + THENL + [EXISTS_TAC `(pp:real^2)$2` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[AFFINE_HULL_2_ALT; EXISTS_IN_GSPEC; IN_UNIV; NORM_LT] THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; CART_EQ; DIMINDEX_2; FORALL_2] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_RING `&0 = p + u * (&0 - p) <=> p = &0 \/ u = &1`] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN ASM_REWRITE_TAC[UNWIND_THM2] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH + `b - (p + u % (c - p)):real^2 = (b - u % c) - (&1 - u) % p`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_SUB_RDISTRIB] THEN + REWRITE_TAC[NORM_POS_LT; GSYM DOT_POS_LT] THEN + REWRITE_TAC[VECTOR_ARITH + `(a - b) dot (a - b) = a dot a + b dot b - &2 * a dot b`] THEN + REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN + SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_2; ARITH; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_SUB_RZERO] THEN + SUBGOAL_THEN `&0 < c pow 2 /\ &0 < p pow 2` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE]; + ALL_TAC] THEN + ASM_CASES_TAC `b = &0` THENL + [EXISTS_TAC `p pow 2 / (p pow 2 + c pow 2):real` THEN + ASM_REWRITE_TAC[REAL_ARITH + `(&0 - u * c) * (&0 - u * c) + ((&1 - u) * p) * ((&1 - u) * p) < p * p <=> + u * u * c pow 2 < u * (&2 - u) * p pow 2`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_DIV; REAL_LT_ADD] THEN + SIMP_TAC[REAL_ARITH `u * c < (&2 - u) * p <=> u * (p + c) < &2 * p`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_ADD] THEN + ASM_REAL_ARITH_TAC; + EXISTS_TAC `b:real / c` THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_SUB_REFL] THEN + REWRITE_TAC[REAL_ARITH + `&0 * &0 + (u * p) * (u * p) < p * p <=> &0 < (&1 - u * u) * p * p`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN + REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_POW_1_LT THEN + SIMP_TAC[ARITH_EQ; REAL_SUB_LE; REAL_ARITH `&1 - x < &1 <=> &0 < x`] THEN + ASM_SIMP_TAC[ARITH_EQ; REAL_LT_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The following lemmas drive a case analysis to pick the right points. *) +(* ------------------------------------------------------------------------- *) + +let cases_quick = prove + (`!q a b c:real^N. + collinear {q,a,b,c} /\ between b (a,c) + ==> between b (q,a) \/ between b (q,c)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + GEOM_ORIGIN_TAC `u:real^N` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v:real^N` THEN + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN + REWRITE_TAC[SPAN_INSERT_0; SPAN_SING; INSERT_SUBSET; EMPTY_SUBSET] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[between; dist; GSYM VECTOR_SUB_RDISTRIB] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + REWRITE_TAC[REAL_MUL_RID; GSYM REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN + ASM_CASES_TAC `abs v = &0` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let cases_lemma = prove + (`!q a b c:real^N. + collinear {q,a,b,c} + ==> between a (q,b) \/ between a (q,c) \/ + between b (q,c) \/ between b (q,a) \/ + between c (q,a) \/ between c (q,b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `collinear {a:real^N,b,c}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COLLINEAR_SUBSET)) THEN SET_TAC[]; + REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN + REPEAT(ONCE_REWRITE_TAC[TAUT `a \/ b \/ c \/ d <=> (a \/ b) \/ c \/ d`] THEN + MATCH_MP_TAC MONO_OR THEN CONJ_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] cases_quick) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[INSERT_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Kelly's proof of the Sylvester-Gallai theorem. *) +(* ------------------------------------------------------------------------- *) + +let SYLVESTER_GALLAI = prove + (`!s:real^2->bool. + FINITE s /\ + (!a b. a IN s /\ b IN s /\ ~(a = b) + ==> ?c. c IN s /\ ~(c = a) /\ ~(c = b) /\ collinear {a,b,c}) + ==> collinear s`, + GEN_TAC THEN ASM_CASES_TAC `s:real^2->bool = {}` THEN + ASM_REWRITE_TAC[COLLINEAR_EMPTY] THEN + ASM_CASES_TAC `?a:real^2. s = {a}` THENL + [ASM_MESON_TAC[COLLINEAR_SING]; STRIP_TAC] THEN + ABBREV_TAC + `L = {affine hull {a,b} | a IN s /\ b IN s /\ ~(a:real^2 = b)}` THEN + SUBGOAL_THEN `FINITE(L:(real^2->bool)->bool)` ASSUME_TAC THENL + [EXPAND_TAC "L" THEN + ONCE_REWRITE_TAC[SET_RULE + `{f x y | x IN s /\ y IN s /\ P x y} = + {f x y | x IN s /\ y IN {y | y IN s /\ P x y}}`] THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_RESTRICT]; + ALL_TAC] THEN + ASM_CASES_TAC `L:(real^2->bool)->bool = {}` THENL + [UNDISCH_TAC `L:(real^2->bool)->bool = {}` THEN EXPAND_TAC "L" THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC + `{ dist(closest_point l p,p) | + l IN L /\ p IN {p:real^2 | p IN s /\ &0 < dist(closest_point l p,p)}}` + INF_FINITE) THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_RESTRICT] THEN + ASM_REWRITE_TAC[SET_RULE + `{f x y | x IN s /\ y IN t x} = {} <=> + s = {} \/ (!x. x IN s ==> t x = {})`] THEN + MATCH_MP_TAC(TAUT `(p ==> r) /\ (q ==> r) ==> (~p ==> q) ==> r`) THEN + CONJ_TAC THENL + [SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = {} <=> !x. x IN s ==> ~P x`] THEN + REWRITE_TAC[GSYM DIST_NZ] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^2->bool` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(MP_TAC o SPEC `l:real^2->bool`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `closed(l:real^2->bool) /\ ~(l = {})` ASSUME_TAC THENL + [UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY]; + ASM_SIMP_TAC[CLOSEST_POINT_REFL]] THEN + DISCH_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `l:real^2->bool` THEN ASM_REWRITE_TAC[SUBSET] THEN + UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_MESON_TAC[COLLINEAR_AFFINE_HULL; SUBSET_REFL]; + ALL_TAC] THEN + SIMP_TAC[IMP_CONJ; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`l:real^2->bool`; `p:real^2`] THEN DISCH_TAC THEN + SUBGOAL_THEN `affine(l:real^2->bool) /\ ~(l = {})` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_AFFINE) THEN + ABBREV_TAC `q = closest_point l p:real^2` THEN + DISCH_TAC THEN REWRITE_TAC[DIST_NZ] THEN DISCH_TAC THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(q:real^2) IN l` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSEST_POINT_IN_SET]; ALL_TAC] THEN + SUBGOAL_THEN + `?b c:real^2. b IN s /\ c IN s /\ b IN l /\ c IN l /\ + ~(b = c) /\ between b (q,c)` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(l:real^2->bool) IN L` THEN EXPAND_TAC "L" THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^2`; `b:real^2`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN + `?c:real^2. c IN s /\ ~(c = a) /\ ~(c = b) /\ collinear {a, b, c}` + (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN + SUBGOAL_THEN `(a:real^2) IN l /\ (b:real^2) IN l` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "l" THEN SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN + MP_TAC(ISPECL [`q:real^2`; `a:real^2`; `b:real^2`; `c:real^2`] + cases_lemma) THEN + ANTS_TAC THENL + [REWRITE_TAC[COLLINEAR_AFFINE_HULL; INSERT_SUBSET; EMPTY_SUBSET] THEN + MAP_EVERY EXISTS_TAC [`a:real^2`; `b:real^2`] THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `~(c:real^2 = q)` ASSUME_TAC THENL + [ASM_MESON_TAC[BETWEEN_REFL_EQ]; ALL_TAC] THEN + SUBGOAL_THEN `~((p:real^2) IN l)` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSEST_POINT_SELF; DIST_EQ_0; REAL_LT_REFL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:real^2`; `q:real^2`; `b:real^2`; `c:real^2`] + SYLVESTER_GALLAI_LEMMA) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [UNDISCH_TAC `~((p:real^2) IN l)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + SPEC_TAC(`p:real^2`,`p:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]; + EXPAND_TAC "q" THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN + MATCH_MP_TAC CLOSEST_POINT_AFFINE_ORTHOGONAL THEN + ASM_REWRITE_TAC[]]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `r:real^2` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`dist(closest_point (affine hull {p,c}) b:real^2,b)`; + `affine hull {p:real^2,c}`; `b:real^2`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + REWRITE_TAC[DIST_POS_LE; DIST_EQ_0] THEN + ASM_SIMP_TAC[CLOSEST_POINT_REFL; CLOSED_AFFINE_HULL; + AFFINE_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN + EXPAND_TAC "L" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `rb < qp ==> cb <= rb ==> ~(qp <= cb)`)) THEN + MATCH_MP_TAC CLOSEST_POINT_LE THEN + ASM_REWRITE_TAC[CLOSED_AFFINE_HULL]]]);; diff --git a/Examples/update_database.ml b/Examples/update_database.ml new file mode 100644 index 0000000..2e5fa89 --- /dev/null +++ b/Examples/update_database.ml @@ -0,0 +1,181 @@ +(* ========================================================================= *) +(* Create search database from OCaml / modify search database dynamically. *) +(* *) +(* This file assigns to "theorems", which is a list of name-theorem pairs. *) +(* The core system already has such a database set up. Use this file if you *) +(* want to update the database beyond the core, so you can search it. *) +(* *) +(* The trickery to get at the OCaml environment is due to oleg@pobox.com *) +(* (see his message to the caml-list on Tuesday 26th September 2006). *) +(* ========================================================================= *) + +(* !!!!!!! You must set this to point at the source directory in + !!!!!!! which OCaml was built. (And don't do "make clean" beforehand.) + *) + +let ocaml_source_dir = + Filename.concat (Sys.getenv "HOME") + ("software/ocaml-"^Sys.ocaml_version);; + +do_list (fun s -> Topdirs.dir_directory(Filename.concat ocaml_source_dir s)) + ["parsing"; "typing"; "toplevel"; "utils"];; + +(* This must be loaded first! It is stateful, and affects Predef *) +#load "ident.cmo";; + +#load "misc.cmo";; +#load "path.cmo";; +#load "types.cmo";; +#load "btype.cmo";; +#load "tbl.cmo";; +#load "subst.cmo";; +#load "predef.cmo";; +#load "datarepr.cmo";; +#load "config.cmo";; +#load "consistbl.cmo";; +#load "clflags.cmo";; +#load "env.cmo";; +#load "ctype.cmo";; +#load "printast.cmo";; +#load "oprint.cmo";; +#load "primitive.cmo";; +#load "printtyp.cmo";; + +(* ------------------------------------------------------------------------- *) +(* Get the toplevel environment as raw data. *) +(* ------------------------------------------------------------------------- *) + +let get_value_bindings env = + let rec get_val acc = function + | Env.Env_empty -> acc + | Env.Env_value (next, ident, val_descr) -> + get_val ((ident,val_descr)::acc) next + | Env.Env_type (next,_,_) -> get_val acc next + | Env.Env_exception (next,_,_) -> get_val acc next + | Env.Env_module (next,_,_) -> get_val acc next + | Env.Env_modtype (next,_,_) -> get_val acc next + | Env.Env_class (next,_,_) -> get_val acc next + | Env.Env_cltype (next,_,_) -> get_val acc next + | Env.Env_open (next,_) -> get_val acc next + in get_val [] (Env.summary env);; + +(* ------------------------------------------------------------------------- *) +(* Convert a type to a string, for ease of comparison. *) +(* ------------------------------------------------------------------------- *) + +let type_to_str (x : Types.type_expr) = + Printtyp.type_expr Format.str_formatter x; + Format.flush_str_formatter ();; + +(* ------------------------------------------------------------------------- *) +(* Put an assignment of a theorem database in the named file. *) +(* ------------------------------------------------------------------------- *) + +let make_database_assignment filename = + let all_bnds = get_value_bindings (!Toploop.toplevel_env) in + let thm_bnds = filter (fun (ident,val_descr) -> + type_to_str val_descr.Types.val_type = "thm") + all_bnds in + let names = + subtract (map (fun (ident,val_descr) -> Ident.name ident) thm_bnds) + ["it"] in + let entries = map (fun n -> "\""^n^"\","^n) (uniq(sort (<) names)) in + let text = "theorems :=\n[\n"^ + end_itlist (fun a b -> a^";\n"^b) entries^"\n];;\n" in + file_of_string filename text;; + +(* ------------------------------------------------------------------------- *) +(* Remove bindings in first list from second assoc list (all ordered). *) +(* ------------------------------------------------------------------------- *) + +let rec demerge s l = + match (s,l) with + u::t,(x,y as p)::m -> + if u = x then demerge t m + else if u < x then demerge t l + else p::(demerge s m) + | _ -> l;; + +(* ------------------------------------------------------------------------- *) +(* Incrementally update database. *) +(* ------------------------------------------------------------------------- *) + +let update_database = + let value_bindings_checked = ref 0 + and theorem_bindings_existing = ref undefined in + let listify l = if l = [] then "[]" + else "[\n"^end_itlist (fun a b -> a^";\n"^b) l^"\n]\n" in + let purenames = map (fun n -> "\""^n^"\"") + and pairnames = map (fun n -> "\""^n^"\","^n) in + fun () -> + let old_count = !value_bindings_checked + and old_ths = !theorem_bindings_existing in + let all_bnds = get_value_bindings (!Toploop.toplevel_env) in + let new_bnds = funpow old_count tl all_bnds in + let new_count = old_count + length new_bnds + and new_ths = + rev_itlist (fun (ident,val_descr) -> + let n = Ident.name ident in + if type_to_str val_descr.Types.val_type = "thm" & n <> "it" + then (n |-> ()) else undefine n) new_bnds old_ths in + value_bindings_checked := new_count; + if new_ths = old_ths then () else + (print_string "Updating search database\n"; + theorem_bindings_existing := new_ths; + let all_ths = combine (fun _ _ -> ()) (fun _ -> false) old_ths new_ths in + let del_ths = combine (fun _ _ -> ()) (fun _ -> true) all_ths new_ths + and add_ths = combine (fun _ _ -> ()) (fun _ -> true) all_ths old_ths in + let del_names = mergesort (<) (foldr (fun a _ l -> a::l) del_ths []) + and add_names = mergesort (<) (foldr (fun a _ l -> a::l) add_ths []) in + let exptext = + "theorems :=\n merge (increasing fst) (demerge "^ + (listify(purenames del_names))^ + " (!theorems)) "^ + (listify(pairnames add_names))^ + ";;\n" in + (let filename = Filename.temp_file "database" ".ml" in + file_of_string filename exptext; + loadt filename; + Sys.remove filename));; + +(* ------------------------------------------------------------------------- *) +(* Include a call to this on each search. *) +(* ------------------------------------------------------------------------- *) + +let search = + let rec immediatesublist l1 l2 = + match (l1,l2) with + [],_ -> true + | _,[] -> false + | (h1::t1,h2::t2) -> h1 = h2 & immediatesublist t1 t2 in + let rec sublist l1 l2 = + match (l1,l2) with + [],_ -> true + | _,[] -> false + | (h1::t1,h2::t2) -> immediatesublist l1 l2 or sublist l1 t2 in + let exists_subterm_satisfying p (n,th) = can (find_term p) (concl th) + and name_contains s (n,th) = sublist (explode s) (explode n) in + let rec filterpred tm = + match tm with + Comb(Var("",_),t) -> not o filterpred t + | Comb(Var("",_),Var(pat,_)) -> name_contains pat + | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) + | pat -> exists_subterm_satisfying (can (term_match [] pat)) in + fun pats -> + update_database(); + let triv,nontriv = partition is_var pats in + (if triv <> [] then + warn true + ("Ignoring plain variables in search: "^ + end_itlist (fun s t -> s^", "^t) (map (fst o dest_var) triv)) + else ()); + (if nontriv = [] & triv <> [] then [] + else itlist (filter o filterpred) pats (!theorems));; + +(* ------------------------------------------------------------------------- *) +(* Update to bring things back to current state. *) +(* ------------------------------------------------------------------------- *) + +theorems := [];; + +update_database();; diff --git a/Examples/vitali.ml b/Examples/vitali.ml new file mode 100644 index 0000000..e31e95e --- /dev/null +++ b/Examples/vitali.ml @@ -0,0 +1,97 @@ +(* ========================================================================= *) +(* Existence of a (bounded) non-measurable set of reals. *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* Classic Vitali proof (positive case simplified via Steinhaus's theorem). *) +(* ------------------------------------------------------------------------- *) + +let NON_MEASURABLE_SET = prove + (`?s. real_bounded s /\ ~real_measurable s`, + MAP_EVERY ABBREV_TAC + [`equiv = \x y. &0 <= x /\ x < &1 /\ &0 <= y /\ y < &1 /\ rational(x - y)`; + `(canonize:real->real) = \x. @y. equiv x y`; + `V = IMAGE (canonize:real->real) {x | &0 <= x /\ x < &1}`] THEN + SUBGOAL_THEN `!x. equiv x x <=> &0 <= x /\ x < &1` ASSUME_TAC THENL + [EXPAND_TAC "equiv" THEN REWRITE_TAC[REAL_SUB_REFL; RATIONAL_NUM; CONJ_ACI]; + ALL_TAC] THEN + SUBGOAL_THEN `!x y:real. equiv x y ==> equiv y x` ASSUME_TAC THENL + [EXPAND_TAC "equiv" THEN MESON_TAC[RATIONAL_NEG; REAL_NEG_SUB]; + ALL_TAC] THEN + SUBGOAL_THEN `!x y z:real. equiv x y /\ equiv y z ==> equiv x z` + ASSUME_TAC THENL + [EXPAND_TAC "equiv" THEN MESON_TAC[RATIONAL_ADD; + REAL_ARITH `x - z:real = (x - y) + (y - z)`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. &0 <= x /\ x < &1 ==> (equiv:real->real->bool) x (canonize x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "canonize" THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. x IN V /\ y IN V /\ rational(x - y) ==> x = y` + ASSUME_TAC THENL + [EXPAND_TAC "V" THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN STRIP_TAC THEN + EXPAND_TAC "canonize" THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real` THEN + SUBGOAL_THEN `equiv ((canonize:real->real) x) (canonize y) :bool` + (fun th -> MP_TAC th THEN ASM_MESON_TAC[]) THEN + EXPAND_TAC "equiv" THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `V:real->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `real_interval[&0,&1]` THEN + REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL; SUBSET; IN_REAL_INTERVAL] THEN + ASM SET_TAC[REAL_LT_IMP_LE]; + DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_REAL_MEASURE_MEASURE]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_MEASURE_POS_LE) THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THENL + [MP_TAC(ISPEC `V:real->bool` REAL_STEINHAUS) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPECL [`d / &2`; `d / &2`] RATIONAL_APPROXIMATION) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `q:real` THEN STRIP_TAC THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `q:real`) THEN REWRITE_TAC[NOT_IMP] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `q = &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[REAL_SUB_0]; + REWRITE_TAC[HAS_REAL_MEASURE_0] THEN DISCH_TAC THEN + SUBGOAL_THEN `?r. rational = IMAGE r (:num)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN REWRITE_TAC[COUNTABLE_RATIONAL] THEN + REWRITE_TAC[FUN_EQ_THM; EMPTY] THEN MESON_TAC[RATIONAL_NUM]; + ALL_TAC] THEN + MP_TAC(ISPEC `\n. IMAGE (\x. (r:num->real) n + x) V` + REAL_NEGLIGIBLE_COUNTABLE_UNIONS) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[REAL_NEGLIGIBLE_TRANSLATION]; ALL_TAC] THEN + SUBGOAL_THEN `~(real_negligible(real_interval(&0,&1)))` MP_TAC THENL + [SIMP_TAC[GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0; + REAL_MEASURABLE_REAL_INTERVAL; REAL_MEASURE_REAL_INTERVAL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_NEGLIGIBLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `(equiv:real->real->bool) x (canonize x)` MP_TAC THENL + [ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + EXPAND_TAC "equiv" THEN ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM IN] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (ASSUME_TAC o SYM)) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[UNIONS_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN + MAP_EVERY EXISTS_TAC [`n:num`; `(canonize:real->real) x`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + EXPAND_TAC "V" THEN MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]);; diff --git a/IsabelleLight/isalight.ml b/IsabelleLight/isalight.ml new file mode 100644 index 0000000..cc1ec50 --- /dev/null +++ b/IsabelleLight/isalight.ml @@ -0,0 +1,19 @@ +(* ========================================================================= *) +(* Isabelle Light *) +(* Isabelle/Procedural style additions and other user-friendly shortcuts. *) +(* *) +(* Petros Papapanagiotou, Jacques Fleuriot *) +(* Center of Intelligent Systems and their Applications *) +(* University of Edinburgh *) +(* 2009-2012 *) +(* ========================================================================= *) +(* FILE : isahol.ml *) +(* DESCRIPTION : Main loader. *) +(* LAST MODIFIED: December 2010 *) +(* ========================================================================= *) + +let paths = [".";"$/IsabelleLight"] +in map (fun st -> load_on_path paths st) + ["support.ml"; + "new_tactics.ml"; + "meta_rules.ml"];; diff --git a/IsabelleLight/make.ml b/IsabelleLight/make.ml new file mode 100644 index 0000000..bc854b8 --- /dev/null +++ b/IsabelleLight/make.ml @@ -0,0 +1,25 @@ +(* ========================================================================= *) +(* Isabelle Light *) +(* Isabelle/Procedural style additions and other user-friendly shortcuts. *) +(* *) +(* Petros Papapanagiotou, Jacques Fleuriot *) +(* Center of Intelligent Systems and their Applications *) +(* University of Edinburgh *) +(* 2009-2012 *) +(* ========================================================================= *) +(* FILE : make.ml *) +(* DESCRIPTION : Makefile. Simply calls the loader but it was written to *) +(* match the rest of HOL Light's packages and for future use. *) +(* LAST MODIFIED: October 2010 *) +(* ========================================================================= *) + +loads "IsabelleLight/isalight.ml";; + +(* Some examples: *) + +prove( `p/\q==>q`, rule impI THEN erule conjE THEN assumption);; +prove (`(!x. P x) ==> P (y+1)`, rule impI THEN erule_tac [`a`,`y+1`] allE THEN assumption);; +prove (`p\/q==>q\/p`, rule impI THEN erule disjE THENL [ rule disjI2 ; rule disjI1 ] THEN assumption);; +prove (`p/\q ==> p\/q`, rule impI THEN rule disjI1 THEN drule conjunct1 THEN assumption);; +prove (`p/\q ==> p\/q`, DISCH_TAC THEN DISJ1_TAC THEN FIRST_ASSUM(CONJUNCTS_THEN ACCEPT_TAC));; +prove (`P x /\ x =0 ==> P 0`, rule impI THEN erule conjE THEN simp[]);; diff --git a/IsabelleLight/meta_rules.ml b/IsabelleLight/meta_rules.ml new file mode 100644 index 0000000..eedfb96 --- /dev/null +++ b/IsabelleLight/meta_rules.ml @@ -0,0 +1,1081 @@ +(* ========================================================================= *) +(* Isabelle Light *) +(* Isabelle/Procedural style additions and other user-friendly shortcuts. *) +(* *) +(* Petros Papapanagiotou, Jacques Fleuriot *) +(* Center of Intelligent Systems and their Applications *) +(* University of Edinburgh *) +(* 2009-2012 *) +(* ========================================================================= *) +(* FILE : meta_rules.ml *) +(* DESCRIPTION : Meta rules is a formalisation used to accommodate *) +(* Isabelle's inference rules in HOL Light.The technical *) +(* details are described in the comments that follow. *) +(* Isabelle rule application tactics (rule, erule, etc.) have *) +(* been defined to work with meta rules. *) +(* We have not been able to accommodate first order rules *) +(* allI and exE. We also make use of metavariables which are *) +(* restricted by the limitations of term_unify *) +(* (ie. no HO unification and no type instantiation). *) +(* LAST MODIFIED: October 2012 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* ----------------------- META-LEVEL IMPLICATION -------------------------- *) +(* ------------------------------------------------------------------------- *) +(* Emulation of meta-level implication at the object level. *) +(* This is purely for syntax and parsing purposes. It solves a number of *) +(* problems when parsing theorems as meta-rules (see below). *) +(* It is applied at the logic level only for transparency. *) +(* ------------------------------------------------------------------------- *) +(* Thanks to Phil Scott for the suggestion. *) +(* ------------------------------------------------------------------------- *) + + +(* ------------------------------------------------------------------------- *) +(* Syntax definition. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("===>",(4,"right"));; + +let is_mimp = is_binary "===>";; +let dest_mimp = dest_binary "===>";; + + +(* ------------------------------------------------------------------------- *) +(* Logic definition: Equivalent to object-level implication. *) +(* ------------------------------------------------------------------------- *) + +let MIMP_DEF = new_basic_definition + `(===>) = \p q. p ==> q`;; + + +(* ------------------------------------------------------------------------- *) +(* CONV, RULE and TACTIC to get rid of meta-level implication in proofs. *) +(* ------------------------------------------------------------------------- *) + +let MIMP_TO_IMP_CONV = BETA_RULE o (PURE_REWRITE_CONV [MIMP_DEF]);; +let MIMP_TO_IMP_RULE = BETA_RULE o (PURE_REWRITE_RULE [MIMP_DEF]);; +let MIMP_TAC = (PURE_REWRITE_TAC [MIMP_DEF]) THEN BETA_TAC;; + + +(* ------------------------------------------------------------------------- *) +(* Equivalent of TAUT after getting rid of meta-level implication. *) +(* Helps prove simple propositional meta-rules easily. *) +(* ------------------------------------------------------------------------- *) + +let MTAUT tm = + let th = MIMP_TO_IMP_CONV tm in + EQ_MP (SYM th) ((TAUT o snd o dest_iff o concl) th);; + + +(* ------------------------------------------------------------------------- *) +(* RULE to replace implication by meta-level implication to easily create *) +(* meta-theorems from normal theorems. *) +(* ------------------------------------------------------------------------- *) + +let MIMP_THM = MTAUT `(p==>q) <=> (p===>q)`;; +let MIMP_RULE = PURE_REWRITE_RULE[MIMP_THM];; + + +(* ------------------------------------------------------------------------- *) +(* UNDISCH for meta-level implication. *) +(* Also gets rid of meta-level implication in the undischarged term. *) +(* ------------------------------------------------------------------------- *) + +let MUNDISCH th = + let mth = BETA_RULE (AP_THM (AP_THM MIMP_DEF `p:bool`) `q:bool`) in + let th = PURE_ONCE_REWRITE_RULE [mth] th in + try let undisch_tm = (rand o rator o concl) th in + PROVE_HYP ((UNDISCH o snd o EQ_IMP_RULE o MIMP_TO_IMP_CONV) undisch_tm) (UNDISCH th) + with Failure _ -> failwith "MUNDISCH";; + + +(* ------------------------------------------------------------------------- *) +(* -------------------------- HELPFUL FUNCTIONS ---------------------------- *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* REV_PART_MATCH_I: term list -> (term -> term) -> thm -> term *) +(* -> instantiation *) +(* Does a reverse PART_MATCH and returns the resulting instantiation. *) +(* Avoids instantiating any of the given variables/constants. *) +(* Does not apply SPEC_ALL like PART_MATCH does. *) +(* ------------------------------------------------------------------------- *) +(* The original PART_MATCH matches a term to part of a theorem so that we can*) +(* instantiate that part with the term. *) +(* The reverse used here, matches the part of the theorem with the term so *) +(* that the term can be instantiated with the part of the theorem. *) +(* We use this in cases such as erule where we want (part of) an assumption *) +(* to match a premise of the rule. We need the instantiation of the rule when*) +(* matched to the assumption (thm) and not the other way around. *) +(* ------------------------------------------------------------------------- *) + +let REV_PART_MATCH_I = + let rec match_bvs t1 t2 acc = + try let v1,b1 = dest_abs t1 + and v2,b2 = dest_abs t2 in + let n1 = fst(dest_var v1) and n2 = fst(dest_var v2) in + let newacc = if n1 = n2 then acc else insert (n1,n2) acc in + match_bvs b1 b2 newacc + with Failure _ -> try + let l1,r1 = dest_comb t1 + and l2,r2 = dest_comb t2 in + match_bvs l1 l2 (match_bvs r1 r2 acc) + with Failure _ -> acc in + fun avoids partfn th -> + let bod = concl th in + let pbod = partfn bod in + let lconsts = union avoids (intersect (frees (concl th)) (freesl(hyp th))) in + fun tm -> + let bvms = match_bvs pbod tm [] in + let atm = deep_alpha bvms tm in + term_match lconsts atm (partfn bod) ;; (* whereas in PART_MATCH we do it the other way around *) + + +(* ------------------------------------------------------------------------- *) +(* term_to_asm_match : term list -> term -> (string * thm) list -> *) +(* (string * thm) list * (thm * instantiation) *) +(* ------------------------------------------------------------------------- *) +(* term_to_asm_match tries to match key to one of the assumptions using *) +(* REV_PART_MATCH_I. Returns the new assumption list (with the matching *) +(* assumption removed), the matching assumption and the resulting *) +(* instantiation used. *) +(* ------------------------------------------------------------------------- *) +(* It is doubtful that this has practical use outside the Xrule_tac's. *) +(* It is used in erule, drule and frule to match the major premise to one of *) +(* the assumptions. *) +(* ------------------------------------------------------------------------- *) + +let rec (term_to_asm_match: term list -> term -> (string * thm) list -> (string * thm) list * (thm * instantiation)) = + fun avoids key asms -> + if (asms = []) then failwith ("No assumptions match `" ^ (string_of_term key) ^ "`!") + else try + let asm = (snd o hd) asms in + let i = REV_PART_MATCH_I avoids I asm key in + (tl asms),(asm,i) + with Failure _ -> let res,inst = term_to_asm_match avoids key (tl asms) in ((hd asms)::res),inst;; + + +(* ------------------------------------------------------------------------- *) +(* term_to_asm_n_match : term list -> term -> (string * thm) list -> int -> *) +(* (string * thm) list * (thm * instantiation) *) +(* ------------------------------------------------------------------------- *) +(* Same as term_to_asm_match but only tries to match nth assumption. *) +(* ------------------------------------------------------------------------- *) +(* It is doubtful that this has practical use outside the Xrulen_tac's. *) +(* It is used in erulen, drulen and frulen to match the major premise to one *) +(* of the assumptions. *) +(* ------------------------------------------------------------------------- *) + +let rec (term_to_asm_n_match: term list -> term -> (string * thm) list -> int -> (string * thm) list * (thm * instantiation)) = + fun avoids key asms n -> + if (asms = []) then failwith "No such assumption found!" + else try match n with + 0 -> + let asm = (snd o hd) asms in + let i = REV_PART_MATCH_I avoids I asm key in + (tl asms),(asm,i) + | _ -> let re_asms,m = term_to_asm_n_match avoids key (tl asms) (n-1) in + (hd asms)::re_asms,m + with Failure _ -> failwith ("Assumption `" ^ ((string_of_term o concl o snd o hd) asms) ^ "` doesn't match `" ^ (string_of_term key) ^ "`!");; + + + +(* gmm is not to be used until qed is updated *) +(* We need a MDISCH for that... *) + +let gmm t = + let fvs = sort (<) (map (fst o dest_var) (frees t)) in + (if fvs <> [] then + let errmsg = end_itlist (fun s t -> s^", "^t) fvs in + warn true ("Free variables in goal: "^errmsg) + else ()); + let rec split_mimp = fun tm -> + if (is_mimp tm) + then + let (a,b) = dest_mimp tm in + let (asms, concl) = split_mimp b in + (a::asms,concl) + else ([],tm) in + set_goal (split_mimp t);; + + +(* ------------------------------------------------------------------------- *) +(* gm : term -> goalstack *) +(* This is used to set a term containing meta-level implication as a goal. *) +(* ------------------------------------------------------------------------- *) +(* (+) Uses g to set the goal then MIMP_TAC to get rid of meta-implication. *) +(* (+) Note that if the goal has normal implication it gets discharged as *) +(* well. This will be fixed when gmm is fixed. *) +(* ------------------------------------------------------------------------- *) + +let gm t = g t ; e (MIMP_TAC THEN REPEAT DISCH_TAC);; + + +(* ------------------------------------------------------------------------- *) +(* Isabelle's natural deduction rules as thms with meta-level implication. *) +(* ------------------------------------------------------------------------- *) + +let conjI = MTAUT `p===>q===>p/\q`;; +let conjunct1 = MTAUT `p/\q===>p`;; +let conjunct2 = MTAUT `p/\q===>q`;; +let conjE = MTAUT `p/\q===>(p===>q===>r)===>r`;; +let disjI1 = MTAUT `p===>p\/q`;; +let disjI2 = MTAUT `q===>p\/q`;; +let disjE = MTAUT `p\/q===>(p===>r)===>(q===>r)===>r`;; + +let impI = MTAUT `(p===>q)===>(p==>q)`;; +let impE = MTAUT `(p==>q)===>p===>(q===>r)===>r`;; +let mp = MTAUT `(p==>q)===>(p===>q)`;; + +let iffI = MTAUT `(a===>b)===>(b===>a)===>(a<=>b)`;; +let iffE = MTAUT `(a<=>b)===>((a==>b) ===> (b==>a) ===> r) ===> r`;; + +let allE = prove( `(!x:A. P x) ===> (P (a:A) ===> (r:bool)) ===> r` , + MIMP_TAC THEN MESON_TAC[]);; +let exI = prove (`P (a:A)===> ?x:A. P x`, + MIMP_TAC THEN + DISCH_TAC THEN + (EXISTS_TAC `a:A`) THEN + (FIRST_ASSUM ACCEPT_TAC));; + +let notI = MTAUT `(p===>F)===> ~p`;; +let notE = MTAUT `~a ===> a ===> r`;; + + +(* ------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------- *) +(* ------------------------ META-RULES START HERE!! ------------------------ *) +(* ------------------------------------------------------------------------- *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* meta_rule (type) *) +(* The representation of an Isabelle inference rule in HOL Light. *) +(* ------------------------------------------------------------------------- *) +(* term = The conclusion of the inference rule. *) +(* goal list = The premises represented as "meta-subgoals". *) +(* thm = The representation of the rule as a theorem used for justification. *) +(* *) +(* (+) thm must be of the form H1,H2,...,Hn |- G *) +(* (+) H1--Hn must be represented as "meta-subgoals" in any order (1) *) +(* (+) [|P;Q|] ==> R (in Isabelle notation) is translated as "meta-subgoal" *) +(* P,Q ?- R and as P==>Q==>R in the justification theorem. *) +(* (+) The form of the premises (assumption order etc) must be kept in the *) +(* justification theorem (see example in (2)) *) +(* (+) Use "mk_meta_rule" to create proper meta rules from theorems. *) +(* ------------------------------------------------------------------------- *) +(* (1) Since we use PROVE_HYP instead of MP to justify rule, erule etc, the *) +(* order of the subgoals is no longer essential. *) +(* (2) Example: conjE *) +(* In Isabelle: P/\Q [|P;Q|]==> R *) +(* ------------------ *) +(* R *) +(* *) +(* As a meta rule (briefly - see conjEm below for full notation): *) +(* `R`, - conclusion *) +(* [ - premises list *) +(* [ ], `P/\Q` ; *) +(* [`P`;`Q`], `R` *) +(* ], *) +(* `P/\Q, P==>Q==>R |- R` - justification theorem *) +(* *) +(* The form of the premises must be preserved in the justification theorem. *) +(* ie. using `P/\Q, Q==>P==>R |- R` or `Q/\P, P==>Q==>R |- R` as a *) +(* justification theorem would break the justification and result in an *) +(* "invalid tactic" exception. *) +(* ------------------------------------------------------------------------- *) + +type meta_rule = term * goal list * thm;; + + +let print_meta_rule: meta_rule->unit = + fun (c,glist,j) -> + print_term c ; hd (map (print_newline () ; print_goal) glist) ; + print_newline () ; print_thm j ; print_newline ();; + + +(* ------------------------------------------------------------------------- *) +(* inst_meta_rule: instantiation -> meta_rule -> meta_rule *) +(* ------------------------------------------------------------------------- *) +(* Instantiates all parts of meta_rules based on an instantiation. *) +(* ------------------------------------------------------------------------- *) + +let inst_meta_rule:instantiation->meta_rule->meta_rule = + fun inst (c,glist,j) -> + instantiate inst c, + map (inst_goal inst) glist, + INSTANTIATE_ALL inst j;; + + +(* ------------------------------------------------------------------------- *) +(* meta_rule_frees: meta_rule -> term list *) +(* ------------------------------------------------------------------------- *) +(* Returns the list of free variables (or Isabelle ?metavariables) in a *) +(* meta_rule. *) +(* ------------------------------------------------------------------------- *) + +let meta_rule_frees: meta_rule -> term list = + fun (c,glist,l) -> + itlist (union o gl_frees) glist (union (frees c) (thm_frees l));; + + +(* ------------------------------------------------------------------------- *) +(* meta_rule_mk_primed_vars_I: term_list -> meta_rule -> *) +(* meta_rule * instantiation *) +(* ------------------------------------------------------------------------- *) +(* Applies mk_primed_var to all the free variables in a meta_rule. *) +(* Returns the new meta_rule and the instantiation for the variable renaming.*) +(* ------------------------------------------------------------------------- *) + +let meta_rule_mk_primed_vars_I: term list -> meta_rule -> meta_rule * instantiation = + fun avoids r -> + let fvars = meta_rule_frees r in + let rec mk_primed_l = fun avoids vars -> + match vars with + [] -> null_inst + | v::rest -> + let new_v = mk_primed_var avoids v in + compose_insts (term_match [] v new_v) (mk_primed_l (new_v::avoids) rest) + in + let inst = mk_primed_l avoids fvars in + (inst_meta_rule inst r),inst;; + + +(* ------------------------------------------------------------------------- *) +(* meta_rule_mk_primed_vars: term_list -> meta_rule -> meta_rule *) +(* ------------------------------------------------------------------------- *) +(* Applies mk_primed_var to all the free variables in a meta_rule. *) +(* ------------------------------------------------------------------------- *) + +let meta_rule_mk_primed_vars: term list -> meta_rule -> meta_rule = + fun avoids r -> fst (meta_rule_mk_primed_vars_I avoids r);; + + + +(* ------------------------------------------------------------------------- *) +(* inst_meta_rule_vars: *) +(* (term * term) list -> meta_rule -> term list -> meta_rule *) +(* ------------------------------------------------------------------------- *) +(* Instantiates the free variables in a meta_rule. Also renames the *) +(* uninstantiated variables so as to avoid clashes with free variables and *) +(* constants in the given goal. *) +(* Essentially it prepares the meta_rule for use with any of xrulem_tac. *) +(* ------------------------------------------------------------------------- *) +(* (+) By instlist we mean the list of variables and instantiation pairs *) +(* given by the user. *) +(* (+) First we check the terms given as variables in the instlist. We must *) +(* check if they are indeed variables and if they are free variables in the *) +(* given meta_rule. *) +(* (+) "match_var" is used to compare a variable with a free variable in the *) +(* meta_rule. *NOTE* that a variable is accepted as long as it can match a *) +(* free variable in the meta_rule allowing only type instantiation. *) +(* (+) "mcheck_var" does the is_var check and tries to find a match with the *) +(* meta_rule's free vars (rfrees) using match_var. *) +(* (+) "mcheck_gvar" tries to match variables on the rhs of each instlist *) +(* pair with the free variables in the goal so as to instantiate their types *) +(* properly. This is done to free the user from declaring the variable types.*) +(* (+) Given variables are replaced with the meta_rule variables (effectively*) +(* achieving type instantiation) and later recombined into the instlist. *) +(* (+) Secondly, we rename all the variables in the meta_rule using *) +(* "meta_rule_mk_primed_vars_I" so that they don't match any of the free *) +(* variables in the goal. *) +(* (+) We use the same instantiation to rename instlist variables so that *) +(* they properly match the new variables of the meta_rule. *) +(* (+) "new_instlist" should contain variables that fully match primed *) +(* variables in the meta_rule (new_r). *) +(* (+) For each instlist pair, we find the instantiation that allows the *) +(* variable to be substituted by the given term. *NOTE* that no check is *) +(* made on that term. It is the user's responsibility to give a sensible, *) +(* matching and correctly typed term. *) +(* (+) All the instantiations produced by the instlist are composed into one *) +(* which is then applied to new_r to give the result. *) +(* ------------------------------------------------------------------------- *) + + +let inst_meta_rule_vars: (term * term) list -> meta_rule -> term list -> meta_rule = + fun instlist r gfrees -> + let rfrees = meta_rule_frees r in + let vars,subs = List.split instlist in + + let match_var = fun tm1 tm2 -> + let inst = try term_match [] tm1 tm2 with Failure _ -> [],[tm2,tm1],[] in + match inst with + [],[],_ -> tm2 + | _ -> failwith "match_var: no match" in + + let mcheck_var = fun tm -> + if (not (is_var tm)) then failwith ("inst_meta_rule_vars: `" ^ string_of_term tm ^ "` is not a variable") + else try list_match_first (match_var tm) rfrees + with Failure _ -> failwith ("inst_meta_rule_vars: `" ^ string_of_term tm ^ "` could not be found in the meta_rule") in + + let mcheck_gvar = fun var -> + try let mvar = list_match_first (match_var var) gfrees in + term_match [] var mvar + with Failure _ -> + warn true ("inst_meta_rule_vars: `" ^ string_of_term var ^ "` could not be found in the goal") ; + null_inst in + + let new_r,prim_inst = meta_rule_mk_primed_vars_I gfrees r in + let new_vars = map ((instantiate prim_inst) o mcheck_var) vars in + + let subs_vars = flat (map frees subs) in + let new_subs_inst = itlist compose_insts (map mcheck_gvar subs_vars) null_inst in + let new_subs = map (instantiate new_subs_inst) subs in + + let new_instlist = List.combine new_vars new_subs in + let mk_inst = fun t1,t2 -> term_match [] t1 t2 in + let inst = itlist compose_insts (map mk_inst new_instlist) null_inst in + let result_r = inst_meta_rule inst new_r in + result_r;; + + + +(* ------------------------------------------------------------------------- *) +(* mk_meta_rule: thm -> meta_rule *) +(* Creates a meta_rule out of a theorem. *) +(* Theorem must be of the form |- H1 ===> H2 ===> ...===> Hn ===> C *) +(* "===>" is the emulation of meta-level implication so this corresponds to *) +(* [|H1;H2;...;Hn|] ==> C in Isabelle) *) +(* For each Hi that is a meta-level implication, a "meta_subgoal" is created.*) +(* ------------------------------------------------------------------------- *) +(* (+) undisch_premises uses MUNDISCH to handle meta-level implication. All *) +(* the premises are undischarged. It returns the list of premises paired *) +(* with the resulting theorem. Note that MUNDISCH also removes meta-level *) +(* implication from the undischarged premises. *) +(* (+) "mk_meta_subgoal" creates a meta_subgoal from a term. If the term is *) +(* an implication, the lhs is added as an assumption/premise of the *) +(* meta_subgoal and mk_meta_subgoal is called recursively for the rhs. *) +(* (+) The conclusion of the undischarged theorem is the first part of the *) +(* produced meta_rule. *) +(* (+) mk_meta_subgoal creates the meta_subgoals for all the premises. They *) +(* form the second part of the meta_rule. *) +(* (+) The theorem itself is used as the justification theorem, after *) +(* eliminating any remaining meta-level implication in the conclusion. *) +(* In theory, the conclusion should never have any remaining meta-level *) +(* implications. We're just making sure because we don't want any meta-level *) +(* implications to appear in our new subgoals. *) +(* ------------------------------------------------------------------------- *) + +let (mk_meta_rule: thm -> meta_rule) = + fun thm -> + let rec undisch_premises th = + if is_mimp (concl th) + then let rest,res_th = undisch_premises (MUNDISCH th) in + (rand(rator(concl th)))::rest,res_th + else [],th in + let (prems,thm) = undisch_premises thm in + let rec mk_meta_subgoal tm = ( + if (is_mimp(tm)) then + let (a,c) = dest_mimp tm in + let (prems,concl) = mk_meta_subgoal c in + ("",ASSUME a)::prems,concl + else [],tm + ) in + concl thm,map mk_meta_subgoal prems,MIMP_TO_IMP_RULE thm;; + + +(* ------------------------------------------------------------------------- *) +(* mk_meta_rule_old: thm -> meta_rule *) +(* Creates a meta_rule out of a theorem. === DEPRECATED === *) +(* Theorem must be of the form H1,H2,...,Hn |- C *) +(* If Hi is of the form Hi1==>Hi2==>...==>Hik==>HiC then it is treated as *) +(* Hi1,Hi2,...,Hik ?- HiC (or "meta-level" implication *) +(* [|Hi1;Hi2;...;Hik|] ==> HiC in Isabelle) and the corresponding *) +(* meta_subgoal is created. *) +(* ------------------------------------------------------------------------- *) +(* --As a result you CANNOT have rules with implication in their premises!-- *) +(* (You'll have to use mk_elim_meta_rule or build the meta_rule yourself.) *) +(* ------------------------------------------------------------------------- *) +(* (+) The theorem is destroyed to its hypothesis list and its conclusion. *) +(* The conclusion is the first part of the meta_rule. *) +(* (+) "mk_meta_subgoal" creates a meta_subgoal from a term. If the term is *) +(* an implication, the lhs is added as an assumption/premise of the *) +(* meta_subgoal and mk_meta_subgoal is called recursively for the rhs. *) +(* (+) The theorem itself is used as the justification theorem. *) +(* ------------------------------------------------------------------------- *) +(* Deprecated. New mk_meta_rule uses meta-level implication. *) +(* Kept until new mk_meta_rule is tested and stable. *) +(* ------------------------------------------------------------------------- *) + +let (mk_meta_rule_old: thm -> meta_rule) = + fun thm -> + let (hyps,concl) = dest_thm thm in + let rec mk_meta_subgoal tm = ( + if (is_imp(tm)) then + let (a,c) = dest_imp tm in + let (prems,concl) = mk_meta_subgoal c in + ("",ASSUME a)::prems,concl + else [],tm + ) in + concl,map mk_meta_subgoal hyps,thm;; + + + +(* ------------------------------------------------------------------------- *) +(* mk_elim_meta_rule_old: thm -> meta_rule *) +(* Creates a meta_rule out of a theorem. === DEPRECATED === *) +(* Works like mk_meta_rule but acommodates elimination/destruction rules *) +(* a little bit better by not breaking the major premise. This effectively *) +(* allows the major premise to be an implication. *) +(* ------------------------------------------------------------------------- *) +(* In an elimination or destruction rule, the first or major premise is *) +(* matched against one of the assumptions. Therefore, you cannot have a *) +(* meta_subgoal for a major premise. If there is an implication there we *) +(* shall leave it intact and not treat it as "meta-level" implication. *) +(* This still disallows the use of implication in the rest of the premises *) +(* (by treating it as "meta-level" implication). *) +(* ------------------------------------------------------------------------- *) +(* Deprecated. New mk_meta_rule uses meta-level implication. *) +(* Kept until new mk_meta_rule is tested and stable. *) +(* ------------------------------------------------------------------------- *) + +let (mk_elim_meta_rule_old: thm -> meta_rule) = + fun thm -> + let (hyps,concl) = dest_thm thm in + if (hyps = []) then failwith "mk_elim_meta_rule: Invalid rule - no premises!" + else let major_prem,hyps = ([],hd hyps),tl hyps in + let rec mk_meta_subgoal tm = ( + if (is_imp(tm)) then + let (a,c) = dest_imp tm in + let (prems,concl) = mk_meta_subgoal c in + ("",ASSUME a)::prems,concl + else [],tm + ) in + concl,major_prem :: (map mk_meta_subgoal hyps),thm;; + + + +(* ------------------------------------------------------------------------- *) +(* Isabelle's natural deduction inference rules as meta_rules. *) +(* ------------------------------------------------------------------------- *) +(* The trailing 'm' indicates they are represented as meta_rules as opposed *) +(* to theorems. *) +(* Use "mk_meta_rule" to create meta_rules from theorems. *) +(* Most of the following can be created using mk_meta_rule but are left here *) +(* as examples. *) +(* ------------------------------------------------------------------------- *) +(* Deprecated. New mk_meta_rule uses meta-level implication so now ALL of *) +(* these can be represented at the object-level and turned into meta_rules *) +(* using mk_meta_rule. *) +(* ------------------------------------------------------------------------- *) + +let conjIm:meta_rule = + (`p/\q`, + [ + [],`p:bool`; + [],`q:bool` + ], + conjI);; + +let conjEm:meta_rule = + (`r:bool`, + [ + [],`p/\q`; + [("",ASSUME `p:bool`);("",ASSUME `q:bool`)],`r:bool` + ], + (UNDISCH o UNDISCH o TAUT) `p/\q==>(p==>q==>r)==>r` +);; + +let notEm:meta_rule = + (`r:bool`, + [ + [],`~a`; + [],`a:bool` + ], + (UNDISCH o UNDISCH o TAUT) `~a==>a==>r` +);; + +let disjI1m:meta_rule = + (`p\/q`, + [ + [],`p:bool`; + ], + UNDISCH ( TAUT `p==>p\/q` ));; + +let disjI2m:meta_rule = + (`p\/q`, + [ + [],`q:bool`; + ], + UNDISCH ( TAUT `q==>p\/q` ));; + +let disjEm:meta_rule = + (`r:bool`, + [ + [],`p\/q`; + [("",ASSUME `p:bool`)],`r:bool`; + [("",ASSUME `q:bool`)],`r:bool` + ], + (UNDISCH o UNDISCH o UNDISCH) ( TAUT `p\/q==>(p==>r)==>(q==>r)==>r`) + );; + + +let impIm:meta_rule = + (`p==>q`, + [ + [("",ASSUME `p:bool`)],`q:bool` + ], + UNDISCH (TAUT `(p==>q)==>(p==>q)`) +);; + + +let impEm:meta_rule = + (`r:bool`, + [ + [],`p==>q`; + [],`p:bool`; + [("",ASSUME `q:bool`)],`r:bool` + ], + (UNDISCH o UNDISCH o UNDISCH o TAUT) `(p==>q)==>p==>(q==>r)==>r` +);; + + +let mpm:meta_rule = + (`q:bool`, + [ + [],`p==>q`; + [],`p:bool` + ], + (UNDISCH o UNDISCH o TAUT) `(p==>q)==>(p==>q)` +);; + +(* Note from old mk_meta_rule: *) +(* This one cannot be expressed as a theorem because HOL Light insists on *) +(* ordering the assumptions of the theorem so the major premise is `p` *) +(* instead of `~p`. *) + +let notEm:meta_rule = + (`r:bool`, + [ + [],`~a`; + [],`a:bool` + ], + (UNDISCH o UNDISCH o TAUT) `~a==>a==>r` +);; + + +(* ------------------------------------------------------------------------- *) +(* rulem_tac: ((term * term) list -> meta_rule -> tactic): *) +(* Isabelle's rule as a HOL Light meta_rule tactic. *) +(* Uses a rule of the form H1,H2,...,Hn |- C represented as a meta_rule *) +(* to solve A1,A2,...,Am ?- G *) +(* Matches C to the goal G, then splits the goal to *) +(* A1,A2,...,Am ?- H1 *) +(* A1,A2,...,Am ?- H2 *) +(* ... *) +(* A1,A2,...,Am ?- Hn *) +(* Hi can be of the form Hi1,Hi2,...,Hik ?- HiC then the goal produced is *) +(* A1,A2,...,Am,Hi1,Hi2,...,Hik ?- HiC *) +(* ------------------------------------------------------------------------- *) +(* (+) "avoids" lists all the free variables in the assumptions and goal so *) +(* as to avoid instantiating those (as in variable conflicts with the rule *) +(* or partly instantiated rule in the case of erule) *) +(* (+) First we check if C matches G. If it does we keep the resulting *) +(* instantiation (ins). *) +(* (+) We instantiate the "meta-subgoals" of the meta_rule using ins. *) +(* In essence we're instantiating the premises of the rule. (new_hyps) *) +(* (+) The "create_goal" function creates the new goals by adding the *) +(* assumption list A1--Am to the instantiated "meta-subgoal". *) +(* (+) create_goal is mapped on new_hyps to create the new subgoal list. *) +(* (+) The "create_dischl" function creates the list of the terms involved *) +(* in the premises of each instantiated meta-subgoal. In order to create the *) +(* justification of the tactic, we need to convert Hi1,Hi2,...,Hik |- HiC *) +(* into |- Hi1==>Hi2==>...==>Hik==>HiC. That is the only way we can capture *) +(* the notion of a "subgoal" within a HOL Light object-level theorem. *) +(* We will then use PROVE_HYP to eliminate each of the proven subgoals from *) +(* the rule's justification theorem. In order to achieve this conversion we *) +(* need to keep a list of the instantiated premises of the rule (dischls) *) +(* for each meta_subgoal so as to avoid discharging the original goal's *) +(* assumptions or _FALSITY_. *) +(* (+) "disch_pair" is used for convenience. dishls is combined with the *) +(* list of proven subgoals so that each subgoal is attached to its *) +(* corresponding premises list (dischl). disch_pair then does the discharges.*) +(* It also takes care of instantiating the meta-variables in those premises *) +(* for proper justification. *) +(* (+) normalfrees is used to calculate the list of metavariables that will *) +(* end up in the new subgoals. It contains all the free variables in the *) +(* goal and instlist. *) +(* (+) The newly introduced metavariables are found by subtracting *) +(* normalfrees from the set of all free variables in all new goals. *) +(* ------------------------------------------------------------------------- *) + +let (rulem_tac: (term*term) list->meta_rule->tactic) = + fun instlist r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let ins = try ( term_match [] c w ) with Failure _ -> failwith "Rule doesn't match!" in + + let new_hyps = map (inst_goal ins) hyps in + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = map (create_goal asl) new_hyps in + let rec create_dischl = fun (asms,g) -> if (asms = []) then [] else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + let dischls = map create_dischl new_hyps in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) (map (disch_pair i) (List.combine dischls l));; + + +(* ------------------------------------------------------------------------- *) +(* erulem_tac: ((term * term) list -> meta_rule -> tactic): *) +(* Isabelle's erule as a HOL Light meta_rule tactic. *) +(* Works like rulem but also matches the first hypothesis H1 with one of the *) +(* assumptions A1--Am and instantiates accordingly. *) +(* A "proper" elimination rule H1 is of the form ?- H1 (ie. has no premises) *) +(* ------------------------------------------------------------------------- *) +(* Same as rulem with some added stuff. *) +(* (+) If there are no "meta_subgoals" (no new subgoals to create) we fail. *) +(* (+) Otherwise we use the first "meta_subgoal" as our primary hypothesis *) +(* (the one that will be eliminated - prim_hyp). *) +(* (+) If prim_hyp has premises then this is not a "proper" elimination rule.*) +(* (+) Otherwise try to match any of the assumptions with prim_hyp. The *) +(* resulting instantiation is elim_inst. *) +(* (+) Instantiate all generated meta_subgoals with elim_inst. Retrieve the *) +(* (now instantiated) prim_hyp and remove it from the new subgoals (it is *) +(* trivially proven). We get a "pattern-matching is not exhaustive" warning *) +(* here, but we have already checked that new_hyps is non-empty. *) +(* (+) prim_thm is a trivial theorem that proves the subgoal corresponding *) +(* to prim_hyp. *) +(* (+) Instantiate the justification theorem with elim_thm. *) +(* (+) Add prim_hyp to the justification (pretending its a proven subgoal). *) +(* (+) Use a hack to add the eliminated assumption to the proven subgoals so *) +(* that we pass the validity check properly. *) +(* ------------------------------------------------------------------------- *) + +let (erulem_tac: (term * term) list -> meta_rule->tactic) = + fun instlist r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let ins = try ( term_match [] c w ) + with Failure _ -> failwith "Rule doesn't match!" in + let new_hyps = map (inst_goal ins) hyps in + + let (prems,prim_hyp) = + if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" + else hd new_hyps in + let avoids = gl_frees g in + + let asl,(prim_thm,elim_inst) = + if (prems = []) + then try term_to_asm_match avoids prim_hyp asl with Failure s -> failwith ("erule: " ^ s) + else failwith "erule: Not a proper elimination rule: major premise has assumptions!" in + let (_,prim_hyp)::new_hyps = map (inst_goal elim_inst) new_hyps in + let thm = INSTANTIATE_ALL elim_inst thm in + + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = map (create_goal asl) new_hyps in + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] + else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + let dischls = map create_dischl new_hyps in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + let major_thmi = INSTANTIATE_ALL i prim_thm in + List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) + (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l)));; + + +(* ------------------------------------------------------------------------- *) +(* drulem_tac: ((term * term) list -> meta_rule -> tactic): *) +(* Isabelle's drule as a HOL Light meta_rule tactic. *) +(* Uses rules as shown in "rule". *) +(* Matches the first hypothesis H1 with one of the *) +(* assumptions A1--Am and instantiates accordingly. *) +(* The assumption is removed from the list and the trivial goal is proven *) +(* automatically. *) +(* A "proper" destructio rule H1 is of the form ?- H1 (ie. has no premises) *) +(* The goal A1,A2,...,Am,G ?- C is also added. *) +(* ------------------------------------------------------------------------- *) +(* Same as erulem with a few differences. *) +(* [+] Does not try to match the goal c. *) +(* [+] Adds an extra goal c ?- w after instantiating c. *) +(* [+] The new goal is treated slightly different in the justification. *) +(* It is the one whose premises must be proven so as to get to the final *) +(* goal. So it gets proven using PROVE_HYP by the result of the *) +(* justification on the original rule. *) +(* ------------------------------------------------------------------------- *) + +let (drulem_tac: (term * term) list -> meta_rule->tactic) = + fun instlist r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let (prems,major_prem) = + if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" + else hd hyps in + let avoids = gl_frees g in + + let asl,(major_thm,elim_inst) = + if (prems = []) + then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("drule: " ^ s) + else failwith "drule: not a proper destruction rule: major premise has assumptions!" in + let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in + let thm = INSTANTIATE_ALL elim_inst thm in + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in + + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] + else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + (* We add an empty discharge list at the end for the extra goal. *) + let dischls = map create_dischl new_hyps @ [[]] in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + let major_thmi = INSTANTIATE_ALL i major_thm in + let l = (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l))) in + PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; + + +(* ------------------------------------------------------------------------- *) +(* frulem_tac: ((term * term) list -> meta_rule -> tactic): *) +(* Isabelle's frule as a HOL Light meta_rule tactic. *) +(* Same as drule, but does not remove the matching assumption from the list. *) +(* ------------------------------------------------------------------------- *) +(* Same as drulem only skipping the parts that eat up the assumption and *) +(* re-add it to the proven subgoals. *) +(* ------------------------------------------------------------------------- *) + +let (frulem_tac: (term * term) list -> meta_rule->tactic) = + fun instlist r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let (prems,major_prem) = + if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" + else hd hyps in + let avoids = gl_frees g in + + let _,(major_thm,elim_inst) = + if (prems = []) + then try term_to_asm_match avoids major_prem asl with Failure s -> failwith ("frule: " ^ s) + else failwith "frule: Not a proper destruction rule: major premise has assumptions!" in + let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in + let thm = INSTANTIATE_ALL elim_inst thm in + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in + + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] + else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + let dischls = map create_dischl new_hyps @ [[]] in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + let major_thmi = INSTANTIATE_ALL i major_thm in + let l = (major_thmi :: ((map (disch_pair i)) o (List.combine dischls)) l) in + PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; + + +(* ------------------------------------------------------------------------- *) +(* cutm_tac: ((term * term) list -> meta_rule -> tactic): *) +(* Isabelle's cut_tac as a HOL Light meta_rule tactic. *) +(* Inserts a theorem in the assumptions. *) +(* ------------------------------------------------------------------------- *) +(* (+) WARNING: It does not introduce metavariables like the other tactics *) +(* do! In the TODO list... *) +(* ------------------------------------------------------------------------- *) + +let (cutm_tac: (term * term) list -> meta_rule->tactic) = + fun instlist r g -> + let (_,_,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + (ASSUME_TAC thm) g;; + + +(* ------------------------------------------------------------------------- *) +(* erulenm_tac : (term * term) list -> int -> meta_rule->tactic) *) +(* drulenm_tac : (term * term) list -> int -> meta_rule->tactic) *) +(* frulenm_tac : (term * term) list -> int -> meta_rule->tactic) *) +(* Identical to their counterparts, the only difference being that they try *) +(* to match a particular assumption given by number. *) +(* ------------------------------------------------------------------------- *) + +let (erulenm_tac: (term * term) list -> int -> meta_rule->tactic) = + fun instlist n r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let ins = try ( term_match [] c w ) + with Failure _ -> failwith "Rule doesn't match!" in + let new_hyps = map (inst_goal ins) hyps in + + let (prems,prim_hyp) = + if (new_hyps = []) then failwith "erule: Not a proper elimination rule: no premises!" + else hd new_hyps in + let avoids = gl_frees g in + + let asl,(prim_thm,elim_inst) = + if (prems = []) + then try term_to_asm_n_match avoids prim_hyp (rev asl) n with Failure s -> failwith ("erule: " ^ s) + else failwith "erule: Not a proper elimination rule: major premise has assumptions!" in + let (_,prim_hyp)::new_hyps = map (inst_goal elim_inst) new_hyps in + let thm = INSTANTIATE_ALL elim_inst thm in + + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = map (create_goal asl) new_hyps in + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] + else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + let dischls = map create_dischl new_hyps in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + let major_thmi = INSTANTIATE_ALL i prim_thm in + List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL (compose_insts ins i) thm) + (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l)));; + + +let (drulenm_tac: (term * term) list -> int -> meta_rule->tactic) = + fun instlist n r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let (prems,major_prem) = + if (hyps = []) then failwith "drule: Not a proper destruction rule: no premises!" + else hd hyps in + let avoids = gl_frees g in + + let asl,(major_thm,elim_inst) = + if (prems = []) + then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("drule: " ^ s) + else failwith "drule: not a proper destruction rule: major premise has assumptions!" in + let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in + let thm = INSTANTIATE_ALL elim_inst thm in + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in + + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] + else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + (* We add an empty discharge list at the end for the extra goal. *) + let dischls = map create_dischl new_hyps @ [[]] in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + let major_thmi = INSTANTIATE_ALL i major_thm in + let l = (major_thmi :: map (ADD_HYP major_thmi) (map (disch_pair i) (List.combine dischls l))) in + PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; + + +let (frulenm_tac: (term * term) list -> int -> meta_rule->tactic) = + fun instlist n r ((asl,w) as g) -> + let (c,hyps,thm) = inst_meta_rule_vars instlist r (gl_frees g) in + + let (prems,major_prem) = + if (hyps = []) then failwith "frule: Not a proper destruction rule: no premises!" + else hd hyps in + let avoids = gl_frees g in + + let _,(major_thm,elim_inst) = + if (prems = []) + then try term_to_asm_n_match avoids major_prem (rev asl) n with Failure s -> failwith ("frule: " ^ s) + else failwith "frule: Not a proper destruction rule: major premise has assumptions!" in + let (_,major_asm)::new_hyps = map (inst_goal elim_inst) hyps in + let thm = INSTANTIATE_ALL elim_inst thm in + let create_goal = fun asms (hs,gl) -> (hs@asms,gl) in + let new_goals = (map (create_goal asl) new_hyps) @ [create_goal asl (["",ASSUME (instantiate elim_inst c)],w)] in + + let rec create_dischl = + fun (asms,g) -> + if (asms = []) then [] + else ((concl o snd o hd) asms)::(create_dischl ((tl asms),g)) in + let dischls = map create_dischl new_hyps @ [[]] in + let disch_pair = fun i (dischl,thm) -> DISCHL (map (instantiate i) dischl) thm in + + let normalfrees = itlist union (map ( fun (_,y) -> frees y ) instlist ) (gl_frees g) in + let mvs = subtract (itlist union (map gl_frees new_goals) []) normalfrees in + (mvs,null_inst),new_goals,fun i l -> + let major_thmi = INSTANTIATE_ALL i major_thm in + let l = (major_thmi :: ((map (disch_pair i)) o (List.combine dischls)) l) in + PROVE_HYP (List.fold_left (fun t1 t2 -> PROVE_HYP (INSTANTIATE_ALL i t2) t1) (INSTANTIATE_ALL i thm) ((butlast) l)) (last l);; + + +(* ------------------------------------------------------------------------- *) +(* Xrulem versions for empty instlist. *) +(* ------------------------------------------------------------------------- *) + +let rulem: meta_rule -> tactic = rulem_tac [];; +let erulem: meta_rule -> tactic = erulem_tac [];; +let drulem: meta_rule -> tactic = drulem_tac [];; +let frulem: meta_rule -> tactic = frulem_tac [];; + +let erulenm: int -> meta_rule -> tactic = erulenm_tac [];; +let drulenm: int -> meta_rule -> tactic = drulenm_tac [];; +let frulenm: int -> meta_rule -> tactic = frulenm_tac [];; + +(* For consistency with HOL Light capitalized tactics: *) +let RULEM,ERULEM,DRULEM,FRULEM = rulem,erulem,drulem,frulem;; +let ERULENM,DRULENM,FRULENM = erulenm,drulenm,frulenm;; + + +(* ------------------------------------------------------------------------- *) +(* Xrule and Xrule_tac using arbitrary inference rules in the form of thms. *) +(* (see mk_meta_rule and meta_rule type) *) +(* ------------------------------------------------------------------------- *) + +let rule_tac: (term * term) list -> thm -> tactic = + fun instlist thm -> + rulem_tac instlist (mk_meta_rule thm);; + +let erule_tac: (term * term) list -> thm -> tactic = + fun instlist thm -> + erulem_tac instlist (mk_meta_rule thm);; + +let drule_tac: (term * term) list -> thm -> tactic = + fun instlist thm -> + drulem_tac instlist (mk_meta_rule thm);; + +let frule_tac: (term * term) list -> thm -> tactic = + fun instlist thm -> + frulem_tac instlist (mk_meta_rule thm);; + +let cut_tac: (term * term) list -> thm -> tactic = + fun instlist thm -> + cutm_tac instlist (mk_meta_rule thm);; + +let RULE_TAC,ERULE_TAC,DRULE_TAC,FRULE_TAC,CUT_TAC = rule_tac,erule_tac,drule_tac,frule_tac,cut_tac;; + + +let erulen_tac: (term * term) list -> int -> thm -> tactic = + fun instlist n thm -> + erulenm_tac instlist n (mk_meta_rule thm);; + +let drulen_tac: (term * term) list -> int -> thm -> tactic = + fun instlist n thm -> + drulenm_tac instlist n (mk_meta_rule thm);; + +let frulen_tac: (term * term) list -> int -> thm -> tactic = + fun instlist n thm -> + frulenm_tac instlist n (mk_meta_rule thm);; + +let ERULEN_TAC,DRULEN_TAC,FRULEN_TAC = erulen_tac,drulen_tac,frulen_tac;; + + +let rule: (thm -> tactic) = rule_tac [];; +let erule: (thm -> tactic) = erule_tac [];; +let drule: (thm -> tactic) = drule_tac [];; +let frule: (thm -> tactic) = frule_tac [];; + +let RULE,ERULE,DRULE,FRULE = rule,erule,drule,frule;; + + +let erulen: (int -> thm -> tactic) = erulen_tac [];; +let drulen: (int -> thm -> tactic) = drulen_tac [];; +let frulen: (int -> thm -> tactic) = frulen_tac [];; + +let ERULEN,DRULEN,FRULEN = erulen,drulen,frulen;; diff --git a/IsabelleLight/new_tactics.ml b/IsabelleLight/new_tactics.ml new file mode 100644 index 0000000..1a4b519 --- /dev/null +++ b/IsabelleLight/new_tactics.ml @@ -0,0 +1,353 @@ +(* ========================================================================= *) +(* Isabelle Light *) +(* Isabelle/Procedural style additions and other user-friendly shortcuts. *) +(* *) +(* Petros Papapanagiotou, Jacques Fleuriot *) +(* Center of Intelligent Systems and their Applications *) +(* University of Edinburgh *) +(* 2009-2010 *) +(* ========================================================================= *) +(* FILE : new_tactics.ml *) +(* DESCRIPTION : Various tactics to facilitate procedural-style users. *) +(* Mostly inspired by Isabelle's similar tactics. *) +(* LAST MODIFIED: October 2012 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* e_all : tactic -> goalstack *) +(* Same as "e" but applies tactic to ALL subgoals. *) +(* ------------------------------------------------------------------------- *) + +let e_all tac = + let c = (count_goals()) in + let rec f i = ( + if (i = 0) + then (!current_goalstack) + else let _ = e tac in let _ = r 1 in f (i-1) + ) in f c;; + + +(* ------------------------------------------------------------------------- *) +(* ROTATE_N_TAC: *) +(* Rotates assumptions N times. *) +(* ------------------------------------------------------------------------- *) +(* Pops the entire assumption list doing nothing (K ALL_TAC) then maps *) +(* LABEL_TAC to the rotated list of assumptions. The list is reversed so as *) +(* to match the external order. The result is applied to (asl,w) so as to *) +(* obtain the resulting goalstate as required by the tactic type. *) +(* ------------------------------------------------------------------------- *) + +let (ROTATE_N_TAC :int->tactic) = + fun n (asl,w) -> + let rotateasm = fun (asl) -> (tl asl)@[hd asl] in + (POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY (fun (s,th) -> LABEL_TAC s th) (funpow n rotateasm (rev asl))) + (asl,w);; + + +(* ------------------------------------------------------------------------- *) +(* ROTATE_TAC: *) +(* Rotates assumptions once. *) +(* ------------------------------------------------------------------------- *) + +let (ROTATE_TAC :tactic) = (ROTATE_N_TAC 1);; + + + +(* ------------------------------------------------------------------------- *) +(* DRULE_N_TAC: *) +(* Applies an inference rule to Nth assumption only. *) +(* Like drule for HOL Light's inference rules without matching. *) +(* ------------------------------------------------------------------------- *) +(* Works like RULE_ASSUM_TAC except it numbers the assumption list with *) +(* num_list and only applies the rule to the Nth assumption. *) +(* ------------------------------------------------------------------------- *) + +let (DRULE_N_TAC :int->(thm->thm)->tactic) = + fun n rule (asl,w) -> (POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY (fun (i,(s,th)) -> LABEL_TAC s (if (i=n) then (rule th) else th)) + (num_list(rev asl))) (asl,w);; + + + +(* ------------------------------------------------------------------------- *) +(* FRULE_N_TAC: *) +(* Applies an inference rule to Nth assumption only then adds the result as *) +(* a new assumption. *) +(* Like frule for HOL Light's inference rules without matching. *) +(* ------------------------------------------------------------------------- *) +(* Works like DRULE_N_TAC except it leaves the assumption intact and *) +(* adds the result as a new assumption. *) +(* ------------------------------------------------------------------------- *) + +let (FRULE_N_TAC :int->(thm->thm)->tactic) = + fun n rule (asl,w) -> ( + let asmlist = num_list(rev asl) in + let (_,asm_n) = try assoc n asmlist with Failure _ -> + failwith("FRULE_N_TAC: didn't find assumption "^string_of_int(n)) in + ASSUME_TAC (rule asm_n)) (asl,w);; + + + +(* ------------------------------------------------------------------------- *) +(* FRULE_MN_TAC: *) +(* Applies an inference rule (such as MP) to the Mth and Nth assumptions and *) +(* adds the result as a new assumption. *) +(* ------------------------------------------------------------------------- *) +(* Numbers the assumption list, finds the Mth and Nth assumptions, applies *) +(* the rule to them and adds the result as a new assumption. *) +(* ------------------------------------------------------------------------- *) + +let (FRULE_MN_TAC :int->int->(thm->thm->thm)->tactic) = +fun m n rule (asl,w) -> ( + let asmlist = num_list(rev asl) in + let (_,asm_m) = try assoc m asmlist with Failure _ -> + failwith("FRULE_MN_TAC: didn't find assumption "^string_of_int(m)) in + let (_,asm_n) = try assoc n asmlist with Failure _ -> + failwith("FRULE_MN_TAC: didn't find assumption "^string_of_int(n)) in + ASSUME_TAC (rule asm_m asm_n)) (asl,w);; + + + + +(* ------------------------------------------------------------------------- *) +(* ----------------------- SIMP TACTICS START HERE!! ----------------------- *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* GENERAL_ASM_TAC: (thm list -> thm -> thm) -> thm list -> tactic *) +(* General function that uses a rewrite rule to rewrite the assumptions. *) +(* Each assumption is rewritten using the rest of the assumptions and the *) +(* given list of theorems. *) +(* ------------------------------------------------------------------------- *) +(* A filter is applied to ensure that the assumption is not used to rewrite *) +(* itself. *) +(* ------------------------------------------------------------------------- *) + +let GENERAL_ASM_TAC = fun rule thl (asl,w) -> + let asm = map snd asl in + (POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY (fun (s,th) -> LABEL_TAC s + (rule ((filter (fun x -> not (th = x)) asm) @ thl) th) + ) (rev asl)) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Using the above GENERAL_ASSUM_TAC, we define 4 tactics to rewrite *) +(* assumptions based on the 4 rewrite rules available in HOL Light. *) +(* ------------------------------------------------------------------------- *) + +let REWRITE_ASM_TAC,ONCE_REWRITE_ASM_TAC,PURE_REWRITE_ASM_TAC, + PURE_ONCE_REWRITE_ASM_TAC = + GENERAL_ASM_TAC REWRITE_RULE, + GENERAL_ASM_TAC ONCE_REWRITE_RULE, + GENERAL_ASM_TAC PURE_REWRITE_RULE, + GENERAL_ASM_TAC PURE_ONCE_REWRITE_RULE;; + +(* ------------------------------------------------------------------------- *) +(* And for simplification. *) +(* ------------------------------------------------------------------------- *) + +let SIMP_ASM_TAC,ONCE_SIMP_ASM_TAC,PURE_SIMP_ASM_TAC = + GENERAL_ASM_TAC SIMP_RULE, + GENERAL_ASM_TAC ONCE_SIMP_RULE, + GENERAL_ASM_TAC PURE_SIMP_RULE;; + +(* ------------------------------------------------------------------------- *) +(* FULL_REWRITE_TAC : thm list -> tactic *) +(* simp : thm list -> tactic *) +(* Similar to Isabelle's simp. Rewrites assumptions then rewrites goal *) +(* using the assumptions. *) +(* ------------------------------------------------------------------------- *) + +let FULL_REWRITE_TAC thl = + REWRITE_ASM_TAC thl THEN ASM_SIMP_TAC thl;; + +let simp = FULL_REWRITE_TAC;; + +(* ------------------------------------------------------------------------- *) +(* FULL_SIMP_TAC : thm list -> tactic *) +(* Hybrid simplifier. Uses HOL Light's SIMP_TAC then FULL_REWRITE_TAC. *) +(* ------------------------------------------------------------------------- *) + +let FULL_SIMP_TAC thl = + SIMP_TAC thl THEN REWRITE_ASM_TAC thl THEN ASM_REWRITE_TAC thl;; + + + +(* ------------------------------------------------------------------------- *) +(* assumption (tactic): *) +(* Shortcut to match an assumption to the goal as Isabelle's "assumption". *) +(* ------------------------------------------------------------------------- *) + +let assumption = FIRST_ASSUM MATCH_ACCEPT_TAC;; + + +(* ------------------------------------------------------------------------- *) +(* ALL_UNIFY_ACCEPT_TAC (term list -> thm -> tactic): *) +(* Altered UNIFY_ACCEPT_TAC. Uses INSTANTIATE_ALL instead of INSTANTIATE. *) +(* ------------------------------------------------------------------------- *) +(* This allows for some valid instantiations that weren't otherwise allowed. *) +(* eg After using allE, the `a` metavariable can't be instantiated otherwise.*) +(* ------------------------------------------------------------------------- *) + +let ALL_UNIFY_ACCEPT_TAC mvs th (asl,w) = + let insts = term_unify mvs (concl th) w in + ([],insts),[], + let th' = INSTANTIATE_ALL insts th in + fun i [] -> INSTANTIATE_ALL i th';; + + + +(* ------------------------------------------------------------------------- *) +(* meta_assumption (term list -> tactic): *) +(* Shortcut to match an assumption to the goal as Isabelle's "assumption". *) +(* This version also tries unification by instantiation of meta-variables *) +(* which, unfortunately, need to be given manually in a list. *) +(* ------------------------------------------------------------------------- *) +(* Invalid instantiations may be produced. *) +(* eg g `!x:num. (?a:num. R a x) ==> (?y. R y x)`;; *) +(* e GEN_TAC;; *) +(* e (rule impI);; *) +(* e (rule exI);; *) +(* e (FIRST_X_ASSUM (X_CHOOSE_TAC `b:num`));; *) +(* e (meta_assumption [`a:num`]);; *) +(* This succeeds but top_thm() is unable to reconstruct the theorem. *) +(* ------------------------------------------------------------------------- *) + +let meta_assumption mvs = (FIRST_ASSUM MATCH_ACCEPT_TAC) ORELSE + (FIRST_ASSUM (ALL_UNIFY_ACCEPT_TAC mvs));; + + +(* ------------------------------------------------------------------------- *) +(* Shortcut for interactive proofs so that you don't have to enumerate *) +(* metavariables. *) +(* ------------------------------------------------------------------------- *) + +let ema () = (e o meta_assumption o top_metas o p) () ;; + + +(* ------------------------------------------------------------------------- *) +(* X_MATCH_CHOOSE_TAC : (term -> tactic) *) +(* Version of X_CHOOSE_TAC with type matching. *) +(* ------------------------------------------------------------------------- *) +(* If the variable given as an argument has a vartype then its type is *) +(* instantiated to the type of the existentially quantified variable. *) +(* Usefull so that the user need not specify the type for his variable. *) +(* It is still acceptable if the user does specify it. *) +(* ------------------------------------------------------------------------- *) + +let (X_MATCH_CHOOSE_TAC: term -> thm_tactic) = + fun x' xth -> + try let xtm = concl xth in + let x,bod = dest_exists xtm in + let x'type = type_of x' in + let x'' = if (is_vartype x'type) then + inst (type_match x'type (type_of x) []) x' + else x' in + let pat = vsubst[x'',x] bod in + let xth' = ASSUME pat in + fun (asl,w) -> + let avoids = itlist (union o frees o concl o snd) asl + (union (frees w) (thm_frees xth)) in + if mem x' avoids then failwith "X_CHOOSE_TAC" else + null_meta,[("",xth')::asl,w], + fun i [th] -> CHOOSE(x'',INSTANTIATE_ALL i xth) th + with Failure _ -> failwith "X_CHOOSE_TAC";; + + + + +(* ------------------------------------------------------------------------- *) +(* exE : (term -> tactic) *) +(* Existential elimination tactic (since we are unable to accommodate *) +(* erule exE with the current meta_rule system because of lack of meta-level *) +(* quantification). *) +(* ------------------------------------------------------------------------- *) + +let exE = FIRST_X_ASSUM o X_MATCH_CHOOSE_TAC;; + + +(* ------------------------------------------------------------------------- *) +(* allI : (term -> tactic) *) +(* Universal introduction tactic (since we are unable to accommodate *) +(* rule allI with the current meta_rule system because of lack of meta-level *) +(* quantification). *) +(* ------------------------------------------------------------------------- *) +(* (+) We can use X_GEN_TAC to allow the user to give his own term, but *) +(* this is rarely useful in procedural style proofs. *) +(* ------------------------------------------------------------------------- *) + +let allI = GEN_TAC;; + + +(* ------------------------------------------------------------------------- *) +(* qed : (unit -> thm) *) +(* Reconstructs the theorem at the end of an interactive proof. *) +(* May fail if an incorrect metavariable instantiation has occured during the*) +(* proof. *) +(* ------------------------------------------------------------------------- *) +(* (+) There are plans to upgrade this for better accommodation of proofs *) +(* containing meta-level implication (see meta_rules.ml and gmm). *) +(* ------------------------------------------------------------------------- *) + +let qed = top_thm;; + + +(* ------------------------------------------------------------------------- *) +(* ASM_STRUCT_CASES_TAC : (thm_tactic) *) +(* Replacement/fix of STRUCT_CASES_TAC where each case is added as an *) +(* assumption like ASM_CASES_TAC does for booleans. *) +(* ------------------------------------------------------------------------- *) + +let ASM_STRUCT_CASES_TAC = + REPEAT_TCL STRIP_THM_THEN ASSUME_TAC;; + +(* ------------------------------------------------------------------------- *) +(* case_tac : (term -> tactic) *) +(* Isabelle's case_tac for splitting cases. *) +(* ------------------------------------------------------------------------- *) + +let (case_tac:term->tactic) = + fun tm ((_,w) as g) -> + let trymatch = fun tm1 tm2 -> + try ( let inst = term_match (gl_frees g) tm1 tm2 in + if (is_var tm1) + then match inst with + [],[],_ -> true + | _ -> false + else true ) + with Failure _ -> false in + let tm' = try (find_term (trymatch tm) w) + with Failure _ -> tm in + let ty = (fst o dest_type o type_of) tm' in + let thm = try (cases ty) + with Failure _ -> failwith ("case_tac: Failed to find cases theorem for type \"" ^ ty ^ "\".") in + ASM_STRUCT_CASES_TAC (ISPEC tm' thm) g;; + + +(* ------------------------------------------------------------------------- *) +(* gen_case_tac : tactic *) +(* Case split on the leading universal quantifier of the goal. *) +(* ------------------------------------------------------------------------- *) + +let (gen_case_tac:tactic) = + fun ((_,w) as g) -> + case_tac ((fst o dest_forall) w) g;; + + +(* ------------------------------------------------------------------------- *) +(* subgoal_tac : (term -> tactic) *) +(* Introduces a new subgoal which gets added as an assumption. *) +(* Isabelle's subgoal_tac. *) +(* ------------------------------------------------------------------------- *) + +let subgoal_tac = fun tm -> SUBGOAL_THEN tm ASSUME_TAC;; + + +(* ------------------------------------------------------------------------- *) +(* meson : (thm list -> tactic) *) +(* Lower-case shortcut for ASM_MESON_TAC *) +(* ------------------------------------------------------------------------- *) + +let meson = ASM_MESON_TAC;; + diff --git a/IsabelleLight/support.ml b/IsabelleLight/support.ml new file mode 100644 index 0000000..670fa48 --- /dev/null +++ b/IsabelleLight/support.ml @@ -0,0 +1,257 @@ +(* ========================================================================= *) +(* Isabelle Light *) +(* Isabelle/Procedural style additions and other user-friendly shortcuts. *) +(* *) +(* Petros Papapanagiotou, Jacques Fleuriot *) +(* Center of Intelligent Systems and their Applications *) +(* University of Edinburgh *) +(* 2009-2012 *) +(* ========================================================================= *) +(* FILE : support.ml *) +(* DESCRIPTION : Support functions and various shortcuts. *) +(* LAST MODIFIED: October 2012 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Functions to deal with triplets: *) +(* ------------------------------------------------------------------------- *) + +let fst3 (x,_,_) = x;; +let snd3 (_,x,_) = x;; +let thd3 (_,_,x) = x;; + + +(*----------------------------------------------------------------------------*) +(* num_list : a' list -> (a' * int) list *) +(* *) +(* Numbers a list of elements, *) +(* e.g. [`a`;`b`;`c`] ---> [(0,`a`);(1,`b`);(2,`c`)]. *) +(*----------------------------------------------------------------------------*) + +let num_list l = + let rec number_list' n l = + if ( l = [] ) then [] + else (n,hd l)::(number_list' (n + 1) (tl l)) + in number_list' 0 l;; + + +(* ------------------------------------------------------------------------- *) +(* list_match_first: (a' -> b') -> a' list -> b' *) +(* Tries to apply a function to the members of a list. Returns the result *) +(* from the first member that succeeds. *) +(* ------------------------------------------------------------------------- *) + +let rec list_match_first f alist = + if (alist = []) then failwith "list_match_first: No matches!" + else try f (hd alist) with Failure _ -> list_match_first f (tl alist);; + + +(* ------------------------------------------------------------------------- *) +(* terms_match: term list -> term -> term list -> instantiation *) +(* Tries to apply term_match to the first possible term in a list. *) +(* Returns the insantiation. *) +(* ------------------------------------------------------------------------- *) + +let (terms_match: term list -> term -> term list -> instantiation ) = + fun consts key tlist -> + try (list_match_first (term_match consts key) tlist) + with Failure _ -> failwith "terms_match: No terms match!";; + + +(* ------------------------------------------------------------------------- *) +(* thm_mk_primed_vars: term list -> thm -> thm *) +(* Renames all free variables in a theorem to avoid specified and constant *) +(* names. *) +(* ------------------------------------------------------------------------- *) + +let thm_mk_primed_vars avoids thm = + let fvars = thm_frees thm in + let new_vars = map (mk_primed_var avoids) fvars in + let insts = List.combine new_vars fvars in + INST insts thm;; + + +(* ------------------------------------------------------------------------- *) +(* gl_frees: goal -> term list *) +(* Finds the free variables in a subgoal (assumptions and goal). *) +(* ------------------------------------------------------------------------- *) + +let gl_frees : goal -> term list = + fun (asl,w) -> itlist (union o thm_frees o snd) asl (frees w);; + + +(* ------------------------------------------------------------------------- *) +(* ADD_HYP: thm -> thm -> thm *) +(* Trivially adds the hypotheses of a theorem to the premises of another. *) +(* ------------------------------------------------------------------------- *) +(* (+) Used in the justification of erule and drule to add the eliminated *) +(* assumption to the proven subgoals. *) +(* (+) Could have been based on ADD_ASSUM but it's more convenient this way. *) +(* ------------------------------------------------------------------------- *) + +let ADD_HYP hyp_thm thm = CONJUNCT2 (CONJ hyp_thm thm);; + + +(* ------------------------------------------------------------------------- *) +(* DISCHL: term list -> thm -> thm *) +(* Applies DISCH for several terms. *) +(* ------------------------------------------------------------------------- *) + +let rec (DISCHL: term list -> thm -> thm) = + fun tms thm -> + if (tms = []) then thm + else DISCH (hd tms) (DISCHL (tl tms) thm);; + + +(* ------------------------------------------------------------------------- *) +(* print_thl: *) +(* Print a list of theorems (for debugging). *) +(* ------------------------------------------------------------------------- *) + +let print_thl thl = + map (fun thm -> ( print_thm thm ; print_newline ())) thl;; + + +(* ------------------------------------------------------------------------- *) +(* print_tml: *) +(* Print a list of terms (for debugging). *) +(* ------------------------------------------------------------------------- *) + +let print_tml tml = + map (fun tm -> ( print_term tm ; print_newline ())) tml;; + + +(* ------------------------------------------------------------------------- *) +(* print_varandtype, show_types, hide_types: *) +(* Prints the type after each variable. Useful for "debugging" type issues. *) +(* ------------------------------------------------------------------------- *) +(* Source: *) +(* http://code.google.com/p/flyspeck/wiki/TipsAndTricks#Investigating_Types *) +(* ------------------------------------------------------------------------- *) + +let print_varandtype fmt tm = + let hop,args = strip_comb tm in + let s = name_of hop + and ty = type_of hop in + if is_var hop & args = [] then + (pp_print_string fmt "("; + pp_print_string fmt s; + pp_print_string fmt ":"; + pp_print_type fmt ty; + pp_print_string fmt ")") + else fail() ;; + +let show_types,hide_types = + (fun () -> install_user_printer ("Show Types",print_varandtype)), + (fun () -> try delete_user_printer "Show Types" + with Failure _ -> failwith ("hide_types: "^ + "Types are already hidden."));; + + +(* ------------------------------------------------------------------------- *) +(* count_goals : unit -> int *) +(* Shortcut to count the subgoals in the current goalstate. *) +(* ------------------------------------------------------------------------- *) + +let count_goals () = + if (!current_goalstack = []) then 0 else + ( let _,gls,_ = hd !current_goalstack in length gls );; + + + +(* ------------------------------------------------------------------------- *) +(* top_asms : goalstack -> (string * thm) list *) +(* Shortcut to get the assumption list of the top goal of a given goalstack. *) +(* ------------------------------------------------------------------------- *) + +let top_asms (gs:goalstack) = (fst o hd o snd3 o hd) gs;; + + +(* ------------------------------------------------------------------------- *) +(* top_metas : goalstack -> term list *) +(* Returns the list of metavariables in the current goalstate. *) +(* ------------------------------------------------------------------------- *) + +let top_metas (gs:goalstack) = (fst o fst3 o hd) gs;; + + +(* ------------------------------------------------------------------------- *) +(* top_inst : goalstack -> instantiation *) +(* Returns the metavariable instantiations in the current goalstate. *) +(* ------------------------------------------------------------------------- *) + +let top_inst (gs:goalstack) = (snd o fst3 o hd) gs;; + + +(* ------------------------------------------------------------------------- *) +(* print_goalstack_all : *) +(* Alternative goalstack printer that always prints all subgoals. *) +(* Also prints list of metavariables with their types. *) +(* ------------------------------------------------------------------------- *) +(* Original printer only prints more than one subgoals iff they were *) +(* generated by the last step. Otherwise it only prints the 'active' subgoal.*) +(* Replace by #install_printer print_goalstack_all;; *) +(* Revert to original by #install_printer print_goalstack;; *) +(* ------------------------------------------------------------------------- *) + +let (print_goalstack_all:goalstack->unit) = + let print_goalstate k gs = + let ((mvs,_),gl,_) = gs in + let n = length gl in + let s = if n = 0 then "No subgoals" else + (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") + ^" ("^(string_of_int n)^" total)" in + let print_mv v = print_string " `" ; + print_varandtype std_formatter v ; + print_string "`;" in + print_string s; print_newline(); + if (length mvs > 0) then ( + print_string "Metas:" ; let _ = map print_mv mvs in () ; print_newline() + ) ; + if gl = [] then () else + do_list (print_goal o C el gl) (rev(0--(k-1))) in + fun l -> + if l = [] then print_string "Empty goalstack" + else + let (_,gl,_ as gs) = hd l in + print_goalstate (length gl) gs;; + + +(* ------------------------------------------------------------------------- *) +(* print_goalstack : *) +(* Upgrade to print_goalstack that also prints a list of metavariables with *) +(* their types. *) +(* ------------------------------------------------------------------------- *) + +let (print_goalstack:goalstack->unit) = + let print_goalstate k gs = + let ((mvs,_),gl,_) = gs in + let n = length gl in + let s = if n = 0 then "No subgoals" else + (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") + ^" ("^(string_of_int n)^" total)" in + let print_mv v = print_string " `" ; + print_varandtype std_formatter v ; + print_string "`;" in + print_string s; print_newline(); + if (length mvs > 0) then ( + print_string "Metas:" ; let _ = map print_mv mvs in () ; print_newline() + ) ; + if gl = [] then () else + do_list (print_goal o C el gl) (rev(0--(k-1))) in + fun l -> + if l = [] then print_string "Empty goalstack" + else if tl l = [] then + let (_,gl,_ as gs) = hd l in + print_goalstate 1 gs + else + let (_,gl,_ as gs) = hd l + and (_,gl0,_) = hd(tl l) in + let p = length gl - length gl0 in + let p' = if p < 1 then 1 else p + 1 in + print_goalstate p' gs;; + +#install_printer print_goalstack;; + + + diff --git a/Jordan/float.ml b/Jordan/float.ml new file mode 100644 index 0000000..cceacec --- /dev/null +++ b/Jordan/float.ml @@ -0,0 +1,1825 @@ +(* ------------------------------------------------------------------ *) +(* Author and Copyright: Thomas C. Hales *) +(* License: GPL http://www.gnu.org/copyleft/gpl.html *) +(* Project: FLYSPECK http://www.math.pitt.edu/~thales/flyspeck/ *) +(* ------------------------------------------------------------------ *) + + + +prioritize_real();; + +let add_test,test = new_test_suite();; + +let twopow = + new_definition( + `twopow x = if (?n. (x = (int_of_num n))) + then ((&2) pow (nabs x)) + else inv((&2) pow (nabs x))`);; + +let float = + new_definition( + `float x n = (real_of_int x)*(twopow n)`);; + +let interval = + new_definition( + `interval x f eps = ((abs (x-f)) <= eps)`);; + +(*--------------------------------------------------------------------*) + +let mk_interval a b ex = + mk_comb(mk_comb (mk_comb (`interval`,a),b),ex);; + +add_test("mk_interval", + mk_interval `#3` `#4` `#1` = `interval #3 #4 #1`);; + +let dest_interval intv = + let (h1,ex) = dest_comb intv in + let (h2,f) = dest_comb h1 in + let (h3,a) = dest_comb h2 in + let _ = assert(h3 = `interval`) in + (a,f,ex);; + +add_test("dest_interval", + let a = `#3` and b = `#4` and c = `#1` in + dest_interval (mk_interval a b c) = (a,b,c));; + +(*--------------------------------------------------------------------*) + +let (dest_int:term-> Num.num) = + fun b -> + let dest_pos_int a = + let (op,nat) = dest_comb a in + if (fst (dest_const op) = "int_of_num") then (dest_numeral nat) + else fail() in + let (op',u) = (dest_comb b) in + try (if (fst (dest_const op') = "int_neg") then + minus_num (dest_pos_int u) else + dest_pos_int b) with + Failure _ -> failwith "dest_int ";; + + +let (mk_int:Num.num -> term) = + fun a -> + let sgn = Num.sign_num a in + let abv = Num.abs_num a in + let r = mk_comb(`&:`,mk_numeral abv) in + try (if (sgn<0) then mk_comb (`--:`,r) else r) with + Failure _ -> failwith ("dest_int "^(string_of_num a));; + +add_test("mk_int", + (mk_int (Int (-1443)) = `--: (&:1443)`) && + (mk_int (Int 37) = `(&:37)`));; + +(* ------------------------------------------------------------------ *) + +let (split_ratio:Num.num -> Num.num*Num.num) = + function + (Ratio r) -> (Big_int (Ratio.numerator_ratio r)), + (Big_int (Ratio.denominator_ratio r))| + u -> (u,(Int 1));; + +add_test("split_ratio", + let (a,b) = split_ratio ((Int 4)//(Int 20)) in + (a =/ (Int 1)) && (b =/ (Int 5)));; + +(* ------------------------------------------------------------------ *) + +(* break nonzero int r into a*(C**b) with a prime to C . *) +let (factor_C:int -> Num.num -> Num.num*Num.num) = + function c -> + let intC = (Int c) in + let rec divC (a,b) = + if ((Int 0) =/ mod_num a intC) then (divC (a//intC,b+/(Int 1))) + else (a,b) in + function r-> + if ((Num.is_integer_num r)&& not((Num.sign_num r) = 0)) then + divC (r,(Int 0)) else failwith "factor_C";; + +add_test("factor_C", + (factor_C 2 (Int (4096+32)) = (Int 129,Int 5)) && + (factor_C 10 (Int (5000)) = (Int 5,Int 3)) && + (cannot (factor_C 2) ((Int 50)//(Int 3))));; + +(*--------------------------------------------------------------------*) + +let (dest_float:term -> Num.num) = + fun f -> + let (a,b) = dest_binop `float` f in + (dest_int a)*/ ((Int 2) **/ (dest_int b));; + +add_test("dest_float", + dest_float `float (&:3) (&:17)` = (Int 393216));; + +add_test("dest_float2", (* must express as numeral first *) + cannot dest_float `float ((&:3)+:(&:1)) (&:17)`);; + +(* ------------------------------------------------------------------ *) +(* creates float of the form `float a b` with a odd *) +let (mk_float:Num.num -> term) = + function r -> + let (a,b) = split_ratio r in + let (a',exp_a) = if (a=/(Int 0)) then ((Int 0),(Int 0)) else factor_C 2 a in + let (b',exp_b) = factor_C 2 b in + let c = a'//b' in + if (Num.is_integer_num c) then + mk_binop `float` (mk_int c) (mk_int (exp_a -/ exp_b)) + else failwith "mk_float";; + +add_test("mk_float", + mk_float (Int (4096+32)) = `float (&:129) (&:5)` && + (mk_float (Int 0) = `float (&:0) (&:0)`));; + +add_test("mk_float2", (* throws exception exactly when denom != 2^k *) + let rtest = fun t -> (t =/ dest_float (mk_float t)) in + rtest ((Int 3)//(Int 1024)) && + (cannot rtest ((Int 1)//(Int 3))));; + +add_test("mk_float dest_float", (* constructs canonical form of float *) + mk_float (dest_float `float (&:4) (&:3)`) = `float (&:1) (&:5)`);; + +(* ------------------------------------------------------------------ *) +(* creates decimal of the form `DECIMAL a b` with a prime to 10 *) +let (mk_pos_decimal:Num.num -> term) = + function r -> + let _ = assert (r >=/ (Int 0)) in + let (a,b) = split_ratio r in + if (a=/(Int 0)) then `#0` else + let (a1,exp_a5) = factor_C 5 a in + let (a2,exp_a2) = factor_C 2 a1 in + let (b1,exp_b5) = factor_C 5 b in + let (b2,exp_b2) = factor_C 2 b1 in + let _ = assert(b2 =/ (Int 1)) in + let c = end_itlist Num.max_num [exp_b5-/exp_a5;exp_b2-/exp_a2;(Int 0)] in + let a' = a2*/((Int 2)**/ (c +/ exp_a2 -/ exp_b2))*/ + ((Int 5)**/(c +/ exp_a5 -/ exp_b5)) in + let b' = (Int 10) **/ c in + mk_binop `DECIMAL` (mk_numeral a') (mk_numeral b');; + +add_test("mk_pos_decimal", + mk_pos_decimal (Int (5000)) = `#5000` && + (mk_pos_decimal ((Int 30)//(Int 40)) = `#0.75`) && + (mk_pos_decimal (Int 0) = `#0`) && + (mk_pos_decimal ((Int 15)//(Int 25)) = `#0.6`) && + (mk_pos_decimal ((Int 25)//(Int 4)) = `#6.25`) && + (mk_pos_decimal ((Int 2)//(Int 25)) = `#0.08`));; + +let (mk_decimal:Num.num->term) = + function r -> + let a = Num.sign_num r in + let b = mk_pos_decimal (Num.abs_num r) in + if (a < 0) then (mk_comb (`--.`, b)) else b;; + +add_test("mk_decimal", + (mk_decimal (Int 3) = `#3`) && + (mk_decimal (Int (-3)) = `--. (#3)`));; + + + +(*--------------------------------------------------------------------*) + +let (dest_decimal:term -> Num.num) = + fun f -> + let (a,b) = dest_binop `DECIMAL` f in + let a1 = dest_numeral a in + let b1 = dest_numeral b in + a1//b1;; + +add_test("dest_decimal", + dest_decimal `#3.4` =/ ((Int 34)//(Int 10)));; +add_test("dest_decimal2", + cannot dest_decimal `--. (#3.4)`);; + + + + + +(*--------------------------------------------------------------------*) +(* Properties of integer powers of 2. *) +(* ------------------------------------------------------------------ *) + + +let TWOPOW_POS = prove(`!n. (twopow (int_of_num n) = (&2) pow n)`, + (REWRITE_TAC[twopow]) + THEN GEN_TAC + THEN COND_CASES_TAC + THENL [AP_TERM_TAC;ALL_TAC] + THEN (REWRITE_TAC[NABS_POS]) + THEN (UNDISCH_EL_TAC 0) + THEN (TAUT_TAC (` ( A ) ==> (~ A ==> B)`)) + THEN (MESON_TAC[]));; + +let TWOPOW_NEG = prove(`!n. (twopow (--(int_of_num n)) = inv((&2) pow n))`, + GEN_TAC + THEN (REWRITE_TAC[twopow]) + THEN (COND_CASES_TAC THENL [ALL_TAC;REWRITE_TAC[NABS_NEG]]) + THEN (POP_ASSUM CHOOSE_TAC) + THEN (REWRITE_TAC[NABS_NEG]) + THEN (UNDISCH_EL_TAC 0) + THEN (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL]) + THEN (REWRITE_TAC[prove (`! u y.((--(real_of_num u) = (real_of_num y))= + ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)]) + THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ;ADD_EQ_0]) + THEN (DISCH_TAC) + THEN (ASM_REWRITE_TAC[real_pow;REAL_INV_1]));; + + +let TWOPOW_INV = prove(`!a. (twopow (--: a) = (inv (twopow a)))`, + (GEN_TAC) + THEN ((ASSUME_TAC (SPEC `a:int` INT_REP2))) + THEN ((POP_ASSUM CHOOSE_TAC)) + THEN ((POP_ASSUM DISJ_CASES_TAC)) + THEN ((ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG;REAL_INV_INV;INT_NEG_NEG])));; + +let INT_REP3 = prove(`!a .(?n.( (a = &: n) \/ (a = --: (&: (n+1)))))`, +(GEN_TAC) +THEN ((ASSUME_TAC (SPEC `a:int` INT_REP2))) +THEN ((POP_ASSUM CHOOSE_TAC)) +THEN ((DISJ_CASES_TAC (prove (`((a:int) = (&: 0)) \/ ~((a:int) =(&: 0))`, MESON_TAC[])))) +(* cases *) +THENL[ ((EXISTS_TAC `0`)) THEN ((ASM_REWRITE_TAC[]));ALL_TAC] +THEN ((UNDISCH_EL_TAC 0)) +THEN ((POP_ASSUM DISJ_CASES_TAC)) +THENL [DISCH_TAC THEN ((ASM MESON_TAC)[]);ALL_TAC] +THEN (DISCH_TAC) +THEN ((EXISTS_TAC `PRE n`)) +THEN ((DISJ2_TAC)) +THEN ((ASM_REWRITE_TAC[INT_EQ_NEG2])) +(*** Changed by JRH, 2006/03/28 to avoid PRE_ELIM_TAC ***) +THEN (FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) +THEN (ASM_REWRITE_TAC[INT_NEG_EQ_0; INT_OF_NUM_EQ]) +THEN (ARITH_TAC));; + +let REAL_EQ_INV = prove(`!x y. ((x:real = y) <=> (inv(x) = inv (y)))`, +((REPEAT GEN_TAC)) +THEN (EQ_TAC) +THENL [((DISCH_TAC THEN (ASM_REWRITE_TAC[]))); + (* branch 2*) ((DISCH_TAC)) +THEN ((ONCE_REWRITE_TAC [(GSYM REAL_INV_INV)])) +THEN ((ASM_REWRITE_TAC[]))]);; + +let TWOPOW_ADD_1 = + prove(`!a. (twopow (a +: (&:1)) = twopow (a) *. (twopow (&:1)))`, +EVERY[ + GEN_TAC; + CHOOSE_TAC (SPEC `a:int` INT_REP3); + POP_ASSUM DISJ_CASES_TAC + THENL[ + ASM_REWRITE_TAC[TWOPOW_POS;INT_OF_NUM_ADD;REAL_POW_ADD]; + EVERY[ + ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD;INT_NEG_ADD;GSYM INT_ADD_ASSOC;INT_ADD_LINV;INT_ADD_RID]; + REWRITE_TAC[GSYM INT_NEG_ADD;INT_OF_NUM_ADD;TWOPOW_NEG;TWOPOW_POS]; + ONCE_REWRITE_TAC[SPEC `(&. 2) pow 1` (GSYM REAL_INV_INV)]; + REWRITE_TAC[GSYM REAL_INV_MUL;GSYM REAL_EQ_INV;REAL_POW_ADD;GSYM REAL_MUL_ASSOC;REAL_POW_1]; + REWRITE_TAC[MATCH_MP REAL_MUL_RINV (REAL_ARITH `~((&. 2) = (&. 0))`); REAL_MUL_RID] + ] + ] +]);; + +let REAL_INV2 = prove( + `(inv(&. 2)*(&. 2) = (&.1)) /\ ((&. 2)*inv(&. 2) = (&.1))`, + SUBGOAL_TAC `~((&.2) = (&.0))` +THENL[ + REAL_ARITH_TAC; + SIMP_TAC[REAL_MUL_RINV;REAL_MUL_LINV]]);; + +let TWOPOW_0 = prove(`twopow (&: 0) = (&. 1)`, + (REWRITE_TAC[TWOPOW_POS;real_pow]));; + +let TWOPOW_SUB_NUM = prove(`!m n.( twopow((&:m) - (&: n)) = twopow((&:m))*. twopow(--: (&:n)))`, +((INDUCT_TAC)) +THENL [REWRITE_TAC[INT_SUB_LZERO;REAL_MUL_LID;TWOPOW_0];ALL_TAC] +THEN ((INDUCT_TAC THEN + ( (ASM_REWRITE_TAC[INT_SUB_RZERO;TWOPOW_0;REAL_MUL_RID;INT_NEG_0;ADD1;GSYM INT_OF_NUM_ADD])))) +THEN ((ASM_REWRITE_TAC [TWOPOW_ADD_1;TWOPOW_INV;prove (`((&:m)+(&:1)) -: ((&:n) +: (&:1)) = ((&:m)-: (&:n))`,INT_ARITH_TAC)])) +THEN ((REWRITE_TAC[REAL_INV_MUL])) +THEN ((ABBREV_TAC `a:real = twopow (&: m)`)) +THEN ((ABBREV_TAC `b:real = inv(twopow (&: n))`)) +THEN ((REWRITE_TAC[TWOPOW_POS;REAL_POW_1;GSYM REAL_MUL_ASSOC;prove (`!(x:real). ((&.2)*x = x*(&.2))`,REAL_ARITH_TAC)])) +THEN ((REWRITE_TAC[REAL_INV2;REAL_MUL_RID])));; + +let TWOPOW_ADD_NUM = prove( + `!m n. (twopow ((&:m) + (&:n)) = twopow((&:m))*. twopow((&:n)))`, +(REWRITE_TAC[TWOPOW_POS;REAL_POW_ADD;INT_OF_NUM_ADD]));; + +let TWOPOW_ADD_INT = prove( + `!a b. (twopow (a +: b) = twopow(a) *. (twopow(b)))`, + ((REPEAT GEN_TAC)) +THEN ((ASSUME_TAC (SPEC `a:int` INT_REP))) +THEN ((POP_ASSUM CHOOSE_TAC)) +THEN ((POP_ASSUM CHOOSE_TAC)) +THEN ((ASSUME_TAC (SPEC `b:int` INT_REP))) +THEN ((REPEAT (POP_ASSUM CHOOSE_TAC))) +THEN ((ASM_REWRITE_TAC[])) +THEN ((SUBGOAL_TAC `&: n -: &: m +: &: n' -: &: m' = (&: (n+n')) -: (&: (m+m'))`)) +(* branch *) +THENL[ ((REWRITE_TAC[GSYM INT_OF_NUM_ADD])) +THEN ((INT_ARITH_TAC));ALL_TAC] +(* 2nd *) +THEN ((DISCH_TAC)) +THEN ((ASM_REWRITE_TAC[TWOPOW_SUB_NUM;TWOPOW_INV;TWOPOW_POS;REAL_POW_ADD;REAL_INV_MUL;GSYM REAL_MUL_ASSOC])) +THEN ((ABBREV_TAC `a':real = inv ((&. 2) pow m)`)) +THEN ((ABBREV_TAC `c :real = (&. 2) pow n`)) +THEN ((ABBREV_TAC `d :real = (&. 2) pow n'`)) +THEN ((ABBREV_TAC `e :real = inv ((&. 2) pow m')`)) +THEN (MESON_TAC[REAL_MUL_AC]));; + +let TWOPOW_ABS = prove(`!a. ||. (twopow a) = (twopow a)`, +(GEN_TAC) +THEN ((CHOOSE_THEN DISJ_CASES_TAC (SPEC `a:int` INT_REP2))) +(* branch *) +THEN ((ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG;REAL_ABS_POW;REAL_ABS_NUM;REAL_ABS_INV])));; + +let REAL_POW_POW = prove( + `!x m n . (x **. m) **. n = x **. (m *| n)`, +((GEN_TAC THEN GEN_TAC THEN INDUCT_TAC)) +(* branch *) +THENL[ ((REWRITE_TAC[real_pow;MULT_0])); +(* second branch *) +((REWRITE_TAC[real_pow])) +THEN ((ASM_REWRITE_TAC[ADD1;LEFT_ADD_DISTRIB;REAL_POW_ADD;REAL_MUL_AC;MULT_CLAUSES]))]);; + +let INT_POW_POW = INT_OF_REAL_THM REAL_POW_POW;; + +let TWOPOW_POW = prove( + `!a n. (twopow a) pow n = twopow (a *: (&: n))`, +((REPEAT GEN_TAC)) +THEN ((CHOOSE_THEN DISJ_CASES_TAC (SPEC `a:int` INT_REP2))) +(* branch *) +THEN ((ASM_REWRITE_TAC[TWOPOW_POS;INT_OF_NUM_MUL; + REAL_POW_POW;TWOPOW_NEG;REAL_POW_INV;INT_OF_NUM_MUL;GSYM INT_NEG_LMUL])));; + +(* ------------------------------------------------------------------ *) +(* Arithmetic operations on float *) +(* ------------------------------------------------------------------ *) +let FLOAT_NEG = prove(`!a m. --. (float a m) = float (--: a) m`, + REPEAT GEN_TAC THEN + REWRITE_TAC[float;GSYM REAL_MUL_LNEG;int_neg_th]);; + + + +let FLOAT_MUL = prove(`!a b m n. (float a m) *. (float b n) = (float (a *: b) (m +: n))`, +((REPEAT GEN_TAC)) +THEN ((REWRITE_TAC[float;GSYM REAL_MUL_ASSOC;TWOPOW_ADD_INT;int_mul_th])) +THEN ((MESON_TAC[REAL_MUL_AC])));; + +let FLOAT_ADD = prove( + `!a b c m. (float a (m+: (&:c))) +. (float b m) + = (float ( (&:(2 EXP c))*a +: b) m)`, +((REWRITE_TAC[float;int_add_th;REAL_ADD_RDISTRIB;int_mul_th;TWOPOW_ADD_INT])) +THEN ((REPEAT GEN_TAC)) +THEN ((REWRITE_TAC[TWOPOW_POS;INT_NUM_REAL;GSYM REAL_OF_NUM_POW])) +THEN ((MESON_TAC[REAL_MUL_AC])));; + +let FLOAT_ADD_EQ = prove( + `!a b m. (float a m) +. (float b m) = + (float (a+:b) m)`, + ((REPEAT GEN_TAC)) +THEN ((REWRITE_TAC[REWRITE_RULE[INT_ADD_RID] (SPEC `m:int` (SPEC `0` (SPEC `b:int` (SPEC `a:int` FLOAT_ADD))))])) +THEN ((REWRITE_TAC[EXP;INT_MUL_LID])));; + +let FLOAT_ADD_NP = prove( + `!a b m n. (float b (--:(&: n))) +. (float a (&: m)) = (float a (&: m)) +. (float b (--:(&: n)))`, +(REWRITE_TAC[REAL_ADD_AC]));; + +let FLOAT_ADD_PN = prove( + `!a b m n. (float a (&: m)) +. (float b (--(&: n))) = (float ( (&:(2 EXP (m+| n)))*a + b) (--:(&: n)))`, +((REPEAT GEN_TAC)) +THEN ((SUBGOAL_TAC `&: m = (--:(&: n)) + (&:(m+n))`)) +THENL[ ((REWRITE_TAC[GSYM INT_OF_NUM_ADD])) +THEN ((INT_ARITH_TAC)); +(* branch *) +((DISCH_TAC)) +THEN ((ASM_REWRITE_TAC[FLOAT_ADD]))]);; + +let FLOAT_ADD_PP = prove( + `!a b m n. ((n <=| m) ==>( (float a (&: m)) +. (float b (&: n)) = (float ((&:(2 EXP (m -| n))) *a + b) (&: n))))`, +((REPEAT GEN_TAC)) +THEN (DISCH_TAC) +THEN ((SUBGOAL_TAC `&: m = (&: n) + (&: (m-n))`)) +THENL[ ((REWRITE_TAC[INT_OF_NUM_ADD])) +THEN (AP_TERM_TAC) +THEN ((REWRITE_TAC[prove (`!(m:num) n. (n+m-n) = (m-n)+n`,REWRITE_TAC[ADD_AC])])) +THEN ((UNDISCH_EL_TAC 0)) +THEN ((MATCH_ACCEPT_TAC(GSYM SUB_ADD))); +(* branch *) +((DISCH_TAC)) +THEN ((ASM_REWRITE_TAC[FLOAT_ADD]))]);; + +let FLOAT_ADD_PPv2 = prove( + `!a b m n. ((m <| n) ==>( (float a (&: m)) +. (float b (&: n)) = (float ((&:(2 EXP (n -| m))) *b + a) (&: m))))`, +((REPEAT GEN_TAC)) +THEN (DISCH_TAC) +THEN ((H_MATCH_MP (THM (prove(`!m n. m<|n ==> m <=|n`,MESON_TAC[LT_LE]))) (HYP_INT 0))) +THEN ((UNDISCH_EL_TAC 0)) +THEN ((SIMP_TAC[GSYM FLOAT_ADD_PP])) +THEN (DISCH_TAC) +THEN ((REWRITE_TAC[REAL_ADD_AC])));; + +let FLOAT_ADD_NN = prove( +`!a b m n. ((n <=| m) ==>( (float a (--:(&: m))) +. (float b (--:(&: n))) + = (float ((&:(2 EXP (m -| n))) *b + a) (--:(&: m)))))`, +((REPEAT GEN_TAC)) +THEN (DISCH_TAC) +THEN ((SUBGOAL_TAC `--: (&: n) = --: (&: m) + (&: (m-n))`)) +THENL [((UNDISCH_EL_TAC 0)) +THEN ((SIMP_TAC [INT_OF_REAL_THM (GSYM REAL_OF_NUM_SUB)])) +THEN (DISCH_TAC) +THEN ((INT_ARITH_TAC)); +(*branch*) +((DISCH_TAC)) +THEN (ASM_REWRITE_TAC[GSYM FLOAT_ADD;REAL_ADD_AC])]);; + +let FLOAT_ADD_NNv2 = prove( +`!a b m n. ((m <| n) ==>( (float a (--:(&: m))) +. (float b (--:(&: n))) + = (float ((&:(2 EXP (n -| m))) *a + b) (--:(&: n)))))`, +((REPEAT GEN_TAC)) +THEN (DISCH_TAC) +THEN (((H_MATCH_MP (THM (prove(`!m n. m<|n ==> m <=|n`,MESON_TAC[LT_LE]))) (HYP_INT 0)))) +THEN (((UNDISCH_EL_TAC 0))) +THEN (((SIMP_TAC[GSYM FLOAT_ADD_NN]))) +THEN ((DISCH_TAC)) +THEN (((REWRITE_TAC[REAL_ADD_AC]))));; + +let FLOAT_SUB = prove( + `!a b n m. (float a n) -. (float b m) + = (float a n) +. (float (--: b) m)`, +REWRITE_TAC[float;int_neg_th;real_sub;REAL_NEG_LMUL]);; + +let FLOAT_ABS = prove( + `!a n. ||. (float a n) = (float (||: a) n)`, +(REWRITE_TAC[float;int_abs_th;REAL_ABS_MUL;TWOPOW_ABS]));; + + +let FLOAT_POW = prove( + `!a n m. (float a n) **. m = (float (a **: m) (n *: (&:m)))`, +(REWRITE_TAC[float;REAL_POW_MUL;int_pow_th;TWOPOW_POW]));; + +let INT_SUB = prove( + `!a b. (a -: b) = (a +: (--: b))`, + (REWRITE_TAC[GSYM INT_SUB_RNEG;INT_NEG_NEG]));; + +let INT_ABS_NUM = prove( + `!n. ||: (&: n) = (&: n)`, + (REWRITE_TAC[int_eq;int_abs_th;INT_NUM_REAL;REAL_ABS_NUM]));; + +let INT_ABS_NEG_NUM = prove( + `!n. ||: (--: (&: n)) = (&: n)`, + (REWRITE_TAC[int_eq;int_abs_th;int_neg_th;INT_NUM_REAL;REAL_ABS_NUM;REAL_ABS_NEG]));; + +let INT_ADD_NEG_NUM = prove(`!x y. --: (&: x) +: (&: y) = (&: y) +: (--: (&: x))`, + (REWRITE_TAC[INT_ADD_AC]));; + +let INT_POW_MUL = INT_OF_REAL_THM REAL_POW_MUL;; + +let INT_POW_NEG1 = prove ( + `!x n. (--: (&: x)) **: n = ((--: (&: 1)) **: n) *: ((&: x) **: n)`, +(REWRITE_TAC[GSYM INT_POW_MUL; GSYM INT_NEG_MINUS1]));; + + + +let INT_POW_EVEN_NEG1 = prove( + `!x n. (--: (&: x)) **: (NUMERAL (BIT0 n)) = ((&: x) **: (NUMERAL (BIT0 n)))`, +((REPEAT GEN_TAC)) +THEN ((ONCE_REWRITE_TAC[INT_POW_NEG1])) +THEN ((ABBREV_TAC `a = &: 1`)) +THEN ((ABBREV_TAC `b = (&: x)**: (NUMERAL (BIT0 n))`)) +THEN ((REWRITE_TAC[NUMERAL;BIT0])) +THEN ((REWRITE_TAC[GSYM MULT_2;GSYM INT_POW_POW;INT_OF_REAL_THM REAL_POW_2;INT_NEG_MUL2])) +THEN ((EXPAND_TAC "a")) +THEN ((REWRITE_TAC[INT_MUL_RID;INT_MUL_LID;INT_OF_REAL_THM REAL_POW_ONE])));; + +let INT_POW_ODD_NEG1 = prove( + `!x n. (--: (&: x)) **: (NUMERAL (BIT1 n)) = --: ((&: x) **: (NUMERAL (BIT1 n)))`, +((REPEAT GEN_TAC)) +THEN ((ONCE_REWRITE_TAC[INT_POW_NEG1])) +THEN (((ABBREV_TAC `a = &: 1`))) +THEN (((ABBREV_TAC `b = (&: x)**: (NUMERAL (BIT1 n))`))) +THEN ((REWRITE_TAC[NUMERAL;BIT1])) +THEN ((ONCE_REWRITE_TAC[ADD1])) +THEN ((EXPAND_TAC "a")) +THEN ((REWRITE_TAC[GSYM MULT_2])) +THEN ((REWRITE_TAC[INT_OF_REAL_THM POW_MINUS1;INT_OF_REAL_THM REAL_POW_ADD])) +THEN ((REWRITE_TAC[INT_OF_REAL_THM POW_1;INT_MUL_LID;INT_MUL_LNEG])));; + +(* subtraction of integers *) + +let INT_ADD_NEG = prove( + `!x y. (x < y ==> ((&: x) +: (--: (&: y)) = --: (&: (y - x))))`, +((REPEAT GEN_TAC)) +THEN ((DISCH_TAC)) +THEN ((SUBGOAL_TAC `&: (y-x ) = (&: y) - (&: x)`)) +THENL [((SUBGOAL_TAC `x <=| y`)) + (* branch *) + THENL [(((ASM MESON_TAC)[LE_LT]));((SIMP_TAC[GSYM (INT_OF_REAL_THM REAL_OF_NUM_SUB)]))] +(* branch *) +; ((DISCH_TAC)) +THEN ((ASM_REWRITE_TAC[])) +THEN (ACCEPT_TAC(INT_ARITH `&: x +: --: (&: y) = --: (&: y -: &: x)`))]);; + +let INT_ADD_NEGv2 = prove( + `!x y. (y <= x ==> ((&: x) +: (--: (&: y)) = (&: (x - y))))`, + ((REPEAT GEN_TAC)) + THEN ((DISCH_TAC)) + THEN ((SUBGOAL_TAC `&: (x - y) = (&: x) - (&: y)`)) + THENL[ + ((UNDISCH_EL_TAC 0)) THEN ((SIMP_TAC[GSYM (INT_OF_REAL_THM REAL_OF_NUM_SUB)])); + ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[INT_SUB])) + ] +);; + +(* assumes a term of the form &:a +: (--: (&: b)) *) +let INT_SUB_CONV t = + let a,b = dest_binop `(+:)` t in + let (_,a) = dest_comb a in + let (_,b) = dest_comb b in + let (_,b) = dest_comb b in + let a = dest_numeral a in + let b = dest_numeral b in + let thm = if (b <=/ a) then + INT_ADD_NEGv2 + else INT_ADD_NEG in + (ARITH_SIMP_CONV[thm]) t;; (* (SIMP_CONV[thm;ARITH]) t;; *) + + +(* ------------------------------------------------------------------ *) +(* Simplifies an arithmetic expression in floats *) +(* A workhorse *) +(* ------------------------------------------------------------------ *) + +let FLOAT_CONV = + (ARITH_SIMP_CONV[FLOAT_MUL;FLOAT_SUB;FLOAT_ABS;FLOAT_POW; + FLOAT_ADD_NN;FLOAT_ADD_NNv2;FLOAT_ADD_PP;FLOAT_ADD_PPv2; + FLOAT_ADD_NP;FLOAT_ADD_PN;FLOAT_NEG; + INT_NEG_NEG;INT_SUB; + INT_ABS_NUM;INT_ABS_NEG_NUM; + INT_MUL_LNEG;INT_MUL_RNEG;INT_NEG_MUL2;INT_OF_NUM_MUL; + INT_OF_NUM_ADD;GSYM INT_NEG_ADD;INT_ADD_NEG_NUM; + INT_OF_NUM_POW;INT_POW_ODD_NEG1;INT_POW_EVEN_NEG1; + INT_ADD_NEG;INT_ADD_NEGv2 (* ; ARITH *) + ]) ;; + +add_test("FLOAT_CONV1", + let f z = + let (x,y) = dest_eq z in + let (u,v) = dest_thm (FLOAT_CONV x) in + (u=[]) && (z = v) in + f `float (&:3) (&:0) = float (&:3) (&:0)` && + f `float (&:3) (&:3) = float (&:3) (&:3)` && + f `float (&:3) (&:0) +. (float (&:4) (&:0)) = (float (&:7) (&:0))` && + f `float (&:1 + (&:3)) (&:4) = float (&:4) (&:4)` && + f `float (&:3 - (&:7)) (&:0) = float (--:(&:4)) (&:0)` && + f `float (&:3) (&:4) *. (float (--: (&:2)) (&:3)) = float (--: (&:6)) + (&:7)` && + f `--. (float (--: (&:3)) (&:0)) = float (&:3) (&:0)` + );; + +(* ------------------------------------------------------------------ *) +(* Operations on interval. Preliminary stuff to deal with *) +(* chains of inequalities. *) +(* ------------------------------------------------------------------ *) + + +let REAL_ADD_LE_SUBST_RHS = prove( + `!a b c P. ((a <=. ((P b)) /\ (!x. (P x) = x + (P (&. 0))) /\ (b <=. c)) ==> (a <=. (P c)))`, +(((REPEAT GEN_TAC))) +THEN (((REPEAT (TAUT_TAC `(b ==> a==> c) ==> (a /\ b ==> c)`)))) +THEN (((REPEAT DISCH_TAC))) +THEN ((((H_RULER(ONCE_REWRITE_RULE))[HYP_INT 1] (HYP_INT 0)))) +THEN ((((ASM ONCE_REWRITE_TAC)[]))) +THEN ((((ASM MESON_TAC)[REAL_LE_RADD;REAL_LE_TRANS]))));; + +let REAL_ADD_LE_SUBST_LHS = prove( + `!a b c P. (((P(a) <=. b /\ (!x. (P x) = x + (P (&. 0))) /\ (c <=. a))) + ==> ((P c) <=. b))`, +(REP_GEN_TAC) +THEN (DISCH_ALL_TAC) +THEN (((H_RULER(ONCE_REWRITE_RULE)) [HYP_INT 1] (HYP_INT 0))) +THEN (((ASM ONCE_REWRITE_TAC)[])) +THEN (((ASM MESON_TAC)[REAL_LE_RADD;REAL_LE_TRANS])));; +(* +let rec SPECL = + function [] -> I | + (a::b) -> fun thm ->(SPECL b (SPEC a thm));; +*) +(* + input: + rel: b <=. c + thm: a <=. P(b). + + output: a <=. P(c). + + condition: REAL_ARITH must be able to prove !x. P(x) = x+. P(&.0). + condition: the term `a` must appear exactly once the lhs of the thm. + *) + +let IWRITE_REAL_LE_RHS rel thm = + let bvar = genvar `:real` in + let (bt,_) = dest_binop `(<=.)` (concl rel) in + let sub = SUBS_CONV[ASSUME (mk_eq(bt,bvar))] in + let rule = (fun th -> EQ_MP (sub (concl th)) th) in + let (subrel,subthm) = (rule rel,rule thm) in + let (a,p) = dest_binop `(<=.)` (concl subthm) in + let (_,c) = dest_binop `(<=.)` (concl subrel) in + let pfn = mk_abs (bvar,p) in + let imp_th = BETA_RULE (SPECL [a;bvar;c;pfn] REAL_ADD_LE_SUBST_RHS) in + let ppart = REAL_ARITH + (fst(dest_conj(snd(dest_conj(fst(dest_imp(concl imp_th))))))) in + let prethm = MATCH_MP imp_th (CONJ subthm (CONJ ppart subrel)) in + let prethm2 = SPEC bt (GEN bvar (DISCH + (find (fun x -> try(bvar = rhs x) with failure -> false) (hyp prethm)) prethm)) in + MATCH_MP prethm2 (REFL bt);; + +(* + input: + rel: c <=. a + thm: P a <=. b + + output: P c <=. b + + condition: REAL_ARITH must be able to prove !x. P(x) = x+. P(&.0). + condition: the term `a` must appear exactly once the lhs of the thm. + *) + +let IWRITE_REAL_LE_LHS rel thm = + let avar = genvar `:real` in + let (_,at) = dest_binop `(<=.)` (concl rel) in + let sub = SUBS_CONV[ASSUME (mk_eq(at,avar))] in + let rule = (fun th -> EQ_MP (sub (concl th)) th) in + let (subrel,subthm) = (rule rel,rule thm) in + let (p,b) = dest_binop `(<=.)` (concl subthm) in + let (c,_) = dest_binop `(<=.)` (concl subrel) in + let pfn = mk_abs (avar,p) in + let imp_th = BETA_RULE (SPECL [avar;b;c;pfn] REAL_ADD_LE_SUBST_LHS) in + let ppart = REAL_ARITH + (fst(dest_conj(snd(dest_conj(fst(dest_imp(concl imp_th))))))) in + let prethm = MATCH_MP imp_th (CONJ subthm (CONJ ppart subrel)) in + let prethm2 = SPEC at (GEN avar (DISCH + (find (fun x -> try(avar = rhs x) with failure -> false) (hyp prethm)) prethm)) in + MATCH_MP prethm2 (REFL at);; + +(* ------------------------------------------------------------------ *) +(* INTERVAL ADD, NEG, SUBTRACT *) +(* ------------------------------------------------------------------ *) + + +let INTERVAL_ADD = prove( + `!x f ex y g ey. interval x f ex /\ interval y g ey ==> + interval (x +. y) (f +. g) (ex +. ey)`, +EVERY[ + REPEAT GEN_TAC; + TAUT_TAC `(A==>B==>C)==>(A/\ B ==> C)`; + REWRITE_TAC[interval]; + REWRITE_TAC[prove(`(x+.y) -. (f+.g) = (x-.f) +. (y-.g)`,REAL_ARITH_TAC)]; + ABBREV_TAC `a = x-.f`; + ABBREV_TAC `b = y-.g`; + ASSUME_TAC (SPEC `b:real` (SPEC `a:real` ABS_TRIANGLE)); + UNDISCH_EL_TAC 0; + ABBREV_TAC `a':real = abs a`; + ABBREV_TAC `b':real = abs b`; + REPEAT DISCH_TAC; + (H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 2); + (H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 2) (HYP_INT 0); + ASM_REWRITE_TAC[]]);; + +let INTERVAL_NEG = prove( + `!x f ex. interval x f ex = interval (--. x) (--. f) ex`, +(REWRITE_TAC[interval;REAL_ABS_NEG;REAL_ARITH `!x y. -- x -. (-- y) = --. (x -. y)`]));; + +let INTERVAL_NEG2 = prove( + `!x f ex. interval (--. x) f ex = interval x (--. f) ex`, + (REWRITE_TAC[interval;REAL_ABS_NEG;REAL_ARITH `!x y. -- x -. y = --. (x -. (--. y))`]));; + + +let INTERVAL_SUB = prove( + `!x f ex y g ey. interval x f ex /\ interval y g ey ==> interval (x -. y) (f -. g) (ex +. ey)`, +((REWRITE_TAC[real_sub])) +THEN (DISCH_ALL_TAC) +THEN (((H_RULER (ONCE_REWRITE_RULE))[THM(INTERVAL_NEG)] (HYP_INT 1))) +THEN (((ASM MESON_TAC)[INTERVAL_ADD])));; + +(* ------------------------------------------------------------------ *) +(* INTERVAL MULTIPLICATION *) +(* ------------------------------------------------------------------ *) + + +let REAL_PROP_LE_LABS = prove( + `!x y z. (y <=. z) ==> ((abs x)* y <=. (abs x) *z)`,(SIMP_TAC[REAL_LE_LMUL_IMP;ABS_POS]));; + +(* renamed from REAL_LE_ABS_RMUL *) +let REAL_PROP_LE_RABS = prove( + `!x y z. (y <=. z) ==> ( y * (abs x) <=. z *(abs x))`,(SIMP_TAC[REAL_LE_RMUL_IMP;ABS_POS]));; + +let REAL_LE_ABS_MUL = prove( + `!x y z w. (( x <=. y) /\ (abs z <=. w)) ==> (x*.w <=. y*.w) `, +(DISCH_ALL_TAC) +THEN ((ASSUME_TAC (REAL_ARITH `abs z <=. w ==> (&.0) <=. w`))) +THEN (((ASM MESON_TAC)[REAL_LE_RMUL_IMP])));; + +let INTERVAL_MUL = prove( + `!x f ex y g ey. (interval x f ex) /\ (interval y g ey) ==> + (interval (x *. y) (f *. g) (abs(f)*.ey +. ex*. abs(g) +. ex*.ey))`, +(REP_GEN_TAC) +THEN ((REWRITE_TAC[interval])) +THEN ((REWRITE_TAC[REAL_ARITH `(x*. y -. f*. g) = (f *.(y -. g) +. (x -. f)*.g +. (x-.f)*.(y-. g))`])) +THEN (DISCH_ALL_TAC) +THEN ((ASSUME_TAC (SPECL [`f*.(y-g)`;`(x-f)*g +. (x-f)*.(y-g)`] ABS_TRIANGLE))) +THEN ((ASSUME_TAC (SPECL [`(x-f)*.g`;`(x-f)*.(y-g)`] ABS_TRIANGLE))) +THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) +THEN ((H_REWRITE_RULE [THM ABS_MUL] (HYP_INT 0))) +THEN ((H_MATCH_MP (THM (SPECL [`g:real`; `abs (x -. f)`; `ex:real`] REAL_PROP_LE_RABS)) (HYP_INT 4))) +THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) +THEN ((H_MATCH_MP (THM (SPECL [`f:real`; `abs (y -. g)`; `ey:real`] REAL_PROP_LE_LABS)) (HYP_INT 7))) +THEN (((H_VAL2 (IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) +THEN ((H_MATCH_MP (THM (SPECL [`x-.f`; `abs (y -. g)`; `ey:real`] REAL_PROP_LE_LABS)) (HYP_INT 9))) +THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1))) +THEN ((ASSUME_TAC (SPECL [`abs(x-.f)`;`ex:real`;`y-.g`;`ey:real`] REAL_LE_ABS_MUL))) +THEN ((H_CONJ (HYP_INT 11) (HYP_INT 12))) +THEN ((H_MATCH_MP (HYP_INT 1) (HYP_INT 0))) +THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 3))) +THEN ((POP_ASSUM ACCEPT_TAC)));; + +(* ------------------------------------------------------------------ *) +(* INTERVAL BASIC OPERATIONS *) +(* ------------------------------------------------------------------ *) + + +let INTERVAL_NUM = prove( + `!n. (interval(&.n) (float(&:n) (&:0)) (float (&: 0) (&:0)))`, +(REWRITE_TAC[interval;float;TWOPOW_POS;pow;REAL_MUL_RID;INT_NUM_REAL;REAL_SUB_REFL;REAL_ABS_0;REAL_LE_REFL]));; + +let INTERVAL_CENTER = prove( + `!x f ex g. (interval x f ex) ==> (interval x g (abs(f-g)+.ex))`, +((REWRITE_TAC[interval])) +THEN (DISCH_ALL_TAC) +THEN ((ASSUME_TAC (REAL_ARITH `abs(x -. g) <=. abs(f-.g) +. abs(x -. f)`))) +THEN ((H_VAL2 IWRITE_REAL_LE_RHS (HYP_INT 1) (HYP_INT 0))) +THEN ((ASM_REWRITE_TAC[])));; + +let INTERVAL_WIDTH = prove( + `!x f ex ex'. (ex <=. ex') ==> (interval x f ex) ==> (interval x f ex')`, +((REWRITE_TAC[interval])) +THEN (DISCH_ALL_TAC) +THEN ((H_VAL2 IWRITE_REAL_LE_RHS (HYP_INT 1) (HYP_INT 0))) +THEN ((ASM_REWRITE_TAC[])));; + +let INTERVAL_MAX = prove( + `!x f ex. interval x f ex ==> (x <=. f+.ex)`, +(REWRITE_TAC[interval]) THEN REAL_ARITH_TAC);; + +let INTERVAL_MIN = prove( + `!x f ex. interval x f ex ==> (f-. ex <=. x)`, +(REWRITE_TAC[interval]) THEN REAL_ARITH_TAC);; + +let INTERVAL_ABS_MIN = prove( + `!x f ex. interval x f ex ==> (abs(f)-. ex <=. abs(x))`, + (REWRITE_TAC[interval] THEN REAL_ARITH_TAC) +);; + +let INTERVAL_ABS_MAX = prove( + `!x f ex. interval x f ex ==> (abs(x) <=. abs(f)+. ex)`, + (REWRITE_TAC[interval] THEN REAL_ARITH_TAC) +);; + +let REAL_RINV_2 = prove( + `&.2 *. (inv (&.2 )) = &. 1`, +EVERY[ + MATCH_MP_TAC REAL_MUL_RINV; + REAL_ARITH_TAC]);; + +let INTERVAL_MK = prove( + `let half = float(&:1)(--:(&:1)) in + !x xmin xmax. ((xmin <=. x) /\ (x <=. xmax)) ==> + interval x + ((xmin+.xmax)*.half) + ((xmax-.xmin)*.half)`, +EVERY[ + REWRITE_TAC[LET_DEF;LET_END_DEF]; + DISCH_ALL_TAC; + REWRITE_TAC[interval;float;TWOPOW_NEG;INT_NUM_REAL;REAL_POW_1;REAL_MUL_LID]; + REWRITE_TAC[GSYM INTERVAL_ABS]; + CONJ_TAC + ] +THENL[ + EVERY[ + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; + REWRITE_TAC[REAL_ARITH `(b+.a)-.(a-.b)=b*.(&.2)`;GSYM REAL_MUL_ASSOC]; + ASM_REWRITE_TAC[REAL_RINV_2;REAL_MUL_RID] + ]; + EVERY[ + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB]; + REWRITE_TAC[REAL_ARITH `(b+.a)+. a -. b=a*.(&.2)`;GSYM REAL_MUL_ASSOC]; + ASM_REWRITE_TAC[REAL_RINV_2;REAL_MUL_RID] + ] +]);; + +let INTERVAL_EPS_POS = prove(`!x f ex. + (interval x f ex) ==> (&.0 <=. ex)`, +EVERY[ + REWRITE_TAC[interval]; + REPEAT (GEN_TAC); + DISCH_THEN(fun x -> (MP_TAC (CONJ (SPEC `x-.f` REAL_ABS_POS) x))); + MATCH_ACCEPT_TAC REAL_LE_TRANS]);; + +let INTERVAL_EPS_0 = prove( + `!x f n. (interval x f (float (&:0) n)) ==> (x = f)`, +EVERY[ + REWRITE_TAC[interval;float;int_of_num_th;REAL_MUL_LZERO]; + REAL_ARITH_TAC]);; + + + +let REAL_EQ_RCANCEL_IMP' = prove(`!x y z.(x * z = y * z) ==> (~(z = &0) ==> (x=y))`, + MESON_TAC[REAL_EQ_RCANCEL_IMP]);; + +(* renamed from REAL_ABS_POS *) +let REAL_MK_POS_ABS_' = prove (`!x. (~(x=(&.0))) ==> (&.0 < abs(x))`, + MESON_TAC[REAL_PROP_NZ_ABS;ABS_POS;REAL_LT_LE]);; + +(* ------------------------------------------------------------------ *) +(* INTERVAL DIVIDE *) +(* ------------------------------------------------------------------ *) + +let INTERVAL_DIV = prove(`!x f ex y g ey h ez. + (((interval x f ex) /\ (interval y g ey) /\ (ey <. (abs g)) /\ + ((ex +. (abs (f -. (h*.g))) +. (abs h)*. ey) <=. (ez*.((abs g) -. ey)))) + ==> (interval (x / y) h ez))`, + +let lemma1 = prove( `&.0 < u /\ ||. z <=. e*. u ==> (&.0) <=. e`, + EVERY[ + DISCH_ALL_TAC; + ASSUME_TAC (SPEC `z:real` REAL_MK_NN_ABS); + H_MATCH_MP (THM REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 2)); + H_MATCH_MP (THM REAL_PROP_NN_RCANCEL) (H_RULE2 CONJ (HYP_INT 2) (HYP_INT 0)); + ASM_REWRITE_TAC[] + ]) in +EVERY[ + DISCH_ALL_TAC; + SUBGOAL_TAC `~(y= (&.0))` + THENL[ + EVERY[ + UNDISCH_LIST[1;2]; + REWRITE_TAC[interval]; + REAL_ARITH_TAC + ]; + EVERY[ + REWRITE_TAC[interval]; + DISCH_TAC THEN (H I (HYP_INT 0)) THEN (UNDISCH_EL_TAC 0); + DISCH_THEN (fun th -> (MP_TAC(MATCH_MP REAL_MK_POS_ABS_' th))); + MATCH_MP_TAC REAL_MUL_RTIMES_LE; + REWRITE_TAC[GSYM ABS_MUL;REAL_SUB_RDISTRIB;real_div;GSYM REAL_MUL_ASSOC]; + ASM_SIMP_TAC[REAL_MUL_LINV;REAL_MUL_RID]; + H (REWRITE_RULE[interval]) (HYP_INT 1); + H (REWRITE_RULE[interval]) (HYP_INT 3); + H (MATCH_MP INTERVAL_ABS_MIN) (HYP_INT 4); + POPL_TAC[3;4;5]; + H_VAL2 (IWRITE_REAL_LE_LHS) (HYP_INT 2) (HYP_INT 4); + H (REWRITE_RULE[ REAL_ADD_ASSOC]) (HYP_INT 0); + H_VAL2 (IWRITE_REAL_LE_LHS) (THM (SPEC `f-. h*g` (SPEC `x-.f` ABS_TRIANGLE))) (HYP_INT 0); + H (ONCE_REWRITE_RULE[REAL_ABS_SUB]) (HYP_INT 4); + H (MATCH_MP (SPEC `h:real` REAL_PROP_LE_LABS)) (HYP_INT 0); + H (REWRITE_RULE[GSYM ABS_MUL]) (HYP_INT 0); + H_VAL2 (IWRITE_REAL_LE_LHS) (HYP_INT 0) (HYP_INT 3); + H_VAL2 (IWRITE_REAL_LE_LHS) (THM (SPEC `h*.(g-.y)` (SPEC`(x-.f)+(f-. h*g)` ABS_TRIANGLE))) (HYP_INT 0); + POPL_TAC[1;2;3;4;5;6;7;9;10;12]; + H (ONCE_REWRITE_RULE[REAL_ARITH `((x-.f) +. (f -. h*. g)) +. h*.(g-. y) = x -. h*. y `]) (HYP_INT 0); + ABBREV_TAC `z = x -. h*.y`; + H (ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) (HYP_INT 4); + ABBREV_TAC `u = abs(g) -. ey`; + POPL_TAC[0;2;4;6]; + H (MATCH_MP lemma1 ) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 1)); + H (MATCH_MP REAL_PROP_LE_LMUL) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 3)); + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0)); + ASM_REWRITE_TAC[] + ]; + ]]);; + +(* ------------------------------------------------------------------ *) +(* INTERVAL ABS VALUE *) +(* ------------------------------------------------------------------ *) + +let INTERVAL_ABSV = prove(`!x f ex. interval x f ex ==> (interval (abs x) (abs f) ex)`, +EVERY[ + REWRITE_TAC[interval]; + DISCH_ALL_TAC; + ASSUME_TAC (SPECL [`x:real`;`f:real`] REAL_ABS_SUB_ABS); + ASM_MESON_TAC[REAL_LE_TRANS] +]);; (* 7 minutes *) + +(* ------------------------------------------------------------------ *) +(* INTERVAL SQRT *) +(* This requires some preliminaries. Extend sqrt by 0 on negatives *) +(* ------------------------------------------------------------------ *) + +let ssqrt = new_definition `ssqrt x = if (x <. (&.0)) then (&.0) else sqrt x`;; (*2m*) + +let LET_TAC = REWRITE_TAC[LET_DEF;LET_END_DEF];; + + +let REAL_SSQRT_NEG = prove(`!x. (x <. (&.0)) ==> (ssqrt x = (&.0))`, + EVERY[ + DISCH_ALL_TAC; + REWRITE_TAC[ssqrt]; + COND_CASES_TAC + THENL[ + ACCEPT_TAC (REFL `&.0`); + ASM_MESON_TAC[] + ] + ]);; +(* 5 min*) + +let REAL_SSQRT_NN = prove(`!x. (&.0) <=. x ==> (ssqrt x = (sqrt x))`, + EVERY[ + DISCH_ALL_TAC; + REWRITE_TAC[ssqrt]; + COND_CASES_TAC + THENL[ + ASM_MESON_TAC[real_lt]; + ACCEPT_TAC (REFL `sqrt x`) + ] + ]);; (* 12 min, mostly spent loading *index-shell* *) + + +(*17 minutes*) +let REAL_MK_NN_SSQRT = prove(`!x. (&.0) <=. (ssqrt x)`, + EVERY[ + GEN_TAC; + DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL) + THENL[ + POP_ASSUM (fun th -> MP_TAC(MATCH_MP (REAL_SSQRT_NEG) th)) THEN + MESON_TAC[REAL_LE_REFL]; + POP_ASSUM (fun th -> ASSUME_TAC(CONJ th (MATCH_MP (REAL_SSQRT_NN) th))) THEN + ASM_MESON_TAC[REAL_PROP_NN_SQRT] + ] + ]);; + +let REAL_SV_SSQRT_0 = prove(`!x. ssqrt (&.0) = (&.0)`, + EVERY[ + GEN_TAC; + MP_TAC (SPEC `&.0` REAL_LE_REFL); + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_SSQRT_NN th]); + ACCEPT_TAC REAL_SV_SQRT_0 + ]);; (* 6 minutes *) + + +let REAL_SSQRT_EQ_0 = prove(`!(x:real). (ssqrt(x) = (&.0)) ==> (x <=. (&.0))`, + EVERY[ + GEN_TAC; + DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL) + THENL[ + ASM_MESON_TAC[REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_SSQRT_NN] THEN + ASM_MESON_TAC[SQRT_EQ_0;REAL_EQ_IMP_LE] + ] + ]);; (* 15 minutes *) + + +let REAL_SSQRT_MONO = prove(`!x. (x<=. y) ==> (ssqrt x <=. (ssqrt y))`, + EVERY[ + GEN_TAC; + DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL) + THENL[ + ASM_MESON_TAC[REAL_SSQRT_NEG;REAL_MK_NN_SSQRT]; + ASM_MESON_TAC[REAL_LE_TRANS;REAL_SSQRT_NN;REAL_PROP_LE_SQRT]; + ] + ]);; (* 5 minutes *) + +let REAL_SSQRT_CHAR = prove(`!x t. (&.0 <=. t /\ (t*t = x)) ==> (t = (ssqrt x))`, + EVERY[ + DISCH_ALL_TAC; + H_ASSUME_TAC (H_RULE_LIST REWRITE_RULE[HYP_INT 1] (THM (SPEC `t:real` REAL_MK_NN_SQUARE))); + ASM_MESON_TAC[REAL_SSQRT_NN;SQRT_MUL;POW_2_SQRT_ABS;REAL_POW_2;REAL_ABS_REFL]; + ]);; (* 13 minutes *) + +let REAL_SSQRT_SQUARE = prove(`!x. (&.0 <=. x) ==> ((ssqrt x)*.(ssqrt x) = x)`, + MESON_TAC[REAL_SSQRT_NN;POW_2;SQRT_POW_2]);;(* 7min *) + +let REAL_SSQRT_SQUARE' = prove(`!x. (&.0<=. x) ==> (ssqrt (x*.x) = x)`, + DISCH_ALL_TAC THEN + REWRITE_TAC[(MATCH_MP REAL_SSQRT_NN (SPEC `x:real` REAL_MK_NN_SQUARE))] THEN + ASM_SIMP_TAC[SQRT_MUL;GSYM POW_2;SQRT_POW_2]);; (*20min*) + + +(* an alternate proof appears in RCS *) +let INTERVAL_SSQRT = prove(`!x f ex u ey ez v. (interval x f ex) /\ (interval (u*.u) f ey) /\ + (ex +.ey <=. ez*.(v+.u)) /\ (v*.v <=. f-.ex) /\ (&.0 <. u) /\ (&.0 <=. v) ==> + (interval (ssqrt x) u ez)`, +EVERY[ + DISCH_ALL_TAC; + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (THM (SPEC `v:real` REAL_MK_NN_SQUARE)) (HYP_INT 3)); + H (MATCH_MP (INTERVAL_MIN)) (HYP_INT 1); + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0)); + H (MATCH_MP INTERVAL_EPS_POS) (HYP_INT 3); + H (MATCH_MP INTERVAL_EPS_POS) (HYP_INT 5); + H (MATCH_MP REAL_PROP_NN_ADD2) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0)); + H (MATCH_MP REAL_PROP_POS_LADD) (H_RULE2 CONJ (HYP_INT 11) (HYP_INT 10)); + H (MATCH_MP REAL_PROP_POS_LADD) (H_RULE2 CONJ (THM (SPEC `x:real` REAL_MK_NN_SSQRT)) (HYP_INT 11)); + H (MATCH_MP REAL_PROP_POS_INV) (HYP_INT 0); + ASSUME_TAC (REAL_ARITH `(ssqrt x -. u) = (ssqrt x -. u)*.(&.1)`); + H (MATCH_MP REAL_MK_NZ_POS) (HYP_INT 2); + H (MATCH_MP REAL_MUL_RINV) (HYP_INT 0); + H_REWRITE_RULE[(H_RULE GSYM) (HYP_INT 0)] (HYP_INT 2); + POPL_TAC[1;2;3]; + H (REWRITE_RULE[REAL_MUL_ASSOC]) (HYP_INT 0); + H (REWRITE_RULE[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_DIFFSQ]) (HYP_INT 0); + POPL_TAC[1;2]; + H_SIMP_RULE[HYP_INT 7;THM REAL_SSQRT_SQUARE] (HYP_INT 0); + ASSUME_TAC (REAL_ARITH `abs(x -. u*.u) <=. abs(x -. f) + abs(f-. u*.u)`); + H (REWRITE_RULE[interval]) (HYP_INT 12); + H (ONCE_REWRITE_RULE[interval]) (HYP_INT 14); + H (ONCE_REWRITE_RULE[REAL_ABS_SUB]) (HYP_INT 0); + POPL_TAC[1;5;15;16]; + H (MATCH_MP REAL_LE_ADD2) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0)); + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0)); + POPL_TAC[1;2;3;4]; + H (AP_TERM `||.`) (HYP_INT 1); + H (REWRITE_RULE[ABS_MUL]) (HYP_INT 0); + H (MATCH_MP REAL_LT_IMP_LE) (HYP_INT 4); + H (REWRITE_RULE[GSYM REAL_ABS_REFL]) (HYP_INT 0); + H_REWRITE_RULE [HYP_INT 0] (HYP_INT 2); + H (MATCH_MP REAL_LE_RMUL) (H_RULE2 CONJ (HYP_INT 5) (HYP_INT 2)); + H_REWRITE_RULE [H_RULE GSYM (HYP_INT 1)] (HYP_INT 0); + POPL_TAC[1;2;3;5;6;7;8]; + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 12) (HYP_INT 9)); + H (MATCH_MP REAL_SSQRT_MONO) (HYP_INT 0); + H (MATCH_MP REAL_SSQRT_SQUARE') (HYP_INT 16); + H_REWRITE_RULE [HYP_INT 0] (HYP_INT 1); + H (ONCE_REWRITE_RULE[GSYM (SPECL[`v:real`;`ssqrt x`;`u:real`] REAL_LE_RADD)]) (HYP_INT 0); + H (MATCH_MP REAL_LE_INV2) (H_RULE2 CONJ (HYP_INT 9) (HYP_INT 0)); + POPL_TAC[1;2;3;4;5;7;8;9;12;13]; + H (MATCH_MP REAL_LE_LMUL) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0)); + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 2) (HYP_INT 0)); + H (MATCH_MP REAL_PROP_POS_INV) (HYP_INT 4); + H (MATCH_MP REAL_LT_IMP_LE) (HYP_INT 0); + H (MATCH_MP REAL_LE_RMUL) (H_RULE2 CONJ (HYP_INT 11) (HYP_INT 0)); + H (REWRITE_RULE[GSYM REAL_MUL_ASSOC]) (HYP_INT 0); + H (MATCH_MP REAL_MK_NZ_POS) (HYP_INT 8); + H (MATCH_MP REAL_MUL_RINV) (HYP_INT 0); + H_REWRITE_RULE[HYP_INT 0; THM REAL_MUL_RID] (HYP_INT 2); + H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 7) (HYP_INT 0)); + ASM_REWRITE_TAC[interval] + ]);; + + + +test();; + + +(* conversion for interval *) + +(* ------------------------------------------------------------------ *) +(* Take a term x of type real. Convert to a thm of the form *) +(* interval x f eps *) +(* *) +(* ------------------------------------------------------------------ *) + +let DOUBLE_CONV_FILE=true;; + +let add_test,test = new_test_suite();; + +(* Num package docs at http://caml.inria.fr/ocaml/htmlman/libref/Num.html *) + +(* ------------------------------------------------------------------ *) +(* num_exponent + Take the absolute value of input. + Write it as a*2^k, where 1 <= a < 2, return k. + + Except: + num_exponent (Int 0) is -1. +*) +let (num_exponent:Num.num -> Num.num) = + fun a -> + let afloat = float_of_num (abs_num a) in + Int ((snd (frexp afloat)) - 1);; + +(*test*)let f (u,v) = ((num_exponent u) =(Int v)) in + add_test("num_exponenwt", + forall f + [Int 1,0; Int 65,6; Int (-65),6; + Int 0,-1; (Int 3)//(Int 4),-1]);; +(* ------------------------------------------------------------------ *) + +let dest_unary op tm = + try let xop,r = dest_comb tm in + if xop = op then r else fail() + with Failure _ -> failwith "dest_unary";; + + +(* ------------------------------------------------------------------ *) + + +(* finds a nearby (outward-rounded) Int with only prec_b significant bits *) +let (round_outward: int -> Num.num -> Num.num) = + fun prec_b a -> + let b = abs_num a in + let sign = if (a =/ b) then I else minus_num in + let throw_bits = Num.max_num (Int 0) ((num_exponent b)-/ (Int prec_b)) in + let twoexp = power_num (Int 2) throw_bits in + (sign (ceiling_num (b // twoexp)))*/twoexp;; + +let (round_inward: int-> Num.num -> Num.num) = + fun prec_b a -> + let b = abs_num a in + let sign = if (a=/b) then I else minus_num in + let throw_bits = Num.max_num (Int 0) ((num_exponent b)-/ (Int prec_b)) in + let twoexp = power_num (Int 2) throw_bits in + (sign (floor_num (b // twoexp)))*/twoexp;; + +let round_rat bprec n = + let b = abs_num n in + let sign = if (b =/ n) then I else minus_num in + let powt = ((Int 2) **/ (Int bprec)) in + sign ((round_outward bprec (Num.ceiling_num (b */ powt)))//powt);; + +let round_inward_rat bprec n = + let b = abs_num n in + let sign = if (b =/ n) then I else minus_num in + let powt = ((Int 2) **/ (Int bprec)) in + sign ((round_inward bprec (Num.floor_num (b */ powt)))//powt);; + +let (round_outward_float: int -> float -> Num.num) = + fun bprec f -> + if (f=0.0) then (Int 0) else + begin + let b = abs_float f in + let sign = if (f >= 0.0) then I else minus_num in + let (x,n) = frexp b in + let u = int_of_float( ceil (ldexp x bprec)) in + sign ((Int u)*/ ((Int 2) **/ (Int (n - bprec)))) + end;; + +let (round_inward_float: int -> float -> Num.num) = + fun bprec f -> + if (f=0.0) then (Int 0) else + begin + (* avoid overflow on 30 bit integers *) + let bprec = if (bprec > 25) then 25 else bprec in + let b = abs_float f in + let sign = if (f >= 0.0) then I else minus_num in + let (x,n) = frexp b in + let u = int_of_float( floor (ldexp x bprec)) in + sign ((Int u)*/ ((Int 2) **/ (Int (n - bprec)))) + end;; + +(* ------------------------------------------------------------------ *) + +(* This doesn't belong here. A general term substitution function *) +let SUBST_TERM sublist tm = + rhs (concl ((SPECL (map fst sublist)) (GENL (map snd sublist) + (REFL tm))));; + +add_test("SUBST_TERM", + SUBST_TERM [(`#1`,`a:real`);(`#2`,`b:real`)] (`a +. b +. c`) = + `#1 + #2 + c`);; + +(* ------------------------------------------------------------------ *) + +(* take a term of the form `interval x f ex` and clean up the f and ex *) + +let INTERVAL_CLEAN_CONV:conv = + fun interv -> + let (ixf,ex) = dest_comb interv in + let (ix,f) = dest_comb ixf in + let fthm = FLOAT_CONV f in + let exthm = FLOAT_CONV ex in + let ixfthm = AP_TERM ix fthm in + MK_COMB (ixfthm, exthm);; + +(*test*) add_test("INTERVAL_CLEAN_CONV", + let testval = INTERVAL_CLEAN_CONV `interval ((&.1) +. (&.1)) + (float (&:3) (&:4) +. (float (&:2) (--: (&:3)))) + (float (&:1) (&:2) *. (float (&:3) (--: (&:2))))` in + let hypval = hyp testval in + let concval = concl testval in + (length hypval = 0) && + concval = + `interval (&1 + &1) (float (&:3) (&:4) + float (&:2) (--: (&:3))) + (float (&:1) (&:2) * float (&:3) (--: (&:2))) = + interval (&1 + &1) (float (&:386) (--: (&:3))) (float (&:3) (&:0))` + );; + +(* ------------------------------------------------------------------ *) +(* GENERAL lemmas *) +(* ------------------------------------------------------------------ *) + + +(* verifies statement of the form `float a b = float a' b'` *) + +let FLOAT_EQ = prove( + `!a b a' b'. (float a b = (float a' b')) <=> + ((float a b) -. (float a' b') = (&.0))`,MESON_TAC[REAL_SUB_0]);; + +let FLOAT_LT = prove( + `!a b a' b'. (float a b <. (float a' b')) <=> + ((&.0) <. (float a' b') -. (float a b))`,MESON_TAC[REAL_SUB_LT]);; + +let FLOAT_LE = prove( + `!a b a' b'. (float a b <=. (float a' b')) <=> + ((&.0) <=. (float a' b') -. (float a b))`,MESON_TAC[REAL_SUB_LE]);; + +let TWOPOW_MK_POS = prove( + `!a. (&.0 <. ( twopow a))`, +EVERY[ + GEN_TAC; + CHOOSE_TAC (SPEC `a:int` INT_REP2); + POP_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG]; + TRY (MATCH_MP_TAC REAL_INV_POS); + MATCH_MP_TAC REAL_POW_LT ; + REAL_ARITH_TAC; +]);; + +let TWOPOW_NZ = prove( + `!a. ~(twopow a = (&.0))`, + GEN_TAC THEN + ACCEPT_TAC (MATCH_MP REAL_MK_NZ_POS (SPEC `a:int` TWOPOW_MK_POS)));; + +let FLOAT_ZERO = prove( + `!a b. (float a b = (&.0)) <=> (a = (&:0))`, +EVERY[ + REWRITE_TAC[float;REAL_ENTIRE;INT_OF_NUM_DEST]; + MESON_TAC[TWOPOW_NZ]; +]);; + +let INT_ZERO = prove( + `!n. ((&:n = (&:0)) = (n=0))`,REWRITE_TAC[INT_OF_NUM_EQ]);; + +let INT_ZERO_NEG=prove( + `!n. ((--: (&:n) = (&:0))) <=> (n=0)`, + REWRITE_TAC[INT_NEG_EQ_0;INT_ZERO]);; + +let FLOAT_NN = prove( + `!a b. ((&.0) <=. (float a b)) <=> (&:0 <=: a)`, +EVERY[ + REWRITE_TAC[float;INT_OF_NUM_DEST]; + REP_GEN_TAC; + EQ_TAC THENL[EVERY[ + DISCH_ALL_TAC; + INPUT_COMBO[THM REAL_PROP_NN_RCANCEL;THM (SPEC `b:int` TWOPOW_MK_POS) &&& (HYP"0")]; + ASM_MESON_TAC[int_le;int_of_num_th]]; + EVERY[ + DISCH_ALL_TAC; + INPUT_COMBO[THM REAL_PROP_NN_POS;THM(SPEC`b:int`TWOPOW_MK_POS)]; + INPUT_COMBO[THM int_of_num_th ; THM int_le ;(HYP"0")]; + INPUT_COMBO[THM REAL_PROP_NN_MUL2; (HYP"2")&&&(HYP"1")]; + ASM_REWRITE_TAC[]]] +]);; + +let INT_NN = INT_POS;; + +let INT_NN_NEG = prove(`!n. ((&:0) <=: (--:(&:n))) <=> (n = 0)`, + REWRITE_TAC[INT_NEG_GE0;INT_OF_NUM_LE] THEN ARITH_TAC + );; + +let FLOAT_POS = prove(`!a b. ((&.0) <. (float a b)) <=> (&:0 <: a)`, + MESON_TAC[FLOAT_NN;FLOAT_ZERO;INT_LT_LE;REAL_LT_LE]);; + +let INT_POS' = prove(`!n. (&:0) <: (&:n) <=> (~(n=0) )`, + REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC);; + +let INT_POS_NEG =prove(`!n. ((&:0) <: (--:(&:n))) <=> F`, + REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC);; + +let RAT_LEMMA1_SUB = prove(`~(y1 = &0) /\ ~(y2 = &0) ==> + ((x1 / y1) - (x2 / y2) = (x1 * y2 - x2 * y1) * inv(y1) * inv(y2))`, + EVERY[REWRITE_TAC[real_div]; + REWRITE_TAC[real_sub;GSYM REAL_MUL_LNEG]; + REWRITE_TAC[GSYM real_div]; + SIMP_TAC[RAT_LEMMA1]; + DISCH_TAC; + MESON_TAC[real_div]]);; + +let INTERVAL_0 = prove(`! a f ex. (interval a f ex <=> (&.0 <= (ex - (abs (a -. f)))))`, + MESON_TAC[interval;REAL_SUB_LE]);; + + + +let ABS_NUM = prove (`!m n. abs (&. n -. (&. m)) = &.((m-|n) + (n-|m))`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC (SPECL [`m:num`;`n:num`] LTE_CASES) THENL[ + (* first case *) + EVERY[ LABEL_ALL_TAC; + H_REWRITE_RULE [THM (GSYM REAL_OF_NUM_LT)] (HYP "0"); + LABEL_ALL_TAC; + H_ONCE_REWRITE_RULE[THM (GSYM REAL_SUB_LT)] (HYP "1"); + LABEL_ALL_TAC; + H_MATCH_MP (THM REAL_LT_IMP_LE) (HYP "2"); + LABEL_ALL_TAC; + H_REWRITE_RULE [THM (GSYM ABS_REFL)] (HYP "3"); + ASM_REWRITE_TAC[]; + H_MATCH_MP (THM LT_IMP_LE) (HYP "0"); + ASM_SIMP_TAC[REAL_OF_NUM_SUB]; + REWRITE_TAC[REAL_OF_NUM_EQ]; + ONCE_REWRITE_TAC[ARITH_RULE `!x:num y:num. (x = y) = (y = x)`]; + REWRITE_TAC[EQ_ADD_RCANCEL_0]; + ASM_REWRITE_TAC[SUB_EQ_0]]; + (* second case *) + EVERY[LABEL_ALL_TAC; + H_REWRITE_RULE [THM (GSYM REAL_OF_NUM_LE)] (HYP "0"); + LABEL_ALL_TAC; + H_ONCE_REWRITE_RULE[THM (GSYM REAL_SUB_LE)] (HYP "1"); + LABEL_ALL_TAC; + H_REWRITE_RULE [THM (GSYM ABS_REFL)] (HYP "2"); + ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG]; + REWRITE_TAC[REAL_ARITH `!x y. --.(x -. y) = (y-x)`]; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_OF_NUM_SUB]; + REWRITE_TAC[REAL_OF_NUM_EQ]; + ONCE_REWRITE_TAC[ARITH_RULE `!x:num y:num. (x = y) <=> (y = x)`]; + REWRITE_TAC[EQ_ADD_LCANCEL_0]; + ASM_REWRITE_TAC[SUB_EQ_0]]]);; + +let INTERVAL_TO_LESS = prove( + `!a f ex b g ey. ((interval a f ex) /\ (interval b g ey) /\ + (&.0 <. (g -. (ey +. ex +. f)))) ==> (a <. b)`, + let lemma1 = REAL_ARITH `!ex ey f g. (&.0 <. + (g -. (ey +. ex +. f))) ==> ((f +. ex)<. (g -. ey)) ` in + EVERY[ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + H_MATCH_MP (THM lemma1) (HYP "2"); + H_MATCH_MP (THM INTERVAL_MAX) (HYP "0"); + H_MATCH_MP (THM INTERVAL_MIN) (HYP "1"); + LABEL_ALL_TAC; + H_MATCH_MP (THM REAL_LET_TRANS) (H_RULE2 CONJ (HYP "4") (HYP "5")); + LABEL_ALL_TAC; + H_MATCH_MP (THM REAL_LTE_TRANS) (H_RULE2 CONJ (HYP "6") (HYP "3")); + ASM_REWRITE_TAC[] + ]);; + +let ABS_TO_INTERVAL = prove( + `!c u k. (abs (c - u) <=. k) ==> (!f g ex ey.((interval u f ex) /\ (interval k g ey) ==> (interval c f (g+.ey+.ex))))`, + EVERY[ + REWRITE_TAC[interval]; + DISCH_ALL_TAC; + REPEAT GEN_TAC; + DISCH_ALL_TAC; + ONCE_REWRITE_TAC [REAL_ARITH `c -. f = (c-. u) + (u-. f)`]; + ONCE_REWRITE_TAC [REAL_ADD_ASSOC]; + ASSUME_TAC (SPECL [`c-.u`;`u-.f`] ABS_TRIANGLE); + IMP_RES_THEN ASSUME_TAC (REAL_ARITH `||.(k-.g) <=. ey ==> (k <=. (g +. ey))`); + MATCH_MP_TAC (REAL_ARITH `(?a b.((x <=. (a+.b)) /\ (a <=. u) /\ (b <=. v))) ==> (x <=. (u +. v))`); + EXISTS_TAC `abs (c-.u)`; + EXISTS_TAC `abs(u-.f)`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LE_TRANS]; + ]);; + + +(* end of general lemmas *) +(* ------------------------------------------------------------------ *) + + +(* ------------------------------------------------------------------ *) +(* Cache of computed constants (abs (c - u) <= k) *) +(* ------------------------------------------------------------------ *) + +let calculated_constants = ref ([]:(term*thm) list);; + +let add_real_constant ineq = + try( + let (abst,k) = dest_binop `(<=.)` (concl ineq) in + let (absh,cmu) = dest_comb abst in + let (c,u) = dest_binop `(-.)` cmu in + calculated_constants := (c,ineq)::(!calculated_constants)) + with _ -> + (try( + let (c,f,ex) = dest_interval (concl ineq) in + calculated_constants := (c,ineq)::(!calculated_constants)) + with _ -> failwith "calculated_constants format : abs(c - u) <= k");; + +let get_real_constant tm = + assoc tm !calculated_constants;; + +let remove_real_constant tm = + calculated_constants := + filter (fun t -> not ((fst t) = tm)) !calculated_constants;; + + + +(* ------------------------------------------------------------------ *) + +(* term of the form '&.n'. Assume error checking done already. *) +let INTERVAL_OF_NUM:conv = + fun tm -> + let tm1 = snd (dest_comb tm) in + let th1 = (ARITH_REWRITE_CONV[] tm1) in + ONCE_REWRITE_RULE[AP_TERM `&.` (GSYM th1)] + (SPEC (rhs (concl th1)) INTERVAL_NUM);; + +add_test("INTERVAL_OF_NUM", + dest_thm (INTERVAL_OF_NUM `&.3`) = ([], + `interval (&3) (float (&:3) (&:0)) (float (&:0) (&:0))`));; + +(* term of the form `--. (&.n)`. Assume format checking already done. *) +let INTERVAL_OF_NEG:conv = + fun tm -> + let (sign,u) = dest_comb tm in + let _ = assert(sign = `--.`) in + let (amp,tm1) = (dest_comb u) in + let _ = assert(amp = `&.`) in + let th1 = (ARITH_REWRITE_CONV[] tm1) in + ONCE_REWRITE_RULE[FLOAT_NEG] ( + ONCE_REWRITE_RULE[INTERVAL_NEG] ( + ONCE_REWRITE_RULE[AP_TERM `&.` (GSYM th1)] ( + (SPEC (rhs (concl th1)) INTERVAL_NUM))));; + +add_test("INTERVAL_OF_NEG", + dest_thm (INTERVAL_OF_NEG `--.(&. (3+4))`) = + ([],`interval( --.(&.(3 + 4)) ) + (float (--: (&:7)) (&:0)) (float (&:0) (&:0))`));; + +(* ------------------------------------------------------------------ *) + +let INTERVAL_TO_LESS_CONV = fun thm1 thm2 -> + let (a,f,ex) = dest_interval (concl thm1) in + let (b,g,ey) = dest_interval (concl thm2) in + let rthm = ASSUME `!f g ex ey. (&.0 <. (g -. (ey +. ex +. f)))` in + let rspec = concl (SPECL [f;g;ex;ey] rthm) in + let rspec_simp = FLOAT_CONV (snd (dest_binop `(<.)` rspec)) in + let rthm2 = prove (rspec,REWRITE_TAC[rspec_simp;FLOAT_POS;INT_POS'; + INT_POS_NEG] THEN ARITH_TAC) in + let fthm = CONJ thm1 (CONJ thm2 rthm2) in + MATCH_MP INTERVAL_TO_LESS fthm;; + +add_test("INTERVAL_TO_LESS_CONV", + let thm1 = ASSUME + `interval (#0.1) (float (&:1) (--: (&:1))) (float (&:1) (--: (&:2)))` in + let thm2 = ASSUME `interval (#7) (float (&:4) (&:1)) (float (&:1) (&:0))` in + let thm3 = INTERVAL_TO_LESS_CONV thm1 thm2 in + concl thm3 = `#0.1 <. (#7)`);; + +add_test("INTERVAL_TO_LESS_CONV2", + let (h,c) = dest_thm (INTERVAL_TO_LESS_CONV + (INTERVAL_OF_NUM `&.3`) (INTERVAL_OF_NUM `&.8`)) in + (h=[]) && (c = `&.3 <. (&.8)`));; + +(* ------------------------------------------------------------------ *) + +(* conversion for DEC <= posfloat and posfloat <= DEC *) + +let lemma1 = prove( + `!n m p. ((&.p/(&.m)) <= (&.n)) <=> ((&.p/(&.m)) <= (&.n)/(&.1))`, + MESON_TAC[REAL_DIV_1]);; + +let lemma2 = prove( + `!n m p. ((&.p) <= ((&.n)/(&.m))) <=> ((&.p/(&.1)) <= (&.n)/(&.m))`, + MESON_TAC[REAL_DIV_1]);; + +let lemma3 = prove(`!a b c d. ( + ((0 (&.a/(&.b) <=. ((&.c)/(&.d))))`, + EVERY[REPEAT GEN_TAC; + DISCH_ALL_TAC; + ASM_SIMP_TAC[RAT_LEMMA4;REAL_LT;REAL_OF_NUM_MUL;REAL_LE]]);; + +let DEC_FLOAT = EQT_ELIM o + ARITH_SIMP_CONV[DECIMAL;float;TWOPOW_POS;TWOPOW_NEG;GSYM real_div; + REAL_OF_NUM_POW;INT_NUM_REAL;REAL_OF_NUM_MUL; + lemma1;lemma2;lemma3];; + +add_test("DEC_FLOAT", + let f c x = + dest_thm (c x) = ([],x) in + ((f DEC_FLOAT `#10.0 <= (float (&:3) (&:2))`) && + (f DEC_FLOAT `#10 <= (float (&:3) (&:2))`) && + (f DEC_FLOAT `#0.1 <= (float (&:1) (--: (&:2)))`) && + (f DEC_FLOAT `float (&:3) (&:2) <= (#13.0)`) && + (f DEC_FLOAT `float (&:3) (&:2) <= (#13)`) && + (f DEC_FLOAT `float (&:1) (--: (&:2)) <= (#0.3)`)));; +(* ------------------------------------------------------------------ *) +(* conversion for float inequalities *) + +let FLOAT_INEQ_CONV t = + let thm1= (ONCE_REWRITE_CONV[GSYM REAL_SUB_LT;GSYM REAL_SUB_LE] t) in + let rhsx= rhs (concl thm1) in + let thm2= prove(rhsx,REWRITE_TAC[FLOAT_CONV (snd (dest_comb rhsx))] THEN + REWRITE_TAC[FLOAT_NN;FLOAT_POS;INT_NN;INT_NN_NEG; + INT_POS';INT_POS_NEG] THEN ARITH_TAC) in + REWRITE_RULE[GSYM thm1] thm2;; + +let t1 = `(float (&:3) (&:0)) +. (float (&:4) (&:0)) <. (float (&:8) (&:1))`;; + + +add_test("FLOAT_INEQ_CONV", + let f c x = + dest_thm (c x) = ([],x) in + let t1 = + `(float (&:3) (&:0)) +. (float (&:4) (&:0)) <. (float (&:8) (&:1))` in + ((f FLOAT_INEQ_CONV t1)));; + + + + +(* ------------------------------------------------------------------ *) + +(* converts a DECIMAL TO A THEOREM *) + +let INTERVAL_MINMAX = prove(`!x f ex. + ((f -. ex) <= x) /\ (x <=. (f +. ex)) ==> (interval x f ex)`, + EVERY[REPEAT GEN_TAC; + REWRITE_TAC[interval;ABS_BOUNDS]; + REAL_ARITH_TAC]);; + + +let INTERVAL_OF_DECIMAL bprec dec = + let a_num = dest_decimal dec in + let f_num = round_rat bprec a_num in + let ex_num = round_rat bprec (Num.abs_num (f_num -/ a_num)) in + let _ = assert (ex_num <=/ f_num) in + let f = mk_float f_num in + let ex= mk_float ex_num in + let fplus_ex = FLOAT_CONV (mk_binop `(+.)` f ex) in + let fminus_ex= FLOAT_CONV (mk_binop `(-.)` f ex) in + let fplus_term = rhs (concl fplus_ex) in + let fminus_term = rhs (concl fminus_ex) in + let th1 = DEC_FLOAT (mk_binop `(<=.)` fminus_term dec) in + let th2 = DEC_FLOAT (mk_binop `(<=.)` dec fplus_term) in + let intv = mk_interval dec f ex in + EQT_ELIM (SIMP_CONV[INTERVAL_MINMAX;fplus_ex;fminus_ex;th1;th2] intv);; + +add_test("INTERVAL_OF_DECIMAL", + let (h,c) = dest_thm (INTERVAL_OF_DECIMAL 4 `#36.1`) in + let (x,f,ex) = dest_interval c in + (h=[]) && (x = `#36.1`));; + +add_test("INTERVAL_OF_DECIMAL2", + can (fun() -> INTERVAL_TO_LESS_CONV (INTERVAL_OF_DECIMAL 4 `#33.33`) + (INTERVAL_OF_DECIMAL 4 `#36.1`)) ());; + +(*--------------------------------------------------------------------*) +(* functions to check format. *) +(* There are various implicit rules: *) +(* NUMERAL is followed by bits and no other kind of num, etc. *) +(* FLOAT a b, both a and b are &:NUMERAL or --:&:NUMERAL, etc. *) +(*--------------------------------------------------------------------*) + + +(* converts exceptions to false *) +let falsify_ex f x = try (f x) with _ -> false;; + +let is_bits_format = + let rec format x = + if (x = `_0`) then true + else let (h,t) = dest_comb x in + (((h = `BIT1`) or (h = `BIT0`)) && (format t)) + in falsify_ex format;; + +let is_numeral_format = + let fn x = + let (h,t) = dest_comb x in + ((h = `NUMERAL`) && (is_bits_format t)) in + falsify_ex fn;; + +let is_decimal_format = + let fn x = + let (t1,t2) = dest_binop `DECIMAL` x in + ((is_numeral_format t1) && (is_numeral_format t2)) in + falsify_ex fn;; + +let is_pos_int_format = + let fn x = + let (h,t) = dest_comb x in + (h = `&:`) && (is_numeral_format t) in + falsify_ex fn;; + +let is_neg_int_format = + let fn x = + let (h,t) = dest_comb x in + (h = `--:`) && (is_pos_int_format t) in + falsify_ex fn;; + +let is_int_format x = + (is_neg_int_format x) or (is_pos_int_format x);; + +let is_float_format = + let fn x = + let (t1,t2) = dest_binop `float` x in + (is_int_format t1) && (is_int_format t2) in + falsify_ex fn;; + +let is_interval_format = + let fn x = + let (a,b,c) = dest_interval x in + (is_float_format b) && (is_float_format c) in + falsify_ex fn;; + +let is_neg_real = + let fn x = + let (h,t) = dest_comb x in + (h= `--.`) in + falsify_ex fn;; + +let is_real_num_format = + let fn x = + let (h,t) = dest_comb x in + (h=`&.`) && (is_numeral_format t) in + falsify_ex fn;; + +let is_comb_of t u = + let fn t u = + t = (fst (dest_comb u)) in + try (fn t u) with failure -> false;; + +(* ------------------------------------------------------------------ *) +(* Heron's formula for the square root of A + Return a value x that is always at most the actual square root + and such that abs (x - A/x ) < epsilon *) + +let rec heron_sqrt depth A x eps = + let half = (Int 1)//(Int 2) in + if (depth <= 0) then raise (Failure "sqrt recursion depth exceeded") else + if (Num.abs_num (x -/ (A//x) ) =/ A) then (A//x) else + let x' = half */ (x +/ (A//x)) in + heron_sqrt (depth -1) A x' eps;; + +let INTERVAL_OF_TWOPOW = prove( + `!n. interval (twopow n) (float (&:1) n) (float (&:0) (&:0))`, + REWRITE_TAC[interval;float;int_of_num_th] THEN + REAL_ARITH_TAC + );; + +(* ------------------------------------------------------------------ *) + +let rec INTERVAL_OF_TERM bprec tm = + (* treat cached values first *) + if (can get_real_constant tm) then + begin + try( + let int_thm = get_real_constant tm in + if (can dest_interval (concl int_thm)) then int_thm + else ( + let absthm = get_real_constant tm in + let (abst,k) = dest_binop `(<=.)` (concl absthm) in + let (absh,cmu) = dest_comb abst in + let (c,u) = dest_binop `(-.)` cmu in + let intk = INTERVAL_OF_TERM bprec k in + let intu = INTERVAL_OF_TERM bprec u in + let thm1 = MATCH_MP ABS_TO_INTERVAL absthm in + let thm2 = MATCH_MP thm1 (CONJ intu intk) in + let (_,f,ex)= dest_interval (concl thm2) in + let fthm = FLOAT_CONV f in + let exthm = FLOAT_CONV ex in + let thm3 = REWRITE_RULE[fthm;exthm] thm2 in + (add_real_constant thm3; thm3) + )) + with _ -> failwith "INTERVAL_OF_TERM : CONSTANT" + end + else if (is_real_num_format tm) then (INTERVAL_OF_NUM tm) + else if (is_decimal_format tm) then (INTERVAL_OF_DECIMAL bprec tm) + (* treat negative terms *) + else if (is_neg_real tm) then + begin + try( + let (_,t) = dest_comb tm in + let int1 = INTERVAL_OF_TERM bprec t in + let (_,b,_) = dest_interval (concl int1) in + let thm1 = FLOAT_CONV (mk_comb (`--.`, b)) in + REWRITE_RULE[thm1] (ONCE_REWRITE_RULE[INTERVAL_NEG] int1)) + with _ -> failwith "INTERVAL_OF_TERM : NEG" + end + (* treat abs value *) + else if (is_comb_of `||.` tm) then + begin + try( + let (_,b) = dest_comb tm in + let b_int = MATCH_MP INTERVAL_ABSV (INTERVAL_OF_TERM bprec b) in + let (_,f,_) = dest_interval (concl b_int) in + let thm1 = FLOAT_CONV f in + REWRITE_RULE[thm1] b_int) + with _ -> failwith "INTERVAL_OF_TERM : ABS" + end + (* treat twopow *) + else if (is_comb_of `twopow` tm) then + begin + try( + let (_,b) = dest_comb tm in + SPEC b INTERVAL_OF_TWOPOW + ) + with _ -> failwith "INTERVAL_OF_TERM : TWOPOW" + end + (* treat addition *) + else if (can (dest_binop `(+.)`) tm) then + begin + try( + let (a,b) = dest_binop `(+.)` tm in + let a_int = INTERVAL_OF_TERM bprec a in + let b_int = INTERVAL_OF_TERM bprec b in + let c_int = MATCH_MP INTERVAL_ADD (CONJ a_int b_int) in + let (_,f,ex) = dest_interval (concl c_int) in + let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in + REWRITE_RULE[thm1;thm2] c_int) + with _ -> failwith "INTERVAL_OF_TERM : ADD" + end + (* treat subtraction *) + else if (can (dest_binop `(-.)`) tm) then + begin + try( + let (a,b) = dest_binop `(-.)` tm in + let a_int = INTERVAL_OF_TERM bprec a in + let b_int = INTERVAL_OF_TERM bprec b in + let c_int = MATCH_MP INTERVAL_SUB (CONJ a_int b_int) in + let (_,f,ex) = dest_interval (concl c_int) in + let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in + REWRITE_RULE[thm1;thm2] c_int) + with _ -> failwith "INTERVAL_OF_TERM : SUB" + end + (* treat multiplication *) + else if (can (dest_binop `( *. )`) tm) then + begin + try( + let (a,b) = dest_binop `( *. )` tm in + let a_int = INTERVAL_OF_TERM bprec a in + let b_int = INTERVAL_OF_TERM bprec b in + let c_int = MATCH_MP INTERVAL_MUL (CONJ a_int b_int) in + let (_,f,ex) = dest_interval (concl c_int) in + let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in + REWRITE_RULE[thm1;thm2] c_int) + with _ -> failwith "INTERVAL_OF_TERM : MUL" + end + (* treat division : instantiate INTERVAL_DIV *) + else if (can (dest_binop `( / )`) tm) then + begin + try( + let (a,b) = dest_binop `( / )` tm in + let a_int = INTERVAL_OF_TERM bprec a in + let b_int = INTERVAL_OF_TERM bprec b in + let (_,f,ex) = dest_interval (concl a_int) in + let (_,g,ey) = dest_interval (concl b_int) in + let f_num = dest_float f in + let ex_num = dest_float ex in + let g_num = dest_float g in + let ey_num = dest_float ey in + let h_num = round_rat bprec (f_num//g_num) in + let h = mk_float h_num in + let ez_rat = (ex_num +/ abs_num (f_num -/ (h_num*/ g_num)) + +/ (abs_num h_num */ ey_num))//((abs_num g_num) -/ (ey_num)) in + let ez_num = round_rat bprec (ez_rat) in + let _ = assert((ez_num >=/ (Int 0))) in + let ez = mk_float ez_num in + let hyp1 = a_int in + let hyp2 = b_int in + let hyp3 = FLOAT_INEQ_CONV (mk_binop `(<.)` ey (mk_comb (`||.`,g))) in + let thm = SPECL [a;f;ex;b;g;ey;h;ez] INTERVAL_DIV in + let conj2 x = snd (dest_conj x) in + let hyp4t = (conj2 (conj2 (conj2 (fst(dest_imp (concl thm)))))) in + let hyp4 = FLOAT_INEQ_CONV hyp4t in + let hyp_all = end_itlist CONJ [hyp1;hyp2;hyp3;hyp4] in + MATCH_MP thm hyp_all) + with _ -> failwith "INTERVAL_OF_TERM :DIV" + end + (* treat sqrt : instantiate INTERVAL_SSQRT *) + else if (can (dest_unary `ssqrt`) tm) then + begin + try( + let x = dest_unary `ssqrt` tm in + let x_int = INTERVAL_OF_TERM bprec x in + let (_,f,ex) = dest_interval (concl x_int) in + let f_num = dest_float f in + let ex_num = dest_float ex in + let fd_num = f_num -/ ex_num in + let fe_f = Num.float_of_num fd_num in + let apprx_sqrt = Pervasives.sqrt fe_f in + (* put in heron's formula *) + let v_num1 = round_inward_float 25 (apprx_sqrt) in + let v_num = round_inward_rat bprec + (heron_sqrt 10 fd_num v_num1 ((Int 2) **/ (Int (-bprec-4)))) in + let u_num1 = round_inward_float 25 + (Pervasives.sqrt (float_of_num f_num)) in + let u_num = round_inward_rat bprec + (heron_sqrt 10 f_num u_num1 ((Int 2) **/ (Int (-bprec-4)))) in + let ey_num = round_rat bprec (abs_num (f_num -/ (u_num */ u_num))) in + let ez_num = round_rat bprec ((ex_num +/ ey_num)//(u_num +/ v_num)) in + let (v,u) = (mk_float v_num,mk_float u_num) in + let (ey,ez) = (mk_float ey_num,mk_float ez_num) in + let thm = SPECL [x;f;ex;u;ey;ez;v] INTERVAL_SSQRT in + let conjhyp = fst (dest_imp (concl thm)) in + let [hyp6;hyp5;hyp4;hyp3;hyp2;hyp1] = + let rec break_conj c acc = + if (not(is_conj c)) then (c::acc) else + let (u,v) = dest_conj c in break_conj v (u::acc) in + (break_conj conjhyp []) in + let thm2 = prove(hyp2,REWRITE_TAC[interval] THEN + (CONV_TAC FLOAT_INEQ_CONV)) in + let thm3 = FLOAT_INEQ_CONV hyp3 in + let thm4 = FLOAT_INEQ_CONV hyp4 in + let float_tac = REWRITE_TAC[FLOAT_NN;FLOAT_POS;INT_NN;INT_NN_NEG; + INT_POS';INT_POS_NEG] THEN ARITH_TAC in + let thm5 = prove( hyp5,float_tac) in + let thm6 = prove( hyp6,float_tac) in + let ant = end_itlist CONJ[x_int;thm2;thm3;thm4;thm5;thm6] in + MATCH_MP thm ant + ) + with _ -> failwith "INTERVAL_OF_TERM : SSQRT" + end + else failwith "INTERVAL_OF_TERM : case not installed";; + + +let real_ineq bprec tm = + let (t1,t2) = dest_binop `(<.)` tm in + let int1 = INTERVAL_OF_TERM bprec t1 in + let int2 = INTERVAL_OF_TERM bprec t2 in + INTERVAL_TO_LESS_CONV int1 int2;; + +pop_priority();; + + diff --git a/Jordan/jordan_curve_theorem.ml b/Jordan/jordan_curve_theorem.ml new file mode 100644 index 0000000..7f9d99f --- /dev/null +++ b/Jordan/jordan_curve_theorem.ml @@ -0,0 +1,59310 @@ +(* + + Proof of the Jordan curve theorem + Format: HOL-LIGHT (OCaml version 2003) + File started April 20, 2004 + Completed January 19, 2005 + Author: Thomas C. Hales + + The proof follows + Carsten Thomassen + "The Jordan-Schoenflies theorem and the classification of + surfaces" + American Math Monthly 99 (1992) 116 - 130. + + There is one major difference from Thomassen's proof. + He uses general polygonal jordan curves in the "easy" case of the + Jordan curve theorem. This file restricts the "easy" case + even further to jordan curves that are made of horizontal + and vertical segments with integer length. + + Thomassen shows finite planar graphs admit polygonal + embeddings. This file shows that finite planar graphs such + that every vertex has degree at most 4 admit + embeddings with edges that are piecewise horizontal and + vertical segments of integer length. + + I have apologies: + + 1. I'm still a novice and haven't settled on a style. The + entire proof is a clumsy experiment. + 2. The lemmas have been ordered by my stream of consciousness. + The file is long, the dependencies are nontrivial, and reordering + is best accomplished by an automated tool. + +*) + + +let jordan_def = local_definition "jordan";; +mk_local_interface "jordan";; +prioritize_real();; + +let basic_rewrite_bak = basic_rewrites();; +let basic_net_bak = basic_net();; +let PARTIAL_REWRITE_CONV thl = + GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net_bak) thl;; +let PARTIAL_REWRITE_TAC thl = CONV_TAC(PARTIAL_REWRITE_CONV thl);; + +let reset() = (set_basic_rewrites basic_rewrite_bak);; +extend_basic_rewrites + (* sets *) + [(* UNIV *) + INR IN_UNIV; + UNIV_NOT_EMPTY; + EMPTY_NOT_UNIV; + DIFF_UNIV; + INSERT_UNIV; + INTER_UNIV ; + EQ_UNIV; + UNIV_SUBSET; + SUBSET_UNIV; + (* EMPTY *) + IN;IN_ELIM_THM'; + (* EMPTY_EXISTS; *) (* leave EMPTY EXISTS out next time *) + EMPTY_DELETE; + INTERS_EMPTY; + INR NOT_IN_EMPTY; + EMPTY_SUBSET; + (* SUBSET_EMPTY; *) (* leave out *) + (* INTERS *) + inters_singleton; + (* SUBSET_INTER; *) + (* unions *) + UNIONS_0; + UNIONS_1; + ];; + + +let DISCH_THEN_REWRITE = (DISCH_THEN (fun t -> REWRITE_TAC[t]));; +let ISUBSET = INR SUBSET;; + +(* ------------------------------------------------------------------ *) +(* Logic, Sets, Metric Space Material *) +(* ------------------------------------------------------------------ *) + +(* logic *) + + +(* sets *) +let PAIR_LEMMAv2 = prove_by_refinement( + `!x (i:A) (j:B). (x = (i,j)) <=> ((FST x = i) /\ (SND x = j))` , +(* {{{ proof *) + [ + MESON_TAC[FST;SND;PAIR]; + ]);; +(* }}} *) + +let PAIR_SPLIT = prove_by_refinement( + `!x (y:A#B). (x = y) <=> ((FST x = FST y) /\ (SND x = SND y))` , +(* {{{ proof *) + [ + MESON_TAC[FST;SND;PAIR]; + ]);; +(* }}} *) + +let single_inter = prove_by_refinement( + `!(a:A) U. ( ~({a} INTER U = EMPTY) <=> U a)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[INSERT;INTER;EMPTY_EXISTS ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inters_inter = prove_by_refinement( + `!(X:A->bool) Y. (X INTER Y) = (INTERS {X,Y})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `{X,Y} Y` SUBGOAL_TAC; + REWRITE_TAC[INSERT ]; + DISCH_TAC; + USE 0 (MATCH_MP delete_inters); + ASM_REWRITE_TAC[DELETE_INSERT; ]; + COND_CASES_TAC; + ASM_REWRITE_TAC[INTER;]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let unions_delete_choice = prove_by_refinement( + `!(A:(A->bool)->bool). ~(A =EMPTY) ==> + (UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A))`, + (* {{{ proof *) + [ + REWRITE_TAC[]; + DISCH_ALL_TAC; + REWRITE_TAC[UNIONS;UNION;DELETE ]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC; + IMATCH_MP_TAC (INR CHOICE_DEF ); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let image_delete_choice = prove_by_refinement( + `!(A:(A->bool)) (f:A->B). ~(A= EMPTY) ==> + (IMAGE f A = + ((IMAGE f (A DELETE CHOICE A)) UNION {(f (CHOICE A))}))`, + (* {{{ proof *) + [ + REWRITE_TAC[]; + DISCH_ALL_TAC; + REWRITE_TAC[IMAGE;UNION;DELETE]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INSERT ]; + TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC; + IMATCH_MP_TAC (INR CHOICE_DEF ); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let UNIONS_UNION = prove_by_refinement( + `!(A:(A->bool)->bool) B. + UNIONS (A UNION B) = (UNIONS A) UNION (UNIONS B)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[UNIONS;UNION]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* reals *) + +let half_pos = prove_by_refinement( + `!x. (&.0 < x) ==> (&.0 < x/(&.2)) /\ (x/(&.2)) < x`, + (* {{{ proof *) + [ + MESON_TAC[REAL_LT_HALF2;REAL_LT_HALF1]; + ]);; + (* }}} *) + +(* topology *) +let convex_inter = prove_by_refinement( + `!S T. (convex S) /\ (convex T) ==> (convex (S INTER T))`, + (* {{{ proof *) + + [ + REWRITE_TAC[convex;mk_segment;INTER;SUBSET_INTER ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPEL_THEN [`x`;`y`] (USE 0 o ISPECL); + REWR 0; + TYPEL_THEN [`x`;`y`] (USE 1 o ISPECL); + REWR 1; + ]);; + + (* }}} *) + +let closed_inter2 = prove_by_refinement( + `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==> + (closed_ U (A INTER B))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[inters_inter]; + IMATCH_MP_TAC closed_inter ; + ASM_REWRITE_TAC[INR INSERT;EMPTY_EXISTS ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let closure_univ = prove_by_refinement( + `!U (X:A->bool). ~(X SUBSET UNIONS U) ==> (closure U X = UNIV)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[closure;closed]; + TYPE_THEN `{B | (B SUBSET UNIONS U /\ open_ U (UNIONS U DIFF B)) /\ X SUBSET B} = EMPTY ` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 1 (REWRITE_RULE[EMPTY_EXISTS ]); + CHO 1; + ASM_MESON_TAC[SUBSET_TRANS]; + DISCH_THEN_REWRITE; + ]);; + + (* }}} *) + +let closure_inter = prove_by_refinement( + `!(X:A->bool) Y U. + (topology_ U) + ==> ((closure U (X INTER Y) SUBSET + (closure U X) INTER closure U Y))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `X SUBSET UNIONS U` ASM_CASES_TAC THEN (TYPE_THEN `Y SUBSET UNIONS U` ASM_CASES_TAC) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t]) closure_univ) THEN ( IMATCH_MP_TAC closure_subset ); + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC closed_inter2; + ASM_SIMP_TAC[closure_closed ]; + REWRITE_TAC[INTER;ISUBSET ]; + ASM_MESON_TAC[subset_closure;ISUBSET]; + ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ]; + ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ]; + ]);; + + (* }}} *) + +let closure_open_ball = prove_by_refinement( + `!(X:A->bool) d Z . + ((metric_space(X,d)) /\ (Z SUBSET X)) ==> + (({a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))} + = closure (top_of_metric(X,d)) Z))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `topology_ (top_of_metric(X,d)) /\ (Z SUBSET (UNIONS (top_of_metric (X,d))))` SUBGOAL_TAC; + ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions]; + DISCH_TAC; + USE 2 (MATCH_MP closure_open); + TYPE_THEN `{a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}` (USE 2 o SPEC); + ASM_REWRITE_TAC[]; + CONJ_TAC; (* 1st prong *) + REWRITE_TAC[ISUBSET;]; + GEN_TAC; + DISCH_TAC; + DISCH_ALL_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_MESON_TAC[SUBSET;IN;INR open_ball_nonempty]; + CONJ_TAC; + REWRITE_TAC[closed;open_DEF ]; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball ;]; + DISCH_ALL_TAC; + TYPE_THEN `&.1` (USE 3 o SPEC); + UND 3; + REDUCE_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + MESON_TAC[]; + ASM_SIMP_TAC[top_of_metric_nbd]; + REWRITE_TAC[IN;DIFF; ISUBSET ]; + CONJ_TAC; + MESON_TAC[]; + DISCH_ALL_TAC; + LEFT 4 "r"; + CHO 4; + USE 4 (REWRITE_RULE[NOT_IMP]); + TYPE_THEN `r` EXISTS_TAC; + NAME_CONFLICT_TAC; + ASM_REWRITE_TAC[NOT_IMP]; + DISCH_ALL_TAC; + AND 4; + SUBCONJ_TAC; + UND 5; + REWRITE_TAC[open_ball; ]; + MESON_TAC[]; + DISCH_TAC; + LEFT_TAC "r'"; + JOIN 0 5; + USE 0 (MATCH_MP (INR open_ball_center)); + CHO 0; + TYPE_THEN `r'` EXISTS_TAC; + UND 0; + UND 4; + MESON_TAC[SUBSET;IN]; + (* final prong *) + (* fp *) + ONCE_REWRITE_TAC[TAUT (`a /\ b ==> e <=> (a /\ ~e ==> ~b)`)]; + REWRITE_TAC[open_DEF;EMPTY_EXISTS ]; + DISCH_ALL_TAC; + CHO 4; + USE 4 (REWRITE_RULE[INTER ]); + AND 4; + UND 3; + ASM_SIMP_TAC[top_of_metric_nbd;]; + DISCH_ALL_TAC; + TSPEC `u` 6; + REWR 6; + CHO 6; + TSPEC `r` 4; + REWR 4; + CHO 4; + TYPE_THEN `z` EXISTS_TAC; + REWRITE_TAC[INTER]; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let closed_union = prove_by_refinement( + `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==> + (closed_ U (A UNION B))`, + (* {{{ proof *) + [ + REWRITE_TAC[closed;open_DEF;union_subset ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `UNIONS U DIFF (A UNION B) = (UNIONS U DIFF A) INTER (UNIONS U DIFF B)` SUBGOAL_TAC; + REWRITE_TAC[DIFF;UNION;IN;INTER;IN_ELIM_THM']; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[SUBSET;IN]; + DISCH_THEN (fun t->REWRITE_TAC[t]); + ASM_MESON_TAC[top_inter]; + ]);; + (* }}} *) + +(* euclid *) +let euclid_scale0 = prove_by_refinement( + `!x. (&.0 *# x) = (euclid0)`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid_scale;euclid0]; + REDUCE_TAC; + ]);; + (* }}} *) + +let euclid_minus0 = prove_by_refinement( + `!x. (x - euclid0) = x`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid0;euclid_minus]; + REDUCE_TAC; +(*** Changed by JRH since MESON no longer automatically applies extensionality + MESON_TAC[]; + ***) + REWRITE_TAC[FUN_EQ_THM] + ]);; + (* }}} *) + +let norm_scale2 = prove_by_refinement( + `!t x. (euclidean x) ==> (norm (t *# x) = abs(t) * norm x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 0 (MATCH_MP norm_scale); + TYPEL_THEN [`t`;`&.0`] (USE 0 o ISPECL); + USE 0 (REWRITE_RULE[euclid_scale0;d_euclid;euclid_minus0]); + UND 0; + REDUCE_TAC; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* half-spaces *) +(* ------------------------------------------------------------------ *) + +let closed_half_space = jordan_def `closed_half_space n v b = + {z | (euclid n z) /\ (dot v z <=. b) }`;; + +let open_half_space = jordan_def `open_half_space n v b = + {z | (euclid n z) /\ (dot v z <. b) }`;; + +let hyperplane = jordan_def `hyperplane n v b = + {z | (euclid n z) /\ (dot v z = b) }`;; + +let closed_half_space_euclid = prove_by_refinement( + `!n v b. (closed_half_space n v b SUBSET euclid n)`, + (* {{{ proof *) + [ + REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let open_half_space_euclid = prove_by_refinement( + `!n v b. (open_half_space n v b SUBSET euclid n)`, + (* {{{ proof *) + [ + REWRITE_TAC[open_half_space;SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let hyperplane_euclid = prove_by_refinement( + `!n v b. (hyperplane n v b SUBSET euclid n)`, + (* {{{ proof *) + [ + REWRITE_TAC[hyperplane;SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let closed_half_space_scale = prove_by_refinement( + `!n v b r. ( &.0 < r) /\ (euclid n v) ==> + (closed_half_space n (r *# v) (r * b) = closed_half_space n v b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[closed_half_space]; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; + IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); + DISCH_ALL_TAC; + JOIN 1 2; + USE 1 (MATCH_MP dot_scale); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[dot_scale]; + IMATCH_MP_TAC REAL_LE_LMUL_EQ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let open_half_space_scale = prove_by_refinement( + `!n v b r. ( &.0 < r) /\ (euclid n v) ==> + (open_half_space n (r *# v) (r * b) = open_half_space n v b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[open_half_space]; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; + IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); + DISCH_ALL_TAC; + JOIN 1 2; + USE 1 (MATCH_MP dot_scale); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[dot_scale]; + IMATCH_MP_TAC REAL_LT_LMUL_EQ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let hyperplane_scale = prove_by_refinement( + `!n v b r. ~( r = &.0) /\ (euclid n v) ==> + (hyperplane n (r *# v) (r * b)= hyperplane n v b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[hyperplane]; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM']; + IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); + DISCH_ALL_TAC; + JOIN 1 2; + USE 1 (MATCH_MP dot_scale); + ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL ]; + ]);; + (* }}} *) + +let open_half_space_diff = prove_by_refinement( + `!n v b. (euclid n v) ==> + ((euclid n) DIFF (open_half_space n v b) = + (closed_half_space n (-- v) (--. b)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[open_half_space;closed_half_space;DIFF ]; + REWRITE_TAC[IN; IN_ELIM_THM']; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM;dot_neg ]; + GEN_TAC; + IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); + DISCH_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let closed_half_space_diff = prove_by_refinement( + `!n v b. (euclid n v) ==> + ((euclid n) DIFF (closed_half_space n v b) = + (open_half_space n (-- v) (--. b)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[open_half_space;closed_half_space;DIFF ]; + REWRITE_TAC[IN; IN_ELIM_THM']; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM;dot_neg ]; + GEN_TAC; + IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); + DISCH_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let closed_half_space_inter = prove_by_refinement( + `!n v b. (euclid n v) ==> + (closed_half_space n v b INTER closed_half_space n (-- v) (--b) = + hyperplane n v b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[closed_half_space;INTER;IN;hyperplane;IN_ELIM_THM' ]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + REWRITE_TAC[GSYM CONJ_ASSOC ]; + IMATCH_MP_TAC (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`); + DISCH_TAC; + ASM_REWRITE_TAC[dot_neg ]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let open_half_space_convex = prove_by_refinement( + `!n v b. (euclid n v) ==> (convex (open_half_space n v b))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[convex;open_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CHO 5; + UND 5; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + KILL 7; + ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;]; + TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC; + ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ]; + DISCH_THEN (fun t -> REWRITE_TAC[t]); + ASM_CASES_TAC `&.0 = a`; + EXPAND_TAC "a"; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`]; + IMATCH_MP_TAC REAL_LTE_ADD2; + CONJ_TAC; + MP_TAC (REAL_ARITH `~(&.0 = a) /\ (&.0 <= a) ==> (&.0 < a)`); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LT_LMUL_EQ]; + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; + IMATCH_MP_TAC REAL_LE_LMUL; + UND 6; + UND 4; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let closed_half_space_convex = prove_by_refinement( + `!n v b. (euclid n v) ==> (convex (closed_half_space n v b))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[convex;closed_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CHO 5; + UND 5; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + KILL 7; + ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;]; + TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC; + ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ]; + DISCH_THEN (fun t -> REWRITE_TAC[t]); + GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`]; + IMATCH_MP_TAC REAL_LE_ADD2; + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; + USE 6 (MATCH_MP (REAL_ARITH `(a <= &.1) ==> (&.0 <= (&1-a))`)); + CONJ_TAC THEN (IMATCH_MP_TAC REAL_LE_LMUL) THEN ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let hyperplane_convex = prove_by_refinement( + `!n v b. (euclid n v) ==> convex(hyperplane n v b)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM closed_half_space_inter]; + IMATCH_MP_TAC convex_inter; + ASM_MESON_TAC[closed_half_space_convex;neg_dim ]; + ]);; + + (* }}} *) + +let open_half_space_open = prove_by_refinement( + `!n v b. (euclid n v) ==> + (top_of_metric(euclid n,d_euclid)) (open_half_space n v b)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[top_of_metric_nbd;metric_euclid;SUBSET;IN;IN_ELIM_THM' ]; + REWRITE_TAC[open_half_space;open_ball;IN_ELIM_THM' ]; + CONJ_TAC ; + MESON_TAC[]; + DISCH_ALL_TAC; + ASM_CASES_TAC `v = euclid0`; + UND 2; + ASM_REWRITE_TAC[dot_lzero]; + MESON_TAC[]; + TYPE_THEN `(b - (dot v a))/(norm v)` EXISTS_TAC; + TYPE_THEN `&.0 < (norm v)` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `&0 <= x /\ (~(x = &.0)) ==> (&.0 < x)`); + ASM_MESON_TAC[norm;norm_nonneg;dot_nonneg;SQRT_EQ_0;dot_zero]; + DISCH_ALL_TAC; + SUBCONJ_TAC; + ASM_SIMP_TAC[REAL_LT_RDIV_0]; + UND 2; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(x:num->real) = a + (x - a)` SUBGOAL_TAC; + REWRITE_TAC[euclid_plus;euclid_minus]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC; + REAL_ARITH_TAC; + DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]); + TYPE_THEN `dot v (a + (x - a)) = (dot v a) + (dot v (x-a))` SUBGOAL_TAC; + IMATCH_MP_TAC dot_linear2; + TYPE_THEN `n` EXISTS_TAC; + ASM_SIMP_TAC[euclid_sub_closure]; + DISCH_THEN (fun t -> REWRITE_TAC[t]); + IMATCH_MP_TAC (REAL_ARITH `(?d. (b<=d) /\ d < C - a) ==> a +b < C`); + TYPE_THEN `(norm v)*. (d_euclid a x)` EXISTS_TAC; + CONJ_TAC; + ASSUME_TAC metric_euclid; + TYPE_THEN `n` (USE 9 o SPEC); + COPY 7; + JOIN 6 7; + JOIN 9 6; + USE 6 (MATCH_MP metric_space_symm); + ASM_REWRITE_TAC[]; + REWRITE_TAC[d_euclid]; + IMATCH_MP_TAC (REAL_ARITH `||. u <=. C ==> (u <=. C)`); + IMATCH_MP_TAC cauchy_schwartz; + ASM_MESON_TAC[euclidean;euclid_sub_closure]; + UND 8; + ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let closed_half_space_closed = prove_by_refinement( + `!n v b. (euclid n v) ==> + closed_ (top_of_metric(euclid n,d_euclid)) + (closed_half_space n v b)`, + (* {{{ proof *) + [ + REWRITE_TAC[closed;open_DEF ]; + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;closed_half_space_diff;open_half_space_open;euclid_neg_closure ]; + REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let hyperplane_closed = prove_by_refinement( + `!n v b. (euclid n v) ==> + closed_ (top_of_metric(euclid n,d_euclid)) + (hyperplane n v b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM closed_half_space_inter]; + IMATCH_MP_TAC closed_inter2; + ASM_MESON_TAC[euclid_neg_closure;top_of_metric_top ;metric_euclid ;closed_half_space_closed;]; + ]);; + (* }}} *) + +let closure_half_space = prove_by_refinement( + `!n v b. (euclid n v) /\ (~(v = euclid0)) ==> + ((closure (top_of_metric(euclid n,d_euclid)) + (open_half_space n v b)) = (closed_half_space n v b))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC closure_subset; + ASM_SIMP_TAC [top_of_metric_top;metric_euclid]; + ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;closed_half_space_closed]; + REWRITE_TAC[SUBSET;IN;closed_half_space;open_half_space;IN_ELIM_THM' ]; + MESON_TAC[REAL_ARITH `a < b ==> a <=. b`]; + ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;open_half_space_euclid]; + REWRITE_TAC[open_half_space;closed_half_space;SUBSET;IN;IN_ELIM_THM']; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `t = ((r/(&.2))/(norm v ))` ABBREV_TAC; + TYPE_THEN `u = x - (t)*# v` ABBREV_TAC; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `&.0 < (dot v v)` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 < x)`); + REWRITE_TAC[dot_nonneg]; + ASM_MESON_TAC[euclidean;dot_zero_euclidean ]; + DISCH_TAC; + TYPE_THEN `&.0 < t` SUBGOAL_TAC; + EXPAND_TAC "t"; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + REWRITE_TAC[norm]; + IMATCH_MP_TAC SQRT_POS_LT; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBCONJ_TAC; + CONJ_TAC; + ASM_MESON_TAC[euclid_sub_closure ;euclid_scale_closure ]; + TYPE_THEN `dot v u = (dot v x - t* (dot v v))` SUBGOAL_TAC; + EXPAND_TAC "u"; + ASM_MESON_TAC[dot_minus_linear2;dot_scale2;euclid_sub_closure;euclid_scale_closure]; + DISCH_THEN (fun t->REWRITE_TAC[t]); + IMATCH_MP_TAC (REAL_ARITH `(a <= b) /\ (&.0 < C) ==> (a - C < b)`); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LT_MUL; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[open_ball;IN_ELIM_THM' ]; + EXPAND_TAC "u"; + REWRITE_TAC[d_euclid]; + TYPE_THEN `euclid_minus x (euclid_minus x (t *# v)) = ( t) *# v` SUBGOAL_TAC; + REWRITE_TAC[euclid_minus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC; + REAL_ARITH_TAC ; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + TYPE_THEN `norm (t *# v) = t * norm v` SUBGOAL_TAC; + ASM_MESON_TAC[euclidean;norm_scale2;ABS_REFL;REAL_ARITH `&.0 < t ==> &.0 <= t`]; + DISCH_THEN (fun t -> REWRITE_TAC[t]); + EXPAND_TAC "t"; + TYPE_THEN `((r / &2) / norm v) * norm v = r/(&.2)` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_DIV_RMUL; + REWRITE_TAC[norm]; + ASM_MESON_TAC[SQRT_POS_LT;REAL_ARITH `&.0 < x ==> ~(x = &.0)`]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ASM_MESON_TAC[half_pos]; + ]);; + + (* }}} *) + + +let subset_of_closure = prove_by_refinement( + `!(A:A->bool) B U. (topology_ U) /\ (A SUBSET B) ==> + (closure U A SUBSET closure U B)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(A SUBSET (UNIONS U))` ASM_CASES_TAC; + TYPE_THEN `(B SUBSET (UNIONS U))` ASM_CASES_TAC; + IMATCH_MP_TAC closure_subset; + ASM_REWRITE_TAC[]; + WITH 0 (MATCH_MP subset_closure); + USE 4 (ISPEC `B:A->bool`); + JOIN 1 4; + USE 1 (MATCH_MP SUBSET_TRANS); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC [closure_closed;]; + USE 3 (MATCH_MP closure_univ); + ASM_REWRITE_TAC[]; + TYPE_THEN `~(B SUBSET UNIONS U)` SUBGOAL_TAC; + UND 2; + UND 1; + REWRITE_TAC[ISUBSET]; + MESON_TAC[]; + DISCH_TAC; + USE 2 (MATCH_MP closure_univ); + USE 3 (MATCH_MP closure_univ); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let closure_union = prove_by_refinement( + `!(A:A->bool) B U. (topology_ U) ==> + (closure U (A UNION B) = (closure U A) UNION (closure U B))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `A SUBSET UNIONS U` ASM_CASES_TAC THEN (TYPE_THEN `B SUBSET UNIONS U` ASM_CASES_TAC ) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t;UNION_UNIV;SUBSET_UNIV;INTER_UNIV]) closure_univ) THEN TRY (IMATCH_MP_TAC closure_univ) THEN TRY (UNDISCH_FIND_TAC `(~)`); + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC closure_subset; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[closed_union; closure_closed]; + REWRITE_TAC[union_subset]; + TYPE_THEN `(A SUBSET closure U A) /\ (B SUBSET closure U B)` SUBGOAL_TAC; + ASM_SIMP_TAC[subset_closure]; + REWRITE_TAC[UNION;ISUBSET ]; + ASM_MESON_TAC[]; + REWRITE_TAC[union_subset]; + CONJ_TAC THEN IMATCH_MP_TAC subset_of_closure THEN ASM_REWRITE_TAC[ISUBSET;UNION ] THEN (MESON_TAC []); + REWRITE_TAC [UNION;SUBSET; ]; + MESON_TAC[]; + REWRITE_TAC[UNION;SUBSET]; + MESON_TAC[]; + REWRITE_TAC[UNION;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let closure_empty = prove_by_refinement( + `!U. (topology_ U) ==> (closure U (EMPTY:A->bool) = EMPTY)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + ASM_MESON_TAC[SUBSET_EMPTY;closure_subset;empty_closed]; + ]);; + (* }}} *) + +let closure_unions = prove_by_refinement( + `!(A:(A->bool)->bool) U. (topology_ U) /\ (FINITE A) ==> + (closure U (UNIONS A) = UNIONS (IMAGE (closure U) A))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + TYPE_THEN `n = CARD A` ABBREV_TAC; + UND 0; + TYPE_THEN `A` (fun t-> SPEC_TAC (t,t)); + TYPE_THEN `n` (fun t-> SPEC_TAC (t,t)); + INDUCT_TAC; + DISCH_ALL_TAC; + TYPE_THEN `A HAS_SIZE 0` SUBGOAL_TAC; + ASM_REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[HAS_SIZE_0]; + DISCH_THEN_REWRITE; + ASM_SIMP_TAC [closure_empty;IMAGE_CLAUSES]; + DISCH_ALL_TAC; + TYPE_THEN `~(A HAS_SIZE 0)` SUBGOAL_TAC; + ASM_REWRITE_TAC[HAS_SIZE]; + ARITH_TAC; + TYPE_THEN `A` (MP_TAC o ((C ISPEC) CARD_DELETE_CHOICE)); + REWRITE_TAC[HAS_SIZE_0]; + DISCH_ALL_TAC; + REWR 5; + USE 5 (CONV_RULE REDUCE_CONV ); + TYPE_THEN `(A DELETE CHOICE A)` (USE 0 o ISPEC); + USE 0 (REWRITE_RULE[FINITE_DELETE]); + REWR 0; + TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC; + IMATCH_MP_TAC (INR CHOICE_DEF); + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A)` SUBGOAL_TAC; + IMATCH_MP_TAC unions_delete_choice; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `(IMAGE (closure U) A) = (IMAGE (closure U) (A DELETE CHOICE A) UNION {(closure U (CHOICE A))})` SUBGOAL_TAC; + IMATCH_MP_TAC image_delete_choice ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_SIMP_TAC[closure_union]; + REWRITE_TAC[UNIONS_UNION]; + ]);; + (* }}} *) + +let metric_space_zero2 = prove_by_refinement( + `!X d (x:A) y. (metric_space(X,d) /\ (X x) /\ (X y)) ==> + ((d x y = &.0) <=> (x = y))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[metric_space]); + TYPEL_THEN [`x`;`y`;`x`] (USE 0 o ISPECL); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let d_euclid_zero = prove_by_refinement( + `!n x y. (euclid n x) /\ (euclid n y) ==> + ((d_euclid x y = &.0) <=> (x = y))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPEL_THEN [`euclid n`;`d_euclid`;`x`;`y`] (ASSUME_TAC o (C ISPECL) metric_space_zero2); + ASM_MESON_TAC[metric_euclid]; + ]);; + (* }}} *) + +let d_euclid_pos2 = prove_by_refinement( + `!x y n. ~(x = y) /\ euclid n x /\ euclid n y ==> &0 <. d_euclid x y`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC (REAL_ARITH `&.0 <= x /\ ~(x = &.0) ==> (&.0 < x)`); + ASM_MESON_TAC[d_euclid_pos;d_euclid_zero]; + ]);; + (* }}} *) + +let euclid_segment = prove_by_refinement( + `!n x y. (euclid n x) /\ + (!t. (&.0 <. t) /\ (t <=. &.1) ==> + (euclid n (t *# x + (&.1 - t)*# y))) + ==> + (euclid n y)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `t = &.1/(&.2)` ABBREV_TAC; + TYPE_THEN `y = ((&.2) *# ((t *# x) + (&.1 - t)*# y)) - x` SUBGOAL_TAC; + REWRITE_TAC[euclid_minus;euclid_scale;euclid_plus]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC ; + REWRITE_TAC[REAL_ADD_LDISTRIB]; + REWRITE_TAC[REAL_MUL_ASSOC;REAL_SUB_LDISTRIB ]; + EXPAND_TAC "t"; + SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&.2 = &.0)`]; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + TYPE_THEN `t` (USE 1 o SPEC); + TYPE_THEN `v = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC; + KILL 3; + TYPE_THEN `&0 < t /\ t <= &1` SUBGOAL_TAC; + EXPAND_TAC "t"; + CONJ_TAC ; + IMATCH_MP_TAC REAL_LT_DIV; + REAL_ARITH_TAC; + IMATCH_MP_TAC REAL_LE_LDIV; + REAL_ARITH_TAC; + DISCH_TAC; + REWR 1; + ASM_SIMP_TAC[euclid_sub_closure;euclid_scale_closure]; + ]);; + (* }}} *) + +let euclid_xy = prove_by_refinement( + `!n x y. (!t . (&.0 < t) /\ (t < &.1) ==> + (euclid n (t *# x + (&.1-t)*# y))) ==> (euclid n x) /\ (euclid n y)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `u = (&.1/(&.3))*# x + (&.1 - (&.1/(&.3))) *# y` ABBREV_TAC; + TYPE_THEN `v = (&.2/(&.3))*# x + (&.1 - (&.2/(&.3))) *# y` ABBREV_TAC; + TYPE_THEN `euclid n u` SUBGOAL_TAC; + EXPAND_TAC "u"; + UND 0; + DISCH_THEN IMATCH_MP_TAC ; + CONV_TAC REAL_RAT_REDUCE_CONV; + DISCH_TAC; + TYPE_THEN `euclid n v` SUBGOAL_TAC; + EXPAND_TAC "v"; + UND 0; + DISCH_THEN IMATCH_MP_TAC ; + CONV_TAC REAL_RAT_REDUCE_CONV; + DISCH_TAC; + TYPE_THEN `x = (&.2)*# v - (&.1) *# u` SUBGOAL_TAC; + EXPAND_TAC "u"; + EXPAND_TAC "v"; + REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + DISCH_ALL_TAC; + BETA_TAC; + TYPE_THEN `a = x x'` ABBREV_TAC ; + TYPE_THEN `b= y x'` ABBREV_TAC ; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure]; + TYPE_THEN `y = (&.2)*# u - (&.1) *# v` SUBGOAL_TAC; + EXPAND_TAC "u"; + EXPAND_TAC "v"; + REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + DISCH_ALL_TAC; + BETA_TAC; + TYPE_THEN `a = x x'` ABBREV_TAC ; + TYPE_THEN `b= y x'` ABBREV_TAC ; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure]; + ]);; + (* }}} *) + + +let closure_segment = prove_by_refinement( + `!C n x y. (C SUBSET (euclid n)) /\ + (!t. (&.0 < t) /\ (t < &.1) ==> (C (t *# x + (&.1-t)*# y))) ==> + (closure (top_of_metric(euclid n,d_euclid)) C y)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `euclid n x /\ (euclid n y)` SUBGOAL_TAC; + IMATCH_MP_TAC euclid_xy; + ASM_MESON_TAC[ISUBSET]; + DISCH_ALL_TAC; + (* case x=y *) + TYPE_THEN `x = y` ASM_CASES_TAC ; + TYPE_THEN `C SUBSET (closure (top_of_metric (euclid n,d_euclid)) C)` SUBGOAL_TAC ; + IMATCH_MP_TAC subset_closure; + ASM_SIMP_TAC [top_of_metric_top;metric_euclid]; + REWRITE_TAC[ISUBSET]; + TYPE_THEN `C x` SUBGOAL_TAC; + REWR 1; + USE 1 (REWRITE_RULE[trivial_lin_combo]); + TSPEC `&.1/(&.2)` 1; + USE 1 (CONV_RULE (REAL_RAT_REDUCE_CONV)); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* now ~(x=y) *) + TYPE_THEN `&.0 < d_euclid x y` SUBGOAL_TAC; + ASM_MESON_TAC[d_euclid_pos2]; + DISCH_TAC; + ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid]; + DISCH_ALL_TAC; + REWRITE_TAC[open_ball]; + (* ## *) + TYPE_THEN `?t. (&.0 <. t) /\ (t <. &.1) /\ (t *. (d_euclid x y) <. r)` SUBGOAL_TAC; + TYPE_THEN `(&.1/(&.2))*. d_euclid x y < r` ASM_CASES_TAC; + TYPE_THEN `(&.1/(&.2))` EXISTS_TAC; + CONV_TAC (REAL_RAT_REDUCE_CONV); + ASM_REWRITE_TAC[]; + TYPE_THEN `(r/(&.2))/(d_euclid x y)` EXISTS_TAC; + ASM_SIMP_TAC[REAL_LT_DIV;REAL_LT_HALF1]; + CONJ_TAC; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + REDUCE_TAC; + TYPE_THEN `s = d_euclid x y ` ABBREV_TAC; + ineq_lt_tac `r/(&.2) + ( (&1/(&2))*s - r)*(&1/(&2)) + (s)*(&3/(&4)) = s`; + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ;REAL_LT_RDIV;half_pos]; + DISCH_TAC; + CHO 7; + TYPE_THEN `t` (USE 1 o SPEC); + REWR 1; + TYPE_THEN `z = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC ; + TYPE_THEN `z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + EXPAND_TAC "z"; + ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure]; + DISCH_TAC; + TYPE_THEN `y = (t *# y) + ((&.1 - t)*# y)` SUBGOAL_TAC; + ASM_MESON_TAC[trivial_lin_combo]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); + EXPAND_TAC "z"; + TYPE_THEN `euclid n (t*# y) /\ (euclid n (t *# x)) /\ (euclid n ((&.1-t)*# y))` SUBGOAL_TAC; + ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure]; + DISCH_TAC; + USE 10 (MATCH_MP metric_translate); + KILL 8; + ASM_REWRITE_TAC[]; + TYPE_THEN `d_euclid (t *# y) (t *# x) = d_euclid (t *# x) (t *# y)` SUBGOAL_TAC; + ASM_MESON_TAC [ISPEC `euclid n` metric_space_symm; euclid_scale_closure;metric_euclid]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); + JOIN 2 3; + USE 2 (MATCH_MP norm_scale_vec); + TSPEC `t` 2; + ASM_REWRITE_TAC[]; + AND 7; + USE 7 (MATCH_MP (REAL_ARITH `&.0 < t ==> (&.0 <=. t)`)); + USE 7 (REWRITE_RULE[GSYM ABS_REFL]); + ASM_REWRITE_TAC []; + ]);; + + (* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* POINTS *) +(* ------------------------------------------------------------------ *) + + +let point = jordan_def `point z = + (FST z) *# (dirac_delta 0) + (SND z) *# (dirac_delta 1)`;; + +let dest_pt = jordan_def `dest_pt p = + @u. p = point u`;; + +let point_xy = prove_by_refinement( + `!x y. point(x,y) = x *# (dirac_delta 0) + y *# (dirac_delta 1)`, + (* {{{ proof *) + [ + REWRITE_TAC[point;]; + ]);; + (* }}} *) + +let coord01 = prove_by_refinement( + `!p. (point p 0 = FST p) /\ (point p 1 = SND p)`, + (* {{{ proof *) + [ + REWRITE_TAC[point;euclid_plus;euclid_scale ]; + REWRITE_TAC[dirac_delta;ARITH_RULE `~(1=0) /\ ~(0=1)`]; + REDUCE_TAC ; + ]);; + (* }}} *) + +let euclid_point = prove_by_refinement( + `!p. euclid 2 (point p)`, + (* {{{ proof *) + [ + REWRITE_TAC[point;euclid]; + REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta ]; + DISCH_ALL_TAC; + USE 0 (MATCH_MP (ARITH_RULE `(2 <=| m) ==> (~(0=m) /\ (~(1=m)))`)); + ASM_REWRITE_TAC[]; + REDUCE_TAC ; + ]);; + (* }}} *) + +let point_inj = prove_by_refinement( + `!p q. (point p = point q) <=> (p = q)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + EQ_TAC ; + DISCH_TAC ; + WITH 0 (fun t -> AP_THM t `0`); + USE 0 (fun t-> AP_THM t `1`); + UND 0; + UND 1; + REWRITE_TAC[coord01;]; + ASM_MESON_TAC[PAIR]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let point_onto = prove_by_refinement( + `!v. (euclid 2 v) ==> ?p. (v = point p)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(v 0 ,v 1)` EXISTS_TAC; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC ; + REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta]; + MP_TAC (ARITH_RULE `(0 = x) \/ ( 1 = x) \/ (2 <= x)`); + REP_CASES_TAC; + WITH 1 (MATCH_MP (ARITH_RULE `(0=x) ==> ~(1=x)`)); + ASM_REWRITE_TAC[]; + EXPAND_TAC "x"; + REDUCE_TAC; + WITH 1 (MATCH_MP (ARITH_RULE `(1=x) ==> ~(0=x)`)); + ASM_REWRITE_TAC[]; + EXPAND_TAC "x"; + REDUCE_TAC; + WITH 1 (MATCH_MP (ARITH_RULE `(2 <=| x) ==> (~(0=x)/\ ~(1=x))`)); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_MESON_TAC[euclid]; + ]);; + (* }}} *) + +let dest_pt_point = prove_by_refinement( + `!p. dest_pt(point p) = p`, + (* {{{ proof *) + [ + REWRITE_TAC[dest_pt]; + DISCH_ALL_TAC; + SELECT_TAC; + ASM_MESON_TAC[point_inj]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let point_dest_pt = prove_by_refinement( + `!v. (euclid 2 v) <=> (point (dest_pt v) = v)`, + (* {{{ proof *) + [ + GEN_TAC; + EQ_TAC; + REWRITE_TAC[dest_pt]; + DISCH_ALL_TAC; + SELECT_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[point_onto]; + ASM_MESON_TAC[euclid_point]; + ]);; + (* }}} *) + +let Q_POINT = prove_by_refinement( + `!Q z. (?u v. (point z = point (u,v)) /\ (Q z u v)) <=> (Q z (FST z) (SND z))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[point_inj]; + EQ_TAC; + DISCH_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `FST z` EXISTS_TAC; + TYPE_THEN `SND z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let pointI = jordan_def `pointI p = + point(real_of_int (FST p),real_of_int (SND p))`;; + +let convex_pointI = prove_by_refinement( + `!p. (convex {(pointI p)})`, + (* {{{ proof *) + + [ + REWRITE_TAC[convex;mk_segment;INSERT;IN_ELIM_THM';SUBSET; ]; + REWRITE_TAC[IN;EMPTY]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[trivial_lin_combo]; + DISCH_ALL_TAC; + CHO 2; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let point_closure = prove_by_refinement( + `!p q a b. (?r. (a *# (point p) + (b *# (point q)) = (point r)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `euclid 2 (a *# (point p) + (b *# (point q)))` SUBGOAL_TAC; + IMATCH_MP_TAC euclid_add_closure; + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN REWRITE_TAC [euclid_point]; + MESON_TAC[point_onto]; + ]);; + (* }}} *) + +let point_scale = prove_by_refinement( + `!a u v. a *# (point (u,v)) = point(a* u,a* v)`, + (* {{{ proof *) + [ + REWRITE_TAC[point;euclid_scale;euclid_plus ]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let point_add = prove_by_refinement( + `!u v u' v'. (point(u,v))+(point(u',v')) = (point(u+u',v+v'))`, + (* {{{ proof *) + [ + REWRITE_TAC[point;euclid_plus;euclid_scale]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* the FLOOR function *) +(* ------------------------------------------------------------------ *) + + +let floor = jordan_def `floor x = + @m. (real_of_int m <=. x /\ (x < (real_of_int (m + &:1))))`;; + +let int_suc = prove_by_refinement( + `!m. (real_of_int (m + &:1) = real_of_int m + &.1)`, + (* {{{ proof *) + [ + REWRITE_TAC[int_add_th;INT_NUM_REAL ]; + ]);; + (* }}} *) + +let floor_ineq = prove_by_refinement( + `!x. (real_of_int (floor x) <=. x) /\ (x <. (real_of_int (floor x)) + &.1)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[floor]; + SELECT_TAC; + REWRITE_TAC[int_suc]; + MP_TAC (SPEC `&.1` REAL_ARCH_LEAST); + REDUCE_TAC; + DISCH_TAC; + ASM_CASES_TAC `&.0 <= x`; + TSPEC `x` 1; + REWR 1; + CHO 1; + LEFT 0 "y"; + TSPEC `&:n` 0; + USE 0 (REWRITE_RULE[INT_NUM_REAL;int_add_th;REAL_OF_NUM_ADD ]); + ASM_MESON_TAC[]; + TSPEC `--. x` 1; + COPY 2; + IMP_REAL `~(&.0 <=. x) ==> (&.0 <=. (-- x))` 2; + REWR 1; + CHO 1; + LEFT 0 "y"; + ASM_CASES_TAC `&.n = --x`; + TSPEC `-- (&:n)` 0; + USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL;REAL_OF_NUM_ADD]); + JOIN 0 1; + USE 0 (REWRITE_RULE[ GSYM REAL_OF_NUM_ADD]); + PROOF_BY_CONTR_TAC; + UND 0; + UND 4; + REAL_ARITH_TAC ; + TSPEC `--: (&:(n+| 1))` 0; + JOIN 1 0; + USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL; GSYM REAL_OF_NUM_ADD;]); + JOIN 4 0; + PROOF_BY_CONTR_TAC; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let int_arch = prove_by_refinement( + `!m n. (n <=: m) /\ (m <: (n +: (&:1))) <=> (n = m)`, + (* {{{ proof *) + [ + REWRITE_TAC[int_lt;int_le;int_eq ;int_add_th;int_of_num_th ]; + DISCH_ALL_TAC; + EQ_TAC; + MP_TAC (SPEC `m:int` dest_int_rep); + DISCH_THEN (CHOOSE_THEN MP_TAC); + MP_TAC (SPEC `n:int` dest_int_rep); + DISCH_THEN (CHOOSE_THEN MP_TAC); + REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC `(/\)`)) THEN ( ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN REDUCE_TAC THEN TRY ARITH_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_int = prove_by_refinement( + `!m. (floor (real_of_int m) = m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `floor (real_of_int m) <=: m /\ (m <: (floor (real_of_int m)) + (&:1))` SUBGOAL_TAC; + REWRITE_TAC[int_le;int_lt;int_add_th ;int_of_num_th;floor_ineq ]; + REWRITE_TAC[int_arch ]; + ]);; + (* }}} *) + +let int_lt_suc_le = prove_by_refinement( + `!m n. m <: n + &:1 <=> m <=: n`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + MP_TAC (SPEC `m:int` dest_int_rep); + DISCH_THEN (CHOOSE_THEN MP_TAC); + MP_TAC (SPEC `n:int` dest_int_rep); + DISCH_THEN (CHOOSE_THEN MP_TAC); + REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC `(+:)`)) THEN ( ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN REDUCE_TAC THEN TRY ARITH_TAC; + REWRITE_TAC[int_le;int_lt;int_add_th;int_of_num_th]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_le = prove_by_refinement( + `!m x. (real_of_int m <=. x) <=> (m <=: (floor x))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + EQ_TAC; + DISCH_TAC; + REWRITE_TAC[int_le]; + REWRITE_TAC[GSYM int_le ;GSYM int_lt_suc_le;]; + REWRITE_TAC[int_lt ;int_add_th;int_of_num_th;]; + ASM_MESON_TAC[floor_ineq; REAL_LET_TRANS]; + REWRITE_TAC[int_le]; + MP_TAC (SPEC `x:real` floor_ineq); + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_lt = prove_by_refinement( + `!m x. (x < real_of_int m + &.1) <=> (floor x <=: m)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + EQ_TAC; + DISCH_TAC; + REWRITE_TAC[GSYM int_lt_suc_le ;]; + REWRITE_TAC[int_lt;int_add_th;int_of_num_th;]; + UND 0; + MP_TAC (SPEC `x:real` floor_ineq); + REAL_ARITH_TAC; + REWRITE_TAC[int_le;]; + MP_TAC (SPEC `x:real` floor_ineq); + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_mono = prove_by_refinement( + `!x y. (x <=. y) ==> (floor x <=: floor y)`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM floor_le]; + REP_GEN_TAC; + MP_TAC (SPEC `x:real` floor_ineq); + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_level = prove_by_refinement( + `!m x. ((&.0 <=. x) /\ (x <. &.1)) ==> (floor (real_of_int(m) + x) = m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + SUBGOAL_TAC `!a b. (b <=: a /\ ~(b <: a)) ==> (a = b)`; + REWRITE_TAC[int_le;int_lt;int_eq]; + REAL_ARITH_TAC; + DISCH_THEN IMATCH_MP_TAC ; + SUBCONJ_TAC; + REWRITE_TAC[GSYM floor_le]; + UND 0; + REAL_ARITH_TAC; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + USE 3 (REWRITE_RULE[]); + USE 3 (ONCE_REWRITE_RULE[GSYM INT_LT_RADD ]); + USE 3 (GEN `z:int`); + TSPEC `&:1` 3; + USE 3 (REWRITE_RULE [int_lt_suc_le ;]); + MP_TAC (SPEC `real_of_int m + x` floor_ineq); + UND 3; + UND 1; + REWRITE_TAC[int_add_th;int_le;int_of_num_th]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + + +let floor_range = prove_by_refinement( + `!x m. (floor x = m) <=> (real_of_int m <=. x /\ x <. real_of_int m +. &.1)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_THEN (fun t -> REWRITE_TAC[GSYM t;floor_ineq]); + DISCH_ALL_TAC; + ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM;GSYM floor_lt;GSYM floor_le;]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* edges and squares *) +(* ------------------------------------------------------------------ *) + + +let h_edge = jordan_def `h_edge p = + { Z | ?u v. (Z = point(u,v)) /\ + (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p)+: (&:1)))) /\ + (v = real_of_int (SND p)) }`;; + +let v_edge = jordan_def `v_edge p = + { Z | ?u v. (Z = point(u,v)) /\ + (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) /\ + (u = real_of_int (FST p)) }`;; + +let squ = jordan_def `squ p = + {Z | ?u v. (Z = point(u,v)) /\ + (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p) +: (&:1)))) /\ + (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) }`;; + +let row = jordan_def `row k = {Z | ?u . (Z = point(u,real_of_int k))}`;; + +let col = jordan_def `col k = {Z | ?v . (Z = point(real_of_int k ,v))}`;; + + +let pointI_inj = prove_by_refinement( + `!p q. (pointI p = pointI q) <=> (p = q) `, + (* {{{ proof *) + [ + REWRITE_TAC[pointI;point_inj;PAIR_EQ;GSYM int_eq ]; + MESON_TAC[PAIR;PAIR_EQ]; + ]);; + (* }}} *) + +let h_edge_row = prove_by_refinement( + `!p . h_edge p SUBSET row (SND p) `, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;IN;h_edge;row;IN_ELIM_THM';]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let h_edge_floor = prove_by_refinement( + `!p. h_edge p SUBSET { z | floor (z 0) = FST p }`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;IN;h_edge;IN_ELIM_THM';int_of_num_th;int_add_th;]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[coord01;floor_range]; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let row_disj = prove_by_refinement( + `!a b. ~((row a) INTER (row b) = EMPTY) <=> (a = b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[EMPTY_EXISTS;IN;INTER;row;IN_ELIM_THM' ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + AND 0; + CHO 0; + CHO 1; + REWRITE_TAC[int_eq]; + USE 1 (GSYM); + REWR 1; + USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC [t]); + MESON_TAC[]; + ]);; + (* }}} *) + +let h_edge_disj = prove_by_refinement( + `!p q. ~(h_edge p INTER h_edge q = EMPTY) <=> (p = q)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM']; + EQ_TAC; + DISCH_TAC; + CHO 0; + ONCE_REWRITE_TAC [GSYM PAIR]; + REWRITE_TAC[PAIR_EQ]; + CONJ_TAC; + MP_TAC h_edge_floor; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; + ASM_MESON_TAC[]; + MP_TAC h_edge_row; + MP_TAC row_disj; + REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;]; + ASM_MESON_TAC[]; + REWRITE_TAC[h_edge;IN_ELIM_THM' ]; + DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]); + NAME_CONFLICT_TAC; + LEFT_TAC "u'"; + TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC; + TYPE_THEN `&.1/(&.2)` EXISTS_TAC; + IMATCH_MP_TAC half_pos; + ARITH_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `real_of_int (FST q) + x` EXISTS_TAC; + LEFT_TAC "v'"; + TYPE_THEN `real_of_int (SND q)` EXISTS_TAC ; + TYPE_THEN `point (real_of_int (FST q) + x,real_of_int (SND q))` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let h_edge_pointI = prove_by_refinement( + `!p q. ~(h_edge p (pointI q))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[pointI;h_edge;IN_ELIM_THM' ]; + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[]); + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]); + USE 0 GSYM ; + REWR 1; + REWR 2; + USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]); + USE 2 (REWRITE_RULE[int_le]); + UND 2; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let v_edge_col = prove_by_refinement( + `!p . v_edge p SUBSET col (FST p) `, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;IN;v_edge;col;IN_ELIM_THM';]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + TYPE_THEN `v` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let v_edge_floor = prove_by_refinement( + `!p. v_edge p SUBSET { z | floor (z 1) = SND p }`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;IN;v_edge;IN_ELIM_THM';int_of_num_th;int_add_th;]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[coord01;floor_range]; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let col_disj = prove_by_refinement( + `!a b. ~((col a) INTER (col b) = EMPTY) <=> (a = b)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[EMPTY_EXISTS;IN;INTER;col;IN_ELIM_THM' ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + AND 0; + CHO 0; + CHO 1; + REWRITE_TAC[int_eq]; + USE 1 (GSYM); + REWR 1; + USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC [t]); + MESON_TAC[]; + ]);; + (* }}} *) + +let v_edge_disj = prove_by_refinement( + `!p q. ~(v_edge p INTER v_edge q = EMPTY) <=> (p = q)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM']; + EQ_TAC; + DISCH_TAC; + CHO 0; + ONCE_REWRITE_TAC [GSYM PAIR]; + REWRITE_TAC[PAIR_EQ]; + IMATCH_MP_TAC (TAUT `a /\ b ==> b/\ a`); + CONJ_TAC; + MP_TAC v_edge_floor; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; + ASM_MESON_TAC[]; + MP_TAC v_edge_col; + MP_TAC col_disj; + REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;]; + ASM_MESON_TAC[]; + REWRITE_TAC[v_edge;IN_ELIM_THM' ]; + DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]); + NAME_CONFLICT_TAC; + LEFT_TAC "u'"; + TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC; + TYPE_THEN `&.1/(&.2)` EXISTS_TAC; + IMATCH_MP_TAC half_pos; + ARITH_TAC; + DISCH_THEN CHOOSE_TAC; + LEFT_TAC "v'"; + LEFT_TAC "v'"; + TYPE_THEN `real_of_int (SND q) + x` EXISTS_TAC; + TYPE_THEN `real_of_int (FST q)` EXISTS_TAC ; + TYPE_THEN `point (real_of_int (FST q),real_of_int (SND q) +x)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let v_edge_pointI = prove_by_refinement( + `!p q. ~(v_edge p (pointI q))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[pointI;v_edge;IN_ELIM_THM' ]; + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[]); + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]); + USE 0 GSYM ; + REWR 1; + REWR 2; + USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]); + USE 2 (REWRITE_RULE[int_le]); + UND 2; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let row_col = prove_by_refinement( + `!a b. (row b INTER col a) = { (pointI(a,b)) }`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[col;row;INTER;IN;IN_ELIM_THM';pointI]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM';INSERT;NOT_IN_EMPTY ]; + GEN_TAC; + ASM_MESON_TAC[PAIR_EQ ;point_inj]; + ]);; + (* }}} *) + +let hv_edge = prove_by_refinement( + `!p q. h_edge p INTER v_edge q = EMPTY`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `h_edge p INTER v_edge q SUBSET (row (SND p)) INTER (col (FST q))` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_INTER;]; + MESON_TAC[h_edge_row;v_edge_col;SUB_IMP_INTER ]; + REWRITE_TAC[row_col]; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + USE 1 (REWRITE_RULE[EMPTY_EXISTS;IN ]); + CHO 1; + USE 0 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM';INSERT;EMPTY ]); + TSPEC `u` 0; + REWR 0; + REWR 1; + USE 1 (REWRITE_RULE[INTER;IN;IN_ELIM_THM';h_edge_pointI]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let square_col = prove_by_refinement( + `!p a. (squ p INTER col a) = EMPTY `, + (* {{{ proof *) + + [ + REWRITE_TAC[squ;col]; + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]); + CHO 0; + USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']); + AND 0; + CHO 0; + CHO 1; + CHO 1; + UND 1; + DISCH_ALL_TAC; + REWR 0; + USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]); + REWR 3; + REWR 2; + USE 3 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]); + USE 3 (REWRITE_RULE[ int_le;]); + UND 2; + UND 3; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let square_row = prove_by_refinement( + `!p a. (squ p INTER row a) = EMPTY `, + (* {{{ proof *) + [ + REWRITE_TAC[squ;row]; + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]); + CHO 0; + USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']); + AND 0; + CHO 0; + CHO 1; + CHO 1; + UND 1; + DISCH_ALL_TAC; + REWR 0; + USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]); + REWR 5; + REWR 4; + USE 5 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]); + USE 5 (REWRITE_RULE[ int_le;]); + UND 5; + UND 4; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let pointI_row = prove_by_refinement( + `!p. (row (SND p)) (pointI p)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[row;pointI;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let pointI_col = prove_by_refinement( + `!p. (col (FST p)) (pointI p)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[col;pointI;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let square_v_edge = prove_by_refinement( + `!p q. (squ p INTER v_edge q = EMPTY)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + TYPE_THEN `squ p INTER v_edge q SUBSET squ p INTER col (FST q)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_INTER]; + MESON_TAC[SUB_IMP_INTER;v_edge_col;SUBSET_REFL]; + REWRITE_TAC[square_col;SUBSET_EMPTY ]; + ]);; + (* }}} *) + +let square_h_edge = prove_by_refinement( + `!p q. (squ p INTER h_edge q = EMPTY)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + TYPE_THEN `squ p INTER h_edge q SUBSET squ p INTER row (SND q)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_INTER]; + MESON_TAC[SUB_IMP_INTER;h_edge_row;SUBSET_REFL]; + REWRITE_TAC[square_row;SUBSET_EMPTY ]; + ]);; + (* }}} *) + +let square_pointI = prove_by_refinement( + `!p q. ~(squ p (pointI q))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + TYPE_THEN `q` (fun t -> ASSUME_TAC (SPEC t pointI_col)); + TYPEL_THEN [`p`;`FST q`] (fun t -> MP_TAC (SPECL t square_col)); + REWRITE_TAC[INTER;IN;]; + IMATCH_MP_TAC (TAUT `(a ==> ~b) ==> (b ==> ~ a)`); + DISCH_TAC; + REWRITE_TAC[EMPTY_EXISTS;IN ]; + TYPE_THEN `pointI q` EXISTS_TAC; + ASM_REWRITE_TAC[IN_ELIM_THM']; + ]);; + (* }}} *) + +let square_floor0 = prove_by_refinement( + `!p. (squ p SUBSET { z | (floor (z 0)) = (FST p) })`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[coord01;floor_range]; + UND 1; + UND 2; + REWRITE_TAC[int_add_th;int_of_num_th]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let square_floor1 = prove_by_refinement( + `!p. (squ p SUBSET { z | (floor (z 1)) = (SND p) })`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[coord01;floor_range]; + UND 3; + UND 4; + REWRITE_TAC[int_add_th;int_of_num_th]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let square_square = prove_by_refinement( + `!p q. ~(squ p INTER squ q = {}) ==> (squ p = squ q)`, + (* {{{ proof *) + [ + MP_TAC square_floor0; + MP_TAC square_floor1; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS ]; + DISCH_ALL_TAC; + REP_GEN_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `p = q` SUBGOAL_TAC; + ONCE_REWRITE_TAC [GSYM PAIR]; + REWRITE_TAC[PAIR_EQ]; + ASM_MESON_TAC[]; + MESON_TAC[]; + ]);; + (* }}} *) + +let square_disj = prove_by_refinement( + `!p q. ~(squ p INTER squ q = EMPTY) <=> (p = q)`, + (* {{{ proof *) + [ + MP_TAC square_floor0; + MP_TAC square_floor1; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS ]; + DISCH_ALL_TAC; + REP_GEN_TAC; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + ONCE_REWRITE_TAC [GSYM PAIR]; + REWRITE_TAC[PAIR_EQ]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[squ]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "u''"); + TYPE_THEN `real_of_int (FST q) + (&.1/(&.2))` EXISTS_TAC; + TYPE_THEN `real_of_int (SND q) + (&.1/(&.2))` EXISTS_TAC; + REWRITE_TAC[int_suc]; + TYPE_THEN `a = real_of_int(FST q)` ABBREV_TAC; +(*** Modified by JRH since ABBREV_TAC now forbids existing variables + TYPE_THEN `a = real_of_int(SND q)` ABBREV_TAC; + ****) + TYPE_THEN `a' = real_of_int(SND q)` ABBREV_TAC; + MP_TAC (REAL_RAT_REDUCE_CONV `&.0 < &.1/(&.2) /\ (&.1/(&.2)) < &.1`); + REAL_ARITH_TAC; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* cells *) +(* ------------------------------------------------------------------ *) + + +let cell = jordan_def `cell = + {z | (?p. (z = { (pointI p) }) \/ (z = h_edge p) \/ + (z = v_edge p) \/ (z = squ p))}`;; + +let cell_rules = prove_by_refinement( + `!p. cell {(pointI p)} /\ (cell (h_edge p)) /\ + (cell (v_edge p)) /\ (cell (squ p))`, + (* {{{ proof *) + [ + REWRITE_TAC[cell;IN_ELIM_THM';]; + MESON_TAC[]; + ]);; + (* }}} *) + +let cell_mem = prove_by_refinement( + `!C. (cell C) <=> (?p. C = ({(pointI p)})) \/ (?p. C = h_edge p) \/ + (?p. C = v_edge p) \/ (?p. C = squ p)`, + (* {{{ proof *) + [ + REWRITE_TAC[cell;IN_ELIM_THM']; + MESON_TAC[]; + ]);; + (* }}} *) + +let square_domain = prove_by_refinement( + `!z. (let (p = (floor(FST z),floor(SND z))) in + (({(pointI p)} UNION + (h_edge p) UNION + (v_edge p) UNION + (squ p) ))) (point z) `, + (* {{{ proof *) + [ + GEN_TAC; + LET_TAC; + REWRITE_TAC[UNION;IN;IN_ELIM_THM' ]; + REWRITE_TAC[pointI;h_edge;v_edge;squ;int_add_th;int_of_num_th;IN_ELIM_THM';INSERT;EMPTY;point_inj;Q_POINT ]; + ASSUME_TAC floor_ineq; + TYPE_THEN `FST z` (WITH 0 o SPEC); + TSPEC `SND z` 0; + UND 0; + UND 1; + REWRITE_TAC[PAIR_LEMMAv2]; + REWRITE_TAC[REAL_ARITH `(a <= b) <=> ((a = b) \/ (a < b))`]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let square_cell = prove_by_refinement( + `!z. (let (p = (floor(FST z),floor(SND z))) in + (({(pointI p)} UNION + (h_edge p) UNION + (v_edge p) UNION + (squ p) ))) SUBSET (UNIONS cell) `, + (* {{{ proof *) + [ + GEN_TAC; + LET_TAC; + REWRITE_TAC[union_subset]; + REPEAT CONJ_TAC THEN (IMATCH_MP_TAC sub_union) THEN (REWRITE_TAC[cell_rules]); + ]);; + (* }}} *) + +let cell_unions = prove_by_refinement( + `!z. (UNIONS cell (point z))`, + (* {{{ proof *) + [ + GEN_TAC; + ASM_MESON_TAC[square_cell;square_domain;SUBSET;IN]; + ]);; + (* }}} *) + +let cell_partition = prove_by_refinement( + `!C D. (cell C) /\ (cell D) /\ ~(C INTER D = EMPTY) ==> (C = D)`, + (* {{{ proof *) + let revr = PURE_ONCE_REWRITE_RULE [INTER_COMM] in + [ + PARTIAL_REWRITE_TAC[cell_mem;]; + PARTIAL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR ]; + REP_GEN_TAC; + PARTIAL_REWRITE_TAC[TAUT `((a \/ b ==> C)) <=> ((a ==> C) /\ (b ==> C))`]; + PARTIAL_REWRITE_TAC[TAUT `((a /\ b) ==> C) <=> (a ==> b ==> C)`]; + REPEAT CONJ_TAC THEN (REPEAT (DISCH_THEN CHOOSE_TAC)) THEN (TRY (UNDISCH_FIND_TAC `(INTER)`)) THEN (ASM PARTIAL_REWRITE_TAC[]) THEN ASM PARTIAL_REWRITE_TAC[square_h_edge;square_v_edge;revr square_h_edge;revr square_v_edge;v_edge_disj;h_edge_disj;hv_edge;revr hv_edge;revr single_inter; single_inter;square_pointI;v_edge_pointI;h_edge_pointI; square_square;INR NOT_IN_EMPTY;INR IN_SING ] THEN (DISCH_THEN (fun t-> REWRITE_TAC[t])); + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* adjacency, closure, convexity, AND strict dominance on cells. *) +(* ------------------------------------------------------------------ *) + + +let top2 = jordan_def `top2 = top_of_metric (euclid 2,d_euclid)`;; + +let adj = jordan_def `adj X Y <=> (~(X = Y) /\ + ~(closure top2 X INTER (closure top2 Y) = EMPTY))`;; + +let strict_dom = jordan_def `strict_dom X Y <=> (cell X) /\ (cell Y) /\ + (closure top2 Y PSUBSET (closure top2 X))`;; + +let adj_symm = prove_by_refinement( + `!X Y. (adj X Y) <=> (adj Y X)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[adj]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let adj_irrefl = prove_by_refinement( + `!X. (~(adj X X))`, + (* {{{ proof *) + [ + REWRITE_TAC[adj;]; + ]);; + (* }}} *) + +let strict_dom_trans = prove_by_refinement( + `!X Y Z. (strict_dom X Y) /\ (strict_dom Y Z) ==> (strict_dom X Z)`, + (* {{{ proof *) + [ + REWRITE_TAC[strict_dom]; + MESON_TAC[PSUBSET_TRANS]; + ]);; + (* }}} *) + +let strict_dom_irrefl = prove_by_refinement( + `!X. ~(strict_dom X X)`, + (* {{{ proof *) + [ + REWRITE_TAC[strict_dom;PSUBSET_IRREFL ]; + ]);; + (* }}} *) + +let dot_point = prove_by_refinement( + `!p q . (dot (point p) (point q)) = (FST p)*(FST q) + (SND p)*(SND q)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `dot (point p) (point q) = sum (0,2) (\i. (point p i)*(point q i))` SUBGOAL_TAC; + IMATCH_MP_TAC dot_euclid; + ASM_SIMP_TAC[euclid_point]; + DISCH_THEN_REWRITE; + REWRITE_TAC[ARITH_RULE `2 = SUC 1`]; + REWRITE_TAC[sum]; + REWRITE_TAC[ARITH_RULE `1 = SUC 0`]; + REWRITE_TAC[sum]; + REDUCE_TAC; + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`;coord01]; + ]);; + (* }}} *) + + +(* 2d half planes *) +let open_half_plane2D_FLT = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (FST p <. r)) } = + open_half_space 2 (point (&.1,&.0)) r `, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let open_half_plane2D_LTF = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (r <. FST p )) } = + open_half_space 2 (point (--. (&.1),&.0)) (--. r) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let open_half_plane2D_SLT = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (SND p <. r )) } = + open_half_space 2 (point (&.0,&.1)) ( r) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let open_half_plane2D_LTS = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (r <. SND p )) } = + open_half_space 2 (point (&.0,--.(&.1))) (--. r) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let closed_half_plane2D_FLE = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (FST p <=. r)) } = + closed_half_space 2 (point (&.1,&.0)) r `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let closed_half_plane2D_LEF = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (r <=. FST p)) } = + closed_half_space 2 (point (--.(&.1),&.0)) (--. r) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let closed_half_plane2D_SLE = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (SND p <=. r)) } = + closed_half_space 2 (point (&.0,&.1)) r `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let closed_half_plane2D_LES = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (r <=. SND p )) } = + closed_half_space 2 (point (&.0,(--. (&.1)))) (--. r) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let line2D_F = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (FST p = r)) } = + hyperplane 2 (point (&.1,&.0)) r `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let line2D_S = prove_by_refinement( + `!r. { z | ?p. ((z = point p) /\ (SND p = r)) } = + hyperplane 2 (point (&.0,&.1)) r `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[open_half_space;hyperplane;closed_half_space ]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASM_REWRITE_TAC[dot_point;euclid_point;]; + REDUCE_TAC; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + USE 0 (MATCH_MP point_onto); + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[dot_point;euclid_point]); + USE 1 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let open_half_plane2D_FLT_open = prove_by_refinement( + `!r. top2 { z | ?p. ((z = point p) /\ (FST p <. r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_FLT;top2]; + SIMP_TAC[open_half_space_open;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_LTF_open = prove_by_refinement( + `!r. top2 { z | ?p. ((z = point p) /\ (r <. FST p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_LTF;top2]; + SIMP_TAC[open_half_space_open;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_SLT_open = prove_by_refinement( + `!r. top2 { z | ?p. ((z = point p) /\ (SND p <. r )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_SLT;top2]; + SIMP_TAC[open_half_space_open;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_LTS_open = prove_by_refinement( + `!r. top2 { z | ?p. ((z = point p) /\ (r <. SND p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_LTS;top2]; + SIMP_TAC[open_half_space_open;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_FLT_closed = prove_by_refinement( + `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p <=. r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_FLE;top2]; + SIMP_TAC[closed_half_space_closed;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_LTF_closed = prove_by_refinement( + `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. FST p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_LEF;top2]; + SIMP_TAC[closed_half_space_closed;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_SLT_closed = prove_by_refinement( + `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p <=. r )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_SLE;top2]; + SIMP_TAC[closed_half_space_closed;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_LTS_closed = prove_by_refinement( + `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. SND p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_LES;top2]; + SIMP_TAC[closed_half_space_closed;euclid_point]; + ]);; + (* }}} *) + +let line2D_F_closed = prove_by_refinement( + `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p = r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[line2D_F;top2]; + SIMP_TAC[hyperplane_closed;euclid_point]; + ]);; + (* }}} *) + +let line2D_S_closed = prove_by_refinement( + `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p = r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[line2D_S;top2]; + SIMP_TAC[hyperplane_closed;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_FLT_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (FST p <. r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_FLT;]; + SIMP_TAC[open_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_LTF_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (r <. FST p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_LTF;]; + SIMP_TAC[open_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_SLT_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (SND p <. r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_SLT;]; + SIMP_TAC[open_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let open_half_plane2D_LTS_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (r <. SND p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_LTS;]; + SIMP_TAC[open_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_FLT_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (FST p <=. r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_FLE;]; + SIMP_TAC[closed_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_LTF_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (r <=. FST p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_LEF;]; + SIMP_TAC[closed_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_SLT_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (SND p <=. r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_SLE;]; + SIMP_TAC[closed_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let closed_half_plane2D_LTS_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (r <=. SND p )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[closed_half_plane2D_LES;]; + SIMP_TAC[closed_half_space_convex;euclid_point]; + ]);; + (* }}} *) + +let line2D_F_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ ( FST p = r )) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[line2D_F;]; + SIMP_TAC[hyperplane_convex;euclid_point]; + ]);; + (* }}} *) + +let line2D_S_convex = prove_by_refinement( + `!r. convex { z | ?p. ((z = point p) /\ (SND p = r)) }`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[line2D_S;]; + SIMP_TAC[hyperplane_convex;euclid_point]; + ]);; + (* }}} *) + +let closure_FLT = prove_by_refinement( + `!r. (closure top2 { z | ?p. ((z = point p) /\ (FST p <. r)) } = + { z | ?p. ((z = point p) /\ (FST p <=. r)) })`, + (* {{{ proof *) + + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_FLT;closed_half_plane2D_FLE;top2]; + TYPE_THEN `~(point(&.1,&.0) = euclid0)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 0(REWRITE_RULE[]); + USE 0 (fun t -> AP_THM t `0`); + USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]); + ASM_REWRITE_TAC[]; + SIMP_TAC[closure_half_space;euclid_point]; + ]);; + + (* }}} *) + +let closure_LTF = prove_by_refinement( + `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. FST p)) } = + { z | ?p. ((z = point p) /\ (r <=. FST p )) })`, + (* {{{ proof *) + + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_LTF;closed_half_plane2D_LEF;top2]; + TYPE_THEN `~(point(--. (&.1),&.0) = euclid0)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 0(REWRITE_RULE[]); + USE 0 (fun t -> AP_THM t `0`); + USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]); + ASM_REWRITE_TAC[]; + SIMP_TAC[closure_half_space;euclid_point]; + ]);; + + (* }}} *) + +let closure_SLT = prove_by_refinement( + `!r. (closure top2 { z | ?p. ((z = point p) /\ (SND p <. r)) } = + { z | ?p. ((z = point p) /\ (SND p <=. r)) })`, + (* {{{ proof *) + + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_SLT;closed_half_plane2D_SLE;top2]; + TYPE_THEN `~(point(&.0,&.1) = euclid0)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 0(REWRITE_RULE[]); + USE 0 (fun t -> AP_THM t `1`); + USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]); + ASM_REWRITE_TAC[]; + SIMP_TAC[closure_half_space;euclid_point]; + ]);; + + (* }}} *) + +let closure_LTS = prove_by_refinement( + `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. SND p)) } = + { z | ?p. ((z = point p) /\ (r <=. SND p )) })`, + (* {{{ proof *) + + [ + GEN_TAC; + REWRITE_TAC[open_half_plane2D_LTS;closed_half_plane2D_LES;top2]; + TYPE_THEN `~(point(&.0, --. (&.1)) = euclid0)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 0(REWRITE_RULE[]); + USE 0 (fun t -> AP_THM t `1`); + USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]); + ASM_REWRITE_TAC[]; + SIMP_TAC[closure_half_space;euclid_point]; + ]);; + + (* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* SECTION B *) +(* ------------------------------------------------------------------ *) + +(* -> sets *) +let single_subset = prove_by_refinement( + `!(x:A) A. ({x} SUBSET A) <=> (A x)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;INSERT]; + MESON_TAC[]; + ]);; + (* }}} *) + +let top2_top = prove_by_refinement( + `topology_ top2 `, + (* {{{ proof *) + [ + ASM_SIMP_TAC [top2;top_of_metric_top;metric_euclid]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* H_edge & v_edge, convexity, closure, closed, adj, etc. *) +(* ------------------------------------------------------------------ *) + +let e1 = jordan_def `e1 = point(&.1,&.0)`;; +let e2 = jordan_def `e2 = point(&.0,&.1)`;; + +let hc_edge = jordan_def `hc_edge m = + (h_edge m) UNION {(pointI m)} UNION {(pointI m + e1)}`;; + +let vc_edge = jordan_def `vc_edge m = + (v_edge m) UNION {(pointI m)} UNION {(pointI m + e2)}`;; + + + +(* H edge *) +let h_edge_inter = prove_by_refinement( + `!m. (h_edge m) = + ({z | ?p. (z = point p) /\ (real_of_int (FST m) <. FST p)} + INTER {z | ?p. (z = point p) /\ (FST p <. real_of_int(FST m +: &:1))} + INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND m))})`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[INTER;h_edge]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[point_inj]; + REPEAT CONJ_TAC THEN (TYPE_THEN `(u,real_of_int(SND m))` EXISTS_TAC) THEN ASM_REWRITE_TAC[PAIR_SPLIT]; + DISCH_ALL_TAC; + CHO 0; + CHO 1; + CHO 2; + TYPE_THEN `FST p` EXISTS_TAC; + TYPE_THEN `SND p` EXISTS_TAC; + REWR 1; + REWR 2; + USE 2 (REWRITE_RULE[point_inj]); + USE 1 (REWRITE_RULE[point_inj]); + AND 1; + AND 2; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let h_edge_convex = prove_by_refinement( + `!m. (convex (h_edge m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[h_edge_inter;]; + IMATCH_MP_TAC convex_inter; + CONJ_TAC; + REWRITE_TAC [open_half_plane2D_LTF_convex;]; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[open_half_plane2D_FLT_convex;line2D_S_convex]; + ]);; + (* }}} *) + +let hc_edge_inter = prove_by_refinement( + `!m. (hc_edge m) = + ({z | ?p. (z = point p) /\ (real_of_int (FST m) <=. FST p)} + INTER {z | ?p. (z = point p) /\ (FST p <=. real_of_int(FST m +: &:1))} + INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND m))})`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[hc_edge;e1]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[union_subset]; + REPEAT (CONJ_TAC); + REWRITE_TAC[h_edge_inter]; + REWRITE_TAC[SUBSET;INTER]; + ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`]; + REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc]; + REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; + REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc]; + REDUCE_TAC; + REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) + &.1,real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; + REWRITE_TAC[INTER;SUBSET;UNION;e1;h_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ]; + GEN_TAC; + DISCH_ALL_TAC; + CHO 0; + REWR 1; + REWR 2; + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])]; + UND 2; + UND 1; + REWRITE_TAC[point_inj;]; + REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])]; + AND 0; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let hc_edge_closed = prove_by_refinement( + `!m. (closed_ top2 (hc_edge m))`, + (* {{{ proof *) + [ + REWRITE_TAC[hc_edge_inter]; + GEN_TAC; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top;closed_half_plane2D_LTF_closed]; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top;closed_half_plane2D_FLT_closed;line2D_S_closed;]; + ]);; + (* }}} *) + +let hc_edge_convex = prove_by_refinement( + `!m. (convex (hc_edge m))`, + (* {{{ proof *) + [ + REWRITE_TAC[hc_edge_inter]; + GEN_TAC; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[closed_half_plane2D_LTF_convex]; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[closed_half_plane2D_FLT_convex;line2D_S_convex;]; + ]);; + (* }}} *) + +let h_edge_subset = prove_by_refinement( + `!m. (h_edge m SUBSET hc_edge m)`, + (* {{{ proof *) + [ + REWRITE_TAC[hc_edge;SUBSET;UNION;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let h_edge_euclid = prove_by_refinement( + `!m. (h_edge m) SUBSET (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;h_edge]; + MESON_TAC[euclid_point]; + ]);; + (* }}} *) + +let h_edge_closure = prove_by_refinement( + `!m. (closure top2 (h_edge m)) = hc_edge m`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC closure_subset; + REWRITE_TAC[h_edge_subset;top2_top;hc_edge_closed]; + REWRITE_TAC[hc_edge]; + REWRITE_TAC[union_subset;e1;pointI;single_subset;point_add]; + CONJ_TAC; + IMATCH_MP_TAC subset_closure; + REWRITE_TAC[top2_top]; + REWRITE_TAC[top2]; + SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ; + REWRITE_TAC[GSYM REAL_RDISTRIB]; + REAL_ARITH_TAC; + DISCH_TAC; + CONJ_TAC THEN (IMATCH_MP_TAC closure_segment) THEN REWRITE_TAC[h_edge_euclid]; + TYPE_THEN `(pointI m)+point(&.1,&.0)` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REDUCE_TAC; + ASM_REWRITE_TAC[int_suc]; + TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; + UND 1; + UND 2; + REAL_ARITH_TAC ; + TYPE_THEN `pointI m` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REDUCE_TAC; + ASM_REWRITE_TAC[int_suc]; + TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; + UND 1; + UND 2; + REAL_ARITH_TAC ; + ]);; + + (* }}} *) + +(* move up *) +let point_split = prove_by_refinement( + `!z u v. (z = point(u,v)) <=> (u = z 0) /\ (v = z 1) /\ (euclid 2 z)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC ; + DISCH_THEN_REWRITE; + REWRITE_TAC[coord01;euclid_point]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + DISJ_CASES_TAC (ARITH_RULE `(x = 0) \/ (x = 1) \/ (2 <= x)`); + ASM_REWRITE_TAC[coord01]; + UND 3; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[coord01]; + ASM_MESON_TAC[euclid;euclid_point] + ]);; + (* }}} *) + + +(* V edge *) +let v_edge_inter = prove_by_refinement( + `!m. (v_edge m) = + ({z | ?p. (z = point p) /\ (real_of_int (SND m) <. SND p)} + INTER {z | ?p. (z = point p) /\ (SND p <. real_of_int(SND m +: &:1))} + INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST m))})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[INTER;v_edge;int_suc ]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[point_inj]; + CONV_TAC (dropq_conv "p"); + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "p"); + CONV_TAC (dropq_conv "p'"); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[point_split;]; + CONV_TAC (dropq_conv "v"); + ASM_MESON_TAC[FST;SND;PAIR;coord01;euclid_point;point_onto]; + ]);; + (* }}} *) + +let v_edge_convex = prove_by_refinement( + `!m. (convex (v_edge m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[v_edge_inter;]; + IMATCH_MP_TAC convex_inter; + CONJ_TAC; + REWRITE_TAC [open_half_plane2D_LTS_convex;]; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[open_half_plane2D_SLT_convex;line2D_F_convex]; + ]);; + (* }}} *) + +let vc_edge_inter = prove_by_refinement( + `!m. (vc_edge m) = + ({z | ?p. (z = point p) /\ (real_of_int (SND m) <=. SND p)} + INTER {z | ?p. (z = point p) /\ (SND p <=. real_of_int(SND m +: &:1))} + INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST m))})`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[vc_edge;e2]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[union_subset]; + REPEAT (CONJ_TAC); + REWRITE_TAC[v_edge_inter]; + REWRITE_TAC[SUBSET;INTER]; + ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`]; + REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc]; + REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; + REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc]; + REDUCE_TAC; + REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) ,real_of_int(SND m) + &.1)` EXISTS_TAC) THEN REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`]; + REWRITE_TAC[INTER;SUBSET;UNION;e2;v_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ]; + GEN_TAC; + DISCH_ALL_TAC; + CHO 0; + REWR 1; + REWR 2; + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])]; + UND 2; + UND 1; + REWRITE_TAC[point_inj;]; + REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])]; + AND 0; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let vc_edge_closed = prove_by_refinement( + `!m. (closed_ top2 (vc_edge m))`, + (* {{{ proof *) + [ + REWRITE_TAC[vc_edge_inter]; + GEN_TAC; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top;closed_half_plane2D_LTS_closed]; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top;closed_half_plane2D_SLT_closed;line2D_F_closed;]; + ]);; + (* }}} *) + +let vc_edge_convex = prove_by_refinement( + `!m. (convex (vc_edge m))`, + (* {{{ proof *) + [ + REWRITE_TAC[vc_edge_inter]; + GEN_TAC; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[closed_half_plane2D_LTS_convex]; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[closed_half_plane2D_SLT_convex;line2D_F_convex;]; + ]);; + (* }}} *) + +let v_edge_subset = prove_by_refinement( + `!m. (v_edge m SUBSET vc_edge m)`, + (* {{{ proof *) + [ + REWRITE_TAC[vc_edge;SUBSET;UNION;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let v_edge_euclid = prove_by_refinement( + `!m. (v_edge m) SUBSET (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;v_edge]; + MESON_TAC[euclid_point]; + ]);; + (* }}} *) + +let v_edge_closure = prove_by_refinement( + `!m. (closure top2 (v_edge m)) = vc_edge m`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC closure_subset; + REWRITE_TAC[v_edge_subset;top2_top;vc_edge_closed]; + REWRITE_TAC[vc_edge]; + REWRITE_TAC[union_subset;e2;pointI;single_subset;point_add]; + CONJ_TAC; + IMATCH_MP_TAC subset_closure; + REWRITE_TAC[top2_top]; + REWRITE_TAC[top2]; + SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ; + REWRITE_TAC[GSYM REAL_RDISTRIB]; + REAL_ARITH_TAC; + DISCH_TAC; + CONJ_TAC THEN (IMATCH_MP_TAC closure_segment) THEN REWRITE_TAC[v_edge_euclid]; + TYPE_THEN `(pointI m)+point(&.0,&.1)` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REDUCE_TAC; + ASM_REWRITE_TAC[int_suc]; + TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; + UND 1; + UND 2; + REAL_ARITH_TAC ; + TYPE_THEN `pointI m` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REDUCE_TAC; + ASM_REWRITE_TAC[int_suc]; + TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC; + UND 1; + UND 2; + REAL_ARITH_TAC ; + ]);; + + (* }}} *) + +let squ_euclid = prove_by_refinement( + `!m. (squ m) SUBSET (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;squ]; + MESON_TAC[euclid_point]; + ]);; + (* }}} *) + +let cell_euclid = prove_by_refinement( + `!X. (cell X) ==> (X SUBSET euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[cell]; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + REP_CASES_TAC THEN ASM_REWRITE_TAC[h_edge_euclid;squ_euclid;v_edge_euclid]; + REWRITE_TAC[ISUBSET;INR IN_SING;pointI;euclid_point]; + ASM_MESON_TAC[euclid_point]; + ]);; + (* }}} *) + +let edge = jordan_def `edge C <=> ?m. ((C = v_edge m) \/ (C = h_edge m))`;; + +let edge_v = prove_by_refinement( + `!m. edge (v_edge m)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[edge]; + ]);; + (* }}} *) + +let edge_h = prove_by_refinement( + `!m. edge (h_edge m)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[edge]; + ]);; + (* }}} *) + +let num_closure = jordan_def `num_closure G x = + CARD { C | (G C) /\ (closure top2 C x) }`;; + +let num_lower = jordan_def `num_lower G n = + CARD { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;; + +let set_lower = jordan_def `set_lower G n = + { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;; + +let num_lower_set = prove_by_refinement( + `!G n. num_lower G n = CARD (set_lower G n)`, + (* {{{ proof *) + [ + REWRITE_TAC[num_lower;set_lower]; + ]);; + (* }}} *) + +let even_cell = jordan_def `even_cell G C <=> + (?m. (C = {(pointI m)}) /\ (EVEN (num_lower G m))) \/ + (?m. (C = h_edge m) /\ (EVEN (num_lower G m))) \/ + (?m. (C = v_edge m) /\ (EVEN (num_lower G m))) \/ + (?m. (C = squ m) /\ (EVEN (num_lower G m)))`;; + +(* set *) +let eq_sing = prove_by_refinement( +(*** Parens added by JRH; parser no longer hacks "=" specially + so it is really right associative + `!X (y:A). X = {y} = ((X y) /\ (!u. (X u) ==> (u=y)))`, + ***) + `!X (y:A). (X = {y}) <=> ((X y) /\ (!u. (X u) ==> (u=y)))`, + (* {{{ proof *) + [ + REWRITE_TAC[INSERT ;]; + DISCH_ALL_TAC; + EQ_TAC ; + DISCH_THEN_REWRITE; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let h_edge_pointIv2 = prove_by_refinement( + `!p q. ~(h_edge p = {(pointI q)})`, + (* {{{ proof *) + [ + REWRITE_TAC[eq_sing;h_edge_pointI]; + ]);; + (* }}} *) + +let v_edge_pointIv2 = prove_by_refinement( + `!p q. ~(v_edge p = {(pointI q)})`, + (* {{{ proof *) + [ + REWRITE_TAC[eq_sing;v_edge_pointI]; + ]);; + (* }}} *) + +let square_pointIv2 = prove_by_refinement( + `!p q. ~(squ p = {(pointI q)})`, + (* {{{ proof *) + [ + REWRITE_TAC[eq_sing;square_pointI]; + ]);; + (* }}} *) + +let cell_nonempty = prove_by_refinement( + `!z. (cell z) ==> ~(z = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[cell_mem]; + GEN_TAC; + REP_CASES_TAC ; + CHO 1; + USE 1( REWRITE_RULE [eq_sing]); + ASM_MESON_TAC[EMPTY]; + CHO 1; + ASM_MESON_TAC[h_edge_disj;INTER_EMPTY]; + CHO 1; + ASM_MESON_TAC[v_edge_disj;INTER_EMPTY]; + CHO 1; + ASM_MESON_TAC[square_disj;INTER_EMPTY]; + ]);; + (* }}} *) + +let hv_edgeV2 = prove_by_refinement( + `!p q. ~(h_edge p = v_edge q)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[cell_rules;cell_nonempty;hv_edge;INTER_IDEMPOT]; + ]);; + (* }}} *) + +let square_v_edgeV2 = prove_by_refinement( + `!p q. ~(squ p = v_edge q)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[cell_rules;cell_nonempty;square_v_edge;INTER_IDEMPOT]; + ]);; + (* }}} *) + +let square_h_edgeV2 = prove_by_refinement( + `!p q. ~(squ p = h_edge q)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[cell_rules;cell_nonempty;square_h_edge;INTER_IDEMPOT]; + ]);; + (* }}} *) + +let h_edge_inj = prove_by_refinement( + `!p q . (h_edge p = h_edge q) <=> (p = q)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[cell_rules;cell_nonempty;h_edge_disj;INTER_IDEMPOT]; + ]);; + (* }}} *) + +let v_edge_inj = prove_by_refinement( + `!p q . (v_edge p = v_edge q) <=> (p = q)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[cell_rules;cell_nonempty;v_edge_disj;INTER_IDEMPOT]; + ]);; + (* }}} *) + +let squ_inj = prove_by_refinement( + `!p q . (squ p = squ q) <=> (p = q)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[cell_rules;cell_nonempty;square_disj;INTER_IDEMPOT]; + ]);; + (* }}} *) + +let finite_set_lower = prove_by_refinement( + `!G n. (FINITE G) ==> (FINITE (set_lower G n))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `INJ h_edge (set_lower G n) G` SUBGOAL_TAC; + REWRITE_TAC[INJ;set_lower;h_edge_inj]; + ASM_MESON_TAC[]; + DISCH_TAC; + JOIN 0 1; + USE 0 (MATCH_MP FINITE_INJ); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let even_cell_point = prove_by_refinement( + `!G m. even_cell G {(pointI m)} <=> EVEN(num_lower G m)`, + (* {{{ proof *) + [ + REWRITE_TAC[even_cell;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2]; + REWRITE_TAC[pointI_inj;INSERT;eq_sing]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let even_cell_h_edge = prove_by_refinement( + `!G m. even_cell G (h_edge m) <=> EVEN(num_lower G m)`, + (* {{{ proof *) + [ + REWRITE_TAC[even_cell;h_edge_pointIv2]; + REWRITE_TAC[pointI_inj;INSERT;h_edge_inj;GSYM square_h_edgeV2;hv_edgeV2;eq_sing]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let even_cell_v_edge = prove_by_refinement( + `!G m. even_cell G (v_edge m) <=> EVEN(num_lower G m)`, + (* {{{ proof *) + [ + REWRITE_TAC[even_cell;v_edge_pointIv2]; + REWRITE_TAC[pointI_inj;INSERT;v_edge_inj;GSYM square_v_edgeV2;hv_edgeV2;eq_sing]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let even_cell_squ = prove_by_refinement( + `!G m. even_cell G (squ m) <=> EVEN(num_lower G m)`, + (* {{{ proof *) + [ + REWRITE_TAC[even_cell;v_edge_pointIv2]; + REWRITE_TAC[pointI_inj;INSERT;squ_inj;GSYM square_v_edgeV2;GSYM square_h_edgeV2;square_pointI;eq_sing]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let h_edge_squ_parity = prove_by_refinement( + `!G m. even_cell G (h_edge m) <=> even_cell G (squ m)`, + (* {{{ proof *) + [ + REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower]; + ]);; + (* }}} *) + +let up = jordan_def `up (m:int#int) = (FST m,SND m +: (&:1))`;; +let down = jordan_def `down (m:int#int) = (FST m,SND m -: (&:1))`;; +let left = jordan_def `left (m:int#int) = (FST m -: (&:1),SND m)`;; +let right = jordan_def `right (m:int#int) = (FST m +: (&:1),SND m)`;; + +let set_lower_delete = prove_by_refinement( + `!G n. set_lower G (down n) = (set_lower G n) DELETE n`, + (* {{{ proof *) + [ + REWRITE_TAC[set_lower;down;DELETE ]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[PAIR_SPLIT;INT_LE_SUB_LADD;GSYM INT_LT_DISCRETE;]; + REWRITE_TAC[int_le;int_lt;]; + REWRITE_TAC[ (ARITH_RULE `! x y. (x <. y) <=> ((x <= y) /\ ~(x = y))`)]; + REWRITE_TAC[GSYM int_eq]; + MESON_TAC[]; + ]);; + (* }}} *) + +let set_lower_n = prove_by_refinement( + `!G n. set_lower G n n = (G (h_edge n))`, + (* {{{ proof *) + [ + REWRITE_TAC[set_lower;int_le ; REAL_LE_REFL]; + ]);; + (* }}} *) + +(* set *) +let CARD_SUC_DELETE = prove_by_refinement( + `!(x:A) s. FINITE s /\ s x ==> + ((SUC (CARD (s DELETE x))) = CARD s)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `s = (x INSERT (s DELETE x))` SUBGOAL_TAC; + ASM_MESON_TAC[INR INSERT_DELETE]; + USE 0 (ONCE_REWRITE_RULE[GSYM FINITE_DELETE]); + TYPE_THEN `b = s DELETE x` ABBREV_TAC ; + DISCH_THEN_REWRITE; + ASM_SIMP_TAC [INR CARD_CLAUSES]; + COND_CASES_TAC; + ASM_MESON_TAC[INR IN_DELETE]; + REWRITE_TAC[]; + ]);; + (* }}} *) + +let even_delete = prove_by_refinement( + `!(x:A) s. FINITE s ==> + ((EVEN (CARD (s DELETE x)) <=> EVEN (CARD s)) <=> ~(s x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `s x` ASM_CASES_TAC ; + ASM_MESON_TAC[CARD_SUC_DELETE;EVEN ]; + ASM_SIMP_TAC[CARD_DELETE]; + ]);; + (* }}} *) + +let num_lower_down = prove_by_refinement( + `!G m. (FINITE G) ==> + ((EVEN (num_lower G (down m)) <=> EVEN (num_lower G m)) <=> + ~(set_lower G m m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[num_lower_set;set_lower_delete]; + IMATCH_MP_TAC even_delete; + REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower;down]; + ASM_MESON_TAC[finite_set_lower]; + ]);; + (* }}} *) + +let squ_down = prove_by_refinement( + `!G m. (FINITE G) ==> + ((even_cell G (squ (down m)) <=> even_cell G (squ m)) <=> + ~(set_lower G m m))`, + (* {{{ proof *) + [ + REWRITE_TAC[even_cell_squ;num_lower_down]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* edge combinatorics *) +(* ------------------------------------------------------------------ *) + +let pair_size_2 = prove_by_refinement( + `!(a:A) b. ~(a= b) ==> ({a, b} HAS_SIZE 2)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[HAS_SIZE]; + ASM_SIMP_TAC[FINITE_SING;CARD_CLAUSES;INR IN_SING ]; + CONJ_TAC; + REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; + REWRITE_TAC[ARITH_RULE `2 = SUC 1`;SUC_INJ;]; + MESON_TAC[SING;CARD_SING]; + ]);; + (* }}} *) + +let has_size2 = prove_by_refinement( + `!u. (u HAS_SIZE 2) <=> (?(a:A) b. (u = {a , b}) /\ ~(a=b))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + REWRITE_TAC[HAS_SIZE]; + DISCH_ALL_TAC; + TYPE_THEN `~(u = EMPTY)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + REWR 2; + REWR 1; + USE 1 (REWRITE_RULE[CARD_CLAUSES]); + UND 1; + ARITH_TAC; + DISCH_TAC; + COPY 0; + COPY 2; + JOIN 0 2; + USE 0 (MATCH_MP CARD_DELETE_CHOICE); + TYPE_THEN `CARD (u DELETE CHOICE u) = 1` SUBGOAL_TAC; + ONCE_REWRITE_TAC [GSYM SUC_INJ]; + ASM_REWRITE_TAC[]; + ARITH_TAC; + DISCH_TAC; + TYPE_THEN `u DELETE CHOICE u HAS_SIZE 1` SUBGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[FINITE_DELETE]; + DISCH_TAC; + USE 5 (MATCH_MP CARD_SING_CONV); + USE 5 (REWRITE_RULE [SING]); + CHO 5; + TYPE_THEN `CHOICE u` EXISTS_TAC; + TYPE_THEN `x` EXISTS_TAC; + USE 5 (SYM); + ASM_REWRITE_TAC[]; + USE 4 (MATCH_MP CHOICE_DEF); + ASM_SIMP_TAC[INSERT_DELETE]; + TYPE_THEN `(u DELETE (CHOICE u)) x` SUBGOAL_TAC; + USE 5 (SYM); + ASM_REWRITE_TAC[INR IN_SING ]; + DISCH_TAC; + TYPE_THEN `~((u DELETE CHOICE u) (CHOICE u))` SUBGOAL_TAC; + REWRITE_TAC[INR IN_DELETE]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[pair_size_2]; + ]);; + (* }}} *) + +let in_pair = prove_by_refinement( + `!(a:A) b t. {a , b} t <=> (t = b) \/ (t = a)`, + (* {{{ proof *) + [ + REWRITE_TAC[INSERT]; + ]);; + (* }}} *) + +let pair_swap_select = + jordan_def `pair_swap u (x:A) = @y. ~(x = y) /\ (u y)`;; + +let pair_swap_pair = prove_by_refinement( + `!(a:A) b. ~(a = b) ==> + (pair_swap {a,b} a = b) /\ (pair_swap {a,b} b = a)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[pair_swap_select]; + REWRITE_TAC[in_pair]; + CONJ_TAC THEN SELECT_TAC THEN (ASM_MESON_TAC[]); + ]);; + (* }}} *) + +let pair_swap = prove_by_refinement( + `!u (x:A). (u HAS_SIZE 2)/\ (u x) ==> + (~(pair_swap u x = x)) /\ (u (pair_swap u x))`, + (* {{{ proof *) + [ + REWRITE_TAC[has_size2]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[]; + REWR 1; + USE 1 (REWRITE_RULE[in_pair]); + CONJ_TAC; + ASM_MESON_TAC[pair_swap_pair]; + UND 1; + DISCH_THEN (DISJ_CASES_TAC) THEN ASM_SIMP_TAC [pair_swap_pair] THEN REWRITE_TAC[INSERT]; + ]);; + (* }}} *) + +let pair_swap_invol = prove_by_refinement( + `!u (x:A). (u HAS_SIZE 2) /\ (u x) ==> + (pair_swap u (pair_swap u x) = x)`, + (* {{{ proof *) + [ + REWRITE_TAC[has_size2]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[]; + REWR 1; + USE 1 (REWRITE_RULE[in_pair]); + UND 1; + DISCH_THEN (DISJ_CASES_TAC); + ASM_SIMP_TAC [pair_swap_pair]; + ASM_SIMP_TAC [pair_swap_pair]; + ]);; + (* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* SECTION C *) +(* ------------------------------------------------------------------ *) + +(* ------------------------------------------------------------------ *) +(* rectagons *) +(* ------------------------------------------------------------------ *) + +let rectagon = jordan_def `rectagon G <=> + (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\ + (!m . ({0,2} (num_closure G (pointI m)))) /\ + (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\ + (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==> + (S = G))`;; + +let segment = jordan_def `segment G <=> + (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\ + (!m . ({0,1,2} (num_closure G (pointI m)))) /\ + (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\ + (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==> + (S = G))`;; + +let psegment = jordan_def `psegment G <=> + segment G /\ ~(rectagon G)`;; + +let rectagon_segment = prove_by_refinement( + `!G. (rectagon G ) ==> (segment G)`, + (* {{{ proof *) + [ + REWRITE_TAC[segment;rectagon;INSERT ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let endpoint = jordan_def `endpoint G m <=> + (num_closure G (pointI m) = 1)`;; + +let midpoint = jordan_def `midpoint G m <=> + (num_closure G (pointI m) = 2)`;; + +let psegment_endpoint = prove_by_refinement( + `!G. (psegment G) ==> (?m. (endpoint G m))`, + (* {{{ proof *) + [ + REWRITE_TAC[psegment;rectagon;segment;endpoint]; + DISCH_ALL_TAC; + UND 5; + ASM_REWRITE_TAC[]; + DISCH_TAC; + LEFT 5 "m"; + CHO 5; + TSPEC `m` 3; + USE 3 (REWRITE_RULE[INSERT]); + USE 5 (REWRITE_RULE[INSERT]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let rectagon_endpoint = prove_by_refinement( + `!G. (rectagon G) ==> ~(?m. (endpoint G m))`, + (* {{{ proof *) + [ + REWRITE_TAC[rectagon;endpoint;INSERT ]; + DISCH_ALL_TAC; + CHO 0; + ASM_MESON_TAC[ARITH_RULE `(~(1=2)) /\ ~(1=0)` ]; + ]);; + (* }}} *) + +let num_closure_mono = prove_by_refinement( + `!G G' x. (FINITE G') /\ (G SUBSET G') ==> + (num_closure G x <= num_closure G' x)`, + (* {{{ proof *) + [ + REWRITE_TAC[num_closure]; + DISCH_ALL_TAC; + IMATCH_MP_TAC CARD_SUBSET ; + REWRITE_TAC[ISUBSET]; + CONJ_TAC; + ASM_MESON_TAC[ISUBSET]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G'` EXISTS_TAC; + ASM_REWRITE_TAC[ISUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let endpoint_psegment = prove_by_refinement( + `!G. (?m. (endpoint G m)) /\ (segment G) ==> (psegment G)`, + (* {{{ proof *) + [ + ASM_MESON_TAC [psegment;rectagon_endpoint]; + ]);; + (* }}} *) + +let num_closure_size = prove_by_refinement( + `!G x. FINITE G ==> + ({C | G C /\ closure top2 C x} HAS_SIZE (num_closure G x) )`, + (* {{{ proof *) + [ + REWRITE_TAC[HAS_SIZE;num_closure]; + DISCH_ALL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + REWRITE_TAC[ISUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let endpoint_edge = prove_by_refinement( + `!G m. (FINITE G) /\ (endpoint G m) ==> (?! e. (G e) /\ + (closure top2 e (pointI m)))`, + (* {{{ proof *) + + [ + REWRITE_TAC[endpoint;]; + DISCH_ALL_TAC; + TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} HAS_SIZE 1` SUBGOAL_TAC; + UND 1; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + IMATCH_MP_TAC num_closure_size; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 2 (MATCH_MP CARD_SING_CONV); + USE 2 (REWRITE_RULE[SING]); + CHO 2; + USE 2 (REWRITE_RULE[eq_sing]); + REWRITE_TAC[EXISTS_UNIQUE_ALT]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let midpoint_edge = prove_by_refinement( + `!G m. (FINITE G) /\ (midpoint G m) ==> + {C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2`, + (* {{{ proof *) + [ + REWRITE_TAC[midpoint;]; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + IMATCH_MP_TAC num_closure_size; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let two_endpoint = prove_by_refinement( + `!e. (edge e) ==> ({ m | (closure top2 e (pointI m)) } HAS_SIZE 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + DISCH_ALL_TAC; + CHO 0; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[v_edge_closure;h_edge_closure]; + REWRITE_TAC[vc_edge;UNION;has_size2]; + TYPE_THEN `m` EXISTS_TAC; + TYPE_THEN `(FST m,SND m +: (&:1))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING ;]; + TYPE_THEN `euclid_plus (pointI m) e2 = pointI (FST m,SND m +: (&:1))` SUBGOAL_TAC ; + REWRITE_TAC[pointI;e2;point_add;int_suc ]; + REDUCE_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[v_edge_pointI;pointI_inj;]; + REWRITE_TAC[INSERT]; + MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + INT_ARITH_TAC; + (* 2nd case: *) + ASM_REWRITE_TAC[v_edge_closure;h_edge_closure]; + REWRITE_TAC[hc_edge;UNION;has_size2]; + TYPE_THEN `m` EXISTS_TAC; + TYPE_THEN `(FST m +: (&:1),SND m )` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING ;]; + TYPE_THEN `euclid_plus (pointI m) e1 = pointI (FST m +: (&:1),SND m )` SUBGOAL_TAC ; + REWRITE_TAC[pointI;e1;point_add;int_suc ]; + REDUCE_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[h_edge_pointI;pointI_inj;]; + REWRITE_TAC[INSERT]; + MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let edge_midend = prove_by_refinement( + `!G e m. (segment G) /\ (G e) /\ (closure top2 e (pointI m)) ==> + (midpoint G m) \/ (endpoint G m)`, + (* {{{ proof *) + [ + REWRITE_TAC[segment;midpoint;endpoint]; + DISCH_ALL_TAC; + TSPEC `m` 3; + USE 3 (REWRITE_RULE[INSERT]); + TYPE_THEN `~(num_closure G (pointI m) = 0)` SUBGOAL_TAC; + USE 0 (MATCH_MP num_closure_size); + TSPEC `pointI m` 0; + PROOF_BY_CONTR_TAC; + REWR 7; + REWR 0; + USE 0(REWRITE_RULE[HAS_SIZE_0]); + UND 0; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 3; + ARITH_TAC; + ]);; + (* }}} *) + +let plus_e12 = prove_by_refinement( + `!m. ((pointI m) + e2 = pointI (FST m,SND m +: (&:1))) /\ + ((pointI m) + e1 = pointI (FST m +: (&:1),SND m))`, + (* {{{ proof *) + [ + REWRITE_TAC[e1;e2]; + REWRITE_TAC[pointI;point_add;int_suc]; + REDUCE_TAC; + ]);; + (* }}} *) + +let c_edge_euclid = prove_by_refinement( + `!e. (edge e) ==> (closure top2 e) SUBSET (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[hc_edge;vc_edge;h_edge_closure;v_edge_closure;union_subset;plus_e12] THEN MESON_TAC[cell_rules; cell_euclid]; + ]);; + (* }}} *) + +(* slow proof... *) +let inter_lattice = prove_by_refinement( + `!x e e'. (edge e) /\ (edge e') /\ (~(e=e')) /\ + ((closure top2 e INTER closure top2 e') x) ==> + (?m. x = pointI m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `euclid 2 x` SUBGOAL_TAC; + USE 3 (REWRITE_RULE[INTER]); + AND 3; + USE 0 (MATCH_MP c_edge_euclid); + USE 0 (REWRITE_RULE[ISUBSET]); + ASM_MESON_TAC[]; + DISCH_THEN (MP_TAC o (MATCH_MP point_onto)); + DISCH_TAC; + CHO 4; + ASM_REWRITE_TAC[]; + ASSUME_TAC square_domain; + TSPEC `p` 5; + USE 5 (CONV_RULE (NAME_CONFLICT_CONV)); + UND 5; + LET_TAC ; + REWRITE_TAC[UNION]; + UND 3; + ASM_REWRITE_TAC[INTER]; + KILL 4; + UND 2; + UND 0; + REWRITE_TAC[edge] ; + DISCH_THEN (CHOOSE_THEN MP_TAC); + UND 1; + REWRITE_TAC[edge] ; + DISCH_THEN (CHOOSE_THEN MP_TAC); + REP_CASES_TAC THEN UNDISCH_FIND_TAC `(~)` THEN UNDISCH_FIND_TAC `(closure)` THEN UNDISCH_FIND_TAC `(point p)` THEN ASM_REWRITE_TAC[] THEN (REWRITE_TAC[INR IN_SING;h_edge_closure;v_edge_closure;UNION;vc_edge;hc_edge;plus_e12 ]) THEN + (* 1st,2nd,3rd, *) + (* tx *) + (let tx = REWRITE_RULE[EQ_EMPTY;INTER ] in MESON_TAC[tx hv_edge;tx v_edge_disj;tx h_edge_disj;tx square_v_edge;tx square_h_edge;v_edge_inj;h_edge_inj]); + ]);; + (* }}} *) + +let edgec_convex = prove_by_refinement( + `!e. (edge e) ==> (convex (closure top2 e))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[v_edge_closure;h_edge_closure;hc_edge_convex;vc_edge_convex]; + ]);; + (* }}} *) + +let midpoint_h_edge = prove_by_refinement( + `!m. (h_edge m) (((&.1)/(&.2))*# (pointI m) + + ((&.1)/(&.2))*# (pointI m + e1))`, + (* {{{ proof *) + [ + REWRITE_TAC[plus_e12]; + REWRITE_TAC[h_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc]; + GEN_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC; + TYPE_THEN `b = real_of_int(FST m)` ABBREV_TAC; + CONJ_TAC; + real_poly_tac ; + CONJ_TAC; + ineq_lt_tac `b + (&.1/(&.2)) = &1 / &2 * b + &1 / &2 * (b + &1)`; + ineq_lt_tac `((&1 / &2) * b + &1 / &2 * (b + &1)) + (&1 / &2) = b +. &1` + ]);; + (* }}} *) + +let midpoint_v_edge = prove_by_refinement( + `!m. (v_edge m) (((&.1)/(&.2))*# (pointI m) + + ((&.1)/(&.2))*# (pointI m + e2))`, + (* {{{ proof *) + [ + REWRITE_TAC[plus_e12]; + REWRITE_TAC[v_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc]; + GEN_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC; + TYPE_THEN `b = real_of_int(FST m)` ABBREV_TAC; + CONJ_TAC; + real_poly_tac ; + CONJ_TAC; + ineq_lt_tac `a +. (&1/ &2)= &1 / &2 * a + &1 / &2 * (a + &1)`; + ineq_lt_tac `(&1 / &2 * a + &1 / &2 * (a + &1)) +(&1/ &2) = a + &1`; + ]);; + (* }}} *) + +let midpoint_unique = prove_by_refinement( + `!x y e e'. (edge e) /\ (edge e') /\ (~(e = e')) /\ + ((closure top2 e INTER closure top2 e') x) /\ + ((closure top2 e INTER closure top2 e') y) ==> + ( x = y)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `convex (closure top2 e INTER closure top2 e')` SUBGOAL_TAC; + IMATCH_MP_TAC convex_inter ; + ASM_MESON_TAC[edgec_convex]; + TYPE_THEN `(?m. x = pointI m) /\ (?n. y = pointI n)` SUBGOAL_TAC; + ASM_MESON_TAC[inter_lattice]; + DISCH_ALL_TAC; + CHO 6; + CHO 7; + ASM_REWRITE_TAC[]; + REWR 3; + REWR 4; + KILL 6; + KILL 7; + TYPE_THEN `(closure top2 e (pointI n)) /\ closure top2 e (pointI m)` SUBGOAL_TAC; + UND 4; + UND 3; + REWRITE_TAC[INTER]; + MESON_TAC[]; + DISCH_ALL_TAC; + WITH 0 (MATCH_MP edgec_convex); + UND 6; + USE 0 (REWRITE_RULE[edge]); + CHO 0; + UND 0; + DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[]; + (* ml -- start of 1st main branch. *) + DISCH_ALL_TAC; + TYPE_THEN `((n = m') \/ (n = (FST m',SND m' + &:1))) /\ ((m = m') \/ (m = (FST m',SND m' + &:1)))` SUBGOAL_TAC; + UND 6; + UND 7; + ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI]; + MESON_TAC[]; + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + TYPE_THEN `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC; + (* start A*) + TYPE_THEN `X (pointI m') /\ X (pointI m' + e2) ==> ~(X INTER (v_edge m') = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + USE 5 (REWRITE_RULE[convex;mk_segment]); + DISCH_TAC ; + H_MATCH_MP (HYP "5") (HYP "10"); + USE 11 (REWRITE_RULE[ISUBSET]); + TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e2)` ABBREV_TAC; + TYPE_THEN `b` EXISTS_TAC; + TSPEC `b` 11; + CONJ_TAC; + UND 11; + DISCH_THEN IMATCH_MP_TAC ; + TYPE_THEN `&1/ &2` EXISTS_TAC; + CONV_TAC REAL_RAT_REDUCE_CONV; + EXPAND_TAC "b"; + MESON_TAC[]; + EXPAND_TAC "b"; + MATCH_ACCEPT_TAC midpoint_v_edge; (* end of goal A *) + REWRITE_TAC[plus_e12]; + (* start B*) + TYPE_THEN `X INTER (v_edge m') = EMPTY ` SUBGOAL_TAC; + REWRITE_TAC[EQ_EMPTY]; + DISCH_ALL_TAC; + USE 10 (REWRITE_RULE[INTER]); + TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC; + ASM_MESON_TAC[inter_lattice;edge]; + DISCH_TAC; + CHO 11; + REWR 10; + ASM_MESON_TAC[v_edge_pointI]; + DISCH_THEN_REWRITE; + DISCH_TAC; + REP_CASES_TAC THEN ASM_MESON_TAC[]; + (* end of FIRST main branch -- snd main branch -- fully parallel *) + DISCH_ALL_TAC; + TYPE_THEN `((n = m') \/ (n = (FST m' + &:1,SND m'))) /\ ((m = m') \/ (m = (FST m' + &:1,SND m' )))` SUBGOAL_TAC; + UND 6; + UND 7; + ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI]; + MESON_TAC[]; + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + TYPE_THEN `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC; + (* start A' *) + TYPE_THEN `X (pointI m') /\ X (pointI m' + e1) ==> ~(X INTER (h_edge m') = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + USE 5 (REWRITE_RULE[convex;mk_segment]); + DISCH_TAC ; + H_MATCH_MP (HYP "5") (HYP "10"); + USE 11 (REWRITE_RULE[ISUBSET]); + TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e1)` ABBREV_TAC; + TYPE_THEN `b` EXISTS_TAC; + TSPEC `b` 11; + CONJ_TAC; + UND 11; + DISCH_THEN IMATCH_MP_TAC ; + TYPE_THEN `&1/ &2` EXISTS_TAC; + CONV_TAC REAL_RAT_REDUCE_CONV; + EXPAND_TAC "b"; + MESON_TAC[]; + EXPAND_TAC "b"; + MATCH_ACCEPT_TAC midpoint_h_edge; (* end of goal A' *) + REWRITE_TAC[plus_e12]; + (* start B' *) + TYPE_THEN `X INTER (h_edge m') = EMPTY ` SUBGOAL_TAC; + REWRITE_TAC[EQ_EMPTY]; + DISCH_ALL_TAC; + USE 10 (REWRITE_RULE[INTER]); + TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC; + ASM_MESON_TAC[inter_lattice;edge]; + DISCH_TAC; + CHO 11; + REWR 10; + ASM_MESON_TAC[h_edge_pointI]; + DISCH_THEN_REWRITE; + DISCH_TAC; + REP_CASES_TAC THEN ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let edge_inter = prove_by_refinement( + `!C C'. (edge C) /\ (edge C') /\ (adj C C') ==> + (?m. (closure top2 C) INTER (closure top2 C') = {(pointI m)}) `, + (* {{{ proof *) + + [ + REWRITE_TAC[adj]; + DISCH_ALL_TAC; + USE 3 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 3; + TYPE_THEN `(?m. u = pointI m)` SUBGOAL_TAC; + ASM_MESON_TAC[inter_lattice]; + DISCH_THEN (CHOOSE_TAC); + REWR 3; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC [eq_sing]; + ASM_MESON_TAC[midpoint_unique]; + ]);; + + (* }}} *) + +let inter_midpoint = prove_by_refinement( + `!G C C' m. (segment G) /\ (G C) /\ (G C') /\ (adj C C') /\ + (((closure top2 C) INTER (closure top2 C')) (pointI m)) ==> + (midpoint G m) `, + (* {{{ proof *) + [ + REWRITE_TAC[midpoint;segment]; + DISCH_ALL_TAC; + TSPEC `m` 3; + USE 3 (REWRITE_RULE[INSERT]); + UND 3; + USE 0 (MATCH_MP num_closure_size); + TSPEC `pointI m` 0; + TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ; + TYPE_THEN `X C /\ X C'` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + UND 8; + REWRITE_TAC[INTER]; (* done WITH subgoal *) + DISCH_TAC; + TYPE_THEN `~(C = C')` SUBGOAL_TAC; + ASM_MESON_TAC[adj]; + DISCH_TAC; + REP_CASES_TAC; + ASM_REWRITE_TAC[]; + REWR 0; + USE 0 (MATCH_MP CARD_SING_CONV); + USE 0 (REWRITE_RULE[SING;eq_sing]); + ASM_MESON_TAC[]; + REWR 0; + USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let mid_end_disj = prove_by_refinement( + `!G m. ~(endpoint G m /\ midpoint G m)`, + (* {{{ proof *) + [ + REWRITE_TAC[endpoint;midpoint]; + ASM_MESON_TAC[ARITH_RULE `~(1=2)`]; + ]);; + (* }}} *) + +let two_exclusion = prove_by_refinement( + `!X p q (r:A). (X HAS_SIZE 2) /\ (X p) /\ (X q) /\ (X r) /\ (~(p = r)) + /\ (~(q = r)) ==> (p = q)`, + (* {{{ proof *) + [ + REWRITE_TAC[has_size2;]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + UND 1; + UND 2; + UND 3; + ASM_REWRITE_TAC[INSERT]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let midpoint_exists = prove_by_refinement( + `!G e. (segment G) /\ (G e) /\ (~(G = {e})) ==> + (?m. (closure top2 e (pointI m)) /\ (midpoint G m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `!m. (closure top2 e (pointI m)) ==> (endpoint G m)` SUBGOAL_TAC; + ASM_MESON_TAC[edge_midend]; + DISCH_TAC; + UND 2; + REWRITE_TAC[]; + UND 0; + REWRITE_TAC[segment]; + DISCH_ALL_TAC; + TSPEC `{e}` 7; + UND 7; + DISCH_THEN (IMATCH_MP_TAC o GSYM); + ASM_REWRITE_TAC[ISUBSET;INR IN_SING;]; + CONJ_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC [eq_sing]; + DISCH_ALL_TAC; + TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 C') = {(pointI m)})` SUBGOAL_TAC; + IMATCH_MP_TAC edge_inter; + ASM_MESON_TAC[ISUBSET]; + DISCH_THEN CHOOSE_TAC; + TSPEC `m` 4; + TYPE_THEN `endpoint G m` SUBGOAL_TAC; + UND 4; + DISCH_THEN IMATCH_MP_TAC ; + UND 10; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + REWRITE_TAC[endpoint]; + USE 0 (MATCH_MP num_closure_size); + TSPEC `(pointI m)` 0; + DISCH_TAC; + REWR 0; + USE 0 (MATCH_MP CARD_SING_CONV); + USE 0 (REWRITE_RULE[SING]); + CHO 0; + USE 0 (REWRITE_RULE[eq_sing]); + USE 10 (REWRITE_RULE[eq_sing]); + USE 10 (REWRITE_RULE[INTER]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let pair_swap_unique = prove_by_refinement( + `!u x (y:A). (u HAS_SIZE 2) /\ (u x) /\ (u y) /\ ~(x = y) ==> + (y = pair_swap u x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC two_exclusion ; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[pair_swap]; + ]);; + (* }}} *) + +let pair_swap_adj = prove_by_refinement( + `!G e m e'. (segment G) /\ (G e) /\ (midpoint G m) /\ + (closure top2 e (pointI m)) /\ + (e' = pair_swap {C | G C /\ closure top2 C (pointI m)} e) ==> + ({C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2) /\ + G e' /\ adj e' e /\ (closure top2 e' (pointI m)) `, + (* {{{ proof *) + [ + REP_GEN_TAC; + TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC; + DISCH_ALL_TAC; + TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC; + USE 3 (REWRITE_RULE[midpoint]); + USE 1 (REWRITE_RULE[segment]); + UND 1; + DISCH_ALL_TAC; + USE 1 (MATCH_MP num_closure_size); + TSPEC `pointI m` 1; + REWR 1; + DISCH_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `X e` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* SUBCONJ_TAC; *) + TYPE_THEN `X e'` SUBGOAL_TAC; + ASM_MESON_TAC[pair_swap]; + DISCH_TAC; + SUBCONJ_TAC; + UND 8; + EXPAND_TAC "X"; + REWRITE_TAC[]; + MESON_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + SUBCONJ_TAC; + UND 8; + EXPAND_TAC "X"; + REWRITE_TAC[]; + MESON_TAC[]; + ASM_REWRITE_TAC[adj]; + ASM_SIMP_TAC[pair_swap]; + REWRITE_TAC[EMPTY_EXISTS]; + ASM_REWRITE_TAC[INTER]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* + A terminal edge is expressed as + (endpoint G m) /\ (closure top2 e (pointI m)) +*) + +let terminal_edge_adj = prove_by_refinement( + `!G e m. (segment G) /\ (G e) /\ (~(G = {e})) /\ + (endpoint G m) /\ (closure top2 e (pointI m)) + ==> + (?! e'. (G e') /\ (adj e e')) `, + (* {{{ proof *) + [ + REP_GEN_TAC; + DISCH_ALL_TAC; + REWRITE_TAC[EXISTS_UNIQUE_ALT ]; + TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC; + IMATCH_MP_TAC midpoint_exists; + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + AND 5; + COPY 5; + USE 5 (REWRITE_RULE[midpoint]); + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + USE 8 (MATCH_MP num_closure_size); + TSPEC `pointI m'` 8; + REWR 8; + TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m')}` ABBREV_TAC; + TYPE_THEN `X e` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `pair_swap X e` EXISTS_TAC; + GEN_TAC; + + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 y) = {(pointI m)}) ` SUBGOAL_TAC; + IMATCH_MP_TAC edge_inter; + ASM_MESON_TAC[segment;ISUBSET;]; + DISCH_THEN CHOOSE_TAC; + (* show m''=m', then X y, then y != e, then it is the PAIR swap *) + TYPE_THEN `ec = (closure top2 e)` ABBREV_TAC; + TYPE_THEN `ec (pointI m'')` SUBGOAL_TAC; + UND 13; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `m'' = m'` SUBGOAL_TAC; + TYPE_THEN `Z = {m | ec (pointI m)}` ABBREV_TAC; + IMATCH_MP_TAC two_exclusion; + TYPE_THEN `Z` EXISTS_TAC; + TYPE_THEN `m` EXISTS_TAC; + CONJ_TAC; + EXPAND_TAC "Z"; + EXPAND_TAC "ec"; + IMATCH_MP_TAC two_endpoint; + ASM_MESON_TAC[segment;ISUBSET]; + EXPAND_TAC "Z"; + ASM_REWRITE_TAC[]; + TYPE_THEN `midpoint G m''` SUBGOAL_TAC ; + IMATCH_MP_TAC inter_midpoint; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `y` EXISTS_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + ASM_MESON_TAC[mid_end_disj]; (* m'' = m' done *) + DISCH_TAC; + TYPE_THEN `X y` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + USE 13 (REWRITE_RULE[INTER;eq_sing]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~(y = e)` SUBGOAL_TAC; + UND 12; + MESON_TAC[adj]; + DISCH_TAC; + IMATCH_MP_TAC (GSYM pair_swap_unique); + ASM_REWRITE_TAC[]; + (* now second direction nsd *) + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASSUME_TAC pair_swap_adj; + TYPEL_THEN [`G`;`e`;`m'`;`pair_swap X e`] (USE 11 o ISPECL); + UND 11; + ASM_REWRITE_TAC[]; + TYPE_THEN `X (pair_swap X e)` SUBGOAL_TAC; + ASM_MESON_TAC[pair_swap]; + DISCH_TAC; + TYPE_THEN `closure top2 (pair_swap X e) (pointI m')` SUBGOAL_TAC; + UND 11; + TYPE_THEN `e'' = pair_swap X e` ABBREV_TAC ; + EXPAND_TAC "X"; + REWRITE_TAC[]; + MESON_TAC[]; + ASM_MESON_TAC[adj_symm]; + ]);; + (* }}} *) + +let psegment_edge = prove_by_refinement( + `!e. (edge e) ==> (psegment {e})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC endpoint_psegment; + ASM_REWRITE_TAC[endpoint;segment;EQ_EMPTY ;INR IN_SING;FINITE_SING;ISUBSET;num_closure]; + CONJ_TAC; + UND 0; + REWRITE_TAC[edge]; + DISCH_TAC ; + CHO 0; + TYPE_THEN `m` EXISTS_TAC; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC CARD_SING; + REWRITE_TAC[SING]; + TYPE_THEN `v_edge m` EXISTS_TAC; + REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ]; + MESON_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC CARD_SING; + REWRITE_TAC[SING]; + TYPE_THEN `h_edge m` EXISTS_TAC; + REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ]; + MESON_TAC[]; + CONJ_TAC; + MESON_TAC[]; + CONJ_TAC ; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[INSERT]; + GEN_TAC; + TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC ; + DISJ1_TAC THEN DISJ2_TAC ; + IMATCH_MP_TAC CARD_SING; + REWRITE_TAC[SING ;eq_sing]; + ASM_MESON_TAC[]; + DISJ2_TAC ; + TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI m)} = {}` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 2 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 2; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[CARD_CLAUSES]; + DISCH_ALL_TAC; + REWRITE_TAC[eq_sing]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let segment_delete = prove_by_refinement( + `!G e m. (segment G) /\ (endpoint G m) /\ + (closure top2 e (pointI m)) /\ (~(G = {e})) + ==> (segment (G DELETE e))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + TYPE_THEN `~G e` ASM_CASES_TAC; + USE 0 (REWRITE_RULE[INR DELETE_NON_ELEMENT]); + ASM_MESON_TAC[]; + REWRITE_TAC[segment]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[FINITE_DELETE;delete_empty]; + CONJ_TAC; + UND 3; + MESON_TAC[ISUBSET ;INR IN_DELETE]; + CONJ_TAC; + GEN_TAC; + REWRITE_TAC[INSERT]; + TYPE_THEN `num_closure (G DELETE e) (pointI m') <=| (num_closure G (pointI m'))` SUBGOAL_TAC; + IMATCH_MP_TAC num_closure_mono; + ASM_REWRITE_TAC[INR IN_DELETE;ISUBSET]; + MESON_TAC[]; + TSPEC `m'` 4; + USE 4 (REWRITE_RULE[INSERT]); + UND 4; + ARITH_TAC; + DISCH_ALL_TAC; + (* tsh1 *) + TYPE_THEN `(?! e'. (G e') /\ (adj e e'))` SUBGOAL_TAC; + IMATCH_MP_TAC terminal_edge_adj; + REWRITE_TAC[segment]; + TYPE_THEN `m` EXISTS_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[EXISTS_UNIQUE_ALT]; + DISCH_THEN CHOOSE_TAC; + (* tsh2 *) + TYPE_THEN `(e INSERT S = G) ==> (S = G DELETE e)` SUBGOAL_TAC; + UND 9; + IMATCH_MP_TAC (TAUT `(a ==> b ==> C) ==> (b ==> a ==> C)`); + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[DELETE_INSERT]; + REWRITE_TAC[DELETE;ISUBSET;]; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + UND 9; + MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + (* tsh3 *) + TYPE_THEN `S e'` ASM_CASES_TAC; + TSPEC `e INSERT S` 5; + UND 5; + DISCH_THEN IMATCH_MP_TAC ; + REWR 0; + ASM_REWRITE_TAC [INR INSERT_SUBSET;NOT_INSERT_EMPTY]; + CONJ_TAC; + UND 9; + MESON_TAC[ISUBSET;INR IN_DELETE]; + DISCH_ALL_TAC; + TSPEC `C` 11; + TSPEC `C'` 11; + REWR 11; (* ok to here *) + (* oth1 *) + TYPE_THEN `C' = e` ASM_CASES_TAC; + ASM_REWRITE_TAC[INSERT]; + ASM_REWRITE_TAC[INSERT]; (* *) + (* UND 12; *) + TYPE_THEN `C = e` ASM_CASES_TAC; + REWR 15; + TSPEC `C'` 12; + REWR 12; + ASM_MESON_TAC[]; + (* start not not -- *) + UND 11; + DISCH_THEN IMATCH_MP_TAC ; + CONJ_TAC; + UND 5; + REWRITE_TAC[INSERT]; + ASM_MESON_TAC[]; + UND 14; + REWRITE_TAC[DELETE]; + ASM_MESON_TAC[]; + (* LAST case *) + TSPEC `S` 5; + TYPE_THEN `S = G` SUBGOAL_TAC; + UND 5; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + UND 9; + REWRITE_TAC[DELETE;ISUBSET]; + MESON_TAC[]; + DISCH_TAC; + DISCH_ALL_TAC; + TYPEL_THEN [`C`;`C'`] (USE 11 o ISPECL); + UND 11; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[DELETE]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TSPEC `C` 12; + TYPE_THEN `G C /\ adj e C` SUBGOAL_TAC; + ASM_MESON_TAC[adj_symm;ISUBSET]; + DISCH_TAC; + REWR 12; + ASM_MESON_TAC[]; + TSPEC `e'` 12; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let other_end = jordan_def `other_end e m = + pair_swap {m | closure top2 e (pointI m)} m`;; + +let other_end_prop = prove_by_refinement( + `!e m. (edge e) /\ (closure top2 e (pointI m))==> + (closure top2 e (pointI (other_end e m))) /\ + (~(other_end e m = m)) /\ + (other_end e (other_end e m) = m)`, + (* {{{ proof *) + [ + REWRITE_TAC[other_end]; + DISCH_ALL_TAC; + USE 0 (MATCH_MP two_endpoint); + TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC; + TYPE_THEN `X m` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC []; + DISCH_TAC; + ASM_SIMP_TAC[pair_swap_invol;pair_swap]; + TYPE_THEN `X (pair_swap X m)` SUBGOAL_TAC ; + ASM_SIMP_TAC[pair_swap]; + EXPAND_TAC "X"; + REWRITE_TAC[]; + ]);; + (* }}} *) + +let num_closure_delete = prove_by_refinement( + `!G e p. (FINITE G) ==> ((num_closure (G DELETE e) p) = + (if ((G e) /\ (closure top2 e p)) then ((num_closure G p) -| 1) + else (num_closure G p)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + COND_CASES_TAC; + REWRITE_TAC[num_closure]; + TYPE_THEN `{C | (G DELETE e) C /\ closure top2 C p} = {C | G C /\ closure top2 C p} DELETE e` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[DELETE ]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `FINITE {C | G C /\ closure top2 C p}` SUBGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[ISUBSET;]; + MESON_TAC[]; + DISCH_TAC; + USE 2 (MATCH_MP CARD_DELETE); + TSPEC `e` 2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[num_closure;DELETE ]; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + TYPE_THEN `x = e` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let psegment_delete_end = prove_by_refinement( + `!G m e. (psegment G) /\ (endpoint G m) /\ (G e) /\ + (closure top2 e (pointI m)) /\ (~(G = {e})) ==> + (endpoint (G DELETE e) = + (((other_end e m) INSERT (endpoint G)) DELETE m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[psegment;segment]; + DISCH_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[psegment;segment;ISUBSET]; + DISCH_TAC; + TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC; + TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC; + EXPAND_TAC "X"; + IMATCH_MP_TAC two_endpoint; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[endpoint;ISUBSET;INSERT;]; + GEN_TAC; + ASM_SIMP_TAC[num_closure_delete]; + REWRITE_TAC[DELETE]; + TYPE_THEN `x = m` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + USE 1 (REWRITE_RULE[endpoint]); + ASM_REWRITE_TAC[]; + ARITH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `x = other_end e m` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + COND_CASES_TAC; + DISCH_TAC; + TYPE_THEN `X x /\ X m /\ X (other_end e m) /\ (~(m= other_end e m))` SUBGOAL_TAC ; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[other_end_prop]; + DISCH_ALL_TAC; + ASM_MESON_TAC[two_exclusion]; + MESON_TAC[]; + (* snd half *) + REWRITE_TAC[SUBSET;endpoint;DELETE_INSERT]; + ASM_SIMP_TAC[other_end_prop]; + ASM_SIMP_TAC[num_closure_delete]; + REWRITE_TAC[INSERT;DELETE ]; + GEN_TAC; + TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC; + ASM_MESON_TAC[psegment;midpoint_exists]; + DISCH_THEN CHOOSE_TAC; + DISCH_THEN DISJ_CASES_TAC; + (* ---m *) + COND_CASES_TAC; + TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m' = m)) /\ (~(x = m'))` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[mid_end_disj]; + ASM_MESON_TAC[two_exclusion]; + USE 10 (REWRITE_RULE[endpoint]); + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[other_end_prop]; + TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m = m'))` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[other_end_prop]; + ASM_MESON_TAC[mid_end_disj]; + DISCH_TAC; + TYPE_THEN `x = m'` SUBGOAL_TAC; + ASM_MESON_TAC[two_exclusion]; + USE 9 (REWRITE_RULE[midpoint]); + ASM_MESON_TAC[ARITH_RULE `(x = 2) ==> (x -| 1 = 1)`]; + ]);; + (* }}} *) + +let endpoint_size2 = prove_by_refinement( + `!G. (psegment G) ==> (endpoint G HAS_SIZE 2)`, + (* {{{ proof *) + [ + TYPE_THEN `(!n G. (psegment G) /\ (G HAS_SIZE n) ==> (endpoint G HAS_SIZE 2)) ==> (!G. (psegment G) ==> endpoint G HAS_SIZE 2)` SUBGOAL_TAC; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `?n. G HAS_SIZE n` SUBGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + CONV_TAC (dropq_conv "n"); + ASM_MESON_TAC[psegment;segment]; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + INDUCT_TAC; + REWRITE_TAC[psegment;segment]; + ASM_MESON_TAC[HAS_SIZE_0]; + DISCH_ALL_TAC; + TYPE_THEN `(?m. (endpoint G m))` SUBGOAL_TAC; + ASM_SIMP_TAC[psegment_endpoint]; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC ; + ASM_MESON_TAC[psegment;segment]; + DISCH_TAC; + TYPE_THEN `?e. (G e /\ closure top2 e (pointI m))` SUBGOAL_TAC; + USE 3 (REWRITE_RULE[endpoint]); + USE 4 (MATCH_MP num_closure_size); + TSPEC `(pointI m)` 4; + REWR 4; + USE 4 (MATCH_MP CARD_SING_CONV); + USE 4(REWRITE_RULE[SING]); + CHO 4; + USE 4 (REWRITE_RULE[eq_sing]); + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `G = {e}` ASM_CASES_TAC; + TYPE_THEN `endpoint G = { m | closure top2 e (pointI m)}` SUBGOAL_TAC; + MATCH_MP_TAC EQ_EXT; + REWRITE_TAC[endpoint]; + USE 4 (MATCH_MP num_closure_size ); + GEN_TAC; + TSPEC `pointI x` 4; + REWR 4; + USE 4 (REWRITE_RULE[INR IN_SING]); + EQ_TAC; + DISCH_TAC; + REWR 4; + USE 4 (MATCH_MP CARD_SING_CONV); + USE 4(REWRITE_RULE[SING;eq_sing]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI x)} ={e}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING ]; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 4; + USE 4 (REWRITE_RULE[HAS_SIZE]); + ASM_MESON_TAC[CARD_SING;SING]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC two_endpoint; + ASM_MESON_TAC[psegment;segment;ISUBSET]; + (*pm*) + (* main case *) + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[psegment;segment;ISUBSET]; + DISCH_TAC; + TSPEC `G DELETE e` 0; + TYPE_THEN `psegment (G DELETE e) /\ G DELETE e HAS_SIZE n` SUBGOAL_TAC; + CONJ_TAC; + REWRITE_TAC[psegment]; + CONJ_TAC; + IMATCH_MP_TAC segment_delete; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[psegment]; + ASM_MESON_TAC[psegment]; + (* it isn't a rectagon if it has an endpoint *) + TYPE_THEN `(endpoint (G DELETE e) (other_end e m)) ` SUBGOAL_TAC; + ASM_SIMP_TAC[psegment_delete_end]; + REWRITE_TAC[DELETE_INSERT]; + COND_CASES_TAC; + ASM_MESON_TAC[other_end_prop]; + REWRITE_TAC[INSERT]; + ASM_MESON_TAC[rectagon_endpoint]; + UND 2; + REWRITE_TAC[HAS_SIZE]; + ASM_MESON_TAC[SUC_INJ;FINITE_DELETE_IMP;CARD_SUC_DELETE]; + DISCH_TAC; + REWR 0; + UND 0; + ASM_SIMP_TAC[psegment_delete_end]; + DISCH_TAC; + TYPE_THEN `G' = (other_end e m INSERT endpoint G)` ABBREV_TAC; + TYPE_THEN `G' HAS_SIZE 3` SUBGOAL_TAC; + UND 0; + REWRITE_TAC[HAS_SIZE;ARITH_RULE `3 = SUC 2`;FINITE_DELETE]; + TYPE_THEN `G' m` SUBGOAL_TAC; + EXPAND_TAC "G'"; + KILL 9; + ASM_REWRITE_TAC [INSERT]; + ASM_MESON_TAC[CARD_SUC_DELETE]; + (* nearly there! *) + EXPAND_TAC "G'"; + REWRITE_TAC[HAS_SIZE;FINITE_INSERT]; + DISCH_ALL_TAC; + UND 11; + ASM_SIMP_TAC [CARD_CLAUSES]; + COND_CASES_TAC; + TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC; + IMATCH_MP_TAC midpoint_exists; + ASM_MESON_TAC[psegment]; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `X = { m | closure top2 e (pointI m) }` ABBREV_TAC; + TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC; + USE 7 (MATCH_MP two_endpoint); + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `X m /\ X m' /\ X (other_end e m) /\ (~(m=m')) /\ (~(m= other_end e m)) /\ (~(m'=other_end e m))` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[other_end_prop]; + ASM_MESON_TAC [mid_end_disj]; + ASM_MESON_TAC[two_exclusion]; + ARITH_TAC; + ]);; + (* }}} *) + +let sing_has_size1 = prove_by_refinement( + `!(x:A). {x} HAS_SIZE 1`, + (* {{{ proof *) + [ + REWRITE_TAC[HAS_SIZE]; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[FINITE_SING ]; + ASM_MESON_TAC[CARD_SING;SING]; + ]);; + (* }}} *) + +let num_closure1 = prove_by_refinement( + `!G x. (FINITE G) ==> + ((num_closure G (x) = 1) <=> + (?e. (!e'. (G e' /\ (closure top2 e' (x))) <=> (e = e'))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + COPY 0; + USE 0 (MATCH_MP (num_closure_size)); + TSPEC `x` 0; + TYPE_THEN `t = num_closure G x` ABBREV_TAC; + EQ_TAC; + DISCH_TAC; + REWR 0; + USE 0 (MATCH_MP CARD_SING_CONV); + USE 0 (REWRITE_RULE[SING;eq_sing]); + CHO 0; + TYPE_THEN `x'` EXISTS_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + CHO 3; + TYPE_THEN `{C | G C /\ closure top2 C x} = {e}` SUBGOAL_TAC; + REWRITE_TAC[eq_sing]; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 0; + TYPE_THEN `e` (fun t -> ASSUME_TAC (ISPEC t sing_has_size1)); + UND 5; + UND 0; + REWRITE_TAC [HAS_SIZE]; + MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* SECTION D *) +(* ------------------------------------------------------------------ *) + + + +let inductive_set = jordan_def `inductive_set G S <=> + S SUBSET G /\ + ~(S = {}) /\ + (!C C'. S C /\ G C' /\ adj C C' ==> S C')`;; + +let inductive_univ = prove_by_refinement( + `!G. (~(G = EMPTY )) ==> (inductive_set G G)`, + (* {{{ proof *) + [ + REWRITE_TAC[inductive_set]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inductive_inter = prove_by_refinement( + `!T G. (T SUBSET G) /\ (~(T = EMPTY )) ==> + (inductive_set G + (INTERS {S | (T SUBSET S) /\ (inductive_set G S)}))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ONCE_REWRITE_TAC[inductive_set]; + CONJ_TAC; + IMATCH_MP_TAC INTERS_SUBSET2; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC inductive_univ; + UND 1; + REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[ISUBSET]; + CONJ_TAC; + USE 1 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 1; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + REWRITE_TAC[INTERS]; + DISCH_ALL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[INTERS]); + REWRITE_TAC[INTERS]; + DISCH_ALL_TAC; + TSPEC `u` 2; + REWR 2; + ASM_MESON_TAC[inductive_set]; + ]);; + (* }}} *) + +let segment_of = jordan_def `segment_of G e = + INTERS { S | S e /\ inductive_set G S }`;; + +let inductive_segment = prove_by_refinement( + `!G e. (G e) ==> (inductive_set G (segment_of G e))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[segment_of]; + ASSUME_TAC inductive_inter; + TYPEL_THEN [`{e}`;`G`] (USE 1 o ISPECL); + USE 1 (REWRITE_RULE[single_subset;EMPTY_EXISTS;INR IN_SING ]); + UND 1; + DISCH_THEN IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let segment_of_G = prove_by_refinement( + `!G e. (G e) ==> (segment_of G e ) SUBSET G`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_of]; + DISCH_ALL_TAC; + IMATCH_MP_TAC (INR INTERS_SUBSET2 ); + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC inductive_univ; + REWRITE_TAC [EMPTY_EXISTS]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let segment_not_in = prove_by_refinement( + `!G e. ~(G e) ==> (segment_of G e = UNIV)`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_of;]; + DISCH_ALL_TAC; + TYPE_THEN `{S | S e /\ inductive_set G S} = EMPTY ` SUBGOAL_TAC ; + REWRITE_TAC[EQ_EMPTY]; + GEN_TAC; + REWRITE_TAC[inductive_set]; + ASM_MESON_TAC[ISUBSET]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let segment_of_finite = prove_by_refinement( + `!G e. (FINITE G) /\ (G e) ==> (FINITE (segment_of G e))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + ASM_MESON_TAC[segment_of_G]; + ]);; + (* }}} *) + +let segment_of_in = prove_by_refinement( + `!G e. (segment_of G e e)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `G e` ASM_CASES_TAC; + REWRITE_TAC[segment_of;INTERS;inductive_set ]; + MESON_TAC[]; + ASM_SIMP_TAC[segment_not_in]; + ]);; + (* }}} *) + +let segment_of_subset = prove_by_refinement( + `!G e f. (G e) /\ (segment_of G e f) ==> + (segment_of G f) SUBSET (segment_of G e)`, + (* {{{ proof *) + [ + REWRITE_TAC[ISUBSET;segment_of;INTERS ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inductive_diff = prove_by_refinement( + `!G S S'. (inductive_set G S) /\ + (inductive_set G S') /\ ~(S DIFF S' = {}) ==> + (inductive_set G (S DIFF S'))`, + (* {{{ proof *) + [ + REWRITE_TAC[inductive_set;DIFF;SUBSET ]; + ASM_MESON_TAC[adj_symm]; + ]);; + (* }}} *) + +(* sets *) +let subset_imp_eq = prove_by_refinement( + `!A (B:A->bool). (A SUBSET B) /\ (B DIFF A = EMPTY) ==> (A = B)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;DIFF;EQ_EMPTY]; + MESON_TAC[EQ_EXT]; + ]);; + (* }}} *) + +let segment_of_eq = prove_by_refinement( + `!G e f. (G e) /\ (segment_of G e f) ==> + ((segment_of G e) = (segment_of G f))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC (GSYM subset_imp_eq); + CONJ_TAC; + ASM_MESON_TAC[segment_of_subset]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `G f` SUBGOAL_TAC; + USE 0 (MATCH_MP segment_of_G); + USE 0 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `X = (segment_of G e DIFF segment_of G f)` ABBREV_TAC; + TYPE_THEN `X e` SUBGOAL_TAC; + EXPAND_TAC "X"; + REWRITE_TAC[DIFF]; + ASM_SIMP_TAC [segment_of_in]; + DISCH_ALL_TAC; + USE 2 (GSYM); + USE 2 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 2; + UND 2; + EXPAND_TAC "X"; + REWRITE_TAC[DIFF]; + JOIN 3 5; + USE 2 (MATCH_MP segment_of_subset); + ASM_MESON_TAC[ISUBSET]; (* done WITH X e *) + DISCH_TAC; + TYPE_THEN `inductive_set G (segment_of G e DIFF segment_of G f)` SUBGOAL_TAC ; + IMATCH_MP_TAC inductive_diff; + ASM_SIMP_TAC[inductive_segment]; + DISCH_TAC; + TYPE_THEN `segment_of G e SUBSET X` SUBGOAL_TAC; + REWRITE_TAC[segment_of]; + IMATCH_MP_TAC INTERS_SUBSET; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET]; + LEFT_TAC "x"; + TYPE_THEN `f` EXISTS_TAC; + EXPAND_TAC "X"; + REWRITE_TAC[DIFF]; + ASM_MESON_TAC[segment_of_in]; + ]);; + (* }}} *) + +let segment_of_segment = prove_by_refinement( + `!G P e. (segment G) /\ (P SUBSET G) /\ (P e) ==> + (segment (segment_of P e))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + TYPE_THEN `FINITE P` SUBGOAL_TAC; + ASM_MESON_TAC[FINITE_SUBSET]; + DISCH_TAC; + REWRITE_TAC[segment]; + ASM_SIMP_TAC[segment_of_finite;EMPTY_EXISTS]; + CONJ_TAC; + ASM_MESON_TAC[segment_of_in]; + SUBCONJ_TAC; + UND 1; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + MP_TAC segment_of_G; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASSUME_TAC segment_of_G; + (* ok to here *) + CONJ_TAC; + GEN_TAC; + REWRITE_TAC[INSERT]; + TYPEL_THEN [`P`;`e`] (USE 6 o ISPECL); + REWR 6; + JOIN 4 6; + USE 4 (MATCH_MP num_closure_mono); + TSPEC `pointI m` 4; + UND 4; + JOIN 3 1; + USE 1 (MATCH_MP num_closure_mono); + TSPEC `(pointI m)` 1; + UND 1; + UND 0; + REWRITE_TAC[segment]; + REWRITE_TAC[INSERT]; + DISCH_ALL_TAC; + TSPEC `m` 7; + UND 7; + UND 0; + UND 1; + ARITH_TAC; + (* ok2 *) + DISCH_ALL_TAC; + CHO 8; + (* IMATCH_MP_TAC subset_imp_eq; *) + IMATCH_MP_TAC SUBSET_ANTISYM; + ASM_REWRITE_TAC[]; + (* PROOF_BY_CONTR_TAC; *) + TYPE_THEN `! C C'. S C /\ P C' /\ adj C C' ==> S C'` SUBGOAL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `segment_of P C C'` SUBGOAL_TAC; + REWRITE_TAC[segment_of;INTERS;]; + X_GEN_TAC `R:((num->real)->bool)->bool`; + REWRITE_TAC[inductive_set]; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `segment_of P e = segment_of P C` SUBGOAL_TAC ; + IMATCH_MP_TAC segment_of_eq; + ASM_MESON_TAC[ISUBSET]; + DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `inductive_set P S` SUBGOAL_TAC; + REWRITE_TAC[inductive_set]; + ASM_REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[ISUBSET;segment_of_G]; + TYPE_THEN `segment_of P e = segment_of P u` SUBGOAL_TAC; + IMATCH_MP_TAC segment_of_eq; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[segment_of]; + DISCH_TAC; + IMATCH_MP_TAC (INR INTERS_SUBSET); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* move up *) +let rectagon_subset = prove_by_refinement( + `!G S. (rectagon G) /\ (segment S) /\ (G SUBSET S) ==> (G = S)`, + (* {{{ proof *) + + [ + REWRITE_TAC[rectagon;segment]; + DISCH_ALL_TAC; + TSPEC `G` 9; + UND 9 ; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC; + ASM_MESON_TAC[edge_inter]; + DISCH_TAC; + CHO 14; + (*loss*) + COPY 10; + COPY 5; + JOIN 5 10; + USE 5 (MATCH_MP num_closure_mono); + TSPEC `pointI m` 5; + TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC; + TSPEC `m` 3; + USE 3 (REWRITE_RULE[INSERT]); + UND 3; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + UND 3; + USE 0 (MATCH_MP num_closure_size); + TSPEC `(pointI m)` 0; + DISCH_ALL_TAC; + REWR 0; + USE 0 (REWRITE_RULE[HAS_SIZE_0]); + UND 0; + REWRITE_TAC[EMPTY_EXISTS ]; + UND 14; + REWRITE_TAC[INTER;eq_sing; ]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `num_closure S (pointI m) = 2` SUBGOAL_TAC; + TSPEC `m` 8; + USE 8(REWRITE_RULE[INSERT]); + UND 8; + TSPEC `m` 3; + USE 3 (REWRITE_RULE[INSERT]); + UND 3; + UND 5; + UND 10; + ARITH_TAC; + DISCH_TAC; + (* ok *) + (* num_closure G = num_closure S, C' in latter, so in former *) + TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} = {C | S C /\ closure top2 C (pointI m)}` SUBGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET_LE; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `S` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET]; + MESON_TAC[]; + CONJ_TAC; + UND 15; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + USE 0 (MATCH_MP num_closure_size); + TSPEC `pointI m` 0; + USE 16 (MATCH_MP num_closure_size); + TSPEC `pointI m` 16; + UND 16; + UND 0; + ASM_REWRITE_TAC [HAS_SIZE]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + DISCH_TAC; + TAPP `C'` 18; + UND 18; + ASM_REWRITE_TAC[]; + UND 14; + REWRITE_TAC[INTER;eq_sing]; + MESON_TAC[]; + ]);; + + (* }}} *) + +let rectagon_h_edge = prove_by_refinement( + `!G. (rectagon G) ==> (?m. (G (h_edge m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `!e. G e ==> (?m. (e= (v_edge m))) ` SUBGOAL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_THEN DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `X = {m | (G (v_edge m)) }` ABBREV_TAC; + TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC; + CONJ_TAC; + TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (v_edge) C)` SUBGOAL_TAC ; + IMATCH_MP_TAC finite_subset; + REWRITE_TAC[IMAGE;SUBSET]; + EXPAND_TAC "X"; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + CONJ_TAC; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[rectagon]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + TYPE_THEN `C = X` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_ALL_TAC; + UND 7; + EXPAND_TAC "X"; + REWRITE_TAC[]; + UND 6; + REWRITE_TAC[IMAGE]; + DISCH_THEN_REWRITE ; + DISCH_THEN CHOOSE_TAC; + USE 6 (REWRITE_RULE[v_edge_inj;h_edge_inj]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + USE 0 (REWRITE_RULE[rectagon]); + UND 0; + DISCH_ALL_TAC; + USE 5(REWRITE_RULE[EMPTY_EXISTS]); + CHO 5; + TSPEC `u` 2; + REWR 2; + CHO 2; + UND 0; + EXPAND_TAC "X"; + REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* dwf done finite X ... Messed up. X must have type real->bool. *) + TYPE_THEN `Y = IMAGE (real_of_int o SND ) X` ABBREV_TAC; + TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC; + CONJ_TAC; + EXPAND_TAC "Y"; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;EMPTY_EXISTS ]; + CONV_TAC (dropq_conv "u"); + AND 4; + USE 4 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 4; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 6 (MATCH_MP min_finite); + CHO 6; + TYPE_THEN `?m. (G (v_edge m)) /\ (real_of_int (SND m) = delta)` SUBGOAL_TAC; + USE 5 (REWRITE_RULE[IMAGE;o_DEF]); + TAPP `delta` 5; + REWR 5; + CHO 5; + TAPP `x` 3; + REWR 3; + ASM_MESON_TAC[]; + DISCH_TAC; + CHO 7; + (* now show that m is an endpoint *) + TYPE_THEN `endpoint G m` SUBGOAL_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + ASM_SIMP_TAC[num_closure1]; + TYPE_THEN `v_edge m` EXISTS_TAC; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e'` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[v_edge_inj]; + REWR 10; + USE 10 (REWRITE_RULE[v_edge_closure;vc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; v_edge_pointI]); + UND 10; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN ` Y (real_of_int (SND m'))` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE]; + TYPE_THEN `m'` EXISTS_TAC; + REWRITE_TAC[o_DEF]; + EXPAND_TAC "X"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + AND 6; + TSPEC `(real_of_int(SND m'))` 6; + REWR 6; + USE 7 GSYM; + REWR 6; + USE 6 (REWRITE_RULE[int_suc ]); + ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`]; + ASM_MESON_TAC[hv_edgeV2]; + DISCH_TAC; + EXPAND_TAC "e'"; + ASM_REWRITE_TAC[]; + EXPAND_TAC "e'"; + REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING ;]; + ASM_MESON_TAC[rectagon_endpoint]; + ]);; + (* }}} *) + +let rectagon_v_edge = prove_by_refinement( + `!G. (rectagon G) ==> (?m. (G (v_edge m)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `!e. G e ==> (?m. (e= (h_edge m))) ` SUBGOAL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_THEN DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `X = {m | (G (h_edge m)) }` ABBREV_TAC; + TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC; + CONJ_TAC; + TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (h_edge) C)` SUBGOAL_TAC ; + IMATCH_MP_TAC finite_subset; + REWRITE_TAC[IMAGE;SUBSET]; + EXPAND_TAC "X"; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + CONJ_TAC; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[rectagon]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + TYPE_THEN `C = X` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_ALL_TAC; + UND 7; + EXPAND_TAC "X"; + REWRITE_TAC[]; + UND 6; + REWRITE_TAC[IMAGE]; + DISCH_THEN_REWRITE ; + DISCH_THEN CHOOSE_TAC; + USE 6 (REWRITE_RULE[h_edge_inj;v_edge_inj]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + USE 0 (REWRITE_RULE[rectagon]); + UND 0; + DISCH_ALL_TAC; + USE 5(REWRITE_RULE[EMPTY_EXISTS]); + CHO 5; + TSPEC `u` 2; + REWR 2; + CHO 2; + UND 0; + EXPAND_TAC "X"; + REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* dwfx done finite X ... Messed up. X must have type real->bool. *) + TYPE_THEN `Y = IMAGE (real_of_int o FST ) X` ABBREV_TAC; + TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC; + CONJ_TAC; + EXPAND_TAC "Y"; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;EMPTY_EXISTS ]; + CONV_TAC (dropq_conv "u"); + AND 4; + USE 4 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 4; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 6 (MATCH_MP min_finite); + CHO 6; + TYPE_THEN `?m. (G (h_edge m)) /\ (real_of_int (FST m) = delta)` SUBGOAL_TAC; + USE 5 (REWRITE_RULE[IMAGE;o_DEF]); + TAPP `delta` 5; + REWR 5; + CHO 5; + TAPP `x` 3; + REWR 3; + ASM_MESON_TAC[]; + DISCH_TAC; + CHO 7; + (* now show that m is an endpoint *) + TYPE_THEN `endpoint G m` SUBGOAL_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + ASM_SIMP_TAC[num_closure1]; + TYPE_THEN `h_edge m` EXISTS_TAC; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e'` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + IMATCH_MP_TAC (TAUT `((A \/ B) ==> C) ==> ((B \/ A) ==> C)`); + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[h_edge_inj]; + REWR 10; + USE 10 (REWRITE_RULE[h_edge_closure;hc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; h_edge_pointI]); + UND 10; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN ` Y (real_of_int (FST m'))` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE]; + TYPE_THEN `m'` EXISTS_TAC; + REWRITE_TAC[o_DEF]; + EXPAND_TAC "X"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + AND 6; + TSPEC `(real_of_int(FST m'))` 6; + REWR 6; + USE 7 GSYM; + REWR 6; + USE 6 (REWRITE_RULE[int_suc ]); + ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`]; + ASM_MESON_TAC[hv_edgeV2]; + DISCH_TAC; + EXPAND_TAC "e'"; + ASM_REWRITE_TAC[]; + EXPAND_TAC "e'"; + REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING ;]; + ASM_MESON_TAC[rectagon_endpoint]; + ]);; + + (* }}} *) + +(* move down *) +let part_below = jordan_def `part_below G m = + {C | G C /\ + ((?n. (C = v_edge n) /\ (SND n <=: SND m) /\ (FST n = FST m)) \/ + (?n. (C = h_edge n) /\ (SND n <=: SND m) /\ + (closure top2 C (pointI (FST m,SND n))))) }`;; + +let part_below_h = prove_by_refinement( + `!G m n. part_below G m (h_edge n) <=> + (set_lower G m n) \/ (set_lower G (left m) n)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[part_below;set_lower;left ]; + REWRITE_TAC[h_edge_closure;hc_edge;UNION ;h_edge_pointI]; + REWRITE_TAC[hv_edgeV2;plus_e12;INR IN_SING ;pointI_inj ;PAIR_SPLIT ]; + REWRITE_TAC[h_edge_inj]; + CONV_TAC (dropq_conv "n'"); + REWRITE_TAC[INT_ARITH `(x = y+: &:1) <=> (x -: (&:1) = y)`]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let part_below_v = prove_by_refinement( + `!G m n. part_below G m (v_edge n) <=> + (G (v_edge n)) /\ (FST n = FST m) /\ (SND n <=: SND m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[part_below;v_edge_closure;vc_edge;UNION;plus_e12; INR IN_SING; pointI_inj ; PAIR_SPLIT; v_edge_inj; hv_edgeV2]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* sets *) +let has_size_bij = prove_by_refinement( + `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f {m | m < n} A)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_TAC; + USE 0 (MATCH_MP (INR HAS_SIZE_INDEX)); + CHO 0; + REWRITE_TAC[BIJ;INJ ;SURJ ;]; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + USE 0 (REWRITE_RULE[EXISTS_UNIQUE_ALT]); + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + REWRITE_TAC[HAS_SIZE]; + ASSUME_TAC CARD_NUMSEG_LT; + TSPEC `n` 1; + EXPAND_TAC "n"; + SUBCONJ_TAC; + ASSUME_TAC FINITE_NUMSEG_LT; + TSPEC `n` 2; + JOIN 2 0; + USE 0 (MATCH_MP FINITE_BIJ); + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC (GSYM BIJ_CARD); + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_NUMSEG_LT]; + ]);; + (* }}} *) + +let has_size_bij2 = prove_by_refinement( + `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f A {m | m < n})`, + (* {{{ proof *) + [ + REWRITE_TAC[has_size_bij]; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `INV f {m | m <| n} A` EXISTS_TAC; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `INV f A {m | m <| n}` EXISTS_TAC; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let fibre_card = prove_by_refinement( + `!(f:A->B) A B m n. (B HAS_SIZE n) /\ (IMAGE f A SUBSET B) /\ + (!b. (B b) ==> ({u | (A u) /\ (f u = b)} HAS_SIZE m)) ==> + (A HAS_SIZE m*n)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `!b. ?g. (B b) ==> (BIJ g {u | (A u) /\ (f u = b)} {j | j <| m})` SUBGOAL_TAC; + DISCH_ALL_TAC; + RIGHT_TAC "g"; + DISCH_TAC; + REWRITE_TAC[GSYM has_size_bij2]; + TSPEC `b` 2; + REWR 2; + DISCH_TAC; + LEFT 3 "g"; + CHO 3; + (* case m=0 *) + DISJ_CASES_TAC (ARITH_RULE `(m=0) \/ 0 < m`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + REWRITE_TAC[HAS_SIZE_0]; + REWR 2; + USE 2 (REWRITE_RULE[HAS_SIZE_0]); + USE 1 (REWRITE_RULE[IMAGE;ISUBSET ]); + PROOF_BY_CONTR_TAC; + USE 5 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 5; + USE 1 (CONV_RULE NAME_CONFLICT_CONV); + USE 1 (CONV_RULE (dropq_conv "x''")); + TSPEC `u` 1; + REWR 1; + TSPEC `f u` 2; + REWR 2; + USE 2 (REWRITE_RULE[EQ_EMPTY]); + ASM_MESON_TAC[]; + TYPE_THEN `BIJ (\x. (f x, g (f x) x)) A {(x,y) | B x /\ {j|j <|m} y}` SUBGOAL_TAC; + REWRITE_TAC[BIJ;INJ;SURJ]; + SUBCONJ_TAC; + SUBCONJ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `f x` EXISTS_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "y"); + SUBCONJ_TAC; + UND 1; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + TSPEC `f x` 3; + REWR 3; + UND 3; + REWRITE_TAC[BIJ;SURJ]; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + DISCH_ALL_TAC; + USE 8(REWRITE_RULE[PAIR_SPLIT]); + AND 8; + REWR 8; + (* r8 *) + TYPE_THEN `B (f y)` SUBGOAL_TAC; + UND 1; + REWRITE_TAC [IMAGE;SUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + TSPEC `f y` 3; + REWR 3; + USE 3 (REWRITE_RULE[BIJ;INJ]); + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + GEN_TAC; + NAME_CONFLICT_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "x'"); + NAME_CONFLICT_TAC; + GEN_TAC; + LEFT_TAC "x''"; + GEN_TAC; + RIGHT_TAC "y''"; + DISCH_THEN_REWRITE ; + RIGHT_TAC "y''"; + DISCH_ALL_TAC; + USE 9 GSYM; + REWR 8; + ASM_REWRITE_TAC[]; + KILL 9; + TSPEC `FST x` 2; + REWR 2; + TSPEC `FST x` 3; + REWR 3; + USE 3 (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + REWRITE_TAC[HAS_SIZE]; + DISCH_TAC; + (* r9 *) + TYPE_THEN `FINITE B /\ FINITE {j | j <| m}` SUBGOAL_TAC; + ASM_REWRITE_TAC[FINITE_NUMSEG_LT]; + ASM_MESON_TAC[HAS_SIZE]; + DISCH_TAC; + COPY 6; + USE 6 (MATCH_MP (INR FINITE_PRODUCT)); + REWR 6; + COPY 7; + USE 7 (MATCH_MP (INR CARD_PRODUCT)); + SUBCONJ_TAC; + JOIN 6 5; + USE 5 (MATCH_MP FINITE_BIJ2); + ASM_REWRITE_TAC[]; + DISCH_TAC; + JOIN 9 5; + USE 5 (MATCH_MP BIJ_CARD); + REWR 7; + ASM_REWRITE_TAC[CARD_NUMSEG_LT]; + USE 0 (REWRITE_RULE[HAS_SIZE]); + ASM_REWRITE_TAC[]; + ARITH_TAC; + ]);; + (* }}} *) + +(* sets *) +let even_card_even = prove_by_refinement( + `!X (Y:A->bool). (FINITE X) /\ (FINITE Y) /\ (X INTER Y = EMPTY) ==> + ((EVEN (CARD X) <=> EVEN (CARD Y)) <=> (EVEN (CARD (X UNION Y))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC [CARD_UNION]; + REWRITE_TAC[EVEN_ADD]; + ]);; + (* }}} *) + + +(* + terminal edge: (endpoint G m) /\ (closure top2 e (pointI m)) + produce bij-MAP from terminal edges to endpoints (of P SUBSET G) + 2-1 MAP from terminal edges to segments. + Hence an EVEN number of endpoints. + +*) + + + +let terminal_edge = jordan_def `terminal_edge G m = + @e. (G e) /\ (closure top2 e (pointI m))`;; + +let terminal_endpoint = prove_by_refinement( + `!G m. (FINITE G) /\ (endpoint G m) ==> ((G (terminal_edge G m)) /\ + (closure top2 (terminal_edge G m) (pointI m)) ) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[terminal_edge]; + SELECT_TAC; + MESON_TAC[]; + ASM_MESON_TAC[endpoint_edge;EXISTS_UNIQUE_ALT]; + ]);; + (* }}} *) + +let terminal_unique = prove_by_refinement( + `!G m e. (FINITE G) /\ (endpoint G m) ==> + ( (G e) /\ (closure top2 e (pointI m)) <=> (e = terminal_edge G m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + REWRITE_TAC[terminal_edge]; + SELECT_TAC; + USE 1(REWRITE_RULE[endpoint]); + ASM_MESON_TAC[num_closure1]; + ASM_MESON_TAC[terminal_endpoint]; + ASM_MESON_TAC[terminal_endpoint]; + ]);; + (* }}} *) + + +let segment_of_endpoint = prove_by_refinement( + `!P e m. (P e) /\ (FINITE P) ==> + (endpoint P m /\ + (segment_of P (terminal_edge P m) = segment_of P e) + <=> + endpoint (segment_of P e) m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE (segment_of P e)` SUBGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + ASM_MESON_TAC[segment_of_G]; + DISCH_TAC; + EQ_TAC; + DISCH_ALL_TAC; + COPY 3; + UND 5; + REWRITE_TAC[endpoint]; + ASM_SIMP_TAC[num_closure1]; + DISCH_ALL_TAC; + CHO 5; + TYPE_THEN `e'` EXISTS_TAC; + DISCH_ALL_TAC; + EQ_TAC; + USE 0 (MATCH_MP segment_of_G); + ASM_MESON_TAC[ISUBSET]; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + COPY 5; + TSPEC `e'` 5; + USE 5 (REWRITE_RULE[]); + ASM_REWRITE_TAC[]; + UND 4; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + TSPEC `terminal_edge P m` 6; + UND 4; + ASM_SIMP_TAC[terminal_endpoint]; + REWRITE_TAC[segment_of_in]; + DISCH_TAC; + (* se *) + SUBCONJ_TAC; + UND 3; + REWRITE_TAC[endpoint]; + ASM_SIMP_TAC[num_closure1]; + DISCH_ALL_TAC; + CHO 3; + TYPE_THEN `e'` EXISTS_TAC; + DISCH_ALL_TAC; + EQ_TAC; + TYPE_THEN `P e'' /\ closure top2 e'' (pointI m) ==> segment_of P e e''` SUBGOAL_TAC; + DISCH_ALL_TAC; + COPY 3; + TSPEC `e'` 3; + USE 3 (REWRITE_RULE []); + TYPE_THEN `e'' = e'` ASM_CASES_TAC; + ASM_MESON_TAC[]; + USE 0 (MATCH_MP inductive_segment); + USE 0 (REWRITE_RULE[inductive_set]); + UND 0; + DISCH_ALL_TAC; + TYPEL_THEN [`e'`;`e''`] (USE 9 o ISPECL); + UND 9; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[adj;EMPTY_EXISTS;]; + TYPE_THEN `pointI m` EXISTS_TAC; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + ASM_MESON_TAC[segment_of_G;ISUBSET ]; + (* I'm getting lost in the thickets *) + (* se2 *) + DISCH_TAC; + IMATCH_MP_TAC (GSYM segment_of_eq); + ASM_REWRITE_TAC[]; + COPY 4; + COPY 3; + UND 3; + UND 4; + REWRITE_TAC[endpoint]; + ASM_SIMP_TAC[num_closure1]; + DISCH_THEN CHOOSE_TAC; + DISCH_THEN CHOOSE_TAC; + (* *) + COPY 3; + TSPEC `e''` 3; + TYPE_THEN `e' = e''` SUBGOAL_TAC; + TSPEC `e''` 4; + USE 4 (REWRITE_RULE[]); + ASM_MESON_TAC[segment_of_G;ISUBSET ]; + DISCH_TAC; + TSPEC `terminal_edge P m` 7; + TYPE_THEN `e' = terminal_edge P m` SUBGOAL_TAC; + ASM_MESON_TAC[terminal_endpoint]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let fibre2 = prove_by_refinement( + `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==> + (!S. ({ S | (?e. (P e) /\ (S = segment_of P e)) } S) ==> + ({m | (endpoint P m) /\ (segment_of P (terminal_edge P m) = S)} + HAS_SIZE 2))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[]; + DISCH_ALL_TAC; + CHO 3; + ASM_REWRITE_TAC[]; + USE 3 (CONJUNCT1 ); + TYPE_THEN `psegment (segment_of P e)` SUBGOAL_TAC; + REWRITE_TAC[psegment]; + CONJ_TAC; + ASM_MESON_TAC[rectagon_subset;segment_of_G;segment_of_segment]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `segment_of P e = G` SUBGOAL_TAC; + IMATCH_MP_TAC rectagon_subset; + REWR 4; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[SUBSET_TRANS;segment_of_G]; + USE 3 (MATCH_MP segment_of_G); + DISCH_TAC; + REWR 3; + JOIN 1 3; + USE 1 (MATCH_MP SUBSET_ANTISYM); + REWR 4; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 4 (MATCH_MP endpoint_size2); + TYPE_THEN `{m | endpoint P m /\ (segment_of P (terminal_edge P m) = segment_of P e)} = endpoint (segment_of P e)` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC ; + REWRITE_TAC[]; + (* f2 *) + IMATCH_MP_TAC segment_of_endpoint; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC FINITE_SUBSET; + ASM_MESON_TAC[segment]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let endpoint_even = prove_by_refinement( + `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==> + (endpoint P HAS_SIZE 2 *| + (CARD {S | (?e. (P e) /\ (S = segment_of P e))}) )`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `f = (segment_of P) o (terminal_edge P)` ABBREV_TAC; + TYPE_THEN `B = { S | (?e. (P e) /\ (S = segment_of P e)) }` ABBREV_TAC; + TYPE_THEN `f` (fun t-> IMATCH_MP_TAC (ISPEC t fibre_card)); + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[HAS_SIZE;IMAGE;SUBSET ; ]; + EXPAND_TAC "B"; + EXPAND_TAC "f"; + REWRITE_TAC[o_DEF ]; + SUBCONJ_TAC; + TYPE_THEN `{S | ?e. P e /\ (S = segment_of P e)} = IMAGE (\x. (segment_of P x)) P` SUBGOAL_TAC; + REWRITE_TAC[IMAGE]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC FINITE_SUBSET ; + ASM_MESON_TAC[segment]; + DISCH_TAC; + CONJ_TAC; + NAME_CONFLICT_TAC; + GEN_TAC; + DISCH_THEN CHOOSE_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `terminal_edge P x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `FINITE P` SUBGOAL_TAC; + ASM_MESON_TAC[segment;FINITE_SUBSET]; + ASM_MESON_TAC[terminal_endpoint]; + (* ee *) + REWRITE_TAC[GSYM HAS_SIZE]; + ASSUME_TAC fibre2; + USE 6 (REWRITE_RULE[]); + UND 6; + DISCH_THEN IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let num_closure0 = prove_by_refinement( + `! G x. + FINITE G ==> ((num_closure G x = 0) <=> + (!e. (G e) ==> (~(closure top2 e x))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 0 (MATCH_MP num_closure_size); + TSPEC `x` 0; + EQ_TAC; + DISCH_TAC; + REWR 0; + USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY ]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `{C | G C /\ closure top2 C x} = {}` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 2 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 2; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 0; + USE 0 (REWRITE_RULE[HAS_SIZE]); + ASM_MESON_TAC[CARD_CLAUSES]; + ]);; + (* }}} *) + +let num_closure2 = prove_by_refinement( + `!G x. + FINITE G ==> ((num_closure G x = 2) <=> + (?a b. (~(a = b)) /\ + ((!e. (G e /\ closure top2 e x) <=> (( e= a)\/ (e =b))))))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + USE 0 (MATCH_MP num_closure_size); + TSPEC `x` 0; + EQ_TAC; + DISCH_TAC; + REWR 0; + USE 0 (REWRITE_RULE[has_size2 ; ]); + CHO 0; + CHO 0; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + AND 0; + TAPP `e` 2; + USE 2(REWRITE_RULE[INSERT]); + ASM_MESON_TAC[]; + DISCH_TAC; + CHO 1; + CHO 1; + TYPE_THEN `X = {C | G C /\ closure top2 C x} ` ABBREV_TAC; + TYPE_THEN `(?a b. (X = {a, b}) /\ ~(a = b))` SUBGOAL_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INSERT]; + EXPAND_TAC "X"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 3 (REWRITE_RULE[GSYM has_size2]); + RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let endpoint_subrectagon = prove_by_refinement( + `!G P m. (rectagon G) /\ (P SUBSET G) ==> + ((endpoint P m) <=> + (?C C'. (P C) /\ (G C') /\ (~(P C')) /\ (~(C = C')) /\ + (closure top2 C (pointI m)) /\ (closure top2 C' (pointI m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + TYPE_THEN `FINITE P` SUBGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + ASM_MESON_TAC[]; + DISCH_TAC; + EQ_TAC; + DISCH_TAC; + TYPE_THEN `midpoint G m` SUBGOAL_TAC; + REWRITE_TAC[midpoint]; + USE 0 (REWRITE_RULE[rectagon;INSERT]); + UND 0; + DISCH_ALL_TAC; + TSPEC `m` 7; + UND 7; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + USE 4 (REWRITE_RULE[endpoint]); + JOIN 0 1; + USE 0 (MATCH_MP num_closure_mono); + ASM_MESON_TAC[ARITH_RULE `~(1 <=| 0)`]; + REWRITE_TAC[midpoint]; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_THEN (MP_TAC o (MATCH_MP num_closure_size)); + DISCH_ALL_TAC; + TSPEC `pointI m` 6; + REWR 6; + USE 4 (REWRITE_RULE[endpoint]); + UND 4; + ASM_SIMP_TAC[num_closure1]; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC; + COPY 6; + UND 8; + REWRITE_TAC[has_size2]; + DISCH_THEN CHOOSE_TAC; + CHO 8; + TYPE_THEN `X a /\ X b /\ X e` SUBGOAL_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[INSERT ]; + CONJ_TAC; + ASM_REWRITE_TAC[INSERT]; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + TSPEC `e` 4; + USE 4(REWRITE_RULE[]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `P e /\ (closure top2 e (pointI m))` SUBGOAL_TAC; + TSPEC `e` 4; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `G a /\ closure top2 a (pointI m) /\ G b /\ closure top2 b (pointI m)` SUBGOAL_TAC; + UND 9; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + MESON_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `(e =a) \/ (e = b)` SUBGOAL_TAC; + ASM_MESON_TAC[two_exclusion]; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `a` EXISTS_TAC; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + CHO 4; + CHO 4; + UND 4; + DISCH_ALL_TAC; + REWRITE_TAC[endpoint]; + UND 0; + REWRITE_TAC[rectagon;INSERT ]; + DISCH_ALL_TAC; + TSPEC `m` 12; + UND 12; + (* rg *) + DISCH_THEN DISJ_CASES_TAC; + USE 3 (MATCH_MP num_closure1); + ASM_REWRITE_TAC[]; + USE 0 (MATCH_MP num_closure2); + REWR 12; + CHO 12; + CHO 12; + AND 12; + TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC; + UND 12; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC; + UND 12; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `C` EXISTS_TAC; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TSPEC `e'` 12; + REWR 12; + TYPE_THEN `G e'` SUBGOAL_TAC; + UND 17; + UND 1; + MESON_TAC[ISUBSET]; + DISCH_TAC; + KILL 0; + KILL 3; + KILL 18; + KILL 13; + ASM_MESON_TAC[]; + KILL 0; + KILL 3; + KILL 13; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_REWRITE_TAC[]; + (* rg2 *) + USE 0(MATCH_MP num_closure0); + REWR 12; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let part_below_finite = prove_by_refinement( + `!G m. (FINITE G) ==> FINITE(part_below G m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[part_below;ISUBSET ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let part_below_subset = prove_by_refinement( + `!G m. (part_below G m) SUBSET G`, + (* {{{ proof *) + [ + REWRITE_TAC[part_below;ISUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let v_edge_cpoint = prove_by_refinement( + `!m n. (closure top2 (v_edge m) (pointI n) <=> + ((n = m) \/ (n = (FST m,SND m +: (&:1)))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[v_edge_closure;vc_edge;UNION]; + REWRITE_TAC[v_edge_pointI;INR IN_SING ;plus_e12;pointI_inj]; + ]);; + (* }}} *) + +let h_edge_cpoint = prove_by_refinement( + `!m n. (closure top2 (h_edge m) (pointI n) <=> + ((n = m) \/ (n = (FST m +: (&:1),SND m ))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[h_edge_closure;hc_edge;UNION]; + REWRITE_TAC[h_edge_pointI;INR IN_SING ;plus_e12;pointI_inj]; + ]);; + (* }}} *) + +let endpoint_lemma = prove_by_refinement( + `!G m x. (rectagon G) /\ + (endpoint (part_below G m) x) + ==> + (? C C' m'. + ((C = v_edge m') \/ (C = h_edge m')) /\ + (edge C') /\ + (!e. G e /\ closure top2 e (pointI x) <=> (e = C) \/ (e = C')) /\ + (~(G = {})) /\ + (G SUBSET edge) /\ + (part_below G m C) /\ + (G C') /\ + (~part_below G m C') /\ + (~(C = C')) /\ + (closure top2 C (pointI x)) /\ + (closure top2 C' (pointI x)) /\ + (part_below G m SUBSET G) /\ + (endpoint (part_below G m) x)) + `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC; + ASM_MESON_TAC[part_below_subset]; + DISCH_TAC ; + COPY 2; + COPY 1; + UND 1; + UND 3; + UND 0; + SIMP_TAC[endpoint_subrectagon]; + DISCH_TAC; + DISCH_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[rectagon;INSERT ]); + UND 0; + DISCH_ALL_TAC; + TSPEC `x` 12; + UND 12; + DISCH_THEN DISJ_CASES_TAC; + USE 0 (MATCH_MP num_closure2); + REWR 12; + CHO 12; + CHO 12; + KILL 0; + AND 12; + TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC; + TSPEC `C` 0; + UND 0; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_MESON_TAC[ISUBSET]; + TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + DISCH_TAC; + TYPE_THEN `!e. G e /\ closure top2 e (pointI x) <=> ((e = C) \/ (e = C'))` SUBGOAL_TAC; + DISCH_ALL_TAC; + TSPEC `e` 0; + ASM_REWRITE_TAC[]; + UND 15; + UND 14; + UND 12; + UND 7; + MESON_TAC[]; + DISCH_TAC; + KILL 15; + KILL 14; + KILL 0; + KILL 12; + KILL 13; + TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;]; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[edge]); + UND 0; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `m'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* snd case *) + USE 0 (MATCH_MP num_closure0); + REWR 12; + PROOF_BY_CONTR_TAC; + UND 12; + UND 5; + UND 9; + MESON_TAC[]; + ]);; + (* }}} *) + +let endpoint_lemma_small_fst = prove_by_refinement( + `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> + (FST m <=: FST x +: &:1) `, + (* {{{ proof *) + + [ + REP_GEN_TAC; + DISCH_TAC; + COPY 0; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`]; + DISCH_ALL_TAC; + (* setup complete *) + UND 0; + DISCH_THEN DISJ_CASES_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 10; + USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `FST x = FST m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 14; + AND 6; + AND 6; + REWR 14; + UND 14; + INT_ARITH_TAC; + (* 2nd case *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); + REWR 10; + USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + UND 14; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +(* identical proof to endpoint_lemma_small_fst *) +let endpoint_lemma_big_fst = prove_by_refinement( + `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> + (FST x <=: FST m +: &:1) `, + (* {{{ proof *) + + [ + REP_GEN_TAC; + DISCH_TAC; + COPY 0; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`]; + DISCH_ALL_TAC; + (* setup complete *) + UND 0; + DISCH_THEN DISJ_CASES_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 10; + USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `FST x = FST m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 14; + AND 6; + AND 6; + REWR 14; + UND 14; + INT_ARITH_TAC; + (* 2nd case *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); + REWR 10; + USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + UND 14; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +let endpoint_lemma_big_snd = prove_by_refinement( + `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> + (SND x <=: SND m +: &:1) `, + (* {{{ proof *) + + [ + REP_GEN_TAC; + DISCH_TAC; + COPY 0; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`]; + DISCH_ALL_TAC; + (* setup complete *) + UND 0; + DISCH_THEN DISJ_CASES_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 10; + USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + UND 14; + AND 6; + AND 6; + UND 6; + INT_ARITH_TAC; + (* 2nd case *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); + REWR 10; + USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `SND x = SND m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `(SND m' <=: SND m)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + UND 14; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +let endpoint_lemma_mid_fst = prove_by_refinement( + `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> + (FST x = FST m) ==> (SND x = SND m +: &:1) `, + (* {{{ proof *) + + [ + REP_GEN_TAC; + DISCH_TAC; + COPY 0; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + (* setup complete *) + UND 2; + DISCH_THEN DISJ_CASES_TAC; + REWR 7; + USE 7 (REWRITE_RULE[part_below_v]); + REWR 11; + USE 11 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + AND 7; + AND 7; + UND 7; + USE 3 (REWRITE_RULE[edge]); + CHO 3; + UND 3; + DISCH_THEN DISJ_CASES_TAC; + REWR 9; + USE 7 (REWRITE_RULE[part_below_v]); + REWR 8; + REWR 7; + REWR 12; + USE 9 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(FST m'' = FST m) /\ (FST x = FST m'')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 9; + REWR 7; + UND 7; + UND 9; + INT_ARITH_TAC; + (* 2nd case *) + REWR 12; + USE 7 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + REWR 8; + REWR 9; + USE 9 (REWRITE_RULE[left ;set_lower;part_below_h]); + REWR 9; + TYPE_THEN `(FST x = FST m') ` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 7; + DISCH_ALL_TAC; + REWR 7; + KILL 12; + REWR 7; + KILL 11; + (* try *) + UND 7; + UND 17; + UND 18; + UND 9; + INT_ARITH_TAC; + (* 3rd case *) + (* 3c *) + REWR 11; + USE 11(REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + USE 3(REWRITE_RULE[edge]); + CHO 3; + UND 3; + DISCH_THEN DISJ_CASES_TAC; + REWR 9; + USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]); + REWR 8; + REWR 9; + UND 9; + UND 11; + UND 0; + REWR 12; + USE 0(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + UND 0; + USE 1 (MATCH_MP endpoint_lemma_big_snd ); + UND 0; + INT_ARITH_TAC; + (* LAST case ,3d *) + TYPE_THEN `G (h_edge m')` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + REWR 12; + USE 12 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `SND x = SND m''` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 12; + REWR 7; + USE 7(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]); + REWR 7; + TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + UND 7; + COPY 17; + UND 7; + DISCH_THEN_REWRITE; + DISCH_TAC; + REWR 9; + USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]); + REWR 8; + REWR 9; + TYPE_THEN `SND x = SND m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + UND 11; + COPY 18; + UND 11; + DISCH_THEN_REWRITE; + DISCH_TAC; + TYPE_THEN `(FST m'' = FST m) \/ (FST m'' = FST m -: &:1)` SUBGOAL_TAC; + UND 11; + UND 7; + UND 12; + INT_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(SND m'' <=: SND m)` SUBGOAL_TAC; + UND 19; + UND 9; + INT_ARITH_TAC; + UND 16; + UND 18; + UND 17; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +let endpoint_lemma_upper_left = prove_by_refinement( + `!G m . (rectagon G) ==> + ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`, + (* {{{ proof *) + + [ + (* needs to be rewritten, template only *) + REP_GEN_TAC; + TYPE_THEN `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + GEN_TAC; + DISCH_TAC; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN DISJ_CASES_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 10; + USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `FST m' = FST m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + INT_ARITH_TAC; + (* 2nd case *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); + REWR 10; + USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +let endpoint_lemma_upper_left = prove_by_refinement( + `!G m . (rectagon G) ==> + ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`, + (* {{{ proof *) + + [ + (* needs to be rewritten, template only *) + REP_GEN_TAC; + TYPE_THEN `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + GEN_TAC; + DISCH_TAC; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN DISJ_CASES_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 10; + USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `FST m' = FST m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + INT_ARITH_TAC; + (* 2nd case *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); + REWR 10; + USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +let endpoint_lemma_upper_right = prove_by_refinement( + `!G m . (rectagon G) ==> + ~(endpoint (part_below G m) (FST m +: &:1, SND m +: &:1))`, + (* {{{ proof *) + + [ + (* needs to be rewritten, template only *) + REP_GEN_TAC; + TYPE_THEN `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m +: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m +: &:1,SND m +: &:1)))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + GEN_TAC; + DISCH_TAC; + USE 0 (MATCH_MP endpoint_lemma); + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN DISJ_CASES_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 10; + USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `FST m +: &:1 = FST m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `FST m' = FST m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + INT_ARITH_TAC; + (* 2nd case *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_h ;set_lower ;left ;]); + REWR 10; + USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + INT_ARITH_TAC; + ]);; + + (* }}} *) + +let endpoint_lemma_summary = prove_by_refinement( + `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> + ((FST x = FST m -: &:1) /\ (SND x <=: SND m)) \/ + ((FST x = FST m +: &:1) /\ (SND x <=: SND m)) \/ + ((FST x = FST m) /\ (SND x = SND m +: &:1 )) `, + (* {{{ proof *) + [ + (* USE int -arith to show cases of fst x, then for each give *) + REP_GEN_TAC; + DISCH_TAC; + TYPE_THEN `(FST x < FST m -: &:1) \/ (FST x = FST m -: &:1) \/ (FST x = FST m ) \/ (FST x = FST m +: &:1) \/ (FST m +: &:1 <: FST x )` SUBGOAL_TAC; + INT_ARITH_TAC; + REP_CASES_TAC ; + USE 0 (MATCH_MP endpoint_lemma_small_fst); + PROOF_BY_CONTR_TAC; + UND 0; + UND 1; + INT_ARITH_TAC; + DISJ1_TAC; + ASM_REWRITE_TAC[]; + COPY 0; + USE 0 (MATCH_MP endpoint_lemma_big_snd); + IMATCH_MP_TAC (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`); + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + REWR 3; + TYPE_THEN `x = (FST m -: &:1, SND m + &:1)` SUBGOAL_TAC; + ASM_REWRITE_TAC[PAIR_SPLIT]; + DISCH_TAC; + REWR 2; + ASM_MESON_TAC[endpoint_lemma_upper_left]; + USE 0 (MATCH_MP endpoint_lemma_mid_fst); + ASM_MESON_TAC[]; + DISJ2_TAC; + DISJ1_TAC ; + ASM_REWRITE_TAC[]; + COPY 0; + USE 0 (MATCH_MP endpoint_lemma_big_snd); + IMATCH_MP_TAC (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`); + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + REWR 3; + TYPE_THEN `x = (FST m +: &:1, SND m + &:1)` SUBGOAL_TAC; + ASM_REWRITE_TAC[PAIR_SPLIT]; + DISCH_TAC; + REWR 2; + ASM_MESON_TAC[endpoint_lemma_upper_right]; + USE 0 (MATCH_MP endpoint_lemma_big_fst); + PROOF_BY_CONTR_TAC; + UND 0; + UND 1; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let terminal_case1 = prove_by_refinement( + `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\ + (closure top2 (h_edge n) (pointI x)) /\ (set_lower G m n ) ==> + (x = right n)`, + (* {{{ proof *) + [ + REWRITE_TAC[h_edge_cpoint; set_lower]; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[PAIR_SPLIT]); + UND 2; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `FST x = FST m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + JOIN 0 1; + USE 0 (MATCH_MP endpoint_lemma_mid_fst); + REWR 0; + UND 0; + UND 2; + UND 5; + INT_ARITH_TAC; + TYPE_THEN `FST x = FST m +: &:1` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT;right ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let terminal_case2 = prove_by_refinement( + `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\ + (closure top2 (h_edge n) (pointI x)) /\ + (set_lower G (left m) n ) ==> + (x = n)`, + (* {{{ proof *) + [ + REWRITE_TAC[h_edge_cpoint; set_lower ]; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[PAIR_SPLIT]); + UND 2; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `FST x = FST m` SUBGOAL_TAC; + UND 2; + UND 4; + REWRITE_TAC[left ]; + INT_ARITH_TAC ; + DISCH_TAC; + JOIN 0 1; + USE 0 (MATCH_MP endpoint_lemma_mid_fst); + AND 2; + UND 2; + REWR 0; + DISCH_TAC; + UND 5; + UND 0; + REWRITE_TAC[left ]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let terminal_case_v = prove_by_refinement( + `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\ + (closure top2 (v_edge n) (pointI x)) /\ + (part_below G m (v_edge n)) ==> + (x = up m) /\ (m =n)`, + (* {{{ proof *) + [ + REWRITE_TAC[part_below_v; v_edge_cpoint;]; + DISCH_ALL_TAC; + JOIN 0 1; + USE 2 (REWRITE_RULE[PAIR_SPLIT]); + REWR 1; + TYPE_THEN `FST x = FST m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 1; + REWRITE_TAC[PAIR_SPLIT; up ;]; + ASM_REWRITE_TAC[]; + USE 0 (MATCH_MP endpoint_lemma_mid_fst); + REWR 0; + ASM_REWRITE_TAC[]; + UND 0; + UND 1; + UND 5; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let inj_terminal = prove_by_refinement( + `!G m. (rectagon G) ==> + (INJ (terminal_edge (part_below G m)) + (endpoint (part_below G m)) UNIV)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC ; + ASM_MESON_TAC[part_below_finite;rectagon]; + DISCH_TAC; + REWRITE_TAC[INJ]; + DISCH_ALL_TAC; + TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC; + TYPE_THEN `closure top2 e (pointI x) /\ closure top2 e (pointI y)` SUBGOAL_TAC; + ASM_MESON_TAC[terminal_endpoint]; + DISCH_ALL_TAC; + TYPE_THEN `(part_below G m) e` SUBGOAL_TAC; + ASM_MESON_TAC[terminal_endpoint]; + DISCH_TAC; + TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC; + REWRITE_TAC[part_below;ISUBSET]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;rectagon]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + TYPE_THEN `(x = up m) /\ (y = up m)` SUBGOAL_TAC; + ASM_MESON_TAC[terminal_case_v]; + MESON_TAC[]; + (* h-case *) + UND 4; + REWR 8; + USE 4 (REWRITE_RULE[part_below_h ;]); + DISCH_TAC; + UND 4; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `(x = right m') /\ (y = right m')` SUBGOAL_TAC ; + ASM_MESON_TAC[terminal_case1]; + MESON_TAC[]; + TYPE_THEN `( x= m' ) /\ (y = m') ` SUBGOAL_TAC; + ASM_MESON_TAC[terminal_case2]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* now start on surjectivity results *) + +let endpoint_criterion = prove_by_refinement( + `!G m e. (FINITE G) /\ + (!e'. (G e' /\ (closure top2 e' (pointI m))) = (e = e')) ==> + (endpoint G m) /\ (e = terminal_edge G m)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[endpoint;]; + ASM_SIMP_TAC[num_closure1]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_MESON_TAC[terminal_unique]; + ]);; + (* }}} *) + +let target_set = jordan_def `target_set G m = + { e | (?n. (e = h_edge n) /\ (set_lower G m n)) \/ + (?n. (e = h_edge n) /\ (set_lower G (left m) n)) \/ + ((e = v_edge m) /\ G e)}`;; + +let target_set_subset = prove_by_refinement( + `!G m. target_set G m SUBSET G`, + (* {{{ proof *) + [ + REWRITE_TAC[ISUBSET;target_set;set_lower]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let target_edge = prove_by_refinement( + `!G m. target_set G m SUBSET edge`, + (* {{{ proof *) + [ + REWRITE_TAC[target_set;edge;ISUBSET ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let target_h = prove_by_refinement( + `!G m n. target_set G m (h_edge n) <=> + (set_lower G m n) \/ (set_lower G (left m) n)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[target_set;h_edge_inj; hv_edgeV2;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let target_v = prove_by_refinement( + `!G m n. target_set G m (v_edge n) <=> + (n = m) /\ G (v_edge n)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[target_set;hv_edgeV2;v_edge_inj;]; + ]);; + (* }}} *) + +let part_below_subset = prove_by_refinement( + `!G m. (part_below G m SUBSET G)`, + (* {{{ proof *) + [ + REWRITE_TAC[part_below;ISUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let part_below_finite = prove_by_refinement( + `!G m. (FINITE G ==> FINITE (part_below G m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[part_below_subset]; + ]);; + (* }}} *) + +let terminal_edge_image = prove_by_refinement( + `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==> + (target_set G m (terminal_edge (part_below G m) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + COPY 2; + USE 2 ( MATCH_MP part_below_finite); + TSPEC `m` 2; + REWRITE_TAC[target_set]; + TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC; + TYPE_THEN `(part_below G m e) /\ (closure top2 e (pointI x))` SUBGOAL_TAC; + ASM_MESON_TAC[terminal_endpoint]; + DISCH_ALL_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[part_below_subset;ISUBSET;rectagon]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + ASM_REWRITE_TAC[hv_edgeV2;v_edge_inj]; + REWR 5; + USE 5 (REWRITE_RULE[part_below_v]); + ASM_REWRITE_TAC[PAIR_SPLIT ]; + REWR 6; + USE 6 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]); + TYPE_THEN `FST x = FST m'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 6; + TYPE_THEN `SND x = SND m +: &:1` SUBGOAL_TAC; + ASM_MESON_TAC[endpoint_lemma_mid_fst]; + UND 6; + AND 5; + AND 5; + UND 5; + INT_ARITH_TAC; + (* H edge *) + ASM_REWRITE_TAC[hv_edgeV2;h_edge_inj;]; + REWR 5; + USE 5(REWRITE_RULE[part_below_h ]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let terminal_edge_surj = prove_by_refinement( + `!G m e. (rectagon G) /\ (target_set G m e) ==> + (?x. (endpoint (part_below G m) x) /\ + (e = terminal_edge (part_below G m) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC; + ASM_MESON_TAC[part_below_finite]; + DISCH_TAC; + TYPE_THEN `(part_below G m) SUBSET G` SUBGOAL_TAC; + ASM_MESON_TAC[part_below_subset]; + DISCH_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[target_edge;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + REWR 1; + USE 1(REWRITE_RULE[target_v]); + AND 1; + REWR 1; + REWR 5; + KILL 6; + TYPE_THEN `up m` EXISTS_TAC; + IMATCH_MP_TAC endpoint_criterion; + ASM_REWRITE_TAC[]; + GEN_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;rectagon]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + ASM_REWRITE_TAC [v_edge_inj;PAIR_SPLIT]; + REWR 7; + USE 7(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT;up;]); + AND 6; + AND 6; + UND 6; + UND 7; + INT_ARITH_TAC; + REWR 6; + USE 6 (REWRITE_RULE[part_below_h;set_lower;left ;]); + TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 7; + USE 7(REWRITE_RULE[h_edge_cpoint; up; PAIR_SPLIT ]); + UND 7; + UND 9; + INT_ARITH_TAC; + DISCH_TAC; + EXPAND_TAC "e'"; + KILL 6; + ASM_REWRITE_TAC [part_below_v;v_edge_cpoint;up]; + INT_ARITH_TAC; + (* half-on-proof , hedge *) + (* hop *) + REWR 1; + USE 1(REWRITE_RULE[target_h]); + UND 1; + DISCH_THEN (DISJ_CASES_TAC); (* split LEFT and RIGHT H *) + TYPE_THEN `right m'` EXISTS_TAC; + IMATCH_MP_TAC endpoint_criterion; + ASM_REWRITE_TAC[]; + GEN_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;rectagon]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); (* snd H or v *) + REWR 6; + USE 6 (REWRITE_RULE[part_below_v]); + REWR 7; + USE 7(REWRITE_RULE[v_edge_cpoint;right ;PAIR_SPLIT; ]); + REWRITE_TAC[h_edge_inj;hv_edgeV2;]; + USE 1 (REWRITE_RULE[set_lower]); + ASM_MESON_TAC[INT_ARITH `~(x +: &:1 = x)`]; + ASM_REWRITE_TAC [h_edge_inj;PAIR_SPLIT ]; (* snd H *) + KILL 5; + UND 8; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE [t])); + RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;PAIR_SPLIT;right ]); + UND 6; + DISCH_THEN DISJ_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[set_lower]); + ASM_MESON_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[set_lower;left ]); + AND 5; + AND 5; + PROOF_BY_CONTR_TAC; + UND 8; + UND 7; + UND 1; + INT_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[part_below_h;h_edge_cpoint;right ]; + ASM_REWRITE_TAC[]; + KILL 5; + (* finally LEFT case: now everything needs to have an endpoint *) + (* hop3*) + USE 1 (REWRITE_RULE[set_lower;left ]); + TYPE_THEN ` m'` EXISTS_TAC ; (* was left m *) + IMATCH_MP_TAC endpoint_criterion; + ASM_REWRITE_TAC[]; + GEN_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `edge e'` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + ASM_REWRITE_TAC[]; + UND 7; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + RULE_ASSUM_TAC (REWRITE_RULE[part_below_v;v_edge_cpoint;left ;PAIR_SPLIT ;]); + UND 5; + UND 6; + UND 1; + INT_ARITH_TAC; + (* now H *) + ASM_REWRITE_TAC[]; + UND 7; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;left ;PAIR_SPLIT ;]); + UND 5; + DISCH_THEN DISJ_CASES_TAC; + USE 5(REWRITE_RULE[set_lower]); + UND 5; + UND 6; + UND 1; + INT_ARITH_TAC; + (* hop2 *) + USE 5 (REWRITE_RULE[set_lower]); + REWRITE_TAC[h_edge_inj;PAIR_SPLIT;]; + UND 5; + UND 6; + UND 1; + INT_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_REWRITE_TAC[part_below_h;h_edge_cpoint; set_lower; left ]; + ]);; + (* }}} *) + +(* set *) +let inj_subset = prove_by_refinement( + `!t t' s (f:A->B). (INJ f s t') /\ (t SUBSET t') /\ + (IMAGE f s SUBSET t) ==> (INJ f s t)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;IMAGE;SUBSET ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let terminal_edge_bij = prove_by_refinement( + `!G m. (rectagon G) ==> + (BIJ (terminal_edge (part_below G m)) + (endpoint (part_below G m)) (target_set G m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + IMATCH_MP_TAC inj_subset; + TYPE_THEN `UNIV:((num->real)->bool)->bool` EXISTS_TAC; + ASM_SIMP_TAC[inj_terminal]; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[terminal_edge_image]; + REWRITE_TAC[INJ;SURJ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[terminal_edge_surj]; + ]);; + (* }}} *) + +let target_set_finite = prove_by_refinement( + `!G m. (FINITE G) ==> (FINITE (target_set G m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + ASM_MESON_TAC[target_set_subset]; + ]);; + (* }}} *) + +let rectagon_endpoint0 = prove_by_refinement( + `!G. (rectagon G) ==> ((endpoint G) HAS_SIZE 0)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `endpoint G = {}` SUBGOAL_TAC; + REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[rectagon_endpoint]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[HAS_SIZE_0]; + ]);; + (* }}} *) + +let target_set_even = prove_by_refinement( + `!G m. (rectagon G) ==> (EVEN (CARD (target_set G m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `CARD (endpoint(part_below G m)) = CARD (target_set G m)` SUBGOAL_TAC; + IMATCH_MP_TAC BIJ_CARD ; + TYPE_THEN `terminal_edge (part_below G m)` EXISTS_TAC; + ASM_SIMP_TAC[terminal_edge_bij]; + ASSUME_TAC terminal_edge_bij; + TYPEL_THEN [`G`;`m`] (USE 1 o ISPECL); + REWR 1; + ASSUME_TAC target_set_finite; + TYPEL_THEN [`G`;`m`] (USE 2 o ISPECL); + ASM_MESON_TAC[FINITE_BIJ2;rectagon]; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + TYPE_THEN `rectagon (part_below G m)` ASM_CASES_TAC; + TYPE_THEN `CARD (endpoint (part_below G m)) =0` SUBGOAL_TAC; + ASM_MESON_TAC[HAS_SIZE;rectagon_endpoint0]; + MESON_TAC[EVEN]; + TYPE_THEN `P = part_below G m` ABBREV_TAC ; + TYPE_THEN `segment G /\ (P SUBSET G) /\ ~(rectagon P)` SUBGOAL_TAC; + ASM_SIMP_TAC[rectagon_segment]; + ASM_MESON_TAC[part_below_subset]; + DISCH_TAC; + USE 3 (MATCH_MP endpoint_even ); + USE 3 (REWRITE_RULE[HAS_SIZE]); + ASM_REWRITE_TAC[EVEN_DOUBLE]; + ]);; + (* }}} *) + +let bij_target_set = prove_by_refinement( + `!G m. (rectagon G) /\ ~(G (v_edge m)) ==> + (BIJ h_edge (set_lower G (left m) UNION (set_lower G m)) + (target_set G m))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; ]; + MESON_TAC[]; + REWRITE_TAC[h_edge_inj;]; + MESON_TAC[]; + REWRITE_TAC[INJ;SURJ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[target_set;set_lower;UNION;]; + GEN_TAC; + REP_CASES_TAC; + CHO 4; + UND 4; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + CHO 4; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let bij_target_set_odd = prove_by_refinement( + `!G m. (rectagon G) /\ (G (v_edge m)) ==> + (BIJ h_edge (set_lower G (left m) UNION + (set_lower G m) ) + (target_set G m DELETE (v_edge m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; DELETE ]; + MESON_TAC[]; + REWRITE_TAC[h_edge_inj;]; + MESON_TAC[]; + REWRITE_TAC[INJ;SURJ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[target_set;set_lower;UNION;DELETE ]; + GEN_TAC; + DISCH_TAC; + AND 4; + REWR 5; + UND 5; + REP_CASES_TAC; + CHO 5; + UND 5; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + CHO 5; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let target_set_odd = prove_by_refinement( + `!G m. (rectagon G) /\ (G (v_edge m)) ==> + ~(EVEN(CARD (target_set G m DELETE (v_edge m))))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM EVEN]; + DISCH_ALL_TAC; + TYPE_THEN `FINITE (target_set G m)` SUBGOAL_TAC; + ASM_MESON_TAC[target_set_finite;rectagon]; + DISCH_TAC; + TYPE_THEN `target_set G m (v_edge m)` SUBGOAL_TAC; + ASM_REWRITE_TAC [target_v]; + DISCH_TAC; + TYPE_THEN `SUC (CARD (target_set G m DELETE (v_edge m))) = CARD (target_set G m )` SUBGOAL_TAC; + IMATCH_MP_TAC CARD_SUC_DELETE; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[target_set_even]; + ]);; + (* }}} *) + +let squ_left_even = prove_by_refinement( + `!G m. (rectagon G) /\ ~(G (v_edge m)) ==> + ((even_cell G (squ (left m)) = even_cell G(squ m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + REWRITE_TAC[even_cell_squ;num_lower_set]; + TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC; + IMATCH_MP_TAC even_card_even; + ASM_SIMP_TAC[finite_set_lower]; + REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ]; + MESON_TAC[INT_ARITH `~(z = z -: &:1)`]; + DISCH_THEN_REWRITE; + TYPE_THEN `BIJ h_edge (set_lower G (left m) UNION (set_lower G m)) (target_set G m) ` SUBGOAL_TAC; + ASM_MESON_TAC[bij_target_set]; + DISCH_TAC; + TYPE_THEN `CARD (set_lower G (left m) UNION (set_lower G m)) = CARD (target_set G m)` SUBGOAL_TAC; + IMATCH_MP_TAC BIJ_CARD ; + TYPE_THEN `h_edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_UNION]; + ASM_MESON_TAC[finite_set_lower]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[target_set_even]; + ]);; + (* }}} *) + +let squ_left_odd = prove_by_refinement( + `!G m. (rectagon G) /\ (G (v_edge m)) ==> + (~(even_cell G (squ (left m)) = even_cell G(squ m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC; + UND 0; + REWRITE_TAC[even_cell_squ;num_lower_set]; + TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC; + IMATCH_MP_TAC even_card_even; + ASM_SIMP_TAC[finite_set_lower]; + REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ]; + MESON_TAC[INT_ARITH `~(z = z -: &:1)`]; + DISCH_THEN_REWRITE; + TYPE_THEN `BIJ h_edge (set_lower G (left m) UNION (set_lower G m)) (target_set G m DELETE (v_edge m)) ` SUBGOAL_TAC; + ASM_MESON_TAC[bij_target_set_odd]; + DISCH_TAC; + TYPE_THEN `CARD (set_lower G (left m) UNION (set_lower G m)) = CARD (target_set G m DELETE (v_edge m))` SUBGOAL_TAC; + IMATCH_MP_TAC BIJ_CARD ; + TYPE_THEN `h_edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_UNION]; + ASM_MESON_TAC[finite_set_lower]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[target_set_odd]; + ]);; + (* }}} *) + +let squ_left_par = prove_by_refinement( + `!G m. (rectagon G) ==> + (((even_cell G (squ (left m)) = even_cell G(squ m))) <=> + ~(G (v_edge m)))`, + (* {{{ proof *) + [ + ASM_MESON_TAC[squ_left_even;squ_left_odd]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION E *) +(* ------------------------------------------------------------------ *) + + +let rectangle = jordan_def `rectangle p q = + {Z | ?u v. (Z = point(u,v)) /\ + (real_of_int (FST p ) <. u) /\ (u <. (real_of_int (FST q ))) /\ + (real_of_int (SND p ) <. v) /\ (v <. (real_of_int (SND q))) }`;; + +let rectangle_inter = prove_by_refinement( + `!p q. rectangle p q = + {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER + {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER + {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST q)} INTER + {z | ?r. (z = point r) /\ (SND r ) <. real_of_int(SND q)} `, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[rectangle;INTER]; + GEN_TAC; + EQ_TAC; + DISCH_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[point_inj]; + CONV_TAC (dropq_conv "r"); + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "r"); + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "r'"); + CONV_TAC (dropq_conv "r"); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[point_inj]); + USE 1(CONV_RULE (dropq_conv "r'")); + REWR 2; + USE 2(REWRITE_RULE[point_inj]); + USE 2(CONV_RULE (dropq_conv "r'")); + REWR 3; + USE 3(REWRITE_RULE[point_inj]); + USE 3(CONV_RULE (dropq_conv "r'")); + REWRITE_TAC[point_inj;PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let rectangle_open = prove_by_refinement( + `!p q. top2 (rectangle p q)`, + (* {{{ proof *) + [ + REWRITE_TAC[rectangle_inter]; + ASSUME_TAC top2_top; + DISCH_ALL_TAC; + REPEAT (IMATCH_MP_TAC top_inter THEN ASM_REWRITE_TAC[top_inter;open_half_plane2D_FLT_open;open_half_plane2D_LTF_open;open_half_plane2D_SLT_open;open_half_plane2D_LTS_open]); + ]);; + (* }}} *) + +let rectangle_convex = prove_by_refinement( + `!p q. convex (rectangle p q)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[rectangle_inter]; + REPEAT (IMATCH_MP_TAC convex_inter THEN REWRITE_TAC[open_half_plane2D_FLT_convex;open_half_plane2D_LTF_convex;open_half_plane2D_SLT_convex;open_half_plane2D_LTS_convex]); + ]);; + (* }}} *) + +let rectangle_squ = prove_by_refinement( + `!p. squ p = rectangle p (FST p +: &:1,SND p +: &:1)`, + (* {{{ proof *) + [ + REWRITE_TAC[squ;rectangle]; + ]);; + (* }}} *) + +let squ_inter = prove_by_refinement( + `!p. squ p = + {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER + {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER + {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST p +: &:1) } INTER + {z | ?r. (z = point r) /\ (SND r ) <. real_of_int(SND p +: &:1) }`, + (* {{{ proof *) + [ + REWRITE_TAC[rectangle_squ;rectangle_inter]; + ]);; + (* }}} *) + +(* set *) +let subset3_absorb = prove_by_refinement( + `!(A:A->bool) B C. (B SUBSET C) ==> (B INTER A = B INTER C INTER A)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[INTER_ACI]; + AP_TERM_TAC; + ASM_MESON_TAC[SUBSET_INTER_ABSORPTION]; + ]);; + (* }}} *) + +let rectangle_lemma1 = prove_by_refinement( + `!p. squ(down p) = + (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1)) + INTER {z | ?r. (z = point r) /\ (SND r <. real_of_int(SND p))}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[squ_inter;rectangle_inter;down]; + REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`]; + REWRITE_TAC[INTER_ACI]; + AP_TERM_TAC; + AP_TERM_TAC; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER;int_suc ;]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + ASSUME_TAC (REAL_ARITH `!u. u <. u + &.1`); + CONJ_TAC; + TYPE_THEN `r` EXISTS_TAC; + ASM_MESON_TAC[REAL_LT_TRANS ]; + ASM_MESON_TAC[]; + MESON_TAC[]; + ]);; + (* }}} *) + + +let rectangle_lemma2 = prove_by_refinement( + `!p. squ(p) = + (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1)) + INTER {z | ?r. (z = point r) /\ ( real_of_int(SND p) <. SND r)}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[squ_inter;rectangle_inter;down]; + REWRITE_TAC[INTER_ACI]; + AP_TERM_TAC; + TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND p -: &:1) < SND r}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th]; + ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`]; + ]);; + (* }}} *) + +let rectangle_lemma3 = prove_by_refinement( + `!q. h_edge q = + (rectangle (FST q , SND q -: &:1) (FST q +: &:1 , SND q +: &:1)) + INTER {z | ?r. (z = point r) /\ ( SND r = real_of_int(SND q))}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[h_edge_inter;rectangle_inter;]; + TYPE_THEN `B = {z | ?p. (z = point p) /\ (SND p = real_of_int (SND q))}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ; + TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC; + REWRITE_TAC[INTER_ACI]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); + IMATCH_MP_TAC subset3_absorb; + REWRITE_TAC[SUBSET_INTER]; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + EXPAND_TAC "D"; + REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;]; + ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`]; + ]);; + (* }}} *) + +let rectangle_h = prove_by_refinement( + `!p. rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1) = + ((squ (down p)) UNION (h_edge p) UNION (squ p) )`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[rectangle_lemma1;rectangle_lemma2;rectangle_lemma3]; + REWRITE_TAC[GSYM UNION_OVER_INTER]; + TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION {z | ?r. (z = point r) /\ (SND r = real_of_int (SND p))} UNION {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[UNION]; + ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`]; + DISCH_THEN_REWRITE; + TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1) SUBSET {z | ?r. z = point r}` SUBGOAL_TAC; + REWRITE_TAC[rectangle;SUBSET ]; + ASM_MESON_TAC[]; + REWRITE_TAC [SUBSET_INTER_ABSORPTION;]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let rectangle_lemma4 = prove_by_refinement( + `!p. squ(left p) = + (rectangle (FST p -: &:1 , SND p)(FST p +: &:1 , SND p +: &:1)) + INTER {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p))}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[squ_inter;rectangle_inter;left ]; + REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`]; + REWRITE_TAC[INTER_ACI]; + AP_TERM_TAC; + AP_TERM_TAC; + TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_suc]; + ASM_MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &.1`]; + ]);; + (* }}} *) + +let rectangle_lemma5 = prove_by_refinement( + `!p. squ(p) = + (rectangle (FST p -: &:1 , SND p) (FST p +: &:1 , SND p +: &:1)) + INTER {z | ?r. (z = point r) /\ ( real_of_int(FST p) <. FST r)}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[squ_inter;rectangle_inter;]; +TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r} ` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th]; + ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`]; + ]);; + (* }}} *) + +let rectangle_lemma6 = prove_by_refinement( + `!q. v_edge q = + (rectangle (FST q -: &:1 , SND q) (FST q +: &:1 , SND q +: &:1)) + INTER {z | ?r. (z = point r) /\ ( FST r = real_of_int(FST q))}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[v_edge_inter;rectangle_inter;]; + REWRITE_TAC[INTER_ACI]; + TYPE_THEN `B = {z | ?p. (z = point p) /\ (FST p = real_of_int (FST q))}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST q -: &:1) < FST r}` ABBREV_TAC ; + TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST q +: &:1)}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC; + REWRITE_TAC[INTER_ACI]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); + IMATCH_MP_TAC subset3_absorb; + REWRITE_TAC[SUBSET_INTER]; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + EXPAND_TAC "D"; + REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;]; + ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`]; + ]);; + (* }}} *) + +let rectangle_v = prove_by_refinement( + `!p. rectangle (FST p -: &:1 , SND p ) (FST p +: &:1 , SND p +: &:1) = + ((squ (left p)) UNION (v_edge p) UNION (squ p) )`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[rectangle_lemma4;rectangle_lemma5;rectangle_lemma6]; + REWRITE_TAC[GSYM UNION_OVER_INTER]; + TYPE_THEN `({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[UNION]; + ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`]; + DISCH_THEN_REWRITE; + TYPE_THEN `rectangle (FST p -: &:1 ,SND p) (FST p +: &:1,SND p +: &:1) SUBSET {z | ?r. z = point r}` SUBGOAL_TAC; + REWRITE_TAC[rectangle;SUBSET ]; + ASM_MESON_TAC[]; + REWRITE_TAC [SUBSET_INTER_ABSORPTION;]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let long_v = jordan_def `long_v p = + {z | (?r. (z = point r) /\ (FST r = real_of_int (FST p)) /\ + (real_of_int(SND p) - &1 <. SND r) /\ + (SND r <. real_of_int(SND p) + &1) )}`;; + +let long_v_inter = prove_by_refinement( + `!p. long_v p = + {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} INTER + {z | ?r. (z = point r) /\ (real_of_int(SND p -: &:1) <. SND r)} INTER + {z | ?r. (z = point r) /\ (SND r <. real_of_int(SND p +: &:1))} `, + (* {{{ proof *) + + [ + GEN_TAC; + IMATCH_MP_TAC EQ_EXT ; + REWRITE_TAC[long_v;INTER;int_add_th;int_sub_th;int_of_num_th]; + GEN_TAC; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + CHO 0; + REWR 1; + REWR 2; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); + USE 2(CONV_RULE (dropq_conv "r'")); + USE 1(CONV_RULE (dropq_conv "r'")); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let long_v_lemma1 = prove_by_refinement( + `!q. v_edge (down q) = + long_v q INTER + {z | ?r. (z = point r) /\ (SND r <. real_of_int(SND q))}`, + (* {{{ proof *) + [ + REWRITE_TAC[v_edge_inter;long_v_inter;down ]; + REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`]; + GEN_TAC; + TYPE_THEN `B = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q)}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ; + alpha_tac; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_add_th;int_of_num_th]; + MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &1`]; + ]);; + (* }}} *) + +let long_v_lemma2 = prove_by_refinement( + `!q. v_edge q = + long_v q INTER + {z | ?r. (z = point r) /\ (real_of_int(SND q) <. SND r )}`, + (* {{{ proof *) + [ + REWRITE_TAC[v_edge_inter;long_v_inter;down;int_suc;int_sub_th;int_of_num_th ]; + GEN_TAC; + TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND q) < SND r}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q) - &1 < SND r}` ABBREV_TAC ; + alpha_tac; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_add_th;int_of_num_th]; + MESON_TAC[REAL_ARITH `x <. y ==> x - &1 <. y`]; + ]);; + (* }}} *) + +let pointI_inter = prove_by_refinement( + `!q. {(pointI q)} = + {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))} INTER + {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING;pointI ]; + GEN_TAC; + EQ_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[point_inj]; + CONV_TAC (dropq_conv "r"); + CONV_TAC (dropq_conv "r'"); + DISCH_ALL_TAC; + CHO 0; + REWR 1; + USE 1(REWRITE_RULE[point_inj]); + USE 1(CONV_RULE (dropq_conv "r'")); + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;]; + ]);; + (* }}} *) + +let long_v_lemma3 = prove_by_refinement( + `!q. {(pointI q)} = long_v q INTER + { z | ?r. (z = point r) /\ (real_of_int(SND q) = SND r)}`, + (* {{{ proof *) + [ + REWRITE_TAC[pointI_inter;long_v_inter]; + GEN_TAC; + alpha_tac; + TYPE_THEN `A = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))}` ABBREV_TAC ; + TYPE_THEN `B = {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ; + TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + AP_TERM_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION]; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + EXPAND_TAC "D"; + REWRITE_TAC[SUBSET;INTER;int_sub_th;int_of_num_th;int_add_th]; + ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &1 <. y /\ x <. y + &1)`]; + ]);; + (* }}} *) + +let long_v_union = prove_by_refinement( + `!p. long_v p = + (v_edge (down p)) UNION {(pointI p)} UNION (v_edge p)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[long_v_lemma1;long_v_lemma2;long_v_lemma3]; + REWRITE_TAC[GSYM UNION_OVER_INTER]; + TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION {z | ?r. (z = point r) /\ (real_of_int (SND p) = SND r)} UNION {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC; + REWRITE_TAC[UNION;]; + EQ_TAC; + MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[point_inj]; + CONV_TAC (dropq_conv "r'"); + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;]; + REWRITE_TAC[long_v;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let two_two_lemma1 = prove_by_refinement( + `!p. rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) = + rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) + INTER + {z | (?r. (z = point r) /\ (FST r <. real_of_int(FST p)))}`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[rectangle_inter]; + alpha_tac; + TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_suc;]; + MESON_TAC[REAL_ARITH `x <. y ==> x < y + &1`]; + ]);; + (* }}} *) + +let two_two_lemma2 = prove_by_refinement( + `!p. rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1) = + rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) + INTER + {z | (?r. (z = point r) /\ ( real_of_int(FST p) <. FST r ))}`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[rectangle_inter]; + alpha_tac; + TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + REWRITE_TAC[SUBSET;int_sub_th;int_add_th;int_of_num_th;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> (x - &1 <. y)`]; + ]);; + (* }}} *) + +let two_two_lemma3 = prove_by_refinement( + `!p. long_v p = + rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) + INTER + {z | (?r. (z = point r) /\ ( FST r = real_of_int(FST p) ))}`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[long_v_inter;rectangle_inter]; + alpha_tac; + TYPE_THEN `B = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} ` ABBREV_TAC ; + TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ; + TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ; + REWRITE_TAC[INTER_ACI]; + TYPE_THEN `!A. (B INTER C INTER D INTER A) = B INTER (C INTER D) INTER A` SUBGOAL_TAC; + REWRITE_TAC[INTER_ACI]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC[t]); + IMATCH_MP_TAC subset3_absorb; + EXPAND_TAC "B"; + EXPAND_TAC "C"; + EXPAND_TAC "D"; + REWRITE_TAC[SUBSET;INTER;int_sub_th;int_add_th;int_of_num_th]; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &.1 <. y /\ x <. y+ &1)`]; + ]);; + (* }}} *) + +let two_two_union = prove_by_refinement( + `!p. rectangle (FST p -: &:1 , SND p -: &:1) + (FST p +: &:1 , SND p + &:1) = + rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) UNION + long_v p UNION + rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1)`, + (* {{{ proof *) + [ + REWRITE_TAC[two_two_lemma1;two_two_lemma2;two_two_lemma3]; + REWRITE_TAC[GSYM UNION_OVER_INTER]; + GEN_TAC; + TYPE_THEN `{z | ?r. (z = point r)} = ({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r})` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[UNION]; + EQ_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_THEN_REWRITE; + REWRITE_TAC [point_inj]; + CONV_TAC (dropq_conv "r'"); + REAL_ARITH_TAC; + MESON_TAC[]; + DISCH_TAC; + USE 0 SYM; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION]; + REWRITE_TAC[rectangle;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let two_two_nine = prove_by_refinement( + `!p. rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) = + squ (FST p -: &:1,SND p -: &:1) UNION squ (FST p -: &:1,SND p ) UNION + squ (FST p,SND p -: &:1) UNION squ p UNION + h_edge (left p) UNION h_edge p UNION + v_edge (down p) UNION v_edge p UNION {(pointI p)}`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[two_two_union;rectangle_h;rectangle_v]; + TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p,SND p +: &:1) = rectangle (FST (left p),SND (left p) -: &:1) (FST (left p) +: &:1,SND (left p) +: &:1)` SUBGOAL_TAC; + REWRITE_TAC[left ;INT_ARITH `x -: &:1 +: &:1 = x`]; + DISCH_THEN_REWRITE; + REWRITE_TAC[rectangle_h]; + REWRITE_TAC[left ;down; long_v_union]; + REWRITE_TAC[UNION_ACI]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) + +let curve_cell = jordan_def `curve_cell G = G UNION + {z | (?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS G) (pointI n)))}`;; + +let curve_cell_cell = prove_by_refinement( + `!G. (G SUBSET edge) ==> (curve_cell G SUBSET cell)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;edge;curve_cell;cell;UNION ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN DISJ_CASES_TAC; + TSPEC `x` 0; + REWR 0; + CHO 0; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let curve_cell_point = prove_by_refinement( + `!G n. (FINITE G) /\ (G SUBSET edge) ==> (curve_cell G {(pointI n)} <=> + (?e. (G e /\ (closure top2 e (pointI n)))))`, + (* {{{ proof *) + [ + REWRITE_TAC[curve_cell;UNION ;edge;SUBSET ]; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_THEN DISJ_CASES_TAC; + TSPEC `{(pointI n)}` 1; + USE 1(GSYM); + USE 1(REWRITE_RULE[eq_sing;v_edge_pointI;h_edge_pointI;]); + ASM_MESON_TAC[]; + USE 2 (REWRITE_RULE[eq_sing;INR IN_SING ;pointI_inj]); + USE 2(CONV_RULE (dropq_conv "n'")); + ASSUME_TAC top2_top; + UND 2; + ASM_SIMP_TAC[closure_unions]; + REWRITE_TAC[IMAGE;INR IN_UNIONS ]; + DISCH_THEN CHOOSE_TAC; + AND 2; + CHO 4; + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + DISJ2_TAC; + REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;]; + CONV_TAC (dropq_conv "n'") ; + TYPE_THEN `closure top2 e SUBSET closure top2 (UNIONS G)` SUBGOAL_TAC; + IMATCH_MP_TAC subset_of_closure; + REWRITE_TAC[top2_top]; + IMATCH_MP_TAC sub_union; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let curve_cell_h = prove_by_refinement( + `!G n. (segment G) ==> (curve_cell G (h_edge n) = G (h_edge n))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI]; + ]);; + (* }}} *) + +let curve_cell_v = prove_by_refinement( + `!G n. (segment G) ==> (curve_cell G (v_edge n) = G (v_edge n))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI]; + ]);; + (* }}} *) + +let curve_cell_in = prove_by_refinement( + `!C G . (G SUBSET edge) /\ (curve_cell G C) ==> + (?n. (C = {(pointI n)}) \/ (C = h_edge n) \/ (C = v_edge n))`, + (* {{{ proof *) + [ + REWRITE_TAC[curve_cell;UNION ;SUBSET; edge ]; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let curve_cell_subset = prove_by_refinement( + `!G. (G SUBSET (curve_cell G))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;curve_cell;UNION ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let curve_closure = prove_by_refinement( + `!G. (segment G) ==> + (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC ; + ASSUME_TAC top2_top; + (* ASM_SIMP_TAC[closure_unions]; *) + TYPE_THEN `G SUBSET edge ` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + ASM_SIMP_TAC[closure_unions]; + REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ]; + DISCH_ALL_TAC; + CHO 4; + AND 4; + CHO 5; + TYPE_THEN `edge x'` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + REWR 5; + REWR 4; + COPY 4; + USE 4(REWRITE_RULE[v_edge_closure;vc_edge;UNION ;INR IN_SING ]); + UND 4; + REP_CASES_TAC; + TYPE_THEN `v_edge m` EXISTS_TAC; + ASM_SIMP_TAC [curve_cell_v]; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + + ASM_SIMP_TAC [curve_cell_point]; + REWRITE_TAC[INR IN_SING]; + ASM_MESON_TAC[]; + USE 4(REWRITE_RULE[plus_e12]); + TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC; + + ASM_SIMP_TAC [curve_cell_point]; + REWRITE_TAC[INR IN_SING]; + ASM_MESON_TAC[]; + (* dt2 , down to 2 goals *) + REWR 5; + REWR 4; + COPY 4; + USE 4 (REWRITE_RULE[h_edge_closure;hc_edge;UNION;INR IN_SING]); + UND 4; + REP_CASES_TAC; + TYPE_THEN `h_edge m` EXISTS_TAC; + ASM_SIMP_TAC[curve_cell_h]; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ]; + ASM_MESON_TAC[]; + USE 4(REWRITE_RULE[plus_e12]); + TYPE_THEN `{x}` EXISTS_TAC; + ASM_REWRITE_TAC[INR IN_SING]; + ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ]; + ASM_MESON_TAC[]; + (* dt1 *) + REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset]; + ASM_SIMP_TAC[closure_unions]; + CONJ_TAC; + REWRITE_TAC[SUBSET;IMAGE;UNIONS]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + NAME_CONFLICT_TAC; + CHO 4; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[subset_closure;ISUBSET ]; + (* // *) + TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ; + REWRITE_TAC[UNIONS;SUBSET ]; + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[INR IN_SING]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* logic *) +let not_not = prove_by_refinement( + `!x y. (~x = ~y) <=> (x = y)`, + (* {{{ proof *) + [ + MESON_TAC[]; + ]);; + (* }}} *) + +let not_eq = prove_by_refinement( + `!x y. (~x = y) <=> (x = ~y)`, + (* {{{ proof *) + [ + MESON_TAC[]; + ]);; + (* }}} *) + +let cell_inter = prove_by_refinement( + `!C D. (cell C) /\ (D SUBSET cell) ==> + ((C INTER (UNIONS D) = EMPTY) <=> ~(D C))`, + (* {{{ proof *) + + [ + REWRITE_TAC[INTER;IN_UNIONS;SUBSET;EQ_EMPTY ]; + DISCH_ALL_TAC; + RIGHT_TAC "x"; + REWRITE_TAC[not_not ]; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + AND 2; + CHO 2; + TYPE_THEN `t = C` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 0(MATCH_MP cell_nonempty); + USE 0(REWRITE_RULE[EMPTY_EXISTS]); + CHO 0; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let curve_cell_h_inter = prove_by_refinement( + `!G m. (segment G) ==> + (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> + (~(G (h_edge m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM curve_cell_h]; + IMATCH_MP_TAC cell_inter; + ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; + ASM_MESON_TAC[segment;curve_cell_cell]; + ]);; + (* }}} *) + +let curve_cell_v_inter = prove_by_refinement( + `!G m. (segment G) ==> + (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> + (~(G (v_edge m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM curve_cell_v]; + IMATCH_MP_TAC cell_inter; + ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; + ASM_MESON_TAC[segment;curve_cell_cell]; + ]);; + (* }}} *) + +let curve_cell_squ = prove_by_refinement( + `!G m. (segment G) ==> ~curve_cell G (squ m)`, + (* {{{ proof *) + [ + REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment]; + REWRITE_TAC[SUBSET; edge]; + DISCH_ALL_TAC; + TSPEC `squ m` 3; + USE 3(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let curve_cell_squ_inter = prove_by_refinement( + `!G m. (segment G) ==> + (((squ m) INTER (UNIONS (curve_cell G)) = {}))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `cell (squ m)` SUBGOAL_TAC; + REWRITE_TAC[cell_rules]; + DISCH_TAC; + TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC; + ASM_MESON_TAC[curve_cell_cell;segment]; + DISCH_TAC; + ASM_SIMP_TAC [cell_inter]; + ASM_MESON_TAC [curve_cell_squ]; + ]);; + (* }}} *) + +let curve_point_unions = prove_by_refinement( + `!G m. (segment G) ==> + (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC; + REWRITE_TAC[REWRITE_RULE[not_eq] single_inter]; + DISCH_THEN_REWRITE; + REWRITE_TAC [not_eq]; + IMATCH_MP_TAC cell_inter; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + ASM_MESON_TAC[cell_rules;curve_cell_cell]; + ]);; + (* }}} *) + +let curve_cell_not_point = prove_by_refinement( + `!G m. (segment G) ==> ((curve_cell G {(pointI m)} <=> + ~(num_closure G (pointI m) = 0)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `FINITE G /\ (G SUBSET edge)` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + ASM_SIMP_TAC[curve_cell_point;num_closure0]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) + +let par_cell = jordan_def `par_cell eps G C <=> + ((?m. (C = {(pointI m)}) /\ (eps = EVEN (num_lower G m))) \/ + (?m. (C = h_edge m) /\ (eps = EVEN (num_lower G m))) \/ + (?m. (C = v_edge m) /\ (eps = EVEN (num_lower G m))) \/ + (?m. (C = squ m) /\ (eps= EVEN (num_lower G m)))) /\ + (C INTER (UNIONS (curve_cell G)) = EMPTY )`;; + +let par_cell_curve_disj = prove_by_refinement( + `!G C eps. (par_cell eps G C) ==> + (C INTER (UNIONS (curve_cell G)) = EMPTY )`, + (* {{{ proof *) + [ + REWRITE_TAC[par_cell]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let par_cell_cell = prove_by_refinement( + `!G eps. (par_cell eps G SUBSET cell)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;par_cell;even_cell]; + DISCH_ALL_TAC; + ASM_MESON_TAC[cell_rules]; + ]);; + (* }}} *) + +let par_cell_h = prove_by_refinement( + `!G m eps. (segment G) ==> ((par_cell eps G (h_edge m) <=> + (~(G (h_edge m))) /\ (eps = EVEN (num_lower G m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[par_cell;eq_sing;h_edge_inj;hv_edgeV2;h_edge_pointI;]; + REWRITE_TAC[square_h_edgeV2]; + ASM_SIMP_TAC[curve_cell_h_inter]; + CONV_TAC (dropq_conv "m'"); + MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_v = prove_by_refinement( + `!G m eps. (segment G) ==> ((par_cell eps G (v_edge m) <=> + (~(G (v_edge m))) /\ (eps = EVEN (num_lower G m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[par_cell;eq_sing;v_edge_inj;hv_edgeV2;v_edge_pointI;]; + REWRITE_TAC[square_v_edgeV2]; + ASM_SIMP_TAC[curve_cell_v_inter]; + CONV_TAC (dropq_conv "m'"); + MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_squ = prove_by_refinement( + `!G m eps. (segment G) ==> ((par_cell eps G (squ m) <=> + (eps = EVEN (num_lower G m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[par_cell;eq_sing;square_h_edgeV2;square_v_edgeV2;squ_inj]; + ASM_SIMP_TAC[curve_cell_squ_inter]; + REWRITE_TAC[square_pointI]; + CONV_TAC (dropq_conv "m'"); + ]);; + (* }}} *) + +let par_cell_point = prove_by_refinement( + `!G m eps. (segment G) ==> ((par_cell eps G {(pointI m)} <=> + ((num_closure G (pointI m) = 0) /\ + (eps = EVEN (num_lower G m)))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[par_cell;eq_sing;INR IN_SING;point_inj;]; + SUBGOAL_TAC `!u x. ({(pointI u)} = x) <=> (x = {(pointI u)})` ; + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[eq_sing;INR IN_SING ;h_edge_pointI; v_edge_pointI; square_pointI;]; + REWRITE_TAC[pointI_inj; REWRITE_RULE[not_eq] single_inter]; + CONV_TAC (dropq_conv "m'"); + ASM_SIMP_TAC [curve_point_unions;curve_cell_not_point]; + MESON_TAC[]; + ]);; + (* }}} *) + +let eq_sing_sym = prove_by_refinement( + `!X (y:A). ({y} = X) <=> X y /\ (!u. X u ==> (u = y))`, + (* {{{ proof *) + [ + ASM_MESON_TAC[eq_sing]; + ]);; + (* }}} *) + +let par_cell_disjoint = prove_by_refinement( + `!G eps. (par_cell eps G INTER par_cell (~eps) G = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[EQ_EMPTY;INTER ]; + REP_GEN_TAC; + REWRITE_TAC[par_cell]; + REPEAT (REPEAT (LEFT_TAC "m") THEN (GEN_TAC)); + REPEAT (LEFT_TAC "m"); + REPEAT (REPEAT (LEFT_TAC "m'") THEN (GEN_TAC )); + REPEAT (LEFT_TAC ("m'")); + REPEAT (REPEAT (LEFT_TAC "m''") THEN (GEN_TAC )); + REPEAT (LEFT_TAC ("m''")); + LEFT_TAC "m'''" THEN GEN_TAC; + LEFT_TAC "m''''" THEN GEN_TAC; + LEFT_TAC "m'''''" THEN GEN_TAC; + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + REWRITE_TAC[DE_MORGAN_THM]; + REPEAT (CONJ_TAC) THEN (REWRITE_TAC[GSYM DE_MORGAN_THM;GSYM CONJ_ASSOC]) THEN (REWRITE_TAC[TAUT `~(A /\ B) <=> (A ==> ~B)`]) THEN (DISCH_THEN_REWRITE ) THEN (REWRITE_TAC[eq_sing;eq_sing_sym;pointI_inj;h_edge_pointI;v_edge_pointI;square_pointI; INR IN_SING ; hv_edgeV2; h_edge_inj ; v_edge_inj; square_v_edgeV2;square_h_edgeV2;squ_inj ]) THEN (ASM_MESON_TAC[]); + ]);; + (* }}} *) + +let par_cell_nonempty = prove_by_refinement( + `!G eps. (rectagon G) ==> ~(par_cell eps G = EMPTY)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + COPY 1; + USE 1 (MATCH_MP rectagon_h_edge); + CHO 1; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon]; + DISCH_TAC ; + USE 3(MATCH_MP squ_down); + TSPEC `m` 3; + USE 3 (REWRITE_RULE[set_lower_n]); + UND 3; + ASM_REWRITE_TAC[even_cell_squ;]; + PROOF_BY_CONTR_TAC; + UND 0; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon_segment]; + DISCH_TAC ; + TYPE_THEN `eps = EVEN (num_lower G m)` ASM_CASES_TAC; + TYPE_THEN `squ m` EXISTS_TAC; + ASM_SIMP_TAC [par_cell_squ]; + TYPE_THEN `squ (down m)` EXISTS_TAC; + ASM_SIMP_TAC[par_cell_squ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_unions_nonempty = prove_by_refinement( + `!G eps. (rectagon G) ==> ~(UNIONS (par_cell eps G) = EMPTY)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[UNIONS;EMPTY_EXISTS ]; + NAME_CONFLICT_TAC; + DISCH_TAC ; + USE 0 (MATCH_MP par_cell_nonempty); + TSPEC `eps` 0; + USE 0 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 0; + LEFT_TAC "u'"; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `cell u` SUBGOAL_TAC; + ASM_MESON_TAC[par_cell_cell;ISUBSET ]; + DISCH_THEN (fun t-> MP_TAC (MATCH_MP cell_nonempty t)); + REWRITE_TAC[EMPTY_EXISTS]; + ]);; + (* }}} *) + +let ctop = jordan_def `ctop G = + induced_top top2 (euclid 2 DIFF (UNIONS (curve_cell G)))`;; + +let top2_unions = prove_by_refinement( + `UNIONS (top2) = (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC [top2]; + ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; + ]);; + (* }}} *) + +let curve_closed = prove_by_refinement( + `!G. (segment G) ==> (closed_ top2 (UNIONS (curve_cell G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM curve_closure]; + IMATCH_MP_TAC closure_closed; + REWRITE_TAC[top2_top]; + IMATCH_MP_TAC UNIONS_SUBSET; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + REWRITE_TAC[SUBSET;top2_unions;edge; ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TSPEC `A` 1; + REWR 1; + CHO 1; + ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid]; + ]);; + (* }}} *) + +let ctop_unions = prove_by_refinement( + `!G. UNIONS (ctop G) = (euclid 2 DIFF (UNIONS (curve_cell G)))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[ctop]; + REWRITE_TAC[induced_top_support]; + REWRITE_TAC[top2_unions]; + REWRITE_TAC[INTER;DIFF;]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_partition = prove_by_refinement( + `!G eps. (segment G) ==> + ((UNIONS (par_cell eps G) UNION (UNIONS (par_cell (~eps) G))) = + (UNIONS (ctop G))) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM ; + CONJ_TAC; + REWRITE_TAC[union_subset]; + TYPE_THEN `eps` (fun t-> SPEC_TAC (t,t)); + RIGHT_TAC "eps"; + SUBCONJ_TAC; + GEN_TAC; + IMATCH_MP_TAC UNIONS_SUBSET; + REWRITE_TAC[ctop_unions;DIFF_SUBSET ]; + DISCH_ALL_TAC; + COPY 1; + USE 2(MATCH_MP par_cell_curve_disj); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC cell_euclid; + ASM_MESON_TAC[par_cell_cell ;ISUBSET ]; + DISCH_TAC ; + GEN_TAC; + TSPEC `~eps` 1; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ctop_unions;SUBSET ;DIFF ; UNION ; UNIONS ]; + DISCH_ALL_TAC; + USE 1(MATCH_MP point_onto); + CHO 1; + ASSUME_TAC cell_unions; + TSPEC `p` 3; + USE 3 (REWRITE_RULE[UNIONS]); + CHO 3; + USE 3 (REWRITE_RULE[cell]); + AND 3; + CHO 4; + UND 4; + REP_CASES_TAC; + NAME_CONFLICT_TAC; + ASM_REWRITE_TAC[]; + REWR 3; + USE 3(REWRITE_RULE[INR IN_SING;pointI;point_inj ;]); + ASM_REWRITE_TAC[GSYM pointI]; + LEFT_TAC "u'"; + TYPE_THEN `{(pointI p')}` EXISTS_TAC; + ASM_SIMP_TAC[par_cell_point]; + REWRITE_TAC[INR IN_SING]; + LEFT 2 "u"; + TSPEC `{(pointI p')}` 2; + REWR 2; + USE 2(REWRITE_RULE[GSYM pointI;INR IN_SING ]); + UND 2; + ASM_SIMP_TAC [curve_cell_not_point]; + MESON_TAC[]; + (* case 2 *) + LEFT_TAC "u"; + TYPE_THEN `h_edge p'` EXISTS_TAC ; + ASM_SIMP_TAC [par_cell_h]; + LEFT 2 "u"; + REWR 3; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `(G (h_edge p'))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC ; + TSPEC `h_edge p'` 2; + ASM_MESON_TAC[curve_cell_h]; + (* case 3 *) + LEFT_TAC "u"; + TYPE_THEN `v_edge p'` EXISTS_TAC ; + ASM_SIMP_TAC [par_cell_v]; + LEFT 2 "u"; + REWR 3; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `(G (v_edge p'))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC ; + TSPEC `v_edge p'` 2; + ASM_MESON_TAC[curve_cell_v]; + (* case 4 *) + LEFT_TAC "u"; + TYPE_THEN `squ p'` EXISTS_TAC ; + ASM_SIMP_TAC [par_cell_squ]; + LEFT 2 "u"; + REWR 3; + ASM_REWRITE_TAC[]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* openness of par_cell *) +(* ------------------------------------------------------------------ *) + +let par_cell_h_squ = prove_by_refinement( + `!G m eps. (segment G) /\ (par_cell eps G (h_edge m)) ==> + (par_cell eps G (squ m) /\ par_cell eps G (squ (down m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + ASM_SIMP_TAC [par_cell_h;par_cell_squ]; + DISCH_ALL_TAC; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC ; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + ASM_SIMP_TAC[num_lower_down]; + ASM_MESON_TAC[set_lower_n]; + ]);; + (* }}} *) + +let par_cell_v_squ = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==> + (par_cell eps G (squ m) /\ par_cell eps G (squ (left m)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + UND 1; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon_segment]; + ASM_SIMP_TAC [par_cell_v;par_cell_squ]; + DISCH_ALL_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par]; + ]);; + + (* }}} *) + +(* move up *) +let segment_finite = prove_by_refinement( + `!G. (segment G) ==> (FINITE G)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[segment]; + ]);; + (* }}} *) + +let num_closure0_edge = prove_by_refinement( + `!G m. (FINITE G) /\ (num_closure G (pointI m) = 0) ==> + ~G (v_edge m) /\ ~G (v_edge (down m)) /\ + ~G (h_edge m) /\ ~G(h_edge (left m))`, + (* {{{ proof *) + + let rule = REWRITE_RULE[down;left ;h_edge_closure;hc_edge;v_edge_closure;vc_edge;UNION ;plus_e12; INR IN_SING ; INT_ARITH `x -: &:1 +: &:1 = x`] in + [ + DISCH_ALL_TAC; + UND 1; + ASM_SIMP_TAC[num_closure0]; + DISCH_TAC; + REWRITE_TAC[GSYM DE_MORGAN_THM]; + PURE_REWRITE_TAC [GSYM IMP_CLAUSES]; + REP_CASES_TAC; + TSPEC `v_edge m` 1; + JOIN 1 2; + USE 1(rule); + ASM_MESON_TAC[]; + TSPEC `v_edge (down m)` 1; + JOIN 2 1; + USE 1(rule); + ASM_MESON_TAC[]; + TSPEC `h_edge ( m)` 1; + JOIN 1 2; + USE 1(rule); + ASM_MESON_TAC[]; + TSPEC `h_edge (left m)` 1; + JOIN 1 2; + USE 1(rule); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_point_h = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==> + (par_cell eps G (h_edge m) /\ par_cell eps G (h_edge (left m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon_segment]; + ASM_SIMP_TAC [par_cell_h;par_cell_point]; + DISCH_ALL_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par]; + UND 1; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[segment_finite]; + ASM_MESON_TAC[num_closure0_edge]; + ]);; + (* }}} *) + +let par_cell_point_v = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==> + (par_cell eps G (v_edge m) /\ par_cell eps G (v_edge (down m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon_segment]; + ASM_SIMP_TAC [par_cell_v;par_cell_point]; + DISCH_ALL_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_MESON_TAC[segment_finite]; + ASM_SIMP_TAC[num_lower_down]; + REWRITE_TAC [set_lower_n]; + ASM_MESON_TAC[num_closure0_edge]; + ]);; + (* }}} *) + +let par_cell_point_rectangle = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==> + (rectangle (FST m -: &:1,SND m -: &:1) (FST m +: &:1,SND m +: &:1) + SUBSET (UNIONS (par_cell eps G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_SIMP_TAC[rectagon_segment]; + DISCH_TAC; + REWRITE_TAC[two_two_union;union_subset]; + CONJ_TAC; + TYPE_THEN `rectangle (FST m -: &:1,SND m -: &:1) (FST m,SND m +: &:1) = rectangle (FST (left m),SND (left m) -: &:1) (FST (left m) +: &:1,SND (left m) +: &:1)` SUBGOAL_TAC; + REWRITE_TAC[left ;INT_ARITH ` x -: &:1 +: &:1 =x`]; + DISCH_THEN_REWRITE; + REWRITE_TAC[rectangle_h;union_subset ]; + TYPE_THEN `par_cell eps G (h_edge (left m))` SUBGOAL_TAC; + ASM_MESON_TAC[par_cell_point_h]; + ASM_MESON_TAC[sub_union;par_cell_h_squ]; + CONJ_TAC; + REWRITE_TAC[long_v_union;union_subset;]; + ASM_MESON_TAC[sub_union; par_cell_point_v;]; + REWRITE_TAC[rectangle_h;union_subset ]; + TYPE_THEN `par_cell eps G (h_edge ( m))` SUBGOAL_TAC; + ASM_MESON_TAC[par_cell_point_h]; + ASM_MESON_TAC[sub_union;par_cell_h_squ]; + ]);; + (* }}} *) + +let par_cell_h_rectangle = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G (h_edge m)) ==> + (rectangle (FST m ,SND m -: &:1) (FST m +: &:1,SND m +: &:1) + SUBSET (UNIONS (par_cell eps G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_SIMP_TAC[rectagon_segment]; + DISCH_TAC; + REWRITE_TAC[rectangle_h;union_subset ]; + ASM_MESON_TAC[sub_union;par_cell_h_squ]; + ]);; + (* }}} *) + +let par_cell_v_rectangle = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==> + (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) + SUBSET (UNIONS (par_cell eps G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_SIMP_TAC[rectagon_segment]; + DISCH_TAC; + REWRITE_TAC[rectangle_v;union_subset ]; + ASM_MESON_TAC[sub_union;par_cell_v_squ]; + ]);; + (* }}} *) + +let par_cell_squ_rectangle = prove_by_refinement( + `!G m eps. (rectagon G) /\ (par_cell eps G (squ m)) ==> + (rectangle (FST m ,SND m ) (FST m +: &:1,SND m +: &:1) + SUBSET (UNIONS (par_cell eps G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[GSYM rectangle_squ]; + IMATCH_MP_TAC sub_union; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let par_cell_point_in_rectangle = prove_by_refinement( + `!m. (rectangle (FST m -: &:1,SND m -: &:1) + (FST m +: &:1,SND m +: &:1) (pointI m))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[two_two_union;UNION ;long_v_union ; INR IN_SING ;]; + ]);; + (* }}} *) + +let par_cell_h_in_rectangle = prove_by_refinement( + `!m. (h_edge m SUBSET + (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[rectangle_h; UNION ; ISUBSET; INR IN_SING ;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_v_in_rectangle = prove_by_refinement( + `!m. (v_edge m SUBSET + (rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[rectangle_v; UNION ; ISUBSET; INR IN_SING ;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let ctop_top = prove_by_refinement( + `!G. topology_ (ctop G)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[ctop]; + IMATCH_MP_TAC induced_top_top; + REWRITE_TAC[top2_top]; + ]);; + (* }}} *) + +let ctop_open = prove_by_refinement( + `!G B eps. (segment G) /\ (B SUBSET UNIONS (par_cell eps G)) /\ + (top2 B) ==> (ctop G B)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[ctop;induced_top;IMAGE]; + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;GSYM ctop_unions]; + ASM_SIMP_TAC[GSYM par_cell_partition]; + REWRITE_TAC[UNION;ISUBSET ]; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let par_cell_open = prove_by_refinement( + `!G eps. (rectagon G) ==> (ctop G (UNIONS (par_cell eps G )))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_MESON_TAC[rectagon_segment]; + DISCH_TAC; + ASSUME_TAC ctop_top; + TSPEC `G` 2; + USE 2(MATCH_MP open_nbd); + UND 2; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]) ; + GEN_TAC; + RIGHT_TAC "B"; + DISCH_TAC; + USE 2(REWRITE_RULE[UNIONS]); + CHO 2; + TYPE_THEN `?p. (u = {(pointI p)}) \/ (u = h_edge p) \/ (u = v_edge p) \/ (u = squ p)` SUBGOAL_TAC; + AND 2; + USE 3 (MATCH_MP (REWRITE_RULE[ISUBSET ]par_cell_cell)); + USE 3(REWRITE_RULE[cell]); + ASM_REWRITE_TAC[]; + DISCH_THEN (CHOOSE_THEN MP_TAC ); + ASSUME_TAC rectangle_open; + REP_CASES_TAC ; + (* 1st case *) + REWR 2; + USE 2(REWRITE_RULE[INR IN_SING]); + ASM_REWRITE_TAC[]; + TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; + REWRITE_TAC[par_cell_point_in_rectangle]; + SUBCONJ_TAC; + ASM_SIMP_TAC[par_cell_point_rectangle]; + ASM_MESON_TAC[ctop_open]; + (* 2nd case *) + REWR 2; + TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; + ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_h_in_rectangle]; + SUBCONJ_TAC; + ASM_SIMP_TAC[par_cell_h_rectangle]; + ASM_MESON_TAC[ctop_open]; + (* 3rd case *) + REWR 2; + TYPE_THEN `rectangle (FST p -: &:1,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; + ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_v_in_rectangle]; + SUBCONJ_TAC; + ASM_SIMP_TAC[par_cell_v_rectangle]; + ASM_MESON_TAC[ctop_open]; + (* 4th case *) + REWR 2; + TYPE_THEN `rectangle (FST p,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC; + ASSUME_TAC rectangle_squ; + TSPEC `p` 5; + SUBCONJ_TAC; + ASM_SIMP_TAC[par_cell_squ_rectangle]; + DISCH_TAC; + CONJ_TAC; + ASM_MESON_TAC[PAIR]; + ASM_MESON_TAC[ctop_open]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* start on connected components of ctop G *) +(* ------------------------------------------------------------------ *) + +(* move *) +let connected_empty = prove_by_refinement( + `!(U:(A->bool)->bool). connected U EMPTY `, + (* {{{ proof *) + [ + REWRITE_TAC[connected]; + ]);; + (* }}} *) + +let par_cell_union_disjoint = prove_by_refinement( + `!G eps. (UNIONS (par_cell eps G) INTER (UNIONS (par_cell (~eps) G)) = + EMPTY )`, + (* {{{ proof *) + + [ + REWRITE_TAC[INTER;EQ_EMPTY ;UNIONS;]; + DISCH_ALL_TAC; + AND 0; + CHO 0; + CHO 1; + TYPE_THEN `cell u /\ cell u'` SUBGOAL_TAC; + ASM_MESON_TAC[par_cell_cell;ISUBSET]; + DISCH_TAC; + TYPE_THEN `u = u'` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASSUME_TAC par_cell_disjoint; + USE 4(REWRITE_RULE[INTER;EQ_EMPTY]); + TYPEL_THEN[`G`;`eps`;`u`] (USE 4 o ISPECL); + USE 3 (GSYM); + REWR 1; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let par_cell_comp = prove_by_refinement( + `!G eps x. (rectagon G) ==> + (component (ctop G) x SUBSET (UNIONS (par_cell eps G))) \/ + (component (ctop G) x SUBSET (UNIONS (par_cell (~eps) G)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `component (ctop G) x SUBSET (UNIONS (ctop G))` SUBGOAL_TAC; + REWRITE_TAC[component_DEF ;SUBSET ;connected ]; + MESON_TAC[]; + TYPE_THEN `segment G` SUBGOAL_TAC; + ASM_MESON_TAC [rectagon_segment]; + DISCH_TAC; + ASM_SIMP_TAC[GSYM par_cell_partition]; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + USE 3 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]); + AND 3; + LEFT 3 "x'"; + CHO 3; + LEFT 4 "x'"; + CHO 4; + TYPE_THEN `component (ctop G) x x'' /\ component (ctop G) x x' ` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `component (ctop G) x' x'' ` SUBGOAL_TAC; + ASM_MESON_TAC[component_symm;component_trans]; + DISCH_TAC; + USE 6(REWRITE_RULE[component_DEF]); + CHO 6; + USE 6(REWRITE_RULE[connected]); + AND 6; + AND 6; + AND 7; + TYPE_THEN `A = UNIONS (par_cell eps G)` ABBREV_TAC ; + TYPE_THEN `B = UNIONS (par_cell (~eps) G)` ABBREV_TAC ; + TYPEL_THEN [`A`;`B`] (USE 7 o ISPECL); + UND 7; + REWRITE_TAC[]; + TYPE_THEN `ctop G A /\ ctop G B` SUBGOAL_TAC; + ASM_MESON_TAC[par_cell_open]; + DISCH_THEN_REWRITE; + TYPE_THEN `Z SUBSET (A UNION B)` SUBGOAL_TAC; + ASM_MESON_TAC[par_cell_partition]; + DISCH_THEN_REWRITE; + TYPE_THEN `A INTER B = EMPTY` SUBGOAL_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + ASM_MESON_TAC[par_cell_union_disjoint;INTER_ACI;]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[ISUBSET]; + ]);; + + (* }}} *) + +(* move *) +let connected_component = prove_by_refinement( + `!U Z (x:A). (connected U Z) /\ (Z x) ==> (Z SUBSET (component U x)) `, + (* {{{ proof *) + [ + REWRITE_TAC[component_DEF ;SUBSET ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `Z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let cont_mk_segment = prove_by_refinement( + `!x y n. (euclid n x) /\ (euclid n y) ==> + (continuous (joinf (\u. x) + (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) + (&.0)) + (top_of_metric (UNIV,d_real)) (top_of_metric (euclid n,d_euclid)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC joinf_cont; + CONJ_TAC; + IMATCH_MP_TAC const_continuous; + IMATCH_MP_TAC top_of_metric_top; + REWRITE_TAC[metric_real]; + CONJ_TAC; + IMATCH_MP_TAC joinf_cont; + CONJ_TAC; + IMATCH_MP_TAC continuous_lin_combo; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC const_continuous; + IMATCH_MP_TAC top_of_metric_top; + REWRITE_TAC[metric_real]; + BETA_TAC; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_rzero ]; + REWRITE_TAC[joinf]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero ]; + ]);; + (* }}} *) + +let mk_segment_image = prove_by_refinement( + `!x y n. (euclid n x) /\ (euclid n y) ==> (?f. + (continuous f + (top_of_metric(UNIV,d_real)) + (top_of_metric (euclid n,d_euclid))) /\ + (IMAGE f {t | &.0 <=. t /\ t <=. &.1} = mk_segment x y))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC cont_mk_segment; + ASM_REWRITE_TAC[]; + REWRITE_TAC[joinf;IMAGE ]; + REWRITE_TAC[mk_segment]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + ASM_REWRITE_TAC[]; + EQ_TAC; + DISCH_TAC; + CHO 2; + UND 2; + COND_CASES_TAC; + DISCH_ALL_TAC; + JOIN 3 2; + ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`]; + DISCH_ALL_TAC; + UND 5; + COND_CASES_TAC; + DISCH_TAC; + TYPE_THEN `&1 - x''` EXISTS_TAC; + SUBCONJ_TAC; + UND 5; + REAL_ARITH_TAC ; + DISCH_TAC; + CONJ_TAC; + UND 3; + REAL_ARITH_TAC ; + ONCE_REWRITE_TAC [euclid_add_comm]; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + CONJ_TAC; + REAL_ARITH_TAC ; + CONJ_TAC; + REAL_ARITH_TAC ; + REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; + (* 2nd half *) + DISCH_TAC; + CHO 2; + TYPE_THEN `&1 - a` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + AND 2; + AND 2; + UND 3; + UND 4; + REAL_ARITH_TAC ; + COND_CASES_TAC; + ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`]; + COND_CASES_TAC; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; + ASM_MESON_TAC [euclid_add_comm]; + TYPE_THEN `a = &.0` SUBGOAL_TAC; + UND 4; + UND 3; + AND 2; + UND 3; + REAL_ARITH_TAC ; + DISCH_TAC; + REWR 2; + REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; + ]);; + (* }}} *) + +let euclid_n_convex = prove_by_refinement( + `!n. (convex (euclid n))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[convex;mk_segment;SUBSET ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CHO 2; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure]; + ]);; + (* }}} *) + +let connected_mk_segment = prove_by_refinement( + `!x y n. (euclid n x) /\ (euclid n y) ==> + (connected (top_of_metric(euclid n,d_euclid)) (mk_segment x y))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `?f. (continuous f (top_of_metric(UNIV,d_real)) (top_of_metric (euclid n,d_euclid))) /\ (IMAGE f {t | &.0 <=. t /\ t <=. &.1} = mk_segment x y)` SUBGOAL_TAC; + IMATCH_MP_TAC mk_segment_image; + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + USE 2(GSYM); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC connect_image; + TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + USE 2(GSYM); + ASM_REWRITE_TAC[]; + TYPE_THEN `UNIONS (top_of_metric (euclid n,d_euclid) ) = (euclid n)` SUBGOAL_TAC; + ASM_MESON_TAC [top_of_metric_unions;metric_euclid]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[convex;euclid_n_convex]; + MATCH_ACCEPT_TAC connect_real; + ]);; + (* }}} *) + +let ctop_open = prove_by_refinement( + `!G A. (top2 A /\ (A SUBSET (UNIONS (ctop G))) ==> ctop G A)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[ctop;induced_top;IMAGE ]; + TYPE_THEN `A` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION]; + REWRITE_TAC[GSYM ctop_unions]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let ctop_top2 = prove_by_refinement( + `!G A. (segment G /\ ctop G A ==> top2 A)`, + (* {{{ proof *) + [ + REWRITE_TAC[ctop;induced_top;IMAGE ;]; + DISCH_ALL_TAC; + TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ; + TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC; + EXPAND_TAC "U"; + ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; + CHO 1; + DISCH_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[top2_top;]; + ASM_SIMP_TAC[GSYM curve_closure;top2]; + IMATCH_MP_TAC (REWRITE_RULE[open_DEF] closed_open); + IMATCH_MP_TAC closure_closed; + CONJ_TAC; + EXPAND_TAC "U"; + ASM_MESON_TAC[top_of_metric_top;metric_euclid]; + USE 3(GSYM); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC UNIONS_SUBSET; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + REWRITE_TAC[edge;ISUBSET;]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TSPEC `A'` 4; + REWR 4; + CHO 4; + UND 4; + DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] ; + MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] v_edge_euclid); + MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] h_edge_euclid); + ]);; + (* }}} *) + +let mk_segment_sym_lemma = prove_by_refinement( + `!x y z. (mk_segment x y z ==> mk_segment y x z)`, + (* {{{ proof *) + [ + REWRITE_TAC[mk_segment]; + DISCH_ALL_TAC; + CHO 0; + TYPE_THEN `&1 - a` EXISTS_TAC; + CONJ_TAC; + ASM_MESON_TAC[REAL_ARITH `a <= &1 ==> &0 <= &1 - a`]; + CONJ_TAC; + ASM_MESON_TAC[REAL_ARITH `&0 <= a ==> &1 - a <= &1`]; + ONCE_REWRITE_TAC[euclid_add_comm]; + ASM_REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; + ]);; + (* }}} *) + +let mk_segment_sym = prove_by_refinement( + `!x y. (mk_segment x y = mk_segment y x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + EQ_TAC THEN ASM_MESON_TAC[mk_segment_sym_lemma]; + ]);; + (* }}} *) + +let mk_segment_end = prove_by_refinement( + `!x y. (mk_segment x y x /\ mk_segment x y y)`, + (* {{{ proof *) + [ + RIGHT_TAC "y"; + RIGHT_TAC "x"; + SUBCONJ_TAC; + DISCH_ALL_TAC; + REWRITE_TAC[mk_segment]; + TYPE_THEN `&1` EXISTS_TAC; + REDUCE_TAC; + CONJ_TAC; + ARITH_TAC; + REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; + DISCH_TAC; + ONCE_REWRITE_TAC[mk_segment_sym]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let convex_connected = prove_by_refinement( + `!G Z. (segment G /\ convex Z) /\ (Z SUBSET (UNIONS (ctop G))) ==> + (connected (ctop G) Z)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[connected]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + USE 7 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]); + AND 7; + LEFT 7 "x"; + CHO 7; + LEFT 8 "x"; + CHO 8; + TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC; + USE 1(REWRITE_RULE[convex]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC; + IMATCH_MP_TAC connected_mk_segment; + USE 2(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]); + ASM_MESON_TAC[]; + REWRITE_TAC[connected]; + DISCH_ALL_TAC; + AND 11; + TYPEL_THEN [`A`;`B`] (USE 11 o ISPECL); + REWR 11; + TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC; + REWRITE_TAC[GSYM top2]; + ASM_MESON_TAC[ctop_top2;top2]; + DISCH_TAC; + UND 11; + ASM_REWRITE_TAC[]; + REWRITE_TAC[DE_MORGAN_THM;ISUBSET;]; + CONJ_TAC; + LEFT_TAC "x''"; + TYPE_THEN `x'` EXISTS_TAC; + REWRITE_TAC[mk_segment_end]; + ASM_MESON_TAC[]; + LEFT_TAC "x''"; + TYPE_THEN `x` EXISTS_TAC; + REWRITE_TAC[mk_segment_end]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let component_replace = prove_by_refinement( + `!U (x:A) y. component U x y ==> (component U x = component U y)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + USE 0(MATCH_MP component_symm); + ASM_MESON_TAC[component_trans]; + ASM_MESON_TAC[component_trans;component_symm]; + ]);; + + (* }}} *) + +let convex_component = prove_by_refinement( + `!G Z x. (segment G /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) /\ + (~(Z INTER (component (ctop G) x ) = EMPTY)) ==> + (Z SUBSET (component (ctop G) x))) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC; + ASM_SIMP_TAC[convex_connected]; + DISCH_TAC; + USE 3(REWRITE_RULE[EMPTY_EXISTS;INTER ]); + CHO 3; + AND 3; + USE 3(MATCH_MP component_replace); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC connected_component; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let cell_convex = prove_by_refinement( + `!C. (cell C) ==> (convex C)`, + (* {{{ proof *) + [ + REWRITE_TAC[cell]; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC ) THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[v_edge_convex;h_edge_convex;convex_pointI;rectangle_squ;rectangle_convex]; + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) + +let cell_of = jordan_def `cell_of C = { A | (cell A) /\ (A SUBSET C) }`;; + +let unions_cell_of = prove_by_refinement( + `!G x. (segment G ==> + (UNIONS (cell_of (component (ctop G) x)) = + component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + REWRITE_TAC[UNIONS;SUBSET;cell_of]; + CONJ_TAC; + DISCH_ALL_TAC; + CHO 1; + AND 1; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[component_DEF ;connected;SUBSET ;ctop_unions;DIFF ]; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 2 (MATCH_MP point_onto); + CHO 2; + REWR 1; + ASM_REWRITE_TAC[]; + ASSUME_TAC cell_unions; + TSPEC `p` 3; + USE 3 (REWRITE_RULE[UNIONS]); + CHO 3; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `u SUBSET (component (ctop G) x) ==> (!x'. u x' ==> component (ctop G) x x')` SUBGOAL_TAC; + REWRITE_TAC[ISUBSET]; + ASM_REWRITE_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + IMATCH_MP_TAC convex_component ; + ASM_REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + ASM_MESON_TAC[cell_convex]; + CONJ_TAC; + REWRITE_TAC[ctop_unions]; + REWRITE_TAC[DIFF;SUBSET ]; + DISCH_ALL_TAC; + CONJ_TAC; + AND 3; + UND 5; + UND 4; + ASM_MESON_TAC[cell_euclid;ISUBSET]; + REWRITE_TAC[UNIONS]; + LEFT_TAC "u"; + GEN_TAC; + DISCH_ALL_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + USE 6 (MATCH_MP curve_cell_cell); + USE 6 (REWRITE_RULE[ISUBSET]); + TSPEC `u'` 6; + REWR 6; + TYPE_THEN `u = u'` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 1 (REWRITE_RULE[component_DEF;connected;SUBSET ]); + TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]; + DISJ2_TAC ; + ASM_MESON_TAC[]; + NAME_CONFLICT_TAC; + TYPE_THEN `point p` EXISTS_TAC; + ASM_REWRITE_TAC [INTER]; + ]);; + (* }}} *) + + + + +(* ------------------------------------------------------------------ *) +(* SECTION F *) +(* ------------------------------------------------------------------ *) + +(* ------------------------------------------------------------------ *) +(* num_abs_of_int *) +(* ------------------------------------------------------------------ *) + +let num_abs_of_int_exists = prove_by_refinement( + `!m. ?i. &i = abs (real_of_int(m))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[GSYM int_abs_th]; + ASSUME_TAC dest_int_rep; + TSPEC `||: m` 0; + CHO 0; + TYPE_THEN `n` EXISTS_TAC; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + WITH 0 (REWRITE_RULE[int_abs_th]); + TYPE_THEN `&0 <= abs (real_of_int m)` SUBGOAL_TAC; + REWRITE_TAC[REAL_ABS_POS]; + TYPE_THEN `abs (real_of_int m) <= &.0` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC ; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC ; + ]);; + (* }}} *) + +let num_abs_of_int_select = new_definition + `num_abs_of_int m = @i. (&i = abs (real_of_int m))`;; + +let num_abs_of_int_th = prove_by_refinement( + `!m. &(num_abs_of_int m) = abs (real_of_int m)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[num_abs_of_int_select]; + SELECT_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[num_abs_of_int_exists]; + ]);; + (* }}} *) + +let num_abs_of_int_mul = prove_by_refinement( + `!m n. (num_abs_of_int (m * n) = num_abs_of_int m * num_abs_of_int n)`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM REAL_OF_NUM_EQ;GSYM REAL_MUL;num_abs_of_int_th;int_mul_th;ABS_MUL;]; + ]);; + (* }}} *) + +let num_abs_of_int_num = prove_by_refinement( + `!n. (num_abs_of_int (&: n) = n)`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_of_num_th;REAL_ABS_NUM;]; + ]);; + (* }}} *) + +let num_abs_of_int_triangle = prove_by_refinement( + `!n m. num_abs_of_int (m + n) <=| + num_abs_of_int(m) +| num_abs_of_int n`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_LE;num_abs_of_int_th;int_add_th;GSYM REAL_OF_NUM_ADD;ABS_TRIANGLE;]; + ]);; + (* }}} *) + +let num_abs_of_int0 = prove_by_refinement( + `!m. (num_abs_of_int m = 0) <=> (m = &:0)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;REAL_ABS_ZERO;]; + REWRITE_TAC[int_eq;]; + REWRITE_TAC[int_of_num_th;]; + ]);; + (* }}} *) + +let num_abs_of_int_neg = prove_by_refinement( + `!m. (num_abs_of_int (--: m) = num_abs_of_int m)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_neg_th;REAL_ABS_NEG;]; + ]);; + (* }}} *) + +let num_abs_of_int_suc = prove_by_refinement( + `!m. (&:0 <=: m) ==> + (SUC (num_abs_of_int m) = num_abs_of_int (m +: &:1))`, + (* {{{ proof *) + [ + REWRITE_TAC[int_le;int_of_num_th;]; + DISCH_ALL_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc]; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let num_abs_of_int_pre = prove_by_refinement( + `!m. (m <=: &:0) ==> + (SUC (num_abs_of_int m) = num_abs_of_int (m -: &:1))`, + (* {{{ proof *) + [ + REWRITE_TAC[int_le;int_of_num_th;]; + DISCH_ALL_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc;int_sub_th;int_of_num_th;]; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* closure of squares *) +(* ------------------------------------------------------------------ *) + +let right_left = prove_by_refinement( + `!m. (right (left m) = m) /\ (left (right m) = m) /\ + (up (down m) = m) /\ (down (up m) = m) /\ + (up (right m) = right (up m)) /\ (up (left m) = left (up m)) /\ + (down (right m) = right (down m)) /\ + (down (left m) = (left (down m)))`, + (* {{{ proof *) + [ + REWRITE_TAC[right ;left ;up;down;PAIR_SPLIT]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let squc = jordan_def `squc p = {Z | ?u v. + (Z = point (u,v)) /\ + real_of_int (FST p) <= u /\ + u <= real_of_int (FST p +: &:1) /\ + real_of_int (SND p) <= v /\ + v <= real_of_int (SND p +: &:1)}`;; + +let squc_inter = prove_by_refinement( + `!p. squc p = + {z | ?r. (z = point r) /\ real_of_int (FST p) <= FST r} INTER + {z | ?r. (z = point r) /\ real_of_int (SND p) <= SND r} INTER + {z | ?r. (z = point r) /\ FST r <= real_of_int (FST p +: &:1)} INTER + {z | ?r. (z = point r) /\ SND r <= real_of_int (SND p +: &:1)}`, + (* {{{ proof *) + + [ + REWRITE_TAC[squc]; + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER]; + EQ_TAC; + DISCH_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[point_inj;]; + CONV_TAC (dropq_conv "r"); + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "r"); + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "r'"); + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "r"); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CHO 0; + AND 0; + REWR 1; + REWRITE_TAC[point_inj;PAIR_SPLIT ;]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + USE 1 (REWRITE_RULE[point_inj;]); + USE 1 (CONV_RULE (dropq_conv "r'")); + REWR 2; + USE 2 (REWRITE_RULE[point_inj;]); + USE 2 (CONV_RULE (dropq_conv "r'")); + REWR 3; + USE 3 (REWRITE_RULE[point_inj;]); + USE 3 (CONV_RULE (dropq_conv "r'")); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let squc_closed = prove_by_refinement( + `!p. closed_ (top2) (squc p)`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC top2_top; + REWRITE_TAC[squc_inter]; + ASM_SIMP_TAC[closed_inter2;closed_half_plane2D_LTS_closed;closed_half_plane2D_SLT_closed;closed_half_plane2D_LTF_closed;closed_half_plane2D_FLT_closed]; + ]);; + (* }}} *) + +let squ_subset_sqc = prove_by_refinement( + `!p. (squ p SUBSET (squc p))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[SUBSET;squ;squc]; + GEN_TAC; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_MESON_TAC[REAL_ARITH `x < y ==> x <=. y`]; + ]);; + (* }}} *) + +let squc_union_lemma1 = prove_by_refinement( + `!p. squc p INTER + {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} = + {(pointI p)} UNION (v_edge p) UNION {(pointI (up p))}`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[squc;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + REWR 1; + USE 1(REWRITE_RULE[point_inj]); + USE 1(CONV_RULE (dropq_conv "r")); + UND 0; + DISCH_ALL_TAC; + UND 4; + UND 5; + REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`]; + KILL 2; + KILL 3; + KILL 0; + USE 1 (GSYM); + ASM_REWRITE_TAC[]; + KILL 0; + REP_CASES_TAC; + ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`]; + EXPAND_TAC "v"; + REWRITE_TAC[pointI;int_suc;]; + ASM_REWRITE_TAC[pointI]; + REWRITE_TAC[v_edge]; + DISJ2_TAC ; + DISJ1_TAC ; + REWRITE_TAC[point_inj; PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v'"); + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[int_suc]; + REP_CASES_TAC; + ASM_REWRITE_TAC[pointI;point_inj;]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + USE 0 (REWRITE_RULE[v_edge]); + CHO 0; + CHO 0; + ASM_REWRITE_TAC[]; + REWRITE_TAC[point_inj]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v'"); + AND 0; + UND 0; + REWRITE_TAC[int_suc]; + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + (* LAST *) + ASM_REWRITE_TAC[pointI;point_inj;]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REWRITE_TAC[int_suc]; + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + ]);; + (* }}} *) + +let squc_union_lemma2 = prove_by_refinement( + `!p. squc p INTER + {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} = + {(pointI (right p))} UNION (v_edge (right p)) UNION + {(pointI (up (right p)))}`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[squc;right ;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + REWR 1; + USE 1(REWRITE_RULE[point_inj]); + USE 1(CONV_RULE (dropq_conv "r")); + UND 0; + DISCH_ALL_TAC; + UND 4; + UND 5; + REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`]; + KILL 2; + KILL 3; + KILL 0; + USE 1 (GSYM); + ASM_REWRITE_TAC[]; + KILL 0; + REP_CASES_TAC; + ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`]; + EXPAND_TAC "v"; + REWRITE_TAC[pointI;int_suc;]; + (* 3 LEFT *) + ASM_REWRITE_TAC[pointI;int_suc;]; + (* 2 LEFT *) + REWRITE_TAC[v_edge]; + DISJ2_TAC ; + DISJ1_TAC ; + REWRITE_TAC[point_inj; PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[int_suc]; + CONV_TAC (dropq_conv "v'"); + ASM_REWRITE_TAC[]; + (* second half *) + ASM_REWRITE_TAC[int_suc]; + REP_CASES_TAC; + ASM_REWRITE_TAC[pointI;point_inj;]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + ASM_REWRITE_TAC[int_suc]; + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + REWRITE_TAC[int_suc]; + (* 2 LEFT *) + USE 0 (REWRITE_RULE[v_edge]); + CHO 0; + CHO 0; + ASM_REWRITE_TAC[]; + REWRITE_TAC[point_inj]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v'"); + AND 0; + UND 0; + REWRITE_TAC[int_suc]; + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + REWRITE_TAC[int_suc]; + (* LAST *) + ASM_REWRITE_TAC[pointI;point_inj;]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REWRITE_TAC[int_suc]; + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + REWRITE_TAC[int_suc]; + ]);; + (* }}} *) + +let squc_union_lemma3 = prove_by_refinement( + `!p. squc p INTER + {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\ + (real_of_int(FST p) <. FST r) } = + (h_edge p) UNION squ p UNION (h_edge (up p))`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER;squc;UNION;]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + REWR 1; + USE 1 (REWRITE_RULE[point_inj]); + USE 1 (CONV_RULE (dropq_conv "r")); + AND 0; + UND 0; + DISCH_ALL_TAC; + KILL 0; + KILL 3; + UND 4; + UND 5; + REWRITE_TAC[REAL_ARITH `(x <= y) <=> (y = x) \/ (x <. y)`;int_suc]; + REP_CASES_TAC; + ASM_MESON_TAC[REAL_ARITH `~(v = v + &1)`]; + EXPAND_TAC "v"; + REWRITE_TAC[up;h_edge]; + DISJ2_TAC; + DISJ2_TAC; + REWRITE_TAC[point_inj;]; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u'"); + CONV_TAC (dropq_conv "v"); + ASM_REWRITE_TAC[int_suc]; + (* 3 to go *) + ASM_REWRITE_TAC[]; + DISJ1_TAC; + REWRITE_TAC[h_edge;point_inj;PAIR_SPLIT]; + CONV_TAC (dropq_conv "u'"); + CONV_TAC (dropq_conv "v"); + ASM_REWRITE_TAC[int_suc]; + (* 2 to go *) + DISJ2_TAC; + DISJ1_TAC; + REWRITE_TAC[squ;point_inj;PAIR_SPLIT]; + CONV_TAC (dropq_conv "u'"); + CONV_TAC (dropq_conv "v'"); + ASM_REWRITE_TAC[int_suc]; + (* 2nd half *) + DISCH_TAC; + TYPE_THEN `?q. x = point q` ASM_CASES_TAC; + CHO 1; + ASM_REWRITE_TAC[point_inj]; + CONJ_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REWR 0; + UND 0; + REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;]; + REP_CASES_TAC; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + UND 0; + REAL_ARITH_TAC ; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + UND 0; + REAL_ARITH_TAC ; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + UND 0; + REAL_ARITH_TAC ; + CONV_TAC (dropq_conv "r"); + REWR 0; + UND 0; + REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;]; + REP_CASES_TAC; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + UND 0; + REAL_ARITH_TAC ; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + UND 0; + REAL_ARITH_TAC ; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + UND 0; + REAL_ARITH_TAC ; + (* 1 goal LEFT *) + PROOF_BY_CONTR_TAC; + KILL 2; + UND 1; + REWRITE_TAC[]; + IMATCH_MP_TAC point_onto; + ASM_MESON_TAC[h_edge_euclid;squ_euclid;v_edge_euclid;ISUBSET ]; + ]);; + (* }}} *) + +let squc_lemma4 = prove_by_refinement( + `!p. squc p SUBSET + {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION + {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION + {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\ + (real_of_int(FST p) <. FST r) } `, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;UNION ;squc ]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[point_inj ;]; + LEFT_TAC "r"; + CONV_TAC (dropq_conv "r"); + UND 0; + DISCH_ALL_TAC; + UND 1; + UND 2; + ASM_REWRITE_TAC[int_suc]; + REAL_ARITH_TAC ; + ]);; + (* }}} *) + +let squc_union = prove_by_refinement( + `!p. squc p = {(pointI p)} UNION {(pointI (right p))} UNION + {(pointI (up p))} UNION {(pointI (up (right p)))} UNION + (h_edge p) UNION (h_edge (up p)) UNION + (v_edge p) UNION (v_edge (right p)) UNION + (squ p)`, + (* {{{ proof *) + [ + GEN_TAC; + TYPE_THEN `squc p = squc p INTER ({z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\ (real_of_int(FST p) <. FST r) } )` SUBGOAL_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + REWRITE_TAC [GSYM SUBSET_INTER_ABSORPTION]; + MATCH_ACCEPT_TAC squc_lemma4; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[squc_union_lemma1;squc_union_lemma2;squc_union_lemma3]; + REWRITE_TAC[UNION_ACI]; + ]);; + (* }}} *) + +let squ_closure_h = prove_by_refinement( + `!p. (h_edge p) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[top2]; + IMATCH_MP_TAC closure_segment; + ASM_REWRITE_TAC[squ_euclid]; + TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; + IMATCH_MP_TAC point_onto; + ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid]; + DISCH_TAC; + CHO 1; + REWR 0; + KILL 1; + TYPE_THEN `point (FST q, SND q + &1)` EXISTS_TAC; + REWRITE_TAC[point_scale;point_add;]; + UND 0; + TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); + PURE_REWRITE_TAC[point_add;point_scale]; + REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;]; + DISCH_ALL_TAC; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + UND 0; + REWRITE_TAC[int_suc]; + ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + UND 1; + UND 2; + REDUCE_TAC ; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let squ_closure_up_h = prove_by_refinement( + `!p. (h_edge (up p)) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;up ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[top2]; + IMATCH_MP_TAC closure_segment; + ASM_REWRITE_TAC[squ_euclid]; + TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; + IMATCH_MP_TAC point_onto; + ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid]; + DISCH_TAC; + CHO 1; + REWR 0; + KILL 1; + TYPE_THEN `point (FST q , SND q - &1)` EXISTS_TAC; + REWRITE_TAC[point_scale;point_add;]; + UND 0; + TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); + PURE_REWRITE_TAC[point_add;point_scale]; + REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;]; + DISCH_ALL_TAC; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + UND 0; + REWRITE_TAC[int_suc]; + ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + UND 1; + UND 2; + REDUCE_TAC ; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let squ_closure_down_h = prove_by_refinement( + `!p. (h_edge p SUBSET (closure top2 (squ (down p))))`, + (* {{{ proof *) + + [ + GEN_TAC; + ASSUME_TAC squ_closure_up_h ; + TSPEC `down p` 0; + USE 0 (REWRITE_RULE [right_left]); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let squ_closure_v = prove_by_refinement( + `!p. (v_edge p) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[top2]; + IMATCH_MP_TAC closure_segment; + ASM_REWRITE_TAC[squ_euclid]; + TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; + IMATCH_MP_TAC point_onto; + ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid]; + DISCH_TAC; + CHO 1; + REWR 0; + KILL 1; + TYPE_THEN `point (FST q + &1, SND q )` EXISTS_TAC; + REWRITE_TAC[point_scale;point_add;]; + UND 0; + TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); + PURE_REWRITE_TAC[point_add;point_scale]; + REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;]; + DISCH_ALL_TAC; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + UND 0; + REWRITE_TAC[int_suc]; + ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + UND 1; + UND 2; + REDUCE_TAC ; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let squ_closure_right_v = prove_by_refinement( + `!p. (v_edge (right p)) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;right ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[top2]; + IMATCH_MP_TAC closure_segment; + ASM_REWRITE_TAC[squ_euclid]; + TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ; + IMATCH_MP_TAC point_onto; + ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid]; + DISCH_TAC; + CHO 1; + REWR 0; + KILL 1; + TYPE_THEN `point (FST q - &1 , SND q )` EXISTS_TAC; + REWRITE_TAC[point_scale;point_add;]; + UND 0; + TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]); + PURE_REWRITE_TAC[point_add;point_scale]; + REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;]; + DISCH_ALL_TAC; + USE 0 (CONV_RULE (dropq_conv "u")); + USE 0 (CONV_RULE (dropq_conv "v")); + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + UND 0; + REWRITE_TAC[int_suc]; + ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + UND 1; + UND 2; + REDUCE_TAC ; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let squ_closure_left_v = prove_by_refinement( + `!p. (v_edge p SUBSET (closure top2 (squ (left p))))`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC squ_closure_right_v; + TSPEC `left p` 0; + USE 0 (REWRITE_RULE[right_left]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let squ_closure_hc = prove_by_refinement( + `!p. (hc_edge p) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[GSYM h_edge_closure]; + IMATCH_MP_TAC closure_subset; + ASSUME_TAC top2_top; + ASM_REWRITE_TAC[squ_closure_h]; + IMATCH_MP_TAC closure_closed; + ASM_REWRITE_TAC[top2_unions;squ_euclid]; + ]);; + + (* }}} *) + +let squ_closure_up_hc = prove_by_refinement( + `!p. (hc_edge (up p)) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[GSYM h_edge_closure]; + IMATCH_MP_TAC closure_subset; + ASSUME_TAC top2_top; + ASM_REWRITE_TAC[squ_closure_up_h]; + IMATCH_MP_TAC closure_closed; + ASM_REWRITE_TAC[top2_unions;squ_euclid]; + ]);; + (* }}} *) + +let squ_closure_vc = prove_by_refinement( + `!p. (vc_edge p) SUBSET (closure top2 (squ p))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[GSYM v_edge_closure]; + IMATCH_MP_TAC closure_subset; + ASSUME_TAC top2_top; + ASM_REWRITE_TAC[squ_closure_v]; + IMATCH_MP_TAC closure_closed; + ASM_REWRITE_TAC[top2_unions;squ_euclid]; + ]);; + (* }}} *) + +let squ_closure = prove_by_refinement( + `!p. (closure top2 (squ p)) = (squc p)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASSUME_TAC top2_top; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC closure_subset; + ASM_REWRITE_TAC[squc_closed]; + REWRITE_TAC[squc_union]; + REWRITE_TAC[SUBSET;UNION]; + ASM_MESON_TAC[]; + REWRITE_TAC[squc_union]; + REWRITE_TAC[union_subset]; + ASSUME_TAC squ_closure_hc; + TSPEC `p` 1; + ASSUME_TAC squ_closure_up_hc; + TSPEC `p` 2; + USE 1 (REWRITE_RULE[hc_edge;plus_e12;union_subset]); + USE 2 (REWRITE_RULE[hc_edge;plus_e12;up;union_subset]); + ASM_REWRITE_TAC [up;right;squ_closure_v;REWRITE_RULE[right ] squ_closure_right_v ]; + ASM_SIMP_TAC[subset_closure]; + ]);; + + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* adj_edge *) +(* ------------------------------------------------------------------ *) + + +let adj_edge = jordan_def `adj_edge x y <=> (~(x = y)) /\ + (?e. (edge e) /\ + (e SUBSET (closure top2 x)) /\ (e SUBSET (closure top2 y)))`;; + +let adj_edge_sym = prove_by_refinement( + `!x y. (adj_edge x y = adj_edge y x)`, + (* {{{ proof *) + [ + REWRITE_TAC[adj_edge]; + MESON_TAC[]; + ]);; + (* }}} *) + +let adj_edge_left = prove_by_refinement( + `!m. (adj_edge (squ m) (squ (left m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[adj_edge]; + REWRITE_TAC[squ_closure;squ_inj;]; + CONJ_TAC; + REWRITE_TAC[left ;PAIR_SPLIT;]; + INT_ARITH_TAC; + TYPE_THEN `v_edge m` EXISTS_TAC; + REWRITE_TAC[edge;v_edge_inj;]; + CONV_TAC (dropq_conv "m'"); + REWRITE_TAC[squc_union; SUBSET;UNION ;]; + REWRITE_TAC[right_left]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let adj_edge_right = prove_by_refinement( + `!m. (adj_edge (squ m) (squ (right m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[adj_edge]; + REWRITE_TAC[squ_closure;squ_inj;]; + CONJ_TAC; + REWRITE_TAC[right ;PAIR_SPLIT;]; + INT_ARITH_TAC; + TYPE_THEN `v_edge (right m)` EXISTS_TAC; + REWRITE_TAC[edge;v_edge_inj;]; + CONV_TAC (dropq_conv "m'"); + REWRITE_TAC[squc_union; SUBSET;UNION ;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let adj_edge_down = prove_by_refinement( + `!m. (adj_edge (squ m) (squ (down m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[adj_edge]; + REWRITE_TAC[squ_closure;squ_inj;]; + CONJ_TAC; + REWRITE_TAC[down ;PAIR_SPLIT;]; + INT_ARITH_TAC; + TYPE_THEN `h_edge m` EXISTS_TAC; + REWRITE_TAC[edge;h_edge_inj;]; + CONV_TAC (dropq_conv "m'"); + REWRITE_TAC[squc_union; SUBSET;UNION ;]; + REWRITE_TAC[right_left]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let adj_edge_right = prove_by_refinement( + `!m. (adj_edge (squ m) (squ (up m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[adj_edge]; + REWRITE_TAC[squ_closure;squ_inj;]; + CONJ_TAC; + REWRITE_TAC[up ;PAIR_SPLIT;]; + INT_ARITH_TAC; + TYPE_THEN `h_edge (up m)` EXISTS_TAC; + REWRITE_TAC[edge;h_edge_inj;]; + CONV_TAC (dropq_conv "m'"); + REWRITE_TAC[squc_union; SUBSET;UNION ;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* components *) +(* ------------------------------------------------------------------ *) + +let rectangle_euclid = prove_by_refinement( + `!p q. (rectangle p q SUBSET (euclid 2))`, + (* {{{ proof *) + [ + REWRITE_TAC[rectangle;SUBSET ;]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + ASM_REWRITE_TAC[euclid_point]; + ]);; + (* }}} *) + +let component_unions = prove_by_refinement( + `!U (x:A). (component U x SUBSET (UNIONS U))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET; component_DEF; connected ;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_h_rect = prove_by_refinement( + `!G m x. (segment G /\ + (h_edge m SUBSET component (ctop G) x)) ==> + (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) + SUBSET component (ctop G) x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; + CONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; + REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;]; + DISCH_ALL_TAC; + AND 2; + TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC; + USE 0(MATCH_MP curve_cell_squ_inter); + COPY 0; + TSPEC `m` 0; + TSPEC `down m` 4; + UND 4; + UND 0; + REWRITE_TAC [EQ_EMPTY; INTER]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 3; + TYPE_THEN `h_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `component (ctop G) x` EXISTS_TAC; + ASM_REWRITE_TAC[component_unions]; + REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; h_edge_euclid; INTER;]; + ASM_MESON_TAC[]; + REWRITE_TAC[rectangle_h; EMPTY_EXISTS; UNION ; INTER;]; + USE 1 (REWRITE_RULE[SUBSET]); + TYPE_THEN `~(h_edge m = EMPTY)` SUBGOAL_TAC ; + IMATCH_MP_TAC cell_nonempty; + REWRITE_TAC[cell_rules]; + REWRITE_TAC[EMPTY_EXISTS]; + DISCH_TAC; + CHO 2; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_v_rect = prove_by_refinement( + `!G m x. (segment G /\ + (v_edge m SUBSET component (ctop G) x)) ==> + (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1) + SUBSET component (ctop G) x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; + CONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; + REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;]; + DISCH_ALL_TAC; + AND 2; + TYPE_THEN `~(squ (left m) x') /\ ~(squ m x')` SUBGOAL_TAC; + USE 0(MATCH_MP curve_cell_squ_inter); + COPY 0; + TSPEC `m` 0; + TSPEC `left m` 4; + UND 4; + UND 0; + REWRITE_TAC [EQ_EMPTY; INTER]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 3; + TYPE_THEN `v_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `component (ctop G) x` EXISTS_TAC; + ASM_REWRITE_TAC[component_unions]; + REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; v_edge_euclid; INTER;]; + ASM_MESON_TAC[]; + REWRITE_TAC[rectangle_v; EMPTY_EXISTS; UNION ; INTER;]; + USE 1 (REWRITE_RULE[SUBSET]); + TYPE_THEN `~(v_edge m = EMPTY)` SUBGOAL_TAC ; + IMATCH_MP_TAC cell_nonempty; + REWRITE_TAC[cell_rules]; + REWRITE_TAC[EMPTY_EXISTS]; + DISCH_TAC; + CHO 2; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let long_v_convex = prove_by_refinement( + `!p. (convex (long_v p))`, + (* {{{ proof *) + [ + REWRITE_TAC[long_v_inter]; + GEN_TAC; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[line2D_F_convex]; + IMATCH_MP_TAC convex_inter; + REWRITE_TAC[open_half_plane2D_LTS_convex;open_half_plane2D_SLT_convex]; + ]);; + (* }}} *) + +let long_v_euclid = prove_by_refinement( + `!p. (long_v p SUBSET (euclid 2))`, + (* {{{ proof *) + [ + REWRITE_TAC[long_v_union;union_subset;v_edge_euclid;single_subset;pointI;euclid_point]; + ]);; + (* }}} *) + +let comp_pointI_long = prove_by_refinement( + `!G m x. (segment G /\ component (ctop G) x (pointI m)) ==> + (long_v m SUBSET component (ctop G) x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[long_v_convex;ctop_unions;DIFF_SUBSET;long_v_euclid]; + CONJ_TAC; + REWRITE_TAC[long_v_union;EQ_EMPTY;UNION;INTER]; + GEN_TAC; + TYPE_THEN `UNIONS (ctop G) (pointI m)` SUBGOAL_TAC; + ASSUME_TAC (ISPEC `(ctop G)` component_unions); + ASM_MESON_TAC[ISUBSET]; + REWRITE_TAC[ctop_unions;DIFF ;]; + DISCH_ALL_TAC; + AND 2; + TYPE_THEN `~(curve_cell G {(pointI m)})` SUBGOAL_TAC; + USE 4(REWRITE_RULE[UNIONS]); + LEFT 4 "u"; + TSPEC `{(pointI m)}` 4; + USE 4(REWRITE_RULE [INR IN_SING;]); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[curve_cell_not_point;]; + TYPE_THEN `FINITE G` SUBGOAL_TAC; + ASM_SIMP_TAC[segment_finite]; + ASM_SIMP_TAC[num_closure0]; + DISCH_TAC; + UND 5; + REP_CASES_TAC; (* cases *) + TYPE_THEN `~(v_edge (down m) INTER UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + ASM_MESON_TAC[]; + ASM_SIMP_TAC[curve_cell_v_inter]; + DISCH_ALL_TAC; + TSPEC `v_edge (down m)` 5; + UND 5; + ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;]; + (* next case *) + USE 7 (REWRITE_RULE[INR IN_SING]); + ASM_MESON_TAC[]; + TYPE_THEN `~(v_edge (m) INTER UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + ASM_MESON_TAC[]; + ASM_SIMP_TAC[curve_cell_v_inter]; + DISCH_ALL_TAC; + TSPEC `v_edge (m)` 5; + UND 5; + ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;]; + (* LAST *) + REWRITE_TAC[long_v_union;EMPTY_EXISTS;]; + TYPE_THEN `(pointI m)` EXISTS_TAC; + ASM_REWRITE_TAC[INTER;UNION;INR IN_SING;]; + ]);; + (* }}} *) + +let comp_h_squ = prove_by_refinement( + `!G x m. (segment G /\ (h_edge m SUBSET (component (ctop G) x)) ==> + (squ m SUBSET (component (ctop G ) x)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC; + IMATCH_MP_TAC comp_h_rect; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[rectangle_h]; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + ]);; + (* }}} *) + +let comp_v_squ = prove_by_refinement( + `!G x m. (segment G /\ (v_edge m SUBSET (component (ctop G) x)) ==> + (squ m SUBSET (component (ctop G ) x)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(rectangle (FST m -: &:1 , SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC; + IMATCH_MP_TAC comp_v_rect; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[rectangle_v]; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + ]);; + (* }}} *) + +let comp_p_squ = prove_by_refinement( + `!G x m. (segment G /\ (component (ctop G) x (pointI m))) ==> + (squ m SUBSET (component (ctop G ) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `long_v m SUBSET component (ctop G) x` SUBGOAL_TAC; + IMATCH_MP_TAC comp_pointI_long; + ASM_REWRITE_TAC[]; + REWRITE_TAC[long_v_union]; + REWRITE_TAC[union_subset]; + DISCH_ALL_TAC; + IMATCH_MP_TAC comp_v_squ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let comp_squ = prove_by_refinement( + `!G x. (segment G /\ (~(component (ctop G) x = EMPTY)) ==> + (?m. (squ m SUBSET (component (ctop G ) x))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + COPY 0; + USE 0 (MATCH_MP unions_cell_of); + TSPEC `x` 0; + USE 0 (SYM); + USE 1 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 1; + UND 0; + DISCH_THEN (fun t-> USE 1 (ONCE_REWRITE_RULE[t])); + USE 0 (REWRITE_RULE[cell_of;UNIONS]); + CHO 0; + UND 0; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[cell]); + CHO 0; + UND 0; + REP_CASES_TAC; + REWR 1; + USE 1 (REWRITE_RULE[single_subset]); + ASM_MESON_TAC[comp_p_squ]; + ASM_MESON_TAC[comp_h_squ]; + ASM_MESON_TAC[comp_v_squ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_squ_left_rect_v = prove_by_refinement( + `!G m x. (segment G /\ ~(G (v_edge ( m))) /\ + (squ m SUBSET component (ctop G) x) ==> + (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET + component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + ASM_SIMP_TAC[GSYM curve_cell_v]; + DISCH_TAC; + (* *) + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; + CONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; + REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;]; + DISCH_ALL_TAC; + AND 3; + TYPE_THEN `~(squ (left m) x') /\ ~(squ m x')` SUBGOAL_TAC; + USE 0(MATCH_MP curve_cell_squ_inter); + COPY 0; + TSPEC `m` 0; + TSPEC `left m` 5; + UND 5; + UND 0; + REWRITE_TAC [EQ_EMPTY; INTER]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 4; + USE 3 (REWRITE_RULE[UNIONS;]); + CHO 3; + TYPE_THEN `cell u` SUBGOAL_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + ASM_MESON_TAC[ISUBSET; curve_cell_cell]; + DISCH_TAC; + TYPE_THEN `u = v_edge m ` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[rectangle_v;EMPTY_EXISTS;]; + TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; + USE 2(REWRITE_RULE[ISUBSET]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_squ_left_rect = prove_by_refinement( + `!G m x. (segment G /\ + (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))) /\ + (squ m SUBSET component (ctop G) x)) ==> + (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1) + SUBSET component (ctop G) x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + LEFT 1 "p"; + TSPEC `m` 1; + LEFT 1 "e"; + TSPEC `v_edge m` 1; + REWR 1; + USE 1(REWRITE_RULE[squ_closure_v]); + IMATCH_MP_TAC comp_squ_left_rect_v; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let comp_squ_right_rect_v = prove_by_refinement( + `!G m x. (segment G /\ ~(G (v_edge (right m))) /\ + (squ m SUBSET component (ctop G) x) ==> + (rectangle (FST m,SND m ) (FST m +: &:2,SND m +: &:1) SUBSET + component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + ASM_SIMP_TAC[GSYM curve_cell_v]; + DISCH_TAC; + (* *) + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; + TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right m) -: &:1, SND (right m)) (FST (right m) +: &:1, SND (right m) +: &:1)` SUBGOAL_TAC; + REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; + DISCH_THEN_REWRITE; + CONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; + REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;]; + DISCH_ALL_TAC; + AND 3; + USE 4 (REWRITE_RULE[right_left]); + TYPE_THEN `~(squ m x') /\ ~(squ (right m) x')` SUBGOAL_TAC; + USE 0(MATCH_MP curve_cell_squ_inter); + COPY 0; + TSPEC `m` 0; + TSPEC `right m` 5; + UND 5; + UND 0; + REWRITE_TAC [EQ_EMPTY; INTER]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 4; + USE 3 (REWRITE_RULE[UNIONS;]); + CHO 3; + TYPE_THEN `cell u` SUBGOAL_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + ASM_MESON_TAC[ISUBSET; curve_cell_cell]; + DISCH_TAC; + TYPE_THEN `u = v_edge (right m) ` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[rectangle_v;EMPTY_EXISTS;]; + REWRITE_TAC[right_left]; + TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; + USE 2(REWRITE_RULE[ISUBSET]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_squ_right_rect = prove_by_refinement( + `!G m x. (segment G /\ + (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))) /\ + (squ m SUBSET component (ctop G) x)) ==> + (rectangle (FST m , SND m ) (FST m +: &:2,SND m +: &:1) + SUBSET component (ctop G) x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + LEFT 1 "p"; + TSPEC `m` 1; + LEFT 1 "e"; + TSPEC `v_edge (right m)` 1; + REWR 1; + USE 1(REWRITE_RULE[squ_closure_right_v]); + IMATCH_MP_TAC comp_squ_right_rect_v; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let comp_squ_down_rect_h = prove_by_refinement( + `!G m x. (segment G /\ ~(G (h_edge m)) /\ + (squ m SUBSET component (ctop G) x) ==> + (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET + component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + ASM_SIMP_TAC[GSYM curve_cell_h]; + DISCH_TAC; + (* *) + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; + CONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; + REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;]; + DISCH_ALL_TAC; + AND 3; + TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC; + USE 0(MATCH_MP curve_cell_squ_inter); + COPY 0; + TSPEC `m` 0; + TSPEC `down m` 5; + UND 5; + UND 0; + REWRITE_TAC [EQ_EMPTY; INTER]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 4; + USE 3 (REWRITE_RULE[UNIONS;]); + CHO 3; + TYPE_THEN `cell u` SUBGOAL_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + ASM_MESON_TAC[ISUBSET; curve_cell_cell]; + DISCH_TAC; + TYPE_THEN `u = h_edge m ` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[rectangle_h;EMPTY_EXISTS;]; + TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; + USE 2(REWRITE_RULE[ISUBSET]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_squ_down_rect = prove_by_refinement( + `!G m x. (segment G /\ + (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))) /\ + (squ m SUBSET component (ctop G) x)) ==> + (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) + SUBSET component (ctop G) x)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + LEFT 1 "p"; + TSPEC `m` 1; + LEFT 1 "e"; + TSPEC `h_edge m` 1; + REWR 1; + USE 1(REWRITE_RULE[squ_closure_h]); + ASM_MESON_TAC[comp_squ_down_rect_h]; + ]);; + + (* }}} *) + +let comp_squ_up_rect_h = prove_by_refinement( + `!G m x. (segment G /\ ~(G (h_edge (up m))) /\ + (squ m SUBSET component (ctop G) x) ==> + (rectangle (FST m,SND m ) (FST m +: &:1,SND m +: &:2) SUBSET + component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UND 1; + ASM_SIMP_TAC[GSYM curve_cell_h]; + DISCH_TAC; + (* *) + IMATCH_MP_TAC convex_component; + ASM_REWRITE_TAC[rectangle_convex; ctop_unions;]; + TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up m) , SND (up m) -: &:1) (FST (up m) +: &:1, SND (up m) +: &:1)` SUBGOAL_TAC; + REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; + DISCH_THEN_REWRITE; + CONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;rectangle_euclid]; + REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;]; + DISCH_ALL_TAC; + AND 3; + USE 4 (REWRITE_RULE[right_left]); + TYPE_THEN `~(squ m x') /\ ~(squ (up m) x')` SUBGOAL_TAC; + USE 0(MATCH_MP curve_cell_squ_inter); + COPY 0; + TSPEC `m` 0; + TSPEC `up m` 5; + UND 5; + UND 0; + REWRITE_TAC [EQ_EMPTY; INTER]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 4; + USE 3 (REWRITE_RULE[UNIONS;]); + CHO 3; + TYPE_THEN `cell u` SUBGOAL_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + ASM_MESON_TAC[ISUBSET; curve_cell_cell]; + DISCH_TAC; + TYPE_THEN `u = h_edge (up m) ` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[rectangle_h;EMPTY_EXISTS;]; + REWRITE_TAC[right_left]; + TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;]; + USE 2(REWRITE_RULE[ISUBSET]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_squ_up_rect = prove_by_refinement( + `!G m x. (segment G /\ + (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))) /\ + (squ m SUBSET component (ctop G) x)) ==> + (rectangle (FST m , SND m ) (FST m +: &:1,SND m +: &:2) + SUBSET component (ctop G) x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + LEFT 1 "p"; + TSPEC `m` 1; + LEFT 1 "e"; + TSPEC `h_edge (up m)` 1; + REWR 1; + USE 1(REWRITE_RULE[squ_closure_up_h]); + IMATCH_MP_TAC comp_squ_up_rect_h; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let comp_squ_right_left = prove_by_refinement( + `!G x m. (segment G /\ (squ m SUBSET (component (ctop G) x)) /\ + (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x)))))) ==> + (squ (left m) SUBSET (component (ctop G) x)) /\ + (squ (right m) SUBSET (component (ctop G) x)) /\ + (squ (up m) SUBSET (component (ctop G) x)) /\ + (squ (down m) SUBSET (component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + JOIN 2 1; + JOIN 0 1; + WITH 0 (MATCH_MP comp_squ_up_rect); + WITH 0 (MATCH_MP comp_squ_down_rect); + WITH 0 (MATCH_MP comp_squ_left_rect); + WITH 0 (MATCH_MP comp_squ_right_rect); + TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up m) , SND (up m) -: &:1) (FST (up m) +: &:1, SND (up m) +: &:1)` SUBGOAL_TAC; + REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; + DISCH_THEN (fun t-> USE 1 (REWRITE_RULE[t])); + TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right m) -: &:1, SND (right m)) (FST (right m) +: &:1, SND (right m) +: &:1)` SUBGOAL_TAC; + REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ]; + DISCH_THEN (fun t-> USE 4 (REWRITE_RULE[t])); + RULE_ASSUM_TAC (REWRITE_RULE[rectangle_h;rectangle_v;union_subset;right_left ]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* move *) +let suc_sum = prove_by_refinement( + `!j a b. (SUC j = a+ b) ==> (?k. (SUC k = a) \/ (SUC k = b))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + LEFT 1 "k"; + USE 1(REWRITE_RULE[DE_MORGAN_THM]); + TYPE_THEN `a = 0 ` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + ASM_MESON_TAC[num_CASES]; + TYPE_THEN `b = 0` SUBGOAL_TAC; + ASM_MESON_TAC[num_CASES]; + UND 0; + ARITH_TAC; + ]);; + (* }}} *) + +let squ_induct = prove_by_refinement( + `!j m n. ?p. + ((SUC j) = (num_abs_of_int (FST m -: FST n) + + num_abs_of_int (SND m -: SND n))) ==> + ((j = (num_abs_of_int (FST p -: FST n) + + num_abs_of_int (SND p -: SND n))) /\ + ((p = left m) \/ (p = right m) \/ (p = up m) \/ (p = down m))) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + RIGHT_TAC "p"; + DISCH_TAC; + WITH 0 (MATCH_MP suc_sum); + CHO 1; + UND 1; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `~(num_abs_of_int (FST m -: FST n) = 0)` SUBGOAL_TAC; + UND 1; + ARITH_TAC; + REWRITE_TAC[num_abs_of_int0]; + DISCH_TAC; + TYPE_THEN `FST m <: FST n \/ FST n <: FST m` SUBGOAL_TAC; + UND 2; + INT_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `right m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[right ]; + ONCE_REWRITE_TAC[GSYM SUC_INJ]; + REWRITE_TAC[GSYM ADD]; + TYPE_THEN `(FST m +: &:1) -: FST n <=: &:0` SUBGOAL_TAC; + UND 3; + INT_ARITH_TAC; + ASM_SIMP_TAC[num_abs_of_int_pre]; + TYPE_THEN `(FST m +: &:1) -: FST n -: &:1 = FST m -: FST n` SUBGOAL_TAC; + INT_ARITH_TAC; + DISCH_THEN_REWRITE; + (* next *) + TYPE_THEN `left m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[left ]; + ONCE_REWRITE_TAC[GSYM SUC_INJ]; + REWRITE_TAC[GSYM ADD]; + TYPE_THEN `&:0 <=: (FST m -: &:1) -: FST n ` SUBGOAL_TAC; + UND 3; + INT_ARITH_TAC; + ASM_SIMP_TAC[num_abs_of_int_suc]; + TYPE_THEN `(FST m -: &:1 -: FST n +: &:1) = FST m -: FST n` SUBGOAL_TAC; + INT_ARITH_TAC; + DISCH_THEN_REWRITE; + (* next *) + TYPE_THEN `~(num_abs_of_int (SND m -: SND n) = 0)` SUBGOAL_TAC; + UND 1; + ARITH_TAC; + REWRITE_TAC[num_abs_of_int0]; + DISCH_TAC; + TYPE_THEN `SND m <: SND n \/ SND n <: SND m` SUBGOAL_TAC; + UND 2; + INT_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + (* next *) + TYPE_THEN `up m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[up ]; + ONCE_REWRITE_TAC[GSYM SUC_INJ]; + REWRITE_TAC[GSYM ADD_SUC]; + TYPE_THEN `(SND m +: &:1) -: SND n <=: &:0` SUBGOAL_TAC; + UND 3; + INT_ARITH_TAC; + ASM_SIMP_TAC[num_abs_of_int_pre]; + TYPE_THEN `((SND m +: &:1) -: SND n -: &:1) = SND m -: SND n` SUBGOAL_TAC; + INT_ARITH_TAC; + DISCH_THEN_REWRITE; + (* final *) + TYPE_THEN `down m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[down ]; + ONCE_REWRITE_TAC[GSYM SUC_INJ]; + REWRITE_TAC[GSYM ADD_SUC]; + TYPE_THEN `&:0 <=: (SND m -: &:1) -: SND n ` SUBGOAL_TAC; + UND 3; + INT_ARITH_TAC; + ASM_SIMP_TAC[num_abs_of_int_suc]; + TYPE_THEN `(SND m -: &:1 -: SND n +: &:1) = SND m -: SND n` SUBGOAL_TAC; + INT_ARITH_TAC; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let comp_squ_fill = prove_by_refinement( + `!G x m. (segment G /\ (squ m SUBSET (component (ctop G ) x)) /\ + (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x)))))) ==> + (!n. (squ n SUBSET (component (ctop G) x))) + `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + GEN_TAC; + TYPE_THEN `(!j n. (j = (num_abs_of_int (FST n -: FST m) + num_abs_of_int (SND n -: SND m))) ==> (squ n SUBSET component (ctop G) x)) ==> (squ n SUBSET component (ctop G) x)` SUBGOAL_TAC; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + INDUCT_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + REWRITE_TAC[ADD_EQ_0;num_abs_of_int0]; + GEN_TAC; + DISCH_TAC; + TYPE_THEN `n = m` SUBGOAL_TAC; + UND 3; + REWRITE_TAC[PAIR_SPLIT]; + INT_ARITH_TAC; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + USE 4 (MATCH_MP (CONV_RULE (quant_right_CONV "p") squ_induct)); + CHO 4; + TSPEC `p` 3; + REWR 3; + AND 4; + TYPE_THEN `(n = left p) \/ (n = right p) \/ (n = up p) \/ (n = down p)` SUBGOAL_TAC; + UND 4; + REP_CASES_TAC THEN (ASM_REWRITE_TAC[right_left]); + KILL 4; + KILL 5; + KILL 1; + JOIN 3 2; + JOIN 0 1; + USE 0 (MATCH_MP comp_squ_right_left); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let comp_squ_adj = prove_by_refinement( + `!G x m. (segment G /\ (squ m SUBSET (component (ctop G ) x))) ==> + (?p e. (G e /\ e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `(!n. (squ n SUBSET (component (ctop G) x)))` SUBGOAL_TAC; + ASM_MESON_TAC[comp_squ_fill]; + DISCH_TAC; + TYPE_THEN `?e. (G e /\ (edge e))` SUBGOAL_TAC; + USE 0 (REWRITE_RULE [segment;EMPTY_EXISTS;SUBSET;]); + ASM_MESON_TAC[]; + DISCH_TAC; + UND 2; + REWRITE_TAC[]; + LEFT_TAC "e"; + CHO 4; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + AND 2; + USE 2(REWRITE_RULE[edge]); + CHO 2; + UND 2; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `m'` EXISTS_TAC; + ASM_REWRITE_TAC[squ_closure_v;squ_closure_h]; + ASM_MESON_TAC[squ_closure_v;squ_closure_h]; + ]);; + + (* }}} *) + +(* ------------------------------------------------------------------ *) + + +let along_seg = jordan_def `along_seg G e x <=> G e /\ + (?p. (e SUBSET closure top2 (squ p) /\ + squ p SUBSET (component (ctop G) x) ))`;; + +let along_lemma1 = prove_by_refinement( + `!G m x. (segment G /\ (squ m SUBSET component (ctop G) x) /\ + (G (v_edge m)) /\ (G (h_edge m))) ==> + (?p. (h_edge m) SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `m` EXISTS_TAC; + ASM_MESON_TAC[squ_closure_h]; + ]);; + + (* }}} *) + +let midpoint_exclusion = prove_by_refinement( + `!G m e e' e''. (segment G /\ G e /\ G e' /\ G e'' /\ (~(e = e')) /\ + (closure top2 e (pointI m)) /\ (closure top2 e' (pointI m)) /\ + (closure top2 e'' (pointI m)) ==> ((e'' = e) \/ (e'' = e'))) + `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[segment;INSERT; ]); + UND 0; + DISCH_ALL_TAC; + TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC; + TSPEC `m` 10; + UND 10; + REP_CASES_TAC; + ASM_REWRITE_TAC[]; + UND 10; + USE 0 (MATCH_MP num_closure1); + ASM_REWRITE_TAC[]; + DISCH_TAC; + CHO 10; + COPY 10; + TSPEC `e` 12; + TSPEC `e'` 10; + ASM_MESON_TAC[]; + USE 0 (MATCH_MP num_closure0); + TSPEC `pointI m` 0; + REWR 0; + TSPEC `e` 0; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 0 (MATCH_MP num_closure_size); + TSPEC `pointI m` 0; + REWR 0; + TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ; + TYPE_THEN `X e /\ X e' /\ X e''` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + UND 0; + UND 4; + MESON_TAC[two_exclusion]; + ]);; + (* }}} *) + +(* indexed to here *) +let along_lemma2 = prove_by_refinement( + `!G m. (segment G /\ G (v_edge m) /\ G (v_edge (down m)) ==> + ~(G (h_edge m)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = v_edge (down m))` SUBGOAL_TAC; + IMATCH_MP_TAC midpoint_exclusion; + TYPE_THEN `G` EXISTS_TAC; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[v_edge_inj;down;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;]; + INT_ARITH_TAC ; + REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2]; + ]);; + (* }}} *) + +let along_lemma3 = prove_by_refinement( + `!G m. (segment G /\ G (v_edge m) /\ G(h_edge (left m)) ==> + ~(G (h_edge m)) /\ ~(G (v_edge (down m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + USE 3(REWRITE_RULE[]); + TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = h_edge (left m))` SUBGOAL_TAC; + IMATCH_MP_TAC midpoint_exclusion; + TYPE_THEN `G` EXISTS_TAC; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[v_edge_inj;left;v_edge_cpoint;GSYM hv_edgeV2;h_edge_cpoint;PAIR_SPLIT;]; + INT_ARITH_TAC ; + REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2;left ;h_edge_inj;PAIR_SPLIT;]; + INT_ARITH_TAC; + PROOF_BY_CONTR_TAC; + USE 3(REWRITE_RULE[]); + TYPE_THEN `(h_edge (left m) = v_edge m) \/ (h_edge (left m) = v_edge (down m))` SUBGOAL_TAC; + IMATCH_MP_TAC midpoint_exclusion; + TYPE_THEN `G` EXISTS_TAC; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[v_edge_inj;down;left ;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;]; + INT_ARITH_TAC ; + REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2]; + ]);; + (* }}} *) + +let along_lemma4 = prove_by_refinement( + `!G m x. (segment G /\ (squ m SUBSET component (ctop G) x) /\ + (G (v_edge m)) /\ (G (v_edge (down m)))) ==> + (?p. (v_edge (down m)) SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `down m` EXISTS_TAC; + CONJ_TAC; + ASM_MESON_TAC[squ_closure_v]; + TYPE_THEN `~(G (h_edge m))` SUBGOAL_TAC; + ASM_MESON_TAC[along_lemma2]; + DISCH_TAC; + TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC ; + IMATCH_MP_TAC comp_squ_down_rect_h; + ASM_REWRITE_TAC[]; + REWRITE_TAC[rectangle_h; union_subset]; + MESON_TAC []; + ]);; + (* }}} *) + +let along_lemma5 = prove_by_refinement( + `!G m x. (segment G /\ (squ m SUBSET component (ctop G) x) /\ + (G (v_edge m)) /\ (G (h_edge (left m)))) ==> + (?p. (h_edge (left m)) SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `left (down m)` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[GSYM right_left]; + ASM_MESON_TAC[squ_closure_down_h]; + TYPE_THEN ` ~(G (h_edge m)) /\ ~(G (v_edge (down m)))` SUBGOAL_TAC; + IMATCH_MP_TAC along_lemma3; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC ; + IMATCH_MP_TAC comp_squ_down_rect_h; + ASM_REWRITE_TAC[]; + REWRITE_TAC[rectangle_h; union_subset]; + DISCH_ALL_TAC; + TYPE_THEN `(rectangle (FST (down m) -: &:1,SND (down m)) (FST (down m) +: &:1,SND (down m) +: &:1) SUBSET component (ctop G) x)` SUBGOAL_TAC; + IMATCH_MP_TAC comp_squ_left_rect_v; + ASM_REWRITE_TAC[]; + REWRITE_TAC[rectangle_v;union_subset;]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let along_lemma6 = prove_by_refinement( + `!G m x e. (segment G /\ (squ m SUBSET component (ctop G) x) /\ + (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==> + (?p. e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC ; + ASM_MESON_TAC[segment]; + DISCH_TAC; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;]; + REWRITE_TAC[edge]; + DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); + REWR 4; + USE 4 (REWRITE_RULE[v_edge_cpoint]); + UND 4; + DISCH_TAC; + TYPE_THEN `(m' = m) \/ (m' = (down m))` SUBGOAL_TAC; + UND 4; + REWRITE_TAC[down;PAIR_SPLIT]; + INT_ARITH_TAC ; + KILL 4; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[squ_closure_v]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC along_lemma4; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + REWR 4; + USE 4(REWRITE_RULE[h_edge_cpoint]); + TYPE_THEN `(m' = m) \/ (m' = (left m))` SUBGOAL_TAC; + UND 4; + REWRITE_TAC[left;PAIR_SPLIT]; + INT_ARITH_TAC ; + KILL 4; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC along_lemma1; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC along_lemma5; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) + +let reflAf = jordan_def + `reflAf r (x:num->real) = point(&2 * (real_of_int r) - x 0, x 1)`;; + +let reflAi = jordan_def + `reflAi r (x:int#int) = ((&:2 *: r) -: FST x,SND x)`;; + +let reflBf = jordan_def + `reflBf r (x:num->real) = point( x 0 , &2 * (real_of_int r) - x 1)`;; + +let reflBi = jordan_def + `reflBi r (x:int#int) = (FST x, (&:2 *: r) -: SND x)`;; + +let reflCf = jordan_def + `reflCf (x:num->real) = point (x 1, x 0)`;; + +let reflCi = jordan_def + `reflCi (x:int#int) = (SND x, FST x)`;; + +let reflAf_inv = prove_by_refinement( + `!r m. (reflAf r (reflAf r (point m)) = (point m))`, + (* {{{ proof *) + + [ + REP_GEN_TAC; + REWRITE_TAC[reflAf;coord01;PAIR_SPLIT ;point_inj ;]; + REAL_ARITH_TAC ; + ]);; + + (* }}} *) + +let reflBf_inv = prove_by_refinement( + `!r m. (reflBf r (reflBf r (point m)) = (point m))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[reflBf;coord01;PAIR_SPLIT ;point_inj ;]; + REAL_ARITH_TAC ; + ]);; + (* }}} *) + +let reflCf_inv = prove_by_refinement( + `!m. (reflCf (reflCf (point m)) = (point m))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[reflCf;coord01;PAIR_SPLIT ;point_inj ;]; + ]);; + (* }}} *) + +let reflAi_inv = prove_by_refinement( + `!r x. (reflAi r (reflAi r x) = x)`, + (* {{{ proof *) + [ + REWRITE_TAC[reflAi;PAIR_SPLIT;]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let reflBi_inv = prove_by_refinement( + `!r x. (reflBi r (reflBi r x) = x)`, + (* {{{ proof *) + [ + REWRITE_TAC[reflBi;PAIR_SPLIT;]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let reflCi_inv = prove_by_refinement( + `!x. (reflCi (reflCi x) = x)`, + (* {{{ proof *) + [ + REWRITE_TAC[reflCi;PAIR_SPLIT;]; + ]);; + (* }}} *) + +let invo_BIJ = prove_by_refinement( + `!f. (!m . (f (f (point m)) = (point m))) /\ + (!x. (euclid 2 (f x))) ==> + (BIJ f (euclid 2) (euclid 2))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[BIJ;INJ;SURJ;]; + SUBCONJ_TAC; + CONJ_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2 (MATCH_MP (point_onto)); + USE 3 (MATCH_MP (point_onto)); + CHO 2; + CHO 3; + REWR 4; + TYPE_THEN `f` (USE 4 o AP_TERM ); + REWR 4; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 4(MATCH_MP point_onto); + CHO 4; + ASM_REWRITE_TAC[]; + TYPE_THEN ` f (point p)` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let reflA_BIJ = prove_by_refinement( + `!r. (BIJ (reflAf r) (euclid 2) (euclid 2))`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC invo_BIJ; + REWRITE_TAC[reflAf_inv]; + REWRITE_TAC[reflAf;euclid_point;]; + ]);; + (* }}} *) + +let reflB_BIJ = prove_by_refinement( + `!r. (BIJ (reflBf r) (euclid 2) (euclid 2))`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC invo_BIJ; + REWRITE_TAC[reflBf_inv]; + REWRITE_TAC[reflBf;euclid_point;]; + ]);; + (* }}} *) + +let reflC_BIJ = prove_by_refinement( + `(BIJ (reflCf ) (euclid 2) (euclid 2))`, + (* {{{ proof *) + [ + IMATCH_MP_TAC invo_BIJ; + REWRITE_TAC[reflCf_inv]; + REWRITE_TAC[reflCf;euclid_point;]; + ]);; + (* }}} *) + +let invo_homeo = prove_by_refinement( + `!U (f:A->A). (continuous f U U) /\ (BIJ f (UNIONS U) (UNIONS U)) /\ + (!x. (UNIONS U x ==> (f (f x ) = x))) ==> (homeomorphism f U U)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC bicont_homeomorphism; + ASM_REWRITE_TAC[]; + TYPE_THEN `!x. (UNIONS U x) ==> (INV f (UNIONS U) (UNIONS U) x = f x)` SUBGOAL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `UNIONS U (f x)` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[BIJ;SURJ]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_SIMP_TAC [(INR INVERSE_XY)]; + DISCH_ALL_TAC; + UND 0; + REWRITE_TAC[continuous]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TSPEC `v` 0; + REWR 0; + UND 0; + REWRITE_TAC[preimage]; + TYPE_THEN `{x | UNIONS U x /\ v (INV f (UNIONS U) (UNIONS U) x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + IMATCH_MP_TAC (TAUT `(C ==> (A <=> B)) ==> ( C /\ A <=> C /\ B)`); + DISCH_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + ]);; + + (* }}} *) + +let d_euclid_point = prove_by_refinement( + `!r s. (d_euclid (point r) (point s) = + sqrt ((FST r - FST s) pow 2 + ((SND r - SND s) pow 2)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `euclid 2 (point r) /\ euclid 2 (point s)` SUBGOAL_TAC; + REWRITE_TAC[euclid_point]; + DISCH_TAC ; + USE 0(MATCH_MP d_euclid_n); + ASM_REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[ARITH_RULE `2 = SUC 1`]; + REWRITE_TAC[sum_DEF]; + REDUCE_TAC; + REWRITE_TAC[ARITH_RULE `1 = SUC 0`]; + REWRITE_TAC[sum_DEF]; + REDUCE_TAC; + REWRITE_TAC[ARITH_RULE `(SUC 0 =1) /\ (SUC (SUC 0) = 2)`]; + REWRITE_TAC[coord01]; + REWRITE_TAC[POW_2]; + ]);; + (* }}} *) + +let reflA_cont = prove_by_refinement( + `!r. continuous (reflAf r) top2 top2`, + (* {{{ proof *) + [ + REWRITE_TAC[top2]; + GEN_TAC; + TYPE_THEN `(IMAGE (reflAf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_SIMP_TAC[metric_euclid]; + CONV_TAC (dropq_conv "x"); + REWRITE_TAC[reflAf;euclid_point]; + DISCH_TAC; + ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;]; + DISCH_ALL_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2(MATCH_MP point_onto); + CHO 2; + USE 3(MATCH_MP point_onto); + CHO 3; + UND 4; + ASM_REWRITE_TAC[reflAf;d_euclid_point;coord01;]; + TYPE_THEN `(&2 * real_of_int r - FST p - (&2 * real_of_int r - FST p')) = --. (FST p - FST p') ` SUBGOAL_TAC; + REAL_ARITH_TAC ; + DISCH_THEN_REWRITE; + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS]; + REWRITE_TAC[ABS_NEG]; + ]);; + (* }}} *) + +let reflB_cont = prove_by_refinement( + `!r. continuous (reflBf r) top2 top2`, + (* {{{ proof *) + [ + REWRITE_TAC[top2]; + GEN_TAC; + TYPE_THEN `(IMAGE (reflBf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_SIMP_TAC[metric_euclid]; + CONV_TAC (dropq_conv "x"); + REWRITE_TAC[reflBf;euclid_point]; + DISCH_TAC; + ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;]; + DISCH_ALL_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2(MATCH_MP point_onto); + CHO 2; + USE 3(MATCH_MP point_onto); + CHO 3; + UND 4; + ASM_REWRITE_TAC[reflBf;d_euclid_point;coord01;]; + TYPE_THEN `(&2 * real_of_int r - SND p - (&2 * real_of_int r - SND p')) = --. (SND p - SND p') ` SUBGOAL_TAC; + REAL_ARITH_TAC ; + DISCH_THEN_REWRITE; + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS]; + REWRITE_TAC[ABS_NEG]; + ]);; + (* }}} *) + +let reflC_cont = prove_by_refinement( + ` continuous (reflCf) top2 top2`, + (* {{{ proof *) + [ + REWRITE_TAC[top2]; + TYPE_THEN `(IMAGE (reflCf) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_SIMP_TAC[metric_euclid]; + CONV_TAC (dropq_conv "x"); + REWRITE_TAC[reflCf;euclid_point]; + DISCH_TAC; + ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;]; + DISCH_ALL_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2(MATCH_MP point_onto); + CHO 2; + USE 3(MATCH_MP point_onto); + CHO 3; + UND 4; + ASM_REWRITE_TAC[reflCf;d_euclid_point;coord01;]; + REWRITE_TAC[REAL_ADD_AC]; + ]);; + (* }}} *) + +let reflA_homeo = prove_by_refinement( + `!r. (homeomorphism (reflAf r) top2 top2)`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC reflA_BIJ; + ASSUME_TAC top2_unions; + IMATCH_MP_TAC invo_homeo; + REWRITE_TAC[reflA_cont]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2(MATCH_MP point_onto); + CHO 2; + ASM_REWRITE_TAC[reflAf_inv]; + ]);; + (* }}} *) + +let reflB_homeo = prove_by_refinement( + `!r. (homeomorphism (reflBf r) top2 top2)`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC reflB_BIJ; + ASSUME_TAC top2_unions; + IMATCH_MP_TAC invo_homeo; + REWRITE_TAC[reflB_cont]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2(MATCH_MP point_onto); + CHO 2; + ASM_REWRITE_TAC[reflBf_inv]; + ]);; + (* }}} *) + +let reflC_homeo = prove_by_refinement( + ` (homeomorphism (reflCf ) top2 top2)`, + (* {{{ proof *) + [ + ASSUME_TAC reflC_BIJ; + ASSUME_TAC top2_unions; + IMATCH_MP_TAC invo_homeo; + REWRITE_TAC[reflC_cont]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 2(MATCH_MP point_onto); + CHO 2; + ASM_REWRITE_TAC[reflCf_inv]; + ]);; + (* }}} *) + +let IMAGE2 = new_definition + `IMAGE2 (f:A->B) U = IMAGE (IMAGE (f:A->B)) U`;; + +let reflA_h_edge = prove_by_refinement( + `!m r. IMAGE (reflAf r) (h_edge m) = h_edge (left (reflAi r m))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[h_edge]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "v"); + REWRITE_TAC[coord01]; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + DISCH_ALL_TAC; + UND 0; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; + UND 0; + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + DISCH_ALL_TAC; + UND 2; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let reflA_v_edge = prove_by_refinement( + `!m r. IMAGE (reflAf r) (v_edge m) = v_edge ( (reflAi r m))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[v_edge]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[coord01]; + REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let reflA_edge = prove_by_refinement( + `!r e. (edge e ==> edge (IMAGE (reflAf r) e))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + DISCH_ALL_TAC; + CHO 0; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[reflA_v_edge]; + ASM_REWRITE_TAC[]; + MESON_TAC[reflA_h_edge]; + ]);; + (* }}} *) + +let reflB_v_edge = prove_by_refinement( + `!m r. IMAGE (reflBf r) (v_edge m) = v_edge (down (reflBi r m))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[v_edge]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[coord01]; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + DISCH_ALL_TAC; + UND 0; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; + UND 0; + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + DISCH_ALL_TAC; + UND 2; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let reflB_h_edge = prove_by_refinement( + `!m r. IMAGE (reflBf r) (h_edge m) = h_edge ( (reflBi r m))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[h_edge]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "v"); + REWRITE_TAC[coord01]; + REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let reflB_edge = prove_by_refinement( + `!r e. (edge e ==> edge (IMAGE (reflBf r) e))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + DISCH_ALL_TAC; + CHO 0; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[reflB_v_edge]; + ASM_REWRITE_TAC[]; + MESON_TAC[reflB_h_edge]; + ]);; + (* }}} *) + +let reflC_vh_edge = prove_by_refinement( + `!m . IMAGE (reflCf) (v_edge m) = h_edge ( (reflCi m))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[v_edge;h_edge]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REWRITE_TAC[coord01]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let reflC_hv_edge = prove_by_refinement( + `!m . IMAGE (reflCf) (h_edge m) = v_edge ( (reflCi m))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[v_edge;h_edge]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + REWRITE_TAC[coord01]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let reflC_edge = prove_by_refinement( + `!e. (edge e ==> edge (IMAGE (reflCf ) e))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + DISCH_ALL_TAC; + CHO 0; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[reflC_vh_edge]; + ASM_REWRITE_TAC[]; + MESON_TAC[reflC_hv_edge]; + ]);; + (* }}} *) + +let homeo_bij = prove_by_refinement( + `!(f:A->B) U V. (homeomorphism f U V) ==> (BIJ (IMAGE f) U V)`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;homeomorphism;continuous;preimage;]; + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + ASM_REWRITE_TAC[IMAGE;]; + DISCH_ALL_TAC; + TAPP `u:B` 6; + USE 6 (REWRITE_RULE[]); + USE 6(CONV_RULE NAME_CONFLICT_CONV); + IMATCH_MP_TAC EQ_EXT; + USE 6 (GEN `u:B`); + GEN_TAC; + COPY 6; + EQ_TAC; + DISCH_TAC; + TSPEC `f x'` 7; + TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 7; + KILL 6; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CHO 6; + CHO 9; + TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `x' = x'''` SUBGOAL_TAC; + USE 0(REWRITE_RULE[INJ]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `x' = x''` SUBGOAL_TAC; + USE 0(REWRITE_RULE[INJ]); + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_MESON_TAC[]; + (* mm *) + DISCH_TAC; + TSPEC `f x'` 7; + TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 7; + KILL 6; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CHO 6; + CHO 9; + TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `x' = x'''` SUBGOAL_TAC; + USE 0(REWRITE_RULE[INJ]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `x' = x''` SUBGOAL_TAC; + USE 0(REWRITE_RULE[INJ]); + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[INJ;SURJ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `{z | UNIONS U z /\ x (f z)}` EXISTS_TAC; + CONJ_TAC; + UND 2; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET ;]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + MESON_TAC[]; + REWRITE_TAC[SUBSET;IMAGE]; + DISCH_ALL_TAC; + NAME_CONFLICT_TAC; + UND 1; + REWRITE_TAC[SURJ]; + DISCH_ALL_TAC; + TSPEC `x'` 8; + TYPE_THEN `UNIONS V x'` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;]; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 8; + CHO 8; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let homeo_unions = prove_by_refinement( + `!(f:A->B) U V. (homeomorphism f U V) ==> + (IMAGE f (UNIONS U) = (UNIONS V))`, + (* {{{ proof *) + [ + REWRITE_TAC[homeomorphism;BIJ;SURJ;IMAGE;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + NAME_CONFLICT_TAC; + EQ_TAC; + DISCH_ALL_TAC; + CHO 5; + ASM_MESON_TAC[]; + DISCH_TAC; + TSPEC `x` 2; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let homeo_closed = prove_by_refinement( + `!(f:A->B) U V A. (homeomorphism f U V /\ (A SUBSET (UNIONS U)) ==> + (closed_ V (IMAGE f A) = closed_ U A))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `BIJ f (UNIONS U) (UNIONS V)` SUBGOAL_TAC; + ASM_MESON_TAC[homeomorphism]; + DISCH_TAC; + USE 2(MATCH_MP DIFF_SURJ); + TSPEC `A` 2; + REWR 2; + ASM_REWRITE_TAC[closed;open_DEF]; + EQ_TAC; + DISCH_ALL_TAC; + USE 0(REWRITE_RULE[homeomorphism;continuous]); + UND 0; + DISCH_ALL_TAC; + USE 2 SYM; + REWR 4; + TSPEC `IMAGE f (UNIONS U DIFF A)` 5; + REWR 5; + TYPE_THEN `preimage (UNIONS U) f (IMAGE f (UNIONS U DIFF A)) = UNIONS U DIFF A` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC; + REWRITE_TAC[INR in_preimage;IMAGE;DIFF;]; + USE 0(REWRITE_RULE[BIJ;INJ]); + EQ_TAC; + DISCH_ALL_TAC; + CHO 8; + ASM_MESON_TAC[]; + MESON_TAC[]; + DISCH_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + CONJ_TAC; + USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]); + REWRITE_TAC[IMAGE;SUBSET]; + GEN_TAC; + NAME_CONFLICT_TAC; + UND 1; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + USE 0(REWRITE_RULE[homeomorphism]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* SECTION G *) +(* ------------------------------------------------------------------ *) + + +let IMAGE_INTERS = prove_by_refinement( + `!(f:A->B) A X . (INJ f X UNIV) /\ (UNIONS A SUBSET X) /\ + ~(A = EMPTY) ==> + ((IMAGE f) (INTERS A) = (INTERS (IMAGE2 f A)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[IMAGE2;INTERS;IMAGE;]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + EQ_TAC; + DISCH_ALL_TAC; + CHO 3; + AND 3; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CHO 5; + AND 5; + ASM_REWRITE_TAC[]; + NAME_CONFLICT_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + USE 3 (CONV_RULE (dropq_conv "u'")); + USE 3 (CONV_RULE (dropq_conv "y'")); + USE 2(REWRITE_RULE[EMPTY_EXISTS]); + CHO 2; + COPY 3; + TSPEC `u` 3; + CHO 3; + REWR 3; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 0(REWRITE_RULE[INJ]); + TSPEC `u'` 4; + CHO 4; + REWR 4; + TYPEL_THEN [`x'`;`x''`] (USE 0 o ISPECL); + USE 1(REWRITE_RULE[UNIONS;ISUBSET]); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let homeo_closure = prove_by_refinement( + `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) /\ + (topology_ U) ==> + (IMAGE f (closure U A) = closure V (IMAGE f A))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[closure]; + TYPE_THEN `INJ f (UNIONS U) (UNIV)` SUBGOAL_TAC; + USE 0(REWRITE_RULE[homeomorphism;BIJ;INJ;]); + ASM_REWRITE_TAC[INJ]; + DISCH_TAC; + TYPE_THEN `C = {B | closed_ U B /\ A SUBSET B}` ABBREV_TAC ; + TYPE_THEN `(UNIONS C SUBSET UNIONS U)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;]; + EXPAND_TAC "C"; + REWRITE_TAC[closed]; + TYPE_THEN `X = UNIONS U` ABBREV_TAC ; + REWRITE_TAC[UNIONS]; + MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `~(C = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `UNIONS U` EXISTS_TAC; + EXPAND_TAC "C"; + ASM_REWRITE_TAC[closed; ISUBSET; DIFF_EQ_EMPTY;]; + ASM_SIMP_TAC[INR open_EMPTY]; + DISCH_TAC; + JOIN 5 6; + JOIN 3 5; + USE 3 (MATCH_MP IMAGE_INTERS); + ASM_REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[IMAGE2]; + EXPAND_TAC "C"; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + EQ_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "g"; + KILL 5; + TYPE_THEN `x' SUBSET (UNIONS U)` SUBGOAL_TAC; + USE 6(REWRITE_RULE[closed]); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[homeo_closed]; + DISCH_TAC; + REWRITE_TAC[ISUBSET;IMAGE]; + NAME_CONFLICT_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_ALL_TAC; + TYPE_THEN `preimage (UNIONS U) f x` EXISTS_TAC; + TYPE_THEN `x = g (preimage (UNIONS U) f x)` SUBGOAL_TAC; + REWRITE_TAC[preimage]; + EXPAND_TAC "g"; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + EQ_TAC; + DISCH_TAC; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]); + UND 0; + DISCH_ALL_TAC; + TSPEC `x'` 10; + TYPE_THEN `UNIONS V x'` SUBGOAL_TAC; + USE 6(REWRITE_RULE[closed]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + REWR 10; + ASM_MESON_TAC[]; + REWRITE_TAC[IMAGE]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 8 (SYM); + ONCE_ASM_REWRITE_TAC[]; + REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `preimage (UNIONS U) f x SUBSET (UNIONS U)` SUBGOAL_TAC; + REWRITE_TAC[preimage;SUBSET;]; + MESON_TAC[]; + ASM_SIMP_TAC[GSYM homeo_closed]; + REWRITE_TAC[preimage;SUBSET]; + DISCH_ALL_TAC; + CONJ_TAC; + ASM_MESON_TAC[ISUBSET]; + UND 7; + EXPAND_TAC "g"; + REWRITE_TAC[IMAGE;ISUBSET;]; + UND 9; + MESON_TAC[]; + ]);; + + (* }}} *) + +let INJ_IMAGE = prove_by_refinement( + `!(f :A->B) A B X . (A SUBSET X) /\ (B SUBSET X) /\ + (INJ f X UNIV) ==> ((IMAGE f A = IMAGE f B) <=> (A = B))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + EQ_TAC; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]); + TAPP `y:B` 3; + RULE_ASSUM_TAC (REWRITE_RULE[]); + USE 3(GEN `y:B`); + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + USE 4(REWRITE_RULE [DE_MORGAN_THM]); + FIRST_ASSUM (DISJ_CASES_TAC); + + LEFT 5 "x"; + REP_BASIC_TAC; + TSPEC `f x ` 3; + TYPE_THEN `A x` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REP_BASIC_TAC; + USE 0(REWRITE_RULE[BIJ;INJ]); + TYPE_THEN `x = x'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + + LEFT 5 "x"; + REP_BASIC_TAC; + TSPEC `f x ` 3; + TYPE_THEN `B x` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REP_BASIC_TAC; + USE 0(REWRITE_RULE[BIJ;INJ]); + TYPE_THEN `x = x'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let INJ_UNIV = prove_by_refinement( + `!(f: A->B) X Y. (INJ f X Y) ==> (INJ f X UNIV)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + ASM_MESON_TAC []; + ]);; + (* }}} *) + +let homeo_adj = prove_by_refinement( + `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\ + (Y SUBSET euclid 2) + ==> (adj X Y ==> (adj (IMAGE f X) (IMAGE f Y)))`, + (* {{{ proof *) + [ + REWRITE_TAC[adj;INTER;EMPTY_EXISTS]; + REP_BASIC_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + TYPE_THEN `X SUBSET (UNIONS top2) /\ Y SUBSET (UNIONS (top2))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `closure top2 (IMAGE f X) = IMAGE f (closure top2 X)` SUBGOAL_TAC; + ASM_MESON_TAC[GSYM homeo_closure]; + DISCH_THEN_REWRITE; + TYPE_THEN `closure top2 (IMAGE f Y) = IMAGE f (closure top2 Y)` SUBGOAL_TAC; + ASM_MESON_TAC[GSYM homeo_closure]; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[]); + UND 2; + REWRITE_TAC[]; + UND 10; + TYPE_THEN `INJ f (euclid 2) UNIV` SUBGOAL_TAC; + IMATCH_MP_TAC INJ_UNIV; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]); + REP_BASIC_TAC; + REWR 11; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + ASM_MESON_TAC[INJ_IMAGE]; + (* done WITH both *) + TYPE_THEN `f u` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + (* converse *) + ]);; + (* }}} *) + +let homeomorphism_inv = prove_by_refinement( + `!(f:A->B) U V. homeomorphism f U V ==> + (homeomorphism (INV f (UNIONS U) (UNIONS V)) V U)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[homeomorphism]; + ASM_SIMP_TAC[INV_homeomorphism]; + USE 0(REWRITE_RULE [homeomorphism;continuous;]); + REP_BASIC_TAC; + ASM_SIMP_TAC[INVERSE_BIJ]; + REP_BASIC_TAC; + TSPEC `A` 1; + REWR 1; + TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ; + TYPE_THEN `BIJ g (UNIONS V) (UNIONS U)` SUBGOAL_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + TYPE_THEN `!x'. (A x' ==> (f (g x') = x'))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPEL_THEN [`f`;`UNIONS U`;`UNIONS V`] (fun t-> ASSUME_TAC (ISPECL t (INR INVERSE_DEF))); + RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); + REWR 6; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + DISCH_TAC; + DISCH_TAC; + (* branch *) + TYPE_THEN `(IMAGE g A) = preimage (UNIONS U) f A` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;preimage]; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]; + EXPAND_TAC "g"; + USE 2(MATCH_MP INVERSE_BIJ); + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC [UNIONS]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `f x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `f x = f (g (f x))` SUBGOAL_TAC; + ASM_SIMP_TAC[]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USE 9 SYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `UNIONS V (f x)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inv_comp_left = prove_by_refinement( + `!(f:A->B) X Y x. (BIJ f X Y /\ X x) ==> (INV f X Y (f x) = x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `Y (f x)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[INR INVERSE_XY]; + ]);; + (* }}} *) + +let inv_comp_right = prove_by_refinement( + `!(f:A->B) X Y y. (BIJ f X Y /\ Y y) ==> (f (INV f X Y y) = y)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); + ASM_MESON_TAC[INR INVERSE_DEF;]; + ]);; + (* }}} *) + +let image_inv_image = prove_by_refinement( + `!(f:A->B) A X Y. (BIJ f X Y) /\ (A SUBSET X) ==> + (IMAGE (INV f X Y) (IMAGE f A) = A)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `x = x'` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC [inv_comp_left;ISUBSET;]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC inv_comp_left; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let homeo_adj_eq = prove_by_refinement( + `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\ + (Y SUBSET euclid 2) + ==> (adj X Y = (adj (IMAGE f X) (IMAGE f Y)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + EQ_TAC; + ASM_MESON_TAC[homeo_adj]; + TYPEL_THEN [`INV f (euclid 2) (euclid 2)`;`IMAGE f X`;`IMAGE f Y`] (fun t-> MP_TAC (ISPECL t homeo_adj)); + ASSUME_TAC top2_unions; + TYPE_THEN `homeomorphism (INV f (euclid 2) (euclid 2)) top2 top2` SUBGOAL_TAC; + ASM_MESON_TAC[homeomorphism_inv]; + DISCH_THEN_REWRITE; + TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[homeomorphism]; + DISCH_TAC; + ASM_SIMP_TAC[image_inv_image]; + REP_BASIC_TAC; + TYPE_THEN `IMAGE f X SUBSET euclid 2 /\ IMAGE f Y SUBSET euclid 2` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + CONJ_TAC THEN (CONV_TAC (dropq_conv "x''")) THEN (RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ])); + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let finite_num_closure = prove_by_refinement( + `!G top (x:A). FINITE G ==> (FINITE {C | G C /\ closure top C x})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let image_powerset = prove_by_refinement( + `!(f:A->B) X Y. (BIJ f X Y ==> + (BIJ (IMAGE f) {z | z SUBSET X} { z | z SUBSET Y}))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + CONJ_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC ; + REWRITE_TAC[IMAGE;SUBSET;]; + ASM_MESON_TAC[ISUBSET ;]; + REWRITE_TAC[IMAGE;SUBSET;]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + + TAPP `z:B` 1; + USE 1(REWRITE_RULE[]); + USE 1(GEN `z:B`); + EQ_TAC; + TSPEC `f x'` 1; + REP_BASIC_TAC; + UND 1; + NAME_CONFLICT_TAC; + TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + TYPE_THEN `x' = x''` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* 2 *) + TSPEC `f x'` 1; + REP_BASIC_TAC; + UND 1; + NAME_CONFLICT_TAC; + TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + TYPE_THEN `x' = x''` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[INJ;SURJ]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `{z | X z /\ x (f z) }` EXISTS_TAC; + SUBCONJ_TAC; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT ; + REP_BASIC_TAC; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + TSPEC `x'` 0; + USE 3(REWRITE_RULE[SUBSET]); + TSPEC `x'` 3; + REWR 3; + REWR 0; + REP_BASIC_TAC; + TYPE_THEN `y` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let image_power_inj = prove_by_refinement( + `!(f:A->B) X Y A B. (BIJ f X Y /\ A SUBSET X /\ B SUBSET X ==> + ((IMAGE f A = IMAGE f B) <=> (A = B)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPEL_THEN [`f`;`X`;`Y`] (fun t -> ASSUME_TAC (ISPECL t image_powerset )); + REWR 3; + USE 3(REWRITE_RULE[BIJ;INJ;]); + REP_BASIC_TAC; + EQ_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let image_power_surj = prove_by_refinement( + `!(f:A->B) X Y B. (BIJ f X Y /\ B SUBSET Y ==> + (?A. (A SUBSET X /\ (IMAGE f A = B))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPEL_THEN [`f`;`X`;`Y`] (fun t -> ASSUME_TAC (ISPECL t image_powerset )); + REWR 2; + USE 2(REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let segment_euclid = prove_by_refinement( + `!G e. (segment G /\ G e) ==> (e SUBSET (euclid 2))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + REP_BASIC_TAC; + USE 3(REWRITE_RULE[SUBSET]); + TSPEC `e` 3; + REWR 3; + USE 3(REWRITE_RULE[edge]); + REP_BASIC_TAC; + ASM_MESON_TAC[h_edge_euclid;v_edge_euclid]; + ]);; + (* }}} *) + +let image_app = prove_by_refinement( + `!(f:A->B) X Y x t. INJ f X Y /\ x SUBSET X /\ (X t) ==> + (IMAGE f x (f t) = x t)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;IMAGE;SUBSET ;]; + REP_BASIC_TAC; + EQ_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let homeo_num_closure = prove_by_refinement( + `!G f m. (homeomorphism f top2 top2 /\ segment G) ==> + (num_closure G (pointI m) = + (num_closure (IMAGE2 f G) (f (pointI m))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC top2_unions; + ASSUME_TAC top2_top; + TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); + ASM_MESON_TAC []; + DISCH_TAC; + TYPE_THEN `G` (fun t-> ASSUME_TAC (ISPEC t segment_euclid)); + REWRITE_TAC[num_closure]; + IMATCH_MP_TAC BIJ_CARD; + TYPE_THEN `IMAGE f` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC finite_num_closure; + ASM_MESON_TAC[segment_finite]; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + CONJ_TAC; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE2]; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `x SUBSET (UNIONS top2)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `IMAGE f (closure top2 x) = closure top2 (IMAGE f x)` SUBGOAL_TAC; + ASM_MESON_TAC [homeo_closure]; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x SUBSET (euclid 2) /\ y SUBSET (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_MESON_TAC[image_power_inj]; + REWRITE_TAC[INJ;SURJ]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]); + UND 9; + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + EXPAND_TAC "g"; + REP_BASIC_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWR 8; + UND 8; + TYPE_THEN `x' SUBSET (UNIONS top2)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `closure top2 (g x') = IMAGE f (closure top2 x')` SUBGOAL_TAC; + ASM_MESON_TAC [GSYM homeo_closure]; + DISCH_THEN_REWRITE; + (* m3 *) + TYPE_THEN `INJ f (euclid 2) (euclid 2) /\ (closure top2 x' SUBSET (euclid 2)) /\ (euclid 2 (pointI m))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); + ASM_REWRITE_TAC[pointI;euclid_point]; + IMATCH_MP_TAC c_edge_euclid; + ASM_MESON_TAC[segment;ISUBSET]; + DISCH_TAC; + USE 12 (MATCH_MP image_app); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION H *) +(* ------------------------------------------------------------------ *) + +let reflA_pointI = prove_by_refinement( + `!r m. (reflAf r (pointI m) = pointI (reflAi r m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[reflAi;reflAf;pointI]; + REWRITE_TAC[point_inj;PAIR_SPLIT;]; + REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01]; + ]);; + (* }}} *) + +let reflB_pointI = prove_by_refinement( + `!r m. (reflBf r (pointI m) = pointI (reflBi r m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[reflBi;reflBf;pointI]; + REWRITE_TAC[point_inj;PAIR_SPLIT;]; + REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01]; + ]);; + (* }}} *) + +let reflC_pointI = prove_by_refinement( + `!m. (reflCf (pointI m) = pointI (reflCi m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[reflCi;reflCf;pointI]; + REWRITE_TAC[point_inj;PAIR_SPLIT;]; + REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01]; + ]);; + (* }}} *) + +let edge_euclid2 = prove_by_refinement( + `!e. (edge e ==> e SUBSET (euclid 2))`, + (* {{{ proof *) + [ + MESON_TAC [edge;h_edge_euclid;v_edge_euclid;]; + ]);; + (* }}} *) + +let reflA_segment = prove_by_refinement( + `!G r. (segment G ==> (segment (IMAGE2 (reflAf r) G)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[segment]; + COPY 0; + USE 0(REWRITE_RULE[segment]); + REP_BASIC_TAC; + TYPE_THEN `homeomorphism (reflAf r) top2 top2` SUBGOAL_TAC; + REWRITE_TAC[reflA_homeo]; + DISCH_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + TYPE_THEN `BIJ (reflAf r) (euclid 2) (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[homeomorphism]; + DISCH_TAC; + TYPE_THEN `INJ (IMAGE (reflAf r)) edge edge` SUBGOAL_TAC; + REWRITE_TAC[INJ;reflA_edge;]; + REP_BASIC_TAC; + TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[edge_euclid2]; + DISCH_TAC; + ASM_MESON_TAC[image_power_inj]; + DISCH_TAC; + (* start cases *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2; EQ_EMPTY]); + TSPEC `IMAGE (reflAf r) u` 4; + UND 4; + REWRITE_TAC[]; + TYPE_THEN `IMAGE (IMAGE (reflAf r)) G (IMAGE (reflAf r) u) = G u` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + EXISTS_TAC `edge`; + EXISTS_TAC `edge`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* + ASM_MESON_TAC[image_power_inj]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2;SUBSET]; + GEN_TAC; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV ) [IMAGE]; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC reflA_edge; + ASM_MESON_TAC[ISUBSET;]; + DISCH_TAC; + (* num closure clause *) + CONJ_TAC; + GEN_TAC; + TYPE_THEN `pointI m = reflAf r (pointI (reflAi r m))` SUBGOAL_TAC; + REWRITE_TAC[reflA_pointI;reflAi_inv]; + DISCH_THEN_REWRITE; + TYPE_THEN `num_closure (IMAGE2 (reflAf r) G) (reflAf r (pointI (reflAi r m))) = num_closure G (pointI (reflAi r m))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_num_closure); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[]; + (* inductive_set clause *) + REP_BASIC_TAC; + (* isc *) + USE 16(REWRITE_RULE[IMAGE2]); + USE 16 (MATCH_MP SUBSET_PREIMAGE); + REP_BASIC_TAC; + TSPEC `Z` 0; + TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[]); + REWR 16; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES]); + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `D = IMAGE (reflAf r) C` ABBREV_TAC ; + TYPE_THEN `D' = IMAGE (reflAf r) C'` ABBREV_TAC ; + TSPEC `D` 14; (* *) + TSPEC `D'` 14; + TYPE_THEN `S D /\ IMAGE2 (reflAf r) G D' /\ adj D D'` SUBGOAL_TAC; + SUBCONJ_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "D"; + TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C) = Z C` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + TYPE_THEN `edge` EXISTS_TAC; + TYPE_THEN `edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* fh1 *) + SUBCONJ_TAC; + EXPAND_TAC "D'"; + REWRITE_TAC[IMAGE2;IMAGE]; + NAME_CONFLICT_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + EXPAND_TAC "D"; + EXPAND_TAC "D'"; + TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;edge_euclid2]; + DISCH_TAC; + TYPE_THEN `(adj C C' ==> adj (IMAGE (reflAf r) C) (IMAGE (reflAf r) C'))` SUBGOAL_TAC; + IMATCH_MP_TAC homeo_adj; + ASM_REWRITE_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 14; + UND 14; + EXPAND_TAC "D'"; + TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C') = Z C'` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + TYPE_THEN `edge` EXISTS_TAC; + TYPE_THEN `edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 3; + UND 19; + ASM_MESON_TAC[ISUBSET]; + MESON_TAC[]; + DISCH_TAC; + REWR 0; + ASM_REWRITE_TAC[IMAGE2]; + ]);; + (* }}} *) + +let reflB_segment = prove_by_refinement( + `!G r. (segment G ==> (segment (IMAGE2 (reflBf r) G)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[segment]; + COPY 0; + USE 0(REWRITE_RULE[segment]); + REP_BASIC_TAC; + TYPE_THEN `homeomorphism (reflBf r) top2 top2` SUBGOAL_TAC; + REWRITE_TAC[reflB_homeo]; + DISCH_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + TYPE_THEN `BIJ (reflBf r) (euclid 2) (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[homeomorphism]; + DISCH_TAC; + TYPE_THEN `INJ (IMAGE (reflBf r)) edge edge` SUBGOAL_TAC; + REWRITE_TAC[INJ;reflB_edge;]; + REP_BASIC_TAC; + TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[edge_euclid2]; + DISCH_TAC; + ASM_MESON_TAC[image_power_inj]; + DISCH_TAC; + (* start cases *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2; EQ_EMPTY]); + TSPEC `IMAGE (reflBf r) u` 4; + UND 4; + REWRITE_TAC[]; + TYPE_THEN `IMAGE (IMAGE (reflBf r)) G (IMAGE (reflBf r) u) = G u` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + EXISTS_TAC `edge`; + EXISTS_TAC `edge`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* + ASM_MESON_TAC[image_power_inj]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2;SUBSET]; + GEN_TAC; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV ) [IMAGE]; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC reflB_edge; + ASM_MESON_TAC[ISUBSET;]; + DISCH_TAC; + (* num closure clause *) + CONJ_TAC; + GEN_TAC; + TYPE_THEN `pointI m = reflBf r (pointI (reflBi r m))` SUBGOAL_TAC; + REWRITE_TAC[reflB_pointI;reflBi_inv]; + DISCH_THEN_REWRITE; + TYPE_THEN `num_closure (IMAGE2 (reflBf r) G) (reflBf r (pointI (reflBi r m))) = num_closure G (pointI (reflBi r m))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_num_closure); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[]; + (* inductive_set clause *) + REP_BASIC_TAC; + (* isc *) + USE 16(REWRITE_RULE[IMAGE2]); + USE 16 (MATCH_MP SUBSET_PREIMAGE); + REP_BASIC_TAC; + TSPEC `Z` 0; + TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[]); + REWR 16; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES]); + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `D = IMAGE (reflBf r) C` ABBREV_TAC ; + TYPE_THEN `D' = IMAGE (reflBf r) C'` ABBREV_TAC ; + TSPEC `D` 14; (* *) + TSPEC `D'` 14; + TYPE_THEN `S D /\ IMAGE2 (reflBf r) G D' /\ adj D D'` SUBGOAL_TAC; + SUBCONJ_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "D"; + TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C) = Z C` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + TYPE_THEN `edge` EXISTS_TAC; + TYPE_THEN `edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* fh1 *) + SUBCONJ_TAC; + EXPAND_TAC "D'"; + REWRITE_TAC[IMAGE2;IMAGE]; + NAME_CONFLICT_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + EXPAND_TAC "D"; + EXPAND_TAC "D'"; + TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;edge_euclid2]; + DISCH_TAC; + TYPE_THEN `(adj C C' ==> adj (IMAGE (reflBf r) C) (IMAGE (reflBf r) C'))` SUBGOAL_TAC; + IMATCH_MP_TAC homeo_adj; + ASM_REWRITE_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 14; + UND 14; + EXPAND_TAC "D'"; + TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C') = Z C'` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + TYPE_THEN `edge` EXISTS_TAC; + TYPE_THEN `edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 3; + UND 19; + ASM_MESON_TAC[ISUBSET]; + MESON_TAC[]; + DISCH_TAC; + REWR 0; + ASM_REWRITE_TAC[IMAGE2]; + ]);; + (* }}} *) + +let reflC_segment = prove_by_refinement( + `!G . (segment G ==> (segment (IMAGE2 (reflCf) G)))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[segment]; + COPY 0; + USE 0(REWRITE_RULE[segment]); + REP_BASIC_TAC; + TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC; + REWRITE_TAC[reflC_homeo]; + DISCH_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + TYPE_THEN `BIJ (reflCf) (euclid 2) (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[homeomorphism]; + DISCH_TAC; + TYPE_THEN `INJ (IMAGE (reflCf)) edge edge` SUBGOAL_TAC; + REWRITE_TAC[INJ;reflC_edge;]; + REP_BASIC_TAC; + TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC; + ASM_MESON_TAC[edge_euclid2]; + DISCH_TAC; + ASM_MESON_TAC[image_power_inj]; + DISCH_TAC; + (* start cases *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2; EQ_EMPTY]); + TSPEC `IMAGE (reflCf) u` 4; + UND 4; + REWRITE_TAC[]; + TYPE_THEN `IMAGE (IMAGE (reflCf)) G (IMAGE (reflCf) u) = G u` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + EXISTS_TAC `edge`; + EXISTS_TAC `edge`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* + ASM_MESON_TAC[image_power_inj]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2;SUBSET]; + GEN_TAC; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV ) [IMAGE]; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC reflC_edge; + ASM_MESON_TAC[ISUBSET;]; + DISCH_TAC; + (* num closure clause *) + CONJ_TAC; + GEN_TAC; + TYPE_THEN `pointI m = reflCf (pointI (reflCi m))` SUBGOAL_TAC; + REWRITE_TAC[reflC_pointI;reflCi_inv]; + DISCH_THEN_REWRITE; + TYPE_THEN `num_closure (IMAGE2 (reflCf) G) (reflCf (pointI (reflCi m))) = num_closure G (pointI (reflCi m))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_num_closure); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[]; + (* inductive_set clause *) + REP_BASIC_TAC; + (* isc *) + USE 16(REWRITE_RULE[IMAGE2]); + USE 16 (MATCH_MP SUBSET_PREIMAGE); + REP_BASIC_TAC; + TSPEC `Z` 0; + TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[]); + REWR 16; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES]); + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `D = IMAGE (reflCf) C` ABBREV_TAC ; + TYPE_THEN `D' = IMAGE (reflCf) C'` ABBREV_TAC ; + TSPEC `D` 14; (* *) + TSPEC `D'` 14; + TYPE_THEN `S D /\ IMAGE2 (reflCf) G D' /\ adj D D'` SUBGOAL_TAC; + SUBCONJ_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "D"; + TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C) = Z C` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + TYPE_THEN `edge` EXISTS_TAC; + TYPE_THEN `edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* fh1 *) + SUBCONJ_TAC; + EXPAND_TAC "D'"; + REWRITE_TAC[IMAGE2;IMAGE]; + NAME_CONFLICT_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + EXPAND_TAC "D"; + EXPAND_TAC "D'"; + TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET;edge_euclid2]; + DISCH_TAC; + TYPE_THEN `(adj C C' ==> adj (IMAGE (reflCf) C) (IMAGE (reflCf) C'))` SUBGOAL_TAC; + IMATCH_MP_TAC homeo_adj; + ASM_REWRITE_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 14; + UND 14; + EXPAND_TAC "D'"; + TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C') = Z C'` SUBGOAL_TAC; + IMATCH_MP_TAC image_app; + TYPE_THEN `edge` EXISTS_TAC; + TYPE_THEN `edge` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 3; + UND 19; + ASM_MESON_TAC[ISUBSET]; + MESON_TAC[]; + DISCH_TAC; + REWR 0; + ASM_REWRITE_TAC[IMAGE2]; + ]);; + + (* }}} *) + +let point_x = prove_by_refinement( + `!x m. (x = point m) <=> (euclid 2 x /\ (FST m = x 0) /\ (SND m = x 1))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + EQ_TAC ; + DISCH_THEN_REWRITE; + REWRITE_TAC[coord01;euclid_point]; + REP_BASIC_TAC; + USE 2 (MATCH_MP point_onto ); + REP_BASIC_TAC; + ASM_REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT]; + ASM_REWRITE_TAC[coord01]; + ]);; + (* }}} *) + +(* next IMAGE of square *) + +let reflA_squ = prove_by_refinement( + `!m r. IMAGE (reflAf r) (squ m) = squ (left (reflAi r m))`, + (* {{{ proof *) + [ + REWRITE_TAC[squ;reflAf;reflAi;IMAGE ;left ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + REWRITE_TAC[coord01;]; + REWRITE_TAC[point_x]; + CONV_TAC (dropq_conv "v"); + EQ_TAC ; + REP_BASIC_TAC; + TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 4; + UND 5; + USE 0 (GSYM ); + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + REAL_ARITH_TAC; + (* 2 *) + REP_BASIC_TAC; + TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; + UND 2; + UND 3; + USE 4 (GSYM); + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let reflB_squ = prove_by_refinement( + `!m r. IMAGE (reflBf r) (squ m) = squ (down (reflBi r m))`, + (* {{{ proof *) + [ + REWRITE_TAC[squ;reflBf;reflBi;IMAGE ;down ;]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + REWRITE_TAC[coord01;]; + REWRITE_TAC[point_x]; + CONV_TAC (dropq_conv "u"); + EQ_TAC ; + REP_BASIC_TAC; + TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 2; + UND 3; + USE 0 (GSYM ); + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + REAL_ARITH_TAC; + (* 2 *) + REP_BASIC_TAC; + TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`]; + UND 0; + UND 1; + USE 4 (GSYM); + ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let reflC_squ = prove_by_refinement( + `!m. IMAGE (reflCf) (squ m) = squ ( (reflCi m))`, + (* {{{ proof *) + [ + REWRITE_TAC[squ;reflCf;reflCi;IMAGE ; ]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "x'"); + REWRITE_TAC[coord01;]; + REWRITE_TAC[point_x]; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "v"); + MESON_TAC[]; + ]);; + (* }}} *) + +(* move to sets *) +let powerset = jordan_def `powerset (X:A->bool) = { z | z SUBSET X }`;; + +let image_sing = prove_by_refinement( + `!(f:A -> B) x. (IMAGE f {x} = {(f x)})`, + (* {{{ proof *) + [ + REWRITE_TAC[IMAGE;INSERT]; + CONV_TAC (dropq_conv "x'"); + ]);; + (* }}} *) + +let image_unions = prove_by_refinement( + `!(f:A->B) U. + (IMAGE f (UNIONS U) = UNIONS (IMAGE (IMAGE f) U))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[IMAGE;UNIONS;]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + EQ_TAC; + REP_BASIC_TAC; + CONV_TAC (dropq_conv "u"); + ASM_REWRITE_TAC[]; + NAME_CONFLICT_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + NAME_CONFLICT_TAC; + REWR 0; + KILL 1; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* move *) +let segment_euclid = prove_by_refinement( + `!G. (segment G) ==> (closure top2 (UNIONS G) SUBSET euclid 2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC closure_subset; + ASM_REWRITE_TAC[top2_top;GSYM top2_unions]; + CONJ_TAC; + IMATCH_MP_TAC closed_UNIV; + REWRITE_TAC[top2_top]; + REWRITE_TAC[top2_unions;SUBSET;UNIONS;]; + REP_BASIC_TAC; + TYPE_THEN `edge u` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + ASM_MESON_TAC[edge_euclid2;ISUBSET]; + ]);; + (* }}} *) + +let image_curve_cell_reflA = prove_by_refinement( + `!G r. (segment G) ==> + (curve_cell (IMAGE2 (reflAf r) G) = + IMAGE2 (reflAf r) (curve_cell G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[curve_cell]; + REWRITE_TAC[IMAGE2;IMAGE_UNION;]; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;UNIONS;]; + REP_BASIC_TAC; + TYPE_THEN `edge u` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET;]; + ASM_MESON_TAC[edge_euclid2;ISUBSET]; + DISCH_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + (* *) + TYPE_THEN `UNIONS (IMAGE (IMAGE (reflAf r)) G) = IMAGE (reflAf r) (UNIONS G)` SUBGOAL_TAC; + REWRITE_TAC[GSYM image_unions]; + DISCH_THEN_REWRITE ; + (* *) + TYPE_THEN `closure top2 (IMAGE (reflAf r) (UNIONS G)) = IMAGE (reflAf r) (closure top2 (UNIONS G))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;]; + DISCH_THEN_REWRITE; + (* *) + TYPE_THEN `!n. IMAGE (reflAf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflAi r n))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `n' = reflAi r n` ABBREV_TAC ; + TYPE_THEN `pointI n = reflAf r (pointI n')` SUBGOAL_TAC; + EXPAND_TAC "n'"; + KILL 4; + ASM_REWRITE_TAC[reflA_pointI;reflAi_inv]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC image_app; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC[pointI;euclid_point]; + ASSUME_TAC reflA_homeo; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC segment_euclid; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* *) + REWRITE_TAC[IMAGE;]; + CONV_TAC (dropq_conv "x'"); +(**** Modified by JRH to avoid GSPEC + REWRITE_TAC[INR IN_SING;GSPEC;]; + ****) + REWRITE_TAC[INR IN_SING; UNWIND_THM2]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "y'"); +(**** Removed by JRH + REWRITE_TAC[GSPEC]; + ****) + (* *) + EQ_TAC ; + REP_BASIC_TAC; + TYPE_THEN `reflAi r n'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING; reflA_pointI; reflAi_inv;]; +(*** Removed by JRH + MESON_TAC[]; + ****) + (* *) + REP_BASIC_TAC; + TYPE_THEN `reflAi r n'` EXISTS_TAC; + ASM_REWRITE_TAC[reflAi_inv;]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING;reflA_pointI;]; +(*** Removed by JRH + MESON_TAC[]; + ****) + ]);; + (* }}} *) + +let image_curve_cell_reflB = prove_by_refinement( + `!G r. (segment G) ==> + (curve_cell (IMAGE2 (reflBf r) G) = + IMAGE2 (reflBf r) (curve_cell G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[curve_cell]; + REWRITE_TAC[IMAGE2;IMAGE_UNION;]; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;UNIONS;]; + REP_BASIC_TAC; + TYPE_THEN `edge u` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET;]; + ASM_MESON_TAC[edge_euclid2;ISUBSET]; + DISCH_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + (* *) + TYPE_THEN `UNIONS (IMAGE (IMAGE (reflBf r)) G) = IMAGE (reflBf r) (UNIONS G)` SUBGOAL_TAC; + REWRITE_TAC[GSYM image_unions]; + DISCH_THEN_REWRITE ; + (* *) + TYPE_THEN `closure top2 (IMAGE (reflBf r) (UNIONS G)) = IMAGE (reflBf r) (closure top2 (UNIONS G))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;]; + DISCH_THEN_REWRITE; + (* *) + TYPE_THEN `!n. IMAGE (reflBf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflBi r n))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `n' = reflBi r n` ABBREV_TAC ; + TYPE_THEN `pointI n = reflBf r (pointI n')` SUBGOAL_TAC; + EXPAND_TAC "n'"; + KILL 4; + ASM_REWRITE_TAC[reflB_pointI;reflBi_inv]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC image_app; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC[pointI;euclid_point]; + ASSUME_TAC reflB_homeo; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC segment_euclid; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* *) + REWRITE_TAC[IMAGE;]; + CONV_TAC (dropq_conv "x'"); + +(*** JRH changed this line to avoid GSPEC + REWRITE_TAC[INR IN_SING;GSPEC;]; + ***) + REWRITE_TAC[INR IN_SING; UNWIND_THM2]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "y'"); +(*** JRH removed this to avoid GSPEC + REWRITE_TAC[GSPEC]; + ***) + (* *) + EQ_TAC ; + REP_BASIC_TAC; + TYPE_THEN `reflBi r n'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING; reflB_pointI; reflBi_inv;]; +(*** Removed by JRH + MESON_TAC[]; + ****) + (* *) + REP_BASIC_TAC; + TYPE_THEN `reflBi r n'` EXISTS_TAC; + ASM_REWRITE_TAC[reflBi_inv;]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING;reflB_pointI;]; +(*** Removed by JRH + MESON_TAC[]; + ****) + ]);; + (* }}} *) + +let image_curve_cell_reflC = prove_by_refinement( + `!G . (segment G) ==> + (curve_cell (IMAGE2 (reflCf ) G) = + IMAGE2 (reflCf) (curve_cell G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[curve_cell]; + REWRITE_TAC[IMAGE2;IMAGE_UNION;]; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;UNIONS;]; + REP_BASIC_TAC; + TYPE_THEN `edge u` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET;]; + ASM_MESON_TAC[edge_euclid2;ISUBSET]; + DISCH_TAC; + ASSUME_TAC top2_top; + ASSUME_TAC top2_unions; + (* *) + TYPE_THEN `UNIONS (IMAGE (IMAGE (reflCf)) G) = IMAGE (reflCf) (UNIONS G)` SUBGOAL_TAC; + REWRITE_TAC[GSYM image_unions]; + DISCH_THEN_REWRITE ; + (* *) + TYPE_THEN `closure top2 (IMAGE (reflCf) (UNIONS G)) = IMAGE (reflCf) (closure top2 (UNIONS G))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;]; + DISCH_THEN_REWRITE; + (* *) + TYPE_THEN `!n. IMAGE (reflCf) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflCi n))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `n' = reflCi n` ABBREV_TAC ; + TYPE_THEN `pointI n = reflCf (pointI n')` SUBGOAL_TAC; + EXPAND_TAC "n'"; + KILL 4; + ASM_REWRITE_TAC[reflC_pointI;reflCi_inv]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC image_app; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC[pointI;euclid_point]; + ASSUME_TAC reflC_homeo; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC segment_euclid; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* *) + REWRITE_TAC[IMAGE;]; + CONV_TAC (dropq_conv "x'"); +(*** This line changed by JRH to avoid GSPEC + REWRITE_TAC[INR IN_SING;GSPEC;]; + ***) + REWRITE_TAC[INR IN_SING; UNWIND_THM2]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x'"); + CONV_TAC (dropq_conv "y'"); + (*** Removed by JRH to avoid GSPEC + REWRITE_TAC[GSPEC]; + ***) + (* *) + EQ_TAC ; + REP_BASIC_TAC; + TYPE_THEN `reflCi n'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING; reflC_pointI; reflCi_inv;]; +(*** Removed by JRH + MESON_TAC[]; + ****) + (* *) + REP_BASIC_TAC; + TYPE_THEN `reflCi n'` EXISTS_TAC; + ASM_REWRITE_TAC[reflCi_inv;]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING;reflC_pointI;]; +(*** Removed by JRH + MESON_TAC[]; + ****) + ]);; + (* }}} *) + +let inj_inter = prove_by_refinement( + `!(f:A->B) X Y A B. (INJ f X Y) /\ (A SUBSET X) /\ (B SUBSET X) ==> + (IMAGE f (A INTER B) = (IMAGE f A) INTER (IMAGE f B))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE;INTER ]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + EQ_TAC; + REP_BASIC_TAC; + ASM_MESON_TAC[ISUBSET;]; + REP_BASIC_TAC; + TYPE_THEN `x' = x''` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[ISUBSET;]; + REP_BASIC_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let homeomorphism_induced_top = prove_by_refinement( + `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) ==> + (IMAGE2 f (induced_top U A) = induced_top V (IMAGE f A))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[induced_top;]; + COPY 1; + USE 1 (MATCH_MP homeo_bij); + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IMAGE2]; + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + (* *) + TYPE_THEN `!t. U t ==> (g (t INTER A) = g t INTER g A)` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC inj_inter; + TYPE_THEN `(UNIONS U)` EXISTS_TAC; + TYPE_THEN `(UNIONS V)` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC sub_union; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* *) + EQ_TAC; + REP_BASIC_TAC; + TSPEC `x'` 4; + REWR 4; + ASM_REWRITE_TAC[]; + NAME_CONFLICT_TAC; + TYPE_THEN `g x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + ASM_MESON_TAC[]; + (* *) + REP_BASIC_TAC; + TYPE_THEN `?t. U t /\ (g t = x')` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TSPEC `t` 4; + REWR 4; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let ctop_reflA = prove_by_refinement( + `!G r. (segment G) ==> + (IMAGE2 (reflAf r) (ctop G) = ctop (IMAGE2 (reflAf r) G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[ctop]; + ASSUME_TAC reflA_homeo; + TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC; + REWRITE_TAC[top2_unions;DIFF;SUBSET;]; + MESON_TAC[]; + DISCH_TAC ; + (* *) + TYPE_THEN `IMAGE2 (reflAf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflAf r) (euclid 2 DIFF (UNIONS (curve_cell G))))` SUBGOAL_TAC; + IMATCH_MP_TAC homeomorphism_induced_top; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + AP_TERM_TAC; + TSPEC `r` 1; + (* *) + TYPE_THEN `IMAGE (reflAf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflAf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]); + REP_BASIC_TAC; + USE 4 (MATCH_MP DIFF_SURJ); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[UNIONS;SUBSET;]; + REP_BASIC_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + TYPE_THEN `cell u` SUBGOAL_TAC; + USE 7 (MATCH_MP curve_cell_cell); + ASM_MESON_TAC[ISUBSET;]; + ASM_MESON_TAC[ISUBSET;cell_euclid]; + DISCH_THEN_REWRITE; + AP_TERM_TAC; + REWRITE_TAC[image_unions]; + AP_TERM_TAC; + ASM_SIMP_TAC[image_curve_cell_reflA]; + REWRITE_TAC[IMAGE2]; + ]);; + (* }}} *) + +let ctop_reflB = prove_by_refinement( + `!G r. (segment G) ==> + (IMAGE2 (reflBf r) (ctop G) = ctop (IMAGE2 (reflBf r) G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[ctop]; + ASSUME_TAC reflB_homeo; + TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC; + REWRITE_TAC[top2_unions;DIFF;SUBSET;]; + MESON_TAC[]; + DISCH_TAC ; + (* *) + TYPE_THEN `IMAGE2 (reflBf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflBf r) (euclid 2 DIFF (UNIONS (curve_cell G))))` SUBGOAL_TAC; + IMATCH_MP_TAC homeomorphism_induced_top; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + AP_TERM_TAC; + TSPEC `r` 1; + (* *) + TYPE_THEN `IMAGE (reflBf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflBf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]); + REP_BASIC_TAC; + USE 4 (MATCH_MP DIFF_SURJ); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[UNIONS;SUBSET;]; + REP_BASIC_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + TYPE_THEN `cell u` SUBGOAL_TAC; + USE 7 (MATCH_MP curve_cell_cell); + ASM_MESON_TAC[ISUBSET;]; + ASM_MESON_TAC[ISUBSET;cell_euclid]; + DISCH_THEN_REWRITE; + AP_TERM_TAC; + REWRITE_TAC[image_unions]; + AP_TERM_TAC; + ASM_SIMP_TAC[image_curve_cell_reflB]; + REWRITE_TAC[IMAGE2]; + ]);; + (* }}} *) + +let ctop_reflC = prove_by_refinement( + `!G . (segment G) ==> + (IMAGE2 (reflCf) (ctop G) = ctop (IMAGE2 (reflCf) G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[ctop]; + ASSUME_TAC reflC_homeo; + TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC; + REWRITE_TAC[top2_unions;DIFF;SUBSET;]; + MESON_TAC[]; + DISCH_TAC ; + (* *) + TYPE_THEN `IMAGE2 (reflCf) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflCf) (euclid 2 DIFF (UNIONS (curve_cell G))))` SUBGOAL_TAC; + IMATCH_MP_TAC homeomorphism_induced_top; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + AP_TERM_TAC; + (* *) + TYPE_THEN `IMAGE (reflCf) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflCf) (UNIONS (curve_cell G)))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]); + REP_BASIC_TAC; + USE 4 (MATCH_MP DIFF_SURJ); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[UNIONS;SUBSET;]; + REP_BASIC_TAC; + TYPE_THEN `G SUBSET edge` SUBGOAL_TAC; + ASM_MESON_TAC[segment]; + DISCH_TAC; + TYPE_THEN `cell u` SUBGOAL_TAC; + USE 7 (MATCH_MP curve_cell_cell); + ASM_MESON_TAC[ISUBSET;]; + ASM_MESON_TAC[ISUBSET;cell_euclid]; + DISCH_THEN_REWRITE; + AP_TERM_TAC; + REWRITE_TAC[image_unions]; + AP_TERM_TAC; + ASM_SIMP_TAC[image_curve_cell_reflC]; + REWRITE_TAC[IMAGE2]; + ]);; + (* }}} *) + +let connected_homeo = prove_by_refinement( + `!(f:A->B) U V Z. (homeomorphism f U V /\ (Z SUBSET UNIONS U) ==> + (connected V (IMAGE f Z) = connected U Z))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ; + TYPE_THEN `Z = IMAGE g (IMAGE f Z)` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IMAGE]; + EXPAND_TAC "g"; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); + REP_BASIC_TAC; + TYPE_THEN `!x'. (UNIONS U x') ==> (INV f (UNIONS U) (UNIONS V) (f x') = x')` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC inv_comp_left; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* *) + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN ` x` EXISTS_TAC; + KILL 2; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET;]; + REP_BASIC_TAC; + TSPEC `x'` 5; + TYPE_THEN `UNIONS U x'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + REWR 5; + ASM_REWRITE_TAC[]; + DISCH_TAC; + EQ_TAC; + REP_BASIC_TAC; + UND 3; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + IMATCH_MP_TAC connect_image; + TYPE_THEN `V` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC INV_homeomorphism; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET;]; + REP_BASIC_TAC; + UND 3; + EXPAND_TAC "g"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `UNIONS U x''` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); + TYPE_THEN `x = x''` SUBGOAL_TAC; + ASM_MESON_TAC[inv_comp_left]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + IMATCH_MP_TAC connect_image; + TYPE_THEN `U` EXISTS_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]); + REP_BASIC_TAC; + ASM_REWRITE_TAC[SUBSET;IMAGE;]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + ASM_MESON_TAC[ISUBSET;]; + ]);; + (* }}} *) + +(* start here , Tues Jun 8 , 2004 *) + +let component = prove_by_refinement( + `!U (x:A) . (component U x = {y | ?Z. connected U Z /\ Z x /\ Z y})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[component_DEF ;]; + ]);; + (* }}} *) + +let component_homeo = prove_by_refinement( + `!(f:A->B) U V x. (homeomorphism f U V) /\ (UNIONS U x) ==> + (IMAGE f (component U x) = (component V (f x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[component ;IMAGE ; ]; + IMATCH_MP_TAC EQ_EXT ; + REP_BASIC_TAC; + REWRITE_TAC[]; + CONV_TAC (dropq_conv "x'"); + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `IMAGE f Z` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `Z SUBSET UNIONS U` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[connected]); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[connected_homeo]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + (* *) + REP_BASIC_TAC; + (* *) + TYPE_THEN `?A. A SUBSET (UNIONS U) /\ (IMAGE f A = Z)` SUBGOAL_TAC; + IMATCH_MP_TAC image_power_surj; + TYPE_THEN `UNIONS V` EXISTS_TAC; + ASM_MESON_TAC[connected;homeomorphism]; + REP_BASIC_TAC; + TYPE_THEN `A` EXISTS_TAC; + NAME_CONFLICT_TAC; + WITH 5 (REWRITE_RULE[IMAGE]); + USE 7 (GSYM); + REWR 2; + REP_BASIC_TAC; + TYPE_THEN `x''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWR 3; + REP_BASIC_TAC; + TYPE_THEN ` x = x'''` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + KILL 7; + ASM_SIMP_TAC[GSYM connected_homeo]; + ]);; + (* }}} *) + +let bij_homeo = prove_by_refinement( + `!(f:A->B) U V. (BIJ f (UNIONS U) (UNIONS V)) /\ + (BIJ (IMAGE f) U V) ==> (homeomorphism f U V)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[homeomorphism;continuous;]; + ASM_REWRITE_TAC[preimage;]; + CONJ_TAC; + REP_BASIC_TAC; + COPY 1; + UND 3; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ;SURJ]); + REP_BASIC_TAC; + TSPEC `v` 1; + REWR 1; + REP_BASIC_TAC; + EXPAND_TAC "v"; + TYPE_THEN `{x | UNIONS U x /\ IMAGE f y (f x)} = y` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `IMAGE f y (f x) = y x` SUBGOAL_TAC; + IMATCH_MP_TAC image_app ; + TYPE_THEN `(UNIONS U)` EXISTS_TAC; + TYPE_THEN `(UNIONS V)` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[sub_union]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + CONJ_TAC; + ASM_MESON_TAC[sub_union;ISUBSET]; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + (* *) + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let homeomorphism_subset = prove_by_refinement( + `!(f:A->B) U V C. (homeomorphism f U V) /\ (C SUBSET U) ==> + (homeomorphism f C (IMAGE2 f C))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + IMATCH_MP_TAC bij_homeo; + SUBCONJ_TAC; + TYPE_THEN `UNIONS C SUBSET UNIONS U` SUBGOAL_TAC; + IMATCH_MP_TAC UNIONS_UNIONS ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWRITE_TAC[IMAGE2 ;GSYM image_unions;]; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]); + REP_BASIC_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + SUBCONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `IMAGE f (UNIONS C) (f x) = (UNIONS C) x` SUBGOAL_TAC; + IMATCH_MP_TAC (image_app); + TYPE_THEN `(UNIONS U)` EXISTS_TAC; + TYPE_THEN `(UNIONS V)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC [ISUBSET]; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + REWRITE_TAC[SURJ]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]); + ASM_MESON_TAC[]; + DISCH_TAC; + REWRITE_TAC[BIJ]; + WITH_FIRST (MATCH_MP homeo_bij); + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE2;]; + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + REWRITE_TAC[INJ;SURJ]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]); + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + UND 6; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let component_reflA = prove_by_refinement( + `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==> + (IMAGE (reflAf r) (component (ctop G) x) = + (component (ctop (IMAGE2 (reflAf r) G)) (reflAf r x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC component_homeo; + ASM_REWRITE_TAC[]; + TYPE_THEN `ctop (IMAGE2 (reflAf r) G) = IMAGE2 (reflAf r) (ctop G)` SUBGOAL_TAC ; + ASM_MESON_TAC[ctop_reflA]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC homeomorphism_subset; + TYPE_THEN `top2` EXISTS_TAC; + TYPE_THEN `top2` EXISTS_TAC; + REWRITE_TAC[reflA_homeo]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[ctop_top2]; + ]);; + (* }}} *) + +let component_reflB = prove_by_refinement( + `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==> + (IMAGE (reflBf r) (component (ctop G) x) = + (component (ctop (IMAGE2 (reflBf r) G)) (reflBf r x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC component_homeo; + ASM_REWRITE_TAC[]; + TYPE_THEN `ctop (IMAGE2 (reflBf r) G) = IMAGE2 (reflBf r) (ctop G)` SUBGOAL_TAC ; + ASM_MESON_TAC[ctop_reflB]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC homeomorphism_subset; + TYPE_THEN `top2` EXISTS_TAC; + TYPE_THEN `top2` EXISTS_TAC; + REWRITE_TAC[reflB_homeo]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[ctop_top2]; + ]);; + (* }}} *) + +let component_reflC = prove_by_refinement( + `!(f:A->B) G x. (segment G) /\ (UNIONS (ctop G) x) ==> + (IMAGE (reflCf) (component (ctop G) x) = + (component (ctop (IMAGE2 (reflCf) G)) (reflCf x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC component_homeo; + ASM_REWRITE_TAC[]; + TYPE_THEN `ctop (IMAGE2 (reflCf) G) = IMAGE2 (reflCf) (ctop G)` SUBGOAL_TAC ; + ASM_MESON_TAC[ctop_reflC]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC homeomorphism_subset; + TYPE_THEN `top2` EXISTS_TAC; + TYPE_THEN `top2` EXISTS_TAC; + REWRITE_TAC[reflC_homeo]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[ctop_top2]; + ]);; + (* }}} *) + +let subset_union_inter = prove_by_refinement( + `!(X:A->bool) A B. (X SUBSET (A UNION B) ==> + (~(X INTER A = EMPTY )) \/ (~(X INTER B = EMPTY)) \/ (X = EMPTY ))`, + (* {{{ proof *) + [ + (REWRITE_TAC [EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ; ]); + MESON_TAC[]; + ]);; + (* }}} *) + +let squ_disj = prove_by_refinement( + `!m n. ((squ m INTER squ n = {}) <=> ~(m = n))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + REWR 1; + RULE_ASSUM_TAC (REWRITE_RULE[INTER_IDEMPOT;]); + ASM_MESON_TAC[cell_nonempty;cell_rules]; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `squ m = squ n` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + ASM_MESON_TAC[cell_rules]; + ASM_REWRITE_TAC[squ_inj]; + ]);; + (* }}} *) + +(* move way up *) +let cell_clauses = prove_by_refinement( + `(!m. (~(v_edge m = EMPTY ) /\ ~(h_edge m = EMPTY ) + /\ ~(squ m = EMPTY ) /\ ~({(pointI m)} = EMPTY ))) /\ + (!m n. (v_edge m INTER {(pointI n)} = EMPTY ) /\ + ({(pointI n)} INTER v_edge m = EMPTY ) /\ + (h_edge m INTER {(pointI n)} = EMPTY ) /\ + ({(pointI n)} INTER h_edge m = EMPTY ) /\ + (squ m INTER {(pointI n)} = EMPTY ) /\ + ({(pointI n)} INTER squ m = EMPTY ) /\ + ((v_edge m INTER v_edge n = EMPTY ) <=> ~(m = n) ) /\ + ((h_edge m INTER h_edge n = EMPTY ) <=> ~(m = n) ) /\ + ((squ m INTER squ n = EMPTY ) <=> ~(m = n) ) /\ + (squ m INTER h_edge n = EMPTY ) /\ + (h_edge n INTER squ m = EMPTY ) /\ + (squ m INTER v_edge n = EMPTY ) /\ + ( v_edge n INTER squ m = EMPTY ) /\ + (h_edge m INTER v_edge n = EMPTY ) /\ + ( v_edge n INTER h_edge m = EMPTY ) /\ + (({(pointI n)} INTER {(pointI m)} = EMPTY ) <=> ~(n = m)) /\ + (({(pointI n)} = {(pointI m)} ) <=> (n = m)) /\ + ~(h_edge n = {(pointI m)}) /\ + ~(v_edge n = {(pointI m)}) /\ + ~(squ n = {(pointI m)}) /\ + ~( {(pointI m)} = h_edge n) /\ +~( {(pointI m)} = v_edge n) /\ +~( {(pointI m)} = squ n) /\ +~(h_edge m = v_edge n) /\ +((h_edge m = h_edge n) <=> (m = n)) /\ +~(h_edge m = squ n) /\ +~(v_edge m = h_edge n) /\ +((v_edge m = v_edge n) <=> (m = n)) /\ +~(v_edge m = squ n) /\ +~(squ m = h_edge n) /\ +((squ m = squ n) <=> (m = n)) /\ +~(squ m = v_edge n) /\ +~(squ m (pointI n)) /\ +~(v_edge m (pointI n)) /\ +~(h_edge m (pointI n)) /\ +((pointI n = pointI m) <=> (n = m))) `, + + (* {{{ proof *) + (let notrr = REWRITE_RULE[not_eq] in + let interc = ONCE_REWRITE_RULE[INTER_COMM] in + ([ + CONJ_TAC ; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[INTER_ACI;notrr v_edge_disj;notrr h_edge_disj;interc square_h_edge;square_h_edge;interc square_v_edge;square_v_edge;square_disj;single_inter;h_edge_inj;v_edge_inj;notrr squ_inj;INR IN_SING;hv_edgeV2; square_h_edgeV2; square_v_edgeV2;hv_edge;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2;notrr single_inter;v_edge_pointI;h_edge_pointI;square_pointI;pointI_inj;squ_disj]; + REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;]; + CONV_TAC (dropq_conv "u"); + ASM_MESON_TAC[pointI_inj]; + ])));; + (* }}} *) + +let inter_union = prove_by_refinement( + `!X A (B:A->bool). ~(X INTER (A UNION B) = EMPTY) ==> + ~(X INTER A = EMPTY) \/ ~(X INTER B = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[INTER;UNION;EMPTY_EXISTS;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let squc_v = prove_by_refinement( + `!m n. (v_edge m SUBSET squc n) ==> (n = m) \/ (n = left m)`, + (* {{{ proof *) + [ + REWRITE_TAC[squc_union;]; + REP_BASIC_TAC; + USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; + REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + KILL 0; + USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; + ASM_REWRITE_TAC[right_left]; + (* *) + ]);; + (* }}} *) + +let squc_h = prove_by_refinement( + `!m n. (h_edge m SUBSET squc n) ==> (n = m) \/ (n = down m)`, + (* {{{ proof *) + [ + REWRITE_TAC[squc_union;]; + REP_BASIC_TAC; + USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; + REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + KILL 0; + USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[right_left]; + KILL 0; + REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ; + ASM_MESON_TAC []; + (* *) + ]);; + (* }}} *) + +let component_empty = prove_by_refinement( + `!U (x:A). (topology_ U) ==> ((component U x = EMPTY) = ~(UNIONS U x))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[component ;EQ_EMPTY;]; + EQ_TAC; + REP_BASIC_TAC; + TSPEC `x` 2; + ASM_MESON_TAC[connected_sing;INR IN_SING;]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[connected]); + REP_BASIC_TAC; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let image_imp = prove_by_refinement( + `!(f:A->B) X t. X t ==> (IMAGE f X) (f t)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let image_inj = prove_by_refinement( + `!(f:A->B) X A B. (INJ f X UNIV) /\ (A SUBSET X ) /\ (B SUBSET X) /\ + (IMAGE f A SUBSET IMAGE f B) ==> (A SUBSET B)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;IMAGE;SUBSET;]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let closure_euclid = prove_by_refinement( + `closure (top2) (euclid 2) = euclid 2`, + (* {{{ proof *) + [ + REWRITE_TAC[closure;top2]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC INTERS_SUBSET; + REWRITE_TAC[SUBSET_REFL;]; + ASM_MESON_TAC[closed_UNIV;top_of_metric_top;metric_euclid;top_of_metric_unions;]; + REWRITE_TAC[INTERS;SUBSET]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let closure_euclid = prove_by_refinement( + `!A. (A SUBSET (euclid 2) ==> (closure top2 A SUBSET (euclid 2)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC [GSYM closure_euclid]; + IMATCH_MP_TAC subset_of_closure; + ASM_REWRITE_TAC[top2_top]; + ]);; + (* }}} *) + +let along_lemma7 = prove_by_refinement( + `!G m n x e. (segment G /\ (squ n SUBSET component (ctop G) x) /\ + (v_edge m SUBSET squc n) /\ + (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==> + (?p. e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + WITH_FIRST (MATCH_MP squc_v); + FIRST_ASSUM (DISJ_CASES_TAC); + REWR 3; + IMATCH_MP_TAC along_lemma6; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWR 4; + (* 2nd side *) + REWR 4; + REWR 3; + KILL 6; + KILL 7; + TYPE_THEN `e' = IMAGE (reflAf (&:0)) e ` ABBREV_TAC ; + TYPE_THEN `G' = IMAGE2 (reflAf (&:0)) G` ABBREV_TAC ; + TYPE_THEN `x' = reflAf (&:0) x` ABBREV_TAC ; + TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC; + TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBGOAL_TAC; + USE 4(REWRITE_RULE[SUBSET]); + TYPE_THEN `~(squ (left m) = EMPTY)` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + TSPEC `u` 4; + REWR 4; + ASM_MESON_TAC[]; + TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC; + ASM_MESON_TAC[ctop_top]; + ASM_SIMP_TAC [component_empty]; + DISCH_TAC; + TYPE_THEN `component (ctop G') x' = IMAGE (reflAf (&:0)) (component (ctop G) x)` SUBGOAL_TAC; + ASM_MESON_TAC[component_reflA;]; + DISCH_TAC; + (* *) + TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC; + IMATCH_MP_TAC along_lemma6; + TYPE_THEN `reflAi (&:0) m` EXISTS_TAC; + (SUBCONJ_TAC); + (* 1st claus *) + EXPAND_TAC "G'"; + IMATCH_MP_TAC reflA_segment; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; + (* 2nd clause *) + ASM_REWRITE_TAC[]; + (* goal 2c *) + USE 4(MATCH_MP (ISPEC `reflAf (&:0)` IMAGE_SUBSET )); + TYPE_THEN `squ(reflAi (&:0) m) = IMAGE (reflAf (&:0)) (squ (left m))` SUBGOAL_TAC; + REWRITE_TAC[reflA_squ]; + AP_TERM_TAC; + REWRITE_TAC[reflAi;left ;PAIR_SPLIT; ]; + INT_ARITH_TAC; + ASM_MESON_TAC[]; + (* 3 *) + CONJ_TAC; + REWRITE_TAC[GSYM reflA_v_edge]; + EXPAND_TAC "G'"; + REWRITE_TAC[IMAGE2]; + UND 2; + (* goal 3c *) + MESON_TAC[image_imp]; + (* <2> *) + CONJ_TAC; + EXPAND_TAC "G'"; + EXPAND_TAC "e'"; + REWRITE_TAC[IMAGE2]; + ASM_MESON_TAC[image_imp]; + EXPAND_TAC "e'"; + TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) e) = IMAGE (reflAf (&:0)) (closure top2 e)` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;]; + TYPE_THEN `edge e ` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + MESON_TAC[ISUBSET;edge_euclid2;]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM reflA_pointI]; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* <1> *) + TYPE_THEN `p = left (reflAi (&:0) p')` ABBREV_TAC ; + TYPE_THEN `squ p' = IMAGE (reflAf (&:0) ) (squ p)` SUBGOAL_TAC; + ASM_REWRITE_TAC[reflA_squ;]; + AP_TERM_TAC; + EXPAND_TAC "p"; + REWRITE_TAC[left ;reflAi;PAIR_SPLIT;]; + INT_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `p` EXISTS_TAC; + (* LAST *) + ASSUME_TAC top2_top; + TYPE_THEN `homeomorphism (reflAf (&:0)) top2 top2` SUBGOAL_TAC; + ASM_MESON_TAC[reflA_homeo]; + DISCH_TAC; + ASSUME_TAC top2_unions; + TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC; + MESON_TAC[squ_euclid;top2_unions]; + DISCH_TAC; + CONJ_TAC; (* split *) + UND 12; + ASM_REWRITE_TAC[]; + EXPAND_TAC "e'"; + TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) (squ p)) = IMAGE (reflAf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* x *) + DISCH_TAC; + IMATCH_MP_TAC (ISPEC `reflAf (&:0)` image_inj); + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC INJ_UNIV; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;]; + CONJ_TAC; + TYPE_THEN `edge e ` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + MESON_TAC[ISUBSET;edge_euclid2;]; + IMATCH_MP_TAC closure_euclid; + REWRITE_TAC[squ_euclid]; + (* last'' *) + IMATCH_MP_TAC (ISPEC `reflAf (&:0)` image_inj); + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC INJ_UNIV; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;]; + CONJ_TAC; + REWRITE_TAC[squ_euclid]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; + ASM_REWRITE_TAC[component_unions;ctop_unions]; + REWRITE_TAC[DIFF;SUBSET]; + MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let v_edge_cases = prove_by_refinement( + `!j m. closure top2 (v_edge j) (pointI m) ==> (j = m) \/ (j = down m)`, + (* {{{ proof *) + [ + REWRITE_TAC[v_edge_closure;vc_edge]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[UNION;cell_clauses;INR IN_SING;plus_e12]); + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + DISJ2_TAC; + ASM_REWRITE_TAC[down;PAIR_SPLIT;]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let squ_squc = prove_by_refinement( + `!r n m. (IMAGE (reflBf r) (squ n) = squ m) ==> + (IMAGE (reflBf r) (squc n) = squc m)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[GSYM squ_closure]; + TYPE_THEN `IMAGE (reflBf r) (closure top2 (squ n)) = closure top2 (IMAGE (reflBf r) (squ n))` SUBGOAL_TAC; + IMATCH_MP_TAC homeo_closure; + ASM_REWRITE_TAC[top2_top;top2_unions;reflB_homeo;squ_euclid;]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let squ_squc_C = prove_by_refinement( + `!n m. (IMAGE (reflCf) (squ n) = squ m) ==> + (IMAGE (reflCf) (squc n) = squc m)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[GSYM squ_closure]; + TYPE_THEN `IMAGE (reflCf) (closure top2 (squ n)) = closure top2 (IMAGE (reflCf) (squ n))` SUBGOAL_TAC; + IMATCH_MP_TAC homeo_closure; + ASM_REWRITE_TAC[top2_top;top2_unions;reflC_homeo;squ_euclid;]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let along_lemma8 = prove_by_refinement( + `!G m n j x e. (segment G /\ (squ n SUBSET component (ctop G) x) /\ + (v_edge j SUBSET squc n) /\ (closure top2 (v_edge j) (pointI m)) /\ + (G (v_edge j)) /\ G e /\ (closure top2 e (pointI m)) ==> + (?p. e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE_FIRST (MATCH_MP v_edge_cases); + FIRST_ASSUM (DISJ_CASES_TAC); + IMATCH_MP_TAC along_lemma7; + ASM_MESON_TAC[]; + KILL 3; + REWR 4; + REWR 2; + KILL 7; + (* INSERT lemmas here *) + TYPE_THEN `e' = IMAGE (reflBf (&:0)) e ` ABBREV_TAC ; + TYPE_THEN `G' = IMAGE2 (reflBf (&:0)) G` ABBREV_TAC ; + TYPE_THEN `x' = reflBf (&:0) x` ABBREV_TAC ; + TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC; + TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBGOAL_TAC; + USE 5(REWRITE_RULE[SUBSET]); + TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC; + ASM_MESON_TAC[ctop_top]; + ASM_SIMP_TAC [component_empty]; + DISCH_TAC; + TYPE_THEN `component (ctop G') x' = IMAGE (reflBf (&:0)) (component (ctop G) x)` SUBGOAL_TAC; + ASM_MESON_TAC[component_reflB;]; + DISCH_TAC; + (* gok to here *) + TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC; + IMATCH_MP_TAC along_lemma7; + TYPE_THEN `(reflBi (&:0)) m` EXISTS_TAC; + TYPE_THEN `down (reflBi (&:0) n)` EXISTS_TAC; + (SUBCONJ_TAC); + (* 1st claus *) + EXPAND_TAC "G'"; + IMATCH_MP_TAC reflB_segment; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; + (* 2nd clause *) + ASM_REWRITE_TAC[GSYM reflB_squ]; + (* goal 2c *) + IMATCH_MP_TAC (ISPEC `reflBf (&:0)` IMAGE_SUBSET ); + ASM_REWRITE_TAC[]; + (* 3 *) + TYPE_THEN `squc (down (reflBi (&:0) n)) = IMAGE (reflBf (&:0)) (squc n)` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM squ_squc); + REWRITE_TAC[reflB_squ]; + DISCH_THEN_REWRITE; (* end *) + TYPE_THEN `v_edge (reflBi (&:0) m) = IMAGE (reflBf (&:0)) (v_edge (down m))` SUBGOAL_TAC; + REWRITE_TAC[reflB_v_edge]; + AP_TERM_TAC ; + REWRITE_TAC[reflBi;down;PAIR_SPLIT ]; + INT_ARITH_TAC; + DISCH_THEN_REWRITE; + CONJ_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + ASM_REWRITE_TAC[]; + (* gok2 *) + CONJ_TAC; + EXPAND_TAC "G'"; + REWRITE_TAC[IMAGE2]; + UND 2; + (* goal 3c *) + MESON_TAC[image_imp]; + (* <2> gok1 *) + CONJ_TAC; + EXPAND_TAC "G'"; + EXPAND_TAC "e'"; + REWRITE_TAC[IMAGE2]; + ASM_MESON_TAC[image_imp]; + EXPAND_TAC "e'"; + (* 2 total *) + TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) e) = IMAGE (reflBf (&:0)) (closure top2 e)` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;]; + TYPE_THEN `edge e ` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + MESON_TAC[ISUBSET;edge_euclid2;]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM reflB_pointI]; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* <1> *) + TYPE_THEN `p = down (reflBi (&:0) p')` ABBREV_TAC ; + TYPE_THEN `squ p' = IMAGE (reflBf (&:0) ) (squ p)` SUBGOAL_TAC; + ASM_REWRITE_TAC[reflB_squ;]; + AP_TERM_TAC; + EXPAND_TAC "p"; + REWRITE_TAC[down ;reflBi;PAIR_SPLIT;]; + INT_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `p` EXISTS_TAC; + (* LAST *) + ASSUME_TAC top2_top; + TYPE_THEN `homeomorphism (reflBf (&:0)) top2 top2` SUBGOAL_TAC; + ASM_MESON_TAC[reflB_homeo]; + DISCH_TAC; + ASSUME_TAC top2_unions; + TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC; + MESON_TAC[squ_euclid;top2_unions]; + DISCH_TAC; + CONJ_TAC; (* split *) + UND 12; + ASM_REWRITE_TAC[]; + EXPAND_TAC "e'"; + TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) (squ p)) = IMAGE (reflBf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* x *) + DISCH_TAC; + IMATCH_MP_TAC (ISPEC `reflBf (&:0)` image_inj); + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC INJ_UNIV; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;]; + CONJ_TAC; + TYPE_THEN `edge e ` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + MESON_TAC[ISUBSET;edge_euclid2;]; + IMATCH_MP_TAC closure_euclid; + REWRITE_TAC[squ_euclid]; + (* last'' *) + IMATCH_MP_TAC (ISPEC `reflBf (&:0)` image_inj); + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC INJ_UNIV; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;]; + CONJ_TAC; + REWRITE_TAC[squ_euclid]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; + ASM_REWRITE_TAC[component_unions;ctop_unions]; + REWRITE_TAC[DIFF;SUBSET]; + MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let along_lemma9 = prove_by_refinement( + `!G m n e' x e. (segment G /\ (squ n SUBSET component (ctop G) x) /\ + (e' SUBSET squc n) /\ (closure top2 e' (pointI m)) /\ (edge e') /\ + (G e') /\ G e /\ (closure top2 e (pointI m)) ==> + (?p. e SUBSET closure top2 (squ p) /\ + (squ p SUBSET (component (ctop G) x))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[edge]); + REP_BASIC_TAC; + FIRST_ASSUM (DISJ_CASES_TAC); + IMATCH_MP_TAC along_lemma8; + ASM_MESON_TAC[]; + TYPE_THEN `edge e` SUBGOAL_TAC; + ASM_MESON_TAC[segment;ISUBSET]; + ASM_SIMP_TAC[]; + DISCH_TAC; + KILL 3; + REWR 4; + REWR 2; + REWR 5; + KILL 8; + (* INSERT lemmas here *) + TYPE_THEN `e' = IMAGE (reflCf) e ` ABBREV_TAC ; + TYPE_THEN `G' = IMAGE2 (reflCf) G` ABBREV_TAC ; + TYPE_THEN `x' = reflCf x` ABBREV_TAC ; + TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC; + TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBGOAL_TAC; + USE 6(REWRITE_RULE[SUBSET]); + TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC; + ASM_MESON_TAC[cell_nonempty;cell_rules]; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC; + ASM_MESON_TAC[ctop_top]; + ASM_SIMP_TAC [component_empty]; + DISCH_TAC; + TYPE_THEN `component (ctop G') x' = IMAGE (reflCf) (component (ctop G) x)` SUBGOAL_TAC; + ASM_MESON_TAC[component_reflC;]; + DISCH_TAC; + (* gok to here *) + TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC; + IMATCH_MP_TAC along_lemma8; + TYPE_THEN `(reflCi) m` EXISTS_TAC; + TYPE_THEN `(reflCi n)` EXISTS_TAC; + TYPE_THEN `reflCi m'` EXISTS_TAC; + (SUBCONJ_TAC); + (* 1st claus *) + EXPAND_TAC "G'"; + IMATCH_MP_TAC reflC_segment; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; + (* 2nd clause *) + ASM_REWRITE_TAC[GSYM reflC_squ]; + (* goal 2c *) + IMATCH_MP_TAC (ISPEC `reflCf` IMAGE_SUBSET ); + ASM_REWRITE_TAC[]; + (* 3 *) + TYPE_THEN `squc ( (reflCi n)) = IMAGE (reflCf) (squc n)` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM squ_squc_C); + REWRITE_TAC[reflC_squ]; + DISCH_THEN_REWRITE; (* end *) + TYPE_THEN `v_edge (reflCi m') = IMAGE (reflCf ) (h_edge ( m'))` SUBGOAL_TAC; + REWRITE_TAC[reflC_hv_edge]; + DISCH_THEN_REWRITE; + CONJ_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + ASM_REWRITE_TAC[]; + (* gok2 *) + (* INSERT *) + TYPE_THEN `!e. (edge e) ==> (closure top2 (IMAGE (reflCf ) e) = IMAGE (reflCf) (closure top2 e))` SUBGOAL_TAC; + DISCH_ALL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;]; + IMATCH_MP_TAC edge_euclid2; + ASM_REWRITE_TAC[]; + DISCH_TAC ; + TYPE_THEN `edge (h_edge m')` SUBGOAL_TAC; + ASM_MESON_TAC[edge]; + DISCH_TAC; + ASM_SIMP_TAC[]; + REWRITE_TAC[GSYM reflC_pointI]; + CONJ_TAC; + ASM_MESON_TAC[image_imp]; + (* to here *) + CONJ_TAC; + EXPAND_TAC "G'"; + REWRITE_TAC[IMAGE2]; + UND 2; + (* goal 3c *) + MESON_TAC[image_imp]; + (* <2> gok1 *) + CONJ_TAC; + EXPAND_TAC "G'"; + EXPAND_TAC "e'"; + REWRITE_TAC[IMAGE2]; + ASM_MESON_TAC[image_imp]; + EXPAND_TAC "e'"; + (* 2 total *) + ASM_SIMP_TAC[]; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* <1> *) + TYPE_THEN `p = reflCi p'` ABBREV_TAC ; + TYPE_THEN `squ p' = IMAGE (reflCf ) (squ p)` SUBGOAL_TAC; + ASM_REWRITE_TAC[reflC_squ;]; + AP_TERM_TAC; + EXPAND_TAC "p"; + REWRITE_TAC[reflCi_inv;PAIR_SPLIT;]; + DISCH_TAC; + TYPE_THEN `p` EXISTS_TAC; + (* LAST *) + ASSUME_TAC top2_top; + TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC; + ASM_MESON_TAC[reflC_homeo]; + DISCH_TAC; + ASSUME_TAC top2_unions; + TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC; + MESON_TAC[squ_euclid;top2_unions]; + DISCH_TAC; + TYPE_THEN `closure top2 (IMAGE (reflCf) (squ p)) = IMAGE (reflCf) (closure top2 (squ p))` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM homeo_closure); + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; (* split *) + IMATCH_MP_TAC (ISPEC `reflCf` image_inj); + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC INJ_UNIV; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;]; + CONJ_TAC; + ASM_MESON_TAC[edge_euclid2]; + CONJ_TAC; + IMATCH_MP_TAC closure_euclid; + REWRITE_TAC[squ_euclid]; + UND 21; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[reflC_squ]; + TYPE_THEN `reflCi p = p'` SUBGOAL_TAC; + EXPAND_TAC "p"; + REWRITE_TAC[reflCi_inv]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + (* last'' *) + UND 13; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC (ISPEC `reflCf` image_inj); + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC INJ_UNIV; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;]; + CONJ_TAC; + REWRITE_TAC[squ_euclid]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; + ASM_REWRITE_TAC[component_unions;ctop_unions]; + REWRITE_TAC[DIFF;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let along_lemma10 = prove_by_refinement( + `!G x. (segment G /\ ~(component (ctop G) x = EMPTY) ) ==> + inductive_set G + { e | (G e /\ (?p. (e SUBSET squc p) /\ + (squ p SUBSET component (ctop G) x)) ) } `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `S = { e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x)) ) } ` ABBREV_TAC ; + REWRITE_TAC[inductive_set]; + CONJ_TAC; + EXPAND_TAC "S"; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + CONJ_TAC; + TYPE_THEN `(?m. squ m SUBSET (component (ctop G) x))` SUBGOAL_TAC; + IMATCH_MP_TAC comp_squ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(?p e. G e /\ e SUBSET closure top2 (squ p) /\ squ p SUBSET component (ctop G) x)` SUBGOAL_TAC; + IMATCH_MP_TAC comp_squ_adj; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + UND 3; + REWRITE_TAC[EMPTY_EXISTS ]; + EXPAND_TAC "S"; + REWRITE_TAC[]; + REWRITE_TAC [squ_closure]; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[GSYM squ_closure]; + REP_BASIC_TAC; + UND 5; + EXPAND_TAC "S"; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC; + IMATCH_MP_TAC edge_inter; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + REWRITE_TAC[GSYM squ_closure]; + IMATCH_MP_TAC along_lemma9; + RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing;]); + TYPE_THEN `m` EXISTS_TAC; + TYPE_THEN `p` EXISTS_TAC; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let along_lemma11 = prove_by_refinement( + `!G x e . (segment G /\ ~(component (ctop G) x = EMPTY) /\ + (G e)) ==> + (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `S = {e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component (ctop G) x)) ) }` ABBREV_TAC ; + TYPE_THEN ` S = G` SUBGOAL_TAC; + COPY 2; + UND 4; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `inductive_set G S` SUBGOAL_TAC; + EXPAND_TAC "S"; + IMATCH_MP_TAC along_lemma10; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[inductive_set]; + EXPAND_TAC "S"; + DISCH_TAC; + USE 4 GSYM; + PROOF_BY_CONTR_TAC; + UND 0; + REWRITE_TAC[]; + ONCE_ASM_REWRITE_TAC[]; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* along_lemma11 + is essentially the proof that there are only two connected + components (because there are only two possible instantiations of p + Come back and finish the proof of the Jordan curve. *) + + +(* ------------------------------------------------------------------ *) +(* SECTION I *) +(* ------------------------------------------------------------------ *) + +(* ALL about graphs *) + +(*** JRH systematically changed (Y,X)graph to (X,Y)graph for all X and Y, + and made corresponding changes to other type annotations. + The core now alphabetically sorts the type variables in a definition. + ***) + +let (mk_graph_t,dest_graph_t) = abbrev_type + `:(A->bool)#(B->bool)#(B->(A->bool))` "graph_t";; + +let graph_vertex = jordan_def + `graph_vertex (G:(A,B)graph_t) = FST (dest_graph_t G)`;; + +let graph_edge = jordan_def + `graph_edge (G:(A,B)graph_t) = part1 (dest_graph_t G)`;; + +let graph_inc = jordan_def + `graph_inc (G:(A,B)graph_t) = drop1 (dest_graph_t G)`;; + +let graph = jordan_def `graph (G:(A,B)graph_t) <=> + (IMAGE (graph_inc G) (graph_edge G)) SUBSET + { s | (s SUBSET (graph_vertex G)) /\ (s HAS_SIZE 2) }`;; + +let graph_incident = jordan_def `graph_incident + (G:(A,B)graph_t) e x <=> + (graph_edge G e) /\ (graph_inc G e x)`;; + +let graph_iso = jordan_def + `graph_iso f (G:(A,B)graph_t) (H:(A',B')graph_t) <=> + (?u v. (f = (u,v)) /\ (BIJ u (graph_vertex G) (graph_vertex H)) /\ + (BIJ v (graph_edge G) (graph_edge H)) /\ + (!e. (graph_edge G e) ==> + (graph_inc H (v e) = IMAGE u (graph_inc G e))))`;; + +(* specify a graph by + { {a,b}, .... } of endpoints of edges. *) + +let mk_simple_graph = jordan_def `mk_simple_graph (E:(A->bool)->bool) = + mk_graph_t + (UNIONS E, (E:(A->bool)->bool), + (\ (x:A->bool) (y:A). (x y)))`;; + +let K33 = jordan_def `K33 = mk_simple_graph + { {1,10}, {2,10}, {3,10}, + {1,20}, {2,20}, {3,20}, + {1,30}, {2,30}, {3,30} }`;; + +let graph_del = jordan_def `graph_del (G:(A,B)graph_t) V E = + mk_graph_t + ((graph_vertex G DIFF V), + (graph_edge G DIFF + (E UNION { (e:B) | ?(v:A). (V v /\ graph_incident G e v ) })), + (graph_inc G))`;; + +let graph_path = jordan_def `graph_path (G:(A,B)graph_t) f n <=> + (?v e . (f = (v,e)) /\ (INJ v { m | m <=| n } (graph_vertex G)) /\ + (INJ e { m | m <| n } (graph_edge G)) /\ + (!i. (i <| n ) ==> + (graph_inc G (e i) = {(v i), (v (SUC i))})))`;; + +let graph_cycle = jordan_def `graph_cycle (G:(A,B)graph_t) f n <=> + (?v e . (f = (v,e)) /\ (INJ v { m | m <| n } (graph_vertex G)) /\ + (INJ e { m | m <| n } (graph_edge G)) /\ + (!i. (i <| n ) ==> + (graph_inc G (e i) = {(v i), (v ((SUC i) %| (n)))})))`;; + +let graph_connected = jordan_def `graph_connected (G:(A,B)graph_t) <=> + !v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ ~(v = v') ==> + (?f n. (graph_path G f n) /\ (FST f 0 = v) /\ (FST f n = v'))`;; + +let graph_2_connected = jordan_def `graph_2_connected (G:(A,B)graph_t) <=> + (graph_connected G) /\ + (!v. (graph_vertex G v) ==> (graph_connected + (graph_del G {v} EMPTY)))`;; + +let simple_arc = jordan_def `simple_arc (U:(A->bool)->bool) C <=> + (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\ + (continuous f (top_of_metric(UNIV,d_real)) U) /\ + (INJ f { x | &.0 <= x /\ x <= &.1} (UNIONS U)))`;; + +let simple_closed_curve = jordan_def + `simple_closed_curve (U:(A->bool)->bool) C <=> + (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\ + (continuous f (top_of_metric(UNIV,d_real)) U) /\ + (INJ f { x | &.0 <= x /\ x < &.1} (UNIONS U)) /\ + (f (&.0) = f (&.1)))`;; + +let simple_polygonal_arc = jordan_def + `simple_polygonal_arc PE C <=> + (simple_arc (top_of_metric(euclid 2,d_euclid)) C) /\ + (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;; + +let simple_polygonal_curve = jordan_def + `simple_polygonal_curve PE C <=> + (simple_closed_curve (top_of_metric(euclid 2,d_euclid)) C) /\ + (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;; + +let hv_line = jordan_def + `hv_line E <=> (!e. (E e) ==> (?x y. (e = mk_line (point x) (point y)) /\ + ((FST x = FST y) \/ (SND x = SND y))))`;; + +let p_conn = jordan_def + `p_conn A x y <=> (?C. (simple_polygonal_arc hv_line C) /\ + (C SUBSET A) /\ (C x) /\ (C y))`;; + +let subf = jordan_def + `subf A (f:A->B) g x = if (A x) then (f x) else (g x)`;; + +let min_real_le = prove_by_refinement( + `!x y. (min_real x y <= x) /\ (min_real x y <= y)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + UND 0; + REAL_ARITH_TAC; + UND 0; + REAL_ARITH_TAC ; + ]);; + (* }}} *) + +let subf_lemma = prove_by_refinement( + `!X dX B (x:A). + (metric_space (X,dX)) /\ (closed_ (top_of_metric(X,dX)) B) /\ + (~(B x)) /\ (X x) ==> + (?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))`, + (* {{{ proof *) + + [ + REWRITE_TAC[closed;open_DEF ]; + REP_BASIC_TAC; + UND 2; + UND 3; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + REP_BASIC_TAC; + TYPE_THEN `(X DIFF B) x` SUBGOAL_TAC; + REWRITE_TAC[DIFF]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPEL_THEN [`X`;`dX`;`(X DIFF B)`;`x`] (fun t-> ASSUME_TAC (ISPECL t open_ball_nbd)); (* // *) + REP_BASIC_TAC; + REWR 6; + TYPE_THEN `e` EXISTS_TAC; + UND 6; + REWRITE_TAC[open_ball;SUBSET;DIFF;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_MESON_TAC[ISUBSET ;]; + ]);; + + (* }}} *) + +let subf_cont = prove_by_refinement( + `!X dX Y dY A B (f:A->B) g. + ((metric_space (X,dX)) /\ (metric_space (Y,dY)) /\ + (closed_ (top_of_metric(X,dX)) A ) /\ + (closed_ (top_of_metric(X,dX)) B ) /\ + (metric_continuous f (A,dX) (Y,dY)) /\ + (metric_continuous g (B,dX) (Y,dY)) /\ + (!x. (A x /\ B x) ==> (f x = g x))) ==> + (metric_continuous (subf A f g) (A UNION B,dX) (Y,dY))`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + RIGHT_TAC "delta"; + DISCH_TAC; + REWRITE_TAC[UNION]; + TYPE_THEN `(A x \/ ~(A x)) /\ (B x \/ (~(B x)))` (fun t-> MP_TAC (TAUT t )); + DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[GSYM DISJ_ASSOC;RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR] t)); + REP_CASES_TAC; + TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL); + TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL); + REP_BASIC_TAC; + REWR 8; + REWR 9; + TYPE_THEN `min_real delta delta'` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `A y \/ (~(A y) /\ B y)` SUBGOAL_TAC; + UND 9; + MESON_TAC[]; + DISCH_THEN DISJ_CASES_TAC; + REWRITE_TAC[subf]; + ASM_REWRITE_TAC[]; + UND 12; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 8; + (* save_goal "ss" *) + TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC; + REWRITE_TAC[min_real_le]; + REAL_ARITH_TAC; + (* 1b case *) + REWRITE_TAC[subf]; + ASM_REWRITE_TAC[]; + TYPE_THEN `f x = g x` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + UND 10; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 8; + TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC; + REWRITE_TAC[min_real_le]; + REAL_ARITH_TAC ; + (* 2nd case *) + TYPE_THEN `X x` SUBGOAL_TAC; + UND 2; + REWRITE_TAC[closed;open_DEF;SUBSET ;]; + REP_BASIC_TAC; + TSPEC `x` 8; + UND 8; + ASM_REWRITE_TAC[]; + UND 0; + SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))` SUBGOAL_TAC; + IMATCH_MP_TAC subf_lemma; + TYPE_THEN `X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL); + REP_BASIC_TAC; + REWR 4; + TYPE_THEN `min_real delta delta'` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `A y` SUBGOAL_TAC; + TYPE_THEN `~(B y) ==> A y` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 4; + TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC; + REWRITE_TAC[min_real_le]; + REAL_ARITH_TAC; + REWRITE_TAC[subf]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 4; + TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC; + REWRITE_TAC[min_real_le]; + REAL_ARITH_TAC; + (* 2 LEFT *) + TYPE_THEN `X x` SUBGOAL_TAC; + UND 3; + REWRITE_TAC[closed;open_DEF;SUBSET ;]; + REP_BASIC_TAC; + TSPEC `x` 8; + UND 8; + ASM_REWRITE_TAC[]; + UND 0; + SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(A y))))` SUBGOAL_TAC; + IMATCH_MP_TAC subf_lemma; + TYPE_THEN `X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL); + REP_BASIC_TAC; + REWR 5; + TYPE_THEN `min_real delta delta'` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `~(A y)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 5; + TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC; + REWRITE_TAC[min_real_le]; + REAL_ARITH_TAC; + REWRITE_TAC[subf]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `B y` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + UND 5; + TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC; + REWRITE_TAC[min_real_le]; + REAL_ARITH_TAC; + (* 1 LEFT *) + TYPE_THEN `&1` EXISTS_TAC; + ASM_MESON_TAC [REAL_ARITH `&0 < &1`]; + ]);; + (* }}} *) + +let p_conn_subset = prove_by_refinement( + `!A B x y. (A SUBSET B) /\ (p_conn A x y) ==> (p_conn B x y)`, + (* {{{ proof *) + [ + REWRITE_TAC[p_conn]; + REP_BASIC_TAC; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let mk_line_symm = prove_by_refinement( + `!x y. mk_line x y = mk_line y x`, + (* {{{ proof *) + [ + REWRITE_TAC[mk_line]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `(&1 - t)` EXISTS_TAC; + ONCE_REWRITE_TAC [euclid_add_comm]; + ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`]; + REP_BASIC_TAC; + TYPE_THEN `(&1 - t)` EXISTS_TAC; + ONCE_REWRITE_TAC [euclid_add_comm]; + ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`]; + ]);; + (* }}} *) + +let mk_line_sub = prove_by_refinement( + `!x y z. ( ~(x = z) /\ (mk_line x y z)) ==> + (mk_line x y = mk_line x z)`, + (* {{{ proof *) + [ + REWRITE_TAC[mk_line]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `~(t = &1)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWR 0; + UND 0; + REDUCE_TAC; + REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `s = (&1 /(&1 - t))` ABBREV_TAC; + TYPE_THEN `(t' - t)*s` EXISTS_TAC; + ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;]; + TYPE_THEN `(&1 - t) * s = &1` SUBGOAL_TAC; + EXPAND_TAC "s"; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 3; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `(t' - t) * s + (&1 - (t' - t) * s) * t = (t' - t) *((&1- t)* s) + t ` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `(&1 - (t' - t) * s)*(&1 - t) = (&1 - t) - (t' - t)*(&1-t)*s` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `((t' - t)* &1 + t = t') /\ (&1 - t - (t' - t)* &1 = (&1 - t'))`]; + (* 2nd half *) + REP_BASIC_TAC; + UND 2; + ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;]; + DISCH_THEN_REWRITE; + TYPE_THEN `t' + (&1 - t')*t` EXISTS_TAC; + TYPE_THEN `(&1 - (t' + (&1 - t') * t)) = ((&1 - t') * (&1 - t))` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let mk_line_2 = prove_by_refinement( + `!x y p q. (mk_line x y p) /\ (mk_line x y q) /\ (~(p = q)) ==> + (mk_line x y = mk_line p q)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `x = p` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC mk_line_sub; + ASM_MESON_TAC[]; + ASM_MESON_TAC[mk_line_sub;mk_line_symm]; + ]);; + (* }}} *) + +let mk_line_inter = prove_by_refinement( + `!x y p q. ~(mk_line x y = mk_line p q) ==> + (?z. (mk_line x y INTER mk_line p q) SUBSET {z} )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?z. (mk_line x y INTER mk_line p q) z)` ASM_CASES_TAC; + REP_BASIC_TAC; + TYPE_THEN `z` EXISTS_TAC; + REWRITE_TAC[INTER;SUBSET;INR IN_SING;]; + REP_BASIC_TAC; + UND 1; + REWRITE_TAC[INTER]; + REP_BASIC_TAC; + ASM_MESON_TAC[mk_line_2]; + REWRITE_TAC[SUBSET;INR IN_SING]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let mk_line_fin_inter = prove_by_refinement( + `!E. (FINITE E) /\ (!e. (E e) ==> (?x y. e = mk_line x y)) ==> + (?X. (FINITE X) /\ + (!e f z. (E e) /\ (E f) /\ ~(e = f) /\ e z /\ f z ==> (X z)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `E2 = { (e,f) | (E e) /\ (E f) /\ (~(e = f)) }` ABBREV_TAC; + TYPE_THEN `EE = { (e,f) | (E e) /\ (E f) }` ABBREV_TAC; + (* *) + TYPE_THEN `FINITE EE` SUBGOAL_TAC; + EXPAND_TAC "EE"; + IMATCH_MP_TAC (INR FINITE_PRODUCT); + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* *) + TYPE_THEN `FINITE E2` SUBGOAL_TAC; + EXPAND_TAC "E2"; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `EE` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "EE"; + EXPAND_TAC "E2"; + REWRITE_TAC[SUBSET;]; + MESON_TAC[]; + DISCH_TAC; + (* *) + TYPE_THEN `E3 = IMAGE (\u. (FST u INTER SND u)) E2` ABBREV_TAC; + TYPE_THEN `FINITE E3` SUBGOAL_TAC; + EXPAND_TAC "E3"; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* *) + TYPE_THEN `UNIONS E3` EXISTS_TAC; + CONJ_TAC; + ASM_SIMP_TAC[FINITE_FINITE_UNIONS]; + GEN_TAC; + EXPAND_TAC "E3"; + EXPAND_TAC "E2"; + REWRITE_TAC[IMAGE]; + CONV_TAC (dropq_conv "x"); + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `e` (WITH 0 o ISPEC); + TYPE_THEN `f` (USE 0 o ISPEC); + UND 0; + UND 12; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + (* *) + TYPE_THEN `(?z. (mk_line x y INTER mk_line x' y') SUBSET {z} )` SUBGOAL_TAC; + IMATCH_MP_TAC mk_line_inter; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{z}` EXISTS_TAC; + ASM_REWRITE_TAC[FINITE_SING ]; + REP_BASIC_TAC; + EXPAND_TAC "E3"; + EXPAND_TAC "E2"; + REWRITE_TAC[IMAGE]; + REWRITE_TAC[UNIONS]; + CONV_TAC (dropq_conv "x"); + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[INTER]; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let euclid_euclid0 = prove_by_refinement( + `!n. (euclid n (euclid0))`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid0;euclid]; + ]);; + (* }}} *) + +let euclid0_point = prove_by_refinement( + `euclid0 = point(&0,&0)`, + (* {{{ proof *) + [ + REWRITE_TAC[point_split;euclid_euclid0]; + REWRITE_TAC[euclid0]; + ]);; + (* }}} *) + +let EVEN2 = prove_by_refinement( + `EVEN 0 /\ ~(EVEN 1) /\ (EVEN 2) /\ ~(EVEN 3) /\ + (EVEN 4) /\ ~(EVEN 5)`, + (* {{{ proof *) + [ + REWRITE_TAC[EVEN; ARITH_RULE `(1 = SUC 0) /\ (2 = SUC 1) /\ (3 = SUC 2) /\ (4 = SUC 3) /\ (5 = SUC 4)`]; + ]);; + (* }}} *) + +let h_seg_openball = prove_by_refinement( + `!x e e'. (&0 < e) /\ (&0 <= e') /\ (e' < e) /\ (euclid 2 x) ==> + (mk_segment x (x + e' *# e1) SUBSET + (open_ball(euclid 2,d_euclid)) x e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[open_ball;mk_segment;SUBSET;]; + REP_BASIC_TAC; + USE 4 (SYM); + UND 4; + REWRITE_TAC[GSYM euclid_add_assoc;euclid_ldistrib;GSYM euclid_rdistrib]; + REWRITE_TAC[REAL_ARITH `a + &1 - a = &1`;euclid_scale_one;euclid_scale_act]; + TYPE_THEN `x'' = (((&1 - a) * e') *# e1)` ABBREV_TAC ; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `euclid 2 x''` SUBGOAL_TAC; + EXPAND_TAC "x''"; + IMATCH_MP_TAC euclid_scale_closure; + REWRITE_TAC[e1;euclid_point]; + DISCH_TAC; + SUBCONJ_TAC; + EXPAND_TAC "x'"; + IMATCH_MP_TAC euclid_add_closure; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `!x y. d_euclid x y = d_euclid (x+euclid0) y ` SUBGOAL_TAC; + REWRITE_TAC[euclid_rzero]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + EXPAND_TAC "x'"; + ASSUME_TAC euclid_euclid0; + KILL 7; + TYPE_THEN `d_euclid (euclid_plus x euclid0) (euclid_plus x x'') = d_euclid euclid0 x''` SUBGOAL_TAC; + ASM_MESON_TAC[metric_translate_LEFT]; + DISCH_THEN_REWRITE; + EXPAND_TAC "x''"; + REWRITE_TAC[e1;point_scale]; + REDUCE_TAC; + REWRITE_TAC[euclid0_point;d_euclid_point;]; + REDUCE_TAC; + REWRITE_TAC[EXP_2;ARITH_RULE `0 *| 0 = 0`]; + REDUCE_TAC; + REWRITE_TAC[REAL_ARITH `&0 - x = --x`;REAL_POW_NEG;EVEN2]; + TYPE_THEN `&0 <= (&1 - a) * e'` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + ASM_REWRITE_TAC[]; + UND 5; + REAL_ARITH_TAC; + ASM_SIMP_TAC[POW_2_SQRT;]; + DISCH_TAC; + ASM_CASES_TAC `a = &0`; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(&1 - a) * e' < &1 * e ==> (&1 - a) * e' < e` SUBGOAL_TAC; + REAL_ARITH_TAC; + DISCH_THEN IMATCH_MP_TAC ; + IMATCH_MP_TAC REAL_LT_MUL2; + ASM_REWRITE_TAC[]; + UND 5; + UND 6; + UND 11; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let openball_convex = prove_by_refinement( + `!x e n. (convex (open_ball (euclid n,d_euclid) x e))`, + (* {{{ proof *) + [ + REWRITE_TAC[convex;open_ball;SUBSET;mk_segment;]; + REP_BASIC_TAC; + USE 0 SYM; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + EXPAND_TAC "x''"; + IMATCH_MP_TAC (euclid_add_closure); + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); + DISCH_TAC; + TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC; + REWRITE_TAC[trivial_lin_combo]; + DISCH_THEN_REWRITE; + EXPAND_TAC "x''"; + (* special case *) + ASM_CASES_TAC `a = &0` ; + UND 10; + DISCH_THEN_REWRITE; + REDUCE_TAC; + ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;]; + TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u < a*e) /\ (v <= (&1- a)*e)) ==> (d < e))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `u + v < (a*e) + (&1 - a)*e` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_LTE_ADD2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`]; + UND 13; + REAL_ARITH_TAC ; + DISCH_THEN IMATCH_MP_TAC ; + TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC; + TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC; + TYPE_THEN `d_euclid z x''` EXISTS_TAC; + TYPE_THEN `euclid n z` SUBGOAL_TAC; + EXPAND_TAC "z"; + IMATCH_MP_TAC (euclid_add_closure); + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); + DISCH_TAC; + CONJ_TAC; + EXPAND_TAC "x''"; + IMATCH_MP_TAC metric_space_triangle; + TYPE_THEN `euclid n` EXISTS_TAC; + REWRITE_TAC[metric_euclid]; + ASM_REWRITE_TAC[trivial_lin_combo]; + CONJ_TAC; + EXPAND_TAC "z"; + TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid (a *# x) (a *# x') ` SUBGOAL_TAC; + IMATCH_MP_TAC metric_translate; + TYPE_THEN `n` EXISTS_TAC; + REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); + DISCH_THEN_REWRITE; + TYPE_THEN `d_euclid (a *# x) (a *# x') = abs (a) * d_euclid x x'` SUBGOAL_TAC; + IMATCH_MP_TAC norm_scale_vec; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `abs a = a` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ABS_REFL]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC REAL_PROP_LT_LMUL; + ASM_REWRITE_TAC[]; + UND 10; + UND 2; + REAL_ARITH_TAC; + (* LAST case *) + EXPAND_TAC "z"; + EXPAND_TAC "x''"; + TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_translate_LEFT; + TYPE_THEN `n` EXISTS_TAC; + REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); + DISCH_THEN_REWRITE; + TYPE_THEN `!b. d_euclid (b *# x) (b *# y) = abs (b) * d_euclid x y` SUBGOAL_TAC; + GEN_TAC; + IMATCH_MP_TAC norm_scale_vec; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `abs (&1 - a) = (&1 - a)` SUBGOAL_TAC; + REWRITE_TAC [REAL_ABS_REFL]; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 1; + REAL_ARITH_TAC; + UND 3; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let openball_mk_segment_end = prove_by_refinement( + `!x e n u v. + (open_ball(euclid n,d_euclid) x e u) /\ + (open_ball(euclid n,d_euclid) x e v) ==> + (mk_segment u v SUBSET (open_ball(euclid n,d_euclid) x e))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC openball_convex; + TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL); + USE 2 (REWRITE_RULE[convex]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let euclid_eq_minus = prove_by_refinement( + `!x y. (x = y) <=> (euclid_minus x y = euclid0)`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid_minus;euclid0]; + REP_BASIC_TAC; + EQ_TAC ; + DISCH_THEN_REWRITE; + REDUCE_TAC; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + ONCE_REWRITE_TAC [REAL_ARITH `(a = b) <=> (a - b = &0)`]; + GEN_TAC; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x':num`)); + BETA_TAC ; + MESON_TAC[]; + ]);; + (* }}} *) + +let euclid_plus_pair = prove_by_refinement( + `!x y u v. (euclid_plus (x + y) (u + v) = (x + u) + (y + v))`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid_plus]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + BETA_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let euclid_minus_scale = prove_by_refinement( + `!x y. (euclid_minus x y = euclid_plus x ((-- &.1) *# y))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + BETA_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let euclid_scale_cancel = prove_by_refinement( + `!t x y . (~(t = &0)) /\ (t *# x = t *# y) ==> (x = y)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x':num`)); + REWRITE_TAC[euclid_scale;]; + ASM_MESON_TAC[REAL_MUL_LTIMES]; + ]);; + (* }}} *) + +let mk_segment_inj_image = prove_by_refinement( + `!x y n. (euclid n x) /\ (euclid n y) /\ ~(x = y) ==> (?f. + (continuous f + (top_of_metric(UNIV,d_real)) + (top_of_metric (euclid n,d_euclid))) /\ + (INJ f {x | &0 <= x /\ x <= &1} (euclid n)) /\ + (IMAGE f {t | &.0 <=. t /\ t <=. &.1} = mk_segment x y))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC cont_mk_segment; + ASM_REWRITE_TAC[]; + REWRITE_TAC[joinf;IMAGE ]; + REWRITE_TAC[mk_segment]; + CONJ_TAC; + (* new stuff *) + REWRITE_TAC[INJ]; + CONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; + UND 4; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_CASES_TAC `x' < &1`; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC euclid_add_closure; + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 3; + TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `~(y' < &0)` SUBGOAL_TAC; + UND 5; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC; + TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC; + UND 6; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(x' < &1)` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; + DISCH_THEN_REWRITE; + + TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC; + TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC; + UND 4; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(y' < &1)` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; + DISCH_THEN_REWRITE; + (* th *) + ONCE_REWRITE_TAC [euclid_eq_minus]; + REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act]; + ONCE_REWRITE_TAC [euclid_plus_pair]; + REWRITE_TAC[GSYM euclid_rdistrib]; + REDUCE_TAC; + REWRITE_TAC[REAL_ARITH `x' + -- &1 * y' = x' - y'`]; + REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`]; + REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus]; + (* th1 *) + DISCH_TAC; + PROOF_BY_CONTR_TAC; + UND 2; + REWRITE_TAC[]; + IMATCH_MP_TAC euclid_scale_cancel; + TYPE_THEN `(x' - y')` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 8; + REAL_ARITH_TAC; + KILL 2; + (* old stuff *) + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + ASM_REWRITE_TAC[]; + EQ_TAC; + DISCH_TAC; + CHO 2; + UND 2; + COND_CASES_TAC; + DISCH_ALL_TAC; + JOIN 3 2; + ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`]; + DISCH_ALL_TAC; + UND 5; + COND_CASES_TAC; + DISCH_TAC; + TYPE_THEN `&1 - x''` EXISTS_TAC; + SUBCONJ_TAC; + UND 5; + REAL_ARITH_TAC ; + DISCH_TAC; + CONJ_TAC; + UND 3; + REAL_ARITH_TAC ; + ONCE_REWRITE_TAC [euclid_add_comm]; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + CONJ_TAC; + REAL_ARITH_TAC ; + CONJ_TAC; + REAL_ARITH_TAC ; + REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; + (* 2nd half *) + DISCH_TAC; + CHO 2; + TYPE_THEN `&1 - a` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + AND 2; + AND 2; + UND 3; + UND 4; + REAL_ARITH_TAC ; + COND_CASES_TAC; + ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`]; + COND_CASES_TAC; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; + ASM_MESON_TAC [euclid_add_comm]; + TYPE_THEN `a = &.0` SUBGOAL_TAC; + UND 4; + UND 3; + AND 2; + UND 3; + REAL_ARITH_TAC ; + DISCH_TAC; + REWR 2; + REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; + ]);; + + (* }}} *) + +let h_simple_polygonal = prove_by_refinement( + `!x e. (euclid 2 x) /\ (~(e = &0)) ==> + (simple_polygonal_arc hv_line (mk_segment x (x + e *# e1)))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ]; + REP_BASIC_TAC; + CONJ_TAC; + ASSUME_TAC mk_segment_inj_image; + TYPEL_THEN [`x`;`x + (e *# e1)`;`2`] (USE 2 o ISPECL); + TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e1)) /\ ~(x = euclid_plus x (e *# e1))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC euclid_add_closure; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC euclid_scale_closure; + REWRITE_TAC [e1;euclid_point]; + REP_BASIC_TAC; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `0`)); + REWRITE_TAC[euclid_plus;euclid_scale;e1;coord01]; + UND 0; + REAL_ARITH_TAC; + DISCH_TAC; + REWR 2; + REP_BASIC_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SIMP_TAC [GSYM top_of_metric_unions;metric_euclid]; + ASM_REWRITE_TAC[]; + (* E *) + USE 1 (MATCH_MP point_onto); + REP_BASIC_TAC; + TYPE_THEN `{(mk_line (point p) (point p + (e *# e1)))}` EXISTS_TAC; + REWRITE_TAC[INR IN_SING]; + CONJ_TAC; + REWRITE_TAC[e1;ISUBSET;mk_segment;mk_line]; + REP_BASIC_TAC; + TYPE_THEN `a` EXISTS_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[FINITE_SING]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + TYPE_THEN `(FST p + e, SND p)` EXISTS_TAC; + REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[e1;point_scale]; + REDUCE_TAC; + TYPE_THEN `euclid_plus (point p) (point (e,&0)) = euclid_plus (point (FST p,SND p)) (point (e,&0))` SUBGOAL_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]); + REWRITE_TAC[point_add]; + REDUCE_TAC; + ]);; + (* }}} *) + +let pconn_refl = prove_by_refinement( + `!A x. (top2 A) /\ (A x) ==> (p_conn A x x)`, + (* {{{ proof *) + [ + REWRITE_TAC[p_conn;top2]; + REP_BASIC_TAC; + TYPE_THEN `?e. (&0 < e) /\ (open_ball(euclid 2,d_euclid) x e SUBSET A)` SUBGOAL_TAC; + ASM_MESON_TAC[open_ball_nbd;metric_euclid]; + REP_BASIC_TAC; + TYPE_THEN `mk_segment x (x + (e/(&2))*# e1)` EXISTS_TAC; + TYPE_THEN `euclid 2 x` SUBGOAL_TAC; + USE 1(MATCH_MP sub_union); + UND 1; + ASM_MESON_TAC [top_of_metric_unions;metric_euclid;ISUBSET]; + DISCH_TAC; + TYPE_THEN `~(e/(&2) = &0)` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `(&0 < x) ==> (~(x = &0))` ); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + DISCH_TAC; + CONJ_TAC; + IMATCH_MP_TAC h_simple_polygonal; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `open_ball (euclid 2,d_euclid) x e ` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC h_seg_openball; + ASM_REWRITE_TAC[]; + UND 3; + MESON_TAC[half_pos;REAL_ARITH `&0 < x ==> &0 <= x`]; + REWRITE_TAC[mk_segment]; + TYPE_THEN `&1` EXISTS_TAC; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one ;euclid_scale0;euclid_rzero;]; + ARITH_TAC; + ]);; + (* }}} *) + +let pconn_symm = prove_by_refinement( + `!A x y. (p_conn A x y ==> p_conn A y x)`, + (* {{{ proof *) + [ + REWRITE_TAC[p_conn;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let compose_cont = prove_by_refinement( + `!(f:A->B) (g:B->C) X dX Y dY Z dZ. + (metric_continuous f (X,dX) (Y,dY)) /\ + (metric_continuous g (Y,dY) (Z,dZ)) /\ + (IMAGE f X SUBSET Y) ==> + (metric_continuous (compose g f) (X,dX) (Z,dZ))`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + REP_BASIC_TAC; + RIGHT_TAC "delta"; + DISCH_TAC; + REWRITE_TAC[compose]; + TYPEL_THEN [`f x`;`epsilon`] (USE 1 o ISPECL); + REP_BASIC_TAC; + REWR 1; + REP_BASIC_TAC; + TYPEL_THEN [`x`;`delta`] (USE 2 o ISPECL); + REP_BASIC_TAC; + REWR 2; + REP_BASIC_TAC; + TYPE_THEN `delta'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 0 (REWRITE_RULE[IMAGE;SUBSET]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let compose_image = prove_by_refinement( + `!(f:A->B) (g:B->C) X. + (IMAGE (compose g f) X) = + (IMAGE g (IMAGE f X))`, + (* {{{ proof *) + [ + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + NAME_CONFLICT_TAC; + REWRITE_TAC[compose]; + CONV_TAC (dropq_conv "x''"); + ]);; + (* }}} *) + +let linear_cont = prove_by_refinement( + `!a b. metric_continuous (\t. t * a + (&1 - t)* b) + (UNIV,d_real) (UNIV,d_real)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + REP_BASIC_TAC; + RIGHT_TAC "delta"; + DISCH_TAC; + TYPE_THEN `a = b` ASM_CASES_TAC; + ASM_REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `!u. u + &1 - u = &1`]; + REDUCE_TAC; + ASM_REWRITE_TAC[d_real;REAL_ARITH `b - b = &0`;ABS_0;]; + TYPE_THEN `epsilon` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* snd *) + TYPE_THEN `delta = epsilon/(abs (a-b))` ABBREV_TAC; + TYPE_THEN `delta` EXISTS_TAC; + SUBCONJ_TAC; + EXPAND_TAC "delta"; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + UND 1; + REAL_ARITH_TAC; + DISCH_TAC; + REWRITE_TAC[d_real]; + REP_BASIC_TAC; + TYPE_THEN `((x * a + (&1 - x) * b) - (y * a + (&1 - y) * b)) = (x - y)*(a - b)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + TYPE_THEN `epsilon = delta * (abs (a - b))` SUBGOAL_TAC; + EXPAND_TAC "delta"; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + IMATCH_MP_TAC REAL_DIV_RMUL; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[ABS_MUL]; + IMATCH_MP_TAC REAL_PROP_LT_RMUL; + ASM_REWRITE_TAC[]; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let linear_image_gen = prove_by_refinement( + `!a b c d. (a < b) /\ (c < d) ==> + (IMAGE (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b ) + {x | c <= x /\ x <= d } = + {y | a <= y /\ y <= b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC; + UND 1; + REAL_ARITH_TAC; + TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + REP_BASIC_TAC; + ABBREV_TAC `e = &1/(d-c)`; + TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC; + GEN_TAC; + EXPAND_TAC "e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC; + EXPAND_TAC "e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + REWRITE_TAC[GSYM real_div]; + IMATCH_MP_TAC REAL_DIV_REFL; + UND 3; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `&0 < e` SUBGOAL_TAC; + EXPAND_TAC "e"; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + (* *) + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * a + ((d - x') * e) * b) ==> (a <= ((x' - c) * e) * a + ((d - x') * e) * b)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_MUL_ASSOC]; + REDUCE_TAC; + DISCH_THEN IMATCH_MP_TAC ; + ineq_le_tac `(d-c)*e*a + (d - x')*(b - a)*e = ((x' - c) * e) * a + ((d - x') * e) * b`; + TYPE_THEN `(((x' - c) * e) * a + ((d - x') * e) * b <= b*((d- c)*e)) ==> (((x' - c) * e) * a + ((d - x') * e) * b <= b)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`]; + DISCH_THEN IMATCH_MP_TAC ; + ineq_le_tac `(((x' - c) * e) * a + ((d - x') * e) * b) + (x'-c )*(b-a)*e = b * (d - c) * e`; + (* 2nd direction *) + REP_BASIC_TAC; + TYPE_THEN `x' = ((d*b - a*c) - (d -c)*x)/(b - a)` ABBREV_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `x'*(b - a) = ((d*b - a*c) - (d -c)*x)` SUBGOAL_TAC; + EXPAND_TAC "x'"; + IMATCH_MP_TAC REAL_DIV_RMUL; + UND 1; + REAL_ARITH_TAC; + DISCH_TAC; + (* sv *) + SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`; + MESON_TAC[REAL_PROP_LE_RCANCEL]; + DISCH_TAC; + CONJ_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(b - a)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ineq_le_tac `c * (b - a) + (d-c)*(b-x) = d * b - a * c - (d - c) * x`; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(b - a)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ineq_le_tac `(d * b - a * c - (d - c) * x) + (d-c)*(x-a) = d * (b - a)`; + TYPE_THEN `((x' - c) * e) * a + ((d - x') * e) * b = (d*b - c*a - x'*(b-a))*e` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `(d * b - c * a - (d * b - a * c - (d - c) * x)) = x*(d-c)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ]);; + (* }}} *) + +let linear_image_rev = prove_by_refinement( + `!a b c d. (a < b) /\ (c < d) ==> + (IMAGE (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a ) + {x | c <= x /\ x <= d } = + {y | a <= y /\ y <= b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC; + UND 1; + REAL_ARITH_TAC; + TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + REP_BASIC_TAC; + ABBREV_TAC `e = &1/(d-c)`; + TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC; + GEN_TAC; + EXPAND_TAC "e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC; + EXPAND_TAC "e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + REWRITE_TAC[GSYM real_div]; + IMATCH_MP_TAC REAL_DIV_REFL; + UND 3; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `&0 < e` SUBGOAL_TAC; + EXPAND_TAC "e"; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + (* *) + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * b + ((d - x') * e) * a) ==> (a <= ((x' - c) * e) * b + ((d - x') * e) * a)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_MUL_ASSOC]; + REDUCE_TAC; + DISCH_THEN IMATCH_MP_TAC ; + ineq_le_tac `(d-c)*e*a + (x' - c)*(b - a)*e = ((x' - c) * e) * b + ((d - x') * e) * a`; + TYPE_THEN `(((x' - c) * e) * b + ((d - x') * e) * a <= b*((d- c)*e)) ==> (((x' - c) * e) * b + ((d - x') * e) * a <= b)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`]; + DISCH_THEN IMATCH_MP_TAC ; + ineq_le_tac `(((x' - c) * e) * b + ((d - x') * e) * a) + (d - x' )*(b-a)*e = b * (d - c) * e`; + (* 2nd direction *) + REP_BASIC_TAC; + TYPE_THEN `x' = ((b*c - a*d) + (d -c)*x)/(b - a)` ABBREV_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `x'*(b - a) = ((b*c - a*d ) + (d -c)*x)` SUBGOAL_TAC; + EXPAND_TAC "x'"; + IMATCH_MP_TAC REAL_DIV_RMUL; + UND 1; + REAL_ARITH_TAC; + DISCH_TAC; + (* sv *) + SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`; + MESON_TAC[REAL_PROP_LE_RCANCEL]; + DISCH_TAC; + CONJ_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(b - a)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ineq_le_tac `c * (b - a) + (d-c)*(x-a) = b*c - a*d + (d - c) * x`; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(b - a)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ineq_le_tac `(b*c - a*d + (d - c) * x) + (d-c)*(b - x) = d * (b - a)`; + TYPE_THEN `((x' - c) * e) * b + ((d - x') * e) * a = (d*a - c*b + x'*(b-a))*e` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `(d * a - c * b + b * c - a * d + (d - c) * x) = x*(d-c)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ]);; + (* }}} *) + +let linear_inj = prove_by_refinement( + `!a b c d. (a < b) /\ (c < d) ==> + (INJ (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b ) + {x | c <= x /\ x <= d } + {y | a <= y /\ y <= b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + REP_BASIC_TAC; + ASSUME_TAC linear_image_gen; + TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL); + REWR 4; + UND 4; + REWRITE_TAC[IMAGE]; + DISCH_TAC; + FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * a + (d - x) / (d - c) * b`)); + UND 5; + REWRITE_TAC[]; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* INJ proper *) + REP_BASIC_TAC; + UND 2; + TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ; + TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC"e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + DISCH_THEN_REWRITE; + DISCH_TAC; + USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]); + UND 8; + TYPE_THEN `(((x - c) * e) * a + ((d - x) * e) * b) - (((y - c) * e) * a + ((d - y) * e) * b) = e*(b-a)*(y - x)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + REWRITE_TAC[REAL_ENTIRE]; + TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `~(e = &0)` SUBGOAL_TAC; + EXPAND_TAC"e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + REWRITE_TAC[REAL_INV_EQ_0]; + UND 0; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let linear_inj_rev = prove_by_refinement( + `!a b c d. (a < b) /\ (c < d) ==> + (INJ (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a ) + {x | c <= x /\ x <= d } + {y | a <= y /\ y <= b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + REP_BASIC_TAC; + ASSUME_TAC linear_image_rev; + TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL); + REWR 4; + UND 4; + REWRITE_TAC[IMAGE]; + DISCH_TAC; + FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * b + (d - x) / (d - c) * a`)); + UND 5; + REWRITE_TAC[]; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* INJ proper *) + REP_BASIC_TAC; + UND 2; + TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ; + TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC"e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + DISCH_THEN_REWRITE; + DISCH_TAC; + USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]); + UND 8; + TYPE_THEN `(((x - c) * e) * b + ((d - x) * e) * a) - (((y - c) * e) * b + ((d - y) * e) * a) = e*(a-b)*(y - x)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + REWRITE_TAC[REAL_ENTIRE]; + TYPE_THEN `~(a-b = &0)` SUBGOAL_TAC; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `~(e = &0)` SUBGOAL_TAC; + EXPAND_TAC"e"; + REWRITE_TAC[real_div]; + REDUCE_TAC; + REWRITE_TAC[REAL_INV_EQ_0]; + UND 0; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let comp_comp = prove_by_refinement( + `(o) = (compose:(B->C) -> ((A->B)-> (A->C))) `, + (* {{{ proof *) + [ + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[o_DEF;compose]; + ]);; + (* }}} *) + +let arc_reparameter_rev = prove_by_refinement( + `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ + INJ f {x | c <= x /\ x <= d} (euclid 2) /\ + (a < b) /\ (c < d) ==> + (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\ + INJ g {x | a <= x /\ x <= b} (euclid 2) /\ + (f d = g a) /\ (f c = g b) /\ + (!x y x' y'. (f x = g x') /\ (f y = g y') /\ + (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\ + (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==> + ((x < y) = (y' < x'))) /\ + (IMAGE f { x | c <= x /\ x <= d } = + IMAGE g { x | a <= x /\ x <= b } )))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (c) + (b - t)/(b - a) *(d) )` ABBREV_TAC ; + TYPE_THEN `g = (f o f2)` ABBREV_TAC ; + TYPE_THEN `g` EXISTS_TAC; + (* general facts *) + TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC; + MESON_TAC[metric_real;top_of_metric_unions]; + DISCH_TAC; + (* continuity *) + CONJ_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[top2]; + ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV]; + TYPE_THEN `f2 = (\t. t* (c - d + d*b - c*a)/(b - a) + (&1 - t)*(d*b-c*a)/(b - a))` SUBGOAL_TAC; + EXPAND_TAC "f2"; + IMATCH_MP_TAC EQ_EXT; + BETA_TAC; + GEN_TAC; + REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`]; + REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL]; + DISJ1_TAC ; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[linear_cont]; + (* IMAGE *) + TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC; + REWRITE_TAC[]; + EXPAND_TAC "f2"; + ASM_SIMP_TAC[linear_image_gen]; + DISCH_TAC; + TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC; + EXPAND_TAC "g"; + REWRITE_TAC[comp_comp;compose_image;]; + AP_TERM_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* INJ *) + EXPAND_TAC "g"; + REWRITE_TAC[comp_comp]; + (* XXX *) + CONJ_TAC; + IMATCH_MP_TAC (COMP_INJ); + TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC; + UND 2; + DISCH_THEN_REWRITE; + KILL 7; + ASM_REWRITE_TAC[]; + EXPAND_TAC "f2"; + IMATCH_MP_TAC linear_inj; + ASM_REWRITE_TAC[]; + (* ends *) + IMATCH_MP_TAC (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`); + CONJ_TAC; + EXPAND_TAC "f2"; + REWRITE_TAC[compose]; + REDUCE_TAC; + REWRITE_TAC[real_div;REAL_MUL_ASSOC;]; + REDUCE_TAC; + TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_MUL_RINV; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REDUCE_TAC; + (* monotone *) + REWRITE_TAC[compose]; + REP_BASIC_TAC; + TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC; + USE 7 (REWRITE_RULE[IMAGE]); + TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `y'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC; + USE 7 (REWRITE_RULE[IMAGE]); + TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x = f2 x'` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `y = f2 y'` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "f2"; + ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`]; + REWRITE_TAC[real_div]; + TYPE_THEN `e = inv(b-a)` ABBREV_TAC ; + TYPE_THEN `(((y' - a) * e) * c + ((b - y') * e) * d) - (((x' - a) * e) * c + ((b - x') * e) * d) = (x' - y')*e*(d-c)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + TYPE_THEN `&0 < e` SUBGOAL_TAC; + EXPAND_TAC"e"; + IMATCH_MP_TAC REAL_PROP_POS_INV; + UND 1; + REAL_ARITH_TAC; + TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_ASSOC]; + ASM_SIMP_TAC[REAL_PROP_POS_RMUL]; + ]);; + (* }}} *) + +let arc_reparameter_gen = prove_by_refinement( + `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ + INJ f {x | c <= x /\ x <= d} (euclid 2) /\ + (a < b) /\ (c < d) ==> + (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\ + INJ g {x | a <= x /\ x <= b} (euclid 2) /\ + (f c = g a) /\ (f d = g b) /\ + (!x y x' y'. (f x = g x') /\ (f y = g y') /\ + (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\ + (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==> + ((x < y) = (x' < y'))) /\ + (IMAGE f { x | c <= x /\ x <= d } = + IMAGE g { x | a <= x /\ x <= b } )))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (d) + (b - t)/(b - a) *(c) )` ABBREV_TAC ; + TYPE_THEN `g = (f o f2)` ABBREV_TAC ; + TYPE_THEN `g` EXISTS_TAC; + (* general facts *) + TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC; + MESON_TAC[metric_real;top_of_metric_unions]; + DISCH_TAC; + (* continuity *) + CONJ_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[top2]; + ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV]; + TYPE_THEN `f2 = (\t. t* (d - c + c*b - d*a)/(b - a) + (&1 - t)*(c*b-d*a)/(b - a))` SUBGOAL_TAC; + EXPAND_TAC "f2"; + IMATCH_MP_TAC EQ_EXT; + BETA_TAC; + GEN_TAC; + REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`]; + REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL]; + DISJ1_TAC ; + real_poly_tac; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[linear_cont]; + (* IMAGE *) + TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC; + REWRITE_TAC[]; + EXPAND_TAC "f2"; + ASM_SIMP_TAC[linear_image_rev]; + DISCH_TAC; + TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC; + EXPAND_TAC "g"; + REWRITE_TAC[comp_comp;compose_image;]; + AP_TERM_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* INJ *) + EXPAND_TAC "g"; + REWRITE_TAC[comp_comp]; + (* XXX *) + CONJ_TAC; + IMATCH_MP_TAC (COMP_INJ); + TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC; + UND 2; + DISCH_THEN_REWRITE; + KILL 7; + ASM_REWRITE_TAC[]; + EXPAND_TAC "f2"; + IMATCH_MP_TAC linear_inj_rev; + ASM_REWRITE_TAC[]; + (* ends *) + IMATCH_MP_TAC (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`); + CONJ_TAC; + EXPAND_TAC "f2"; + REWRITE_TAC[compose]; + REDUCE_TAC; + REWRITE_TAC[real_div;REAL_MUL_ASSOC;]; + REDUCE_TAC; + TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_MUL_RINV; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REDUCE_TAC; + (* monotone *) + REWRITE_TAC[compose]; + REP_BASIC_TAC; + TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC; + USE 7 (REWRITE_RULE[IMAGE]); + TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `y'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC; + USE 7 (REWRITE_RULE[IMAGE]); + TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s))); + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x = f2 x'` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `y = f2 y'` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "f2"; + ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`]; + REWRITE_TAC[real_div]; + TYPE_THEN `e = inv(b-a)` ABBREV_TAC ; + TYPE_THEN `(((y' - a) * e) * d + ((b - y') * e) * c) - (((x' - a) * e) * d + ((b - x') * e) * c) = (y' - x')*e*(d-c)` SUBGOAL_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + TYPE_THEN `&0 < e` SUBGOAL_TAC; + EXPAND_TAC"e"; + IMATCH_MP_TAC REAL_PROP_POS_INV; + UND 1; + REAL_ARITH_TAC; + TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_ASSOC]; + ASM_SIMP_TAC[REAL_PROP_POS_RMUL]; + ]);; + (* }}} *) + +let image_preimage = prove_by_refinement( + `!(f:A->B) X Y. IMAGE f (preimage X f Y) SUBSET Y`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE;SUBSET;INR in_preimage ;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let preimage_union2 = prove_by_refinement( + `!(f:A->B) A B X. (preimage X f (A UNION B)) = + (preimage X f A UNION preimage X f B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[preimage_union;image_preimage;]; + REWRITE_TAC[preimage;SUBSET;]; + MESON_TAC[]; + REWRITE_TAC[union_subset]; + REWRITE_TAC[preimage;SUBSET;UNION]; + MESON_TAC[]; + ]);; + (* }}} *) + +let union_diff = prove_by_refinement( + `!(X:A->bool) A B. (X = A UNION B) /\ (A INTER B = EMPTY) ==> + (X DIFF B = A)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + SET_TAC[]; + ]);; + (* }}} *) + +let preimage_closed = prove_by_refinement( + `!U V C (f:A->B). (continuous f U V) /\ (closed_ V C) /\ + (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==> + (closed_ U (preimage (UNIONS U) f C))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[closed;open_DEF;]; + TYPE_THEN `(UNIONS U DIFF (preimage (UNIONS U) f C)) = preimage (UNIONS U) f (UNIONS V DIFF C)` SUBGOAL_TAC; + IMATCH_MP_TAC union_diff; + REWRITE_TAC[GSYM preimage_union2]; + CONJ_TAC; + TYPE_THEN `UNIONS V DIFF C UNION C = UNIONS V` SUBGOAL_TAC; + TYPE_THEN `!P. C SUBSET P ==> (P DIFF C UNION C = P)` SUBGOAL_TAC; + SET_TAC[]; + TYPE_THEN `C SUBSET UNIONS V` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[closed;open_DEF;]; + DISCH_THEN_REWRITE; + DISCH_TAC; + DISCH_THEN (fun t-> ASM_SIMP_TAC[t]); + DISCH_THEN_REWRITE; + IMATCH_MP_TAC SUBSET_ANTISYM; + ASM_REWRITE_TAC [ subset_preimage;]; + REWRITE_TAC[preimage;SUBSET]; + MESON_TAC[]; + IMATCH_MP_TAC preimage_disjoint; + SET_TAC[]; + DISCH_THEN_REWRITE; + CONJ_TAC; + REWRITE_TAC[SUBSET;preimage]; + MESON_TAC[]; + UND 2; + REWRITE_TAC[continuous]; + DISCH_THEN IMATCH_MP_TAC ; + UND 1; + REWRITE_TAC[closed;open_DEF;]; + MESON_TAC[]; + ]);; + + (* }}} *) + +let preimage_restrict = prove_by_refinement( + `!(f:A->B) Z A B. (A SUBSET B) ==> + (preimage A f Z = A INTER preimage B f Z)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[preimage;INTER;]; + TYPE_THEN `!y. (A SUBSET B ==> (A y /\ B y <=> A y))` SUBGOAL_TAC; + MESON_TAC[ISUBSET]; + ASM_SIMP_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let continuous_delta = prove_by_refinement( + `continuous (\x. (x *# dirac_delta 0)) (top_of_metric(UNIV,d_real)) + (top_of_metric(euclid 1,d_euclid)) `, + (* {{{ proof *) + [ + TYPE_THEN `IMAGE (\x. (x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + MESON_TAC[euclid_dirac]; + ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + REP_BASIC_TAC; + RIGHT_TAC "delta"; + REP_BASIC_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_SIMP_TAC[euclid_dirac;euclid1_abs]; + REWRITE_TAC[dirac_0]; + USE 2 (REWRITE_RULE [d_real]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let continuous_neg_delta = prove_by_refinement( + `continuous (\x. ((-- x) *# dirac_delta 0)) + (top_of_metric(UNIV,d_real)) + (top_of_metric(euclid 1,d_euclid)) `, + (* {{{ proof *) + [ + TYPE_THEN `IMAGE (\x. (-- x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + MESON_TAC[euclid_dirac]; + ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + REP_BASIC_TAC; + RIGHT_TAC "delta"; + REP_BASIC_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_SIMP_TAC[euclid_dirac;euclid1_abs]; + REWRITE_TAC[dirac_0]; + USE 2 (REWRITE_RULE [d_real]); + UND 2; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let compact_max_real = prove_by_refinement( + `!(f:A->real) U K. + continuous f U (top_of_metric (UNIV,d_real)) /\ + compact U K /\ + ~(K = {}) + ==> (?x. K x /\ (!y. K y ==> f y <= f x ))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `g = (\x. (x *# dirac_delta 0)) o f` ABBREV_TAC ; + TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_max; + TYPE_THEN `U` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "g"; + REWRITE_TAC[IMAGE_o]; + TYPE_THEN `X = IMAGE f K` ABBREV_TAC ; + REWRITE_TAC[IMAGE ;SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC; + ASM_REWRITE_TAC[continuous_delta]; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + MESON_TAC[euclid_dirac]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 4; + EXPAND_TAC "g"; + REWRITE_TAC[o_DEF;dirac_0]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let compact_min_real = prove_by_refinement( + `!(f:A->real) U K. + continuous f U (top_of_metric (UNIV,d_real)) /\ + compact U K /\ + ~(K = {}) + ==> (?x. K x /\ (!y. K y ==> f x <= f y ))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `g = (\x. (-- x *# dirac_delta 0)) o f` ABBREV_TAC ; + TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_max; + TYPE_THEN `U` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "g"; + REWRITE_TAC[IMAGE_o]; + TYPE_THEN `X = IMAGE f K` ABBREV_TAC ; + REWRITE_TAC[IMAGE ;SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC; + ASM_REWRITE_TAC[continuous_neg_delta]; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + MESON_TAC[euclid_dirac]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 4; + EXPAND_TAC "g"; + REWRITE_TAC[o_DEF;dirac_0]; + ASM_MESON_TAC[REAL_ARITH `!u v. (-- u <= --v) <=> (v <= u)`]; + ]);; + (* }}} *) + +let continuous_I = prove_by_refinement( + `continuous I (top_of_metric(UNIV,d_real)) + (top_of_metric(UNIV,d_real))`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous]; + REP_BASIC_TAC; + REWRITE_TAC[preimage]; + SIMP_TAC [GSYM top_of_metric_unions;metric_real]; + REWRITE_TAC[I_DEF]; + TYPE_THEN `{x | v x} = v` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let compact_sup = prove_by_refinement( + `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==> + (?x. (X x) /\ (!y. (X y) ==> (y <= x)))`, + (* {{{ proof *) + [ + TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC; + REWRITE_TAC[I_DEF]; + DISCH_TAC; + TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t -> ONCE_REWRITE_TAC [t]); + REP_BASIC_TAC; + IMATCH_MP_TAC compact_max_real; + TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC[continuous_I]; + ]);; + (* }}} *) + +let compact_inf = prove_by_refinement( + `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==> + (?x. (X x) /\ (!y. (X y) ==> (x <= y)))`, + (* {{{ proof *) + [ + TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC; + REWRITE_TAC[I_DEF]; + DISCH_TAC; + TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t -> ONCE_REWRITE_TAC [t]); + REP_BASIC_TAC; + IMATCH_MP_TAC compact_min_real; + TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC[continuous_I]; + ]);; + (* }}} *) + +let preimage_compact = prove_by_refinement( + `!C (f:A->B) Y dY Z dZ Y0. + metric_space (Y,dY) /\ metric_space (Z,dZ) /\ + (compact (top_of_metric(Y,dY)) Y0) /\ + (continuous f (top_of_metric(Y0,dY)) + (top_of_metric(Z,dZ))) /\ + (IMAGE f Y0 SUBSET Z) /\ + (closed_ (top_of_metric(Z,dZ)) C) /\ + ~(IMAGE f Y0 INTER C = EMPTY) ==> + (compact (top_of_metric(Y,dY)) (preimage Y0 f C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `X = preimage Y0 f C` ABBREV_TAC ; + TYPE_THEN `(UNIONS (top_of_metric(Y,dY)) = Y) /\ (UNIONS(top_of_metric(Z,dZ)) = Z)` SUBGOAL_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + REP_BASIC_TAC; + TYPE_THEN `Y0 SUBSET Y` SUBGOAL_TAC; + ASM_MESON_TAC [compact;]; + DISCH_TAC; + WITH 10 (MATCH_MP preimage_restrict); + TYPEL_THEN [`f`;`C`] (USE 11 o ISPECL); + TYPE_THEN `metric_space (Y0,dY)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `closed_ (top_of_metric(Y0,dY)) X` SUBGOAL_TAC; + EXPAND_TAC "X"; + TYPE_THEN `preimage Y0 f C = preimage (UNIONS (top_of_metric(Y0,dY))) f C` SUBGOAL_TAC; + AP_THM_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC preimage_closed; + TYPE_THEN `(top_of_metric (Z,dZ))` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + TYPE_THEN `~(X = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS;]; + UND 0; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + UND 0; + REWRITE_TAC[IMAGE;INTER]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + EXPAND_TAC "X"; + REWRITE_TAC[preimage]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* next X compact in the reals , take inf X, *) + TYPE_THEN `U = top_of_metric(Y,dY)` ABBREV_TAC ; + TYPE_THEN `U0 = top_of_metric(Y0,dY)` ABBREV_TAC ; + TYPE_THEN `U00 = top_of_metric (X,dY)` ABBREV_TAC ; + TYPE_THEN `X SUBSET Y0` SUBGOAL_TAC; + EXPAND_TAC "X"; + KILL 7; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER;SUBSET;]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `induced_top U Y0 = U0` SUBGOAL_TAC; + EXPAND_TAC "U"; + EXPAND_TAC "U0"; + IMATCH_MP_TAC top_of_metric_induced; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `UNIONS U = Y` SUBGOAL_TAC; + EXPAND_TAC "U"; + ASM_SIMP_TAC [GSYM top_of_metric_unions]; + DISCH_TAC; + TYPE_THEN `compact U0 Y0` SUBGOAL_TAC; + KILL 16; + EXPAND_TAC "U0"; + ASM_SIMP_TAC[GSYM induced_compact;]; + REP_BASIC_TAC; + (* ok to here *) + TYPE_THEN `compact U0 X` SUBGOAL_TAC; + IMATCH_MP_TAC closed_compact; + TYPE_THEN `Y0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + KILL 19; + EXPAND_TAC "U0"; + IMATCH_MP_TAC top_of_metric_top; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* done WITH compac U0 X *) + TYPE_THEN `induced_top U0 X = U00` SUBGOAL_TAC; + KILL 19; + EXPAND_TAC "U0"; + EXPAND_TAC "U00"; + IMATCH_MP_TAC top_of_metric_induced; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `compact U00 X` SUBGOAL_TAC; + EXPAND_TAC "U00"; + TYPE_THEN `X SUBSET UNIONS U0` SUBGOAL_TAC; + KILL 19; + EXPAND_TAC "U0"; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + ASM_SIMP_TAC[GSYM induced_compact]; + DISCH_TAC; + TYPE_THEN `induced_top U X = U00` SUBGOAL_TAC; + KILL 19; + EXPAND_TAC "U"; + KILL 23; + EXPAND_TAC "U00"; + IMATCH_MP_TAC top_of_metric_induced; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + DISCH_TAC; + UND 24; + EXPAND_TAC "U00"; + TYPE_THEN `compact (induced_top U X) X = compact U X` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM induced_compact); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + MESON_TAC[]; + ]);; + (* }}} *) + +let preimage_compact_interval = prove_by_refinement( + `!C n f a b. + (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) + (top_of_metric(euclid n,d_euclid)) /\ + (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\ + (closed_ (top_of_metric(euclid n,d_euclid)) C) /\ + ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==> + (compact (top_of_metric(UNIV,d_real)) + (preimage {x | a <= x /\ x <= b} f C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC preimage_compact; + TYPE_THEN `(euclid n)` EXISTS_TAC; + TYPE_THEN `d_euclid` EXISTS_TAC; + ASM_REWRITE_TAC[metric_real;metric_euclid;interval_compact;]; + ]);; + (* }}} *) + +let preimage_first = prove_by_refinement( + `!C n f a b. + (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) + (top_of_metric(euclid n,d_euclid)) /\ + (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\ + (closed_ (top_of_metric(euclid n,d_euclid)) C) /\ + ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==> + (?t. (a <= t /\ t <= b) /\ (C (f t)) /\ + (!s. (a <=s /\ s < t) ==> ~(C (f s))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(compact (top_of_metric(UNIV,d_real)) (preimage {x | a <= x /\ x <= b} f C))` SUBGOAL_TAC; + IMATCH_MP_TAC preimage_compact_interval; + TYPE_THEN `n` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `~(preimage {x | a <= x /\ x <= b} f C = EMPTY)` SUBGOAL_TAC; + UND 0; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[IMAGE ;INTER;preimage]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `X = preimage {x | a <= x /\ x <= b } f C` ABBREV_TAC ; + TYPE_THEN `(?x. (X x) /\ (!y. (X y) ==> (x <= y)))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_inf; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + UND 8; + UND 7; + EXPAND_TAC "X"; + REWRITE_TAC[preimage]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TSPEC `s` 10; + REWR 10; + UND 10; + UND 12; + UND 8; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let inj_subset_domain = prove_by_refinement( + `!s s' t (f:A->B). INJ f s t /\ (s' SUBSET s) ==> INJ f s' t`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;SUBSET;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let arc_restrict = prove_by_refinement( + `!a b c d C f t t'. (c <= t /\ t < t' /\ t' <= d) /\ (a < b) /\ + (C = IMAGE f { x | c <= x /\ x <= d }) /\ + INJ f {x | c <= x /\ x <= d} (euclid 2) /\ + continuous f (top_of_metric(UNIV,d_real)) + (top_of_metric(euclid 2,d_euclid)) ==> + (?g. + (IMAGE g {x | a <= x /\ x <= b} = IMAGE f {x | t <= x /\ x <= t'}) /\ + (g a = f t) /\ (g b = f t') /\ + INJ g { x | a <= x /\ x <= b} (euclid 2) /\ + continuous g (top_of_metric(UNIV,d_real)) + (top_of_metric(euclid 2,d_euclid)))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN ` continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (a < b) /\ (t < t')` SUBGOAL_TAC; + ASM_REWRITE_TAC[top2]; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;]; + UND 4; + UND 5; + UND 6; + REAL_ARITH_TAC; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[top2]; + ]);; + + (* }}} *) + +let continuous_induced_domain = prove_by_refinement( + `!(f:A->B) U V K. (continuous f U V) /\ (K SUBSET (UNIONS U)) ==> + (continuous f (induced_top U K) V)`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous;induced_top_support;]; + REWRITE_TAC[preimage;induced_top]; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `{x | UNIONS U x /\ v (f x)}` EXISTS_TAC; + ASM_SIMP_TAC[]; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + MESON_TAC[]; + ]);; + (* }}} *) + +let inj_split = prove_by_refinement( + `!A B Z (f:A->B). (INJ f A Z) /\ (INJ f B Z) /\ + (IMAGE f A INTER IMAGE f B = EMPTY) ==> (INJ f (A UNION B) Z)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;INTER;IMAGE;UNION;]; + REP_BASIC_TAC; + CONJ_TAC; + ASM_MESON_TAC[]; + REP_GEN_TAC; + REP_BASIC_TAC; + UND 7; + UND 6; + REP_CASES_TAC; + KILL 1; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 0; + REWRITE_TAC[EQ_EMPTY]; + NAME_CONFLICT_TAC; + DISCH_TAC; + TSPEC `f y` 0; + USE 0 (REWRITE_RULE[DE_MORGAN_THM]); + ASM_MESON_TAC[]; + USE 0 (REWRITE_RULE[EQ_EMPTY]); + TSPEC `f x` 0; + ASM_MESON_TAC[]; + KILL 3; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let joinf_inj_below = prove_by_refinement( + `!(f:real->B) g a A. + (A SUBSET {x | x < a}) ==> (INJ (joinf f g a) A = INJ f A)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[joinf]; + TSPEC `z` 0; + REWR 0; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let joinf_inj_above = prove_by_refinement( + `!(f:real->B) g a A. + (A SUBSET {x | a <= x}) ==> (INJ (joinf f g a) A = INJ g A)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[joinf]; + TSPEC `z` 0; + REWR 0; + ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let joinf_image_below = prove_by_refinement( + `!(f:real->B) g a A. + (A SUBSET {x | x < a}) ==> (IMAGE (joinf f g a) A = IMAGE f A)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[joinf]; + TSPEC `z` 0; + REWR 0; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let joinf_image_above = prove_by_refinement( + `!(f:real->B) g a A. + (A SUBSET {x | a <= x}) ==> (IMAGE (joinf f g a) A = IMAGE g A)`, + (* {{{ proof *) + + [ + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[joinf]; + TSPEC `z` 0; + REWR 0; + ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let pconn_trans = prove_by_refinement( + `!A x y z. (p_conn A x y /\ p_conn A y z ==> p_conn A x z)`, + (* {{{ proof *) + [ + REWRITE_TAC[p_conn;simple_polygonal_arc;simple_arc;]; + REP_BASIC_TAC; + TYPE_THEN `C' x` ASM_CASES_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `f'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN `~(x = y)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + (* now ~( x= y) *) + TYPE_THEN `C z` ASM_CASES_TAC; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN `~(z = y)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + (* now ~( z = y) *) + TYPE_THEN `?tx. (&0 <= tx) /\ (tx <= &1) /\ (f tx = x)` SUBGOAL_TAC; + UND 10; + ASM_REWRITE_TAC[IMAGE;]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `?ty. (&0 <= ty) /\ (ty <= &1) /\ (f ty = y)` SUBGOAL_TAC; + UND 9; + ASM_REWRITE_TAC[IMAGE;]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `~(tx = ty)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + (* reparameter C *) + TYPE_THEN `?g. (g (&0) = x) /\ (g (&1) = y) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE g { x | &0 <= x /\ x <= &1 } SUBSET C` SUBGOAL_TAC; + TYPE_THEN `(tx < ty) \/ (ty < tx)` SUBGOAL_TAC; + UND 28; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `(?g. (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | tx <= x /\ x <= ty}) /\ (g (&0) = f tx) /\ (g (&1) = f ty) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; + IMATCH_MP_TAC arc_restrict; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&1` EXISTS_TAC; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;]; + UND 15; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + REP_BASIC_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + GEN_TAC; + UND 24; + UND 26; + REAL_ARITH_TAC; + TYPE_THEN `(?g. (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx}) /\ (g (&0) = f ty) /\ (g (&1) = f tx) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; + IMATCH_MP_TAC arc_restrict; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&1` EXISTS_TAC; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;]; + UND 15; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + REP_BASIC_TAC; + (* REVERSE reparameter on C XX0 *) + TYPE_THEN `(?g'. continuous g' (top_of_metric (UNIV,d_real)) (top2) /\ INJ g' {x | (&0) <= x /\ x <= (&1)} (euclid 2) /\ (g (&1) = g' (&0)) /\ (g (&0) = g' (&1)) /\ (!x y x' y'. (g x = g' x') /\ (g y = g' y') /\ ((&0) <= x /\ x <= (&1)) /\ ((&0) <= y /\ y <= (&1)) /\ ((&0) <= x' /\ x' <= (&1)) /\ ((&0) <= y' /\ y' <= (&1)) ==> ((x < y) <=> (y' < x'))) /\ (IMAGE g { x | (&0) <= x /\ x <= (&1) } = IMAGE g' { x | (&0) <= x /\ x <= (&1) } ))` SUBGOAL_TAC; + IMATCH_MP_TAC arc_reparameter_rev; + ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;top2;]; + REP_BASIC_TAC; + TYPE_THEN `g'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[]; (* L80 *) + CONJ_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[top2]; + TYPE_THEN `IMAGE g' {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx }` SUBGOAL_TAC; + UND 34; + UND 35; + alpha_tac; + MESON_TAC[]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + UND 23; + UND 27; + REAL_ARITH_TAC; + REP_BASIC_TAC; + (* now restrict C to [x,y'] *) + (* rC *) + TYPE_THEN `Cg = IMAGE g {x | &0 <= x /\ x <= &1 }` ABBREV_TAC ; + TYPE_THEN `Z = Cg INTER C'` ABBREV_TAC ; + TYPE_THEN `?t'. (&0 <= t' /\ t' <= &1) /\ (Z (g t')) /\ (!s. (&0 <=s /\ s < t') ==> ~(Z (g s)))` SUBGOAL_TAC; + IMATCH_MP_TAC preimage_first; + EXISTS_TAC `2`; + (* restriction conditions *) + CONJ_TAC; + TYPE_THEN `induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1 } = top_of_metric ({x | &0 <= x /\ x <= &1 },d_real)` SUBGOAL_TAC; + ASM_SIMP_TAC[SUBSET_UNIV;metric_real;top_of_metric_induced]; + DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]); + IMATCH_MP_TAC continuous_induced_domain; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + SUBCONJ_TAC; + UND 31; + REWRITE_TAC[INJ;IMAGE;SUBSET;]; + MESON_TAC[]; + DISCH_TAC; + CONJ_TAC; + (* rC2 *) + TYPE_THEN `!C. (?f a b. (continuous f (top_of_metric(UNIV,d_real)) (top2)) /\ (INJ f {x | a <= x /\ x <= b} (euclid 2)) /\ (IMAGE f {x | a <= x /\ x <= b} = C)) ==> (closed_ top2 C)` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC compact_closed; + ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid]; + ASM_SIMP_TAC[top_of_metric_top;metric_euclid]; + EXPAND_TAC "C''"; + IMATCH_MP_TAC image_compact; + TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;interval_compact]; + ASM_SIMP_TAC[GSYM top2]; + EXPAND_TAC "C''"; + UND 38; + REWRITE_TAC[INJ;IMAGE;SUBSET]; + MESON_TAC[]; + DISCH_TAC; + REWRITE_TAC[GSYM top2]; + EXPAND_TAC "Z"; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `g` EXISTS_TAC; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&1` EXISTS_TAC; + ASM_REWRITE_TAC[]; (* XX2 *) + ASM_SIMP_TAC[top2]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `f'` EXISTS_TAC; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&1` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[top2]; + UND 6; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + EXPAND_TAC "Z"; + REWRITE_TAC[EMPTY_EXISTS;INTER;IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `&1` EXISTS_TAC; + EXPAND_TAC "Cg"; + ASM_REWRITE_TAC[IMAGE;]; + REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC))); + EXPAND_TAC "Cg"; (* L160 *) + (remark "LINE 160"; ALL_TAC); + REWRITE_TAC[IMAGE]; + TYPE_THEN `&1` EXISTS_TAC; + REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC))); + ASM_REWRITE_TAC[]; + UND 1; + ASM_REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + TYPE_THEN `(t' = &0) \/ (&0 < t')` SUBGOAL_TAC; + UND 39; + REAL_ARITH_TAC; + (* elim t' =0 *) + DISCH_THEN DISJ_CASES_TAC; + UND 37; + EXPAND_TAC "Z"; + REWRITE_TAC[INTER]; + ASM_MESON_TAC[]; + (* ** START ON 2nd BRANCH ** *** ** *) + (* 2b*) + TYPE_THEN `?tz. (&0 <= tz) /\ (tz <= &1) /\ (f' tz = z)` SUBGOAL_TAC; + UND 0; + ASM_REWRITE_TAC[IMAGE;]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + LEFT_TAC "tz"; + TYPE_THEN `x'` EXISTS_TAC; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `?t''. (&0 <= t'') /\ (t'' <= &1) /\ (f' t'' = g t')` SUBGOAL_TAC; + UND 37; + EXPAND_TAC "Z"; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[IMAGE;]; + DISCH_THEN (fun t-> MP_TAC (CONJUNCT2 t)); + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `~(tz = t'')` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `C (g t')` SUBGOAL_TAC; + UND 37; + EXPAND_TAC "Z"; + REWRITE_TAC[INTER]; + UND 29; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* reparam on C' *) + TYPE_THEN `?h. (h (&1/(&2)) = g t') /\ (h (&1) = z) /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE h { x | &1/(&2) <= x /\ x <= &1 } SUBSET C'` SUBGOAL_TAC; + TYPE_THEN `(t'' < tz) \/ (tz < t'')` SUBGOAL_TAC; + UND 47; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `(?h. (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | t'' <= x /\ x <= tz}) /\ (h (&1/(&2)) = f' t'') /\ (h (&1) = f' tz) /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; + IMATCH_MP_TAC arc_restrict; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&1` EXISTS_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 6; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + DISCH_TAC; + REWRITE_TAC[REAL_LT_HALF2]; + REAL_ARITH_TAC; + REP_BASIC_TAC; + TYPE_THEN `h` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + GEN_TAC; + UND 42; + UND 46; + REAL_ARITH_TAC; + TYPE_THEN `(?h. (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }) /\ (h (&1/(&2)) = f' tz) /\ (h (&1) = f' t'') /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC; + IMATCH_MP_TAC arc_restrict; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&1` EXISTS_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`]; + UND 6; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + REP_BASIC_TAC; (* L240 *) + (remark "LINE 240"; ALL_TAC); + (* REVERSE reparameter on C *) + TYPE_THEN `(?h'. continuous h' (top_of_metric (UNIV,d_real)) (top2) /\ INJ h' {x | (&1/(&2)) <= x /\ x <= (&1)} (euclid 2) /\ (h (&1) = h' (&1/(&2))) /\ (h (&1/(&2)) = h' (&1)) /\ (!x y x' y'. (h x = h' x') /\ (h y = h' y') /\ ((&1/(&2)) <= x /\ x <= (&1)) /\ ((&1/(&2)) <= y /\ y <= (&1)) /\ ((&1/(&2)) <= x' /\ x' <= (&1)) /\ ((&1/(&2)) <= y' /\ y' <= (&1)) ==> ((x < y) <=> (y' < x'))) /\ (IMAGE h { x | (&1/(&2)) <= x /\ x <= (&1) } = IMAGE h' { x | (&1/(&2)) <= x /\ x <= (&1) } ))` SUBGOAL_TAC; + IMATCH_MP_TAC arc_reparameter_rev; + ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`;top2;]; + REP_BASIC_TAC; + TYPE_THEN `h'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[top2]; + TYPE_THEN `IMAGE h' {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }` SUBGOAL_TAC; + UND 53; (* ZZZ *) + UND 54; + alpha_tac; + MESON_TAC[]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + UND 43; + UND 45; + REAL_ARITH_TAC; + REP_BASIC_TAC; + (* reparam g [0,1/2] *) + (* rg *) + TYPE_THEN `?g'. ((g' (&0)) = x) /\ (g' (&1/(&2)) = g t') /\ INJ g' { x | &0 <= x /\ x <= &1/(&2) } (euclid 2) /\ continuous g' (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ (IMAGE g' { x | &0 <= x /\ x <= &1/(&2) } = IMAGE g {x | &0 <= x /\ x <= t'}) ` SUBGOAL_TAC; (* was SUBSET Cg *) + ASSUME_TAC arc_reparameter_gen; + TYPEL_THEN [`g`;`&0`;`&1/(&2)`;`&0`;`t'`] (fun t-> FIRST_ASSUM (fun s-> (MP_TAC (ISPECL t s)))); + KILL 53; (* ZZZ *) + ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;REAL_LT_HALF1;]; + UND 30; + REWRITE_TAC[top2]; + DISCH_THEN_REWRITE; + TYPE_THEN `INJ g {x | &0 <= x /\ x <= t'} (euclid 2)` SUBGOAL_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1 }` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + UND 38; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + TYPE_THEN `g'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* deleted lines here *) + REP_BASIC_TAC; + TYPE_THEN `fm = joinf g' h (&1/(&2))` ABBREV_TAC ; + TYPE_THEN `Cm = IMAGE fm {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; + TYPE_THEN `Cm` EXISTS_TAC; + (* final instantiation *) + (* fi *) + REPEAT (IMATCH_MP_TAC (TAUT `A /\ B/\ C ==> (A /\ B) /\C`)); + CONJ_TAC; + TYPE_THEN `fm` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "fm"; + IMATCH_MP_TAC joinf_cont; + ASM_REWRITE_TAC[]; + TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + GEN_TAC; + TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC; + REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC inj_split; + EXPAND_TAC "fm"; + TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + KILL 58; + ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below;joinf_image_above;joinf_image_below]; + DISCH_TAC; + (* cases *) + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; (* L320 *) + (remark "LINE 320"; ALL_TAC); + TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2) }` EXISTS_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + CONJ_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + ASM_REWRITE_TAC[]; + TYPE_THEN `IMAGE g' { x | &0 <= x /\ x <= &1/(&2)} INTER IMAGE h {x | &1/(&2) <= x /\ x <= &1} SUBSET {(g t')}` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `IMAGE g { x | &0 <= x /\ x <= t' } SUBSET Cg` SUBGOAL_TAC; + EXPAND_TAC "Cg"; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + UND 38; + REAL_ARITH_TAC; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'} INTER Z` EXISTS_TAC; + CONJ_TAC; + EXPAND_TAC "Z"; + UND 48; + UND 60; + REWRITE_TAC[SUBSET;INTER]; + (* MESON_TAC[]; *) + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + (* LINE 350 *) + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[]; + UND 36; + REWRITE_TAC[INTER;SUBSET;IMAGE]; + UND 37; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + REWRITE_TAC[INR IN_SING]; + UND 0; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `(x' = t') \/ (x' < t')` SUBGOAL_TAC; + UND 2; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + USE 61 (REWRITE_RULE[EMPTY_EXISTS ]); + REP_BASIC_TAC; + TYPE_THEN `!B' B (u:num->real). (B' u /\ B' SUBSET B) ==> (B u)` SUBGOAL_TAC; + MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `{(g t')} u` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x <= &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET;IMAGE]; + MESON_TAC[REAL_ARITH `x < t ==> x <= t`]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INR IN_SING]; + REP_BASIC_TAC; + UND 62; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER;IMAGE;DE_MORGAN_THM;]; + DISJ1_TAC; + USE 56 SYM; + ASM_REWRITE_TAC[]; + UND 55; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + USE 1(REWRITE_RULE [REAL_ARITH `(x < &1/(&2)) <=> (x <= &1/(&2) /\ ~(x = &1/(&2)))`]); + TYPEL_THEN [`x`;`&1/(&2)`] (USE 3 o ISPECL); + TYPE_THEN `&0 <= &1/ &2 /\ &1/ &2 <= &1/ (&2)` SUBGOAL_TAC; + REWRITE_TAC[REAL_ARITH `x <= x`]; + IMATCH_MP_TAC REAL_LE_DIV; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* Now E *) (* L400 *) + (remark "LINE 400"; ALL_TAC); + (* ne *) + TYPE_THEN ` {x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + GEN_TAC; + TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC; + REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`]; + REAL_ARITH_TAC; + EXPAND_TAC "Cm"; + DISCH_THEN_REWRITE; + REWRITE_TAC[IMAGE_UNION]; + TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + EXPAND_TAC "fm"; + KILL 58; + ASM_SIMP_TAC[joinf_image_above;joinf_image_below]; + DISCH_TAC; + TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION IMAGE h {x | &1 / &2 <= x /\ x <= &1}) z` SUBGOAL_TAC; + UND 51; + REWRITE_TAC[UNION;IMAGE]; + POP_ASSUM_LIST (fun t->ALL_TAC); + REP_BASIC_TAC; + DISJ2_TAC; + TYPE_THEN `&1` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `&1 <= &1`]; + IMATCH_MP_TAC REAL_LE_LDIV; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION IMAGE h {x | &1 / &2 <= x /\ x <= &1}) x` SUBGOAL_TAC; + UND 57; + REWRITE_TAC[UNION;IMAGE]; + POP_ASSUM_LIST (fun t->ALL_TAC); + REP_BASIC_TAC; + DISJ1_TAC; + TYPE_THEN `&0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `&0 <= &0`]; + REWRITE_TAC[REAL_LT_HALF1]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + (* gh *) + UND 48; + TYPE_THEN `IMAGE g' {x | &0 <= x /\ x < &1/ &2} SUBSET C` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Cg ` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + EXPAND_TAC "Cg"; + TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'}` EXISTS_TAC; + CONJ_TAC; + USE 53 SYM; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[REAL_ARITH `x < t ==> x <= t`]; + REWRITE_TAC[IMAGE;SUBSET]; + UND 38; + MESON_TAC[REAL_ARITH `t' <= &1 ==> (x <= t' ==> x<= &1)`]; + TYPE_THEN `GCG = IMAGE g' {x | &0 <= x /\ x < &1 / &2}` ABBREV_TAC ; + TYPE_THEN `HCH = IMAGE h {x | &1 / &2 <= x /\ x <= &1}` ABBREV_TAC ; + UND 11; + UND 2; + UND 4; + UND 5; + UND 13; + UND 14; + UND 12; + UND 3; + POP_ASSUM_LIST (fun t->ALL_TAC); + REP_BASIC_TAC; + CONJ_TAC; + TYPE_THEN `E UNION E'` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[UNIONS_UNION]; + REWRITE_TAC[union_subset]; + CONJ_TAC; + UND 1; + UND 7; + REWRITE_TAC[UNION;SUBSET]; (* L480 *) + (remark "LINE 480"; ALL_TAC); + MESON_TAC[]; + UND 0; + UND 5; + REWRITE_TAC[UNION;SUBSET]; + MESON_TAC[]; + CONJ_TAC; + ASM_REWRITE_TAC[FINITE_UNION]; + UND 8; + UND 9; + REWRITE_TAC[hv_line;UNION;]; + MESON_TAC[]; + UND 1; + UND 0; + UND 2; + UND 3; + REWRITE_TAC[SUBSET;UNION;]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION J *) +(* ------------------------------------------------------------------ *) + + +(* Conclusion of Jordan Curve, page 1 *) + +let v_simple_polygonal = prove_by_refinement( + `!x e. (euclid 2 x) /\ (~(e = &0)) ==> + (simple_polygonal_arc hv_line (mk_segment x (x + e *# e2)))`, + (* {{{ proof *) + + [ + REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ]; + REP_BASIC_TAC; + CONJ_TAC; + ASSUME_TAC mk_segment_inj_image; + TYPEL_THEN [`x`;`x + (e *# e2)`;`2`] (USE 2 o ISPECL); + TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e2)) /\ ~(x = euclid_plus x (e *# e2))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC euclid_add_closure; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC euclid_scale_closure; + REWRITE_TAC [e2;euclid_point]; + REP_BASIC_TAC; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `1`)); + REWRITE_TAC[euclid_plus;euclid_scale;e2;coord01]; + UND 0; + REAL_ARITH_TAC; + DISCH_TAC; + REWR 2; + REP_BASIC_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SIMP_TAC [GSYM top_of_metric_unions;metric_euclid]; + ASM_REWRITE_TAC[]; + (* E *) + USE 1 (MATCH_MP point_onto); + REP_BASIC_TAC; + TYPE_THEN `{(mk_line (point p) (point p + (e *# e2)))}` EXISTS_TAC; + REWRITE_TAC[INR IN_SING]; + CONJ_TAC; + REWRITE_TAC[e2;ISUBSET;mk_segment;mk_line]; + REP_BASIC_TAC; + TYPE_THEN `a` EXISTS_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[FINITE_SING]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + TYPE_THEN `(FST p , SND p + e)` EXISTS_TAC; + REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[e2;point_scale]; + REDUCE_TAC; + TYPE_THEN `euclid_plus (point p) (point (&0,e)) = euclid_plus (point (FST p,SND p)) (point (&0,e))` SUBGOAL_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]); + REWRITE_TAC[point_add]; + REDUCE_TAC; + ]);; + + (* }}} *) + +let p_conn_ball = prove_by_refinement( + `! x y r. (open_ball(euclid 2,d_euclid) x r y) ==> + (p_conn (open_ball(euclid 2,d_euclid) x r) x y)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `open_ball (euclid 2,d_euclid) x r x` SUBGOAL_TAC; + SIMP_TAC [metric_euclid;INR open_ball_nonempty_center]; + REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + DISCH_TAC; + + TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[open_ball]); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + RULE_ASSUM_TAC (fun t -> try (MATCH_MP point_onto t) with Failure _ -> t); + REP_BASIC_TAC; + + TYPE_THEN `y' = point(FST p,SND p')` ABBREV_TAC ; + TYPE_THEN `A = open_ball(euclid 2,d_euclid) x r` ABBREV_TAC ; + + TYPE_THEN `y' = euclid_plus x ((SND p' - SND p) *# e2)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "y'"; + REWRITE_TAC[e2]; + REWRITE_TAC[point_add;point_scale;]; + REDUCE_TAC; + PURE_ONCE_REWRITE_TAC [GSYM PAIR]; + PURE_REWRITE_TAC [point_add]; + REWRITE_TAC[]; + REDUCE_TAC; + AP_TERM_TAC; + REWRITE_TAC[PAIR_SPLIT]; + REAL_ARITH_TAC; + DISCH_TAC; + + TYPE_THEN `A y'` SUBGOAL_TAC; + UND 0; + EXPAND_TAC "y'"; + KILL 4; + EXPAND_TAC "A"; + KILL 5; + ASM_REWRITE_TAC[open_ball;euclid_point;d_euclid_point;]; + REWRITE_TAC[REAL_ARITH `(x - x = &0)`;POW_0;ARITH_RULE `2 = SUC 1`]; + IMATCH_MP_TAC (REAL_ARITH `(x <= y) ==> (y < r ==> x < r)`); + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_ARITH `&0 + x = x`;ARITH_RULE `SUC 1 = 2`;REAL_PROP_NN_SQUARE]; + IMATCH_MP_TAC (REAL_ARITH `&0 <= x ==> (y <= x + y)`); + REWRITE_TAC[REAL_PROP_NN_SQUARE]; + DISCH_TAC; + + TYPE_THEN `p_conn A x y'` SUBGOAL_TAC; + TYPE_THEN `x = y'` ASM_CASES_TAC; + EXPAND_TAC "y'"; + IMATCH_MP_TAC pconn_refl; + REWRITE_TAC[p_conn]; + CONJ_TAC; + EXPAND_TAC "A"; + REWRITE_TAC[top2]; + IMATCH_MP_TAC open_ball_open; + MESON_TAC[metric_euclid]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[p_conn]; + TYPE_THEN `mk_segment x y'` EXISTS_TAC; + CONJ_TAC; + UND 6; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC v_simple_polygonal; + ASM_REWRITE_TAC[euclid_point]; + REWRITE_TAC[REAL_SUB_0]; + DISCH_ALL_TAC; + UND 8; + ASM_REWRITE_TAC[]; + EXPAND_TAC "y'"; + AP_TERM_TAC; + ASM_MESON_TAC[PAIR]; + CONJ_TAC; + EXPAND_TAC "A"; + IMATCH_MP_TAC openball_mk_segment_end; + ASM_MESON_TAC[]; + REWRITE_TAC[mk_segment_end]; + DISCH_TAC; + + TYPE_THEN `y' = euclid_plus y ((FST p - FST p') *# e1)` SUBGOAL_TAC; + KILL 6; + ASM_REWRITE_TAC[]; + EXPAND_TAC "y'"; + REWRITE_TAC[e1]; + REWRITE_TAC[point_add;point_scale;]; + REDUCE_TAC; + PURE_ONCE_REWRITE_TAC [GSYM PAIR]; + PURE_REWRITE_TAC [point_add]; + REWRITE_TAC[]; + REDUCE_TAC; + AP_TERM_TAC; + REWRITE_TAC[PAIR_SPLIT]; + REAL_ARITH_TAC; + DISCH_TAC; + + TYPE_THEN `p_conn A y y'` SUBGOAL_TAC; + TYPE_THEN `y = y'` ASM_CASES_TAC; + EXPAND_TAC "y'"; + IMATCH_MP_TAC pconn_refl; + CONJ_TAC; + EXPAND_TAC "A"; + REWRITE_TAC[top2]; + IMATCH_MP_TAC open_ball_open; + MESON_TAC[metric_euclid]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[p_conn]; + TYPE_THEN `mk_segment y y'` EXISTS_TAC; + CONJ_TAC; + UND 9; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC h_simple_polygonal; + ASM_REWRITE_TAC[euclid_point]; + REWRITE_TAC[REAL_SUB_0]; + DISCH_ALL_TAC; + UND 10; + KILL 6; + ASM_REWRITE_TAC[]; + EXPAND_TAC "y'"; + AP_TERM_TAC; + ASM_MESON_TAC[PAIR]; + CONJ_TAC; + EXPAND_TAC "A"; + IMATCH_MP_TAC openball_mk_segment_end; + ASM_MESON_TAC[]; + REWRITE_TAC[mk_segment_end]; + DISCH_TAC; + IMATCH_MP_TAC pconn_trans; + TYPE_THEN `y'` EXISTS_TAC; + UND 8; + DISCH_THEN_REWRITE; + UND 10; + MESON_TAC[pconn_symm]; + (* Wed Aug 4 10:40:05 EDT 2004 *) + + ]);; + + (* }}} *) + +let p_conn_euclid = prove_by_refinement( + `!A x. p_conn A x SUBSET (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;p_conn;simple_polygonal_arc;simple_arc;]; + REP_BASIC_TAC; + UND 0; + ASM_REWRITE_TAC[]; + UND 6; + SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + REWRITE_TAC[INJ;IMAGE]; + MESON_TAC[]; + (* Wed Aug 4 10:55:53 EDT 2004 *) + ]);; + (* }}} *) + +let p_connA = prove_by_refinement( + `!A x. p_conn A x SUBSET A`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[p_conn;SUBSET;]; + ASM_MESON_TAC[]; + (* Wed Aug 4 11:11:21 EDT 2004 *) + ]);; + (* }}} *) + +let p_conn_open = prove_by_refinement( + `!A x. top2 A ==> (top2 (p_conn A x))`, + (* {{{ proof *) + [ + (* Wed Aug 4 10:43:29 EDT 2004 *) + REP_BASIC_TAC; + ASM_SIMP_TAC[top2;top_of_metric_nbd;metric_euclid;p_conn_euclid]; + REP_BASIC_TAC; + + TYPE_THEN `A a` SUBGOAL_TAC; + ASM_MESON_TAC[p_connA;ISUBSET]; + DISCH_TAC; + + TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC; + ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;]; + REP_BASIC_TAC; + TYPE_THEN `r` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;]; + REP_BASIC_TAC; + IMATCH_MP_TAC pconn_trans; + TYPE_THEN `a` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC p_conn_subset; + TYPE_THEN `open_ball (euclid 2,d_euclid) a r` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC p_conn_ball; + ASM_REWRITE_TAC[]; + (* Wed Aug 4 11:21:18 EDT 2004 *) + ]);; + (* }}} *) + +let p_conn_diff = prove_by_refinement( + `!A x. top2 A ==> (top2 (A DIFF (p_conn A x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + SIMP_TAC[top2;metric_euclid;top_of_metric_nbd]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `A` EXISTS_TAC; + REWRITE_TAC[SUBSET_DIFF]; + UND 0; + REWRITE_TAC[top2;]; + DISCH_TAC; + FIRST_ASSUM (fun t-> ASSUME_TAC (MATCH_MP sub_union t)); + UND 1; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[DIFF]); + REP_BASIC_TAC; + + TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC; + ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;]; + REP_BASIC_TAC; + + TYPE_THEN `r` EXISTS_TAC; + ASM_REWRITE_TAC[DIFF_SUBSET]; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS;INTER]); + REP_BASIC_TAC; + FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP p_conn_ball t)); + TYPE_THEN `p_conn A a u` SUBGOAL_TAC; + IMATCH_MP_TAC p_conn_subset; + ASM_MESON_TAC[]; + DISCH_TAC; + UND 1; + REWRITE_TAC[]; + IMATCH_MP_TAC pconn_trans; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[pconn_symm]; + (* Wed Aug 4 12:00:13 EDT 2004 *) + ]);; + (* }}} *) + +let p_conn_conn = prove_by_refinement( + `!A x y. (top2 A /\ connected top2 A /\ A x /\ A y) ==> + (p_conn A x y)`, + (* {{{ proof *) + [ + REWRITE_TAC[connected]; + REP_BASIC_TAC; + TYPEL_THEN [`p_conn A x`;`A DIFF (p_conn A x)`] (USE 2 o ISPECL); + UND 2; + ASM_SIMP_TAC[p_conn_open;p_conn_diff]; + + TYPE_THEN `!(w:(num->real)->bool) z. (w INTER (z DIFF w) = EMPTY)` SUBGOAL_TAC; + SET_TAC[INTER;DIFF]; + DISCH_THEN_REWRITE; + + TYPE_THEN `!(x:(num->real)->bool) y. (x SUBSET (y UNION (x DIFF y)))` SUBGOAL_TAC; + SET_TAC[SUBSET;UNION;DIFF]; + DISCH_THEN_REWRITE; + + DISCH_THEN (DISJ_CASES_TAC); + ASM_MESON_TAC[ISUBSET]; + UND 2; + REWRITE_TAC[SUBSET;DIFF]; + ASM_MESON_TAC[pconn_refl]; + (* Wed Aug 4 12:42:12 EDT 2004 *) + ]);; + (* }}} *) + +let plane_graph = jordan_def + `plane_graph G <=> + graph_vertex G SUBSET (euclid 2) /\ + graph G /\ + graph_edge G SUBSET (simple_arc top2) /\ + (!e. (graph_edge G e ==> + (graph_inc G e = e INTER (graph_vertex G)))) /\ + (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e')) ==> + (e INTER e' SUBSET (graph_vertex G)))`;; + +let graph_isomorphic = jordan_def + `graph_isomorphic (G:(A,B)graph_t) (H:(A',B')graph_t) <=> + ?f. (graph_iso f G H)`;; + +let I_BIJ = prove_by_refinement( + `!(x:A->bool). BIJ I x x`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;INJ;SURJ;I_THM;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let graph_isomorphic_refl = prove_by_refinement( + `!(G:(A,B)graph_t). graph_isomorphic G G`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_isomorphic;graph_iso;]; + REP_BASIC_TAC; + RIGHT_TAC "f"; + RIGHT_TAC "f"; + TYPE_THEN `I:A->A` EXISTS_TAC; + TYPE_THEN `I:B->B` EXISTS_TAC; + TYPE_THEN `(I:A->A,I:B->B)` EXISTS_TAC; + ASM_REWRITE_TAC[I_THM;IMAGE_I;I_BIJ]; + (* Wed Aug 4 13:08:32 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_inc_subset = prove_by_refinement( + `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e) ==> + (graph_inc G e SUBSET graph_vertex G)`, + (* {{{ proof *) + [ + REWRITE_TAC[graph;IMAGE;SUBSET;]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + USE 2 (CONV_RULE (dropq_conv "x''")); + TSPEC `e'` 2; + REWR 2; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_isomorphic_symm = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t). + graph G /\ graph_isomorphic G H ==> graph_isomorphic H G`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_isomorphic;graph_iso]; + REP_BASIC_TAC; + RIGHT_TAC "f"; + RIGHT_TAC "f"; + TYPE_THEN `u' = INV u (graph_vertex G) (graph_vertex H)` ABBREV_TAC ; + TYPE_THEN `v' = INV v (graph_edge G) (graph_edge H)` ABBREV_TAC ; + TYPE_THEN `u'` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC; + TYPE_THEN `(u',v')` EXISTS_TAC; + REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "u'"; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "v'"; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + (* LAST step *) + REP_BASIC_TAC; + TYPE_THEN `e' = v' e` ABBREV_TAC ; + + TYPE_THEN `e = v e'` SUBGOAL_TAC; + ASM_MESON_TAC [inv_comp_right]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + + TYPE_THEN `BIJ v' (graph_edge H) (graph_edge G)` SUBGOAL_TAC; + ASM_MESON_TAC[INVERSE_BIJ]; + DISCH_TAC; + + TYPE_THEN `graph_edge G e'` SUBGOAL_TAC; + EXPAND_TAC "e'"; + UND 10; + REWRITE_TAC[BIJ;SURJ;]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_SIMP_TAC[]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + EXPAND_TAC "u'"; + IMATCH_MP_TAC image_inv_image; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC graph_inc_subset; + ASM_MESON_TAC[]; + (* Wed Aug 4 13:53:24 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_isomorphic_trans = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t) (J:(A'',B'')graph_t). + graph_isomorphic G H /\ graph_isomorphic H J ==> + graph_isomorphic G J`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_isomorphic;graph_iso;]; + REP_BASIC_TAC; + KILL 3; + KILL 7; + RIGHT_TAC "f"; + RIGHT_TAC "f"; + TYPE_THEN `u' o u` EXISTS_TAC; + TYPE_THEN `v' o v` EXISTS_TAC; + TYPE_THEN `(u' o u, v' o v)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REWRITE_TAC[comp_comp]; + IMATCH_MP_TAC COMP_BIJ; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[comp_comp]; + IMATCH_MP_TAC COMP_BIJ; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE_o]; + REWRITE_TAC[o_DEF]; + + TYPE_THEN `graph_edge H (v e)` SUBGOAL_TAC; + UND 5; + REWRITE_TAC[BIJ;SURJ]; + UND 3; + MESON_TAC[]; + ASM_SIMP_TAC[]; + (* Wed Aug 4 14:13:25 EDT 2004 *) + ]);; + (* }}} *) + +let graph_isomorphic_graph = prove_by_refinement( + `!(G:(A,B)graph_t) H. + graph G /\ graph_isomorphic G (H:(A',B')graph_t) ==> graph H`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `!z. (graph_edge G z ==> graph_inc G z SUBSET graph_vertex G)` SUBGOAL_TAC; + ASM_MESON_TAC[graph_inc_subset]; + DISCH_TAC; + UND 0; + UND 1; + REWRITE_TAC[graph;graph_isomorphic;graph_iso]; + REP_BASIC_TAC; + REWRITE_TAC[SUBSET;IMAGE;]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + REP_BASIC_TAC; + TYPE_THEN `?y'. (graph_edge G y' /\ (v y' = x'))` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[BIJ;SURJ]; + UND 6; + MESON_TAC[]; + REP_BASIC_TAC; + + TYPE_THEN `graph_inc H x' = IMAGE u (graph_inc G y')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + + TYPE_THEN `graph_inc G y' SUBSET graph_vertex G` SUBGOAL_TAC; + ASM_SIMP_TAC[]; + DISCH_TAC; + KILL 2; + + SUBCONJ_TAC; + ASM_REWRITE_TAC[IMAGE]; + UND 10; + UND 3; + REWRITE_TAC[BIJ;SURJ]; + MESON_TAC[ISUBSET]; + DISCH_TAC; + + (* has size *) + TYPE_THEN `(graph_inc G y') HAS_SIZE 2` SUBGOAL_TAC; + UND 5; + REWRITE_TAC[SUBSET;IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + UND 8; + MESON_TAC[]; + DISCH_TAC; + + + ASM_REWRITE_TAC[]; + REWRITE_TAC[HAS_SIZE]; + SUBCONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_MESON_TAC[HAS_SIZE]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); + REP_BASIC_TAC; + UND 11; + DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]); + IMATCH_MP_TAC CARD_IMAGE_INJ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 3; + REWRITE_TAC[BIJ;INJ]; + REP_BASIC_TAC; + ASM_MESON_TAC[ISUBSET]; + (* Wed Aug 4 15:18:06 EDT 2004 *) + ]);; + + (* }}} *) + +let planar_graph = jordan_def + `planar_graph (G:(A,B)graph_t) <=> + (?H. (plane_graph H) /\ (graph_isomorphic H G))`;; + +let plane_planar = prove_by_refinement( + `!G. (plane_graph G) ==> (planar_graph G)`, + (* {{{ proof *) + + [ + REWRITE_TAC[planar_graph]; + REP_BASIC_TAC; + ASM_MESON_TAC[graph_isomorphic_refl]; + ]);; + + (* }}} *) + +let planar_is_graph = prove_by_refinement( + `!(G:(A,B)graph_t). (planar_graph G ==> graph G)`, + (* {{{ proof *) + + [ + REWRITE_TAC[planar_graph;plane_graph]; + REP_BASIC_TAC; + ASM_MESON_TAC[graph_isomorphic_graph]; + ]);; + + (* }}} *) + +let planar_iso = prove_by_refinement( + `!G H. (planar_graph (G:(A,B)graph_t)) /\ (graph_isomorphic G H) ==> + (planar_graph (H:(A',B')graph_t))`, + (* {{{ proof *) + [ + REWRITE_TAC[planar_graph]; + REP_BASIC_TAC; + TYPE_THEN `H'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + JOIN 1 0; + USE 0 (MATCH_MP graph_isomorphic_trans); + ASM_REWRITE_TAC[]; + (* Wed Aug 4 15:41:05 EDT 2004 *) + + ]);; + (* }}} *) + +(* almost the same ans num_MAX . The minimization is num_WOP. *) +let select_num_max = prove_by_refinement( + `!Y. FINITE Y /\ (~(Y= EMPTY)) ==> + (?z. (Y z /\ (!y. Y y ==> y <=| z)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `f = \ (t:num). --. (&. t)` ABBREV_TAC ; + TYPE_THEN `Z = IMAGE f Y` ABBREV_TAC ; + TYPE_THEN `FINITE Z /\ ~(Z = {})` SUBGOAL_TAC; + EXPAND_TAC "Z"; + CONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + UND 0; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `f u` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 4 (MATCH_MP min_finite); + REP_BASIC_TAC; + TYPE_THEN `?z. Y z /\ (f z = delta)` SUBGOAL_TAC; + UND 5; + EXPAND_TAC "Z"; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(f z <= f y) ==> (y <=| z)` SUBGOAL_TAC; + EXPAND_TAC "f"; + REDUCE_TAC; + DISCH_THEN IMATCH_MP_TAC ; + TYPE_THEN `Z (f y)` SUBGOAL_TAC; + EXPAND_TAC "Z"; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let select_image_num_max = prove_by_refinement( + `!(X:A->bool) f. (?N. (!x. (X x ==> f x <| N))) /\ ~(X = EMPTY) ==> + (?z. (X z /\ (!x. (X x ==> f x <=| f z))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ; + TYPE_THEN `Y SUBSET {n | n <| N}` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;SUBSET;]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `FINITE Y /\ (~(Y= EMPTY))` SUBGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{n | n <| N}` EXISTS_TAC; + ASM_REWRITE_TAC[FINITE_NUMSEG_LT]; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + TYPE_THEN `f u` EXISTS_TAC; + UND 2; + UND 0; + REWRITE_TAC[IMAGE;SUBSET]; + DISCH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_MESON_TAC[]; + DISCH_TAC; + USE 4 (MATCH_MP select_num_max); + REP_BASIC_TAC; + TYPE_THEN `?r. X r /\ (f r = z)` SUBGOAL_TAC; + UND 5; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `r` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TSPEC `f x` 4; + TYPE_THEN `Y (f x)` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* Wed Aug 4 16:41:51 EDT 2004 *) + + ]);; + (* }}} *) + +let select_image_num_min = prove_by_refinement( + `!(X:A->bool) f. (~(X = EMPTY)) ==> + (?z. (X z /\ (!x. (X x ==> f z <=| f x))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + TYPE_THEN `(?n. Y n)` SUBGOAL_TAC; + TYPE_THEN `f u` EXISTS_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + DISCH_TAC; + RULE_ASSUM_TAC (ONCE_REWRITE_RULE[num_WOP]); + REP_BASIC_TAC; + TYPE_THEN `?z. (X z) /\ (f z = n)` SUBGOAL_TAC; + UND 3; + EXPAND_TAC "Y"; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TSPEC `f x` 2; + IMATCH_MP_TAC (ARITH_RULE `~(f x <| n) ==> (n <=| f x)`); + DISCH_ALL_TAC; + UND 2; + ASM_REWRITE_TAC[]; + EXPAND_TAC "Y"; + KILL 1; + ASM_REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + (* Wed Aug 4 19:37:29 EDT 2004 *) + + ]);; + (* }}} *) + +let select_card_max = prove_by_refinement( + `!(X:(A->bool)->bool). (~(X = EMPTY) /\ (FINITE (UNIONS X))) ==> + (?z. (X z /\ (!x. (X x ==> (CARD x <= CARD z)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC select_image_num_max; + ASM_REWRITE_TAC[]; + TYPE_THEN `SUC (CARD (UNIONS X))` EXISTS_TAC; + REP_BASIC_TAC; + TYPE_THEN `x SUBSET (UNIONS X)` SUBGOAL_TAC; + IMATCH_MP_TAC sub_union; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWRITE_TAC[ARITH_RULE `(a <| SUC b) <=> (a <=| b)`]; + IMATCH_MP_TAC CARD_SUBSET; + ASM_REWRITE_TAC[]; + (* Thu Aug 5 10:50:37 EDT 2004 *) + + ]);; + (* }}} *) + +let select_card_min = prove_by_refinement( + `!(X:(A->bool)->bool). ~(X = EMPTY) ==> + (?z. (X z /\ (!x. (X x ==> (CARD z <= CARD x)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC select_image_num_min; + ASM_REWRITE_TAC[]; + (* Thu Aug 5 10:52:02 EDT 2004 *) + ]);; + (* }}} *) + +(* D embeddings of planar graphs *) + +let induced_top_interval = prove_by_refinement( + `!a b. induced_top (top_of_metric(UNIV,d_real)) + {x | a <= x /\ x <= b } = + top_of_metric ({x | a <= x /\ x <= b}, d_real) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC top_of_metric_induced; + ASM_REWRITE_TAC[SUBSET_UNIV;metric_real]; + ]);; + (* }}} *) + +let continuous_interval = prove_by_refinement( + `!f a b. (continuous f (top_of_metric(UNIV,d_real)) top2) ==> + (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) top2)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[GSYM induced_top_interval]; + IMATCH_MP_TAC continuous_induced_domain; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV ]; + ]);; + (* }}} *) + +let inj_image_subset = prove_by_refinement( + `!(f:A->B) X Y. (INJ f X Y ==> IMAGE f X SUBSET Y)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;IMAGE;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let subset_contain = prove_by_refinement( + `!a b c d. (c <= a) /\ (b <= d) ==> + {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d}`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let curve_restriction = prove_by_refinement( + `!C K K' a b. + simple_arc top2 C /\ + closed_ top2 K /\ closed_ top2 K' /\ + (C INTER K INTER K' = EMPTY) /\ + ~(C INTER K = EMPTY) /\ + ~(C INTER K' = EMPTY) /\ + (a <. b) ==> + (?C' f. (C' = IMAGE f {x | a <= x /\ x <= b}) /\ (C' SUBSET C) /\ + continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | a <= x /\ x <= b} (euclid 2) /\ + (C' INTER K = {(f a)}) /\ + (C' INTER K' = {(f b)}) + ) + `, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc]; + REP_BASIC_TAC; + ASSUME_TAC top2_unions; + (* K parameter *) + TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K (f s)))` SUBGOAL_TAC; + ASSUME_TAC preimage_first ; + TYPEL_THEN [`K`;`2`] (USE 10 o ISPECL); + FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); + KILL 10; + ASM_REWRITE_TAC[GSYM top2;]; + ASM_SIMP_TAC[continuous_interval]; + UND 2; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + REWR 6; + IMATCH_MP_TAC inj_image_subset; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* K' parameter *) + TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K' (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K' (f s)))` SUBGOAL_TAC; + ASSUME_TAC preimage_first ; + TYPEL_THEN [`K'`;`2`] (USE 14 o ISPECL); + FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); + KILL 14; + ASM_REWRITE_TAC[GSYM top2;]; + ASM_SIMP_TAC[continuous_interval]; + UND 1; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + REWR 6; + IMATCH_MP_TAC inj_image_subset; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(t < t' \/ t' < t)` SUBGOAL_TAC; + REWRITE_TAC[(REAL_ARITH `(t < t' \/ t' < t) <=> ~( t = t')`)]; + DISCH_ALL_TAC; + UND 3; + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + TYPE_THEN `(f t)` EXISTS_TAC; + REWR 11; + REWRITE_TAC[IMAGE;SUBSET]; + CONJ_TAC; + TYPE_THEN `t'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* main cases split [main] *) + ASSUME_TAC (REAL_ARITH `&0 < &1`); + DISCH_THEN (DISJ_CASES_TAC); + TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (&0 < &1) /\ (t < t') ` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + REWR 6; + ASM_REWRITE_TAC[SUBSET ]; + UND 19; + UND 16; + UND 13; + REAL_ARITH_TAC; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); + REP_BASIC_TAC; + TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; + TYPE_THEN `Ca INTER K' = {(g (&0))}` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET;INR IN_SING;]; + KILL 26; + EXPAND_TAC "Ca"; + REWRITE_TAC[IMAGE;SUBSET]; + REP_BASIC_TAC; + TYPE_THEN `x' < t' \/ (x' = t')` SUBGOAL_TAC; + UND 28; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + PROOF_BY_CONTR_TAC; + UND 26; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 29; + UND 13; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;INTER;INR IN_SING;]; + KILL 26; + EXPAND_TAC "Ca"; + REWRITE_TAC[IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + CONJ_TAC; + TYPE_THEN `t'` EXISTS_TAC; + ASM_MESON_TAC[REAL_ARITH `(t < t' ==> t<= t') /\ (t' <= t')`]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~(Ca INTER K = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `f t` EXISTS_TAC; + KILL 26; + EXPAND_TAC "Ca"; + REWRITE_TAC[IMAGE;SUBSET;]; + ASM_REWRITE_TAC[]; + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `t <= t`]; + ASM_SIMP_TAC[REAL_ARITH `(t < t') ==> (t <= t')`]; + DISCH_TAC; + KILL 21; + (* ADD Ca SUBSET C *) + TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC; + KILL 26; + EXPAND_TAC "Ca"; + KILL 20; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 21; + UND 26; + UND 13; + UND 19; + UND 16; + REAL_ARITH_TAC; + DISCH_TAC; + (* t'' parameter for g and K *) + TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K (g s)))` SUBGOAL_TAC; + ASSUME_TAC preimage_first ; + TYPEL_THEN [`K`;`2`] (USE 29 o ISPECL); + FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); + KILL 29; + ASM_REWRITE_TAC[GSYM top2;]; + ASM_SIMP_TAC[continuous_interval]; + EXPAND_TAC "Ca"; + IMATCH_MP_TAC inj_image_subset; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* set up for arc_reparameter_rev *) + TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\ INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'') ` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC; + UND 32; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET ]; + UND 31; + REAL_ARITH_TAC; + PROOF_BY_CONTR_TAC; + UND 3; + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + TYPE_THEN `g (&0)` EXISTS_TAC; + TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC; + TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC; + ASM_MESON_TAC[INTER_SUBSET]; + REWRITE_TAC[SUBSET;INR IN_SING]; + MESON_TAC[]; + DISCH_TAC; + CONJ_TAC; + UND 3; + UND 21; + MESON_TAC[ISUBSET]; + REWR 30; + ASM_REWRITE_TAC[]; + UND 15; + ASM_REWRITE_TAC[]; + DISCH_TAC; + FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); + REP_BASIC_TAC; + TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ; + (* now finally go after the goal in the FIRST case *) + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `g'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* now finish off the three conditions *) + KILL 34; + TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC; + KILL 43; + EXPAND_TAC "C'"; + EXPAND_TAC "Ca"; + IMATCH_MP_TAC IMAGE_SUBSET; + IMATCH_MP_TAC subset_contain; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + CONJ_TAC; (* 1*) + ASM_REWRITE_TAC[]; + USE 8 GSYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Ca` EXISTS_TAC ; + ASM_MESON_TAC[]; + CONJ_TAC; (* 2 *) + KILL 43; + EXPAND_TAC "C'"; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + REWRITE_TAC[INR IN_SING]; + TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC; + UND 45; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TSPEC `x'` 14; + UND 43; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `t''` EXISTS_TAC; + ASM_MESON_TAC[REAL_ARITH `t'' <= t''`]; + ASM_MESON_TAC[]; + (* 3 *) + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Ca INTER K'` EXISTS_TAC; + CONJ_TAC; + UND 34; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;INR IN_SING]; + REWRITE_TAC[SUBSET;INTER;INR IN_SING ]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "C'"; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 40; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* sh *) + (* ******************* START THE SECOND HALF ************ *) + + TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t' <= x /\ x <= t} (euclid 2) /\ (&0 < &1) /\ (t' < t) ` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + REWR 6; + ASM_REWRITE_TAC[SUBSET ]; + UND 19; + UND 12; + UND 17; + REAL_ARITH_TAC; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); + REP_BASIC_TAC; + TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; + TYPE_THEN `Ca INTER K = {(g (&0))}` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET;INR IN_SING;]; + KILL 26; + EXPAND_TAC "Ca"; + REWRITE_TAC[IMAGE;SUBSET]; + REP_BASIC_TAC; + TYPE_THEN `x' < t \/ (x' = t)` SUBGOAL_TAC; + UND 28; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + PROOF_BY_CONTR_TAC; + UND 26; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 29; + UND 17; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;INTER;INR IN_SING;]; + KILL 26; + EXPAND_TAC "Ca"; + REWRITE_TAC[IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + CONJ_TAC; + TYPE_THEN `t` EXISTS_TAC; + ASM_MESON_TAC[REAL_ARITH `(t' < t ==> t'<= t) /\ (t <= t)`]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~(Ca INTER K' = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `f t'` EXISTS_TAC; + KILL 26; + EXPAND_TAC "Ca"; + REWRITE_TAC[IMAGE;SUBSET;]; + ASM_REWRITE_TAC[]; + TYPE_THEN `t'` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_ARITH `t' <= t'`]; + ASM_SIMP_TAC[REAL_ARITH `(t' < t) ==> (t' <= t)`]; + DISCH_TAC; + KILL 21; + (* ADD Ca SUBSET C *) + TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC; + KILL 26; + EXPAND_TAC "Ca"; + KILL 20; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 21; + UND 26; + UND 17; + UND 19; + UND 12; + REAL_ARITH_TAC; + DISCH_TAC; + (* gK *) + (* t'' parameter for g and K *) + TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K' (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K' (g s)))` SUBGOAL_TAC; + ASSUME_TAC preimage_first ; + TYPEL_THEN [`K'`;`2`] (USE 29 o ISPECL); + FIRST_ASSUM (fun t -> IMATCH_MP_TAC t); + KILL 29; + ASM_REWRITE_TAC[GSYM top2;]; + ASM_SIMP_TAC[continuous_interval]; + EXPAND_TAC "Ca"; + IMATCH_MP_TAC inj_image_subset; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* set up for arc_reparameter_gen *) + TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\ INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'') ` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC; + UND 32; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET ]; + UND 31; + REAL_ARITH_TAC; + PROOF_BY_CONTR_TAC; + UND 3; + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + TYPE_THEN `g (&0)` EXISTS_TAC; + TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC; + TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC; + ASM_MESON_TAC[INTER_SUBSET]; + REWRITE_TAC[SUBSET;INR IN_SING]; + MESON_TAC[]; + DISCH_TAC; + CONJ_TAC; + UND 3; + UND 21; + MESON_TAC[ISUBSET]; + REWR 30; + ASM_REWRITE_TAC[]; + UND 11; + ASM_REWRITE_TAC[]; + DISCH_TAC; + FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ; + (* now finally go after the goal in the FIRST case *) + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `g'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* nfo *) + (* now finish off the three conditions *) + KILL 34; + TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC; + KILL 43; + EXPAND_TAC "C'"; + EXPAND_TAC "Ca"; + IMATCH_MP_TAC IMAGE_SUBSET; + IMATCH_MP_TAC subset_contain; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + CONJ_TAC; (* 1*) + ASM_REWRITE_TAC[]; + USE 8 GSYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Ca` EXISTS_TAC ; + ASM_MESON_TAC[]; + (* s2 *) + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC ; (* 2 *) + KILL 43; + EXPAND_TAC "C'"; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;IMAGE;SUBSET]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + REWRITE_TAC[INR IN_SING]; + TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC; + UND 45; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TSPEC `x'` 14; + UND 43; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING]; + NAME_CONFLICT_TAC; + REP_BASIC_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `t''` EXISTS_TAC; + ASM_MESON_TAC[REAL_ARITH `t'' <= t''`]; + ASM_MESON_TAC[]; + (* s3 *) + (* 3 *) + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Ca INTER K` EXISTS_TAC; + CONJ_TAC; + UND 34; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;INR IN_SING]; + REWRITE_TAC[SUBSET;INTER;INR IN_SING ]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "C'"; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `a` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 40; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* Thu Aug 5 08:09:38 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end = jordan_def + `simple_arc_end C v v' <=> + (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1 }) /\ + continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ + (f (&0) = v) /\ (f(&1) = v'))`;; + +let good_plane_graph = jordan_def + `good_plane_graph G <=> plane_graph G /\ + (!e v v'. (graph_edge G e /\ ~(v = v') /\ + (graph_inc G e v) /\ (graph_inc G e v') ==> + (simple_arc_end e v v')))`;; + +let graph_edge_mod = jordan_def + `graph_edge_mod (G:(A,B)graph_t) (f:B->B') = + mk_graph_t (graph_vertex G,IMAGE f (graph_edge G), + (\ e' v. (?e. graph_edge G e /\ graph_inc G e v /\ (f e = e'))))`;; + +let graph_edge_mod_v = prove_by_refinement( + `!(G:(A,B)graph_t) (f:B->B'). + graph_vertex (graph_edge_mod G f) = graph_vertex G `, + (* {{{ proof *) + [ + REWRITE_TAC[graph_edge_mod;graph_vertex;dest_graph_t;]; + ]);; + (* }}} *) + +let graph_edge_mod_e = prove_by_refinement( + `!(G:(A,B)graph_t) (f:B->B'). + graph_edge (graph_edge_mod G f) = IMAGE f (graph_edge G )`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_edge_mod;graph_edge;dest_graph_t;part1;drop0]; + ]);; + (* }}} *) + +let graph_edge_mod_i = prove_by_refinement( + `!(G:(A,B)graph_t) (f:B->B') e v. + graph_inc (graph_edge_mod G f) e v <=> + (?e'. (graph_edge G e' /\ graph_inc G e' v /\ (f e' = e)))`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_edge_mod;graph_inc;dest_graph_t;part1;drop1]; + ]);; + (* }}} *) + +let inj_bij = prove_by_refinement( + `!(f:A->B) X. (INJ f X UNIV) ==> (BIJ f X (IMAGE f X))`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ]; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE_SURJ]; + UND 0; + REWRITE_TAC[INJ;IMAGE;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let graph_edge_iso = prove_by_refinement( + `! f (G:(A,B)graph_t). (INJ (f:B->B') (graph_edge G) (UNIV)) ==> + (graph_isomorphic G (graph_edge_mod G f))`, + (* {{{ proof *) + + [ + REWRITE_TAC[graph_isomorphic;graph_iso]; + REP_BASIC_TAC; + RIGHT_TAC "f"; + RIGHT_TAC "f"; + TYPE_THEN `I:A->A` EXISTS_TAC ; + TYPE_THEN `f` EXISTS_TAC; + NAME_CONFLICT_TAC; + EXISTS_TAC `(I:A->A,f:B->B')` ; + REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e]; + CONJ_TAC; + REWRITE_TAC[I_DEF;BIJ;INJ;SURJ;]; + MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC inj_bij; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[graph_edge_mod_i;IMAGE_I;]; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `e'' = e'` SUBGOAL_TAC; + RULE_ASSUM_TAC(REWRITE_RULE [INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let graph_edge_graph = prove_by_refinement( + `!f (G:(A,B)graph_t). (graph G) /\ + (INJ (f:B->B') (graph_edge G) (UNIV)) ==> + (graph (graph_edge_mod G f)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC graph_isomorphic_graph; + TYPE_THEN `G` EXISTS_TAC; + ASM_MESON_TAC[graph_edge_iso]; + ]);; + (* }}} *) + +let plane_graph_mod = prove_by_refinement( + `!G f. (plane_graph G) /\ (INJ f (graph_edge G) UNIV) /\ + (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> + (f e INTER f e' SUBSET e INTER e') )) /\ + (!e. (graph_edge G e ==> (simple_arc top2 (f e)))) /\ + (!e. (graph_edge G e) ==> + (e INTER graph_vertex G = (f e) INTER graph_vertex G)) ==> + (plane_graph (graph_edge_mod G f)) + `, + (* {{{ proof *) + + [ + REWRITE_TAC[plane_graph]; + REP_BASIC_TAC; + REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e;]; + CONJ_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[graph_edge_graph]; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER]; + REP_BASIC_TAC; + REWRITE_TAC[graph_edge_mod_i]; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `e' = x` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TSPEC `e'` 5; + TSPEC `e'` 0; + UND 0; + UND 5; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `(f x INTER graph_vertex G) x'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER;SUBSET]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TSPEC `x` 5; + TSPEC `x` 0; + UND 0; + REWR 5; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + ASM_SIMP_TAC[]; + REWRITE_TAC[INTER;SUBSET]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + UND 10; + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + UND 11; + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + TYPE_THEN `~(x = x')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `x' INTER x` EXISTS_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Thu Aug 5 10:17:38 EDT 2004 *) + + ]);; + + (* }}} *) + +let compact_point = prove_by_refinement( + `!U (x:A). (UNIONS U x) ==> (compact U {x})`, + (* {{{ proof *) + [ + REWRITE_TAC[compact]; + REP_BASIC_TAC; + CONJ_TAC; + ASM_REWRITE_TAC [single_subset]; + REP_BASIC_TAC; + TYPE_THEN `?u. V u /\ u x` SUBGOAL_TAC; + UND 2; + REWRITE_TAC[SUBSET;UNIONS;INR IN_SING]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `{u}` EXISTS_TAC; + ASM_REWRITE_TAC [single_subset;FINITE_SING]; + (* Thu Aug 5 12:02:40 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_select = prove_by_refinement( + `!C v v'. (simple_arc top2 C) /\ (C v) /\ (C v') /\ ~(v = v') ==> + (?C'. (C' SUBSET C) /\ (simple_arc_end C' v v'))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + (* A *) + TYPE_THEN `!v. (C v) ==> (closed_ top2 {v})` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC compact_closed; + ASM_SIMP_TAC[top2_top;metric_hausdorff;top2;metric_euclid;compact_point]; + IMATCH_MP_TAC compact_point; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + UND 3; + REWRITE_TAC[simple_arc]; + REP_BASIC_TAC; + TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_image_subset; + RULE_ASSUM_TAC (REWRITE_RULE [top2_unions]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + (* B hypotheses of curve_restriction *) + TYPE_THEN `simple_arc top2 C /\ closed_ top2 {v} /\ closed_ top2 {v'} /\ (C INTER {v} INTER { v' } = EMPTY) /\ ~(C INTER {v} = EMPTY) /\ ~(C INTER {v'} = EMPTY) /\ (&0 < &1)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `&0 < &1`]; + REWRITE_TAC[INTER;INR IN_SING;EMPTY_EXISTS ]; + REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP curve_restriction t)); + REP_BASIC_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `!A u v. (A INTER {u} = {v}) ==> ( (v:num->real)=u)` SUBGOAL_TAC; + REWRITE_TAC[eq_sing;INTER;INR IN_SING;]; + MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_edge2 = prove_by_refinement( + `!(G:(A,B)graph_t) e. + (graph G /\ graph_edge G e) ==> (graph_inc G e HAS_SIZE 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[graph]; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let simple_arc_end_symm = prove_by_refinement( + `!C' v v'. (simple_arc_end C' v v' ==> simple_arc_end C' v' v)`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + TYPE_THEN `( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (&0 < &1) /\ (&0 < &1))` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`]; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t)); + REP_BASIC_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let simple_arc_end_plane_select = prove_by_refinement( + `!G e. (plane_graph G /\ graph_edge G e) ==> (?e'. + (e' SUBSET e /\ + (!v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==> + simple_arc_end e' v v')))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]); + IMATCH_MP_TAC graph_edge2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + TYPE_THEN `(?e'. (e' SUBSET e) /\ (simple_arc_end e' a b))` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_select; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + CONJ_TAC; + UND 5; + ASM_MESON_TAC [ISUBSET]; + TYPE_THEN `graph_inc G e a /\ graph_inc G e b` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[in_pair]; + KILL 3; + ASM_SIMP_TAC[]; + REWRITE_TAC[INTER;SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `e'` EXISTS_TAC; + ASM_REWRITE_TAC[in_pair]; + REP_BASIC_TAC; + TYPE_THEN `((v = a) /\ (v' = b)) \/ ((v = b) /\ (v' =a ))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + (* Thu Aug 5 14:10:17 EDT 2004 *) + + ]);; + + (* }}} *) + +let plane_graph_contain = prove_by_refinement( + `!G e e'. (plane_graph G /\ graph_edge G e /\ graph_edge G e' /\ + (e SUBSET e') ==> (e = e'))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `e INTER e' SUBSET graph_vertex G` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `e INTER e' SUBSET e' INTER graph_vertex G` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_INTER]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER;SUBSET]; + MESON_TAC[]; + TYPE_THEN `e' INTER graph_vertex G = graph_inc G e'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `graph_inc G e' HAS_SIZE 2` SUBGOAL_TAC; + ASM_MESON_TAC[graph_edge2]; + TYPE_THEN `e INTER e' = e` SUBGOAL_TAC; + UND 0; + REWRITE_TAC[SUBSET_INTER_ABSORPTION]; + DISCH_THEN_REWRITE; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + REWR 10; + TYPE_THEN `simple_arc top2 e` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + REWRITE_TAC[simple_arc]; + REP_BASIC_TAC; + TYPE_THEN `!x. (&0 <= x /\ x <= &1) ==> {a,b} (f x)` SUBGOAL_TAC; + REWR 10; + UND 10; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + TYPE_THEN `(f (&0) = f(&1))` SUBGOAL_TAC; + IMATCH_MP_TAC two_exclusion; + TYPE_THEN `{a,b}` EXISTS_TAC; + TYPE_THEN `?t. (&0 < t /\ t < &1)` SUBGOAL_TAC; + TYPE_THEN `&1/ (&2)` EXISTS_TAC; + IMATCH_MP_TAC half_pos; + REAL_ARITH_TAC; + REP_BASIC_TAC; + TYPE_THEN `f t` EXISTS_TAC; + CONJ_TAC; + ASM_MESON_TAC[pair_size_2]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REAL_ARITH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REAL_ARITH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 18; + UND 19; + REAL_ARITH_TAC; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `~(&0 = t)` SUBGOAL_TAC; + UND 19; + REAL_ARITH_TAC; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWR 20; + ASM_REWRITE_TAC[]; + UND 18; + UND 19; + REAL_ARITH_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `~(&1 = t)` SUBGOAL_TAC; + UND 18; + REAL_ARITH_TAC; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWR 20; + ASM_REWRITE_TAC[]; + UND 18; + UND 19; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(&0 = &1)` SUBGOAL_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* Thu Aug 5 15:11:20 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_edge_end_select = prove_by_refinement( + `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e ==> + (?v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v')))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[in_pair]; + (* Thu Aug 5 19:26:02 EDT 2004 *) + + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* SECTION K *) +(* ------------------------------------------------------------------ *) + +(* Thu Aug 5 21:17:36 EDT 2004 *) + +(* Tweaked slightly now that there is an "inf" constant. JRH, 4 Dec 2011 *) + +let inf = + let inf_def = + `inf (X:real->bool) = + @s. ((!x. X x ==> s <= x) /\ (!y. (!x. X x ==> y <= x) ==> (y <= s)))` in + let def = + subst [mk_var("inf",`:(real->bool)->real`),mk_const("inf",[])] inf_def in + jordan_def def;; + +let interval_closed = prove_by_refinement( + `!a b. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x /\ x <= b}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC compact_closed; + ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real]; + ASM_SIMP_TAC[metric_hausdorff;metric_real;]; + ]);; + (* }}} *) + +let half_closed = prove_by_refinement( + `!a. closed_ (top_of_metric(UNIV,d_real)) {x | x <= a}`, + (* {{{ proof *) + [ + REWRITE_TAC[closed]; + REP_BASIC_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + TYPE_THEN `UNIV DIFF {x | x <= a } = {x | a < x}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[DIFF;UNIV]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC [open_DEF;half_open_above]; + ]);; + (* }}} *) + +let half_closed_above = prove_by_refinement( + `!a. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x}`, + (* {{{ proof *) + [ + REWRITE_TAC[closed]; + REP_BASIC_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + TYPE_THEN `UNIV DIFF {x | a <= x } = {x | x < a}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[DIFF;UNIV]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC [open_DEF;half_open]; + ]);; + (* }}} *) + +let inf_LB = prove_by_refinement( + `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==> + (!x. X x ==> inf X <= x) /\ + (!y. (!x. X x ==> y <= x) ==> (y <= inf X))`, + (* {{{ proof *) + [ + GEN_TAC; + TYPE_THEN `topology_ (top_of_metric(UNIV,d_real))` SUBGOAL_TAC; + ASM_SIMP_TAC[top_of_metric_top;metric_real]; + DISCH_TAC; + (* *) + TYPE_THEN `X SUBSET closure (top_of_metric(UNIV,d_real)) X` SUBGOAL_TAC; + ASM_SIMP_TAC[subset_closure]; + DISCH_TAC; + (* *) + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + REWRITE_TAC[inf]; + SELECT_TAC; + ASM_MESON_TAC[]; + PROOF_BY_CONTR_TAC; + UND 4; + KILL 5; + REWRITE_TAC[]; + TYPE_THEN `XC = closure (top_of_metric(UNIV,d_real)) X INTER {x | t <= x /\ x <= u}` ABBREV_TAC ; + TYPE_THEN `compact (top_of_metric(UNIV,d_real)) XC` SUBGOAL_TAC; + IMATCH_MP_TAC closed_compact; + TYPE_THEN `{x | t <= x /\ x <= u}` EXISTS_TAC; + ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real]; + EXPAND_TAC "XC"; + CONJ_TAC; + IMATCH_MP_TAC closed_inter2; + ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real]; + IMATCH_MP_TAC closure_closed; + ASM_SIMP_TAC[top_of_metric_top;metric_real;GSYM top_of_metric_unions;]; + ASM_REWRITE_TAC[INTER_SUBSET]; + DISCH_TAC; + (* *) + TYPE_THEN `(?z. (XC z /\ (!y. XC y ==> z <= y)))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_inf; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + EXPAND_TAC "XC"; + REWRITE_TAC[INTER;SUBSET]; + CONJ_TAC; + UND 1; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[REAL_ARITH `u <= u`]; + REP_BASIC_TAC; + TYPE_THEN `z` EXISTS_TAC; + CONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `(x <= u) \/ (u < x)` SUBGOAL_TAC; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `XC x` SUBGOAL_TAC; + EXPAND_TAC "XC"; + REWRITE_TAC[INTER;SUBSET]; + CONJ_TAC; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + UND 7; + EXPAND_TAC "XC"; + REWRITE_TAC[INTER;SUBSET]; + REP_BASIC_TAC; + ASM_MESON_TAC[REAL_ARITH `z <= u /\ u < x ==> z <= x`]; + REP_BASIC_TAC; + TYPE_THEN `closed_ (top_of_metric (UNIV,d_real)) {x | y' <= x }` SUBGOAL_TAC; + REWRITE_TAC[half_closed_above]; + DISCH_TAC; + TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X SUBSET {x | y' <= x }` SUBGOAL_TAC; + IMATCH_MP_TAC closure_subset; + ASM_REWRITE_TAC[SUBSET ]; + DISCH_TAC; + TYPE_THEN `XC SUBSET {x | y' <= x}` SUBGOAL_TAC; + EXPAND_TAC "XC"; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X ` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "XC"; + REWRITE_TAC[INTER_SUBSET]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* Fri Aug 6 05:51:24 EDT 2004 *) + + ]);; + (* }}} *) + +let inf_eps = prove_by_refinement( + `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==> + (!epsilon. (&0 < epsilon) ==> (?x. X x /\ (x < inf X + epsilon)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(!y. (!x. X x ==> y <= x) ==> (y <= inf X))` SUBGOAL_TAC; + ASM_MESON_TAC[inf_LB]; + DISCH_TAC; + TSPEC `inf X + epsilon` 3; + PROOF_BY_CONTR_TAC; + TYPE_THEN `(!x. X x ==> inf X + epsilon <= x)` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(v < u) ==> u <= v`); + ASM_MESON_TAC[]; + ASM_MESON_TAC[REAL_ARITH `(x + y <= x ==> ~(&0 < y))`]; + ]);; + (* }}} *) + +let supm = jordan_def `supm (X:real->bool) = + --. (inf ({x | ?z. X z /\ (x = --. z)}))`;; + +let supm_UB = prove_by_refinement( + `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==> + (!x. X x ==> x <= supm X ) /\ + (!y. (!x. X x ==> x <= y) ==> (supm X <= y))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[supm]; + TYPE_THEN `Y = {x | ?z. X z /\ (x = --z)}` ABBREV_TAC ; + TYPE_THEN `!u. (Y u = X (-- u)) /\ (Y (--u ) = X u)` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + MESON_TAC[REAL_ARITH `(-- (-- u) = u)`]; + DISCH_TAC; + TYPE_THEN `(~(Y = EMPTY) /\ (?t. !x. (Y x ==> t <= x)))` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + CONJ_TAC; + TYPE_THEN `-- u` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `-- t` EXISTS_TAC; + REP_BASIC_TAC; + ASM_MESON_TAC[REAL_ARITH `--t <= x <=> (-- x <= t)`]; + DISCH_THEN ( ASSUME_TAC o (MATCH_MP inf_LB)); + CONJ_TAC; + REP_BASIC_TAC; + ASM_MESON_TAC[REAL_ARITH `y <= --x <=> x <= --y`]; + REP_BASIC_TAC; + IMATCH_MP_TAC (REAL_ARITH `--y <= inf Y ==> -- inf Y <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + REP_BASIC_TAC; + ASM_MESON_TAC[ REAL_ARITH `--x <= y <=> --y <= x`]; + (* Fri Aug 6 06:42:14 EDT 2004 *) + + ]);; + (* }}} *) + +let supm_eps = prove_by_refinement( + `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==> + (!epsilon.(&0 < epsilon) ==> (?x. X x /\ (supm X - epsilon < x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC; + ASM_MESON_TAC[supm_UB]; + DISCH_TAC; + TSPEC `supm X - epsilon` 3; + PROOF_BY_CONTR_TAC; + TYPE_THEN `(!x. X x ==> x <= supm X - epsilon)` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(v < u) ==> u <= v`); + ASM_MESON_TAC[]; + ASM_MESON_TAC[REAL_ARITH `(x <= x - y ==> ~(&0 < y))`]; + (* Fri Aug 6 06:47:22 EDT 2004 *) + + ]);; + (* }}} *) + +let compact_subset = prove_by_refinement( + `!(X:A->bool) K d. (K SUBSET X /\ metric_space(X,d)) ==> + (compact(top_of_metric(X,d)) K = compact(top_of_metric(K,d))K) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_induced]; + ASM_MESON_TAC[induced_compact;top_of_metric_unions]; + ]);; + (* }}} *) + +let exp_gt1 = prove_by_refinement( + `!n. (0 < n) ==> (1 < 2 **| n)`, + (* {{{ proof *) + [ + TYPE_THEN `1 = 2 **| 0` SUBGOAL_TAC; + REWRITE_TAC[EXP]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + REP_BASIC_TAC; + REWRITE_TAC[LT_EXP]; + UND 0; + ARITH_TAC; + ]);; + (* }}} *) + +let twopow_lt = prove_by_refinement( + `!a b. (a < b) ==> (twopow a < twopow b)`, + (* {{{ proof *) + [ + ONCE_REWRITE_TAC [INT_ARITH `(a <: b) <=> (&:0 <: b -: a)`]; + ASSUME_TAC twopow_pos; + ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> &1*x < y`]; + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]; + REWRITE_TAC[real_div]; + REWRITE_TAC[GSYM TWOPOW_INV;GSYM TWOPOW_ADD_INT;GSYM INT_SUB]; + REP_GEN_TAC; + TYPE_THEN `C = b -: a` ABBREV_TAC ; + ASSUME_TAC INT_REP2 ; + TSPEC `C` 2; + REP_BASIC_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + UND 2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[TWOPOW_POS]; + REDUCE_TAC; + REWRITE_TAC[INT_OF_NUM_LT;exp_gt1]; + PROOF_BY_CONTR_TAC; + UND 2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_ARITH `(~(&:0 <: --: y) <=> (&:0 <=: y))`]; + REWRITE_TAC[INT_OF_NUM_LE]; + ARITH_TAC; + ]);; + (* }}} *) + +let compact_distance = prove_by_refinement( + `!(X:A->bool) d K K'. (metric_space(X,d) /\ + ~(K=EMPTY) /\ ~(K' = EMPTY) /\ + (compact (top_of_metric(X,d)) K) /\ (compact(top_of_metric(X,d))K')) + ==> (?p p'. (K p /\ K' p' /\ (!q q'. (K q /\ K' q') ==> + (d p p' <= d q q'))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `UNIONS (top_of_metric(X,d)) = X` SUBGOAL_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + TYPE_THEN `K SUBSET X /\ K' SUBSET X` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[compact]); + REWR 0; + REWR 1; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `Y = { z | ?q q'. (K q /\ K' q' /\ (z = d q q'))}` ABBREV_TAC ; + TYPE_THEN `!y. (Y y) ==> (&0 <= y)` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); + TYPEL_THEN [`q`;`q'`;`q'`] (USE 4 o ISPECL); + ASM_MESON_TAC[metric_space;ISUBSET]; + REP_BASIC_TAC; + (* *) + TYPE_THEN `~(Y= EMPTY)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + UND 2; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `d u' u` EXISTS_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* inf Y *) + TYPE_THEN `(!epsilon. (&0 < epsilon) ==> (?x. Y x /\ (x < inf Y + epsilon)))` SUBGOAL_TAC; + IMATCH_MP_TAC inf_eps; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + ASSUME_TAC twopow_pos; + TYPE_THEN `(!n. ?p. ?p'. K p /\ K' p' /\ (d p p' < inf Y + twopow( -- (&:n))))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `(?x. Y x /\ x < inf Y + twopow (--: (&:n)))` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 14; + EXPAND_TAC "Y"; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + RIGHT 13 "n"; + REP_BASIC_TAC; + (* compact,complete,totally bounded *) + TYPE_THEN `metric_space (K,d) /\ metric_space(K',d)` SUBGOAL_TAC; + ASM_MESON_TAC[metric_subspace]; + REP_BASIC_TAC; + TYPE_THEN `compact (top_of_metric(K,d)) K /\ compact (top_of_metric(K',d)) K'` SUBGOAL_TAC; + ASM_MESON_TAC[compact_subset]; + REP_BASIC_TAC; + TYPE_THEN `complete (K,d) /\ complete (K',d) ` SUBGOAL_TAC; + ASM_MESON_TAC[compact_complete]; + REP_BASIC_TAC; + TYPE_THEN `totally_bounded(K,d) /\ totally_bounded(K',d)` SUBGOAL_TAC; + ASM_MESON_TAC[compact_totally_bounded;]; + REP_BASIC_TAC; + (* construct subseq of p *) + TYPE_THEN `(?ss. subseq ss /\ converge (K,d) (p o ss))` SUBGOAL_TAC; + IMATCH_MP_TAC convergent_subseq; + ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + RIGHT 13 "p'"; + ASM_MESON_TAC[]; + REWRITE_TAC[converge]; + REP_BASIC_TAC; + (* construct q *) + TYPE_THEN `!n. ?p'. K' p' /\ d x p' < inf Y + twopow(--: (&:n))` SUBGOAL_TAC; + REP_BASIC_TAC; + TSPEC `twopow (--: (&:(SUC(n))))` 22; + REP_BASIC_TAC; + REWR 22; + TSPEC `SUC(n') + SUC (n)` 22; + RULE_ASSUM_TAC (REWRITE_RULE[ARITH_RULE `x <=| SUC x +| y`]); + TSPEC `ss (SUC n' +| SUC n)` 13; + REP_BASIC_TAC; + TYPE_THEN `twopow (--: (&:(ss(SUC n'+SUC n)))) < twopow(--: (&:(SUC n)))` SUBGOAL_TAC; + IMATCH_MP_TAC twopow_lt; + REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT;]; + IMATCH_MP_TAC (ARITH_RULE `(?t. (a <= t /\ t <| b)) ==> (a <| b)`); + TYPE_THEN `ss (SUC n)` EXISTS_TAC; + ASM_SIMP_TAC[SEQ_SUBLE;subseq]; + RULE_ASSUM_TAC (REWRITE_RULE[subseq]); + FIRST_ASSUM IMATCH_MP_TAC ; + ARITH_TAC; + DISCH_TAC; + TYPE_THEN `p'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); + REP_BASIC_TAC; + TYPEL_THEN [`x`;`p (ss (SUC n' +| SUC n))`;`p'`] (USE 4 o ISPECL); + REP_BASIC_TAC; + TYPE_THEN `X x /\ X (p (ss (SUC n' +| SUC n))) /\ X p'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + REWR 4; + REP_BASIC_TAC; + TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC; + REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double]; + UND 4; + UND 13; + UND 27; + UND 22; + REWRITE_TAC[o_DEF]; + REAL_ARITH_TAC; + DISCH_TAC; + RIGHT 25 "n" ; + REP_BASIC_TAC; + (* take subseq of p' *) + TYPE_THEN `(?ss'. subseq ss' /\ converge (K',d) (p' o ss'))` SUBGOAL_TAC; + IMATCH_MP_TAC convergent_subseq; + ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + ASM_MESON_TAC[]; + REWRITE_TAC[converge]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* now go in for the KILL. *) + (* Show d x x' <= inf Y because d x x' < inf Y + eps *) + (* [K] *) + IMATCH_MP_TAC (REAL_ARITH `(?t. (t <= y) /\ (x <= t)) ==> (x <= y)`); + TYPE_THEN `inf Y` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `(!y. Y y ==> inf Y <= y)` SUBGOAL_TAC; + ASM_MESON_TAC[inf_LB]; + DISCH_THEN IMATCH_MP_TAC ; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + TYPE_THEN `q` EXISTS_TAC; + TYPE_THEN `q'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `!x y. (!e. (&0 (x < y + e)) ==> (x <= y)`; + REP_GEN_TAC; + DISCH_THEN (fun t -> MP_TAC (SPEC `x'' - y` t)); + REAL_ARITH_TAC; + DISCH_THEN IMATCH_MP_TAC ; + REP_BASIC_TAC; + KILL 15; + KILL 14; + KILL 17; + KILL 16; + KILL 18; + KILL 19; + KILL 20; + KILL 21; + KILL 2; + KILL 3; + KILL 0; + KILL 1; + KILL 8; + KILL 29; + KILL 30; + (* GEN needed inequalities *) + (* [L] *) + TYPE_THEN `?n. (&1)* twopow(--: (&:n)) < e` SUBGOAL_TAC; + ASM_MESON_TAC[twopow_eps;REAL_ARITH `&0 < &1`]; + REDUCE_TAC; + REP_BASIC_TAC; + TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC; + REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double]; + REP_BASIC_TAC; + TSPEC `twopow(--: (&:(SUC n)))` 26; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[twopow_pos]); + + TSPEC `SUC (n) + SUC n'` 2; + USE 2(REWRITE_RULE[ARITH_RULE `a <=| b + SUC a`]); + TSPEC `ss' (SUC n + SUC n')` 25; + TYPE_THEN `twopow (--: (&:(ss' (SUC n +| SUC n')))) < twopow (--: (&:(SUC n)))` SUBGOAL_TAC; + IMATCH_MP_TAC twopow_lt; + REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT ]; + IMATCH_MP_TAC (ARITH_RULE `(?t. (a <=| t /\ (t <| b))) ==> (a <| b)`); + TYPE_THEN `(ss' (SUC n) )` EXISTS_TAC; + ASM_SIMP_TAC[SEQ_SUBLE]; + RULE_ASSUM_TAC (REWRITE_RULE[subseq]); + FIRST_ASSUM IMATCH_MP_TAC ; + ARITH_TAC; + DISCH_TAC; + REP_BASIC_TAC; + (* metric space ineq *) + TYPE_THEN `X x /\ X x' /\ X (p' (ss' (SUC n +| SUC n')))` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[o_DEF]); + TYPE_THEN `r = p' (ss' (SUC n +| SUC n'))` ABBREV_TAC ; + TYPE_THEN `d x' r = d r x'` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_symm; + ASM_MESON_TAC[]; + TYPE_THEN `d x x' <= d x r + d r x'` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_triangle; + ASM_MESON_TAC[]; + UND 0; + UND 1; + UND 2; + UND 3; + UND 8; + REAL_ARITH_TAC; + (* Fri Aug 6 11:54:33 EDT 2004 *) + ]);; + (* }}} *) + +let max_real_le = prove_by_refinement( + `!x y. x <= max_real x y /\ y <= max_real x y `, + (* {{{ proof *) + [ + REWRITE_TAC[max_real]; + REP_GEN_TAC; + COND_CASES_TAC; + UND 0; + REAL_ARITH_TAC; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let min_real_le = prove_by_refinement( + `!x y. min_real x y <= x /\ min_real x y <= y`, + (* {{{ proof *) + [ + REWRITE_TAC[min_real]; + REP_GEN_TAC; + COND_CASES_TAC; + UND 0; + REAL_ARITH_TAC; + UND 0; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let finite_UB = prove_by_refinement( + `!X. (FINITE X) ==> (?t. (!x. X x ==> x <=. t))`, + (* {{{ proof *) + [ + TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> x <= t))` SUBGOAL_TAC; + INDUCT_TAC ; + REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;]; + MESON_TAC[]; + REWRITE_TAC[HAS_SIZE_SUC]; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + TSPEC `X DELETE u` 0; + TYPE_THEN `(?t. !x. (X DELETE u) x ==> x <= t)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `max_real t u` EXISTS_TAC; + GEN_TAC; + DISCH_TAC; + TYPE_THEN `x = u` ASM_CASES_TAC; + ASM_MESON_TAC[max_real_le]; + TSPEC `x` 3; + RULE_ASSUM_TAC (REWRITE_RULE[DELETE]); + ASM_MESON_TAC[max_real_le;REAL_LE_TRANS]; + REWRITE_TAC[HAS_SIZE]; + ASM_MESON_TAC[]; + (* Fri Aug 6 12:50:04 EDT 2004 *) + ]);; + (* }}} *) + +let finite_LB = prove_by_refinement( + `!X. (FINITE X) ==> (?t. (!x. X x ==> t <=. x))`, + (* {{{ proof *) + [ + TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> t <= x))` SUBGOAL_TAC; + INDUCT_TAC ; + REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;]; + MESON_TAC[]; + REWRITE_TAC[HAS_SIZE_SUC]; + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + TSPEC `X DELETE u` 0; + TYPE_THEN `(?t. !x. (X DELETE u) x ==> t <= x)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `min_real t u` EXISTS_TAC; + GEN_TAC; + DISCH_TAC; + TYPE_THEN `x = u` ASM_CASES_TAC; + ASM_MESON_TAC[min_real_le]; + TSPEC `x` 3; + RULE_ASSUM_TAC (REWRITE_RULE[DELETE]); + ASM_MESON_TAC[min_real_le;REAL_LE_TRANS]; + REWRITE_TAC[HAS_SIZE]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let finite_compact = prove_by_refinement( + `!(X:A->bool) U. (FINITE X) /\ (X SUBSET UNIONS U) ==> (compact U X)`, + (* {{{ proof *) + [ + TYPE_THEN `!n (X:A->bool) U. (X HAS_SIZE n) /\ (X SUBSET UNIONS U) ==> (compact U X)` SUBGOAL_TAC; + INDUCT_TAC; + REWRITE_TAC[HAS_SIZE_0]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[compact]; + REP_BASIC_TAC; + TYPE_THEN `EMPTY:(A->bool)->bool` EXISTS_TAC; + REWRITE_TAC[FINITE_RULES]; + REWRITE_TAC[HAS_SIZE_SUC;EMPTY_EXISTS;compact ;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `X DELETE u HAS_SIZE n` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPEL_THEN [`X DELETE u`;`U`] (USE 0 o ISPECL); + REP_BASIC_TAC; + REWR 0; + TYPE_THEN `X DELETE u SUBSET UNIONS U` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[SUBSET;DELETE]; + MESON_TAC[]; + DISCH_TAC; + REWR 0; + RULE_ASSUM_TAC (REWRITE_RULE[compact]); + REP_BASIC_TAC; + TSPEC `V` 0; + REWR 0; + TYPE_THEN `X DELETE u SUBSET UNIONS V` SUBGOAL_TAC; + UND 6; + REWRITE_TAC[SUBSET;DELETE]; + MESON_TAC[]; + DISCH_TAC; + REWR 0; + REP_BASIC_TAC; + USE 6 (REWRITE_RULE[SUBSET;UNIONS]); + TSPEC `u` 6; + REWR 6; + REP_BASIC_TAC; + TYPE_THEN `u' INSERT W` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[INSERT_SUBSET]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[FINITE_INSERT]; + REWRITE_TAC[UNIONS_INSERT]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `u' UNION (X DELETE u)` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;DELETE;UNION]; + ASM_MESON_TAC[]; + UND 0; + REWRITE_TAC[UNION;SUBSET]; + MESON_TAC[]; + REWRITE_TAC[HAS_SIZE]; + MESON_TAC[]; + ]);; + (* }}} *) + +let compact_supm = prove_by_refinement( + `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==> + X (supm X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?x. X x /\ (!y. X y ==> y <= x))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_sup; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(!x. X x ==> x <= supm X ) /\ (!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC; + IMATCH_MP_TAC supm_UB; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x = supm X` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `x <= supm X /\ supm X <= x ==> (x = supm X)`); + TSPEC `x` 4; + REWR 4; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + + ]);; + (* }}} *) + +let compact_infm = prove_by_refinement( + `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==> + X (inf X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?x. X x /\ (!y. X y ==> x <= y))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_inf; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(!x. X x ==> inf X <= x ) /\ (!y. (!x. X x ==> y <= x) ==> ( y <= inf X))` SUBGOAL_TAC; + IMATCH_MP_TAC inf_LB; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x = inf X` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `x <= inf X /\ inf X <= x ==> (x = inf X)`); + TSPEC `x` 4; + REWR 4; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* Fri Aug 6 13:45:50 EDT 2004 *) + + ]);; + (* }}} *) + +let finite_supm = prove_by_refinement( + `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (supm X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC compact_supm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC finite_compact; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;]; + ]);; + (* }}} *) + +let finite_inf = prove_by_refinement( + `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (inf X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC compact_infm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC finite_compact; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;]; + (* Fri Aug 6 13:49:38 EDT 2004 *) + ]);; + (* }}} *) + +let finite_supm_max = prove_by_refinement( + `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> x <= supm X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?t. !x. (X x ==> x <= t))` SUBGOAL_TAC; + ASM_MESON_TAC[finite_UB]; + ASM_MESON_TAC[supm_UB]; + ]);; + (* }}} *) + +let finite_inf_min = prove_by_refinement( + `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> inf X <= x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?t. !x. (X x ==> t <= x))` SUBGOAL_TAC; + ASM_MESON_TAC[finite_LB]; + ASM_MESON_TAC[inf_LB]; + ]);; + (* }}} *) + +let bij_inj_image = prove_by_refinement( + `!(f:A->B) X Y. (INJ f X Y /\ Y SUBSET IMAGE f X) ==> + (BIJ f X Y)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;BIJ;SURJ;SUBSET;IMAGE]; + MESON_TAC[]; + ]);; + (* }}} *) + +let suc_interval = prove_by_refinement( + `!n. {x | x <| SUC n} = {x | x <| n} UNION {n}`, + (* {{{ proof *) + [ + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[UNION;INR IN_SING;]; + ARITH_TAC; + ]);; + (* }}} *) + +let inj_domain_sub = prove_by_refinement( + `!(f:A->B) g X Y. (!x. (X x ==> (f x = g x))) ==> (INJ f X Y = INJ g X Y)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let image_domain_sub = prove_by_refinement( + `!(f:A->B) g X . (!x. (X x ==> (f x = g x))) ==> (IMAGE f X = IMAGE g X)`, + (* {{{ proof *) + [ + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let real_finite_increase = prove_by_refinement( + `!X. ( (FINITE X) ==> + (? u. (BIJ u {x | x <| CARD X} X) /\ + (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==> + (u i <. u j)))))`, + (* {{{ proof *) + [ + TYPE_THEN `!n X. ( (X HAS_SIZE n) ==> (? u. (BIJ u {x | x <| CARD X} X) /\ (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==> (u i <. u j)))))` SUBGOAL_TAC; + INDUCT_TAC; + REWRITE_TAC[HAS_SIZE_0]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[CARD_CLAUSES;BIJ;INJ;SURJ]; + REWRITE_TAC[ARITH_RULE `~(j <| 0)`]; + REP_BASIC_TAC; + COPY 1; + UND 1; + REWRITE_TAC[HAS_SIZE_SUC;]; + REP_BASIC_TAC; + TYPE_THEN `X (supm X)` SUBGOAL_TAC; + IMATCH_MP_TAC finite_supm; + ASM_REWRITE_TAC[]; + KILL 0; + USE 3(REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + TSPEC `u` 1; + ASM_MESON_TAC[FINITE_DELETE;HAS_SIZE;]; + DISCH_TAC; + TSPEC `supm X` 1; + REWR 1; + TSPEC `X DELETE supm X` 0; + REWR 0; + REP_BASIC_TAC; + TYPE_THEN `v = (\j. if (j = n) then supm X else u j)` ABBREV_TAC ; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `CARD (X DELETE supm X) = n` SUBGOAL_TAC; + ASM_MESON_TAC[HAS_SIZE]; + DISCH_TAC; + (* [th] *) + TYPE_THEN `!x. ({x | x <| n} x ==> (v x = u x))` SUBGOAL_TAC; + REWRITE_TAC[]; + EXPAND_TAC "v"; + GEN_TAC; + COND_CASES_TAC; + ASM_REWRITE_TAC[ARITH_RULE `~(n <| n)`]; + REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `INJ v {x | x <| n} X = INJ u {x | x <| n} X` SUBGOAL_TAC; + IMATCH_MP_TAC inj_domain_sub; + UND 8; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `v n = supm X` SUBGOAL_TAC; + EXPAND_TAC "v"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `IMAGE v {x | x <| n} = IMAGE u {x | x <| n}` SUBGOAL_TAC; + IMATCH_MP_TAC image_domain_sub; + UND 8; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `IMAGE v {x | x <| n} = X DELETE supm X` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + UND 5; + ASM_REWRITE_TAC[]; + REWRITE_TAC[BIJ]; + alpha_tac; + MESON_TAC[SURJ_IMAGE]; + DISCH_TAC; + (* obligations *) + CONJ_TAC; + IMATCH_MP_TAC bij_inj_image; + CONJ_TAC; + TYPE_THEN `{x | x <| CARD X} = {x | x <| n} UNION {n}` SUBGOAL_TAC; + USE 2(REWRITE_RULE[HAS_SIZE]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[suc_interval]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC inj_split; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;DELETE]); + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + UND 13; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INJ;SUBSET]; + MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[INJ;SUBSET;INR IN_SING]; + ASM_MESON_TAC[]; + REWRITE_TAC[EQ_EMPTY;INTER;image_sing;INR IN_SING;]; + KILL 11; + ASM_REWRITE_TAC[DELETE;SUBSET;]; + MESON_TAC[]; + TYPE_THEN `X = supm X INSERT (X DELETE supm X)` SUBGOAL_TAC; + ASM_SIMP_TAC[INR INSERT_DELETE]; + USE 2 (REWRITE_RULE[HAS_SIZE]); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + REWRITE_TAC[INSERT_SUBSET]; + KILL 11; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `n` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `IMAGE v {x| x <| n}` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + USE 12 GSYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + ARITH_TAC; + REP_GEN_TAC; + (* monotonicity [m] *) + USE 2 (REWRITE_RULE[HAS_SIZE]); + ASM_REWRITE_TAC[]; + TYPE_THEN `(!x. X x ==> x <= supm X)` SUBGOAL_TAC; + ASM_MESON_TAC[finite_supm_max]; + DISCH_TAC; + TYPE_THEN `j = n` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `(v:num->real) i`)); + REWRITE_TAC[IMAGE;DELETE;]; + TSPEC `(v i)` 13; + UND 13; + MESON_TAC[REAL_ARITH `a < b <=> (a<= b /\ ~(a = b))`]; + KILL 3; + KILL 4; + KILL 5; + REP_BASIC_TAC; + TYPE_THEN `~(i = n)` SUBGOAL_TAC; + UND 2; + UND 3; + ARITH_TAC; + REWR 0; + DISCH_TAC; + TYPE_THEN `i <| n /\ j <| n` SUBGOAL_TAC; + UND 3; + UND 4; + UND 14; + UND 16; + ARITH_TAC; + REP_BASIC_TAC; + REWR 8; + ASM_SIMP_TAC[]; + (* end *) + REWRITE_TAC[HAS_SIZE]; + REP_BASIC_TAC; + RIGHT 1 "n" ; + TSPEC `X` 1; + TSPEC `CARD X` 1; + alpha_tac; + ASM_MESON_TAC[]; + (* Fri Aug 6 19:51:16 EDT 2004 *) + ]);; + (* }}} *) + +let connected_nogap = prove_by_refinement( + `!A a b. connected (top_of_metric(UNIV,d_real)) A /\ + A a /\ A b ==> + {x | a <= x /\ x <= b } SUBSET A`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(a = b) \/ (b < a) \/ (a < b)` SUBGOAL_TAC; + REAL_ARITH_TAC; + REP_CASES_TAC; + ASM_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= b ==> (x = b)`]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[REAL_ARITH `a <=x /\ x <= b ==> ~(b < a)`]; + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `a < x` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `(a <= x /\ ~(a = x)) ==> a < x`); + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `x < b` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `(x <= b /\ ~(b = x)) ==> x < b`); + ASM_MESON_TAC[]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[connected]); + REP_BASIC_TAC; + TYPEL_THEN [` {t | t < x}`;` {t | x < t}`] (USE 2 o SPECL); + UND 2; + REWRITE_TAC[half_open;half_open_above]; + TYPE_THEN `({t | t < x} INTER {t | x < t} = {}) /\ A SUBSET {t | t < x} UNION {t | x < t}` SUBGOAL_TAC; + REWRITE_TAC[INTER;EQ_EMPTY;UNION;SUBSET;]; + REWRITE_TAC[REAL_ARITH `x' < x \/ x < x' <=> ~(x' = x)`]; + CONJ_TAC; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[SUBSET;]; + ASM_MESON_TAC[REAL_ARITH `x < b ==> ~(b < x)`]; + (* Fri Aug 6 20:24:45 EDT 2004 *) + + ]);; + (* }}} *) + +let connected_open = prove_by_refinement( + `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\ + (top_of_metric(UNIV,d_real) A) /\ + (~(A = EMPTY)) /\ + A SUBSET {x | a <= x /\ x <= b}) ==> + ( A = {x | inf A < x /\ x < supm A})`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ supm A - epsilon < x))` SUBGOAL_TAC; + IMATCH_MP_TAC supm_eps; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ x < inf A + epsilon))` SUBGOAL_TAC; + IMATCH_MP_TAC inf_eps; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(!x. A x ==> x <= supm A)` SUBGOAL_TAC; + ASM_MESON_TAC[supm_UB]; + DISCH_TAC; + TYPE_THEN `(!x. A x ==> inf A <= x)` SUBGOAL_TAC; + ASM_MESON_TAC[inf_LB]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + TYPE_THEN `!x. (A x ==> ?e. &0 < e /\ open_ball(UNIV,d_real) x e SUBSET A)` SUBGOAL_TAC; + UND 2; + MP_TAC metric_real; + MESON_TAC[open_ball_nbd]; + REWRITE_TAC[open_ball;d_real]; + DISCH_TAC; + (* *) + TYPE_THEN `!x. A x ==> (?y. A y /\ ~(x <= y))` SUBGOAL_TAC; + REP_BASIC_TAC; + TSPEC `x` 8; + REWR 8; + REP_BASIC_TAC; + USE 8(REWRITE_RULE[SUBSET]); + TYPE_THEN `x - e/(&2)` EXISTS_TAC; + REWRITE_TAC[REAL_ARITH `~(x <= x - e/(&2)) <=> (&0 < e/(&2))`]; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[REAL_ARITH `(x - (x - t)) = t`]; + TYPE_THEN `abs (e/(&2)) = (e/(&2))` SUBGOAL_TAC; + REWRITE_TAC[REAL_ABS_REFL]; + IMATCH_MP_TAC (REAL_ARITH `(a < b) ==> (a <= b)`); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[REAL_LT_HALF2]; + DISCH_TAC; + (* *) + TYPE_THEN `!x. A x ==> (?y. A y /\ ~(y <= x))` SUBGOAL_TAC; + REP_BASIC_TAC; + TSPEC `x` 8; + REWR 8; + REP_BASIC_TAC; + USE 8(REWRITE_RULE[SUBSET]); + TYPE_THEN `x + e/(&2)` EXISTS_TAC; + REWRITE_TAC[REAL_ARITH `~( x + e/(&2) <= x) <=> (&0 < e/(&2))`]; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[REAL_ARITH `(x - (x + t)) = --. t`]; + TYPE_THEN `abs (--. (e/(&2))) = (e/(&2))` SUBGOAL_TAC; + REWRITE_TAC[REAL_ABS_REFL;ABS_NEG;]; + IMATCH_MP_TAC (REAL_ARITH `(a < b) ==> (a <= b)`); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[REAL_LT_HALF2]; + DISCH_TAC; + (* FIRST direction *) + CONJ_TAC; + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + REWRITE_TAC[REAL_ARITH `u < v <=> (u <= v /\ ~(u = v))`]; + CONJ_TAC; + CONJ_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* 2 *) + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + TYPE_THEN `?a'. A a' /\ (a' < x)` SUBGOAL_TAC; + TSPEC `x - inf A` 5; + USE 5 (REWRITE_RULE[REAL_ARITH `&0 < x - y <=> (y < x)`;REAL_ARITH `t + x - t = x`]); + REWR 5; + DISCH_TAC; + TSPEC `supm A - x` 4; + USE 4(REWRITE_RULE[REAL_ARITH `&0 < y - x <=> (x < y)`;REAL_ARITH `t - (t -x) = x`]); + REWR 4; + REP_BASIC_TAC; + TYPE_THEN `{t | a' <= t /\ t <= x'} SUBSET A` SUBGOAL_TAC; + IMATCH_MP_TAC connected_nogap; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_TAC; + TSPEC `x` 16; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 4; + UND 14; + REAL_ARITH_TAC; + (* Fri Aug 6 21:34:56 EDT 2004 *) + + ]);; + (* }}} *) + +let closure_real_set = prove_by_refinement( + `!Z a. + (closure(top_of_metric(UNIV,d_real)) Z a <=> + (!e. (&0 < e) ==> (?z. Z z /\ (abs (a - z) <= e))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `metric_space (UNIV,d_real) /\ Z SUBSET UNIV` SUBGOAL_TAC; + REWRITE_TAC[metric_real;SUBSET_UNIV]; + DISCH_THEN (fun t -> MP_TAC (MATCH_MP closure_open_ball t)); + DISCH_THEN (fun t -> MP_TAC (AP_THM t `a:real`)); + REWRITE_TAC[]; + DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]); + REWRITE_TAC[open_ball;d_real;]; + EQ_TAC; + ASM_MESON_TAC[REAL_ARITH `a < b ==> a <= b`]; + REP_BASIC_TAC; + TSPEC `r/(&2)` 1; + RULE_ASSUM_TAC (REWRITE_RULE[REAL_LT_HALF1]); + REWR 1; + REP_BASIC_TAC; + TYPE_THEN `z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `(a <= b/(&2)) /\ (b/(&2) < b) ==> (a < b)`); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[half_pos]; + (* Sat Aug 7 08:14:28 EDT 2004 *) + + ]);; + (* }}} *) + +let real_div_assoc = prove_by_refinement( + `!a b c. (a*b)/c = a*(b/c)`, + (* {{{ proof *) + [ + REWRITE_TAC[real_div;REAL_MUL_AC;]; + ]);; + (* }}} *) + +let real_middle1_lt = prove_by_refinement( + `!a b. (a < b) ==> a < (a + b)/(&2) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(&2*a)/(&2) < (a+b)/(&2)` SUBGOAL_TAC; + ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`]; + REWRITE_TAC[REAL_MUL_2]; + UND 0; + REAL_ARITH_TAC; + REWRITE_TAC[real_div_assoc]; + ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`]; + ]);; + (* }}} *) + +let real_middle2_lt = prove_by_refinement( + `!a b. (a < b) ==> (a + b)/(&2) < b `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN ` (a+b)/(&2) < (&2*b)/(&2)` SUBGOAL_TAC; + ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`]; + REWRITE_TAC[REAL_MUL_2]; + UND 0; + REAL_ARITH_TAC; + REWRITE_TAC[real_div_assoc]; + ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`]; + ]);; + (* }}} *) + +let real_sub_half = prove_by_refinement( + `!a b. (a - (a + b)/(&2) = (a - b)/(&2))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `((&2*a)/(&2) - (a+b)/(&2) = (a - b)/(&2))` SUBGOAL_TAC; + REWRITE_TAC[real_div;GSYM REAL_SUB_RDISTRIB]; + REWRITE_TAC[REAL_EQ_RMUL_IMP]; + AP_THM_TAC; + AP_TERM_TAC; + REWRITE_TAC[REAL_MUL_2]; + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ARITH `~(&2 = &0)`;REAL_DIV_LMUL;real_div_assoc]; + ]);; + (* }}} *) + +let closure_open_interval = prove_by_refinement( + `!a b. (a < b) ==> + (closure (top_of_metric(UNIV,d_real)) {x | a < x /\ x < b} = + {x | a <= x /\ x <= b}) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC closure_subset; + ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real]; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + (* 2 *) + TYPE_THEN `{x | a <= x /\ x <= b} = a INSERT (b INSERT {x | a < x /\ x < b})` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INSERT]; + GEN_TAC; + UND 0; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[INSERT_SUBSET]; + ASM_SIMP_TAC[top_of_metric_top;metric_real;subset_closure;]; + (* USE closure_real_set *) + REWRITE_TAC[closure_real_set]; + TYPE_THEN `!e. (&0 < e) ==> (a + e < b) \/ ((b - a)/(&2) < e)` SUBGOAL_TAC; + REP_BASIC_TAC; + ASM_CASES_TAC `(a + e < b)`; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `(x <= y/(&2) /\ y/(&2) < y) ==> (x < y)`); + ASM_SIMP_TAC [half_pos]; + ASM_SIMP_TAC[REAL_LE_DIV2_EQ;REAL_ARITH `&0 < &2`]; + UND 2; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + (* 1 *) + CONJ_TAC; + REP_BASIC_TAC; + TSPEC `e` 1; + REWR 1; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `a + e` EXISTS_TAC; + REWRITE_TAC[REAL_ARITH `(a < a + e <=> &0 < e) /\ (a - (a + e) = --. e)`]; + ASM_REWRITE_TAC[ABS_NEG;]; + IMATCH_MP_TAC (REAL_ARITH `(x = y) ==> (x <= y)`); + REWRITE_TAC[REAL_ABS_REFL]; + UND 2; + REAL_ARITH_TAC; + (* 2 *) + REP_BASIC_TAC; + TYPE_THEN `(a + b)/(&2)` EXISTS_TAC; + ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half]; + UND 3; + UND 0; + REWRITE_TAC[real_div;ABS_MUL]; + ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(a - b) = (b-a))`]; + TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC; + REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REAL_ARITH_TAC; + (* 3 *) + REP_BASIC_TAC; + TSPEC `e` 1; + REWR 1; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b - e` EXISTS_TAC; + REWRITE_TAC[REAL_ARITH `(b - e < b <=> &0 < e) /\ (b - (b - e) = e)`]; + REWRITE_TAC[REAL_ARITH `(a < b - e) <=> (a + e < b)`]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `(x = y) ==> (x <= y)`); + REWRITE_TAC[REAL_ABS_REFL]; + UND 2; + REAL_ARITH_TAC; + (* 4 *) + REP_BASIC_TAC; + TYPE_THEN `(b + a)/(&2)` EXISTS_TAC; + ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half]; + ONCE_REWRITE_TAC [REAL_ARITH `(a + b) = (b + a)`]; + ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half]; + UND 3; + UND 0; + REWRITE_TAC[real_div;ABS_MUL]; + ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(b - a) = (b-a))`]; + TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC; + REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REAL_ARITH_TAC; + (* Sat Aug 7 09:45:29 EDT 2004 *) + ]);; + + (* }}} *) + +let interval_subset = prove_by_refinement( + `!a b c d. {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d} <=> + (b < a) \/ ((c <= a ) /\ (b <= d))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET ]; + REP_BASIC_TAC; + ASM_CASES_TAC `b < a` ; + ASM_REWRITE_TAC[]; + UND 0; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `a` (WITH 1 o SPEC); + TYPE_THEN `b` (USE 1 o SPEC); + UND 0; + UND 1; + UND 2; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let subset_antisym_eq = prove_by_refinement( + `!(A:A->bool) B. (A = B) <=> (A SUBSET B /\ B SUBSET A) `, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;FUN_EQ_THM ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let interval_eq = prove_by_refinement( +(**** Parens added by JRH for real right associativity of = + `!a b c d. {x | a <= x /\ x <= b} = {x | c <= x /\ x <= d} = + ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`, + ****) + `!a b c d. ({x | a <= x /\ x <= b} = {x | c <= x /\ x <= d}) <=> + ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`, + (* {{{ proof *) + [ + REWRITE_TAC[subset_antisym_eq;interval_subset;]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let connected_open_closure = prove_by_refinement( + `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\ + (top_of_metric(UNIV,d_real) A) /\ + (closure (top_of_metric(UNIV,d_real)) A = {x | a <= x /\ x <= b}) ==> + (A = { x | a < x /\ x < b }))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* deal WITH emptyset *) + TYPE_THEN `A = EMPTY` ASM_CASES_TAC; + REWR 0; + UND 0; + ASM_SIMP_TAC[top_of_metric_top;metric_real;closure_empty;]; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x:real`)); + REWRITE_TAC[]; + REAL_ARITH_TAC; + (* deal WITH containment *) + TYPE_THEN `A SUBSET {x | a <= x /\ x <= b}` SUBGOAL_TAC; + USE 0 SYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_closure; + ASM_SIMP_TAC[top_of_metric_top;metric_real]; + DISCH_TAC; + (* quote previous result *) + TYPE_THEN `( A = {x | inf A < x /\ x < supm A})` SUBGOAL_TAC; + IMATCH_MP_TAC connected_open; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* now USE the closure of an open interval is the closed interval *) + + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + UND 3; + REWRITE_TAC[]; + ASM ONCE_REWRITE_TAC []; + REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `inf A < supm A` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + DISCH_TAC; + USE 7(MATCH_MP closure_open_interval); + UND 6; + UND 0; + REWRITE_TAC[]; + ASM ONCE_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + USE 0(REWRITE_RULE[interval_eq]); + FIRST_ASSUM DISJ_CASES_TAC; + UND 8; + UND 3; + UND 6; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + (* Sat Aug 7 10:38:12 EDT 2004 *) + + ]);; + (* }}} *) + +(* Sat Aug 7 11:01:27 EDT 2004 *) + +let closed_ball_empty = prove_by_refinement( + `!n a r. (r < &0) ==> (closed_ball(euclid n,d_euclid) a r = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[closed_ball;EQ_EMPTY;]; + ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> ~(r < &0)`]; + ]);; + (* }}} *) + +let closed_ball_pt = prove_by_refinement( + `!n a. (closed_ball(euclid n,d_euclid) a (&0) SUBSET {a})`, + (* {{{ proof *) + [ + REWRITE_TAC[closed_ball;SUBSET;INR IN_SING;]; + ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;REAL_ARITH `(x <= &0 /\ &0 <= x) ==> (x = &0)`]; + ]);; + (* }}} *) + +let closed_ball_subset_open = prove_by_refinement( + `!n a r. ?r'. closed_ball(euclid n,d_euclid) a r SUBSET + open_ball(euclid n,d_euclid) a r'`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[closed_ball;open_ball;SUBSET ]; + TYPE_THEN `r + &1` EXISTS_TAC; + MESON_TAC[ REAL_ARITH `(u <= r) ==> (u < r + &1)`]; + ]);; + (* }}} *) + +let closed_ball_compact = prove_by_refinement( + `!n a r. (compact (top_of_metric(euclid n,d_euclid)) + (closed_ball(euclid n,d_euclid) a r)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `closed_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC; + REWRITE_TAC[closed_ball;SUBSET]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `open_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC; + REWRITE_TAC[open_ball;SUBSET]; + MESON_TAC[]; + DISCH_TAC; + ASM_SIMP_TAC[compact_euclid;closed_ball_closed;metric_euclid;]; + REWRITE_TAC[metric_bounded]; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `r + &1`EXISTS_TAC; + REWRITE_TAC[open_ball;SUBSET;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + UND 2; + REWRITE_TAC[closed_ball]; + REP_BASIC_TAC; + TYPE_THEN `d_euclid a a = &0` SUBGOAL_TAC; + ASM_MESON_TAC[d_euclid_zero]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> &0 <= r`;REAL_ARITH `u <= r ==> (u < r + &1)`]; + (* Sat Aug 7 12:15:05 EDT 2004 *) + + ]);; + (* }}} *) + +let set_dist = jordan_def + `set_dist d (K:A->bool) (K':B->bool) = + inf { z | (?p p'. (K p /\ K' p' /\ (z = d p p')))}`;; + +let set_dist_inf = prove_by_refinement( + `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ + (K' SUBSET X) ==> + (!p p'. (K p /\ K' p' ==> (set_dist d K K' <= d p p')))`, + (* {{{ proof *) + [ + REWRITE_TAC[set_dist]; + REP_BASIC_TAC; + TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ; + TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC; + GEN_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `Y (d p p')` SUBGOAL_TAC; + + EXPAND_TAC "Y"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + + TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC; + CONJ_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `d p p'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN (ASSUME_TAC o (MATCH_MP inf_LB)); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let set_dist_nn = prove_by_refinement( + `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ + ~(K = EMPTY) /\ ~(K' = EMPTY) /\ + (K' SUBSET X) ==> (&0 <= set_dist d K K')`, + (* {{{ proof *) + [ + REWRITE_TAC[set_dist]; + REP_BASIC_TAC; + TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ; + TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC; + REP_BASIC_TAC; + UND 6; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `~(Y = {})` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + TYPE_THEN `d u' u` EXISTS_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN (ASSUME_TAC o (MATCH_MP inf_LB)); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let set_dist_eq = prove_by_refinement( + `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ + ~(K = EMPTY) /\ ~(K' = EMPTY) /\ + (compact (top_of_metric(X,d)) K) /\ + (compact (top_of_metric (X,d)) K') /\ + (K' SUBSET X) ==> + (?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))`, + (* {{{ proof *) + [ + REWRITE_TAC[set_dist]; + REP_BASIC_TAC; + TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ; + TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC; + REP_BASIC_TAC; + UND 8; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[metric_space]); + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + TYPE_THEN `~(Y = {})` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + TYPE_THEN `d u' u` EXISTS_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN (ASSUME_TAC o (MATCH_MP inf_LB)); + TYPE_THEN `(?p p'. K p /\ K' p' /\ (!q q'. K q /\ K' q' ==> d p p' <= d q q'))` SUBGOAL_TAC; + IMATCH_MP_TAC compact_distance; + TYPE_THEN `X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `p` EXISTS_TAC; + TYPE_THEN `p'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* 1 *) + TYPE_THEN `Y (d p p')` SUBGOAL_TAC; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC (REAL_ARITH `a <= b /\ b <= a ==> (a = b)`); + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + EXPAND_TAC "Y"; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Sat Aug 7 13:19:01 EDT 2004 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION L *) +(* ------------------------------------------------------------------ *) + + +let simple_arc_compact = prove_by_refinement( + `!C. simple_arc top2 C ==> compact top2 C`, + (* {{{ proof *) + + [ + REWRITE_TAC[simple_arc]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC image_compact; + TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[inj_image_subset;interval_compact;]; + (* Sat Aug 7 12:24:22 EDT 2004 *) + + ]);; + + (* }}} *) + +let simple_arc_nonempty = prove_by_refinement( + `!C. simple_arc top2 C ==> ~(C = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc;EMPTY_EXISTS;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[IMAGE;]; + TYPE_THEN `f (&0)` EXISTS_TAC; + TYPE_THEN `&0` EXISTS_TAC; + REWRITE_TAC[]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let graph_edge_compact = prove_by_refinement( + `!G e. (plane_graph G) /\ (graph_edge G e) ==> + (compact top2 e)`, + (* {{{ proof *) + [ + REWRITE_TAC [plane_graph]; + REP_BASIC_TAC; + USE 3 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[simple_arc_compact]; + ]);; + (* }}} *) + +let graph_vertex_exist = prove_by_refinement( + `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==> + (?v. graph_vertex G v)`, + (* {{{ proof *) + + [ + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC; + ASM_SIMP_TAC[graph_inc_subset]; + DISCH_TAC; + TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC; + ASM_SIMP_TAC[graph_edge2;]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + REWR 2; + UND 2; + REWRITE_TAC[SUBSET ;INR in_pair ]; + MESON_TAC[]; + ]);; + + (* }}} *) + +let graph_vertex_2 = prove_by_refinement( + `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==> + (?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))`, + (* {{{ proof *) + [ + REWRITE_TAC[EMPTY_EXISTS]; + REP_BASIC_TAC; + TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC; + ASM_SIMP_TAC[graph_inc_subset]; + DISCH_TAC; + TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC; + ASM_SIMP_TAC[graph_edge2;]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + REWR 2; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC ; + UND 2; + REWRITE_TAC[SUBSET ;INR in_pair ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_disk_lemma1 = prove_by_refinement( + `!G. plane_graph G /\ FINITE (graph_vertex G) /\ FINITE (graph_edge G) + ==> + FINITE {z | (?e v. graph_edge G e /\ graph_vertex G v /\ + ~(graph_inc G e v) /\ (z = (e,v)))}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `Y = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) /\ (z = (e,v)))}` ABBREV_TAC ; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{(e,v) | graph_edge G e /\ graph_vertex G v}` EXISTS_TAC; + TYPEL_THEN [`graph_edge G `;`graph_vertex G `] (fun t -> ASSUME_TAC (ISPECL t FINITE_PRODUCT)); + REWR 4; + ASM_REWRITE_TAC[]; + EXPAND_TAC "Y"; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + (* Sat Aug 7 14:21:19 EDT 2004 *) + + ]);; + (* }}} *) + +let image_empty = prove_by_refinement( + `!(A:A->bool) (f:A->B). (IMAGE f A = EMPTY) <=> (A = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[IMAGE;FUN_EQ_THM;]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* not used *) +let pair_apply = prove_by_refinement( + `!P. (!x. P x) <=> ! (u:A) (v:B) . P (u,v)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + EQ_TAC; + REP_BASIC_TAC; + TSPEC `(u,v)` 0; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPEL_THEN [`FST x`;`SND x`] (USE 0 o ISPECL); + USE 0(REWRITE_RULE[]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let set_dist_pos = prove_by_refinement( + `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\ + ~(K = EMPTY) /\ ~(K' = EMPTY) /\ + (compact (top_of_metric(X,d)) K) /\ + (compact (top_of_metric (X,d)) K') /\ (K INTER K' = EMPTY) /\ + (K' SUBSET X) ==> + (&0 < (set_dist d K K' ))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`); + CONJ_TAC; + TYPE_THEN `(?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))` SUBGOAL_TAC; + IMATCH_MP_TAC set_dist_eq; + TYPE_THEN `X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `p = p'` SUBGOAL_TAC; + REWR 9; + TYPE_THEN `X p /\ X p'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + USE 9 SYM; + REP_BASIC_TAC; + UND 9; + ASM_MESON_TAC [metric_space_zero2]; + UND 1; + UND 10; + UND 11; + REWRITE_TAC[EQ_EMPTY;INTER;]; + MESON_TAC[]; + IMATCH_MP_TAC set_dist_nn; + TYPE_THEN `X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let closed_ball_inter = prove_by_refinement( + `!(x:A) y r r' X d. (metric_space(X,d) /\ + ~(closed_ball(X,d) x r INTER closed_ball(X,d) y r' = EMPTY) ==> + (d x y <= r + r'))`, + (* {{{ proof *) + + [ + REWRITE_TAC[closed_ball;EMPTY_EXISTS;INTER]; + REP_BASIC_TAC; + TYPE_THEN `d x y <= d x u + d u y` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_triangle; + ASM_MESON_TAC[]; + TYPE_THEN `d u y = d y u` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_symm; + ASM_MESON_TAC[]; + UND 0; + UND 3; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let graph_disk = prove_by_refinement( + `!G. plane_graph G /\ + FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ + ~(graph_edge G = EMPTY) + ==> (?r. (&0 < r ) /\ + (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> + (closed_ball (euclid 2,d_euclid) v r INTER + closed_ball (euclid 2,d_euclid) v' r = EMPTY)) /\ + (!e v. (graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) ==> + (e INTER closed_ball (euclid 2,d_euclid) v r = EMPTY) )))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + (* A' *) + TYPE_THEN `A = { (v,v') | (graph_vertex G v) /\ graph_vertex G v' /\ ~(v = v') }` ABBREV_TAC ; + TYPE_THEN `FINITE A` SUBGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{ (v,v') | (graph_vertex G v) /\ graph_vertex G v'}` EXISTS_TAC; + TYPEL_THEN [`graph_vertex G`;`graph_vertex G`] (fun t-> ASSUME_TAC (ISPECL t FINITE_PRODUCT)); + REWR 5; + ASM_REWRITE_TAC[]; + EXPAND_TAC "A"; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `A' = IMAGE (\ (v,v'). (d_euclid v v')/(&2)) A` ABBREV_TAC ; + TYPE_THEN `FINITE A'` SUBGOAL_TAC; + EXPAND_TAC "A'"; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* [B] *) + TYPE_THEN `B = { (e,v) | graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) }` ABBREV_TAC ; + TYPE_THEN `B' = IMAGE (\ (e,v). (set_dist d_euclid {v} e)) B` ABBREV_TAC ; + TYPE_THEN `FINITE B'` SUBGOAL_TAC; + EXPAND_TAC "B'"; + IMATCH_MP_TAC FINITE_IMAGE; + TYPE_THEN `B = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~( graph_inc G e v) /\ (z = (e,v)))}` SUBGOAL_TAC; + EXPAND_TAC "B"; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC graph_disk_lemma1; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* [C] : A' B' C nonempty *) + TYPE_THEN `C' = A' UNION B'` ABBREV_TAC ; + TYPE_THEN `FINITE C' /\ ~(C' = EMPTY)` SUBGOAL_TAC; + EXPAND_TAC "C'"; + ASM_REWRITE_TAC[FINITE_UNION]; + EXPAND_TAC "C'"; + REWRITE_TAC[EMPTY_EXISTS;UNION;]; + TYPE_THEN `~(A' = EMPTY)` SUBGOAL_TAC; + EXPAND_TAC "A'"; + REWRITE_TAC[image_empty; ]; + TYPE_THEN `(?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))` SUBGOAL_TAC; + IMATCH_MP_TAC graph_vertex_2; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[plane_graph]; + REP_BASIC_TAC; + UND 12; + REWRITE_TAC[]; + EXPAND_TAC "A"; + REWRITE_TAC[EMPTY_EXISTS]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + MESON_TAC[]; + DISCH_TAC; + (* [D]: C(inf C) *) + TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; + UND 3; + REWRITE_TAC[plane_graph]; + MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `C'(inf C')` SUBGOAL_TAC; + IMATCH_MP_TAC finite_inf; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!x. C' x ==> (inf C' <= x)` SUBGOAL_TAC; + IMATCH_MP_TAC finite_inf_min; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!v. (graph_vertex G v ==> compact top2 {v})` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC compact_point; + UND 13; + REWRITE_TAC[SUBSET;top2_unions]; + UND 12; + MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!e. (graph_edge G e ==> compact top2 e)` SUBGOAL_TAC; + ASM_MESON_TAC[graph_edge_compact]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!x. A' x <=> (?v' v''. graph_vertex G v' /\ graph_vertex G v'' /\ ~(v' = v'') /\ (x = d_euclid v' v'' / &2))` SUBGOAL_TAC; + EXPAND_TAC "A'"; + EXPAND_TAC "A"; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x'"); +(*** Next steps removed by JRH: now paired beta-conversion automatic ***) + DISCH_TAC; + (* -- *) + TYPE_THEN `!x. B' x <=> (?e' v'. graph_edge G e' /\ graph_vertex G v' /\ ~(graph_inc G e' v') /\ (x = set_dist d_euclid { v' } e'))` + SUBGOAL_TAC; + EXPAND_TAC "B'"; + EXPAND_TAC "B"; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x'"); +(*** Next steps removed by JRH: now paired beta-conversion automatic ***) + DISCH_TAC; + (* -- [temp] *) + TYPE_THEN `!x. C' x ==> (&0 < x)` SUBGOAL_TAC; + EXPAND_TAC "C'"; + REWRITE_TAC[UNION]; + GEN_TAC; + DISCH_THEN DISJ_CASES_TAC; + UND 20; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + IMATCH_MP_TAC (REAL_ARITH `(&0 <= y /\ ~(y = &0) ) ==> &0 < y `); + TYPE_THEN `euclid 2 v' /\ euclid 2 v''` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + UND 20; + ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;]; + (* -2- *) + UND 20; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC set_dist_pos; + TYPE_THEN `euclid 2` EXISTS_TAC ; + REWRITE_TAC[metric_euclid;single_subset]; + CONJ_TAC; + UND 13; + REWRITE_TAC[SUBSET]; + UND 21; + MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[EMPTY_EXISTS;INR IN_SING;]; + MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_nonempty; + UND 3; + UND 22; + REWRITE_TAC[plane_graph;SUBSET;]; + MESON_TAC[]; + REWRITE_TAC[GSYM top2]; + ASM_SIMP_TAC[]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TSPEC `e'` 25; + REWR 25; + TYPE_THEN `v'` (fun u -> FIRST_ASSUM (fun t-> (MP_TAC (AP_THM t u)))); + ASM_REWRITE_TAC[EQ_EMPTY;]; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[INR IN_SING;]; + MESON_TAC[]; + UND 22; + UND 17; + REWRITE_TAC[compact;top2_unions]; + MESON_TAC[]; + DISCH_TAC; + (* [E] r good for A' *) + TYPE_THEN `?r. (&0 < r /\ r < inf C')` SUBGOAL_TAC; + TYPE_THEN `inf C' /(&2)` EXISTS_TAC; + IMATCH_MP_TAC half_pos; + UND 20; + UND 14; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `r` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `A' ((d_euclid v v')/(&2))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -2- *) + TYPE_THEN `r < ((d_euclid v v')/(&2))` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `(?t . (r < t /\ t <= u)) ==> (r < u)`); + TYPE_THEN `inf C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + EXPAND_TAC "C'"; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWRITE_TAC[EQ_EMPTY ;INTER;]; + REP_BASIC_TAC; + (* -2- triangle ineq *) + UND 29; + UND 30; + UND 28; + UND 21; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + (* [* temp] *) + TYPE_THEN `d_euclid v v' <= r + r` SUBGOAL_TAC; + IMATCH_MP_TAC closed_ball_inter; + TYPE_THEN `euclid 2` EXISTS_TAC; + REWRITE_TAC[INTER;EMPTY_EXISTS ;metric_euclid;]; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `d_euclid v v' < d_euclid v v'/(&2) + d_euclid v v'/(&2)` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `(?t. (d <= t + t /\ t < u)) ==> (d < u + u)`); + TYPE_THEN `r` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_HALF_DOUBLE]; + REAL_ARITH_TAC; + (* [F] good for B' *) + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER;]); + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `B' (set_dist d_euclid {v} e)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `r < set_dist d_euclid {v} e` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `(?t. (r < t /\ t <= q)) ==> (r < q)`); + TYPE_THEN `inf C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + EXPAND_TAC "C'"; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `(!p p'. ({v} p /\ e p' ==> (set_dist d_euclid {v} e <= d_euclid p p')))` SUBGOAL_TAC; + IMATCH_MP_TAC set_dist_inf; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid;single_subset;]; + CONJ_TAC; + UND 13; + UND 25; + MESON_TAC[ISUBSET]; + UND 17; + UND 26; + REWRITE_TAC[compact;top2_unions;]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `set_dist d_euclid {v} e <= d_euclid v u` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[INR IN_SING]; + TYPE_THEN `d_euclid v u <= r` SUBGOAL_TAC; + UND 27; + REWRITE_TAC[closed_ball]; + MESON_TAC[]; + UND 30; + REAL_ARITH_TAC; + (* Sat Aug 7 21:33:13 EDT 2004 *) + + ]);; + + (* }}} *) + +let norm2 = jordan_def `norm2 x = d_euclid x euclid0`;; + +let cis = jordan_def `cis x = point(cos(x),sin(x))`;; + +let norm2_cis = prove_by_refinement( + `!x. norm2(cis(x)) = &1`, + (* {{{ proof *) + [ + REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point]; + REDUCE_TAC; + ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`]; + REWRITE_TAC[SIN_CIRCLE;SQRT_1]; + (* Sat Aug 7 21:47:16 EDT 2004 *) + ]);; + (* }}} *) + +let norm2_nn = prove_by_refinement( + `!x . (euclid 2 x) ==> &0 <= norm2 x`, + (* {{{ proof *) + [ + REWRITE_TAC[norm2;euclid0_point]; + ASM_MESON_TAC[d_euclid_pos;euclid_point]; + (* Sat Aug 7 21:52:31 EDT 2004 *) + + ]);; + (* }}} *) + +let norm2_0 = prove_by_refinement( + `!x. (euclid 2 x) /\ (norm2 x = &0) <=> (x = euclid0)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + EQ_TAC; + REWRITE_TAC[norm2;euclid0_point;]; + MESON_TAC[d_euclid_zero;euclid_point]; + DISCH_THEN_REWRITE; + REWRITE_TAC[euclid0_point;euclid_point;norm2;]; + ASM_MESON_TAC[d_euclid_zero;euclid_point]; + (* Sat Aug 7 21:59:11 EDT 2004 *) + ]);; + (* }}} *) + +let cis_inj = prove_by_refinement( + `!t t'. (&0 <= t /\ t < &2*pi) /\ (&0 <= t' /\ t' < &2*pi) ==> + ((cis t = cis t') <=> (t = t'))`, + (* {{{ proof *) + [ + (* A trivial direction *) + REP_BASIC_TAC; + REWRITE_TAC[cis;point_inj;PAIR_SPLIT ]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + EQ_TAC; + DISCH_THEN_REWRITE; + (* B range of s *) + REP_BASIC_TAC; + TYPE_THEN `s = (\t. (if (t < pi) then t else ((&2)*pi - t)))` ABBREV_TAC ; + TYPE_THEN `!t. (&0 <= t /\ t < (&2 * pi)) ==> (&0 <= s t /\ s t <= pi)` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC "s"; + COND_CASES_TAC; + UND 9; + UND 8; + REAL_ARITH_TAC; + CONJ_TAC; + UND 7; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_2;]; + UND 9; + REAL_ARITH_TAC; + DISCH_TAC; + (* [C] : cos (s t) *) + TYPE_THEN `!t. cos (s t) = cos t` SUBGOAL_TAC; + EXPAND_TAC "s"; + GEN_TAC; + COND_CASES_TAC; + REWRITE_TAC[]; + REWRITE_TAC [REAL_ARITH `x - t = (--. t + x)`;COS_PERIODIC;COS_NEG]; + DISCH_TAC; + (* D : (s t) = (s t') *) + TYPE_THEN `(s t= s t') ==> ((t = t') \/ (t' = (&2 * pi - t)))` SUBGOAL_TAC; + EXPAND_TAC "s"; + COND_CASES_TAC; + COND_CASES_TAC; + MESON_TAC[]; + REAL_ARITH_TAC; + COND_CASES_TAC; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + DISCH_TAC; + (* E : show s t = s t' *) + USE 8 GSYM; + UND 5; + (ASM ONCE_REWRITE_TAC []); + DISCH_THEN (fun t -> MP_TAC (AP_TERM `acs` t)); + DISCH_TAC; + TYPE_THEN `s t = s t'` SUBGOAL_TAC; + TYPE_THEN `acs (cos (s t)) = s t` SUBGOAL_TAC; + IMATCH_MP_TAC COS_ACS; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `acs (cos (s t')) = s t'` SUBGOAL_TAC; + IMATCH_MP_TAC COS_ACS; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 9; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + UND 4; + ASM_REWRITE_TAC[]; + REWRITE_TAC[(REAL_ARITH `x - y = -- y + x`);SIN_PERIODIC ;SIN_NEG ;]; + REWRITE_TAC [(REAL_ARITH `(x = --x) <=> (x = &0)`)]; + REWRITE_TAC[SIN_ZERO_PI]; + PROOF_BY_CONTR_TAC; + USE 4 (REWRITE_RULE[]); + (* now t is a MULT of pi, finish *) + FIRST_ASSUM DISJ_CASES_TAC; + REP_BASIC_TAC; + UND 2; + ASM_REWRITE_TAC[]; + ASSUME_TAC PI_POS; + ASM_SIMP_TAC[REAL_LT_RMUL_EQ]; + REWRITE_TAC [REAL_LT]; + REWRITE_TAC[ARITH_RULE `n <| 2 <=> (n = 0) \/ (n =1)`]; + DISCH_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + REWR 13; + REWR 11; + UND 0; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + UND 12; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + REP_BASIC_TAC; + UND 3; + ASM_REWRITE_TAC[]; + ASSUME_TAC PI_POS; + REWRITE_TAC[REAL_ARITH (` ~(&0 <= -- x) <=> (&0 <. x) `)]; + IMATCH_MP_TAC REAL_LT_MUL; + ASM_REWRITE_TAC[REAL_LT ]; + REWRITE_TAC[ARITH_RULE `0 <| n <=> ~(n = 0)`]; + DISCH_TAC; + UND 0; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* Sun Aug 8 08:42:13 EDT 2004 *) + + ]);; + (* }}} *) + +let norm2_scale_cis = prove_by_refinement( + `!x r. norm2(r *# cis(x)) = abs (r)`, + (* {{{ proof *) + + [ + REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;]; + REDUCE_TAC; + REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB]; + ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`]; + REWRITE_TAC[SIN_CIRCLE;REAL_MUL_RID;POW_2_SQRT_ABS]; + (* Sun Aug 8 08:46:56 EDT 2004 *) + + ]);; + + (* }}} *) + +let norm2_scale = prove_by_refinement( + `!x r. (euclid 2 x) ==> (norm2(r *# x) = abs (r)*norm2(x))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?u v. (x = point(u,v))` SUBGOAL_TAC; + USE 0 (MATCH_MP point_onto); + REP_BASIC_TAC; + TYPE_THEN `FST p` EXISTS_TAC; + TYPE_THEN `SND p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;]; + REDUCE_TAC; + REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB]; + REWRITE_TAC[GSYM POW_2_SQRT_ABS]; + IMATCH_MP_TAC SQRT_MUL; + REWRITE_TAC[REAL_LE_SQUARE_POW]; + IMATCH_MP_TAC (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`); + REWRITE_TAC[REAL_LE_SQUARE_POW]; + + ]);; + (* }}} *) + +let polar_inj = prove_by_refinement( + `!x x' r r'. (&0 <= r) /\ (&0 <= r') /\ (&0 <= x) /\ (&0 <= x') /\ + (x < &2 *pi) /\ (x' < &2 * pi) /\ (r *# cis(x) = r' *# cis(x')) ==> + ((r = &0) /\ (r' = &0)) \/ ((r = r') /\ (x = x'))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `abs r = abs r'` SUBGOAL_TAC; + FIRST_ASSUM (fun t -> MP_TAC (AP_TERM `norm2` t)); + REWRITE_TAC[norm2_scale_cis]; + DISCH_TAC; + TYPE_THEN `r' = r` SUBGOAL_TAC; + ASM_MESON_TAC[ABS_REFL]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + ASM_CASES_TAC `(r = &0)` ; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWR 0; + TYPE_THEN `cis x = cis x'` SUBGOAL_TAC; + IMATCH_MP_TAC euclid_scale_cancel; + ASM_MESON_TAC[]; + ASM_MESON_TAC[cis_inj]; + ]);; + + (* }}} *) + +let norm2_bounds = prove_by_refinement( + `!a b s t. (&0 < a) /\ (a < b) /\ (&0 <= t) /\ (t <= &1) ==> + (a <= norm2((a + t*(b-a))*# cis(s))) /\ + ( norm2((a + t*(b-a))*# cis(s)) <= b) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[norm2_scale_cis]; + TYPE_THEN `a <= a + t*(b - a)` SUBGOAL_TAC; + REWRITE_TAC[REAL_ARITH `x <= x + y <=> (&0 <= y)`]; + IMATCH_MP_TAC REAL_LE_MUL; + ASM_REWRITE_TAC[]; + UND 2; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `&0 <= a + t*(b-a)` SUBGOAL_TAC; + UND 4; + UND 3; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `abs (a + t*(b-a)) = a + t*(b-a)` SUBGOAL_TAC; + REWRITE_TAC[ABS_REFL]; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ineq_le_tac `(a + t*(b-a)) + (&1 - t)*(b - a) = b`; + (* Sun Aug 8 09:12:18 EDT 2004 *) + + ]);; + (* }}} *) + +let norm2_point = prove_by_refinement( + `!u v. norm2(point(u,v)) = sqrt(u pow 2 + v pow 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[norm2;euclid0_point;d_euclid_point;]; + REDUCE_TAC; + ]);; + (* }}} *) + +let cis_exist_lemma = prove_by_refinement( + `!x. (euclid 2 x) /\ (norm2 x = &1) ==> + (? t. x = cis(t))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `? u v. x = point (u,v)` SUBGOAL_TAC; + USE 1 (MATCH_MP point_onto); + REP_BASIC_TAC; + TYPE_THEN `FST p` EXISTS_TAC; + TYPE_THEN `SND p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWR 0; + UND 0; + REWRITE_TAC[norm2_point]; + DISCH_TAC; + USE 0 (fun t -> AP_TERM `\t. t pow 2` t); + UND 0; + BETA_TAC; + REDUCE_TAC; + TYPE_THEN `(sqrt (u pow 2 + v pow 2) pow 2 = u pow 2 + v pow 2)` SUBGOAL_TAC; + IMATCH_MP_TAC SQRT_POW_2; + IMATCH_MP_TAC (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`); + ASM_REWRITE_TAC[REAL_LE_POW_2]; + DISCH_THEN_REWRITE; + DISCH_THEN (fun t -> MP_TAC (MATCH_MP CIRCLE_SINCOS t)); + REP_BASIC_TAC; + ASM_REWRITE_TAC[cis]; + MESON_TAC[]; + + ]);; + (* }}} *) + +let cos_period = prove_by_refinement( + `! j t. (cos (t + &j * &2 *pi) = cos(t))`, + (* {{{ proof *) + [ + INDUCT_TAC; + REDUCE_TAC; + REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;]; + REDUCE_TAC; + REWRITE_TAC[COS_PERIODIC]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let sin_period = prove_by_refinement( + `! j t. (sin (t + &j * &2 *pi) = sin(t))`, + (* {{{ proof *) + [ + INDUCT_TAC; + REDUCE_TAC; + REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;]; + REDUCE_TAC; + REWRITE_TAC[SIN_PERIODIC]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let cos_period_neg = prove_by_refinement( + `! j t. (cos (t - &j * &2 *pi) = cos(t))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC cos_period; + TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL); + RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]); + USE 0 SYM; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let sin_period_neg = prove_by_refinement( + `! j t. (sin (t - &j * &2 *pi) = sin(t))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC sin_period; + TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL); + RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]); + USE 0 SYM; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let cos_period_int = prove_by_refinement( + `!m t. (cos (t + real_of_int m * &2 *pi) = cos (t))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC INT_REP2 ; + TSPEC `m` 0; + REP_BASIC_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[int_of_num_th;cos_period]; + ASM_REWRITE_TAC[int_of_num_th;int_neg_th;cos_period_neg;GSYM real_sub;REAL_MUL_LNEG]; + ]);; + (* }}} *) + +let sin_period_int = prove_by_refinement( + `!m t. (sin (t + real_of_int m * &2 *pi) = sin (t))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC INT_REP2 ; + TSPEC `m` 0; + REP_BASIC_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[int_of_num_th;sin_period]; + ASM_REWRITE_TAC[int_of_num_th;int_neg_th;sin_period_neg;GSYM real_sub;REAL_MUL_LNEG]; + ]);; + (* }}} *) + +let cos_sin_reduce = prove_by_refinement( + `!t. ?t'. (cos t = cos t') /\ + (sin t = sin t') /\ (&0 <= t') /\ (t' < &2 * pi)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + ASSUME_TAC floor_ineq; + TSPEC `t/(&2 *pi)` 0; + TYPE_THEN `f = floor (t/(&2 * pi))` ABBREV_TAC ; + REP_BASIC_TAC; + TYPE_THEN `t' = t - real_of_int(f)*(&2)*pi` ABBREV_TAC ; + TYPE_THEN `t'` EXISTS_TAC; + TYPE_THEN `t' = t + real_of_int (--: f) *(&2)*pi` SUBGOAL_TAC; + EXPAND_TAC "t'"; + REWRITE_TAC[REAL_ARITH `x -y = x + (-- y)`;REAL_ARITH `-- (x * y) = (-- x)*y`;GSYM int_neg_th]; + DISCH_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[cos_period_int]; + CONJ_TAC; + ASM_REWRITE_TAC[sin_period_int]; + EXPAND_TAC "t'"; + TYPE_THEN `&0 < (&2 *pi)` SUBGOAL_TAC; + REWRITE_TAC[REAL_MUL_2]; + MP_TAC PI_POS; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(&0 = &2* pi)` SUBGOAL_TAC; + UND 5; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `t = (t/(&2 *pi))*(&2 *pi)` SUBGOAL_TAC; + ASM_SIMP_TAC[REAL_DIV_RMUL]; + DISCH_TAC; + USE 7 SYM ; + TYPE_THEN `&0 <= (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi)` SUBGOAL_TAC; + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; + IMATCH_MP_TAC REAL_LE_MUL; + UND 2; + UND 5; + REAL_ARITH_TAC; + KILL 4; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + EXPAND_TAC "t'"; + TYPE_THEN ` (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi) < &1* &2*pi` SUBGOAL_TAC; + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB]; + IMATCH_MP_TAC REAL_LT_RMUL; + UND 0; + UND 5; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + (* Tue Aug 10 09:57:36 EDT 2004 *) + + ]);; + + (* }}} *) + +let cis_lemma = prove_by_refinement( + `!x. (euclid 2 x) /\ (norm2 x = &1) ==> + (?t. &0 <= t /\ t < &2 * pi /\ (x = cis t))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?t. x = cis t)` SUBGOAL_TAC; + IMATCH_MP_TAC cis_exist_lemma; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASSUME_TAC cos_sin_reduce; + TSPEC `t` 3; + REP_BASIC_TAC; + ASM_REWRITE_TAC[cis;point_inj;PAIR_SPLIT]; + ASM_MESON_TAC[]; + (* Tue Aug 10 10:01:55 EDT 2004 *) + ]);; + (* }}} *) + +let polar_exist = prove_by_refinement( + `!x. (euclid 2 x) ==> + (?r t. (&0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = r *# cis(t))))`, + (* {{{ proof *) + [ + (* A: trivial case of norm 0 *) + REP_BASIC_TAC; + ASM_CASES_TAC `norm2 x = &0` ; + TYPE_THEN `x = euclid0` SUBGOAL_TAC; + ASM_MESON_TAC[norm2_0]; + DISCH_THEN_REWRITE; + TYPE_THEN `&0` EXISTS_TAC; + TYPE_THEN `&0` EXISTS_TAC; + REWRITE_TAC[euclid_scale0;REAL_MUL_2 ]; + MP_TAC PI_POS; + REAL_ARITH_TAC; + (* B: rescale to 1 *) + TYPE_THEN `&0 < norm2 x` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC norm2_nn; + ASM_REWRITE_TAC[]; + TYPE_THEN `r = norm2 x ` ABBREV_TAC ; + DISCH_TAC; + TYPE_THEN `r` EXISTS_TAC; + TYPE_THEN `y = (&1/r)*# x` ABBREV_TAC ; + TYPE_THEN `x = r*# y` SUBGOAL_TAC; + EXPAND_TAC "y"; + REWRITE_TAC[euclid_scale_act;GSYM real_div_assoc]; + REDUCE_TAC; + ASM_SIMP_TAC[REAL_DIV_REFL; euclid_scale_one;]; + DISCH_TAC; + REWR 2; + ASM_REWRITE_TAC[]; + TYPE_THEN `euclid 2 y` SUBGOAL_TAC; + EXPAND_TAC "y"; + IMATCH_MP_TAC euclid_scale_closure; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 2; + ASM_SIMP_TAC[norm2_scale]; + TYPE_THEN `abs r = r` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_ABS_REFL]; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + DISCH_TAC; + TYPE_THEN `norm2 y = &1` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_EQ_LCANCEL_IMP; + TYPE_THEN `r` EXISTS_TAC; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* C: invoke norm2=1 case *) + TYPE_THEN `(?t. &0 <= t /\ t < &2 * pi /\ (y = cis t))` SUBGOAL_TAC; + IMATCH_MP_TAC cis_lemma; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +(* +vert r = hyperplane 2 e1 r +horz r = hyperplane 2 e2 r +cf. line2D_F..., line2D_S.... +*) + +let subset_union_pair = prove_by_refinement( + `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==> + (A UNION B) SUBSET (A' UNION B')`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + ]);; + (* }}} *) + +let subset_inter_pair = prove_by_refinement( + `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==> + (A INTER B) SUBSET (A' INTER B')`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + ]);; + (* }}} *) + +let simple_arc_end_simple = prove_by_refinement( + `!C v v'. simple_arc_end C v v' ==> simple_arc top2 C`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end;simple_arc]; + REP_BASIC_TAC; + REWRITE_TAC[top2_unions]; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Tue Aug 10 10:33:30 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_restriction = prove_by_refinement( + `!C K K' . simple_arc top2 C /\ closed_ top2 K /\ + closed_ top2 K' /\ (C INTER K INTER K' = EMPTY ) /\ + ~(C INTER K = EMPTY ) /\ ~(C INTER K' = EMPTY) ==> + (?C' v v'. C' SUBSET C /\ simple_arc_end C' v v' /\ + (C' INTER K = {v}) /\ (C' INTER K' = {v'})) `, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `(?C' f. (C' = IMAGE f {x | &0 <= x /\ x <= &1 }) /\ C' SUBSET C /\ continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= (&1)} (euclid 2) /\ (C' INTER K = {(f (&0))}) /\ (C' INTER K' = {(f (&1))}))` SUBGOAL_TAC; + IMATCH_MP_TAC curve_restriction; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + REP_BASIC_TAC; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `f(&0)` EXISTS_TAC; + TYPE_THEN `f(&1)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[simple_arc_end]; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let simple_arc_end_trans = prove_by_refinement( + `!C C' v v' v'' . simple_arc_end C v v' /\ simple_arc_end C' v' v'' /\ + ( C INTER C' = {v'}) ==> + simple_arc_end (C UNION C') v v''`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ &0 < &1/(&2) /\ &0 < &1` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + REAL_ARITH_TAC; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + KILL 12; + TYPE_THEN `continuous f' (top_of_metric (UNIV,d_real)) top2 /\ INJ f' {x | &0 <= x /\ x <= &1} (euclid 2) /\ &1/(&2) < &1 /\ &0 < &1` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF2]; + REAL_ARITH_TAC; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + KILL 17; + TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC; + (* A: prelims *) + TYPE_THEN `&0 < &1/(&2) /\ &1/(&2) < &1` SUBGOAL_TAC; + REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2]; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM union_closed_interval); + UND 17; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &0 <= x /\ x < &1} SUBSET {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &0 <= x /\ x < &1 / &2} SUBSET {x | x < &1/(&2)}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &1 / &2 <= x /\ x <= &1} SUBSET {x | &1/ (&2) <= x}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)} = {x | &0 <= x /\ x < &1/(&2)} UNION {(&1 /(&2))}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING ]; + GEN_TAC; + UND 17; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `g (&1/(&2)) = g' (&1/(&2))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + (* [B]: IMAGE *) + SUBCONJ_TAC; + ASM_REWRITE_TAC[IMAGE_UNION]; + ASM_SIMP_TAC[joinf_image_above;joinf_image_below]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[union_subset]; + CONJ_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET_UNION]; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[IMAGE;INR IN_SING;]; + NAME_CONFLICT_TAC; + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "x''"); + GEN_TAC; + DISCH_THEN_REWRITE; + UND 27; + DISCH_THEN_REWRITE; + DISJ2_TAC ; + TYPE_THEN `&1/(&2)` EXISTS_TAC; + REWRITE_TAC[]; + UND 17; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET_UNION]; + (* --2-- *) + USE 26 SYM; + ASM_REWRITE_TAC[GSYM IMAGE_UNION]; + REWRITE_TAC[union_subset]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + ASM_REWRITE_TAC[SUBSET;]; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET_UNION]; + REWRITE_TAC[SUBSET_UNION]; + DISCH_TAC; + (* [C]: cont,INJ *) + CONJ_TAC; + IMATCH_MP_TAC joinf_cont; + ASM_REWRITE_TAC[]; + (* -- *) + CONJ_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_split; + ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below]; + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_UNION]; + (* --2-- *) + TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; + ASM_SIMP_TAC[joinf_image_below]; + DISCH_THEN_REWRITE; + TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC; + ASM_SIMP_TAC[joinf_image_above]; + DISCH_THEN_REWRITE; + TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 / &2} INTER IMAGE g' {x | &1 / &2 <= x /\ x <= &1} SUBSET {v'}` SUBGOAL_TAC; + UND 0; + DISCH_THEN (fun t -> REWRITE_TAC[SYM t]); + USE 26 GSYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC IMAGE_SUBSET; + ASM_REWRITE_TAC[SUBSET ]; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 /(&2)} INTER {v'} = EMPTY` SUBGOAL_TAC; + REWRITE_TAC[EQ_EMPTY]; + GEN_TAC; + REWRITE_TAC[IMAGE;INTER;INR IN_SING;DE_MORGAN_THM;]; + NAME_CONFLICT_TAC; + LEFT_TAC "x'"; + IMATCH_MP_TAC (TAUT `(B ==> A) ==> A \/ ~B`); + DISCH_THEN_REWRITE; + GEN_TAC; + REP_BASIC_TAC; + TYPE_THEN `x' = &1/(&2)` SUBGOAL_TAC; + USE 15 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USE 27 GSYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `g x' = g(&1/(&2))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + UND 30; + UND 33; + REAL_ARITH_TAC; + UND 30; + REAL_ARITH_TAC; + UND 29; + REWRITE_TAC[SUBSET;EQ_EMPTY ;INTER;INR IN_SING;]; + POP_ASSUM_LIST (fun t -> ALL_TAC); + REP_BASIC_TAC; + TSPEC `x` 3; + REWR 3; + TSPEC `x` 2; + REWR 2; + (* [D] final touches *) + CONJ_TAC; + REWRITE_TAC[joinf]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[joinf]; + ASM_SIMP_TAC [REAL_ARITH `&1/(&2) < &1 ==> (&1 < &1/ &2 <=> F)`]; + ASM_MESON_TAC[]; + (* Tue Aug 10 13:15:07 EDT 2004 *) + + ]);; + (* }}} *) + +let continuous_uninduced = prove_by_refinement( + `!(f:A->B) U V Y. + continuous f U (induced_top V Y) /\ IMAGE f (UNIONS U) SUBSET Y + ==> continuous f U V`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous;]; + REP_BASIC_TAC; + TSPEC `v INTER Y` 2; + TYPE_THEN `induced_top V Y (v INTER Y)` SUBGOAL_TAC; + REWRITE_TAC[induced_top;IMAGE;]; + ASM_MESON_TAC[]; + DISCH_TAC; + REWR 2; + UND 2; + REWRITE_TAC [preimage;INTER]; + TYPE_THEN `{x | UNIONS U x /\ v (f x) /\ Y (f x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + TYPE_THEN `UNIONS U x ==> Y (f x)` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + (* Tue Aug 10 19:11:27 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_homeo = prove_by_refinement( + `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\ + (metric_space(X,d)) ==> + (?f. homeomorphism f + (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) + (top_of_metric(C,d)))`, + (* {{{ proof *) + + [ + REWRITE_TAC[simple_arc]; + REP_BASIC_TAC; + TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + REWR 1; + (* -- *) + TYPE_THEN `C SUBSET X` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_image_subset; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC; + KILL 3; + ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace]; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_UNIV]; + DISCH_TAC; + (* -- *) + TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC; + ASM_REWRITE_TAC[metric_real]; + DISCH_TAC; + (* -- *) + ASSUME_TAC metric_real; + (* -- *) + TYPE_THEN `compact (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; + TYPEL_THEN [`UNIV:real->bool`;`{x| &0 <= x /\ x <= &1}`;`d_real`] (fun t-> ASSUME_TAC (ISPECL t compact_subset)); + REWR 10; + USE 10 SYM; + ASM_REWRITE_TAC[interval_compact]; + DISCH_TAC; + (* -- *) + USE 3 GSYM ; + (* -- *) + (* A: show homeomorphism *) + TYPE_THEN `f` EXISTS_TAC; + IMATCH_MP_TAC hausdorff_homeomorphsim; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + ASM_SIMP_TAC[top_of_metric_top;metric_subspace]; + (* -- *) + TYPE_THEN `metric_space (C,d)` SUBGOAL_TAC; + ASM_MESON_TAC [metric_subspace]; + DISCH_TAC; + TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET C` SUBGOAL_TAC; + ASM_REWRITE_TAC[SUBSET_REFL ]; + DISCH_TAC; + TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET X` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* B: final obligations *) + CONJ_TAC; + EXPAND_TAC "C"; + IMATCH_MP_TAC inj_bij; + UND 1; + REWRITE_TAC[INJ]; + MESON_TAC[]; + (* -- *) + TYPE_THEN `induced_top (top_of_metric (UNIV,d_real)) {x| &0 <= x /\ x <= &1} {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; + ASM_SIMP_TAC[top_of_metric_induced]; + TYPE_THEN `topology_ (top_of_metric ({x | &0 <= x /\ x <= &1},d_real))` SUBGOAL_TAC; + ASM_SIMP_TAC[top_of_metric_top]; + DISCH_THEN (fun t-> MP_TAC (MATCH_MP top_univ t)); + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + TYPE_THEN `continuous f (induced_top (top_of_metric (UNIV,d_real)) {x | &0 <= x /\ x <= &1}) (top_of_metric(X,d))` SUBGOAL_TAC; + IMATCH_MP_TAC continuous_induced_domain; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + ASM_SIMP_TAC[metric_real;top_of_metric_induced]; + ASM_SIMP_TAC[metric_continuous_continuous;metric_subspace]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_THEN_REWRITE; + ASM_SIMP_TAC[top_of_metric_top]; + IMATCH_MP_TAC metric_hausdorff; + ASM_REWRITE_TAC[]; + (* Tue Aug 10 20:34:30 EDT 2004 *) + + ]);; + + (* }}} *) + +let continuous_metric_extend = prove_by_refinement( + `!(f:A->B) U C X d. (metric_space(X,d) /\ + continuous f U (top_of_metric (C,d)) /\ + IMAGE f (UNIONS U) SUBSET C /\ C SUBSET X ==> + continuous f U (top_of_metric(X,d)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `metric_space(C,d)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d)) C` SUBGOAL_TAC; + ASM_SIMP_TAC[top_of_metric_induced]; + DISCH_TAC; + REWR 2; + IMATCH_MP_TAC continuous_uninduced; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Tue Aug 10 20:47:53 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_distinct = prove_by_refinement( + `!C v v'. simple_arc_end C v v' ==> ~(v = v')`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end;INJ]; + REP_BASIC_TAC; + TYPE_THEN `&0 = &1` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `f (&0) = f(&1)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let bij_imp_image = prove_by_refinement( + `!(f:A->B) X Y. BIJ f X Y ==> (IMAGE f X = Y)`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;SURJ]; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let homeo_inj = prove_by_refinement( + `!(f:A->B) U C X d. (homeomorphism f U (top_of_metric(C,d))) /\ + (C SUBSET X) /\ (metric_space (X,d)) ==> + ( continuous f U (top_of_metric(X,d)) /\ INJ f (UNIONS U) C /\ + (IMAGE f (UNIONS U) = C))`, + (* {{{ proof *) + [ + REWRITE_TAC[homeomorphism]; + REP_BASIC_TAC; + TYPE_THEN`metric_space(C,d)` SUBGOAL_TAC; + ASM_MESON_TAC [metric_subspace]; + DISCH_TAC; + (* -- *) + UND 4; + ASM_SIMP_TAC[GSYM top_of_metric_unions;]; + DISCH_TAC; + (* -- *) + TYPE_THEN `IMAGE f (UNIONS U)= C` SUBGOAL_TAC; + IMATCH_MP_TAC bij_imp_image ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC continuous_metric_extend; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL ]; + (* Tue Aug 10 20:58:37 EDT 2004 *) + + + ]);; + (* }}} *) + +let simple_arc_coord = prove_by_refinement( + `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\ + (metric_space(X,d)) ==> + (?f. + (continuous f (top_of_metric(C,d)) (top_of_metric(UNIV,d_real))) /\ + (INJ f C UNIV) /\ + (IMAGE f C = {x | &0 <= x /\ x <= &1}))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + (* -- *) + TYPE_THEN `C SUBSET X` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]); + REP_BASIC_TAC; + USE 4 GSYM; + REWR 1; + EXPAND_TAC "C"; + IMATCH_MP_TAC inj_image_subset; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC; + ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace]; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_UNIV]; + DISCH_TAC; + (* -- *) + TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC; + ASM_REWRITE_TAC[metric_real]; + DISCH_TAC; + (* -- *) + ASSUME_TAC metric_real; + (* -- *) + TYPE_THEN `(?f. homeomorphism f (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric(C,d)))` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_homeo; + TYPE_THEN `X` EXISTS_TAC; (* // *) + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN ` g = (INV f ({x | &0 <= x /\ x <= &1}) (C:A->bool))` ABBREV_TAC ; + TYPE_THEN `g = INV f (UNIONS((top_of_metric({x | &0 <= x /\ x <= &1},d_real)))) (UNIONS((top_of_metric(C,d))))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_subspace;]; + DISCH_TAC; + (* A: *) + TYPE_THEN `g` EXISTS_TAC; + (* -- *) + (* TYPE_THEN `U = top_of_metric({x | &0 <= x /\ x <= &1},d_real)` ABBREV_TAC ; *) + TYPE_THEN `(homeomorphism g (top_of_metric(C,d)) (top_of_metric({x | &0 <= x /\ x <= &1},d_real))) /\ ({x | &0 <= x /\ x <= &1} SUBSET UNIV) /\ (metric_space (UNIV,d_real))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPEL_THEN [`f`;`(top_of_metric({x | &0 <= x /\ x <= &1},d_real))`;`top_of_metric(C,d)`] (fun t-> ASSUME_TAC (ISPECL t homeomorphism_inv)); + REWR 11; + DISCH_TAC; + USE 11 (MATCH_MP homeo_inj); + REP_BASIC_TAC; + KILL 9; + KILL 10; + ASM_REWRITE_TAC[]; + UND 11; + UND 12; + ASM_REWRITE_TAC[]; + UND 5; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[INJ_UNIV]; + (* Tue Aug 10 21:49:22 EDT 2004 *) + + ]);; + (* }}} *) + +(* slow! *) +let image_interval = prove_by_refinement( + `!a b f. (a < b) /\ + (continuous f (top_of_metric(UNIV,d_real)) + (top_of_metric( UNIV,d_real))) /\ + (INJ f {x | a <= x /\ x <= b} UNIV) ==> + (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\ + (IMAGE f {x | a <= x /\ x <= b} = + {x | c <= x /\ x <= d}) + ) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* -- *) + ASSUME_TAC connect_real; + TYPE_THEN `!a b. connected (top_of_metric(UNIV,d_real)) (IMAGE f {x | a<= x /\ x <= b})` SUBGOAL_TAC; + REP_GEN_TAC; + IMATCH_MP_TAC connect_image; + TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC ; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + DISCH_TAC; + (* -- *) + TYPE_THEN `c = min_real (f a) (f b)` ABBREV_TAC ; + TYPE_THEN `d = max_real (f a) (f b)` ABBREV_TAC ; + TYPE_THEN `c`EXISTS_TAC; + TYPE_THEN `d` EXISTS_TAC; + TYPE_THEN `~(f a = f b)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + TYPE_THEN `a = b` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 2; + REAL_ARITH_TAC; + UND 2; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + SUBCONJ_TAC; + EXPAND_TAC "d"; + EXPAND_TAC "c"; + REWRITE_TAC[min_real;max_real]; + TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `~(f b < f a)` SUBGOAL_TAC; + UND 8; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(f a < f b)` SUBGOAL_TAC; + UND 8; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + SUBCONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[in_pair]; + EXPAND_TAC "d"; + EXPAND_TAC "c"; + REWRITE_TAC[max_real;min_real]; + TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `~(f b < f a)` SUBGOAL_TAC; + UND 9; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(f a < f b)` SUBGOAL_TAC; + UND 9; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + MESON_TAC[]; + DISCH_TAC; + (* B *) + IMATCH_MP_TAC SUBSET_ANTISYM; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + SUBCONJ_TAC; + IMATCH_MP_TAC connected_nogap; + ASM_REWRITE_TAC[]; + EXPAND_TAC "c"; + EXPAND_TAC "d"; + REWRITE_TAC[max_real;min_real]; + TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `~(f b < f a)` SUBGOAL_TAC; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`]; + TYPE_THEN `~(f a < f b)` SUBGOAL_TAC; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`]; + DISCH_TAC; + (* C set up cases *) + REWRITE_TAC[IMAGE;SUBSET;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USE 14 (REWRITE_RULE[DE_MORGAN_THM]); + USE 9 (REWRITE_RULE[FUN_EQ_THM;in_pair ]); + TYPE_THEN `((c = f a) /\ (d = f b)) \/ ((c = f b) /\ (d = f a))` SUBGOAL_TAC; + UND 9; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `f x' < c \/ d < f x'` SUBGOAL_TAC; + UND 14; + ARITH_TAC; + DISCH_TAC; + KILL 9; + KILL 14; + KILL 11; + (* D generic case *) + TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (r < t) /\ (f r < f s) /\ (f s < f t) ==> (r < s /\ s < t))` SUBGOAL_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPEL_THEN [`r`;`t`] (USE 4 o ISPECL); + USE 4(REWRITE_RULE[connected]); + REP_BASIC_TAC; + TYPE_THEN `IMAGE f {x | r <= x /\ x <= t} SUBSET {x | x < f s} \/ IMAGE f {x | r <= x /\ x <= t} SUBSET {x | f s < x}` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;]; + CONJ_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[IMAGE;SUBSET;UNION;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` ); + DISCH_TAC; + TYPE_THEN `x'' = s` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 26; + UND 27; + UND 22; + UND 17; + REAL_ARITH_TAC; + UND 9; + UND 11; + UND 23; + UND 26; + UND 27; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + TYPE_THEN `~(r = s)` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; + TYPE_THEN `~(s = t)` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; + KILL 1; + KILL 2; + UND 0; + UND 3; + UND 4; + UND 5; + REAL_ARITH_TAC; + REWRITE_TAC[DE_MORGAN_THM ]; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + LEFT_TAC "x"; + TYPE_THEN `f t` EXISTS_TAC; + LEFT_TAC "x'"; + REP_BASIC_TAC; + TSPEC `t` 25; + UND 25; + UND 9; + UND 14; + REAL_ARITH_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + LEFT_TAC "x"; + TYPE_THEN `f r` EXISTS_TAC; + REP_BASIC_TAC; + LEFT 25 "x'" ; + TSPEC `r` 25; + UND 25; + UND 14; + UND 11; + REAL_ARITH_TAC; + (* D' generic case *) + TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (t < r) /\ (f r < f s) /\ (f s < f t) ==> (t < s /\ s < r))` SUBGOAL_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPEL_THEN [`t`;`r`] (USE 4 o ISPECL); + USE 4(REWRITE_RULE[connected]); + REP_BASIC_TAC; + TYPE_THEN `IMAGE f {x | t <= x /\ x <= r} SUBSET {x | x < f s} \/ IMAGE f {x | t <= x /\ x <= r} SUBSET {x | f s < x}` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;]; + CONJ_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[IMAGE;SUBSET;UNION;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` ); + DISCH_TAC; + TYPE_THEN `x'' = s` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 26; + UND 27; + UND 18; + UND 21; + REAL_ARITH_TAC; + UND 9; + UND 11; + UND 23; + UND 26; + UND 27; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + TYPE_THEN `~(r = s)` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; + TYPE_THEN `~(s = t)` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`]; + KILL 1; + KILL 2; + UND 0; + UND 3; + UND 4; + UND 5; + REAL_ARITH_TAC; + REWRITE_TAC[DE_MORGAN_THM ]; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + LEFT_TAC "x"; + TYPE_THEN `f t` EXISTS_TAC; + LEFT_TAC "x'"; + REP_BASIC_TAC; + TSPEC `t` 25; + UND 25; + UND 9; + UND 14; + REAL_ARITH_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + LEFT_TAC "x"; + TYPE_THEN `f r` EXISTS_TAC; + REP_BASIC_TAC; + LEFT 25 "x'" ; + TSPEC `r` 25; + UND 25; + UND 14; + UND 11; + REAL_ARITH_TAC; + REP_BASIC_TAC; + (* end generic *) + KILL 4; + KILL 3; + KILL 0; + KILL 1; + KILL 10; + KILL 6; + KILL 5; + (* E: actual cases *) + UND 16; + UND 15; + REP_CASES_TAC; + (* --2a-- *) + KILL 11; + TYPEL_THEN[`x'`;`a`;`b`] (USE 9 o ISPECL); + TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(x' = b)` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* --2b-- *) + KILL 11; + TYPEL_THEN [`a`;`b`;`x'`] (USE 9 o ISPECL); + TYPE_THEN `~(f a = f x')` SUBGOAL_TAC; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(a = x')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* --2c-- *) + KILL 9; + TYPEL_THEN [`x'`;`b`;`a`] (USE 11 o ISPECL); + TYPE_THEN `~(f x' = f a)` SUBGOAL_TAC; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(a = x')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* --2d-- *) + KILL 9; + TYPEL_THEN [`b`;`a`;`x'`] (USE 11 o ISPECL); + TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `~(b = x')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REPEAT (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* Wed Aug 11 09:36:14 EDT 2004 *) + ]);; + (* }}} *) + +let metric_continuous_range = prove_by_refinement( + `!(f:A->B) X dX Y dY Y'. + metric_continuous f (X,dX) (Y,dY) <=> + metric_continuous f (X,dX) (Y',dY)`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + ]);; + (* }}} *) + +let continuous_range = prove_by_refinement( + `!(f:A->B) X dX Y dY Y'. + metric_space(X,dX) /\ metric_space(Y,dY) /\ metric_space(Y',dY) /\ + continuous f (top_of_metric(X,dX)) (top_of_metric(Y,dY)) /\ + IMAGE f X SUBSET Y /\ IMAGE f X SUBSET Y' ==> + continuous f (top_of_metric(X,dX)) (top_of_metric(Y',dY))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y',dY)) = metric_continuous f (X,dX) (Y',dY)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_continuous_continuous; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y,dY)) = metric_continuous f (X,dX) (Y,dY)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_continuous_continuous; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + REWR 2; + ASM_MESON_TAC[metric_continuous_range]; + ]);; + (* }}} *) + +let metric_continuous_domain = prove_by_refinement( + `!(f:A->B) X dX Y dY Y' A. + metric_continuous f (X,dX) (Y,dY) /\ A SUBSET X ==> + metric_continuous f (A,dX) (Y',dY)`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_continuous;metric_continuous_pt;SUBSET]; + MESON_TAC[]; + ]);; + (* }}} *) + +let pair_order_endpoint = prove_by_refinement( + `!a b c d . (c < d) /\ ({c , d} = {a ,b}) ==> + (c = min_real a b) /\ (d = max_real a b)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0 (REWRITE_RULE[FUN_EQ_THM;in_pair]); + TYPE_THEN `((c = a) /\ (d = b)) \/ ((c = b) /\ (d = a))` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + REWR 1; + ASM_REWRITE_TAC[min_real;max_real]; + ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`]; + ASM_REWRITE_TAC[]; + REWR 1; + ASM_REWRITE_TAC[min_real;max_real]; + ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`]; + ]);; + (* }}} *) + +let cont_extend_real_lemma = prove_by_refinement( + `!a b (f:real->A) Y dY. (a < b) /\ + (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) + (top_of_metric(Y,dY))) /\ (metric_space(Y,dY)) /\ + IMAGE f {x | a <= x /\ x <= b} SUBSET Y ==> + ( + ?g. (continuous g (top_of_metric(UNIV,d_real)) + (top_of_metric(Y,dY))) /\ + (!x. (a <= x /\ x <= b) ==> (f x = g x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?t. (a < t /\ t < b)` SUBGOAL_TAC; + TYPE_THEN `(a+b)/(&2)` EXISTS_TAC; + ASM_MESON_TAC[real_middle1_lt;real_middle2_lt]; + REP_BASIC_TAC; + ASSUME_TAC metric_real; + TYPE_THEN `{x | a <= x /\ x <= b} SUBSET UNIV` SUBGOAL_TAC; + ASM_REWRITE_TAC[SUBSET_UNIV]; + DISCH_TAC; + TYPE_THEN `metric_space ({x | a <= x /\ x <= b},d_real)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `metric_continuous f ({x | a <= x /\ x <= b},d_real) (Y,dY)` SUBGOAL_TAC; + UND 2; + ASM_SIMP_TAC [metric_continuous_continuous]; + DISCH_TAC; + TYPE_THEN `A = {x | x <= a}` ABBREV_TAC ; + TYPE_THEN `B = {x | b <= x}` ABBREV_TAC ; + TYPE_THEN `fA = (\(t:real). f a)` ABBREV_TAC ; + TYPE_THEN `fB = (\(t:real). f b)` ABBREV_TAC ; + ASSUME_TAC half_closed; + ASSUME_TAC half_closed_above; + (* -- *) + TYPE_THEN `!r A. (Y r) ==> (metric_continuous (\t. r) (A,d_real) (Y,dY))` SUBGOAL_TAC; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + REP_BASIC_TAC; + RIGHT_TAC "delta"; + REP_BASIC_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_MESON_TAC[metric_space_zero]; + DISCH_TAC; + (* -- *) + TYPE_THEN `metric_continuous (subf A fA fB) (A UNION B,d_real) (Y,dY)` SUBGOAL_TAC; + IMATCH_MP_TAC subf_cont; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + ASM_REWRITE_TAC[]; + EXPAND_TAC "fA"; + EXPAND_TAC "fB"; + TYPE_THEN `!x. x <= a /\ b <= x <=> F` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC ; + DISCH_THEN_REWRITE; + TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC; + UND 0; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + MESON_TAC[]; + DISCH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `A' = A UNION B` ABBREV_TAC ; + TYPE_THEN `B' = {x | a <= x /\ x <= b}` ABBREV_TAC ; + TYPE_THEN `fA' = subf A fA fB` ABBREV_TAC ; + TYPE_THEN `metric_continuous (subf A' fA' f) (A' UNION B',d_real) (Y,dY)` SUBGOAL_TAC; + IMATCH_MP_TAC subf_cont; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "A'"; + EXPAND_TAC "B'"; + CONJ_TAC; + IMATCH_MP_TAC closed_union; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + ASM_SIMP_TAC[top_of_metric_top]; + ASM_REWRITE_TAC[interval_closed]; + EXPAND_TAC "fA'"; + EXPAND_TAC "A'"; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + REWRITE_TAC[UNION]; + GEN_TAC ; + DISCH_TAC; + TYPE_THEN `(x = a) \/ (x = b)` SUBGOAL_TAC; + UND 21; + REAL_ARITH_TAC; + EXPAND_TAC "fA"; + EXPAND_TAC "fB"; + DISCH_THEN DISJ_CASES_TAC; + UND 22; + DISCH_THEN_REWRITE; + REWRITE_TAC[subf;REAL_ARITH `a <= a`]; + UND 22; + DISCH_THEN_REWRITE; + REWRITE_TAC[subf]; + TYPE_THEN `~(b <= a)` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* -- *) + TYPE_THEN `A' UNION B' = UNIV` SUBGOAL_TAC; + EXPAND_TAC "A'"; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + EXPAND_TAC "B'"; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `g = subf A' fA' f` ABBREV_TAC ; + TYPE_THEN `!x. A x ==> (g x = f a)` SUBGOAL_TAC; + EXPAND_TAC "g"; + REWRITE_TAC[subf]; + EXPAND_TAC "A'"; + REWRITE_TAC[UNION]; + GEN_TAC; + DISCH_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "fA'"; + REWRITE_TAC[subf]; + ASM_REWRITE_TAC[]; + EXPAND_TAC "fA"; + REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!x. B x ==> (g x = f b)` SUBGOAL_TAC; + EXPAND_TAC "g"; + REWRITE_TAC[subf]; + EXPAND_TAC "A'"; + REWRITE_TAC[UNION]; + GEN_TAC; + DISCH_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "fA'"; + REWRITE_TAC[subf]; + TYPE_THEN `~(A x)` SUBGOAL_TAC; + UND 25; + EXPAND_TAC "B"; + EXPAND_TAC "A"; + REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + EXPAND_TAC "fB"; + REWRITE_TAC[]; + DISCH_TAC; + (* A *) + TYPE_THEN `!x. B' x ==> (g x = f x)` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `A x` ASM_CASES_TAC; + TYPE_THEN `A x /\ B' x ==> (x = a)` SUBGOAL_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B'"; + REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + ASM_MESON_TAC[]; + (* --2-- *) + TYPE_THEN `B x` ASM_CASES_TAC; + TYPE_THEN `B x /\ B' x ==> (x = b)` SUBGOAL_TAC; + EXPAND_TAC "B"; + EXPAND_TAC "B'"; + REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `~(A' x)` SUBGOAL_TAC; + UND 27; + UND 28; + EXPAND_TAC "A'"; + REWRITE_TAC[UNION]; + MESON_TAC[]; + EXPAND_TAC "g"; + REWRITE_TAC[subf]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* B start on goal *) + TYPE_THEN `g` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + UND 26; + EXPAND_TAC "B'"; + REWRITE_TAC[]; + MESON_TAC[]; + TYPE_THEN `IMAGE g UNIV SUBSET Y /\ metric_space (UNIV,d_real) /\ metric_space (Y,dY)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + UND 22; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[IMAGE_UNION;union_subset]; + CONJ_TAC; + EXPAND_TAC "A'"; + REWRITE_TAC[IMAGE_UNION;union_subset]; + UND 24; + UND 25; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC; + UND 0; + EXPAND_TAC "B'"; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + MESON_TAC[]; + MESON_TAC[]; + UND 26; + UND 0; + EXPAND_TAC "B'"; + REWRITE_TAC[IMAGE;SUBSET]; + MESON_TAC[]; + DISCH_TAC; + COPY 27; + (* C final KILL *) + USE 28 (MATCH_MP metric_continuous_continuous); + ASM_REWRITE_TAC[]; + REWR 21; + (* Wed Aug 11 12:37:40 EDT 2004 *) + + ]);; + (* }}} *) + +let image_interval2 = prove_by_refinement( + `!a b f. (a < b) /\ + (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) + (top_of_metric( UNIV,d_real))) /\ + (INJ f {x | a <= x /\ x <= b} UNIV) ==> + (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\ + (IMAGE f {x | a <= x /\ x <= b} = + {x | c <= x /\ x <= d}) + )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?g. (continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real))) /\ (!x. (a <= x /\ x <= b) ==> (f x = g x))` SUBGOAL_TAC; + IMATCH_MP_TAC cont_extend_real_lemma; + ASM_REWRITE_TAC[metric_real]; + REP_BASIC_TAC; + TYPE_THEN `(a < b) /\ (continuous g (top_of_metric(UNIV,d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ g {x | a <= x /\ x <= b} UNIV)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `INJ g {x | a <= x /\ x <= b} UNIV= INJ f {x | a <= x /\ x <= b} UNIV` SUBGOAL_TAC; + IMATCH_MP_TAC inj_domain_sub; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP image_interval t)); + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `c` EXISTS_TAC; + TYPE_THEN `d` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `(f a = g a) /\ (f b = g b)` SUBGOAL_TAC; + UND 3; + UND 2; + MESON_TAC[REAL_ARITH `(a < b) ==> (a<= a /\ a <= b /\ b <= b)`]; + DISCH_THEN_REWRITE; + USE 5 SYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC image_domain_sub; + ASM_REWRITE_TAC[]; + (* Wed Aug 11 12:51:52 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_euclid = prove_by_refinement( + `!C. (simple_arc top2 C ==> (C SUBSET (euclid 2)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0 (MATCH_MP simple_arc_compact); + RULE_ASSUM_TAC (REWRITE_RULE[compact;top2_unions]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let simple_arc_end_inj = prove_by_refinement( + `!A B C v v'. (simple_arc_end A v v' /\ simple_arc_end B v v') /\ + (simple_arc top2 C) /\ (A SUBSET C) /\ (B SUBSET C) ==> + (A = B)`, + (* {{{ proof *) + [ + (* A: *) + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + TYPE_THEN `simple_arc (top_of_metric(euclid 2,d_euclid)) C /\ (metric_space(euclid 2,d_euclid))` SUBGOAL_TAC; + ASM_REWRITE_TAC[GSYM top2;metric_euclid]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_coord t)); + REP_BASIC_TAC; + (* push to reals *) + TYPE_THEN `(IMAGE f'' A = IMAGE f'' B) <=> (A = B)` SUBGOAL_TAC; + IMATCH_MP_TAC INJ_IMAGE ; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + (* -- *) + TYPE_THEN `C SUBSET (euclid 2)` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `metric_space (C,d_euclid )` SUBGOAL_TAC; + ASM_MESON_TAC[metric_subspace;metric_euclid]; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC; + REWRITE_TAC[SUBSET_UNIV]; + DISCH_TAC; + (* -- *) + TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC ; + ASM_REWRITE_TAC[metric_real]; + DISCH_TAC; + (* -- *) + (* -- *) + TYPE_THEN `g = f'' o f` ABBREV_TAC ; + TYPE_THEN `g'= f'' o f'` ABBREV_TAC ; + TYPE_THEN `top_of_metric({x| &0 <= x /\ x <= &1},d_real) = induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM top_of_metric_induced); + ASM_REWRITE_TAC[metric_real]; + DISCH_TAC; + (* -- *) + TYPE_THEN `continuous f (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC; + ASM_REWRITE_TAC[top2 ]; + IMATCH_MP_TAC continuous_induced_domain; + ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real]; + DISCH_TAC; + (* -- *) + TYPE_THEN `continuous f' (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC; + ASM_REWRITE_TAC[top2 ]; + IMATCH_MP_TAC continuous_induced_domain; + ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real]; + DISCH_TAC; + KILL 11; + KILL 6; + (* A *) + TYPE_THEN `(&0 < &1) /\ (continuous g (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ g {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC; + CONJ_TAC; + REAL_ARITH_TAC; + CONJ_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC; + USE 22 GSYM; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + UND 1; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC continuous_range; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[GSYM top2]; + ASM_SIMP_TAC[metric_euclid]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + SUBCONJ_TAC; + UND 1; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* --2-- *) + EXPAND_TAC "g"; + IMATCH_MP_TAC (REWRITE_RULE[GSYM comp_comp] COMP_INJ); + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_subset; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 1; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t)); + REP_BASIC_TAC; + (* -- *) + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM IMAGE_o]; + ASM_REWRITE_TAC[]; + (* B *) + TYPE_THEN `(&0 < &1) /\ (continuous g' (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric( UNIV,d_real))) /\ (INJ g' {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC; + CONJ_TAC; + REAL_ARITH_TAC; + CONJ_TAC; + EXPAND_TAC "g'"; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC; + USE 22 GSYM; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + UND 0; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC continuous_range; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[GSYM top2]; + ASM_SIMP_TAC[metric_euclid]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + SUBCONJ_TAC; + UND 0; + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* --2-- *) + EXPAND_TAC "g'"; + IMATCH_MP_TAC (REWRITE_RULE[GSYM comp_comp] COMP_INJ); + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_subset; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t)); + REP_BASIC_TAC; + (* C final steps *) + TYPE_THEN `(g (&0) = g'(&0)) /\ (g(&1) = g'(&1))` SUBGOAL_TAC; + EXPAND_TAC "g"; + EXPAND_TAC "g'"; + REWRITE_TAC[o_DEF ]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 11; + ASM_REWRITE_TAC[]; + (* temp *) + DISCH_TAC; + TYPE_THEN `(c = min_real (g'(&0)) (g'(&1))) /\ (d = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC; + IMATCH_MP_TAC pair_order_endpoint; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `(c' = min_real (g'(&0)) (g'(&1))) /\ (d' = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC; + IMATCH_MP_TAC pair_order_endpoint; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* Wed Aug 11 15:10:02 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_cut = prove_by_refinement( + `!C v v' v''. simple_arc_end C v v' /\ (C v'') /\ ~(v'' = v) /\ + ~(v'' = v') ==> + (?C' C''. (simple_arc_end C' v v'') /\ (simple_arc_end C'' v'' v') /\ + (C' INTER C'' = {v''}) /\ (C' UNION C'' = C))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + (* -- INTER *) + TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v''))` SUBGOAL_TAC; + UND 2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC; + TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC; + REP_BASIC_TAC; + TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x <= &1} = IMAGE f ({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1})` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM inj_inter ); + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + UND 9; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `{x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1} = {t}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING]; + UND 9; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[image_sing]; + ASM_REWRITE_TAC[]; + (* A UNION *) + REWRITE_TAC[GSYM IMAGE_UNION]; + TYPE_THEN `{x | &0 <= x /\ x <= t} UNION {x | t <= x /\ x <= &1} = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;]; + UND 9; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + (* B FIRST piece *) + CONJ_TAC; + TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= t} (euclid 2) /\ &0 < &1 /\ &0 < t` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + UND 9; + REAL_ARITH_TAC; + TYPE_THEN `~(&0 = t)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + REWR 11; + REWR 4; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* C LAST piece *) + TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | t <= x /\ x <= &1} (euclid 2) /\ &0 < &1 /\ t < &1` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + UND 10; + REAL_ARITH_TAC; + TYPE_THEN `~( &1 = t)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + REWR 11; + REWR 3; + UND 9; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* Wed Aug 11 15:54:37 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_closed_curve_pt = prove_by_refinement( + `!C v. (simple_closed_curve top2 C /\ C v) ==> + (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\ + continuous f (top_of_metric (UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x < &1} (UNIONS top2) /\ + (f (&0) = v) /\ + (f (&0) = f (&1)))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_closed_curve]; + REP_BASIC_TAC; + TYPE_THEN `f(&0) = v` ASM_CASES_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v))` SUBGOAL_TAC; + UND 0; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `~(t = &0)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + REWR 9; + REWR 6; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~(t = &1)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `{x | t <= x /\ x <= &1} = {x | t <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING]; + UND 7; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `INJ f {x | t <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC inj_split; + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC ; + ASM_REWRITE_TAC[GSYM top2_unions]; + REWRITE_TAC[SUBSET]; + UND 8; + REAL_ARITH_TAC; + CONJ_TAC; + REWRITE_TAC[INJ;INR IN_SING;]; + USE 2 (REWRITE_RULE[top2_unions]); + TYPE_THEN `euclid 2 (f (&0))` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[]; + REWRITE_TAC[EQ_EMPTY;IMAGE;INTER;image_sing;INR IN_SING;]; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "x''"); + REP_GEN_TAC; + REP_BASIC_TAC; + TYPE_THEN `x' = &0` SUBGOAL_TAC; + USE 2(REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 14; + UND 8; + REAL_ARITH_TAC; + UND 14; + UND 8; + UND 9; + REAL_ARITH_TAC; + DISCH_TAC; + (* [A] reparameter 1st part *) + TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\ (INJ f {x | t <= x /\ x <= &1} (euclid 2)) /\ (&0 < &1/(&2)) /\ (t < &1)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + UND 7; + UND 10; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + KILL 14; + (* B 2nd part *) + TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\ (INJ f {x | &0 <= x /\ x <= t} (euclid 2)) /\ (&1/(&2) < &1) /\ (&0 < t)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF2]; + CONJ_TAC; + USE 2(REWRITE_RULE[top2_unions]); + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x < &1} ` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET]; + UND 7; + UND 10; + REAL_ARITH_TAC; + UND 8; + UND 9; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + KILL 19; + (* [C] JOIN functions *) + TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC; + TYPE_THEN `&0 < &1/(&2)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `&1/(&2) < &1` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF2]; + REAL_ARITH_TAC ; + DISCH_TAC; + (* -- *) + TYPE_THEN `joinf g g' (&1/(&2)) (&0) = v` SUBGOAL_TAC; + ASM_REWRITE_TAC[joinf]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `joinf g g' (&1/(&2)) (&1) = v` SUBGOAL_TAC; + ASM_REWRITE_TAC[joinf]; + ASM_SIMP_TAC[REAL_ARITH `(&1/ &2 < &1) ==> ~(&1 < (&1/(&2)))`]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `continuous (joinf g g' (&1 / &2)) (top_of_metric (UNIV,d_real)) top2` SUBGOAL_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC joinf_cont; + ASM_REWRITE_TAC[GSYM top2]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + (* [D] INJ *) + TYPE_THEN `{x | &0 <= x /\ x < &1} = {x | &0 <= x /\ x < (&1/(&2))} UNION {x | (&1/(&2)) <= x /\ x < &1}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + ASM_REWRITE_TAC[UNION]; + UND 24; + UND 19; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + (* -- *) + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + REWRITE_TAC[top2_unions]; + RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); + CONJ_TAC; + IMATCH_MP_TAC inj_split; + TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = INJ g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; + IMATCH_MP_TAC joinf_inj_below; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = INJ g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC; + IMATCH_MP_TAC joinf_inj_above; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE ; + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &1/(&2) <= x /\ x <= &1}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + (* --2-- E IMAGE *) + REWRITE_TAC[EQ_EMPTY]; + TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; + IMATCH_MP_TAC joinf_image_below; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = IMAGE g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC; + IMATCH_MP_TAC joinf_image_above; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[INTER]; + GEN_TAC; + REWRITE_TAC[IMAGE;]; + DISCH_TAC; + REP_BASIC_TAC; + REWR 27; + KILL 30; + USE 13 (REWRITE_RULE[FUN_EQ_THM ]); + TSPEC `g x'` 13; + USE 13 (REWRITE_RULE[IMAGE]); + TYPE_THEN `(?x. (&0 <= x /\ x <= &1 / &2) /\ (g x' = g x))` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`]; + DISCH_TAC; + REWR 13; + KILL 30; + REP_BASIC_TAC; + USE 14 (REWRITE_RULE[FUN_EQ_THM;]); + TSPEC `g' x''` 14; + USE 14 (REWRITE_RULE[IMAGE]); + TYPE_THEN `(?x. (&1 / &2 <= x /\ x <= &1) /\ (g' x'' = g' x))` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`]; + DISCH_TAC; + REWR 14; + KILL 34; + REP_BASIC_TAC; + TYPE_THEN `(x = x''')` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(x = &0)` SUBGOAL_TAC; + DISCH_TAC; + TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC; + USE 17(REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 31; + UND 24; + UND 19; + REAL_ARITH_TAC; + UND 31; + REAL_ARITH_TAC; + TYPE_THEN `~(x = &1)` SUBGOAL_TAC; + DISCH_TAC; + TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC; + USE 17(REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 31; + UND 24; + UND 19; + REAL_ARITH_TAC; + UND 31; + REAL_ARITH_TAC; + UND 34; + UND 7; + UND 10; + UND 33; + UND 8; + UND 9; + UND 30; + REAL_ARITH_TAC; + DISCH_TAC; + (* --2-- *) + TYPE_THEN `x = t` SUBGOAL_TAC; + UND 36; + UND 35; + UND 34; + UND 33; + UND 30; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `g' (&1) = g'(x'')` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `&1 = x''` SUBGOAL_TAC; + USE 22(REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 28; + UND 24; + UND 19; + REAL_ARITH_TAC; + UND 28; + REAL_ARITH_TAC; + (* F IMAGE *) + TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION ]; + UND 24; + UND 19; + REAL_ARITH_TAC; + DISCH_TAC; + TYPEL_THEN [`joinf g g' (&1/(&2))`;`{x | &0 <= x /\ x < &1/(&2)}`;`{x | &1/(&2) <= x /\ x <= &1}`] (fun t-> ASSUME_TAC (ISPECL t IMAGE_UNION )); + ASM_REWRITE_TAC[]; + USE 27 SYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC; + IMATCH_MP_TAC joinf_image_below; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC; + IMATCH_MP_TAC joinf_image_above; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + USE 14 GSYM ; + ASM_REWRITE_TAC[]; + (* F final *) + TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING]; + REAL_ARITH_TAC; + DISCH_TAC ; + (* -- *) + TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} = IMAGE f {x | &0 <= x /\ x < &1}` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE_UNION;image_sing; ]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[union_subset;SUBSET_REFL]; + REWRITE_TAC[SUBSET;INR IN_SING;]; + GEN_TAC; + DISCH_THEN_REWRITE; + UND 1; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[IMAGE]; + TYPE_THEN `&0` EXISTS_TAC; + REWRITE_TAC[]; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET_UNION]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1/(&2)} = IMAGE f {x | t <= x /\ x < &1}` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1} DELETE (f (&1))` EXISTS_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[SUBSET_DELETE]; + CONJ_TAC; + REWRITE_TAC[IMAGE;]; + REP_BASIC_TAC; + TYPE_THEN `x = (&1/(&2))` SUBGOAL_TAC; + USE 17(REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 32; + UND 19; + REAL_ARITH_TAC; + UND 32; + REAL_ARITH_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + REWRITE_TAC[DELETE;IMAGE;SUBSET;]; + REWRITE_TAC[REAL_ARITH `x <= &1 <=> (x < &1 \/ (x = &1))`]; + MESON_TAC[]; + (* --2--*) + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)} DELETE (g (&1/(&2)))` EXISTS_TAC; + CONJ_TAC; + USE 13 GSYM; + USE 15 GSYM; + ASM_REWRITE_TAC[SUBSET_DELETE]; + CONJ_TAC; + REWRITE_TAC[IMAGE;]; + REP_BASIC_TAC; + TYPE_THEN `&1 = x` SUBGOAL_TAC; + USE 12(REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 32; + REAL_ARITH_TAC; + UND 32; + REAL_ARITH_TAC; + USE 11 SYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + REWRITE_TAC[DELETE;IMAGE;SUBSET;]; + REWRITE_TAC[REAL_ARITH `x <= &1/(&2) <=> (x < &1/(&2) \/ (x = &1/(&2)))`]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + (* G *) + REWRITE_TAC[GSYM IMAGE_UNION]; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UND 8; + UND 7; + UND 10; + REAL_ARITH_TAC; + (* -- World's worst proof *) + (* Thu Aug 12 07:44:29 EDT 2004 *) + + ]);; + + + (* }}} *) + +let shift_inj = prove_by_refinement( + `!(f:real->A) X t. (INJ f {x | &0 <= x /\ x < &1} X) /\ + (f (&0) = f(&1)) /\ (&0 < t) ==> + INJ f {x | t <= x /\ x <= &1} X`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + CONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `x < &1` ASM_CASES_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 5; + UND 0; + REAL_ARITH_TAC; + TYPE_THEN `x = &1` SUBGOAL_TAC; + UND 4; + UND 6; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + USE 1 GSYM; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + REAL_ARITH_TAC; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `((x = &1) /\ (y = &1)) \/ ((x < &1) /\ (y = &1)) \/ ((x = &1) /\ (y < &1)) \/ ((x < &1) /\ (y < &1))` SUBGOAL_TAC; + UND 5; + UND 7; + REAL_ARITH_TAC; + REP_CASES_TAC; + ASM_REWRITE_TAC[]; + USE 1 SYM ; + REWR 4; + TYPE_THEN `x = &0` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 8; + UND 0; + REAL_ARITH_TAC; + UND 8; + UND 0; + REAL_ARITH_TAC; + USE 1 SYM; + REWR 4; + TYPE_THEN `y = &0` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 6; + UND 0; + REAL_ARITH_TAC; + UND 6; + UND 0; + REAL_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 6; + UND 8; + UND 0; + REAL_ARITH_TAC; + (* Thu Aug 12 08:33:16 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_segment = prove_by_refinement( + `!f u v. + continuous f (top_of_metric (UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x < &1} (euclid 2) /\ + (f (&0) = f (&1)) /\ + (&0 <= u /\ u < v /\ v <= &1 /\ (&0 < u \/ v < &1)) ==> + simple_arc_end (IMAGE f {x | u <= x /\ x <= v}) (f u) (f v)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[simple_arc_end]; + (* -- *) + TYPE_THEN `(&0 < u) ==> INJ f { x | u <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC ; + DISCH_TAC; + IMATCH_MP_TAC shift_inj; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `INJ f { x | u <= x /\ x <= v } (euclid 2)` SUBGOAL_TAC; + UND 0; + DISCH_THEN DISJ_CASES_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | u <= x /\ x <= &1}` EXISTS_TAC; + REWR 7; + ASM_REWRITE_TAC[SUBSET ]; + UND 1; + REAL_ARITH_TAC; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + UND 0; + UND 3; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | u <= x /\ x <= v} (euclid 2) /\ &0 < &1 /\ u < v` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t)); + REP_BASIC_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Thu Aug 12 08:55:11 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_closed_cut = prove_by_refinement( + `!C v v'. (simple_closed_curve top2 C /\ C v /\ C v' /\ ~(v = v') + ==> (?C' C''. simple_arc_end C' v v' /\ simple_arc_end C'' v v' + /\ ( C' UNION C'' = C) /\ (C' INTER C'' = {v,v'})))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `simple_closed_curve top2 C /\ C v` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_closed_curve_pt t)); + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f(t) = v'))` SUBGOAL_TAC; + UND 1; + ASM_REWRITE_TAC[IMAGE]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `t < &1` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `~( t= &1) /\ (t <= &1) ==> (t < &1)`); + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 9; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `&0 < t` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(t = &0) /\ (&0 <= t) ==> (&0 < t)`); + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 9; + DISCH_TAC; + (* -- *) + TYPE_THEN `C' = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ; + TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `C''` EXISTS_TAC; + CONJ_TAC; + EXPAND_TAC "C'"; + EXPAND_TAC "v"; + EXPAND_TAC "v'"; + IMATCH_MP_TAC simple_arc_segment; + RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_ARITH `x <= x`]; + (* -- *) + CONJ_TAC; + USE 5 SYM; + ASM_REWRITE_TAC[]; + EXPAND_TAC "C''"; + EXPAND_TAC "v'"; + IMATCH_MP_TAC simple_arc_end_symm; + IMATCH_MP_TAC simple_arc_segment; + RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* -- *) + CONJ_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "C'"; + EXPAND_TAC "C''"; + REWRITE_TAC[GSYM IMAGE_UNION]; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UND 13; + UND 12; + REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x < &1} UNION IMAGE f {(&1)}` SUBGOAL_TAC; + REWRITE_TAC[GSYM IMAGE_UNION]; + EXPAND_TAC "C''"; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING ]; + UND 12; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + (* -- *) + REWRITE_TAC[UNION_OVER_INTER;image_sing]; + EXPAND_TAC "C'"; + TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1})) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x < &1})` SUBGOAL_TAC; + IMATCH_MP_TAC inj_inter; + TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC; + TYPE_THEN `(UNIONS top2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + UND 12; + UND 13; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + (* -- *) + TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1}) = {t}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING]; + UND 13; + UND 12; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `{(f (&1))} = IMAGE f {(&0)}` SUBGOAL_TAC; + REWRITE_TAC[image_sing]; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER {(&0)}) ) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {(&0)} )` SUBGOAL_TAC; + IMATCH_MP_TAC inj_inter; + TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC; + TYPE_THEN `UNIONS top2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;INR IN_SING]; + UND 12; + UND 13; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + (* -- *) + TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {(&0)}) = {(&0)}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING ]; + UND 11; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[image_sing]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[in_pair]; + REWRITE_TAC[UNION;INR IN_SING]; + ASM_MESON_TAC[]; + (* Thu Aug 12 09:35:48 EDT 2004 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION M *) +(* ------------------------------------------------------------------ *) + + +let closed_point = prove_by_refinement( + `!x. (euclid 2 x) ==> (closed_ top2 {x})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC compact_closed; + REWRITE_TAC[top2_top]; + ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid]; + IMATCH_MP_TAC compact_point; + ASM_REWRITE_TAC[GSYM top2;top2_unions]; + (* Fri Aug 13 08:42:22 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_closed = prove_by_refinement( + `!C v v'. (simple_arc_end C v v' ==> closed_ top2 C) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC compact_closed; + REWRITE_TAC[top2_top]; + ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid]; + REWRITE_TAC [GSYM top2]; + IMATCH_MP_TAC simple_arc_compact; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + (* Fri Aug 13 09:33:35 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_end = prove_by_refinement( + `!C v v'. (simple_arc_end C v v' ==> C v)`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "v"; + REWRITE_TAC[IMAGE;]; + TYPE_THEN `&0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* Fri Aug 13 09:40:59 EDT 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_end2 = prove_by_refinement( + `!C v v'. (simple_arc_end C v v' ==> C v')`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "v'"; + REWRITE_TAC[IMAGE;]; + TYPE_THEN `&1` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* Fri Aug 13 09:42:07 EDT 2004 *) + ]);; + (* }}} *) + +let simple_arc_end_end_closed = prove_by_refinement( + `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC closed_point; + TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + TYPE_THEN `C v` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let simple_arc_end_end_closed2 = prove_by_refinement( + `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v'}`, + (* {{{ proof *) + + [ + ASM_MESON_TAC[simple_arc_end_end_closed;simple_arc_end_symm;]; + ]);; + + (* }}} *) + +let simple_arc_sep3 = prove_by_refinement( + `!A C1 C2 C3 x p1 p2 p3. + (C1 UNION C2 UNION C3 SUBSET A) /\ + (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\ + (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\ + (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==> + (?x' C1' C2' C3'. + (C1' UNION C2' UNION C3' SUBSET A) /\ + (simple_arc_end C1' x' p1) /\ + (simple_arc_end C2' x' p2) /\ + (simple_arc_end C3' x' p3) /\ + ~(C2' p3) /\ ~(C3' p2) /\ + (C1' INTER C2' = {x'} ) /\ + (C1' INTER C3' = {x'} )) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `K = C2 UNION C3` ABBREV_TAC ; + TYPE_THEN `~((C1 INTER K) = EMPTY)` SUBGOAL_TAC; + EXPAND_TAC "K"; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + REWRITE_TAC[UNION]; + TYPE_THEN `x` EXISTS_TAC; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + DISCH_TAC; + (* -- *) + TYPE_THEN `closed_ top2 K` SUBGOAL_TAC; + EXPAND_TAC "K"; + IMATCH_MP_TAC closed_union; + ASM_MESON_TAC[simple_arc_end_closed;top2_top]; + DISCH_TAC; + (* -- *) + TYPE_THEN `~((C1 INTER {p1}) = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[INTER;EMPTY_EXISTS;INR IN_SING]; + ASM_MESON_TAC[simple_arc_end_end2]; + DISCH_TAC; + (* -- *) + TYPE_THEN `(?C1' x' v'. C1' SUBSET C1 /\ simple_arc_end C1' x' v' /\ (C1' INTER K = {x'}) /\ (C1' INTER {p1} = {v'}))` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_restriction; + ASM_REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING ]; + CONJ_TAC; + ASM_MESON_TAC[simple_arc_end_simple]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_end_closed2; + ASM_MESON_TAC[]; + CONV_TAC (dropq_conv "x"); + REWRITE_TAC[DE_MORGAN_THM]; + DISJ2_TAC; + EXPAND_TAC "K"; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `v' = p1` SUBGOAL_TAC; + USE 14 (REWRITE_RULE[FUN_EQ_THM]); + USE 14 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + KILL 14; + (* -- *) + (* [A] case x' = x *) + TYPE_THEN `x' = x` ASM_CASES_TAC; + UND 14; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `C1` EXISTS_TAC; + TYPE_THEN `C2` EXISTS_TAC; + TYPE_THEN `C3` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `C1' = C1` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `C1` EXISTS_TAC; + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `p1` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL ]; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + (* --2-- *) + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER;INR IN_SING]; + EQ_TAC; + USE 15 (REWRITE_RULE[FUN_EQ_THM;]); + USE 14 (REWRITE_RULE[INTER;INR IN_SING]); + UND 14; + EXPAND_TAC "K"; + REWRITE_TAC[UNION]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[simple_arc_end_end]; + (* --2'-- *) + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER;INR IN_SING]; + EQ_TAC; + USE 15 (REWRITE_RULE[FUN_EQ_THM;]); + USE 14 (REWRITE_RULE[INTER;INR IN_SING]); + UND 14; + EXPAND_TAC "K"; + REWRITE_TAC[UNION]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[simple_arc_end_end]; + (* B cut C1 at- x' *) + TYPE_THEN `~(x' = p1)` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_distinct]; + DISCH_TAC; + (* -- *) + TYPE_THEN `C1' x'` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `simple_arc_end C1 x p1 /\ C1 x' /\ ~(x' = x) /\ ~(x' = p1)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + UND 17; + UND 19; + MESON_TAC[ISUBSET]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `C'' = C1'` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `C1` EXISTS_TAC; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `p1` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + UND 20; + SET_TAC[UNION;SUBSET]; + DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); + (* -- *) + TYPE_THEN `C1 x'` SUBGOAL_TAC; + UND 19; + UND 17; + MESON_TAC[ISUBSET]; + DISCH_TAC; + (* -- *) + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `C1'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[union_subset]; + TYPE_THEN `C1' SUBSET A` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION K ` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_UNION]; + DISCH_THEN_REWRITE; + (* [C] C2 x' *) + (* ------- *) + TYPE_THEN `C2 x'` ASM_CASES_TAC; + TYPE_THEN `simple_arc_end C2 x p2 /\ C2 x' /\ ~(x' = x) /\ ~(x' = p2)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); + REP_BASIC_TAC; + TYPE_THEN `C2' = C''''` ABBREV_TAC ; + KILL 30; + (*---- *) + TYPE_THEN `C2'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `C2' SUBSET C2` SUBGOAL_TAC; + USE 26 ( (REWRITE_RULE[FUN_EQ_THM])); + USE 26 (REWRITE_RULE[UNION]); + UND 26; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~C2' p3` SUBGOAL_TAC; + UND 30; + UND 3; + MESON_TAC[ISUBSET]; + DISCH_THEN_REWRITE; + ONCE_REWRITE_TAC [union_subset]; + TYPE_THEN `C2' SUBSET A` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION K` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "K"; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `C1' INTER C2' = {x'}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING]; + GEN_TAC; + EQ_TAC; + UND 15; + UND 30; + EXPAND_TAC "K"; + REWRITE_TAC [eq_sing]; + REWRITE_TAC[INTER;UNION;SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end]; + DISCH_THEN_REWRITE; + (* --[C2]-- branch again for C3 x' -- *) + TYPE_THEN `C3 x'` ASM_CASES_TAC; + TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); + REP_BASIC_TAC; + TYPE_THEN `C3' = C''''''` ABBREV_TAC ; + KILL 36; + TYPE_THEN `C3'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC; + UND 32; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION K` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "K"; + UND 36; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + CONJ_TAC; + UND 36; + UND 0; + MESON_TAC[ISUBSET]; + TYPE_THEN `C3' x'` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + GEN_TAC; + EQ_TAC; + UND 15; + UND 36; + EXPAND_TAC "K"; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[UNION;SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + (* --[C2']-- now C3 doesn't meet x'. This will be repeated for C2 *) + (* -- cut C' from {x'} to FIRST point on C3 -- *) + TYPEL_THEN [`C'`;`{x'}`;`C3`] (fun t-> MP_TAC (ISPECL t simple_arc_end_restriction)); + DISCH_THEN ANT_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_end_closed; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + ASM_MESON_TAC[]; + CONJ_TAC; + UND 31; + REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING]; + MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[INTER;INR IN_SING]; + USE 23 (MATCH_MP simple_arc_end_end2); + UND 23; + MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[INTER;INR IN_SING]; + USE 23 (MATCH_MP simple_arc_end_end); + UND 23; + USE 2 (MATCH_MP simple_arc_end_end); + UND 2; + MESON_TAC[]; + REP_BASIC_TAC; + (* ---[a] *) + TYPE_THEN `C3a = C'''''` ABBREV_TAC ; + KILL 36; + TYPE_THEN `v = x'` SUBGOAL_TAC; + USE 33(REWRITE_RULE[FUN_EQ_THM]); + USE 33(REWRITE_RULE[INTER;INR IN_SING]); + UND 33; + MESON_TAC[]; + DISCH_THEN (fun t -> (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + KILL 33; + TYPE_THEN `C3a SUBSET C1` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 20; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + TYPE_THEN `C3a SUBSET A /\ simple_arc_end C3a x' v'' /\ ~(C3a p2) /\ (C1' INTER C3a = {(x')}) /\ (C3 INTER C3a = {(v'')}) /\ (~C3a p3)` SUBGOAL_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION K` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1` EXISTS_TAC; + REWRITE_TAC[SUBSET_UNION]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL ]; + CONJ_TAC; + UND 7; + UND 33; + MESON_TAC[ISUBSET]; + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING]; + EQ_TAC; + UND 21; + UND 35; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end]; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING]; + EQ_TAC; + UND 32; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + UND 32; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + UND 35; + USE 20 (REWRITE_RULE[FUN_EQ_THM]); + USE 20 (REWRITE_RULE[UNION]); + UND 20; + UND 6; + MESON_TAC [ISUBSET]; + KILL 32; + KILL 33; + KILL 34; + KILL 31; + REP_BASIC_TAC; + (* --[b] *) + TYPE_THEN `(v'' = x)` ASM_CASES_TAC; + FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); + TYPE_THEN `C3 UNION C3a` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ONCE_REWRITE_TAC[union_subset]; + ASM_REWRITE_TAC[]; + UND 9; + EXPAND_TAC "K"; + REWRITE_TAC[union_subset]; + MESON_TAC[]; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REWRITE_TAC[UNION;DE_MORGAN_THM]; + ASM_REWRITE_TAC[]; + (* --- *) + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;UNION;INR IN_SING]; + GEN_TAC; + EQ_TAC ; + REWRITE_TAC[LEFT_AND_OVER_OR]; + DISCH_THEN DISJ_CASES_TAC; + UND 39; + UND 15; + EXPAND_TAC "K"; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER;UNION]; + MESON_TAC[]; + UND 39; + UND 33; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + UND 33; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + (* -- *) + (* --[c] cut off C3b at- v'' *) + TYPEL_THEN [`C3`;`x`;`p3`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut)); + DISCH_THEN ANT_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 32; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + PROOF_BY_CONTR_TAC; + USE 39 (REWRITE_RULE[]); + FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + UND 31; + REWRITE_TAC[]; + UND 32; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `C3b = C'''''''` ABBREV_TAC ; + KILL 43; + TYPE_THEN `C3b SUBSET C3` SUBGOAL_TAC; + UND 39; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + (* -- [d] EXISTS_TAC *) + TYPE_THEN `C3a UNION C3b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS ; + TYPE_THEN `C1 UNION K` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_union_pair; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 20; + SET_TAC[UNION;SUBSET]; + EXPAND_TAC "K"; + UND 43; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_trans; + (* IMATCH_MP_TAC SUBSET_TRANS; *) + TYPE_THEN `v''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 43; + UND 32; + UND 40; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER;SUBSET]; + MESON_TAC[]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[UNION;DE_MORGAN_THM]; + ASM_REWRITE_TAC[]; + UND 43; + UND 0; + MESON_TAC[ISUBSET]; + IMATCH_MP_TAC EQ_EXT ; + REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR]; + GEN_TAC; + EQ_TAC; + DISCH_THEN DISJ_CASES_TAC; + FIRST_ASSUM MP_TAC; + UND 21; + UND 33; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + FIRST_ASSUM MP_TAC; + UND 43; + UND 15; + EXPAND_TAC "K"; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER;UNION;SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISJ1_TAC; + UND 36; + MESON_TAC[simple_arc_end_end]; + (* D *) + TYPE_THEN `C3 x'` SUBGOAL_TAC; + UND 25; + UND 15; + REWRITE_TAC[eq_sing]; + EXPAND_TAC "K"; + REWRITE_TAC[INTER;UNION]; + MESON_TAC[]; + DISCH_TAC; + (* [E] back to ONE goal *) + (* TYPE_THEN `C3 x'` ASM_CASES_TAC; *) + TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t)); + REP_BASIC_TAC; + TYPE_THEN `C3' = C''''` ABBREV_TAC ; + KILL 31; + (*---- *) + LEFT_TAC "C3'"; + USE 10 (ONCE_REWRITE_RULE[UNION_COMM]); + TYPE_THEN `C3'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC; + USE 27 ( (REWRITE_RULE[FUN_EQ_THM])); + USE 27 (REWRITE_RULE[UNION]); + UND 27; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `~C3' p2` SUBGOAL_TAC; + UND 31; + UND 0; + MESON_TAC[ISUBSET]; + DISCH_THEN_REWRITE; + ONCE_REWRITE_TAC [union_subset]; + TYPE_THEN `C3' SUBSET A` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION K` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C3` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "K"; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `C1' INTER C3' = {x'}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING]; + GEN_TAC; + EQ_TAC; + UND 15; + UND 31; + EXPAND_TAC "K"; + REWRITE_TAC [eq_sing]; + REWRITE_TAC[INTER;UNION;SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end]; + DISCH_THEN_REWRITE; + (* --[XC2]-- now C2 doesn't meet x'. This is repeat. *) + (* -- cut C' from {x'} to FIRST point on C2 -- *) + TYPEL_THEN [`C'`;`{x'}`;`C2`] (fun t-> MP_TAC (ISPECL t simple_arc_end_restriction)); + DISCH_THEN ANT_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_end_closed; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + ASM_MESON_TAC[]; + CONJ_TAC; + UND 25; + REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING]; + MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[INTER;INR IN_SING]; + USE 23 (MATCH_MP simple_arc_end_end2); + UND 23; + MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[INTER;INR IN_SING]; + USE 23 (MATCH_MP simple_arc_end_end); + UND 23; + USE 5 (MATCH_MP simple_arc_end_end); + UND 5; + MESON_TAC[]; + REP_BASIC_TAC; + (* ---[Xa] *) + TYPE_THEN `C2a = C'''''` ABBREV_TAC ; + KILL 36; + TYPE_THEN `v = x'` SUBGOAL_TAC; + USE 33(REWRITE_RULE[FUN_EQ_THM]); + USE 33(REWRITE_RULE[INTER;INR IN_SING]); + UND 33; + MESON_TAC[]; + DISCH_THEN (fun t -> (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + KILL 33; + TYPE_THEN `C2a SUBSET C1` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 20; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + TYPE_THEN `C2a SUBSET A /\ simple_arc_end C2a x' v'' /\ ~(C2a p3) /\ (C1' INTER C2a = {(x')}) /\ (C2 INTER C2a = {(v'')}) /\ (~C2a p2)` SUBGOAL_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION K` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1` EXISTS_TAC; + REWRITE_TAC[SUBSET_UNION]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL ]; + CONJ_TAC; + UND 6; + UND 33; + MESON_TAC[ISUBSET]; + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING]; + EQ_TAC; + UND 21; + UND 35; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end]; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING]; + EQ_TAC; + UND 32; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + UND 32; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + UND 35; + USE 20 (REWRITE_RULE[FUN_EQ_THM]); + USE 20 (REWRITE_RULE[UNION]); + UND 20; + UND 7; + MESON_TAC [ISUBSET]; + KILL 32; + KILL 33; + KILL 34; + KILL 35; (* attention *) + REP_BASIC_TAC; + (* --[Xb] *) + TYPE_THEN `(v'' = x)` ASM_CASES_TAC; + FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); + TYPE_THEN `C2 UNION C2a` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ONCE_REWRITE_TAC[union_subset]; + ASM_REWRITE_TAC[]; + UND 9; + EXPAND_TAC "K"; + REWRITE_TAC[union_subset]; + MESON_TAC[]; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REWRITE_TAC[UNION;DE_MORGAN_THM]; + ASM_REWRITE_TAC[]; + (* --- *) + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;UNION;INR IN_SING]; + GEN_TAC; + EQ_TAC ; + REWRITE_TAC[LEFT_AND_OVER_OR]; + DISCH_THEN DISJ_CASES_TAC; + UND 39; + UND 15; + EXPAND_TAC "K"; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER;UNION]; + MESON_TAC[]; + UND 39; + UND 34; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + UND 34; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + (* -- *) + (* --[Xc] cut off C3b at- v'' *) + TYPEL_THEN [`C2`;`x`;`p2`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut)); + DISCH_THEN ANT_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 33; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + PROOF_BY_CONTR_TAC; + USE 39 (REWRITE_RULE[]); + FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + UND 32; + REWRITE_TAC[]; + UND 33; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `C2b = C''''''` ABBREV_TAC ; + KILL 43; + TYPE_THEN `C2b SUBSET C2` SUBGOAL_TAC; + UND 39; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + (* -- [Xd] EXISTS_TAC *) + TYPE_THEN `C2a UNION C2b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REWRITE_TAC[union_subset ]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS ; + TYPE_THEN `C1 UNION K` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "K"; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `v''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 43; + UND 33; + UND 40; + REWRITE_TAC[eq_sing ]; + REWRITE_TAC[INTER;SUBSET]; + MESON_TAC[]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[UNION;DE_MORGAN_THM]; + ASM_REWRITE_TAC[]; + UND 43; + UND 3; + MESON_TAC[ISUBSET]; + IMATCH_MP_TAC EQ_EXT ; + REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR]; + GEN_TAC; + EQ_TAC; + DISCH_THEN DISJ_CASES_TAC; + FIRST_ASSUM MP_TAC; + UND 21; + UND 34; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER]; + MESON_TAC[]; + FIRST_ASSUM MP_TAC; + UND 43; + UND 15; + EXPAND_TAC "K"; + REWRITE_TAC[eq_sing]; + REWRITE_TAC[INTER;UNION;SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISJ1_TAC; + UND 36; + MESON_TAC[simple_arc_end_end]; + (* Fri Aug 13 17:43:15 EDT 2004 *) + + ]);; + + (* }}} *) + + +let simple_arc_sep2 = prove_by_refinement( + `!A C1 C2 C3 x p1 p2 p3. + ( + C1 UNION C2 UNION C3 SUBSET A /\ + (simple_arc_end C1 x p1) /\ + (simple_arc_end C2 x p2) /\ + (simple_arc_end C3 x p3) /\ + (C1 INTER C2 = {x}) /\ + (C1 INTER C3 = {x}) /\ + ~(C2 p3) /\ ~(C3 p2)) ==> + (?x' C1' C2' C3'. + (C1' UNION C2' UNION C3' SUBSET A) /\ + (simple_arc_end C1' x' p1) /\ + (simple_arc_end C2' x' p2) /\ + (simple_arc_end C3' x' p3) /\ + (C1' INTER C2' = {x'}) /\ + (C2' INTER C3' = {x'}) /\ + (C3' INTER C1' = {x'}) + )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPEL_THEN[`C2`;`C3`;`{p2}`] (fun t -> ANT_TAC (ISPECL t simple_arc_end_restriction)); + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_end_closed; + TYPE_THEN `C2` EXISTS_TAC; + TYPE_THEN `x` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING]; + TYPE_THEN `C2 p2` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + TYPE_THEN `C2 x` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + TYPE_THEN `C3 x` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `v' = p2` SUBGOAL_TAC; + UND 8; + REWRITE_TAC[eq_sing; INR IN_SING;]; + REWRITE_TAC[INTER;INR IN_SING ]; + MESON_TAC[]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + KILL 8; + TYPE_THEN `v` EXISTS_TAC; + LEFT_TAC "C2'"; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* A easy case *) + TYPE_THEN `v = x` ASM_CASES_TAC; + FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]); + TYPE_THEN `C' = C2` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `C2` EXISTS_TAC; + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `p2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET_REFL]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]); + TYPE_THEN `C1` EXISTS_TAC; + TYPE_THEN `C3` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [INTER_COMM]; + ASM_REWRITE_TAC[]; + (* [B] general case *) + TYPEL_THEN [`C3`;`x`;`p3`;`v`] (fun t-> ANT_TAC (ISPECL t simple_arc_end_cut)); + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 9; + REWRITE_TAC[eq_sing;INTER]; + MESON_TAC[]; + DISCH_TAC; + FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + TYPE_THEN `C' p3` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + UND 1; + UND 11; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `C1 UNION C''` EXISTS_TAC; + TYPE_THEN `C'''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(C1 UNION C'') UNION C' UNION C''' = C1 UNION C' UNION (C'' UNION C''')` SUBGOAL_TAC; + SET_TAC[UNION]; + DISCH_THEN_REWRITE; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C1 UNION C2 UNION C3` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_union_pair ; + REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC subset_union_pair ; + ASM_REWRITE_TAC[SUBSET_REFL]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING ]; + GEN_TAC; + EQ_TAC ; + UND 2; + TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC; + UND 12; + SET_TAC [SUBSET;UNION]; + REWRITE_TAC[eq_sing;INTER;SUBSET]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + (* --[a] *) + TYPE_THEN `(C1 UNION C'') v /\ (C' v) /\ (C''' v)` SUBGOAL_TAC; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + DISJ2_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + ASM_MESON_TAC[simple_arc_end_end;]; + DISCH_TAC; + (* -- *) + TYPE_THEN `C''' SUBSET C3` SUBGOAL_TAC; + UND 12; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + TYPE_THEN `C' INTER C''' = {v}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + GEN_TAC; + EQ_TAC; + UND 17; + UND 9; + REWRITE_TAC[eq_sing;SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[INTER;]; + DISCH_THEN_REWRITE; + (* -- *) + TYPEL_THEN [`C2`;`p2`;`x`;`v`] (fun t-> ANT_TAC(ISPECL t simple_arc_end_cut)); + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 11; + REP_BASIC_TAC; + UND 11; + UND 18; + MESON_TAC[ISUBSET]; + IMATCH_MP_TAC simple_arc_end_distinct; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `C'''' = C'` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `C2` EXISTS_TAC; + TYPE_THEN `p2` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + UND 16; + SET_TAC[UNION;SUBSET]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + (* -- *) + TYPE_THEN `~C' x` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + REWR 24; + TYPE_THEN `C''''' x` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + UND 8; + UND 18; + UND 24; + REWRITE_TAC[eq_sing;INTER;]; + MESON_TAC[]; + DISCH_TAC; + (* -- *) + KILL 7; + KILL 6; + KILL 5; + KILL 4; + TYPE_THEN `C'' x` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + DISCH_TAC; + KILL 15; + KILL 14; + KILL 20; + KILL 19; + (* --[b] *) + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INTER;INR IN_SING]; + GEN_TAC; + EQ_TAC; + TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC; + UND 12; + SET_TAC[UNION;SUBSET]; + UND 2; + UND 3; + UND 11; + UND 24; + UND 9; + REWRITE_TAC[SUBSET;INTER;eq_sing]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + UND 13; + REWRITE_TAC[eq_sing;INTER]; + MESON_TAC[]; + (* -- *) + TYPE_THEN `~ (C''' x)` SUBGOAL_TAC; + DISCH_TAC; + UND 13; + UND 5; + UND 4; + UND 8; + REWRITE_TAC[eq_sing;INTER;]; + MESON_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;UNION;INR IN_SING]; + GEN_TAC; + EQ_TAC ; + UND 13; + UND 2; + UND 17; + UND 5; + REWRITE_TAC[SUBSET;INTER;eq_sing]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + UND 23; + REWRITE_TAC[UNION]; + (* Fri Aug 13 20:36:09 EDT 2004 *) + + ]);; + + (* }}} *) + +let simple_arc_sep = prove_by_refinement( + `!A C1 C2 C3 x p1 p2 p3. + (C1 UNION C2 UNION C3 SUBSET A) /\ + (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\ + (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\ + (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==> + (?x' C1' C2' C3'. + (C1' UNION C2' UNION C3' SUBSET A) /\ + (simple_arc_end C1' x' p1) /\ + (simple_arc_end C2' x' p2) /\ + (simple_arc_end C3' x' p3) /\ + (C1' INTER C2' = {x'}) /\ + (C2' INTER C3' = {x'}) /\ + (C3' INTER C1' = {x'}) + )`, + (* {{{ proof *) + [ + REP_GEN_TAC; + DISCH_TAC; + IMATCH_MP_TAC simple_arc_sep2; + USE 0 (MATCH_MP simple_arc_sep3); + REP_BASIC_TAC; + TYPE_THEN `C1'` EXISTS_TAC; + TYPE_THEN `C2'` EXISTS_TAC; + TYPE_THEN `C3'` EXISTS_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION N *) +(* ------------------------------------------------------------------ *) + +(* K33 stuff *) + +let isthree = prove_by_refinement( + `?x. (\t. (t < 3)) x`, + (* {{{ proof *) + + [ + TYPE_THEN `0` EXISTS_TAC; + BETA_TAC; + ARITH_TAC; + (* Sat Aug 14 11:56:32 EDT 2004 *) + ]);; + + (* }}} *) + +let three_t = new_type_definition "three_t" ("ABS3","REP3") + isthree;; + +let type_bij = prove_by_refinement( + `!X (fXY:A->B) gYX. + (!a. fXY (gYX a) = a) /\ (!r. X r = (gYX (fXY r) = r)) ==> + (BIJ fXY X UNIV) /\ (BIJ gYX UNIV X)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + CONJ_TAC; + IMATCH_MP_TAC bij_inj_image; + REWRITE_TAC[INJ;SUBSET;IMAGE ;]; + CONJ_TAC; + REP_BASIC_TAC; + USE 2 (AP_TERM `gYX:B->A` ); + REWR 3; + REWR 4; + REWR 2; + (* -- *) + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + NAME_CONFLICT_TAC; + GEN_TAC; + TYPE_THEN `gYX x''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + IMATCH_MP_TAC bij_inj_image; + REWRITE_TAC[INJ;SUBSET;IMAGE]; + CONJ_TAC; + REP_BASIC_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + USE 2(AP_TERM `fXY:A->B`); + REWR 2; + REP_BASIC_TAC; + TYPE_THEN `fXY x` EXISTS_TAC; + REWR 2; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let thr_bij = prove_by_refinement( + `(BIJ ABS3 {x | x < 3} UNIV) /\ (BIJ REP3 UNIV {x | x < 3})`, + (* {{{ proof *) + [ + IMATCH_MP_TAC type_bij ; + ASSUME_TAC three_t; + ASM_REWRITE_TAC[]; + REWRITE_TAC[three_t]; + REP_BASIC_TAC; + UND 0; + BETA_TAC; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let thr_finite = prove_by_refinement( + `(UNIV:three_t->bool) HAS_SIZE 3`, + (* {{{ proof *) + [ + REWRITE_TAC [has_size_bij2]; + TYPE_THEN `REP3` EXISTS_TAC; + ASM_REWRITE_TAC[thr_bij]; + (* Sat Aug 14 12:28:58 EDT 2004 *) + ]);; + (* }}} *) + +let has_size3_bij = prove_by_refinement( + `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f (UNIV:three_t->bool) A)`, + (* {{{ proof *) + + [ + REWRITE_TAC[has_size_bij]; + REP_BASIC_TAC; + EQ_TAC; + REP_BASIC_TAC; + ASSUME_TAC thr_bij; + TYPE_THEN `compose f REP3` EXISTS_TAC; + IMATCH_MP_TAC COMP_BIJ; + TYPE_THEN `{m | m < 3}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + REP_BASIC_TAC; + TYPE_THEN `compose f ABS3` EXISTS_TAC; + IMATCH_MP_TAC COMP_BIJ; + TYPE_THEN `UNIV:three_t->bool` EXISTS_TAC; + ASM_REWRITE_TAC[thr_bij]; + (* Sat Aug 14 12:36:22 EDT 2004 *) + + ]);; + + (* }}} *) + +let has_size3_bij2 = prove_by_refinement( + `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f A (UNIV:three_t->bool) )`, + (* {{{ proof *) + [ + REWRITE_TAC[has_size_bij2]; + GEN_TAC; + EQ_TAC; + REP_BASIC_TAC; + TYPE_THEN `compose ABS3 f` EXISTS_TAC; + IMATCH_MP_TAC COMP_BIJ; + TYPE_THEN `{m | m < 3}` EXISTS_TAC; + ASM_REWRITE_TAC[thr_bij]; + (* -- *) + REP_BASIC_TAC; + TYPE_THEN `compose REP3 f` EXISTS_TAC; + IMATCH_MP_TAC COMP_BIJ; + TYPE_THEN `UNIV:three_t ->bool` EXISTS_TAC; + ASM_REWRITE_TAC[thr_bij]; + (* Sat Aug 14 12:40:48 EDT 2004 *) + + ]);; + (* }}} *) + +let cartesian = jordan_def + `cartesian (X:A->bool) (Y:B->bool) = + { (x,y) | X x /\ Y y}`;; + +let cartesian_pair = prove_by_refinement( + `!X Y (x:A) (y:B). cartesian X Y (x,y) <=> (X x) /\ (Y y)`, + (* {{{ proof *) + [ + REWRITE_TAC[cartesian;PAIR_SPLIT ;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let cartesian_el = prove_by_refinement( +`!X Y (x:(A#B)). cartesian X Y x <=> (X (FST x)) /\ (Y (SND x))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[cartesian]; + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN`FST x` EXISTS_TAC; + TYPE_THEN `SND x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* ignore earlier K33 def *) + +let k33_graph = jordan_def + `k33_graph = mk_graph_t ( + cartesian (UNIV:three_t ->bool) UNIV, + cartesian UNIV UNIV, + (\e. { (FST e,T), (SND e,F)} ) )`;; + +let graph_edge_mk_graph = prove_by_refinement( + `!(V:A->bool) (E:B->bool) C. graph_edge(mk_graph_t (V,E,C)) = E`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_edge;dest_graph_t;part1;drop0]; + ]);; + (* }}} *) + +let graph_vertex_mk_graph = prove_by_refinement( + `!(V:A->bool) (E:B->bool) C. graph_vertex(mk_graph_t (V,E,C)) = V`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_vertex;dest_graph_t;]; + ]);; + (* }}} *) + +let graph_inc_mk_graph = prove_by_refinement( + `!(V:A->bool) (E:B->bool) C. graph_inc(mk_graph_t (V,E,C)) = C`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_inc;dest_graph_t;drop1]; + ]);; + (* }}} *) + +let k33_isgraph = prove_by_refinement( + `graph (k33_graph)`, + (* {{{ proof *) + [ + REWRITE_TAC[graph;has_size2]; + REWRITE_TAC[IMAGE;SUBSET;]; + NAME_CONFLICT_TAC; + REWRITE_TAC[k33_graph;graph_inc_mk_graph;graph_edge_mk_graph;graph_vertex_mk_graph;in_pair;cartesian]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[in_pair]; + CONJ_TAC; + GEN_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN `(x,T)` EXISTS_TAC; + TYPE_THEN `(y,F)` EXISTS_TAC; + REWRITE_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + (* Sat Aug 14 13:18:16 EDT 2004 *) + + ]);; + (* }}} *) + +let k33_iso = prove_by_refinement( + `!(A:A->bool) B (E:B->bool) f. + A HAS_SIZE 3 /\ B HAS_SIZE 3 /\ (A INTER B = EMPTY) /\ + BIJ f E (cartesian A B) ==> + (graph_isomorphic k33_graph + (mk_graph_t + (A UNION B, E,( \ e. { (FST (f e)), (SND (f e)) }))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[graph_isomorphic;graph_iso;k33_graph;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph;]; + RULE_ASSUM_TAC (REWRITE_RULE[has_size3_bij]); + REP_BASIC_TAC; + TYPE_THEN `u = ( \ t. (if (SND t) then (f'' (FST t)) else (f'(FST t))))` ABBREV_TAC ; + LEFT_TAC "u"; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `g = INV f E (cartesian A B)` ABBREV_TAC ; + TYPE_THEN `v = ( \t . (g (f'' (FST t), f' (SND t))))` ABBREV_TAC ; + LEFT_TAC "v"; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `(u,v)` EXISTS_TAC; + REWRITE_TAC[]; + (* A u *) + CONJ_TAC; + REWRITE_TAC[BIJ;SURJ;INJ]; + SUBCONJ_TAC ; + CONJ_TAC; + EXPAND_TAC "u"; + REWRITE_TAC[cartesian_el]; + REWRITE_TAC[UNION;]; + GEN_TAC; + COND_CASES_TAC; + UND 2; + REWRITE_TAC[BIJ;SURJ]; + MESON_TAC[]; + UND 3; + REWRITE_TAC[BIJ;SURJ]; + MESON_TAC[]; + REWRITE_TAC[cartesian_el;]; + EXPAND_TAC "u"; + REP_GEN_TAC ; + COND_CASES_TAC; + COND_CASES_TAC; + UND 2; + REWRITE_TAC[BIJ;INJ]; + REP_BASIC_TAC; + REWRITE_TAC[PAIR_SPLIT]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + UND 1; + REWRITE_TAC[EMPTY_EXISTS ]; + TYPE_THEN `f'' (FST x)` EXISTS_TAC; + REWRITE_TAC[INTER]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + COND_CASES_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + UND 1; + REWRITE_TAC[EMPTY_EXISTS ]; + TYPE_THEN `f' (FST x)` EXISTS_TAC; + REWRITE_TAC[INTER]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 3(REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE ; + REWRITE_TAC[UNION]; + GEN_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPE_THEN `( ((INV f'' UNIV A) x ), T )` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[cartesian_el]; + EXPAND_TAC "u"; + REWRITE_TAC[SND ]; + IMATCH_MP_TAC inv_comp_right; + ASM_REWRITE_TAC[]; + TYPE_THEN `( ((INV f' UNIV B) x ), F )` EXISTS_TAC; + REWRITE_TAC[cartesian_el]; + EXPAND_TAC "u"; + REWRITE_TAC[SND ]; + IMATCH_MP_TAC inv_comp_right; + ASM_REWRITE_TAC[]; + (* B graph_inc *) + REWRITE_TAC[cartesian_el]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + GEN_TAC; + EXPAND_TAC "u"; + REWRITE_TAC[IMAGE_CLAUSES]; + EXPAND_TAC "v"; + EXPAND_TAC "g"; + TYPE_THEN `cartesian A B (f'' (FST e), f' (SND e))` SUBGOAL_TAC; + REWRITE_TAC[cartesian_el]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + ASM_SIMP_TAC[inv_comp_right]; + (* C BIJ v *) + TYPE_THEN `BIJ g (cartesian A B) E` SUBGOAL_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + REWRITE_TAC[cartesian_el]; + EXPAND_TAC "v"; + CONJ_TAC; + (* --- *) + USE 7(REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[cartesian_el]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(f'' (FST x),f' (SND x)) = (f''(FST y),f' (SND y))` SUBGOAL_TAC; + USE 7(REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC [cartesian_el]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + REP_BASIC_TAC; + CONJ_TAC; + USE 2 (REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USE 3 (REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[INJ;SURJ]; + DISCH_THEN_REWRITE; + REWRITE_TAC[cartesian_el]; + EXPAND_TAC "v"; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `?u0. (f'' u0 = FST (f x))` SUBGOAL_TAC ; + USE 2 (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 0 (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + TSPEC `x` 11; + REWR 11; + USE 11(REWRITE_RULE[cartesian_el]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `?u1. (f' u1 = SND (f x))` SUBGOAL_TAC ; + USE 3 (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 0 (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + TSPEC `x` 12; + REWR 12; + USE 12(REWRITE_RULE[cartesian_el]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(u0,u1)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "g"; + IMATCH_MP_TAC inv_comp_left; + ASM_REWRITE_TAC[]; + (* Sat Aug 14 14:58:11 EDT 2004 *) + + ]);; + (* }}} *) + + +(* ********************************************************* *) + +let mk_segment_inj_image2 = prove_by_refinement( + `!x y n. + euclid n x /\ euclid n y /\ ~(x = y) + ==> (?f. continuous f (top_of_metric (UNIV,d_real)) + (top_of_metric (euclid n,d_euclid)) /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid n) /\ + (f (&0) = x) /\ (f (&1) = y) /\ + (IMAGE f {t | &0 <= t /\ t <= &1} = mk_segment x y))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC cont_mk_segment; + ASM_REWRITE_TAC[]; + REWRITE_TAC[joinf;IMAGE ]; + REWRITE_TAC[mk_segment]; + (* new new *) + TYPE_THEN `((if &0 < &0 then x else if &0 < &1 then euclid_plus (&0 *# y) ((&1 - &0) *# x) else y) = x) /\ ((if &1 < &0 then x else if &1 < &1 then euclid_plus (&1 *# y) ((&1 - &1) *# x) else y) = y)` SUBGOAL_TAC; + REWRITE_TAC[REAL_ARITH `~(&0 < &0) /\ ~(&1 < &0) /\ (&0 < &1) /\ ~(&1 < &1)`]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale0; euclid_scale_one ; euclid_lzero]; + DISCH_THEN_REWRITE; + (* end new new *) + CONJ_TAC; + (* new stuff *) + REWRITE_TAC[INJ]; + CONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; + UND 4; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_CASES_TAC `x' < &1`; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC euclid_add_closure; + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 3; + TYPE_THEN `~(x' < &0)` SUBGOAL_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `~(y' < &0)` SUBGOAL_TAC; + UND 5; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC; + TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC; + UND 6; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(x' < &1)` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; + DISCH_THEN_REWRITE; + + TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC; + TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC; + UND 4; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(y' < &1)` SUBGOAL_TAC; + UND 3; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero]; + DISCH_THEN_REWRITE; + (* th *) + ONCE_REWRITE_TAC [euclid_eq_minus]; + REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act]; + ONCE_REWRITE_TAC [euclid_plus_pair]; + REWRITE_TAC[GSYM euclid_rdistrib]; + REDUCE_TAC; + REWRITE_TAC[REAL_ARITH `x' + -- &1 * y' = x' - y'`]; + REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`]; + REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus]; + (* th1 *) + DISCH_TAC; + PROOF_BY_CONTR_TAC; + UND 2; + REWRITE_TAC[]; + IMATCH_MP_TAC euclid_scale_cancel; + TYPE_THEN `(x' - y')` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 8; + REAL_ARITH_TAC; + KILL 2; + (* old stuff *) + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + ASM_REWRITE_TAC[]; + EQ_TAC; + DISCH_TAC; + CHO 2; + UND 2; + COND_CASES_TAC; + DISCH_ALL_TAC; + JOIN 3 2; + ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`]; + DISCH_ALL_TAC; + UND 5; + COND_CASES_TAC; + DISCH_TAC; + TYPE_THEN `&1 - x''` EXISTS_TAC; + SUBCONJ_TAC; + UND 5; + REAL_ARITH_TAC ; + DISCH_TAC; + CONJ_TAC; + UND 3; + REAL_ARITH_TAC ; + ONCE_REWRITE_TAC [euclid_add_comm]; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`]; + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + CONJ_TAC; + REAL_ARITH_TAC ; + CONJ_TAC; + REAL_ARITH_TAC ; + REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; + (* 2nd half *) + DISCH_TAC; + CHO 2; + TYPE_THEN `&1 - a` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + AND 2; + AND 2; + UND 3; + UND 4; + REAL_ARITH_TAC ; + COND_CASES_TAC; + ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`]; + COND_CASES_TAC; + REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`]; + ASM_MESON_TAC [euclid_add_comm]; + TYPE_THEN `a = &.0` SUBGOAL_TAC; + UND 4; + UND 3; + AND 2; + UND 3; + REAL_ARITH_TAC ; + DISCH_TAC; + REWR 2; + REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ]; + ]);; + (* }}} *) + +let mk_segment_simple_arc_end = prove_by_refinement( + `!x y. + (euclid 2 x) /\ (euclid 2 y) /\ ~(x = y) ==> + simple_arc_end (mk_segment x y) x y`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[simple_arc_end]; + TYPEL_THEN [`x`;`y`;`2`] (fun t-> ANT_TAC (ISPECL t mk_segment_inj_image2)); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `f` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[GSYM top2 ]); + ASM_REWRITE_TAC[]; + (* Tue Aug 17 10:10:00 EDT 2004 *) + + ]);; + + (* }}} *) + +let cis0 = prove_by_refinement( + `cis (&0) = e1`, + (* {{{ proof *) + [ + REWRITE_TAC[cis;COS_0;SIN_0;e1;]; + ]);; + (* }}} *) + +let cispi2 = prove_by_refinement( + `cis (pi/(&2)) = e2`, + (* {{{ proof *) + [ + REWRITE_TAC [cis;COS_PI2;SIN_PI2;e2]; + ]);; + (* }}} *) + +let neg_point = prove_by_refinement( + `!x y. -- (point (x,y)) = point (--x, --y)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[euclid_neg]; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + BETA_TAC; + MP_TAC (ARITH_RULE `(x' = 0) \/ (x' = 1) \/ (2 <=| x')`); + REP_CASES_TAC ; + ASM_REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[coord01]; + TYPE_THEN `euclid 2(point(x,y)) /\ euclid 2(point(--x,--y))` SUBGOAL_TAC; + ASM_MESON_TAC[euclid_point]; + REWRITE_TAC[euclid]; + REP_BASIC_TAC; + TSPEC `x'` 1; + TSPEC `x'` 2; + ASM_MESON_TAC[REAL_ARITH `-- &0 = &0`]; + (* Tue Aug 17 10:27:14 EDT 2004 *) + + ]);; + (* }}} *) + +let cispi = prove_by_refinement( + `cis(pi) = -- e1`, + (* {{{ proof *) + [ + REWRITE_TAC[cis;COS_PI ;SIN_PI;e1]; + REWRITE_TAC[neg_point]; + AP_TERM_TAC; + REWRITE_TAC[PAIR_SPLIT]; + REAL_ARITH_TAC; + (* Tue Aug 17 10:28:55 EDT 2004 *) + + ]);; + (* }}} *) + +let cis3pi2 = prove_by_refinement( + `cis(&3 *pi/(&2)) = -- e2`, + (* {{{ proof *) + [ + TYPE_THEN `&3 *pi/(&2) = pi/(&2) + pi` SUBGOAL_TAC; + REWRITE_TAC[REAL_ARITH `&3 = &1 + &1 + &1`]; + REWRITE_TAC[REAL_ARITH `(x + y)*z = x*z + y*z`]; + REDUCE_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[cis;COS_PERIODIC_PI;SIN_PERIODIC_PI;GSYM neg_point;]; + AP_TERM_TAC; + REWRITE_TAC[GSYM cis;cispi2]; + (* Tue Aug 17 10:34:32 EDT 2004 *) + + ]);; + (* }}} *) + +let closedball_convex = prove_by_refinement( + `!x e n. (convex (closed_ball (euclid n,d_euclid) x e))`, + (* {{{ proof *) + [ + REWRITE_TAC[convex;closed_ball;SUBSET;mk_segment;]; + REP_BASIC_TAC; + USE 0 SYM; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + EXPAND_TAC "x''"; + IMATCH_MP_TAC (euclid_add_closure); + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); + DISCH_TAC; + TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC; + REWRITE_TAC[trivial_lin_combo]; + DISCH_THEN_REWRITE; + EXPAND_TAC "x''"; + (* special case *) + ASM_CASES_TAC `a = &0` ; + UND 10; + DISCH_THEN_REWRITE; + REDUCE_TAC; + ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;]; + TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u <= a*e) /\ (v <= (&1- a)*e)) ==> (d <= e))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `u + v <= (a*e) + (&1 - a)*e` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_LE_ADD2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`]; + UND 13; + REAL_ARITH_TAC ; + DISCH_THEN IMATCH_MP_TAC ; + TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC; + TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC; + TYPE_THEN `d_euclid z x''` EXISTS_TAC; + TYPE_THEN `euclid n z` SUBGOAL_TAC; + EXPAND_TAC "z"; + IMATCH_MP_TAC (euclid_add_closure); + CONJ_TAC THEN (IMATCH_MP_TAC euclid_scale_closure) THEN (ASM_REWRITE_TAC[]); + DISCH_TAC; + CONJ_TAC; + EXPAND_TAC "x''"; + IMATCH_MP_TAC metric_space_triangle; + TYPE_THEN `euclid n` EXISTS_TAC; + REWRITE_TAC[metric_euclid]; + ASM_REWRITE_TAC[trivial_lin_combo]; + CONJ_TAC; + EXPAND_TAC "z"; + TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid (a *# x) (a *# x') ` SUBGOAL_TAC; + IMATCH_MP_TAC metric_translate; + TYPE_THEN `n` EXISTS_TAC; + REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); + DISCH_THEN_REWRITE; + TYPE_THEN `d_euclid (a *# x) (a *# x') = abs (a) * d_euclid x x'` SUBGOAL_TAC; + IMATCH_MP_TAC norm_scale_vec; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `abs a = a` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_ABS_REFL]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + ASM_REWRITE_TAC[]; + + (* LAST case *) + EXPAND_TAC "z"; + EXPAND_TAC "x''"; + TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_translate_LEFT; + TYPE_THEN `n` EXISTS_TAC; + REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC euclid_scale_closure) THEN ASM_REWRITE_TAC[]); + DISCH_THEN_REWRITE; + TYPE_THEN `!b. d_euclid (b *# x) (b *# y) = abs (b) * d_euclid x y` SUBGOAL_TAC; + GEN_TAC; + IMATCH_MP_TAC norm_scale_vec; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `abs (&1 - a) = (&1 - a)` SUBGOAL_TAC; + REWRITE_TAC [REAL_ABS_REFL]; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + ASM_REWRITE_TAC[]; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let closedball_mk_segment_end = prove_by_refinement( + `!x e n u v. + (closed_ball(euclid n,d_euclid) x e u) /\ + (closed_ball(euclid n,d_euclid) x e v) ==> + (mk_segment u v SUBSET (closed_ball(euclid n,d_euclid) x e))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC closedball_convex; + TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL); + USE 2 (REWRITE_RULE[convex]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let euclid2_e12 = prove_by_refinement( + `euclid 2 e1 /\ euclid 2 e2`, + (* {{{ proof *) + [ + REWRITE_TAC[e1;e2;euclid_point]; + ]);; + (* }}} *) + +let in_union = prove_by_refinement( + `!X Y Z. (X:A->bool) SUBSET Y \/ (X SUBSET Z) ==> (X SUBSET Y UNION Z)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;UNION ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let mk_segment_hyperplane = prove_by_refinement( + `!p r i. (i < 4) /\ (&0 + (mk_segment p (p + r *# (cis(&i * pi/(&2))))) SUBSET + (hyperplane 2 e2 (p 1) UNION + hyperplane 2 e1 (p 0)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?x y. p = point (x,y)` SUBGOAL_TAC; + USE 0 (MATCH_MP point_onto); + REP_BASIC_TAC; + TYPE_THEN `FST p'` EXISTS_TAC; + TYPE_THEN `SND p'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UND 3; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + REWRITE_TAC[coord01]; + (* -- *) + TYPE_THEN `convex(hyperplane 2 e2 y)` SUBGOAL_TAC; + IMATCH_MP_TAC hyperplane_convex; + REWRITE_TAC[euclid2_e12]; + TYPE_THEN `convex(hyperplane 2 e1 x)` SUBGOAL_TAC; + IMATCH_MP_TAC hyperplane_convex; + REWRITE_TAC[euclid2_e12]; + REWRITE_TAC[convex]; + REP_BASIC_TAC; + TYPE_THEN `hyperplane 2 e1 x (point(x,y)) /\ hyperplane 2 e2 y (point(x,y))` SUBGOAL_TAC; + REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F]; + CONJ_TAC; + TYPE_THEN `(x,y)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(x,y)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + USE 2 (MATCH_MP (ARITH_RULE (`(i < 4) ==> (i = 0) \/ (i = 1) \/ (i = 2) \/ (i = 3)`))); + (* -- *) + IMATCH_MP_TAC in_union; + TYPE_THEN `z = (euclid_plus (point (x,y)) (r *# cis (&i * pi / &2)))` ABBREV_TAC ; + TYPE_THEN `hyperplane 2 e2 y z \/ hyperplane 2 e1 x z ==> mk_segment (point (x,y)) z SUBSET hyperplane 2 e2 y \/ mk_segment (point (x,y)) z SUBSET hyperplane 2 e1 x` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + (* -- *) + TYPE_THEN `( (cis (&i *pi/(&2))) 0 = &0) ==> (hyperplane 2 e1 x z)` SUBGOAL_TAC; + REWRITE_TAC[e1;GSYM line2D_F]; + EXPAND_TAC "z"; + REWRITE_TAC[cis;coord01]; + DISCH_THEN_REWRITE; + REWRITE_TAC[point_scale;point_add]; + REDUCE_TAC; + TYPE_THEN `(x, y+ r*sin (&i *pi/(&2)))` EXISTS_TAC; + REWRITE_TAC[]; + (* -- *) + TYPE_THEN `( (cis (&i *pi/(&2))) 1 = &0) ==> (hyperplane 2 e2 y z)` SUBGOAL_TAC; + REWRITE_TAC[e2;GSYM line2D_S]; + EXPAND_TAC "z"; + REWRITE_TAC[cis;coord01]; + DISCH_THEN_REWRITE; + REWRITE_TAC[point_scale;point_add]; + REDUCE_TAC; + TYPE_THEN `(x + r*cos(&i *pi/(&2)) , y)` EXISTS_TAC; + REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(cis (&i * pi / &2) 0 = &0) \/ (cis (&i * pi / &2) 1 = &0) ==> hyperplane 2 e2 y z \/ hyperplane 2 e1 x z` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN IMATCH_MP_TAC ; + UND 2; + POP_ASSUM_LIST (fun t-> ALL_TAC); + (* A -- *) + REP_CASES_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_REWRITE_TAC[cis0;e1;coord01]; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_REWRITE_TAC[cispi2;e2;coord01]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_2]; + REDUCE_TAC; + ASM_REWRITE_TAC[cispi;e1;coord01;neg_point]; + REDUCE_TAC; + ASM_REWRITE_TAC[cis3pi2;e2;coord01;neg_point]; + REDUCE_TAC; + (* Tue Aug 17 11:46:56 EDT 2004 *) + + ]);; + (* }}} *) + +let d_euclid_mk_segment = prove_by_refinement( + `!n a p q . (&0 <= a) /\ (a <= &1) /\ (euclid n p) /\ (euclid n q) ==> + (d_euclid p (a*#p + (&1 - a)*#q) = (&1 - a)*(d_euclid p q))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!z. d_euclid (a*# p + (&1 - a)*# p) z = d_euclid p z` SUBGOAL_TAC; + REWRITE_TAC[trivial_lin_combo]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + TYPE_THEN `d_euclid (euclid_plus (a *# p) ((&1 - a) *# p)) (euclid_plus (a *# p) ((&1 - a) *# q)) = d_euclid ( ((&1 - a) *# p)) ( ((&1 - a) *# q))` SUBGOAL_TAC; + ASM_MESON_TAC [metric_translate_LEFT;euclid_scale_closure]; + DISCH_THEN_REWRITE; + TYPE_THEN `d_euclid ((&1 - a) *# p) ((&1 - a) *# q) = abs (&1- a) * d_euclid p q` SUBGOAL_TAC; + ASM_MESON_TAC[euclid_scale_closure;norm_scale_vec]; + DISCH_THEN_REWRITE; + TYPE_THEN `abs (&1 - a) = (&1 - a)` SUBGOAL_TAC; + UND 2; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[trivial_lin_combo]; + (* Tue Aug 17 12:24:07 EDT 2004 *) + + ]);; + (* }}} *) + +let mk_segment_eq = prove_by_refinement( + `! a p x y. ((a*# p + (&1 - a)*# x) = (a *# p + (&1 - a)*# y)) ==> + (a = &1) \/ (x = y)`, + (* {{{ proof *) + [ + ONCE_REWRITE_TAC[euclid_eq_minus]; + REWRITE_TAC[euclid_minus;euclid_plus;euclid0;euclid_scale]; + REP_BASIC_TAC; + USE 0 (REWRITE_RULE[FUN_EQ_THM]); + IMATCH_MP_TAC (TAUT `(~A ==>B) ==> (A \/ B)`); + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + BETA_TAC; + USE 0 (SPEC `x':num` ); + UND 0; + REWRITE_TAC[REAL_ARITH `(a*b + r*c ) - (a*b + r*d) = r*c - r*d`]; + REWRITE_TAC[REAL_ARITH `a*y - a*z = a*(y-z)`]; + REWRITE_TAC[REAL_ENTIRE]; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let mk_segment_endpoint = prove_by_refinement( + `!p x y n . (d_euclid p x = d_euclid p y) /\ ~(x = y) /\ + (euclid n x) /\ (euclid n y) /\ (euclid n p) ==> + (mk_segment p x INTER mk_segment p y = {p})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING]; + GEN_TAC; + (* A -- *) + EQ_TAC; + REWRITE_TAC[mk_segment]; + REP_BASIC_TAC; + UND 5; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + PROOF_BY_CONTR_TAC; + TYPE_THEN `~(a' = &1)` SUBGOAL_TAC; + DISCH_TAC; + UND 11; + DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t])); + UND 5; + REDUCE_TAC; + REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero]; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `(&1- a')*d_euclid p y = (&1- a)*d_euclid p x` SUBGOAL_TAC; + KILL 4; + ASM_MESON_TAC[d_euclid_mk_segment]; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + REWR 12; + (* -- *) + TYPE_THEN `d_euclid p y = &0` ASM_CASES_TAC; + TYPE_THEN `p = y` SUBGOAL_TAC; + ASM_MESON_TAC [d_euclid_zero]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + ASM_MESON_TAC[d_euclid_zero]; + USE 12 (REWRITE_RULE[REAL_EQ_MUL_RCANCEL]); + REWR 12; + TYPE_THEN `a' = a` SUBGOAL_TAC; + UND 12; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + USE 8 (MATCH_MP mk_segment_eq); + REWR 8; + (* -- *) + DISCH_THEN_REWRITE; + REWRITE_TAC[mk_segment_end]; + (* Tue Aug 17 14:04:19 EDT 2004 *) + + ]);; + (* }}} *) + +let cases4 = prove_by_refinement( + `!i j. (i < j) /\ (j < 4) ==> ((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/ + ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/ + ((i=2)/\ (j=3))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!k. (k < 4) ==> (k = 0) \/ (k =1)\/ (k=2) \/ (k=3)` SUBGOAL_TAC; + ARITH_TAC; + DISCH_TAC; + TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2) \/ (j = 3)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `~(j=0)` SUBGOAL_TAC; + UND 1; + ARITH_TAC; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + TYPE_THEN `(i < 3)` SUBGOAL_TAC; + UND 0; + UND 1; + ARITH_TAC; + DISCH_TAC; + TYPE_THEN `(i=0) \/ (i = 1) \/ (i=2)` SUBGOAL_TAC; + UND 4; + ARITH_TAC; + DISCH_TAC; + JOIN 5 3; + USE 3 (REWRITE_RULE [RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]); + TYPE_THEN `!k. ~((i = k) /\ (j = k))` SUBGOAL_TAC; + GEN_TAC; + UND 1; + ARITH_TAC; + DISCH_THEN (fun t-> USE 3 (REWRITE_RULE[t])); + TYPE_THEN `~((i=2) /\ (j = 1))` SUBGOAL_TAC; + UND 1; + ARITH_TAC ; + DISCH_THEN (fun t-> USE 3(REWRITE_RULE[t])); + ASM_REWRITE_TAC[]; + UND 3; + REP_CASES_TAC THEN (ASM_REWRITE_TAC[]); + ]);; + (* }}} *) + +let cis_distinct = prove_by_refinement( + `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (&0 < r) ==> + ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))`, + (* {{{ proof *) + + [ + TYPE_THEN `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (i < j) /\ (&0 < r) ==> ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `!p x y. (euclid_plus p x = euclid_plus p y) ==> (x = y)` SUBGOAL_TAC; + REWRITE_TAC[euclid_plus]; + REP_BASIC_TAC; + USE 6 (REWRITE_RULE[FUN_EQ_THM]); + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + TSPEC `x'` 6; + UND 6; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> USE 0 (MATCH_MP t)); + USE 0 (AP_TERM `( *# ) (&1/r)`); + USE 0 (REWRITE_RULE [euclid_scale_act]); + TYPE_THEN `&1/r * r = &1` SUBGOAL_TAC; + ONCE_REWRITE_TAC [REAL_ARITH `x*y = y*x`]; + ASM_MESON_TAC[REAL_DIV_LMUL;REAL_ARITH `&0 < r ==> ~(r = &0)`]; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + USE 0(REWRITE_RULE[euclid_scale_one]); + TYPE_THEN `((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/ ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/ ((i=2)/\ (j=3))` SUBGOAL_TAC; + IMATCH_MP_TAC cases4; + ASM_REWRITE_TAC[]; + REP_CASES_TAC THEN (FIRST_ASSUM MP_TAC) THEN (DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t;REAL_ARITH `(&1*x=x) /\ (&0*x= &0)`;e1;e2;cis0;cispi;cispi2;cis3pi2;neg_point;point_inj; PAIR_SPLIT; REAL_ARITH `~(&1 = &0) /\ ~(&0 = &1) /\ (-- &0 = &0) /\ ~(&1 = -- &1) /\ ~(-- &1 = &0) /\ ~(&0 = -- &1)`;REAL_MUL_2; REAL_HALF_DOUBLE ]))) THEN (ASM_REWRITE_TAC[]); + REP_BASIC_TAC; + TYPE_THEN `( i <| j) \/ (j <| i)` SUBGOAL_TAC; + UND 2; + ARITH_TAC; + REP_CASES_TAC; + TYPEL_THEN [`i`;`j`;`r`] (USE 5 o ISPECL); + ASM_MESON_TAC[]; + TYPEL_THEN [`j`;`i`;`r`] (USE 5 o ISPECL); + ASM_MESON_TAC[]; + (* Tue Aug 17 15:01:38 EDT 2004 *) + + + + + ]);; + + (* }}} *) + +let cis_nz = prove_by_refinement( + `!t. ~(cis(t) = euclid0)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0 (AP_TERM `norm2`); + RULE_ASSUM_TAC (REWRITE_RULE[norm2_cis]); + ASM_MESON_TAC[REAL_ARITH `~(&1= &0)`;norm2_0;]; + ]);; + (* }}} *) + +let polar_nz = prove_by_refinement( + `!r t. ~(r = &0) ==> ~(r *# cis(t) =euclid0)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0 (AP_TERM `norm2`); + RULE_ASSUM_TAC (REWRITE_RULE[norm2_scale_cis]); + ASM_MESON_TAC[REAL_ARITH `(abs r = &0) ==> (r = &0)`;norm2_0]; + ]);; + (* }}} *) + +let polar_euclid = prove_by_refinement( + `!r t. euclid 2 (r *# (cis t))`, + (* {{{ proof *) + [ + REWRITE_TAC[cis;point_scale;euclid_point]; + ]);; + (* }}} *) + +let d_euclidpq = prove_by_refinement( + `!n p q . (euclid n p) /\ (euclid n q) ==> (d_euclid p (p+q) = + d_euclid q euclid0)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!z. d_euclid p z = d_euclid (p + euclid0) z` SUBGOAL_TAC; + REWRITE_TAC[euclid_rzero]; + DISCH_THEN (fun t->ONCE_REWRITE_TAC[t]); + TYPE_THEN `d_euclid (euclid_plus p euclid0) (euclid_plus p q) = d_euclid euclid0 q` SUBGOAL_TAC; + IMATCH_MP_TAC metric_translate_LEFT; + TYPE_THEN `n` EXISTS_TAC; + ASM_REWRITE_TAC[euclid_euclid0;polar_euclid;]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC metric_space_symm; + TYPE_THEN `euclid n` EXISTS_TAC ; + ASM_REWRITE_TAC[metric_euclid;euclid_euclid0;polar_euclid]; + ]);; + (* }}} *) + +let degree4_vertex_hv = prove_by_refinement( + `!r p. (&0 < r) /\ (euclid 2 p) ==> + (?C. + (!i. (i< 4) ==> + simple_arc_end (C i) p (p + r*# (cis(&i * pi/(&2))))) /\ + (!i. (i < 4) ==> + (C i = mk_segment p (p + r*# (cis(&i * pi/(&2)))))) /\ + (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==> + (C i INTER C j = {p})) /\ + (!i. (i < 4) ==> + (C i INTER {x | r <= d_euclid p x } = + { (p + r *# (cis(&i* pi/(&2)))) })) /\ + (!i. (i< 4) ==> + C i SUBSET (closed_ball (euclid 2,d_euclid) p r)) /\ + (!i. (i< 4) ==> + C i SUBSET (hyperplane 2 e2 (p 1) UNION + hyperplane 2 e1 (p 0)))) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(\i. mk_segment p (euclid_plus p (r *# cis (&i * pi / &2))))` EXISTS_TAC; + BETA_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `!i. ~(r *# cis (&i * pi/(&2)) = euclid0)` SUBGOAL_TAC; + REP_BASIC_TAC; + ASM_MESON_TAC[polar_nz;REAL_ARITH `&0 < r ==> ~( r= &0)`]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!i . euclid 2 (r *# cis (&i * pi/(&2)))` SUBGOAL_TAC; + GEN_TAC; + REWRITE_TAC[polar_euclid]; + DISCH_TAC; + (* -- *) + CONJ_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_SIMP_TAC[euclid_add_closure]; + DISCH_TAC; + TSPEC `i` 2; + UND 2; + TYPE_THEN `z =r *# cis(&i *pi/(&2))` ABBREV_TAC ; + REWRITE_TAC[euclid0]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + USE 5 (REWRITE_RULE[FUN_EQ_THM ]); + TSPEC `x` 5; + UND 5; + REWRITE_TAC[euclid_plus]; + REAL_ARITH_TAC; + (* -- *) + CONJ_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC mk_segment_endpoint; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `!i. d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi / &2)) euclid0` SUBGOAL_TAC; + GEN_TAC; + IMATCH_MP_TAC d_euclidpq; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM norm2]; + REWRITE_TAC[norm2_scale_cis]; + CONJ_TAC; + IMATCH_MP_TAC cis_distinct; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[polar_euclid;euclid_add_closure]; + (* [B] *) + TYPE_THEN `!a q. (euclid 2 q) /\ (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + q)) = (&1 - a)*(d_euclid p (p + q)))` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC d_euclid_mk_segment; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[euclid_add_closure]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!a i. (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + r *# (cis (&i * pi/(&2))))) = (&1 - a)*r)` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `d_euclid p (p + r *# (cis (&i * pi/(&2)))) = norm2 ( r *# (cis (&i * pi/(&2))))` SUBGOAL_TAC; + REWRITE_TAC[norm2]; + IMATCH_MP_TAC d_euclidpq; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[polar_euclid]; + REWRITE_TAC[norm2_scale_cis]; + TYPE_THEN `abs r = r` SUBGOAL_TAC; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPEL_THEN [`2`;`a`;`p`;`p + (r *# cis (&i * pi / &2))`] (fun t-> ANT_TAC (ISPECL t d_euclid_mk_segment)); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[euclid_add_closure;polar_euclid]; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + (* -- *) + CONJ_TAC; + REP_BASIC_TAC ; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[mk_segment;INTER;INR IN_SING]; + EQ_TAC; + REP_BASIC_TAC; + UND 8; + DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL); + REWR 5; + ASM_REWRITE_TAC[]; + REWR 7; + TYPE_THEN `&1 * r <= (&1 - a) * r` SUBGOAL_TAC; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; + DISCH_TAC; + TYPE_THEN `a = &0` SUBGOAL_TAC; + UND 10; + UND 8; + REAL_ARITH_TAC; + DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + REDUCE_TAC; + REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero]; + DISCH_THEN_REWRITE; + CONJ_TAC; + TYPE_THEN `&0` EXISTS_TAC; + REWRITE_TAC [REAL_ARITH `&0 <= &0 /\ &0 <= &1`]; + REDUCE_TAC; + REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero]; + TYPE_THEN `d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi/(&2))) euclid0` SUBGOAL_TAC; + IMATCH_MP_TAC d_euclidpq; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM norm2;norm2_scale_cis]; + UND 1; + REAL_ARITH_TAC; + (* C-- *) + CONJ_TAC; + REP_BASIC_TAC ; + REWRITE_TAC[SUBSET]; + GEN_TAC; + REWRITE_TAC[mk_segment;closed_ball]; + REP_BASIC_TAC; + UND 7; + DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL); + REWR 5; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[euclid_add_closure;polar_euclid;euclid_scale_closure]; + ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1*y`]; + IMATCH_MP_TAC REAL_PROP_LE_RMUL; + UND 1; + UND 9; + REAL_ARITH_TAC; + (* D-- *) + REP_BASIC_TAC; + IMATCH_MP_TAC mk_segment_hyperplane; + ASM_REWRITE_TAC[]; + (* Tue Aug 17 17:02:28 EDT 2004 *) + + ]);; + (* }}} *) + +let diff_pow1 = prove_by_refinement( + `!t x. (( \ x. (t*x)) diffl t) x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(\ x. (t * x)) = (\x. (t * (\u. (u pow 1)) x))` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + BETA_TAC; + REWRITE_TAC[POW_1]; + DISCH_THEN_REWRITE; + TYPE_THEN `((\x. (t * (\u. (u pow 1)) x)) diffl (t* &1)) x ` SUBGOAL_TAC; + IMATCH_MP_TAC DIFF_CMUL; + TYPEL_THEN[`1`;`x`] (fun t-> ASSUME_TAC (ISPECL t DIFF_POW)); + UND 0; + REWRITE_TAC[ARITH_RULE `1-1 = 0`;pow]; + REDUCE_TAC; + BETA_TAC; + REDUCE_TAC; + ]);; + (* }}} *) + +let pi_bounds = prove_by_refinement( + `&3 < pi /\ pi < &22/ (&7)`, + (* {{{ proof *) + let tpi = recompute_pi 12 in + let t3 = INTERVAL_OF_TERM 12 `&3` in + let t227 = INTERVAL_OF_TERM 12 `&22/(&7)` in + let th1 = INTERVAL_TO_LESS_CONV t3 tpi in + let th2 = INTERVAL_TO_LESS_CONV tpi t227 in + ( + [ + REP_BASIC_TAC; + ASSUME_TAC th2; + ASSUME_TAC th1; + ASM_REWRITE_TAC[]; + ]));; + (* }}} *) + +let sinx_le_x = prove_by_refinement( + `!x. (&0 <=x) ==> (sin x <= x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `x = &0` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SIN_0;]; + REAL_ARITH_TAC; + TYPE_THEN `&0 < x` SUBGOAL_TAC; + UND 0; + UND 1; + REAL_ARITH_TAC; + POP_ASSUM_LIST (fun t-> ALL_TAC); + DISCH_TAC; + (* -- *) + TYPE_THEN `f = ( \ t x. t * x - sin(x))` ABBREV_TAC ; + TYPE_THEN `!t. (&1 < t) ==> (!x. (&0 < x) ==> (&0 < f t x))` SUBGOAL_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + (* --- *) + TYPE_THEN `!x. (f t diffl (t - cos x)) x` SUBGOAL_TAC; + EXPAND_TAC "f"; + GEN_TAC; + IMATCH_MP_TAC DIFF_SUB; + REWRITE_TAC[DIFF_SIN;diff_pow1;]; + DISCH_TAC; + TYPEL_THEN [`f t`;`&0`;`x'`] (fun t-> ANT_TAC (ISPECL t MVT)); + ASM_REWRITE_TAC[]; + CONJ_TAC; + REP_BASIC_TAC; + ASM_MESON_TAC[DIFF_CONT]; + REWRITE_TAC[differentiable]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + UND 6; + TYPE_THEN `f t (&0) = &0` SUBGOAL_TAC; + EXPAND_TAC "f"; + REWRITE_TAC[SIN_0]; + REDUCE_TAC; + DISCH_THEN_REWRITE; + REDUCE_TAC; + DISCH_TAC; + UND 4; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LT_MUL; + ASM_REWRITE_TAC[]; + TSPEC `z` 5; + TYPE_THEN `l = t - cos z` SUBGOAL_TAC; + IMATCH_MP_TAC DIFF_UNIQ; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + UND 3; + MP_TAC COS_BOUNDS; + DISCH_TAC; + TSPEC `z` 3; + REP_BASIC_TAC; + UND 5; + UND 3; + REAL_ARITH_TAC; + (* -- *) + DISCH_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(x < sin x) ==> (sin x <= x)`) ; + DISCH_TAC; + TYPE_THEN `&1 < sin x/x` SUBGOAL_TAC; + ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TSPEC `(sin x)/x` 2; + REWR 2; + TSPEC `x` 2; + REWR 2; + UND 2; + EXPAND_TAC "f"; + (* -- *) + ASM_SIMP_TAC[REAL_DIV_RMUL;REAL_ARITH `&0 < x ==> ~(x = &0)`]; + REDUCE_TAC; + (* Tue Aug 17 19:35:13 EDT 2004 *) + + ]);; + (* }}} *) + +let abssinx_lemma = prove_by_refinement( + `!x. (&0 <= x) ==> ((abs (sin x)) <= abs x)`, + (* {{{ proof *) + [ + GEN_TAC; + REP_BASIC_TAC; + TYPE_THEN `abs x = x` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + TYPE_THEN `x <= pi` ASM_CASES_TAC; + TYPE_THEN `&0 <= sin x` SUBGOAL_TAC; + IMATCH_MP_TAC SIN_POS_PI_LE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `abs (sin x) = sin x` SUBGOAL_TAC; + UND 2; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[sinx_le_x]; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `&1` EXISTS_TAC; + CONJ_TAC; + ASSUME_TAC SIN_BOUNDS; + TSPEC `x` 2; + UND 2; + REAL_ARITH_TAC; + UND 1; + TYPE_THEN `&3 < pi` SUBGOAL_TAC; + REWRITE_TAC[pi_bounds]; + REAL_ARITH_TAC; + (* Tue Aug 17 22:54:49 EDT 2004 *) + + ]);; + (* }}} *) + +let abssinx_le = prove_by_refinement( + `!x. abs (sin x) <= abs x`, + (* {{{ proof *) + [ + GEN_TAC; + TYPE_THEN `(&0 <= x) \/ (&0 <= -- x)` SUBGOAL_TAC; + REAL_ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + ASM_MESON_TAC[abssinx_lemma]; + TYPE_THEN `y = --x` ABBREV_TAC ; + TYPE_THEN `x = --y` SUBGOAL_TAC; + UND 1; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + REWRITE_TAC[SIN_NEG;REAL_ABS_NEG]; + ASM_MESON_TAC[abssinx_lemma]; + (* Tue Aug 17 22:59:20 EDT 2004 *) + + ]);; + (* }}} *) + +let cos_double2 = prove_by_refinement( + `!x. cos (&2 * x) = &1 - &2 * (sin x pow 2)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[COS_DOUBLE;GSYM SIN_CIRCLE ]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let sin_half = prove_by_refinement( + `!x. &2 * (sin (x/(&2)) pow 2) = &1 - cos (x)`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC cos_double2; + TSPEC `x/ &2` 0; + TYPE_THEN `&2 *(x/(&2)) = x` SUBGOAL_TAC; + REWRITE_TAC[REAL_MUL_2;]; + REDUCE_TAC; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let x_diff_y2 = prove_by_refinement( + `!x y. (x - y) pow 2 = x*x - &2*x*y + y*y`, + (* {{{ proof *) + [ + REWRITE_TAC[REAL_POW_2]; + real_poly_tac; + ]);; + (* }}} *) + +let cosdiff2 = prove_by_refinement( + `!x y. (cos x - cos y) pow 2 + (sin x - sin y) pow 2 = + (&2 * sin ((x - y)/(&2))) pow 2`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[POW_MUL]; + TYPE_THEN `!z. &2 pow 2 * z = &2 *(&2 *z)` SUBGOAL_TAC ; + REWRITE_TAC[POW_2]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[sin_half]; + + TYPE_THEN `cos (x - y) = cos (x + (--y))` SUBGOAL_TAC; + AP_TERM_TAC; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[COS_ADD ]; + REWRITE_TAC[SIN_NEG;COS_NEG;REAL_ARITH `x - u*(-- v) = x + u*v`]; + REWRITE_TAC[x_diff_y2]; + REWRITE_TAC[POW_2]; + TYPE_THEN `a = cos x` ABBREV_TAC ; + TYPE_THEN `b = sin x` ABBREV_TAC ; + TYPE_THEN `a' = cos y` ABBREV_TAC ; + TYPE_THEN `b' = sin y` ABBREV_TAC ; + REWRITE_TAC[REAL_ARITH `x*(y-z) = x*y - x*z`]; + TYPE_THEN `&2 * &1 = ((b pow 2) + (a pow 2)) + ((b' pow 2) + (a' pow 2))` SUBGOAL_TAC; + EXPAND_TAC "a"; + EXPAND_TAC "b"; + EXPAND_TAC "a'"; + EXPAND_TAC "b'"; + REWRITE_TAC[SIN_CIRCLE]; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[POW_2]; + real_poly_tac; + (* Tue Aug 17 23:38:27 EDT 2004 *) + + ]);; + (* }}} *) + +let d_euclid_cis = prove_by_refinement( + `!x y. d_euclid (cis x) (cis y) = &2 * (abs (sin ((x-y)/(&2))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[cis;d_euclid_point;cosdiff2;POW_2_SQRT_ABS;ABS_MUL;]; + REWRITE_TAC[REAL_ARITH `abs (&2) = &2`]; + (* Tue Aug 17 23:41:30 EDT 2004 *) + ]);; + (* }}} *) + +let d_euclid_cis_ineq = prove_by_refinement( + `!x y. d_euclid (cis x) (cis y) <= abs (x - y)`, + (* {{{ proof *) + [ + REWRITE_TAC[d_euclid_cis]; + REP_GEN_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `&2 * (abs ((x-y)/(&2)))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`;abssinx_le]; + REWRITE_TAC[REAL_ARITH `!z. &2*(abs z) = abs (&2 *z)`]; + TYPE_THEN `&2 * ((x - y)/(&2)) = (x - y)` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REAL_ARITH_TAC; + (* Wed Aug 18 06:42:28 EDT 2004 *) + + ]);; + (* }}} *) + +let polar_fg_inj = prove_by_refinement( + `!f g p. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\ + (!x. (&0 <= x /\ x <= &1) ==> (&0 <= f x)) /\ (euclid 2 p) ==> + INJ (\t. p + (f t)*# (cis (g t))) {x | &0 <= x /\ x <= &1} (euclid 2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[INJ;polar_euclid]; + ASM_SIMP_TAC[euclid_add_closure;polar_euclid]; + REP_BASIC_TAC; + (* INSERT *) + TYPE_THEN `(f x *# cis (g x)) = (f y *# cis (g y))` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + USE 3 (REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x'` 3; + USE 3(REWRITE_RULE[euclid_plus]); + UND 3; + REAL_ARITH_TAC; + KILL 3; + DISCH_TAC; + (* end ins *) + USE 3 (AP_TERM `norm2`); + USE 3 (REWRITE_RULE[norm2_scale_cis]); + TYPE_THEN `&0 <= f x /\ &0 <= f y` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[GSYM REAL_ABS_REFL]); + REWR 3; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + + ]);; + (* }}} *) + +let polar_distinct = prove_by_refinement( + `!f g g'. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\ + (!x. (&0 <= x /\ x <= &1) ==> (&0 < f x)) /\ + (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g x /\ g x < &2 * pi)) /\ + (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g' x /\ g' x < &2 * pi)) + ==> + (!x y. (&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 /\ + ((f x)*# (cis (g x)) = (f y)*# (cis (g' y)))) ==> + (x = y) /\ (g x = g' y)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + COPY 0; + USE 0 (AP_TERM `norm2`); + USE 0 (REWRITE_RULE[norm2_scale_cis]); + TYPE_THEN `&0 < f x /\ &0 < f y` SUBGOAL_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `f x = f y` SUBGOAL_TAC; + UND 0; + UND 10; + UND 11; + REAL_ARITH_TAC; + DISCH_TAC; + (* -- *) + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE [INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + TYPEL_THEN [`g y`;`g' y`;`f y`;`f y`] (fun t-> ANT_TAC (ISPECL t polar_inj)); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_ARITH `&0 < t ==> &0 <= t`]; + DISCH_THEN DISJ_CASES_TAC; + PROOF_BY_CONTR_TAC; + REP_BASIC_TAC; + UND 13; + UND 10; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + (* Wed Aug 18 07:42:54 EDT 2004 *) + + ]);; + (* }}} *) + +let d_euclid_eq_arg = prove_by_refinement( + `!r r' x. (d_euclid (r *# (cis x)) (r' *# (cis x)) = abs (r - r'))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[cis;point_scale;d_euclid_point]; + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB;POW_MUL;GSYM REAL_ADD_LDISTRIB]; + ONCE_REWRITE_TAC [REAL_ARITH `x + y = y + x`]; + REWRITE_TAC[SIN_CIRCLE]; + REDUCE_TAC; + REWRITE_TAC[POW_2_SQRT_ABS]; + (* Wed Aug 18 08:15:39 EDT 2004 *) + ]);; + (* }}} *) + +(* not used *) +let one_over_plus1 = prove_by_refinement( + `!t. (&0 <= t) ==> (t / (&1 + t) <= &1)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC REAL_LE_LDIV; + UND 0; + REAL_ARITH_TAC; + (* Wed Aug 18 08:17:46 EDT 2004 *) + + ]);; + (* }}} *) + +let polar_cont = prove_by_refinement( + `!p f g. continuous f (top_of_metric(UNIV,d_real)) + (top_of_metric(UNIV,d_real)) /\ + continuous g (top_of_metric(UNIV,d_real)) + (top_of_metric(UNIV,d_real)) /\ (euclid 2 p) ==> + continuous (\t. p + (f t) *# cis(g t)) (top_of_metric(UNIV,d_real)) + (top2)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + DISCH_TAC; + TYPE_THEN `IMAGE (\t. p + (f t) *# cis(g t)) UNIV SUBSET (euclid 2)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IMAGE ]; + ASM_MESON_TAC[euclid_add_closure;polar_euclid]; + REWRITE_TAC[top2]; + UND 0; + ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_euclid;metric_real]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + REP_BASIC_TAC; + RIGHT_TAC "delta"; + DISCH_TAC; + TYPEL_THEN [`x`;`epsilon/(&2)`] (USE 3 o ISPECL); + TYPEL_THEN [`x`;`(&1/(&1 + abs (f x)))*(epsilon/(&2))`] (USE 2 o ISPECL); + REP_BASIC_TAC; + TYPE_THEN `&0 < epsilon/(&2)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + DISCH_TAC; + TYPE_THEN `&0 < &1 / (&1 + abs (f x)) * epsilon / &2` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LT_DIV; + REAL_ARITH_TAC; + DISCH_TAC; + REWR 3; + REWR 2; + REP_BASIC_TAC; + TYPE_THEN `min_real delta delta'` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[min_real]; + UND 3; + UND 8; + COND_CASES_TAC; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + REP_BASIC_TAC; + TYPE_THEN `d_real x y < delta /\ d_real x y < delta'` SUBGOAL_TAC ; + UND 9; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + UND 9; + REAL_ARITH_TAC; + UND 9; + REAL_ARITH_TAC; + REP_BASIC_TAC; + TSPEC `y` 2; + TSPEC `y` 7; + REWR 2; + REWR 7; + (* A-- *) + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `d_euclid (p + f x *# cis(g x)) (p + f x *# cis(g y)) + d_euclid (p + f x *# cis(g y)) (p + f y *# cis(g y))` EXISTS_TAC; + TYPE_THEN `!z r x r' x'. d_euclid (p + r *# (cis x)) (p + r' *# (cis x')) = d_euclid (r*# (cis x)) (r' *# (cis x'))` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC metric_translate_LEFT; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + (* end of add-on *) + CONJ_TAC; + IMATCH_MP_TAC metric_space_triangle; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_SIMP_TAC[polar_euclid;metric_euclid]; + REWRITE_TAC[d_euclid_eq_arg]; + TYPEL_THEN[`2`;`f x`;`cis (g x)`;`cis (g y)`] (fun t-> ANT_TAC (ISPECL t norm_scale_vec)); + REWRITE_TAC[cis;euclid_point]; + DISCH_THEN_REWRITE; + TYPE_THEN `!x y z. (x <= z/ &2 /\ y < z/ &2 ==> x + y < z/ &2 + z/ &2)` SUBGOAL_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_HALF_DOUBLE]; + DISCH_THEN IMATCH_MP_TAC ; + USE 2 (REWRITE_RULE[d_real]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `abs (f x) * (&1 / (&1 + abs (f x)) * epsilon / &2)` EXISTS_TAC; + (* B-- *) + CONJ_TAC; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + REWRITE_TAC[REAL_MK_NN_ABS]; + IMATCH_MP_TAC (REAL_ARITH `!y. (x <= y /\ y < z) ==> (x <= z)`); + TYPE_THEN `abs (g x - g y)` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[d_euclid_cis_ineq]; + USE 7 (REWRITE_RULE[d_real]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `(x*y*z <= z) <=> ((x*y)*(z) <= &1 * (z))`]; + IMATCH_MP_TAC REAL_PROP_LE_RMUL; + CONJ_TAC; + REWRITE_TAC[real_div]; + REDUCE_TAC; + REWRITE_TAC[GSYM real_div]; + IMATCH_MP_TAC REAL_LE_LDIV; + REAL_ARITH_TAC; + UND 5; + REAL_ARITH_TAC; + + ]);; + (* }}} *) + +let lc_bounds = prove_by_refinement( + `!a b x. (&0 <= x /\ x <= &1) ==> (min_real a b <= x*a + (&1- x)*b) /\ + (x*a + (&1 - x)*b <= max_real a b)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + CONJ_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + ineq_le_tac `a + (&1 - x)*(b - a) = (x*a + (&1- x)*b)`; + ineq_le_tac `b + x*(a - b) = x*a + (&1- x)*b`; + REWRITE_TAC[max_real]; + COND_CASES_TAC; + ineq_le_tac `(x*a + (&1 - x)*b) + (&1 - x)*(a - b) = a`; + ineq_le_tac `(x*a + (&1 - x)*b) + (x*(b - a)) = b`; + (* Wed Aug 18 11:52:54 EDT 2004 *) + + ]);; + (* }}} *) + +let min_real_symm = prove_by_refinement( + `!a b. min_real a b = min_real b a`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`)); + ASM_REWRITE_TAC[]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let max_real_symm = prove_by_refinement( + `!a b. max_real a b = max_real b a`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[max_real]; + COND_CASES_TAC; + USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`)); + ASM_REWRITE_TAC[]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let curve_annulus_lemma = prove_by_refinement( + `!r g p. (&0 < r) /\ (euclid 2 p) ==> + (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t))) + {x | &0 <= x /\ x <= &1}) + SUBSET ({ x | (r/(&2) <= d_euclid p x /\ + d_euclid p x <= r)} )`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + REP_BASIC_TAC; + UND 2; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC; + IMATCH_MP_TAC d_euclidpq; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM norm2;norm2_scale_cis]; + TYPE_THEN `r/(&2) < r` SUBGOAL_TAC; + ASM_MESON_TAC[half_pos]; + DISCH_TAC; + TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC; + REWRITE_TAC[min_real;max_real]; + ASM_REWRITE_TAC[]; + COND_CASES_TAC; + UND 2; + UND 5; + REAL_ARITH_TAC; + REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ; + CONJ_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `&0 < x ==> &0 <= x`); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + ONCE_REWRITE_TAC [min_real_symm]; + ASM_MESON_TAC[lc_bounds]; + REWRITE_TAC[GSYM ABS_REFL]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[lc_bounds;min_real_symm;max_real_symm]; + (* Wed Aug 18 12:13:50 EDT 2004 *) + + ]);; + + (* }}} *) + +let curve_circle_lemma = prove_by_refinement( + `!r g p. (&0 < r) /\ (euclid 2 p) ==> + (((IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t))) + {x | &0 <= x /\ x <= &1}) + INTER ({ x | d_euclid p x <= (r/(&2))})) = + { ( p + (r/(&2)) *# (cis (g (&0) ))) }) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[IMAGE;SUBSET;INTER;]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + GEN_TAC; + (* A *) + EQ_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + REP_BASIC_TAC; + CONJ_TAC; + TYPE_THEN `&0` EXISTS_TAC; + REDUCE_TAC; + TYPEL_THEN [`2`;`p`;`(r / &2 *# cis (g (&0)))`] (fun t-> ANT_TAC (ISPECL t d_euclidpq)); + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM norm2;norm2_scale_cis;]; + IMATCH_MP_TAC (REAL_ARITH `(x = y) ==> (x <= y)`); + REWRITE_TAC[ABS_REFL]; + IMATCH_MP_TAC (REAL_ARITH `(&0 < x) ==> (&0 <= x)`); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + REP_BASIC_TAC; + (* B other direction *) + UND 3; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + PROOF_BY_CONTR_TAC; + UND 2; + TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC; + IMATCH_MP_TAC d_euclidpq; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM norm2;norm2_scale_cis]; + TYPE_THEN `r/(&2) < r` SUBGOAL_TAC; + ASM_MESON_TAC[half_pos]; + DISCH_TAC; + TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC; + REWRITE_TAC[min_real;max_real]; + ASM_REWRITE_TAC[]; + COND_CASES_TAC; + UND 2; + UND 6; + REAL_ARITH_TAC; + REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ; + CONJ_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `&0 < x ==> &0 <= x`); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + ONCE_REWRITE_TAC [min_real_symm]; + ASM_MESON_TAC[lc_bounds]; + REWRITE_TAC[GSYM ABS_REFL]; + DISCH_THEN_REWRITE; + TYPE_THEN `~(x' = &0)` SUBGOAL_TAC; + DISCH_TAC; + UND 7; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + UND 3; + REDUCE_TAC; + DISCH_TAC; + TYPE_THEN `&0 < x'` SUBGOAL_TAC; + UND 7; + UND 5; + REAL_ARITH_TAC; + DISCH_TAC; + IMATCH_MP_TAC (REAL_ARITH `a < b ==> ~(b <= a)`); + ineq_lt_tac `(r/ &2) + x'* (r - (r/(&2))) = (x' * r + (&1 - x') * r / &2)`; + (* Wed Aug 18 12:41:16 EDT 2004 *) + + ]);; + (* }}} *) + +let curve_simple_lemma = prove_by_refinement( + `!r g p. (&0 < r) /\ (euclid 2 p) /\ + (continuous g (top_of_metric(UNIV,d_real)) + (top_of_metric(UNIV,d_real))) ==> + (simple_arc_end + (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t))) + {x | &0 <= x /\ x <= &1}) (p + (r/(&2))*# (cis (g (&0)))) + (p + (r)*# (cis (g (&1)))))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + REP_BASIC_TAC; + TYPE_THEN `(\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + CONJ_TAC; + IMATCH_MP_TAC polar_cont; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV]; + REWRITE_TAC[linear_cont]; + IMATCH_MP_TAC polar_fg_inj; + ASM_REWRITE_TAC[INJ;SUBSET_UNIV ]; + (* -- *) + CONJ_TAC; + REP_BASIC_TAC; + USE 3 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]); + TYPE_THEN `(x * r + (&1 - x) * r / &2) - (y * r + (&1 - y) * r / &2) = (x - y)*(r - r/(&2)) ` SUBGOAL_TAC; + real_poly_tac; + DISCH_TAC; + REWR 3; + USE 3(REWRITE_RULE[REAL_ENTIRE]); + UND 3; + DISCH_THEN DISJ_CASES_TAC; + UND 3; + REAL_ARITH_TAC; + PROOF_BY_CONTR_TAC; + UND 3; + TYPE_THEN `r - r/(&2) = (r/ &2 + r/ &2) - r/ &2` SUBGOAL_TAC; + REWRITE_TAC[REAL_HALF_DOUBLE]; + DISCH_THEN_REWRITE; + REWRITE_TAC[REAL_ARITH `(x + x) - x = x`]; + USE 2 (ONCE_REWRITE_RULE [GSYM REAL_HALF_DOUBLE]); + USE 2 (REWRITE_RULE[REAL_DIV_LZERO]); + UND 2; + REAL_ARITH_TAC; + (* -- *) + GEN_TAC; + DISCH_TAC; + WITH 3 (MATCH_MP lc_bounds); + TYPEL_THEN [`r`;`r/ &2`] (USE 4 o ISPECL); + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `min_real r (r/ &2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `r / &2 < r` SUBGOAL_TAC; + UND 2; + MESON_TAC [half_pos]; + TYPE_THEN `&0 < r/ (&2)` SUBGOAL_TAC; + ASM_MESON_TAC[half_pos]; + TYPE_THEN `a = r/ &2` ABBREV_TAC ; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + (* Wed Aug 18 14:02:54 EDT 2004 *) + + ]);; + (* }}} *) + +let segpath = jordan_def + `segpath x y t = t* x + (&1 - t)*y` ;; + +let segpathxy = prove_by_refinement( + `!x y. segpath x y = (\ t. t*x + (&1 - t)*y)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[segpath]; + ]);; + (* }}} *) + +let segpath_lemma = prove_by_refinement( + `(!x y . (continuous (segpath x y) (top_of_metric(UNIV,d_real)) + (top_of_metric(UNIV,d_real)))) /\ + (!x y b. (&0 <= x /\ x < b /\ &0 <= y /\ y < b ==> + (!t. &0 <= t /\ t <= &1 ==> &0 <= segpath x y t /\ + segpath x y t < b))) /\ + (!x y x' y' t. (x < x' /\ y < y' /\ &0 <= t /\ t <= &1) + ==> ~(segpath x y t = segpath x' y' t))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + CONJ_TAC; + REP_BASIC_TAC; + ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_real]; + REWRITE_TAC[segpathxy;linear_cont]; + (* -- *) + CONJ_TAC; + REP_BASIC_TAC; + REWRITE_TAC[segpath]; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `min_real x y` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[lc_bounds]; + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `max_real x y` EXISTS_TAC; + CONJ_TAC; + ASM_MESON_TAC[lc_bounds]; + REWRITE_TAC[max_real]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[segpath]; + REP_BASIC_TAC; + UND 0; + REWRITE_TAC[REAL_ARITH `(u + v = u' + v') <=> ((u' - u) + (v' - v) = &0)`]; + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB]; + TYPE_THEN `t = &0` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + UND 3; + REAL_ARITH_TAC; + TYPE_THEN `t = &1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + UND 4; + REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `&0 < t * (x' - x) + (&1 - t)*(y' - y)` SUBGOAL_TAC; + ineq_lt_tac `&0 + t * (x' - x) + (&1 - t)*(y' - y) = (t*(x' - x) + (&1- t)*(y' - y))` ; + UND 5; + UND 1; + REAL_ARITH_TAC; + REAL_ARITH_TAC; + (* Wed Aug 18 14:48:37 EDT 2004 *) + + ]);; + + (* }}} *) + +let segpath_end = prove_by_refinement( + `!x y. ( segpath x y (&0) = y) /\ (segpath x y (&1) = x)`, + (* {{{ proof *) + [ + REWRITE_TAC[segpath]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let segpath_inj = prove_by_refinement( + `!x y. ~(x = y) ==> INJ (segpath x y) {t | &0 <= t /\ t <= &1} UNIV`, + (* {{{ proof *) + + [ + REWRITE_TAC[segpath;INJ;SUBSET_UNIV]; + REP_BASIC_TAC; + USE 0 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]); + TYPE_THEN `(x' * x + (&1 - x') * y) - (y' * x + (&1 - y') * y) = (x' - y')*(x - y) ` SUBGOAL_TAC; + real_poly_tac; + DISCH_TAC; + REWR 0; + USE 0(REWRITE_RULE[REAL_ENTIRE]); + UND 0; + DISCH_THEN DISJ_CASES_TAC; + UND 0; + REAL_ARITH_TAC; + PROOF_BY_CONTR_TAC; + UND 0; + UND 5; + REAL_ARITH_TAC; + (* Wed Aug 18 15:15:11 EDT 2004 *) + + ]);; + + (* }}} *) + +let degree_vertex_annulus = prove_by_refinement( + `!n r p xx zz. (&0 < r) /\ (euclid 2 p) /\ + (!j. j < n ==> (&0 <= xx j /\ xx j < &2 * pi)) /\ + (!j. j < n ==> (&0 <= zz j /\ zz j < &2 * pi)) /\ + (!i j. (i < j) /\ (j <| n) ==> (xx i < xx j)) /\ + (!i j. (i < j) /\ (j < n) ==> (zz i < zz j)) ==> + (?C. + (!i. (i < n) ==> + simple_arc_end (C i ) (p + (r/ &2)*# (cis(zz i))) + (p + r*# (cis(xx i)))) /\ + (!i j. (i < n) /\ (j < n) /\ (~(i=j)) ==> + (C i INTER C j = EMPTY )) /\ + (!i. (i< n) ==> + C i SUBSET ({ x | (r/(&2) <= d_euclid p x /\ + d_euclid p x <= r)} )) /\ + (!i. (i< n) ==> + (C i INTER ({ x | d_euclid p x <= (r/(&2))}) = + { ( p + (r/(&2)) *# (cis (zz i ))) })) + ) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `C = ( \ i. IMAGE ( \ t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (segpath (xx i) (zz i) t))) {t | &0 <= t /\ t <= &1})` ABBREV_TAC ; + TYPE_THEN `C` EXISTS_TAC; + (* -- *) + CONJ_TAC; + REP_BASIC_TAC; + EXPAND_TAC "C"; + TYPEL_THEN [`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> (ANT_TAC(ISPECL t curve_simple_lemma))); + ASM_REWRITE_TAC[segpath_lemma]; + REWRITE_TAC[segpath_end]; + (* -- *) + TYPE_THEN `&0 < r/ &2 /\ r / &2 < r` SUBGOAL_TAC; + IMATCH_MP_TAC half_pos; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; + REP_BASIC_TAC; + TYPEL_THEN [`( \ t. t * r + (&1 - t) * r / &2)`;`segpath (xx i) (zz i)`;`segpath (xx j) (zz j)`] (fun t-> ANT_TAC (ISPECL t polar_distinct)); + ASM_REWRITE_TAC[]; + (* --- *) + CONJ_TAC; + TYPEL_THEN [`r`;`r / &2`] (fun t-> ANT_TAC(ISPECL t segpath_inj)); + UND 10; + REAL_ARITH_TAC; + REWRITE_TAC[segpathxy]; + (* --- *) + CONJ_TAC; + REP_BASIC_TAC; + ineq_lt_tac `&0 + (x* (r - r/(&2))) + (r/ &2) = x*r + (&1 - x)*(r/ &2)`; + (* --- *) + ASM_MESON_TAC[segpath_lemma]; + (* -- *) + DISCH_TAC; + EXPAND_TAC "C"; + REWRITE_TAC[EQ_EMPTY]; + GEN_TAC; + REWRITE_TAC[IMAGE;INTER]; + REP_BASIC_TAC; + UND 13; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t])); + TYPEL_THEN[`x'`;`x''`] (USE 12 o ISPECL); + REWR 12; + TYPE_THEN `((x'' * r + (&1 - x'') * r / &2) *# cis (segpath (xx j) (zz j) x'')) = ((x' * r + (&1 - x') * r / &2) *# cis (segpath (xx i) (zz i) x'))` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + USE 16 ( (REWRITE_RULE[FUN_EQ_THM])); + TSPEC `x'''` 13; + UND 13; + REWRITE_TAC[euclid_plus]; + REAL_ARITH_TAC; + DISCH_TAC; + KILL 16; + USE 13 (ONCE_REWRITE_RULE [EQ_SYM_EQ]); + REWR 12; + REP_BASIC_TAC; + USE 16 GSYM; + UND 16; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t])); + TYPE_THEN `(i <| j) \/ (j < i)` SUBGOAL_TAC; + UND 7; + ARITH_TAC; + (* ---- *) + DISCH_THEN DISJ_CASES_TAC; + TYPEL_THEN [`i`;`j`] (USE 0 o ISPECL); + TYPEL_THEN [`i`;`j`] (USE 1 o ISPECL); + KILL 2; + KILL 3; + KILL 6; + KILL 13; + ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)]; + TYPEL_THEN [`j`;`i`] (USE 0 o ISPECL); + TYPEL_THEN [`j`;`i`] (USE 1 o ISPECL); + KILL 2; + KILL 3; + KILL 6; + KILL 13; + ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)]; + (* B-- *) + CONJ_TAC; + REP_BASIC_TAC; + EXPAND_TAC "C"; + IMATCH_MP_TAC curve_annulus_lemma; + ASM_REWRITE_TAC[]; + (* -- *) + REP_BASIC_TAC; + EXPAND_TAC "C"; + TYPEL_THEN[`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> ANT_TAC(ISPECL t curve_circle_lemma)); + ASM_REWRITE_TAC[]; + REWRITE_TAC[segpath_end]; + (* Wed Aug 18 15:57:53 EDT 2004 *) + ]);; + (* }}} *) + +let closed_ball2_center = prove_by_refinement( + `!p r. closed_ball (euclid 2,d_euclid) p r p <=> (euclid 2 p) /\ (&0 <= r)`, + (* {{{ proof *) + [ + REWRITE_TAC[closed_ball]; + TYPE_THEN `!p. (euclid 2 p) ==> (d_euclid p p = &0)` SUBGOAL_TAC; + DISCH_ALL_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let degree_vertex_disk = prove_by_refinement( + `!r p xx . (&0 < r) /\ (euclid 2 p) /\ + (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\ + (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j)) + ==> + (?C. + (!i. (i< 4) ==> (?C' C'' v. + simple_arc_end C' p v /\ + simple_arc_end C'' v (p + r*# (cis(xx i ))) /\ + C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\ + (C' INTER C'' = {v}) /\ + (C' UNION C'' = C i )) /\ + simple_arc_end (C i ) p (p + r*# (cis(xx i))) /\ + C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\ + C i INTER (closed_ball(euclid 2,d_euclid) p (r / &2)) + SUBSET (hyperplane 2 e2 (p 1) UNION + hyperplane 2 e1 (p 0))) /\ + (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==> + (C i INTER C j = {p} ))) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(&0 < (r /(&2))) /\ (euclid 2 p)` SUBGOAL_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree4_vertex_hv t)); + REP_BASIC_TAC; + TYPE_THEN `C' = C` ABBREV_TAC ; + KILL 10; + TYPE_THEN `zz = (\j. (&j) * pi/(&2))` ABBREV_TAC ; + TYPE_THEN `(&0 < r) /\ (euclid 2 p) /\ (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\ (!j. j < 4 ==> (&0 <= zz j /\ zz j < &2 * pi)) /\ (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j)) /\ (!i j. (i < j) /\ (j < 4) ==> (zz i < zz j))` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + EXPAND_TAC "zz"; + REP_BASIC_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + CONJ_TAC; + REDUCE_TAC; + IMATCH_MP_TAC REAL_LE_DIV; + MP_TAC PI_POS; + REAL_ARITH_TAC; + REWRITE_TAC[real_div;REAL_ARITH `pi*x = x*pi`]; + REWRITE_TAC[REAL_ARITH `x*y*z = (x*y)*z`]; + IMATCH_MP_TAC REAL_PROP_LT_RMUL; + ASM_REWRITE_TAC[PI_POS;GSYM real_div;]; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ;REAL_ARITH `&0 < &2`]; + REDUCE_TAC; + UND 11; + ARITH_TAC; + REP_BASIC_TAC; + EXPAND_TAC "zz"; + ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> (&0 < y - x)`]; + REWRITE_TAC[REAL_ARITH `x*y - z*y = (x - z)*y`]; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + REWRITE_TAC[PI2_BOUNDS]; + REDUCE_TAC; + UND 12; + REWRITE_TAC[REAL_ARITH `&0 < &j - &i <=> &i < &j`]; + REDUCE_TAC; + DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree_vertex_annulus t)); + REP_BASIC_TAC; + (* A *) + TYPE_THEN `(\j. C' j UNION C'' j)` EXISTS_TAC; + BETA_TAC; + (* B 1st conjunct *) + TYPE_THEN `!i. (i<| 4) ==> (simple_arc_end (C' i ) p (p + ((r/ &2) *# (cis (&i * pi/(&2))))) /\ simple_arc_end (C'' i) (p + ((r/ &2) *# (cis (&i * pi/(&2))))) (euclid_plus p (r *# cis (xx i))) /\ (C' i) SUBSET closed_ball (euclid 2,d_euclid) p (r / &2) /\ ((C' i) INTER (C'' i) = {(p + ((r/ &2) *# (cis (&i * pi/(&2)))))})) ` SUBGOAL_TAC; + REP_BASIC_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INR IN_SING;INTER ]; + EQ_TAC; + DISCH_TAC; + TYPE_THEN `closed_ball (euclid 2,d_euclid) p (r / &2) x` SUBGOAL_TAC; + UND 18; + REWRITE_TAC[SUBSET]; + UND 19; + MESON_TAC[]; + TSPEC `i` 11; + REWR 11; + REWRITE_TAC[closed_ball]; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`)); + UND 19; + REWRITE_TAC[INTER;INR IN_SING;]; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + EXPAND_TAC "zz"; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + UND 17; + UND 16; + MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* [C] 1nd conjunct. simple-arc-end; *) + TYPE_THEN `D = closed_ball (euclid 2,d_euclid) p (r /(&2))` ABBREV_TAC ; + TYPE_THEN `!i x. (i <| 4) /\ (D x) ==> ((C' i UNION C'' i) x = C' i x)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[UNION]; + IMATCH_MP_TAC (TAUT `(b ==> a) ==> (a \/ b <=> a)`); + TSPEC `i` 11; + REWR 11; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`)); + UND 17; + EXPAND_TAC"D"; + REWRITE_TAC[closed_ball]; + REWRITE_TAC[INTER;INR IN_SING]; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[simple_arc_end_end2]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!i x. (i <| 4) /\ ~(D x) ==> ((C' i UNION C'' i) x = C'' i x)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[UNION]; + IMATCH_MP_TAC (TAUT `(a ==> b) ==> (a \/ b <=> b)`); + TSPEC `i` 5; + REWR 5; + USE 5 (REWRITE_RULE[SUBSET]); + TSPEC `x` 5; + UND 5; + UND 18; + MESON_TAC[]; + DISCH_TAC; + ONCE_REWRITE_TAC [TAUT `(x /\ y) <=> (y /\ x)`]; + (* D-- *) + CONJ_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER;INR IN_SING]; + TYPE_THEN `D x` ASM_CASES_TAC; + TYPEL_THEN [`i`;`x`] (WITH 17 o ISPECL); + TYPEL_THEN [`j`;`x`] (WITH 17 o ISPECL); + UND 23; + UND 24; + KILL 17; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + TYPEL_THEN [`i`;`j`;] (USE 7 o ISPECL); + REWR 7; + FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`)); + REWRITE_TAC[INTER;INR IN_SING]; + (* --2-- *) + TYPEL_THEN [`i`;`x`] (WITH 18 o ISPECL); + TYPEL_THEN [`j`;`x`] (WITH 18 o ISPECL); + UND 23; + UND 24; + KILL 18; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + TYPEL_THEN [`i`;`j`;] (USE 13 o ISPECL); + REWR 13; + USE 13 (REWRITE_RULE[EQ_EMPTY;INTER ]); + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USE 18(REWRITE_RULE[]); + UND 18; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t])); + UND 22; + REWRITE_TAC[]; + EXPAND_TAC "D"; + REWRITE_TAC[closed_ball2_center]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `&0 &0 <= x`); + ASM_REWRITE_TAC[REAL_LT_HALF1]; + (* E *) + REP_BASIC_TAC; + CONJ_TAC; + TYPE_THEN `C' i` EXISTS_TAC; + TYPE_THEN `C'' i` EXISTS_TAC; + TYPE_THEN `p + (r / &2 *# cis (&i * pi / &2))` EXISTS_TAC; + ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_trans; + ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[union_subset]; + CONJ_TAC; + TSPEC `i` 5; + UND 5; + ASM_REWRITE_TAC[]; + EXPAND_TAC "D"; + REWRITE_TAC[SUBSET;closed_ball;]; + TYPE_THEN `r / &2 < r` SUBGOAL_TAC; + UND 3; + MESON_TAC[half_pos]; + MESON_TAC[REAL_ARITH `(x <= y) /\ (y < z) ==> (x <= z)`]; + TSPEC `i` 12; + UND 12; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;closed_ball]; + ASM_REWRITE_TAC[]; + TSPEC `i` 14; + REWR 12; + TYPE_THEN `C'' i SUBSET (euclid 2)` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + UND 12; + MESON_TAC[]; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + (* -- *) + KILL 15; + KILL 9; + KILL 8; + KILL 11; + KILL 12; + TYPE_THEN `(C' i UNION C'' i) INTER D = (C' i INTER D)` SUBGOAL_TAC; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + UND 17; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TSPEC `i` 4; + REWR 4; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C' i` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER;SUBSET]; + MESON_TAC[]; + (* Thu Aug 19 07:36:47 EDT 2004 *) + + ]);; + (* }}} *) + +let euclid_cancel1 = prove_by_refinement( + `!x y z. (x = euclid_plus y z) <=> (x - y = z)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + EQ_TAC; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[euclid_plus;euclid_minus]; + REAL_ARITH_TAC; + DISCH_TAC; + USE 0 SYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[euclid_plus;euclid_minus]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let infinite_subset = prove_by_refinement( + `!(X:A->bool) Y. INFINITE X /\ X SUBSET Y ==> INFINITE Y`, + (* {{{ proof *) + [ + REWRITE_TAC[INFINITE]; + MESON_TAC[FINITE_SUBSET]; + ]);; + (* }}} *) + +let EXPinj = prove_by_refinement( + `!x y n. (1 < n) /\ (n **| x = n **| y) ==> (x = y)`, + (* {{{ proof *) + [ + TYPE_THEN `! x y n. (x <| y) /\ (n **| x = n **| y) ==> ~(1 <| n)` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `n **| y <= n **| x` SUBGOAL_TAC; + UND 1; + ARITH_TAC; + REWRITE_TAC[LE_EXP]; + TYPE_THEN `~(n = 0)` SUBGOAL_TAC; + UND 0; + ARITH_TAC; + DISCH_THEN_REWRITE; + REWRITE_TAC[DE_MORGAN_THM]; + CONJ_TAC; + UND 0; + ARITH_TAC; + UND 2; + ARITH_TAC; + DISCH_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `x < y \/ y <| x` SUBGOAL_TAC; + UND 3; + ARITH_TAC; + DISCH_THEN DISJ_CASES_TAC; + TYPEL_THEN[`x`;`y`;`n`] (USE 0 o ISPECL); + ASM_MESON_TAC[]; + TYPEL_THEN[`y`;`x`;`n`] (USE 0 o ISPECL); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let infinite_interval = prove_by_refinement( + `!a b. a < b ==> (INFINITE {x | a < x /\ x < b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC infinite_subset; + TYPE_THEN `f = (\ n. a + (b-a)/((&2) pow (SUC n)))` ABBREV_TAC ; + TYPE_THEN `IMAGE f UNIV` EXISTS_TAC ; + CONJ_TAC; + TYPE_THEN `(! x y. (f x = f y) ==> (x = y))` SUBGOAL_TAC; + EXPAND_TAC "f"; + REP_BASIC_TAC; + USE 2 (REWRITE_RULE[REAL_ARITH `(a + d = a + d') <=> (d = d')`;real_div;REAL_PROP_EQ_RMUL_';]); + TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC; + UND 0; + REAL_ARITH_TAC; + DISCH_TAC; + REWR 2; + USE 2 (REWRITE_RULE[GSYM REAL_EQ_INV]); + UND 2; + REDUCE_TAC; + DISCH_TAC; + ONCE_REWRITE_TAC[GSYM SUC_INJ]; + IMATCH_MP_TAC EXPinj; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + DISCH_TAC; + TYPE_THEN `INFINITE (UNIV:num->bool) ==> INFINITE (IMAGE f UNIV)` SUBGOAL_TAC; + ASM_MESON_TAC[INFINITE_IMAGE_INJ]; + REWRITE_TAC[num_INFINITE]; + (* -- *) + REWRITE_TAC[IMAGE;SUBSET]; + GEN_TAC; + REP_BASIC_TAC; + UND 2; + DISCH_THEN_REWRITE; + EXPAND_TAC "f"; + CONJ_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `a < a + x <=> &0 < x`]; + REWRITE_TAC[real_div]; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + CONJ_TAC; + UND 0; + REAL_ARITH_TAC; + IMATCH_MP_TAC REAL_PROP_POS_INV; + REDUCE_TAC; + ARITH_TAC; + ONCE_REWRITE_TAC [REAL_ARITH `a + x < b <=> x < (b - a)*(&1)`]; + REWRITE_TAC[real_div]; + IMATCH_MP_TAC REAL_PROP_LT_LMUL; + CONJ_TAC; + UND 0; + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[GSYM REAL_INV_1]; + IMATCH_MP_TAC REAL_LT_INV2; + REDUCE_TAC; + IMATCH_MP_TAC exp_gt1; + ARITH_TAC; + (* Thu Aug 19 14:59:58 EDT 2004 *) + ]);; + (* }}} *) + +let finite_augment1 = prove_by_refinement( + `!n (X:A->bool) . (INFINITE X) ==> (?Z. Z SUBSET X /\ Z HAS_SIZE n)`, + (* {{{ proof *) + [ + INDUCT_TAC; + REP_BASIC_TAC; + TYPE_THEN `EMPTY:A->bool` EXISTS_TAC ; + REWRITE_TAC[HAS_SIZE_0]; + REP_BASIC_TAC; + TSPEC `X` 0; + REWR 0; + REP_BASIC_TAC; + TYPE_THEN `INFINITE (X DIFF Z)` SUBGOAL_TAC; + IMATCH_MP_TAC INFINITE_DIFF_FINITE; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[HAS_SIZE]; + DISCH_TAC; + USE 3 (MATCH_MP INFINITE_NONEMPTY); + USE 3 (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + TYPE_THEN `u INSERT Z` EXISTS_TAC; + CONJ_TAC; + UND 2; + UND 3; + REWRITE_TAC[DIFF;SUBSET;INSERT]; + ASM_MESON_TAC[]; + (* -- *) + USE 0 (REWRITE_RULE[HAS_SIZE]); + ASM_SIMP_TAC [HAS_SIZE;FINITE_INSERT;CARD_CLAUSES;]; + UND 3; + REWRITE_TAC[DIFF]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let finite_augment = prove_by_refinement( + `!(X:A->bool) Y n m . (n <= m) /\ (X HAS_SIZE n) /\ (INFINITE Y) /\ + (X SUBSET Y) ==> (?Z. (X SUBSET Z /\ Z SUBSET Y /\ Z HAS_SIZE m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `INFINITE (Y DIFF X)` SUBGOAL_TAC; + IMATCH_MP_TAC INFINITE_DIFF_FINITE; + ASM_MESON_TAC[HAS_SIZE]; + DISCH_TAC; + USE 4(MATCH_MP finite_augment1); + USE 3(REWRITE_RULE[LE_EXISTS]); + REP_BASIC_TAC; + TSPEC `d` 4; + REP_BASIC_TAC; + TYPE_THEN `X UNION Z` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + REWRITE_TAC[union_subset]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 5; + SET_TAC[SUBSET;DIFF]; + REWRITE_TAC[HAS_SIZE]; + CONJ_TAC; + ASM_REWRITE_TAC[FINITE_UNION]; + ASM_MESON_TAC[HAS_SIZE]; + RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); + REP_BASIC_TAC; + EXPAND_TAC "d"; + EXPAND_TAC "n"; + IMATCH_MP_TAC CARD_UNION; + ASM_REWRITE_TAC[]; + UND 5; + REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY ]; + MESON_TAC[]; + (* Thu Aug 19 15:29:05 EDT 2004 *) + + ]);; + (* }}} *) + +let euclid_add_cancel = prove_by_refinement( + `!p q q'. (euclid_plus p q = euclid_plus p q') <=> (q = q')`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC [euclid_plus;]; + REWRITE_TAC[REAL_ARITH `(x + a = x + b) <=> (a = b)`]; + ]);; + (* }}} *) + + +let degree_vertex_disk_ver2 = prove_by_refinement( + `!r p X. (&0 < r) /\ (euclid 2 p) /\ (FINITE X) /\ (CARD X <= 4) /\ + (X SUBSET {x | (euclid 2 x) /\ (d_euclid p x = r)}) ==> + (?C. (!i. (X i) ==> (?C' C'' v. + simple_arc_end C' p v /\ + simple_arc_end C'' v i /\ + C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\ + (C' INTER C'' = {v}) /\ + (C' UNION C'' = C i )) /\ + simple_arc_end (C i ) p i /\ + C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\ + C i INTER (closed_ball(euclid 2,d_euclid) p (r / &2)) + SUBSET (hyperplane 2 e2 (p 1) UNION + hyperplane 2 e1 (p 0))) /\ + (!i j. (X i ) /\ (X j) /\ (~(i=j)) ==> + (C i INTER C j = {p} )))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!x. (X x) ==> (?r t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[euclid_cancel1]; + IMATCH_MP_TAC polar_exist; + USE 0(REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[euclid_sub_closure]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!x. (X x) ==> (?t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC; + REP_BASIC_TAC; + TSPEC `x` 5; + REWR 5; + REP_BASIC_TAC; + UND 5; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t]))); + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 4; + REAL_ARITH_TAC; + USE 0 (REWRITE_RULE[SUBSET]); + TSPEC `euclid_plus p (r' *# cis t)` 0; + REWR 0; + REP_BASIC_TAC; + UND 0; + TYPEL_THEN[`2`;`p`;`r' *# cis t`] (fun t-> ANT_TAC (ISPECL t d_euclidpq)); + ASM_REWRITE_TAC[polar_euclid]; + DISCH_THEN_REWRITE; + REWRITE_TAC[GSYM norm2;norm2_scale_cis]; + DISCH_TAC; + TYPE_THEN `abs r' = r'` SUBGOAL_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_TAC; + REWR 0; + ASM_REWRITE_TAC[]; + DISCH_TAC; + KILL 5; + (* -- *) + TYPE_THEN `TX = {t | (&0 <= t /\ t < &2 *pi /\ (X( p + (r *# (cis t))))) }` ABBREV_TAC ; + TYPE_THEN `BIJ ( \ t. p + r *# cis t) TX X` SUBGOAL_TAC; + REWRITE_TAC[BIJ;INJ;SURJ]; + SUBCONJ_TAC; + CONJ_TAC; + EXPAND_TAC "TX"; + REWRITE_TAC[]; + MESON_TAC[]; + EXPAND_TAC "TX"; + REWRITE_TAC[]; + REP_BASIC_TAC; + USE 7 (REWRITE_RULE[euclid_add_cancel]); + PROOF_BY_CONTR_TAC; + TYPEL_THEN[`x`;`y`;`r`;`r`] (fun t-> ANT_TAC(ISPECL t polar_inj)); + ASM_REWRITE_TAC[]; + UND 4; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + UND 4; + REAL_ARITH_TAC; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + EXPAND_TAC "TX"; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `INFINITE {x | &0 <= x /\ x < &2* pi}` SUBGOAL_TAC; + IMATCH_MP_TAC infinite_subset; + TYPE_THEN `{x | &0 < x /\ x < &2 * pi}` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC infinite_interval; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + REWRITE_TAC[PI_POS]; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET]; + MESON_TAC[REAL_ARITH `&0 < x ==> &0 <= x`]; + DISCH_TAC; + (* A -- *) + TYPE_THEN `TX HAS_SIZE CARD X` SUBGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + SUBCONJ_TAC; + COPY 7; + JOIN 2 7; + USE 2 (MATCH_MP FINITE_BIJ2); + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMATCH_MP_TAC BIJ_CARD; + ASM_REWRITE_TAC []; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `(?Z. (TX SUBSET Z /\ Z SUBSET {x | &0 <= x /\ x < &2 *pi} /\ Z HAS_SIZE 4))` SUBGOAL_TAC; + IMATCH_MP_TAC finite_augment; + TYPE_THEN `CARD X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC"TX"; + REWRITE_TAC[SUBSET]; + REAL_ARITH_TAC; + REP_BASIC_TAC; + (* B -- order points *) + TYPE_THEN `FINITE Z` SUBGOAL_TAC; + ASM_MESON_TAC[HAS_SIZE]; + DISCH_TAC; + USE 13 (MATCH_MP real_finite_increase); + REP_BASIC_TAC; + USE 10(REWRITE_RULE[HAS_SIZE]); + REP_BASIC_TAC; + REWR 13; + REWR 14; + (* -- *) + TYPEL_THEN [`r`;`p`;`u`] (fun t-> ANT_TAC (ISPECL t degree_vertex_disk)); + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 14; + REWRITE_TAC[BIJ;SURJ]; + REP_BASIC_TAC; + USE 11(REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 16; + UND 17; + ARITH_TAC; + REP_BASIC_TAC; + (* [C] -- create C *) + TYPE_THEN `f = (\t. euclid_plus p (r *# cis t))` ABBREV_TAC ; + TYPE_THEN `g = INV f TX X` ABBREV_TAC ; + TYPE_THEN `u' = INV u {x | x <| 4} Z` ABBREV_TAC ; + TYPE_THEN `BIJ g X TX` SUBGOAL_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `BIJ u' Z {x | x <| 4}` SUBGOAL_TAC; + EXPAND_TAC "u'"; + IMATCH_MP_TAC INVERSE_BIJ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `INJ (compose u' g) X { x | x <| 4}` SUBGOAL_TAC; + IMATCH_MP_TAC COMP_INJ; + TYPE_THEN `TX` EXISTS_TAC; + CONJ_TAC; + UND 21; + REWRITE_TAC[BIJ]; + MESON_TAC[]; + IMATCH_MP_TAC inj_subset_domain; + TYPE_THEN `Z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 22; + REWRITE_TAC [BIJ]; + DISCH_THEN_REWRITE; + DISCH_TAC; + TYPE_THEN `(\ j. C ((compose u' g) j))` EXISTS_TAC; + REWRITE_TAC[]; + (* D -- check properties *) + CONJ_TAC; + REP_BASIC_TAC; + TYPE_THEN `j = compose u' g i` ABBREV_TAC ; + TSPEC `j` 17; + TYPE_THEN `j <| 4` SUBGOAL_TAC; + USE 23 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + EXPAND_TAC "j"; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 17; + ASM_REWRITE_TAC[]; + (* --2-- *) + TYPE_THEN `i = f (u j)` SUBGOAL_TAC; + EXPAND_TAC "j"; + EXPAND_TAC "f"; + EXPAND_TAC "u'"; + REWRITE_TAC[compose]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + TYPE_THEN `u (INV u {x | x <| 4} Z (g i)) = (g i)` SUBGOAL_TAC; + IMATCH_MP_TAC inv_comp_right; + ASM_REWRITE_TAC[]; + UND 21; + UND 12; + REWRITE_TAC[SUBSET;BIJ;SURJ;]; + UND 24; + MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `f (g i) = i` SUBGOAL_TAC; + EXPAND_TAC "g"; + IMATCH_MP_TAC inv_comp_right; + ASM_REWRITE_TAC[]; + EXPAND_TAC "f"; + DISCH_THEN_REWRITE; + EXPAND_TAC "f"; + DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[GSYM t])); + ASM_REWRITE_TAC[]; + (* E *) + REP_BASIC_TAC; + TYPE_THEN `i' = compose u' g i` ABBREV_TAC ; + TYPE_THEN `j' = compose u' g j` ABBREV_TAC ; + KILL 17; + TYPE_THEN `~(i' = j')` SUBGOAL_TAC; + DISCH_TAC; + UND 24; + REWRITE_TAC[]; + USE 23 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `(i' <| 4) /\ (j' <| 4) ` SUBGOAL_TAC; + EXPAND_TAC "i'"; + EXPAND_TAC "j'"; + USE 23 (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPEL_THEN [`i'`;`j'`] (USE 16 o ISPECL); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Thu Aug 19 18:06:33 EDT 2004 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION O *) +(* ------------------------------------------------------------------ *) + + +let simple_arc_connected = prove_by_refinement( + `!C. simple_arc top2 C ==> connected top2 C`, + (* {{{ proof *) + + [ + REWRITE_TAC[simple_arc;]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC connect_image; + TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC[connect_real]; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REWRITE_TAC[IMAGE;SUBSET]; + REP_BASIC_TAC; + ASM_SIMP_TAC[]; + (* Fri Aug 20 08:32:31 EDT 2004 *) + ]);; + + (* }}} *) + +let disk_endpoint = prove_by_refinement( + `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\ + (C INTER (closed_ball(euclid 2,d_euclid) p r) = {v}) ==> + (d_euclid p v = r)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `connected top2 C` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_connected; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `A = euclid 2 DIFF (closed_ball (euclid 2, d_euclid) p r)` ABBREV_TAC ; + TYPE_THEN `B = closed_ball(euclid 2, d_euclid) p r` ABBREV_TAC ; + TYPE_THEN `closed_ top2 B` SUBGOAL_TAC; + EXPAND_TAC "B"; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + REWRITE_TAC[metric_euclid]; + DISCH_TAC; + (* - *) + TYPE_THEN `top2 A` SUBGOAL_TAC; + UND 8; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + REWRITE_TAC[closed;top2_unions;open_DEF ;]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* - *) + TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `B' = open_ball(euclid 2,d_euclid) p r` ABBREV_TAC ; + TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B'"; + EXPAND_TAC "B"; + REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION]; + USE 10 (REWRITE_RULE[SUBSET]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TSPEC `x` 10; + REWR 10; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USE 13 (REWRITE_RULE[DE_MORGAN_THM]); + REP_BASIC_TAC; + TYPE_THEN `B x` SUBGOAL_TAC; + EXPAND_TAC "B"; + REWRITE_TAC[closed_ball]; + ASM_REWRITE_TAC[]; + USE 0 (REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_MESON_TAC[REAL_ARITH `u <= v /\ ~(u = v) ==> (u < v)`]; + (* - *) + USE 5 (REWRITE_RULE[connected;top2_unions]); + REP_BASIC_TAC; + TYPEL_THEN[`B'`;`A`] (USE 12 o ISPECL); + REWR 12; + TYPE_THEN `top2 B'` SUBGOAL_TAC; + EXPAND_TAC "B'"; + REWRITE_TAC[top2]; + IMATCH_MP_TAC open_ball_open; + REWRITE_TAC[metric_euclid]; + DISCH_THEN_FULL_REWRITE; + (* - *) + TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B'"; + EXPAND_TAC "B"; + REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;]; + REP_BASIC_TAC; + UND 14; + ASM_REWRITE_TAC[]; + UND 16; + REAL_ARITH_TAC; + DISCH_THEN_FULL_REWRITE; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `C SUBSET B` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `B'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "B"; + EXPAND_TAC "B'"; + REWRITE_TAC[SUBSET;open_ball;closed_ball]; + MESON_TAC[REAL_ARITH `x < y ==> x <= y`]; + DISCH_TAC; + (* -- *) + TYPE_THEN `~(v = v')` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_distinct; + ASM_MESON_TAC[]; + REWRITE_TAC[]; + TYPE_THEN `C v'` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + DISCH_TAC; + TYPE_THEN `B v'` SUBGOAL_TAC; + UND 15; + UND 16; + MESON_TAC[ISUBSET]; + UND 16; + UND 0; + REWRITE_TAC[INTER;eq_sing]; + MESON_TAC[]; + (* - *) + TYPE_THEN `C v` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + DISCH_TAC; + TYPE_THEN `A v` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + TYPE_THEN `B v` SUBGOAL_TAC; + UND 0; + REWRITE_TAC[INTER;eq_sing]; + DISCH_THEN_REWRITE; + EXPAND_TAC "A"; + REWRITE_TAC[DIFF]; + DISCH_THEN_REWRITE; + (* Fri Aug 20 09:12:44 EDT 2004 *) + + ]);; + (* }}} *) + +let disk_endpoint_gen = prove_by_refinement( + `!C B' B v v'. simple_arc_end C v v' /\ + (top2 B') /\ (closed_ top2 B) /\ (B' SUBSET B) /\ + (C INTER B = {v}) ==> + (~(B' v))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `connected top2 C` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_connected; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `A = euclid 2 DIFF B` ABBREV_TAC ; + (* - *) + TYPE_THEN `top2 A` SUBGOAL_TAC; + EXPAND_TAC "A"; + UND 3; + REWRITE_TAC[closed;top2_unions;open_DEF ;]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* - *) + TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC; + EXPAND_TAC "A"; + REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION]; + USE 9 (REWRITE_RULE[SUBSET]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `B x` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + USE 1(REWRITE_RULE[INTER;eq_sing]); + REP_BASIC_TAC; + TYPE_THEN `(x = v)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + DISJ2_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + DISCH_TAC; + USE 6 (REWRITE_RULE[connected;top2_unions]); + REP_BASIC_TAC; + TYPEL_THEN[`B'`;`A`] (USE 6 o ISPECL); + REWR 6; + (* - *) + TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC; + EXPAND_TAC "A"; + REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + DISCH_THEN_FULL_REWRITE; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `C SUBSET B` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `B'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `~(v = v')` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_distinct; + ASM_MESON_TAC[]; + REWRITE_TAC[]; + TYPE_THEN `C v'` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + DISCH_TAC; + TYPE_THEN `B v'` SUBGOAL_TAC; + UND 13; + UND 14; + MESON_TAC[ISUBSET]; + UND 14; + UND 1; + REWRITE_TAC[INTER;eq_sing]; + MESON_TAC[]; + (* - *) + TYPE_THEN `C v` SUBGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + DISCH_TAC; + TYPE_THEN `A v` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + TYPE_THEN `B v` SUBGOAL_TAC; + UND 1; + REWRITE_TAC[INTER;eq_sing]; + DISCH_THEN_REWRITE; + EXPAND_TAC "A"; + REWRITE_TAC[DIFF]; + DISCH_THEN_REWRITE; + ]);; + (* }}} *) + +let disk_endpoint_outer = prove_by_refinement( + `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\ + (C INTER (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r)) = {v}) + ==> + (d_euclid p v = r)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `B = (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ; + TYPE_THEN `B' = (euclid 2 DIFF (closed_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ; + (* - *) + TYPE_THEN `B' SUBSET B` SUBGOAL_TAC; + EXPAND_TAC "B'"; + EXPAND_TAC "B"; + REWRITE_TAC[closed_ball;open_ball;SUBSET;DIFF]; + MESON_TAC[REAL_ARITH `x < u ==> x <= u`]; + DISCH_TAC; + (* - *) + TYPE_THEN `closed_ top2 B` SUBGOAL_TAC; + EXPAND_TAC "B"; + REWRITE_TAC[closed;top2_unions;open_DEF ;SUBSET_DIFF]; + TYPE_THEN `open_ball (euclid 2,d_euclid) p r SUBSET (euclid 2)` SUBGOAL_TAC; + REWRITE_TAC[open_ball;SUBSET]; + MESON_TAC[]; + ASM_SIMP_TAC[DIFF_DIFF2]; + ASM_SIMP_TAC [open_ball_open;top2;metric_euclid]; + DISCH_TAC; + (* - *) + TYPE_THEN `top2 B'` SUBGOAL_TAC; + EXPAND_TAC "B'"; + TH_INTRO_TAC [`top2`;`closed_ball (euclid 2,d_euclid) p r`] closed_open; + REWRITE_TAC[metric_euclid;top2]; + IMATCH_MP_TAC closed_ball_closed; + REWRITE_TAC[metric_euclid]; + REWRITE_TAC[open_DEF;top2_unions;]; + DISCH_TAC; + (* - *) + TH_INTRO_TAC [`C`;`B'`;`B`;`v`;`v'`] disk_endpoint_gen; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `B v` SUBGOAL_TAC; + UND 0; + REWRITE_TAC[INTER;eq_sing]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* - *) + TYPE_THEN `B v /\ ~B' v ==> (d_euclid p v = r)` SUBGOAL_TAC; + EXPAND_TAC "B"; + EXPAND_TAC "B'"; + REWRITE_TAC[DIFF;open_ball;closed_ball;]; + MESON_TAC[REAL_ARITH `x <= y /\ ~(x < y) ==> (x = y)`]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let graph_edge_around = jordan_def + `graph_edge_around (G:(A,B)graph_t) v = + { e | graph_edge G e /\ graph_inc G e v}`;; + +let graph_edge_around_empty = prove_by_refinement( + `!(G:(A,B)graph_t) v. (graph G) /\ ~(graph_vertex G v) ==> + (graph_edge_around G v = EMPTY)`, + (* {{{ proof *) + + [ + REWRITE_TAC[graph_edge_around;EQ_EMPTY;]; + REP_BASIC_TAC; + TH_INTRO_TAC [`G`;`x`] graph_inc_subset; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* Fri Aug 20 09:25:57 EDT 2004 *) + + ]);; + + (* }}} *) + +let graph_disk_hv_preliminaries = prove_by_refinement( + `!G. plane_graph G /\ + FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ + ~(graph_edge G = EMPTY) /\ + (!v. (CARD (graph_edge_around G v) <=| 4)) + ==> + (?NC D short_end hyper r d f. ((!e p. graph_edge G e /\ (!v. ~D v p) ==> (f e p = d e p)) /\ + (!e v p. + graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v /\ D v p + ==> ~f e p) /\ + (!e v p. + (graph_edge G e /\ graph_inc G e v) /\ D v p + ==> (f e p = NC e v p)) /\ + (!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}) /\ + (!v e e'. + graph_edge G e /\ + graph_edge G e' /\ + graph_inc G e v /\ + graph_inc G e' v /\ + ~(e = e') + ==> (NC e v INTER NC e' v = {v})) /\ + (!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)) /\ + (!e e'. + graph_edge G e /\ graph_edge G e' /\ ~(e = e') + ==> (d e INTER d e' = {})) /\ + (!e v. + graph_edge G e /\ graph_inc G e v + ==> ~graph_vertex G (short_end e v)) /\ + (!v v'. + graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') + ==> (D v INTER D v' = {})) /\ + (!e v. + graph_edge G e /\ graph_inc G e v + ==> simple_arc_end (NC e v) v (short_end e v) /\ + NC e v SUBSET D v /\ + hyper (NC e v) v) /\ + ((\ B v. + B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET + hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) = + hyper) /\ + (!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v) /\ + (!e v. + graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v + ==> (d e INTER D v = {})) /\ + (!e. graph_edge G e ==> d e SUBSET e) /\ + (!e v. + graph_edge G e /\ graph_inc G e v + ==> (d e INTER D v = {(short_end e v)}) /\ + (d_euclid v (short_end e v) = r) /\ + (!v'. graph_inc G e v' /\ ~(v = v') + ==> simple_arc_end (d e) (short_end e v) + (short_end e v'))) /\ + (!v. euclid 2 v ==> D v v) /\ + (!u. closed_ top2 (D u)) /\ + (( \ u. closed_ball (euclid 2,d_euclid) u r) = D) /\ + (&0 < r) /\ + (plane_graph G))) + `, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TH_INTRO_TAC [`G`] graph_disk; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* TYPE_THEN `r /(&2)` EXISTS_TAC; *) + (* - *) + TYPE_THEN `D = (\u. (closed_ball (euclid 2,d_euclid ) u r))` ABBREV_TAC ; + TYPE_THEN `!u. closed_ top2 (D u)` SUBGOAL_TAC; + EXPAND_TAC "D"; + GEN_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + REWRITE_TAC[metric_euclid]; + DISCH_TAC; + (* - *) + TYPE_THEN `!v. (euclid 2 v) ==> D v v` SUBGOAL_TAC; + EXPAND_TAC "D"; + REWRITE_TAC[closed_ball2_center]; + GEN_TAC; + DISCH_THEN_REWRITE; + UND 7; + REAL_ARITH_TAC; + DISCH_TAC; + (* - *) + (* [A]- Pick middle arcs *) + (* {{{ *) + + TYPE_THEN `!e. ?d. (graph_edge G e) ==> (?u u' v v'. simple_arc_end d u u' /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') /\ (d INTER (D v) = {u}) /\ (d INTER (D v') = {u'}) /\ (d SUBSET e) /\ (d_euclid v u = r) /\ (d_euclid v' u' = r))` SUBGOAL_TAC ; + GEN_TAC; + RIGHT_TAC "d"; + DISCH_TAC; + TH_INTRO_TAC [`G`;`e`] graph_edge_end_select; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); (* -xx- *) + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TH_INTRO_TAC [`e`;`D v`;`D v'`] simple_arc_end_restriction; + ASM_REWRITE_TAC[GSYM top2]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + USE 16 (REWRITE_RULE[SUBSET ]); + ASM_MESON_TAC[]; + UND 6; + DISCH_THEN (TH_INTRO_TAC [`v`;`v'`] ); + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE [plane_graph;]); + ASM_MESON_TAC[REWRITE_RULE[SUBSET] graph_inc_subset]; + DISCH_TAC; + CONJ_TAC; + EXPAND_TAC "D"; + UND 6; + REWRITE_TAC[INTER;EQ_EMPTY]; + MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS ]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TSPEC `e` 15; + REWR 15; + REWR 13; + REWR 14; + UND 18; + REWRITE_TAC[SUBSET]; + UND 13; + UND 14; + REWRITE_TAC[INTER]; + UND 10; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `v''` EXISTS_TAC; + TYPE_THEN `v'''` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC disk_endpoint; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `v'''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 16; + EXPAND_TAC "D"; + DISCH_THEN_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + USE 21 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset]; + (* -- *) + IMATCH_MP_TAC disk_endpoint; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `v''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 15; + EXPAND_TAC "D"; + DISCH_THEN_REWRITE; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + USE 21 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset]; + DISCH_TAC; + RIGHT 11 "e"; + REP_BASIC_TAC; + (* B- short_end *) + TYPE_THEN `short_end = ( \ e v. @s. (d e INTER (D v)) s)` ABBREV_TAC ; + TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v) ==> (d e INTER (D v) = {(short_end e v)}) /\ (d_euclid v (short_end e v) = r) /\ (!v'. (graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (d e) (short_end e v) (short_end e v'))))` SUBGOAL_TAC; + REP_BASIC_TAC; + TSPEC `e` 11; + REWR 11; + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge2; + UND 4; + REWRITE_TAC[plane_graph]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `!u. graph_inc G e u ==> (u = v') \/ (u = v'')` SUBGOAL_TAC; + ASM_MESON_TAC[two_exclusion]; + DISCH_TAC; + TYPE_THEN `?s. (d e INTER D v) s` SUBGOAL_TAC; + TSPEC `v` 24; + REWR 24; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + MESON_TAC[]; + ASM_REWRITE_TAC[INR IN_SING ]; + MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `(d e INTER D v) (short_end e v)` SUBGOAL_TAC; + EXPAND_TAC "short_end"; + SELECT_TAC; + DISCH_THEN_REWRITE ; + ASM_MESON_TAC[]; + DISCH_TAC; + LEFT_TAC "v'"; + LEFT_TAC "v'"; + GEN_TAC; + TYPE_THEN `(v = v') \/ (v = v'')` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `(graph_inc G e v''') ==> (v''' = v') \/ (v''' = v'')` SUBGOAL_TAC; + DISCH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* --- *) + DISCH_THEN DISJ_CASES_TAC; + FIRST_ASSUM MP_TAC; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `short_end e v' = u` SUBGOAL_TAC; + REWR 26; + USE 26 (REWRITE_RULE[INR IN_SING]); + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + KILL 24; + REWR 27; + UND 24; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC; + TYPE_THEN `?s. (d e INTER D v'') s` SUBGOAL_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + MESON_TAC[]; + EXPAND_TAC "short_end"; + SELECT_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + DISCH_THEN_REWRITE; + UND 24; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + (* -- *) + FIRST_ASSUM MP_TAC; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC; + REWR 26; + USE 26 (REWRITE_RULE[INR IN_SING]); + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + KILL 24; + REWR 27; + UND 24; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `short_end e v' = u` SUBGOAL_TAC; + TYPE_THEN `?s. (d e INTER D v') s` SUBGOAL_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + MESON_TAC[]; + EXPAND_TAC "short_end"; + SELECT_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + DISCH_THEN_REWRITE; + UND 24; + MESON_TAC[]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + DISCH_TAC; + + (* }}} *) + (* [C]- *) + TYPE_THEN `X = (\ v. (IMAGE (\ e. short_end e v) (graph_edge_around G v)))` ABBREV_TAC ; + TYPE_THEN `!v. FINITE (graph_edge_around G v)` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[graph_edge_around]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `graph_edge G ` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `!v. graph_vertex G v ==> (FINITE (X v) /\ (CARD (X v) <=| 4) /\ ((X v) SUBSET {x | euclid 2 x /\ (d_euclid v x = r)}))` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC "X"; + SUBCONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; + IMATCH_MP_TAC LE_TRANS; + TYPE_THEN `CARD (graph_edge_around G v)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC CARD_IMAGE_LE; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IMAGE]; + REP_BASIC_TAC; + UND 18; + DISCH_THEN_FULL_REWRITE; + USE 19 (REWRITE_RULE[graph_edge_around]); + TSPEC `x'` 13; + TSPEC `v` 13; + REWR 13; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + UND 19; + EXPAND_TAC "D"; + REWRITE_TAC[INTER;eq_sing;closed_ball]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* -D now generate curves C in disk. *) + TYPE_THEN `!v. (graph_vertex G v) ==> (?C. (!i. X v i ==> (?C' C'' v'. simple_arc_end C' v v' /\ simple_arc_end C'' v' i /\ C' SUBSET closed_ball (euclid 2,d_euclid) v (r / &2) /\ (C' INTER C'' = {v'}) /\ (C' UNION C'' = C i)) /\ simple_arc_end (C i) v i /\ C i SUBSET closed_ball (euclid 2,d_euclid) v r /\ C i INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) /\ (!i j. X v i /\ X v j /\ ~(i = j) ==> (C i INTER C j = {v})))` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC degree_vertex_disk_ver2; + ASM_REWRITE_TAC[]; + TYPE_THEN `(\j. X v j) = X v` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + BETA_TAC; + MESON_TAC[]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + TSPEC `v` 16; + REWR 16; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + LEFT 17 "C"; + LEFT 17 "C"; + REP_BASIC_TAC; + TYPE_THEN `f = (\ e. { x | d e x \/ (?v. graph_inc G e v /\ C v (short_end e v) x)})` ABBREV_TAC ; + (* -[E] lets try to flatten some hypotheses *) + TYPE_THEN `NC = (\ e v. (C v (short_end e v)))` ABBREV_TAC ; + KILL 1; + KILL 2; + KILL 3; + KILL 0; + (* rework 5 *) + TYPE_THEN `!e . graph_edge G e ==> (d e SUBSET e)` SUBGOAL_TAC; + UND 11; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `!e v. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v ==> (d e INTER (D v) = EMPTY)` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL); + REWR 5; + UND 5; + UND 0; + REWRITE_TAC[SUBSET;EQ_EMPTY]; + UND 3; + EXPAND_TAC "D"; + REWRITE_TAC[INTER]; + MESON_TAC[]; + DISCH_TAC; + KILL 5; + KILL 11; + KILL 12; + (* rework 16 *) + TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TH_INTRO_TAC [`G`;`e`] graph_inc_subset; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> X v (short_end e v))` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC "X"; + REWRITE_TAC[IMAGE]; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[graph_edge_around]; + DISCH_TAC; + KILL 16; + KILL 14; + (* rework 17 *) + TYPE_THEN `hyper = (\ B v. (B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)))` ABBREV_TAC ; + TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> (simple_arc_end (NC e v) v (short_end e v)) /\ (NC e v SUBSET D v) /\ (hyper (NC e v) v)` SUBGOAL_TAC; + EXPAND_TAC "hyper"; + EXPAND_TAC "NC"; + REP_BASIC_TAC; + TSPEC `v` 17; + TYPE_THEN `graph_vertex G v` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + REP_BASIC_TAC; + TSPEC `short_end e v` 16; + TYPE_THEN `X v (short_end e v)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + EXPAND_TAC "D"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* F- continue simplification *) + TYPE_THEN `!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (D v INTER D v' = EMPTY)` SUBGOAL_TAC; + EXPAND_TAC "D"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + KILL 6; + (* - *) + TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> ~(graph_vertex G (short_end e v)))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL); + REWR 13; + REP_BASIC_TAC; + USE 21 (REWRITE_RULE[eq_sing;INTER]); + REP_BASIC_TAC; + TYPE_THEN `D (short_end e v) (short_end e v)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]); + REP_BASIC_TAC; + USE 27 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `~(D (short_end e v) INTER D v = EMPTY)` SUBGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `short_end e v` EXISTS_TAC; + ASM_REWRITE_TAC[INTER]; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USE 25 (REWRITE_RULE[]); + UND 25; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + USE 28 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + UND 20; + UND 7; + REAL_ARITH_TAC; + DISCH_TAC; + (* - *) + TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (d e INTER d e' = EMPTY)` SUBGOAL_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + USE 21 (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TYPEL_THEN [`e`;`e'`] (USE 4 o ISPECL); + REWR 4; + TYPE_THEN `d e INTER d e' SUBSET graph_vertex G` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `e INTER e'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_inter_pair; + UND 0; + UND 20; + UND 16; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `graph_vertex G u` SUBGOAL_TAC; + USE 26 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USE 21(REWRITE_RULE[INTER]); + TYPE_THEN `graph_inc G e u` ASM_CASES_TAC; + TYPEL_THEN [`e`;`u`] (USE 13 o ISPECL); + REWR 13; + TYPE_THEN `(d e INTER D u) u` SUBGOAL_TAC; + REP_BASIC_TAC; + USE 28 GSYM; + ASM_REWRITE_TAC[INTER]; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 25 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 28 GSYM; + REWR 28; + USE 28 (REWRITE_RULE[INR IN_SING]); + UND 28; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `d e INTER D u = EMPTY ` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC []; + USE 26 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[INTER]; + DISCH_TAC; + USE 28(REWRITE_RULE[EQ_EMPTY]); + TSPEC `u` 28; + DISCH_TAC; + USE 28(REWRITE_RULE[INTER]); + UND 28; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 25 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -G continue to simplify *) + TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL); + REWR 13; + REP_BASIC_TAC; + USE 22(REWRITE_RULE[eq_sing;INTER]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `! v e e'. graph_edge G e /\ graph_edge G e' /\ graph_inc G e v /\ graph_inc G e' v /\ ~(e = e') ==> (NC e v INTER NC e' v = {v})` SUBGOAL_TAC; + EXPAND_TAC "NC"; + REP_BASIC_TAC; + TSPEC `v` 17; + TYPE_THEN `graph_vertex G v` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + REP_BASIC_TAC; + TYPEL_THEN [`short_end e v`;`short_end e' v`](USE 17 o ISPECL); + KILL 25; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + KILL 17; + DISCH_TAC; + TYPE_THEN `d e (short_end e v)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `d e' (short_end e' v)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `d e INTER d e' = EMPTY ` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EQ_EMPTY;INTER]; + UND 17; + MESON_TAC[]; + DISCH_TAC; + KILL 17; + KILL 3; + KILL 15; + (* H- *) + TYPE_THEN `!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC "f"; + EXPAND_TAC "NC"; + REWRITE_TAC[]; + DISCH_TAC; + KILL 18; + KILL 19; + TYPE_THEN `!e v p. (graph_edge G e /\ graph_inc G e v) /\ (D v p) ==> (f e p = NC e v p)` SUBGOAL_TAC ; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + EQ_TAC; + UND 17; + MESON_TAC[]; + DISCH_THEN DISJ_CASES_TAC; + TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL); + REWR 13; + REP_BASIC_TAC; + USE 22 (REWRITE_RULE[eq_sing;INTER ]); + REP_BASIC_TAC; + TSPEC `p` 22; + REWR 22; + UND 22; + DISCH_THEN_FULL_REWRITE; + TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL); + REWR 11; + REP_BASIC_TAC; + UND 25; + MESON_TAC[simple_arc_end_end2]; + REP_BASIC_TAC; + TYPE_THEN `v' = v` ASM_CASES_TAC; + UND 19; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `p` EXISTS_TAC; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + TYPEL_THEN[`e`;`v'`] (USE 11 o ISPECL); + REWR 11; + REP_BASIC_TAC; + USE 24 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `!e v p. (graph_edge G e /\ (graph_vertex G v) /\ ~(graph_inc G e v) /\ (D v p) ==> ~(f e p))` SUBGOAL_TAC; + ASM_REWRITE_TAC[DE_MORGAN_THM ]; + REP_BASIC_TAC; + CONJ_TAC; + DISCH_TAC; + TYPE_THEN `d e INTER D v = EMPTY` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + LEFT_TAC "v"; + GEN_TAC; + DISCH_TAC; + REP_BASIC_TAC; + TYPE_THEN `~(v = v')` SUBGOAL_TAC; + DISCH_TAC; + UND 23; + UND 18; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPEL_THEN [`e`;`v'`] (USE 11 o ISPECL); + REP_BASIC_TAC; + REWR 11; + REP_BASIC_TAC; + USE 25 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `!e p. graph_edge G e /\ (!v. ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + IMATCH_MP_TAC (TAUT `~B ==> (A \/ B <=> A)`); + DISCH_TAC; + REP_BASIC_TAC; + TSPEC `v` 18; + UND 18; + REWRITE_TAC[]; + TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL); + REWR 11; + REP_BASIC_TAC; + USE 18(REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* I- *) + TYPE_THEN `NC` EXISTS_TAC; + TYPE_THEN `D` EXISTS_TAC; + TYPE_THEN `short_end` EXISTS_TAC; + TYPE_THEN `hyper` EXISTS_TAC; + TYPE_THEN `r` EXISTS_TAC; + TYPE_THEN `d` EXISTS_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Sat Aug 21 08:06:22 EDT 2004 *) + + ]);; + + (* }}} *) + + +let graph_vertex_exhaust = prove_by_refinement( + `!(G:(A,B)graph_t) e v v'. + (graph G /\ (graph_edge G e) /\ (graph_inc G e v) /\ + (graph_inc G e v') /\ ~(v = v') ==> (graph_inc G e = {v,v'}))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + UND 6; + DISCH_THEN_FULL_REWRITE; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[in_pair]; + KILL 3; + KILL 4; + RULE_ASSUM_TAC (REWRITE_RULE[in_pair]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +let graph_disk_hv = prove_by_refinement( + `!G. plane_graph G /\ + FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ + ~(graph_edge G = EMPTY) /\ + (!v. (CARD (graph_edge_around G v) <=| 4)) + ==> + (?r H . graph_isomorphic G H /\ good_plane_graph H /\ + (&0 < r) /\ + (!v v'. + graph_vertex H v /\ graph_vertex H v' /\ ~(v = v') + ==> (closed_ball (euclid 2,d_euclid) v r INTER + closed_ball (euclid 2,d_euclid) v' r = + {})) /\ + (!e v. + graph_edge H e /\ graph_vertex H v /\ ~graph_inc H e v + ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ + (!e v. + graph_edge H e /\ graph_inc H e v + ==> (e INTER closed_ball (euclid 2, d_euclid) v r SUBSET + (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)))) + )`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TH_INTRO_TAC [`G`] graph_disk_hv_preliminaries; + ASM_REWRITE_TAC[]; + POP_ASSUM_LIST (fun t-> ALL_TAC); + REP_BASIC_TAC; + (* - *) (* redo 19 *) + TYPE_THEN `!e p. graph_edge G e /\ (!v. graph_inc G e v ==> ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (TAUT `~B ==> (A \/ B <=> A)`); + DISCH_TAC; + REP_BASIC_TAC; + TSPEC `v` 20; + UND 20; + ASM_REWRITE_TAC[]; + TYPEL_THEN[`e`;`v`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + USE 20 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + KILL 19; + (* - *) + TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (f e INTER f e' SUBSET e INTER e')` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[SUBSET;INTER ]; + REP_BASIC_TAC; + TYPE_THEN `?v. (graph_inc G e v /\ D v x)` ASM_CASES_TAC; + REP_BASIC_TAC; + TYPE_THEN `f e x = NC e v x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `graph_inc G e' v` ASM_CASES_TAC; + TYPE_THEN `f e' x = NC e' v x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `(NC e v INTER NC e' v = {v})` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INR IN_SING;INTER]; + DISCH_TAC; + TSPEC `x` 28; + REWR 28; + UND 28; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TYPE_THEN `e` (WITH 28 o ISPEC); + TSPEC `e'` 28; + UND 28; + UND 32; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + DISCH_THEN_FULL_REWRITE; + UND 26; + UND 27; + REWRITE_TAC[INTER]; + DISCH_THEN_REWRITE; + PROOF_BY_CONTR_TAC; + UND 23; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `(f e x = d e x)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + GEN_TAC; + UND 25; + MESON_TAC[]; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `(?v. graph_inc G e' v /\ D v x)` ASM_CASES_TAC; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `d e INTER D v = {}` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + LEFT 25 "v"; + TSPEC `v` 25; + UND 25; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `f e' x = d e' x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + GEN_TAC; + UND 26; + MESON_TAC[]; + DISCH_THEN_FULL_REWRITE; + PROOF_BY_CONTR_TAC; + TYPE_THEN `d e INTER d e' = EMPTY` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS ;INTER]; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* A injective *) + TYPE_THEN `INJ f (graph_edge G) UNIV` SUBGOAL_TAC; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + TYPE_THEN ` (graph_inc G x ) HAS_SIZE 2` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge2; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + TYPE_THEN `graph_inc G x a` SUBGOAL_TAC; + ASM_REWRITE_TAC[in_pair]; + DISCH_TAC; + TYPE_THEN `d x SUBSET f x` SUBGOAL_TAC; + KILL 21; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `d x (short_end x a)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `f x (short_end x a)` SUBGOAL_TAC; + UND 28; + UND 27; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `f x INTER f y SUBSET x INTER y` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `(x INTER y) (short_end x a)` SUBGOAL_TAC; + USE 31 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + USE 21 GSYM; + KILL 16; + ASM_REWRITE_TAC[INTER_IDEMPOT]; + TYPE_THEN `(x INTER y) SUBSET (graph_vertex G)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `(graph_vertex G (short_end x a))` SUBGOAL_TAC; + USE 33(REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* B now simple arc -- ugh *) + TYPE_THEN `(!e v v'. (graph_edge G e /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (f e) v v')))` SUBGOAL_TAC; + REP_BASIC_TAC; + TYPE_THEN `f e = (NC e v UNION d e) UNION NC e v'` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[UNION]; + ONCE_REWRITE_TAC [EQ_SYM_EQ;]; + REWRITE_TAC[GSYM DISJ_ASSOC]; + EQ_TAC; + REP_CASES_TAC; + DISJ2_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + DISJ2_TAC; + TYPE_THEN `v'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_CASES_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e = {v , v'}` SUBGOAL_TAC; + IMATCH_MP_TAC graph_vertex_exhaust; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 27; + USE 27 (REWRITE_RULE[in_pair]); + UND 27; + REP_CASES_TAC; + UND 27; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + UND 27; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN ASSUME_TAC t); + (* -- *) + TYPE_THEN `simple_arc_end (NC e v UNION d e) v (short_end e v')` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `short_end e v` EXISTS_TAC; + CONJ_TAC; + TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL); + REWR 5; + REP_BASIC_TAC; + TSPEC `v'` 5; + REWR 5; + (* --- *) + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING;INTER ]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + GEN_TAC; + EQ_TAC; + DISCH_THEN_FULL_REWRITE; + CONJ_TAC; + TYPE_THEN `simple_arc_end (NC e v) v (short_end e v)` SUBGOAL_TAC; + TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[simple_arc_end_end2]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* --- *) + DISCH_TAC; + REP_BASIC_TAC; + TYPE_THEN `D v x` SUBGOAL_TAC; + TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + USE 29 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `d e INTER D v = {(short_end e v)}` SUBGOAL_TAC; + TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL); + REWR 5; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[eq_sing]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `(short_end e v')` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + GEN_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + EQ_TAC; + DISCH_THEN_FULL_REWRITE; + CONJ_TAC; + UND 27; + MESON_TAC[simple_arc_end_end2]; + TYPEL_THEN[`e`;`v'`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + UND 29; + MESON_TAC[simple_arc_end_end2]; + REP_BASIC_TAC; + UND 29; + REWRITE_TAC[UNION]; + REP_CASES_TAC ; + PROOF_BY_CONTR_TAC; + TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `x` EXISTS_TAC; + CONJ_TAC; + TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + USE 31 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + USE 31 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `D v' x` SUBGOAL_TAC; + TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + USE 30 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `d e INTER D v' = {(short_end e v')}` SUBGOAL_TAC; + TYPEL_THEN [`e`;`v'`] (USE 5 o ISPECL); + REWR 5; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER;eq_sing]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* C - *) + TYPE_THEN `!e v. (graph_edge G e) ==> ( e INTER graph_vertex G = (f e) INTER (graph_vertex G))` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER]; + GEN_TAC; + IMATCH_MP_TAC (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`); + DISCH_TAC; + TYPE_THEN `D x x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `graph_inc G e x` ASM_CASES_TAC; + TYPE_THEN `f e x = NC e x x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `NC e x x` SUBGOAL_TAC; + TYPEL_THEN[`e`;`x`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + UND 28; + MESON_TAC[simple_arc_end_end]; + DISCH_THEN_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TSPEC `e` 27; + REWR 27; + REWR 26; + UND 26; + REWRITE_TAC[INTER]; + DISCH_THEN_REWRITE; + TYPE_THEN `~f e x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + DISCH_TAC; + UND 26; + REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TSPEC `e` 26; + REWR 26; + ASM_REWRITE_TAC[INTER]; + DISCH_TAC; + (* D start on graph and goal *) + TYPE_THEN `r /(&2)` EXISTS_TAC; + TYPE_THEN `graph_edge_mod G f` EXISTS_TAC; + REWRITE_TAC[good_plane_graph]; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + CONJ_TAC; + IMATCH_MP_TAC graph_edge_iso; + ASM_REWRITE_TAC[]; + REWRITE_TAC[TAUT `(A /\ B) /\ C <=> (A /\ (B /\ C))`]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC plane_graph_mod; + USE 16 GSYM; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + TH_INTRO_TAC [`G`;`e`] graph_edge_end_select; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); (* --x-- *) + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i]); + REP_BASIC_TAC; + USE 29 GSYM; + UND 29; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `e'' =e'` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!v. closed_ball (euclid 2, d_euclid) v (r/(&2)) SUBSET D v` SUBGOAL_TAC; + GEN_TAC; + EXPAND_TAC "D"; + REWRITE_TAC[closed_ball;SUBSET]; + TYPE_THEN `r /(&2) < r` SUBGOAL_TAC; + UND 1; + MESON_TAC[ half_pos]; + MESON_TAC[REAL_ARITH `x <= u /\ u < v ==> x <= v`]; + DISCH_TAC; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `D v INTER D v'` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v]); + TYPE_THEN `(D v INTER D v' = EMPTY)` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[]; + (* E - down to 2 *) + CONJ_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v;graph_edge_mod_i;graph_edge_mod_e]); + USE 27 (REWRITE_RULE[IMAGE]); + REP_BASIC_TAC; + UND 27; + DISCH_THEN_FULL_REWRITE; + LEFT 25 "e'"; + TSPEC `x` 25; + PROOF_BY_CONTR_TAC; + USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER]); + REP_BASIC_TAC; + TYPE_THEN `D v u` SUBGOAL_TAC; + USE 24 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `~f x u` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 25; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - final *) + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_i;graph_edge_mod_e]); + USE 26 (REWRITE_RULE[IMAGE]); + REP_BASIC_TAC; + UND 28; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `e' = x` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + (* - *) + TYPE_THEN `f x INTER D v = NC x v INTER D v` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`); + DISCH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `f x INTER (closed_ball (euclid 2,d_euclid) v (r/(&2))) = NC x v INTER (closed_ball(euclid 2, d_euclid) v (r/(&2)))` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INTER]; + USE 28 (REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x'` 28; + UND 28; + UND 24; + REWRITE_TAC[SUBSET;INTER]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPEL_THEN[`x`;`v`] (USE 10 o ISPECL); + REWR 10; + REP_BASIC_TAC; + UND 10; + EXPAND_TAC "hyper"; + DISCH_THEN_REWRITE; + (* Sat Aug 21 14:12:41 EDT 2004 *) + + ]);; + + (* }}} *) + +let hv_finite = jordan_def `hv_finite C <=> + (?E. C SUBSET UNIONS E /\ FINITE E /\ hv_line E)`;; + +let hv_finite_subset = prove_by_refinement( + `!A B. hv_finite B /\ A SUBSET B ==> hv_finite A`, + (* {{{ proof *) + [ + REWRITE_TAC[hv_finite]; + REP_BASIC_TAC; + TYPE_THEN `E` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let mk_line_hyper2_e1 = prove_by_refinement( + `!z. mk_line (point (z, &0)) (point(z, &1)) = hyperplane 2 e1 z`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM line2D_F;e1;mk_line;]; + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[point_scale;point_add]; + GEN_TAC; + REDUCE_TAC; + TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC; + GEN_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `(z, &1 - t)` EXISTS_TAC; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `&1 - (SND p)` EXISTS_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let mk_line_hyper2_e2 = prove_by_refinement( + `!z. mk_line (point (&0, z)) (point(&1, z)) = hyperplane 2 e2 z`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM line2D_S;e2;mk_line;]; + GEN_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[point_scale;point_add]; + GEN_TAC; + REDUCE_TAC; + TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC; + GEN_TAC; + real_poly_tac; + DISCH_THEN_REWRITE; + EQ_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `( &1 - t, z)` EXISTS_TAC; + REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `&1 - (FST p)` EXISTS_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let hv_finite_hyper = prove_by_refinement( + `!C. + (?v. C SUBSET (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))) ==> + (hv_finite C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[hv_finite]; + TYPE_THEN `{(hyperplane 2 e2 (v 1)), (hyperplane 2 e1 (v 0))}` EXISTS_TAC ; + ASM_REWRITE_TAC[UNIONS_2;FINITE_INSERT;FINITE_SING;FINITE_RULES; ]; + REWRITE_TAC[hv_line;in_pair;GSYM mk_line_hyper2_e2;GSYM mk_line_hyper2_e1]; + GEN_TAC; + REP_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `(v 0, &0)` EXISTS_TAC; + TYPE_THEN `(v 0, &1)` EXISTS_TAC; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + TYPE_THEN `(&0, v 1)` EXISTS_TAC; + TYPE_THEN `(&1, v 1)` EXISTS_TAC; + REWRITE_TAC[]; + ]);; + + (* }}} *) + +let graph_hv_finite_radius = jordan_def + `graph_hv_finite_radius G r <=> (good_plane_graph G /\ + (&0 < r) /\ + (!v v'. + graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') + ==> (closed_ball (euclid 2,d_euclid) v r INTER + closed_ball (euclid 2,d_euclid) v' r = + {})) /\ + (!e v. + graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v + ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ + (!e v. + graph_edge G e /\ graph_inc G e v + ==> (hv_finite (e INTER closed_ball (euclid 2, d_euclid) v r)))) + `;; + +let p_conn_hv_finite = prove_by_refinement( + `!A x y. ~(x = y) ==> + (p_conn A x y <=> (?C. (hv_finite C) /\ (C SUBSET A) /\ + (simple_arc_end C x y)))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[p_conn;simple_polygonal_arc]; + (* - *) + EQ_TAC; + REP_BASIC_TAC; + TH_INTRO_TAC [`C`;`x`;`y`] simple_arc_end_select; + ASM_REWRITE_TAC[top2]; + REP_BASIC_TAC; + TYPE_THEN `C'` EXISTS_TAC; + REWRITE_TAC[hv_finite]; + CONJ_TAC; + TYPE_THEN `E` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]); + REP_BASIC_TAC; + TYPE_THEN `C` EXISTS_TAC; + CONJ_TAC; + CONJ_TAC; + REWRITE_TAC[GSYM top2]; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + ]);; + + (* }}} *) + + +let graph_iso_around = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t) f v. (graph G) /\ + graph_iso f G H /\ (graph_vertex G v) ==> + (graph_edge_around H (FST f v) = + (IMAGE (SND f) (graph_edge_around G v)))`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_iso;graph_edge_around]; + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REP_BASIC_TAC; + REWRITE_TAC[]; + EQ_TAC ; + REP_BASIC_TAC; + TYPE_THEN `(?y. graph_edge G y /\ (v' y = x))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + USE 8 GSYM; + UND 8; + DISCH_THEN_FULL_REWRITE; + TSPEC `y` 1; + REWR 1; + REWRITE_TAC[IMAGE]; + TYPE_THEN `y` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWR 6; + USE 6 (REWRITE_RULE[IMAGE]); + REP_BASIC_TAC; + TYPE_THEN `v = x'` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TH_INTRO_TAC [`G`;`y`] graph_inc_subset; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + REWR 6; + UND 6; + DISCH_THEN_FULL_REWRITE; + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ASM_MESON_TAC[]; + DISCH_TAC; + ASM_SIMP_TAC[]; + REWRITE_TAC[IMAGE]; + REP_BASIC_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Sat Aug 21 16:49:58 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_radius_exists = prove_by_refinement( + `!G. planar_graph (G:(A,B) graph_t) /\ + FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\ + ~(graph_edge G = EMPTY) /\ + (!v. (CARD (graph_edge_around G v) <=| 4)) ==> + (?r H. + (graph_isomorphic G H /\ graph_hv_finite_radius H r))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[planar_graph]); + REP_BASIC_TAC; + TYPE_THEN `FINITE (graph_edge H) /\ FINITE (graph_vertex H) /\ ~(graph_edge H = EMPTY) /\ (!v. (CARD (graph_edge_around H v) <=| 4))` SUBGOAL_TAC; + WITH 4 (REWRITE_RULE[graph_isomorphic]); + REP_BASIC_TAC; + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]); + REP_BASIC_TAC; + TH_INTRO_TAC [`graph_edge H`;`graph_edge G`;`v`] FINITE_BIJ2; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* -- *) + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]); + REP_BASIC_TAC; + TH_INTRO_TAC [`graph_vertex H`;`graph_vertex G`;`u`] FINITE_BIJ2; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + CONJ_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_iso;BIJ;SURJ]); + REP_BASIC_TAC; + ASM_MESON_TAC[]; + GEN_TAC; + (* -- *) + TYPE_THEN `graph_vertex H v` ASM_CASES_TAC; + TH_INTRO_TAC [`H`;`G`;`f`;`v`] graph_iso_around; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]); + REP_BASIC_TAC; + UND 12; + DISCH_THEN_FULL_REWRITE; + TSPEC `u v` 0; + REWR 0; + TH_INTRO_TAC [`v'`;`graph_edge_around H v`] CARD_IMAGE_INJ; + REWRITE_TAC[]; + CONJ_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ;BIJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_around]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `graph_edge H` EXISTS_TAC ; + ASM_REWRITE_TAC[SUBSET;graph_edge_around]; + MESON_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + TH_INTRO_TAC [`H`;`v`] graph_edge_around_empty; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[CARD_CLAUSES]; + ARITH_TAC; + REP_BASIC_TAC; + (* - *) + TH_INTRO_TAC [`H`] graph_disk_hv; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `r` EXISTS_TAC; + TYPE_THEN `H'` EXISTS_TAC; + REWRITE_TAC[graph_hv_finite_radius]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TH_INTRO_TAC [`G`;`H`;`H'`] graph_isomorphic_trans; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC graph_isomorphic_symm; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* - *) + REP_BASIC_TAC; + TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL); + REWR 10; + IMATCH_MP_TAC hv_finite_hyper; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Sat Aug 21 17:28:09 EDT 2004 *) + + ]);; + (* }}} *) + +let replace = jordan_def `replace (x:A) y = + (\ z. (if (z = x) then y else z))`;; + +let replace_x = prove_by_refinement( + `!(x:A) y. replace x y x = y`, + (* {{{ proof *) + [ + REWRITE_TAC[replace]; + (* Sun Aug 22 09:01:27 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_replace = jordan_def + `graph_replace (G:(A,B)graph_t) e e' = + graph_edge_mod G (replace e e')`;; + +let replace_inj = prove_by_refinement( + `!(x:A) y Z. ~(Z y) ==> INJ (replace x y) Z UNIV`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;replace]; + REP_BASIC_TAC; + MP_TAC (TAUT `((x' = (x:A)) \/ ~(x' = x)) /\ ((y' = x) \/ ~(y' = x))`); + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + REP_CASES_TAC THEN (REWR 0); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_replace_iso = prove_by_refinement( + `!(G:(A,B)graph_t) e e'. + ~(graph_edge G e') ==> graph_isomorphic G (graph_replace G e e')`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_replace]; + REP_BASIC_TAC; + IMATCH_MP_TAC graph_edge_iso; + IMATCH_MP_TAC replace_inj; + ASM_REWRITE_TAC[]; + (* Sun Aug 22 09:30:14 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_replace_plane = prove_by_refinement( + `!G e e'. plane_graph G /\ ~(graph_edge G e') /\ + (graph_edge G e) /\ + (!e''. graph_edge G e'' /\ ~(e'' = e) ==> + (e' INTER e'' SUBSET e INTER e'')) /\ + (simple_arc top2 e') /\ + (e INTER graph_vertex G = e' INTER graph_vertex G) ==> + plane_graph (graph_replace G e e')`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[graph_replace]; + IMATCH_MP_TAC plane_graph_mod; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC replace_inj; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + REWRITE_TAC[replace]; + TYPE_THEN `((e'' = e) \/ ~(e'' = e)) /\ ((e''' = e) \/ ~(e''' = e))` (fun t-> MP_TAC (TAUT t)); + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + REP_CASES_TAC THEN (FIRST_ASSUM (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN (ASSUME_TAC t))); + ASM_MESON_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [INTER_COMM]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET_REFL]; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + REWRITE_TAC[replace]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + REP_BASIC_TAC; + REWRITE_TAC[replace]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[]; + (* Sun Aug 22 10:28:15 EDT 2004 *) + + ]);; + (* }}} *) + +let good_replace = prove_by_refinement( + `!G e e'. (good_plane_graph G) /\ plane_graph (graph_replace G e e') /\ + ~(graph_edge G e') /\ + ( e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\ + (!v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ + ~(v = v') /\ e' v /\ e' v' ==> simple_arc_end e' v v') + ==> (good_plane_graph (graph_replace G e e'))`, + (* {{{ proof *) + [ + REWRITE_TAC[good_plane_graph;graph_replace]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i ;IMAGE ]); + REP_BASIC_TAC; + UND 6; + DISCH_THEN_FULL_REWRITE; + TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `e'''' = x` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `e''' = x` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + (* - *) + REWRITE_TAC[replace]; + COND_CASES_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UNDF `x`; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + UNDF `e INTER u = e' INTER u`; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[INTER;]); + ASM_REWRITE_TAC[]; + (* - *) + KILL 0; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Sun Aug 22 10:59:34 EDT 2004 *) + + ]);; + (* }}} *) + +let graph_replace_hv_finite_radius = prove_by_refinement( + `!G r e e'. graph_hv_finite_radius G r /\ ~(graph_edge G e') /\ + good_plane_graph (graph_replace G e e') /\ + (e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\ + (!v. graph_vertex G v /\ ~(e' v) ==> + ((e' INTER closed_ball (euclid 2,d_euclid) v r = {}))) /\ + (hv_finite e') + ==> graph_hv_finite_radius (graph_replace G e e') r`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_hv_finite_radius]; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + UND 7; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_replace ;graph_edge_mod_v]); + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]); + REP_BASIC_TAC; + UNDF `e''`; + DISCH_THEN_FULL_REWRITE; + REWRITE_TAC[replace]; + COND_CASES_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWR 13; + DISCH_TAC; + LEFT 10 "e'''"; + TSPEC `e` 10; + UND 10; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[INTER]; + KILL 1; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + LEFT 10 "e'''"; + TSPEC `x` 1; + REWR 1; + (* - *) + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]); + REP_BASIC_TAC; + UNDF `e''`; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `e''' = x` SUBGOAL_TAC; + TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INJ]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + (* - *) + REWRITE_TAC[replace]; + COND_CASES_TAC ; + UNDF `x`; + DISCH_THEN_FULL_REWRITE; + IMATCH_MP_TAC hv_finite_subset; + TYPE_THEN `e'` EXISTS_TAC; + ASM_REWRITE_TAC[INTER;SUBSET;]; + MESON_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Sun Aug 22 12:09:03 EDT 2004 *) + + ]);; + (* }}} *) + +let card_suc_insert = prove_by_refinement( + `!(x:A) s. FINITE s /\ (~(s x)) ==> (SUC (CARD s) = CARD(x INSERT s))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASM_SIMP_TAC [CARD_CLAUSES]; + ]);; + (* }}} *) + +let graph_replace_card = prove_by_refinement( + `!G e e'. + (FINITE (graph_edge (G:(A,(num->real)->bool)graph_t))) /\ + (graph_edge G e) /\ ~(graph_edge G e') /\ + ~(hv_finite e) /\ (hv_finite e') ==> + (CARD {x | graph_edge (graph_replace G e e') x /\ ~(hv_finite x)} < + CARD{ x | graph_edge G x /\ ~hv_finite x}) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC (ARITH_RULE `(SUC x = y) ==> (x <| y)`); + (* - *) + TYPE_THEN `FINITE (graph_edge (graph_replace G e e'))` SUBGOAL_TAC; + REWRITE_TAC[graph_edge_mod_e;graph_replace]; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `A = {x | graph_edge (graph_replace G e e') x /\ ~hv_finite x}` ABBREV_TAC ; + TYPE_THEN `FINITE A` SUBGOAL_TAC; + EXPAND_TAC "A"; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `graph_edge (graph_replace G e e')` EXISTS_TAC; + ASM_REWRITE_TAC[]; + EXPAND_TAC "A"; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `~A e` SUBGOAL_TAC; + EXPAND_TAC"A"; + REWRITE_TAC[]; + ASM_REWRITE_TAC[graph_replace;graph_edge_mod_e;IMAGE]; + DISCH_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[replace]); + UND 8; + COND_CASES_TAC; + ASM_MESON_TAC[]; + UND 8; + REWRITE_TAC[]; + MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `SUC (CARD A) = CARD(e INSERT A)` SUBGOAL_TAC; + IMATCH_MP_TAC card_suc_insert; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* - *) + AP_TERM_TAC; + EXPAND_TAC "A"; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[INSERT;graph_replace;graph_edge_mod_e;IMAGE;replace; ]; + EQ_TAC; + REP_BASIC_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + REP_BASIC_TAC; + UNDF `x = u`; + DISCH_THEN_FULL_REWRITE; + COND_CASES_TAC; + UNDF `x' = e`; + DISCH_THEN_FULL_REWRITE; + ASM_MESON_TAC[]; + REWR 10; + UNDF `x = e`; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + (* - *) + REP_BASIC_TAC; + TYPE_THEN `x = e` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let graph_edge_end_select_other = prove_by_refinement( + `!(G:(A,B)graph_t) e v. (graph G /\ graph_edge G e /\ + (graph_inc G e v) ==> + (?v'. (graph_inc G e v' /\ ~(v = v'))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TH_INTRO_TAC [`G`;`e`] graph_edge_end_select; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[has_size2]; + REP_BASIC_TAC; + UND 7; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[in_pair]); + REWRITE_TAC[in_pair]; + TYPE_THEN `(v'' = b)` ASM_CASES_TAC; + UNDF `v''`; + DISCH_THEN_FULL_REWRITE; + REWR 5; + UNDF`v'`; + DISCH_THEN_FULL_REWRITE; + ASM_MESON_TAC[]; + REWR 4; + UNDF`v''`; + DISCH_THEN_FULL_REWRITE; + REWR 5; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_rad_pt_select = prove_by_refinement( + `!G r e v. graph_hv_finite_radius G r /\ graph_inc G e v /\ + graph_edge G e ==> + (?C u. (hv_finite C) /\ (simple_arc_end C v u) /\ (euclid 2 u) /\ + (d_euclid v u = r) /\ (C SUBSET e) /\ (C SUBSET (closed_ball(euclid 2,d_euclid) v r))) `, + (* {{{ proof *) + [ + REWRITE_TAC[graph_hv_finite_radius]; + REP_BASIC_TAC; + (* - *) + TH_INTRO_TAC [`e`;`{v}`;`(euclid 2 DIFF (open_ball(euclid 2,d_euclid) v r))`] simple_arc_end_restriction; + (* -- *) + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE [good_plane_graph;plane_graph;SUBSET ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -- *) + TH_INTRO_TAC[`G`;`e`;`v`] graph_edge_end_select_other; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* -- *) + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + REP_BASIC_TAC; + IMATCH_MP_TAC simple_arc_end_end_closed; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -- *) + CONJ_TAC; + TH_INTRO_TAC [`top2`;`open_ball(euclid 2,d_euclid) v r`] open_closed; + REWRITE_TAC[top2_top]; + ASM_SIMP_TAC [top2;open_ball_open;metric_euclid;open_DEF ]; + REWRITE_TAC[top2_unions]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[INTER;DIFF;EQ_EMPTY;open_ball;INR IN_SING ]; + REP_BASIC_TAC; + UNDF `x = v`; + DISCH_THEN_FULL_REWRITE; + UNDF `x < r`; + ASM_REWRITE_TAC[]; + TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid]; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `v` EXISTS_TAC; + REWRITE_TAC[INTER;INR IN_SING]; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + REP_BASIC_TAC; + UNDF `graph_inc G e = y`; + DISCH_THEN (TH_INTRO_TAC [`e`]); + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[INTER]); + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `v'` EXISTS_TAC; + REWRITE_TAC[INTER]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + REP_BASIC_TAC; + UNDF `graph_inc G e = y`; + DISCH_THEN (TH_INTRO_TAC [`e`]); + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[INTER]); + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[DIFF]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TH_INTRO_TAC [`G`;`e`] graph_inc_subset; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[open_ball;DE_MORGAN_THM ]; + DISJ2_TAC; + DISJ2_TAC; + DISCH_TAC; + (* -- *) + TYPE_THEN `!v. graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC; + TH_INTRO_TAC [`G`;`e`] graph_inc_subset; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_TAC; + (* -- *) + TYPE_THEN `!v. graph_inc G e v ==> euclid 2 v` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + UND 4; + DISCH_THEN ( TH_INTRO_TAC [`v`;`v'`] ); + ASM_MESON_TAC []; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `v` EXISTS_TAC; + REWRITE_TAC[closed_ball]; + TYPE_THEN `euclid 2 v` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `euclid 2 v'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_MESON_TAC[metric_euclid]; + DISCH_THEN_REWRITE; + UND 5; + UND 9; + TYPE_THEN `d_euclid v v' = d_euclid v' v` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_symm; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_MESON_TAC[metric_euclid]; + DISCH_THEN_REWRITE; + REAL_ARITH_TAC; + (* A- *) + REP_BASIC_TAC; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `v''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `v' = v` SUBGOAL_TAC; + UND 8; + REWRITE_TAC[INTER;eq_sing;INR IN_SING ]; + MESON_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `euclid 2 v''` SUBGOAL_TAC; + FIRST_ASSUM MP_TAC; + REWRITE_TAC[INTER;DIFF;eq_sing;]; + DISCH_THEN_REWRITE; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `d_euclid v v'' = r` SUBGOAL_TAC; + IMATCH_MP_TAC disk_endpoint_outer; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + TH_INTRO_TAC [`C'`] simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + UND 9; + MESON_TAC[simple_arc_end_end]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* B- *) + TYPE_THEN `C' SUBSET closed_ball(euclid 2,d_euclid) v r` SUBGOAL_TAC; + UND 7; + REWRITE_TAC[SUBSET;closed_ball;INTER;open_ball;DIFF;eq_sing;INR IN_SING]; + REP_BASIC_TAC; + TYPE_THEN `!x. C' x ==> euclid 2 x` SUBGOAL_TAC; + REP_BASIC_TAC; + TH_INTRO_TAC[`C'`] simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `C' v` SUBGOAL_TAC; + UND 8; + REWRITE_TAC[INTER;INR IN_SING;eq_sing;]; + DISCH_THEN_REWRITE; + DISCH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `x = v''` ASM_CASES_TAC; + UNDF `x = v''`; + DISCH_THEN_FULL_REWRITE; + UND 12; + REAL_ARITH_TAC; + TSPEC `x` 13; + PROOF_BY_CONTR_TAC; + UND 19; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[DE_MORGAN_THM]; + DISJ2_TAC; + UND 20; + REAL_ARITH_TAC; + DISCH_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC hv_finite_subset; + TYPE_THEN `e INTER (closed_ball(euclid 2,d_euclid) v r)` EXISTS_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET_INTER]; + ASM_REWRITE_TAC[]; + (* Sun Aug 22 15:50:58 EDT 2004 *) + + ]);; + + (* }}} *) + +(* not needed here *) +let top_union = prove_by_refinement( + `!A B U. topology_ U /\ U A /\ U (B:A->bool) ==> U(A UNION B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[GSYM UNIONS_2]; + IMATCH_MP_TAC top_unions; + ASM_REWRITE_TAC[in_pair; SUBSET;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let top_closed_unions = prove_by_refinement( + `!(B:(A->bool)->bool) U. + topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==> + closed_ U(UNIONS B)`, + (* {{{ proof *) + [ + TYPE_THEN `!n (B:(A->bool)->bool) U. (CARD B = n) /\ topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==> closed_ U(UNIONS B)` SUBGOAL_TAC; + INDUCT_TAC; + REP_BASIC_TAC; + TYPE_THEN `B HAS_SIZE 0` SUBGOAL_TAC; + ASM_REWRITE_TAC[HAS_SIZE]; + REWRITE_TAC[HAS_SIZE_0]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC empty_closed; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* -- *) + TYPE_THEN `~(B = EMPTY)` SUBGOAL_TAC; + DISCH_TAC; + UNDF `EMPTY`; + DISCH_THEN_FULL_REWRITE; + UNDF `SUC`; + REWRITE_TAC[CARD_CLAUSES]; + ARITH_TAC; + DISCH_TAC; + (* -- *) + TH_INTRO_TAC [`B`] CARD_DELETE_CHOICE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USEF `SUC` SYM; + REWR 4; + RULE_ASSUM_TAC (REWRITE_RULE[SUC_INJ]); + TYPEL_THEN [`(B DELETE CHOICE B)`;`U`] (USE 0 o ISPECL); + UNDF `n`; + DISCH_THEN (TH_INTRO_TAC []); + ASM_REWRITE_TAC[FINITE_DELETE]; + UNDF `(SUBSET)`; + REWRITE_TAC[SUBSET;DELETE]; + MESON_TAC[]; + (* -- *) + DISCH_TAC; + TYPE_THEN `closed_ U( UNIONS (B DELETE CHOICE B) UNION (CHOICE B))` SUBGOAL_TAC; + IMATCH_MP_TAC closed_union; + ASM_REWRITE_TAC[]; + UND 1; + REWRITE_TAC[SUBSET]; + USEF `(~)` (MATCH_MP CHOICE_DEF); + UNDF `(IN)`; + REWRITE_TAC[]; + MESON_TAC[]; + ASM_MESON_TAC[unions_delete_choice]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let euclid2_d0 = prove_by_refinement( + `!x. (euclid 2 x) ==> (d_euclid x x = &0)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid]; + ]);; + (* }}} *) + +let union_imp_subset = prove_by_refinement( + `!(Z1:A->bool) Z2 A. (Z1 UNION Z2 = A) ==> + (Z1 SUBSET A /\ Z2 SUBSET A)`, + (* {{{ proof *) + [ + SET_TAC[UNION;SUBSET]; + ]);; + (* }}} *) + +let loc_path_conn_top2 = prove_by_refinement( + `loc_path_conn top2`, + (* {{{ proof *) + [ + REWRITE_TAC[top2]; + IMATCH_MP_TAC loc_path_conn_euclid; + TYPE_THEN `2` EXISTS_TAC; + MESON_TAC[metric_euclid;top_of_metric_top;top_of_metric_unions;top_univ]; + ]);; + (* }}} *) + +let connected_empty = prove_by_refinement( + `!U. connected (U:(A->bool)->bool) EMPTY `, + (* {{{ proof *) + [ + REWRITE_TAC[connected]; + ]);; + (* }}} *) + +let component_imp_connected = prove_by_refinement( + `!U (x:A). (topology_ U) ==> (connected U (component U x))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `~(UNIONS U x)` ASM_CASES_TAC; + UND 1; + ASM_SIMP_TAC[GSYM component_empty]; + REWRITE_TAC[connected_empty]; + REWR 1; + (* - *) + REWRITE_TAC[connected]; + CONJ_TAC; + REWRITE_TAC[SUBSET;connected;component]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `component U x x` SUBGOAL_TAC; + ASM_MESON_TAC[component_refl]; + DISCH_TAC; + (* - *) + TYPE_THEN `A x \/ B x` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET;UNION]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!A B. component U x SUBSET A UNION B /\ (A INTER B = EMPTY) /\ U B /\ U A /\ A x ==> component U x SUBSET A` SUBGOAL_TAC; + REP_BASIC_TAC; + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `B' x'` SUBGOAL_TAC; + USE 11 (REWRITE_RULE[SUBSET;UNION]); + TSPEC `x'` 11; + ASM_MESON_TAC[]; + DISCH_TAC; + USE 12 (REWRITE_RULE[component]); + REP_BASIC_TAC; + TYPE_THEN `Z SUBSET (component U x)` SUBGOAL_TAC; + IMATCH_MP_TAC connected_component; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 16 (REWRITE_RULE[connected]); + REP_BASIC_TAC; + TYPEL_THEN[`A'`;`B'`] (USE 16 o ISPECL); + UND 16; + ASM_REWRITE_TAC[]; + TYPE_THEN `Z SUBSET A' UNION B'` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `component U x` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + REWRITE_TAC[DE_MORGAN_THM]; + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + CONJ_TAC; + ASM_MESON_TAC[]; + USE 10 (REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + DISCH_THEN DISJ_CASES_TAC; + TYPEL_THEN[`A`;`B`] (USE 7 o ISPECL); + ASM_MESON_TAC[]; + TYPEL_THEN [`B`;`A`] (USE 7 o ISPECL); + REWR 7; + DISJ2_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ONCE_REWRITE_TAC[INTER_COMM]; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[UNION_COMM]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let open_induced = prove_by_refinement( + `!U (A:A->bool). (topology_ U) /\ U A ==> + (induced_top U A = { B | U B /\ B SUBSET A })`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[induced_top;IMAGE;]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[]; + GEN_TAC; + EQ_TAC; + REP_BASIC_TAC; + FIRST_ASSUM MP_TAC ; + DISCH_THEN_FULL_REWRITE; + CONJ_TAC; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER;SUBSET]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 2; + SET_TAC [INTER;SUBSET]; + ]);; + (* }}} *) + +let connected_induced = prove_by_refinement( + `!U (C:A->bool) . (topology_ U /\ U C ) ==> + (connected U C = connected (induced_top U C) C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[connected]; + ASM_SIMP_TAC[open_induced]; + EQ_TAC; + REP_BASIC_TAC; + CONJ_TAC; + IMATCH_MP_TAC sub_union; + ASM_REWRITE_TAC[SUBSET_REFL ]; + REP_BASIC_TAC; + TYPEL_THEN [`A`;`B`] (USE 2 o ISPECL); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + REP_BASIC_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS {B | U B /\ B SUBSET C}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC UNIONS_UNIONS; + ONCE_REWRITE_TAC[SUBSET]; + REWRITE_TAC[]; + MESON_TAC[]; + (* - *) + REP_BASIC_TAC; + TYPEL_THEN[`A INTER C`;`B INTER C`] (USE 2 o ISPECL); + REWR 2; + UND 2; + DISCH_THEN (TH_INTRO_TAC []); + TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWRITE_TAC[GSYM CONJ_ASSOC]; + CONJ_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER_SUBSET]; + CONJ_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + UND 5; + SET_TAC[INTER]; + UND 4; + SET_TAC[SUBSET;UNION;INTER]; + SET_TAC[INTER;SUBSET]; + ]);; + (* }}} *) + +let connected_induced2 = prove_by_refinement( + `!U (C:A->bool) Z. (topology_ U /\ U C /\ Z SUBSET (UNIONS U)) ==> + (connected (induced_top U C) Z <=> (Z SUBSET C) /\ (connected U Z))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[connected]; + ASM_SIMP_TAC[open_induced]; + EQ_TAC; + REP_BASIC_TAC; + SUBCONJ_TAC; + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + USE 4(REWRITE_RULE[SUBSET;UNIONS]); + TSPEC `x` 4; + REWR 4; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REP_BASIC_TAC; + TYPEL_THEN [`A INTER C`;`B INTER C`] (USE 3 o ISPECL); + REWR 3; + UND 3; + DISCH_THEN (TH_INTRO_TAC []); + TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC; + REP_BASIC_TAC; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWRITE_TAC[GSYM CONJ_ASSOC]; + CONJ_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER_SUBSET]; + CONJ_TAC; + ASM_MESON_TAC[]; + CONJ_TAC; + UND 7; + SET_TAC[INTER]; + UND 6; + UND 5; + SET_TAC[INTER;SUBSET;UNION]; + UND 5; + SET_TAC[INTER;SUBSET;UNION]; + REP_BASIC_TAC; + (* - *) + CONJ_TAC; + UND 0; + REWRITE_TAC[SUBSET;UNIONS]; + REP_BASIC_TAC; + TSPEC `x` 5; + REWR 5; + REP_BASIC_TAC; + TYPE_THEN `u INTER C` EXISTS_TAC; + REWRITE_TAC[GSYM CONJ_ASSOC]; + CONJ_TAC; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER]; + ASM_MESON_TAC[ISUBSET ]; + (* - *) + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let connected_metric = prove_by_refinement( + `!X d (C:A->bool). metric_space (X,d) /\ C SUBSET X /\ + (top_of_metric(X,d)C) ==> + (connected(top_of_metric(X,d))C <=> connected(top_of_metric(C,d))C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d))C` SUBGOAL_TAC; + ASM_MESON_TAC[top_of_metric_induced]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC connected_induced; + ASM_MESON_TAC[top_of_metric_top]; + ]);; + (* }}} *) + +let connected_metric_pair = prove_by_refinement( + `!(X:A->bool) Y Z d. metric_space (X,d) /\ + top_of_metric(X,d) Y /\ top_of_metric(X,d) Z /\ + Z SUBSET Y ==> + (connected (top_of_metric(X,d)) Z = connected (top_of_metric(Y,d)) Z)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* - *) + TYPE_THEN `Y SUBSET X` SUBGOAL_TAC; + USE 2(MATCH_MP sub_union); + UND 2; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_TAC; + (* - *) + TYPE_THEN `Z SUBSET X` SUBGOAL_TAC ; + ASM_MESON_TAC[SUBSET_TRANS]; + DISCH_TAC; + ASM_SIMP_TAC[connected_metric]; + (* - *) + TYPE_THEN `metric_space (Y,d)` SUBGOAL_TAC; + ASM_MESON_TAC[metric_subspace]; + DISCH_TAC; + (* - *) + TYPE_THEN `top_of_metric(Y,d) = induced_top(top_of_metric(X,d)) Y` SUBGOAL_TAC; + ASM_MESON_TAC[top_of_metric_induced]; + DISCH_TAC; + TYPE_THEN `top_of_metric(Y,d) Z` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[open_induced;top_of_metric_top]; + DISCH_TAC; + ASM_SIMP_TAC[connected_metric]; + ]);; + (* }}} *) + +let construct_hv_finite = prove_by_refinement( + `!A C v v'. (top2 A) /\ (C SUBSET A) /\ (simple_arc_end C v v') ==> + (?C'. C' SUBSET A /\ simple_arc_end C' v v' /\ hv_finite C')`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `A' = path_component(top_of_metric(A,d_euclid)) v` ABBREV_TAC ; + TYPE_THEN `A' = component (top_of_metric(A,d_euclid)) v` SUBGOAL_TAC; + EXPAND_TAC "A'"; + AP_THM_TAC; + IMATCH_MP_TAC loc_path_euclid_cor ; + TYPE_THEN `2` EXISTS_TAC; + ASM_REWRITE_TAC[GSYM top2]; + DISCH_TAC; + (* - *) + TYPE_THEN `A SUBSET (euclid 2)` SUBGOAL_TAC; + USEF `top2` (MATCH_MP sub_union ); + RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN`UNIONS (top_of_metric(A,d_euclid)) = A` SUBGOAL_TAC; + ASM_MESON_TAC [GSYM top_of_metric_unions;metric_euclid;metric_subspace]; + DISCH_TAC; + (* - *) + TYPE_THEN `A' SUBSET (UNIONS (top_of_metric(A,d_euclid)))` SUBGOAL_TAC; + ASM_MESON_TAC[component_unions]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `A' SUBSET (euclid 2)` SUBGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `A` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + ASSUME_TAC loc_path_conn_top2 ; + (* - *) + TYPE_THEN `A v` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + UND 1; + DISCH_THEN IMATCH_MP_TAC ; + UND 0; + MESON_TAC[simple_arc_end_end]; + DISCH_TAC; + (* - *) + TYPE_THEN `top_of_metric(A,d_euclid) = induced_top top2 A` SUBGOAL_TAC; + REWRITE_TAC[top2]; + UND 5; + SIMP_TAC [metric_euclid;top_of_metric_induced ]; + DISCH_TAC; + (* - *) + TYPE_THEN `top2 A'` SUBGOAL_TAC; + EXPAND_TAC "A'"; + UND 11; + DISCH_THEN_REWRITE; + USE 9 (REWRITE_RULE[ loc_path_conn]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `~(v = v')` SUBGOAL_TAC; + UND 0; + ASM_MESON_TAC[simple_arc_end_distinct]; + DISCH_TAC; + (* A' - *) + TYPE_THEN `connected (top_of_metric(A,d_euclid)) A'` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC component_imp_connected; + ASM_MESON_TAC[top_of_metric_top;metric_subspace;metric_euclid]; + DISCH_TAC; + (* - *) + TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) A'` SUBGOAL_TAC; + TH_INTRO_TAC [`euclid 2`;`A`;`A'`;`d_euclid`] connected_metric_pair; + ASM_MESON_TAC [metric_euclid;GSYM top2]; + DISCH_THEN_REWRITE; + ASM_MESON_TAC[]; + REWRITE_TAC[GSYM top2]; + DISCH_TAC; + (* - *) + TYPE_THEN `connected top2 C` SUBGOAL_TAC; + IMATCH_MP_TAC simple_arc_connected; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `C SUBSET A'` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC connected_component; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\a`); + CONJ_TAC; + UND 0; + MESON_TAC[simple_arc_end_end]; + TH_INTRO_TAC[`top2`;`A`;`C`] connected_induced2; + REWRITE_TAC[top2_top;top2_unions]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[SUBSET_TRANS]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `C v /\ C v'` SUBGOAL_TAC; + UND 0; + MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + DISCH_TAC; + TYPE_THEN `A' v /\ A' v'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + DISCH_TAC; + (* - *) + TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_conn; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_hv_finite; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + REP_BASIC_TAC; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `A'` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_rad_pt_center_piece = prove_by_refinement( + `!G r e v v'. + graph_hv_finite_radius G r /\ graph_inc G e v /\ + FINITE(graph_edge G) /\ FINITE(graph_vertex G) /\ + graph_edge G e /\ graph_inc G e v' /\ ~(v = v') ==> + (? Cv u Cv' u' C''. + (hv_finite Cv /\ hv_finite Cv' /\ (hv_finite C'') /\ + ~(graph_vertex G u) /\ + ~(graph_vertex G u') /\ + simple_arc_end Cv v u /\ + simple_arc_end Cv' v' u' /\ + simple_arc_end C'' u u' /\ + ~C'' v /\ ~C'' v' /\ + (euclid 2 u) /\ (euclid 2 u') /\ + (d_euclid v u = r) /\ (d_euclid v' u' = r) /\ + (Cv SUBSET e) /\ (Cv' SUBSET e) /\ + (Cv SUBSET (closed_ball(euclid 2,d_euclid) v r)) /\ + (Cv' SUBSET (closed_ball(euclid 2,d_euclid) v' r)) /\ + (!e'. (graph_edge G e') /\ ~(e = e') ==> (C'' INTER e' = EMPTY)) /\ + (!v''. graph_vertex G v'' /\ ~(graph_inc G e v'') ==> + (C'' INTER (closed_ball(euclid 2,d_euclid) v'' r) = EMPTY)) + ))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TH_INTRO_TAC [`G`;`r`;`e`;`v`] graph_rad_pt_select; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `Cv = C` ABBREV_TAC ; + KILL 13; + TYPE_THEN `Cv` EXISTS_TAC; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TH_INTRO_TAC [`G`;`r`;`e`;`v'`] graph_rad_pt_select; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `Cv' = C'` ABBREV_TAC ; + KILL 19; + TYPE_THEN `Cv'` EXISTS_TAC; + TYPE_THEN `u'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* A' *) + TYPE_THEN `!v''. graph_vertex G v'' ==> (euclid 2 v'')` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;SUBSET ]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `!v''. graph_inc G e v'' ==> graph_vertex G v''` SUBGOAL_TAC; + REP_BASIC_TAC; + TH_INTRO_TAC [`G`;`e`] graph_inc_subset; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]); + ASM_REWRITE_TAC[SUBSET ]; + FIRST_ASSUM MP_TAC; + MESON_TAC[ISUBSET]; + DISCH_TAC; + (* - *) + TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ; + TYPE_THEN `B = (UNIONS { e' | graph_edge G e' /\ ~(e' = e)})` ABBREV_TAC ; + TYPE_THEN `B' = (UNIONS { DD | ?v''. (graph_vertex G v'' /\ (DD = D v'') /\ ~(graph_inc G e v''))})` ABBREV_TAC ; + TYPE_THEN `B'' = {v, v'}` ABBREV_TAC ; + TYPE_THEN `A = (euclid 2 DIFF (B UNION B' UNION B''))` ABBREV_TAC ; + TYPE_THEN `top2 A` SUBGOAL_TAC; + TH_INTRO_TAC [`top2`;`B UNION B' UNION B''`] closed_open; + IMATCH_MP_TAC closed_union; + REWRITE_TAC[top2_top]; + EXPAND_TAC "B"; + EXPAND_TAC "B'"; + EXPAND_TAC "B''"; + CONJ_TAC; + IMATCH_MP_TAC top_closed_unions; + REWRITE_TAC[top2_top;SUBSET;]; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `graph_edge G` EXISTS_TAC ; + ASM_REWRITE_TAC[SUBSET]; + MESON_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]); + REP_BASIC_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + TH_INTRO_TAC [`G`;`x`] graph_edge_end_select; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + (* --- *) + IMATCH_MP_TAC closed_union; + REWRITE_TAC[top2_top]; + CONJ_TAC; + IMATCH_MP_TAC top_closed_unions; + REWRITE_TAC[top2_top]; + CONJ_TAC; + TYPE_THEN `{DD | ?v''. graph_vertex G v'' /\ (DD = D v'') /\ ~graph_inc G e v''} = IMAGE D { v'' | graph_vertex G v'' /\ ~graph_inc G e v''}` SUBGOAL_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `graph_vertex G` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET ]; + MESON_TAC[]; + REWRITE_TAC[SUBSET]; + REP_BASIC_TAC; + UNDF `x = D v''`; + DISCH_THEN_FULL_REWRITE; + EXPAND_TAC "D"; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + REWRITE_TAC[metric_euclid]; + (* --- *) + TYPE_THEN `{v,v'} = {v} UNION {v'}` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[in_pair;UNION;INR IN_SING]; + MESON_TAC[]; + DISCH_THEN_REWRITE; + IMATCH_MP_TAC closed_union; + REWRITE_TAC[top2_top]; + TYPE_THEN `graph_inc G e v` (FIND_ASSUM MP_TAC); + TYPE_THEN `graph_inc G e v'` (FIND_ASSUM MP_TAC); + ASM_MESON_TAC[closed_point]; + REWRITE_TAC[open_DEF;top2_unions]; + EXPAND_TAC "A"; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* B' *) + TYPE_THEN `!u'' v''. graph_vertex G v'' /\ (d_euclid v'' u'' = r) ==> ~(graph_vertex G u'')` SUBGOAL_TAC; + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + TYPEL_THEN [`u''`;`v''`] (USE 31 o ISPECL); + TYPE_THEN `~(u'' = v'')` SUBGOAL_TAC; + DISCH_TAC; + POP_ASSUM MP_TAC; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `d_euclid v'' v'' = &0` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + UNDF `&0 = r`; + UNDF `&0 < r`; + REAL_ARITH_TAC; + DISCH_TAC; + UNDF `(graph_vertex)`; + ASM_REWRITE_TAC[EMPTY_EXISTS ;INTER ;closed_ball ;]; + TYPE_THEN `u''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `d_euclid u'' u'' = &0` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_zero; + TYPE_THEN `euclid 2` EXISTS_TAC; + ASM_REWRITE_TAC[metric_euclid]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `euclid 2 u'' ` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `euclid 2 v'' ` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + UNDF `&0 < r`; + REAL_ARITH_TAC; + DISCH_TAC; + (* B1'- *) + TYPE_THEN `~graph_vertex G u` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~graph_vertex G u'` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `v'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + (* C' *) + TYPE_THEN `!(X:A->bool) Y Z. (X UNION Y = Z) ==> (X SUBSET Z)` SUBGOAL_TAC; + SET_TAC[UNION;SUBSET]; + DISCH_TAC; + (* - *) + TYPE_THEN `simple_arc_end e v v'` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE [graph_hv_finite_radius;good_plane_graph]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `graph_vertex G v` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `graph_vertex G v'` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `~D v u'` SUBGOAL_TAC; + EXPAND_TAC "D"; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]); + REP_BASIC_TAC; + GRABF `~(v = v')` (TH_INTRO_TAC [`v`;`v'`]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u'` EXISTS_TAC; + ASM_REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[closed_ball]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + (* C1'- *) + TYPE_THEN `~(v = u) /\ ~(v = u')` SUBGOAL_TAC; + CONJ_TAC; + DISCH_TAC; + POP_ASSUM MP_TAC; + DISCH_THEN_FULL_REWRITE; + TH_INTRO_TAC[`u`] euclid2_d0; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UNDF `&0 < r`; + UNDF `&0 = r`; + REAL_ARITH_TAC; + DISCH_TAC; + POP_ASSUM MP_TAC; + DISCH_THEN_FULL_REWRITE; + POP_ASSUM MP_TAC; + EXPAND_TAC "D"; + REWRITE_TAC[closed_ball]; + ASM_REWRITE_TAC[]; + TH_INTRO_TAC [`u'`] euclid2_d0; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UNDF `&0 < r`; + REAL_ARITH_TAC; + DISCH_TAC; + (* - *) + TYPE_THEN `~(v' = u') ` SUBGOAL_TAC; + DISCH_TAC; + POP_ASSUM MP_TAC; + DISCH_THEN_FULL_REWRITE; + TH_INTRO_TAC[`u'`] euclid2_d0; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UNDF `&0 < r`; + UNDF `&0 = r`; + REAL_ARITH_TAC; + DISCH_TAC; + (* - *) + TH_INTRO_TAC [`e`;`v`;`v'`;`u'`] simple_arc_end_cut; + ASM_REWRITE_TAC[]; + TYPE_THEN `Cv' u'` SUBGOAL_TAC; + TYPE_THEN `simple_arc_end Cv' v' u'` (FIND_ASSUM MP_TAC ); + MESON_TAC[simple_arc_end_end2]; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `Cvu' = C''` ABBREV_TAC ; + POP_ASSUM (fun t-> ALL_TAC); + TYPE_THEN `Cu'v' = C'''` ABBREV_TAC ; + POP_ASSUM (fun t -> ALL_TAC); + TYPE_THEN `Cu'v' v'` SUBGOAL_TAC; + TYPE_THEN `simple_arc_end Cu'v' u' v'` (FIND_ASSUM MP_TAC ); + MESON_TAC[simple_arc_end_end2]; + DISCH_TAC; + TYPE_THEN `~Cvu' v'` SUBGOAL_TAC; + DISCH_TAC; + USEF `(INTER)` (REWRITE_RULE[FUN_EQ_THM]); + TSPEC `v'` 37; + RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing ;INR IN_SING]); + UND 37; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `~D v' u` SUBGOAL_TAC; + EXPAND_TAC "D"; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]); + REP_BASIC_TAC; + GRABF `~(v' = v)` (TH_INTRO_TAC [`v'`;`v`]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[closed_ball]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; + (* D'- *) + TYPE_THEN `Cvu' u \/ Cu'v' u` SUBGOAL_TAC; + USE 35 (REWRITE_RULE[FUN_EQ_THM;]); + TSPEC `u` 35 ; + USE 35 (REWRITE_RULE[UNION]); + ASM_REWRITE_TAC[]; + USE 8(REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 11; + MESON_TAC[simple_arc_end_end2]; + DISCH_TAC; + (* - *) + USE 35 (MATCH_MP union_imp_subset); + TYPE_THEN `Cu'v' = Cv'` SUBGOAL_TAC; + TH_INTRO_TAC [`Cu'v'`;`Cv'`;`e`;`v'`;`u'`] simple_arc_end_inj; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + DISCH_THEN_FULL_REWRITE; + (* - *) + TYPE_THEN `~Cv' u` SUBGOAL_TAC; + DISCH_TAC; + UNDF `~D v' u` ; + REWRITE_TAC[]; + EXPAND_TAC "D"; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 45; + (* - *) + TYPE_THEN `~(u = u')` SUBGOAL_TAC; + DISCH_TAC; + UND 47; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + GRABF `~(v=v')` (TH_INTRO_TAC[`v`;`v'`]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u'` EXISTS_TAC; + REWRITE_TAC[INTER;closed_ball]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `r <= r`]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TH_INTRO_TAC[`Cvu'`;`v`;`u'`;`u`] simple_arc_end_cut; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `CC = C'''''` ABBREV_TAC ; + POP_ASSUM (fun t->ALL_TAC); + (* E' *) + TYPE_THEN `~CC v` SUBGOAL_TAC; + DISCH_TAC; + TYPE_THEN `C'''' v` SUBGOAL_TAC; + UND 50; + MESON_TAC[simple_arc_end_end]; + DISCH_TAC; + TYPE_THEN `v = u` SUBGOAL_TAC; + UND 48; + REWRITE_TAC[INTER;eq_sing;INR IN_SING]; + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_THEN_FULL_REWRITE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `~CC v'` SUBGOAL_TAC; + DISCH_TAC; + USE 35 (MATCH_MP union_imp_subset); + UND 43; + REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `CC SUBSET A` SUBGOAL_TAC; + EXPAND_TAC "A"; + REWRITE_TAC[DIFF_SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + UND 49; + MESON_TAC[]; + PROOF_BY_CONTR_TAC; + USE 55 (MATCH_MP inter_union); + FIRST_ASSUM MP_TAC; + REWRITE_TAC[]; + REWRITE_TAC[DE_MORGAN_THM]; + TYPE_THEN `CC SUBSET e` SUBGOAL_TAC; + USE 35 (MATCH_MP union_imp_subset); + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Cvu'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_TAC; + (* -- *) + CONJ_TAC; + EXPAND_TAC"B"; + REWRITE_TAC[INTER;UNIONS;EQ_EMPTY ]; + REP_BASIC_TAC; + TYPE_THEN `e x` SUBGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + REP_BASIC_TAC ; (* we are up to 69 in the hypothesis stack *) + TYPEL_THEN [`e`;`u''`] (USE 66 o ISPECL); + REWR 66; + TYPE_THEN `graph_vertex G x` SUBGOAL_TAC; + USE 66 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[INTER]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* --- *) + TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge2; + ASM_REWRITE_TAC[]; + TYPE_THEN `graph_inc G e x` SUBGOAL_TAC; + ASM_SIMP_TAC[]; + ASM_REWRITE_TAC[INTER]; + REP_BASIC_TAC; + TH_INTRO_TAC [`graph_inc G e`;`v`;`x`;`v'`] two_exclusion; + ASM_REWRITE_TAC[]; + UND 60; + UND 54; + MESON_TAC[]; + UND 60; + UND 53; + MESON_TAC[]; + (* -- *) + PROOF_BY_CONTR_TAC; + USE 57 (MATCH_MP inter_union); + UND 57; + REWRITE_TAC[DE_MORGAN_THM]; + CONJ_TAC; + EXPAND_TAC "B'"; + REWRITE_TAC[INTER;UNIONS;]; + REWRITE_TAC [EQ_EMPTY]; + REP_BASIC_TAC; + UNDF `u''' = D v''` ; + DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + TYPEL_THEN [`e`;`v''`] (USE 59 o ISPECL); + REWR 59; + UND 59; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `x` EXISTS_TAC; + REWRITE_TAC[INTER]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 57; + EXPAND_TAC "D"; + DISCH_THEN_REWRITE; + (* -- *) + EXPAND_TAC "B''"; + REWRITE_TAC[INTER;EQ_EMPTY;in_pair]; + ASM_MESON_TAC[]; + DISCH_TAC; + (* F' *) + TH_INTRO_TAC[`A`;`CC`;`u`;`u'`] construct_hv_finite; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `Chv = C''''''` ABBREV_TAC ; + KILL 59; + TYPE_THEN `Chv` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~(A v) /\ ~(A v')` SUBGOAL_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B''"; + REWRITE_TAC[DIFF;UNION;in_pair]; + DISCH_TAC; + TYPE_THEN `~(Chv v) /\ ~(Chv v')` SUBGOAL_TAC; + UND 59; + UND 58; + MESON_TAC[ISUBSET]; + DISCH_THEN_REWRITE; + (* - *) + TYPE_THEN `(!e'. ~(e = e') /\ (graph_edge G e') ==> (A INTER e' = {}))` SUBGOAL_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B"; + REP_BASIC_TAC; + REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS ]; + REP_BASIC_TAC; + LEFT 64 "u"; + LEFT 64 "u"; + TSPEC `e'` 64; + UND 64; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + CONJ_TAC; + REP_BASIC_TAC; + TSPEC `e'` 60; + REWR 60; + UND 60; + UND 58; + REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;]; + MESON_TAC[]; + (* - *) + TYPE_THEN `!v''. graph_vertex G v'' /\ ~graph_inc G e v'' ==> (A INTER closed_ball (euclid 2,d_euclid) v'' r = {})` SUBGOAL_TAC; + REP_BASIC_TAC; + EXPAND_TAC "A"; + EXPAND_TAC "B'"; + REP_BASIC_TAC; + REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS;]; + EXPAND_TAC "D"; + REP_BASIC_TAC; + UND 65; + REWRITE_TAC[]; + DISJ2_TAC; + DISJ1_TAC; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `v''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TSPEC `v''` 62; + REWR 62; + UND 62; + UND 58; + REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;]; + MESON_TAC[]; + (* Wed Aug 25 14:58:37 EDT 2004 *) + + + ]);; + (* }}} *) + +let planar_graph_hv = prove_by_refinement( + `!(G:(A,B)graph_t). (planar_graph G) /\ + FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) + ==> (?H. graph_isomorphic G H /\ + good_plane_graph H /\ (!e. graph_edge H e ==> + hv_finite e))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TH_INTRO_TAC[`G`] graph_radius_exists; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + (* - *) + TYPE_THEN `X = { K | graph_isomorphic H K /\ graph_hv_finite_radius K r}` ABBREV_TAC ; + TYPE_THEN `c = (\ (K:(num->real,(num->real)->bool)graph_t). CARD {x | graph_edge K x /\ ~hv_finite x})` ABBREV_TAC ; + TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ; + TH_INTRO_TAC[`X`;`c`] select_image_num_min; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `H` EXISTS_TAC; + EXPAND_TAC "X"; + REWRITE_TAC[]; + ASM_REWRITE_TAC[graph_isomorphic_refl]; + REP_BASIC_TAC; + TYPE_THEN `K = z` ABBREV_TAC ; + KILL 12; + TYPE_THEN `K` EXISTS_TAC; + CONJ_TAC; + UND 11; + EXPAND_TAC "X"; + REWRITE_TAC[]; + ASM_MESON_TAC[graph_isomorphic_trans]; + (* - *) + TYPE_THEN `graph_hv_finite_radius K r` SUBGOAL_TAC; + UND 11; + EXPAND_TAC "X"; + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* - *) + CONJ_TAC; + UND 12; + REWRITE_TAC[graph_hv_finite_radius]; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + (* - *) + TH_INTRO_TAC[`K`;`e`] graph_edge_end_select; + ASM_REWRITE_TAC[]; + UND 12; + REWRITE_TAC[graph_hv_finite_radius;good_plane_graph;plane_graph]; + DISCH_THEN_REWRITE; + REP_BASIC_TAC; + (* A *) + TYPE_THEN `graph_isomorphic G K` SUBGOAL_TAC; + TH_INTRO_TAC[`G`;`H`;`K`] graph_isomorphic_trans; + ASM_REWRITE_TAC[]; + UND 11; + EXPAND_TAC "X"; + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* - *) + TYPE_THEN `FINITE (graph_edge K)` SUBGOAL_TAC; + USE 18(REWRITE_RULE[graph_isomorphic;graph_iso]); + REP_BASIC_TAC; + UND 19; + UND 3; + MESON_TAC[FINITE_BIJ]; + DISCH_TAC; + (* - *) + TYPE_THEN `~(? e' . (~graph_edge K e') /\ hv_finite e' /\ simple_arc_end e' v v' /\ (e INTER (graph_vertex K) = (e' INTER (graph_vertex K))) /\ (!v. graph_vertex K v /\ ~e' v ==> (e' INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ (!e''. graph_edge K e'' /\ ~(e'' = e) ==> e' INTER e'' SUBSET e INTER e''))` SUBGOAL_TAC; + DISCH_TAC; + REP_BASIC_TAC; + (* -- *) + TH_INTRO_TAC[`K`;`e`;`e'`] graph_replace_card; + ASM_REWRITE_TAC[]; + TYPE_THEN `K' = graph_replace K e e'` ABBREV_TAC ; + DISCH_TAC; + TYPE_THEN `graph_isomorphic H K'` SUBGOAL_TAC; + EXPAND_TAC "X"; + EXPAND_TAC "K'"; + REWRITE_TAC[]; + TH_INTRO_TAC[`H`;`K`;`K'`] graph_isomorphic_trans; + ASM_REWRITE_TAC[]; + UND 11; + EXPAND_TAC "X"; + REWRITE_TAC[]; + DISCH_THEN_REWRITE; + EXPAND_TAC "K'"; + IMATCH_MP_TAC graph_replace_iso; + ASM_REWRITE_TAC[]; + EXPAND_TAC "K'"; + DISCH_THEN_REWRITE; + DISCH_TAC; + (* -- *) + TYPE_THEN `plane_graph K'` SUBGOAL_TAC; + EXPAND_TAC "K'"; + IMATCH_MP_TAC graph_replace_plane; + ASM_REWRITE_TAC[]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `good_plane_graph K'` SUBGOAL_TAC; + EXPAND_TAC "K'"; + IMATCH_MP_TAC good_replace; + ASM_REWRITE_TAC[]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `e v'' /\ e v'''` SUBGOAL_TAC; + USE 22 (REWRITE_RULE[FUN_EQ_THM]); + TYPE_THEN `v''` (WITH 22 o ISPEC); + TYPE_THEN `v'''` (USE 22 o ISPEC); + RULE_ASSUM_TAC (REWRITE_RULE[INTER]); + UND 22; + UND 35; + UND 33; + UND 34; + DISCH_THEN_REWRITE; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + MESON_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC; + IMATCH_MP_TAC graph_vertex_exhaust; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `graph_inc K e = {v'',v'''}` SUBGOAL_TAC; + IMATCH_MP_TAC graph_vertex_exhaust; + USE 37 (SYM); + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + TSPEC `e` 46; + REWR 46; + ASM_REWRITE_TAC[INTER]; + DISCH_THEN_FULL_REWRITE; + TYPE_THEN `((v'' = v) /\ (v''' = v')) \/ ((v'' = v') /\ (v''' = v))` SUBGOAL_TAC; + USE 37 (REWRITE_RULE[FUN_EQ_THM]); + TYPE_THEN `v''` (WITH 37 o ISPEC); + TYPE_THEN `v'''` (USE 37 o ISPEC); + UND 37; + UND 38; + REWRITE_TAC[in_pair]; + UND 32; + UND 15; + MESON_TAC[]; + DISCH_THEN DISJ_CASES_TAC; + REP_BASIC_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* -- *) + TYPE_THEN `graph_hv_finite_radius K' r` SUBGOAL_TAC; + EXPAND_TAC "K'"; + IMATCH_MP_TAC graph_replace_hv_finite_radius; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `X K'` SUBGOAL_TAC; + EXPAND_TAC "X"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TSPEC `K'` 10; + REWR 10; + UND 10; + EXPAND_TAC "c"; + UND 27; +(**** Changed by JRH; the new ARITH_TAC doesn't accept alpha-equivs (maybe) + ARITH_TAC; + ****) + REWRITE_TAC[NOT_IMP; NOT_LE]; + REWRITE_TAC[]; + (* B *) + TH_INTRO_TAC [`K`;`r`;`e`;`v`;`v'`] graph_rad_pt_center_piece; + ASM_REWRITE_TAC[]; + USE 18 (REWRITE_RULE[graph_isomorphic;graph_iso]); + REP_BASIC_TAC; + UND 21; + UND 2; + MESON_TAC[FINITE_BIJ]; + REP_BASIC_TAC; + KILL 4; + KILL 3; + KILL 2; + KILL 1; + KILL 0; + KILL 6; + KILL 5; + KILL 7; + KILL 8; + KILL 11; + KILL 10; + KILL 18; + KILL 19; + TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC; + IMATCH_MP_TAC graph_vertex_exhaust; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `e INTER graph_vertex K = {v,v'}` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + REP_BASIC_TAC; + TSPEC `e` 7; + REWR 7; + ASM_REWRITE_TAC[]; + DISCH_THEN_REWRITE; + (* C- *) + TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC; + REP_BASIC_TAC; + TH_INTRO_TAC[`K`;`e'`] graph_inc_subset; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `p_conn (Cv UNION Cv' UNION C'') v v'` SUBGOAL_TAC; + IMATCH_MP_TAC pconn_trans; + TYPE_THEN `u` EXISTS_TAC; + CONJ_TAC; + TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`u`] p_conn_hv_finite; + IMATCH_MP_TAC simple_arc_end_distinct; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `Cv` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + IMATCH_MP_TAC pconn_trans; + TYPE_THEN `u'` EXISTS_TAC; + CONJ_TAC; + TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u`;`u'`] p_conn_hv_finite; + IMATCH_MP_TAC simple_arc_end_distinct; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `C''` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u'`;`v'`] p_conn_hv_finite; + IMATCH_MP_TAC simple_arc_end_distinct; + TYPE_THEN `Cv'` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_MESON_TAC[]; + DISCH_THEN_REWRITE; + TYPE_THEN `Cv'` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`v'`] p_conn_hv_finite; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* D final constraints *) + TYPE_THEN`graph K` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC; + REP_BASIC_TAC; + TH_INTRO_TAC[`K`;`e'`]graph_inc_subset; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* - *) + CONJ_TAC; + DISCH_TAC; + TYPE_THEN `C = e` ASM_CASES_TAC; + ASM_MESON_TAC[]; + TSPEC `C` 21; + REWR 11; + TYPE_THEN `C SUBSET Cv UNION Cv'` SUBGOAL_TAC; + UND 11; + UND 4; + REWRITE_TAC[SUBSET;UNION;EQ_EMPTY;INTER ]; + MESON_TAC[]; + DISCH_TAC; + TYPE_THEN `D v INTER D v' = EMPTY ` SUBGOAL_TAC; + EXPAND_TAC "D"; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UND 21; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + DISCH_TAC; + (* -- *) + UND 10; + REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + SUBCONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]); + REP_BASIC_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Cv UNION Cv'` EXISTS_TAC; + ASM_REWRITE_TAC[union_subset ]; + (* E *) + CONJ_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[in_pair;INTER ]; + GEN_TAC; + EQ_TAC; + DISCH_THEN DISJ_CASES_TAC; + UND 8; + DISCH_THEN_FULL_REWRITE; + CONJ_TAC; + UND 3; + MESON_TAC[simple_arc_end_end2]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + UND 8; + DISCH_THEN_FULL_REWRITE; + CONJ_TAC; + UND 3; + MESON_TAC[simple_arc_end_end]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `graph_inc K e x` ASM_CASES_TAC; + REWR 8; + RULE_ASSUM_TAC (REWRITE_RULE[in_pair]); + ASM_REWRITE_TAC[]; + USE 4 (REWRITE_RULE[SUBSET ]); + REP_BASIC_TAC; + TSPEC `x` 4; + REWR 4; + USE 4(REWRITE_RULE[UNION]); + UND 4; + REP_CASES_TAC; + DISJ2_TAC; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UND 40; + DISCH_THEN (TH_INTRO_TAC[`v`;`x`]); + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `x` EXISTS_TAC; + REWRITE_TAC[INTER]; + CONJ_TAC; + UND 4; + UND 23; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + REWRITE_TAC[closed_ball2_center]; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + REP_BASIC_TAC; + CONJ_TAC; + USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UNDF `&0 < r`; + REAL_ARITH_TAC; + (* --- *) + DISJ1_TAC; + PROOF_BY_CONTR_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UNDF `~(v = v')`; + DISCH_THEN (TH_INTRO_TAC[`v'`;`x`]); + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `x` EXISTS_TAC; + REWRITE_TAC[INTER]; + CONJ_TAC; + UND 4; + UND 22; + REWRITE_TAC[SUBSET]; + MESON_TAC[]; + REWRITE_TAC[closed_ball2_center]; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]); + REP_BASIC_TAC; + CONJ_TAC; + USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UNDF `&0 < r`; + REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `graph_inc K e x` ASM_CASES_TAC; + REWR 18; + TSPEC `x` 20; + REWR 19; + PROOF_BY_CONTR_TAC; + UND 19; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[INTER;closed_ball2_center]; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]); + REP_BASIC_TAC; + USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]); + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UNDF `&0 < r`; + REAL_ARITH_TAC; + (* F *) + KILL 14; + KILL 39; + KILL 38; + KILL 37; + KILL 36; + KILL 35; + KILL 34; + KILL 33; + KILL 32; + KILL 29; + KILL 28; + KILL 27; + KILL 26; + KILL 5; + KILL 2; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + REP_BASIC_TAC; + REWRITE_TAC[SUBSET;INTER]; + REP_BASIC_TAC; + USEF `(SUBSET)` (REWRITE_RULE[SUBSET]); + TSPEC `x` 4; + REWR 4; + UND 4; + REWRITE_TAC[UNION]; + REP_CASES_TAC; + ASM_MESON_TAC[ISUBSET]; + ASM_MESON_TAC[ISUBSET]; + PROOF_BY_CONTR_TAC; + UND 21; + DISCH_THEN (TH_INTRO_TAC[`e''`]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[INTER]; + (* G *) + REP_BASIC_TAC; + TYPE_THEN `graph_inc K e v''` ASM_CASES_TAC; + REWR 8; + UND 8; + REWRITE_TAC[in_pair]; + REP_CASES_TAC; + UND 8; + DISCH_THEN_FULL_REWRITE; + PROOF_BY_CONTR_TAC; + UND 2; + UND 3; + MESON_TAC[simple_arc_end_end2]; + UND 8; + DISCH_THEN_FULL_REWRITE; + PROOF_BY_CONTR_TAC; + UND 2; + UND 3; + MESON_TAC[simple_arc_end_end]; + (* - *) + TYPE_THEN `C SUBSET D v UNION D v' UNION C''` SUBGOAL_TAC; + EXPAND_TAC "D"; + UND 4; + UND 22; + UND 23; + REWRITE_TAC[SUBSET;UNION]; + MESON_TAC[]; + REWRITE_TAC[SUBSET]; + DISCH_TAC; + PROOF_BY_CONTR_TAC; + USE 11 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + REP_BASIC_TAC; + TSPEC `u` 10; + REWR 10; + USE 10 (REWRITE_RULE[UNION]); + UND 10; + REP_CASES_TAC ; + (* -- *) + UND 8; + ASM_REWRITE_TAC[in_pair]; + PROOF_BY_CONTR_TAC; + USE 8 (REWRITE_RULE[DE_MORGAN_THM]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UND 26; + DISCH_THEN (TH_INTRO_TAC[`v`;`v''`]); + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + UND 10; + EXPAND_TAC "D"; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + (* -- *) + UND 8; + ASM_REWRITE_TAC[in_pair]; + PROOF_BY_CONTR_TAC; + USE 8 (REWRITE_RULE[DE_MORGAN_THM]); + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]); + REP_BASIC_TAC; + UND 26; + DISCH_THEN (TH_INTRO_TAC[`v'`;`v''`]); + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + UND 10; + EXPAND_TAC "D"; + DISCH_THEN_REWRITE; + ASM_REWRITE_TAC[]; + (* - *) + UND 20; + DISCH_THEN (TH_INTRO_TAC[`v''`]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + ASM_MESON_TAC[]; + (* Thu Aug 26 08:46:13 EDT 2004 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION P *) +(* ------------------------------------------------------------------ *) + + +let (UNDISCHQ_TAC:(term->bool) -> tactic) = + fun cond (asl,w) -> + let cond' x = try (cond x) with failure -> false in + let asl' = (fst(partition cond' (map (concl o snd) asl))) in + EVERY (map (TRY o UNDISCH_TAC ) asl') (asl,w);; + +let UNABBREV_TAC tm = + FIRST[ UNDISCHQ_TAC ( ((=) tm o rhs)) + THEN (DISCH_THEN (MP_TAC o SYM)) ; + UNDISCHQ_TAC ( ((=) tm o lhs)) ] + THEN DISCH_THEN_FULL_REWRITE;; + +let set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net = + let rewrites = ref (basic_rewrites()) + and conv_net = ref (basic_net()) in + let set_simp_rewrites thl = + let canon_thl = itlist (mk_rewrites false) thl ([]:thm list) in + (rewrites := canon_thl; + conv_net := itlist (net_of_thm true) canon_thl empty_net) in + let extend_simp_rewrites thl = + (* is false in simp.ml . Important change. *) + let canon_thl = itlist (mk_rewrites true) thl ([]:thm list) in + (rewrites := canon_thl @ !rewrites; + conv_net := itlist (net_of_thm true) canon_thl (!conv_net)) in + let simp_rewrites() = !rewrites in + let simp_net() = !conv_net in + set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net;; + +let simp_ss = + let rewmaker = mk_rewrites true in + fun thl -> + let cthms = itlist rewmaker thl ([]:thm list) in + let net' = itlist (net_of_thm true) cthms (simp_net()) in + let net'' = itlist net_of_cong (basic_congs()) net' in + Simpset(net'',basic_prover,([]:prover list),rewmaker);; + +let RSIMP_CONV thl = ONCE_SIMPLIFY_CONV (simp_ss ([]:thm list)) thl;; + +let (RSIMP_TAC:thm list -> tactic) = fun (thl:thm list) -> CONV_TAC(RSIMP_CONV thl);; + +let ASM_RSIMP_TAC = ASM RSIMP_TAC;; + +EVERY_STEP_TAC := + (RSIMP_TAC[]) THEN + REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN + (ASM_RSIMP_TAC[]) THEN + (REWRITE_TAC[]) ;; + +let SUBAGOAL_TAC t = SUBGOAL_THEN t ASSUME_TAC;; + +(* EVERY_STEP_TAC := ALL_TAC *) + +let subset_imp = prove_by_refinement( + `!A B (x:A). A x /\ A SUBSET B ==> B x`, + (* {{{ proof *) + [ + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +(* +extend_simp_rewrites[subset_imp] +*) + +(* ------------------------------------------------------------------ *) +(* ------------------------------------------------------------------ *) + + +let plane_graph_image = jordan_def + `plane_graph_image (f:(num->real)->(num->real)) G = + mk_graph_t + (IMAGE f (graph_vertex G), + IMAGE2 f (graph_edge G), + ( \ e v. (?e' v'. (graph_edge G e') /\ + (IMAGE f e' = e) /\ (f v' = v) /\ + (graph_inc G e' v'))))`;; + +let plane_graph_image_e = prove_by_refinement( + `!f G. (graph_edge (plane_graph_image f G)) = + IMAGE2 f (graph_edge G)`, + (* {{{ proof *) + [ + REWRITE_TAC[plane_graph_image;graph_edge;part1;drop0;dest_graph_t]; + (* Thu Aug 26 10:16:26 EDT 2004 *) + + ]);; + (* }}} *) + +let plane_graph_image_v = prove_by_refinement( + `!f G. (graph_vertex (plane_graph_image f G)) = + IMAGE f (graph_vertex G)`, + (* {{{ proof *) + [ + REWRITE_TAC[plane_graph_image;dest_graph_t;graph_vertex;]; + (* Thu Aug 26 10:17:56 EDT 2004 *) + + ]);; + (* }}} *) + +let plane_graph_image_i = prove_by_refinement( + `!f G. (graph_inc (plane_graph_image f G)) = + ( \ e v. (?e' v'. (graph_edge G e') /\ + (IMAGE f e' = e) /\ (f v' = v) /\ + (graph_inc G e' v')))`, + (* {{{ proof *) + [ + REWRITE_TAC[plane_graph_image ;graph_inc;dest_graph_t;drop1]; + (* Thu Aug 26 10:20:07 EDT 2004 *) + + ]);; + (* }}} *) + +let plane_graph_image_bij = prove_by_refinement( + `!f G. homeomorphism f top2 top2 /\ plane_graph G ==> + BIJ f (graph_vertex G) (IMAGE f (graph_vertex G)) /\ + BIJ (IMAGE f) (graph_edge G) (IMAGE2 f (graph_edge G))`, + (* {{{ proof *) + [ + ALL_TAC ; + (* - *) + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]); + TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[subset_imp]; + (* - *) + USE 3 (MATCH_MP image_powerset); + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + (* ASM_MESON_TAC[ISUBSET]; *) + ]);; + (* }}} *) + +let plane_graph_image_iso = prove_by_refinement( + `!f G. (homeomorphism f top2 top2 /\ plane_graph G ==> + graph_isomorphic G (plane_graph_image f G))`, + (* {{{ proof *) + [ + ALL_TAC; + REWRITE_TAC[graph_isomorphic;graph_iso;]; + LEFT_TAC "u"; + TYPE_THEN `f` EXISTS_TAC; + LEFT_TAC "v"; + TYPE_THEN `IMAGE f` EXISTS_TAC; + TYPE_THEN `f,IMAGE f` EXISTS_TAC; + REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]; + (* - *) + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]); + TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + (* - *) + TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[ISUBSET]; + (* - *) + SUBCONJ_TAC; + USE 3 (MATCH_MP image_powerset); + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + (* A- *) + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `e' = e` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2;BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* ---- *) + TYPE_THEN `e'` UNABBREV_TAC ; + REWRITE_TAC[IMAGE]; + USE 5 GSYM; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + USE 8(REWRITE_RULE[IMAGE]); + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Thu Aug 26 10:49:22 EDT 2004 *) + ]);; + (* }}} *) + +extend_simp_rewrites [(REAL_ARITH `&0 < &1`)];; + +extend_simp_rewrites [prove_by_refinement( + `metric_space(euclid 2,d_euclid)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[metric_euclid]; + ])];; + (* }}} *) + +extend_simp_rewrites [prove_by_refinement( + `!G. plane_graph G ==> graph_vertex G SUBSET (euclid 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[plane_graph]; + ])];; + (* }}} *) + +let simple_arc_end_cont = prove_by_refinement( + `!C v v'. simple_arc_end C v v' <=> + (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\ + continuous f + (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ + (f (&0) = v) /\ + (f (&1) = v'))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + EQ_TAC; + TH_INTRO_TAC [`&0`;`&1`;`f`;`euclid 2`;`d_euclid`] cont_extend_real_lemma; + CONJ_TAC; + ASM_REWRITE_TAC[GSYM top2]; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `g` EXISTS_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + UNIFY_EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UNIFY_EXISTS_TAC; + ASM_MESON_TAC[]; + (* -- *) + ASM_REWRITE_TAC[top2]; + CONJ_TAC; + REWRITE_TAC[INJ]; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[REAL_ARITH `x <=. x `;REAL_ARITH `&0 <=. &1`]; + (* - *) + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC continuous_interval; + (* Thu Aug 26 12:57:09 EDT 2004 *) + ]);; + (* }}} *) + +let graph_edge_euclid = prove_by_refinement( + `!G e. (plane_graph G /\ graph_edge G e) ==> (e SUBSET (euclid 2))`, + (* {{{ proof *) + [ + ALL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let plane_graph_image_plane = prove_by_refinement( + `!f G. (homeomorphism f top2 top2 /\ good_plane_graph G ==> + good_plane_graph(plane_graph_image f G))`, + (* {{{ proof *) + [ + REWRITE_TAC[good_plane_graph]; + TH_INTRO_TAC[`G`;`plane_graph_image f G`] graph_isomorphic_graph; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC plane_graph_image_iso; + ASM_REWRITE_TAC[plane_graph]; + (* - *) + TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC; + (* - *) + TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC; + IMATCH_MP_TAC graph_edge_euclid; + UNIFY_EXISTS_TAC; + (* - *) + TH_INTRO_TAC[`f`;`G`] plane_graph_image_bij; + (* A- *) + ASM_REWRITE_TAC[plane_graph;GSYM CONJ_ASSOC;]; + TYPE_THEN `(!e v v'. graph_edge (plane_graph_image f G) e /\ ~(v = v') /\ graph_inc (plane_graph_image f G) e v /\ graph_inc (plane_graph_image f G) e v' ==> simple_arc_end e v v')` SUBGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]); + TYPE_THEN `v` UNABBREV_TAC; + TYPE_THEN `v'` UNABBREV_TAC; + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `e' = e''` SUBGOAL_TAC ; + USE 6 (REWRITE_RULE[BIJ;INJ;IMAGE2]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `e''` UNABBREV_TAC; + UND 0 THEN (DISCH_THEN (TH_INTRO_TAC [`e'`;`v'''`;`v''`])); + DISCH_TAC; + TYPE_THEN `v'''` UNABBREV_TAC; + USE 0 (REWRITE_RULE[simple_arc_end_cont]); + REWRITE_TAC[simple_arc_end_cont]; + TYPE_THEN `f o f'` EXISTS_TAC; + REWRITE_TAC[IMAGE_o]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `top2` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]); + ASM_REWRITE_TAC[top2_unions]; + TYPE_THEN `UNIONS (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC; + TH_INTRO_TAC[`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_unions; + TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV ` SUBAGOAL_TAC; + alpha_tac; + IMATCH_MP_TAC metric_subspace; + UNIFY_EXISTS_TAC; + REWRITE_TAC [metric_real;]; + UND 21 THEN DISCH_THEN (fun t->ONCE_REWRITE_TAC[GSYM t]); + REWRITE_TAC[]; + USE 15 (REWRITE_RULE[INJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* -- *) + CONJ_TAC; + REWRITE_TAC[comp_comp]; + IMATCH_MP_TAC COMP_INJ; + UNIFY_EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]); + REWRITE_TAC[o_DEF]; + (* B- *) + ASM_REWRITE_TAC[]; + TYPE_THEN `graph_edge (plane_graph_image f G) SUBSET simple_arc top2` SUBGOAL_TAC; + REWRITE_TAC[SUBSET]; + TH_INTRO_TAC[`plane_graph_image f G`;`x`] graph_edge_end_select; + UND 8 THEN DISCH_THEN (TH_INTRO_TAC[`x`;`v`;`v'`]); + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + KILL 8; + (* - *) + CONJ_TAC; + MP_TAC plane_graph_image_v THEN DISCH_THEN_FULL_REWRITE; + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;INJ;]); + USE 16 (REWRITE_RULE[top2_unions]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + (* - *) + CONJ_TAC; + (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t )) [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + TYPE_THEN `x` UNABBREV_TAC ; + TYPE_THEN `e` UNABBREV_TAC; + REWRITE_TAC[INTER]; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + TSPEC `e'` 11; + REWR 10; + USE 10 (REWRITE_RULE[INTER]); + REWRITE_TAC[IMAGE]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE]; + TYPE_THEN `v'` EXISTS_TAC; + TH_INTRO_TAC [`G`;`e'`] graph_inc_subset; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + USE 8 (REWRITE_RULE[IMAGE2]); + TYPE_THEN `FF = IMAGE f` ABBREV_TAC ; + USE 8 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` EXISTS_TAC; + USE 10 (REWRITE_RULE[INTER]); + TYPE_THEN `FF` UNABBREV_TAC; + USE 10 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `x''` EXISTS_TAC; + TYPE_THEN `e` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + REWRITE_TAC[INTER]; + USE 13 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'' =x` SUBAGOAL_TAC; + USE 2(REWRITE_RULE[homeomorphism;BIJ;INJ;top2_unions]); + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + TSPEC `x'` 5; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* C- *) + (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t )) [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]; + USE 10 (REWRITE_RULE[IMAGE2]); + USE 11 (REWRITE_RULE[IMAGE2]); + TYPE_THEN `FF = IMAGE f` ABBREV_TAC ; + USE 10 (REWRITE_RULE[IMAGE]); + USE 11 (REWRITE_RULE[IMAGE]); + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + TH_INTRO_TAC [`f`;`euclid 2`;`euclid 2`;`x'`;`x`] (GSYM inj_inter); + RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]); + TYPE_THEN `FF` UNABBREV_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]); + TYPEL_THEN [`x'`;`x`] (fun t-> UND 1 THEN DISCH_THEN (TH_INTRO_TAC t)); + DISCH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + ]);; + (* }}} *) + +(* state MP *) + +let h_compat = jordan_def `h_compat f <=> !x y. (SND x = SND y) ==> + (IMAGE f (mk_line (point x) (point y)) = + mk_line (f (point x)) (f (point y)))`;; + +let v_compat = jordan_def `v_compat f <=> !x y. (FST x = FST y) ==> + (IMAGE f (mk_line (point x) (point y)) = + mk_line (f (point x)) (f (point y)))`;; + +let h_translate = jordan_def `h_translate r p = p + r *# e1`;; + +let v_translate = jordan_def `v_translate r p = p + r *# e2`;; + +let r_scale = jordan_def `r_scale r p = + if ( &.0 < p 0) then (point (r * p 0, p 1)) else p`;; + +let u_scale = jordan_def `u_scale r p = + if ( &.0 < p 1) then (point ( p 0, r * p 1)) else p`;; + +let cont_domain = prove_by_refinement( + `!(f:A->B) g U V. (continuous f U V) /\ (!x. UNIONS U x ==> (f x = g x)) + ==> (continuous g U V)`, + (* {{{ proof *) + [ + REWRITE_TAC[preimage;continuous;]; + TYPE_THEN `{x | UNIONS U x /\ v (g x)} = {x | UNIONS U x /\ v (f x)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC (TAUT `(A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`); + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let h_translate_bij = prove_by_refinement( + `!r. BIJ (h_translate r) (euclid 2) (euclid 2)`, + (* {{{ proof *) + + [ + REWRITE_TAC[BIJ;INJ;h_translate]; + SUBCONJ_TAC; + CONJ_TAC; + ASM_SIMP_TAC[euclid_add_closure;e1;point_scale;euclid_point]; + RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e1]); + IMATCH_MP_TAC EQ_EXT; + USE 0 (REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x'` 0; + UND 0 THEN REAL_ARITH_TAC; + REWRITE_TAC[SURJ;h_translate]; + REP_BASIC_TAC; + TYPE_THEN `x - (r *# e1)` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[point_scale;e1]; + ASM_SIMP_TAC[euclid_sub_closure;euclid_point]; + REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + REAL_ARITH_TAC; + (* Tue Sep 7 10:15:46 EDT 2004 *) + + ]);; + + (* }}} *) + +let v_translate_bij = prove_by_refinement( + `!r. BIJ (v_translate r) (euclid 2) (euclid 2)`, + (* {{{ proof *) + + [ + REWRITE_TAC[BIJ;INJ;v_translate]; + SUBCONJ_TAC; + CONJ_TAC; + ASM_SIMP_TAC[euclid_add_closure;e2;point_scale;euclid_point]; + RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e2]); + IMATCH_MP_TAC EQ_EXT; + USE 0 (REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x'` 0; + UND 0 THEN REAL_ARITH_TAC; + REWRITE_TAC[SURJ;v_translate]; + REP_BASIC_TAC; + TYPE_THEN `x - (r *# e2)` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[point_scale;e2]; + ASM_SIMP_TAC[euclid_sub_closure;euclid_point]; + REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + REAL_ARITH_TAC; + (* Tue Sep 7 10:16:38 EDT 2004 *) + + ]);; + + (* }}} *) + +extend_simp_rewrites [euclid_point];; +extend_simp_rewrites [coord01];; + +let r_scale_bij = prove_by_refinement( + `!r. (&0 < r) ==> BIJ (r_scale r) (euclid 2) (euclid 2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[BIJ;INJ;r_scale;]; + SUBCONJ_TAC; + CONJ_TAC; + COND_CASES_TAC; + REWRITE_TAC[euclid_point]; + USE 2 (MATCH_MP point_onto); + USE 3 (MATCH_MP point_onto); + REWRITE_TAC[point_inj]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `y` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + RULE_ASSUM_TAC (REWRITE_RULE[coord01]); + UND 1 THEN COND_CASES_TAC; + UND 1 THEN COND_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); + RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]); + UND 4 THEN UND 0 THEN REAL_ARITH_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); + TYPE_THEN `FST p` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 3 THEN REWRITE_TAC[]; + REWRITE_TAC[real_gt]; + IMATCH_MP_TAC REAL_LT_MUL; + UND 1 THEN COND_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]); + TYPE_THEN `FST p'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 2 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LT_MUL; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); + KILL 1; + REWRITE_TAC[SURJ;r_scale]; + KILL 2; + USE 1 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `&0 < FST p` ASM_CASES_TAC; + TYPE_THEN `point ((&1/r)* FST p, SND p)` EXISTS_TAC; + TYPE_THEN `&0 < &1/ r * FST p` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC]; + TYPE_THEN `(r * &1/r) * FST p = &1 * FST p` SUBAGOAL_TAC; + AP_THM_TAC; + AP_TERM_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 3 THEN UND 0 THEN REAL_ARITH_TAC; + REDUCE_TAC; + TYPE_THEN `point p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Tue Sep 7 10:55:54 EDT 2004 *) + + ]);; + (* }}} *) + +let u_scale_bij = prove_by_refinement( + `!r. (&0 < r) ==> BIJ (u_scale r) (euclid 2) (euclid 2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[BIJ;INJ;u_scale;]; + SUBCONJ_TAC; + CONJ_TAC; + COND_CASES_TAC; + USE 2 (MATCH_MP point_onto); + USE 3 (MATCH_MP point_onto); + REWRITE_TAC[point_inj]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `y` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + RULE_ASSUM_TAC (REWRITE_RULE[coord01]); + UND 1 THEN COND_CASES_TAC; + UND 1 THEN COND_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); + RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]); + UND 1 THEN UND 0 THEN REAL_ARITH_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]); + TYPE_THEN `SND p` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 3 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LT_MUL; + UND 1 THEN COND_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]); + TYPE_THEN `SND p'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 2 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LT_MUL; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); + KILL 1; + REWRITE_TAC[SURJ;u_scale]; + KILL 2; + USE 1 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `&0 < SND p` ASM_CASES_TAC; + TYPE_THEN `point (FST p, (&1/r)* SND p)` EXISTS_TAC; + TYPE_THEN `&0 < &1/ r * SND p` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC]; + TYPE_THEN `(r * &1/r) * SND p = &1 * SND p` SUBAGOAL_TAC; + AP_THM_TAC; + AP_TERM_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 3 THEN UND 0 THEN REAL_ARITH_TAC; + REDUCE_TAC; + TYPE_THEN `point p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Tue Sep 7 11:01:53 EDT 2004 *) + + ]);; + (* }}} *) + +let h_translate_inv = prove_by_refinement( + `!r x. (euclid 2 x) ==> + (h_translate (--. r) x = INV (h_translate r) (euclid 2) (euclid 2) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_SYM; + TH_INTRO_TAC[`h_translate r`;`euclid 2`;`euclid 2`;`h_translate (--. r) x`;`x`] INVERSE_XY; + ASM_REWRITE_TAC[h_translate_bij;h_translate;e1;point_scale]; + ASM_SIMP_TAC[euclid_add_closure;euclid_point]; + REWRITE_TAC[h_translate;euclid_plus;e1;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + REAL_ARITH_TAC; + (* Tue Sep 7 11:11:17 EDT 2004 *) + ]);; + (* }}} *) + +let v_translate_inv = prove_by_refinement( + `!r x. (euclid 2 x) ==> + (v_translate (--. r) x = INV (v_translate r) (euclid 2) (euclid 2) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_SYM; + TH_INTRO_TAC[`v_translate r`;`euclid 2`;`euclid 2`;`v_translate (--. r) x`;`x`] INVERSE_XY; + ASM_REWRITE_TAC[v_translate_bij;v_translate;e2;point_scale]; + ASM_SIMP_TAC[euclid_add_closure;euclid_point]; + REWRITE_TAC[v_translate;euclid_plus;e2;euclid_scale]; + IMATCH_MP_TAC EQ_EXT; + REAL_ARITH_TAC; + (* Tue Sep 7 11:12:42 EDT 2004 *) + ]);; + (* }}} *) + +extend_simp_rewrites[prove_by_refinement( + `!x r. (&0 < r) ==> (r * (&1/r) * x = x)`, + (* {{{ proof *) + [ + REWRITE_TAC [REAL_MUL_ASSOC]; + TYPE_THEN `(r * &1/r) * x = &1 * x` SUBAGOAL_TAC; + AP_THM_TAC; + AP_TERM_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 1 THEN UND 0 THEN REAL_ARITH_TAC; + REDUCE_TAC; + ])];; + (* }}} *) + +extend_simp_rewrites[ prove_by_refinement( + `!r. (&0 < r) ==> (&0 < &1 / r)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + ])];; + (* }}} *) + +extend_simp_rewrites[ REAL_LE_POW_2];; + +extend_simp_rewrites[ prove_by_refinement( + `!x y. &0 <= x pow 2 + y pow 2`, + (* {{{ proof *) + [ + ALL_TAC; + IMATCH_MP_TAC REAL_LE_ADD; + ])];; + (* }}} *) + +let r_scale_inv = prove_by_refinement( + `!r x. (&0 < r) /\ (euclid 2 x) ==> + (r_scale (&1/r) x = INV (r_scale r) (euclid 2) (euclid 2) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_SYM; + TH_INTRO_TAC[`r_scale r`;`euclid 2`;`euclid 2`;`r_scale (&1/r) x`;`x`] INVERSE_XY; + ASM_SIMP_TAC [r_scale_bij]; + TH_INTRO_TAC[`&1/r`] r_scale_bij; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[r_scale]; + USE 0 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `&0 < FST p` ASM_CASES_TAC; + REWRITE_TAC[coord01]; + TYPE_THEN `&0 < (&1 / r) * FST p` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* Tue Sep 7 11:40:41 EDT 2004 *) + + ]);; + (* }}} *) + +let u_scale_inv = prove_by_refinement( + `!r x. (&0 < r) /\ (euclid 2 x) ==> + (u_scale (&1/r) x = INV (u_scale r) (euclid 2) (euclid 2) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_SYM; + TH_INTRO_TAC[`u_scale r`;`euclid 2`;`euclid 2`;`u_scale (&1/r) x`;`x`] INVERSE_XY; + ASM_SIMP_TAC [u_scale_bij]; + TH_INTRO_TAC[`&1/r`] u_scale_bij; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[u_scale]; + USE 0 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `&0 < SND p` ASM_CASES_TAC; + REWRITE_TAC[coord01]; + TYPE_THEN `&0 < (&1 / r) * SND p` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* Tue Sep 7 11:56:05 EDT 2004 *) + + + ]);; + (* }}} *) + +let metric_continuous_continuous_top2 = prove_by_refinement( + `!f. (IMAGE f (euclid 2) SUBSET (euclid 2) ==> + (continuous f top2 top2 = + metric_continuous f (euclid 2,d_euclid) (euclid 2,d_euclid)))`, + (* {{{ proof *) + [ + REWRITE_TAC[top2]; + IMATCH_MP_TAC metric_continuous_continuous; + ]);; + (* }}} *) + +let h_translate_cont = prove_by_refinement( + `!r. continuous (h_translate r) (top2) (top2)`, + (* {{{ proof *) + [ + ALL_TAC; + TH_INTRO_TAC [`h_translate r`] metric_continuous_continuous_top2; + ASSUME_TAC h_translate_bij; + TSPEC `r` 0; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + TYPE_THEN `epsilon` EXISTS_TAC; + REP_BASIC_TAC; + REWRITE_TAC[h_translate]; + TH_INTRO_TAC[`2`;`x`;`y`;`r *# e1`] metric_translate; + REWRITE_TAC[e1;point_scale]; + (* Tue Sep 7 12:09:30 EDT 2004 *) + + ]);; + (* }}} *) + +let v_translate_cont = prove_by_refinement( + `!r. continuous (v_translate r) (top2) (top2)`, + (* {{{ proof *) + [ + ALL_TAC; + TH_INTRO_TAC [`v_translate r`] metric_continuous_continuous_top2; + ASSUME_TAC v_translate_bij; + TSPEC `r` 0; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + TYPE_THEN `epsilon` EXISTS_TAC; + REP_BASIC_TAC; + REWRITE_TAC[v_translate]; + TH_INTRO_TAC[`2`;`x`;`y`;`r *# e2`] metric_translate; + REWRITE_TAC[e2;point_scale]; + (* Tue Sep 7 12:10:54 EDT 2004 *) + ]);; + (* }}} *) + +let r_scale_cont = prove_by_refinement( + `!r. (&0 < r) ==> (continuous (r_scale r) top2 top2)`, + (* {{{ proof *) + [ + ALL_TAC; + TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC; + UND 0 THEN REAL_ARITH_TAC; + TH_INTRO_TAC[`r_scale r`] metric_continuous_continuous_top2; + ASSUME_TAC r_scale_bij; + TSPEC `r` 2; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC; + TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ; + TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC; + TYPE_THEN `epsilon'` UNABBREV_TAC; + TYPE_THEN `epsilon` UNABBREV_TAC; + KILL 4; + SUBCONJ_TAC; + ASM_MESON_TAC[REAL_PROP_POS_LMUL]; + USE 5(MATCH_MP point_onto); + TYPE_THEN `y` UNABBREV_TAC; + USE 6(MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + (* - *) + TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ]; + IMATCH_MP_TAC REAL_LE_RMUL; + REWRITE_TAC[REAL_POW_2]; + IMATCH_MP_TAC ABS_SQUARE_LE; + UND 0 THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_POW_MUL]; + (* - *) + TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LE_RMUL; + REWRITE_TAC[REAL_POW_2]; + IMATCH_MP_TAC ABS_SQUARE_LE; + UND 0 THEN REAL_ARITH_TAC; + UND 6 THEN REDUCE_TAC; + (* - *) + TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC; + REWRITE_TAC[GSYM REAL_POW_MUL]; + REWRITE_TAC[REAL_POW_2]; + IMATCH_MP_TAC ABS_SQUARE_LE; + TYPE_THEN `abs (r*x' + y') = r*x' + y'` SUBAGOAL_TAC; + REWRITE_TAC[ABS_REFL]; + IMATCH_MP_TAC REAL_LE_ADD; + ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`]; + ineq_le_tac `(r*x' + y') + x' + r*y' = (&1 + r)*(x' + y')` ; + (* A - *) + TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC; + TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC; + IMATCH_MP_TAC POW_2_SQRT; + IMATCH_MP_TAC REAL_LE_MUL; + UND 7 THEN UND 1 THEN REAL_ARITH_TAC; + UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]); + IMATCH_MP_TAC SQRT_MONO_LT; + REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ]; + REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ]; + IMATCH_MP_TAC REAL_LT_LMUL; + CONJ_TAC; + IMATCH_MP_TAC REAL_PROP_POS_POW; + TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT); + TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC; + IMATCH_MP_TAC POW_2_SQRT; + UND 7 THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]); + (* - *) + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC; + (* B- *) + REWRITE_TAC[r_scale]; + COND_CASES_TAC THEN COND_CASES_TAC; + UND 4 THEN REWRITE_TAC[d_euclid_point]; + IMATCH_MP_TAC SQRT_MONO_LE; + (* IMATCH_MP_TAC REAL_LET_TRANS; *) + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + (* 3 LEFT *) + UND 4 THEN (REWRITE_TAC [d_euclid_point]); + TYPE_THEN `u = --. (FST p)` ABBREV_TAC ; + TYPE_THEN `FST p = -- u` SUBAGOAL_TAC; + UND 12 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `x - --. y = x + y`]; + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; + (* 2 LEFT *) + UND 4 THEN (REWRITE_TAC [d_euclid_point]); + TYPE_THEN `u = --. (FST p')` ABBREV_TAC ; + TYPE_THEN `FST p' = -- u` SUBAGOAL_TAC; + UND 12 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `-- x - v = -- (v + x)`;REAL_POW_NEG;EVEN2 ]; + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; + (* 1 LEFT *) + UND 4 THEN (REWRITE_TAC [d_euclid_point]); + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + (* Tue Sep 7 15:33:59 EDT 2004 *) + + ]);; + (* }}} *) + +let u_scale_cont = prove_by_refinement( + `!r. (&0 < r) ==> (continuous (u_scale r) top2 top2)`, + (* {{{ proof *) + [ + ALL_TAC; + TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC; + UND 0 THEN REAL_ARITH_TAC; + TH_INTRO_TAC[`u_scale r`] metric_continuous_continuous_top2; + ASSUME_TAC u_scale_bij; + TSPEC `r` 2; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC; + TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ; + TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC; + TYPE_THEN `epsilon'` UNABBREV_TAC; + TYPE_THEN `epsilon` UNABBREV_TAC; + KILL 4; + SUBCONJ_TAC; + ASM_MESON_TAC[REAL_PROP_POS_LMUL]; + USE 5(MATCH_MP point_onto); + TYPE_THEN `y` UNABBREV_TAC; + USE 6(MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + (* - *) + TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ]; + IMATCH_MP_TAC REAL_LE_RMUL; + REWRITE_TAC[REAL_POW_2]; + IMATCH_MP_TAC ABS_SQUARE_LE; + UND 0 THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_POW_MUL]; + (* - *) + TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LE_RMUL; + REWRITE_TAC[REAL_POW_2]; + IMATCH_MP_TAC ABS_SQUARE_LE; + UND 0 THEN REAL_ARITH_TAC; + UND 6 THEN REDUCE_TAC; + (* - *) + TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC; + REWRITE_TAC[GSYM REAL_POW_MUL]; + REWRITE_TAC[REAL_POW_2]; + IMATCH_MP_TAC ABS_SQUARE_LE; + TYPE_THEN `abs (r*x' + y') = r*x' + y'` SUBAGOAL_TAC; + REWRITE_TAC[ABS_REFL]; + IMATCH_MP_TAC REAL_LE_ADD; + ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`]; + ineq_le_tac `(r*x' + y') + x' + r*y' = (&1 + r)*(x' + y')` ; + (* A - *) + TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC; + TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC; + IMATCH_MP_TAC POW_2_SQRT; + IMATCH_MP_TAC REAL_LE_MUL; + UND 7 THEN UND 1 THEN REAL_ARITH_TAC; + UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]); + IMATCH_MP_TAC SQRT_MONO_LT; + REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ]; + REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ]; + IMATCH_MP_TAC REAL_LT_LMUL; + CONJ_TAC; + IMATCH_MP_TAC REAL_PROP_POS_POW; + TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT); + TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC; + IMATCH_MP_TAC POW_2_SQRT; + UND 7 THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]); + (* - *) + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC; + (* B- *) + REWRITE_TAC[u_scale]; + COND_CASES_TAC THEN COND_CASES_TAC; + UND 4 THEN REWRITE_TAC[d_euclid_point]; + IMATCH_MP_TAC SQRT_MONO_LE; + (* IMATCH_MP_TAC REAL_LET_TRANS; *) + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + (* 3 LEFT *) + UND 4 THEN (REWRITE_TAC [d_euclid_point]); + TYPE_THEN `u = --. (SND p)` ABBREV_TAC ; + TYPE_THEN `SND p = -- u` SUBAGOAL_TAC; + UND 12 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `x - --. y = x + y`]; + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; + (* 2 LEFT *) + UND 4 THEN (REWRITE_TAC [d_euclid_point]); + TYPE_THEN `u = --. (SND p')` ABBREV_TAC ; + TYPE_THEN `SND p' = -- u` SUBAGOAL_TAC; + UND 12 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `-- x - v = -- (v + x)`;REAL_POW_NEG;EVEN2 ]; + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC; + (* 1 LEFT *) + UND 4 THEN (REWRITE_TAC [d_euclid_point]); + IMATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LDISTRIB]; + IMATCH_MP_TAC REAL_LE_ADD2; + (* Tue Sep 7 15:40:34 EDT 2004 *) + ]);; + (* }}} *) + +let h_translate_hom = prove_by_refinement( + `!r. (homeomorphism (h_translate r) top2 top2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC bicont_homeomorphism; + REWRITE_TAC[top2_unions;h_translate_bij;h_translate_cont]; + IMATCH_MP_TAC cont_domain; + REWRITE_TAC[top2_unions]; + TYPE_THEN `h_translate (-- r)` EXISTS_TAC; + REWRITE_TAC[h_translate_inv;h_translate_cont]; + (* Tue Sep 7 15:56:20 EDT 2004 *) + + ]);; + (* }}} *) + +let v_translate_hom = prove_by_refinement( + `!r. (homeomorphism (v_translate r) top2 top2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC bicont_homeomorphism; + REWRITE_TAC[top2_unions;v_translate_bij;v_translate_cont]; + IMATCH_MP_TAC cont_domain; + REWRITE_TAC[top2_unions]; + TYPE_THEN `v_translate (-- r)` EXISTS_TAC; + REWRITE_TAC[v_translate_inv;v_translate_cont]; + (* Tue Sep 7 15:57:06 EDT 2004 *) + ]);; + (* }}} *) + +let r_scale_hom = prove_by_refinement( + `!r. (&0 < r) ==> (homeomorphism (r_scale r) top2 top2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC bicont_homeomorphism; + ASM_SIMP_TAC [top2_unions;r_scale_bij;r_scale_cont]; + IMATCH_MP_TAC cont_domain; + REWRITE_TAC[top2_unions]; + TYPE_THEN `r_scale (&1/r)` EXISTS_TAC; + TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC; + ASM_SIMP_TAC [r_scale_inv;r_scale_cont]; + (* Tue Sep 7 16:00:14 EDT 2004 *) + + ]);; + (* }}} *) + +let u_scale_hom = prove_by_refinement( + `!r. (&0 < r) ==> (homeomorphism (u_scale r) top2 top2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC bicont_homeomorphism; + ASM_SIMP_TAC [top2_unions;u_scale_bij;u_scale_cont]; + IMATCH_MP_TAC cont_domain; + REWRITE_TAC[top2_unions]; + TYPE_THEN `u_scale (&1/r)` EXISTS_TAC; + TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC; + ASM_SIMP_TAC [u_scale_inv;u_scale_cont]; + (* Tue Sep 7 16:01:04 EDT 2004 *) + + + ]);; + (* }}} *) + +let h_translate_h = prove_by_refinement( + `!r. (h_compat (h_translate r))`, + (* {{{ proof *) + [ + REWRITE_TAC[h_compat;h_translate;e1;point_scale;mk_line;IMAGE]; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + REDUCE_TAC; + TYPE_THEN `t` EXISTS_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + CONV_TAC (dropq_conv "x"); + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `t` EXISTS_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + (* Tue Sep 7 16:13:50 EDT 2004 *) + + ]);; + (* }}} *) + +let v_translate_v = prove_by_refinement( + `!r. (v_compat (v_translate r))`, + (* {{{ proof *) + [ + REWRITE_TAC[v_compat;v_translate;e2;point_scale;mk_line;IMAGE]; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + REDUCE_TAC; + TYPE_THEN `t` EXISTS_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + CONV_TAC (dropq_conv "x"); + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `t` EXISTS_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + (* Tue Sep 7 16:15:33 EDT 2004 *) + + + ]);; + (* }}} *) + +let h_translate_v = prove_by_refinement( + `!r. (v_compat (h_translate r))`, + (* {{{ proof *) + [ + REWRITE_TAC[v_compat;h_translate;e1;point_scale;mk_line;IMAGE]; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + REDUCE_TAC; + TYPE_THEN `t` EXISTS_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + CONV_TAC (dropq_conv "x"); + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `t` EXISTS_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + (* Tue Sep 7 16:17:13 EDT 2004 *) + ]);; + (* }}} *) + +let v_translate_h = prove_by_refinement( + `!r. (h_compat (v_translate r))`, + (* {{{ proof *) + [ + REWRITE_TAC[h_compat;v_translate;e2;point_scale;mk_line;IMAGE]; + IMATCH_MP_TAC EQ_EXT; + EQ_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + REDUCE_TAC; + TYPE_THEN `t` EXISTS_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + CONV_TAC (dropq_conv "x"); + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `t` EXISTS_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + REAL_ARITH_TAC; + (* Tue Sep 7 16:18:12 EDT 2004 *) + + ]);; + (* }}} *) + +let lin_solve_x = prove_by_refinement( + `!a c. ~(c = &0) ==> (?t. c*t = a)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `a/c` EXISTS_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let mk_line_pt = prove_by_refinement( + `!x. mk_line x x = {x}`, + (* {{{ proof *) + [ + REWRITE_TAC[mk_line;trivial_lin_combo]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + ]);; + (* }}} *) + +let h_compat_bij = prove_by_refinement( + `!f t. (BIJ f (euclid 2) (euclid 2) /\ + (!x. f (point x) 1 = t + SND x) ==> + h_compat f)`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;h_compat]; + TYPE_THEN `x = y` ASM_CASES_TAC; + REWRITE_TAC[mk_line_pt]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE;INR IN_SING]; + EQ_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN`point y` EXISTS_TAC; + (* - *) + TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, t + SND x ))` SUBAGOAL_TAC; + TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); + USE 5 (MATCH_MP point_onto); + REWRITE_TAC[point_inj ;PAIR_SPLIT;]; + TSPEC `x'` 1; + REWR 1; + UND 1 THEN REWRITE_TAC[coord01]; + (* A- *) + UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t)); + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + TYPE_THEN `x'` UNABBREV_TAC; + UND 7 THEN REWRITE_TAC[mk_line]; + TYPE_THEN `x''` UNABBREV_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + TYPE_THEN `x' = (t' * FST x + (&1 - t') * FST y,t' * SND y + (&1 - t') * SND y)` ABBREV_TAC ; + TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + REAL_ARITH_TAC; + KILL 8; + COPY 5; + TSPEC `x'` 5; + UND 5 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); + REWRITE_TAC[point_inj ;PAIR_SPLIT;]; + TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x; + TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC; + UND 8 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); + REWRITE_TAC[point_inj ;PAIR_SPLIT ]; + UND 5 THEN REAL_ARITH_TAC; + UND 4 THEN REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM point_inj]; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `t'` EXISTS_TAC; + CONJ_TAC; + UND 5 THEN REAL_ARITH_TAC; + REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[mk_line;SUBSET;IMAGE]; + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `?u. (euclid_plus (t' *# point (f (point x) 0,t + SND y)) ((&1 - t') *# point (f (point y) 0,t + SND y))) = point (u , t + SND y)` SUBAGOAL_TAC; + REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;]; + CONV_TAC (dropq_conv "u"); + REAL_ARITH_TAC; + KILL 6; + (* - *) + TYPE_THEN `?x'. point(u, t + SND y) = f (point x')` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); + TSPEC `point (u,t + SND y)` 2; + RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]); + USE 7 (MATCH_MP point_onto); + TYPE_THEN `y'` UNABBREV_TAC; + TYPE_THEN `p` EXISTS_TAC; + (* - *) + TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x; + UND 4 THEN REWRITE_TAC[PAIR_SPLIT ]; + UND 7 THEN REAL_ARITH_TAC; + TYPE_THEN `t'` EXISTS_TAC; + AP_TERM_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;]; + CONJ_TAC; + UND 7 THEN REAL_ARITH_TAC; + (* - *) + TSPEC `x'` 5; + TYPE_THEN `f (point x')` UNABBREV_TAC; + USE 5 (REWRITE_RULE[point_inj;PAIR_SPLIT;]); + UND 5 THEN REAL_ARITH_TAC; + (* Tue Sep 7 22:08:48 EDT 2004 *) + + ]);; + (* }}} *) + +let r_scale_h = prove_by_refinement( + `!r. (&0 < r) ==> (h_compat (r_scale r))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC h_compat_bij; + TYPE_THEN `&0` EXISTS_TAC; + REDUCE_TAC; + ASM_SIMP_TAC [r_scale_bij]; + REWRITE_TAC[r_scale]; + COND_CASES_TAC; + (* Tue Sep 7 22:11:42 EDT 2004 *) + + ]);; + (* }}} *) + +let h_compat_bij2 = prove_by_refinement( + `!f s. (BIJ f (euclid 2) (euclid 2) /\ + (!x. f (point x) 1 = s(SND x)) /\ (INJ s UNIV UNIV) ==> + h_compat f)`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;h_compat]; + TYPE_THEN `x = y` ASM_CASES_TAC; + REWRITE_TAC[mk_line_pt]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE;INR IN_SING]; + EQ_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN`point y` EXISTS_TAC; + (* - *) + TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, s(SND x) ))` SUBAGOAL_TAC; + TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); + USE 6 (MATCH_MP point_onto); + REWRITE_TAC[point_inj ;PAIR_SPLIT;]; + TSPEC `x'` 2; + REWR 2; + UND 2 THEN REWRITE_TAC[coord01]; + (* A- *) + UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t)); + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + TYPE_THEN `x'` UNABBREV_TAC; + UND 8 THEN REWRITE_TAC[mk_line]; + TYPE_THEN `x''` UNABBREV_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + TYPE_THEN `x' = (t * FST x + (&1 - t) * FST y,t * SND y + (&1 - t) * SND y)` ABBREV_TAC ; + TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + REAL_ARITH_TAC; + KILL 9; + COPY 6; + TSPEC `x'` 6; + UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); + REWRITE_TAC[point_inj ;PAIR_SPLIT;]; + TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x; + TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC; + UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); + REWRITE_TAC[point_inj ;PAIR_SPLIT ]; + UND 6 THEN REAL_ARITH_TAC; + UND 5 THEN REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM point_inj]; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `t` EXISTS_TAC; + CONJ_TAC; + UND 6 THEN REAL_ARITH_TAC; + REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[mk_line;SUBSET;IMAGE]; + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `?u. (euclid_plus (t *# point (f (point x) 0,s(SND y))) ((&1 - t) *# point (f (point y) 0,s(SND y)))) = point (u , s(SND y))` SUBAGOAL_TAC; + REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;]; + CONV_TAC (dropq_conv "u"); + REAL_ARITH_TAC; + ONCE_ASM_REWRITE_TAC []; + UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + (* - *) + TYPE_THEN `?x'. point(u, s(SND y)) = f (point x')` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); + TSPEC `point (u,s(SND y))` 3; + RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]); + USE 8 (MATCH_MP point_onto); + TYPE_THEN `y'` UNABBREV_TAC; + TYPE_THEN `p` EXISTS_TAC; + (* B- *) + TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x; + UND 5 THEN REWRITE_TAC[PAIR_SPLIT ]; + UND 8 THEN REAL_ARITH_TAC; + + TYPE_THEN `t` EXISTS_TAC; + AP_TERM_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;]; + CONJ_TAC; + UND 8 THEN REAL_ARITH_TAC; + (* - *) + TSPEC `x'` 6; + TYPE_THEN `f (point x')` UNABBREV_TAC; + USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]); + TYPE_THEN `SND y = SND x'` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 12 THEN REAL_ARITH_TAC; + (* Wed Sep 8 20:04:34 EDT 2004 *) + + ]);; + (* }}} *) + +let u_scale_h = prove_by_refinement( + `!r. (&0 < r) ==> (h_compat (u_scale r))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC h_compat_bij2; + TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC; + ASM_SIMP_TAC[u_scale_bij]; + CONJ_TAC; + REWRITE_TAC[u_scale]; + TYPE_THEN `&0 < SND x` ASM_CASES_TAC; + REWRITE_TAC[coord01]; + TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC; + REWRITE_TAC[INJ]; + UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC; + IMATCH_MP_TAC REAL_EQ_LMUL_IMP; + UNIFY_EXISTS_TAC; + UND 0 THEN REAL_ARITH_TAC; + TYPE_THEN `y` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 2 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + TYPE_THEN `x` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 3 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + ]);; + (* }}} *) + +let v_compat_bij2 = prove_by_refinement( + `!f s. (BIJ f (euclid 2) (euclid 2) /\ + (!x. f (point x) 0 = s(FST x)) /\ (INJ s UNIV UNIV) ==> + v_compat f)`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;v_compat]; + TYPE_THEN `x = y` ASM_CASES_TAC; + REWRITE_TAC[mk_line_pt]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE;INR IN_SING]; + EQ_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN`point y` EXISTS_TAC; + (* - *) + TYPE_THEN `!x. f (point x) = point(s(FST x), (f (point x)) 1 )` SUBAGOAL_TAC; + TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); + USE 6 (MATCH_MP point_onto); + REWRITE_TAC[point_inj ;PAIR_SPLIT;]; + TSPEC `x'` 2; + REWR 2; + UND 2 THEN REWRITE_TAC[coord01]; + (* A- *) + UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t)); + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET;]; + TYPE_THEN `x'` UNABBREV_TAC; + UND 8 THEN REWRITE_TAC[mk_line]; + TYPE_THEN `x''` UNABBREV_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add]; + TYPE_THEN `x' = (t * FST y + (&1 - t) * FST y,t * SND x + (&1 - t) * SND y)` ABBREV_TAC ; + TYPE_THEN `FST x' = FST y` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + REAL_ARITH_TAC; + KILL 9; + COPY 6; + TSPEC `x'` 6; + UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); + REWRITE_TAC[point_inj ;PAIR_SPLIT;]; + TH_INTRO_TAC[`f (point x') 1 - f(point y) 1`;`f (point x) 1 - f (point y) 1`] lin_solve_x; + TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC; + UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t])); + REWRITE_TAC[point_inj ;PAIR_SPLIT ]; + UND 6 THEN REAL_ARITH_TAC; + UND 5 THEN REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM point_inj]; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `t` EXISTS_TAC; + CONJ_TAC; + UND 6 THEN REAL_ARITH_TAC; + UND 6 THEN REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[mk_line;SUBSET;IMAGE]; + CONV_TAC (dropq_conv "x''"); + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `?u. (euclid_plus (t *# (f (point x))) ((&1 - t) *# (f (point y)))) = point ( s(FST y), u)` SUBAGOAL_TAC; + ONCE_ASM_REWRITE_TAC[]; + REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;]; + CONV_TAC (dropq_conv "u"); + REAL_ARITH_TAC; + (* - *) + TYPE_THEN `?x'. point( s(FST y),u) = f (point x')` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SURJ]); + TSPEC `point (s(FST y),u)` 3; + RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]); + USE 9 (MATCH_MP point_onto); + TYPE_THEN `y'` UNABBREV_TAC; + TYPE_THEN `p` EXISTS_TAC; + (* B- *) + TH_INTRO_TAC[`SND x' - SND y`;`SND x - SND y`] lin_solve_x; + UND 5 THEN REWRITE_TAC[PAIR_SPLIT ]; + UND 9 THEN REAL_ARITH_TAC; + TYPE_THEN `t'` EXISTS_TAC; + AP_TERM_TAC; + TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC; + TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC; + TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + UND 9 THEN REAL_ARITH_TAC; + (* - *) + TSPEC `x'` 6; + TYPE_THEN `f (point x')` UNABBREV_TAC; + USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]); + TYPE_THEN `FST y = FST x'` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 13 THEN REAL_ARITH_TAC; + (* Wed Sep 8 21:10:34 EDT 2004 *) + + + ]);; + (* }}} *) + +let r_scale_v = prove_by_refinement( + `!r. (&0 < r) ==> (v_compat (r_scale r))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC v_compat_bij2; + TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC; + ASM_SIMP_TAC[r_scale_bij]; + CONJ_TAC; + REWRITE_TAC[r_scale]; + TYPE_THEN `&0 < FST x` ASM_CASES_TAC; + REWRITE_TAC[coord01]; + TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC; + REWRITE_TAC[INJ]; + UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC; + IMATCH_MP_TAC REAL_EQ_LMUL_IMP; + UNIFY_EXISTS_TAC; + UND 0 THEN REAL_ARITH_TAC; + TYPE_THEN `y` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 2 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + TYPE_THEN `x` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 3 THEN REWRITE_TAC[]; + IMATCH_MP_TAC REAL_PROP_POS_MUL2; + ]);; + (* }}} *) + +let u_scale_v = prove_by_refinement( + `!r. (&0 < r) ==> (v_compat (u_scale r))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC v_compat_bij2; + TYPE_THEN `(\ z. &0 + z)` EXISTS_TAC; + ASM_SIMP_TAC[u_scale_bij]; + REDUCE_TAC; + CONJ_TAC; + REWRITE_TAC[u_scale]; + COND_CASES_TAC; + REWRITE_TAC[INJ]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* SECTION Q *) +(* ------------------------------------------------------------------ *) + +let mk_line_hyper2_fst = prove_by_refinement( + `!x y. (FST x = FST y) ==> (mk_line (point x) (point y) SUBSET + hyperplane 2 e1 (FST x))`, + (* {{{ proof *) + [ + REWRITE_TAC[]; + TYPE_THEN `x = y` ASM_CASES_TAC; + REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ]; + REWRITE_TAC[e1;GSYM line2D_F;SUBSET;mk_line;]; + TYPE_THEN `y` EXISTS_TAC; + (* - *) + IMATCH_MP_TAC (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]])); + REWRITE_TAC[GSYM mk_line_hyper2_e1]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + IMATCH_MP_TAC mk_line_2; + REWRITE_TAC[mk_line_hyper2_e1;]; + REWRITE_TAC[e1;GSYM line2D_F;point_inj;PAIR_SPLIT]; + CONJ_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `y` EXISTS_TAC; + UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT]; + (* Thu Sep 9 10:13:23 EDT 2004 *) + + ]);; + (* }}} *) + +let mk_line_hyper2_snd = prove_by_refinement( + `!x y. (SND x = SND y) ==> (mk_line (point x) (point y) SUBSET + hyperplane 2 e2 (SND x))`, + (* {{{ proof *) + [ + REWRITE_TAC[]; + TYPE_THEN `x = y` ASM_CASES_TAC; + REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ]; + REWRITE_TAC[e2;GSYM line2D_S;SUBSET;mk_line;]; + TYPE_THEN `y` EXISTS_TAC; + (* - *) + IMATCH_MP_TAC (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]])); + REWRITE_TAC[GSYM mk_line_hyper2_e2]; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + IMATCH_MP_TAC mk_line_2; + REWRITE_TAC[mk_line_hyper2_e2;]; + REWRITE_TAC[e2;GSYM line2D_S;point_inj;PAIR_SPLIT]; + CONJ_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `y` EXISTS_TAC; + UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT]; + (* Thu Sep 9 10:16:19 EDT 2004 *) + ]);; + (* }}} *) + +let hv_line_hyper = prove_by_refinement( + `!E e. hv_line E /\ E e ==> (?z. + (e SUBSET hyperplane 2 e1 z) \/ (e SUBSET hyperplane 2 e2 z))`, + (* {{{ proof *) + [ + REWRITE_TAC[hv_line]; + TSPEC `e` 1; + REP_BASIC_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `FST y` EXISTS_TAC; + DISJ1_TAC; + USE 3 SYM; + IMATCH_MP_TAC mk_line_hyper2_fst; + TYPE_THEN `SND x` EXISTS_TAC; + USE 3 SYM; + DISJ2_TAC; + IMATCH_MP_TAC mk_line_hyper2_snd; + (* Thu Sep 9 10:20:05 EDT 2004 *) + + ]);; + (* }}} *) + +let hv_line_hyper2 = prove_by_refinement( + `!E. hv_line E /\ FINITE E ==> (?E'. + (UNIONS E SUBSET UNIONS E') /\ (FINITE E') /\ + (!e. E' e ==> + (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!e. ?h. (E e ==> (e SUBSET h /\ (?z. (h = hyperplane 2 e1 z) \/ (h = hyperplane 2 e2 z))))` SUBAGOAL_TAC; + RIGHT_TAC "h"; + TH_INTRO_TAC[`E`;`e`] hv_line_hyper; + FIRST_ASSUM DISJ_CASES_TAC; + UNIFY_EXISTS_TAC; + TYPE_THEN `z` EXISTS_TAC; + UNIFY_EXISTS_TAC; + TYPE_THEN `z` EXISTS_TAC; + LEFT 2 "h"; + TYPE_THEN `IMAGE h E` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[UNIONS;SUBSET;IMAGE]; + CONV_TAC (dropq_conv "u"); + NAME_CONFLICT_TAC; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[ISUBSET]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]); + ASM_MESON_TAC[]; + (* Thu Sep 9 10:32:28 EDT 2004 *) + + ]);; + (* }}} *) + +let finite_graph_edge = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_edge G) /\ + graph_isomorphic G H ==> FINITE (graph_edge H)`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_isomorphic;graph_iso]; + ASM_MESON_TAC[FINITE_BIJ]; + ]);; + (* }}} *) + +let finite_graph_vertex = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_vertex G) /\ + graph_isomorphic G H ==> FINITE (graph_vertex H)`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_isomorphic;graph_iso]; + ASM_MESON_TAC[FINITE_BIJ]; + ]);; + (* }}} *) + +let graph_edge_nonempty = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t). ~(graph_edge G = EMPTY ) /\ + graph_isomorphic G H ==> ~(graph_edge H = EMPTY )`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_isomorphic;graph_iso]; + USE 5 (REWRITE_RULE[EMPTY_EXISTS]); + UND 0 THEN (REWRITE_TAC [EMPTY_EXISTS]); + TYPE_THEN `v u'` EXISTS_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + ]);; + (* }}} *) + +let graph_edge_around_finite = prove_by_refinement( + `!(G:(A,B)graph_t) v. + (FINITE (graph_edge G)) ==> (FINITE (graph_edge_around G v))`, + (* {{{ proof *) + [ + REWRITE_TAC[graph_edge_around]; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET]; + ]);; + (* }}} *) + +let graph_edge_around4 = prove_by_refinement( + `!(G:(A,B)graph_t) (H:(A',B')graph_t). (graph G) /\ + (FINITE (graph_edge G)) /\ + (!v. CARD (graph_edge_around G v) <=| 4) /\ + graph_isomorphic G H ==> (!v. CARD (graph_edge_around H v) <=| 4)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `graph_vertex H v` ASM_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE [graph_isomorphic]); + TYPE_THEN `?v'. (graph_vertex G v' /\ ((FST f) v' = v))` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT ;graph_iso]); + USE 6 (REWRITE_RULE[BIJ;SURJ]); + TYPE_THEN `v` UNABBREV_TAC; + TH_INTRO_TAC[`G`;`H`;`f`;`v'`] graph_iso_around; + TH_INTRO_TAC[`SND f`; `(graph_edge_around G v')`] CARD_IMAGE_LE; + IMATCH_MP_TAC graph_edge_around_finite; + IMATCH_MP_TAC LE_TRANS; + UNIFY_EXISTS_TAC; + ASM_MESON_TAC [ARITH_RULE `0 <=| 4`; CARD_CLAUSES;graph_isomorphic_graph;graph_edge_around_empty]; + (* Thu Sep 9 11:49:01 EDT 2004 *) + + ]);; + + (* }}} *) + +let graph_near_support = prove_by_refinement( + `!(G:(A,B)graph_t). (planar_graph G) /\ + FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) + ==> (?H E. graph_isomorphic G H /\ + (FINITE E) /\ (good_plane_graph H) /\ + (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\ + (!v. (graph_vertex H v ==> + E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\ + (!e. (E e ==> + (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TH_INTRO_TAC[`G`] planar_graph_hv; + TYPE_THEN `H` EXISTS_TAC; + TYPE_THEN `A = IMAGE (\ v. hyperplane 2 e1 (v 0)) (graph_vertex H)` ABBREV_TAC ; + TYPE_THEN `B = IMAGE (\ v. hyperplane 2 e2 (v 1)) (graph_vertex H)` ABBREV_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]); + LEFT 5 "E"; + LEFT 5 "E"; + TYPE_THEN `?E'. !e. (graph_edge H e ==> (e SUBSET UNIONS (E' e)) /\ (FINITE (E' e)) /\ (!e'. E' e e' ==> (?z. (e' = hyperplane 2 e1 z) \/ (e' = hyperplane 2 e2 z))))` SUBAGOAL_TAC; + LEFT_TAC "e"; + RIGHT_TAC "E'"; + TSPEC `e` 5; + TH_INTRO_TAC[`E e`] hv_line_hyper2; + TYPE_THEN `E'` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + (* - *) + TYPE_THEN `C = UNIONS (IMAGE E' (graph_edge H))` ABBREV_TAC ; + TYPE_THEN `A UNION B UNION C` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + CONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC finite_graph_vertex; + UNIFY_EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC finite_graph_vertex; + UNIFY_EXISTS_TAC; + TYPE_THEN `C` UNABBREV_TAC; + TH_INTRO_TAC[`IMAGE E' (graph_edge H)`] FINITE_FINITE_UNIONS; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC finite_graph_edge; + UNIFY_EXISTS_TAC; + USE 11 (REWRITE_RULE[IMAGE]); + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + REWRITE_TAC[UNIONS_UNION]; + IMATCH_MP_TAC in_union; + DISJ2_TAC; + IMATCH_MP_TAC in_union; + DISJ2_TAC; + TYPE_THEN `C` UNABBREV_TAC; + TSPEC `e` 10; + REP_BASIC_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + REWRITE_TAC[SUBSET;UNIONS;IMAGE;]; + CONV_TAC (dropq_conv "u"); + UNIFY_EXISTS_TAC; + (* - *) + CONJ_TAC; + REWRITE_TAC[UNION]; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + CONJ_TAC; + DISJ1_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISJ2_TAC; + DISJ1_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + USE 12 (REWRITE_RULE[UNION]); + UND 12 THEN REP_CASES_TAC; + TYPE_THEN `A` UNABBREV_TAC; + USE 12 (REWRITE_RULE[IMAGE]); + MESON_TAC[]; + TYPE_THEN `B` UNABBREV_TAC; + USE 12 (REWRITE_RULE[IMAGE]); + MESON_TAC[]; + TYPE_THEN `C` UNABBREV_TAC; + USE 12 (REWRITE_RULE[IMAGE;UNIONS]); + TYPE_THEN `u` UNABBREV_TAC; + TSPEC `x` 10; + (* Thu Sep 9 12:12:51 EDT 2004 *) + + ]);; + (* }}} *) + +let h_translate_point = prove_by_refinement( + `!u v r. (h_translate r (point (u,v)) = point (u+r,v))`, + (* {{{ proof *) + [ + REWRITE_TAC[h_translate;e1;point_scale;point_add]; + REDUCE_TAC; + ]);; + (* }}} *) + +let v_translate_point = prove_by_refinement( + `!u v r. (v_translate r (point (u,v)) = point (u,v + r))`, + (* {{{ proof *) + [ + REWRITE_TAC[v_translate;e2;point_scale;point_add]; + REDUCE_TAC; + ]);; + (* }}} *) + +let hyperplane1_h_translate = prove_by_refinement( + `!z r. (IMAGE (h_translate r) (hyperplane 2 e1 z) = + (hyperplane 2 e1 (z + r)))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e1]; + ASSUME_TAC v_compat; + TSPEC `(h_translate r)` 0; + RULE_ASSUM_TAC (REWRITE_RULE[h_translate_v]); + UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`z, &0`;`z, &1`])); + REWRITE_TAC[h_translate_point]; + ]);; + (* }}} *) + +let hyperplane2_h_translate = prove_by_refinement( + `!z r. (IMAGE (h_translate r) (hyperplane 2 e2 z) = + (hyperplane 2 e2 z))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e2]; + ASSUME_TAC h_compat; + TSPEC `(h_translate r)` 0; + RULE_ASSUM_TAC (REWRITE_RULE[h_translate_h]); + UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;` &1,z`])); + REWRITE_TAC[h_translate_point]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC mk_line_2; + REWRITE_TAC[mk_line_hyper2_e2;]; + REWRITE_TAC[GSYM line2D_S;e2;point_inj ]; + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]); + UND 1 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let hyperplane2_v_translate = prove_by_refinement( + `!z r. (IMAGE (v_translate r) (hyperplane 2 e2 z) = + (hyperplane 2 e2 (z + r)))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e2]; + ASSUME_TAC h_compat; + TSPEC `(v_translate r)` 0; + RULE_ASSUM_TAC (REWRITE_RULE[v_translate_h]); + UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`])); + REWRITE_TAC[v_translate_point]; + ]);; + (* }}} *) + +let hyperplane1_v_translate = prove_by_refinement( + `!z r. (IMAGE (v_translate r) (hyperplane 2 e1 z) = + (hyperplane 2 e1 z))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e1]; + ASSUME_TAC v_compat; + TSPEC `(v_translate r)` 0; + RULE_ASSUM_TAC (REWRITE_RULE[v_translate_v]); + UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`])); + REWRITE_TAC[v_translate_point]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC mk_line_2; + REWRITE_TAC[mk_line_hyper2_e1;]; + REWRITE_TAC[GSYM line2D_F;e1;point_inj ]; + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]); + UND 1 THEN REAL_ARITH_TAC; + (* Thu Sep 9 13:43:45 EDT 2004 *) + + ]);; + (* }}} *) + +let r_scale_point = prove_by_refinement( + `!r u v. (r_scale r (point (u,v))) = + point ((if (&0 < u) then r*u else u),v)`, + (* {{{ proof *) + [ + REWRITE_TAC[r_scale]; + TYPE_THEN `&0 < u` ASM_CASES_TAC; + ]);; + (* }}} *) + +let u_scale_point = prove_by_refinement( + `!r u v. (u_scale r (point (u,v))) = + point (u,(if (&0 < v) then r*v else v))`, + (* {{{ proof *) + [ + REWRITE_TAC[u_scale]; + TYPE_THEN `&0 < v` ASM_CASES_TAC; + ]);; + (* }}} *) + +let hyperplane2_r_scale = prove_by_refinement( + `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e2 z) = + (hyperplane 2 e2 z))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e2]; + ASSUME_TAC h_compat; + TSPEC `(r_scale r)` 1; + TYPE_THEN `h_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_h];ALL_TAC]; + REWR 1; + UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;`&1,z`])); + REWRITE_TAC[r_scale_point]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC mk_line_2; + REWRITE_TAC[REAL_ARITH `~(&0 < &0)`]; + REWRITE_TAC[mk_line_hyper2_e2;]; + REWRITE_TAC[GSYM line2D_S;e2;point_inj ]; + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]); + UND 3 THEN UND 0 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let hyperplane1_r_scale = prove_by_refinement( + `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e1 z) = + (hyperplane 2 e1 (if &0 < z then r*z else z)))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e1]; + ASSUME_TAC v_compat; + TSPEC `(r_scale r)` 1; + TYPE_THEN `v_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_v];ALL_TAC]; + REWR 1; + UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`z,&0`;`z,&1`])); + REWRITE_TAC[r_scale_point]; + ]);; + (* }}} *) + +let hyperplane1_u_scale = prove_by_refinement( + `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e1 z) = + (hyperplane 2 e1 z))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e1]; + ASSUME_TAC v_compat; + TSPEC `(u_scale r)` 1; + TYPE_THEN `v_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_v];ALL_TAC]; + REWR 1; + UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`])); + REWRITE_TAC[u_scale_point]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC mk_line_2; + REWRITE_TAC[REAL_ARITH `~(&0 < &0)`]; + REWRITE_TAC[mk_line_hyper2_e1;]; + REWRITE_TAC[GSYM line2D_F;e1;point_inj ]; + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + CONJ_TAC; + CONV_TAC (dropq_conv "p"); + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]); + UND 3 THEN UND 0 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let hyperplane2_u_scale = prove_by_refinement( + `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e2 z) = + (hyperplane 2 e2 (if &0 < z then r*z else z)))`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM mk_line_hyper2_e2]; + ASSUME_TAC h_compat; + TSPEC `(u_scale r)` 1; + TYPE_THEN `h_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_h];ALL_TAC]; + REWR 1; + UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`])); + REWRITE_TAC[u_scale_point]; + (* Thu Sep 9 14:04:58 EDT 2004 *) + + ]);; + (* }}} *) + +let homeomorphism_compose = prove_by_refinement( + `!U V W (f:A->B) (g:B->C). homeomorphism f U V /\ homeomorphism g V W + ==> + homeomorphism (g o f) U W`, + (* {{{ proof *) + [ + REWRITE_TAC[homeomorphism]; + SUBCONJ_TAC; + REWRITE_TAC[comp_comp]; + IMATCH_MP_TAC COMP_BIJ; + UNIFY_EXISTS_TAC; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + UNIFY_EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + REWRITE_TAC[IMAGE_o]; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let hyperplane1_inj = prove_by_refinement( + `!z w. (hyperplane 2 e1 z = hyperplane 2 e1 w) ==> (z = w)`, + (* {{{ proof *) + [ + REWRITE_TAC[e1; GSYM line2D_F]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[]); + TSPEC `point(z,&0)` 0; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); + USE 0 SYM; + TYPE_THEN `(?p. (z,&0 = p) /\ (FST p = z))` SUBAGOAL_TAC; + CONV_TAC (dropq_conv "p"); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let hyperplane2_inj = prove_by_refinement( + `!z w. (hyperplane 2 e2 z = hyperplane 2 e2 w) ==> (z = w)`, + (* {{{ proof *) + [ + REWRITE_TAC[e2; GSYM line2D_S]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[]); + TSPEC `point(z,z)` 0; + RULE_ASSUM_TAC (REWRITE_RULE[point_inj]); + USE 0 SYM; + TYPE_THEN `(?p. (z,z = p) /\ (SND p = z))` SUBAGOAL_TAC; + CONV_TAC (dropq_conv "p"); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let graph_support_init = prove_by_refinement( + `!(G:(A,B)graph_t). (planar_graph G) /\ + FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) + ==> (?H E. graph_isomorphic G H /\ + (FINITE E) /\ (good_plane_graph H) /\ + (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\ + (!v. (graph_vertex H v ==> + E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\ + (!e. (E e ==> + (?z. (&0 < z) /\ + ((e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TH_INTRO_TAC[`G`] graph_near_support; + TYPE_THEN `EH = E INTER { h | ?z. (h = hyperplane 2 e1 z) }` ABBREV_TAC ; + TYPE_THEN `EV = E INTER {h | ?z. (h = hyperplane 2 e2 z) }` ABBREV_TAC ; + TYPE_THEN `E = EH UNION EV` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + TYPE_THEN `EH` UNABBREV_TAC; + TYPE_THEN `EV` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INTER;UNION]; + ASM_MESON_TAC[]; + REWRITE_TAC[UNION;SUBSET]; + TYPE_THEN `EH` UNABBREV_TAC; + TYPE_THEN `EV` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INTER;GSYM LEFT_AND_OVER_OR]); + (* - *) + TYPE_THEN `FINITE EH /\ FINITE EV` SUBAGOAL_TAC; + USE 13 SYM; + USE 13 (MATCH_MP union_imp_subset); + ASM_MESON_TAC[FINITE_SUBSET]; +(*** Modified by JRH for new theorem name + TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE; + ***) + TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE_IMP; + TYPE_THEN `EH` UNABBREV_TAC; + REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV]; +(*** Modified by JRH for new theorem name + TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE; + ***) + TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE_IMP; + TYPE_THEN `EV` UNABBREV_TAC; + REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV]; + (* - *) + WITH 21 (MATCH_MP finite_LB); + WITH 18 (MATCH_MP finite_LB); + TYPE_THEN `f = (h_translate (&1 - t')) o (v_translate (&1 - t))` ABBREV_TAC ; + TYPE_THEN `plane_graph_image f H` EXISTS_TAC; + TYPE_THEN `IMAGE2 f E` EXISTS_TAC; + (* A- *) + TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC; + TYPE_THEN `f` UNABBREV_TAC; + IMATCH_MP_TAC homeomorphism_compose; + TYPE_THEN `top2` EXISTS_TAC; + REWRITE_TAC[v_translate_hom;h_translate_hom]; + (* - *) + TYPE_THEN `graph_isomorphic H (plane_graph_image f H)` SUBAGOAL_TAC; + IMATCH_MP_TAC plane_graph_image_iso; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph]); + (* - *) + CONJ_TAC; + TH_INTRO_TAC[`G`;`H`;`plane_graph_image f H`] graph_isomorphic_trans; + (* - *) + CONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[FINITE_UNION]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC plane_graph_image_plane; + (* B- *) + TYPE_THEN `!z. IMAGE f (hyperplane 2 e1 z) = hyperplane 2 e1 (z - t' + &1)` SUBAGOAL_TAC; + TYPE_THEN `f` UNABBREV_TAC; + REWRITE_TAC[IMAGE_o;hyperplane1_v_translate;hyperplane1_h_translate]; + AP_TERM_TAC; + REAL_ARITH_TAC; + TYPE_THEN `!z. IMAGE f (hyperplane 2 e2 z) = hyperplane 2 e2 (z - t + &1)` SUBAGOAL_TAC; + TYPE_THEN `f` UNABBREV_TAC; + REWRITE_TAC[IMAGE_o;hyperplane2_v_translate;hyperplane2_h_translate]; + AP_TERM_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[IMAGE2;GSYM image_unions;]; + REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;IMAGE2]; + (* - *) + CONJ_TAC; + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + USE 29 (REWRITE_RULE[IMAGE]); + TYPE_THEN `g` UNABBREV_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + USE 13 GSYM; + FIRST_ASSUM IMATCH_MP_TAC ; + (* C- *) + USE 13 GSYM; + CONJ_TAC; + USE 29 (REWRITE_RULE[IMAGE]); + TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]); + USE 31 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `v` UNABBREV_TAC; + TYPE_THEN `f (point p) = point(FST p - t' + &1 , SND p - t + &1)` SUBAGOAL_TAC; + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `p = FST p,SND p` SUBAGOAL_TAC; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;]; + PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;]; + REWRITE_TAC[point_inj ;PAIR_SPLIT]; + REAL_ARITH_TAC; + USE 28 GSYM ; + USE 27 GSYM; + TSPEC `point p` 6; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + RULE_ASSUM_TAC (REWRITE_RULE[coord01]); + IMATCH_MP_TAC image_imp; + RULE_ASSUM_TAC (REWRITE_RULE[coord01]); + (* D- *) + TYPE_THEN `g = IMAGE f` ABBREV_TAC ; + USE 29 (REWRITE_RULE[IMAGE]); + TYPE_THEN `EH x \/ EV x` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `EH` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INTER]); + ASM_REWRITE_TAC[]; + TYPE_THEN `z - t' + &1` EXISTS_TAC; + TYPE_THEN `s' z` SUBAGOAL_TAC; + USE 16 (REWRITE_RULE[SUBSET;IMAGE]); + TSPEC `x` 16; + REWR 16; + LEFT 16 "z'"; + TSPEC `z` 16; + REWR 16; + TYPE_THEN `z = x'` SUBAGOAL_TAC; + IMATCH_MP_TAC hyperplane1_inj; + ASM_REWRITE_TAC[]; + TSPEC `z` 23; + UND 23 THEN REAL_ARITH_TAC; + TYPE_THEN `EV` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INTER]); + ASM_REWRITE_TAC[]; + TYPE_THEN `z - t + &1` EXISTS_TAC; + TYPE_THEN `s'' z` SUBAGOAL_TAC; + USE 19 (REWRITE_RULE[SUBSET;IMAGE]); + TSPEC `x` 19; + REWR 19; + LEFT 19 "z'"; + TSPEC `z` 19; + REWR 19; + TYPE_THEN `z = x'` SUBAGOAL_TAC; + IMATCH_MP_TAC hyperplane2_inj; + ASM_REWRITE_TAC[]; + TSPEC `z` 22; + UND 22 THEN REAL_ARITH_TAC; + (* Thu Sep 9 17:00:37 EDT 2004 *) + + ]);; + (* }}} *) + +let hyperplane_ne = prove_by_refinement( + `!z z'. ~(hyperplane 2 e1 z = hyperplane 2 e2 z')`, + (* {{{ proof *) + [ + REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F]; + RULE_ASSUM_TAC (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `point(z, z'+ &1)` 0; + REWR 0; + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;point_inj]); + USE 0 SYM; + TYPE_THEN `(?p. ((z = FST p) /\ (z' + &1 = SND p)) /\ (FST p = z))` SUBAGOAL_TAC; + TYPE_THEN `(z,z' + &1)` EXISTS_TAC; + ASSUME_TAC (REAL_ARITH `~(z' + &1 = z')`); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* SECTION R *) +(* ------------------------------------------------------------------ *) + + +extend_simp_rewrites[UNION_EMPTY ];; + +let inductive_set_restrict = prove_by_refinement( + `!G A S. inductive_set G S /\ + ~(S INTER A = EMPTY) /\ + segment A /\ A SUBSET G ==> inductive_set A (S INTER A)`, + (* {{{ proof *) + [ + REWRITE_TAC[inductive_set]; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET]; + REWRITE_TAC[INTER]; + FIRST_ASSUM IMATCH_MP_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[INTER]); + UNIFY_EXISTS_TAC; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let inductive_set_adj = prove_by_refinement( + `!A B S m. inductive_set (A UNION B) S /\ (endpoint B m) /\ + (FINITE A) /\ (FINITE B) /\ + (endpoint A m) /\ (A SUBSET S) ==> (~(S INTER B = EMPTY)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?e. A e /\ closure top2 e (pointI m)` SUBAGOAL_TAC; + TYPE_THEN `terminal_edge A m` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + TYPE_THEN `?e'. B e' /\ closure top2 e' (pointI m)` SUBAGOAL_TAC; + TYPE_THEN `terminal_edge B m` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + RULE_ASSUM_TAC (REWRITE_RULE[inductive_set]); + TSPEC `e` 6; + TSPEC `e'` 6; + (* - *) + TYPE_THEN `e = e'` ASM_CASES_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[SUBSET ;EQ_EMPTY;INTER; ]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `S e /\ (A UNION B) e' /\ adj e e'` SUBAGOAL_TAC; + CONJ_TAC; + ASM_MESON_TAC[ISUBSET]; + CONJ_TAC; + REWRITE_TAC[UNION]; + REWRITE_TAC[adj]; + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + UNIFY_EXISTS_TAC; + REWR 6; + RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY ;INTER]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inductive_set_join = prove_by_refinement( + `!A B S . ~(S INTER A = EMPTY) /\ (segment B) /\ (segment A) /\ + (?m. endpoint A m /\ endpoint B m) /\ + (inductive_set (A UNION B) S) ==> + (S = (A UNION B))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TH_INTRO_TAC[`A UNION B`;`A`;`S`] inductive_set_restrict; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `(S INTER A) = A` SUBAGOAL_TAC; + USE 6 (REWRITE_RULE[inductive_set]); + USE 3 (REWRITE_RULE[segment]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `A SUBSET S` SUBAGOAL_TAC; + UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + REWRITE_TAC[INTER;SUBSET]; + (* - *) + TH_INTRO_TAC [`A`;`B`;`S`;`m`] inductive_set_adj; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + (* - *) + TH_INTRO_TAC[`A UNION B`;`B`;`S`] inductive_set_restrict; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `(S INTER B) = B` SUBAGOAL_TAC; + USE 10 (REWRITE_RULE[inductive_set]); + USE 4 (REWRITE_RULE[segment]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `B SUBSET S` SUBAGOAL_TAC; + UND 11 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + REWRITE_TAC[INTER;SUBSET]; + IMATCH_MP_TAC SUBSET_ANTISYM; + USE 0 (REWRITE_RULE[inductive_set]); + REWRITE_TAC[union_subset]; + ]);; + (* }}} *) + +let segment_union = prove_by_refinement( + `!A B m. segment A /\ segment B /\ + endpoint A m /\ endpoint B m /\ + (A INTER B = EMPTY) /\ + (!n. (0 < num_closure A (pointI n)) /\ + (0 < num_closure B (pointI n)) ==> (n = m) ) + ==> + segment (A UNION B)` , + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* - *) + TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + (* - *) + REWRITE_TAC[segment]; + ASM_REWRITE_TAC[FINITE_UNION]; + (* - *) + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + UND 8 THEN REWRITE_TAC[EMPTY_EXISTS;UNION]; + TYPE_THEN `u` EXISTS_TAC; + (* - *) + CONJ_TAC; + REWRITE_TAC[union_subset]; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + (* - *) + TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + TYPE_THEN `A x` ASM_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]); + TSPEC `x` 1; + REWR 1; + TYPE_THEN `!m. num_closure(A UNION B) (pointI m) = num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC; + REWRITE_TAC[num_closure]; + IMATCH_MP_TAC (CARD_UNION); + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `A` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + REWRITE_TAC[SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `B` EXISTS_TAC; + REWRITE_TAC[SUBSET]; + REWRITE_TAC[EQ_EMPTY ]; + RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]); + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC; + REDUCE_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC; + REDUCE_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + UND 10 THEN UND 11 THEN REWRITE_TAC [ARITH_RULE `~(x = 0) <=> (0 < x)`]; + TYPE_THEN `m' = m` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[endpoint]); + REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT]; + (* -A *) + TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC; + REWRITE_TAC[inductive_set]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC; + (* -- cut here *) + IMATCH_MP_TAC inductive_set_join; + UNIFY_EXISTS_TAC; + REWR 14; + TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC; + UND 15 THEN UND 14 THEN UND 11 THEN UND 12 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[]; + (* - *) + ONCE_REWRITE_TAC [UNION_COMM]; + IMATCH_MP_TAC inductive_set_join; + ONCE_REWRITE_TAC [UNION_COMM]; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let two_endpoint_segment = prove_by_refinement( + `!C p q m. segment C /\ endpoint C q /\ endpoint C p /\ endpoint C m /\ + ~(m = p) ==> + (q = m) \/ (q = p)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `psegment C` SUBAGOAL_TAC; + IMATCH_MP_TAC endpoint_psegment; + UNIFY_EXISTS_TAC; + (* - *) + TH_INTRO_TAC[`C`] endpoint_size2; + IMATCH_MP_TAC (TAUT `(~A ==> B) ==> (A \/ B)`); + IMATCH_MP_TAC two_exclusion; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let EQ_ANTISYM = prove_by_refinement( + `!A B. (A ==>B) /\ (B ==> A) ==> (A = B)`, + (* {{{ proof *) + [ + MESON_TAC[]; + ]);; + (* }}} *) + +let segment_union2 = prove_by_refinement( + `!A B m p. segment A /\ segment B /\ ~(m = p) /\ + endpoint A m /\ endpoint B m /\ + endpoint A p /\ endpoint B p /\ + (A INTER B = EMPTY) /\ + (!n. (0 < num_closure A (pointI n)) /\ (0 < num_closure B (pointI n)) <=> + (((n = m ) \/ (n = p) ))) + ==> + rectagon (A UNION B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + (* - *) + REWRITE_TAC[rectagon]; + ASM_REWRITE_TAC[FINITE_UNION]; + (* - *) + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]); + UND 11 THEN REWRITE_TAC[EMPTY_EXISTS;UNION]; + TYPE_THEN `u` EXISTS_TAC; + (* - *) + CONJ_TAC; + REWRITE_TAC[union_subset]; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + (* - *) + TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + TYPE_THEN `A x` ASM_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]); + TSPEC `x` 1; + REWR 1; + (* - *) + TYPE_THEN `!m. num_closure(A UNION B) (pointI m) = num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC; + REWRITE_TAC[num_closure]; + IMATCH_MP_TAC (CARD_UNION); + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `A` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + REWRITE_TAC[SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `B` EXISTS_TAC; + REWRITE_TAC[SUBSET]; + REWRITE_TAC[EQ_EMPTY ]; + RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!q. endpoint A q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC; + IMATCH_MP_TAC two_endpoint_segment; + UNIFY_EXISTS_TAC; + TYPE_THEN `!q. endpoint B q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC; + IMATCH_MP_TAC two_endpoint_segment; + TYPE_THEN `B` EXISTS_TAC; + UNIFY_EXISTS_TAC; + (* -A *) + TYPE_THEN `!m. (num_closure A (pointI m) = 1) <=> (num_closure B (pointI m) = 1)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + RULE_ASSUM_TAC (REWRITE_RULE[endpoint]); + CONJ_TAC; + TSPEC `m'` 13; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + TSPEC `m'` 14; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + FULL_REWRITE_TAC[endpoint]; + TYPE_THEN `!x. {0, 2} x <=> {0, 1, 2} x /\ ~(x = 1)` SUBAGOAL_TAC; + REWRITE_TAC[INSERT]; + ARITH_TAC; + KILL 16; + TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC; + REDUCE_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + TSPEC `m'` 15; + REWR 25; + UND 25 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC; + REDUCE_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[segment]); + ARITH_TAC; + FULL_REWRITE_TAC [ARITH_RULE `~(x = 0) <=> (0 < x)`]; + TYPE_THEN `(m' = m) \/ (m' = p)` SUBAGOAL_TAC; + TSPEC `m'` 0; + REWR 0; + TYPE_THEN `num_closure A (pointI m') = 1` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + TYPE_THEN `num_closure B (pointI m') = 1` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT;ARITH_RULE `~(2 = 1)`]; + (* - *) + TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC; + REWRITE_TAC[inductive_set]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC; + (* -- *) + IMATCH_MP_TAC inductive_set_join; + UNIFY_EXISTS_TAC; + REWR 20; + TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC; + UND 20 THEN UND 21 THEN UND 17 THEN UND 18 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[]; + (* - *) + ONCE_REWRITE_TAC [UNION_COMM]; + IMATCH_MP_TAC inductive_set_join; + ONCE_REWRITE_TAC [UNION_COMM]; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let card_inj = prove_by_refinement( + `!(f:A->B) A B. INJ f A B /\ FINITE B ==> (CARD A <= CARD B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `CARD (IMAGE f A) = CARD A` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_IMAGE_INJ; + CONJ_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC FINITE_INJ; + ASM_MESON_TAC[]; + USE 2 GSYM; + IMATCH_MP_TAC CARD_SUBSET; + RULE_ASSUM_TAC (REWRITE_RULE[INJ]); + REWRITE_TAC[IMAGE;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let inj_bij_size = prove_by_refinement( + `!A B (f:A->B). INJ f A B /\ B HAS_SIZE (CARD A) ==> BIJ f A B`, + (* {{{ proof *) + [ + REWRITE_TAC[HAS_SIZE]; + TH_INTRO_TAC [`f`;`A`] inj_bij; + FULL_REWRITE_TAC[INJ]; + ASM_MESON_TAC[]; + TYPE_THEN `IMAGE f A = B` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET_EQ; + CONJ_TAC; + FULL_REWRITE_TAC[INJ]; + REWRITE_TAC[IMAGE;SUBSET]; + ASM_MESON_TAC[]; + IMATCH_MP_TAC EQ_SYM; + IMATCH_MP_TAC BIJ_CARD; + UNIFY_EXISTS_TAC; + ASM_MESON_TAC[FINITE_INJ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let bij_empty = prove_by_refinement( + `!(f:A->B). BIJ f EMPTY EMPTY `, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;INJ;SURJ]; + ]);; + (* }}} *) + +let bij_sing = prove_by_refinement( + `!(f:A->B) a b. BIJ f {a} {b} <=> (f a = b)`, + (* {{{ proof *) + [ + REWRITE_TAC[BIJ;INJ;SURJ;INR IN_SING ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let card_sing = prove_by_refinement( + `!(a:A). (CARD {a} = 1)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`a`;`EMPTY:A->bool`] card_suc_insert; + REWRITE_TAC[FINITE_RULES]; + FULL_REWRITE_TAC[CARD_CLAUSES]; + TYPE_THEN `CARD {a}` UNABBREV_TAC; + ARITH_TAC; + ]);; + (* }}} *) + +let pair_indistinct = prove_by_refinement( + `!(a:A). {a,a} = {a}`, + (* {{{ proof *) + [ + MESON_TAC[INR ABSORPTION;INR COMPONENT]; + ]);; + (* }}} *) + +let has_size2_distinct = prove_by_refinement( + `!(a:A) b. {a,b} HAS_SIZE 2 ==> ~(a = b)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `b` UNABBREV_TAC; + FULL_REWRITE_TAC [pair_indistinct]; + THM_INTRO_TAC[`a`] sing_has_size1; + FULL_REWRITE_TAC[HAS_SIZE]; + UND 0 THEN UND 2 THEN ARITH_TAC; + ]);; + (* }}} *) + +let has_size2_subset = prove_by_refinement( + `!X (a:A) b. X HAS_SIZE 2 /\ X SUBSET {a,b} ==> (X = {a,b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + FULL_REWRITE_TAC [has_size2]; + TYPE_THEN `X` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + FULL_REWRITE_TAC[SUBSET;in_pair]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + COPY 0; + TSPEC `b'` 0; + TSPEC `a'` 3; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inj_subset2 = prove_by_refinement( + `!t t' s (f:A->B). INJ f s t /\ t SUBSET t' ==> INJ f s t'`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;SUBSET;]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let terminal_adj = prove_by_refinement( + `!E b. segment E /\ endpoint E b /\ ~(SING E) ==> + (?!e. E e /\ adj (terminal_edge E b) e )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[EXISTS_UNIQUE_ALT]; + THM_INTRO_TAC[`E`;`b`] terminal_endpoint; + FULL_REWRITE_TAC[segment]; + (* - *) + THM_INTRO_TAC[`terminal_edge E b`] two_endpoint; + FULL_REWRITE_TAC[segment;ISUBSET]; + (* - *) + FULL_REWRITE_TAC[has_size2]; + USE 6 (REWRITE_RULE[FUN_EQ_THM]); + TYPE_THEN `?x. !y. (closure top2 (terminal_edge E b) (pointI y) <=> ((y = x) \/ (y = b)))` SUBAGOAL_TAC; + USE 6 (REWRITE_RULE[in_pair]); + REWRITE_TAC[in_pair]; + TYPE_THEN `(b = b') \/ (b = a)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `a` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `b'` EXISTS_TAC; + (* - *) + TYPE_THEN `!e. (adj (terminal_edge E b) e /\ (E e) ==> (closure top2 e (pointI x)))` SUBAGOAL_TAC; + THM_INTRO_TAC[`terminal_edge E b`;`e`] edge_inter; + ASM_MESON_TAC[segment;ISUBSET]; + FULL_REWRITE_TAC[INTER;eq_sing]; + TSPEC `m` 7; + REWR 7; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`E`;`(pointI b)`] num_closure1; + FULL_REWRITE_TAC[segment]; + REWR 14; + COPY 14; + TSPEC `terminal_edge E b` 15; + TSPEC `e` 14; + TYPE_THEN `e' = terminal_edge E b` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e' = e` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[adj]; + UND 18 THEN UND 17 THEN UND 16 THEN MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`E`;`terminal_edge E b`] midpoint_exists; + FULL_REWRITE_TAC[SING]; + LEFT 0 "x" ; + TSPEC `terminal_edge E b` 0; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[midpoint]; + THM_INTRO_TAC[`E`;`(pointI m)`] num_closure2; + FULL_REWRITE_TAC[segment]; + REWR 11; + (* -DD *) + TYPE_THEN `?c. ~(terminal_edge E b = c) /\ (E c) /\ (closure top2 c (pointI m))` SUBAGOAL_TAC; + COPY 12; + TSPEC `terminal_edge E b` 11; + REWR 11; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b''` EXISTS_TAC; + TYPE_THEN `a'` EXISTS_TAC; + (* - *) + TYPE_THEN `c` EXISTS_TAC; + COPY 7; + TSPEC `m` 16; + REWR 16; + TYPE_THEN `adj (terminal_edge E b) c` SUBAGOAL_TAC; + REWRITE_TAC[adj]; + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + TYPE_THEN `pointI m` EXISTS_TAC; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM ; + CONJ_TAC; + TYPE_THEN `closure top2 y (pointI x)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `closure top2 c (pointI x)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + KILL 6; + TYPE_THEN `closure top2 (terminal_edge E b) (pointI x)` SUBAGOAL_TAC; + TYPE_THEN `({0,1,2} (num_closure E (pointI x)))` SUBAGOAL_TAC; + UND 2 THEN MESON_TAC[segment]; + FULL_REWRITE_TAC[INSERT;]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + THM_INTRO_TAC[`E`;`(pointI x)`] num_closure0; + REWR 22; + THM_INTRO_TAC[`E`;`(pointI x)`] num_closure1; + THM_INTRO_TAC[`E`;`(pointI x)`] num_closure2; + REWR 22; + UND 22 THEN REP_CASES_TAC ; + TYPE_THEN `(terminal_edge E b = a'') \/ (terminal_edge E b = b''')` SUBAGOAL_TAC; + TSPEC `terminal_edge E b` 22; + REWR 22; + TYPE_THEN `(c = a'') \/ (c = b''')` SUBAGOAL_TAC; + TSPEC `c` 22; + REWR 22; + TYPE_THEN `(y = a'') \/ (y = b''')` SUBAGOAL_TAC; + TSPEC `y` 22; + REWR 22; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `a''` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + REWR 29; + TYPE_THEN `b'''` UNABBREV_TAC; + USE 18(REWRITE_RULE[adj]); + UND 29 THEN UND 15 THEN UND 28 THEN MESON_TAC[]; + TYPE_THEN `b'''` UNABBREV_TAC; + USE 18 (REWRITE_RULE[adj]); + UND 31 THEN UND 15 THEN UND 29 THEN UND 28 THEN MESON_TAC[]; + (* --- *) + UND 20 THEN UND 21 THEN UND 14 THEN UND 19 THEN UND 22 THEN MESON_TAC[]; + UND 22 THEN UND 19 THEN UND 20 THEN MESON_TAC[]; + (* - *) + TYPE_THEN `y` UNABBREV_TAC; + ]);; + (* }}} *) + +let psegment_order_induct_lemma = prove_by_refinement( + `!n. !E a b. psegment E /\ (CARD E = n) /\ (endpoint E a) /\ + (endpoint E b) /\ ~(a = b) ==> + (?f. (BIJ f { p | p < n} E) /\ (f 0 = terminal_edge E a) /\ + ((0 < n) ==> (f (n - 1) = terminal_edge E b)) /\ + (!i j. (i < CARD E /\ j < CARD E) ==> + (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))))`, + (* {{{ proof *) + [ + INDUCT_TAC; + (* -- 0 case *) + TYPE_THEN `f = (\ (x:num). terminal_edge E a)` ABBREV_TAC ; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `{ p | p < 0} = EMPTY` SUBAGOAL_TAC; + REWRITE_TAC[EQ_EMPTY]; + UND 6 THEN ARITH_TAC; + TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[psegment;segment]; + FULL_REWRITE_TAC[HAS_SIZE_0]; + REWRITE_TAC[ARITH_RULE `~(k <| 0)`;bij_empty]; + EXPAND_TAC "f"; + (* - 1 case *) + REWRITE_TAC[ARITH_RULE `0 <| SUC n /\ (SUC n - 1 = n)`]; + TYPE_THEN `n = 0` ASM_CASES_TAC; + KILL 5; + REWRITE_TAC[ARITH_RULE `i <| SUC 0 <=> (i = 0)`;]; + REWRITE_TAC[ARITH_RULE `~(SUC 0 = 0)`;adj]; + TYPE_THEN `n` UNABBREV_TAC; + FULL_REWRITE_TAC[ARITH_RULE `SUC 0 = 1`]; + TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC; + FULL_REWRITE_TAC[HAS_SIZE;psegment;segment]; + USE 5(MATCH_MP CARD_SING_CONV); + FULL_REWRITE_TAC[SING]; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `f = (\ (y:num). x )` ABBREV_TAC ; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `FINITE {x}` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + TYPE_THEN `{p | p = 0} = {0}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + KILL 7; + TYPE_THEN `f 0 = x` SUBAGOAL_TAC; + EXPAND_TAC "f"; + REWRITE_TAC[bij_sing]; + TH_INTRO_TAC[`{x}`;`a`] terminal_endpoint; + TH_INTRO_TAC[`{x}`;`b`] terminal_endpoint; + FULL_REWRITE_TAC[INR IN_SING]; + (* - A2 and above *) + TYPE_THEN `e = terminal_edge E b` ABBREV_TAC ; + TYPE_THEN `b' = other_end e b` ABBREV_TAC ; + TYPE_THEN `E' = E DELETE e` ABBREV_TAC ; + (* - *) + TYPE_THEN `E e /\ closure top2 e (pointI b)` SUBAGOAL_TAC; + TYPE_THEN `e` UNABBREV_TAC; + IMATCH_MP_TAC terminal_endpoint; + RULE_ASSUM_TAC (REWRITE_RULE[psegment;segment]); + (* - *) + TYPE_THEN `psegment E'` SUBAGOAL_TAC; + REWRITE_TAC[psegment]; + CONJ_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + IMATCH_MP_TAC segment_delete; + TYPE_THEN `b` EXISTS_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[psegment]); + REWRITE_TAC[]; + TYPE_THEN `E` UNABBREV_TAC; + THM_INTRO_TAC [`e`] sing_has_size1; + RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); + UND 12 THEN UND 3 THEN UND 6 THEN ARITH_TAC; + THM_INTRO_TAC [`E'`;`E`] rectagon_subset; + RULE_ASSUM_TAC (REWRITE_RULE[psegment]); + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[DELETE;SUBSET]; + TYPE_THEN `E'` UNABBREV_TAC; + UND 13 THEN UND 11 THEN MESON_TAC[INR DELETE_NON_ELEMENT]; + (* - *) + TYPE_THEN `SUC (CARD E') = SUC n` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + TYPE_THEN `SUC n` UNABBREV_TAC; + IMATCH_MP_TAC CARD_SUC_DELETE; + FULL_REWRITE_TAC[psegment;segment]; + FULL_REWRITE_TAC[SUC_INJ]; + (* -B *) + THM_INTRO_TAC [`E`;`b`;`e`] psegment_delete_end; + REWRITE_TAC[]; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[card_sing]; + UND 3 THEN UND 6 THEN ARITH_TAC; + (* - *) + TYPE_THEN `endpoint E' = {a,b'}` SUBAGOAL_TAC; + IMATCH_MP_TAC has_size2_subset; + CONJ_TAC; + IMATCH_MP_TAC endpoint_size2; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INSERT;DELETE]; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC [`E`;`x`;`a`;`b`] two_endpoint_segment; + FULL_REWRITE_TAC[psegment]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`e`;`b`] other_end_prop; + UND 4 THEN REWRITE_TAC[psegment;segment;SUBSET;]; + (* - *) + TYPE_THEN `{a,b'} HAS_SIZE 2` SUBAGOAL_TAC; + TYPE_THEN `{a,b'}` UNABBREV_TAC; + IMATCH_MP_TAC endpoint_size2; + USE 16 (MATCH_MP has_size2_distinct); + UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`a`;`b'`]); + REWRITE_TAC[in_pair]; + (* - *) + TYPE_THEN `g = (\ i. if (i <| n) then f i else e)` ABBREV_TAC ; + TYPE_THEN `!i. (i <| n) ==> (g i = f i)` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `g n = e` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + REWRITE_TAC[ARITH_RULE `~(n <| n)`]; + TYPE_THEN `g` EXISTS_TAC; + (* - FINAL PUSH *) + SUBCONJ_TAC; + IMATCH_MP_TAC inj_bij_size; + REWRITE_TAC[CARD_NUMSEG_LT]; + CONJ_TAC; + TYPE_THEN `{p | p <| SUC n} = {p | p <| n} UNION {n}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING]; + ARITH_TAC; + IMATCH_MP_TAC inj_split; + CONJ_TAC; + TYPE_THEN `INJ g {p | p <| n} E = INJ f {p | p <| n} E` SUBAGOAL_TAC; + IMATCH_MP_TAC inj_domain_sub; + USE 24 (REWRITE_RULE[]); + RULE_ASSUM_TAC (REWRITE_RULE[BIJ]); + (* --- temp *) + IMATCH_MP_TAC inj_subset2; + UNIFY_EXISTS_TAC; + UND 9 THEN REWRITE_TAC[SUBSET;DELETE]; + TYPE_THEN `E'` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[INJ;INR IN_SING;]; + REP_BASIC_TAC; + REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ]; + TYPE_THEN `x''` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `g n` UNABBREV_TAC; + TSPEC `x'` 21; + TYPE_THEN `g x'` UNABBREV_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + TSPEC `x'` 22; + TYPE_THEN `E'` UNABBREV_TAC; + FULL_REWRITE_TAC[DELETE]; + ASM_MESON_TAC[]; + UND 4 THEN ASM_REWRITE_TAC[HAS_SIZE;psegment;segment;rectagon]; + (* - C*) + TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[DELETE;SUBSET]; + (* - *) + TSPEC `0` 21; + TYPE_THEN `0 <| n` SUBAGOAL_TAC; + UND 6 THEN ARITH_TAC; + TYPE_THEN `f 0` UNABBREV_TAC; + CONJ_TAC; + TYPE_THEN `e' = terminal_edge E' a` ABBREV_TAC ; + THM_INTRO_TAC[`E'`;`a`;`e'`] terminal_unique; + REWRITE_TAC[INR in_pair]; + UND 12 THEN REWRITE_TAC[psegment;segment]; + TYPE_THEN `e'` UNABBREV_TAC; + TYPE_THEN `g 0 ` UNABBREV_TAC; + THM_INTRO_TAC[`E`;`a`;`terminal_edge E' a`] terminal_unique; + UND 4 THEN (REWRITE_TAC[psegment;segment]); + REWR 26; + ASM_MESON_TAC[ISUBSET]; + (* -D *) + TYPE_THEN `E' (terminal_edge E' b')` SUBAGOAL_TAC; + THM_INTRO_TAC[`E'`;`b'`] terminal_endpoint; + FULL_REWRITE_TAC[psegment;segment;INR in_pair ]; + (* - *) + TYPE_THEN `~(E' (terminal_edge E b))` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + FULL_REWRITE_TAC[DELETE]; + TYPE_THEN `terminal_edge E b` UNABBREV_TAC; + (* - *) + TYPE_THEN `adj e (g (n - 1))` SUBAGOAL_TAC; + TYPE_THEN `g (n - 1) = f (n-1 )` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `n - 1 < n` SUBAGOAL_TAC; + UND 21 THEN ARITH_TAC; + TYPE_THEN `f (n - 1)` UNABBREV_TAC; + TYPE_THEN `e` UNABBREV_TAC; + REWRITE_TAC[adj]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + CONJ_TAC; + TYPE_THEN `g n` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `pointI b'` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `b'` UNABBREV_TAC; + THM_INTRO_TAC[`terminal_edge E b`;`b`]other_end_prop; + FULL_REWRITE_TAC[psegment;segment;ISUBSET]; + THM_INTRO_TAC [`E'`;`b'`] terminal_endpoint; + FULL_REWRITE_TAC[psegment;segment;in_pair]; + (* - *) + TYPE_THEN `!i. (i <| SUC n) ==> (adj (g n) (g i) = (SUC i = n))` SUBAGOAL_TAC; + TYPE_THEN `( i' = n) \/ (i' <| n)` SUBAGOAL_TAC; + UND 30 THEN ARITH_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + REWRITE_TAC[adj]; + ARITH_TAC; + (* -- *) + THM_INTRO_TAC[`E`;`b`] terminal_adj; + FULL_REWRITE_TAC[psegment]; + REWRITE_TAC[]; + USE 35 (MATCH_MP CARD_SING); + TYPE_THEN `CARD E` UNABBREV_TAC; + UND 3 THEN UND 21 THEN ARITH_TAC; + FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT]; + TYPE_THEN `!i'. (i' <| n) ==> (adj e (g i') = (e' = (g i')))` SUBAGOAL_TAC; + TSPEC `g (i'')`33; + TYPE_THEN `E (g i'')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 34 THEN ARITH_TAC; + REWR 33; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + TSPEC `n - 1` 34; + TYPE_THEN `n - 1 < n` SUBAGOAL_TAC; + UND 21 THEN ARITH_TAC; + TYPE_THEN `(g i' = g (n - 1)) ==> (SUC i' = n)` SUBAGOAL_TAC; + FULL_REWRITE_TAC [BIJ;INJ]; + IMATCH_MP_TAC (ARITH_RULE `((i' = n - 1) /\ (0 < n)) ==> (SUC i' = n)` ); + FIRST_ASSUM IMATCH_MP_TAC ; + ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWR 34; + (* -- *) + TYPE_THEN `i' = n - 1` SUBAGOAL_TAC; + UND 35 THEN UND 21 THEN ARITH_TAC; + TSPEC `i'` 34; + TYPE_THEN `i'` UNABBREV_TAC; + REWR 32; + (* -E *) + TYPE_THEN `(i = n) \/ (i <| n)` SUBAGOAL_TAC; + UND 26 THEN ARITH_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TSPEC `j` 30; + UND 30 THEN ARITH_TAC; + (* - *) + TYPE_THEN `(j = n) \/ (j <| n)` SUBAGOAL_TAC; + UND 25 THEN ARITH_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ONCE_REWRITE_TAC [adj_symm]; + UND 26 THEN ARITH_TAC; + (* - *) + TYPE_THEN `g` UNABBREV_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + + ]);; + (* }}} *) + +(* a couple of variants *) +let psegment_order = prove_by_refinement( + `!E a b. psegment E /\ (endpoint E a) /\ + (endpoint E b) /\ ~(a = b) ==> + (?f. (BIJ f { p | p < CARD E} E) /\ (f 0 = terminal_edge E a) /\ + ((0 < CARD E) ==> (f (CARD E - 1) = terminal_edge E b)) /\ + (!i j. (i < CARD E /\ j < CARD E) ==> + (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`CARD E`;`E`;`a`;`b`] psegment_order_induct_lemma; + REWRITE_TAC[]; + ]);; + (* }}} *) + +let psegment_order' = prove_by_refinement( + `!A m. psegment A /\ endpoint A m ==> + (?f. BIJ f {p | p < CARD A} A /\ + (f 0 = terminal_edge A m) /\ + (!i j. (i < CARD A /\ j < CARD A) ==> + (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A`] endpoint_size2; + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `?n. (endpoint A n) /\ ~(m = n)` SUBAGOAL_TAC; + REWR 0; + FULL_REWRITE_TAC[in_pair]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + THM_INTRO_TAC[`A`;`m`;`n`] psegment_order; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let order_imp_psegment = prove_by_refinement( + `!f n. (INJ f { p | p < n} (edge)) /\ (0 < n) /\ + (!i j. (i < n /\ j < n) ==> + (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i) ))) ==> + (psegment (IMAGE f { p | p < n}))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `E = IMAGE f {p | p <| n}` ABBREV_TAC ; + IMATCH_MP_TAC endpoint_psegment; + REWRITE_TAC[segment;]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + REWRITE_TAC[FINITE_NUMSEG_LT]; + (* - *) + TYPE_THEN `~(E = {})` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[image_empty]; + FULL_REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[IMAGE;INJ;SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + TYPE_THEN `E (f 0)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC ; + REWRITE_TAC[IMAGE]; + TYPE_THEN `0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `edge (f 0)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + (* -A *) + TYPE_THEN `?m. endpoint E m` SUBAGOAL_TAC; + REWRITE_TAC[endpoint]; + ASM_SIMP_TAC[num_closure1]; + LEFT_TAC "e"; + TYPE_THEN `f 0 ` EXISTS_TAC; + THM_INTRO_TAC[`f 0`] two_endpoint; + FULL_REWRITE_TAC[has_size2]; + ASM_CASES_TAC `n =1`; + TYPE_THEN `a` EXISTS_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `n` UNABBREV_TAC; + FULL_REWRITE_TAC[IMAGE]; + TYPE_THEN `(x' = 0) /\ (x = 0)` SUBAGOAL_TAC; + UND 7 THEN UND 13 THEN ARITH_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `a` 10; + FULL_REWRITE_TAC[in_pair]; + (* -- *) + TYPE_THEN `E (f 1)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `1` EXISTS_TAC; + UND 11 THEN UND 1 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `edge (f 1)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + (* -- *) + TYPE_THEN `adj (f 0 ) (f 1)` SUBAGOAL_TAC; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`;`1`]); + UND 11 THEN UND 1 THEN ARITH_TAC; + ARITH_TAC; + THM_INTRO_TAC[`f 0`;`f 1`] edge_inter; + FULL_REWRITE_TAC[INTER;INR eq_sing ]; + (* -- *) + TYPE_THEN `?r. closure top2 (f 0) (pointI r) /\ ~(r = m)` SUBAGOAL_TAC; + USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + FULL_REWRITE_TAC[in_pair]; + TYPE_THEN `m = a` ASM_CASES_TAC; + TYPE_THEN `m` UNABBREV_TAC; + TYPE_THEN `b` EXISTS_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `r` EXISTS_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN`?j. (j <| n) /\ (e' = f j)` SUBAGOAL_TAC; + TYPE_THEN`E` UNABBREV_TAC; + FULL_REWRITE_TAC[IMAGE]; + TYPE_THEN`x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `adj (f 0) (f j)` SUBAGOAL_TAC; + REWRITE_TAC[adj;EMPTY_EXISTS;INTER ]; + TYPE_THEN`pointI r` EXISTS_TAC; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[` 0`;` j`] ); + REWR 0; + TYPE_THEN `j = 1` SUBAGOAL_TAC; + UND 0 THEN ARITH_TAC; + TYPE_THEN `j` UNABBREV_TAC; + TSPEC `pointI r` 15; + REWR 15; + FULL_REWRITE_TAC[pointI_inj]; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + CONJ_TAC; + UNIFY_EXISTS_TAC; + (* -B *) + TYPE_THEN `!e. (E e ==> ?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[IMAGE]; + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + REWRITE_TAC[INSERT]; + ASM_SIMP_TAC [num_closure0;num_closure1;num_closure2]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + LEFT 11 "e"; + LEFT 12 "e"; + TSPEC `e` 12; + LEFT 12 "e'"; + FULL_REWRITE_TAC[NOT_IMP]; + TYPE_THEN `E e' /\ closure top2 e' (pointI m') /\ ~(e = e')` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `adj e e'` SUBAGOAL_TAC; + REWRITE_TAC[adj;EMPTY_EXISTS;INTER;]; + UNIFY_EXISTS_TAC; + TYPE_THEN `(?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC; + TYPE_THEN `(?j. (j <| n) /\ (e' = f j))` SUBAGOAL_TAC; + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + TYPE_THEN `(SUC i = j) \/ (SUC j = i)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + LEFT 13 "a"; + TSPEC `f i` 13; + LEFT 13 "b"; + TSPEC `f j` 13; + UND 13 THEN REWRITE_TAC[]; + REWRITE_TAC[]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `?k. (k <| n) /\ (e'' = f k)` SUBAGOAL_TAC; + TYPE_THEN `e''` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + TYPE_THEN `adj (f i) (f k) /\ adj (f j) (f k)` SUBAGOAL_TAC; + REWRITE_TAC[adj]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + LEFT_TAC "u"; + UNIFY_EXISTS_TAC; + TYPE_THEN `(SUC j = k) \/ (SUC k = j)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `(SUC i = k) \/ (SUC k = i)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + UND 29 THEN UND 28 THEN UND 19 THEN ARITH_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -C *) + TYPE_THEN `X = {p | p <| n /\ S (f p)}` ABBREV_TAC ; + TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET]; + TYPE_THEN `E u` SUBAGOAL_TAC; + TYPE_THEN `(?i. (i <| n) /\ (u = f i))` SUBAGOAL_TAC; + TYPE_THEN `u` UNABBREV_TAC; + UNDF `EMPTY` THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + (* - *) + TYPE_THEN `!j k. X j /\ (k <| n) /\ ((SUC j = k) \/ (SUC k = j)) ==> (X k)` SUBAGOAL_TAC; + TYPE_THEN `j = k` ASM_CASES_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `S (f j)` SUBAGOAL_TAC; + TYPE_THEN `X` UNABBREV_TAC; + TYPE_THEN `E (f k)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `k` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `adj (f j) (f k)` SUBAGOAL_TAC; + TYPE_THEN `X` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `S (f k)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `X` UNABBREV_TAC; + (* - *) + TYPE_THEN `(?i. X i /\ (!m. m <| i ==> ~X m))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[num_WOP]; + TYPE_THEN `i = 0` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `?j. SUC j = i` SUBAGOAL_TAC; + TYPE_THEN `i - 1` EXISTS_TAC; + UND 19 THEN ARITH_TAC; + TSPEC `j` 17; + UND 17 THEN DISCH_THEN (THM_INTRO_TAC[]); + UND 20 THEN ARITH_TAC; + UND 17 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + UND 17 THEN UND 20 THEN ARITH_TAC; + TYPE_THEN `i` UNABBREV_TAC; + (* -D *) + TYPE_THEN `X = { p | p <| n }` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp_eq; + CONJ_TAC; + TYPE_THEN `X` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `Z = ({p | p <| n} DIFF X)` ABBREV_TAC ; + TYPE_THEN `?n. Z n /\ (!m. m <| n ==> ~Z m)` SUBAGOAL_TAC; + UND 19 THEN MESON_TAC[num_WOP]; + TYPE_THEN `Z` UNABBREV_TAC; + FULL_REWRITE_TAC[DIFF]; + TSPEC `n' - 1` 21; + TYPE_THEN `~(n' = 0)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `n' - 1 <| n'` SUBAGOAL_TAC; + UND 24 THEN ARITH_TAC; + TYPE_THEN `n' - 1 <| n` SUBAGOAL_TAC; + UND 20 THEN ARITH_TAC; + REWR 21; + UND 19 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `n' - 1` EXISTS_TAC; + UND 24 THEN ARITH_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + REWRITE_TAC[SUBSET]; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `X` UNABBREV_TAC; + USE 20 (REWRITE_RULE[IMAGE]); + USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x'` 19; + FULL_REWRITE_TAC[]; + REWR 19; + ]);; + (* }}} *) + +let rectagon_nonsing = prove_by_refinement( + `!G. rectagon G ==> ~SING G`, + (* {{{ proof *) + [ + REWRITE_TAC[rectagon;SING]; + TYPE_THEN `G` UNABBREV_TAC; + THM_INTRO_TAC [`x`] two_endpoint; + FULL_REWRITE_TAC[SUBSET;INR IN_SING;]; + FULL_REWRITE_TAC[has_size2]; + USE 6 (ONCE_REWRITE_RULE [FUN_EQ_THM]); + FULL_REWRITE_TAC[in_pair]; + TSPEC `b` 6; + REWR 6; + TSPEC `b` 2; + THM_INTRO_TAC[`{x}`;`pointI b`] num_closure0; + FULL_REWRITE_TAC[INR IN_SING]; + REWR 2; + LEFT 2 "e" ; + TSPEC `x` 2; + REWR 2; + THM_INTRO_TAC[`{x}`;`pointI b`] num_closure2; + REWR 8; + FULL_REWRITE_TAC[INR IN_SING]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let rectagon_2 = prove_by_refinement( + `!G S. rectagon G /\ S SUBSET G /\ ~(S = EMPTY) /\ + (!m. {0,2} (num_closure S (pointI m))) ==> (S = G)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `Tx = { A | ~(A = EMPTY) /\ A SUBSET S /\ (!m. {0,2} (num_closure A (pointI m))) }` ABBREV_TAC ; + TYPE_THEN `~(Tx = EMPTY)` SUBAGOAL_TAC; + UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `S` EXISTS_TAC; + TYPE_THEN `Tx` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + USE 5 (MATCH_MP select_card_min); + (* - *) + TYPE_THEN `z SUBSET G` SUBAGOAL_TAC; + TYPE_THEN `Tx` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + (* - *) + TYPE_THEN `(z = G) ==> (S = G)` SUBAGOAL_TAC; + TYPE_THEN `Tx` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + FULL_REWRITE_TAC [ISUBSET]; + ASM_MESON_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + KILL 8; + (* - *) + IMATCH_MP_TAC rectagon_subset; + TYPE_THEN `segment G` SUBAGOAL_TAC; + IMATCH_MP_TAC rectagon_segment; + (* - *) + REWRITE_TAC[rectagon]; + TYPE_THEN `Tx` UNABBREV_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + FULL_REWRITE_TAC[rectagon]; + CONJ_TAC; + FULL_REWRITE_TAC[rectagon]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G` EXISTS_TAC; + (* -A1 *) + IMATCH_MP_TAC CARD_SUBSET_LE; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + KILL 5; + KILL 0; + TSPEC `m` 4; + FULL_REWRITE_TAC[INSERT]; + USE 0 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono; + UND 4 THEN UND 5 THEN ARITH_TAC; + KILL 0; + (* - *) + TYPE_THEN `~(num_closure S' (pointI m) = 1)` ASM_CASES_TAC; + THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono; + UND 5 THEN UND 0 THEN UND 4 THEN ARITH_TAC; + REWR 0; + (* - *) + THM_INTRO_TAC[`S'`;`(pointI m)`] num_closure1; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWR 5; + (* - *) + THM_INTRO_TAC[`z`;`pointI m`] num_closure2; + REWR 14; + COPY 14; + TSPEC `e` 16; + COPY 5; + TSPEC `e` 5; + USE 5 (REWRITE_RULE[]); + TYPE_THEN `z e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[ISUBSET]; + TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 16; + (* -B1 *) + TYPE_THEN `?e'. (closure top2 e' (pointI m)) /\ z e' /\ ~(e = e')` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `a` EXISTS_TAC; + ASM_MESON_TAC[]; + (* - *) + UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`e`;`e'`]); + REWRITE_TAC[adj;INTER;EMPTY_EXISTS;]; + TYPE_THEN `pointI m` EXISTS_TAC; + TSPEC `e'` 17 ; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let closure_imp_adj = prove_by_refinement( + `!X Y m. (closure top2 X (pointI m) /\ closure top2 Y (pointI m) /\ + ~(X = Y) ==> adj X Y)`, + (* {{{ proof *) + [ + REWRITE_TAC[adj]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let inductive_set_endpoint = prove_by_refinement( + `!G S. FINITE G /\ inductive_set G S ==> + (endpoint S SUBSET endpoint G)`, + (* {{{ proof *) + [ + REWRITE_TAC[inductive_set]; + REWRITE_TAC[SUBSET;endpoint]; + TYPE_THEN `FINITE S` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + THM_INTRO_TAC[`S`;`pointI x`] num_closure1; + REWR 6; + ASM_SIMP_TAC[num_closure1]; + TYPE_THEN `e` EXISTS_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + COPY 6; + TSPEC `e'` 6; + TSPEC `e` 9; + REWR 6; + REWR 9; + PROOF_BY_CONTR_TAC; + UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`e`;`e'`]); + IMATCH_MP_TAC closure_imp_adj; + TYPE_THEN `x` EXISTS_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `e'` UNABBREV_TAC; + TSPEC `e` 6; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let endpoint_closure = prove_by_refinement( + `!e. (edge e) ==> (endpoint {e} = {m | closure top2 e (pointI m)})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1; + REWRITE_TAC[FINITE_SING]; + REWRITE_TAC[INR IN_SING]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `e = e'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let rectagon_delete = prove_by_refinement( + `!E e. (rectagon E) /\ (E e) ==> (psegment (E DELETE e))`, + (* {{{ proof *) + [ + REWRITE_TAC[psegment]; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + THM_INTRO_TAC[`E DELETE e`;`E`] rectagon_subset; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + REWRITE_TAC[DELETE;SUBSET]; + ASM_MESON_TAC[INR DELETE_NON_ELEMENT]; + (* - *) + REWRITE_TAC[segment]; + CONJ_TAC; + FULL_REWRITE_TAC[rectagon]; + REWRITE_TAC[FINITE_DELETE]; + (* - *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[delete_empty]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 1 (MATCH_MP rectagon_nonsing); + FULL_REWRITE_TAC[SING]; + ASM_MESON_TAC[]; + (* - *) + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[DELETE;SUBSET]; + FULL_REWRITE_TAC[rectagon]; + (* - *) + SUBCONJ_TAC; + THM_INTRO_TAC[`E DELETE e`;`E`;`pointI m`] num_closure_mono; + FULL_REWRITE_TAC[rectagon;DELETE;SUBSET]; + FULL_REWRITE_TAC[rectagon]; + UND 5 THEN UND 4 THEN (REWRITE_TAC[INSERT]) ; + TSPEC `m` 4; + UND 4 THEN UND 5 THEN ARITH_TAC; + (* -A *) + TYPE_THEN `~S e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET;DELETE]; + ASM_MESON_TAC[]; + TYPE_THEN `(e INSERT S = E) ==> (S = E DELETE e)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC [DELETE_INSERT]; + ASM_MESON_TAC[INR DELETE_NON_ELEMENT]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + FULL_REWRITE_TAC[rectagon]; + REWRITE_TAC[DELETE;SUBSET]; + (* - *) + THM_INTRO_TAC[`E DELETE e`;`S`] inductive_set_endpoint; + REWRITE_TAC[inductive_set]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC rectagon_2; + CONJ_TAC; + REWRITE_TAC[INSERT_SUBSET]; + UND 6 THEN REWRITE_TAC[SUBSET;DELETE]; + (* - *) + CONJ_TAC; + FULL_REWRITE_TAC[EQ_EMPTY;INSERT;]; + ASM_MESON_TAC[]; + (* -B *) + TYPE_THEN `e INSERT S SUBSET E` SUBAGOAL_TAC; + UND 6 THEN REWRITE_TAC[INSERT;DELETE;SUBSET]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`e INSERT S`;`E`;`pointI m`] num_closure_mono; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `~(num_closure (e INSERT S) (pointI m) = 1)` ASM_CASES_TAC; + TYPE_THEN `S' = e INSERT S` ABBREV_TAC ; + KILL 15; + FULL_REWRITE_TAC[INSERT;rectagon]; + TSPEC `m` 15; + UND 15 THEN UND 14 THEN UND 13 THEN ARITH_TAC; + REWR 14; + PROOF_BY_CONTR_TAC; + KILL 13; + KILL 15; + KILL 9; + (* - *) + TYPE_THEN `!A x. (A SUBSET E) /\ (num_closure A (pointI x) = 1) ==> (num_closure E (pointI x) = 2)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + TSPEC `x` 15; + USE 15 (REWRITE_RULE[INSERT]); + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`A`;`E`;`pointI x`] num_closure_mono; + UND 20 THEN UND 19 THEN UND 9 THEN ARITH_TAC; + (* - *) + TYPE_THEN `endpoint (E DELETE e) SUBSET endpoint {e}` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET;endpoint]; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`E DELETE e`;`x`]); + REWRITE_TAC[SUBSET;DELETE]; + THM_INTRO_TAC[`E`;`pointI x`] num_closure2; + FULL_REWRITE_TAC[rectagon]; + REWR 15; + THM_INTRO_TAC[`E DELETE e`;`pointI x`] num_closure1; + REWR 17; + USE 17 (REWRITE_RULE[DELETE]); + THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1; + REWRITE_TAC[FINITE_SING]; + REWRITE_TAC[INR IN_SING]; + TYPE_THEN `e` EXISTS_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + REWRITE_TAC[]; + TYPE_THEN `e''` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `E a /\ closure top2 a (pointI x)` SUBAGOAL_TAC; + TYPE_THEN `E b /\ closure top2 b (pointI x)` SUBAGOAL_TAC; + TSPEC `e` 15; + UND 15 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC ; + USE 15 (REWRITE_RULE[DE_MORGAN_THM]); + COPY 17; + TSPEC `a` 17; + TSPEC `b` 25; + KILL 18; + KILL 4; + KILL 7; + TYPE_THEN `e' = b` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 25; + TYPE_THEN `e' = a` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + UND 7 THEN UND 4 THEN UND 16 THEN MESON_TAC[]; + (* -C *) + TYPE_THEN `endpoint S SUBSET endpoint {e}` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + KILL 13; + KILL 11; + (* - *) + THM_INTRO_TAC[`S`;`E`] endpoint_even; + SUBCONJ_TAC; + ASM_MESON_TAC[rectagon_segment]; + SUBCONJ_TAC; + UND 12 THEN REWRITE_TAC[INSERT;SUBSET] THEN MESON_TAC[]; + THM_INTRO_TAC[`S`;`E`] rectagon_subset; + TYPE_THEN `S` UNABBREV_TAC; + UND 8 THEN REWRITE_TAC[]; + (* - *) + TYPE_THEN `X = {S' | ?e. S e /\ (S' = segment_of S e)}` ABBREV_TAC ; + TYPE_THEN `FINITE X` SUBAGOAL_TAC; + THM_INTRO_TAC[`segment_of S`;`S`] FINITE_IMAGE; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E DELETE e` EXISTS_TAC; + TYPE_THEN `X = IMAGE (segment_of S) S` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + TYPE_THEN `X` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC; + USE 5 (REWRITE_RULE[EMPTY_EXISTS]); + UND 17 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `segment_of S u` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[HAS_SIZE]; + (* -D *) + TYPE_THEN `edge e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[ISUBSET]; + THM_INTRO_TAC[`e`] endpoint_closure; + THM_INTRO_TAC[`e`] two_endpoint; + FULL_REWRITE_TAC[HAS_SIZE]; + (* - *) + TYPE_THEN `endpoint S = endpoint {e}` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET_LE; + CONJ_TAC; + ASM_MESON_TAC[]; + IMATCH_MP_TAC (ARITH_RULE `~(CARD X = 0) ==> 2 <= 2 * CARD X`); + TYPE_THEN `X HAS_SIZE 0` SUBAGOAL_TAC; + ASM_REWRITE_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[HAS_SIZE_0]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`e INSERT S`;`pointI m`] num_closure1; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + FULL_REWRITE_TAC[rectagon]; + REWR 24; + USE 24 (REWRITE_RULE[INSERT]); + TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC; + TYPE_THEN `e' = e` SUBAGOAL_TAC; + TSPEC `e` 24; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + TYPE_THEN `endpoint S m` SUBAGOAL_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`S`;`m`]endpoint_edge; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E DELETE e` EXISTS_TAC ; + FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT]; + TSPEC `e''` 27; + TSPEC `e''` 24; + TYPE_THEN `e = e''` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e''` UNABBREV_TAC; + KILL 9; + KILL 20; + KILL 7; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `~endpoint S m` SUBAGOAL_TAC; + UND 26 THEN ASM_REWRITE_TAC[]; + (* - *) + USE 26 (REWRITE_RULE[endpoint]); + THM_INTRO_TAC[`S`;`E`;`pointI m`] num_closure_mono; + FULL_REWRITE_TAC[rectagon]; + UND 6 THEN REWRITE_TAC[DELETE;SUBSET]; + TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `FINITE S` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET ; + TYPE_THEN `E DELETE e` EXISTS_TAC; + TYPE_THEN `~(num_closure S (pointI m) = 0)` SUBAGOAL_TAC; + THM_INTRO_TAC[`S`;`pointI m`] num_closure0; + REWR 30; + TSPEC `e'` 30; + COPY 24; + TSPEC `e` 32; + TSPEC `e'` 24; + REWR 24; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + KILL 4; + KILL 9; + ASM_MESON_TAC[]; + (* - *) + USE 28 (REWRITE_RULE [INSERT]); + USE 28 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); + FIRST_ASSUM DISJ_CASES_TAC; + UND 27 THEN UND 31 THEN UND 30 THEN ARITH_TAC; + KILL 28; + TYPE_THEN `num_closure S (pointI m) = 2` SUBAGOAL_TAC; + UND 31 THEN UND 30 THEN UND 26 THEN UND 27 THEN ARITH_TAC; + KILL 31; + KILL 9; + KILL 4; + KILL 7; + KILL 30; + (* -E *) + THM_INTRO_TAC[`S`;`pointI m`] num_closure2; + REWR 4; + TYPE_THEN `S a /\ closure top2 a (pointI m)` SUBAGOAL_TAC; + TYPE_THEN `S b /\ closure top2 b (pointI m)` SUBAGOAL_TAC; + KILL 4; + TYPE_THEN `e' = a` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e' =b` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + UND 7 THEN REWRITE_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + ]);; + (* }}} *) + +let rectagon_adj = prove_by_refinement( + `!E e f. (rectagon E) /\ E e /\ E f ==> + (adj e f <=> + (?a. endpoint (E DELETE e) a /\ (f = terminal_edge (E DELETE e) a)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[DELETE;SUBSET]; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + IMATCH_MP_TAC (TAUT `A /\ b ==> b /\ A`); + CONJ_TAC; + IMATCH_MP_TAC closure_imp_adj; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `f` UNABBREV_TAC; + FULL_REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`E DELETE e`;`pointI a`] num_closure1; + REWR 5; + USE 5 (REWRITE_RULE[DELETE]); + TYPE_THEN `{0,2} (num_closure E (pointI a))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + USE 7 (REWRITE_RULE[INSERT]); + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`E`;`pointI a`] num_closure2; + REWR 9; + TYPE_THEN `E a' /\ closure top2 a' (pointI a)` SUBAGOAL_TAC; + TYPE_THEN `E b /\ closure top2 b (pointI a)` SUBAGOAL_TAC; + SUBCONJ_TAC; + PROOF_BY_CONTR_TAC; + TSPEC `e` 9; + UND 9 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USE 9(REWRITE_RULE[DE_MORGAN_THM]); + COPY 5; + TSPEC `a'` 5; + TSPEC `b` 17; + TYPE_THEN `e' = b` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`E DELETE e`;`a`]terminal_endpoint; + REWRITE_TAC[endpoint]; + UND 17 THEN REWRITE_TAC[DELETE] THEN MESON_TAC[]; + (* -- case 0 *) + THM_INTRO_TAC[`E`;`pointI a`] num_closure0; + REWR 9; + ASM_MESON_TAC[]; + (* -A *) + THM_INTRO_TAC[`e`;`f`] edge_inter; + FULL_REWRITE_TAC[rectagon;ISUBSET]; + FULL_REWRITE_TAC[INTER;INR eq_sing]; + TYPE_THEN `m` EXISTS_TAC; + SUBCONJ_TAC; + REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1; + KILL 9; + TYPE_THEN `f` EXISTS_TAC; + REWRITE_TAC[DELETE]; + IMATCH_MP_TAC EQ_ANTISYM; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + TYPE_THEN `e''` UNABBREV_TAC; + FULL_REWRITE_TAC[adj]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `{0, 2} (num_closure E (pointI m))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[INSERT]; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`E`;`pointI m`]num_closure2; + REWR 14; + PROOF_BY_CONTR_TAC; + COPY 14; + COPY 14; + TSPEC `e` 14; + TSPEC `f` 18; + TSPEC `e''` 17; + KILL 13; + KILL 12; + KILL 6; + TYPE_THEN `e'' = a` ASM_CASES_TAC ; + TYPE_THEN `e''` UNABBREV_TAC; + TYPE_THEN `(f = b)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `e = b` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e` UNABBREV_TAC; + FULL_REWRITE_TAC[adj]; + TYPE_THEN `e'' = b` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e''` UNABBREV_TAC; + TYPE_THEN `f = a` SUBAGOAL_TAC; + KILL 14; + ASM_MESON_TAC[]; + TYPE_THEN `f` UNABBREV_TAC ; + FULL_REWRITE_TAC[adj]; + ASM_MESON_TAC[]; + (* -- 0 case -- *) + THM_INTRO_TAC[`E`;`pointI m`] num_closure0; + REWR 14; + KILL 6; + ASM_MESON_TAC[]; + (* -B *) + THM_INTRO_TAC[`E DELETE e`;`m`;`f`] terminal_unique; + USE 10 (ONCE_REWRITE_RULE [EQ_SYM_EQ]); + ASM_REWRITE_TAC[DELETE]; + ASM_MESON_TAC[adj]; + ]);; + (* }}} *) + +let rectagon_delete_end = prove_by_refinement( + `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==> + endpoint (E DELETE e ) m`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWRITE_TAC[DELETE;SUBSET]; + THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1; + KILL 5; + REWRITE_TAC[DELETE]; + (* - *) + TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[INSERT]; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + KILL 5; + THM_INTRO_TAC[`E`;`pointI m`] num_closure2; + REWR 5; + TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `?c. (E c /\ ~(c = e) /\ closure top2 c (pointI m)) /\ (!e'. E e' /\ closure top2 e' (pointI m) <=> (e' = e) \/ (e' = c))` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `a` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `c` EXISTS_TAC; + TYPE_THEN `c = e''` ASM_CASES_TAC; + TYPE_THEN `e''` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + REWR 14; + KILL 5; + TSPEC `e''` 9; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`E`;`pointI m`] num_closure0; + REWR 7; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let rectagon_order = prove_by_refinement( + `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==> + (?f. BIJ f { p | p < CARD E } E /\ + (f (CARD E - 1) = e) /\ (closure top2 (f 0) (pointI m)) /\ + (!i j. (i < CARD E /\ j < CARD E) ==> + (adj (f i) (f j) <=> ((SUC i = j) \/ (SUC j = i) \/ + ((i = 0) /\ (j = (CARD E -1))) \/ ((i = CARD E -1) /\ (j = 0))))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`;`e`] rectagon_delete; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWRITE_TAC[DELETE;SUBSET]; + TYPE_THEN `endpoint (E DELETE e) m` SUBAGOAL_TAC; + IMATCH_MP_TAC rectagon_delete_end; + (* - *) + TYPE_THEN `?n. (endpoint (E DELETE e) n) /\ ~(n = m)` SUBAGOAL_TAC; + THM_INTRO_TAC[`E DELETE e`] endpoint_size2; + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `m = a` ASM_CASES_TAC ; + TYPE_THEN `b` EXISTS_TAC; + REWRITE_TAC[INR in_pair]; + TYPE_THEN `a` EXISTS_TAC; + REWRITE_TAC[INR in_pair]; + (* - *) + THM_INTRO_TAC[`E DELETE e`;`m`;`n`] psegment_order; + THM_INTRO_TAC[`e`;`E`;] CARD_SUC_DELETE; + TYPE_THEN `~(CARD E = 0)` SUBAGOAL_TAC; + TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY]; + ASM_MESON_TAC[]; + TYPE_THEN `CARD (E DELETE e) = CARD (E) - 1` SUBAGOAL_TAC; + UND 14 THEN UND 13 THEN ARITH_TAC; + (* - *) + TYPE_THEN `g = \ (i:num). if (i < CARD E - 1) then f i else e` ABBREV_TAC ; + TYPE_THEN `(g (CARD E - 1) = e)` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + REWRITE_TAC[ARITH_RULE `~(x <| x)`]; + TYPE_THEN `(!i. (i < CARD E -| 1) ==> (g i = f i))` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + KILL 16; + TYPE_THEN `g` EXISTS_TAC; + (* -A *) + TYPE_THEN `{p | p < CARD E - 1} UNION {(CARD E - 1)} = {p | p <| CARD E}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING ]; + UND 14 THEN ARITH_TAC; + (* - *) + SUBCONJ_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + USE 16 (SYM); + IMATCH_MP_TAC inj_split; + CONJ_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + TYPE_THEN `CARD (E DELETE e)` UNABBREV_TAC; + CONJ_TAC; + UND 20 THEN REWRITE_TAC[DELETE] THEN UND 15 THEN MESON_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 15 THEN UND 21 THEN UND 22 THEN UND 18 THEN MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[INJ;INR IN_SING ]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ]; + TYPE_THEN `x` UNABBREV_TAC ; + TYPE_THEN `x''` UNABBREV_TAC; + REWR 19; + TYPE_THEN `g x' = f x'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `g x'` UNABBREV_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + TYPE_THEN `CARD(E DELETE e)` UNABBREV_TAC; + USE 21(REWRITE_RULE[DELETE]); + ASM_MESON_TAC[]; + (* -- SURJ -- *) + REWRITE_TAC[SURJ]; + USE 19 (REWRITE_RULE[INJ]); + REWRITE_TAC[]; + TYPE_THEN `x = e` ASM_CASES_TAC; + TYPE_THEN `CARD E - 1` EXISTS_TAC; + UND 14 THEN ARITH_TAC; + TYPE_THEN `(E DELETE e) x` SUBAGOAL_TAC; + ASM_REWRITE_TAC[DELETE]; + FULL_REWRITE_TAC[BIJ;SURJ]; + TSPEC `x` 12; + REWR 12; + TYPE_THEN `y` EXISTS_TAC; + CONJ_TAC; + UND 26 THEN ARITH_TAC; + (* -B *) + TYPE_THEN `~(SING E)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SING]; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[INR IN_SING]; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment;segment]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + UND 22 THEN ASM_REWRITE_TAC[DELETE;INR IN_SING]; + ASM_MESON_TAC[]; + TYPE_THEN `~(CARD E = 1)` SUBAGOAL_TAC; + TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC; + ASM_REWRITE_TAC[HAS_SIZE]; + ASM_MESON_TAC[CARD_SING_CONV]; + (* - *) + TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC; + UND 21 THEN UND 14 THEN ARITH_TAC; + COPY 18 ; + TSPEC `0` 23; + (* - *) + SUBCONJ_TAC; + THM_INTRO_TAC[`E DELETE e`;`m`]terminal_endpoint; + (* -C *) + UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]); + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `CARD (E DELETE e) - 1 = CARD E - 2` SUBAGOAL_TAC; + UND 23 THEN ARITH_TAC; + REWR 10; + (* - *) + TYPE_THEN `!k. endpoint (E DELETE e) k ==> (k = n) \/ (k = m)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 29 (REWRITE_RULE[DE_MORGAN_THM]); + THM_INTRO_TAC[`E DELETE e`] endpoint_size2; + THM_INTRO_TAC[`endpoint(E DELETE e)`;`n`;`m`;`k`]two_exclusion; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!j. (j <| CARD E - 1) ==> (adj e (g j) <=> (j = 0) \/ (j = CARD E - 2))` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`;`e`;`g j'`] rectagon_adj; + TSPEC `j'` 18; + TYPE_THEN `f j'` UNABBREV_TAC; + USE 19 (REWRITE_RULE[BIJ;SURJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 29 THEN ARITH_TAC; + (* -- *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`j'`]); + TYPE_THEN `g j'` UNABBREV_TAC; + REWR 30; + TSPEC `a` 28; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `a` UNABBREV_TAC; + DISJ2_TAC; + TYPE_THEN `f j' = f (CARD E -| 2)` SUBAGOAL_TAC; + USE 12(REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 29 THEN UND 23 THEN ARITH_TAC; + TYPE_THEN `a` UNABBREV_TAC; + DISJ1_TAC; + TYPE_THEN `f j' = f 0` SUBAGOAL_TAC; + USE 12 (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -- *) + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`E`;`e`;`f 0`] rectagon_adj; + TYPE_THEN `terminal_edge (E DELETE e) m` UNABBREV_TAC; + USE 22 SYM; + USE 19 (REWRITE_RULE[BIJ;SURJ]); + TSPEC `0` 22; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 23 THEN ARITH_TAC; + ASM_MESON_TAC[]; + (* -- *) + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`E`;`e`;`f (CARD E - 2)`] rectagon_adj; + TYPE_THEN `terminal_edge (E DELETE e) n` UNABBREV_TAC; + UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`CARD E -2`]); + UND 23 THEN ARITH_TAC; + USE 10 GSYM; + USE 19 (REWRITE_RULE[BIJ;SURJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 23 THEN ARITH_TAC; + REWR 33; + TYPE_THEN `n` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `i = CARD E - 1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[adj]; + UND 32 THEN UND 23 THEN ARITH_TAC; + UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`j`]); + UND 31 THEN UND 24 THEN ARITH_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `j` UNABBREV_TAC; + DISJ2_TAC; + DISJ1_TAC; + UND 23 THEN ARITH_TAC; + UND 32 THEN REP_CASES_TAC; + TYPE_THEN `j` UNABBREV_TAC; + UND 24 THEN ARITH_TAC; + DISJ2_TAC; + UND 32 THEN UND 23 THEN ARITH_TAC; + (* - *) + TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [adj_symm]; + UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + UND 30 THEN UND 25 THEN ARITH_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC ; + UND 23 THEN ARITH_TAC; + UND 32 THEN REP_CASES_TAC; + UND 32 THEN UND 23 THEN ARITH_TAC; + TYPE_THEN `i` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 25 THEN ARITH_TAC; + (* - *) + TYPE_THEN `i < CARD E - 1 /\ j < CARD E - 1` SUBAGOAL_TAC; + UND 31 THEN UND 30 THEN UND 24 THEN UND 25 THEN ARITH_TAC; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + + +let order_imp_psegment_shift = prove_by_refinement( + `! f m n. + INJ f { p | m <= p /\ p < n} edge /\ + m <| n /\ + (! i j. m <= i /\ i < n /\ m <= j /\ j < n ==> + (adj (f i) (f j) <=> (SUC i = j) \/ (SUC j = i))) ==> + psegment (IMAGE f {p | m <= p /\ p < n})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `g = \ (i: num). f (i + m)` ABBREV_TAC ; + TYPE_THEN `IMAGE f {p | m <=| p /\ p < n} = IMAGE g {p | p < n - m}` SUBAGOAL_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `x' -| m` EXISTS_TAC; + CONJ_TAC; + UND 5 THEN UND 6 THEN ARITH_TAC; + AP_TERM_TAC; + UND 6 THEN ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `x' +| m` EXISTS_TAC; + UND 5 THEN UND 1 THEN ARITH_TAC; + IMATCH_MP_TAC order_imp_psegment; + (* - *) + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + TYPE_THEN`g`UNABBREV_TAC; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 5 THEN UND 1 THEN ARITH_TAC; + TYPE_THEN `g` UNABBREV_TAC; + IMATCH_MP_TAC (ARITH_RULE `((x +| m) = (y + m)) ==> (x = y)`); + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC; + (* - *) + CONJ_TAC; + UND 1 THEN ARITH_TAC; + TYPE_THEN `g` UNABBREV_TAC; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i +| m`;`j +| m`]); + UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC; + REWRITE_TAC[ARITH_RULE `(SUC(i + m) = (j +| m)) <=> (SUC i = j)`]; + ]);; + (* }}} *) + +let cls = jordan_def + `cls E = {m | ?e. E e /\ closure top2 e (pointI m)}`;; + +let cls_edge = prove_by_refinement( + `!e. (cls {e} = {m | closure top2 e (pointI m)})`, + (* {{{ proof *) + [ + REWRITE_TAC[cls;INR IN_SING ;]; + IMATCH_MP_TAC EQ_EXT; + MESON_TAC[]; + ]);; + (* }}} *) + +let cls_inj_lemma_v = prove_by_refinement( + `!m n. (cls {(v_edge m)} = cls {(v_edge n)}) ==> (m = n)`, + (* {{{ proof *) + [ + REWRITE_TAC[cls_edge;INR IN_SING;]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INR IN_SING]); + FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT]; + SUBCONJ_TAC; + TSPEC `m` 0; + ASM_MESON_TAC[]; + TYPE_THEN `FST n` UNABBREV_TAC; + COPY 0; + TSPEC `m` 1; + TSPEC `(FST m, SND n)` 0; + REWR 0; + REWR 1; + UND 0 THEN UND 1 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let cls_inj_lemma_h = prove_by_refinement( + `!m n. (cls {(h_edge m)} = cls {(h_edge n)}) ==> (m = n)`, + (* {{{ proof *) + [ + REWRITE_TAC[cls_edge;INR IN_SING;]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INR IN_SING]); + FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT]; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + SUBCONJ_TAC; + TSPEC `m` 0; + ASM_MESON_TAC[]; + TYPE_THEN `SND n` UNABBREV_TAC; + COPY 0; + TSPEC `m` 1; + TSPEC `(FST n, SND m)` 0; + REWR 0; + REWR 1; + UND 0 THEN UND 1 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let cls_inj_lemma_hv = prove_by_refinement( + `!m n. ~(cls {(h_edge m)} = cls {(v_edge n)})` , + (* {{{ proof *) + [ + REWRITE_TAC[cls_edge;]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INR IN_SING]); + FULL_REWRITE_TAC[v_edge_closure;vc_edge;h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT]; + COPY 0; + TSPEC `n` 0; + TSPEC `(FST n, SND n +: &:1)` 1; + REWR 0; + REWR 1; + TYPE_THEN `SND n = SND m` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `SND m` UNABBREV_TAC; + UND 1 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let cls_inj = prove_by_refinement( + `!e f . (edge e /\ edge f /\ (cls {e} = cls {f}) ==> (e = f))`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + JOIN 1 2 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + UND 1 THEN REP_CASES_TAC THEN REWR 0 THEN REWRITE_TAC[v_edge_inj;h_edge_inj]; + IMATCH_MP_TAC cls_inj_lemma_v; + ASM_MESON_TAC[cls_inj_lemma_hv]; + ASM_MESON_TAC[cls_inj_lemma_hv]; + IMATCH_MP_TAC cls_inj_lemma_h; + ]);; + (* }}} *) + +let adjv = jordan_def + `adjv e f = @m. (closure top2 e (pointI m)) /\ + (closure top2 f (pointI m))` ;; + +let adjv_adj = prove_by_refinement( + `!e f. edge e /\ edge f /\ adj e f ==> + closure top2 e (pointI (adjv e f))`, + (* {{{ proof *) + [ + REWRITE_TAC[adjv]; + SELECT_TAC ; + THM_INTRO_TAC[`e`;`f`] edge_inter; + FULL_REWRITE_TAC [INTER;INR eq_sing;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let adjv_adj2 = prove_by_refinement( + `!e f. edge e /\ edge f /\ adj e f ==> + closure top2 f (pointI (adjv e f))`, + (* {{{ proof *) + [ + REWRITE_TAC[adjv]; + SELECT_TAC ; + THM_INTRO_TAC[`e`;`f`] edge_inter; + FULL_REWRITE_TAC [INTER;INR eq_sing;]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let has_size2_pair = prove_by_refinement( + `!(X:A->bool) a b. (X HAS_SIZE 2) /\ X a /\ X b /\ ~(a = b) ==> + (X = {a,b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC CARD_SUBSET_EQ; + FULL_REWRITE_TAC[HAS_SIZE]; + REWRITE_TAC[SUBSET;INR in_pair]; + ASM_MESON_TAC[pair_size_2;HAS_SIZE]; + ]);; + (* }}} *) + +let adjv_unique = prove_by_refinement( + `!e f n. edge e /\ edge f /\ adj e f /\ closure top2 e (pointI n) /\ + closure top2 f (pointI n) ==> (n = adjv e f)`, + (* {{{ proof *) + [ + REWRITE_TAC[adjv]; + SELECT_TAC; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`e`] two_endpoint; + THM_INTRO_TAC[`f`] two_endpoint; + THM_INTRO_TAC[ `{m | closure top2 f (pointI m)}`;`n`;`t`] has_size2_pair; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[ `{m | closure top2 e (pointI m)}`;`n`;`t`] has_size2_pair; + ASM_REWRITE_TAC[]; + TYPE_THEN `cls {e} = cls {f}` SUBAGOAL_TAC; + REWRITE_TAC[cls_edge;INR IN_SING ]; + THM_INTRO_TAC[`e`;`f`] cls_inj; + TYPE_THEN`f` UNABBREV_TAC; + FULL_REWRITE_TAC[adj]; + (* - *) + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let adjv_symm = prove_by_refinement( + `!e f. edge e /\ edge f /\ adj e f ==> + (adjv f e = adjv e f)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC adjv_unique; + THM_INTRO_TAC[`f`;`e`] adjv_adj; + ASM_MESON_TAC[adj_symm]; + THM_INTRO_TAC[`f`;`e`] adjv_adj2; + ASM_MESON_TAC[adj_symm]; + ]);; + (* }}} *) + +let adjv_segment = prove_by_refinement( + `!E e f. segment E /\ E e /\ E f /\ adj e f ==> + ({C| E C /\ closure top2 C (pointI (adjv e f))} = {e,f} ) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC has_size2_pair; + TYPE_THEN `~(e = f)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[adj]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `edge e /\ edge f` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment;ISUBSET]; + (* - *) + TYPE_THEN `closure top2 e (pointI (adjv e f))` SUBAGOAL_TAC; + IMATCH_MP_TAC adjv_adj; + TYPE_THEN `closure top2 f (pointI (adjv e f))` SUBAGOAL_TAC; + IMATCH_MP_TAC adjv_adj2; + (* - *) + TYPE_THEN `{0,1,2} (num_closure E (pointI (adjv e f)))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + FULL_REWRITE_TAC[INSERT]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + UND 9 THEN REP_CASES_TAC; + THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure_size; + REWR 11; + (* -- *) + THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure1; + REWR 11; + COPY 11; + TSPEC `f` 11; + TSPEC `e` 12; + REWR 11; + REWR 12; + (* - *) + THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure0; + REWR 11; + TSPEC `e` 11; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let num_closure_elt = prove_by_refinement( + `!S m. (0 <| num_closure S m) ==> (?e. S e /\ closure top2 e m)`, + (* {{{ proof *) + [ + REWRITE_TAC[num_closure]; + TYPE_THEN `~({C | S C /\ closure top2 C m} = EMPTY)` SUBAGOAL_TAC; + REWR 0; + FULL_REWRITE_TAC[CARD_CLAUSES]; + UND 0 THEN ARITH_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +(* I shouldn't need three minor variations of the same + thing here, but here they are *) + +let rectagon_subset_endpoint = prove_by_refinement( + `!E S k. rectagon E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\ + (0 <| num_closure (E DIFF S) (pointI k)) ==> + (endpoint S k)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono; + TYPE_THEN `{0,2} (num_closure E (pointI k))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[INSERT]; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC ; + PROOF_BY_CONTR_TAC; + TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC; + REWR 5; + UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC; + TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET_EQ; + USE 9 (REWRITE_RULE[num_closure]); + USE 7 (REWRITE_RULE[num_closure]); + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET;]; + REWRITE_TAC[SUBSET;]; + FULL_REWRITE_TAC[ISUBSET]; + (* -- *) + USE 0 (REWRITE_RULE[num_closure]); + USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`)); + TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC; + REWRITE_TAC[EQ_EMPTY ]; + USE 12 (REWRITE_RULE[DIFF]); + USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]); + TSPEC `x` 10; + REWR 10; + UND 0 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CARD_CLAUSES]; + UND 7 THEN UND 5 THEN UND 1 THEN ARITH_TAC; + ]);; + (* }}} *) + +let psegment_subset_endpoint = prove_by_refinement( + `!E S k. psegment E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\ + (0 <| num_closure (E DIFF S) (pointI k)) ==> + (endpoint S k)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono; + TYPE_THEN `{0,1,2} (num_closure E (pointI k))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + FULL_REWRITE_TAC[INSERT]; + (* - *) + FULL_REWRITE_TAC[DISJ_ACI]; + FIRST_ASSUM DISJ_CASES_TAC ; + PROOF_BY_CONTR_TAC; + TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC; + REWR 5; + UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC; + TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET_EQ; + USE 9 (REWRITE_RULE[num_closure]); + USE 7 (REWRITE_RULE[num_closure]); + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET;]; + REWRITE_TAC[SUBSET;]; + FULL_REWRITE_TAC[ISUBSET]; + (* -- *) + USE 0 (REWRITE_RULE[num_closure]); + USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`)); + TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC; + REWRITE_TAC[EQ_EMPTY ]; + USE 12 (REWRITE_RULE[DIFF]); + USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]); + TSPEC `x` 10; + REWR 10; + UND 0 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CARD_CLAUSES]; + (* - *) + KILL 6; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`E`;`pointI k`] num_closure1; + REWR 8; + USE 0 (MATCH_MP num_closure_elt); + FULL_REWRITE_TAC[DIFF]; + USE 1 (MATCH_MP num_closure_elt); + COPY 8; + TSPEC `e'` 12; + TSPEC `e''` 8; + FULL_REWRITE_TAC[ISUBSET]; + ASM_MESON_TAC[]; + (* - *) + UND 6 THEN UND 5 THEN UND 1 THEN ARITH_TAC; + ]);; + (* }}} *) + + +let num_closure_pos = prove_by_refinement( + `!G m. + FINITE G /\ (?e. G e /\ closure top2 e (pointI m)) ==> + (0 <| (num_closure G (pointI m)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC ; + TYPE_THEN `num_closure G (pointI m) = 0` SUBAGOAL_TAC; + UND 3 THEN ARITH_TAC; + THM_INTRO_TAC[`G`;`pointI m`] num_closure0; + REWR 5; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let cut_rectagon = prove_by_refinement( + `!E m n. (rectagon E) /\ (0 < num_closure E (pointI m)) /\ + (0 < num_closure E (pointI n)) /\ ~(m = n) ==> + (?A B. psegment A /\ psegment B /\ (E = A UNION B) /\ + (A INTER B = EMPTY) /\ (endpoint A = {m,n}) /\ + (endpoint B = {m,n}) /\ + (!k. (0 < num_closure A (pointI k)) /\ + (0 < num_closure B (pointI k)) ==> (k = m) \/ (k = n) )) + `, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + THM_INTRO_TAC[`E`;`pointI m`] num_closure_size; + TYPE_THEN `~({C | E C /\ closure top2 C (pointI m)} = EMPTY)` SUBAGOAL_TAC; + USE 6 SYM; + FULL_REWRITE_TAC[HAS_SIZE]; + USE 6 (AP_TERM `CARD:(((num->real)->bool)->bool)->num`); + USE 6 (REWRITE_RULE[CARD_CLAUSES]); +(**** Changed by JRH because of new ARITH_RULE's inability to handle alpha equivs + UND 6 THEN UND 5 THEN UND 2 THEN ARITH_TAC; + ****) + UND 6 THEN UND 5 THEN UND 2 THEN REWRITE_TAC[ARITH_RULE `0 < x ==> (y = x) ==> (0 = y) ==> F`]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + THM_INTRO_TAC[`E`;`u`;`m`] rectagon_order; + TYPE_THEN `!n. (0 <| num_closure E (pointI n)) ==> (num_closure E (pointI n) = 2)` SUBAGOAL_TAC ; + TYPE_THEN `{0,2} (num_closure E (pointI n'))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[INSERT]; + FIRST_ASSUM DISJ_CASES_TAC; + UND 14 THEN UND 12 THEN ARITH_TAC; + TYPE_THEN `u` UNABBREV_TAC; + (* -A *) + TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `num_closure E (pointI m) = 2` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`;`pointI m`] num_closure; + REWR 14; + THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI m)}`;`E`] CARD_SUBSET; + REWRITE_TAC[SUBSET]; + USE 14 SYM ; + REWR 15; + UND 15 THEN UND 10 THEN ARITH_TAC; + (* - *) + TYPE_THEN `!m. (closure top2 (f 0) (pointI m)) /\ (closure top2 (f (CARD E - 1)) (pointI m)) ==> (m = adjv (f 0) (f (CARD E -| 1)))` SUBAGOAL_TAC; + IMATCH_MP_TAC adjv_unique; + FULL_REWRITE_TAC[BIJ;INJ;rectagon;ISUBSET ]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 10 THEN ARITH_TAC; + REWRITE_TAC[adj;EMPTY_EXISTS;INTER;]; + CONJ_TAC; + TYPE_THEN `0 = (CARD E -| 1)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 10 THEN ARITH_TAC; + UND 22 THEN UND 10 THEN ARITH_TAC; + TYPE_THEN `pointI m'` EXISTS_TAC; + (* -B *) + TYPE_THEN `num_closure E (pointI n) = 2` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`;`pointI n`] num_closure2; + REWR 15; + TYPE_THEN `E a /\ closure top2 a (pointI n)` SUBAGOAL_TAC; + TYPE_THEN `E b /\ closure top2 b (pointI n)` SUBAGOAL_TAC; + TYPE_THEN `?i. (i < CARD E) /\ (f i = a)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + TYPE_THEN `a` UNABBREV_TAC; + TYPE_THEN `?j. (j < CARD E) /\ (f j = b)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + TYPE_THEN `b` UNABBREV_TAC; + COPY 8; + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + (* - *) + TYPE_THEN `adj (f i) (f j)` SUBAGOAL_TAC THEN REWRITE_TAC[adj]; + REWRITE_TAC[INTER;EMPTY_EXISTS ]; + UNIFY_EXISTS_TAC; + REWR 8; + (* -C *) + TYPE_THEN `edge (f i)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon;ISUBSET]; + TYPE_THEN `edge (f j)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon;ISUBSET]; + TYPE_THEN `?k. (k < CARD E -| 1) /\ (n = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `i` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 27 THEN UND 23 THEN ARITH_TAC; + IMATCH_MP_TAC adjv_unique; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 28 THEN UND 22 THEN ARITH_TAC; + IMATCH_MP_TAC adjv_unique; + USE 24 (ONCE_REWRITE_RULE[adj_symm]); + (* -- *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `i` UNABBREV_TAC; + TYPE_THEN `j` UNABBREV_TAC; + COPY 13; + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]); + UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]); + PROOF_BY_CONTR_TAC; + UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[]; + TYPE_THEN `i` UNABBREV_TAC; + TYPE_THEN `j` UNABBREV_TAC; + COPY 13; + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]); + UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]); + PROOF_BY_CONTR_TAC; + UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[]; + (* - *) + TYPE_THEN `A = IMAGE f {p | p <| SUC(k)}` ABBREV_TAC ; + TYPE_THEN `B = IMAGE f {p | SUC(k) <=| p /\ p < CARD E}` ABBREV_TAC ; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + (* -D , now prove properties *) + KILL 26; + KILL 25; + KILL 8; + KILL 24; + KILL 23; + KILL 22; + KILL 19; + KILL 20; + KILL 17; + KILL 18; + KILL 15; + KILL 16; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC order_imp_psegment; + REWRITE_TAC[ARITH_RULE `0 <| SUC k`]; + (* -- *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon;ISUBSET]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 17 THEN UND 28 THEN ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 18 THEN UND 19 THEN UND 28 THEN ARITH_TAC; + (* -- *) + UND 21 THEN DISCH_THEN ( THM_INTRO_TAC[`i`;`j`]); + UND 8 THEN UND 15 THEN UND 28 THEN ARITH_TAC; + TYPE_THEN `~(j = CARD E -| 1)` SUBAGOAL_TAC; + UND 18 THEN UND 8 THEN UND 28 THEN ARITH_TAC; + TYPE_THEN `~(i = CARD E -| 1)` SUBAGOAL_TAC; + UND 19 THEN UND 15 THEN UND 28 THEN ARITH_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC order_imp_psegment_shift; + SUBCONJ_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon;ISUBSET]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + UND 28 THEN ARITH_TAC; + (* -- *) + UND 21 THEN DISCH_THEN ( THM_INTRO_TAC[`i`;`j`]); + TYPE_THEN `~(j = 0)` SUBAGOAL_TAC; + UND 21 THEN UND 17 THEN ARITH_TAC; + TYPE_THEN `~(i = 0)` SUBAGOAL_TAC; + UND 22 THEN UND 19 THEN ARITH_TAC; + (* -E *) + SUBCONJ_TAC; + TYPE_THEN `(IMAGE f {p | p <| CARD E} = E)` SUBAGOAL_TAC; + IMATCH_MP_TAC bij_imp_image; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[GSYM IMAGE_UNION]; + TYPE_THEN `cE = CARD E` ABBREV_TAC ; + UND 16 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UND 28 THEN ARITH_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC ; + REWRITE_TAC[IMAGE]; + PROOF_BY_CONTR_TAC ; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `u'` UNABBREV_TAC; + TYPE_THEN `x = x'` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 22 THEN UND 28 THEN ARITH_TAC; + UND 20 THEN UND 19 THEN UND 22 THEN ARITH_TAC; + (* - *) + TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC; + UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; + TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC; + UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; + (* - finite A ,B *) + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `FINITE B` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* -F *) + TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon;ISUBSET]; + KILL 16; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 11 (REWRITE_RULE[BIJ;SURJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 11 (REWRITE_RULE[BIJ;SURJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + UND 21 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]); + UND 28 THEN ARITH_TAC; + (* - *) + TYPE_THEN `0 <| num_closure A (pointI n)` SUBAGOAL_TAC; + IMATCH_MP_TAC num_closure_pos; + TYPE_THEN `f k` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `k` EXISTS_TAC; + ARITH_TAC; + IMATCH_MP_TAC adjv_adj; + (* - *) + TYPE_THEN `0 <| num_closure B (pointI n)` SUBAGOAL_TAC; + IMATCH_MP_TAC num_closure_pos; + TYPE_THEN `f (SUC k)` EXISTS_TAC; + TYPE_THEN `B` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `SUC k` EXISTS_TAC; + UND 28 THEN ARITH_TAC; + IMATCH_MP_TAC adjv_adj2; + (* - *) + TYPE_THEN `0 <| num_closure A (pointI m)` SUBAGOAL_TAC; + IMATCH_MP_TAC num_closure_pos; + TYPE_THEN `f 0` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `0` EXISTS_TAC; + ARITH_TAC; + (* - *) + TYPE_THEN `0 <| num_closure B (pointI m)` SUBAGOAL_TAC; + IMATCH_MP_TAC num_closure_pos; + KILL 16; + TYPE_THEN `f (CARD E -| 1)` EXISTS_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `CARD E -| 1` EXISTS_TAC; + UND 28 THEN ARITH_TAC; + (* -G *) + SUBCONJ_TAC; + IMATCH_MP_TAC has_size2_pair; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC endpoint_size2; + CONJ_TAC; + IMATCH_MP_TAC rectagon_subset_endpoint; + UNIFY_EXISTS_TAC ; + ASM_REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_subset_endpoint; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `n` UNABBREV_TAC; + UND 34 THEN UND 27 THEN UND 0 THEN MESON_TAC[]; + (* - *) + SUBCONJ_TAC; + IMATCH_MP_TAC has_size2_pair; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC endpoint_size2; + CONJ_TAC; + IMATCH_MP_TAC rectagon_subset_endpoint; + UNIFY_EXISTS_TAC ; + ASM_REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_subset_endpoint; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `n` UNABBREV_TAC; + UND 35 THEN UND 27 THEN UND 0 THEN MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`E`;`A`;`k'`] rectagon_subset_endpoint; + ASM_REWRITE_TAC[SUBSET;UNION]; + REWR 38; + USE 38 (REWRITE_RULE[INR in_pair]); + UND 38 THEN MESON_TAC[]; + ]);; + + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION S *) +(* ------------------------------------------------------------------ *) + +(* 2 - connected *) + + +(* -------------- MOVE TO TACTICS, *) +(* proves ineqs of the form a + (&:0)*c <= b. + This handles ineqs such as a <=: a + &:(SUC n) that + INT_ARITH_TAC can't do. *) + +let int_le_mp = prove_by_refinement( + `!a b c. (a +: c = b) /\ (&:0 <=: c) ==> (a + (&:0)*c <=: b)`, + (* {{{ proof *) + [ + INT_ARITH_TAC; + ]);; + (* }}} *) + +(* rewrites assumptions as 0 <= A, breaks 0 <= A + B into 2, + then breaks 0 <= A*B into 2, and tries rewriting and INT_ARITH_TAC *) + +let int_le_tac = RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM INT_SUB_LE]) THEN + IMATCH_MP_TAC int_le_mp THEN + CONJ_TAC THENL [TRY INT_ARITH_TAC;ALL_TAC] THEN + ASM_REWRITE_TAC[INT_POS] THEN + REPEAT (IMATCH_MP_TAC INT_LE_ADD THEN CONJ_TAC THEN + ASM_REWRITE_TAC[INT_POS]) THEN + REPEAT (IMATCH_MP_TAC INT_LE_MUL THEN CONJ_TAC THEN + ASM_REWRITE_TAC[INT_POS]) THEN + ASM_REWRITE_TAC[INT_POS] THEN + TRY INT_ARITH_TAC;; + + +let clean_int_le_tac = FULL_REWRITE_TAC[INT_MUL_LZERO;INT_ADD_RID];; + +let test_case_int_le_tac = prove_by_refinement( + `!a b n. a +: &:(SUC n) <= b ==> a <= b`, + (* {{{ proof *) + [ + (* INT_ARITH_TAC fails *) + REP_BASIC_TAC; + TYPE_THEN `a + (&:0)*((b - (a +: &:(SUC n))) + (&:(SUC n))) <=: b` SUBAGOAL_TAC; + int_le_tac; + clean_int_le_tac; + ]);; + (* }}} *) + + + + +(* -------------- *) + +let segment_end = jordan_def `segment_end S a b <=> + psegment S /\ (endpoint S = {a,b})`;; + +let conn = jordan_def `conn E <=> (!a b. + (cls E a /\ cls E b /\ ~(a = b) ==> + (?S. (S SUBSET E /\ segment_end S a b))))`;; + +let conn2 = jordan_def `conn2 E <=> (FINITE E) /\ + (2 <=| CARD E) /\ (!a b c. cls E a /\ cls E b /\ + ~(a = b) /\ ~(b = c) /\ ~(a = c) ==> + (?S. (S SUBSET E /\ segment_end S a b /\ ~(cls S c))))`;; + +let segment_end_symm = prove_by_refinement( + `!S a b. (segment_end S a b = segment_end S b a)`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_end]; + TYPE_THEN `{a,b} = {b,a}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair]; + MESON_TAC[]; + ]);; + (* }}} *) + +let segment_end_disj = prove_by_refinement( + `!S a b. segment_end S a b ==> ~(a = b)`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_end]; + THM_INTRO_TAC[`S`] endpoint_size2; + USE 3 (REWRITE_RULE[has_size2]); + TYPE_THEN `endpoint S` UNABBREV_TAC; + USE 1 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + FULL_REWRITE_TAC[INR in_pair]; + COPY 1; + TSPEC `a'` 4; + TSPEC `b'` 1; + REWR 1; + REWR 4; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let cut_psegment = prove_by_refinement( + `!E a b c. segment_end E a b /\ cls E c /\ ~(c = a) /\ ~(c = b) ==> + (?A B. (E = (A UNION B)) /\ (A INTER B = EMPTY) /\ + (cls A INTER cls B = {c}) /\ + segment_end A a c /\ segment_end B c b)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `~(a = b)` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`;`a`;`b`] segment_end_disj; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[segment_end]; + FULL_REWRITE_TAC[cls]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + REWRITE_TAC[INR eq_sing;INTER;EQ_EMPTY ]; + REWRITE_TAC[CONJ_ACI]; + (* - *) + THM_INTRO_TAC[`E`;`a`;`b`] psegment_order; + REWRITE_TAC[INR in_pair]; + TYPE_THEN `num_closure E (pointI c) = 2` SUBAGOAL_TAC; + TYPE_THEN `{0,1,2} (num_closure E (pointI c))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + FULL_REWRITE_TAC[INSERT;DISJ_ACI]; + FIRST_ASSUM DISJ_CASES_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + USE 3 SYM; + TYPE_THEN `endpoint E c` SUBAGOAL_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `endpoint E` UNABBREV_TAC; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`E`;`pointI c`] num_closure0; + REWR 15; + TSPEC `e` 15; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `?k. (k < CARD E -| 1) /\ (c = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`;`pointI c`] num_closure2; + REWR 13; + TYPE_THEN `E a' /\ closure top2 a' (pointI c)` SUBAGOAL_TAC; + TYPE_THEN `?i'. (i' <| CARD E) /\ ( f i' = a')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + TYPE_THEN `a'` UNABBREV_TAC; + TYPE_THEN `E b' /\ closure top2 b' (pointI c)` SUBAGOAL_TAC; + TYPE_THEN `?j'. (j' <| CARD E) /\ ( f j' = b')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + TYPE_THEN `b'` UNABBREV_TAC; + UND 8 THEN DISCH_THEN ( THM_INTRO_TAC[`i'`;`j'`]); + USE 8 SYM; + TYPE_THEN `adj (f i') (f j')` SUBAGOAL_TAC; + IMATCH_MP_TAC closure_imp_adj; + UNIFY_EXISTS_TAC; + REWR 8; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `i'` EXISTS_TAC; + CONJ_TAC; + UND 22 THEN UND 21 THEN ARITH_TAC; + IMATCH_MP_TAC adjv_unique; + FULL_REWRITE_TAC[psegment;segment;ISUBSET]; + TYPE_THEN `j'` EXISTS_TAC; + CONJ_TAC; + UND 22 THEN UND 18 THEN ARITH_TAC; + IMATCH_MP_TAC adjv_unique; + USE 20 (ONCE_REWRITE_RULE[adj_symm]); + FULL_REWRITE_TAC[psegment;segment;ISUBSET]; + (* -A *) + TYPE_THEN `c` UNABBREV_TAC; + TYPE_THEN `A = IMAGE f { p | p <| SUC k}` ABBREV_TAC ; + TYPE_THEN `B = IMAGE f { p | SUC k <=| p /\ p < CARD E}` ABBREV_TAC ; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + (* - now prove properties *) + TYPE_THEN `psegment A` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC order_imp_psegment; + CONJ_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment;ISUBSET]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 18 THEN UND 14 THEN ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 19 THEN UND 20 THEN UND 14 THEN ARITH_TAC; + CONJ_TAC; + ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 13 THEN UND 16 THEN UND 14 THEN ARITH_TAC; + (* - *) + TYPE_THEN `psegment B` SUBAGOAL_TAC; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC order_imp_psegment_shift; + CONJ_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment;ISUBSET]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + UND 14 THEN ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + FULL_REWRITE_TAC[IMAGE]; + TYPE_THEN`x` UNABBREV_TAC; + TYPE_THEN `x' = x''` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 15 THEN UND 14 THEN ARITH_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + UND 15 THEN UND 20 THEN ARITH_TAC; + (* -B *) + TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment;ISUBSET]; + (* - *) + TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[BIJ;SURJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 14 THEN ARITH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[BIJ;SURJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 14 THEN ARITH_TAC; + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]); + UND 14 THEN ARITH_TAC; + (* - *) + TYPE_THEN `(?e. A e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC; + TYPE_THEN `f k` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `k` EXISTS_TAC; + ARITH_TAC; + IMATCH_MP_TAC adjv_adj; + (* - *) + TYPE_THEN `(?e. B e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC; + TYPE_THEN `f (SUC k)` EXISTS_TAC; + TYPE_THEN `B` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `SUC k` EXISTS_TAC; + UND 14 THEN ARITH_TAC; + IMATCH_MP_TAC adjv_adj2; + (* - *) + TYPE_THEN `IMAGE f {p | p <| CARD E} = E` SUBAGOAL_TAC; + IMATCH_MP_TAC bij_imp_image; + (* - *) + TYPE_THEN `A UNION B = E` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[GSYM IMAGE_UNION]; + TYPE_THEN `cE = CARD E` ABBREV_TAC ; + UND 27 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t])) THEN AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UND 14 THEN ARITH_TAC; + (* -C *) + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + USE 28 SYM; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `FINITE B` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + USE 28 SYM; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC; + USE 28 SYM; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;DIFF]; + UND 18 THEN MESON_TAC[]; + (* - *) + TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC; + USE 28 SYM; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;DIFF]; + UND 18 THEN MESON_TAC[]; + (* - *) + TYPE_THEN `endpoint A (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; + IMATCH_MP_TAC psegment_subset_endpoint; + UNIFY_EXISTS_TAC; + USE 28 (SYM); + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`]; + CONJ_TAC; + THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; + REWR 34; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; + REWR 34; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `endpoint B (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC; + IMATCH_MP_TAC psegment_subset_endpoint; + UNIFY_EXISTS_TAC; + USE 28 (SYM); + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`]; + CONJ_TAC; + THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; + REWR 35; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0; + REWR 35; + ASM_MESON_TAC[]; + (* -D *) + TYPE_THEN `endpoint A a` SUBAGOAL_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `endpoint E a` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + THM_INTRO_TAC[`A`;`E`;`pointI a`] num_closure_mono; + USE 28 SYM; + REWRITE_TAC[SUBSET;UNION]; + USE 35 (REWRITE_RULE[endpoint]); + REWR 36; + USE 36 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]); + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`A`;`pointI a`] num_closure0; + REWR 38; + TSPEC `f 0` 38 ; + USE 10 SYM; + UND 38 THEN DISCH_THEN (THM_INTRO_TAC[]); + TYPE_THEN`A` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `0` EXISTS_TAC; + ARITH_TAC; + THM_INTRO_TAC[`E`;`a`] terminal_endpoint; + REWRITE_TAC[INR in_pair]; + UND 39 THEN ASM_REWRITE_TAC[]; + (* -E *) + TYPE_THEN `endpoint B b` SUBAGOAL_TAC; + REWRITE_TAC[endpoint]; + TYPE_THEN `endpoint E b` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + THM_INTRO_TAC[`B`;`E`;`pointI b`] num_closure_mono; + USE 28 SYM; + REWRITE_TAC[SUBSET;UNION]; + USE 36 (REWRITE_RULE[endpoint]); + REWR 37; + USE 37 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]); + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`B`;`pointI b`] num_closure0; + REWR 39; + TSPEC `f (CARD E -| 1)` 39 ; + UND 39 THEN DISCH_THEN (THM_INTRO_TAC[]); + TYPE_THEN`B` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `CARD E -| 1` EXISTS_TAC; + UND 14 THEN ARITH_TAC; + THM_INTRO_TAC[`E`;`b`] terminal_endpoint; + REWRITE_TAC[INR in_pair]; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]); + UND 14 THEN ARITH_TAC; + UND 39 THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `endpoint A = {a, (adjv (f k) (f (SUC k)))}` SUBAGOAL_TAC; + IMATCH_MP_TAC has_size2_pair; + IMATCH_MP_TAC endpoint_size2; + TYPE_THEN `endpoint B = {(adjv (f k) (f (SUC k))), b}` SUBAGOAL_TAC; + IMATCH_MP_TAC has_size2_pair; + IMATCH_MP_TAC endpoint_size2; + (* - *) + CONJ_TAC; + USE 37 SYM; + TYPE_THEN `endpoint A u` SUBAGOAL_TAC; + IMATCH_MP_TAC psegment_subset_endpoint; + UNIFY_EXISTS_TAC; + CONJ_TAC; + USE 28 SYM; + REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + IMATCH_MP_TAC num_closure_pos; + UNIFY_EXISTS_TAC; + IMATCH_MP_TAC num_closure_pos; + TYPE_THEN `e''''` EXISTS_TAC ; + USE 38 SYM; + TYPE_THEN `endpoint B u` SUBAGOAL_TAC; + IMATCH_MP_TAC psegment_subset_endpoint; + UNIFY_EXISTS_TAC; + CONJ_TAC; + USE 28 SYM; + REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + IMATCH_MP_TAC num_closure_pos; + TYPE_THEN `e''''` EXISTS_TAC ; + IMATCH_MP_TAC num_closure_pos; + TYPE_THEN `e'''` EXISTS_TAC ; + TYPE_THEN `endpoint A` UNABBREV_TAC; + TYPE_THEN `endpoint B` UNABBREV_TAC; + FULL_REWRITE_TAC[INR in_pair]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + TYPE_THEN `e'` EXISTS_TAC; + TYPE_THEN `e''` EXISTS_TAC; + ]);; + (* }}} *) + +let segment_end_inj = prove_by_refinement( + `!S a b c. (segment_end S a b /\ segment_end S a c) ==> (b = c)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`S`;`a`;`b`] segment_end_disj; + THM_INTRO_TAC[`S`;`a`;`c`] segment_end_disj; + FULL_REWRITE_TAC[segment_end]; + TYPE_THEN `endpoint S` UNABBREV_TAC; + USE 0 (ONCE_REWRITE_RULE [FUN_EQ_THM]); + TSPEC `b` 0; + FULL_REWRITE_TAC[INR in_pair]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let segment_end_finite = prove_by_refinement( + `!S a b. segment_end S a b ==> FINITE S`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_end;psegment;segment]; + ]);; + (* }}} *) + +let segment_superset_endpoint = prove_by_refinement( + `!E S k. segment E /\ S SUBSET E /\ (endpoint S k) /\ + (num_closure (E DIFF S) (pointI k) = 0) ==> + (endpoint E k) `, + (* {{{ proof *) + [ + REWRITE_TAC[endpoint]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + ASM_SIMP_TAC[num_closure1]; + TYPE_THEN `FINITE S` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + THM_INTRO_TAC[`S`;`pointI k`] num_closure1; + REWR 6; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `S e /\ closure top2 e (pointI k)` SUBAGOAL_TAC; + TYPE_THEN `S e'` ASM_CASES_TAC; + FULL_REWRITE_TAC[ISUBSET]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`S`;`pointI k`] num_closure0; + REWR 10; + FULL_REWRITE_TAC[ARITH_RULE `~(1=0)`]; + TYPE_THEN `~(e = e')` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[]; + USE 0 (REWRITE_RULE[ARITH_RULE `(x = 0) <=> ~(0 <| x)`]); + UND 0 THEN REWRITE_TAC[]; + IMATCH_MP_TAC num_closure_pos; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + TYPE_THEN `e'` EXISTS_TAC; + REWRITE_TAC[DIFF]; + ]);; + (* }}} *) + +let segment_end_union_lemma = prove_by_refinement( + `!A B a b c. segment_end A a b /\ segment_end B b c /\ + (A INTER B = EMPTY) /\ (cls A INTER cls B = {b}) ==> + segment_end (A UNION B) a c `, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A`;`a`;`b`] segment_end_disj; + THM_INTRO_TAC[`B`;`b`;`c`] segment_end_disj; + FULL_REWRITE_TAC[cls;segment_end]; + TYPE_THEN `segment (A UNION B) /\ (endpoint (A UNION B) = {a,c}) ==> psegment (A UNION B) /\ (endpoint (A UNION B) = {a, c})` SUBAGOAL_TAC; + IMATCH_MP_TAC endpoint_psegment; + TYPE_THEN `a` EXISTS_TAC; + REWRITE_TAC[INR in_pair]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + SUBCONJ_TAC; + IMATCH_MP_TAC segment_union; + TYPE_THEN `b` EXISTS_TAC; + REWRITE_TAC[INR in_pair]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + FULL_REWRITE_TAC[INR IN_SING;INTER;]; + TSPEC `n` 0; + ASM_MESON_TAC[num_closure_elt]; + (* - *) + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + TYPE_THEN `FINITE B` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment;segment]; + TYPE_THEN `FINITE (A UNION B)` SUBAGOAL_TAC; + REWRITE_TAC[FINITE_UNION]; + (* -A *) + TYPE_THEN `endpoint (A UNION B) a` SUBAGOAL_TAC; + IMATCH_MP_TAC segment_superset_endpoint; + TYPE_THEN `A` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION ]; + REWRITE_TAC[INR in_pair]; + TYPE_THEN `(A UNION B) DIFF A = B` SUBAGOAL_TAC; + UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; + ASM_SIMP_TAC[num_closure0]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INTER;INR IN_SING]); + TSPEC `a` 0; + TYPE_THEN `(?e. A e /\ closure top2 e (pointI a))` SUBAGOAL_TAC; + TYPE_THEN `terminal_edge A a` EXISTS_TAC; + TYPE_THEN `endpoint A a` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + IMATCH_MP_TAC terminal_endpoint; + ASM_MESON_TAC[]; + TYPE_THEN `psegment (A UNION B)` SUBAGOAL_TAC; + ASM_MESON_TAC[endpoint_psegment]; + IMATCH_MP_TAC has_size2_pair; + (* - *) + TYPE_THEN `endpoint (A UNION B) c` SUBAGOAL_TAC; + IMATCH_MP_TAC segment_superset_endpoint; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION ]; + REWRITE_TAC[INR in_pair]; + TYPE_THEN `(A UNION B) DIFF B = A` SUBAGOAL_TAC; + UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY]; + ASM_SIMP_TAC[num_closure0]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INTER;INR IN_SING]); + TSPEC `c` 0; + TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC; + TYPE_THEN `terminal_edge B c` EXISTS_TAC; + TYPE_THEN `endpoint B c` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + IMATCH_MP_TAC terminal_endpoint; + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC endpoint_size2; + (* - *) + TYPE_THEN`a` UNABBREV_TAC; + TYPE_THEN `endpoint B c /\ endpoint A c` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INTER;INR IN_SING]); + TSPEC `c` 0; + TYPE_THEN `(?e. A e /\ closure top2 e (pointI c))` SUBAGOAL_TAC; + TYPE_THEN `terminal_edge A c` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC; + TYPE_THEN `terminal_edge B c` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let cls_subset = prove_by_refinement( + `!A B. A SUBSET B ==> cls A SUBSET cls B`, + (* {{{ proof *) + [ + REWRITE_TAC[cls]; + REWRITE_TAC[SUBSET]; + TYPE_THEN `e` EXISTS_TAC; + ASM_MESON_TAC[ISUBSET]; + ]);; + (* }}} *) + +let segment_end_union = prove_by_refinement( + `!A B a b c. segment_end A a b /\ segment_end B b c /\ + (cls A INTER cls B = {b}) ==> + segment_end (A UNION B) a c`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC segment_end_union_lemma; + TYPE_THEN `b` EXISTS_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER ]; + TYPE_THEN `edge u` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end;psegment;segment;ISUBSET]; + TYPE_THEN `(cls {u} ) HAS_SIZE 2` SUBAGOAL_TAC; + REWRITE_TAC[cls_edge]; + IMATCH_MP_TAC two_endpoint; + FULL_REWRITE_TAC[has_size2]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0 (REWRITE_RULE[INR IN_SING ]); + COPY 0; + TSPEC `a'` 8; + TSPEC `b'` 0; + TYPE_THEN `cls {u} a' /\ cls {u} b'` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + KILL 7; + TYPE_THEN `cls {u} SUBSET cls A` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;INR IN_SING]; + TYPE_THEN `cls {u} SUBSET cls B` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;INR IN_SING]; + FULL_REWRITE_TAC[ISUBSET]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let segment_end_cls = prove_by_refinement( + `!A a b. segment_end A a b ==> cls A a`, + (* {{{ proof *) + [ + REWRITE_TAC[cls;segment_end]; + TYPE_THEN `terminal_edge A a` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + FULL_REWRITE_TAC[INR in_pair;psegment;segment]; + ]);; + (* }}} *) + +let segment_end_cls2 = prove_by_refinement( + `!A a b. segment_end A a b ==> cls A b`, + (* {{{ proof *) + [ + REWRITE_TAC[cls;segment_end]; + TYPE_THEN `terminal_edge A b` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + FULL_REWRITE_TAC[INR in_pair;psegment;segment]; + ]);; + (* }}} *) + +let card_subset_lt = prove_by_refinement( + `!(a:A->bool) b. a SUBSET b /\ ~(a = b) /\ FINITE b ==> + (CARD a < CARD b)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC (ARITH_RULE (`x <=| y /\ ~( x = y) ==> (x < y)`)); + CONJ_TAC; + IMATCH_MP_TAC CARD_SUBSET; + UND 1 THEN REWRITE_TAC[]; + IMATCH_MP_TAC CARD_SUBSET_EQ; + ]);; + (* }}} *) + +let segment_end_trans = prove_by_refinement( + `!R S a b c. segment_end R a b /\ segment_end S b c /\ ~(a = c) ==> + (?U. segment_end U a c /\ (U SUBSET (R UNION S)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN`SS = { (U,V,b') | segment_end U a b' /\ segment_end V b' c /\ (U SUBSET (R UNION S) /\ V SUBSET (R UNION S) ) }` ABBREV_TAC ; + TYPE_THEN `~(SS = EMPTY)` SUBAGOAL_TAC; + UND 4 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `(R,S,b)` EXISTS_TAC; + TYPE_THEN `SS` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "U"); + CONV_TAC (dropq_conv "V"); + TYPE_THEN `b` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `FINITE R` SUBAGOAL_TAC; + IMATCH_MP_TAC segment_end_finite; + UNIFY_EXISTS_TAC; + TYPE_THEN `FINITE S` SUBAGOAL_TAC; + IMATCH_MP_TAC segment_end_finite; + UNIFY_EXISTS_TAC; + TYPE_THEN `FINITE (R UNION S)` SUBAGOAL_TAC; + ASM_REWRITE_TAC[FINITE_UNION]; + (* - *) + TYPE_THEN `f = (\ ((U,V,b):((((num->real)->bool)->bool)#((((num->real)->bool)->bool)#(int#int))) ). (CARD U) + (CARD V))` ABBREV_TAC ; + THM_INTRO_TAC[`SS`;`f`] select_image_num_min; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `?Um Vm bm. z = (Um,Vm,bm)` SUBAGOAL_TAC ; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `!U' V' b''. (SS (U',V',b'') ==> f (Um,Vm,bm) <=| f (U',V',b''))` SUBAGOAL_TAC; + KILL 9; + TYPE_THEN `SS` UNABBREV_TAC; + KILL 4; + (* - *) + USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]); + REWR 4; + TYPE_THEN `U` UNABBREV_TAC; + USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]); + REWR 4; + TYPE_THEN `V` UNABBREV_TAC; + TYPE_THEN `b'` UNABBREV_TAC; + (* - *) + TYPE_THEN `! U V b'. f (U,V,b') = CARD U +| CARD V` SUBAGOAL_TAC; + USE 8 SYM; + GBETA_TAC; + KILL 8; + REWR 11; + KILL 3; + USE 4 (ONCE_REWRITE_RULE[PAIR_SPLIT]); + REWR 3; + USE 3 (CONV_RULE (dropq_conv "U")); + USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]); + REWR 3; + USE 3 (CONV_RULE (dropq_conv "V")); + USE 3 (CONV_RULE (dropq_conv "b''")); + (* - *) + TYPE_THEN `FINITE Vm` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + TYPE_THEN `FINITE Um` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + (* -A *) + THM_INTRO_TAC[`S`;`b`;`c`] segment_end_disj; + THM_INTRO_TAC[`R`;`a`;`b`] segment_end_disj; + TYPE_THEN `cls Vm a` ASM_CASES_TAC; + THM_INTRO_TAC[`Vm`;`bm`;`c`;`a`] cut_psegment; + THM_INTRO_TAC[`Um`;`a`;`bm`] segment_end_disj; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Vm` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `cls Um c` ASM_CASES_TAC; + THM_INTRO_TAC[`Um`;`a`;`bm`;`c`] cut_psegment; + THM_INTRO_TAC[`Vm`;`bm`;`c`] segment_end_disj; + TYPE_THEN `A` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Um` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `Um UNION Vm` EXISTS_TAC; + IMATCH_MP_TAC (TAUT ` a /\ b ==> b /\ a`); + SUBCONJ_TAC; + REWRITE_TAC[union_subset]; + (* - *) + IMATCH_MP_TAC segment_end_union; + TYPE_THEN `bm` EXISTS_TAC; + REWRITE_TAC[INTER;eq_sing]; + TYPE_THEN `cls Um bm /\ cls Vm bm` SUBAGOAL_TAC; + ASM_MESON_TAC[segment_end_cls;segment_end_cls2]; + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + (* -B *) + TYPE_THEN `~(u = a)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `~(u = c)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`Vm`;`bm`;`c`;`u`] cut_psegment; + THM_INTRO_TAC[`Um`;`a`;`bm`;`u`] cut_psegment; + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`A'`;`B`;`u`]); + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Um` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Vm` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `FINITE A'` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `Um` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `FINITE B` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `Vm` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* -C *) + USE 34 SYM; + TYPE_THEN `CARD A' < CARD Um` SUBAGOAL_TAC; + IMATCH_MP_TAC card_subset_lt; + USE 34 SYM; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `B' = EMPTY` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY]; + USE 37(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 37; + FULL_REWRITE_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN`B'` UNABBREV_TAC; + FULL_REWRITE_TAC[segment_end;segment;psegment]; + (* - *) + USE 29 SYM; + TYPE_THEN `CARD B < CARD Vm` SUBAGOAL_TAC; + IMATCH_MP_TAC card_subset_lt; + USE 29 SYM; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `A = EMPTY` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY]; + USE 38(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 38; + FULL_REWRITE_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN`A` UNABBREV_TAC; + FULL_REWRITE_TAC[segment_end;segment;psegment]; + (* - *) + UND 38 THEN UND 37 THEN UND 3 THEN ARITH_TAC; + ]);; + (* }}} *) + +let cls_union = prove_by_refinement( + `!A B. cls(A UNION B) = cls A UNION cls B`, + (* {{{ proof *) + [ + REWRITE_TAC[cls;UNION ]; + IMATCH_MP_TAC EQ_EXT; + MESON_TAC[]; + ]);; + (* }}} *) + +let conn_union = prove_by_refinement( + `!E E'. conn E /\ conn E' /\ ~(cls E INTER cls E' = EMPTY) ==> + conn (E UNION E')`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[conn;cls_union]; + RULE_ASSUM_TAC (REWRITE_RULE[UNION]); + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `!E E' a b u. ~(a = b) /\ ~cls E b /\ ~cls E' a /\ cls E a /\ cls E' b /\ (conn E) /\ (conn E') /\ cls E u /\ cls E' u ==> (?S. S SUBSET (E UNION E') /\ segment_end S a b)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn]; + UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`u'`]); + ASM_MESON_TAC []; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`u'`;`b'`]); + ASM_MESON_TAC[]; + THM_INTRO_TAC[`S`;`S'`;`a'`;`u'`;`b'`] segment_end_trans; + TYPE_THEN `U` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `S UNION S'` EXISTS_TAC; + IMATCH_MP_TAC subset_union_pair; + (* - *) + TYPE_THEN `cls E a /\ cls E b` ASM_CASES_TAC; + USE 2 (REWRITE_RULE[conn]); + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]); + TYPE_THEN `S` EXISTS_TAC; + UND 10 THEN REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `cls E' a /\ cls E' b` ASM_CASES_TAC; + USE 1 (REWRITE_RULE[conn]); + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]); + TYPE_THEN `S` EXISTS_TAC; + UND 11 THEN REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `cls E a /\ cls E' b` ASM_CASES_TAC; + REWR 9; + REWR 8; + UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E`;`E'`;`a`;`b`;`u`]); + (* - *) + TYPE_THEN `cls E' a /\ cls E b` ASM_CASES_TAC; + REWR 9; + REWR 8; + UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`E`;`a`;`b`;`u`]); + TYPE_THEN `S` EXISTS_TAC; + UND 13 THEN REWRITE_TAC[SUBSET;UNION]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let cls_empty = prove_by_refinement( + `cls EMPTY = EMPTY `, + (* {{{ proof *) + [ + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[cls]; + ]);; + (* }}} *) + +let finite_cls = prove_by_refinement( + `!E. FINITE E ==> (E SUBSET edge ==> FINITE (cls E))`, + (* {{{ proof *) + [ + IMATCH_MP_TAC FINITE_INDUCT_STRONG; + REWRITE_TAC[cls_empty;FINITE_RULES ]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `cls (E UNION {x})` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[cls_union;FINITE_UNION;]; + (* -- *) + TYPE_THEN `edge x /\ E SUBSET edge` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INSERT;SUBSET]; + ASM_MESON_TAC[]; + REWRITE_TAC[cls_edge]; + USE 5 (MATCH_MP two_endpoint); + FULL_REWRITE_TAC[HAS_SIZE]; + (* - *) + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[INSERT;SUBSET;INR IN_SING;UNION ]; + ]);; + (* }}} *) + +let infinite_int = prove_by_refinement( + `INFINITE (UNIV:int->bool)`, + (* {{{ proof *) + [ + IMATCH_MP_TAC infinite_subset; + TYPE_THEN `IMAGE (&:) UNIV` EXISTS_TAC; + THM_INTRO_TAC[`(&:)`] INFINITE_IMAGE_INJ; + ASM_MESON_TAC[INT_OF_NUM_EQ]; + TSPEC `UNIV:num->bool` 0; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[num_INFINITE]; + ]);; + (* }}} *) + +let infinite_intpair = prove_by_refinement( + `INFINITE (UNIV:int#int->bool)`, + (* {{{ proof *) + [ + IMATCH_MP_TAC infinite_subset; + TYPE_THEN `IMAGE (\ (i:int) . (i,&:0)) UNIV` EXISTS_TAC; + THM_INTRO_TAC[`(\ (i:int) . (i,&:0))`] INFINITE_IMAGE_INJ; + FULL_REWRITE_TAC[PAIR_SPLIT]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[infinite_int]; + ]);; + (* }}} *) + +let not_cls_exists = prove_by_refinement( + `!E. ?c. (FINITE E /\ E SUBSET edge) ==> ~cls E c`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RIGHT_TAC "c"; + THM_INTRO_TAC[`E`] finite_cls; + FULL_REWRITE_TAC[cls]; + TYPE_THEN `INFINITE (UNIV DIFF {m | ?e. E e /\ closure top2 e (pointI m)})` SUBAGOAL_TAC; + IMATCH_MP_TAC INFINITE_DIFF_FINITE; + REWRITE_TAC[infinite_intpair]; + (* - *) + USE 3 (MATCH_MP INFINITE_NONEMPTY); + USE 3 (REWRITE_RULE[EMPTY_EXISTS;DIFF]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let conn2_imp_conn = prove_by_refinement( + `!E. (E SUBSET edge ) /\ conn2 E ==> conn E`, + (* {{{ proof *) + [ + REWRITE_TAC[conn;conn2]; + THM_INTRO_TAC[`E`] finite_cls; + THM_INTRO_TAC[`E`] not_cls_exists; + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]); + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let has_size1 = prove_by_refinement( + `!(X:A -> bool). X HAS_SIZE 1 <=> SING X`, + (* {{{ proof *) + [ + REWRITE_TAC[]; + IMATCH_MP_TAC EQ_ANTISYM; + ASM_REWRITE_TAC[CARD_SING_CONV]; + FULL_REWRITE_TAC[SING]; + REWRITE_TAC[sing_has_size1]; + ]);; + (* }}} *) + +let card_gt_3 = prove_by_refinement( + `!(X:A->bool). FINITE X ==> ( 3 <= CARD X <=> + (?a b c. X a /\ X b /\ X c /\ ~(a = b) /\ ~(a = c) /\ ~( b = c)))`, + (* {{{ proof *) + [ + FULL_REWRITE_TAC[ARITH_RULE `(3 <= x) <=> ~(x = 0) /\ ~(x = 1) /\ ~(x = 2)`]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `~(X HAS_SIZE 0)` SUBAGOAL_TAC; + ASM_MESON_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[HAS_SIZE_0 ;EMPTY_EXISTS ]; + TYPE_THEN `~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2)` SUBAGOAL_TAC; + ASM_MESON_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[has_size1 ;SING;has_size2;INR eq_sing ]; + TYPE_THEN `?v. (X v /\ ~(v = u))` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + LEFT 5 "a"; + TSPEC `u` 5; + LEFT 5 "b"; + TSPEC `v` 5; + USE 5 (REWRITE_RULE[DE_MORGAN_THM]); + REWR 5; + USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + LEFT 5 "x"; + FULL_REWRITE_TAC[INR in_pair]; + TYPE_THEN `x` EXISTS_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `~(X HAS_SIZE 0) /\ ~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2) ==> ~(CARD X = 0) /\ ~(CARD X = 1) /\ ~(CARD X = 2)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[HAS_SIZE]; + ASM_MESON_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + KILL 7; + REWRITE_TAC[HAS_SIZE_0;has_size1;SING;EMPTY_EXISTS ]; + CONJ_TAC; + TYPE_THEN `a` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `X` UNABBREV_TAC; + FULL_REWRITE_TAC[INR IN_SING]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`X`;`a`;`b`;`c`] two_exclusion; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let card_has_subset = prove_by_refinement( + `!(A:A->bool) n. FINITE A /\ (n <= CARD A) ==> + (?B. B SUBSET A /\ (B HAS_SIZE n))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `A HAS_SIZE CARD A` SUBAGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[has_size_bij]; + TYPE_THEN `IMAGE f {m | m <| n}` EXISTS_TAC; + CONJ_TAC; + FULL_REWRITE_TAC[IMAGE;SUBSET;BIJ;SURJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 3 THEN UND 0 THEN ARITH_TAC; + TYPE_THEN `f` EXISTS_TAC; + IMATCH_MP_TAC inj_bij; + FULL_REWRITE_TAC[INJ;BIJ;]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 3 THEN UND 4 THEN UND 0 THEN ARITH_TAC; + ]);; + (* }}} *) + +let cls_edge_size2 = prove_by_refinement( + `!e. (edge e) ==> (cls {e} HAS_SIZE 2)`, + (* {{{ proof *) + [ + REWRITE_TAC[cls_edge]; + IMATCH_MP_TAC two_endpoint; + ]);; + (* }}} *) + +let conn2_cls3 = prove_by_refinement( + `!E. (E SUBSET edge) /\ conn2 E ==> (3 <= CARD (cls E))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`] finite_cls; + FULL_REWRITE_TAC[conn2]; + ASM_SIMP_TAC[card_gt_3]; + FULL_REWRITE_TAC[conn2]; + THM_INTRO_TAC[`E`;`2`] card_has_subset; + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `B` UNABBREV_TAC; + USE 6(REWRITE_RULE[SUBSET;INR in_pair]); + TYPE_THEN `E b` SUBAGOAL_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `E a` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + USE 2(REWRITE_RULE[SUBSET]); + TYPE_THEN `edge a /\ edge b` SUBAGOAL_TAC; + (* - *) + TYPE_THEN `cls {a} HAS_SIZE 2 /\ cls {b} HAS_SIZE 2` SUBAGOAL_TAC; + ASM_MESON_TAC[cls_edge_size2]; + FULL_REWRITE_TAC[has_size2]; + USE 12 SYM; + USE 14 SYM; + TYPE_THEN `cls {a} SUBSET cls E` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;INR IN_SING]; + TYPE_THEN `cls {b} SUBSET cls E` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;INR IN_SING]; + (* - *) + TYPE_THEN `cls E a' /\ cls E b' /\ cls E a'' /\ cls E b''` SUBAGOAL_TAC; + USE 12 GSYM; + USE 14 SYM; + REWR 15; + REWR 16; + FULL_REWRITE_TAC[SUBSET;INR in_pair]; + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN `a'` EXISTS_TAC; + TYPE_THEN `b'` EXISTS_TAC; + (* - *) + TYPE_THEN `~(cls {a} = cls {b})` SUBAGOAL_TAC; + THM_INTRO_TAC[`a`;`b`] cls_inj; + ASM_MESON_TAC[]; + USE 14 SYM; + TYPE_THEN `cls {b} a''` ASM_CASES_TAC; + REWR 22; + FULL_REWRITE_TAC[INR in_pair ]; + TYPE_THEN `b''` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `b''` UNABBREV_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `a''` UNABBREV_TAC; + TYPE_THEN `cls {b}` UNABBREV_TAC; + TYPE_THEN `cls {a}` UNABBREV_TAC; + UND 21 THEN REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INSERT]; + MESON_TAC[]; + TYPE_THEN `a''` UNABBREV_TAC; + (* -- *) + TYPE_THEN `b''` UNABBREV_TAC; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `a''` UNABBREV_TAC; + TYPE_THEN `a''` UNABBREV_TAC; + TYPE_THEN `cls {b}` UNABBREV_TAC; + TYPE_THEN `cls {a}` UNABBREV_TAC; + (* -B *) + TYPE_THEN `a''` EXISTS_TAC; + REWR 22; + FULL_REWRITE_TAC[INR in_pair]; + UND 22 THEN MESON_TAC[]; + ]);; + (* }}} *) + +let has_size2_subset_ne = prove_by_refinement( + `!X (a:A) b. X HAS_SIZE 2 /\ {a,b} SUBSET X /\ ~(a = b) ==> + (X = {a,b})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + IMATCH_MP_TAC CARD_SUBSET_EQ; + THM_INTRO_TAC[`a`;`b`] pair_size_2; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[HAS_SIZE]; + ]);; + (* }}} *) + +let segment_end_sing = prove_by_refinement( + `!a b e. closure top2 e (pointI a) /\ closure top2 e (pointI b) /\ + ~(a = b) /\ (edge e) ==> segment_end {e} a b`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_end]; + CONJ_TAC ; + IMATCH_MP_TAC psegment_edge; + (* - *) + IMATCH_MP_TAC has_size2_subset_ne; + CONJ_TAC; + IMATCH_MP_TAC endpoint_size2; + IMATCH_MP_TAC psegment_edge; + (* - *) + REWRITE_TAC[endpoint;SUBSET]; + FULL_REWRITE_TAC[INR in_pair]; + THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1; + REWRITE_TAC[FINITE_SING]; + KILL 5; + TYPE_THEN `e` EXISTS_TAC; + REWRITE_TAC[INR IN_SING]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let conn2_no1 = prove_by_refinement( + `!E. (E SUBSET edge) /\ conn2 E ==> + (!m. ~(num_closure E (pointI m) = 1))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `FINITE E` SUBAGOAL_TAC ; + FULL_REWRITE_TAC[conn2]; + TYPE_THEN `?e. E e /\ closure top2 e (pointI m)` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`;`pointI m`] num_closure1; + REWR 4; + MESON_TAC[]; + THM_INTRO_TAC[`e`] cls_edge_size2; + ASM_MESON_TAC[ISUBSET]; + TYPE_THEN `?n. closure top2 e (pointI n) /\ ~(n = m)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[has_size2]; + USE 7 SYM; + TYPE_THEN `cls {e} m` SUBAGOAL_TAC; + REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[]; + USE 7 SYM; + REWR 8; + FULL_REWRITE_TAC[INR in_pair]; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `cls{e} a` SUBAGOAL_TAC; + REWRITE_TAC[INSERT]; + FULL_REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[]; + TYPE_THEN `b` EXISTS_TAC; + TYPE_THEN `cls{e} b` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INR in_pair;cls; INR IN_SING]; + FULL_REWRITE_TAC[cls;INR IN_SING]; + ASM_MESON_TAC[]; + TYPE_THEN `edge e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + (* -A *) + TYPE_THEN`?c. cls E c /\ ~(c = m) /\ ~(c = n)` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`] conn2_cls3; + THM_INTRO_TAC[`E`] finite_cls; + THM_INTRO_TAC[`cls E`] card_gt_3; + REWR 12; + TYPE_THEN `~(a = m) /\ ~(a = n)` ASM_CASES_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `~(b = m) /\ ~(b = n)` ASM_CASES_TAC; + TYPE_THEN `b` EXISTS_TAC; + TYPE_THEN `~(c = m) /\ ~(c = n)` ASM_CASES_TAC; + TYPE_THEN `c` EXISTS_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[conn2]; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`c`;`n`]); + REWRITE_TAC[cls]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `cls {e} n` SUBAGOAL_TAC; + REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `~S e` SUBAGOAL_TAC; + TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;INR IN_SING]; + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`S`;`m`] terminal_endpoint; + FULL_REWRITE_TAC[segment_end]; + FULL_REWRITE_TAC[psegment;segment;INR in_pair]; + THM_INTRO_TAC[`E`;`pointI m`] num_closure1; + REWR 21; + COPY 21; + TSPEC `e` 21; + TYPE_THEN `e = e'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + TSPEC `(terminal_edge S m)` 22; + REWR 22; + USE 22 SYM; + TYPE_THEN `E (terminal_edge S m)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[ISUBSET]; + REWR 22; + TYPE_THEN `e` UNABBREV_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let conn2_union = prove_by_refinement( + `!A B. (A SUBSET edge) /\ (B SUBSET edge) /\ (conn2 A) /\ (conn2 B) /\ + (?a b. ~(a = b) /\ ({a,b} SUBSET (cls A INTER cls B))) ==> + (conn2 (A UNION B))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[conn2]; + TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + SUBCONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + (* - *) + SUBCONJ_TAC; + IMATCH_MP_TAC LE_TRANS; + TYPE_THEN `CARD A` EXISTS_TAC; + FULL_REWRITE_TAC[conn2]; + IMATCH_MP_TAC CARD_SUBSET; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `cls A a' /\ cls A b'` ASM_CASES_TAC; + FULL_REWRITE_TAC[conn2]; + UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]); + TYPE_THEN`S` EXISTS_TAC; + UND 22 THEN REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `cls B a' /\ cls B b'` ASM_CASES_TAC; + FULL_REWRITE_TAC[conn2]; + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]); + TYPE_THEN`S` EXISTS_TAC; + UND 23 THEN REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `?d. cls A d /\ cls B d /\ ~(c = d)` SUBAGOAL_TAC; + TYPE_THEN `c = a` ASM_CASES_TAC; + TYPE_THEN `c` UNABBREV_TAC; + TYPE_THEN `b` EXISTS_TAC; + FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair]; + ASM_MESON_TAC[]; + TYPE_THEN `a` EXISTS_TAC; + FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair]; + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN `!m n. cls A m /\ ~cls B m /\ ~cls A n /\ cls B n /\ ~(m = n) /\ ~(m = c) /\ ~(n = c) ==> (?S. S SUBSET A UNION B /\ segment_end S m n /\ ~cls S c)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + UND 28 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`d`;`c`]); + REWRITE_TAC[]; + TYPE_THEN `m` UNABBREV_TAC; + ASM_MESON_TAC[]; + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`d`;`n`;`c`]); + ASM_MESON_TAC[]; + THM_INTRO_TAC[`S`;`S'`;`m`;`d`;`n`] segment_end_trans; + TYPE_THEN `U` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `S UNION S'` EXISTS_TAC ; + IMATCH_MP_TAC subset_union_pair; + TYPE_THEN `cls U SUBSET cls (S UNION S')` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + FULL_REWRITE_TAC[cls_union ]; + FULL_REWRITE_TAC[ISUBSET]; + TSPEC `c` 38; + USE 37 (REWRITE_RULE[UNION]); + ASM_MESON_TAC[]; + (* -B *) + FULL_REWRITE_TAC[DE_MORGAN_THM]; + FULL_REWRITE_TAC[cls_union ]; + USE 12(REWRITE_RULE[UNION]); + USE 13 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + REWR 15; + REWR 12; + REWR 16; + UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`]); + (* - *) + REWR 16; + REWR 12; + REWR 15; + UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`b'`;`a'`]); + TYPE_THEN `S` EXISTS_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + ]);; + (* }}} *) + +let cut_rectagon_cls = prove_by_refinement( + `!E m n. rectagon E /\ ~(m = n) /\ cls E m /\ cls E n ==> + (?A B. segment_end A m n /\ segment_end B m n /\ + (E = A UNION B) /\ (A INTER B = EMPTY) /\ + (cls A INTER cls B = {m,n}))`, + (* {{{ proof *) + [ + REWRITE_TAC[segment_end;cls;]; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon;segment;psegment]; + THM_INTRO_TAC[`E`;`m`;`n`] cut_rectagon; + CONJ_TAC; + IMATCH_MP_TAC num_closure_pos; + ASM_MESON_TAC[]; + IMATCH_MP_TAC num_closure_pos; + ASM_MESON_TAC[]; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR in_pair]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC (TAUT `a \/ b ==> b \/ a`); + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + IMATCH_MP_TAC num_closure_pos; + ASM_MESON_TAC[psegment;segment]; + IMATCH_MP_TAC num_closure_pos; + ASM_MESON_TAC[psegment;segment]; + (* - *) + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `FINITE B` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `endpoint A m /\ endpoint A n /\ endpoint B m /\ endpoint B n` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + CONJ_TAC; + TYPE_THEN `terminal_edge A n` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + TYPE_THEN `terminal_edge B n` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + CONJ_TAC; + TYPE_THEN `terminal_edge A m` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + TYPE_THEN `terminal_edge B m` EXISTS_TAC; + IMATCH_MP_TAC terminal_endpoint; + ]);; + (* }}} *) + +let conn2_rectagon = prove_by_refinement( + `!E. rectagon E ==> conn2 E`, + (* {{{ proof *) + [ + FULL_REWRITE_TAC[conn2]; + SUBCONJ_TAC; + FULL_REWRITE_TAC[rectagon]; + SUBCONJ_TAC; + THM_INTRO_TAC[`E`] rectagon_h_edge; + THM_INTRO_TAC[`E`] rectagon_v_edge; + TYPE_THEN `~(h_edge m = v_edge m')` SUBAGOAL_TAC; + ASM_MESON_TAC[hv_edgeV2]; + TYPE_THEN `CARD {(h_edge m),(v_edge m')} <= CARD E` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET; + REWRITE_TAC[SUBSET;INR in_pair]; + ASM_MESON_TAC[]; + TYPE_THEN `{(h_edge m),(v_edge m')} HAS_SIZE 2` SUBAGOAL_TAC; + IMATCH_MP_TAC pair_size_2; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[HAS_SIZE]; + REWR 5; + (* - *) + THM_INTRO_TAC[`E`;`a`;`b`] cut_rectagon_cls; + TYPE_THEN `~cls A c` ASM_CASES_TAC; + TYPE_THEN `A` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + REWR 13; + (* - *) + TYPE_THEN `~cls B c ` SUBAGOAL_TAC; + USE 8 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `c` 8; + FULL_REWRITE_TAC[INTER;INR in_pair]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `B` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + ]);; + (* }}} *) + +let rectangle_grid = jordan_def + `rectangle_grid p q = { e | + (?m. (e = h_edge m) /\ FST p <= FST m /\ (FST m +: &:1 <=: FST q) /\ + SND p <= SND m /\ SND m <=: SND q) \/ + (?m. (e = v_edge m) /\ FST p <= FST m /\ FST m <= FST q /\ + SND p <= SND m /\ SND m +: &:1 <=: SND q) }`;; + +let rectangle_grid_h = prove_by_refinement( + `!p q m. rectangle_grid p q (h_edge m) <=> + (FST p <=: FST m) /\ (FST m +: &:1 <=: FST q) /\ + (SND p <=: SND m) /\ (SND m <=: SND q)`, + (* {{{ proof *) + [ + REWRITE_TAC[rectangle_grid]; + REWRITE_TAC[cell_clauses;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let rectangle_grid_v = prove_by_refinement( + `!p q m. rectangle_grid p q (v_edge m) <=> + (FST p <= FST m /\ FST m <= FST q /\ + SND p <= SND m /\ SND m +: &:1 <=: SND q)`, + (* {{{ proof *) + [ + REWRITE_TAC[rectangle_grid]; + REWRITE_TAC[cell_clauses;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let rectangle_grid_edge = prove_by_refinement( + `!p q. rectangle_grid p q SUBSET edge`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;rectangle_grid;edge]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let rectangle_grid_sq = prove_by_refinement( + `!p. (rectangle_grid p (FST p +: &:1, SND p +: &:1)) = + {(h_edge p), (h_edge (up p)), (v_edge p), (v_edge (right p))}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `E = rectangle_grid p (FST p +: &:1, SND p +: &:1)` ABBREV_TAC ; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INSERT]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `edge x` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; + (* - *) + FULL_REWRITE_TAC[edge]; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_v;PAIR_SPLIT]; + REWRITE_TAC[cell_clauses]; + REWRITE_TAC[PAIR_SPLIT;right ]; + UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_h;PAIR_SPLIT]; + REWRITE_TAC[cell_clauses]; + REWRITE_TAC[PAIR_SPLIT;up ]; + UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; + (* - *) + TYPE_THEN `E` UNABBREV_TAC; + UND 1 THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[rectangle_grid_v;rectangle_grid_h;up;right ;] THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let rectangle_grid_sq_cls = prove_by_refinement( + `!p. cls (rectangle_grid p (FST p +: &:1, SND p +: &:1)) = + {(p),(right p),(up p), (up (right p))}`, + (* {{{ proof *) + + [ + REWRITE_TAC[cls]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[rectangle_grid_sq]; + REWRITE_TAC[INSERT]; + IMATCH_MP_TAC EQ_ANTISYM; + (* - *) + CONJ_TAC; + FULL_REWRITE_TAC[right ;up;]; + UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `e` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;] THEN ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[right ;up;]; + TYPE_THEN `closure top2 (h_edge p) (pointI x) \/ closure top2 (h_edge (FST p,SND p +: &:1)) (pointI x)` SUBAGOAL_TAC; + UND 0 THEN REP_CASES_TAC THEN (TYPE_THEN`x` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;]; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let segment_end_union_rectagon = prove_by_refinement( + `!A B m p. segment_end A m p /\ segment_end B m p /\ + (A INTER B = EMPTY) /\ (cls A INTER cls B = {m,p}) ==> + (rectagon (A UNION B))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A`;`m`;`p`] segment_end_disj; + IMATCH_MP_TAC segment_union2; + TYPE_THEN `m` EXISTS_TAC; + TYPE_THEN `p` EXISTS_TAC; + FULL_REWRITE_TAC[segment_end;INR in_pair]; + REWRITE_TAC[INR in_pair]; + FULL_REWRITE_TAC[psegment]; + REP_BASIC_TAC; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `n` 0; + USE 0 (REWRITE_RULE[INR in_pair;INTER;cls]); + IMATCH_MP_TAC (TAUT `a \/ b ==> b \/ a`); + USE 0 SYM; + CONJ_TAC; + USE 10 (MATCH_MP num_closure_elt); + ASM_MESON_TAC[]; + USE 9 (MATCH_MP num_closure_elt); + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + TYPE_THEN `FINITE B` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + TYPE_THEN `endpoint B m /\ endpoint B p /\ endpoint A m /\ endpoint A p` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + CONJ_TAC; + IMATCH_MP_TAC num_closure_pos; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`A`;`m`] terminal_endpoint; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`A`;`p`] terminal_endpoint; + ASM_MESON_TAC[]; + IMATCH_MP_TAC num_closure_pos; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`B`;`m`] terminal_endpoint; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`B`;`p`] terminal_endpoint; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let cls_h = prove_by_refinement( + `!m. (cls {(h_edge m)} = {m, (right m)})`, + (* {{{ proof *) + [ + REWRITE_TAC[cls]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair;INR IN_SING;]; + CONV_TAC (dropq_conv "e"); + REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let cls_v = prove_by_refinement( + `!m. (cls {(v_edge m)} = {m, (up m)})`, + (* {{{ proof *) + [ + REWRITE_TAC[cls]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair;INR IN_SING;]; + CONV_TAC (dropq_conv "e"); + REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let rectagon_rectangle_grid_sq = prove_by_refinement( + `!p. rectagon ((rectangle_grid p (FST p +: &:1, SND p +: &:1)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `E = rectagon (rectangle_grid p (FST p +: &:1,SND p +: &:1))` ABBREV_TAC ; + TYPE_THEN `segment_end {(h_edge p)} p (right p) /\ segment_end {(v_edge p)} p (up p) /\ segment_end { (h_edge (up p)) } (up p) (right (up p)) /\ segment_end {(v_edge (right p))} (right p) (right (up p))` SUBAGOAL_TAC; + (REPEAT CONJ_TAC) THEN IMATCH_MP_TAC segment_end_sing THEN REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right ;up; vc_edge;hc_edge; UNION ;plus_e12; INR IN_SING; PAIR_SPLIT ] THEN INT_ARITH_TAC ; + (* - *) + THM_INTRO_TAC[`{(h_edge p)}`;`{(v_edge (right p))}`;`p`;`right p`;`right (up p)`] segment_end_union; + THM_INTRO_TAC[`p`] cls_h; + THM_INTRO_TAC[`right p`] cls_v; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING;]; + REWRITE_TAC[INR in_pair;right ;up; PAIR_SPLIT ]; + INT_ARITH_TAC; + (* - *) + THM_INTRO_TAC[`{(v_edge p)}`;`{(h_edge (up p))}`;`p`;`up p`;`right (up p)`] segment_end_union; + THM_INTRO_TAC[`p`] cls_v; + THM_INTRO_TAC[`up p`] cls_h; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR IN_SING;]; + REWRITE_TAC[INR in_pair;right ;up; PAIR_SPLIT ]; + INT_ARITH_TAC; + (* - *) + THM_INTRO_TAC[`{(v_edge p)} UNION {(h_edge (up p))}`;`{(h_edge p)} UNION {(v_edge (right p))}`;`p`;`right (up p)`] segment_end_union_rectagon; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 7(REWRITE_RULE[INTER;UNION;INR IN_SING]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses;up;PAIR_SPLIT ]; + UND 8 THEN INT_ARITH_TAC; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses;up; right ;PAIR_SPLIT ]; + UND 8 THEN INT_ARITH_TAC; + REWRITE_TAC[cls_h;cls_v;cls_union]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[up; right ; INTER; UNION;]; + REWRITE_TAC[INR in_pair]; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `FST x = FST p` ASM_CASES_TAC; + REWRITE_TAC[INT_ARITH `~(FST p = FST p +: &:1)`]; + INT_ARITH_TAC; + INT_ARITH_TAC; + (* - *) + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `{(h_edge p), (h_edge (up p)), (v_edge p),( v_edge (right p))} = (({(v_edge p)} UNION {(h_edge (up p))}) UNION {(h_edge p)} UNION {(v_edge (right p))})` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + REWRITE_TAC[INR IN_SING]; + REWRITE_TAC[INSERT]; + MESON_TAC[]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let conn2_union_edge = prove_by_refinement( + `!A B. A SUBSET edge /\ B SUBSET edge /\ conn2 A /\ conn2 B /\ + (~(A INTER B = EMPTY)) ==> conn2 (A UNION B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC conn2_union; + USE 0 (REWRITE_RULE [EMPTY_EXISTS;INTER;]); + TYPE_THEN `edge u` SUBAGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + USE 6 (MATCH_MP cls_edge_size2); + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + USE 7 SYM; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC; + IMATCH_MP_TAC cls_subset; + ASM_REWRITE_TAC[SUBSET;INR IN_SING]; + IMATCH_MP_TAC cls_subset; + ASM_REWRITE_TAC[SUBSET;INR IN_SING]; + ]);; + (* }}} *) + +let rectangle_grid_h_conn2 = prove_by_refinement( + `!n p. conn2 (rectangle_grid p (FST p +: &:(SUC n), SND p +: &:1))`, + (* {{{ proof *) + [ + INDUCT_TAC; + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ; + IMATCH_MP_TAC conn2_rectagon; + REWRITE_TAC[rectagon_rectangle_grid_sq]; + (* - *) + TYPE_THEN `rectangle_grid p (FST p +: &:(SUC (SUC n)),SND p +: &:1) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:1) UNION rectangle_grid (FST p +: &:(SUC n),SND p) (FST p +: &:(SUC (SUC n)),SND p +: &:1)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `edge x` SUBAGOAL_TAC; + ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; + FULL_REWRITE_TAC [edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_v]; + UND 4 THEN UND 5 THEN INT_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_h]; + UND 4 THEN UND 5 THEN INT_ARITH_TAC; + (* -- *) + TYPE_THEN `edge x` SUBAGOAL_TAC; + ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; + FULL_REWRITE_TAC [edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_v]; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; + UND 5 THEN INT_ARITH_TAC; + TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC; + int_le_tac; + clean_int_le_tac; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_h]; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; + UND 5 THEN INT_ARITH_TAC; + TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC; + int_le_tac; + clean_int_le_tac; + (* -A *) + IMATCH_MP_TAC conn2_union_edge; + REWRITE_TAC[rectangle_grid_edge]; + CONJ_TAC; + IMATCH_MP_TAC conn2_rectagon; + THM_INTRO_TAC[`FST p +: &:(SUC n),SND p`] rectagon_rectangle_grid_sq; + TYPE_THEN `(FST p +: &:(SUC (SUC n)),SND p +: &:1) = (FST (FST p +: &:(SUC n),SND p) +: &:1, SND (FST p +: &:(SUC n),SND p) +: &:1)` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT;GSYM INT_OF_NUM_SUC]; + INT_ARITH_TAC; + REWR 2; + UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;]; + TYPE_THEN `v_edge (FST p +: &:(SUC n),SND p)` EXISTS_TAC; + REWRITE_TAC[rectangle_grid_v]; + REPEAT CONJ_TAC THEN (TRY INT_ARITH_TAC); + TYPE_THEN `FST p + (&:0)*(&:(SUC n)) <=: FST p + &: (SUC n)` SUBAGOAL_TAC; + int_le_tac; + clean_int_le_tac; + REWRITE_TAC[GSYM INT_OF_NUM_SUC]; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let rectangle_grid_conn2 = prove_by_refinement( + `!m n p. conn2 + (rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)))`, + (* {{{ proof *) + [ + INDUCT_TAC; + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ; + REWRITE_TAC[rectangle_grid_h_conn2]; + (* - *) + TYPE_THEN `rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)) UNION rectangle_grid (FST p ,SND p + &:(SUC m)) (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m)))` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `edge x` SUBAGOAL_TAC; + ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; + FULL_REWRITE_TAC [edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_v]; + UND 1 THEN UND 3 THEN INT_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_h]; + UND 1 THEN UND 3 THEN INT_ARITH_TAC; + (* -- *) + TYPE_THEN `edge x` SUBAGOAL_TAC; + ASM_MESON_TAC[rectangle_grid_edge;ISUBSET]; + FULL_REWRITE_TAC [edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_v]; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; + UND 3 THEN INT_ARITH_TAC; + TYPE_THEN `(SND p +: (&:0)*((SND m' - (SND p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC; + int_le_tac; + clean_int_le_tac; + (* -- *) + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[rectangle_grid_h]; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC]; + UND 3 THEN INT_ARITH_TAC; + TYPE_THEN `(SND p +: (&:0)*((SND m' - (SND p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC; + int_le_tac; + clean_int_le_tac; + (* -A *) + IMATCH_MP_TAC conn2_union_edge; + REWRITE_TAC[rectangle_grid_edge]; + CONJ_TAC; + THM_INTRO_TAC[`n`;`(FST p,SND p +: &:(SUC m))` ] rectangle_grid_h_conn2; + TYPE_THEN `(FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = (FST (FST p,SND p +: &:(SUC m)) +: &:(SUC n), SND (FST p,SND p +: &:(SUC m)) +: &:1)` SUBAGOAL_TAC; + REWRITE_TAC[GSYM INT_OF_NUM_SUC;PAIR_SPLIT ]; + INT_ARITH_TAC; + REWR 2; + (* - // *) + UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;]; + TYPE_THEN `h_edge (FST p ,SND p + &:(SUC m))` EXISTS_TAC; + REWRITE_TAC[rectangle_grid_h]; + REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC INT_LE_LADD_IMP)) THEN (REWRITE_TAC[INT_OF_NUM_LE;INT_LE_ADDR ]) THEN (TRY INT_ARITH_TAC) THEN (TRY ARITH_TAC); + ]);; + (* }}} *) + +let conn2_has_rectagon = prove_by_refinement( + `!E. (E SUBSET edge) /\ (conn2 E) ==> (?B. (B SUBSET E) /\ rectagon B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?e. E e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + THM_INTRO_TAC[`E`;`1`] card_has_subset; + UND 2 THEN ARITH_TAC; + FULL_REWRITE_TAC[has_size1;SING ]; + TYPE_THEN `B` UNABBREV_TAC; + FULL_REWRITE_TAC[SUBSET;INR IN_SING]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `edge e` SUBAGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + USE 3 (MATCH_MP cls_edge_size2); + FULL_REWRITE_TAC[has_size2]; + (* - *) + TYPE_THEN `2 <=| num_closure E (pointI a)` SUBAGOAL_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(x = 0) /\ ~(x = 1) ==> 2 <= x`); + CONJ_TAC; + THM_INTRO_TAC[`E`;`pointI a`] num_closure0; + FULL_REWRITE_TAC[conn2]; + REWR 6; + TYPE_THEN `cls {e} a` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + FULL_REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[conn2_no1]; + FULL_REWRITE_TAC[num_closure]; + THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI a)}`;`2`] card_has_subset; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + FULL_REWRITE_TAC[conn2]; + REWRITE_TAC[SUBSET]; + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `B` UNABBREV_TAC; + USE 7(REWRITE_RULE[SUBSET;INR in_pair ]); + (* - *) + TYPE_THEN `?e' . (E e' /\ closure top2 e' (pointI a) /\ ~(e = e'))` SUBAGOAL_TAC; + TYPE_THEN `e = a'` ASM_CASES_TAC; + TYPE_THEN `b'` EXISTS_TAC; + TYPE_THEN `a'` UNABBREV_TAC; + TSPEC `b'` 7; + ASM_MESON_TAC[]; + TYPE_THEN `a'` EXISTS_TAC; + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN`?c. (cls {e'} = {a,c}) /\ ~(c = a) ` SUBAGOAL_TAC; + TYPE_THEN `edge e'` SUBAGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + USE 11 (MATCH_MP cls_edge_size2); + FULL_REWRITE_TAC[has_size2]; + USE 12 SYM; + TYPE_THEN `cls{e'} a` SUBAGOAL_TAC; + REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[]; + TYPE_THEN `cls {e'}` UNABBREV_TAC; + FULL_REWRITE_TAC[INR in_pair]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b''` UNABBREV_TAC; + TYPE_THEN `a''` EXISTS_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair]; + MESON_TAC[]; + TYPE_THEN `a''` UNABBREV_TAC; + TYPE_THEN `b''` EXISTS_TAC; + ASM_MESON_TAC[]; + (* -B *) + TYPE_THEN `~(c = b)` SUBAGOAL_TAC; + TYPE_THEN`c` UNABBREV_TAC; + TYPE_THEN `cls{e} = cls{e'}` SUBAGOAL_TAC; + ASM_MESON_TAC[cls_inj;ISUBSET]; + (* - *) + TYPE_THEN `?S. S SUBSET E /\ segment_end S b c /\ ~cls S a` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `cls {e} b /\ cls {e'} c` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + USE 12 SYM; + USE 4 SYM; + TYPE_THEN `cls {e} SUBSET cls E /\ cls {e'} SUBSET cls E` SUBAGOAL_TAC; + CONJ_TAC THEN IMATCH_MP_TAC cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING]; + ASM_MESON_TAC[ISUBSET]; + (* -C *) + THM_INTRO_TAC[`b`;`a`;`e`] segment_end_sing; + TYPE_THEN `cls {e} a /\ cls {e} b` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + FULL_REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[ISUBSET]; + THM_INTRO_TAC[`a`;`c`;`e'`] segment_end_sing; + TYPE_THEN `cls {e'} a /\ cls {e'} c` SUBAGOAL_TAC; + REWRITE_TAC[INR in_pair]; + FULL_REWRITE_TAC[cls;INR IN_SING ]; + ASM_MESON_TAC[ISUBSET]; + (* - *) + THM_INTRO_TAC[`{e}`;`{e'}`;`b`;`a`;`c`] segment_end_union; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR in_pair;INR IN_SING]; + ASM_MESON_TAC[]; + (* -D *) + THM_INTRO_TAC[`S`;`{e} UNION {e'}`;`b`;`c`] segment_end_union_rectagon; + REWRITE_TAC[cls_union; UNION_OVER_INTER; EMPTY_UNION; ]; + CONJ_TAC; + REWRITE_TAC[EQ_EMPTY;INTER ;INR IN_SING ]; + CONJ_TAC ; + TYPE_THEN `x` UNABBREV_TAC; + USE 4 SYM; + TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + ASM_MESON_TAC[ISUBSET;INR IN_SING]; + USE 20 (REWRITE_RULE[SUBSET]); + TSPEC `a` 20; + TYPE_THEN `cls {e}` UNABBREV_TAC; + FULL_REWRITE_TAC[INR in_pair]; + ASM_MESON_TAC[]; + USE 12 SYM; + TYPE_THEN `cls {e'} SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + ASM_MESON_TAC[ISUBSET;INR IN_SING]; + USE 22 (REWRITE_RULE[SUBSET]); + TSPEC `a` 22; + TYPE_THEN `cls {e'}` UNABBREV_TAC; + FULL_REWRITE_TAC[INR in_pair]; + ASM_MESON_TAC[]; + (* --E *) + REWRITE_TAC[GSYM UNION_OVER_INTER]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair]; + TYPE_THEN `((x = c) \/ (x = b)) \/ (x = a)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + (* -- *) + REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair]; + TYPE_THEN `cls S b /\ cls S c` SUBAGOAL_TAC; + ASM_MESON_TAC[segment_end_cls2;segment_end_cls]; + ASM_MESON_TAC[]; + TYPE_THEN `(S UNION {e} UNION {e'})` EXISTS_TAC; + REWRITE_TAC[union_subset]; + REWRITE_TAC[SUBSET;INR IN_SING]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION T *) +(* ------------------------------------------------------------------ *) + + +(* 1.0.6 rectagon components *) + +(* redo some results from E that USE the segment hypothesis *) + +let curve_cell_h_ver2 = prove_by_refinement( + `!G n. (curve_cell G (h_edge n) = G (h_edge n))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI]; + ]);; + + (* }}} *) + +let curve_cell_v_ver2 = prove_by_refinement( + `!G n. (curve_cell G (v_edge n) = G (v_edge n))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI]; + ]);; + (* }}} *) + +let curve_closure_ver2 = prove_by_refinement( + `!G. (FINITE G) /\ (G SUBSET edge) ==> + (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC top2_top; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + ASM_SIMP_TAC[closure_unions]; + REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ]; + TYPE_THEN `edge x'` SUBGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + FULL_REWRITE_TAC [edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `t` UNABBREV_TAC; + FULL_REWRITE_TAC [v_edge_closure;vc_edge;UNION ;INR IN_SING ]; + UND 3 THEN REP_CASES_TAC; + TYPE_THEN `v_edge m` EXISTS_TAC; + ASM_SIMP_TAC [curve_cell_v_ver2]; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + (* ---- *) + ASM_SIMP_TAC [curve_cell_point]; + REWRITE_TAC[INR IN_SING]; + UNIFY_EXISTS_TAC; + REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ]; + TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC; + ASM_SIMP_TAC [curve_cell_point]; + REWRITE_TAC[INR IN_SING;plus_e12]; + TYPE_THEN `v_edge m` EXISTS_TAC; + REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ]; + (* dt2 , down to 2 goals *) + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `t` UNABBREV_TAC; + FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING]; + UND 3 THEN REP_CASES_TAC; + TYPE_THEN `h_edge m` EXISTS_TAC; + ASM_SIMP_TAC[curve_cell_h_ver2]; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ]; + TYPE_THEN `h_edge m` EXISTS_TAC; + FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING]; + TYPE_THEN `{x}` EXISTS_TAC; + ASM_REWRITE_TAC[INR IN_SING]; + ASM_SIMP_TAC[curve_cell_point ;INR IN_SING;plus_e12 ]; + TYPE_THEN `h_edge m` EXISTS_TAC; + FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING;plus_e12]; + (* dt1 *) + REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset]; + ASM_SIMP_TAC[closure_unions]; + CONJ_TAC; + REWRITE_TAC[SUBSET;IMAGE;UNIONS]; + DISCH_ALL_TAC; + CONV_TAC (dropq_conv "u"); + NAME_CONFLICT_TAC; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[subset_closure;ISUBSET ]; + (* // *) + TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ; + REWRITE_TAC[UNIONS;SUBSET ]; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC [INR IN_SING]; + ASM_MESON_TAC []; + ]);; + (* }}} *) + +let curve_cell_h_inter_ver2 = prove_by_refinement( + `!G m. (FINITE G) /\ (G SUBSET edge) ==> + (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> + (~(G (h_edge m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ONCE_REWRITE_TAC [GSYM curve_cell_h_ver2]; + IMATCH_MP_TAC cell_inter; + ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; + ASM_MESON_TAC[segment;curve_cell_cell]; + ]);; + (* }}} *) + +let curve_cell_v_inter_ver2 = prove_by_refinement( + `!G m. (FINITE G) /\ (G SUBSET edge) ==> + (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=> + (~(G (v_edge m))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ONCE_REWRITE_TAC [GSYM curve_cell_v_ver2]; + IMATCH_MP_TAC cell_inter; + ASM_REWRITE_TAC [cell_rules;curve_cell_cell]; + ASM_MESON_TAC[segment;curve_cell_cell]; + ]);; + (* }}} *) + +let curve_cell_squ_ver2 = prove_by_refinement( + `!G m. (FINITE G) /\ (G SUBSET edge) ==> ~curve_cell G (squ m)`, + (* {{{ proof *) + [ + REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment]; + FULL_REWRITE_TAC [SUBSET; edge]; + TSPEC `squ m` 1; + USE 0(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;cell_clauses]); + ]);; + (* }}} *) + +let curve_cell_squ_inter_ver2 = prove_by_refinement( + `!G m. (FINITE G) /\ (G SUBSET edge) ==> + (((squ m) INTER (UNIONS (curve_cell G)) = {}))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `cell (squ m)` SUBGOAL_TAC; + REWRITE_TAC[cell_rules]; + TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC; + ASM_MESON_TAC[curve_cell_cell;segment]; + ASM_SIMP_TAC [cell_inter]; + ASM_MESON_TAC [curve_cell_squ_ver2]; + ]);; + (* }}} *) + +let curve_point_unions_ver2 = prove_by_refinement( + `!G m. (FINITE G) /\ (G SUBSET edge) ==> + (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC; + REWRITE_TAC[REWRITE_RULE[not_eq] single_inter]; + REWRITE_TAC [not_eq]; + IMATCH_MP_TAC cell_inter; + ASM_MESON_TAC[cell_rules;curve_cell_cell]; + ]);; + (* }}} *) + +let curve_cell_not_point_ver2 = prove_by_refinement( + `!G m. (FINITE G) /\ (G SUBSET edge) ==> ((curve_cell G {(pointI m)} <=> + ~(num_closure G (pointI m) = 0)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[curve_cell_point;num_closure0]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let curve_closed_ver2 = prove_by_refinement( + `!G. (FINITE G) /\ (G SUBSET edge) ==> + (closed_ top2 (UNIONS (curve_cell G)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[GSYM curve_closure_ver2]; + IMATCH_MP_TAC closure_closed; + REWRITE_TAC[top2_top]; + IMATCH_MP_TAC UNIONS_SUBSET; + FULL_REWRITE_TAC [SUBSET;top2_unions;edge; ]; + ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid]; + ]);; + (* }}} *) + +let ctop_top2_ver2 = prove_by_refinement( + `!G A. (FINITE G) /\ (G SUBSET edge) /\ ctop G A ==> top2 A`, + (* {{{ proof *) + [ + REWRITE_TAC[ctop;induced_top;IMAGE ;]; + TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ; + TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC; + TYPE_THEN `U` UNABBREV_TAC; + ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[top2_top;]; + ASM_SIMP_TAC[GSYM curve_closure_ver2;top2]; + IMATCH_MP_TAC (REWRITE_RULE[open_DEF] closed_open); + IMATCH_MP_TAC closure_closed; + CONJ_TAC; + TYPE_THEN `U` UNABBREV_TAC; + ASM_MESON_TAC[top_of_metric_top;metric_euclid]; + USE 5(GSYM); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC UNIONS_SUBSET; + FULL_REWRITE_TAC [edge;ISUBSET;]; + TSPEC `A'` 2; + REWRITE_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[ (REWRITE_RULE[ISUBSET;] v_edge_euclid)]; + ASM_MESON_TAC [(REWRITE_RULE[ISUBSET;] h_edge_euclid)]; + ]);; + (* }}} *) + +let convex_connected_ver2 = prove_by_refinement( + `!G Z. (FINITE G) /\ (G SUBSET edge) /\ convex Z /\ + (Z SUBSET (UNIONS (ctop G))) ==> + (connected (ctop G) Z)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[connected]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + USE 8 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]); + LEFT 8 "x"; + LEFT 9 "x"; + TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC; + FULL_REWRITE_TAC [convex]; + ASM_MESON_TAC[ISUBSET]; + TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC; + IMATCH_MP_TAC connected_mk_segment; + USE 3(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]); + (* - *) + FULL_REWRITE_TAC [connected]; + TYPEL_THEN [`A`;`B`] (USE 13 o ISPECL); + REWR 13; + TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC; + REWRITE_TAC[GSYM top2]; + ASM_MESON_TAC[ctop_top2_ver2;top2]; + UND 13 THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + (* -- *) + UND 9 THEN REWRITE_TAC[]; + UND 8 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + ASM_MESON_TAC[mk_segment_end;ISUBSET]; + ASM_MESON_TAC [mk_segment_end;ISUBSET ]; + ]);; + (* }}} *) + +let convex_component_ver2 = prove_by_refinement( + `!G Z x. (FINITE G) /\ (G SUBSET edge) /\ convex Z /\ + (Z SUBSET (UNIONS (ctop G))) /\ + (~(Z INTER (component (ctop G) x ) = EMPTY)) ==> + (Z SUBSET (component (ctop G) x)) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC; + ASM_SIMP_TAC[convex_connected_ver2]; + USE 4(REWRITE_RULE[EMPTY_EXISTS;INTER ]); + USE 4(MATCH_MP component_replace); + IMATCH_MP_TAC connected_component; + ]);; + (* }}} *) + +let unions_cell_of_ver2 = prove_by_refinement( + `!G x. ((FINITE G) /\ (G SUBSET edge) ==> + (UNIONS (cell_of (component (ctop G) x)) = + component (ctop G) x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + REWRITE_TAC [UNIONS;SUBSET;cell_of]; + CONJ_TAC; + TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC; + UND 2 THEN REWRITE_TAC[component_DEF ;connected;SUBSET ;ctop_unions;DIFF ]; + USE 3 (MATCH_MP point_onto); + TYPE_THEN `x'` UNABBREV_TAC; + ASSUME_TAC cell_unions; + TSPEC `p` 3; + USE 3 (REWRITE_RULE[UNIONS]); + TYPE_THEN `u` EXISTS_TAC; + (* - *) + DISCH_ALL_TAC; + TYPE_THEN `u SUBSET (component (ctop G) x)` SUBAGOAL_TAC; + IMATCH_MP_TAC convex_component_ver2 ; + ASM_REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + ASM_MESON_TAC[cell_convex]; + CONJ_TAC; + REWRITE_TAC[ctop_unions]; + REWRITE_TAC[DIFF;SUBSET ]; + CONJ_TAC; + ASM_MESON_TAC[cell_euclid;ISUBSET]; + FULL_REWRITE_TAC[UNIONS]; + USE 1 (MATCH_MP curve_cell_cell); + USE 1 (REWRITE_RULE[ISUBSET]); + TSPEC `u'` 1; + TYPE_THEN `u = u'` SUBGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + ASM_MESON_TAC[]; + (* --- *) + USE 2 (REWRITE_RULE[component_DEF;connected;SUBSET ]); + TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC; + USE 12(REWRITE_RULE[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]); + ASM_MESON_TAC[]; + TYPE_THEN `point p` EXISTS_TAC; + ASM_REWRITE_TAC [INTER]; + (* - *) + FULL_REWRITE_TAC [ISUBSET]; + ]);; + (* }}} *) + +let unbounded = jordan_def `unbounded C <=> + (?r. !s. (r <=. s) ==> C (point(s,&.0)))`;; + +let curve_cell_empty = prove_by_refinement( + `curve_cell EMPTY = EMPTY `, + (* {{{ proof *) + [ + REWRITE_TAC[curve_cell]; + REWRITE_TAC[EQ_EMPTY]; + THM_INTRO_TAC[`top2`] closure_empty; + REWRITE_TAC[top2_top]; + REWR 0; + ]);; + (* }}} *) + +let curve_cell_union = prove_by_refinement( + `!A B. curve_cell (A UNION B) = curve_cell A UNION curve_cell B`, + (* {{{ proof *) + [ + REWRITE_TAC[curve_cell]; + FULL_REWRITE_TAC[UNIONS_UNION;]; + ASM_SIMP_TAC[top2_top;closure_union]; + TYPE_THEN `{z | ?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS A) UNION closure top2 (UNIONS B)) (pointI n)} = ( {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}) UNION ({z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)})` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + MESON_TAC[]; + TYPE_THEN `C = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}` ABBREV_TAC ; + TYPE_THEN `D = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)}` ABBREV_TAC ; + REWRITE_TAC[UNION_ACI]; + ]);; + (* }}} *) + +let insert_sing = prove_by_refinement( + `!A (x:A). x INSERT A = {x} UNION A`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INSERT;UNION;INR IN_SING]; + MESON_TAC[]; + ]);; + (* }}} *) + +let curve_cell_sing = prove_by_refinement( + `!e. (edge e) ==> (UNIONS (curve_cell {e}) = closure top2 e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[curve_cell;UNIONS_UNION]; + FULL_REWRITE_TAC[edge]; + FIRST_ASSUM DISJ_CASES_TAC; + REWRITE_TAC[v_edge_closure;vc_edge;plus_e12]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;UNIONS]; + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj]; + RIGHT_TAC "n"; + TYPE_THEN `v_edge m x` ASM_CASES_TAC; + MESON_TAC[]; + (* - *) + REWRITE_TAC[h_edge_closure;hc_edge;plus_e12]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;UNIONS]; + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj]; + RIGHT_TAC "n"; + TYPE_THEN `h_edge m x` ASM_CASES_TAC; + MESON_TAC[]; + ]);; + (* }}} *) + +let unbounded_elt = prove_by_refinement( + `!G. (FINITE G) /\ (G SUBSET edge) ==> + (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r))`, + (* {{{ proof *) + [ + TYPE_THEN `!G. (FINITE G) ==> ((G SUBSET edge) ==> (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r)))` SUBAGOAL_TAC THENL[IMATCH_MP_TAC FINITE_INDUCT_STRONG ;ASM_MESON_TAC[]]; + (* - *) + CONJ_TAC; + REWRITE_TAC[curve_cell_empty]; + (* - *) + ASSUME_TAC top2_top; + ONCE_REWRITE_TAC[insert_sing]; + REWRITE_TAC[curve_cell_union;UNIONS_UNION]; + REWRITE_TAC[UNION;]; + NAME_CONFLICT_TAC; + THM_INTRO_TAC[`x`] curve_cell_sing; + FULL_REWRITE_TAC[INSERT;SUBSET]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `G SUBSET edge` SUBAGOAL_TAC; + FULL_REWRITE_TAC[ISUBSET;INSERT]; + ASM_MESON_TAC[]; + REP_BASIC_TAC; + (* - *) + TYPE_THEN `edge x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INSERT;SUBSET;]; + ASM_MESON_TAC[]; + TYPE_THEN `?r. !x'. closure top2 x x' ==> x' 0 < r` SUBAGOAL_TAC; + USE 7(REWRITE_RULE[edge]); + FIRST_ASSUM DISJ_CASES_TAC; + REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING;plus_e12 ]; + TYPE_THEN `real_of_int (FST m) + (&1)` EXISTS_TAC; + FULL_REWRITE_TAC[pointI]; + UND 9 THEN REP_CASES_TAC THEN FULL_REWRITE_TAC[v_edge;coord01]; + FULL_REWRITE_TAC[v_edge;coord01]; + REAL_ARITH_TAC; + REWRITE_TAC[coord01]; + REAL_ARITH_TAC; + REWRITE_TAC[coord01;pointI]; + REAL_ARITH_TAC; + (* --A *) + REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING;plus_e12 ]; + TYPE_THEN `real_of_int (FST m) + (&2)` EXISTS_TAC; + UND 9 THEN REP_CASES_TAC; + FULL_REWRITE_TAC[h_edge;coord01]; + FULL_REWRITE_TAC[h_edge;coord01]; + FULL_REWRITE_TAC[int_add_th;int_of_num_th]; + UND 10 THEN REAL_ARITH_TAC; + REWRITE_TAC[pointI]; + REAL_ARITH_TAC; + REWRITE_TAC[pointI]; + FULL_REWRITE_TAC[int_add_th;int_of_num_th]; + REAL_ARITH_TAC; + (* - *) + TYPE_THEN `max_real r r'` EXISTS_TAC; + TSPEC `x'` 3; + FIRST_ASSUM DISJ_CASES_TAC; + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `r'` EXISTS_TAC; + ASM_REWRITE_TAC[max_real_le]; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `r` EXISTS_TAC; + REWRITE_TAC[max_real_le]; + ]);; + (* }}} *) + +let mk_segment_convex = prove_by_refinement( + `!x y. convex (mk_segment x y)`, + (* {{{ proof *) + [ + REWRITE_TAC[convex]; + FULL_REWRITE_TAC[mk_segment;SUBSET;]; + REP_BASIC_TAC; + REWRITE_TAC[euclid_ldistrib]; + ONCE_REWRITE_TAC[euclid_plus_pair]; + REWRITE_TAC[euclid_scale_act]; + REWRITE_TAC[GSYM euclid_rdistrib]; + TYPE_THEN `(a * a'' + (&1 - a) * a')` EXISTS_TAC; + CONJ_TAC; + ineq_le_tac `(&0) + (a * a'') + (&1 - a)* a' = (a * a'' + (&1 - a)*a')`; + CONJ_TAC; + ineq_le_tac `(a * a'' + (&1 - a) * a') + ((&1 - a)*(&1 - a')) + a*(&1 - a'') = &1`; + AP_TERM_TAC; + AP_THM_TAC; + AP_TERM_TAC; + real_poly_tac; + ]);; + (* }}} *) + +let mk_segment_h = prove_by_refinement( + `!r s b x. (r <= s) ==> (mk_segment (point(r,b)) (point(s,b)) x <=> (?t. (r <= t /\ t <= s /\ (x = point(t,b)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[mk_segment]; + REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC; + CONJ_TAC; + ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`; + ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`; + TYPE_THEN `s = r` ASM_CASES_TAC; + REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`]; + TYPE_THEN `&0` EXISTS_TAC; + UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC; + REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ; + TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC; + TYPE_THEN `v` UNABBREV_TAC; + REWRITE_TAC[GSYM real_div_assoc]; + REDUCE_TAC; + IMATCH_MP_TAC REAL_DIV_REFL; + UND 5 THEN UND 4 THEN REAL_ARITH_TAC; + TYPE_THEN `v*(s - t)` EXISTS_TAC; + TYPE_THEN `&0 < v` SUBAGOAL_TAC; + TYPE_THEN `v` UNABBREV_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + UND 4 THEN UND 0 THEN REAL_ARITH_TAC; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + UND 7 THEN UND 2 THEN REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_LCANCEL_IMP; + TYPE_THEN `(s - r)` EXISTS_TAC; + CONJ_TAC; + UND 4 THEN UND 0 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_ASSOC]; + REDUCE_TAC; + UND 3 THEN REAL_ARITH_TAC; + TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC]; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + + ]);; + (* }}} *) + +let unbounded_comp = prove_by_refinement( + `!G. (FINITE G) /\ (G SUBSET edge) ==> + (?x. unbounded (component (ctop G) x))` , + (* {{{ proof *) + [ + REWRITE_TAC[unbounded]; + THM_INTRO_TAC[`G`] unbounded_elt; + TYPE_THEN `point(r, &0)` EXISTS_TAC; + TYPE_THEN `r` EXISTS_TAC; + TYPE_THEN `Z = mk_segment (point(r, &0)) (point(s, &0))` ABBREV_TAC ; + THM_INTRO_TAC[`G`;`Z`;`(point(r, &0))`] convex_component_ver2; + CONJ_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[mk_segment_convex]; + (* -- *) + CONJ_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[ctop_unions]; + REWRITE_TAC[SUBSET;DIFF]; + THM_INTRO_TAC[`r`;`s`;`&0`;`x`] mk_segment_h; + REWR 5; + REWRITE_TAC[euclid_point]; + TSPEC `(point (t ,&0))` 2; + FULL_REWRITE_TAC[coord01]; + UND 2 THEN UND 7 THEN REAL_ARITH_TAC; + UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `(point(r,&0))` EXISTS_TAC; + REWRITE_TAC[INTER]; + (* -- *) + CONJ_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + THM_INTRO_TAC[`r`;`s`;`&0`;`point(r,&0)`] mk_segment_h; + TYPE_THEN `r` EXISTS_TAC; + UND 3 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC component_refl; + REWRITE_TAC[ctop_unions]; + REWRITE_TAC[DIFF;euclid_point]; + TSPEC `(point(r,&0))` 2; + FULL_REWRITE_TAC[coord01]; + UND 2 THEN REAL_ARITH_TAC; + (* -A *) + FULL_REWRITE_TAC[SUBSET]; + TSPEC `(point(s,&0))` 5; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[mk_segment_end]; + ]);; + (* }}} *) + +let unbounded_comp_unique = prove_by_refinement( + `!G x y. (FINITE G) /\ (G SUBSET edge) /\ + (unbounded (component (ctop G) x)) /\ + (unbounded(component (ctop G) y)) ==> + (component (ctop G) x = component (ctop G) y) `, + (* {{{ proof *) + [ + REWRITE_TAC[unbounded]; + TSPEC `max_real r r'` 0; + TSPEC `max_real r r'` 1; + FULL_REWRITE_TAC[max_real_le]; + ASM_MESON_TAC[component_replace]; + ]);; + (* }}} *) + +let unbounded_set = jordan_def + `unbounded_set G x = unbounded(component (ctop G) x)`;; + +let bounded_set = jordan_def + `bounded_set G x <=> ~(component (ctop G) x = EMPTY) /\ + ~(unbounded (component (ctop G) x))`;; + +let bounded_unbounded_disj = prove_by_refinement( + `!G. bounded_set G INTER unbounded_set G = EMPTY `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[EQ_EMPTY]; + FULL_REWRITE_TAC[INTER;bounded_set;unbounded_set]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let bounded_unbounded_union = prove_by_refinement( + `!G. bounded_set G UNION unbounded_set G = UNIONS (ctop G)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;bounded_set;unbounded_set]; + THM_INTRO_TAC[`G`] ctop_top; + TYPE_THEN `component (ctop G) x = EMPTY` ASM_CASES_TAC; + THM_INTRO_TAC[`ctop G`;`x`] component_empty; + REWR 2; + REWRITE_TAC[unbounded]; + TSPEC `r + &1` 3; + UND 3 THEN REAL_ARITH_TAC; + REWRITE_TAC[TAUT `~A \/ A`]; + ASM_MESON_TAC[component_empty]; + ]);; + (* }}} *) + +let bounded_subset_unions = prove_by_refinement( + `!G x. (bounded_set G x ==> UNIONS (ctop G) x) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[GSYM bounded_unbounded_union;UNION]; + ]);; + (* }}} *) + +let unbounded_subset_unions = prove_by_refinement( + `!G x. (unbounded_set G x ==> UNIONS (ctop G) x) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[GSYM bounded_unbounded_union;UNION]; + ]);; + (* }}} *) + +let unbounded_set_nonempty = prove_by_refinement( + `!G. (FINITE G) /\ (G SUBSET edge) ==> + ~(unbounded_set G = EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[unbounded_set]; + THM_INTRO_TAC[`G`] unbounded_comp; + ]);; + (* }}} *) + +let unbounded_set_comp = prove_by_refinement( + `!G. (FINITE G) /\ (G SUBSET edge) ==> + (?x. unbounded_set G = component (ctop G) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`] unbounded_comp; + TYPE_THEN `x` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + USE 3(REWRITE_RULE[SUBSET]); + LEFT 3 "x'"; + UND 3 THEN REWRITE_TAC[]; + THM_INTRO_TAC[`G`;`x`;`x'`] unbounded_comp_unique; + FULL_REWRITE_TAC[unbounded_set]; + IMATCH_MP_TAC component_refl; + FULL_REWRITE_TAC[unbounded_set]; + FULL_REWRITE_TAC[unbounded]; + TSPEC `r` 3; + FULL_REWRITE_TAC[ARITH_RULE `r <= r`]; + TYPE_THEN `~(component (ctop G) x' = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`ctop G`;`x'`] component_empty; + REWRITE_TAC[ctop_top]; + ASM_MESON_TAC[]; + (* - *) + REWRITE_TAC[SUBSET]; + REWRITE_TAC[unbounded_set]; + TYPE_THEN `component (ctop G) x = component (ctop G) x'` SUBAGOAL_TAC; + IMATCH_MP_TAC component_replace; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unbounded_set_comp_elt = prove_by_refinement( + `!G x. (FINITE G) /\ (G SUBSET edge) /\ + (unbounded_set G = component (ctop G) x) ==> + (unbounded_set G x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC ; + THM_INTRO_TAC[`G`]unbounded_set_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + REWR 3; + TYPE_THEN `~(component (ctop G) x = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[EQ_EMPTY ]; + ASM_MESON_TAC[]; + ASSUME_TAC ctop_top; + TYPE_THEN `(UNIONS (ctop G) x)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`ctop G`;`x`] component_empty; + ASM_MESON_TAC[]; + ASM_MESON_TAC[component_refl]; + ]);; + (* }}} *) + +let unbounded_even_subset = prove_by_refinement( + `!G. rectagon G ==> (unbounded_set G SUBSET UNIONS (par_cell T G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + THM_INTRO_TAC[`G`] unbounded_set_comp; + THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp; + FIRST_ASSUM DISJ_CASES_TAC; + PROOF_BY_CONTR_TAC; + KILL 6; + KILL 4; + THM_INTRO_TAC[`G`;`x`] unbounded_set_comp_elt; + USE 4 (REWRITE_RULE[unbounded_set;unbounded]); + THM_INTRO_TAC[`G`] unbounded_elt; + TYPE_THEN `s = floor (max_real r r') + &:1` ABBREV_TAC ; + TYPE_THEN `r < real_of_int s /\ r' < real_of_int s` SUBAGOAL_TAC; + TYPE_THEN `s` UNABBREV_TAC; + TYPE_THEN `!t u. t <= u ==> t <. real_of_int( floor u + &:1)` SUBAGOAL_TAC; + REWRITE_TAC[int_add_th ; int_of_num_th]; + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `u` EXISTS_TAC; + REWRITE_TAC[floor_ineq]; + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[max_real_le] ; + (* -A *) + TYPE_THEN `~(UNIONS (curve_cell G) (pointI (s, &:0)))` SUBAGOAL_TAC; + TSPEC `pointI (s, &:0)` 6; + USE 6 (REWRITE_RULE[pointI;coord01]); + UND 6 THEN UND 8 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`G`] rectagon_segment; + THM_INTRO_TAC[`G`;`(s,&:0)`] curve_point_unions; + UND 12 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + (* - *) + TYPE_THEN `par_cell T G {(pointI (s, &:0))}` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`;`(s, &:0)`;`T`] par_cell_point; + CONJ_TAC; + ASM_MESON_TAC[curve_cell_not_point]; + REWRITE_TAC[num_lower]; + TYPE_THEN `{m | G (h_edge m) /\ (FST m = s) /\ SND m <=: &:0} = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 6(REWRITE_RULE[UNIONS]); + LEFT 6 "u"; + LEFT 6 "u"; + TSPEC `h_edge u` 6; + THM_INTRO_TAC[`G`;`u`] curve_cell_h; + REWR 6; + USE 6(REWRITE_RULE[h_edge]); + REWR 6; + USE 6 (CONV_RULE (dropq_conv "x")); + USE 6 (REWRITE_RULE[coord01]); + USE 6 (CONV_RULE (dropq_conv "v")); + TSPEC `real_of_int s + &1/ (&2)` 6; + USE 6(REWRITE_RULE[int_add_th;int_of_num_th; REAL_LT_ADDR; REAL_LT_LADD; ]); + UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]); + IMATCH_MP_TAC half_pos; + TYPE_THEN `real_of_int s < r'` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_TRANS; + TYPE_THEN `real_of_int s + &1 / &2` EXISTS_TAC; + REWRITE_TAC[REAL_LT_ADDR; REAL_LT_HALF1]; + UND 18 THEN UND 8 THEN REAL_ARITH_TAC; + REWRITE_TAC[CARD_CLAUSES;EVEN2]; + (* -B *) + TYPE_THEN `UNIONS (par_cell F G) (pointI (s,&:0))` SUBAGOAL_TAC; + USE 5 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[pointI;int_of_num_th]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 9 THEN REAL_ARITH_TAC ; + TYPE_THEN `UNIONS (par_cell T G) (pointI (s,&:0))` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS]; + TYPE_THEN `{(pointI (s,&:0))}` EXISTS_TAC ; + REWRITE_TAC[INR IN_SING]; + (* - *) + THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; + USE 16(REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let odd_bounded_subset = prove_by_refinement( + `!G. rectagon G ==> (UNIONS (par_cell F G) SUBSET bounded_set G)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* - *) + REWRITE_TAC[SUBSET]; + THM_INTRO_TAC[`G`] unbounded_even_subset; + FULL_REWRITE_TAC[SUBSET]; + TSPEC `x` 2; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[bounded_set;unbounded_set;DE_MORGAN_THM ]; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`G`] ctop_top; + THM_INTRO_TAC[`ctop G`;`x`] component_empty; + UND 6 THEN ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`G`]rectagon_segment; + THM_INTRO_TAC[`G`;`T`] par_cell_partition; + USE 7(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 7; + FULL_REWRITE_TAC[UNION]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; + UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unique_bounded = prove_by_refinement( + `!G x y. (rectagon G) /\ bounded_set G x /\ bounded_set G y ==> + (component (ctop G) x = component (ctop G) y) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`;`x`] bounded_subset_unions; + THM_INTRO_TAC[`G`;`y`] bounded_subset_unions; + TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC; + FULL_REWRITE_TAC[rectagon]; + THM_INTRO_TAC[`G`] unbounded_set_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`G`;`u`] unbounded_subset_unions; + THM_INTRO_TAC[`G`] rectagon_h_edge; + THM_INTRO_TAC[`G`] ctop_top; + TYPE_THEN `~(component (ctop G) x = EMPTY) /\ ~(component (ctop G) u = EMPTY) /\ ~(component (ctop G) y = EMPTY)` SUBAGOAL_TAC; + ASM_MESON_TAC[component_empty]; + TYPE_THEN `segment G` SUBAGOAL_TAC; + IMATCH_MP_TAC rectagon_segment; + THM_INTRO_TAC[`G`;`x`;`h_edge m`] along_lemma11; + THM_INTRO_TAC[`G`;`y`;`h_edge m`] along_lemma11; + THM_INTRO_TAC[`G`;`u`;`h_edge m`] along_lemma11; + USE 16 (MATCH_MP squc_h); + USE 18 (MATCH_MP squc_h); + USE 20 (MATCH_MP squc_h); + TYPE_THEN `(p'' = p) \/ (p'' = p') \/ (p' = p)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `!p a b. squ p SUBSET component (ctop G) a /\ squ p SUBSET component (ctop G) b ==> (component (ctop G) a = component (ctop G) b)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + THM_INTRO_TAC[`squ p'''`] cell_nonempty; + REWRITE_TAC[cell_rules]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TSPEC `u'` 22; + TSPEC `u'` 23; + KILL 19 THEN KILL 17 THEN KILL 15 THEN KILL 5; + ASM_MESON_TAC[component_replace]; + (* - *) + TYPE_THEN `!a. bounded_set G a ==> ~(component (ctop G) a = component (ctop G) u)` SUBAGOAL_TAC; + TYPE_THEN `unbounded_set G a` SUBAGOAL_TAC; + REWRITE_TAC[unbounded_set]; + REWRITE_TAC[GSYM unbounded_set]; + THM_INTRO_TAC[`G`] bounded_unbounded_disj; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + UND 21 THEN REP_CASES_TAC; + TYPE_THEN `p''` UNABBREV_TAC; + UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p`;`u`;`x`]); + UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + ASM_MESON_TAC[]; + TYPE_THEN `p''` UNABBREV_TAC; + UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p'`;`u`;`y`]); + UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`y`]); + ASM_MESON_TAC[]; + TYPE_THEN `p'` UNABBREV_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let odd_bounded = prove_by_refinement( + `!G. rectagon G ==> (UNIONS (par_cell F G) = bounded_set G)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC odd_bounded_subset; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`G`;`F`] par_cell_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `?y. UNIONS (par_cell F G) y` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS]; + LEFT_TAC "u"; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `cell u` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`;`F`] par_cell_cell; + ASM_MESON_TAC[ISUBSET]; + USE 4 (MATCH_MP cell_nonempty); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`G`] odd_bounded_subset; + TYPE_THEN `bounded_set G y` SUBAGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + (* - *) + THM_INTRO_TAC[`G`;`x`;`y`] unique_bounded; + TYPE_THEN `component (ctop G) y SUBSET UNIONS (par_cell F G)` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`;`F`;`y`] par_cell_comp; + FIRST_ASSUM DISJ_CASES_TAC; + USE 9 (REWRITE_RULE[SUBSET]); + TSPEC `y` 9; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]); + IMATCH_MP_TAC component_refl; + IMATCH_MP_TAC bounded_subset_unions; + THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + USE 7 SYM; + REWR 8; + USE 8 (REWRITE_RULE[SUBSET]); + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + IMATCH_MP_TAC component_refl; + IMATCH_MP_TAC bounded_subset_unions; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unbounded_even = prove_by_refinement( + `!G. rectagon G ==> (unbounded_set G = UNIONS (par_cell T G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + THM_INTRO_TAC[`G`] unbounded_even_subset; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`G`] odd_bounded; + USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 4; + (* - *) + TYPE_THEN `segment G` SUBAGOAL_TAC; + IMATCH_MP_TAC rectagon_segment; + TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`;`T`] par_cell_partition; + USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 6; + USE 6 (REWRITE_RULE[UNION]); + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`G`] bounded_unbounded_union; + USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + FULL_REWRITE_TAC[UNION]; + TYPE_THEN `bounded_set G x` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + REWR 4; + THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; + FULL_REWRITE_TAC[EQ_EMPTY;INTER]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_union_comp = prove_by_refinement( + `!G eps x. (rectagon G) /\ (UNIONS (par_cell eps G) x) ==> + (UNIONS (par_cell eps G) = component (ctop G) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `eps = T` ASM_CASES_TAC; + TYPE_THEN `UNIONS (par_cell T G) = unbounded_set G` SUBAGOAL_TAC; + ASM_MESON_TAC[unbounded_even]; + TYPE_THEN `eps` UNABBREV_TAC; + REWR 0; + THM_INTRO_TAC[`G`]unbounded_set_comp; + FULL_REWRITE_TAC[rectagon]; + REWR 0; + ASM_MESON_TAC[component_replace]; + (* - *) + TYPE_THEN `eps = F` ASM_CASES_TAC; + TYPE_THEN `eps` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`G`;`x`;`x'`] unique_bounded; + ASM_MESON_TAC[odd_bounded]; + UND 4 THEN REWRITE_TAC[]; + IMATCH_MP_TAC component_refl; + IMATCH_MP_TAC bounded_subset_unions; + ASM_MESON_TAC[odd_bounded]; + THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp; + FIRST_ASSUM DISJ_CASES_TAC; + USE 4 (REWRITE_RULE [SUBSET]); + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + IMATCH_MP_TAC component_refl; + IMATCH_MP_TAC bounded_subset_unions; + ASM_MESON_TAC[odd_bounded]; + THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* 1.0.7 Adding segments *) + +let edge_cell = prove_by_refinement( + `!e. (edge e) ==> (cell e)`, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + ASM_MESON_TAC[cell_rules]; + ]);; + (* }}} *) + +let edge_subset_ctop = prove_by_refinement( + `!G A. FINITE G /\ G SUBSET edge /\ A SUBSET edge /\ + (A INTER G = EMPTY) ==> (UNIONS A SUBSET UNIONS (ctop G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[ctop_unions;DIFF_SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS edge` EXISTS_TAC ; + CONJ_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + FULL_REWRITE_TAC[segment]; + REWRITE_TAC[UNIONS;SUBSET]; + USE 5 (MATCH_MP edge_euclid2); + FULL_REWRITE_TAC[SUBSET]; + (* - *) + REWRITE_TAC[UNIONS;INTER;EQ_EMPTY]; + FULL_REWRITE_TAC[EQ_EMPTY]; + TSPEC `u` 0; + USE 0(REWRITE_RULE[INTER]); + UND 0 THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `cell u /\ cell u'` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`] curve_cell_cell; + THM_INTRO_TAC[`u`] edge_cell; + FULL_REWRITE_TAC[ISUBSET]; + FULL_REWRITE_TAC[ISUBSET]; + (* - *) + TYPE_THEN `u = u'` SUBAGOAL_TAC ; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + ASM_MESON_TAC[]; + TYPE_THEN `u'` UNABBREV_TAC; + TYPE_THEN `edge u` SUBAGOAL_TAC; + ASM_MESON_TAC[ISUBSET]; + FULL_REWRITE_TAC[edge]; + ASM_MESON_TAC[curve_cell_h_ver2;curve_cell_v_ver2]; + ]);; + (* }}} *) + +let par_cell_pointI = prove_by_refinement( + `!G eps m. + (par_cell eps G {(pointI m)} = + UNIONS (par_cell eps G) (pointI m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[UNIONS]; + TYPE_THEN `!u. cell u /\ u (pointI m) ==> ( u = {(pointI m)})` SUBAGOAL_TAC; + FULL_REWRITE_TAC[cell]; + UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `u` UNABBREV_TAC) THEN (FULL_REWRITE_TAC[cell_clauses;INR IN_SING;pointI_inj]); + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + REWRITE_TAC[INR IN_SING]; + TYPE_THEN `u = {(pointI m)}` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[par_cell_cell;subset_imp]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_pointI_trichot = prove_by_refinement( + `!G eps m. (rectagon G) ==> + ((par_cell eps G {(pointI m)}) \/ (par_cell (~eps) G {(pointI m)}) + \/ (cls G m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `UNIONS (ctop G) (pointI m)` ASM_CASES_TAC; + THM_INTRO_TAC[`G`;`eps`] par_cell_partition; + IMATCH_MP_TAC rectagon_segment; + USE 2 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `pointI m` 2; + REWR 2; + USE 2(REWRITE_RULE[UNION]); + USE 2 (REWRITE_RULE[GSYM par_cell_pointI]); + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`] rectagon_segment; + (* - *) + DISJ2_TAC; + DISJ2_TAC; + REWRITE_TAC[cls]; + FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM ]; + THM_INTRO_TAC[`G`;`m`] curve_point_unions; + REWR 1; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[pointI;euclid_point]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`;`m`] curve_cell_not_point; + REWR 4; + THM_INTRO_TAC[`G`;`pointI m`] num_closure0; + FULL_REWRITE_TAC[rectagon]; + REWR 6; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_nbd = prove_by_refinement( + `!G eps m e. (rectagon G) /\ (par_cell eps G {(pointI m)}) /\ edge e + /\ closure top2 e (pointI m) ==> (par_cell eps G e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + FULL_REWRITE_TAC[edge]; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_v; + TYPE_THEN `e` UNABBREV_TAC; + FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `m'` UNABBREV_TAC; + TYPE_THEN `m` UNABBREV_TAC; + TYPE_THEN `down (FST m',SND m' +: &:1) = m'` SUBAGOAL_TAC; + REWRITE_TAC[down;PAIR_SPLIT]; + INT_ARITH_TAC; + REWR 5; + (* - *) + TYPE_THEN `e` UNABBREV_TAC; + THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_h; + FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `m'` UNABBREV_TAC; + TYPE_THEN `m` UNABBREV_TAC; + TYPE_THEN `left (FST m' +: &:1,SND m') = m'` SUBAGOAL_TAC; + REWRITE_TAC[left ;PAIR_SPLIT]; + INT_ARITH_TAC; + REWR 4; + ]);; + (* }}} *) + +let segment_in_comp = prove_by_refinement( + `!G A. rectagon G /\ segment A /\ (A INTER G = EMPTY) /\ + (cls G INTER cls A SUBSET endpoint A) + ==> (?eps. A SUBSET par_cell eps G)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `?e. A e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment;EMPTY_EXISTS ]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`G`;`A`] edge_subset_ctop; + FULL_REWRITE_TAC[segment;rectagon]; + (* - *) + THM_INTRO_TAC[`G`] rectagon_segment; + TYPE_THEN`edge e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET;segment]; + THM_INTRO_TAC[`e`] edge_cell; + THM_INTRO_TAC[`e`] cell_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + TYPE_THEN `?eps. ~(e INTER (UNIONS (par_cell eps G)) = EMPTY)` SUBAGOAL_TAC; + REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`G`;`T`] par_cell_partition; + USE 10(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 10; + TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `UNIONS A` EXISTS_TAC; + REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + REWR 10; + USE 10 (REWRITE_RULE[SUBSET ;UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `T` EXISTS_TAC; + TYPE_THEN `u` EXISTS_TAC; + REWRITE_TAC[INTER]; + REWRITE_TAC[INTER]; + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN `eps` EXISTS_TAC; + (* - *) + USE 10 (REWRITE_RULE [EMPTY_EXISTS;INTER;UNIONS]); + TYPE_THEN `u'' = e` SUBAGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + ASM_MESON_TAC[par_cell_cell;subset_imp ]; + TYPE_THEN `u''` UNABBREV_TAC; + (* - *) + TYPE_THEN `S = A INTER par_cell eps G` ABBREV_TAC ; + TYPE_THEN `inductive_set A S` BACK_TAC ; (* // *) + FULL_REWRITE_TAC[inductive_set;segment]; + TYPE_THEN `S = A` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 2 THEN MESON_TAC[]; + KILL 15 THEN KILL 20 THEN KILL 16 THEN KILL 21; + TYPE_THEN `S` UNABBREV_TAC; + ASM_MESON_TAC[SUBSET_INTER_ABSORPTION]; + (* -// *) + REWRITE_TAC[inductive_set]; + SUBCONJ_TAC; + TYPE_THEN `S` UNABBREV_TAC ; + REWRITE_TAC[INTER;SUBSET]; + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `S` UNABBREV_TAC; + REWRITE_TAC[INTER]; + (* -B *) + USE 13(REWRITE_RULE[INTER]); + TYPE_THEN `S` UNABBREV_TAC; + THM_INTRO_TAC[`C`;`C'`] adjv_adj; + FULL_REWRITE_TAC[segment]; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `m = adjv C C'` ABBREV_TAC ; + (* - *) + TYPE_THEN `FINITE G /\ FINITE A` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + TYPE_THEN `~endpoint A m` SUBAGOAL_TAC; + FULL_REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`A`;`pointI m`] num_closure1; + REWR 23; + COPY 23; + TSPEC `C` 23; + TSPEC `C'` 24; + TYPE_THEN `e' = C` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + THM_INTRO_TAC[`C`;`C'`] adjv_adj2; + USE 2(REWRITE_RULE[segment]); + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `C = C'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[adj]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `cls A m` SUBAGOAL_TAC; + REWRITE_TAC[cls]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `~cls G m` SUBAGOAL_TAC; + USE 0 (REWRITE_RULE[SUBSET;INTER]); + ASM_MESON_TAC[]; + (* -C *) + TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC; + USE 2(REWRITE_RULE[segment]); + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`G`;`eps`;`m`] par_cell_pointI_trichot; + REWR 27; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`G`;`eps`;`m`;`C'`] par_cell_nbd; + TYPE_THEN `m` UNABBREV_TAC; + IMATCH_MP_TAC adjv_adj2; + (* - *) + THM_INTRO_TAC[`G`;`~eps`;`m`;`C`] par_cell_nbd; + THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let segment_end_select = prove_by_refinement( + `!E A a b. (E SUBSET edge) /\ segment_end A a b /\ + ~cls E a /\ cls E b ==> + (?B c. segment_end B a c /\ cls E c /\ B SUBSET A /\ + (cls B INTER cls E = {c}))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `EE = { (B,c) | segment_end B a c /\ cls E c /\ B SUBSET A }` ABBREV_TAC ; + (* - *) + TYPE_THEN `~(EE = EMPTY)` SUBAGOAL_TAC; + UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `(A,b)` EXISTS_TAC; + TYPE_THEN `EE` UNABBREV_TAC; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + (* - *) + THM_INTRO_TAC[`EE`;`(CARD o FST):((((num->real)->bool)->bool)#(int#int))->num`] select_image_num_min; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `?Bm cm. (z = (Bm,cm))` SUBAGOAL_TAC; + ONCE_REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `Bm` EXISTS_TAC; + TYPE_THEN `cm` EXISTS_TAC; + TYPE_THEN `EE` UNABBREV_TAC; + FULL_REWRITE_TAC[o_DEF]; + USE 4(ONCE_REWRITE_RULE[PAIR_SPLIT]); + USE 4(REWRITE_RULE[]); + TYPE_THEN `c` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + (* - *) + IMATCH_MP_TAC SUBSET_ANTISYM; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + FULL_REWRITE_TAC[SUBSET;INR IN_SING;INTER]; + IMATCH_MP_TAC segment_end_cls2; + ASM_MESON_TAC[]; + (* - *) + REWRITE_TAC[SUBSET;INTER;INR IN_SING]; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`Bm`;`a`;`cm`;`x`] cut_psegment; + DISCH_TAC; + ASM_MESON_TAC[]; + (* - *) + TSPEC `(A',x)` 6; + USE 6 (ONCE_REWRITE_RULE[PAIR_SPLIT]); + REWR 6; + USE 6 (CONV_RULE (dropq_conv "B")); + USE 6 (CONV_RULE (dropq_conv "c")); + UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]); + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Bm` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + USE 6(MATCH_MP (ARITH_RULE `x <=| y ==> ~( y < x)`)); + UND 6 THEN REWRITE_TAC[]; + (* - *) + IMATCH_MP_TAC card_subset_lt; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + FULL_REWRITE_TAC[segment_end;segment;psegment]; + (* - *) + TYPE_THEN `~(B' = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end;segment;psegment]; + UND 17 THEN UND 19 THEN MESON_TAC[]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + FULL_REWRITE_TAC[EQ_EMPTY;INTER ]; + TSPEC `u` 15; + USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 6; + FULL_REWRITE_TAC[UNION]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let endpoint_cls = prove_by_refinement( + `!G. FINITE G ==> (endpoint G SUBSET cls G)`, + (* {{{ proof *) + [ + REWRITE_TAC[endpoint;SUBSET;cls]; + THM_INTRO_TAC[`G`;`pointI x`] num_closure1; + REWR 2; + MESON_TAC[]; + ]);; + (* }}} *) + +let conn2_proper = prove_by_refinement( + `!G H . (G SUBSET edge) /\ + conn2 G /\ conn2 H /\ H SUBSET G /\ ~(H = G) ==> + (?A. A SUBSET G /\ (A INTER H = EMPTY) /\ psegment A /\ + (cls H INTER cls A = endpoint A))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* - *) + TYPE_THEN `cls G SUBSET cls H` ASM_CASES_TAC; + TYPE_THEN `?e. G e /\ ~H e` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + UND 0 THEN REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_ANTISYM; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `edge e` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `{e}` EXISTS_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[SUBSET;INR IN_SING]; + CONJ_TAC; + ASM_REWRITE_TAC[EQ_EMPTY;INR IN_SING;INTER]; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC psegment_edge; + TYPE_THEN `endpoint{e} = cls{e}` SUBAGOAL_TAC; + ASM_SIMP_TAC[endpoint_closure;cls_edge]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_INTER_ABSORPTION]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `cls G` EXISTS_TAC; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;INR IN_SING]; + (* -A *) + TYPE_THEN `?a. cls G a /\ ~cls H a` SUBAGOAL_TAC; + USE 5(REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `FINITE H /\ H SUBSET edge` SUBAGOAL_TAC; + CONJ_TAC; + FULL_REWRITE_TAC[conn2]; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + (* - *) + TYPE_THEN `?b c. cls H b /\ cls H c /\ ~(b = c)` SUBAGOAL_TAC; + THM_INTRO_TAC[`H`] conn2_cls3; + THM_INTRO_TAC[`cls H`;`2`] card_has_subset; + CONJ_TAC; + ASM_MESON_TAC[finite_cls]; + UND 10 THEN ARITH_TAC; + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `B` UNABBREV_TAC; + FULL_REWRITE_TAC[SUBSET;INR in_pair]; + TYPE_THEN `a'` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_MESON_TAC[]; + (* -B *) + TYPE_THEN `cls H SUBSET cls G` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + TYPE_THEN `~(a = b) /\ ~(a = c)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `(?U. U SUBSET G /\ segment_end U a b /\ ~cls U c)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`H`;`U`;`a`;`b`] segment_end_select; + TYPE_THEN `B SUBSET G` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `U` EXISTS_TAC; + TYPE_THEN `~cls B c` SUBAGOAL_TAC; + TYPE_THEN `cls B SUBSET cls U` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USE 25 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + KILL 20 THEN KILL 16 THEN KILL 17 THEN KILL 18 THEN KILL 15 THEN KILL 10; + KILL 12; + TYPE_THEN `~(a = c')` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `~(c = c')` SUBAGOAL_TAC; + TYPE_THEN`c'` UNABBREV_TAC; + USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `c` 12; + USE 12 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `(?V. V SUBSET G /\ segment_end V a c /\ ~cls V c')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`H`;`V`;`a`;`c`] segment_end_select; + (* -C *) + TYPE_THEN `B' SUBSET G` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `V` EXISTS_TAC; + TYPE_THEN `~cls B' c'` SUBAGOAL_TAC; + TYPE_THEN `cls B' SUBSET cls V` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USE 29 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + KILL 20 THEN KILL 16 THEN KILL 17; + KILL 15; + KILL 12 THEN KILL 24 THEN KILL 14; + (* - *) + TYPE_THEN `~(c'' = c')` SUBAGOAL_TAC; + TYPE_THEN `c''` UNABBREV_TAC; + USE 18 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `c'` 12; + USE 12 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `B INTER H = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 14(REWRITE_RULE[INTER]); + USE 19 SYM; + TYPE_THEN `cls {u} SUBSET cls B INTER cls H` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC THEN IMATCH_MP_TAC cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING]; + USE 16 SYM; + REWR 17; + THM_INTRO_TAC[`u`] cls_edge_size2; + FULL_REWRITE_TAC[SUBSET]; + FULL_REWRITE_TAC[has_size2]; + REWR 17; + USE 17 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]); + COPY 17; + TSPEC `a'` 17; + TSPEC `b` 24; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `B' INTER H = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 15(REWRITE_RULE[INTER]); + USE 18 SYM; + TYPE_THEN `cls {u} SUBSET cls B' INTER cls H` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC THEN IMATCH_MP_TAC cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING]; + USE 17 SYM; + REWR 18; + THM_INTRO_TAC[`u`] cls_edge_size2; + FULL_REWRITE_TAC[SUBSET]; + FULL_REWRITE_TAC[has_size2]; + REWR 18; + USE 18 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]); + COPY 18; + TSPEC `a'` 18; + TSPEC `b` 29; + ASM_MESON_TAC[]; + (* -D *) + USE 22 (ONCE_REWRITE_RULE[segment_end_symm]); + THM_INTRO_TAC[`B`;`B'`;`c'`;`a`;`c''`] segment_end_trans; + TYPE_THEN `U` EXISTS_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `B UNION B'` EXISTS_TAC; + REWRITE_TAC[union_subset]; + (* - *) + CONJ_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ]; + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + USE 20(REWRITE_RULE[segment_end]); + (* -// *) + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET]; + USE 20 (REWRITE_RULE[segment_end]); + REWRITE_TAC[INR in_pair]; + TYPE_THEN `cls U SUBSET cls(B UNION B')` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USE 31(REWRITE_RULE[SUBSET;cls_union]); + USE 31(REWRITE_RULE[UNION]); + TSPEC `x` 31; + FIRST_ASSUM DISJ_CASES_TAC; + USE 19(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 19; + USE 19 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_MESON_TAC[]; + USE 18(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 18; + USE 18 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_MESON_TAC[]; + (* -E *) + USE 20(REWRITE_RULE[segment_end]); + REWRITE_TAC[SUBSET;INTER;INR in_pair]; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `FINITE U` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + (* - *) + USE 20 SYM; + TYPE_THEN `endpoint U SUBSET cls U` SUBAGOAL_TAC; + IMATCH_MP_TAC endpoint_cls; + USE 31(REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + USE 20 SYM; + REWRITE_TAC[INR in_pair]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION U *) +(* ------------------------------------------------------------------ *) + + +(* EVEN and ODD components. 1.0.8, Nov 28, 2004, 9am *) + +let parity_select = jordan_def + `parity G C = @eps. par_cell eps G C`;; + +let cell_ununion = prove_by_refinement( + `!V C u. cell C /\ C u /\ (V SUBSET cell) /\ (UNIONS V) u ==> V C`, + (* {{{ proof *) + [ + REWRITE_TAC[UNIONS]; + TYPE_THEN `u' = C` SUBAGOAL_TAC; + IMATCH_MP_TAC cell_partition; + CONJ_TAC; + ASM_MESON_TAC[subset_imp]; + UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_cell_partition = prove_by_refinement( + `!G eps C. segment G /\ cell C ==> + (par_cell eps G C \/ par_cell (~eps) G C \/ curve_cell G C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `curve_cell G C` ASM_CASES_TAC; + THM_INTRO_TAC[`C`] cell_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC; + REWRITE_TAC[ctop_unions;DIFF;UNIONS ]; + CONJ_TAC; + THM_INTRO_TAC[`C`] cell_euclid; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`curve_cell G`;`C`;`u`] cell_ununion; + CONJ_TAC; + IMATCH_MP_TAC curve_cell_cell; + FULL_REWRITE_TAC[segment]; + REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`G`;`eps`] par_cell_partition; + USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 5; + REWR 5; + USE 5(REWRITE_RULE[UNION]); + THM_INTRO_TAC[`G`] par_cell_cell; + FIRST_ASSUM DISJ_CASES_TAC; + DISJ1_TAC; + IMATCH_MP_TAC cell_ununion; + ASM_MESON_TAC[]; + DISJ2_TAC; + IMATCH_MP_TAC cell_ununion; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_curve_cell_disj = prove_by_refinement( + `!G eps. (G SUBSET edge) ==> + (par_cell eps G INTER curve_cell G = EMPTY )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[INTER;EQ_EMPTY]; + USE 2(MATCH_MP par_cell_curve_disj); + UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;UNIONS ]; + TYPE_THEN `cell x` SUBAGOAL_TAC; + ASM_MESON_TAC[curve_cell_cell;subset_imp]; + USE 2 (MATCH_MP cell_nonempty); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let curve_cell_edge = prove_by_refinement( + `!G e . edge e ==> (curve_cell G e = G e) `, + (* {{{ proof *) + [ + REWRITE_TAC[edge]; + FIRST_ASSUM DISJ_CASES_TAC; + REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ]; + REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ]; + ]);; + (* }}} *) + +let parity = prove_by_refinement( + `!G C. segment G /\ cell C /\ ~curve_cell G C ==> + par_cell (parity G C) G C`, + (* {{{ proof *) + [ + REWRITE_TAC[parity_select]; + SELECT_TAC; + THM_INTRO_TAC[`G`;`T`;`C`] par_cell_cell_partition; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let parity_unique = prove_by_refinement( + `!G C eps. segment G /\ + par_cell eps G C ==> (eps = parity G C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `cell C /\ ~curve_cell G C` SUBAGOAL_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[par_cell_cell;subset_imp]; + THM_INTRO_TAC[`G`;`eps`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[segment]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`;`C`] parity; + PROOF_BY_CONTR_TAC; + TYPE_THEN`parity G C = ~eps` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `parity G C` UNABBREV_TAC; + THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unions_curve_cell = prove_by_refinement( + `!G C. (G SUBSET edge) /\ cell C ==> + ((C INTER UNIONS (curve_cell G) = EMPTY) = (~curve_cell G C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + USE 3(REWRITE_RULE[INTER;UNIONS;EQ_EMPTY]); + USE 0 (MATCH_MP cell_nonempty); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + (* - *) + REWRITE_TAC[EQ_EMPTY;INTER]; + UND 2 THEN REWRITE_TAC[]; + IMATCH_MP_TAC cell_ununion; + UNIFY_EXISTS_TAC; + IMATCH_MP_TAC curve_cell_cell; + ]);; + (* }}} *) + +let even_num_lower_union = prove_by_refinement( + `!A B m. FINITE A /\ FINITE B /\ (A INTER B = EMPTY) ==> + (EVEN (num_lower (A UNION B) m) <=> + (EVEN (num_lower A m) = EVEN (num_lower B m)))`, + (* {{{ proof *) + [ + REWRITE_TAC[num_lower_set]; + THM_INTRO_TAC[`set_lower A m`;`set_lower B m`] even_card_even; + REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC finite_set_lower)); + REWRITE_TAC[EQ_EMPTY;INTER;set_lower]; + FULL_REWRITE_TAC[EQ_EMPTY;INTER]; + ASM_MESON_TAC[]; + (* - *) + AP_TERM_TAC; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[set_lower;UNION]; + TYPE_THEN `C <=> (FST x = FST m) /\ SND x <=: SND m` ABBREV_TAC ; + USE 0 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `h_edge x` 0; + UND 0 THEN MESON_TAC[]; + ]);; + (* }}} *) + +let eq_pair_exchange = prove_by_refinement( + `!(a:bool) b c d. ((a = b) <=> (c = d)) <=> ((a = c) <=> (b = d))`, + (* {{{ proof *) + [ + MESON_TAC[]; + ]);; + (* }}} *) + +let parity_point = prove_by_refinement( + `!A p. segment A /\ ~(curve_cell A {(pointI p)}) ==> + (parity A {(pointI p)} = EVEN (num_lower A p))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC parity_unique; + REWRITE_TAC[par_cell;cell_clauses]; + THM_INTRO_TAC[`A`;`{(pointI p)}`] unions_curve_cell; + FULL_REWRITE_TAC[cell_rules;segment]; + MESON_TAC[]; + ]);; + (* }}} *) + +let parity_h = prove_by_refinement( + `!A p. segment A /\ ~A (h_edge p) ==> + (parity A (h_edge p) <=> EVEN (num_lower A p))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC parity_unique; + REWRITE_TAC[par_cell;cell_clauses]; + THM_INTRO_TAC[`A`;`h_edge p`] unions_curve_cell; + FULL_REWRITE_TAC[cell_rules;segment]; + THM_INTRO_TAC[`A`;`h_edge p`] curve_cell_edge; + REWRITE_TAC[edge_h]; + MESON_TAC[]; + ]);; + (* }}} *) + +let parity_v = prove_by_refinement( + `!A p. segment A /\ ~A (v_edge p) ==> + (parity A (v_edge p) <=> EVEN (num_lower A p))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC parity_unique; + REWRITE_TAC[par_cell;cell_clauses]; + THM_INTRO_TAC[`A`;`v_edge p`] unions_curve_cell; + FULL_REWRITE_TAC[cell_rules;segment]; + THM_INTRO_TAC[`A`;`v_edge p`] curve_cell_edge; + REWRITE_TAC[edge_v]; + MESON_TAC[]; + ]);; + (* }}} *) + +let parity_squ = prove_by_refinement( + `!A p. segment A ==> + (parity A (squ p) <=> EVEN (num_lower A p))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC parity_unique; + REWRITE_TAC[par_cell;cell_clauses]; + THM_INTRO_TAC[`A`;`squ p`] unions_curve_cell; + FULL_REWRITE_TAC[cell_rules;segment]; + THM_INTRO_TAC[`A`;`p`] curve_cell_squ; + MESON_TAC[]; + ]);; + (* }}} *) + +let parity_union = prove_by_refinement( + `!A B C. segment A /\ segment B /\ segment (A UNION B) /\ + (A INTER B = EMPTY) /\ + cell C /\ ~curve_cell A C /\ ~curve_cell B C ==> + (parity (A UNION B) C <=> (parity A C = parity B C))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC parity_unique; + REWRITE_TAC[par_cell]; + TYPE_THEN `A UNION B SUBSET edge` SUBAGOAL_TAC; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[segment]; + ASM_SIMP_TAC[unions_curve_cell]; + TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + ASM_SIMP_TAC[even_num_lower_union]; + ONCE_REWRITE_TAC[eq_pair_exchange]; + (* -A *) + REWRITE_TAC[curve_cell_union]; + REWRITE_TAC[UNION]; + (* - *) + WITH 2(REWRITE_RULE[cell_mem]); + UND 10 THEN REP_CASES_TAC ; + (* --cases-- *) + REWRITE_TAC[cell_clauses]; + TYPE_THEN`p` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); + TYPE_THEN `C` UNABBREV_TAC; + CONJ_TAC THEN (IMATCH_MP_TAC parity_point); + REWRITE_TAC[cell_clauses]; + TYPE_THEN`p` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); + TYPE_THEN `C` UNABBREV_TAC; + CONJ_TAC THEN (IMATCH_MP_TAC parity_h) THEN ASM_MESON_TAC[curve_cell_h_ver2]; + REWRITE_TAC[cell_clauses]; + TYPE_THEN`p` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); + TYPE_THEN `C` UNABBREV_TAC; + CONJ_TAC THEN (IMATCH_MP_TAC parity_v) THEN ASM_MESON_TAC[curve_cell_v_ver2]; + REWRITE_TAC[cell_clauses]; + TYPE_THEN`p` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `a /\ b ==> (a <=> b)`); + TYPE_THEN `C` UNABBREV_TAC; + CONJ_TAC THEN (IMATCH_MP_TAC parity_squ) ; + ]);; + + (* }}} *) + +(* extraneous fact *) +let component_simple_arc = prove_by_refinement( + `!G x y. (FINITE G /\ G SUBSET edge ) /\ ~(x = y) ==> + ((component (ctop G) x y) <=> + (?C. simple_arc_end C x y /\ + (C INTER (UNIONS (curve_cell G)) = EMPTY)))`, + (* {{{ proof *) + [ + (* + string together :component-imp-connected, connected-induced2, + p_conn_conn, p_conn_hv_finite; + other_direction : simple_arc_connected, connected-induced, + connected-component; *) + REP_BASIC_TAC; + THM_INTRO_TAC[`G`] ctop_top; + ASSUME_TAC top2_top; + THM_INTRO_TAC[`G`] curve_closed_ver2; + TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC; + USE 5 (MATCH_MP closed_open); + FULL_REWRITE_TAC[top2_unions;open_DEF ]; + TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ; + TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC; + TYPE_THEN`A` UNABBREV_TAC; + REWRITE_TAC[ctop_unions]; + TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC; + REWRITE_TAC[ctop]; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected; + THM_INTRO_TAC[`(top2)`;`A`;`(component (ctop G) x)`] connected_induced2; + REWRITE_TAC[top2_unions]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; + CONJ_TAC; + KILL 7; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[component_unions]; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF;SUBSET]; + REWR 12; + (* --A *) + TYPE_THEN `B = component (ctop G) x` ABBREV_TAC ; + TYPE_THEN `B x /\ B y` SUBAGOAL_TAC; + TYPE_THEN `B` UNABBREV_TAC; + THM_INTRO_TAC[`(ctop G)`;`x`;`y`] component_replace; + IMATCH_MP_TAC component_symm; + (* -- *) + ASSUME_TAC loc_path_conn_top2; + TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC; + REWRITE_TAC[ctop]; + REWRITE_TAC[top2]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC top_of_metric_induced; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF;SUBSET]; + (* -- *) + TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC; + THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid; + FULL_REWRITE_TAC[top2]; + ASM_MESON_TAC[]; + (* -- *) + THM_INTRO_TAC[`top2`] loc_path_conn; + REWR 20; + TSPEC `A` 20; + REWR 20; + TSPEC `x` 20; + TYPE_THEN `A x` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `top2 B` SUBAGOAL_TAC; + TYPE_THEN `B` UNABBREV_TAC; + ASM_MESON_TAC[path_eq_conn]; + (* --B *) + THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn; + (* -- *) + THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite; + ASM_MESON_TAC[]; + REWR 24; + TYPE_THEN `C` EXISTS_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 7; + FULL_REWRITE_TAC[DIFF]; + TYPE_THEN `B u` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `A u` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + REWR 7; + (* -C *) + (* other_direction : simple_arc_connected, connected-induced, + connected-component; *) + THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple; + THM_INTRO_TAC[`C`] simple_arc_connected; + TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2; + REWRITE_TAC[top2_unions]; + REWR 15; + (* - *) + TYPE_THEN `C SUBSET A` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF_SUBSET]; + REWR 15; + (* - *) + THM_INTRO_TAC[`(ctop G)`;`C`;`x`] connected_component; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + USE 17(REWRITE_RULE[SUBSET]); + TSPEC `y` 17; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let ctop_comp_open = prove_by_refinement( + `!G x . (FINITE G /\ G SUBSET edge ) ==> + top2 (component (ctop G) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`] ctop_top; + ASSUME_TAC top2_top; + THM_INTRO_TAC[`G`] curve_closed_ver2; + TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC; + USE 4 (MATCH_MP closed_open); + FULL_REWRITE_TAC[top2_unions;open_DEF ]; + TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ; + TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC; + TYPE_THEN`A` UNABBREV_TAC; + REWRITE_TAC[ctop_unions]; + TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC; + REWRITE_TAC[ctop]; + (* - *) + TYPE_THEN `B = component (ctop G) x` ABBREV_TAC ; + TYPE_THEN `B = EMPTY` ASM_CASES_TAC; + THM_INTRO_TAC[`top2`] open_EMPTY; + FULL_REWRITE_TAC[open_DEF]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected; + THM_INTRO_TAC[`(top2)`;`A`;`(component (ctop G) x)`] connected_induced2; + REWRITE_TAC[top2_unions]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC; + CONJ_TAC; + KILL 6; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[component_unions]; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF;SUBSET]; + REWR 12; + (* --A *) + TYPE_THEN `B x /\ B u` SUBAGOAL_TAC; + TYPE_THEN `B` UNABBREV_TAC; + THM_INTRO_TAC[`(ctop G)`;`x`;`u`] component_replace; + IMATCH_MP_TAC component_symm; + (* -- *) + ASSUME_TAC loc_path_conn_top2; + TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC; + REWRITE_TAC[ctop]; + REWRITE_TAC[top2]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC top_of_metric_induced; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF;SUBSET]; + (* -- *) + TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC; + THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid; + FULL_REWRITE_TAC[top2]; + ASM_MESON_TAC[]; + (* -- *) + THM_INTRO_TAC[`top2`] loc_path_conn; + REWR 18; + TSPEC `A` 18; + REWR 18; + TSPEC `x` 18; + TYPE_THEN `A x` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `B` UNABBREV_TAC; + ASM_MESON_TAC[path_eq_conn]; + (* --B *) + ]);; + (* }}} *) + +let psegment_triple = jordan_def + `psegment_triple A B C <=> + psegment A /\ psegment B /\ psegment C /\ + rectagon (A UNION B) /\ rectagon (A UNION C) /\ + rectagon(B UNION C) /\ + (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ + (B INTER C = EMPTY) /\ + (cls A INTER cls B = endpoint A) /\ + (cls B INTER cls C = endpoint A) /\ + (cls A INTER cls C = endpoint A) /\ + (endpoint A = endpoint B) /\ (endpoint B = endpoint C)`;; + +let psegment_triple3 = prove_by_refinement( + `!A B C. psegment_triple A B C ==> psegment_triple B C A`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM;INTER_COMM]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let psegment_triple2 = prove_by_refinement( + `!A B C. psegment_triple A B C ==> psegment_triple C B A`, + (* {{{ proof *) + [ + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM;INTER_COMM]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unions_empty_imp_empty = prove_by_refinement( + `!(A:(A->bool)->bool) B. (UNIONS A INTER UNIONS B = EMPTY) /\ + (!C. A C ==> ~(C = EMPTY)) ==> + (A INTER B = EMPTY) `, + (* {{{ proof *) + [ + REWRITE_TAC[EQ_EMPTY;INTER;UNIONS]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_closure = prove_by_refinement( + `!G A eps. + FINITE A /\ A SUBSET edge /\ rectagon G /\ + A SUBSET par_cell eps G ==> + (curve_cell A INTER par_cell (~eps) G = EMPTY)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC unions_empty_imp_empty; + ASSUME_TAC top2_top; + TYPE_THEN `(par_cell (~eps) G) = EMPTY` ASM_CASES_TAC; + REWRITE_TAC[INTER_EMPTY]; + FULL_REWRITE_TAC[curve_cell;UNION]; + TYPE_THEN `C` UNABBREV_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[SUBSET]; + TYPE_THEN `edge {}` SUBAGOAL_TAC; + TYPE_THEN `cell {}` SUBAGOAL_TAC; + IMATCH_MP_TAC edge_cell; + USE 9 (MATCH_MP cell_nonempty); + ASM_MESON_TAC[]; + USE 8 SYM; + FULL_REWRITE_TAC[EQ_EMPTY;INR IN_SING ]; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `~(UNIONS (par_cell (~eps) G) = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNIONS;EQ_EMPTY]; + TYPE_THEN `~ (u = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `u` UNABBREV_TAC; + THM_INTRO_TAC[`G`;`~eps`] par_cell_cell; + FULL_REWRITE_TAC[SUBSET]; + TYPE_THEN `cell {}` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + USE 8 (MATCH_MP cell_nonempty); + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TSPEC `u'` 6; + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC; + THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed; + REWRITE_TAC[open_DEF]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`G`;`~eps`;`u'`] par_cell_union_comp; + IMATCH_MP_TAC ctop_comp_open ; + ASM_MESON_TAC[rectagon]; + FULL_REWRITE_TAC[top2_unions]; + (* -B *) + THM_INTRO_TAC[`A`] curve_closure_ver2; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + THM_INTRO_TAC[`A`] curve_cell_cell; + USE 10 (REWRITE_RULE[SUBSET]); + TSPEC `C` 10; + USE 9 (MATCH_MP cell_nonempty); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN`UNIONS (curve_cell A) SUBSET (euclid 2 DIFF UNIONS (par_cell (~eps) G))` SUBAGOAL_TAC; + USE 8 GSYM; + IMATCH_MP_TAC closure_subset; + REWRITE_TAC[DIFF_SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS edge` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + REWRITE_TAC[UNIONS;SUBSET]; + THM_INTRO_TAC[`u'`] edge_euclid2; + ASM_MESON_TAC[subset_imp]; + REWRITE_TAC[INTER;EQ_EMPTY]; + COPY 10; + USE 11(REWRITE_RULE[UNIONS]); + THM_INTRO_TAC[`par_cell (~eps) G`;`u'`;`x`] cell_ununion; + TYPE_THEN`edge u'` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC [par_cell_cell;edge_cell]; + USE 0 (REWRITE_RULE[SUBSET]); + TSPEC `u'` 0; + THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[DIFF_SUBSET]; + ]);; + (* }}} *) + +let cell_unions_disj = prove_by_refinement( + `!U V. U SUBSET cell /\ V SUBSET cell ==> ((U INTER V = EMPTY) <=> + (UNIONS U INTER UNIONS V = EMPTY))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 3(REWRITE_RULE[INTER]); + TYPE_THEN `?C. V C /\ C u` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + TYPE_THEN `cell C` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `U C` SUBAGOAL_TAC; + IMATCH_MP_TAC cell_ununion; + ASM_MESON_TAC[]; + USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + (* - *) + IMATCH_MP_TAC unions_empty_imp_empty; + REP_BASIC_TAC; + TYPE_THEN `C` UNABBREV_TAC; + TYPE_THEN `cell EMPTY ` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[cell_nonempty]; + ]);; + (* }}} *) + +let unions_curve_cell_par_cell_disj = prove_by_refinement( + `!G eps. (G SUBSET edge) ==> + (UNIONS (par_cell eps G) INTER UNIONS (curve_cell G) = EMPTY)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`par_cell eps G`;`curve_cell G`] cell_unions_disj; + THM_INTRO_TAC[`G`] curve_cell_cell; + REWRITE_TAC[par_cell_cell]; + USE 1 SYM; + IMATCH_MP_TAC par_cell_curve_cell_disj; + ]);; + (* }}} *) + +let par_cell_simple_arc = prove_by_refinement( + `!G eps x y. rectagon G /\ ~(x = y) ==> + ((UNIONS (par_cell eps G) x /\ UNIONS (par_cell eps G) y) <=> + (?C. simple_arc_end C x y /\ + (C SUBSET (UNIONS (par_cell eps G)))) )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + THM_INTRO_TAC[`G`;`eps`;`x`] par_cell_union_comp; + THM_INTRO_TAC[`G`;`x`;`y`] component_simple_arc; + FULL_REWRITE_TAC[rectagon]; + REWR 2; + TYPE_THEN `C` EXISTS_TAC; + USE 4 SYM; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + (* -- *) + THM_INTRO_TAC[`C`;`x`;`y`;`x'`] simple_arc_end_cut; + CONJ_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `x'` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -- *) + THM_INTRO_TAC[`G`;`x`;`x'`] component_simple_arc; + FULL_REWRITE_TAC[rectagon]; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `~component (ctop G) x x'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + UND 13 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `C'` EXISTS_TAC; + FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ]SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C INTER UNIONS (curve_cell G)` EXISTS_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* -A *) + TYPE_THEN `C x /\ C y` SUBAGOAL_TAC; + CONJ_TAC THEN ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let trap_triple_seg = prove_by_refinement( + `!A B C eps eps'. psegment_triple A B C /\ + C SUBSET par_cell (~eps) (A UNION B) + ==> + (par_cell eps (A UNION B) SUBSET par_cell eps' (A UNION C) \/ + par_cell eps (A UNION B) SUBSET par_cell (~eps') (A UNION C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + USE 2 (REWRITE_RULE[SUBSET]); + FULL_REWRITE_TAC[DE_MORGAN_THM]; + LEFT 2 "x"; + LEFT 3 "x"; + UND 2 THEN REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + UND 3 THEN REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TYPE_THEN`cell x' /\ cell x` SUBAGOAL_TAC; + ASM_MESON_TAC[par_cell_cell;subset_imp]; + (* - *) + TYPE_THEN `!x. cell x /\ par_cell eps (A UNION B) x ==> par_cell eps' (A UNION C) x \/ par_cell (~eps') (A UNION C) x` SUBAGOAL_TAC; + THM_INTRO_TAC[`A UNION C`;`eps'`;`x''`] par_cell_cell_partition; + IMATCH_MP_TAC rectagon_segment; + FULL_REWRITE_TAC[psegment_triple]; + USE 10 (REWRITE_RULE[curve_cell_union]); + UND 10 THEN REP_CASES_TAC; + USE 10 (REWRITE_RULE[UNION]); + (* -- *) + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`A UNION B`;`eps`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[psegment_triple]; + USE 21 (REWRITE_RULE[rectagon]); + USE 12 (REWRITE_RULE[INTER;EQ_EMPTY;curve_cell_union;DE_MORGAN_THM ]); + TSPEC `x''` 12; + REWR 12; + USE 12 (REWRITE_RULE[UNION;DE_MORGAN_THM ]); + ASM_MESON_TAC[]; + (* -- *) + THM_INTRO_TAC[`A UNION B`;`C`;`~eps`;] par_cell_closure; + FULL_REWRITE_TAC[psegment_triple]; + USE 22(REWRITE_RULE[psegment;segment]); + USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + (* - *) + COPY 8; + TSPEC `x` 8; + TSPEC `x'` 9; + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]); + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWR 8; + REWR 9; + (* - *) + USE 6 (MATCH_MP cell_nonempty); + USE 7(MATCH_MP cell_nonempty); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `UNIONS (par_cell eps (A UNION B)) u /\ UNIONS (par_cell eps (A UNION B)) u'` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `u = u'` ASM_CASES_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + TYPE_THEN `cell x /\ cell x'` SUBAGOAL_TAC; + ASM_MESON_TAC[par_cell_cell;subset_imp]; + TYPE_THEN `x = x'` SUBAGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + ASM_MESON_TAC[]; + TYPE_THEN `x'` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -B *) + THM_INTRO_TAC[`A UNION B`;`eps`;`u`;`u'`]par_cell_simple_arc; + FULL_REWRITE_TAC[psegment_triple]; + REWR 13; + (* - *) + TYPE_THEN `C' INTER UNIONS (curve_cell A) = EMPTY` SUBAGOAL_TAC; + REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL;curve_cell_union;UNIONS_UNION]; + REWRITE_TAC[SUBSET;UNION]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (par_cell eps (A UNION B)) INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET_EMPTY]; + IMATCH_MP_TAC unions_curve_cell_par_cell_disj ; + FULL_REWRITE_TAC[psegment_triple]; + USE 24 (REWRITE_RULE[rectagon]); + (* -C *) + THM_INTRO_TAC[`A UNION B`;`C`;`~eps`] par_cell_closure; + FULL_REWRITE_TAC[psegment_triple]; + USE 26(REWRITE_RULE[psegment;segment]); + REWR 16; + THM_INTRO_TAC[`curve_cell C`;`par_cell eps (A UNION B)`] cell_unions_disj; + CONJ_TAC; + IMATCH_MP_TAC curve_cell_cell; + FULL_REWRITE_TAC[psegment_triple]; + USE 27(REWRITE_RULE[psegment;segment]); + REWRITE_TAC[par_cell_cell]; + REWR 17; + TYPE_THEN `UNIONS (curve_cell C) INTER C' = EMPTY` SUBAGOAL_TAC ; + REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY]; + USE 17 SYM; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + (* - *) + TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION C)) = EMPTY` SUBAGOAL_TAC; + REWRITE_TAC[curve_cell_union;UNIONS_UNION]; + REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY]; + REWRITE_TAC[UNION_EMPTY]; + ONCE_REWRITE_TAC[INTER_COMM]; + (* -D *) + THM_INTRO_TAC[`A UNION C`;`u`;`u'`] component_simple_arc; + FULL_REWRITE_TAC[psegment_triple]; + USE 28(REWRITE_RULE[rectagon]); + (* - *) + TYPE_THEN `component (ctop (A UNION C)) u u'` SUBAGOAL_TAC; + TYPE_THEN `C'` EXISTS_TAC; + REWR 20; + TYPE_THEN `UNIONS (par_cell (eps') (A UNION C)) u'` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C)) u` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC [`A UNION C`;`eps'`] par_cell_union_disjoint; + THM_INTRO_TAC[`A UNION C`;`eps'`;`u'`] par_cell_union_comp; + FULL_REWRITE_TAC[psegment_triple]; + THM_INTRO_TAC[`A UNION C`;`~eps'`;`u`] par_cell_union_comp; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C))` UNABBREV_TAC; + TYPE_THEN `UNIONS (par_cell eps' (A UNION C))` UNABBREV_TAC; + USE 25 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u'` 25; + REWR 25; + ]);; + (* }}} *) + +let parity_even_cell = prove_by_refinement( + `!G m. (rectagon G) ==> (parity G (squ m) = even_cell G (squ m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`;`m`] parity_squ; + IMATCH_MP_TAC rectagon_segment; + REWRITE_TAC[parity_squ;even_cell_squ]; + ]);; + (* }}} *) + +let par_cell_squ_neg = prove_by_refinement( + `!G m eps. segment G ==> + (par_cell (~eps) G (squ m) <=> ~(par_cell eps G (squ m)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`;`eps`;`squ m`] par_cell_cell_partition; + REWRITE_TAC[cell_rules]; + ASM_MESON_TAC[curve_cell_squ]; + ]);; + (* }}} *) + +let triple_par_cell_distinct = prove_by_refinement( + `!A B C eps eps'. psegment_triple A B C ==> + ~(par_cell eps (A UNION B) = par_cell eps' (A UNION C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `s = (eps = eps')` ABBREV_TAC ; + TYPE_THEN `!m. (parity (A UNION B) (squ m) = parity(A UNION C) (squ m)) = s` SUBAGOAL_TAC; + TYPE_THEN `s` UNABBREV_TAC; + REWRITE_TAC[EQ_SYM_EQ]; + ONCE_REWRITE_TAC[eq_pair_exchange]; + TYPE_THEN `eps = parity (A UNION B) (squ m)` ASM_CASES_TAC; + IMATCH_MP_TAC parity_unique; + USE 0 SYM; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + IMATCH_MP_TAC parity; + REWRITE_TAC[cell_rules;]; + SUBCONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + ASM_MESON_TAC[curve_cell_squ]; + (* -- *) + TYPE_THEN `!m. par_cell (~eps) (A UNION B) (squ m) = par_cell (~eps') (A UNION C) (squ m)` SUBAGOAL_TAC; + TYPE_THEN `segment (A UNION B) /\ segment(A UNION C)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC THEN IMATCH_MP_TAC rectagon_segment; + ASM_SIMP_TAC [par_cell_squ_neg]; + TYPE_THEN `~eps = parity (A UNION B) (squ m)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 2; + TYPE_THEN `~(~eps' = parity (A UNION C) (squ m))` SUBAGOAL_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + ASM_MESON_TAC[]; + KILL 3; + UND 2 THEN REWRITE_TAC[]; + IMATCH_MP_TAC parity_unique; + TSPEC `m` 4; + USE 2 SYM; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + IMATCH_MP_TAC parity; + REWRITE_TAC[cell_rules;]; + SUBCONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + ASM_MESON_TAC[curve_cell_squ]; + (* -A *) + THM_INTRO_TAC[`A UNION B`] parity_even_cell; + RIGHT 4 "m"; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]); + FULL_REWRITE_TAC[psegment_triple]; + REWR 3; + THM_INTRO_TAC[`A UNION C`] parity_even_cell; + RIGHT 5 "m"; + UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]); + FULL_REWRITE_TAC[psegment_triple]; + REWR 3; + (* - *) + TYPE_THEN `?e. B e /\ ~C e /\ ~A e` SUBAGOAL_TAC; + TYPE_THEN `~(B = EMPTY)` SUBAGOAL_TAC ; + TYPE_THEN `B` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + USE 17( REWRITE_RULE[psegment;segment]); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + REWRITE_TAC[GSYM DE_MORGAN_THM]; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `edge e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + USE 20 (REWRITE_RULE[psegment;segment]); + ASM_MESON_TAC[subset_imp]; + FULL_REWRITE_TAC[edge]; + TYPE_THEN `rectagon (A UNION B) /\ rectagon (A UNION C)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + (* - *) + KILL 5; + KILL 4; + KILL 0; + KILL 2; + TYPE_THEN `~(A UNION C) e /\ (A UNION B) e` SUBAGOAL_TAC; + ASM_REWRITE_TAC[UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + THM_INTRO_TAC[`(A UNION B)`;`m`] squ_left_odd; + THM_INTRO_TAC[`(A UNION C)`;`m`] squ_left_even; + ASM_MESON_TAC[]; + TYPE_THEN `e` UNABBREV_TAC; + THM_INTRO_TAC[`A UNION B`;`m`] squ_down; + FULL_REWRITE_TAC[rectagon]; + THM_INTRO_TAC[`A UNION C`;`m`] squ_down; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[set_lower_n]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let triple_in_comp = prove_by_refinement( + `!A B C eps. psegment_triple A B C /\ + ~(C SUBSET par_cell eps (A UNION B)) ==> + (C SUBSET par_cell (~eps) (A UNION B)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp; + FULL_REWRITE_TAC[psegment_triple]; + USE 12 (REWRITE_RULE[psegment]); + REWRITE_TAC[cls_union;]; + CONJ_TAC; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + ONCE_REWRITE_TAC[INTER_COMM]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + TYPE_THEN `endpoint A` UNABBREV_TAC; + TYPE_THEN `endpoint B` UNABBREV_TAC; + TYPE_THEN `endpoint C` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[SUBSET_REFL]; + TYPE_THEN `eps' = eps` ASM_CASES_TAC; + TYPE_THEN`eps'` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps'` UNABBREV_TAC; + ]);; + (* }}} *) + +let trap_odd_cell = prove_by_refinement( + `!A B C. psegment_triple A B C ==> + (A SUBSET par_cell F (B UNION C)) \/ + (B SUBSET par_cell F (A UNION C)) \/ + (C SUBSET par_cell F (A UNION B))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + TYPE_THEN `C SUBSET par_cell (~F) (A UNION B)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC triple_in_comp;ALL_TAC]; + TYPE_THEN `A SUBSET par_cell (~F) (B UNION C)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC triple_in_comp;ALL_TAC]; + IMATCH_MP_TAC psegment_triple3; + TYPE_THEN `B SUBSET par_cell (~F) (C UNION A)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC triple_in_comp;ALL_TAC]; + CONJ_TAC; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple3; + USE 6(ONCE_REWRITE_RULE[UNION_COMM]); + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!A B. psegment_triple A B C /\ (C SUBSET par_cell T (A UNION B)) /\ (A SUBSET par_cell T (B UNION C)) ==> (par_cell F (A UNION B) SUBSET par_cell T (B UNION C))` SUBAGOAL_TAC; + THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`T`] trap_triple_seg; + FULL_REWRITE_TAC[UNION_COMM]; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple2; + FULL_REWRITE_TAC[UNION_COMM]; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`B'`;`C`;`A'`;`F`;`F`] trap_triple_seg; + IMATCH_MP_TAC psegment_triple3; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[UNION_COMM]; + TYPE_THEN `par_cell F (B' UNION C) = par_cell F (A' UNION B')` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`F`] triple_par_cell_distinct; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple2; + FULL_REWRITE_TAC[UNION_COMM]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `par_cell F (B' UNION A') SUBSET par_cell T (B' UNION A')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNION_COMM]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `par_cell F (B' UNION C)` EXISTS_TAC; + (* -- *) + THM_INTRO_TAC[`A' UNION B'`;`F` ] par_cell_nonempty; + USE 9(REWRITE_RULE[psegment_triple]); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`A' UNION B'`;`F`] par_cell_disjoint; + FULL_REWRITE_TAC[EQ_EMPTY;INTER]; + TSPEC `u` 16; + REWR 16; + USE 14(REWRITE_RULE[SUBSET]); + FULL_REWRITE_TAC[UNION_COMM]; + ASM_MESON_TAC[]; + (* -A *) + COPY 7; + UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`B`]); + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`B`;`A`]); + FULL_REWRITE_TAC[UNION_COMM]; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple2; + (* - *) + FULL_REWRITE_TAC[UNION_COMM]; + THM_INTRO_TAC[`A UNION B`;`F`] par_cell_nonempty; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`A UNION B`;`u`;`F`] parity_unique; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + TYPE_THEN `par_cell T (A UNION C) u /\ par_cell T (B UNION C) u` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`A UNION C`;`u`;`T`] parity_unique; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + (* -B *) + TYPE_THEN `cell u` SUBAGOAL_TAC; + ASM_MESON_TAC[par_cell_cell;subset_imp]; + TYPE_THEN `!A B eps. rectagon (A UNION B) /\ (par_cell eps (A UNION B) u) ==> ~curve_cell A u` SUBAGOAL_TAC; + THM_INTRO_TAC[`A' UNION B'`;`eps`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[EQ_EMPTY;INTER]; + TSPEC `u` 19; + USE 19 (REWRITE_RULE[curve_cell_union;DE_MORGAN_THM ]); + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + USE 20 (REWRITE_RULE[UNION]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `segment A /\ segment B /\ segment C /\ segment (A UNION B) /\ segment (B UNION C) /\ segment (A UNION C) /\ (A INTER B = EMPTY) /\ (B INTER C = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment]; + FULL_REWRITE_TAC[UNION_COMM]; + REPEAT CONJ_TAC THEN (IMATCH_MP_TAC rectagon_segment); + (* -C *) + THM_INTRO_TAC[`A`;`B`;`u`] parity_union; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `F` EXISTS_TAC; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `A` EXISTS_TAC; + USE 10 SYM; + TYPE_THEN `F` EXISTS_TAC; + FULL_REWRITE_TAC[UNION_COMM]; + FULL_REWRITE_TAC[psegment_triple]; + (* - *) + THM_INTRO_TAC[`B`;`C`;`u`] parity_union; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `T` EXISTS_TAC; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `T` EXISTS_TAC; + FULL_REWRITE_TAC[UNION_COMM]; + FULL_REWRITE_TAC[psegment_triple]; + (* - *) + THM_INTRO_TAC[`A`;`C`;`u`] parity_union; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `T` EXISTS_TAC; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `T` EXISTS_TAC; + FULL_REWRITE_TAC[UNION_COMM]; + FULL_REWRITE_TAC[psegment_triple]; + REWR 28; + REWR 27; + ]);; + + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* SECTION V *) +(* ------------------------------------------------------------------ *) + +(* -- more on 2-connectedness, etc. *) + +let euclid_diff_par_cell = prove_by_refinement( + `!G eps. (segment G) ==> + (euclid 2 DIFF UNIONS(par_cell (~eps) G) = + UNIONS(par_cell eps G) UNION UNIONS (curve_cell G))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[DIFF;UNION]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + USE 3(REWRITE_RULE[DE_MORGAN_THM]); + TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC; + ASM_REWRITE_TAC[ctop_unions;DIFF]; + (* -- *) + THM_INTRO_TAC[`G`;`eps`] par_cell_partition; + USE 6 SYM; + REWR 5; + FULL_REWRITE_TAC[UNION]; + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + USE 1(REWRITE_RULE[UNIONS]); + LEFT 1 "u"; + THM_INTRO_TAC[`u`] cell_euclid; + THM_INTRO_TAC[`G`;`eps`] par_cell_cell; + THM_INTRO_TAC[`G`] curve_cell_cell; + FULL_REWRITE_TAC[segment]; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[subset_imp]; + (* - *) + THM_INTRO_TAC[`G`;`eps`] par_cell_union_disjoint; + USE 3(REWRITE_RULE[INTER;EQ_EMPTY]); + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`G`] ctop_unions; + USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 5; + FULL_REWRITE_TAC[DIFF]; + TYPE_THEN `~UNIONS (ctop G )x` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`;`eps`] par_cell_partition; + USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + FULL_REWRITE_TAC[UNION]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_closure_cell = prove_by_refinement( + `!G C d eps. + cell C /\ cell d /\ rectagon G /\ (d SUBSET closure top2 C) /\ + par_cell eps G C ==> + (par_cell eps G d \/ curve_cell G d)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC top2_top; + TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC; + THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed; + REWRITE_TAC[open_DEF]; + TYPE_THEN `UNIONS (par_cell (~eps) G) = EMPTY ` ASM_CASES_TAC; + USE 5 (MATCH_MP (REWRITE_RULE[open_DEF]open_EMPTY)); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`G`;`~eps`;`u`] par_cell_union_comp; + IMATCH_MP_TAC ctop_comp_open ; + ASM_MESON_TAC[rectagon]; + FULL_REWRITE_TAC[top2_unions]; + THM_INTRO_TAC[`G`;`eps`] euclid_diff_par_cell; + IMATCH_MP_TAC rectagon_segment; + REWR 6; + KILL 7; + (* -A *) + TYPE_THEN `closure top2 C SUBSET (UNIONS (par_cell eps G) UNION UNIONS (curve_cell G))` SUBAGOAL_TAC; + IMATCH_MP_TAC closure_subset; + IMATCH_MP_TAC in_union; + DISJ1_TAC; + IMATCH_MP_TAC sub_union; + (* - *) + TYPE_THEN `d SUBSET UNIONS (par_cell eps G) UNION UNIONS (curve_cell G)` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[GSYM UNIONS_UNION]; + (* - *) + THM_INTRO_TAC[`d`] cell_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + THM_INTRO_TAC[`par_cell eps G UNION curve_cell G`;`d`;`u`] cell_ununion; + CONJ_TAC; + REWRITE_TAC[union_subset]; + REWRITE_TAC [par_cell_cell]; + THM_INTRO_TAC[`G`] curve_cell_cell; + FULL_REWRITE_TAC[rectagon]; + REWRITE_TAC[UNIONS;UNION]; + USE 8(REWRITE_RULE[SUBSET;UNIONS]); + TSPEC `u` 8; + USE 8 (REWRITE_RULE[UNION]); + TYPE_THEN `u'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[UNION]; + (* Thu Dec 2 09:50:25 EST 2004 *) + ]);; + (* }}} *) + +let rectagon_curve = prove_by_refinement( + `!G C a b. FINITE G /\ G SUBSET edge /\ simple_arc_end C a b /\ + (C INTER UNIONS (curve_cell G) = EMPTY) ==> + (C SUBSET (component (ctop G) a))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[SUBSET]; + TYPE_THEN `a = x` ASM_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + IMATCH_MP_TAC component_refl; + FULL_REWRITE_TAC[ctop_unions;DIFF;EQ_EMPTY ;INTER ]; + CONJ_TAC; + USE 1 (MATCH_MP simple_arc_end_simple); + USE 1 (MATCH_MP simple_arc_euclid); + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`G`;`a`;`x`] component_simple_arc; + TYPE_THEN `x = b` ASM_CASES_TAC; + TYPE_THEN `C` EXISTS_TAC; + (* - *) + THM_INTRO_TAC[`C`;`a`;`b`;`x`] simple_arc_end_cut; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `C` UNABBREV_TAC; + FULL_REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `(C' UNION C'') INTER UNIONS (curve_cell G)` EXISTS_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;UNION]; + (* Thu Dec 2 10:11:45 EST 2004 *) + + ]);; + (* }}} *) + +(* *) +let star_avoidance_lemma1 = prove_by_refinement( + `!E E' R B x. bounded_set E x /\ E SUBSET E' /\ FINITE E' /\ + E' SUBSET edge /\ rectagon R /\ R SUBSET E /\ + ~(UNIONS (curve_cell B) x) /\ + B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==> + (bounded_set (E' DIFF B) x \/ unbounded_set (E' DIFF B) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`ctop E`;`x`] component_empty; + REWRITE_TAC[ctop_top]; + (* - *) + TYPE_THEN `UNIONS (ctop E) x` SUBAGOAL_TAC; + USE 9 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] not_eq]); + FULL_REWRITE_TAC[EMPTY_EXISTS;bounded_set]; + ASM_MESON_TAC[]; + KILL 9; + (* - *) + TYPE_THEN `UNIONS (ctop (E' DIFF B)) x` SUBAGOAL_TAC; + REWRITE_TAC[ctop_unions]; + TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ; + REWRITE_TAC[DIFF]; + CONJ_TAC; + USE 10(REWRITE_RULE[ctop_unions;DIFF]); + TYPE_THEN `E' = E'' UNION E'` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + TYPE_THEN `E''` UNABBREV_TAC; + REWRITE_TAC[DIFF;UNION]; + MESON_TAC[]; + THM_INTRO_TAC[`E''`;`E'`] curve_cell_union; + USE 12 SYM; + REWR 13; + TYPE_THEN `UNIONS (curve_cell E') = UNIONS (curve_cell E'') UNION UNIONS(curve_cell E')` SUBAGOAL_TAC; + REWRITE_TAC[GSYM UNIONS_UNION]; + AP_TERM_TAC; + ASM_MESON_TAC[]; + USE 14(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 14; + USE 14(REWRITE_RULE[UNION]); + ASM_MESON_TAC[]; + (* -A *) + THM_INTRO_TAC[`E' DIFF B`] bounded_unbounded_union; + USE 11(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 11; + REWR 11; + USE 11(REWRITE_RULE[UNION]); + (* - *) + ]);; + (* }}} *) + +let curve_cell_imp_subset = prove_by_refinement( + `!A B. A SUBSET B ==> curve_cell A SUBSET curve_cell B`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `B = A UNION (B DIFF A)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + FULL_REWRITE_TAC [UNION;DIFF;SUBSET ]; + ASM_MESON_TAC []; + TYPE_THEN `C = B DIFF A` ABBREV_TAC ; + REWRITE_TAC[curve_cell_union]; + REWRITE_TAC[SUBSET;UNION]; + ]);; + (* }}} *) + +let unbound_set_x_axis = prove_by_refinement( + `!G. (FINITE G /\ G SUBSET edge ) ==> + (?r. !s. (r <= s) ==> unbounded_set G (point(s,&0)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[unbounded_set;unbounded;]; + NAME_CONFLICT_TAC; + LEFT_TAC "r'"; + LEFT_TAC "r'"; + THM_INTRO_TAC[`G`] unbounded_set_nonempty; + FULL_REWRITE_TAC[EMPTY_EXISTS;unbounded_set;unbounded]; + TYPE_THEN `r` EXISTS_TAC; + TYPE_THEN `(\ (s:real). r)` EXISTS_TAC; + COPY 2; + TSPEC `s'` 2; + TSPEC `s''` 5; + USE 4 (MATCH_MP component_symm); + USE 4 (MATCH_MP component_replace); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let star_avoidance = prove_by_refinement( + `!E E' R B x. unbounded_set (E' DIFF B) x /\ E SUBSET E' /\ FINITE E' /\ + E' SUBSET edge /\ rectagon R /\ R SUBSET E /\ + FINITE B /\ B SUBSET edge /\ + ~(UNIONS (curve_cell B) x) /\ + B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==> + ( unbounded_set (E) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ; + RULE_ASSUM_TAC (REWRITE_RULE[unbounded_set;unbounded]); + (* - *) + THM_INTRO_TAC[`R`] unbound_set_x_axis; + FULL_REWRITE_TAC[rectagon]; + (* - *) + TYPE_THEN `?r. !s. (r <= s) ==> component (ctop E'') x (point(s,&0)) /\ ~(x = (point(s,&0))) /\ unbounded_set R (point(s,&0)) ` SUBAGOAL_TAC; + TYPE_THEN `r'' = &1 + (||. r') + (||. r) + ||. (x 0)` ABBREV_TAC ; + TYPE_THEN `r''` EXISTS_TAC; + TYPE_THEN `r <= s` SUBAGOAL_TAC; + UNDF `r'' <= s` THEN UND 13 THEN REAL_ARITH_TAC; + CONJ_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[coord01]; + UND 13 THEN UND 14 THEN REAL_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 13 THEN UND 14 THEN REAL_ARITH_TAC; + KILL 12; + KILL 10; + (* - *) + TYPE_THEN `FINITE E'' /\ E'' SUBSET edge` SUBAGOAL_TAC; + TYPE_THEN `E''` UNABBREV_TAC; + CONJ_TAC; + IMATCH_MP_TAC FINITE_DIFF; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET_DIFF]; + (* - *) + TYPE_THEN `!s. ?C. (r'' <= s) ==> (simple_arc_end C x (point(s,&0)) /\ (C INTER UNIONS (curve_cell E'') = {}))` SUBAGOAL_TAC; + TSPEC `s` 13; + RIGHT_TAC "C"; + THM_INTRO_TAC[`E''`;`x`;`point(s,&0)`] component_simple_arc; + ASM_MESON_TAC[]; + (* -A *) + REWRITE_TAC[unbounded_set;unbounded]; + TYPE_THEN `r''` EXISTS_TAC; + TSPEC `s` 13; + TSPEC `s` 14; + THM_INTRO_TAC[`E`;`x`;`point(s,&0)`] component_simple_arc; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + ASM_MESON_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + TYPE_THEN `C` EXISTS_TAC; + (* - *) + TYPE_THEN `R SUBSET E''` SUBAGOAL_TAC; + TYPE_THEN `E''` UNABBREV_TAC; + REWRITE_TAC[DIFF_SUBSET]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[rectagon]; + USE 21(REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u` 21; + UND 21 THEN ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[curve_cell_subset;subset_imp]; + (* -B *) + TYPE_THEN `C INTER UNIONS(curve_cell R) = EMPTY` SUBAGOAL_TAC; + FULL_REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C INTER UNIONS (curve_cell E'')` EXISTS_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC UNIONS_UNIONS; + IMATCH_MP_TAC curve_cell_imp_subset; + (* - *) + THM_INTRO_TAC[`R`;`C`;`x`;`point(s,&0)`] rectagon_curve; + FULL_REWRITE_TAC[rectagon]; + (* - *) + THM_INTRO_TAC[`R`]unbounded_set_comp; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `component (ctop R) x' = component (ctop R) (point(s,&0))` SUBAGOAL_TAC; + IMATCH_MP_TAC component_replace; + USE 23 SYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `component (ctop R) x'` UNABBREV_TAC; + TYPE_THEN `component (ctop R) x = component (ctop R) (point(s,&0))` SUBAGOAL_TAC; + IMATCH_MP_TAC component_replace; + USE 22(REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* -C *) + THM_INTRO_TAC[`R`;`B`;`F`] par_cell_closure; + (* - *) + TYPE_THEN `C INTER UNIONS (curve_cell B) = EMPTY` SUBAGOAL_TAC; + FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (par_cell T R) INTER UNIONS (curve_cell B)` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + THM_INTRO_TAC[`R`] unbounded_even; + USE 26 SYM; + ASM_MESON_TAC[]; + ONCE_REWRITE_TAC[INTER_COMM]; + FULL_REWRITE_TAC[SUBSET_EMPTY ]; + THM_INTRO_TAC[`curve_cell B`;`par_cell T R`] cell_unions_disj; + THM_INTRO_TAC[`B`]curve_cell_cell; + THM_INTRO_TAC[`R`]par_cell_cell; + USE 26 (ONCE_REWRITE_RULE[EQ_SYM_EQ]); + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `E SUBSET E'' UNION B` SUBAGOAL_TAC; + TYPE_THEN `E''` UNABBREV_TAC; + REWRITE_TAC[SUBSET;DIFF;UNION]; + ASM_MESON_TAC[subset_imp]; + (* - *) + FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C INTER UNIONS (curve_cell (E'' UNION B))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC UNIONS_UNIONS; + IMATCH_MP_TAC curve_cell_imp_subset; + (* - *) + REWRITE_TAC[curve_cell_union;UNIONS_UNION]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + (* Thu Dec 2 16:12:59 EST 2004 *) + + ]);; + (* }}} *) + +let star_avoidance_contrp = prove_by_refinement( + `!E E' R B x. bounded_set (E) x /\ E SUBSET E' /\ FINITE E' /\ + E' SUBSET edge /\ rectagon R /\ R SUBSET E /\ + FINITE B /\ B SUBSET edge /\ + ~(UNIONS (curve_cell B) x) /\ + B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==> + ( bounded_set (E' DIFF B) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance_lemma1; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance; + THM_INTRO_TAC[`E`] bounded_unbounded_disj; + FULL_REWRITE_TAC[EQ_EMPTY;INTER]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let bounded_avoidance_subset = prove_by_refinement( + `!E E' x. bounded_set E x /\ E SUBSET E' /\ (E' SUBSET edge) /\ + (FINITE E') /\ + conn2 E /\ + ~(UNIONS (curve_cell E') x) ==> + (bounded_set E' x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`] conn2_has_rectagon; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance_contrp; + ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty]; + FULL_REWRITE_TAC[DIFF_EMPTY]; + ]);; + (* }}} *) + +let unbounded_avoidance_subset = prove_by_refinement( + `!E E' x. (unbounded_set E' x) /\ E SUBSET E' /\ (E' SUBSET edge) /\ + (FINITE E') /\ + conn2 E /\ + ~(UNIONS (curve_cell E') x) ==> unbounded_set E x + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`] conn2_has_rectagon; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance; + ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty;DIFF_EMPTY]; + ]);; + (* }}} *) + +let diff_unchange = prove_by_refinement( + `! (A:A -> bool) B. (A DIFF B = A) <=> (A INTER B = EMPTY)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + USE 0(ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 0(REWRITE_RULE[DIFF]); + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[EQ_EMPTY;INTER]; + ASM_MESON_TAC[]; + USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + IMATCH_MP_TAC EQ_EXT; + FULL_REWRITE_TAC[DIFF;INTER]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let union_diff2 = prove_by_refinement( + `!(A:A->bool) B. (A UNION B) DIFF A = (B DIFF A)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;DIFF;]; + MESON_TAC[]; + ]);; + (* }}} *) + +let unbounded_triple_avoidance = prove_by_refinement( + `!A B C x. psegment_triple A B C /\ + A SUBSET par_cell F (B UNION C) /\ + unbounded_set (B UNION C) x ==> + unbounded_set (A UNION B UNION C) x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance; + CONJ_TAC; + TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC; + ONCE_REWRITE_TAC [union_diff2]; + REWRITE_TAC[diff_unchange]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[psegment_triple]; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[SUBSET_REFL]; + CONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment;segment]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment;segment]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + USE 15 (REWRITE_RULE[segment;psegment]); + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + USE 15 (REWRITE_RULE[segment;psegment]); + SUBCONJ_TAC; + THM_INTRO_TAC[`(B UNION C)`;`A`;`F`] par_cell_closure; + FULL_REWRITE_TAC[psegment_triple]; + USE 16 (REWRITE_RULE[psegment;segment]); + THM_INTRO_TAC[`B UNION C`] unbounded_even; + FULL_REWRITE_TAC[psegment_triple]; + REWR 0; + KILL 5; + FULL_REWRITE_TAC[UNIONS]; + TYPE_THEN `u = u'` SUBAGOAL_TAC; + IMATCH_MP_TAC cell_partition; + REWRITE_TAC[EMPTY_EXISTS;INTER ]; + THM_INTRO_TAC[`A`] curve_cell_cell; + FULL_REWRITE_TAC[psegment_triple]; + USE 19 (REWRITE_RULE[psegment;segment;]); + REPEAT CONJ_TAC THEN (TRY (ASM_MESON_TAC[par_cell_cell;subset_imp])); + TYPE_THEN`u'` UNABBREV_TAC; + USE 4 (REWRITE_RULE [EQ_EMPTY;INTER]); + ASM_MESON_TAC[]; + (* -A *) + USE 3(ONCE_REWRITE_RULE[curve_cell_union; ]); + USE 3(REWRITE_RULE[UNIONS_UNION]); + TYPE_THEN `D = B UNION C` ABBREV_TAC ; + USE 3(REWRITE_RULE[UNION]); + REWR 3; + TYPE_THEN `D` UNABBREV_TAC; + THM_INTRO_TAC[`B UNION C`;`T`] unions_curve_cell_par_cell_disj; + FULL_REWRITE_TAC[psegment_triple]; + USE 12(REWRITE_RULE[rectagon]); + THM_INTRO_TAC[`B UNION C`] unbounded_even; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unbounded_set_comp_elt_eq = prove_by_refinement( + `! G x. FINITE G /\ + G SUBSET edge /\ unbounded_set G x ==> + (unbounded_set G = component (ctop G) x) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`] unbounded_set_comp; + IMATCH_MP_TAC component_replace; + REWR 0; + ]);; + (* }}} *) + +let outer_segment_even = prove_by_refinement( + `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) + ==> C SUBSET par_cell T (A UNION B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple;psegment;segment]; + TYPE_THEN `C` UNABBREV_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + THM_INTRO_TAC[`B UNION C`] unbounded_set_nonempty; + FULL_REWRITE_TAC[psegment_triple]; + USE 10(REWRITE_RULE [rectagon]); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + THM_INTRO_TAC[`B UNION C`;`u'`] unbounded_set_comp_elt_eq; + FULL_REWRITE_TAC[psegment_triple]; + USE 11 (REWRITE_RULE[rectagon]); + THM_INTRO_TAC[`B UNION C`;`u'`;`u`] along_lemma11; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC rectagon_segment; + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[UNION]; + (* - *) + THM_INTRO_TAC[`squ p`] cell_nonempty; + REWRITE_TAC[cell_rules]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `unbounded_set (B UNION C) u''` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + (* -A *) + THM_INTRO_TAC[`A`;`B`;`C`;`u''`] unbounded_triple_avoidance; + THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`u''`] unbounded_avoidance_subset; + (* -- *) + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + CONJ_TAC; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment;segment]; + CONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment;segment]; + CONJ_TAC; + IMATCH_MP_TAC conn2_rectagon; + FULL_REWRITE_TAC[psegment_triple]; + (* --B *) + TYPE_THEN `D = B UNION C` ABBREV_TAC ; + USE 10(REWRITE_RULE[curve_cell_union;]); + USE 10(REWRITE_RULE[UNIONS_UNION]); + USE 10(REWRITE_RULE[UNION]); + THM_INTRO_TAC[`D`] unbounded_even; + TYPE_THEN `D` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + KILL 4; + TYPE_THEN `unbounded_set D` UNABBREV_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`D`;`A`;`F`] par_cell_closure; + TYPE_THEN `D` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + USE 23(REWRITE_RULE[psegment;segment]); + THM_INTRO_TAC[`curve_cell A`;`par_cell T D`] cell_unions_disj; + THM_INTRO_TAC[`A`] curve_cell_cell; + FULL_REWRITE_TAC[psegment_triple]; + USE 25(REWRITE_RULE[psegment;segment]); + THM_INTRO_TAC[`D`] par_cell_cell; + REWR 12; + REWR 13; + USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + (* -- *) + THM_INTRO_TAC[`D`;`T`]unions_curve_cell_par_cell_disj; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `D` UNABBREV_TAC; + USE 19 (REWRITE_RULE[rectagon]); + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* -C *) + THM_INTRO_TAC[`A UNION B`] unbounded_even; + FULL_REWRITE_TAC[psegment_triple]; + KILL 4; + TYPE_THEN `unbounded_set (A UNION B)` UNABBREV_TAC; + THM_INTRO_TAC[`par_cell T (A UNION B)`;`squ p`;`u''`] cell_ununion; + REWRITE_TAC[par_cell_cell;cell_rules]; + THM_INTRO_TAC[`A UNION B`;`squ p`;`u`;`T`] par_cell_closure_cell; + REWRITE_TAC[cell_rules;squ_closure]; + CONJ_TAC; + IMATCH_MP_TAC edge_cell; + FULL_REWRITE_TAC[psegment_triple]; + USE 21 (REWRITE_RULE[psegment;segment]); + ASM_MESON_TAC[subset_imp]; + FULL_REWRITE_TAC[psegment_triple]; + (* - *) + THM_INTRO_TAC[`A UNION B`;`u`] curve_cell_edge; + FULL_REWRITE_TAC[psegment_triple]; + USE 22 (REWRITE_RULE[psegment;segment]); + ASM_MESON_TAC[subset_imp]; + REWR 11; + KILL 12; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC ; + THM_INTRO_TAC[`A UNION B`;`C`] segment_in_comp; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[cls_union]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER;union_subset]; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER_COMM]; + ASM_MESON_TAC[SUBSET_REFL]; + (* -- *) + TYPE_THEN `eps = T` ASM_CASES_TAC; + TYPE_THEN `eps` UNABBREV_TAC; + TYPE_THEN `eps = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint; + USE 15(REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u` 15; + USE 13 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + (* - *) + USE 12 (REWRITE_RULE[UNION]); + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let meeting_lemma = prove_by_refinement( + `!R B C v eps. rectagon R /\ B SUBSET par_cell eps R /\ + (C INTER R = EMPTY) /\ cls R INTER cls C SUBSET endpoint C /\ + cls C v /\ cls B v /\ ~cls R v /\ segment C /\ B SUBSET edge ==> + C SUBSET par_cell eps R`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`R`;`C`] segment_in_comp; + TYPE_THEN `eps' = eps` ASM_CASES_TAC ; + TYPE_THEN `eps'` UNABBREV_TAC; + TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps'` UNABBREV_TAC; + KILL 10; + (* - *) + TYPE_THEN `~(C INTER par_cell eps R = EMPTY)` BACK_TAC ; + USE 10(REWRITE_RULE[INTER;EMPTY_EXISTS ]); + THM_INTRO_TAC[`R`;`eps`] par_cell_disjoint; + USE 12(REWRITE_RULE[INTER;EQ_EMPTY]); + USE 9 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `?eC. closure top2 eC (pointI v) /\ C eC` SUBAGOAL_TAC; + FULL_REWRITE_TAC[cls]; + ASM_MESON_TAC[]; + TYPE_THEN `?eB. closure top2 eB (pointI v) /\ B eB` SUBAGOAL_TAC; + FULL_REWRITE_TAC[cls]; + ASM_MESON_TAC[]; + (* - *) + UND 10 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `eC` EXISTS_TAC; + IMATCH_MP_TAC par_cell_nbd; + TYPE_THEN `v` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + FULL_REWRITE_TAC[segment]; + ASM_MESON_TAC[subset_imp]; + (* - *) + THM_INTRO_TAC[`R`;`eB`;`{(pointI v)}`;`eps`] par_cell_closure_cell; + REWRITE_TAC[cell_rules;SUBSET;INR IN_SING]; + CONJ_TAC; + IMATCH_MP_TAC edge_cell; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[subset_imp]; + PROOF_BY_CONTR_TAC; + REWR 10; + THM_INTRO_TAC[`R`;`v`] curve_cell_not_point; + IMATCH_MP_TAC rectagon_segment; + UND 16 THEN ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`R`;`pointI v`] num_closure0; + FULL_REWRITE_TAC[rectagon]; + USE 2(REWRITE_RULE[cls]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let parity_union_triple = prove_by_refinement( + `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\ + (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) + /\ (A SUBSET edge) /\ A e ==> + (parity (B UNION C) e = (parity B e = parity C e))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `edge e` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`B`;`C`;`e`] parity_union; + CONJ_TAC; + IMATCH_MP_TAC edge_cell; + (* - *) + TYPE_THEN `~B e /\ ~C e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + ASM_SIMP_TAC[curve_cell_edge]; + ]);; + (* }}} *) + +let parity_union_triple_even = prove_by_refinement( + `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\ + (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) + /\ (segment A ) /\ A e /\ + A SUBSET par_cell T (B UNION C) ==> (parity B e = parity C e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple; + FULL_REWRITE_TAC[segment]; + USE 9(ONCE_REWRITE_RULE[EQ_SYM_EQ]); + THM_INTRO_TAC[`B UNION C`;`e`;`T`] parity_unique; + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let parity_union_triple_odd = prove_by_refinement( + `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\ + (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY) + /\ (A SUBSET edge) /\ A e /\ + A SUBSET par_cell F (B UNION C) ==> ~(parity B e = parity C e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple; + REWR 10; + THM_INTRO_TAC[`B UNION C`;`e`;`F`] parity_unique; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let par_cell_even_imp = prove_by_refinement( + `!A B C D. psegment_triple A B D /\ segment C /\ + cls (A UNION B) INTER cls C SUBSET endpoint C /\ + (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY) + /\ C SUBSET par_cell T (B UNION D) /\ C SUBSET par_cell T (A UNION D) + ==> C SUBSET par_cell T (A UNION B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp; + REWRITE_TAC[cls_union]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + (* - *) + TYPE_THEN `eps = T` ASM_CASES_TAC; + TYPE_THEN `eps` UNABBREV_TAC; + TYPE_THEN `eps = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + KILL 9; + PROOF_BY_CONTR_TAC; + (* - *) + TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[subset_imp]; + (* - *) + THM_INTRO_TAC[`C`;`A`;`D`;`e`] parity_union_triple_even; + FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; + IMATCH_MP_TAC rectagon_segment; + THM_INTRO_TAC[`C`;`B`;`D`;`e`] parity_union_triple_even; + FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; + IMATCH_MP_TAC rectagon_segment; + TYPE_THEN `parity D e` UNABBREV_TAC; + USE 12 SYM; + (* - *) + THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple; + FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + USE 6(REWRITE_RULE[segment]); + REWR 13; + (* - *) + THM_INTRO_TAC[`(A UNION B)`;`e`] parity; + ASM_SIMP_TAC[curve_cell_edge]; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + CONJ_TAC; + IMATCH_MP_TAC edge_cell; + USE 27 (REWRITE_RULE[UNION]); + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`A UNION B`;`parity(A UNION B) e`] par_cell_disjoint; + USE 15(REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `e` 15; + UND 15 THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let par_cell_odd_imp = prove_by_refinement( + `!A B C D. psegment_triple A B D /\ segment C /\ + cls (A UNION B) INTER cls C SUBSET endpoint C /\ + (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY) + /\ C SUBSET par_cell F (B UNION D) /\ C SUBSET par_cell T (A UNION D) + ==> C SUBSET par_cell F (A UNION B)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp; + REWRITE_TAC[cls_union]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + (* - *) + TYPE_THEN `eps = F` ASM_CASES_TAC; + TYPE_THEN `eps` UNABBREV_TAC; + TYPE_THEN `eps = T` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + KILL 9; + PROOF_BY_CONTR_TAC; + (* - *) + TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[subset_imp]; + (* - *) + THM_INTRO_TAC[`C`;`A`;`D`;`e`] parity_union_triple_even; + FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; + IMATCH_MP_TAC rectagon_segment; + THM_INTRO_TAC[`C`;`B`;`D`;`e`] parity_union_triple_odd; + FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + USE 6 (REWRITE_RULE[segment]); + TYPE_THEN `parity D e` UNABBREV_TAC; + USE 13 GSYM; + (* - *) + THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple; + FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + USE 6(REWRITE_RULE[segment]); + (* - *) + THM_INTRO_TAC[`(A UNION B)`;`e`] parity; + ASM_SIMP_TAC[curve_cell_edge]; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + CONJ_TAC; + IMATCH_MP_TAC edge_cell; + USE 27 (REWRITE_RULE[UNION]); + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `parity(A UNION B) e = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 13 THEN REWR 14; + UND 9 THEN ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`A UNION B`;`F`] par_cell_disjoint; + USE 9(REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `e` 9; + ASM_MESON_TAC[subset_imp]; + ]);; + + (* }}} *) + +let curve_cell_cls = prove_by_refinement( + `!G m. segment G ==> (curve_cell G {(pointI m)} = cls G m)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASM_SIMP_TAC[curve_cell_not_point]; + THM_INTRO_TAC[`G`;`pointI m`] num_closure0; + FULL_REWRITE_TAC[segment]; + REWRITE_TAC[cls]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let conn2_rect_diff_inner = prove_by_refinement( + `!E R. conn2 E /\ (E SUBSET edge) /\ rectagon R /\ R SUBSET E ==> + conn2 (E DIFF (E INTER par_cell F R))`, + (* {{{ proof *) + [ + REWRITE_TAC[conn2]; + TYPE_THEN `J = E INTER par_cell F R` ABBREV_TAC ; + SUBCONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + (* - *) + TYPE_THEN `R SUBSET E DIFF J` SUBAGOAL_TAC; + REWRITE_TAC[DIFF_SUBSET]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC [EMPTY_EXISTS;INTER]; + TYPE_THEN `J` UNABBREV_TAC; + THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[rectagon]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + TSPEC `u` 10; + THM_INTRO_TAC[`R`;`u`] curve_cell_edge; + FULL_REWRITE_TAC[rectagon]; + ASM_MESON_TAC[subset_imp]; + REWR 10; + (* -/ *) + THM_INTRO_TAC[`R`] conn2_rectagon; + CONJ_TAC; + THM_INTRO_TAC[`R`;`E DIFF J`] CARD_SUBSET; + FULL_REWRITE_TAC[conn2]; + UND 10 THEN UND 11 THEN ARITH_TAC; + TYPE_THEN `(E DIFF J) UNION J = E` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[DIFF;INTER;UNION]; + MESON_TAC[]; + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]); + UND 15 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + REWRITE_TAC[cls_union]; + REWRITE_TAC[UNION]; + (* -A *) + TYPE_THEN `S SUBSET E DIFF J` ASM_CASES_TAC; + TYPE_THEN `S` EXISTS_TAC; + TYPE_THEN `~(S INTER J = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `~(S = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end;segment;psegment]; + TYPE_THEN `S` UNABBREV_TAC ; + USE 20 (REWRITE_RULE[EMPTY_EXISTS]); + UND 20 THEN UND 19 THEN UND 18 THEN UND 17 THEN REWRITE_TAC[EQ_EMPTY;SUBSET;INTER;DIFF] THEN MESON_TAC[]; + (* -/ *) + THM_INTRO_TAC[`R`;`T`;`{(pointI a)}`] par_cell_cell_partition; + REWRITE_TAC[cell_rules]; + IMATCH_MP_TAC rectagon_segment; + TYPE_THEN `par_cell T R {(pointI a)} \/ cls R a` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[cls]; + USE 14 (REWRITE_RULE[DIFF]); + THM_INTRO_TAC[`R`;`F`;`a`;`e'`] par_cell_nbd; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `J` UNABBREV_TAC; + USE 14(REWRITE_RULE[INTER]); + ASM_MESON_TAC[]; + THM_INTRO_TAC[`R`;`a`]curve_cell_cls; + IMATCH_MP_TAC rectagon_segment; + ASM_MESON_TAC[]; + (* -B/ *) + KILL 20; + THM_INTRO_TAC[`R`;`T`;`{(pointI b)}`] par_cell_cell_partition; + REWRITE_TAC[cell_rules]; + IMATCH_MP_TAC rectagon_segment; + (* - *) + TYPE_THEN `par_cell T R {(pointI b)} \/ cls R b` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[cls]; + USE 25 (REWRITE_RULE[DIFF]); + THM_INTRO_TAC[`R`;`F`;`b`;`e`] par_cell_nbd; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `J` UNABBREV_TAC; + USE 25(REWRITE_RULE[INTER]); + ASM_MESON_TAC[]; + THM_INTRO_TAC[`R`;`b`]curve_cell_cls; + IMATCH_MP_TAC rectagon_segment; + ASM_MESON_TAC[]; + KILL 20; + KILL 18; + USE 19 (REWRITE_RULE [EMPTY_EXISTS;INTER]); + (* -C/ *) + TYPE_THEN `~cls J a \/ cls R a` SUBAGOAL_TAC; + UND 21 THEN DISCH_THEN DISJ_CASES_TAC; + DISJ1_TAC; + USE 21(REWRITE_RULE[cls]); + THM_INTRO_TAC[`R`;`T`;`a`;`e`] par_cell_nbd; + TYPE_THEN `J` UNABBREV_TAC; + USE 23(REWRITE_RULE[INTER]); + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `J` UNABBREV_TAC; + USE 23(REWRITE_RULE[INTER]); + THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; + USE 25(REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + (* -/ *) + TYPE_THEN `~cls J b \/ cls R b` SUBAGOAL_TAC; + UND 22 THEN DISCH_THEN DISJ_CASES_TAC; + DISJ1_TAC; + USE 23(REWRITE_RULE[cls]); + THM_INTRO_TAC[`R`;`T`;`b`;`e`] par_cell_nbd; + TYPE_THEN `J` UNABBREV_TAC; + USE 24(REWRITE_RULE[INTER]); + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `J` UNABBREV_TAC; + USE 24(REWRITE_RULE[INTER]); + THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; + USE 26(REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + (* -D/ *) + TYPE_THEN `!a b S'. (S' SUBSET S) /\ segment_end S' a b /\ (cls S' INTER cls (R UNION J) = {b}) ==> cls R b /\ (S' INTER (R UNION J) = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `S' INTER (R UNION J) = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 27 (REWRITE_RULE[INTER;UNION ]); + THM_INTRO_TAC[`u'`] two_endpoint; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + UND 28 THEN UND 31 THEN MESON_TAC[subset_imp]; + TYPE_THEN `!n. closure top2 u' (pointI n) ==> (n = b')` SUBAGOAL_TAC; + USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `n` 24; + USE 24 (REWRITE_RULE[INTER;INR IN_SING]); + USE 24 SYM; + TYPE_THEN `{u'} SUBSET S' /\ {u'} SUBSET (R UNION J)` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET;INR IN_SING;UNION ]; + USE 31(MATCH_MP cls_subset); + USE 32(MATCH_MP cls_subset); + FULL_REWRITE_TAC[cls_edge]; + FULL_REWRITE_TAC[SUBSET]; + USE 29 (REWRITE_RULE[has_size2]); + USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 31(REWRITE_RULE[INR in_pair]); + COPY 31; + TSPEC `a''` 32; + TSPEC `b''` 31; + REWR 31; + REWR 32; + UND 29 THEN REWRITE_TAC[]; + (* --E *) + PROOF_BY_CONTR_TAC; + TYPE_THEN `cls J b'` SUBAGOAL_TAC; + USE 24(ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 24(REWRITE_RULE[INTER;INR IN_SING]); + TSPEC `b'` 24; + USE 24(REWRITE_RULE[cls_union]); + USE 24(REWRITE_RULE[UNION]); + REWR 24; + (* --/ *) + TYPE_THEN`par_cell F R {(pointI b')}` SUBAGOAL_TAC; + THM_INTRO_TAC[`R`;`T`;`{(pointI b')}`] par_cell_cell_partition; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + REWRITE_TAC[cell_rules]; + UND 30 THEN REP_CASES_TAC; + USE 29 (REWRITE_RULE[cls]); + THM_INTRO_TAC[`R`;`e`;`{(pointI b')}`;`F`] par_cell_closure_cell; + REWRITE_TAC[cell_rules]; + REWRITE_TAC[SUBSET;INR IN_SING]; + TYPE_THEN `J` UNABBREV_TAC; + USE 31 (REWRITE_RULE[INTER]); + IMATCH_MP_TAC edge_cell; + UND 31 THEN UND 2 THEN MESON_TAC[subset_imp]; + FIRST_ASSUM DISJ_CASES_TAC ; + THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[rectagon]; + THM_INTRO_TAC[`R`;`b'`] curve_cell_cls; + IMATCH_MP_TAC rectagon_segment; + REWR 33; + THM_INTRO_TAC[`R`;`b'`] curve_cell_cls; + IMATCH_MP_TAC rectagon_segment; + REWR 30; + (* --/ *) + USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 24 (REWRITE_RULE[INR IN_SING;cls_union]); + TSPEC `b'` 24; + USE 24 (REWRITE_RULE[INTER;UNION]); + USE 31(REWRITE_RULE[cls]); + THM_INTRO_TAC[`R`;`F`;`b'`;`e`] par_cell_nbd; + USE 16 (REWRITE_RULE[segment_end;segment;psegment]); + UND 36 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + USE 27(REWRITE_RULE[EQ_EMPTY;INTER;UNION]); + TSPEC `e` 27; + UND 27 THEN ASM_REWRITE_TAC[]; + DISJ2_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[INTER]; + UND 17 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + (* -F *) + TYPE_THEN `?m. (cls R m /\ cls S m)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`R`;`S`] segment_in_comp; + FULL_REWRITE_TAC[segment_end;psegment]; + LEFT 25 "m" ; + CONJ_TAC; + PROOF_BY_CONTR_TAC; + USE 28(REWRITE_RULE[EMPTY_EXISTS;INTER ]); + THM_INTRO_TAC[`u'`] two_endpoint; + UND 29 THEN UND 17 THEN UND 2 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + USE 30(REWRITE_RULE[has_size2]); + USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `a'` 31; + USE 31(REWRITE_RULE[INR in_pair]); + TSPEC `a'` 25; + USE 25(REWRITE_RULE[cls]); + ASM_MESON_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `EMPTY:((int#int)->bool)` EXISTS_TAC; + REWRITE_TAC[SUBSET_EMPTY;EQ_EMPTY;INTER;]; + TSPEC `x` 25; + UND 25 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `eps = T` ASM_CASES_TAC ; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; + USE 27(REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u` 27; + USE 26(REWRITE_RULE[SUBSET]); + TYPE_THEN`J` UNABBREV_TAC; + USE 18 (REWRITE_RULE[INTER]); + UND 6 THEN UND 26 THEN UND 27 THEN UND 19 THEN MESON_TAC[]; + TYPE_THEN `eps = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 27; + TYPE_THEN `eps` UNABBREV_TAC; + USE 16 (REWRITE_RULE[segment_end]); + THM_INTRO_TAC[`S`;`a`] terminal_endpoint; + USE 16 (REWRITE_RULE[FUN_EQ_THM]); + TSPEC `a` 16; + FULL_REWRITE_TAC[psegment;segment;INR in_pair]; + TYPE_THEN `e = terminal_edge S a` ABBREV_TAC ; + USE 20 (REWRITE_RULE[cls]); + FIRST_ASSUM DISJ_CASES_TAC; + LEFT 31 "e"; + TSPEC `e` 31; + TYPE_THEN `J` UNABBREV_TAC; + USE 31(REWRITE_RULE[INTER]); + UND 6 THEN ASM_REWRITE_TAC[]; + UND 29 THEN UND 26 THEN UND 17 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + LEFT 25 "m"; + TSPEC `a` 25; + USE 25 (REWRITE_RULE[cls]); + KILL 24; + ASM_MESON_TAC[]; + (* -G/ *) + TYPE_THEN `conn2 R` SUBAGOAL_TAC; + USE 27(REWRITE_RULE[conn2]); + TSPEC `m` 27; + LEFT 27 "c"; + TSPEC `c` 27; + (* - a case *) + TYPE_THEN `(~(a = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' a m /\ ~cls S' c)` SUBAGOAL_TAC; + TYPE_THEN `cls R a` ASM_CASES_TAC; + UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`a`]); + KILL 24; + ASM_MESON_TAC[]; + TYPE_THEN `S'` EXISTS_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `R` EXISTS_TAC; + (* -- *) + TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' a m` SUBAGOAL_TAC; + TYPE_THEN `m = b` ASM_CASES_TAC; + TYPE_THEN `S` EXISTS_TAC; + REWRITE_TAC[SUBSET_REFL]; + THM_INTRO_TAC[`S`;`a`;`b`;`m`] cut_psegment; + TYPE_THEN `A` EXISTS_TAC; + REWRITE_TAC[SUBSET_UNION]; + THM_INTRO_TAC[`R UNION J`;`S'`;`a`;`m`] segment_end_select; + REWRITE_TAC[cls_union;union_subset]; + ASM_REWRITE_TAC[UNION]; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + REWR 20; + CONJ_TAC; + FULL_REWRITE_TAC [rectagon]; + TYPE_THEN `J` UNABBREV_TAC; + UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[]; + (* -- *) + UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`c'`;`B`]); + UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + TYPE_THEN `c' = m` ASM_CASES_TAC; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); + UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; + TYPE_THEN `c'` UNABBREV_TAC; + TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + UND 39 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + (* -- *) + TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC; + CONJ_TAC; + USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); + UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; + TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + UND 41 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + (* -- *) + UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]); + CONJ_TAC; + TYPE_THEN `c'` UNABBREV_TAC; + USE 37(MATCH_MP segment_end_cls2); + UND 40 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `c` UNABBREV_TAC; + USE 32 (MATCH_MP segment_end_cls2); + TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + UND 25 THEN UND 3 THEN MESON_TAC[]; + USE 42 (ONCE_REWRITE_RULE[segment_end_symm]); + (* -- *) + TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `R` EXISTS_TAC; + THM_INTRO_TAC[`B`;`S''`;`a`;`c'`;`m`] segment_end_trans; + TYPE_THEN `U` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `B UNION S''` EXISTS_TAC; + REWRITE_TAC[union_subset]; + TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USE 48(REWRITE_RULE[cls_union]); + UND 48 THEN UND 47 THEN UND 40 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; + (* -H *) + TYPE_THEN `(~(b = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' b m /\ ~cls S' c)` SUBAGOAL_TAC; + TYPE_THEN `cls R b` ASM_CASES_TAC; + UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`b`]); + KILL 24; + ASM_MESON_TAC[]; + TYPE_THEN `S'` EXISTS_TAC; + USE 33(ONCE_REWRITE_RULE[segment_end_symm]); + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `R` EXISTS_TAC; + (* -- *) + TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' b m` SUBAGOAL_TAC; + TYPE_THEN `m = a` ASM_CASES_TAC; + TYPE_THEN `S` EXISTS_TAC; + REWRITE_TAC[SUBSET_REFL]; + USE 16 (ONCE_REWRITE_RULE[segment_end_symm]); + THM_INTRO_TAC[`S`;`b`;`a`;`m`] cut_psegment; + USE 16 (ONCE_REWRITE_RULE[segment_end_symm]); + TYPE_THEN `A` EXISTS_TAC; + REWRITE_TAC[SUBSET_UNION]; + (* -- *) + THM_INTRO_TAC[`R UNION J`;`S'`;`b`;`m`] segment_end_select; + REWRITE_TAC[cls_union;union_subset]; + ASM_REWRITE_TAC[UNION]; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + REWR 23; + CONJ_TAC; + FULL_REWRITE_TAC [rectagon]; + TYPE_THEN `J` UNABBREV_TAC; + UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[]; + (* -- *) + UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`b`;`c'`;`B`]); + UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + TYPE_THEN `c' = m` ASM_CASES_TAC; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); + UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; + TYPE_THEN `c'` UNABBREV_TAC; + TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + UND 40 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + (* -- *) + TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC; + CONJ_TAC; + USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]); + UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; + TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + UND 42 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[]; + (* -- *) + UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]); + CONJ_TAC; + TYPE_THEN `c'` UNABBREV_TAC; + USE 38(MATCH_MP segment_end_cls2); + UND 41 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `c` UNABBREV_TAC; + USE 33 (MATCH_MP segment_end_cls2); + TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + UND 25 THEN UND 3 THEN MESON_TAC[]; + (* -- *) + TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `R` EXISTS_TAC; + THM_INTRO_TAC[`B`;`S''`;`b`;`c'`;`m`] segment_end_trans; + ONCE_REWRITE_TAC[segment_end_symm]; + TYPE_THEN `U` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `B UNION S''` EXISTS_TAC; + REWRITE_TAC[union_subset]; + TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USE 49(REWRITE_RULE[cls_union]); + UND 49 THEN UND 48 THEN UND 41 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; + (* -I *) + TYPE_THEN `b = m` ASM_CASES_TAC; + TYPE_THEN`m` UNABBREV_TAC; + TYPE_THEN `a = m` ASM_CASES_TAC; + TYPE_THEN `m` UNABBREV_TAC; + TYPE_THEN `S'` EXISTS_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`S''`;`S'`;`a`;`m`;`b`] segment_end_trans; + ONCE_REWRITE_TAC[segment_end_symm]; + TYPE_THEN `U` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `S'' UNION S'` EXISTS_TAC; + REWRITE_TAC[union_subset]; + TYPE_THEN `cls U SUBSET cls (S'' UNION S')` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USE 41(REWRITE_RULE[SUBSET;cls_union]); + UND 41 THEN UND 40 THEN UND 30 THEN UND 33 THEN REWRITE_TAC[UNION] THEN MESON_TAC[]; + (* Sat Dec 4 18:57:41 EST 2004 *) + + ]);; + (* }}} *) + +let conn2_psegment_triple = prove_by_refinement( + `!E. conn2 E /\ (E SUBSET edge) /\ + ~(rectagon E) ==> (?A B C. psegment_triple A B C + /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\ + A SUBSET par_cell F (B UNION C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?A B C. psegment_triple A B C /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E)` BACK_TAC; + THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + USE 6 (MATCH_MP psegment_triple3); + USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]); + ASM_MESON_TAC[]; + USE 6 (MATCH_MP psegment_triple2); + USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]); + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`E`] conn2_has_rectagon; + THM_INTRO_TAC[`E`;`B`] conn2_proper; + CONJ_TAC; + IMATCH_MP_TAC conn2_rectagon; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`A`] endpoint_size2; + FULL_REWRITE_TAC[has_size2]; + THM_INTRO_TAC[`B`;`a`;`b`] cut_rectagon_cls; + REWR 5; + USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 5 (REWRITE_RULE[INTER;INR in_pair]); + ASM_MESON_TAC[]; + TYPE_THEN `C = A'` ABBREV_TAC ; + TYPE_THEN `A'` UNABBREV_TAC; + TYPE_THEN`A` EXISTS_TAC; + TYPE_THEN `B` UNABBREV_TAC; + TYPE_THEN `B'` EXISTS_TAC; + TYPE_THEN `C` EXISTS_TAC; + REWRITE_TAC[psegment_triple]; + TYPE_THEN `psegment B' /\ psegment C` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + TYPE_THEN`(A INTER B' = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + USE 5 (REWRITE_RULE[cls_union]); + FULL_REWRITE_TAC[UNION_OVER_INTER;]; + TYPE_THEN `(endpoint B' = {a,b}) /\ (endpoint C = {a,b})` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + TYPE_THEN `(cls A INTER cls B' = {a, b}) /\ (cls A INTER cls C = {a, b})` SUBAGOAL_TAC; + TYPE_THEN `endpoint A` UNABBREV_TAC; + + USE 10 (REWRITE_RULE[FUN_EQ_THM]); + USE 5 (REWRITE_RULE[INTER;UNION;INR in_pair]); + CONJ_TAC THEN IMATCH_MP_TAC EQ_EXT THEN REWRITE_TAC[INTER;INR in_pair]; + ASM_MESON_TAC[segment_end_cls;segment_end_cls2]; + ASM_MESON_TAC[segment_end_cls;segment_end_cls2]; + (* - *) + FULL_REWRITE_TAC[UNION_COMM]; + (* - *) + TYPE_THEN`segment_end A a b` SUBAGOAL_TAC; + REWRITE_TAC[segment_end]; + CONJ_TAC ; + ASM_MESON_TAC[segment_end_union_rectagon;segment_end_symm;INTER_COMM;UNION_COMM]; + ASM_MESON_TAC[union_subset]; + ]);; + (* }}} *) + +let rectagon_surround_conn2 = prove_by_refinement( + `!G. conn2 G /\ G SUBSET edge ==> + (?C. rectagon C /\ C SUBSET G /\ + (!x. bounded_set G x ==> bounded_set C x))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `EE = {C | conn2 C /\ (C SUBSET G) /\ (!x. bounded_set G x ==> bounded_set C x)}` ABBREV_TAC ; + TYPE_THEN `EE G` SUBAGOAL_TAC; + TYPE_THEN `EE` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + THM_INTRO_TAC[`EE`] select_card_min; + UND 4 THEN REWRITE_TAC[EMPTY_EXISTS]; + ASM_MESON_TAC[]; + TYPE_THEN `C = z` ABBREV_TAC ; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `rectagon C` BACK_TAC ; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `EE` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `!R. rectagon R /\ R SUBSET C ==> (C INTER par_cell F R = EMPTY)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `J = (C INTER par_cell F R )` ABBREV_TAC ; + TYPE_THEN `EE (C DIFF J)` SUBAGOAL_TAC; + TYPE_THEN `EE` UNABBREV_TAC; + CONJ_TAC; + TYPE_THEN `J` UNABBREV_TAC; + IMATCH_MP_TAC conn2_rect_diff_inner; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + TSPEC `x` 2; + THM_INTRO_TAC[`C`;`C`;`R`;`J`;`x`] star_avoidance_contrp; + REWRITE_TAC[SUBSET_REFL]; + (* --- *) + TYPE_THEN `FINITE G` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + TYPE_THEN `J SUBSET G` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + UND 3 THEN REWRITE_TAC[SUBSET;INTER] THEN MESON_TAC[]; + TYPE_THEN `FINITE C /\ FINITE J` SUBAGOAL_TAC; + CONJ_TAC THEN IMATCH_MP_TAC FINITE_SUBSET THEN ASM_MESON_TAC[]; + TYPE_THEN `C SUBSET edge /\ J SUBSET edge` SUBAGOAL_TAC; + CONJ_TAC THEN IMATCH_MP_TAC SUBSET_TRANS THEN ASM_MESON_TAC[]; + TYPE_THEN `J SUBSET par_cell F R` SUBAGOAL_TAC; + TYPE_THEN`J` UNABBREV_TAC; + REWRITE_TAC[INTER;SUBSET]; + TYPE_THEN `~(UNIONS (curve_cell G) x)` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`;`x`] bounded_subset_unions; + USE 22(REWRITE_RULE[ctop_unions;DIFF ]); + ASM_MESON_TAC[]; + TYPE_THEN `!A. A SUBSET G ==> UNIONS (curve_cell A) SUBSET UNIONS(curve_cell G)` SUBAGOAL_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + IMATCH_MP_TAC curve_cell_imp_subset; + ASM_MESON_TAC[subset_imp]; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`C DIFF J`]); + USE 4(MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); + UND 4 THEN ASM_REWRITE_TAC[]; + IMATCH_MP_TAC card_subset_lt; + CONJ_TAC; + REWRITE_TAC[DIFF;SUBSET]; + CONJ_TAC; + TYPE_THEN `J` UNABBREV_TAC; + USE 9(REWRITE_RULE[EMPTY_EXISTS]); + USE 4 (REWRITE_RULE[diff_unchange]); + USE 4(REWRITE_RULE[EQ_EMPTY]); + FULL_REWRITE_TAC[INTER]; + ASM_MESON_TAC[]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + FULL_REWRITE_TAC[conn2]; + TYPE_THEN `EE` UNABBREV_TAC; + (* -A *) + THM_INTRO_TAC[`C`] conn2_psegment_triple; + TYPE_THEN `EE` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + ASM_MESON_TAC[]; + TSPEC `(B UNION C')` 7; + UND 7 THEN DISCH_THEN (THM_INTRO_TAC[]); + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + REWRITE_TAC[union_subset]; + UND 7 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `A` UNABBREV_TAC; + USE 25 (REWRITE_RULE[psegment;segment]); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let curve_cell_subset = prove_by_refinement( + `!H G. (H SUBSET G) ==> + UNIONS (curve_cell H) SUBSET UNIONS (curve_cell G)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + TYPE_THEN `G = H UNION (G DIFF H)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + UND 0 THEN REWRITE_TAC[SUBSET;UNION;DIFF] THEN MESON_TAC[]; + UND 1 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + REWRITE_TAC[curve_cell_union]; + REWRITE_TAC[SUBSET;UNION]; + ]);; + (* }}} *) + +let bounded_set_curve_cell_empty = prove_by_refinement( + `!H G x. bounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`H`;`G`]curve_cell_subset; + THM_INTRO_TAC[`G`] bounded_unbounded_union; + USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 4; + USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]); + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let unbounded_set_curve_cell_empty = prove_by_refinement( + `!H G x. unbounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`H`;`G`]curve_cell_subset; + THM_INTRO_TAC[`G`] bounded_unbounded_union; + USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `x` 4; + USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]); + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let bounded_triple_avoidance = prove_by_refinement( + `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) ==> + bounded_set (A UNION B UNION C) SUBSET bounded_set (B UNION C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance_lemma1; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[FINITE_UNION;union_subset]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment;segment]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[psegment;segment]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + THM_INTRO_TAC[`A`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; + REWRITE_TAC[SUBSET;UNION]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; + REWRITE_TAC[SUBSET_REFL ]; + ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + IMATCH_MP_TAC EQ_EXT; + UND 10 THEN UND 11 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION;DIFF] THEN MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + REWR 6; + REWR 6; + (* - *) + THM_INTRO_TAC[`A`;`B`;`C`;`x`] unbounded_triple_avoidance; + THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj; + FULL_REWRITE_TAC[INTER;EQ_EMPTY ]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let bounded_euclid = prove_by_refinement( + `!G x. bounded_set G x ==> euclid 2 x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0(MATCH_MP bounded_subset_unions); + FULL_REWRITE_TAC[ctop_unions;DIFF ]; + ]);; + (* }}} *) + +let unbounded_euclid = prove_by_refinement( + `!G x. unbounded_set G x ==> euclid 2 x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0(MATCH_MP unbounded_subset_unions); + FULL_REWRITE_TAC[ctop_unions;DIFF ]; + ]);; + (* }}} *) + +let bounded_triple_inner_union = prove_by_refinement( + `!A B C. psegment_triple A B C ==> bounded_set (A UNION B UNION C) + SUBSET (bounded_set (A UNION B) UNION bounded_set (B UNION C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`A`;`B`] trap_odd_cell; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple3; + UND 1 THEN REP_CASES_TAC; + THM_INTRO_TAC[`C`;`A`;`B`] bounded_triple_avoidance; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple3; + FULL_REWRITE_TAC[UNION_ACI;]; + IMATCH_MP_TAC in_union; + THM_INTRO_TAC[`A`;`B`;`C`] bounded_triple_avoidance; + FULL_REWRITE_TAC[UNION_ACI;]; + IMATCH_MP_TAC in_union; + (* - *) + REWRITE_TAC[SUBSET]; + ONCE_REWRITE_TAC[UNION]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + THM_INTRO_TAC[`B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; + REWRITE_TAC[UNION;SUBSET]; + THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty; + REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[]; + TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; + ASM_MESON_TAC[bounded_euclid]; + THM_INTRO_TAC[`A UNION B`] bounded_unbounded_union; + USE 8(ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 8(REWRITE_RULE[ctop_unions;DIFF]); + TSPEC `x` 8; + TYPE_THEN `R = A UNION B` ABBREV_TAC ; + USE 8(REWRITE_RULE[UNION]); + REWR 8; + TYPE_THEN `R` UNABBREV_TAC; + (* -A *) + THM_INTRO_TAC[`B UNION C`] bounded_unbounded_union; + USE 9(ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 9(REWRITE_RULE[ctop_unions;DIFF]); + TSPEC `x` 9; + TYPE_THEN `R = B UNION C` ABBREV_TAC ; + USE 9(REWRITE_RULE[UNION]); + REWR 9; + TYPE_THEN `R'` UNABBREV_TAC; + KILL 5; + KILL 6; + KILL 3; + KILL 4; + (* - *) + THM_INTRO_TAC[`x`] point_onto; + TYPE_THEN `x` UNABBREV_TAC; + THM_INTRO_TAC[`p`] cell_unions; + USE 3(REWRITE_RULE[UNIONS]); + THM_INTRO_TAC[`B UNION C`] unbounded_even; + FULL_REWRITE_TAC[psegment_triple]; + REWR 9; + KILL 5; + THM_INTRO_TAC[`par_cell T (B UNION C)`;`u`;`point p`] cell_ununion; + REWRITE_TAC[par_cell_cell]; + KILL 6; + (* - *) + THM_INTRO_TAC[`A UNION B`] unbounded_even; + FULL_REWRITE_TAC[psegment_triple]; + REWR 8; + KILL 6; + THM_INTRO_TAC[`par_cell T (A UNION B)`;`u`;`point p`] cell_ununion; + REWRITE_TAC[par_cell_cell]; + KILL 8; + (* - *) + TYPE_THEN `unbounded_set (A UNION B UNION C) (point p)` ASM_CASES_TAC; + THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* -B *) + TYPE_THEN `~unbounded_set (B UNION C UNION A) (point p)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[UNION_ACI]; + ASM_MESON_TAC[]; + UND 9 THEN REWRITE_TAC[]; + IMATCH_MP_TAC unbounded_triple_avoidance; + CONJ_TAC; + IMATCH_MP_TAC psegment_triple3; + (* - *) + FULL_REWRITE_TAC[UNION_ACI]; + KILL 8; + KILL 2; + THM_INTRO_TAC[`A UNION C`] unbounded_even; + FULL_REWRITE_TAC[psegment_triple]; + REWRITE_TAC[UNIONS]; + TYPE_THEN `u` EXISTS_TAC; + KILL 2; + (* - *) + THM_INTRO_TAC[`A UNION B`;`u`;`T`] parity_unique; + IMATCH_MP_TAC rectagon_segment; + FULL_REWRITE_TAC[psegment_triple]; + THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique; + IMATCH_MP_TAC rectagon_segment; + FULL_REWRITE_TAC[psegment_triple]; + (* - *) + TYPE_THEN `!A B. rectagon (A UNION B) /\ par_cell T (A UNION B) u ==> ~curve_cell A u` SUBAGOAL_TAC; + THM_INTRO_TAC[`A' UNION B'`;`T`] par_cell_curve_cell_disj; + FULL_REWRITE_TAC[rectagon]; + UND 12 THEN ASM_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `u` EXISTS_TAC; + REWRITE_TAC[INTER]; + THM_INTRO_TAC[`A'`;`A' UNION B'`] curve_cell_imp_subset; + REWRITE_TAC[SUBSET;UNION]; + ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `~curve_cell A u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; + TYPE_THEN `B` EXISTS_TAC; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + TYPE_THEN `~curve_cell B u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; + TYPE_THEN `A` EXISTS_TAC; + REWRITE_TAC[UNION_ACI]; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + TYPE_THEN `~curve_cell C u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; + TYPE_THEN `B` EXISTS_TAC; + REWRITE_TAC[UNION_ACI]; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + (* -C *) + THM_INTRO_TAC[`A`;`B`;`u`] parity_union; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + IMATCH_MP_TAC rectagon_segment; + REWR 13; + (* - *) + THM_INTRO_TAC[`B`;`C`;`u`] parity_union; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + IMATCH_MP_TAC rectagon_segment; + REWR 14; + (* - *) + TYPE_THEN `parity A u = parity C u` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 13; + KILL 14; + THM_INTRO_TAC[`A`;`C`;`u`] parity_union; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + IMATCH_MP_TAC rectagon_segment; + REWR 13; + TYPE_THEN `parity (A UNION C) u = T` SUBAGOAL_TAC; + USE 14 SYM; + IMATCH_MP_TAC parity; + REWRITE_TAC[curve_cell_union]; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple;psegment;]; + IMATCH_MP_TAC rectagon_segment; + USE 16(REWRITE_RULE[UNION]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION W *) +(* ------------------------------------------------------------------ *) + + +(* back to the K3 graph *) + +let rectagon_graph = jordan_def + `rectagon_graph G <=> + graph G /\ + graph_edge G SUBSET psegment /\ + (!e. graph_edge G e ==> (graph_inc G e = endpoint e)) /\ + (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> + (e INTER e' = EMPTY)) /\ + (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> + (cls e INTER cls e' = endpoint e INTER endpoint e'))`;; + +let rectagonal_graph = jordan_def + `rectagonal_graph (G:(A,B)graph_t) <=> + (?H. rectagon_graph H /\ graph_isomorphic H G)`;; + +let k33_rectagon_hyp = jordan_def + `k33_rectagon_hyp R f <=> rectagon R /\ + (!(i:three_t) j. ~(i = j) ==> (cls (f i) INTER (cls (f j)) = EMPTY)) /\ + (!i j. ~(i = j) ==> ((f i) INTER (f j) = EMPTY)) /\ + (!i. ?A B. (R = A UNION B) /\ psegment_triple A B (f i) /\ + (!j. ~(cls (f j) INTER cls A = EMPTY) /\ + ~(cls (f j) INTER cls B = EMPTY)) /\ + (!j. ~(i = j) ==> (cls (f j) INTER cls A INTER cls B = EMPTY)))`;; + +let k33_rectagon_two_even = prove_by_refinement( + `!R f i. k33_rectagon_hyp R f /\ + f i SUBSET par_cell F R ==> + (!j. ~(j = i) ==> (f j SUBSET par_cell T R))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + FULL_REWRITE_TAC [k33_rectagon_hyp]; + COPY 2; + TSPEC `i` 2; + TYPE_THEN `R` UNABBREV_TAC; + (* - *) + THM_INTRO_TAC[`f i`;`A`;`B`] outer_segment_even; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple3; + THM_INTRO_TAC[`f i`;`B`;`A`] outer_segment_even; + FULL_REWRITE_TAC[UNION_ACI]; + IMATCH_MP_TAC psegment_triple2; + (* - *) + TSPEC `j` 7; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 7 (REWRITE_RULE[INTER]); + USE 11(REWRITE_RULE[INTER]); + (* -A *) + THM_INTRO_TAC[`f i UNION A`;`B`;`f j`;`u`;`T`] meeting_lemma; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + CONJ_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + TSPEC `j` 6; + REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC; + CONJ_TAC; + USE 42 SYM; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[cls_union]; + (* -- *) + TSPEC `j` 2; + REWR 2; + USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u` 2; + REWR 2; + COPY 4; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + TYPE_THEN `i` UNABBREV_TAC; + USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); + TSPEC `u` 4; + REWR 4; + (* -- *) + TYPE_THEN `B SUBSET edge` SUBAGOAL_TAC; + USE 8 (REWRITE_RULE[psegment_triple]); + USE 26(REWRITE_RULE[psegment;segment]); + (* -- *) + TYPE_THEN `segment (f j)` SUBAGOAL_TAC; + TSPEC `j` 6; + USE 17 (REWRITE_RULE[psegment_triple]); + FULL_REWRITE_TAC[psegment]; + (* -- *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + USE 17 (REWRITE_RULE[UNION]); + REWR 17; + (* -- *) + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + CONJ_TAC; + UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + TYPE_THEN `j` UNABBREV_TAC; + (* -- *) + TSPEC `j` 6; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + USE 19 SYM; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;UNION]; + USE 18(REWRITE_RULE[psegment_triple]); + REWRITE_TAC[cls_union;UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint (f j)` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + (* -B *) + THM_INTRO_TAC[`f i UNION B`;`A`;`f j`;`u'`;`T`] meeting_lemma; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + CONJ_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + TSPEC `j` 6; + REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC; + CONJ_TAC; + USE 43 SYM; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[cls_union]; + (* -- *) + TSPEC `j` 2; + REWR 2; + USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u'` 2; + REWR 2; + COPY 4; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + TYPE_THEN `i` UNABBREV_TAC; + USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); + TSPEC `u'` 4; + REWR 4; + (* -- *) + TYPE_THEN `A SUBSET edge` SUBAGOAL_TAC; + USE 8 (REWRITE_RULE[psegment_triple]); + USE 28(REWRITE_RULE[psegment;segment]); + (* -- *) + TYPE_THEN `segment (f j)` SUBAGOAL_TAC; + TSPEC `j` 6; + USE 18 (REWRITE_RULE[psegment_triple]); + FULL_REWRITE_TAC[psegment]; + (* -- *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + USE 18 (REWRITE_RULE[UNION]); + REWR 18; + (* -- *) + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + CONJ_TAC; + UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + TYPE_THEN `j` UNABBREV_TAC; + (* -- *) + TSPEC `j` 6; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + USE 20 SYM; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;UNION]; + USE 19(REWRITE_RULE[psegment_triple]); + REWRITE_TAC[cls_union;UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint (f j)` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + (* -C *) + IMATCH_MP_TAC par_cell_even_imp; + TYPE_THEN `f i` EXISTS_TAC; + FULL_REWRITE_TAC[UNION_ACI]; + CONJ_TAC; + TSPEC `j` 6; + USE 17 (REWRITE_RULE [psegment_triple]); + USE 29(REWRITE_RULE[psegment]); + (* - *) + CONJ_TAC; + TSPEC `j` 6; + FULL_REWRITE_TAC[psegment_triple]; + REWRITE_TAC[cls_union ;]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint A'` UNABBREV_TAC; + TYPE_THEN `endpoint B'` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + TYPE_THEN `j` UNABBREV_TAC; + (* - *) + TSPEC `j` 6; + UND 17 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC)); + TYPE_THEN `!C. C SUBSET (A' UNION B') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + FULL_REWRITE_TAC[SUBSET;UNION ]; + ASM_MESON_TAC[]; + USE 1 SYM; + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION]; + ]);; + (* }}} *) + +let psegment_triple_odd_even = prove_by_refinement( + `!A B C. psegment_triple A B C /\ C SUBSET par_cell T (A UNION B) ==> + (?A' B'. psegment_triple A' B' C /\ C SUBSET par_cell T (A' UNION B') + /\ A' SUBSET par_cell F (B' UNION C) + /\ B' SUBSET par_cell T (A' UNION C) + /\ (A UNION B = A' UNION B') + /\ (cls A INTER cls B = cls A' INTER cls B') /\ + (!P. (P A /\ P B ) ==> P A' /\ P B'))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `A SUBSET par_cell F (B UNION C)` ASM_CASES_TAC; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC outer_segment_even; + FULL_REWRITE_TAC[UNION_COMM]; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple2; + THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell; + UND 3 THEN REP_CASES_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `A` EXISTS_TAC; + FULL_REWRITE_TAC[UNION_COMM;INTER_COMM;]; + CONJ_TAC; + IMATCH_MP_TAC psegment_triple3; + IMATCH_MP_TAC psegment_triple2; + IMATCH_MP_TAC outer_segment_even; + FULL_REWRITE_TAC[UNION_COMM]; + IMATCH_MP_TAC psegment_triple3; + (* - *) + TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + TYPE_THEN `C` UNABBREV_TAC; + USE 15 (REWRITE_RULE[psegment;segment]); + (* - *) + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let k33_rectagon_two_odd = prove_by_refinement( + `!R f i. k33_rectagon_hyp R f /\ + f i SUBSET par_cell T R ==> + (!j. ~(j = i) ==> (f j SUBSET par_cell F R))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + FULL_REWRITE_TAC [k33_rectagon_hyp]; + COPY 2; + TSPEC `i` 2; + TYPE_THEN `R` UNABBREV_TAC; + (* - *) + THM_INTRO_TAC[`A`;`B`;`f i`] psegment_triple_odd_even; + TYPE_THEN `A UNION B` UNABBREV_TAC; + TYPE_THEN `cls A INTER cls B` UNABBREV_TAC; + TYPE_THEN `!j. ~(cls (f j) INTER cls A' = {}) /\ ~(cls (f j) INTER cls B' = {})` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + KILL 7; (* 7 -> 10 *) + KILL 9; + KILL 8; + (* - *) + TSPEC `j` 10; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + USE 7 (REWRITE_RULE[INTER]); + USE 8(REWRITE_RULE[INTER]); + (* -A *) + THM_INTRO_TAC[`f i UNION A'`;`B'`;`f j`;`u`;`T`] meeting_lemma; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[UNION_COMM]; + CONJ_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + TSPEC `j` 6; + FULL_REWRITE_TAC[UNION_COMM]; + REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC; + CONJ_TAC; + USE 43 SYM; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[cls_union]; + (* -- *) + TSPEC `j` 2; + REWR 2; + USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u` 2; + REWR 2; + COPY 4; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + TYPE_THEN `i` UNABBREV_TAC; + USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); + TSPEC `u` 4; + REWR 4; + (* -- *) + TYPE_THEN `B' SUBSET edge` SUBAGOAL_TAC; + USE 15 (REWRITE_RULE[psegment_triple]); + USE 27(REWRITE_RULE[psegment;segment]); + (* -- *) + TYPE_THEN `segment (f j)` SUBAGOAL_TAC; + TSPEC `j` 6; + USE 18 (REWRITE_RULE[psegment_triple]); + FULL_REWRITE_TAC[psegment]; + (* -- *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + USE 18 (REWRITE_RULE[UNION]); + REWR 18; + (* -- *) + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + TYPE_THEN `j` UNABBREV_TAC; + (* -- *) + TSPEC `j` 6; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + USE 20 SYM; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;UNION]; + USE 19(REWRITE_RULE[psegment_triple]); + REWRITE_TAC[cls_union;UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint (f j)` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + (* -B *) + THM_INTRO_TAC[`f i UNION B'`;`A'`;`f j`;`u'`;`F`] meeting_lemma; + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[UNION_COMM]; + CONJ_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` UNABBREV_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[UNION_COMM]; + TSPEC `j` 6; + REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC; + CONJ_TAC; + USE 44 SYM; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;UNION]; + REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[cls_union]; + (* -- *) + TSPEC `j` 2; + REWR 2; + USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u'` 2; + REWR 2; + COPY 4; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + TYPE_THEN `i` UNABBREV_TAC; + USE 4(REWRITE_RULE [EQ_EMPTY;INTER]); + TSPEC `u'` 4; + REWR 4; + (* -- *) + TYPE_THEN `A' SUBSET edge` SUBAGOAL_TAC; + USE 15 (REWRITE_RULE[psegment_triple]); + USE 29(REWRITE_RULE[psegment;segment]); + (* -- *) + TYPE_THEN `segment (f j)` SUBAGOAL_TAC; + TSPEC `j` 6; + USE 19 (REWRITE_RULE[psegment_triple]); + FULL_REWRITE_TAC[psegment]; + (* -- *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + USE 19 (REWRITE_RULE[UNION]); + REWR 19; + (* -- *) + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + UND 16 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + TYPE_THEN `j` UNABBREV_TAC; + (* -- *) + TSPEC `j` 6; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + REWRITE_TAC[SUBSET_REFL]; + USE 21 SYM; + IMATCH_MP_TAC cls_subset; + REWRITE_TAC[SUBSET;UNION]; + USE 20(REWRITE_RULE[psegment_triple]); + REWRITE_TAC[cls_union;UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint (f j)` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + (* -C *) + IMATCH_MP_TAC par_cell_odd_imp; + TYPE_THEN `f i` EXISTS_TAC; + FULL_REWRITE_TAC[UNION_ACI]; + CONJ_TAC; + TSPEC `j` 6; + USE 18 (REWRITE_RULE [psegment_triple]); + USE 30(REWRITE_RULE[psegment]); + (* - *) + CONJ_TAC; + TSPEC `j` 6; + FULL_REWRITE_TAC[psegment_triple]; + REWRITE_TAC[cls_union ;]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint A''` UNABBREV_TAC; + TYPE_THEN `endpoint B''` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + TYPE_THEN `j` UNABBREV_TAC; + (* - *) + TSPEC `j` 6; + UND 19 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC)); + TYPE_THEN `!C. C SUBSET (A'' UNION B'') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[psegment_triple]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + FULL_REWRITE_TAC[SUBSET;UNION ]; + ASM_MESON_TAC[]; + USE 0 SYM; + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION]; + ]);; + (* }}} *) + +let ABS3_012 = prove_by_refinement( + `(REP3 (ABS3 0) = 0) /\ (REP3(ABS3 1) = 1) /\ (REP3(ABS3 2) = 2)`, + (* {{{ proof *) + [ + ASSUME_TAC three_t; + USE 0(ONCE_REWRITE_RULE[EQ_SYM_EQ]); + ARITH_TAC; + ]);; + (* }}} *) + +let three_t_not_sing = prove_by_refinement( + `!i. ?(j:three_t). ~(i = j)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `i = ABS3 0` ASM_CASES_TAC; + TYPE_THEN `ABS3 1` EXISTS_TAC; + USE 1(AP_TERM `REP3`); + FULL_REWRITE_TAC[ABS3_012]; + UND 1 THEN ARITH_TAC; + TYPE_THEN `ABS3 0` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let ABS3_onto = prove_by_refinement( + `!(i:three_t). ?j. (i = ABS3 j) /\ (j < 3)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `REP3 i` EXISTS_TAC; + REWRITE_TAC[BETA_RULE three_t]; + ]);; + (* }}} *) + +let three_t_eq = prove_by_refinement( + `!i j. (i = j) <=> (REP3 i = REP3 j)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + DISCH_TAC; + USE 0(AP_TERM `ABS3`); + FULL_REWRITE_TAC[three_t]; + ]);; + (* }}} *) + +let rep3_lt = prove_by_refinement( + `!i. (REP3 i < 3)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[BETA_RULE three_t]; + ]);; + (* }}} *) + +let three_t_not_pair = prove_by_refinement( + `!i j. ?(k:three_t). ~(k = i) /\ ~(k = j)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[three_t_eq]; + TYPE_THEN `?k'. (k' < 3) /\ ~(k' = REP3 i) /\ ~(k' = REP3 j)` SUBAGOAL_TAC; + TYPE_THEN ` ~(0 = REP3 i) /\ ~(0 = REP3 j)` ASM_CASES_TAC; + ASM_MESON_TAC[ARITH_RULE `0 < 3`]; + TYPE_THEN ` ~(1 = REP3 i) /\ ~(1 = REP3 j)` ASM_CASES_TAC; + ASM_MESON_TAC[ARITH_RULE `1 < 3`]; + TYPE_THEN ` ~(2 = REP3 i) /\ ~(2 = REP3 j)` ASM_CASES_TAC; + ASM_MESON_TAC[ARITH_RULE `2 < 3`]; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + PROOF_BY_CONTR_TAC; + UND 0 THEN UND 1 THEN UND 2 THEN ARITH_TAC; + TYPE_THEN` ABS3 k'` EXISTS_TAC; + ASM_MESON_TAC [BETA_RULE three_t]; + ]);; + (* }}} *) + +let bool_size = prove_by_refinement( + `(UNIV:bool->bool) HAS_SIZE 2`, + (* {{{ proof *) + [ + REWRITE_TAC[has_size_bij2]; + TYPE_THEN `\ u. if u then 0 else 1` EXISTS_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + COND_CASES_TAC THEN ARITH_TAC ; + UND 0 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[ARITH_RULE `~(0 =1) /\ ~(1 = 0)`]; + FULL_REWRITE_TAC[SURJ;INJ]; + REP_BASIC_TAC; + USE 2 (REWRITE_RULE[ARITH_RULE `x <| 2 <=> (x = 0)\/ (x = 1)`]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `T` EXISTS_TAC; + TYPE_THEN `F` EXISTS_TAC; + ]);; + (* }}} *) + +let three_delete_size = prove_by_refinement( + `!(i:three_t). (UNIV DELETE i) HAS_SIZE 2`, + (* {{{ proof *) + [ + REWRITE_TAC[HAS_SIZE;FINITE_DELETE]; + THM_INTRO_TAC[] thr_finite; + FULL_REWRITE_TAC[HAS_SIZE]; + IMATCH_MP_TAC (ARITH_RULE `(SUC x = 3) ==> (x = 2)`); + USE 0 SYM; + IMATCH_MP_TAC CARD_SUC_DELETE; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let has_size_bij_set = prove_by_refinement( + `!(A:A->bool) (B:B->bool) n. A HAS_SIZE n /\ B HAS_SIZE n ==> + (?f. BIJ f A B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USE 0(REWRITE_RULE [has_size_bij]); + USE 1(REWRITE_RULE[has_size_bij2]); + TYPE_THEN `compose f f'` EXISTS_TAC; + IMATCH_MP_TAC COMP_BIJ; + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let bool_three_delete_bij = prove_by_refinement( + `!i. ?b. BIJ b (UNIV:bool->bool) ((UNIV:three_t->bool) DELETE i)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC has_size_bij_set; + TYPE_THEN`2` EXISTS_TAC; + REWRITE_TAC[bool_size;three_delete_size]; + ]);; + (* }}} *) + +let k33_rectagon_hyp_odd_exist = prove_by_refinement( + `!R f. k33_rectagon_hyp R f ==> + (?i. (f i SUBSET par_cell F R))`, + (* {{{ proof *) + [ + REWRITE_TAC[k33_rectagon_hyp]; + TYPE_THEN `j = ABS3 0` ABBREV_TAC ; + TYPE_THEN `f j SUBSET par_cell F R` ASM_CASES_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `k = ABS3 1` ABBREV_TAC ; + TYPE_THEN `k` EXISTS_TAC; + THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd; + CONJ_TAC; + ASM_REWRITE_TAC[k33_rectagon_hyp]; + THM_INTRO_TAC[`R`;`f j`] segment_in_comp; + TSPEC `j` 0; + USE 8 (REWRITE_RULE[psegment_triple]); + CONJ_TAC; + USE 20(REWRITE_RULE[psegment]); + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + FULL_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[cls_union]; + REWRITE_TAC[UNION_OVER_INTER;union_subset]; + FULL_REWRITE_TAC[INTER_COMM]; + TYPE_THEN `endpoint (f j)` UNABBREV_TAC; + REWRITE_TAC[SUBSET_REFL]; + TYPE_THEN `eps = F` ASM_CASES_TAC; + REWR 7; + TYPE_THEN `eps = T` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + (* - *) + TSPEC `k` 7; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` UNABBREV_TAC; + TYPE_THEN `k` UNABBREV_TAC; + USE 4 (AP_TERM `REP3`); + FULL_REWRITE_TAC[ABS3_012]; + UND 4 THEN ARITH_TAC; + ]);; + (* }}} *) + +let k33_rectagon_hyp_false = prove_by_refinement( + `!R f. ~k33_rectagon_hyp R f`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`R`;`f`] k33_rectagon_hyp_odd_exist; + THM_INTRO_TAC[`R`;`f`;`i`] k33_rectagon_two_even; + THM_INTRO_TAC[`i`] three_t_not_sing; + COPY 2; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`j`]); + TYPE_THEN `j` UNABBREV_TAC; + (* - *) + THM_INTRO_TAC[`i`;`j`] three_t_not_pair; + TSPEC `k` 2; + THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd; + TSPEC `k` 7; + TYPE_THEN `~(f k = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[k33_rectagon_hyp]; + TSPEC `k` 0; + FULL_REWRITE_TAC[psegment_triple]; + USE 25(REWRITE_RULE[psegment;segment]); + TYPE_THEN `f k` UNABBREV_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`R`;`T`] par_cell_disjoint; + FULL_REWRITE_TAC[EQ_EMPTY;INTER ]; + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let k33_graph_edge = prove_by_refinement( + `graph_edge (k33_graph) = cartesian UNIV UNIV`, + (* {{{ proof *) + [ + REWRITE_TAC[k33_graph;graph_edge_mk_graph]; + ]);; + (* }}} *) + +let k33_graph_vertex = prove_by_refinement( + `graph_vertex (k33_graph) = cartesian UNIV UNIV`, + (* {{{ proof *) + [ + REWRITE_TAC[k33_graph;graph_vertex_mk_graph]; + ]);; + (* }}} *) + +let k33_graph_inc = prove_by_refinement( + `!e v. graph_inc (k33_graph) e v <=> (v = (FST e,T)) \/ (v = (SND e,F))`, + (* {{{ proof *) + [ + REWRITE_TAC[k33_graph;graph_inc_mk_graph;INR in_pair ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let cartesian_univ = prove_by_refinement( + `!x. cartesian (UNIV:A->bool) (UNIV:B->bool) x`, + (* {{{ proof *) + [ + REWRITE_TAC[cartesian;PAIR_SPLIT]; + MESON_TAC[]; + ]);; + (* }}} *) + +let rectagonal_graph_k33 = prove_by_refinement( + `rectagonal_graph k33_graph <=> (?f uA uB. + INJ uA UNIV UNIV /\ + INJ uB UNIV UNIV /\ + (!(i:three_t#three_t). + segment_end (f i) (uA (FST i)) (uB (SND i))) /\ + (!i j. ~(f i INTER f j = EMPTY) ==> (i = j)) /\ + (!i j. ~(i = j) ==> (cls (f i) INTER cls (f j) = + endpoint (f i) INTER endpoint (f j)))) + `, + (* {{{ proof *) + [ + REWRITE_TAC[rectagonal_graph]; + IMATCH_MP_TAC EQ_ANTISYM; + (* - *) + CONJ_TAC; + THM_INTRO_TAC[`H`;`k33_graph`] graph_isomorphic_symm; + FULL_REWRITE_TAC[rectagon_graph]; + KILL 0; + FULL_REWRITE_TAC [graph_isomorphic;graph_iso]; + FULL_REWRITE_TAC[rectagon_graph]; + FULL_REWRITE_TAC[k33_graph_edge;k33_graph_vertex;k33_graph_inc]; + KILL 4; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `uA = (\ i. u (i,T))` ABBREV_TAC ; + TYPE_THEN `uB = (\ i. u (i,F))` ABBREV_TAC ; + TYPE_THEN `uA` EXISTS_TAC; + TYPE_THEN `uB` EXISTS_TAC; + (* -- *) + CONJ_TAC; + REWRITE_TAC[INJ]; + TYPE_THEN `uA` UNABBREV_TAC; + USE 3(REWRITE_RULE[BIJ;INJ]); + TYPE_THEN`(x,T) = (y,T)` BACK_TAC; + USE 12 (REWRITE_RULE[PAIR_SPLIT]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[cartesian_univ]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[INJ]; + TYPE_THEN `uB` UNABBREV_TAC; + USE 3(REWRITE_RULE[BIJ;INJ]); + TYPE_THEN`(x,F) = (y,F)` BACK_TAC; + USE 12 (REWRITE_RULE[PAIR_SPLIT]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[cartesian_univ]; + (* --A *) + TYPE_THEN `!i. graph_edge H (v i)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[BIJ;SURJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[cartesian_univ]; + FULL_REWRITE_TAC[cartesian_univ]; + (* -- *) + SUBCONJ_TAC; + REWRITE_TAC[segment_end]; + CONJ_TAC; + USE 7(REWRITE_RULE[SUBSET]); + USE 6 GSYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE;k33_graph_inc;INR in_pair]; + TYPE_THEN `uA` UNABBREV_TAC; + TYPE_THEN `uB` UNABBREV_TAC; + NAME_CONFLICT_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `(SND i,F)` EXISTS_TAC; + TYPE_THEN `(FST i,T)` EXISTS_TAC; + (* --B *) + CONJ_TAC; + PROOF_BY_CONTR_TAC; + UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`v i`;`v j`]); + PROOF_BY_CONTR_TAC; + UND 13 THEN REWRITE_TAC[]; + USE 2 (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[cartesian_univ]; + ASM_MESON_TAC[]; + (* -- *) + FIRST_ASSUM IMATCH_MP_TAC ; + DISCH_TAC; + UND 12 THEN REWRITE_TAC[]; + USE 2 (REWRITE_RULE[BIJ;INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[cartesian_univ]; + (* -C *) + TYPE_THEN `?H. rectagon_graph H /\ graph_isomorphic k33_graph H` BACK_TAC; + TYPE_THEN `H` EXISTS_TAC; + IMATCH_MP_TAC graph_isomorphic_symm; + REWRITE_TAC[k33_isgraph]; + REWRITE_TAC[rectagon_graph;graph_isomorphic;graph_iso]; + REWRITE_TAC[k33_graph_vertex;k33_graph_edge]; + TYPE_THEN `H = mk_graph_t (IMAGE uA UNIV UNION IMAGE uB UNIV ,IMAGE f (cartesian UNIV UNIV), endpoint)` ABBREV_TAC ; + TYPE_THEN `H` EXISTS_TAC; + TYPE_THEN `graph_edge H = IMAGE f (cartesian UNIV UNIV)` SUBAGOAL_TAC; + TYPE_THEN `H` UNABBREV_TAC; + REWRITE_TAC[graph_edge_mk_graph]; + TYPE_THEN `graph_vertex H = IMAGE uA UNIV UNION IMAGE uB UNIV ` SUBAGOAL_TAC; + TYPE_THEN `H` UNABBREV_TAC; + REWRITE_TAC[graph_vertex_mk_graph]; + TYPE_THEN `graph_inc H = endpoint` SUBAGOAL_TAC; + TYPE_THEN `H` UNABBREV_TAC; + REWRITE_TAC[graph_inc_mk_graph]; + (* - *) + REWRITE_TAC[GSYM CONJ_ASSOC]; + CONJ_TAC; + REWRITE_TAC[graph]; + REWRITE_TAC[SUBSET]; + NAME_CONFLICT_TAC; + REWRITE_TAC[UNION]; + USE 9(REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` UNABBREV_TAC; + CONJ_TAC; + TSPEC `x''` 2; + USE 2(REWRITE_RULE[segment_end]); + REWR 10; + USE 10 (REWRITE_RULE[INR in_pair]); + FIRST_ASSUM DISJ_CASES_TAC; + REWRITE_TAC[IMAGE]; + MESON_TAC[]; + REWRITE_TAC[IMAGE]; + MESON_TAC[]; + IMATCH_MP_TAC endpoint_size2; + TSPEC `x''` 2; + USE 2(REWRITE_RULE[segment_end]); + (* -D *) + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET;cartesian_univ]; + USE 2(REWRITE_RULE[segment_end]); + (* - *) + KILL 5; + KILL 6; + KILL 7; + KILL 8; + CONJ_TAC; + FULL_REWRITE_TAC[IMAGE;cartesian_univ]; + PROOF_BY_CONTR_TAC; + UND 5 THEN REWRITE_TAC[]; + AP_TERM_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* - *) + CONJ_TAC; + FULL_REWRITE_TAC[IMAGE;cartesian_univ]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + ASM_MESON_TAC[]; + LEFT_TAC "u"; + TYPE_THEN `u = (\ x. (if (SND x) then (uA (FST x)) else uB(FST x)))` ABBREV_TAC ; + TYPE_THEN `u` EXISTS_TAC; + LEFT_TAC "v"; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `(u,f)` EXISTS_TAC; + (* -E *) + TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC; + TSPEC `(i,j)` 2; + USE 2(MATCH_MP segment_end_disj); + UND 2 THEN ASM_REWRITE_TAC[]; + (* - *) + SUBCONJ_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ;cartesian_univ]; + CONJ_TAC; + TYPE_THEN `u` UNABBREV_TAC; + COND_CASES_TAC; + REWRITE_TAC[IMAGE;UNION]; + MESON_TAC[]; + REWRITE_TAC[IMAGE;UNION]; + MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + (* ---// *) + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `!x y. (uA (x) = uA (y)) ==> (x = y)` SUBAGOAL_TAC; + USE 4 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `!x y. (uB (x) = uB (y)) ==> (x = y)` SUBAGOAL_TAC; + USE 3 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 8 THEN REWRITE_TAC[DE_MORGAN_THM]; + KILL 0 THEN KILL 1 THEN KILL 2; + UND 7 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[]; + (* -- *) + REWRITE_TAC[SURJ]; + CONJ_TAC; + USE 7(REWRITE_RULE[INJ]); + REWRITE_TAC[cartesian_univ]; + TYPE_THEN `u` UNABBREV_TAC; + USE 8 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + USE 8(REWRITE_RULE[IMAGE]); + TYPE_THEN `(x',T)` EXISTS_TAC; + USE 8(REWRITE_RULE[IMAGE]); + TYPE_THEN `(x',F)` EXISTS_TAC; + (* -F *) + CONJ_TAC; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `f x` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_IDEMPOT]; + TSPEC `y` 2; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + ASM_MESON_TAC[]; + (* - *) + TSPEC `e` 2; + FULL_REWRITE_TAC[segment_end]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair;IMAGE;k33_graph_inc]; + NAME_CONFLICT_TAC; + THM_INTRO_TAC[`u`;`cartesian (UNIV:three_t->bool) (UNIV:bool->bool)`;`(IMAGE uA UNIV UNION IMAGE uB UNIV)`] bij_imp_image; + USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USE 10 (REWRITE_RULE[IMAGE ;cartesian_univ;UNION]); + USE 10 (CONV_RULE (NAME_CONFLICT_CONV)); + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TSPEC `uB (SND e)` 10; + USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (c ==> a)`)); + UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]); + MESON_TAC[]; + TYPE_THEN`(SND e,F)` EXISTS_TAC; + TYPE_THEN `u x'` UNABBREV_TAC; + TYPE_THEN `u` UNABBREV_TAC; + (* -- *) + TYPE_THEN `x` UNABBREV_TAC; + TSPEC `uA (FST e)` 10; + USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (b ==> a)`)); + UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]); + MESON_TAC[]; + TYPE_THEN`(FST e,T)` EXISTS_TAC; + TYPE_THEN `u x'` UNABBREV_TAC; + TYPE_THEN `u` UNABBREV_TAC; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `u` UNABBREV_TAC; + ]);; + (* }}} *) + +let eq_exchange = prove_by_refinement( + `!x a (b:A). (x = a) /\ (x = b) <=> (x = a) /\ (a = b)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + MESON_TAC[]; + ]);; + (* }}} *) + +let rectagon_graph_k33_false = prove_by_refinement( + `~(rectagonal_graph k33_graph)`, + (* {{{ proof *) + [ + DISCH_TAC; + FULL_REWRITE_TAC[rectagonal_graph_k33]; + ASSUME_TAC k33_rectagon_hyp_false; + LEFT 5 "f"; + TYPE_THEN `diag = (\ (i:three_t). f (i,i))` ABBREV_TAC ; + TYPE_THEN `!i. diag i = f(i,i)` SUBAGOAL_TAC; + TYPE_THEN `diag` UNABBREV_TAC; + KILL 6; + TSPEC `diag` 5; + RIGHT 5 "R"; + UND 5 THEN REWRITE_TAC[]; + REWRITE_TAC[k33_rectagon_hyp]; + TYPE_THEN `R = UNIONS { e | (?i j. ~(i = j) /\ (e = f (i,j)) ) }` ABBREV_TAC ; + TYPE_THEN `R` EXISTS_TAC; + (* - *) + TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC; + TSPEC `i,j` 2; + USE 2(MATCH_MP segment_end_disj); + REWR 2; + (* - *) + TYPE_THEN `!i j. (uA i = uA j) <=> (i = j)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_ANTISYM ; + USE 4 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + TYPE_THEN `!i j. (uB i = uB j) <=> (i = j)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_ANTISYM ; + USE 3 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + (* -A *) + TYPE_THEN `(!i j. ~(i = j) ==> (cls (f (i,i)) INTER cls (f (j,j)) = {}))` SUBAGOAL_TAC; + UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(i,i)`;`j,j`]); + USE 0 (REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + COPY 2; + TSPEC `i,i` 11; + TSPEC `j,j` 2; + FULL_REWRITE_TAC[segment_end]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR in_pair]; + FIRST_ASSUM DISJ_CASES_TAC THEN (TYPE_THEN `x` UNABBREV_TAC); + REWR 15; + REWR 15; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(!i j. ~(i = j) ==> (f (i,i) INTER f (j,j) = {}))` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + UND 11 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `(i,i) = (j,j)` BACK_TAC; + USE 11(REWRITE_RULE[PAIR_SPLIT]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + LEFT_TAC "i"; + (* -B start main reduction *) + TYPE_THEN `?A. (cls (A T) INTER cls (A F) SUBSET endpoint (f (i,i))) /\ (A T INTER A F = EMPTY ) /\ (A T UNION A F = R) /\ (!eps. psegment (A eps)) /\ (!j eps. ~(cls (f (j,j)) INTER cls (A eps) = EMPTY)) /\ (!eps. A eps INTER (f (i,i)) = EMPTY) /\ (!eps. endpoint (A eps) = endpoint (f(i,i))) /\ (!eps. (cls (A eps) INTER cls (f(i,i)) = endpoint (f(i,i))))` BACK_TAC; + LEFT_TAC "A"; + LEFT_TAC "B"; + TYPE_THEN `A T` EXISTS_TAC; + TYPE_THEN `A F` EXISTS_TAC; + TYPE_THEN `(!j. ~(i = j) ==> (cls (f (j,j)) INTER cls (A T) INTER cls (A F) = {}))` SUBAGOAL_TAC; + REWRITE_TAC[GSYM SUBSET_EMPTY]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `cls (f (j,j)) INTER cls(f (i,i))` EXISTS_TAC; + REWRITE_TAC[SUBSET_EMPTY]; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + ASM_REWRITE_TAC[SUBSET_REFL]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `endpoint (f (i,i))` EXISTS_TAC; + IMATCH_MP_TAC endpoint_cls; + USE 2(REWRITE_RULE[segment_end;psegment;segment]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + SUBCONJ_TAC; + ASM_REWRITE_TAC[psegment_triple]; + TYPE_THEN `cls (A T) INTER cls (A F) = endpoint (f (i,i))` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM ; + COPY 13; + TSPEC `T` 21; + TSPEC `F` 13; + REWRITE_TAC[SUBSET_INTER]; + TYPE_THEN `FINITE (f(i,i))` SUBAGOAL_TAC; + USE 2 (REWRITE_RULE[segment_end;psegment;segment]); + CONJ_TAC; + USE 21 SYM; + IMATCH_MP_TAC endpoint_cls; + USE 16(REWRITE_RULE[psegment;segment]); + USE 13 SYM; + IMATCH_MP_TAC endpoint_cls; + USE 16(REWRITE_RULE[psegment;segment]); + SUBCONJ_TAC; + FULL_REWRITE_TAC[segment_end]; + (* ---C *) + TYPE_THEN `endpoint (f (i,i)) = {(uA (i)), (uB(i))}` SUBAGOAL_TAC; + USE 2 (REWRITE_RULE[segment_end]); + CONJ_TAC; + TYPE_THEN `R` UNABBREV_TAC; + USE 5 SYM; + IMATCH_MP_TAC segment_end_union_rectagon; + TYPE_THEN `uA i` EXISTS_TAC; + TYPE_THEN `uB i` EXISTS_TAC; + ASM_REWRITE_TAC[segment_end]; + (* --- *) + CONJ_TAC THEN IMATCH_MP_TAC segment_end_union_rectagon THEN TYPE_THEN `uA i` EXISTS_TAC THEN TYPE_THEN `uB i` EXISTS_TAC THEN ASM_REWRITE_TAC[segment_end]; + (* -- *) + FULL_REWRITE_TAC[psegment_triple]; + KILL 5; + TYPE_THEN `R` UNABBREV_TAC; + (* -D *) + THM_INTRO_TAC[`i`] bool_three_delete_bij; + TYPE_THEN `!e. ~(b e = i)` SUBAGOAL_TAC; + USE 12(REWRITE_RULE[BIJ;SURJ;DELETE ]); + ASM_MESON_TAC[]; + TYPE_THEN `!e e'. (b e = b e') <=> (e = e')` SUBAGOAL_TAC; + USE 12 (REWRITE_RULE[BIJ;INJ]); + IMATCH_MP_TAC EQ_ANTISYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `!j. ~(j = i) ==> (?e. (j = b e))` SUBAGOAL_TAC; + USE 12(REWRITE_RULE[BIJ;SURJ]); + USE 12 (GSYM); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[DELETE]; + TYPE_THEN `j` UNABBREV_TAC; + (* - *) + TYPE_THEN `A = (\ (e: bool). f(i, b e) UNION f (b (~e),b e) UNION f (b(~e),i))` ABBREV_TAC ; + TYPE_THEN `A` EXISTS_TAC; + (* - now satisfy constraints *) + TYPE_THEN `(!eps. A eps INTER f (i,i) = {})` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + REPEAT CONJ_TAC THEN PROOF_BY_CONTR_TAC THEN (UND 1 THEN DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT] o (TRY_RULE (MATCH_MP t))))) THEN ASM_MESON_TAC[]; + (* -E *) + TYPE_THEN `(!eps. cls (A eps) INTER cls (f (i,i)) = endpoint (f (i,i)))` SUBAGOAL_TAC ; + TYPE_THEN `A` UNABBREV_TAC; + ONCE_REWRITE_TAC[INTER_COMM]; + FULL_REWRITE_TAC[UNION_OVER_INTER;cls_union]; + COPY 0; + UND 0 THEN DISCH_THEN( THM_INTRO_TAC[`(i,i)`;`(i, b eps)`]); + USE 0 (REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + COPY 16; + UND 16 THEN DISCH_THEN( THM_INTRO_TAC[`(i,i)`;`(b (~eps),i)`]); + USE 16 (REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + COPY 18; + UND 18 THEN DISCH_THEN( THM_INTRO_TAC[`(i,i)`;`(b (~eps),b eps)`]); + USE 18 (REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + REWRITE_TAC[GSYM UNION_OVER_INTER]; + REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] SUBSET_INTER_ABSORPTION]; + USE 2 (REWRITE_RULE[segment_end]); + REWRITE_TAC[SUBSET;UNION;INR in_pair ]; + FIRST_ASSUM DISJ_CASES_TAC; + (* - *) + TYPE_THEN `(!j eps. ~(cls (f (j,j)) INTER cls (A eps) = {}))` SUBAGOAL_TAC; + TYPE_THEN `j = i` ASM_CASES_TAC; + TYPE_THEN `i` UNABBREV_TAC; + USE 19 (ONCE_REWRITE_RULE[INTER_COMM]); + TSPEC `eps` 18; + REWR 19; + TSPEC `(j,j)` 2; + FULL_REWRITE_TAC[segment_end]; + REWR 2; + USE 2 SYM; + USE 2(REWRITE_RULE[EQ_EMPTY;INR in_pair]); + ASM_MESON_TAC[]; + TYPE_THEN `A` UNABBREV_TAC; + FULL_REWRITE_TAC[cls_union]; + FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION]; + UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`]); + TYPE_THEN `j` UNABBREV_TAC; + TYPE_THEN `j` UNABBREV_TAC; + TYPE_THEN `(e = eps) \/ (e = ~eps)` SUBAGOAL_TAC; + MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(b eps,b eps)`;`(i,b eps)`] ); + USE 0 (REWRITE_RULE[PAIR_SPLIT]); + TYPE_THEN `i` UNABBREV_TAC; + REWR 21; + UND 21 THEN REWRITE_TAC[EMPTY_EXISTS ]; + REWRITE_TAC[INTER]; + FULL_REWRITE_TAC[segment_end;INR in_pair]; + FULL_REWRITE_TAC[segment_end;INR in_pair]; + TYPE_THEN `uB (b eps)` EXISTS_TAC; + (* -- *) + TYPE_THEN `e` UNABBREV_TAC; + UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(b (~eps),b (~eps))`;`(b (~eps),i)`] ); + USE 0 (REWRITE_RULE[PAIR_SPLIT]); + TYPE_THEN `i` UNABBREV_TAC; + REWR 16; + UND 16 THEN REWRITE_TAC[EMPTY_EXISTS ]; + REWRITE_TAC[INTER]; + FULL_REWRITE_TAC[segment_end;INR in_pair]; + FULL_REWRITE_TAC[segment_end;INR in_pair]; + TYPE_THEN `uA (b (~eps))` EXISTS_TAC; + (* -F *) + TYPE_THEN `A T INTER A F = EMPTY ` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[UNION_OVER_INTER]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[EMPTY_UNION]; + TYPE_THEN `!i j. (f i INTER f j = EMPTY) <=> ~( i = j)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `i'` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_IDEMPOT]; + TSPEC `j` 2; + TYPE_THEN `f j` UNABBREV_TAC; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + PROOF_BY_CONTR_TAC; + UND 16 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[PAIR_SPLIT]; + (* - *) + TYPE_THEN `A T UNION A F = R` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `R` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION;UNIONS]; + CONV_TAC (dropq_conv "u"); + UND 5 THEN REP_CASES_TAC THEN UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION;UNIONS]; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `!i'. (i' = i) \/ (i' = b T) \/ (i' = b F)` SUBAGOAL_TAC; + TYPE_THEN`i'' = i` ASM_CASES_TAC; + UND 15 THEN DISCH_THEN ( THM_INTRO_TAC[`i''`]); + ASM_MESON_TAC[]; + TYPE_THEN `e = T` ASM_CASES_TAC; + MESON_TAC[]; + MESON_TAC[]; + COPY 16; + TSPEC `i'` 16; + TSPEC `j` 22; + JOIN 16 22 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + UND 16 THEN REP_CASES_TAC THEN REWR 5 ; + TYPE_THEN `j` UNABBREV_TAC; + TYPE_THEN `i'` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `j` UNABBREV_TAC; + TYPE_THEN `i'` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `j` UNABBREV_TAC; + TYPE_THEN `i'` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -G *) + SUBCONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[cls_union]; + REWRITE_TAC[UNION_OVER_INTER]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[union_subset]; + USE 2(REWRITE_RULE[segment_end]); + USE 0 (REWRITE_RULE[PAIR_SPLIT]); + ASM_SIMP_TAC[]; + REWRITE_TAC[INTER;SUBSET;INR in_pair]; + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + ONCE_REWRITE_TAC[eq_exchange]; + ASM_REWRITE_TAC[]; + (* -H *) + KILL 21; + KILL 20; + KILL 17; + KILL 19; + KILL 18; + TYPE_THEN `!eps. segment_end (A eps) (uA i) (uB i)` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + THM_INTRO_TAC[`f (b (~eps),i)`;`f (b (~eps),b eps)`;`uB i`;`uA(b (~eps))`;`uB(b eps)`] segment_end_union; + CONJ_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + TSPEC `(b (~eps),i)` 2; + REWR 2; + CONJ_TAC; + TSPEC `(b (~eps),b eps)` 2; + REWR 2; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`(b (~eps),i)`;`(b (~eps),b eps)`]); + USE 0(REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + USE 2(REWRITE_RULE[segment_end]); + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;INR in_pair;INR IN_SING;]; + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + ONCE_REWRITE_TAC[eq_exchange]; + ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`f (i,b eps)`;`f (b (~eps),i) UNION f (b (~eps),b eps)`;`uA i`;`uB (b eps)`;`uB i`] segment_end_union; + CONJ_TAC; + TSPEC `(i,b eps)` 2; + REWR 2; + CONJ_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + REWRITE_TAC[cls_union]; + COPY 0; + UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`(i,b eps)`;`b (~eps),i`]); + USE 0 (REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNION_OVER_INTER]; + UND 17 THEN DISCH_THEN ( THM_INTRO_TAC[`(i,b eps)`;`b (~eps),(b eps)`]); + USE 17 (REWRITE_RULE[PAIR_SPLIT]); + ASM_MESON_TAC[]; + USE 2(REWRITE_RULE[segment_end]); + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;UNION;INR in_pair;INR IN_SING;]; + REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + ONCE_REWRITE_TAC[eq_exchange]; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[UNION_COMM]; + (* - *) + USE 17(REWRITE_RULE[segment_end]); + USE 2 (REWRITE_RULE[segment_end]); + ]);; + (* }}} *) + +(* --- *) + + +(* ------------------------------------------------------------------ *) +(* SECTION X *) +(* ------------------------------------------------------------------ *) + + +(* Continue from SECTION Q. + 1.0.2 Rational approximation. *) + +(* work out homeo on graph_support_set properties *) +(* apply h_translate (-- &1) o r_scale (&1/z) *) + + +(* Let's go back and do it in a symmetric way for both cases. *) + +let eps_translate_def = jordan_def `eps_translate eps = + if eps then h_translate else v_translate`;; + +let eps_translate = prove_by_refinement( + `!eps r. eps_translate eps r = if eps then h_translate r else + v_translate r`, + (* {{{ proof *) + [ + REWRITE_TAC[eps_translate_def]; + COND_CASES_TAC; + ]);; + (* }}} *) + +let homeomorphism_eps_translate = prove_by_refinement( + `!eps r. homeomorphism (eps_translate eps r) top2 top2`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[eps_translate]; + COND_CASES_TAC THEN REWRITE_TAC[h_translate_hom;v_translate_hom]; + ]);; + (* }}} *) + +let eps_hyper = jordan_def `eps_hyper eps z = + if eps then hyperplane 2 e1 z else hyperplane 2 e2 z`;; + +let eps_hyper_translate = prove_by_refinement( + `!eps r z. IMAGE (eps_translate eps r) (eps_hyper eps z) = + (eps_hyper eps (z + r)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[eps_translate;eps_hyper]; + COND_CASES_TAC THEN REWRITE_TAC[hyperplane1_h_translate;hyperplane2_v_translate]; + ]);; + (* }}} *) + +let eps_hyper_translate_perp = prove_by_refinement( + `!eps r z. IMAGE (eps_translate eps r) (eps_hyper (~eps) z) = + (eps_hyper (~eps) z) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[eps_translate;eps_hyper]; + COND_CASES_TAC THEN REWRITE_TAC[hyperplane2_h_translate;hyperplane1_v_translate]; + ]);; + (* }}} *) + +let eps_scale = jordan_def `eps_scale eps r = + if eps then r_scale r else u_scale r`;; + +let eps_hyper_scale_perp = prove_by_refinement( + `!eps r z. (&0 < r) ==> + (IMAGE (eps_scale eps r) (eps_hyper (~eps) z) = + (eps_hyper (~eps) z)) `, + (* {{{ proof *) + [ + REWRITE_TAC[eps_scale;eps_hyper]; + COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane1_u_scale;hyperplane2_r_scale]; + ]);; + (* }}} *) + +let eps_hyper_scale = prove_by_refinement( + `!eps r z. (&0 < r) ==> + (IMAGE (eps_scale eps r) (eps_hyper (eps) z) = + (eps_hyper (eps) (if (&0 < z) then r*z else z))) `, + (* {{{ proof *) + [ + REWRITE_TAC[eps_scale;eps_hyper]; + COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane2_u_scale;hyperplane1_r_scale]; + ]);; + (* }}} *) + +let homeomorphism_eps_scale = prove_by_refinement( + `!eps r. (&0 < r) ==> homeomorphism (eps_scale eps r) top2 top2`, + (* {{{ proof *) + [ + REWRITE_TAC[eps_scale]; + COND_CASES_TAC THEN ASM_SIMP_TAC [u_scale_hom;r_scale_hom]; + ]);; + (* }}} *) + +let graph_support_eps = jordan_def `graph_support_eps G E <=> + good_plane_graph G /\ FINITE E /\ + (!e. (graph_edge G e ==> e SUBSET UNIONS E)) /\ + (!v. (graph_vertex G v ==> + E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\ + (!e. (E e ==> (?z eps. (e = eps_hyper eps z)))) /\ + (!z eps. (z <= &0 /\ E (eps_hyper eps z) ==> (?j. z = -- &j)))`;; + +let iso_support_eps_pair = jordan_def + `iso_support_eps_pair (G:(A,B)graph_t) = + { (H,E) | (graph_isomorphic G H) /\ graph_support_eps H E }`;; + +let eps_hyper_ne = prove_by_refinement( + `!z z' eps. ~(eps_hyper eps z = eps_hyper (~eps) z')`, + (* {{{ proof *) + [ + REWRITE_TAC[eps_hyper]; + UND 0 THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[hyperplane_ne;GSYM hyperplane_ne] ; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let eps_hyper_inj = prove_by_refinement( + `!z z' eps eps'. (eps_hyper eps z = eps_hyper eps' z') <=> + ((eps = eps') /\ (z = z'))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN`eps' = ~eps` ASM_CASES_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + REWRITE_TAC [eps_hyper_ne]; + ASM_MESON_TAC[]; + TYPE_THEN `eps' = eps` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps'` UNABBREV_TAC; + REWRITE_TAC[eps_hyper]; + COND_CASES_TAC THEN IMATCH_MP_TAC EQ_ANTISYM THEN CONJ_TAC; + IMATCH_MP_TAC hyperplane1_inj; + IMATCH_MP_TAC hyperplane2_inj; + ]);; + (* }}} *) + +let iso_support_eps_nonempty = prove_by_refinement( + `!(G:(A,B)graph_t). (planar_graph G) /\ + FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) ==> + ~(iso_support_eps_pair G = EMPTY) `, + (* {{{ proof *) + [ + REWRITE_TAC[iso_support_eps_pair]; + TH_INTRO_TAC [`G`] graph_support_init; + UND 0 THEN REWRITE_TAC[EMPTY_EXISTS]; + CONV_TAC (dropq_conv "u"); + REWRITE_TAC[graph_support_eps]; + UNIFY_EXISTS_TAC; + (* - *) + CONJ_TAC; + REWRITE_TAC[eps_hyper]; + (* - *) + TYPE_THEN `(!e. E e ==> (?z eps. (&0 < z) /\ (e = eps_hyper eps z)))` SUBAGOAL_TAC; + UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`e`]); + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN`z` EXISTS_TAC; + TYPE_THEN `T` EXISTS_TAC; + REWRITE_TAC[eps_hyper]; + TYPE_THEN`z` EXISTS_TAC; + TYPE_THEN `F` EXISTS_TAC; + REWRITE_TAC[eps_hyper]; + (* - *) + CONJ_TAC; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`e`]); + MESON_TAC[]; + (* - *) + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`eps_hyper eps z`]); + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `z'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 14 THEN UND 13 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let count_iso_eps_pair = jordan_def + `count_iso_eps_pair ((H:(A,B)graph_t),E) = + CARD { e | (?z eps. (&0 < z) /\ E e /\ (e = eps_hyper eps z)) }`;; + +let iso_support_eps_finite = prove_by_refinement( + `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) ==> FINITE + { e | (?z eps. (&0 < z) /\ E e /\ (e = eps_hyper eps z)) }`, + (* {{{ proof *) + [ + REWRITE_TAC[iso_support_eps_pair ;PAIR_SPLIT; graph_support_eps;]; + TYPE_THEN `E'` UNABBREV_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[SUBSET]; + ]);; + (* }}} *) + +let iso_eps_support0 = prove_by_refinement( + `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\ + (count_iso_eps_pair (H,E) = 0) ==> + good_plane_graph H /\ FINITE E /\ + (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\ + (!v. (graph_vertex H v ==> + E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\ + (!e. (E e ==> (?z eps. (e = eps_hyper eps z) ))) /\ + (!z eps. (E (eps_hyper eps z) ==> (?j. z = -- &j))) + `, + (* {{{ proof *) + [ + REWRITE_TAC[count_iso_eps_pair;]; + TYPE_THEN `A = { e | (?z eps. (&0 < z) /\ E e /\ (e = eps_hyper eps z)) }` ABBREV_TAC ; + TYPE_THEN `A HAS_SIZE 0` SUBAGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + TYPE_THEN `A` UNABBREV_TAC; + TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite; + RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;graph_support_eps;iso_support_eps_pair]); + TYPE_THEN `E'` UNABBREV_TAC; + TYPE_THEN `H'` UNABBREV_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN`eps` EXISTS_TAC; + FULL_REWRITE_TAC[HAS_SIZE_0]; + TYPE_THEN `A` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + USE 2 (MATCH_MP (REAL_ARITH `~( z <= &0) ==> (&0 < z)`)); + UND 3 THEN REWRITE_TAC[EMPTY_EXISTS]; + CONV_TAC (dropq_conv "u"); + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let iso_support_eps_min = prove_by_refinement( + `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\ + (0 < count_iso_eps_pair (H,E)) ==> + (?z eps. (&0 < z) /\ E (eps_hyper eps z) /\ + (!w. (&0 < w /\ w < z) ==> ~(E (eps_hyper eps w))))`, + (* {{{ proof *) + [ + REWRITE_TAC[count_iso_eps_pair]; + TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ; + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `~(A HAS_SIZE 0) ` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]); + UND 4 THEN UND 0 THEN ARITH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE_0;EMPTY_EXISTS]); + TYPE_THEN `?r eps. (u = eps_hyper eps r)` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + MESON_TAC[]; + TYPE_THEN `u` UNABBREV_TAC; + (* - *) + TH_INTRO_TAC[`{z | &0 < z}`;`eps_hyper eps`;`{e | ?z. (&0 < z) /\ E e /\ (e = eps_hyper eps z)}`] finite_subset; + REWRITE_TAC[SUBSET;IMAGE]; + CONJ_TAC; + TYPE_THEN `z` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]); + UND 5 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `A` UNABBREV_TAC; + UNIFY_EXISTS_TAC; + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `inf C` EXISTS_TAC; + (* - *) + TYPE_THEN `C (inf C)` SUBAGOAL_TAC; + IMATCH_MP_TAC finite_inf; + (* - *) + TYPE_THEN `(!z. C z ==> inf C <= z)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC finite_inf_min;ALL_TAC ]; + TYPE_THEN `z = inf C` ABBREV_TAC ; + KILL 11; + KILL 8; + (* - *) + TYPE_THEN `eps` EXISTS_TAC; + USE 5(REWRITE_RULE[IMAGE]); + USE 5(ONCE_REWRITE_RULE[FUN_EQ_THM]); + COPY 5; + TSPEC `eps_hyper eps z` 5; + USE 5(REWRITE_RULE[INR IN_SING]); + USE 5(MATCH_MP (TAUT `(a <=> b) ==> (b ==> a)`)); + UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]); + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `z'` UNABBREV_TAC; + REP_BASIC_TAC; + (* - *) + TSPEC `eps_hyper eps w` 8; + USE 8(MATCH_MP (TAUT `(a <=> b) ==> (a ==> b)`)); + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]); + TYPE_THEN `w` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `x` UNABBREV_TAC; + UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`w`]); + UND 8 THEN UND 13 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let graph_eps_scale_image = prove_by_refinement( + `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps + (plane_graph_image (eps_scale eps r)G) + (IMAGE2 (eps_scale eps r) E) + `, + (* {{{ proof *) + [ + REWRITE_TAC[graph_support_eps]; + THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale; + SUBCONJ_TAC; + IMATCH_MP_TAC plane_graph_image_plane; + (* - *) + REWRITE_TAC[plane_graph_image_e;plane_graph_image_v]; + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + (* - *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + USE 10 (REWRITE_RULE[IMAGE]); + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + FULL_REWRITE_TAC [SUBSET;UNIONS]; + REWRITE_TAC[IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `im` UNABBREV_TAC; + USE 3(CONV_RULE NAME_CONFLICT_CONV); + USE 13 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` UNABBREV_TAC; + TSPEC `x''` 3; + REP_BASIC_TAC; + TYPE_THEN `u'` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -A *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + TYPE_THEN `im` UNABBREV_TAC; + USE 11(REWRITE_RULE[IMAGE]); + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + CONJ_TAC; + UNIFY_EXISTS_TAC; + (* ? *) + TYPE_THEN `eps = T` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; + REWRITE_TAC[eps_scale;r_scale]; + COND_CASES_TAC; + TYPE_THEN `eps = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp; + AP_TERM_TAC; + REWRITE_TAC[eps_scale;u_scale]; + COND_CASES_TAC; + (* -- *) + TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC; + TYPE_THEN `eps = F` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; + REWRITE_TAC[eps_scale;u_scale]; + COND_CASES_TAC; + TYPE_THEN `eps = T` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp; + AP_TERM_TAC; + REWRITE_TAC[eps_scale;r_scale]; + COND_CASES_TAC; + (* -B *) + CONJ_TAC; + USE 12(REWRITE_RULE[IMAGE2]); + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + USE 12(REWRITE_RULE[IMAGE]); + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `im` UNABBREV_TAC; + LEFT_TAC "eps''"; + TYPE_THEN `eps'` EXISTS_TAC; + TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_scale_perp]; + MESON_TAC[]; + TYPE_THEN `eps' = eps` SUBAGOAL_TAC; + UND 13 THEN MESON_TAC[]; + ASM_SIMP_TAC[eps_hyper_scale]; + MESON_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `eps'` EXISTS_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + USE 12 (REWRITE_RULE[IMAGE]); + TYPE_THEN `im` UNABBREV_TAC; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + REWR 12; + TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC; + UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `eps''` UNABBREV_TAC; + TYPE_THEN `eps'' = eps` SUBAGOAL_TAC; + UND 14 THEN MESON_TAC[]; + TYPE_THEN `eps''` UNABBREV_TAC; + UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale]; + FULL_REWRITE_TAC[eps_hyper_inj]; + UND 12 THEN COND_CASES_TAC; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + PROOF_BY_CONTR_TAC; + UND 12 THEN UND 13 THEN REAL_ARITH_TAC; + TYPE_THEN `z'` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + ]);; + (* }}} *) + +let graph_eps_scale_image = prove_by_refinement( + `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps + (plane_graph_image (eps_scale eps r)G) + (IMAGE2 (eps_scale eps r) E) + `, + (* {{{ proof *) + [ + REWRITE_TAC[graph_support_eps]; + THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale; + SUBCONJ_TAC; + IMATCH_MP_TAC plane_graph_image_plane; + (* - *) + REWRITE_TAC[plane_graph_image_e;plane_graph_image_v]; + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + (* - *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + USE 10 (REWRITE_RULE[IMAGE]); + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + FULL_REWRITE_TAC [SUBSET;UNIONS]; + REWRITE_TAC[IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `im` UNABBREV_TAC; + USE 3(CONV_RULE NAME_CONFLICT_CONV); + USE 13 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` UNABBREV_TAC; + TSPEC `x''` 3; + REP_BASIC_TAC; + TYPE_THEN `u'` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -A *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + TYPE_THEN `im` UNABBREV_TAC; + USE 11(REWRITE_RULE[IMAGE]); + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + CONJ_TAC; + UNIFY_EXISTS_TAC; + (* ? *) + TYPE_THEN `eps = T` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; + REWRITE_TAC[eps_scale;r_scale]; + COND_CASES_TAC; + TYPE_THEN `eps = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp; + AP_TERM_TAC; + REWRITE_TAC[eps_scale;u_scale]; + COND_CASES_TAC; + (* -- *) + TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC; + TYPE_THEN `eps = F` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; + REWRITE_TAC[eps_scale;u_scale]; + COND_CASES_TAC; + TYPE_THEN `eps = T` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp; + AP_TERM_TAC; + REWRITE_TAC[eps_scale;r_scale]; + COND_CASES_TAC; + (* -B *) + CONJ_TAC; + USE 12(REWRITE_RULE[IMAGE2]); + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + USE 12(REWRITE_RULE[IMAGE]); + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `im` UNABBREV_TAC; + LEFT_TAC "eps''"; + TYPE_THEN `eps'` EXISTS_TAC; + TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_scale_perp]; + MESON_TAC[]; + TYPE_THEN `eps' = eps` SUBAGOAL_TAC; + UND 13 THEN MESON_TAC[]; + ASM_SIMP_TAC[eps_hyper_scale]; + MESON_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `eps'` EXISTS_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + USE 12 (REWRITE_RULE[IMAGE]); + TYPE_THEN `im` UNABBREV_TAC; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + REWR 12; + TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC; + UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `eps''` UNABBREV_TAC; + TYPE_THEN `eps'' = eps` SUBAGOAL_TAC; + UND 14 THEN MESON_TAC[]; + TYPE_THEN `eps''` UNABBREV_TAC; + UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale]; + FULL_REWRITE_TAC[eps_hyper_inj]; + UND 12 THEN COND_CASES_TAC; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + PROOF_BY_CONTR_TAC; + UND 12 THEN UND 13 THEN REAL_ARITH_TAC; + TYPE_THEN `z'` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + ]);; + (* }}} *) + +let graph_eps_translate_image = prove_by_refinement( + `!G E eps r. (?j. -- &j = r) /\ + (!w. (&0 < w /\ w < -- r) ==> ~(E (eps_hyper eps w))) /\ + graph_support_eps G E ==> + graph_support_eps + (plane_graph_image (eps_translate eps r)G) + (IMAGE2 (eps_translate eps r) E) + `, + (* {{{ proof *) + [ + REWRITE_TAC[graph_support_eps]; + THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_translate; + SUBCONJ_TAC; + IMATCH_MP_TAC plane_graph_image_plane; + (* - *) + REWRITE_TAC[plane_graph_image_e;plane_graph_image_v]; + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + IMATCH_MP_TAC FINITE_IMAGE; + (* - *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; + USE 11 (REWRITE_RULE[IMAGE]); + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + FULL_REWRITE_TAC [SUBSET;UNIONS]; + REWRITE_TAC[IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `im` UNABBREV_TAC; + USE 3(CONV_RULE NAME_CONFLICT_CONV); + USE 14 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` UNABBREV_TAC; + TSPEC `x''` 3; + REP_BASIC_TAC; + TYPE_THEN `u'` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -A *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + TYPE_THEN `im` UNABBREV_TAC; + USE 12(REWRITE_RULE[IMAGE]); + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + CONJ_TAC; + UNIFY_EXISTS_TAC; + (* --- *) + TYPE_THEN `eps = T` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj]; + REWRITE_TAC[eps_translate;h_translate]; + REWRITE_TAC[euclid_plus;e1;point_scale]; + REAL_ARITH_TAC; + TYPE_THEN `eps = F` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_translate_perp; + FULL_REWRITE_TAC []; + AP_TERM_TAC; + REWRITE_TAC[eps_translate;v_translate]; + REWRITE_TAC[euclid_plus;e2;point_scale]; + REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC; + TYPE_THEN `eps = F` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj]; + REWRITE_TAC[eps_translate;v_translate]; + REWRITE_TAC[euclid_plus;e2;point_scale]; + REAL_ARITH_TAC; + TYPE_THEN `eps = T` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `eps` UNABBREV_TAC; + THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_translate_perp; + FULL_REWRITE_TAC[]; + AP_TERM_TAC; + REWRITE_TAC[eps_translate;h_translate]; + REWRITE_TAC[euclid_plus;e1;point_scale]; + REAL_ARITH_TAC; + (* -B *) + CONJ_TAC; + USE 13(REWRITE_RULE[IMAGE2]); + TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; + USE 13(REWRITE_RULE[IMAGE]); + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `im` UNABBREV_TAC; + LEFT_TAC "eps''"; + TYPE_THEN `eps'` EXISTS_TAC; + TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; + ASM_SIMP_TAC [eps_hyper_translate_perp]; + MESON_TAC[]; + TYPE_THEN `eps' = eps` SUBAGOAL_TAC; + UND 14 THEN MESON_TAC[]; + ASM_SIMP_TAC[eps_hyper_translate]; + MESON_TAC[]; + (* -C *) + TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `~eps` EXISTS_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; + USE 13 (REWRITE_RULE[IMAGE]); + TYPE_THEN `im` UNABBREV_TAC; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + REWR 13; + TYPE_THEN `eps' = ~eps` ASM_CASES_TAC; + UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + TYPE_THEN `eps' = eps` SUBAGOAL_TAC; + UND 15 THEN MESON_TAC[]; + TYPE_THEN `eps'` UNABBREV_TAC; + UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate]; + FULL_REWRITE_TAC[eps_hyper_inj]; + UND 17 THEN MESON_TAC[]; + (* -D *) + TYPE_THEN `eps' = eps` SUBAGOAL_TAC; + UND 15 THEN MESON_TAC[]; + TYPE_THEN`eps'` UNABBREV_TAC; + TYPE_THEN `E(eps_hyper eps (z + &j))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ; + USE 13 (REWRITE_RULE[IMAGE]); + TYPE_THEN `im` UNABBREV_TAC; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + REWR 13; + TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC; + UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp]; + FULL_REWRITE_TAC[eps_hyper_inj]; + UND 18 THEN MESON_TAC[]; + TYPE_THEN `eps'' = eps` SUBAGOAL_TAC; + UND 16 THEN MESON_TAC[]; + TYPE_THEN `eps''` UNABBREV_TAC; + FULL_REWRITE_TAC[eps_hyper_translate;eps_hyper_inj]; + TYPE_THEN `r` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `!a. (z' + (-- a)) + a = z'` SUBAGOAL_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `z = &0` ASM_CASES_TAC; + TYPE_THEN `0` EXISTS_TAC; + REAL_ARITH_TAC; + UND 0 THEN DISCH_THEN ( THM_INTRO_TAC[`z + &j`;`eps`]); + IMATCH_MP_TAC (REAL_ARITH `~(&0 < z + &j) ==> (z + &j <= &0)`); + UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`z + &j`]); + TYPE_THEN `r` UNABBREV_TAC; + UND 17 THEN UND 14 THEN REAL_ARITH_TAC; + UND 6 THEN REWRITE_TAC[]; + TYPE_THEN `j +| j'` EXISTS_TAC; + UND 0 THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let count_iso_scale = prove_by_refinement( + `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> + (count_iso_eps_pair (G,E) = count_iso_eps_pair + ((plane_graph_image(eps_scale eps r) G), + (IMAGE2 (eps_scale eps r) E))) `, + (* {{{ proof *) + [ + REWRITE_TAC[count_iso_eps_pair]; + THM_INTRO_TAC[`G`;`E`;`eps`;`r`] graph_eps_scale_image; + FULL_REWRITE_TAC[graph_support_eps]; + IMATCH_MP_TAC BIJ_CARD; + TYPE_THEN `IMAGE (eps_scale eps r)` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET ; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[SUBSET]; + (* - *) + FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v]; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ; + (* - *) + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + TYPE_THEN `if (eps = eps') then r* z else z` EXISTS_TAC; + TYPE_THEN `eps'` EXISTS_TAC; + CONJ_TAC; + COND_CASES_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `im` UNABBREV_TAC; + COND_CASES_TAC; + ASM_SIMP_TAC[eps_hyper_scale]; + TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; + UND 13 THEN MESON_TAC[]; + ASM_SIMP_TAC[eps_hyper_scale_perp]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `y` UNABBREV_TAC; + TYPE_THEN `im` UNABBREV_TAC; + TYPE_THEN `(eps' = eps) \/ (eps' = ~eps)` SUBAGOAL_TAC; + MESON_TAC[]; + TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC; + MESON_TAC[]; + REWRITE_TAC[eps_hyper_inj]; + JOIN 13 15 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR]; + UND 13 THEN REP_CASES_TAC THEN UND 14 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_scale_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`]; + IMATCH_MP_TAC REAL_EQ_LCANCEL_IMP; + TYPE_THEN `r` EXISTS_TAC; + UND 1 THEN REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[SURJ]; + CONJ_TAC; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* - *) + CONV_TAC (dropq_conv "y"); + TYPE_THEN `x` UNABBREV_TAC; + LEFT_TAC "eps"; + TYPE_THEN `eps'` EXISTS_TAC; + USE 16 (REWRITE_RULE[IMAGE]); + UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `z'` EXISTS_TAC; + TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then r*z' else z')` SUBAGOAL_TAC; + TYPE_THEN `im` UNABBREV_TAC; + COND_CASES_TAC; + TYPE_THEN `eps''` UNABBREV_TAC; + UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj]; + COND_CASES_TAC; + REWR 17; + TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC; + UND 8 THEN MESON_TAC[]; + TYPE_THEN `eps''` UNABBREV_TAC; + UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale_perp;eps_hyper_inj]; + (* - *) + TYPE_THEN `eps''` UNABBREV_TAC; + REWR 17; + UND 17 THEN COND_CASES_TAC; + THM_INTRO_TAC[`r`;`z'`] REAL_LT_LMUL_0; + USE 19 SYM; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let count_iso_translate = prove_by_refinement( + `!G E eps . graph_support_eps G E /\ + (!w. (&0 < w /\ w < &1) ==> ~(E (eps_hyper eps w))) /\ + E (eps_hyper eps (&1)) ==> + (count_iso_eps_pair (G,E) = SUC(count_iso_eps_pair + ((plane_graph_image(eps_translate eps (-- &1)) G), + (IMAGE2 (eps_translate eps (-- &1)) E)))) `, + (* {{{ proof *) + [ + REWRITE_TAC[count_iso_eps_pair]; + TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ; + TYPE_THEN `A (eps_hyper eps (&1))` SUBAGOAL_TAC; + TYPE_THEN`A` UNABBREV_TAC; + TYPE_THEN `&1` EXISTS_TAC; + MESON_TAC[]; + (* - *) + TYPE_THEN`FINITE A` SUBAGOAL_TAC; + FULL_REWRITE_TAC[graph_support_eps]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + (* - *) + THM_INTRO_TAC[`(eps_hyper eps (&1))`;`A`]CARD_SUC_DELETE; + TYPE_THEN `CARD A` UNABBREV_TAC; + REWRITE_TAC[SUC_INJ]; + THM_INTRO_TAC[`G`;`E`;`eps`;`-- &1`] graph_eps_translate_image; + CONJ_TAC; + MESON_TAC[]; + FULL_REWRITE_TAC[REAL_ARITH `-- -- x = x`]; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[graph_support_eps]; + (* -A0 *) + IMATCH_MP_TAC BIJ_CARD; + TYPE_THEN `IMAGE (eps_translate eps (-- &1))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC FINITE_DELETE_IMP; + (* - *) + FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v]; + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_translate eps (-- &1))` ABBREV_TAC ; + (* -A *) + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + FULL_REWRITE_TAC[DELETE]; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `if (eps = eps'') then z' - &1 else z'` EXISTS_TAC; + TYPE_THEN `eps''` EXISTS_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + CONJ_TAC; + COND_CASES_TAC; + TYPE_THEN `eps''` UNABBREV_TAC; + IMATCH_MP_TAC (REAL_ARITH `~((z' = &1) \/ (z' < &1)) ==> (&0 < z' - &1)`); + REWR 3; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`z'`]); + UND 1 THEN ASM_REWRITE_TAC[]; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC image_imp; + TYPE_THEN `im` UNABBREV_TAC; + COND_CASES_TAC; + ASM_SIMP_TAC[eps_hyper_translate]; + AP_TERM_TAC; + REAL_ARITH_TAC; + TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC; + UND 3 THEN MESON_TAC[]; + ASM_SIMP_TAC[eps_hyper_translate_perp]; + TYPE_THEN `A` UNABBREV_TAC; + FULL_REWRITE_TAC[DELETE]; + TYPE_THEN `x` UNABBREV_TAC; (* -// *) + TYPE_THEN `y` UNABBREV_TAC; + TYPE_THEN `im` UNABBREV_TAC; + TYPE_THEN `(eps''' = eps) \/ (eps''' = ~eps)` SUBAGOAL_TAC; + MESON_TAC[]; + TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC; + MESON_TAC[]; + REWRITE_TAC[eps_hyper_inj]; + JOIN 17 20 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR]; + UND 17 THEN REP_CASES_TAC THEN UND 18 THEN ASM_SIMP_TAC[eps_hyper_translate;eps_hyper_translate_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`]; + UND 17 THEN REAL_ARITH_TAC; + (* -B *) + REWRITE_TAC[SURJ]; + FULL_REWRITE_TAC[INJ]; + (* - *) + REP_BASIC_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DELETE]; + CONV_TAC (dropq_conv "y"); (* -// *) + LEFT_TAC "eps"; + TYPE_THEN `eps'` EXISTS_TAC; + KILL 18; + KILL 19; + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `z'` UNABBREV_TAC; + TYPE_THEN `eps''` UNABBREV_TAC; + (* - *) + USE 21 (REWRITE_RULE[IMAGE]); + UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `z''` EXISTS_TAC; + TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then z'' - &1 else z'')` SUBAGOAL_TAC; + TYPE_THEN `im` UNABBREV_TAC; + COND_CASES_TAC; + TYPE_THEN `eps''` UNABBREV_TAC; + USE 3 (REWRITE_RULE [eps_hyper_translate;eps_hyper_inj]); + REAL_ARITH_TAC; + TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC; + UND 12 THEN MESON_TAC[]; + TYPE_THEN `eps''` UNABBREV_TAC; + USE 3 (REWRITE_RULE[ eps_hyper_translate_perp;eps_hyper_inj]); + (* - *) + TYPE_THEN `eps''` UNABBREV_TAC; + TYPE_THEN `z` UNABBREV_TAC; + CONJ_TAC; + UND 22 THEN COND_CASES_TAC; + UND 12 THEN REAL_ARITH_TAC; + TYPE_THEN `z''` UNABBREV_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + UND 22 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let iso_support_min_int = prove_by_refinement( + `!G:(A,B)graph_t H E. iso_support_eps_pair G (H,E) /\ + (0 <| count_iso_eps_pair (H,E)) ==> + (?H' E'. iso_support_eps_pair G (H',E') /\ + (count_iso_eps_pair(H',E') = count_iso_eps_pair(H,E)) /\ + (?eps. E' (eps_hyper eps (&1)) /\ + (!w. (&0 < w /\ w < &1) ==> ~(E'(eps_hyper eps w)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_min; + TYPE_THEN `z' = &1/z` ABBREV_TAC ; + TYPE_THEN `H' = plane_graph_image (eps_scale eps z') H` ABBREV_TAC ; + TYPE_THEN `E' = IMAGE2 (eps_scale eps z') E` ABBREV_TAC ; + TYPE_THEN `H'` EXISTS_TAC; + TYPE_THEN `E'` EXISTS_TAC; + (* - *) + TYPE_THEN `&0 < z'` SUBAGOAL_TAC; + TYPE_THEN `z'` UNABBREV_TAC; + (* - *) + TYPE_THEN `z' * z = &1` SUBAGOAL_TAC; + TYPE_THEN `z'` UNABBREV_TAC; + IMATCH_MP_TAC REAL_DIV_RMUL; + UND 5 THEN UND 4 THEN REAL_ARITH_TAC; + (* - *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[iso_support_eps_pair]; + FULL_REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `E''` UNABBREV_TAC; + TYPE_THEN `H''` UNABBREV_TAC; + TYPE_THEN `H'` EXISTS_TAC; + TYPE_THEN `E'` EXISTS_TAC; + TYPE_THEN `H'` UNABBREV_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + CONJ_TAC; + THM_INTRO_TAC[`eps_scale eps z'`;`H`] plane_graph_image_iso; + ASM_SIMP_TAC [homeomorphism_eps_scale]; + FULL_REWRITE_TAC[graph_support_eps;good_plane_graph]; + THM_INTRO_TAC[`G`;`H`;`(plane_graph_image (eps_scale eps z') H)`] graph_isomorphic_trans; + IMATCH_MP_TAC graph_eps_scale_image; + (* - *) + SUBCONJ_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + TYPE_THEN `E'` UNABBREV_TAC; + TYPE_THEN `H'` UNABBREV_TAC; + IMATCH_MP_TAC count_iso_scale; + FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; + ASM_MESON_TAC[]; + TYPE_THEN `eps` EXISTS_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + (* - *) + SUBCONJ_TAC; + REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ; + REWRITE_TAC[IMAGE]; + TYPE_THEN `eps_hyper eps z` EXISTS_TAC; + TYPE_THEN `im` UNABBREV_TAC; + ASM_SIMP_TAC [eps_hyper_scale]; + (* - *) + FULL_REWRITE_TAC[IMAGE2]; + TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ; + USE 7(REWRITE_RULE[IMAGE]); + TYPE_THEN `im` UNABBREV_TAC; + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[ `z*w` ]); + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + IMATCH_MP_TAC (REAL_ARITH `z * w < z* &1 ==> z*w < z`); + IMATCH_MP_TAC REAL_LT_LMUL; + TYPE_THEN `x = eps_hyper eps (z * w)` SUBAGOAL_TAC; + USE 1 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]); + TYPE_THEN `E''` UNABBREV_TAC; + USE 17 (REWRITE_RULE[graph_support_eps]); + UND 17 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `x` UNABBREV_TAC; + REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `eps' = eps` ASM_CASES_TAC; + TYPE_THEN `eps'` UNABBREV_TAC; + UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_inj]; + COND_CASES_TAC; + UND 9 THEN REWRITE_TAC[REAL_MUL_AC]; + ASM_REWRITE_TAC [REAL_MUL_ASSOC]; + REAL_ARITH_TAC; + REWR 13; + TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC; + UND 17 THEN MESON_TAC[]; + TYPE_THEN `eps'` UNABBREV_TAC; + UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale_perp;eps_hyper_inj]; + TYPE_THEN `x` UNABBREV_TAC; + UND 2 THEN ASM_REWRITE_TAC[]; + + + ]);; + (* }}} *) + +let iso_int_model_lemma = prove_by_refinement( + `!(G:(A,B)graph_t) . (planar_graph G) /\ + FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) ==> + (?H E. iso_support_eps_pair G (H,E) /\ + (count_iso_eps_pair (H,E) = 0))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `c = count_iso_eps_pair:((num->real,(num->real)->bool)graph_t#(((num->real)->bool)->bool))->num` ABBREV_TAC ; + THM_INTRO_TAC[`G`] iso_support_eps_nonempty; + THM_INTRO_TAC[`iso_support_eps_pair G`;`c`] select_image_num_min; + UND 6 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `?H E. z = H,E` SUBAGOAL_TAC ; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `H` EXISTS_TAC; + TYPE_THEN `E` EXISTS_TAC; + TYPE_THEN `c` UNABBREV_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(0 < x) ==> (x = 0)`); + THM_INTRO_TAC[`G`;`H`;`E`] iso_support_min_int; + THM_INTRO_TAC[`H'`;`E'`;`eps`] count_iso_translate; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; + ASM_MESON_TAC[]; + TYPE_THEN `H'' = plane_graph_image (eps_translate eps (-- &1)) H'` ABBREV_TAC ; + TYPE_THEN `E'' = IMAGE2 (eps_translate eps ( -- &1)) E'`ABBREV_TAC ; + UND 7 THEN DISCH_THEN (THM_INTRO_TAC[ `(H'',E'')`]); + TYPE_THEN `H''` UNABBREV_TAC; + TYPE_THEN `E''` UNABBREV_TAC; + REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; + CONV_TAC (dropq_conv "H"); + CONV_TAC (dropq_conv "E"); + (* -- *) + CONJ_TAC; + TYPE_THEN `graph_isomorphic H' (plane_graph_image (eps_translate eps (-- &1)) H')` SUBAGOAL_TAC; + IMATCH_MP_TAC plane_graph_image_iso; + REWRITE_TAC[homeomorphism_eps_translate;]; + USE 12 (REWRITE_RULE[iso_support_eps_pair;graph_support_eps;good_plane_graph;PAIR_SPLIT]); + ASM_MESON_TAC[]; + THM_INTRO_TAC[`G`;`H'`;`(plane_graph_image (eps_translate eps (-- &1)) H')`] graph_isomorphic_trans; + USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]); + ASM_MESON_TAC[]; + (* -- *) + IMATCH_MP_TAC graph_eps_translate_image; + CONJ_TAC; + MESON_TAC[]; + ASM_REWRITE_TAC[ARITH_RULE `-- (-- x) = x`]; + USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]); + ASM_MESON_TAC[]; + UND 7 THEN UND 13 THEN UND 11 THEN ARITH_TAC; + + ]);; + (* }}} *) + +let graph_int_model = prove_by_refinement( + `!(G:(A,B)graph_t) . (planar_graph G) /\ + FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) ==> + (?H E. + graph_isomorphic G H /\ + good_plane_graph H /\ + FINITE E /\ + (!e. graph_edge H e ==> e SUBSET UNIONS E) /\ + (!v. graph_vertex H v + ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1))) /\ + (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\ + (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) + )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`]iso_int_model_lemma; + TYPE_THEN `H` EXISTS_TAC; + TYPE_THEN `E` EXISTS_TAC; + THM_INTRO_TAC[`G`;`H`;`E`] iso_eps_support0; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION Y *) +(* ------------------------------------------------------------------ *) + +(* if a graph has an int model then it is a rectagonal graph *) +(* k33_nonplanar proved! *) + + +let h_edge_ball = prove_by_refinement( + `!m. h_edge m SUBSET open_ball + (euclid 2,d_euclid) + (pointI m + (&1/ &2)*# e1) (&1 / &2)`, + (* {{{ proof *) + + [ + REWRITE_TAC[h_edge;open_ball;SUBSET;euclid_point;e1;point_scale;pointI;point_add]; + REWRITE_TAC[euclid_point;]; + TYPE_THEN `v` UNABBREV_TAC; + REDUCE_TAC; + REWRITE_TAC[d_euclid_point]; + REDUCE_TAC; + TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC; + REWRITE_TAC[EXP_EQ_0]; + UND 0 THEN ARITH_TAC; + REDUCE_TAC; + REWRITE_TAC[POW_2_SQRT_ABS]; + FULL_REWRITE_TAC[int_add_th;int_of_num_th]; + REWRITE_TAC[GSYM REAL_ABS_BETWEEN]; + CONJ_TAC; + REWRITE_TAC[REAL_LT_HALF1]; + CONJ_TAC; + REWRITE_TAC[REAL_LT_SUB_RADD]; + REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE]; + UND 2 THEN REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let v_edge_ball = prove_by_refinement( + `!m. v_edge m SUBSET open_ball + (euclid 2,d_euclid) + (pointI m + (&1/ &2)*# e2) (&1 / &2)`, + (* {{{ proof *) + [ + REWRITE_TAC[v_edge;open_ball;SUBSET;euclid_point;e2;point_scale;pointI;point_add]; + REWRITE_TAC[euclid_point;]; + TYPE_THEN `u` UNABBREV_TAC; + REDUCE_TAC; + REWRITE_TAC[d_euclid_point]; + REDUCE_TAC; + TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC; + REWRITE_TAC[EXP_EQ_0]; + UND 0 THEN ARITH_TAC; + REDUCE_TAC; + REWRITE_TAC[POW_2_SQRT_ABS]; + FULL_REWRITE_TAC[int_add_th;int_of_num_th]; + REWRITE_TAC[GSYM REAL_ABS_BETWEEN]; + CONJ_TAC; + REWRITE_TAC[REAL_LT_HALF1]; + CONJ_TAC; + REWRITE_TAC[REAL_LT_SUB_RADD]; + REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE]; + UND 2 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let sqrt_frac = prove_by_refinement( + `!n m. sqrt ((&n/ &m) pow 2) = &n/ (&m) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC POW_2_SQRT; + IMATCH_MP_TAC REAL_LE_DIV; + REWRITE_TAC[REAL_POS]; + ]);; + (* }}} *) + +let abs_dest_int_half = prove_by_refinement( + `!m. &1 / &2 <= abs (real_of_int m - &1 / &2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC REAL_LE_LCANCEL_IMP; + TYPE_THEN `&2` EXISTS_TAC; + CONJ_TAC; + REAL_ARITH_TAC; + TYPE_THEN `&2 * (&1/ &2) = &1` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 0 THEN REAL_ARITH_TAC; + TYPE_THEN `&2 = abs (&2)` SUBAGOAL_TAC; + REAL_ARITH_TAC; + TYPE_THEN`!x. &2 * abs x = abs (&2 * x)` SUBAGOAL_TAC; + UND 1 THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_SUB_LDISTRIB]; + REWRITE_TAC[GSYM int_of_num_th;GSYM int_mul_th;GSYM int_sub_th;GSYM int_abs_th;GSYM int_le]; + TYPE_THEN `!x. ~(&:0 = ||: x) ==> (&:1 <= ||: x)` SUBAGOAL_TAC; + THM_INTRO_TAC[`x`] INT_ABS_POS; + UND 3 THEN UND 4 THEN INT_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 4 SYM; + FULL_REWRITE_TAC[INT_ABS_ZERO]; + THM_INTRO_TAC[`m`] INT_REP; + TYPE_THEN`m` UNABBREV_TAC; + FULL_REWRITE_TAC[INT_OF_NUM_MUL;INT_SUB_LDISTRIB;INT_EQ_SUB_RADD;INT_OF_NUM_ADD;INT_OF_NUM_EQ;]; + UND 4 THEN REDUCE_TAC ; + TYPE_THEN `ODD (2 *| n)` SUBAGOAL_TAC; + REWRITE_TAC[ODD_EXISTS]; + TYPE_THEN `m'` EXISTS_TAC; + ARITH_TAC; + KILL 4; + TYPE_THEN `EVEN (2 *| n)` SUBAGOAL_TAC; + REWRITE_TAC[EVEN_EXISTS]; + MESON_TAC[]; + ASM_MESON_TAC[EVEN_AND_ODD]; + ]);; + (* }}} *) + +let REAL_LT_SQUARE_ABS = prove_by_refinement( + `!x y. abs x < abs y <=> x pow 2 < y pow 2`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y /\ ~(y <= x))`]; + MESON_TAC[REAL_LE_SQUARE_ABS]; + ]);; + (* }}} *) + +let h_edge_closed_ball = prove_by_refinement( + `!e m. edge e /\ ~(e INTER closed_ball + (euclid 2,d_euclid) + (pointI m + (&1/ &2)*# e1) (&1 / &2) = EMPTY) ==> + (e = h_edge m)`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + USE 1 (MATCH_MP point_onto); + TYPE_THEN `u` UNABBREV_TAC; + KILL 5; + FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;v_edge;point_inj]; + TYPE_THEN `p` UNABBREV_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); + UND 0 THEN REWRITE_TAC[]; + TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; + REWRITE_TAC[sqrt_frac]; + IMATCH_MP_TAC SQRT_MONO_LT; + IMATCH_MP_TAC (REAL_ARITH `(x <= u /\ &0 < v) ==> x < u + v` ); + (* -- *) + CONJ_TAC; + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS]; + TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_DIV;ABS_N]; + ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG]; + TYPE_THEN `--((real_of_int (FST m) + &1 / &2) - real_of_int (FST m')) = (real_of_int (FST m' - FST m)) - &1 / &2 ` SUBAGOAL_TAC; + REWRITE_TAC[int_sub_th]; + REAL_ARITH_TAC; + REWRITE_TAC[abs_dest_int_half]; + (* -- *) + IMATCH_MP_TAC (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`); + REWRITE_TAC[]; + USE 1 (MATCH_MP POW_ZERO); + TYPE_THEN `v = real_of_int (SND m)` SUBAGOAL_TAC; + UND 1 THEN REAL_ARITH_TAC; + TYPE_THEN `v` UNABBREV_TAC; + FULL_REWRITE_TAC[GSYM int_lt]; + UND 3 THEN UND 5 THEN INT_ARITH_TAC; + (* - *) + REWRITE_TAC[cell_clauses]; + TYPE_THEN `e` UNABBREV_TAC; + FULL_REWRITE_TAC[h_edge]; + TYPE_THEN `v` UNABBREV_TAC; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; + REWRITE_TAC[PAIR_SPLIT]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + (* - *) + USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); + UND 0 THEN REWRITE_TAC[]; + TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; + REWRITE_TAC[sqrt_frac]; + IMATCH_MP_TAC SQRT_MONO_LT; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + IMATCH_MP_TAC (REAL_ARITH `(x < u /\ &0 <= v) ==> x < u + v` ); + (* --B *) + REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; + TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_DIV;ABS_N]; + KILL 0; + TYPE_THEN `!x y. x < abs y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC; + REAL_ARITH_TAC; + TYPE_THEN `&1 / &2 < (real_of_int (FST m) + &1 / &2) - u'` ASM_CASES_TAC; + DISJ1_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `&1 / &2` EXISTS_TAC; + CONJ_TAC ; + IMATCH_MP_TAC REAL_LE_DIV; + REAL_ARITH_TAC; + UND 9 THEN REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `real_of_int (FST m) + &1 < u'` BACK_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_TRANS; + TYPE_THEN `real_of_int (FST m) + &1 - u'` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC; + REWRITE_TAC[REAL_LT_HALF2]; + UND 11 THEN REAL_ARITH_TAC; + UND 10 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE; + UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t])); + UND 10 THEN REAL_ARITH_TAC; + (* -- *) + PROOF_BY_CONTR_TAC; + TYPE_THEN `u' <= real_of_int (FST m) + &1` SUBAGOAL_TAC; + UND 10 THEN REAL_ARITH_TAC; + TYPE_THEN `real_of_int (FST m) <= u'` SUBAGOAL_TAC; + UND 9 THEN REAL_ARITH_TAC; + TYPE_THEN `~(u' = real_of_int (FST m) + &1)` SUBAGOAL_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;]; + UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC; + TYPE_THEN `u' < real_of_int (FST m) + &1` SUBAGOAL_TAC; + UND 13 THEN UND 11 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `floor u' = (FST m')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[int_add_th;int_of_num_th]; + ASM_REWRITE_TAC[floor_range]; + UND 6 THEN REAL_ARITH_TAC; + USE 15 SYM; + TYPE_THEN `floor u' = FST m` SUBAGOAL_TAC; + REWRITE_TAC[floor_range]; + ASM_MESON_TAC[]; + (* -C different second coord *) + IMATCH_MP_TAC (REAL_ARITH `x < z /\ &0 <= y ==> x < y + z`); + REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; + REDUCE_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `&1` EXISTS_TAC; + CONJ_TAC; + KILL 0; + REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM]; + REWRITE_TAC[REAL_LT_HALF2]; + REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;]; + UND 7 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let v_edge_closed_ball = prove_by_refinement( + `!e m. edge e /\ ~(e INTER closed_ball + (euclid 2,d_euclid) + (pointI m + (&1/ &2)*# e2) (&1 / &2) = EMPTY) ==> + (e = v_edge m)`, + (* {{{ proof *) + [ + REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; + (* - *) + USE 4 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + USE 1 (MATCH_MP point_onto); + TYPE_THEN `u` UNABBREV_TAC; + KILL 5; + FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;h_edge;point_inj]; + TYPE_THEN `p` UNABBREV_TAC; + TYPE_THEN `v ` UNABBREV_TAC; + USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); + UND 0 THEN REWRITE_TAC[]; + TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; + REWRITE_TAC[sqrt_frac]; + IMATCH_MP_TAC SQRT_MONO_LT; + IMATCH_MP_TAC (REAL_ARITH `(x <= v /\ &0 < u) ==> x < u + v` ); + (* -- *) + CONJ_TAC; + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS]; + TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_DIV;ABS_N]; + ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG]; + TYPE_THEN `--((real_of_int (SND m) + &1 / &2) - real_of_int (SND m')) = (real_of_int (SND m' - SND m)) - &1 / &2 ` SUBAGOAL_TAC; + REWRITE_TAC[int_sub_th]; + REAL_ARITH_TAC; + REWRITE_TAC[abs_dest_int_half]; + (* --// *) + IMATCH_MP_TAC (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`); + REWRITE_TAC[]; + USE 1 (MATCH_MP POW_ZERO); + TYPE_THEN `u' = real_of_int (FST m)` SUBAGOAL_TAC; + UND 1 THEN REAL_ARITH_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + FULL_REWRITE_TAC[GSYM int_lt]; + UND 3 THEN UND 5 THEN INT_ARITH_TAC; + (* - *) + REWRITE_TAC[cell_clauses]; + TYPE_THEN `e` UNABBREV_TAC; + FULL_REWRITE_TAC[v_edge]; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC; + REWRITE_TAC[PAIR_SPLIT]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + (* - *) + USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); + UND 0 THEN REWRITE_TAC[]; + TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC; + REWRITE_TAC[sqrt_frac]; + IMATCH_MP_TAC SQRT_MONO_LT; + (* - *) + USE 3 (MATCH_MP (TAUT `a \/ b ==> b \/ a`)); + FIRST_ASSUM DISJ_CASES_TAC; + IMATCH_MP_TAC (REAL_ARITH `(x < v /\ &0 <= u) ==> x < u + v` ); + (* --B *) + REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; + TYPE_THEN `abs (&1/ &2) = &1 / &2` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_DIV;ABS_N]; + KILL 0; + TYPE_THEN `!x y. x < abs y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC; + REAL_ARITH_TAC; + TYPE_THEN `&1 / &2 < (real_of_int (SND m) + &1 / &2) - v` ASM_CASES_TAC; + DISJ1_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `&1 / &2` EXISTS_TAC; + CONJ_TAC ; + IMATCH_MP_TAC REAL_LE_DIV; + REAL_ARITH_TAC; + UND 9 THEN REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `real_of_int (SND m) + &1 < v` BACK_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_TRANS; + TYPE_THEN `real_of_int (SND m) + &1 - v` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC; + REWRITE_TAC[REAL_LT_HALF2]; + UND 11 THEN REAL_ARITH_TAC; + UND 10 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE; + UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t])); + UND 10 THEN REAL_ARITH_TAC; + (* -- *) + PROOF_BY_CONTR_TAC; + TYPE_THEN `v <= real_of_int (SND m) + &1` SUBAGOAL_TAC; + UND 10 THEN REAL_ARITH_TAC; + TYPE_THEN `real_of_int (SND m) <= v` SUBAGOAL_TAC; + UND 9 THEN REAL_ARITH_TAC; + TYPE_THEN `~(v = real_of_int (SND m) + &1)` SUBAGOAL_TAC; + TYPE_THEN `v` UNABBREV_TAC; + FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;]; + UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC; + TYPE_THEN `v < real_of_int (SND m) + &1` SUBAGOAL_TAC; + UND 13 THEN UND 11 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `floor v = (SND m')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[int_add_th;int_of_num_th]; + ASM_REWRITE_TAC[floor_range]; + UND 6 THEN REAL_ARITH_TAC; + USE 15 SYM; + TYPE_THEN `floor v = SND m` SUBAGOAL_TAC; + REWRITE_TAC[floor_range]; + ASM_MESON_TAC[]; + (* -C different second coord *) + IMATCH_MP_TAC (REAL_ARITH `x < y /\ &0 <= z ==> x < y + z`); + REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS]; + REDUCE_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `&1` EXISTS_TAC; + CONJ_TAC; + KILL 0; + REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM]; + REWRITE_TAC[REAL_LT_HALF2]; + REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;]; + UND 7 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let connected_in_edge = prove_by_refinement( + `!C. connected top2 C /\ C SUBSET (UNIONS edge) ==> + (?e. edge e /\ C SUBSET e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `C = EMPTY` ASM_CASES_TAC ; + REWRITE_TAC[connected_empty]; + TYPE_THEN `C` UNABBREV_TAC; + TYPE_THEN `h_edge (&:0,&:0)` EXISTS_TAC; + REWRITE_TAC[edge_h]; + (* - *) + TYPE_THEN `?e. edge e /\ ~(C INTER e = EMPTY)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET;UNIONS;EMPTY_EXISTS]; + TSPEC `u` 0; + REWRITE_TAC[INTER ]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `e` EXISTS_TAC; + FULL_REWRITE_TAC[connected;edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `A = open_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ; + TYPE_THEN `B = closed_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ; + TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ; + UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`])); + CONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC open_ball_open; + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[top2]; + THM_INTRO_TAC[`top2`;`B`] closed_open ; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + FULL_REWRITE_TAC[open_DEF;top2_unions;]; + FULL_REWRITE_TAC[top2]; + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[EQ_EMPTY;INTER;DIFF]; + UND 1 THEN REWRITE_TAC[]; + ASM_MESON_TAC[open_ball_sub_closed;subset_imp;]; + USE 0 (REWRITE_RULE[SUBSET;UNIONS]); + REWRITE_TAC[SUBSET;UNION]; + TSPEC `x` 0; + REWRITE_TAC[]; + TYPE_THEN `u = v_edge m` ASM_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + DISJ1_TAC; + ASM_MESON_TAC[v_edge_ball;subset_imp ]; + DISJ2_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[DIFF]; + CONJ_TAC; + FULL_REWRITE_TAC[top2_unions]; + ASM_MESON_TAC[subset_imp]; + UND 10 THEN REWRITE_TAC[]; + IMATCH_MP_TAC v_edge_closed_ball; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + USE 0 (REWRITE_RULE[SUBSET;UNIONS]); + REWRITE_TAC[SUBSET]; + TSPEC `x` 0; + REWRITE_TAC[]; + TYPE_THEN `u = v_edge m` BACK_TAC ; + ASM_MESON_TAC[]; + IMATCH_MP_TAC v_edge_closed_ball; + REWRITE_TAC[INTER;EMPTY_EXISTS ]; + TYPE_THEN `x` EXISTS_TAC; + ASM_MESON_TAC[open_ball_sub_closed;subset_imp]; + USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + PROOF_BY_CONTR_TAC; + UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET]; + TSPEC `u` 8; + UND 8 THEN REWRITE_TAC[DE_MORGAN_THM]; + DISJ2_TAC; + ASM_MESON_TAC[v_edge_ball;subset_imp;open_ball_sub_closed]; + (* -A *) + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `A = open_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ; + TYPE_THEN `B = closed_ball (euclid 2,d_euclid) (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ; + TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ; + UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`])); + CONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC open_ball_open; + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[top2]; + THM_INTRO_TAC[`top2`;`B`] closed_open ; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + FULL_REWRITE_TAC[open_DEF;top2_unions;]; + FULL_REWRITE_TAC[top2]; + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[EQ_EMPTY;INTER;DIFF]; + UND 1 THEN REWRITE_TAC[]; + ASM_MESON_TAC[open_ball_sub_closed;subset_imp;]; + USE 0 (REWRITE_RULE[SUBSET;UNIONS]); + REWRITE_TAC[SUBSET;UNION]; + TSPEC `x` 0; + REWRITE_TAC[]; + (* -- *) + TYPE_THEN `u = h_edge m` ASM_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + DISJ1_TAC; + ASM_MESON_TAC[h_edge_ball;subset_imp ]; + DISJ2_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[DIFF]; + CONJ_TAC; + FULL_REWRITE_TAC[top2_unions]; + ASM_MESON_TAC[subset_imp]; + UND 10 THEN REWRITE_TAC[]; + IMATCH_MP_TAC h_edge_closed_ball; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + USE 0 (REWRITE_RULE[SUBSET;UNIONS]); + REWRITE_TAC[SUBSET]; + TSPEC `x` 0; + REWRITE_TAC[]; + TYPE_THEN `u = h_edge m` BACK_TAC ; + ASM_MESON_TAC[]; + IMATCH_MP_TAC h_edge_closed_ball; + REWRITE_TAC[INTER;EMPTY_EXISTS ]; + TYPE_THEN `x` EXISTS_TAC; + ASM_MESON_TAC[open_ball_sub_closed;subset_imp]; + USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + PROOF_BY_CONTR_TAC; + (* - *) + UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET]; + TSPEC `u` 8; + UND 8 THEN REWRITE_TAC[DE_MORGAN_THM]; + DISJ2_TAC; + ASM_MESON_TAC[h_edge_ball;subset_imp;open_ball_sub_closed]; + (* - *) + (* Mon Dec 20 15:16:18 EST 2004 *) + + ]);; + (* }}} *) + +let int_pow2_gt1 = prove_by_refinement( + `!x. ~(x = &:0) ==> &1 <= (real_of_int x) pow 2`, + (* {{{ proof *) + [ + TYPE_THEN `&1 = &1 pow 2` SUBAGOAL_TAC ; + REDUCE_TAC; + UND 1 THEN DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]); + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS;GSYM int_le;GSYM int_abs_th ;GSYM int_of_num_th;]; + UND 0 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let d_euclid_pointI_pos = prove_by_refinement( + `!m n. d_euclid (pointI m) (pointI n) < &1 ==> (m = n)`, + (* {{{ proof *) + [ + REWRITE_TAC[pointI;d_euclid_point;PAIR_SPLIT]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + USE 0 (MATCH_MP (REAL_ARITH `x < y ==> ~(y <= x)`)); + UND 0 THEN REWRITE_TAC[]; + TYPE_THEN `&1 = sqrt(&1)` SUBAGOAL_TAC; + ONCE_REWRITE_TAC [EQ_SYM_EQ]; + IMATCH_MP_TAC SQRT_POS_UNIQ; + REDUCE_TAC; + UND 0 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); + IMATCH_MP_TAC SQRT_MONO_LE; + REDUCE_TAC; + FULL_REWRITE_TAC[GSYM int_sub_th]; + USE 1 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] INT_SUB_0]); + FIRST_ASSUM DISJ_CASES_TAC; + IMATCH_MP_TAC (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= x + y`); + IMATCH_MP_TAC int_pow2_gt1; + ASM_MESON_TAC[]; + IMATCH_MP_TAC (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= y + x`); + IMATCH_MP_TAC int_pow2_gt1; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +extend_simp_rewrites[prove_by_refinement( + `&0 < &1 / &2`, + (* {{{ proof *) + [ + REWRITE_TAC[REAL_LT_HALF1]; + ])];; + (* }}} *) + +extend_simp_rewrites[prove_by_refinement( + `&2 * &1/ &2 = &1`, + (* {{{ proof *) + [ + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 0 THEN REAL_ARITH_TAC; + ])];; + (* }}} *) + +let totally_bounded_pointI = prove_by_refinement( + `?eps. !x m n. (&0 + (m = n)) `, + (* {{{ proof *) + [ + TYPE_THEN `&1/ &2` EXISTS_TAC; + REWRITE_TAC[]; + IMATCH_MP_TAC d_euclid_pointI_pos; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`x`;`&1 / &2`] BALL_DIST; + TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let simple_arc_finite_pointI = prove_by_refinement( + `! e . + simple_arc top2 e ==> + (?X. FINITE X /\ (!m. e (pointI m) ==> X m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`e`] simple_arc_compact; + THM_INTRO_TAC[`e`] simple_arc_euclid; + THM_INTRO_TAC[`e`;`d_euclid`] compact_totally_bounded; + CONJ_TAC; + THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace; + THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] compact_subset; + FULL_REWRITE_TAC[top2]; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[totally_bounded]; + THM_INTRO_TAC[] totally_bounded_pointI; + TSPEC `eps` 3; + RIGHT 4 "n"; + RIGHT 4 "m"; + RIGHT 4 "x"; + REWRITE_TAC[]; + TYPE_THEN `X = { m | ?b. B b /\ b (pointI m) }` ABBREV_TAC ; + TYPE_THEN `X` EXISTS_TAC; + (* - *) + TYPE_THEN `!m. ?b. (X m) ==> (B b /\ b (pointI m))` SUBAGOAL_TAC; + TYPE_THEN `X` UNABBREV_TAC; + MESON_TAC[]; + LEFT 9 "b"; + CONJ_TAC; + THM_INTRO_TAC[`X`;`B`;`b`] FINITE_INJ; + REWRITE_TAC[INJ]; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + COPY 9; + TSPEC `x` 13; + TSPEC `y` 9; + COPY 6; + TSPEC `b x` 16; + TSPEC `b y` 6; + TYPE_THEN `x'` EXISTS_TAC; + (* // *) + TYPE_THEN `b y` UNABBREV_TAC; + TYPE_THEN `b x` UNABBREV_TAC; + THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace; + THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`;`x'`;`eps`] open_ball_subspace; + CONJ_TAC THEN ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `X` UNABBREV_TAC; + FULL_REWRITE_TAC[UNIONS]; + ASM_MESON_TAC[]; + (* Mon Dec 20 18:39:42 EST 2004 *) + + + ]);; + (* }}} *) + +let simple_arc_finite_lemma1 = prove_by_refinement( + `!e v v'. simple_arc_end e v v' ==> + (?X f. (X SUBSET {x | &0 <= x /\ x <= &1}) /\ FINITE X /\ + (f (&0) = v) /\ (f (&1) = v') /\ + (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\ + continuous f (top_of_metric (UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ + (!x. &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) <=> (X x))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_simple; + THM_INTRO_TAC[`e`] simple_arc_finite_pointI; + THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end; + REWR 4; + TYPE_THEN `Y = {x | &0 <= x /\ x <= &1 /\ (?m. (f x = pointI m))}` ABBREV_TAC ; + TYPE_THEN `Y` EXISTS_TAC; + TYPE_THEN `f` EXISTS_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN`Y` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + (* - *) + FULL_REWRITE_TAC[top2_unions]; + CONJ_TAC; + THM_INTRO_TAC[`Y`;`IMAGE (pointI) X`;`f`] FINITE_INJ; + CONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + FULL_REWRITE_TAC[INJ]; + CONJ_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `Y` UNABBREV_TAC; + TYPE_THEN `m` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 9 SYM; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `Y` UNABBREV_TAC; + (* - *) + TYPE_THEN `Y` UNABBREV_TAC; + ]);; + (* }}} *) + +let simple_arc_finite_lemma2 = prove_by_refinement( + `!e v v'. simple_arc_end e v v'==> + (?(N:num) t f. + (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\ + (f (&0) = v) /\ (f (&1) = v') /\ + (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\ + (!i j. (i < j) /\ (i < N) /\ (j < N) ==> (t i < t j)) /\ + continuous f (top_of_metric (UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ + (!x. &0 <= x /\ x <= &1 ==> + ( (?m. f x = pointI m) <=> (?k. (k < N) /\ (x = t k)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma1; + THM_INTRO_TAC[`X`] real_finite_increase; + TYPE_THEN `CARD X` EXISTS_TAC; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `f` EXISTS_TAC; + (* - *) + SUBCONJ_TAC; + FULL_REWRITE_TAC[BIJ;IMAGE;SURJ]; + FULL_REWRITE_TAC[SUBSET]; + TSPEC `x'` 11; + (* - *) + SUBCONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + TSPEC `x` 1; + REWR 1; + FULL_REWRITE_TAC[BIJ;SURJ]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let connected_unions_common = prove_by_refinement( + `!U (ZZ:(A->bool)->bool). (!Z. ZZ Z ==> connected U Z) /\ + (!Z Z'. ZZ Z /\ ZZ Z' ==> ~(Z INTER Z' = EMPTY)) ==> + (connected U (UNIONS ZZ))`, + (* {{{ proof *) + [ + REWRITE_TAC[connected]; + SUBCONJ_TAC; + TYPE_THEN `UU = UNIONS U` ABBREV_TAC ; + REWRITE_TAC[UNIONS;SUBSET]; + TSPEC `u` 1; + REWRITE_TAC[]; + ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `!Z. ZZ Z ==> Z SUBSET A \/ Z SUBSET B` SUBAGOAL_TAC; + TSPEC `Z` 1; + REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 2 (REWRITE_RULE[UNIONS;SUBSET]); + REWRITE_TAC[SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `AA = {Z | ZZ Z /\ Z SUBSET A}` ABBREV_TAC ; + TYPE_THEN `BB = {Z | ZZ Z /\ Z SUBSET B}` ABBREV_TAC ; + TYPE_THEN `ZZ = AA UNION BB` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + TYPE_THEN `AA` UNABBREV_TAC; + TYPE_THEN `BB` UNABBREV_TAC; + ASM_MESON_TAC[]; + PROOF_BY_CONTR_TAC; + USE 11 (REWRITE_RULE[DE_MORGAN_THM;UNIONS;SUBSET;UNION]); + LEFT 11 "x"; + LEFT 12 "x"; + TYPE_THEN `AA` UNABBREV_TAC; + TYPE_THEN `BB` UNABBREV_TAC; + LEFT 11 "u"; + LEFT 8 "u"; + LEFT 12 "u"; + LEFT 9 "u"; + (* - *) + TYPE_THEN `ZZ u` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `ZZ u'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `u SUBSET A` SUBAGOAL_TAC; + TSPEC `u` 7; + FIRST_ASSUM DISJ_CASES_TAC ; + USE 13(REWRITE_RULE[SUBSET]); + TSPEC `x` 13; + ASM_MESON_TAC[]; + TYPE_THEN `u' SUBSET B` SUBAGOAL_TAC; + TSPEC `u'` 7; + FIRST_ASSUM DISJ_CASES_TAC ; + USE 14(REWRITE_RULE[SUBSET]); + TSPEC `x'` 14; + ASM_MESON_TAC[]; + (* - *) + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`u`;`u'`]); + USE 0 (REWRITE_RULE[EMPTY_EXISTS;INTER ]); + USE 3(REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `u''` 3; + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let connect_real_open = prove_by_refinement( + `!a b. connected + (top_of_metric (UNIV,d_real)) {x | a < x /\ x < b}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `{x | a < x /\ x < b} = EMPTY` ASM_CASES_TAC; + REWRITE_TAC[connected_empty]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `ZZ = {Z | ?a' b'. a < a' /\ a' < u /\ u < b' /\ b' < b /\ (Z = {x | a' <= x /\ x <= b'})}` ABBREV_TAC ; + TYPE_THEN `{x | a < x /\ x < b} = UNIONS ZZ` SUBAGOAL_TAC; + TYPE_THEN `ZZ` UNABBREV_TAC; + REWRITE_TAC[UNIONS]; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + CONV_TAC (dropq_conv "u"); + CONV_TAC (dropq_conv "x'"); + TYPE_THEN `u < x` ASM_CASES_TAC; + TYPE_THEN `(a + u)/ &2` EXISTS_TAC; + TYPE_THEN `x` EXISTS_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC real_middle1_lt; + SUBCONJ_TAC; + IMATCH_MP_TAC real_middle2_lt; + UND 6 THEN UND 4 THEN REAL_ARITH_TAC; + TYPE_THEN `(a + x)/ &2` EXISTS_TAC; + TYPE_THEN `(u + b)/ &2` EXISTS_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC real_middle1_lt; + SUBCONJ_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `x` EXISTS_TAC; + USE 4 (MATCH_MP (REAL_ARITH `~(u < x) ==> (x <= u)`)); + IMATCH_MP_TAC real_middle2_lt; + SUBCONJ_TAC; + IMATCH_MP_TAC real_middle1_lt; + CONJ_TAC; + IMATCH_MP_TAC real_middle2_lt; + CONJ_TAC; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + IMATCH_MP_TAC real_middle2_lt; + UND 4 THEN UND 7 THEN REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `u'` UNABBREV_TAC; + UND 7 THEN UND 3 THEN UND 2 THEN UND 4 THEN REAL_ARITH_TAC; + (* - *) + IMATCH_MP_TAC connected_unions_common; + CONJ_TAC; + TYPE_THEN `ZZ` UNABBREV_TAC; + REWRITE_TAC[connect_real]; + TYPE_THEN `ZZ` UNABBREV_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + TYPE_THEN `Z'` UNABBREV_TAC; + USE 4(REWRITE_RULE[EQ_EMPTY;INTER]); + TSPEC `u` 2; + KILL 3; + REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let int_neg_num_th = prove_by_refinement( + `!j. real_of_int (--: (&: j)) = -- (&j)`, + (* {{{ proof *) + [ + REWRITE_TAC[int_neg_th;int_of_num_th;]; + ]);; + (* }}} *) + +let closed_ball_subset_larger_open = prove_by_refinement( + `!n a r r'. + (r < r') ==> closed_ball (euclid n,d_euclid) a r SUBSET + open_ball (euclid n,d_euclid) a r'`, + (* {{{ proof *) + [ + REWRITE_TAC[closed_ball;open_ball;SUBSET]; + UND 3 THEN UND 0 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let simple_arc_end_edge_closure = prove_by_refinement( + `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\ + (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==> + (closure top2 e (pointI m))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`e`] edge_euclid2; + FULL_REWRITE_TAC[edge]; + TYPE_THEN `connected top2 C` SUBAGOAL_TAC; + USE 1 (MATCH_MP simple_arc_end_simple); + USE 1(MATCH_MP simple_arc_connected); + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`e`] closure_open_ball; + USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `(pointI m)` 6; + USE 5 (REWRITE_RULE[top2]); + UND 6 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + (* - *) + TYPE_THEN `?r. &0 < r /\ (r < &1/ &2) /\ (e INTER closed_ball (euclid 2, d_euclid) (pointI m) r = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `?s. &0 < s /\ s <= r /\ s <= &1/ &2` SUBAGOAL_TAC; + TYPE_THEN `min_real r (&1 / &2)` EXISTS_TAC; + REWRITE_TAC[min_real_le]; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + TYPE_THEN `s/ &2` EXISTS_TAC; + ASM_REWRITE_TAC[REAL_LT_HALF1]; + CONJ_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `s` EXISTS_TAC; + REWRITE_TAC[REAL_LT_HALF2]; + REWRITE_TAC[EQ_EMPTY;INTER]; + LEFT 7 "z"; + TSPEC `x` 7; + UND 7 THEN ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `s/ &2 < r` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `s` EXISTS_TAC; + REWRITE_TAC[REAL_LT_HALF2]; + THM_INTRO_TAC[`2`;`pointI m`;`s / &2`;`r`] closed_ball_subset_larger_open; + ASM_MESON_TAC[subset_imp]; + (* - *) + THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct; + FULL_REWRITE_TAC[connected]; + TYPE_THEN `A = open_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ; + TYPE_THEN `B = closed_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ; + TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ; + (* -A *) + TYPE_THEN `top2 A /\ top2 E /\ (A INTER E = {}) /\ C SUBSET A UNION E /\ A (pointI m) /\ E (pointI n)` SUBAGOAL_TAC; + CONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC open_ball_open; + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[top2]; + THM_INTRO_TAC[`top2`;`B`] closed_open; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + FULL_REWRITE_TAC[open_DEF;top2_unions ]; + FULL_REWRITE_TAC[top2]; + (* --// *) + CONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[INTER;EQ_EMPTY;DIFF]; + ASM_MESON_TAC[subset_imp;open_ball_sub_closed]; + (* -- *) + TYPE_THEN `A (pointI m)` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC (INR open_ball_nonempty); + REWRITE_TAC[pointI]; + (* -- *) + TYPE_THEN `E (pointI n)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[DIFF]; + TYPE_THEN `B` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[pointI]; + FULL_REWRITE_TAC[pointI_inj]; + TYPE_THEN `open_ball (euclid 2,d_euclid) (pointI m) (&1 / &2) (pointI n)` SUBAGOAL_TAC; + THM_INTRO_TAC[`2`;`pointI m`;`r'`;`&1 / &2`] closed_ball_subset_larger_open; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`pointI m`;`&1 / &2`] BALL_DIST; + IMATCH_MP_TAC (INR open_ball_nonempty); + REWRITE_TAC[pointI]; + TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC; + REWR 17; + USE 17 (MATCH_MP d_euclid_pointI_pos); + TYPE_THEN `m` UNABBREV_TAC; + (* --// *) + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC; + TSPEC `x` 0; + ASM_MESON_TAC[]; + UND 19 THEN REP_CASES_TAC; + DISJ2_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[DIFF]; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + ASM_MESON_TAC[subset_imp]; + DISJ1_TAC; + DISJ2_TAC; + (* - *) + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`E`]); + (* -B *) + TYPE_THEN `C (pointI m)` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_end; + UNIFY_EXISTS_TAC; + TYPE_THEN `C (pointI n)` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_end2; + UNIFY_EXISTS_TAC; + USE 19 (REWRITE_RULE[INTER;EQ_EMPTY ]); + FIRST_ASSUM DISJ_CASES_TAC; + USE 24 (REWRITE_RULE[SUBSET]); (* -- *) + ASM_MESON_TAC[]; + USE 24 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let vc_edge_pointI = prove_by_refinement( + `!m n. vc_edge m (pointI n) <=> (n = m) \/ (n = up m)`, + (* {{{ proof *) + [ + REWRITE_TAC[vc_edge;cell_clauses;INR IN_SING;UNION]; + TYPE_THEN `pointI m + e2 = pointI (up m)` SUBAGOAL_TAC; + REWRITE_TAC[up;e2;point_add ;pointI]; + REDUCE_TAC; + REWRITE_TAC[int_of_num_th;int_add_th]; + REWRITE_TAC[pointI_inj]; + ]);; + (* }}} *) + +let hc_edge_pointI = prove_by_refinement( + `!m n. hc_edge m (pointI n) <=> (n = m) \/ (n = right m)`, + (* {{{ proof *) + [ + REWRITE_TAC[hc_edge;cell_clauses;INR IN_SING;UNION]; + TYPE_THEN `pointI m + e1 = pointI (right m)` SUBAGOAL_TAC; + REWRITE_TAC[right;e1;point_add ;pointI]; + REDUCE_TAC; + REWRITE_TAC[int_of_num_th;int_add_th]; + REWRITE_TAC[pointI_inj]; + ]);; + (* }}} *) + +let mk_segment_v = prove_by_refinement( + `!r s b x. (r <= s) ==> (mk_segment (point(b,r)) (point(b,s)) x <=> + (?t. (r <= t /\ t <= s /\ (x = point(b,t)))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[mk_segment]; + REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC; + CONJ_TAC; + ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`; + ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`; + TYPE_THEN `s = r` ASM_CASES_TAC; + REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`]; + TYPE_THEN `&0` EXISTS_TAC; + UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ; + TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC; + TYPE_THEN `v` UNABBREV_TAC; + REWRITE_TAC[GSYM real_div_assoc]; + REDUCE_TAC; + IMATCH_MP_TAC REAL_DIV_REFL; + UND 5 THEN UND 4 THEN REAL_ARITH_TAC; + TYPE_THEN `v*(s - t)` EXISTS_TAC; + TYPE_THEN `&0 < v` SUBAGOAL_TAC; + TYPE_THEN `v` UNABBREV_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + UND 4 THEN UND 0 THEN REAL_ARITH_TAC; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + UND 7 THEN UND 2 THEN REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_LCANCEL_IMP; + TYPE_THEN `(s - r)` EXISTS_TAC; + CONJ_TAC; + UND 4 THEN UND 0 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_ASSOC]; + REDUCE_TAC; + UND 3 THEN REAL_ARITH_TAC; + TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC]; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + + ]);; + (* }}} *) + +let mk_segment_vc = prove_by_refinement( + `!m. mk_segment (pointI m) (pointI (up m)) = vc_edge m`, + (* {{{ proof *) + [ + REWRITE_TAC[up;vc_edge;v_edge;pointI;UNION ;e2;]; + IMATCH_MP_TAC EQ_EXT; + THM_INTRO_TAC[`real_of_int (SND m)`;`real_of_int(SND m + &:1)`;`real_of_int (FST m)`;`x`] mk_segment_v; + REWRITE_TAC[GSYM int_le]; + INT_ARITH_TAC; + REWRITE_TAC[point_add;]; + REDUCE_TAC; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + TYPE_THEN `t = real_of_int (SND m)` ASM_CASES_TAC; + REWRITE_TAC[INR IN_SING]; + TYPE_THEN `t = real_of_int (SND m) + &1` ASM_CASES_TAC; + REWRITE_TAC[INR IN_SING]; + DISJ1_TAC; + CONV_TAC (dropq_conv "u"); +CONV_TAC (dropq_conv "v"); + FULL_REWRITE_TAC[int_add_th;int_of_num_th;]; + UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC; + (* - *) + UND 1 THEN REP_CASES_TAC ; + TYPE_THEN `v` EXISTS_TAC; + UND 2 THEN UND 3 THEN REAL_ARITH_TAC; + FULL_REWRITE_TAC [INR IN_SING]; + TYPE_THEN `real_of_int (SND m)` EXISTS_TAC; + REWRITE_TAC[int_add_th;int_of_num_th]; + REAL_ARITH_TAC; + FULL_REWRITE_TAC [INR IN_SING]; + TYPE_THEN `real_of_int (SND m) + &1` EXISTS_TAC; + REWRITE_TAC[int_add_th;int_of_num_th]; + REAL_ARITH_TAC; + (* Tue Dec 21 18:22:18 EST 2004 *) + + ]);; + (* }}} *) + +let mk_segment_hc = prove_by_refinement( + `!m. mk_segment (pointI m) (pointI (right m)) = hc_edge m`, + (* {{{ proof *) + [ + REWRITE_TAC[right;hc_edge;h_edge;pointI;UNION ;e1;]; + IMATCH_MP_TAC EQ_EXT; + THM_INTRO_TAC[`real_of_int (FST m)`;`real_of_int(FST m + &:1)`;`real_of_int (SND m)`;`x`] mk_segment_h; + REWRITE_TAC[int_add_th;int_of_num_th;]; + REAL_ARITH_TAC; + REWRITE_TAC[point_add;]; + REDUCE_TAC; + FULL_REWRITE_TAC[int_add_th;int_of_num_th;]; + (* - *) + REWRITE_TAC[INR IN_SING]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + REWRITE_TAC[point_inj;PAIR_SPLIT ]; + TYPE_THEN `t = real_of_int (FST m)` ASM_CASES_TAC; + TYPE_THEN `t = real_of_int (FST m) + &1` ASM_CASES_TAC; + CONV_TAC (dropq_conv "u"); +CONV_TAC (dropq_conv "v"); + UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC; + (* - *) + UND 1 THEN REP_CASES_TAC ; + TYPE_THEN `u` EXISTS_TAC; + UND 2 THEN UND 3 THEN REAL_ARITH_TAC; + TYPE_THEN `real_of_int (FST m)` EXISTS_TAC; + REAL_ARITH_TAC; + TYPE_THEN `real_of_int (FST m) + &1` EXISTS_TAC; + REAL_ARITH_TAC; + + ]);; + (* }}} *) + +let simple_arc_end_edge_full_closure = prove_by_refinement( + `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\ + (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==> + (C = closure top2 e ) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`e`;`m`;`n`] simple_arc_end_edge_closure; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`e`;`n`;`m`] simple_arc_end_edge_closure; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + TYPE_THEN `C SUBSET closure top2 e` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET]; + TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + UND 6 THEN REP_CASES_TAC; + THM_INTRO_TAC[`top2`;`e`] subset_closure; + REWRITE_TAC[top2_top]; + ASM_MESON_TAC[subset_imp]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `B = closure top2 e` ABBREV_TAC ; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `pointI m` EXISTS_TAC; + TYPE_THEN `pointI n` EXISTS_TAC; + REWRITE_TAC[SUBSET_REFL]; + TYPE_THEN `simple_arc_end B (pointI m) (pointI n)` BACK_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + (* -A *) + THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct; + FULL_REWRITE_TAC[pointI_inj]; + (* - *) + TYPE_THEN `mk_segment (pointI m) (pointI n) = B` SUBAGOAL_TAC ; + FULL_REWRITE_TAC[edge]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;]; + TYPE_THEN `B` UNABBREV_TAC; + TYPE_THEN `(m = m') /\ (n = up m') \/ (m = up m') /\ (n = m')` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[vc_edge_pointI;]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `n` UNABBREV_TAC; + REWR 3; + TYPE_THEN `n` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* --- *) + REWRITE_TAC[GSYM mk_segment_vc]; + FIRST_ASSUM DISJ_CASES_TAC; + MESON_TAC[mk_segment_sym]; + (* -- *) + TYPE_THEN `e` UNABBREV_TAC; + FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;]; + TYPE_THEN `B` UNABBREV_TAC; + TYPE_THEN `(m = m') /\ (n = right m') \/ (m = right m') /\ (n = m')` SUBAGOAL_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[hc_edge_pointI;]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `n` UNABBREV_TAC; + REWR 3; + TYPE_THEN `n` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -- *) + REWRITE_TAC[GSYM mk_segment_hc]; + FIRST_ASSUM DISJ_CASES_TAC; + MESON_TAC[mk_segment_sym]; + KILL 6; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[pointI_inj]; + REWRITE_TAC[pointI]; + ]);; + (* }}} *) + +let simple_arc_finite_lemma3 = prove_by_refinement( + `!E e v v'. simple_arc_end e v v' /\ + FINITE E /\ + e SUBSET UNIONS E /\ + E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\ + E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\ + (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\ + (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==> + (?(N:num) t f. + (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\ + (f (&0) = v) /\ (f (&1) = v') /\ + (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\ + (!i j. (i < j) /\ (i < N) /\ (j < N) ==> (t i < t j)) /\ + continuous f (top_of_metric (UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ + (!x. &0 <= x /\ x <= &1 ==> + ( (?m. f x = pointI m) = (?k. (k < N) /\ (x = t k)))) /\ + (&0 = t 0) /\ (&1 = t (N - 1)) /\ + (!i. (SUC i < N) ==> (?ed. (edge ed) /\ + (IMAGE f { x | t i <= x /\ x <= t (SUC i) } = + closure top2 ed)))) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma2; + TYPE_THEN `N` EXISTS_TAC; + TYPE_THEN `t` EXISTS_TAC; + TYPE_THEN `f` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC; + COPY 0; + COPY 1; + TSPEC `eps_hyper F (w 1)` 21; + TSPEC `eps_hyper T (w 0)` 1; + TSPEC `z` 20; + TSPEC `eps` 20; + TSPEC `z'` 0; + TSPEC `eps'` 0; + FULL_REWRITE_TAC[eps_hyper_inj]; + TYPE_THEN `z` UNABBREV_TAC; + TYPE_THEN `z'` UNABBREV_TAC; + TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[pointI]; + TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC; + REWRITE_TAC[int_neg;int_abstr;int_of_num_th;]; + TYPE_THEN `!j. (integer (-- &j))` SUBAGOAL_TAC; + REWRITE_TAC[is_int]; + MESON_TAC[]; + USE 24 (REWRITE_RULE[int_rep]); + USE 19 (MATCH_MP point_onto); + REWRITE_TAC[point_inj]; + TYPE_THEN `w` UNABBREV_TAC; + FULL_REWRITE_TAC[coord01;PAIR_SPLIT]; + (* -A *) + SUBCONJ_TAC; + TYPE_THEN `?m. v = pointI m` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end; + USE 8 (MATCH_MP simple_arc_end_simple); + USE 8 (MATCH_MP simple_arc_euclid); + ASM_MESON_TAC[subset_imp]; + UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&0`])); + REDUCE_TAC; + TYPE_THEN `(?k. k <| N /\ (&0 = t k))` SUBAGOAL_TAC; + USE 9 SYM; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + AP_TERM_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(0 < k) ==> (k = 0)`); + USE 16 (REWRITE_RULE[IMAGE;SUBSET ]); + USE 16 (CONV_RULE NAME_CONFLICT_CONV); + TSPEC `t 0` 16; + LEFT 16 "x'" ; + TSPEC `0` 16; + TYPE_THEN `0 < N` SUBAGOAL_TAC; + UND 21 THEN UND 20 THEN ARITH_TAC; + REWR 16; + USE 23 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`)); + UND 23 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* -B *) + SUBCONJ_TAC; + TYPE_THEN `?m. v' = pointI m` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end2; + USE 8 (MATCH_MP simple_arc_end_simple); + USE 8 (MATCH_MP simple_arc_euclid); + ASM_MESON_TAC[subset_imp]; + UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&1`])); + REDUCE_TAC; + REWRITE_TAC[ARITH_RULE `1 <= 1`]; + USE 18 SYM; + REDUCE_TAC; + (* -- *) + TYPE_THEN `(?k. k <| N /\ (&1 = t k))` SUBAGOAL_TAC; + USE 9 SYM; + TYPE_THEN `m` EXISTS_TAC; + ASM_REWRITE_TAC[]; + AP_TERM_TAC; + IMATCH_MP_TAC (ARITH_RULE `(k < N) /\ ~(k < N - 1) ==> (k = N - 1)`); + USE 16 (REWRITE_RULE[IMAGE;SUBSET ]); + USE 22 (CONV_RULE NAME_CONFLICT_CONV); + TSPEC `t (N-1)` 22; + LEFT 22 "x'" ; + TSPEC `N-1` 22; + UND 22 THEN DISCH_THEN (THM_INTRO_TAC[]); + UND 21 THEN ARITH_TAC; + REWR 22; + USE 22 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`)); + UND 22 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 16 THEN ARITH_TAC; + (* -C *) + USE 20 SYM; + USE 18 SYM; + TYPE_THEN `&0 <= t i /\ t i <= &1` SUBAGOAL_TAC; + USE 16 (REWRITE_RULE[SUBSET;IMAGE]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + UND 19 THEN ARITH_TAC; + (* - *) + TYPE_THEN `&0 <= t (SUC i) /\ t (SUC i) <= &1` SUBAGOAL_TAC; + USE 16 (REWRITE_RULE[SUBSET;IMAGE]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `SUC i` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `connected top2 (IMAGE f {x | t i < x /\ x < t (SUC i)})` SUBAGOAL_TAC; + IMATCH_MP_TAC connect_image; + TYPE_THEN `top_of_metric (UNIV,d_real)` EXISTS_TAC; + REWRITE_TAC[top2_unions]; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + USE 10 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 26 THEN UND 27 THEN UND 23 THEN UND 22 THEN REAL_ARITH_TAC; + (* --D *) + REWRITE_TAC[connect_real_open]; + (* - *) + TYPE_THEN `!x. &0 <= x /\ x <= &1 /\ ~(IMAGE t {j | j<| N} x) ==> (?e. edge e /\ (e (f x)))` SUBAGOAL_TAC; + TYPE_THEN `e` UNABBREV_TAC; + USE 6 (REWRITE_RULE[SUBSET;UNIONS;IMAGE ]); + USE 6 (CONV_RULE NAME_CONFLICT_CONV); + TSPEC `f x` 6; + UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]); + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TSPEC `u'` 1; + REWRITE_TAC[]; + TYPE_THEN `u'` UNABBREV_TAC; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`z`;`eps`]); + TYPE_THEN `z` UNABBREV_TAC; + (* --E *) + TYPE_THEN `euclid 2 (f x)` SUBAGOAL_TAC; + USE 8 (MATCH_MP simple_arc_end_simple); + USE 0 (MATCH_MP simple_arc_euclid); + USE 0 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + TYPE_THEN `?C. cell C /\ C (f x)` SUBAGOAL_TAC; + USE 0 (MATCH_MP point_onto); + THM_INTRO_TAC[`p`] cell_unions; + USE 1 (REWRITE_RULE[UNIONS]); + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `C` EXISTS_TAC; + FULL_REWRITE_TAC[cell]; + UND 29 THEN REP_CASES_TAC; + TYPE_THEN `C` UNABBREV_TAC; + FULL_REWRITE_TAC[INR IN_SING]; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + TYPE_THEN `(?k. k <| N /\ (x = t k))` SUBAGOAL_TAC; + USE 9 SYM; + UNIFY_EXISTS_TAC; + TYPE_THEN `x` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 26 THEN REWRITE_TAC[]; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + REWRITE_TAC[edge_h]; + REWRITE_TAC[edge_v]; + TYPE_THEN `C` UNABBREV_TAC; + USE 1 (REWRITE_RULE[squ]); + TYPE_THEN `f x` UNABBREV_TAC; + USE 6 (REWRITE_RULE[eps_hyper]); + UND 6 THEN COND_CASES_TAC; + FULL_REWRITE_TAC[e1]; + FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_F]; + FULL_REWRITE_TAC[point_inj]; + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `u` UNABBREV_TAC; + (* ---F *) + FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;]; + UND 30 THEN UND 31 THEN INT_ARITH_TAC; + (* -- *) + FULL_REWRITE_TAC[e2]; + FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_S]; + FULL_REWRITE_TAC[point_inj]; + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `v''` UNABBREV_TAC; + FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;]; + UND 1 THEN UND 29 THEN INT_ARITH_TAC; + (* -G *) + THM_INTRO_TAC[`(IMAGE f {x | t i < x /\ x < t (SUC i)})`] connected_in_edge; + REWRITE_TAC[IMAGE;SUBSET;UNIONS]; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + UND 29 THEN UND 22 THEN REAL_ARITH_TAC; + CONJ_TAC; + UND 23 THEN UND 28 THEN REAL_ARITH_TAC; + USE 30 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` UNABBREV_TAC; + USE 28 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`)); + UND 30 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC (ARITH_RULE `~(x = y) /\ ~(x <| y) ==> (y < x)`); + CONJ_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + USE 29 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`)); + UND 32 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i <| N` SUBAGOAL_TAC; + UND 19 THEN ARITH_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(x = y) /\ ~(x <| y) ==> (y < x)`); + CONJ_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + UND 33 THEN UND 30 THEN ARITH_TAC; + (* - *) + TYPE_THEN `e'` EXISTS_TAC; + (* -H *) + TYPE_THEN `C = IMAGE f {x | t i <= x /\ x <= t (SUC i)}` ABBREV_TAC ; + IMATCH_MP_TAC simple_arc_end_edge_full_closure; + KILL 5; + KILL 4; + KILL 2; + KILL 3; + KILL 0; + KILL 17; + TYPE_THEN `v` UNABBREV_TAC; + TYPE_THEN `v'` UNABBREV_TAC; + TYPE_THEN `!k. k <| N ==> (?m. f (t k) = pointI m)` SUBAGOAL_TAC; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`t k`]); + USE 16 (REWRITE_RULE[IMAGE;SUBSET]); + ASM_MESON_TAC[]; + TYPE_THEN `k` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + COPY 0; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + UND 19 THEN ARITH_TAC; + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]); + TYPE_THEN `m` EXISTS_TAC; + TYPE_THEN `m'` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `A /\ B ==> B /\ A`); + CONJ_TAC; + TYPE_THEN `C` UNABBREV_TAC; + USE 5 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `pointI m` UNABBREV_TAC; + TYPE_THEN `pointI m'` UNABBREV_TAC; + USE 27 (REWRITE_RULE[IMAGE;SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `~(x' = t i)` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `~(x' = t (SUC i))` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + UND 5 THEN UND 2 THEN UND 15 THEN UND 14 THEN REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[simple_arc_end]; + THM_INTRO_TAC[`&0`;`&1`;`t i`;`t (SUC i)`;`C`;`f`;`t i`;`t (SUC i)`] arc_restrict; + REWRITE_TAC[REAL_ARITH `x <= x`]; + USE 11 (REWRITE_RULE[top2]); + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 19 THEN ARITH_TAC; + IMATCH_MP_TAC inj_subset_domain; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET]; + UND 4 THEN UND 5 THEN UND 22 THEN UND 23 THEN REAL_ARITH_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[top2]; + (* Tue Dec 21 19:05:25 EST 2004 *) + + ]);; + (* }}} *) + +let order_lt_imp_psegment = prove_by_refinement( + `!f n. + INJ f {p | p <| n} edge /\ + 0 <| n /\ + (!i j. + i <| n /\ j <| n /\ (i < j) + ==> (adj (f i) (f j) = (SUC i = j) )) + ==> psegment (IMAGE f {p | p <| n})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC order_imp_psegment; + REP_BASIC_TAC; + TYPE_THEN `i <| j` ASM_CASES_TAC; + TYPE_THEN `~(SUC j = i)` SUBAGOAL_TAC; + UND 6 THEN UND 5 THEN ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i = j` ASM_CASES_TAC; + REWRITE_TAC[adj]; + UND 7 THEN ARITH_TAC; + TYPE_THEN `j <| i` SUBAGOAL_TAC; + UND 6 THEN UND 5 THEN ARITH_TAC; + TYPE_THEN `~(SUC i = j)` SUBAGOAL_TAC; + UND 8 THEN UND 7 THEN ARITH_TAC; + ONCE_REWRITE_TAC[adj_symm]; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + + +let simple_arc_finite_lemma4 = prove_by_refinement( + `!E e v v'. simple_arc_end e v v' /\ + FINITE E /\ + e SUBSET UNIONS E /\ + E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\ + E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\ + (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\ + (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==> + (?S a b. segment_end S a b /\ (v = pointI a) /\ (v' = pointI b) /\ + (e = closure top2 (UNIONS S))) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`;`e`;`v`;`v'`]simple_arc_finite_lemma3; + ASM_REWRITE_TAC[]; + (* - *) + REWRITE_TAC[segment_end]; + LEFT 9 "ed"; + LEFT 9 "ed"; + TYPE_THEN `S = IMAGE ed {p | p <| N - 1}` ABBREV_TAC ; + TYPE_THEN `S` EXISTS_TAC; + TYPE_THEN `!i. i <| N ==> (?m. f (t i) = pointI m)` SUBAGOAL_TAC; + USE 10 SYM; + USE 11 SYM; + UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`t i`]); + USE 19 (REWRITE_RULE[IMAGE;SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `0 <| N` SUBAGOAL_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(N = 0) ==> (0 <| N)`); + TYPE_THEN `N` UNABBREV_TAC; + FULL_REWRITE_TAC[ARITH_RULE `0 -| 1 = 0`]; + UND 10 THEN UND 11 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `?a. f (t 0) = pointI a` SUBAGOAL_TAC; + TYPE_THEN `?b. f (t (N - 1)) = pointI b` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 22 THEN ARITH_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + (* - *) + TYPE_THEN `v = pointI a` SUBAGOAL_TAC; + TYPE_THEN `v` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `v' = pointI b` SUBAGOAL_TAC; + TYPE_THEN `v'` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* -A *) + TYPE_THEN `(INJ ed {p | p <| N-1 } edge) /\ ( 0 <| N-1) /\ (!i j. i <| N-1 /\ j <| N-1 /\ i <| j ==> (adj (ed i) (ed j) <=> (SUC i = j)))` SUBAGOAL_TAC; + TYPE_THEN `S` UNABBREV_TAC; + SUBCONJ_TAC; (* // *) + REWRITE_TAC[INJ]; + CONJ_TAC; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + UND 20 THEN ARITH_TAC; + TYPE_THEN `!x y. x < y /\ y <| N - 1 ==> ~(ed x = ed y)` SUBAGOAL_TAC; + TYPE_THEN `t x' < t y'` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 31 THEN UND 30 THEN ARITH_TAC; + COPY 9; + UND 33 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + UND 31 THEN UND 30 THEN ARITH_TAC; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`y'`]); + UND 30 THEN ARITH_TAC; + TYPE_THEN `ed x'` UNABBREV_TAC; + TYPE_THEN `IMAGE f {x | t x' <= x /\ x <= t (SUC x')} (f (t x'))` SUBAGOAL_TAC; + USE 33 SYM; + IMATCH_MP_TAC image_imp; + CONJ_TAC; + REAL_ARITH_TAC; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 31 THEN UND 30 THEN ARITH_TAC; + TYPE_THEN `IMAGE f {x | t y' <= x /\ x <= t (SUC y')} (f (t x'))` SUBAGOAL_TAC; + USE 33 SYM; + ASM_REWRITE_TAC[]; + USE 36 (REWRITE_RULE[IMAGE]); + USE 13 (REWRITE_RULE[INJ]); + TYPE_THEN `t x' = x''` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 11 SYM; + USE 10 SYM; + USE 19 (REWRITE_RULE[IMAGE;SUBSET]); + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + UND 31 THEN UND 30 THEN ARITH_TAC; + TYPE_THEN `&0 <= t y' /\ t y' <= &1` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `y'` EXISTS_TAC; + UND 30 THEN ARITH_TAC; + CONJ_TAC; + UND 41 THEN UND 38 THEN ARITH_TAC; + TYPE_THEN `&0 <= t (SUC y') /\ t (SUC y') <= &1` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `SUC y'` EXISTS_TAC; + UND 30 THEN ARITH_TAC; + UND 42 THEN UND 37 THEN ARITH_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + UND 38 THEN UND 32 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC (ARITH_RULE `(~(x <| y) /\ ~(y < x)) ==> (x = y)`); + CONJ_TAC; + UND 30 THEN UND 29 THEN UND 27 THEN UND 20 THEN MESON_TAC[]; + UND 30 THEN UND 29 THEN UND 28 THEN UND 20 THEN MESON_TAC[]; + (* -- *) + SUBCONJ_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(0 = N-1) ==> (0 <| N- 1)`); + TYPE_THEN `N -| 1` UNABBREV_TAC; + UND 10 THEN UND 11 THEN REAL_ARITH_TAC; + (* --B *) + TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); + UND 31 THEN ARITH_TAC; + USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 9; + USE 9 SYM; + REWRITE_TAC[IMAGE]; + REWRITE_TAC[CONJ_ACI]; + (* -- *) + REWRITE_TAC[adj;EMPTY_EXISTS;INTER ]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `x = x'` SUBAGOAL_TAC; + USE 13 (REWRITE_RULE[INJ]); + USE 10 SYM; + USE 11 SYM; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC; + USE 19 (REWRITE_RULE[IMAGE;SUBSET]); + TYPE_THEN `&0 <= t j' /\ t j' <= &1` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j'` EXISTS_TAC; + UND 41 THEN ARITH_TAC; + TYPE_THEN `&0 <= t (SUC j') /\ t (SUC j') <= &1` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `SUC j'` EXISTS_TAC; + UND 41 THEN ARITH_TAC; + UND 44 THEN UND 39 THEN UND 43 THEN UND 40 THEN REAL_ARITH_TAC; + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `j` EXISTS_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `t i < t j` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN UND 29 THEN ARITH_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `t j <= t (SUC i)` SUBAGOAL_TAC; + UND 35 THEN UND 33 THEN REAL_ARITH_TAC; + USE 40 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`)); + UND 40 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 39 THEN UND 27 THEN UND 28 THEN UND 29 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `j` UNABBREV_TAC; + CONJ_TAC; + TYPE_THEN `i = SUC i` SUBAGOAL_TAC; + USE 20 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 33 THEN ARITH_TAC; + TYPE_THEN `f (t (SUC i))` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `t (SUC i)` EXISTS_TAC; + REWRITE_TAC[REAL_ARITH `x <= x`]; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + TYPE_THEN `t (SUC i)` EXISTS_TAC; + REWRITE_TAC[REAL_ARITH `x <= x`]; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + (* - *) + TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC; + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + UND 30 THEN ARITH_TAC; + USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 9; + USE 9 SYM; + REWRITE_TAC[IMAGE]; + REWRITE_TAC[CONJ_ACI]; + (* - *) + USE 11 SYM; + USE 10 SYM; + TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC; + USE 19 (REWRITE_RULE[IMAGE;SUBSET]); + TYPE_THEN `&0 <= t j /\ t j <= &1` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` EXISTS_TAC; + UND 33 THEN ARITH_TAC; + TYPE_THEN `&0 <= t (SUC j) /\ t (SUC j) <= &1` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `SUC j` EXISTS_TAC; + UND 33 THEN ARITH_TAC; + UND 36 THEN UND 31 THEN UND 35 THEN UND 32 THEN REAL_ARITH_TAC; + (* -C *) + ONCE_REWRITE_TAC[CONJ_ACI]; + SUBCONJ_TAC; + THM_INTRO_TAC[`ed`;`N-| 1`] order_lt_imp_psegment; + ASM_REWRITE_TAC[]; + TYPE_THEN `S` UNABBREV_TAC; + (* - *) + TYPE_THEN `{a, b} SUBSET endpoint S` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET;INR in_pair]; + REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`S`;`pointI x`] num_closure1; + USE 32 (REWRITE_RULE[psegment;segment]); + FIRST_ASSUM DISJ_CASES_TAC; (* // *) + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `ed (N -2)` EXISTS_TAC; + TYPE_THEN `S` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `x' < N -| 2` SUBAGOAL_TAC; + IMATCH_MP_TAC (ARITH_RULE `x' < N -| 1 /\ ~(x' = N-2) ==> x' < N -2`); + PROOF_BY_CONTR_TAC; + REWR 37; + TYPE_THEN `x'` UNABBREV_TAC; + (* ---- *) + TYPE_THEN `pointI b` UNABBREV_TAC; + UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[]; + USE 10 SYM; + TYPE_THEN `t (N -1) = x''` SUBAGOAL_TAC; + USE 13 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + USE 10 SYM; + REDUCE_TAC; + REWRITE_TAC[ARITH_RULE `1 <= 1`]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + USE 20 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); + UND 20 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 37 THEN ARITH_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + CONJ_TAC; + TYPE_THEN `N-| 2` EXISTS_TAC; + UND 28 THEN ARITH_TAC; + TYPE_THEN `N -| 2 < N -| 1` SUBAGOAL_TAC; + UND 28 THEN ARITH_TAC; + TYPE_THEN `t (N - 1)` EXISTS_TAC; + TYPE_THEN `SUC (N - 2) = N - 1` SUBAGOAL_TAC; + UND 28 THEN ARITH_TAC; + USE 10 SYM; + REWRITE_TAC[REAL_ARITH `x <= x`]; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + (* --D *) + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `ed (0)` EXISTS_TAC; + TYPE_THEN `S` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `0 < x'` SUBAGOAL_TAC; + IMATCH_MP_TAC (ARITH_RULE `~(x' = 0) ==> 0 < x'`); + TYPE_THEN `x'` UNABBREV_TAC; + (* --- *) + TYPE_THEN `pointI a` UNABBREV_TAC; + UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[]; + USE 11 SYM; + TYPE_THEN `t (0) = x''` SUBAGOAL_TAC; + USE 13 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + USE 11 SYM; + REDUCE_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + USE 25 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`)); + UND 25 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 38 THEN ARITH_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + CONJ_TAC; + TYPE_THEN `0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `t (0)` EXISTS_TAC; + REDUCE_TAC; + USE 11 SYM; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + (* -E *) + SUBCONJ_TAC; + IMATCH_MP_TAC has_size2_pair; + CONJ_TAC; + IMATCH_MP_TAC endpoint_size2; + USE 33 (REWRITE_RULE[SUBSET;INR in_pair]); + CONJ_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `a` UNABBREV_TAC; + TYPE_THEN `v = v'` SUBAGOAL_TAC; + USE 8(MATCH_MP simple_arc_end_distinct); + UND 8 THEN ASM_REWRITE_TAC[]; + (* -F *) + IMATCH_MP_TAC EQ_EXT ; + THM_INTRO_TAC[`S`;`top2`] closure_unions; + REWRITE_TAC[top2_top]; + FULL_REWRITE_TAC[psegment;segment]; + TYPE_THEN `S` UNABBREV_TAC; + REWRITE_TAC[UNIONS]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + USE 20 (REWRITE_RULE[IMAGE]); + (* -- *) + TYPE_THEN `A = {i | (i <=| N -| 1) /\ (t i <= x')}` ABBREV_TAC ; + TYPE_THEN `FINITE A` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{i | i <=| (N -| 1)}` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + REWRITE_TAC[FINITE_NUMSEG_LE]; + TYPE_THEN `A 0` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + UND 28 THEN ARITH_TAC; + THM_INTRO_TAC[`A`] select_num_max; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `0` EXISTS_TAC; + TYPE_THEN `x' = &1` ASM_CASES_TAC; + TYPE_THEN `closure top2 (ed (N -| 2))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + IMATCH_MP_TAC image_imp; + UND 28 THEN ARITH_TAC; + USE 24 SYM; + TYPE_THEN `N - 2 <| N - 1` SUBAGOAL_TAC; + UND 28 THEN ARITH_TAC; + TYPE_THEN `t (N -| 1)` EXISTS_TAC; + TYPE_THEN `N - 1 = SUC (N - 2)` SUBAGOAL_TAC; + UND 28 THEN ARITH_TAC; + USE 10 SYM; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `x <= x`]; + IMATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 28 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `closure top2 (ed z)` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + IMATCH_MP_TAC image_imp; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`); + DISCH_TAC; + TYPE_THEN `z` UNABBREV_TAC; + UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC; + TYPE_THEN `z <| N-1` SUBAGOAL_TAC; + IMATCH_MP_TAC (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`); + TYPE_THEN `A` UNABBREV_TAC; + DISCH_TAC; + TYPE_THEN `z` UNABBREV_TAC; + UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC (REAL_ARITH `~(x <= y) ==> (y <= x)`); + UND 41 THEN DISCH_THEN (THM_INTRO_TAC[`SUC z`]); + UND 44 THEN ARITH_TAC; + UND 41 THEN ARITH_TAC; + (* -G *) + USE 36 (REWRITE_RULE[IMAGE]); + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + UND 30 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x`]); + REWR 30; + IMATCH_MP_TAC image_imp; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x''` EXISTS_TAC; + (* Wed Dec 22 07:47:58 EST 2004 *) + ]);; + (* }}} *) + +let psegment_cls = prove_by_refinement( + `!S. psegment S ==> IMAGE pointI (cls S) SUBSET closure top2 (UNIONS S)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[cls;IMAGE;SUBSET]; + THM_INTRO_TAC[`S`;`top2`] closure_unions; + FULL_REWRITE_TAC[top2_top;psegment;segment]; + REWRITE_TAC[UNIONS;IMAGE]; + CONV_TAC (dropq_conv "u"); + UNIFY_EXISTS_TAC; + ]);; + (* }}} *) + +let planar_graph_rectagonal = prove_by_refinement( + `!(G:(A,B)graph_t). planar_graph G /\ FINITE (graph_edge G) /\ + FINITE (graph_vertex G) /\ + ~(graph_edge G = {}) /\ + (!v. CARD (graph_edge_around G v) <=| 4) ==> + (rectagonal_graph G)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`G`] graph_int_model; + REWRITE_TAC[rectagonal_graph;rectagon_graph]; + TYPE_THEN `graph H` SUBAGOAL_TAC; + FULL_REWRITE_TAC[good_plane_graph;plane_graph]; + TYPE_THEN `!e. graph_edge H e ==> (?S a b. segment_end S a b /\ (graph_inc H e = { (pointI a), (pointI b) }) /\ (e = closure top2 (UNIONS S)))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[good_plane_graph]; + TSPEC `e` 10; + REWR 10; + THM_INTRO_TAC[`H`;`e`] graph_edge_end_select; + UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`v`;`v'`]); + THM_INTRO_TAC[`E`;`e`;`v`;`v'`] simple_arc_finite_lemma4; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`H`;`e`] graph_inc_subset; + TYPE_THEN `graph_vertex H v` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `graph_vertex H v'` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `S` EXISTS_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + USE 18 SYM; + IMATCH_MP_TAC has_size2_subset_ne; + CONJ_TAC; + IMATCH_MP_TAC graph_edge2; + REWRITE_TAC[SUBSET;INR in_pair]; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + USE 19 SYM; + ASM_REWRITE_TAC[]; + USE 20 SYM; + ASM_REWRITE_TAC[]; + UND 15 THEN ASM_REWRITE_TAC[]; + (* -A *) + LEFT 13 "S"; + LEFT 13 "S"; + (* - *) + TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC; + TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + REWRITE_TAC[pointI]; + TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC; + REWRITE_TAC[int_neg_num_th]; + USE 16 (MATCH_MP point_onto); + REWRITE_TAC[point_inj]; + TYPE_THEN `w` UNABBREV_TAC; + FULL_REWRITE_TAC[coord01;PAIR_SPLIT]; + (* -- *) + TYPE_THEN `!v. graph_vertex H v ==> ?a. (v = pointI a)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[good_plane_graph;plane_graph]; + ASM_MESON_TAC[subset_imp]; + LEFT 15 "a"; + LEFT 15 "a"; + TYPE_THEN `J = mk_graph_t (IMAGE a (graph_vertex H), IMAGE S (graph_edge H),endpoint)` ABBREV_TAC ; + TYPE_THEN `J` EXISTS_TAC; + (* - *) + TYPE_THEN `graph_isomorphic H J` SUBAGOAL_TAC; + REWRITE_TAC[graph_isomorphic;graph_iso]; + LEFT_TAC "u"; + TYPE_THEN `a` EXISTS_TAC; + LEFT_TAC "v"; + TYPE_THEN `S` EXISTS_TAC; + TYPE_THEN `a,S` EXISTS_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph]; + CONJ_TAC; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + TYPE_THEN `x = pointI (a x)` SUBAGOAL_TAC; + TYPE_THEN `y = pointI (a y)` SUBAGOAL_TAC; + TYPE_THEN `a x` UNABBREV_TAC; + TYPE_THEN `pointI (a y)` UNABBREV_TAC; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + TYPE_THEN `x = closure top2 (UNIONS (S x))` SUBAGOAL_TAC; + USE 16 SYM; + ASM_MESON_TAC[]; + TYPE_THEN `y = closure top2 (UNIONS (S y))` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `S x` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -- *) + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`e`]); + THM_INTRO_TAC[`H`;`e`] graph_inc_subset; + REWR 19; + USE 19 (REWRITE_RULE[SUBSET;INR in_pair]); + TYPE_THEN `IMAGE a {(pointI a'), (pointI b)} = {a', b}` SUBAGOAL_TAC; + REWRITE_TAC[IMAGE ;INR in_pair]; + IMATCH_MP_TAC EQ_EXT ; + REWRITE_TAC[INR in_pair]; + NAME_CONFLICT_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + DISJ1_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + TSPEC `pointI b` 15; + USE 15 (REWRITE_RULE[pointI_inj]); + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + DISJ2_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + TSPEC `pointI a'` 15; + USE 15 (REWRITE_RULE[pointI_inj]); + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + (* --- *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `pointI b` EXISTS_TAC; + TSPEC `pointI b` 15; + USE 15 (REWRITE_RULE[pointI_inj]); + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `pointI a'` EXISTS_TAC; + TSPEC `pointI a'` 15; + USE 15 (REWRITE_RULE[pointI_inj]); + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[segment_end]; + (* -B *) + REWRITE_TAC[GSYM CONJ_ASSOC]; + SUBCONJ_TAC; + THM_INTRO_TAC[`H`;`J`] graph_isomorphic_graph; + SUBCONJ_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[SUBSET;graph_edge_mk_graph]; + USE 16 (REWRITE_RULE[IMAGE]); + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + FULL_REWRITE_TAC[segment_end]; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[graph_inc_mk_graph]; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `J` UNABBREV_TAC; + FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph]; + USE 22 (REWRITE_RULE[IMAGE]); + USE 23 (REWRITE_RULE[IMAGE]); + COPY 13; + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + UND 25 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + PROOF_BY_CONTR_TAC; (* repeat from - to here // *) + USE 30 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + TYPE_THEN `edge u` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `(UNIONS (S x) SUBSET closure top2 (UNIONS (S x)))` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_closure; + REWRITE_TAC[top2_top]; + TYPE_THEN `(UNIONS (S x') SUBSET closure top2 (UNIONS (S x')))` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_closure; + REWRITE_TAC[top2_top]; + TYPE_THEN `UNIONS (S x) SUBSET x` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `UNIONS (S x') SUBSET x'` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + USE 36 (REWRITE_RULE[UNIONS;SUBSET]); + USE 35 (REWRITE_RULE[UNIONS;SUBSET]); + LEFT 35 "u" ; + LEFT 35 "u" ; + LEFT 36 "u" ; + LEFT 36 "u" ; + TSPEC `u` 36; + TSPEC `u` 35; + TYPE_THEN `u SUBSET x` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `u SUBSET x'` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[good_plane_graph;plane_graph]; + UND 39 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`x'`]); + DISCH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + UND 21 THEN ASM_REWRITE_TAC[]; + USE 39 (REWRITE_RULE[INTER;SUBSET]); + TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `u` UNABBREV_TAC; + USE 32 (MATCH_MP edge_cell); + USE 32 (MATCH_MP cell_nonempty); + UND 32 THEN (REWRITE_TAC[]); + USE 44 (REWRITE_RULE[EMPTY_EXISTS]); + TSPEC `u'` 39; + TYPE_THEN `graph_vertex H u'` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[subset_imp]; + UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`u'`]); + UND 15 THEN UND 44 THEN UND 32 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); + FULL_REWRITE_TAC[edge]; + TYPE_THEN `c = a u'` ABBREV_TAC ; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses]; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses]; + (* -C *) + TYPE_THEN `graph_isomorphic J G` SUBAGOAL_TAC; + THM_INTRO_TAC[`G`;`H`;`J`] graph_isomorphic_trans; + IMATCH_MP_TAC graph_isomorphic_symm; + IMATCH_MP_TAC planar_is_graph; + (* - *) + TYPE_THEN `J` UNABBREV_TAC; + FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph]; + USE 23 (REWRITE_RULE[IMAGE]); + USE 24 (REWRITE_RULE[IMAGE]); + COPY 13; + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + IMATCH_MP_TAC SUBSET_ANTISYM; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + CONJ_TAC THEN (IMATCH_MP_TAC endpoint_cls); + FULL_REWRITE_TAC[segment_end;psegment;segment]; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + (* -D *) + TYPE_THEN `IMAGE pointI (cls(S x') INTER cls(S x)) SUBSET (IMAGE pointI (endpoint (S x') INTER endpoint (S x)))` BACK_TAC; + THM_INTRO_TAC[`pointI`] image_inj; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `UNIV:int#int ->bool` EXISTS_TAC; + REWRITE_TAC[INJ]; + FULL_REWRITE_TAC[pointI_inj]; + (* - *) + TYPE_THEN `!A B. (IMAGE pointI (A INTER B) = IMAGE pointI A INTER IMAGE pointI B)` SUBAGOAL_TAC; + IMATCH_MP_TAC inj_inter; + TYPE_THEN `UNIV:int#int->bool` EXISTS_TAC; + TYPE_THEN `UNIV:(num->real)->bool` EXISTS_TAC; + REWRITE_TAC[INJ]; + FULL_REWRITE_TAC[pointI_inj]; + (* - *) + TYPE_THEN `IMAGE pointI (endpoint (S x')) = graph_inc H x'` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair]; + MESON_TAC[]; + TYPE_THEN `IMAGE pointI (endpoint (S x)) = graph_inc H x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR in_pair]; + MESON_TAC[]; + USE 28 SYM; + USE 30 SYM; + (* -E *) + TYPE_THEN `!e. graph_edge H e ==> (graph_inc H e = e INTER graph_vertex H)` SUBAGOAL_TAC; + USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]); + TYPE_THEN `x' INTER x SUBSET graph_vertex H` SUBAGOAL_TAC; + USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]); + FIRST_ASSUM IMATCH_MP_TAC ; + UND 24 THEN UND 23 THEN UND 16 THEN MESON_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `x' INTER x` EXISTS_TAC; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + UND 36 THEN REWRITE_TAC[INTER;SUBSET;] THEN MESON_TAC[]; + (* - *) + IMATCH_MP_TAC subset_inter_pair; + (* -F *) + UND 31 THEN UND 13 THEN UND 29 THEN UND 27 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); + FULL_REWRITE_TAC[segment_end]; + ASM_MESON_TAC[psegment_cls]; + (* Wed Dec 22 11:18:27 EST 2004 *) + + ]);; + (* }}} *) + +let cartesian_finite = prove_by_refinement( + `!(A:A->bool) (B:B->bool). FINITE A /\ FINITE B ==> + FINITE (cartesian A B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `cartesian A B = {(x,y) | (x IN A) /\ (y IN B)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[cartesian]; + IMATCH_MP_TAC FINITE_PRODUCT; + ]);; + (* }}} *) + +let three_t_finite = prove_by_refinement( + `FINITE (UNIV:three_t ->bool)`, + (* {{{ proof *) + [ + THM_INTRO_TAC[`ABS3 0`] three_delete_size; + FULL_REWRITE_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[FINITE_DELETE]; + ]);; + (* }}} *) + +let three_t_size3 = prove_by_refinement( + `(UNIV:three_t ->bool) HAS_SIZE 3`, + (* {{{ proof *) + [ + THM_INTRO_TAC[`ABS3 0`] three_delete_size; + FULL_REWRITE_TAC[HAS_SIZE]; + FULL_REWRITE_TAC[FINITE_DELETE]; + THM_INTRO_TAC[`ABS3 0`;`UNIV:three_t->bool`;] CARD_SUC_DELETE; + ASM_REWRITE_TAC[]; + USE 2 SYM; + ASM_REWRITE_TAC[]; + ARITH_TAC; + ]);; + (* }}} *) + +let k33_nonplanar = prove_by_refinement( + `~(planar_graph k33_graph)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`k33_graph`] planar_graph_rectagonal; + REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex]; + ASSUME_TAC three_t_finite; + ASSUME_TAC bool_size; + FULL_REWRITE_TAC[HAS_SIZE]; + CONJ_TAC; + IMATCH_MP_TAC cartesian_finite; + CONJ_TAC; + IMATCH_MP_TAC cartesian_finite; + (* -- *) + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + TYPE_THEN `(ABS3 0,ABS3 0)` EXISTS_TAC; + REWRITE_TAC[cartesian;PAIR_SPLIT]; + MESON_TAC[]; + REWRITE_TAC[graph_edge_around]; + REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex;cartesian_univ]; + TYPE_THEN `E = {e | (v = FST e,T) \/ (v = SND e,F)}` ABBREV_TAC ; + TYPE_THEN `SND v ==> (E = IMAGE (\ f. (FST v, f)) UNIV)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE]; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `~(SND v) ==> (E = IMAGE (\ f. (f,FST v)) UNIV)` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE]; + REWRITE_TAC[PAIR_SPLIT]; + NAME_CONFLICT_TAC; + MESON_TAC[]; + TYPE_THEN `CARD E <=| CARD (UNIV:three_t ->bool)` SUBAGOAL_TAC; + TYPE_THEN `SND v` ASM_CASES_TAC; + IMATCH_MP_TAC CARD_IMAGE_LE; + IMATCH_MP_TAC CARD_IMAGE_LE; + ASSUME_TAC three_t_size3; + FULL_REWRITE_TAC[HAS_SIZE]; + UND 8 THEN UND 7 THEN ARITH_TAC; + (* - *) + ASSUME_TAC rectagon_graph_k33_false; + UND 2 THEN ASM_REWRITE_TAC[]; + (* Wed Dec 22 11:57:49 EST 2004 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION Z *) +(* ------------------------------------------------------------------ *) + +(* show the complement of a simple arc is connected *) + + +let grid33 = jordan_def `grid33 m = + rectangle_grid (FST m -: &:1, SND m -: &:1) + (FST m +: &:2, SND m +: &:2)`;; + +let grid = jordan_def `grid f N = + UNIONS (IMAGE + ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1))) + {j | j <= N})`;; + +let grid33_conn2 = prove_by_refinement( + `!m. conn2 (grid33 m)`, + (* {{{ proof *) + + [ + REWRITE_TAC[grid33]; + TYPE_THEN `SUC 2 = 3` SUBAGOAL_TAC; + ARITH_TAC; + TYPE_THEN `a = FST m -: &:1` ABBREV_TAC ; + TYPE_THEN `FST m +: &:2 = a +: &:(SUC 2)` SUBAGOAL_TAC; + TYPE_THEN `a` UNABBREV_TAC; + INT_ARITH_TAC; + TYPE_THEN `b = SND m -: &:1` ABBREV_TAC ; + TYPE_THEN `SND m +: &:2 = b +: &:(SUC 2)` SUBAGOAL_TAC; + TYPE_THEN `b` UNABBREV_TAC; + ARITH_TAC; + USE 0 SYM; + THM_INTRO_TAC[`2`;`2`;`(a,b)`] rectangle_grid_conn2; + FULL_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let grid_finite = prove_by_refinement( + `!f N. FINITE (grid f N)`, + (* {{{ proof *) + [ + REWRITE_TAC[ grid]; + TYPE_THEN `FINITE (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N}) ` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + REWRITE_TAC[FINITE_NUMSEG_LE]; + ASM_SIMP_TAC[FINITE_FINITE_UNIONS]; + USE 1 (REWRITE_RULE[IMAGE]); + THM_INTRO_TAC[`floor (f (&x / &N) 0),floor (f (&x / &N) 1)`] grid33_conn2; + FULL_REWRITE_TAC[conn2]; + ]);; + (* }}} *) + +let grid33_edge = prove_by_refinement( + `!m. grid33 m SUBSET edge `, + (* {{{ proof *) + [ + REWRITE_TAC[grid33;rectangle_grid_edge]; + ]);; + (* }}} *) + +let grid_edge = prove_by_refinement( + `!f N . grid f N SUBSET edge `, + (* {{{ proof *) + + [ + REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ]; + TYPE_THEN `u` UNABBREV_TAC; + ASM_MESON_TAC[grid33_edge;subset_imp]; + ]);; + + (* }}} *) + +let floor_add_num = prove_by_refinement( + `!x m. floor (x + &m) = floor x +: &:m`, + (* {{{ proof *) + [ + REWRITE_TAC [floor_range;int_add_th;int_of_num_th;]; + THM_INTRO_TAC[`x`;`floor x`] floor_range; + REWR 0; + UND 0 THEN UND 1 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_abs = prove_by_refinement( + `!x y m. (abs (x -. y) <= &m) ==> (||: (floor x -: floor y) <=: &:m)`, + (* {{{ proof *) + [ + TYPE_THEN `!x y m. (y <. x) /\ (x - y <= &m) ==> (floor x -: floor y <=: &:m)` SUBAGOAL_TAC; + THM_INTRO_TAC[`x`;`y + &m`] floor_mono; + UND 0 THEN REAL_ARITH_TAC; + FULL_REWRITE_TAC[floor_add_num]; + UND 2 THEN INT_ARITH_TAC ; + TYPE_THEN `y = x` ASM_CASES_TAC; + TYPE_THEN `y` UNABBREV_TAC; + FULL_REWRITE_TAC[REAL_ARITH `x -. x = &0`;ABS_0;INT_SUB_REFL;INT_ABS_0;int_le ; int_of_num_th]; + ASM_REWRITE_TAC[]; + TYPE_THEN `y <= x` ASM_CASES_TAC; + TYPE_THEN `abs (x - y) = (x - y)` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_REFL]; + UND 3 THEN REAL_ARITH_TAC; + REWR 0; + TYPE_THEN `floor y <=: floor x` SUBAGOAL_TAC; + IMATCH_MP_TAC floor_mono; + TYPE_THEN `||: (floor x -: floor y) = (floor x -: floor y)` SUBAGOAL_TAC; + REWRITE_TAC[INT_ABS_REFL]; + UND 5 THEN INT_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 2 THEN UND 3 THEN REAL_ARITH_TAC; + TYPE_THEN `x < y` SUBAGOAL_TAC; + UND 2 THEN UND 3 THEN REAL_ARITH_TAC; + (* -A *) + TYPE_THEN `abs (x - y) = (y - x)` SUBAGOAL_TAC; + UND 4 THEN REAL_ARITH_TAC; + REWR 0; + TYPE_THEN `floor x <=: floor y` SUBAGOAL_TAC; + IMATCH_MP_TAC floor_mono; + UND 4 THEN REAL_ARITH_TAC; + TYPE_THEN `||: (floor x -: floor y) = (floor y -: floor x)` SUBAGOAL_TAC; + UND 6 THEN INT_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let d_euclid_floor = prove_by_refinement( + `!x y i n. (euclid n x) /\ (euclid n y) /\ (d_euclid x y < &1) ==> + (||: (floor (x i) -: floor (y i)) <=: &:1)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC floor_abs; + THM_INTRO_TAC[`n`;`x`;`y`;`i`] proj_contraction; + UND 3 THEN UND 0 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +extend_simp_rewrites[prove_by_refinement( + `!x . x/ &0 = &0 `, + (* {{{ proof *) + [ + REWRITE_TAC[REAL_INV_0;real_div;REAL_MUL_RZERO]; + ])];; + (* }}} *) + +extend_simp_rewrites[INR in_pair ; INR IN_SING];; + +extend_simp_rewrites[REAL_POS];; + +let real_eq_div = prove_by_refinement( + `!x y z. ~(z = &0) ==> ((x / z = y) <=> (x = y * z))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `&0 < z` ASM_CASES_TAC; + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ]; + TYPE_THEN `&0 < -- z` SUBAGOAL_TAC; + UND 0 THEN UND 1 THEN REAL_ARITH_TAC; + TYPE_THEN `x / z = (--x)/(--z)` SUBAGOAL_TAC; + REWRITE_TAC[real_div;REAL_INV_NEG;REAL_NEG_MUL2]; + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let grid_conn2_induct_lemma = prove_by_refinement( + `!k f N. + (k <= N) /\ (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\ + (!i. (i < N) ==> d_euclid (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==> + conn2 (UNIONS (IMAGE + ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1))) + {j | j <= k}))`, + (* {{{ proof *) + + [ + INDUCT_TAC; + TYPE_THEN `{j | j <=| 0} = {0}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_SING]; + ARITH_TAC; + REWRITE_TAC[IMAGE;INR IN_SING ]; + TYPE_THEN `{y | ?x. (x = 0) /\ (y = grid33 (floor (f (&x / &N) 0),floor (f (&x / &N) 1)))} = {(grid33 (floor (f (&0 / &N) 0), floor (f (&0 / &N) 1)))}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + NAME_CONFLICT_TAC; + REWRITE_TAC[INR IN_SING]; + CONV_TAC (dropq_conv "x'"); + REWRITE_TAC[grid33_conn2]; + (* - *) + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`f`;`N`]); + UND 2 THEN ARITH_TAC; + TYPE_THEN `{j | j <=| SUC k} = {j | j <=| k} UNION {(SUC k)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;]; + ARITH_TAC; + REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1]; + IMATCH_MP_TAC conn2_union_edge; + ASM_REWRITE_TAC[grid33_conn2]; + (* - *) + CONJ_TAC; + REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ]; + TYPE_THEN `u` UNABBREV_TAC; + ASM_MESON_TAC[grid33_edge;subset_imp]; + REWRITE_TAC[EMPTY_EXISTS]; + REWRITE_TAC[grid33_edge]; + TYPE_THEN `{j | j <=| k} = {j | j <| k} UNION {k}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING]; + ARITH_TAC; + REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1]; + ONCE_REWRITE_TAC[INTER_COMM]; + REWRITE_TAC[UNION_OVER_INTER]; + REWRITE_TAC[UNION]; + RIGHT_TAC "u"; + DISJ2_TAC; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]); + UND 2 THEN ARITH_TAC; + (* -A *) + TYPE_THEN `a = floor (f (&k / &N) 0)` ABBREV_TAC ; + TYPE_THEN `b = floor (f (&k / &N) 1)` ABBREV_TAC ; + TYPE_THEN `a' = floor (f (&(SUC k) / &N) 0)` ABBREV_TAC ; + TYPE_THEN `b' = floor (f (&(SUC k) / &N) 1)` ABBREV_TAC ; + TYPE_THEN `h_edge (a,b)` EXISTS_TAC; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + REWRITE_TAC[grid33]; + REWRITE_TAC[rectangle_grid_h]; + INT_ARITH_TAC; + (* - *) + TYPE_THEN `!k. (k <=| N) ==> euclid 2 (f (&k / &N))` SUBAGOAL_TAC; + USE 1(REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC image_imp; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_DIV; + TYPE_THEN `&N = &0` ASM_CASES_TAC; + REWRITE_TAC[]; + REAL_ARITH_TAC; + TYPE_THEN `&0 < &N` SUBAGOAL_TAC; + UND 11 THEN REWRITE_TAC[REAL_OF_NUM_EQ;REAL_LT] THEN ARITH_TAC; + ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + UND 10 THEN REWRITE_TAC[REAL_LE;REAL_OF_NUM_MUL] THEN ARITH_TAC ; + (* - *) + TYPE_THEN `euclid 2 (f (&k/ &N))` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 2 THEN ARITH_TAC; + TYPE_THEN `euclid 2 (f (&(SUC k)/ &N))` SUBAGOAL_TAC; + (* - *) + THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`0`;`2`] d_euclid_floor; + THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`1`;`2`] d_euclid_floor; + TYPE_THEN `||: (a - a') <=: &:1` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `||: (b - b') <=: &:1` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILL 14 THEN KILL 13; + KILL 5 THEN KILL 4; + KILL 3 THEN KILL 1; + REWRITE_TAC[grid33]; + REWRITE_TAC[rectangle_grid_h]; + UND 16 THEN UND 15 THEN INT_ARITH_TAC; + (* Thu Dec 23 10:46:15 EST 2004 *) + + ]);; + + (* }}} *) + +let grid_conn2 = prove_by_refinement( + `!f N. (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\ + (!i. (i < N) ==> d_euclid (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==> + conn2 (grid f N)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`N`;`f`;`N`] grid_conn2_induct_lemma; + ARITH_TAC; + REWRITE_TAC[grid]; + ]);; + (* }}} *) + +let simple_arc_uniformly_continuous = prove_by_refinement( + `!f . continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> + uniformly_continuous f + ({x | &0 <= x /\ x <= &1},d_real) + (euclid 2,d_euclid)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASSUME_TAC metric_real; + IMATCH_MP_TAC compact_uniformly_continuous; + THM_INTRO_TAC[`&0`;`&1`] interval_compact; + THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] compact_subset; + REWRITE_TAC[metric_real]; + REWR 4; + KILL 4; + KILL 3; + (* - *) + TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} SUBSET euclid 2` SUBAGOAL_TAC; + IMATCH_MP_TAC inj_image_subset; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + (* -A *) + SUBCONJ_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + (* -// *) + THM_INTRO_TAC[`f`;`top_of_metric(UNIV,d_real)`;`top2`;`{x | &0 <= x /\ x <= &1}`] continuous_induced_domain; + ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions]; + (* - *) + THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_induced; + REWRITE_TAC[metric_real]; + REWR 5; + THM_INTRO_TAC[`f`;`{x | &0 <= x /\ x <= &1}`;`euclid 2`;`d_real`;`d_euclid`] metric_continuous_continuous; + USE 7 SYM; + FULL_REWRITE_TAC[top2]; + (* Thu Dec 23 11:29:49 EST 2004 *) + ]);; + (* }}} *) + +let num_abs_of_int_mono = prove_by_refinement( + `!a b. &:0 <= a /\ a <= b ==> num_abs_of_int a <= num_abs_of_int b`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM REAL_LE;num_abs_of_int_th;GSYM int_abs_th;GSYM int_le ]; + UND 0 THEN UND 1 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let floor_num = prove_by_refinement( + `!n. floor (&n) = &:n`, + (* {{{ proof *) + [ + REWRITE_TAC[floor_range]; + REWRITE_TAC[int_of_num_th;]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let floor_neg_num = prove_by_refinement( + `!n. floor (-- &n) = -- (&:n)`, + (* {{{ proof *) + [ + REWRITE_TAC[floor_range]; + REWRITE_TAC[int_neg_th;int_of_num_th;]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let delta_partition_lemma = prove_by_refinement( + `!delta. (&0 < delta) ==> (?N. !x. ?i. (0 < N) /\ + ((&0 <= x /\ x <= &1) ==> (i <= N) /\ abs (&i/ &N - x) < delta))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE; + TYPE_THEN `n` EXISTS_TAC; + TYPE_THEN `num_abs_of_int (floor (&n*x))` EXISTS_TAC; + TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC; + TYPE_THEN `&0 < &n` SUBAGOAL_TAC; + UND 1 THEN UND 2 THEN REAL_ARITH_TAC; + TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC; + ASM_MESON_TAC[REAL_LE_LDIV_EQ]; + CONJ_TAC; + FULL_REWRITE_TAC[REAL_LT]; + TYPE_THEN `&:0 <= floor (&n * x)` SUBAGOAL_TAC; + TYPE_THEN `floor (&0) <=: floor (&n * x)` BACK_TAC; + FULL_REWRITE_TAC[floor_num]; + IMATCH_MP_TAC floor_mono; + IMATCH_MP_TAC REAL_LE_MUL; + (* - *) + CONJ_TAC; + TYPE_THEN `num_abs_of_int (floor (&n * x)) <= num_abs_of_int (floor (&n))` BACK_TAC; + FULL_REWRITE_TAC[floor_num;num_abs_of_int_num]; + IMATCH_MP_TAC num_abs_of_int_mono; + IMATCH_MP_TAC floor_mono; + TYPE_THEN `&n * x <= &n * &1` BACK_TAC; + UND 8 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + (* -A *) + IMATCH_MP_TAC REAL_LT_LCANCEL_IMP; + TYPE_THEN `&n` EXISTS_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN`&1` EXISTS_TAC; + (* - *) + REWRITE_TAC[num_abs_of_int_th;]; + TYPE_THEN `abs (real_of_int (floor (&n * x))) = (real_of_int (floor (&n *x)))` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_REFL]; + FULL_REWRITE_TAC [int_le; int_of_num_th;]; + TYPE_THEN `!u. &n * abs (u / &n - x) = abs (u - &n*x)` SUBAGOAL_TAC; + TYPE_THEN `!t. &n * abs t = abs (&n *t)` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM]; + AP_TERM_TAC; + REWRITE_TAC[REAL_SUB_LDISTRIB]; + TYPE_THEN `&n * u/ &n = u` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 10 THEN UND 3 THEN REAL_ARITH_TAC; + TYPE_THEN `t = &n * x ` ABBREV_TAC ; + TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC; + REWRITE_TAC[floor_ineq]; + TYPE_THEN `abs (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC; + UND 11 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`t`] floor_ineq; + UND 13 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let simple_arc_ball_cover = prove_by_refinement( + `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> + (?N. !x. ?i. (0 < N) /\ (&0 <= x /\ x <= &1 ==> + (i <= N) /\ + open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; + FULL_REWRITE_TAC[uniformly_continuous]; + TSPEC `&1` 2; + UND 2 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRITE_TAC[open_ball]; + THM_INTRO_TAC[`delta`] delta_partition_lemma; + TYPE_THEN `N` EXISTS_TAC; + TSPEC `x` 4; + TYPE_THEN `i` EXISTS_TAC; + REP_BASIC_TAC; + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]); + (* - *) + TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_DIV; + THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ; + REWRITE_TAC[REAL_LT]; + REWRITE_TAC[REAL_MUL;REAL_LE]; + UND 8 THEN ARITH_TAC; + (* - *) + FULL_REWRITE_TAC[INJ]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[d_real]; + ]);; + (* }}} *) + +let unbounded_diff = prove_by_refinement( + `!G. unbounded_set G = UNIONS(ctop G) DIFF (bounded_set G)`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM bounded_unbounded_union]; + IMATCH_MP_TAC EQ_EXT; + THM_INTRO_TAC[`G`] bounded_unbounded_disj; + UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[]; + ]);; + (* }}} *) + +let bounded_diff = prove_by_refinement( + `!G. bounded_set G = UNIONS(ctop G) DIFF (unbounded_set G)`, + (* {{{ proof *) + [ + REWRITE_TAC[GSYM bounded_unbounded_union]; + IMATCH_MP_TAC EQ_EXT; + THM_INTRO_TAC[`G`] bounded_unbounded_disj; + UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[]; + ]);; + (* }}} *) + +let rectangle_grid_subset = prove_by_refinement( + `!p q r s. (FST p <=: FST r) /\ (SND p <= SND r) /\ + (FST s <= FST q) /\ (SND s <= SND q) ==> + rectangle_grid r s SUBSET rectangle_grid p q`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;rectangle_grid]; + FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[cell_clauses] THEN CONV_TAC (dropq_conv "m'"); + UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; + UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let grid_image_bounded = prove_by_refinement( + `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> + (?N. (0 < N) /\ ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER + (unbounded_set (grid f N)) = EMPTY)) `, + (* {{{ proof *) + [ + REWRITE_TAC[EQ_EMPTY;INTER;]; + THM_INTRO_TAC[`f`] simple_arc_ball_cover; + TYPE_THEN `N` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + RIGHT 2 "i"; + RIGHT 2 "x"; + TYPE_THEN `x''` UNABBREV_TAC; + FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ]; + UND 2 THEN REWRITE_TAC[]; + UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + REWR 2; + FULL_REWRITE_TAC[open_ball]; + (* _ *) + IMATCH_MP_TAC bounded_avoidance_subset; + TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ; + TYPE_THEN `E` EXISTS_TAC; + (* _ *) + TYPE_THEN `conn2 E` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[grid33_conn2]; + REWRITE_TAC[grid_edge;grid_finite]; + TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC; + REWRITE_TAC[grid]; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UND 6 THEN ARITH_TAC; + REWRITE_TAC[IMAGE_UNION;UNIONS_UNION]; + REWRITE_TAC[SUBSET;UNION]; + DISJ1_TAC; + REWRITE_TAC[image_sing]; + (* _ *) + TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC; + UND 3 THEN REWRITE_TAC[]; + THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset; + USE 3 (MATCH_MP UNIONS_UNIONS); + ASM_MESON_TAC[subset_imp]; + KILL 13; + KILL 3; + (* _A *) + TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ; + THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq; + FULL_REWRITE_TAC []; + REWR 13; + TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[grid33]; + IMATCH_MP_TAC rectangle_grid_subset; + (* __ *) + THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor; + THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor; + UND 3 THEN UND 11 THEN INT_ARITH_TAC; + (* _ *) + IMATCH_MP_TAC bounded_avoidance_subset; + TYPE_THEN `E'` EXISTS_TAC; + TYPE_THEN `conn2 E'` SUBAGOAL_TAC; + IMATCH_MP_TAC conn2_rectagon; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + (* _ *) + TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[grid33_edge]; + (* _ *) + ASM_SIMP_TAC[GSYM odd_bounded]; + REWRITE_TAC[UNIONS]; + TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC; + IMATCH_MP_TAC (TAUT ` a/\ b ==> b /\ a`); + (* -B *) + TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC; + UND 14 THEN REWRITE_TAC[]; + THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset; + USE 14 (MATCH_MP UNIONS_UNIONS); + ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ; + TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC; + UND 19 THEN REWRITE_TAC[]; + REWRITE_TAC[UNIONS]; + TYPE_THEN `h_edge m` EXISTS_TAC; + REWRITE_TAC[curve_cell_h_ver2]; + USE 20 (REWRITE_RULE[PAIR_SPLIT]); + REWR 3; + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[INSERT]; + (* - *) + TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC; + UND 19 THEN REWRITE_TAC[]; + REWRITE_TAC[UNIONS]; + TYPE_THEN `v_edge m` EXISTS_TAC; + REWRITE_TAC[curve_cell_v_ver2]; + USE 20 (REWRITE_RULE[PAIR_SPLIT]); + REWR 3; + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[INSERT]; + (* - *) + TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC; + UND 19 THEN REWRITE_TAC[]; + REWRITE_TAC[UNIONS]; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + ASM_SIMP_TAC[rectagon_segment;curve_cell_cls]; + USE 20 (REWRITE_RULE[PAIR_SPLIT]); + REWR 3; + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INSERT]; + USE 24 (MATCH_MP cls_subset); + USE 24 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[cls_h]; + (* -C *) + USE 9 (MATCH_MP point_onto); + THM_INTRO_TAC[`p`] square_domain; + UND 24 THEN LET_TAC; + TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC; + TYPE_THEN `m` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + REWR 24; + TYPE_THEN `point p` UNABBREV_TAC; + USE 24 (REWRITE_RULE[UNION;INR IN_SING;]); + REWR 9; + (* -D *) + ASM_SIMP_TAC[rectagon_segment;par_cell_squ]; + FULL_REWRITE_TAC[num_lower]; + USE 20 (REWRITE_RULE[PAIR_SPLIT]); + REWR 3; + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[INSERT;cell_clauses]; + REWR 24; + (* - *) + TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[up;PAIR_SPLIT]; + INT_ARITH_TAC; + REWR 24; + FULL_REWRITE_TAC[card_sing;EVEN2]; + (* Thu Dec 23 20:25:33 EST 2004 *) + + ]);; + (* }}} *) + +let conn2_sequence_lemma1 = prove_by_refinement( + `!k G N . (k <= N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ + (!i. (i <= N) ==> (G i SUBSET edge )) /\ + (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) ==> + conn2 (UNIONS (IMAGE G ({i | i <=| k})))`, + (* {{{ proof *) + [ + INDUCT_TAC; + TYPE_THEN `{i | i <=| 0} = {0}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT ; + ARITH_TAC; + REWRITE_TAC[image_sing]; + (* - *) + UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`G`;`N`]); + UND 3 THEN ARITH_TAC; + TYPE_THEN `{i | i <=| SUC k} = {i | i <= k} UNION {(SUC k)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + ARITH_TAC; + REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION]; + IMATCH_MP_TAC conn2_union_edge; + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + REWRITE_TAC[UNIONS;IMAGE;SUBSET]; + FULL_REWRITE_TAC[SUBSET]; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + UND 8 THEN UND 3 THEN ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `u` UNABBREV_TAC; + REWRITE_TAC[INTER]; + TYPE_THEN`{i | i <=| k} = {i | i <| k} UNION {k}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + ARITH_TAC; + (* - *) + REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION]; + REWRITE_TAC[UNION]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]); + FULL_REWRITE_TAC[INTER]; + TYPE_THEN `u` EXISTS_TAC; + ]);; + (* }}} *) + +let thread_finite_union = prove_by_refinement( + `!(A:(A->bool)->(B->bool)) S. + (FINITE S) /\ (!a b. A (a UNION b) = A a UNION A b) /\ + (A EMPTY = EMPTY) ==> + (A (UNIONS S) = UNIONS (IMAGE A S))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!k S. S HAS_SIZE k ==> (A (UNIONS S) = UNIONS (IMAGE A S))` SUBAGOAL_TAC THENL [INDUCT_TAC;ALL_TAC]; + FULL_REWRITE_TAC[HAS_SIZE_0]; + ASM_REWRITE_TAC[IMAGE_CLAUSES;UNIONS_0;]; + THM_INTRO_TAC[`S'`;`k`] HAS_SIZE_SUC; + REWR 5; + USE 6 (REWRITE_RULE[EMPTY_EXISTS]); + TSPEC `u` 5; + TSPEC `S' DELETE u` 4; + TYPE_THEN `S' = (S' DELETE u) UNION {u}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + UND 6 THEN REWRITE_TAC[DELETE;UNION;INR IN_SING ] THEN MESON_TAC[]; + UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + ASM_REWRITE_TAC[UNIONS_UNION;IMAGE_UNION;image_sing;]; + (* - *) + UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`CARD S`;`S`]); + ASM_REWRITE_TAC[HAS_SIZE]; + ]);; + (* }}} *) + +let conn2_sequence_lemma2 = prove_by_refinement( + `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ + (!i. (i <= N) ==> (G i SUBSET edge )) /\ + (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\ + (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\ + ~(unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==> + (bounded_set (UNIONS (IMAGE G {i | i <=| N})) p)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC [unbounded_diff;DIFF;DE_MORGAN_THM;]; + UND 6 THEN ASM_REWRITE_TAC[]; + USE 0 (ONCE_REWRITE_RULE[DISJ_SYM]); + FIRST_ASSUM DISJ_CASES_TAC; + KILL 0; + FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM;]; + (* - *) + COPY 1; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`]); + UND 5 THEN ARITH_TAC; + REWR 6; + (* - *) + TYPE_THEN `?j. (j <=| N) /\ UNIONS (curve_cell (G j)) p` SUBAGOAL_TAC; + TYPE_THEN `!r. UNIONS (curve_cell r) = (UNIONS o curve_cell) r` SUBAGOAL_TAC; + REWRITE_TAC[o_DEF]; + REWR 6; + TYPE_THEN `A = UNIONS o curve_cell` ABBREV_TAC ; + THM_INTRO_TAC[`A`;`IMAGE G {i | i <=| N}`] thread_finite_union; + CONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + REWRITE_TAC[FINITE_NUMSEG_LE]; + TYPE_THEN `A` UNABBREV_TAC; + USE 9 GSYM; + CONJ_TAC; + REWRITE_TAC[curve_cell_union;UNIONS_UNION]; + REWRITE_TAC[curve_cell_empty;]; + USE 11 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `p` 11; + TYPE_THEN `A` UNABBREV_TAC; + KILL 9; + FULL_REWRITE_TAC[IMAGE_o]; + FULL_REWRITE_TAC[o_DEF]; + REWR 11; + FULL_REWRITE_TAC[GSYM UNIONS_IMAGE_UNIONS]; + USE 9 (REWRITE_RULE[UNIONS]); + USE 11 (REWRITE_RULE[IMAGE]); + TYPE_THEN `u'` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `x'` EXISTS_TAC; + REWRITE_TAC[UNIONS]; + TYPE_THEN `u` EXISTS_TAC; + (* - *) + FULL_REWRITE_TAC[curve_cell_union;UNIONS_UNION]; + FULL_REWRITE_TAC[UNION;DE_MORGAN_THM]; + TYPE_THEN `j = 0` ASM_CASES_TAC; + REWR 9; + (* - *) + TYPE_THEN `?i. j = SUC i` SUBAGOAL_TAC ; + TYPE_THEN `j - 1` EXISTS_TAC; + UND 12 THEN ARITH_TAC; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + REWR 10; + TYPE_THEN `j` UNABBREV_TAC; + UND 14 THEN ASM_REWRITE_TAC[]; + (* Fri Dec 24 07:02:02 EST 2004 *) + + ]);; + (* }}} *) + +let conn2_sequence_lemma3 = prove_by_refinement( + `!G N. (!i. (i <= N) ==> (G i SUBSET edge )) ==> + (UNIONS (IMAGE G {i | i <=| N}) SUBSET edge)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[UNIONS;IMAGE;SUBSET ]; + UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + ASM_MESON_TAC[subset_imp]; + ]);; + (* }}} *) + +let unbounded_avoidance_subset_ver2 = prove_by_refinement( + `!E E' x. + unbounded_set E' x /\ + E SUBSET E' /\ + E' SUBSET edge /\ + FINITE E' /\ + conn2 E + ==> unbounded_set E x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`;`E'`;`x`] unbounded_avoidance_subset; + THM_INTRO_TAC[`E'`;`x`] unbounded_subset_unions; + FULL_REWRITE_TAC[ctop_unions;DIFF]; + UND 6 THEN ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let conn2_sequence_lemma4 = prove_by_refinement( + `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ + (!i. (i <= N) ==> (G i SUBSET edge )) /\ + (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\ + (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\ + (bounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==> + (?C i j . rectagon C /\ bounded_set C p /\ + (SUC i < j) /\ (j <=| N) /\ + (C SUBSET (UNIONS (IMAGE G ({x | (i <=| x) /\ (x <=| j)})))) /\ + (!C' i' j'. rectagon C' /\ bounded_set C' p /\ + (i' < j') /\ (j' <=| N) /\ + (C' SUBSET (UNIONS (IMAGE G ({x | (i' <=| x /\ x <=| j')})))) ==> + (j - i <= j' - i') /\ + ((j - i = j' - i') ==> + (CARD (C DIFF (G (SUC i))) <= CARD (C' DIFF (G (SUC i')))))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1; + ARITH_TAC; + TYPE_THEN `X = {(C,i,j) | rectagon C /\ bounded_set C p /\ (i <| j) /\ (j <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i <=| x /\ x <=| j})) }` ABBREV_TAC ; + TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC; + UND 8 THEN REWRITE_TAC[EMPTY_EXISTS]; + THM_INTRO_TAC[`UNIONS (IMAGE G {i | i <=| N})`] rectagon_surround_conn2; + IMATCH_MP_TAC conn2_sequence_lemma3; + TYPE_THEN `(C,0,N)` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `0` EXISTS_TAC; + TYPE_THEN `N` EXISTS_TAC; + REWRITE_TAC[ARITH_RULE `!x. 0 <=| x`]; + ARITH_TAC; + (* -A *) + THM_INTRO_TAC[`X`;`(\ (C,i,j). j -| i):(((((num->real)->bool)->bool)#(num#num)) -> num)`] select_image_num_min; + UND 8 THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `?D i j. z = (D,i,j)` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `z` UNABBREV_TAC; + (* - *) + TYPE_THEN `Y = {(C,i',j') | rectagon C /\ bounded_set C p /\ (i' <| j') /\ (j' <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i' <=| x /\ x <=| j'})) /\ (j' - i' = j - i) }` ABBREV_TAC ; + TYPE_THEN `~(Y = EMPTY)` SUBAGOAL_TAC; + UND 12 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `(D,i,j)` EXISTS_TAC; + TYPE_THEN `Y` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `D` EXISTS_TAC; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `j` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + USE 7 (REWRITE_RULE[PAIR_SPLIT]); + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`Y`;`\ (C,i',(j':num)). (CARD (C DIFF (G (SUC i'))))`] select_image_num_min; + UND 12 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `?C i' j'. z' = (C,i',j')` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `z'` UNABBREV_TAC; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `i'` EXISTS_TAC; + TYPE_THEN `j'` EXISTS_TAC; + USE 11 SYM; + REWR 14; + USE 11 SYM; + USE 14 (REWRITE_RULE[PAIR_SPLIT]); + TYPE_THEN `C'` UNABBREV_TAC; + TYPE_THEN `i''` UNABBREV_TAC; + TYPE_THEN `j''` UNABBREV_TAC; + (* -B *) + CONJ_TAC; + TYPE_THEN `(SUC i' <| j') \/ (SUC i' = j')` SUBAGOAL_TAC; + UND 18 THEN ARITH_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `j'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); + TYPE_THEN `{x | i' <=| x /\ x <=| SUC i'} = {i'} UNION {(SUC i')}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + ARITH_TAC; + REWR 16; + USE 16 (REWRITE_RULE[UNIONS_UNION;image_sing;IMAGE_UNION]); + (* -- *) + THM_INTRO_TAC[`C`;`(G i' UNION G (SUC i'))`;`p`]unbounded_avoidance_subset_ver2; + REWRITE_TAC[union_subset]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UND 17 THEN ARITH_TAC; + CONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + TYPE_THEN `i' <=| N` SUBAGOAL_TAC; + UND 17 THEN ARITH_TAC; + FULL_REWRITE_TAC[conn2]; + IMATCH_MP_TAC conn2_rectagon; + (* -- *) + THM_INTRO_TAC[`C`] bounded_unbounded_disj; + USE 24 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPEC `p` 24; + UND 24 THEN ASM_REWRITE_TAC[]; + (* -C *) + TYPE_THEN `X (C'',i''',j''')` SUBAGOAL_TAC; + TYPE_THEN `X` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `C''` EXISTS_TAC; + TYPE_THEN `i'''` EXISTS_TAC; + TYPE_THEN `j'''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + TSPEC `(C'',i''',j''')` 9; + USE 9 (GBETA_RULE); + (* - *) + TYPE_THEN `Y (C'',i''',j''')` SUBAGOAL_TAC; + TYPE_THEN `Y` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `C''` EXISTS_TAC; + TYPE_THEN `i'''` EXISTS_TAC; + TYPE_THEN `j'''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`(C'',i''',j''')`]); +(*** Removed by JRH; no longer needed with paired beta in default rewrites + USE 13 (GBETA_RULE); + ***) + (* Fri Dec 24 12:26:34 EST 2004 *) + ]);; + (* }}} *) + +let endpoint_sub_rectagon = prove_by_refinement( + `!C G m. rectagon G /\ C SUBSET G /\ endpoint C m ==> + (?!e. G e /\ ~(C e) /\ cls {e} m)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + FULL_REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`C`;`pointI m`] num_closure1; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `G` EXISTS_TAC; + FULL_REWRITE_TAC[rectagon]; + REWR 3; + FULL_REWRITE_TAC[rectagon]; + KILL 2; + TSPEC `m` 4; + USE 2 (REWRITE_RULE[INSERT]); + USE 2 (ONCE_REWRITE_RULE[TAUT `a \/ b <=> b \/ a`]); + FIRST_ASSUM DISJ_CASES_TAC; + THM_INTRO_TAC[`G`;`pointI m`] num_closure0; + REWR 8; + TSPEC `e` 8; + USE 1 (REWRITE_RULE[SUBSET]); + TSPEC `e` 3; + ASM_MESON_TAC[]; + (* -A *) + COPY 3; + TSPEC `e` 8; + USE 8 (REWRITE_RULE[]); + THM_INTRO_TAC[`G`;`pointI m`] num_closure2; + REWR 10; + COPY 10; + TSPEC `e` 10; + TYPE_THEN `G e` SUBAGOAL_TAC; + USE 1 (REWRITE_RULE[SUBSET]); + TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[cls]; + REWRITE_TAC[EXISTS_UNIQUE_ALT]; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `b` EXISTS_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + TSPEC `y` 12; + REWR 12; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `y` UNABBREV_TAC; + UND 18 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `y` UNABBREV_TAC; + TSPEC `b` 3; + TSPEC `b` 12; + REWR 12; + REWR 3; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `a` EXISTS_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + TSPEC `y` 12; + REWR 12; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `y` UNABBREV_TAC; + UND 18 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `y` UNABBREV_TAC; + TSPEC `a` 3; + TSPEC `a` 12; + REWR 12; + REWR 3; + TYPE_THEN `a` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Mon Dec 27 15:17:28 EST 2004 *) + ]);; + (* }}} *) + +let cut_rectagon_unique = prove_by_refinement( + `!E A B C m n. rectagon E /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\ + segment_end A m n /\ segment_end B m n /\ segment_end C m n /\ + (E = A UNION B) /\ (A INTER B = EMPTY) ==> + (C = A) \/ (C = B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!A. A SUBSET E /\ segment_end A m n /\ ~(A INTER C = EMPTY) ==> (A SUBSET C)` SUBAGOAL_TAC; + TYPE_THEN `inductive_set A' (A' INTER C)` SUBAGOAL_TAC; + REWRITE_TAC[inductive_set]; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET]; + FULL_REWRITE_TAC[INTER]; + TYPE_THEN `edge C' /\ edge C''` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end;psegment;segment]; + UND 16 THEN UND 15 THEN UND 13 THEN MESON_TAC[subset_imp]; + THM_INTRO_TAC[`C'`;`C''`] adjv_adj; + THM_INTRO_TAC[`C'`;`C''`] adjv_adj2; + TYPE_THEN `q =adjv C' C''` ABBREV_TAC ; + TYPE_THEN `~(C' = C'')` SUBAGOAL_TAC; + FULL_REWRITE_TAC[adj]; + UND 22 THEN ASM_REWRITE_TAC[]; + (* --- *) + TYPE_THEN `~(endpoint A' q)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + USE 2 SYM; + USE 22 (REWRITE_RULE[endpoint]); + THM_INTRO_TAC[`A'`;`pointI q`] num_closure1; + USE 3 (REWRITE_RULE[psegment;segment]); + REWR 27; + COPY 27; + TSPEC `C'` 27; + TSPEC `C''` 28; + ASM_MESON_TAC[]; + (* ---A *) + TYPE_THEN `~(endpoint C q)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + TYPE_THEN `endpoint A'` UNABBREV_TAC; + TYPE_THEN `endpoint C` UNABBREV_TAC; + UND 22 THEN ASM_REWRITE_TAC[]; + (* --- *) + PROOF_BY_CONTR_TAC; + UND 23 THEN ASM_REWRITE_TAC[]; + IMATCH_MP_TAC rectagon_subset_endpoint; + USE 1 SYM; + TYPE_THEN `E` EXISTS_TAC; + CONJ_TAC THEN IMATCH_MP_TAC num_closure_pos; + CONJ_TAC; + USE 2 (REWRITE_RULE[segment_end;segment;psegment]); + TYPE_THEN `C'` EXISTS_TAC; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + FULL_REWRITE_TAC[rectagon]; + TYPE_THEN `C''` EXISTS_TAC; + REWRITE_TAC[DIFF]; + USE 11 (REWRITE_RULE[SUBSET]); + (* -- *) + USE 10 (REWRITE_RULE[segment_end;psegment;segment]); + FULL_REWRITE_TAC[inductive_set]; + UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`A' INTER C`]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET_INTER_ABSORPTION]; + (* -B *) + TYPE_THEN `!A B. (A INTER B = EMPTY ) /\ (E = A UNION B) /\ (segment_end B m n) /\ (segment_end A m n) /\ (B SUBSET E) /\ (A SUBSET E) /\ ~(C INTER A = EMPTY) ==> (C = A)` SUBAGOAL_TAC; + TYPE_THEN `A' SUBSET C` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[INTER_COMM]; + UND 10 THEN ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `B' INTER C = EMPTY` ASM_CASES_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `A UNION B` UNABBREV_TAC; + UND 5 THEN UND 18 THEN UND 17 THEN POP_ASSUM_LIST (fun t-> ALL_TAC); + FULL_REWRITE_TAC[SUBSET;INTER;EQ_EMPTY;UNION]; + IMATCH_MP_TAC EQ_EXT ; + TSPEC `x` 0; + TSPEC `x` 1; + TSPEC `x` 2; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `B' SUBSET C` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USE 1 SYM; + TYPE_THEN `E = C` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[subset_imp]; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `A UNION B` UNABBREV_TAC; + USE 5 (REWRITE_RULE[SUBSET;UNION]); + TYPE_THEN `C` UNABBREV_TAC; + USE 2 (REWRITE_RULE[segment_end;psegment]); + UND 20 THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~(C INTER A = EMPTY) \/ ~( C INTER B = EMPTY)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 11 (REWRITE_RULE[DE_MORGAN_THM]); + TYPE_THEN `E` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER;EQ_EMPTY]; + USE 5 (REWRITE_RULE[SUBSET;UNION]); + USE 2 (REWRITE_RULE[segment_end;psegment;segment]); + FULL_REWRITE_TAC[EMPTY_EXISTS]; + TSPEC `u` 1; + TSPEC `u` 11; + TSPEC `u` 12; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + DISJ1_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET;UNION]; + DISJ2_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `A` EXISTS_TAC; + FULL_REWRITE_TAC[INTER_COMM;UNION_COMM]; + ASM_REWRITE_TAC[SUBSET;UNION]; + (* Mon Dec 27 20:34:44 EST 2004 *) + + ]);; + (* }}} *) + +let conn2_sequence_lemma5 = prove_by_refinement( + `!C E . ~(E SUBSET C) /\ psegment E /\ rectagon C /\ + endpoint E SUBSET cls C ==> + (?E'. E' SUBSET E /\ psegment E' /\ (E' INTER C = EMPTY ) /\ + (cls E' INTER cls C = endpoint E'))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?e. E e /\ ~C e` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `J = segment_of (E DIFF C) e` ABBREV_TAC ; + TYPE_THEN `X = { A | psegment A /\ A SUBSET E /\ (A INTER C = EMPTY) /\ (endpoint A SUBSET cls C)}` ABBREV_TAC ; + TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC]; + TYPE_THEN `X` UNABBREV_TAC; + TYPE_THEN `J` EXISTS_TAC; + TYPE_THEN `J SUBSET (E DIFF C)` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + THM_INTRO_TAC[`(E DIFF C)`;`e`] segment_of_G; + REWRITE_TAC[DIFF]; + CONJ_TAC; + THM_INTRO_TAC[`E`;`E DIFF C`;`e`] segment_of_segment; + FULL_REWRITE_TAC[psegment]; + REWRITE_TAC[DIFF;SUBSET]; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[psegment]; + DISCH_TAC; + THM_INTRO_TAC[`segment_of (E DIFF C) e`;`E`] rectagon_subset; + USE 2 (REWRITE_RULE[psegment]); + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E DIFF C` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + USE 2 (REWRITE_RULE[psegment]); + ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + UND 7 THEN REWRITE_TAC[SUBSET;DIFF]; + CONJ_TAC; + UND 7 THEN REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY] THEN MESON_TAC[]; + REWRITE_TAC[SUBSET]; + PROOF_BY_CONTR_TAC; + (* --A *) + THM_INTRO_TAC[`E DIFF C`;`e`] inductive_segment; + REWRITE_TAC[DIFF]; + FULL_REWRITE_TAC[inductive_set]; + USE 8 (REWRITE_RULE[endpoint]); + THM_INTRO_TAC[`J`;`pointI x`] num_closure1; + TYPE_THEN `J` UNABBREV_TAC; + IMATCH_MP_TAC segment_of_finite; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + USE 2 (REWRITE_RULE[psegment;segment]); + REWRITE_TAC[DIFF]; + REWR 13; + USE 2 (REWRITE_RULE[psegment;segment]); + TSPEC `x` 15; + USE 15 (REWRITE_RULE[INSERT]); + UND 15 THEN REP_CASES_TAC; + THM_INTRO_TAC[`E`;`pointI x`] num_closure2; + REWR 15; + (* ---- *) + TYPE_THEN `?a b. ~(a = b) /\ (!e. E e /\ closure top2 e (pointI x) <=> (e = a) \/ (e = b)) /\ (!e. J e /\ closure top2 e (pointI x) <=> (e = a))` SUBAGOAL_TAC; + TYPE_THEN `(e' = a) \/ (e' = b)` SUBAGOAL_TAC; + TSPEC `e'` 15; + USE 15 (ONCE_REWRITE_RULE[EQ_SYM_EQ]); + TSPEC `e'` 13; + TYPE_THEN `J` UNABBREV_TAC; + THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G; + REWRITE_TAC[DIFF]; + USE 21 (REWRITE_RULE[SUBSET]); + TSPEC `e'` 21; + USE 13 (REWRITE_RULE[DIFF]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + TYPE_THEN `a` EXISTS_TAC ; + TYPE_THEN `b` EXISTS_TAC; + MESON_TAC[]; + TYPE_THEN `e'` UNABBREV_TAC; + TYPE_THEN `b` EXISTS_TAC; + TYPE_THEN `a` EXISTS_TAC; + REWRITE_TAC [EQ_SYM_EQ ]; + MESON_TAC[]; + (* ---- *) + USE 6 SYM; + TYPE_THEN `segment_of (E DIFF C) e b'` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `a'` EXISTS_TAC; + CONJ_TAC; + TSPEC `a'` 21; + TYPE_THEN `J` UNABBREV_TAC; + CONJ_TAC; + REWRITE_TAC[DIFF]; + CONJ_TAC; + TSPEC `b'` 22; + KILL 15; + REWR 22; + (* ------ *) + USE 9 (REWRITE_RULE[cls]); + LEFT 9 "e"; + TSPEC `b'` 9; + TSPEC `b'` 22; + KILL 15; + UND 22 THEN ASM_REWRITE_TAC[]; + UND 9 THEN ASM_REWRITE_TAC[]; + (* ----- *) + REWRITE_TAC[adj]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `pointI x` EXISTS_TAC; + KILL 15; + COPY 22; + TSPEC `a'` 15; + TSPEC `b'` 22; + REWR 22; + REWR 15; + (* ---- *) + TSPEC `b'` 21; + TYPE_THEN `J` UNABBREV_TAC; + TSPEC `b'` 22; + KILL 15; + REWR 6; + KILL 13; + UND 21 THEN ASM_REWRITE_TAC[]; + (* --- *) + USE 0 (REWRITE_RULE[SUBSET]); + TSPEC `x` 0; + USE 0 (REWRITE_RULE[endpoint]); + UND 9 THEN ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`J`;`E`;`pointI x`] num_closure_mono; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G; + REWRITE_TAC[DIFF]; + USE 19 (REWRITE_RULE[SUBSET]); + TSPEC `x'` 19; + USE 6 (REWRITE_RULE[DIFF]); + UND 8 THEN UND 15 THEN UND 19 THEN ARITH_TAC; + (* -B *) + THM_INTRO_TAC[`X`] select_card_min; + UND 8 THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `z` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + IMATCH_MP_TAC (TAUT `a /\ b==> b /\ a`); + CONJ_TAC; + REWRITE_TAC[SUBSET_INTER]; + IMATCH_MP_TAC endpoint_cls; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + USE 2 (REWRITE_RULE[psegment;segment]); + REWRITE_TAC[INTER;SUBSET]; + PROOF_BY_CONTR_TAC; + (* - cut along x *) + THM_INTRO_TAC[`z`] endpoint_size2; + FULL_REWRITE_TAC[has_size2]; + TYPE_THEN `segment_end z a b` SUBAGOAL_TAC; + REWRITE_TAC[segment_end]; + (* - *) + THM_INTRO_TAC[`z`;`a`;`b`;`x`] cut_psegment; + TYPE_THEN `endpoint z` UNABBREV_TAC; + USE 15 (REWRITE_RULE[INR in_pair;DE_MORGAN_THM ]); + UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`A`]); + CONJ_TAC; + USE 20 (REWRITE_RULE[segment_end]); + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `z` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + REWRITE_TAC[EQ_EMPTY;INTER]; + USE 10 (REWRITE_RULE[INTER;EQ_EMPTY ]); + TSPEC `x'` 10; + UND 10 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[UNION]; + USE 20 (REWRITE_RULE[segment_end]); + REWRITE_TAC[SUBSET;INR in_pair]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + USE 7 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[]; + USE 9 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); + UND 9 THEN REWRITE_TAC[]; + IMATCH_MP_TAC card_subset_lt; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION]; + CONJ_TAC; + TYPE_THEN `B = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 24 (REWRITE_RULE[EMPTY_EXISTS]); + USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPEC `u` 9; + USE 9 (REWRITE_RULE[UNION]); + UND 22 THEN ASM_REWRITE_TAC[INTER;EMPTY_EXISTS]; + ASM_MESON_TAC[]; + TYPE_THEN `B` UNABBREV_TAC; + USE 19 (REWRITE_RULE[segment_end;psegment;segment]); + (* - *) + TYPE_THEN `A UNION B` UNABBREV_TAC; + USE 12 (REWRITE_RULE[psegment;segment;]); + (* Mon Dec 27 23:01:48 EST 2004 *) + + + ]);; + (* }}} *) + +let conn_splice = prove_by_refinement( + `!E AE B a b a' b'. segment_end E a b /\ segment_end AE a' b' /\ + segment_end B a' b' /\ AE SUBSET E ==> + (?B'. segment_end B' a b /\ B' SUBSET (E DIFF AE) UNION B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `J= (E DIFF AE) UNION B` ABBREV_TAC ; + TYPE_THEN `B SUBSET J` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + TYPE_THEN `cls B SUBSET cls J` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + TYPE_THEN `endpoint B SUBSET cls B` SUBAGOAL_TAC; + IMATCH_MP_TAC endpoint_cls; + USE 1 (REWRITE_RULE[segment_end;segment;psegment]); + (* - *) + TYPE_THEN `cls B a' /\ cls B b'` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + USE 1 (REWRITE_RULE[segment_end]); + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[INR in_pair ]; + TYPE_THEN `cls J a' /\ cls J b'` SUBAGOAL_TAC; + USE 6 (REWRITE_RULE[SUBSET]); + (* -// *) + TYPE_THEN `conn J` SUBAGOAL_TAC ; + TYPE_THEN `!x. cls J x ==> (x = a') \/ (?P. segment_end P x a' /\ P SUBSET J)` BACK_TAC; + REWRITE_TAC[conn]; + TYPE_THEN `a'' = a'` ASM_CASES_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + TYPE_THEN `a''` UNABBREV_TAC; + TSPEC `b''` 12; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b''` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `P` EXISTS_TAC; + (* --- *) + TYPE_THEN `b'' = a'` ASM_CASES_TAC; + TYPE_THEN `b''` UNABBREV_TAC; + TSPEC `a''` 12; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `a''` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `P` EXISTS_TAC; + (* --- *) + COPY 12; + TSPEC `a''` 18; + REWR 15; + TSPEC `b''` 12; + REWR 12; + THM_INTRO_TAC[`P`;`P'`;`a''`;`a'`;`b''`] segment_end_trans; + ONCE_REWRITE_TAC[segment_end_symm]; + TYPE_THEN `U` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `P UNION P'` EXISTS_TAC; + REWRITE_TAC[union_subset]; + (* --A// *) + TYPE_THEN `x = a'` ASM_CASES_TAC; + TYPE_THEN `x = b'` ASM_CASES_TAC; + TYPE_THEN `B` EXISTS_TAC; + ONCE_REWRITE_TAC [segment_end_symm]; + (* -- *) + TYPE_THEN `?P. segment_end P x b' /\ P SUBSET J` ASM_CASES_TAC; + THM_INTRO_TAC[`P`;`B`;`x`;`b'`;`a'`] segment_end_trans; + ONCE_REWRITE_TAC[segment_end_symm]; + TYPE_THEN `U` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `P UNION B` EXISTS_TAC; + REWRITE_TAC[union_subset]; + (* -- *) + TYPE_THEN `cls B x` ASM_CASES_TAC; + THM_INTRO_TAC[`B`;`a'`;`b'`;`x`] cut_psegment; + TYPE_THEN `A` EXISTS_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* --// *) + TYPE_THEN `cls E x` SUBAGOAL_TAC; + TYPE_THEN `(E DIFF AE) SUBSET E` SUBAGOAL_TAC; + REWRITE_TAC[DIFF;SUBSET]; + USE 17 (MATCH_MP cls_subset); + USE 17 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `J` UNABBREV_TAC; + FULL_REWRITE_TAC[cls_union]; + USE 12 (REWRITE_RULE[UNION]); + REWR 4; + (* -- *) + TYPE_THEN `cls (E DIFF AE) x` SUBAGOAL_TAC ; + TYPE_THEN `J` UNABBREV_TAC; + USE 12 (REWRITE_RULE[cls_union]); + USE 4 (REWRITE_RULE[UNION]); + REWR 4; + (* -- *) + PROOF_BY_CONTR_TAC; + TYPE_THEN `S = {e | E e /\ ~AE e /\ (?x. closure top2 e (pointI x) /\ ~(?P. segment_end P x a' /\ P SUBSET J) /\ ~(?P. segment_end P x b' /\ P SUBSET J) ) }` ABBREV_TAC ; + TYPE_THEN `inductive_set E S` SUBAGOAL_TAC; + REWRITE_TAC[inductive_set]; + SUBCONJ_TAC; + TYPE_THEN `S` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + SUBCONJ_TAC; + USE 18 (REWRITE_RULE[cls]); + UND 22 THEN REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `e` EXISTS_TAC; + TYPE_THEN `S` UNABBREV_TAC; + USE 23 (REWRITE_RULE[DIFF]); + TYPE_THEN `x` EXISTS_TAC; + (* --- *) + TYPE_THEN `S` UNABBREV_TAC; + CONJ_TAC; + THM_INTRO_TAC[`E`;`AE`;`adjv C C'`] psegment_subset_endpoint; + SUBCONJ_TAC; + USE 3 (REWRITE_RULE[segment_end]); + CONJ_TAC; + IMATCH_MP_TAC num_closure_pos; + CONJ_TAC; + USE 2 (REWRITE_RULE[segment_end;psegment;segment]); + TYPE_THEN `C'` EXISTS_TAC; + IMATCH_MP_TAC adjv_adj2; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + USE 34 (REWRITE_RULE[SUBSET]); + IMATCH_MP_TAC num_closure_pos; + CONJ_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + USE 3 (REWRITE_RULE[segment_end;psegment;segment]); + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC [DIFF]; + IMATCH_MP_TAC adjv_adj; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + USE 34 (REWRITE_RULE[SUBSET]); + USE 2 (REWRITE_RULE[segment_end]); + TYPE_THEN `endpoint AE` UNABBREV_TAC; + USE 30 (REWRITE_RULE[INR in_pair]); + (* ----B *) + TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC; + TYPE_THEN `adjv C C'` UNABBREV_TAC; + FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN (TYPE_THEN`x'` UNABBREV_TAC); + UND 24 THEN REWRITE_TAC[]; + TYPE_THEN `B` EXISTS_TAC; + ONCE_REWRITE_TAC [segment_end_symm]; + UND 20 THEN REWRITE_TAC[]; + TYPE_THEN `B` EXISTS_TAC; + (* ----//B1 *) + THM_INTRO_TAC[`C`;`C'`] adjv_adj; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + USE 35 (REWRITE_RULE[SUBSET]); + (* ---- *) + TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INR IN_SING;DIFF;UNION]; + (* ---- *) + TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC; + IMATCH_MP_TAC segment_end_sing; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + USE 37 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `b'` UNABBREV_TAC; + UND 20 THEN REWRITE_TAC[]; + TYPE_THEN `{C}` EXISTS_TAC; + TYPE_THEN `a'` UNABBREV_TAC; + UND 24 THEN REWRITE_TAC[]; + TYPE_THEN `{C}` EXISTS_TAC; + (* --- *) + TYPE_THEN `adjv C C'` EXISTS_TAC; + TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + USE 32 (REWRITE_RULE[SUBSET]); + CONJ_TAC; + IMATCH_MP_TAC adjv_adj2; + (* --- *) + TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC; + TYPE_THEN `adjv C C'` UNABBREV_TAC; + (* ---C// *) + TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC; + IMATCH_MP_TAC segment_end_sing; + IMATCH_MP_TAC adjv_adj; + TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[SUBSET;DIFF;UNION;INR IN_SING ]; + (* --- *) + TYPE_THEN `adjv C C' = a'` ASM_CASES_TAC; + TYPE_THEN `adjv C C'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 24 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `{C}` EXISTS_TAC; + TYPE_THEN `adjv C C' = b'` ASM_CASES_TAC; + TYPE_THEN `adjv C C'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 20 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `{C}` EXISTS_TAC; + (* --- repeat from here *) + TYPE_THEN `x' = a'` ASM_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 20 THEN REWRITE_TAC[]; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `x' = b'` ASM_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UND 24 THEN REWRITE_TAC[]; + TYPE_THEN `B` EXISTS_TAC; + ONCE_REWRITE_TAC[segment_end_symm]; + (* --- *) + CONJ_TAC; + UND 24 THEN REWRITE_TAC[]; + THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`a'`] segment_end_trans; + TYPE_THEN `U` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `{C} UNION P` EXISTS_TAC; + REWRITE_TAC[union_subset]; + (* ---// *) + UND 20 THEN REWRITE_TAC[]; + THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`b'`] segment_end_trans; + TYPE_THEN `U` EXISTS_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `{C} UNION P` EXISTS_TAC; + REWRITE_TAC[union_subset]; + (* -- *) + TYPE_THEN `S = E` SUBAGOAL_TAC; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[inductive_set]; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `S` UNABBREV_TAC; + USE 22 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TYPE_THEN `~(AE = EMPTY)` SUBAGOAL_TAC; + USE 2 (REWRITE_RULE[segment_end;segment;psegment]); + UND 27 THEN ASM_REWRITE_TAC[]; + USE 22 (REWRITE_RULE[EMPTY_EXISTS]); + TSPEC `u` 20; + UND 20 THEN ASM_REWRITE_TAC[]; + USE 0 (REWRITE_RULE[SUBSET]); + (* -D// *) + FULL_REWRITE_TAC[conn]; + TYPE_THEN `~(a = b)` SUBAGOAL_TAC; + USE 3 (MATCH_MP segment_end_disj); + UND 3 THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`]; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + TYPE_THEN `!c. endpoint E c /\ cls AE c ==> endpoint AE c` SUBAGOAL_TAC; + REWRITE_TAC[endpoint]; + THM_INTRO_TAC[`AE`;`E`;`pointI c`] num_closure_mono; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + USE 15 (REWRITE_RULE[endpoint]); + REWR 16; + USE 16 (MATCH_MP (ARITH_RULE `x <=| 1 ==> (x = 1) \/ (x = 0)`)); + FIRST_ASSUM DISJ_CASES_TAC; + PROOF_BY_CONTR_TAC; + USE 14 (REWRITE_RULE[cls]); + THM_INTRO_TAC[`AE`;`pointI c`] num_closure0; + USE 2 (REWRITE_RULE[segment_end;psegment;segment]); + REWR 20; + TSPEC `e` 20; + UND 19 THEN ASM_REWRITE_TAC[]; + (* -E *) + TYPE_THEN `!c. endpoint E c ==> cls J c` SUBAGOAL_TAC; + TYPE_THEN `J` UNABBREV_TAC; + REWRITE_TAC[cls_union]; + REWRITE_TAC[UNION]; + TYPE_THEN `cls AE c` ASM_CASES_TAC; + TSPEC `c` 14; + TYPE_THEN `endpoint AE c` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `endpoint B c` SUBAGOAL_TAC; + FULL_REWRITE_TAC[segment_end]; + TYPE_THEN `{a',b'}` UNABBREV_TAC; + THM_INTRO_TAC[`B`] endpoint_cls; + USE 1 (REWRITE_RULE[segment_end;psegment;segment]); + DISJ2_TAC; + ASM_MESON_TAC[subset_imp]; + DISJ1_TAC; + TYPE_THEN `E = (E DIFF AE) UNION AE` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + UND 0 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; + TYPE_THEN `cls E c` SUBAGOAL_TAC; + THM_INTRO_TAC[`E`] endpoint_cls; + USE 3 (REWRITE_RULE[segment_end;segment;psegment]); + ASM_MESON_TAC[subset_imp]; + UND 16 THEN DISCH_THEN (fun t -> USE 17 (ONCE_REWRITE_RULE[t])); + FULL_REWRITE_TAC[cls_union]; + USE 16 (REWRITE_RULE[UNION ]); + REWR 16; + (* - *) + USE 3 (REWRITE_RULE[segment_end]); + TYPE_THEN `endpoint E` UNABBREV_TAC; + USE 15 (REWRITE_RULE[INR in_pair]); + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; + (* Tue Dec 28 12:02:34 EST 2004 *) + + ]);; + (* }}} *) + +let conn2_sequence = prove_by_refinement( + `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\ + (!i. (i <= N) ==> (G i SUBSET edge )) /\ + (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\ + (!i j. (i < j) /\ (j <=| N) /\ ~(SUC i = j) ==> + (curve_cell (G i) INTER (curve_cell (G j)) = EMPTY)) /\ + (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) ==> + (unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1; + ARITH_TAC; + THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma2; + THM_INTRO_TAC[`G`;`N`] conn2_sequence_lemma3; + THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma4; + (* - *) + TYPE_THEN `?ei. C ei /\ G i ei /\ (!k. i < k /\ k <=|j ==> ~G k ei)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`SUC i`;`j`]); + TYPE_THEN `{x | i <=| x /\ x <=| j} = {i} UNION {x | SUC i <= x /\ x <= j}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UNDH 3810 THEN ARITH_TAC; + REWRH 1849; + USEH 4802 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]); + USEH 5681 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]); + REWRITE_TAC[SUBSET;UNIONS;IMAGE]; + CONV_TAC (dropq_conv "u"); + NAME_CONFLICT_TAC; + TSPECH `x` 7945; + LEFTH 1695 "ei"; + TSPECH `x` 5608; + LEFTH 1699 "u"; + USEH 7623 (CONV_RULE NAME_CONFLICT_CONV); + REWRH 2787; + TYPE_THEN `G i x` ASM_CASES_TAC; + REWRH 2360; + LEFTH 4513 "k" ; + TYPE_THEN `k` EXISTS_TAC; + UNDH 2414 THEN MESON_TAC[ARITH_RULE `a <| b ==> SUC a <=| b`]; + REWRH 7623; + ASM_MESON_TAC[]; + UNDH 5817 THEN UNDH 3810 THEN ARITH_TAC; + (* -A *) + TYPE_THEN `?ej. C ej /\ G j ej /\ (!k. i <= k /\ k <| j ==> ~G k ej)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`i`;`j -1`]); + TYPE_THEN `{x | i <=| x /\ x <=| j} = {j} UNION {x | i <= x /\ x <= j- 1}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UNDH 3810 THEN ARITH_TAC; + REWRH 1849; + USEH 6712 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]); + USEH 7737 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]); + REWRITE_TAC[SUBSET;UNIONS;IMAGE]; + CONJ_TAC ; + UNDH 3810 THEN ARITH_TAC; + CONJ_TAC; + UNDH 5153 THEN ARITH_TAC; + CONV_TAC (dropq_conv "u"); + NAME_CONFLICT_TAC; + TSPECH `x` 5663; + LEFTH 6587 "ej"; + TSPECH `x` 613; + LEFTH 8601 "u"; + USEH 2468 (CONV_RULE NAME_CONFLICT_CONV); + REWRH 3770; + TYPE_THEN `G j x` ASM_CASES_TAC; + REWRH 7772; + LEFTH 3203 "k" ; + TYPE_THEN `k` EXISTS_TAC; + UNDH 9304 THEN MESON_TAC[ARITH_RULE `a <| b ==> a <=| b - 1`]; + REWRH 2468; + ASM_MESON_TAC[]; + UNDH 7805 THEN UNDH 3810 THEN ARITH_TAC; + (* -B< *) + TYPE_THEN `Ci = {e | C e /\ G i e /\ (!k. i <| k /\ k <=| j ==> ~G k e)}` ABBREV_TAC ; + TYPE_THEN `Ci ei` SUBAGOAL_TAC; + TYPE_THEN `Ci` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `CiS = segment_of Ci ei` ABBREV_TAC ; + TYPE_THEN `segment CiS` SUBAGOAL_TAC; + TYPE_THEN `CiS` UNABBREV_TAC; + IMATCH_MP_TAC segment_of_segment; + TYPE_THEN `C` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + TYPE_THEN `Ci` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + (* - *) + TYPE_THEN `~Ci ej` SUBAGOAL_TAC THENL [TYPE_THEN `Ci` UNABBREV_TAC;ALL_TAC]; + TSPECH `j` 9673; + UNDH 375 THEN ASM_REWRITE_TAC[]; + UNDH 3810 THEN ARITH_TAC; + (* - *) + TYPE_THEN `CiS SUBSET Ci` SUBAGOAL_TAC; + TYPE_THEN `CiS` UNABBREV_TAC; + IMATCH_MP_TAC segment_of_G; + (* - *) + TYPE_THEN `psegment CiS` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`CiS`;`C`] rectagon_subset; + USEH 5119 (REWRITE_RULE[psegment]); + REWRH 2394; + CONJ_TAC; + IMATCH_MP_TAC rectagon_segment; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Ci` EXISTS_TAC; + TYPE_THEN `Ci` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + TYPE_THEN `C` UNABBREV_TAC; + USEH 2712 (REWRITE_RULE[SUBSET]); + UNDH 7665 THEN REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`CiS`] endpoint_size2; + FULL_REWRITE_TAC[has_size2]; + USEH 1801 SYM; + (* -C< *) + TYPE_THEN `Ci SUBSET C` SUBAGOAL_TAC; + TYPE_THEN `Ci` UNABBREV_TAC; + REWRITE_TAC[SUBSET]; + TYPE_THEN `CiS SUBSET C` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `Ci` EXISTS_TAC; + (* - *) + TYPE_THEN `!m. endpoint CiS m ==> cls (G (SUC i)) m` SUBAGOAL_TAC; + THM_INTRO_TAC[`CiS`;`C`;`m`] endpoint_sub_rectagon; + USEH 5941 (REWRITE_RULE[EXISTS_UNIQUE_ALT]); + REWRITE_TAC[cls]; + TYPE_THEN `e` EXISTS_TAC; + TSPECH `e` 8431; + USEH 3634 (REWRITE_RULE[cls_edge]); + (* -- *) + KILLH 3313 THEN KILLH 5237 THEN KILLH 2072 THEN KILLH 4795 THEN KILLH 3667 THEN KILLH 8912; + REWRH 142; + TYPE_THEN `~Ci e` SUBAGOAL_TAC; + KILLH 5989 THEN KILLH 9803 THEN KILLH 1909 THEN KILLH 8416 THEN KILLH 320 THEN KILLH 846; + THM_INTRO_TAC[`Ci`;`ei`] inductive_segment; + FULL_REWRITE_TAC[inductive_set]; + USEH 7070 (REWRITE_RULE[endpoint]); + THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1; + FULL_REWRITE_TAC[segment]; + REWRH 4780; + UNDH 8549 THEN DISCH_THEN (THM_INTRO_TAC[`e'`;`e`]); + REWRITE_TAC[adj;INTER;EMPTY_EXISTS]; + TSPECH `e'` 5120; + REWRH 6063; + CONJ_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + UNDH 9580 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `pointI m` EXISTS_TAC; + TYPE_THEN `CiS` UNABBREV_TAC; + UNDH 1420 THEN ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `UNIONS (IMAGE G {x | i <=| x /\ x <=| j}) e` SUBAGOAL_TAC; + USEH 1849 (REWRITE_RULE[SUBSET]); + USEH 9077 (REWRITE_RULE[UNIONS;IMAGE]); + TYPE_THEN `u` UNABBREV_TAC; + (* --// *) + TYPE_THEN `!y. (SUC i < y) /\ (y <=| N) ==> ~(G y e)` SUBAGOAL_TAC; + UNDH 4928 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`y`]); + UNDH 8692 THEN ARITH_TAC; + USEH 6879 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPECH `{(pointI m)}` 6278; + TYPE_THEN `!r. (r <=| N) ==> (G r SUBSET UNIONS (IMAGE G {i | i <=| N}))` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS;IMAGE;SUBSET]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `r` EXISTS_TAC; + (* --- *) + TYPE_THEN `!r. (r <=| N) ==> (curve_cell (G r) {(pointI m)} <=> (?e. G r e /\ closure top2 e (pointI m)))` SUBAGOAL_TAC; + IMATCH_MP_TAC curve_cell_point; + USEH 2858 (REWRITE_RULE[conn2;]); + IMATCH_MP_TAC FINITE_SUBSET; + UNIFY_EXISTS_TAC; + (* --- *) + TYPE_THEN `i <=| N` SUBAGOAL_TAC; + UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; + UNDH 4794 THEN ASM_REWRITE_TAC[]; + CONJ_TAC; + USEH 7070 (REWRITE_RULE[endpoint]); + THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `C` EXISTS_TAC; + FULL_REWRITE_TAC[rectagon]; + REWRH 4780; + TYPE_THEN `e'` EXISTS_TAC; + TSPECH `e'` 5120; + REWRH 6063; + TYPE_THEN `Ci` UNABBREV_TAC; + USEH 2281 (REWRITE_RULE[SUBSET]); + (* --- *) + TYPE_THEN `e` EXISTS_TAC; + (* --D< *) + PROOF_BY_CONTR_TAC; + USEH 1849 (REWRITE_RULE[UNIONS;IMAGE;SUBSET]); + TSPECH `e` 5988; + FULL_REWRITE_TAC[]; + TYPE_THEN `u'` UNABBREV_TAC; + TYPE_THEN `x' = i` ASM_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `Ci` UNABBREV_TAC; + UNDH 8814 THEN ASM_REWRITE_TAC[]; + TSPECH `k` 8651; + TYPE_THEN `k = SUC i` ASM_CASES_TAC; + UNDH 9079 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `k` UNABBREV_TAC; + UNDH 5461 THEN ASM_REWRITE_TAC[]; + UNDH 9872 THEN UNDH 5198 THEN UNDH 2528 THEN UNDH 5153 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `x' = SUC i` ASM_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + UNDH 9079 THEN ASM_REWRITE_TAC[]; + TSPECH `x'` 8651; + UNDH 7878 THEN ASM_REWRITE_TAC[]; + UNDH 9481 THEN UNDH 5258 THEN UNDH 5565 THEN UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC; + (* - *) + COPYH 9674; + UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`b`]); + USEH 8662 SYM; + REWRITE_TAC[]; + UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`a`]); + USEH 8662 SYM; + REWRITE_TAC[]; + (* -E *) + TYPE_THEN `X = { E | E SUBSET (C UNION (G (SUC i))) /\ ~(E ei) /\ ~(E ej) /\ segment_end E a b }` ABBREV_TAC ; + TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC]; + TYPE_THEN `X` UNABBREV_TAC; + UNDH 8912 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]); + UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; + THM_INTRO_TAC[`G (SUC i)`] conn2_imp_conn; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; + FULL_REWRITE_TAC[conn]; + UNDH 6247 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]); + TYPE_THEN `S` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `G (SUC i)` EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION ]; + TSPECH `SUC i` 320; + TSPECH `SUC i` 9803; + UNDH 8789 THEN DISCH_THEN (THM_INTRO_TAC[]); + UNDH 3810 THEN ARITH_TAC; + UNDH 5005 THEN DISCH_THEN (THM_INTRO_TAC[]); + ARITH_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + USEH 1620 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM DISJ_CASES_TAC; + UNDH 4837 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 683 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `f = (\ E . CARD (E DIFF C))` ABBREV_TAC ; + THM_INTRO_TAC[`X`;`f`] select_image_num_min; + UNDH 6007 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `E = z` ABBREV_TAC ; + TYPE_THEN `z` UNABBREV_TAC; + (* -F< *) + TYPE_THEN `cls C a /\ cls C b` SUBAGOAL_TAC; + TYPE_THEN `cls CiS SUBSET cls C` SUBAGOAL_TAC; + IMATCH_MP_TAC cls_subset; + USEH 2127 (REWRITE_RULE[SUBSET]); + THM_INTRO_TAC[`CiS`] endpoint_cls; + USEH 214 (REWRITE_RULE[psegment;segment]); + USEH 477 (REWRITE_RULE[SUBSET]); + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (TYPE_THEN `endpoint CiS` UNABBREV_TAC) THEN REWRITE_TAC[INR in_pair]; + (* -// *) + THM_INTRO_TAC[`C`;`a`;`b`] cut_rectagon_cls; + TYPE_THEN `segment_end CiS a b` SUBAGOAL_TAC; + REWRITE_TAC[segment_end]; + TYPE_THEN `?CjS. (cls (CjS) INTER cls CiS = {a,b}) /\ (CiS INTER CjS = EMPTY) /\ (C = CiS UNION CjS) /\ segment_end CjS a b ` SUBAGOAL_TAC; + THM_INTRO_TAC[`C`;`A`;`B`;`CiS`;`a`;`b`] cut_rectagon_unique; + REWRITE_TAC[SUBSET;UNION]; + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[INTER_COMM]; + ASM_REWRITE_TAC[]; + TYPE_THEN `B` UNABBREV_TAC; + TYPE_THEN `A` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[INTER_COMM;UNION_COMM;]; + KILLH 7539 THEN KILLH 8335 THEN KILLH 2130 THEN KILLH 6524 THEN KILLH 3863; + (* -G< *) + TYPE_THEN `CjS ej` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + USEH 2238 (REWRITE_RULE[UNION ]); + UNDH 3048 THEN UNDH 2712 THEN UNDH 7665 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC )); + USEH 2712 (REWRITE_RULE[SUBSET]); + ASM_MESON_TAC[]; + (* -// *) + TYPE_THEN `CiS ei` SUBAGOAL_TAC; + TYPE_THEN `CiS` UNABBREV_TAC; + REWRITE_TAC[segment_of_in]; + TYPE_THEN `~CjS ei` SUBAGOAL_TAC; + UNDH 947 THEN UNDH 1398 THEN UNDH 3558 THEN REWRITE_TAC[INTER;EQ_EMPTY] THEN MESON_TAC[]; + (* -// *) + TYPE_THEN `~(E SUBSET C)` SUBAGOAL_TAC; + TYPE_THEN `X` UNABBREV_TAC; + THM_INTRO_TAC[`C`;`CiS`;`CjS`;`E`;`a`;`b`] cut_rectagon_unique; + REWRITE_TAC[SUBSET;UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `E` UNABBREV_TAC; + UNDH 5338 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `E` UNABBREV_TAC; + UNDH 442 THEN ASM_REWRITE_TAC[]; + (* -H< *) + THM_INTRO_TAC[`C`;`E`] conn2_sequence_lemma5; + USEH 4704 SYM; + CONJ_TAC; + TYPE_THEN `X` UNABBREV_TAC; + USEH 7614 (REWRITE_RULE[segment_end]); + TYPE_THEN `X` UNABBREV_TAC; + USEH 7614 (REWRITE_RULE[segment_end]); + REWRITE_TAC[SUBSET;INR in_pair]; + FIRST_ASSUM (DISJ_CASES_TAC ) THEN (TYPE_THEN `x` UNABBREV_TAC); + (* -// *) + THM_INTRO_TAC[`E'`] endpoint_size2; + FULL_REWRITE_TAC[has_size2]; + (* -// *) + TYPE_THEN `?E''. E'' SUBSET C /\ ~E'' ei /\ ~E'' ej /\ segment_end E'' a' b'` ASM_CASES_TAC; + UNDH 3844 THEN UNDH 6993 THEN UNDH 1260 THEN UNDH 6943 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5435 THEN UNDH 7079 THEN UNDH 2483 THEN UNDH 1489 THEN UNDH 9777 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); + (* -- *) + TYPE_THEN `X` UNABBREV_TAC; + TYPE_THEN `f` UNABBREV_TAC; + (* --I< *) + THM_INTRO_TAC[`E`;`E'`;`E''`;`a`;`b`;`a'`;`b'`] conn_splice; + REWRITE_TAC[segment_end]; + TSPECH `B'` 8320; + UNDH 8902 THEN DISCH_THEN (THM_INTRO_TAC[]); + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E UNION E''` EXISTS_TAC ; + CONJ_TAC; + UNDH 280 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; + REWRITE_TAC[union_subset]; + UNDH 6943 THEN REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `B' SUBSET E UNION E''` SUBAGOAL_TAC; + UNDH 280 THEN REWRITE_TAC[DIFF;SUBSET;UNION] THEN MESON_TAC[]; + USEH 9489 (REWRITE_RULE[SUBSET;UNION]); + CONJ_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `B' DIFF C SUBSET (E DIFF E') DIFF C` SUBAGOAL_TAC; + UNDH 280 THEN UND 3 THEN REWRITE_TAC[SUBSET;DIFF;UNION;] THEN MESON_TAC[]; + USEH 8272 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); + UNDH 200 THEN ASM_REWRITE_TAC[]; + IMATCH_MP_TAC card_subset_lt; + CONJ_TAC; + UNDH 8308 THEN (REWRITE_TAC[DIFF;SUBSET]) THEN MESON_TAC[]; + CONJ_TAC; + USEH 7143 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TYPE_THEN `~(E' = EMPTY)` SUBAGOAL_TAC ; + USEH 4430 (REWRITE_RULE[psegment;segment]); + UNDH 5706 THEN ASM_REWRITE_TAC[]; + USEH 5706 (REWRITE_RULE[EMPTY_EXISTS]); + TSPECH `u` 5085; + USEH 9707 (REWRITE_RULE[DIFF]); + USEH 7802 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPECH `u` 6967; + UNDH 366 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + REWRH 2690; + USEH 8308 (REWRITE_RULE[SUBSET;DIFF;]); + TSPECH `u` 5436; + USEH 5435 (REWRITE_RULE[SUBSET]); + TSPECH `u` 5036; + ASM_MESON_TAC[]; + (* -- *) + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `E` EXISTS_TAC; + REWRITE_TAC[DIFF;SUBSET]; + USEH 7614 (REWRITE_RULE[segment_end;segment;psegment]); + (* -J< // (57 HYP here ) *) + (* KILLH 846 THEN KILLH 1909 THEN KILLH 5989; ?? *) + KILLH 9203 THEN KILLH 4704 THEN KILLH 3558 THEN KILLH 3114 THEN KILLH 5443 THEN KILLH 7079 THEN KILLH 1489 THEN KILLH 6007 THEN KILLH 9461 THEN KILLH 4797 THEN KILLH 8662 THEN KILLH 214; + KILLH 4596 THEN KILLH 947 THEN KILLH 5282; + (* - *) + TYPE_THEN `E' SUBSET C UNION (G (SUC i))` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E` EXISTS_TAC; + TYPE_THEN `X` UNABBREV_TAC; + (* - *) + TYPE_THEN `E' SUBSET (G (SUC i))` SUBAGOAL_TAC; + UNDH 7718 THEN UNDH 7802 THEN REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;UNION] THEN MESON_TAC[]; + KILLH 7718; + KILLH 7292 THEN KILLH 4330 THEN KILLH 4248 THEN KILLH 2712 THEN KILLH 7665 THEN KILLH 5425 THEN KILLH 5357 THEN KILLH 1285; + KILLH 145 THEN KILLH 7070 THEN KILLH 2483 THEN KILLH 9777; + KILLH 7420; + KILLH 5435; + (* -K< *) + TYPE_THEN `cls C a' /\ cls C b'` SUBAGOAL_TAC; + TYPE_THEN ` endpoint E' SUBSET cls C` SUBAGOAL_TAC; + USEH 2907 SYM; + KILLH 8660; + TYPE_THEN `endpoint E'` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INTER]; + REWRH 5756; + USEH 6207 (REWRITE_RULE[SUBSET;INR in_pair]); + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; + (* -// *) + TYPE_THEN `?A B. segment_end A a' b' /\ segment_end B a' b' /\ (C = A UNION B) /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {a',b'}) /\ (A ei) /\ (B ej)` SUBAGOAL_TAC; + THM_INTRO_TAC[`C`;`a'`;`b'`] cut_rectagon_cls; + TYPE_THEN `A ei` ASM_CASES_TAC; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + FULL_REWRITE_TAC[INTER_COMM]; + LEFTH 4284 "E''"; + TSPECH `B` 567; + UNDH 469 THEN ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + UNDH 7424 THEN REP_CASES_TAC; + PROOF_BY_CONTR_TAC; + UNDH 3642 THEN REWRITE_TAC[SUBSET;UNION]; + USEH 8335 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPECH `ei` 554; + UNDH 8511 THEN ASM_REWRITE_TAC[]; + (* --// *) + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `A` EXISTS_TAC; + FULL_REWRITE_TAC[INTER_COMM;UNION_COMM]; + CONJ_TAC; + UNDH 4532 THEN (TYPE_THEN `C` UNABBREV_TAC) THEN ASM_REWRITE_TAC[UNION]; + LEFTH 4284 "E''"; + TSPECH `A` 567; + PROOF_BY_CONTR_TAC; + UNDH 937 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;UNION]; + (* -L< *) + + TYPE_THEN `~(G (SUC i) ei)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; + UNDH 3810 THEN ARITH_TAC; + TYPE_THEN `~(G (SUC i) ej)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; + ARITH_TAC; + (* -// *) + TYPE_THEN `psegment_triple A B E'` SUBAGOAL_TAC; + UNDH 830 THEN UNDH 8335 THEN UNDH 2130 THEN UNDH 4401 THEN UNDH 3688 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5107 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC)); + FULL_REWRITE_TAC[psegment_triple;segment_end]; + CONJ_TAC; + TYPE_THEN `C` UNABBREV_TAC; + TYPE_THEN `(A INTER E' = EMPTY) /\ (B INTER E' = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + UNDH 7714 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION] THEN MESON_TAC[]; + (* --// *) + TYPE_THEN `(cls A INTER cls E' = {a',b'}) /\ (cls B INTER cls E' = {a',b'})` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + USEH 9349 (REWRITE_RULE[cls_union]); + CONJ_TAC THEN (IMATCH_MP_TAC SUBSET_ANTISYM); + CONJ_TAC; + TYPE_THEN `endpoint E'` UNABBREV_TAC; + TYPE_THEN `{a',b'}` UNABBREV_TAC; + REWRITE_TAC[INTER;SUBSET;UNION]; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC; + KILLH 2907; + TYPE_THEN `{a',b'}` UNABBREV_TAC; + REWRITE_TAC[INTER;SUBSET]; + TYPE_THEN `{a',b'}` UNABBREV_TAC; + IMATCH_MP_TAC endpoint_cls; + FULL_REWRITE_TAC[psegment;segment]; + CONJ_TAC; + TYPE_THEN `{a',b'}` UNABBREV_TAC; + TYPE_THEN `endpoint E'` UNABBREV_TAC; + REWRITE_TAC[INTER;SUBSET;UNION]; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC; + USEH 5640 SYM; + IMATCH_MP_TAC endpoint_cls; + USEH 4134 (REWRITE_RULE[psegment;segment]); + USEH 2907 SYM; + IMATCH_MP_TAC endpoint_cls; + USEH 4430 (REWRITE_RULE[psegment;segment]); + CONJ_TAC THEN IMATCH_MP_TAC segment_end_union_rectagon; + FULL_REWRITE_TAC[segment_end]; + MESON_TAC[]; + FULL_REWRITE_TAC[segment_end]; + MESON_TAC[]; + (* -M< // *) + USEH 2518 (MATCH_MP psegment_triple3); + COPYH 7680; + USEH 7680 (MATCH_MP bounded_triple_inner_union); + USEH 3265 (REWRITE_RULE [SUBSET]); + (* TSPEC p deferred ///// *) + (* -// *) + TYPE_THEN `~(bounded_set (B UNION E') p)` SUBAGOAL_TAC; + UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`B UNION E'`;`i`;`j`]); + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + UNDH 3810 THEN ARITH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `C UNION E'` EXISTS_TAC ; + CONJ_TAC; + REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[]; + TYPE_THEN `A UNION B` UNABBREV_TAC; + REWRITE_TAC[union_subset]; + REWRITE_TAC[SUBSET;UNIONS;IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `SUC i` EXISTS_TAC; + USEH 343 (REWRITE_RULE[SUBSET]); + UNDH 3810 THEN ARITH_TAC; + REWRH 9345; + USEH 1598 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); + UNDH 5101 THEN REWRITE_TAC[]; + IMATCH_MP_TAC card_subset_lt; + CONJ_TAC; + UNDH 343 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; + CONJ_TAC; + USEH 7390 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `ei` 9338; + USEH 4016 (REWRITE_RULE[UNION;DIFF]); + UNDH 1090 THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `ei` EXISTS_TAC; + UNDH 4837 THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[subset_imp]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `A UNION B` EXISTS_TAC; + CONJ_TAC; + USEH 2130 SYM; + USEH 5107 (REWRITE_RULE[rectagon]); + REWRITE_TAC[SUBSET;DIFF]; + (* -// *) + TYPE_THEN `~(bounded_set (E' UNION A) p)` SUBAGOAL_TAC; + UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`E' UNION A`;`i`;`j`]); + CONJ_TAC; + FULL_REWRITE_TAC[psegment_triple]; + CONJ_TAC; + UNDH 3810 THEN ARITH_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E' UNION C` EXISTS_TAC ; + CONJ_TAC; + REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[]; + TYPE_THEN `A UNION B` UNABBREV_TAC; + REWRITE_TAC[union_subset]; + REWRITE_TAC[SUBSET;UNIONS;IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `SUC i` EXISTS_TAC; + USEH 343 (REWRITE_RULE[SUBSET]); + UNDH 3810 THEN ARITH_TAC; + REWRH 9505; + USEH 4752 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`)); + UNDH 2448 THEN REWRITE_TAC[]; + IMATCH_MP_TAC card_subset_lt; + CONJ_TAC; + UNDH 343 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[]; + CONJ_TAC; + USEH 758 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `ej` 1425; + USEH 5076 (REWRITE_RULE[UNION;DIFF]); + UNDH 5580 THEN ASM_REWRITE_TAC[]; + USEH 3977 (MATCH_MP (TAUT `a \/ b ==> b\/ a`)); + FIRST_ASSUM DISJ_CASES_TAC; + UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `ej` EXISTS_TAC; + UNDH 683 THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[subset_imp]; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `A UNION B` EXISTS_TAC; + CONJ_TAC; + USEH 2130 SYM; + USEH 5107 (REWRITE_RULE[rectagon]); + REWRITE_TAC[SUBSET;DIFF]; + (* -N< // *) + KILLH 3313 THEN KILLH 4532 THEN KILLH 846 THEN KILLH 320 THEN KILLH 8416 THEN KILLH 1909 THEN KILLH 9803 THEN KILLH 5989 THEN KILLH 4430 THEN KILLH 7802 THEN KILLH 6174 THEN KILLH 2907; + KILLH 683 THEN KILLH 4837 THEN KILLH 3627 THEN KILLH 2590 THEN KILLH 830 THEN KILLH 8335 THEN KILLH 4401 THEN KILLH 3688; + POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)); + (* - *) + TYPE_THEN `bounded_set (B UNION E' UNION A) p` SUBAGOAL_TAC; + IMATCH_MP_TAC bounded_avoidance_subset; + TYPE_THEN `C` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[union_subset]; + USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]); + CONJ_TAC; + REWRITE_TAC[FINITE_UNION]; + USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]); + CONJ_TAC; + TYPE_THEN `A UNION B` UNABBREV_TAC; + IMATCH_MP_TAC conn2_rectagon; + (* --// *) + UNDH 8721 THEN REWRITE_TAC[] THEN (IMATCH_MP_TAC bounded_set_curve_cell_empty); + TYPE_THEN `UNIONS (IMAGE G {i | i <=| N})` EXISTS_TAC; + TYPE_THEN `B UNION E' UNION A = E' UNION C` SUBAGOAL_TAC; + REWRITE_TAC[UNION_ACI ]; + REWRITE_TAC[union_subset]; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNIONS;IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `(SUC i)` EXISTS_TAC; + USEH 343 (REWRITE_RULE[SUBSET]); + UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC; + TYPE_THEN `A UNION B` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `x'` EXISTS_TAC; + UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC; + TSPECH `p` 2110; + USEH 1588 (ONCE_REWRITE_RULE[UNION]); + USEH 6893 (REWRITE_RULE[]); + ASM_MESON_TAC[]; + (* Tue Dec 28 15:56:13 EST 2004 *) + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION AA *) +(* ------------------------------------------------------------------ *) + + +(* finish proof of the connectedness of the complement of an arc *) + +let real_div_denom = prove_by_refinement( + `!z x y . (&0 < z) ==> ((x/ z <= y/ z) <=> (x <= y))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`]; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; + FULL_REWRITE_TAC[REAL_MUL_AC]; + IMATCH_MP_TAC REAL_LE_RMUL_EQ; + ]);; + (* }}} *) + +let real_div_denom_lt = prove_by_refinement( + `!z x y . (&0 < z) ==> ((x/ z < y/ z) <=> (x < y))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`]; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; + FULL_REWRITE_TAC[REAL_MUL_AC]; + IMATCH_MP_TAC REAL_LT_RMUL_EQ; + ]);; + (* }}} *) + +let simple_arc_constants = prove_by_refinement( + `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ + euclid 2 p /\ euclid 2 q ==> + (?d N B a d'. (&0 <. d) /\ (&0 <. d') /\ (0 < N) /\ + (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\ + (C = UNIONS (IMAGE B {i | i <| N})) /\ + (!x. C x ==> + (&8 * d <= d_euclid x p) /\ (&8 * d <= d_euclid x q)) /\ + (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==> + (&16 * d' < d_euclid x y)) /\ + (!i. (i <| N) ==> + (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d)))) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`]simple_arc_compact; + THM_INTRO_TAC[`2`] metric_euclid; + THM_INTRO_TAC[`C`] simple_arc_nonempty; + THM_INTRO_TAC[`top2`] compact_point; + FULL_REWRITE_TAC[top2_unions]; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{p}`] compact_distance; + FULL_REWRITE_TAC[top2]; + REWRITE_TAC[EMPTY_EXISTS]; + MESON_TAC[]; + FULL_REWRITE_TAC[INR IN_SING]; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{q}`] compact_distance; + FULL_REWRITE_TAC[top2]; + REWRITE_TAC[EMPTY_EXISTS]; + MESON_TAC[]; + FULL_REWRITE_TAC[INR IN_SING]; + (* - *) + TYPE_THEN `p''''` UNABBREV_TAC; + TYPE_THEN `p''` UNABBREV_TAC; + TYPE_THEN `d = (min_real (d_euclid p''' q) (d_euclid p' p))/(&8)` ABBREV_TAC ; + TYPE_THEN `d` EXISTS_TAC; + TYPE_THEN `&0 < d` SUBAGOAL_TAC; + TYPE_THEN `d` UNABBREV_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + ASSUME_TAC (REAL_ARITH `&0 < &8`); + REWRITE_TAC[min_real] ; + THM_INTRO_TAC[`C`] simple_arc_euclid; + COND_CASES_TAC; + IMATCH_MP_TAC d_euclid_pos2; + TYPE_THEN `2` EXISTS_TAC; + ASM_MESON_TAC[subset_imp]; + IMATCH_MP_TAC d_euclid_pos2; + TYPE_THEN `2` EXISTS_TAC; + ASM_MESON_TAC[subset_imp]; + (* -A// *) + TYPE_THEN `(!x. C x ==> &8 * d <= d_euclid x p /\ &8 * d <= d_euclid x q)` SUBAGOAL_TAC; + TYPE_THEN `&8 * d = min_real (d_euclid p''' q) (d_euclid p' p)` SUBAGOAL_TAC; + TYPE_THEN `d` UNABBREV_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 10 THEN REAL_ARITH_TAC ; + UNDH 6289 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`q`]); + ASM_REWRITE_TAC[]; + UNDH 4386 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`p`]); + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`(d_euclid p''' q)`;`d_euclid p' p `] min_real_le; + UNDH 4228 THEN UNDH 5042 THEN UNDH 8570 THEN UNDH 8336 THEN REAL_ARITH_TAC; + KILLH 8745 THEN KILLH 6021 THEN KILLH 6289 THEN KILLH 371; + KILLH 4386 THEN KILLH 6186; + (* -B// *) + COPYH 3550; + USEH 3550 (REWRITE_RULE[simple_arc]); + FULL_REWRITE_TAC[top2_unions]; + THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; + FULL_REWRITE_TAC[uniformly_continuous]; + TSPECH `d` 814; + FULL_REWRITE_TAC[]; + (* - *) + TYPE_THEN `?N. &1/delta <= &N` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ARCH_SIMPLE]; + TYPE_THEN `&0 < &N` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + UNIFY_EXISTS_TAC; + TYPE_THEN `&1/ &N <= delta` SUBAGOAL_TAC; + UNDH 338 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + FULL_REWRITE_TAC[REAL_MUL_AC]; + TYPE_THEN `N' = 2*N` ABBREV_TAC ; + TYPE_THEN `&0 < &N'` SUBAGOAL_TAC; + TYPE_THEN `N'` UNABBREV_TAC; + FULL_REWRITE_TAC[REAL_OF_NUM_LT]; + UNDH 7562 THEN ARITH_TAC; + (* - *) + TYPE_THEN `!r. (r <= &1/ (&N')) ==> (r < delta)` SUBAGOAL_TAC; + TYPE_THEN `&1/ &N' < &1/ &N` SUBAGOAL_TAC; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`]; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; + TYPE_THEN `N'` UNABBREV_TAC; + REDUCE_TAC; + UNDH 5547 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; + UNDH 5945 THEN UNDH 3160 THEN UNDH 532 THEN REAL_ARITH_TAC; + (* -C// *) + KILLH 1557 THEN KILLH 5945 THEN KILLH 5547 THEN KILLH 338; + TYPE_THEN `N'` EXISTS_TAC; + TYPE_THEN `B = (\ i. IMAGE f {x | (&i / &N') <= x /\ (x <= &(SUC i)/(&N'))} )` ABBREV_TAC ; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `a = (\ i. f(&i / &N'))` ABBREV_TAC ; + TYPE_THEN `a` EXISTS_TAC; + (* - *) + THM_INTRO_TAC[`&N'`] real_div_denom; + REWRH 9377; + (* - *) + TYPE_THEN `!x. (&0 <= x/ &N') <=> (&0 <= x)` SUBAGOAL_TAC; + UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`x`]); + FULL_REWRITE_TAC[REAL_DIV_LZERO]; + (* - *) + TYPE_THEN `!x. (x/ &N' <= &1) <=> (x <= &N')` SUBAGOAL_TAC; + UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`&N'`]); + THM_INTRO_TAC[`&N'`] REAL_DIV_REFL; + TYPE_THEN `&N'` UNABBREV_TAC; + UNDH 869 THEN REAL_ARITH_TAC; + REWRH 4881; + (* - *) + TYPE_THEN `!i x. (i <| N') /\ (&i / &N' <= x) /\ (x <= &(SUC i) / &N') ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC; + TYPE_THEN `&0 <= &i / &N' /\ &(SUC i) / (&N') <= &1` BACK_TAC; + UNDH 601 THEN UNDH 1707 THEN UNDH 167 THEN UNDH 1199 THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_OF_NUM_LE]; + UNDH 9580 THEN ARITH_TAC; + (* -D// *) + TYPE_THEN `(!i. i <| N' ==> (?x. B i x /\ B i SUBSET open_ball (euclid 2,d_euclid) x d))` SUBAGOAL_TAC; + TYPE_THEN `a i` EXISTS_TAC; + TYPE_THEN `a` UNABBREV_TAC; + SUBCONJ_TAC; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[REAL_OF_NUM_LE ]; + ARITH_TAC; + (* -- *) + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[open_ball;IMAGE;SUBSET;]; + TYPE_THEN `x` UNABBREV_TAC; + USEH 3550 (MATCH_MP simple_arc_euclid); + TYPE_THEN `C` UNABBREV_TAC; + USEH 3429 (REWRITE_RULE[SUBSET]); + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[REAL_OF_NUM_LE ]; + UNDH 9580 THEN ARITH_TAC; + (* -- *) + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC image_imp; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + CONJ_TAC; + UNDH 9580 THEN ARITH_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + REWRITE_TAC[d_real]; + TYPE_THEN `x' <= &i/ &N' + &1/ &N'` SUBAGOAL_TAC; + UNDH 3570 THEN REWRITE_TAC[REAL]; + REWRITE_TAC[real_div;GSYM REAL_ADD_RDISTRIB]; + REWRITE_TAC[GSYM real_div]; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 4551 THEN UNDH 1464 THEN REAL_ARITH_TAC; + KILLH 8623 THEN KILLH 2193; + KILLH 626 THEN KILLH 4538; + (* -E// *) + TYPE_THEN `!i. &i / &N' < &(SUC i)/ &N'` SUBAGOAL_TAC; + ASM_SIMP_TAC[real_div_denom_lt]; + REWRITE_TAC[REAL_OF_NUM_LT]; + ARITH_TAC; + (* - *) + TYPE_THEN `(!i. i <| N' ==> simple_arc_end (B i) (a i) (a (SUC i)))` SUBAGOAL_TAC; + TYPE_THEN `a` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[simple_arc_end]; + THM_INTRO_TAC[`f`;`&0`;`&1`;`&i/ &N'`;`&(SUC i)/ &N'`] arc_reparameter_gen; + IMATCH_MP_TAC inj_subset_domain; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `g` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -F// *) + TYPE_THEN `(IMAGE f {x | &0 <= x /\ x <= &1} = UNIONS (IMAGE B {i | i <| N'}))` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNIONS;IMAGE]; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + CONV_TAC (dropq_conv "u"); + NAME_CONFLICT_TAC; + LEFT_TAC "x''"; + LEFT_TAC "x''"; + TYPE_THEN `x'` EXISTS_TAC; + (* --- *) + TYPE_THEN `x' = &1` ASM_CASES_TAC; + TYPE_THEN `N' -| 1` EXISTS_TAC; + FULL_REWRITE_TAC[REAL_LT;REAL_LE]; + TYPE_THEN `N' -| 1 <| N'` SUBAGOAL_TAC; + UNDH 8859 THEN ARITH_TAC; + CONJ_TAC; + UNDH 9064 THEN ARITH_TAC; + FULL_REWRITE_TAC[GSYM REAL_LT]; + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; + REDUCE_TAC; + FULL_REWRITE_TAC[REAL_LT]; + UND 25 THEN ARITH_TAC; + (* --- *) + TYPE_THEN `num_abs_of_int (floor (&N' * x'))` EXISTS_TAC; + TYPE_THEN `t = &N' * x'` ABBREV_TAC ; + TYPE_THEN `x' = t/(&N')` SUBAGOAL_TAC; + TYPE_THEN `t` UNABBREV_TAC; + REWRITE_TAC[real_div_assoc]; + ONCE_REWRITE_TAC[EQ_SYM_EQ ]; + IMATCH_MP_TAC REAL_DIV_LMUL; + UNDH 3200 THEN UNDH 7688 THEN REAL_ARITH_TAC; + TYPE_THEN `&0 <= t` SUBAGOAL_TAC; + TYPE_THEN `t` UNABBREV_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + TYPE_THEN `&:0 <=: (floor t)` SUBAGOAL_TAC; + REWRITE_TAC[int_of_num_th;GSYM floor_le]; + REWRITE_TAC[GSYM REAL_OF_NUM_LT]; + ASM_REWRITE_TAC[REAL;num_abs_of_int_th;GSYM int_abs_th;]; + TYPE_THEN `(||: (floor t) = (floor t))` SUBAGOAL_TAC; + REWRITE_TAC[INT_ABS_REFL;]; + THM_INTRO_TAC[`t`] floor_ineq; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + TYPE_THEN `t < &N' * &1` SUBAGOAL_TAC; + TYPE_THEN `t` UNABBREV_TAC; + ASM_SIMP_TAC[REAL_LT_LMUL_EQ]; + UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC; + CONJ_TAC; + UNDH 5082 THEN REAL_ARITH_TAC; + TYPE_THEN `real_of_int (floor (&N' )) = &N'` SUBAGOAL_TAC; + REWRITE_TAC[floor_num;int_of_num_th;]; + UNDH 6307 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + REWRITE_TAC[GSYM int_lt ]; + IMATCH_MP_TAC (INT_ARITH `~(x = y) /\ (x <= y) ==> (x <: y)`); + CONJ_TAC; + FULL_REWRITE_TAC[floor_range]; + FULL_REWRITE_TAC[int_of_num_th;floor_num]; + UNDH 1048 THEN UNDH 6689 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC floor_mono; + UNDH 1048 THEN REAL_ARITH_TAC; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `x''` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + (* -G// *) + TYPE_THEN `!i. (i <| N') ==> compact top2 (B i)` SUBAGOAL_TAC; + UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + USEH 9744 (MATCH_MP simple_arc_end_simple); + USEH 3463 (MATCH_MP simple_arc_compact); + (* - *) + TYPE_THEN `!i. (i <| N') ==> ~(B i = EMPTY)` SUBAGOAL_TAC; + UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + USEH 9744 (MATCH_MP simple_arc_end_simple); + USEH 3463 (MATCH_MP simple_arc_nonempty); + UNDH 8481 THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!k. ?dij. !i j. (k = (i,j)) /\ SUC i < j /\ j < N' ==> (&0 < dij /\ (!x y. B i x /\ B j y ==> dij <= d_euclid x y))` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + CONV_TAC (dropq_conv "i"); + CONV_TAC (dropq_conv "j"); + TYPE_THEN `i = FST k` ABBREV_TAC ; + TYPE_THEN `j = SND k` ABBREV_TAC ; + RIGHT_TAC "y"; + RIGHT_TAC "x"; + RIGHT_TAC "dij"; + THM_INTRO_TAC[`(euclid 2)`;`d_euclid`;`(B i)`;`(B j)`] compact_distance; + CONJ_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC]; + UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; + FULL_REWRITE_TAC[top2]; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; + TYPE_THEN `d_euclid p' p''` EXISTS_TAC; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC d_euclid_pos2; + TYPE_THEN `2` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `p''` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + USEH 7066 (REWRITE_RULE[IMAGE]); + USEH 6258 (REWRITE_RULE[IMAGE]); + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `x = x'` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + UNIFY_EXISTS_TAC; + UNIFY_EXISTS_TAC; + UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `&j/ &N' <= &(SUC i) / (&N')` SUBAGOAL_TAC THENL[IMATCH_MP_TAC REAL_LE_TRANS;ALL_TAC]; + UNIFY_EXISTS_TAC; + UNDH 5902 THEN ASM_REWRITE_TAC[]; + UNDH 4223 THEN UNDH 3810 THEN REWRITE_TAC[REAL_LE] THEN ARITH_TAC; + (* --- *) + TYPE_THEN `(i <| N')` SUBAGOAL_TAC; + UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; + TYPE_THEN `!i x. (i <| N') /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC; + TSPECH `i'` 8913; + USEH 9316 (MATCH_MP simple_arc_end_simple); + USEH 5604 (MATCH_MP simple_arc_euclid); + ASM_MESON_TAC[subset_imp]; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + UNIFY_EXISTS_TAC; + UNIFY_EXISTS_TAC; + (* -- *) + FIRST_ASSUM IMATCH_MP_TAC ; + (* -H// *) + LEFTH 8852 "dij"; + TYPE_THEN `?d''. (&0 < d'') /\ (!i j. (SUC i < j /\ j <| N') ==> (d'' <= dij (i,j)))` SUBAGOAL_TAC; + TYPE_THEN `X = { r | (?i j. SUC i < j /\ j <| N' /\ (r = dij (i,j))) }` ABBREV_TAC ; + TYPE_THEN `d'' = inf X` ABBREV_TAC ; + TYPE_THEN `X = IMAGE dij {(i,j) | (SUC i < j /\ j < N')}` SUBAGOAL_TAC; + TYPE_THEN `X` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE;]; + NAME_CONFLICT_TAC; + POP_ASSUM_LIST (fun t->ALL_TAC); + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + CONV_TAC (dropq_conv "x'"); + ASM_MESON_TAC[]; + TYPE_THEN `x'` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `FINITE X` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `A = {i | (i <| N')}` ABBREV_TAC ; + TYPE_THEN `{(i,j) | A i /\ A j}` EXISTS_TAC; + CONJ_TAC; + THM_INTRO_TAC[`A`;`A`] FINITE_PRODUCT; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[FINITE_NUMSEG_LT]; + REWRITE_TAC[SUBSET;]; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN`i` EXISTS_TAC; + TYPE_THEN `j` EXISTS_TAC; + UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC; + (* --// *) + TYPE_THEN `X = EMPTY` ASM_CASES_TAC; + TYPE_THEN `&1` EXISTS_TAC; + REWRH 9106; + USEH 3802 SYM; + USEH 7502 (REWRITE_RULE[image_empty]); + USEH 1549 (REWRITE_RULE[EQ_EMPTY]); + TSPECH `(i,j)` 7313 ; + LEFTH 4977 "i'"; + TSPECH `i` 9356; + LEFTH 6976 "j'"; + TSPECH `j` 1468; + UNDH 5891 THEN ASM_REWRITE_TAC[]; + (* --H2// *) + THM_INTRO_TAC[`X`] finite_inf_min; + THM_INTRO_TAC[`X`] finite_inf; + TYPE_THEN `d''` EXISTS_TAC; + USEH 9106 SYM; + (* TYPE_THEN `d''` UNABBREV_TAC; *) + (* -- *) + CONJ_TAC; + TYPE_THEN `?i j. SUC i <| j /\ j <| N' /\ (d'' = dij (i,j))` SUBAGOAL_TAC; + UNDH 7611 THEN ASM_REWRITE_TAC[] THEN UNDH 3235 THEN DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]); + ASM_REWRITE_TAC[]; + REP_BASIC_TAC; + UNDH 6732 THEN DISCH_THEN (THM_INTRO_TAC[`dij (i,j)`]); + UNDH 3235 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + ASM_MESON_TAC[]; + USEH 7679 SYM; + ASM_REWRITE_TAC[]; + (* -I *) + TYPE_THEN `d' = d''/ &32` ABBREV_TAC ; + TYPE_THEN `&0 < &32` SUBAGOAL_TAC; + REAL_ARITH_TAC; + TYPE_THEN `d'` EXISTS_TAC; + SUBCONJ_TAC; + TYPE_THEN `d'` UNABBREV_TAC; + ASM_SIMP_TAC[REAL_LT_RDIV_0]; + SUBCONJ_TAC; + FULL_REWRITE_TAC[REAL_LT]; + (* - *) + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `d''` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `d'` UNABBREV_TAC; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + REWRITE_TAC[REAL_MUL_AC]; + IMATCH_MP_TAC REAL_LT_LMUL; + REAL_ARITH_TAC; + (* -/// *) + UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `dij (i,j)` EXISTS_TAC; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + (* Wed Dec 29 17:40:18 EST 2004 *) + + ]);; + (* }}} *) + +let euclid_scale_rinv = prove_by_refinement( + `!x r. (&0 < r) ==> ((r * &1/ r) *# x = x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USEH 6412 (MATCH_MP (REAL_ARITH `&0 < r ==> ~(r = &0)`)); + ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one]; + ]);; + (* }}} *) + +let euclid_scale_bij = prove_by_refinement( + `!r . (&0 < r) ==> BIJ (euclid_scale r) (euclid 2) (euclid 2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[BIJ;INJ;]; + TYPE_THEN `!x. (r * &1 / r) *# x = x` SUBAGOAL_TAC; + USEH 6412 (MATCH_MP (REAL_ARITH `&0 < r ==> ~(r = &0)`)); + ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one]; + SUBCONJ_TAC; + CONJ_TAC; + IMATCH_MP_TAC euclid_scale_closure; + TYPE_THEN `euclid_scale (&1/ r)` (fun t -> USEH 9290 (AP_TERM t)); + FULL_REWRITE_TAC[euclid_scale_act]; + USEH 7114 (ONCE_REWRITE_RULE[REAL_ARITH `x * y = y *x`]); + REWRH 5498; + REWRITE_TAC[SURJ]; + REP_BASIC_TAC; + TYPE_THEN`(&1/ r) *# x` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC euclid_scale_closure; + REWRITE_TAC[euclid_scale_act]; + ]);; + (* }}} *) + +let euclid_scale_cont = prove_by_refinement( + `!r. (&0 < r) ==> (continuous (euclid_scale r) top2 top2)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`( *# ) r`] metric_continuous_continuous_top2; + REWRITE_TAC[IMAGE;SUBSET]; + IMATCH_MP_TAC euclid_scale_closure; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + TYPE_THEN `epsilon/r` EXISTS_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + THM_INTRO_TAC[`2`;`r`;`x`;`y`] norm_scale_vec; + TYPE_THEN `abs r = r` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_REFL]; + UNDH 6412 THEN REAL_ARITH_TAC; + UNDH 3108 THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; + FULL_REWRITE_TAC[REAL_MUL_AC]; + ]);; + (* }}} *) + +let euclid_scale_inv = prove_by_refinement( + `!r x. (&0 < r) /\ (euclid 2 x) ==> + (INV (( *# ) r) (euclid 2) (euclid 2) x = (( *# ) (&1 / r)) x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`( *# ) r`;`(euclid 2)`;`(euclid 2)`;`&1 / r *# x`;`x`] INVERSE_XY; + ASM_SIMP_TAC[euclid_scale_bij]; + IMATCH_MP_TAC euclid_scale_closure; + USEH 6412 (MATCH_MP (REAL_ARITH `&0 < r ==> ~(r = &0)`)); + REWRITE_TAC[euclid_scale_act]; + ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one]; + ]);; + (* }}} *) + +let euclid_scale_homeo = prove_by_refinement( + `!r. (&0 < r) ==> homeomorphism (euclid_scale r) top2 top2`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC bicont_homeomorphism; + REWRITE_TAC[top2_unions]; + ASM_SIMP_TAC [euclid_scale_bij]; + ASM_SIMP_TAC[euclid_scale_cont]; + IMATCH_MP_TAC cont_domain; + TYPE_THEN `( *# ) (&1 / r)` EXISTS_TAC; + TYPE_THEN `&0 < &1 /r` SUBAGOAL_TAC; + ASM_SIMP_TAC[euclid_scale_cont]; + FULL_REWRITE_TAC[top2_unions]; + ASM_SIMP_TAC[euclid_scale_inv]; + (* Wed Dec 29 18:45:44 EST 2004 *) + ]);; + (* }}} *) + +let simple_arc_end_homeo = prove_by_refinement( + `!f C a b. simple_arc_end C a b /\ homeomorphism f top2 top2 ==> + simple_arc_end (IMAGE f C) (f a) (f b)`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc_end_cont]; + TYPE_THEN `f o f'` EXISTS_TAC; + REWRITE_TAC[IMAGE_o]; + TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBAGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `UNIV:real->bool` EXISTS_TAC; + REWRITE_TAC[metric_real]; + (* - *) + TYPE_THEN `UNIONS (top_of_metric (({x | &0 <= x /\ x <= &1},d_real))) = {x | &0 <= x /\ x <= &1}` SUBAGOAL_TAC; + IMATCH_MP_TAC (GSYM top_of_metric_unions); + (* - *) + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `top2` EXISTS_TAC; + REWRITE_TAC[top2_unions]; + FULL_REWRITE_TAC[homeomorphism]; + (* -- *) + IMATCH_MP_TAC inj_image_subset; + (* - *) + CONJ_TAC; + REWRITE_TAC[comp_comp]; + IMATCH_MP_TAC COMP_INJ; + TYPE_THEN `(euclid 2)` EXISTS_TAC; + FULL_REWRITE_TAC[homeomorphism]; + FULL_REWRITE_TAC[top2_unions;BIJ]; + REWRITE_TAC[o_DEF]; + ]);; + (* }}} *) + +let simple_arc_homeo = prove_by_refinement( + `!f C. simple_arc top2 C /\ homeomorphism f top2 top2 ==> + simple_arc top2 (IMAGE f C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]); + TYPE_THEN `simple_arc_end C (f' (&0)) (f' (&1))` SUBAGOAL_TAC; + REWRITE_TAC[simple_arc_end]; + TYPE_THEN `f'` EXISTS_TAC; + FULL_REWRITE_TAC[top2_unions]; + THM_INTRO_TAC[`f`;`C`;`f' (&0)`;`f' (&1)`] simple_arc_end_homeo; + USEH 6603 (MATCH_MP simple_arc_end_simple); + TYPE_THEN `C` UNABBREV_TAC; + ]);; + (* }}} *) + +let euclid_scale_simple_arc_ver2 = prove_by_refinement( + `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ (euclid 2 p) /\ + (euclid 2 q) /\ ~(p = q) /\ + (!A. simple_arc_end A p q ==> ~(C INTER A = EMPTY)) ==> + (?C' p' q' d N B a d'. + simple_arc top2 C' /\ ~C' p' /\ ~C' q' /\ (euclid 2 p') /\ + (euclid 2 q') /\ ~(p' = q') /\ + (!A. simple_arc_end A p' q' ==> ~(C' INTER A = EMPTY)) /\ + (&1 <=. d) /\ (&1 <=. d') /\ (0 < N) /\ + (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\ + (C' = UNIONS (IMAGE B {i | i <| N})) /\ + (!x. C' x ==> + (&8 * d <= d_euclid x p') /\ (&8 * d <= d_euclid x q')) /\ + (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==> + (&16 * d' < d_euclid x y)) /\ + (!i. (i <| N) ==> + (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d)))) + `, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`p`;`q`] simple_arc_constants; + TYPE_THEN `r = min_real d d'` ABBREV_TAC ; + TYPE_THEN `f = ( *# ) (&1 /r)` ABBREV_TAC ; + TYPE_THEN `C' = IMAGE f C` ABBREV_TAC ; + TYPE_THEN `B' = (IMAGE f) o B` ABBREV_TAC ; + TYPE_THEN `p' = f p` ABBREV_TAC ; + TYPE_THEN `q' = f q` ABBREV_TAC ; + TYPE_THEN `dr = d/r` ABBREV_TAC ; + TYPE_THEN `dr' = d'/r` ABBREV_TAC ; + TYPE_THEN `a' = f o a` ABBREV_TAC ; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `p'` EXISTS_TAC; + TYPE_THEN `q'` EXISTS_TAC; + TYPE_THEN `dr` EXISTS_TAC; + TYPE_THEN `N` EXISTS_TAC; + TYPE_THEN `B'` EXISTS_TAC; + TYPE_THEN `a'` EXISTS_TAC; + TYPE_THEN `dr'` EXISTS_TAC; + (* -A *) + TYPE_THEN `&0 < r` SUBAGOAL_TAC; + TYPE_THEN `r` UNABBREV_TAC; + REWRITE_TAC[min_real]; + COND_CASES_TAC; + TYPE_THEN `&0 < &1/ r` SUBAGOAL_TAC; + (* - *) + TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC; + TYPE_THEN `f` UNABBREV_TAC; + IMATCH_MP_TAC euclid_scale_homeo; + USEH 5104 SYM; + SUBCONJ_TAC; + TYPE_THEN `C'` UNABBREV_TAC; + IMATCH_MP_TAC simple_arc_homeo; + (* - *) + TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC; + USEH 3550 (MATCH_MP simple_arc_euclid); + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `C'` UNABBREV_TAC; + TYPE_THEN `p'` UNABBREV_TAC; + UNDH 9726 THEN ASM_REWRITE_TAC[]; + USEH 7428 (REWRITE_RULE[IMAGE]); + FULL_REWRITE_TAC[homeomorphism;BIJ;INJ]; + TYPE_THEN `(x = p)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[top2_unions]; + TYPE_THEN `p` UNABBREV_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `C'` UNABBREV_TAC; + TYPE_THEN `q'` UNABBREV_TAC; + UNDH 6497 THEN ASM_REWRITE_TAC[]; + USEH 4199 (REWRITE_RULE[IMAGE]); + FULL_REWRITE_TAC[homeomorphism;BIJ;INJ]; + TYPE_THEN `(q = x)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[top2_unions]; + TYPE_THEN `q` UNABBREV_TAC; + (* -B *) + TYPE_THEN `euclid 2 p' /\ euclid 2 q'` SUBAGOAL_TAC; + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `q'` UNABBREV_TAC; + FULL_REWRITE_TAC[homeomorphism;BIJ;SURJ;top2_unions]; + (* -// *) + CONJ_TAC; + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `q'` UNABBREV_TAC; + FULL_REWRITE_TAC[homeomorphism;BIJ;INJ]; + UNDH 11 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[top2_unions]; + (* - *) + CONJ_TAC; + TYPE_THEN `g = ( *# ) r` ABBREV_TAC ; + TYPE_THEN `A' = IMAGE g A` ABBREV_TAC ; + TYPE_THEN`homeomorphism g top2 top2` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + ASM_SIMP_TAC[euclid_scale_homeo]; + TSPECH `A'` 8219; + TYPE_THEN `!x. (g (f x) = x)` SUBAGOAL_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `f` UNABBREV_TAC; + REWRITE_TAC[euclid_scale_act]; + ASM_SIMP_TAC [euclid_scale_rinv]; + (* -- *) + UNDH 5082 THEN DISCH_THEN (THM_INTRO_TAC[]); + TYPE_THEN `A'` UNABBREV_TAC; + TYPE_THEN `(p = g p') /\ (q = g q')` SUBAGOAL_TAC; + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `q'` UNABBREV_TAC; + IMATCH_MP_TAC simple_arc_end_homeo; + USEH 7123 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + USEH 8329 (REWRITE_RULE[EQ_EMPTY;INTER]); + TSPECH `f u` 5681; + UNDH 1812 THEN REWRITE_TAC[]; + TYPE_THEN `C'` UNABBREV_TAC; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + TYPE_THEN `A'` UNABBREV_TAC; + USEH 1648 (REWRITE_RULE[IMAGE]); + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + REWRITE_TAC[euclid_scale_act]; + ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`]; + ASM_SIMP_TAC[euclid_scale_rinv]; + (* -C *) + CONJ_TAC; + TYPE_THEN `dr` UNABBREV_TAC; + TYPE_THEN `r` UNABBREV_TAC; + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; + REDUCE_TAC; + REWRITE_TAC[min_real_le]; + CONJ_TAC; + TYPE_THEN `dr'` UNABBREV_TAC; + TYPE_THEN `r` UNABBREV_TAC; + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; + REDUCE_TAC; + REWRITE_TAC[min_real_le]; + (* - *) + CONJ_TAC; + TYPE_THEN `B'` UNABBREV_TAC; + TYPE_THEN `a'` UNABBREV_TAC; + REWRITE_TAC[o_DEF]; + IMATCH_MP_TAC simple_arc_end_homeo; + (* - *) + CONJ_TAC; + TYPE_THEN `C'` UNABBREV_TAC; + TYPE_THEN `B'` UNABBREV_TAC; + REWRITE_TAC[IMAGE_o]; + REWRITE_TAC[GSYM image_unions]; + (* - *) + TYPE_THEN `!x y. (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid (f x) (f y) = (d_euclid x y)/r)` SUBAGOAL_TAC; + TYPE_THEN `f` UNABBREV_TAC; + THM_INTRO_TAC[`2`;`&1 / r`;`x`;`y`] norm_scale_vec; + TYPE_THEN `abs (&1/r) = &1/r` SUBAGOAL_TAC; + REWRITE_TAC[ABS_REFL]; + UNDH 4597 THEN REAL_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `x * y = y* x`]; + REWRITE_TAC[GSYM real_div_assoc]; + REDUCE_TAC; + (* -D *) + CONJ_TAC; + TYPE_THEN `C'` UNABBREV_TAC; + USEH 3184 (REWRITE_RULE[IMAGE]); + TYPE_THEN `p'` UNABBREV_TAC; + TYPE_THEN `q'` UNABBREV_TAC; + ASM_SIMP_TAC[]; + TYPE_THEN `dr` UNABBREV_TAC; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[real_div_denom]; + (* - *) + TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC; + UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + USEH 9744 (MATCH_MP simple_arc_end_simple); + USEH 3463 (MATCH_MP simple_arc_euclid); + USEH 4246 (REWRITE_RULE[SUBSET]); + (* - *) + CONJ_TAC; + TYPE_THEN `B'` UNABBREV_TAC; + FULL_REWRITE_TAC[o_DEF]; + USEH 407 (REWRITE_RULE[IMAGE]); + USEH 3121 (REWRITE_RULE[IMAGE]); + TYPE_THEN `i <| N` SUBAGOAL_TAC; + UNDH 3810 THEN UNDH 1688 THEN ARITH_TAC; + UNDH 2436 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x'`]); + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_MESON_TAC[]; + TYPE_THEN `dr'` UNABBREV_TAC; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[real_div_denom_lt]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* -E *) + TSPECH `i` 4673; + REWRITE_TAC[]; + TYPE_THEN `f x` EXISTS_TAC; + TYPE_THEN `B'` UNABBREV_TAC; + REWRITE_TAC[o_DEF]; + SUBCONJ_TAC; + IMATCH_MP_TAC image_imp; + FULL_REWRITE_TAC[SUBSET;open_ball]; + USEH 4418 (REWRITE_RULE[IMAGE]); + TSPECH `x''` 7148; + (* - *) + CONJ_TAC; + TYPE_THEN `f` UNABBREV_TAC; + IMATCH_MP_TAC euclid_scale_closure; + CONJ_TAC; + TYPE_THEN `f` UNABBREV_TAC; + IMATCH_MP_TAC euclid_scale_closure; + ASM_SIMP_TAC[]; + TYPE_THEN `dr` UNABBREV_TAC; + ASM_SIMP_TAC[real_div_denom_lt]; + (* Thu Dec 30 10:14:03 EST 2004 *) + + ]);; + + (* }}} *) + +let delta_pos_arch = prove_by_refinement( + `!d. (&0 < d) ==> (?n. (0 <| n) /\ (&1/(&n) < d))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`&1/d`] REAL_ARCH_SIMPLE; + TYPE_THEN `2 * n` EXISTS_TAC; + SUBCONJ_TAC; + REWRITE_TAC[LT_MULT]; + CONJ_TAC; + ARITH_TAC; + REWRITE_TAC[GSYM REAL_LT]; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `&1 / d` EXISTS_TAC; + (* - *) + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN `&1/ &n` EXISTS_TAC; + (* - *) + TYPE_THEN `&0 < &(2 *| n)` SUBAGOAL_TAC; + REWRITE_TAC[REAL_LT]; + TYPE_THEN `&0 < &n` SUBAGOAL_TAC; + FULL_REWRITE_TAC[REAL_LT]; + FULL_REWRITE_TAC[LT_MULT]; + CONJ_TAC; + ASM_SIMP_TAC[REAL_LT_RDIV_EQ]; + ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`]; + REWRITE_TAC[GSYM real_div_assoc]; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + REDUCE_TAC; + FULL_REWRITE_TAC[REAL_LT]; + UNDH 3476 THEN ARITH_TAC; + UNDH 27 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + FULL_REWRITE_TAC[REAL_MUL_AC]; + ]);; + (* }}} *) + +let suc_div = prove_by_refinement( + `!i a. &(SUC i) / a = &i/ a + &1/a`, + (* {{{ proof *) + [ + REWRITE_TAC[REAL]; + REWRITE_TAC[real_div]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let delta_partition_lemma_ver2 = prove_by_refinement( + `!delta. (&0 < delta) ==> (?M. !N. !x. ?i. (0 < M) /\ + ((M <= N) /\ (&0 <= x /\ x <= &1) ==> + (i <= N) /\ abs (&i/ &N - x) < delta))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE; + TYPE_THEN `n` EXISTS_TAC; + TYPE_THEN `num_abs_of_int (floor (&N*x))` EXISTS_TAC; + TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC; + TYPE_THEN `&0 < &n` SUBAGOAL_TAC; + UND 1 THEN UND 2 THEN REAL_ARITH_TAC; + TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC; + ASM_MESON_TAC[REAL_LE_LDIV_EQ]; + CONJ_TAC; + FULL_REWRITE_TAC[REAL_LT]; + TYPE_THEN `&:0 <= floor (&N * x)` SUBAGOAL_TAC; + TYPE_THEN `floor (&0) <=: floor (&N * x)` BACK_TAC; + FULL_REWRITE_TAC[floor_num]; + IMATCH_MP_TAC floor_mono; + IMATCH_MP_TAC REAL_LE_MUL; + (* - *) + CONJ_TAC; + TYPE_THEN `num_abs_of_int (floor (&N * x)) <= num_abs_of_int (floor (&N))` BACK_TAC; + FULL_REWRITE_TAC[floor_num;num_abs_of_int_num]; + IMATCH_MP_TAC num_abs_of_int_mono; + IMATCH_MP_TAC floor_mono; + TYPE_THEN `&N * x <= &N * &1` BACK_TAC; + UND 9 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC REAL_PROP_LE_LMUL; + (* -A *) + IMATCH_MP_TAC REAL_LT_LCANCEL_IMP; + TYPE_THEN `&N` EXISTS_TAC; + (* - *) + TYPE_THEN `&0 < &N` SUBAGOAL_TAC; + FULL_REWRITE_TAC[REAL_LT]; + UNDH 3476 THEN UNDH 9390 THEN ARITH_TAC; + IMATCH_MP_TAC REAL_LTE_TRANS; + TYPE_THEN`&1` EXISTS_TAC; + (* - *) + REWRITE_TAC[num_abs_of_int_th;]; + TYPE_THEN `abs (real_of_int (floor (&N * x))) = (real_of_int (floor (&N *x)))` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_REFL]; + FULL_REWRITE_TAC [int_le; int_of_num_th;]; + TYPE_THEN `!u. &N * abs (u / &N - x) = abs (u - &N*x)` SUBAGOAL_TAC; + TYPE_THEN `!t. &N * abs t = abs (&N *t)` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM]; + AP_TERM_TAC; + REWRITE_TAC[REAL_SUB_LDISTRIB]; + TYPE_THEN `&N * u/ &N = u` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_DIV_LMUL; + UND 12 THEN UND 9 THEN REAL_ARITH_TAC; + TYPE_THEN `t = &N * x ` ABBREV_TAC ; + TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC; + REWRITE_TAC[floor_ineq]; + TYPE_THEN `abs (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC; + UND 13 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`t`] floor_ineq; + CONJ_TAC; + UND 15 THEN REAL_ARITH_TAC; + (* - *) + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `&n * delta` EXISTS_TAC; + ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; + FULL_REWRITE_TAC[REAL_LE]; + ]);; + (* }}} *) + +let simple_arc_ball_cover_ver2 = prove_by_refinement( + `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> + (?M. !N. !x. ?i. (0 < M) /\ (( M <= N) /\ (&0 <= x /\ x <= &1) ==> + (i <= N) /\ + open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; + FULL_REWRITE_TAC[uniformly_continuous]; + TSPECH `&1` 814; + UNDH 4636 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRITE_TAC[open_ball]; + THM_INTRO_TAC[`delta`] delta_partition_lemma_ver2; + TYPE_THEN `M` EXISTS_TAC; + TSPECH `N` 6807; + TSPECH `x` 8373; + TYPE_THEN `i` EXISTS_TAC; + REP_BASIC_TAC; + UNDH 5594 THEN DISCH_THEN (THM_INTRO_TAC[]); + (* - *) + TYPE_THEN `0 <| N` SUBAGOAL_TAC; + UNDH 6734 THEN UNDH 4600 THEN ARITH_TAC; + (* - *) + TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_DIV; + THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ; + REWRITE_TAC[REAL_LT]; + REWRITE_TAC[REAL_MUL;REAL_LE]; + UNDH 8395 THEN ARITH_TAC; + (* - *) + FULL_REWRITE_TAC[INJ]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[d_real]; + ]);; + (* }}} *) + +let grid_image_bounded_ver2 = prove_by_refinement( + `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\ + INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==> + (?M. !N. (0 < M) /\ ((M <= N) ==> + ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER + (unbounded_set (grid f N)) = EMPTY)) )`, + (* {{{ proof *) + + [ + REWRITE_TAC[EQ_EMPTY;INTER;]; + THM_INTRO_TAC[`f`] simple_arc_ball_cover_ver2; + TYPE_THEN `M` EXISTS_TAC; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + TSPECH `N` 8189; + RIGHTH 2874 "i"; + RIGHTH 3911 "x"; + TYPE_THEN `x''` UNABBREV_TAC; + TYPE_THEN `0 <| N` SUBAGOAL_TAC; + UNDH 4600 THEN UNDH 6734 THEN ARITH_TAC; + FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ]; + UNDH 5619 THEN REWRITE_TAC[]; (* ~bounded *) + UNDH 1431 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + REWRH 3036; + FULL_REWRITE_TAC[open_ball]; + (* _ *) + IMATCH_MP_TAC bounded_avoidance_subset; + TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ; + TYPE_THEN `E` EXISTS_TAC; + (* _ *) + TYPE_THEN `conn2 E` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[grid33_conn2]; + REWRITE_TAC[grid_edge;grid_finite]; + TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC; + REWRITE_TAC[grid]; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + UNDH 8395 THEN ARITH_TAC; (* i <=| N *) + (* -- *) + REWRITE_TAC[IMAGE_UNION;UNIONS_UNION]; + REWRITE_TAC[SUBSET;UNION]; + DISJ1_TAC; + REWRITE_TAC[image_sing]; + (* - *) + TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC; + UNDH 4893 THEN REWRITE_TAC[]; + THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset; + USEH 2367 (MATCH_MP UNIONS_UNIONS); (* CURVE_CELL SUBSET curve-cell *) + ASM_MESON_TAC[subset_imp]; + KILLH 3474; (* E SUBSET grid f N *) + KILLH 4893; (* ~UNIONS (. grid f N) *) + (* -A// *) + TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ; + THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq; + FULL_REWRITE_TAC []; + REWRH 2390; + TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[grid33]; + IMATCH_MP_TAC rectangle_grid_subset; + (* __ *) + THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor; + THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor; + UNDH 7979 THEN UNDH 4359 THEN INT_ARITH_TAC; + (* -// *) + IMATCH_MP_TAC bounded_avoidance_subset; + TYPE_THEN `E'` EXISTS_TAC; + TYPE_THEN `conn2 E'` SUBAGOAL_TAC; + IMATCH_MP_TAC conn2_rectagon; + TYPE_THEN `FINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[conn2]; + (* -// *) + TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[grid33_edge]; + (* -// *) + ASM_SIMP_TAC[GSYM odd_bounded]; + REWRITE_TAC[UNIONS]; + TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC; + IMATCH_MP_TAC (TAUT ` a/\ b ==> b /\ a`); + (* -B// *) + TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC; + UNDH 1109 THEN REWRITE_TAC[]; (* ~ E *) + THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset; + USEH 2664 (MATCH_MP UNIONS_UNIONS); (* curve-cell SUBSET *) + ASM_MESON_TAC[subset_imp]; + (* -// *) + TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ; + TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC; + UNDH 8466 THEN REWRITE_TAC[]; (* ~ *) + REWRITE_TAC[UNIONS]; + TYPE_THEN `h_edge m` EXISTS_TAC; + REWRITE_TAC[curve_cell_h_ver2]; + USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); (* floor,floor = m *) + REWRH 1242; (* rg flor,flor *) + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[INSERT]; + (* -// *) + TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC; + UNDH 8466 THEN REWRITE_TAC[]; (* ~UNIONS .. E' *) + REWRITE_TAC[UNIONS]; + TYPE_THEN `v_edge m` EXISTS_TAC; + REWRITE_TAC[curve_cell_v_ver2]; + USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); + REWRH 1242; + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[INSERT]; + (* -// *) + TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC; + UNDH 8466 THEN REWRITE_TAC[]; + REWRITE_TAC[UNIONS]; + TYPE_THEN `{(pointI m)}` EXISTS_TAC; + ASM_SIMP_TAC[rectagon_segment;curve_cell_cls]; + USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); + REWRH 1242; + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INSERT]; + USEH 9677 (MATCH_MP cls_subset); (* { hedge } SUBSET E' *) + USEH 1949 (REWRITE_RULE[SUBSET]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[cls_h]; + (* -C// *) + USEH 2851 (MATCH_MP point_onto); (* euclid 2 (f x') *) + THM_INTRO_TAC[`p`] square_domain; + UNDH 4082 THEN LET_TAC; + TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC; + TYPE_THEN `m` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + REWRH 2288; (* big ONE *) + TYPE_THEN `point p` UNABBREV_TAC; + USEH 459 (REWRITE_RULE[UNION;INR IN_SING;]); (* long *) + REWRH 4739; (* \/ *) + (* -D// *) + ASM_SIMP_TAC[rectagon_segment;par_cell_squ]; + FULL_REWRITE_TAC[num_lower]; + USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); + REWRH 1242; (* rect-grid *) + FULL_REWRITE_TAC[rectangle_grid_sq]; + TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[INSERT;cell_clauses]; + REWRH 5179; (* EVEN *) + (* - *) + TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[up;PAIR_SPLIT]; + INT_ARITH_TAC; + REWRH 3452; (* EVEN *) + FULL_REWRITE_TAC[card_sing;EVEN2]; + ]);; + + (* }}} *) + +let grid33_h = prove_by_refinement( + `!m. grid33 m (h_edge m)`, + (* {{{ proof *) + [ + REWRITE_TAC[grid33]; + REWRITE_TAC[rectangle_grid]; + DISJ1_TAC; + TYPE_THEN `m` EXISTS_TAC; + INT_ARITH_TAC; + ]);; + (* }}} *) + +let curve_cell_grid_unions = prove_by_refinement( + `!f N. curve_cell (grid f N) = + UNIONS (IMAGE curve_cell + ((IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) + {j | j <=| N})))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + REWRITE_TAC[grid]; + TYPE_THEN `S = (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N})` ABBREV_TAC ; + IMATCH_MP_TAC thread_finite_union; + REWRITE_TAC[curve_cell_union;curve_cell_empty]; + TYPE_THEN `S` UNABBREV_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + REWRITE_TAC[FINITE_NUMSEG_LE]; + ]);; + + (* }}} *) + +let curve_cell_finite_union = prove_by_refinement( + `!E. FINITE E ==> + ( curve_cell (UNIONS E) = UNIONS (IMAGE curve_cell E))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC thread_finite_union; + REWRITE_TAC[curve_cell_empty;curve_cell_union]; + ]);; + (* }}} *) + +let grid33_unions = prove_by_refinement( + `!p. grid33 p = + (IMAGE h_edge + { m | (FST p -: &:1 <=: FST m) /\ FST m <=: FST p +: &:1 /\ + SND p -: &:1 <=: SND m /\ (SND m <=: SND p +: &:2) }) + UNION + (IMAGE v_edge + { m | FST p -: &:1 <=: FST m /\ FST m <= FST p +: &:2 /\ + SND p -: &:1 <=: SND m /\ SND m <= SND p +: &:1}) `, + (* {{{ proof *) + + [ + REWRITE_TAC[grid33;IMAGE;rectangle_grid]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION]; + IMATCH_MP_TAC EQ_ANTISYM ; + CONJ_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses]; + CONV_TAC (dropq_conv "x"); + TYPE_THEN `m'` UNABBREV_TAC; + UNDH 3867 THEN INT_ARITH_TAC; + (* -- *) + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses]; + CONV_TAC (dropq_conv "x"); + TYPE_THEN `m'` UNABBREV_TAC; + UNDH 2244 THEN INT_ARITH_TAC; + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses]; + CONV_TAC (dropq_conv "m"); + TYPE_THEN `x'` UNABBREV_TAC; + UNDH 6786 THEN INT_ARITH_TAC; + (* - *) + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[cell_clauses]; + CONV_TAC (dropq_conv "m"); + TYPE_THEN `x'` UNABBREV_TAC; + UNDH 2096 THEN INT_ARITH_TAC; + ]);; + + (* }}} *) + +let int_range_finite = prove_by_refinement( + `!a b. FINITE {t | a <=: t /\ t <=: b}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `b <: a` ASM_CASES_TAC; + TYPE_THEN `{ t | a <=: t /\ t <=: b} = EMPTY ` BACK_TAC; + REWRITE_TAC[FINITE_RULES]; + IMATCH_MP_TAC EQ_EXT; + UNDH 5826 THEN INT_ARITH_TAC; + (* - *) + THM_INTRO_TAC[`a`] INT_REP; + THM_INTRO_TAC[`b`] INT_REP; + TYPE_THEN `a` UNABBREV_TAC; + TYPE_THEN `b` UNABBREV_TAC; + (* - *) + THM_INTRO_TAC[`{ i | i <=| (n' + m) - (n + m') }`;`{t | (&:n -: &:m) <=: t /\ t <=: &:n' -: &:m'}`;`(\ i. (&:i) + &:n -: &:m)`] SURJ_FINITE; + REWRITE_TAC[FINITE_NUMSEG_LE]; + REWRITE_TAC[SURJ]; + CONJ_TAC; + TYPE_THEN `(n +| m') <= (n' + m)` SUBAGOAL_TAC; + REWRITE_TAC[GSYM INT_OF_NUM_LE]; + REWRITE_TAC[GSYM INT_OF_NUM_ADD]; + UNDH 6818 THEN INT_ARITH_TAC; + USEH 2499 (MATCH_MP INT_OF_NUM_SUB); + USEH 6968 SYM; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE]; + REWRH 3919; + FULL_REWRITE_TAC[INT_OF_NUM_ADD]; + CONJ_TAC; + TYPE_THEN `&:0 <=: &:x` SUBAGOAL_TAC; + REWRITE_TAC[INT_OF_NUM_LE]; + ARITH_TAC; + UNDH 163 THEN ARITH_TAC; + UNDH 1710 THEN ARITH_TAC; + (* -A *) + THM_INTRO_TAC[`x`] INT_REP; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `(n'' + m) -| (m'' + n)` EXISTS_TAC; + TYPE_THEN `&:n'' + &:m' <=: &:n' + &:m''` SUBAGOAL_TAC; + UNDH 4837 THEN INT_ARITH_TAC; + KILLH 4837; + TYPE_THEN `&:m'' + &:n <=: &:n'' + &:m` SUBAGOAL_TAC; + UNDH 9532 THEN INT_ARITH_TAC; + KILLH 9532; + KILLH 6818; + (* - *) + CONJ_TAC; + FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE]; + UNDH 8565 THEN UNDH 9575 THEN ARITH_TAC; + (* - *) + FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE]; + ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB]; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_ADD]; + FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE;GSYM INT_OF_NUM_ADD ]; + UNDH 4630 THEN UNDH 1357 THEN INT_ARITH_TAC; + ]);; + (* }}} *) + +let subs_lemma = prove_by_refinement( + `!y (f:A->bool). (f y) ==> (!x. (x = y) ==> f x)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `x` UNABBREV_TAC; + ]);; + (* }}} *) + +(*** JRH changed the labels here because somehow + some beta-redexes get contracted that did not before, + (new IN_ELIM_THM?) and this changes the set comprehensions + +let int2_range_finite = prove_by_refinement( + `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\ + c <=: SND m /\ SND m <=: d}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT; + REWRITE_TAC[int_range_finite]; + USEH 3506 (MATCH_MP subs_lemma); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC EQ_EXT; + KILLH 8899; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "t'"); + CONV_TAC (dropq_conv "u'"); + REWRITE_TAC[PAIR_SPLIT]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + + ****) + +let int2_range_finite = prove_by_refinement( + `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\ + c <=: SND m /\ SND m <=: d}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT; + REWRITE_TAC[int_range_finite]; + USEH 4853 (MATCH_MP subs_lemma); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC EQ_EXT; + KILLH 4636; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + NAME_CONFLICT_TAC; + CONV_TAC (dropq_conv "t'"); + CONV_TAC (dropq_conv "u'"); + REWRITE_TAC[PAIR_SPLIT]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + + +let grid33_finite = prove_by_refinement( + `!p. FINITE (grid33 p)`, + (* {{{ proof *) + [ + REWRITE_TAC[grid33_unions]; + REWRITE_TAC[FINITE_UNION]; + CONJ_TAC THEN (IMATCH_MP_TAC FINITE_IMAGE) THEN (REWRITE_TAC[int2_range_finite]); + ]);; + (* }}} *) + +let d_euclid_bound2 = prove_by_refinement( + `!x y eps. euclid 2 x /\ euclid 2 y /\ (abs (x 0 - y 0) <= eps) /\ + (abs (x 1 - y 1) <= eps) ==> (d_euclid x y <= sqrt(&2) * eps)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC D_EUCLID_BOUND; + REP_BASIC_TAC; + TYPE_THEN `(i=0) \/ (i = 1) \/ (2 <= i)` SUBAGOAL_TAC; + ARITH_TAC; + UNDH 2744 THEN REP_CASES_TAC; + TYPE_THEN `i` UNABBREV_TAC; + TYPE_THEN `i` UNABBREV_TAC; + FULL_REWRITE_TAC[euclid]; + UND 0 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let grid33_radius = prove_by_refinement( + `!x y. (euclid 2 x) /\ + (UNIONS (curve_cell (grid33 (floor (x 0),floor (x 1)))) y) ==> + (d_euclid x y < &4 )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `m = (floor (x 0),floor (x 1))` ABBREV_TAC ; + THM_INTRO_TAC[`grid33 m`] (GSYM curve_closure_ver2); + REWRITE_TAC[grid33_edge;grid33_finite]; + REWRH 2056; + KILLH 7690; + TYPE_THEN `(UNIONS (grid33 m)) SUBSET closed_ball (euclid 2,d_euclid) x (&3) ` BACK_TAC; + THM_INTRO_TAC[`top2`;`UNIONS(grid33 m)`;`closed_ball (euclid 2,d_euclid) x (&3)`;] closure_subset; + REWRITE_TAC [top2_top;]; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`&3 `]closed_ball_closed; + FULL_REWRITE_TAC[GSYM top2]; + KILLH 1468; + FULL_REWRITE_TAC[SUBSET;closed_ball]; + TSPECH `y` 8043; + FULL_REWRITE_TAC[]; + UNDH 9621 THEN REAL_ARITH_TAC; + (* -A *) + KILLH 920; + FULL_REWRITE_TAC [grid33_unions]; + REWRITE_TAC[UNIONS_UNION;union_subset]; + (* - *) + TYPE_THEN `sqrt (&2) * (&2) <= (&3)` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_POW_2_LE; + REWRITE_TAC[REAL_POW_MUL]; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + IMATCH_MP_TAC SQRT_POS_LE; + TYPE_THEN `sqrt(&2) pow 2 = &2` SUBAGOAL_TAC; + IMATCH_MP_TAC SQRT_POW_2; + REWRITE_TAC[REAL_POW_2]; + REAL_ARITH_TAC; + (* - *) + CONJ_TAC; + FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball]; + TYPE_THEN `u` UNABBREV_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[h_edge_euclid;subset_imp]; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC; + IMATCH_MP_TAC d_euclid_bound2; + FULL_REWRITE_TAC[h_edge]; + REWRITE_TAC[coord01]; + TYPE_THEN `v` UNABBREV_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `m` UNABBREV_TAC; + THM_INTRO_TAC[`x 0`] floor_ineq; + THM_INTRO_TAC[`x 1`] floor_ineq; + FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le]; + POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC; + (* - *) + FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball]; + TYPE_THEN `u` UNABBREV_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[v_edge_euclid;subset_imp]; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC; + IMATCH_MP_TAC d_euclid_bound2; + FULL_REWRITE_TAC[v_edge]; + REWRITE_TAC[coord01]; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `m` UNABBREV_TAC; + THM_INTRO_TAC[`x 0`] floor_ineq; + THM_INTRO_TAC[`x 1`] floor_ineq; + FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le]; + POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC; + (* Thu Dec 30 21:22:53 EST 2004 *) + + ]);; + (* }}} *) + +let simple_arc_grid_properties = prove_by_refinement( + `!C a b. simple_arc_end C a b ==> (?E. + E SUBSET edge /\ + (C INTER (unbounded_set E) = EMPTY) /\ + conn2 E /\ + E (h_edge (floor (a 0),floor (a 1))) /\ + E (h_edge (floor (b 0),floor (b 1))) /\ + (!y. UNIONS (curve_cell E) y ==> (?x. C x /\ d_euclid x y < &4)))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + COPYH 2895; + USEH 2895 (REWRITE_RULE [simple_arc_end]); + THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous; + FULL_REWRITE_TAC[uniformly_continuous]; + (* - *) + TYPE_THEN `!N' x. (&0 < &N') ==> ((&0 <= x/ &N') <=> (&0 <= x))` SUBAGOAL_TAC; + THM_INTRO_TAC[`&N'`;`&0`;`x`] real_div_denom; + FULL_REWRITE_TAC[REAL_DIV_LZERO]; + (* - *) + TYPE_THEN `!N' x. (&0 < &N') ==> ((x/ &N' <= &1) <=> (x <= &N'))` SUBAGOAL_TAC; + ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + REDUCE_TAC; + (* - *) + TYPE_THEN `?N. (!i N'. (N <= N') /\ (i <| N') ==> d_euclid (f (&i / &N')) (f (&(SUC i) / &N')) < &1)` SUBAGOAL_TAC; + TSPECH `&1` 814; + FULL_REWRITE_TAC[REAL_ARITH `&0 < &1`]; + THM_INTRO_TAC[`delta`] delta_pos_arch; + TYPE_THEN `n` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FULL_REWRITE_TAC[GSYM REAL_LT]; + FULL_REWRITE_TAC[REAL_LE;REAL_LT;d_real]; + (* -- *) + TYPE_THEN `0 <| N'` SUBAGOAL_TAC; + UNDH 800 THEN UNDH 3476 THEN ARITH_TAC; + (* -- *) + FULL_REWRITE_TAC[REAL_LE;REAL_LT;]; + CONJ_TAC; + UNDH 9580 THEN ARITH_TAC; + CONJ_TAC; + UNDH 9580 THEN ARITH_TAC; + REWRITE_TAC[suc_div]; + REWRITE_TAC[REAL_ARITH `abs (x - (x + y)) = abs y`]; + REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM]; + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `&1/ &n`EXISTS_TAC; + FULL_REWRITE_TAC[GSYM REAL_LT]; + ASM_SIMP_TAC[RAT_LEMMA4]; + REDUCE_TAC; + (* -A *) + THM_INTRO_TAC[`f`] grid_image_bounded_ver2; + TYPE_THEN `n = N +| M` ABBREV_TAC ; + TYPE_THEN`E = grid f n` ABBREV_TAC ; + TYPE_THEN `E` EXISTS_TAC; + TYPE_THEN `0 <| n /\ M <= n /\ N <= n` SUBAGOAL_TAC; + RIGHTH 8917 "N"; + UNDH 8208 THEN UNDH 4600 THEN ARITH_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC [ grid_edge]; + (* - *) + SUBCONJ_TAC; + TSPECH `n` 8917; + TYPE_THEN `E` UNABBREV_TAC; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + IMATCH_MP_TAC grid_conn2; + CONJ_TAC; + IMATCH_MP_TAC inj_image_subset; + (* -- *) + FIRST_ASSUM IMATCH_MP_TAC ; + (* -B *) + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[grid]; + TYPE_THEN `a` UNABBREV_TAC; + REWRITE_TAC[IMAGE;UNIONS]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `0` EXISTS_TAC; + CONJ_TAC; + UNDH 3476 THEN ARITH_TAC; + REWRITE_TAC[REAL_DIV_LZERO;grid33_h]; + (* - *) + CONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[grid]; + TYPE_THEN `b` UNABBREV_TAC; + REWRITE_TAC[IMAGE;UNIONS]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `n` EXISTS_TAC; + CONJ_TAC; + ARITH_TAC; + USEH 3476 (REWRITE_RULE [GSYM REAL_LT]); + USEH 1089 (MATCH_MP (REAL_ARITH `&0 < y ==> ~(y = &0)`)); + ASM_SIMP_TAC[REAL_DIV_REFL]; + REWRITE_TAC[grid33_h]; + (* -C *) + TYPE_THEN `E` UNABBREV_TAC; + USEH 2127 (REWRITE_RULE[curve_cell_grid_unions]); + USEH 957 (REWRITE_RULE[IMAGE;UNIONS]); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + TYPE_THEN `f ( &x' / &n )` EXISTS_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC image_imp ; + FULL_REWRITE_TAC[GSYM REAL_LT]; + FULL_REWRITE_TAC[REAL_LE;REAL_LT ]; + ARITH_TAC; + (* - *) + IMATCH_MP_TAC grid33_radius; + CONJ_TAC; + USEH 2083 (REWRITE_RULE[IMAGE]); + USEH 7215 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + (* - *) + REWRITE_TAC[UNIONS]; + UNIFY_EXISTS_TAC; + (* Thu Dec 30 21:27:32 EST 2004 *) + ]);; + + (* }}} *) + +let unbounded_set_lemma = prove_by_refinement( + `!E p. (FINITE E /\ E SUBSET edge) ==> + (unbounded_set E p <=> (?r. !s. (r <= s) ==> + (?C. simple_arc_end C p (point(s,&0)) /\ + (C INTER UNIONS (curve_cell E) = EMPTY))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + THM_INTRO_TAC[`E`;`p`] unbounded_euclid; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + (* -- *) + FULL_REWRITE_TAC[unbounded_set;unbounded]; + TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ; + TYPE_THEN `r'` EXISTS_TAC; + THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; + TYPE_THEN `s` UNABBREV_TAC; + TYPE_THEN `r'` UNABBREV_TAC; + UNDH 5363 THEN UNDH 4629 THEN REAL_ARITH_TAC; + USEH 3140 (ONCE_REWRITE_RULE[EQ_SYM_EQ]); + FIRST_ASSUM IMATCH_MP_TAC ; + THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; + UNDH 1263 THEN UNDH 5669 THEN UNDH 6232 THEN REAL_ARITH_TAC; + (* - *) + REWRITE_TAC[unbounded_set;unbounded]; + TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; + TSPECH `r` 3171; + FULL_REWRITE_TAC[REAL_ARITH `r <= r`]; + COPYH 3604; + USEH 3604 (MATCH_MP simple_arc_end_end); + USEH 3604 (MATCH_MP simple_arc_end_simple); + USEH 3550 (MATCH_MP simple_arc_euclid); + ASM_MESON_TAC[subset_imp]; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + (* - *) + TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ; + TYPE_THEN `r'` EXISTS_TAC; + THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; + UNDH 5363 THEN UNDH 6232 THEN UNDH 5669 THEN UNDH 9420 THEN REAL_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `r'` UNABBREV_TAC; + THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le; + UNDH 1263 THEN UNDH 540 THEN REAL_ARITH_TAC; + (* Fri Dec 31 07:35:03 EST 2004 *) + + ]);; + (* }}} *) + +let simple_arc_end_subset_trans_lemma = prove_by_refinement( + `!C a b c. simple_arc_end C a b /\ C c /\ ~(c = a) ==> + (?C'. C' SUBSET C /\ simple_arc_end C' a c)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `b = c` ASM_CASES_TAC; + TYPE_THEN `b` UNABBREV_TAC; + TYPE_THEN `C` EXISTS_TAC; + REWRITE_TAC[SUBSET_REFL]; + THM_INTRO_TAC[`C`;`a`;`b`;`c`] simple_arc_end_cut; + TYPE_THEN `C'` EXISTS_TAC; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + ]);; + (* }}} *) + +let simple_arc_end_subset_trans = prove_by_refinement( + `!C C' a b c. simple_arc_end C a b /\ simple_arc_end C' b c /\ + ~(a = c) ==> + (?U. simple_arc_end U a c /\ U SUBSET (C UNION C'))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `C' a` ASM_CASES_TAC; + THM_INTRO_TAC[`C'`;`c`;`b`;`a`] simple_arc_end_subset_trans_lemma; + IMATCH_MP_TAC simple_arc_end_symm; + TYPE_THEN `C''` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + IMATCH_MP_TAC SUBSET_TRANS; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* - *) + THM_INTRO_TAC[`C`;`{a}`;`C'`] simple_arc_end_restriction; + CONJ_TAC; + USEH 2895 (MATCH_MP simple_arc_end_simple); + CONJ_TAC; + USEH 2895 (MATCH_MP simple_arc_end_end_closed); + CONJ_TAC; + USEH 3594 (MATCH_MP simple_arc_end_closed); + CONJ_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ]; + TYPE_THEN `u` UNABBREV_TAC; + ASM_MESON_TAC[]; + CONJ_TAC THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `a` EXISTS_TAC; + USEH 2895 (MATCH_MP simple_arc_end_end); + TYPE_THEN `b` EXISTS_TAC; + USEH 2895 (MATCH_MP simple_arc_end_end2); + USEH 3594 (MATCH_MP simple_arc_end_end); + (* - *) + TYPE_THEN `v = a` SUBAGOAL_TAC; + USEH 6975 (REWRITE_RULE[eq_sing]); + USEH 8361 (REWRITE_RULE[INTER;INR IN_SING]); + TYPE_THEN `v` UNABBREV_TAC; + (* - *) + TYPE_THEN `v' = c` ASM_CASES_TAC; + TYPE_THEN `v'` UNABBREV_TAC; + TYPE_THEN `C''` EXISTS_TAC; + FULL_REWRITE_TAC[SUBSET;UNION]; + (* - *) + THM_INTRO_TAC[`C'`;`c`;`b`;`v'`] simple_arc_end_subset_trans_lemma; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + USEH 9287 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + USEH 6723 (MATCH_MP simple_arc_end_symm); + THM_INTRO_TAC[`C''`;`C'''`;`a`;`v'`;`c`] simple_arc_end_trans; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + FULL_REWRITE_TAC[INTER;eq_sing;INR IN_SING;SUBSET]; + ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + USEH 3266 (MATCH_MP simple_arc_end_end2); + USEH 2088 (MATCH_MP simple_arc_end_end); + TYPE_THEN `C'' UNION C'''` EXISTS_TAC; + FULL_REWRITE_TAC[SUBSET;UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + (* Fri Dec 31 08:49:20 EST 2004 *) + + ]);; + (* }}} *) + +let unbounded_set_trans_lemma = prove_by_refinement( + `!E p q x r. FINITE E /\ E SUBSET edge /\ + (unbounded_set E p) /\ + (UNIONS E SUBSET (closed_ball(euclid 2,d_euclid) x r)) /\ + (?C. simple_arc_end C p q /\ + (C INTER closed_ball(euclid 2,d_euclid) x r = EMPTY)) ==> + (unbounded_set E q)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `closure top2 (UNIONS E) SUBSET (closed_ball (euclid 2,d_euclid) x r)` SUBAGOAL_TAC; + IMATCH_MP_TAC closure_subset; + REWRITE_TAC[top2_top]; + REWRITE_TAC[top2]; + IMATCH_MP_TAC closed_ball_closed; + (* - *) + THM_INTRO_TAC[`E`] curve_closure_ver2; + REWRH 5238; + KILLH 3085; + KILLH 5161; + (* - *) + TYPE_THEN `C INTER UNIONS (curve_cell E) = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + FULL_REWRITE_TAC[EQ_EMPTY ]; + TSPECH `u` 5342; + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* - *) + UNDH 2166 THEN ASM_SIMP_TAC [unbounded_set_lemma]; + TYPE_THEN `euclid 2 q` SUBAGOAL_TAC; + COPYH 5276; + USEH 5276 (MATCH_MP simple_arc_end_simple); + USEH 5276 (MATCH_MP simple_arc_end_end2); + USEH 3550 (MATCH_MP simple_arc_euclid); + ASM_MESON_TAC[subset_imp]; + USEH 877 (MATCH_MP point_onto); + TYPE_THEN `q` UNABBREV_TAC; + (* - *) + TYPE_THEN `r'' = max_real r' (FST p' + &1)` ABBREV_TAC ; + TYPE_THEN `r''` EXISTS_TAC; + TSPECH `s` 5976; + (* - *) + TYPE_THEN `r' <= s` SUBAGOAL_TAC; + TYPE_THEN `r''` UNABBREV_TAC; + THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le; + UNDH 6140 THEN UNDH 3019 THEN REAL_ARITH_TAC; + REP_BASIC_TAC; + USEH 9110 (MATCH_MP simple_arc_end_symm); + (* - *) + TYPE_THEN `~(point p' = point (s,&0))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `s` UNABBREV_TAC; + TYPE_THEN `r''` UNABBREV_TAC; + THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le; + UNDH 9809 THEN UNDH 7108 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`C`;`C'`;`point p'`;`p`;`(point(s,&0))`] simple_arc_end_subset_trans; + TYPE_THEN `U` EXISTS_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; + FULL_REWRITE_TAC[SUBSET;UNION;EQ_EMPTY]; + ASM_MESON_TAC[]; + (* Fri Dec 31 09:05:35 EST 2004 *) + + ]);; + (* }}} *) + +let unbounded_set_empty = prove_by_refinement( + `(unbounded_set EMPTY = euclid 2)`, + (* {{{ proof *) + [ + THM_INTRO_TAC[`EMPTY:((num->real)->bool)->bool`] unbound_set_x_axis; + REWRITE_TAC[FINITE_RULES]; + TSPECH `r` 9109; + FULL_REWRITE_TAC[REAL_ARITH `r <= r`]; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC unbounded_euclid; + UNIFY_EXISTS_TAC; + (* - *) + TYPE_THEN `x = (point(r,&0))` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + (* - *) + IMATCH_MP_TAC unbounded_set_trans_lemma; + REWRITE_TAC[FINITE_RULES]; + TYPE_THEN `point(r,&0)` EXISTS_TAC; + TYPE_THEN `point(&0,&0)` EXISTS_TAC; + TYPE_THEN `-- &1` EXISTS_TAC; + (* - *) + THM_INTRO_TAC[`2`;`point(&0,&0)`;`-- &1`] closed_ball_empty; + REAL_ARITH_TAC; + TYPE_THEN `mk_segment (point (r,&0)) x` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[INTER_EMPTY]; + (* Fri Dec 31 09:37:30 EST 2004 *) + + ]);; + (* }}} *) + +let continuous_real_const = prove_by_refinement( + `!r. continuous (\t. r) (top_of_metric (UNIV,d_real)) + (top_of_metric (UNIV,d_real))`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous;preimage]; + TYPE_THEN `v r` ASM_CASES_TAC; + TYPE_THEN `{x | UNIONS (top_of_metric (UNIV,d_real)) x} = UNIONS (top_of_metric(UNIV,d_real))` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC top_univ; + IMATCH_MP_TAC top_of_metric_top; + REWRITE_TAC[metric_real]; +(**** Modified by JRH to avoid GSPEC + REWRITE_TAC[GSYM EMPTY;GSPEC;top_of_metric_empty ]; + ****) + (let lemma = prove(`{x | F} = {}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]) in + REWRITE_TAC[lemma; top_of_metric_empty]) + (* Fri Dec 31 10:30:48 EST 2004 *) + + ]);; + (* }}} *) + +let continuous_real_mul = prove_by_refinement( + `!r. (&0 < r) ==> continuous (( *. ) r) + (top_of_metric (UNIV,d_real)) + (top_of_metric (UNIV,d_real)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`( *. ) r`;`UNIV:real->bool`;`UNIV:real->bool`;`d_real`;`d_real`;] metric_continuous_continuous; + REWRITE_TAC[metric_real]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + FULL_REWRITE_TAC[d_real]; + TYPE_THEN `epsilon/r` EXISTS_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + UNDH 5576 THEN (ASM_SIMP_TAC[REAL_LT_RDIV_EQ]); + ASM_SIMP_TAC[REAL_ARITH `r * x - r *y = r*. (x - y)`;ABS_MUL ]; + UNDH 7175 THEN UNDH 6412 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let polar_curve_lemma = prove_by_refinement( + `!x theta r. euclid 2 x /\ &0 < theta /\ theta < &2 * pi /\ &0 < r ==> + (?C. + simple_arc_end C (x + point(r,&0)) (x + r *# (cis theta)) /\ + !y. C y ==> (d_euclid x y = r))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `f = (\ (t:real) . r) ` ABBREV_TAC ; + TYPE_THEN `g = ( *. ) theta` ABBREV_TAC ; + THM_INTRO_TAC[`x`;`f`;`g`] polar_cont; + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + ASM_SIMP_TAC [continuous_real_const;continuous_real_mul]; + TYPE_THEN `G = (\t. euclid_plus x (f t *# cis (g t))) ` ABBREV_TAC ; + TYPE_THEN `C = IMAGE G {x | &0 <= x /\ x <= &1}` ABBREV_TAC ; + TYPE_THEN `C` EXISTS_TAC; + REWRITE_TAC[simple_arc_end]; + SUBCONJ_TAC; + TYPE_THEN `G` EXISTS_TAC; + (* -- *) + TYPE_THEN `G (&0) = euclid_plus x (point (r,&0)) ` SUBAGOAL_TAC; + TYPE_THEN `G` UNABBREV_TAC; + AP_TERM_TAC; + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + REDUCE_TAC; + REWRITE_TAC[cis]; + REWRITE_TAC[point_scale;COS_0;SIN_0]; + REDUCE_TAC; + (* -- *) + TYPE_THEN `G (&1) = euclid_plus x (r *# cis theta)` SUBAGOAL_TAC; + TYPE_THEN `G` UNABBREV_TAC; + AP_TERM_TAC; + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + REDUCE_TAC; + (* -- *) + TYPE_THEN `G` UNABBREV_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + IMATCH_MP_TAC euclid_add_closure; + REWRITE_TAC[polar_euclid]; + (* -- *) + FULL_REWRITE_TAC[euclid_add_cancel]; + TYPE_THEN `f` UNABBREV_TAC; + THM_INTRO_TAC[`g x'`;`g y`;`r`;`r`] polar_inj; + TYPE_THEN `g` UNABBREV_TAC; + ASSUME_TAC (REAL_ARITH `&0 < r ==> &0 <= r`); + TYPE_THEN `!x. &0 <= x ==> &0 <= theta* x` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LE_MUL; + UNDH 2540 THEN REAL_ARITH_TAC; + TYPE_THEN `!x. (x <= &1) ==> (theta* x < &2 * pi)` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LET_TRANS; + TYPE_THEN `theta* &1` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_LMUL; + UNDH 2540 THEN REAL_ARITH_TAC; + REDUCE_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `r` UNABBREV_TAC; + UNDH 869 THEN REAL_ARITH_TAC; + TYPE_THEN `g` UNABBREV_TAC; + FULL_REWRITE_TAC[REAL_EQ_MUL_LCANCEL]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `theta` UNABBREV_TAC; + UNDH 869 THEN REAL_ARITH_TAC; + (* -A *) + TYPE_THEN `C` UNABBREV_TAC; + TYPE_THEN `G` UNABBREV_TAC; + USEH 1547 (REWRITE_RULE[IMAGE]); + TYPE_THEN `f` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `d_euclid x (euclid_plus x (r *# cis (theta * x'))) = d_euclid (x + (&0 *# (cis (theta * x')))) (euclid_plus x (r *# cis (theta * x')))` SUBAGOAL_TAC; + AP_THM_TAC; + AP_TERM_TAC; + REWRITE_TAC[euclid_scale0;euclid_rzero]; + THM_INTRO_TAC[`2`;`(&0 *# cis (theta * x'))`;`(r *# cis (theta * x'))`;`x`] metric_translate_LEFT; + REWRITE_TAC[polar_euclid]; + REWRITE_TAC[d_euclid_eq_arg]; + UNDH 6412 THEN REAL_ARITH_TAC; + (* Fri Dec 31 11:25:13 EST 2004 *) + + ]);; + (* }}} *) + +let unbounded_set_ball = prove_by_refinement( + `!E x r p. (&0 < r) /\ + FINITE E /\ E SUBSET edge /\ (euclid 2 p) /\ + UNIONS E SUBSET (closed_ball (euclid 2,d_euclid) x r) /\ + ~(closed_ball (euclid 2,d_euclid) x r p) ==> + unbounded_set E p`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`E`] unbound_set_x_axis; + (* - *) + TYPE_THEN `E = EMPTY` ASM_CASES_TAC; + FULL_REWRITE_TAC[unbounded_set_empty]; + TYPE_THEN `UNIONS E = EMPTY` ASM_CASES_TAC; + FULL_REWRITE_TAC[UNIONS_EQ_EMPTY]; + REWRH 7639; + TYPE_THEN `E` UNABBREV_TAC; + USEH 8908(REWRITE_RULE[SUBSET;INR IN_SING ]); + TYPE_THEN `edge EMPTY` SUBAGOAL_TAC; + USEH 1936 (MATCH_MP edge_cell); + USEH 5731 (MATCH_MP cell_nonempty); + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[EMPTY_EXISTS]; + (* - *) + TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET;closed_ball]; + TSPECH `u` 9087; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + (* -A *) + TYPE_THEN `!x. (FST p' + r < x) ==> unbounded_set E (point(x,&0))` SUBAGOAL_TAC; + TYPE_THEN `r' <= x'` ASM_CASES_TAC; + IMATCH_MP_TAC unbounded_set_trans_lemma; + TYPE_THEN `point(r',&0)` EXISTS_TAC; + TYPE_THEN `point p'` EXISTS_TAC; + TYPE_THEN `r` EXISTS_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REAL_ARITH_TAC; + TYPE_THEN `mk_segment (point (r',&0)) (point(x',&0))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `x'` UNABBREV_TAC; + UNDH 7236 THEN REAL_ARITH_TAC; + ONCE_REWRITE_TAC[mk_segment_sym]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + THM_INTRO_TAC[`x'`;`r'`;`&0`;`u''`]mk_segment_h; + UNDH 7636 THEN REAL_ARITH_TAC; + REWRH 9446; + TYPE_THEN `u''` UNABBREV_TAC; + USEH 7067 (REWRITE_RULE[closed_ball]); + THM_INTRO_TAC[`2`;`point p'`;`point(t,&0)`;`0`]proj_contraction; + FULL_REWRITE_TAC[coord01]; + UNDH 9207 THEN UNDH 6790 THEN UNDH 9670 THEN UNDH 2823 THEN REAL_ARITH_TAC; + (* -B *) + KILLH 3473; + KILLH 5938; + KILLH 7857; + (* - *) + TYPE_THEN `?R theta. r < R /\ &0 <= theta /\ theta < &2 * pi /\ (p = (point p') + (R *# cis theta))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[closed_ball]; + TYPE_THEN `?q. (euclid 2 q) /\ (p = point p' + q) ` SUBAGOAL_TAC; + TYPE_THEN `euclid_minus p (point p')` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC euclid_sub_closure; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[euclid_plus;euclid_minus]; + REAL_ARITH_TAC; + TYPE_THEN `p` UNABBREV_TAC; + (* -- *) + USEH 877 (MATCH_MP polar_exist); + TYPE_THEN `q` UNABBREV_TAC; + TYPE_THEN `r'` EXISTS_TAC ; + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + UNDH 1925 THEN ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`2`;`&0 *# cis t`;`r' *# cis t`;`point p'`] metric_translate_LEFT; + REWRITE_TAC[polar_euclid]; + TYPE_THEN `point p' + &0 *# cis t = point p'` SUBAGOAL_TAC; + REWRITE_TAC[euclid_scale0;euclid_rzero]; + REWRH 5125; + REWRITE_TAC[d_euclid_eq_arg]; + UNDH 3665 THEN UNDH 1444 THEN REAL_ARITH_TAC; + (* -C *) + TYPE_THEN `unbounded_set E (point (FST p' + R,SND p'))` SUBAGOAL_TAC; + TYPE_THEN `SND p' = &0` ASM_CASES_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 8204 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC unbounded_set_trans_lemma; + TYPE_THEN `point (FST p' +R, &0)` EXISTS_TAC; + TYPE_THEN `point p'` EXISTS_TAC; + TYPE_THEN `r` EXISTS_TAC; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 8204 THEN REAL_ARITH_TAC; + TYPE_THEN `mk_segment (point (FST p' + R,&0)) (point(FST p' + R,SND p'))` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[point_inj;PAIR_SPLIT]; + UNDH 5038 THEN ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `&0 <= SND p'` ASM_CASES_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + THM_INTRO_TAC[`&0`;`SND p'`;`FST p' + R`;`u`]mk_segment_v; + REWRH 1093; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[closed_ball]; + THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction; + FULL_REWRITE_TAC[coord01]; + UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC; + (* -- *) + ONCE_REWRITE_TAC[mk_segment_sym]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + THM_INTRO_TAC[`SND p'`;`&0`;`FST p' + R`;`u`]mk_segment_v; + UNDH 2479 THEN REAL_ARITH_TAC; + REWRH 2966; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[closed_ball]; + THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction; + FULL_REWRITE_TAC[coord01]; + UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC; + (* -D *) + TYPE_THEN `theta= &0` ASM_CASES_TAC ; + REWRITE_TAC[cis;COS_0;SIN_0;point_scale]; + TYPE_THEN `point p' + point (R * &1, R* &0) = point (FST p' + R , SND p')` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_SYM; + ONCE_REWRITE_TAC[euclid_add_comm]; + REWRITE_TAC[euclid_cancel1]; + REWRITE_TAC[euclid_minus_scale;point_scale;point_add;point_inj;PAIR_SPLIT]; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + (* - *) + IMATCH_MP_TAC unbounded_set_trans_lemma; + TYPE_THEN `point (FST p' + R,SND p')` EXISTS_TAC; + TYPE_THEN `point p'` EXISTS_TAC; + TYPE_THEN `r` EXISTS_TAC; + THM_INTRO_TAC[`point p'`;`theta`;`R`] polar_curve_lemma; + UNDH 6412 THEN UNDH 8204 THEN UNDH 6162 THEN UNDH 4026 THEN REAL_ARITH_TAC; + TYPE_THEN `C` EXISTS_TAC; + (* - *) + CONJ_TAC; + TYPE_THEN `?u v. (p' = (u,v))` SUBAGOAL_TAC ; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `p'` UNABBREV_TAC; + FULL_REWRITE_TAC[point_add;REAL_ARITH `x + &0 = x`]; + (* - *) + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; + USEH 3064 (REWRITE_RULE[closed_ball]); + TSPECH `u` 5780; + TYPE_THEN `R` UNABBREV_TAC; + UNDH 8265 THEN UNDH 4705 THEN REAL_ARITH_TAC; + (* Fri Dec 31 12:28:22 EST 2004 *) + + ]);; + + (* }}} *) + +let unbounded_connect = prove_by_refinement( + `!E p q. FINITE E /\ E SUBSET edge /\ ~(p = q) /\ + unbounded_set E p /\ unbounded_set E q ==> + (?C. C SUBSET unbounded_set E /\ simple_arc_end C p q)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `(?r. !s. r <= s ==> (?C. simple_arc_end C p (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC; + ASM_MESON_TAC[unbounded_set_lemma]; + TYPE_THEN `(?r. !s. r <= s ==> (?C. simple_arc_end C q (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC; + ASM_MESON_TAC[unbounded_set_lemma]; + TYPE_THEN `r'' = max_real r r'` ABBREV_TAC ; + TSPECH `r''` 4812; + TSPECH `r''` 3171; + THM_INTRO_TAC[`r`;`r'`] max_real_le; + UNDH 4459 THEN DISCH_THEN (THM_INTRO_TAC[]); + UNDH 6887 THEN UNDH 2 THEN REAL_ARITH_TAC; + UNDH 5611 THEN DISCH_THEN (THM_INTRO_TAC[]); + UNDH 7318 THEN UNDH 2 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`C`;`C'`;`p`;`point(r'',&0)`;`q`] simple_arc_end_subset_trans; + IMATCH_MP_TAC simple_arc_end_symm; + TYPE_THEN `U` EXISTS_TAC; + (* - *) + THM_INTRO_TAC[`E`] unbounded_set_comp; + THM_INTRO_TAC[`E`;`x`] unbounded_set_comp_elt; + THM_INTRO_TAC[`E`;`x`;`p`] unbounded_comp_unique; + REWRITE_TAC[GSYM unbounded_set]; + IMATCH_MP_TAC rectagon_curve; + TYPE_THEN `q` EXISTS_TAC; + (* - *) + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + FULL_REWRITE_TAC[SUBSET;UNION]; + FULL_REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[]; + (* Fri Dec 31 16:38:36 EST 2004 *) + + ]);; + (* }}} *) + +let simple_arc_conn_complement = prove_by_refinement( + `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ + (euclid 2 p) /\ ~(p = q) /\ + (euclid 2 q) ==> (?A. simple_arc_end A p q /\ (C INTER A = EMPTY))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`C`;`p`;`q`] euclid_scale_simple_arc_ver2; + REP_BASIC_TAC; + ASM_MESON_TAC[]; + (* - *) + KILLH 907 THEN KILLH 877 THEN KILLH 7802 THEN KILLH 6497 THEN KILLH 9726 THEN KILLH 3550 THEN KILLH 11; + (* - simple-arc-grid-properties *) + TYPE_THEN `!i. (?E. (i <| N) ==> ( E SUBSET edge /\ (B i INTER (unbounded_set E) = EMPTY) /\ conn2 E /\ E (h_edge (floor (a i 0),floor (a i 1))) /\ E (h_edge (floor (a (SUC i) 0),floor (a (SUC i) 1))) /\ (!y. UNIONS (curve_cell E) y ==> (?x. B i x /\ d_euclid x y < &4))))` SUBAGOAL_TAC; + RIGHT_TAC "E"; + TSPECH `i` 4963; + USEH 9744 (MATCH_MP simple_arc_grid_properties); + TYPE_THEN `E` EXISTS_TAC; + LEFTH 3651 "E"; + (* - conn2-sequence *) + THM_INTRO_TAC[`E`;`N-1`] conn2_sequence; + (* -A *) + TYPE_THEN `!i. (i <=| N- 1) ==> (i <| N)` SUBAGOAL_TAC; + UNDH 7562 THEN UNDH 6077 THEN ARITH_TAC; + TYPE_THEN `(!i. i <=| N- 1 ==> conn2 (E i))` SUBAGOAL_TAC; + TSPECH `i` 2188; + UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRH 1437; + (* - *) + TYPE_THEN `!i. (i <= N-| 1) ==> (E i SUBSET edge)` SUBAGOAL_TAC; + TSPECH `i` 2188; + UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRH 456; + (* - *) + TYPE_THEN `(!i. (SUC i <= N -| 1) ==> ~(E i INTER E (SUC i) = {}))` SUBAGOAL_TAC; + UNDH 6943 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `h_edge (floor (a (SUC i) 0), floor (a (SUC i) 1))` EXISTS_TAC; + CONJ_TAC; + TSPECH `i` 2188; + UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); + UNDH 1989 THEN UNDH 7562 THEN ARITH_TAC; + TSPECH `SUC i` 2188; + UNDH 395 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRH 7915 ; + (* -B *) + TYPE_THEN `(!i j. i <| j /\ j <=| N -| 1 /\ ~(SUC i = j) ==> (curve_cell (E i) INTER curve_cell (E j) = {}))` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + USEH 2591 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC cell_nonempty ; ALL_TAC]; + THM_INTRO_TAC[`E i`] curve_cell_cell; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC; + ASM_MESON_TAC[subset_imp]; + USEH 1008 (REWRITE_RULE[EMPTY_EXISTS]); + (* -- *) + TYPE_THEN `euclid 2 u'` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `u` EXISTS_TAC; + IMATCH_MP_TAC cell_euclid; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `curve_cell (E j)` EXISTS_TAC; + IMATCH_MP_TAC curve_cell_cell; + (* -- *) + TYPE_THEN `(?x. B i x /\ d_euclid x u' < &4)` SUBAGOAL_TAC; + TSPECH `i` 2188; + UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]); + UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[UNIONS]; + UNIFY_EXISTS_TAC; + (* -- *) + TYPE_THEN `(?y. B j y /\ d_euclid y u' < &4)` SUBAGOAL_TAC; + TSPECH `j` 2188; + UNDH 7711 THEN DISCH_THEN (THM_INTRO_TAC[]); + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[UNIONS]; + UNIFY_EXISTS_TAC; + (* -- *) + UNDH 1512 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`x`;`y`]); + UNDH 5462 THEN UNDH 2236 THEN ARITH_TAC; + (* -- *) + TYPE_THEN `!k x. B k x /\ (k <| N) ==> euclid 2 x` SUBAGOAL_TAC; + UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`k`]); + USEH 120 (MATCH_MP simple_arc_end_simple); + USEH 6892 (MATCH_MP simple_arc_euclid); + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBAGOAL_TAC; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + TYPE_THEN `i` EXISTS_TAC; + UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC; + TYPE_THEN `j` EXISTS_TAC; + (* -- *) + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`u'`;`y`] metric_space_triangle; + TYPE_THEN `d_euclid x y <= &8` SUBAGOAL_TAC; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`y`;`u'`] metric_space_symm; + UNDH 8326 THEN UNDH 204 THEN UNDH 2611 THEN UNDH 2778 THEN REAL_ARITH_TAC; + UNDH 6749 THEN UNDH 4559 THEN UNDH 6444 THEN REAL_ARITH_TAC; + REWRH 6286; + (* -C *) + TYPE_THEN `E' = UNIONS (IMAGE E {i | i <=| N -| 1})` ABBREV_TAC ; + TYPE_THEN `E' SUBSET edge` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[IMAGE;UNIONS;SUBSET]; + TYPE_THEN `u` UNABBREV_TAC; + TSPECH `x'` 2188; + UNDH 1746 THEN DISCH_THEN (THM_INTRO_TAC[]); + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + (* - *) + TYPE_THEN `FINITE E'` SUBAGOAL_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + THM_INTRO_TAC[`IMAGE E {i | i <=| N -| 1}`] FINITE_FINITE_UNIONS; + IMATCH_MP_TAC FINITE_IMAGE; + REWRITE_TAC[FINITE_NUMSEG_LE]; + USEH 3282 (REWRITE_RULE[IMAGE]); + UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + FULL_REWRITE_TAC[conn2]; + (* - *) + TYPE_THEN `C' INTER unbounded_set E' = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + USEH 8327 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + USEH 3168 (REWRITE_RULE [UNIONS;IMAGE]); + TYPE_THEN `u'` UNABBREV_TAC; + TSPECH `x` 2188; + REP_BASIC_TAC; + USEH 2251 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPECH `u` 5859; + UNDH 5490 THEN ASM_REWRITE_TAC[]; + IMATCH_MP_TAC unbounded_avoidance_subset_ver2; + TYPE_THEN `E'` EXISTS_TAC; + TYPE_THEN `E'` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNIONS;IMAGE]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `x` EXISTS_TAC; + UNDH 5971 THEN ARITH_TAC; + (* -D *) + TYPE_THEN `unbounded_set E' p' /\ unbounded_set E' q'` ASM_CASES_TAC; + THM_INTRO_TAC[`E'`;`p'`;`q'`] unbounded_connect; + TSPECH `C` 7694; + USEH 8696 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + USEH 5828 (REWRITE_RULE[SUBSET]); + USEH 6174 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPECH `u` 5341; + TSPECH `u` 7291; + UNDH 362 THEN ASM_REWRITE_TAC[]; + (* -E *) + TYPE_THEN `N = 1` ASM_CASES_TAC; + TYPE_THEN `N` UNABBREV_TAC; + FULL_REWRITE_TAC[ARITH_RULE `i <| 1 <=> (i = 0)`]; + FULL_REWRITE_TAC[ARITH_RULE `i <= 1 -| 1 <=> (i = 0)`]; + TSPECH `0` 6703; + TYPE_THEN `0 = 0` SUBAGOAL_TAC; + TYPE_THEN `{i | i = 0} = {0}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRH 327; + REWRH 627; + FULL_REWRITE_TAC[image_sing]; + TYPE_THEN `E'` UNABBREV_TAC; + TYPE_THEN `C'` UNABBREV_TAC; + TSPECH `0` 4218; + UNDH 9174 THEN DISCH_THEN (THM_INTRO_TAC[]); + (* -- *) + UNDH 5439 THEN REWRITE_TAC[]; + TYPE_THEN `!p. (!x. B 0 x ==> &8 *d <= d_euclid x p) /\ (euclid 2 p) ==> unbounded_set (E 0) p` SUBAGOAL_TAC; + IMATCH_MP_TAC unbounded_set_ball; + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `&7* d` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + UNDH 5147 THEN REAL_ARITH_TAC; + (* --- *) + CONJ_TAC; + REWRITE_TAC[SUBSET;closed_ball]; + SUBCONJ_TAC; + TSPECH `0` 6993; + UNDH 9405 THEN DISCH_THEN (THM_INTRO_TAC[]); + USEH 4758 (MATCH_MP simple_arc_end_simple); + USEH 6872 (MATCH_MP simple_arc_euclid); + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B 0` EXISTS_TAC; + SUBCONJ_TAC; + USEH 6028 (REWRITE_RULE[UNIONS]); + IMATCH_MP_TAC subset_imp; + TYPE_THEN `u` EXISTS_TAC; + IMATCH_MP_TAC cell_euclid; + IMATCH_MP_TAC edge_cell; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `E 0` EXISTS_TAC; + (* ---- *) + UNDH 7489 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + IMATCH_MP_TAC subset_imp; + TYPE_THEN `UNIONS (E 0)` EXISTS_TAC; + IMATCH_MP_TAC UNIONS_UNIONS; + REWRITE_TAC[SUBSET]; + USEH 361 (REWRITE_RULE[SUBSET]); + ASM_SIMP_TAC[curve_cell_edge]; + USEH 5290 (REWRITE_RULE[SUBSET;open_ball]); + TSPECH `x''` 19; + REP_BASIC_TAC; + (* ---- *) + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`x''`;`x'`] metric_space_triangle; + TYPE_THEN `d_euclid x x' <= d + &4` SUBAGOAL_TAC; + UNDH 8092 THEN UNDH 8809 THEN UNDH 9378 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `d + &4` EXISTS_TAC; + UNDH 5147 THEN REAL_ARITH_TAC; + (* --- *) + USEH 129 (REWRITE_RULE[closed_ball]); + TSPECH `x` 7711; + UNDH 6465 THEN UNDH 5617 THEN UNDH 5147 THEN REAL_ARITH_TAC; + (* -- *) + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + (* -F *) + TYPE_THEN `0 <| N -| 1` SUBAGOAL_TAC; + UNDH 426 THEN UNDH 7562 THEN ARITH_TAC; + REWRH 532; + UNDH 7535 THEN REWRITE_TAC[]; + (* - *) + TYPE_THEN `!p. (euclid 2 p) /\ (!i. (SUC i <= (N-1)) ==> (&8 * d <= d_euclid (a (SUC i)) p)) ==> (unbounded_set E' p)` BACK_TAC; + TYPE_THEN `!i. (SUC i <= (N-1)) ==> C' (a (SUC i))` SUBAGOAL_TAC; + REWRITE_TAC[UNIONS;IMAGE]; + CONV_TAC (dropq_conv ("u")); + TYPE_THEN `i` EXISTS_TAC; + CONJ_TAC; + UNDH 1989 THEN ARITH_TAC; + TSPECH `i` 4963; + TYPE_THEN `i <| N` SUBAGOAL_TAC; + UNDH 1989 THEN ARITH_TAC; + USEH 9744 (MATCH_MP simple_arc_end_end2); + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN REP_BASIC_TAC THEN ASM_MESON_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 8137 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + KILLH 6656 THEN KILLH 1512 THEN KILLH 7562 THEN KILLH 6444 THEN KILLH 7694 THEN KILLH 9229 THEN KILLH 2174 THEN KILLH 9099 THEN KILLH 3258 THEN KILLH 6487; + COPYH 2188; + UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`i`]); + UNDH 1989 THEN ARITH_TAC; + UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]); + KILLH 5053 THEN KILLH 8136 THEN KILLH 5388 THEN KILLH 6737; + (* -G *) + IMATCH_MP_TAC unbounded_set_ball; + TYPE_THEN `a(SUC i)` EXISTS_TAC; + TYPE_THEN `&7 *d` EXISTS_TAC; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_MUL; + UNDH 5147 THEN REAL_ARITH_TAC; + (* - *) + CONJ_TAC; + REWRITE_TAC[ FINITE_UNION]; + FULL_REWRITE_TAC[conn2]; + REWRITE_TAC[union_subset]; + REWRITE_TAC[UNIONS_UNION;union_subset]; + (* - *) + IMATCH_MP_TAC (TAUT `a/\ b ==> b/\ a`); + CONJ_TAC; + USEH 9183 (REWRITE_RULE[closed_ball]); + UNDH 6641 THEN UNDH 3603 THEN UNDH 5147 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> euclid 2 x` SUBAGOAL_TAC; + UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); + USEH 9316 (MATCH_MP simple_arc_end_simple); + USEH 5604 (MATCH_MP simple_arc_euclid); + USEH 2996 (REWRITE_RULE[SUBSET]); + COPYH 3219; + TSPECH `i` 3219; + TSPECH `SUC i` 3219; + (* - *) + TYPE_THEN `(i <| N) /\ (SUC i <| N)` SUBAGOAL_TAC; + UNDH 1989 THEN ARITH_TAC; + REWRH 6689; + REWRH 5459; + (* - *) + TYPE_THEN `B i (a(SUC i))` SUBAGOAL_TAC; + TSPECH `i` 4963; + USEH 9744 (MATCH_MP simple_arc_end_end2); + (* - *) + TYPE_THEN `B (SUC i) (a (SUC i))` SUBAGOAL_TAC; + TSPECH `SUC i` 4963; + USEH 9147 (MATCH_MP simple_arc_end_end); + (* - *) + REWRITE_TAC[SUBSET;closed_ball]; + TYPE_THEN `euclid 2 (a(SUC i))` SUBAGOAL_TAC; + (* - *) + TYPE_THEN `!i x y. (i <| N) /\ B i x /\ B i y /\ (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid x y < &2 *d)` SUBAGOAL_TAC; + IMATCH_MP_TAC BALL_DIST; + TYPE_THEN `euclid 2` EXISTS_TAC; + UNDH 4673 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]); + TYPE_THEN `x'` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B i'` EXISTS_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B i'` EXISTS_TAC; + (* - *) + KILLH 3302 THEN KILLH 6317 THEN KILLH 4963 THEN KILLH 4847; + KILLH 4673 THEN KILLH 3226 THEN KILLH 9755 THEN KILLH 8762 THEN KILLH 6174; + KILLH 7802 THEN KILLH 3603 THEN KILLH 5957; + (* - *) + TYPE_THEN `(!x. (euclid 2 x) /\ (?y. (euclid 2 y) /\ (d_euclid y x < &4) /\ (d_euclid (a (SUC i)) y < &2 * d)) ==> (d_euclid (a (SUC i)) x <= &7 *d))` SUBAGOAL_TAC; + THM_INTRO_TAC[`euclid 2`;`d_euclid`;`a(SUC i)`;`y`;`x`] metric_space_triangle; + UNDH 8917 THEN UNDH 3588 THEN UNDH 1391 THEN UNDH 5147 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `!G x. G SUBSET edge /\ UNIONS G x ==> (euclid 2 x /\ UNIONS (curve_cell G) x)` SUBAGOAL_TAC; + USEH 6599 (REWRITE_RULE[UNIONS]); + TYPE_THEN `edge u` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `G` EXISTS_TAC; + CONJ_TAC; + USEH 9350 (MATCH_MP edge_euclid2); + IMATCH_MP_TAC subset_imp; + TYPE_THEN `u` EXISTS_TAC; + REWRITE_TAC[UNIONS]; + TYPE_THEN `u` EXISTS_TAC; + ASM_SIMP_TAC[curve_cell_edge]; + (* -H *) + CONJ_TAC; + UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E i`;`x`]); + UNDH 404 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + (* - *) + UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E (SUC i)`;`x`]); + UNDH 9352 THEN DISCH_THEN (THM_INTRO_TAC[`x`]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `x'` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `SUC i` EXISTS_TAC; + (* Sat Jan 1 19:23:34 EST 2005 *) + + ]);; + (* }}} *) + +let cut_arc = + jordan_def `cut_arc C v w = @B. simple_arc_end B v w /\ B SUBSET C`;; + +let cut_arc_symm = prove_by_refinement( + `!C v w. cut_arc C v w = cut_arc C w v`, + (* {{{ proof *) + [ + REWRITE_TAC[cut_arc]; + TYPE_THEN `!B. simple_arc_end B v w = simple_arc_end B w v` SUBAGOAL_TAC; + MESON_TAC[simple_arc_end_symm]; + ]);; + (* }}} *) + +let cut_arc_simple = prove_by_refinement( + `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==> + simple_arc_end (cut_arc C v w) v w`, + (* {{{ proof *) + [ + REWRITE_TAC[cut_arc]; + SELECT_TAC; + ASM_MESON_TAC[simple_arc_end_select]; + ]);; + (* }}} *) + +let cut_arc_subset = prove_by_refinement( + `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==> + cut_arc C v w SUBSET C`, + (* {{{ proof *) + [ + REWRITE_TAC[cut_arc]; + SELECT_TAC; + ASM_MESON_TAC[simple_arc_end_select]; + ]);; + (* }}} *) + +let cut_arc_unique = prove_by_refinement( + `!C v w B. simple_arc top2 C /\ (B SUBSET C) /\ simple_arc_end B v w + ==> (cut_arc C v w = B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `w` EXISTS_TAC; + TYPE_THEN `~(v = w)` SUBAGOAL_TAC THENL[ (IMATCH_MP_TAC simple_arc_end_distinct);ALL_TAC]; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `C v` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_end; + TYPE_THEN `w` EXISTS_TAC; + TYPE_THEN `C w` SUBAGOAL_TAC ; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_end2; + UNIFY_EXISTS_TAC; + ASM_MESON_TAC [cut_arc_subset;cut_arc_simple]; + ]);; + (* }}} *) + +let cut_arc_inter = prove_by_refinement( + `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==> + (cut_arc C v u INTER cut_arc C u w = {u}) /\ + (cut_arc C v u UNION cut_arc C u w = C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`v`;`w`;`u`] simple_arc_end_cut; + TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; + USEH 8829 (MATCH_MP simple_arc_end_simple); + TYPE_THEN `cut_arc C v u = C'` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_unique; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `cut_arc C u w = C''` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_unique; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + ASM_REWRITE_TAC[]; + (* Sat Jan 1 19:57:51 EST 2005 *) + + ]);; + (* }}} *) + +let simple_closed_curve_euclid = prove_by_refinement( + `!C . simple_closed_curve top2 C ==> (C SUBSET euclid 2) `, + (* {{{ proof *) + [ + REWRITE_TAC[simple_closed_curve]; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `!u. &0 <= u /\ u < &1 ==> euclid 2 (f u)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INJ;top2_unions]; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 5825 SYM ; + TYPE_THEN `x' = &1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC; + ]);; + (* }}} *) + +let open_real_interval = prove_by_refinement( + `!a b. top_of_metric (UNIV,d_real) {x | a < x /\ x < b}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`b`] half_open; + THM_INTRO_TAC[`a`] half_open_above; + TYPE_THEN `{x | a < x /\ x < b} = {x | a < x} INTER {x | x < b}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER]; + IMATCH_MP_TAC top_inter; + IMATCH_MP_TAC top_of_metric_top; + REWRITE_TAC[metric_real]; + ]);; + (* }}} *) + +let simple_closed_curve_cut_unique = prove_by_refinement( + `!A A' A'' C v w. simple_closed_curve top2 C /\ + simple_arc_end A v w /\ + simple_arc_end A' v w /\ + simple_arc_end A'' v w /\ + ~(A' = A'') /\ + (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==> + (A = A') \/ (A = A'')`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `A'` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_end; + TYPE_THEN`w` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `A'` EXISTS_TAC; + REWRITE_TAC[SUBSET_UNION]; + IMATCH_MP_TAC simple_arc_end_end2; + TYPE_THEN `v` EXISTS_TAC; + USEH 4051 (MATCH_MP simple_arc_end_distinct); + UNDH 1472 THEN ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`C`;`v`] simple_closed_curve_pt; + TYPE_THEN `?t. (&0 < t /\ t < &1 /\ (f t = w))` SUBAGOAL_TAC ; + (* KILLH 9405; *) + TYPE_THEN `C` UNABBREV_TAC ; + FULL_REWRITE_TAC[IMAGE]; + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `x = &0` ASM_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `x = &1` ASM_CASES_TAC; + ASM_MESON_TAC[]; + UNDH 3483 THEN UNDH 9557 THEN UNDH 953 THEN UNDH 8032 THEN REAL_ARITH_TAC; + TYPE_THEN `w` UNABBREV_TAC; + TYPE_THEN `v` UNABBREV_TAC; + (* -A *) + (* USEH 9405 SYM; // *) + FULL_REWRITE_TAC[top2_unions]; + TYPE_THEN `simple_arc_end (IMAGE f {x | &0 <= x /\ x <= t}) (f (&0)) (f t)` SUBAGOAL_TAC; + USEH 5825 SYM; + IMATCH_MP_TAC simple_arc_segment; + UNDH 6523 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `simple_arc_end (IMAGE f {x | t <= x /\ x <= &1}) (f t) (f (&1))` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_segment; + UNDH 2449 THEN REAL_ARITH_TAC; + USEH 5825 SYM; + REWRH 3167; + (* - *) + TYPE_THEN `!q. {x | q <= x /\ x <= q} = {q}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REAL_ARITH_TAC; + (* - *) + TYPE_THEN `!x. &0 <= x /\ x <= &1 ==> euclid 2 (f x)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + USEH 5674 SYM; + IMATCH_MP_TAC simple_closed_curve_euclid; + (* - *) + TYPE_THEN `! r s. &0 <= r /\ s <= &1 /\ r < s ==> (?U. top2 U /\ (IMAGE f {x | r < x /\ x < s} = U INTER C))` SUBAGOAL_TAC; + TYPE_THEN `closed_ top2 (IMAGE f {x | &0 <= x /\ x <= r})` SUBAGOAL_TAC; + TYPE_THEN `r = &0` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[image_sing]; + IMATCH_MP_TAC closed_point; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_closed; + TYPE_THEN `f( &0)` EXISTS_TAC; + TYPE_THEN `f (r)` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_segment; + UNDH 5145 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC; + TYPE_THEN `closed_ top2 (IMAGE f {x | s <= x /\ x <= &1})` SUBAGOAL_TAC; + TYPE_THEN `s = &1` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[image_sing]; + IMATCH_MP_TAC closed_point; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_closed; + TYPE_THEN `f(s)` EXISTS_TAC; + USEH 1826 SYM; + TYPE_THEN `f (&1)` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_segment; + UNDH 2144 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC; + TYPE_THEN `closed_ top2 ((IMAGE f {x | &0 <= x /\ x <= r}) UNION (IMAGE f {x | s <= x /\ x <= &1}))` SUBAGOAL_TAC; + IMATCH_MP_TAC closed_union; + REWRITE_TAC[top2_top]; + USEH 9076 (MATCH_MP closed_open); + FULL_REWRITE_TAC[open_DEF;top2_unions ]; + TYPE_THEN `(euclid 2 DIFF (IMAGE f {x | &0 <= x /\ x <= r} UNION IMAGE f {x | s <= x /\ x <= &1}))` EXISTS_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IMAGE;DIFF;UNION;INTER]; + NAME_CONFLICT_TAC; + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + TYPE_THEN `x` UNABBREV_TAC; + REWRITE_TAC[DE_MORGAN_THM;CONJ_ACI]; + TYPE_THEN `&0 <= x' /\ x' <= &1` SUBAGOAL_TAC; + UNDH 507 THEN UNDH 3413 THEN UNDH 1908 THEN UNDH 147 THEN REAL_ARITH_TAC; + CONJ_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + CONJ_TAC; + USEH 2422 (REWRITE_RULE[INJ]); + TYPE_THEN `x'' = &1` ASM_CASES_TAC; + TYPE_THEN `x' = &0` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UNDH 507 THEN UNDH 1908 THEN REAL_ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + UNDH 8462 THEN UNDH 147 THEN REAL_ARITH_TAC; + TYPE_THEN `x' = x''` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 5595 THEN UNDH 8732 THEN UNDH 9674 THEN UNDH 507 THEN UNDH 9329 THEN UNDH 1908 THEN REAL_ARITH_TAC ; + TYPE_THEN `x''` UNABBREV_TAC; + UNDH 507 THEN UNDH 1162 THEN REAL_ARITH_TAC; + (* --- *) + TYPE_THEN `x' = x''` SUBAGOAL_TAC; + USEH 2422 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 8691 THEN UNDH 7080 THEN UNDH 1908 THEN UNDH 507 THEN REAL_ARITH_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + UNDH 3283 THEN UNDH 3413 THEN REAL_ARITH_TAC; + (* -- *) + FULL_REWRITE_TAC[DE_MORGAN_THM]; + TYPE_THEN `x'` EXISTS_TAC; + LEFTH 7656 "x'"; + TSPECH `x'` 4068; + TYPE_THEN `x` UNABBREV_TAC; + LEFTH 5373 "x''"; + TSPECH `x'` 1785; + UNDH 1589 THEN UNDH 4223 THEN REWRITE_TAC[] THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC; + (* -B *) + COPYH 7922; + UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`t`]); + UNDH 6523 THEN REAL_ARITH_TAC; + UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`t`;`&1`]); + UNDH 2449 THEN REAL_ARITH_TAC; + (* - *) + USEH 5674 SYM; + TYPE_THEN `U INTER U' INTER C = EMPTY` SUBAGOAL_TAC; + TYPE_THEN `U INTER U' INTER C = (U INTER C) INTER (U' INTER C)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER] THEN MESON_TAC[]; + TYPE_THEN `U INTER C` UNABBREV_TAC; + TYPE_THEN `U' INTER C` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + USEH 6182 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]); + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `x = x'` SUBAGOAL_TAC; + USEH 2422 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 4410 THEN UNDH 8119 THEN UNDH 6523 THEN UNDH 5777 THEN UNDH 2449 THEN REAL_ARITH_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + UNDH 4480 THEN UNDH 8119 THEN REAL_ARITH_TAC; + (* -C *) + TYPE_THEN `UNIONS (top_of_metric (UNIV,d_real)) = UNIV` SUBAGOAL_TAC; + IMATCH_MP_TAC (GSYM top_of_metric_unions); + REWRITE_TAC[metric_real]; + THM_INTRO_TAC[`&0`;`&1`] connect_real_open; + THM_INTRO_TAC[`&0`;`&1`] open_real_interval; + TYPE_THEN `!B. simple_arc_end B (f (&0)) (f t) /\ B SUBSET C ==> (B = IMAGE f {x | &0 <= x /\ x <= t}) \/ (B = IMAGE f {x | t <= x /\ x <= &1})` SUBAGOAL_TAC; + COPYH 3089; + USEH 3089 (REWRITE_RULE[simple_arc_end]); + USEH 3272 (REWRITE_RULE[continuous;preimage]); + REWRH 1293; + TYPE_THEN `!v. top2 v ==> top_of_metric(UNIV,d_real) {x | &0 < x /\ x < &1 /\ v (f' x)}` SUBAGOAL_TAC; + TYPE_THEN `{x | &0 < x /\ x < &1 /\ v' (f' x)} = {x | &0 < x /\ x < &1 } INTER {x | v' (f' x)}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER]; + MESON_TAC[]; + IMATCH_MP_TAC top_inter; + IMATCH_MP_TAC top_of_metric_top; + REWRITE_TAC[metric_real]; + COPYH 7847; + TSPECH `U` 7847; + TSPECH `U'`7847; + FULL_REWRITE_TAC[connected]; + UNDH 868 THEN DISCH_THEN (THM_INTRO_TAC[`{x | &0 < x /\ x < &1 /\ U (f' x)}`;`{x | &0 < x /\ x < &1 /\ U' (f' x)}`]); + CONJ_TAC; + PROOF_BY_CONTR_TAC; + USEH 228 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + TYPE_THEN `C (f' u)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC image_imp; + UNDH 5411 THEN UNDH 7814 THEN REAL_ARITH_TAC; + USEH 161 (REWRITE_RULE[INTER;EQ_EMPTY]); + TSPECH `f' u` 3418; + UNDH 1284 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;UNION]; + TYPE_THEN `C (f' x)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC image_imp; + UNDH 4410 THEN UNDH 2236 THEN REAL_ARITH_TAC ; + USEH 3773 SYM; + REWRH 5090; + USEH 8548 (REWRITE_RULE[IMAGE]); + TYPE_THEN `~(x' = &0)` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `f(&0)` UNABBREV_TAC; + TYPE_THEN `f(&1)` UNABBREV_TAC; + TYPE_THEN `x = &0` SUBAGOAL_TAC; + USEH 5798 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + UNDH 869 THEN REAL_ARITH_TAC; + TYPE_THEN `~(x' = &1)` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `f(&0)` UNABBREV_TAC; + TYPE_THEN `f(&1)` UNABBREV_TAC; + TYPE_THEN `x = &0` SUBAGOAL_TAC; + USEH 5798 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + UNDH 869 THEN REAL_ARITH_TAC; + TYPE_THEN `~(x' = t)` SUBAGOAL_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `f(&0)` UNABBREV_TAC; + TYPE_THEN `f(&1)` UNABBREV_TAC; + TYPE_THEN `f t` UNABBREV_TAC; + TYPE_THEN `x = &1` SUBAGOAL_TAC; + USEH 5798 (REWRITE_RULE[INJ]); + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + UNDH 6586 THEN REAL_ARITH_TAC; + (* --- *) + TYPE_THEN `x' < t` ASM_CASES_TAC; + DISJ1_TAC; + USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `f x'` 4001; + USEH 4175 (REWRITE_RULE[INTER]); + USEH 4860 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`)); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + UNDH 2455 THEN UNDH 9329 THEN REAL_ARITH_TAC; + DISJ2_TAC; + USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `f x'` 7907; + USEH 1343 (REWRITE_RULE[INTER]); + USEH 5291 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`)); + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + UNDH 9585 THEN UNDH 7068 THEN UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC; + (* --D *) + FIRST_ASSUM DISJ_CASES_TAC; + DISJ1_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC; + TYPE_THEN `f (&0)` EXISTS_TAC; + TYPE_THEN `f (t)` EXISTS_TAC; + CONJ_TAC; + TYPE_THEN `B` UNABBREV_TAC; + CONJ_TAC; + USEH 4679 (MATCH_MP simple_arc_end_simple); + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;IMAGE]; + (* --- *) + TYPE_THEN `x' = &0` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + UNDH 2449 THEN REAL_ARITH_TAC; + TYPE_THEN `x' = &1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `t` EXISTS_TAC; + UNDH 2449 THEN REAL_ARITH_TAC; + USEH 8833 (REWRITE_RULE[SUBSET]); + UNDH 5386 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + UNDH 6268 THEN UNDH 2455 THEN UNDH 9329 THEN UNDH 3324 THEN REAL_ARITH_TAC; + TYPE_THEN `C (f' x')` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC image_imp; +(*** Removed by JRH --- not quite sure why this changed + UNDH 7473 THEN UNDH 5707 THEN UNDH 6268 THEN UNDH 2455 THEN REAL_ARITH_TAC; + ***) + USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `(f' x')` 4001; + USEH 3320 (REWRITE_RULE[INTER;IMAGE]); + REWRH 7476; + TYPE_THEN `x''` EXISTS_TAC; + UNDH 4332 THEN UNDH 4962 THEN REAL_ARITH_TAC; + (* --E *) + DISJ2_TAC; + IMATCH_MP_TAC simple_arc_end_inj; + TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC; + TYPE_THEN `f t` EXISTS_TAC; + TYPE_THEN `f (&1)` EXISTS_TAC; + USEH 1826 SYM; + CONJ_TAC; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_MESON_TAC[]; + CONJ_TAC; + USEH 9241 (MATCH_MP simple_arc_end_simple); + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[SUBSET;IMAGE]; + (* --- *) + TYPE_THEN `x' = &0` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `&1` EXISTS_TAC; + UNDH 6523 THEN REAL_ARITH_TAC; + TYPE_THEN `x' = &1` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `t` EXISTS_TAC; + UNDH 6523 THEN REAL_ARITH_TAC; + TYPE_THEN `&0 < x' /\ x' < &1` SUBAGOAL_TAC; + UNDH 9329 THEN UNDH 2455 THEN UNDH 3324 THEN UNDH 6268 THEN REAL_ARITH_TAC; + USEH 1419 (REWRITE_RULE[SUBSET]); + UNDH 7111 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]); + TYPE_THEN `C (f' x')` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `B` EXISTS_TAC; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `(f' x')` 7907; + USEH 1445 (REWRITE_RULE[INTER;IMAGE]); + REWRH 6223; + TYPE_THEN `x''` EXISTS_TAC; + UNDH 4402 THEN UNDH 8966 THEN REAL_ARITH_TAC; + (* -F *) + TYPE_THEN `X = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ; + TYPE_THEN `Y = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ; + TYPE_THEN `a = f(&0)` ABBREV_TAC ; + TYPE_THEN `b = f t` ABBREV_TAC ; + TYPE_THEN `f t` UNABBREV_TAC; + TYPE_THEN `f (&0)` UNABBREV_TAC; + TYPE_THEN `f (&1)` UNABBREV_TAC; + UNDH 7556 THEN UNDH 7601 THEN UNDH 9279 THEN UNDH 3395 THEN UNDH 1702 THEN UNDH 2817 THEN UNDH 7605 THEN UNDH 1063 THEN POP_ASSUM_LIST (fun t-> ALL_TAC); + TYPE_THEN `(A = X) \/ (A = Y)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(A' = X) \/ (A' = Y)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `(A'' = X) \/ (A'' = Y)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + FIRST_ASSUM DISJ_CASES_TAC THEN FIRST_ASSUM DISJ_CASES_TAC THEN ASM_MESON_TAC[]; + (* Sun Jan 2 11:55:31 EST 2005 *) + + ]);; + (* }}} *) + +let infinite_closed_interval = prove_by_refinement( + `!a b. a < b ==> INFINITE {x | a <= x /\ x <= b}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?r s. a < r /\ r < s /\ s < b` SUBAGOAL_TAC; + TYPE_THEN `(&2*a + b)/ &3` EXISTS_TAC; + TYPE_THEN `(a + &2*b)/ &3` EXISTS_TAC; + ASSUME_TAC (REAL_ARITH `&0 < &3 /\ ~(&3 = &0)`); + ASM_SIMP_TAC[REAL_LT_RDIV_EQ;REAL_LT_LDIV_EQ;REAL_DIV_RMUL]; + UNDH 4394 THEN REAL_ARITH_TAC; + IMATCH_MP_TAC infinite_subset; + TYPE_THEN `{x | r < x /\ x < s}` EXISTS_TAC ; + CONJ_TAC; + ASM_SIMP_TAC[infinite_interval]; + REWRITE_TAC[SUBSET]; + UNDH 2351 THEN UNDH 2116 THEN UNDH 5157 THEN UNDH 4011 THEN REAL_ARITH_TAC; + (* Sun Jan 2 12:21:29 EST 2005 *) + + ]);; + (* }}} *) + +let infinite_image = prove_by_refinement( + `!(f:A->B) X. INFINITE X /\ INJ f X UNIV ==> INFINITE (IMAGE f X)`, + (* {{{ proof *) + [ + REWRITE_TAC[INJ;INFINITE]; + THM_INTRO_TAC[`f`;`IMAGE f X`;`X`] FINITE_IMAGE_INJ_GENERAL; + ASM_REWRITE_TAC[]; + UNDH 3229 THEN REWRITE_TAC[]; + TYPE_THEN `{x | x IN X /\ f x IN IMAGE f X} = X` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + ASM_MESON_TAC[image_imp]; + REWRH 2588; + ]);; + (* }}} *) + +let simple_arc_infinite = prove_by_refinement( + `!C. simple_arc top2 C ==> INFINITE C`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc]; + IMATCH_MP_TAC infinite_image; + CONJ_TAC; + IMATCH_MP_TAC infinite_closed_interval; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ]);; + (* }}} *) + +let simple_closed_curve_cut_unique_inter = prove_by_refinement( + `!A A' A'' C v w. simple_closed_curve top2 C /\ + simple_arc_end A v w /\ + simple_arc_end A' v w /\ + simple_arc_end A'' v w /\ + (A' INTER A'' = {v,w}) /\ + (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==> + (A = A') \/ (A = A'')`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC simple_closed_curve_cut_unique; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `w` EXISTS_TAC; + DISCH_TAC; + TYPE_THEN `A''` UNABBREV_TAC; + FULL_REWRITE_TAC [INTER_ACI]; + TYPE_THEN `A'` UNABBREV_TAC; + USEH 2648 (MATCH_MP simple_arc_end_simple); + USEH 9214 (MATCH_MP simple_arc_infinite); + FULL_REWRITE_TAC[INFINITE]; + UNDH 8436 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; + (* Sun Jan 2 12:47:35 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_access = prove_by_refinement( + `!A C v w x p. simple_closed_curve top2 C /\ + simple_arc_end A v w /\ + A SUBSET C /\ + A x /\ ~(x = v) /\ ~(x = w) /\ + (euclid 2 p) /\ + ~C p /\ + (?q. ~( p = q) /\ ~(C q) /\ (euclid 2 q) /\ + (!B. simple_arc_end B p q ==> ~(B INTER C = EMPTY))) ==> + (?E. + simple_arc_end E p x /\ + E INTER C SUBSET A /\ + (!e. E e /\ ~C e /\ ~(p = e) ==> (cut_arc E p e INTER C = EMPTY)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `A` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_end; + TYPE_THEN`w` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `A` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_end2; + TYPE_THEN `v` EXISTS_TAC; + USEH 9236 (MATCH_MP simple_arc_end_distinct); + UNDH 1472 THEN ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`C`;`v`;`w`] simple_closed_cut; + (* - *) + TYPE_THEN `?B. (A UNION B = C) /\ (A INTER B = {v,w}) /\ (simple_arc_end B v w)` SUBAGOAL_TAC; + THM_INTRO_TAC[`A`;`C'`;`C''`;`C`;`v`;`w`] simple_closed_curve_cut_unique_inter; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + (* -- *) + FIRST_ASSUM DISJ_CASES_TAC ; + TYPE_THEN `C'` UNABBREV_TAC; + TYPE_THEN `C''` EXISTS_TAC; + TYPE_THEN `C''` UNABBREV_TAC; + TYPE_THEN `C'` EXISTS_TAC; + FULL_REWRITE_TAC[INTER_ACI;UNION_ACI]; + KILLH 6724 THEN KILLH 906 THEN KILLH 4244 THEN KILLH 3747; + (* -A *) + THM_INTRO_TAC[`B`;`p`;`q`] simple_arc_conn_complement; + USEH 2164 (MATCH_MP simple_arc_end_simple); + TYPE_THEN `B SUBSET C` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION]; + ASM_MESON_TAC[subset_imp]; + (* - *) + THM_INTRO_TAC[`A'`;`{p}`;`A`] simple_arc_end_restriction; + CONJ_TAC; + USEH 384 (MATCH_MP simple_arc_end_simple); + CONJ_TAC; + USEH 384 (MATCH_MP simple_arc_end_end_closed); + CONJ_TAC; + USEH 9236 (MATCH_MP simple_arc_end_closed); + CONJ_TAC; + REWRITE_TAC[EQ_EMPTY]; + FULL_REWRITE_TAC[INTER;INR IN_SING]; + TYPE_THEN `x'` UNABBREV_TAC; + ASM_MESON_TAC[subset_imp]; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + CONJ_TAC; + CONV_TAC (dropq_conv "u"); + USEH 384 (MATCH_MP simple_arc_end_end); + TSPECH `A'` 1640; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `u` EXISTS_TAC; + TYPE_THEN `C` UNABBREV_TAC; + FULL_REWRITE_TAC[UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `v' = p` SUBAGOAL_TAC; + USEH 6335 (REWRITE_RULE[INR eq_sing;INTER;INR IN_SING ]); + TYPE_THEN `v'` UNABBREV_TAC; + (* -B *) + TYPE_THEN `x = v''` ASM_CASES_TAC ; + TYPE_THEN `v''` UNABBREV_TAC; + TYPE_THEN `C'` EXISTS_TAC; + SUBCONJ_TAC; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[INTER;UNION;SUBSET]; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[INTER;EQ_EMPTY;SUBSET ]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `~(e = x)` SUBAGOAL_TAC; + TYPE_THEN `e` UNABBREV_TAC; + UNDH 3668 THEN REWRITE_TAC[] ; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `A` EXISTS_TAC; + THM_INTRO_TAC[`C'`;`e`;`p`;`x`] cut_arc_inter; + (* -- *) + PROOF_BY_CONTR_TAC; + THM_INTRO_TAC[`C'`;`p`;`e`] cut_arc_subset; + CONJ_TAC; + USEH 8530 (MATCH_MP simple_arc_end_simple); + USEH 8530 (MATCH_MP simple_arc_end_end); + FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; + FULL_REWRITE_TAC[SUBSET;INR eq_sing ;INR IN_SING;]; + THM_INTRO_TAC[`C'`;`e`;`x`] cut_arc_simple; + USEH 8530 (MATCH_MP simple_arc_end_simple); + USEH 5502 (MATCH_MP simple_arc_end_end2); + ASM_MESON_TAC[]; + (* -C *) + TYPE_THEN `cutvx = cut_arc A v'' x` ABBREV_TAC ; + TYPE_THEN `E = C' UNION cutvx` ABBREV_TAC ; + TYPE_THEN `E` EXISTS_TAC; + (* - *) + TYPE_THEN `simple_arc top2 A` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `A v'' ` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INTER;INR eq_sing; INR IN_SING]; + THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_simple; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC ; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `v''` EXISTS_TAC; + TYPE_THEN `cutvx` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + USEH 6508 SYM; + REWRITE_TAC[INTER;SUBSET]; + THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + REWRITE_TAC[SUBSET;INTER;INR IN_SING]; + FULL_REWRITE_TAC[INTER;INR IN_SING;INR eq_sing]; + USEH 4778 (MATCH_MP simple_arc_end_end); + (* -D *) + SUBCONJ_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `cutvx` UNABBREV_TAC; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[SUBSET;INTER;UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + KILLH 4866; + FIRST_ASSUM DISJ_CASES_TAC; + FULL_REWRITE_TAC[SUBSET;EQ_EMPTY;INTER;]; + ASM_MESON_TAC[]; + THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset; + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + (* -E *) + TYPE_THEN `simple_arc top2 E` SUBAGOAL_TAC; + USEH 9538 (MATCH_MP simple_arc_end_simple); + TYPE_THEN `C' p /\ C' e` SUBAGOAL_TAC; + CONJ_TAC; + FULL_REWRITE_TAC[INTER;INR eq_sing;INR IN_SING]; + TYPE_THEN `E` UNABBREV_TAC; + USEH 3684 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `cutvx SUBSET C` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `cutvx` UNABBREV_TAC; + IMATCH_MP_TAC cut_arc_subset; + ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `cut_arc E p e = cut_arc C' p e` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_unique; + TYPE_THEN `E` UNABBREV_TAC; + CONJ_TAC; + TYPE_THEN `cut_arc C' p e SUBSET C'` BACK_TAC; + UNDH 7958 THEN REWRITE_TAC[SUBSET;UNION]; + IMATCH_MP_TAC cut_arc_subset; + USEH 2528 (MATCH_MP simple_arc_end_simple); + IMATCH_MP_TAC cut_arc_simple; + USEH 2528 (MATCH_MP simple_arc_end_simple); + (* - *) + TYPE_THEN `~(e = v'')` SUBAGOAL_TAC; + UNDH 5697 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[UNION]; + THM_INTRO_TAC[`C'`;`e`;`p`;`v''`] cut_arc_inter; + (* - *) + TYPE_THEN `C' INTER C = {v''}` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + REWRITE_TAC[eq_sing;INR IN_SING ;INTER;UNION;]; + USEH 2528 (MATCH_MP simple_arc_end_end2); + REP_BASIC_TAC; + FIRST_ASSUM DISJ_CASES_TAC ; + USEH 6508 (REWRITE_RULE[INTER;INR eq_sing;INR IN_SING]); + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 7813 (REWRITE_RULE[SUBSET]); + USEH 4523 (REWRITE_RULE[EQ_EMPTY;INTER;]); + ASM_MESON_TAC[]; + (* -F *) + TYPE_THEN `C' v''` SUBAGOAL_TAC; + USEH 2528 (MATCH_MP simple_arc_end_end2); + TYPE_THEN `~cut_arc C' p e v''` SUBAGOAL_TAC; + USEH 8060 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + UNDH 2267 THEN DISCH_THEN (THM_INTRO_TAC[`v''`]); + THM_INTRO_TAC[`C'`;`e`;`v''`] cut_arc_simple; + USEH 2528 (MATCH_MP simple_arc_end_simple); + USEH 1175 (MATCH_MP simple_arc_end_end2); + UNDH 1069 THEN ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USEH 7182 (REWRITE_RULE [EMPTY_EXISTS;INTER]); + USEH 3774 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + TYPE_THEN `u = v''` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `cut_arc C' p e SUBSET C'` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_subset; + USEH 2528 (MATCH_MP simple_arc_end_simple); + IMATCH_MP_TAC subset_imp; + UNIFY_EXISTS_TAC; + TYPE_THEN `u` UNABBREV_TAC; + UNDH 9484 THEN ASM_REWRITE_TAC[]; + (* Sun Jan 2 14:55:11 EST 2005 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION BB *) +(* ------------------------------------------------------------------ *) + + +(* show that a Jordan curve has no more than 2 components *) + +let jordan_curve_seg3 = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> + (?s. (!(i:three_t). (s i SUBSET C) /\ (simple_arc top2 (s i))) /\ + (!i j. ~(s i INTER s j = EMPTY) ==> (i = j)))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_closed_curve]; + TYPE_THEN `s = (\ i. IMAGE f {x | ((&2 * &(REP3 i) + &1)/ &8) <= x /\ x <= ((&2 * &(REP3 i) + &2)/ &8) } )` ABBREV_TAC ; + TYPE_THEN `s` EXISTS_TAC; + (* - *) + TYPE_THEN `&0 < &8 /\ ~(&8 = &0)` SUBAGOAL_TAC; + REAL_ARITH_TAC; + TYPE_THEN `!i. &0 <= (&2 * &(REP3 i) + &1) / &8` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LE_DIV; + REDUCE_TAC; + TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / &8 <= &1` SUBAGOAL_TAC; + ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + REDUCE_TAC; + THM_INTRO_TAC[`i`] rep3_lt; + UNDH 1618 THEN ARITH_TAC; + (* - *) + CONJ_TAC; + CONJ_TAC; + TYPE_THEN `s` UNABBREV_TAC; + REWRITE_TAC[SUBSET;IMAGE]; + TYPE_THEN `x'` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + UNIFY_EXISTS_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + UNIFY_EXISTS_TAC; + (* -- *) + TYPE_THEN `s` UNABBREV_TAC ; + THM_INTRO_TAC[`f`;`(&2 * &(REP3 i) + &1) / &8 `;`(&2 * &(REP3 i) + &2) / &8`] simple_arc_segment; + FULL_REWRITE_TAC[top2_unions]; + CONJ_TAC; + ASM_SIMP_TAC[real_div_denom_lt]; + REDUCE_TAC; + ARITH_TAC; + DISJ1_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + REDUCE_TAC; + ARITH_TAC; + USEH 6148 (MATCH_MP simple_arc_end_simple); + (* -A *) + TYPE_THEN `!i j. (REP3 i < REP3 j) ==> (s i INTER s j = EMPTY)` BACK_TAC ; + TYPE_THEN `(REP3 i = REP3 j) \/ (REP3 j <| REP3 i) \/ (REP3 i < REP3 j)` SUBAGOAL_TAC; + ARITH_TAC; + UNDH 2249 THEN REP_CASES_TAC; + REWRITE_TAC[three_t_eq]; + UNDH 6857 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]); + FULL_REWRITE_TAC[INTER_COMM]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* - *) + PROOF_BY_CONTR_TAC; + KILLH 1348; + FULL_REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `s` UNABBREV_TAC; + USEH 4729 (REWRITE_RULE[IMAGE]); + USEH 9244 (REWRITE_RULE[IMAGE]); + TYPE_THEN `u` UNABBREV_TAC; + (* - *) + TYPE_THEN `x = x'` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / (&8) < &1`SUBAGOAL_TAC; + UNDH 7394 THEN SIMP_TAC[REAL_LT_LDIV_EQ]; + REDUCE_TAC; + THM_INTRO_TAC[`i`] rep3_lt; + UNDH 1618 THEN ARITH_TAC; + TYPE_THEN `&0 <= x /\ &0 <= x'` SUBAGOAL_TAC; + ASM_MESON_TAC[REAL_LE_TRANS]; + CONJ_TAC THEN IMATCH_MP_TAC REAL_LET_TRANS THEN UNIFY_EXISTS_TAC; + (* - *) + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `(&2 * &(REP3 j') + &1) / &8 <= (&2 * &(REP3 i') + &2)/ &8` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LE_TRANS THEN UNIFY_EXISTS_TAC; + (* - *) + USEH 8118 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`)); + UNDH 4580 THEN REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_LT_RDIV]; + REDUCE_TAC; + UNDH 4372 THEN ARITH_TAC; + (* Sun Jan 2 20:07:58 EST 2005 *) + + ]);; + (* }}} *) + +let abs3_distinct = prove_by_refinement( + `~(ABS3 0 = ABS3 1) /\ ~(ABS3 0 = ABS3 2) /\ ~(ABS3 1 = ABS3 2)`, + (* {{{ proof *) + [ + TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3(ABS3 j))==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC; + TYPE_THEN `ABS3 i` UNABBREV_TAC; + REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[ABS3_012] THEN ARITH_TAC; + ]);; + (* }}} *) + +let three_t_enum = prove_by_refinement( + `!(a:A) b c. ?(f:three_t ->A). (f(ABS3 0) = a) /\ + (f(ABS3 1) = b) /\ (f(ABS3 2) = c)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `f = (\ i. (if (i = ABS3 0) then a else (if (i = ABS3 1) then b else c)))` ABBREV_TAC ; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `f` UNABBREV_TAC; + REWRITE_TAC[abs3_distinct]; + ]);; + (* }}} *) + +let three_t_univ = prove_by_refinement( + `!P. P (ABS3 0) /\ P(ABS3 1) /\ P(ABS3 2) ==> (!i. P i)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`i`] ABS3_onto; + TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2)` SUBAGOAL_TAC; + UNDH 4616 THEN ARITH_TAC; + UNDH 2783 THEN REP_CASES_TAC THEN (TYPE_THEN `j` UNABBREV_TAC); + ]);; + (* }}} *) + +let simple_arc_sep_three_t = prove_by_refinement( + `!C x p. + (!(i:three_t). simple_arc_end (C i) x (p i)) /\ + (!i j. (C i) (p j) ==> (i = j)) ==> + (?C' x. + (!i. simple_arc_end (C' i) x (p i)) /\ + (!i j. ~(i = j) ==> (C' i INTER C' j = {x})) /\ + (!A. (!i. (C i) SUBSET A) ==> (!i. (C' i) SUBSET A))) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `A = C(ABS3 0) UNION C(ABS3 1) UNION C(ABS3 2)` ABBREV_TAC ; + THM_INTRO_TAC[`A`;`C(ABS3 0)`;`C(ABS3 1)`;`C(ABS3 2)`;`x`;`p(ABS3 0)`;`p(ABS3 1)`;`p(ABS3 2)`] simple_arc_sep; + REWRITE_TAC[SUBSET_REFL]; + TYPE_THEN `!i j. ~(i = j) ==> ~(C i (p j))` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3 (ABS3 j)) ==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC; + TYPE_THEN `ABS3 i` UNABBREV_TAC; + REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[ABS3_012] THEN ARITH_TAC ; + THM_INTRO_TAC[`C1'`;`C2'`;`C3'`] three_t_enum; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `C1'` UNABBREV_TAC; + TYPE_THEN `C2'` UNABBREV_TAC; + TYPE_THEN `C3'` UNABBREV_TAC; + (* - *) + CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ;ALL_TAC]; + CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ THEN (REPEAT CONJ_TAC) THEN IMATCH_MP_TAC three_t_univ THEN FULL_REWRITE_TAC[INTER_ACI];ALL_TAC]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `A` EXISTS_TAC; + FULL_REWRITE_TAC[union_subset]; + TYPE_THEN `!i. (f i SUBSET A)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC three_t_univ;ALL_TAC]; + (* - *) + UNDH 2066 THEN UNDH 915 THEN POP_ASSUM_LIST (fun t->ALL_TAC); + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[union_subset]; + (* Sun Jan 2 21:17:07 EST 2005 *) + + ]);; + (* }}} *) + +let old_every_step_tac = !EVERY_STEP_TAC;; +EVERY_STEP_TAC := + REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN + (REWRITE_TAC[]) ;; + +let transpose = jordan_def `transpose (Q:A->B->C) i j = Q j i`;; + +let transpose2 = prove_by_refinement( + `!Q . (transpose (transpose Q)) = (Q:A->B->C) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[transpose]; + ]);; + (* }}} *) + +let k33_planar_graph_data_expand = prove_by_refinement( + `(!q A CA B CB. + (!(i:three_t) (j:three_t) i' j'. + (q i j = q i' j') ==> (i = i') /\ (j = j')) /\ + (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\ + (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\ + (!i j i' j' u. (CB i j u /\ CA i' j' u) ==> + (i = i') /\ (j = j') /\ (u = q i j)) /\ + (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\ + (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) + ==> (?A' CA' B' CB'. + (!i j. simple_arc_end (CA' i j) (A' i) (q i j)) /\ + (!i j. simple_arc_end (CB' i j) (B' j) (q i j)) /\ + (!i j i' j' u. (CB' i j u /\ CA' i' j' u) ==> + (i = i') /\ (j = j') /\ (u = q i j)) /\ + (!i j i' j'. ~(CA' i j INTER CA' i' j' = EMPTY) ==> (i = i')) /\ + (!i j i' j'. ~(CB' i j INTER CB' i' j' = EMPTY) ==> (j = j')) /\ + (!i j k. ~(j = k) ==> (CA' i j INTER CA' i k = {(A' i)})) /\ + (!i j k. ~(j = k) ==> (CB' j i INTER CB' k i = {(B' i)})) + )) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `!i. ?CA' A'. (!j. simple_arc_end (CA' j) (A') (q i j)) /\ (!j k. ~(j = k) ==> (CA' j INTER CA' k = {(A')})) /\ (!U. (!j. (CA i j SUBSET U)) ==> (!j. CA' j SUBSET U))` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_sep_three_t; + TYPE_THEN `A i` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`q i j'`]); + ASM_REWRITE_TAC[]; + UNDH 190 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`]); + USEH 6066 (MATCH_MP simple_arc_end_end2); + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + RIGHTH 7847 "i"; + RIGHTH 705 "i"; + TYPE_THEN `A'` EXISTS_TAC; + TYPE_THEN `CA'` EXISTS_TAC; + TYPE_THEN `(!i j. simple_arc_end (CA' i j) (A' i) (q i j))` SUBAGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -A *) + TYPE_THEN `!i j u. CA' i j u ==> (?j'. CA i j' u)` SUBAGOAL_TAC; + TSPECH `i` 6858; + TSPECH `UNIONS (IMAGE (CA i) (UNIV))` 1295; + UNDH 3086 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRITE_TAC[SUBSET;UNIONS;IMAGE ]; + CONV_TAC (dropq_conv ("u")); + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TSPECH `j` 7352; + USEH 4766 (REWRITE_RULE[SUBSET;UNIONS;IMAGE]); + TSPECH `u` 9646; + REP_BASIC_TAC; + TYPE_THEN `u'` UNABBREV_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(!i j i' j'. ~(CA' i j INTER CA' i' j' = {}) ==> (i = i'))` SUBAGOAL_TAC; + USEH 3155 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + COPYH 6882; + UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]); + ASM_REWRITE_TAC[]; + UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]); + ASM_REWRITE_TAC[]; + KILLH 33; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `j'''` EXISTS_TAC; + TYPE_THEN `j''` EXISTS_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -B *) + TYPE_THEN `!i. ?CBt' B'. (!j. simple_arc_end (CBt' j) (B') (transpose q i j)) /\ (!j k. ~(j = k) ==> (CBt' j INTER CBt' k = {(B')})) /\ (!U. (!j. (transpose CB i j SUBSET U)) ==> (!j. CBt' j SUBSET U))` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_sep_three_t; + TYPE_THEN `B i` EXISTS_TAC; + REWRITE_TAC[transpose]; + ASM_REWRITE_TAC[]; + UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`;`j'`;`i`;`q j' i`]); + ASM_REWRITE_TAC[]; + UNDH 8461 THEN DISCH_THEN (THM_INTRO_TAC[`j'`;`i`]); + USEH 6944 (MATCH_MP simple_arc_end_end2); + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + RIGHTH 2590 "i"; + RIGHTH 5199 "i"; + TYPE_THEN `B'` EXISTS_TAC; + TYPE_THEN `CB' = transpose CBt'` ABBREV_TAC ; + TYPE_THEN `CBt' = transpose CB'` SUBAGOAL_TAC; + TYPE_THEN `CB'` UNABBREV_TAC; + REWRITE_TAC[transpose2]; + TYPE_THEN `CBt'` UNABBREV_TAC; + FULL_REWRITE_TAC[transpose]; + KILLH 87; + TYPE_THEN `CB'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -C *) + TYPE_THEN `!i j u. CB' i j u ==> (?i'. CB i' j u)` SUBAGOAL_TAC; + TSPECH `j` 4587; + TSPECH `UNIONS (IMAGE (transpose CB j) (UNIV))` 6357; + UNDH 3701 THEN DISCH_THEN (THM_INTRO_TAC[]); + REWRITE_TAC[SUBSET;UNIONS;IMAGE;transpose ]; + CONV_TAC (dropq_conv ("u")); + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TSPECH `i` 8438; + USEH 4864 (REWRITE_RULE[SUBSET;UNIONS;IMAGE]); + TSPECH `u` 7999; + FULL_REWRITE_TAC[transpose]; + TYPE_THEN `u'` UNABBREV_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(!i j i' j'. ~(CB' i j INTER CB' i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC; + USEH 541 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + COPYH 5811; + UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]); + ASM_REWRITE_TAC[]; + UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]); + ASM_REWRITE_TAC[]; + KILLH 3657; + KILLH 6409; + FIRST_ASSUM IMATCH_MP_TAC ; + REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `i'''` EXISTS_TAC; + TYPE_THEN `i''` EXISTS_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -D *) + UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]); + ASM_REWRITE_TAC[]; + UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]); + ASM_REWRITE_TAC[]; + UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i''`;`j`;`i'`;`j''`;`u`]); + ASM_REWRITE_TAC[]; + TYPE_THEN `j''` UNABBREV_TAC; + TYPE_THEN `i''` UNABBREV_TAC; + TYPE_THEN `u` UNABBREV_TAC; + TSPECH `i'` 6858; + (* -- *) + TYPE_THEN `~(j = j')` ASM_CASES_TAC; + UNDH 1784 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`j'`]); + UNDH 2577 THEN ASM_REWRITE_TAC[]; + USEH 6310 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + TSPECH `q i' j` 3488; + REWRH 4791; + TSPECH `j` 1529; + COPYH 3976; + USEH 3976 (MATCH_MP simple_arc_end_distinct); + UNDH 587 THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 3976 (MATCH_MP simple_arc_end_end2); + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[]; + TYPE_THEN `j'` UNABBREV_TAC; + (* -E *) + TYPE_THEN `(i = i')` BACK_TAC; + TYPE_THEN `i'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + TSPECH `j` 4587; + UNDH 5789 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`]); + UNDH 3113 THEN ASM_REWRITE_TAC[]; + USEH 3441 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + TSPECH `q i' j` 7938; + REWRH 5749; + TSPECH `i'` 7762; + COPYH 8730; + USEH 8730 (MATCH_MP simple_arc_end_distinct); + UNDH 586 THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 8730 (MATCH_MP simple_arc_end_end2); + ASM_REWRITE_TAC[]; + (* Tue Jan 4 10:50:14 EST 2005 *) + + ]);; + (* }}} *) + +let three_t_size3 = prove_by_refinement( + `(UNIV:three_t->bool) HAS_SIZE 3`, + (* {{{ proof *) + [ + ASSUME_TAC (ARITH_RULE `3 = SUC 2`); + ASM_REWRITE_TAC[]; + REWRITE_TAC[HAS_SIZE_SUC]; + REWRITE_TAC[three_delete_size]; + ]);; + (* }}} *) + +let no_k33_planar_graph_data = prove_by_refinement( + `(!q A CA B CB. + (!(i:three_t) (j:three_t) i' j'. + (q i j = q i' j') ==> (i = i') /\ (j = j')) /\ + (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\ + (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\ + (!i j i' j' u. (CB i j u /\ CA i' j' u) ==> + (i = i') /\ (j = j') /\ (u = q i j)) /\ + (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\ + (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) ==> + F)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`q`;`A`;`CA`;`B`;`CB`] k33_planar_graph_data_expand; + ASM_REWRITE_TAC[]; + KILLH 33 THEN KILLH 3657 THEN KILLH 8763 THEN KILLH 190 THEN KILLH 8461; + TYPE_THEN `CE = ( \i j. CA' i j UNION CB' i j)` ABBREV_TAC ; + TYPE_THEN `!i j. CE i j = CA' i j UNION CB' i j` SUBAGOAL_TAC; + TYPE_THEN `CE` UNABBREV_TAC; + TYPE_THEN `!i j. simple_arc_end (CE i j) (A' i) (B' j)` SUBAGOAL_TAC; + TYPE_THEN `CE` UNABBREV_TAC; + IMATCH_MP_TAC simple_arc_end_trans; + TYPE_THEN `q i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[INTER;SUBSET;INR IN_SING]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;INR IN_SING;INTER]; + TYPE_THEN `x` UNABBREV_TAC; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + (* - *) + TYPE_THEN `A = IMAGE A' UNIV` ABBREV_TAC ; + TYPE_THEN `B = IMAGE B' UNIV` ABBREV_TAC ; + TYPE_THEN `E = IMAGE (\ (i,j). (CE i j)) (cartesian UNIV UNIV)` ABBREV_TAC ; + (* - *) + TYPE_THEN `!i j. CA' i j (q i j)` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + TYPE_THEN `!i j. CB' i j (q i j)` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2]; + TYPE_THEN `!i j. CA' i j (A' i)` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + TYPE_THEN `!i j. CB' i j (B' j)` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + (* - *) + TYPE_THEN `!i i' j. CA' i j (A' i') ==> (i = i')` SUBAGOAL_TAC; + KILLH 5790; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `j` EXISTS_TAC; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `j` EXISTS_TAC; + TYPE_THEN `(A' i')` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j j'. CB' i j (B' j') ==> (j = j')` SUBAGOAL_TAC; + KILLH 6409; + KILLH 1344; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `(B' j')` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i i' j. ~CB' i j (A' i') ` SUBAGOAL_TAC; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`A' i'`]); + ASM_REWRITE_TAC[]; + USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + UNDH 6711 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`]); + TYPE_THEN `A' i'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `i'` UNABBREV_TAC; + ASM_MESON_TAC[simple_arc_end_distinct]; + (* - *) + TYPE_THEN `!i j j'. ~CA' i j (B' j') ` SUBAGOAL_TAC; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`B' j'`]); + ASM_REWRITE_TAC[]; + TYPE_THEN `j'` UNABBREV_TAC; + ASM_MESON_TAC[simple_arc_end_distinct]; + (* - *) + TYPE_THEN `!i j. CE i j INTER A = {(A' i)}` SUBAGOAL_TAC; + REWRITE_TAC[eq_sing;INR IN_SING;INTER]; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `CE` UNABBREV_TAC; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + NAME_CONFLICT_TAC; + CONJ_TAC; + MESON_TAC[]; + TYPE_THEN `u'` UNABBREV_TAC ; + TYPE_THEN `x' = i` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. CE i j INTER B = {(B' j)}` SUBAGOAL_TAC; + REWRITE_TAC[eq_sing;INR IN_SING;INTER]; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + TYPE_THEN `CE` UNABBREV_TAC; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + NAME_CONFLICT_TAC; + CONJ_TAC; + MESON_TAC[]; + TYPE_THEN `u'` UNABBREV_TAC ; + TYPE_THEN `x' = j` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* -A *) + TYPE_THEN `!i i'. (A' i = A' i') ==> (i = i')` SUBAGOAL_TAC; + UNDH 1344 THEN DISCH_THEN IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!j j'. (B' j = B' j') ==> (j = j')` SUBAGOAL_TAC; + UNDH 6780 THEN DISCH_THEN IMATCH_MP_TAC ; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j i' j'. ~(CE i j INTER CE i' j' = EMPTY) ==> (i = i') \/ (j = j')` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + TYPE_THEN `CE` UNABBREV_TAC; + USEH 672 (REWRITE_RULE[EMPTY_EXISTS;INTER;UNION]); + USEH 5790 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + FIRST_ASSUM DISJ_CASES_TAC THEN KILLH 7160 THEN (FIRST_ASSUM DISJ_CASES_TAC) ; + UNDH 3113 THEN REWRITE_TAC[] THEN UNDH 6711 THEN DISCH_THEN IMATCH_MP_TAC ; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`u`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`i`;`j`;`u`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + UNDH 2577 THEN REWRITE_TAC[] THEN UNDH 6981 THEN DISCH_THEN IMATCH_MP_TAC ; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -B *) + TYPE_THEN `!i j. ~(A' i = B' j)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j j'. ~(j = j') ==> (CE i j INTER CE i j' = {(A' i)})` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + TYPE_THEN `CE` UNABBREV_TAC; + REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING]; + FIRST_ASSUM DISJ_CASES_TAC THEN (KILLH 2709) THEN (FIRST_ASSUM DISJ_CASES_TAC ); + USEH 6932 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[]; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`j'`;`x`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`x`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + USEH 5790 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + ASM_MESON_TAC[]; + REWRITE_TAC[INR IN_SING;SUBSET;INTER]; + TYPE_THEN `x` UNABBREV_TAC; + USEH 9014 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i i' j. ~(i = i') ==> (CE i j INTER CE i' j = {(B' j)})` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + TYPE_THEN `CE` UNABBREV_TAC; + REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING]; + FIRST_ASSUM DISJ_CASES_TAC THEN (KILLH 3625) THEN (FIRST_ASSUM DISJ_CASES_TAC ); + USEH 6409 (REWRITE_RULE[EMPTY_EXISTS;INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[]; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`x`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`i`;`j`;`x`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + USEH 3599 (REWRITE_RULE[INTER;eq_sing;INR IN_SING;]); + ASM_MESON_TAC[]; + REWRITE_TAC[INR IN_SING;SUBSET;INTER]; + TYPE_THEN `x` UNABBREV_TAC; + USEH 4144 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); + ASM_MESON_TAC[]; + (* -C *) + TYPE_THEN `g = (\ (i,j). CE i j)` ABBREV_TAC ; + TYPE_THEN `BIJ g (cartesian UNIV UNIV) E` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + IMATCH_MP_TAC inj_bij; + REWRITE_TAC[INJ]; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `?i j. x = (i,j)` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `?i j. y = (i,j)` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `y` UNABBREV_TAC; +(*** Removed by JRH; this happens automatically now + USEH 8053 (GBETA_RULE); + ***) + REWRITE_TAC[PAIR_SPLIT]; + (* -- *) + TYPE_THEN `!i j. INFINITE (CE i j)` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_infinite; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `(i = i') \/ (j = j')` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `CE i' j'` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_IDEMPOT]; + TSPECH `i` 6411; + TSPECH `j` 2286; + FULL_REWRITE_TAC[INFINITE]; + TYPE_THEN `CE i j` UNABBREV_TAC; + FULL_REWRITE_TAC[FINITE_RULES]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + UNDH 2315 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]); + ASM_MESON_TAC[]; + TYPE_THEN `i'` UNABBREV_TAC; + TYPE_THEN `CE i j'` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_IDEMPOT]; + FULL_REWRITE_TAC[INFINITE]; + UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[]; + TYPE_THEN `CE i j` UNABBREV_TAC; + FULL_REWRITE_TAC[FINITE_SING]; + ASM_REWRITE_TAC[]; + TYPE_THEN `j'` UNABBREV_TAC; + PROOF_BY_CONTR_TAC; + UNDH 3532 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]); + ASM_MESON_TAC[]; + TYPE_THEN `CE i' j` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_IDEMPOT]; + FULL_REWRITE_TAC[INFINITE]; + UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[]; + TYPE_THEN `CE i j` UNABBREV_TAC; + FULL_REWRITE_TAC[FINITE_SING]; + ASM_REWRITE_TAC[]; + (* -D *) + COPYH 1061; + USEH 1061 (MATCH_MP INVERSE_BIJ); + TYPE_THEN `h = INV g (cartesian UNIV UNIV) E` ABBREV_TAC ; + TYPE_THEN `hh = (\ x. (A' (FST (h x)), B' (SND (h x))))` ABBREV_TAC ; + TYPE_THEN `BIJ hh E (cartesian A B)` SUBAGOAL_TAC; + TYPE_THEN `hh` UNABBREV_TAC; + REWRITE_TAC[BIJ]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC; + REWRITE_TAC[cartesian]; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[IMAGE;PAIR_SPLIT ]; + MESON_TAC[]; + FULL_REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `h x = h y` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[BIJ;INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SURJ]; + CONJ_TAC; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USEH 807 (REWRITE_RULE[cartesian;PAIR_SPLIT]); + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `FST x` UNABBREV_TAC; + TYPE_THEN `SND x` UNABBREV_TAC; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + USEH 6050 (REWRITE_RULE[IMAGE]); + USEH 2264 (REWRITE_RULE[IMAGE]); + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `y` UNABBREV_TAC; + TYPE_THEN `g (x'',x)` EXISTS_TAC; + (* -- *) + TYPE_THEN `h (g (x'',x)) = (x'',x)` SUBAGOAL_TAC; + TYPE_THEN `h` UNABBREV_TAC; + IMATCH_MP_TAC inv_comp_left; + ASM_REWRITE_TAC[]; + REWRITE_TAC[cartesian_univ]; + ASM_REWRITE_TAC[]; + TYPE_THEN `E` UNABBREV_TAC; + IMATCH_MP_TAC image_imp; + REWRITE_TAC[cartesian_univ]; + (* -E *) + TYPE_THEN `G = mk_graph_t (A UNION B,E,(\ e . {(FST (hh e)), (SND (hh e)) }))` ABBREV_TAC ; + TYPE_THEN `graph_isomorphic k33_graph G` SUBAGOAL_TAC; + TYPE_THEN `G` UNABBREV_TAC; + IMATCH_MP_TAC k33_iso; + ASM_REWRITE_TAC[]; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + (* -- *) + REWRITE_TAC[HAS_SIZE] ; + TYPE_THEN `FINITE (IMAGE A' UNIV) /\ FINITE (IMAGE B' UNIV)` SUBAGOAL_TAC; + ASSUME_TAC three_t_size3; + FULL_REWRITE_TAC[HAS_SIZE]; + CONJ_TAC THEN IMATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASSUME_TAC three_t_size3; + FULL_REWRITE_TAC[HAS_SIZE]; + TYPE_THEN `(CARD (IMAGE A' UNIV) = 3) /\ (CARD (IMAGE B' UNIV) = 3)` SUBAGOAL_TAC; + USEH 6784 SYM; + ASM_REWRITE_TAC[]; + CONJ_TAC THEN IMATCH_MP_TAC (INR CARD_IMAGE_INJ) THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USEH 9575 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]); + TYPE_THEN `u` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* -F *) + THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph; + ASM_REWRITE_TAC[k33_isgraph]; + THM_INTRO_TAC[] k33_nonplanar; + FULL_REWRITE_TAC[planar_graph]; + UNDH 3419 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `G` EXISTS_TAC; + THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_symm; + ASM_REWRITE_TAC[k33_isgraph]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[plane_graph]; + ASM_REWRITE_TAC[]; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `G` UNABBREV_TAC; + REWRITE_TAC[graph_vertex_mk_graph]; + REWRITE_TAC[UNION;SUBSET]; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + USEH 986 (REWRITE_RULE[IMAGE]); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + UNDH 2402 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]); + TYPE_THEN `x` UNABBREV_TAC; + UNDH 7678 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]); + (* - *) + SUBCONJ_TAC; + TYPE_THEN `G` UNABBREV_TAC; + REWRITE_TAC[graph_edge_mk_graph]; + TYPE_THEN `E` UNABBREV_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + TYPE_THEN `?i j. (x' = (i,j))` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT]; + MESON_TAC[]; + TYPE_THEN `x' ` UNABBREV_TAC; + GBETA_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + TYPE_THEN `(A' i)` EXISTS_TAC; + TYPE_THEN `(B' j)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `G` UNABBREV_TAC; + REWRITE_TAC[graph_edge_mk_graph;graph_inc_mk_graph;graph_vertex_mk_graph]; + KILLH 6876 THEN KILLH 5591 THEN KILLH 6365; + FULL_REWRITE_TAC[graph_edge_mk_graph]; + TYPE_THEN `E` UNABBREV_TAC; + USEH 1953 (REWRITE_RULE[IMAGE;cartesian_univ]); + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `hh` UNABBREV_TAC; + (* -- *) + TYPE_THEN `h (g (x)) = x` SUBAGOAL_TAC; + TYPE_THEN `h` UNABBREV_TAC; + IMATCH_MP_TAC inv_comp_left; + ASM_REWRITE_TAC[cartesian_univ]; + ASM_REWRITE_TAC[]; + TYPE_THEN `?i j. (x = (i,j))` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + GBETA_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;UNION;INR in_pair]; + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + FULL_REWRITE_TAC[eq_sing; INTER; INR IN_SING]; + TYPE_THEN `x` UNABBREV_TAC; + GBETA_TAC; + ASM_MESON_TAC[]; + (* -G *) + KILLH 7987 THEN KILLH 6305 THEN KILLH 5812 THEN KILLH 3738 THEN KILLH 8499; + TYPE_THEN `!e. E e ==> (?i j. (e = CE i j))` SUBAGOAL_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `g` UNABBREV_TAC; + USEH 7673 (REWRITE_RULE[cartesian_univ;IMAGE]); + TYPE_THEN `(? i j. x = (i,j))` SUBAGOAL_TAC; + REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `e''` UNABBREV_TAC; + GBETA_TAC; + MESON_TAC[]; + (* - *) + TYPE_THEN `G` UNABBREV_TAC; + FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph]; + KILLH 4886 THEN KILLH 6107 THEN KILLH 6780 THEN KILLH 1344; + COPYH 1159; + TSPECH `e` 1159; + TSPECH `e'` 1159; + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + KILLH 5790 THEN KILLH 6409 THEN KILLH 5249 THEN KILLH 5804; + REWRITE_TAC[INTER;SUBSET;UNION]; + TYPE_THEN `(i' = i)` ASM_CASES_TAC; + DISJ1_TAC; + FULL_REWRITE_TAC[eq_sing;INTER;INR IN_SING]; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[IMAGE]; + NAME_CONFLICT_TAC; + TYPE_THEN `i'` UNABBREV_TAC; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `~(j' = j)` SUBAGOAL_TAC; + TYPE_THEN `j'` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + UNDH 221 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]); + UNDH 7790 THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(i' = i) \/ (j' = j)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 5273 (REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + REWRH 5596; + TYPE_THEN `j'` UNABBREV_TAC; + DISJ2_TAC; + (* - *) + TYPE_THEN `x = B' j` BACK_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `B` UNABBREV_TAC; + IMATCH_MP_TAC image_imp; + (* - *) + USEH 3532 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); + UNDH 9432 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]); + UNDH 7528 THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Tue Jan 4 15:3282:39 EST 2005 *) + ]);; + (* }}} *) + +let simple_arc_midpoint = prove_by_refinement( + `!C v w. simple_arc_end C v w ==> + (?u. (C u /\ ~(u = v) /\ ~(u = w)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] simple_arc_infinite; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`{v,w}`;] INFINITE_DIFF_FINITE; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`v`;`w`] pair_size_2; + ASM_MESON_TAC[simple_arc_end_distinct]; + FULL_REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[]; + USEH 3168 (MATCH_MP INFINITE_NONEMPTY); + FULL_REWRITE_TAC[DIFF;EMPTY_EXISTS;INR in_pair]; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let simple_arc_choose_end = prove_by_refinement( + `!C. simple_arc top2 C ==> (?v w. simple_arc_end C v w)`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_arc;simple_arc_end]; + FULL_REWRITE_TAC[top2_unions]; + LEFT_TAC "f"; + LEFT_TAC "f"; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `f(&0)` EXISTS_TAC; + TYPE_THEN `f(&1)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let cut_arc_replace = prove_by_refinement( + `!A B u v. A SUBSET B /\ simple_arc top2 A /\ simple_arc top2 B /\ + A u /\ A v /\ ~(u = v) ==> (cut_arc B u v = cut_arc A u v)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC cut_arc_unique; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `A` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let cut_arc_order = prove_by_refinement( + `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==> + ~(cut_arc C v u w)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`u`;`v`;`w`] cut_arc_inter; + ASM_REWRITE_TAC[]; + USEH 1187 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + TSPECH `w` 5795; + COPYH 1985; + UNDH 1985 THEN REWRITE_TAC []; + IMATCH_MP_TAC EQ_SYM; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + TYPE_THEN `u` EXISTS_TAC; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* First direction of Jordan curve theorem. *) + +let jordan_curve_no_inj3 = prove_by_refinement( + `!C p. + simple_closed_curve top2 C /\ + INJ p (UNIV:three_t ->bool) (euclid 2) /\ + (!i. ~C (p i)) /\ + (!i j A. simple_arc_end A (p i) (p j) ==> ~(A INTER C = EMPTY)) + ==> F`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] jordan_curve_seg3; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i. ?v w. simple_arc_end (s i) v w` SUBAGOAL_TAC; + THM_INTRO_TAC[`s i`] simple_arc_choose_end; + ASM_MESON_TAC[]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + LEFTH 4671 "v"; + LEFTH 2518 "w"; + (* - *) + TYPE_THEN `!i. ?B. s i B /\ ~(B = v i) /\ ~(B = w i)` SUBAGOAL_TAC; + THM_INTRO_TAC[`s i`;`v i`;`w i`] simple_arc_midpoint; + ASM_REWRITE_TAC[]; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + LEFTH 9437 "B"; + (* -A *) + TYPE_THEN `!i. euclid 2 (p i)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INJ]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. ?E. simple_arc_end E (p i) (B j) /\ (E INTER C SUBSET (s j)) /\ (!e. E e /\ ~C e /\ ~(p i = e) ==> (cut_arc E (p i) e INTER C = EMPTY))` SUBAGOAL_TAC; + IMATCH_MP_TAC jordan_curve_access; + TYPE_THEN `v j` EXISTS_TAC; + TYPE_THEN `w j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`i`] three_t_not_sing; + TYPE_THEN `p j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 7630 THEN FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + LEFTH 4024 "E"; + LEFTH 1449 "E"; + (* -B *) + TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ C u ==> (j = j') /\ s j u` SUBAGOAL_TAC; + COPYH 807; + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]); + USEH 6239 (REWRITE_RULE[INTER;SUBSET]); + USEH 4225 (REWRITE_RULE[INTER;SUBSET]); + SUBCONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 9012 (REWRITE_RULE[EQ_EMPTY;INTER]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j. (p i = p j) ==> (i = j)` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INJ]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. E i j (p i)` SUBAGOAL_TAC; + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + USEH 3415 (MATCH_MP simple_arc_end_end); + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ ~C u ==> (i = i')` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + (* -- *) + TYPE_THEN `u = p i` ASM_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]); + UNDH 8557 THEN DISCH_THEN (THM_INTRO_TAC[`p i`]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`i`;`cut_arc (E i' j') (p i') (p i)`]); + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + UNDH 1303 THEN ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `u = p i'` ASM_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + UNDH 3041 THEN DISCH_THEN (THM_INTRO_TAC[`p i'`]); + ASM_REWRITE_TAC[]; + UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`cut_arc (E i j) (p i) (p i')`]); + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 9380 THEN ASM_REWRITE_TAC[]; + (* -- *) + COPYH 807; + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]); + TYPE_THEN `cut_arc (E i j) (p i) u INTER C = EMPTY` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `cut_arc (E i' j') (p i') u INTER C = EMPTY` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`E i j`;`p i`;`u`] cut_arc_simple; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`E i' j'`;`p i'`;`u`] cut_arc_simple; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`cut_arc (E i j) (p i) u`;`cut_arc (E i' j') (p i') u`;`p i`;`u`;`p i'`] simple_arc_end_subset_trans; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + UNDH 3113 THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -- *) + UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`U`]); + ASM_REWRITE_TAC[]; + UNDH 3232 THEN UNDH 5860 THEN UNDH 4934 THEN UNDH 7573 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;SUBSET] THEN REWRITE_TAC[EQ_EMPTY;UNION] THEN MESON_TAC[]; + (* -C *) + TYPE_THEN `!i j. ?E'' u u''. E'' SUBSET E i j /\ simple_arc_end E'' u u'' /\ (E'' INTER (UNIONS (IMAGE (E i) {k | ~(k = j)})) = {u}) /\ (E'' INTER {(B j)} = {u''})` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_restriction; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple THEN ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC top_closed_unions; + REWRITE_TAC[top2_top]; + CONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `UNIV:three_t -> bool` EXISTS_TAC ; + REWRITE_TAC[three_t_finite]; + REWRITE_TAC[SUBSET;IMAGE]; + TYPE_THEN `x` UNABBREV_TAC; + ASM_MESON_TAC[simple_arc_end_closed]; + (* -- *) + CONJ_TAC; + ASM_MESON_TAC[simple_arc_end_end_closed2]; + (* -- *) + CONJ_TAC; + REWRITE_TAC[EQ_EMPTY;INTER;UNIONS;IMAGE;INR IN_SING ]; + TYPE_THEN `u` UNABBREV_TAC; + TYPE_THEN `x` UNABBREV_TAC; + UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x'`;`B j`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `s j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 7917 THEN ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + TYPE_THEN `p i` EXISTS_TAC; + REWRITE_TAC[INTER;UNIONS;IMAGE]; + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "u"); + THM_INTRO_TAC[`j`] three_t_not_sing; + TYPE_THEN `j'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER]; + TYPE_THEN `B j` EXISTS_TAC; + ASM_REWRITE_TAC[INR IN_SING ]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* - *) + LEFTH 4870 "E''"; + LEFTH 4064 "E''"; + LEFTH 544 "u''"; + LEFTH 659 "u''"; + LEFTH 239 "u''"; + TYPE_THEN `u'' = (\ i j. B j)` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + IMATCH_MP_TAC EQ_EXT; + TSPECH `x` 3583; + TSPECH `x'` 7705; + USEH 2213 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + IMATCH_MP_TAC EQ_SYM; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 3027 SYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `u''` UNABBREV_TAC; + (* - *) + LEFTH 1162 "u"; + LEFTH 3727 "u"; + TYPE_THEN `!i j. (?E' ua u'. E' SUBSET (E'' i j) /\ simple_arc_end E' ua u' /\ (E' INTER {(u i j)} = {ua}) /\ (E' INTER (s j) = {u'}))` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_restriction; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC []; + (* -- *) + CONJ_TAC; + ASM_MESON_TAC[simple_arc_end_end_closed]; + CONJ_TAC; + ASM_MESON_TAC[simple_arc_end_closed]; + (* -- *) + CONJ_TAC; + PROOF_BY_CONTR_TAC; + USEH 4139 (REWRITE_RULE[INTER;EMPTY_EXISTS;INR IN_SING]); + TYPE_THEN `u'` UNABBREV_TAC; + TSPECH `i` 2275; + TSPECH `j` 631; + USEH 9848 (REWRITE_RULE[eq_sing;INR IN_SING;INTER;UNIONS;IMAGE]); + TYPE_THEN `u''` UNABBREV_TAC; + UNDH 9165 THEN REWRITE_TAC[]; + UNDH 3778 THEN DISCH_THEN IMATCH_MP_TAC ; + UNDH 1277 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `u i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `C (u i j)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `s j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x`;`u i j`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `E'' i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ]; + CONJ_TAC; + TYPE_THEN `u i j` EXISTS_TAC; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `B j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + LEFTH 5131 "E'"; + LEFTH 6920 "E'"; + (* -D *) + TYPE_THEN `!i j k q x. E i k x /\ E'' i j q /\ ~(q = u i j) /\ ~(q = B j) /\ cut_arc (E i j) (q) (B j) x ==> (j = k)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + (* -- *) + TYPE_THEN `cut_arc (E i j) q (B j) = cut_arc (E'' i j) q (B j)` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_replace; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* -- *) + REWRH 4315; + TYPE_THEN `E'' i j x` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `cut_arc (E'' i j) q (B j)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* -- *) + UNDH 2275 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + USEH 9848 (REWRITE_RULE[INTER;UNIONS;IMAGE;eq_sing;INR IN_SING]); + TYPE_THEN `x = u i j` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONV_TAC (dropq_conv "u"); + TYPE_THEN `k` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `x` UNABBREV_TAC; + (* -- *) + THM_INTRO_TAC[`E'' i j`;`q`;`B j`;`u i j`] cut_arc_order; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + UNDH 1152 THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[cut_arc_symm]; + ASM_REWRITE_TAC[]; + (* -Da *) + TYPE_THEN `?u'. !i j. E' i j SUBSET E'' i j /\ simple_arc_end (E' i j) (u i j) (u' i j) /\ (E' i j INTER s j = {(u' i j)})` SUBAGOAL_TAC; + LEFTH 2832 "ua"; + LEFTH 6021 "ua"; + LEFTH 4322 "u'"; + LEFTH 1946 "u'"; + TYPE_THEN `u'` EXISTS_TAC; + TSPECH `i` 1323; + TSPECH `j` 1285; + ASM_REWRITE_TAC[]; + USEH 7215 (REWRITE_RULE[INTER;INR IN_SING;eq_sing;]); + TYPE_THEN `ua i j` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + KILLH 2832; + (* - *) + TYPE_THEN `!i j. E' i j SUBSET E i j` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E'' i j` EXISTS_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j. ?q. (E' i j q) /\ (E'' i j q) /\ (E i j q) /\ ~(q = u i j) /\ ~(q = u' i j) /\ ~(s j q) /\ (!k. E i k q ==> (j = k))` SUBAGOAL_TAC; + TSPECH `i` 7629; + TSPECH `j` 6300; + THM_INTRO_TAC[`E' i j`;`u i j`;`u' i j`] simple_arc_midpoint; + ASM_REWRITE_TAC[]; + TYPE_THEN `q = u''` ABBREV_TAC ; + TYPE_THEN `u''` UNABBREV_TAC; + TYPE_THEN `q` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `E' i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + SUBCONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `E' i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + SUBCONJ_TAC; + USEH 3228 (REWRITE_RULE[INR IN_SING;eq_sing;INTER]); + ASM_MESON_TAC[]; + TSPECH `i` 6619; + TSPECH `j` 4357; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `q` EXISTS_TAC; + TYPE_THEN `q` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + UNDH 9552 THEN REWRITE_TAC[]; + TYPE_THEN `q` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`E i j`;`q`;`B j`] cut_arc_simple; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + LEFTH 7093 "q"; + LEFTH 7917 "q"; + (* -E *) + TYPE_THEN `CA = (\ i j. cut_arc (E i j) (p i) (q i j))` ABBREV_TAC ; + TYPE_THEN `CB = (\ i j. cut_arc (E i j) (q i j) (B j))` ABBREV_TAC ; + TYPE_THEN `!i j. ~(q i j = p i)` SUBAGOAL_TAC; + TSPECH `i` 3615; + TSPECH `j` 524; + THM_INTRO_TAC[`j`] three_t_not_sing; + UNDH 2577 THEN REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. ~(q i j = B j)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j. simple_arc_end (CA i j) (p i) (q i j)` SUBAGOAL_TAC; + TYPE_THEN `CA` UNABBREV_TAC; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j. simple_arc_end (CB i j) (q i j) (B j)` SUBAGOAL_TAC; + TYPE_THEN `CB` UNABBREV_TAC; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* -F *) + THM_INTRO_TAC[`q`;`p`;`CA`;`B`;`CB`] no_k33_planar_graph_data THENL [ALL_TAC;ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]; + TYPE_THEN `(!i j. simple_arc_end (CB i j) (B j) (q i j)) ` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. CA i j INTER C = EMPTY` SUBAGOAL_TAC; + UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]); + TYPE_THEN `CA` UNABBREV_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USEH 6239 (REWRITE_RULE[INTER;SUBSET]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!i j j' u. CB i j u /\ E i j' u ==> (j = j')` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `q i j` EXISTS_TAC; + TYPE_THEN `u''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `CB` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. CB i j = cut_arc (E'' i j) (q i j) (B j)` SUBAGOAL_TAC; + TYPE_THEN `CB` UNABBREV_TAC; + IMATCH_MP_TAC cut_arc_replace; + ASM_REWRITE_TAC[]; + TYPE_THEN `simple_arc top2 (E i j)` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple]; + (* - *) + TYPE_THEN `!i i' j j' u. ~(i = i') /\ CB i j u /\ E i' j' u ==> (j = j') /\ s j u` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `i` EXISTS_TAC; + TYPE_THEN `i'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `CB` UNABBREV_TAC; + SUBCONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `cut_arc (E i j) (q i j) (B j)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `E'' i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple]; + PROOF_BY_CONTR_TAC; + UNDH 3113 THEN REWRITE_TAC[]; + UNDH 6138 THEN DISCH_THEN (IMATCH_MP_TAC ); + TYPE_THEN `j` EXISTS_TAC; + TYPE_THEN `j'` EXISTS_TAC; + TYPE_THEN `u''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -G *) + USEH 9121 GSYM; + TYPE_THEN `!i j. CB i j SUBSET E i j` SUBAGOAL_TAC; + TYPE_THEN `CB` UNABBREV_TAC; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple]; + (* - *) + TYPE_THEN `(!i j i' j'. ~(CB i j INTER CB i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC; + USEH 2001 (REWRITE_RULE [INTER;EMPTY_EXISTS]); + TYPE_THEN `i = i'` ASM_CASES_TAC; + UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `CB i' j'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -- *) + UNDH 3773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `CB i' j'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j'` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!i j. CA i j SUBSET E i j` SUBAGOAL_TAC; + TYPE_THEN `CA` UNABBREV_TAC; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_simple]; + (* -H *) + TYPE_THEN `(!i j i' j' u. CB i j u /\ CA i' j' u ==> (i = i') /\ (j = j') /\ (u = q i j))` SUBAGOAL_TAC; + TYPE_THEN `i = i'` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `i'` UNABBREV_TAC; + UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `CA i j'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j'` UNABBREV_TAC; + THM_INTRO_TAC[`E i j`;`q i j`;`p i`;`B j`] cut_arc_inter; + ASM_REWRITE_TAC[]; + USEH 699 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `CA` UNABBREV_TAC; + TYPE_THEN `CB` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + UNDH 3773 THEN DISCH_THEN ( THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `CA i' j'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j'` UNABBREV_TAC; + (* -- *) + USEH 682 (REWRITE_RULE[INTER;EQ_EMPTY]); + UNDH 218 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`u''`]); + UNDH 2186 THEN ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `s j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -I *) + CONJ_TAC; + UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`q i j`]); + CONJ_TAC; + TYPE_THEN `CB` UNABBREV_TAC; + ASM_MESON_TAC[simple_arc_end_end]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_end2]; + TYPE_THEN `i'` UNABBREV_TAC; + TYPE_THEN `j'` UNABBREV_TAC; + (* - *) + USEH 6538 (REWRITE_RULE[EMPTY_EXISTS;INTER]); + UNDH 6138 THEN DISCH_THEN IMATCH_MP_TAC ; + TYPE_THEN `j` EXISTS_TAC; + TYPE_THEN `j'` EXISTS_TAC; + TYPE_THEN `u''` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `CA i j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `CA i' j'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNDH 682 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER ]; + UNDH 7281 THEN REWRITE_TAC[EMPTY_EXISTS;INTER]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Sun Jan 16 08:48:56 EST 2005 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION CC *) +(* ------------------------------------------------------------------ *) + +(* finish off Jordan curve *) + +let simple_closed_curve_compact = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> compact top2 C`, + (* {{{ proof *) + + [ + REWRITE_TAC[simple_closed_curve]; + TYPE_THEN `C` UNABBREV_TAC; + IMATCH_MP_TAC image_compact; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[top2_unions]; + CONJ_TAC; + REWRITE_TAC[interval_compact]; + REWRITE_TAC[IMAGE;SUBSET]; + FULL_REWRITE_TAC[INJ]; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `x' = &1` ASM_CASES_TAC; + TYPE_THEN `x'` UNABBREV_TAC; + USEH 5825 SYM; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + REAL_ARITH_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + UNDH 6268 THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC; + (* Sun Jan 16 09:13:09 EST 2005 *) + + ]);; + + (* }}} *) + +let ymaxQexists_lemma = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> + (?p. C p /\ (!q. C q ==> (q 1 <=. p 1)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`1`;`2`] continuous_euclid1; + FULL_REWRITE_TAC[GSYM top2]; + THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_max_real; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_closed_curve_compact; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[simple_closed_curve]; + TYPE_THEN `C` UNABBREV_TAC; + USEH 2198 GSYM; + USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); + TSPECH `f (&0)` 9716; + UNDH 5422 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + TYPE_THEN `x` EXISTS_TAC; + FULL_REWRITE_TAC[coord]; + ASM_REWRITE_TAC[]; + (* Sun Jan 16 09:16:3282 EST 2005 *) + + ]);; + (* }}} *) + +let yminQexists_lemma = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> + (?p. C p /\ (!q. C q ==> (p 1 <=. q 1)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`1`;`2`] continuous_euclid1; + FULL_REWRITE_TAC[GSYM top2]; + THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_min_real; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_closed_curve_compact; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[simple_closed_curve]; + TYPE_THEN `C` UNABBREV_TAC; + USEH 2198 GSYM; + USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); + TSPECH `f (&0)` 9716; + UNDH 5422 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + TYPE_THEN `x` EXISTS_TAC; + FULL_REWRITE_TAC[coord]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let xmaxQexists_lemma = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> + (?p. C p /\ (!q. C q ==> (q 0 <=. p 0)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`0`;`2`] continuous_euclid1; + FULL_REWRITE_TAC[GSYM top2]; + THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_max_real; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_closed_curve_compact; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[simple_closed_curve]; + TYPE_THEN `C` UNABBREV_TAC; + USEH 2198 GSYM; + USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); + TSPECH `f (&0)` 9716; + UNDH 5422 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + TYPE_THEN `x` EXISTS_TAC; + FULL_REWRITE_TAC[coord]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let xminQexists_lemma = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> + (?p. C p /\ (!q. C q ==> (p 0 <=. q 0)))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`0`;`2`] continuous_euclid1; + FULL_REWRITE_TAC[GSYM top2]; + THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_min_real; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_closed_curve_compact; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[simple_closed_curve]; + TYPE_THEN `C` UNABBREV_TAC; + USEH 2198 GSYM; + USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]); + TSPECH `f (&0)` 9716; + UNDH 5422 THEN ASM_REWRITE_TAC[]; + TYPE_THEN `&0` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + TYPE_THEN `x` EXISTS_TAC; + FULL_REWRITE_TAC[coord]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* state pSC *) +let ymaxQ = jordan_def `ymaxQ C = supm { y | ?x. (C (point(x,y))) }`;; +let yminQ = jordan_def `yminQ C = inf { y | ?x. (C (point(x,y))) }`;; +let xmaxQ = jordan_def `xmaxQ C = supm { x | ?y. (C (point(x,y))) }`;; +let xminQ = jordan_def `xminQ C = inf { x | ?y. (C (point(x,y))) }`;; + +let inf_unique = prove_by_refinement( + `!X s. X s /\ (!t. X t ==> (s <= t)) ==> (s = inf X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`X`] inf_LB; + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `s` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `(s <= inf X) /\ (inf X <= s)` BACK_TAC; + UNDH 9491 THEN UNDH 1818 THEN REAL_ARITH_TAC; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let supm_unique = prove_by_refinement( + `!X s. X s /\ (!t. X t ==> (t <= s)) ==> (s = supm X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`X`] supm_UB; + REWRITE_TAC[EMPTY_EXISTS]; + CONJ_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `s` EXISTS_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `(s <= supm X) /\ (supm X <= s)` BACK_TAC; + UNDH 4025 THEN UNDH 5913 THEN REAL_ARITH_TAC; + CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ); + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Sun Jan 16 09:42:06 EST 2005 *) + + ]);; + (* }}} *) + +let euclid2_point = prove_by_refinement( + `!p. euclid 2 p ==> (point (p 0, p 1) = p)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[coord01]; + ]);; + (* }}} *) + +let ymaxQ_exists = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = ymaxQ C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] ymaxQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ymaxQ]; + IMATCH_MP_TAC supm_unique; + CONJ_TAC; + TYPE_THEN `p 0` EXISTS_TAC; + TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_SIMP_TAC[simple_closed_curve_euclid]; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `A = point(x,t)` ABBREV_TAC ; + REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let yminQ_exists = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = yminQ C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] yminQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[yminQ]; + IMATCH_MP_TAC inf_unique; + CONJ_TAC; + TYPE_THEN `p 0` EXISTS_TAC; + TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_SIMP_TAC[simple_closed_curve_euclid]; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `A = point(x,t)` ABBREV_TAC ; + REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let xmaxQ_exists = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xmaxQ C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] xmaxQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[xmaxQ]; + IMATCH_MP_TAC supm_unique; + CONJ_TAC; + TYPE_THEN `p 1` EXISTS_TAC; + TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_SIMP_TAC[simple_closed_curve_euclid]; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `A = point(t,y)` ABBREV_TAC ; + REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let xminQ_exists = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xminQ C))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] xminQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[xminQ]; + IMATCH_MP_TAC inf_unique; + CONJ_TAC; + TYPE_THEN `p 1` EXISTS_TAC; + TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_SIMP_TAC[simple_closed_curve_euclid]; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]); + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `A = point(t,y)` ABBREV_TAC ; + REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let ymaxQ_max = prove_by_refinement( + `!C p. simple_closed_curve top2 C /\ C p ==> (p 1 <= ymaxQ C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[ymaxQ]; + THM_INTRO_TAC[`C`] ymaxQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] supm_UB; + REWRITE_TAC[EMPTY_EXISTS]; + (* -- *) + CONJ_TAC; + TYPE_THEN `p 1` EXISTS_TAC; + TYPE_THEN `p 0` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `p' 1` EXISTS_TAC; + TSPECH `point(x',x)` 1647; + FULL_REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `p 0` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + ]);; + (* }}} *) + +let yminQ_min = prove_by_refinement( + `!C p. simple_closed_curve top2 C /\ C p ==> (yminQ C <= p 1)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[yminQ]; + THM_INTRO_TAC[`C`] yminQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] inf_LB; + REWRITE_TAC[EMPTY_EXISTS]; + (* -- *) + CONJ_TAC; + TYPE_THEN `p 1` EXISTS_TAC; + TYPE_THEN `p 0` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `p' 1` EXISTS_TAC; + TSPECH `point(x',x)` 2887; + FULL_REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `p 0` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + ]);; + (* }}} *) + +let xmaxQ_max = prove_by_refinement( + `!C p. simple_closed_curve top2 C /\ C p ==> (p 0 <= xmaxQ C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[xmaxQ]; + THM_INTRO_TAC[`C`] xmaxQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] supm_UB; + REWRITE_TAC[EMPTY_EXISTS]; + (* -- *) + CONJ_TAC; + TYPE_THEN `p 0` EXISTS_TAC; + TYPE_THEN `p 1` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `p' 0` EXISTS_TAC; + TSPECH `point(x,y)` 3013; + FULL_REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `p 1` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + ]);; + (* }}} *) + +let xminQ_min = prove_by_refinement( + `!C p. simple_closed_curve top2 C /\ C p ==> (xminQ C <= p 0)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[xminQ]; + THM_INTRO_TAC[`C`] xminQexists_lemma; + ASM_REWRITE_TAC[]; + TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] inf_LB; + REWRITE_TAC[EMPTY_EXISTS]; + (* -- *) + CONJ_TAC; + TYPE_THEN `p 0` EXISTS_TAC; + TYPE_THEN `p 1` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + TYPE_THEN `p' 0` EXISTS_TAC; + TSPECH `point(x,y)` 4062; + FULL_REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[]; + (* - *) + FIRST_ASSUM IMATCH_MP_TAC ; + TYPE_THEN `p 1` EXISTS_TAC; + ASM_SIMP_TAC[euclid2_point]; + (* Sun Jan 16 13:15:02 EST 2005 *) + ]);; + (* }}} *) + +extend_simp_rewrites[prove_by_refinement( + `!x. x <=. x`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REAL_ARITH_TAC; + ])];; + (* }}} *) + +let real012 = prove_by_refinement( + `&0 < &1 /\ &0 <= &1 /\ &0 <= &1 / &2 /\ &0 < &1 / &2 /\ &1/ &2 < &1 /\ &1 / &2 <= &1 `, + (* {{{ proof *) + [ + CONJ_TAC; + REAL_ARITH_TAC; + CONJ_TAC; + REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_RDIV; + REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_1; + REAL_ARITH_TAC; + IMATCH_MP_TAC REAL_LE_LDIV; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +extend_simp_rewrites[real012];; + +let simple_closed_curve_nonempty = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (?p. C p)`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_closed_curve]; + KILLH 5825; + TYPE_THEN `f (&0)` EXISTS_TAC; + TYPE_THEN `C` UNABBREV_TAC; + IMATCH_MP_TAC image_imp; + ASM_RSIMP_TAC[]; + ]);; + (* }}} *) + +let simple_closed_curve_2pt = prove_by_refinement( + `!C p. simple_closed_curve top2 C /\ C p ==> (?q. C q /\ ~(q = p))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_closed_curve]; + USEH 5825 GSYM; + TYPE_THEN `~(f (&0) = f( &1 / &2))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[INJ]; + TYPE_THEN `&0 = &1 / &2` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* --- *) + ASM_RSIMP_TAC []; + TYPE_THEN `&0 < &2` SUBAGOAL_TAC; + REAL_ARITH_TAC; + TYPE_THEN `&0 < &1 / &2` SUBAGOAL_TAC; + ASM_RSIMP_TAC[]; + UNDH 4792 THEN UNDH 3735 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `C (f (&1 / &2))` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + IMATCH_MP_TAC image_imp; + ASM_RSIMP_TAC[]; + (* - *) + TYPE_THEN `p = f (&0)` ASM_CASES_TAC; + TYPE_THEN `p` UNABBREV_TAC; + TYPE_THEN `f (&1 / &2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `f (&0)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC image_imp; + ASM_RSIMP_TAC[]; + ]);; + (* }}} *) + +let xmin_le_xmax = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (xminQ C <= xmaxQ C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] xminQ_exists; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`p`] xmaxQ_max; + ASM_REWRITE_TAC[]; + USEH 6458 GSYM; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let ymin_le_ymax = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (yminQ C <= ymaxQ C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] yminQ_exists; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`p`] ymaxQ_max; + ASM_REWRITE_TAC[]; + USEH 4513 GSYM; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let simple_closed_curve_nsubset_arc = prove_by_refinement( + `!C E. simple_closed_curve top2 C /\ simple_arc top2 E ==> + ~(C SUBSET E)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] simple_closed_curve_nonempty; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut; + ASM_REWRITE_TAC[]; + TYPE_THEN `C' SUBSET E /\ C'' SUBSET E` SUBAGOAL_TAC; + TYPE_THEN `C` UNABBREV_TAC; + UNDH 6378 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; + THM_INTRO_TAC[`E`;`p`;`q`;`C'`] cut_arc_unique; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`E`;`p`;`q`;`C''`] cut_arc_unique; + ASM_REWRITE_TAC[]; + TYPE_THEN `cut_arc E p q` UNABBREV_TAC; + TYPE_THEN `C''` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_IDEMPOT]; + TYPE_THEN `C'` UNABBREV_TAC; + THM_INTRO_TAC[`{p,q}`] simple_arc_infinite; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[INFINITE]; + FULL_REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; + ASM_REWRITE_TAC[]; + (* Sun Jan 16 15:22:30 EST 2005 *) + ]);; + (* }}} *) + +let xmin_lt_xmax = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (xminQ C < xmaxQ C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`]; + ASM_SIMP_TAC [xmin_le_xmax]; + THM_INTRO_TAC[`C`] ymin_le_ymax; + ASM_REWRITE_TAC[]; + TYPE_THEN `yminQ C < ymaxQ C` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`]; + ASM_SIMP_TAC[ymin_le_ymax]; + TYPE_THEN `!p. C p ==> (p = point(xminQ C,yminQ C))` SUBAGOAL_TAC; + TYPE_THEN `euclid 2 p` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + USEH 7802 (MATCH_MP point_onto); +(*** Modified by JRH for proper right associativity of "=" + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;REAL_ARITH `x = y = (x <= y) /\ (y <= x)`]; + ***) + ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_LE_ANTISYM]; + TYPE_THEN `(FST p' = p 0) /\ (SND p' = p 1)` SUBAGOAL_TAC; + ASM_REWRITE_TAC[coord01]; + KILLH 5687; + ASM_REWRITE_TAC[]; + CONJ_TAC; + CONJ_TAC; + IMATCH_MP_TAC xmaxQ_max; + ASM_REWRITE_TAC[]; + USEH 5418 GSYM; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC xminQ_min; + ASM_REWRITE_TAC[]; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC ymaxQ_max; + ASM_REWRITE_TAC[]; + TYPE_THEN `ymaxQ C` UNABBREV_TAC; + IMATCH_MP_TAC yminQ_min; + ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`C`] simple_closed_curve_nonempty; + ASM_REWRITE_TAC[]; + COPYH 9414; + TSPECH `p` 9414; + TYPE_THEN `point(xminQ C,yminQ C)` UNABBREV_TAC; + THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* -A BACK ON *) + TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!p. C p ==> (p 0 = xmaxQ C)` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`]; + CONJ_TAC; + IMATCH_MP_TAC xmaxQ_max; + ASM_REWRITE_TAC[]; + TYPE_THEN `xmaxQ C` UNABBREV_TAC; + IMATCH_MP_TAC xminQ_min; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!p. C p ==> (yminQ C <= p 1 /\ p 1 <= ymaxQ C)` SUBAGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC yminQ_min; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC ymaxQ_max; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC; + THM_INTRO_TAC[`C`] yminQ_exists; + ASM_REWRITE_TAC[]; + TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ; + TYPE_THEN `p` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + TSPECH `p` 2734; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `yminQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + TSPECH `point p'` 111; + TYPE_THEN `xmaxQ C` UNABBREV_TAC; + TYPE_THEN `xminQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + (* - *) + TYPE_THEN `C (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC; + THM_INTRO_TAC[`C`] ymaxQ_exists; + ASM_REWRITE_TAC[]; + TYPE_THEN `p = point(xminQ C, ymaxQ C)` BACK_TAC ; + TYPE_THEN `p` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + TSPECH `p` 2734; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `ymaxQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + TSPECH `point p'` 111; + TYPE_THEN `xmaxQ C` UNABBREV_TAC; + TYPE_THEN `xminQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + (* - *) + TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC; + ASM_SIMP_TAC [SUBSET;mk_segment_v]; + TYPE_THEN `x 1` EXISTS_TAC; + TYPE_THEN `yminQ C <= x 1 /\ x 1 <= ymaxQ C ` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + TSPECH `x` 2734; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT;coord01]; + TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[]; + TYPE_THEN `q = point p` ABBREV_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -B *) + THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xminQ C,ymaxQ C))`] simple_closed_curve_nsubset_arc; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + TYPE_THEN `point(xmaxQ C,yminQ C)` EXISTS_TAC; + TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ]; + UNDH 1234 THEN UNDH 5378 THEN REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* Sun Jan 16 15:26:36 EST 2005 *) + + ]);; + (* }}} *) + +let ymin_lt_ymax = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (yminQ C < ymaxQ C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`]; + ASM_SIMP_TAC [ymin_le_ymax]; + THM_INTRO_TAC[`C`] xmin_lt_xmax; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!p. C p ==> (p 1 = ymaxQ C)` SUBAGOAL_TAC; + REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`]; + CONJ_TAC; + IMATCH_MP_TAC ymaxQ_max; + ASM_REWRITE_TAC[]; + TYPE_THEN `ymaxQ C` UNABBREV_TAC; + IMATCH_MP_TAC yminQ_min; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!p. C p ==> (xminQ C <= p 0 /\ p 0 <= xmaxQ C)` SUBAGOAL_TAC; + CONJ_TAC; + IMATCH_MP_TAC xminQ_min; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC xmaxQ_max; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC; + THM_INTRO_TAC[`C`] xminQ_exists; + ASM_REWRITE_TAC[]; + TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ; + TYPE_THEN `p` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + TSPECH `p` 2734; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `xminQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + TSPECH `point p'` 4874; + TYPE_THEN `ymaxQ C` UNABBREV_TAC; + TYPE_THEN `yminQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + (* - *) + TYPE_THEN `C (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC; + THM_INTRO_TAC[`C`] xmaxQ_exists; + ASM_REWRITE_TAC[]; + TYPE_THEN `p = point(xmaxQ C, yminQ C)` BACK_TAC ; + TYPE_THEN `p` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + TSPECH `p` 2734; + USEH 7802 (MATCH_MP point_onto); + TYPE_THEN `p` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT]; + TYPE_THEN `xmaxQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + TSPECH `point p'` 4874; + TYPE_THEN `ymaxQ C` UNABBREV_TAC; + TYPE_THEN `yminQ C` UNABBREV_TAC; + REWRITE_TAC[coord01]; + (* - *) + TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC; + TYPE_THEN `xminQ C <= xmaxQ C` SUBAGOAL_TAC; + UNDH 5679 THEN REAL_ARITH_TAC; + ASM_SIMP_TAC [SUBSET;mk_segment_h]; + TYPE_THEN `x 0` EXISTS_TAC; + TYPE_THEN `xminQ C <= x 0 /\ x 0 <= xmaxQ C ` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + TSPECH `x` 2734; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + REWRITE_TAC[point_inj]; + REWRITE_TAC[PAIR_SPLIT;coord01]; + TYPE_THEN `SND p = point p 1` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + ASM_REWRITE_TAC[]; + TYPE_THEN `q = point p` ABBREV_TAC ; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* -B *) + THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xmaxQ C,yminQ C))`] simple_closed_curve_nsubset_arc; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + TYPE_THEN `point(xminQ C,ymaxQ C)` EXISTS_TAC; + TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ]; + UNDH 5418 THEN UNDH 5679 THEN REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* Sun Jan 16 15:39:56 EST 2005 *) + + ]);; + (* }}} *) + +let simple_closed_curve_closed = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> (closed_ top2 C)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] simple_closed_curve_nonempty; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut; + ASM_REWRITE_TAC[]; + TYPE_THEN `C` UNABBREV_TAC; + IMATCH_MP_TAC closed_union; + REWRITE_TAC[top2_top]; + CONJ_TAC THEN IMATCH_MP_TAC simple_arc_end_closed THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[]; + (* Sun Jan 16 16:43:23 EST 2005 *) + + ]);; + (* }}} *) + +let simple_closed_curve_mk_C = prove_by_refinement( + `!Q. simple_closed_curve top2 Q ==> + ?C v1 v2. simple_arc_end C v1 v2 /\ + (C INTER Q = {v1,v2}) /\ + (v2 1 = yminQ Q) /\ + (v1 1 = ymaxQ Q) /\ + (!x. C x ==> + (x 1 = yminQ Q) \/ (x 1 = ymaxQ Q) \/ (xmaxQ Q < x 0))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `Ca = mk_segment (point(xminQ Q,yminQ Q)) (point(xmaxQ Q + &1,yminQ Q))` ABBREV_TAC ; + (* - *) + TYPE_THEN `xminQ Q <= xmaxQ Q + &1` SUBAGOAL_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `xmaxQ Q` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC xmin_le_xmax; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* - *) + THM_INTRO_TAC[`Ca`;`Ca INTER Q`;`{(point(xmaxQ Q + &1,yminQ Q))}`] simple_arc_end_restriction; + SUBCONJ_TAC; + TYPE_THEN `Ca` UNABBREV_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + THM_INTRO_TAC[`point(xminQ Q,yminQ Q)`;`point(xmaxQ Q + &1,yminQ Q)`] mk_segment_simple_arc_end; + REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT]; + THM_INTRO_TAC[`Q`] xmin_lt_xmax; + ASM_REWRITE_TAC[]; + UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + ASM_MESON_TAC[simple_arc_choose_end]; + IMATCH_MP_TAC simple_closed_curve_closed; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + REWRITE_TAC[INR IN_SING;EQ_EMPTY]; + CONJ_TAC; + IMATCH_MP_TAC closed_point; + REWRITE_TAC[euclid_point]; + (* -- *) + CONJ_TAC; + TYPE_THEN `x` UNABBREV_TAC; + THM_INTRO_TAC[`Q`] xmaxQ_max; + TSPECH `(point (xmaxQ Q + &1, yminQ Q))` 9371; + REWRH 3532; + FULL_REWRITE_TAC[coord01]; + UNDH 3234 THEN REAL_ARITH_TAC; + (* -- *) + CONJ_TAC; + THM_INTRO_TAC[`Q`] yminQ_exists; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `Ca` UNABBREV_TAC; + ASM_SIMP_TAC[mk_segment_h]; + TYPE_THEN `p 0` EXISTS_TAC; + TYPE_THEN `yminQ Q` UNABBREV_TAC; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC xminQ_min; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `xmaxQ Q` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC xmaxQ_max; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + IMATCH_MP_TAC (GSYM euclid2_point); + IMATCH_MP_TAC subset_imp; + TYPE_THEN `Q` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* -- *) + CONV_TAC (dropq_conv "u"); + TYPE_THEN `Ca` UNABBREV_TAC; + ASM_SIMP_TAC[mk_segment_h]; + REWRITE_TAC[point_inj; PAIR_SPLIT;]; + CONV_TAC (dropq_conv "t"); + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* -A *) + TYPE_THEN `Cb = mk_segment(point(xminQ Q,ymaxQ Q)) (point(xmaxQ Q + &1,ymaxQ Q))` ABBREV_TAC ; + THM_INTRO_TAC[`Cb`;`Cb INTER Q`;`{(point(xmaxQ Q + &1,ymaxQ Q))}`] simple_arc_end_restriction; + SUBCONJ_TAC; + TYPE_THEN `Cb` UNABBREV_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + THM_INTRO_TAC[`point(xminQ Q,ymaxQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] mk_segment_simple_arc_end; + REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT]; + THM_INTRO_TAC[`Q`] xmin_lt_xmax; + ASM_REWRITE_TAC[]; + UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC; + ASM_MESON_TAC[]; + (* -- *) + CONJ_TAC; + IMATCH_MP_TAC closed_inter2; + REWRITE_TAC[top2_top]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + ASM_MESON_TAC[simple_arc_choose_end]; + IMATCH_MP_TAC simple_closed_curve_closed; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[EMPTY_EXISTS;INTER;]; + REWRITE_TAC[INR IN_SING;EQ_EMPTY]; + CONJ_TAC; + IMATCH_MP_TAC closed_point; + REWRITE_TAC[euclid_point]; + (* -- *) + CONJ_TAC; + TYPE_THEN `x` UNABBREV_TAC; + THM_INTRO_TAC[`Q`] xmaxQ_max; + TSPECH `(point (xmaxQ Q + &1, ymaxQ Q))` 9371; + REWRH 5576; + FULL_REWRITE_TAC[coord01]; + UNDH 3234 THEN REAL_ARITH_TAC; + (* -- *) + CONJ_TAC; + THM_INTRO_TAC[`Q`] ymaxQ_exists; + ASM_REWRITE_TAC[]; + TYPE_THEN `p` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `Cb` UNABBREV_TAC; + ASM_SIMP_TAC[mk_segment_h]; + TYPE_THEN `p 0` EXISTS_TAC; + TYPE_THEN `ymaxQ Q` UNABBREV_TAC; + (* --- *) + CONJ_TAC; + IMATCH_MP_TAC xminQ_min; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC REAL_LE_TRANS; + TYPE_THEN `xmaxQ Q` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC xmaxQ_max; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + IMATCH_MP_TAC (GSYM euclid2_point); + IMATCH_MP_TAC subset_imp; + TYPE_THEN `Q` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* -- *) + CONV_TAC (dropq_conv "u"); + TYPE_THEN `Cb` UNABBREV_TAC; + ASM_SIMP_TAC[mk_segment_h]; + REWRITE_TAC[point_inj; PAIR_SPLIT;]; + CONV_TAC (dropq_conv "t"); + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + (* -B *) + TYPE_THEN `Cu = mk_segment (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` ABBREV_TAC ; + TYPE_THEN `simple_arc_end Cu (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` SUBAGOAL_TAC; + TYPE_THEN `Cu` UNABBREV_TAC; + IMATCH_MP_TAC mk_segment_simple_arc_end; + REWRITE_TAC[euclid_point]; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + THM_INTRO_TAC[`Q`] ymin_lt_ymax; + ASM_REWRITE_TAC[]; + UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `yminQ Q <= ymaxQ Q` SUBAGOAL_TAC; + IMATCH_MP_TAC ymin_le_ymax; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `v' = point (xmaxQ Q + &1,yminQ Q)` SUBAGOAL_TAC; + USEH 1212 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]); + ASM_REWRITE_TAC[]; + TYPE_THEN `v'` UNABBREV_TAC; + (* - *) + TYPE_THEN `v''' = point (xmaxQ Q + &1,ymaxQ Q)` SUBAGOAL_TAC; + USEH 7634 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]); + ASM_REWRITE_TAC[]; + TYPE_THEN `v'''` UNABBREV_TAC; + (* - *) + THM_INTRO_TAC[`C'`;`Cu`;`v`;`point(xmaxQ Q + &1,yminQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] simple_arc_end_trans; + ASM_REWRITE_TAC[]; + REWRITE_TAC[eq_sing;INR IN_SING;INTER;]; + CONJ_TAC; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_end2; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `Cu` UNABBREV_TAC; + REWRITE_TAC[mk_segment_end]; + TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + USEH 2838 (MATCH_MP point_onto); + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + CONJ_TAC; + TYPE_THEN `Cu` UNABBREV_TAC; + UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_REWRITE_TAC[]; + TYPE_THEN `Ca (point p)` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `Ca` UNABBREV_TAC; + UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_REWRITE_TAC[]; + (* -C *) + TYPE_THEN `((C' UNION Cu) INTER Q = {v}) /\ ((C' UNION Cu) INTER C'' = {(point(xmaxQ Q + &1,ymaxQ Q))}) /\ (v 1 = yminQ Q) /\ (!x. (C' UNION Cu) x ==> (x 1 = yminQ Q) \/ (xmaxQ Q < x 0))` SUBAGOAL_TAC; + CONJ_TAC; + REWRITE_TAC[INTER;eq_sing;INR IN_SING]; + CONJ_TAC; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + USEH 2123 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_REWRITE_TAC[]; + USEH 579 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + USEH 2123 (REWRITE_RULE[eq_sing;INTER;INR IN_SING]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `Cu` UNABBREV_TAC; + TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `Q` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + USEH 2838 (MATCH_MP point_onto); + TYPE_THEN `u` UNABBREV_TAC; + UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]); + FULL_REWRITE_TAC[PAIR_SPLIT;point_inj]; + THM_INTRO_TAC[`Q`] xmaxQ_max; + TSPECH `(point p)` 9371; + REWRH 375; + TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC; + REWRITE_TAC[coord01]; + TYPE_THEN `FST p` UNABBREV_TAC; + TYPE_THEN `point p 0` UNABBREV_TAC; + UNDH 3234 THEN REAL_ARITH_TAC; + (* -- *) + CONJ_TAC; + REWRITE_TAC[eq_sing;INR IN_SING;INTER]; + CONJ_TAC; + CONJ_TAC; + REWRITE_TAC[UNION]; + DISJ2_TAC; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + USEH 2838 (MATCH_MP point_onto); + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + (* --- *) + USEH 311 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `Ca (point p) /\ Cb (point p)` SUBAGOAL_TAC; + CONJ_TAC THEN IMATCH_MP_TAC subset_imp THEN ASM_MESON_TAC[]; + TYPE_THEN `Ca` UNABBREV_TAC; + TYPE_THEN `Cb` UNABBREV_TAC; + UNDH 4559 THEN UNDH 3719 THEN ASM_SIMP_TAC[mk_segment_h]; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `SND p` UNABBREV_TAC; + THM_INTRO_TAC[`Q`] ymin_lt_ymax; + ASM_REWRITE_TAC[]; + UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC; + THM_INTRO_TAC[`p`] (GSYM coord01); + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `Cu` UNABBREV_TAC; + UNDH 5078 THEN ASM_SIMP_TAC[mk_segment_v]; + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_MESON_TAC[]; + TYPE_THEN `Cb (point p)` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C''` EXISTS_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `Cb` UNABBREV_TAC; + UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `!x. C' x ==> (x 1 = yminQ Q)` SUBAGOAL_TAC; + TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `Ca (point p)` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `Ca` UNABBREV_TAC; + UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_REWRITE_TAC[coord01]; + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + (* -- *) + USEH 9465 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + DISJ1_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISJ2_TAC; + IMATCH_MP_TAC (REAL_ARITH `(u + &1 = v) ==> (u < v)`); + TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `Cu` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `Cu` UNABBREV_TAC; + UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_SIMP_TAC[coord01]; + (* -D *) + TYPE_THEN `Cf = C' UNION Cu` ABBREV_TAC ; + KILLH 7427 THEN KILLH 6091 THEN KILLH 7407 THEN KILLH 1428 THEN KILLH 2123 THEN KILLH 7904 THEN KILLH 700 THEN KILLH 3022; + (* - *) + TYPE_THEN `!x. C'' x ==> (x 1 = ymaxQ Q)` SUBAGOAL_TAC; + TYPE_THEN `euclid 2 x` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `Cb (point p)` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `Cb` UNABBREV_TAC; + UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_REWRITE_TAC[coord01]; + (* - *) + TYPE_THEN `C'' INTER Q = {v''}` SUBAGOAL_TAC; + REWRITE_TAC[eq_sing;INR IN_SING;INTER;]; + USEH 6873 (REWRITE_RULE[SUBSET]); + USEH 6548 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`Cf`;`C''`;`v`;`point(xmaxQ Q + &1,ymaxQ Q)`;`v''`] simple_arc_end_trans; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + TYPE_THEN `Cf UNION C''` EXISTS_TAC; + TYPE_THEN `v''` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -E *) + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + REWRITE_TAC[SUBSET;INTER ;INR in_pair;]; + CONJ_TAC; + USEH 3594 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + DISJ1_TAC; + USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + DISJ2_TAC; + USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNION]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_REWRITE_TAC[]; + TYPE_THEN `x` UNABBREV_TAC; + USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_REWRITE_TAC[]; + USEH 3594 (REWRITE_RULE[UNION]); + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* Sun Jan 16 18:43:03 EST 2005 *) + ]);; + (* }}} *) + +let simple_arc_end_IVT = prove_by_refinement( + `!C v w i y. simple_arc_end C v w /\ v i <= y /\ y <= w i ==> + (?u. C u /\ (u i = y)) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] simple_arc_connected; + IMATCH_MP_TAC simple_arc_end_simple; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`i`;`2`] continuous_euclid1; + FULL_REWRITE_TAC[GSYM top2]; + (* - *) + THM_INTRO_TAC[`coord i`;`top2`;`top_of_metric(UNIV,d_real)`;`C`] connect_image; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions]; + (* - *) + TYPE_THEN `!u. C u ==> (IMAGE (coord i) C) (u i)` SUBAGOAL_TAC; + TYPE_THEN `u i = coord i u` SUBAGOAL_TAC; + REWRITE_TAC[coord]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`IMAGE (coord i) C`;`v i`;`w i`] connected_nogap; + ASM_REWRITE_TAC[]; + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* - *) + USEH 9674 (REWRITE_RULE[SUBSET;IMAGE;coord]); + USEH 8862 GSYM; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Mon Jan 17 07:07:14 EST 2005 *) + + ]);; + (* }}} *) + +let simple_closed_curve_mk_ABD = prove_by_refinement( + `!Q v1 v2. simple_closed_curve top2 Q /\ + Q v1 /\ Q v2 /\ (v2 1 = yminQ Q) /\ (v1 1 = ymaxQ Q) ==> + (?A B D w1 w2. + simple_arc_end A v1 v2 /\ + simple_arc_end B v1 v2 /\ + (A UNION B = Q) /\ + (A INTER B = {v1,v2}) /\ + ~(w1 = v1) /\ + ~(w1 = v2) /\ + ~(w2 = v1) /\ + ~(w2 = v2) /\ + A w1 /\ B w2 /\ + simple_arc_end D w1 w2 /\ + (D INTER Q = {w1,w2}) /\ + (!x. D x ==> + (yminQ Q < x 1) /\ (x 1 < ymaxQ Q) /\ (x 0 <= xmaxQ Q)) + )`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `ymid = (yminQ Q + ymaxQ Q)/(&2)` ABBREV_TAC ; + TYPE_THEN `yminQ Q < ymaxQ Q` SUBAGOAL_TAC; + IMATCH_MP_TAC ymin_lt_ymax; + ASM_REWRITE_TAC[]; + TYPE_THEN `yminQ Q < ymid /\ ymid < ymaxQ Q` SUBAGOAL_TAC; + TYPE_THEN `ymid` UNABBREV_TAC; + CONJ_TAC THENL[IMATCH_MP_TAC real_middle1_lt;IMATCH_MP_TAC real_middle2_lt] THEN ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~(v1 = v2)` SUBAGOAL_TAC; + TYPE_THEN `v2` UNABBREV_TAC; + TYPE_THEN `v1 1` UNABBREV_TAC; + UNDH 6716 THEN UNDH 6486 THEN REAL_ARITH_TAC; + (* - *) + THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_cut; + ASM_REWRITE_TAC[]; + TYPE_THEN `A = C'` ABBREV_TAC ; + TYPE_THEN `C'` UNABBREV_TAC; + TYPE_THEN `B = C''` ABBREV_TAC ; + TYPE_THEN `C''` UNABBREV_TAC; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `C = mk_segment (point(xminQ Q,ymid)) (point(xmaxQ Q,ymid))` ABBREV_TAC ; + TYPE_THEN `xminQ Q <= xmaxQ Q` SUBAGOAL_TAC; + IMATCH_MP_TAC xmin_le_xmax; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`(point(xminQ Q,ymid))`;`point(xmaxQ Q,ymid)`] mk_segment_simple_arc_end; + REWRITE_TAC[point_inj;PAIR_SPLIT;euclid_point]; + TYPE_THEN `xminQ Q < xmaxQ Q` SUBAGOAL_TAC; + IMATCH_MP_TAC xmin_lt_xmax; + ASM_REWRITE_TAC[]; + UNDH 3331 THEN UNDH 9105 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + TYPE_THEN `C` UNABBREV_TAC; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `!x. C x ==> (x 1 = ymid)` SUBAGOAL_TAC; + TSPECH `x` 2734; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `C` UNABBREV_TAC; + UNDH 3980 THEN (ASM_SIMP_TAC[mk_segment_h]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_REWRITE_TAC[coord01]; + (* -A *) + TYPE_THEN `!x. C x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q` SUBAGOAL_TAC; + TSPECH `x` 2734; + USEH 1837 (MATCH_MP point_onto); + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `C` UNABBREV_TAC; + UNDH 3980 THEN UNDH 8406 THEN (SIMP_TAC[mk_segment_h]); + FULL_REWRITE_TAC[point_inj;PAIR_SPLIT]; + ASM_REWRITE_TAC[coord01]; + (* - *) + THM_INTRO_TAC[`C`;`A INTER C`;`B INTER C`] simple_arc_end_restriction; + ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[] top2_top; + TYPE_THEN `!E v v'. simple_arc_end E v v' ==> closed_ top2 E` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC closed_inter2; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC closed_inter2; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER;EMPTY_EXISTS]; + REWRITE_TAC[EQ_EMPTY]; + CONJ_TAC; + TYPE_THEN `(x 1 = ymid)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + TSPECH `x` 6622 ; + USEH 3537 (REWRITE_RULE[INTER;INR in_pair]); + REWRH 6257; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `v2 1` UNABBREV_TAC; + UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `v1 1` UNABBREV_TAC; + UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC; + (* -- *) + TYPE_THEN `!E. simple_arc_end E v1 v2 /\ (E SUBSET Q) ==> (?u. C u /\ E u)` BACK_TAC; + CONJ_TAC; + UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`A`]); + ASM_REWRITE_TAC[]; + TYPE_THEN `Q` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; + ASM_MESON_TAC[]; + UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`B`]); + ASM_REWRITE_TAC[]; + TYPE_THEN `Q` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[]; + ASM_MESON_TAC[]; + (* --B intermediate value theorem needed *) + THM_INTRO_TAC[`E`;`v2`;`v1`;`1`;`ymid`] simple_arc_end_IVT; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + UNDH 3172 THEN UNDH 8976 THEN REAL_ARITH_TAC; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `C` UNABBREV_TAC; + TYPE_THEN `euclid 2 u` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `E` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + USEH 2838 (MATCH_MP point_onto); + TYPE_THEN `u` UNABBREV_TAC; + UNDH 8406 THEN SIMP_TAC[mk_segment_h]; + REWRITE_TAC[point_inj;PAIR_SPLIT]; + TYPE_THEN `FST p` EXISTS_TAC; + USEH 6779 GSYM; + ASM_REWRITE_TAC[coord01]; + (* -- *) + TYPE_THEN `Q (point p)` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + THM_INTRO_TAC[`Q`;`point p`] xminQ_min; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`Q`;`point p`] xmaxQ_max; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM coord01]; + (* -C *) + TYPE_THEN `D = C'''` ABBREV_TAC ; + TYPE_THEN `C'''` UNABBREV_TAC; + TYPE_THEN `w1 = v` ABBREV_TAC ; + TYPE_THEN `v` UNABBREV_TAC; + TYPE_THEN `w2 = v'` ABBREV_TAC ; + TYPE_THEN `v'` UNABBREV_TAC; + TYPE_THEN `D` EXISTS_TAC; + TYPE_THEN `w1` EXISTS_TAC; + TYPE_THEN `w2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `A w1 /\ B w2` SUBAGOAL_TAC; + USEH 5104 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + USEH 7194 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `D INTER Q = {w1,w2}` SUBAGOAL_TAC; + TYPE_THEN `Q` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;UNION;INR in_pair]; + UNDH 5104 THEN UNDH 7194 THEN UNDH 2332 THEN (REWRITE_TAC [eq_sing;INR IN_SING;INTER;SUBSET]) THEN MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(!x. D x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q)` SUBAGOAL_TAC; + TYPE_THEN `C x` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* -D *) + TYPE_THEN `~(v1 1 = ymid)` SUBAGOAL_TAC; + TYPE_THEN `v1 1` UNABBREV_TAC; + UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC; + TYPE_THEN `~(v2 1 = ymid)` SUBAGOAL_TAC; + TYPE_THEN `v2 1` UNABBREV_TAC; + UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC; + (* - *) + TYPE_THEN `!w. D w ==> (w 1 = ymid)` SUBAGOAL_TAC; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC; + USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 5003 (REWRITE_RULE[INTER;INR in_pair]); + UNDH 6817 THEN MESON_TAC[]; + TYPE_THEN `!w v. (D w) /\ ~(v 1 = ymid) ==> ~(w = v)` SUBAGOAL_TAC; + TYPE_THEN `v''` UNABBREV_TAC; + UNDH 5813 THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + (* Mon Jan 17 07:35:06 EST 2005 *) + ]);; + (* }}} *) + +let one_sided_jordan_curve = jordan_def `one_sided_jordan_curve Q <=> + (!v w. euclid 2 v /\ euclid 2 w /\ ~Q v /\ ~Q w /\ ~(v = w) ==> + (?C. simple_arc_end C v w /\ (C INTER Q = EMPTY)))`;; + +let simple_closed_curve_mk_E = prove_by_refinement( + `!Q C D . simple_closed_curve top2 Q /\ one_sided_jordan_curve Q /\ + ~(C SUBSET Q) /\ ~(D SUBSET Q) /\ + simple_arc top2 C /\ simple_arc top2 D /\ (C INTER D = EMPTY) ==> + (?E x1 x2. simple_arc_end E x1 x2 /\ + (E INTER C = {x2}) /\ (E INTER D = {x1}) /\ (E INTER Q = EMPTY))`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + TYPE_THEN `?c. C c /\ ~Q c` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + TYPE_THEN `?d. D d /\ ~Q d` SUBAGOAL_TAC; + FULL_REWRITE_TAC[SUBSET]; + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[one_sided_jordan_curve]; + (* - *) + TYPE_THEN `!R x. simple_arc top2 R /\ R x ==> euclid 2 x` SUBAGOAL_TAC; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `R` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_euclid; + ASM_REWRITE_TAC[]; + (* - *) + UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`c`;`d`]); + ASM_REWRITE_TAC[]; + USEH 6641 (REWRITE_RULE[INTER;EQ_EMPTY]); + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`C'`;`C`;`D`] simple_arc_end_restriction; + ASM_REWRITE_TAC[EMPTY_EXISTS; INTER_EMPTY; ]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + IMATCH_MP_TAC simple_arc_choose_end; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_closed; + IMATCH_MP_TAC simple_arc_choose_end; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER]; + CONJ_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_end; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_end2; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -A *) + TYPE_THEN `E = C''` ABBREV_TAC ; + TYPE_THEN `C''` UNABBREV_TAC; + TYPE_THEN `E` EXISTS_TAC; + TYPE_THEN `v'` EXISTS_TAC; + TYPE_THEN `v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + (* - *) + UNDH 3420 THEN UNDH 5123 THEN (REWRITE_TAC[EQ_EMPTY;INTER;SUBSET]) THEN MESON_TAC[]; + (* Mon Jan 17 08:50:35 EST 2005 *) + ]);; + + (* }}} *) + +let jordan_curve_k33_data = jordan_def + `jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 <=> + simple_closed_curve top2 Q /\ + simple_arc_end A v1 v2 /\ + simple_arc_end B v1 v2 /\ + simple_arc_end C v1 v2 /\ + simple_arc_end D w1 w2 /\ + simple_arc_end E x1 x2 /\ + ~(w1 = v1) /\ + ~(w1 = v2) /\ + ~(w2 = v1) /\ + ~(w2 = v2) /\ + A w1 /\ B w2 /\ + (A UNION B = Q) /\ + (A INTER B = {v1,v2}) /\ + (D INTER Q = {w1,w2}) /\ + (C INTER D = EMPTY) /\ + (C INTER Q = {v1,v2}) /\ + (E INTER C = {x2}) /\ + (E INTER D = {x1}) /\ + (E INTER Q = EMPTY)`;; + + +let jordan_curve_k33_data_exist = prove_by_refinement( + `!Q. simple_closed_curve top2 Q /\ one_sided_jordan_curve Q ==> + (?A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2)`, + (* {{{ proof *) + [ + REWRITE_TAC[jordan_curve_k33_data]; + THM_INTRO_TAC[`Q`] simple_closed_curve_mk_C; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_curve_mk_ABD; + ASM_REWRITE_TAC[]; + USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 7606 (REWRITE_RULE[INTER;INR in_pair]); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B` EXISTS_TAC; + TYPE_THEN `C` EXISTS_TAC; + TYPE_THEN `D` EXISTS_TAC; + (* - *) + TYPE_THEN `C INTER D = EMPTY` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + USEH 7282 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + TSPECH `u` 3184; + TSPECH `u` 9655; + UNDH 1134 THEN UNDH 2424 THEN UNDH 920 THEN UNDH 4468 THEN REAL_ARITH_TAC; + (* - *) + THM_INTRO_TAC[`Q`;`C`;`D`] simple_closed_curve_mk_E; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + TYPE_THEN `simple_arc top2 D` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `!R y1 y2. (R INTER Q = {y1,y2}) /\ simple_arc_end R y1 y2 ==> ~(R SUBSET Q)` SUBAGOAL_TAC; + TYPE_THEN `R SUBSET {y1,y2}` SUBAGOAL_TAC; + USEH 842 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + UNDH 4643 THEN UNDH 5847 THEN (REWRITE_TAC [SUBSET;INR in_pair;INTER]) THEN MESON_TAC[]; + TYPE_THEN `FINITE R` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{y1,y2}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_RULES;FINITE_INSERT]; + THM_INTRO_TAC[`R`] simple_arc_infinite; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + FULL_REWRITE_TAC[INFINITE]; + ASM_MESON_TAC[]; + CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* -A *) + TYPE_THEN `E` EXISTS_TAC; + TYPE_THEN `v1` EXISTS_TAC; + TYPE_THEN `v2` EXISTS_TAC; + TYPE_THEN `w1` EXISTS_TAC; + TYPE_THEN `w2` EXISTS_TAC; + TYPE_THEN `x1` EXISTS_TAC; + TYPE_THEN `x2` EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Mon Jan 17 09:26:35 EST 2005 *) + + ]);; + (* }}} *) + +let has_size_insert = prove_by_refinement( + `!X (x:A) n. ~(X x) /\ X HAS_SIZE n ==> + (x INSERT X HAS_SIZE SUC n)`, + (* {{{ proof *) + [ + REWRITE_TAC[HAS_SIZE]; + ASM_SIMP_TAC [FINITE_RULES]; + TYPE_THEN `n` UNABBREV_TAC; + IMATCH_MP_TAC (GSYM card_suc_insert); + ASM_REWRITE_TAC[]; + (* Mon Jan 17 09:33:11 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_x = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + ~(Q x1) /\ ~(Q x2) /\ ~(A x1) /\ ~(A x2) /\ ~(B x1) /\ ~(B x2) /\ + ~C x1 /\ C x2 /\ D x1 /\ ~D x2 /\ E x1 /\ E x2`, + (* {{{ proof *) + [ + REWRITE_TAC[jordan_curve_k33_data]; + TYPE_THEN `E x1 /\ E x2` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_end]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~Q x1 /\ ~Q x2` SUBAGOAL_TAC; + USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]); + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~A x1 /\ ~A x2 /\ ~B x1 /\ ~B x2` SUBAGOAL_TAC; + TYPE_THEN `Q` UNABBREV_TAC; + FULL_REWRITE_TAC[UNION;DE_MORGAN_THM;]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `D x1` SUBAGOAL_TAC; + USEH 4975 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); + ASM_REWRITE_TAC[]; + TYPE_THEN `C x2` SUBAGOAL_TAC; + USEH 1536 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]); + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`E`;`x1`;`x2`] simple_arc_end_distinct; + ASM_REWRITE_TAC[]; + CONJ_TAC; + USEH 1536 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_MESON_TAC[]; + USEH 4975 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]); + ASM_MESON_TAC[]; + (* Mon Jan 17 09:56:00 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_v = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + Q v1 /\ Q v2 /\ A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2 /\ + ~D v1 /\ ~D v2 /\ ~E v1 /\ ~E v2`, + (* {{{ proof *) + [ + REWRITE_TAC[jordan_curve_k33_data]; + TYPE_THEN `A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + ASM_REWRITE_TAC[]; + TYPE_THEN `Q v1 /\ Q v2` SUBAGOAL_TAC; + TYPE_THEN `Q` UNABBREV_TAC; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~E v1 /\ ~E v2` SUBAGOAL_TAC; + USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]); + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 5003 (REWRITE_RULE[INTER;INR in_pair]); + ASM_MESON_TAC[]; + (* Mon Jan 17 10:06:12 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_w = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + Q w1 /\ Q w2 /\ A w1 /\ ~A w2 /\ ~B w1 /\ B w2 /\ ~C w1 /\ ~C w2 /\ + D w1 /\ D w2 /\ ~E w1 /\ ~E w2`, + (* {{{ proof *) + [ + REWRITE_TAC[jordan_curve_k33_data]; + ASM_REWRITE_TAC[]; + TYPE_THEN `Q w1 /\ Q w2` SUBAGOAL_TAC; + TYPE_THEN `Q` UNABBREV_TAC; + REWRITE_TAC[UNION]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~E w1 /\ ~E w2` SUBAGOAL_TAC; + USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER;]); + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~C w1 /\ ~C w2` SUBAGOAL_TAC; + USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 7606 (REWRITE_RULE[INTER;INR in_pair]); + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 6622 (REWRITE_RULE[INTER;INR in_pair]); + ASM_MESON_TAC[]; + (* Mon Jan 17 10:14:46 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_AP_size3 = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + ({w1,w2,x2} HAS_SIZE 3)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + COPYH 2122; + USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); + (* - *) + TYPE_THEN `{w1,w2,x2} = x2 INSERT {w1,w2}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_INSERT]; + MESON_TAC[]; + TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC; + ARITH_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC has_size_insert; + REWRITE_TAC[INR in_pair]; + REWRITE_TAC[DE_MORGAN_THM]; + (* - *) + CONJ_TAC; + ASM_MESON_TAC[jordan_curve_w;jordan_curve_x]; + (* - *) + IMATCH_MP_TAC pair_size_2; + ASM_MESON_TAC[jordan_curve_w]; + (* Mon Jan 17 10:18:45 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_BP_size3 = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + ({v1,v2,x1} HAS_SIZE 3)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + COPYH 2122; + USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); + (* - *) + TYPE_THEN `{v1,v2,x1} = x1 INSERT {v1,v2}` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_INSERT]; + MESON_TAC[]; + TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC; + ARITH_TAC ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC has_size_insert; + REWRITE_TAC[INR in_pair]; + REWRITE_TAC[DE_MORGAN_THM]; + (* - *) + CONJ_TAC; + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_v); + USEH 2122 (MATCH_MP jordan_curve_x); + UNDH 2724 THEN UNDH 3425 THEN UNDH 7579 THEN MESON_TAC[]; + (* - *) + IMATCH_MP_TAC pair_size_2; + USEH 2191 (MATCH_MP simple_arc_end_distinct); + ASM_MESON_TAC[]; + (* Mon Jan 17 10:26:14 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_AP_BP_empty = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + ({w1,w2,x2} INTER {v1,v2,x1} = EMPTY)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + COPYH 2122; + USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `(u = x2) \/ (u = x1) \/ ({w1,w2} u /\ {v1,v2} u)` SUBAGOAL_TAC; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + FULL_REWRITE_TAC[INR IN_INSERT]; + UNDH 911 THEN UNDH 96 THEN UNDH 5829 THEN UNDH 4124 THEN UNDH 8311 THEN MESON_TAC[]; + (* - *) + UNDH 7992 THEN REP_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[INR IN_INSERT]; + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_v); + USEH 2122 (MATCH_MP jordan_curve_x); + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[INR IN_INSERT]; + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_w); + USEH 2122 (MATCH_MP jordan_curve_x); + ASM_MESON_TAC[]; + (* - *) + FULL_REWRITE_TAC[INR IN_INSERT]; + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_w); + USEH 2122 (MATCH_MP jordan_curve_v); + ASM_MESON_TAC[]; + (* Mon Jan 17 10:36:27 EST 2005 *) + + ]);; + (* }}} *) + +let has_size_drop_le = prove_by_refinement( + `!n X (x:A) . FINITE X /\ CARD X <=| n ==> + FINITE (x INSERT X) /\ CARD (x INSERT X) <=| SUC n`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + ASM_SIMP_TAC[CARD_CLAUSES]; + CONJ_TAC; + ASM_MESON_TAC[FINITE_RULES]; + COND_CASES_TAC; + UNDH 2770 THEN ARITH_TAC; + UNDH 2770 THEN ARITH_TAC; + (* Mon Jan 17 10:45:48 EST 2005 *) + ]);; + (* }}} *) + +let has_size_le9 = prove_by_refinement( + `!(x1:A) x2 x3 x4 x5 x6 x7 x8 x9. + CARD {x1,x2,x3,x4,x5,x6,x7,x8,x9} <=| 9 /\ + FINITE {x1,x2,x3,x4,x5,x6,x7,x8,x9}`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`0`;`EMPTY:A->bool`;`x9`] has_size_drop_le; + REWRITE_TAC[FINITE_RULES;CARD_CLAUSES]; + ARITH_TAC; + (* - *) + THM_INTRO_TAC[`SUC 0`;`{x9}`;`x8`] has_size_drop_le; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`SUC(SUC 0)`;`{x8,x9}`;`x7`] has_size_drop_le; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`SUC(SUC(SUC 0))`;`{x7,x8,x9}`;`x6`] has_size_drop_le; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`SUC(SUC(SUC(SUC 0)))`;`{x6,x7,x8,x9}`;`x5`] has_size_drop_le; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC 0))))`;`{x5,x6,x7,x8,x9}`;`x4`] has_size_drop_le; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC 0)))))`;`{x4,x5,x6,x7,x8,x9}`;`x3`] has_size_drop_le; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC 0))))))`;`{x3,x4,x5,x6,x7,x8,x9}`;`x2`] has_size_drop_le; + ASM_REWRITE_TAC[]; +THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC(SUC 0)))))))`;`{x2,x3,x4,x5,x6,x7,x8,x9}`;`x1`] has_size_drop_le; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + UNDH 457 THEN ARITH_TAC; + (* Mon Jan 17 10:58:38 EST 2005 *) + + ]);; + (* }}} *) + +let card_surj_bij = prove_by_refinement( + `!(f:A->B) X Y . FINITE X /\ CARD X <=| CARD Y /\ + (!y. Y y ==> ?x. X x /\ (f x = y)) ==> + BIJ f X Y`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`f`;`X`] CARD_IMAGE_LE; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`f`;`X`] FINITE_IMAGE; + ASM_REWRITE_TAC[]; + TYPE_THEN `Y SUBSET IMAGE f X` SUBAGOAL_TAC; + REWRITE_TAC[SUBSET;IMAGE]; + ASM_MESON_TAC[]; + TYPE_THEN `FINITE Y` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `CARD Y <=| CARD (IMAGE f X)` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET; + ASM_REWRITE_TAC[]; + TYPE_THEN `(CARD Y = CARD (IMAGE f X)) /\ (CARD (IMAGE f X) = CARD X)` SUBAGOAL_TAC; + UNDH 5809 THEN UNDH 8940 THEN UNDH 3182 THEN ARITH_TAC; + (* - *) + TYPE_THEN `Y = IMAGE f X` SUBAGOAL_TAC; + IMATCH_MP_TAC CARD_SUBSET_EQ; + ASM_REWRITE_TAC[]; + (* - *) + REWRITE_TAC[BIJ]; + TYPE_THEN `SURJ f X Y` SUBAGOAL_TAC; + REWRITE_TAC[SURJ]; + TYPE_THEN `Y` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + REWRITE_TAC[INJ]; + CONJ_TAC; + IMATCH_MP_TAC image_imp; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + TYPE_THEN `Z = X DELETE x` ABBREV_TAC ; + (* -A *) + TYPE_THEN `IMAGE f Z = Y` SUBAGOAL_TAC; + TYPE_THEN `Y` UNABBREV_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + IMATCH_MP_TAC IMAGE_SUBSET; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[DELETE;SUBSET]; + ASM_REWRITE_TAC[]; + (* -- *) + REWRITE_TAC[SUBSET;IMAGE]; + TYPE_THEN `x'` UNABBREV_TAC; + TYPE_THEN `x'' = x` ASM_CASES_TAC; + TYPE_THEN `x''` UNABBREV_TAC; + TYPE_THEN `y` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[DELETE]; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `x''` EXISTS_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[DELETE]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `FINITE Z` SUBAGOAL_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + REWRITE_TAC[FINITE_DELETE]; + ASM_REWRITE_TAC[]; + TYPE_THEN `CARD Z <| CARD X` SUBAGOAL_TAC; + THM_INTRO_TAC[`x`;`X`] CARD_SUC_DELETE; + ASM_REWRITE_TAC[]; + TYPE_THEN `Z` UNABBREV_TAC; + UNDH 481 THEN ARITH_TAC; + (* - *) + TYPE_THEN `CARD Y <= CARD Z` SUBAGOAL_TAC; + TYPE_THEN `Y` UNABBREV_TAC; + IMATCH_MP_TAC CARD_IMAGE_LE; + ASM_REWRITE_TAC[]; + UNDH 9361 THEN UNDH 6773 THEN UNDH 7923 THEN UNDH 193 THEN ARITH_TAC; + (* Mon Jan 17 15:04:48 EST 2005 *) + + ]);; + (* }}} *) + +let select_inter = jordan_def + `select_inter A C = @x. A (x:A) /\ C x` ;; + +let k33f = jordan_def + `k33f (A:A->bool) B E = (select_inter A E, select_inter B E)`;; + +let incf = jordan_def + `incf (f:A-> (B#B)) E = { (FST (f E)) , (SND(f E)) }`;; + +let k33f_value = prove_by_refinement( + `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==> + (k33f A B E = (a,b))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[k33f;PAIR_SPLIT]; + CONJ_TAC; + REWRITE_TAC[select_inter]; + USEH 5597 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 9224 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[select_inter]; + USEH 6985 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 5555 (REWRITE_RULE[INTER;INR IN_SING]); + ASM_REWRITE_TAC[]; + (* Mon Jan 17 15:18:50 EST 2005 *) + ]);; + (* }}} *) + +let incf_value = prove_by_refinement( + `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==> + (incf (k33f A B) E = {a,b})`, + (* {{{ proof *) + [ + REWRITE_TAC[incf]; + THM_INTRO_TAC[`A`;`B`;`E`;`a`;`b`] k33f_value; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* Mon Jan 17 15:22:22 EST 2005 *) + ]);; + (* }}} *) + +let incf_V = prove_by_refinement( + `!(A:A->bool) B E . SING(A INTER E) /\ SING(B INTER E) ==> + (incf (k33f A B) E = E INTER (A UNION B))`, + (* {{{ proof *) + [ + REWRITE_TAC[SING]; + THM_INTRO_TAC[`A`;`B`;`E`;`x`;`x'`] incf_value; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNION_OVER_INTER]; + ONCE_REWRITE_TAC[INTER_COMM]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[UNION;INR IN_SING;INR in_pair]; + MESON_TAC[]; + (* Mon Jan 17 15:31:21 EST 2005 *) + ]);; + (* }}} *) + +let k33f_E = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + ({w1,w2,x2} INTER E = {x2}) /\ + ({v1,v2,x1} INTER E = {x1}) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + COPYH 2122; + USEH 2122(MATCH_MP jordan_curve_w); + COPYH 2122; + USEH 2122(MATCH_MP jordan_curve_x); + USEH 2122(MATCH_MP jordan_curve_v); + CONJ_TAC; + REWRITE_TAC[INTER;INR IN_INSERT;eq_sing]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[INTER;INR IN_INSERT;eq_sing]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* Mon Jan 17 15:40:01 EST 2005 *) + ]);; + (* }}} *) + +let k33f_cut_lemma = prove_by_refinement( + `!C v1 v2 w A B. simple_arc_end C v1 v2 /\ + C w /\ ~(w = v1) /\ ~(w = v2) /\ + (A INTER C = {v1,v2}) /\ + (B INTER C = {w}) ==> + (A INTER (cut_arc C v1 w) = {v1}) /\ + (B INTER (cut_arc C v1 w) = {w}) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + USEH 8436 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + THM_INTRO_TAC[`C`;`w`;`v1`;`v2`] cut_arc_inter; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[eq_sing;INR IN_INSERT;INTER;]; + (* - *) + TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + (* - *) + TYPE_THEN `C v1 /\ C v2 ` SUBAGOAL_TAC; + ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2]; + (* - *) + TYPE_THEN `simple_arc_end (cut_arc C v1 w) v1 w` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `simple_arc_end (cut_arc C v2 w) v2 w` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `cut_arc C v1 w SUBSET C ` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + TYPE_THEN `cut_arc C v2 w SUBSET C ` SUBAGOAL_TAC; + IMATCH_MP_TAC cut_arc_subset; + ASM_REWRITE_TAC[]; + (* -A *) + TYPE_THEN `cut_arc C w v1 = cut_arc C v1 w` SUBAGOAL_TAC; + MESON_TAC [cut_arc_symm]; + TYPE_THEN `cut_arc C w v1` UNABBREV_TAC; + TYPE_THEN `cut_arc C w v2 = cut_arc C v2 w` SUBAGOAL_TAC; + MESON_TAC [cut_arc_symm]; + TYPE_THEN `cut_arc C w v2` UNABBREV_TAC; + (* - *) + CONJ_TAC; + CONJ_TAC; + CONJ_TAC; + ASM_MESON_TAC[]; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + TYPE_THEN `C u` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TSPECH `u` 2825; + REWRH 9519; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `u` UNABBREV_TAC; + UNDH 6835 THEN DISCH_THEN (THM_INTRO_TAC[`v2`]); + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* - *) + UNDH 6153 THEN DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[subset_imp]; + (* Mon Jan 17 16:10:38 EST 2005 *) + + ]);; + (* }}} *) + +let k33f_cut = prove_by_refinement( + `!C v1 v2 w A B. simple_arc_end C v1 v2 /\ + C w /\ ~(w = v1) /\ ~(w = v2) /\ + (A INTER C = {v1,v2}) /\ + (B INTER C = {w}) ==> + (A INTER (cut_arc C v1 w) = {v1}) /\ + (B INTER (cut_arc C v1 w) = {w}) /\ + (A INTER (cut_arc C v2 w) = {v2}) /\ + (B INTER (cut_arc C v2 w) = {w})`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`v1`;`v2`;`w`;`A`;`B`] k33f_cut_lemma; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`v2`;`v1`;`w`;`A`;`B`] k33f_cut_lemma; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INR IN_INSERT]; + MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* Mon Jan 17 16:13:48 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_k33 = jordan_def + `jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2 = + mk_graph_t ({w1,w2,x2} UNION {v1,v2,x1}, + {E, + (cut_arc A v1 w1), (cut_arc A v2 w1), + (cut_arc B v1 w2), (cut_arc B v2 w2), + (cut_arc C v1 x2), (cut_arc C v2 x2), + (cut_arc D w1 x1),( cut_arc D w2 x1)}, + (\ e. {(FST (k33f {w1,w2,x2} {v1,v2,x1} e)), + (SND (k33f {w1,w2,x2} {v1,v2,x1} e)) }))`;; + +let jordan_curve_AP_euclid = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + {w1,w2,x2} UNION {v1,v2,x1} SUBSET euclid 2`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + COPYH 2122; + USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); + REWRITE_TAC[UNION;SUBSET;INR IN_INSERT]; + IMATCH_MP_TAC subset_imp; + TYPE_THEN `simple_arc top2 A /\ simple_arc top2 D /\ simple_arc top2 E` SUBAGOAL_TAC; + REPEAT CONJ_TAC THEN IMATCH_MP_TAC simple_arc_end_simple THEN ASM_MESON_TAC[]; + USEH 9474 (MATCH_MP simple_arc_euclid); + USEH 6512 (MATCH_MP simple_arc_euclid); + USEH 7513 (MATCH_MP simple_arc_euclid); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_x); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_v); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_w); + UNDH 2244 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN ASM_MESON_TAC[]; + (* Mon Jan 17 17:05:26 EST 2005 *) + ]);; + + (* }}} *) + +let cut_arc_simple2 = prove_by_refinement( + `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==> + simple_arc top2 (cut_arc C v w)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`;`v`;`w`] cut_arc_simple; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_simple; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let jordan_curve_k33_plane_criterion = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + (graph G) /\ + (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\ + (SING ({v1,v2,x1} INTER e))) /\ + (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> + e INTER e' SUBSET graph_vertex G) ==> + plane_graph G + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + REWRITE_TAC[plane_graph]; + ASM_REWRITE_TAC[]; + TYPE_THEN `G` UNABBREV_TAC; + FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph]; + CONJ_TAC; + IMATCH_MP_TAC jordan_curve_AP_euclid; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + REWRITE_TAC[SUBSET;INR IN_INSERT]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + FULL_REWRITE_TAC[jordan_curve_k33_data]; + ASM_MESON_TAC[simple_arc_end_simple]; + KILLH 8072; + (* -- *) + TYPE_THEN `simple_arc top2 A /\ simple_arc top2 B /\ simple_arc top2 C /\ simple_arc top2 D` SUBAGOAL_TAC; + FULL_REWRITE_TAC[jordan_curve_k33_data]; + REPEAT CONJ_TAC THEN IMATCH_MP_TAC simple_arc_end_simple THEN ASM_MESON_TAC[]; + (* -- *) + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_v); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_x); + USEH 2122 (MATCH_MP jordan_curve_w); + UNDH 9236 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN IMATCH_MP_TAC cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + (* -A *) + TYPE_THEN `{(FST (k33f {w1, w2, x2} {v1, v2, x1} e)), (SND (k33f {w1, w2, x2} {v1, v2, x1} e))} = (incf (k33f {w1, w2,x2} {v1,v2,x1} ) e)` SUBAGOAL_TAC; + REWRITE_TAC[incf]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC incf_V; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* Mon Jan 17 17:27:23 EST 2005 *) + + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* SECTION DD *) +(* ------------------------------------------------------------------ *) + + +let cartesian_size = prove_by_refinement( + `!(A:A->bool) (B:B->bool) m n. A HAS_SIZE m /\ B HAS_SIZE n ==> + cartesian A B HAS_SIZE (m *| n)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`A`;`B`] CARD_PRODUCT; + FULL_REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[IN]; + TYPE_THEN `cartesian A B = {(x,y) | A x /\ B y}` SUBAGOAL_TAC; + REWRITE_TAC[cartesian]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[]; + (* - *) + IMATCH_MP_TAC (INR FINITE_PRODUCT); + ASM_REWRITE_TAC[]; + (* Mon Jan 17 19:37:49 EST 2005 *) + + ]);; + + (* }}} *) + +let jordan_k33f_bij = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==> + (BIJ (k33f {w1,w2,x2} {v1,v2,x1}) + (graph_edge G) + (cartesian {w1,w2,x2} {v1,v2,x1})) /\ + (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\ + (SING ({v1,v2,x1} INTER e))) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `G` UNABBREV_TAC; + TYPE_THEN `L = (graph_edge (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))` ABBREV_TAC ; + FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph]; + (* - *) + COPYH 2122; + USEH 2122 (MATCH_MP k33f_E); + (* - *) + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_x); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_v); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_w); + COPYH 2122; + USEH 2122 (REWRITE_RULE [jordan_curve_k33_data]); + (* -A *) + THM_INTRO_TAC[`A`;`v1`;`v2`;`w1`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INTER;INR IN_INSERT]; + CONJ_TAC THEN ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`B`;`v1`;`v2`;`w2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INTER;INR IN_INSERT]; + CONJ_TAC THEN ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`C`;`v1`;`v2`;`x2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(x2 = v1 ) /\ ~(x2 = v2)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INTER;INR IN_INSERT]; + CONJ_TAC THEN ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`D`;`w1`;`w2`;`x1`;`{w1,w2,x2}`;`{v1,v2,x1}`] k33f_cut; + ASM_REWRITE_TAC[]; + TYPE_THEN `~(x1 = w1 ) /\ ~(x1 = w2)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INTER;INR IN_INSERT]; + CONJ_TAC THEN ASM_MESON_TAC[]; + (* -B *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + CONJ_TAC; + TYPE_THEN `L` UNABBREV_TAC; + USEH 3555 (REWRITE_RULE[INR IN_INSERT]); + TYPE_THEN `!U V (x:num->real). (U INTER V = {x}) ==> (SING (U INTER V))` SUBAGOAL_TAC; + REWRITE_TAC[SING]; + UNIFY_EXISTS_TAC ; + ASM_REWRITE_TAC[]; + (* -- *) + UNDH 4488 THEN DISCH_THEN (fun t-> RULE_ASSUM_TAC (fun s -> try (MATCH_MP t s) with failure -> s)); + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + KILLH 4869; + UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_REWRITE_TAC[] ; + (* -C *) + IMATCH_MP_TAC card_surj_bij ; + (* - *) + SUBCONJ_TAC; + TYPE_THEN `L` UNABBREV_TAC; + REWRITE_TAC[FINITE_INSERT;FINITE_RULES]; + (* - *) + TYPE_THEN ` (cartesian {w1, w2, x2} {v1, v2, x1}) HAS_SIZE (3 *| 3)` SUBAGOAL_TAC; + IMATCH_MP_TAC cartesian_size; + CONJ_TAC; + IMATCH_MP_TAC jordan_curve_AP_size3; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC jordan_curve_BP_size3; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + TYPE_THEN `L` UNABBREV_TAC; + FULL_REWRITE_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[]; + TYPE_THEN `3 *| 3 = 9` SUBAGOAL_TAC; + ARITH_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[has_size_le9]; + (* -D *) + TYPE_THEN `(y = (w1,v1)) \/ (y = (w1,v2)) \/ (y = (w1,x1)) \/ (y = (w2,v1)) \/ (y = (w2,v2)) \/ (y = (w2,x1)) \/ (y = (x2,v1)) \/ (y = (x2,v2)) \/ (y = (x2,x1))` SUBAGOAL_TAC; + FULL_REWRITE_TAC[cartesian]; + TYPE_THEN `y` UNABBREV_TAC; + REWRITE_TAC[PAIR_SPLIT]; + USEH 8489 (REWRITE_RULE[INR IN_INSERT]); + USEH 7329 (REWRITE_RULE[INR IN_INSERT]); + UNDH 1878 THEN UNDH 8866 THEN MESON_TAC[]; + (* - *) + TYPE_THEN `?x. L x /\ ({w1,w2,x2} INTER x = {(FST y)}) /\ ({v1,v2,x1} INTER x = {(SND y)})` BACK_TAC; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`{w1,w2,x2}`;`{v1,v2,x1}`;`x`;`FST y`;`SND y`] k33f_value; + ASM_REWRITE_TAC[]; + USEH 5894 (REWRITE_RULE[]); + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `L` UNABBREV_TAC; + REWRITE_TAC[INR IN_INSERT]; + UNDH 7966 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `y` UNABBREV_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]; + (* Mon Jan 17 20:01:06 EST 2005 *) + ]);; + + (* }}} *) + +let jordan_curve_k33_isk33 = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + graph_isomorphic k33_graph + (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)`, + (* {{{ proof *) + [ + REWRITE_TAC[jordan_curve_k33]; + IMATCH_MP_TAC k33_iso; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC jordan_curve_AP_size3; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC jordan_curve_BP_size3; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + CONJ_TAC; + IMATCH_MP_TAC jordan_curve_AP_BP_empty; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2`] jordan_k33f_bij; + ASM_REWRITE_TAC[]; + KILLH 2219; + FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;]; + TYPE_THEN `fn = k33f {w1,w2,x2} {v1,v2,x1}` ABBREV_TAC ; + TYPE_THEN `(\ e. fn e) = fn` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + ASM_REWRITE_TAC[]; + (* Mon Jan 17 20:12:31 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_k33_data_inter = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + (A INTER B = {v1,v2}) /\ + (A INTER C = {v1,v2}) /\ + (A INTER D = {w1}) /\ + (A INTER E = EMPTY) /\ + (B INTER C = {v1,v2}) /\ + (B INTER D = {w2}) /\ + (B INTER E = EMPTY) /\ + (C INTER D = EMPTY) /\ + (C INTER E = {x2}) /\ + (D INTER E = {x1})`, + (* {{{ proof *) + [ + REWRITE_TAC[jordan_curve_k33_data]; + FULL_REWRITE_TAC[INTER_COMM]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(A INTER E = EMPTY ) /\ (B INTER E = EMPTY)` SUBAGOAL_TAC; + TYPE_THEN `Q` UNABBREV_TAC; + USEH 2576 (REWRITE_RULE[INTER;UNION;EQ_EMPTY]); + REWRITE_TAC[EQ_EMPTY;INTER]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(A INTER C = {v1, v2}) /\ (B INTER C = {v1, v2})` SUBAGOAL_TAC; + ONCE_REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INTER;INR IN_INSERT]; + USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 7606 (REWRITE_RULE[INTER;INR IN_INSERT]); + TYPE_THEN `Q` UNABBREV_TAC; + FULL_REWRITE_TAC[UNION]; + USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]); + CONJ_TAC THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* -A *) + REWRITE_TAC[INTER;eq_sing;INR IN_INSERT]; + TYPE_THEN `Q` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + USEH 1691 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 4348 (REWRITE_RULE[INTER;UNION;INR IN_INSERT]); + USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]); + USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]); + ASM_MESON_TAC[]; + (* Mon Jan 17 20:35:28 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_edge_inter = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + (!e e'. {A,B,C,D,E} e /\ {A,B,C,D,E} e' /\ ~(e = e') ==> + (e INTER e' SUBSET ({w1,w2,x2} UNION {v1,v2,x1})))`, + (* {{{ proof *) + [ + REWRITE_TAC[INR IN_INSERT]; + TYPE_THEN `V = {w1, w2, x2} UNION {v1, v2, x1}` ABBREV_TAC ; + TYPE_THEN `{v1,v2} SUBSET V /\ {w1} SUBSET V /\ EMPTY SUBSET V /\ {w2} SUBSET V /\ {x2} SUBSET V /\ {x1} SUBSET V` SUBAGOAL_TAC; + TYPE_THEN `V` UNABBREV_TAC; + REWRITE_TAC[SUBSET;UNION;INR IN_INSERT]; + REPEAT CONJ_TAC THEN MESON_TAC[]; + (* - *) + JOIN 2 1 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]; + USEH 2122 (MATCH_MP jordan_curve_k33_data_inter); + UNDH 4732 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN TYPE_THEN `e'` UNABBREV_TAC THEN FULL_REWRITE_TAC[] THEN ASM_REWRITE_TAC[INTER_COMM ] THEN ASM_MESON_TAC[]; + (* Mon Jan 17 20:46:56 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_k33_plane_criterion2 = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> + e INTER e' SUBSET graph_vertex G) ==> + plane_graph G`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC jordan_curve_k33_plane_criterion; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + SUBCONJ_TAC; + THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph; + REWRITE_TAC[k33_isgraph]; + TYPE_THEN `G` UNABBREV_TAC; + IMATCH_MP_TAC jordan_curve_k33_isk33; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `G` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* - *) + ASM_MESON_TAC[jordan_k33f_bij]; + (* Tue Jan 18 06:14:19 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_edge_arc = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G e. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + (graph_edge G e) ==> (simple_arc top2 e)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `G` UNABBREV_TAC; + FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33]; + FULL_REWRITE_TAC[INR IN_INSERT]; + COPYH 2122; + USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); + RULE_ASSUM_TAC (fun s-> try (MATCH_MP simple_arc_end_simple s) with failure -> s); + (* - *) + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `e` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + KILLH 4869; + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_x); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_v); + COPYH 2122; + USEH 2122 (MATCH_MP jordan_curve_w); + UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN IMATCH_MP_TAC cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + (* Tue Jan 18 06:28:31 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_guider_inj = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G e U V. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + (graph_edge G e) /\ {A,B,C,D,E} U /\ {A,B,C,D,E} V /\ + (e SUBSET U) /\ (e SUBSET V) ==> (U = V) `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `INFINITE e` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_infinite; + IMATCH_MP_TAC jordan_curve_edge_arc; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(U INTER V) SUBSET ({w1,w2,x2} UNION {v1,v2,x1})` SUBAGOAL_TAC; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_edge_inter; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `e SUBSET {w1, w2, x2} UNION {v1, v2, x1}` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `U INTER V` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC [SUBSET;INTER]; + ASM_MESON_TAC[subset_imp]; + (* - *) + TYPE_THEN `FINITE ({w1, w2, x2} UNION {v1, v2, x1})` SUBAGOAL_TAC; + REWRITE_TAC[ FINITE_UNION]; + REWRITE_TAC[FINITE_RULES;FINITE_INSERT]; + TYPE_THEN `FINITE e` SUBAGOAL_TAC; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{w1, w2, x2} UNION {v1, v2, x1}` EXISTS_TAC; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[INFINITE]; + ASM_MESON_TAC[]; + (* Tue Jan 18 06:3282:02 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_guider_disj = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(A = E) /\ ~(B = C) /\ + ~(B = D) /\ ~(B = E) /\ ~(C = D) /\ ~(C = E) /\ ~(D = E)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_k33_data_inter; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[DE_MORGAN_THM]; + (* - *) + TYPE_THEN `INFINITE A /\ INFINITE B /\ INFINITE C /\ INFINITE D /\ INFINITE E` SUBAGOAL_TAC; + FULL_REWRITE_TAC[jordan_curve_k33_data]; + RULE_ASSUM_TAC (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s); + RULE_ASSUM_TAC (fun s -> try (MATCH_MP simple_arc_infinite s) with failure -> s); + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `FINITE (A INTER B) /\ FINITE (A INTER C) /\ FINITE (A INTER D) /\ FINITE (A INTER E) /\ FINITE (B INTER C) /\ FINITE (B INTER D) /\ FINITE (B INTER E) /\ FINITE (C INTER D) /\ FINITE(C INTER E) /\ FINITE (D INTER E)` SUBAGOAL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_RULES;FINITE_INSERT]; + FULL_REWRITE_TAC[INFINITE]; + (* - *) + KILLH 3523 THEN KILLH 1286 THEN KILLH 6641 THEN KILLH 4962 THEN KILLH 3223 THEN KILLH 6941 THEN KILLH 9399 THEN KILLH 3259 THEN KILLH 8436 THEN KILLH 2195 THEN KILLH 2122; + UNDH 5285 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TRY (TYPE_THEN `A` UNABBREV_TAC) THEN TRY (TYPE_THEN `B` UNABBREV_TAC) THEN TRY (TYPE_THEN `C` UNABBREV_TAC) THEN TRY (TYPE_THEN `D` UNABBREV_TAC) THEN FULL_REWRITE_TAC[INTER_IDEMPOT] THEN ASM_MESON_TAC[]; + (* Tue Jan 18 07:01:04 EST 2005 *) + + ]);; + (* }}} *) + +let jordan_curve_guider_enum = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==> + (E SUBSET E) /\ + (cut_arc A v1 w1 SUBSET A) /\ + (cut_arc A v2 w1 SUBSET A) /\ + (cut_arc B v1 w2 SUBSET B) /\ + (cut_arc B v2 w2 SUBSET B) /\ + (cut_arc C v1 x2 SUBSET C) /\ + (cut_arc C v2 x2 SUBSET C) /\ + (cut_arc D w1 x1 SUBSET D) /\ + (cut_arc D w2 x1 SUBSET D)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET_REFL]; + COPYH 2122; + USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]); + RULE_ASSUM_TAC (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s); + COPYH 2122 ; + USEH 2122 (MATCH_MP jordan_curve_x); + COPYH 2122 ; + USEH 2122 (MATCH_MP jordan_curve_v); + COPYH 2122 ; + USEH 2122 (MATCH_MP jordan_curve_w); + REPEAT CONJ_TAC THEN IMATCH_MP_TAC cut_arc_subset THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + (* Tue Jan 18 07:12:33 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_guider_exists = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G e. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + graph_edge G e ==> + (?U. {A,B,C,D,E} U /\ e SUBSET U)`, + (* {{{ proof *) + [ + REWRITE_TAC[INR IN_INSERT]; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum; + ASM_REWRITE_TAC[]; + TYPE_THEN `G` UNABBREV_TAC; + FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33]; + FULL_REWRITE_TAC[INR IN_INSERT]; + UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[]; + (* Tue Jan 18 07:43:50 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_guider_sep_lemma = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G e . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + graph_edge G e ==> + (((e SUBSET A) ==> (e = cut_arc A v1 w1) \/ (e = cut_arc A v2 w1)) /\ + ((e SUBSET B) ==> (e = cut_arc B v1 w2) \/ (e = cut_arc B v2 w2)) /\ + ((e SUBSET C) ==> (e = cut_arc C v1 x2) \/ (e = cut_arc C v2 x2)) /\ + ((e SUBSET D) ==> (e = cut_arc D w1 x1) \/ (e = cut_arc D w2 x1)) /\ + ((e SUBSET E) ==> (e = E))) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_disj; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_inj; + REWRH 1245; + TYPE_THEN `G` UNABBREV_TAC; + FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;INR IN_INSERT]; + REPEAT CONJ_TAC THEN UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_MESON_TAC[]; + (* Tue Jan 18 09:38:07 EST 2005 *) + ]);; + (* }}} *) + +let cut_arc_inter_lemma = prove_by_refinement( + `!X R u v w. X u /\ + simple_arc_end R v w /\ R u /\ ~(u = v) /\ ~(u = w) ==> + (cut_arc R v u INTER cut_arc R w u SUBSET X)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`R`;`u`;`v`;`w`] cut_arc_inter; + ASM_REWRITE_TAC[]; + TYPE_THEN `cut_arc R u w = cut_arc R w u` SUBAGOAL_TAC; + MESON_TAC[cut_arc_symm]; + TYPE_THEN `cut_arc R u w` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;INR IN_SING]; + TYPE_THEN `x` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* Tue Jan 18 09:55:17 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_cut_inter = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==> + (cut_arc A v1 w1 INTER cut_arc A v2 w1 SUBSET graph_vertex G) /\ + (cut_arc B v1 w2 INTER cut_arc B v2 w2 SUBSET graph_vertex G) /\ + (cut_arc C v1 x2 INTER cut_arc C v2 x2 SUBSET graph_vertex G) /\ + (cut_arc D w1 x1 INTER cut_arc D w2 x1 SUBSET graph_vertex G) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `G` UNABBREV_TAC; + FULL_REWRITE_TAC[graph_vertex_mk_graph;jordan_curve_k33]; + COPYH 2122 ; + COPYH 2122 ; + COPYH 2122 ; + USEH 2122 (MATCH_MP jordan_curve_x); + USEH 2122 (MATCH_MP jordan_curve_v); + USEH 2122 (MATCH_MP jordan_curve_w); + FULL_REWRITE_TAC[jordan_curve_k33_data]; + REPEAT CONJ_TAC THEN IMATCH_MP_TAC cut_arc_inter_lemma THEN ASM_REWRITE_TAC[UNION;INR IN_INSERT ] THEN ASM_MESON_TAC[] ; + (* Tue Jan 18 10:00:14 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_guider_separate = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G U e e'. + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\ + {A,B,C,D,E} U /\ e SUBSET U /\ e' SUBSET U /\ + graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> + (e INTER e' SUBSET graph_vertex G) + `, + (* {{{ proof *) + [ + REP_BASIC_TAC; + TYPE_THEN `?a b. ((e = a) \/ (e = b)) /\ ((e' = a) \/ (e' = b)) /\ (a INTER b SUBSET graph_vertex G)` BACK_TAC; + TYPE_THEN `((e = a) /\ (e' = b)) \/ ((e = b) /\ (e' = a))` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + FIRST_ASSUM DISJ_CASES_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `e` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + FULL_REWRITE_TAC[INTER_COMM]; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`] jordan_curve_cut_inter; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_sep_lemma ; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e'`] jordan_curve_guider_sep_lemma ; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[INR IN_INSERT]; + TYPE_THEN `U = E` ASM_CASES_TAC; + TYPE_THEN `U` UNABBREV_TAC; + TYPE_THEN `E` UNABBREV_TAC; + TYPE_THEN `e'` UNABBREV_TAC; + UNDH 4836 THEN MESON_TAC[]; + REWRH 4440; + TYPE_THEN `G` UNABBREV_TAC; + UNDH 7811 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `U` UNABBREV_TAC THEN REP_BASIC_TAC; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + KILLH 2881; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + KILLH 2881 THEN KILLH 1255; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + KILLH 2881 THEN KILLH 1255 THEN KILLH 2514; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* Tue Jan 18 10:22:53 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_k33_plane = prove_by_refinement( + `!Q A B C D E v1 v2 w1 w2 x1 x2 G . + jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\ + (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==> + plane_graph G`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + IMATCH_MP_TAC jordan_curve_k33_plane_criterion2; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `(?U. {A,B,C,D,E} U /\ e SUBSET U)` SUBAGOAL_TAC; + IMATCH_MP_TAC jordan_curve_guider_exists; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; +TYPE_THEN `(?U'. {A,B,C,D,E} U' /\ e' SUBSET U')` SUBAGOAL_TAC; + IMATCH_MP_TAC jordan_curve_guider_exists; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `U = U'` ASM_CASES_TAC; + TYPE_THEN `U'` UNABBREV_TAC; + IMATCH_MP_TAC jordan_curve_guider_separate; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `U INTER U'` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC subset_inter_pair; + ASM_REWRITE_TAC[]; + REWRITE_TAC[jordan_curve_k33;graph_vertex_mk_graph]; + ASM_MESON_TAC[jordan_curve_edge_inter]; + (* Tue Jan 18 10:32:34 EST 2005 *) + ]);; + (* }}} *) + +let jordan_curve_not_one_sided = prove_by_refinement( + `!Q. simple_closed_curve top2 Q ==> ~(one_sided_jordan_curve Q)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`Q`] jordan_curve_k33_data_exist; + ASM_REWRITE_TAC[]; + TYPE_THEN `plane_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC; + IMATCH_MP_TAC jordan_curve_k33_plane; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `graph_isomorphic k33_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC; + IMATCH_MP_TAC jordan_curve_k33_isk33; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[] k33_nonplanar; + FULL_REWRITE_TAC[planar_graph]; + UNDH 3419 THEN ASM_REWRITE_TAC[]; + UNIFY_EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC graph_isomorphic_symm; + ASM_REWRITE_TAC[]; + REWRITE_TAC[k33_isgraph]; + (* Tue Jan 18 10:43:40 EST 2005 *) + ]);; + + (* }}} *) + +(* +Tue Jan 18 10:44:07 EST 2005 + +I'M DONE! The Jordan Curve Theorem is proved. + +The statements jordan_curve_not_one_sided + and jordan_curve_no_inj3 give a form of the Jordan Curve Theorem. + +Now lets put it in a simple form. + +*) + +let component_simple_arc_ver2 = prove_by_refinement( + `!G x y. (closed_ top2 G ) /\ ~(x = y) ==> + (component (induced_top top2 (euclid 2 DIFF G)) x y <=> + (?C. simple_arc_end C x y /\ + (C INTER G = EMPTY)))`, + (* {{{ proof *) + [ + (* + string together :component-imp-connected, connected-induced2, + p_conn_conn, p_conn_hv_finite; + other_direction : simple_arc_connected, connected-induced, + connected-component; *) + REP_BASIC_TAC; + ASSUME_TAC top2_top; + THM_INTRO_TAC[`top2`;`(euclid 2 DIFF G)`] induced_top_top; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `top2 (euclid 2 DIFF G)` SUBAGOAL_TAC; + USEH 4142 (MATCH_MP closed_open); + FULL_REWRITE_TAC[top2_unions;open_DEF ]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `A = euclid 2 DIFF G` ABBREV_TAC ; + TYPE_THEN `UNIONS (induced_top top2 A) = A` SUBAGOAL_TAC; + THM_INTRO_TAC[`top2`;`A`] induced_top_support; + ASM_REWRITE_TAC[top2_unions;]; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;DIFF]; + MESON_TAC[]; + (* - *) + IMATCH_MP_TAC EQ_ANTISYM; + CONJ_TAC; + THM_INTRO_TAC[`induced_top top2 A`;`x`] component_imp_connected; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`(top2)`;`A`;`(component (induced_top top2 A) x)`] connected_induced2; + ASM_REWRITE_TAC[top2_unions]; + IMATCH_MP_TAC SUBSET_TRANS; + TYPE_THEN `UNIONS (induced_top top2 A)` EXISTS_TAC; + CONJ_TAC; + KILLH 9392; + REWRITE_TAC[component_unions]; + UNDH 250 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]); + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF;SUBSET]; + ASM_REWRITE_TAC[]; + REWRH 486; + (* --A *) + TYPE_THEN `B = component (induced_top top2 A) x` ABBREV_TAC ; + TYPE_THEN `B x /\ B y` SUBAGOAL_TAC; + TYPE_THEN `B` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`(induced_top top2 A)`;`x`;`y`] component_replace; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC component_symm; + ASM_REWRITE_TAC[]; + (* -- *) + ASSUME_TAC loc_path_conn_top2; + TYPE_THEN `top_of_metric(A,d_euclid) = (induced_top top2 A)` SUBAGOAL_TAC; + REWRITE_TAC[top2]; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + IMATCH_MP_TAC top_of_metric_induced; + TYPE_THEN `A` UNABBREV_TAC; + REWRITE_TAC[DIFF;SUBSET]; + MESON_TAC[metric_euclid]; + (* -- *) + TYPE_THEN `loc_path_conn (induced_top top2 A)` SUBAGOAL_TAC; + THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid; + FULL_REWRITE_TAC[top2]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* -- *) + THM_INTRO_TAC[`top2`] loc_path_conn; + REWRH 6586; + TSPECH `A` 7522; + REWRH 4569; + TSPECH `x` 6750; + TYPE_THEN `A x` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `top2 B` SUBAGOAL_TAC; + TYPE_THEN `B` UNABBREV_TAC; + ASM_MESON_TAC[path_eq_conn]; + (* --B *) + THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn; + ASM_REWRITE_TAC[]; + (* -- *) + THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite; + ASM_MESON_TAC[]; + REWRH 7914; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + FULL_REWRITE_TAC[EMPTY_EXISTS;INTER]; + TYPE_THEN `B u` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `A u` SUBAGOAL_TAC; + ASM_MESON_TAC[subset_imp]; + TYPE_THEN `A` UNABBREV_TAC; + USEH 1911 (REWRITE_RULE[DIFF]); + ASM_MESON_TAC[]; + (* -C *) + (* other_direction : simple_arc_connected, connected-induced, + connected-component; *) + THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`] simple_arc_connected; + ASM_REWRITE_TAC[]; + TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC; + IMATCH_MP_TAC simple_arc_euclid; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2; + ASM_REWRITE_TAC[top2_unions]; + REWRH 8620; + (* - *) + TYPE_THEN `C SUBSET A` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + ASM_REWRITE_TAC[DIFF_SUBSET]; + REWRH 9619; + (* - *) + THM_INTRO_TAC[`induced_top top2 A`;`C`;`x`] connected_component; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + USEH 5951(REWRITE_RULE[SUBSET]); + TSPECH `y` 4625; + FIRST_ASSUM IMATCH_MP_TAC ; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* Tue Jan 18 12:54:06 EST 2005 *) + + ]);; + (* }}} *) + +let component_properties = prove_by_refinement( + `!C A v. closed_ top2 C /\ (euclid 2 v) /\ ~C v /\ + (A = component (induced_top top2 (euclid 2 DIFF C)) v) ==> + top2 A /\ connected top2 A /\ + ~(A = EMPTY) /\ (A INTER C = EMPTY) /\ A v /\ + (A SUBSET euclid 2) /\ + (!w. ~(w = v) ==> + (A w = (?P. simple_arc_end P v w /\ (P INTER C = EMPTY))))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + (* - *) + ASSUME_TAC top2_top; + (* -A *) + THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support; + FULL_REWRITE_TAC[top2_unions]; + (* - *) + TYPE_THEN `euclid 2 INTER (euclid 2 DIFF C) = euclid 2 DIFF C` SUBAGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[INTER;DIFF]; + MESON_TAC[]; + REWRH 972; + KILLH 105; + (* - *) + TYPE_THEN `top2 (euclid 2 DIFF C)` SUBAGOAL_TAC; + THM_INTRO_TAC[`top2`;`C`] (REWRITE_RULE[open_DEF] closed_open); + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[top2_unions]; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`2`;`(euclid 2 DIFF C)`] loc_path_conn_euclid; + REWRITE_TAC[GSYM top2]; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`2`;`euclid 2`] loc_path_conn_euclid; + REWRITE_TAC[GSYM top2]; + THM_INTRO_TAC[`top2`] top_univ; + REWRITE_TAC[top2_top]; + FULL_REWRITE_TAC[top2_unions]; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[GSYM top2]; + (* - *) + USEH 7343 GSYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `A v` SUBAGOAL_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC component_refl THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[DIFF]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC THENL[ REWRITE_TAC[EMPTY_EXISTS];ALL_TAC]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* -B *) + TYPE_THEN `A INTER C = EMPTY` SUBAGOAL_TAC; + THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions; + REWRH 7860; + UNDH 4798 THEN REWRITE_TAC[INTER;SUBSET;DIFF;EQ_EMPTY] THEN MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `A SUBSET euclid 2` SUBAGOAL_TAC; + THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions; + REWRH 7860; + UNDH 4798 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `top_of_metric(euclid 2 DIFF C,d_euclid) = induced_top top2 (euclid 2 DIFF C)` SUBAGOAL_TAC; + REWRITE_TAC[top2]; + IMATCH_MP_TAC (GSYM top_of_metric_induced); + REWRITE_TAC[metric_euclid]; + REWRITE_TAC[DIFF;SUBSET] THEN MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`2`;`euclid 2 DIFF C`] loc_path_euclid_cor; + REWRITE_TAC[GSYM top2]; + ASM_REWRITE_TAC[]; + (* - *) + THM_INTRO_TAC[`top2`] loc_path_conn; + REWRH 6586; + SUBCONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + USEH 7626 GSYM; + USEH 4421 GSYM; + ASM_REWRITE_TAC[]; + USEH 1238 GSYM; + ASM_REWRITE_TAC[]; + FIRST_ASSUM IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[DIFF]; + ASM_REWRITE_TAC[]; + (* -C *) + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + SUBCONJ_TAC; + TYPE_THEN `A` UNABBREV_TAC; + IMATCH_MP_TAC component_simple_arc_ver2; + ASM_REWRITE_TAC[]; + (* - *) + TYPE_THEN `A = UNIONS ({v} INSERT {P | (?w. simple_arc_end P v w) /\ (P INTER C = {}) })` SUBAGOAL_TAC; + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNIONS]; + TYPE_THEN `x = v` ASM_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + TYPE_THEN `{v}` EXISTS_TAC; + REWRITE_TAC[INR IN_INSERT]; + TSPECH `x` 9360; + REWRH 8744; + TYPE_THEN`P` EXISTS_TAC; + REWRITE_TAC[INR IN_INSERT]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + DISJ2_TAC; + ASM_MESON_TAC[simple_arc_end_simple]; + IMATCH_MP_TAC simple_arc_end_end2; + ASM_MESON_TAC[]; + (* -- *) + REWRITE_TAC[UNIONS;INR IN_INSERT;SUBSET]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + FULL_REWRITE_TAC[INR IN_INSERT]; + TYPE_THEN `x` UNABBREV_TAC; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `x = v` ASM_CASES_TAC; + ASM_MESON_TAC[]; + TSPECH `x` 9360; + ASM_REWRITE_TAC[]; + (* -- *) + TYPE_THEN `x = w` ASM_CASES_TAC; + TYPE_THEN `x` UNABBREV_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `cut_arc u v x` EXISTS_TAC; + (* -- *) + SUBCONJ_TAC; + IMATCH_MP_TAC cut_arc_simple; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end]; + (* -- *) + THM_INTRO_TAC[`u`;`v`;`x`] cut_arc_subset; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end]; + ASM_REWRITE_TAC[]; + UNDH 4401 THEN UNDH 2627 THEN REWRITE_TAC[SUBSET;INTER;EQ_EMPTY] THEN MESON_TAC[]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC connected_unions_common; + (* -D *) + CONJ_TAC; + FULL_REWRITE_TAC[INR IN_INSERT]; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `Z` UNABBREV_TAC; + IMATCH_MP_TAC connected_sing; + ASM_REWRITE_TAC[top2_unions]; + IMATCH_MP_TAC simple_arc_connected; + ASM_MESON_TAC[simple_arc_end_simple]; + (* - *) + UNDH 281 THEN REWRITE_TAC[INTER;EMPTY_EXISTS]; + TYPE_THEN `v` EXISTS_TAC; + FULL_REWRITE_TAC[INR IN_INSERT]; + TYPE_THEN `!Z. (Z = {v}) \/ (?w. simple_arc_end Z v w) /\ (Z INTER C = EMPTY) ==> Z v` SUBAGOAL_TAC; + FIRST_ASSUM DISJ_CASES_TAC; + TYPE_THEN `Z''` UNABBREV_TAC; + REWRITE_TAC[INR IN_SING]; + IMATCH_MP_TAC simple_arc_end_end; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* Tue Jan 18 19:38:27 EST 2005 *) + ]);; + (* }}} *) + +let JORDAN_CURVE_THEOREM = prove_by_refinement( + `!C. simple_closed_curve top2 C ==> + (?A B. top2 A /\ top2 B /\ + connected top2 A /\ connected top2 B /\ + ~(A = EMPTY) /\ ~(B = EMPTY) /\ + (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\ + (B INTER C = EMPTY) /\ + (A UNION B UNION C = euclid 2))`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + THM_INTRO_TAC[`C`] jordan_curve_not_one_sided; + ASM_REWRITE_TAC[]; + FULL_REWRITE_TAC[one_sided_jordan_curve]; + ASM_REWRITE_TAC[]; + (* - *) + LEFTH 1701 "v"; + LEFTH 7038 "w"; + TYPE_THEN `euclid 2 v /\ euclid 2 w /\ ~C v /\ ~C w /\ ~(v = w) /\ (!C'. simple_arc_end C' v w ==> ~(C' INTER C = EMPTY))` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + KILLH 9332; + (* - *) + TYPE_THEN `A = component (induced_top top2 (euclid 2 DIFF C)) v` ABBREV_TAC ; + TYPE_THEN `A` EXISTS_TAC; + TYPE_THEN `B = component (induced_top top2 (euclid 2 DIFF C)) w` ABBREV_TAC ; + TYPE_THEN `B` EXISTS_TAC; + (* - *) + ASSUME_TAC top2_top; + (* -A *) + THM_INTRO_TAC[`C`] simple_closed_curve_closed; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`A`;`v`] component_properties; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`C`;`B`;`w`] component_properties; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* - *) + SUBCONJ_TAC; + PROOF_BY_CONTR_TAC; + USEH 2797 (REWRITE_RULE[INTER;EMPTY_EXISTS]); + TYPE_THEN `u = v` ASM_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + TSPECH `v` 8396; + REWRH 1610; + TSPECH `P` 3407; + UNDH 3395 THEN DISCH_THEN (THM_INTRO_TAC[]); + IMATCH_MP_TAC simple_arc_end_symm; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* -- *) + TYPE_THEN `u = w` ASM_CASES_TAC; + TYPE_THEN `u` UNABBREV_TAC; + TSPECH `w` 9360; + REWRH 3625; + ASM_MESON_TAC[simple_arc_end_symm]; + (* -- *) + TYPE_THEN `A` UNABBREV_TAC; + TYPE_THEN `B` UNABBREV_TAC; + USEH 9617 (MATCH_MP component_replace); + USEH 8370 (MATCH_MP component_replace); + TSPECH `v` 2427; + TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) w` UNABBREV_TAC; + TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) u` UNABBREV_TAC; + TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) v v` SUBAGOAL_TAC; + IMATCH_MP_TAC component_refl; + ASM_REWRITE_TAC[]; + THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support; + FULL_REWRITE_TAC[top2_unions]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC [INTER;DIFF]; + REWRH 4538; + USEH 1851 (MATCH_MP simple_arc_end_symm); + ASM_MESON_TAC[]; + (* -B *) + IMATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[union_subset]; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC simple_closed_curve_euclid; + ASM_REWRITE_TAC[]; + (* - *) + PROOF_BY_CONTR_TAC; + USEH 2025 (REWRITE_RULE[SUBSET;UNION]); + LEFTH 2615 "x"; + TYPE_THEN `euclid 2 x /\ ~A x /\ ~ B x /\ ~ C x` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + (* - *) + THM_INTRO_TAC[`v`;`w`;`x`] three_t_enum; + TYPE_THEN `INJ f UNIV (euclid 2) /\ (!i. ~C (f i)) /\ (!i j A. simple_arc_end A (f i) (f j) ==> ~(A INTER C = {}))` ASM_CASES_TAC ; + ASM_MESON_TAC[jordan_curve_no_inj3]; + UNDH 6935 THEN ASM_REWRITE_TAC[]; + (* -C *) + TYPE_THEN `~(x = w) /\ ~(x = v) /\ ~(v = w)` SUBAGOAL_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + SUBCONJ_TAC; + REWRITE_TAC[INJ]; + CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ THEN ASM_MESON_TAC[]; IMATCH_MP_TAC three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; + (* - *) + TYPE_THEN `!C'. simple_arc_end C' v x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `!C'. simple_arc_end C' w x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `!x A. ~simple_arc_end A x x` SUBAGOAL_TAC; + USEH 3186 (MATCH_MP simple_arc_end_distinct); + ASM_MESON_TAC[]; + KILLH 8396 THEN KILLH 9360 THEN KILLH 3221 THEN KILLH 4325; + IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`); + (* - *) + TYPE_THEN `!C' w v. simple_arc_end C' w v = simple_arc_end C' v w` SUBAGOAL_TAC; + MESON_TAC[simple_arc_end_symm]; + CONJ_TAC THENL [IMATCH_MP_TAC three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] ; ALL_TAC]; + TYPE_THEN `!i. ~(C (f i))` SUBAGOAL_TAC THENL [IMATCH_MP_TAC three_t_univ THEN ASM_REWRITE_TAC[];ALL_TAC]; + ASM_MESON_TAC[]; + (* Tue Jan 18 20:44:12 EST 2005 *) + ]);; + (* }}} *) + +(* collect together the definitions in a single theorem. + We leave out the definitions in the HOL-light distribution + such as abs , sqrt, sum, + IMAGE, INJ, INTER, EMPTY, UNION, SUBSET, UNIONS. *) + +let JORDAN_CURVE_DEFS = prove_by_refinement( + `(!x. euclid 2 x = (!n. 2 <=| n ==> (x n = &0))) /\ + (top2 = top_of_metric (euclid 2,d_euclid)) /\ + (!(X:A->bool) d. top_of_metric (X,d) = + {A | ?F. F SUBSET open_balls (X,d) /\ (A = UNIONS F) }) /\ + (!(X:A->bool) d. open_balls(X,d) = + {B | ?x r. (B = open_ball (X,d) x r) }) /\ + (!X d (x:A) r. open_ball (X,d) x r = + {y | X x /\ X y /\ d x y < r}) /\ + (!U (Z:A->bool). connected U Z <=> + Z SUBSET UNIONS U /\ + (!A B. + U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B + ==> Z SUBSET A \/ Z SUBSET B)) /\ + (!(C:A->bool) U. simple_closed_curve U C = + (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\ + continuous f (top_of_metric (UNIV,d_real)) U /\ + INJ f {x | &0 <= x /\ x < &1} (UNIONS U) /\ + (f (&0) = f (&1)))) /\ + (!(f:A->B) U V. continuous f U V = + (!v. V v ==> U { x | (UNIONS U) x /\ v (f x) })) /\ + (!x y. d_real x y = abs (x - y)) /\ + (!x y. euclid 2 x /\ euclid 2 y + ==> (d_euclid x y = + sqrt (sum (0,2) (\i. (x i - y i) * (x i - y i)))))`, + (* {{{ proof *) + [ + REWRITE_TAC[simple_closed_curve;continuous;preimage;d_real;]; + REWRITE_TAC[d_euclid_n]; + REWRITE_TAC[euclid;top2;top_of_metric;open_balls;open_ball;connected;]; + (* Tue Jan 18 21:10:10 EST 2005 *) + ]);; + (* }}} *) + +(* The interesting thing about these definitions is how the + standard mathematical definitions are made total, as required + by HOL. + + "continuous": There is no requirement that the IMAGE of f is + a subset of UNIONS V. This is contrary to the common mathematical + requirement that a function f:X->Y maps X to Y. The constraint + on the IMAGE for a simple_closed_curve is contained in the definition + of INJ. + + "simple_closed_curve": Continuity is required on the full real + line, but injectivity is required only on the unit interval. + + "connected": Here there is a requirement that Z is a subset of + UNIONS U + + "open_ball": If x is not in X, then the open ball is empty. + +*) diff --git a/Jordan/lib_ext.ml b/Jordan/lib_ext.ml new file mode 100644 index 0000000..2216dae --- /dev/null +++ b/Jordan/lib_ext.ml @@ -0,0 +1,99 @@ + + +let rec drop i list = + match (i,list) with (_,[]) -> failwith "drop null" + | (0,a::b) -> b + | (i,a::b) -> a::(drop (i-1) b);; + +let rec take i j = + function + [] -> [] | + a::b -> match (i,j) with + (0,0) -> [] | + (0,j) -> a::(take 0 (j-1) b) | + _ -> take (i-1) (j-1) b;; + +let cannot f x = try (f x; false) with Failure _ -> true;; + +(* ------------------------------------------------------------------ *) +(* UNIT TESTS *) +(* ------------------------------------------------------------------ *) + +let new_test_suite() = + let t = ref ([]:(string*bool) list) in + let add_test (s,f) = (t:= ((s,f)::!t)) in + let eval (s,f) = if f then () else failwith ("test suite: "^s) in + let test() = (ignore (List.map eval (!t));()) in + add_test,test;; + +let add_test,test = new_test_suite();; + + +(* ------------------------------------------------------------------ *) +(* LOCAL DEFINITIONS *) +(* ------------------------------------------------------------------ *) + +let local_defs = ref ([]:(string * (string * term)) list);; + +let add_interface (sym,tm) = + if (can (assoc sym) (!the_overload_skeletons)) then + (overload_interface (sym,tm)) + else (override_interface(sym,tm));; + +let local_definition package_name tm = + let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in + let avs,bod = strip_forall tm in + let l,r = try dest_eq bod + with Failure _ -> failwith "new_local_definition: Not an equation" in + let lv,largs = strip_comb l in + let cname,ty = dest_var lv in + let cname' = package_name^"'"^cname in + let lv' = mk_var(cname',ty) in + let l' = list_mk_comb(lv',largs) in + let bod' = mk_eq(l',r) in + let tm'= list_mk_forall(avs,bod') in + let thm = new_definition tm' in + let _ = (local_defs := (package_name,(cname,lv'))::(!local_defs)) in + let _ = add_interface(cname,lv') in + thm;; + +let reduce_local_interface(package_name) = + map (reduce_interface o snd) + (filter (fun x -> ((fst x) = package_name)) !local_defs);; + +let mk_local_interface(package_name) = + map (add_interface o snd) + (filter (fun x -> ((fst x) = package_name)) !local_defs);; + + + +(* ------------------------------------------------------------------ *) +(* SAVING STATE *) +(* ------------------------------------------------------------------ *) + +(****** Removed for now by JRH + +let (save_state,get_state) = + let state_array = ref [] in + let save_state (key:string) = + state_array := + (key,(!EVERY_STEP_TAC,!local_defs,!the_interface, + !the_term_constants,!the_type_constants, + !the_overload_skeletons, + !the_axioms,!the_definitions))::!state_array in + let get_state key = + let (et,ld,i,tc,tyc,os,ax,def) = assoc key !state_array in + ( + EVERY_STEP_TAC := et; + local_defs := ld; + the_interface := i; + the_term_constants:= tc; + the_type_constants:= tyc; + the_overload_skeletons:= os; + the_axioms:= ax; + the_definitions:= def) + in (save_state,get_state);; + +save_state "lib_ext";; + +*****) diff --git a/Jordan/make.ml b/Jordan/make.ml new file mode 100644 index 0000000..fcd6ef8 --- /dev/null +++ b/Jordan/make.ml @@ -0,0 +1,31 @@ +(* ========================================================================= *) +(* The Jordan Curve Theorem *) +(* *) +(* Proof by Tom Hales *) +(* *) +(* A few tweaks by John Harrison for the latest HOL Light *) +(* ========================================================================= *) + +(*** Standard HOL Light library ***) + +loads "Library/analysis.ml";; +loads "Library/transc.ml";; +loads "Examples/polylog.ml";; + +(*** New stuff ***) + +loadt "Jordan/tactics_refine.ml";; +loadt "Jordan/lib_ext.ml";; +loadt "Jordan/tactics_fix.ml";; +loadt "Jordan/parse_ext_override_interface.ml";; +loadt "Jordan/tactics_ext.ml";; +loadt "Jordan/num_ext_gcd.ml";; +loadt "Jordan/num_ext_nabs.ml";; +loadt "Jordan/real_ext_geom_series.ml";; +loadt "Rqe/num_calc_simp.ml";; +loadt "Jordan/real_ext.ml";; +loadt "Jordan/float.ml";; +loadt "Jordan/tactics_ext2.ml";; +loadt "Jordan/misc_defs_and_lemmas.ml";; +loadt "Jordan/metric_spaces.ml";; +loadt "Jordan/jordan_curve_theorem.ml";; diff --git a/Jordan/metric_spaces.ml b/Jordan/metric_spaces.ml new file mode 100644 index 0000000..f21940a --- /dev/null +++ b/Jordan/metric_spaces.ml @@ -0,0 +1,9170 @@ + + +(* ------------------------------------------------------------------ *) +(* + Topological Spaces, Metric Spaces, + Connectedness, Totally bounded spaces, compactness, + Hausdorff property, completeness, properties of Euclidean space, + + Author: Thomas Hales 2004 + +*) + +(* ------------------------------------------------------------------ *) + + +(* prioritize_real (or num) *) + +(* ------------------------------------------------------------------ *) +(* Logical Preliminaries *) +(* ------------------------------------------------------------------ *) + + +let Q_ELIM_THM = prove_by_refinement( + `!P Q R . (?(u:B). (?(x:A). (u = P x) /\ (Q x)) /\ (R u)) <=> + (?x. (Q x) /\ R( P x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MESON_TAC[]; + ]);; + (* }}} *) + +let Q_ELIM_THM' = prove_by_refinement( + `!P Q R. (!(t:B). (?(x:A). P x /\ (t = Q x)) ==> R t) <=> + (!x. P x ==> R (Q x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MESON_TAC[]; + ]);; + (* }}} *) + +let Q_ELIM_THM'' = prove_by_refinement( + `!P Q R. (!(t:B). (?(x:A). (t = Q x) /\ P x ) ==> R t) <=> + (!x. P x ==> R (Q x))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Set Preliminaries *) +(* ------------------------------------------------------------------ *) + +let DIFF_SUBSET = prove_by_refinement( + `!X A (B:A->bool). A SUBSET (X DIFF B) <=> + (A SUBSET X) /\ (A INTER B = EMPTY)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[SUBSET;DIFF;INTER;IN]; + EQ_TAC; + REWRITE_TAC[IN_ELIM_THM']; + DISCH_TAC; + CONJ_TAC; + ASM_MESON_TAC[]; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM';EMPTY]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + GEN_TAC; + DISCH_ALL_TAC; + REWRITE_TAC[IN_ELIM_THM']; + CONJ_TAC; + ASM_MESON_TAC[]; + USE 1 (fun t-> AP_THM t `x:A`); + USE 1 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let SUBSET_INTERS = prove_by_refinement( + `!X (A:A->bool). A SUBSET (INTERS X) <=> (!x. X x ==> (A SUBSET x))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[SUBSET;INTERS]; + REWRITE_TAC [IN_ELIM_THM']; + MESON_TAC[IN]; + ]);; + (* }}} *) + +let EQ_EMPTY = prove_by_refinement( + `!P. ({(x:A) | P x} = {}) <=> (!x. ~P x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_TAC; + (USE 0 (fun t-> AP_THM t `x:A`)); + USE 0 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); + USE 0 (GEN_ALL); + ASM_REWRITE_TAC[]; + DISCH_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM';EMPTY]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let DIFF_INTER = prove_by_refinement( + `!A B (C:A->bool). ((A DIFF B) INTER C = EMPTY) <=> + ((A INTER C) SUBSET B)`, + (* {{{ proof *) + [ + REWRITE_TAC[DIFF;INTER;SUBSET;IN_ELIM_THM']; + REWRITE_TAC[IN;EQ_EMPTY]; + MESON_TAC[]; + ]);; + (* }}} *) + +let SUB_IMP_INTER = prove_by_refinement( + `!A B (C:A->bool). ((A SUBSET B) ==> (A INTER C) SUBSET B) /\ + ((A SUBSET B) ==> (C INTER A) SUBSET B)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[INTER;SUBSET;IN;IN_ELIM_THM']; + MESON_TAC[]; + MESON_TAC[INTER_COMM]; + ]);; + (* }}} *) + +let SUBSET_UNIONS_INSERT = prove_by_refinement( + `!(A:A->bool) B C. A SUBSET (UNIONS (B INSERT C)) <=> + (A DIFF B) SUBSET (UNIONS C)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + SET_TAC[UNIONS;SUBSET;INSERT]; + ]);; + (* }}} *) + +let UNIONS_DELETE2 = prove_by_refinement( + `!(A:A->bool) B C. (A SUBSET (UNIONS B)) /\ (A INTER C = EMPTY) ==> + (A SUBSET (UNIONS (B DELETE (C))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM SET_TAC[SUBSET;UNIONS;INTER;EMPTY;DELETE]; + ]);; + (* }}} *) + + +(* this generalizes to arbitrary cardinalities *) +let finite_subset = prove_by_refinement( + `!A (f:A->B) B. (B SUBSET (IMAGE f A)) /\ (FINITE B) ==> + (?C. (C SUBSET A) /\ (FINITE C) /\ (B = IMAGE f C))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[SUBSET;IN_IMAGE]); + USE 0 (CONV_RULE NAME_CONFLICT_CONV); + USE 0 (CONV_RULE (quant_left_CONV "x'")); + USE 0 (CONV_RULE (quant_left_CONV "x'")); + CHO 0; + TYPE_THEN `IMAGE x' B` EXISTS_TAC ; + SUBCONJ_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE]; + NAME_CONFLICT_TAC; + GEN_TAC; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + CONJ_TAC; + ASM_MESON_TAC[ FINITE_IMAGE]; + MATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE]; + GEN_TAC; + TYPE_THEN `x` (USE 0 o SPEC); + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;IN_IMAGE]; + NAME_CONFLICT_TAC; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + AND 3; + CHO 3; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let inters_singleton = prove_by_refinement( + `!(A:A->bool). INTERS {A} = A`, + (* {{{ proof *) + [ + REWRITE_TAC[INSERT;INTERS]; + REWRITE_TAC[IN_ELIM_THM';NOT_IN_EMPTY]; + GEN_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[IN]; + ]);; + (* }}} *) + +let delete_empty = prove_by_refinement( + `!(A:A->bool) x. (A DELETE x = EMPTY) <=> (~(A = EMPTY) ==> (A = {x}))`, + (* {{{ proof *) + + [ + REWRITE_TAC[DELETE]; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + USE 1 (fun t-> AP_THM t `u:A`); + USE 1 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); + REWRITE_TAC[EMPTY;INSERT;IN]; + USE 0 (REWRITE_RULE[EMPTY_EXISTS]); + USE 1 (GEN `u:A`); + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[IN]; + DISCH_ALL_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM';EMPTY]; + USE 0 (REWRITE_RULE[EMPTY_EXISTS]); + USE 0 (REWRITE_RULE[EMPTY;INSERT;IN]); + REWRITE_TAC[IN]; + USE 0 (CONV_RULE (quant_left_CONV "u")); + USE 0 (SPEC `x':A`); + MATCH_MP_TAC (TAUT `(a ==> b) ==> ~(a /\ ~b)`); + DISCH_ALL_TAC; + REWR 0; + UND 1; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM']; + ]);; + + (* }}} *) + +let inters_subset = prove_by_refinement( + `!A (B:(A->bool)->bool). A SUBSET B ==> INTERS B SUBSET INTERS A`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[INTERS;SUBSET;IN_ELIM_THM']; + ASM_MESON_TAC[SUBSET;IN]; + ]);; + (* }}} *) + +let delete_inters = prove_by_refinement( + `!V (u:A->bool). V u ==> (INTERS V = (INTERS (V DELETE u)) INTER u)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC; + MATCH_MP_TAC inters_subset; + REWRITE_TAC [DELETE_SUBSET]; + USE 0 (ONCE_REWRITE_RULE[GSYM IN]); + USE 0 (MATCH_MP INTERS_SUBSET); + ASM_REWRITE_TAC[]; + TYPE_THEN `INTERS (V DELETE u) INTER u SUBSET u` SUBGOAL_TAC; + REWRITE_TAC[INTER_SUBSET]; + REWRITE_TAC[SUBSET_INTERS]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `x = u` ASM_CASES_TAC; + ASM_MESON_TAC[]; + TYPE_THEN `INTERS (V DELETE u) INTER u SUBSET INTERS (V DELETE u) ` SUBGOAL_TAC; + REWRITE_TAC[INTER_SUBSET]; + TYPE_THEN `INTERS (V DELETE u) SUBSET x` SUBGOAL_TAC; + MATCH_MP_TAC INTERS_SUBSET; + ASM_REWRITE_TAC [IN;DELETE;IN_ELIM_THM']; + ASM_MESON_TAC[SUBSET_TRANS]; + ]);; + (* }}} *) + +let EQ_EMPTY = prove_by_refinement( + `!(A:A->bool) . (A = EMPTY) <=> (!x. ~(A x))`, + (* {{{ proof *) + [ + ASM_MESON_TAC[EMPTY_EXISTS;IN]; + ]);; + (* }}} *) + +let UNIONS_EQ_EMPTY = prove_by_refinement( + `!(U:(A->bool)->bool). (UNIONS U = {}) <=> + ((U = EMPTY) \/ (U = {EMPTY}))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[EQ_EMPTY;UNIONS;IN_ELIM_THM';INSERT;EMPTY]; + REWRITE_TAC [IN]; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `!x. ~U x` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC; + USE 1 (CONV_RULE (quant_left_CONV "x")); + CHO 1; + USE 0 (CONV_RULE (quant_left_CONV "u")); + USE 0 (CONV_RULE (quant_left_CONV "u")); + EQ_TAC; + DISCH_TAC; + TYPE_THEN `x` (USE 0 o SPEC); + ASM_MESON_TAC[]; + DISCH_TAC; + COPY 0; + TYPE_THEN `x` (USE 0 o SPEC); + TYPE_THEN `x'` (USE 3 o SPEC); + PROOF_BY_CONTR_TAC; + TYPE_THEN `x' = {}` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 5 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 5; + USE 5 (REWRITE_RULE[IN]); + ASM_MESON_TAC[]; + USE 2 (CONV_RULE (quant_right_CONV "x'")); + ASM_MESON_TAC[IN;EMPTY_EXISTS]; + DISCH_THEN DISJ_CASES_TAC; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let INTERS_EQ_EMPTY = prove_by_refinement( + `!((A:(A->bool)->bool)). ((INTERS A) = EMPTY) <=> + (!x . ?a. (A a) /\ ~(a x))`, + (* {{{ proof *) + [ + REWRITE_TAC[INTERS;EQ_EMPTY;IN_ELIM_THM']; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + (* }}} *) + +let CARD_SING_CONV = prove_by_refinement( + `!X:A->bool. (X HAS_SIZE 1) ==> (SING X)`, + (* {{{ proof *) + + [ + REWRITE_TAC[HAS_SIZE ;SING ]; + DISCH_ALL_TAC; + TYPE_THEN `CHOICE X` EXISTS_TAC; + TYPE_THEN `~(X = {})` SUBGOAL_TAC; + ASM_MESON_TAC[CARD_CLAUSES;ARITH_RULE`~(0=1)`]; + DISCH_ALL_TAC; + TYPE_THEN `SUC (CARD (X DELETE (CHOICE X)))=1` SUBGOAL_TAC ; + ASM_SIMP_TAC[CARD_DELETE_CHOICE]; + REWRITE_TAC[ARITH_RULE`(SUC a = 1) <=> (a=0)`]; + ASSUME_TAC HAS_SIZE_0; + USE 3 (REWRITE_RULE [HAS_SIZE ]); + ASSUME_TAC FINITE_DELETE_IMP; + ASM_MESON_TAC[delete_empty]; + ]);; + + (* }}} *) + +let countable_prod = prove_by_refinement( + `!(A:A->bool) (B:B->bool). (COUNTABLE A) /\ (COUNTABLE B) ==> + (COUNTABLE {(a,b) | (A a) /\ (B b) })`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC (INST_TYPE [`:num#num`,`:A`] COUNTABLE_IMAGE); + USE 0 (REWRITE_RULE [COUNTABLE;GE_C;IN_UNIV]); + USE 1 (REWRITE_RULE [COUNTABLE;GE_C;IN_UNIV]); + CHO 0; + CHO 1; + TYPE_THEN `{(m:num,n:num) | T}` EXISTS_TAC; + REWRITE_TAC[NUM2_COUNTABLE;SUBSET;IN_IMAGE]; + REWRITE_TAC[IN_ELIM_THM]; + TYPE_THEN `(\ (u,v) . (f u,f' v))` EXISTS_TAC; + DISCH_ALL_TAC; + CHO 2; + CHO 2; + AND 2; + TYPE_THEN `a` (USE 0 o SPEC); + TYPE_THEN `b` (USE 1 o SPEC); + IN_OUT_TAC; + REWR 2; + REWR 3; + CHO 3; + CHO 2; + TYPE_THEN `(x',x'')` EXISTS_TAC; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let IMAGE_I = prove_by_refinement( + `!(A:A->bool). IMAGE I A = A`, + (* {{{ proof *) + [ + REWRITE_TAC[IMAGE;IN;I_DEF]; + GEN_TAC; + MATCH_MP_TAC EQ_EXT THEN GEN_TAC ; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let EMPTY_NOT_EXISTS = prove_by_refinement( + `!X. (X = {}) <=> (~(?(u:A). X u))`, + (* {{{ proof *) + [ + MESON_TAC [IN;EMPTY_EXISTS]; + ]);; + (* }}} *) + +let DIFF_SURJ = prove_by_refinement( + `!(f : A->B) X Y. (BIJ f X Y) ==> + (! t. (t SUBSET X) ==> ((IMAGE f (X DIFF t)) = (Y DIFF (IMAGE f t))))`, + (* {{{ proof *) + + [ + REWRITE_TAC[BIJ;INJ;SURJ;IN ]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + REWRITE_TAC[IMAGE;IN]; + IMATCH_MP_TAC EQ_EXT ; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC; + X_GEN_TAC `y:B`; + REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF]; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[SUBSET;IN ]; + ]);; + + (* }}} *) + +let union_subset = prove_by_refinement( + `!Z1 Z2 A. ((Z1 UNION Z2) SUBSET (A:A->bool)) <=> + (Z1 SUBSET A) /\ (Z2 SUBSET A)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[UNION;SUBSET;IN;IN_ELIM_THM']; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let preimage_disjoint = prove_by_refinement( + `!(f:A->B) A B X. (A INTER B = EMPTY) ==> + (preimage X f A INTER (preimage X f B) = EMPTY )`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[preimage]; + REWRITE_TAC[EQ_EMPTY]; + DISCH_ALL_TAC; + USE 1( REWRITE_RULE[INTER;IN;IN_ELIM_THM']); + USE 0 (REWRITE_RULE[EQ_EMPTY;INTER;IN;IN_ELIM_THM']); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let preimage_union = prove_by_refinement( + `!(f:A->B) A B X Z. + (Z SUBSET ((preimage X f A) UNION (preimage X f B))) <=> + (Z SUBSET X) /\ (IMAGE f Z SUBSET (A UNION B))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[preimage;IMAGE;UNION;SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let subset_preimage = prove_by_refinement( + `!(f:A->B) A X Z. (Z SUBSET (preimage X f A)) <=> (Z SUBSET X) /\ + (IMAGE f Z SUBSET A)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;preimage;IMAGE;IN;IN_ELIM_THM']; + MESON_TAC[]; + ]);; + (* }}} *) + +let preimage_unions = prove_by_refinement( + `!dom (f:A->B) C. preimage dom f (UNIONS C) = + (UNIONS (IMAGE (preimage dom f) C))`, + (* {{{ proof *) + [ + REWRITE_TAC[preimage;IN_UNIONS ]; + REWRITE_TAC[UNIONS;IN_IMAGE ]; + REWRITE_TAC[preimage;IN]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT ; + DISCH_ALL_TAC; + REWRITE_TAC[IN_ELIM_THM']; + REWRITE_TAC[Q_ELIM_THM;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let preimage_subset = prove_by_refinement( + `!(f:A->B) X A B. (A SUBSET B) ==> + (preimage X f A SUBSET (preimage X f B))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;in_preimage]; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* to fix two varying descriptions of ((INTER) Y): *) +let INTER_THM = prove_by_refinement( + `!(X:A->bool). ((\B. B INTER X) = ((INTER) X)) /\ + ((\B. X INTER B) = ((INTER) X))`, + (* {{{ proof *) + [ + REWRITE_TAC[INTER_COMM]; + GEN_TAC; + MATCH_MP_TAC EQ_EXT THEN BETA_TAC; + REWRITE_TAC[INTER_COMM]; +]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Real Preliminaries *) +(* ------------------------------------------------------------------ *) + +let REAL_SUM_SQUARE_POS = prove_by_refinement( + `!m n x . &.0 <=. sum(m,n) (\i. (x i)*.(x i))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MATCH_MP_TAC SUM_POS_GEN; + DISCH_ALL_TAC; + BETA_TAC; + REWRITE_TAC[REAL_LE_SQUARE]; + ]);; + (* }}} *) + +(* twopow , DUPLICATE OF TWOPOW_MK_POS *) +let twopow_pos = prove_by_refinement( + `!n. (&.0 <. twopow(n))`, + (* {{{ proof *) + [ + GEN_TAC; + DISJ_CASES_TAC (SPEC `n:int` INT_IMAGE); + CHO 0; + ASM_REWRITE_TAC[TWOPOW_POS]; + REDUCE_TAC; + ARITH_TAC; + CHO 0; + ASM_REWRITE_TAC[TWOPOW_NEG]; + REDUCE_TAC; + ARITH_TAC; + ]);; + (* }}} *) + +let twopow_double = prove_by_refinement( + `!n. &.2 * (twopow (--: (&: (n+1)))) = twopow (--: (&:n))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[TWOPOW_NEG;REAL_POW_ADD;POW_1;REAL_INV_MUL ]; + REWRITE_TAC [REAL_ARITH `a*b*cc = (a*cc)*b`]; + REWRITE_TAC [REAL_RINV_2 ]; + REAL_ARITH_TAC ; + ]);; + (* }}} *) + + +let min_finite = prove_by_refinement( + `!X. (FINITE X) /\ (~(X = EMPTY )) ==> + (?delta. (X delta) /\ (!x. (X x) ==> (delta <=. x)))`, + (* {{{ proof *) + + [ + TYPE_THEN `(!X k. FINITE X /\ (~(X = EMPTY )) /\ (X HAS_SIZE k) ==> (?delta. X delta /\ (!x. X x ==> delta <= x))) ==>(!X. FINITE X /\ (~(X = EMPTY )) ==> (?delta. X delta /\ (!x. X x ==> delta <= x)))` SUBGOAL_TAC ; + DISCH_TAC; + DISCH_ALL_TAC; + TYPE_THEN `X` (USE 0 o SPEC); + TYPE_THEN `CARD X` (USE 0 o SPEC); + UND 0; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[HAS_SIZE ]; + DISCH_THEN IMATCH_MP_TAC ; + CONV_TAC (quant_left_CONV "k"); + INDUCT_TAC; + REWRITE_TAC[HAS_SIZE_0]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[EMPTY]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + USE 3(REWRITE_RULE[HAS_SIZE]); + TYPE_THEN `X DELETE (CHOICE X)` (USE 0 o SPEC); + ASM_CASES_TAC `k=0`; + REWR 3; + USE 3 (REWRITE_RULE [ARITH_RULE `SUC 0=1`]); + TYPE_THEN `SING X` SUBGOAL_TAC ; + IMATCH_MP_TAC CARD_SING_CONV; + ASM_MESON_TAC [HAS_SIZE]; + REWRITE_TAC[SING]; + DISCH_TAC ; + CHO 5; + TYPE_THEN `x` EXISTS_TAC ; + ASM_REWRITE_TAC[REWRITE_RULE[IN] IN_SING ]; + REAL_ARITH_TAC; + TYPE_THEN `FINITE (X DELETE CHOICE X) /\ ~(X DELETE CHOICE X = {}) /\ (X DELETE CHOICE X HAS_SIZE k ) ` SUBGOAL_TAC; + REWRITE_TAC[FINITE_DELETE;HAS_SIZE ]; + ASM_REWRITE_TAC[]; + REWR 3; + IMATCH_MP_TAC (TAUT `(a /\ b) ==> (b /\ a)`); + SUBCONJ_TAC; + IMATCH_MP_TAC (ARITH_RULE `(SUC x = SUC y) ==> (x = y)`); + COPY 3; + UND 3; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + IMATCH_MP_TAC CARD_DELETE_CHOICE; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (TAUT `(b ==> ~a ) ==> (a ==> ~b)`); + DISCH_THEN (fun t-> ASM_REWRITE_TAC[t;CARD_CLAUSES]); + DISCH_TAC; + REWR 0; + CHO 0; + ALL_TAC; (* "ccx" *) + TYPE_THEN `if (delta < (CHOICE X)) then delta else (CHOICE X)` EXISTS_TAC; + (* REWRITE_TAC[min_real]; *) + COND_CASES_TAC ; + CONJ_TAC; + UND 0; + REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ]; + MESON_TAC[]; + GEN_TAC; + UND 0; + REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + TYPE_THEN `x = CHOICE X` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + UND 6; + REAL_ARITH_TAC; + ASM_MESON_TAC[]; + SUBCONJ_TAC; + IMATCH_MP_TAC (REWRITE_RULE[IN ] CHOICE_DEF); + ASM_REWRITE_TAC[]; + DISCH_TAC; + DISCH_ALL_TAC; + TYPE_THEN `x = CHOICE X` ASM_CASES_TAC ; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + UND 0; + REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + TYPE_THEN `x` (USE 11 o SPEC); + REWR 11; + UND 11; + UND 6; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let min_finite_delta = prove_by_refinement( + `!c X. (FINITE X) /\ ( !x. (X x) ==> (c <. x) ) ==> + (?delta. (c <. delta) /\ (!x. (X x) ==> (delta <=. x)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `~(X = EMPTY)` ASM_CASES_TAC; + JOIN 0 2; + USE 0 (MATCH_MP min_finite); + CHO 0; + TYPE_THEN `delta` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REWR 2; + ASM_REWRITE_TAC[EMPTY]; + TYPE_THEN `c +. (&.1)` EXISTS_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let union_closed_interval = prove_by_refinement( + `!a b c. (a <=. b) /\ (b <=. c) ==> + ({x | a <= x /\ x < b} UNION {x | b <= x /\ x <= c} = + { x | a <= x /\ x <= c})`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[UNION;IN;IN_ELIM_THM']; + IMATCH_MP_TAC EQ_EXT ; + REWRITE_TAC[IN_ELIM_THM']; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let real_half_LT = prove_by_refinement( + `!x y z. ((x < z/(&.2)) /\ (y < z/(&.2)) ==> (x + y < z))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let real_half_LE = prove_by_refinement( + `!x y z. ((x < z/(&.2)) /\ (y <= z/(&.2)) ==> (x + y < z))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let real_half_EL = prove_by_refinement( + `!x y z. ((x <= z/(&.2)) /\ (y < z/(&.2)) ==> (x + y < z))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let real_half_LLE = prove_by_refinement( + `!x y z. ((x <= z/(&.2)) /\ (y <= z/(&.2)) ==> (x + y <= z))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE]; + UND 0; + UND 1; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let interval_finite = prove_by_refinement( + `!N. FINITE {x | ?j. (abs x = &.j) /\ (j <=| N)}`, + (* {{{ proof *) + [ + GEN_TAC; + ABBREV_TAC `inter = {n | n <=| N}`; + SUBGOAL_TAC `FINITE {y | ?x. (x IN inter /\ (y = (&. x)))}`; + MATCH_MP_TAC FINITE_IMAGE_EXPAND; + EXPAND_TAC "inter"; + REWRITE_TAC[FINITE_NUMSEG_LE]; + SUBGOAL_TAC `FINITE {y | ?x. (x IN inter /\ (y = --.(&. x)))}`; + MATCH_MP_TAC FINITE_IMAGE_EXPAND; + EXPAND_TAC "inter"; + REWRITE_TAC[FINITE_NUMSEG_LE]; + DISCH_ALL_TAC; + JOIN 1 2; + USE 1 (REWRITE_RULE[GSYM FINITE_UNION]); + UND 1; + SUBGOAL_TAC `!a b. ((a:real->bool) = b) ==> (FINITE a ==> FINITE b)`; + REP_GEN_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + DISCH_THEN (fun t-> MATCH_MP_TAC t); + MATCH_MP_TAC EQ_EXT; + X_GEN_TAC `c:real`; + REWRITE_TAC[IN_ELIM_THM';UNION]; + EXPAND_TAC "inter"; + REWRITE_TAC[IN_ELIM_THM']; + REWRITE_TAC[real_abs]; + EQ_TAC; + MATCH_MP_TAC (TAUT `(a==>b) /\ (c==>b) ==> (a \/ c ==> b)`); + CONJ_TAC; + DISCH_THEN CHOOSE_TAC; + AND 1; + ASM_REWRITE_TAC[]; + EXISTS_TAC `x:num`; + ASM_REWRITE_TAC [REAL_LE;LE_0]; + DISCH_THEN CHOOSE_TAC; + AND 1; + EXISTS_TAC `x:num`; + ASM_REWRITE_TAC[REAL_NEG_NEG]; + COND_CASES_TAC; + UND 3; + REDUCE_TAC; + ARITH_TAC; + REDUCE_TAC; + DISCH_THEN CHOOSE_TAC; + AND 1; + UND 2; + COND_CASES_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + DISJ2_TAC; + EXISTS_TAC `j:num`; + ASM_REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Euclidean Space *) +(* ------------------------------------------------------------------ *) + +let euclid_add_closure = prove_by_refinement( + `!f g n. (euclid n f) /\ (euclid n g) ==> (euclid n (f + g))`, +(* {{{ *) + [ + REWRITE_TAC[euclid;euclid_plus]; + ASM_MESON_TAC[REAL_ARITH `&0 +. (&.0) = (&.0)`]; + ]);; +(* }}} *) + +let euclid_scale_closure = prove_by_refinement( + `!n t f. (euclid n f) ==> (euclid n ((t:real) *# f))`, +(* {{{ *) + [ + REWRITE_TAC[euclid;euclid_scale]; + MESON_TAC[REAL_ARITH `t *.(&.0) = (&.0)`]; + ]);; +(* }}} *) + +let euclid_neg_closure = prove_by_refinement( + `!f n. (euclid n f) ==> (euclid n (-- f))`, +(* {{{ *) + + [ + REWRITE_TAC[euclid;euclid_neg]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[REAL_ARITH `(--x = &.0) <=> (x = &.0)`]; + ]);; + +(* }}} *) + +let euclid_sub_closure = prove_by_refinement( + `!f g n. (euclid n f ) /\ (euclid n g) ==> (euclid n (f - g))`, +(* {{{ *) + + [ + REWRITE_TAC[euclid;euclid_minus]; + ASM_MESON_TAC[REAL_ARITH `&.0 -. (&.0) = (&.0)`]; + ]);; + +(* }}} *) + +let neg_dim = prove_by_refinement( + `!f n. (euclid n f) = (euclid n (--f))`, +(* {{{ *) + + [ + REPEAT GEN_TAC; + EQ_TAC; + REWRITE_TAC[euclid_neg_closure]; + REWRITE_TAC[euclid;euclid_neg]; + DISCH_ALL_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `(x = &.0) <=> (--x = &.0)`]; + ASM_REWRITE_TAC[]; + ]);; + +(* }}} *) + +let euclid_updim = prove_by_refinement ( + `!f m n. (m <=| n) /\ (euclid m f) ==> (euclid n f)`, +(* {{{ *) + [ + REWRITE_TAC[euclid]; + MESON_TAC[LE_TRANS]; + ]);; +(* }}} *) + +let euclidean_add_closure = prove_by_refinement( + `!f g. (euclidean f) /\ (euclidean g) ==> (euclidean (f+g))`, +(* {{{ *) + + [ + REWRITE_TAC[euclidean]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `euclid` CHOOSE_TAC; + UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; + EXISTS_TAC `n+|n'`; + ASSUME_TAC (ARITH_RULE `n <=| n+n'`); + ASSUME_TAC (ARITH_RULE `n' <=| n+n'`); + ASM_MESON_TAC[euclid_add_closure;euclid_updim]; + ]);; + +(* }}} *) + +let euclidean_sub_closure = prove_by_refinement( + `!f g. (euclidean f) /\ (euclidean g) ==> (euclidean (f-g))`, +(* {{{ *) + + [ + REWRITE_TAC[euclidean]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `euclid` CHOOSE_TAC; + UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; + EXISTS_TAC `n+|n'`; + ASSUME_TAC (ARITH_RULE `n <=| n+n'`); + ASSUME_TAC (ARITH_RULE `n' <=| n+n'`); + ASM_MESON_TAC[euclid_sub_closure;euclid_updim]; + ]);; + +(* }}} *) + +let euclidean_scale_closure = prove_by_refinement( + `!s f. (euclidean f) ==> (euclidean (s *# f))`, +(* {{{ *) + [ + REWRITE_TAC[euclidean]; + REPEAT GEN_TAC; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `n:num`; + ASM_MESON_TAC[euclid_scale_closure]; + ]);; +(* }}} *) + +let euclidean_neg_closure = prove_by_refinement( + `!f. (euclidean f) ==> (euclidean (-- f))`, +(* {{{ *) + [ + REWRITE_TAC[euclidean]; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `n:num`; + ASM_MESON_TAC[euclid_neg_closure]; + ]);; +(* }}} *) + +let euclid_add_comm = prove_by_refinement( + `!(f:num->real) g. (f + g = g + f)`, +(* {{{ *) + [ + REWRITE_TAC[euclid_plus;REAL_ARITH `a+.b = b+.a`] + ]);; +(* }}} *) + +let euclid_add_assoc = prove_by_refinement( + `!(f:num->real) g h. (f + g)+h = f + g + h`, +(* {{{ *) + [ + REWRITE_TAC[euclid_plus;REAL_ARITH `(a+.b)+.c = a+b+c`]; + ]);; +(* }}} *) + +let euclid_lzero = prove_by_refinement( + `!f. euclid0 + f = f`, +(* {{{ *) + [ + REWRITE_TAC[euclid_plus;euclid0;REAL_ARITH `&.0+a=a`]; + ACCEPT_TAC (INST_TYPE [(`:num`,`:A`);(`:real`,`:B`)] ETA_AX); + ]);; +(* }}} *) + +let euclid_rzero = prove_by_refinement( + `!f. f + euclid0 = f`, +(* {{{ *) + [ + REWRITE_TAC[euclid_plus;euclid0;REAL_ARITH `a+(&.0)=a`]; + ACCEPT_TAC (INST_TYPE [(`:num`,`:A`);(`:real`,`:B`)] ETA_AX); + ]);; +(* }}} *) + +let euclid_ldistrib = prove_by_refinement( + `!f g r. r *# (f + g) = (r *# f) + (r *# g)`, +(* {{{ *) + [ + REWRITE_TAC[euclid_plus;euclid_scale;REAL_ARITH `a*(b+.c)=a*b+a*c`]; + ]);; +(* }}} *) + +let euclid_rdistrib = prove_by_refinement( + `!f r s. (r+s)*# f = (r *# f) + (s *# f)`, +(* {{{ *) + [ + REWRITE_TAC[euclid_plus;euclid_scale;REAL_ARITH `(a+b)*c= a*c+b*c`]; + ]);; +(* }}} *) + +let euclid_scale_act = prove_by_refinement( + `!r s f. r *# (s *# f) = (r *s) *# f`, +(* {{{ *) + [ + REWRITE_TAC[euclid_scale;REAL_ARITH `(a*b)*c = a*(b*c)`]; + ]);; +(* }}} *) + +let euclid_scale_one = prove_by_refinement( + `!f. (&.1) *# f = f`, +(* {{{ proof *) + [ + REWRITE_TAC[euclid_scale]; + REDUCE_TAC; + MESON_TAC[ETA_AX]; + ]);; +(* }}} *) + +let euclid_neg_sum = prove_by_refinement( + `!x y . euclid_minus (--x) (--y) = -- (euclid_minus x y)`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid_neg;euclid_minus]; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + BETA_TAC; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let trivial_lin_combo = prove_by_refinement( + `!x t. ((t *# x) + (&.1 - t) *# x = x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[euclid_plus;euclid_scale;]; + IMATCH_MP_TAC EQ_EXT THEN BETA_TAC; + REAL_ARITH_TAC ; + ]);; + (* }}} *) + + +(* DOT PRODUCT *) + +let dot_euclid = prove_by_refinement( + `!p f g. (euclid p f) /\ (euclid p g) ==> + (dot f g = sum (0,p) (\i. (f i)* (g i)))`, +(* {{{ *) + + [ + REWRITE_TAC[dot]; + LET_TAC; + REPEAT GEN_TAC; + ABBREV_TAC `(P:num->bool) = \m. (euclid m f) /\ (euclid m g)`; + DISCH_ALL_TAC; + SUBGOAL_TAC `(P:num->bool) (p:num)`; + EXPAND_TAC "P"; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBGOAL_TAC `min_num P <=| p`; + ASM_MESON_TAC[min_least]; + DISCH_TAC; + SUBGOAL_TAC + `euclid (min_num (P:num->bool)) f /\ (euclid (min_num (P:num->bool)) g)`; + ASM_MESON_TAC[min_least]; + DISCH_ALL_TAC; + ABBREV_TAC `q = min_num P`; + MP_TAC (SPECL [`q:num`;`p:num`] LE_EXISTS); + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[GSYM SUM_TWO]; + MATCH_MP_TAC (REAL_ARITH `(u = (&.0)) ==> (x = x + u)`); + SUBGOAL_THEN `!n. n>=| q ==> ((\i. f i *. g i) n = (&.0))` (fun th -> MATCH_MP_TAC (MATCH_MP SUM_ZERO th)); + GEN_TAC THEN BETA_TAC; + DISCH_TAC; + SUBGOAL_THEN `(f:num->real) n = (&.0)` (fun th -> REWRITE_TAC[th;REAL_ARITH `(&.0)*.a =(&.0)`]); + UNDISCH_TAC `euclid q f`; + UNDISCH_TAC `n >=| q`; + MESON_TAC[euclid;ARITH_RULE `(a<=|b) <=> (b >=| a)`]; + ACCEPT_TAC (ARITH_RULE `q >=| q`); + ]);; + +(* }}} *) + +let dot_updim = prove_by_refinement ( + `!f g m n. (m <=|n) /\ (euclid m f) /\ (euclid m g) ==> + (dot f g = sum (0,n) (\i. (f i)* (g i)))`, +(* {{{ *) + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC `(euclid n f) /\ (euclid n g)`; + ASM_MESON_TAC[euclid_updim]; + MATCH_ACCEPT_TAC dot_euclid] +);; +(* }}} *) + +let dot_nonneg = prove_by_refinement( + `!f. (&.0 <= (dot f f))`, +(* {{{ *) + [ + REWRITE_TAC[dot]; + LET_TAC; + GEN_TAC; + SUBGOAL_TAC `(!n. (&.0 <=. (\(i:num). f i *. f i) n))`; + BETA_TAC; + REWRITE_TAC[REAL_LE_SQUARE]; + ASSUME_TAC(SPEC `\i. (f:num->real) i *. f i` SUM_POS); + ASM_MESON_TAC[]]);; +(* }}} *) + +let dot_comm = prove_by_refinement( + `!f g. (dot f g = dot g f)`, +(* {{{ *) + [ + REWRITE_TAC[dot]; + REWRITE_TAC[REAL_ARITH `a*.b = b*.a`;TAUT `a/\b <=> b/\a`] + ]);; +(* }}} *) + +let dot_neg = prove_by_refinement( + `!f g. (dot (--f) g) = --. (dot f g)`, +(* {{{ *) + [ + REWRITE_TAC[dot]; + LET_TAC; + REWRITE_TAC [GSYM neg_dim]; + ONCE_REWRITE_TAC[GSYM SUM_NEG]; + REWRITE_TAC[euclid_neg]; + REPEAT GEN_TAC; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT; + BETA_TAC; + GEN_TAC; + REWRITE_TAC[REAL_ARITH `(--x) * y = --. (x *y)`]; + ]);; +(* }}} *) + +let dot_neg2 = prove_by_refinement( + `!f g. (dot f (--g)) = --. (dot f g)`, +(* {{{ *) + [ + ONCE_REWRITE_TAC[dot_comm]; + REWRITE_TAC[dot_neg]; + ]);; +(* }}} *) + +let dot_scale = prove_by_refinement( + `!n f g s. (euclid n f) /\ (euclid n g) ==> + (dot (s *# f) g = s *. (dot f g))`, +(* {{{ *) + [ + REWRITE_TAC[euclid_scale]; + REPEAT GEN_TAC; + DISCH_THEN (fun th -> ASSUME_TAC th THEN ASSUME_TAC (MATCH_MP dot_euclid th)); + SUBGOAL_THEN (`euclid n (\ (i:num). (s *. f i) ) /\ (euclid n g)`) ASSUME_TAC; + ASM_REWRITE_TAC[]; + ASSUME_TAC(REWRITE_RULE[euclid_scale](SPECL [`n:num`;`s:real`;`f:num->real`] euclid_scale_closure)); + ASM_MESON_TAC[]; + IMP_RES_THEN ASSUME_TAC dot_euclid; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM SUM_CMUL]; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + BETA_TAC; + REWRITE_TAC[REAL_ARITH `a*.(b*.c) = (a*b)*c`]; + ]);; +(* }}} *) + +let dot_scale_euclidean = prove_by_refinement( + `!f g s. (euclidean f) /\ (euclidean g) ==> + (dot (s *# f) g = s *. (dot f g))`, +(* {{{ *) + + [ + REWRITE_TAC[euclidean]; + DISCH_ALL_TAC; + REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC)); + DISCH_ALL_TAC; + ASSUME_TAC (ARITH_RULE `(n' <=| n+n')`); + ASSUME_TAC (ARITH_RULE `(n <=| n+n')`); + SUBGOAL_TAC `euclid (n+|n') f /\ euclid (n+n') g`; + ASM_MESON_TAC[euclid_updim]; + MESON_TAC[dot_scale]; + ]);; + +(* }}} *) + +let dot_scale2 = prove_by_refinement( + `!n f g s. (euclid n f) /\ (euclid n g) ==> + (dot f (s *# g) = s *. (dot f g))`, +(* {{{ *) + [ + ONCE_REWRITE_TAC[dot_comm]; + MESON_TAC[dot_scale] + ]);; +(* }}} *) + +let dot_scale2_euclidean = prove_by_refinement( + `!f g s. (euclidean f) /\ (euclidean g) ==> + (dot f (s *# g) = s *. (dot f g))`, +(* {{{ *) + [ + ONCE_REWRITE_TAC[dot_comm]; + MESON_TAC[dot_scale_euclidean]; + ]);; +(* }}} *) + +let dot_linear = prove_by_refinement( + `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> + ((dot (f + g) h ) = (dot f h) +. (dot g h))`, +(* {{{ *) + [ + DISCH_ALL_TAC; + SUBGOAL_TAC `euclid n (f+g)`; + ASM_MESON_TAC[euclid_add_closure]; + DISCH_TAC; + MP_TAC (SPECL [`n:num`;`f:num->real`;`h:num->real`] dot_euclid); + MP_TAC (SPECL [`n:num`;`g:num->real`;`h:num->real`] dot_euclid); + MP_TAC (SPECL [`n:num`;`(f+g):num->real`;`h:num->real`] dot_euclid); ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM SUM_ADD]; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC; + REWRITE_TAC[euclid_plus]; + REWRITE_TAC[REAL_ARITH `(a+.b)*.c = a*c + b*c`]; + ]);; +(* }}} *) + +let dot_minus_linear = prove_by_refinement( + `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> + ((dot (f - g) h ) = (dot f h) -. (dot g h))`, +(* {{{ *) + + [ + DISCH_ALL_TAC; + SUBGOAL_TAC `euclid n (f-g)`; + ASM_MESON_TAC[euclid_sub_closure]; + DISCH_TAC; + MP_TAC (SPECL [`n:num`;`f:num->real`;`h:num->real`] dot_euclid); + MP_TAC (SPECL [`n:num`;`g:num->real`;`h:num->real`] dot_euclid); + MP_TAC (SPECL [`n:num`;`(f-g):num->real`;`h:num->real`] dot_euclid); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM SUM_SUB]; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC; + REWRITE_TAC[euclid_minus]; + REWRITE_TAC[REAL_ARITH `(a-.b)*.c = a*c - b*c`]; + ]);; + +(* }}} *) + +let dot_linear_euclidean = prove_by_refinement( + `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> + ((dot (f + g) h ) = (dot f h) +. (dot g h))`, +(* {{{ *) + [ + REWRITE_TAC[euclidean]; + DISCH_ALL_TAC; + REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC)); + DISCH_ALL_TAC; + SUBGOAL_TAC `(euclid (n+n'+n'') f)`; + ASM_MESON_TAC[ARITH_RULE `n <=| n+n'+n''`;euclid_updim]; + SUBGOAL_TAC `(euclid (n+n'+n'') g)`; + ASM_MESON_TAC[ARITH_RULE `n' <=| n+n'+n''`;euclid_updim]; + SUBGOAL_TAC `(euclid (n+n'+n'') h)`; + ASM_MESON_TAC[ARITH_RULE `n'' <=| n+n'+n''`;euclid_updim]; + MESON_TAC[dot_linear]]);; +(* }}} *) + +let dot_minus_linear_euclidean = prove_by_refinement( + `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> + ((dot (f - g) h ) = (dot f h) -. (dot g h))`, +(* {{{ *) + + [ + REWRITE_TAC[euclidean]; + DISCH_ALL_TAC; + REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC)); + DISCH_ALL_TAC; + SUBGOAL_TAC `(euclid (n+n'+n'') f)`; + ASM_MESON_TAC[ARITH_RULE `n <=| n+n'+n''`;euclid_updim]; + SUBGOAL_TAC `(euclid (n+n'+n'') g)`; + ASM_MESON_TAC[ARITH_RULE `n' <=| n+n'+n''`;euclid_updim]; + SUBGOAL_TAC `(euclid (n+n'+n'') h)`; + ASM_MESON_TAC[ARITH_RULE `n'' <=| n+n'+n''`;euclid_updim]; + MESON_TAC[dot_minus_linear]; +]);; + +(* }}} *) + +let dot_linear2 = prove_by_refinement( + `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> + ((dot h (f + g)) = (dot h f) +. (dot h g))`, +(* {{{ *) + + [ + REPEAT GEN_TAC; + ONCE_REWRITE_TAC[dot_comm]; + MESON_TAC[dot_linear] + ]);; + +(* }}} *) + +let dot_linear2_euclidean = prove_by_refinement( + `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> + ((dot h (f + g)) = (dot h f) +. (dot h g))`, +(* {{{ *) + [ + REPEAT GEN_TAC; + ONCE_REWRITE_TAC[dot_comm]; + MESON_TAC[dot_linear_euclidean] + ]);; +(* }}} *) + +let dot_minus_linear2 = prove_by_refinement( + `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==> + ((dot h (f - g)) = (dot h f) -. (dot h g))`, +(* {{{ *) + + [ + REPEAT GEN_TAC; + ONCE_REWRITE_TAC[dot_comm]; + MESON_TAC[dot_minus_linear] + ]);; + +(* }}} *) + +let dot_minus_linear2_euclidean = prove_by_refinement( + `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==> + ((dot h (f - g)) = (dot h f) -. (dot h g))`, +(* {{{ *) + + [ + REPEAT GEN_TAC; + ONCE_REWRITE_TAC[dot_comm]; + MESON_TAC[dot_minus_linear_euclidean] + ]);; + +(* }}} *) + +let dot_rzero = prove_by_refinement( + `!f. (dot f euclid0) = &.0`, +(* {{{ *) + [ + REWRITE_TAC[dot;euclid0]; + LET_TAC; + GEN_TAC; + SUBGOAL_THEN `(\ (i:num). (f i *. (&.0))) = (\ (r:num). (&.0))` (fun t -> REWRITE_TAC[t]); + REWRITE_TAC[REAL_ARITH `a*.(&.0) = (&.0)`]; + MESON_TAC[SUM_0]; + ]);; +(* }}} *) + +let dot_lzero = prove_by_refinement( + `!f. (dot euclid0 f ) = &.0`, +(* {{{ *) + [ + ONCE_REWRITE_TAC[dot_comm]; + REWRITE_TAC[dot_rzero]; + ]);; +(* }}} *) + +let dot_zero = prove_by_refinement( + `!f n. (euclid n f) /\ (dot f f = (&.0)) ==> (f = euclid0)`, +(* {{{ *) + [ + DISCH_ALL_TAC; + UNDISCH_TAC `dot f f = (&.0)`; + MP_TAC (SPECL [`n:num`;`f:num->real`;`f:num->real`] dot_euclid); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun th -> REWRITE_TAC[th]); + REWRITE_TAC[euclid0]; + DISCH_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC; + DISJ_CASES_TAC (ARITH_RULE `x <| n \/ (n <=| x)`); + CLEAN_ASSUME_TAC (ARITH_RULE `(x <|n) ==> (SUC x <=| n)`); + CLEAN_THEN (SPECL [`SUC x`;`n:num`] LE_EXISTS) CHOOSE_TAC; + UNDISCH_TAC `sum(0,n) (\ (i:num). f i *. f i) = (&.0)`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM SUM_TWO;sum;ARITH_RULE `0+| x = x`]; + SUBGOAL_TAC `!a b. (&.0 <=. sum(a,b) (\ (i:num). f i *. f i))`; + REPEAT GEN_TAC; + MP_TAC (SPEC `\ (i:num). f i *. f i` SUM_POS); + BETA_TAC; + REWRITE_TAC[REAL_LE_SQUARE]; + MESON_TAC[]; + DISCH_ALL_TAC; + IMP_RES_THEN MP_TAC (REAL_ARITH `(a+.b = &.0) ==> ((&.0 <=. b) ==> (a <=. (&.0)))`); + ASM_REWRITE_TAC[]; + DISCH_TAC; + IMP_RES_THEN MP_TAC (REAL_ARITH `(a+b <=. &.0) ==> ((&.0 <=. a) ==> (b <=. (&.0)))`); + ASM_REWRITE_TAC[]; + ABBREV_TAC `a = (f:num->real) x`; + MESON_TAC[REAL_LE_SQUARE;REAL_ARITH `a <=. (&.0) /\ (&.0 <=. a) ==> (a = (&.0))`;REAL_ENTIRE]; + UNDISCH_TAC `euclid n f`; + REWRITE_TAC[euclid]; + ASM_MESON_TAC[]; + ]);; +(* }}} *) + +let dot_zero_euclidean = prove_by_refinement( + `!f. (euclidean f) /\ (dot f f = (&.0)) ==> (f = euclid0)`, +(* {{{ *) + [ + REWRITE_TAC[euclidean]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `euclid` CHOOSE_TAC; + ASM_MESON_TAC[dot_zero]; + ]);; +(* }}} *) + +(* norm *) + +let norm_nonneg = prove_by_refinement( + `!f. (&.0 <=. norm f)`, +(* {{{ *) + [ + REWRITE_TAC[norm]; + ONCE_REWRITE_TAC[GSYM SQRT_0]; + GEN_TAC; + MATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[dot_nonneg]; + REAL_ARITH_TAC; + ]);; +(* }}} *) + +let norm_neg = prove_by_refinement( + `!f. norm (--f) = norm f`, +(* {{{ *) + + [ + REWRITE_TAC[norm;dot_neg;dot_neg2]; + REWRITE_TAC[REAL_ARITH `--(--. x) = x`]; + ]);; + +(* }}} *) + +let cauchy_schwartz = prove_by_refinement( + `!f g. (euclidean f) /\ (euclidean g) ==> + ((abs(dot f g)) <=. (norm f)*. (norm g))`, +(* {{{ *) + [ + DISCH_ALL_TAC; + DISJ_CASES_TAC (TAUT `(f = euclid0 ) \/ ~(f = euclid0)`); + ASM_REWRITE_TAC[dot_lzero;norm;SQRT_0;REAL_ARITH`&.0 *. x = (&.0)`]; + REWRITE_TAC[ABS_0;REAL_ARITH `x <=. x`]; + SUBGOAL_THEN `!a b. (dot (a *# f + b *# g) (a *# f + b *# g)) = a*a*(dot f f) + (&.2)*a*b*(dot f g) + b*b*(dot g g)` ASSUME_TAC; + REPEAT GEN_TAC; + ASM_SIMP_TAC[euclidean_scale_closure;euclidean_add_closure;dot_linear_euclidean;dot_linear2_euclidean;dot_scale_euclidean;dot_scale2_euclidean]; + REWRITE_TAC[REAL_MUL_AC;REAL_ADD_AC;REAL_ADD_LDISTRIB]; + MATCH_MP_TAC (REAL_ARITH`(b+. c=e) ==> (a+b+c+d = a+ e+d)`); + REWRITE_TAC[GSYM REAL_LDISTRIB]; + REPEAT AP_TERM_TAC; + MATCH_MP_TAC (REAL_ARITH `(a=b)==> (a+.b = a*(&.2))`); + REWRITE_TAC[dot_comm]; + FIRST_ASSUM (fun th -> ASSUME_TAC (SPECL[` --. (dot f g)`;`dot f f`] th)); + CLEAN_THEN (SPEC `(--.(dot f g)) *# f + (dot f f)*# g` dot_nonneg) ASSUME_TAC; + REWRITE_TAC[norm]; + ASSUME_TAC(SPEC `f:num->real` dot_nonneg); + ASSUME_TAC(SPEC `g:num->real` dot_nonneg); + ASM_SIMP_TAC[GSYM SQRT_MUL]; + REWRITE_TAC[GSYM POW_2_SQRT_ABS;POW_2]; + MATCH_MP_TAC SQRT_MONO_LE; + REWRITE_TAC[REAL_LE_SQUARE]; + SUBGOAL_TAC `&.0 <. dot f f`; + MATCH_MP_TAC (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 <. x)`); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[dot_zero_euclidean]; + REPEAT (UNDISCH_FIND_TAC `(<=.)` ); + ABBREV_TAC `a = dot f f`; + ABBREV_TAC `b = dot f g`; + ABBREV_TAC `c = dot g g`; + POP_ASSUM_LIST (fun t -> ALL_TAC); + REWRITE_TAC[REAL_ARITH `(&.2 *. x = x + x)`;REAL_ADD_AC]; + REWRITE_TAC[REAL_ARITH `(a *. ((--. b)*.c) = --. (a *. (b*.c)))/\ (--. ((--. a) *. b) = a *.b )`]; + REWRITE_TAC[REAL_ARITH `(--. b) *. a*. b + b*.b*.a = (&.0)`]; + REWRITE_TAC[REAL_ARITH `x +. (&.0) = x`]; + REWRITE_TAC[REAL_ARITH `(&.0 <=. (a*.a*.c +. (--.b)*.a*.b)) <=> (a*b*b <=. a*a*c)`]; + DISCH_ALL_TAC; + MATCH_MP_TAC (SPEC `a:real` REAL_LE_LCANCEL_IMP); + ASM_REWRITE_TAC[]; + ]);; +(* }}} *) + +let norm_dot = prove_by_refinement( + `!h. norm(h) * norm(h) = (dot h h)`, +(* {{{ *) + [ + REWRITE_TAC[norm]; + ONCE_REWRITE_TAC[GSYM POW_2]; + REWRITE_TAC[SQRT_POW2;dot_nonneg]; + ]);; +(* }}} *) + +let norm_triangle = prove_by_refinement( + `!f g. (euclidean f) /\ (euclidean g) ==> + (norm (f+g) <=. norm(f) + norm(g))`, +(* {{{ *) + [ + DISCH_ALL_TAC; + MATCH_MP_TAC square_le; + REWRITE_TAC[norm_nonneg]; + CONJ_TAC; + MATCH_MP_TAC (REAL_ARITH `(&.0 <=. x) /\ (&.0 <=. y) ==> (&.0 <= x+y)`); + REWRITE_TAC[norm_nonneg]; + REWRITE_TAC[REAL_ADD_LDISTRIB;REAL_ADD_RDISTRIB;REAL_ADD_AC]; + REWRITE_TAC[norm_dot]; +ASM_SIMP_TAC[euclidean_add_closure;dot_linear_euclidean;dot_linear2_euclidean]; + REWRITE_TAC[REAL_MUL_AC]; + REWRITE_TAC[REAL_ADD_AC]; + MATCH_MP_TAC (REAL_ARITH `(b<=.c)==>((a+.b) <=. (a+c))`); + MATCH_MP_TAC (REAL_ARITH `(a=b)/\ (a<=. e) ==>((a+b+c) <= (c+e+e))`); + CONJ_TAC; + REWRITE_TAC[dot_comm]; + ASM_MESON_TAC[cauchy_schwartz;REAL_LE_TRANS;REAL_ARITH `x <=. ||. x`]; + ]);; +(* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* Metric Space *) +(* ------------------------------------------------------------------ *) + +let metric_space_zero = prove_by_refinement( + `!(X:A->bool) d a. (metric_space(X,d) /\ (X a) ==> (d a a = (&.0)))`, +(* {{{ *) + [MESON_TAC[metric_space] + ]);; +(* }}} *) + +let metric_space_symm = prove_by_refinement( + `!(X:A->bool) d a b. (metric_space(X,d) /\ (X a) /\ (X b) ==> + (d a b = d b a))`, +(* {{{ *) + [ + MESON_TAC[metric_space]; + ]);; +(* }}} *) + +let metric_space_triangle = prove_by_refinement( + `!(X:A->bool) d a b c. (metric_space(X,d) /\ (X a) /\ (X b) /\ (X c) + ==> (d a c <=. d a b +. d b c))`, +(* {{{ *) + [ + MESON_TAC[metric_space]; + ]);; +(* }}} *) + +let metric_subspace = prove_by_refinement( + `!X Y d. (Y SUBSET (X:A->bool)) /\ (metric_space (X,d)) ==> + (metric_space (Y,d))`, +(* {{{ *) + [ + REWRITE_TAC[SUBSET;metric_space;IN]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `( /\ )` (fun t -> MP_TAC (SPECL[`x:A`;`y:A`;`z:A`] t)); + ASM_SIMP_TAC[]; + ]);; +(* }}} *) + +let metric_euclidean = prove_by_refinement( + `metric_space (euclidean,d_euclid)`, +(* {{{ *) + [ + REWRITE_TAC[metric_space;d_euclid]; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[norm_nonneg]; + CONJ_TAC; + EQ_TAC; + REWRITE_TAC[norm]; + ONCE_REWRITE_TAC[REAL_ARITH `(&.0 = x) <=> (x = (&.0))`]; + ASM_SIMP_TAC[dot_nonneg;SQRT_EQ_0]; + DISCH_TAC; + SUBGOAL_TAC `x - y = euclid0`; + ASM_MESON_TAC[dot_zero_euclidean;euclidean_sub_closure]; + REWRITE_TAC[euclid_minus;euclid0]; + DISCH_TAC THEN (MATCH_MP_TAC EQ_EXT); + X_GEN_TAC `n:num`; + FIRST_ASSUM (fun t -> ASSUME_TAC (BETA_RULE (AP_THM t `n:num`))); + ASM_MESON_TAC [REAL_ARITH `(a = b) <=> (a-.b = (&.0))`]; + DISCH_THEN (fun t->REWRITE_TAC[t]); + SUBGOAL_THEN `(y:num->real) - y = euclid0` (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[euclid0;euclid_minus]; + MATCH_MP_TAC EQ_EXT; + GEN_TAC THEN BETA_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[norm;dot_lzero;SQRT_0]; + CONJ_TAC; + SUBGOAL_THEN `x - y = (euclid_neg (y-x))` ASSUME_TAC; + REWRITE_TAC[euclid_neg;euclid_minus]; + MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC; + REAL_ARITH_TAC; + ASM_MESON_TAC[norm_neg]; + SUBGOAL_THEN `(x-z) = euclid_plus(x - y) (y-z)` (fun t -> REWRITE_TAC[t]); + REWRITE_TAC[euclid_plus;euclid_minus]; + MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[norm_triangle;euclidean_sub_closure;euclidean_sub_closure]; + ]);; +(* }}} *) + +let metric_euclid = prove_by_refinement( + `!n. metric_space (euclid n,d_euclid)`, +(* {{{ *) + [ + GEN_TAC; + MATCH_MP_TAC (ISPEC `euclidean` metric_subspace); + REWRITE_TAC[metric_euclidean;SUBSET;IN]; + MESON_TAC[euclidean]; + ]);; +(* }}} *) + +let euclid1_abs = prove_by_refinement( + `!x y. (euclid 1 x) /\ (euclid 1 y) ==> + ((d_euclid x y) = (abs ((x 0) -. (y 0))))`, + (* {{{ proof *) + [ + REWRITE_TAC[d_euclid;norm]; + DISCH_ALL_TAC; + SUBGOAL_TAC `euclid 1 (x - y)`; + ASM_MESON_TAC[euclid_sub_closure]; + DISCH_TAC; + ASSUME_TAC (prove(`1 <= 1`,ARITH_TAC)); + MP_TAC (SPECL[`(x-y):num->real`;`(x-y):num->real`;`1`;`1`] dot_updim); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[prove(`1 = SUC 0`,ARITH_TAC)]; + REWRITE_TAC[sum]; + REWRITE_TAC[REAL_ARITH `&.0 + x = x`]; + REWRITE_TAC[ARITH_RULE `0 +| 0 = 0`]; + REWRITE_TAC[euclid_minus]; + ASM_MESON_TAC[REAL_POW_2;POW_2_SQRT_ABS]; + ]);; + (* }}} *) + +let coord_dirac = prove_by_refinement( + `!i t. coord i (t *# dirac_delta i ) = t`, + (* {{{ proof *) + + [ + REWRITE_TAC[coord;dirac_delta;euclid_scale]; + ARITH_TAC; + ]);; + + (* }}} *) + +let dirac_0 = prove_by_refinement( + `!x. (x *# dirac_delta 0) 0 = x`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[dirac_delta;euclid_scale;]; + REDUCE_TAC; + ]);; + (* }}} *) + +let euclid1_dirac = prove_by_refinement( + `!x. euclid 1 x <=> (x = (x 0) *# (dirac_delta 0))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[euclid; euclid_scale;dirac_delta ]; + EQ_TAC; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + X_GEN_TAC `n:num`; + BETA_TAC; + COND_CASES_TAC; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_SIMP_TAC[ARITH_RULE `(~(0=m))==>(1<=| m)`]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + USE 1 (MATCH_MP (ARITH_RULE `1<= m ==> (~(0=m))`)); + ASM ONCE_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REDUCE_TAC ; + ]);; + (* }}} *) + +(* projection onto the ith coordinate, as a euclidean vector *) +let proj = euclid_def + `proj i x = (\j. (if (j=0) then (x (i:num)) else (&.0)))`;; + +let proj_euclid1 = prove_by_refinement( + `!i x. euclid 1 (proj i x)`, + (* {{{ proof *) + [ + REWRITE_TAC[proj;euclid]; + REPEAT GEN_TAC; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + ARITH_TAC; + ]);; + (* }}} *) + +let d_euclid_n = prove_by_refinement( + `!n x y. ((euclid n x) /\ (euclid n y)) ==> ((d_euclid x y) = + sqrt(sum (0,n) (\i. (x i - y i) * (x i - y i))))`, + (* {{{ proof *) + + [ + REPEAT GEN_TAC; + REWRITE_TAC[d_euclid;norm]; + DISCH_ALL_TAC; + ASSUME_TAC (ARITH_RULE `n <=| n`); + SUBGOAL_TAC `euclid n (x - y)`; + ASM_SIMP_TAC[euclid_sub_closure]; + DISCH_TAC; + CLEAN_ASSUME_TAC (SPECL[`(x-y):num->real`;`(x-y):num->real`;`n:num`;`n:num`]dot_updim); + ASM_REWRITE_TAC[euclid_minus]; + ]);; + + (* }}} *) + +let norm_n = prove_by_refinement( + `!n x. ((euclid n x) ) ==> ((norm x) = + sqrt(sum (0,n) (\i. (x i ) * (x i ))))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + TYPEL_THEN [`x`;`x`;`n`;`n`] (fun t-> SIMP_TAC [norm;ISPECL t dot_updim;ARITH_RULE `n <=| n`;]); + ]);; + (* }}} *) + +let proj_d_euclid = prove_by_refinement( + `!i x y. d_euclid (proj i x) (proj i y) = abs (x i -. y i)`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + SIMP_TAC[SPEC `1` d_euclid_n;proj_euclid1]; + REWRITE_TAC[ARITH_RULE `1 = SUC 0`;sum]; + NUM_REDUCE_TAC; + REWRITE_TAC[proj]; + REWRITE_TAC[REAL_ARITH `&.0 + x = x`]; + MESON_TAC[POW_2_SQRT_ABS;REAL_POW_2]; + ]);; + (* }}} *) + +let d_euclid_pos = prove_by_refinement( + `!x y n. (euclid n x) /\ (euclid n y) ==> (&.0 <=. d_euclid x y)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MP_TAC metric_euclid; + REWRITE_TAC[metric_space;euclidean]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let proj_contraction = prove_by_refinement( + `!n x y i. (euclid n x) /\ (euclid n y) ==> + abs (x i - (y i)) <=. d_euclid x y`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MATCH_MP_TAC REAL_POW_2_LE; + REWRITE_TAC[REAL_ABS_POS]; + CONJ_TAC; + ASM_MESON_TAC[d_euclid_pos]; + ASM_SIMP_TAC[SPEC `n:num` d_euclid_n]; + REWRITE_TAC[REAL_POW2_ABS]; + SUBGOAL_TAC `euclid n (x - y)`; (* why does MESON fail here??? *) + MATCH_MP_TAC euclid_sub_closure; + ASM_MESON_TAC[]; + DISCH_TAC; + SUBGOAL_TAC `&.0 <=. sum (0,n) (\i. (x i - y i)*. (x i - y i))`; + MATCH_MP_TAC SUM_POS_GEN; + DISCH_ALL_TAC THEN BETA_TAC; + REWRITE_TAC[REAL_LE_SQUARE]; + SIMP_TAC[SQRT_POW_2]; + DISCH_TAC; + ASM_CASES_TAC `n <=| i`; + MATCH_MP_TAC (REAL_ARITH `(x = (&.0)) /\ (&.0 <=. y) ==> (x <=. y)`); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_PROP_ZERO_POW]; + NUM_REDUCE_TAC; + ASM_MESON_TAC[euclid;euclid_minus]; + MP_TAC (ARITH_RULE `~(n <=| i) ==> (i < n) /\ (n = (SUC i) + (n-i-1))`); + ASM_REWRITE_TAC[] THEN DISCH_ALL_TAC; + ASM ONCE_REWRITE_TAC[]; + REWRITE_TAC[GSYM SUM_TWO]; + MATCH_MP_TAC (REAL_ARITH `(a <=. b) /\ (&.0 <=. c) ==> (a <=. (b +c))`); + CONJ_TAC; + REWRITE_TAC[sum_DEF]; + REWRITE_TAC[ARITH_RULE `0 +| i = i`]; + MATCH_MP_TAC (REAL_ARITH `(a = c) /\ (&.0 <=. b) ==> (a <=. b+c)`); + REWRITE_TAC[REAL_POW_2]; + MP_TAC (SPECL [`0:num`;`i:num`;`(x:num->real)- y`] REAL_SUM_SQUARE_POS); + BETA_TAC; + REWRITE_TAC[euclid_minus]; + MP_TAC (SPECL [`SUC i`;`(n:num)-i-1`;`(x:num->real)- y`] REAL_SUM_SQUARE_POS); + BETA_TAC; + REWRITE_TAC[euclid_minus]; + ]);; + (* }}} *) + +let euclid_dirac = prove_by_refinement( + `!x. (euclid 1 (x *# (dirac_delta 0)))`, + (* {{{ proof *) + [ + REWRITE_TAC[euclid;dirac_delta ;euclid_scale]; + DISCH_ALL_TAC; + USE 0 (MATCH_MP (ARITH_RULE `1 <=| m ==> (~(0=m))`)); + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ]);; + (* }}} *) + +let d_euclid_pow2 = prove_by_refinement( + `!n x y. (euclid n x) /\ (euclid n y) ==> + ((d_euclid x y) pow 2 = sum (0,n) (\i. (x i - y i) * (x i - y i)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[d_euclid_n]; + REWRITE_TAC[SQRT_POW2]; + MATCH_MP_TAC SUM_POS_GEN; + BETA_TAC; + REDUCE_TAC; + ]);; + (* }}} *) + +let D_EUCLID_BOUND = prove_by_refinement( + `!n x y eps. ((euclid n x) /\ (euclid n y) /\ + (!i. (abs (x i -. y i) <=. eps))) ==> + ( d_euclid x y <=. sqrt(&.n)*. eps )`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + SQUARE_TAC; + SUBCONJ_TAC; + JOIN 0 1; + USE 0 (MATCH_MP d_euclid_pos); + ASM_REWRITE_TAC[]; + DISCH_TAC; + WITH 2 (SPEC `0`); + USE 4 (MATCH_MP (REAL_ARITH `abs (x) <=. eps ==> &.0 <=. eps`)); + SUBCONJ_TAC; + ALL_TAC; + REWRITE_TAC[REAL_MUL_NN]; + DISJ1_TAC; + CONJ_TAC; + MATCH_MP_TAC SQRT_POS_LE ; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_SIMP_TAC[d_euclid_pow2]; + SUBGOAL_TAC `!i. ((x:num->real) i -. y i) *. (x i -. y i) <=. eps* eps`; + GEN_TAC; + ALL_TAC; + USE 2 (SPEC `i:num`); + ABBREV_TAC `t = x i - (y:num->real) i`; + UND 2; + REWRITE_TAC[ABS_SQUARE_LE]; + REWRITE_TAC[REAL_POW_MUL]; + ASSUME_TAC (REWRITE_RULE[] ((REDUCE_CONV `&.0 <= &.n`))); + USE 6 (REWRITE_RULE[GSYM SQRT_POW2]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ALL_TAC; + MATCH_MP_TAC SUM_BOUND; + GEN_TAC; + DISCH_TAC; + BETA_TAC; + REWRITE_TAC[POW_2]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let metric_translate = prove_by_refinement( + `!n x y z . (euclid n x) /\ (euclid n y) /\ (euclid n z) ==> + (d_euclid (x + z) (y + z) = d_euclid x y)`, + (* {{{ proof *) + + [ + REWRITE_TAC[d_euclid;norm]; + DISCH_ALL_TAC; + TYPE_THEN `euclid n (euclid_minus x y)` SUBGOAL_TAC; + ASM_SIMP_TAC[euclid_sub_closure]; + DISCH_TAC; + TYPE_THEN `euclid n (euclid_minus (euclid_plus x z) (euclid_plus y z))` SUBGOAL_TAC; + ASM_SIMP_TAC[euclid_sub_closure; euclid_add_closure]; + DISCH_ALL_TAC; + ASM_SIMP_TAC[SPEC `n:num` dot_euclid]; + TYPE_THEN `(x + z) - (y + z) = ((x:num->real) - y)` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + X_GEN_TAC `i:num`; + REWRITE_TAC[euclid_minus;euclid_plus]; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ]);; + + (* }}} *) + +let metric_translate_LEFT = prove_by_refinement( + `!n x y z . (euclid n x) /\ (euclid n y) /\ (euclid n z) ==> + (d_euclid (z + x ) (z + y) = d_euclid x y)`, + (* {{{ proof *) + + [ + REWRITE_TAC[d_euclid;norm]; + DISCH_ALL_TAC; + TYPE_THEN `euclid n (euclid_minus x y)` SUBGOAL_TAC; + ASM_SIMP_TAC[euclid_sub_closure]; + DISCH_TAC; + TYPE_THEN `euclid n (euclid_minus (euclid_plus z x) (euclid_plus z y))` SUBGOAL_TAC; + ASM_SIMP_TAC[euclid_sub_closure; euclid_add_closure]; + DISCH_ALL_TAC; + ASM_SIMP_TAC[SPEC `n:num` dot_euclid]; + TYPE_THEN `(z + x) - (z + y) = ((x:num->real) - y)` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + X_GEN_TAC `i:num`; + REWRITE_TAC[euclid_minus;euclid_plus]; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ]);; + + (* }}} *) + +let norm_scale = prove_by_refinement( + `!t t' x . (euclidean x) ==> + (d_euclid (t *# x) (t' *# x) = + ||. (t - t') * norm(x))`, + (* {{{ proof *) + + [ + REWRITE_TAC[euclidean]; + LEFT_TAC "n"; + DISCH_ALL_TAC; + ASM_SIMP_TAC[d_euclid_n;norm_n;euclid_scale_closure;euclid_scale;GSYM REAL_SUB_RDISTRIB;REAL_MUL_AC;]; + REWRITE_TAC[GSYM REAL_POW_2 ]; + REWRITE_TAC[REAL_ARITH `a * a * b = b * (a * a)`;SUM_CMUL;]; + ASM_SIMP_TAC[SQRT_MUL;REAL_SUM_SQUARE_POS;REAL_LE_SQUARE_POW;POW_2_SQRT_ABS ]; + REWRITE_TAC[REAL_POW_2]; + ]);; + + (* }}} *) + +let norm_scale_vec = prove_by_refinement( + `!n t x x' . (euclid n x) /\ (euclid n x') ==> + (d_euclid (t *# x) (t *# x') = ||. t * d_euclid x x')`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[d_euclid_n;norm_n;euclid_scale_closure;euclid_scale;GSYM REAL_SUB_LDISTRIB;REAL_MUL_AC;]; + REWRITE_TAC[REAL_ARITH `t*t*b = (t*t)*b`]; + REWRITE_TAC[GSYM REAL_POW_2 ;SUM_CMUL ]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_2]; + ASM_SIMP_TAC[SQRT_MUL;REAL_SUM_SQUARE_POS;REAL_LE_SQUARE_POW;POW_2_SQRT_ABS ]; + REWRITE_TAC[REAL_POW_2]; + ]);; + + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Topological Spaces *) +(* ------------------------------------------------------------------ *) + + +(* Definitions *) +(* underscore is necessary to avoid Harrison's global "topology" *) +(* carrier of topology is UNIONS U *) + +let topology = euclid_def `topology_ (U:(A->bool)->bool) <=> + (!A B V. (U EMPTY) /\ + ((U A) /\ (U B) ==> (U (A INTER B))) /\ + ((V SUBSET U) ==> (U (UNIONS V))))`;; + +let open_DEF = euclid_def `open_ (U:(A->bool)->bool) A = (U A)`;; + +let closed = euclid_def `closed_ (U:(A->bool)->bool) B <=> + (B SUBSET (UNIONS U)) /\ + (open_ U ((UNIONS U) DIFF B))`;; + +let closure = euclid_def `closure (U:(A->bool)->bool) A = + INTERS { B | (closed_ U B) /\ (A SUBSET B) }`;; + +let induced_top = euclid_def `induced_top U (A:A->bool) = + IMAGE ( \B. (B INTER A)) U`;; + +let open_ball = euclid_def + `open_ball(X,d) (x:A) r = { y | (X x) /\ (X y) /\ (d x y <. r) }`;; + +let closed_ball =euclid_def + `closed_ball (X,d) (x:A) r = { y | (X x) /\ (X y) /\ (d x y <=. r) }`;; + +let open_balls = euclid_def + `open_balls (X,d) = { B | ?(x:A) r. B = open_ball (X,d) x r}`;; + +let top_of_metric = euclid_def + `top_of_metric ((X:A->bool),d) = + { A | ?F. (F SUBSET (open_balls (X,d)))/\ + (A = UNIONS F) }`;; + +(* basic properties *) + +let open_EMPTY = prove_by_refinement( + `!(U:(A->bool)->bool). (topology_ U ==> open_ U EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[topology;open_DEF]; + MESON_TAC[]; + ]);; + (* }}} *) + +let open_closed = prove_by_refinement( + `!U A. (topology_ (U:(A->bool)->bool)) /\ (open_ U A) ==> + (closed_ U ((UNIONS U) DIFF A))`, + (* {{{ proof *) + [ + REWRITE_TAC[closed;open_DEF]; + DISCH_ALL_TAC; + SUBGOAL_THEN `(A:A->bool) SUBSET (UNIONS U)` ASSUME_TAC; + ASM_MESON_TAC[sub_union]; + ASM_SIMP_TAC[DIFF_DIFF2]; + REWRITE_TAC[SUBSET_DIFF]; + ]);; +(* }}} *) + +let closed_UNIV = prove_by_refinement( + `!(U:(A->bool)->bool). (topology_ U ==> closed_ U (UNIONS U))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASM_SIMP_TAC[open_closed]; + REWRITE_TAC[closed;open_DEF]; + TYPE_THEN `a = UNIONS U` ABBREV_TAC; + USE 0 (REWRITE_RULE[topology]); + CONJ_TAC; + MESON_TAC[SUBSET]; + USE 0 (CONV_RULE (quant_right_CONV "V")); + USE 0 (CONV_RULE (quant_right_CONV "B")); + USE 0 (CONV_RULE (quant_right_CONV "A")); + AND 0; + UND 2; + MESON_TAC[DIFF_EQ_EMPTY]; + ]);; + + (* }}} *) + +let top_univ = prove_by_refinement( + `!(U:(A->bool)->bool). (topology_ U) ==> (U (UNIONS U))`, + (* {{{ proof *) + [ + REWRITE_TAC[topology]; + DISCH_ALL_TAC; + ASM_MESON_TAC[SUBSET_REFL]; + ]);; + (* }}} *) + +let empty_closed = prove_by_refinement( + `!(U:(A->bool)->bool). + (topology_ U) ==> closed_ U EMPTY`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[closed;EMPTY_SUBSET;DIFF_EMPTY;open_DEF]; + ASM_MESON_TAC[top_univ]; + ]);; + (* }}} *) + +let closed_open = prove_by_refinement( + `!(U:(A->bool)->bool) A. (closed_ U A) ==> + (open_ U ((UNIONS U) DIFF A))`, + (* {{{ proof *) + [ + MESON_TAC[closed]; + ]);; +(* }}} *) + +let closed_inter = prove_by_refinement ( + `!U V. (topology_ (U:(A->bool)->bool)) /\ (!a. (V a) ==> (closed_ U a)) + /\ ~(V = EMPTY) + ==> (closed_ U (INTERS V))`, + (* {{{ proof *) + [ + REWRITE_TAC[closed]; + DISCH_ALL_TAC; + CONJ_TAC; + MATCH_MP_TAC INTERS_SUBSET2; + USE 2 (REWRITE_RULE[ EMPTY_EXISTS]); + USE 2 (REWRITE_RULE[IN]); + CHO 2; + EXISTS_TAC `u:A->bool`; + ASM_MESON_TAC[ ]; + ABBREV_TAC `VCOMP = IMAGE ((DIFF) (UNIONS (U:(A->bool)->bool))) V`; + UNDISCH_FIND_THEN `VCOMP` (fun t -> ASSUME_TAC (GSYM t)); + SUBGOAL_THEN `(VCOMP:(A->bool)->bool) SUBSET U` ASSUME_TAC; + ASM_REWRITE_TAC[SUBSET;IN_ELIM_THM;IMAGE]; + REWRITE_TAC[IN]; + GEN_TAC; + ASM_MESON_TAC[open_DEF]; + SUBGOAL_THEN `open_ U (UNIONS (VCOMP:(A->bool)->bool))` ASSUME_TAC; + ASM_MESON_TAC[topology;open_DEF]; + SUBGOAL_THEN ` (UNIONS U DIFF INTERS V)= (UNIONS (VCOMP:(A->bool)->bool))` (fun t-> (REWRITE_TAC[t])); + ASM_REWRITE_TAC[UNIONS_INTERS]; + UNDISCH_FIND_TAC `(open_)`; + REWRITE_TAC[]; + ]);; +(* }}} *) + +let open_nbd = prove_by_refinement( + `!U (A:A->bool). (topology_ U) ==> + ((U A) = (!x. ?B. (A x ) ==> ((B SUBSET A) /\ (B x) /\ (U B))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + GEN_TAC; + EXISTS_TAC `A:A->bool`; + ASM_MESON_TAC[SUBSET]; + CONV_TAC (quant_left_CONV "B"); + DISCH_THEN CHOOSE_TAC; + USE 1 (CONV_RULE NAME_CONFLICT_CONV); + TYPE_THEN `UNIONS (IMAGE B A) = A` SUBGOAL_TAC; + MATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + MATCH_MP_TAC UNIONS_SUBSET; + REWRITE_TAC[IN_IMAGE]; + ASM_MESON_TAC[IN]; + REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]; + DISCH_ALL_TAC; + NAME_CONFLICT_TAC; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + EXISTS_TAC `x:A`; + TYPE_THEN `B x` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[IN]; + (* on 1*) + TYPE_THEN `(IMAGE B A) SUBSET U` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE;]; + REWRITE_TAC[IN]; + NAME_CONFLICT_TAC; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN `W = IMAGE B A` ABBREV_TAC; + KILL 2; + ASM_MESON_TAC[topology]; + ]);; + (* }}} *) + +let open_inters = prove_by_refinement( + `!U (V:(A->bool)->bool). (topology_ U) /\ (V SUBSET U) /\ + (FINITE V) /\ ~(V = EMPTY) ==> + (U (INTERS V))`, + (* {{{ proof *) + [ + REP_GEN_TAC; + DISCH_ALL_TAC; + TYPE_THEN `(?n. V HAS_SIZE n)` SUBGOAL_TAC; + REWRITE_TAC[HAS_SIZE]; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + UND 0; + UND 1; + UND 2; + UND 3; + UND 4; + CONV_TAC (quant_left_CONV "n"); + TYPE_THEN `V` SPEC2_TAC ; + TYPE_THEN `U` SPEC2_TAC ; + CONV_TAC (quant_left_CONV "n"); + CONV_TAC (quant_left_CONV "n"); + INDUCT_TAC; + DISCH_ALL_TAC; + ASM_MESON_TAC[HAS_SIZE_0]; + DISCH_ALL_TAC; + TYPE_THEN `U` (USE 0 o SPEC); + USE 5 (REWRITE_RULE[HAS_SIZE_SUC;EMPTY_EXISTS]); + AND 5; + CHO 6; + TYPE_THEN `u` (USE 5 o SPEC); + REWR 5; + TYPE_THEN `V DELETE u` (USE 0 o SPEC); + REWR 0; + TYPE_THEN `V={u}` ASM_CASES_TAC; + ASM_REWRITE_TAC[inters_singleton]; + UND 6; + UND 2; + REWRITE_TAC [SUBSET;IN]; + MESON_TAC[]; + ALL_TAC; (* oi1 *) + USE 0 (REWRITE_RULE[delete_empty]); + REWR 0; + USE 0 (REWRITE_RULE[FINITE_DELETE]); + REWR 0; + TYPE_THEN `V DELETE u SUBSET U ` SUBGOAL_TAC; + ASM_MESON_TAC[DELETE_SUBSET;SUBSET_TRANS]; + DISCH_ALL_TAC; + REWR 0; + ALL_TAC; (* oi2 *) + COPY 6; + USE 9 (REWRITE_RULE[IN]); + USE 9 (MATCH_MP delete_inters); + ASM_REWRITE_TAC[]; + USE 1 (REWRITE_RULE[topology]); + TYPEL_THEN [`(INTERS (V DELETE u))`;`u`;`U`] (USE 1 o ISPECL); + AND 1; + AND 1; + UND 11; + DISCH_THEN MATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + UND 6; + UND 2; + REWRITE_TAC [SUBSET;IN]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let top_unions = prove_by_refinement( + `!(U:(A->bool)->bool) V. topology_ U /\ (V SUBSET U) ==> U (UNIONS V)`, + (* {{{ proof *) + [ + MESON_TAC[topology]; + ]);; + (* }}} *) + +let top_inter = prove_by_refinement( + `!(U:(A->bool)-> bool) A B. topology_ U /\ (U A) /\ (U B) ==> (U (A INTER B))`, + (* {{{ proof *) + [ + MESON_TAC[topology]; + ]);; + (* }}} *) + + +(* open and closed balls in metric spaces *) + +let open_ball_nonempty = prove_by_refinement( + `!(X:A->bool) d a r. (metric_space (X,d)) /\ (&.0 <. r) /\ (X a) ==> + (a IN (open_ball(X,d) a r))`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_space;IN_ELIM_THM;open_ball]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `( /\ )` (ASSUME_TAC o (SPECL [`a:A`;`a:A`;`a:A`])); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let open_ball_subset = prove_by_refinement( + `!(X:A->bool) d a r. (open_ball (X,d) a r SUBSET X)`, +(* {{{ proof *) + [ + REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let open_ball_subspace = prove_by_refinement( + `!(X:A->bool) Y d a r. (Y SUBSET X) ==> + (open_ball(Y,d) a r SUBSET open_ball(X,d) a r)`, +(* {{{ proof *) + [ + REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let open_ball_empty = prove_by_refinement( + `!(X:A->bool) d a r. ~(a IN X) ==> (EMPTY = open_ball (X,d) a r)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[open_ball]; + MATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM;EMPTY]; + ASM_MESON_TAC[IN]; + ]);; + (* }}} *) + +(*** Old proof modified by JRH to avoid GSPEC + +let open_ball_intersect = prove_by_refinement( + `!(X:A->bool) Y d a r. (Y SUBSET X) /\ (a IN Y) ==> + (open_ball(Y,d) a r = (open_ball(X,d) a r INTER Y))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;IN;INTER;open_ball]; + REWRITE_TAC[GSPEC_THM]; + REWRITE_TAC[IN_ELIM_THM]; + REWRITE_TAC[GSPEC]; + DISCH_ALL_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + BETA_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +***) + +let open_ball_intersect = prove_by_refinement( + `!(X:A->bool) Y d a r. (Y SUBSET X) /\ (a IN Y) ==> + (open_ball(Y,d) a r = (open_ball(X,d) a r INTER Y))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;IN;INTER;open_ball]; + REWRITE_TAC[EXTENSION; IN_ELIM_THM]; + MESON_TAC[] + ]);; + (* }}} *) + +let open_ball_center = prove_by_refinement( + `!(X:A->bool) d a b r. (metric_space (X,d)) /\ + (a IN (open_ball (X,d) b r)) ==> + (?r'. (&.0 <. r') /\ + ((open_ball(X,d) a r') SUBSET (open_ball(X,d) b r)))`, +(* {{{ proof *) + [ + REWRITE_TAC[metric_space;open_ball]; + DISCH_ALL_TAC; + EXISTS_TAC `r -. (d (a:A) (b:A))`; + REWRITE_TAC[SUBSET;IN_ELIM_THM]; + UNDISCH_FIND_TAC `(IN)`; + REWRITE_TAC[IN_ELIM_THM]; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[REAL_ARITH `(&.0 < r -. s)= (s <. r)`]; + ASM_MESON_TAC[]; + GEN_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `(u <. v-.w) <=> (w +. u <. v)`]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UNDISCH_FIND_TAC `(!)`; + DISCH_THEN (fun t-> (MP_TAC (SPECL [`b:A`;`a:A`;`x:A`] t))); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LET_TRANS;REAL_LTE_TRANS]; + ]);; +(* }}} *) + +let open_ball_nonempty_center = prove_by_refinement( + `!(X:A->bool) d a r. (metric_space(X,d)) ==> + ((a IN (open_ball(X,d) a r)) = + ~(open_ball(X,d) a r = EMPTY))`, +(* {{{ proof *) + [ + REWRITE_TAC[metric_space]; + DISCH_ALL_TAC; + REWRITE_TAC[open_ball]; + REWRITE_TAC[REWRITE_CONV[IN_ELIM_THM] `(a:A) IN { y | X a /\ X y /\ (d a y <. r)}`]; + REWRITE_TAC[EXTENSION]; + REWRITE_TAC[IN_ELIM_THM;NOT_IN_EMPTY;NOT_FORALL_THM]; + EQ_TAC; + MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t)); + UNDISCH_FIND_THEN `(+.)` (fun t -> MP_TAC (SPECL [`a:A`;`a:A`;`a:A`] t)); + ASM_MESON_TAC[REAL_LET_TRANS;REAL_LTE_TRANS]; + ]);; +(* }}} *) + +(*** Old proof modified by JRH to remove apparent misnamed quantifier + +let open_ball_neg_radius = prove_by_refinement( + `!(X:A->bool) d a r. metric_space(X,d) /\ (r <. (&.0)) ==> + (EMPTY = open_ball(X,d) a r)`, + (* {{{ proof *) + [ + REWRITE_TAC[open_ball;metric_space]; + DISCH_ALL_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[EMPTY;IN_ELIM_THM]; + FIRST_ASSUM (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t)); + ASSUME_TAC (REAL_ARITH `!u r. ~((dd <. r) /\ (r <. (&.0)) /\ (&.0 <=. dd))`); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +***) + +let open_ball_neg_radius = prove_by_refinement( + `!(X:A->bool) d a r. metric_space(X,d) /\ (r <. (&.0)) ==> + (EMPTY = open_ball(X,d) a r)`, + (* {{{ proof *) + [ + REWRITE_TAC[open_ball;metric_space]; + DISCH_ALL_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[EMPTY;IN_ELIM_THM]; + FIRST_ASSUM (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t)); + ASSUME_TAC (REAL_ARITH `!d r. ~((d <. r) /\ (r <. (&.0)) /\ (&.0 <=. d))`); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +let open_ball_nest = prove_by_refinement( + `!(X:A->bool) d a r r'. (r <. r') ==> + ((open_ball (X,d) a r) SUBSET (open_ball(X,d) a r'))`, +(* {{{ proof *) + [ + REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM]; + MESON_TAC[REAL_ARITH `(r<. r') /\ (a <. r) ==> (a <. r')`]; + ]);; +(* }}} *) + +(* intersection of open balls contains an open ball *) +let open_ball_inter = prove_by_refinement( + `!(X:A->bool) d a b c r r'. (metric_space (X,d)) /\ (X a) /\ (X b) /\ + (c IN (open_ball(X,d) a r INTER (open_ball(X,d) b r'))) ==> + (?r''. (&.0 <. r'') /\ (open_ball(X,d) c r'') SUBSET + (open_ball(X,d) a r INTER (open_ball(X,d) b r')))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `(INTER)` (fun t-> MP_TAC (REWRITE_RULE[IN_INTER] t) THEN DISCH_ALL_TAC); + SUBGOAL_TAC `(X:A->bool) (c:A)`; + ASM_MESON_TAC[SUBSET;open_ball_subset;IN]; + DISCH_TAC; + MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`;`c:A`;`b:A`;`r':real`] open_ball_center) THEN (ASM_REWRITE_TAC[]) THEN (DISCH_THEN CHOOSE_TAC); + MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`;`c:A`;`a:A`;`r:real`] open_ball_center) THEN (ASM_REWRITE_TAC[]) THEN (DISCH_THEN CHOOSE_TAC); + REWRITE_TAC[SUBSET_INTER]; + EXISTS_TAC `(if (r'' <. r''') then (r'') else (r'''))`; + COND_CASES_TAC; + ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; + IMP_RES_THEN DISJ_CASES_TAC (REAL_ARITH `(~(r'' <. r''')) ==> ((r''' <. r'') \/ (r'''=r''))`); + ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; + ASM_MESON_TAC[]; + ]);; +(* }}} *) + +let BALL_DIST = prove_by_refinement( + `!X d x y (z:A) r. metric_space(X,d) /\ open_ball(X,d) z r x /\ + open_ball(X,d) z r y ==> d x y <. (&.2 * r)`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_space;open_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + USE 0 (SPECL [`x:A`;`z:A`;`y:A`]); + REWR 0; + UND 0 THEN DISCH_ALL_TAC; + UND 9; + UND 6; + ASM_REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let BALL_DIST_CLOSED = prove_by_refinement( + `!X d x y (z:A) r. metric_space(X,d) /\ closed_ball(X,d) z r x /\ + closed_ball(X,d) z r y ==> d x y <=. (&.2 * r)`, + (* {{{ proof *) + + [ + REWRITE_TAC[metric_space;closed_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + USE 0 (SPECL [`x:A`;`z:A`;`y:A`]); + REWR 0; + UND 0 THEN DISCH_ALL_TAC; + UND 9; + UND 6; + ASM_REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + + +let open_ball_sub_closed = prove_by_refinement( + `!X d (x:A) r. + (open_ball(X,d) x r SUBSET (closed_ball(X,d) x r))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[SUBSET;IN;open_ball;closed_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 2; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let ball_symm = prove_by_refinement( + `!X d (x:A) y r. metric_space(X,d) /\ (X x) /\ (X y) ==> + (open_ball(X,d) x r y = open_ball(X,d) y r x)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC [open_ball;IN_ELIM_THM']; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC [metric_space_symm]; + ]);; + (* }}} *) + +let ball_subset_ball = prove_by_refinement( + `!X d (x:A) z r. metric_space(X,d) /\ + (open_ball(X,d) x r z ) ==> + (open_ball(X,d) z r SUBSET (open_ball(X,d) x (&.2 * r)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[SUBSET;IN]; + DISCH_ALL_TAC; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + TYPE_THEN `X z /\ X x' /\ X x` SUBGOAL_TAC ; + UND 2; + UND 1; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + MESON_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `open_ball(X,d) z r x` SUBGOAL_TAC; + ASM_MESON_TAC[ball_symm]; + ASM_MESON_TAC[BALL_DIST]; + ]);; + (* }}} *) + + +(* top_of_metric *) + +let top_of_metric_unions = prove_by_refinement( + `!(X:A->bool) d. (metric_space (X,d)) ==> + (X = UNIONS (top_of_metric (X,d)))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_TAC; + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC; + REWRITE_TAC[SUBSET]; + REWRITE_TAC[IN_UNIONS;top_of_metric]; + DISCH_ALL_TAC; + EXISTS_TAC `open_ball(X,d) (x:A) (&.1)`; + UNDISCH_TAC `(x:A) IN X` THEN (REWRITE_TAC[IN_ELIM_THM]); + DISCH_ALL_TAC; + CONJ_TAC; + EXISTS_TAC `{(open_ball(X,d) (x:A) (&.1))}`; + REWRITE_TAC[GSYM UNIONS_1;INSERT_SUBSET;EMPTY_SUBSET]; + REWRITE_TAC[open_balls;IN_ELIM_THM]; + MESON_TAC[]; + REWRITE_TAC[IN_ELIM_THM;open_ball]; + UNDISCH_FIND_TAC `(IN)`; + ASM_REWRITE_TAC[IN]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + UNDISCH_FIND_TAC `metric_space`; + REWRITE_TAC[metric_space]; + DISCH_THEN (fun t -> MP_TAC (ISPECL [`x:A`;`x:A`;`x:A`] t)); + ASM_MESON_TAC[REAL_ARITH `(&.0) <. (&.1)`]; + MATCH_MP_TAC UNIONS_SUBSET; + GEN_TAC; + REWRITE_TAC[top_of_metric;IN_ELIM_THM]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC UNIONS_SUBSET; + X_GEN_TAC `B:A->bool`; + DISCH_TAC; + SUBGOAL_TAC `(B:A->bool) IN open_balls (X,d)`; + ASM SET_TAC[]; + REWRITE_TAC[open_balls;IN_ELIM_THM]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_THEN (CHOOSE_THEN ASSUME_TAC); + ASM_REWRITE_TAC[]; + REWRITE_TAC[open_ball;SUBSET;IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let top_of_metric_empty = prove_by_refinement( + `!(X:A->bool) d. + ( (top_of_metric (X,d)) EMPTY)`, + (* {{{ proof *) + [ + REWRITE_TAC[top_of_metric]; + REPEAT GEN_TAC; + REWRITE_TAC[IN_ELIM_THM]; + EXISTS_TAC `EMPTY:(A->bool)->bool`; + REWRITE_TAC[UNIONS_0;EMPTY_SUBSET]; + ]);; +(* }}} *) + +let top_of_metric_open = prove_by_refinement( + `!(X:A->bool) d F. + (F SUBSET (open_balls (X,d))) ==> + ((UNIONS F) IN (top_of_metric(X,d)))`, + (* {{{ proof *) + [ + REWRITE_TAC[top_of_metric;IN_ELIM_THM]; + MESON_TAC[]; + ]);; + (* }}} *) + +let top_of_metric_open_balls = prove_by_refinement( + `!(X:A->bool) d. + (open_balls (X,d)) SUBSET (top_of_metric(X,d))`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET]; + REWRITE_TAC[top_of_metric;IN_ELIM_THM]; + DISCH_ALL_TAC; + EXISTS_TAC `{(x:A->bool)}`; + ASM SET_TAC[]; + ]);; + (* }}} *) + +let open_ball_open = prove_by_refinement( + `! (X:A->bool) d x r. (metric_space(X,d)) ==> + (top_of_metric (X,d) (open_ball (X,d) x r)) `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPEL_THEN [`X`;`d`] (fun t-> ASSUME_TAC ( ISPECL t top_of_metric_open_balls)); + USE 1 (REWRITE_RULE[open_balls;SUBSET;IN_ELIM_THM']); + ASM_MESON_TAC[IN]; + ]);; + (* }}} *) + +(* a set is open then every point contains a ball *) +let top_of_metric_nbd = prove_by_refinement( + `!(X:A->bool) d A. (metric_space (X,d)) ==> + ((top_of_metric (X,d) A) <=> ((A SUBSET X) /\ + (!a. (a IN A) ==> + (?r. (&.0 <. r) /\ (open_ball(X,d) a r SUBSET A)))))`, +(* {{{ proof *) + + [ + (DISCH_ALL_TAC); + EQ_TAC; + REWRITE_TAC[top_of_metric;IN_ELIM_THM]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + CONJ_TAC; + IMP_RES_THEN ASSUME_TAC top_of_metric_unions; + ASM_REWRITE_TAC[]; + IMP_RES_THEN ASSUME_TAC top_of_metric_open; + ASM ONCE_REWRITE_TAC[]; + MATCH_MP_TAC UNIONS_UNIONS; + ASM_MESON_TAC[SUBSET_TRANS;top_of_metric_open_balls]; + DISCH_ALL_TAC THEN (ASM_REWRITE_TAC[]); + REWRITE_TAC[IN_UNIONS;UNIONS_SUBSET]; + UNDISCH_FIND_TAC `(IN)`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_UNIONS]; + DISCH_THEN (CHOOSE_THEN ASSUME_TAC); + SUBGOAL_TAC `(t IN open_balls (X:A->bool,d))`; + ASM_MESON_TAC[SUBSET]; + REWRITE_TAC[open_balls;IN_ELIM_THM]; + REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)); + DISCH_TAC; + MP_TAC (SPECL[`(X:A->bool)`; `d:A->A->real`;`a:A`;`x:A`;`r:real`] open_ball_center); + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `(a:A) IN open_ball(X,d) x r`; + ASM_MESON_TAC[]; + DISCH_TAC THEN (ASM_REWRITE_TAC[]); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `r':real`; + ASM_REWRITE_TAC[]; + (* to here *) + SUBGOAL_TAC `!s. ((s:A->bool) IN F') ==> (s SUBSET (UNIONS F'))`; + SET_TAC[]; + ASM_MESON_TAC[SUBSET_TRANS] ; (*second direction: *) + DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT1 t) THEN MP_TAC (CONJUNCT2 t)); + DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[RIGHT_IMP_EXISTS_THM] t)); + REWRITE_TAC[SKOLEM_THM]; + DISCH_THEN CHOOSE_TAC; + REWRITE_TAC[top_of_metric;IN_ELIM_THM]; + EXISTS_TAC `IMAGE (\b. (open_ball(X,d) b (r b))) (A:A->bool)`; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET]; + REWRITE_TAC[IN_ELIM_THM;open_balls]; + MESON_TAC[IN]; + REWRITE_TAC[IMAGE]; + GEN_REWRITE_TAC I [EXTENSION]; + X_GEN_TAC `a:A`; + REWRITE_TAC[IN_UNIONS]; + REWRITE_TAC[IN_ELIM_THM]; + EQ_TAC; + DISCH_TAC; + EXISTS_TAC `open_ball (X,d) (a:A) (r a)`; + CONJ_TAC; + EXISTS_TAC `a:A`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN;open_ball]; + REWRITE_TAC[IN_ELIM_THM]; + ASM_MESON_TAC[metric_space_zero;IN;SUBSET]; (* last: *) + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + UNDISCH_FIND_TAC `(?)` ; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + UNDISCH_FIND_TAC `(!)`; + DISCH_THEN (fun t -> MP_TAC(SPEC `x:A` t)); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_MESON_TAC[SUBSET;IN]; + ]);; + +(* }}} *) + +let top_of_metric_inter = prove_by_refinement( + `!(X:A->bool) d. (metric_space (X,d)) ==> + (!A B. (top_of_metric (X,d) A) /\ (top_of_metric (X,d) B) ==> + (top_of_metric (X,d) (A INTER B)))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + DISCH_ALL_TAC; + IMP_RES_THEN ASSUME_TAC (SPECL [`X:A->bool`;`d:A->A->real`] top_of_metric_nbd); + UNDISCH_TAC `(top_of_metric (X,d) (B:A->bool))`; + UNDISCH_TAC `(top_of_metric (X,d) (A:A->bool))`; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CONJ_TAC; + ASM SET_TAC[]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `(INTER)` (fun t-> (MP_TAC (REWRITE_RULE[IN_INTER]t)) THEN DISCH_ALL_TAC ); + UNDISCH_FIND_THEN `(IN)` (fun t-> ANTE_RES_THEN MP_TAC t); + UNDISCH_FIND_THEN `(IN)` (fun t-> ANTE_RES_THEN MP_TAC t); + DISCH_THEN CHOOSE_TAC; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `if (r<. r') then r else r'`; + COND_CASES_TAC; + ASM_REWRITE_TAC[SUBSET_INTER]; + ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; + MP_TAC (ARITH_RULE `~(r<.r') ==> ((r'<. r) \/ (r'=r))`) THEN (ASM_REWRITE_TAC[]); + DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[SUBSET_INTER]; + ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS]; + ASM_MESON_TAC[SUBSET_INTER]; + ]);; +(* }}} *) + +let top_of_metric_union = prove_by_refinement( + `!(X:A->bool) d. (metric_space(X,d)) ==> + (!V. (V SUBSET top_of_metric(X,d)) ==> + (top_of_metric(X,d) (UNIONS V)))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`] top_of_metric_nbd); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + DISCH_ALL_TAC; + CONJ_TAC; + ASM_MESON_TAC[UNIONS_UNIONS;top_of_metric_unions]; + GEN_TAC; + REWRITE_TAC[IN_UNIONS]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + SUBGOAL_TAC `(top_of_metric (X,d)) (t:A->bool)`; + ASM_MESON_TAC[IN;SUBSET]; + MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`] top_of_metric_nbd); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `(!)` (fun t -> MP_TAC (SPEC `a:A` t)); + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `r:real`; + ASM_REWRITE_TAC[]; + ASM SET_TAC[UNIONS]; + ]);; +(* }}} *) + +let top_of_metric_top = prove_by_refinement( + `!(X:A->bool) d. ( (metric_space (X,d))) ==> + (topology_ (top_of_metric (X,d)))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[topology]; + REPEAT GEN_TAC; + ASM_SIMP_TAC[top_of_metric_empty;top_of_metric_inter;top_of_metric_union]; + ]);; +(* }}} *) + +let closed_ball_closed = prove_by_refinement( + `!X d (x:A) r. (metric_space (X,d)) ==> + (closed_ (top_of_metric(X,d)) (closed_ball(X,d) x r))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `X x` ASM_CASES_TAC ; + REWRITE_TAC[closed]; + ASM_SIMP_TAC [GSYM top_of_metric_unions]; + SUBCONJ_TAC; + REWRITE_TAC[closed_ball;SUBSET;IN;IN_ELIM_THM']; + MESON_TAC[]; + DISCH_ALL_TAC; + REWRITE_TAC[open_DEF]; + COPY 0; + USE 0 (MATCH_MP top_of_metric_top); + ONCE_ASM_SIMP_TAC[open_nbd]; + GEN_TAC; + TYPE_THEN `open_ball(X,d) x' (d x x' -. r)` EXISTS_TAC; + TYPE_THEN `R = (d x x' -. r)` ABBREV_TAC; + DISCH_ALL_TAC; + TYPE_THEN `X x'` SUBGOAL_TAC; + USE 5 (REWRITE_RULE[INR IN_DIFF]); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[DIFF_SUBSET;open_ball_subset;INTER;EQ_EMPTY;IN_ELIM_THM']; + X_GEN_TAC `y:A`; + REWRITE_TAC[IN]; + ASM_REWRITE_TAC[open_ball;closed_ball]; + REWRITE_TAC[IN_ELIM_THM';GSYM CONJ_ASSOC]; + PROOF_BY_CONTR_TAC; + USE 7 (REWRITE_RULE[]); + AND 7; + REWR 7; + COPY 3; + USE 3 (REWRITE_RULE[metric_space]); + TYPEL_THEN [`x`;`y`;`x'`] (USE 3 o SPECL); + REWR 3; + ALL_TAC; (* "bb"; *) + TYPE_THEN `d x' y = d y x'` SUBGOAL_TAC; + TYPEL_THEN [`X`;`d`] (fun t-> MATCH_MP_TAC (SPECL t metric_space_symm)); + ASM_REWRITE_TAC[]; + DISCH_TAC; + UND 7; + UND 10; + AND 3; + AND 3; + AND 3; + UND 3; + EXPAND_TAC "R"; + ALL_TAC; (* "cb" *) + REAL_ARITH_TAC; + ALL_TAC; (* "cbc" *) + DISCH_TAC; + ASM_SIMP_TAC [open_ball_open]; + MATCH_MP_TAC (INR open_ball_nonempty); + ASM_REWRITE_TAC[]; + EXPAND_TAC "R"; + PROOF_BY_CONTR_TAC; + USE 8 (MATCH_MP (REAL_ARITH `~(&.0 < d x x' - r) ==> (d x x' <=. r)`)); + USE 5 (REWRITE_RULE[INR IN_DIFF;closed_ball;IN_ELIM_THM']); + ASM_MESON_TAC[]; + TYPE_THEN `(closed_ball (X,d) x r) = EMPTY` SUBGOAL_TAC; +(**** Old step changed by JRH for modified set comprehensions + ASM_REWRITE_TAC[closed_ball;EMPTY;GSPEC]; + ***) + ASM_REWRITE_TAC[closed_ball;IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY]; + DISCH_THEN (REWRT_TAC); + ALL_TAC; (* "cbc1" *) + ASM_MESON_TAC[empty_closed;top_of_metric_top]; + ]);; + (* }}} *) + +let open_ball_nbd = prove_by_refinement( + `!X d C x. ?e. (metric_space((X:A->bool),d)) /\ (C x) /\ + (top_of_metric (X,d) C) ==> + ((&.0 < e) /\ (open_ball (X,d) x e SUBSET C))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + RIGHT_TAC "e"; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[top_of_metric;open_balls;IN_ELIM_THM';SUBSET;IN ]); + CHO 2; + AND 2; + ASM_REWRITE_TAC[]; + REWR 1; + USE 1 (REWRITE_RULE[UNIONS;IN;IN_ELIM_THM' ]); + CHO 1; + TYPE_THEN `u` (USE 3 o SPEC); + REWR 3; + CHO 3; + CHO 3; + REWR 1; + TYPEL_THEN [`X`;`d`;`x`;`x'`;`r`] (fun t-> (ASSUME_TAC (ISPECL t open_ball_center))); + USE 4 (REWRITE_RULE[IN ]); + REWR 4; + CHO 4; + TYPE_THEN `r'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;UNIONS;IN;IN_ELIM_THM']; + DISCH_ALL_TAC; + AND 4; + USE 4 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + + +(* closure *) + +let closure_closed = prove_by_refinement( + `!U (A:A->bool). (topology_ U) /\ (A SUBSET (UNIONS U)) ==> + (closed_ U (closure U A))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[closure]; + MATCH_MP_TAC closed_inter; + REWRITE_TAC[IN_ELIM_THM]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + MESON_TAC[]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `UNIONS U` EXISTS_TAC; + ASM_REWRITE_TAC[IN_ELIM_THM']; + ASM_SIMP_TAC[closed_UNIV]; + ]);; +(* }}} *) + +let subset_closure = prove_by_refinement( + `!U (A:A->bool). (topology_ U) ==> (A SUBSET (closure U A))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[closure;SUBSET;IN_INTERS;IN_ELIM_THM]; + X_GEN_TAC `a:A`; + MESON_TAC[IN]; + ]);; + (* }}} *) + +let closure_subset = prove_by_refinement( + `!U (A:A->bool) B. (topology_ U) /\ (closed_ U B) /\ (A SUBSET B) + ==> (closure U A SUBSET B)`, + (* {{{ proof *) + [ + REWRITE_TAC[closure]; + DISCH_ALL_TAC; + MATCH_MP_TAC INTERS_SUBSET; + ASM_REWRITE_TAC[IN_ELIM_THM]; + ]);; + (* }}} *) + +let closure_self = prove_by_refinement( + `!U (A:A->bool). (topology_ U) /\ (closed_ U A) ==> + (closure U A = A)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MATCH_MP_TAC SUBSET_ANTISYM; + ASM_SIMP_TAC[subset_closure]; + ASM_SIMP_TAC[closure_subset;SUBSET_REFL]; + ]);; + (* }}} *) + +let closure_close = prove_by_refinement( + `!U Z (A:A->bool). (topology_ U) /\ (Z SUBSET (UNIONS U)) ==> + ((A = closure U Z) = ((Z SUBSET A) /\ (closed_ U A) /\ + (!B. (closed_ U B) /\ ((Z SUBSET B)) ==> + (A SUBSET B))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_THEN (REWRT_TAC); + ASM_SIMP_TAC[subset_closure;closure_closed;closure_subset]; + DISCH_ALL_TAC; + REWRITE_TAC [closure]; + MATCH_MP_TAC (SUBSET_ANTISYM); + CONJ_TAC; + REWRITE_TAC[SUBSET_INTERS]; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[]; + MATCH_MP_TAC INTERS_SUBSET; + REWRITE_TAC[IN_ELIM_THM']; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let closure_open = prove_by_refinement( + `!U Z (A:A->bool). (topology_ U) /\ (Z SUBSET (UNIONS U)) ==> + ((A = closure U Z) = ((Z SUBSET A) /\ (closed_ U A) /\ + (!B. (open_ U B) /\ ((B INTER Z) = EMPTY) ==> + ((B INTER A) = EMPTY))))`, + (* {{{ proof *) + + [ + REP_GEN_TAC; + DISCH_TAC; + ASM_SIMP_TAC[closure_close]; + MATCH_MP_TAC (TAUT `( A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`); + DISCH_TAC; + MATCH_MP_TAC (TAUT `( A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`); + DISCH_TAC; + EQ_TAC; + DISCH_TAC; + USE 2 (REWRITE_RULE[closed]); + ASM_REWRITE_TAC[]; + GEN_TAC; + USE 3 (SPEC `(UNIONS U) DIFF (B:A->bool)`); + DISCH_ALL_TAC; + UND 3; + ASM_SIMP_TAC[open_closed]; + ASM_REWRITE_TAC[DIFF_SUBSET]; + DISCH_TAC; + UND 5; + UND 3; + REWRITE_TAC[INTER_COMM]; + ALL_TAC; (* co1 *) + DISCH_ALL_TAC; + DISCH_ALL_TAC; + USE 3 (SPEC `(UNIONS U) DIFF (B:A->bool)`); + UND 3; + ASM_SIMP_TAC[closed_open]; + REWRITE_TAC[DIFF_INTER]; + ASM_SIMP_TAC[SUB_IMP_INTER]; + TYPE_THEN `A SUBSET (UNIONS U INTER A)` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[closed]); + AND 2; + UND 3; + ALL_TAC; (* co2 *) + SET_TAC[SUBSET;INTER]; + MESON_TAC [SUBSET_TRANS]; + ]);; + + (* }}} *) + + +(* induced topology *) + +let image_top = prove_by_refinement( + `!(U:(A->bool)->bool) (f:(A->bool)->(B->bool)). + ((topology_ U) /\ (EMPTY = f EMPTY) /\ + (!a b. (a IN U) /\ (b IN U) ==> + (((f a) INTER (f b)) = f (a INTER b))) /\ + (!V. (V SUBSET U) ==> (UNIONS (IMAGE f V) =f (UNIONS V) ))) + ==> (topology_ (IMAGE f U))`, + (* {{{ proof *) + + [ + REWRITE_TAC[topology]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[IMAGE;IN]; + REWRITE_TAC[IN_ELIM_THM]; + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[IMAGE;IN]; + REWRITE_TAC[IN_ELIM_THM]; + DISCH_ALL_TAC; + REPEAT (UNDISCH_FIND_THEN `(?)` CHOOSE_TAC); + ASM_REWRITE_TAC[]; + EXISTS_TAC `(x:A->bool) INTER x'`; + ASM_SIMP_TAC[IN]; + DISCH_THEN (fun t-> MP_TAC (MATCH_MP SUBSET_PREIMAGE t)); + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]; + REWRITE_TAC[IMAGE;IN_ELIM_THM]; + EXISTS_TAC `UNIONS (Z:(A->bool)->bool)`; + ASM_SIMP_TAC[IN]; + ]);; + +(* }}} *) + +let induced_top_support = prove_by_refinement( + `!U (C:A->bool). (UNIONS (induced_top U C) = ((UNIONS U) INTER C))`, + (* {{{ proof *) + [ + REWRITE_TAC[UNIONS_INTER]; + DISCH_ALL_TAC; + AP_TERM_TAC; + REWRITE_TAC[induced_top]; + AP_THM_TAC; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT THEN BETA_TAC; + SET_TAC[]; + ]);; +(* }}} *) + +let induced_top_top = prove_by_refinement( + `!U (C:A->bool). (topology_ U) ==> (topology_ (induced_top U C))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_TAC; + REWRITE_TAC[induced_top]; + MATCH_MP_TAC image_top; + ASM_REWRITE_TAC[]; + CONJ_TAC; + SET_TAC[]; + CONJ_TAC; + SET_TAC[]; + REWRITE_TAC[UNIONS_INTER]; + DISCH_ALL_TAC; + AP_TERM_TAC; + AP_THM_TAC; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT THEN BETA_TAC; + SET_TAC[]; + ]);; +(* }}} *) + +let induced_top_open = prove_by_refinement( + `!U (C:A->bool) A. (topology_ U) ==> (induced_top U C A = + (?B. (U B) /\ ((B INTER C) = A)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[induced_top;IMAGE]; + REWRITE_TAC[IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let induced_trans = prove_by_refinement( + `! U (A:A->bool) B. (topology_ U) /\ U A /\ (induced_top U A B) ==> + (U B)`, + (* {{{ proof *) + [ + REWRITE_TAC[induced_top;IMAGE;IN ;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + CHO 2; + ASM_MESON_TAC[top_inter]; + ]);; + (* }}} *) + +let induced_top_unions = prove_by_refinement( + `!(U:(A->bool)->bool). (topology_ U) ==> + ((induced_top U (UNIONS U)) = U)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + ASM_SIMP_TAC[induced_top_open]; + EQ_TAC; + DISCH_ALL_TAC; + CHO 1; + USE 0 (REWRITE_RULE[topology]); + TYPE_THEN `B SUBSET (UNIONS U)` SUBGOAL_TAC; + ASM_MESON_TAC[sub_union ]; + REWRITE_TAC[SUBSET_INTER_ABSORPTION]; + DISCH_TAC ; + ASM_MESON_TAC[]; + DISCH_TAC ; + TYPE_THEN `x` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `x SUBSET (UNIONS U)` SUBGOAL_TAC; + ASM_MESON_TAC[sub_union ]; + REWRITE_TAC[SUBSET_INTER_ABSORPTION]; + ]);; + + (* }}} *) + +(* induced metric *) + +let gen = euclid_def `gen (X:(A->bool)->bool) + = {A | ?Y. (Y SUBSET X) /\ (A = UNIONS Y)}`;; + +let top_of_metric_gen = prove_by_refinement( + `!(X:(A)->bool) d. gen (open_balls(X,d))= (top_of_metric(X,d))`, +(* {{{ proof *) + [ + REWRITE_TAC[gen;top_of_metric]; + ]);; +(* }}} *) + +let gen_subset = prove_by_refinement( + `!U (V:(A->bool)->bool). (U SUBSET V) /\ + (!A. (A IN V) ==> (?Y. (Y SUBSET U) /\ (A = UNIONS Y))) + ==> (gen U = (gen V))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[EXTENSION]; + GEN_TAC THEN EQ_TAC; + REWRITE_TAC[IN_ELIM_THM;gen]; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[SUBSET_TRANS]; + REWRITE_TAC[IN_ELIM_THM;gen]; + DISCH_THEN CHOOSE_TAC; + UNDISCH_FIND_THEN `(?)` (fun t-> MP_TAC(REWRITE_RULE[RIGHT_IMP_EXISTS_THM;SKOLEM_THM]t)); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `UNIONS (IMAGE (Y':(A->bool)->((A->bool)->bool)) (Y:(A->bool)->bool))`; + CONJ_TAC; + MATCH_MP_TAC UNIONS_SUBSET; + REWRITE_TAC[IN_IMAGE]; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[IN;SUBSET]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIONS_IMAGE_UNIONS]; + AP_TERM_TAC; + REWRITE_TAC[GSYM IMAGE_o]; + REWRITE_TAC[EXTENSION]; + X_GEN_TAC `A:(A->bool)`; + REWRITE_TAC[IN_IMAGE;o_THM]; + ASM_MESON_TAC[SUBSET;IN]; + ]);; +(* }}} *) + +let gen_subspace = prove_by_refinement( + `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space(X,d)) ==> + (induced_top (top_of_metric(X,d)) Y = + gen (induced_top (open_balls(X,d)) Y))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[induced_top]; + REWRITE_TAC[EXTENSION]; + X_GEN_TAC `B:A->bool`; + REWRITE_TAC[IN_IMAGE]; + EQ_TAC; + DISCH_THEN (X_CHOOSE_TAC `C:A->bool`); + FIRST_ASSUM MP_TAC; + REWRITE_TAC[top_of_metric]; + REWRITE_TAC[IN_ELIM_THM]; + DISCH_ALL_TAC; + UNDISCH_FIND_TAC `(?)`; + DISCH_THEN (CHOOSE_TAC); + UNDISCH_FIND_TAC `(INTER)`; + ASM_REWRITE_TAC[UNIONS_INTER]; + REWRITE_TAC[gen;IN_ELIM_THM]; + EXISTS_TAC `IMAGE ((INTER) Y) (F':(A->bool)->bool)`; + CONJ_TAC; + REWRITE_TAC[INTER_THM]; + MATCH_MP_TAC IMAGE_SUBSET; + ASM_REWRITE_TAC[]; + REFL_TAC; + REWRITE_TAC[gen;IN_ELIM_THM]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + IMP_RES_THEN MP_TAC SUBSET_PREIMAGE; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `UNIONS (Z:(A->bool)->bool)`; + CONJ_TAC; + REWRITE_TAC[UNIONS_INTER]; + UNDISCH_FIND_THEN `(UNIONS)` (fun t -> REWRITE_TAC[t]); + AP_TERM_TAC; + UNDISCH_FIND_TAC `(SUBSET)`; + REWRITE_TAC[INTER_THM]; + ASM_MESON_TAC[]; + REWRITE_TAC[top_of_metric;IN_ELIM_THM]; + ASM_MESON_TAC[]; + ]);; +(* }}} *) + +let gen_induced = prove_by_refinement( + `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space (X,d)) ==> + (gen (open_balls(Y,d)) = gen (induced_top (open_balls(X,d)) Y))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + MATCH_MP_TAC gen_subset; + CONJ_TAC; + REWRITE_TAC[induced_top;SUBSET;open_balls]; + REWRITE_TAC [IN_IMAGE]; + X_GEN_TAC `A:(A->bool)`; + REWRITE_TAC[IN_ELIM_THM]; + REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)); + DISCH_TAC; + ASM_REWRITE_TAC[]; + ASM_CASES_TAC `(Y:A->bool) (x:A)`; + CONV_TAC (relabel_bound_conv); + EXISTS_TAC `open_ball (X,d) (x:A) r`; + CONJ_TAC; + MATCH_MP_TAC open_ball_intersect; + ASM_MESON_TAC[IN]; + MESON_TAC[]; + EXISTS_TAC `open_ball (X,d) (x:A) (--. (&.1))`; + CONJ_TAC; + ASM_MESON_TAC[IN;INTER_EMPTY;open_ball_empty;open_ball_neg_radius;REAL_ARITH `(--.(&.1) <. (&.0))`]; + MESON_TAC[]; (* end of first half *) + REWRITE_TAC[induced_top;IN_IMAGE]; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + NAME_CONFLICT_TAC; + REWRITE_TAC[IN;open_balls]; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (CHOOSE_THEN ASSUME_TAC); + FIRST_ASSUM (CHOOSE_THEN ASSUME_TAC); + SUBGOAL_TAC `!(a:A). (a IN x INTER Y) ==> (?r. ((&.0) <. r) /\ open_ball(Y,d) a r SUBSET (x INTER Y))`; + DISCH_ALL_TAC; + TYPEL_THEN [`X`;`d`;`a`;`x'`;`r'`] (fun t -> (CLEAN_ASSUME_TAC (ISPECL t open_ball_center))); + SUBGOAL_TAC `(a:A) IN open_ball(X,d) x' r'`; + ASM_MESON_TAC[IN_INTER]; + DISCH_THEN (fun t -> ANTE_RES_THEN (MP_TAC) t); + DISCH_THEN (CHOOSE_TAC); + EXISTS_TAC `r'':real`; + ASM_REWRITE_TAC[SUBSET_INTER;open_ball_subset]; + ASM_MESON_TAC[open_ball_subspace;SUBSET_TRANS]; + DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[RIGHT_IMP_EXISTS_THM;SKOLEM_THM] t)); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `IMAGE (\t. open_ball(Y,d) t (r t) ) ((x:A->bool) INTER Y)`; + REWRITE_TAC[SUBSET_INTER]; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN_ELIM_THM']; + REWRITE_TAC[IN_IMAGE]; + GEN_TAC; + MESON_TAC[]; + MATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET]; + GEN_TAC; + REWRITE_TAC[IN_UNIONS]; + DISCH_TAC; + EXISTS_TAC `open_ball (Y,d) (x'':A) (r x'')`; + REWRITE_TAC[IN_IMAGE]; + CONJ_TAC; + NAME_CONFLICT_TAC; + EXISTS_TAC `x'':A`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC open_ball_nonempty; + ASM_SIMP_TAC[metric_subspace]; + ASM_MESON_TAC[IN_INTER;IN;metric_subspace]; + MATCH_MP_TAC UNIONS_SUBSET; + GEN_TAC; + REWRITE_TAC[IN_IMAGE]; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[]; + ]);; +(* }}} *) + +let top_of_metric_induced = prove_by_refinement( + `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space(X,d)) ==> + (induced_top (top_of_metric(X,d)) Y = (top_of_metric(Y,d)))`, +(* {{{ proof *) + [ + SIMP_TAC[gen_subspace]; + REPEAT GEN_TAC; + REWRITE_TAC[GSYM top_of_metric_gen]; + MESON_TAC[gen_induced]; + ]);; +(* }}} *) + +(* ------------------------------------------------------------------ *) +(* Continuity *) +(* ------------------------------------------------------------------ *) + + +let continuous = euclid_def `continuous (f:A->B) U V <=> !v. + (v IN V) ==> (preimage (UNIONS U) f v) IN U`;; + +let metric_continuous_pt = euclid_def + `metric_continuous_pt (f:A->B) (X,dX) ((Y:B->bool),dY) x = + !epsilon. ?delta. (((&.0) < epsilon) ==> ((&.0) <. delta) /\ + (!y. ((x IN X) /\ (y IN X) /\ (dX x y) <. delta) ==> + (dY (f x) (f y) <. epsilon)))`;; + +let metric_continuous = euclid_def + `metric_continuous (f:A->B) (X,dX) (Y,dY) <=> !x. + metric_continuous_pt f (X,dX) (Y,dY) x`;; + +let metric_continuous_pt_domain = prove_by_refinement(`!f X dX Y dY x . + ~(x IN X) ==> (metric_continuous_pt (f:A->B) (X,dX) (Y,dY) x)`, + (* {{{ proof *) + + [ + REWRITE_TAC[metric_continuous_pt]; + MESON_TAC[]; + ]);; + + (* }}} *) + +let metric_continuous_continuous = prove_by_refinement( + `!f X Y dX dY. (IMAGE f X SUBSET Y) /\ (metric_space(X,dX)) /\ (metric_space(Y,dY)) + ==> + (continuous (f:A->B) (top_of_metric(X,dX)) (top_of_metric(Y,dY)) + <=> (metric_continuous f (X,dX) (Y,dY)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + REWRITE_TAC[continuous;metric_continuous]; + DISCH_TAC; + GEN_TAC; + ASM_CASES_TAC `(x:A) IN X` THENL[ALL_TAC;ASM_SIMP_TAC[metric_continuous_pt_domain]]; + REWRITE_TAC[metric_continuous_pt]; + GEN_TAC; + SUBGOAL_TAC `(open_ball (Y,dY) ((f:A->B) x) epsilon) IN (top_of_metric(Y,dY))`; + MATCH_MP_TAC (prove_by_refinement(`!(x:A) B. (?A. (x IN A /\ A SUBSET B)) ==> (x IN B)`,[SET_TAC[]])); + EXISTS_TAC `open_balls((Y:B->bool),dY)`; + REWRITE_TAC[top_of_metric_open_balls]; + REWRITE_TAC[open_balls;IN_ELIM_THM']; + MESON_TAC[]; + DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); + REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]; + DISCH_TAC; + SUBGOAL_TAC `(x:A) IN preimage (UNIONS (top_of_metric (X,dX))) f (open_ball (Y,dY) ((f:A->B) x) epsilon)`; + REWRITE_TAC[in_preimage]; + SUBGOAL_TAC `(Y:B->bool) ((f:A->B) x )`; + UNDISCH_FIND_TAC `IMAGE`; + UNDISCH_TAC `(x:A) IN X`; + REWRITE_TAC[SUBSET;IMAGE]; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC; + REWRITE_TAC[IN]; + MESON_TAC[]; + ASM_MESON_TAC[top_of_metric_unions;open_ball_nonempty]; + ABBREV_TAC `B = preimage (UNIONS (top_of_metric (X,dX))) (f:A->B) (open_ball (Y,dY) (f x) epsilon)`; + DISCH_TAC; + SUBGOAL_TAC `?r. (&.0 <. r) /\ (open_ball(X,dX) (x:A) r SUBSET B)`; + ASSUME_TAC top_of_metric_nbd; + ASM_MESON_TAC[IN]; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `r:real`; + ASM_REWRITE_TAC[]; + GEN_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC `y:A IN B`; + MATCH_MP_TAC (prove_by_refinement(`!(x:A) B. (?A. (x IN A /\ A SUBSET B)) ==> (x IN B)`,[SET_TAC[]])); + EXISTS_TAC `open_ball(X,dX) (x:A) r`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + ASM_MESON_TAC[IN]; + UNDISCH_FIND_TAC `preimage`; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[in_preimage]; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + MESON_TAC[]; (* first half done *) + REWRITE_TAC[metric_continuous]; + DISCH_TAC; + REWRITE_TAC[continuous]; + GEN_TAC; + DISCH_TAC; + REWRITE_TAC[IN]; + ASM_SIMP_TAC[top_of_metric_nbd]; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + CONJ_TAC; + REWRITE_TAC[SUBSET;in_preimage]; + MESON_TAC[]; + GEN_TAC; + DISCH_THEN (fun t -> ASSUME_TAC t THEN (MP_TAC (REWRITE_RULE[in_preimage] t))); + DISCH_ALL_TAC; + SUBGOAL_TAC `?eps. (&.0 <. eps) /\ (open_ball(Y,dY) ((f:A->B) a) eps SUBSET v)`; + UNDISCH_FIND_TAC `v IN top_of_metric (Y,dY)`; + REWRITE_TAC[IN]; + ASM_SIMP_TAC[top_of_metric_nbd]; + DISCH_THEN CHOOSE_TAC; + FIRST_ASSUM (fun t -> MP_TAC (SPEC `a:A` t)); + REWRITE_TAC[metric_continuous_pt]; + DISCH_THEN (fun t-> MP_TAC (SPEC `eps:real` t)); + DISCH_THEN (CHOOSE_THEN MP_TAC); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + EXISTS_TAC `delta:real`; + ASM_REWRITE_TAC[SUBSET]; + REWRITE_TAC[in_preimage;open_ball]; + REWRITE_TAC[IN_ELIM_THM']; + X_GEN_TAC `y:A`; + DISCH_ALL_TAC; + CONJ_TAC THENL [(ASM_REWRITE_TAC[IN]);ALL_TAC]; + FIRST_ASSUM (fun t -> (MP_TAC (SPEC `y:A` t))); + ASM_REWRITE_TAC[IN]; + UNDISCH_FIND_TAC `open_ball`; + REWRITE_TAC[open_ball]; + DISCH_THEN (fun t -> (MP_TAC (CONJUNCT2 t))); + REWRITE_TAC[SUBSET]; + DISCH_THEN (fun t-> (MP_TAC (SPEC `(f:A->B) y` t))); + ASM_REWRITE_TAC[IN_ELIM_THM']; + SUBGOAL_TAC `!x. (X x) ==> (Y ((f:A->B) x))`; + UNDISCH_FIND_TAC `IMAGE`; + REWRITE_TAC[SUBSET;IN_IMAGE]; + NAME_CONFLICT_TAC; + ASM_MESON_TAC[IN]; + ASM_MESON_TAC[IN]; + ]);; + (* }}} *) + +let continuous_induced = prove_by_refinement( + `!(f:A->B) U V A. (topology_ V) /\ (continuous f U V) /\ (V A) ==> + (continuous f U (induced_top V A)) `, + (* {{{ proof *) + [ + REWRITE_TAC[continuous;induced_top;IN_IMAGE;Q_ELIM_THM'' ]; + ASM_MESON_TAC[top_inter;IN ]; + ]);; + (* }}} *) + +let metric_cont = prove_by_refinement( + `!U X d f. (metric_space(X,d)) /\ (topology_ U) ==> + ((continuous (f:A->B) U (top_of_metric(X,d))) = + (!(x:B) r. U (preimage (UNIONS U) f (open_ball (X,d) x r))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[continuous;IN]); + UND 2 THEN (DISCH_THEN MATCH_MP_TAC ); + ASM_MESON_TAC [open_ball_open]; + REWRITE_TAC[continuous;IN]; + DISCH_ALL_TAC; + REWRITE_TAC[top_of_metric;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + CHO 3; + AND 3; + ASM_REWRITE_TAC[]; + REWRITE_TAC[preimage_unions]; + IMATCH_MP_TAC top_unions ; + ASM_REWRITE_TAC[IMAGE;SUBSET;IN;IN_ELIM_THM' ]; + NAME_CONFLICT_TAC; + REWRITE_TAC[Q_ELIM_THM']; + USE 4 (REWRITE_RULE[SUBSET;IN]); + DISCH_ALL_TAC; + TYPE_THEN `x'` (USE 4 o SPEC); + REWR 4; + USE 4 (REWRITE_RULE[open_balls;IN_ELIM_THM' ]); + CHO 4; + CHO 4; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let continuous_sum = prove_by_refinement( + `!U (f:A->(num->real)) g n. (topology_ U) /\ + (continuous f U (top_of_metric(euclid n,d_euclid))) /\ + (continuous g U (top_of_metric(euclid n,d_euclid))) /\ + (IMAGE f (UNIONS U) SUBSET (euclid n)) /\ + (IMAGE g (UNIONS U) SUBSET (euclid n)) ==> + (continuous (\t. (f t + g t)) U (top_of_metric(euclid n,d_euclid)))`, + (* {{{ proof *) + [ + ASSUME_TAC metric_euclid; + DISCH_ALL_TAC; + ASM_SIMP_TAC[metric_cont]; + DISCH_ALL_TAC; + ONCE_ASM_SIMP_TAC[open_nbd]; + X_GEN_TAC `t:A`; + RIGHT_TAC "B"; + DISCH_ALL_TAC; + USE 6 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]); + USE 2 (REWRITE_RULE[continuous]); + USE 3 (REWRITE_RULE[continuous]); + AND 6; + TYPE_THEN `n` (USE 0 o SPEC); + COPY 0; + JOIN 8 6; + USE 6 (MATCH_MP (REWRITE_RULE[IN] open_ball_center)); + CHO 6; + AND 6; + TYPE_THEN `open_ball(euclid n,d_euclid) (f t) (r'/(&.2))` (USE 2 o SPEC); + TYPE_THEN `open_ball(euclid n,d_euclid) (g t) (r'/(&.2))` (USE 3 o SPEC); + UND 3; + UND 2; + REWRITE_TAC[IN]; + ASM_SIMP_TAC[open_ball_open]; + DISCH_ALL_TAC; + TYPE_THEN `B = (preimage (UNIONS U) f (open_ball (euclid n,d_euclid) (f t) (r' / &2))) INTER (preimage (UNIONS U) g (open_ball (euclid n,d_euclid) (g t) (r' / &2)))` ABBREV_TAC ; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + (* cs1 *) + USE 6 (MATCH_MP preimage_subset ); + TYPEL_THEN [`(\t. euclid_plus (f t) (g t))`;`UNIONS U`] (USE 6 o ISPECL); + UND 6; + IMATCH_MP_TAC (prove_by_refinement(`!D B C. ((B:A->bool) SUBSET D) ==> ((D SUBSET C) ==> (B SUBSET C))`,[MESON_TAC [SUBSET_TRANS]])); + REWRITE_TAC[subset_preimage]; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;in_preimage;IN ;IN_ELIM_THM' ]; + ASM_MESON_TAC[]; + REWRITE_TAC[IMAGE;SUBSET;IN;IN_ELIM_THM']; + REWRITE_TAC[Q_ELIM_THM']; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;in_preimage;IN ;IN_ELIM_THM' ]; + REWRITE_TAC[open_ball;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + ASM_SIMP_TAC[euclid_add_closure]; + TYPE_THEN `d_euclid (f t + (g t)) (f x' + g x') <=. (d_euclid (f t + (g t)) (f x' + g t)) + (d_euclid (f x' + g t) (f x' + g x'))` SUBGOAL_TAC; + TYPEL_THEN [`euclid n`;`d_euclid`] (fun t-> ASSUME_TAC (ISPECL t metric_space_triangle)); + REWR 17; + UND 17 THEN DISCH_THEN IMATCH_MP_TAC ; + ASM_SIMP_TAC[euclid_add_closure]; + IMATCH_MP_TAC (REAL_ARITH `b + C < d ==> (a <= b + C ==> (a < d))`); + (* cs2 *) + IMATCH_MP_TAC real_half_LT; + CONJ_TAC; + ASM_MESON_TAC [euclid_add_closure;SPEC `n:num` metric_translate]; + ASM_MESON_TAC[euclid_add_closure;metric_translate_LEFT]; + CONJ_TAC; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;in_preimage ;IN_ELIM_THM]; + ASM_REWRITE_TAC[IN]; + UND 4; + UND 5; + REWRITE_TAC[SUBSET;IN;IN_IMAGE ;IN_ELIM_THM']; + NAME_CONFLICT_TAC; + REWRITE_TAC[Q_ELIM_THM'']; + USE 8 (ONCE_REWRITE_RULE [GSYM REAL_LT_HALF1]); + ASM_MESON_TAC[REWRITE_RULE[IN] open_ball_nonempty]; + EXPAND_TAC "B"; + IMATCH_MP_TAC top_inter; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Cauchy sequences and completeness *) +(* ------------------------------------------------------------------ *) + + +let sequence = euclid_def + `sequence X (f:num->A) <=> (IMAGE f UNIV) SUBSET X`;; + +let converge = euclid_def + `converge (X,d) (f:num -> A) <=> (?x. (x IN (X:A->bool)) /\ + (!eps. ?n. (&.0 <. eps) ==> + (!i. (n <=| i) ==> (d x (f i) <. eps))))`;; + +let cauchy_seq = euclid_def + `cauchy_seq (X,d) (f:num->A) <=> (sequence X f) /\ + (!eps. ?n. !i j. (&.0 <. eps) /\ + (n <= i) /\ (n <= j) ==> (d (f i) (f j) <. eps))`;; + +let complete = euclid_def + `complete (X,d) <=> !(f:num->A). cauchy_seq (X,d) f ==> + converge (X,d) f`;; + +let converge_cauchy = prove_by_refinement( + `!X d f. metric_space(X,d) /\ (sequence X f) /\ (converge((X:A->bool),d) f) + ==> cauchy_seq(X,d) f`, + (* {{{ proof *) + + [ + REWRITE_TAC[converge;metric_space]; + DISCH_ALL_TAC; + REWRITE_TAC[cauchy_seq]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM CHOOSE_TAC; + GEN_TAC; + UNDISCH_FIND_TAC `(IN)`; + DISCH_ALL_TAC; + FIRST_ASSUM (fun t-> MP_TAC (SPEC `eps/(&.2)` t)); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `n:num`; + REPEAT GEN_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC ` (&.0 <. (eps/(&.2)))`; + MATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); + UNDISCH_TAC `n <=| i`; + DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); + UNDISCH_TAC `n <=| j`; + DISCH_THEN (ANTE_RES_THEN ASSUME_TAC); + FIRST_ASSUM (fun t-> MP_TAC (SPECL [`(f:num->A) i`;`x:A`;`(f:num->A) j`] t)); + UNDISCH_FIND_TAC `sequence`; + REWRITE_TAC[sequence;SUBSET;IN_IMAGE;IN_UNIV]; + NAME_CONFLICT_TAC; + REWRITE_TAC[IN]; + DISCH_TAC; + SUBGOAL_TAC `X ((f:num->A) i) /\ X x /\ X (f j)`; + ASM_MESON_TAC[IN]; + DISCH_THEN (fun t->REWRITE_TAC[t]); + DISCH_ALL_TAC; + ASM_MESON_TAC[REAL_LET_TRANS;REAL_LT_ADD2;REAL_HALF_DOUBLE]; + ]);; + + (* }}} *) + + +(* relate the metric space version to the real numbers version *) +let cauchy_seq_cauchy = prove_by_refinement( + `!f. (cauchy_seq(euclid 1,d_euclid) f) ==> (cauchy (\x. (f x 0)))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[cauchy_seq;cauchy;sequence;SUBSET;IN_IMAGE;IN_UNIV]; + REWRITE_TAC[IN]; + NAME_CONFLICT_TAC; + DISCH_ALL_TAC; + GEN_TAC; + DISCH_TAC; + FIRST_ASSUM (fun t -> MP_TAC (SPEC `e':real` t)); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `n':num`; + REPEAT GEN_TAC; + REWRITE_TAC[ARITH_RULE `a >=| b <=> b <=| a`]; + SUBGOAL_TAC `euclid 1 (f (m':num)) /\ euclid 1 (f (n'':num))`; + ASM_MESON_TAC[]; + ASM_MESON_TAC[euclid1_abs]; + ]);; + (* }}} *) + +(* a variant of SEQ_CAUCHY *) +let complete_real = prove_by_refinement( + `complete (euclid 1,d_euclid)`, + (* {{{ proof *) + + [ + REWRITE_TAC[complete;converge]; + GEN_TAC; + DISCH_THEN (fun t-> ASSUME_TAC t THEN MP_TAC t); + DISCH_THEN (fun t -> MP_TAC (MATCH_MP cauchy_seq_cauchy t)); + REWRITE_TAC[SEQ_CAUCHY;SEQ_LIM;tends_num_real;SEQ_TENDS]; + ABBREV_TAC `z = lim (\x. f x 0)`; + REWRITE_TAC[MR1_DEF]; + DISCH_TAC; + ABBREV_TAC `c = \j. (if (j=0) then (z:real) else (&.0))`; + EXISTS_TAC `(c:num->real)`; + SUBGOAL_TAC `c IN (euclid 1)`; + REWRITE_TAC[IN;euclid]; + EXPAND_TAC "c"; + GEN_TAC; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + ARITH_TAC; + DISCH_TAC; + ASM_REWRITE_TAC[]; + GEN_TAC; + REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM]; + DISCH_TAC; + FIRST_ASSUM (fun t-> (MP_TAC (SPEC `eps:real` t))); + FIRST_ASSUM (fun t-> REWRITE_TAC[t]); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `N:num`; + GEN_TAC; + SUBGOAL_TAC `euclid 1 (f (i:num))`; + UNDISCH_FIND_TAC `cauchy_seq`; + REWRITE_TAC[cauchy_seq;sequence;SUBSET;IN_IMAGE;IN_UNIV]; + DISCH_THEN (fun t-> MP_TAC (CONJUNCT1 t)); + REWRITE_TAC[IN]; + MESON_TAC[]; + UNDISCH_FIND_TAC `(IN)`; + REWRITE_TAC[IN]; + SIMP_TAC[euclid1_abs]; + DISCH_ALL_TAC; + EXPAND_TAC "c"; + COND_CASES_TAC; + ASM_MESON_TAC[ARITH_RULE `n >=| N <=> N <= n`]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let sequence_in = prove_by_refinement( + `!X (f:num->A) i. sequence X f ==> X (f i)`, + (* {{{ proof *) + + [ + REPEAT GEN_TAC; + REWRITE_TAC[sequence;SUBSET;IN_IMAGE;IN_UNIV]; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + + (* }}} *) + +let proj_cauchy = prove_by_refinement( + `!i f n. cauchy_seq (euclid n,d_euclid) f ==> + (cauchy_seq (euclid 1,d_euclid) ((proj i) o f))`, + (* {{{ proof *) + + [ + REWRITE_TAC[cauchy_seq]; + DISCH_ALL_TAC; + SUBGOAL_TAC `sequence (euclid 1) (proj (i:num) o f)`; + REWRITE_TAC[sequence;SUBSET;IN_IMAGE;o_DEF;IN_UNIV]; + NAME_CONFLICT_TAC; + MESON_TAC[IN;proj_euclid1]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + GEN_TAC; + FIRST_ASSUM (fun t -> CHOOSE_TAC (SPEC `eps:real` t)); + EXISTS_TAC `n':num`; + DISCH_ALL_TAC; + FIRST_ASSUM (fun t-> MP_TAC(SPECL [`i':num`;`j:num`] t)); + UNDISCH_FIND_THEN `d_euclid` (fun t-> ALL_TAC); + ASM_REWRITE_TAC[]; + MATCH_MP_TAC (REAL_ARITH `a <=. b ==> (b <. eps ==> a <. eps)`); + REWRITE_TAC[o_DEF;proj_d_euclid]; + MATCH_MP_TAC proj_contraction; + EXISTS_TAC `n:num`; + ASM_MESON_TAC[sequence_in]; + ]);; + + (* }}} *) + +let complete_euclid = prove_by_refinement( + `!n. complete (euclid n,d_euclid)`, + (* {{{ proof *) + [ + REWRITE_TAC[complete;IN]; + REPEAT GEN_TAC; + DISCH_ALL_TAC; + IMP_RES_THEN MP_TAC proj_cauchy; + DISCH_TAC; + SUBGOAL_TAC `!i. converge (euclid 1,d_euclid) (proj i o f)`; + GEN_TAC; + ASM_MESON_TAC[complete;complete_real]; + REWRITE_TAC[converge;IN]; + DISCH_THEN (fun t-> MP_TAC (ONCE_REWRITE_RULE[SKOLEM_THM] t)); + DISCH_THEN (X_CHOOSE_TAC `L:num->(num->real)`); + EXISTS_TAC `(\j. ((L:num->num->real) j 0))`; + SUBCONJ_TAC; + REWRITE_TAC[euclid]; + GEN_TAC; + FIRST_ASSUM (fun t->(MP_TAC (SPEC `m:num` t))); + DISCH_ALL_TAC; + FIRST_ASSUM (fun t-> (MP_TAC (SPEC `abs((L:num->num->real) m 0)` t))); + DISCH_THEN CHOOSE_TAC; + PROOF_BY_CONTR_TAC; + ASSUME_TAC (REAL_ARITH `!x. ~(x=(&.0)) ==> (&.0 <. abs(x))`); + UNDISCH_FIND_TAC `d_euclid`; + ASM_SIMP_TAC[]; + REWRITE_TAC[GSYM EXISTS_NOT_THM]; + EXISTS_TAC `(n:num)+n'`; + REWRITE_TAC[o_DEF]; + REWRITE_TAC[ARITH_RULE `n' <=| n+| n'`]; + MATCH_MP_TAC(REAL_ARITH `(x = y) ==> ~(x (abs(u - x) = abs(u))`); + REWRITE_TAC[proj]; + SUBGOAL_TAC `euclid n (f (n+| n'))`; + ASM_MESON_TAC[cauchy_seq;sequence_in]; + REWRITE_TAC[euclid]; + DISCH_THEN (fun t-> ASM_SIMP_TAC[t]); + ALL_TAC; (* #buffer "CE2"; *) + DISCH_TAC; + GEN_TAC; + CONV_TAC (quant_right_CONV "n"); + DISCH_TAC; + USE 2 (CONV_RULE (quant_left_CONV "eps")); + USE 2 (CONV_RULE (quant_left_CONV "eps")); + USE 2 (SPEC `eps/(&.1 +. &. n)`); + USE 2 (CONV_RULE (quant_left_CONV "n'")); + USE 2 (CONV_RULE (quant_left_CONV "n'")); + CHO 2; + SUBGOAL_TAC `&.0 <. eps/ (&.1 +. &.n)`; + MATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT]; + ARITH_TAC; + DISCH_THEN (fun t-> (USE 2 (REWRITE_RULE[t]))); + SUBGOAL_TAC `!i j. euclid 1 ((proj i o f) (j:num))`; + ASM_MESON_TAC[cauchy_seq;sequence_in]; + DISCH_TAC; + SUBGOAL_TAC `!i. euclid n (f (i:num))`; + GEN_TAC; + ASM_MESON_TAC[cauchy_seq;sequence_in]; + DISCH_TAC; + ASM_SIMP_TAC[d_euclid_n]; + SUBGOAL_TAC `!(j:num). ?c. !i. (c <=| i) ==> ||. (L j 0 -. f i j) <. eps/(&.1 + &. n)`; + CONV_TAC (quant_left_CONV "c"); + EXISTS_TAC `n':num->num`; + REPEAT GEN_TAC; + USE 2 ((SPEC `j:num`)); + UND 2; + DISCH_ALL_TAC; + USE 8 (SPEC `i:num`); + UND 8; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[euclid1_abs]; + REWRITE_TAC[proj;o_DEF]; + CONV_TAC (quant_left_CONV "c"); + DISCH_THEN CHOOSE_TAC; + ABBREV_TAC `t = (\u. (if (u <| n) then (c u) else (0)))`; + SUBGOAL_TAC `?M. (!j. (t:num->num) j <=| M)`; + MATCH_MP_TAC max_num_sequence; + EXISTS_TAC `n:num`; + GEN_TAC; + EXPAND_TAC "t"; + COND_CASES_TAC; + ASM_MESON_TAC[ARITH_RULE `m <| n ==> ~(n <= m)`]; + REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `M:num`; + GEN_TAC; + ALL_TAC; (* #set "CE3"; *) + DISCH_TAC; + MATCH_MP_TAC REAL_POW_2_LT; + CONJ_TAC; + MATCH_MP_TAC SQRT_POS_LE; + REWRITE_TAC[REAL_SUM_SQUARE_POS]; + CONJ_TAC; + UND 4; + REAL_ARITH_TAC; + SIMP_TAC[REAL_SUM_SQUARE_POS;SQRT_POW_2]; + SUBGOAL_TAC `sum (0,n) (\i'. (L i' 0 - f (i:num) i') * (L i' 0 - f i i')) <=. sum (0,n) (\i'. (eps/(&.1 + &.n)) * (eps/(&.1 + &.n)))`; + MATCH_MP_TAC SUM_LE; + BETA_TAC; + GEN_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC `c (r:num) = (t:num->num) r`; + EXPAND_TAC "t"; + COND_CASES_TAC; + REFL_TAC; + ASM_MESON_TAC[ARITH_RULE `n +| 0 = n`]; + DISCH_TAC; + SUBGOAL_TAC `(abs (L r 0 - f (i:num) (r:num)) < eps/(&.1 + &.n))`; + USE 7 (SPECL [`r:num`;`i:num`]); + UND 7; + DISCH_THEN MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + USE 9 (SPEC `r:num`); + JOIN 7 10; + UND 7; + REWRITE_TAC[LE_TRANS]; + ALL_TAC; (* "CE4" *) + ABBREV_TAC `b = eps/(&1 + &n)`; + ABBREV_TAC `a = (L r 0 - (f:num->num->real) i r)`; + REWRITE_TAC[GSYM REAL_POW_2]; + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS]; + REAL_ARITH_TAC; + MATCH_MP_TAC (REAL_ARITH `(b <. c) ==> ((a <=. b) ==> (a <. c))`); + REWRITE_TAC[SUM_CONST]; + REWRITE_TAC[REAL_MUL_AC;real_div]; + SUBGOAL_TAC `eps pow 2 = eps*eps*(&. 1)`; + REWRITE_TAC[REAL_POW_2]; + REAL_ARITH_TAC; + DISCH_THEN (fun t->REWRITE_TAC[t]); + MATCH_MP_TAC REAL_PROP_LT_LMUL; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_PROP_LT_LMUL; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `&.0 <. &.1 + &.n `; + REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT]; + ARITH_TAC; + ALL_TAC; (* "CE5" *) + SIMP_TAC[REAL_INV_LT]; + DISCH_TAC; + REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT;REAL_OF_NUM_MUL]; + REWRITE_TAC[ARITH_RULE `(1+n)*(1+n)*1 = 1+n+n+n*n`]; + MATCH_MP_TAC (ARITH_RULE `(0<=a)/\(0<=b) /\(0<1) ==> (a <| 1 + a + a + b)`); + CONJ_TAC; + ARITH_TAC; + CONJ_TAC; + ONCE_REWRITE_TAC [ARITH_RULE `0 = n *| 0`]; + REWRITE_TAC[LE_MULT_LCANCEL]; + ARITH_TAC; + ARITH_TAC; + ]);; + (* }}} *) + +let subset_sequence = prove_by_refinement( + `!(X:A->bool) S f. S SUBSET X /\ sequence S f ==> + sequence X f`, + (* {{{ proof *) + [ + REWRITE_TAC[sequence]; + SET_TAC[]; + ]);; + (* }}} *) + +let subset_cauchy = prove_by_refinement( + `!(X:A->bool) S d f. S SUBSET X /\ cauchy_seq(S,d) f ==> + cauchy_seq(X,d) f`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + REWRITE_TAC[cauchy_seq]; + DISCH_ALL_TAC; + ASM_MESON_TAC[subset_sequence]; + ]);; + (* }}} *) + +let complete_closed = prove_by_refinement( + `!n S. (closed_ (top_of_metric (euclid n,d_euclid)) S) /\ + (S SUBSET (euclid n)) ==> + (complete (S,d_euclid))`, + (* {{{ proof *) + [ + REWRITE_TAC[complete]; + REPEAT GEN_TAC; + DISCH_ALL_TAC; + GEN_TAC; + DISCH_TAC; + USE 0 (MATCH_MP closed_open); + UND 0; + SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + DISCH_TAC; + SUBGOAL_TAC `cauchy_seq(euclid n,d_euclid) f`; + ASM_MESON_TAC[subset_cauchy]; + DISCH_TAC; + SUBGOAL_TAC `converge(euclid n,d_euclid) f`; + ASM_MESON_TAC[complete_euclid;complete]; + REWRITE_TAC[converge]; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `(x:num->real)`; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + SUBGOAL_TAC `~(x IN S) ==> (x IN (euclid n DIFF S))`; + ASM SET_TAC[]; + DISCH_TAC; + H_MATCH_MP (HYP "6") (HYP "5"); + USE 0 (REWRITE_RULE[open_DEF]); + USE 0 (REWRITE_RULE[(MATCH_MP (CONV_RULE (quant_right_CONV "A") top_of_metric_nbd) (SPEC `n:num` metric_euclid))]); + USE 0 (CONV_RULE (quant_left_CONV "a")); + USE 0 (SPEC `x:num->real`); + UND 0; + ASM_REWRITE_TAC[SUBSET_DIFF]; + ALL_TAC; (* #CC1; *) + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[]); + CHO 0; + USE 0 (REWRITE_RULE[SUBSET;IN_ELIM_THM';open_ball]); + AND 0; + AND 4; + USE 4 (SPEC `r:real`); + CHO 4; + H_MATCH_MP (HYP "4") (HYP "8"); + USE 10 (SPEC `n':num`); + USE 10 (REWRITE_RULE[ARITH_RULE `n <=| n`]); + USE 0 (SPEC `(f:num->num->real) n'`); + UND 0; + USE 9 (REWRITE_RULE[IN]); + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `(S:(num->real)->bool) ((f:num->num->real) n')`; + ASM_MESON_TAC[cauchy_seq;sequence_in]; + UND 1; + ABBREV_TAC `X = euclid n`; + ABBREV_TAC `a = (f:num->num->real) n'`; + REWRITE_TAC[IN_DIFF]; + REWRITE_TAC[IN;SUBSET]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Totally bounded metric spaces *) +(* ------------------------------------------------------------------ *) + + +let totally_bounded = euclid_def `totally_bounded ((X:A->bool),d) = + (!eps. ?B. (&.0 <. eps) ==> + (FINITE B) /\ + (!b. (B b) ==> ?x. b = open_ball(X,d) x eps) /\ + (X = UNIONS B))`;; + +let totally_bounded_subset = prove_by_refinement( + `!(X:A->bool) d S. (metric_space (X,d)) /\ (totally_bounded(X,d)) + /\ (S SUBSET X) ==> + (totally_bounded (S,d)) `, + (* {{{ proof *) + + [ + REPEAT GEN_TAC; + REWRITE_TAC[totally_bounded]; + DISCH_ALL_TAC; + GEN_TAC; + USE 1 (SPEC `eps/(&.2)`); + CHO 1; + CONV_TAC (quant_right_CONV "B"); + DISCH_TAC; + SUBGOAL_TAC `&.0 <. eps ==> &.0 <. eps/(&.2)`; + DISCH_THEN (fun t-> MP_TAC (ONCE_REWRITE_RULE[GSYM REAL_HALF_DOUBLE] t)); + REWRITE_TAC[REAL_DIV_LZERO]; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (UND 1) THEN (ASM_REWRITE_TAC[]) THEN DISCH_ALL_TAC; + SUBGOAL_TAC `!b. ?s. (?t. (t IN (b:A->bool) INTER S)) ==> (s IN b INTER S)`; + GEN_TAC; + CONV_TAC (quant_left_CONV "t"); + MESON_TAC[IN]; + CONV_TAC (quant_left_CONV "s"); + DISCH_THEN CHOOSE_TAC; + ALL_TAC; (* #set "TB1"; *) + EXISTS_TAC `IMAGE (\c. (open_ball ((S:A->bool),d) ((s) c) eps)) (B:(A->bool)->bool)`; + CONJ_TAC; + MATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + CONJ_TAC; + GEN_TAC; + REWRITE_TAC[IMAGE;IN_ELIM_THM']; + NAME_CONFLICT_TAC; + DISCH_THEN (X_CHOOSE_TAC `c:A->bool`); + ASM_MESON_TAC[]; + MATCH_MP_TAC EQ_EXT; + X_GEN_TAC `u:A`; + EQ_TAC; + DISCH_TAC; + SUBGOAL_TAC `(X:A->bool) (u:A)`; + ASM_MESON_TAC[SUBSET;IN]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REWRITE_RULE[IN] IN_UNIONS]; + DISCH_THEN (X_CHOOSE_TAC `b':A->bool`); + USE 7 (SPEC `b':A->bool`); + REWRITE_TAC[IMAGE]; + REWRITE_TAC[IN_ELIM_THM']; + CONV_TAC (quant_left_CONV "x"); + CONV_TAC (quant_left_CONV "x"); + EXISTS_TAC `b':A->bool`; + EXISTS_TAC `open_ball((S:A->bool),d) (s (b':A->bool)) eps`; + ASM_REWRITE_TAC[IN]; + REWRITE_TAC[open_ball]; + REWRITE_TAC[IN_ELIM_THM']; + ALL_TAC; (* #set "TB2"; *) + SUBGOAL_TAC `(u:A) IN (b' INTER S)`; + REWRITE_TAC[IN_INTER]; + ASM_MESON_TAC[IN]; + UND 7; + CONV_TAC (quant_left_CONV "t"); + CONV_TAC (quant_left_CONV "t"); + EXISTS_TAC `u:A`; + DISCH_TAC; + DISCH_TAC; + SUBGOAL_TAC `(S:A->bool) ((s:(A->bool)->A) b')`; + UND 7; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_INTER]; + MESON_TAC[IN]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `(b':A->bool) ((s:(A->bool)->A) b')`; + UND 11; + UND 7; + REWRITE_TAC[IN_INTER]; + ASM_MESON_TAC[IN]; + ALL_TAC; (* #set "TB3"; *) + DISCH_TAC; + AND 9; + USE 5 (SPEC `b':A->bool`); + H_MATCH_MP (HYP "5") (HYP "13"); + CHO 14; + ABBREV_TAC `v = (s:(A->bool)->A) b'`; + COPY 9; + UND 9; + UND 12; + ASM_REWRITE_TAC[]; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + SUBGOAL_TAC `(X x) /\ ((X:A->bool) u) /\ (X v)`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[SUBSET;IN]; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[metric_space]); + COPY 16; + KILL 1; + KILL 7; + KILL 11; + UND 21; + KILL 6; + UND 14; + DISCH_THEN (fun t-> ASSUME_TAC t THEN (REWRITE_TAC[t])); + REWRITE_TAC[open_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + USE 0 (SPECL [`v:A`;`x:A`;`u:A`]); + UND 0; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 22 (MATCH_MP (REAL_ARITH `(a <=. b + c) ==> !e. (b + c <. e ==> (a <. e))`)); + USE 22 (SPEC `eps:real`); + UND 22 THEN (DISCH_THEN (MATCH_MP_TAC)); + ASM_REWRITE_TAC[]; + UND 11; + UND 17; + MP_TAC (SPEC `eps:real` REAL_HALF_DOUBLE); + REAL_ARITH_TAC; + REWRITE_TAC[IMAGE;IN_ELIM_THM']; + REWRITE_TAC[UNIONS;IN_ELIM_THM']; + CONV_TAC (quant_left_CONV "x"); + CONV_TAC (quant_left_CONV "x"); + NAME_CONFLICT_TAC; + CONV_TAC (quant_left_CONV "x'"); + X_GEN_TAC `c:A->bool`; + CONV_TAC (quant_left_CONV "u'"); + GEN_TAC; + DISCH_ALL_TAC; + UND 10; + ASM_REWRITE_TAC[]; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + MESON_TAC[]; + ]);; + + (* }}} *) + +let integer_cube_finite = prove_by_refinement( + `!n N. FINITE { f | (euclid n f) /\ + (!i. (?j. (abs(f i) = &.j) /\ (j <=| N)))}`, + (* {{{ proof *) + + [ + REP_GEN_TAC; + ABBREV_TAC `fs = FUN {m | m <| n} {x | ?j. (abs x = &.j) /\ (j <=| N)}`; + ABBREV_TAC `gs = { f | (euclid n f) /\ (!i. (?j. (abs(f i) = &.j) /\ (j <=| N)))}`; + SUBGOAL_TAC `FINITE (fs:(num->real)->bool)`; + EXPAND_TAC "fs"; + MP_TAC(prove(`!(a:num->bool) (b:real->bool). FINITE a /\ FINITE b ==> (FINITE (FUN a b))`,MESON_TAC[HAS_SIZE;FUN_SIZE])); + DISCH_THEN MATCH_MP_TAC; + REWRITE_TAC[interval_finite;FINITE_NUMSEG_LT]; + DISCH_TAC; + ABBREV_TAC `G = (\ u. (\ j. if (n <=| j) then (&.0) else (u j)))`; + SUBGOAL_TAC `FINITE { y | ?x. x IN fs /\ (y:(num->real) = G (x:num->real))}`; + MATCH_MP_TAC FINITE_IMAGE_EXPAND; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `!a b. ((a:(num->real)->bool) = b) ==> (FINITE a ==> FINITE b)`; + REP_GEN_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + DISCH_THEN (fun t-> MATCH_MP_TAC t); + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + EXPAND_TAC "gs"; + REWRITE_TAC[IN_ELIM_THM']; + EXPAND_TAC "fs"; + REWRITE_TAC[FUN;IN_ELIM_THM']; + NAME_CONFLICT_TAC; + EQ_TAC; + DISCH_THEN (CHOOSE_TAC ); + SUBGOAL_TAC `euclid n x`; + REWRITE_TAC[euclid]; + GEN_TAC; + AND 4; + UND 4; + EXPAND_TAC "G"; + DISCH_THEN (fun t->REWRITE_TAC[t]); + DISCH_THEN (fun t->REWRITE_TAC[t]); + DISCH_TAC THEN (ASM_REWRITE_TAC[]); + GEN_TAC; + AND 4; + EXPAND_TAC "G"; + COND_CASES_TAC; + REDUCE_TAC; + EXISTS_TAC `0`; + REDUCE_TAC; + AND 6; + USE 8 (SPEC `i':num`); + ASM_MESON_TAC[ARITH_RULE `~(n <=| i') ==> (i' <| n)`]; + DISCH_ALL_TAC; + EXISTS_TAC `\p. (if (p <| n) then ((x:num->real) p) else (CHOICE UNIV))`; + CONJ_TAC; + REWRITE_TAC[SUPP;SUBSET;IN_ELIM_THM']; + NAME_CONFLICT_TAC; + CONJ_TAC; + GEN_TAC; + DISCH_THEN (fun t->REWRITE_TAC[t]); + UND 5; + MESON_TAC[]; + GEN_TAC; + COND_CASES_TAC; + REWRITE_TAC[]; + REWRITE_TAC[]; + MATCH_MP_TAC EQ_EXT; + X_GEN_TAC `q:num`; + EXPAND_TAC "G"; + COND_CASES_TAC; + ASM_MESON_TAC[euclid]; + USE 6 (MATCH_MP (ARITH_RULE `~(n <=| q) ==> (q <| n)`)); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let FINITE_scaled_lattice = prove_by_refinement( + `!n N s. (&.0 <. s) ==> FINITE {x | euclid n x /\ (!i. (?j. abs(x i) = s*(&.j)) /\ (abs(x i) <=. (&.N) ) ) }`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ABBREV_TAC `map = ( *# ) s`; + ASSUME_TAC REAL_ARCH_SIMPLE; + USE 2 (SPEC `inv(s)*(&.N)`); + UND 2 THEN (DISCH_THEN (X_CHOOSE_TAC `M:num`)); + ASSUME_TAC integer_cube_finite; + USE 3 (SPECL [`n:num`;`M:num`]); + USE 3 (MATCH_MP (ISPEC `map:(num->real)->(num->real)` FINITE_IMAGE_EXPAND)); + UND 3; + MATCH_MP_TAC (prove_by_refinement (`!a b. ((b:A->bool) SUBSET a) ==> (FINITE a ==> FINITE b)`,[MESON_TAC[FINITE_SUBSET]])); + REWRITE_TAC[SUBSET]; + X_GEN_TAC `c:num->real`; + REWRITE_TAC[IN_ELIM_THM']; + EXPAND_TAC "map"; + DISCH_ALL_TAC; + EXISTS_TAC `inv(s) *# c`; + REWRITE_TAC[euclid_scale_act]; + ASM_SIMP_TAC[euclid_scale_closure]; + WITH 0 (MATCH_MP (REAL_ARITH `&.0 < s ==> ~(s = &.0)`)); + ASM_SIMP_TAC[REAL_MUL_RINV]; + CONJ_TAC; + GEN_TAC; + USE 4 (SPEC `i:num`); + AND 4; + CHO 6; + REWRITE_TAC[euclid_scale;REAL_ABS_MUL;REAL_ABS_INV]; + SUBGOAL_TAC `abs s = s`; + UND 0; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + EXISTS_TAC `j:num`; + ALL_TAC; (* save_goal "C" *) + SUBCONJ_TAC; + ASM_REWRITE_TAC[]; + UND 5; + REWRITE_TAC[GSYM (CONJUNCT1 (CONJUNCT2 (REAL_MUL_AC)))]; + SIMP_TAC[REAL_MUL_LINV]; + REAL_ARITH_TAC; + DISCH_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_LE]; + USE 7 (GSYM); + UND 7 THEN DISCH_THEN (fun t-> REWRITE_TAC[t]); + USE 0 (MATCH_MP REAL_LT_INV); + ABBREV_TAC `s' = inv(s)`; + USE 0 (MATCH_MP (REAL_ARITH `&.0 < s' ==> &.0 <=. s'`)); + JOIN 0 4; + USE 0 (MATCH_MP REAL_LE_LMUL); + JOIN 0 2; + UND 0; + REAL_ARITH_TAC; + REWRITE_TAC[euclid_scale_one]; + ]);; + + (* }}} *) + +let totally_bounded_cube = prove_by_refinement( + `!n N. totally_bounded + ({x | euclid n x /\ (!i. abs(x i) <=. (&.N))},d_euclid)`, + (* {{{ proof *) + [ + REP_GEN_TAC; + REWRITE_TAC[totally_bounded]; + GEN_TAC; + CONV_TAC (quant_right_CONV "B"); + DISCH_TAC; + ABBREV_TAC `cent = {x | euclid n x /\ (!i. (?j. abs(x i) = (eps/(&.n+. &.1))*(&.j)) /\ (abs(x i) <=. (&.N) ) ) }`; + SUBGOAL_TAC `&.0 <. (&.n +. &.1)`; + REDUCE_TAC; + ARITH_TAC; + DISCH_TAC; + ABBREV_TAC `s = eps/(&.n +. &.1)`; + SUBGOAL_TAC `&.0 < s`; + EXPAND_TAC "s"; + ASM_SIMP_TAC[REAL_LT_DIV]; + DISCH_TAC; + SUBGOAL_TAC `FINITE (cent:(num->real)->bool)`; + EXPAND_TAC "cent"; + ASM_SIMP_TAC[FINITE_scaled_lattice]; + DISCH_TAC; + ABBREV_TAC `cube = {x | euclid n x /\ (!i. abs(x i) <=. (&.N))}`; + EXISTS_TAC `IMAGE (\c. open_ball(cube,d_euclid) c eps) cent`; + SUBCONJ_TAC; + ASM_MESON_TAC[FINITE_IMAGE]; + DISCH_TAC; + SUBCONJ_TAC; + GEN_TAC; + REWRITE_TAC[IMAGE;IN_ELIM_THM']; + ASM_MESON_TAC[]; + DISCH_TAC; + ALL_TAC; (* # TB1; *) + SUBGOAL_TAC `cent SUBSET (cube:(num->real)->bool)`; + REWRITE_TAC[SUBSET]; + EXPAND_TAC "cent"; + EXPAND_TAC "cube"; + REWRITE_TAC[IN_ELIM_THM']; + MESON_TAC[]; + DISCH_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + EQ_TAC; + DISCH_TAC; + REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; + ASSUME_TAC REAL_ARCH_LEAST; + USE 11 (SPEC `s:real`); + UND 11 THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC; + USE 11 (CONV_RULE (quant_left_CONV "n")); + USE 11 (CONV_RULE (quant_left_CONV "n")); + UND 11 THEN (DISCH_THEN (X_CHOOSE_TAC `cs:real->num`)); + NAME_CONFLICT_TAC; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + ABBREV_TAC `cx = \ (i:num) . if (&.0 <=. (x i)) then &(cs (x i))* s else --. (&.(cs (--. (x i))) * s )`; + EXISTS_TAC `cx:num->real`; + EXISTS_TAC `open_ball(cube,d_euclid) cx eps`; + ASM_REWRITE_TAC[]; + ALL_TAC; (* # TB2; *) + SUBGOAL_TAC `euclid n x`; + UND 10; + EXPAND_TAC "cube"; + REWRITE_TAC[IN_ELIM_THM']; + MESON_TAC[]; + DISCH_TAC; + SUBGOAL_TAC `cx IN (euclid n)`; + REWRITE_TAC[IN;euclid;]; + DISCH_ALL_TAC; + EXPAND_TAC "cx"; + UND 13; + REWRITE_TAC[euclid]; + DISCH_THEN (fun t-> MP_TAC(SPEC `m:num` t)); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + REDUCE_TAC; + USE 11 (SPEC `&.0`); + UND 11; + REDUCE_TAC; + ABBREV_TAC `(a:num) = (cs (&.0))`; + SUBGOAL_TAC `&.0 <=. &.a *s`; + REWRITE_TAC[REAL_MUL_NN]; + DISJ1_TAC; + REDUCE_TAC; + UND 4; + REAL_ARITH_TAC; + ABBREV_TAC `q = (&.a)*. s`; + REAL_ARITH_TAC; + DISCH_TAC; + ALL_TAC; (* # TB3; *) + SUBCONJ_TAC; + EXPAND_TAC "cent"; + REWRITE_TAC[IN_ELIM_THM']; + USE 14 (REWRITE_RULE[IN]); + ASM_REWRITE_TAC[]; + GEN_TAC; + EXPAND_TAC "cx"; + BETA_TAC; + COND_CASES_TAC; + SUBCONJ_TAC; + EXISTS_TAC `((cs:real->num) (x (i:num)))`; + REWRITE_TAC[REAL_ABS_MUL]; + REDUCE_TAC; + REWRITE_TAC[REAL_MUL_AC]; + AP_THM_TAC; + AP_TERM_TAC; + UND 4; + REAL_ARITH_TAC; + DISCH_TAC; + ALL_TAC; (* # TB4; *) + SUBGOAL_TAC `(&.0 <=. &.(cs ((x:num->real) i)) * s)`; + REWRITE_TAC[REAL_MUL_NN]; + DISJ1_TAC; + REDUCE_TAC; + UND 4 THEN REAL_ARITH_TAC; + DISCH_THEN (fun t-> MP_TAC (REWRITE_RULE[GSYM REAL_ABS_REFL] t)); + DISCH_THEN (fun t-> REWRITE_TAC [t]); + USE 11 (SPEC `(x:num->real) i`); + UND 11; + ASM_REWRITE_TAC []; + UND 10; + EXPAND_TAC "cube"; + REWRITE_TAC [IN_ELIM_THM']; + DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT2 t)); + USE 10 (SPEC `i:num`); + UND 10; + ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL])); + ASM_SIMP_TAC[]; + MESON_TAC[REAL_LE_TRANS]; + ALL_TAC ; (* #TB5; *) + REWRITE_TAC[REAL_ABS_NEG]; + SUBCONJ_TAC; + EXISTS_TAC `((cs:real->num) (--. (x (i:num))))`; + REWRITE_TAC [REAL_ABS_MUL]; + REDUCE_TAC; + ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL])); + ASSUME_TAC(REAL_ARITH `&.0 < x ==> &. 0 <=. x`); + ASM_SIMP_TAC[]; + REWRITE_TAC [REAL_MUL_AC]; + DISCH_TAC; + USE 11 (SPEC `--. (x (i:num))`); + UND 11; + ASSUME_TAC (REAL_ARITH `!x. ~(&.0 <= x) ==> (&.0 <= --. x)`); + ASM_SIMP_TAC[]; + UND 10; + EXPAND_TAC "cube"; + REWRITE_TAC[IN_ELIM_THM']; + DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT2 t)); + USE 10 (SPEC `i:num`); + UND 10; + MP_TAC(prove(`!v. (-- v <=. abs(v))`,REAL_ARITH_TAC)); + REWRITE_TAC [REAL_ABS_MUL]; + REDUCE_TAC; + ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL])); + ASSUME_TAC(REAL_ARITH `&.0 < x ==> &. 0 <=. x`); + ASM_SIMP_TAC[]; + MESON_TAC[REAL_LE_TRANS]; + ALL_TAC; (* #TB6; *) + DISCH_TAC; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 15; + UND 9; + REWRITE_TAC[SUBSET;IN]; + MESON_TAC[]; + SUBGOAL_TAC `d_euclid cx x <= sqrt(&.n)*s`; + MATCH_MP_TAC D_EUCLID_BOUND; + USE 14 (REWRITE_RULE[IN]); + ASM_REWRITE_TAC[]; + GEN_TAC; + EXPAND_TAC "cx"; + BETA_TAC; + ASSUME_TAC (REAL_ARITH `!x a b. a <=. x /\ x <. b ==> abs(a - x) <= b -a`); + SUBGOAL_TAC `!x. &.0 <=. x ==> abs(&.(cs x)*.s -. x) <=. s`; + DISCH_ALL_TAC; + USE 11 (SPEC `x':real`); + H_MATCH_MP (HYP "11") (HYP "17"); + H_MATCH_MP (HYP "16") (HYP "18"); + USE 19 (REWRITE_RULE [GSYM REAL_SUB_RDISTRIB]); + ALL_TAC; (* # TB7; *) + USE 19 (CONV_RULE REDUCE_CONV); + ASM_REWRITE_TAC []; + DISCH_TAC; + COND_CASES_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[REAL_ARITH `--x - y = --(x+.y)`;REAL_ABS_NEG]; + REWRITE_TAC[REAL_ARITH `x+. y = (x -. (--. y))`]; + ASM_MESON_TAC[REAL_ARITH `!u. ~(&.0 <=. u) ==> (&.0 <=. (--. u))`]; + ALL_TAC; (* # TB8; *) + MATCH_MP_TAC(REAL_ARITH `b < c ==> ((a<=b) ==> (a < c))`); + EXPAND_TAC "s"; + REWRITE_TAC[real_div;REAL_MUL_AC]; + MATCH_MP_TAC(REAL_ARITH`(t < e *(&.1)) ==> (t <. e)`); + MATCH_MP_TAC (REAL_LT_LMUL); + ASM_REWRITE_TAC[]; + ASSUME_TAC REAL_PROP_LT_LCANCEL ; + USE 16 (SPEC `&.n +. &.1`); + UND 16; + DISCH_THEN (MATCH_MP_TAC); + REDUCE_TAC; + SUBGOAL_TAC `~(&.(n+1) = &.0)`; + REDUCE_TAC; + ARITH_TAC; + REWRITE_TAC[REAL_ARITH`a*b*c = (a*b)*c`]; + ALL_TAC; (* # TB8; *) + SIMP_TAC[REAL_MUL_RINV]; + REDUCE_TAC; + DISCH_TAC; + CONJ_TAC; + ARITH_TAC; + SQUARE_TAC; + SUBCONJ_TAC; + MATCH_MP_TAC SQRT_POS_LE; + REDUCE_TAC; + DISCH_TAC; + SUBCONJ_TAC; + REDUCE_TAC; + DISCH_TAC; + SUBGOAL_TAC `&.0 <=. &.n`; + REDUCE_TAC; + SIMP_TAC[prove(`!x. (&.0 <=. x) ==> (sqrt(x) pow 2 = x)`,MESON_TAC[SQRT_POW2])]; + DISCH_TAC; + REWRITE_TAC[REAL_POW_2]; + REDUCE_TAC; + REWRITE_TAC[LEFT_ADD_DISTRIB;RIGHT_ADD_DISTRIB]; + REDUCE_TAC; + ABBREV_TAC `m = n*|n +| n`; + ARITH_TAC; + ALL_TAC; (* # TB9; *) + REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; + DISCH_THEN CHOOSE_TAC; + AND 10; + CHO 11; + AND 11; + UND 10; + ASM_REWRITE_TAC[]; + MP_TAC (ISPEC `cube:(num->real)->bool` open_ball_subset); + REWRITE_TAC[SUBSET]; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + (* }}} *) + +let center_FINITE = prove_by_refinement( + `!X d . metric_space ((X:A->bool),d) /\ (totally_bounded (X,d)) + ==> (!eps. (&.0 < eps) ==> (?C. (C SUBSET X) /\ (FINITE C) /\ (X = UNIONS (IMAGE (\x. open_ball(X,d) x eps) C))))`, + (* {{{ proof *) + [ + REWRITE_TAC[totally_bounded]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + USE 1 (SPEC `eps:real`); + CHO 1; + REWR 1; + AND 1; + AND 1; + USE 4 (CONV_RULE ((quant_left_CONV "x"))); + USE 4 (CONV_RULE ((quant_left_CONV "x"))); + CHO 4; + ABBREV_TAC `C'={z | (X (z:A)) /\ (?b. (B (b:A->bool)) /\ (z = x b))}`; + EXISTS_TAC `C':A->bool`; + SUBCONJ_TAC; + EXPAND_TAC"C'"; + REWRITE_TAC[SUBSET;IN_ELIM_THM']; + REWRITE_TAC[IN]; + MESON_TAC[]; + DISCH_TAC; + CONJ_TAC; + SUBGOAL_TAC `C' SUBSET (IMAGE (x:(A->bool)->A) B)`; + EXPAND_TAC"C'"; + REWRITE_TAC[SUBSET;IN_IMAGE;IN_ELIM_THM']; + NAME_CONFLICT_TAC; + MESON_TAC[IN]; + DISCH_TAC; + SUBGOAL_TAC `FINITE (IMAGE (x:(A->bool)->A) B)`; + ASM_MESON_TAC[FINITE_IMAGE]; + ASM_MESON_TAC[FINITE_SUBSET]; + ALL_TAC; (* #g1; *) + (ASM (GEN_REWRITE_TAC LAND_CONV)) []; + ( (GEN_REWRITE_TAC LAND_CONV)) [UNIONS_DELETE]; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[DELETE;IN_ELIM_THM';IMAGE]; + EXPAND_TAC "C'"; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC; + EQ_TAC; + DISCH_ALL_TAC; + USE 4 (SPEC `x':A->bool`); + CONV_TAC (quant_left_CONV "b'"); + CONV_TAC (quant_left_CONV "b'"); + CONV_TAC (quant_left_CONV "b'"); + EXISTS_TAC `x':(A->bool)`; + EXISTS_TAC `(x:(A->bool)->A) x'`; + REWRITE_TAC[]; + USE 7 (REWRITE_RULE[IN]); + H_MATCH_MP (HYP "4") (HYP"7"); + ALL_TAC; (* #g2 *) + ABBREV_TAC `a = (x:(A->bool)->A) x'`; + KILL 1; + ASM_REWRITE_TAC[]; + UND 8; + ASM_REWRITE_TAC[]; + MESON_TAC[open_ball_empty;IN]; + ALL_TAC; (* #g3 *) + DISCH_THEN CHOOSE_TAC; + UND 7; + DISCH_ALL_TAC; + CHO 8; + AND 8; + CONJ_TAC; + KILL 1; + ASM_REWRITE_TAC[]; + KILL 9; + USE 4 (SPEC `b':A->bool`); + REWR 1; + ASM_MESON_TAC[IN]; + KILL 1; + ASM_REWRITE_TAC[]; + UND 7; + ASM_REWRITE_TAC[]; + ABBREV_TAC `a = (x:(A->bool)->A) b'`; + DISCH_TAC; + JOIN 2 7; + JOIN 0 2; + USE 0 (MATCH_MP open_ball_nonempty); + UND 0; + ABBREV_TAC `E= open_ball(X,d) (a:A) eps `; + MESON_TAC[IN;EMPTY]; + ]);; + (* }}} *) + +let open_ball_dist = prove_by_refinement( + `!X d x y r. (open_ball(X,d) x r y) ==> (d (x:A) y <. r)`, + (* {{{ proof *) + [ + REWRITE_TAC[open_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let totally_bounded_bounded = prove_by_refinement( + `!(X:A->bool) d. metric_space(X,d) /\ totally_bounded (X,d) ==> + (?a r. X SUBSET (open_ball(X,d) a r))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + COPY 0; + JOIN 0 1; + USE 0 (MATCH_MP center_FINITE); + USE 0 (SPEC `&.1`); + USE 0 (CONV_RULE REDUCE_CONV); + CHO 0; + EXISTS_TAC `CHOICE (X:A->bool)`; + ASM_CASES_TAC `(X:A->bool) = EMPTY`; + ASM_REWRITE_TAC[EMPTY_SUBSET]; + USE 1 (MATCH_MP CHOICE_DEF); + UND 0 THEN DISCH_ALL_TAC; + ABBREV_TAC `(dset:real->bool) = IMAGE (\c. (d (CHOICE (X:A->bool)) (c:A))) C`; + SUBGOAL_TAC `FINITE (dset:real->bool)`; + EXPAND_TAC"dset"; + MATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 6 (MATCH_MP real_FINITE); + CHO 6; + EXISTS_TAC `a +. &.1`; + REWRITE_TAC[SUBSET]; + GEN_TAC; + REWRITE_TAC[open_ball;IN_ELIM_THM']; + UND 1; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + UND 4; + ASM_REWRITE_TAC[]; + DISCH_TAC; + (* ASM (GEN_REWRITE_TAC LAND_CONV) []; *) + USE 4(REWRITE_RULE[UNIONS;IN_IMAGE;IN_ELIM_THM']); + USE 4(fun t -> AP_THM t `x:A`); + UND 1; + DISCH_THEN (fun t-> ((MP_TAC t) THEN (ASM_REWRITE_TAC[])) THEN ASSUME_TAC t); + DISCH_TAC; + USE 8 (REWRITE_RULE[IN_ELIM_THM']); + CHO 8; + AND 8; + USE 9 (CONV_RULE NAME_CONFLICT_CONV); + CHO 9; + ALL_TAC; (* # "tbb"; *) + REWR 8; + USE 8(REWRITE_RULE[IN]); + USE 8 (MATCH_MP open_ball_dist); + AND 9; + SUBGOAL_TAC `d (CHOICE (X:A->bool)) (x':A) IN (dset:real->bool)`; + EXPAND_TAC"dset"; + REWRITE_TAC[IN_IMAGE]; + ASM_MESON_TAC[]; + DISCH_TAC; + H_MATCH_MP (HYP"6") (HYP"11"); + USE 2 (REWRITE_RULE[metric_space]); + USE 2 (SPECL[`(CHOICE (X:A->bool))`;`(x':A)`;`x:A`]); + KILL 4; + REWR 2; + SUBGOAL_TAC `(X:A->bool) x'`; + UND 9; + UND 0; + SET_TAC[IN;SUBSET]; + DISCH_TAC; + REWR 2; + UND 2 THEN DISCH_ALL_TAC; + UND 8; + UND 12; + UND 15; + ARITH_TAC; + ]);; + (* }}} *) + +let subsequence_rec = prove_by_refinement( + `!(X:A->bool) d f C s n r. + metric_space(X,d) /\ (totally_bounded(X,d)) /\ (sequence X f) /\ + (C SUBSET X) /\ (&.0 < r) /\ + (~FINITE{j| C (f j)} /\ C(f s) /\ (!x y. (C x /\ C y) ==> + d x y <. r*twopow(--: (&:n)))) ==> + (? C' s'. ((C' SUBSET C) /\ (s < s') /\ + (~FINITE{j| C' (f j)} /\ C'(f s') /\ (!x y. (C' x /\ C' y) ==> + d x y <. r*twopow(--: (&:(SUC n)))))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 1 (REWRITE_RULE[totally_bounded]); + USE 1 (SPEC `r*twopow(--: (&:(n+| 2)))`); + CHO 1; + ASSUME_TAC twopow_pos; + USE 8 (SPEC `--: (&: (n+| 2))`); + ALL_TAC; (* ## need a few lines here to match Z8 with Z1. *) + COPY 4; + JOIN 9 8; + USE 8 (MATCH_MP REAL_LT_MUL); + REWR 1; + UND 1 THEN DISCH_ALL_TAC; + ALL_TAC ; (* "sr1" OK TO HERE *) + ASSUME_TAC (ISPECL [`UNIV:num->bool`;`f:num->A`;`B:(A->bool)->bool`;`C:A->bool`] INFINITE_PIGEONHOLE); + UND 11; + ASM_SIMP_TAC[UNIV]; + H_REWRITE_RULE[HYP "10"] (HYP "3"); + ASM_REWRITE_TAC []; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `C INTER (b:A->bool)`; + CONV_TAC (quant_right_CONV "s'"); + SUBCONJ_TAC; + REWRITE_TAC[INTER_SUBSET]; + DISCH_TAC; + AND 12; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `~(FINITE ({i | (C INTER b) ((f:num->A) i)} INTER {i | s <| i}))`; + PROOF_BY_CONTR_TAC; + (USE 15) (REWRITE_RULE[]); + USE 15 (MATCH_MP num_above_finite); + UND 12; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ABBREV_TAC `J = ({i | (C INTER b) ((f:num->A) i)} INTER {i | s <| i})`; + EXISTS_TAC `CHOICE (J:num->bool)`; (* ok to here *) + SUBGOAL_TAC `J (CHOICE (J:num->bool))`; + MATCH_MP_TAC (REWRITE_RULE [IN] CHOICE_DEF); + PROOF_BY_CONTR_TAC; + USE 17 (REWRITE_RULE[]); + H_REWRITE_RULE[(HYP "17")] (HYP "15"); + UND 18; + REWRITE_TAC[FINITE_RULES]; + ALL_TAC; (* "sr2" *) + ABBREV_TAC `s' = (CHOICE (J:num->bool))`; + EXPAND_TAC "J"; + REWRITE_TAC[INTER;IN_ELIM_THM']; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + KILL 5 THEN (KILL 2) THEN (KILL 1) THEN (KILL 13) THEN (KILL 12); + SUBGOAL_TAC `(X x) /\ (X (y:A))`; + UND 21 THEN UND 23 THEN UND 3; + MESON_TAC[SUBSET;IN]; + USE 9 (SPEC `b:A->bool`); + H_REWRITE_RULE[HYP "14"] (HYP "1"); + CHO 2; + ALL_TAC; (* #"gg1" *) + JOIN 22 24; + JOIN 0 5; + H_REWRITE_RULE[(HYP "2")] (HYP "0"); + USE 5 (REWRITE_RULE[IN]); + USE 5 (MATCH_MP BALL_DIST); + DISCH_ALL_TAC; + UND 5; + MATCH_MP_TAC (REAL_ARITH `(b = c) ==> ((a<. b) ==> (a ~(r = &.0)`)); + ASM_REWRITE_TAC[]; + REWRITE_TAC[TWOPOW_NEG]; + REWRITE_TAC[ARITH_RULE `(n+|2) = 1 + (SUC n)`]; + REWRITE_TAC[REAL_POW_ADD;REAL_INV_MUL]; + REWRITE_TAC [REAL_MUL_ASSOC]; + REWRITE_TAC[REAL_INV2;REAL_POW_1]; + REDUCE_TAC; + ]);; + (* }}} *) + +let sequence_subseq = prove_by_refinement( + `!(X:A->bool) f (ss:num->num). (sequence X f) ==> + (sequence X (f o ss))`, + (* {{{ proof *) + [ + REWRITE_TAC[sequence;IMAGE;IN_UNIV;SUBSET;IN_ELIM_THM';o_DEF]; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + (* }}} *) + +let cauchy_subseq = prove_by_refinement( + `!(X:A->bool) d f. ((metric_space(X,d))/\(totally_bounded(X,d)) /\ + (sequence X f)) ==> + (?ss. (subseq ss) /\ (cauchy_seq(X,d) (f o ss)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + COPY 0 THEN COPY 1; + JOIN 4 3; + USE 3 (MATCH_MP totally_bounded_bounded); + CHO 3; + CHO 3; + ALL_TAC; (* {{{ xxx *) + ALL_TAC; (* make r pos *) + ASSUME_TAC (REAL_ARITH `r <. (&.1 + abs(r))`); + ASSUME_TAC (REAL_ARITH `&.0 <. (&.1 + abs(r))`); + ABBREV_TAC (`r' = &.1 +. abs(r)`); + SUBGOAL_TAC `open_ball(X,d) a r SUBSET open_ball(X,d) (a:A) r'`; + ASM_SIMP_TAC[open_ball_nest]; + DISCH_TAC; + JOIN 3 7; + USE 3 (MATCH_MP SUBSET_TRANS); + KILL 6; + KILL 4; + ALL_TAC; (* "cs1" *) + SUBGOAL_TAC `( !(x:A) y. (X x) /\ (X y) ==> (d x y <. &.2 *. r'))`; + DISCH_ALL_TAC; + USE 3 (REWRITE_RULE[SUBSET;IN]); + COPY 3; + USE 7 (SPEC `x:A`); + USE 3 (SPEC `y:A`); + H_MATCH_MP (HYP "3") (HYP "6"); + H_MATCH_MP (HYP "7") (HYP "4"); + JOIN 9 8; + JOIN 0 8; + USE 0 (MATCH_MP BALL_DIST); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ABBREV_TAC `cond = (\ ((C:A->bool),(s:num)) n. ~FINITE{j| C (f j)} /\ (C(f s)) /\ (!x y. (C x /\ C y) ==> d x y <. (&.2*.r')*. twopow(--: (&:n))))`; + ABBREV_TAC `R = (&.2)*r'`; + ALL_TAC ; (* 0 case of recursio *) + ALL_TAC; (* cs2 *) + SUBGOAL_TAC ` (X SUBSET X) /\ (cond ((X:A->bool),0) 0)`; + REWRITE_TAC[SUBSET_REFL]; + EXPAND_TAC "cond"; + CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV); + USE 2 (REWRITE_RULE[sequence;SUBSET;IN_IMAGE;IN_UNIV]); + USE 2 (REWRITE_RULE[IN]); + USE 2 (CONV_RULE (NAME_CONFLICT_CONV)); + SUBGOAL_TAC `!x. X((f:num->A) x)`; + ASM_MESON_TAC[]; + REDUCE_TAC; + REWRITE_TAC[TWOPOW_0] THEN REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBGOAL_TAC `{ j | (X:A->bool) (f j) } = (UNIV:num->bool)`; + MATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM;UNIV]; + ASM_REWRITE_TAC[]; + DISCH_THEN REWRT_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[num_infinite]; + ALL_TAC; (* #save_goal "cs3" *) + SUBGOAL_TAC `&.0 <. R`; + EXPAND_TAC "R"; + UND 5; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC `!cs n. ?cs' . (FST cs SUBSET X) /\ (cond cs n)==>( (FST cs' SUBSET (FST cs)) /\(SND cs <| ((SND:((A->bool)#num)->num) cs') /\ (cond cs' (SUC n))) )`; + DISCH_ALL_TAC; + CONV_TAC (quant_right_CONV "cs'"); + DISCH_TAC; + AND 11; + H_REWRITE_RULE[GSYM o (HYP "6")] (HYP "11"); + USE 13 (CONV_RULE (SUBS_CONV[GSYM(ISPEC `cs:(A->bool)#num` PAIR)])); + USE 13 (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV)); + JOIN 10 13; + JOIN 12 10; + JOIN 2 10; + JOIN 1 2; + JOIN 0 1; + USE 0 (MATCH_MP subsequence_rec); + CHO 0; + CHO 0; + EXISTS_TAC `(C':A->bool,s':num)`; + ASM_REWRITE_TAC[FST;SND]; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ALL_TAC; (* "cs4" *) + USE 11 (REWRITE_RULE[SKOLEM_THM]); + CHO 11; + ASSUME_TAC (ISPECL[`((X:A->bool),0)`;`cs':(((A->bool)#num)->(num->(A->bool)#num))`] num_RECURSION); + CHO 12; + EXISTS_TAC `\i. (SND ((fn : num->(A->bool)#num) i))`; + USE 11 (CONV_RULE (quant_left_CONV "n")); + USE 11 (SPEC `n:num`); + USE 11 (SPEC `(fn:num->(A->bool)#num) n`); + AND 12; + H_REWRITE_RULE[GSYM o (HYP "12")] (HYP "11"); + USE 14 (GEN_ALL); + ABBREV_TAC `sn = (\i. SND ((fn:num->(A->bool)#num) i))`; + ABBREV_TAC `Cn = (\i. FST ((fn:num->(A->bool)#num) i))`; + SUBGOAL_TAC `((sn:num->num) 0 = 0) /\ (Cn 0 = (X:A->bool))`; + EXPAND_TAC "sn"; + EXPAND_TAC "Cn"; + UND 13; + MESON_TAC[FST;SND]; + DISCH_TAC; + KILL 13; + KILL 11; + SUBGOAL_TAC `!(n:num). ((fn n):(A->bool)#num) = (Cn n,sn n)`; + EXPAND_TAC "sn"; + EXPAND_TAC "Cn"; + REWRITE_TAC[PAIR]; + DISCH_TAC; + H_REWRITE_RULE[(HYP "11")] (HYP"14"); + KILL 12; + KILL 14; + KILL 11; + KILL 16; + KILL 15; + ALL_TAC; (* }}} *) + ALL_TAC; (* KILL 10; cs4m *) + KILL 8; + KILL 7; + KILL 3; + KILL 5; + ALL_TAC; (* cs5 *) + TYPE_THEN `!n. (Cn n SUBSET X) /\ (cond (Cn n,sn n) n)` SUBGOAL_TAC; + INDUCT_TAC; + ASM_REWRITE_TAC[]; + SET_TAC[SUBSET]; + USE 13 (SPEC `n:num`); + REWR 5; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[SUBSET_TRANS]; + DISCH_TAC; + REWR 13; + SUBCONJ_TAC; + ASM_REWRITE_TAC[SUBSEQ_SUC]; + DISCH_TAC; + ASM_REWRITE_TAC[cauchy_seq]; + ASM_SIMP_TAC[sequence_subseq]; + GEN_TAC; + TYPE_THEN `!i j. (i <=| j) ==> (Cn j SUBSET (Cn i))` SUBGOAL_TAC; + MATCH_MP_TAC SUBSET_SUC2; + ASM_REWRITE_TAC[]; + DISCH_TAC; + ALL_TAC; (* cs6 *) + SUBGOAL_TAC `!R e. ?n. (&.0 <. R)/\ (&.0 <. e) ==> R*(twopow(--: (&:n))) <. e`; + DISCH_ALL_TAC; + REWRITE_TAC[TWOPOW_NEG]; (* cs6b *) + ASSUME_TAC (prove(`!n. &.0 < &.2 pow n`,REDUCE_TAC THEN ARITH_TAC)); + ONCE_REWRITE_TAC[REAL_MUL_AC]; + ASM_SIMP_TAC[REAL_INV_LT]; + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]; + CONV_TAC (quant_right_CONV "n"); + DISCH_ALL_TAC; + ASSUME_TAC (SPEC `R'/e` REAL_ARCH_SIMPLE); + CHO 14; + EXISTS_TAC `n:num`; + UND 14; + MESON_TAC[POW_2_LT;REAL_LET_TRANS]; + DISCH_TAC; + USE 11 (SPECL [`R:real`;`eps:real`]); + CHO 11; + EXISTS_TAC `n:num`; + DISCH_ALL_TAC; + REWR 11; + ALL_TAC; (* cs7 *) + COPY 3; + USE 3 (SPEC `n:num`); + AND 3; + UND 3; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + DISCH_ALL_TAC; + COPY 15; + USE 15 (SPEC `i:num`); + AND 15; + UND 15; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + DISCH_ALL_TAC; + COPY 20; + USE 20 (SPEC `j:num`); + AND 20; + UND 20; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + DISCH_ALL_TAC; + ABBREV_TAC `e2 = R * twopow (--: (&:n))`; + REWRITE_TAC[o_DEF]; + TYPEL_THEN [`f (sn i)`;`f (sn j)`] (fun t-> (USE 19 (SPECL t))); + KILL 27; + KILL 23; + KILL 25; + KILL 21; + KILL 16; + KILL 9; + KILL 6; + KILL 28; + COPY 8; + USE 8 (SPECL [`n:num`;`i:num`]); + USE 6 (SPECL [`n:num`;`j:num`]); + UND 11; + MATCH_MP_TAC (REAL_ARITH `(c < a) ==> ((a < b) ==> (c < b))`); + UND 19; + DISCH_THEN (MATCH_MP_TAC); + UND 6; + UND 8; + ASM_REWRITE_TAC[]; + UND 22; + UND 26; + MESON_TAC[IN;SUBSET]; + ]);; + + (* }}} *) + +let convergent_subseq = prove_by_refinement( + `!(X:A->bool) d f. metric_space(X,d) /\ (totally_bounded(X,d)) /\ + (complete (X,d)) /\ (sequence X f) ==> + ((?(ss:num->num). (subseq ss) /\ (converge (X,d) (f o ss))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `?ss. (subseq ss) /\ (cauchy_seq(X,d) (f o ss))` SUBGOAL_TAC; + ASM_MESON_TAC[cauchy_subseq]; + DISCH_ALL_TAC; + CHO 4; + EXISTS_TAC `ss:num->num`; + USE 2 (REWRITE_RULE[complete]); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let dense = euclid_def `!U Z. dense U Z <=> + (closure U (Z:A->bool) = UNIONS U)`;; + +let hausdorff = euclid_def `hausdorff U <=> (!x y. + (UNIONS U (x:A) /\ UNIONS U y /\ ~(x = y)) ==> + (?A B. (U A) /\ (U B) /\ (A x) /\ (B y) /\ (A INTER B = EMPTY)))`;; + +let dense_subset = prove_by_refinement( + `!U Z. (topology_ U) /\ (dense U (Z:A->bool)) ==> + (Z SUBSET (UNIONS U))`, + (* {{{ proof *) + [ + REWRITE_TAC[dense]; + MESON_TAC[subset_closure]; + ]);; + (* }}} *) + +let dense_open = prove_by_refinement( + `!U Z. (topology_ U) /\ (Z SUBSET (UNIONS U)) ==> + (dense U (Z:A->bool) <=> + (!A. (open_ U A) /\ ( (A INTER Z) = EMPTY) ==> (A = EMPTY)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + EQ_TAC; + DISCH_TAC; + DISCH_ALL_TAC; + COPY 3; + COPY 0; + JOIN 0 3; + USE 0 (MATCH_MP (open_closed)); + TYPE_THEN `Z SUBSET (UNIONS U DIFF A)` SUBGOAL_TAC; + ALL_TAC ; (* do1 *) + REWRITE_TAC[DIFF_SUBSET]; + ONCE_REWRITE_TAC[INTER_COMM]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + JOIN 0 3; + JOIN 6 0; + USE 0 (MATCH_MP closure_subset); + USE 0 (REWRITE_RULE[DIFF_SUBSET]); + AND 0; + USE 2 (REWRITE_RULE[dense]); + H_REWRITE_RULE [(HYP "2")] (HYP "0"); + (USE 5 (REWRITE_RULE[open_DEF])); + USE 5 (MATCH_MP sub_union); + USE 5 (REWRITE_RULE[ SUBSET_INTER_ABSORPTION]); + USE 5 (ONCE_REWRITE_RULE[INTER_COMM]); + ASM_MESON_TAC[]; + REWRITE_TAC[dense]; + DISCH_TAC ; + MATCH_MP_TAC EQ_SYM; + UND 0; + UND 1; + SIMP_TAC [closure_open]; + DISCH_TAC ; + SIMP_TAC[closed_UNIV]; + DISCH_TAC ; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + USE 2 (SPEC `B:A->bool`); + REWR 2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTER_EMPTY]; + ]);; + (* }}} *) + +let countable_dense = prove_by_refinement( + `!(X:A->bool) d. (metric_space(X,d)) /\ (totally_bounded(X,d)) ==> + ?Z. (COUNTABLE Z) /\ (dense (top_of_metric(X,d)) Z)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `!r. ?z. (COUNTABLE z) /\ (z SUBSET X) /\ (X = UNIONS (IMAGE (\x. open_ball(X,d) x (twopow(--: (&:r)))) z))` SUBGOAL_TAC; + GEN_TAC; + COPY 0; + COPY 1; + JOIN 2 3; + USE 2 (MATCH_MP center_FINITE); + USE 2 (SPEC `twopow (--: (&:r))`); + H_MATCH_MP (HYP "2") (THM (SPEC `(--: (&:r))` twopow_pos)); + X_CHO 3 `z:A->bool`; + EXISTS_TAC `z:A->bool`; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[FINITE_COUNTABLE]; + ASM_MESON_TAC[]; + CONV_TAC (quant_left_CONV "z"); + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `UNIONS (IMAGE z (UNIV:num->bool))` EXISTS_TAC; + CONJ_TAC; + MATCH_MP_TAC COUNTABLE_UNIONS; + CONJ_TAC; + MATCH_MP_TAC (ISPEC `UNIV:num->bool` COUNTABLE_IMAGE); + REWRITE_TAC[NUM_COUNTABLE]; + TYPE_THEN `z` EXISTS_TAC ; + SET_TAC[]; + GEN_TAC; + REWRITE_TAC[IN_IMAGE;IN_UNIV]; + ASM_MESON_TAC[ ]; + TYPE_THEN `U = top_of_metric (X,d)` ABBREV_TAC; + TYPE_THEN `Z = UNIONS (IMAGE z UNIV)` ABBREV_TAC; + TYPE_THEN `topology_ U /\ (Z SUBSET (UNIONS U))` SUBGOAL_TAC; + EXPAND_TAC "U"; + KILL 3; + ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions]; + EXPAND_TAC "Z"; + MATCH_MP_TAC UNIONS_SUBSET; + REWRITE_TAC[IN_IMAGE;IN_UNIV]; + ASM_MESON_TAC[]; + SIMP_TAC[dense_open]; + DISCH_ALL_TAC; + GEN_TAC; + REWRITE_TAC[open_DEF]; + MATCH_MP_TAC (TAUT `( a /\ ~b ==> ~c) ==> (a /\ c ==> b)`); + EXPAND_TAC "U"; + ASM_SIMP_TAC [top_of_metric_nbd]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]; + DISCH_ALL_TAC; + CHO 9; + TYPE_THEN `x` (fun t-> (USE 8 (SPEC t))); + REWR 8; + X_CHO 8 `eps:real`; + ALL_TAC; (*"cd5"*) + SUBGOAL_TAC `?r. twopow(--: (&:r)) < eps`; + ASSUME_TAC (SPECL [`&.1`;`eps:real`] twopow_eps); + USE 10 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + USE 2 (SPEC `r:num`); + AND 2; + AND 2; + TYPE_THEN `x IN X` SUBGOAL_TAC; + ASM SET_TAC[IN;SUBSET]; + ASM ONCE_REWRITE_TAC[]; + REWRITE_TAC[UNIONS;IN_ELIM_THM';IN_IMAGE]; + DISCH_THEN CHOOSE_TAC; + AND 13; + X_CHO 14 `z0:A`; + REWR 13; + AND 14; + EXISTS_TAC `z0:A`; + REWRITE_TAC[IN_INTER]; + USE 13 (REWRITE_RULE[IN]); + USE 13 (MATCH_MP open_ball_dist); + CONJ_TAC; + USE 8 (REWRITE_RULE [open_ball;SUBSET]); + AND 8; + USE 8 (SPEC `z0:A`); + USE 8 (REWRITE_RULE [IN_ELIM_THM']); + UND 8; + DISCH_THEN (MATCH_MP_TAC ); + ALL_TAC; (* "cd6" *) + SUBCONJ_TAC; + ASM SET_TAC[IN;SUBSET]; + DISCH_TAC; + SUBCONJ_TAC; + ASM SET_TAC[IN;SUBSET]; + DISCH_TAC; + UND 13; + UND 10; + USE 0 (REWRITE_RULE[metric_space]); + TYPEL_THEN [`z0`;`x`;`z0`] (fun t-> USE 0 (SPECL t)); + REWR 0; + UND 0; + REAL_ARITH_TAC; + EXPAND_TAC "Z"; + REWRITE_TAC[IN_UNIONS;IN_IMAGE;IN_UNIV]; + UND 14; + MESON_TAC[]; + ]);; + + (* }}} *) + +let metric_hausdorff = prove_by_refinement( + `! (X:A->bool) d. (metric_space(X,d))==> + (hausdorff (top_of_metric(X,d)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[hausdorff;]; + ASM_SIMP_TAC [GSYM top_of_metric_unions]; + DISCH_ALL_TAC; + COPY 0; + USE 4 (REWRITE_RULE[metric_space]); + TYPEL_THEN [`x`;`y`;`x`] (USE 4 o SPECL); + REWR 4; + TYPE_THEN `r = d x y` ABBREV_TAC; + SUBGOAL_TAC `&.0 <. r`; + UND 4; + ARITH_TAC; + DISCH_TAC; + TYPE_THEN `open_ball(X,d) x (r/(&.2))` EXISTS_TAC; + TYPE_THEN `open_ball(X,d) y (r/(&.2))` EXISTS_TAC; + ALL_TAC; (* mh1 *) + KILL 4; + ASM_SIMP_TAC[open_ball_open]; + COPY 6; + USE 4 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]); + ASM_SIMP_TAC[REWRITE_RULE[IN] open_ball_nonempty]; + PROOF_BY_CONTR_TAC; + USE 7 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 7; + USE 7 (REWRITE_RULE[IN_INTER]); + USE 7 (REWRITE_RULE[IN]); + ALL_TAC; (* mh2 *) + AND 7; + COPY 7; + COPY 8; + USE 7 (MATCH_MP open_ball_dist); + USE 8 (MATCH_MP open_ball_dist); + USE 0 (REWRITE_RULE[metric_space]); + COPY 0; + TYPEL_THEN [`x`;`u`;`y`] (fun t-> (USE 0 (ISPECL t))); + TYPEL_THEN [`y`;`u`;`y`] (fun t-> (USE 11 (ISPECL t))); + UND 11; + UND 0; + ASM_REWRITE_TAC[]; + TYPE_THEN `X u` SUBGOAL_TAC; + ASM_MESON_TAC[ open_ball_subset;IN;SUBSET]; + DISCH_THEN (REWRT_TAC); + DISCH_ALL_TAC; + UND 14; + UND 0; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + JOIN 7 8; + USE 0 (MATCH_MP (REAL_ARITH `(a <. c) /\ (b < c) ==> b+a < c + c`)); + USE 0 (CONV_RULE REDUCE_CONV); + ASM_MESON_TAC[real_lt]; + ]);; + + (* }}} *) + +(* compactness *) + +let compact = euclid_def `compact U (K:A->bool) <=> + (K SUBSET UNIONS U) /\ (!V. (K SUBSET UNIONS V ) /\ (V SUBSET U) ==> + (?W. (W SUBSET V) /\ (FINITE W) /\ (K SUBSET UNIONS W )))`;; + +let closed_compact = prove_by_refinement( + `!U K (S:A->bool). ((topology_ U) /\ (compact U K) /\ + (closed_ U S) /\ (S SUBSET K)) ==> (compact U S)`, + (* {{{ proof *) + [ + REWRITE_TAC[compact]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + SUBCONJ_TAC; + ASM_MESON_TAC[ SUBSET_TRANS]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `A = UNIONS U DIFF S` ABBREV_TAC; + TYPE_THEN `open_ U A` SUBGOAL_TAC ; + ASM_MESON_TAC[ closed_open]; + TYPE_THEN `V' = (A INSERT V)` ABBREV_TAC; + DISCH_ALL_TAC; + TYPE_THEN `V'` (USE 2 o SPEC); + ALL_TAC; (* cc1 *) + TYPE_THEN `K SUBSET UNIONS V'` SUBGOAL_TAC; + EXPAND_TAC "V'"; + EXPAND_TAC "A"; + UND 6; + UND 4; + UND 1; + TYPE_THEN `X = UNIONS U ` ABBREV_TAC; + ALL_TAC; (* cc2 *) + REWRITE_TAC[SUBSET_UNIONS_INSERT]; + SET_TAC[SUBSET;UNIONS;DIFF]; + DISCH_ALL_TAC; + TYPE_THEN `V' SUBSET U` SUBGOAL_TAC; + EXPAND_TAC "V'"; + EXPAND_TAC "A"; + REWRITE_TAC[INSERT_SUBSET]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[IN;open_DEF]; + DISCH_ALL_TAC; + REWR 2; + CHO 2; + TYPE_THEN `W DELETE A` EXISTS_TAC; + CONJ_TAC; + AND 2; + UND 13; + EXPAND_TAC "V'"; + SET_TAC[SUBSET;INSERT;DELETE]; + ASM_REWRITE_TAC[FINITE_DELETE]; + AND 2; + AND 2; + UND 2; + UND 4; + UND 1; + EXPAND_TAC "A"; + TYPE_THEN `X = UNIONS U ` ABBREV_TAC; + ALL_TAC; (* cc3 *) + DISCH_ALL_TAC; + MATCH_MP_TAC UNIONS_DELETE2; + CONJ_TAC; + ASM_MESON_TAC[SUBSET_TRANS]; + SET_TAC[INTER;DIFF]; + ]);; + (* }}} *) + + +let compact_closed = prove_by_refinement( + `!U (K:A->bool). (topology_ U) /\ (hausdorff U) /\ (compact U K) ==> + (closed_ U K)`, + (* {{{ proof *) + + [ + REWRITE_TAC[hausdorff;compact;closed]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[open_DEF]; + ONCE_ASM_SIMP_TAC[open_nbd]; + TYPE_THEN `C = UNIONS U DIFF K` ABBREV_TAC; + GEN_TAC; + CONV_TAC (quant_right_CONV "B"); + DISCH_ALL_TAC; + (* cc1 *) + TYPE_THEN `!y. (K y) ==> (?A B. (U A /\ U B /\ A x /\ B y /\ (A INTER B = {})))` SUBGOAL_TAC; + DISCH_ALL_TAC; + UND 1; + DISCH_THEN MATCH_MP_TAC; + CONJ_TAC; + UND 5; + EXPAND_TAC "C"; + REWRITE_TAC[DIFF;IN_ELIM_THM']; + REWRITE_TAC [IN]; + MESON_TAC[]; + CONJ_TAC; + UND 6; + UND 2; + REWRITE_TAC[SUBSET;IN]; + MESON_TAC[]; + PROOF_BY_CONTR_TAC; + REWR 1; + REWR 5; + UND 5; + UND 6; + EXPAND_TAC "C"; + REWRITE_TAC[DIFF;IN_ELIM_THM']; + MESON_TAC[IN]; + (* cc2 *) + DISCH_ALL_TAC; + USE 6 (CONV_RULE (quant_left_CONV "B")); + USE 6 (CONV_RULE (quant_left_CONV "B")); + USE 6 (CONV_RULE (quant_left_CONV "B")); + CHO 6; + TYPE_THEN `IMAGE B K` (USE 3 o SPEC); + TYPE_THEN `K SUBSET UNIONS (IMAGE B K) /\ IMAGE B K SUBSET U` SUBGOAL_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;UNIONS;IN_IMAGE;IN_ELIM_THM']; + X_GEN_TAC `y:A`; + REWRITE_TAC[IN]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;IN_IMAGE]; + NAME_CONFLICT_TAC; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + ASM_MESON_TAC[IN]; + DISCH_TAC; + REWR 3; + CHO 3; + (* cc3 *) + AND 3; + AND 3; + JOIN 8 9; + USE 8 (MATCH_MP finite_subset); + X_CHO 8 `kc:A->bool`; + USE 6 (CONV_RULE (quant_left_CONV "A")); + USE 6 (CONV_RULE (quant_left_CONV "A")); + CHO 6; + (* cc4 *) + TYPE_THEN `K = EMPTY` ASM_CASES_TAC; + REWR 4; + USE 4 (REWRITE_RULE[DIFF_EMPTY]); + EXISTS_TAC `C:A->bool`; + ASM_REWRITE_TAC[SUBSET_REFL]; + EXPAND_TAC "C"; + USE 0 (REWRITE_RULE[topology]); + UND 0; + MESON_TAC[topology;IN;SUBSET_REFL]; + TYPE_THEN `~(kc = EMPTY)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 10 (REWRITE_RULE[]); + REWR 8; + USE 8 (REWRITE_RULE[IMAGE_CLAUSES]); + REWR 3; + USE 3 (REWRITE_RULE[UNIONS_0;SUBSET_EMPTY]); + ASM_MESON_TAC[ ]; + REWRITE_TAC[EMPTY_EXISTS]; + DISCH_THEN CHOOSE_TAC; + ALL_TAC; (* cc5 *) + TYPE_THEN `INTERS (IMAGE A kc)` EXISTS_TAC; + TYPE_THEN `INTERS (IMAGE A kc) INTER (UNIONS (IMAGE B kc)) = EMPTY` SUBGOAL_TAC; + REWRITE_TAC[INTER;UNIONS]; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM';EMPTY]; + MATCH_MP_TAC (TAUT `(a ==> ~b )==> ~(a /\ b)`); + REWRITE_TAC[IN_INTERS;IN_IMAGE]; + DISCH_ALL_TAC; + CHO 11; + AND 11; + CHO 13; + IN_ELIM 13; + REWR 11; + USE 12 (CONV_RULE (quant_left_CONV "x")); + USE 12 (CONV_RULE (quant_left_CONV "x")); + TYPE_THEN `x''` (USE 12 o SPEC); + TYPE_THEN `A x''` (USE 12 o SPEC); + IN_ELIM 12; + REWR 12; + TYPE_THEN `x''` (USE 6 o SPEC); + TYPE_THEN `K x''` SUBGOAL_TAC; + UND 13; + AND 8; + UND 13; + MESON_TAC[SUBSET;IN]; + DISCH_TAC; + REWR 6; + USE 6 (REWRITE_RULE [INTER]); + (AND 6); + (AND 6); + (AND 6); + (AND 6); + USE 6 (fun t-> AP_THM t `x':A`); + USE 6 (REWRITE_RULE[IN_ELIM_THM';EMPTY]); + ASM_MESON_TAC[IN]; + DISCH_TAC; + ALL_TAC; (* cc6 *) + SUBCONJ_TAC; + EXPAND_TAC "C"; + REWRITE_TAC[DIFF_SUBSET]; + CONJ_TAC; + MATCH_MP_TAC INTERS_SUBSET2; + TYPE_THEN `A u` EXISTS_TAC ; + REWRITE_TAC[IMAGE;IN_ELIM_THM']; + CONJ_TAC; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC sub_union; + TYPE_THEN `u` (USE 6 o SPEC); + AND 8; + USE 12 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[IN]; + UND 3; + ASM_REWRITE_TAC[]; + UND 11; + TYPE_THEN `a' = INTERS (IMAGE A kc)` ABBREV_TAC; + TYPE_THEN `b' = UNIONS (IMAGE B kc)` ABBREV_TAC; + SET_TAC[INTER;SUBSET;EMPTY]; + DISCH_TAC; + ALL_TAC; (* cc7 *) + CONJ_TAC; + REWRITE_TAC[INTERS;IN_IMAGE;IN_ELIM_THM']; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + TYPE_THEN `x'` (USE 6 o SPEC); + ASM_REWRITE_TAC[]; + USE 8 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[IN]; + MATCH_MP_TAC open_inters; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE;]; + NAME_CONFLICT_TAC; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + USE 6 (SPEC `x':A`); + USE 8 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[IN]; + CONJ_TAC; + ASM_MESON_TAC[FINITE_IMAGE]; + REWRITE_TAC[EMPTY_EXISTS]; + TYPE_THEN `A u` EXISTS_TAC; + REWRITE_TAC[IN_IMAGE]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let compact_totally_bounded = prove_by_refinement( + `!(X:A->bool) d.( metric_space(X,d)) /\ (compact (top_of_metric(X,d)) X) + ==> (totally_bounded (X,d))`, + (* {{{ proof *) + [ + REWRITE_TAC[totally_bounded;compact]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CONV_TAC (quant_right_CONV "B"); + DISCH_TAC; + TYPE_THEN `IMAGE (\x. open_ball(X,d) x eps) X` (USE 2 o SPEC); + TYPE_THEN `X SUBSET UNIONS (IMAGE (\x. open_ball (X,d) x eps) X)` SUBGOAL_TAC; + (REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]); + GEN_TAC; + NAME_CONFLICT_TAC; + REWRITE_TAC[IN]; + DISCH_TAC; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `open_ball (X,d) x eps` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[open_ball_nonempty;IN]; + DISCH_TAC; + REWR 2; + ALL_TAC; (* ctb1 *) + TYPE_THEN `IMAGE (\x. open_ball (X,d) x eps) X SUBSET top_of_metric (X,d)` SUBGOAL_TAC; + TYPE_THEN `IMAGE (\x. open_ball (X,d) x eps) X SUBSET open_balls(X,d)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE;open_balls;IN_ELIM_THM']; + MESON_TAC[IN]; + MESON_TAC[SUBSET_TRANS;top_of_metric_open_balls]; + DISCH_TAC; + REWR 2; + CHO 2; + TYPE_THEN `W` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + DISCH_ALL_TAC; + AND 2; + USE 7 (REWRITE_RULE [SUBSET;IN_IMAGE]); + ASM_MESON_TAC[IN]; + MATCH_MP_TAC SUBSET_ANTISYM; + ASM_REWRITE_TAC[]; + TYPE_THEN `W SUBSET top_of_metric (X,d)` SUBGOAL_TAC; + ASM_MESON_TAC[SUBSET_TRANS]; + DISCH_ALL_TAC; + USE 6 (MATCH_MP UNIONS_UNIONS); + ASM_MESON_TAC[top_of_metric_unions]; + ]);; + (* }}} *) + +(* + If W is empty then INTERS W = UNIV, rather than EMPTY. + Thus, extra arguments must be provided for this case. *) + +let finite_inters = prove_by_refinement( + `!U V . (topology_ U) /\ (compact U (UNIONS U)) /\ (INTERS V = EMPTY) /\ + (!(u:A->bool). (V u) ==> (closed_ U u)) + ==> (?W. (W SUBSET V) /\ (FINITE W) /\ (INTERS W = EMPTY))`, + (* {{{ proof *) + + [ + REWRITE_TAC[compact;SUBSET_REFL]; + DISCH_ALL_TAC; + (* {{{ proof *) + + TYPE_THEN `IMAGE (\r. ((UNIONS U) DIFF r)) V` (USE 1 o SPEC); + TYPE_THEN `IMAGE (\r. UNIONS U DIFF r) V SUBSET U` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM']; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[top_univ;IN;SUBSET_DIFF]; + IN_ELIM 4; + TYPE_THEN `x'` (USE 3 o SPEC); + REWR 3; + USE 3 (REWRITE_RULE[closed;open_DEF]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + REWR 1; + ALL_TAC; (* fi1 *) + TYPE_THEN `UNIONS U SUBSET UNIONS (IMAGE (\r. UNIONS U DIFF r) V)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]; + GEN_TAC; + DISCH_THEN CHOOSE_TAC; + NAME_CONFLICT_TAC; + USE 2 (REWRITE_RULE[INTERS_EQ_EMPTY]); + TYPE_THEN `x` (USE 2 o SPEC); + CHO 2; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `UNIONS U DIFF a` EXISTS_TAC ; + ASM_REWRITE_TAC[IN]; + REWRITE_TAC[DIFF;IN_ELIM_THM';IN_UNIONS]; + ASM_MESON_TAC[IN]; + DISCH_TAC; + REWR 1; + CHO 1; + AND 1; + AND 1; + JOIN 7 6; +(*** Modified by JRH for changed theorem name + USE 6 (MATCH_MP FINITE_SUBSET_IMAGE); + ****) + USE 6 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); + CHO 6; + ALL_TAC; (* fi2*) + TYPE_THEN `s'={}` ASM_CASES_TAC ; + REWR 6; + USE 6 (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]); + REWR 1; + USE 1 (REWRITE_RULE[UNIONS_0;SUBSET_EMPTY]); + USE 1 (REWRITE_RULE [UNIONS_EQ_EMPTY]); + UND 1; + DISCH_THEN DISJ_CASES_TAC; + REWR 4; + USE 4 (REWRITE_RULE[SUBSET_EMPTY;IMAGE;EQ_EMPTY;IN_ELIM_THM']); + TYPE_THEN `V = {}` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 8 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 8; + USE 4 (CONV_RULE (quant_left_CONV "x'")); + USE 4 (CONV_RULE (quant_left_CONV "x'")); + TYPE_THEN `u` (USE 4 o SPEC); + TYPE_THEN `UNIONS {} DIFF u` (USE 4 o SPEC); + ASM_MESON_TAC[]; + USE 2 (REWRITE_RULE[INTERS_EQ_EMPTY]); + REWRITE_TAC[EQ_EMPTY]; + ASM_MESON_TAC[]; + ALL_TAC; (* fi3*) + TYPE_THEN `V` EXISTS_TAC; + ASM_REWRITE_TAC[SUBSET_REFL]; + USE 3 (REWRITE_RULE[closed;open_DEF]); + REWR 3; + USE 3 (REWRITE_RULE[REWRITE_RULE[IN] IN_SING]); + TYPE_THEN `!u. V u ==> (u = EMPTY)` SUBGOAL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `u` (USE 3 o SPEC); + REWR 3; + AND 3; + ASM_MESON_TAC[ SUBSET_EMPTY;UNIONS_EQ_EMPTY]; + DISCH_TAC; + TYPE_THEN `V SUBSET {EMPTY}` SUBGOAL_TAC; + REWRITE_TAC[INSERT_DEF]; + REWRITE_TAC[IN_ELIM_THM']; + REWRITE_TAC[IN;EMPTY;SUBSET]; + ASM_MESON_TAC[IN;EMPTY]; + + (* }}} *) + MESON_TAC[FINITE_SING;FINITE_SUBSET]; + ALL_TAC; (* fi4*) + TYPE_THEN `s'` EXISTS_TAC; + ASM_REWRITE_TAC[INTERS_EQ_EMPTY]; + GEN_TAC; + USE 7 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 7; + TYPE_THEN `UNIONS U x` ASM_CASES_TAC ; + TYPE_THEN `UNIONS W x` SUBGOAL_TAC; + USE 1 (REWRITE_RULE[SUBSET;IN]); + UND 8; + UND 1; + MESON_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `UNIONS (IMAGE (\r. UNIONS U DIFF r) s') x` SUBGOAL_TAC; + AND 6; + AND 6; + USE 6 (MATCH_MP UNIONS_UNIONS); + USE 6 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[]; + REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + LEFT 10 "x"; + LEFT 10 "x"; + TYPE_THEN `S:A->bool` (X_CHO 10) ; + CHO 10; + AND 10; + REWR 10; + TYPE_THEN `S` EXISTS_TAC; + ASM_REWRITE_TAC[]; + USE 10(REWRITE_RULE[REWRITE_RULE[IN] IN_DIFF]); + ASM_REWRITE_TAC[]; + TYPE_THEN `u` EXISTS_TAC; + IN_ELIM 7; + ASM_REWRITE_TAC[]; + PROOF_BY_CONTR_TAC; + USE 9 (REWRITE_RULE[]); + TYPE_THEN `V u` SUBGOAL_TAC; + AND 6; + AND 6; + USE 11 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[]; + DISCH_TAC; + H_MATCH_MP (HYP "3") (HYP "10"); + USE 11(REWRITE_RULE[closed;open_DEF]); + USE 11 (REWRITE_RULE [SUBSET;IN]); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + + +(* first part of the proof of cauchy_subseq *) +let cauchy_subseq_sublemma = prove_by_refinement( + `!(X:A->bool) d f. ((metric_space(X,d))/\(totally_bounded(X,d)) /\ + (sequence X f)) ==> + (?R Cn sn cond. + (&0 < R) /\ + (!x y. X x /\ X y ==> d x y < R) /\ + (cond (X,0) 0) /\ + (sn 0 = 0) /\ (Cn 0 = X) /\ + (!n. Cn n SUBSET X /\ cond (Cn n,sn n) n) /\ + (!n. Cn (SUC n) SUBSET Cn n /\ sn n <| sn (SUC n)) /\ + (((\ (C,s). \n. + (~FINITE {j | C (f j)}) /\ + (C (f s)) /\ + (!x y. (C x /\ C y) ==> d x y < R * (twopow (--: (&:n))))) = + cond) + ))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + COPY 0 THEN COPY 1; + JOIN 4 3; + USE 3 (MATCH_MP totally_bounded_bounded); + CHO 3; + CHO 3; + ALL_TAC; (* {{{ xxx *) + ALL_TAC; (* make r pos *) + ASSUME_TAC (REAL_ARITH `r <. (&.1 + abs(r))`); + ASSUME_TAC (REAL_ARITH `&.0 <. (&.1 + abs(r))`); + ABBREV_TAC (`r' = &.1 +. abs(r)`); + SUBGOAL_TAC `open_ball(X,d) a r SUBSET open_ball(X,d) (a:A) r'`; + ASM_SIMP_TAC[open_ball_nest]; + DISCH_TAC; + JOIN 3 7; + USE 3 (MATCH_MP SUBSET_TRANS); + KILL 6; + KILL 4; + ALL_TAC; (* "cs1" *) + SUBGOAL_TAC `( !(x:A) y. (X x) /\ (X y) ==> (d x y <. &.2 *. r'))`; + DISCH_ALL_TAC; + USE 3 (REWRITE_RULE[SUBSET;IN]); + COPY 3; + USE 7 (SPEC `x:A`); + USE 3 (SPEC `y:A`); + H_MATCH_MP (HYP "3") (HYP "6"); + H_MATCH_MP (HYP "7") (HYP "4"); + JOIN 9 8; + JOIN 0 8; + USE 0 (MATCH_MP BALL_DIST); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ABBREV_TAC `cond = (\ ((C:A->bool),(s:num)) n. ~FINITE{j| C (f j)} /\ (C(f s)) /\ (!x y. (C x /\ C y) ==> d x y <. (&.2*.r')*. twopow(--: (&:n))))`; + ABBREV_TAC `R = (&.2)*r'`; + ALL_TAC ; (* 0 case of recursio *) + ALL_TAC; (* cs2 *) + SUBGOAL_TAC ` (X SUBSET X) /\ (cond ((X:A->bool),0) 0)`; + REWRITE_TAC[SUBSET_REFL]; + EXPAND_TAC "cond"; + CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV); + USE 2 (REWRITE_RULE[sequence;SUBSET;IN_IMAGE;IN_UNIV]); + USE 2 (REWRITE_RULE[IN]); + USE 2 (CONV_RULE (NAME_CONFLICT_CONV)); + SUBGOAL_TAC `!x. X((f:num->A) x)`; + ASM_MESON_TAC[]; + REDUCE_TAC; + REWRITE_TAC[TWOPOW_0] THEN REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC; + SUBGOAL_TAC `{ j | (X:A->bool) (f j) } = (UNIV:num->bool)`; + MATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM;UNIV]; + ASM_REWRITE_TAC[]; + DISCH_THEN REWRT_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[num_infinite]; + ALL_TAC; (* #save_goal "cs3" *) + SUBGOAL_TAC `&.0 <. R`; + EXPAND_TAC "R"; + UND 5; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC `!cs n. ?cs' . (FST cs SUBSET X) /\ (cond cs n)==>( (FST cs' SUBSET (FST cs)) /\(SND cs <| ((SND:((A->bool)#num)->num) cs') /\ (cond cs' (SUC n))) )`; + DISCH_ALL_TAC; + CONV_TAC (quant_right_CONV "cs'"); + DISCH_TAC; + AND 11; + H_REWRITE_RULE[GSYM o (HYP "6")] (HYP "11"); + USE 13 (CONV_RULE (SUBS_CONV[GSYM(ISPEC `cs:(A->bool)#num` PAIR)])); + USE 13 (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV)); + JOIN 10 13; + JOIN 12 10; + JOIN 2 10; + JOIN 1 2; + JOIN 0 1; + USE 0 (MATCH_MP subsequence_rec); + CHO 0; + CHO 0; + EXISTS_TAC `(C':A->bool,s':num)`; + ASM_REWRITE_TAC[FST;SND]; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ALL_TAC; (* "cs4" *) + USE 11 (REWRITE_RULE[SKOLEM_THM]); + CHO 11; + ASSUME_TAC (ISPECL[`((X:A->bool),0)`;`cs':(((A->bool)#num)->(num->(A->bool)#num))`] num_RECURSION); + CHO 12; + ALL_TAC;(* EXISTS_TAC `\i. (SND ((fn : num->(A->bool)#num) i))`; *) + USE 11 (CONV_RULE (quant_left_CONV "n")); + USE 11 (SPEC `n:num`); + USE 11 (SPEC `(fn:num->(A->bool)#num) n`); + AND 12; + H_REWRITE_RULE[GSYM o (HYP "12")] (HYP "11"); + USE 14 (GEN_ALL); + ABBREV_TAC `sn = (\i. SND ((fn:num->(A->bool)#num) i))`; + ABBREV_TAC `Cn = (\i. FST ((fn:num->(A->bool)#num) i))`; + SUBGOAL_TAC `((sn:num->num) 0 = 0) /\ (Cn 0 = (X:A->bool))`; + EXPAND_TAC "sn"; + EXPAND_TAC "Cn"; + UND 13; + MESON_TAC[FST;SND]; + DISCH_TAC; + KILL 13; + KILL 11; + SUBGOAL_TAC `!(n:num). ((fn n):(A->bool)#num) = (Cn n,sn n)`; + EXPAND_TAC "sn"; + EXPAND_TAC "Cn"; + REWRITE_TAC[PAIR]; + DISCH_TAC; + H_REWRITE_RULE[(HYP "11")] (HYP"14"); + KILL 12; + KILL 14; + KILL 11; + KILL 16; + KILL 15; + ALL_TAC; (* }}} *) + ALL_TAC; (* KILL 10; cs4m *) + KILL 8; + KILL 7; + KILL 3; + KILL 5; + ALL_TAC; (* cs5 *) + TYPE_THEN `!n. (Cn n SUBSET X) /\ (cond (Cn n,sn n) n)` SUBGOAL_TAC; + INDUCT_TAC; + ASM_REWRITE_TAC[]; + SET_TAC[SUBSET]; + USE 13 (SPEC `n:num`); + REWR 5; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[SUBSET_TRANS]; + DISCH_TAC; + REWR 13; + ALL_TAC; (* TO HERE EVERYTHING WORKS GENERALLY *) + TYPE_THEN `R` EXISTS_TAC; + TYPE_THEN `Cn` EXISTS_TAC; + TYPE_THEN `sn` EXISTS_TAC; + TYPE_THEN `cond` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* more on metric spaces and topology *) + +let subseq_cauchy = prove_by_refinement( + `!(X:A->bool) d f s. (metric_space(X,d)) /\ + (cauchy_seq (X,d) f) /\ (subseq s) /\ + (converge(X,d) (f o s)) ==> (converge(X,d) f)`, + (* {{{ proof *) + [ + REWRITE_TAC[cauchy_seq;converge;sequence_in]; + DISCH_ALL_TAC; + CHO 4; + TYPE_THEN `x` EXISTS_TAC ; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + AND 4; + TYPE_THEN `eps/(&.2)` (USE 2 o SPEC); + TYPE_THEN `eps/(&.2)` (USE 4 o SPEC); + CHO 4; + CHO 2; + CONV_TAC (quant_right_CONV "n"); + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[REAL_LT_HALF1]); + USE 4 (REWRITE_RULE[REAL_LT_HALF1]); + REWR 2; + REWR 4; + TYPE_THEN `n'` EXISTS_TAC ; + DISCH_ALL_TAC; + TYPE_THEN `n +| n'` (USE 4 o SPEC); + USE 4 (REWRITE_RULE[ARITH_RULE `n <=| n +| n'`]); + TYPE_THEN `s(n +| n')` (USE 2 o SPEC); + TYPE_THEN `i` (USE 2 o SPEC); + TYPE_THEN `n' <=| s (n +| n')` SUBGOAL_TAC; + USE 3 (MATCH_MP SEQ_SUBLE); + TYPE_THEN `n +| n'` (USE 3 o SPEC); + ASM_MESON_TAC[ LE_TRANS; ARITH_RULE `n' <=| n +| n'`]; + DISCH_TAC; + REWR 2; + USE 4 (REWRITE_RULE[o_DEF]); + (* save_goal"sc1"; *) + TYPEL_THEN [`X`;`d`;`x`;`f (s(n +| n'))`;`f i`] (fun t-> ASSUME_TAC (ISPECL t metric_space_triangle)); + USE 5 (REWRITE_RULE[IN]); + REWR 9; + USE 1 (MATCH_MP sequence_in); + REWR 9; + UND 9; + UND 4; + UND 2; + MP_TAC (SPEC `eps:real` REAL_HALF_DOUBLE); + TYPE_THEN `a = d (f (s (n +| n'))) (f i)` ABBREV_TAC ; + TYPE_THEN `b = d x (f (s (n +| n')))` ABBREV_TAC ; + TYPE_THEN `c = d x (f i)` ABBREV_TAC ; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let compact_complete = prove_by_refinement( + `!(X:A->bool) d. metric_space(X,d) /\ + (compact (top_of_metric(X,d)) X) ==> + (complete(X,d))`, + (* {{{ proof *) + + [ + REWRITE_TAC [complete]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + COPY 0; + COPY 1; + JOIN 3 4; + USE 3 (MATCH_MP compact_totally_bounded); + COPY 2; + USE 4 (REWRITE_RULE[cauchy_seq]); + AND 4; + COPY 0; + COPY 3; + COPY 5; + JOIN 7 8; + JOIN 6 7; + USE 6 (MATCH_MP cauchy_subseq_sublemma); + CHO 6; + CHO 6; + CHO 6; + CHO 6; + (AND 6); + (AND 6); + (AND 6); + (AND 6); + (AND 6); + (AND 6); + (AND 6); + ALL_TAC ; (* cc1 *) + MATCH_MP_TAC subseq_cauchy; + TYPE_THEN `sn` EXISTS_TAC; + ASM_REWRITE_TAC [converge]; + SUBCONJ_TAC; + REWRITE_TAC[SUBSEQ_SUC]; + ASM_MESON_TAC[ ]; + DISCH_ALL_TAC; + TYPE_THEN `~(INTERS {z | ?n. z = closed_ball(X,d) (f (sn n)) (R* twopow(--: (&:n)))} =EMPTY)` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC ; + REWR 15; + TYPEL_THEN [`top_of_metric(X,d)`;`{z | ?n. z = closed_ball (X,d) (f(sn n)) (R * twopow (--: (&:n)))}`] (fun t-> ASSUME_TAC (ISPECL t finite_inters)); + REWR 16; + TYPE_THEN `topology_ (top_of_metric (X,d)) /\ compact (top_of_metric (X,d)) (UNIONS (top_of_metric (X,d))) /\ (!u. {z | ?n. z = closed_ball (X,d) (f(sn n)) (R * twopow (--: (&:n)))} u ==> closed_ (top_of_metric (X,d)) u)` SUBGOAL_TAC ; + ASM_SIMP_TAC[GSYM top_of_metric_unions;]; + ASM_SIMP_TAC[top_of_metric_top]; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[closed_ball_closed]; + DISCH_TAC; + REWR 16; + CHO 16; + ALL_TAC ; (* cc2 *) + TYPE_THEN `{z | ?n. z = closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))} = IMAGE (\n. closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))) (UNIV)` SUBGOAL_TAC ; + MATCH_MP_TAC EQ_EXT; + GEN_TAC ; + REWRITE_TAC[IN_ELIM_THM';INR IN_IMAGE;UNIV]; + DISCH_TAC; + REWR 16; + AND 16; + AND 16; + JOIN 20 19; +(*** Modified by JRH for new theorem name + USE 19 (MATCH_MP FINITE_SUBSET_IMAGE); + ***) + USE 19 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); + CHO 19; + AND 19; + AND 19; +(*** JRH --- originally for implicational num_FINITE: + USE 20 (MATCH_MP num_FINITE); + ***) + USE 20 (CONV_RULE (REWR_CONV num_FINITE)); + CHO 20; + TYPE_THEN `f (sn a) IN (INTERS W)` SUBGOAL_TAC ; + REWRITE_TAC[IN_INTERS]; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + USE 19 (REWRITE_RULE [SUBSET;IN_IMAGE]); + TYPE_THEN `t` (USE 19 o SPEC); + USE 19 (REWRITE_RULE [IN]); + REWR 19; + X_CHO 19 `m:num`; + USE 20 (SPEC `m:num`); + USE 20 (REWRITE_RULE[IN]); + REWR 20; + TYPE_THEN `Cn m SUBSET closed_ball (X,d) (f (sn m)) (R * twopow (--: (&:m)))` SUBGOAL_TAC ; + REWRITE_TAC[SUBSET;closed_ball;IN_ELIM_THM']; + USE 12 (SPEC `m:num`); + UND 12; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + REWRITE_TAC[SUBSET]; + MESON_TAC[IN;REAL_ARITH `x <. y ==> x <=. y`]; + REWRITE_TAC[SUBSET;IN]; + DISCH_THEN (MATCH_MP_TAC ); + ALL_TAC ; (* cc3 *) + TYPE_THEN `Cn a SUBSET Cn m` SUBGOAL_TAC ; + UND 13; + UND 20; + MESON_TAC [SUBSET_SUC2]; + REWRITE_TAC[SUBSET;IN]; + DISCH_THEN (MATCH_MP_TAC ); + USE 12 (SPEC `a:num`); + AND 12; + UND 12; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + MESON_TAC[]; + ASM_REWRITE_TAC [NOT_IN_EMPTY]; + DISCH_TAC; + ALL_TAC ; (* cc4 *) + USE 15 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 15; + TYPE_THEN `u` EXISTS_TAC ; + REWRITE_TAC[IN]; + SUBCONJ_TAC; + USE 15 (REWRITE_RULE [IN_INTERS]); + TYPE_THEN `closed_ball (X,d) (f (sn 0)) (R * twopow (--: (&:0)))` (USE 15 o SPEC); + USE 15 (REWRITE_RULE[IN_ELIM_THM']); + LEFT 15 "n"; + TYPE_THEN `0` (USE 15 o SPEC); + USE 15 (REWRITE_RULE[IN;closed_ball]); + USE 15 (REWRITE_RULE [IN_ELIM_THM']); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CONV_TAC (quant_right_CONV "n"); + DISCH_ALL_TAC; + TYPEL_THEN [`(&.2)*R`;`eps`] (fun t-> ASSUME_TAC (ISPECL t twopow_eps)); + CHO 18; + REWR 18; + TYPE_THEN `n` EXISTS_TAC; + DISCH_ALL_TAC; + TYPE_THEN `&0 < &2 * R ` SUBGOAL_TAC; + MATCH_MP_TAC REAL_PROP_POS_MUL2; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + DISCH_ALL_TAC; + REWR 18; + UND 18; + MATCH_MP_TAC (REAL_ARITH `x <= a ==> ((a < b) ==> (x < b))`); + USE 15 (REWRITE_RULE[IN_INTERS]); + TYPE_THEN `closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` (USE 15 o SPEC); + USE 15 (REWRITE_RULE[IN_ELIM_THM']); + LEFT 15 "n'"; + USE 15 (SPEC `n:num`); + REWR 15; + TYPE_THEN `Cn n SUBSET closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` SUBGOAL_TAC ; + REWRITE_TAC[SUBSET;closed_ball;IN_ELIM_THM']; + USE 12 (SPEC `n:num`); + UND 12; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + REWRITE_TAC[SUBSET]; + MESON_TAC[IN;REAL_ARITH `x <. y ==> x <=. y`]; + DISCH_TAC; + TYPE_THEN `Cn i SUBSET Cn n` SUBGOAL_TAC ; + UND 13; + UND 19; + MESON_TAC [SUBSET_SUC2]; + ALL_TAC ; (* REWRITE_TAC[SUBSET;IN];*) + DISCH_ALL_TAC; + USE 12 (SPEC `i:num`); + AND 12; + UND 12; + EXPAND_TAC "cond"; + (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV)); + DISCH_ALL_TAC; + TYPE_THEN `((f o sn) i) IN closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` SUBGOAL_TAC; + KILL 1; + KILL 0; + KILL 2; + KILL 3; + KILL 5; + KILL 4; + JOIN 21 18; + USE 0 (MATCH_MP SUBSET_TRANS); + ALL_TAC; (* "CC5"; *) + ASM_MESON_TAC[IN;o_DEF;SUBSET]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + UND 15; + TYPE_THEN `r = R * twopow (--: (&:n))` ABBREV_TAC; + UND 0; + REWRITE_TAC[IN]; + MESON_TAC[BALL_DIST_CLOSED]; + ]);; + + (* }}} *) + +let countable_cover = prove_by_refinement( + `!(X:A->bool) d U. (metric_space(X,d)) /\ (totally_bounded(X,d)) /\ + (X SUBSET (UNIONS U)) /\ (U SUBSET (top_of_metric(X,d))) ==> + (?V. (V SUBSET U) /\ (X SUBSET (UNIONS V)) /\ (COUNTABLE V))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + TYPE_THEN `(?Z. COUNTABLE Z /\ dense (top_of_metric (X,d)) Z)` SUBGOAL_TAC; + ASM_MESON_TAC[countable_dense]; + DISCH_ALL_TAC; + CHO 4; + TYPE_THEN `S = {(z,n) | ?A. (Z z) /\ (open_ball(X,d) z (twopow(--: (&:n))) SUBSET A) /\ U A}` ABBREV_TAC ; + TYPE_THEN `COUNTABLE S` SUBGOAL_TAC; + IMATCH_MP_TAC (INST_TYPE [`:A#num`,`:A`] COUNTABLE_IMAGE); + TYPE_THEN `{(z,(n:num)) | (Z z) /\ (UNIV n)}` EXISTS_TAC ; + CONJ_TAC ; + IMATCH_MP_TAC countable_prod; + ASM_REWRITE_TAC [NUM_COUNTABLE]; + TYPE_THEN `I:(A#num) -> (A#num)` EXISTS_TAC; + REWRITE_TAC[IMAGE_I;UNIV;SUBSET]; + IN_OUT_TAC; + EXPAND_TAC "S"; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + ASM_MESON_TAC[GSPEC]; + DISCH_TAC; + TYPE_THEN `!z n. (S (z,n) ==> ?A. Z z /\ open_ball (X,d) z (twopow (--: (&:n))) SUBSET A /\ U A)` SUBGOAL_TAC; + EXPAND_TAC "S"; + REWRITE_TAC[IN_ELIM_THM']; + DISCH_ALL_TAC; + CHO 7; + CHO 7; + AND 7; + CHO 8; + TYPE_THEN `A` EXISTS_TAC; + ASM_MESON_TAC[PAIR_EQ]; + DISCH_TAC ; + LEFT 7 "A"; + LEFT 7 "A"; + LEFT 7 "A"; + CHO 7; + ALL_TAC ; (* "cc1"; *) + TYPE_THEN `IMAGE (\ (z,n). A z n) S` EXISTS_TAC; + SUBCONJ_TAC ; + REWRITE_TAC[SUBSET;IN_IMAGE]; + NAME_CONFLICT_TAC; + TYPE_THEN `Azn:A->bool` X_GEN_TAC; + DISCH_THEN (X_CHOOSE_TAC `zn:A#num`); + USE 8 (SUBS [(ISPEC `zn:A#num` (GSYM PAIR))]); + USE 8 (GBETA_RULE); + TYPE_THEN `z = FST zn` ABBREV_TAC ; + TYPE_THEN `n = SND zn` ABBREV_TAC ; + IN_OUT_TAC; + ASM_MESON_TAC[]; + DISCH_TAC; + CONJ_TAC ; + REWRITE_TAC[SUBSET]; + USE 2 (REWRITE_RULE[SUBSET;IN_UNIONS]); + IN_OUT_TAC; + DISCH_ALL_TAC; + TYPE_THEN `x` ( USE 6 o SPEC); + REWR 6; + CHO 6; + TYPE_THEN `top_of_metric (X,d) t` SUBGOAL_TAC; + AND 6; + UND 10; + UND 5; + REWRITE_TAC[SUBSET;IN]; + MESON_TAC[]; + ASM_SIMP_TAC[top_of_metric_nbd]; + DISCH_ALL_TAC; + TYPE_THEN `x` (USE 11 o SPEC); + IN_OUT_TAC; + REWR 0; + CHO 0; + AND 0; + ASSUME_TAC (SPECL[`&.1`;`r:real`] twopow_eps); + CHO 13; + USE 13 (CONV_RULE REDUCE_CONV); + REWR 13; + TYPEL_THEN [`X`;`d`;`x`] (fun t-> USE 13 (MATCH_MP (SPECL t open_ball_nest))); + JOIN 13 0; + USE 0 (MATCH_MP SUBSET_TRANS); + ASSUME_TAC (SPEC `(--: (&:n))` twopow_pos); + WITH 3 (MATCH_MP top_of_metric_top); + AND 7; + COPY 7; + COPY 14; + JOIN 14 7; + USE 7 (MATCH_MP dense_subset); + UND 16; + ASM_SIMP_TAC [dense_open]; + DISCH_TAC ; + TYPE_THEN `(open_ball(X,d) x (twopow (--: (&:(n+1)))))` (USE 14 o SPEC); + ALL_TAC ; (* "cc2"; *) + TYPE_THEN `open_ball (X,d) x (twopow (--: (&:(n +| 1)))) x` SUBGOAL_TAC; + IMATCH_MP_TAC open_ball_nonempty; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `?z. (Z z) /\ (open_ball(X,d) x (twopow (--: (&:(n+1)))) z)` SUBGOAL_TAC; + UND 14; + REWRITE_TAC[open_DEF]; + ASM_SIMP_TAC[open_ball_open]; + UND 16; + TYPE_THEN `B = open_ball (X,d) x (twopow (--: (&:(n +| 1))))` ABBREV_TAC ; + REWRITE_TAC[INTER;IN]; + POP_ASSUM_LIST (fun t->ALL_TAC); + REWRITE_TAC[EMPTY_NOT_EXISTS]; + REWRITE_TAC[IN_ELIM_THM']; + MESON_TAC[]; + DISCH_TAC; + CHO 18; + AND 18; + WITH 3 (MATCH_MP top_of_metric_unions); + USE 20 (SYM); + REWR 7; + TYPE_THEN `X z` SUBGOAL_TAC; + UND 7; + UND 19; + MESON_TAC[SUBSET;IN]; + DISCH_TAC; + TYPE_THEN `open_ball (X,d) z (twopow (--: (&:(n +| 1)))) x` SUBGOAL_TAC; + ASM_MESON_TAC[ball_symm]; + DISCH_TAC; + ALL_TAC ; (* "cc3"; *) + REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM']; + REWRITE_TAC[IN]; + LEFT_TAC "x"; + LEFT_TAC "x"; + TYPE_THEN `(z,n+1)` EXISTS_TAC; + TYPE_THEN `A z (n+1)` EXISTS_TAC; + GBETA_TAC; + EXPAND_TAC "S"; + REWRITE_TAC[IN_ELIM_THM']; + LEFT_TAC "z'"; + TYPE_THEN `z` EXISTS_TAC; + LEFT_TAC "n'"; + TYPE_THEN `n + 1` EXISTS_TAC; + REWRITE_TAC[]; + LEFT_TAC "A"; + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ALL_TAC ; (* "cc4"; *) + SUBCONJ_TAC ; + TYPE_THEN `open_ball (X,d) z (twopow (--: (&:(n +| 1)))) SUBSET (open_ball (X,d) x (twopow (--: (&:n))))` SUBGOAL_TAC ; + CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [(GSYM twopow_double)])); + IMATCH_MP_TAC ball_subset_ball; + ASM_REWRITE_TAC[]; + UND 0; + MESON_TAC[SUBSET_TRANS]; + DISCH_TAC ; + TYPEL_THEN [`z`;`n+1`] (fun t -> USE 10 (SPECL t)); + USE 10 (REWRITE_RULE [SUBSET ]); + IN_OUT_TAC ; + ALL_TAC ; (* "cc5" *) + TYPE_THEN `S (z,n +| 1)` SUBGOAL_TAC ; + EXPAND_TAC "S"; + REWRITE_TAC[IN_ELIM_THM' ]; + TYPE_THEN `z` EXISTS_TAC ; + TYPE_THEN `n + 1` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `t` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC ; + REWR 13; + AND 13; + TYPE_THEN `x` (USE 25 o SPEC ); + UND 25; + ASM_REWRITE_TAC[]; + TYPE_THEN `S` ( fun t-> IMATCH_MP_TAC ( ISPEC t COUNTABLE_IMAGE)) ; + ASM_REWRITE_TAC[]; + TYPE_THEN `\ (z,n). A z n` EXISTS_TAC; + REWRITE_TAC[SUBSET_REFL ]; + ]);; + + (* }}} *) + +let complete_compact = prove_by_refinement( + `!(X:A->bool) d . (metric_space(X,d)) /\ (totally_bounded(X,d)) /\ + (complete (X,d)) ==> (compact (top_of_metric(X,d)) X)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[compact]; + CONJ_TAC ; + UND 0; + SIMP_TAC[GSYM top_of_metric_unions ]; + REWRITE_TAC[SUBSET_REFL]; + GEN_TAC; + DISCH_ALL_TAC; + TYPE_THEN `(?V'. (V' SUBSET V) /\ (X SUBSET (UNIONS V')) /\ (COUNTABLE V'))` SUBGOAL_TAC ; + IMATCH_MP_TAC countable_cover; + TYPE_THEN `d` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + ALL_TAC; (* ASM_MESON_TAC[]; *) + ALL_TAC; (* DISCH_THEN (CHOOSE_THEN MP_TAC); *) + ALL_TAC; (* DISCH_ALL_TAC; *) + USE 7 (REWRITE_RULE[COUNTABLE;GE_C;UNIV]); + IN_OUT_TAC; + CHO 0; + TYPE_THEN `B = \i. (IMAGE f { u | (u <=| i ) /\ V' (f u)}) ` ABBREV_TAC ; + TYPE_THEN `?i . UNIONS (B i ) = X ` ASM_CASES_TAC; + CHO 9; + TYPE_THEN `B i ` EXISTS_TAC; + EXPAND_TAC "B"; + CONJ_TAC; + REWRITE_TAC[IMAGE;SUBSET ;IN ]; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC; + UND 2; + REWRITE_TAC[SUBSET;IN ]; + MESON_TAC[]; + CONJ_TAC ; + IMATCH_MP_TAC FINITE_IMAGE; + IMATCH_MP_TAC FINITE_SUBSET; + TYPE_THEN `{u | u <=| i }` EXISTS_TAC; + REWRITE_TAC[FINITE_NUMSEG_LE;SUBSET;IN ;IN_ELIM_THM' ]; + MESON_TAC[]; + UND 9; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + EXPAND_TAC "B"; + REWRITE_TAC[SUBSET_REFL ]; + ALL_TAC ; (* "sv1" *) + LEFT 9 "i"; + TYPE_THEN `UNIONS V' SUBSET X` SUBGOAL_TAC; + JOIN 2 3; + USE 2 (MATCH_MP SUBSET_TRANS ); + USE 2 (MATCH_MP UNIONS_UNIONS ); + UND 2; + ASM_MESON_TAC[top_of_metric_unions ]; + DISCH_TAC ; + TYPE_THEN `!i. UNIONS (B i) SUBSET X` SUBGOAL_TAC; + GEN_TAC; + UND 10; + EXPAND_TAC "B"; + REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE ]; + REWRITE_TAC[IN;IN_ELIM_THM' ]; + MESON_TAC[]; + DISCH_TAC ; + COPY 11; + COPY 9; + JOIN 12 13; + LEFT 12 "i"; + USE 12 (REWRITE_RULE [GSYM PSUBSET ;PSUBSET_MEMBER;IN ]); + LEFT 12 "y"; + LEFT 12 "y"; + CHO 12; + ALL_TAC ; (* "sv2" *) + TYPE_THEN `(?ss. subseq ss /\ converge (X,d) (y o ss))` SUBGOAL_TAC; + IMATCH_MP_TAC convergent_subseq ; + ASM_REWRITE_TAC[sequence]; + REWRITE_TAC[SUBSET;UNIV;IN_IMAGE ]; + REWRITE_TAC[IN]; + ASM_MESON_TAC[]; + DISCH_TAC; + CHO 13; + AND 13; + COPY 13; + USE 13 (REWRITE_RULE[converge;IN ]); + CHO 13; + AND 13; + USE 1 (REWRITE_RULE[SUBSET;UNIONS;IN;IN_ELIM_THM' ]); + TYPE_THEN `x` (USE 1 o SPEC); + REWR 1; + CHO 1; + TYPE_THEN `u` (USE 0 o SPEC); + REWR 0; + X_CHO 0 `j:num`; + TYPE_THEN `(UNIONS (B j)) x` SUBGOAL_TAC; + EXPAND_TAC "B"; + REWRITE_TAC[UNIONS;IN_IMAGE ]; + REWRITE_TAC[IN;IN_ELIM_THM' ]; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j` EXISTS_TAC; + ASM_MESON_TAC[ARITH_RULE `j <=| j`]; + DISCH_TAC; + TYPE_THEN `u SUBSET (UNIONS (B j))` SUBGOAL_TAC; + IMATCH_MP_TAC sub_union; + EXPAND_TAC "B"; + REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; + TYPE_THEN `j` EXISTS_TAC; + ASM_MESON_TAC[ARITH_RULE `j <=| j`]; + DISCH_TAC; + JOIN 2 3; + USE 2 (MATCH_MP SUBSET_TRANS); + ALL_TAC ; (* "sv3" *) + TYPE_THEN `top_of_metric(X,d) u` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[SUBSET;IN ]); + ASM_MESON_TAC[]; + ASM_SIMP_TAC[top_of_metric_nbd]; + REWRITE_TAC[IN ]; + DISCH_ALL_TAC; + TYPE_THEN `x` (USE 19 o SPEC); + REWR 1; + REWR 19; + CHO 19; + TYPE_THEN `r` (USE 13 o SPEC); + CHO 13; + REWR 13; + REWR 0; + TYPE_THEN `n +| (j)` (USE 13 o SPEC); + USE 13 (REWRITE_RULE[ARITH_RULE `n<=| (n+| a)`]); + AND 19; + TYPE_THEN `u ((y o ss) (n +| j) )` SUBGOAL_TAC; + USE 19 (REWRITE_RULE[SUBSET;open_ball;IN ;IN_ELIM_THM' ]); + TYPE_THEN `((y o ss) (n +| j))` (USE 19 o SPEC); + ASM_REWRITE_TAC[]; + UND 19; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPE_THEN `(ss (n +| j))` (USE 12 o SPEC); + ASM_REWRITE_TAC[o_DEF ]; + DISCH_TAC; + TYPE_THEN `z = ((y o ss) (n +| j))` ABBREV_TAC; + TYPE_THEN `UNIONS (B (ss (n+| j))) ((y o ss) (n +| j))` SUBGOAL_TAC; + EXPAND_TAC "B"; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIONS;IN_IMAGE]; + REWRITE_TAC[IN; IN_ELIM_THM']; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `j` EXISTS_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (ARITH_RULE `j <= a /\ a <= ss(a) ==> (j <=| (ss (a)))`); + ASM_SIMP_TAC[SEQ_SUBLE]; + ARITH_TAC; + REWRITE_TAC[o_DEF]; + TYPE_THEN `ss(n +| j)` (USE 12 o SPEC); + UND 12; + MESON_TAC[]; + ]);; + (* }}} *) + +let uniformly_continuous = euclid_def + `uniformly_continuous (f:A->B) ((X:A->bool),dX) ((Y:B->bool),dY) <=> + (!epsilon. ?delta. (&.0 < epsilon) ==> (&.0 <. delta) /\ + (!x y. (X x) /\ (X y) /\ + (dX x y < delta) ==> (dY (f x) (f y) < epsilon)))`;; + +(* NB. It is not part of the hypothesis on metric_continuous + that the IMAGE of f on X is contained in Y. Hence the + extra hypothesis. *) + +let compact_uniformly_continuous = prove_by_refinement( + `!f X dX Y dY. metric_continuous f (X,dX) (Y,dY) /\ (metric_space(X,dX)) + /\ (metric_space(Y,dY)) /\ (compact(top_of_metric(X,dX)) X) /\ + (IMAGE f X SUBSET Y) ==> + uniformly_continuous (f:A->B) ((X:A->bool),dX) ((Y:B->bool),dY)`, + (* {{{ proof *) + + [ + REWRITE_TAC[uniformly_continuous;metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + GEN_TAC; + LEFT 0 "epsilon"; + TYPE_THEN `epsilon/(&.2)` (USE 0 o SPEC); + LEFT 0 "delta"; + CHO 0; + TYPE_THEN `cov = IMAGE (\x. open_ball (X,dX) x ((delta x)/(&.2))) X` ABBREV_TAC; + USE 3 (REWRITE_RULE[compact]); + UND 3; + ASM_SIMP_TAC[GSYM top_of_metric_unions;SUBSET_REFL ]; + DISCH_TAC; + TYPE_THEN `cov` (USE 3 o SPEC); + CONV_TAC (quant_right_CONV "delta"); + DISCH_TAC; + WITH 6 (ONCE_REWRITE_RULE [GSYM REAL_LT_HALF1]); + REWR 0; + TYPE_THEN `!x. (&.0 < (delta x)/(&.2))` SUBGOAL_TAC; + ASM_MESON_TAC[REAL_LT_HALF1]; + DISCH_TAC; + TYPE_THEN `X SUBSET UNIONS cov /\ cov SUBSET top_of_metric (X,dX)` SUBGOAL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[SUBSET;UNIONS;IN;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + TYPE_THEN `open_ball (X,dX) x ((delta x)/(&.2))` EXISTS_TAC; + CONJ_TAC; + EXPAND_TAC "cov"; + REWRITE_TAC[IMAGE;IN ;IN_ELIM_THM' ]; + ASM_MESON_TAC[]; + IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); + ASM_REWRITE_TAC[]; + DISCH_TAC ; + REWRITE_TAC[SUBSET;IN ]; + EXPAND_TAC "cov"; + REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; + NAME_CONFLICT_TAC; + DISCH_ALL_TAC; + CHO 10; + AND 10; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[open_ball_open]; + DISCH_TAC; + REWR 3; + CHO 3; + ALL_TAC; (* "cc1"; *) + AND 3; + AND 3; + JOIN 11 10; + UND 10; + EXPAND_TAC "cov"; + DISCH_TAC; +(*** Modified by JRH for changed theorem name + USE 10 (MATCH_MP FINITE_SUBSET_IMAGE); + ***) + USE 10 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); + X_CHO 10 `S:A->bool`; + TYPE_THEN `ds = IMAGE delta S` ABBREV_TAC ; + TYPE_THEN `(FINITE ds) /\ ( !x. (ds x) ==> (&.0 <. x) )` SUBGOAL_TAC; + EXPAND_TAC "ds"; + CONJ_TAC; + IMATCH_MP_TAC FINITE_IMAGE ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; + NAME_CONFLICT_TAC ; + DISCH_ALL_TAC; + CHO 12; + ASM_REWRITE_TAC[]; + DISCH_TAC; + USE 12 (MATCH_MP min_finite_delta); + CHO 12; + TYPE_THEN `delta'/(&.2)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ALL_TAC ; (* "cc2" *) + ASM_REWRITE_TAC[REAL_LT_HALF1]; + DISCH_ALL_TAC; + AND 10; + AND 10; + USE 10( MATCH_MP UNIONS_UNIONS ); + JOIN 3 10; + USE 3 (MATCH_MP SUBSET_TRANS); + USE 3 (REWRITE_RULE [SUBSET;IN;UNIONS;IN_ELIM_THM' ]); + USE 3 (REWRITE_RULE[IMAGE;IN ;IN_ELIM_THM' ]); + TYPE_THEN `x` (WITH 3 o SPEC); + TYPE_THEN `y` (WITH 3 o SPEC); + KILL 3; (* start of yest *) + H_MATCH_MP (HYP "18")(HYP "14"); + H_MATCH_MP (HYP "10") (HYP "13"); + CHO 19; + CHO 3; + AND 19; + CHO 20; + AND 20; + USE 20 (REWRITE_RULE [open_ball]); + REWR 19; + USE 19 (REWRITE_RULE [IN_ELIM_THM']); + AND 19; + AND 19; + TYPE_THEN `dX x' x < delta x'` SUBGOAL_TAC; + UND 19; + IMATCH_MP_TAC (REAL_ARITH `((u <. v) ==> (a< u)==>(a (dX x' y <. u + u)`); + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 15; + IMATCH_MP_TAC (REAL_ARITH `((u <=. v) ==> (a< u)==>(a (u <= v)`); + REWRITE_TAC[REAL_HALF_DOUBLE]; + AND 12; + UND 12; + DISCH_THEN (MATCH_MP_TAC); + EXPAND_TAC "ds"; + REWRITE_TAC[IMAGE;IN; IN_ELIM_THM' ]; + UND 21; + MESON_TAC[]; + IMATCH_MP_TAC metric_space_triangle; + TYPE_THEN `X` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [GSYM REAL_HALF_DOUBLE])); + TYPE_THEN `(dY (f x) (f x') <. u0) /\ (dY (f x') (f y) <. u0) /\ (dY (f x) (f y) <= (dY (f x) (f x')) + (dY (f x') (f y))) ==> ((dY (f x) (f y)) < u0 + u0)` (fun t-> (IMATCH_MP_TAC (REAL_ARITH t))); + TYPE_THEN `x'` (USE 0 o SPEC); + AND 0; + USE 0 (REWRITE_RULE[IN ]); + TYPE_THEN `y` (WITH 0 o SPEC); + TYPE_THEN `x` (USE 0 o SPEC); + ALL_TAC; (* cc4 *) + TYPE_THEN `Y (f x) /\ Y (f y) /\ Y (f x')` SUBGOAL_TAC; + UND 4; + REWRITE_TAC[SUBSET;IN_IMAGE; ]; + REWRITE_TAC[IN ]; + UND 13; + UND 14; + UND 22; + MESON_TAC[]; + DISCH_ALL_TAC; + CONJ_TAC; + TYPE_THEN `dY (f x) (f x') = dY (f x') (f x)` SUBGOAL_TAC; + UND 2; + UND 28; + UND 30; + TYPEL_THEN [`Y`;`dY`;`f x`;`f x'`] (fun t-> MP_TAC(ISPECL t metric_space_symm)); + MESON_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + UND 0; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 27; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + TYPEL_THEN [`Y`;`dY`;`f x`;`f x'`;`f y`] (fun t-> MP_TAC(ISPECL t metric_space_triangle)); + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +(* I'm rather surprised that this lemma did not need the + hypothesis that U and- V are topologies. *) + +let image_compact = prove_by_refinement( + `!U V (f:A->B) K. (continuous f U V ) /\ + (compact U K) /\ (IMAGE f K SUBSET (UNIONS V)) + ==> (compact V (IMAGE f K))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[compact]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `cov = IMAGE (\v. preimage (UNIONS U) f v ) V'` ABBREV_TAC ; + TYPE_THEN `cov SUBSET U` SUBGOAL_TAC ; + EXPAND_TAC "cov"; + REWRITE_TAC[SUBSET;IN_IMAGE ]; + NAME_CONFLICT_TAC; + GEN_TAC; + DISCH_ALL_TAC; + CHO 6; + AND 6; + ASM_REWRITE_TAC[]; + USE 4 (REWRITE_RULE[SUBSET]); + TYPE_THEN `x'` (USE 4 o SPEC); + REWR 4; + UND 4; + UND 0; + REWRITE_TAC[continuous]; + MESON_TAC[]; + TYPE_THEN `K SUBSET UNIONS cov` SUBGOAL_TAC; + ALL_TAC; (* ic1 *) + UND 3; + REWRITE_TAC[SUBSET;IN_IMAGE ]; + NAME_CONFLICT_TAC; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + LEFT 3 "x'"; + DISCH_ALL_TAC; + LEFT 3 "x'"; + TYPE_THEN `x'` (USE 3 o SPEC); + TYPE_THEN `f x'` (USE 3 o SPEC); + REWR 3; + UND 3; + REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ]; + USE 5 (REWRITE_RULE[IMAGE]); + EXPAND_TAC "cov"; + REWRITE_TAC[IN_ELIM_THM';IN ]; + DISCH_ALL_TAC; + CHO 5; + CONV_TAC (quant_left_CONV "x"); + CONV_TAC (quant_left_CONV "x"); + TYPE_THEN `u` EXISTS_TAC; + NAME_CONFLICT_TAC; + TYPE_THEN `preimage (UNIONS U) f u` EXISTS_TAC; + ASM_REWRITE_TAC[preimage;IN_ELIM_THM' ;IN ]; + USE 1 (REWRITE_RULE[compact;SUBSET;IN ]); + AND 1; + UND 7; + UND 6; + MESON_TAC[]; + DISCH_ALL_TAC; + USE 1 (REWRITE_RULE[compact]); + AND 1; + TYPE_THEN `cov` (USE 1 o SPEC); + REWR 1; + CHO 1; + ALL_TAC ; (* ic2 *) + TYPE_THEN `(?V''. V'' SUBSET V' /\ FINITE V'' /\ (W = IMAGE (\v. preimage (UNIONS U) f v) V''))` SUBGOAL_TAC; + IMATCH_MP_TAC finite_subset ; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + CHO 9; + TYPE_THEN `V''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN_IMAGE]; + REWRITE_TAC[IN;UNIONS;IN_ELIM_THM' ]; + NAME_CONFLICT_TAC; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + AND 1; + AND 1; + USE 1 (REWRITE_RULE[SUBSET;UNIONS;IN;IN_ELIM_THM' ]); + TYPE_THEN `x'` (USE 1 o SPEC); + REWR 1; + CHO 1; + AND 1; + USE 14 (REWRITE_RULE[IMAGE;IN ;IN_ELIM_THM' ]); + TYPE_THEN `u':B->bool` (X_CHO 14); + TYPE_THEN `u'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 1; + ASM_REWRITE_TAC[preimage;IN;IN_ELIM_THM' ]; + MESON_TAC []; + ]);; + (* }}} *) + +let metric_bounded = euclid_def + `metric_bounded (X,d) <=> + ?(x:A) r. X SUBSET (open_ball(X,d) x r)`;; + +let euclid_ball_cube = prove_by_refinement( + `!n x r. ?N. (open_ball(euclid n,d_euclid) x r) SUBSET + {x | euclid n x /\ (!i. abs (x i) <= &N)}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball; ]; + ASSUME_TAC REAL_ARCH_SIMPLE; + TYPE_THEN ` (d_euclid x (\i. &.0) +. r)` (USE 0 o SPEC); + X_CHO 0 `N:num`; + TYPE_THEN `N` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + GEN_TAC ; + ASSUME_TAC proj_contraction; + TYPEL_THEN [`n`;`x'`;`(\(i :num). &.0)`;`i`] (USE 4 o SPECL); + USE 4 BETA_RULE ; + USE 4 (CONV_RULE REDUCE_CONV ); + TYPE_THEN `euclid n (\i. &.0)` SUBGOAL_TAC ; + REWRITE_TAC[euclid]; + DISCH_TAC; + REWR 4; + ASSUME_TAC metric_euclid; + TYPE_THEN `n` (USE 6 o SPEC); + TYPE_THEN `d_euclid x' (\i. &.0) <=. d_euclid x' x + d_euclid x (\i. &0)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_triangle; + TYPE_THEN `euclid n` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `d_euclid x' x = d_euclid x x'` SUBGOAL_TAC; + IMATCH_MP_TAC metric_space_symm; + TYPE_THEN `euclid n` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + UND 3; + UND 4; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let totally_bounded_euclid = prove_by_refinement( + `!X n. (metric_bounded (X,d_euclid) /\ + (X SUBSET (euclid n))) ==> + (totally_bounded (X,d_euclid))`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_bounded]; + DISCH_ALL_TAC; + IMATCH_MP_TAC totally_bounded_subset; + CHO 0; + CHO 0; + ASSUME_TAC euclid_ball_cube; + TYPEL_THEN [`n`;`x`;`r`] (USE 2 o SPECL); + CHO 2; + ASSUME_TAC open_ball_subspace; + TYPEL_THEN [`euclid n`;`X`;`d_euclid`;`x`;`r`] (USE 3 o ISPECL); + REWR 3; + JOIN 0 3; + USE 0 (MATCH_MP SUBSET_TRANS); + JOIN 0 2; + USE 0 (MATCH_MP SUBSET_TRANS); + TYPE_THEN `{x | euclid n x /\ (!i. abs (x i) <= &N)}` EXISTS_TAC; + ASM_REWRITE_TAC[totally_bounded_cube ]; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `euclid n` EXISTS_TAC; + REWRITE_TAC[metric_euclid]; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +(* topology is not needed as an assumption here! *) +let induced_compact = prove_by_refinement( + `!U (K:A->bool). (K SUBSET (UNIONS U)) ==> + (compact U K <=> (compact (induced_top U K) K))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASM_REWRITE_TAC[compact]; + EQ_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[induced_top_support;SUBSET_INTER;SUBSET_REFL ]; + DISCH_ALL_TAC; + USE 3 (REWRITE_RULE[induced_top;SUBSET;IN_IMAGE ]); + LEFT 3 "x'"; + LEFT 3 "x'"; + X_CHO 3 `u:(A->bool)->(A->bool)`; + TYPE_THEN `IMAGE u V` (USE 1 o SPEC); + TYPE_THEN `K SUBSET UNIONS (IMAGE u V) /\ IMAGE u V SUBSET U` SUBGOAL_TAC; + REWRITE_TAC[IMAGE;SUBSET;IN_UNIONS;IN_ELIM_THM' ]; + CONJ_TAC; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[SUBSET;IN_UNIONS ]); + USE 2 (REWRITE_RULE[IN ]); + TYPE_THEN `x` (USE 2 o SPEC); + REWR 2; + X_CHO 2 `v:A->bool`; + NAME_CONFLICT_TAC; + CONV_TAC (quant_left_CONV "x'"); + CONV_TAC (quant_left_CONV "x'"); + TYPE_THEN `v` EXISTS_TAC; + TYPE_THEN `u v` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `v` (USE 3 o SPEC); + USE 3 (REWRITE_RULE[IN]); + REWR 3; + ASSUME_TAC INTER_SUBSET; + USE 5 (CONJUNCT1); + TYPEL_THEN [`u v`;`K`] (USE 5 o ISPECL); + ASM_MESON_TAC[SUBSET;IN]; + NAME_CONFLICT_TAC; + REWRITE_TAC[IN ]; + ASM_MESON_TAC[IN]; + DISCH_TAC; + REWR 1; + CHO 1; + AND 1; + AND 1; + JOIN 6 5; +(*** Modified by JRH for changed theorem name + USE 5 (MATCH_MP FINITE_SUBSET_IMAGE); + ***) + USE 5 (MATCH_MP FINITE_SUBSET_IMAGE_IMP); + X_CHO 5 `W':(A->bool)->bool`; + TYPE_THEN `W'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `K SUBSET UNIONS (IMAGE u W')` SUBGOAL_TAC; + ASM_MESON_TAC[UNIONS_UNIONS ;SUBSET_TRANS]; + REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE; ]; + NAME_CONFLICT_TAC; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `x'` (USE 6 o SPEC); + REWR 6; + CHO 6; + AND 6; + CHO 8; + AND 5; + AND 5; + USE 10 (REWRITE_RULE[SUBSET;IN ]); + TYPE_THEN `x''` (USE 10 o SPEC); + REWR 10; + USE 3 (REWRITE_RULE[IN]); + TYPE_THEN `x''` (USE 3 o SPEC); + REWR 3; + TYPE_THEN `x''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM ONCE_REWRITE_TAC[]; + REWRITE_TAC[INTER;IN;IN_ELIM_THM' ]; + ASM_MESON_TAC[]; + ALL_TAC ; (* dd1*) + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `VK = IMAGE (\b. (b INTER K)) V` ABBREV_TAC ; + TYPE_THEN `VK` (USE 2 o SPEC); + TYPE_THEN `K SUBSET UNIONS VK /\ VK SUBSET induced_top U K` SUBGOAL_TAC; + CONJ_TAC; + EXPAND_TAC "VK"; + REWRITE_TAC[INTER_THM;GSYM UNIONS_INTER ]; + ASM_REWRITE_TAC[SUBSET_INTER;SUBSET_REFL ]; (* end of branch *) + REWRITE_TAC[induced_top]; + EXPAND_TAC "VK"; + REWRITE_TAC[INTER_THM ]; + IMATCH_MP_TAC IMAGE_SUBSET; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + REWR 2; + X_CHO 2 `WK:(A->bool)->bool`; + TYPEL_THEN [`V`;`(INTER) K`;`WK`] (fun t-> MP_TAC (ISPECL t finite_subset )); + ASM_REWRITE_TAC[]; + AND 2; + UND 8; + EXPAND_TAC "VK"; + REWRITE_TAC[INTER_THM]; + DISCH_ALL_TAC; + REWR 8; + CHO 8; + TYPE_THEN `C` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWR 2; + AND 2; + USE 2 (REWRITE_RULE[GSYM UNIONS_INTER]); + UND 2; + TYPE_THEN `R = UNIONS C` ABBREV_TAC; + SET_TAC[]; + ]);; + + (* }}} *) + +let compact_euclid = prove_by_refinement( + `!X n. (X SUBSET euclid n) ==> + (compact (top_of_metric(euclid n,d_euclid)) X <=> + (closed_ (top_of_metric(euclid n,d_euclid)) X /\ + (metric_bounded(X,d_euclid))))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `top_of_metric (X,d_euclid) = induced_top (top_of_metric(euclid n,d_euclid)) X` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM top_of_metric_induced); + ASM_REWRITE_TAC[metric_euclid]; + DISCH_TAC; + TYPE_THEN `metric_space (X,d_euclid)` SUBGOAL_TAC ; + ASM_MESON_TAC [metric_euclid;metric_subspace]; + DISCH_TAC ; + EQ_TAC; + DISCH_ALL_TAC; + CONJ_TAC; + IMATCH_MP_TAC compact_closed; + SIMP_TAC [metric_euclid;metric_hausdorff;top_of_metric_top ]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[metric_bounded]; + IMATCH_MP_TAC totally_bounded_bounded; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC compact_totally_bounded ; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[induced_compact;top_of_metric_unions;metric_euclid ]; + DISCH_ALL_TAC; + TYPE_THEN `X SUBSET (UNIONS (top_of_metric (euclid n,d_euclid)))` SUBGOAL_TAC; + ASM_MESON_TAC[top_of_metric_unions ; metric_euclid]; + ASM_SIMP_TAC [induced_compact ]; + ASSUME_TAC metric_euclid; + DISCH_TAC; + TYPE_THEN `induced_top (top_of_metric(euclid n,d_euclid)) X = top_of_metric(X,d_euclid)` SUBGOAL_TAC; + IMATCH_MP_TAC top_of_metric_induced; + ASM_REWRITE_TAC[]; + DISCH_THEN REWRT_TAC; + IMATCH_MP_TAC complete_compact; + ASM_REWRITE_TAC[]; + CONJ_TAC ; + ASM_MESON_TAC[totally_bounded_euclid]; + IMATCH_MP_TAC complete_closed; + TYPE_THEN `n` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + + +let neg_continuous = prove_by_refinement( + `!n. metric_continuous (euclid_neg) (euclid n,d_euclid) (euclid n,d_euclid)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + RIGHT_TAC "delta"; + DISCH_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + ASM_REWRITE_TAC[IN ]; + DISCH_ALL_TAC; + REWRITE_TAC[d_euclid]; + REWRITE_TAC[euclid_neg_sum]; + REWRITE_TAC[norm_neg]; + REWRITE_TAC[GSYM d_euclid]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let continuous_comp = prove_by_refinement( + `!(f:A->B) (g:B->C) U V W. + continuous f U V /\ continuous g V W /\ + (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==> + continuous (g o f) U W`, + (* {{{ proof *) + + [ + REWRITE_TAC[continuous;IN;preimage]; + DISCH_ALL_TAC; + X_GEN_TAC `w :C->bool`; + DISCH_TAC; + TYPE_THEN `w ` (USE 1 o SPEC); + REWR 1; + TYPE_THEN `{x | UNIONS V x /\ w (g x)}` (USE 0 o SPEC); + REWR 0; + USE 0 (REWRITE_RULE[IN_ELIM_THM' ]); + REWRITE_TAC[o_DEF ]; + TYPE_THEN `U {x | UNIONS U x /\ UNIONS V (f x) /\ w (g (f x))} = U {x | UNIONS U x /\ w (g (f x))}` SUBGOAL_TAC; + AP_TERM_TAC; + IMATCH_MP_TAC EQ_EXT; + DISCH_ALL_TAC; + REWRITE_TAC[IN_ELIM_THM']; + IMATCH_MP_TAC (TAUT `(a ==> b) ==> ((a /\ b /\ c) <=> (a /\ c ))`); + TYPE_THEN `UU = UNIONS U ` ABBREV_TAC; + TYPE_THEN `VV = UNIONS V` ABBREV_TAC ; + USE 2 (REWRITE_RULE[SUBSET;IN_IMAGE ]); + ASM_MESON_TAC[IN]; + DISCH_THEN (fun t-> (USE 0 ( REWRITE_RULE[t]))); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + + +let compact_max = prove_by_refinement( + `!(f:A->(num->real)) U K. + (continuous f U (top_of_metric(euclid 1,d_euclid))) /\ + (IMAGE f K SUBSET (euclid 1)) /\ + (compact U K) /\ ~(K=EMPTY)==> + (?x. K x /\ (!y. (K y) ==> (f y 0 <= f x 0)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + COPY 2; + COPY 1; + TYPE_THEN `euclid 1 = UNIONS (top_of_metric (euclid 1,d_euclid))` SUBGOAL_TAC; + MESON_TAC[top_of_metric_unions;metric_euclid]; + DISCH_THEN (fun t-> USE 5 (ONCE_REWRITE_RULE[t])); + JOIN 4 5; + COPY 0; + JOIN 0 4; + WITH 0 (MATCH_MP image_compact); + UND 4; + ASM_SIMP_TAC[compact_euclid]; + DISCH_ALL_TAC; + TYPE_THEN `P = (IMAGE (coord 0) (IMAGE f K))` ABBREV_TAC ; + TYPE_THEN `(?s. !y. (?x. P x /\ y <. x) <=> y <. s)` SUBGOAL_TAC; + IMATCH_MP_TAC REAL_SUP_EXISTS; + CONJ_TAC; + USE 3 (REWRITE_RULE[EMPTY_EXISTS;IN ]); + CHO 3; + TYPE_THEN `f u 0` EXISTS_TAC; + EXPAND_TAC "P"; + REWRITE_TAC[IMAGE;IN;IN_ELIM_THM';coord ]; + NAME_CONFLICT_TAC; + LEFT_TAC "x'"; + LEFT_TAC "x'"; + TYPE_THEN `u` EXISTS_TAC; + ASM_MESON_TAC[]; + USE 6 (REWRITE_RULE[metric_bounded;open_ball;SUBSET;IN_IMAGE ]); + X_CHO 6 `x0:num->real`; + X_CHO 6 `r:real`; + USE 6 (REWRITE_RULE[IN;IN_ELIM_THM' ]); + EXPAND_TAC "P"; + REWRITE_TAC[IMAGE;IN;IN_ELIM_THM';coord]; + NAME_CONFLICT_TAC; + TYPE_THEN `x0 0 +. r` EXISTS_TAC; + DISCH_ALL_TAC; + X_CHO 8 `fx:num->real`; + AND 8; + ASM_REWRITE_TAC[]; + KILL 8; + X_CHO 9 `x:A`; + LEFT 6 "x"; + LEFT 6 "x"; + TYPE_THEN `x` (USE 6 o SPEC); + TYPE_THEN `fx` (USE 6 o SPEC); + REWR 6; + TYPE_THEN `(d_euclid x0 (f x) = abs (x0 0 - (f x 0)))` SUBGOAL_TAC; + IMATCH_MP_TAC euclid1_abs; + USE 1 (REWRITE_RULE[SUBSET;IN ]); + ASM_MESON_TAC[]; + AND 6; + AND 6; + DISCH_TAC; + REWR 6; + UND 6; + REAL_ARITH_TAC; + DISCH_TAC; + ALL_TAC ; (* cc1 *) + TYPE_THEN `(!u. (P u) ==> (u <=. sup P)) /\ (P (sup P))` SUBGOAL_TAC; + REWRITE_TAC[sup]; + SELECT_TAC; + CHO 8; + ASM_REWRITE_TAC[]; + DISCH_TAC; + TYPE_THEN `s = t` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + USE 10 (MATCH_MP (REAL_ARITH `~(s=t) ==> (s<. t) \/ (t <. s)`)); + TYPE_THEN `s ` (WITH 9 o SPEC); + TYPE_THEN `t` (WITH 9 o SPEC); + ASM_MESON_TAC[REAL_ARITH `~(x <. x)`]; + DISCH_TAC; + REWR 8; + SUBCONJ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `t` (USE 8 o SPEC); + UND 8; + REWRITE_TAC[REAL_ARITH `~(x <. x)`]; + LEFT_TAC "x"; + LEFT_TAC "x"; + TYPE_THEN `u` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + TYPE_THEN `~ (IMAGE f K) (t *# (dirac_delta 0))` SUBGOAL_TAC; + PROOF_BY_CONTR_TAC; + REWR 13; + UND 12; + EXPAND_TAC "P"; + ONCE_REWRITE_TAC[IMAGE]; + ONCE_REWRITE_TAC[IMAGE]; + ONCE_REWRITE_TAC[IMAGE]; + REWRITE_TAC[IN_ELIM_THM';IN]; + TYPE_THEN `t *# (dirac_delta 0)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ALL_TAC ; (* cc2 *) + REWRITE_TAC[coord_dirac]; + DISCH_TAC; + USE 4 (MATCH_MP closed_open); + ASSUME_TAC (SPEC `1` metric_euclid); + WITH 14 (MATCH_MP top_of_metric_unions); + WITH 15 (GSYM); + REWR 4; + TYPE_THEN `z = t *# dirac_delta 0` ABBREV_TAC ; + TYPE_THEN `(euclid 1 DIFF (IMAGE f K)) z` SUBGOAL_TAC ; + REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF]; + ASM_REWRITE_TAC[]; + EXPAND_TAC "z"; + REWRITE_TAC[euclid;euclid_scale;dirac_delta]; + DISCH_ALL_TAC; + ASSUME_TAC (ARITH_RULE `1 <=| m ==> (~(0=m))`); + REWR 19; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + REWRITE_TAC[]; + UND 16; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]); + UND 4; + REWRITE_TAC[open_DEF]; + ASM_SIMP_TAC[top_of_metric_nbd]; + DISCH_ALL_TAC; + IN_OUT_TAC ; + TYPE_THEN `z` (USE 0 o SPEC); + KILL 12; + KILL 13; + KILL 9; + UND 14; + UND 3; + REWRITE_TAC[]; + DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]); + DISCH_ALL_TAC; + REWR 0; + CHO 0; + AND 0; + USE 0 (REWRITE_RULE[SUBSET;IN; open_ball;IN_ELIM_THM' ]); + COPY 0; + TYPE_THEN `(t- (r/(&.2)))*# (dirac_delta 0)` (USE 0 o SPEC); + TYPE_THEN `euclid 1 z /\ euclid 1 ((t - r / &2) *# dirac_delta 0) /\ d_euclid z ((t - r / &2) *# dirac_delta 0) < r` SUBGOAL_TAC; + EXPAND_TAC "z"; + SUBCONJ_TAC; + REWRITE_TAC[euclid;dirac_delta;euclid_scale]; + GEN_TAC; + SIMP_TAC [ (ARITH_RULE `1 <=| m ==> (~(0=m))`)]; + REWRITE_TAC[REAL_ARITH `t*(&.0) = (&.0)`]; + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[euclid;dirac_delta;euclid_scale]; + GEN_TAC; + SIMP_TAC [ (ARITH_RULE `1 <=| m ==> (~(0=m))`)]; + REWRITE_TAC[REAL_ARITH `t*(&.0) = (&.0)`]; + ALL_TAC ; (* cc3 *) + UND 13 ; + SIMP_TAC[euclid1_abs]; + DISCH_ALL_TAC; + REWRITE_TAC[euclid_minus ; euclid_scale;dirac_delta ]; + REDUCE_TAC ; + REWRITE_TAC[REAL_ARITH `t - (t - (r/(&.2))) = r/(&.2)`]; + WITH 9 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]); + WITH 19 (MATCH_MP (REAL_ARITH `&.0 < x ==> (&.0 <= x)`)); + WITH 20 (REWRITE_RULE[GSYM REAL_ABS_REFL]); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LT_HALF2]; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> (USE 0 (REWRITE_RULE[t]))); + ALL_TAC ; (* cc4 *) + TYPE_THEN `t - (r/(&.2)) ` (USE 10 o SPEC); + TYPE_THEN `t - r / &2 < t` SUBGOAL_TAC; + IMATCH_MP_TAC (REAL_ARITH `&.0 < x ==> (t - x < t)`); + WITH 9 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]); + ASM_REWRITE_TAC[]; + DISCH_TAC ; + REWR 10; + X_CHO 10 `u:real`; + TYPE_THEN `u` (USE 7 o SPEC); + REWR 7; + TYPE_THEN `(euclid 1 DIFF IMAGE f K) (u *# (dirac_delta 0))` SUBGOAL_TAC ; + UND 12; + DISCH_THEN (IMATCH_MP_TAC ); + EXPAND_TAC "z"; + SUBCONJ_TAC; + REWRITE_TAC[euclid;euclid_scale;dirac_delta]; + REWRITE_TAC[ (ARITH_RULE `1 <=| m <=> (~(0=m))`)]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[euclid;euclid_scale;dirac_delta]; + REWRITE_TAC[ (ARITH_RULE `1 <=| m <=> (~(0=m))`)]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + ASM_SIMP_TAC[euclid1_abs]; + EXPAND_TAC "z"; + REWRITE_TAC[dirac_delta;euclid_scale;euclid_minus]; + REDUCE_TAC; + AND 10; + REWRITE_TAC[GSYM ABS_BETWEEN]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 7; + UND 9; + REAL_ARITH_TAC; + UND 10; + IMATCH_MP_TAC (REAL_ARITH `y <. x ==> ((t - y <. u) ==> (t <. u + x))`); + REWRITE_TAC[REAL_LT_HALF2]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF]; + IMATCH_MP_TAC (TAUT `B ==> (~(A /\ ~B))`); + AND 10; + UND 14; + EXPAND_TAC "P"; + TYPE_THEN `B = IMAGE f K` ABBREV_TAC ; + ALL_TAC ; (* cc5 *) + REWRITE_TAC[IMAGE;coord;IN;IN_ELIM_THM' ]; + DISCH_TAC; + CHO 19; + AND 19; + ASM_REWRITE_TAC[]; + USE 17 (REWRITE_RULE[SUBSET;IN]); + TYPE_THEN `x` (USE 17 o SPEC); + REWR 17; + USE 17 (REWRITE_RULE[euclid1_dirac]); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + TYPE_THEN `t = sup P` ABBREV_TAC; + DISCH_ALL_TAC; + UND 11; + EXPAND_TAC "P"; + REWRITE_TAC[]; + ONCE_REWRITE_TAC[IMAGE]; + REWRITE_TAC[IN_IMAGE;IN_ELIM_THM';IN ]; + NAME_CONFLICT_TAC; + DISCH_ALL_TAC; + CHO 11; + AND 11; + CHO 12; + REWR 11; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + UND 10; + EXPAND_TAC "P"; + REWRITE_TAC[]; + ONCE_REWRITE_TAC[IMAGE]; + REWRITE_TAC[IN_IMAGE;IN_ELIM_THM' ]; + REWRITE_TAC[IN]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[coord]; + NAME_CONFLICT_TAC; + DISCH_ALL_TAC; + TYPE_THEN `f y' 0` (USE 10 o SPEC); + UND 10; + DISCH_THEN IMATCH_MP_TAC ; + LEFT_TAC "x'"; + LEFT_TAC "x'"; + ASM_MESON_TAC[]; + (* finish *) + ]);; + + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* homeomorphisms *) +(* ------------------------------------------------------------------ *) + +let homeomorphism = euclid_def `homeomorphism (f:A->B) U V <=> + (BIJ f (UNIONS U) (UNIONS V) ) /\ (continuous f U V) /\ + (!A. (U A) ==> (V (IMAGE f A)))`;; + +let INV_homeomorphism = prove_by_refinement( + `!f U V. homeomorphism (f:A-> B) U V ==> + (continuous (INV f (UNIONS U) (UNIONS V)) V U)`, + (* {{{ proof *) + + [ + REWRITE_TAC[continuous;IN;preimage]; + REWRITE_TAC[homeomorphism]; + DISCH_ALL_TAC; + X_GEN_TAC `u:A->bool`; + DISCH_ALL_TAC; + TYPE_THEN `{ x | UNIONS V x /\ u (INV f (UNIONS U) (UNIONS V) x)} = IMAGE f u` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT ; + X_GEN_TAC `t:B`; + REWRITE_TAC[IN_ELIM_THM';IMAGE ;IN ]; + EQ_TAC ; + DISCH_ALL_TAC; + TYPE_THEN `(INV f (UNIONS U) (UNIONS V) t)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[INVERSE_DEF;IN;BIJ ]; + DISCH_ALL_TAC; + CHO 4; + SUBCONJ_TAC; + USE 0 (REWRITE_RULE[BIJ;INJ]); + IN_OUT_TAC ; + ASM_REWRITE_TAC[]; + AND 4; + AND 5; + TYPE_THEN `x` (USE 6 o SPEC); + UND 6; + DISCH_THEN (IMATCH_MP_TAC ); + REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ]; + ASM_MESON_TAC[]; + DISCH_TAC ; + TYPE_THEN `INV f (UNIONS U) (UNIONS V) t = x` SUBGOAL_TAC; + (* stop here this is an example that ASM_MESON_TAC should catch *) + (* ASM_MESON_TAC[INVERSE_XY;IN ;UNIONS ]; *) + TYPE_THEN `(UNIONS U x)` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;IN_ELIM_THM';IN ]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[INVERSE_XY;IN ]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + UND 2; + DISCH_THEN IMATCH_MP_TAC ; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let bicont_homeomorphism = prove_by_refinement( + `!f U V. (BIJ (f:A->B) (UNIONS U) (UNIONS V)) /\ (continuous f U V) /\ + (continuous (INV f (UNIONS U) (UNIONS V)) V U) ==> + (homeomorphism f U V)`, + (* {{{ proof *) + + [ + REWRITE_TAC[homeomorphism]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + UND 2; + REWRITE_TAC[continuous;IN;preimage ]; + DISCH_ALL_TAC; + TYPE_THEN `A` (USE 2 o SPEC); + REWR 2; + TYPE_THEN `{x | UNIONS V x /\ A (INV f (UNIONS U) (UNIONS V) x)}= (IMAGE f A) ` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT ; + X_GEN_TAC `t:B`; + REWRITE_TAC[IN_ELIM_THM';IMAGE ;IN ]; + EQ_TAC ; + DISCH_ALL_TAC; + TYPE_THEN `(INV f (UNIONS U) (UNIONS V) t)` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[INVERSE_DEF;IN;BIJ ]; + DISCH_ALL_TAC; + CHO 4; + SUBCONJ_TAC; + USE 0 (REWRITE_RULE[BIJ;INJ]); + IN_OUT_TAC ; + ASM_REWRITE_TAC[]; + AND 4; + AND 5; + TYPE_THEN `x` (USE 6 o SPEC); + UND 6; + DISCH_THEN (IMATCH_MP_TAC ); + REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ]; + ASM_MESON_TAC[]; + DISCH_TAC ; + TYPE_THEN `INV f (UNIONS U) (UNIONS V) t = x` SUBGOAL_TAC; + TYPE_THEN `(UNIONS U x)` SUBGOAL_TAC; + REWRITE_TAC[UNIONS;IN_ELIM_THM';IN ]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[INVERSE_XY;IN ]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let open_and_closed = prove_by_refinement( + `!(f:A->B) U V. (topology_ U) /\ (topology_ V) /\ + (BIJ f (UNIONS U) (UNIONS V)) ==> + ((!A. (U A ==> V (IMAGE f A))) <=> + (!B. (closed_ U B) ==> (closed_ V (IMAGE f B))))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[closed]; + EQ_TAC; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + SUBCONJ_TAC; + UND 4; + UND 2; + (* should have worked: + ASM_MESON_TAC[SUBSET;IN;BIJ;INJ;IMAGE;IN_ELIM_THM' ]; + bug found? *) + REWRITE_TAC[BIJ;IN;INJ;SUBSET;IMAGE;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + NAME_CONFLICT_TAC; + TYPE_THEN `y:B` X_GEN_TAC; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWRITE_TAC[open_DEF]; + USE 5 (REWRITE_RULE[open_DEF]); + TYPE_THEN `UNIONS U DIFF B` (USE 3 o SPEC); + REWR 3; + TYPE_THEN `IMAGE f (UNIONS U DIFF B) = (UNIONS V DIFF IMAGE f B)` SUBGOAL_TAC; + ASM_MESON_TAC[DIFF_SURJ]; + ASM_MESON_TAC[]; + REWRITE_TAC[open_DEF]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + TYPE_THEN `UNIONS U DIFF A` (USE 3 o SPEC); + TYPE_THEN `UNIONS U DIFF A SUBSET UNIONS U /\ U (UNIONS U DIFF (UNIONS U DIFF A))` SUBGOAL_TAC; + ASM_SIMP_TAC[sub_union ; DIFF_DIFF2 ]; + ASM_REWRITE_TAC[SUBSET_DIFF]; + DISCH_TAC ; + REWR 3; + TYPE_THEN `UNIONS V DIFF IMAGE f (UNIONS U DIFF A) = IMAGE f A` SUBGOAL_TAC; + ASM_MESON_TAC[DIFF_SURJ; sub_union; DIFF_DIFF2]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let hausdorff_homeomorphsim = prove_by_refinement( + `!f U V. (BIJ (f:A->B) (UNIONS U) (UNIONS V)) /\ (continuous f U V) /\ + (compact U (UNIONS U)) /\ (hausdorff V) /\ (topology_ U) /\ + (topology_ V) ==> (homeomorphism f U V)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_REWRITE_TAC[homeomorphism]; + ASM_SIMP_TAC[open_and_closed]; + DISCH_ALL_TAC; + TYPEL_THEN [`U`;`UNIONS U`;`B`] (fun t-> ASSUME_TAC (SPECL t closed_compact)); + REWR 7; + WITH 6 (REWRITE_RULE[closed]); + REWR 7; + IMATCH_MP_TAC compact_closed ; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC image_compact; + TYPE_THEN `U` EXISTS_TAC; + ASM_REWRITE_TAC[]; + AND 8; + USE 0 (REWRITE_RULE[BIJ;INJ;IN ]); + AND 0; + AND 10; + REWRITE_TAC[SUBSET;IN_IMAGE]; + REWRITE_TAC[IN]; + USE 9 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* the metric and topology on the real numbers *) +(* ------------------------------------------------------------------ *) + +let d_real = euclid_def `d_real x y = ||. (x -. y)`;; + +(* +let real_topology = euclid_def + `real_topology = top_of_metric (UNIV,d_real)`;; +*) + +let metric_real = prove_by_refinement( + `metric_space (UNIV,d_real)`, + (* {{{ proof *) + [ + REWRITE_TAC[metric_space;UNIV;d_real ]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let continuous_euclid1 = prove_by_refinement( + `!i n. continuous (coord i) + (top_of_metric (euclid n,d_euclid)) + (top_of_metric (UNIV,d_real))`, + (* {{{ proof *) + + [ + TYPE_THEN `!i n . IMAGE (coord i) (euclid n) SUBSET (UNIV) /\ metric_space (euclid n,d_euclid) /\ metric_space (UNIV,d_real)` SUBGOAL_TAC; + REP_GEN_TAC; + REWRITE_TAC[UNIV ;SUBSET;IN]; + REWRITE_TAC[metric_euclid;metric_real;GSYM UNIV]; + DISCH_TAC; + DISCH_ALL_TAC; + TYPEL_THEN [`i`;`n`] (USE 0 o SPECL); + USE 0 (IMATCH_MP metric_continuous_continuous); + ASM_REWRITE_TAC[]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + RIGHT_TAC "delta"; + DISCH_ALL_TAC; + REWRITE_TAC[d_real;IN;coord]; + TYPE_THEN `epsilon` EXISTS_TAC; + ASM_REWRITE_TAC[]; + GEN_TAC; + DISCH_ALL_TAC; + UND 4; + IMATCH_MP_TAC (REAL_ARITH `(a <=. b) ==> ((b <. e) ==> (a <. e))`); + ASM_MESON_TAC[proj_contraction]; + ]);; + + (* }}} *) + + +let interval_closed_ball = prove_by_refinement( + `!a b . ? x r. (a <=. b) ==> + ({x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} = + (closed_ball(euclid 1,d_euclid)) x r)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `((a +b)/(&.2)) *# (dirac_delta 0)` EXISTS_TAC; + TYPE_THEN `((b -a)/(&.2))` EXISTS_TAC; + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[closed_ball;IN_ELIM_THM']; + DISCH_ALL_TAC; + IMATCH_MP_TAC (TAUT `(a ==> (b <=> d /\ c)) ==> (a /\ b <=> d /\ a /\ c)`); + DISCH_ALL_TAC; + TYPE_THEN `z = ((a + b) / &2 *# dirac_delta 0)` ABBREV_TAC; + TYPE_THEN `euclid 1 z` SUBGOAL_TAC; + EXPAND_TAC "z"; + MESON_TAC[euclid_dirac]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[euclid1_abs]; + EXPAND_TAC "z"; + TYPE_THEN `t = x 0` ABBREV_TAC ; + REWRITE_TAC[dirac_delta;euclid_scale]; + REDUCE_TAC ; + REWRITE_TAC[GSYM INTERVAL_ABS ]; + IMATCH_MP_TAC (TAUT `((a = d) /\ (b = C)) ==> ((a /\ b) <=> (C /\ d))`); + ONCE_REWRITE_TAC[REAL_ARITH `((x <=. u + v) <=> (x - v <=. u)) /\ ((x - u <= v) <=> (x <=. v + u))`]; + CONJ_TAC; + TYPE_THEN `(a + b) / &2 - (b - a) / &2 = a` SUBGOAL_TAC ; + REWRITE_TAC[real_div]; + REWRITE_TAC[REAL_ARITH `(a+b)*C - (b-a)*C = a*(&.2*C) `]; + REDUCE_TAC ; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + TYPE_THEN `(a+ b) /(&.2) + (b - a)/(&.2) = b` SUBGOAL_TAC; + REWRITE_TAC[real_div]; + REWRITE_TAC[REAL_ARITH `(a+b) * C + (b - a) * C = b *(&.2*C)`]; + REDUCE_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ]);; + (* }}} *) + +let interval_euclid1_closed = prove_by_refinement( + `!a b. closed_ (top_of_metric (euclid 1,d_euclid)) + {x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASM_CASES_TAC `a <=. b`; + ASSUME_TAC interval_closed_ball; + TYPEL_THEN [`a`;`b`] (USE 1 o SPECL); + (CHO 1); + CHO 1; + REWR 1; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC closed_ball_closed; + REWRITE_TAC[metric_euclid]; + TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}= EMPTY ` SUBGOAL_TAC ; + REWRITE_TAC[EQ_EMPTY;IN_ELIM_THM' ]; + GEN_TAC; + TYPE_THEN `t = x 0 ` ABBREV_TAC; + KILL 1; + IMATCH_MP_TAC (TAUT `~(b /\ C) ==> ~( a /\ b/\ C)`); + UND 0; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + IMATCH_MP_TAC empty_closed; + IMATCH_MP_TAC top_of_metric_top ; + REWRITE_TAC[metric_euclid]; + ]);; + (* }}} *) + +let interval_euclid1_bounded = prove_by_refinement( + `!a b. metric_bounded + ({x | euclid 1 x /\ a <= x 0 /\ x 0 <= b},d_euclid)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[metric_bounded]; + ASSUME_TAC interval_closed_ball; + TYPEL_THEN [`a`;`b`] (USE 0 o SPECL); + CHO 0; + CHO 0; + ASM_CASES_TAC `a <=. b`; + REWR 0; + ASM_REWRITE_TAC[]; + TYPE_THEN `x` EXISTS_TAC; + TYPE_THEN `r + (&.1) ` EXISTS_TAC; + REWRITE_TAC[open_ball;SUBSET;IN ;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 2; + REWRITE_TAC[closed_ball;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 4; + ASM_SIMP_TAC[euclid1_abs ]; + TYPE_THEN `t = x 0` ABBREV_TAC; + TYPE_THEN `s = x' 0` ABBREV_TAC; + DISCH_ALL_TAC; + TYPE_THEN `&.0 <=. r` SUBGOAL_TAC; + UND 6; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + UND 6; + UND 7; + REAL_ARITH_TAC ; + TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} = EMPTY` SUBGOAL_TAC; + REWRITE_TAC[EQ_EMPTY;IN_ELIM_THM' ]; + GEN_TAC; + TYPE_THEN `t = x 0 ` ABBREV_TAC; + KILL 2; + IMATCH_MP_TAC (TAUT `~(b /\ C) ==> ~( a /\ b/\ C)`); + UND 1; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[EMPTY_SUBSET]; + ]);; + (* }}} *) + +let interval_euclid1_compact = prove_by_refinement( + `!a b. compact (top_of_metric(euclid 1,d_euclid)) + {x | (euclid 1 x) /\ (a <=. (x 0)) /\ (x 0 <= b)}`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} SUBSET (euclid 1)` SUBGOAL_TAC; + REWRITE_TAC [SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + DISCH_TAC; + ASM_SIMP_TAC[compact_euclid]; + CONJ_TAC; + MATCH_ACCEPT_TAC interval_euclid1_closed; + MATCH_ACCEPT_TAC interval_euclid1_bounded; + ]);; + (* }}} *) + +let interval_image = prove_by_refinement( + `!a b. {x | a <=. x /\ (x <= b)} = + IMAGE (coord 0) {x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM';IMAGE]; + GEN_TAC; + EQ_TAC; + DISCH_ALL_TAC; + TYPE_THEN `x *# (dirac_delta 0)` EXISTS_TAC; + REWRITE_TAC[coord_dirac;euclid_dirac;dirac_0]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CHO 0; + USE 0 (REWRITE_RULE[coord]); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let interval_compact = prove_by_refinement( + `!a b. compact (top_of_metric (UNIV,d_real)) + {x | a <=. x /\ (x <=. b)} `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[interval_image]; + IMATCH_MP_TAC image_compact; + TYPE_THEN `(top_of_metric (euclid 1,d_euclid))` EXISTS_TAC; + REWRITE_TAC[continuous_euclid1;interval_euclid1_compact]; + SIMP_TAC[GSYM top_of_metric_unions;metric_real]; + REWRITE_TAC[UNIV;SUBSET;IN]; + ]);; + (* }}} *) + +let half_open = prove_by_refinement( + `!a. top_of_metric(UNIV,d_real ) { x | x <. a}`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC open_nbd ; + TYPEL_THEN [`top_of_metric (UNIV,d_real)`;` {x | x < a}`] (USE 0 o ISPECL); + USE 0 (SIMP_RULE[top_of_metric_top;metric_real ]); + ASM_REWRITE_TAC[]; + GEN_TAC; + TYPE_THEN `open_ball (UNIV,d_real) x (a - x)` EXISTS_TAC; + REWRITE_TAC[IN_ELIM_THM']; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[open_ball;d_real ;IN;IN_ELIM_THM';UNIV ;SUBSET ]; + GEN_TAC ; + UND 1; + REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); + REWRITE_TAC[metric_real; UNIV ]; + UND 1; + REAL_ARITH_TAC; + IMATCH_MP_TAC open_ball_open; + REWRITE_TAC[metric_real]; + ]);; + (* }}} *) + +let half_open_above = prove_by_refinement( + `!a. top_of_metric(UNIV,d_real ) { x | a <. x}`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC open_nbd ; + TYPEL_THEN [`top_of_metric (UNIV,d_real)`;` {x | a <. x}`] (USE 0 o ISPECL); + USE 0 (SIMP_RULE[top_of_metric_top;metric_real ]); + ASM_REWRITE_TAC[]; + GEN_TAC; + TYPE_THEN `open_ball (UNIV,d_real) x (x -. a)` EXISTS_TAC; + REWRITE_TAC[IN_ELIM_THM']; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[open_ball;d_real ;IN;IN_ELIM_THM';UNIV ;SUBSET ]; + GEN_TAC ; + UND 1; + REAL_ARITH_TAC; + CONJ_TAC; + IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); + REWRITE_TAC[metric_real; UNIV ]; + UND 1; + REAL_ARITH_TAC; + IMATCH_MP_TAC open_ball_open; + REWRITE_TAC[metric_real]; + ]);; + (* }}} *) + +let joinf = euclid_def `joinf (f:real -> A) g a = + (\ x . (if (x <. a) then (f x) else (g x)))`;; + +let joinf_cont = prove_by_refinement( + `!U a (f:real -> A) g. + (continuous f (top_of_metric(UNIV,d_real)) U) /\ + (continuous g (top_of_metric(UNIV,d_real)) U) /\ + (f a = (g a)) ==> + ( (continuous (joinf f g a) (top_of_metric(UNIV,d_real)) U))`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + REWRITE_TAC[IN ]; + ASSUME_TAC open_nbd; + TYPEL_THEN [`top_of_metric (UNIV,d_real)`;`(preimage (UNIONS (top_of_metric (UNIV,d_real))) (joinf f g a) v)`] (USE 4 o ISPECL); + USE 4 (SIMP_RULE [top_of_metric_top;metric_real ]); + ASM_REWRITE_TAC[]; + GEN_TAC; + REWRITE_TAC[subset_preimage]; + RIGHT_TAC "B"; + DISCH_TAC; + SIMP_TAC[GSYM top_of_metric_unions; metric_real]; + REWRITE_TAC[SUBSET_UNIV]; + MP_TAC (REAL_ARITH `(x = a) \/ (x <. a) \/ (a <. x)`); + REP_CASES_TAC; + TYPE_THEN `B = (preimage (UNIONS (top_of_metric (UNIV,d_real))) f v) INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) g v)` ABBREV_TAC ; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE;IN ]; + GEN_TAC; + LEFT_TAC "x"; + GEN_TAC ; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 9; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;IN_ELIM_THM';IN ]; + REWRITE_TAC[REWRITE_RULE[IN] in_preimage;joinf ]; + COND_CASES_TAC; + MESON_TAC[]; + MESON_TAC[]; + CONJ_TAC ; + ASM_REWRITE_TAC[]; + UND 5; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;IN;IN_ELIM_THM']; + REWRITE_TAC[REWRITE_RULE[IN] in_preimage]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[joinf]; + REWRITE_TAC[REAL_ARITH `~(a<. a)`]; + ASSUME_TAC top_of_metric_top; + TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL); + USE 8 (REWRITE_RULE[metric_real ]); + USE 8 (REWRITE_RULE[topology]); + EXPAND_TAC "B"; + KILL 7; + TYPE_THEN `v` (USE 0 o SPEC); + TYPE_THEN `v` (USE 1 o SPEC); + ASM_MESON_TAC[IN ]; + (* 2nd case x < a *) + TYPE_THEN `B = { x | x <. a } INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) f v)` ABBREV_TAC ; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[SUBSET;IN_IMAGE ; IN;joinf ]; + GEN_TAC ; + LEFT_TAC "x"; + GEN_TAC ; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 9; + EXPAND_TAC "B"; + REWRITE_TAC[INTER ;IN ;IN_ELIM_THM']; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + USE 10 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]); + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 5; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;IN;IN_ELIM_THM']; + REWRITE_TAC[REWRITE_RULE[IN] in_preimage]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 8; + REWRITE_TAC[joinf]; + ASM_REWRITE_TAC[]; + ASSUME_TAC top_of_metric_top; + TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL); + USE 8 (REWRITE_RULE[metric_real ]); + USE 8 (REWRITE_RULE[topology]); + TYPE_THEN `v` (USE 0 o SPEC); + TYPE_THEN `v` (USE 1 o SPEC); + EXPAND_TAC "B"; + KILL 7; + KILL 5; + KILL 4; + KILL 1; + KILL 6; + TYPEL_THEN [`{x | x < a}`;`preimage (UNIONS (top_of_metric (UNIV,d_real))) f v`] (USE 8 o ISPECL); + RIGHT 1 "V"; + RIGHT 1 "V"; + AND 1; + AND 1; + REWR 0; + USE 0 (REWRITE_RULE[IN]); + REWR 5; + USE 5 (REWRITE_RULE[half_open]); + ASM_REWRITE_TAC[]; + (* case 3 a < x *) + TYPE_THEN `B = { x | a <. x } INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) g v)` ABBREV_TAC ; + TYPE_THEN `B` EXISTS_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[SUBSET;IN_IMAGE ; IN;joinf ]; + GEN_TAC ; + LEFT_TAC "x"; + GEN_TAC ; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 9; + EXPAND_TAC "B"; + REWRITE_TAC[INTER ;IN ;IN_ELIM_THM']; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + USE 10 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]); + ASM_REWRITE_TAC[]; + USE 9 (MATCH_MP (REAL_ARITH `a < x'' ==> (~(x'' <. a))`)); + ASM_REWRITE_TAC[]; + CONJ_TAC; + UND 5; + EXPAND_TAC "B"; + REWRITE_TAC[INTER;IN;IN_ELIM_THM']; + REWRITE_TAC[REWRITE_RULE[IN] in_preimage]; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + UND 8; + REWRITE_TAC[joinf]; + USE 6 (MATCH_MP (REAL_ARITH `a < x'' ==> (~(x'' <. a))`)); + ASM_REWRITE_TAC[]; + ASSUME_TAC top_of_metric_top; + TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL); + USE 8 (REWRITE_RULE[metric_real ]); + USE 8 (REWRITE_RULE[topology]); + TYPE_THEN `v` (USE 0 o SPEC); + TYPE_THEN `v` (USE 1 o SPEC); + EXPAND_TAC "B"; + KILL 7; + KILL 5; + KILL 4; + KILL 0; + KILL 6; + TYPEL_THEN [`{x | a < x}`;`preimage (UNIONS (top_of_metric (UNIV,d_real))) g v`] (USE 8 o ISPECL); + RIGHT 0 "V"; + RIGHT 0 "V"; + AND 0; + AND 0; + REWR 1; + USE 1 (REWRITE_RULE[IN]); + REWR 5; + USE 5 (REWRITE_RULE[half_open_above]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let neg_cont = prove_by_refinement( + `continuous ( --.) + (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)) `, + (* {{{ proof *) + [ + TYPE_THEN `IMAGE ( --. ) (UNIV) SUBSET (UNIV)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN;UNION;UNIV ]; + DISCH_TAC; + ASM_SIMP_TAC[metric_continuous_continuous;metric_real ]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[UNIV;IN;d_real ]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let add_cont = prove_by_refinement( + `!u. (continuous ( (+.) u)) + (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real)) `, + (* {{{ proof *) + + [ + GEN_TAC; + TYPE_THEN `IMAGE ( (+.) u ) (UNIV) SUBSET (UNIV)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN;UNION;UNIV ]; + DISCH_TAC; + ASM_SIMP_TAC[metric_continuous_continuous;metric_real ]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + TYPE_THEN `epsilon` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[UNIV;IN;d_real ]; + REAL_ARITH_TAC; + ]);; + + (* }}} *) + +let continuous_scale = prove_by_refinement( + `!x n. (euclid n x) ==> + (continuous (\t. (t *# x)) (top_of_metric(UNIV,d_real)) + (top_of_metric(euclid n,d_euclid)))`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + ASSUME_TAC metric_euclid; + ASSUME_TAC metric_real ; + TYPE_THEN `IMAGE (\t. (t *# x)) (UNIV) SUBSET (euclid n)` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE;IN_ELIM_THM']; + REWRITE_TAC[Q_ELIM_THM'';IN ; UNIV ]; + ASM_MESON_TAC[euclid_scale_closure]; + ASM_SIMP_TAC[metric_continuous_continuous]; + DISCH_TAC; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + DISCH_ALL_TAC; + REWRITE_TAC[IN;UNIV]; + TYPE_THEN `euclidean x` SUBGOAL_TAC; + ASM_MESON_TAC[euclidean]; + ASM_SIMP_TAC[norm_scale;d_real]; + DISCH_TAC; + TYPE_THEN `norm x <=. &.1` ASM_CASES_TAC ; + TYPE_THEN `epsilon` EXISTS_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + MP_TAC (SPEC `x' -. y` REAL_ABS_POS); + DISCH_TAC ; + USE 5 (MATCH_MP (SPEC `x' -. y` REAL_PROP_LE_LABS)); + USE 5 (CONV_RULE REDUCE_CONV); + UND 5; + UND 7; + REAL_ARITH_TAC ; + TYPE_THEN `epsilon / norm x` EXISTS_TAC; + DISCH_ALL_TAC; + CONJ_TAC; + IMATCH_MP_TAC REAL_LT_DIV; + ASM_REWRITE_TAC[]; + UND 5; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x <= &.1) ==> (&.0 <. x)`;REAL_LT_RDIV_EQ]; + ]);; + + (* }}} *) + +let continuous_lin_combo = prove_by_refinement( + `! x y n. (euclid n x) /\ (euclid n y) ==> + (continuous (\t. (t *# x + (&.1 - t) *# y)) + (top_of_metric(UNIV,d_real)) + (top_of_metric(euclid n,d_euclid)))`, + (* {{{ proof *) + + let comp_elim_tac = ( IMATCH_MP_TAC continuous_comp THEN + TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC THEN + ASM_SIMP_TAC[add_cont;neg_cont;continuous_scale] THEN + REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM''] THEN + SIMP_TAC[GSYM top_of_metric_unions ;metric_real;IN_UNIV ] ) in + [ + DISCH_ALL_TAC; + IMATCH_MP_TAC continuous_sum; + ASM_SIMP_TAC[metric_real;metric_euclid;top_of_metric_top;continuous_scale;SUBSET ;IN_IMAGE;Q_ELIM_THM'' ]; + ASM_SIMP_TAC[IN;euclid_scale_closure;continuous_scale]; + TYPE_THEN `(\t . (&. 1 - t) *# y) = (\t. t *# y) o ((--.) o ((+.) (--. (&.1))))` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[o_DEF;REAL_ARITH `--.(--. u +. v) = (u -. v)`]; + DISCH_THEN (fun t-> REWRITE_TAC [t]); + REPEAT comp_elim_tac; + ]);; + + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Connected Sets *) +(* ------------------------------------------------------------------ *) + +let connected = euclid_def `connected U (Z:A->bool) <=> + (Z SUBSET (UNIONS U)) /\ + (!A B. (U A) /\ (U B) /\ (A INTER B = EMPTY ) /\ + (Z SUBSET (A UNION B)) ==> ((Z SUBSET A) \/ (Z SUBSET B)))`;; + +let connected_unions = prove_by_refinement( + `!U (Z1:A->bool) Z2. (connected U Z1) /\ (connected U Z2) /\ + ~(Z1 INTER Z2 = EMPTY) ==> (connected U (Z1 UNION Z2))`, + (* {{{ proof *) + [ + REWRITE_TAC[connected]; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + SUBCONJ_TAC; + REWRITE_TAC[UNION;SUBSET;IN;IN_ELIM_THM' ]; + ASM_MESON_TAC[SUBSET ;IN]; + DISCH_TAC ; + DISCH_ALL_TAC; + TYPEL_THEN [`A`;`B`] (USE 1 o SPECL); + REWR 1; + TYPEL_THEN [`A`;`B`] (USE 3 o SPECL); + REWR 3; + WITH 9 (REWRITE_RULE[union_subset]); + REWR 1; + REWR 3; + IMATCH_MP_TAC (TAUT `(~b ==> a) ==> (a \/ b)`); + DISCH_ALL_TAC; + USE 11 (REWRITE_RULE[union_subset]); + (* start a case *) + USE 4 (REWRITE_RULE[EMPTY_EXISTS]); + CHO 4; + USE 4 (REWRITE_RULE[IN;INTER;IN_ELIM_THM' ]); + REWRITE_TAC[union_subset]; + TYPE_THEN `~((Z1 SUBSET A) /\ (Z2 SUBSET B))` SUBGOAL_TAC; + DISCH_ALL_TAC; + USE 8 (REWRITE_RULE[EQ_EMPTY]); + USE 8 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]); + ASM_MESON_TAC[SUBSET;IN]; + TYPE_THEN `~((Z2 SUBSET A) /\ (Z1 SUBSET B))` SUBGOAL_TAC; + DISCH_ALL_TAC; + USE 8 (REWRITE_RULE[EQ_EMPTY]); + USE 8 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]); + ASM_MESON_TAC[SUBSET;IN]; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let component_DEF = euclid_def `component U (x:A) y <=> + (?Z. (connected U Z) /\ (Z x) /\ (Z y))`;; + +let connected_sing = prove_by_refinement( + `!U (x:A). (UNIONS U x) ==> (connected U {x})`, + (* {{{ proof *) + [ + REWRITE_TAC[connected]; + DISCH_ALL_TAC; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN_SING ]; + ASM_MESON_TAC[IN]; + DISCH_ALL_TAC; + UND 4; + SET_TAC[]; + ]);; + (* }}} *) + +let component_refl = prove_by_refinement( + `!U x. (UNIONS U x) ==> (component U x (x:A))`, + (* {{{ proof *) + [ + REWRITE_TAC[component_DEF]; + ASM_MESON_TAC[IN_SING;IN;connected_sing]; + ]);; + (* }}} *) + +let component_symm = prove_by_refinement( + `!U x y. (component U x y) ==> + (component U (y:A) x)`, + (* {{{ proof *) + [ + MESON_TAC[component_DEF]; + ]);; + (* }}} *) + +let component_trans = prove_by_refinement( + `!U (x:A) y z. (component U x y) /\ (component U y z) ==> + (component U x z)`, + (* {{{ proof *) + [ + REWRITE_TAC[component_DEF]; + DISCH_ALL_TAC; + CHO 0; + CHO 1; + TYPE_THEN `connected U (Z UNION Z')` SUBGOAL_TAC; + IMATCH_MP_TAC connected_unions; + ASM_REWRITE_TAC[]; + REWRITE_TAC[EMPTY_EXISTS ]; + REWRITE_TAC[IN;INTER;IN_ELIM_THM' ]; + TYPE_THEN `y` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + TYPE_THEN `Z UNION Z'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNION;IN;IN_ELIM_THM' ]; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* based on the Bolzano lemma *) + +let connect_real = prove_by_refinement( + `!a b. connected (top_of_metric (UNIV,d_real)) + {x | a <=. x /\ x <=. b }`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[connected]; + ASSUME_TAC metric_real; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + SUBCONJ_TAC; + REWRITE_TAC[UNIV;SUBSET;IN ]; + DISCH_TAC; + DISCH_ALL_TAC; + TYPE_THEN `\ (u ,v ). ( u <. a) \/ (b <. v) \/ ({x | u <=. x /\ x <=. v } SUBSET A) \/ ({x | u <=. x /\ x <=. v } SUBSET B)` (fun t-> ASSUME_TAC (SPEC t BOLZANO_LEMMA )); + UND 6; + GBETA_TAC ; + IMATCH_MP_TAC (TAUT `((b ==> c ) /\ a ) ==> ((a ==> b) ==> c )`); + CONJ_TAC; + DISCH_ALL_TAC; + TYPEL_THEN [`a`;`b`] ((USE 6 o SPECL)); + USE 6 (REWRITE_RULE[ARITH_RULE `~(a <. a)`]); + ASM_CASES_TAC `a <=. b`; + REWR 6; + TYPE_THEN `{x | a <=. x /\ x <=. b} = EMPTY ` SUBGOAL_TAC; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM';EMPTY]; + GEN_TAC; + UND 7; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[EMPTY_SUBSET]; + CONJ_TAC; + DISCH_ALL_TAC; + UND 8; + UND 9; + (* c1 *) + USE 4 (REWRITE_RULE[EQ_EMPTY;INTER;IN;IN_ELIM_THM' ]); + TYPE_THEN `b'` (USE 4 o SPEC); + TYPE_THEN `{x | a' <=. x /\ x <=. b' } b'` SUBGOAL_TAC; + ASM_REWRITE_TAC[IN_ELIM_THM']; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `{x | b' <=. x /\ x <=. c } b'` SUBGOAL_TAC; + ASM_REWRITE_TAC[IN_ELIM_THM']; + REAL_ARITH_TAC; + DISCH_TAC; + TYPE_THEN `{x | a' <=. x /\ x <=. b' } UNION {x | b' <=. x /\ x <= c } = { x | a' <=. x /\ x <=. c }` SUBGOAL_TAC; + REWRITE_TAC[UNION;IN;IN_ELIM_THM']; + IMATCH_MP_TAC EQ_EXT ; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + UND 6; + UND 7; + REAL_ARITH_TAC; + DISCH_TAC; + (* cr 1*) + REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN (TRY (GEN_MESON_TAC 0 7 1[REAL_ARITH `(b < b' /\ b' <=. c ==> b <. c ) /\ (a' <=. b' /\ b' <. a ==> a' <. a)`])); + IMATCH_MP_TAC (TAUT `c ==> (a \/ b \/ c \/ d)`); + UND 10; + DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]); + ASM_REWRITE_TAC[union_subset]; + (* ASM_MESON_TAC[SUBSET;IN]; should have worked *) + PROOF_BY_CONTR_TAC; + UND 11; + UND 12; + UND 9; + UND 8; + UND 4; + REWRITE_TAC[SUBSET;IN]; + TYPE_THEN `R ={x | a' <=. x /\ x <=. b'}` ABBREV_TAC; + TYPE_THEN `S = {x | b' <=. x /\ x <=. c}` ABBREV_TAC; + MESON_TAC[]; (* ok now it works *) + PROOF_BY_CONTR_TAC; + UND 11; + UND 12; + UND 9; + UND 8; + UND 4; + REWRITE_TAC[SUBSET;IN]; + TYPE_THEN `R ={x | a' <=. x /\ x <=. b'}` ABBREV_TAC; + TYPE_THEN `S = {x | b' <=. x /\ x <=. c}` ABBREV_TAC; + MESON_TAC[]; (* ok now it works *) + IMATCH_MP_TAC (TAUT `d ==> (a \/ b \/ c \/ d)`); + UND 10; + DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]); + ASM_REWRITE_TAC[union_subset]; + (* cr 2*) + DISCH_ALL_TAC; + ASM_CASES_TAC `x <. a`; + TYPE_THEN `&.1` EXISTS_TAC; + REDUCE_TAC; + DISCH_ALL_TAC; + DISJ1_TAC ; + UND 7; + UND 6; + REAL_ARITH_TAC; + ASM_CASES_TAC `b <. x`; + TYPE_THEN `&.1` EXISTS_TAC; + REDUCE_TAC; + DISCH_ALL_TAC; + DISJ2_TAC; + DISJ1_TAC; + UND 9; + UND 7; + REAL_ARITH_TAC; + TYPE_THEN ` (A UNION B) x` SUBGOAL_TAC; + USE 5 (REWRITE_RULE[SUBSET;IN]); + UND 5; + DISCH_THEN (IMATCH_MP_TAC ); + REWRITE_TAC[IN_ELIM_THM']; + UND 7; + UND 6; + REAL_ARITH_TAC; + DISCH_TAC; + (* cr3 *) + TYPEL_THEN [`UNIV:real -> bool`;`d_real`] (fun t-> (ASSUME_TAC (ISPECL t open_ball_nbd))); (* --//-- *) + USE 8 (REWRITE_RULE[REWRITE_RULE[IN] IN_UNION]); + TYPE_THEN `A x` ASM_CASES_TAC; (* *) + TYPE_THEN `A` (USE 9 o SPEC); + TYPE_THEN `x` (USE 9 o SPEC); (* --//-- *) + CHO 9; + REWR 9; + USE 9 (REWRITE_RULE[open_ball;d_real;UNIV ]); + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + IMATCH_MP_TAC (TAUT `C ==> (a \/ b \/ C\/ d)`); + AND 9; + UND 9; + TYPE_THEN `{x | a' <=. x /\ x <=. b'} SUBSET {y | abs (x - y) <. e}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; + GEN_TAC; + UND 11; + UND 12; + UND 13; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + REWR 8; + TYPE_THEN `B` (USE 9 o SPEC); + TYPE_THEN `x` (USE 9 o SPEC); (* --//-- *) + CHO 9; + REWR 9; + USE 9 (REWRITE_RULE[open_ball;d_real;UNIV ]); + TYPE_THEN `e` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + IMATCH_MP_TAC (TAUT `d ==> (a \/ b \/ C\/ d)`); + AND 9; + UND 9; + TYPE_THEN `{x | a' <=. x /\ x <=. b'} SUBSET {y | abs (x - y) <. e}` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; + GEN_TAC; + UND 11; + UND 12; + UND 13; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ]; + MESON_TAC[]; + ]);; + (* }}} *) + +let connect_image = prove_by_refinement( + `!f U V Z. (continuous (f:A->B) U V) /\ + (IMAGE f Z SUBSET (UNIONS V)) /\ (connected U Z) ==> + (connected V (IMAGE f Z))`, + (* {{{ proof *) + + [ + REWRITE_TAC[connected]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[continuous;IN ]); + TYPE_THEN `A` (WITH 0 o SPEC); + TYPE_THEN `B` (USE 0 o SPEC); + TYPE_THEN `(preimage (UNIONS U) f A)` (USE 3 o SPEC); + TYPE_THEN `(preimage (UNIONS U) f B)` (USE 3 o SPEC); + USE 6 (MATCH_MP preimage_disjoint ); + TYPE_THEN `Z SUBSET preimage (UNIONS U) f A UNION preimage (UNIONS U) f B` SUBGOAL_TAC; + REWRITE_TAC[preimage_union]; + ASM_REWRITE_TAC[]; + USE 3 (REWRITE_RULE[subset_preimage ]); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let path = euclid_def `path U x y <=> + (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ + (f a = (x:A)) /\ (f b = y))`;; + +(**** Old proof modified by JRH to avoid use of GSPEC + +let const_continuous = prove_by_refinement( + `!U V y. (topology_ U) ==> + (continuous (\ (x:A). (y:B)) U V)`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous]; + DISCH_ALL_TAC; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + REWRITE_TAC[preimage;IN ]; + TYPE_THEN `v y` ASM_CASES_TAC ; + ASM_REWRITE_TAC[IN_ELIM_THM;GSPEC ]; + USE 0 (MATCH_MP top_univ); + TYPE_THEN`t = UNIONS U` ABBREV_TAC; + UND 0; + REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[GSPEC ]; + USE 0 (MATCH_MP open_EMPTY); + USE 0 (REWRITE_RULE[open_DEF ;EMPTY]); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +****) + +let const_continuous = prove_by_refinement( + `!U V y. (topology_ U) ==> + (continuous (\ (x:A). (y:B)) U V)`, + (* {{{ proof *) + [ + REWRITE_TAC[continuous]; + DISCH_ALL_TAC; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + REWRITE_TAC[preimage;IN ]; + TYPE_THEN `v y` ASM_CASES_TAC ; + ASM_REWRITE_TAC[IN_ELIM_THM]; + USE 0 (MATCH_MP top_univ); + TYPE_THEN`t = UNIONS U` ABBREV_TAC; + UND 0; + MATCH_MP_TAC(TAUT `(a <=> b) ==> a ==> b`); + AP_TERM_TAC; + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN]; + USE 0 (MATCH_MP open_EMPTY); + USE 0 (REWRITE_RULE[open_DEF ;EMPTY]); + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `{x:A | F} = \x. F` SUBST1_TAC; + REWRITE_TAC[EXTENSION; IN; IN_ELIM_THM]; + ASM_REWRITE_TAC[] + ]);; + (* }}} *) + +let path_component = euclid_def `path_component U x y <=> + (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (a <. b) /\ + (f a = (x:A)) /\ (f b = y) /\ + (IMAGE f { t | a <=. t /\ t <=. b } SUBSET (UNIONS U)))`;; + +let path_refl = prove_by_refinement( + `!U x. (UNIONS U x) ==> (path_component U x (x:A))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASSUME_TAC (top_of_metric_top ); + TYPEL_THEN [`UNIV:real ->bool`;`d_real`] (USE 1 o ISPECL); + USE 1 (REWRITE_RULE[metric_real ]); + USE 1 (MATCH_MP const_continuous); + REWRITE_TAC[path_component]; + TYPE_THEN `(\ (t:real). x)` EXISTS_TAC; + ASM_REWRITE_TAC[IMAGE;IN;]; + TYPE_THEN `&.0` EXISTS_TAC; + TYPE_THEN `&.1` EXISTS_TAC; + CONJ_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET;IN;IN_ELIM_THM']; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + + +let path_symm = prove_by_refinement( +`!U x y . (path_component U x (y:A)) ==> (path_component U y (x:A))`, + (* {{{ proof *) + + [ + REWRITE_TAC[path_component]; + DISCH_ALL_TAC; + (CHO 0); + (CHO 0); + (CHO 0); + TYPE_THEN `f o (--.)` EXISTS_TAC; + TYPE_THEN `--. b` EXISTS_TAC; + TYPE_THEN `--. a` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC; + REWRITE_TAC[neg_cont]; + SIMP_TAC[top_of_metric_top; metric_real; metric_euclidean; metric_euclid; metric_hausdorff; GSYM top_of_metric_unions; open_ball_open;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIV;IN;SUBSET ]; + CONJ_TAC ; + AND 0; + AND 0; + UND 2; + REAL_ARITH_TAC ; + REWRITE_TAC[o_DEF ;]; + REDUCE_TAC ; + ASM_REWRITE_TAC[]; + UND 0; + REWRITE_TAC[IMAGE;IN;SUBSET;IN_ELIM_THM']; + DISCH_ALL_TAC; + DISCH_ALL_TAC; + CHO 5; + USE 4 (CONV_RULE NAME_CONFLICT_CONV ); + TYPE_THEN `x'` (USE 4 o SPEC); + UND 4; + DISCH_THEN IMATCH_MP_TAC ; + NAME_CONFLICT_TAC; + TYPE_THEN `--. x''` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 5; + REAL_ARITH_TAC ; + ]);; + + (* }}} *) + +let path_symm_eq = prove_by_refinement( +`!U x y . (path_component U x (y:A)) <=> (path_component U y (x:A))`, + (* {{{ proof *) + [ + MESON_TAC[path_symm]; + ]);; + (* }}} *) + + +let path_trans = prove_by_refinement( + `!U x y (z:A). (path_component U x y) /\ (path_component U y z) ==> + (path_component U x z)`, + (* {{{ proof *) + + [ + REWRITE_TAC[path_component]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + CHO 0; + CHO 1; + CHO 1; + CHO 1; + TYPE_THEN `joinf f (f' o ((+.) (a' -. b))) b` EXISTS_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b' +. (b - a')` EXISTS_TAC; + CONJ_TAC; (* start of continuity *) + IMATCH_MP_TAC joinf_cont; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC continuous_comp; + TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC; + ASM_REWRITE_TAC [top_of_metric_top; metric_real; metric_euclidean; metric_euclid; metric_hausdorff; GSYM top_of_metric_unions; open_ball_open;]; + REWRITE_TAC[add_cont]; + ASM_SIMP_TAC [top_of_metric_top; metric_real; metric_euclidean; metric_euclid; metric_hausdorff; GSYM top_of_metric_unions; open_ball_open;]; + REWRITE_TAC[SUBSET;UNIV;IN;IN_ELIM_THM']; + REWRITE_TAC[o_DEF]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; (* end of continuity *) + CONJ_TAC; (* start real ineq *) + AND 1; + AND 1; + AND 0; + AND 0; + UND 5; + UND 3; + REAL_ARITH_TAC; (* end of real ineq *) + CONJ_TAC; + REWRITE_TAC[joinf;o_DEF]; + ASM_REWRITE_TAC[]; (* end of JOIN statement *) + CONJ_TAC; (* next JOIN statement *) + REWRITE_TAC[joinf;o_DEF]; + TYPE_THEN `~(b' +. b -. a' <. b)` SUBGOAL_TAC; + TYPE_THEN `(a' <. b') /\ (a <. b)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + TYPE_THEN ` a' -. b +. b' +. b -. a' = b'` SUBGOAL_TAC; + REAL_ARITH_TAC ; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + ASM_REWRITE_TAC[]; (* end of next joinf *) + TYPE_THEN `(a <=. b) /\ (b <=. (b' + b - a'))` SUBGOAL_TAC; (* subreal *) + TYPE_THEN `(a' <. b') /\ (a <. b)` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_TAC; (* end of subreal *) + USE 2 (MATCH_MP union_closed_interval); + UND 2; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + REWRITE_TAC[IMAGE_UNION;union_subset]; + CONJ_TAC; (* start of FIRST interval *) + TYPE_THEN `IMAGE (joinf f (f' o (+.) (a' -. b)) b) {t | a <=. t /\ t <. b} = IMAGE f {t | a <=. t /\ t <. b}` SUBGOAL_TAC; + REWRITE_TAC[joinf;IMAGE;IN_IMAGE ]; + IMATCH_MP_TAC EQ_EXT; + X_GEN_TAC `t:A`; + REWRITE_TAC[IN_ELIM_THM']; + EQ_TAC; + DISCH_ALL_TAC; + CHO 2; + UND 2; + DISCH_ALL_TAC; + REWR 4; + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + CHO 2; + UND 2; + DISCH_ALL_TAC; + TYPE_THEN `x'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun t-> REWRITE_TAC[t]); (* FIRST interval still *) + TYPE_THEN `IMAGE f {t | a <=. t /\ t <. b} SUBSET IMAGE f {t | a <=. t /\ t <=. b} ` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE ;IN_ELIM_THM']; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + MESON_TAC[REAL_ARITH `a <. b ==> a<=. b`]; + KILL 1; + UND 0; + DISCH_ALL_TAC; + JOIN 0 5; + USE 0 (MATCH_MP SUBSET_TRANS ); + ASM_REWRITE_TAC[]; (* end of FIRST interval *) + (* lc 1*) + TYPE_THEN `IMAGE (joinf f (f' o (+.) (a' -. b)) b) {t | b <=. t /\ t <=. b' + b -. a'} = IMAGE f' {t | a' <=. t /\ t <=. b'}` SUBGOAL_TAC; + REWRITE_TAC[joinf;IMAGE;IN_IMAGE ]; + IMATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM']; + NAME_CONFLICT_TAC ; + X_GEN_TAC `t:A`; + EQ_TAC; + DISCH_ALL_TAC; + CHO 2; + UND 2; + DISCH_ALL_TAC; + TYPE_THEN `~(x' <. b)` SUBGOAL_TAC; + UND 2; + REAL_ARITH_TAC ; + DISCH_TAC ; + REWR 4; + USE 4 (REWRITE_RULE[o_DEF]); + TYPE_THEN `a' -. b +. x'` EXISTS_TAC; (* * *) + ASM_REWRITE_TAC[]; + TYPE_THEN `(a' <. b') /\ (a <. b) /\ (b <=. x') /\ (x' <=. b' +. b -. a')` SUBGOAL_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + CHO 2; + UND 2; + DISCH_ALL_TAC; + TYPE_THEN `x' +. b -. a'` EXISTS_TAC; + ASM_REWRITE_TAC[]; + SUBCONJ_TAC; + UND 2; + UND 3; + REAL_ARITH_TAC; + DISCH_ALL_TAC; + TYPE_THEN `~(x' +. b -. a' <. b)` SUBGOAL_TAC; + UND 5; + REAL_ARITH_TAC ; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[o_DEF]; + AP_TERM_TAC; + REAL_ARITH_TAC ; + DISCH_THEN (fun t -> REWRITE_TAC [t]); + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let loc_path_conn = euclid_def `loc_path_conn U <=> + !A x. (U A) /\ (A (x:A)) ==> + (U (path_component (induced_top U A) x))`;; + + +let path_eq_conn = prove_by_refinement( + `!U (x:A). (loc_path_conn U) /\ (topology_ U) ==> + (path_component U x = component U x)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + MATCH_MP_TAC EQ_EXT; + X_GEN_TAC `y:A`; + EQ_TAC ; + REWRITE_TAC[path_component]; + DISCH_ALL_TAC; + CHO 2; + CHO 2; + CHO 2; + UND 2 THEN DISCH_ALL_TAC; + REWRITE_TAC[component_DEF]; + TYPE_THEN `IMAGE f {t | a <= t /\ t <= b}` EXISTS_TAC; + CONJ_TAC; + IMATCH_MP_TAC connect_image ; + NAME_CONFLICT_TAC; + TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC ; + ASM_REWRITE_TAC[connect_real ]; + REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ]; + CONJ_TAC; + TYPE_THEN `a` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC ; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 3; + REAL_ARITH_TAC; + REWRITE_TAC[component_DEF]; + DISCH_ALL_TAC; + CHO 2; + UND 2 THEN DISCH_ALL_TAC; + USE 2 (REWRITE_RULE[connected]); + UND 2 THEN DISCH_ALL_TAC; + TYPE_THEN `path_component U x` (USE 5 o SPEC); + TYPE_THEN `A = path_component U x` ABBREV_TAC; + TYPE_THEN `B = UNIONS (IMAGE (\z. (path_component U z)) (Z DIFF A))` ABBREV_TAC ; + TYPE_THEN `B` (USE 5 o SPEC); + TYPE_THEN `U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B` SUBGOAL_TAC; + WITH 0 (REWRITE_RULE[loc_path_conn]); + TYPE_THEN `(UNIONS U)` (USE 8 o SPEC); + TYPE_THEN `x` (USE 8 o SPEC); + UND 8; + ASM_SIMP_TAC[induced_top_unions]; + ASM_SIMP_TAC[top_univ]; + TYPE_THEN `UNIONS U x` SUBGOAL_TAC; + USE 2 (REWRITE_RULE[SUBSET;IN;]); + ASM_MESON_TAC[]; + DISCH_ALL_TAC; + REWR 8; + ASM_REWRITE_TAC[]; + (* dd *) + CONJ_TAC; + EXPAND_TAC "B"; + WITH 1 (REWRITE_RULE[topology]); + TYPEL_THEN [`EMPTY:A->bool`;`EMPTY:A->bool`;`(IMAGE (\z. path_component U z) (Z DIFF A))`] (USE 10 o ISPECL); + UND 10 THEN DISCH_ALL_TAC; + UND 12 THEN (DISCH_THEN IMATCH_MP_TAC ); + REWRITE_TAC[SUBSET;IN_IMAGE]; + REWRITE_TAC[IN]; + NAME_CONFLICT_TAC; + DISCH_ALL_TAC; + CHO 12; + ASM_REWRITE_TAC[]; + USE 0 (REWRITE_RULE[loc_path_conn]); + TYPE_THEN `(UNIONS U)` (USE 0 o SPEC); + USE 0 ( CONV_RULE NAME_CONFLICT_CONV); + TYPE_THEN `x'` (USE 0 o SPEC); + UND 0; + ASM_SIMP_TAC[induced_top_unions]; + DISCH_THEN MATCH_MP_TAC; + ASM_SIMP_TAC[top_univ]; + AND 12; + USE 2 (REWRITE_RULE[SUBSET;IN]); + USE 0 (REWRITE_RULE[DIFF;IN;IN_ELIM_THM' ]); + ASM_MESON_TAC[]; + CONJ_TAC; + REWRITE_TAC[EQ_EMPTY]; + DISCH_ALL_TAC; + USE 10 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]); + AND 10; + UND 10; + EXPAND_TAC "B"; + REWRITE_TAC[UNIONS;IN_IMAGE ;IN_ELIM_THM' ]; + REWRITE_TAC[IN]; + LEFT_TAC "u"; + DISCH_ALL_TAC; + AND 10; + CHO 12; + AND 12; + REWR 10; + UND 11; + EXPAND_TAC "A"; + USE 10 (ONCE_REWRITE_RULE [path_symm_eq]); + DISCH_TAC; + JOIN 11 10; + USE 10 (MATCH_MP path_trans); + REWR 10; + UND 10; + UND 12; + REWRITE_TAC[DIFF;IN;IN_ELIM_THM']; + MESON_TAC[]; + REWRITE_TAC[SUBSET;IN;UNION;IN_ELIM_THM']; + DISCH_ALL_TAC; + TYPE_THEN `A x'` ASM_CASES_TAC; + ASM_REWRITE_TAC[]; + DISJ2_TAC ; + EXPAND_TAC "B"; + REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM' ]; + REWRITE_TAC[IN]; + LEFT_TAC "x"; + LEFT_TAC "x"; + TYPE_THEN `x'` EXISTS_TAC; + TYPE_THEN `path_component U x'` EXISTS_TAC; + ASM_REWRITE_TAC[DIFF;IN;IN_ELIM_THM' ]; + IMATCH_MP_TAC path_refl; + USE 2 (REWRITE_RULE[SUBSET;IN]); + ASM_MESON_TAC[]; + DISCH_TAC ; + REWR 5; + UND 5; + DISCH_THEN DISJ_CASES_TAC ; + USE 5 (REWRITE_RULE[SUBSET;IN ;]); + ASM_MESON_TAC[]; + UND 8 THEN DISCH_ALL_TAC; + USE 10 (REWRITE_RULE[EQ_EMPTY]); + TYPE_THEN `x` (USE 10 o SPEC); + USE 10 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']); + USE 5 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']); + TYPE_THEN `A x` SUBGOAL_TAC; + EXPAND_TAC "A"; + IMATCH_MP_TAC path_refl ; + USE 2 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + + +let open_ball_star = prove_by_refinement( + `!x r y t n. (open_ball(euclid n,d_euclid) x r y) /\ + (&.0 <=. t) /\ (t <=. &.1) ==> + (open_ball(euclid n,d_euclid) x r ((t *# x + (&.1-t)*#y)))`, + (* {{{ proof *) + + [ + REWRITE_TAC[open_ball;IN_ELIM_THM' ]; + DISCH_ALL_TAC; + ASM_SIMP_TAC[euclid_scale_closure;euclid_add_closure]; + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM trivial_lin_combo]; + ASSUME_TAC (SPEC `n:num` metric_translate_LEFT); + TYPEL_THEN [`(&.1 - t) *# x`;`(&.1 - t)*# y`;`t *# x`] (USE 5 o ISPECL); + UND 5; + ASM_SIMP_TAC [euclid_scale_closure]; + ASM_MESON_TAC[norm_scale_vec;REAL_ARITH `(&.0 <=. t) /\ (t <=. (&.1)) ==> (||. (&.1 - t) <=. &.1)`;REAL_ARITH `(b <= a) ==> ((a < C) ==> (b < C))`;GSYM REAL_MUL_LID;REAL_LE_RMUL;d_euclid_pos]; + ]);; + + (* }}} *) + +let open_ball_path = prove_by_refinement( + `!x r y n. (open_ball(euclid n,d_euclid) x r y) ==> + (path_component + (top_of_metric(open_ball(euclid n,d_euclid) x r,d_euclid)) y x)`, + (* {{{ proof *) + + [ + REWRITE_TAC[path_component ;]; + DISCH_ALL_TAC; + TYPE_THEN `(\t. (t *# x + (&.1 - t) *# y))` EXISTS_TAC; + EXISTS_TAC `&.0`; + EXISTS_TAC `&.1`; + REDUCE_TAC; + TYPE_THEN `top_of_metric (open_ball (euclid n,d_euclid) x r,d_euclid) = (induced_top(top_of_metric(euclid n,d_euclid)) (open_ball (euclid n,d_euclid) x r))` SUBGOAL_TAC; + ASM_MESON_TAC[open_ball_subset;metric_euclid;top_of_metric_induced ]; + DISCH_TAC ; + TYPE_THEN `euclid n x /\ euclid n y` SUBGOAL_TAC; + USE 0 (REWRITE_RULE[open_ball;IN_ELIM_THM' ]); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + CONJ_TAC; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC continuous_induced; + ASM_SIMP_TAC [top_of_metric_top;metric_euclid;open_ball_open]; + IMATCH_MP_TAC continuous_lin_combo ; + ASM_REWRITE_TAC[]; + CONJ_TAC; + REWRITE_TAC[euclid_plus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT THEN BETA_TAC ; + REDUCE_TAC; + CONJ_TAC; + REWRITE_TAC[euclid_plus;euclid_scale]; + IMATCH_MP_TAC EQ_EXT THEN BETA_TAC ; + REDUCE_TAC; + REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM'' ]; + REWRITE_TAC[IN;IN_ELIM_THM']; + TYPE_THEN `(UNIONS (top_of_metric (open_ball (euclid n,d_euclid) x r,d_euclid))) = (open_ball(euclid n,d_euclid) x r)` SUBGOAL_TAC; + IMATCH_MP_TAC (GSYM top_of_metric_unions); + IMATCH_MP_TAC metric_subspace; + ASM_MESON_TAC[metric_euclid;open_ball_subset]; + DISCH_THEN (fun t->REWRITE_TAC[t]); + ASM_MESON_TAC [open_ball_star]; + ]);; + + (* }}} *) + +let path_domain = prove_by_refinement( + `!U x (y:A). path_component U x y <=> + (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (a <. b) /\ + (f a = (x:A)) /\ (f b = y) /\ + (IMAGE f UNIV SUBSET (UNIONS U)))`, + (* {{{ proof *) + + [ + REWRITE_TAC[path_component]; + DISCH_ALL_TAC; + EQ_TAC; + DISCH_TAC ; + CHO 0; + CHO 0; + CHO 0; + TYPE_THEN `joinf (\t. (f a)) (joinf f (\t. (f b)) b) a` EXISTS_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + CONJ_TAC; + IMATCH_MP_TAC joinf_cont; + ASM_SIMP_TAC[const_continuous;top_of_metric_top;metric_real]; + CONJ_TAC; + IMATCH_MP_TAC joinf_cont; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[const_continuous;top_of_metric_top;metric_real]; + REWRITE_TAC[joinf]; + ASM_REWRITE_TAC[]; + CONJ_TAC; + ASM_REWRITE_TAC[joinf;REAL_ARITH `~(a (~(b < a))`)); + ASM_REWRITE_TAC [joinf;REAL_ARITH `~(b < b)`]; + REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM'';joinf ]; + REWRITE_TAC[IN_UNIV]; + GEN_TAC; + UND 0; + DISCH_ALL_TAC; + USE 4 (REWRITE_RULE[SUBSET;IN_IMAGE;Q_ELIM_THM'';]); + USE 4 (REWRITE_RULE[IN;IN_ELIM_THM' ]); + (* cc1 *) + TYPE_THEN `a` (WITH 4 o SPEC); + TYPE_THEN `b` (WITH 4 o SPEC); + TYPE_THEN `x'` (USE 4 o SPEC); + DISJ_CASES_TAC (REAL_ARITH `x' < a \/ (a <= x')`); + ASM_REWRITE_TAC[IN]; + ASM_MESON_TAC[REAL_ARITH `(a <=a) /\ ((a < b) ==> (a <= b))`]; + DISJ_CASES_TAC (REAL_ARITH `x' < b \/ (b <= x')`); + REWR 4; + USE 7 (MATCH_MP (REAL_ARITH `a <= x' ==> (~(x' < a))`)); + ASM_REWRITE_TAC[IN ]; + ASM_MESON_TAC[REAL_ARITH `x' < b ==> x' <= b`]; + USE 7 (MATCH_MP (REAL_ARITH `a <= x' ==> (~(x' < a))`)); + ASM_REWRITE_TAC[]; + USE 8 (MATCH_MP (REAL_ARITH `b <= x' ==> ~(x' < b)`)); + ASM_REWRITE_TAC[IN]; + ASM_MESON_TAC[REAL_ARITH `b <=b /\ ((a < b) ==> (a <= b))`]; + DISCH_TAC ; + CHO 0; + CHO 0; + CHO 0; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `a ` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + UND 0; + REWRITE_TAC[SUBSET;IN_IMAGE ;Q_ELIM_THM'']; + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[IN;IN_ELIM_THM']; + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let path_component_subspace = prove_by_refinement( + `!X Y d (y:A). ((Y SUBSET X) /\ (metric_space(X,d) /\ (Y y))) ==> + ((path_component(top_of_metric(Y,d)) y) SUBSET + (path_component(top_of_metric(X,d)) y))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[SUBSET;IN;path_domain]; + DISCH_ALL_TAC; + CHO 3; + CHO 3; + CHO 3; + TYPE_THEN `f` EXISTS_TAC; + TYPE_THEN `a` EXISTS_TAC; + TYPE_THEN `b` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `metric_space(Y,d)` SUBGOAL_TAC; + ASM_MESON_TAC[metric_subspace]; + DISCH_TAC; + UND 3; + ASM_SIMP_TAC[GSYM top_of_metric_unions]; + DISCH_ALL_TAC; + CONJ_TAC; + UND 3; + TYPE_THEN `IMAGE f UNIV SUBSET X /\ IMAGE f UNIV SUBSET Y` SUBGOAL_TAC; + ASM_MESON_TAC[SUBSET;IN]; + DISCH_TAC; + ASM_SIMP_TAC[metric_continuous_continuous;metric_real]; + REWRITE_TAC[metric_continuous;metric_continuous_pt]; + ASM_MESON_TAC[SUBSET;IN]; + ]);; + (* }}} *) + +let path_component_in = prove_by_refinement( + `!x (y:A) U. (path_component U x y) ==> (UNIONS U y)`, + (* {{{ proof *) + [ + REWRITE_TAC[path_component]; + DISCH_ALL_TAC; + CHO 0; + CHO 0; + CHO 0; + UND 0; + DISCH_ALL_TAC; + USE 4 (REWRITE_RULE[SUBSET;IN_IMAGE;Q_ELIM_THM'']); + USE 4 (REWRITE_RULE[IN_ELIM_THM';IN]); + TYPE_THEN `b` (USE 4 o SPEC); + ASM_MESON_TAC[REAL_ARITH `(a < b) ==> ((a<=. b) /\ (b <= b))`]; + ]);; + (* }}} *) + +let loc_path_conn_euclid = prove_by_refinement( + `!n A. (top_of_metric(euclid n,d_euclid)) A ==> + (loc_path_conn (top_of_metric(A,d_euclid)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[loc_path_conn]; + DISCH_ALL_TAC; + TYPE_THEN `metric_space (A,d_euclid)` SUBGOAL_TAC; + IMATCH_MP_TAC metric_subspace; + TYPE_THEN `euclid n` EXISTS_TAC; + REWRITE_TAC[metric_euclid]; + USE 0 (MATCH_MP sub_union); + ASM_MESON_TAC[top_of_metric_unions;metric_euclid]; + DISCH_ALL_TAC; + WITH 3 (MATCH_MP top_of_metric_nbd); + UND 4; + DISCH_THEN (fun t-> REWRITE_TAC[t]); + TYPE_THEN `A' SUBSET A` SUBGOAL_TAC; + USE 1 (MATCH_MP sub_union); + ASM_MESON_TAC[top_of_metric_unions]; + DISCH_TAC; + ASM_SIMP_TAC[top_of_metric_induced]; + TYPE_THEN `metric_space(A',d_euclid)` SUBGOAL_TAC; + ASM_MESON_TAC[metric_subspace]; + DISCH_TAC ; + SUBCONJ_TAC; + REWRITE_TAC[SUBSET;IN]; + REWRITE_TAC[path_component]; + DISCH_ALL_TAC; + CHO 6; + CHO 6; + CHO 6; + USE 6 (REWRITE_RULE[SUBSET;IN_IMAGE ;IN_ELIM_THM';Q_ELIM_THM'']); + UND 6; + DISCH_ALL_TAC; + TYPE_THEN `b` (USE 10 o SPEC); + USE 4 (REWRITE_RULE[SUBSET;IN]); + UND 4; + DISCH_THEN IMATCH_MP_TAC ; + USE 5 (MATCH_MP top_of_metric_unions); + UND 10; + UND 4; + DISCH_THEN (fun t -> ONCE_REWRITE_TAC[GSYM t]); + ASM_REWRITE_TAC[IN]; + ASM_MESON_TAC[REAL_ARITH `b <=. b /\ ((a < b)==> (a <=. b))`]; + DISCH_TAC; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + (* c2 *) + WITH 7 (MATCH_MP path_component_in); + TYPE_THEN `A' a` SUBGOAL_TAC; + UND 8; + ASM_SIMP_TAC[GSYM top_of_metric_unions;]; + DISCH_TAC; + TYPE_THEN `A SUBSET (euclid n)` SUBGOAL_TAC; + USE 0 (MATCH_MP sub_union); + UND 0; + ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid]; + DISCH_TAC; + TYPE_THEN `top_of_metric(euclid n,d_euclid) A'` SUBGOAL_TAC; + IMATCH_MP_TAC induced_trans; + TYPE_THEN `A` EXISTS_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[top_of_metric_top;metric_euclid;top_of_metric_induced ]; + DISCH_TAC; + COPY 11; + UND 12; + SIMP_TAC[top_of_metric_nbd;metric_euclid]; + DISCH_ALL_TAC; + TYPE_THEN `a` (USE 13 o SPEC); + USE 13 (REWRITE_RULE[IN]); + REWR 13; + CHO 13; + TYPE_THEN `r` EXISTS_TAC; + ASM_REWRITE_TAC[]; + TYPE_THEN `open_ball (A,d_euclid) a r SUBSET path_component (top_of_metric (A',d_euclid)) a` SUBGOAL_TAC ; + TYPE_THEN `open_ball (euclid n,d_euclid) a r SUBSET path_component (top_of_metric (A',d_euclid)) a` SUBGOAL_TAC ; + TYPE_THEN `open_ball (euclid n,d_euclid) a r SUBSET path_component (top_of_metric ((open_ball(euclid n,d_euclid) a r),d_euclid)) a` SUBGOAL_TAC; + REWRITE_TAC[SUBSET;IN]; + MESON_TAC[open_ball_path;SUBSET;IN;path_symm]; + IMATCH_MP_TAC (prove_by_refinement(`!A B C. (B:A->bool) SUBSET C ==> (A SUBSET B ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]])); + IMATCH_MP_TAC path_component_subspace; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC (REWRITE_RULE[IN] open_ball_nonempty); + ASM_SIMP_TAC[metric_euclid]; + ASM_MESON_TAC[SUBSET;IN]; + IMATCH_MP_TAC (prove_by_refinement (`!A B C. (A:A->bool) SUBSET B ==> (B SUBSET C ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]])); + ASM_SIMP_TAC[open_ball_subspace]; + IMATCH_MP_TAC (prove_by_refinement(`!A B C. (B:A->bool) SUBSET C ==> (A SUBSET B ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]])); + REWRITE_TAC[SUBSET;IN]; + GEN_TAC; + UND 7; + MESON_TAC[path_trans]; + ]);; + (* }}} *) + +let loc_path_euclid_cor = prove_by_refinement( + `!n A . (top_of_metric(euclid n,d_euclid)) A ==> + (path_component (top_of_metric(A,d_euclid)) = + component (top_of_metric(A,d_euclid)))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + WITH 0 (MATCH_MP loc_path_conn_euclid); + IMATCH_MP_TAC EQ_EXT; + GEN_TAC; + IMATCH_MP_TAC path_eq_conn; + ASM_REWRITE_TAC[]; + IMATCH_MP_TAC top_of_metric_top; + USE 0 (MATCH_MP sub_union); + UND 0; + ASM_SIMP_TAC[GSYM top_of_metric_unions ;metric_euclid]; + ASM_MESON_TAC[metric_subspace;metric_euclid]; + ]);; + (* }}} *) diff --git a/Jordan/misc_defs_and_lemmas.ml b/Jordan/misc_defs_and_lemmas.ml new file mode 100644 index 0000000..af43e93 --- /dev/null +++ b/Jordan/misc_defs_and_lemmas.ml @@ -0,0 +1,2285 @@ + +labels_flag:= true;; + +let dirac_delta = new_definition `dirac_delta (i:num) = + (\j. if (i=j) then (&.1) else (&.0))`;; + +let min_num = new_definition + `min_num (X:num->bool) = @m. (m IN X) /\ (!n. (n IN X) ==> (m <= n))`;; + +let min_least = prove_by_refinement ( + `!(X:num->bool) c. (X c) ==> (X (min_num X) /\ (min_num X <=| c))`, + (* {{{ proof *) + + [ + REWRITE_TAC[min_num;IN]; + REPEAT GEN_TAC; + DISCH_TAC; + SUBGOAL_THEN `?n. (X:num->bool) n /\ (!m. m <| n ==> ~X m)` MP_TAC; + REWRITE_TAC[(GSYM (ISPEC `X:num->bool` num_WOP))]; + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + ASSUME_TAC (select_thm `\m. (X:num->bool) m /\ (!n. X n ==> m <=| n)` `n:num`); + ABBREV_TAC `r = @m. (X:num->bool) m /\ (!n. X n ==> m <=| n)`; + ASM_MESON_TAC[ ARITH_RULE `~(n' < n) ==> (n <=| n') `] + ]);; + + (* }}} *) + +let max_real = new_definition(`max_real x y = + if (y <. x) then x else y`);; + +let min_real = new_definition(`min_real x y = + if (x <. y) then x else y`);; + +let deriv = new_definition(`deriv f x = @d. (f diffl d)(x)`);; +let deriv2 = new_definition(`deriv2 f = (deriv (deriv f))`);; + +let square_le = prove_by_refinement( + `!x y. (&.0 <=. x) /\ (&.0 <=. y) /\ (x*.x <=. y*.y) ==> (x <=. y)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + UNDISCH_FIND_TAC `( *. )` ; + ONCE_REWRITE_TAC[REAL_ARITH `(a <=. b) <=> (&.0 <= (b - a))`]; + REWRITE_TAC[GSYM REAL_DIFFSQ]; + DISCH_TAC; + DISJ_CASES_TAC (REAL_ARITH `&.0 < (y+x) \/ (y+x <=. (&.0))`); + MATCH_MP_TAC (SPEC `(y+x):real` REAL_LE_LCANCEL_IMP); + ASM_REWRITE_TAC [REAL_ARITH `x * (&.0) = (&.0)`]; + CLEAN_ASSUME_TAC (REAL_ARITH `(&.0 <= y) /\ (&.0 <=. x) /\ (y+x <= (&.0)) ==> ((x= &.0) /\ (y= &.0))`); + ASM_REWRITE_TAC[REAL_ARITH `&.0 <=. (&.0 -. (&.0))`]; + ]);; + + (* }}} *) + +let max_num_sequence = prove_by_refinement( + `!(t:num->num). (?n. !m. (n <=| m) ==> (t m = 0)) ==> + (?M. !i. (t i <=| M))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[GSYM LEFT_FORALL_IMP_THM]; + GEN_TAC; + SPEC_TAC (`t:num->num`,`t:num->num`); + SPEC_TAC (`n:num`,`n:num`); + INDUCT_TAC; + GEN_TAC; + REWRITE_TAC[ARITH_RULE `0<=|m`]; + DISCH_TAC; + EXISTS_TAC `0`; + ASM_MESON_TAC[ARITH_RULE`(a=0) ==> (a <=|0)`]; + DISCH_ALL_TAC; + ABBREV_TAC `b = \m. (if (m=n) then 0 else (t (m:num)) )`; + FIRST_ASSUM (fun t-> ASSUME_TAC (SPEC `b:num->num` t)); + SUBGOAL_TAC `((b:num->num) (n) = 0) /\ (!m. ~(m=n) ==> (b m = t m))`; + EXPAND_TAC "b"; + CONJ_TAC; + COND_CASES_TAC; + REWRITE_TAC[]; + ASM_MESON_TAC[]; + GEN_TAC; + COND_CASES_TAC; + REWRITE_TAC[]; + REWRITE_TAC[]; + DISCH_ALL_TAC; + FIRST_ASSUM (fun t-> MP_TAC(SPEC `b:num->num` t)); + SUBGOAL_TAC `!m. (n<=|m) ==> (b m =0)`; + GEN_TAC; + ASM_CASES_TAC `m = (n:num)`; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC ( `(n <=| m) /\ (~(m = n)) ==> (SUC n <=| m)`); + ARITH_TAC; + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + ASM_MESON_TAC[]; (* good *) + DISCH_THEN (fun t-> REWRITE_TAC[t]); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `(M:num) + (t:num->num) n`; + GEN_TAC; + ASM_CASES_TAC `(i:num) = n`; + ASM_REWRITE_TAC[]; + ARITH_TAC; + MATCH_MP_TAC (ARITH_RULE `x <=| M ==> (x <=| M+ u)`); + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let REAL_INV_LT = prove_by_refinement( + `!x y z. (&.0 <. x) ==> ((inv(x)*y < z) <=> (y <. x*z))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_TAC; + REWRITE_TAC[REAL_ARITH `inv x * y = y* inv x`]; + REWRITE_TAC[GSYM real_div]; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let REAL_MUL_NN = prove_by_refinement( + `!x y. (&.0 <= x*y) <=> + ((&.0 <= x /\ (&.0 <=. y)) \/ ((x <= &.0) /\ (y <= &.0) ))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + SUBGOAL_TAC `! x y. ((&.0 < x) ==> ((&.0 <= x*y) <=> ((&.0 <= x /\ (&.0 <=. y)) \/ ((x <= &.0) /\ (y <= &.0) ))))`; + DISCH_ALL_TAC; + ASM_SIMP_TAC[REAL_ARITH `((&.0 <. x) ==> (&.0 <=. x))`;REAL_ARITH `(&.0 <. x) ==> ~(x <=. &.0)`]; + EQ_TAC; + ASM_MESON_TAC[REAL_PROP_NN_LCANCEL]; + ASM_MESON_TAC[REAL_LE_MUL;REAL_LT_IMP_LE]; + DISCH_TAC; + DISJ_CASES_TAC (REAL_ARITH `(&.0 < x) \/ (x = &.0) \/ (x < &.0)`); + ASM_MESON_TAC[]; + UND 1 THEN DISCH_THEN DISJ_CASES_TAC; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ARITH `((x <. &.0) ==> ~(&.0 <=. x))`;REAL_ARITH `(x <. &.0) ==> (x <=. &.0)`]; + USE 0 (SPECL [`--. (x:real)`;`--. (y:real)`]); + UND 0; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_ARITH `((x <. &.0) ==> ~(&.0 <=. x))`;REAL_ARITH `(x <. &.0) ==> (x <=. &.0)`]; + ]);; + (* }}} *) + +let ABS_SQUARE = prove_by_refinement( + `!t u. abs(t) <. u ==> t*t <. u*u`, + (* {{{ proof *) + + [ + REP_GEN_TAC; + CONV_TAC (SUBS_CONV[SPEC `t:real` (REWRITE_RULE[POW_2] (GSYM REAL_POW2_ABS))]); + ASSUME_TAC REAL_ABS_POS; + USE 0 (SPEC `t:real`); + ABBREV_TAC `(b:real) = (abs t)`; + KILL 1; + DISCH_ALL_TAC; + MATCH_MP_TAC REAL_PROP_LT_LRMUL; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let ABS_SQUARE_LE = prove_by_refinement( + `!t u. abs(t) <=. u ==> t*t <=. u*u`, + (* {{{ proof *) + + [ + REP_GEN_TAC; + CONV_TAC (SUBS_CONV[SPEC `t:real` (REWRITE_RULE[POW_2] (GSYM REAL_POW2_ABS))]); + ASSUME_TAC REAL_ABS_POS; + USE 0 (SPEC `t:real`); + ABBREV_TAC `(b:real) = (abs t)`; + KILL 1; + DISCH_ALL_TAC; + MATCH_MP_TAC REAL_PROP_LE_LRMUL; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let twopow_eps = prove_by_refinement( + `!R e. ?n. (&.0 <. R)/\ (&.0 <. e) ==> R*(twopow(--: (&:n))) <. e`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + REWRITE_TAC[TWOPOW_NEG]; (* cs6b *) + ASSUME_TAC (prove(`!n. &.0 < &.2 pow n`,REDUCE_TAC THEN ARITH_TAC)); + ONCE_REWRITE_TAC[REAL_MUL_AC]; + ASM_SIMP_TAC[REAL_INV_LT]; + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]; + CONV_TAC (quant_right_CONV "n"); + DISCH_ALL_TAC; + ASSUME_TAC (SPEC `R/e` REAL_ARCH_SIMPLE); + CHO 3; + EXISTS_TAC `n:num`; + UND 3; + MESON_TAC[POW_2_LT;REAL_LET_TRANS]; + ]);; + + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* finite products, in imitation of finite sums *) +(* ------------------------------------------------------------------ *) + +let prod_EXISTS = prove_by_refinement( + `?prod. (!f n. prod(n,0) f = &1) /\ + (!f m n. prod(n,SUC m) f = prod(n,m) f * f(n + m))`, +(* {{{ proof *) + [ + (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = &1) /\ (!f m n. sm n (SUC m) f = sm n m f * f(n + m))` ; + EXISTS_TAC `\(n,m) f. (sm:num->num->(num->real)->real) n m f`; + CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[] + ]);; +(* }}} *) + +let prod_DEF = new_specification ["prod"] prod_EXISTS;; + +let prod = prove + (`!n m. (prod(n,0) f = &1) /\ + (prod(n,SUC m) f = prod(n,m) f * f(n + m))`, +(* {{{ proof *) + REWRITE_TAC[prod_DEF]);; +(* }}} *) + +let PROD_TWO = prove_by_refinement( + `!f n p. prod(0,n) f * prod(n,p) f = prod(0,n + p) f`, +(* {{{ proof *) + [ + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod; REAL_MUL_RID; MULT_CLAUSES;ADD_0]; + REWRITE_TAC[ARITH_RULE `n+| (SUC p) = (SUC (n+|p))`;prod;ARITH_RULE `0+|n = n`]; + ASM_REWRITE_TAC[REAL_MUL_ASSOC]; +]);; +(* }}} *) + + +let ABS_PROD = prove_by_refinement( + `!f m n. abs(prod(m,n) f) = prod(m,n) (\n. abs(f n))`, +(* {{{ proof *) + [ + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC; + REWRITE_TAC[prod]; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[prod;ABS_MUL] + ]);; +(* }}} *) + +let PROD_EQ = prove_by_refinement + (`!f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r))) + ==> (prod(m,n) f = prod(m,n) g)`, +(* {{{ proof *) + + [ + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod]; + REWRITE_TAC[prod]; + DISCH_THEN (fun th -> MP_TAC th THEN (MP_TAC (SPEC `m+|n` th))); + REWRITE_TAC[ARITH_RULE `(m<=| (m+|n))/\ (m +| n <| (SUC n +| m))`]; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + AP_THM_TAC THEN AP_TERM_TAC; + FIRST_X_ASSUM MATCH_MP_TAC; + GEN_TAC THEN DISCH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[ARITH_RULE `r <| (n+| m) ==> (r <| (SUC n +| m))`] + ]);; + +(* }}} *) + +let PROD_POS = prove_by_refinement + (`!f. (!n. &0 <= f(n)) ==> !m n. &0 <= prod(m,n) f`, +(* {{{ proof *) + + [ + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod]; + REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_LE_MUL] + ]);; +(* }}} *) + +let PROD_POS_GEN = prove_by_refinement + (`!f m n. + (!n. m <= n ==> &0 <= f(n)) + ==> &0 <= prod(m,n) f`, +(* {{{ proof *) + + [ + REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[prod]; + REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_LE_MUL;ARITH_RULE `m <=| (m +| n)`] + ]);; +(* }}} *) + + +let PROD_ABS = prove + (`!f m n. abs(prod(m,n) (\m. abs(f m))) = prod(m,n) (\m. abs(f m))`, +(* {{{ proof *) + REWRITE_TAC[ABS_PROD;REAL_ARITH `||. (||. x) = (||. x)`]);; +(* }}} *) + +let PROD_ZERO = prove_by_refinement + (`!f m n. (?p. (m <= p /\ (p < (n+| m)) /\ (f p = (&.0)))) ==> + (prod(m,n) f = &0)`, +(* {{{ proof *) + [ + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN (REWRITE_TAC[prod]); + ARITH_TAC; + DISCH_THEN CHOOSE_TAC; + ASM_CASES_TAC `p <| (n+| m)`; + MATCH_MP_TAC (prove (`(x = (&.0)) ==> (x *. y = (&.0))`,(DISCH_THEN (fun th -> (REWRITE_TAC[th]))) THEN REAL_ARITH_TAC)); + FIRST_X_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[]; + POP_ASSUM (fun th -> ASSUME_TAC (MATCH_MP (ARITH_RULE `(~(p <| (n+|m)) ==> ((p <| ((SUC n) +| m)) ==> (p = ((m +| n)))))`) th)); + MATCH_MP_TAC (prove (`(x = (&.0)) ==> (y *. x = (&.0))`,(DISCH_THEN (fun th -> (REWRITE_TAC[th]))) THEN REAL_ARITH_TAC)); + ASM_MESON_TAC[] + ]);; +(* }}} *) + +let PROD_MUL = prove_by_refinement( + `!f g m n. prod(m,n) (\n. f(n) * g(n)) = prod(m,n) f * prod(m,n) g`, + (* {{{ proof *) + [ + EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[prod]; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_AC]; + ]);; + (* }}} *) + +let PROD_CMUL = prove_by_refinement( + `!f c m n. prod(m,n) (\n. c * f(n)) = (c **. n) * prod(m,n) f`, + (* {{{ proof *) + [ + EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[prod;pow]; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_AC]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* LEMMAS ABOUT SETS *) +(* ------------------------------------------------------------------ *) + +(* IN_ELIM_THM produces garbled results at times. I like this better: *) + +(*** JRH replaced this with the "new" IN_ELIM_THM; see how it works. + +let IN_ELIM_THM' = prove_by_refinement( + `(!P. !x:A. x IN (GSPEC P) <=> P x) /\ + (!P. !x:A. x IN (\x. P x) <=> P x) /\ + (!P. !x:A. (GSPEC P) x <=> P x) /\ + (!P (x:A) (t:A). (\t. (?y:A. P y /\ (t = y))) x <=> P x)`, + (* {{{ proof *) + [ + REWRITE_TAC[IN; GSPEC]; + MESON_TAC[]; + ]);; + (* }}} *) + + ****) + +let IN_ELIM_THM' = IN_ELIM_THM;; + +let SURJ_IMAGE = prove_by_refinement( + `!(f:A->B) a b. SURJ f a b ==> (b = (IMAGE f a))`, +(* {{{ proof *) + + [ + REPEAT GEN_TAC; + REWRITE_TAC[SURJ;IMAGE]; + DISCH_ALL_TAC; + REWRITE_TAC[EXTENSION]; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM]; + ASM_MESON_TAC[]] + +(* }}} *) +);; + + +let SURJ_FINITE = prove_by_refinement( + `!a b (f:A->B). FINITE a /\ (SURJ f a b) ==> FINITE b`, +(* {{{ *) + + [ + ASM_MESON_TAC[SURJ_IMAGE;FINITE_IMAGE] + ]);; + +(* }}} *) + +let BIJ_INVERSE = prove_by_refinement( + `!a b (f:A->B). (SURJ f a b) ==> (?(g:B->A). (INJ g b a))`, +(* {{{ proof *) + + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + SUBGOAL_THEN `!y. ?u. ((y IN b) ==> ((u IN a) /\ ((f:A->B) u = y)))` ASSUME_TAC; + ASM_MESON_TAC[SURJ]; + LABEL_ALL_TAC; + H_REWRITE_RULE[THM SKOLEM_THM] (HYP "1"); + LABEL_ALL_TAC; + H_UNDISCH_TAC (HYP"2"); + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `u:B->A`; + REWRITE_TAC[INJ] THEN CONJ_TAC THEN (ASM_MESON_TAC[]) + ] + +(* }}} *) +);; + +(* complement of an intersection is a union of complements *) +let UNIONS_INTERS = prove_by_refinement( + `!(X:A->bool) V. + (X DIFF (INTERS V) = UNIONS (IMAGE ((DIFF) X) V))`, +(* {{{ proof *) + + [ + REPEAT GEN_TAC; + MATCH_MP_TAC SUBSET_ANTISYM; + CONJ_TAC; + REWRITE_TAC[SUBSET;IMAGE;IN_ELIM_THM]; + X_GEN_TAC `c:A`; + REWRITE_TAC[IN_DIFF;IN_INTERS;IN_UNIONS;NOT_FORALL_THM]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; + EXISTS_TAC `(X DIFF t):A->bool`; + REWRITE_TAC[IN_ELIM_THM]; + CONJ_TAC; + EXISTS_TAC `t:A->bool`; + ASM_MESON_TAC[]; + REWRITE_TAC[IN_DIFF]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET;IMAGE;IN_ELIM_THM]; + X_GEN_TAC `c:A`; + REWRITE_TAC[IN_DIFF;IN_UNIONS]; + DISCH_THEN CHOOSE_TAC; + UNDISCH_FIND_TAC `(IN)`; + REWRITE_TAC[IN_INTERS;IN_ELIM_THM]; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; + CONJ_TAC; + ASM_MESON_TAC[SUBSET_DIFF;SUBSET]; + REWRITE_TAC[NOT_FORALL_THM]; + EXISTS_TAC `x:A->bool`; + ASM_MESON_TAC[IN_DIFF]; + ]);; + +(* }}} *) + +let INTERS_SUBSET = prove_by_refinement ( + `!X (A:A->bool). (A IN X) ==> (INTERS X SUBSET A)`, +(* {{{ *) + [ + REPEAT GEN_TAC; + REWRITE_TAC[SUBSET;IN_INTERS]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let sub_union = prove_by_refinement( + `!X (U:(A->bool)->bool). (U X) ==> (X SUBSET (UNIONS U))`, +(* {{{ *) + [ + DISCH_ALL_TAC; + REWRITE_TAC[SUBSET;IN_ELIM_THM;UNIONS]; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + EXISTS_TAC `X:A->bool`; + ASM_REWRITE_TAC[]; + ]);; +(* }}} *) + +let IMAGE_SURJ = prove_by_refinement( + `!(f:A->B) a. SURJ f a (IMAGE f a)`, +(* {{{ *) + [ + REWRITE_TAC[SURJ;IMAGE;IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let SUBSET_PREIMAGE = prove_by_refinement( + `!(f:A->B) X Y. (Y SUBSET (IMAGE f X)) ==> + (?Z. (Z SUBSET X) /\ (Y = IMAGE f Z))`, +(* {{{ proof *) + [ + DISCH_ALL_TAC; + EXISTS_TAC `{x | (x IN (X:A->bool))/\ (f x IN (Y:B->bool)) }`; + CONJ_TAC; + REWRITE_TAC[SUBSET;IN_ELIM_THM]; + MESON_TAC[]; + REWRITE_TAC[EXTENSION]; + X_GEN_TAC `y:B`; + UNDISCH_FIND_TAC `(SUBSET)`; + REWRITE_TAC[SUBSET;IN_IMAGE]; + REWRITE_TAC[IN_ELIM_THM]; + DISCH_THEN (fun t-> MP_TAC (SPEC `y:B` t)); + MESON_TAC[]; + ]);; +(* }}} *) + +let UNIONS_INTER = prove_by_refinement( + `!(U:(A->bool)->bool) A. (((UNIONS U) INTER A) = + (UNIONS (IMAGE ((INTER) A) U)))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + MATCH_MP_TAC (prove(`((C SUBSET (B:A->bool)) /\ (C SUBSET A) /\ ((A INTER B) SUBSET C)) ==> ((B INTER A) = C)`,SET_TAC[])); + CONJ_TAC; + REWRITE_TAC[SUBSET;UNIONS;IN_ELIM_THM]; + REWRITE_TAC[IN_IMAGE]; + SET_TAC[]; + REWRITE_TAC[SUBSET;UNIONS;IN_IMAGE]; + CONJ_TAC; + REWRITE_TAC[IN_ELIM_THM]; + X_GEN_TAC `y:A`; + DISCH_THEN CHOOSE_TAC; + ASM_MESON_TAC[IN_INTER]; + REWRITE_TAC[IN_INTER]; + REWRITE_TAC[IN_ELIM_THM]; + X_GEN_TAC `y:A`; + DISCH_ALL_TAC; + UNDISCH_FIND_THEN `(?)` CHOOSE_TAC; + EXISTS_TAC `A INTER (u:A->bool)`; + ASM SET_TAC[]; + ]);; +(* }}} *) + +let UNIONS_SUBSET = prove_by_refinement( + `!U (X:A->bool). (!A. (A IN U) ==> (A SUBSET X)) ==> (UNIONS U SUBSET X)`, +(* {{{ *) + [ + REPEAT GEN_TAC; + SET_TAC[]; + ]);; +(* }}} *) + +let SUBSET_INTER = prove_by_refinement( + `!X A (B:A->bool). (X SUBSET (A INTER B)) <=> (X SUBSET A) /\ (X SUBSET B)`, +(* {{{ *) + [ + REWRITE_TAC[SUBSET;INTER;IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + +let EMPTY_EXISTS = prove_by_refinement( + `!X. ~(X = {}) <=> (? (u:A). (u IN X))`, +(* {{{ *) + [ + REWRITE_TAC[EXTENSION]; + REWRITE_TAC[IN;EMPTY]; + MESON_TAC[]; + ]);; +(* }}} *) + +let UNIONS_UNIONS = prove_by_refinement( + `!A B. (A SUBSET B) ==>(UNIONS (A:(A->bool)->bool) SUBSET (UNIONS B))`, +(* {{{ *) + [ + REWRITE_TAC[SUBSET;UNIONS;IN_ELIM_THM]; + MESON_TAC[IN]; + ]);; +(* }}} *) + + +(* nested union can flatten from outside in, or inside out *) +let UNIONS_IMAGE_UNIONS = prove_by_refinement( + `!(X:((A->bool)->bool)->bool). + UNIONS (UNIONS X) = (UNIONS (IMAGE UNIONS X))`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[EXTENSION;IN_UNIONS]; + GEN_TAC; + REWRITE_TAC[EXTENSION;IN_UNIONS]; + EQ_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + FIRST_ASSUM MP_TAC; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `UNIONS (t':(A->bool)->bool)`; + REWRITE_TAC[IN_UNIONS;IN_IMAGE]; + CONJ_TAC; + EXISTS_TAC `(t':(A->bool)->bool)`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + FIRST_ASSUM MP_TAC; + REWRITE_TAC[IN_IMAGE]; + DISCH_ALL_TAC; + FIRST_ASSUM MP_TAC; + DISCH_THEN CHOOSE_TAC; + UNDISCH_TAC `(x:A) IN t`; + FIRST_ASSUM (fun t-> REWRITE_TAC[t]); + REWRITE_TAC[IN_UNIONS]; + DISCH_THEN (CHOOSE_TAC); + EXISTS_TAC `t':(A->bool)`; + CONJ_TAC; + EXISTS_TAC `x':(A->bool)->bool`; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ]);; +(* }}} *) + + +let INTERS_SUBSET2 = prove_by_refinement( + `!X A. (?(x:A->bool). (A x /\ (x SUBSET X))) ==> ((INTERS A) SUBSET X)`, + (* {{{ proof *) + [ + REWRITE_TAC[SUBSET;INTERS;IN_ELIM_THM']; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + (* }}} *) + +(**** New proof by JRH; old one breaks because of new set comprehensions + +let INTERS_EMPTY = prove_by_refinement( + `INTERS EMPTY = (UNIV:A->bool)`, + (* {{{ proof *) + [ + REWRITE_TAC[INTERS;NOT_IN_EMPTY;IN_ELIM_THM';]; + REWRITE_TAC[UNIV;GSPEC]; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + MESON_TAC[]; + ]);; + (* }}} *) + + ****) + +let INTERS_EMPTY = prove_by_refinement( + `INTERS EMPTY = (UNIV:A->bool)`, + [SET_TAC[]]);; + +let preimage = new_definition `preimage dom (f:A->B) + Z = {x | (x IN dom) /\ (f x IN Z)}`;; + +let in_preimage = prove_by_refinement( + `!f x Z dom. x IN (preimage dom (f:A->B) Z) <=> (x IN dom) /\ (f x IN Z)`, +(* {{{ *) + [ + REWRITE_TAC[preimage]; + REWRITE_TAC[IN_ELIM_THM'] + ]);; +(* }}} *) + +(* Partial functions, which we identify with functions that + take the canonical choice of element outside the domain. *) + +let supp = new_definition + `supp (f:A->B) = \ x. ~(f x = (CHOICE (UNIV:B ->bool)) )`;; + +let func = new_definition + `func a b = (\ (f:A->B). ((!x. (x IN a) ==> (f x IN b)) /\ + ((supp f) SUBSET a))) `;; + + +(* relations *) +let reflexive = new_definition + `reflexive (f:A->A->bool) <=> (!x. f x x)`;; + +let symmetric = new_definition + `symmetric (f:A->A->bool) <=> (!x y. f x y ==> f y x)`;; + +let transitive = new_definition + `transitive (f:A->A->bool) <=> (!x y z. f x y /\ f y z ==> f x z)`;; + +let equivalence_relation = new_definition + `equivalence_relation (f:A->A->bool) <=> + (reflexive f) /\ (symmetric f) /\ (transitive f)`;; + +(* We do not introduce the equivalence class of f explicitly, because + it is represented directly in HOL by (f a) *) + +let partition_DEF = new_definition + `partition (A:A->bool) SA <=> (UNIONS SA = A) /\ + (!a b. ((a IN SA) /\ (b IN SA) /\ (~(a = b)) ==> ({} = (a INTER b))))`;; + +let DIFF_DIFF2 = prove_by_refinement( + `!X (A:A->bool). (A SUBSET X) ==> ((X DIFF (X DIFF A)) = A)`, + [ + SET_TAC[] + ]);; + +(*** Old proof replaced by JRH: no longer UNWIND_THM[12] clause in IN_ELIM_THM + +let GSPEC_THM = prove_by_refinement( + `!P (x:A). (?y. P y /\ (x = y)) <=> P x`, + [REWRITE_TAC[IN_ELIM_THM]]);; + +***) + +let GSPEC_THM = prove_by_refinement( + `!P (x:A). (?y. P y /\ (x = y)) <=> P x`, + [MESON_TAC[]]);; + +let CARD_GE_REFL = prove + (`!s:A->bool. s >=_c s`, + GEN_TAC THEN REWRITE_TAC[GE_C] THEN + EXISTS_TAC `\x:A. x` THEN MESON_TAC[]);; + +let FINITE_HAS_SIZE_LEMMA = prove + (`!s:A->bool. FINITE s ==> ?n:num. {x | x < n} >=_c s`, + MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[NOT_IN_EMPTY; GE_C; IN_ELIM_THM]; + REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `SUC N` THEN POP_ASSUM MP_TAC THEN PURE_REWRITE_TAC[GE_C] THEN + DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN + EXISTS_TAC `\n:num. if n = N then x:A else f n` THEN + X_GEN_TAC `y:A` THEN PURE_REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (ANTE_RES_THEN MP_TAC)) THENL + [EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `n:num < N` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[LT_REFL] THEN ARITH_TAC]]);; + +let NUM_COUNTABLE = prove_by_refinement( + `COUNTABLE (UNIV:num->bool)`, + (* {{{ proof *) + + [ + REWRITE_TAC[COUNTABLE;CARD_GE_REFL]; + ]);; + + (* }}} *) + +let NUM2_COUNTABLE = prove_by_refinement( + `COUNTABLE {((x:num),(y:num)) | T}`, + (* {{{ proof *) + [ + CHOOSE_TAC (ISPECL[`(0,0)`;`(\ (a:num,b:num) (n:num) . if (b=0) then (0,a+b+1) else (a+1,b-1))`] num_RECURSION); + REWRITE_TAC[COUNTABLE;GE_C;IN_ELIM_THM']; + NAME_CONFLICT_TAC; + EXISTS_TAC `fn:num -> (num#num)`; + X_GEN_TAC `p:num#num`; + REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC)); + DISCH_THEN (fun t->REWRITE_TAC[t]); + REWRITE_TAC[IN_UNIV]; + SUBGOAL_TAC `?t. t = x'+|y'`; + MESON_TAC[]; + SPEC_TAC (`x':num`,`a:num`); + SPEC_TAC (`y':num`,`b:num`); + CONV_TAC (quant_left_CONV "t"); + CONV_TAC (quant_left_CONV "t"); + CONV_TAC (quant_left_CONV "t"); + INDUCT_TAC; + REDUCE_TAC; + REP_GEN_TAC; + DISCH_THEN (fun t -> REWRITE_TAC[t]); + EXISTS_TAC `0`; + ASM_REWRITE_TAC[]; + CONV_TAC (quant_left_CONV "a"); + INDUCT_TAC; + REDUCE_TAC; + GEN_TAC; + USE 1 (SPECL [`0`;`t:num`]); + UND 1 THEN REDUCE_TAC; + DISCH_THEN (X_CHOOSE_TAC `n:num`); + AND 0; + USE 0 (SPEC `n:num`); + UND 0; + UND 1; + DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]); + CONV_TAC (ONCE_DEPTH_CONV GEN_BETA_CONV); + BETA_TAC; + REDUCE_TAC; + DISCH_ALL_TAC; + EXISTS_TAC `SUC n`; + EXPAND_TAC "b"; + KILL 0; + ASM_REWRITE_TAC[]; + REWRITE_TAC [ARITH_RULE `SUC t = t+|1`]; + GEN_TAC; + ABBREV_TAC `t' = SUC t`; + USE 2 (SPEC `SUC b`); + DISCH_TAC; + UND 2; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ARITH_RULE `SUC a +| b = a +| SUC b`]; + DISCH_THEN (X_CHOOSE_TAC `n:num`); + EXISTS_TAC `SUC n`; + AND 0; + USE 0 (SPEC `n:num`); + UND 0; + UND 2; + DISCH_THEN (fun t->REWRITE_TAC[GSYM t]); + CONV_TAC (ONCE_DEPTH_CONV GEN_BETA_CONV); + BETA_TAC; + REDUCE_TAC; + DISCH_THEN (fun t->REWRITE_TAC[t]); + REWRITE_TAC[ARITH_RULE `SUC a = a+| 1`]; + ]);; + (* }}} *) + +let COUNTABLE_UNIONS = prove_by_refinement( + `!A:(A->bool)->bool. (COUNTABLE A) /\ + (!a. (a IN A) ==> (COUNTABLE a)) ==> (COUNTABLE (UNIONS A))`, + (* {{{ proof *) + [ + GEN_TAC; + DISCH_ALL_TAC; + USE 0 (REWRITE_RULE[COUNTABLE;GE_C;IN_UNIV]); + CHO 0; + USE 0 (CONV_RULE (quant_left_CONV "x")); + USE 0 (CONV_RULE (quant_left_CONV "x")); + CHO 0; + USE 1 (REWRITE_RULE[COUNTABLE;GE_C;IN_UNIV]); + USE 1 (CONV_RULE (quant_left_CONV "f")); + USE 1 (CONV_RULE (quant_left_CONV "f")); + UND 1; + DISCH_THEN (X_CHOOSE_TAC `g:(A->bool)->num->A`); + SUBGOAL_TAC `!a y. (a IN (A:(A->bool)->bool)) /\ (y IN a) ==> (? (u:num) (v:num). ( a = f u) /\ (y = g a v))`; + REP_GEN_TAC; + DISCH_ALL_TAC; + USE 1 (SPEC `a:A->bool`); + USE 0 (SPEC `a:A->bool`); + EXISTS_TAC `(x:(A->bool)->num) a`; + ASM_SIMP_TAC[]; + ASSUME_TAC NUM2_COUNTABLE; + USE 2 (REWRITE_RULE[COUNTABLE;GE_C;IN_ELIM_THM';IN_UNIV]); + USE 2 (CONV_RULE NAME_CONFLICT_CONV); + UND 2 THEN (DISCH_THEN (X_CHOOSE_TAC `h:num->(num#num)`)); + DISCH_TAC; + REWRITE_TAC[COUNTABLE;GE_C;IN_ELIM_THM';IN_UNIV;IN_UNIONS]; + EXISTS_TAC `(\p. (g:(A->bool)->num->A) ((f:num->(A->bool)) (FST ((h:num->(num#num)) p))) (SND (h p)))`; + BETA_TAC; + GEN_TAC; + DISCH_THEN (CHOOSE_THEN MP_TAC); + DISCH_ALL_TAC; + USE 3 (SPEC `t:A->bool`); + USE 3 (SPEC `y:A`); + UND 3 THEN (ASM_REWRITE_TAC[]); + REPEAT (DISCH_THEN(CHOOSE_THEN (MP_TAC))); + DISCH_ALL_TAC; + USE 2 (SPEC `(u:num,v:num)`); + SUBGOAL_TAC `?x' y'. (u:num,v:num) = (x',y')`; + MESON_TAC[]; + DISCH_TAC; + UND 2; + ASM_REWRITE_TAC[]; + DISCH_THEN (CHOOSE_THEN (ASSUME_TAC o GSYM)); + EXISTS_TAC `x':num`; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let COUNTABLE_IMAGE = prove_by_refinement( + `!(A:A->bool) (B:B->bool) . (COUNTABLE A) /\ (?f. (B SUBSET IMAGE f A)) ==> + (COUNTABLE B)`, + (* {{{ proof *) + [ + REWRITE_TAC[COUNTABLE;GE_C;IN_UNIV;IN_ELIM_THM';SUBSET]; + DISCH_ALL_TAC; + CHO 0; + USE 1 (REWRITE_RULE[IMAGE;IN_ELIM_THM']); + CHO 1; + USE 1 (REWRITE_RULE[IN_ELIM_THM']); + USE 1 (CONV_RULE NAME_CONFLICT_CONV); + EXISTS_TAC `(f':A->B) o (f:num->A)`; + REWRITE_TAC[o_DEF]; + DISCH_ALL_TAC; + USE 1 (SPEC `y:B`); + UND 1; + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + USE 0 (SPEC `x':A`); + UND 0 THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let COUNTABLE_CARD = prove_by_refinement( + `!(A:A->bool) (B:B->bool). (COUNTABLE A) /\ (A >=_c B) ==> + (COUNTABLE B)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + MATCH_MP_TAC COUNTABLE_IMAGE; + EXISTS_TAC `A:A->bool`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM']; + USE 1 (REWRITE_RULE[GE_C]); + CHO 1; + EXISTS_TAC `f:A->B`; + ASM_REWRITE_TAC[]; + ]);; + + (* }}} *) + +let COUNTABLE_NUMSEG = prove_by_refinement( + `!n. COUNTABLE {x | x <| n}`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[COUNTABLE;GE_C;IN_UNIV]; + EXISTS_TAC `I:num->num`; + REDUCE_TAC; + REWRITE_TAC[IN_ELIM_THM']; + MESON_TAC[]; + ]);; + (* }}} *) + +let FINITE_COUNTABLE = prove_by_refinement( + `!(A:A->bool). (FINITE A) ==> (COUNTABLE A)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + USE 0 (MATCH_MP FINITE_HAS_SIZE_LEMMA); + CHO 0; + ASSUME_TAC(SPEC `n:num` COUNTABLE_NUMSEG); + JOIN 1 0; + USE 0 (MATCH_MP COUNTABLE_CARD); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let num_infinite = prove_by_refinement( + `~ (FINITE (UNIV:num->bool))`, + (* {{{ proof *) + [ + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[]); + USE 0 (MATCH_MP num_FINITE_AVOID); + USE 0 (REWRITE_RULE[IN_UNIV]); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let num_SEG_UNION = prove_by_refinement( + `!i. ({u | i <| u} UNION {m | m <=| i}) = UNIV`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + SUBGOAL_TAC `({u | i <| u} UNION {m | m <=| i}) = UNIV`; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[UNIV;UNION;IN_ELIM_THM']; + ARITH_TAC; + REWRITE_TAC[]; + ]);; + (* }}} *) + +let num_above_infinite = prove_by_refinement( + `!i. ~ (FINITE {u | i <| u})`, + (* {{{ proof *) + [ + GEN_TAC; + PROOF_BY_CONTR_TAC; + USE 0 (REWRITE_RULE[]); + ASSUME_TAC(SPEC `i:num` FINITE_NUMSEG_LE); + JOIN 0 1; + USE 0 (MATCH_MP FINITE_UNION_IMP); + SUBGOAL_TAC `({u | i <| u} UNION {m | m <=| i}) = UNIV`; + REWRITE_TAC[num_SEG_UNION]; + DISCH_TAC; + UND 0; + ASM_REWRITE_TAC[]; + REWRITE_TAC[num_infinite]; + ]);; + (* }}} *) + +let INTER_FINITE = prove_by_refinement( + `!s (t:A->bool). (FINITE s ==> FINITE(s INTER t)) /\ (FINITE t ==> FINITE (s INTER t))`, + (* {{{ proof *) + + [ + CONV_TAC (quant_right_CONV "t"); + CONV_TAC (quant_right_CONV "s"); + SUBCONJ_TAC; + DISCH_ALL_TAC; + SUBGOAL_TAC `s INTER t SUBSET (s:A->bool)`; + SET_TAC[]; + ASM_MESON_TAC[FINITE_SUBSET]; + MESON_TAC[INTER_COMM]; + ]);; + + (* }}} *) + +let num_above_finite = prove_by_refinement( + `!i J. (FINITE (J INTER {u | (i <| u)})) ==> (FINITE J)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + SUBGOAL_TAC `J = (J INTER {u | (i <| u)}) UNION (J INTER {m | m <=| i})`; + REWRITE_TAC[GSYM UNION_OVER_INTER;num_SEG_UNION;INTER_UNIV]; + DISCH_TAC; + ASM (ONCE_REWRITE_TAC)[]; + REWRITE_TAC[FINITE_UNION]; + ASM_REWRITE_TAC[]; + MP_TAC (SPEC `i:num` FINITE_NUMSEG_LE); + REWRITE_TAC[INTER_FINITE]; + ]);; + (* }}} *) + +let SUBSET_SUC = prove_by_refinement( + `!(f:num->A->bool). (!i. f i SUBSET f (SUC i)) ==> (! i j. ( i <=| j) ==> (f i SUBSET f j))`, + (* {{{ proof *) + [ + GEN_TAC; + DISCH_TAC; + REP_GEN_TAC; + MP_TAC (prove( `?n. n = j -| i`,MESON_TAC[])); + CONV_TAC (quant_left_CONV "n"); + SPEC_TAC (`i:num`,`i:num`); + SPEC_TAC (`j:num`,`j:num`); + REP 2( CONV_TAC (quant_left_CONV "n")); + INDUCT_TAC; + REP_GEN_TAC; + DISCH_ALL_TAC; + JOIN 1 2; + USE 1 (CONV_RULE REDUCE_CONV); + ASM_REWRITE_TAC[SUBSET]; + REP_GEN_TAC; + DISCH_TAC; + SUBGOAL_TAC `?j'. j = SUC j'`; + DISJ_CASES_TAC (SPEC `j:num` num_CASES); + UND 2; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + USE 0 (SPEC `j':num`); + USE 1(SPECL [`j':num`;`i:num`]); + DISCH_TAC; + SUBGOAL_TAC `(n = j'-|i)`; + UND 2; + ASM_REWRITE_TAC[]; + ARITH_TAC; + DISCH_TAC; + SUBGOAL_TAC `(i<=| j')`; + USE 2 (MATCH_MP(ARITH_RULE `(SUC n = j -| i) ==> (0 < j -| i)`)); + UND 2; + ASM_REWRITE_TAC[]; + ARITH_TAC; + UND 1; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + REWR 6; + ASM_MESON_TAC[SUBSET_TRANS]; + ]);; + (* }}} *) + +let SUBSET_SUC2 = prove_by_refinement( + `!(f:num->A->bool). (!i. f (SUC i) SUBSET (f i)) ==> (! i j. ( i <=| j) ==> (f j SUBSET f i))`, + (* {{{ proof *) + [ + GEN_TAC; + DISCH_TAC; + REP_GEN_TAC; + MP_TAC (prove( `?n. n = j -| i`,MESON_TAC[])); + CONV_TAC (quant_left_CONV "n"); + SPEC_TAC (`i:num`,`i:num`); + SPEC_TAC (`j:num`,`j:num`); + REP 2( CONV_TAC (quant_left_CONV "n")); + INDUCT_TAC; + REP_GEN_TAC; + DISCH_ALL_TAC; + JOIN 1 2; + USE 1 (CONV_RULE REDUCE_CONV); + ASM_REWRITE_TAC[SUBSET]; + REP_GEN_TAC; + DISCH_TAC; + SUBGOAL_TAC `?j'. j = SUC j'`; + DISJ_CASES_TAC (SPEC `j:num` num_CASES); + UND 2; + ASM_REWRITE_TAC[]; + REDUCE_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN CHOOSE_TAC; + ASM_REWRITE_TAC[]; + USE 0 (SPEC `j':num`); + USE 1(SPECL [`j':num`;`i:num`]); + DISCH_TAC; + SUBGOAL_TAC `(n = j'-|i)`; + UND 2; + ASM_REWRITE_TAC[]; + ARITH_TAC; + DISCH_TAC; + SUBGOAL_TAC `(i<=| j')`; + USE 2 (MATCH_MP(ARITH_RULE `(SUC n = j -| i) ==> (0 < j -| i)`)); + UND 2; + ASM_REWRITE_TAC[]; + ARITH_TAC; + UND 1; + ASM_REWRITE_TAC []; + DISCH_ALL_TAC; + REWR 6; + ASM_MESON_TAC[SUBSET_TRANS]; + ]);; + (* }}} *) + +let INFINITE_PIGEONHOLE = prove_by_refinement( + `!I (f:A->B) B C. (~(FINITE {i | (I i) /\ (C (f i))})) /\ (FINITE B) /\ + (C SUBSET (UNIONS B)) ==> + (?b. (B b) /\ ~(FINITE {i | (I i) /\ (C INTER b) (f i) }))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + PROOF_BY_CONTR_TAC; + USE 3 ( CONV_RULE (quant_left_CONV "b")); + UND 0; + TAUT_TAC `P ==> (~P ==> F)`; + SUBGOAL_TAC `{i | I' i /\ (C ((f:A->B) i))} = UNIONS (IMAGE (\b. {i | I' i /\ ((C INTER b) (f i))}) B)`; + REWRITE_TAC[UNIONS;IN_IMAGE]; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + REWRITE_TAC[IN_ELIM_THM']; + ABBREV_TAC `j = (x:A)`; + EQ_TAC; + DISCH_ALL_TAC; + USE 2 (REWRITE_RULE [SUBSET;UNIONS]); + USE 2 (REWRITE_RULE[IN_ELIM_THM']); + USE 2 (SPEC `(f:A->B) j`); + USE 2 (REWRITE_RULE[IN]); + REWR 2; + CHO 2; + CONV_TAC (quant_left_CONV "x"); + CONV_TAC (quant_left_CONV "x"); + EXISTS_TAC (`u:B->bool`); + NAME_CONFLICT_TAC; + EXISTS_TAC (`{i' | I' i' /\ (C INTER u) ((f:A->B) i')}`); + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM';INTER]; + REWRITE_TAC[IN]; + ASM_REWRITE_TAC[]; + DISCH_TAC; + CHO 4; + AND 4; + CHO 5; + REWR 4; + USE 4 (REWRITE_RULE[IN_ELIM_THM';INTER]); + USE 4 (REWRITE_RULE[IN]); + ASM_REWRITE_TAC[]; + DISCH_TAC; + ASM_REWRITE_TAC[]; + SUBGOAL_TAC `FINITE (IMAGE (\b. {i | I' i /\ (C INTER b) ((f:A->B) i)}) B)`; + MATCH_MP_TAC FINITE_IMAGE; + ASM_REWRITE_TAC[]; + SIMP_TAC[FINITE_UNIONS]; + DISCH_TAC; + GEN_TAC; + REWRITE_TAC[IN_IMAGE]; + DISCH_THEN (X_CHOOSE_TAC `b:B->bool`); + ASM_REWRITE_TAC[]; + USE 3 (SPEC `b:B->bool`); + UND 3; + AND 5; + UND 3; + ABBREV_TAC `r = {i | I' i /\ (C INTER b) ((f:A->B) i)}`; + MESON_TAC[IN]; + ]);; + (* }}} *) + +let real_FINITE = prove_by_refinement( + `!(s:real->bool). FINITE s ==> (?a. !x. x IN s ==> (x <=. a))`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ASSUME_TAC REAL_ARCH_SIMPLE; + USE 1 (CONV_RULE (quant_left_CONV "n")); + CHO 1; + SUBGOAL_TAC `FINITE (IMAGE (n:real->num) s)`; + ASM_MESON_TAC[FINITE_IMAGE]; +(*** JRH -- num_FINITE is now an equivalence not an implication + ASSUME_TAC (SPEC `IMAGE (n:real->num) s` num_FINITE); + ***) + ASSUME_TAC(fst(EQ_IMP_RULE(SPEC `IMAGE (n:real->num) s` num_FINITE))); + DISCH_TAC; + REWR 2; + CHO 2; + USE 2 (REWRITE_RULE[IN_IMAGE]); + USE 2 (CONV_RULE NAME_CONFLICT_CONV); + EXISTS_TAC `&.a`; + GEN_TAC; + USE 2 (CONV_RULE (quant_left_CONV "x'")); + USE 2 (CONV_RULE (quant_left_CONV "x'")); + USE 2 (SPEC `x:real`); + USE 2 (SPEC `(n:real->num) x`); + DISCH_TAC; + REWR 2; + USE 1 (SPEC `x:real`); + UND 1; + MATCH_MP_TAC (REAL_ARITH `a<=b ==> ((x <= a) ==> (x <=. b))`); + REDUCE_TAC; + ASM_REWRITE_TAC []; + ]);; + (* }}} *) + +let UNIONS_DELETE = prove_by_refinement( + `!s. (UNIONS (s:(A->bool)->bool)) = (UNIONS (s DELETE (EMPTY)))`, + (* {{{ proof *) + [ + REWRITE_TAC[UNIONS;DELETE;EMPTY]; + GEN_TAC; + MATCH_MP_TAC EQ_EXT; + REWRITE_TAC[IN_ELIM_THM']; + GEN_TAC; + REWRITE_TAC[IN]; + MESON_TAC[]; + ]);; + (* }}} *) + + +(* ------------------------------------------------------------------ *) +(* Partial functions, which we identify with functions that + take the canonical choice of element outside the domain. *) +(* ------------------------------------------------------------------ *) + +let SUPP = new_definition + `SUPP (f:A->B) = \ x. ~(f x = (CHOICE (UNIV:B ->bool)) )`;; + +let FUN = new_definition + `FUN a b = (\ (f:A->B). ((!x. (x IN a) ==> (f x IN b)) /\ + ((SUPP f) SUBSET a))) `;; + +(* ------------------------------------------------------------------ *) +(* compositions *) +(* ------------------------------------------------------------------ *) + +let compose = new_definition + `compose f g = \x. (f (g x))`;; + +let COMP_ASSOC = prove_by_refinement( + `!(f:num ->num) (g:num->num) (h:num->num). + (compose f (compose g h)) = (compose (compose f g) h)`, +(* {{{ proof *) + + [ + REPEAT GEN_TAC THEN REWRITE_TAC[compose]; + ]);; +(* }}} *) + +let COMP_INJ = prove (`!(f:A->B) (g:B->C) s t u. + INJ f s t /\ (INJ g t u) ==> + (INJ (compose g f) s u)`, +(* {{{ proof *) + + EVERY[REPEAT GEN_TAC; + REWRITE_TAC[INJ;compose]; + DISCH_ALL_TAC; + ASM_MESON_TAC[]]);; +(* }}} *) + +let COMP_SURJ = prove (`!(f:A->B) (g:B->C) s t u. + SURJ f s t /\ (SURJ g t u) ==> (SURJ (compose g f) s u)`, +(* {{{ proof *) + + EVERY[REWRITE_TAC[SURJ;compose]; + DISCH_ALL_TAC; + ASM_MESON_TAC[]]);; +(* }}} *) + +let COMP_BIJ = prove (`!(f:A->B) s t (g:B->C) u. + BIJ f s t /\ (BIJ g t u) ==> (BIJ (compose g f) s u)`, +(* {{{ proof *) + + EVERY[ + REPEAT GEN_TAC; + REWRITE_TAC[BIJ]; + DISCH_ALL_TAC; + ASM_MESON_TAC[COMP_INJ;COMP_SURJ]]);; + +(* }}} *) + + +(* ------------------------------------------------------------------ *) +(* general construction of an inverse function on a domain *) +(* ------------------------------------------------------------------ *) + +let INVERSE_FN = prove_by_refinement( + `?INV. (! (f:A->B) a b. (SURJ f a b) ==> ((INJ (INV f a b) b a) /\ + (!(x:B). (x IN b) ==> (f ((INV f a b) x) = x))))`, +(* {{{ proof *) + + [ + REWRITE_TAC[GSYM SKOLEM_THM]; + REPEAT GEN_TAC; + MATCH_MP_TAC (prove_by_refinement( `!A B. (A ==> (?x. (B x))) ==> (?(x:B->A). (A ==> (B x)))`,[MESON_TAC[]])) ; + REWRITE_TAC[SURJ;INJ]; + DISCH_ALL_TAC; + SUBGOAL_TAC `?u. !y. ((y IN b)==> ((u y IN a) /\ ((f:A->B) (u y) = y)))`; + REWRITE_TAC[GSYM SKOLEM_THM]; + GEN_TAC; + ASM_MESON_TAC[]; + DISCH_THEN CHOOSE_TAC; + EXISTS_TAC `u:B->A`; + REPEAT CONJ_TAC; + ASM_MESON_TAC[]; + REPEAT GEN_TAC; + DISCH_ALL_TAC; + FIRST_X_ASSUM (fun th -> ASSUME_TAC (AP_TERM `f:A->B` th)); + ASM_MESON_TAC[]; + ASM_MESON_TAC[] + ]);; + +(* }}} *) + +let INVERSE_DEF = new_specification ["INV"] INVERSE_FN;; + +let INVERSE_BIJ = prove_by_refinement( + `!(f:A->B) a b. (BIJ f a b) ==> ((BIJ (INV f a b) b a))`, +(* {{{ proof *) + [ + REPEAT GEN_TAC; + REWRITE_TAC[BIJ]; + DISCH_ALL_TAC; + ASM_SIMP_TAC[INVERSE_DEF]; + REWRITE_TAC[SURJ]; + CONJ_TAC; + ASM_MESON_TAC[INVERSE_DEF;INJ]; + GEN_TAC THEN DISCH_TAC; + EXISTS_TAC `(f:A->B) x`; + CONJ_TAC; + ASM_MESON_TAC[INJ]; + SUBGOAL_THEN `((f:A->B) x) IN b` ASSUME_TAC; + ASM_MESON_TAC[INJ]; + SUBGOAL_THEN `(f:A->B) (INV f a b (f x)) = (f x)` ASSUME_TAC; + ASM_MESON_TAC[INVERSE_DEF]; + H_UNDISCH_TAC (HYP "0"); + REWRITE_TAC[INJ]; + DISCH_ALL_TAC; + FIRST_X_ASSUM (fun th -> MP_TAC (SPECL [`INV (f:A->B) a b (f x)`;`x:A`] th)); + ASM_REWRITE_TAC[]; + DISCH_ALL_TAC; + SUBGOAL_THEN `INV (f:A->B) a b (f x) IN a` ASSUME_TAC; + ASM_MESON_TAC[INVERSE_DEF;INJ]; + ASM_MESON_TAC[]; + ]);; +(* }}} *) + +let INVERSE_XY = prove_by_refinement( + `!(f:A->B) a b x y. (BIJ f a b) /\ (x IN a) /\ (y IN b) ==> ((INV f a b y = x) <=> (f x = y))`, +(* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + EQ_TAC; + FIRST_X_ASSUM (fun th -> (ASSUME_TAC th THEN (ASSUME_TAC (MATCH_MP INVERSE_DEF (CONJUNCT2 (REWRITE_RULE[BIJ] th)))))); + ASM_MESON_TAC[]; + POP_ASSUM (fun th -> (ASSUME_TAC th THEN (ASSUME_TAC (CONJUNCT2 (REWRITE_RULE[INJ] (CONJUNCT1 (REWRITE_RULE[BIJ] th))))))); + DISCH_THEN (fun th -> ASSUME_TAC th THEN (REWRITE_TAC[GSYM th])); + FIRST_X_ASSUM MATCH_MP_TAC; + REPEAT CONJ_TAC; + ASM_REWRITE_TAC[]; + IMP_RES_THEN ASSUME_TAC INVERSE_BIJ; + ASM_MESON_TAC[BIJ;INJ]; + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM (fun th -> (ASSUME_TAC (CONJUNCT2 (REWRITE_RULE[BIJ] th)))); + IMP_RES_THEN (fun th -> ASSUME_TAC (CONJUNCT2 th)) INVERSE_DEF; + ASM_MESON_TAC[]; + ]);; +(* }}} *) + +let FINITE_BIJ = prove( + `!a b (f:A->B). FINITE a /\ (BIJ f a b) ==> (FINITE b)`, +(* {{{ proof *) + + MESON_TAC[SURJ_IMAGE;BIJ;INJ;FINITE_IMAGE] +);; + +(* }}} *) + +let FINITE_INJ = prove_by_refinement( + `!a b (f:A->B). FINITE b /\ (INJ f a b) ==> (FINITE a)`, +(* {{{ proof *) + + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + MP_TAC (SPECL [`f:A->B`;`b:B->bool`;`a:A->bool`] FINITE_IMAGE_INJ_GENERAL); + DISCH_ALL_TAC; + SUBGOAL_THEN `(a:A->bool) SUBSET ({x | (x IN a) /\ ((f:A->B) x IN b)})` ASSUME_TAC; + REWRITE_TAC[SUBSET]; + GEN_TAC ; + REWRITE_TAC[IN_ELIM_THM]; + POPL_TAC[0;1]; + ASM_MESON_TAC[BIJ;INJ]; + MATCH_MP_TAC FINITE_SUBSET; + EXISTS_TAC `({x | (x IN a) /\ ((f:A->B) x IN b)})` ; + CONJ_TAC; + FIRST_X_ASSUM (fun th -> MATCH_MP_TAC th); + CONJ_TAC; + ASM_MESON_TAC[BIJ;INJ]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ] +);; + +(* }}} *) + +let FINITE_BIJ2 = prove_by_refinement( + `!a b (f:A->B). FINITE b /\ (BIJ f a b) ==> (FINITE a)`, +(* {{{ proof *) + + [ + MESON_TAC[BIJ;FINITE_INJ] + ]);; +(* }}} *) + +let BIJ_CARD = prove_by_refinement( + `!a b (f:A->B). FINITE a /\ (BIJ f a b) ==> (CARD a = (CARD b))`, +(* {{{ proof *) + + [ + ASM_MESON_TAC[SURJ_IMAGE;BIJ;INJ;CARD_IMAGE_INJ]; + ]);; + +(* }}} *) + +let PAIR_LEMMA = prove_by_refinement( + `!(x:num#num) i j. ((FST x = i) /\ (SND x = j)) <=> (x = (i,j))` , +(* {{{ proof *) + + [ + MESON_TAC[FST;SND;PAIR]; + ]);; +(* }}} *) + +let CARD_SING = prove_by_refinement( + `!(u:A->bool). (SING u ) ==> (CARD u = 1)`, +(* {{{ proof *) + [ + REWRITE_TAC[SING]; + GEN_TAC; + DISCH_THEN (CHOOSE_TAC); + ASM_REWRITE_TAC[]; + ASSUME_TAC FINITE_RULES; + ASM_SIMP_TAC[CARD_CLAUSES;NOT_IN_EMPTY]; + ACCEPT_TAC (NUM_RED_CONV `SUC 0`) + ]);; +(* }}} *) + +let FINITE_SING = prove_by_refinement( + `!(x:A). FINITE ({x})`, +(* {{{ proof *) + + [ + MESON_TAC[FINITE_RULES] + ]);; +(* }}} *) + +let NUM_INTRO = prove_by_refinement( + `!f P.((!(n:num). !(g:A). (f g = n) ==> (P g)) ==> (!g. (P g)))`, +(* {{{ proof *) + + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + GEN_TAC; + H_VAL (SPECL [`(f:A->num) (g:A)`; `g:A`]) (HYP "0"); + ASM_MESON_TAC[]; + ]);; +(* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* Lemmas about the support of a function *) +(* ------------------------------------------------------------------ *) + + +(* Law of cardinal exponents B^0 = 1 *) +let DOMAIN_EMPTY = prove_by_refinement( + `!b. FUN (EMPTY:A->bool) b = { (\ (u:A). (CHOICE (UNIV:B->bool))) }`, +(* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[EXTENSION;FUN]; + X_GEN_TAC `f:A->B`; + REWRITE_TAC[IN_ELIM_THM;INSERT;NOT_IN_EMPTY;SUBSET_EMPTY;SUPP]; + REWRITE_TAC[EMPTY]; + ONCE_REWRITE_TAC[EXTENSION]; + REWRITE_TAC[IN]; + EQ_TAC; + DISCH_TAC THEN (MATCH_MP_TAC EQ_EXT); + BETA_TAC; + ASM_REWRITE_TAC[]; + DISCH_TAC THEN (ASM_REWRITE_TAC[]) THEN BETA_TAC; + ]);; +(* }}} *) + +(* Law of cardinal exponents B^A * B = B^(A+1) *) +let DOMAIN_INSERT = prove_by_refinement( + `!a b s. (~((s:A) IN a) ==> + (?F. (BIJ F (FUN (s INSERT a) b) + { (u,v) | (u IN (FUN a b)) /\ ((v:B) IN b) } + )))`, +(* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_TAC; + EXISTS_TAC `\ f. ((\ x. (if (x=(s:A)) then (CHOICE (UNIV:B->bool)) else (f x))),(f s))`; + REWRITE_TAC[BIJ;INJ;SURJ]; + TAUT_TAC `(A /\ (A ==> B) /\ (A ==>C)) ==> ((A/\ B) /\ (A /\ C))`; + REPEAT CONJ_TAC; + X_GEN_TAC `(f:A->B)`; + REWRITE_TAC[FUN;IN_ELIM_THM]; + REWRITE_TAC[INSERT;SUBSET]; + REWRITE_TAC[IN_ELIM_THM;SUPP]; + STRIP_TAC; + ABBREV_TAC `g = \ x. (if (x=(s:A)) then (CHOICE (UNIV:B->bool)) else (f x)) `; + EXISTS_TAC `g:A->B`; + EXISTS_TAC `(f:A->B) s`; + REWRITE_TAC[]; + REPEAT CONJ_TAC; + EXPAND_TAC "g" THEN BETA_TAC; + GEN_TAC; + REWRITE_TAC[IN;COND_ELIM_THM]; + ASM_MESON_TAC[IN]; + (* next *) ALL_TAC; + EXPAND_TAC "g" THEN BETA_TAC; + GEN_TAC; + ASM_CASES_TAC `(x:A) = s`; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* next *) ALL_TAC; + ASM_MESON_TAC[]; + (* INJ *) ALL_TAC; + REWRITE_TAC[FUN;SUPP]; + DISCH_TAC; + X_GEN_TAC `f1:A->B`; + X_GEN_TAC `f2:A->B`; + REWRITE_TAC[IN]; + DISCH_ALL_TAC; + MATCH_MP_TAC EQ_EXT; + GEN_TAC; + ASM_CASES_TAC `(x:A) = s`; + POPL_TAC[1;2;3;4;6;7]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[PAIR;FST;SND]; + POPL_TAC[1;2;3;4;6;7]; + FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[FST] (AP_TERM `FST:((A->B)#B)->(A->B)` th))) ; + FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[COND_ELIM_THM] (BETA_RULE (AP_THM th `x:A`)))); + LABEL_ALL_TAC; + H_UNDISCH_TAC (HYP "0"); + COND_CASES_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + (* SURJ *) ALL_TAC; + REWRITE_TAC[FUN;SUPP;IN_ELIM_THM]; + REWRITE_TAC[IN;INSERT;SUBSET]; + DISCH_ALL_TAC; + X_GEN_TAC `p:(A->B)#B`; + DISCH_THEN CHOOSE_TAC; + FIRST_X_ASSUM (fun th -> MP_TAC th); + DISCH_THEN CHOOSE_TAC; + FIRST_X_ASSUM MP_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + EXISTS_TAC `\ (x:A). if (x = s) then (v:B) else (u x)`; + REPEAT CONJ_TAC; + X_GEN_TAC `t:A`; + BETA_TAC; + REWRITE_TAC[IN_ELIM_THM;COND_ELIM_THM]; + POPL_TAC[1;3;4;5]; + ASM_MESON_TAC[]; + X_GEN_TAC `t:A`; + BETA_TAC; + REWRITE_TAC[IN_ELIM_THM;COND_ELIM_THM]; + ASM_CASES_TAC `(t:A) = s`; + POPL_TAC[1;3;4;5;6]; + ASM_REWRITE_TAC[]; + POPL_TAC[1;3;4;5;6]; + FIRST_X_ASSUM (fun th -> ASSUME_TAC (SPEC `t:A` th)); + ASM_SIMP_TAC[prove(`~((t:A)=s) ==> ((t=s)=F)`,MESON_TAC[])]; + BETA_TAC; + REWRITE_TAC[]; + POPL_TAC[0;2;3;4]; + AP_THM_TAC; + AP_TERM_TAC; + MATCH_MP_TAC EQ_EXT; + X_GEN_TAC `t:A`; + BETA_TAC; + DISJ_CASES_TAC (prove(`(((t:A)=s) <=> T) \/ ((t=s) <=> F)`,MESON_TAC[])); + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[IN]; + ASM_REWRITE_TAC[] + ]);; +(* }}} *) + +let CARD_DELETE_CHOICE = prove_by_refinement( + `!(a:(A->bool)). ((FINITE a) /\ (~(a=EMPTY))) ==> + (SUC (CARD (a DELETE (CHOICE a))) = (CARD a))`, +(* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + ASM_SIMP_TAC[CARD_DELETE]; + ASM_SIMP_TAC[CHOICE_DEF]; + MATCH_MP_TAC (ARITH_RULE `~(x=0) ==> (SUC (x -| 1) = x)`); + ASM_MESON_TAC[HAS_SIZE_0;HAS_SIZE]; + ]);; +(* }}} *) + + +(* +let dets_flag = ref true;; +dets_flag:= !labels_flag;; +*) + + +labels_flag:=false;; + +(* Law of cardinals |B^A| = |B|^|A| *) +let FUN_SIZE = prove_by_refinement( + `!b a. (FINITE (a:A->bool)) /\ (FINITE (b:B->bool)) + ==> ((FUN a b) HAS_SIZE ((CARD b) EXP (CARD a)))`, +(* {{{ proof *) + [ + GEN_TAC; + MATCH_MP_TAC (SPEC `CARD:(A->bool)->num` ((INST_TYPE) [`:A->bool`,`:A`] NUM_INTRO)); + INDUCT_TAC; + GEN_TAC; + DISCH_ALL_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC [EXP]; + SUBGOAL_THEN `(a:A->bool) = EMPTY` ASSUME_TAC; + ASM_REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE]; + ASM_REWRITE_TAC[HAS_SIZE;DOMAIN_EMPTY]; + CONJ_TAC; + REWRITE_TAC[FINITE_SING]; + MATCH_MP_TAC CARD_SING; + REWRITE_TAC[SING]; + MESON_TAC[]; + GEN_TAC; + FIRST_X_ASSUM (fun th -> ASSUME_TAC (SPEC `(a:A->bool) DELETE (CHOICE a)` th)) ; + DISCH_ALL_TAC; + SUBGOAL_THEN `CARD ((a:A->bool) DELETE (CHOICE a)) = n` ASSUME_TAC; + ASM_SIMP_TAC[CARD_DELETE]; + SUBGOAL_THEN `CHOICE (a:A->bool) IN a` ASSUME_TAC; + MATCH_MP_TAC CHOICE_DEF; + ASSUME_TAC( ARITH_RULE `!x. (x = (SUC n)) ==> (~(x = 0))`); + REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + MESON_TAC[ ( ARITH_RULE `!n. (SUC n -| 1) = n`)]; + LABEL_ALL_TAC; + H_MATCH_MP (HYP "3") (HYP "4"); + SUBGOAL_THEN `FUN ((a:A->bool) DELETE CHOICE a) (b:B->bool) HAS_SIZE CARD b **| CARD (a DELETE CHOICE a)` ASSUME_TAC; + ASM_MESON_TAC[FINITE_DELETE]; + ASSUME_TAC (SPECL [`((a:A->bool) DELETE (CHOICE a))`;`b:B->bool`;`(CHOICE (a:A->bool))` ] DOMAIN_INSERT); + LABEL_ALL_TAC; + H_UNDISCH_TAC (HYP "5"); + REWRITE_TAC[IN_DELETE]; + SUBGOAL_THEN `~((a:A->bool) = EMPTY)` ASSUME_TAC; + REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE]; + ASSUME_TAC( ARITH_RULE `!x. (x = (SUC n)) ==> (~(x = 0))`); + ASM_MESON_TAC[]; + ASM_SIMP_TAC[INSERT_DELETE;CHOICE_DEF]; + DISCH_THEN CHOOSE_TAC; + REWRITE_TAC[HAS_SIZE]; + SUBGOAL_THEN `FINITE (FUN (a:A->bool) (b:B->bool))` ASSUME_TAC; + (* CONJ_TAC; *) ALL_TAC; + MATCH_MP_TAC (SPEC `FUN (a:A->bool) (b:B->bool)` (PINST[(`:A->B`,`:A`);(`:(A->B)#B`,`:B`)] [] FINITE_BIJ2)); + EXISTS_TAC `{u,v | (u:A->B) IN FUN (a DELETE CHOICE a) b /\ (v:B) IN b}`; + EXISTS_TAC `F':(A->B)->((A->B)#B)`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC FINITE_PRODUCT; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[HAS_SIZE]; + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `CARD (FUN (a:A->bool) (b:B->bool)) = (CARD {u,v | (u:A->B) IN FUN (a DELETE CHOICE a) b /\ (v:B) IN b})` ASSUME_TAC; + MATCH_MP_TAC BIJ_CARD; + EXISTS_TAC `F':(A->B)->((A->B)#B)`; + ASM_REWRITE_TAC[]; + (* *) ALL_TAC; + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `FINITE (a DELETE CHOICE (a:A->bool))` ASSUME_TAC; + ASM_MESON_TAC[FINITE_DELETE]; + SUBGOAL_THEN `(FUN ((a:A->bool) DELETE CHOICE a) (b:B->bool)) HAS_SIZE (CARD b **| (CARD (a DELETE CHOICE a)))` ASSUME_TAC; + POPL_TAC[1;2;3;4;5;10;11]; + ASM_MESON_TAC[CARD_DELETE]; + POP_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[HAS_SIZE] th) THEN (ASSUME_TAC th)); + ASM_SIMP_TAC[CARD_PRODUCT]; + REWRITE_TAC[EXP;MULT_AC] + ]);; +(* }}} *) + +labels_flag:= true;; + + +(* ------------------------------------------------------------------ *) +(* ------------------------------------------------------------------ *) + + + +(* Definitions in math tend to be n-tuples of data. Let's make it + easy to pick out the individual components of a definition *) + +(* pick out the rest of n-tuples. Indexing consistent with lib.drop *) +let drop0 = new_definition(`drop0 (u:A#B) = SND u`);; +let drop1 = new_definition(`drop1 (u:A#B#C) = SND (SND u)`);; +let drop2 = new_definition(`drop2 (u:A#B#C#D) = SND (SND (SND u))`);; +let drop3 = new_definition(`drop3 (u:A#B#C#D#E) = SND (SND (SND (SND u)))`);; + +(* pick out parts of n-tuples *) + +let part0 = new_definition(`part0 (u:A#B) = FST u`);; +let part1 = new_definition(`part1 (u:A#B#C) = FST (drop0 u)`);; +let part2 = new_definition(`part2 (u:A#B#C#D) = FST (drop1 u)`);; +let part3 = new_definition(`part3 (u:A#B#C#D#E) = FST (drop2 u)`);; +let part4 = new_definition(`part4 (u:A#B#C#D#E#F) = FST (drop3 u)`);; +let part5 = new_definition(`part5 (u:A#B#C#D#E#F#G) = + FST (SND (SND (SND (SND (SND u)))))`);; +let part6 = new_definition(`part6 (u:A#B#C#D#E#F#G#H) = + FST (SND (SND (SND (SND (SND (SND u))))))`);; +let part7 = new_definition(`part7 (u:A#B#C#D#E#F#G#H#I) = + FST (SND (SND (SND (SND (SND (SND (SND u)))))))`);; + + +(* ------------------------------------------------------------------ *) +(* Basic Definitions of Euclidean Space, Metric Spaces, and Topology *) +(* ------------------------------------------------------------------ *) + +(* ------------------------------------------------------------------ *) +(* Interface *) +(* ------------------------------------------------------------------ *) + +let euclid_def = local_definition "euclid";; +mk_local_interface "euclid";; + +overload_interface + ("+", `euclid'euclid_plus:(num->real)->(num->real)->(num->real)`);; + +make_overloadable "*#" `:A -> B -> B`;; + +let euclid_scale = euclid_def + `euclid_scale t f = \ (i:num). (t*. (f i))`;; + +overload_interface ("*#",`euclid'euclid_scale`);; + +parse_as_infix("*#",(20,"right"));; + +let euclid_neg = euclid_def `euclid_neg f = \ (i:num). (--. (f i))`;; + +(* This is highly ambiguous: -- f x can be read as + (-- f) x or as -- (f x). *) +overload_interface ("--",`euclid'euclid_neg`);; + +overload_interface + ("-", `euclid'euclid_minus:(num->real)->(num->real)->(num->real)`);; + +(* ------------------------------------------------------------------ *) +(* Euclidean Space *) +(* ------------------------------------------------------------------ *) + +let euclid_plus = euclid_def + `euclid_plus f g = \ (i:num). (f i) +. (g i)`;; + +let euclid = euclid_def `euclid n v <=> !m. (n <=| m) ==> (v m = &.0)`;; + +let euclidean = euclid_def `euclidean v <=> ?n. euclid n v`;; + +let euclid_minus = euclid_def + `euclid_minus f g = \(i:num). (f i) -. (g i)`;; + +let euclid0 = euclid_def `euclid0 = \(i:num). &.0`;; + +let coord = euclid_def `coord i (f:num->real) = f i`;; + +let dot = euclid_def `dot f g = + let (n = (min_num (\m. (euclid m f) /\ (euclid m g)))) in + sum (0,n) (\i. (f i)*(g i))`;; + +let norm = euclid_def `norm f = sqrt(dot f f)`;; + +let d_euclid = euclid_def `d_euclid f g = norm (f - g)`;; + + + +(* ------------------------------------------------------------------ *) +(* Euclidean and Convex geometry *) +(* ------------------------------------------------------------------ *) + + +let sum_vector_EXISTS = prove_by_refinement( + `?sum_vector. (!f n. sum_vector(n,0) f = (\n. &.0)) /\ + (!f m n. sum_vector(n,SUC m) f = sum_vector(n,m) f + f(n + m))`, + (* {{{ proof *) + [ + (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = (\n. &0)) /\ (!f m n. sm n (SUC m) f = sm n m f + f(n + m))`; + EXISTS_TAC `\(n,m) f. (sm:num->num->(num->(num->real))->(num->real)) n m f`; + CONV_TAC(DEPTH_CONV GEN_BETA_CONV); + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +let sum_vector = new_specification ["sum_vector"] sum_vector_EXISTS;; + +let mk_segment = euclid_def + `mk_segment x y = { u | ?a. (&.0 <=. a) /\ (a <=. &.1) /\ + (u = a *# x + (&.1 - a) *# y) }`;; + +let mk_open_segment = euclid_def + `mk_open_segment x y = { u | ?a. (&.0 <. a) /\ (a <. &.1) /\ + (u = a *# x + (&.1 - a) *# y) }`;; + +let convex = euclid_def + `convex S <=> !x y. (S x) /\ (S y) ==> (mk_segment x y SUBSET S)`;; + +let convex_hull = euclid_def + `convex_hull S = { u | ?f alpha m. (!n. (n< m) ==> (S (f n))) /\ + (sum(0,m) alpha = &.1) /\ (!n. (n< m) ==> (&.0 <=. (alpha n))) /\ + (u = sum_vector(0,m) (\n. (alpha n) *# (f n)))}`;; + +let affine_hull = euclid_def + `affine_hull S = { u | ?f alpha m. (!n. (n< m) ==> (S (f n))) /\ + (sum(0,m) alpha = &.1) /\ + (u = sum_vector(0,m) (\n. (alpha n) *# (f n)))}`;; + +let mk_line = euclid_def `mk_line x y = + {z| ?t. (z = (t *# x) + ((&.1 - t) *# y)) }`;; + +let affine = euclid_def + `affine S <=> !x y. (S x ) /\ (S y) ==> (mk_line x y SUBSET S)`;; + +let affine_dim = euclid_def + `affine_dim n S <=> + (?T. (T HAS_SIZE (SUC n)) /\ (affine_hull T = affine_hull S)) /\ + (!T m. (T HAS_SIZE (SUC m)) /\ (m < n) ==> ~(affine_hull T = affine_hull S))`;; + +let collinear = euclid_def + `collinear S <=> (?n. affine_dim n S /\ (n < 2))`;; + +let coplanar = euclid_def + `coplanar S <=> (?n. affine_dim n S /\ (n < 3))`;; + +let line = euclid_def + `line L <=> (affine L) /\ (affine_dim 1 L)`;; + +let plane = euclid_def + `plane P <=> (affine P) /\ (affine_dim 2 P)`;; + +let space = euclid_def + `space R <=> (affine R) /\ (affine_dim 3 R)`;; + +(* + +General constructor of conical objects, including + rays, cones, half-planes, etc. + +L is the edge. C is the set of generators in the positive +direction. + +If L is a line, and C = {c}, we get the half-plane bounded by +L and containing c. + +If L is a point, and C is general, we get the cone at L generated +by C. + +If L and C are both singletons, we get the ray ending at L. + + *) + +let mk_open_half_set = euclid_def + `mk_open_half_set L S = + { u | ?t v c. (L v) /\ (S c) /\ (&.0 < t) /\ + (u = (t *# (c - v) + (&.1 - t) *# v)) }`;; + +let mk_half_set = euclid_def + `mk_half_set L S = + { u | ?t v c. (L v) /\ (S c) /\ (&.0 <=. t) /\ + (u = (t *# (c - v) + (&.1 - t) *# v)) }`;; + + +let mk_angle = euclid_def `mk_angle x y z = + (mk_half_set {x} {y}) UNION (mk_half_set {x} {z})`;; + +let mk_signed_angle = euclid_def `mk_signed_angle x y z = + (mk_half_set {x} {y} , mk_half_set {x} {z})`;; + +let mk_convex_cone = euclid_def + `mk_convex_cone v (S:(num->real)->bool) = + mk_half_set {v} (convex_hull S)`;; + +(* we always normalize the radius of balls in a packing to 1 *) +let packing = euclid_def(`packing (S:(num->real)->bool) <=> + !x y. ( ((S x) /\ (S y) /\ ((d_euclid x y) < (&.2))) ==> + (x = y))`);; + +let saturated_packing = euclid_def(`saturated_packing S <=> + (( packing S) /\ + (!z. (affine_hull S z) ==> + (?x. ((S x) /\ ((d_euclid x z) < (&.2))))))`);; + + +(* 3 dimensions specific: *) +let cross_product3 = euclid_def(`cross_product3 v1 v2 = + let (x1 = v1 0) and (x2 = v1 1) and (x3 = v1 2) in + let (y1 = v2 0) and (y2 = v2 1) and (y3 = v2 2) in + (\k. + (if (k=0) then (x2*y3-x3*y2) + else if (k=1) then (x3*y1-x1*y3) + else if (k=2) then (x1*y2-x2*y1) + else (&0)))`);; + +let triple_product = euclid_def(`triple_product v1 v2 v3 = + dot v1 (cross_product3 v2 v3)`);; + +(* the bounding edge *) +let mk_triangle = euclid_def `mk_triangle v1 v2 v3 = + (mk_segment v1 v2) UNION (mk_segment v2 v3) UNION (mk_segment v3 v1)`;; + +(* the interior *) +let mk_interior_triangle = euclid_def + `mk_interior_triangle v1 v2 v3 = + mk_open_half_set (mk_line v1 v2) {v3} INTER + (mk_open_half_set (mk_line v2 v3) {v1}) INTER + (mk_open_half_set (mk_line v3 v1) {v2})`;; + +let mk_triangular_region = euclid_def + `mk_triangular_region v1 v2 v3 = + (mk_triangle v1 v2 v3) UNION (mk_interior_triangle v1 v2 v3)`;; + + +(* ------------------------------------------------------------------ *) +(* Statements of Theorems in Euclidean Geometry (no proofs *) +(* ------------------------------------------------------------------ *) + +let half_set_convex = `!L S. convex (mk_half_set L S)`;; + +let open_half_set_convex = `!L S . convex (mk_open_half_set L S )`;; + +let affine_dim0 = `!S. (affine_dim 0 S) = (SING S)`;; + +let hull_convex = `!S. (convex (convex_hull S))`;; + +let hull_minimal = `!S T. (convex T) /\ (S SUBSET T) ==> + (convex_hull S) SUBSET T`;; + +let affine_hull_affine = `!S. (affine (affine_hull S))`;; + +let affine_hull_minimal = `!S T. (affine T) /\ (S SUBSET T) ==> + (affine_hull S) SUBSET T`;; + +let mk_line_dim = `!x y. ~(x = y) ==> affine_dim 1 (mk_line x y)`;; + +let affine_convex_hull = `!S. (affine_hull S) = (affine_hull (convex_hull S))`;; + +let convex_hull_hull = `!S. (convex_hull S) = (convex_hull (convex_hull S))`;; + +let euclid_affine_dim = `!n. affine_dim n (euclid n)`;; + +let affine_dim_subset = `!m n T S. + (affine_dim m T) /\ (affine_dim n S) /\ (T SUBSET S) ==> (m <= n)`;; + +(* A few of the Birkhoff postulates of Geometry (incomplete) *) + +let line_postulate = `!x y. ~(x = y) ==> + (?!L. (L x) /\ (L y) /\ (line L))`;; + +let ruler_postulate = `!L. (line L) ==> + (?f. (BIJ f L UNIV) /\ + (!x y. (L x /\ L y ==> (d_euclid x y = abs(f x -. f y)))))`;; + +let affine_postulate = `!n. (affine_dim n P) ==> (?S. + (S SUBSET P) /\ (S HAS_SIZE n) /\ (affine_dim n S))`;; + +let line_plane = `!P x y. (plane P) /\ (P x) /\ (P y) ==> + (mk_line x y SUBSET P)`;; + +let plane_of_pt = `!S. (S HAS_SIZE 3) ==> (?P. (plane P) /\ + (S SUBSET P))`;; + +let plane_of_pt_unique = `!S. (S HAS_SIZE 3) ==> (collinear S) \/ + (?! P. (plane P) /\ (S SUBSET P))`;; + +let plane_inter = `!P Q. (plane P) /\ (plane Q) ==> + (P INTER Q = EMPTY) \/ (line (P INTER Q)) \/ (P = Q)`;; + +(* each line separates a plane into two half-planes *) +let plane_separation = + `!P L. (plane P) /\ (line L) /\ (L SUBSET P) ==> + (?A B. (A INTER B = EMPTY) /\ (A INTER L = EMPTY) /\ + (B INTER L = EMPTY) /\ (L UNION A UNION B = P) /\ + (!c u. (P c) /\ (u = mk_open_half_set L {c}) ==> + (u = A) \/ (u = B) \/ (u = L)) /\ + (!a b. (A a) /\ (B b) ==> ~(segment a b INTER L = EMPTY)))`;; + +let space_separation = + `!R P. (space R) /\ (plane P) /\ (P SUBSET R) ==> + (?A B. (A INTER B = EMRTY) /\ (A INTER P = EMRTY) /\ + (B INTER P = EMRTY) /\ (P UNION A UNION B = R) /\ + (!c u. (R c) /\ (u = mk_open_half_set P {c}) ==> + (u = A) \/ (u = B) \/ (u = P)) /\ + (!a b. (A a) /\ (B b) ==> ~(segment a b INTER L = EMPTY)))`;; + +(* ------------------------------------------------------------------ *) +(* Metric Space *) +(* ------------------------------------------------------------------ *) + +let metric_space = euclid_def `metric_space (X:A->bool,d:A->A->real) + <=> + !x y z. + (X x) /\ (X y) /\ (X z) ==> + (((&.0) <=. (d x y)) /\ + ((&.0 = d x y) = (x = y)) /\ + (d x y = d y x) /\ + (d x z <=. d x y + d y z))`;; + +(* ------------------------------------------------------------------ *) +(* Measure *) +(* ------------------------------------------------------------------ *) + +let set_translate = euclid_def + `set_translate v X = { z | ?x. (X x) /\ (z = v + x) }`;; + +let set_scale = euclid_def + `set_scale r X = { z | ?x. (X x) /\ (z = r *# x) }`;; + +let mk_rectangle = euclid_def + `mk_rectangle a b = { z | !(i:num). (a i <=. z i) /\ (z i <. b i) }`;; + +let one_vec = euclid_def + `one_vec n = (\i. if (i<| n) then (&.1) else (&.0))`;; + +let mk_cube = euclid_def + `mk_cube n k v = + let (r = twopow (--: (&: k))) in + let (vv = (\i. (real_of_int (v i)))) in + mk_rectangle (r *# vv) (r *# (vv + (one_vec n)))`;; + +let inner_cube = euclid_def + `inner_cube n k A = + { v | (mk_cube n k v SUBSET A) /\ + (!i. (n <| i) ==> (&:0 = v i)) }`;; + +let outer_cube = euclid_def + `outer_cube n k A = + { v | ~((mk_cube n k v) INTER A = EMPTY) /\ + (!i. (n <| i) ==> (&:0 = v i)) }`;; + +let inner_vol = euclid_def + `inner_vol n k A = + (&. (CARD (inner_cube n k A)))*(twopow (--: (&: (n*k))))`;; + +let outer_vol = euclid_def + `outer_vol n k A = + (&. (CARD (outer_cube n k A)))*(twopow (--: (&: (n*k))))`;; + +let euclid_bounded = euclid_def + `euclid_bounded A = (?R. !(x:num->real) i. (A x) ==> (x i <. R))`;; + +let vol = euclid_def + `vol n A = lim (\k. outer_vol n k A)`;; + +(* ------------------------------------------------------------------ *) +(* COMPUTING PI *) +(* ------------------------------------------------------------------ *) + +unambiguous_interface();; +prioritize_real();; + +(* ------------------------------------------------------------------ *) +(* general series approximations *) +(* ------------------------------------------------------------------ *) + +let SER_APPROX1 = prove_by_refinement( + `!s f g. (f sums s) /\ (summable g) ==> + (!k. ((!n. (||. (f (n+k)) <=. (g (n+k)))) ==> + ( (s - (sum(0,k) f)) <=. (suminf (\n. (g (n +| k)))))))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + GEN_TAC; + DISCH_TAC; + IMP_RES_THEN ASSUME_TAC SUM_SUMMABLE; + IMP_RES_THEN (fun th -> (ASSUME_TAC (SPEC `k:num` th))) SER_OFFSET; + IMP_RES_THEN ASSUME_TAC SUM_UNIQ; + SUBGOAL_THEN `(\n. (f (n+ k))) sums (s - (sum(0,k) f))` ASSUME_TAC; + ASM_MESON_TAC[]; + SUBGOAL_THEN `summable (\n. (f (n+k))) /\ (suminf (\n. (f (n+k))) <=. (suminf (\n. (g (n+k)))))` ASSUME_TAC; + MATCH_MP_TAC SER_LE2; + BETA_TAC; + ASM_REWRITE_TAC[]; + IMP_RES_THEN ASSUME_TAC SER_OFFSET; + FIRST_X_ASSUM (fun th -> ACCEPT_TAC (MATCH_MP SUM_SUMMABLE (((SPEC `k:num`) th)))); + ASM_MESON_TAC[SUM_UNIQ] + ]);; + (* }}} *) + +let SER_APPROX = prove_by_refinement( + `!s f g. (f sums s) /\ (!n. (||. (f n) <=. (g n))) /\ + (summable g) ==> + (!k. (abs (s - (sum(0,k) f)) <=. (suminf (\n. (g (n +| k))))))`, + (* {{{ proof *) + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + GEN_TAC; + REWRITE_TAC[REAL_ABS_BOUNDS]; + CONJ_TAC; + SUBGOAL_THEN `(!k. ((!n. (||. ((\p. (--. (f p))) (n+k))) <=. (g (n+k)))) ==> ((--.s) - (sum(0,k) (\p. (--. (f p)))) <=. (suminf (\n. (g (n +k))))))` ASSUME_TAC; + MATCH_MP_TAC SER_APPROX1; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SER_NEG ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC (REAL_ARITH (`(--. s -. (--. u) <=. x) ==> (--. x <=. (s -. u))`)); + ONCE_REWRITE_TAC[GSYM SUM_NEG]; + FIRST_X_ASSUM (fun th -> (MATCH_MP_TAC th)); + BETA_TAC; + ASM_REWRITE_TAC[REAL_ABS_NEG]; + H_VAL2 CONJ (HYP "0") (HYP "2"); + IMP_RES_THEN MATCH_MP_TAC SER_APPROX1 ; + GEN_TAC; + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* now for pi calculation stuff *) +(* ------------------------------------------------------------------ *) + + +let local_def = local_definition "trig";; + + +let PI_EST = prove_by_refinement( + `!n. (1 <=| n) ==> (abs(&4 / &(8 * n + 1) - + &2 / &(8 * n + 4) - + &1 / &(8 * n + 5) - + &1 / &(8 * n + 6)) <= &.622/(&.819))`, + (* {{{ proof *) + [ + GEN_TAC THEN DISCH_ALL_TAC; + REWRITE_TAC[real_div]; + MATCH_MP_TAC (REWRITE_RULE[real_div] (REWRITE_RULE[REAL_RAT_REDUCE_CONV `(&.4/(&.9) +(&.2/(&.12)) + (&.1/(&.13))+ (&.1/(&.14)))`] (REAL_ARITH `(abs((&.4)*.u)<=. (&.4)/(&.9)) /\ (abs((&.2)*.v)<=. (&.2)/(&.12)) /\ (abs((&.1)*w) <=. (&.1)/(&.13)) /\ (abs((&.1)*x) <=. (&.1)/(&.14)) ==> (abs((&.4)*u -(&.2)*v - (&.1)*w - (&.1)*x) <= (&.4/(&.9) +(&.2/(&.12)) + (&.1/(&.13))+ (&.1/(&.14))))`))); + IMP_RES_THEN ASSUME_TAC (ARITH_RULE `1 <=| n ==> (0 < n)`); + FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[GSYM REAL_OF_NUM_LT] th)); + ASSUME_TAC (prove(`(a<=.b) ==> (&.n*a <=. (&.n)*b)`,MESON_TAC[REAL_PROP_LE_LMUL;REAL_POS])); + REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_INV;prove(`||.(&.n) = (&.n)`,MESON_TAC[REAL_POS;REAL_ABS_REFL])]; + REPEAT CONJ_TAC THEN (POP_ASSUM (fun th -> MATCH_MP_TAC th)) THEN (MATCH_MP_TAC (prove(`((&.0 <. (&.n)) /\ (&.n <=. a)) ==> (inv(a)<=. (inv(&.n)))`,MESON_TAC[REAL_ABS_REFL;REAL_ABS_INV;REAL_LE_INV2]))) THEN + REWRITE_TAC[REAL_LT;REAL_LE] THEN (H_UNDISCH_TAC (HYP"0")) THEN + ARITH_TAC]);; + (* }}} *) + +let pi_fun = local_def `pi_fun n = inv (&.16 **. n) *. + (&.4 / &.(8 *| n +| 1) -. + &.2 / &.(8 *| n +| 4) -. + &.1 / &.(8 *| n +| 5) -. + &.1 / &.(8 *| n +| 6))`;; + +let pi_bound_fun = local_def `pi_bound_fun n = if (n=0) then (&.8) else + (((&.15)/(&.16))*(inv(&.16 **. n))) `;; + +let PI_EST2 = prove_by_refinement( + `!k. abs(pi_fun k) <=. (pi_bound_fun k)`, + (* {{{ proof *) + [ + GEN_TAC; + REWRITE_TAC[pi_fun;pi_bound_fun]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + CONV_TAC (NUM_REDUCE_CONV); + (CONV_TAC (REAL_RAT_REDUCE_CONV)); + CONV_TAC (RAND_CONV (REWR_CONV (REAL_ARITH `a*b = b*.a`))); + REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_INV;REAL_ABS_POW;prove(`||.(&.n) = (&.n)`,MESON_TAC[REAL_POS;REAL_ABS_REFL])]; + MATCH_MP_TAC (prove(`!x y z. (&.0 <. z /\ (y <=. x) ==> (z*y <=. (z*x)))`,MESON_TAC[REAL_LE_LMUL_EQ])); + ASSUME_TAC (REWRITE_RULE[] (REAL_RAT_REDUCE_CONV `(&.622)/(&.819) <=. (&.15)/(&.16)`)); + IMP_RES_THEN ASSUME_TAC (ARITH_RULE `~(k=0) ==> (1<=| k)`); + IMP_RES_THEN ASSUME_TAC (PI_EST); + CONJ_TAC; + SIMP_TAC[REAL_POW_LT;REAL_LT_INV;ARITH_RULE `&.0 < (&.16)`]; + ASM_MESON_TAC[REAL_LE_TRANS]; + ]);; + (* }}} *) + +let GP16 = prove_by_refinement( + `!k. (\n. inv (&16 pow k) * inv (&16 pow n)) sums + inv (&16 pow k) * &16 / &15`, + (* {{{ proof *) + [ + GEN_TAC; + ASSUME_TAC (REWRITE_RULE[] (REAL_RAT_REDUCE_CONV `abs (&.1 / (&. 16)) <. (&.1)`)); + IMP_RES_THEN (fun th -> ASSUME_TAC (CONV_RULE REAL_RAT_REDUCE_CONV th)) GP; + MATCH_MP_TAC SER_CMUL; + ASM_REWRITE_TAC[GSYM REAL_POW_INV;REAL_INV_1OVER]; + ]);; + (* }}} *) + +let GP16a = prove_by_refinement( + `!k. (0<|k) ==> (\n. (pi_bound_fun (n+k))) sums (inv(&.16 **. k))`, + (* {{{ proof *) + [ + GEN_TAC; + DISCH_TAC; + SUBGOAL_THEN `(\n. pi_bound_fun (n+k)) = (\n. ((&.15/(&.16))* (inv(&.16)**. k) *. inv(&.16 **. n)))` (fun th-> REWRITE_TAC[th]); + MATCH_MP_TAC EQ_EXT; + X_GEN_TAC `n:num` THEN BETA_TAC; + REWRITE_TAC[pi_bound_fun]; + COND_CASES_TAC; + ASM_MESON_TAC[ARITH_RULE `0<| k ==> (~(n+k = 0))`]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + AP_TERM_TAC; + REWRITE_TAC[REAL_INV_MUL;REAL_POW_ADD;REAL_POW_INV;REAL_MUL_AC]; + SUBGOAL_THEN `(\n. (&.15/(&.16)) *. ((inv(&.16)**. k)*. inv(&.16 **. n))) sums ((&.15/(&.16)) *.(inv(&.16**. k)*. ((&.16)/(&.15))))` ASSUME_TAC; + MATCH_MP_TAC SER_CMUL; + REWRITE_TAC[REAL_POW_INV]; + ACCEPT_TAC (SPEC `k:num` GP16); + FIRST_X_ASSUM MP_TAC; + REWRITE_TAC[REAL_MUL_ASSOC]; + MATCH_MP_TAC (prove (`(x=y) ==> ((a sums x) ==> (a sums y))`,MESON_TAC[])); + MATCH_MP_TAC (REAL_ARITH `(b*(a*c) = (b*(&.1))) ==> ((a*b)*c = b)`); + AP_TERM_TAC; + CONV_TAC (REAL_RAT_REDUCE_CONV); + ]);; + (* }}} *) + +let PI_SER = prove_by_refinement( + `!k. (0<|k) ==> (abs(pi - (sum(0,k) pi_fun)) <=. (inv(&.16 **. (k))))`, + (* {{{ proof *) + [ + GEN_TAC THEN DISCH_TAC; + ASSUME_TAC (ONCE_REWRITE_RULE[ETA_AX] (REWRITE_RULE[GSYM pi_fun] POLYLOG_THM)); + ASSUME_TAC PI_EST2; + IMP_RES_THEN (ASSUME_TAC) GP16a; + IMP_RES_THEN (ASSUME_TAC) SUM_SUMMABLE; + IMP_RES_THEN (ASSUME_TAC) SER_OFFSET_REV; + IMP_RES_THEN (ASSUME_TAC) SUM_SUMMABLE; + MP_TAC (SPECL [`pi`;`pi_fun`;`pi_bound_fun` ] SER_APPROX); + ASM_REWRITE_TAC[]; + DISCH_THEN (fun th -> MP_TAC (SPEC `k:num` th)); + SUBGOAL_THEN `suminf (\n. pi_bound_fun (n + k)) = inv (&.16 **. k)` (fun th -> (MESON_TAC[th])); + ASM_MESON_TAC[SUM_UNIQ]; + ]);; + (* }}} *) + +(* replace 3 by SUC (SUC (SUC 0)) *) +let SUC_EXPAND_CONV tm = + let count = dest_numeral tm in + let rec add_suc i r = + if (i <=/ (Int 0)) then r + else add_suc (i -/ (Int 1)) (mk_comb (`SUC`,r)) in + let tm' = add_suc count `0` in + REWRITE_RULE[] (ARITH_REWRITE_CONV[] (mk_eq (tm,tm')));; + +let inv_twopow = prove( + `!n. inv (&.16 **. n) = (twopow (--: (&:(4*n)))) `, + REWRITE_TAC[TWOPOW_NEG;GSYM (NUM_RED_CONV `2 EXP 4`); + REAL_OF_NUM_POW;EXP_MULT]);; + +let PI_SERn n = + let SUM_EXPAND_CONV = + (ARITH_REWRITE_CONV[]) THENC + (TOP_DEPTH_CONV SUC_EXPAND_CONV) THENC + (REWRITE_CONV[sum]) THENC + (ARITH_REWRITE_CONV[REAL_ADD_LID;GSYM REAL_ADD_ASSOC]) in + let sum_thm = SUM_EXPAND_CONV (vsubst [n,`i:num`] `sum(0,i) f`) in + let gt_thm = ARITH_RULE (vsubst [n,`i:num`] `0 <| i`) in + ((* CONV_RULE REAL_RAT_REDUCE_CONV *)(CONV_RULE (ARITH_REWRITE_CONV[]) (BETA_RULE (REWRITE_RULE[sum_thm;pi_fun;inv_twopow] (MATCH_MP PI_SER gt_thm)))));; + +(* abs(pi - u ) < e *) +let recompute_pi bprec = + let n = (bprec /4) in + let pi_ser = PI_SERn (mk_numeral (Int n)) in + let _ = remove_real_constant `pi` in + (add_real_constant pi_ser; INTERVAL_OF_TERM bprec `pi`);; + +(* ------------------------------------------------------------------ *) +(* restore defaults *) +(* ------------------------------------------------------------------ *) + +reduce_local_interface("trig");; +pop_priority();; + + + + + + + diff --git a/Jordan/num_ext_gcd.ml b/Jordan/num_ext_gcd.ml new file mode 100644 index 0000000..42a0d36 --- /dev/null +++ b/Jordan/num_ext_gcd.ml @@ -0,0 +1,249 @@ +(* + Author: Thomas C. Hales, 2003 + + GCD_CONV takes two HOL-light terms (NUMERALs) a and b and + produces a theorem of the form + |- GCD a b = g + + (In particular, the arguments cannot be negative.) + +*) + + +prioritize_num();; + +let DIVIDE = new_definition(`DIVIDE a b = ?m. (b = m*a )`);; + +parse_as_infix("||",(16,"right"));; + +override_interface("||",`DIVIDE:num->num->bool`);; + +(* Now prove the lemmas *) + +let DIV_TAC t = EVERY[ REP_GEN_TAC; + REWRITE_TAC[DIVIDE]; + DISCH_ALL_TAC; + REPEAT (FIRST_X_ASSUM CHOOSE_TAC); + TRY (EXISTS_TAC t)];; + + +let DIVIDE_DIVIDE = prove_by_refinement( + `!a b c. (((a || b) /\ (b || c)) ==> (a || c))`, + [ + DIV_TAC `m'*m`; + ASM_REWRITE_TAC[MULT_ASSOC] + ]);; + +let DIVIDE_EQ = prove_by_refinement( + `! a b. (((a || b) /\ (b || a)) ==> (a = b))`, + [ + DIV_TAC `1`; + FIRST_X_ASSUM (fun th -> (POP_ASSUM MP_TAC) THEN REWRITE_TAC[th]); + ASM_CASES_TAC `b=0`; + ASM_REWRITE_TAC[]; + ARITH_TAC; + REWRITE_TAC[ARITH_RULE `(b = m*m'*b) = (1*b = m*m'*b)`]; + ASM_REWRITE_TAC[MULT_ASSOC;EQ_MULT_RCANCEL]; + DISCH_THEN (fun th -> MP_TAC (REWRITE_RULE[MULT_EQ_1] (GSYM th)) ); + DISCH_THEN (fun th -> REWRITE_TAC[CONJUNCT2 th] THEN ARITH_TAC); + ]);; + +let DIVIDE_SUM = prove_by_refinement( + `!a b h. (((h || a) /\ (h||b)) ==> (h || (a+b)))`, + [ + DIV_TAC `m+m'`; + ASM_REWRITE_TAC[ARITH;RIGHT_ADD_DISTRIB]; + ]);; + +let DIVIDE_SUMMAND = prove_by_refinement( + `!a b h. (((h|| b) /\ (h || (a+b))) ==> (h|| a))`, + [ + DIV_TAC `m'-m`; + REWRITE_TAC[RIGHT_SUB_DISTRIB]; + REPEAT (FIRST_X_ASSUM (fun th -> REWRITE_TAC[GSYM th])); + ARITH_TAC; + ]);; + +let DIVIDE_PROD = prove_by_refinement( + `!a b h. (((h|| a) ==> (h || (b*a))))`, + [ + DIV_TAC `b*m`; + ASM_REWRITE_TAC[MULT_ASSOC]; + ]);; + +let DIVIDE_PROD2 = prove_by_refinement( + `!a b h. (((h|| a) ==> (h || (a*b))))`, + [ + DIV_TAC `b*m`; + ASM_REWRITE_TAC[MULT_AC] + ]);; + +let GCD = new_definition(`GCD a b = @g. + ((g || a) /\ (g || b) /\ + (!h. (((h || a) /\ (h || b)) ==> (h || g))))`);; + +let gcd_certificate = prove(`!a b g. ((? r s r' s' a' b'. + ((a = a'*g) /\ (b = b'*g) /\ (g +r'*a+s'*b= r*a + s*b))) + ==> (GCD a b = g))`, + let tac1 = ( + (REPEAT GEN_TAC) + THEN (DISCH_TAC) + THEN (REPEAT (POP_ASSUM CHOOSE_TAC)) + THEN (REWRITE_TAC[GCD]) + THEN (MATCH_MP_TAC SELECT_UNIQUE) + THEN BETA_TAC + THEN GEN_TAC + THEN EQ_TAC) and + + ygbranch = ( + DISCH_TAC + THEN (MATCH_MP_TAC DIVIDE_EQ) + THEN CONJ_TAC) and + + ydivg_branch = ( + (SUBGOAL_TAC (` (y || (r*a + s*b))/\ (y || (r'*a +s'*b))`)) + THENL [((ASM MESON_TAC)[DIVIDE_SUM;DIVIDE_PROD]); + ((ASM MESON_TAC)[DIVIDE_SUMMAND])] + ) and + + gdivy_branch = ( + (UNDISCH_TAC + (`(y||a) /\ (y ||b) /\ (!h. (((h||a)/\(h||b))==> (h||y)))`)) + THEN (TAUT_TAC (` (A ==> B) ==> ((C /\ D/\ A)==> B)`)) + THEN (DISCH_TAC) + THEN (POP_ASSUM MATCH_MP_TAC) + THEN (REWRITE_TAC[DIVIDE]) + THEN (CONJ_TAC) + THEN ((ASM MESON_TAC)[]) + ) and + + yghyp_branch = ( + (DISCH_TAC) + THEN (let x t = REWRITE_TAC[t] in (POP_ASSUM x)) + THEN (CONJ_TAC) + THENL [((ASM MESON_TAC)[DIVIDE]);ALL_TAC] + THEN (CONJ_TAC) + THENL [((ASM MESON_TAC)[DIVIDE]);ALL_TAC] + THEN GEN_TAC + THEN DISCH_TAC + THEN (SUBGOAL_TAC (` (h || (r*a + s*b))/\ (h || (r'*a+s'*b))`)) + THENL [((ASM MESON_TAC)[DIVIDE_SUM;DIVIDE_PROD]); + ((ASM MESON_TAC)[DIVIDE_SUMMAND])] + ) in + tac1 THENL [ygbranch THENL [ydivg_branch;gdivy_branch];yghyp_branch]);; + +(* Now compute gcd with CAML num calculations, + then check the answer in HOL-light *) +let gcd_num x1 x2 = + let rec gcd_data (a1,b1,x1,a2,b2,x2) = + if (x1 < (Int 0)) then + gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2) + else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num + b2,minus_num x2) + else if (x1 = (Int 0)) then (a2,b2,x2) + else if (x1>x2) then gcd_data (a2,b2,x2,a1,b1,x1) + else ( + let r = (quo_num x2 x1) in + gcd_data (a1,b1,x1,a2 -/ r*/ a1,b2 -/ r*/ b1, x2 -/ r*/ x1) + ) in + gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);; + +let gcd_num x1 x2 = + let rec gcd_data (a1,b1,x1,a2,b2,x2) = + if (x1 < (Int 0)) then + gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2) + else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num + b2,minus_num x2) + else if (x1 = (Int 0)) then (a2,b2,x2) + else if (x1>x2) then gcd_data (a2,b2,x2,a1,b1,x1) + else ( + let r = (quo_num x2 x1) in + gcd_data (a1,b1,x1,a2 -/ r*/ a1,b2 -/ r*/ b1, x2 -/ r*/ x1) + ) in + gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);; + + (* g = gcd, (a',b') = (a,b)/g, g +r1'*a+s1'*b = r1*a+s1*b *) +let gcd_numdata a b = + let a = abs_num a in + let b = abs_num b in + let Z = Int 0 in + let (r,s,g) = gcd_num a b in + let a' = if (g=Z) then Z else round_num(a//g) in + let b' = if (g=Z) then Z else round_num(b//g) in + let _ = if not(a=a'*/g) then failwith "GCD_CONV a" else 0 in + let _ = if not(b=b'*/g) then failwith "GCD_CONV b" else 0 in + let _ = if not(g=r*/a+/s*/b) then failwith "GCD_CONV g" else 0 in + let (r1,r1') = if (r >/ Z) then (r,Z) else (Z,minus_num r) in + let (s1,s1') = if (s >/ Z) then (s,Z) else (Z,minus_num s) in + (g,a,b,a',b',r1',s1',r1,s1);; + +(* Here is the conversion. + Example: + GCD_CONV (`66`) (`144`) + +*) +let GCD_CONV at bt = + let a = dest_numeral at in + let b = dest_numeral bt in + let (g,a,b,a',b',r1',s1',r1,s1) = gcd_numdata a b in + prove(parse_term("GCD "^(string_of_num a)^" "^(string_of_num b)^" = "^ + (string_of_num g)), + (MATCH_MP_TAC gcd_certificate) + THEN (EXISTS_TAC (mk_numeral r1)) + THEN (EXISTS_TAC (mk_numeral s1)) + THEN (EXISTS_TAC (mk_numeral r1')) + THEN (EXISTS_TAC (mk_numeral s1')) + THEN (EXISTS_TAC (mk_numeral a')) + THEN (EXISTS_TAC (mk_numeral b')) + THEN (ARITH_TAC));; + +(* Example: + hol_gcd 66 144 + + This version can overflow on CAML integers before it reaches hol-light. + Example: + hol_gcd 1000000000000000000 10000000000000000000000 + - : thm = |- GCD 660865024 843055104 = 262144 +*) + +let hol_gcd a b = GCD_CONV (mk_small_numeral a) (mk_small_numeral b);; + +remove_interface ("||");; +pop_priority();; + + +(* test code *) + +exception Test_suite_num_ext_gcd of string;; + +(* For the tests we use integers a and b. These can overflow if + a and b are too large, so that we should confine ourselves to + tests that are not too large. +*) + +let test_num_ext_gcd (a, b) = + let a1 = string_of_int (abs a) in + let b1 = string_of_int (abs b) in + let c = gcd a b in + let c1 = string_of_int (abs c) in + let th = GCD_CONV (mk_small_numeral a) (mk_small_numeral b) in + if (not (hyp th = ([]:term list))) then raise + (failwith ("num_ext_gcd test suite failure "^a1^" "^b1)) + else if (not (concl th = (parse_term ("GCD "^a1^" "^b1^"="^c1)))) + then raise (failwith ("num_ext_gcd test suite failure "^a1^" "^b1)) + else ();; + + +let test_suite_num_ext_gcd = + let _ = + map test_num_ext_gcd + [(0,0);(0,1);(1,0);(-0,-0); + (2,3);(4,6); + (0,2);(2,0); + (10,100);(100,10);(17,100);(100,17)] in + print_string "num_ext_gcd loaded\n";; + +let divide = DIVIDE and + gcd = GCD and + gcd_conv = GCD_CONV;; + diff --git a/Jordan/num_ext_nabs.ml b/Jordan/num_ext_nabs.ml new file mode 100644 index 0000000..0ebedc6 --- /dev/null +++ b/Jordan/num_ext_nabs.ml @@ -0,0 +1,96 @@ +unambiguous_interface();; + +let INT_NUM = prove(`!u. (integer (real_of_num u))`, + (REWRITE_TAC[is_int]) THEN GEN_TAC THEN + (EXISTS_TAC (`u:num`)) THEN (MESON_TAC[]));; + +let INT_NUM_REAL = prove(`!u. (real_of_int (int_of_num u) = real_of_num u)`, + (REWRITE_TAC[int_of_num]) THEN + GEN_TAC THEN (MESON_TAC[INT_NUM;int_rep]));; + +let INT_IS_INT = prove(`!(a:int). (integer (real_of_int a))`, + REWRITE_TAC[int_rep;int_abstr]);; + +let INT_OF_NUM_DEST = prove(`!a n. ((real_of_int a = (real_of_num n)) = + (a = int_of_num n))`, + (REWRITE_TAC[int_eq]) + THEN (REPEAT GEN_TAC) + THEN (REWRITE_TAC[int_of_num]) + THEN (ASSUME_TAC (SPEC (`n:num`) INT_NUM)) + THEN (UNDISCH_EL_TAC 0) + THEN (SIMP_TAC[int_rep]));; + +let INT_REP = prove(`!a. ?n m. (a = (int_of_num n) - (int_of_num m))`, + GEN_TAC + THEN (let tt =(REWRITE_RULE[is_int] (SPEC (`a:int`) INT_IS_INT)) in + (CHOOSE_TAC tt)) + THEN (POP_ASSUM DISJ_CASES_TAC) + THENL [ + (EXISTS_TAC (`n:num`)) THEN (EXISTS_TAC (`0`)) THEN + (ASM_REWRITE_TAC[INT_SUB_RZERO;GSYM INT_OF_NUM_DEST]); + (EXISTS_TAC (`0`)) THEN (EXISTS_TAC (`n:num`)) THEN + (REWRITE_TAC[INT_SUB_LZERO]) THEN + (UNDISCH_EL_TAC 0) THEN + (REWRITE_TAC[GSYM REAL_NEG_EQ;GSYM INT_NEG_EQ;GSYM int_neg_th;GSYM + INT_OF_NUM_DEST])]);; + +let INT_REP2 = prove( `!a. ?n. ((a = (&: n)) \/ (a = (--: (&: n))))`, +(GEN_TAC) + THEN ((let tt =(REWRITE_RULE[is_int] (SPEC (`a:int`) INT_IS_INT)) in + (CHOOSE_TAC tt))) + THEN ((POP_ASSUM DISJ_CASES_TAC)) + THENL + [ ((EXISTS_TAC (`n:num`))) + THEN ((ASM_REWRITE_TAC[GSYM INT_OF_NUM_DEST])); + ((EXISTS_TAC (`n:num`))) + (* THEN ((RULE_EL 0 (REWRITE_RULE[GSYM REAL_NEG_EQ;GSYM int_neg_th]))) *) + THEN (H_REWRITE_RULE[THM (GSYM REAL_NEG_EQ);THM (GSYM int_neg_th)] (HYP_INT 0)) + THEN ((ASM_REWRITE_TAC[GSYM INT_NEG_EQ;GSYM INT_OF_NUM_DEST]))]);; + + + +(* ------------------------------------------------------------------ *) +(* nabs : int -> num gives the natural number abs. value of an int *) +(* ------------------------------------------------------------------ *) + + +let nabs = new_definition(`nabs n = @u. ((n = int_of_num u) \/ (n = + int_neg (int_of_num u)))`);; + +let NABS_POS = prove(`!u. (nabs (int_of_num u)) = u`, + GEN_TAC + THEN (REWRITE_TAC [nabs]) + THEN (MATCH_MP_TAC SELECT_UNIQUE) + THEN (GEN_TAC THEN BETA_TAC) + THEN (EQ_TAC) + THENL [(TAUT_TAC (` ((A==>C)/\ (B==>C)) ==> (A\/B ==>C) `)); + MESON_TAC[]] + THEN CONJ_TAC THENL + (let branch2 = (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL]) + THEN (REWRITE_TAC[prove (`! u y.(((real_of_num u) = --(real_of_num y))= + ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)]) + THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ]) + THEN (MESON_TAC[ADD_EQ_0]) in + [(REWRITE_TAC[int_eq;INT_NUM_REAL]);branch2]) + THEN (REWRITE_TAC[INT_NUM_REAL]) + THEN (MESON_TAC[REAL_OF_NUM_EQ]));; + +let NABS_NEG = prove(`!n. (nabs (-- (int_of_num n))) = n`, + GEN_TAC + THEN (REWRITE_TAC [nabs]) + THEN (MATCH_MP_TAC SELECT_UNIQUE) + THEN (GEN_TAC THEN BETA_TAC) + THEN (EQ_TAC) + THENL [(TAUT_TAC (` ((A==>C)/\ (B==>C)) ==> (A\/B ==>C) `)); + MESON_TAC[]] + THEN CONJ_TAC THENL + (let branch1 = (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL]) + THEN (REWRITE_TAC[prove (`! u y.((--(real_of_num u) = (real_of_num y))= + ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)]) + THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ]) + THEN (MESON_TAC[ADD_EQ_0]) in + [branch1;(REWRITE_TAC[int_eq;INT_NUM_REAL])]) + THEN (REWRITE_TAC[INT_NUM_REAL;int_neg_th;REAL_NEG_EQ;REAL_NEGNEG]) + THEN (MESON_TAC[REAL_OF_NUM_EQ]));; + + diff --git a/Jordan/parse_ext_override_interface.ml b/Jordan/parse_ext_override_interface.ml new file mode 100644 index 0000000..10d1a2d --- /dev/null +++ b/Jordan/parse_ext_override_interface.ml @@ -0,0 +1,204 @@ +(* + Author: Thomas C. Hales + + As a new user of HOL-light, I have had a difficult time distinguishing + between the different uses of overloaded operators such as + (+), ( * ), (abs) (&), and so forth. + + Their interpretation is context dependent, according to which of + prioritize_num, prioritize_int, and prioritize_real was most + recently called. + + This file removes all ambiguities in notation. + Following the usage of CAML, we append a dot to operations on real + numbers so that addition is (+.), etc. + + In the same way, we remove ambiguities between natural numbers and + integers by appending a character. We have chosen to use + the character `|` for natural number operations + and the character `:` for integer operations. + + The character `&` continues to denote the embedding of + natural numbers into the integers or reals. + + HOL-light parsing does not permit an operator mixing alphanumeric + characters with symbols. Thus, we were not able to use (abs.) + and (abs:) for the absolute value. Instead we adapt the usual notation + |x| for absolute value and write it in prefix notation ||: and + ||. for the integer and real absolute value functions respectively. + + In deference to HOL-light notation, we use ** for the exponential + function. There are three versions: ( **| ), ( **: ), and ( **. ). + +*) + +(* natural number operations *) + + + +let unambiguous_interface() = +parse_as_infix("+|",(16,"right")); +parse_as_infix("-|",(18,"left")); +parse_as_infix("*|",(20,"right")); +parse_as_infix("**|",(24,"left")); (* EXP *) +parse_as_infix("/|",(22,"right")); (* DIV *) +parse_as_infix("%|",(22,"left")); (* MOD *) +parse_as_infix("<|",(12,"right")); +parse_as_infix("<=|",(12,"right")); +parse_as_infix(">|",(12,"right")); +parse_as_infix(">=|",(12,"right")); +override_interface("+|",`(+):num->(num->num)`); +override_interface("-|",`(-):num->(num->num)`); +override_interface("*|",`( * ):num->(num->num)`); +override_interface("**|",`(EXP):num->(num->num)`); +override_interface("/|",`(DIV):num->(num->num)`); +override_interface("%|",`(MOD):num->(num->num)`); +override_interface("<|",`(<):num->(num->bool)`); +override_interface("<=|",`(<=):num->(num->bool)`); +override_interface(">|",`(>):num->(num->bool)`); +override_interface(">=|",`(>=):num->(num->bool)`); +(* integer operations *) +parse_as_infix("+:",(16,"right")); +parse_as_infix("-:",(18,"left")); +parse_as_infix("*:",(20,"right")); +parse_as_infix("**:",(24,"left")); +parse_as_infix("<:",(12,"right")); +parse_as_infix("<=:",(12,"right")); +parse_as_infix(">:",(12,"right")); +parse_as_infix(">=:",(12,"right")); +override_interface("+:",`int_add:int->int->int`); +override_interface("-:",`int_sub:int->int->int`); +override_interface("*:",`int_mul:int->int->int`); +override_interface("**:",`int_pow:int->num->int`); +(* boolean *) +override_interface("<:",`int_lt:int->int->bool`); +override_interface("<=:",`int_le:int->int->bool`); +override_interface(">:",`int_gt:int->int->bool`); +override_interface(">=:",`int_ge:int->int->bool`); +(* unary *) +override_interface("--:",`int_neg:int->int`); +override_interface("&:",`int_of_num:num->int`); +override_interface("||:",`int_abs:int->int`); +(* real number operations *) +parse_as_infix("+.",(16,"right")); +parse_as_infix("-.",(18,"left")); +parse_as_infix("*.",(20,"right")); +parse_as_infix("**.",(24,"left")); +parse_as_infix("<.",(12,"right")); +parse_as_infix("<=.",(12,"right")); +parse_as_infix(">.",(12,"right")); +parse_as_infix(">=.",(12,"right")); +override_interface("+.",`real_add:real->real->real`); +override_interface("-.",`real_sub:real->real->real`); +override_interface("*.",`real_mul:real->real->real`); +override_interface("**.",`real_pow:real->num->real`); +(* boolean *) +override_interface("<.",`real_lt:real->real->bool`); +override_interface("<=.",`real_le:real->real->bool`); +override_interface(">.",`real_gt:real->real->bool`); +override_interface(">=.",`real_ge:real->real->bool`); +(* unary *) +override_interface("--.",`real_neg:real->real`); +override_interface("&.",`real_of_num:num->real`); +override_interface("||.",`real_abs:real->real`);; + +let ambiguous_interface() = +reduce_interface("+|",`(+):num->(num->num)`); +reduce_interface("-|",`(-):num->(num->num)`); +reduce_interface("*|",`( * ):num->(num->num)`); +reduce_interface("**|",`(EXP):num->(num->num)`); +reduce_interface("/|",`(DIV):num->(num->num)`); +reduce_interface("%|",`(MOD):num->(num->num)`); +reduce_interface("<|",`(<):num->(num->bool)`); +reduce_interface("<=|",`(<=):num->(num->bool)`); +reduce_interface(">|",`(>):num->(num->bool)`); +reduce_interface(">=|",`(>=):num->(num->bool)`); +(* integer operations *) +reduce_interface("+:",`int_add:int->int->int`); +reduce_interface("-:",`int_sub:int->int->int`); +reduce_interface("*:",`int_mul:int->int->int`); +reduce_interface("**:",`int_pow:int->num->int`); +(* boolean *) +reduce_interface("<:",`int_lt:int->int->bool`); +reduce_interface("<=:",`int_le:int->int->bool`); +reduce_interface(">:",`int_gt:int->int->bool`); +reduce_interface(">=:",`int_ge:int->int->bool`); +(* unary *) +reduce_interface("--:",`int_neg:int->int`); +reduce_interface("&:",`int_of_num:num->int`); +reduce_interface("||:",`int_abs:int->int`); +(* real *) +reduce_interface("+.",`real_add:real->real->real`); +reduce_interface("-.",`real_sub:real->real->real`); +reduce_interface("*.",`real_mul:real->real->real`); +reduce_interface("**.",`real_pow:real->num->real`); +(* boolean *) +reduce_interface("<.",`real_lt:real->real->bool`); +reduce_interface("<=.",`real_le:real->real->bool`); +reduce_interface(">.",`real_gt:real->real->bool`); +reduce_interface(">=.",`real_ge:real->real->bool`); +(* unary *) +reduce_interface("--.",`real_neg:real->real`); +reduce_interface("&.",`real_of_num:num->real`); +reduce_interface("||.",`real_abs:real->real`);; + +(* add to Harrison's priorities the functions pop_priority and get_priority *) +let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = + let v = ref ([]:string list) in + let prioritize_int() = + v:= "int"::!v; + overload_interface ("+",`int_add:int->int->int`); + overload_interface ("-",`int_sub:int->int->int`); + overload_interface ("*",`int_mul:int->int->int`); + overload_interface ("<",`int_lt:int->int->bool`); + overload_interface ("<=",`int_le:int->int->bool`); + overload_interface (">",`int_gt:int->int->bool`); + overload_interface (">=",`int_ge:int->int->bool`); + overload_interface ("--",`int_neg:int->int`); + overload_interface ("pow",`int_pow:int->num->int`); + overload_interface ("abs",`int_abs:int->int`); + override_interface ("&",`int_of_num:num->int`) and + prioritize_num() = + v:= "num"::!v; + overload_interface ("+",`(+):num->num->num`); + overload_interface ("-",`(-):num->num->num`); + overload_interface ("*",`(*):num->num->num`); + overload_interface ("<",`(<):num->num->bool`); + overload_interface ("<=",`(<=):num->num->bool`); + overload_interface (">",`(>):num->num->bool`); + overload_interface (">=",`(>=):num->num->bool`) and + prioritize_real() = + v:= "real"::!v; + overload_interface ("+",`real_add:real->real->real`); + overload_interface ("-",`real_sub:real->real->real`); + overload_interface ("*",`real_mul:real->real->real`); + overload_interface ("/",`real_div:real->real->real`); + overload_interface ("<",`real_lt:real->real->bool`); + overload_interface ("<=",`real_le:real->real->bool`); + overload_interface (">",`real_gt:real->real->bool`); + overload_interface (">=",`real_ge:real->real->bool`); + overload_interface ("--",`real_neg:real->real`); + overload_interface ("pow",`real_pow:real->num->real`); + overload_interface ("inv",`real_inv:real->real`); + overload_interface ("abs",`real_abs:real->real`); + override_interface ("&",`real_of_num:num->real`) and + pop_priority() = + if (length !v <= 1) then (print_string "priority unchanged\n") else + let (a::b::c) = !v in + v:= (b::c); + print_string ("priority is now "^b^"\n"); + match a with + "num" -> prioritize_num() | + "int" -> prioritize_int() | + "real"-> prioritize_real()| + _ -> () and + get_priority() = + if (!v=[]) then "unknown" else + let (a::b) = !v in a + in + prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority;; + + + + + diff --git a/Jordan/real_ext.ml b/Jordan/real_ext.ml new file mode 100644 index 0000000..2fccc26 --- /dev/null +++ b/Jordan/real_ext.ml @@ -0,0 +1,218 @@ + + + + +(* ------------------------------------------------------------------ *) +(* Theorems that construct and propagate equality and inequality *) +(* ------------------------------------------------------------------ *) + +(* ------------------------------------------------------------------ *) +(* Propagation of =EQUAL= *) +(* ------------------------------------------------------------------ *) + +unambiguous_interface();; +prioritize_num();; + +let REAL_MUL_LTIMES = prove (`!x a b. (x*.a = x*.b) ==> (~(x=(&.0))) ==> (a =b)`, + MESON_TAC[REAL_EQ_MUL_LCANCEL]);; + +let REAL_MUL_RTIMES = prove (`!x a b. (a*.x = b*.x) ==> (~(x=(&.0))) ==> (a =b)`, + MESON_TAC[REAL_EQ_MUL_RCANCEL]);; + +let REAL_PROP_EQ_LMUL = REAL_MUL_LTIMES;; +let REAL_PROP_EQ_RMUL = REAL_MUL_RTIMES;; + +let REAL_PROP_EQ_LMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * y = x * z) = (x = &0) \/ (y = z) *);; +let REAL_PROP_EQ_RMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * z = y * z) = (x = y) \/ (z = &0) *);; +(* see also minor variations REAL_LT_LMUL_EQ, REAL_LT_RMUL_EQ *) + +let REAL_PROP_EQ_SQRT = SQRT_INJ;; (* |- !x y. &0 <= x /\ &0 <= y ==> ((sqrt x = sqrt y) = x = y) *) + +(* ------------------------------------------------------------------ *) +(* Construction of <=. *) +(* ------------------------------------------------------------------ *) +let REAL_MK_LE_SQUARE = REAL_LE_SQUARE_POW ;; (* |- !x. &0 <= x pow 2 *) + +(* ------------------------------------------------------------------ *) +(* Propagation of <=. *) +(* ------------------------------------------------------------------ *) + +let REAL_MUL_LTIMES_LE = prove (`!x a b. (x*.a <=. x*.b) ==> (&.0 < x) ==> (a <=. b)`, + MESON_TAC[REAL_LE_LMUL_EQ]);; + (* virtually identical to REAL_LE_LCANCEL_IMP, REAL_LE_LMUL_EQ *) + +let REAL_MUL_RTIMES_LE = prove (`!x a b. (a*.x <=. b*.x) ==> (&.0 < x) ==> (a <=. b)`, + MESON_TAC[REAL_LE_RMUL_EQ]);; + (* virtually identical to REAL_LE_RCANCEL_IMP, REAL_LE_RMUL_EQ *) + +let REAL_PROP_LE_LCANCEL = REAL_MUL_LTIMES_LE;; +let REAL_PROP_LE_RCANCEL = REAL_MUL_RTIMES_LE;; +let REAL_PROP_LE_LMUL = REAL_LE_LMUL (* |- !x y z. &0 <= x /\ y <= z ==> x * y <= x * z *);; +let REAL_PROP_LE_RMUL = REAL_LE_RMUL (* |- !x y z. x <= y /\ &0 <= z ==> x * z <= y * z *);; +let REAL_PROP_LE_LRMUL = REAL_LE_MUL2;; (* |- !w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z ==> w * y <= x * z *) +let REAL_PROP_LE_POW = POW_LE;; (* |- !n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n *) +let REAL_PROP_LE_SQRT = SQRT_MONO_LE_EQ;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x <= sqrt y = x <= y) *) + +(* ------------------------------------------------------------------ *) +(* Construction of LT *) +(* ------------------------------------------------------------------ *) + +let REAL_MK_LT_SQUARE = REAL_LT_SQUARE;; (* |- !x. &0 < x * x = ~(x = &0) *) + +(* ------------------------------------------------------------------ *) +(* Propagation of LT *) +(* ------------------------------------------------------------------ *) + +let REAL_PROP_LT_LCANCEL = REAL_LT_LCANCEL_IMP (* |- !x y z. &0 < x /\ x * y < x * z ==> y < z *);; +let REAL_PROP_LT_RCANCEL = REAL_LT_RCANCEL_IMP (* |- !x y z. &0 < z /\ x * z < y * z ==> x < y *);; +let REAL_PROP_LT_LMUL = REAL_LT_LMUL (* |- !x y z. &0 < x /\ y < z ==> x * y < x * z *);; +let REAL_PROP_LT_RMUL = REAL_LT_RMUL (* |- !x y z. x < y /\ &0 < z ==> x * z < y * z *);; +(* minor variation REAL_LT_LMUL_IMP, REAL_LT_RMUL_IMP *) + +let REAL_PROP_LT_LRMUL= REAL_LT_MUL2;; (* |- !w x y z. &0 <= w /\ w < x /\ &0 <= y /\ y < z ==> w * y < x * z *) +let REAL_PROP_LT_SQRT = SQRT_MONO_LT_EQ;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x < sqrt y = x < y) *) + +(* ------------------------------------------------------------------ *) +(* Constructors of Non-negative *) +(* ------------------------------------------------------------------ *) + +let REAL_MK_NN_SQUARE = REAL_LE_SQUARE;; (* |- !x. &0 <= x * x *) +let REAL_MK_NN_ABS = ABS_POS;; (* |- !x. &0 <= abs x *) + +(* ------------------------------------------------------------------ *) +(* Propagation of Non-negative *) +(* ------------------------------------------------------------------ *) + +let REAL_PROP_NN_POS = prove(`! x y. x<. y ==> x <= y`,MESON_TAC[REAL_LT_LE]);; +let REAL_PROP_NN_ADD2 = REAL_LE_ADD (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x + y *);; +let REAL_PROP_NN_DOUBLE = REAL_LE_DOUBLE (* |- !x. &0 <= x + x <=> &0 <= x *);; +let REAL_PROP_NN_RCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. y*.x ==> ((&.0) <=. y)`, + MESON_TAC[REAL_PROP_LE_RCANCEL;REAL_MUL_LZERO]);; +let REAL_PROP_NN_LCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. x*.y ==> ((&.0) <=. y)`, + MESON_TAC[REAL_PROP_LE_LCANCEL;REAL_MUL_RZERO]);; +let REAL_PROP_NN_MUL2 = REAL_LE_MUL (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x * y *);; +let REAL_PROP_NN_POW = REAL_POW_LE (* |- !x n. &0 <= x ==> &0 <= x pow n *);; +let REAL_PROP_NN_SQUARE = REAL_LE_POW_2;; (* |- !x. &0 <= x pow 2 *) +let REAL_PROP_NN_SQRT = SQRT_POS_LE;; (* |- !x. &0 <= x ==> &0 <= sqrt x *) +let REAL_PROP_NN_INV = REAL_LE_INV_EQ (* |- !x. &0 <= inv x = &0 <= x *);; +let REAL_PROP_NN_SIN = SIN_POS_PI_LE;; (* |- !x. &0 <= x /\ x <= pi ==> &0 <= sin x *) +let REAL_PROP_NN_ATN = ATN_POS_LE;; (* |- &0 <= atn x = &0 <= x *) + + +(* ------------------------------------------------------------------ *) +(* Constructor of POS *) +(* ------------------------------------------------------------------ *) + +let REAL_MK_POS_ABS = REAL_ABS_NZ (* |- !x. ~(x = &0) = &0 < abs x *);; +let REAL_MK_POS_EXP = REAL_EXP_POS_LT;; (* |- !x. &0 < exp x *) +let REAL_MK_POS_LN = LN_POS_LT;; (* |- !x. &1 < x ==> &0 < ln x *) +let REAL_MK_POS_PI = PI_POS;; (* |- &0 < pi *) + + +(* ------------------------------------------------------------------ *) +(* Propagation of POS *) +(* ------------------------------------------------------------------ *) + +let REAL_PROP_POS_ADD2 = REAL_LT_ADD (* |- !x y. &0 < x /\ &0 < y ==> &0 < x + y *);; +let REAL_PROP_POS_LADD = REAL_LET_ADD (* |- !x y. &0 <= x /\ &0 < y ==> &0 < x + y *);; +let REAL_PROP_POS_RADD = REAL_LTE_ADD (* |- !x y. &0 < x /\ &0 <= y ==> &0 < x + y *);; +let REAL_PROP_POS_LMUL = REAL_LT_LMUL_0;; (* |- !x y. &0 < x ==> (&0 < x * y = &0 < y) *) +let REAL_PROP_POS_RMUL = REAL_LT_RMUL_0;; (* |- !x y. &0 < y ==> (&0 < x * y = &0 < x) *) +let REAL_PROP_POS_MUL2 = REAL_LT_MUL (* |- !x y. &0 < x /\ &0 < y ==> &0 < x * y *);; +let REAL_PROP_POS_SQRT = SQRT_POS_LT;; (* |- !x. &0 < x ==> &0 < sqrt x *) +let REAL_PROP_POS_POW = REAL_POW_LT (* |- !x n. &0 < x ==> &0 < x pow n *);; +let REAL_PROP_POS_INV = REAL_LT_INV (* |- !x. &0 < x ==> &0 < inv x *);; +let REAL_PROP_POS_SIN = SIN_POS_PI;; (* |- !x. &0 < x /\ x < pi ==> &0 < sin x *) +let REAL_PROP_POS_TAN = TAN_POS_PI2;; (* |- !x. &0 < x /\ x < pi / &2 ==> &0 < tan x *) +let REAL_PROP_POS_ATN = ATN_POS_LT;; (* |- &0 < atn x = &0 < x *) + +(* ------------------------------------------------------------------ *) +(* Construction of NZ *) +(* ------------------------------------------------------------------ *) + +(* renamed from REAL_MK_NZ_OF_POS *) +let REAL_MK_NZ_POS = REAL_POS_NZ (* |- !x. &0 < x ==> ~(x = &0) *);; +let REAL_MK_NZ_EXP = REAL_EXP_NZ;; (* |- !x. ~(exp x = &0) *) + +(* ------------------------------------------------------------------ *) +(* Propagation of NZ *) +(* ------------------------------------------------------------------ *) + +(* renamed from REAL_ABS_NZ, moved from float.ml *) +let REAL_PROP_NZ_ABS = prove(`!x. (~(x = (&.0))) ==> (~(abs(x) = (&.0)))`, + REWRITE_TAC[ABS_ZERO]);; +let REAL_PROP_NZ_POW = REAL_POW_NZ (* |- !x n. ~(x = &0) ==> ~(x pow n = &0) *);; +let REAL_PROP_NZ_INV = REAL_INV_NZ;; (* |- !x. ~(x = &0) ==> ~(inv x = &0) *) + + +(* ------------------------------------------------------------------ *) +(* Propagation of ZERO *) +(* ------------------------------------------------------------------ *) + +let REAL_PROP_ZERO_ABS = REAL_ABS_ZERO (* |- !x. (abs x = &0) = x = &0); *);; +let REAL_PROP_ZERO_NEG = REAL_NEG_EQ_0 ;; (* |- !x. (--x = &0) = x = &0 *) +let REAL_PROP_ZERO_INV = REAL_INV_EQ_0 (* |- !x. (inv x = &0) = x = &0 *);; +let REAL_PROP_ZERO_NEG = REAL_NEG_EQ0;; (* |- !x. (--x = &0) = x = &0 *) +let REAL_PROP_ZERO_SUMSQ = REAL_SUMSQ;; (* |- !x y. (x * x + y * y = &0) = (x = &0) /\ (y = &0) *) +let REAL_PROP_ZERO_POW = REAL_POW_EQ_0;; (* |- !x n. (x pow n = &0) = (x = &0) /\ ~(n = 0) *) +let REAL_PROP_ZERO_SQRT = SQRT_EQ_0;; (* |- !x. &0 <= x ==> (x / sqrt x = sqrt x) *) + +(* ------------------------------------------------------------------ *) +(* Special values of functions *) +(* ------------------------------------------------------------------ *) + +let REAL_SV_LADD_0 = REAL_ADD_LID (* |- !x. &0 + x = x); *);; +let REAL_SV_INV_0 = REAL_INV_0 (* |- inv (&0) = &0 *);; +let REAL_SV_RMUL_0 = REAL_MUL_RZERO (* |- !x. x * &0 = &0 *);; +let REAL_SV_LMUL_0 = REAL_MUL_LZERO (* |- !x. &0 * x = &0 *);; +let REAL_SV_NEG_0 = REAL_NEG_0 (* |- -- &0 = &0 *);; +let REAL_SV_ABS_0 = REAL_ABS_0 (* |- abs (&0) = &0 *);; +let REAL_SV_EXP_0 = REAL_EXP_0;; (* |- exp (&0) = &1 *) +let REAL_SV_LN_1 = LN_1;; (* |- ln (&1) = &0 *) +let REAL_SV_SQRT_0 = SQRT_0;; (* |- sqrt (&0) = &0 *) +let REAL_SV_TAN_0 = TAN_0;; (* |- tan (&0) = &0 *) +let REAL_SV_TAN_PI = TAN_PI;; (* |- tan pi = &0 *) + +(* ------------------------------------------------------------------ *) +(* A tactic that multiplies a real on the left *) +(* ------------------------------------------------------------------ *) + +(** +#g `a:real = b:real`;; +#e (REAL_LMUL_TAC `c:real`);; +it : goalstack = 2 subgoals (2 total) +`~(c = &0)` + +`c * a = c * b` + + 0 [`~(c = &0)`] +# +**) +(* ------------------------------------------------------------------ *) + + + +let REAL_LMUL_TAC t = + let REAL_MUL_LTIMES = + prove ((`!x a b. + (((~(x=(&0)) ==> (x*a = x*b)) /\ ~(x=(&0))) ==> (a = b))`), + MESON_TAC[REAL_EQ_MUL_LCANCEL]) in + (MATCH_MP_TAC (SPEC t REAL_MUL_LTIMES)) + THEN CONJ_TAC + THENL [DISCH_TAC; ALL_TAC];; + +(* ------------------------------------------------------------------ *) +(* Right multiply by a real *) +(* ------------------------------------------------------------------ *) + +let REAL_RMUL_TAC t = + let REAL_MUL_RTIMES = + prove (`!x a b. + ((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==> (a = b)`, + MESON_TAC[REAL_EQ_MUL_RCANCEL]) in + (MATCH_MP_TAC (SPEC t REAL_MUL_RTIMES)) + THEN CONJ_TAC + THENL [DISCH_TAC; ALL_TAC];; + + +pop_priority();; diff --git a/Jordan/real_ext_geom_series.ml b/Jordan/real_ext_geom_series.ml new file mode 100644 index 0000000..46e8565 --- /dev/null +++ b/Jordan/real_ext_geom_series.ml @@ -0,0 +1,49 @@ + +prioritize_real();; + +let (TRY_RULE:(thm->thm) -> (thm->thm)) = + fun rl t -> try (rl t) with _ -> t;; + + +let REAL_MUL_RTIMES = + prove ((`!x a b. + (((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==> (a = b))`), + MESON_TAC[REAL_EQ_MUL_RCANCEL]);; + + +let GEOMETRIC_SUM = prove( + `!m n x.(~(x=(&1)) ==> + (sum(m,n) (\k.(x pow k)) = ((x pow m) - (x pow (m+n)))/((&1)-x)))`, + let tac1 = + GEN_TAC + THEN INDUCT_TAC + THEN GEN_TAC + THEN DISCH_TAC + THEN (REWRITE_TAC + [sum_DEF;real_pow;ADD_CLAUSES;real_div;REAL_SUB_RDISTRIB; + REAL_SUB_REFL]) in + let tac2 = + (RULE_ASSUM_TAC (TRY_RULE (SPEC (`x:real`)))) + THEN (UNDISCH_EL_TAC 1) + THEN (UNDISCH_EL_TAC 0) + THEN (TAUT_TAC (`(A==>(B==>C)) ==> (A ==> ((A==>B) ==>C))`)) + THEN (REPEAT DISCH_TAC) + THEN (ASM_REWRITE_TAC[real_div]) + THEN (ABBREV_TAC (`a:real = x pow m`)) + THEN (ABBREV_TAC (`b:real = x pow (m+n)`)) in + let tac3 = + (MATCH_MP_TAC (SPEC (`&1 - x`) REAL_MUL_RTIMES)) + THEN CONJ_TAC + THENL [ALL_TAC; (UNDISCH_TAC (`~(x = (&1))`)) + THEN (ACCEPT_TAC (REAL_ARITH (`~(x=(&1)) ==> ~((&1 - x = (&0)))`)))] + THEN (REWRITE_TAC + [GSYM REAL_MUL_ASSOC;REAL_ADD_RDISTRIB;REAL_SUB_RDISTRIB]) + THEN (SIMP_TAC[REAL_MUL_LINV]) + THEN DISCH_TAC + THEN (REWRITE_TAC + [REAL_SUB_LDISTRIB;REAL_MUL_LID;REAL_MUL_RID;REAL_MUL_ASSOC]) + THEN (ACCEPT_TAC (REAL_ARITH (`a - b + b - b*x = a - x*b`))) in + (tac1 THEN tac2 THEN tac3));; + + +pop_priority();; diff --git a/Jordan/tactics_ext.ml b/Jordan/tactics_ext.ml new file mode 100644 index 0000000..7d96e89 --- /dev/null +++ b/Jordan/tactics_ext.ml @@ -0,0 +1,203 @@ +(* This file is in severe need of a rewrite! *) + +unambiguous_interface();; +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* A printer that reverses the assumption list *) +(* ------------------------------------------------------------------------- *) + +(* + + Objective version of HOL-light uses (rev asl) in the method print_goal. + This means that the numbers printed next to the assumptions + are the reverse of the numbering in the list. + + I want it the opposite way. + This reverses the numbering on the assumption list, + so that the printed numbers match the list order. + + To use, type + #install_printer print_rev_goal;; + #install_printer print_rev_goalstack;; + + To restore HOL-light defaults, type + #install_printer print_goal;; + #install_printer print_goalstack;; + +*) + +let (print_rev_goal:goal->unit) = + fun (asl,w) -> + print_newline(); + if asl <> [] then (print_hyps 0 (asl); print_newline()) else (); + print_qterm w; print_newline();; + +let (print_rev_goalstate:int->goalstate->unit) = + fun k gs -> let (_,gl,_) = gs in + let n = length gl in + let s = if n = 0 then "No subgoals" else + (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") + ^" ("^(string_of_int n)^" total)" in + print_string s; print_newline(); + if gl = [] then () else + do_list (print_rev_goal o C el gl) (rev(0--(k-1)));; + +let (print_rev_goalstack:goalstack->unit) = + fun l -> + if l = [] then print_string "Empty goalstack" + else if tl l = [] then + let (_,gl,_ as gs) = hd l in + print_rev_goalstate 1 gs + else + let (_,gl,_ as gs) = hd l + and (_,gl0,_) = hd(tl l) in + let p = length gl - length gl0 in + let p' = if p < 1 then 1 else p + 1 in + print_rev_goalstate p' gs;; + +#install_printer print_rev_goal;; +#install_printer print_rev_goalstack;; + + + + +(* ------------------------------------------------------------------ *) +(* SOME EASY TACTICS *) +(* ------------------------------------------------------------------ *) + +let TAUT_TAC t = (MATCH_MP_TAC (TAUT t));; + +let REP_GEN_TAC = REPEAT GEN_TAC;; + +let SUBGOAL_TAC t = SUBGOAL_THEN t MP_TAC;; + +let DISCH_ALL_TAC = REP_GEN_TAC THEN + let tac = TAUT_TAC `(b ==> a==> c) ==> (a /\ b ==> c)` in + (REPEAT ((REPEAT tac) THEN DISCH_TAC)) THEN LABEL_ALL_TAC;; + +(* ------------------------------------------------------------------ *) +(* TACTICS BY NUMBER. These are probably best avoided. + NB: + The numbering is that in the asm list -- not the printed numbers! *) +(* ------------------------------------------------------------------ *) + +let (UNDISCH_EL_TAC:int -> tactic) = + fun i (asl,w) -> + try let sthm,asl' = (el i asl),(drop i asl) in + let tm = concl (snd (el i asl)) in + let thm = snd sthm in + null_meta,[asl',mk_imp(tm,w)], + fun i [th] -> MP th (INSTANTIATE_ALL i thm) + with Failure _ -> failwith "UNDISCH_EL_TAC";; + +(* remove hypotheses by number *) +let rec (POPL_TAC:int list ->tactic) = + let (POP_TAC:int->tactic) = + fun i -> (UNDISCH_EL_TAC i) THEN (TAUT_TAC `B ==> (A==>B)`) in + let renumber i = + map(fun j -> if j<=i then j else (j-1)) in + function [] -> ALL_TAC | + (i::b) -> (POP_TAC i) THEN (POPL_TAC (renumber i b));; + +let rec (UNDISCH_LIST:int list -> tactic) = + let renumber i = + map(fun j -> if j<=i then j else (j-1)) in + function [] -> ALL_TAC | + (i::b) -> (UNDISCH_EL_TAC i) THEN (UNDISCH_LIST (renumber i b));; + +(* ------------------------------------------------------------------ *) +(* Transformations of Hypothesis List by LABELS *) +(* ------------------------------------------------------------------ *) + +type goalthm = goal -> thm;; + +let (HYP_INT:int->goalthm) = + fun i-> + fun ((asl,_):goal) -> + snd (el i asl);; + +let (HYP:string->goalthm) = + fun s (asl,w) -> + try assoc s asl + with Failure _ -> assoc ("Z-"^s) asl;; + +let (THM:thm->goalthm) = + fun thm -> + fun (_:goal) -> thm;; + +let (H_RULER: (thm list->thm->thm)->(goalthm list)-> goalthm -> tactic) = + fun rule gthl gthm -> + fun ((asl,w) as g:goal) -> + let thl = map (fun x-> (x g)) gthl in + let th = rule thl (gthm g) in + ASSUME_TAC th g;; + +(* The next few term rules into goal_rules *) +(* H_type (x:type) should return an object + similar to x but with thms made into goalthms *) + +let (H_RULE_LIST: (thm list->thm->thm)->(goalthm list)-> goalthm -> goalthm) = + fun rule gthl gthm g -> + let thl = map (fun x-> (x g)) gthl in + rule thl (gthm g);; + +let H_RULE2 (rule:thm->thm->thm) = + fun gthm1 gthm2 -> H_RULE_LIST (fun thl th -> rule (hd thl) th) [gthm1] gthm2;; + +let H_RULE (rule:thm->thm) = fun gthm -> H_RULE_LIST (fun _ th -> rule th) [] gthm;; + +let (H_TTAC : thm_tactic -> goalthm -> tactic ) = + fun ttac gthm g -> (ttac (gthm g) g);; + +let H_ASSUME_TAC = H_TTAC ASSUME_TAC;; +let INPUT = fun gth -> (H_ASSUME_TAC gth) THEN LABEL_ALL_TAC;; + +let H_VAL2 (rule:thm->thm->thm) = + fun gthm1 gthm2 -> H_RULER (fun thl th -> rule (hd thl) th) [gthm1] gthm2;; + +let H_CONJ = H_VAL2(CONJ);; +let H_MATCH_MP = H_VAL2(MATCH_MP);; + +let H_REWRITE_RULE gthml gth = H_RULER REWRITE_RULE gthml gth;; +let H_ONCE_REWRITE_RULE gthml gth = H_RULER ONCE_REWRITE_RULE gthml gth;; +let H_SIMP_RULE = H_RULER SIMP_RULE;; + +let H_VAL (rule:thm->thm) = fun gthm -> H_RULER (fun _ th -> rule th) [] gthm;; +let H = H_VAL;; + +let H_CONJUNCT1 = H_VAL CONJUNCT1;; +let H_CONJUNCT2 = H_VAL CONJUNCT2;; +let H_EQT_INTRO = H_VAL EQT_INTRO;; +let H_EQT_ELIM = H_VAL EQT_ELIM;; +let H_SPEC = fun t -> H_VAL(SPEC t);; +let H_GEN = fun t -> H_VAL(GEN t);; +let H_DISJ1 = C (fun t -> H_VAL ((C DISJ1) t));; +let H_DISJ2 = (fun t -> H_VAL (( DISJ2) t));; + (* beware! One is inverted here. *) +let H_NOT_ELIM = H_VAL (NOT_ELIM);; +let H_NOT_INTRO = H_VAL (NOT_INTRO);; +let H_EQF_ELIM = H_VAL (EQF_ELIM);; +let H_EQF_INTRO = H_VAL (EQF_INTRO);; +let (&&&) = H_RULE2 CONJ;; + +let (H_UNDISCH_TAC:goalthm -> tactic) = + fun gthm g -> + let tm = concl(gthm g) in + UNDISCH_TAC tm g;; + + + +(* let upgs tac gs = by tac gs;; *) + +let (thm_op:goalthm->goalthm->goalthm) = + fun gt1 gt2 g -> + if (is_eq (snd (strip_forall (concl (gt1 g))))) + then REWRITE_RULE[gt1 g] (gt2 g) else + MATCH_MP (gt1 g) (gt2 g);; + +let (COMBO:goalthm list-> goalthm) = + fun gthl -> end_itlist thm_op gthl;; + +let INPUT_COMBO = INPUT o COMBO;; + diff --git a/Jordan/tactics_ext2.ml b/Jordan/tactics_ext2.ml new file mode 100644 index 0000000..989150b --- /dev/null +++ b/Jordan/tactics_ext2.ml @@ -0,0 +1,1486 @@ + +(* ------------------------------------------------------------------ *) +(* MORE RECENT ADDITIONS *) +(* ------------------------------------------------------------------ *) + + + +(* abbrev_type copied from definitions_group.ml *) + +let pthm = prove_by_refinement( + `(\ (x:A) .T) (@(x:A). T)`, + [BETA_TAC]);; + +let abbrev_type ty s = let (a,b) = new_basic_type_definition s + ("mk_"^s,"dest_"^s) + (INST_TYPE [ty,`:A`] pthm) in + let abst t = list_mk_forall ((frees t), t) in + let a' = abst (concl a) in + let b' = abst (rhs (concl b)) in + ( + prove_by_refinement(a',[REWRITE_TAC[a]]), + prove_by_refinement(b',[REWRITE_TAC[GSYM b]]));; + + +(* ------------------------------------------------------------------ *) +(* KILL IN *) +(* ------------------------------------------------------------------ *) + +let un = REWRITE_RULE[IN];; + +(* ------------------------------------------------------------------ *) + +let SUBCONJ_TAC = + MATCH_MP_TAC (TAUT `A /\ (A ==>B) ==> (A /\ B)`) THEN CONJ_TAC;; + +let PROOF_BY_CONTR_TAC = + MATCH_MP_TAC (TAUT `(~A ==> F) ==> A`) THEN DISCH_TAC;; + + + +(* ------------------------------------------------------------------ *) +(* some general tactics *) +(* ------------------------------------------------------------------ *) + +(* before adding assumption to hypothesis list, cleanse it + of unnecessary conditions *) + + +let CLEAN_ASSUME_TAC th = + MP_TAC th THEN ASM_REWRITE_TAC[] THEN DISCH_TAC;; + +let CLEAN_THEN th ttac = + MP_TAC th THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ttac;; + +(* looks for a hypothesis by matching a subterm *) +let (UNDISCH_FIND_TAC: term -> tactic) = + fun tm (asl,w) -> + let p = can (term_match[] tm) in + try let sthm,_ = remove + (fun (_,asm) -> can (find_term p) (concl ( asm))) asl in + UNDISCH_TAC (concl (snd sthm)) (asl,w) + with Failure _ -> failwith "UNDISCH_FIND_TAC";; + +let (UNDISCH_FIND_THEN: term -> thm_tactic -> tactic) = + fun tm ttac (asl,w) -> + let p = can (term_match[] tm) in + try let sthm,_ = remove + (fun (_,asm) -> can (find_term p) (concl ( asm))) asl in + UNDISCH_THEN (concl (snd sthm)) ttac (asl,w) + with Failure _ -> failwith "UNDISCH_FIND_TAC";; + +(* ------------------------------------------------------------------ *) +(* NAME_CONFLICT_TAC : eliminate name conflicts in a term *) +(* ------------------------------------------------------------------ *) + +let relabel_bound_conv tm = + let rec vars_and_constants tm acc = + match tm with + | Var _ -> tm::acc + | Const _ -> tm::acc + | Comb(a,b) -> vars_and_constants b (vars_and_constants a acc) + | Abs(a,b) -> a::(vars_and_constants b acc) in + let relabel_bound tm = + match tm with + | Abs(x,t) -> + let avoids = filter ((!=) x) (vars_and_constants tm []) in + let x' = mk_primed_var avoids x in + if (x=x') then failwith "relabel_bound" else (alpha x' tm) + | _ -> failwith "relabel_bound" in + DEPTH_CONV (fun t -> ALPHA t (relabel_bound t)) tm;; + +(* example *) +let _ = + let bad_term = mk_abs (`x:bool`,`(x:num)+1=2`) in + relabel_bound_conv bad_term;; + +let NAME_CONFLICT_CONV = relabel_bound_conv;; + +let NAME_CONFLICT_TAC = CONV_TAC (relabel_bound_conv);; + +(* renames given bound variables *) +let alpha_conv env tm = ALPHA tm (deep_alpha env tm);; + +(* replaces given alpha-equivalent terms with- the term itself *) +let unify_alpha_tac = SUBST_ALL_TAC o REFL;; + +let rec get_abs tm acc = match tm with + Abs(u,v) -> get_abs v (tm::acc) + |Comb(u,v) -> get_abs u (get_abs v acc) + |_ -> acc;; + +(* for purposes such as sorting, it helps if ALL ALPHA-equiv + abstractions are replaced by equal abstractions *) +let (alpha_tac:tactic) = + fun (asl,w' ) -> + EVERY (map unify_alpha_tac (get_abs w' [])) (asl,w');; + +(* ------------------------------------------------------------------ *) +(* SELECT ELIMINATION. + SELECT_TAC should work whenever there is a single predicate selected. + Something more sophisticated might be needed when there + is (@)A and (@)B + in the same formula. + Useful for proving statements such as `1 + (@x. (x=3)) = 4` *) +(* ------------------------------------------------------------------ *) + +(* spec form of SELECT_AX *) +let select_thm select_fn select_exist = + BETA_RULE (ISPECL [select_fn;select_exist] + SELECT_AX);; + +(* example *) +select_thm + `\m. (X:num->bool) m /\ (!n. X n ==> m <=| n)` `n:num`;; + +let SELECT_EXIST = prove_by_refinement( + `!(P:A->bool) Q. (?y. P y) /\ (!t. (P t ==> Q t)) ==> Q ((@) P)`, + (* {{{ proof *) + + [ + REPEAT GEN_TAC; + DISCH_ALL_TAC; + UNDISCH_FIND_TAC `(?)`; + DISCH_THEN CHOOSE_TAC; + ASSUME_TAC (ISPECL[`P:(A->bool)`;`y:A`] SELECT_AX); + ASM_MESON_TAC[]; + ]);; + + (* }}} *) + +let SELECT_THM = prove_by_refinement( + `!(P:A->bool) Q. (((?y. P y) ==> (!t. (P t ==> Q t))) /\ ((~(?y. P y)) ==> + (!t. Q t))) ==> Q ((@) P)`, + (* {{{ proof *) + [ + MESON_TAC[SELECT_EXIST]; + ]);; + (* }}} *) + +let SELECT_TAC = + (* explicitly pull apart the clause Q((@) P), + because MATCH_MP_TAC isn't powerful + enough to do this by itself. *) + let unbeta = prove( + `!(P:A->bool) (Q:A->bool). (Q ((@) P)) <=> (\t. Q t) ((@) P)`,MESON_TAC[]) in + let unbeta_tac = CONV_TAC (HIGHER_REWRITE_CONV[unbeta] true) in + unbeta_tac THEN (MATCH_MP_TAC SELECT_THM) THEN BETA_TAC THEN CONJ_TAC + THENL[ + (DISCH_THEN (fun t-> ALL_TAC)) THEN GEN_TAC; + DISCH_TAC THEN GEN_TAC];; + +(* EXAMPLE: + +# g `(R:A->bool) ((@) S)`;; +val it : Core.goalstack = 1 subgoal (1 total) + +`R ((@) S)` + +# e SELECT_TAC ;; +val it : Core.goalstack = 2 subgoals (2 total) + + 0 [`~(?y. S y)`] + +`R t` + +`S t ==> R t` + +*) + + +(* ------------------------------------------------------------------ *) +(* TYPE_THEN and TYPEL_THEN calculate the types of the terms supplied + in a proof, avoiding the hassle of working them out by hand. + It locates the terms among the free variables in the goal. + Ambiguious if a free variables have name conflicts. + + Now TYPE_THEN handles general terms. +*) +(* ------------------------------------------------------------------ *) + + +let rec type_set: (string*term) list -> (term list*term) -> (term list*term)= + fun typinfo (acclist,utm) -> match acclist with + | [] -> (acclist,utm) + | (Var(s,_) as a)::rest -> + let a' = (assocd s typinfo a) in + if (a = a') then type_set typinfo (rest,utm) + else let inst = instantiate (term_match [] a a') in + type_set typinfo ((map inst rest),inst utm) + | _ -> failwith "type_set: variable expected" + ;; + +let has_stv t = + let typ = (type_vars_in_term t) in + can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;; + + +let TYPE_THEN: term -> (term -> tactic) -> tactic = + fun t (tac:term->tactic) (asl,w) -> + let avoids = itlist (union o frees o concl o snd) asl + (frees w) in + let strip = fun t-> (match t with + |Var(s,_) -> (s,t) | _ -> failwith "TYPE_THEN" ) in + let typinfo = map strip avoids in + let t' = (snd (type_set typinfo ((frees t),t))) in + (warn ((has_stv t')) "TYPE_THEN: unresolved type variables"); + tac t' (asl,w);; + +(* this version must take variables *) +let TYPEL_THEN: term list -> (term list -> tactic) -> tactic = + fun t (tac:term list->tactic) (asl,w) -> + let avoids = itlist (union o frees o concl o snd) asl + (frees w) in + let strip = fun t-> (match t with + |Var(s,_) -> (s,t) | _ -> failwith "TYPE_THEN" ) in + let typinfo = map strip avoids in + let t' = map (fun u -> snd (type_set typinfo ((frees u),u))) t in + (warn ((can (find has_stv) t')) "TYPEL_THEN: unresolved type vars"); + tac t' (asl,w);; + +(* trivial example *) + +let _ = prove_by_refinement(`!y. y:num = y`, + [ + GEN_TAC; + TYPE_THEN `y:A` (fun t -> ASSUME_TAC(ISPEC t (TAUT `!x:B. x=x`))); + UNDISCH_TAC `y:num = y`; (* evidence that `y:A` was retyped as `y:num` *) + MESON_TAC[]; + ]);; + + +(* ------------------------------------------------------------------ *) +(* SAVE the goalstate, and retrieve later *) +(* ------------------------------------------------------------------ *) + +let (save_goal,get_goal) = + let goal_buffer = ref [] in + let save_goal s = + goal_buffer := (s,!current_goalstack )::!goal_buffer in + let get_goal (s:string) = (current_goalstack:= assoc s !goal_buffer) in + (save_goal,get_goal);; + + +(* ------------------------------------------------------------------ *) +(* ordered rewrites with general ord function . + This allows rewrites with an arbitrary condition + -- adapted from simp.ml *) +(* ------------------------------------------------------------------ *) + + + +let net_of_thm_ord ord rep force th = + let t = concl th in + let lconsts = freesl (hyp th) in + let matchable = can o term_match lconsts in + try let l,r = dest_eq t in + if rep & free_in l r then + let th' = EQT_INTRO th in + enter lconsts (l,(1,REWR_CONV th')) + else if rep & matchable l r & matchable r l then + enter lconsts (l,(1,ORDERED_REWR_CONV ord th)) + else if force then + enter lconsts (l,(1,ORDERED_REWR_CONV ord th)) + else enter lconsts (l,(1,REWR_CONV th)) + with Failure _ -> + let l,r = dest_eq(rand t) in + if rep & free_in l r then + let tm = lhand t in + let th' = DISCH tm (EQT_INTRO(UNDISCH th)) in + enter lconsts (l,(3,IMP_REWR_CONV th')) + else if rep & matchable l r & matchable r l then + enter lconsts (l,(3,ORDERED_IMP_REWR_CONV ord th)) + else enter lconsts(l,(3,IMP_REWR_CONV th));; + +let GENERAL_REWRITE_ORD_CONV ord rep force (cnvl:conv->conv) (builtin_net:gconv net) thl = + let thl_canon = itlist (mk_rewrites false) thl [] in + let final_net = itlist (net_of_thm_ord ord rep force ) thl_canon builtin_net in + cnvl (REWRITES_CONV final_net);; + +let GEN_REWRITE_ORD_CONV ord force (cnvl:conv->conv) thl = + GENERAL_REWRITE_ORD_CONV ord false force cnvl empty_net thl;; + +let PURE_REWRITE_ORD_CONV ord force thl = + GENERAL_REWRITE_ORD_CONV ord true force TOP_DEPTH_CONV empty_net thl;; + +let REWRITE_ORD_CONV ord force thl = + GENERAL_REWRITE_ORD_CONV ord true force TOP_DEPTH_CONV (basic_net()) thl;; + +let PURE_ONCE_REWRITE_ORD_CONV ord force thl = + GENERAL_REWRITE_ORD_CONV ord false force ONCE_DEPTH_CONV empty_net thl;; + +let ONCE_REWRITE_ORD_CONV ord force thl = + GENERAL_REWRITE_ORD_CONV ord false force ONCE_DEPTH_CONV (basic_net()) thl;; + +let REWRITE_ORD_TAC ord force thl = CONV_TAC(REWRITE_ORD_CONV ord force thl);; + + + + +(* ------------------------------------------------------------------ *) +(* poly reduction *) +(* ------------------------------------------------------------------ *) + + +(* move vars leftward *) +(* if ord old_lhs new_rhs THEN swap *) + + +let new_factor_order t1 t2 = + try let t1v = fst(dest_binop `( *. )` t1) in + let t2v = fst(dest_binop `( *. )` t2) in + if (is_var t1v) & (is_var t2v) then term_order t1v t2v + else if (is_var t2v) then true else false + with Failure _ -> false ;; + +(* false if it contains a variable or abstraction. *) +let rec is_arith_const tm = + if is_var tm then false else + if is_abs tm then false else + if is_comb tm then + let (a,b) = (dest_comb tm) in + is_arith_const (a) & is_arith_const (b) + else true;; + +(* const leftward *) +let new_factor_order2 t1 t2 = + try let t1v = fst(dest_binop `( *. )` t1) in + let t2v = fst(dest_binop `( *. )` t2) in + if (is_var t1v) & (is_var t2v) then term_order t1v t2v + else if (is_arith_const t2v) then true else false + with Failure _ -> false ;; + +let rec mon_sz tm = + if is_var tm then + Int (Hashtbl.hash tm) + else + try let (a,b) = dest_binop `( *. )` tm in + (mon_sz a) */ (mon_sz b) + with Failure _ -> Int 1;; + +let rec new_summand_order t1 t2 = + try let t1v = fst(dest_binop `( +. )` t1) in + let t2v = fst(dest_binop `( +. )` t2) in + (mon_sz t2v >/ mon_sz t1v) + with Failure _ -> false ;; + +let rec new_distrib_order t1 t2 = + try let t2v = fst(dest_binop `( *. )` t2) in + if (is_arith_const t2v) then true else false + with Failure _ -> + try + let t2' = fst(dest_binop `( +. )` t2) in + new_distrib_order t1 t2' + with Failure _ -> false ;; + +let real_poly_conv = + (* same side *) + ONCE_REWRITE_CONV [GSYM REAL_SUB_0] THENC + (* expand ALL *) + REWRITE_CONV[real_div;REAL_RDISTRIB;REAL_SUB_RDISTRIB; + pow; + GSYM REAL_MUL_ASSOC;GSYM REAL_ADD_ASSOC; + REAL_ARITH `(x -. (--y) = x + y) /\ (x - y = x + (-- y)) /\ + (--(x + y) = --x + (--y)) /\ (--(x - y) = --x + y)`; + REAL_ARITH + `(x*.(-- y) = -- (x*. y)) /\ (--. (--. x) = x) /\ + ((--. x)*.y = --.(x*.y))`; + REAL_SUB_LDISTRIB;REAL_LDISTRIB] THENC + (* move constants rightward on monomials *) + REWRITE_ORD_CONV new_factor_order false [REAL_MUL_AC;] THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV + [REAL_ARITH `-- x = (x*(-- &.1))`] THENC + REWRITE_CONV[GSYM REAL_MUL_ASSOC] THENC + REAL_RAT_REDUCE_CONV THENC + (* collect like monomials *) + REWRITE_ORD_CONV new_summand_order false [REAL_ADD_AC;] THENC + (* move constants leftward AND collect them together *) + REWRITE_ORD_CONV new_factor_order2 false [REAL_MUL_AC;] THENC + REWRITE_ORD_CONV new_distrib_order true [ + REAL_ARITH `(a*b +. d*b = (a+d)*b) /\ + (a*b + b = (a+ &.1)*b ) /\ ( b + a*b = (a+ &.1)*b) /\ + (a*b +. d*b +e = (a+d)*b + e) /\ + (a*b + b + e= (a+. &.1)* b +e ) /\ + ( b + a*b + e = (a + &.1)*b +e) `;] THENC + REAL_RAT_REDUCE_CONV THENC + REWRITE_CONV[REAL_ARITH `(&.0 * x = &.0) /\ (x + &.0 = x) /\ + (&.0 + x = x)`];; + +let real_poly_tac = CONV_TAC real_poly_conv;; + +let test_real_poly_tac = prove_by_refinement( + `!x y . (x + (&.2)*y)*(x- (&.2)*y) = (x*x -. (&.4)*y*y)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + real_poly_tac; + ]);; + (* }}} *) + + + + +(* ------------------------------------------------------------------ *) +(* REAL INEQUALITIES *) + + +(* Take inequality certificate A + B1 + B2 +.... + P = C as a term. + Prove it as an inequality. + Reduce to an ineq (A < C) WITH side conditions + 0 <= Bi, 0 < P. + + If (not strict), write as an ineq (A <= C) WITH side conditions + 0 <= Bi. + + Expand each Bi (or P) that is a product U*V as 0 <= U /\ 0 <= V. + To prevent expansion of Bi write (U*V) as (&0 + (U*V)). + + CALL as + ineq_le_tac `A + B1 + B2 = C`; + + *) +(* ------------------------------------------------------------------ *) + + +let strict_lemma = prove_by_refinement( + `!A B C. (A+B = C) ==> ((&.0 <. B) ==> (A <. C) )`, + (* {{{ proof *) + [ + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let weak_lemma = prove_by_refinement( + `!A B C. (A+B = C) ==> ((&.0 <=. B) ==> (A <=. C))`, + (* {{{ proof *) + [ + REAL_ARITH_TAC; + ]);; + (* }}} *) + +let strip_lt_lemma = prove_by_refinement( + `!B1 B2 C. ((&.0 <. (B1+B2)) ==> C) ==> + ((&.0 <. B2) ==> ((&.0 <=. B1) ==> C))`, + (* {{{ proof *) + [ + ASM_MESON_TAC[REAL_LET_ADD]; + ]);; + (* }}} *) + +let strip_le_lemma = prove_by_refinement( + `!B1 B2 C. ((&.0 <=. (B1+B2)) ==> C) ==> + ((&.0 <=. B2) ==> ((&.0 <=. B1) ==> C))`, + (* {{{ proof *) + [ + ASM_MESON_TAC[REAL_LE_ADD]; + ]);; + (* }}} *) + +let is_x_prod_le tm = + try let hyp = fst(dest_binop `( ==> )` tm) in + let arg = snd(dest_binop `( <=. ) ` hyp) in + let fac = dest_binop `( *. )` arg in + true + with Failure _ -> false;; + +let switch_lemma_le_order t1 t2 = + if (is_x_prod_le t1) & (is_x_prod_le t2) then + term_order t1 t2 else + if (is_x_prod_le t2) then true else false;; + +let is_x_prod_lt tm = + try let hyp = fst(dest_binop `( ==> )` tm) in + let arg = snd(dest_binop `( <. ) ` hyp) in + let fac = dest_binop `( *. )` arg in + true + with Failure _ -> false;; + +let switch_lemma_lt_order t1 t2 = + if (is_x_prod_lt t1) & (is_x_prod_lt t2) then + term_order t1 t2 else + if (is_x_prod_lt t2) then true else false;; + +let switch_lemma_le = prove_by_refinement( + `!A B C. ((&.0 <= A) ==> (&.0 <= B) ==> C) = + ((&.0 <=. B) ==> (&.0 <= A) ==> C)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let switch_lemma_let = prove_by_refinement( + `!A B C. ((&.0 < A) ==> (&.0 <= B) ==> C) = + ((&.0 <=. B) ==> (&.0 < A) ==> C)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let switch_lemma_lt = prove_by_refinement( + `!A B C. ((&.0 < A) ==> (&.0 < B) ==> C) = + ((&.0 <. B) ==> (&.0 < A) ==> C)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[]; + ]);; + (* }}} *) + +let expand_prod_lt = prove_by_refinement( + `!B1 B2 C. (&.0 < B1*B2 ==> C) ==> + ((&.0 <. B1) ==> (&.0 <. B2) ==> C)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[REAL_LT_MUL ]; + ]);; + (* }}} *) + +let expand_prod_le = prove_by_refinement( + `!B1 B2 C. (&.0 <= B1*B2 ==> C) ==> + ((&.0 <=. B1) ==> (&.0 <=. B2) ==> C)`, + (* {{{ proof *) + [ + ASM_MESON_TAC[REAL_LE_MUL ]; + ]);; + (* }}} *) + + +let ineq_cert_gen_tac v cert = + let DISCH_RULE f = DISCH_THEN (fun t-> MP_TAC (f t)) in + TYPE_THEN cert + (MP_TAC o (REWRITE_CONV[REAL_POW_2] THENC real_poly_conv)) THEN + REWRITE_TAC[] THEN + DISCH_RULE (MATCH_MP v) THEN + DISCH_RULE (repeat (MATCH_MP strip_lt_lemma)) THEN + DISCH_RULE (repeat (MATCH_MP strip_le_lemma)) THEN + DISCH_RULE (repeat (MATCH_MP expand_prod_lt o + (CONV_RULE + (REWRITE_ORD_CONV switch_lemma_lt_order true[switch_lemma_lt])))) THEN + DISCH_RULE (repeat (MATCH_MP expand_prod_le o + (CONV_RULE (REWRITE_ORD_CONV switch_lemma_le_order true + [switch_lemma_le])) o + (REWRITE_RULE[switch_lemma_let]))) THEN + DISCH_RULE (repeat (MATCH_MP + (TAUT `(A ==> B==>C) ==> (A /\ B ==> C)`))) THEN + REWRITE_TAC[REAL_MUL_LID] THEN + DISCH_THEN MATCH_MP_TAC THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LE_POW_2; + REAL_ARITH `(&.0 < x ==> &.0 <= x) /\ (&.0 + x = x) /\ + (a <= b ==> &.0 <= b - a) /\ + (a < b ==> &.0 <= b - a) /\ + (~(b < a) ==> &.0 <= b - a) /\ + (~(b <= a) ==> &.0 <= b - a) /\ + (a < b ==> &.0 < b - a) /\ + (~(b <= a) ==> &.0 < b - a)`];; + +let ineq_lt_tac = ineq_cert_gen_tac strict_lemma;; +let ineq_le_tac = ineq_cert_gen_tac weak_lemma;; + + + +(* test *) +let test_ineq_tac = prove_by_refinement( + `!x y z. (&.0 <= x*y) /\ (&.0 <. z) ==> + (x*y) <. x*x + (&.3)*x*y + &.4 `, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + ineq_lt_tac `x * y + x pow 2 + &2 * (&.0 + x * y) + &2 * &2 = x * x + &3 * x * y + &4`; + ]);; + (* }}} *) + + + +(* ------------------------------------------------------------------ *) +(* Move quantifier left. Use class.ml and theorems.ml to bubble + quantifiers towards the head of an expression. It should move + quantifiers past other quantifiers, past conjunctions, disjunctions, + implications, etc. + + val quant_left_CONV : string -> term -> thm = + Arguments: + var_name:string -- The name of the variable that is to be shifted. + + It tends to return `T` when the conversion fails. + + Example: + quant_left_CONV "a" `!b. ?a. a = b*4`;; + val it : thm = |- (!b. ?a. a = b *| 4) <=> (?a. !b. a b = b *| 4) + *) +(* ------------------------------------------------------------------ *) + +let tagb = new_definition `TAGB (x:bool) = x`;; + +let is_quant tm = (is_forall tm) or (is_exists tm);; + +(*** JRH replaced Comb and Abs with abstract type constructors ***) + +let rec tag_quant var_name tm = + if (is_forall tm && (fst (dest_var (fst (dest_forall tm))) = var_name)) + then mk_comb (`TAGB`,tm) + else if (is_exists tm && (fst (dest_var (fst (dest_exists tm))) = var_name)) then mk_comb (`TAGB`,tm) + else match tm with + | Comb (x,y) -> mk_comb(tag_quant var_name x,tag_quant var_name y) + | Abs (x,y) -> mk_abs(x,tag_quant var_name y) + | _ -> tm;; + +let quant_left_CONV = + (* ~! -> ?~ *) + let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let NOT_FORALL_TAG = prove(`!P. ~(TAGB(!x. P x)) <=> (?x:A. ~(P x))`, + REWRITE_TAC[tagb;NOT_FORALL_THM]) in + let SKOLEM_TAG = + prove(`!P. (?y. TAGB (!(x:A). P x ((y:A->B) x))) <=> + ( (!(x:A). ?y. P x ((y:B))))`,REWRITE_TAC[tagb;SKOLEM_THM]) in + let SKOLEM_TAG2 = + prove(`!P. (!x:A. TAGB(?y:B. P x y)) <=> (?y. !x. P x (y x))`, + REWRITE_TAC[tagb;SKOLEM_THM]) in + (* !1 !2 -> !2 !1 *) + let SWAP_FORALL_TAG = + prove(`!P:A->B->bool. (!x. TAGB(! y. P x y)) <=> (!y x. P x y)`, + REWRITE_TAC[SWAP_FORALL_THM;tagb]) in + let SWAP_EXISTS_THM = iprove + `!P:A->B->bool. (?x. TAGB (?y. P x y)) <=> (?y x. P x y)` in + (* ! /\ ! -> ! /\ *) + let AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ TAGB (!x. Q x) <=> + (!x. P x /\ Q x))`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let LEFT_AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ Q) <=> + (!x. P x /\ Q )`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let RIGHT_AND_FORALL_TAG = prove(`!P Q. P /\ TAGB (!x. Q x) <=> + (!x. P /\ Q x)`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let TRIV_OR_FORALL_TAG = prove + (`!P Q. TAGB (!x:A. P) \/ TAGB (!x:A. Q) <=> (!x:A. P \/ Q)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let RIGHT_IMP_FORALL_TAG = prove + (`!P Q. (P ==> TAGB (!x:A. Q x)) <=> (!x. P ==> Q x)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let OR_EXISTS_THM = iprove + `!P Q. TAGB (?x. P x) \/ TAGB (?x. Q x) <=> (?x:A. P x \/ Q x)` in + let LEFT_OR_EXISTS_THM = iprove + `!P Q. TAGB (?x. P x) \/ Q <=> (?x:A. P x \/ Q)` in + let RIGHT_OR_EXISTS_THM = iprove + `!P Q. P \/ TAGB (?x. Q x) <=> (?x:A. P \/ Q x)` in + let LEFT_AND_EXISTS_THM = iprove + `!P Q. TAGB (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)` in + let RIGHT_AND_EXISTS_THM = iprove + `!P Q. P /\ TAGB (?x:A. Q x) <=> (?x:A. P /\ Q x)` in + let TRIV_AND_EXISTS_THM = iprove + `!P Q. TAGB (?x:A. P) /\ TAGB (?x:A. Q) <=> (?x:A. P /\ Q)` in + let LEFT_IMP_EXISTS_THM = iprove + `!P Q. (TAGB (?x:A. P x) ==> Q) <=> (!x. P x ==> Q)` in + let TRIV_FORALL_IMP_THM = iprove + `!P Q. (TAGB (?x:A. P) ==> TAGB (!x:A. Q)) <=> (!x:A. P ==> Q) ` in + let TRIV_EXISTS_IMP_THM = iprove + `!P Q. (TAGB(!x:A. P) ==> TAGB (?x:A. Q)) <=> (?x:A. P ==> Q) ` in + let NOT_EXISTS_TAG = prove( + `!P. ~(TAGB(?x:A. P x)) <=> (!x. ~(P x))`, + REWRITE_TAC[tagb;NOT_EXISTS_THM]) in + let LEFT_OR_FORALL_TAG = prove + (`!P Q. TAGB(!x:A. P x) \/ Q <=> (!x. P x \/ Q)`, + REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in + let RIGHT_OR_FORALL_TAG = prove + (`!P Q. P \/ TAGB(!x:A. Q x) <=> (!x. P \/ Q x)`, + REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in + let LEFT_IMP_FORALL_TAG = prove + (`!P Q. (TAGB(!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`, + REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in + let RIGHT_IMP_EXISTS_TAG = prove + (`!P Q. (P ==> TAGB(?x:A. Q x)) <=> (?x:A. P ==> Q x)`, + REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in + fun var_name tm -> + REWRITE_RULE [tagb] + (TOP_SWEEP_CONV + (GEN_REWRITE_CONV I + [NOT_FORALL_TAG;SKOLEM_TAG;SKOLEM_TAG2; + SWAP_FORALL_TAG;SWAP_EXISTS_THM; + SWAP_EXISTS_THM; + AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG; + TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG; + OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM; + TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM; + TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG; + LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG; + RIGHT_IMP_EXISTS_TAG; + ]) + (tag_quant var_name tm));; + +(* same, but never pass a quantifier past another. No Skolem, etc. *) +let quant_left_noswap_CONV = + (* ~! -> ?~ *) + let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let NOT_FORALL_TAG = prove(`!P. ~(TAGB(!x. P x)) <=> (?x:A. ~(P x))`, + REWRITE_TAC[tagb;NOT_FORALL_THM]) in + let SKOLEM_TAG = + prove(`!P. (?y. TAGB (!(x:A). P x ((y:A->B) x))) <=> + ( (!(x:A). ?y. P x ((y:B))))`,REWRITE_TAC[tagb;SKOLEM_THM]) in + let SKOLEM_TAG2 = + prove(`!P. (!x:A. TAGB(?y:B. P x y)) <=> (?y. !x. P x (y x))`, + REWRITE_TAC[tagb;SKOLEM_THM]) in + (* !1 !2 -> !2 !1 *) + let SWAP_FORALL_TAG = + prove(`!P:A->B->bool. (!x. TAGB(! y. P x y)) <=> (!y x. P x y)`, + REWRITE_TAC[SWAP_FORALL_THM;tagb]) in + let SWAP_EXISTS_THM = iprove + `!P:A->B->bool. (?x. TAGB (?y. P x y)) <=> (?y x. P x y)` in + (* ! /\ ! -> ! /\ *) + let AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ TAGB (!x. Q x) <=> + (!x. P x /\ Q x))`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let LEFT_AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ Q) <=> + (!x. P x /\ Q )`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let RIGHT_AND_FORALL_TAG = prove(`!P Q. P /\ TAGB (!x. Q x) <=> + (!x. P /\ Q x)`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let TRIV_OR_FORALL_TAG = prove + (`!P Q. TAGB (!x:A. P) \/ TAGB (!x:A. Q) <=> (!x:A. P \/ Q)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let RIGHT_IMP_FORALL_TAG = prove + (`!P Q. (P ==> TAGB (!x:A. Q x)) <=> (!x. P ==> Q x)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let OR_EXISTS_THM = iprove + `!P Q. TAGB (?x. P x) \/ TAGB (?x. Q x) <=> (?x:A. P x \/ Q x)` in + let LEFT_OR_EXISTS_THM = iprove + `!P Q. TAGB (?x. P x) \/ Q <=> (?x:A. P x \/ Q)` in + let RIGHT_OR_EXISTS_THM = iprove + `!P Q. P \/ TAGB (?x. Q x) <=> (?x:A. P \/ Q x)` in + let LEFT_AND_EXISTS_THM = iprove + `!P Q. TAGB (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)` in + let RIGHT_AND_EXISTS_THM = iprove + `!P Q. P /\ TAGB (?x:A. Q x) <=> (?x:A. P /\ Q x)` in + let TRIV_AND_EXISTS_THM = iprove + `!P Q. TAGB (?x:A. P) /\ TAGB (?x:A. Q) <=> (?x:A. P /\ Q)` in + let LEFT_IMP_EXISTS_THM = iprove + `!P Q. (TAGB (?x:A. P x) ==> Q) <=> (!x. P x ==> Q)` in + let TRIV_FORALL_IMP_THM = iprove + `!P Q. (TAGB (?x:A. P) ==> TAGB (!x:A. Q)) <=> (!x:A. P ==> Q) ` in + let TRIV_EXISTS_IMP_THM = iprove + `!P Q. (TAGB(!x:A. P) ==> TAGB (?x:A. Q)) <=> (?x:A. P ==> Q) ` in + let NOT_EXISTS_TAG = prove( + `!P. ~(TAGB(?x:A. P x)) <=> (!x. ~(P x))`, + REWRITE_TAC[tagb;NOT_EXISTS_THM]) in + let LEFT_OR_FORALL_TAG = prove + (`!P Q. TAGB(!x:A. P x) \/ Q <=> (!x. P x \/ Q)`, + REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in + let RIGHT_OR_FORALL_TAG = prove + (`!P Q. P \/ TAGB(!x:A. Q x) <=> (!x. P \/ Q x)`, + REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in + let LEFT_IMP_FORALL_TAG = prove + (`!P Q. (TAGB(!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`, + REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in + let RIGHT_IMP_EXISTS_TAG = prove + (`!P Q. (P ==> TAGB(?x:A. Q x)) <=> (?x:A. P ==> Q x)`, + REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in + fun var_name tm -> + REWRITE_RULE [tagb] + (TOP_SWEEP_CONV + (GEN_REWRITE_CONV I + [NOT_FORALL_TAG; (* SKOLEM_TAG;SKOLEM_TAG2; *) + (* SWAP_FORALL_TAG;SWAP_EXISTS_THM; + SWAP_EXISTS_THM; *) + AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG; + TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG; + OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM; + TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM; + TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG; + LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG; + RIGHT_IMP_EXISTS_TAG; + ]) + (tag_quant var_name tm));; + +let quant_right_CONV = + (* ~! -> ?~ *) + let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let NOT_FORALL_TAG = prove(`!P. TAGB(?x:A. ~(P x)) <=> ~((!x. P x))`, + REWRITE_TAC[tagb;GSYM NOT_FORALL_THM]) in + let SKOLEM_TAG = + prove(`!P. ( TAGB(!(x:A). ?y. P x ((y:B)))) <=> + (?y. (!(x:A). P x ((y:A->B) x)))`, + REWRITE_TAC[tagb;GSYM SKOLEM_THM]) + in + let SKOLEM_TAG2 = + prove(`!P. TAGB(?y. !x. P x (y x)) <=> (!x:A. (?y:B. P x y))`, + REWRITE_TAC[tagb;GSYM SKOLEM_THM]) in + (* !1 !2 -> !2 !1.. *) + let SWAP_FORALL_TAG = + prove(`!P:A->B->bool. TAGB(!y x. P x y) <=> (!x. (! y. P x y))`, + REWRITE_TAC[GSYM SWAP_FORALL_THM;tagb]) in + let SWAP_EXISTS_THM = iprove + `!P:A->B->bool. TAGB (?y x. P x y) <=> (?x. (?y. P x y))` in + (* ! /\ ! -> ! /\ *) + let AND_FORALL_TAG = iprove`!P Q. TAGB(!x. P x /\ Q x) <=> + ((!x. P x) /\ (!x. Q x))` in + let LEFT_AND_FORALL_TAG = prove(`!P Q. + TAGB(!x. P x /\ Q ) <=> ((!x. P x) /\ Q)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let RIGHT_AND_FORALL_TAG = prove(`!P Q. + TAGB(!x. P /\ Q x) <=> P /\ (!x. Q x)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let TRIV_OR_FORALL_TAG = prove + (`!P Q. TAGB(!x:A. P \/ Q) <=>(!x:A. P) \/ (!x:A. Q)`, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let RIGHT_IMP_FORALL_TAG = prove + (`!P Q. TAGB (!x. P ==> Q x) <=> (P ==> (!x:A. Q x)) `, + REWRITE_TAC[tagb] THEN ITAUT_TAC) in + let OR_EXISTS_THM = iprove + `!P Q. TAGB(?x:A. P x \/ Q x) <=> (?x. P x) \/ (?x. Q x) ` in + let LEFT_OR_EXISTS_THM = iprove + `!P Q. TAGB (?x:A. P x \/ Q) <=> (?x. P x) \/ Q ` in + let RIGHT_OR_EXISTS_THM = iprove + `!P Q.TAGB (?x:A. P \/ Q x) <=> P \/ (?x. Q x)` in + let LEFT_AND_EXISTS_THM = iprove + `!P Q.TAGB (?x:A. P x /\ Q) <=> (?x:A. P x) /\ Q` in + let RIGHT_AND_EXISTS_THM = iprove + `!P Q. TAGB (?x:A. P /\ Q x) <=> P /\ (?x:A. Q x) ` in + let TRIV_AND_EXISTS_THM = iprove + `!P Q. TAGB(?x:A. P /\ Q) <=> (?x:A. P) /\ (?x:A. Q) ` in (* *) + let LEFT_IMP_EXISTS_THM = iprove + `!P Q. TAGB(!x. P x ==> Q) <=> ( (?x:A. P x) ==> Q) ` in (* *) + let TRIV_FORALL_IMP_THM = iprove + `!P Q. TAGB(!x:A. P ==> Q) <=> ( (?x:A. P) ==> (!x:A. Q)) ` in + let TRIV_EXISTS_IMP_THM = iprove + `!P Q. TAGB(?x:A. P ==> Q) <=> ((!x:A. P) ==> (?x:A. Q)) ` in + let NOT_EXISTS_TAG = prove( + `!P. TAGB(!x. ~(P x)) <=> ~((?x:A. P x)) `, + REWRITE_TAC[tagb;NOT_EXISTS_THM]) in + let LEFT_OR_FORALL_TAG = prove + (`!P Q. TAGB(!x. P x \/ Q) <=> (!x:A. P x) \/ Q `, + REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in + let RIGHT_OR_FORALL_TAG = prove + (`!P Q. TAGB(!x. P \/ Q x) <=> P \/ (!x:A. Q x) `, + REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in + let LEFT_IMP_FORALL_TAG = prove + (`!P Q. TAGB(?x. P x ==> Q) <=> ((!x:A. P x) ==> Q) `, + REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in + let RIGHT_IMP_EXISTS_TAG = prove + (`!P Q. TAGB(?x:A. P ==> Q x) <=> (P ==> (?x:A. Q x)) `, + REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in + fun var_name tm -> + REWRITE_RULE [tagb] + (TOP_SWEEP_CONV + (GEN_REWRITE_CONV I + [NOT_FORALL_TAG;SKOLEM_TAG;SKOLEM_TAG2; + SWAP_FORALL_TAG;SWAP_EXISTS_THM; + SWAP_EXISTS_THM; + AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG; + TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG; + OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM; + TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM; + TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG; + LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG; + RIGHT_IMP_EXISTS_TAG; + ]) + (tag_quant var_name tm));; + + +(* ------------------------------------------------------------------ *) +(* Dropping Superfluous Quantifiers . + Example: ?u. (u = t) /\ ... + We can eliminate the u. + *) +(* ------------------------------------------------------------------ *) + +let mark_term = new_definition `mark_term (u:A) = u`;; + +(*** JRH replaced Comb and Abs with explicit constructors ***) + +let rec markq qname tm = + match tm with + Var (a,b) -> if (a=qname) then mk_icomb (`mark_term:A->A`,tm) else tm + |Const(_,_) -> tm + |Comb(s,b) -> mk_comb(markq qname s,markq qname b) + |Abs (x,t) -> mk_abs(x,markq qname t);; + +let rec getquants tm = + if (is_forall tm) then + (fst (dest_var (fst (dest_forall tm)))):: + (getquants (snd (dest_forall tm))) + else if (is_exists tm) then + (fst (dest_var (fst (dest_exists tm)))):: + (getquants (snd (dest_exists tm))) + else match tm with + Comb(s,b) -> (getquants s) @ (getquants b) + | Abs (x,t) -> (getquants t) + | _ -> [];; + +(* can loop if there are TWO *) +let rewrite_conjs = [ + prove_by_refinement (`!A B C. (A /\ B) /\ C <=> A /\ B /\ C`,[REWRITE_TAC[CONJ_ACI]]); + prove_by_refinement (`!u. (mark_term (u:A) = mark_term u) <=> T`,[MESON_TAC[]]); + prove_by_refinement (`!u t. (t = mark_term (u:A)) <=> (mark_term u = t)`,[MESON_TAC[]]); + prove_by_refinement (`!u a b. (mark_term (u:A) = a) /\ (mark_term u = b) <=> (mark_term u = a) /\ (a = b)`,[MESON_TAC[]]); + prove_by_refinement (`!u a b B. (mark_term (u:A) = a) /\ (mark_term u = b) /\ B <=> (mark_term u = a) /\ (a = b) /\ B`,[MESON_TAC[]]); + prove_by_refinement (`!u t A C. A /\ (mark_term (u:A) = t) /\ C <=> + (mark_term u = t) /\ A /\ C`,[MESON_TAC[]]); + prove_by_refinement (`!A u t. A /\ (mark_term (u:A) = t) <=> + (mark_term u = t) /\ A `,[MESON_TAC[]]); + prove_by_refinement (`!u t C D. (((mark_term (u:A) = t) /\ C) ==> D) <=> + ((mark_term (u:A) = t) ==> C ==> D)`,[MESON_TAC[]]); + prove_by_refinement (`!A u t B. (A ==> (mark_term (u:A) = t) ==> B) <=> + ((mark_term (u:A) = t) ==> A ==> B)`,[MESON_TAC[]]); +];; + +let higher_conjs = [ + prove_by_refinement (`!C u t. ((mark_term u = t) ==> C (mark_term u)) <=> + ((mark_term u = t) ==> C (t:A))`,[MESON_TAC[mark_term]]); + prove_by_refinement (`!C u t. ((mark_term u = t) /\ C (mark_term u)) <=> + ((mark_term u = t) /\ C (t:A))`,[MESON_TAC[mark_term]]); +];; + + +let dropq_conv = + let drop_exist = + REWRITE_CONV [prove_by_refinement (`!t. ?(u:A). (u = t)`,[MESON_TAC[]])] in + fun qname tm -> + let quanlist = getquants tm in + let quantleft_CONV = EVERY_CONV + (map (REPEATC o quant_left_noswap_CONV) quanlist) in + let qname_conv tm = prove(mk_eq(tm,markq qname tm), + REWRITE_TAC[mark_term]) in + let conj_conv = REWRITE_CONV rewrite_conjs in + let quantright_CONV = (REPEATC (quant_right_CONV qname)) in + let drop_mark_CONV = REWRITE_CONV [mark_term] in + (quantleft_CONV THENC qname_conv THENC conj_conv THENC + (ONCE_REWRITE_CONV higher_conjs) + THENC drop_mark_CONV THENC quantright_CONV THENC + drop_exist ) tm ;; + + +(* Examples : *) +dropq_conv "u" `!P Q R . (?(u:B). (?(x:A). (u = P x) /\ (Q x)) /\ (R u))`;; +dropq_conv "t" `!P Q R. (!(t:B). (?(x:A). P x /\ (t = Q x)) ==> R t)`;; + +dropq_conv "u" `?u v. + ((t * (a + &1) + (&1 - t) *a = u) /\ + (t * (b + &0) + (&1 - t) * b = v)) /\ + a < u /\ + u < r /\ + (v = b)`;; + + + +(* ------------------------------------------------------------------ *) +(* SOME GENERAL TACTICS FOR THE ASSUMPTION LIST *) +(* ------------------------------------------------------------------ *) + +let (%) i = HYP (string_of_int i);; + +let WITH i rule = (H_VAL (rule) (HYP (string_of_int i))) ;; + +let (UND:int -> tactic) = + fun i (asl,w) -> + let name = "Z-"^(string_of_int i) in + try let thm= assoc name asl in + let tm = concl (thm) in + let (_,asl') = partition (fun t-> ((=) name (fst t))) asl in + null_meta,[asl',mk_imp(tm,w)], + fun i [th] -> MP th (INSTANTIATE_ALL i thm) + with Failure _ -> failwith "UND";; + +let KILL i = + (UND i) THEN (DISCH_THEN (fun t -> ALL_TAC));; + +let USE i rule = (WITH i rule) THEN (KILL i);; + +let CHO i = (UND i) THEN (DISCH_THEN CHOOSE_TAC);; + +let X_CHO i t = (UND i) THEN (DISCH_THEN (X_CHOOSE_TAC t));; + +let AND i = (UND i) THEN + (DISCH_THEN (fun t-> (ASSUME_TAC (CONJUNCT1 t) + THEN (ASSUME_TAC (CONJUNCT2 t)))));; + +let JOIN i j = + (H_VAL2 CONJ ((%)i) ((%)j)) THEN (KILL i) THEN (KILL j);; + +let COPY i = WITH i I;; + +let REP n tac = EVERY (replicate tac n);; + +let REWR i = (UND i) THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC;; + +let LEFT i t = (USE i (CONV_RULE (quant_left_CONV t)));; + +let RIGHT i t = (USE i (CONV_RULE (quant_right_CONV t)));; + +let LEFT_TAC t = ((CONV_TAC (quant_left_CONV t)));; + +let RIGHT_TAC t = ( (CONV_TAC (quant_right_CONV t)));; + +let INR = REWRITE_RULE[IN];; + +(* + + + +let rec REP n tac = if (n<=0) then ALL_TAC + else (tac THEN (REP (n-1) tac));; (* doesn't seem to work? *) + + +let COPY i = (UNDISCH_WITH i) THEN (DISCH_THEN (fun t->ALL_TAC));; + + +MANIPULATING ASSUMPTIONS. (MAKE 0= GOAL) + +COPY: int -> tactic Make a copy in adjacent slot. + + +EXPAND: int -> tactic. + conjunction -> two separate. + exists/goal-forall -> choose. + goal-if-then -> discharge +EXPAND_TERM: int -> term -> tactic. + constant -> expand definition or other rewrites associated. +ADD: term -> tactic. + +SIMPLIFY: int -> tactic. Apply simplification rules. + + +*) + +let CONTRAPOSITIVE_TAC = MATCH_MP_TAC (TAUT `(~q ==> ~p) ==> (p ==> q)`) + THEN REWRITE_TAC[];; + +let REWRT_TAC = (fun t-> REWRITE_TAC[t]);; + +let (REDUCE_CONV,REDUCE_TAC) = + let list = [ + (* reals *) REAL_NEG_GE0; + REAL_HALF_DOUBLE; + REAL_SUB_REFL ; + REAL_NEG_NEG; + REAL_LE; LE_0; + REAL_ADD_LINV;REAL_ADD_RINV; + REAL_NEG_0; + REAL_NEG_LE0; + REAL_NEG_GE0; + REAL_LE_NEGL; + REAL_LE_NEGR; + REAL_LE_NEG; + REAL_NEG_EQ_0; + REAL_SUB_RNEG; + REAL_ARITH `!(x:real). (--x = x) <=> (x = &.0)`; + REAL_ARITH `!(a:real) b. (a - b + b) = a`; + REAL_ADD_LID; + REAL_ADD_RID ; + REAL_INV_0; + REAL_OF_NUM_EQ; + REAL_OF_NUM_LE; + REAL_OF_NUM_LT; + REAL_OF_NUM_ADD; + REAL_OF_NUM_MUL; + REAL_POS; + REAL_MUL_RZERO; + REAL_MUL_LZERO; + REAL_LE_01; + REAL_SUB_RZERO; + REAL_LE_SQUARE; + REAL_MUL_RID; + REAL_MUL_LID; + REAL_ABS_ZERO; + REAL_ABS_NUM; + REAL_ABS_1; + REAL_ABS_NEG; + REAL_ABS_POS; + ABS_ZERO; + ABS_ABS; + REAL_NEG_LT0; + REAL_NEG_GT0; + REAL_LT_NEG; + REAL_NEG_MUL2; + REAL_OF_NUM_POW; + REAL_LT_INV_EQ; + REAL_POW_1; + REAL_INV2; + prove (`(--. (&.n) < (&.m)) <=> (&.0 < (&.n) + (&.m))`,REAL_ARITH_TAC); + prove (`(--. (&.n) <= (&.m)) <=> (&.0 <= (&.n) + (&.m))`,REAL_ARITH_TAC); + prove (`(--. (&.n) = (&.m)) <=> ((&.n) + (&.m) = (&.0))`,REAL_ARITH_TAC); + prove (`((&.n) < --.(&.m)) <=> ((&.n) + (&.m) <. (&.0))`,REAL_ARITH_TAC); + prove (`((&.n) <= --.(&.m)) <=> ((&.n) + (&.m) <=. (&.0))`,REAL_ARITH_TAC); + prove (`((&.n) = --.(&.m)) <=> ((&.n) + (&.m) = (&.0))`,REAL_ARITH_TAC); + prove (`((&.n) < --.(&.m) + &.r) <=> ((&.n) + (&.m) < (&.r))`,REAL_ARITH_TAC); + prove (`(--. x = --. y) <=> (x = y)`,REAL_ARITH_TAC); + prove (`(--(&.n) < --.(&.m) + &.r) <=> ( (&.m) < &.n + (&.r))`,REAL_ARITH_TAC); + prove (`(--. x = --. y) <=> (x = y)`,REAL_ARITH_TAC); + prove (`((--. (&.1))* x < --. y <=> y < x)`,REAL_ARITH_TAC ); + prove (`((--. (&.1))* x <= --. y <=> y <= x)`,REAL_ARITH_TAC ); + (* num *) + EXP_1; + EXP_LT_0; + ADD_0; + ARITH_RULE `0+| m = m`; + ADD_EQ_0; + prove (`(0 = m +|n) <=> (m = 0)/\ (n=0)`,MESON_TAC[ADD_EQ_0]); + EQ_ADD_LCANCEL_0; + EQ_ADD_RCANCEL_0; + LT_ADD; + LT_ADDR; + ARITH_RULE `(0 = j -| i) <=> (j <=| i)`; + ARITH_RULE `(j -| i = 0) <=> (j <=| i)`; + ARITH_RULE `0 -| i = 0`; + ARITH_RULE `(i<=| j) /\ (j <=| i) <=> (i = j)`; + ARITH_RULE `0 <| 1`; + (* SUC *) + NOT_SUC; + SUC_INJ; + PRE; + ADD_CLAUSES; + MULT; + MULT_CLAUSES; + LE; LT; + ARITH_RULE `SUC b -| 1 = b`; + ARITH_RULE `SUC b -| b = 1`; + prove(`&.(SUC x) - &.x = &.1`, + REWRITE_TAC [REAL_ARITH `(a -. b=c) <=> (a = b+.c)`; + REAL_OF_NUM_ADD;REAL_OF_NUM_EQ] THEN ARITH_TAC); + (* (o) *) + o_DEF; + (* I *) + I_THM; + I_O_ID; + (* pow *) + REAL_POW_1; + REAL_POW_ONE; + (* INT *) + INT_ADD_LINV; + INT_ADD_RINV; + INT_ADD_SUB2; + INT_EQ_NEG2; + INT_LE_NEG; + INT_LE_NEGL; + INT_LE_NEGR; + INT_LT_NEG; + INT_LT_NEG2; + INT_NEGNEG; + INT_NEG_0; + INT_NEG_EQ_0; + INT_NEG_GE0; + INT_NEG_GT0; + INT_NEG_LE0; + INT_NEG_LT0; + GSYM INT_NEG_MINUS1; + INT_NEG_MUL2; + INT_NEG_NEG; + (* sets *) + ] in +(REWRITE_CONV list,REWRITE_TAC list);; + + + + + +(* prove by squaring *) +let REAL_POW_2_LE = prove_by_refinement( + `!x y. (&.0 <= x) /\ (&.0 <= y) /\ (x pow 2 <=. y pow 2) ==> (x <=. y)`, + (* {{{ proof *) + [ + DISCH_ALL_TAC; + MP_TAC (SPECL[` (x:real) pow 2`;`(y:real)pow 2`] SQRT_MONO_LE); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_POW_LE]; + ASM_SIMP_TAC[POW_2_SQRT]; + ]);; + (* }}} *) + +(* prove by squaring *) +let REAL_POW_2_LT = prove_by_refinement( + `!x y. (&.0 <= x) /\ (&.0 <= y) /\ (x pow 2 <. y pow 2) ==> (x <. y)`, + (* {{{ proof *) + + [ + DISCH_ALL_TAC; + MP_TAC (SPECL[` (x:real) pow 2`;`(y:real)pow 2`] SQRT_MONO_LT); + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_POW_LE]; + ASM_SIMP_TAC[POW_2_SQRT]; + ]);; + + (* }}} *) + +let SQUARE_TAC = + FIRST[ + MATCH_MP_TAC REAL_LE_LSQRT; + MATCH_MP_TAC REAL_POW_2_LT; + MATCH_MP_TAC REAL_POW_2_LE + ] + THEN REWRITE_TAC[];; + +(****) + +let SPEC2_TAC t = SPEC_TAC (t,t);; + +let IN_ELIM i = (USE i (REWRITE_RULE[IN]));; + +let rec range i n = + if (n>0) then (i::(range (i+1) (n-1))) else [];; + + +(* in elimination *) + +let (IN_OUT_TAC: tactic) = + fun (asl,g) -> (REWRITE_TAC [IN] THEN + (EVERY (map (IN_ELIM) (range 0 (length asl))))) (asl,g);; + +let (IWRITE_TAC : thm list -> tactic) = + fun thlist -> REWRITE_TAC (map INR thlist);; + +let (IWRITE_RULE : thm list -> thm -> thm) = + fun thlist -> REWRITE_RULE (map INR thlist);; + +let IMATCH_MP imp ant = MATCH_MP (INR imp) (INR ant);; + +let IMATCH_MP_TAC imp = MATCH_MP_TAC (INR imp);; + + +let GBETA_TAC = (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));; +let GBETA_RULE = (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV));; + +(* breaks antecedent into multiple cases *) +let REP_CASES_TAC = + REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC));; + +let TSPEC t i = TYPE_THEN t (USE i o SPEC);; + +let IMP_REAL t i = (USE i (MATCH_MP (REAL_ARITH t)));; + +(* goes from f = g to fz = gz *) +let TAPP z i = TYPE_THEN z (fun u -> (USE i(fun t -> AP_THM t u)));; + +(* ONE NEW TACTIC -- DOESN'T WORK!! DON'T USE.... +let CONCL_TAC t = let co = snd (dest_imp (concl t)) in + SUBGOAL_TAC co THEN (TRY (IMATCH_MP_TAC t));; +*) + +(* subgoal the antecedent of a THM, in order to USE the conclusion *) +let ANT_TAC t = let (ant,co) = (dest_imp (concl t)) in + SUBGOAL_TAC ant + THENL [ALL_TAC;DISCH_THEN (fun u-> MP_TAC (MATCH_MP t u))];; + + +let TH_INTRO_TAC tl th = TYPEL_THEN tl (fun t-> ANT_TAC (ISPECL t th));; + +let THM_INTRO_TAC tl th = TYPEL_THEN tl + (fun t-> + let s = ISPECL t th in + if is_imp (concl s) then ANT_TAC s else ASSUME_TAC s);; + +let (DISCH_THEN_FULL_REWRITE:tactic) = + DISCH_THEN (fun t-> REWRITE_TAC[t] THEN + (RULE_ASSUM_TAC (REWRITE_RULE[t])));; + +let FULL_REWRITE_TAC t = (REWRITE_TAC t THEN (RULE_ASSUM_TAC (REWRITE_RULE t)));; + +(* ------------------------------------------------------------------ *) + +let BASIC_TAC = + [ GEN_TAC; + IMATCH_MP_TAC (TAUT ` (a ==> b ==> C) ==> ( a /\ b ==> C)`); + DISCH_THEN (CHOOSE_THEN MP_TAC); + FIRST_ASSUM (fun t-> UNDISCH_TAC (concl t) THEN + (DISCH_THEN CHOOSE_TAC)); + FIRST_ASSUM (fun t -> + (if (length (CONJUNCTS t) < 2) then failwith "BASIC_TAC" + else UNDISCH_TAC (concl t))); + DISCH_TAC; + ];; + +let REP_BASIC_TAC = REPEAT (CHANGED_TAC (FIRST BASIC_TAC));; + +(* ------------------------------------------------------------------ *) + +let USE_FIRST rule = + FIRST_ASSUM (fun t -> (UNDISCH_TAC (concl t) THEN + (DISCH_THEN (ASSUME_TAC o rule))));; + +let WITH_FIRST rule = + FIRST_ASSUM (fun t -> ASSUME_TAC (rule t));; + +let UNDF t = (TYPE_THEN t UNDISCH_FIND_TAC );; + +let GRABF t ttac = (UNDF t THEN (DISCH_THEN ttac));; + +let USEF t rule = + (TYPE_THEN t (fun t' -> UNDISCH_FIND_THEN t' + (fun u -> ASSUME_TAC (rule u))));; + + +(* ------------------------------------------------------------------ *) +(* UNIFY_EXISTS_TAC *) +(* ------------------------------------------------------------------ *) + +let rec EXISTSL_TAC tml = match tml with + a::tml' -> EXISTS_TAC a THEN EXISTSL_TAC tml' | + [] -> ALL_TAC;; + +(* + Goal: ?x1....xn. P1 /\ ... /\ Pm + Try to pick ALL of x1...xn to unify ONE or more Pi with terms + appearing in the assumption list, trying term_unify on + each Pi with each assumption. +*) +let (UNIFY_EXISTS_TAC:tactic) = + let run_one wc assum (varl,sofar) = + if varl = [] then (varl,sofar) else + try ( + let wc' = instantiate ([],sofar,[]) wc in + let (_,ins,_) = term_unify varl wc' assum in + let insv = map snd ins in + ( subtract varl insv , union sofar ins ) + ) with failure -> (varl,sofar) in + let run_onel asl wc (varl,sofar) = + itlist (run_one wc) asl (varl,sofar) in + let run_all varl sofar wcl asl = + itlist (run_onel asl) wcl (varl,sofar) in + let full_unify (asl,w) = + let (varl,ws) = strip_exists w in + let vargl = map genvar (map type_of varl) in + let wg = instantiate ([],zip vargl varl,[]) ws in + let wcg = conjuncts wg in + let (vargl',sofar) = run_all vargl [] wcg ( asl) in + if (vargl' = []) then + map (C rev_assoc sofar) (map (C rev_assoc (zip vargl varl)) varl) + else failwith "full_unify: unification not found " in + fun (asl,w) -> + try( + let asl' = map (concl o snd) asl in + let asl'' = flat (map (conjuncts ) asl') in + let varsub = full_unify (asl'',w) in + EXISTSL_TAC varsub (asl,w) + ) with failure -> failwith "UNIFY_EXIST_TAC: unification not found.";; + +(* partial example *) +let unify_exists_tac_example = try(prove_by_refinement( + `!C a b v A R TX U SS. (A v /\ (a = v) /\ (C:num->num->bool) a b /\ R a ==> + ?v v'. TX v' /\ U v v' /\ C v' v /\ SS v)`, + (* {{{ proof *) + + [ + REP_BASIC_TAC; + UNIFY_EXISTS_TAC; (* v' -> a and v -> b *) + (* not finished. Here is a variant approach. *) + REP_GEN_TAC; + DISCH_TAC; + UNIFY_EXISTS_TAC; + ])) with failure -> (REFL `T`);; + + (* }}} *) + +(* ------------------------------------------------------------------ *) +(* UNIFY_EXISTS conversion *) +(* ------------------------------------------------------------------ *) + +(* + FIRST argument is the "certificate" + second arg is the goal. + Example: + UNIFY_EXISTS `(f:num->bool) x` `?t. (f:num->bool) t` +*) + +let (UNIFY_EXISTS:thm -> term -> thm) = + let run_one wc assum (varl,sofar) = + if varl = [] then (varl,sofar) else + try ( + let wc' = instantiate ([],sofar,[]) wc in + let (_,ins,_) = term_unify varl wc' assum in + let insv = map snd ins in + ( subtract varl insv , union sofar ins ) + ) with failure -> (varl,sofar) in + let run_onel asl wc (varl,sofar) = + itlist (run_one wc) asl (varl,sofar) in + let run_all varl sofar wcl asl = + itlist (run_onel asl) wcl (varl,sofar) in + let full_unify (t,w) = + let (varl,ws) = strip_exists w in + let vargl = map genvar (map type_of varl) in + let wg = instantiate ([],zip vargl varl,[]) ws in + let wcg = conjuncts wg in + let (vargl',sofar) = run_all vargl [] wcg ( [concl t]) in + if (vargl' = []) then + map (C rev_assoc sofar) (map (C rev_assoc (zip vargl varl)) varl) + else failwith "full_unify: unification not found " in + fun t w -> + try( + if not(is_exists w) then failwith "UNIFY_EXISTS: not EXISTS" else + let varl' = (full_unify (t,w)) in + let (varl,ws) = strip_exists w in + let varsub = zip varl' varl in + let varlb = map (fun s-> chop_list s (rev varl)) + (range 1 (length varl)) in + let targets = map (fun s-> (instantiate ([],varsub,[]) + (list_mk_exists( rev (fst s), ws)) )) varlb in + let target_zip = zip (rev targets) varl' in + itlist (fun s th -> EXISTS s th) target_zip t + ) with failure -> failwith "UNIFY_EXISTS: unification not found.";; + +let unify_exists_example= + UNIFY_EXISTS (ARITH_RULE `2 = 0+2`) `(?x y. ((x:num) = y))`;; + +(* now make a prover for it *) + + +(* ------------------------------------------------------------------ *) + +(* +drop_ant_tac replaces + 0 A ==>B + 1 A +with + 0 B + 1 A +in hypothesis list +*) +let DROP_ANT_TAC pq = + UNDISCH_TAC pq THEN (UNDISCH_TAC (fst (dest_imp pq))) THEN + DISCH_THEN (fun pthm -> ASSUME_TAC pthm THEN + DISCH_THEN (fun pqthm -> ASSUME_TAC (MATCH_MP pqthm pthm )));; + +let (DROP_ALL_ANT_TAC:tactic) = + fun (asl,w) -> + let imps = filter (is_imp) (map (concl o snd) asl) in + MAP_EVERY (TRY o DROP_ANT_TAC) imps (asl,w);; + +let drop_ant_tac_example = prove_by_refinement( + `!A B C D E. (A /\ (A ==> B) /\ (C ==>D) /\ C) ==> (E \/ C \/ B)`, + (* {{{ proof *) + [ + REP_BASIC_TAC; + DROP_ALL_ANT_TAC; + ASM_REWRITE_TAC[]; + ]);; + (* }}} *) + +(* ------------------------------------------------------------------ *) + +(* ASSUME tm, then prove it later. almost the same as asm-cases-tac *) +let (BACK_TAC : term -> tactic) = + fun tm (asl,w) -> + let ng = mk_imp (tm,w) in + (SUBGOAL_TAC ng THENL [ALL_TAC;DISCH_THEN IMATCH_MP_TAC ]) (asl,w);; + +(* --- *) +(* Using hash numbers for tactics *) +(* --- *) + +let label_of_hash ((asl,g):goal) (h:int) = + let one_label h (s,tm) = + if (h = hash_of_term (concl tm)) then + let s1 = String.sub s 2 (String.length s - 2) in + int_of_string s1 + else failwith "label_of_hash" in + tryfind (one_label h) asl;; + +let HASHIFY m h w = m (label_of_hash w h) w;; +let UNDH = HASHIFY UND;; +let REWRH = HASHIFY REWR;; +let KILLH = HASHIFY KILL;; +let COPYH = HASHIFY COPY;; +let HASHIFY1 m h tm w = m (label_of_hash w h) tm w;; +let USEH = HASHIFY1 USE;; +let LEFTH = HASHIFY1 LEFT;; +let RIGHTH = HASHIFY1 RIGHT;; +let TSPECH tm h w = TSPEC tm (label_of_hash w h) w ;; diff --git a/Jordan/tactics_fix.ml b/Jordan/tactics_fix.ml new file mode 100644 index 0000000..b1fa085 --- /dev/null +++ b/Jordan/tactics_fix.ml @@ -0,0 +1,133 @@ +(* ------------------------------------------------------------------------- *) +(* A printer for goals etc. *) +(* ------------------------------------------------------------------------- *) + +(* had (rev asl) in this method. I don't want to reverse the list *) + + +let hash_of_string = + let prime200 = 1223 in + let prime = 8831 in + let rec hashll v = match v with + | [] -> 0 + | h::t -> + (int_of_char (String.get h 0) + prime200*( hashll t)) mod prime in + fun s -> + let slt = explode s in + hashll slt;; + +let saved_hashstring = + ref ((Hashtbl.create 300):(string,int) Hashtbl.t);; +let save_hashstring string = + Hashtbl.add !saved_hashstring (string) (hash_of_string string);; +let mem_hashstring s = Hashtbl.mem !saved_hashstring s;; +let remove_hashstring s = Hashtbl.remove !saved_hashstring s;; +let find_hashstring s = Hashtbl.find !saved_hashstring s;; + +let memhash_of_string s = + if not(mem_hashstring s) then (save_hashstring s) ; + find_hashstring s;; + +let hash_of_type = + let prime150 = 863 in + let prime160 = 941 in + let prime180 = 1069 in + let prime190 = 1151 in + let prime1200 = 9733 in + let rec hashl u = match u with + | [] -> 0 + | h::t -> ((hasht h) + prime190*(hashl t)) mod prime1200 + and + hasht v = match v with + | Tyvar s -> (prime150*memhash_of_string s + prime160) mod prime1200 + | Tyapp (s,tlt) -> let h = memhash_of_string s in + let h2 = (h*h) mod prime1200 in + (prime180*h2 + hashl tlt ) mod prime1200 in + hasht;; + +(* make hash_of_term constant on alpha-equivalence classes of + terms *) + +let rename_var n = + fun v -> mk_var ("??_"^(string_of_int n),type_of v);; + +let paform = + let rec raform n env tm = + match tm with + | Var(_,_) -> assocd tm env tm + | Const(_,_) -> tm + | Comb (s,t) -> mk_comb(raform n env s, raform n env t) + | Abs (x,t) -> let x1 = rename_var n x in + mk_abs(x1, raform (n+1) ((x,x1)::env) t) in + raform 0 [];; + +let hash_of_term = + let prime1220 = 9887 in + let prime210 = 1291 in + let prime220 = 1373 in + let prime230 = 1451 in + let prime240 = 1511 in + let prime250 = 1583 in + let prime260 = 1657 in + let prime270 = 1733 in + let prime280 = 1811 in + let rec hasht u = match u with + | Var (s,t) -> + (prime210*(memhash_of_string s) + hash_of_type t) mod prime1220 + | Const (s,t) -> + (prime220*(memhash_of_string s) + hash_of_type t) mod prime1220 + | Comb (s,t) -> let h = hasht s in + let h2 = (h*h) mod prime1220 in + (prime230*h2 + prime240*hasht t + prime250) mod prime1220 + | Abs (s,t) -> let h = hasht s in + let h2 = (h*h) mod prime1220 in + (prime260*h2 + prime270*hasht t + prime280) mod prime1220 + in hasht o paform;; + +let print_hyp n (s,th) = + open_hbox(); + print_string " "; + print_as 4 (string_of_int (hash_of_term (concl th))); + print_string " ["; + print_qterm (concl th); + print_string "]"; + (if not (s = "") then (print_string (" ("^s^")")) else ()); + close_box(); + print_newline();; + +let rec print_hyps n asl = + if asl = [] then () else + (print_hyp n (hd asl); + print_hyps (n + 1) (tl asl));; + +let (print_goal_hashed:goal->unit) = + fun (asl,w) -> + print_newline(); + if asl <> [] then (print_hyps 0 (asl); print_newline()) else (); + print_qterm w; print_newline();; + +let (print_goalstate_hashed:int->goalstate->unit) = + fun k gs -> let (_,gl,_) = gs in + let n = length gl in + let s = if n = 0 then "No subgoals" else + (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") + ^" ("^(string_of_int n)^" total)" in + print_string s; print_newline(); + if gl = [] then () else + do_list (print_goal_hashed o C el gl) (rev(0--(k-1)));; + +let (print_goalstack_hashed:goalstack->unit) = + fun l -> + if l = [] then print_string "Empty goalstack" + else if tl l = [] then + let (_,gl,_ as gs) = hd l in + print_goalstate_hashed 1 gs + else + let (_,gl,_ as gs) = hd l + and (_,gl0,_) = hd(tl l) in + let p = length gl - length gl0 in + let p' = if p < 1 then 1 else p + 1 in + print_goalstate_hashed p' gs;; + +#install_printer print_goal_hashed;; +#install_printer print_goalstack_hashed;; diff --git a/Jordan/tactics_refine.ml b/Jordan/tactics_refine.ml new file mode 100644 index 0000000..788a20b --- /dev/null +++ b/Jordan/tactics_refine.ml @@ -0,0 +1,106 @@ + +(* ------------------------------------------------------------------ *) +(* This bundles an interactive session into a proof. *) +(* ------------------------------------------------------------------ *) + +let labels_flag = ref false;; + + +let LABEL_ALL_TAC:tactic = + let mk_label avoid = + let rec mk_one_label i avoid = + let label = "Z-"^(string_of_int i) in + if not(mem label avoid) then label else mk_one_label (i+1) avoid in + mk_one_label 0 avoid in + let update_label i asl = + let rec f_at_i f j = + function [] -> [] + | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in + let avoid = map fst asl in + let current = el i avoid in + let new_label = mk_label avoid in + if (String.length current > 0) then asl else + f_at_i (fun (_,y) -> (new_label,y) ) i asl in + fun (asl,w) -> + let aslp = ref asl in + (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done; + (ALL_TAC (!aslp,w)));; + +(* global_var *) +let (EVERY_STEP_TAC:tactic ref) = ref ALL_TAC;; + +let (e:tactic ->goalstack) = + fun tac -> refine(by(VALID + (if !labels_flag then (tac THEN (!EVERY_STEP_TAC)) THEN LABEL_ALL_TAC + else tac)));; + +let has_stv t = + let typ = (type_vars_in_term t) in + can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;; + +let prove_by_refinement(t,(tacl:tactic list)) = + if (length (frees t) > 0) + then failwith "prove_by_refinement: free vars" else + if (has_stv t) + then failwith "prove_by_refinement: has stv" else + let gstate = mk_goalstate ([],t) in + let _,sgs,just = rev_itlist + (fun tac gs -> by + (if !labels_flag then (tac THEN + (!EVERY_STEP_TAC) THEN LABEL_ALL_TAC ) else tac) gs) + tacl gstate in + let th = if sgs = [] then just null_inst [] + else failwith "BY_REFINEMENT_PROOF: Unsolved goals" in + let t' = concl th in + if t' = t then th else + try EQ_MP (ALPHA t' t) th + with Failure _ -> failwith "prove_by_refinement: generated wrong theorem";; + + +(* ------------------------------------------------------------------ *) +(* DUMPING AND PRELOADED THEOREMS *) +(* ------------------------------------------------------------------ *) + + +let saved_thm = ref ((Hashtbl.create 300):(term,thm) Hashtbl.t);; +let save_thm thm = Hashtbl.add !saved_thm (concl thm) thm;; +let mem_thm tm = Hashtbl.mem !saved_thm tm;; +let remove_thm tm = Hashtbl.remove !saved_thm tm;; +let find_thm tm = Hashtbl.find !saved_thm tm;; + +let dump_thm file_name = + let ch = open_out_bin file_name in + (output_value ch !saved_thm; + close_out ch);; + +let load_thm file_name = + let ch = open_in_bin file_name in + (saved_thm := input_value ch; + close_in ch);; + +(* ------------------------------------------------------------------ *) +(* PROOFS STORED. *) +(* ------------------------------------------------------------------ *) + +let old_prove = prove;; +let old_prove_by_refinement = prove_by_refinement;; +let fast_load = ref true;; + +let set_fast_load file_name = + (fast_load := true; + load_thm file_name);; + +let set_slow_load () = + (fast_load := false;);; + +let prove (x, tac) = + if (!fast_load) then (try(find_thm x) with failure -> old_prove(x,tac)) + else (let t = old_prove(x,tac) in (save_thm t; t));; + +let prove_by_refinement (x, tacl) = + if (!fast_load) then (try(find_thm x) + with failure -> old_prove_by_refinement(x,tacl)) + else (let t = old_prove_by_refinement(x,tacl) in (save_thm t; t));; + +if (false) then (set_fast_load "thm.dump") else (fast_load:=false);; + diff --git a/LP_arith/lp_arith.ml b/LP_arith/lp_arith.ml new file mode 100644 index 0000000..9ad48cd --- /dev/null +++ b/LP_arith/lp_arith.ml @@ -0,0 +1,128 @@ + +(* small LP-based prover, to convert the HOL-terms to a coefficient + matrix and back it uses the code of REAL_LINEAR_PROVER in the HOL + Light distribution *) + + +let cddwrapper = "cdd_cert";; + +(* in lin_of_hol one can replace the call to linear_add to a call to lin_add *) + +let lin_of_hol = + let one_tm = `&1:real` + and zero_tm = `&0:real` + and add_tm = `(+):real->real->real` + and mul_tm = `(*):real->real->real` + and lin_add = combine (+/) (fun x -> x =/ num_0) in + let rec lin_of_hol tm = + if tm = zero_tm then undefined + else if not (is_comb tm) then (tm |=> Int 1) + else if is_ratconst tm then (one_tm |=> rat_of_term tm) else + let lop,r = dest_comb tm in + if not (is_comb lop) then (tm |=> Int 1) else + let op,l = dest_comb lop in + if op = add_tm then lin_add (lin_of_hol l) (lin_of_hol r) + else if op = mul_tm & is_ratconst l then (r |=> rat_of_term l) + else (tm |=> Int 1) in + lin_of_hol;; + +let words s = + let stre = Stream.of_string s in + let is_empty st = match Stream.peek st with + None -> true + | Some _ -> false in + let rec sb acc st = + if is_empty st + then [acc] + else + let t = Stream.next st in + if t = ' ' then acc :: (sb "" st) else sb (acc ^ Char.escaped t) st + in filter (fun x -> x <> "") (sb "" stre);; + +let cdd ins = + let outfn = Filename.temp_file "cdd" ".res" + and infn = Filename.temp_file "cdd" ".ine" in + let s = "cat " ^ infn ^ "| " ^ cddwrapper ^ " 2> /dev/null > " ^ outfn in + let inch = open_out infn in + output_string inch ins; + close_out inch; + if Sys.command s <> 0 then failwith "cdd" else + let fd = Pervasives.open_in outfn in let data = input_line fd in close_in fd; Sys.remove infn; Sys.remove outfn; data;; + +let rec take n l = + match l with + x :: xs -> if n = 0 then [] else x :: (take (n-1) xs) + | [] -> [];; + +let rec drop n l = + match l with + x :: xs -> if n = 0 then l else (drop (n-1) xs) + | [] -> [];; + +let lp_prover (eq,le,lt) = + let one_tm = `&1:real` in + let vars = (subtract (itlist (union o dom) (eq@le@lt) []) [one_tm]) in + let neq = length eq + and nle = length le + and nlt = length lt + and nr = length (eq@le@lt) in + let get_row v = map (fun x -> applyd x (fun _ -> num_0) v) (eq@le@lt) in + let rec rep n e = if n = 0 then [] else e :: (rep (n-1) e) in + let one_at n = + map (fun i -> (rep i (num_0))@[num_1]@(rep (n-i-1) (num_0))) (0--(n-1)) in + let main_rows = map ((fun l -> num_0::l) o get_row) vars + and lt_row = [minus_num num_1] @ (rep (length eq) num_0) @ + (rep (length le) num_0) @ (rep (length lt) num_1) + and pos_rows = map (fun l -> (rep (length eq + 1 ) num_0) @ l) + (one_at (length (le@lt))) + and bvec = (num_0 :: (get_row one_tm)) in + let mat = main_rows@[lt_row]@pos_rows in + let string_of_row = (String.concat " ") o (map string_of_num) in + let cddlp = (String.concat "\n" + ["H-representation"; + "linearity "^(string_of_int (length main_rows))^" "^ + (String.concat " " (map string_of_int (1--(length main_rows)))); + "begin"; + String.concat " " [string_of_int (length mat);string_of_int (nr+1);"rational"]; + String.concat "\n" (map string_of_row mat); + "end"; + String.concat " " ["minimize";string_of_row bvec]]) in + let outp = (cdd cddlp) in + let res = (* print_string cddlp; print_newline(); *)(* print_string outp; print_newline(); *) + if outp = "No Contradiction" then failwith "No contradiction" else map Num.num_of_string (words outp) in + let (req,rle,rlt) = (take neq res, + take nle (drop neq res), + take nlt (drop (nle+neq) res)) in + let peq = map2 (fun r e -> if (r =/ num_0) then [] else [Eqmul (term_of_rat r, Axiom_eq e)]) req (0--(neq-1)) + and ple = map2 (fun r e -> if (r =/ num_0) then [] else [Product (Rational_lt r,Axiom_le e)]) rle (0--(nle-1)) + and plt = map2 (fun r e -> if (r =/ num_0) then [] else [Product (Rational_lt r,Axiom_lt e)]) rlt (0--(nlt-1)) in + let pp = List.flatten (peq@ple@plt) in + let refu = itlist (fun acc x -> Sum (acc,x)) (tl pp) (hd pp) in + (* print_string outp; *) + (* print_newline(); *) + refu;; + +let LP_PROVER = + let is_alien tm = + match tm with + Comb(Const("real_of_num",_),n) when not(is_numeral n) -> true + | _ -> false in + let n_tm = `n:num` in + let pth = REWRITE_RULE[GSYM real_ge] (SPEC n_tm REAL_POS) in + fun translator (eq,le,lt) -> + let eq_pols = map (lin_of_hol o lhand o concl) eq + and le_pols = map (lin_of_hol o lhand o concl) le + and lt_pols = map (lin_of_hol o lhand o concl) lt in + let aliens = filter is_alien + (itlist (union o dom) (eq_pols @ le_pols @ lt_pols) []) in + let le_pols' = le_pols @ map (fun v -> (v |=> Int 1)) aliens in + let proof = lp_prover(eq_pols,le_pols',lt_pols) in + let le' = le @ map (fun a -> INST [rand a,n_tm] pth) aliens in + translator (eq,le',lt) proof;; + +let LP_ARITH = + let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] + and pure = GEN_REAL_ARITH LP_PROVER in + fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; + +let LP_ARITH_TAC = CONV_TAC LP_ARITH;; diff --git a/LP_arith/lp_tests.ml b/LP_arith/lp_tests.ml new file mode 100644 index 0000000..89ef7ce --- /dev/null +++ b/LP_arith/lp_tests.ml @@ -0,0 +1,65 @@ +let rec_seq = ` !x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11:real. + x3 = abs(x2) - x1 /\ x4 = abs(x3) - x2 /\ x5 = abs(x4) - x3 /\ + x6 = abs(x5) - x4 /\ x7 = abs(x6) - x5 /\ + x8 = abs(x7) - x6 /\ x9 = abs(x8) - x7 /\ x10 = abs(x9) - x8 /\ + x11 = abs(x10) - x9 ==> x1 = x10 /\ x2 = x11`;; + +let test_std = `!a b c d. + ((&0 + &1 * a + &0 * b + &0 * c + &0 * d >= &0) + /\ + (&0 + &0 * a + &1 * b + &0 * c + &0 * d >= &0) + /\ + (&0 + &0 * a + &0 * b + &1 * c + &0 * d >= &0) + /\ + (&0 + &0 * a + &0 * b + &0 * c + &1 * d >= &0) + /\ + (&0 + &3008 * a + &20980 * b + (-- &97775) * c + (-- &101225) * d >= &0) + /\ + (&0 + &3985 * a + &25643 * b + (-- &135871) * c + (-- &130580) * d >= &0) + /\ + (&0 + &4324 * a + &26978 * b + (-- &133655) * c + (-- &168473) * d >= &0) + /\ + (&0 + &3534 * a + &25361 * b + (-- &46243) * c + (-- &100407) * d >= &0) + /\ +(&0 + &8836 * a + &40796 * b + (-- &176661) * c + (-- &215616) * d >= &0) + /\ + (&0 + &5376 * a + &37562 * b + (-- &182576) * c + (-- &217615) * d >= &0) + /\ + (&0 + &4982 * a + &33088 * b + (-- &98880) * c + (-- &167278) * d >= &0) + /\ + (&0 + &4775 * a + &39122 * b + (-- &136701) * c + (-- &193393) * d >= &0) + /\ + (&0 + &8046 * a + &42958 * b + (-- &225138) * c + (-- &256575) * d >= &0) + /\ + (&0 + &8554 * a + &48955 * b + (-- &257370) * c + (-- &312877) * d >= &0) + /\ + (&0 + &6147 * a + &45514 * b + (-- &165274) * c + (-- &227099) * d >= &0) + /\ + (&0 + &8366 * a + &55140 * b + (-- &203989) * c + (-- &321623) * d >= &0) + /\ + (&0 + &13479 * a + &68037 * b + (-- &174270) * c + (-- &341743) * d >= &0) + /\ + (&0 + &21808 * a + &78302 * b + (-- &322990) * c + (-- &487539) * d >= &0) + /\ + (&1 + (-- &8554 / &10000) * a + (-- &48955 / &10000) * b + &0 * c + &0 * d >= &0) + /\ + (&1 + &0 * a + &0 * b + (-- &257370 / &10000) * c + (-- &312877 / &10000) * d >= &0)) ==> + &1 * a + &1 / &2 * b + &1 / &3 * c + &1 / &4 * d <= &2057990000 / &1743360801`;; + +let gale = `~(?T14 T24 T25 T35 T46 T47 T57 T58. + T14 < &20 /\ + T24 + T25 < &20 /\ + T35 < &20 /\ + T14 + T24 - T46 - T47 = &0 /\ + T25 + T35 - T57 - T58 = &0 /\ + T46 > &10 /\ + T47 + T57 > &20 /\ + T58 > &30 /\ + T14 < &30 /\ + T24 < &20 /\ + T25 < &10 /\ + T35 < &10 /\ + T46 < &10 /\ + T47 < &2 /\ + T57 < &20 /\ + T58 < &30)`;; diff --git a/LP_arith/make.ml b/LP_arith/make.ml new file mode 100644 index 0000000..b8cc97e --- /dev/null +++ b/LP_arith/make.ml @@ -0,0 +1,8 @@ +loadt "LP_arith/lp_arith.ml";; +loadt "LP_arith/lp_tests.ml";; + +time LP_ARITH rec_seq;; +time LP_ARITH test_std;; + +time REAL_ARITH rec_seq;; +time REAL_ARITH test_std;; diff --git a/Library/agm.ml b/Library/agm.ml new file mode 100644 index 0000000..9b6a16f --- /dev/null +++ b/Library/agm.ml @@ -0,0 +1,131 @@ +(* ========================================================================= *) +(* Arithmetic-geometric mean inequality. *) +(* ========================================================================= *) + +needs "Library/products.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Various trivial lemmas. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_2 = prove + (`!P. (!i. 1 <= i /\ i <= 2 ==> P i) <=> P 1 /\ P 2`, + MESON_TAC[ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`]);; + +let NUMSEG_2 = prove + (`1..2 = {1,2}`, + REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC);; + +let AGM_2 = prove + (`!x y. x * y <= ((x + y) / &2) pow 2`, + REWRITE_TAC[REAL_LE_SQUARE; REAL_ARITH + `x * y <= ((x + y) / &2) pow 2 <=> &0 <= (x - y) * (x - y)`]);; + +let SUM_SPLIT_2 = prove + (`sum(1..2*n) f = sum(1..n) f + sum(n+1..2*n) f`, + SIMP_TAC[MULT_2; ARITH_RULE `1 <= n + 1`; SUM_ADD_SPLIT]);; + +let PRODUCT_SPLIT_2 = prove + (`product(1..2*n) f = product(1..n) f * product(n+1..2*n) f`, + SIMP_TAC[MULT_2; ARITH_RULE `1 <= n + 1`; PRODUCT_ADD_SPLIT]);; + +(* ------------------------------------------------------------------------- *) +(* Specialized induction principle. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_INDUCT = prove + (`!P. P 2 /\ (!n. P n ==> P(2 * n)) /\ (!n. P(n + 1) ==> P n) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `P(0) /\ P(1)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `1 = 0 + 1 /\ 2 = 1 + 1`]; ALL_TAC] THEN + ASM_CASES_TAC `EVEN n` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + ASM_MESON_TAC[ARITH_RULE `2 * n = 0 \/ n < 2 * n`]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EVEN]) THEN + SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + ASM_MESON_TAC[ARITH_RULE `SUC(2 * m) = 1 \/ m + 1 < SUC(2 * m)`; + ARITH_RULE `SUC(2 * m) + 1 = 2 * (m + 1)`]);; + +(* ------------------------------------------------------------------------- *) +(* The main result. *) +(* ------------------------------------------------------------------------- *) + +let AGM = prove + (`!n a. 1 <= n /\ (!i. 1 <= i /\ i <= n ==> &0 <= a(i)) + ==> product(1..n) a <= (sum(1..n) a / &n) pow n`, + MATCH_MP_TAC CAUCHY_INDUCT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[FORALL_2; NUMSEG_2] THEN + SIMP_TAC[SUM_CLAUSES; PRODUCT_CLAUSES; FINITE_RULES; IN_INSERT; + NOT_IN_EMPTY; ARITH; REAL_MUL_RID; REAL_ADD_RID] THEN + REWRITE_TAC[AGM_2]; + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN + STRIP_TAC THEN REWRITE_TAC[SUM_SPLIT_2; PRODUCT_SPLIT_2] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(sum(1..n) a / &n) pow n * (sum(n+1..2*n) a / &n) pow n` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PRODUCT_POS_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= 2 * n`]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= 2 * n`; + ARITH_RULE `1 <= 2 * n ==> 1 <= n`]; + MATCH_MP_TAC PRODUCT_POS_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `n + 1 <= i ==> 1 <= i`]; + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[MULT_2] THEN + REWRITE_TAC[PRODUCT_OFFSET; SUM_OFFSET] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[ARITH_RULE + `1 <= i /\ i <= n ==> 1 <= i + n /\ i + n <= 2 * n`; + ARITH_RULE `1 <= 2 * n ==> 1 <= n`]]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_POW_MUL; GSYM REAL_POW_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + SUBST1_TAC(REAL_ARITH `&2 * &n = &n * &2`) THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `(x + y) * (a * b) = (x * a + y * a) * b`] THEN + REWRITE_TAC[GSYM real_div; AGM_2] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN + REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC SUM_POS_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `a:num->real` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `\i. if i <= n then a(i) else sum(1..n) a / &n`) THEN + REWRITE_TAC[ARITH_RULE `1 <= n + 1`] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; IN_NUMSEG]; + ALL_TAC] THEN + ABBREV_TAC `A = sum(1..n) a / &n` THEN + SIMP_TAC[GSYM ADD1; PRODUCT_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG] THEN + SIMP_TAC[ARITH_RULE `1 <= SUC n /\ ~(SUC n <= n)`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN EXPAND_TAC "A" THEN + SIMP_TAC[REAL_OF_NUM_LE; ASSUME `1 <= n`; REAL_FIELD + `&1 <= &n ==> (s + s / &n) / (&n + &1) = s / &n`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[real_pow] THEN + ASM_CASES_TAC `&0 < A` THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + SUBGOAL_THEN `A = &0` MP_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM; GSYM REAL_NOT_LT] THEN + REWRITE_TAC[REAL_NOT_LT] THEN EXPAND_TAC "A" THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; IN_NUMSEG]; + ALL_TAC] THEN + EXPAND_TAC "A" THEN + REWRITE_TAC[real_div; REAL_ENTIRE; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= n ==> ~(n = 0)`] THEN DISCH_TAC THEN + DISCH_THEN(K ALL_TAC) THEN + MP_TAC(SPECL [`a:num->real`; `1`; `n:num`] SUM_POS_EQ_0_NUMSEG) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + REWRITE_TAC[ARITH_RULE `1 + n = SUC n`] THEN + DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LZERO; PRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`; REAL_MUL_RZERO; REAL_LE_REFL]]);; diff --git a/Library/analysis.ml b/Library/analysis.ml new file mode 100644 index 0000000..d58c2a3 --- /dev/null +++ b/Library/analysis.ml @@ -0,0 +1,6735 @@ +(* ========================================================================= *) +(* Elementary real analysis, with some supporting HOL88 compatibility stuff. *) +(* ========================================================================= *) + +let dest_neg_imp tm = + try dest_imp tm with Failure _ -> + try (dest_neg tm,mk_const("F",[])) + with Failure _ -> failwith "dest_neg_imp";; + +(* ------------------------------------------------------------------------- *) +(* The quantifier movement conversions. *) +(* ------------------------------------------------------------------------- *) + +let (CONV_OF_RCONV: conv -> conv) = + let rec get_bv tm = + if is_abs tm then bndvar tm + else if is_comb tm then try get_bv (rand tm) + with Failure _ -> get_bv (rator tm) + else failwith "" in + fun conv tm -> + let v = get_bv tm in + let th1 = conv tm in + let th2 = ONCE_DEPTH_CONV (GEN_ALPHA_CONV v) (rhs(concl th1)) in + TRANS th1 th2;; + +let (CONV_OF_THM: thm -> conv) = + CONV_OF_RCONV o REWR_CONV;; + +let (X_FUN_EQ_CONV:term->conv) = + fun v -> (REWR_CONV FUN_EQ_THM) THENC GEN_ALPHA_CONV v;; + +let (FUN_EQ_CONV:conv) = + fun tm -> + let vars = frees tm in + let op,[ty1;ty2] = dest_type(type_of (lhs tm)) in + if op = "fun" + then let varnm = + if (is_vartype ty1) then "x" else + hd(explode(fst(dest_type ty1))) in + let x = variant vars (mk_var(varnm,ty1)) in + X_FUN_EQ_CONV x tm + else failwith "FUN_EQ_CONV";; + +let (SINGLE_DEPTH_CONV:conv->conv) = + let rec SINGLE_DEPTH_CONV conv tm = + try conv tm with Failure _ -> + (SUB_CONV (SINGLE_DEPTH_CONV conv) THENC (TRY_CONV conv)) tm in + SINGLE_DEPTH_CONV;; + +let (OLD_SKOLEM_CONV:conv) = + SINGLE_DEPTH_CONV (REWR_CONV SKOLEM_THM);; + +let (X_SKOLEM_CONV:term->conv) = + fun v -> OLD_SKOLEM_CONV THENC GEN_ALPHA_CONV v;; + +let EXISTS_UNIQUE_CONV tm = + let v = bndvar(rand tm) in + let th1 = REWR_CONV EXISTS_UNIQUE_THM tm in + let tm1 = rhs(concl th1) in + let vars = frees tm1 in + let v = variant vars v in + let v' = variant (v::vars) v in + let th2 = + (LAND_CONV(GEN_ALPHA_CONV v) THENC + RAND_CONV(BINDER_CONV(GEN_ALPHA_CONV v') THENC + GEN_ALPHA_CONV v)) tm1 in + TRANS th1 th2;; + +let NOT_FORALL_CONV = CONV_OF_THM NOT_FORALL_THM;; + +let NOT_EXISTS_CONV = CONV_OF_THM NOT_EXISTS_THM;; + +let RIGHT_IMP_EXISTS_CONV = CONV_OF_THM RIGHT_IMP_EXISTS_THM;; + +let FORALL_IMP_CONV = CONV_OF_RCONV + (REWR_CONV TRIV_FORALL_IMP_THM ORELSEC + REWR_CONV RIGHT_FORALL_IMP_THM ORELSEC + REWR_CONV LEFT_FORALL_IMP_THM);; + +let EXISTS_AND_CONV = CONV_OF_RCONV + (REWR_CONV TRIV_EXISTS_AND_THM ORELSEC + REWR_CONV LEFT_EXISTS_AND_THM ORELSEC + REWR_CONV RIGHT_EXISTS_AND_THM);; + +let LEFT_IMP_EXISTS_CONV = CONV_OF_THM LEFT_IMP_EXISTS_THM;; + +let LEFT_AND_EXISTS_CONV tm = + let v = bndvar(rand(rand(rator tm))) in + (REWR_CONV LEFT_AND_EXISTS_THM THENC TRY_CONV (GEN_ALPHA_CONV v)) tm;; + +let RIGHT_AND_EXISTS_CONV = + CONV_OF_THM RIGHT_AND_EXISTS_THM;; + +let AND_FORALL_CONV = CONV_OF_THM AND_FORALL_THM;; + +(* ------------------------------------------------------------------------- *) +(* The slew of named tautologies. *) +(* ------------------------------------------------------------------------- *) + +let F_IMP = TAUT `!t. ~t ==> t ==> F`;; + +let LEFT_AND_OVER_OR = TAUT + `!t1 t2 t3. t1 /\ (t2 \/ t3) <=> t1 /\ t2 \/ t1 /\ t3`;; + +let RIGHT_AND_OVER_OR = TAUT + `!t1 t2 t3. (t2 \/ t3) /\ t1 <=> t2 /\ t1 \/ t3 /\ t1`;; + +(* ------------------------------------------------------------------------- *) +(* Something trivial and useless. *) +(* ------------------------------------------------------------------------- *) + +let INST_TY_TERM(substl,insttyl) th = INST substl (INST_TYPE insttyl th);; + +(* ------------------------------------------------------------------------- *) +(* Derived rules. *) +(* ------------------------------------------------------------------------- *) + +let NOT_MP thi th = + try MP thi th with Failure _ -> + try let t = dest_neg (concl thi) in + MP(MP (SPEC t F_IMP) thi) th + with Failure _ -> failwith "NOT_MP";; + +(* ------------------------------------------------------------------------- *) +(* Creating half abstractions. *) +(* ------------------------------------------------------------------------- *) + +let MK_ABS qth = + try let ov = bndvar(rand(concl qth)) in + let bv,rth = SPEC_VAR qth in + let sth = ABS bv rth in + let cnv = ALPHA_CONV ov in + CONV_RULE(BINOP_CONV cnv) sth + with Failure _ -> failwith "MK_ABS";; + +let HALF_MK_ABS th = + try let th1 = MK_ABS th in + CONV_RULE(LAND_CONV ETA_CONV) th1 + with Failure _ -> failwith "HALF_MK_ABS";; + +(* ------------------------------------------------------------------------- *) +(* Old substitution primitive, now a (not very efficient) derived rule. *) +(* ------------------------------------------------------------------------- *) + +let SUBST thl pat th = + let eqs,vs = unzip thl in + let gvs = map (genvar o type_of) vs in + let gpat = subst (zip gvs vs) pat in + let ls,rs = unzip (map (dest_eq o concl) eqs) in + let ths = map (ASSUME o mk_eq) (zip gvs rs) in + let th1 = ASSUME gpat in + let th2 = SUBS ths th1 in + let th3 = itlist DISCH (map concl ths) (DISCH gpat th2) in + let th4 = INST (zip ls gvs) th3 in + MP (rev_itlist (C MP) eqs th4) th;; + +(* ------------------------------------------------------------------------- *) +(* Various theorems have different names. *) +(* ------------------------------------------------------------------------- *) + +prioritize_num();; + +let LESS_EQUAL_ANTISYM = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ANTISYM)));; +let NOT_LESS_0 = GEN_ALL(EQF_ELIM(SPEC_ALL(CONJUNCT1 LT)));; +let LESS_LEMMA1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL(CONJUNCT2 LT))));; +let LESS_SUC_REFL = ARITH_RULE `!n. n < SUC n`;; +let LESS_EQ_SUC_REFL = ARITH_RULE `!n. n <= SUC n`;; +let LESS_EQUAL_ADD = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_EXISTS)));; +let LESS_EQ_IMP_LESS_SUC = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_SUC_LE)));; +let LESS_MONO_ADD = GEN_ALL(snd(EQ_IMP_RULE(SPEC_ALL LT_ADD_RCANCEL)));; +let LESS_SUC = ARITH_RULE `!m n. m < n ==> m < (SUC n)`;; +let LESS_ADD_1 = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL + (REWRITE_RULE[ADD1] LT_EXISTS))));; +let SUC_SUB1 = ARITH_RULE `!m. SUC m - 1 = m`;; +let LESS_ADD_SUC = ARITH_RULE `!m n. m < m + SUC n`;; +let OR_LESS = GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_SUC_LT)));; +let NOT_SUC_LESS_EQ = ARITH_RULE `!n m. ~(SUC n <= m) <=> m <= n`;; +let LESS_LESS_CASES = ARITH_RULE `!m n. (m = n) \/ m < n \/ n < m`;; +let SUB_SUB = prove + (`!b c. c <= b ==> (!a. a - (b - c) = (a + c) - b)`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN ARITH_TAC);; +let LESS_CASES_IMP = ARITH_RULE `!m n. ~(m < n) /\ ~(m = n) ==> n < m`;; +let SUB_LESS_EQ = ARITH_RULE `!n m. (n - m) <= n`;; +let SUB_EQ_EQ_0 = ARITH_RULE `!m n. (m - n = m) <=> (m = 0) \/ (n = 0)`;; +let SUB_LEFT_LESS_EQ = + ARITH_RULE `!m n p. m <= (n - p) <=> (m + p) <= n \/ m <= 0`;; +let SUB_LEFT_GREATER_EQ = ARITH_RULE `!m n p. m >= (n - p) <=> (m + p) >= n`;; +let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; +let LESS_OR = ARITH_RULE `!m n. m < n ==> (SUC m) <= n`;; +let SUB_OLD = prove(`(!m. 0 - m = 0) /\ + (!m n. (SUC m) - n = (if m < n then 0 else SUC(m - n)))`, + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN TRY (POP_ASSUM MP_TAC) THEN + ARITH_TAC);; + +(*============================================================================*) +(* Various useful tactics, conversions etc. *) +(*============================================================================*) + +(*----------------------------------------------------------------------------*) +(* SYM_CANON_CONV - Canonicalizes single application of symmetric operator *) +(* Rewrites `so as to make fn true`, e.g. fn = $<< or fn = curry$= `1` o fst *) +(*----------------------------------------------------------------------------*) + +let SYM_CANON_CONV sym fn = + REWR_CONV sym o + check (not o fn o ((snd o dest_comb) F_F I) o dest_comb);; + +(*----------------------------------------------------------------------------*) +(* IMP_SUBST_TAC - Implicational substitution for deepest matchable term *) +(*----------------------------------------------------------------------------*) + +let (IMP_SUBST_TAC:thm_tactic) = + fun th (asl,w) -> + let tms = find_terms (can (PART_MATCH (lhs o snd o dest_imp) th)) w in + let tm1 = hd (sort free_in tms) in + let th1 = PART_MATCH (lhs o snd o dest_imp) th tm1 in + let (a,(l,r)) = (I F_F dest_eq) (dest_imp (concl th1)) in + let gv = genvar (type_of l) in + let pat = subst[gv,l] w in + null_meta, + [(asl,a); (asl,subst[(r,gv)] pat)], + fun i [t1;t2] -> SUBST[(SYM(MP th1 t1),gv)] pat t2;; + +(*---------------------------------------------------------------*) +(* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) = (f = g) *) +(*---------------------------------------------------------------*) + +let EXT_CONV = SYM o uncurry X_FUN_EQ_CONV o + (I F_F (mk_eq o (rator F_F rator) o dest_eq)) o dest_forall;; + +(*----------------------------------------------------------------------------*) +(* EQUAL_TAC - Strip down to unequal core (usually too enthusiastic) *) +(*----------------------------------------------------------------------------*) + +let EQUAL_TAC = REPEAT(FIRST [AP_TERM_TAC; AP_THM_TAC; ABS_TAC]);; + +(*----------------------------------------------------------------------------*) +(* X_BETA_CONV `v` `tm[v]` = |- tm[v] = (\v. tm[v]) v *) +(*----------------------------------------------------------------------------*) + +let X_BETA_CONV v tm = + SYM(BETA_CONV(mk_comb(mk_abs(v,tm),v)));; + +(*----------------------------------------------------------------------------*) +(* EXACT_CONV - Rewrite with theorem matching exactly one in a list *) +(*----------------------------------------------------------------------------*) + +let EXACT_CONV = + ONCE_DEPTH_CONV o FIRST_CONV o + map (fun t -> K t o check((=)(lhs(concl t))));; + +(*----------------------------------------------------------------------------*) +(* Rather ad-hoc higher-order fiddling conversion *) +(* |- (\x. f t1[x] ... tn[x]) = (\x. f ((\x. t1[x]) x) ... ((\x. tn[x]) x)) *) +(*----------------------------------------------------------------------------*) + +let HABS_CONV tm = + let v,bod = dest_abs tm in + let hop,pl = strip_comb bod in + let eql = rev(map (X_BETA_CONV v) pl) in + ABS v (itlist (C(curry MK_COMB)) eql (REFL hop));; + +(*----------------------------------------------------------------------------*) +(* Expand an abbreviation *) +(*----------------------------------------------------------------------------*) + +let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o + check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Set up the reals. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let real_le = prove + (`!x y. x <= y <=> ~(y < x)`, + REWRITE_TAC[REAL_NOT_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Link a few theorems. *) +(* ------------------------------------------------------------------------- *) + +let REAL_10 = REAL_ARITH `~(&1 = &0)`;; + +let REAL_LDISTRIB = REAL_ADD_LDISTRIB;; + +let REAL_LT_IADD = REAL_ARITH `!x y z. y < z ==> x + y < x + z`;; + +(*----------------------------------------------------------------------------*) +(* Prove lots of boring field theorems *) +(*----------------------------------------------------------------------------*) + +let REAL_MUL_RID = prove( + `!x. x * &1 = x`, + GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_MUL_LID);; + +let REAL_MUL_RINV = prove( + `!x. ~(x = &0) ==> (x * (inv x) = &1)`, + GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_MUL_LINV);; + +let REAL_RDISTRIB = prove( + `!x y z. (x + y) * z = (x * z) + (y * z)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_LDISTRIB);; + +let REAL_EQ_LADD = prove( + `!x y z. (x + y = x + z) <=> (y = z)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `(+) (-- x)`) THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; + +let REAL_EQ_RADD = prove( + `!x y z. (x + z = y + z) <=> (x = y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_EQ_LADD);; + +let REAL_ADD_LID_UNIQ = prove( + `!x y. (x + y = y) <=> (x = &0)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ADD_LID] + THEN MATCH_ACCEPT_TAC REAL_EQ_RADD);; + +let REAL_ADD_RID_UNIQ = prove( + `!x y. (x + y = x) <=> (y = &0)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_ADD_LID_UNIQ);; + +let REAL_LNEG_UNIQ = prove( + `!x y. (x + y = &0) <=> (x = --y)`, + REPEAT GEN_TAC THEN SUBST1_TAC (SYM(SPEC `y:real` REAL_ADD_LINV)) THEN + MATCH_ACCEPT_TAC REAL_EQ_RADD);; + +let REAL_RNEG_UNIQ = prove( + `!x y. (x + y = &0) <=> (y = --x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_LNEG_UNIQ);; + +let REAL_NEG_ADD = prove( + `!x y. --(x + y) = (--x) + (--y)`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM REAL_LNEG_UNIQ] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (a + c) + (b + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_MUL_LZERO = prove( + `!x. &0 * x = &0`, + GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`&0 * x`; `&0 * x`] REAL_ADD_LID_UNIQ)) + THEN REWRITE_TAC[GSYM REAL_RDISTRIB; REAL_ADD_LID]);; + +let REAL_MUL_RZERO = prove( + `!x. x * &0 = &0`, + GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_MUL_LZERO);; + +let REAL_NEG_LMUL = prove( + `!x y. --(x * y) = (--x) * y`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM REAL_LNEG_UNIQ; GSYM REAL_RDISTRIB; + REAL_ADD_LINV; REAL_MUL_LZERO]);; + +let REAL_NEG_RMUL = prove( + `!x y. --(x * y) = x * (--y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_NEG_LMUL);; + +let REAL_NEGNEG = prove( + `!x. --(--x) = x`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM REAL_LNEG_UNIQ; REAL_ADD_RINV]);; + +let REAL_NEG_MUL2 = prove( + `!x y. (--x) * (--y) = x * y`, + REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL; REAL_NEGNEG]);; + +let REAL_LT_LADD = prove( + `!x y z. (x + y) < (x + z) <=> y < z`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LT_IADD) THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; + MATCH_ACCEPT_TAC REAL_LT_IADD]);; + +let REAL_LT_RADD = prove( + `!x y z. (x + z) < (y + z) <=> x < y`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_LT_LADD);; + +let REAL_NOT_LT = prove( + `!x y. ~(x < y) <=> y <= x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_le]);; + +let REAL_LT_ANTISYM = prove( + `!x y. ~(x < y /\ y < x)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_TRANS) THEN + REWRITE_TAC[REAL_LT_REFL]);; + +let REAL_LT_GT = prove( + `!x y. x < y ==> ~(y < x)`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONJ th)) THEN + REWRITE_TAC[REAL_LT_ANTISYM]);; + +let REAL_NOT_LE = prove( + `!x y. ~(x <= y) <=> y < x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_le]);; + +let REAL_LE_TOTAL = prove( + `!x y. x <= y \/ y <= x`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_le; GSYM DE_MORGAN_THM; REAL_LT_ANTISYM]);; + +let REAL_LE_REFL = prove( + `!x. x <= x`, + GEN_TAC THEN REWRITE_TAC[real_le; REAL_LT_REFL]);; + +let REAL_LE_LT = prove( + `!x y. x <= y <=> x < y \/ (x = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN EQ_TAC THENL + [REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN ASM_REWRITE_TAC[]; + DISCH_THEN(DISJ_CASES_THEN2 + ((then_) (MATCH_MP_TAC REAL_LT_GT) o ACCEPT_TAC) SUBST1_TAC) THEN + MATCH_ACCEPT_TAC REAL_LT_REFL]);; + +let REAL_LT_LE = prove( + `!x y. x < y <=> x <= y /\ ~(x = y)`, + let lemma = TAUT `~(a /\ ~a)` in + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; RIGHT_AND_OVER_OR; lemma] + THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]);; + +let REAL_LT_IMP_LE = prove( + `!x y. x < y ==> x <= y`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[REAL_LE_LT]);; + +let REAL_LTE_TRANS = prove( + `!x y z. x < y /\ y <= z ==> x < z`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; LEFT_AND_OVER_OR] THEN + DISCH_THEN(DISJ_CASES_THEN2 (ACCEPT_TAC o MATCH_MP REAL_LT_TRANS) + (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN REWRITE_TAC[]);; + +let REAL_LE_TRANS = prove( + `!x y z. x <= y /\ y <= z ==> x <= z`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_LE_LT] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC)) + THEN REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o C CONJ (ASSUME `y < z`)) THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP REAL_LT_IMP_LE o MATCH_MP REAL_LET_TRANS));; + +let REAL_NEG_LT0 = prove( + `!x. (--x) < &0 <=> &0 < x`, + GEN_TAC THEN SUBST1_TAC(SYM(SPECL [`--x`; `&0`; `x:real`] REAL_LT_RADD)) THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_NEG_GT0 = prove( + `!x. &0 < (--x) <=> x < &0`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEGNEG]);; + +let REAL_NEG_LE0 = prove( + `!x. (--x) <= &0 <=> &0 <= x`, + GEN_TAC THEN REWRITE_TAC[real_le] THEN + REWRITE_TAC[REAL_NEG_GT0]);; + +let REAL_NEG_GE0 = prove( + `!x. &0 <= (--x) <=> x <= &0`, + GEN_TAC THEN REWRITE_TAC[real_le] THEN + REWRITE_TAC[REAL_NEG_LT0]);; + +let REAL_LT_NEGTOTAL = prove( + `!x. (x = &0) \/ (&0 < x) \/ (&0 < --x)`, + GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THEN + ASM_REWRITE_TAC[SYM(REWRITE_RULE[REAL_NEGNEG] (SPEC `--x` REAL_NEG_LT0))]);; + +let REAL_LE_NEGTOTAL = prove( + `!x. &0 <= x \/ &0 <= --x`, + GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN + ASM_REWRITE_TAC[]);; + +let REAL_LE_MUL = prove( + `!x y. &0 <= x /\ &0 <= y ==> &0 <= (x * y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + MAP_EVERY ASM_CASES_TAC [`&0 = x`; `&0 = y`] THEN + ASM_REWRITE_TAC[] THEN TRY(FIRST_ASSUM(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + DISCH_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[]);; + +let REAL_LE_SQUARE = prove( + `!x. &0 <= x * x`, + GEN_TAC THEN DISJ_CASES_TAC (SPEC `x:real` REAL_LE_NEGTOTAL) THEN + POP_ASSUM(MP_TAC o MATCH_MP REAL_LE_MUL o W CONJ) THEN + REWRITE_TAC[GSYM REAL_NEG_RMUL; GSYM REAL_NEG_LMUL; REAL_NEGNEG]);; + +let REAL_LT_01 = prove( + `&0 < &1`, + REWRITE_TAC[REAL_LT_LE; REAL_LE_01] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + REWRITE_TAC[REAL_10]);; + +let REAL_LE_LADD = prove( + `!x y z. (x + y) <= (x + z) <=> y <= z`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN + AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LADD);; + +let REAL_LE_RADD = prove( + `!x y z. (x + z) <= (y + z) <=> x <= y`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_le] THEN + AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_LT_RADD);; + +let REAL_LT_ADD2 = prove( + `!w x y z. w < x /\ y < z ==> (w + y) < (x + z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `w + z` THEN + ASM_REWRITE_TAC[REAL_LT_LADD; REAL_LT_RADD]);; + +let REAL_LT_ADD = prove( + `!x y. &0 < x /\ &0 < y ==> &0 < (x + y)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2) THEN + REWRITE_TAC[REAL_ADD_LID]);; + +let REAL_LT_ADDNEG = prove( + `!x y z. y < (x + (--z)) <=> (y + z) < x`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`y:real`; `x + (--z)`; `z:real`] REAL_LT_RADD)) THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; + +let REAL_LT_ADDNEG2 = prove( + `!x y z. (x + (--y)) < z <=> x < (z + y)`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`x + (-- y)`; `z:real`; `y:real`] REAL_LT_RADD)) THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; + +let REAL_LT_ADD1 = prove( + `!x y. x <= y ==> x < (y + &1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [POP_ASSUM(MP_TAC o MATCH_MP REAL_LT_ADD2 o C CONJ REAL_LT_01) THEN + REWRITE_TAC[REAL_ADD_RID]; + POP_ASSUM SUBST1_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + REWRITE_TAC[REAL_LT_LADD; REAL_LT_01]]);; + +let REAL_SUB_ADD = prove( + `!x y. (x - y) + y = x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; + REAL_ADD_LINV; REAL_ADD_RID]);; + +let REAL_SUB_ADD2 = prove( + `!x y. y + (x - y) = x`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_SUB_ADD);; + +let REAL_SUB_REFL = prove( + `!x. x - x = &0`, + GEN_TAC THEN REWRITE_TAC[real_sub; REAL_ADD_RINV]);; + +let REAL_SUB_0 = prove( + `!x y. (x - y = &0) <=> (x = y)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o C AP_THM `y:real` o AP_TERM `(+)`) THEN + REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]; + DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_SUB_REFL]);; + +let REAL_LE_DOUBLE = prove( + `!x. &0 <= x + x <=> &0 <= x`, + GEN_TAC THEN EQ_TAC THENL + [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2 o W CONJ); + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2 o W CONJ)] THEN + REWRITE_TAC[REAL_ADD_LID]);; + +let REAL_LE_NEGL = prove( + `!x. (--x <= x) <=> (&0 <= x)`, + GEN_TAC THEN SUBST1_TAC (SYM(SPECL [`x:real`; `--x`; `x:real`] REAL_LE_LADD)) + THEN REWRITE_TAC[REAL_ADD_RINV; REAL_LE_DOUBLE]);; + +let REAL_LE_NEGR = prove( + `!x. (x <= --x) <=> (x <= &0)`, + GEN_TAC THEN SUBST1_TAC(SYM(SPEC `x:real` REAL_NEGNEG)) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_NEGNEG] THEN + REWRITE_TAC[REAL_LE_NEGL] THEN REWRITE_TAC[REAL_NEG_GE0] THEN + REWRITE_TAC[REAL_NEGNEG]);; + +let REAL_NEG_EQ0 = prove( + `!x. (--x = &0) <=> (x = &0)`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `(+) x`); + DISCH_THEN(MP_TAC o AP_TERM `(+) (--x)`)] THEN + REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LINV; REAL_ADD_RID] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +let REAL_NEG_0 = prove( + `--(&0) = &0`, + REWRITE_TAC[REAL_NEG_EQ0]);; + +let REAL_NEG_SUB = prove( + `!x y. --(x - y) = y - x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN + MATCH_ACCEPT_TAC REAL_ADD_SYM);; + +let REAL_SUB_LT = prove( + `!x y. &0 < x - y <=> y < x`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`&0`; `x - y`; `y:real`] REAL_LT_RADD)) THEN + REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]);; + +let REAL_SUB_LE = prove( + `!x y. &0 <= (x - y) <=> y <= x`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`&0`; `x - y`; `y:real`] REAL_LE_RADD)) THEN + REWRITE_TAC[REAL_SUB_ADD; REAL_ADD_LID]);; + +let REAL_EQ_LMUL = prove( + `!x y z. (x * y = x * z) <=> (x = &0) \/ (y = z)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `(*) (inv x)`) THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(fun th -> REWRITE_TAC + [REAL_MUL_ASSOC; MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_LID]; + DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THEN + REWRITE_TAC[REAL_MUL_LZERO]]);; + +let REAL_EQ_RMUL = prove( + `!x y z. (x * z = y * z) <=> (z = &0) \/ (x = y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_EQ_LMUL);; + +let REAL_SUB_LDISTRIB = prove( + `!x y z. x * (y - z) = (x * y) - (x * z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_NEG_RMUL]);; + +let REAL_SUB_RDISTRIB = prove( + `!x y z. (x - y) * z = (x * z) - (y * z)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_SUB_LDISTRIB);; + +let REAL_NEG_EQ = prove( + `!x y. (--x = y) <=> (x = --y)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM); DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[REAL_NEGNEG]);; + +let REAL_NEG_MINUS1 = prove( + `!x. --x = (--(&1)) * x`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_INV_NZ = prove( + `!x. ~(x = &0) ==> ~(inv x = &0)`, + GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o C AP_THM `x:real` o AP_TERM `(*)`) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_10]);; + +let REAL_INVINV = prove( + `!x. ~(x = &0) ==> (inv (inv x) = x)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_MUL_RINV) THEN + ASM_CASES_TAC `inv x = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; GSYM REAL_10] THEN + MP_TAC(SPECL [`inv(inv x)`; `x:real`; `inv x`] REAL_EQ_RMUL) + THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN + FIRST_ASSUM ACCEPT_TAC);; + +let REAL_LT_IMP_NE = prove( + `!x y. x < y ==> ~(x = y)`, + REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_LT_REFL]);; + +let REAL_INV_POS = prove( + `!x. &0 < x ==> &0 < inv x`, + GEN_TAC THEN DISCH_TAC THEN REPEAT_TCL DISJ_CASES_THEN + MP_TAC (SPECL [`inv x`; `&0`] REAL_LT_TOTAL) THENL + [POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_NZ o + GSYM o MATCH_MP REAL_LT_IMP_NE) THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM REAL_NEG_GT0] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL o C CONJ (ASSUME `&0 < x`)) THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN + POP_ASSUM(fun th -> REWRITE_TAC + [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN + REWRITE_TAC[REAL_NEG_GT0] THEN DISCH_THEN(MP_TAC o CONJ REAL_LT_01) THEN + REWRITE_TAC[REAL_LT_ANTISYM]; + REWRITE_TAC[]]);; + +let REAL_LT_LMUL_0 = prove( + `!x y. &0 < x ==> (&0 < (x * y) <=> &0 < y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL + [FIRST_ASSUM(fun th -> + DISCH_THEN(MP_TAC o CONJ (MATCH_MP REAL_INV_POS th))) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC + [MATCH_MP REAL_MUL_LINV (GSYM (MATCH_MP REAL_LT_IMP_NE th))]) THEN + REWRITE_TAC[REAL_MUL_LID]; + DISCH_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]]);; + +let REAL_LT_RMUL_0 = prove( + `!x y. &0 < y ==> (&0 < (x * y) <=> &0 < x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_LT_LMUL_0);; + +let REAL_LT_LMUL_EQ = prove( + `!x y z. &0 < x ==> ((x * y) < (x * z) <=> y < z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_LT_LMUL_0);; + +let REAL_LT_RMUL_EQ = prove( + `!x y z. &0 < z ==> ((x * z) < (y * z) <=> x < y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_LT_LMUL_EQ);; + +let REAL_LT_RMUL_IMP = prove( + `!x y z. x < y /\ &0 < z ==> (x * z) < (y * z)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + POP_ASSUM(fun th -> REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_RMUL_EQ th)]));; + +let REAL_LT_LMUL_IMP = prove( + `!x y z. y < z /\ &0 < x ==> (x * y) < (x * z)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + POP_ASSUM(fun th -> REWRITE_TAC[GEN_ALL(MATCH_MP REAL_LT_LMUL_EQ th)]));; + +let REAL_LINV_UNIQ = prove( + `!x y. (x * y = &1) ==> (x = inv y)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_10] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) (inv x)`) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN + POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC REAL_INVINV);; + +let REAL_RINV_UNIQ = prove( + `!x y. (x * y = &1) ==> (y = inv x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_LINV_UNIQ);; + +let REAL_NEG_INV = prove( + `!x. ~(x = &0) ==> (--(inv x) = inv(--x))`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_NEGNEG]);; + +let REAL_INV_1OVER = prove( + `!x. inv x = &1 / x`, + GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LID]);; + +(*----------------------------------------------------------------------------*) +(* Prove homomorphisms for the inclusion map *) +(*----------------------------------------------------------------------------*) + +let REAL = prove( + `!n. &(SUC n) = &n + &1`, + REWRITE_TAC[ADD1; REAL_OF_NUM_ADD]);; + +let REAL_POS = prove( + `!n. &0 <= &n`, + INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[REAL] THEN + REWRITE_TAC[REAL_LE_ADDR; REAL_LE_01]);; + +let REAL_LE = prove( + `!m n. &m <= &n <=> m <= n`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC + [REAL; REAL_LE_RADD; LE_0; LE_SUC; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM NOT_LT; LT_0] THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n` THEN + ASM_REWRITE_TAC[LE_0; REAL_LE_ADDR; REAL_LE_01]; + DISCH_THEN(MP_TAC o C CONJ (SPEC `m:num` REAL_POS)) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_NOT_LE; REAL_LT_ADDR; REAL_LT_01]]);; + +let REAL_LT = prove( + `!m n. &m < &n <=> m < n`, + REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC ((REWRITE_RULE[] o AP_TERM `(~)` o + REWRITE_RULE[GSYM NOT_LT; GSYM REAL_NOT_LT]) (SPEC_ALL REAL_LE)));; + +let REAL_INJ = prove( + `!m n. (&m = &n) <=> (m = n)`, + let th = prove(`(m = n) <=> m:num <= n /\ n <= m`, + EQ_TAC THENL + [DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LE_REFL]; + MATCH_ACCEPT_TAC LESS_EQUAL_ANTISYM]) in + REPEAT GEN_TAC THEN REWRITE_TAC[th; GSYM REAL_LE_ANTISYM; REAL_LE]);; + +let REAL_ADD = prove( + `!m n. &m + &n = &(m + n)`, + INDUCT_TAC THEN REWRITE_TAC[REAL; ADD; REAL_ADD_LID] THEN + RULE_ASSUM_TAC GSYM THEN GEN_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ADD_AC]);; + +let REAL_MUL = prove( + `!m n. &m * &n = &(m * n)`, + INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; MULT_CLAUSES; REAL; + GSYM REAL_ADD; REAL_RDISTRIB] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[REAL_MUL_LID]);; + +(*----------------------------------------------------------------------------*) +(* Now more theorems *) +(*----------------------------------------------------------------------------*) + +let REAL_INV1 = prove( + `inv(&1) = &1`, + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_DIV_LZERO = prove( + `!x. &0 / x = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO]);; + +let REAL_LT_NZ = prove( + `!n. ~(&n = &0) <=> (&0 < &n)`, + GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN + ASM_CASES_TAC `&n = &0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_POS]);; + +let REAL_NZ_IMP_LT = prove( + `!n. ~(n = 0) ==> &0 < &n`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_INJ; REAL_LT_NZ]);; + +let REAL_LT_RDIV_0 = prove( + `!y z. &0 < z ==> (&0 < (y / z) <=> &0 < y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_0 THEN + MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC);; + +let REAL_LT_RDIV = prove( + `!x y z. &0 < z ==> ((x / z) < (y / z) <=> x < y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN + MATCH_MP_TAC REAL_INV_POS THEN POP_ASSUM ACCEPT_TAC);; + +let REAL_LT_FRACTION_0 = prove( + `!n d. ~(n = 0) ==> (&0 < (d / &n) <=> &0 < d)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_RDIV_0 THEN + ASM_REWRITE_TAC[GSYM REAL_LT_NZ; REAL_INJ]);; + +let REAL_LT_MULTIPLE = prove( + `!n d. 1 < n ==> (d < (&n * d) <=> &0 < d)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN INDUCT_TAC THENL + [REWRITE_TAC[num_CONV `1`; NOT_LESS_0]; + POP_ASSUM MP_TAC THEN ASM_CASES_TAC `1 < n` THEN + ASM_REWRITE_TAC[] THENL + [DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL; REAL_LDISTRIB; REAL_MUL_RID; REAL_LT_ADDL] THEN + MATCH_MP_TAC REAL_LT_RMUL_0 THEN REWRITE_TAC[REAL_LT] THEN + MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `1` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV `1`; LT_0]; + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_LEMMA1) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL; REAL_LDISTRIB; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_LT_ADDL]]]);; + +let REAL_LT_FRACTION = prove( + `!n d. (1 < n) ==> ((d / &n) < d <=> &0 < d)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[NOT_LESS_0] THEN DISCH_TAC THEN + UNDISCH_TAC `1 < n` THEN + FIRST_ASSUM(fun th -> let th1 = REWRITE_RULE[GSYM REAL_INJ] th in + MAP_EVERY ASSUME_TAC [th1; REWRITE_RULE[REAL_LT_NZ] th1]) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) + [GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_LT_MULTIPLE);; + +let REAL_LT_HALF1 = prove( + `!d. &0 < (d / &2) <=> &0 < d`, + GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION_0 THEN + REWRITE_TAC[num_CONV `2`; NOT_SUC]);; + +let REAL_LT_HALF2 = prove( + `!d. (d / &2) < d <=> &0 < d`, + GEN_TAC THEN MATCH_MP_TAC REAL_LT_FRACTION THEN + CONV_TAC(RAND_CONV num_CONV) THEN + REWRITE_TAC[LESS_SUC_REFL]);; + +let REAL_DOUBLE = prove( + `!x. x + x = &2 * x`, + GEN_TAC THEN REWRITE_TAC[num_CONV `2`; REAL] THEN + REWRITE_TAC[REAL_RDISTRIB; REAL_MUL_LID]);; + +let REAL_HALF_DOUBLE = prove( + `!x. (x / &2) + (x / &2) = x`, + GEN_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN + MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_INJ] THEN + REWRITE_TAC[num_CONV `2`; NOT_SUC]);; + +let REAL_SUB_SUB = prove( + `!x y. (x - y) - x = --y`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + c = (c + a) + b`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_LT_ADD_SUB = prove( + `!x y z. (x + y) < z <=> x < (z - y)`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`x:real`; `z - y`; `y:real`] REAL_LT_RADD)) THEN + REWRITE_TAC[REAL_SUB_ADD]);; + +let REAL_LT_SUB_RADD = prove( + `!x y z. (x - y) < z <=> x < z + y`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`x - y`; `z:real`; `y:real`] REAL_LT_RADD)) THEN + REWRITE_TAC[REAL_SUB_ADD]);; + +let REAL_LT_SUB_LADD = prove( + `!x y z. x < (y - z) <=> (x + z) < y`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`x + z`; `y:real`; `--z`] REAL_LT_RADD)) THEN + REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_RINV; REAL_ADD_RID]);; + +let REAL_LE_SUB_LADD = prove( + `!x y z. x <= (y - z) <=> (x + z) <= y`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_SUB_RADD]);; + +let REAL_LE_SUB_RADD = prove( + `!x y z. (x - y) <= z <=> x <= z + y`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_SUB_LADD]);; + +let REAL_LT_NEG = prove( + `!x y. --x < --y <=> y < x`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL[`--x`; `--y`; `x + y`] REAL_LT_RADD)) THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_RINV; REAL_ADD_LID]);; + +let REAL_LE_NEG = prove( + `!x y. --x <= --y <=> y <= x`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + REWRITE_TAC[REAL_LT_NEG]);; + +let REAL_SUB_LZERO = prove( + `!x. &0 - x = --x`, + GEN_TAC THEN REWRITE_TAC[real_sub; REAL_ADD_LID]);; + +let REAL_SUB_RZERO = prove( + `!x. x - &0 = x`, + GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_0; REAL_ADD_RID]);; + +let REAL_LTE_ADD2 = prove( + `!w x y z. w < x /\ y <= z ==> (w + y) < (x + z)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_LET_ADD2);; + +let REAL_LTE_ADD = prove( + `!x y. &0 < x /\ &0 <= y ==> &0 < (x + y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID)) THEN + MATCH_MP_TAC REAL_LTE_ADD2 THEN + ASM_REWRITE_TAC[]);; + +let REAL_LT_MUL2_ALT = prove( + `!x1 x2 y1 y2. &0 <= x1 /\ &0 <= y1 /\ x1 < x2 /\ y1 < y2 ==> + (x1 * y1) < (x2 * y2)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN `!a b c d. + (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))` + MP_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (b + c) + (a + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + DISCH_THEN STRIP_ASSUME_TAC THEN + MATCH_MP_TAC REAL_LTE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; + +let REAL_SUB_LNEG = prove( + `!x y. (--x) - y = --(x + y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD]);; + +let REAL_SUB_RNEG = prove( + `!x y. x - (--y) = x + y`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEGNEG]);; + +let REAL_SUB_NEG2 = prove( + `!x y. (--x) - (--y) = y - x`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUB_LNEG] THEN + REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN + MATCH_ACCEPT_TAC REAL_ADD_SYM);; + +let REAL_SUB_TRIANGLE = prove( + `!a b c. (a - b) + (b - c) = a - c`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (b + c) + (a + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_INV_MUL_WEAK = prove( + `!x y. ~(x = &0) /\ ~(y = &0) ==> + (inv(x * y) = inv(x) * inv(y))`, + REWRITE_TAC[REAL_INV_MUL]);; + +let REAL_LE_LMUL_LOCAL = prove( + `!x y z. &0 < x ==> ((x * y) <= (x * z) <=> y <= z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN + AP_TERM_TAC THEN MATCH_MP_TAC REAL_LT_LMUL_EQ THEN ASM_REWRITE_TAC[]);; + +let REAL_LE_RMUL_EQ = prove( + `!x y z. &0 < z ==> ((x * z) <= (y * z) <=> x <= y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_LE_LMUL_LOCAL);; + +let REAL_SUB_INV2 = prove( + `!x y. ~(x = &0) /\ ~(y = &0) ==> + (inv(x) - inv(y) = (y - x) / (x * y))`, + REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN + SUBGOAL_THEN `inv(x * y) = inv(x) * inv(y)` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN + REWRITE_TAC[REAL_MUL_LID] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_SUB_SUB2 = prove( + `!x y. x - (x - y) = y`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEGNEG] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_SUB]);; + +let REAL_MEAN = prove( + `!x y. x < y ==> ?z. x < z /\ z < y`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_DOWN o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) + THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x + d` THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]);; + +let REAL_EQ_LMUL2 = prove( + `!x y z. ~(x = &0) ==> ((y = z) <=> (x * y = x * z))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`x:real`; `y:real`; `z:real`] REAL_EQ_LMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN REFL_TAC);; + +let REAL_LE_MUL2V = prove( + `!x1 x2 y1 y2. + (& 0) <= x1 /\ (& 0) <= y1 /\ x1 <= x2 /\ y1 <= y2 ==> + (x1 * y1) <= (x2 * y2)`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SPECL [`x1:real`; `x2:real`] REAL_LE_LT) THEN + ASM_CASES_TAC `x1:real = x2` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [UNDISCH_TAC `&0 <= x2` THEN + DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]); + SUBST1_TAC(SYM(ASSUME `&0 = x2`)) THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL]]; ALL_TAC] THEN + UNDISCH_TAC `y1 <= y2` THEN + DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]] THEN + UNDISCH_TAC `&0 <= y1` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + SUBST1_TAC(SYM(ASSUME `&0 = y2`)) THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]);; + +let REAL_LE_LDIV = prove( + `!x y z. &0 < x /\ y <= (z * x) ==> (y / x) <= z`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN + SUBGOAL_THEN `y = (y / x) * x` MP_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC; + DISCH_THEN(fun t -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [t]) + THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN POP_ASSUM ACCEPT_TAC]);; + +let REAL_LE_RDIV = prove( + `!x y z. &0 < x /\ (y * x) <= z ==> y <= (z / x)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC EQ_IMP THEN + SUBGOAL_THEN `z = (z / x) * x` MP_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC; + DISCH_THEN(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) + THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN POP_ASSUM ACCEPT_TAC]);; + +let REAL_LT_1 = prove( + `!x y. &0 <= x /\ x < y ==> (x / y) < &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(x / y) < &1 <=> ((x / y) * y) < (&1 * y)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(x / y) * y = x` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_DIV_RMUL THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[REAL_MUL_LID]]]);; + +let REAL_LE_LMUL_IMP = prove( + `!x y z. &0 <= x /\ y <= z ==> (x * y) <= (x * z)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]); + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + MATCH_ACCEPT_TAC REAL_LE_REFL]);; + +let REAL_LE_RMUL_IMP = prove( + `!x y z. &0 <= x /\ y <= z ==> (y * x) <= (z * x)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_LE_LMUL_IMP);; + +let REAL_INV_LT1 = prove( + `!x. &0 < x /\ x < &1 ==> &1 < inv(x)`, + GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_INV_POS) THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_REWRITE_TAC[REAL_NOT_LT] THEN REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_TAC THEN + MP_TAC(SPECL [`inv(x)`; `&1`; `x:real`; `&1`] REAL_LT_MUL2_ALT) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_NE) THEN + REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_LINV THEN + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&0 < &0` THEN + REWRITE_TAC[REAL_LT_REFL]]; + DISCH_THEN(MP_TAC o AP_TERM `inv`) THEN REWRITE_TAC[REAL_INV1] THEN + SUBGOAL_THEN `inv(inv x) = x` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC; + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&1 < &1` THEN + REWRITE_TAC[REAL_LT_REFL]]]);; + +let REAL_POS_NZ = prove( + `!x. &0 < x ==> ~(x = &0)`, + GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_LT_IMP_NE) THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN POP_ASSUM ACCEPT_TAC);; + +let REAL_EQ_RMUL_IMP = prove( + `!x y z. ~(z = &0) /\ (x * z = y * z) ==> (x = y)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[REAL_EQ_RMUL]);; + +let REAL_EQ_LMUL_IMP = prove( + `!x y z. ~(x = &0) /\ (x * y = x * z) ==> (y = z)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_RMUL_IMP);; + +let REAL_FACT_NZ = prove( + `!n. ~(&(FACT n) = &0)`, + GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN + REWRITE_TAC[REAL_LT; FACT_LT]);; + +let REAL_POSSQ = prove( + `!x. &0 < (x * x) <=> ~(x = &0)`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN AP_TERM_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o C CONJ (SPEC `x:real` REAL_LE_SQUARE)) THEN + REWRITE_TAC[REAL_LE_ANTISYM; REAL_ENTIRE]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL]]);; + +let REAL_SUMSQ = prove( + `!x y. ((x * x) + (y * y) = &0) <=> (x = &0) /\ (y = &0)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM] THEN + DISCH_THEN DISJ_CASES_TAC THEN MATCH_MP_TAC REAL_POS_NZ THENL + [MATCH_MP_TAC REAL_LTE_ADD; MATCH_MP_TAC REAL_LET_ADD] THEN + ASM_REWRITE_TAC[REAL_POSSQ; REAL_LE_SQUARE]; + DISCH_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID]]);; + +let REAL_EQ_NEG = prove( + `!x y. (--x = --y) <=> (x = y)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_NEG] THEN + MATCH_ACCEPT_TAC CONJ_SYM);; + +let REAL_DIV_MUL2 = prove( + `!x z. ~(x = &0) /\ ~(z = &0) ==> !y. y / z = (x * y) / (x * z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (c * a) * (b * d)`] THEN + IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_MIDDLE1 = prove( + `!a b. a <= b ==> a <= (a + b) / &2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_RDIV THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_DOUBLE] THEN + ASM_REWRITE_TAC[GSYM REAL_DOUBLE; REAL_LE_LADD] THEN + REWRITE_TAC[num_CONV `2`; REAL_LT; LT_0]);; + +let REAL_MIDDLE2 = prove( + `!a b. a <= b ==> ((a + b) / &2) <= b`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_LDIV THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_DOUBLE] THEN + ASM_REWRITE_TAC[GSYM REAL_DOUBLE; REAL_LE_RADD] THEN + REWRITE_TAC[num_CONV `2`; REAL_LT; LT_0]);; + +(*----------------------------------------------------------------------------*) +(* Define usual norm (absolute distance) on the real line *) +(*----------------------------------------------------------------------------*) + +let ABS_ZERO = prove( + `!x. (abs(x) = &0) <=> (x = &0)`, + GEN_TAC THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_NEG_EQ0]);; + +let ABS_0 = prove( + `abs(&0) = &0`, + REWRITE_TAC[ABS_ZERO]);; + +let ABS_1 = prove( + `abs(&1) = &1`, + REWRITE_TAC[real_abs; REAL_LE; LE_0]);; + +let ABS_NEG = prove( + `!x. abs(--x) = abs(x)`, + GEN_TAC THEN REWRITE_TAC[real_abs; REAL_NEGNEG; REAL_NEG_GE0] THEN + REPEAT COND_CASES_TAC THEN REWRITE_TAC[] THENL + [MP_TAC(CONJ (ASSUME `&0 <= x`) (ASSUME `x <= &0`)) THEN + REWRITE_TAC[REAL_LE_ANTISYM] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_NEG_0]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + W(MP_TAC o end_itlist CONJ o map snd o fst) THEN + REWRITE_TAC[REAL_LT_ANTISYM]]);; + +let ABS_TRIANGLE = prove( + `!x y. abs(x + y) <= abs(x) + abs(y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN + REPEAT COND_CASES_TAC THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_LE_REFL; REAL_LE_LADD; REAL_LE_RADD] THEN + ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_LE_NEGL; REAL_LE_NEGR] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN + TRY(UNDISCH_TAC `(x + y) < &0`) THEN SUBST1_TAC(SYM(SPEC `&0` REAL_ADD_LID)) + THEN REWRITE_TAC[REAL_NOT_LT] THEN + MAP_FIRST MATCH_MP_TAC [REAL_LT_ADD2; REAL_LE_ADD2] THEN + ASM_REWRITE_TAC[]);; + +let ABS_POS = prove( + `!x. &0 <= abs(x)`, + GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL + [ALL_TAC; + MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC] THEN + ASM_REWRITE_TAC[real_abs]);; + +let ABS_MUL = prove( + `!x y. abs(x * y) = abs(x) * abs(y)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL + [ALL_TAC; + MP_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ABS_NEG] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ABS_NEG] + THEN REWRITE_TAC[REAL_NEG_LMUL]] THEN + (ASM_CASES_TAC `&0 <= y` THENL + [ALL_TAC; + MP_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ABS_NEG] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ABS_NEG] THEN + REWRITE_TAC[REAL_NEG_RMUL]]) THEN + ASSUM_LIST(ASSUME_TAC o MATCH_MP REAL_LE_MUL o end_itlist CONJ o rev) THEN + ASM_REWRITE_TAC[real_abs]);; + +let ABS_LT_MUL2 = prove( + `!w x y z. abs(w) < y /\ abs(x) < z ==> abs(w * x) < (y * z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN + ASM_REWRITE_TAC[ABS_POS]);; + +let ABS_SUB = prove( + `!x y. abs(x - y) = abs(y - x)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_NEG_SUB] THEN + REWRITE_TAC[ABS_NEG]);; + +let ABS_NZ = prove( + `!x. ~(x = &0) <=> &0 < abs(x)`, + GEN_TAC THEN EQ_TAC THENL + [ONCE_REWRITE_TAC[GSYM ABS_ZERO] THEN + REWRITE_TAC[TAUT `~a ==> b <=> b \/ a`] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + REWRITE_TAC[GSYM REAL_LE_LT; ABS_POS]; + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[real_abs; REAL_LT_REFL; REAL_LE_REFL]]);; + +let ABS_INV = prove( + `!x. ~(x = &0) ==> (abs(inv x) = inv(abs(x)))`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LINV_UNIQ THEN + REWRITE_TAC[GSYM ABS_MUL] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[real_abs; REAL_LE] THEN + REWRITE_TAC[num_CONV `1`; GSYM NOT_LT; NOT_LESS_0]);; + +let ABS_ABS = prove( + `!x. abs(abs(x)) = abs(x)`, + GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [real_abs] THEN + REWRITE_TAC[ABS_POS]);; + +let ABS_LE = prove( + `!x. x <= abs(x)`, + GEN_TAC THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + REWRITE_TAC[REAL_LE_NEGR] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_NOT_LE]);; + +let ABS_REFL = prove( + `!x. (abs(x) = x) <=> &0 <= x`, + GEN_TAC THEN REWRITE_TAC[real_abs] THEN + ASM_CASES_TAC `&0 <= x` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + ONCE_REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN + REWRITE_TAC[REAL_DOUBLE; REAL_ENTIRE; REAL_INJ] THEN + REWRITE_TAC[num_CONV `2`; NOT_SUC] THEN + DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[REAL_LE_REFL]);; + +let ABS_N = prove( + `!n. abs(&n) = &n`, + GEN_TAC THEN REWRITE_TAC[ABS_REFL; REAL_LE; LE_0]);; + +let ABS_BETWEEN = prove( + `!x y d. &0 < d /\ ((x - d) < y) /\ (y < (x + d)) <=> abs(y - x) < d`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN + REWRITE_TAC[REAL_SUB_LE] THEN REWRITE_TAC[REAL_NEG_SUB] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `x < (x + d)` MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[REAL_LT_ADDR]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + SUBGOAL_THEN `y < (y + d)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_LT_ADDR] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[REAL_LT_ADDR]]);; + +let ABS_BOUND = prove( + `!x y d. abs(x - y) < d ==> y < (x + d)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN + ONCE_REWRITE_TAC[GSYM ABS_BETWEEN] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +let ABS_STILLNZ = prove( + `!x y. abs(x - y) < abs(y) ==> ~(x = &0)`, + REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG; REAL_LT_REFL]);; + +let ABS_CASES = prove( + `!x. (x = &0) \/ &0 < abs(x)`, + GEN_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN + BOOL_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[]);; + +let ABS_BETWEEN1 = prove( + `!x y z. x < z /\ (abs(y - x)) < (z - x) ==> y < z`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC (SPECL [`x:real`; `y:real`] REAL_LET_TOTAL) THENL + [ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + REWRITE_TAC[real_sub; REAL_LT_RADD] THEN + DISCH_THEN(ACCEPT_TAC o CONJUNCT2); + DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]);; + +let ABS_SIGN = prove( + `!x y. abs(x - y) < y ==> &0 < x`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ABS_BOUND) THEN + REWRITE_TAC[REAL_LT_ADDL]);; + +let ABS_SIGN2 = prove( + `!x y. abs(x - y) < --y ==> x < &0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`--x`; `--y`] ABS_SIGN) THEN + REWRITE_TAC[REAL_SUB_NEG2] THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN + REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEGNEG]);; + +let ABS_DIV = prove( + `!y. ~(y = &0) ==> !x. abs(x / y) = abs(x) / abs(y)`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[ABS_MUL] THEN + POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]));; + +let ABS_CIRCLE = prove( + `!x y h. abs(h) < (abs(y) - abs(x)) ==> abs(x + h) < abs(y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x) + abs(h)` THEN + REWRITE_TAC[ABS_TRIANGLE] THEN + POP_ASSUM(MP_TAC o CONJ (SPEC `abs(x)` REAL_LE_REFL)) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD2) THEN + REWRITE_TAC[REAL_SUB_ADD2]);; + +let REAL_SUB_ABS = prove( + `!x y. (abs(x) - abs(y)) <= abs(x - y)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs(x - y) + abs(y)) - abs(y)` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[real_sub] THEN REWRITE_TAC[REAL_LE_RADD] THEN + SUBST1_TAC(SYM(SPECL [`x:real`; `y:real`] REAL_SUB_ADD)) THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_SUB_ADD] THEN + MATCH_ACCEPT_TAC ABS_TRIANGLE; + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[REAL_ADD_SUB; REAL_LE_REFL]]);; + +let ABS_SUB_ABS = prove( + `!x y. abs(abs(x) - abs(y)) <= abs(x - y)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [real_abs] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_SUB_ABS] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN + REWRITE_TAC[REAL_SUB_ABS]);; + +let ABS_BETWEEN2 = prove( + `!x0 x y0 y. x0 < y0 /\ abs(x - x0) < (y0 - x0) / &2 /\ + abs(y - y0) < (y0 - x0) / &2 + ==> x < y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `x < y0 /\ x0 < y` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MP_TAC(SPECL [`x0:real`; `x:real`; `y0 - x0`] ABS_BOUND) THEN + REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `(y0 - x0) / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2] THEN + ASM_REWRITE_TAC[REAL_SUB_LT]; + GEN_REWRITE_TAC I [TAUT `a = ~ ~a`] THEN + PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(AC REAL_ADD_AC + `(y0 + --x0) + (x0 + --y) = (--x0 + x0) + (y0 + --y)`) THEN + REWRITE_TAC[GSYM real_sub; REAL_ADD_LINV; REAL_ADD_LID] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`y0 - x0`; `x0 - y`] REAL_LE_ADDR) THEN + ASM_REWRITE_TAC[REAL_SUB_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(y0 <= y)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_NOT_LE] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `y0 - x0` THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN + UNDISCH_TAC `abs(y - y0) < (y0 - x0) / &2` THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN DISCH_TAC THEN + SUBGOAL_THEN `(y0 - x0) < (y0 - x0) / &2` MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `y0 - y` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[REAL_LT_HALF2] THEN ASM_REWRITE_TAC[REAL_SUB_LT]]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(x0 - y) < (y0 - x0) / &2` ASSUME_TAC THENL + [REWRITE_TAC[real_abs; REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `x - x0` THEN REWRITE_TAC[real_sub; REAL_LE_RADD] THEN + ASM_REWRITE_TAC[GSYM real_sub] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(x - x0)` THEN ASM_REWRITE_TAC[ABS_LE]; ALL_TAC] THEN + SUBGOAL_THEN `abs(y0 - x0) < ((y0 - x0) / &2) + ((y0 - x0) / &2)` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_HALF_DOUBLE; REAL_NOT_LT; ABS_LE]] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(y0 - y) + abs(y - x0)` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LT_ADD2 THEN ONCE_REWRITE_TAC[ABS_SUB] THEN + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `y0 - x0 = (y0 - y) + (y - x0)` SUBST1_TAC THEN + REWRITE_TAC[ABS_TRIANGLE] THEN + REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (b + c) + (a + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; + +let ABS_BOUNDS = prove( + `!x k. abs(x) <= k <=> --k <= x /\ x <= k`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_LE_NEG] THEN + REWRITE_TAC[REAL_NEGNEG] THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THENL + [REWRITE_TAC[TAUT `(a <=> b /\ a) <=> a ==> b`] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_NEGL]; + REWRITE_TAC[TAUT `(a <=> a /\ b) <=> a ==> b`] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_LE_NEGR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LE]]);; + +(*----------------------------------------------------------------------------*) +(* Define integer powers *) +(*----------------------------------------------------------------------------*) + +let pow = real_pow;; + +let POW_0 = prove( + `!n. &0 pow (SUC n) = &0`, + INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO]);; + +let POW_NZ = prove( + `!c n. ~(c = &0) ==> ~(c pow n = &0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[pow; REAL_10; REAL_ENTIRE]);; + +let POW_INV = prove( + `!c n. ~(c = &0) ==> (inv(c pow n) = (inv c) pow n)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[pow; REAL_INV1] THEN + MP_TAC(SPECL [`c:real`; `c pow n`] REAL_INV_MUL_WEAK) THEN + ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `~(c pow n = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC POW_NZ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]);; + +let POW_ABS = prove( + `!c n. abs(c) pow n = abs(c pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[pow; ABS_1; ABS_MUL]);; + +let POW_PLUS1 = prove( + `!e n. &0 < e ==> (&1 + (&n * e)) <= (&1 + e) pow n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 + e) * (&1 + (&n * e))` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_RDISTRIB; REAL; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_LDISTRIB;REAL_MUL_RID; REAL_ADD_ASSOC; REAL_LE_ADDR] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_LE; LE_0]; + SUBGOAL_THEN `&0 < (&1 + e)` + (fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th]) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_LT] THEN REWRITE_TAC[num_CONV `1`; LT_0]]);; + +let POW_ADD = prove( + `!c m n. c pow (m + n) = (c pow m) * (c pow n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[pow; ADD_CLAUSES; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let POW_1 = prove( + `!x. x pow 1 = x`, + GEN_TAC THEN REWRITE_TAC[num_CONV `1`] THEN + REWRITE_TAC[pow; REAL_MUL_RID]);; + +let POW_2 = prove( + `!x. x pow 2 = x * x`, + GEN_TAC THEN REWRITE_TAC[num_CONV `2`] THEN + REWRITE_TAC[pow; POW_1]);; + +let POW_POS = prove( + `!x n. &0 <= x ==> &0 <= (x pow n)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[pow; REAL_LE_01] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);; + +let POW_LE = prove( + `!n x y. &0 <= x /\ x <= y ==> (x pow n) <= (y pow n)`, + INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_REFL] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[POW_POS]);; + +let POW_M1 = prove( + `!n. abs((--(&1)) pow n) = &1`, + INDUCT_TAC THEN REWRITE_TAC[pow; ABS_NEG; ABS_1] THEN + ASM_REWRITE_TAC[ABS_MUL; ABS_NEG; ABS_1; REAL_MUL_LID]);; + +let POW_MUL = prove( + `!n x y. (x * y) pow n = (x pow n) * (y pow n)`, + INDUCT_TAC THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN + REPEAT GEN_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let REAL_LE_SQUARE_POW = prove( + `!x. &0 <= x pow 2`, + GEN_TAC THEN REWRITE_TAC[POW_2; REAL_LE_SQUARE]);; + +let ABS_POW2 = prove( + `!x. abs(x pow 2) = x pow 2`, + GEN_TAC THEN REWRITE_TAC[ABS_REFL; REAL_LE_SQUARE_POW]);; + +let REAL_LE1_POW2 = prove( + `!x. &1 <= x ==> &1 <= (x pow 2)`, + GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[REAL_LE_01]);; + +let REAL_LT1_POW2 = prove( + `!x. &1 < x ==> &1 < (x pow 2)`, + GEN_TAC THEN REWRITE_TAC[POW_2] THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_MUL2_ALT THEN ASM_REWRITE_TAC[REAL_LE_01]);; + +let POW_POS_LT = prove( + `!x n. &0 < x ==> &0 < (x pow (SUC n))`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[]; + CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC POW_NZ THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[]]);; + +let POW_2_LE1 = prove( + `!n. &1 <= &2 pow n`, + INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LE_REFL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2V THEN ASM_REWRITE_TAC[REAL_LE] THEN + REWRITE_TAC[LE_0; num_CONV `2`; LESS_EQ_SUC_REFL]);; + +let POW_2_LT = prove( + `!n. &n < &2 pow n`, + INDUCT_TAC THEN REWRITE_TAC[pow; REAL_LT_01] THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; GSYM REAL_DOUBLE] THEN + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[POW_2_LE1]);; + +let POW_MINUS1 = prove( + `!n. (--(&1)) pow (2 * n) = &1`, + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; pow] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; ADD_CLAUSES] THEN + REWRITE_TAC[pow] THEN + REWRITE_TAC[SYM(num_CONV `2`); SYM(num_CONV `1`)] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_NEGNEG]);; + +(*----------------------------------------------------------------------------*) +(* Derive the supremum property for an arbitrary bounded nonempty set *) +(*----------------------------------------------------------------------------*) + +let REAL_SUP_EXISTS = prove( + `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==> + (?s. !y. (?x. P x /\ y < x) <=> y < s)`, + GEN_TAC THEN MP_TAC(SPEC `P:real->bool` REAL_COMPLETE) THEN + MESON_TAC[REAL_LT_IMP_LE; REAL_LTE_TRANS; REAL_NOT_LT]);; + +let sup_def = new_definition + `sup s = @a. (!x. x IN s ==> x <= a) /\ + (!b. (!x. x IN s ==> x <= b) ==> a <= b)`;; + +let sup = prove + (`sup P = @s. !y. (?x. P x /\ y < x) <=> y < s`, + REWRITE_TAC[sup_def; IN] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + ASM_MESON_TAC[REAL_LTE_TRANS; REAL_NOT_LT; REAL_LE_REFL]);; + +let REAL_SUP = prove( + `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==> + (!y. (?x. P x /\ y < x) <=> y < sup P)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o SELECT_RULE o MATCH_MP REAL_SUP_EXISTS) + THEN REWRITE_TAC[GSYM sup]);; + +let REAL_SUP_UBOUND = prove( + `!P. (?x. P x) /\ (?z. !x. P x ==> x < z) ==> + (!y. P y ==> y <= sup P)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `sup P` o MATCH_MP REAL_SUP) THEN + REWRITE_TAC[REAL_LT_REFL] THEN + DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN + X_GEN_TAC `x:real` THEN RULE_ASSUM_TAC(SPEC `x:real`) THEN + DISCH_THEN (SUBST_ALL_TAC o EQT_INTRO) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[REAL_NOT_LT]);; + +let SETOK_LE_LT = prove( + `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) <=> + (?x. P x) /\ (?z. !x. P x ==> x < z)`, + GEN_TAC THEN AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `z:real`) + THENL (map EXISTS_TAC [`z + &1`; `z:real`]) THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[REAL_LT_ADD1; REAL_LT_IMP_LE]);; + +let REAL_SUP_LE = prove( + `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==> + (!y. (?x. P x /\ y < x) <=> y < sup P)`, + GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT; REAL_SUP]);; + +let REAL_SUP_UBOUND_LE = prove( + `!P. (?x. P x) /\ (?z. !x. P x ==> x <= z) ==> + (!y. P y ==> y <= sup P)`, + GEN_TAC THEN REWRITE_TAC[SETOK_LE_LT; REAL_SUP_UBOUND]);; + +(*----------------------------------------------------------------------------*) +(* Prove the Archimedean property *) +(*----------------------------------------------------------------------------*) + +let REAL_ARCH_SIMPLE = prove + (`!x. ?n. x <= &n`, + let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in + MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN + MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL; + REAL_ARITH `~(M <= M - &1)`]);; + +let REAL_ARCH = prove( + `!x. &0 < x ==> !y. ?n. y < &n * x`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a <=> ~(~a)`] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN + REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(SPEC `\z. ?n. z = &n * x` REAL_SUP_LE) THEN BETA_TAC THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o + funpow 2 (fst o dest_imp) o snd) + THENL [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`&n * x`; `n:num`] THEN REFL_TAC; + EXISTS_TAC `y:real` THEN GEN_TAC THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `sup(\z. ?n. z = &n * x) - x`) THEN + REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `n:num`) MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_RDISTRIB] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `sup(\z. ?n. z = &n * x)`) THEN + REWRITE_TAC[REAL_LT_REFL] THEN EXISTS_TAC `(&n + &1) * x` THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `n + 1` THEN + REWRITE_TAC[REAL_ADD]);; + +let REAL_ARCH_LEAST = prove( + `!y. &0 < y ==> !x. &0 <= x ==> + ?n. (&n * y) <= x /\ x < (&(SUC n) * y)`, + GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP REAL_ARCH) THEN + GEN_TAC THEN POP_ASSUM(ASSUME_TAC o SPEC `x:real`) THEN + POP_ASSUM(X_CHOOSE_THEN `n:num` MP_TAC o + ONCE_REWRITE_RULE[num_WOP]) THEN + REWRITE_TAC[REAL_NOT_LT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SPEC `PRE n`)) THEN + DISCH_TAC THEN EXISTS_TAC `PRE n` THEN + SUBGOAL_THEN `SUC(PRE n) = n` ASSUME_TAC THENL + [DISJ_CASES_THEN2 SUBST_ALL_TAC (CHOOSE_THEN SUBST_ALL_TAC) + (SPEC `n:num` num_CASES) THENL + [UNDISCH_TAC `x < &0 * y` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_NOT_LE]; + REWRITE_TAC[PRE]]; + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[PRE; LESS_SUC_REFL]]);; + +let REAL_POW_LBOUND = prove + (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH + `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; + +let REAL_ARCH_POW = prove + (`!x y. &1 < x ==> ?n. y < x pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 + &n * (x - &1)` THEN + ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN + ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH + `&1 < x ==> &0 <= x - &1`]);; + +let REAL_ARCH_POW2 = prove + (`!x. ?n. x < &2 pow n`, + SIMP_TAC[REAL_ARCH_POW; REAL_OF_NUM_LT; ARITH]);; + +(* ========================================================================= *) +(* Finite sums. NB: sum(m,n) f = f(m) + f(m+1) + ... + f(m+n-1) *) +(* ========================================================================= *) + +prioritize_real();; + +make_overloadable "sum" `:A->(B->real)->real`;; + +overload_interface("sum",`sum:(A->bool)->(A->real)->real`);; +overload_interface("sum",`psum:(num#num)->(num->real)->real`);; + +let sum_EXISTS = prove + (`?sum. (!f n. sum(n,0) f = &0) /\ + (!f m n. sum(n,SUC m) f = sum(n,m) f + f(n + m))`, + (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) + `(!f n. sm n 0 f = &0) /\ + (!f m n. sm n (SUC m) f = sm n m f + f(n + m))` THEN + EXISTS_TAC `\(n,m) f. (sm:num->num->(num->real)->real) n m f` THEN + CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]);; + +let sum_DEF = new_specification ["psum"] sum_EXISTS;; + +let sum = prove + (`(sum(n,0) f = &0) /\ + (sum(n,SUC m) f = sum(n,m) f + f(n + m))`, + REWRITE_TAC[sum_DEF]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to the standard notion. *) +(* ------------------------------------------------------------------------- *) + +let PSUM_SUM = prove + (`!f m n. sum(m,n) f = sum {i | m <= i /\ i < m + n} f`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THENL + [SUBGOAL_THEN `{i | m <= i /\ i < m + 0} = {}` + (fun th -> SIMP_TAC[th; SUM_CLAUSES]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `FINITE {i | m <= i /\ i < m + n} /\ + {i | m <= i /\ i < m + SUC n} = + (m + n) INSERT {i | m <= i /\ i < m + n}` + (fun th -> ASM_SIMP_TAC[th; SUM_CLAUSES; IN_ELIM_THM; + LT_REFL; REAL_ADD_AC]) THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `m..m+n` THEN + REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM]; + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT]] THEN + ARITH_TAC);; + +let PSUM_SUM_NUMSEG = prove + (`!f m n. ~(m = 0 /\ n = 0) ==> sum(m,n) f = sum(m..(m+n)-1) f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[PSUM_SUM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Stuff about sums. *) +(* ------------------------------------------------------------------------- *) + +let SUM_TWO = prove + (`!f n p. sum(0,n) f + sum(n,p) f = sum(0,n + p) f`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[sum; REAL_ADD_RID; ADD_CLAUSES] THEN + ASM_REWRITE_TAC[REAL_ADD_ASSOC]);; + +let SUM_DIFF = prove + (`!f m n. sum(m,n) f = sum(0,m + n) f - sum(0,m) f`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN MATCH_ACCEPT_TAC SUM_TWO);; + +let ABS_SUM = prove + (`!f m n. abs(sum(m,n) f) <= sum(m,n) (\n. abs(f n))`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[sum; REAL_ABS_0; REAL_LE_REFL] THEN BETA_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sum(m,n) f) + abs(f(m + n))` THEN + ASM_REWRITE_TAC[REAL_ABS_TRIANGLE; REAL_LE_RADD]);; + +let SUM_LE = prove + (`!f g m n. (!r. m <= r /\ r < n + m ==> f(r) <= g(r)) + ==> (sum(m,n) f <= sum(m,n) g)`, + EVERY(replicate GEN_TAC 3) THEN + INDUCT_TAC THEN REWRITE_TAC[sum; REAL_LE_REFL] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `(n:num) + m`; + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM]] THEN + ASM_REWRITE_TAC[ADD_CLAUSES; LE_ADD; LT]);; + +let SUM_EQ = prove + (`!f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r))) + ==> (sum(m,n) f = sum(m,n) g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN GEN_TAC THEN + DISCH_THEN(fun th -> MATCH_MP_TAC REAL_EQ_IMP_LE THEN + FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN REFL_TAC);; + +let SUM_POS = prove + (`!f. (!n. &0 <= f(n)) ==> !m n. &0 <= sum(m,n) f`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[sum; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[]);; + +let SUM_POS_GEN = prove + (`!f m n. + (!n. m <= n ==> &0 <= f(n)) + ==> &0 <= sum(m,n) f`, + REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[sum; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_ADD THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_ACCEPT_TAC LE_ADD);; + +let SUM_ABS = prove + (`!f m n. abs(sum(m,n) (\m. abs(f m))) = sum(m,n) (\m. abs(f m))`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[REAL_ABS_REFL] THEN + SPEC_TAC(`m:num`,`m:num`) THEN MATCH_MP_TAC SUM_POS THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_POS]);; + +let SUM_ABS_LE = prove + (`!f m n. abs(sum(m,n) f) <= sum(m,n)(\n. abs(f n))`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[sum; REAL_ABS_0; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sum(m,n) f) + abs(f(m + n))` THEN + REWRITE_TAC[REAL_ABS_TRIANGLE] THEN BETA_TAC THEN + ASM_REWRITE_TAC[REAL_LE_RADD]);; + +let SUM_ZERO = prove + (`!f N. (!n. n >= N ==> (f(n) = &0)) ==> + (!m n. m >= N ==> (sum(m,n) f = &0))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN + ASM_REWRITE_TAC[REAL_ADD_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[GE; GSYM ADD_ASSOC; LE_ADD]);; + +let SUM_ADD = prove + (`!f g m n. sum(m,n) (\n. f(n) + g(n)) = sum(m,n) f + sum(m,n) g`, + EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; REAL_ADD_LID; REAL_ADD_AC]);; + +let SUM_CMUL = prove + (`!f c m n. sum(m,n) (\n. c * f(n)) = c * sum(m,n) f`, + EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; REAL_MUL_RZERO] THEN BETA_TAC THEN + REWRITE_TAC[REAL_ADD_LDISTRIB]);; + +let SUM_NEG = prove + (`!f n d. sum(n,d) (\n. --(f n)) = --(sum(n,d) f)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; REAL_NEG_0] THEN + BETA_TAC THEN REWRITE_TAC[REAL_NEG_ADD]);; + +let SUM_SUB = prove + (`!f g m n. sum(m,n)(\n. (f n) - (g n)) = sum(m,n) f - sum(m,n) g`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM SUM_NEG; GSYM SUM_ADD]);; + +let SUM_SUBST = prove + (`!f g m n. (!p. m <= p /\ p < (m + n) ==> (f p = g p)) + ==> (sum(m,n) f = sum(m,n) g)`, + EVERY (replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN BINOP_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE] THEN + MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[LT_SUC_LE; LE_REFL; ADD_CLAUSES]]);; + +let SUM_NSUB = prove + (`!n f c. sum(0,n) f - (&n * c) = sum(0,n)(\p. f(p) - c)`, + INDUCT_TAC THEN REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_SUB_REFL] THEN + REWRITE_TAC[ADD_CLAUSES; GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN + REPEAT GEN_TAC THEN POP_ASSUM(fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_MUL_LID; REAL_ADD_AC]);; + +let SUM_BOUND = prove + (`!f K m n. (!p. m <= p /\ p < (m + n) ==> (f(p) <= K)) + ==> (sum(m,n) f <= (&n * K))`, + EVERY (replicate GEN_TAC 3) THEN INDUCT_TAC THEN + REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_LE_REFL] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_CLAUSES; LT_SUC_LE; LE_REFL] THEN + MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_LID] THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ADD_CLAUSES; LE_ADD; LT_SUC_LE; LE_REFL]]);; + +let SUM_GROUP = prove + (`!n k f. sum(0,n)(\m. sum(m * k,k) f) = sum(0,n * k) f`, + INDUCT_TAC THEN REWRITE_TAC[sum; MULT_CLAUSES] THEN + REPEAT GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_CLAUSES; SUM_TWO]);; + +let SUM_1 = prove + (`!f n. sum(n,1) f = f(n)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[num_CONV `1`; sum; ADD_CLAUSES; REAL_ADD_LID]);; + +let SUM_2 = prove + (`!f n. sum(n,2) f = f(n) + f(n + 1)`, + REPEAT GEN_TAC THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN + REWRITE_TAC[sum; ADD_CLAUSES; REAL_ADD_LID]);; + +let SUM_OFFSET = prove + (`!f n k. sum(0,n)(\m. f(m + k)) = sum(0,n + k) f - sum(0,k) f`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN + REWRITE_TAC[GSYM SUM_TWO; REAL_ADD_SUB] THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN + BETA_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN MATCH_ACCEPT_TAC ADD_SYM);; + +let SUM_REINDEX = prove + (`!f m k n. sum(m + k,n) f = sum(m,n)(\r. f(r + k))`, + EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN + ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN REWRITE_TAC[ADD_AC]);; + +let SUM_0 = prove + (`!m n. sum(m,n)(\r. &0) = &0`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[sum] THEN + BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID]);; + +let SUM_CANCEL = prove + (`!f n d. sum(n,d) (\n. f(SUC n) - f(n)) = f(n + d) - f(n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN + BETA_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_ADD_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_RID]);; + +let SUM_HORNER = prove + (`!f n x. sum(0,SUC n)(\i. f(i) * x pow i) = + f(0) + x * sum(0,n)(\i. f(SUC i) * x pow i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c = b * (a * c)`] THEN + REWRITE_TAC[GSYM real_pow] THEN + MP_TAC(GEN `f:num->real` + (SPECL [`f:num->real`; `n:num`; `1`] SUM_OFFSET)) THEN + REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[SUM_1] THEN REWRITE_TAC[real_pow; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD]);; + +let SUM_CONST = prove + (`!c n. sum(0,n) (\m. c) = &n * c`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; GSYM REAL_OF_NUM_SUC; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_LID]);; + +let SUM_SPLIT = prove + (`!f n p. sum(m,n) f + sum(m + n,p) f = sum(m,n + p) f`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SUM_DIFF] THEN + GEN_REWRITE_TAC RAND_CONV [SUM_DIFF] THEN + REWRITE_TAC[ADD_ASSOC] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM SUM_TWO] THEN + REAL_ARITH_TAC);; + +let SUM_SWAP = prove + (`!f m1 n1 m2 n2. + sum(m1,n1) (\a. sum(m2,n2) (\b. f a b)) = + sum(m2,n2) (\b. sum(m1,n1) (\a. f a b))`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[sum; SUM_0] THEN ASM_REWRITE_TAC[SUM_ADD]);; + +let SUM_EQ_0 = prove + (`(!r. m <= r /\ r < m + n ==> (f(r) = &0)) ==> (sum(m,n) f = &0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum(m,n) (\r. &0)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SUM_0]] THEN + MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]);; + +let SUM_MORETERMS_EQ = prove + (`!m n p. + n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f(r) = &0)) + ==> (sum(m,p) f = sum(m,n) f)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o GSYM o MATCH_MP SUB_ADD) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN + SUBGOAL_THEN `sum (m + n,p - n) f = &0` + (fun th -> REWRITE_TAC[REAL_ADD_RID; th]) THEN MATCH_MP_TAC SUM_EQ_0 THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `(m + n) + p - n:num` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN MATCH_MP_TAC EQ_IMP_LE THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[SUB_ADD]);; + +let SUM_DIFFERENCES_EQ = prove + (`!m n p. + n <= p /\ (!r. m + n <= r /\ r < m + p ==> (f(r) = g(r))) + ==> (sum(m,p) f - sum(m,n) f = sum(m,p) g - sum(m,n) g)`, + ONCE_REWRITE_TAC[REAL_ARITH `(a - b = c - d) <=> (a - c = b - d)`] THEN + SIMP_TAC[GSYM SUM_SUB; SUM_MORETERMS_EQ; REAL_SUB_0]);; + +(* ------------------------------------------------------------------------- *) +(* A conversion to evaluate summations (not clear it belongs here...) *) +(* ------------------------------------------------------------------------- *) + +let REAL_SUM_CONV = + let sum_tm = `sum` in + let pth = prove + (`sum(0,1) f = f 0`, + REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES]) in + let conv0 = GEN_REWRITE_CONV I [CONJUNCT1 sum; pth] + and conv1 = REWR_CONV(CONJUNCT2 sum) in + let rec sum_conv tm = + try conv0 tm + with Failure _ -> + (LAND_CONV(RAND_CONV num_CONV) THENC + conv1 THENC LAND_CONV sum_conv) tm in + fun tm -> + let sn,bod = dest_comb tm in + let s,ntm = dest_comb sn in + let _,htm = dest_pair ntm in + if s = sum_tm & is_numeral htm + then sum_conv tm + else failwith "REAL_SUM_CONV";; + +let REAL_HORNER_SUM_CONV = + let sum_tm = `sum` in + let pth = prove + (`sum(0,1) f = f 0`, + REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES]) in + let conv0 = GEN_REWRITE_CONV I [CONJUNCT1 sum; pth] + and conv1 = REWR_CONV SUM_HORNER in + let rec sum_conv tm = + try conv0 tm + with Failure _ -> + (LAND_CONV(RAND_CONV num_CONV) THENC + conv1 THENC RAND_CONV (RAND_CONV sum_conv)) tm in + fun tm -> + let sn,bod = dest_comb tm in + let s,ntm = dest_comb sn in + let _,htm = dest_pair ntm in + if s = sum_tm & is_numeral htm + then sum_conv tm + else failwith "REAL_HORNER_SUM_CONV";; + +(*============================================================================*) +(* Topologies and metric spaces, including metric on real line *) +(*============================================================================*) + +parse_as_infix("re_union",(15,"right"));; +parse_as_infix("re_intersect",(17,"right"));; +parse_as_infix("re_subset",(12,"right"));; + +(*----------------------------------------------------------------------------*) +(* Minimal amount of set notation is convenient *) +(*----------------------------------------------------------------------------*) + +let re_Union = new_definition( + `re_Union S = \x:A. ?s. S s /\ s x`);; + +let re_union = new_definition( + `P re_union Q = \x:A. P x \/ Q x`);; + +let re_intersect = new_definition + `P re_intersect Q = \x:A. P x /\ Q x`;; + +let re_null = new_definition( + `re_null = \x:A. F`);; + +let re_universe = new_definition( + `re_universe = \x:A. T`);; + +let re_subset = new_definition( + `P re_subset Q <=> !x:A. P x ==> Q x`);; + +let re_compl = new_definition( + `re_compl S = \x:A. ~(S x)`);; + +let SUBSETA_REFL = prove( + `!S:A->bool. S re_subset S`, + GEN_TAC THEN REWRITE_TAC[re_subset]);; + +let COMPL_MEM = prove( + `!S:A->bool. !x. S x <=> ~(re_compl S x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[re_compl] THEN + BETA_TAC THEN REWRITE_TAC[]);; + +let SUBSETA_ANTISYM = prove( + `!P:A->bool. !Q. P re_subset Q /\ Q re_subset P <=> (P = Q)`, + REPEAT GEN_TAC THEN REWRITE_TAC[re_subset] THEN + CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (b ==> a) <=> (a <=> b)`] THEN + CONV_TAC(RAND_CONV FUN_EQ_CONV) THEN REFL_TAC);; + +let SUBSETA_TRANS = prove( + `!P:A->bool. !Q R. P re_subset Q /\ Q re_subset R ==> P re_subset R`, + REPEAT GEN_TAC THEN REWRITE_TAC[re_subset] THEN + CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN + DISCH_THEN(MATCH_ACCEPT_TAC o GEN `x:A` o end_itlist IMP_TRANS o + CONJUNCTS o SPEC `x:A`));; + +(*----------------------------------------------------------------------------*) +(* Characterize an (A)topology *) +(*----------------------------------------------------------------------------*) + +let istopology = new_definition( + `!L:(A->bool)->bool. istopology L <=> + L re_null /\ + L re_universe /\ + (!a b. L a /\ L b ==> L (a re_intersect b)) /\ + (!P. P re_subset L ==> L (re_Union P))`);; + +let topology_tybij = new_type_definition "topology" ("topology","open") + (prove(`?t:(A->bool)->bool. istopology t`, + EXISTS_TAC `re_universe:(A->bool)->bool` THEN + REWRITE_TAC[istopology; re_universe]));; + +let TOPOLOGY = prove( + `!L:(A)topology. open(L) re_null /\ + open(L) re_universe /\ + (!x y. open(L) x /\ open(L) y ==> open(L) (x re_intersect y)) /\ + (!P. P re_subset (open L) ==> open(L) (re_Union P))`, + GEN_TAC THEN REWRITE_TAC[GSYM istopology] THEN + REWRITE_TAC[topology_tybij]);; + +let TOPOLOGY_UNION = prove( + `!L:(A)topology. !P. P re_subset (open L) ==> open(L) (re_Union P)`, + REWRITE_TAC[TOPOLOGY]);; + +(*----------------------------------------------------------------------------*) +(* Characterize a neighbourhood of a point relative to a topology *) +(*----------------------------------------------------------------------------*) + +let neigh = new_definition( + `neigh(top)(N,(x:A)) = ?P. open(top) P /\ P re_subset N /\ P x`);; + +(*----------------------------------------------------------------------------*) +(* Prove various properties / characterizations of open sets *) +(*----------------------------------------------------------------------------*) + +let OPEN_OWN_NEIGH = prove( + `!S top. !x:A. open(top) S /\ S x ==> neigh(top)(S,x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[neigh] THEN + EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]);; + +let OPEN_UNOPEN = prove( + `!S top. open(top) S <=> + (re_Union (\P:A->bool. open(top) P /\ P re_subset S) = S)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM SUBSETA_ANTISYM] THEN + REWRITE_TAC[re_Union; re_subset] THEN + BETA_TAC THEN CONJ_TAC THEN GEN_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `s:A->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; + DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC TOPOLOGY_UNION THEN + REWRITE_TAC[re_subset] THEN BETA_TAC THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]);; + +let OPEN_SUBOPEN = prove( + `!S top. open(top) S <=> + !x:A. S x ==> ?P. P x /\ open(top) P /\ P re_subset S`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]; + DISCH_TAC THEN C SUBGOAL_THEN SUBST1_TAC + `S = re_Union (\P:A->bool. open(top) P /\ P re_subset S)` THENL + [ONCE_REWRITE_TAC[GSYM SUBSETA_ANTISYM] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[re_subset] THEN REWRITE_TAC [re_Union] THEN + BETA_TAC THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(X_CHOOSE_TAC `P:A->bool`) THEN EXISTS_TAC `P:A->bool` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[re_subset; re_Union] THEN BETA_TAC THEN GEN_TAC THEN + DISCH_THEN(CHOOSE_THEN STRIP_ASSUME_TAC) THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]; + MATCH_MP_TAC TOPOLOGY_UNION THEN ONCE_REWRITE_TAC[re_subset] THEN + GEN_TAC THEN BETA_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; + +let OPEN_NEIGH = prove( + `!S top. open(top) S = !x:A. S x ==> ?N. neigh(top)(N,x) /\ N re_subset S`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `S:A->bool` THEN + REWRITE_TAC[SUBSETA_REFL; neigh] THEN + EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSETA_REFL]; + DISCH_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN + GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(X_CHOOSE_THEN `N:A->bool` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) + THEN REWRITE_TAC[neigh] THEN + DISCH_THEN(X_CHOOSE_THEN `P:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `P:A->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSETA_TRANS THEN EXISTS_TAC `N:A->bool` THEN + ASM_REWRITE_TAC[]]);; + +(*----------------------------------------------------------------------------*) +(* Characterize closed sets in a topological space *) +(*----------------------------------------------------------------------------*) + +let closed = new_definition( + `closed(L:(A)topology) S = open(L)(re_compl S)`);; + +(*----------------------------------------------------------------------------*) +(* Define limit point in topological space *) +(*----------------------------------------------------------------------------*) + +let limpt = new_definition( + `limpt(top) x S <=> + !N:A->bool. neigh(top)(N,x) ==> ?y. ~(x = y) /\ S y /\ N y`);; + +(*----------------------------------------------------------------------------*) +(* Prove that a set is closed iff it contains all its limit points *) +(*----------------------------------------------------------------------------*) + +let CLOSED_LIMPT = prove( + `!top S. closed(top) S <=> (!x:A. limpt(top) x S ==> S x)`, + REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN + REWRITE_TAC[closed; limpt] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN + FREEZE_THEN (fun th -> ONCE_REWRITE_TAC[th]) + (SPEC `S:A->bool` COMPL_MEM) THEN + REWRITE_TAC[] THEN + SPEC_TAC(`re_compl(S:A->bool)`,`S:A->bool`) THEN + GEN_TAC THEN REWRITE_TAC[NOT_IMP] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN + REWRITE_TAC[DE_MORGAN_THM] THEN + REWRITE_TAC[OPEN_NEIGH; re_subset] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `(S:A->bool) x` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TAUT `a \/ b \/ ~c <=> c ==> a \/ b`] THEN + EQUAL_TAC THEN + REWRITE_TAC[TAUT `(a <=> b \/ a) <=> b ==> a`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + POP_ASSUM ACCEPT_TAC);; + +(*----------------------------------------------------------------------------*) +(* Characterize an (A)metric *) +(*----------------------------------------------------------------------------*) + +let ismet = new_definition( + `ismet (m:A#A->real) <=> (!x y. (m(x,y) = &0) <=> (x = y)) /\ + (!x y z. m(y,z) <= m(x,y) + m(x,z))`);; + +let metric_tybij = new_type_definition "metric" ("metric","mdist") + (prove(`?m:(A#A->real). ismet m`, + EXISTS_TAC `\((x:A),(y:A)). if x = y then &0 else &1` THEN + REWRITE_TAC[ismet] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + CONJ_TAC THEN REPEAT GEN_TAC THENL + [BOOL_CASES_TAC `x:A = y` THEN REWRITE_TAC[REAL_10]; + REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_LE_REFL; REAL_LE_01] + THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_LID] THEN + TRY(MATCH_MP_TAC REAL_LE_ADD2) THEN + REWRITE_TAC[REAL_LE_01; REAL_LE_REFL] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN + EVERY_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[]]));; + +(*----------------------------------------------------------------------------*) +(* Derive the metric properties *) +(*----------------------------------------------------------------------------*) + +let METRIC_ISMET = prove( + `!m:(A)metric. ismet (mdist m)`, + GEN_TAC THEN REWRITE_TAC[metric_tybij]);; + +let METRIC_ZERO = prove( + `!m:(A)metric. !x y. ((mdist m)(x,y) = &0) <=> (x = y)`, + REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN + RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN ASM_REWRITE_TAC[]);; + +let METRIC_SAME = prove( + `!m:(A)metric. !x. (mdist m)(x,x) = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[METRIC_ZERO]);; + +let METRIC_POS = prove( + `!m:(A)metric. !x y. &0 <= (mdist m)(x,y)`, + REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN + RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`; `y:A`] o CONJUNCT2) THEN + REWRITE_TAC[REWRITE_RULE[] (SPECL [`m:(A)metric`; `y:A`; `y:A`] METRIC_ZERO)] + THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2 o W CONJ) THEN + REWRITE_TAC[REAL_ADD_LID]);; + +let METRIC_SYM = prove( + `!m:(A)metric. !x y. (mdist m)(x,y) = (mdist m)(y,x)`, + REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN + RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN FIRST_ASSUM + (MP_TAC o GENL [`y:A`; `z:A`] o SPECL [`z:A`; `y:A`; `z:A`] o CONJUNCT2) + THEN REWRITE_TAC[METRIC_SAME; REAL_ADD_RID] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM]);; + +let METRIC_TRIANGLE = prove( + `!m:(A)metric. !x y z. (mdist m)(x,z) <= (mdist m)(x,y) + (mdist m)(y,z)`, + REPEAT GEN_TAC THEN ASSUME_TAC(SPEC `m:(A)metric` METRIC_ISMET) THEN + RULE_ASSUM_TAC(REWRITE_RULE[ismet]) THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [METRIC_SYM] THEN + ASM_REWRITE_TAC[]);; + +let METRIC_NZ = prove( + `!m:(A)metric. !x y. ~(x = y) ==> &0 < (mdist m)(x,y)`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPECL [`m:(A)metric`; `x:A`; `y:A`] METRIC_ZERO)) THEN + ONCE_REWRITE_TAC[TAUT `~a ==> b <=> b \/ a`] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + REWRITE_TAC[GSYM REAL_LE_LT; METRIC_POS]);; + +(*----------------------------------------------------------------------------*) +(* Now define metric topology and prove equivalent definition of `open` *) +(*----------------------------------------------------------------------------*) + +let mtop = new_definition( + `!m:(A)metric. mtop m = + topology(\S. !x. S x ==> ?e. &0 < e /\ (!y. (mdist m)(x,y) < e ==> S y))`);; + +let mtop_istopology = prove( + `!m:(A)metric. istopology + (\S. !x. S x ==> ?e. &0 < e /\ (!y. (mdist m)(x,y) < e ==> S y))`, + GEN_TAC THEN + REWRITE_TAC[istopology; re_null; re_universe; re_Union; + re_intersect; re_subset] THEN + CONV_TAC(REDEPTH_CONV BETA_CONV) THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC REAL_LT_01; + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + DISCH_THEN(fun th -> POP_ASSUM(CONJUNCTS_THEN(MP_TAC o SPEC `x:A`)) + THEN REWRITE_TAC[th]) THEN + DISCH_THEN(X_CHOOSE_TAC `e1:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `e2:real`) THEN + REPEAT_TCL DISJ_CASES_THEN MP_TAC + (SPECL [`e1:real`; `e2:real`] REAL_LT_TOTAL) THENL + [DISCH_THEN SUBST_ALL_TAC THEN EXISTS_TAC `e2:real` THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun th -> EVERY_ASSUM(ASSUME_TAC o C MATCH_MP th o CONJUNCT2)) + THEN ASM_REWRITE_TAC[]; + DISCH_THEN((then_) (EXISTS_TAC `e1:real`) o MP_TAC); + DISCH_THEN((then_) (EXISTS_TAC `e2:real`) o MP_TAC)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th2 -> GEN_TAC THEN DISCH_THEN(fun th1 -> + ASSUME_TAC th1 THEN ASSUME_TAC (MATCH_MP REAL_LT_TRANS (CONJ th1 th2)))) + THEN CONJ_TAC THEN FIRST_ASSUM (MATCH_MP_TAC o CONJUNCT2) + THEN FIRST_ASSUM ACCEPT_TAC; + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `y:A->bool` + (fun th -> POP_ASSUM(X_CHOOSE_TAC `e:real` o C MATCH_MP (CONJUNCT2 th) o + C MATCH_MP (CONJUNCT1 th)) THEN ASSUME_TAC th)) THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:A` THEN + DISCH_THEN + (fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th o CONJUNCT2)) THEN + EXISTS_TAC `y:A->bool` THEN ASM_REWRITE_TAC[]]);; + +let MTOP_OPEN = prove( + `!m:(A)metric. open(mtop m) S <=> + (!x. S x ==> ?e. &0 < e /\ (!y. (mdist m(x,y)) < e ==> S y))`, + GEN_TAC THEN REWRITE_TAC[mtop] THEN + REWRITE_TAC[REWRITE_RULE[topology_tybij] mtop_istopology] THEN + BETA_TAC THEN REFL_TAC);; + +(*----------------------------------------------------------------------------*) +(* Define open ball in metric space + prove basic properties *) +(*----------------------------------------------------------------------------*) + +let ball = new_definition( + `!m:(A)metric. !x e. ball(m)(x,e) = \y. (mdist m)(x,y) < e`);; + +let BALL_OPEN = prove( + `!m:(A)metric. !x e. &0 < e ==> open(mtop(m))(ball(m)(x,e))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MTOP_OPEN] THEN + X_GEN_TAC `z:A` THEN REWRITE_TAC[ball] THEN BETA_TAC THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN + EXISTS_TAC `e - mdist(m:(A)metric)(x,z)` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:A` THEN REWRITE_TAC[REAL_LT_SUB_LADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `mdist(m)((x:A),z) + mdist(m)(z,y)` THEN + ASM_REWRITE_TAC[METRIC_TRIANGLE]);; + +let BALL_NEIGH = prove( + `!m:(A)metric. !x e. &0 < e ==> neigh(mtop(m))(ball(m)(x,e),x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[neigh] THEN EXISTS_TAC `ball(m)((x:A),e)` THEN + REWRITE_TAC[SUBSETA_REFL] THEN CONJ_TAC THENL + [MATCH_MP_TAC BALL_OPEN; + REWRITE_TAC[ball] THEN BETA_TAC THEN REWRITE_TAC[METRIC_SAME]] THEN + POP_ASSUM ACCEPT_TAC);; + +(*----------------------------------------------------------------------------*) +(* Characterize limit point in a metric topology *) +(*----------------------------------------------------------------------------*) + +let MTOP_LIMPT = prove( + `!m:(A)metric. !x S. limpt(mtop m) x S <=> + !e. &0 < e ==> ?y. ~(x = y) /\ S y /\ (mdist m)(x,y) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[limpt] THEN EQ_TAC THENL + [DISCH_THEN((then_) (GEN_TAC THEN DISCH_TAC) o + MP_TAC o SPEC `ball(m)((x:A),e)`) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BALL_NEIGH th]) THEN + REWRITE_TAC[ball] THEN BETA_TAC THEN DISCH_THEN ACCEPT_TAC; + DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[neigh] THEN + DISCH_THEN(X_CHOOSE_THEN `P:A->bool` + (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN + REWRITE_TAC[MTOP_OPEN] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `y:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(P:A->bool) re_subset N` THEN + REWRITE_TAC[re_subset] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_ASSUM ACCEPT_TAC]);; + +(*----------------------------------------------------------------------------*) +(* Define the usual metric on the real line *) +(*----------------------------------------------------------------------------*) + +let ISMET_R1 = prove( + `ismet (\(x,y). abs(y - x))`, + REWRITE_TAC[ismet] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + CONJ_TAC THEN REPEAT GEN_TAC THENL + [REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN REFL_TAC; + SUBST1_TAC(SYM(SPECL [`x:real`; `y:real`] REAL_NEG_SUB)) THEN + REWRITE_TAC[ABS_NEG] THEN SUBGOAL_THEN `z - y = (x - y) + (z - x)` + (fun th -> SUBST1_TAC th THEN MATCH_ACCEPT_TAC ABS_TRIANGLE) THEN + REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (d + a) + (c + b)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]]);; + +let mr1 = new_definition( + `mr1 = metric(\(x,y). abs(y - x))`);; + +let MR1_DEF = prove( + `!x y. (mdist mr1)(x,y) = abs(y - x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[mr1; REWRITE_RULE[metric_tybij] ISMET_R1] + THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REFL_TAC);; + +let MR1_ADD = prove( + `!x d. (mdist mr1)(x,x+d) = abs(d)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; REAL_ADD_SUB]);; + +let MR1_SUB = prove( + `!x d. (mdist mr1)(x,x-d) = abs(d)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; REAL_SUB_SUB; ABS_NEG]);; + +let MR1_ADD_LE = prove( + `!x d. &0 <= d ==> ((mdist mr1)(x,x+d) = d)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MR1_ADD; real_abs]);; + +let MR1_SUB_LE = prove( + `!x d. &0 <= d ==> ((mdist mr1)(x,x-d) = d)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[MR1_SUB; real_abs]);; + +let MR1_ADD_LT = prove( + `!x d. &0 < d ==> ((mdist mr1)(x,x+d) = d)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MATCH_ACCEPT_TAC MR1_ADD_LE);; + +let MR1_SUB_LT = prove( + `!x d. &0 < d ==> ((mdist mr1)(x,x-d) = d)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MATCH_ACCEPT_TAC MR1_SUB_LE);; + +let MR1_BETWEEN1 = prove( + `!x y z. x < z /\ (mdist mr1)(x,y) < (z - x) ==> y < z`, + REPEAT GEN_TAC THEN REWRITE_TAC[MR1_DEF; ABS_BETWEEN1]);; + +(*----------------------------------------------------------------------------*) +(* Every real is a limit point of the real line *) +(*----------------------------------------------------------------------------*) + +let MR1_LIMPT = prove( + `!x. limpt(mtop mr1) x re_universe`, + GEN_TAC THEN REWRITE_TAC[MTOP_LIMPT; re_universe] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `x + (e / &2)` THEN + REWRITE_TAC[MR1_ADD] THEN + SUBGOAL_THEN `&0 <= (e / &2)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_REWRITE_TAC[REAL_LT_HALF1]; ALL_TAC] THEN + ASM_REWRITE_TAC[real_abs; REAL_LT_HALF2] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + REWRITE_TAC[REAL_ADD_RID_UNIQ] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + ASM_REWRITE_TAC[REAL_LT_HALF1]);; + +(*============================================================================*) +(* Theory of Moore-Smith covergence nets, and special cases like sequences *) +(*============================================================================*) + +parse_as_infix ("tends",(12,"right"));; + +(*----------------------------------------------------------------------------*) +(* Basic definitions: directed set, net, bounded net, pointwise limit *) +(*----------------------------------------------------------------------------*) + +let dorder = new_definition( + `dorder (g:A->A->bool) <=> + !x y. g x x /\ g y y ==> ?z. g z z /\ (!w. g w z ==> g w x /\ g w y)`);; + +let tends = new_definition + `(s tends l)(top,g) <=> + !N:A->bool. neigh(top)(N,l) ==> + ?n:B. g n n /\ !m:B. g m n ==> N(s m)`;; + +let bounded = new_definition( + `bounded((m:(A)metric),(g:B->B->bool)) f <=> + ?k x N. g N N /\ (!n. g n N ==> (mdist m)(f(n),x) < k)`);; + +let tendsto = new_definition( + `tendsto((m:(A)metric),x) y z <=> + &0 < (mdist m)(x,y) /\ (mdist m)(x,y) <= (mdist m)(x,z)`);; + +parse_as_infix("-->",(12,"right"));; + +override_interface ("-->",`(tends)`);; + +let DORDER_LEMMA = prove( + `!g:A->A->bool. + dorder g ==> + !P Q. (?n. g n n /\ (!m. g m n ==> P m)) /\ + (?n. g n n /\ (!m. g m n ==> Q m)) + ==> (?n. g n n /\ (!m. g m n ==> P m /\ Q m))`, + GEN_TAC THEN REWRITE_TAC[dorder] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `N1:A` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `N2:A` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPECL [`N1:A`; `N2:A`]) THEN + REWRITE_TAC[ASSUME `(g:A->A->bool) N1 N1`;ASSUME `(g:A->A->bool) N2 N2`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:A` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `m:A` THEN DISCH_TAC THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o + check(is_conj o snd o dest_imp o snd o dest_forall) o concl) THEN + DISCH_THEN(MP_TAC o SPEC `m:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Following tactic is useful in the following proofs *) +(*----------------------------------------------------------------------------*) + +let DORDER_THEN tac th = + let [t1;t2] = map (rand o rand o body o rand) (conjuncts(concl th)) in + let dog = (rator o rator o rand o rator o body) t1 in + let thl = map ((uncurry X_BETA_CONV) o (I F_F rand) o dest_abs) [t1;t2] in + let th1 = CONV_RULE(EXACT_CONV thl) th in + let th2 = MATCH_MP DORDER_LEMMA (ASSUME (list_mk_icomb "dorder" [dog])) in + let th3 = MATCH_MP th2 th1 in + let th4 = CONV_RULE(EXACT_CONV(map SYM thl)) th3 in + tac th4;; + +(*----------------------------------------------------------------------------*) +(* Show that sequences and pointwise limits in a metric space are directed *) +(*----------------------------------------------------------------------------*) + +let DORDER_NGE = prove( + `dorder ((>=) :num->num->bool)`, + REWRITE_TAC[dorder; GE; LE_REFL] THEN + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THENL + [EXISTS_TAC `y:num`; EXISTS_TAC `x:num`] THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LE_TRANS THENL + [EXISTS_TAC `y:num`; EXISTS_TAC `x:num`] THEN + ASM_REWRITE_TAC[]);; + +let DORDER_TENDSTO = prove( + `!m:(A)metric. !x. dorder(tendsto(m,x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[dorder; tendsto] THEN + MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN + REWRITE_TAC[REAL_LE_REFL] THEN + DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN + DISJ_CASES_TAC(SPECL [`(mdist m)((x:A),v)`; `(mdist m)((x:A),u)`] + REAL_LE_TOTAL) + THENL [EXISTS_TAC `v:A`; EXISTS_TAC `u:A`] THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN FIRST_ASSUM (fun th -> + (EXISTS_TAC o rand o concl) th THEN ASM_REWRITE_TAC[] THEN NO_TAC));; + +(*----------------------------------------------------------------------------*) +(* Simpler characterization of limit in a metric topology *) +(*----------------------------------------------------------------------------*) + +let MTOP_TENDS = prove( + `!d g. !x:B->A. !x0. (x --> x0)(mtop(d),g) <=> + !e. &0 < e ==> ?n. g n n /\ !m. g m n ==> mdist(d)(x(m),x0) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends] THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `ball(d)((x0:A),e)`) THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (rand o rator) o snd) THENL + [MATCH_MP_TAC BALL_NEIGH THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[ball] THEN + BETA_TAC THEN GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [METRIC_SYM] THEN REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[neigh] THEN + DISCH_THEN(X_CHOOSE_THEN `P:A->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `open(mtop(d)) (P:A->bool)` THEN + REWRITE_TAC[MTOP_OPEN] THEN DISCH_THEN(MP_TAC o SPEC `x0:A`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `d:real`) THEN + REWRITE_TAC[ASSUME `&0 < d`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:B` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `(P:A->bool) re_subset N` THEN + REWRITE_TAC[re_subset] THEN DISCH_TAC THEN + REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN + ONCE_REWRITE_TAC[METRIC_SYM] THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; + +(*----------------------------------------------------------------------------*) +(* Prove that a net in a metric topology cannot converge to different limits *) +(*----------------------------------------------------------------------------*) + +let MTOP_TENDS_UNIQ = prove( + `!g d. dorder (g:B->B->bool) ==> + (x --> x0)(mtop(d),g) /\ (x --> x1)(mtop(d),g) ==> (x0:A = x1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[MTOP_TENDS] THEN + CONV_TAC(ONCE_DEPTH_CONV AND_FORALL_CONV) THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN + CONV_TAC NOT_FORALL_CONV THEN + EXISTS_TAC `mdist(d:(A)metric)(x0,x1) / &2` THEN + W(C SUBGOAL_THEN ASSUME_TAC o rand o rator o rand o snd) THENL + [REWRITE_TAC[REAL_LT_HALF1] THEN MATCH_MP_TAC METRIC_NZ THEN + FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N:B` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `N:B`) THEN ASM_REWRITE_TAC[] THEN + BETA_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_ADD2) THEN + REWRITE_TAC[REAL_HALF_DOUBLE; REAL_NOT_LT] THEN + GEN_REWRITE_TAC(RAND_CONV o LAND_CONV) [METRIC_SYM] THEN + MATCH_ACCEPT_TAC METRIC_TRIANGLE);; + +(*----------------------------------------------------------------------------*) +(* Simpler characterization of limit of a sequence in a metric topology *) +(*----------------------------------------------------------------------------*) + +let SEQ_TENDS = prove( + `!d:(A)metric. !x x0. (x --> x0)(mtop(d), (>=) :num->num->bool) <=> + !e. &0 < e ==> ?N. !n. n >= N ==> mdist(d)(x(n),x0) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; GE; LE_REFL]);; + +(*----------------------------------------------------------------------------*) +(* And of limit of function between metric spaces *) +(*----------------------------------------------------------------------------*) + +let LIM_TENDS = prove( + `!m1:(A)metric. !m2:(B)metric. !f x0 y0. + limpt(mtop m1) x0 re_universe ==> + ((f --> y0)(mtop(m2),tendsto(m1,x0)) <=> + !e. &0 < e ==> + ?d. &0 < d /\ !x. &0 < (mdist m1)(x,x0) /\ (mdist m1)(x,x0) <= d + ==> (mdist m2)(f(x),y0) < e)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[MTOP_TENDS; tendsto] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_LE_REFL] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(mdist m1)((x0:A),z)` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBST1_TAC(ISPECL [`m1:(A)metric`; `x0:A`; `x:A`] METRIC_SYM) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `limpt(mtop m1) (x0:A) re_universe` THEN + REWRITE_TAC[MTOP_LIMPT] THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[re_universe] THEN + DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `y:A` THEN CONJ_TAC THENL + [MATCH_MP_TAC METRIC_NZ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[METRIC_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(mdist m1)((x0:A),y)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_ASSUM ACCEPT_TAC]);; + +(*----------------------------------------------------------------------------*) +(* Similar, more conventional version, is also true at a limit point *) +(*----------------------------------------------------------------------------*) + +let LIM_TENDS2 = prove( + `!m1:(A)metric. !m2:(B)metric. !f x0 y0. + limpt(mtop m1) x0 re_universe ==> + ((f --> y0)(mtop(m2),tendsto(m1,x0)) <=> + !e. &0 < e ==> + ?d. &0 < d /\ !x. &0 < (mdist m1)(x,x0) /\ (mdist m1)(x,x0) < d ==> + (mdist m2)(f(x),y0) < e)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LIM_TENDS th]) THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF2]]);; + +(*----------------------------------------------------------------------------*) +(* Simpler characterization of boundedness for the real line *) +(*----------------------------------------------------------------------------*) + +let MR1_BOUNDED = prove( + `!(g:A->A->bool) f. bounded(mr1,g) f <=> + ?k N. g N N /\ (!n. g n N ==> abs(f n) < k)`, + REPEAT GEN_TAC THEN REWRITE_TAC[bounded; MR1_DEF] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV) + [SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN + CONV_TAC(REDEPTH_CONV EXISTS_AND_CONV) THEN + AP_TERM_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THENL + [DISCH_THEN(X_CHOOSE_TAC `x:real`) THEN + EXISTS_TAC `abs(x) + k` THEN GEN_TAC THEN DISCH_TAC THEN + SUBST1_TAC(SYM(SPECL [`(f:A->real) n`; `x:real`] REAL_SUB_ADD)) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs((f:A->real) n - x) + abs(x)` THEN + REWRITE_TAC[ABS_TRIANGLE] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN + REWRITE_TAC[REAL_LT_RADD] THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`k:real`; `&0`] THEN + ASM_REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG]]);; + +(*----------------------------------------------------------------------------*) +(* Firstly, prove useful forms of null and bounded nets *) +(*----------------------------------------------------------------------------*) + +let NET_NULL = prove( + `!g:A->A->bool. !x x0. + (x --> x0)(mtop(mr1),g) <=> ((\n. x(n) - x0) --> &0)(mtop(mr1),g)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN BETA_TAC THEN + REWRITE_TAC[MR1_DEF; REAL_SUB_LZERO] THEN EQUAL_TAC THEN + REWRITE_TAC[REAL_NEG_SUB]);; + +let NET_CONV_BOUNDED = prove( + `!g:A->A->bool. !x x0. + (x --> x0)(mtop(mr1),g) ==> bounded(mr1,g) x`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; bounded] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0] THEN + REWRITE_TAC[GSYM(num_CONV `1`)] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`&1`; `x0:real`; `N:A`] THEN + ASM_REWRITE_TAC[]);; + +let NET_CONV_NZ = prove( + `!g:A->A->bool. !x x0. + (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==> + ?N. g N N /\ (!n. g n N ==> ~(x n = &0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; bounded] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `abs(x0)`) ASSUME_TAC) THEN + ASM_REWRITE_TAC[GSYM ABS_NZ] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_TAC THEN EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[MR1_DEF; REAL_SUB_RZERO; REAL_LT_REFL]);; + +let NET_CONV_IBOUNDED = prove( + `!g:A->A->bool. !x x0. + (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) ==> + bounded(mr1,g) (\n. inv(x n))`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_BOUNDED; MR1_DEF] THEN + BETA_TAC THEN REWRITE_TAC[ABS_NZ] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `abs(x0) / &2`) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`&2 / abs(x0)`; `N:A`] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:A` THEN + DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `(abs(x0) / & 2) < abs(x(n:A))` ASSUME_TAC THENL + [SUBST1_TAC(SYM(SPECL [`abs(x0) / &2`; `abs(x0) / &2`; `abs(x(n:A))`] + REAL_LT_LADD)) THEN + REWRITE_TAC[REAL_HALF_DOUBLE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(x0 - x(n:A)) + abs(x(n))` THEN + ASM_REWRITE_TAC[REAL_LT_RADD] THEN + SUBST1_TAC(SYM(AP_TERM `abs` + (SPECL [`x0:real`; `x(n:A):real`] REAL_SUB_ADD))) THEN + MATCH_ACCEPT_TAC ABS_TRIANGLE; ALL_TAC] THEN + SUBGOAL_THEN `&0 < abs(x(n:A))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `abs(x0) / &2` THEN + ASM_REWRITE_TAC[REAL_LT_HALF1]; ALL_TAC] THEN + SUBGOAL_THEN `&2 / abs(x0) = inv(abs(x0) / &2)` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_RINV_UNIQ THEN REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (d * a) * (b * c)`] THEN + SUBGOAL_THEN `~(abs(x0) = &0) /\ ~(&2 = &0)` + (fun th -> CONJUNCTS_THEN(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) th + THEN REWRITE_TAC[REAL_MUL_LID]) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[ABS_NZ; ABS_ABS]; + REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]]; ALL_TAC] THEN + SUBGOAL_THEN `~(x(n:A) = &0)` (SUBST1_TAC o MATCH_MP ABS_INV) THENL + [ASM_REWRITE_TAC[ABS_NZ]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_HALF1]);; + +(*----------------------------------------------------------------------------*) +(* Now combining theorems for null nets *) +(*----------------------------------------------------------------------------*) + +let NET_NULL_ADD = prove( + `!g:A->A->bool. dorder g ==> + !x y. (x --> &0)(mtop(mr1),g) /\ (y --> &0)(mtop(mr1),g) ==> + ((\n. x(n) + y(n)) --> &0)(mtop(mr1),g)`, + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN + DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o + MP_TAC o end_itlist CONJ o map (SPEC `e / &2`) o CONJUNCTS) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(DORDER_THEN (X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + BETA_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(x(m:A)) + abs(y(m:A))` THEN + REWRITE_TAC[ABS_TRIANGLE] THEN RULE_ASSUM_TAC BETA_RULE THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]);; + +let NET_NULL_MUL = prove( + `!g:A->A->bool. dorder g ==> + !x y. bounded(mr1,g) x /\ (y --> &0)(mtop(mr1),g) ==> + ((\n. x(n) * y(n)) --> &0)(mtop(mr1),g)`, + GEN_TAC THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN REWRITE_TAC[MR1_BOUNDED] THEN + REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN + DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN + CONV_TAC(LAND_CONV LEFT_AND_EXISTS_CONV) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN + DISCH_THEN(ASSUME_TAC o uncurry CONJ o (I F_F SPEC `e / k`) o CONJ_PAIR) THEN + SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL + [FIRST_ASSUM(X_CHOOSE_THEN `N:A` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) o CONJUNCT1) THEN + DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(x(N:A))` THEN ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + SUBGOAL_THEN `&0 < e / k` ASSUME_TAC THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LT_RDIV_0 th] THEN + ASM_REWRITE_TAC[] THEN NO_TAC); ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DORDER_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN (ASSUME_TAC o BETA_RULE)) THEN + SUBGOAL_THEN `e = k * (e / k)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&0 < &0` THEN + REWRITE_TAC[REAL_LT_REFL]; ALL_TAC] THEN BETA_TAC THEN + REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN + ASM_REWRITE_TAC[ABS_POS]);; + +let NET_NULL_CMUL = prove( + `!g:A->A->bool. !k x. + (x --> &0)(mtop(mr1),g) ==> ((\n. k * x(n)) --> &0)(mtop(mr1),g)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS; MR1_DEF] THEN + BETA_TAC THEN REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG] THEN + DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN + ASM_CASES_TAC `k = &0` THENL + [DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT; num_CONV `1`; LESS_SUC_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; real_abs; REAL_LE_REFL]; + DISCH_THEN(MP_TAC o SPEC `e / abs(k)`) THEN + SUBGOAL_THEN `&0 < e / abs(k)` ASSUME_TAC THENL + [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN + ASM_REWRITE_TAC[GSYM ABS_NZ]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `e = abs(k) * (e / abs(k))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + ASM_REWRITE_TAC[ABS_ZERO]; ALL_TAC] THEN + REWRITE_TAC[ABS_MUL] THEN + SUBGOAL_THEN `&0 < abs k` (fun th -> REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ th]) + THEN ASM_REWRITE_TAC[GSYM ABS_NZ]]);; + +(*----------------------------------------------------------------------------*) +(* Now real arithmetic theorems for convergent nets *) +(*----------------------------------------------------------------------------*) + +let NET_ADD = prove( + `!g:A->A->bool x x0 y y0. + dorder g + ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) + ==> ((\n. x(n) + y(n)) --> (x0 + y0))(mtop(mr1),g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[NET_NULL] THEN + DISCH_THEN(fun th -> FIRST_ASSUM + (MP_TAC o C MATCH_MP th o MATCH_MP NET_NULL_ADD)) + THEN MATCH_MP_TAC EQ_IMP THEN EQUAL_TAC THEN + BETA_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD] THEN + REWRITE_TAC[REAL_ADD_AC]);; + +let NET_NEG = prove( + `!g:A->A->bool x x0. + dorder g + ==> ((x --> x0)(mtop(mr1),g) <=> + ((\n. --(x n)) --> --x0)(mtop(mr1),g))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[MTOP_TENDS; MR1_DEF] THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_NEG2] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN + REFL_TAC);; + +let NET_SUB = prove( + `!g:A->A->bool x x0 y y0. + dorder g + ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) + ==> ((\n. x(n) - y(n)) --> (x0 - y0))(mtop(mr1),g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[real_sub] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `--(y(n:A))`]) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_ADD) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP NET_NEG th)]) THEN + ASM_REWRITE_TAC[]);; + +let NET_MUL = prove( + `!g:A->A->bool x y x0 y0. + dorder g + ==> (x --> x0)(mtop(mr1),g) /\ (y --> y0)(mtop(mr1),g) + ==> ((\n. x(n) * y(n)) --> (x0 * y0))(mtop(mr1),g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[NET_NULL] THEN + DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `!a b c d. (a * b) - (c * d) = (a * (b - d)) + ((a - c) * d)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REPEAT GEN_TAC THEN + REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_RDISTRIB; GSYM REAL_ADD_ASSOC] + THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `x(n:A) * (y(n) - y0)`]) THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `(x(n:A) - x0) * y0`]) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_NULL_ADD) THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + (CONV_TAC o EXACT_CONV o map (X_BETA_CONV `n:A`)) + [`y(n:A) - y0`; `x(n:A) - x0`] THEN + CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_NULL_MUL) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NET_CONV_BOUNDED THEN + EXISTS_TAC `x0:real` THEN ONCE_REWRITE_TAC[NET_NULL] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC NET_NULL_CMUL THEN ASM_REWRITE_TAC[]]);; + +let NET_INV = prove( + `!g:A->A->bool x x0. + dorder g + ==> (x --> x0)(mtop(mr1),g) /\ ~(x0 = &0) + ==> ((\n. inv(x(n))) --> inv x0)(mtop(mr1),g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + MP_TAC(CONJ (MATCH_MP NET_CONV_IBOUNDED th) + (MATCH_MP NET_CONV_NZ th))) THEN + REWRITE_TAC[MR1_BOUNDED] THEN + CONV_TAC(ONCE_DEPTH_CONV LEFT_AND_EXISTS_CONV) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN + DISCH_THEN(DORDER_THEN MP_TAC) THEN BETA_TAC THEN + DISCH_THEN(MP_TAC o C CONJ + (ASSUME `(x --> x0)(mtop mr1,(g:A->A->bool))`)) THEN + ONCE_REWRITE_TAC[NET_NULL] THEN + REWRITE_TAC[MTOP_TENDS; MR1_DEF; REAL_SUB_LZERO; ABS_NEG] THEN BETA_TAC + THEN DISCH_THEN((then_) + (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN + ONCE_REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN + DISCH_THEN(ASSUME_TAC o SPEC `e * abs(x0) * (inv k)`) THEN + SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(inv(x(N:A)))` THEN + ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < e * abs(x0) * inv k` ASSUME_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[GSYM ABS_NZ] THEN + MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(DORDER_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN ASSUME_TAC)) THEN + EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:A` THEN DISCH_THEN(ANTE_RES_THEN STRIP_ASSUME_TAC) THEN + RULE_ASSUM_TAC BETA_RULE THEN POP_ASSUM_LIST(MAP_EVERY STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `inv(x n) - inv x0 = + inv(x n) * inv x0 * (x0 - x(n:A))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x0 = &0)`)] THEN + REWRITE_TAC[REAL_MUL_RID] THEN REPEAT AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_RINV (ASSUME `~(x(n:A) = &0)`)] THEN + REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + REWRITE_TAC[ABS_MUL] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN + SUBGOAL_THEN `e = e * (abs(inv x0) * abs(x0)) * (inv k * k)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM ABS_MUL] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x0 = &0)`)] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_LINV + (GSYM(MATCH_MP REAL_LT_IMP_NE (ASSUME `&0 < k`)))] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + REWRITE_TAC[real_abs; REAL_LE; LE_LT; num_CONV `1`; LESS_SUC_REFL] THEN + REWRITE_TAC[SYM(num_CONV `1`); REAL_MUL_RID]; ALL_TAC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * (b * c) * (d * e) = e * b * (a * c * d)`] THEN + REWRITE_TAC[GSYM ABS_MUL] THEN + MATCH_MP_TAC ABS_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABS_MUL] THEN SUBGOAL_THEN `&0 < abs(inv x0)` + (fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ th]) THEN + REWRITE_TAC[GSYM ABS_NZ] THEN + MATCH_MP_TAC REAL_INV_NZ THEN ASM_REWRITE_TAC[]);; + +let NET_DIV = prove( + `!g:A->A->bool x x0 y y0. + dorder g + ==> (x --> x0)(mtop(mr1),g) /\ + (y --> y0)(mtop(mr1),g) /\ ~(y0 = &0) + ==> ((\n. x(n) / y(n)) --> (x0 / y0))(mtop(mr1),g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `n:A` `inv(y(n:A))`]) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_MUL) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_INV) THEN + ASM_REWRITE_TAC[]);; + +let NET_ABS = prove( + `!x x0. (x --> x0)(mtop(mr1),g) ==> + ((\n:A. abs(x n)) --> abs(x0))(mtop(mr1),g)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MTOP_TENDS] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(fun th -> POP_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `mdist(mr1)(x(n:A),x0)` THEN CONJ_TAC THENL + [REWRITE_TAC[MR1_DEF; ABS_SUB_ABS]; + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; + +let NET_SUM = prove + (`!g. dorder g /\ + ((\x. &0) --> &0)(mtop(mr1),g) + ==> !m n. (!r. m <= r /\ r < m + n ==> (f r --> l r)(mtop(mr1),g)) + ==> ((\x. sum(m,n) (\r. f r x)) --> sum(m,n) l) + (mtop(mr1),g)`, + GEN_TAC THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN + ASM_SIMP_TAC[sum] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP NET_ADD) THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + X_GEN_TAC `r:num` THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `a < b + c ==> a < b + SUC c`]; + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM MATCH_MP_TAC THEN + ARITH_TAC]);; + +(*----------------------------------------------------------------------------*) +(* Comparison between limits *) +(*----------------------------------------------------------------------------*) + +let NET_LE = prove( + `!g:A->A->bool x x0 y y0. + dorder g + ==> (x --> x0)(mtop(mr1),g) /\ + (y --> y0)(mtop(mr1),g) /\ + (?N. g N N /\ !n. g n N ==> x(n) <= y(n)) + ==> x0 <= y0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[MTOP_TENDS] THEN + DISCH_THEN(MP_TAC o end_itlist CONJ o + map (SPEC `(x0 - y0) / &2`) o CONJUNCTS) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(DORDER_THEN MP_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_exists o concl) THEN + DISCH_THEN(fun th1 -> DISCH_THEN (fun th2 -> MP_TAC(CONJ th1 th2))) THEN + DISCH_THEN(DORDER_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N:A` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + BETA_TAC THEN DISCH_THEN(MP_TAC o SPEC `N:A`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MR1_DEF] THEN ONCE_REWRITE_TAC[ABS_SUB] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC ABS_BETWEEN2 THEN + MAP_EVERY EXISTS_TAC [`y0:real`; `x0:real`] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + FIRST_ASSUM ACCEPT_TAC);; + +(*============================================================================*) +(* Theory of sequences and series of real numbers *) +(*============================================================================*) + +parse_as_infix ("tends_num_real",(12,"right"));; + +parse_as_infix ("sums",(12,"right"));; + +(*----------------------------------------------------------------------------*) +(* Specialize net theorems to sequences:num->real *) +(*----------------------------------------------------------------------------*) + +let tends_num_real = new_definition( + `x tends_num_real x0 <=> (x tends x0)(mtop(mr1), (>=) :num->num->bool)`);; + +override_interface ("-->",`(tends_num_real)`);; + +let SEQ = prove( + `!x x0. (x --> x0) <=> + !e. &0 < e ==> ?N. !n. n >= N ==> abs(x(n) - x0) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real; SEQ_TENDS; MR1_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN + REFL_TAC);; + +let SEQ_CONST = prove( + `!k. (\x. k) --> k`, + REPEAT GEN_TAC THEN REWRITE_TAC[SEQ; REAL_SUB_REFL; ABS_0] THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +let SEQ_ADD = prove( + `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) + y(n)) --> (x0 + y0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC NET_ADD THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_MUL = prove( + `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) * y(n)) --> (x0 * y0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC NET_MUL THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_NEG = prove( + `!x x0. x --> x0 <=> (\n. --(x n)) --> --x0`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC NET_NEG THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_INV = prove( + `!x x0. x --> x0 /\ ~(x0 = &0) ==> (\n. inv(x n)) --> inv x0`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC NET_INV THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_SUB = prove( + `!x x0 y y0. x --> x0 /\ y --> y0 ==> (\n. x(n) - y(n)) --> (x0 - y0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC NET_SUB THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_DIV = prove( + `!x x0 y y0. x --> x0 /\ y --> y0 /\ ~(y0 = &0) ==> + (\n. x(n) / y(n)) --> (x0 / y0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC NET_DIV THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_UNIQ = prove( + `!x x1 x2. x --> x1 /\ x --> x2 ==> (x1 = x2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC MTOP_TENDS_UNIQ THEN + MATCH_ACCEPT_TAC DORDER_NGE);; + +let SEQ_NULL = prove( + `!s l. s --> l <=> (\n. s(n) - l) --> &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_ACCEPT_TAC NET_NULL);; + +let SEQ_SUM = prove + (`!f l m n. + (!r. m <= r /\ r < m + n ==> f r --> l r) + ==> (\k. sum(m,n) (\r. f r k)) --> sum(m,n) l`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] NET_SUM) THEN + REWRITE_TAC[SEQ_CONST; DORDER_NGE; GSYM tends_num_real]);; + +let SEQ_TRANSFORM = prove + (`!s t l N. (!n. N <= n ==> (s n = t n)) /\ s --> l ==> t --> l`, + REWRITE_TAC[SEQ; GE] THEN + MESON_TAC[ARITH_RULE `M + N <= n:num ==> M <= n /\ N <= n`]);; + +(*----------------------------------------------------------------------------*) +(* Define convergence and Cauchy-ness *) +(*----------------------------------------------------------------------------*) + +let convergent = new_definition( + `convergent f <=> ?l. f --> l`);; + +let cauchy = new_definition( + `cauchy f <=> !e. &0 < e ==> + ?N:num. !m n. m >= N /\ n >= N ==> abs(f(m) - f(n)) < e`);; + +let lim = new_definition( + `lim f = @l. f --> l`);; + +let SEQ_LIM = prove( + `!f. convergent f <=> (f --> lim f)`, + GEN_TAC THEN REWRITE_TAC[convergent] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[lim]; + DISCH_TAC THEN EXISTS_TAC `lim f` THEN POP_ASSUM ACCEPT_TAC]);; + +(*----------------------------------------------------------------------------*) +(* Define a subsequence *) +(*----------------------------------------------------------------------------*) + +let subseq = new_definition( + `subseq (f:num->num) <=> !m n. m < n ==> (f m) < (f n)`);; + +let SUBSEQ_SUC = prove( + `!f. subseq f <=> !n. f(n) < f(SUC n)`, + GEN_TAC THEN REWRITE_TAC[subseq] THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `n:num` THEN POP_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[LESS_SUC_REFL]; + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `f(m + (SUC p)):num`] THEN + ASM_REWRITE_TAC[ADD_CLAUSES]]);; + +(*----------------------------------------------------------------------------*) +(* Define monotonicity *) +(*----------------------------------------------------------------------------*) + +let mono = new_definition( + `mono (f:num->real) <=> + (!m n. m <= n ==> f(m) <= f(n)) \/ + (!m n. m <= n ==> f(m) >= f(n))`);; + +let MONO_SUC = prove( + `!f. mono f <=> (!n. f(SUC n) >= f(n)) \/ (!n. f(SUC n) <= f(n))`, + GEN_TAC THEN REWRITE_TAC[mono; real_ge] THEN + MATCH_MP_TAC(TAUT `(a <=> c) /\ (b <=> d) ==> (a \/ b <=> c \/ d)`) THEN + CONJ_TAC THEN (EQ_TAC THENL + [DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`n:num`; `SUC n`]) THEN + REWRITE_TAC[LESS_EQ_SUC_REFL]; + DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(m + p:num):real` THEN + ASM_REWRITE_TAC[]]));; + +(*----------------------------------------------------------------------------*) +(* Simpler characterization of bounded sequence *) +(*----------------------------------------------------------------------------*) + +let MAX_LEMMA = prove( + `!s N. ?k. !n:num. n < N ==> abs(s n) < k`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_LESS_0] THEN + POP_ASSUM(X_CHOOSE_TAC `k:real`) THEN + DISJ_CASES_TAC (SPECL [`k:real`; `abs(s(N:num))`] REAL_LET_TOTAL) THENL + [EXISTS_TAC `abs(s(N:num)) + &1`; EXISTS_TAC `k:real`] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[CONJUNCT2 LT] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN + TRY(MATCH_MP_TAC REAL_LT_ADD1) THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LT_ADD1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `k:real` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_REWRITE_TAC[]);; + +let SEQ_BOUNDED = prove( + `!s. bounded(mr1, (>=)) s <=> ?k. !n:num. abs(s n) < k`, + GEN_TAC THEN REWRITE_TAC[MR1_BOUNDED] THEN + REWRITE_TAC[GE; LE_REFL] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `k:real` (X_CHOOSE_TAC `N:num`)) THEN + MP_TAC(SPECL [`s:num->real`; `N:num`] MAX_LEMMA) THEN + DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN + DISJ_CASES_TAC (SPECL [`k:real`; `l:real`] REAL_LE_TOTAL) THENL + [EXISTS_TAC `l:real`; EXISTS_TAC `k:real`] THEN + X_GEN_TAC `n:num` THEN MP_TAC(SPECL [`n:num`; `N:num`] LTE_CASES) THEN + DISCH_THEN(DISJ_CASES_THEN(ANTE_RES_THEN ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN + ASM_REWRITE_TAC[] THEN NO_TAC); + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN + MAP_EVERY EXISTS_TAC [`k:real`; `0`] THEN + GEN_TAC THEN ASM_REWRITE_TAC[]]);; + +let SEQ_BOUNDED_2 = prove( + `!f k K. (!n:num. k <= f(n) /\ f(n) <= K) ==> bounded(mr1, (>=)) f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN + EXISTS_TAC `(abs(k) + abs(K)) + &1` THEN GEN_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(k) + abs(K)` THEN + REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN + GEN_REWRITE_TAC LAND_CONV [real_abs] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(K)` THEN + REWRITE_TAC[REAL_LE_ADDL; ABS_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[ABS_LE]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(k)` THEN + REWRITE_TAC[REAL_LE_ADDR; ABS_POS] THEN + REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN + SUBGOAL_THEN `&0 <= f(n:num)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]);; + +(*----------------------------------------------------------------------------*) +(* Show that every Cauchy sequence is bounded *) +(*----------------------------------------------------------------------------*) + +let SEQ_CBOUNDED = prove( + `!f. cauchy f ==> bounded(mr1, (>=)) f`, + GEN_TAC THEN REWRITE_TAC[bounded; cauchy] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MAP_EVERY EXISTS_TAC [`&1`; `(f:num->real) N`; `N:num`] THEN + REWRITE_TAC[GE; LE_REFL] THEN + POP_ASSUM(MP_TAC o SPEC `N:num`) THEN + REWRITE_TAC[GE; LE_REFL; MR1_DEF]);; + +(*----------------------------------------------------------------------------*) +(* Show that a bounded and monotonic sequence converges *) +(*----------------------------------------------------------------------------*) + +let SEQ_ICONV = prove( + `!f. bounded(mr1, (>=)) f /\ (!m n. m >= n ==> f(m) >= f(n)) + ==> convergent f`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC (SPEC `\x:real. ?n:num. x = f(n)` REAL_SUP) THEN BETA_TAC THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`f(0):real`; `0`] THEN REFL_TAC; + POP_ASSUM(MP_TAC o REWRITE_RULE[SEQ_BOUNDED] o CONJUNCT1) THEN + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN EXISTS_TAC `k:real` THEN + GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(f(n:num))` THEN + ASM_REWRITE_TAC[ABS_LE]]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_TAC THEN + REWRITE_TAC[convergent] THEN EXISTS_TAC `sup(\x. ?n:num. x = f(n))` THEN + REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o check(is_forall o concl)) THEN + DISCH_THEN(MP_TAC o SPEC `sup(\x. ?n:num. x = f(n)) - e`) THEN + REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `n:num` SUBST1_TAC)) THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[GSYM REAL_LT_SUB_RADD] THEN + DISCH_TAC THEN SUBGOAL_THEN `!n. f(n) <= sup(\x. ?n:num. x = f(n))` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `sup(\x. ?n:num. x = f(n))`) THEN + REWRITE_TAC[REAL_LT_REFL] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN + REWRITE_TAC[REAL_NOT_LT] THEN + CONV_TAC(ONCE_DEPTH_CONV LEFT_IMP_EXISTS_CONV) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`(f:num->real) n`; `n:num`]) THEN + REWRITE_TAC[]; ALL_TAC] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_SUB_RADD]) THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_LT_SUB_RADD]) THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `(sup(\x. ?m:num. x = f(m)) - e) < f(m)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_NEG_SUB] THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub] THEN + (SUBST1_TAC o REWRITE_RULE[REAL_ADD_RINV] o C SPECL REAL_LE_RADD) + [`(f:num->real) m`; `(sup(\x. ?n:num. x = f(n)))`; + `--(sup(\x. ?n:num. x = f(n)))`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LT_SUB_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_LT_SUB_RADD] THEN ASM_REWRITE_TAC[]]);; + +let SEQ_NEG_CONV = prove( + `!f. convergent f <=> convergent (\n. --(f n))`, + GEN_TAC THEN REWRITE_TAC[convergent] THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN + EXISTS_TAC `--l` THEN POP_ASSUM MP_TAC THEN + SUBST1_TAC(SYM(SPEC `l:real` REAL_NEGNEG)) THEN + REWRITE_TAC[GSYM SEQ_NEG] THEN REWRITE_TAC[REAL_NEGNEG]);; + +let SEQ_NEG_BOUNDED = prove( + `!f. bounded(mr1, (>=))(\n:num. --(f n)) <=> bounded(mr1, (>=)) f`, + GEN_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN BETA_TAC THEN + REWRITE_TAC[ABS_NEG]);; + +let SEQ_BCONV = prove( + `!f. bounded(mr1, (>=)) f /\ mono f ==> convergent f`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[mono] THEN DISCH_THEN DISJ_CASES_TAC THENL + [MATCH_MP_TAC SEQ_ICONV THEN ASM_REWRITE_TAC[GE; real_ge]; + ONCE_REWRITE_TAC[SEQ_NEG_CONV] THEN MATCH_MP_TAC SEQ_ICONV THEN + ASM_REWRITE_TAC[SEQ_NEG_BOUNDED] THEN BETA_TAC THEN + REWRITE_TAC[GE; real_ge; REAL_LE_NEG] THEN + ONCE_REWRITE_TAC[GSYM real_ge] THEN ASM_REWRITE_TAC[]]);; + +(*----------------------------------------------------------------------------*) +(* Show that every sequence contains a monotonic subsequence *) +(*----------------------------------------------------------------------------*) + +let SEQ_MONOSUB = prove( + `!s:num->real. ?f. subseq f /\ mono(\n.s(f n))`, + GEN_TAC THEN + ASM_CASES_TAC `!n:num. ?p. p > n /\ !m. m >= p ==> s(m) <= s(p)` THENL + [(X_CHOOSE_THEN `f:num->num` MP_TAC o EXISTENCE o C ISPECL num_Axiom) + [`@p. p > 0 /\ (!m. m >= p ==> (s m) <= (s p))`; + `\x. \n:num. @p:num. p > x /\ + (!m. m >= p ==> (s m) <= (s p))`] THEN + BETA_TAC THEN RULE_ASSUM_TAC(GEN `n:num` o SELECT_RULE o SPEC `n:num`) THEN + POP_ASSUM(fun th -> DISCH_THEN(ASSUME_TAC o GSYM) THEN + MP_TAC(SPEC `0` th) THEN + MP_TAC(GEN `n:num` (SPEC `(f:num->num) n` th))) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `f:num->num` THEN ASM_REWRITE_TAC[SUBSEQ_SUC; GSYM GT] THEN + SUBGOAL_THEN `!p q. p:num >= (f q) ==> s(p) <= s(f(q:num))` MP_TAC THENL + [REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `q:num` num_CASES) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o GEN `q:num` o SPECL [`f(SUC q):num`; `q:num`]) THEN + SUBGOAL_THEN `!q. f(SUC q):num >= f(q)` (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[GE] THEN + MATCH_MP_TAC LT_IMP_LE + THEN ASM_REWRITE_TAC[GSYM GT]; ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[MONO_SUC] THEN DISJ2_TAC THEN + BETA_TAC THEN ASM_REWRITE_TAC[]; + POP_ASSUM(X_CHOOSE_TAC `N:num` o CONV_RULE NOT_FORALL_CONV) THEN + POP_ASSUM(MP_TAC o CONV_RULE NOT_EXISTS_CONV) THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN + REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN `!p. p >= SUC N ==> (?m. m > p /\ s(p) < s(m))` + MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[GE; LE_SUC_LT] THEN + REWRITE_TAC[GSYM GT] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + REWRITE_TAC[GE; LE_LT; RIGHT_AND_OVER_OR; GT] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` DISJ_CASES_TAC) THENL + [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[REAL_LT_REFL]]; ALL_TAC] THEN + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN + (X_CHOOSE_THEN `f:num->num` MP_TAC o EXISTENCE o C ISPECL num_Axiom) + [`@m. m > (SUC N) /\ s(SUC N) < s(m)`; + `\x. \n:num. @m:num. m > x /\ s(x) < s(m)`] THEN + BETA_TAC THEN DISCH_THEN ASSUME_TAC THEN SUBGOAL_THEN + `!n. f(n) >= (SUC N) /\ + f(SUC n) > f(n) /\ s(f n) < s(f(SUC n):num)` MP_TAC THENL + [INDUCT_TAC THENL + [SUBGOAL_THEN `f(0) >= (SUC N)` MP_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `SUC N`) THEN + REWRITE_TAC[GE; LE_REFL] THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN + MATCH_MP_TAC LT_IMP_LE THEN + ASM_REWRITE_TAC[GSYM GT]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN REWRITE_TAC[th]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[CONJUNCT2 th]) THEN + CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM(UNDISCH_TAC o + check((=)3 o length o conjuncts) o concl) THEN + DISCH_THEN STRIP_ASSUME_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(f:num->num) n` THEN REWRITE_TAC[GSYM GE] THEN + CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN + REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN + REWRITE_TAC[GSYM GT] THEN FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM(SUBST1_TAC o SPEC `SUC n` o CONJUNCT2) THEN + CONV_TAC SELECT_CONV THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(f:num->num) n` THEN + REWRITE_TAC[GSYM GE] THEN CONJ_TAC THEN + TRY(FIRST_ASSUM ACCEPT_TAC) THEN + REWRITE_TAC[GE] THEN MATCH_MP_TAC LT_IMP_LE THEN + REWRITE_TAC[GSYM GT] THEN + FIRST_ASSUM ACCEPT_TAC]]; ALL_TAC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN + EXISTS_TAC `f:num->num` THEN REWRITE_TAC[SUBSEQ_SUC; MONO_SUC] THEN + ASM_REWRITE_TAC[GSYM GT] THEN DISJ1_TAC THEN BETA_TAC THEN + GEN_TAC THEN REWRITE_TAC[real_ge] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);; + +(*----------------------------------------------------------------------------*) +(* Show that a subsequence of a bounded sequence is bounded *) +(*----------------------------------------------------------------------------*) + +let SEQ_SBOUNDED = prove( + `!s (f:num->num). bounded(mr1, (>=)) s ==> bounded(mr1, (>=)) (\n. s(f n))`, + REPEAT GEN_TAC THEN REWRITE_TAC[SEQ_BOUNDED] THEN + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN EXISTS_TAC `k:real` THEN + GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Show we can take subsequential terms arbitrarily far up a sequence *) +(*----------------------------------------------------------------------------*) + +let SEQ_SUBLE = prove( + `!f n. subseq f ==> n <= f(n)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[GSYM NOT_LT; NOT_LESS_0]; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC(f(n:num))` THEN + ASM_REWRITE_TAC[LE_SUC] THEN + REWRITE_TAC[LE_SUC_LT] THEN + UNDISCH_TAC `subseq f` THEN REWRITE_TAC[SUBSEQ_SUC] THEN + DISCH_THEN MATCH_ACCEPT_TAC]);; + +let SEQ_DIRECT = prove( + `!f. subseq f ==> !N1 N2. ?n. n >= N1 /\ f(n) >= N2`, + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISJ_CASES_TAC (SPECL [`N1:num`; `N2:num`] LE_CASES) THENL + [EXISTS_TAC `N2:num` THEN ASM_REWRITE_TAC[GE] THEN + MATCH_MP_TAC SEQ_SUBLE THEN + FIRST_ASSUM ACCEPT_TAC; + EXISTS_TAC `N1:num` THEN REWRITE_TAC[GE; LE_REFL] THEN + REWRITE_TAC[GE] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `N1:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SEQ_SUBLE THEN + FIRST_ASSUM ACCEPT_TAC]);; + +(*----------------------------------------------------------------------------*) +(* Now show that every Cauchy sequence converges *) +(*----------------------------------------------------------------------------*) + +let SEQ_CAUCHY = prove( + `!f. cauchy f <=> convergent f`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SEQ_CBOUNDED) THEN + MP_TAC(SPEC `f:num->real` SEQ_MONOSUB) THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `bounded(mr1, (>=) :num->num->bool)(\n. f(g(n):num))` + ASSUME_TAC THENL + [MATCH_MP_TAC SEQ_SBOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `convergent (\n. f(g(n):num))` MP_TAC THENL + [MATCH_MP_TAC SEQ_BCONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[convergent] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN + EXISTS_TAC `l:real` THEN REWRITE_TAC[SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `(\n. f(g(n):num)) --> l` THEN REWRITE_TAC[SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + UNDISCH_TAC `cauchy f` THEN REWRITE_TAC[cauchy] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SEQ_DIRECT) THEN + DISCH_THEN(MP_TAC o SPECL [`N1:num`; `N2:num`]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N2:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + UNDISCH_TAC `!n:num. n >= N1 ==> abs(f(g n:num) - l) < (e / &2)` THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPECL [`g(n:num):num`; `m:num`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + SUBGOAL_THEN `f(m:num) - l = (f(m) - f(g(n:num))) + (f(g n) - l)` + SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_TRIANGLE]; ALL_TAC] THEN + EXISTS_TAC `abs(f(m:num) - f(g(n:num))) + abs(f(g n) - l)` THEN + REWRITE_TAC[ABS_TRIANGLE] THEN + SUBST1_TAC(SYM(SPEC `e:real` REAL_HALF_DOUBLE)) THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[]; + + REWRITE_TAC[convergent] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN + REWRITE_TAC[SEQ; cauchy] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN (ANTE_RES_THEN ASSUME_TAC)) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + SUBGOAL_THEN `f(m:num) - f(n) = (f(m) - l) + (l - f(n))` + SUBST1_TAC THENL [REWRITE_TAC[REAL_SUB_TRIANGLE]; ALL_TAC] THEN + EXISTS_TAC `abs(f(m:num) - l) + abs(l - f(n))` THEN + REWRITE_TAC[ABS_TRIANGLE] THEN + SUBST1_TAC(SYM(SPEC `e:real` REAL_HALF_DOUBLE)) THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[]]);; + +(*----------------------------------------------------------------------------*) +(* The limit comparison property for sequences *) +(*----------------------------------------------------------------------------*) + +let SEQ_LE = prove( + `!f g l m. f --> l /\ g --> m /\ (?N. !n. n >= N ==> f(n) <= g(n)) + ==> l <= m`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `(>=) :num->num->bool` NET_LE) THEN + REWRITE_TAC[DORDER_NGE; tends_num_real; GE; LE_REFL] THEN + DISCH_THEN MATCH_ACCEPT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* When a sequence tends to zero. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_LE_0 = prove + (`!f g. f --> &0 /\ (?N. !n. n >= N ==> abs(g n) <= abs(f n)) + ==> g --> &0`, + REWRITE_TAC[SEQ; REAL_SUB_RZERO; GE] THEN + MESON_TAC[LE_CASES; LE_TRANS; REAL_LET_TRANS]);; + +(*----------------------------------------------------------------------------*) +(* We can displace a convergent series by 1 *) +(*----------------------------------------------------------------------------*) + +let SEQ_SUC = prove( + `!f l. f --> l <=> (\n. f(SUC n)) --> l`, + REPEAT GEN_TAC THEN REWRITE_TAC[SEQ; GE] THEN EQ_TAC THEN + DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN + DISCH_THEN(MP_TAC o MATCH_MP th)) THEN BETA_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL + [EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `SUC N` THEN ASM_REWRITE_TAC[LE_SUC; LESS_EQ_SUC_REFL]; + EXISTS_TAC `SUC N` THEN X_GEN_TAC `n:num` THEN + STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THENL + [REWRITE_TAC[GSYM NOT_LT; LT_0]; + REWRITE_TAC[LE_SUC] THEN DISCH_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; + +(*----------------------------------------------------------------------------*) +(* Prove a sequence tends to zero iff its abs does *) +(*----------------------------------------------------------------------------*) + +let SEQ_ABS = prove( + `!f. (\n. abs(f n)) --> &0 <=> f --> &0`, + GEN_TAC THEN REWRITE_TAC[SEQ] THEN + BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO; ABS_ABS]);; + +(*----------------------------------------------------------------------------*) +(* Half this is true for a general limit *) +(*----------------------------------------------------------------------------*) + +let SEQ_ABS_IMP = prove( + `!f l. f --> l ==> (\n. abs(f n)) --> abs(l)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_num_real] THEN + MATCH_ACCEPT_TAC NET_ABS);; + +(*----------------------------------------------------------------------------*) +(* Prove that an unbounded sequence's inverse tends to 0 *) +(*----------------------------------------------------------------------------*) + +let SEQ_INV0 = prove( + `!f. (!y. ?N. !n. n >= N ==> f(n) > y) + ==> (\n. inv(f n)) --> &0`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ; REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `N:num` o SPEC `inv e`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN ANTE_RES_THEN MP_TAC th) THEN + REWRITE_TAC[real_gt] THEN BETA_TAC THEN + IMP_RES_THEN ASSUME_TAC REAL_INV_POS THEN + SUBGOAL_THEN `&0 < f(n:num)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv e` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM real_gt] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < inv(f(n:num))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(f(n:num) = &0)` ASSUME_TAC THENL + [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN + SUBGOAL_THEN `e = inv(inv e)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN + ASM_REWRITE_TAC[ABS_LE]);; + +(*----------------------------------------------------------------------------*) +(* Important limit of c^n for |c| < 1 *) +(*----------------------------------------------------------------------------*) + +let SEQ_POWER_ABS = prove( + `!c. abs(c) < &1 ==> (\n. abs(c) pow n) --> &0`, + GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `c:real` ABS_POS) THEN + REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN DISJ_CASES_TAC THENL + [SUBGOAL_THEN `!n. abs(c) pow n = inv(inv(abs(c) pow n))` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN + MATCH_MP_TAC POW_NZ THEN + ASM_REWRITE_TAC[ABS_NZ; ABS_ABS]; ALL_TAC] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `n:num` `inv(abs(c) pow n)`]) THEN + MATCH_MP_TAC SEQ_INV0 THEN BETA_TAC THEN X_GEN_TAC `y:real` THEN + SUBGOAL_THEN `~(abs(c) = &0)` + (fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THENL + [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN REWRITE_TAC[real_gt] THEN + SUBGOAL_THEN `&0 < inv(abs c) - &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_SUB_LADD] THEN REWRITE_TAC[REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV1] THEN MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPEC `inv(abs c) - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num` o SPEC `y:real`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN + DISCH_TAC THEN SUBGOAL_THEN `y < (&n * (inv(abs c) - &1))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&N * (inv(abs c) - &1)` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP REAL_LE_RMUL_EQ th]) THEN + ASM_REWRITE_TAC[REAL_LE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `&n * (inv(abs c) - &1)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 + (&n * (inv(abs c) - &1))` THEN + REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 + (inv(abs c) - &1)) pow n` THEN CONJ_TAC THENL + [MATCH_MP_TAC POW_PLUS1 THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN + REWRITE_TAC[REAL_LE_REFL]]; + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SEQ] THEN + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN BETA_TAC THEN + STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THENL + [REWRITE_TAC[GSYM NOT_LT; num_CONV `1`; LT_0]; + REWRITE_TAC[POW_0; REAL_SUB_RZERO; ABS_0] THEN + REWRITE_TAC[ASSUME `&0 < e`]]]);; + +(*----------------------------------------------------------------------------*) +(* Similar version without the abs *) +(*----------------------------------------------------------------------------*) + +let SEQ_POWER = prove( + `!c. abs(c) < &1 ==> (\n. c pow n) --> &0`, + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM SEQ_ABS] THEN BETA_TAC THEN + REWRITE_TAC[GSYM POW_ABS] THEN + POP_ASSUM(ACCEPT_TAC o MATCH_MP SEQ_POWER_ABS));; + +(* ------------------------------------------------------------------------- *) +(* Convergence to 0 of harmonic sequence (not series of course). *) +(* ------------------------------------------------------------------------- *) + +let SEQ_HARMONIC = prove + (`!a. (\n. a / &n) --> &0`, + GEN_TAC THEN REWRITE_TAC[SEQ] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `abs a` o MATCH_MP REAL_ARCH) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `&0 < &n` (fun th -> SIMP_TAC[REAL_LT_LDIV_EQ; th]) THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `N + 1 <= n` THEN ARITH_TAC; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&N * e`] THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `N + 1 <= n` THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Other basic lemmas about sequences. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_SUBSEQ = prove + (`!f l. f --> l ==> !a b. ~(a = 0) ==> (\n. f(a * n + b)) --> l`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM; SEQ; GE] THEN REPEAT GEN_TAC THEN + SUBGOAL_THEN `!a b n. ~(a = 0) ==> n <= a * n + b` + (fun th -> MESON_TAC[th; LE_TRANS]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ARITH_RULE + `1 * n <= a * n ==> n <= a * n + b`) THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let SEQ_POW = prove + (`!f l. (f --> l) ==> !n. (\i. f(i) pow n) --> l pow n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[real_pow; SEQ_CONST] THEN MATCH_MP_TAC SEQ_MUL THEN + ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Useful lemmas about nested intervals and proof by bisection *) +(*----------------------------------------------------------------------------*) + +let NEST_LEMMA = prove( + `!f g. (!n. f(SUC n) >= f(n)) /\ + (!n. g(SUC n) <= g(n)) /\ + (!n. f(n) <= g(n)) ==> + ?l m. l <= m /\ ((!n. f(n) <= l) /\ f --> l) /\ + ((!n. m <= g(n)) /\ g --> m)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `f:num->real` MONO_SUC) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(SPEC `g:num->real` MONO_SUC) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN SUBGOAL_THEN `bounded((mr1), (>=) :num->num->bool) f` + ASSUME_TAC THENL + [MATCH_MP_TAC SEQ_BOUNDED_2 THEN + MAP_EVERY EXISTS_TAC [`(f:num->real) 0`; `(g:num->real) 0`] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) n` THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(SUC n):real` THEN + ASM_REWRITE_TAC[] THEN SPEC_TAC(`SUC n`,`m:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(m:num):real` THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `bounded((mr1), (>=) :num->num->bool) g` ASSUME_TAC THENL + [MATCH_MP_TAC SEQ_BOUNDED_2 THEN + MAP_EVERY EXISTS_TAC [`(f:num->real) 0`; `(g:num->real) 0`] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) (SUC n)` THEN + ASM_REWRITE_TAC[] THEN SPEC_TAC(`SUC n`,`m:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) m` THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(g:num->real) n` THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MP_TAC(SPEC `f:num->real` SEQ_BCONV) THEN ASM_REWRITE_TAC[SEQ_LIM] THEN + DISCH_TAC THEN MP_TAC(SPEC `g:num->real` SEQ_BCONV) THEN + ASM_REWRITE_TAC[SEQ_LIM] THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`lim f`; `lim g`] THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SEQ_LE THEN + MAP_EVERY EXISTS_TAC [`f:num->real`; `g:num->real`] THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + UNDISCH_TAC `f --> lim f` THEN REWRITE_TAC[SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `f(m) - lim f`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `p + m:num`) THEN + REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[real_abs] THEN + SUBGOAL_THEN `!p. lim f <= f(p + m:num)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(p + m:num):real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[REAL_SUB_LE] THEN + REWRITE_TAC[REAL_NOT_LT; real_sub; REAL_LE_RADD] THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[REAL_LE_REFL; ADD_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(p + m:num):real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_ge]) THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `m:num` THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + UNDISCH_TAC `g --> lim g` THEN REWRITE_TAC[SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `lim g - g(m)`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `p + m:num`) THEN + REWRITE_TAC[GE; LE_ADD] THEN REWRITE_TAC[real_abs] THEN + SUBGOAL_THEN `!p. g(p + m:num) < lim g` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `g(p + m:num):real` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_SUB_LE] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_NEG_SUB] THEN + REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG] THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[REAL_LE_REFL; ADD_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `g(p + m:num):real` THEN + ASM_REWRITE_TAC[]]]);; + +let NEST_LEMMA_UNIQ = prove( + `!f g. (!n. f(SUC n) >= f(n)) /\ + (!n. g(SUC n) <= g(n)) /\ + (!n. f(n) <= g(n)) /\ + (\n. f(n) - g(n)) --> &0 ==> + ?l. ((!n. f(n) <= l) /\ f --> l) /\ + ((!n. l <= g(n)) /\ g --> l)`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP NEST_LEMMA) THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `l:real = m` (fun th -> ASM_REWRITE_TAC[th]) THEN + MP_TAC(SPECL [`f:num->real`; `l:real`; `g:num->real`; `m:real`] SEQ_SUB) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJ(ASSUME `(\n. f(n) - g(n)) --> &0`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_UNIQ) THEN + CONV_TAC(LAND_CONV SYM_CONV) THEN + REWRITE_TAC[REAL_SUB_0]);; + +let BOLZANO_LEMMA = prove( + `!P. (!a b c. a <= b /\ b <= c /\ P(a,b) /\ P(b,c) ==> P(a,c)) /\ + (!x. ?d. &0 < d /\ !a b. a <= x /\ x <= b /\ (b - a) < d ==> P(a,b)) + ==> !a b. a <= b ==> P(a,b)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN DISCH_TAC THEN + (X_CHOOSE_THEN `f:num->real#real` STRIP_ASSUME_TAC o + EXISTENCE o BETA_RULE o C ISPECL num_Axiom) + [`(a:real,(b:real))`; + `\fn (n:num). if P(FST fn,(FST fn + SND fn)/ &2) then + ((FST fn + SND fn)/ &2,SND fn) else + (FST fn,(FST fn + SND fn)/ &2)`] THEN + MP_TAC(SPECL + [`\n:num. FST(f(n) :real#real)`; `\n:num. SND(f(n) :real#real)`] + NEST_LEMMA_UNIQ) THEN BETA_TAC THEN + SUBGOAL_THEN `!n:num. FST(f n) <= SND(f n)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THENL + [MATCH_MP_TAC REAL_MIDDLE2; MATCH_MP_TAC REAL_MIDDLE1] THEN + FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN REWRITE_TAC[real_ge] THEN + SUBGOAL_THEN `!n. FST(f n :real#real) <= FST(f(SUC n))` + ASSUME_TAC THENL + [REWRITE_TAC[real_ge] THEN INDUCT_TAC THEN + FIRST_ASSUM + (fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [th]) THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_MIDDLE1 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!n. ~P(FST((f:num->real#real) n),SND(f n))` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN UNDISCH_TAC `~P(FST((f:num->real#real) n),SND(f n))` THEN + PURE_REWRITE_TAC[IMP_CLAUSES; NOT_CLAUSES] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(FST(f(n:num)) + SND(f(n))) / &2` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MIDDLE1; MATCH_MP_TAC REAL_MIDDLE2] THEN + FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!n. SND(f(SUC n) :real#real) <= SND(f n)` ASSUME_TAC THENL + [BETA_TAC THEN INDUCT_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV) [th]) THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_MIDDLE2 THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!n. SND(f n) - FST(f n) = (b - a) / (&2 pow n)` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [ASM_REWRITE_TAC[pow; real_div; REAL_INV1; REAL_MUL_RID]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC `&2` THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + (SUBGOAL_THEN `~(&2 = &0)` (fun th -> REWRITE_TAC[th] THEN + REWRITE_TAC[MATCH_MP REAL_DIV_LMUL th]) THENL + [REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]; ALL_TAC]) THEN + REWRITE_TAC[GSYM REAL_DOUBLE] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_ADD_SYM] THEN + (SUBGOAL_THEN `!x y z. (x + y) - (x + z) = y - z` + (fun th -> REWRITE_TAC[th]) + THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; REAL_NEG_ADD] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_RID] THEN + SUBST1_TAC(SYM(SPEC `x:real` REAL_ADD_LINV)) THEN + REWRITE_TAC[REAL_ADD_AC]; ALL_TAC]) THEN + ASM_REWRITE_TAC[REAL_DOUBLE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + AP_TERM_TAC THEN REWRITE_TAC[pow] THEN + (SUBGOAL_THEN `~(&2 = &0) /\ ~(&2 pow n = &0)` + (fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THENL + [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC POW_NZ] THEN + REWRITE_TAC[REAL_INJ] THEN + REWRITE_TAC[num_CONV `2`; NOT_SUC]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [GSYM REAL_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_MUL_RINV THEN REWRITE_TAC[REAL_INJ] THEN + REWRITE_TAC[num_CONV `2`; NOT_SUC]]); + ALL_TAC] THEN + FIRST_ASSUM(UNDISCH_TAC o check (can (find_term is_cond)) o concl) THEN + DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN + W(C SUBGOAL_THEN + (fun t -> REWRITE_TAC[t]) o fst o dest_imp o rand o snd) THENL + [ONCE_REWRITE_TAC[SEQ_NEG] THEN BETA_TAC THEN + ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_NEG_0] THEN + REWRITE_TAC[real_div] THEN SUBGOAL_THEN `~(&2 = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_INJ; num_CONV `2`; NOT_SUC]; ALL_TAC] THEN + (MP_TAC o C SPECL SEQ_MUL) + [`\n:num. b - a`; `b - a`; `\n. (inv (&2 pow n))`; `&0`] THEN + REWRITE_TAC[SEQ_CONST; REAL_MUL_RZERO] THEN BETA_TAC THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THEN + ONCE_REWRITE_TAC[GSYM SEQ_ABS] THEN BETA_TAC THEN + REWRITE_TAC[GSYM POW_ABS] THEN MATCH_MP_TAC SEQ_POWER_ABS THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN + REWRITE_TAC[ABS_N] THEN SUBGOAL_THEN `&0 < &2` + (fun th -> ONCE_REWRITE_TAC [GSYM (MATCH_MP REAL_LT_RMUL_EQ th)]) THENL + [REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[REAL_LT] THEN + REWRITE_TAC[num_CONV `2`; LESS_SUC_REFL]; + DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o SPEC `l:real`) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + UNDISCH_TAC `(\n:num. SND(f n :real#real)) --> l` THEN + UNDISCH_TAC `(\n:num. FST(f n :real#real)) --> l` THEN + REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (ASSUME_TAC o BETA_RULE)) THEN + DISCH_THEN(MP_TAC o SPEC `d / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (ASSUME_TAC o BETA_RULE)) THEN + DISCH_THEN(MP_TAC o + SPECL [`FST((f:num->real#real) (N1 + N2))`; + `SND((f:num->real#real) (N1 + N2))`]) THEN + UNDISCH_TAC `!n. (SND(f n)) - (FST(f n)) = (b - a) / ((& 2) pow n)` THEN + DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(FST(f(N1 + N2:num)) - l) + + abs(SND(f(N1 + N2:num)) - l)` THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [ABS_SUB] THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[AC REAL_ADD_AC `a + b + c + d = (d + a) + (c + b)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID; REAL_LE_REFL]; + MATCH_MP_TAC REAL_LT_ADD2 THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[GE; LE_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]]]);; + +(* ------------------------------------------------------------------------- *) +(* This one is better for higher-order matching. *) +(* ------------------------------------------------------------------------- *) + +let BOLZANO_LEMMA_ALT = prove + (`!P. (!a b c. a <= b /\ b <= c /\ P a b /\ P b c ==> P a c) /\ + (!x. ?d. &0 < d /\ (!a b. a <= x /\ x <= b /\ b - a < d ==> P a b)) + ==> !a b. a <= b ==> P a b`, + GEN_TAC THEN MP_TAC(SPEC `\(x:real,y:real). P x y :bool` BOLZANO_LEMMA) THEN + REWRITE_TAC[] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Define infinite sums *) +(*----------------------------------------------------------------------------*) + +let sums = new_definition + `f sums s <=> (\n. sum(0,n) f) --> s`;; + +let summable = new_definition( + `summable f <=> ?s. f sums s`);; + +let suminf = new_definition( + `suminf f = @s. f sums s`);; + +(*----------------------------------------------------------------------------*) +(* If summable then it sums to the sum (!) *) +(*----------------------------------------------------------------------------*) + +let SUM_SUMMABLE = prove( + `!f l. f sums l ==> summable f`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[summable] THEN + EXISTS_TAC `l:real` THEN POP_ASSUM ACCEPT_TAC);; + +let SUMMABLE_SUM = prove( + `!f. summable f ==> f sums (suminf f)`, + GEN_TAC THEN REWRITE_TAC[summable; suminf] THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + MATCH_ACCEPT_TAC SELECT_AX);; + +(*----------------------------------------------------------------------------*) +(* And the sum is unique *) +(*----------------------------------------------------------------------------*) + +let SUM_UNIQ = prove( + `!f x. f sums x ==> (x = suminf f)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `summable f` MP_TAC THENL + [REWRITE_TAC[summable] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; + DISCH_THEN(ASSUME_TAC o MATCH_MP SUMMABLE_SUM) THEN + MATCH_MP_TAC SEQ_UNIQ THEN + EXISTS_TAC `\n. sum(0,n) f` THEN ASM_REWRITE_TAC[GSYM sums]]);; + +let SER_UNIQ = prove + (`!f x y. f sums x /\ f sums y ==> (x = y)`, + MESON_TAC[SUM_UNIQ]);; + +(*----------------------------------------------------------------------------*) +(* Series which is zero beyond a certain point *) +(*----------------------------------------------------------------------------*) + +let SER_0 = prove( + `!f n. (!m. n <= m ==> (f(m) = &0)) ==> + f sums (sum(0,n) f)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[sums; SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN + W(C SUBGOAL_THEN SUBST1_TAC o C (curry mk_eq) `&0` o rand o rator o snd) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN + BETA_TAC THEN REWRITE_TAC[GSYM SUM_TWO; REAL_ADD_RID_UNIQ] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[GE] SUM_ZERO)) THEN + MATCH_ACCEPT_TAC LE_REFL);; + +(*----------------------------------------------------------------------------*) +(* summable series of positive terms has limit >(=) any partial sum *) +(*----------------------------------------------------------------------------*) + +let SER_POS_LE = prove( + `!f n. summable f /\ (!m. n <= m ==> &0 <= f(m)) + ==> sum(0,n) f <= suminf f`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN REWRITE_TAC[sums] THEN + MP_TAC(SPEC `sum(0,n) f` SEQ_CONST) THEN + GEN_REWRITE_TAC I [IMP_IMP] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] + SEQ_LE) THEN BETA_TAC THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) THEN + REWRITE_TAC[GSYM SUM_TWO; REAL_LE_ADDR] THEN + MATCH_MP_TAC SUM_POS_GEN THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; + +let SER_POS_LT = prove( + `!f n. summable f /\ (!m. n <= m ==> &0 < f(m)) + ==> sum(0,n) f < suminf f`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `sum(0,n + 1) f` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_TWO; REAL_LT_ADDR] THEN + REWRITE_TAC[num_CONV `1`; sum; REAL_ADD_LID; ADD_CLAUSES] THEN + FIRST_ASSUM MATCH_MP_TAC THEN MATCH_ACCEPT_TAC LE_REFL; + MATCH_MP_TAC SER_POS_LE THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC n` THEN + REWRITE_TAC[LESS_EQ_SUC_REFL] THEN ASM_REWRITE_TAC[ADD1]]);; + +(*----------------------------------------------------------------------------*) +(* Theorems about grouping and offsetting, *not* permuting, terms *) +(*----------------------------------------------------------------------------*) + +let SER_GROUP = prove( + `!f k. summable f /\ 0 < k ==> + (\n. sum(n * k,k) f) sums (suminf f)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + REWRITE_TAC[sums; SEQ] THEN BETA_TAC THEN + DISCH_THEN(fun t -> X_GEN_TAC `e:real` THEN + DISCH_THEN(MP_TAC o MATCH_MP t)) THEN + REWRITE_TAC[GE] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + REWRITE_TAC[SUM_GROUP] THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `0 < k` THEN + STRUCT_CASES_TAC(SPEC `k:num` num_CASES) THEN + REWRITE_TAC[MULT_CLAUSES; LE_ADD; CONJUNCT1 LE] THEN + REWRITE_TAC[LT_REFL]);; + +let SER_PAIR = prove( + `!f. summable f ==> (\n. sum(2 * n,2) f) sums (suminf f)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o C CONJ (SPEC `1:num` LT_0)) THEN + REWRITE_TAC[SYM(num_CONV `2`)] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + MATCH_ACCEPT_TAC SER_GROUP);; + +let SER_OFFSET = prove( + `!f. summable f ==> !k. (\n. f(n + k)) sums (suminf f - sum(0,k) f)`, + GEN_TAC THEN + DISCH_THEN((then_) GEN_TAC o MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + REWRITE_TAC[sums; SEQ] THEN + DISCH_THEN(fun th -> GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP th)) THEN + BETA_TAC THEN REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[SUM_OFFSET] THEN + REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (b + d) + (a + c)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN REWRITE_TAC[GSYM real_sub] THEN + FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LE_ADD]);; + +let SER_OFFSET_REV = prove + (`!f k. summable(\n. f(n + k)) ==> + f sums (sum(0,k) f) + suminf (\n. f(n + k))`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + REWRITE_TAC[sums; SEQ] THEN REWRITE_TAC[SUM_OFFSET] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN + DISCH_TAC THEN REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[ADD_SYM] SUM_DIFF)] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N + k:num` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + ONCE_REWRITE_TAC[ARITH_RULE `(N + k) + d = k + N + d:num`] THEN + REWRITE_TAC[REAL_ARITH `a - (b + c) = a - b - c`] THEN + REWRITE_TAC[GSYM SUM_DIFF] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ARITH_TAC);; + +(*----------------------------------------------------------------------------*) +(* Similar version for pairing up terms *) +(*----------------------------------------------------------------------------*) + +let SER_POS_LT_PAIR = prove( + `!f n. summable f /\ + (!d. &0 < (f(n + (2 * d))) + + f(n + ((2 * d) + 1))) + ==> sum(0,n) f < suminf f`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + REWRITE_TAC[sums; SEQ] THEN BETA_TAC THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `f(n) + f(n + 1)`) THEN + FIRST_ASSUM(MP_TAC o SPEC `0`) THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + SUBGOAL_THEN `sum(0,n + 2) f <= sum(0,(2 * (SUC N)) + n) f` + ASSUME_TAC THENL + [SPEC_TAC(`N:num`,`N:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN + MATCH_ACCEPT_TAC REAL_LE_REFL; + ABBREV_TAC `M = SUC N` THEN + REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[num_CONV `2`; ADD_CLAUSES] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[ADD_SYM] ADD1)] THEN + REWRITE_TAC[SYM(num_CONV `2`)] THEN REWRITE_TAC[ADD_CLAUSES] THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [ADD1] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + REWRITE_TAC[GSYM ADD1; SYM(num_CONV `2`)] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,(2 * M) + n) f` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[sum] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_LE_ADDR] THEN + REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[ADD1] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + ONCE_REWRITE_TAC[SPEC `1` ADD_SYM] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o SPEC `(2 * (SUC N)) + n`) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o + funpow 2(fst o dest_imp) o snd) THENL + [REWRITE_TAC[num_CONV `2`; MULT_CLAUSES] THEN + ONCE_REWRITE_TAC[AC ADD_AC + `(a + (b + c)) + d:num = b + (a + (c + d))`] THEN + REWRITE_TAC[GE; LE_ADD]; ALL_TAC] THEN + SUBGOAL_THEN `(suminf f + (f(n) + f(n + 1))) <= + sum(0,(2 * (SUC N)) + n) f` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,n + 2) f` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,n) f + (f(n) + f(n + 1))` THEN + ASM_REWRITE_TAC[REAL_LE_RADD] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + CONV_TAC(REDEPTH_CONV num_CONV) THEN + REWRITE_TAC[ADD_CLAUSES; sum; REAL_ADD_ASSOC]; ALL_TAC] THEN + SUBGOAL_THEN `suminf f <= sum(0,(2 * (SUC N)) + n) f` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `suminf f + (f(n) + f(n + 1))` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_LE_ADDR] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + REWRITE_TAC[REAL_LT_SUB_RADD] THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [REAL_ADD_SYM] THEN + ASM_REWRITE_TAC[REAL_NOT_LT]]);; + +(*----------------------------------------------------------------------------*) +(* Prove a few composition formulas for series *) +(*----------------------------------------------------------------------------*) + +let SER_ADD = prove( + `!x x0 y y0. x sums x0 /\ y sums y0 ==> (\n. x(n) + y(n)) sums (x0 + y0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums; SUM_ADD] THEN + CONV_TAC((RAND_CONV o EXACT_CONV)[X_BETA_CONV `n:num` `sum(0,n) x`]) THEN + CONV_TAC((RAND_CONV o EXACT_CONV)[X_BETA_CONV `n:num` `sum(0,n) y`]) THEN + MATCH_ACCEPT_TAC SEQ_ADD);; + +let SER_CMUL = prove( + `!x x0 c. x sums x0 ==> (\n. c * x(n)) sums (c * x0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums; SUM_CMUL] THEN DISCH_TAC THEN + SUBGOAL_THEN `(\n. (\n. c) n * (\n. sum(0,n) x) n) --> c * x0` MP_TAC THENL + [MATCH_MP_TAC SEQ_MUL THEN ASM_REWRITE_TAC[SEQ_CONST]; + REWRITE_TAC[BETA_THM]]);; + +let SER_NEG = prove( + `!x x0. x sums x0 ==> (\n. --(x n)) sums --x0`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN + MATCH_ACCEPT_TAC SER_CMUL);; + +let SER_SUB = prove( + `!x x0 y y0. x sums x0 /\ y sums y0 ==> (\n. x(n) - y(n)) sums (x0 - y0)`, + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC (MATCH_MP SER_ADD + (CONJ (CONJUNCT1 th) (MATCH_MP SER_NEG (CONJUNCT2 th))))) THEN + BETA_TAC THEN REWRITE_TAC[real_sub]);; + +let SER_CDIV = prove( + `!x x0 c. x sums x0 ==> (\n. x(n) / c) sums (x0 / c)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC SER_CMUL);; + +(*----------------------------------------------------------------------------*) +(* Prove Cauchy-type criterion for convergence of series *) +(*----------------------------------------------------------------------------*) + +let SER_CAUCHY = prove( + `!f. summable f <=> + !e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(m,n) f) < e`, + GEN_TAC THEN REWRITE_TAC[summable; sums] THEN + REWRITE_TAC[GSYM convergent] THEN + REWRITE_TAC[GSYM SEQ_CAUCHY] THEN REWRITE_TAC[cauchy] THEN + AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[GE] THEN BETA_TAC THEN + REWRITE_TAC[TAUT `((a ==> b) <=> (a ==> c)) <=> a ==> (b <=> c)`] THEN + DISCH_TAC THEN EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN DISCH_TAC THENL + [ONCE_REWRITE_TAC[SUM_DIFF] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN + ASM_REWRITE_TAC[LE_ADD]; + DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC o + MATCH_MP LESS_EQUAL_ADD) THENL + [ONCE_REWRITE_TAC[ABS_SUB]; ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_DIFF] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + +(*----------------------------------------------------------------------------*) +(* Show that if a series converges, the terms tend to 0 *) +(*----------------------------------------------------------------------------*) + +let SER_ZERO = prove( + `!f. summable f ==> f --> &0`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `summable f` THEN REWRITE_TAC[SER_CAUCHY] THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + DISCH_THEN((then_) (EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN + DISCH_TAC) o MP_TAC) THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `SUC 0`]) THEN + ASM_REWRITE_TAC[sum; REAL_SUB_RZERO; REAL_ADD_LID; ADD_CLAUSES]);; + +(*----------------------------------------------------------------------------*) +(* Now prove the comparison test *) +(*----------------------------------------------------------------------------*) + +let SER_COMPAR = prove( + `!f g. (?N. !n. n >= N ==> abs(f(n)) <= g(n)) /\ summable g ==> + summable f`, + REPEAT GEN_TAC THEN REWRITE_TAC[SER_CAUCHY; GE] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) MP_TAC) THEN + REWRITE_TAC[SER_CAUCHY; GE] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(m,n)(\k. abs(f k))` THEN REWRITE_TAC[ABS_SUM] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(m,n) g` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN BETA_TAC THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m:num` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `N1 + N2:num` THEN ASM_REWRITE_TAC[LE_ADD]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(sum(m,n) g)` THEN + REWRITE_TAC[ABS_LE] THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2:num` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[LE_ADD]);; + +(*----------------------------------------------------------------------------*) +(* And a similar version for absolute convergence *) +(*----------------------------------------------------------------------------*) + +let SER_COMPARA = prove( + `!f g. (?N. !n. n >= N ==> abs(f(n)) <= g(n)) /\ summable g ==> + summable (\k. abs(f k))`, + REPEAT GEN_TAC THEN SUBGOAL_THEN `!n. abs(f(n)) = abs((\k:num. abs(f k)) n)` + (fun th -> GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[ABS_ABS]; + MATCH_ACCEPT_TAC SER_COMPAR]);; + +(*----------------------------------------------------------------------------*) +(* Limit comparison property for series *) +(*----------------------------------------------------------------------------*) + +let SER_LE = prove( + `!f g. (!n. f(n) <= g(n)) /\ summable f /\ summable g + ==> suminf f <= suminf g`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN (fun th -> ASSUME_TAC th THEN ASSUME_TAC + (REWRITE_RULE[sums] (MATCH_MP SUMMABLE_SUM th)))) THEN + MATCH_MP_TAC SEQ_LE THEN REWRITE_TAC[CONJ_ASSOC] THEN + MAP_EVERY EXISTS_TAC [`\n. sum(0,n) f`; `\n. sum(0,n) g`] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM sums] THEN CONJ_TAC THEN + MATCH_MP_TAC SUMMABLE_SUM THEN FIRST_ASSUM ACCEPT_TAC; + EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0] THEN + GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC SUM_LE THEN + GEN_TAC THEN ASM_REWRITE_TAC[LE_0]]);; + +let SER_LE2 = prove( + `!f g. (!n. abs(f n) <= g(n)) /\ summable g ==> + summable f /\ suminf f <= suminf g`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `summable f` ASSUME_TAC THENL + [MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `g:num->real` THEN + ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(f(n:num))` THEN ASM_REWRITE_TAC[ABS_LE]);; + +(*----------------------------------------------------------------------------*) +(* Show that absolute convergence implies normal convergence *) +(*----------------------------------------------------------------------------*) + +let SER_ACONV = prove( + `!f. summable (\n. abs(f n)) ==> summable f`, + GEN_TAC THEN REWRITE_TAC[SER_CAUCHY] THEN REWRITE_TAC[SUM_ABS] THEN + DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN + DISCH_THEN(IMP_RES_THEN (X_CHOOSE_TAC `N:num`)) THEN + EXISTS_TAC `N:num` THEN REPEAT GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(m,n)(\m. abs(f m))` THEN ASM_REWRITE_TAC[ABS_SUM]);; + +(*----------------------------------------------------------------------------*) +(* Absolute value of series *) +(*----------------------------------------------------------------------------*) + +let SER_ABS = prove( + `!f. summable(\n. abs(f n)) ==> abs(suminf f) <= suminf(\n. abs(f n))`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SER_ACONV) THEN + POP_ASSUM(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + REWRITE_TAC[sums] THEN DISCH_TAC THEN + DISCH_THEN(ASSUME_TAC o BETA_RULE o MATCH_MP SEQ_ABS_IMP) THEN + MATCH_MP_TAC SEQ_LE THEN MAP_EVERY EXISTS_TAC + [`\n. abs(sum(0,n)f)`; `\n. sum(0,n)(\n. abs(f n))`] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN MATCH_ACCEPT_TAC SUM_ABS_LE);; + +(*----------------------------------------------------------------------------*) +(* Prove sum of geometric progression (useful for comparison) *) +(*----------------------------------------------------------------------------*) + +let GP_FINITE = prove( + `!x. ~(x = &1) ==> + !n. (sum(0,n) (\n. x pow n) = ((x pow n) - &1) / (x - &1))`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[sum; pow; REAL_SUB_REFL; REAL_DIV_LZERO]; + REWRITE_TAC[sum; pow] THEN BETA_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + SUBGOAL_THEN `~(x - &1 = &0)` ASSUME_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_0] THEN + MP_TAC(GENL [`p:real`; `q:real`] + (SPECL [`p:real`; `q:real`; `x - &1`] REAL_EQ_RMUL)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[REAL_RDISTRIB] THEN SUBGOAL_THEN + `!p. (p / (x - &1)) * (x - &1) = p` (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] + THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (c + b) + (d + a)`] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LINV; REAL_ADD_RID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);; + +let GP = prove( + `!x. abs(x) < &1 ==> (\n. x pow n) sums inv(&1 - x)`, + GEN_TAC THEN ASM_CASES_TAC `x = &1` THEN + ASM_REWRITE_TAC[ABS_1; REAL_LT_REFL] THEN DISCH_TAC THEN + REWRITE_TAC[sums] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP GP_FINITE th]) THEN + REWRITE_TAC[REAL_INV_1OVER] THEN REWRITE_TAC[real_div] THEN + GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_NEG_MUL2] THEN + SUBGOAL_THEN `~(x - &1 = &0)` + (fun t -> REWRITE_TAC[MATCH_MP REAL_NEG_INV t]) THENL + [ASM_REWRITE_TAC[REAL_SUB_0]; ALL_TAC] THEN + REWRITE_TAC[REAL_NEG_SUB; GSYM real_div] THEN + SUBGOAL_THEN `(\n. (\n. &1 - x pow n) n / (\n. &1 - x) n) --> &1 / (&1 - x)` + MP_TAC THENL [ALL_TAC; REWRITE_TAC[BETA_THM]] THEN + MATCH_MP_TAC SEQ_DIV THEN BETA_TAC THEN REWRITE_TAC[SEQ_CONST] THEN + REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_RZERO] THEN + SUBGOAL_THEN `(\n. (\n. &1) n - (\n. x pow n) n) --> &1 - &0` + MP_TAC THENL [ALL_TAC; REWRITE_TAC[BETA_THM]] THEN + MATCH_MP_TAC SEQ_SUB THEN BETA_TAC THEN REWRITE_TAC[SEQ_CONST] THEN + MATCH_MP_TAC SEQ_POWER THEN FIRST_ASSUM ACCEPT_TAC);; + +(*----------------------------------------------------------------------------*) +(* Now prove the ratio test *) +(*----------------------------------------------------------------------------*) + +let ABS_NEG_LEMMA = prove( + `!c x y. c <= &0 ==> abs(x) <= c * abs(y) ==> (x = &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NEG_GE0] THEN DISCH_TAC THEN + MP_TAC(SPECL [`--c`; `abs(y)`] REAL_LE_MUL) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABS_POS; GSYM REAL_NEG_LMUL; REAL_NEG_GE0] THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C CONJ th)) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[ABS_NZ; REAL_NOT_LE]);; + +let SER_RATIO = prove( + `!f c N. c < &1 /\ + (!n. n >= N ==> abs(f(SUC n)) <= c * abs(f(n))) ==> + summable f`, + REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN + DISJ_CASES_TAC (SPECL [`c:real`; `&0`] REAL_LET_TOTAL) THENL + [REWRITE_TAC[SER_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `!n. n >= N ==> (f(SUC n) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + MATCH_MP_TAC ABS_NEG_LEMMA THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!n. n >= (SUC N) ==> (f(n) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THENL + [REWRITE_TAC[GE] THEN DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN + REWRITE_TAC[NOT_LESS_0]; + REWRITE_TAC[GE; LE_SUC] THEN + ASM_REWRITE_TAC[GSYM GE]]; ALL_TAC] THEN + EXISTS_TAC `SUC N` THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUM_ZERO) THEN + REPEAT GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN (fun th -> REWRITE_TAC[th])) THEN + ASM_REWRITE_TAC[ABS_0]; + + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. (abs(f N) / c pow N) * (c pow n)` THEN CONJ_TAC THENL + [EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_EQUAL_ADD) + THEN BETA_TAC THEN REWRITE_TAC[POW_ADD] THEN REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (a * d) * (b * c)`] THEN + SUBGOAL_THEN `~(c pow N = &0)` + (fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th; REAL_MUL_RID]) THENL + [MATCH_MP_TAC POW_NZ THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[pow; ADD_CLAUSES; REAL_MUL_RID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * abs(f(N + d:num))` THEN + CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_ADD]; + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * (b * c) = b * (a * c)`] THEN + FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP REAL_LE_LMUL_LOCAL th])]; + + REWRITE_TAC[summable] THEN + EXISTS_TAC `(abs(f(N:num)) / (c pow N)) * inv(&1 - c)` THEN + MATCH_MP_TAC SER_CMUL THEN MATCH_MP_TAC GP THEN + ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`)) THEN + ASM_REWRITE_TAC[real_abs]]]);; + +(* ------------------------------------------------------------------------- *) +(* The error in truncating a convergent series is bounded by partial sums. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_TRUNCATION = prove + (`!f l n b. + f sums l /\ (!m. abs(sum(n,m) f) <= b) + ==> abs(l - sum(0,n) f) <= b`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP SER_OFFSET) THEN + REWRITE_TAC[sums] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP SUM_UNIQ) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP SEQ_ABS_IMP) THEN + MATCH_MP_TAC SEQ_LE THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + FIRST_ASSUM(fun th -> EXISTS_TAC (lhand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + EXISTS_TAC `\r:num. b:real` THEN REWRITE_TAC[SEQ_CONST] THEN + ASM_REWRITE_TAC[GSYM SUM_REINDEX; ADD_CLAUSES]);; + +(*============================================================================*) +(* Theory of limits, continuity and differentiation of real->real functions *) +(*============================================================================*) + +parse_as_infix ("tends_real_real",(12,"right"));; + +parse_as_infix ("diffl",(12,"right"));; +parse_as_infix ("contl",(12,"right"));; +parse_as_infix ("differentiable",(12,"right"));; + +(*----------------------------------------------------------------------------*) +(* Specialize nets theorems to the pointwise limit of real->real functions *) +(*----------------------------------------------------------------------------*) + +let tends_real_real = new_definition + `(f tends_real_real l)(x0) <=> + (f tends l)(mtop(mr1),tendsto(mr1,x0))`;; + +override_interface ("-->",`(tends_real_real)`);; + +let LIM = prove( + `!f y0 x0. (f --> y0)(x0) <=> + !e. &0 < e ==> + ?d. &0 < d /\ !x. &0 < abs(x - x0) /\ abs(x - x0) < d ==> + abs(f(x) - y0) < e`, + REPEAT GEN_TAC THEN + REWRITE_TAC[tends_real_real; MATCH_MP LIM_TENDS2 (SPEC `x0:real` MR1_LIMPT)] + THEN REWRITE_TAC[MR1_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ABS_SUB] THEN + REFL_TAC);; + +let LIM_CONST = prove( + `!k x. ((\x. k) --> k)(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real; MTOP_TENDS] THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[METRIC_SAME] THEN + REWRITE_TAC[tendsto; REAL_LE_REFL] THEN + MP_TAC(REWRITE_RULE[MTOP_LIMPT] (SPEC `x:real` MR1_LIMPT)) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` (ASSUME_TAC o CONJUNCT1)) THEN + EXISTS_TAC `z:real` THEN REWRITE_TAC[MR1_DEF; GSYM ABS_NZ] THEN + REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[]);; + +let LIM_ADD = prove( + `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==> + ((\x. f(x) + g(x)) --> (l + m))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC NET_ADD THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +let LIM_MUL = prove( + `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==> + ((\x. f(x) * g(x)) --> (l * m))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC NET_MUL THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +let LIM_NEG = prove( + `!f l. (f --> l)(x) <=> ((\x. --(f(x))) --> --l)(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC NET_NEG THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +let LIM_INV = prove( + `!f l. (f --> l)(x) /\ ~(l = &0) ==> + ((\x. inv(f(x))) --> inv l)(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC NET_INV THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +let LIM_SUB = prove( + `!f g l m. (f --> l)(x) /\ (g --> m)(x) ==> + ((\x. f(x) - g(x)) --> (l - m))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC NET_SUB THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +let LIM_DIV = prove( + `!f g l m. (f --> l)(x) /\ (g --> m)(x) /\ ~(m = &0) ==> + ((\x. f(x) / g(x)) --> (l / m))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC NET_DIV THEN MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +let LIM_NULL = prove( + `!f l x. (f --> l)(x) <=> ((\x. f(x) - l) --> &0)(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_ACCEPT_TAC NET_NULL);; + +let LIM_SUM = prove + (`!f l m n x. + (!r. m <= r /\ r < m + n ==> (f r --> l r)(x)) + ==> ((\x. sum(m,n) (\r. f r x)) --> sum(m,n) l)(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] NET_SUM) THEN + REWRITE_TAC[LIM_CONST; DORDER_TENDSTO; GSYM tends_real_real]);; + +(*----------------------------------------------------------------------------*) +(* One extra theorem is handy *) +(*----------------------------------------------------------------------------*) + +let LIM_X = prove( + `!x0. ((\x. x) --> x0)(x0)`, + GEN_TAC THEN REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Uniqueness of limit *) +(*----------------------------------------------------------------------------*) + +let LIM_UNIQ = prove( + `!f l m x. (f --> l)(x) /\ (f --> m)(x) ==> (l = m)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tends_real_real] THEN + MATCH_MP_TAC MTOP_TENDS_UNIQ THEN + MATCH_ACCEPT_TAC DORDER_TENDSTO);; + +(*----------------------------------------------------------------------------*) +(* Show that limits are equal when functions are equal except at limit point *) +(*----------------------------------------------------------------------------*) + +let LIM_EQUAL = prove( + `!f g l x0. (!x. ~(x = x0) ==> (f x = g x)) ==> + ((f --> l)(x0) <=> (g --> l)(x0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN DISCH_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN + ONCE_REWRITE_TAC[TAUT `(a ==> b <=> a ==> c) <=> a ==> (b <=> c)`] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + ASM_REWRITE_TAC[ABS_NZ]);; + +(*----------------------------------------------------------------------------*) +(* A more general theorem about rearranging the body of a limit *) +(*----------------------------------------------------------------------------*) + +let LIM_TRANSFORM = prove( + `!f g x0 l. ((\x. f(x) - g(x)) --> &0)(x0) /\ (g --> l)(x0) + ==> (f --> l)(x0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + DISCH_THEN((then_) (X_GEN_TAC `e:real` THEN DISCH_TAC) o MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`c:real`; `d:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN STRIP_ASSUME_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(e / &2) + (e / &2)` THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_HALF_DOUBLE] THEN + REWRITE_TAC[REAL_LE_REFL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(f(x:real) - g(x)) + abs(g(x) - l)` THEN + SUBST1_TAC(SYM(SPECL + [`(f:real->real) x`; `(g:real->real) x`; `l:real`] REAL_SUB_TRIANGLE)) THEN + REWRITE_TAC[ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_ADD2 THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `b:real` THEN + ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Define differentiation and continuity *) +(*----------------------------------------------------------------------------*) + +let diffl = new_definition + `(f diffl l)(x) <=> ((\h. (f(x+h) - f(x)) / h) --> l)(&0)`;; + +let contl = new_definition + `f contl x <=> ((\h. f(x + h)) --> f(x))(&0)`;; + +let differentiable = new_definition + `f differentiable x <=> ?l. (f diffl l)(x)`;; + +(*----------------------------------------------------------------------------*) +(* Derivative is unique *) +(*----------------------------------------------------------------------------*) + +let DIFF_UNIQ = prove( + `!f l m x. (f diffl l)(x) /\ (f diffl m)(x) ==> (l = m)`, + REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN + MATCH_ACCEPT_TAC LIM_UNIQ);; + +(*----------------------------------------------------------------------------*) +(* Differentiability implies continuity *) +(*----------------------------------------------------------------------------*) + +let DIFF_CONT = prove( + `!f l x. (f diffl l)(x) ==> f contl x`, + REPEAT GEN_TAC THEN REWRITE_TAC[diffl; contl] THEN DISCH_TAC THEN + REWRITE_TAC[tends_real_real] THEN ONCE_REWRITE_TAC[NET_NULL] THEN + REWRITE_TAC[GSYM tends_real_real] THEN BETA_TAC THEN + SUBGOAL_THEN `((\h. f(x + h) - f(x)) --> &0)(&0) <=> + ((\h. ((f(x + h) - f(x)) / h) * h) --> &0)(&0)` SUBST1_TAC + THENL + [MATCH_MP_TAC LIM_EQUAL THEN + X_GEN_TAC `z:real` THEN BETA_TAC THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_RMUL th]); ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV o RAND_CONV) + [SYM(BETA_CONV `(\h:real. h) h`)] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(f(x + h) - f(x)) / h`]) THEN + SUBST1_TAC(SYM(SPEC `l:real` REAL_MUL_RZERO)) THEN + MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LIM] THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e:real` THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Alternative definition of continuity *) +(*----------------------------------------------------------------------------*) + +let CONTL_LIM = prove( + `!f x. f contl x <=> (f --> f(x))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[contl; LIM] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ONCE_REWRITE_TAC[TAUT `(a ==> b <=> a ==> c) <=> a ==> (b <=> c)`] THEN + DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real` THENL + [DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[REAL_SUB_ADD2]; + DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_ADD_SUB]]);; + +(*----------------------------------------------------------------------------*) +(* Simple combining theorems for continuity *) +(*----------------------------------------------------------------------------*) + +let CONT_X = prove + (`!x. (\x. x) contl x`, + REWRITE_TAC[CONTL_LIM; LIM_X]);; + +let CONT_CONST = prove( + `!x. (\x. k) contl x`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN + MATCH_ACCEPT_TAC LIM_CONST);; + +let CONT_ADD = prove( + `!x. f contl x /\ g contl x ==> (\x. f(x) + g(x)) contl x`, + GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN + MATCH_ACCEPT_TAC LIM_ADD);; + +let CONT_MUL = prove( + `!x. f contl x /\ g contl x ==> (\x. f(x) * g(x)) contl x`, + GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN + MATCH_ACCEPT_TAC LIM_MUL);; + +let CONT_NEG = prove( + `!x. f contl x ==> (\x. --(f(x))) contl x`, + GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN + REWRITE_TAC[GSYM LIM_NEG]);; + +let CONT_INV = prove( + `!x. f contl x /\ ~(f x = &0) ==> (\x. inv(f(x))) contl x`, + GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN + MATCH_ACCEPT_TAC LIM_INV);; + +let CONT_SUB = prove( + `!x. f contl x /\ g contl x ==> (\x. f(x) - g(x)) contl x`, + GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN + MATCH_ACCEPT_TAC LIM_SUB);; + +let CONT_DIV = prove( + `!x. f contl x /\ g contl x /\ ~(g x = &0) ==> + (\x. f(x) / g(x)) contl x`, + GEN_TAC THEN REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN + MATCH_ACCEPT_TAC LIM_DIV);; + +let CONT_ABS = prove + (`!f x. f contl x ==> (\x. abs(f x)) contl x`, + REWRITE_TAC[CONTL_LIM; LIM] THEN + MESON_TAC[REAL_ARITH `abs(a - b) < e ==> abs(abs a - abs b) < e`]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of continuous functions is continuous. *) +(* ------------------------------------------------------------------------- *) + +let CONT_COMPOSE = prove( + `!f g x. f contl x /\ g contl (f x) ==> (\x. g(f x)) contl x`, + REPEAT GEN_TAC THEN REWRITE_TAC[contl; LIM; REAL_SUB_RZERO] THEN + BETA_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + ASM_CASES_TAC `&0 < abs(f(x + h) - f(x))` THENL + [UNDISCH_TAC `&0 < abs(f(x + h) - f(x))` THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONJ th)) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[REAL_SUB_ADD2]; + UNDISCH_TAC `~(&0 < abs(f(x + h) - f(x)))` THEN + REWRITE_TAC[GSYM ABS_NZ; REAL_SUB_0] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]]);; + +(*----------------------------------------------------------------------------*) +(* Intermediate Value Theorem (we prove contrapositive by bisection) *) +(*----------------------------------------------------------------------------*) + +let IVT = prove( + `!f a b y. a <= b /\ + (f(a) <= y /\ y <= f(b)) /\ + (!x. a <= x /\ x <= b ==> f contl x) + ==> (?x. a <= x /\ x <= b /\ (f(x) = y))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN + CONV_TAC CONTRAPOS_CONV THEN + DISCH_THEN(ASSUME_TAC o CONV_RULE NOT_EXISTS_CONV) THEN + (MP_TAC o C SPEC BOLZANO_LEMMA) + `\(u,v). a <= u /\ u <= v /\ v <= b ==> ~(f(u) <= y /\ y <= f(v))` THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN + ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[DE_MORGAN_THM; NOT_IMP] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY ASM_CASES_TAC [`u <= v`; `v <= w`] THEN ASM_REWRITE_TAC[] THEN + DISJ_CASES_TAC(SPECL [`y:real`; `(f:real->real) v`] REAL_LE_TOTAL) THEN + ASM_REWRITE_TAC[] THENL [DISJ1_TAC; DISJ2_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `w:real`; EXISTS_TAC `u:real`] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL + [ALL_TAC; + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a <= x /\ x <= b)` THEN + REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN + ASM_REWRITE_TAC[]] THEN + UNDISCH_TAC `!x. ~(a <= x /\ x <= b /\ (f(x) = (y:real)))` THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th)) THEN + REWRITE_TAC[contl; LIM] THEN + DISCH_THEN(MP_TAC o SPEC `abs(y - f(x:real))`) THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM ABS_NZ] THEN + REWRITE_TAC[REAL_SUB_0; REAL_SUB_RZERO] THEN BETA_TAC THEN + ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`(f:real->real) x`; `y:real`] REAL_LT_TOTAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THENL + [DISCH_THEN(MP_TAC o SPEC `v - x`) THEN REWRITE_TAC[NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_SUB_LT] THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `f(v:real) < y` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE]; + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN + ASM_REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG; REAL_LE_RADD]; + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN + REWRITE_TAC[REAL_NOT_LT; real_abs; REAL_SUB_LE] THEN + SUBGOAL_THEN `f(x:real) <= y` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `f(x:real) <= f(v)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `y:real`; ALL_TAC] THEN + ASM_REWRITE_TAC[real_sub; REAL_LE_RADD]]; + DISCH_THEN(MP_TAC o SPEC `u - x`) THEN REWRITE_TAC[NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[ABS_SUB] THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_SUB_LT] THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `y < f(x:real)` THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LE]; + ONCE_REWRITE_TAC[ABS_SUB] THEN ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN + ASM_REWRITE_TAC[real_sub; REAL_LE_LADD; REAL_LE_NEG; REAL_LE_RADD]; + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_SUB_ADD] THEN + REWRITE_TAC[REAL_NOT_LT; real_abs; REAL_SUB_LE] THEN + SUBGOAL_THEN `f(u:real) < f(x)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ASM_REWRITE_TAC[REAL_NOT_LT; REAL_LE_NEG; real_sub; REAL_LE_RADD]]]);; + +(*----------------------------------------------------------------------------*) +(* Intermediate value theorem where value at the left end is bigger *) +(*----------------------------------------------------------------------------*) + +let IVT2 = prove( + `!f a b y. (a <= b) /\ (f(b) <= y /\ y <= f(a)) /\ + (!x. a <= x /\ x <= b ==> f contl x) ==> + ?x. a <= x /\ x <= b /\ (f(x) = y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. --(f x)`; `a:real`; `b:real`; `--y`] IVT) THEN + BETA_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG; REAL_NEG_EQ; REAL_NEGNEG] THEN + DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC CONT_NEG THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Prove the simple combining theorems for differentiation *) +(*----------------------------------------------------------------------------*) + +let DIFF_CONST = prove( + `!k x. ((\x. k) diffl &0)(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN + REWRITE_TAC[REAL_SUB_REFL; real_div; REAL_MUL_LZERO] THEN + MATCH_ACCEPT_TAC LIM_CONST);; + +let DIFF_ADD = prove( + `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==> + ((\x. f(x) + g(x)) diffl (l + m))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN + DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ADD2_SUB2] THEN + REWRITE_TAC[real_div; REAL_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(f(x + h) - f(x)) / h`]) THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `(g(x + h) - g(x)) / h`]) THEN + MATCH_MP_TAC LIM_ADD THEN ASM_REWRITE_TAC[]);; + +let DIFF_MUL = prove( + `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==> + ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[diffl] THEN + DISCH_TAC THEN BETA_TAC THEN SUBGOAL_THEN + `!a b c d. (a * b) - (c * d) = ((a * b) - (a * d)) + ((a * d) - (c * d))` + (fun th -> ONCE_REWRITE_TAC[GEN_ALL th]) THENL + [REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (b + c) + (a + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN SUBGOAL_THEN + `!a b c d e. ((a * b) + (c * d)) / e = ((b / e) * a) + ((c / e) * d)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[REAL_RDISTRIB] THEN BINOP_TAC THEN + REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ADD_SYM] THEN + CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) + [`((g(x + h) - g(x)) / h) * f(x + h)`; + `((f(x + h) - f(x)) / h) * g(x)`])) THEN + MATCH_MP_TAC LIM_ADD THEN + CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) + [`(g(x + h) - g(x)) / h`; `f(x + h):real`; + `(f(x + h) - f(x)) / h`; `g(x:real):real`])) THEN + CONJ_TAC THEN MATCH_MP_TAC LIM_MUL THEN + BETA_TAC THEN ASM_REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[GSYM contl] THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `l:real` THEN + ASM_REWRITE_TAC[diffl]);; + +let DIFF_CMUL = prove( + `!f c l x. (f diffl l)(x) ==> ((\x. c * f(x)) diffl (c * l))(x)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o CONJ (SPECL [`c:real`; `x:real`] DIFF_CONST)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + MATCH_MP_TAC(TAUT(`(a <=> b) ==> a ==> b`)) THEN AP_THM_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[]);; + +let DIFF_NEG = prove( + `!f l x. (f diffl l)(x) ==> ((\x. --(f x)) diffl --l)(x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_NEG_MINUS1] THEN + MATCH_ACCEPT_TAC DIFF_CMUL);; + +let DIFF_SUB = prove( + `!f g l m x. (f diffl l)(x) /\ (g diffl m)(x) ==> + ((\x. f(x) - g(x)) diffl (l - m))(x)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD o (uncurry CONJ) o + (I F_F MATCH_MP DIFF_NEG) o CONJ_PAIR) THEN + BETA_TAC THEN REWRITE_TAC[real_sub]);; + +(* ------------------------------------------------------------------------- *) +(* Carathe'odory definition makes the chain rule proof much easier. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_CARAT = prove( + `!f l x. (f diffl l)(x) <=> + ?g. (!z. f(z) - f(x) = g(z) * (z - x)) /\ g contl x /\ (g(x) = l)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [EXISTS_TAC `\z. if z = x then l else (f(z) - f(x)) / (z - x)` THEN + BETA_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + ASM_REWRITE_TAC[REAL_SUB_0]; + POP_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[diffl; contl] THEN BETA_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC LIM_EQUAL THEN GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + ASM_REWRITE_TAC[REAL_ADD_RID_UNIQ; REAL_ADD_SUB]]; + POP_ASSUM(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN UNDISCH_TAC `g contl x` THEN + ASM_REWRITE_TAC[contl; diffl; REAL_ADD_SUB] THEN + MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC LIM_EQUAL THEN GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN + REWRITE_TAC[REAL_MUL_RID]]);; + +(*----------------------------------------------------------------------------*) +(* Now the chain rule *) +(*----------------------------------------------------------------------------*) + +let DIFF_CHAIN = prove( + `!f g l m x. + (f diffl l)(g x) /\ (g diffl m)(x) ==> ((\x. f(g x)) diffl (l * m))(x)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP DIFF_CONT th)) THEN + REWRITE_TAC[DIFF_CARAT] THEN + DISCH_THEN(X_CHOOSE_THEN `g':real->real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `f':real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `\z. if z = x then l * m else (f(g(z):real) - f(g(x))) / (z - x)` THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + ASM_REWRITE_TAC[REAL_SUB_0]; + MP_TAC(CONJ (ASSUME `g contl x`) (ASSUME `f' contl (g(x:real))`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP CONT_COMPOSE) THEN + DISCH_THEN(MP_TAC o C CONJ (ASSUME `g' contl x`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP CONT_MUL) THEN BETA_TAC THEN + ASM_REWRITE_TAC[contl] THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC LIM_EQUAL THEN X_GEN_TAC `z:real` THEN + DISCH_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID_UNIQ] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_ADD_SUB] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN + REWRITE_TAC[REAL_MUL_RID]]);; + +(*----------------------------------------------------------------------------*) +(* Differentiation of natural number powers *) +(*----------------------------------------------------------------------------*) + +let DIFF_X = prove( + `!x. ((\x. x) diffl &1)(x)`, + GEN_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN + REWRITE_TAC[REAL_ADD_SUB] THEN REWRITE_TAC[LIM; REAL_SUB_RZERO] THEN + BETA_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[GSYM ABS_NZ] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_REFL th]) THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]);; + +let DIFF_POW = prove( + `!n x. ((\x. x pow n) diffl (&n * (x pow (n - 1))))(x)`, + INDUCT_TAC THEN REWRITE_TAC[pow; DIFF_CONST; REAL_MUL_LZERO] THEN + X_GEN_TAC `x:real` THEN + POP_ASSUM(MP_TAC o CONJ(SPEC `x:real` DIFF_X) o SPEC `x:real`) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN + REWRITE_TAC[REAL; REAL_RDISTRIB; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN BINOP_TAC THENL + [REWRITE_TAC[ADD1; ADD_SUB]; + STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[ADD1; ADD_SUB; POW_ADD] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[num_CONV `1`; pow] THEN + REWRITE_TAC[SYM(num_CONV `1`); REAL_MUL_RID]]);; + +(*----------------------------------------------------------------------------*) +(* Now power of -1 (then differentiation of inverses follows from chain rule) *) +(*----------------------------------------------------------------------------*) + +let DIFF_XM1 = prove( + `!x. ~(x = &0) ==> ((\x. inv(x)) diffl (--(inv(x) pow 2)))(x)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[diffl] THEN BETA_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\h. --(inv(x + h) * inv(x))` THEN + BETA_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `abs(x)` THEN + EVERY_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[ABS_NZ] th]) THEN + X_GEN_TAC `h:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN STRIP_ASSUME_TAC THEN BETA_TAC THEN + W(C SUBGOAL_THEN SUBST1_TAC o C (curry mk_eq) `&0` o + rand o rator o snd) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABS_ZERO; REAL_SUB_0] THEN + SUBGOAL_THEN `~(x + h = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `abs(h) < abs(--h)` THEN + REWRITE_TAC[ABS_NEG; REAL_LT_REFL]; ALL_TAC] THEN + W(fun (asl,w) -> MP_TAC + (SPECL [`x * (x + h)`; lhs w; rhs w] REAL_EQ_LMUL)) THEN + ASM_REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[real_div; REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (c * b) * (d * a)`] THEN + REWRITE_TAC(map (MATCH_MP REAL_MUL_LINV o ASSUME) + [`~(x = &0)`; `~(x + h = &0)`]) THEN REWRITE_TAC[REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * (c * d) = (a * d) * (c * b)`] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x = &0)`)] THEN + REWRITE_TAC[REAL_MUL_LID; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REWRITE_RULE[REAL_NEG_SUB] + (AP_TERM `(--)` (SPEC_ALL REAL_ADD_SUB))] THEN + REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[ABS_NZ]; + + REWRITE_TAC[POW_2] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `inv(x + h) * inv(x)`]) THEN + REWRITE_TAC[GSYM LIM_NEG] THEN + CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`inv(x + h)`; `inv(x)`])) + THEN MATCH_MP_TAC LIM_MUL THEN BETA_TAC THEN + REWRITE_TAC[LIM_CONST] THEN + CONV_TAC(EXACT_CONV[X_BETA_CONV `h:real` `x + h`]) THEN + MATCH_MP_TAC LIM_INV THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + CONV_TAC(EXACT_CONV(map (X_BETA_CONV `h:real`) [`x:real`; `h:real`])) THEN + MATCH_MP_TAC LIM_ADD THEN BETA_TAC THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_ACCEPT_TAC LIM_X]);; + +(*----------------------------------------------------------------------------*) +(* Now differentiation of inverse and quotient *) +(*----------------------------------------------------------------------------*) + +let DIFF_INV = prove( + `!f l x. (f diffl l)(x) /\ ~(f(x) = &0) ==> + ((\x. inv(f x)) diffl --(l / (f(x) pow 2)))(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_div; REAL_NEG_RMUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN DISCH_TAC THEN + MATCH_MP_TAC DIFF_CHAIN THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV (CONJUNCT2 th)]) THEN + MATCH_MP_TAC(CONV_RULE(ONCE_DEPTH_CONV ETA_CONV) DIFF_XM1) THEN + ASM_REWRITE_TAC[]);; + +let DIFF_DIV = prove( + `!f g l m. (f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==> + ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) / (g(x) pow 2)))(x)`, + REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN + REWRITE_TAC[real_div] THEN + MP_TAC(SPECL [`g:real->real`; `m:real`; `x:real`] DIFF_INV) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJ(ASSUME `(f diffl l)(x)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_MUL) THEN BETA_TAC THEN + W(C SUBGOAL_THEN SUBST1_TAC o mk_eq o + ((rand o rator) F_F (rand o rator)) o dest_imp o snd) THEN + REWRITE_TAC[] THEN REWRITE_TAC[real_sub] THEN + REWRITE_TAC[REAL_LDISTRIB; REAL_RDISTRIB] THEN BINOP_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[POW_2] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK (W CONJ th)]) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN + REWRITE_TAC[REAL_MUL_LID]; + REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_AC]]);; + +(*----------------------------------------------------------------------------*) +(* Differentiation of finite sum *) +(*----------------------------------------------------------------------------*) + +let DIFF_SUM = prove( + `!f f' m n x. (!r. m <= r /\ r < (m + n) + ==> ((\x. f r x) diffl (f' r x))(x)) + ==> ((\x. sum(m,n)(\n. f n x)) diffl (sum(m,n) (\r. f' r x)))(x)`, + REPEAT GEN_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[sum; DIFF_CONST] THEN DISCH_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC DIFF_ADD THEN + BETA_TAC THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LT_TRANS THEN + EXISTS_TAC `m + n:num` THEN ASM_REWRITE_TAC[ADD_CLAUSES; LESS_SUC_REFL]; + REWRITE_TAC[LE_ADD; ADD_CLAUSES; LESS_SUC_REFL]]);; + +(*----------------------------------------------------------------------------*) +(* By bisection, function continuous on closed interval is bounded above *) +(*----------------------------------------------------------------------------*) + +let CONT_BOUNDED = prove( + `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) + ==> ?M. !x. a <= x /\ x <= b ==> f(x) <= M`, + REPEAT STRIP_TAC THEN + (MP_TAC o C SPEC BOLZANO_LEMMA) + `\(u,v). a <= u /\ u <= v /\ v <= b ==> + ?M. !x. u <= x /\ x <= v ==> f x <= M` THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o + funpow 2(fst o dest_imp) o snd) THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN + ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + DISCH_TAC THEN + REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_imp o concl)) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `v <= b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `a <= v` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `M1:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `M2:real`) THEN + DISJ_CASES_TAC(SPECL [`M1:real`; `M2:real`] REAL_LE_TOTAL) THENL + [EXISTS_TAC `M2:real` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`x:real`; `v:real`] REAL_LE_TOTAL) THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M1:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `M1:real` THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`x:real`; `v:real`] REAL_LE_TOTAL) THENL + [ALL_TAC; MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `M2:real` THEN ASM_REWRITE_TAC[]] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL + [ALL_TAC; + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a <= x /\ x <= b)` THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN + ASM_REWRITE_TAC[]] THEN + UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[contl; LIM] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN BETA_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `abs(f(x:real)) + &1` THEN + X_GEN_TAC `z:real` THEN STRIP_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `z - x`) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN + REWRITE_TAC[REAL_SUB_ADD] THEN DISCH_TAC THEN + MP_TAC(SPECL [`f(z:real) - f(x)`; `(f:real->real) x`] ABS_TRIANGLE) THEN + REWRITE_TAC[REAL_SUB_ADD] THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(z:real))` THEN + REWRITE_TAC[ABS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(f(x:real)) + (abs(f(z) - f(x)))` THEN + ASM_REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_CASES_TAC `z:real = x` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0; REAL_LT_01]; + FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM ABS_NZ] THEN + ASM_REWRITE_TAC[REAL_SUB_0; real_abs; REAL_SUB_LE] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN COND_CASES_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `v - x`; EXISTS_TAC `v - z`] THEN + ASM_REWRITE_TAC[real_sub; REAL_LE_RADD; REAL_LE_LADD; REAL_LE_NEG]]);; + +let CONT_BOUNDED_ABS = prove + (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) + ==> ?M. !x. a <= x /\ x <= b ==> abs(f(x)) <= M`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `a <= b` THENL + [ALL_TAC; + ASM_SIMP_TAC[REAL_ARITH `~(a <= b) ==> ~(a <= x /\ x <= b)`]] THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_BOUNDED) THEN + MP_TAC(SPECL [`\x:real. --(f x)`; `a:real`; `b:real`] CONT_BOUNDED) THEN + ASM_SIMP_TAC[CONT_NEG] THEN + DISCH_THEN(X_CHOOSE_TAC `M1:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `M2:real`) THEN + EXISTS_TAC `abs(M1) + abs(M2)` THEN + ASM_SIMP_TAC[REAL_ARITH + `x <= m1 /\ --x <= m2 ==> abs(x) <= abs(m2) + abs(m1)`]);; + +(*----------------------------------------------------------------------------*) +(* Refine the above to existence of least upper bound *) +(*----------------------------------------------------------------------------*) + +let CONT_HASSUP = prove( + `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) + ==> ?M. (!x. a <= x /\ x <= b ==> f(x) <= M) /\ + (!N. N < M ==> ?x. a <= x /\ x <= b /\ N < f(x))`, + let tm = `\y:real. ?x. a <= x /\ x <= b /\ (y = f(x))` in + REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC tm REAL_SUP_LE) THEN + BETA_TAC THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) + THENL + [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`(f:real->real) a`; `a:real`] THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_LT]; + POP_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP CONT_BOUNDED) THEN + EXISTS_TAC `M:real` THEN X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN + REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THEN + POP_ASSUM MATCH_ACCEPT_TAC]; + DISCH_TAC THEN EXISTS_TAC (mk_comb(`sup`,tm)) THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC (mk_comb(`sup`,tm))) THEN + REWRITE_TAC[REAL_LT_REFL] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN + DISCH_THEN(MP_TAC o SPEC `(f:real->real) x`) THEN + REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN + CONV_TAC(ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `N:real`) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN + REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST_ALL_TAC) THEN + DISCH_TAC THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]]);; + +(*----------------------------------------------------------------------------*) +(* Now show that it attains its upper bound *) +(*----------------------------------------------------------------------------*) + +let CONT_ATTAINS = prove( + `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) + ==> ?M. (!x. a <= x /\ x <= b ==> f(x) <= M) /\ + (?x. a <= x /\ x <= b /\ (f(x) = M))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC o MATCH_MP CONT_HASSUP) + THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + CONV_TAC(RAND_CONV NOT_EXISTS_CONV) THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> f(x) < M` MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + PURE_ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. inv(M - f(x))) contl x` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN + MATCH_MP_TAC CONT_INV THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LT_IMP_NE THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN + MATCH_MP_TAC CONT_SUB THEN BETA_TAC THEN + REWRITE_TAC[CONT_CONST] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?k. !x. a <= x /\ x <= b ==> (\x. inv(M - (f x))) x <= k` + MP_TAC THENL + [MATCH_MP_TAC CONT_BOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> &0 < inv(M - f(x))` ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_INV_POS THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. inv(M - (f x))) x < (k + &1)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `k:real` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN + BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> + inv(k + &1) < inv((\x. inv(M - (f x))) x)` MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LT_INV2 THEN + CONJ_TAC THENL + [BETA_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + BETA_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> inv(k + &1) < (M - (f x))` + MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `~(M - f(x:real) = &0)` + (SUBST1_TAC o SYM o MATCH_MP REAL_INVINV) THENL + [CONV_TAC(RAND_CONV SYM_CONV) THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[REAL_LT_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ONCE_REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN DISCH_TAC THEN + UNDISCH_TAC `!N. N < M ==> (?x. a <= x /\ x <= b /\ N < (f x))` THEN + DISCH_THEN(MP_TAC o SPEC `M - inv(k + &1)`) THEN + REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `k:real` THEN REWRITE_TAC[REAL_LT_ADDR; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(M - f(a:real))` THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL]; + DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ONCE_REWRITE_TAC[GSYM REAL_LT_SUB_LADD] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(*----------------------------------------------------------------------------*) +(* Same theorem for lower bound *) +(*----------------------------------------------------------------------------*) + +let CONT_ATTAINS2 = prove( + `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) + ==> ?M. (!x. a <= x /\ x <= b ==> M <= f(x)) /\ + (?x. a <= x /\ x <= b /\ (f(x) = M))`, + REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (\x. --(f x)) contl x` MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o CONJ (ASSUME `a <= b`)) THEN + DISCH_THEN(X_CHOOSE_THEN `M:real` MP_TAC o MATCH_MP CONT_ATTAINS) THEN + BETA_TAC THEN DISCH_TAC THEN EXISTS_TAC `--M` THEN CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_LE_NEG] THEN + ASM_REWRITE_TAC[REAL_NEGNEG]; + ASM_REWRITE_TAC[GSYM REAL_NEG_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* Another version. *) +(* ------------------------------------------------------------------------- *) + +let CONT_ATTAINS_ALL = prove( + `!f a b. (a <= b /\ !x. a <= x /\ x <= b ==> f contl x) + ==> ?L M. (!x. a <= x /\ x <= b ==> L <= f(x) /\ f(x) <= M) /\ + !y. L <= y /\ y <= M ==> ?x. a <= x /\ x <= b /\ (f(x) = y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `L:real` MP_TAC o MATCH_MP CONT_ATTAINS2) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x1:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_THEN `M:real` MP_TAC o MATCH_MP CONT_ATTAINS) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x2:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`L:real`; `M:real`] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISJ_CASES_TAC(SPECL [`x1:real`; `x2:real`] REAL_LE_TOTAL) THEN + REPEAT STRIP_TAC THENL + [MP_TAC(SPECL [`f:real->real`; `x1:real`; `x2:real`; `y:real`] IVT) THEN + ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN + (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2); + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + + ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN + (CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `x1:real`; EXISTS_TAC `x2:real`] THEN + ASM_REWRITE_TAC[]); + MP_TAC(SPECL [`f:real->real`; `x2:real`; `x1:real`; `y:real`] IVT2) THEN + ASM_REWRITE_TAC[] THEN W(C SUBGOAL_THEN + (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2); + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN + (CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `x2:real`; EXISTS_TAC `x1:real`] THEN + ASM_REWRITE_TAC[])]);; + +(*----------------------------------------------------------------------------*) +(* If f'(x) > 0 then x is locally strictly increasing at the right *) +(*----------------------------------------------------------------------------*) + +let DIFF_LINC = prove( + `!f x l. (f diffl l)(x) /\ &0 < l ==> + ?d. &0 < d /\ !h. &0 < h /\ h < d ==> f(x) < f(x + h)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[diffl; LIM; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `l:real`) THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INV_POS o CONJUNCT1) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC ABS_SIGN THEN EXISTS_TAC `l:real` THEN + FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE o CONJUNCT1) THEN + ASM_REWRITE_TAC[real_abs]);; + +(*----------------------------------------------------------------------------*) +(* If f'(x) < 0 then x is locally strictly increasing at the left *) +(*----------------------------------------------------------------------------*) + +let DIFF_LDEC = prove( + `!f x l. (f diffl l)(x) /\ l < &0 ==> + ?d. &0 < d /\ !h. &0 < h /\ h < d ==> f(x) < f(x - h)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[diffl; LIM; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `--l`) THEN + ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN + REWRITE_TAC[REAL_NEG_LT0] THEN BETA_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INV_POS o CONJUNCT1) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM REAL_NEG_LT0; REAL_NEG_RMUL] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_NEG_INV + (GSYM (MATCH_MP REAL_LT_IMP_NE (CONJUNCT1 th)))]) THEN + MATCH_MP_TAC ABS_SIGN2 THEN EXISTS_TAC `l:real` THEN + REWRITE_TAC[GSYM real_div] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o funpow 3 LAND_CONV o RAND_CONV) + [real_sub] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE o CONJUNCT1) THEN + REWRITE_TAC[real_abs; GSYM REAL_NEG_LE0; REAL_NEGNEG] THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LT]);; + +(*----------------------------------------------------------------------------*) +(* If f is differentiable at a local maximum x, f'(x) = 0 *) +(*----------------------------------------------------------------------------*) + +let DIFF_LMAX = prove( + `!f x l. (f diffl l)(x) /\ + (?d. &0 < d /\ (!y. abs(x - y) < d ==> f(y) <= f(x))) ==> (l = &0)`, + REPEAT GEN_TAC THEN DISCH_THEN + (CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC)) THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`l:real`; `&0`] REAL_LT_TOTAL) THEN + ASM_REWRITE_TAC[] THENL + [DISCH_THEN(MP_TAC o C CONJ(ASSUME `l < &0`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_LDEC) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(SPECL [`k:real`; `e:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `x - d`) THEN REWRITE_TAC[REAL_SUB_SUB2] THEN + SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]; + DISCH_THEN(MP_TAC o C CONJ(ASSUME `&0 < l`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_LINC) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(SPECL [`k:real`; `e:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `x + d`) THEN REWRITE_TAC[REAL_ADD_SUB2] THEN + SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[ABS_NEG] THEN + ASM_REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT]]);; + +(*----------------------------------------------------------------------------*) +(* Similar theorem for a local minimum *) +(*----------------------------------------------------------------------------*) + +let DIFF_LMIN = prove( + `!f x l. (f diffl l)(x) /\ + (?d. &0 < d /\ (!y. abs(x - y) < d ==> f(x) <= f(y))) ==> (l = &0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`\x:real. --(f x)`; `x:real`; `--l`] DIFF_LMAX) THEN + BETA_TAC THEN REWRITE_TAC[REAL_LE_NEG; REAL_NEG_EQ0] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIFF_NEG THEN ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* In particular if a function is locally flat *) +(*----------------------------------------------------------------------------*) + +let DIFF_LCONST = prove( + `!f x l. (f diffl l)(x) /\ + (?d. &0 < d /\ (!y. abs(x - y) < d ==> (f(y) = f(x)))) ==> (l = &0)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC DIFF_LMAX THEN + MAP_EVERY EXISTS_TAC [`f:real->real`; `x:real`] THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(SUBST1_TAC o C MATCH_MP th)) THEN + MATCH_ACCEPT_TAC REAL_LE_REFL);; + +(*----------------------------------------------------------------------------*) +(* Lemma about introducing open ball in open interval *) +(*----------------------------------------------------------------------------*) + +let INTERVAL_LEMMA_LT = prove( + `!a b x. a < x /\ x < b ==> + ?d. &0 < d /\ !y. abs(x - y) < d ==> a < y /\ y < b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ABS_BETWEEN] THEN + DISJ_CASES_TAC(SPECL [`x - a`; `b - x`] REAL_LE_TOTAL) THENL + [EXISTS_TAC `x - a`; EXISTS_TAC `b - x`] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN GEN_TAC THEN + REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN + REWRITE_TAC[real_sub; REAL_ADD_ASSOC] THEN + REWRITE_TAC[GSYM real_sub; REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN + FREEZE_THEN(fun th -> ONCE_REWRITE_TAC[th]) (SPEC `x:real` REAL_ADD_SYM) THEN + REWRITE_TAC[REAL_LT_RADD] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + (MATCH_MP_TAC o GEN_ALL o fst o EQ_IMP_RULE o SPEC_ALL) REAL_LT_RADD THENL + [EXISTS_TAC `a:real` THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `x + x` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(x - a) <= (b - x)`; + EXISTS_TAC `b:real` THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `x + x` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(b - x) <= (x - a)`] THEN + REWRITE_TAC[REAL_LE_SUB_LADD; GSYM REAL_LE_SUB_RADD] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_sub] THEN + REWRITE_TAC[REAL_ADD_AC]);; + +let INTERVAL_LEMMA = prove( + `!a b x. a < x /\ x < b ==> + ?d. &0 < d /\ !y. abs(x - y) < d ==> a <= y /\ y <= b`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `d:real` o MATCH_MP INTERVAL_LEMMA_LT) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th o CONJUNCT2)) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]);; + +(*----------------------------------------------------------------------------*) +(* Now Rolle's theorem *) +(*----------------------------------------------------------------------------*) + +let ROLLE = prove( + `!f a b. a < b /\ + (f(a) = f(b)) /\ + (!x. a <= x /\ x <= b ==> f contl x) /\ + (!x. a < x /\ x < b ==> f differentiable x) + ==> ?z. a < z /\ z < b /\ (f diffl &0)(z)`, + REPEAT GEN_TAC THEN DISCH_THEN STRIP_ASSUME_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_ATTAINS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `M:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x1:real`)) THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_ATTAINS2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `m:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x2:real`)) THEN + ASM_CASES_TAC `a < x1 /\ x1 < b` THENL + [FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN + DISCH_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC `x1:real` THEN + ASM_REWRITE_TAC[] THEN SUBGOAL_THEN + `?l. (f diffl l)(x1) /\ + ?d. &0 < d /\ (!y. abs(x1 - y) < d ==> f(y) <= f(x1))` MP_TAC THENL + [CONV_TAC EXISTS_AND_CONV THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + SUBST_ALL_TAC(MATCH_MP DIFF_LMAX th)) + THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `a < x2 /\ x2 < b` THENL + [FIRST_ASSUM(X_CHOOSE_THEN `d:real` MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN + DISCH_THEN STRIP_ASSUME_TAC THEN EXISTS_TAC `x2:real` THEN + ASM_REWRITE_TAC[] THEN SUBGOAL_THEN + `?l. (f diffl l)(x2) /\ + ?d. &0 < d /\ (!y. abs(x2 - y) < d ==> f(x2) <= f(y))` MP_TAC THENL + [CONV_TAC EXISTS_AND_CONV THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + DISCH_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + SUBST_ALL_TAC(MATCH_MP DIFF_LMIN th)) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x. a <= x /\ x <= b ==> (f(x):real = f(b))` MP_TAC THENL + [REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl)) THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN REWRITE_TAC[DE_MORGAN_THM] THEN + REPEAT (DISCH_THEN(DISJ_CASES_THEN2 (MP_TAC o SYM) MP_TAC) THEN + DISCH_THEN(SUBST_ALL_TAC o AP_TERM `f:real->real`)) THEN + UNDISCH_TAC `(f:real->real) a = f b` THEN + DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + (CONJ_TAC THENL + [SUBGOAL_THEN `(f:real->real) b = M` SUBST1_TAC THENL + [FIRST_ASSUM(ACCEPT_TAC o el 2 o CONJUNCTS); + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `(f:real->real) b = m` SUBST1_TAC THENL + [FIRST_ASSUM(ACCEPT_TAC o el 2 o CONJUNCTS); + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]); + X_CHOOSE_TAC `x:real` (MATCH_MP REAL_MEAN (ASSUME `a < b`)) THEN + DISCH_TAC THEN EXISTS_TAC `x:real` THEN + REWRITE_TAC[ASSUME `a < x /\ x < b`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INTERVAL_LEMMA) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?l. (f diffl l)(x) /\ + (?d. &0 < d /\ (!y. abs(x - y) < d ==> (f(y) = f(x))))` MP_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV EXISTS_AND_CONV) THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN + FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `l:real` (fun th -> + ASSUME_TAC th THEN SUBST_ALL_TAC(MATCH_MP DIFF_LCONST th))) THEN + ASM_REWRITE_TAC[]]]);; + +(*----------------------------------------------------------------------------*) +(* Mean value theorem *) +(*----------------------------------------------------------------------------*) + +let MVT_LEMMA = prove( + `!(f:real->real) a b. + (\x. f(x) - (((f(b) - f(a)) / (b - a)) * x))(a) = + (\x. f(x) - (((f(b) - f(a)) / (b - a)) * x))(b)`, + REPEAT GEN_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `b:real = a` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_0]) THEN + MP_TAC(GENL [`x:real`; `y:real`] + (SPECL [`x:real`; `y:real`; `b - a`] REAL_EQ_RMUL)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_RMUL th]) THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[real_sub; REAL_LDISTRIB; REAL_RDISTRIB] THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL; + REAL_NEG_ADD; REAL_NEGNEG] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[AC REAL_ADD_AC + `w + x + y + z = (y + w) + (x + z)`; REAL_ADD_LINV; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_ADD_RID]);; + +let MVT = prove( + `!f a b. a < b /\ + (!x. a <= x /\ x <= b ==> f contl x) /\ + (!x. a < x /\ x < b ==> f differentiable x) + ==> ?l z. a < z /\ z < b /\ (f diffl l)(z) /\ + (f(b) - f(a) = (b - a) * l)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`\x. f(x) - (((f(b) - f(a)) / (b - a)) * x)`; + `a:real`; `b:real`] ROLLE) THEN + W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [ASM_REWRITE_TAC[MVT_LEMMA] THEN BETA_TAC THEN + CONJ_TAC THEN X_GEN_TAC `x:real` THENL + [DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN + MATCH_MP_TAC CONT_SUB THEN CONJ_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC CONT_MUL THEN + REWRITE_TAC[CONT_CONST] THEN MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC DIFF_X]; + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[differentiable] THEN DISCH_THEN(X_CHOOSE_TAC `l:real`) THEN + EXISTS_TAC `l - ((f(b) - f(a)) / (b - a))` THEN + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC DIFF_SUB THEN + CONJ_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN FIRST_ASSUM ACCEPT_TAC; + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC DIFF_CMUL THEN MATCH_ACCEPT_TAC DIFF_X]]; + ALL_TAC] THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN((then_) (MAP_EVERY EXISTS_TAC + [`((f(b) - f(a)) / (b - a))`; `z:real`]) o MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN((then_) CONJ_TAC o MP_TAC) THENL + [ALL_TAC; DISCH_THEN(K ALL_TAC) THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_DIV_LMUL THEN REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `a < a` THEN + REWRITE_TAC[REAL_LT_REFL]] THEN + SUBGOAL_THEN `((\x. ((f(b) - f(a)) / (b - a)) * x ) diffl + ((f(b) - f(a)) / (b - a)))(z)` + (fun th -> DISCH_THEN(MP_TAC o C CONJ th)) THENL + [CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC DIFF_CMUL THEN REWRITE_TAC[DIFF_X]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_ADD] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + REWRITE_TAC[REAL_ADD_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Simple version with pure differentiability assumption. *) +(* ------------------------------------------------------------------------- *) + +let MVT_ALT = prove + (`!f f' a b. + a < b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) + ==> ?z. a < z /\ z < b /\ (f b - f a = (b - a) * f'(z))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?l z. a < z /\ z < b /\ (f diffl l) z /\ (f b - f a = (b - a) * l)` + MP_TAC THENL + [MATCH_MP_TAC MVT THEN REWRITE_TAC[differentiable] THEN + ASM_MESON_TAC[DIFF_CONT; REAL_LT_IMP_LE]; + ASM_MESON_TAC[DIFF_UNIQ; REAL_LT_IMP_LE]]);; + +(*----------------------------------------------------------------------------*) +(* Theorem that function is constant if its derivative is 0 over an interval. *) +(* *) +(* We could have proved this directly by bisection; consider instantiating *) +(* BOLZANO_LEMMA with *) +(* *) +(* \(x,y). f(y) - f(x) <= C * (y - x) *) +(* *) +(* However the Rolle and Mean Value theorems are useful to have anyway *) +(*----------------------------------------------------------------------------*) + +let DIFF_ISCONST_END = prove( + `!f a b. a < b /\ + (!x. a <= x /\ x <= b ==> f contl x) /\ + (!x. a < x /\ x < b ==> (f diffl &0)(x)) + ==> (f b = f a)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] MVT) THEN + ASM_REWRITE_TAC[] THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [GEN_TAC THEN REWRITE_TAC[differentiable] THEN + DISCH_THEN((then_) (EXISTS_TAC `&0`) o MP_TAC) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` (X_CHOOSE_THEN `x:real` MP_TAC)) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ b) /\ (c /\ d)`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(MP_TAC o CONJ (ASSUME `(f diffl l)(x)`)) THEN + DISCH_THEN(SUBST_ALL_TAC o MATCH_MP DIFF_UNIQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_MUL_RZERO; REAL_SUB_0]) THEN + FIRST_ASSUM ACCEPT_TAC);; + +let DIFF_ISCONST = prove( + `!f a b. a < b /\ + (!x. a <= x /\ x <= b ==> f contl x) /\ + (!x. a < x /\ x < b ==> (f diffl &0)(x)) + ==> !x. a <= x /\ x <= b ==> (f x = f a)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `x:real`] DIFF_ISCONST_END) THEN + DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `a <= x`)) THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real`; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x:real`] THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]);; + +let DIFF_ISCONST_END_SIMPLE = prove + (`!f a b. a < b /\ + (!x. a <= x /\ x <= b ==> (f diffl &0)(x)) + ==> (f b = f a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_ISCONST_END THEN + ASM_MESON_TAC[DIFF_CONT; REAL_LT_IMP_LE]);; + +let DIFF_ISCONST_ALL = prove( + `!f x y. (!x. (f diffl &0)(x)) ==> (f(x) = f(y))`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `!x. f contl x` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC + (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THENL + [DISCH_THEN SUBST1_TAC THEN REFL_TAC; + CONV_TAC(RAND_CONV SYM_CONV); + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC DIFF_ISCONST_END THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Boring lemma about distances *) +(* ------------------------------------------------------------------------ *) + +let INTERVAL_ABS = REAL_ARITH + `!x z d. (x - d) <= z /\ z <= (x + d) <=> abs(z - x) <= d`;; + +(* ------------------------------------------------------------------------ *) +(* Dull lemma that an continuous injection on an interval must have a strict*) +(* maximum at an end point, not in the middle. *) +(* ------------------------------------------------------------------------ *) + +let CONT_INJ_LEMMA = prove( + `!f g x d. &0 < d /\ + (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ + (!z. abs(z - x) <= d ==> f contl z) ==> + ~(!z. abs(z - x) <= d ==> f(z) <= f(x))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN + DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o C SPEC th) [`x - d`; `x + d`]) THEN + REWRITE_TAC[REAL_ADD_SUB; REAL_SUB_SUB; ABS_NEG] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_REFL] THEN + DISCH_TAC THEN DISCH_TAC THEN DISJ_CASES_TAC + (SPECL [`f(x - d):real`; `f(x + d):real`] REAL_LE_TOTAL) THENL + [MP_TAC(SPECL [`f:real->real`; `x - d`; `x:real`; `f(x + d):real`] IVT) THEN + ASM_REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_ADDR] THEN + W(C SUBGOAL_THEN MP_TAC o fst o dest_imp o dest_neg o snd) THENL + [X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN + REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o AP_TERM `g:real->real`) THEN + SUBGOAL_THEN `g((f:real->real) z) = z` SUBST1_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN + REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `g(f(x + d):real) = x + d` SUBST1_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_ADD_SUB] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[REAL_LT_ADDR]]; + MP_TAC(SPECL [`f:real->real`; `x:real`; `x + d`; `f(x - d):real`] IVT2) THEN + ASM_REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_ADDR] THEN + W(C SUBGOAL_THEN MP_TAC o fst o dest_imp o dest_neg o snd) THENL + [X_GEN_TAC `z:real` THEN STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o AP_TERM `g:real->real`) THEN + SUBGOAL_THEN `g((f:real->real) z) = z` SUBST1_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; REAL_LE_SUB_RADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `g(f(x - d):real) = x - d` SUBST1_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_SUB_SUB; ABS_NEG] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LT_ADDR]]]);; + +(* ------------------------------------------------------------------------ *) +(* Similar version for lower bound *) +(* ------------------------------------------------------------------------ *) + +let CONT_INJ_LEMMA2 = prove( + `!f g x d. &0 < d /\ + (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ + (!z. abs(z - x) <= d ==> f contl z) ==> + ~(!z. abs(z - x) <= d ==> f(x) <= f(z))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. --(f x)`; `\y. (g(--y):real)`; `x:real`; `d:real`] + CONT_INJ_LEMMA) THEN + BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEGNEG; REAL_LE_NEG] THEN + DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONT_NEG THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; + +(* ------------------------------------------------------------------------ *) +(* Show there's an interval surrounding f(x) in f[[x - d, x + d]] *) +(* ------------------------------------------------------------------------ *) + +let CONT_INJ_RANGE = prove( + `!f g x d. &0 < d /\ + (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ + (!z. abs(z - x) <= d ==> f contl z) ==> + ?e. &0 < e /\ + (!y. abs(y - f(x)) <= e ==> ?z. abs(z - x) <= d /\ (f z = y))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN + MP_TAC(SPECL [`f:real->real`; `x - d`; `x + d`] CONT_ATTAINS_ALL) THEN + ASM_REWRITE_TAC[INTERVAL_ABS; REAL_LE_SUB_RADD] THEN + ASM_REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_LE_ADDR; REAL_LE_DOUBLE] THEN + DISCH_THEN(X_CHOOSE_THEN `L:real` (X_CHOOSE_THEN `M:real` MP_TAC)) THEN + STRIP_TAC THEN + SUBGOAL_THEN `L <= f(x:real) /\ f(x) <= M` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]; ALL_TAC] THEN + SUBGOAL_THEN `L < f(x:real) /\ f(x:real) < M` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THENL + [DISCH_THEN SUBST_ALL_TAC THEN (MP_TAC o C SPECL CONT_INJ_LEMMA2) + [`f:real->real`; `g:real->real`; `x:real`; `d:real`]; + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN (MP_TAC o C SPECL CONT_INJ_LEMMA) + [`f:real->real`; `g:real->real`; `x:real`; `d:real`]] THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun t -> FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP th t] THEN + NO_TAC)); + MP_TAC(SPECL [`f(x:real) - L`; `M - f(x:real)`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM INTERVAL_ABS] THEN + REWRITE_TAC[REAL_LE_SUB_RADD] THEN ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `abs(y - f(x:real)) <= e` THEN + REWRITE_TAC[GSYM INTERVAL_ABS] THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) - e` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_LE_SUB_LADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_LE_SUB_LADD]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `f(x:real) + (M - f(x))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `f(x:real) + e` THEN + ASM_REWRITE_TAC[REAL_LE_LADD]; + REWRITE_TAC[REAL_SUB_ADD2; REAL_LE_REFL]]] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------ *) +(* Continuity of inverse function *) +(* ------------------------------------------------------------------------ *) + +let CONT_INVERSE = prove( + `!f g x d. &0 < d /\ + (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ + (!z. abs(z - x) <= d ==> f contl z) + ==> g contl (f x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[contl; LIM] THEN + X_GEN_TAC `a:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`a:real`; `d:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + IMP_RES_THEN ASSUME_TAC REAL_LT_IMP_LE THEN + SUBGOAL_THEN `!z. abs(z - x) <= e ==> (g(f z :real) = z)` ASSUME_TAC THENL + [X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!z. abs(z - x) <= e ==> (f contl z)` ASSUME_TAC THENL + [X_GEN_TAC `z:real` THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + UNDISCH_TAC `!z. abs(z - x) <= d ==> (g(f z :real) = z)` THEN + UNDISCH_TAC `!z. abs(z - x) <= d ==> (f contl z)` THEN + DISCH_THEN(K ALL_TAC) THEN DISCH_THEN(K ALL_TAC) THEN + (MP_TAC o C SPECL CONT_INJ_RANGE) + [`f:real->real`; `g:real->real`; `x:real`; `e:real`] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real` THEN BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC + (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN + REWRITE_TAC[GSYM ABS_NZ] THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> MP_TAC(SPEC `f(x:real) + h` th) THEN + REWRITE_TAC[REAL_ADD_SUB; ASSUME `abs(h) <= k`] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e:real` THEN + SUBGOAL_THEN `(g((f:real->real)(z)) = z) /\ (g(f(x)) = x)` + (fun t -> ASM_REWRITE_TAC[t]) THEN CONJ_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; ABS_0]);; + +(* ------------------------------------------------------------------------ *) +(* Differentiability of inverse function *) +(* ------------------------------------------------------------------------ *) + +let DIFF_INVERSE = prove( + `!f g l x d. &0 < d /\ + (!z. abs(z - x) <= d ==> (g(f(z)) = z)) /\ + (!z. abs(z - x) <= d ==> f contl z) /\ + (f diffl l)(x) /\ + ~(l = &0) + ==> (g diffl (inv l))(f x)`, + REPEAT STRIP_TAC THEN UNDISCH_TAC `(f diffl l)(x)` THEN + DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP DIFF_CONT th) THEN MP_TAC th) THEN + REWRITE_TAC[DIFF_CARAT] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\y. if y = f(x) then + inv(h(g y)) else (g(y) - g(f(x:real))) / (y - f(x))` THEN BETA_TAC THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + ASM_REWRITE_TAC[REAL_SUB_0]; + ALL_TAC; + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REPEAT AP_TERM_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_SUB_REFL; ABS_0] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[CONTL_LIM] THEN BETA_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `g((f:real->real)(x)) = x` ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_SUB_REFL; ABS_0] THEN + MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC `\y:real. inv(h(g(y):real))` THEN + BETA_TAC THEN CONJ_TAC THENL + [ALL_TAC; + (SUBST1_TAC o SYM o ONCE_DEPTH_CONV BETA_CONV) + `\y. inv((\y:real. h(g(y):real)) y)` THEN + MATCH_MP_TAC LIM_INV THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\y:real. h(g(y):real)) contl (f(x:real))` MP_TAC THENL + [MATCH_MP_TAC CONT_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONT_INVERSE THEN EXISTS_TAC `d:real`; + REWRITE_TAC[CONTL_LIM] THEN BETA_TAC] THEN + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `?e. &0 < e /\ + !y. &0 < abs(y - f(x:real)) /\ + abs(y - f(x:real)) < e ==> + (f(g(y)) = y) /\ ~(h(g(y)) = &0)` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + REWRITE_TAC[LIM] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + DISCH_THEN(fun th -> FIRST_ASSUM(STRIP_ASSUME_TAC o C MATCH_MP th) THEN + ASSUME_TAC(REWRITE_RULE[GSYM ABS_NZ; REAL_SUB_0] (CONJUNCT1 th))) THEN + BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN `y - f(x) = h(g(y)) * (g(y) - x)` SUBST1_TAC THENL + [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + REWRITE_TAC[ASSUME `f((g:real->real)(y)) = y`]; + UNDISCH_TAC `&0 < k` THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[ABS_ZERO; REAL_SUB_0]] THEN + SUBGOAL_THEN `~(g(y:real) - x = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN(MP_TAC o AP_TERM `f:real->real`) THEN + ASM_REWRITE_TAC[]; REWRITE_TAC[real_div]] THEN + SUBGOAL_THEN `inv((h(g(y))) * (g(y:real) - x)) = + inv(h(g(y))) * inv(g(y) - x)` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]]] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x)) < e ==> (f(g(y)) = y)` + (X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THENL + [MP_TAC(SPECL [`f:real->real`; `g:real->real`; `x:real`; `d:real`] + CONT_INJ_RANGE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real` THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(f:real->real)(z) = y` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !y. &0 < abs(y - f(x:real)) /\ abs(y - f(x)) < e + ==> ~((h:real->real)(g(y)) = &0)` + (X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THENL + [ALL_TAC; + MP_TAC(SPECL [`b:real`; `c:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN CONJ_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `e:real` THEN + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `(\y. h(g(y:real):real)) contl (f(x:real))` MP_TAC THENL + [MATCH_MP_TAC CONT_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONT_INVERSE THEN EXISTS_TAC `d:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `abs(l)`) THEN + ASM_REWRITE_TAC[GSYM ABS_NZ] THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[ABS_NZ] THEN X_GEN_TAC `y:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[ABS_NZ]) THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[GSYM ABS_NZ] THEN + CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_SUB_LZERO; ABS_NEG; REAL_LT_REFL]);; + +let DIFF_INVERSE_LT = prove( + `!f g l x d. &0 < d /\ + (!z. abs(z - x) < d ==> (g(f(z)) = z)) /\ + (!z. abs(z - x) < d ==> f contl z) /\ + (f diffl l)(x) /\ + ~(l = &0) + ==> (g diffl (inv l))(f x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_INVERSE THEN + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `d / &2` THEN + ASM_REWRITE_TAC[REAL_LT_HALF2]);; + +(* ------------------------------------------------------------------------- *) +(* Every derivative is Darboux continuous. *) +(* ------------------------------------------------------------------------- *) + +let IVT_DERIVATIVE_0 = prove + (`!f f' a b. + a <= b /\ + (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ + f'(a) > &0 /\ f'(b) < &0 + ==> ?z. a < z /\ z < b /\ (f'(z) = &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_gt] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_LE_LT] THEN + STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_ANTISYM]] THEN + SUBGOAL_THEN `?w. (!x. a <= x /\ x <= b ==> f x <= w) /\ + (?x. a <= x /\ x <= b /\ (f x = w))` + MP_TAC THENL + [MATCH_MP_TAC CONT_ATTAINS THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; DIFF_CONT]; ALL_TAC] THEN + DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `z:real` THEN ASM_CASES_TAC `z:real = a` THENL + [UNDISCH_THEN `z:real = a` SUBST_ALL_TAC THEN + MP_TAC(SPECL[`f:real->real`; `a:real`; `(f':real->real) a`] DIFF_LINC) THEN + ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d:real`; `b - a`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `!h. &0 < h /\ h < d ==> w < f (a + h)` THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ASM_SIMP_TAC[REAL_LE_ADDL; REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_CASES_TAC `z:real = b` THENL + [UNDISCH_THEN `z:real = b` SUBST_ALL_TAC THEN + MP_TAC(SPECL[`f:real->real`; `b:real`; `(f':real->real) b`] DIFF_LDEC) THEN + ASM_SIMP_TAC[REAL_LE_REFL; REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d:real`; `b - a`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `!h. &0 < h /\ h < d ==> w < f (b - h)` THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_NOT_LT] THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ASM_SIMP_TAC[REAL_LE_ADDL; REAL_LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN `a < z /\ z < b` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LMAX THEN + MP_TAC(SPECL [`z - a`; `b - z`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`f:real->real`; `z:real`] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + MAP_EVERY UNDISCH_TAC [`e + z < b`; `e + a < z`] THEN + REAL_ARITH_TAC);; + +let IVT_DERIVATIVE_POS = prove + (`!f f' a b y. + a <= b /\ + (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ + f'(a) > y /\ f'(b) < y + ==> ?z. a < z /\ z < b /\ (f'(z) = y)`, + REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x. f(x) - y * x`; `\x:real. f'(x) - y`; + `a:real`; `b:real`] IVT_DERIVATIVE_0) THEN + ASM_REWRITE_TAC[real_gt] THEN + ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN + ASM_REWRITE_TAC[REAL_EQ_SUB_RADD; REAL_ADD_LID] THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV o BINDER_CONV o RAND_CONV o + LAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + ASM_SIMP_TAC[DIFF_SUB; DIFF_X; DIFF_CMUL]);; + +let IVT_DERIVATIVE_NEG = prove + (`!f f' a b y. + a <= b /\ + (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ + f'(a) < y /\ f'(b) > y + ==> ?z. a < z /\ z < b /\ (f'(z) = y)`, + REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. --(f x)`; `\x:real. --(f' x)`; + `a:real`; `b:real`; `--y`] IVT_DERIVATIVE_POS) THEN + ASM_REWRITE_TAC[real_gt; REAL_LT_NEG2; REAL_EQ_NEG2] THEN + ASM_SIMP_TAC[DIFF_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Uniformly convergent sequence of continuous functions is continuous. *) +(* (Continuity at a point; uniformity in some neighbourhood of that point.) *) +(* ------------------------------------------------------------------------- *) + +let SEQ_CONT_UNIFORM = prove + (`!s f x0. (!e. &0 < e + ==> ?N d. &0 < d /\ + !x n. abs(x - x0) < d /\ n >= N + ==> abs(s n x - f(x)) < e) /\ + (?N:num. !n. n >= N ==> (s n) contl x0) + ==> f contl x0`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `M:num`)) THEN + REWRITE_TAC[CONTL_LIM; LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`N:num`; `d1:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN + REWRITE_TAC[CONTL_LIM; LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!fx sx fx0 sx0 e3. + abs(sx - fx) < e3 /\ abs(sx0 - fx0) < e3 /\ abs(sx - sx0) < e3 /\ + (&3 * e3 = e) + ==> abs(fx - fx0) < e`) THEN + MAP_EVERY EXISTS_TAC + [`(s:num->real->real) (M + N) x`; + `(s:num->real->real) (M + N) x0`; + `e / &3`] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + ASM_MESON_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_TRANS; + ARITH_RULE `M + N >= N:num`]);; + +(* ------------------------------------------------------------------------- *) +(* Comparison test gives uniform convergence of sum in a neighbourhood. *) +(* ------------------------------------------------------------------------- *) + +let SER_COMPARA_UNIFORM = prove + (`!s x0 g. + (?N d. &0 < d /\ + !n x. abs(x - x0) < d /\ n >= N + ==> abs(s x n) <= g n) /\ summable g + ==> ?f d. &0 < d /\ + !e. &0 < e + ==> ?N. !x n. abs(x - x0) < d /\ n >= N + ==> abs(sum(0,n) (s x) - f(x)) < e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!x. abs(x - x0) < d ==> ?y. (s x) sums y` MP_TAC THENL + [ASM_MESON_TAC[summable; SER_COMPAR]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real->real` THEN DISCH_TAC THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SER_CAUCHY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + EXISTS_TAC `M + N:num` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `n:num`] THEN STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE + `n >= M + N ==> n >= M /\ n >= N:num`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[sums; SEQ] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m + n:num`)) THEN + REWRITE_TAC[GE; LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + ONCE_REWRITE_TAC[GSYM SUM_TWO] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(snm) < e2 /\ (&2 * e2 = e) + ==> abs((sn + snm) - fx) < e2 ==> abs(sn - fx) < e`) THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(n,m) (\n. abs(s (x:real) n))` THEN + REWRITE_TAC[SUM_ABS_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum(n,m) g` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[GE; LE_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) < a ==> x < a`) THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A weaker variant matching the requirement for continuity of limit. *) +(* ------------------------------------------------------------------------- *) + +let SER_COMPARA_UNIFORM_WEAK = prove + (`!s x0 g. + (?N d. &0 < d /\ + !n x. abs(x - x0) < d /\ n >= N + ==> abs(s x n) <= g n) /\ summable g + ==> ?f. !e. &0 < e + ==> ?N d. &0 < d /\ + !x n. abs(x - x0) < d /\ n >= N + ==> abs(sum(0,n) (s x) - f(x)) < e`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SER_COMPARA_UNIFORM) THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* More convenient formulation of continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTL = prove + (`!f x. f contl x <=> + !e. &0 < e ==> ?d. &0 < d /\ !x'. abs(x' - x) < d + ==> abs(f(x') - f(x)) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTL_LIM; LIM] THEN + REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN + AP_TERM_TAC THEN ABS_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> ((a ==> b) <=> (a ==> c))`) THEN + DISCH_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; + +(* ------------------------------------------------------------------------- *) +(* Of course we also have this and similar results for sequences. *) +(* ------------------------------------------------------------------------- *) + +let CONTL_SEQ = prove + (`!f x l. f contl l /\ x tends_num_real l + + ==> (\n. f(x n)) tends_num_real f(l)`, + REWRITE_TAC[CONTL; SEQ] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Uniformity of continuity over closed interval. *) +(* ------------------------------------------------------------------------- *) + +let SUP_INTERVAL = prove + (`!P a b. + (?x. a <= x /\ x <= b /\ P x) + ==> ?s. a <= s /\ s <= b /\ + !y. y < s <=> (?x. a <= x /\ x <= b /\ P x /\ y < x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x. a <= x /\ x <= b /\ P x` REAL_SUP) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[ARITH_RULE `x <= b ==> x < b + &1`]; + ALL_TAC] THEN + ABBREV_TAC `s = sup (\x. a <= x /\ x <= b /\ P x)` THEN + REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `s:real` THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LTE_TRANS; REAL_NOT_LE; REAL_LT_ANTISYM]);; + +let CONT_UNIFORM = prove + (`!f a b. a <= b /\ (!x. a <= x /\ x <= b ==> f contl x) + ==> !e. &0 < e ==> ?d. &0 < d /\ + !x y. a <= x /\ x <= b /\ + a <= y /\ y <= b /\ + abs(x - y) < d + ==> abs(f(x) - f(y)) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\c. ?d. &0 < d /\ + !x y. a <= x /\ x <= c /\ + a <= y /\ y <= c /\ + abs(x - y) < d + ==> abs(f(x) - f(y)) < e` + SUP_INTERVAL) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN ANTS_TAC THENL + [EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_ARITH `abs(x - x) = &0`]; + ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?t. s < t /\ ?d. &0 < d /\ + !x y. a <= x /\ x <= t /\ a <= y /\ y <= t /\ + abs(x - y) < d ==> abs(f(x) - f(y)) < e` + MP_TAC THENL + [UNDISCH_TAC `!x. a <= x /\ x <= b ==> f contl x` THEN + DISCH_THEN(MP_TAC o SPEC `s:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CONTL_LIM; LIM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `&0 < d1 / &2 /\ d1 / &2 < d1` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_LT_LDIV_EQ; + REAL_ARITH `d < d * &2 <=> &0 < d`]; + ALL_TAC] THEN + SUBGOAL_THEN `!x y. abs(x - s) < d1 /\ abs(y - s) < d1 + ==> abs(f(x) - f(y)) < e` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e) + ==> abs(x - y) < e`) THEN + EXISTS_TAC `(f:real->real) s` THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + SUBGOAL_THEN `!x. abs(x - s) < d1 ==> abs(f x - f s) < e / &2` + (fun th -> ASM_MESON_TAC[th]) THEN + X_GEN_TAC `u:real` THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:real = s` THENL + [ASM_SIMP_TAC[REAL_SUB_REFL; REAL_ABS_NUM; REAL_LT_DIV; + REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + ASM_MESON_TAC[REAL_ARITH `&0 < abs(x - s) <=> ~(x = s)`]; + ALL_TAC] THEN + SUBGOAL_THEN `s - d1 / &2 < s` MP_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `x - y < x <=> &0 < y`]; + ALL_TAC] THEN + DISCH_THEN(fun th -> FIRST_ASSUM(fun th' -> + MP_TAC(GEN_REWRITE_RULE I [th'] th))) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d2:real`; `d1 / &2`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s + d / &2` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + REAL_ARITH `s < s + d <=> &0 < d`] THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `x <= r /\ y <= r` THENL + [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC(ASSUME + `!x y. abs(x - s) < d1 /\ abs(y - s) < d1 ==> abs(f x - f y) < e`) THEN + MATCH_MP_TAC(REAL_ARITH + `!r t d d12. + ~(x <= r /\ y <= r) /\ + abs(x - y) < d /\ + s - d12 < r /\ t <= s + d /\ + x <= t /\ y <= t /\ &2 * d12 <= e /\ + &2 * d < e ==> abs(x - s) < e /\ abs(y - s) < e`) THEN + MAP_EVERY EXISTS_TAC [`r:real`; `s + d / &2`; `d:real`; `d1 / &2`] THEN + ASM_REWRITE_TAC[REAL_LE_LADD] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> d <= d * &2`; REAL_LE_REFL]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` (CONJUNCTS_THEN ASSUME_TAC)) THEN + SUBGOAL_THEN `b <= t` (fun th -> ASM_MESON_TAC[REAL_LE_TRANS; th]) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + UNDISCH_THEN `!x. a <= x /\ x <= b ==> f contl x` (K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check(is_eq o concl) o SPEC `s:real`) THEN + REWRITE_TAC[REAL_LT_REFL] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_TAC THEN EXISTS_TAC `t:real` THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Slightly stronger version exploiting 2-sided continuity at ends. *) +(* ------------------------------------------------------------------------- *) + +let CONT_UNIFORM_STRONG = prove + (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) + ==> !e. &0 < e + ==> ?d. &0 < d /\ + !x y. (a <= x /\ x <= b \/ a <= y /\ y <= b) /\ + abs(x - y) < d + ==> abs(f(x) - f(y)) < e`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `a <= b` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_01]] THEN + FIRST_ASSUM(fun th -> + MP_TAC(SPEC `a:real` th) THEN MP_TAC(SPEC `b:real` th)) THEN + REWRITE_TAC[CONTL; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_UNIFORM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d3:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d0:real`; `d3:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [ASM_CASES_TAC `y <= b` THENL + [ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e) + ==> abs(x - y) < e`) THEN + EXISTS_TAC `(f:real->real) b` THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH + `x <= b /\ ~(y <= b) /\ abs(x - y) < d /\ d < d1 + ==> abs(x - b) < d1 /\ abs(y - b) < d1`]; + ASM_CASES_TAC `a <= x` THENL + [ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!a. abs(x - a) < e / &2 /\ abs(y - a) < e / &2 /\ (&2 * e / &2 = e) + ==> abs(x - y) < e`) THEN + EXISTS_TAC `(f:real->real) a` THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH + `~(a <= x) /\ a <= y /\ abs(x - y) < d /\ d < d1 + ==> abs(x - a) < d1 /\ abs(y - a) < d1`]]);; + +(* ------------------------------------------------------------------------- *) +(* Get rid of special syntax status of '-->'. *) +(* ------------------------------------------------------------------------- *) + +remove_interface "-->";; diff --git a/Library/binary.ml b/Library/binary.ml new file mode 100644 index 0000000..7489c07 --- /dev/null +++ b/Library/binary.ml @@ -0,0 +1,184 @@ +(* ========================================================================= *) +(* Binary expansions as a bijection between numbers and finite sets. *) +(* ========================================================================= *) + +let BINARY_INDUCT = prove + (`!P. P 0 /\ (!n. P n ==> P(2 * n) /\ P(2 * n + 1)) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN GEN_TAC THEN + STRIP_ASSUME_TAC(ARITH_RULE + `n = 0 \/ n DIV 2 < n /\ (n = 2 * n DIV 2 \/ n = 2 * n DIV 2 + 1)`) THEN + ASM_MESON_TAC[]);; + +let BOUNDED_FINITE = prove + (`!s. (!x:num. x IN s ==> x <= n) ==> FINITE s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + ASM_SIMP_TAC[SUBSET; IN_NUMSEG; FINITE_NUMSEG; LE_0]);; + +let EVEN_NSUM = prove + (`!s. FINITE s /\ (!i. i IN s ==> EVEN(f i)) ==> EVEN(nsum s f)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[NSUM_CLAUSES; ARITH; EVEN_ADD; IN_INSERT]);; + +(* ------------------------------------------------------------------------- *) +(* The basic bijections. *) +(* ------------------------------------------------------------------------- *) + +let bitset = new_definition + `bitset n = {i | ODD(n DIV (2 EXP i))}`;; + +let binarysum = new_definition + `binarysum s = nsum s (\i. 2 EXP i)`;; + +(* ------------------------------------------------------------------------- *) +(* Inverse property in one direction. *) +(* ------------------------------------------------------------------------- *) + +let BITSET_BOUND_LEMMA = prove + (`!n i. i IN (bitset n) ==> 2 EXP i <= n`, + REWRITE_TAC[bitset; IN_ELIM_THM] THEN MESON_TAC[DIV_LT; ODD; NOT_LE]);; + +let BITSET_BOUND_WEAK = prove + (`!n i. i IN (bitset n) ==> i < n`, + MESON_TAC[BITSET_BOUND_LEMMA; LT_POW2_REFL; LTE_TRANS]);; + +let FINITE_BITSET = prove + (`!n. FINITE(bitset n)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; SUBSET] THEN + MESON_TAC[LT_IMP_LE; BITSET_BOUND_WEAK]);; + +let BITSET_0 = prove + (`bitset 0 = {}`, + REWRITE_TAC[bitset; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN + SIMP_TAC[DIV_0; EXP_EQ_0; ARITH]);; + +let BITSET_STEP = prove + (`(!n. bitset(2 * n) = IMAGE SUC (bitset n)) /\ + (!n. bitset(2 * n + 1) = 0 INSERT (IMAGE SUC (bitset n)))`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ALL_TAC; DISCH_THEN(fun th -> REWRITE_TAC[GSYM th])] THEN + REWRITE_TAC[bitset; EXTENSION; IN_INSERT; IN_ELIM_THM; IN_IMAGE] THEN + GEN_TAC THEN MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[ARITH; ODD_MULT; DIV_1; NOT_SUC; ODD_ADD] THEN + GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[SUC_INJ; UNWIND_THM1; EXP] THEN + SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL DIV_DIV); + MULT_EQ_0; EXP_EQ_0; ARITH] THEN + REWRITE_TAC[ARITH_RULE `(2 * n + 1) DIV 2 = n /\ (2 * n) DIV 2 = n`]);; + +let BINARYSUM_BITSET = prove + (`!n. binarysum (bitset n) = n`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[binarysum] THEN + MATCH_MP_TAC BINARY_INDUCT THEN REWRITE_TAC[BITSET_0; NSUM_CLAUSES] THEN + SIMP_TAC[BITSET_STEP; NSUM_IMAGE; SUC_INJ; ADD1; FINITE_BITSET; ARITH; + NSUM_CLAUSES; FINITE_IMAGE; IN_IMAGE; ARITH_RULE `~(0 = x + 1)`] THEN + REWRITE_TAC[o_DEF; EXP; NSUM_LMUL] THEN + ASM_MESON_TAC[ADD_SYM; ARITH_RULE `~(2 * m = 0) ==> m < 2 * m`; + ARITH_RULE `m < SUC(2 * m)`]);; + +let BITSET_EQ = prove + (`!m n. bitset m = bitset n <=> m = n`, + MESON_TAC[BINARYSUM_BITSET]);; + +let BITSET_EQ_EMPTY = prove + (`!n. bitset n = {} <=> n = 0`, + MESON_TAC[BITSET_EQ; BITSET_0]);; + +(* ------------------------------------------------------------------------- *) +(* Inverse property in the other direction. *) +(* ------------------------------------------------------------------------- *) + +let BINARYSUM_BOUND_LEMMA = prove + (`!k s. (!i. i IN s ==> i < k) ==> nsum s (\i. 2 EXP i) < 2 EXP k`, + INDUCT_TAC THEN + SIMP_TAC[LT; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY; NSUM_CLAUSES; ARITH] THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN `FINITE(s:num->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[BOUNDED_FINITE; LE_LT]; ALL_TAC] THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `nsum (k INSERT (s DELETE k)) (\i. 2 EXP i)` THEN CONJ_TAC THENL + [MATCH_MP_TAC NSUM_SUBSET THEN SIMP_TAC[FINITE_INSERT; FINITE_DELETE]; + ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + REWRITE_TAC[EXP; ARITH_RULE `a + b < 2 * a <=> b < a `] THEN + FIRST_X_ASSUM MATCH_MP_TAC] THEN + ASM SET_TAC[]);; + +let BINARYSUM_DIV_DIVISIBLE = prove + (`!s k. FINITE s /\ (!i. i IN s ==> k <= i) + ==> nsum s (\i. 2 EXP i) = 2 EXP k * nsum s (\i. 2 EXP (i - k))`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NSUM_CLAUSES; DIV_0; EXP_EQ_0; ARITH_EQ; MULT_CLAUSES] THEN + SIMP_TAC[IN_INSERT; ADD_ASSOC; EQ_ADD_RCANCEL; LEFT_ADD_DISTRIB] THEN + SIMP_TAC[GSYM EXP_ADD; ARITH_RULE `i <= k:num ==> i + k - i = k`]);; + +let BINARYSUM_DIV = prove + (`!k s. FINITE s + ==> (nsum s (\j. 2 EXP j)) DIV (2 EXP k) = + nsum s (\j. if j < k then 0 else 2 EXP (j - k))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(nsum {i | i < k /\ i IN s} (\j. 2 EXP j) + + nsum {i | k <= i /\ i IN s} (\j. 2 EXP j)) DIV (2 EXP k)` THEN + CONJ_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC NSUM_UNION_EQ THEN + ASM_SIMP_TAC[EXTENSION; IN_INTER; IN_UNION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + CONJ_TAC THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC DIV_UNIQ THEN + EXISTS_TAC `nsum {i | i < k /\ i IN s} (\j. 2 EXP j)` THEN + SIMP_TAC[BINARYSUM_BOUND_LEMMA; IN_ELIM_THM] THEN + REWRITE_TAC[ARITH_RULE `a + x:num = y + a <=> x = y`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `2 EXP k * nsum {i | k <= i /\ i IN s} (\i. 2 EXP (i - k))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC BINARYSUM_DIV_DIVISIBLE THEN SIMP_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:num->bool` THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ARITH_EQ] THEN + ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_ADD; EXP_EQ_0; ARITH; IN_ELIM_THM] THEN + REWRITE_TAC[ARITH_RULE `(if p then 0 else q) = 0 <=> ~p ==> q = 0`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH; NOT_LT; CONJ_ACI] THEN + MATCH_MP_TAC NSUM_EQ THEN + SIMP_TAC[IN_ELIM_THM; ARITH_RULE `k <= j:num ==> ~(j < k)`]);; + +let BITSET_BINARYSUM = prove + (`!s. FINITE s ==> bitset (binarysum s) = s`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[bitset; binarysum; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN ASM_SIMP_TAC[BINARYSUM_DIV] THEN + ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `i IN s ==> s = i INSERT (s DELETE i)`)) THEN + ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + REWRITE_TAC[LT_REFL; SUB_REFL; ARITH; ODD_ADD]; + ALL_TAC] THEN + REWRITE_TAC[NOT_ODD] THEN MATCH_MP_TAC EVEN_NSUM THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[ARITH; EVEN_EXP; SUB_EQ_0] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[LE_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Also, bijections between restricted segments. *) +(* ------------------------------------------------------------------------- *) + +let BINARYSUM_BOUND = prove + (`!k s. (!i. i IN s ==> i < k) ==> binarysum s < 2 EXP k`, + REWRITE_TAC[BINARYSUM_BOUND_LEMMA; binarysum]);; + +let BITSET_BOUND = prove + (`!n i k. n < 2 EXP k /\ i IN bitset n ==> i < k`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `2 EXP i < 2 EXP k` MP_TAC THENL + [ASM_MESON_TAC[BITSET_BOUND_LEMMA; LET_TRANS]; + REWRITE_TAC[LT_EXP; ARITH]]);; + +let BITSET_BOUND_EQ = prove + (`!n k. n < 2 EXP k <=> (!i. i IN bitset n ==> i < k)`, + MESON_TAC[BINARYSUM_BOUND; BITSET_BOUND; BINARYSUM_BITSET]);; + +let BINARYSUM_BOUND_EQ = prove + (`!s k. FINITE s ==> (binarysum s < 2 EXP k <=> (!i. i IN s ==> i < k))`, + MESON_TAC[BINARYSUM_BOUND; BITSET_BOUND; BITSET_BINARYSUM]);; diff --git a/Library/binomial.ml b/Library/binomial.ml new file mode 100644 index 0000000..34f78a3 --- /dev/null +++ b/Library/binomial.ml @@ -0,0 +1,323 @@ +(* ========================================================================= *) +(* Binomial coefficients and the binomial theorem. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Binomial coefficients. *) +(* ------------------------------------------------------------------------- *) + +let binom = define + `(!n. binom(n,0) = 1) /\ + (!k. binom(0,SUC(k)) = 0) /\ + (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; + +let BINOM_0 = prove + (`!n. binom(0,n) = if n = 0 then 1 else 0`, + INDUCT_TAC THEN REWRITE_TAC[binom; NOT_SUC]);; + +let BINOM_LT = prove + (`!n k. n < k ==> (binom(n,k) = 0)`, + INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN + ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; + +let BINOM_REFL = prove + (`!n. binom(n,n) = 1`, + INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; + +let BINOM_1 = prove + (`!n. binom(n,1) = n`, + REWRITE_TAC[num_CONV `1`] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[binom] THEN ARITH_TAC);; + +let BINOM_FACT = prove + (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, + INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; + +let BINOM_EQ_0 = prove + (`!n k. binom(n,k) = 0 <=> n < k`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[BINOM_LT]] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_LT; LE_EXISTS] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + DISCH_TAC THEN MP_TAC(SYM(SPECL [`d:num`; `k:num`] BINOM_FACT)) THEN + ASM_REWRITE_TAC[GSYM LT_NZ; MULT_CLAUSES; FACT_LT]);; + +let BINOM_PENULT = prove + (`!n. binom(SUC n,n) = SUC n`, + INDUCT_TAC THEN ASM_REWRITE_TAC [binom; ONE; BINOM_REFL] THEN + SUBGOAL_THEN `binom(n,SUC n)=0` SUBST1_TAC THENL + [REWRITE_TAC [BINOM_EQ_0; LT]; REWRITE_TAC [ADD; ADD_0; ADD_SUC; SUC_INJ]]);; + +let BINOM_GE_TOP = prove + (`!m n. 1 <= m /\ m < n ==> n <= binom(n,m)`, + INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom] THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN ASM_CASES_TAC `m = 0` THEN + ASM_SIMP_TAC[BINOM_1; ARITH_SUC; binom] THEN REWRITE_TAC[ADD1; LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `~(c = 0) ==> n <= b ==> n + 1 <= c + b`) THEN + REWRITE_TAC[BINOM_EQ_0] THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* More potentially useful lemmas. *) +(* ------------------------------------------------------------------------- *) + +let BINOM_TOP_STEP = prove + (`!n k. ((n + 1) - k) * binom(n + 1,k) = (n + 1) * binom(n,k)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n < k:num` THENL + [FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP + (ARITH_RULE `n < k ==> n + 1 = k \/ n + 1 < k`)) THEN + ASM_SIMP_TAC[BINOM_LT; SUB_REFL; MULT_CLAUSES]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_LT; LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM ADD_ASSOC; ADD_SUB; ADD_SUB2] THEN + MP_TAC(SPECL [`d + 1`; `k:num`] BINOM_FACT) THEN + MP_TAC(SPECL [`d:num`; `k:num`] BINOM_FACT) THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; FACT; ADD_AC] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t FACT_LT)) [`d:num`; `k:num`] THEN + REWRITE_TAC[LT_NZ] THEN CONV_TAC NUM_RING);; + +let BINOM_BOTTOM_STEP = prove + (`!n k. (k + 1) * binom(n,k + 1) = (n - k) * binom(n,k)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n < k + 1` THENL + [FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP + (ARITH_RULE `n < k + 1 ==> n = k \/ n < k`)) THEN + ASM_SIMP_TAC[BINOM_LT; SUB_REFL; MULT_CLAUSES]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_LT; LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM ADD_ASSOC; ADD_SUB; ADD_SUB2] THEN + MP_TAC(SPECL [`d + 1`; `k:num`] BINOM_FACT) THEN + MP_TAC(SPECL [`d:num`; `k + 1`] BINOM_FACT) THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; FACT; ADD_AC] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t FACT_LT)) [`d:num`; `k:num`] THEN + REWRITE_TAC[LT_NZ] THEN CONV_TAC NUM_RING);; + +(* ------------------------------------------------------------------------- *) +(* Binomial expansion. *) +(* ------------------------------------------------------------------------- *) + +let BINOMIAL_THEOREM = prove + (`!n x y. + (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k))`, + INDUCT_TAC THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[EXP] THEN + REWRITE_TAC[NSUM_SING_NUMSEG; binom; SUB_REFL; EXP; MULT_CLAUSES] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; NSUM_OFFSET] THEN + ASM_REWRITE_TAC[EXP; binom; GSYM ADD1; GSYM NSUM_LMUL] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; NSUM_ADD_NUMSEG; MULT_CLAUSES; SUB_0] THEN + MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN + CONJ_TAC THENL [REWRITE_TAC[MULT_AC; SUB_SUC]; REWRITE_TAC[GSYM EXP]] THEN + SIMP_TAC[ADD1; SYM(REWRITE_CONV[NSUM_OFFSET]`nsum(m+1..n+1) (\i. f i)`)] THEN + REWRITE_TAC[NSUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0] THEN + SIMP_TAC[BINOM_LT; LT; MULT_CLAUSES; ADD_CLAUSES; SUB_0; EXP; binom] THEN + SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; EXP] THEN + REWRITE_TAC[MULT_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing for the reals. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let REAL_BINOMIAL_THEOREM = prove + (`!n x y. + (x + y) pow n = sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k))`, + INDUCT_TAC THEN REPEAT GEN_TAC THEN ASM_REWRITE_TAC[real_pow] THEN + REWRITE_TAC[SUM_SING_NUMSEG; binom; SUB_REFL; real_pow; REAL_MUL_LID] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; SUM_OFFSET] THEN + ASM_REWRITE_TAC[real_pow; binom; GSYM ADD1; GSYM SUM_LMUL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG; REAL_MUL_LID; SUB_0] THEN + MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN + CONJ_TAC THENL [SIMP_TAC[REAL_MUL_AC; SUB_SUC]; SIMP_TAC[GSYM real_pow]] THEN + SIMP_TAC[ADD1; SYM(REWRITE_CONV[SUM_OFFSET]`sum(m+1..n+1) (\i. f i)`)] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; BINOM_LT; LT; REAL_MUL_LID; SUB_0; real_pow; + binom; REAL_MUL_LZERO; REAL_ADD_RID] THEN + SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; real_pow] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* More direct stepping theorems over the reals. *) +(* ------------------------------------------------------------------------- *) + +let BINOM_TOP_STEP_REAL = prove + (`!n k. &(binom(n + 1,k)) = + if k = n + 1 then &1 + else (&n + &1) / (&n + &1 - &k) * &(binom(n,k))`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[BINOM_REFL] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE + `~(k = n + 1) ==> n < k /\ n + 1 < k \/ k <= n /\ k <= n + 1`)) THEN + ASM_SIMP_TAC[BINOM_LT; REAL_MUL_RZERO] THEN + MP_TAC(SPECL [`n:num`; `k:num`] BINOM_TOP_STEP) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_SUB] THEN + UNDISCH_TAC `k <= n:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + CONV_TAC REAL_FIELD);; + +let BINOM_BOTTOM_STEP_REAL = prove + (`!n k. &(binom(n,k+1)) = (&n - &k) / (&k + &1) * &(binom(n,k))`, + REPEAT GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n:num < k \/ k <= n`) THENL + [ASM_SIMP_TAC[BINOM_LT; ARITH_RULE `n < k ==> n < k + 1`; REAL_MUL_RZERO]; + MP_TAC(SPECL [`n:num`; `k:num`] BINOM_BOTTOM_STEP) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB] THEN + CONV_TAC REAL_FIELD]);; + +let REAL_OF_NUM_BINOM = prove + (`!n k. &(binom(n,k)) = + if k <= n then &(FACT n) / (&(FACT(n - k)) * &(FACT k)) + else &0`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[BINOM_LT; GSYM NOT_LE] THEN + SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; FACT_LT] THEN + FIRST_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[ADD_SUB2] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM BINOM_FACT] THEN REWRITE_TAC[REAL_OF_NUM_MUL; MULT_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Some additional theorems for stepping both arguments together. *) +(* ------------------------------------------------------------------------- *) + +let BINOM_BOTH_STEP_REAL = prove + (`!p k. &(binom(p + 1,k + 1)) = (&p + &1) / (&k + &1) * &(binom(p,k))`, + REWRITE_TAC[BINOM_TOP_STEP_REAL; BINOM_BOTTOM_STEP_REAL] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[EQ_ADD_RCANCEL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[BINOM_REFL] THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_EQ] THEN + CONV_TAC REAL_FIELD);; + +let BINOM_BOTH_STEP = prove + (`!p k. (k + 1) * binom(p + 1,k + 1) = (p + 1) * binom(p,k)`, + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[BINOM_BOTH_STEP_REAL; GSYM REAL_OF_NUM_ADD] THEN + CONV_TAC REAL_FIELD);; + +let BINOM_BOTH_STEP_DOWN = prove + (`!p k. (k = 0 ==> p = 0) ==> k * binom(p,k) = p * binom(p - 1,k - 1)`, + REPEAT INDUCT_TAC THEN + SIMP_TAC[BINOM_LT; LT_0; LT_REFL; ARITH] THEN + REWRITE_TAC[SUC_SUB1; ADD1; BINOM_BOTH_STEP] THEN + REWRITE_TAC[MULT_CLAUSES]);; + +let BINOM = prove + (`!n k. binom(n,k) = + if k <= n then FACT(n) DIV (FACT(n - k) * FACT(k)) + else 0`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[BINOM_EQ_0; GSYM NOT_LE] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + SIMP_TAC[LT_MULT; FACT_LT; ADD_CLAUSES] THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM BINOM_FACT; ADD_SUB] THEN REWRITE_TAC[MULT_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Additional lemmas. *) +(* ------------------------------------------------------------------------- *) + +let BINOM_SYM = prove + (`!n k. binom(n,n-k) = if k <= n then binom(n,k) else 1`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[binom; ARITH_RULE `~(k <= n) ==> n - k = 0`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; REAL_OF_NUM_BINOM] THEN + ASM_REWRITE_TAC[ARITH_RULE `n - k:num <= n`] THEN + ASM_SIMP_TAC[ARITH_RULE `k:num <= n ==> n - (n - k) = k`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; MULT_SYM]);; + +let BINOM_MUL_SHIFT = prove + (`!m n k. k <= m + ==> binom(n,m) * binom(m,k) = binom(n,k) * binom(n - k,m - k)`, + REPEAT STRIP_TAC THEN + SIMP_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_MUL; REAL_OF_NUM_BINOM] THEN + ASM_CASES_TAC `n:num < m` THENL + [REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]) THEN + MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC; + REPEAT(COND_CASES_TAC THENL + [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + ASM_SIMP_TAC[ARITH_RULE + `k:num <= m /\ m <= n ==> n - k - (m - k) = n - m`] THEN + MAP_EVERY (MP_TAC o C SPEC FACT_NZ) + [`n:num`; `m:num`; `n - m:num`; `n - k:num`; `m - k:num`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD]);; + +let APPELL_SEQUENCE = prove + (`!c n x y. sum (0..n) + (\k. &(binom(n,k)) * + sum(0..k) + (\l. &(binom(k,l)) * c l * x pow (k - l)) * + y pow (n - k)) = + sum (0..n) (\k. &(binom(n,k)) * c k * (x + y) pow (n - k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_BINOMIAL_THEOREM] THEN + REWRITE_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + EXISTS_TAC `(\(x,y). y,x - y):num#num->num#num` THEN + EXISTS_TAC `(\(x,y). x + y,x):num#num->num#num` THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ; IN_NUMSEG] THEN + CONJ_TAC THENL [ARITH_TAC; REPEAT GEN_TAC THEN STRIP_TAC] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + ASM_SIMP_TAC[ARITH_RULE + `j:num <= k /\ k <= n ==> (n - j) - (k - j) = n - k`] THEN + MATCH_MP_TAC(REAL_RING + `c * d:real = a * b ==> a * z * b * x * y = c * (d * z * x) * y`) THEN + ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; BINOM_MUL_SHIFT]);; + +(* ------------------------------------------------------------------------- *) +(* Numerical computation of binom. *) +(* ------------------------------------------------------------------------- *) + +let NUM_BINOM_CONV = + let pth_step = prove + (`binom(n,k) = y + ==> k <= n + ==> (SUC n) * y = ((n + 1) - k) * x ==> binom(SUC n,k) = x`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD1; GSYM BINOM_TOP_STEP; EQ_MULT_LCANCEL; SUB_EQ_0] THEN + ARITH_TAC) + and pth_0 = prove + (`n < k ==> binom(n,k) = 0`, + REWRITE_TAC[BINOM_LT]) + and pth_1 = prove + (`binom(n,n) = 1`, + REWRITE_TAC[BINOM_REFL]) + and pth_swap = prove + (`k <= n ==> binom(n,k) = binom(n,n - k)`, + MESON_TAC[BINOM_SYM]) + and k_tm = `k:num` and n_tm = `n:num` + and x_tm = `x:num` and y_tm = `y:num` + and binom_tm = `binom` in + let rec BINOM_RULE(n,k) = + if n + let bop,nkp = dest_comb tm in + if bop <> binom_tm then failwith "NUM_BINOM_CONV" else + let nt,kt = dest_pair nkp in + BINOM_RULE(dest_numeral nt,dest_numeral kt);; diff --git a/Library/calc_real.ml b/Library/calc_real.ml new file mode 100644 index 0000000..9c56e9a --- /dev/null +++ b/Library/calc_real.ml @@ -0,0 +1,2293 @@ +(* ========================================================================= *) +(* Calculation with real numbers (Boehm-style but by inference). *) +(* ========================================================================= *) + +needs "Library/transc.ml";; + +let REAL_SUB_SUM0 = prove + (`!x y m. sum(0,m) x - sum(0,m) y = sum(0,m) (\i. x i - y i)`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum] THEN + REAL_ARITH_TAC);; + +let REAL_MUL_RSUM0 = prove + (`!m c x. c * sum(0,m) x = sum(0,m) (\i. c * x(i))`, + INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; REAL_MUL_RZERO; REAL_ADD_LDISTRIB]);; + +let REAL_ABS_LEMMA = prove + (`!a b n. (&a pow n) * abs b = abs((&a pow n) * b)`, + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM]);; + +let REAL_ABS_LEMMA1 = prove + (`!a b. &a * abs b = abs(&a * b)`, + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM]);; + +let REAL_ABS_TRIANGLE_LEMMA = prove + (`!u x y z. abs(x - y) + abs(z - x) < u ==> abs(z - y) < u`, + REAL_ARITH_TAC);; +let REAL_MONO_POW2 = prove + (`!m n. m <= n ==> &2 pow m <= &2 pow n`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_LE_REFL] THEN + POP_ASSUM MP_TAC THEN MP_TAC(SPEC `m:num` REAL_LT_POW2) THEN + REAL_ARITH_TAC);; + +let REAL_LE_SUC_POW2 = prove + (`!m. &2 pow m + &1 <= &2 pow (SUC m)`, + GEN_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_2; REAL_LE_LADD; REAL_LE_POW2]);; + +let REAL_OPPSIGN_LEMMA = prove + (`!x y. (x * y < &0) <=> (x < &0 /\ &0 < y) \/ (&0 < x /\ y < &0)`, + REPEAT GEN_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `y:real` REAL_LT_NEGTOTAL) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + DISCH_THEN(fun th -> MP_TAC(MATCH_MP REAL_LT_MUL th) THEN MP_TAC th) THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + REAL_ARITH_TAC);; + +let REAL_OPPSIGN = prove + (`(&0 < x ==> &0 <= y) /\ (x < &0 ==> y <= &0) <=> &0 <= x * y`, + REWRITE_TAC[GSYM REAL_NOT_LT; REAL_OPPSIGN_LEMMA] THEN + REAL_ARITH_TAC);; + +let REAL_NDIV_LEMMA1a = prove + (`!a m n. &2 * abs(&2 pow m * &a - &2 pow (m + n)) <= &2 pow m + ==> (&a = &2 pow n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_POW_ADD; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_OF_NUM_POW] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`a:num`; `2 EXP n`] LT_CASES) THEN + ASM_REWRITE_TAC[] THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + POP_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LT_EXISTS]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `((a + b) - a = b) /\ (a - (a + b) = --b)`] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_NOT_LE; REAL_ABS_NUM] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_MUL_2; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ADD_ASSOC; REAL_LT_ADDL] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&(2 EXP m)` THEN + REWRITE_TAC[REAL_LT_POW2; GSYM REAL_OF_NUM_POW] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + c = b + (a + c)`] THEN + REWRITE_TAC[GSYM REAL_MUL_2; REAL_LE_ADDR] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]);; + +let REAL_NDIV_LEMMA1b = prove + (`!a m n. ~(&2 * abs(-- (&2 pow m * &a) - &2 pow (m + n)) <= &2 pow m)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub; GSYM REAL_NEG_ADD] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_POW_ADD] THEN + REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_ADD_LDISTRIB] THEN + SUBGOAL_THEN `&0 <= &a + &2 pow n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN + ASM_REWRITE_TAC[real_abs; REAL_NOT_LE] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(&2 * &2 pow m) * &1` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_RID; REAL_MUL_2] THEN + REWRITE_TAC[REAL_LT_ADDR; REAL_LT_POW2]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_POS]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow n` THEN + REWRITE_TAC[REAL_LE_POW2; REAL_LE_ADDL; REAL_POS]]]]);; + +let REAL_NDIV_LEMMA2 = prove + (`!a b m n. (?k. (b = &k) \/ (b = --(&k))) /\ + (abs(a) = &2 pow m) /\ + &2 * abs(a * b - &2 pow (m + n)) <= abs(a) + ==> (a * b = &2 pow (m + n))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISJ_CASES_THEN SUBST1_TAC (REAL_ARITH `(a = abs a) \/ (a = --(abs a))`) THEN + ASM_REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW; REAL_ABS_NUM; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_NDIV_LEMMA1b] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_NDIV_LEMMA1a) THEN + REWRITE_TAC[REAL_POW_ADD]);; + +let REAL_NDIV_LEMMA3 = prove + (`!a b m n. m <= n /\ + (?k. (b = &k) \/ (b = --(&k))) /\ + (abs(a) = &2 pow m) /\ + &2 * abs(a * b - &2 pow n) <= abs(a) + ==> (a * b = &2 pow n)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[REAL_NDIV_LEMMA2]);; + +(* ------------------------------------------------------------------------- *) +(* Surely there is already an efficient way to do this... *) +(* ------------------------------------------------------------------------- *) + +let log2 = (*** least p >= 0 with x <= 2^p ***) + let rec log2 x y = + if x log2 (x -/ Int 1) (Int 0);; + +(* ------------------------------------------------------------------------- *) +(* Theorems justifying the steps. *) +(* ------------------------------------------------------------------------- *) + +let REALCALC_DOWNGRADE = prove + (`(SUC d0 = d) ==> + (n + d = n0) ==> + abs(a - &2 pow n0 * x) < &1 ==> + abs((&2 pow d) * b - a) <= &2 pow d0 ==> + abs(b - &2 pow n * x) < &1`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REPEAT DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow (SUC d0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ABS_LEMMA; REAL_MUL_RID; REAL_SUB_LDISTRIB] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow d0 + &2 pow d0` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_ABS_TRIANGLE_LEMMA THEN EXISTS_TAC `a:real` THEN + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`d0:num`,`d0:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 + &1` THEN + REWRITE_TAC[REAL_MUL_2] THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[real_pow; GSYM REAL_MUL_2; REAL_LE_REFL]]]);; + +let REALCALC_INT = prove + (`abs((&2 pow n) * a - (&2 pow n) * a) < &1`, + REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0; REAL_LT_01]);; + +let REALCALC_NEG = prove + (`abs(a - (&2 pow n) * x) < &1 + ==> abs(--a - (&2 pow n) * --x) < &1`, + REWRITE_TAC[real_sub; GSYM REAL_NEG_ADD] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_MUL_RNEG]);; + +let REALCALC_ABS = prove + (`abs(a - &2 pow n * x) < &1 + ==> abs(abs(a) - &2 pow n * abs(x)) < &1`, + DISCH_TAC THEN REWRITE_TAC[REAL_ABS_LEMMA] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(a - (&2 pow n) * x)` THEN + ASM_REWRITE_TAC[REAL_ABS_SUB_ABS]);; + +let REALCALC_INV_LEMMA = prove + (`(?m. (b = &m) \/ (b = --(&m))) /\ + (?m. (a = &m) \/ (a = --(&m))) /\ + SUC(n + k) <= (2 * e) /\ + &2 pow e <= abs(a) /\ + abs(a - &2 pow k * x) < &1 /\ + &2 * abs(a * b - &2 pow (n + k)) <= abs(a) + ==> abs(b - &2 pow n * inv(x)) < &1`, + let lemma1 = REAL_ARITH + `!x y z b. &2 * abs(x - y) <= b /\ &2 * abs(y - z) < b + ==> &2 * abs(x - z) < &2 * b` in + let lemma2 = REAL_ARITH + `!x y z. x + &1 <= abs(z) /\ abs(z - y) < &1 ==> x <= abs(y)` in + let lemma3 = REAL_ARITH + `(abs(x) <= &1 /\ &0 < abs(y) /\ abs(y) < &1) /\ + (&0 < x ==> &0 <= y) /\ (x < &0 ==> y <= &0) + ==> abs(x - y) < &1` in + let lemma4 = REAL_ARITH + `!a b c. c <= abs(a) + abs(b) /\ abs(a - b) < c ==> + (&0 < a ==> &0 <= b) /\ (a < &0 ==> b <= &0)` in + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `~(a = &0)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `&2 pow e <= abs(&0)` THEN + REWRITE_TAC[REAL_ABS_0; GSYM REAL_NOT_LT; REAL_LT_POW2]; ALL_TAC] THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `abs(a - &2 pow k * &0) < &1` THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow e` THEN + ASM_REWRITE_TAC[REAL_LE_POW2]; ALL_TAC] THEN + SUBGOAL_THEN `(&2 pow e + &1 <= abs(a)) \/ (&2 pow e = abs(a))` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_POW] THEN + FIRST_ASSUM(CHOOSE_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_ABS_NEG; REAL_ABS_NUM]) THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM ADD1; LE_SUC_LT; GSYM LE_LT] THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_POW]; + UNDISCH_TAC `&2 pow e <= abs(a)` THEN DISCH_THEN(K ALL_TAC)] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `&2 * abs(a)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN + MATCH_MP_TAC lemma1 THEN EXISTS_TAC `&2 pow (n + k)` THEN + ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN + EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&2 * abs(&2 pow n) * &1` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_POW_EQ_0] THEN + CONV_TAC(RAND_CONV(LAND_CONV REAL_INT_EQ_CONV)) THEN REWRITE_TAC[]; + REWRITE_TAC[REAL_SUB_RDISTRIB] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_RINV th]) THEN + ASM_REWRITE_TAC[REAL_MUL_LID]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2 pow k` THEN + REWRITE_TAC[REAL_LT_POW2; REAL_MUL_RID; REAL_ABS_LEMMA] THEN + ONCE_REWRITE_TAC + [AC REAL_MUL_AC `a * b * c = (a * c) * b`] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 pow e * &2 pow e` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC + [AC REAL_MUL_AC `(a * b) * c = c * b * a`] THEN + REWRITE_TAC[GSYM REAL_POW_ADD; GSYM(CONJUNCT2 real_pow)] THEN + MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[GSYM MULT_2]; + MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; + REWRITE_TAC[REAL_ABS_LEMMA] THEN MATCH_MP_TAC lemma2 THEN + EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow e + &1` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]; + + DISCH_TAC THEN + DISJ_CASES_TAC (SPECL [`e:num`; `n + k:num`] LET_CASES) THENL + [SUBGOAL_THEN `a * b = &2 pow (n + k)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_NDIV_LEMMA3 THEN + EXISTS_TAC `e:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(a)` THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; GSYM REAL_ABS_MUL] THEN + ASM_REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN + REWRITE_TAC[REAL_POW_ADD; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(x = &0)`)] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow n * &1` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + ASM_REWRITE_TAC[REAL_LT_POW2; REAL_MUL_RID]; + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `&2 pow (SUC k)` THEN + REWRITE_TAC[REAL_MUL_RID; REAL_LT_POW2]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 pow (2 * e)` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_POW_ADD; ADD_CLAUSES] THEN + MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[]; + SUBST1_TAC(SYM(ASSUME `&2 pow e = abs(a)`)) THEN + REWRITE_TAC[MULT_2; REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE (SPEC_ALL REAL_LT_POW2)]] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[real_pow] THEN + SUBGOAL_THEN `?d. e = SUC d` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [UNDISCH_TAC `SUC (n + k) <= (2 * e)` THEN + SPEC_TAC(`e:num`,`e:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LE; NOT_SUC] THEN + REWRITE_TAC[SUC_INJ; GSYM EXISTS_REFL]; + REWRITE_TAC[real_pow; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 pow (SUC d) - &1` THEN + REWRITE_TAC[REAL_LE_SUB_RADD; REAL_LE_SUB_LADD] THEN + REWRITE_TAC[REAL_LE_SUC_POW2] THEN + SUBGOAL_THEN `abs(abs a - &2 pow k * abs(x)) < &1` MP_TAC THENL + [REWRITE_TAC[REAL_ABS_LEMMA] THEN + MATCH_MP_TAC(REAL_LET_IMP REAL_ABS_SUB_ABS) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]; + + SUBGOAL_THEN `abs(b) <= &1 /\ &0 <= a * b` STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `b = &0` THEN + ASM_REWRITE_TAC[REAL_ABS_0; REAL_MUL_RZERO; REAL_POS] THEN + SUBGOAL_THEN `abs(a) <= abs(a * b)` ASSUME_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + SUBGOAL_THEN `?q. abs(b) = &q` CHOOSE_TAC THENL + [UNDISCH_TAC `?m. (b = &m) \/ (b = --(&m))` THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` DISJ_CASES_TAC) THEN + EXISTS_TAC `p:num` THEN + ASM_REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM]; + UNDISCH_TAC `~(b = &0)` THEN ASM_REWRITE_TAC[REAL_ABS_NZ] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + REWRITE_TAC[SYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN + REWRITE_TAC[LE_SUC_LT]]; + ALL_TAC] THEN + SUBGOAL_THEN `abs(a * b) <= abs(a) /\ &0 <= a * b` ASSUME_TAC THENL + [MP_TAC(SPEC `(n:num) + k` REAL_LT_POW2) THEN + UNDISCH_TAC `&2 * abs(a * b - &2 pow (n + k)) <= abs a` THEN + UNDISCH_TAC `abs(a) <= abs(a * b)` THEN + SUBGOAL_THEN `~(a * b = &0)` MP_TAC THENL + [ASM_REWRITE_TAC[REAL_ENTIRE]; ALL_TAC] THEN + SUBGOAL_THEN `&2 * &2 pow (n + k) <= abs(a)` MP_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[LE_SUC_LT]; + REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `abs(a)` THEN ASM_REWRITE_TAC + [GSYM REAL_ABS_NZ; GSYM REAL_ABS_MUL; REAL_MUL_RID]]; + ALL_TAC] THEN + MATCH_MP_TAC lemma3 THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_ENTIRE; REAL_INV_EQ_0] THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN REWRITE_TAC[REAL_LT_POW2]; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(x)` THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; GSYM REAL_ABS_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * c * a`] THEN + SUBGOAL_THEN `inv(x) * x = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow k` THEN + REWRITE_TAC[REAL_LT_POW2; REAL_ABS_LEMMA] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&2 pow (SUC(n + k)) - &1` THEN + REWRITE_TAC[REAL_LT_SUB_RADD; REAL_LE_SUB_LADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_LE_SUC_POW2; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 pow e` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MONO_POW2 THEN + ASM_REWRITE_TAC[LE_SUC_LT]; + UNDISCH_TAC `abs(a - &2 pow k * x) < &1` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]]; + SUBGOAL_THEN `&0 <= b * (&2 pow n * inv x)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `a * a` THEN ASM_REWRITE_TAC[REAL_LT_SQUARE] THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * c * d = (a * c) * (b * d)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `x * x` THEN ASM_REWRITE_TAC[REAL_LT_SQUARE] THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * c * d * e = d * (e * a) * c * b`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE (SPEC_ALL REAL_LT_POW2)] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) + [MATCH_MP REAL_MUL_LINV th]) THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2 pow k` THEN + REWRITE_TAC[REAL_LT_POW2; REAL_MUL_RZERO; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * (a * c)`] THEN + ONCE_REWRITE_TAC[GSYM REAL_OPPSIGN] THEN + MATCH_MP_TAC lemma4 THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(a)` THEN CONJ_TAC THENL + [UNDISCH_TAC `?m. (a = & m) \/ (a = -- (& m))` THEN + DISCH_THEN(CHOOSE_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN + REWRITE_TAC[SYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN + REWRITE_TAC[LE_SUC_LT] THEN RULE_ASSUM_TAC + (REWRITE_RULE[REAL_ARITH `(--x = &0) = (x = &0)`]) THEN + UNDISCH_TAC `~(&m = &0)` THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LT; LE]; + REWRITE_TAC[REAL_LE_ADDR; REAL_ABS_POS]]; + REWRITE_TAC[REAL_OPPSIGN]]]]]);; + +let REALCALC_INV = prove + (`abs(a - &2 pow k * x) < &1 ==> + (?m. (a = &m) \/ (a = --(&m))) ==> + (?m. (b = &m) \/ (b = --(&m))) ==> + SUC(n + k) <= (2 * e) ==> + &2 pow e <= abs(a) ==> + &2 * abs(a * b - &2 pow (n + k)) <= abs(a) + ==> abs(b - &2 pow n * inv(x)) < &1`, + REPEAT DISCH_TAC THEN MATCH_MP_TAC REALCALC_INV_LEMMA THEN + ASM_REWRITE_TAC[]);; + +let REALCALC_ADD = prove + (`(n + 2 = n') ==> + abs(a - &2 pow n' * x) < &1 ==> + abs(b - &2 pow n' * y) < &1 ==> + abs(&4 * c - (a + b)) <= &2 + ==> abs(c - &2 pow n * (x + y)) < &1`, + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REPEAT DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `&2 pow 2` THEN + CONV_TAC(LAND_CONV REAL_INT_REDUCE_CONV) THEN + REWRITE_TAC[REAL_ABS_LEMMA; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + SUBST1_TAC(REAL_INT_REDUCE_CONV `&2 pow 2`) THEN + MATCH_MP_TAC REAL_ABS_TRIANGLE_LEMMA THEN + EXISTS_TAC `a + b` THEN + GEN_REWRITE_TAC RAND_CONV [SYM(REAL_INT_REDUCE_CONV `&2 + &2`)] THEN + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC + [REAL_ARITH `(x + y) - a * (u + v) = (x - a * u) + (y - a * v)`] THEN + GEN_REWRITE_TAC RAND_CONV [SYM(REAL_INT_REDUCE_CONV `&1 + &1`)] THEN + MATCH_MP_TAC(REAL_LET_IMP REAL_ABS_TRIANGLE) THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]);; + +let REALCALC_MUL = prove + (`abs(a - &2 pow k * x) < &1 ==> + abs(b - &2 pow l * y) < &1 ==> + (n + m = k + l) ==> + &2 * (abs(a) + abs(b) + &1) <= &2 pow m ==> + &2 * abs(&2 pow m * c - a * b) <= &2 pow m + ==> abs(c - &2 pow n * (x * y)) < &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 pow m` THEN + REWRITE_TAC[REAL_LT_POW2; REAL_ABS_LEMMA; REAL_SUB_LDISTRIB] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2` THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN + REWRITE_TAC[REAL_MUL_RID] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_2] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&2 * abs(&2 pow m * c - a * b) + + &2 * abs(a * b - &2 pow m * &2 pow n * x * y)` THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_ADD2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `((a * b) * c) * d = (a * c) * (b * d)`] THEN + SUBGOAL_THEN `?d. abs(d) < &1 /\ (&2 pow k * x = a + d)` MP_TAC THENL + [EXISTS_TAC `&2 pow k * x - a` THEN + UNDISCH_TAC `abs(a - &2 pow k * x) < &1` THEN REAL_ARITH_TAC; + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))] THEN + SUBGOAL_THEN `?e. abs(e) < &1 /\ (&2 pow l * y = b + e)` MP_TAC THENL + [EXISTS_TAC `&2 pow l * y - b` THEN + UNDISCH_TAC `abs(b - &2 pow l * y) < &1` THEN REAL_ARITH_TAC; + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&2 * (abs(a) * &1 + abs(b) * &1 + &1 * &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(a) * abs(e) + abs(b) * abs(d) + abs(d) * abs(e)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]]]]; + ASM_REWRITE_TAC[REAL_MUL_RID]]);; + +(* ------------------------------------------------------------------------- *) +(* Square root. *) +(* ------------------------------------------------------------------------- *) + +let REALCALC_SQRT = prove + (`abs(a - &2 pow n * x) < &1 + ==> &1 <= x + ==> abs(b pow 2 - &2 pow n * a) <= b + ==> abs(b - &2 pow n * sqrt(x)) < &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `abs(b + &2 pow n * sqrt(x))` THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `!z. abs(z) <= b /\ &0 < c ==> &0 < abs(b + c)`) THEN + EXISTS_TAC `b pow 2 - &2 pow n * a` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_LT_MUL; + SQRT_POS_LT; REAL_ARITH `&1 <= x ==> &0 < x`]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a + b) * (a - b) = a * a - b * b`] THEN + MATCH_MP_TAC(REAL_ARITH + `!c d. abs(b - c) <= d /\ abs(c - a) < e - d + ==> abs(b - a) < e`) THEN + MAP_EVERY EXISTS_TAC [`&2 pow n * a`; `b:real`] THEN + ASM_REWRITE_TAC[GSYM REAL_POW_2] THEN + REWRITE_TAC[REAL_POW_2; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `a < c ==> a < abs(b + c) - b`) THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; GSYM POW_2; SQRT_POW_2; + REAL_ARITH `&1 <= x ==> &0 <= x`] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `&1 <= x ==> &0 <= x`)) THEN + UNDISCH_TAC `&1 <= x` THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN `x = sqrt(x) pow 2` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[SQRT_POW2]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[POW_2] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN + ASM_SIMP_TAC[SQRT_POS_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas common to all the Taylor series error analyses. *) +(* ------------------------------------------------------------------------- *) + +let STEP_LEMMA1 = prove + (`!a b c d x y. + abs(a - c) <= x /\ abs(b - d) <= y + ==> abs(a * b - c * d) <= abs(c) * y + abs(d) * x + x * y`, + REPEAT GEN_TAC THEN + ABBREV_TAC `u = a - c` THEN ABBREV_TAC `v = b - d` THEN + SUBGOAL_THEN `a = c + u` SUBST1_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `b = d + v` SUBST1_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN SUBST1_TAC + (REAL_ARITH `(c + u) * (d + v) - c * d = c * v + d * u + u * v`) THEN + REPEAT(MATCH_MP_TAC (REAL_LE_IMP REAL_ABS_TRIANGLE) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN + REWRITE_TAC[REAL_ABS_MUL] THENL + [MATCH_MP_TAC REAL_LE_LMUL; + MATCH_MP_TAC REAL_LE_LMUL; + MATCH_MP_TAC REAL_LE_MUL2] THEN + ASM_REWRITE_TAC[REAL_ABS_POS]);; + +let STEP_LEMMA2 = prove + (`!n s t u x y k l a d. + &0 < a /\ + &0 < d /\ + abs(s - &2 pow n * x) <= k /\ + abs(t - &2 pow n * y) <= l /\ + &2 * abs(u * &2 pow n * d - a * s * t) <= &2 pow n * d + ==> abs(u - &2 pow n * (a / d) * (x * y)) <= + (a / d) * (abs(x) + k / (&2 pow n)) * l + + ((a / d) * k * abs(y) + &1 / &2)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN + (CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP STEP_LEMMA1) ASSUME_TAC) THEN + SUBGOAL_THEN `&0 < &2 * &2 pow n * d` ASSUME_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_LT_POW2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `&2 * &2 pow n * d` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_ADD_LDISTRIB; REAL_ADD_RDISTRIB] THEN + SUBGOAL_THEN + `!z. (&2 * &2 pow n * d) * abs(z) = abs((&2 * &2 pow n * d) * z)` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN AP_THM_TAC THEN + AP_TERM_TAC THEN UNDISCH_TAC `&0 < &2 * &2 pow n * d` THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + (MATCH_MP_TAC o GEN_ALL o REAL_ARITH) + `abs(a - b) + abs(b - c) <= d ==> abs(a - c) <= d` THEN + EXISTS_TAC `&2 * a * s * t` THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_ADD_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ADD_SYM] THEN + SUBGOAL_THEN `(inv(&2) * &2 = &1) /\ + (inv(&2 pow n) * &2 pow n = &1) /\ + (inv(d) * d = &1)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_POW_EQ_0] THEN + UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ABS_LEMMA1] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV o LAND_CONV) + [REAL_MUL_SYM] THEN ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + + REWRITE_TAC(map (GSYM o SPEC `&2`) + [REAL_SUB_LDISTRIB; REAL_ADD_LDISTRIB]) THEN + REWRITE_TAC[GSYM REAL_ABS_LEMMA1] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [AC REAL_MUL_AC + `a * b * c * d * e * f * g = d * (a * f) * (c * g) * (e * b)`] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) + [AC REAL_MUL_AC + `a * b * c * d * e * f = c * (a * e) * f * (d * b)`] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) + [AC REAL_MUL_AC + `a * b * c * d * e * f * g = c * (e * g) * (f * a) * (d * b)`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [AC REAL_MUL_AC + `a * b * c * d * e * f = c * (a * f) * e * (d * b)`] THEN + GEN_REWRITE_TAC RAND_CONV + [AC REAL_ADD_AC `(a + b) + c = a + c + b`] THEN + ASM_REWRITE_TAC[REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(a) = a` SUBST1_TAC THENL + [UNDISCH_TAC `&0 < a` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_ABS_LEMMA] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Now specific instances. *) +(* ------------------------------------------------------------------------- *) + +let STEP_EXP = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) <= &1 /\ + abs(t - &2 pow n * (x pow i / &(FACT i))) <= k /\ + &2 * abs(u * &2 pow n * &(SUC i) - s * t) <= &2 pow n * &(SUC i) + ==> abs(u - &2 pow n * (x pow (SUC i)) / &(FACT(SUC i))) <= + (&2 / &(SUC i)) * k + &1 / &(FACT(SUC i)) + &1 / &2`, + STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; + `x:real`; `x pow i / &(FACT i)`; + `&1`; `k:real`; `&1`; `&(SUC i)`] STEP_LEMMA2) THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN + REWRITE_TAC[FACT; real_div; GSYM REAL_OF_NUM_MUL; real_pow] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_AC]; + REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_OF_NUM_LE; LE_0]; + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &1 + &1`] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_LE_POW2]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(t - &2 pow n * (x pow i / &(FACT i)))` THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]; + REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(a) <= a`) THEN + MATCH_MP_TAC REAL_LE_INV THEN + REWRITE_TAC[REAL_OF_NUM_LE; LE_0]]]]]);; + +let STEP_SIN = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * --(x pow 2)) <= &1 /\ + abs(t - &2 pow n * + x pow (2 * i + 1) / &(FACT (2 * i + 1))) + <= &1 /\ + &2 * abs(u * &2 pow n * &(2 * i + 2) * &(2 * i + 3) + - s * t) + <= &2 pow n * &(2 * i + 2) * &(2 * i + 3) + ==> abs(u - &2 pow n * + --(x pow (2 * (SUC i) + 1)) / + &(FACT (2 * (SUC i) + 1))) <= &1`, + STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; + `--(x pow 2)`; + `x pow (2 * i + 1) / + &(FACT(2 * i + 1))`; + `&1`; `&1`; `&1`; + `&(2 * i + 2) * &(2 * i + 3)`] + STEP_LEMMA2) THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN W(C SUBGOAL_THEN + (fun th -> REWRITE_TAC[th]) o funpow 2 (fst o dest_imp) o snd) THENL + [REWRITE_TAC(map num_CONV [`3`; `2`; `1`]) THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; LT_0]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN + `2 * (SUC i) + 1 = SUC(SUC(2 * i + 1))` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [GSYM REAL_OF_NUM_EQ] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + REWRITE_TAC[real_pow; FACT] THEN + REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN + REWRITE_TAC[ARITH] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_OF_NUM_MUL; + GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_AC]]; + GEN_REWRITE_TAC RAND_CONV + [SYM(REAL_RAT_REDUCE_CONV `&1 / &3 + &1 / &6 + &1 / &2`)] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN + SUBGOAL_THEN `&1 / (&(2 * i + 2) * &(2 * i + 3)) + <= &1 / &6` ASSUME_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&6 = &2 * &3`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC LE_MULT2 THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[LE_ADD]; ALL_TAC] THEN + REWRITE_TAC[SYM(REAL_RAT_REDUCE_CONV `&1 / &6 * &2`)] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_POS]; + MATCH_MP_TAC REAL_LE_ADD THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_ADD THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; + REWRITE_TAC[REAL_MUL_RID]] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &1 + &1`] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_LE_POW2]]; + REWRITE_TAC[real_div; REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + REWRITE_TAC[REAL_OF_NUM_LE; FACT_LE]]]]);; + +let STEP_COS = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * --(x pow 2)) <= &1 /\ + abs(t - &2 pow n * + x pow (2 * i) / &(FACT (2 * i))) + <= k /\ + &2 * abs(u * &2 pow n * &(2 * i + 1) * &(2 * i + 2) + - s * t) + <= &2 pow n * &(2 * i + 1) * &(2 * i + 2) + ==> abs(u - &2 pow n * + --(x pow (2 * (SUC i))) / + &(FACT (2 * (SUC i)))) + <= (&2 * inv(&(2 * i + 1) * &(2 * i + 2))) * k + + inv(&(FACT(2 * i + 2))) + &1 / &2`, + STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; + `--(x pow 2)`; + `x pow (2 * i) / + &(FACT(2 * i))`; + `&1`; `k:real`; `&1`; + `&(2 * i + 1) * &(2 * i + 2)`] + STEP_LEMMA2) THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN W(C SUBGOAL_THEN + (fun th -> REWRITE_TAC[th]) o funpow 2 (fst o dest_imp) o snd) THENL + [REWRITE_TAC(map num_CONV [`3`; `2`; `1`]) THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LT] THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; LT_0]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN SUBGOAL_THEN + `2 * (SUC i) = SUC(SUC(2 * i))` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [GSYM REAL_OF_NUM_EQ] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + REWRITE_TAC[real_pow; FACT] THEN + REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN + REWRITE_TAC[ARITH] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_OF_NUM_MUL; + GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_AC]]; + + REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_POS]; + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `&2 = &1 + &1`] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_LE_POW2]]]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `abs(t - &2 pow n * x pow (2 * i) / &(FACT (2 * i)))` THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]; + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_MUL; REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * c * d = (d * a * b) * c`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + REWRITE_TAC[REAL_POS; REAL_ABS_POS; REAL_LE_INV_EQ]; + REWRITE_TAC[REAL_ABS_INV] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; ADD_CLAUSES] THEN + REWRITE_TAC[SYM(num_CONV `2`); SYM(num_CONV `1`)] THEN + REWRITE_TAC[FACT; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[MULT_AC]; + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_1_LE THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]]]);; + +let STEP_LN = prove + (`2 <= n /\ + abs(x) <= &1 / &2 /\ + abs(s - &2 pow n * --x) <= &1 /\ + abs(t - &2 pow n * -- ((--x) pow (SUC i) / &(SUC i))) <= &3 /\ + &2 * abs(u * &2 pow n * &(SUC(SUC i)) - &(SUC i) * s * t) + <= &2 pow n * &(SUC(SUC i)) + ==> abs(u - &2 pow n * -- ((--x) pow (SUC(SUC i)) / &(SUC(SUC i)))) <= &3`, + STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `s:real`; `t:real`; `u:real`; + `--x`; + `-- (--x pow (SUC i) / &(SUC i))`; + `&1`; `&3`; + `&(SUC i)`; + `&(SUC(SUC i))`] + STEP_LEMMA2) THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN + MATCH_MP_TAC(REAL_ARITH `(a = b) /\ c <= d ==> a <= c ==> b <= d`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SUBGOAL_THEN `inv(&(SUC i)) * &(SUC i) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; + ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_AC]]; + GEN_REWRITE_TAC RAND_CONV [SYM(REAL_RAT_REDUCE_CONV + `(&1 / &2 + &1 / &4) * &3 + &1 / &4 + &1 / &2`)] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_LE_RADD] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + CONV_TAC(RAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN + EXISTS_TAC `&(SUC(SUC i))` THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_OF_NUM_LT; LT_0] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC(REAL_ARITH `(x = &1) ==> &0 <= x`) THEN + MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN + EXISTS_TAC `&(SUC(SUC i))` THEN + REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[REAL_OF_NUM_LE; LE] THEN + MATCH_MP_TAC(REAL_ARITH `(x = &1) ==> &0 <= x /\ x <= &1`) THEN + MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; + MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[REAL_ABS_NEG] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + SUBST1_TAC(SYM(REAL_INT_REDUCE_CONV `&2 pow 2`)) THEN + MATCH_MP_TAC REAL_MONO_POW2 THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_INV] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_NUM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(&(SUC i)) * &(SUC i) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; + GEN_REWRITE_TAC RAND_CONV + [EQT_ELIM(REAL_RAT_REDUCE_CONV `inv(&4) = inv(&2) * inv(&2)`)] THEN + ASM_REWRITE_TAC[REAL_MUL_RID; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC + [REAL_POS; REAL_ABS_POS; REAL_LE_INV_EQ; GSYM REAL_ABS_POW] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + MP_TAC(SPEC `i:num` REAL_POS) THEN REAL_ARITH_TAC; + REWRITE_TAC[real_pow; REAL_ABS_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS] THEN + REPEAT CONJ_TAC THENL + [CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_POW_1_LE THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 / &2` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Expand the "!k. SUC k < r ==> P k" term for given numeral r. *) +(* ------------------------------------------------------------------------- *) + +let EXPAND_RANGE_CONV = + let pth0 = prove + (`(!k. SUC k < 0 ==> P k) <=> T`, + REWRITE_TAC[LT]) + and pth1 = prove + (`(!k. k < (SUC m) ==> P k) <=> + (!k. k < m ==> P k) /\ P m`, + REWRITE_TAC[LT] THEN MESON_TAC[]) + and pth2 = prove + (`(!k. k < 0 ==> P k) <=> T`, + REWRITE_TAC[LT]) in + let triv_conv = GEN_REWRITE_CONV I [pth0] + and trivial_conv = GEN_REWRITE_CONV I [pth2] + and nontrivial_conv = GEN_REWRITE_CONV I [pth1] in + let s_tm = `s:real` + and m_tm = `m:num` + and n_tm = `n:num` in + let rec expand_conv tm = + try trivial_conv tm + with Failure _ -> + let mth = num_CONV(rand(lhand(body(rand tm)))) in + let th1 = BINDER_CONV(LAND_CONV(RAND_CONV(K mth))) tm in + let th2 = TRANS th1 (nontrivial_conv (rand(concl th1))) in + let th3 = COMB2_CONV (RAND_CONV expand_conv) (SUBS_CONV[SYM mth]) + (rand(concl th2)) in + TRANS th2 th3 in + let hack_conv = + triv_conv ORELSEC + (BINDER_CONV (LAND_CONV + ((RAND_CONV num_CONV) THENC REWR_CONV LT_SUC)) THENC + expand_conv) in + hack_conv;; + +(* ------------------------------------------------------------------------- *) +(* Lemmas leading to iterative versions. *) +(* ------------------------------------------------------------------------- *) + +let STEP_EXP_THM = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + abs(t(i) - &2 pow n * (x pow i / &(FACT i))) <= k ==> + &2 * abs(t(SUC i) * &2 pow n * &(SUC i) - s * t(i)) <= &2 pow n * &(SUC i) + ==> abs(t(SUC i) - &2 pow n * (x pow (SUC i)) / &(FACT(SUC i))) <= + (&2 / &(SUC i)) * k + &1 / &(FACT(SUC i)) + &1 / &2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(GEN_ALL STEP_EXP) THEN + MAP_EVERY EXISTS_TAC [`s:real`; `t(i:num):real`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_REWRITE_TAC[]);; + +let STEP_EXP_RULE th = + let th1 = MATCH_MP STEP_EXP_THM th in + let th2 = UNDISCH(PURE_REWRITE_RULE[ARITH_SUC] th1) in + let th3 = CONV_RULE(RAND_CONV(ONCE_DEPTH_CONV NUM_FACT_CONV)) th2 in + let th4 = CONV_RULE(RAND_CONV REAL_RAT_REDUCE_CONV) th3 in + let th5 = ASSUME(find is_conj (hyp th)) in + let th6a,th6b = (I F_F CONJUNCT1) (CONJ_PAIR th5) in + CONJ th6a (CONJ th6b th4);; + +let STEP_EXP_0 = (UNDISCH o prove) + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) ==> + abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + abs(t(0) - &2 pow n * (x pow 0 / &(FACT 0))) <= &0`, + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_pow; FACT; real_div; REAL_INV_1; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0; REAL_LE_REFL]);; + +let STEP_EXP_1 = STEP_EXP_RULE STEP_EXP_0;; (* e(1) = 3/2 *) +let STEP_EXP_2 = STEP_EXP_RULE STEP_EXP_1;; (* e(2) = 5/2 *) +let STEP_EXP_3 = STEP_EXP_RULE STEP_EXP_2;; (* e(3) = 7/3 *) +let STEP_EXP_4 = STEP_EXP_RULE STEP_EXP_3;; (* e(4) = 41/24 *) +let STEP_EXP_5 = STEP_EXP_RULE STEP_EXP_4;; (* e(5) = 143/120 *) + +let STEP_EXP_4_PLUS = prove + (`4 <= m /\ + abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < SUC m ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(t m - &2 pow n * x pow m / &(FACT m)) <= &2`, + let lemma = prove + (`(!k. k < (SUC m) ==> P k) <=> + (!k. k < m ==> P k) /\ P m`, + REWRITE_TAC[LT] THEN MESON_TAC[]) in + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + POP_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[LT_SUC] THEN SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES] THEN + SUBST1_TAC(TOP_DEPTH_CONV num_CONV `4`) THEN + REWRITE_TAC[lemma] THEN REWRITE_TAC[ARITH_SUC] THEN + REWRITE_TAC[LT] THEN STRIP_TAC THEN + MP_TAC (DISCH_ALL STEP_EXP_4) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + REWRITE_TAC[ADD_CLAUSES; lemma] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 / &(SUC(4 + d)) * &2 + + &1 / &(FACT(SUC(4 + d))) + &1 / &2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(GEN_ALL STEP_EXP) THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `s:real` THEN EXISTS_TAC `t(4 + d):real` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + GEN_REWRITE_TAC RAND_CONV + [SYM(REAL_RAT_REDUCE_CONV `&3 / &2 + &1 / &2`)] THEN + REWRITE_TAC[REAL_LE_RADD; REAL_ADD_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 / &5 + &1 / &120` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH `&2 * &2 = &4`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ARITH `&0 <= &4`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + MP_TAC(SPEC `d':num` REAL_POS) THEN REAL_ARITH_TAC; + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC(LAND_CONV (EQT_INTRO o REAL_ARITH)) THEN REWRITE_TAC[] THEN + SUBST1_TAC(SYM(NUM_FACT_CONV `FACT 5`)) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN MATCH_MP_TAC FACT_MONO THEN + REWRITE_TAC[num_CONV `5`; LE_SUC; LE_ADD]]]]);; + +let STEPS_EXP_0 = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < 0 ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(sum(0,0) t - + &2 pow n * sum(0,0) (\i. x pow i / &(FACT i))) <= &2 * &0`, + STRIP_TAC THEN ASM_REWRITE_TAC[sum] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ABS_0; REAL_SUB_REFL; REAL_LE_REFL]);; + +let STEPS_EXP_1 = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < 1 ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(sum(0,1) t - &2 pow n * sum(0,1)(\i. x pow i / &(FACT i))) + <= &2 * &1`, + CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN + STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]);; + +let STEPS_EXP_2 = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < 2 ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(sum(0,2) t - &2 pow n * sum(0,2) (\i. x pow i / &(FACT i))) + <= &2 * &2`, + CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN + STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - (c + d) = (a - c) + (b - d)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0 + &3 / &2` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]; + MP_TAC (DISCH_ALL STEP_EXP_1) THEN + ASM_REWRITE_TAC[ADD_CLAUSES]]);; + +let STEPS_EXP_3 = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < 3 ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(sum(0,3) t - &2 pow n * sum(0,3) (\i. x pow i / &(FACT i))) + <= &2 * &3`, + CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN + STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - (c + d) = (a - c) + (b - d)`] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0 + &3 / &2 + &5 / &2` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + REPEAT + (MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) + THENL + [MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]; + MP_TAC (DISCH_ALL STEP_EXP_1) THEN ASM_REWRITE_TAC[ADD_CLAUSES]; + MP_TAC (DISCH_ALL STEP_EXP_2) THEN ASM_REWRITE_TAC[ADD_CLAUSES]]);; + +let STEPS_EXP_4 = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < 4 ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(sum(0,4) t - &2 pow n * sum(0,4) (\i. x pow i / &(FACT i))) + <= &2 * &4`, + CONV_TAC(ONCE_DEPTH_CONV EXPAND_RANGE_CONV) THEN REWRITE_TAC[] THEN + STRIP_TAC THEN CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - (c + d) = (a - c) + (b - d)`] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&0 + &3 / &2 + &5 / &2 + &7 / &3` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + REPEAT + (MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) + THENL + [MP_TAC (DISCH_ALL STEP_EXP_0) THEN ASM_REWRITE_TAC[]; + MP_TAC (DISCH_ALL STEP_EXP_1) THEN ASM_REWRITE_TAC[ADD_CLAUSES]; + MP_TAC (DISCH_ALL STEP_EXP_2) THEN ASM_REWRITE_TAC[ADD_CLAUSES]; + MP_TAC (DISCH_ALL STEP_EXP_3) THEN ASM_REWRITE_TAC[ADD_CLAUSES]]);; + +(* ------------------------------------------------------------------------- *) +(* Iterated versions. *) +(* ------------------------------------------------------------------------- *) + +let STEPS_EXP_LEMMA = prove + (`(!k. P(SUC k) ==> P(k)) /\ + (P(0) ==> (abs(sum(0,0) z) <= &2 * &0)) /\ + (P(1) ==> (abs(sum(0,1) z) <= &2 * &1)) /\ + (P(2) ==> (abs(sum(0,2) z) <= &2 * &2)) /\ + (P(3) ==> (abs(sum(0,3) z) <= &2 * &3)) /\ + (P(4) ==> (abs(sum(0,4) z) <= &2 * &4)) /\ + (!m. 4 <= m /\ P(SUC m) ==> (abs(z m) <= &2)) + ==> !m. P(m) ==> (abs(sum(0,m) z) <= &2 * &m)`, + STRIP_TAC THEN SUBGOAL_THEN + `!d. P(d + 4) ==> + abs(sum(0,d + 4) z) <= &2 * &(d + 4)` + ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + DISCH_TAC THEN REWRITE_TAC[sum; ADD1] THEN + ONCE_REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC(REAL_LE_IMP(REAL_ARITH `abs(a + b) <= abs(a) + abs(b)`)) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RID] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[LE_ADD]]; + GEN_TAC THEN + DISJ_CASES_THEN MP_TAC (SPECL [`4`; `m:num`] LE_CASES) THENL + [DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]; + SUBST1_TAC(TOP_DEPTH_CONV num_CONV `4`) THEN + REWRITE_TAC[LE] THEN REWRITE_TAC[ARITH_SUC] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + ASM_REWRITE_TAC[]]]);; + +let STEPS_EXP = prove + (`abs(x) <= &1 /\ + abs(s - &2 pow n * x) < &1 /\ + (t(0) = &2 pow n) /\ + (!k. SUC k < m ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC k) - s * t(k)) + <= &2 pow n * &(SUC k)) + ==> abs(sum(0,m) t - &2 pow n * sum(0,m) (\i. x pow i / &(FACT i))) + <= &2 * &m`, + REWRITE_TAC[REAL_MUL_RSUM0; REAL_SUB_SUM0] THEN + SPEC_TAC(`m:num`,`m:num`) THEN MATCH_MP_TAC STEPS_EXP_LEMMA THEN + REWRITE_TAC[GSYM REAL_SUB_SUM0; GSYM REAL_MUL_RSUM0] THEN + REWRITE_TAC[STEPS_EXP_0; STEPS_EXP_1; STEPS_EXP_2; STEPS_EXP_3] THEN + REWRITE_TAC[STEPS_EXP_4; STEP_EXP_4_PLUS] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `k:num` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LT]);; + +let STEPS_LN = prove + (`2 <= n /\ + abs(x) <= &1 / &2 /\ + abs(s - &2 pow n * --x) < &1 /\ + (t(0) = --s) /\ + (!k. SUC k < m ==> + &2 * abs(t(SUC k) * &2 pow n * &(SUC(SUC k)) + - &(SUC k) * s * t(k)) + <= &2 pow n * &(SUC(SUC k))) + ==> abs(sum(0,m) t - &2 pow n * sum(0,m) + (\i. (--(&1)) pow i * x pow (SUC i) / &(SUC i))) <= &3 * &m`, + REWRITE_TAC[REAL_MUL_RSUM0; REAL_SUB_SUM0] THEN + STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC (REAL_LE_IMP SUM_ABS_LE) THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[ADD_CLAUSES; LE_0] THEN + INDUCT_TAC THENL + [REWRITE_TAC[real_pow; ARITH; REAL_DIV_1; REAL_MUL_LID; REAL_MUL_RID] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `-- a - b * c = --(a - b * --c)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN + ASM_SIMP_TAC[REAL_ABS_NEG; REAL_LT_IMP_LE; REAL_OF_NUM_LE; ARITH]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + SUBGOAL_THEN `p:num < m` (ANTE_RES_THEN MP_TAC) THENL + [UNDISCH_TAC `SUC p < m` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!y. abs(x - y) + abs(y - z) <= e ==> abs(x - z) <= e`) THEN + EXISTS_TAC `&(SUC p) * s * t p / (&2 pow n * &(SUC(SUC p)))` THEN + ONCE_REWRITE_TAC [SYM(REAL_RAT_REDUCE_CONV `&1 / &2 + &5 / &2`)] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN + EXISTS_TAC `&2 pow n * &(SUC(SUC p))` THEN + SUBGOAL_THEN `&0 < &2 pow n * &(SUC(SUC p))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; LT_0; ARITH]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!x y. &0 < y ==> (abs(x) * y = abs(x * y))` + (fun th -> ASM_SIMP_TAC[th]) THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2` THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB] THEN + SUBGOAL_THEN `!a b c d. &0 < a ==> ((b * c * d / a) * a = b * c * d)` + (fun th -> ASM_SIMP_TAC[th]) THEN + SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID; + REAL_LT_IMP_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!y. abs(x - y) + abs(y - z) <= e ==> abs(x - z) <= e`) THEN + EXISTS_TAC `--(&1) pow p * s * x pow (SUC p) / &(SUC(SUC p))` THEN + ONCE_REWRITE_TAC [SYM(REAL_RAT_REDUCE_CONV `&9 / &4 + &1 / &4`)] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [SUBGOAL_THEN `--(&1) pow p * s * x pow (SUC p) / &(SUC(SUC p)) = + &(SUC p) * s * + (&2 pow n * --(&1) pow p * x pow SUC p / &(SUC p)) / + (&2 pow n * &(SUC (SUC p)))` + SUBST1_TAC THENL + [REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e * f * g * h = + d * b * e * h * (g * c) * (f * a)`] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; + ARITH; NOT_SUC] THEN + REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = (a * b * d) * c`] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o REDEPTH_CONV) + [GSYM REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs (&(SUC p) * s * inv (&2 pow n * &(SUC (SUC p)))) * &3` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_INV; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_INV_MUL] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d * e = + (d * a) * (b * c) * e`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&1) * &3 / &4 * &3` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; + REAL_POW_LE; REAL_ABS_POS] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `&(SUC(SUC p))` THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_OF_NUM_EQ; NOT_SUC] THEN + REWRITE_TAC[REAL_INV_1; REAL_MUL_LID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC; + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN + EXISTS_TAC `&2 pow n` THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_ARITH + `!y. abs(x - y) < &1 /\ abs(y) <= d - &1 ==> abs(x) <= d`) THEN + EXISTS_TAC `&2 pow n * --x` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `inv(&2 pow n)` THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_POW; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; + ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 / &2` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; GSYM REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_LE_SUB_LADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_LE_SUB_LADD] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + SUBST1_TAC(SYM(REAL_INT_REDUCE_CONV `&2 pow 2`)) THEN + MATCH_MP_TAC REAL_POW_MONO THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; ARITH]]; + ALL_TAC] THEN + SUBGOAL_THEN + `--(&1) pow p * s * x pow (SUC p) / &(SUC(SUC p)) - + &2 pow n * --(&1) pow (SUC p) * x pow (SUC(SUC p)) / &(SUC(SUC p)) = + (--(&1) pow p * x pow (SUC p) / &(SUC(SUC p))) * + (s - &2 pow n * --x)` + SUBST1_TAC THENL + [REWRITE_TAC[real_pow; real_div; GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_AC]; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs (-- (&1) pow p * x pow SUC p / &(SUC (SUC p))) * &1` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ABS_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_MUL_RID; real_div; REAL_ABS_MUL; REAL_ABS_POW; + REAL_ABS_NEG; REAL_ABS_NUM; REAL_ABS_INV] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2) pow 1 * inv(&2)` THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_ABS_POS; REAL_POW_LE; + REAL_LE_INV_EQ; LE_0; REAL_OF_NUM_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2) pow (SUC p)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN ARITH_TAC]; + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; ARITH; REAL_OF_NUM_LE] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Special version of Taylor series for exponential in limited range. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_EXP_LE1 = prove + (`!x n. abs(x) <= &1 + ==> ?t. abs(t) <= &1 /\ + (exp(x) = sum(0,n) (\m. x pow m / &(FACT m)) + + (exp(t) / &(FACT n)) * x pow n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real`; `n:num`] MCLAURIN_EXP_LE) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x)` THEN + ASM_REWRITE_TAC[]);; + +let REAL_EXP_15 = prove + (`exp(&1) < &5`, + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `inv(&2) + inv(&2)`)) THEN + REWRITE_TAC[REAL_EXP_ADD] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(&1 + &2 * inv(&2)) * (&1 + &2 * inv(&2))` THEN + CONV_TAC(RAND_CONV REAL_RAT_REDUCE_CONV) THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_EXP_BOUND_LEMMA THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let TAYLOR_EXP_WEAK = prove + (`abs(x) <= &1 ==> + abs(exp(x) - sum(0,m) (\i. x pow i / &(FACT i))) < &5 * inv(&(FACT m))`, + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `m:num` o MATCH_MP MCLAURIN_EXP_LE1) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `abs((x + y) - x) = abs(y)`] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[] THEN + SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[real_pow; FACT; ABS_N; REAL_INV_1; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `exp(&1)` THEN REWRITE_TAC[REAL_EXP_15] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN + UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; + REWRITE_TAC[POW_0; REAL_ABS_0; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_INV_POS THEN + REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT]]; + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&5 * abs(inv(&(FACT m))) * abs(x pow m)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(exp(&1))` THEN + ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE; REAL_EXP_MONO_LE; + REAL_EXP_15] THEN + UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[GSYM ABS_NZ; REAL_POW_EQ_0] THEN + REWRITE_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN + MP_TAC(SPEC `m:num` FACT_LT) THEN ARITH_TAC]; + MATCH_MP_TAC REAL_LE_LMUL_IMP THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_INV; ABS_N; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]]);; + +let REAL_EXP_13 = prove + (`exp(&1) < &3`, + MP_TAC(INST [`&1`,`x:real`; `5`,`m:num`] TAYLOR_EXP_WEAK) THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[ADD_CLAUSES] THEN + CONV_TAC(ONCE_DEPTH_CONV NUM_FACT_CONV) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH + `b + e <= c ==> abs(a - b) < e ==> a < c`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let TAYLOR_EXP = prove + (`abs(x) <= &1 ==> + abs(exp(x) - sum(0,m) (\i. x pow i / &(FACT i))) < &3 * inv(&(FACT m))`, + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `m:num` o MATCH_MP MCLAURIN_EXP_LE1) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `abs((x + y) - x) = abs(y)`] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[] THEN + SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[real_pow; FACT; ABS_N; REAL_INV_1; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `exp(&1)` THEN REWRITE_TAC[REAL_EXP_13] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN + UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; + REWRITE_TAC[POW_0; REAL_ABS_0; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_INV_POS THEN + REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT]]; + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&3 * abs(inv(&(FACT m))) * abs(x pow m)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(exp(&1))` THEN + ASM_REWRITE_TAC[real_abs; REAL_EXP_POS_LE; REAL_EXP_MONO_LE; + REAL_EXP_13] THEN + UNDISCH_TAC `abs(t) <= &1` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[GSYM ABS_NZ; REAL_POW_EQ_0] THEN + REWRITE_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN + MP_TAC(SPEC `m:num` FACT_LT) THEN ARITH_TAC]; + MATCH_MP_TAC REAL_LE_LMUL_IMP THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_INV; ABS_N; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]]);; + +let TAYLOR_LN = prove + (`&0 <= x /\ x <= inv(&2 pow k) ==> + abs(ln(&1 + x) - sum(0,m) (\i. --(&1) pow i * x pow SUC i / & (SUC i))) + < inv(&2 pow (k * SUC m) * &(SUC m))`, + let lemma = INST [`1`,`k:num`] (SYM(SPEC_ALL SUM_REINDEX)) in + STRIP_TAC THEN + UNDISCH_TAC `&0 <= x` THEN REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THENL + [ALL_TAC; + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div] THEN + REWRITE_TAC[SUM_0; REAL_ADD_RID; REAL_SUB_LZERO; LN_1] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_0] THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; + LT_0; ARITH]] THEN + SUBGOAL_THEN `!i. --(&1) pow i = --(&1) pow (SUC(SUC i))` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REWRITE_TAC[real_pow; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN + REWRITE_TAC[ADD1; lemma] THEN + REWRITE_TAC[ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[SUM_DIFF] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO] THEN + REWRITE_TAC[GSYM ADD1] THEN + MP_TAC(SPECL [`x:real`; `SUC m`] MCLAURIN_LN_POS) THEN + ASM_REWRITE_TAC[LT_0] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ADD1] THEN + REWRITE_TAC[GSYM real_div] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_ARITH `(a + b) - a = b`] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `inv (&2 pow (k * SUC m)) * inv (&(SUC m)) * inv(abs(&1 + t) pow SUC m)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_POS; REAL_ABS_POS; + REAL_POW_LE] THEN + REWRITE_TAC[GSYM REAL_POW_INV] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_POW_INV; real_abs; REAL_LT_IMP_LE]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN + SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0; REAL_POW_LT; + ARITH] THEN + REWRITE_TAC[GSYM REAL_POW_INV; GSYM REAL_ABS_INV] THEN + SUBGOAL_THEN `abs(inv(&1 + t)) < &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + UNDISCH_TAC `&0 < t` THEN REAL_ARITH_TAC; + SUBST1_TAC(SYM(SPEC `SUC m` REAL_POW_ONE)) THEN + MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[REAL_POW_ONE; NOT_SUC; REAL_ABS_POS]]]);; + +(* ------------------------------------------------------------------------- *) +(* Leading from the summation to the actual function. *) +(* ------------------------------------------------------------------------- *) + +let APPROX_LEMMA1 = prove + (`abs(f(x:real) - sum(0,m) (\i. P i x)) < inv(&2 pow (n + 2)) /\ + abs(u - &2 pow (n + e + 2) * sum(0,m) (\i. P i x)) <= &k * &m /\ + &k * &m <= &2 pow e /\ + abs(s * &2 pow (e + 2) - u) <= &2 pow (e + 1) + ==> abs(s - &2 pow n * f(x)) < &1`, + STRIP_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `&2 pow (n + e + 2)` THEN + REWRITE_TAC[REAL_LT_POW2] THEN + REWRITE_TAC[REAL_ABS_LEMMA; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN (MATCH_MP_TAC o GEN_ALL) + (REAL_ARITH `abs(a - b) + abs(b - c) < d ==> abs(a - c) < d`) THEN + EXISTS_TAC `&2 pow n * u` THEN + CONV_TAC(funpow 4 RAND_CONV num_CONV) THEN + REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_2] THEN + MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_POW_ADD] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[GSYM REAL_ABS_LEMMA] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[REAL_LT_POW2]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_SUB_LDISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_POW_ADD] THEN + REWRITE_TAC[GSYM REAL_ABS_LEMMA] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN REWRITE_TAC[REAL_LT_POW2] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN (MATCH_MP_TAC o GEN_ALL) + (REAL_ARITH `abs(a - b) + abs(b - c) < d ==> abs(a - c) < d`) THEN + EXISTS_TAC + `&2 pow (n + e + 2) * sum(0,m) (\i. P i (x:real))` THEN + GEN_REWRITE_TAC RAND_CONV [REAL_POW_ADD] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_POW_1; REAL_MUL_2] THEN + MATCH_MP_TAC REAL_LET_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&k * &m` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_ABS_LEMMA] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ADD_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_POW_ADD] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + REWRITE_TAC[REAL_LT_POW2] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `inv(&2 pow (n + 2))` THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + SUBGOAL_THEN `inv(&2 pow (n + 2)) * &2 pow (n + 2) = &1` + (fun th -> ASM_REWRITE_TAC[th; REAL_MUL_LID]) THEN + MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_POW_EQ_0] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Approximation theorems. *) +(* ------------------------------------------------------------------------- *) + +let APPROX_EXP = prove + (`(n + e + 2 = p) /\ + &3 * &2 pow (n + 2) <= &(FACT m) /\ + &2 * &m <= &2 pow e /\ + abs(x) <= &1 /\ + abs(s - &2 pow p * x) < &1 /\ + (t(0) = &2 pow p) /\ + (!k. SUC k < m ==> + &2 * abs(t(SUC k) * &2 pow p * &(SUC k) - s * t(k)) + <= &2 pow p * &(SUC k)) /\ + abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) + ==> abs(u - &2 pow n * exp(x)) < &1`, + STRIP_TAC THEN MATCH_MP_TAC(GEN_ALL APPROX_LEMMA1) THEN + MAP_EVERY EXISTS_TAC + [`\i x. x pow i / &(FACT i)`; `2`; `m:num`; `sum(0,m) t`; `e:num`] THEN + ASM_REWRITE_TAC[BETA_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&3 * inv(&(FACT m))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC TAYLOR_EXP THEN ASM_REWRITE_TAC[]; + SUBST1_TAC(SYM(SPEC `&3` REAL_INV_INV)) THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_POW2] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&3` THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + REWRITE_TAC[MATCH_MP REAL_MUL_RINV (REAL_ARITH `~(&3 = &0)`)] THEN + ASM_REWRITE_TAC[REAL_MUL_LID] THEN REAL_ARITH_TAC]; + MATCH_MP_TAC STEPS_EXP THEN ASM_REWRITE_TAC[]]);; + +let APPROX_LN = prove + (`~(k = 0) /\ + (n + e + 2 = p) /\ + &2 pow (n + 2) <= &2 pow (k * SUC m) * &(SUC m) /\ + &3 * &m <= &2 pow e /\ + (&0 <= x /\ x <= inv(&2 pow k)) /\ + abs(s - &2 pow p * --x) < &1 /\ + (t(0) = --s) /\ + (!k. SUC k < m ==> + &2 * abs(t(SUC k) * &2 pow p * &(SUC(SUC k)) - + &(SUC k) * s * t(k)) + <= &2 pow p * &(SUC(SUC k))) /\ + abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) + ==> abs(u - &2 pow n * ln(&1 + x)) < &1`, + STRIP_TAC THEN + (MATCH_MP_TAC o GEN_ALL o BETA_RULE) + (INST [`\x. ln(&1 + x):real`,`f:real->real`] APPROX_LEMMA1) THEN + MAP_EVERY EXISTS_TAC + [`\i x. (--(&1)) pow i * x pow (SUC i) / &(SUC i)`; + `3`; `m:num`; `sum(0,m) t`; `e:num`] THEN + ASM_REWRITE_TAC[BETA_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `inv(&2 pow (k * SUC m) * &(SUC m))` THEN CONJ_TAC THENL + [MATCH_MP_TAC TAYLOR_LN THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_POW2]]; + MATCH_MP_TAC STEPS_LN THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `2 <= (n + e + 2)` MP_TAC THENL + [REWRITE_TAC[ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[LE_ADD]; + SUBGOAL_THEN `abs(x) <= &1 / &2` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2 pow k)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_POW_1] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_LT_POW2] THEN + MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Eliminate trivial definitions. *) +(* ------------------------------------------------------------------------- *) + +let ELIMINATE_DEF = + let x_tm = `x:num` + and a_tm = `&0` + and sconv = REWRITE_CONV[ARITH] in + fun tdefs th -> + if tdefs = [] then th else + let ctm = + itlist (fun tm acc -> + let l,r = (rand F_F I) (dest_eq tm) in + mk_cond(mk_eq(x_tm,l),r,acc)) tdefs a_tm in + let atm = mk_abs(x_tm,ctm) in + let ttm = rator(lhs(hd tdefs)) in + let tth = ASSUME(mk_eq(ttm,atm)) in + let ths = map + (EQT_ELIM o CONV_RULE(RAND_CONV sconv) o SUBS_CONV[tth]) tdefs in + let dth = PROVE_HYP (end_itlist CONJ ths) th in + MP (INST [atm,ttm] (DISCH_ALL dth)) (REFL atm);; + +(* ------------------------------------------------------------------------- *) +(* Overall conversion. *) +(* ------------------------------------------------------------------------- *) + +let realcalc_cache = ref [];; + +let REALCALC_CONV,thm_eval,raw_eval,thm_wrap = + let a_tm = `a:real` and n_tm = `n:num` and n'_tm = `n':num` + + and m_tm = `m:num` + + and b_tm = `b:real` and e_tm = `e:num` + and c_tm = `c:real` + + and neg_tm = `(--)` + and abs_tm = `abs` + and inv_tm = `inv` + and sqrt_tm = `sqrt` + and add_tm = `(+)` + and mul_tm = `(*)` + and sub_tm = `(-)` + and exp_tm = `exp:real->real` + and ln_tm = `ln:real->real` + and add1_tm = `(+) (&1)` + and pow2_tm = `(pow) (&2)` + and one_tm = `&1` + and lt_tm = `(<)` in + + let INTEGER_PROVE = + EQT_ELIM o REWRITE_CONV[REAL_EQ_NEG2; GSYM EXISTS_REFL; + EXISTS_OR_THM; REAL_OF_NUM_EQ] in + + let ndiv x y = + let q = quo_num x y in + let r = x -/ (q */ y) in + if le_num (abs_num(Int 2 */ r)) (abs_num y) then q + else if le_num (abs_num(Int 2 */ (r -/ y))) (abs_num y) then q +/ Int 1 + else if le_num (abs_num(Int 2 */ (r +/ y))) (abs_num y) then q -/ Int 1 + else let s = (string_of_num x)^" and "^(string_of_num y) in + failwith ("ndiv: "^s) in + + let raw_wrap (f:num->num) = (ref(Int(-1),Int 0),f) in + + let raw_eval(r,(f:num->num)) n = + let (n0,y0) = !r in + if le_num n n0 then ndiv y0 (power_num (Int 2) (n0 -/ n)) + else let y = f n in (r := (n,y); y) in + + let thm_eval = + let SUC_tm = `SUC` + and mk_add = mk_binop `(+):num->num->num` in + fun (r,(f:num->thm)) n -> + let (n0,y0th) = !r in + if le_num n n0 then + if n =/ n0 then y0th else + let th1 = NUM_SUC_CONV + (mk_comb(SUC_tm,mk_numeral(n0 -/ (n +/ Int 1)))) in + let th2 = MATCH_MP REALCALC_DOWNGRADE th1 in + let th3 = NUM_ADD_CONV(mk_add(mk_numeral(n)) (mk_numeral(n0 -/ n))) in + let th4 = MATCH_MP th2 th3 in + let th5 = MATCH_MP th4 y0th in + let tm5 = fst(dest_imp(concl th5)) in + let tm5a,tm5b = dest_comb tm5 in + let th6 = REAL_INT_POW_CONV tm5b in + let tm5c = rand(rand tm5a) in + let tm5d,tm5e = dest_comb tm5c in + let tm5f,tm5g = dest_comb(rand tm5d) in + let tm5h = rand(rand tm5f) in + let bin = mk_realintconst + (ndiv (dest_realintconst tm5e) (power_num (Int 2) (dest_numeral tm5h))) in + let th7 = AP_TERM (rator(rand tm5f)) th1 in + let th8 = GEN_REWRITE_RULE LAND_CONV [CONJUNCT2 real_pow] th7 in + let th9 = SYM(GEN_REWRITE_RULE (LAND_CONV o RAND_CONV) [th6] th8) in + let th10 = TRANS th9 (REAL_INT_MUL_CONV (rand(concl th9))) in + let th11 = AP_THM (AP_TERM (rator tm5f) th10) bin in + let th12 = TRANS th11 (REAL_INT_MUL_CONV (rand(concl th11))) in + let th13 = AP_THM (AP_TERM (rator tm5d) th12) tm5e in + let th14 = TRANS th13 (REAL_INT_SUB_CONV (rand(concl th13))) in + let th15 = AP_TERM (rator(rand tm5a)) th14 in + let th16 = TRANS th15 (REAL_INT_ABS_CONV (rand(concl th15))) in + let th17 = MK_COMB(AP_TERM (rator tm5a) th16,th6) in + let th18 = TRANS th17 (REAL_INT_LE_CONV (rand(concl th17))) in + MATCH_MP th5 (EQT_ELIM th18) + else let yth = f n in (r := (n,yth); yth) in + + let thm_wrap (f:num->thm) = (ref(Int(-1),TRUTH),f) in + + let find_msd = + let rec find_msd n f = + if Int 1 real` + and n_tm = `n:num` + and m_tm = `m:num` + and e_tm = `e:num` + and p_tm = `p:num` + and s_tm = `s:real` + and u_tm = `u:real` + and x_tm = `x:real` in + let rec calculate_m acc i r = + if acc >=/ r then i else + let i' = i +/ Int 1 in + calculate_m (i' */ acc) i' r in + let calculate_exp_sequence = + let rec calculate_exp_sequence p2 s i = + if i let p2 = power_num (Int 2) p in + rev(calculate_exp_sequence p2 s (m -/ Int 1)) in + let pth = prove + (`abs(x) <= &1 ==> + abs(s - &2 pow p * x) < &1 ==> + (n + e + 2 = p) /\ + &3 * &2 pow (n + 2) <= &(FACT m) /\ + &2 * &m <= &2 pow e /\ + (t(0) = &2 pow p) /\ + (!k. SUC k < m ==> + &2 * abs(t(SUC k) * &2 pow p * &(SUC k) - s * t(k)) + <= &2 pow p * &(SUC k)) /\ + abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) + ==> abs(u - &2 pow n * exp(x)) < &1`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC APPROX_EXP THEN + ASM_REWRITE_TAC[]) in + let LEFT_ZERO_RULE = + ONCE_REWRITE_RULE[prove(`0 + n = n`,REWRITE_TAC[ADD_CLAUSES])] in + fun (fn1,fn2) -> + let raw_fn n = + let m = calculate_m (Int 1) (Int 0) + (Int 3 */ (power_num (Int 2) (n +/ Int 2))) in + let e = log2 (Int 2 */ m) in + let p = n +/ e +/ Int 2 in + let s = raw_eval fn1 p in + let seq = calculate_exp_sequence p s m in + let u0 = itlist (+/) seq (Int 0) in + ndiv u0 (power_num (Int 2) (e +/ Int 2)) + and thm_fn n = + let m = calculate_m (Int 1) (Int 0) + (Int 3 */ (power_num (Int 2) (n +/ Int 2))) in + let e = log2 (Int 2 */ m) in + let p = n +/ e +/ Int 2 in + let sth = thm_eval fn2 p in + let tm1 = rand(lhand(concl sth)) in + let s_num = lhand tm1 in + let x_num = rand(rand tm1) in + let s = dest_realintconst s_num in + let seq = calculate_exp_sequence p s m in + let u0 = itlist (+/) seq (Int 0) in + let u = ndiv u0 (power_num (Int 2) (e +/ Int 2)) in + let m_num = mk_numeral m + and n_num = mk_numeral n + and e_num = mk_numeral e + and p_num = mk_numeral p + and u_num = mk_realintconst u in + let tdefs = map2 (fun a b -> mk_eq(mk_comb(t_tm,mk_small_numeral a), + mk_realintconst b)) (0--(length seq - 1)) seq in + let p2th = REAL_INT_POW_CONV (mk_comb(pow2_tm,p_num)) in + let th0 = INST [m_num,m_tm; n_num,n_tm; e_num,e_tm; + x_num,x_tm; p_num,p_tm; s_num,s_tm; u_num,u_tm] pth in + let th0' = MP th0 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th0)))) in + let th1 = MP th0' sth in + let th2 = CONV_RULE (ONCE_DEPTH_CONV EXPAND_RANGE_CONV) th1 in + let th3 = LEFT_ZERO_RULE + (CONV_RULE (ONCE_DEPTH_CONV REAL_SUM_CONV) th2) in + let ths = try CONJUNCTS(ASSUME(list_mk_conj tdefs)) + with Failure _ -> [] in + let th4 = SUBS (p2th::ths) th3 in + let th5 = CONV_RULE (LAND_CONV + (DEPTH_CONV NUM_ADD_CONV THENC + ONCE_DEPTH_CONV NUM_FACT_CONV THENC + REAL_INT_REDUCE_CONV)) th4 in + MP (ELIMINATE_DEF tdefs th5) TRUTH in + raw_wrap raw_fn,thm_wrap thm_fn in + + let REALCALC_LN_CONV = + let t_tm = `t:num->real` + and n_tm = `n:num` + and m_tm = `m:num` + and e_tm = `e:num` + and p_tm = `p:num` + and s_tm = `s:real` + and u_tm = `u:real` + and k_tm = `k:num` + and x_tm = `x:real` in + let rec calculate_m acc k2 m r = + if acc */ (m +/ Int 1) >=/ r then m else + calculate_m (k2 */ acc) k2 (m +/ Int 1) r in + let calculate_ln_sequence = + let rec calculate_ln_sequence p2 s i = + if i let p2 = power_num (Int 2) p in + rev(calculate_ln_sequence p2 s (m -/ Int 1)) in + let pth = prove + (`&0 <= x /\ x <= inv(&2 pow k) ==> + abs(s - &2 pow p * x) < &1 ==> + ~(k = 0) /\ + (n + e + 2 = p) /\ + &2 pow (n + 2) <= &2 pow (k * SUC m) * &(SUC m) /\ + &3 * &m <= &2 pow e /\ + (t(0) = s) /\ + (!k. SUC k < m ==> + &2 * abs(t(SUC k) * &2 pow p * &(SUC(SUC k)) - + &(SUC k) * --s * t(k)) + <= &2 pow p * &(SUC(SUC k))) /\ + abs(u * &2 pow (e + 2) - sum(0,m) t) <= &2 pow (e + 1) + ==> abs(u - &2 pow n * ln(&1 + x)) < &1`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(INST [`--s`,`s:real`] APPROX_LN) THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_ARITH `abs(--a - --b) = abs(a - b)`] THEN + ASM_REWRITE_TAC[]) in + let LEFT_ZERO_RULE = + ONCE_REWRITE_RULE[prove(`0 + n = n`,REWRITE_TAC[ADD_CLAUSES])] in + let pow2_tm = `(pow) (&2)` in + let default_tdefs = [`t 0 = &0`] in + fun (fn1,fn2) -> + let raw_fn n = + let k = find_ubound fn1 in + if k mk_eq(mk_comb(t_tm,mk_small_numeral a), + mk_realintconst b)) (0--(length seq - 1)) seq in + let tdefs = if tdefs0 = [] then default_tdefs else tdefs0 in + let p2th = REAL_INT_POW_CONV (mk_comb(pow2_tm,p_num)) in + let th0 = INST [m_num,m_tm; n_num,n_tm; e_num,e_tm; k_num,k_tm; + x_num,x_tm; p_num,p_tm; s_num,s_tm; u_num,u_tm] pth in + let th0' = MP th0 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th0)))) in + let th1 = MP th0' sth in + let th2 = CONV_RULE (ONCE_DEPTH_CONV EXPAND_RANGE_CONV) th1 in + let th3 = LEFT_ZERO_RULE + (CONV_RULE (ONCE_DEPTH_CONV REAL_SUM_CONV) th2) in + let ths = try CONJUNCTS(ASSUME(list_mk_conj tdefs)) + with Failure _ -> [] in + let th4 = SUBS (p2th::ths) th3 in + let th5 = CONV_RULE (LAND_CONV + (NUM_REDUCE_CONV THENC + REAL_INT_REDUCE_CONV)) th4 in + MP (ELIMINATE_DEF tdefs th5) TRUTH in + raw_wrap raw_fn,thm_wrap thm_fn in + + let REALCALC_SQRT_CONV = + let num_sqrt = + let rec isolate_sqrt (a,b) y = + if abs_num(a -/ b) <=/ Int 1 then + if abs_num(a */ a -/ y) <=/ a then a else b + else + let c = quo_num (a +/ b) (Int 2) in + if c */ c <=/ y then isolate_sqrt (c,b) y + else isolate_sqrt (a,c) y in + fun n -> isolate_sqrt (Int 0,n) n in + let MATCH_pth = MATCH_MP REALCALC_SQRT in + let b_tm = `b:real` in + let PROVE_1_LE_SQRT = + let pth = prove + (`&1 <= x ==> &1 <= sqrt(x)`, + DISCH_THEN(fun th -> + ASSUME_TAC(MATCH_MP (REAL_ARITH `&1 <= x ==> &0 <= x`) th) THEN + MP_TAC th) THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_TAC THEN + SUBGOAL_THEN `x = sqrt(x) pow 2` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[SQRT_POW2]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[POW_2] THEN MATCH_MP_TAC REAL_LT_MUL2 THEN + ASM_SIMP_TAC[SQRT_POS_LE]]) in + let tac = REPEAT(MATCH_MP_TAC pth) THEN CONV_TAC REAL_RAT_LE_CONV in + fun tm -> try prove(tm,tac) + with Failure _ -> failwith "Need root body >= &1" in + fun (fn1,fn2) -> + let raw_fn n = + num_sqrt(power_num (Int 2) n */ raw_eval fn1 n) + and thm_fn n = + let th1 = MATCH_pth(thm_eval fn2 n) in + let th2 = MP th1 (PROVE_1_LE_SQRT(lhand(concl th1))) in + let th3 = CONV_RULE(funpow 2 LAND_CONV + (funpow 2 RAND_CONV REAL_RAT_REDUCE_CONV)) th2 in + let k = dest_realintconst(rand(rand(lhand(lhand(concl th3))))) in + let th4 = INST [mk_realintconst(num_sqrt k),b_tm] th3 in + MP th4 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th4)))) in + raw_wrap raw_fn,thm_wrap thm_fn in + + let rec REALCALC_CONV tm = + try assoc tm (!realcalc_cache) with Failure _ -> + if is_ratconst tm then + let x = rat_of_term tm in + let raw_fn acc = + floor_num ((power_num (Int 2) acc) */ x) + and thm_fn acc = + let a = floor_num ((power_num (Int 2) acc) */ x) in + let atm = mk_realintconst a in + let rtm = mk_comb(mk_comb(mul_tm,mk_comb(pow2_tm,mk_numeral acc)),tm) in + let btm = mk_comb(abs_tm,mk_comb(mk_comb(sub_tm,atm),rtm)) in + let ftm = mk_comb(mk_comb(lt_tm,btm),one_tm) in + EQT_ELIM(REAL_RAT_REDUCE_CONV ftm) in + raw_wrap raw_fn,thm_wrap thm_fn else + let lop,r = dest_comb tm in + if lop = neg_tm then + let rfn,tfn = REALCALC_CONV r in + let raw_fn acc = + minus_num (raw_eval rfn acc) + and thm_fn acc = + let th1 = thm_eval tfn acc in + let th2 = MATCH_MP REALCALC_NEG th1 in + try EQ_MP (LAND_CONV(RAND_CONV(LAND_CONV REAL_INT_NEG_CONV)) (concl th2)) + th2 + with Failure _ -> th2 in + raw_wrap raw_fn,thm_wrap thm_fn + else if lop = abs_tm then + let rfn,tfn = REALCALC_CONV r in + let raw_fn acc = + abs_num (raw_eval rfn acc) + and thm_fn acc = + let th1 = thm_eval tfn acc in + let th2 = MATCH_MP REALCALC_ABS th1 in + CONV_RULE (LAND_CONV(RAND_CONV(LAND_CONV REAL_INT_ABS_CONV))) th2 in + raw_wrap raw_fn,thm_wrap thm_fn + else if lop = sqrt_tm then + REALCALC_SQRT_CONV(REALCALC_CONV r) + else if lop = inv_tm then + let rfn,tfn = REALCALC_CONV r in + let x0 = raw_eval rfn (Int 0) in + let ax0 = abs_num x0 in + let r = log2(ax0) -/ Int 1 in + let get_ek(acc) = + if r < Int 0 then + let p = find_msd rfn in + let e = acc +/ p +/ Int 1 in + let k = e +/ p in e,k + else + let k = let k0 = acc +/ Int 1 -/ (Int 2 */ r) in + if k0 + let th1 = thm_eval tfn n in + GEN_REWRITE_RULE (LAND_CONV o funpow 3 RAND_CONV) [SYM th] th1);; + +(* ------------------------------------------------------------------------- *) +(* Calculate ordering relation between two expressions. *) +(* ------------------------------------------------------------------------- *) + +let REALCALC_LT = prove + (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 + ==> &2 <= abs(a - b) ==> (x < y <=> a < b)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&2 pow n * x < &2 pow n * y` THEN CONJ_TAC THENL + [SIMP_TAC[REAL_LT_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);; + +let REALCALC_LE = prove + (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 + ==> &2 <= abs(a - b) ==> (x <= y <=> a <= b)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&2 pow n * x <= &2 pow n * y` THEN CONJ_TAC THENL + [SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]; + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);; + +let REALCALC_GT = prove + (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 + ==> &2 <= abs(a - b) ==> (x > y <=> a > b)`, + ONCE_REWRITE_TAC[CONJ_SYM; REAL_ABS_SUB] THEN + REWRITE_TAC[real_gt; REALCALC_LT]);; + +let REALCALC_GE = prove + (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 + ==> &2 <= abs(a - b) ==> (x >= y <=> a >= b)`, + ONCE_REWRITE_TAC[CONJ_SYM; REAL_ABS_SUB] THEN + REWRITE_TAC[real_ge; REALCALC_LE]);; + +let REALCALC_EQ = prove + (`abs(a - &2 pow n * x) < &1 /\ abs(b - &2 pow n * y) < &1 + ==> &2 <= abs(a - b) ==> ((x = y) <=> F)`, + ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let realcalc_rel_conv = + let pops = + [`(<)`,()`,(>/); `(>=)`,(>=/); + `(=):real->real->bool`,(=/)] in + let rec find_n rfn1 rfn2 n = + if n >/ Int 1000 then + failwith "realcalc_rel_conv: too close to discriminate" else + if abs_num(raw_eval rfn1 n -/ raw_eval rfn2 n) >=/ Int 4 then n + else find_n rfn1 rfn2 (n +/ Int 1) in + fun tm -> + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + let pop = + try assoc op pops + with Failure _ -> failwith "realcalc_rel_conv: unknown operator" in + let rfn1,tfn1 = REALCALC_CONV l + and rfn2,tfn2 = REALCALC_CONV r in + let n = find_n rfn1 rfn2 (Int 1) in + pop (raw_eval rfn1 n) (raw_eval rfn2 n);; + +let REALCALC_REL_CONV = + let pths = + [`(<)`,REALCALC_LT; `(<=)`,REALCALC_LE; + `(>)`,REALCALC_GT; `(>=)`,REALCALC_GE; + `(=):real->real->bool`,REALCALC_EQ] in + let rec find_n rfn1 rfn2 n = + if n >/ Int 1000 then + failwith "realcalc_rel_conv: too close to discriminate" else + if abs_num(raw_eval rfn1 n -/ raw_eval rfn2 n) >=/ Int 4 then n + else find_n rfn1 rfn2 (n +/ Int 1) in + fun tm -> + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + let pth = try assoc op pths + with Failure _ -> failwith "realcalc_rel_conv: unknown operator" in + let rfn1,tfn1 = REALCALC_CONV l + and rfn2,tfn2 = REALCALC_CONV r in + let n = find_n rfn1 rfn2 (Int 1) in + let th1 = thm_eval tfn1 n + and th2 = thm_eval tfn2 n in + let th3 = MATCH_MP pth (CONJ th1 th2) in + let th4 = MP th3 (EQT_ELIM(REAL_INT_REDUCE_CONV(lhand(concl th3)))) in + CONV_RULE(RAND_CONV REAL_RAT_REDUCE_CONV) th4;; diff --git a/Library/card.ml b/Library/card.ml new file mode 100644 index 0000000..65e624a --- /dev/null +++ b/Library/card.ml @@ -0,0 +1,1803 @@ +(* ========================================================================= *) +(* Basic notions of cardinal arithmetic. *) +(* ========================================================================= *) + +needs "Library/wo.ml";; + +let TRANS_CHAIN_TAC th = + MAP_EVERY (fun t -> TRANS_TAC th t THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* We need these a few times, so give them names. *) +(* ------------------------------------------------------------------------- *) + +let sum_DISTINCT = distinctness "sum";; + +let sum_INJECTIVE = injectivity "sum";; + +let sum_CASES = prove_cases_thm sum_INDUCT;; + +let FORALL_SUM_THM = prove + (`(!z. P z) <=> (!x. P(INL x)) /\ (!x. P(INR x))`, + MESON_TAC[sum_CASES]);; + +let EXISTS_SUM_THM = prove + (`(?z. P z) <=> (?x. P(INL x)) \/ (?x. P(INR x))`, + MESON_TAC[sum_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of Zorn's Lemma for restriction of subset lattice. *) +(* ------------------------------------------------------------------------- *) + +let POSET_RESTRICTED_SUBSET = prove + (`!P. poset(\(x,y). P(x) /\ P(y) /\ x SUBSET y)`, + GEN_TAC THEN REWRITE_TAC[poset; fl] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[SUBSET; EXTENSION] THEN MESON_TAC[]);; + +let FL_RESTRICTED_SUBSET = prove + (`!P. fl(\(x,y). P(x) /\ P(y) /\ x SUBSET y) = P`, + REWRITE_TAC[fl; FORALL_PAIR_THM; FUN_EQ_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[SUBSET_REFL]);; + +let ZL_SUBSETS = prove + (`!P. (!c. (!x. x IN c ==> P x) /\ + (!x y. x IN c /\ y IN c ==> x SUBSET y \/ y SUBSET x) + ==> ?z. P z /\ (!x. x IN c ==> x SUBSET z)) + ==> ?a:A->bool. P a /\ (!x. P x /\ a SUBSET x ==> (a = x))`, + GEN_TAC THEN + MP_TAC(ISPEC `\(x,y). P(x:A->bool) /\ P(y) /\ x SUBSET y` ZL) THEN + REWRITE_TAC[POSET_RESTRICTED_SUBSET; FL_RESTRICTED_SUBSET] THEN + REWRITE_TAC[chain] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[IN] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL + [MATCH_MP_TAC MONO_FORALL; ALL_TAC] THEN + MESON_TAC[]);; + +let ZL_SUBSETS_UNIONS = prove + (`!P. (!c. (!x. x IN c ==> P x) /\ + (!x y. x IN c /\ y IN c ==> x SUBSET y \/ y SUBSET x) + ==> P(UNIONS c)) + ==> ?a:A->bool. P a /\ (!x. P x /\ a SUBSET x ==> (a = x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ZL_SUBSETS THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `UNIONS(c:(A->bool)->bool)` THEN + ASM_MESON_TAC[SUBSET; IN_UNIONS]);; + +let ZL_SUBSETS_UNIONS_NONEMPTY = prove + (`!P. (?x. P x) /\ + (!c. (?x. x IN c) /\ + (!x. x IN c ==> P x) /\ + (!x y. x IN c /\ y IN c ==> x SUBSET y \/ y SUBSET x) + ==> P(UNIONS c)) + ==> ?a:A->bool. P a /\ (!x. P x /\ a SUBSET x ==> (a = x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ZL_SUBSETS THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `?x:A->bool. x IN c` THENL + [EXISTS_TAC `UNIONS(c:(A->bool)->bool)` THEN + ASM_SIMP_TAC[] THEN MESON_TAC[SUBSET; IN_UNIONS]; + ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Useful lemma to reduce some higher order stuff to first order. *) +(* ------------------------------------------------------------------------- *) + +let FLATTEN_LEMMA = prove + (`(!x. x IN s ==> (g(f(x)) = x)) <=> !y x. x IN s /\ (y = f x) ==> (g y = x)`, + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Knaster-Tarski fixpoint theorem (used in Schroeder-Bernstein below). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_SET = prove + (`!f. (!s t. s SUBSET t ==> f(s) SUBSET f(t)) ==> ?s:A->bool. f(s) = s`, + REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC + [`Y = {b:A->bool | f(b) SUBSET b}`; `a:A->bool = INTERS Y`] THEN + SUBGOAL_THEN `!b:A->bool. b IN Y <=> f(b) SUBSET b` ASSUME_TAC THENL + [EXPAND_TAC "Y" THEN REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + SUBGOAL_THEN `!b:A->bool. b IN Y ==> f(a:A->bool) SUBSET b` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET_TRANS; IN_INTERS; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `f(a:A->bool) SUBSET a` + (fun th -> ASM_MESON_TAC[SUBSET_ANTISYM; IN_INTERS; th]) THEN + ASM_MESON_TAC[IN_INTERS; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* We need a nonemptiness hypothesis for the nicest total function form. *) +(* ------------------------------------------------------------------------- *) + +let INJECTIVE_LEFT_INVERSE_NONEMPTY = prove + (`(?x. x IN s) + ==> ((!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) <=> + ?g. (!y. y IN t ==> g(y) IN s) /\ + (!x. x IN s ==> (g(f(x)) = x)))`, + REWRITE_TAC[FLATTEN_LEMMA; GSYM SKOLEM_THM; AND_FORALL_THM] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Now bijectivity. *) +(* ------------------------------------------------------------------------- *) + +let BIJECTIVE_INJECTIVE_SURJECTIVE = prove + (`(!x. x IN s ==> f(x) IN t) /\ + (!y. y IN t ==> ?!x. x IN s /\ (f x = y)) <=> + (!x. x IN s ==> f(x) IN t) /\ + (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ + (!y. y IN t ==> ?x. x IN s /\ (f x = y))`, + MESON_TAC[]);; + +let BIJECTIVE_INVERSES = prove + (`(!x. x IN s ==> f(x) IN t) /\ + (!y. y IN t ==> ?!x. x IN s /\ (f x = y)) <=> + (!x. x IN s ==> f(x) IN t) /\ + ?g. (!y. y IN t ==> g(y) IN s) /\ + (!y. y IN t ==> (f(g(y)) = y)) /\ + (!x. x IN s ==> (g(f(x)) = x))`, + REWRITE_TAC[BIJECTIVE_INJECTIVE_SURJECTIVE; + INJECTIVE_ON_LEFT_INVERSE; + SURJECTIVE_ON_RIGHT_INVERSE] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Other variants of cardinal equality. *) +(* ------------------------------------------------------------------------- *) + +let EQ_C_BIJECTIONS = prove + (`!s:A->bool t:B->bool. + s =_c t <=> ?f g. (!x. x IN s ==> f x IN t /\ g(f x) = x) /\ + (!y. y IN t ==> g y IN s /\ f(g y) = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `f:A->B` THEN REWRITE_TAC[] THEN + EQ_TAC THENL [STRIP_TAC; MESON_TAC[]] THEN + EXISTS_TAC `(\y. @x. x IN s /\ f x = y):B->A` THEN + ASM_MESON_TAC[]);; + +let EQ_C = prove + (`s =_c t <=> + ?R:A#B->bool. (!x y. R(x,y) ==> x IN s /\ y IN t) /\ + (!x. x IN s ==> ?!y. y IN t /\ R(x,y)) /\ + (!y. y IN t ==> ?!x. x IN s /\ R(x,y))`, + REWRITE_TAC[eq_c] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\(x:A,y:B). x IN s /\ y IN t /\ (y = f x)` THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_MESON_TAC[]; + DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [EXISTS_UNIQUE_ALT; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The "easy" ordering properties. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_REFL = prove + (`!s:A->bool. s <=_c s`, + GEN_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. x` THEN SIMP_TAC[]);; + +let CARD_LE_TRANS = prove + (`!s:A->bool t:B->bool u:C->bool. + s <=_c t /\ t <=_c u ==> s <=_c u`, + REPEAT GEN_TAC THEN REWRITE_TAC[le_c] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `f:A->B`) (X_CHOOSE_TAC `g:B->C`)) THEN + EXISTS_TAC `(g:B->C) o (f:A->B)` THEN REWRITE_TAC[o_THM] THEN + ASM_MESON_TAC[]);; + +let CARD_LT_REFL = prove + (`!s:A->bool. ~(s <_c s)`, + MESON_TAC[lt_c; CARD_LE_REFL]);; + +let CARD_LET_TRANS = prove + (`!s:A->bool t:B->bool u:C->bool. + s <=_c t /\ t <_c u ==> s <_c u`, + REPEAT GEN_TAC THEN REWRITE_TAC[lt_c] THEN + MATCH_MP_TAC(TAUT `(a /\ b ==> c) /\ (c' /\ a ==> b') + ==> a /\ b /\ ~b' ==> c /\ ~c'`) THEN + REWRITE_TAC[CARD_LE_TRANS]);; + +let CARD_LTE_TRANS = prove + (`!s:A->bool t:B->bool u:C->bool. + s <_c t /\ t <=_c u ==> s <_c u`, + REPEAT GEN_TAC THEN REWRITE_TAC[lt_c] THEN + MATCH_MP_TAC(TAUT `(a /\ b ==> c) /\ (b /\ c' ==> a') + ==> (a /\ ~a') /\ b ==> c /\ ~c'`) THEN + REWRITE_TAC[CARD_LE_TRANS]);; + +let CARD_LT_TRANS = prove + (`!s:A->bool t:B->bool u:C->bool. + s <_c t /\ t <_c u ==> s <_c u`, + MESON_TAC[lt_c; CARD_LTE_TRANS]);; + +let CARD_EQ_REFL = prove + (`!s:A->bool. s =_c s`, + GEN_TAC THEN REWRITE_TAC[eq_c] THEN EXISTS_TAC `\x:A. x` THEN + SIMP_TAC[] THEN MESON_TAC[]);; + +let CARD_EQ_SYM = prove + (`!s t. s =_c t <=> t =_c s`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c; BIJECTIVE_INVERSES] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN REWRITE_TAC[CONJ_ACI]);; + +let CARD_EQ_IMP_LE = prove + (`!s t. s =_c t ==> s <=_c t`, + REWRITE_TAC[le_c; eq_c] THEN MESON_TAC[]);; + +let CARD_LT_IMP_LE = prove + (`!s t. s <_c t ==> s <=_c t`, + SIMP_TAC[lt_c]);; + +let CARD_LE_RELATIONAL = prove + (`!R:A->B->bool. + (!x y y'. x IN s /\ R x y /\ R x y' ==> y = y') + ==> {y | ?x. x IN s /\ R x y} <=_c s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[le_c] THEN + EXISTS_TAC `\y:B. @x:A. x IN s /\ R x y` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]);; + +let CARD_LE_RELATIONAL_FULL = prove + (`!R:A->B->bool s t. + (!y. y IN t ==> ?x. x IN s /\ R x y) /\ + (!x y y'. x IN s /\ y IN t /\ y' IN t /\ R x y /\ R x y' ==> y = y') + ==> t <=_c s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[le_c] THEN + EXISTS_TAC `\y:B. @x:A. x IN s /\ R x y` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Two trivial lemmas. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_EMPTY = prove + (`!s. s <=_c {} <=> s = {}`, + REWRITE_TAC[le_c; EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let CARD_EQ_EMPTY = prove + (`!s. s =_c {} <=> s = {}`, + REWRITE_TAC[eq_c; EXTENSION; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Antisymmetry (the Schroeder-Bernstein theorem). *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_ANTISYM = prove + (`!s:A->bool t:B->bool. s <=_c t /\ t <=_c s <=> (s =_c t)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; + SIMP_TAC[CARD_EQ_IMP_LE] THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + SIMP_TAC[CARD_EQ_IMP_LE]] THEN + ASM_CASES_TAC `s:A->bool = {}` THEN ASM_CASES_TAC `t:B->bool = {}` THEN + ASM_SIMP_TAC[CARD_LE_EMPTY; CARD_EQ_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; NOT_IN_EMPTY; NOT_FORALL_THM]) THEN + ASM_SIMP_TAC[le_c; eq_c; INJECTIVE_LEFT_INVERSE_NONEMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `i:A->B` + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `i':B->A` STRIP_ASSUME_TAC))) + (X_CHOOSE_THEN `j:B->A` + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `j':A->B` STRIP_ASSUME_TAC)))) THEN + MP_TAC(ISPEC + `\a. s DIFF (IMAGE (j:B->A) (t DIFF (IMAGE (i:A->B) a)))` + TARSKI_SET) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_DIFF; IN_IMAGE] THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A->bool` ASSUME_TAC) THEN + REWRITE_TAC[BIJECTIVE_INVERSES] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + EXISTS_TAC `\x. if x IN a then (i:A->B)(x) else j'(x)` THEN + EXISTS_TAC `\y. if y IN (IMAGE (i:A->B) a) then i'(y) else (j:B->A)(y)` THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_DEF] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN ASM_CASES_TAC `x:A IN a`; + X_GEN_TAC `y:B` THEN ASM_CASES_TAC `y IN IMAGE (i:A->B) a`] THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[EXTENSION; IN_UNIV; IN_DIFF; IN_IMAGE]) THEN + TRY(FIRST_X_ASSUM(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC)) THEN + TRY(FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:A` th) THEN + ASM_REWRITE_TAC[] THEN ASSUME_TAC th)) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Totality (cardinal comparability). *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_TOTAL = prove + (`!s:A->bool t:B->bool. s <=_c t \/ t <=_c s`, + REPEAT GEN_TAC THEN + ABBREV_TAC + `P = \R. (!x:A y:B. R(x,y) ==> x IN s /\ y IN t) /\ + (!x y y'. R(x,y) /\ R(x,y') ==> (y = y')) /\ + (!x x' y. R(x,y) /\ R(x',y) ==> (x = x'))` THEN + MP_TAC(ISPEC `P:((A#B)->bool)->bool` ZL_SUBSETS_UNIONS) THEN ANTS_TAC THENL + [GEN_TAC THEN EXPAND_TAC "P" THEN + REWRITE_TAC[UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `R:A#B->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `(!x:A. x IN s ==> ?y:B. y IN t /\ R(x,y)) \/ + (!y:B. y IN t ==> ?x:A. x IN s /\ R(x,y))` + THENL + [FIRST_X_ASSUM(K ALL_TAC o SPEC `\(x:A,y:B). T`) THEN + FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; le_c] THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) (X_CHOOSE_TAC `b:B`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `\(x:A,y:B). (x = a) /\ (y = b) \/ R(x,y)`) THEN + REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN; EXTENSION] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Other variants like "trichotomy of cardinals" now follow easily. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LET_TOTAL = prove + (`!s:A->bool t:B->bool. s <=_c t \/ t <_c s`, + REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; + +let CARD_LTE_TOTAL = prove + (`!s:A->bool t:B->bool. s <_c t \/ t <=_c s`, + REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; + +let CARD_LT_TOTAL = prove + (`!s:A->bool t:B->bool. s =_c t \/ s <_c t \/ t <_c s`, + REWRITE_TAC[lt_c; GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_TOTAL]);; + +let CARD_NOT_LE = prove + (`!s:A->bool t:B->bool. ~(s <=_c t) <=> t <_c s`, + REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; + +let CARD_NOT_LT = prove + (`!s:A->bool t:B->bool. ~(s <_c t) <=> t <=_c s`, + REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_LE_TOTAL]);; + +let CARD_LT_LE = prove + (`!s t. s <_c t <=> s <=_c t /\ ~(s =_c t)`, + REWRITE_TAC[lt_c; GSYM CARD_LE_ANTISYM] THEN CONV_TAC TAUT);; + +let CARD_LE_LT = prove + (`!s t. s <=_c t <=> s <_c t \/ s =_c t`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_NOT_LT] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CARD_LT_LE] THEN + REWRITE_TAC[DE_MORGAN_THM; CARD_NOT_LE; CARD_EQ_SYM]);; + +let CARD_LE_CONG = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s =_c s' /\ t =_c t' ==> (s <=_c t <=> s' <=_c t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN + MATCH_MP_TAC(TAUT + `!x y. (b /\ e ==> x) /\ (x /\ c ==> f) /\ (a /\ f ==> y) /\ (y /\ d ==> e) + ==> (a /\ b) /\ (c /\ d) ==> (e <=> f)`) THEN + MAP_EVERY EXISTS_TAC + [`(s':B->bool) <=_c (t:C->bool)`; + `(s:A->bool) <=_c (t':D->bool)`] THEN + REWRITE_TAC[CARD_LE_TRANS]);; + +let CARD_LT_CONG = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s =_c s' /\ t =_c t' ==> (s <_c t <=> s' <_c t')`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_NOT_LE] THEN + AP_TERM_TAC THEN MATCH_MP_TAC CARD_LE_CONG THEN + ASM_REWRITE_TAC[]);; + +let CARD_EQ_TRANS = prove + (`!s:A->bool t:B->bool u:C->bool. + s =_c t /\ t =_c u ==> s =_c u`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[CARD_LE_TRANS]);; + +let CARD_EQ_CONG = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s =_c s' /\ t =_c t' ==> (s =_c t <=> s' =_c t')`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [TRANS_CHAIN_TAC CARD_EQ_TRANS [`t:C->bool`; `s:A->bool`]; + TRANS_CHAIN_TAC CARD_EQ_TRANS [`s':B->bool`; `t':D->bool`]] THEN + ASM_MESON_TAC[CARD_EQ_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Finiteness and infiniteness in terms of cardinality of N. *) +(* ------------------------------------------------------------------------- *) + +let INFINITE_CARD_LE = prove + (`!s:A->bool. INFINITE s <=> (UNIV:num->bool) <=_c s`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[INFINITE; le_c; IN_UNIV] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_IMAGE_INJ) THEN + DISCH_THEN(MP_TAC o C MATCH_MP num_INFINITE) THEN + REWRITE_TAC[INFINITE] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN + ASM_SIMP_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM]] THEN + DISCH_TAC THEN + SUBGOAL_THEN `?f:num->A. !n. f(n) = @x. x IN (s DIFF IMAGE f {m | m < n})` + MP_TAC THENL + [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF] THEN REPEAT STRIP_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[le_c] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `f:num->A` THEN REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN + SUBGOAL_THEN `!n. (f:num->A)(n) IN (s DIFF IMAGE f {m | m < n})` MP_TAC THENL + [GEN_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV THEN + REWRITE_TAC[MEMBER_NOT_EMPTY] THEN + MATCH_MP_TAC INFINITE_NONEMPTY THEN MATCH_MP_TAC INFINITE_DIFF_FINITE THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; + ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[LT_CASES]);; + +let FINITE_CARD_LT = prove + (`!s:A->bool. FINITE s <=> s <_c (UNIV:num->bool)`, + ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[GSYM INFINITE; CARD_NOT_LT; INFINITE_CARD_LE]);; + +let CARD_LE_SUBSET = prove + (`!s:A->bool t. s SUBSET t ==> s <=_c t`, + REWRITE_TAC[SUBSET; le_c] THEN MESON_TAC[I_THM]);; + +let CARD_LE_UNIV = prove + (`!s:A->bool. s <=_c (:A)`, + GEN_TAC THEN MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; + +let CARD_LE_EQ_SUBSET = prove + (`!s:A->bool t:B->bool. s <=_c t <=> ?u. u SUBSET t /\ (s =_c u)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN + MATCH_MP_TAC(TAUT `(a <=> b) ==> b ==> a`) THEN + MATCH_MP_TAC CARD_LE_CONG THEN + ASM_REWRITE_TAC[CARD_LE_CONG; CARD_EQ_REFL]] THEN + REWRITE_TAC[le_c; eq_c] THEN + DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN EXISTS_TAC `IMAGE (f:A->B) s` THEN + EXISTS_TAC `f:A->B` THEN REWRITE_TAC[IN_IMAGE; SUBSET] THEN + ASM_MESON_TAC[]);; + +let CARD_INFINITE_CONG = prove + (`!s:A->bool t:B->bool. s =_c t ==> (INFINITE s <=> INFINITE t)`, + REWRITE_TAC[INFINITE_CARD_LE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CARD_LE_CONG THEN ASM_REWRITE_TAC[CARD_EQ_REFL]);; + +let CARD_FINITE_CONG = prove + (`!s:A->bool t:B->bool. s =_c t ==> (FINITE s <=> FINITE t)`, + ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[GSYM INFINITE; CARD_INFINITE_CONG]);; + +let CARD_LE_FINITE = prove + (`!s:A->bool t:B->bool. FINITE t /\ s <=_c t ==> FINITE s`, + ASM_MESON_TAC[CARD_LE_EQ_SUBSET; FINITE_SUBSET; CARD_FINITE_CONG]);; + +let CARD_EQ_FINITE = prove + (`!s t:A->bool. FINITE t /\ s =_c t ==> FINITE s`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_FINITE]);; + +let CARD_LE_INFINITE = prove + (`!s:A->bool t:B->bool. INFINITE s /\ s <=_c t ==> INFINITE t`, + MESON_TAC[CARD_LE_FINITE; INFINITE]);; + +let CARD_LT_FINITE_INFINITE = prove + (`!s:A->bool t:B->bool. FINITE s /\ INFINITE t ==> s <_c t`, + REWRITE_TAC[GSYM CARD_NOT_LE; INFINITE] THEN MESON_TAC[CARD_LE_FINITE]);; + +let CARD_LE_CARD_IMP = prove + (`!s:A->bool t:B->bool. FINITE t /\ s <=_c t ==> CARD s <= CARD t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `FINITE(s:A->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CARD_LE_FINITE]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [le_c]) THEN + DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:A->B) s)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `(m = n:num) ==> n <= m`) THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE]]);; + +let CARD_EQ_CARD_IMP = prove + (`!s:A->bool t:B->bool. FINITE t /\ s =_c t ==> (CARD s = CARD t)`, + MESON_TAC[CARD_FINITE_CONG; LE_ANTISYM; CARD_LE_ANTISYM; CARD_LE_CARD_IMP]);; + +let CARD_LE_CARD = prove + (`!s:A->bool t:B->bool. + FINITE s /\ FINITE t ==> (s <=_c t <=> CARD s <= CARD t)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (~a ==> ~b) ==> (a <=> b)`) THEN + ASM_SIMP_TAC[CARD_LE_CARD_IMP] THEN + REWRITE_TAC[CARD_NOT_LE; NOT_LE] THEN REWRITE_TAC[lt_c; LT_LE] THEN + ASM_SIMP_TAC[CARD_LE_CARD_IMP] THEN + MATCH_MP_TAC(TAUT `(c ==> a ==> b) ==> a /\ ~b ==> ~c`) THEN + DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [CARD_LE_EQ_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `u:A->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + SUBGOAL_THEN `u:A->bool = s` (fun th -> ASM_MESON_TAC[th; CARD_EQ_SYM]) THEN + ASM_MESON_TAC[CARD_SUBSET_EQ; CARD_EQ_CARD_IMP; CARD_EQ_SYM]);; + +let CARD_EQ_CARD = prove + (`!s:A->bool t:B->bool. + FINITE s /\ FINITE t ==> (s =_c t <=> (CARD s = CARD t))`, + MESON_TAC[CARD_FINITE_CONG; LE_ANTISYM; CARD_LE_ANTISYM; CARD_LE_CARD]);; + +let CARD_LT_CARD = prove + (`!s:A->bool t:B->bool. + FINITE s /\ FINITE t ==> (s <_c t <=> CARD s < CARD t)`, + SIMP_TAC[CARD_LE_CARD; GSYM NOT_LE; GSYM CARD_NOT_LE]);; + +let CARD_HAS_SIZE_CONG = prove + (`!s:A->bool t:B->bool n. s HAS_SIZE n /\ s =_c t ==> t HAS_SIZE n`, + REWRITE_TAC[HAS_SIZE] THEN + MESON_TAC[CARD_EQ_CARD; CARD_FINITE_CONG]);; + +let CARD_LE_IMAGE = prove + (`!f s. IMAGE f s <=_c s`, + REWRITE_TAC[LE_C; FORALL_IN_IMAGE] THEN MESON_TAC[]);; + +let CARD_LE_IMAGE_GEN = prove + (`!f:A->B s t. t SUBSET IMAGE f s ==> t <=_c s`, + REPEAT STRIP_TAC THEN TRANS_TAC CARD_LE_TRANS `IMAGE (f:A->B) s` THEN + ASM_SIMP_TAC[CARD_LE_IMAGE; CARD_LE_SUBSET]);; + +let CARD_EQ_IMAGE = prove + (`!f:A->B s. + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> IMAGE f s =_c s`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + REWRITE_TAC[eq_c] THEN EXISTS_TAC `f:A->B` THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinal arithmetic operations. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("+_c",(16,"right"));; +parse_as_infix("*_c",(20,"right"));; + +let add_c = new_definition + `s +_c t = {INL x | x IN s} UNION {INR y | y IN t}`;; + +let mul_c = new_definition + `s *_c t = {(x,y) | x IN s /\ y IN t}`;; + +(* ------------------------------------------------------------------------- *) +(* Congruence properties for the arithmetic operators. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_ADD = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s <=_c s' /\ t <=_c t' ==> s +_c t <=_c s' +_c t'`, + REPEAT GEN_TAC THEN REWRITE_TAC[le_c; add_c] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `g:C->D` STRIP_ASSUME_TAC)) THEN + MP_TAC(prove_recursive_functions_exist sum_RECURSION + `(!x. h(INL x) = INL((f:A->B) x)) /\ (!y. h(INR y) = INR((g:C->D) y))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:(A+C)->(B+D)` THEN STRIP_TAC THEN + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN + CONJ_TAC THEN REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[]) THEN + ASM_REWRITE_TAC[sum_DISTINCT; + sum_INJECTIVE] THEN + ASM_MESON_TAC[]);; + +let CARD_LE_MUL = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s <=_c s' /\ t <=_c t' ==> s *_c t <=_c s' *_c t'`, + REPEAT GEN_TAC THEN REWRITE_TAC[le_c; mul_c] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `g:C->D` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\(x,y). (f:A->B) x,(g:C->D) y` THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[]);; + +let CARD_FUNSPACE_LE = prove + (`(:A) <=_c (:A') /\ (:B) <=_c (:B') ==> (:A->B) <=_c (:A'->B')`, + REWRITE_TAC[le_c; IN_UNIV] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `f:A->A'`) (X_CHOOSE_TAC `g:B->B'`)) THEN + SUBGOAL_THEN `?f':A'->A. !x. f'(f x) = x` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM INJECTIVE_LEFT_INVERSE]; ALL_TAC] THEN + EXISTS_TAC `\h. (g:B->B') o (h:A->B) o (f':A'->A)` THEN + ASM_REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN ASM_MESON_TAC[]);; + +let CARD_ADD_CONG = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s =_c s' /\ t =_c t' ==> s +_c t =_c s' +_c t'`, + SIMP_TAC[CARD_LE_ADD; GSYM CARD_LE_ANTISYM]);; + +let CARD_MUL_CONG = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s =_c s' /\ t =_c t' ==> s *_c t =_c s' *_c t'`, + SIMP_TAC[CARD_LE_MUL; GSYM CARD_LE_ANTISYM]);; + +let CARD_FUNSPACE_CONG = prove + (`(:A) =_c (:A') /\ (:B) =_c (:B') ==> (:A->B) =_c (:A'->B')`, + SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_FUNSPACE_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Misc lemmas. *) +(* ------------------------------------------------------------------------- *) + +let MUL_C_UNIV = prove + (`(:A) *_c (:B) = (:A#B)`, + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; mul_c; IN_ELIM_PAIR_THM; IN_UNIV]);; + +let CARD_FUNSPACE_CURRY = prove + (`(:A->B->C) =_c (:A#B->C)`, + REWRITE_TAC[EQ_C_BIJECTIONS] THEN + EXISTS_TAC `\(f:A->B->C) (x,y). f x y` THEN + EXISTS_TAC `\(g:A#B->C) x y. g(x,y)` THEN + REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; + +let IN_CARD_ADD = prove + (`(!x. INL(x) IN (s +_c t) <=> x IN s) /\ + (!y. INR(y) IN (s +_c t) <=> y IN t)`, + REWRITE_TAC[add_c; IN_UNION; IN_ELIM_THM] THEN + REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE] THEN MESON_TAC[]);; + +let IN_CARD_MUL = prove + (`!s t x y. (x,y) IN (s *_c t) <=> x IN s /\ y IN t`, + REWRITE_TAC[mul_c; IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[]);; + +let CARD_LE_SQUARE = prove + (`!s:A->bool. s <=_c s *_c s`, + GEN_TAC THEN REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. x,(@z:A. z IN s)` THEN + SIMP_TAC[IN_CARD_MUL; PAIR_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN MESON_TAC[]);; + +let CARD_SQUARE_NUM = prove + (`(UNIV:num->bool) *_c (UNIV:num->bool) =_c (UNIV:num->bool)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_SQUARE] THEN + REWRITE_TAC[le_c; IN_UNIV; mul_c; IN_ELIM_THM] THEN + EXISTS_TAC `\(x,y). NUMPAIR x y` THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[NUMPAIR_INJ]);; + +let UNION_LE_ADD_C = prove + (`!s t:A->bool. (s UNION t) <=_c s +_c t`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CARD_LE_IMAGE_GEN THEN + EXISTS_TAC `function INL x -> (x:A) | INR x -> x` THEN + REWRITE_TAC[add_c; IMAGE_UNION] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN SET_TAC[]);; + +let CARD_ADD_C = prove + (`!s t. FINITE s /\ FINITE t ==> CARD(s +_c t) = CARD s + CARD t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[add_c] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNION o lhand o snd) THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE] THEN + REWRITE_TAC[SET_RULE `IMAGE f s INTER IMAGE g t = {} <=> + !x y. x IN s /\ y IN t ==> ~(f x = g y)`] THEN + REWRITE_TAC[sum_DISTINCT] THEN DISCH_THEN SUBST1_TAC THEN + BINOP_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN + ASM_SIMP_TAC[sum_INJECTIVE]);; + +(* ------------------------------------------------------------------------- *) +(* Various "arithmetical" lemmas. *) +(* ------------------------------------------------------------------------- *) + +let CARD_ADD_SYM = prove + (`!s:A->bool t:B->bool. s +_c t =_c t +_c s`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN + MP_TAC(prove_recursive_functions_exist sum_RECURSION + `(!x. (h:A+B->B+A) (INL x) = INR x) /\ (!y. h(INR y) = INL y)`) THEN + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[FORALL_SUM_THM; EXISTS_SUM_THM; EXISTS_UNIQUE_THM] THEN + REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN MESON_TAC[]);; + +let CARD_ADD_ASSOC = prove + (`!s:A->bool t:B->bool u:C->bool. s +_c (t +_c u) =_c (s +_c t) +_c u`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN + CHOOSE_TAC(prove_recursive_functions_exist sum_RECURSION + `(!u. (i:B+C->(A+B)+C) (INL u) = INL(INR u)) /\ + (!v. i(INR v) = INR v)`) THEN + MP_TAC(prove_recursive_functions_exist sum_RECURSION + `(!x. (h:A+B+C->(A+B)+C) (INL x) = INL(INL x)) /\ + (!z. h(INR z) = i(z))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FORALL_SUM_THM; EXISTS_SUM_THM; EXISTS_UNIQUE_THM; + sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN + MESON_TAC[]);; + +let CARD_MUL_SYM = prove + (`!s:A->bool t:B->bool. s *_c t =_c t *_c s`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN + MP_TAC(prove_recursive_functions_exist pair_RECURSION + `(!x:A y:B. h(x,y) = (y,x))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM; IN_CARD_MUL; PAIR_EQ] THEN + MESON_TAC[]);; + +let CARD_MUL_ASSOC = prove + (`!s:A->bool t:B->bool u:C->bool. s *_c (t *_c u) =_c (s *_c t) *_c u`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN + CHOOSE_TAC(prove_recursive_functions_exist pair_RECURSION + `(!x y z. (i:A->B#C->(A#B)#C) x (y,z) = (x,y),z)`) THEN + MP_TAC(prove_recursive_functions_exist pair_RECURSION + `(!x p. (h:A#B#C->(A#B)#C) (x,p) = i x p)`) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM; IN_CARD_MUL; PAIR_EQ] THEN + MESON_TAC[]);; + +let CARD_LDISTRIB = prove + (`!s:A->bool t:B->bool u:C->bool. + s *_c (t +_c u) =_c (s *_c t) +_c (s *_c u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[eq_c] THEN + CHOOSE_TAC(prove_recursive_functions_exist sum_RECURSION + `(!x y. (i:A->(B+C)->A#B+A#C) x (INL y) = INL(x,y)) /\ + (!x z. (i:A->(B+C)->A#B+A#C) x (INR z) = INR(x,z))`) THEN + MP_TAC(prove_recursive_functions_exist pair_RECURSION + `(!x s. (h:A#(B+C)->(A#B)+(A#C)) (x,s) = i x s)`) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[EXISTS_UNIQUE_THM; FORALL_PAIR_THM; EXISTS_PAIR_THM; + FORALL_SUM_THM; EXISTS_SUM_THM; PAIR_EQ; IN_CARD_MUL; + sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN + MESON_TAC[]);; + +let CARD_RDISTRIB = prove + (`!s:A->bool t:B->bool u:C->bool. + (s +_c t) *_c u =_c (s *_c u) +_c (t *_c u)`, + REPEAT GEN_TAC THEN + TRANS_TAC CARD_EQ_TRANS + `(u:C->bool) *_c ((s:A->bool) +_c (t:B->bool))` THEN + REWRITE_TAC[CARD_MUL_SYM] THEN + TRANS_TAC CARD_EQ_TRANS + `(u:C->bool) *_c (s:A->bool) +_c (u:C->bool) *_c (t:B->bool)` THEN + REWRITE_TAC[CARD_LDISTRIB] THEN + MATCH_MP_TAC CARD_ADD_CONG THEN REWRITE_TAC[CARD_MUL_SYM]);; + +let CARD_LE_ADDR = prove + (`!s:A->bool t:B->bool. s <=_c s +_c t`, + REPEAT GEN_TAC THEN REWRITE_TAC[le_c] THEN + EXISTS_TAC `INL:A->A+B` THEN SIMP_TAC[IN_CARD_ADD; sum_INJECTIVE]);; + +let CARD_LE_ADDL = prove + (`!s:A->bool t:B->bool. t <=_c s +_c t`, + REPEAT GEN_TAC THEN REWRITE_TAC[le_c] THEN + EXISTS_TAC `INR:B->A+B` THEN SIMP_TAC[IN_CARD_ADD; sum_INJECTIVE]);; + +(* ------------------------------------------------------------------------- *) +(* A rather special lemma but temporarily useful. *) +(* ------------------------------------------------------------------------- *) + +let CARD_ADD_LE_MUL_INFINITE = prove + (`!s:A->bool. INFINITE s ==> s +_c s <=_c s *_c s`, + GEN_TAC THEN REWRITE_TAC[INFINITE_CARD_LE; le_c; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN + MP_TAC(prove_recursive_functions_exist sum_RECURSION + `(!x. h(INL x) = (f(0),x):A#A) /\ (!x. h(INR x) = (f(1),x))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:A+A->A#A` THEN + STRIP_TAC THEN + REPEAT((MATCH_MP_TAC sum_INDUCT THEN + ASM_REWRITE_TAC[IN_CARD_ADD; IN_CARD_MUL; PAIR_EQ]) + ORELSE STRIP_TAC) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[NUM_REDUCE_CONV `1 = 0`]);; + +(* ------------------------------------------------------------------------- *) +(* Relate cardinal addition to the simple union operation. *) +(* ------------------------------------------------------------------------- *) + +let CARD_DISJOINT_UNION = prove + (`!s:A->bool t. (s INTER t = {}) ==> (s UNION t =_c s +_c t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + STRIP_TAC THEN REWRITE_TAC[eq_c; IN_UNION] THEN + EXISTS_TAC `\x:A. if x IN s then INL x else INR x` THEN + REWRITE_TAC[FORALL_SUM_THM; IN_CARD_ADD] THEN + REWRITE_TAC[COND_RAND; COND_RATOR] THEN + REWRITE_TAC[TAUT `(if b then x else y) <=> b /\ x \/ ~b /\ y`] THEN + REWRITE_TAC[sum_DISTINCT; sum_INJECTIVE; IN_CARD_ADD] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The key to arithmetic on infinite cardinals: k^2 = k. *) +(* ------------------------------------------------------------------------- *) + +let CARD_SQUARE_INFINITE = prove + (`!k:A->bool. INFINITE k ==> (k *_c k =_c k)`, + let lemma = prove + (`INFINITE(s:A->bool) /\ s SUBSET k /\ + (!x y. R(x,y) ==> x IN (s *_c s) /\ y IN s) /\ + (!x. x IN (s *_c s) ==> ?!y. y IN s /\ R(x,y)) /\ + (!y:A. y IN s ==> ?!x. x IN (s *_c s) /\ R(x,y)) + ==> (s = {z | ?p. R(p,z)})`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]) in + REPEAT STRIP_TAC THEN + ABBREV_TAC + `P = \R. ?s. INFINITE(s:A->bool) /\ s SUBSET k /\ + (!x y. R(x,y) ==> x IN (s *_c s) /\ y IN s) /\ + (!x. x IN (s *_c s) ==> ?!y. y IN s /\ R(x,y)) /\ + (!y. y IN s ==> ?!x. x IN (s *_c s) /\ R(x,y))` THEN + MP_TAC(ISPEC `P:((A#A)#A->bool)->bool` ZL_SUBSETS_UNIONS_NONEMPTY) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EQ_C] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INFINITE_CARD_LE]) THEN + REWRITE_TAC[CARD_LE_EQ_SUBSET] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:A->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[num_INFINITE; CARD_INFINITE_CONG]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> + MP_TAC(MATCH_MP CARD_MUL_CONG (CONJ th th))) THEN + GEN_REWRITE_TAC LAND_CONV [CARD_EQ_SYM] THEN + DISCH_THEN(MP_TAC o C CONJ CARD_SQUARE_NUM) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_TRANS) THEN + FIRST_ASSUM(fun th -> + DISCH_THEN(ACCEPT_TAC o MATCH_MP CARD_EQ_TRANS o C CONJ th)); + ALL_TAC] THEN + SUBGOAL_THEN + `P = \R. INFINITE {z | ?x y. R((x,y),z)} /\ + (!x:A y z. R((x,y),z) ==> x IN k /\ y IN k /\ z IN k) /\ + (!x y. (?u v. R((u,v),x)) /\ (?u v. R((u,v),y)) + ==> ?z. R((x,y),z)) /\ + (!x y. (?z. R((x,y),z)) + ==> (?u v. R((u,v),x)) /\ (?u v. R((u,v),y))) /\ + (!x y z1 z2. R((x,y),z1) /\ R((x,y),z2) ==> (z1 = z2)) /\ + (!x1 y1 x2 y2 z. R((x1,y1),z) /\ R((x2,y2),z) + ==> (x1 = x2) /\ (y1 = y2))` + SUBST1_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[MATCH_MP(TAUT `(a ==> b) ==> (a <=> b /\ a)`) lemma] THEN + REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[FUN_EQ_THM] THEN + REWRITE_TAC[IN_CARD_MUL; EXISTS_PAIR_THM; SUBSET; FUN_EQ_THM; + IN_ELIM_THM; FORALL_PAIR_THM; EXISTS_UNIQUE_THM; + UNIONS; PAIR_EQ] THEN + GEN_TAC THEN AP_TERM_TAC THEN MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REWRITE_TAC[] THEN GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [FORALL_AND_THM] THEN + MATCH_MP_TAC(TAUT + `(c /\ d ==> f) /\ (a /\ b ==> e) + ==> (a /\ (b /\ c) /\ d ==> e /\ f)`) THEN + CONJ_TAC THENL + [REWRITE_TAC[UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `s:(A#A)#A->bool`) MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `s:(A#A)#A->bool`) THEN + ASM_REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; UNIONS] THEN ASM_MESON_TAC[IN]; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `R:(A#A)#A->bool` + (CONJUNCTS_THEN2 (X_CHOOSE_TAC `s:A->bool`) ASSUME_TAC)) THEN + SUBGOAL_THEN `(s:A->bool) *_c s =_c s` ASSUME_TAC THENL + [REWRITE_TAC[EQ_C] THEN EXISTS_TAC `R:(A#A)#A->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `s +_c s <=_c (s:A->bool)` ASSUME_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(s:A->bool) *_c s` THEN + ASM_SIMP_TAC[CARD_EQ_IMP_LE; CARD_ADD_LE_MUL_INFINITE]; + ALL_TAC] THEN + SUBGOAL_THEN `(s:A->bool) INTER (k DIFF s) = {}` ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_DIFF; NOT_IN_EMPTY] THEN MESON_TAC[]; + ALL_TAC] THEN + DISJ_CASES_TAC(ISPECL [`k DIFF (s:A->bool)`; `s:A->bool`] CARD_LE_TOTAL) + THENL + [SUBGOAL_THEN `k = (s:A->bool) UNION (k DIFF s)` SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN + REWRITE_TAC[SUBSET; EXTENSION; IN_INTER; NOT_IN_EMPTY; + IN_UNION; IN_DIFF] THEN + MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_SQUARE] THEN + TRANS_TAC CARD_LE_TRANS + `((s:A->bool) +_c (k DIFF s:A->bool)) *_c (s +_c k DIFF s)` THEN + ASM_SIMP_TAC[CARD_DISJOINT_UNION; CARD_EQ_IMP_LE; CARD_MUL_CONG] THEN + TRANS_TAC CARD_LE_TRANS `((s:A->bool) +_c s) *_c (s +_c s)` THEN + ASM_SIMP_TAC[CARD_LE_ADD; CARD_LE_MUL; CARD_LE_REFL] THEN + TRANS_TAC CARD_LE_TRANS `(s:A->bool) *_c s` THEN + ASM_SIMP_TAC[CARD_LE_MUL] THEN + TRANS_TAC CARD_LE_TRANS `s:A->bool` THEN ASM_SIMP_TAC[CARD_EQ_IMP_LE] THEN + REWRITE_TAC[CARD_LE_EQ_SUBSET] THEN EXISTS_TAC `s:A->bool` THEN + SIMP_TAC[CARD_EQ_REFL; SUBSET; IN_UNION]; + ALL_TAC] THEN + UNDISCH_TAC `s:A->bool <=_c k DIFF s` THEN + REWRITE_TAC[CARD_LE_EQ_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `d:A->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(s:A->bool *_c d) UNION (d *_c s) UNION (d *_c d) =_c d` + MP_TAC THENL + [TRANS_TAC CARD_EQ_TRANS + `((s:A->bool) *_c (d:A->bool)) +_c ((d *_c s) +_c (d *_c d))` THEN + CONJ_TAC THENL + [TRANS_TAC CARD_EQ_TRANS + `((s:A->bool) *_c d) +_c ((d *_c s) UNION (d *_c d))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CARD_ADD_CONG THEN REWRITE_TAC[CARD_EQ_REFL]] THEN + MATCH_MP_TAC CARD_DISJOINT_UNION THEN + UNDISCH_TAC `s INTER (k DIFF s:A->bool) = {}` THEN + UNDISCH_TAC `d SUBSET (k DIFF s:A->bool)` THEN + REWRITE_TAC[EXTENSION; SUBSET; FORALL_PAIR_THM; NOT_IN_EMPTY; + IN_INTER; IN_UNION; IN_CARD_MUL; IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + TRANS_TAC CARD_EQ_TRANS `s:A->bool` THEN ASM_REWRITE_TAC[] THEN + TRANS_TAC CARD_EQ_TRANS + `(s:A->bool *_c s) +_c (s *_c s) +_c (s *_c s)` THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CARD_ADD_CONG THEN CONJ_TAC) THEN + MATCH_MP_TAC CARD_MUL_CONG THEN ASM_REWRITE_TAC[CARD_EQ_REFL] THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + TRANS_TAC CARD_EQ_TRANS `(s:A->bool) +_c s +_c s` THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CARD_ADD_CONG THEN ASM_REWRITE_TAC[]); + ALL_TAC] THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_ADDR] THEN + TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c s` THEN + ASM_SIMP_TAC[CARD_LE_ADD; CARD_LE_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[EQ_C; IN_UNION] THEN + DISCH_THEN(X_CHOOSE_TAC `S:(A#A)#A->bool`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\x:(A#A)#A. R(x) \/ S(x)`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `(s:A->bool) UNION d`; + SIMP_TAC[SUBSET; IN]; + SUBGOAL_THEN `~(d:A->bool = {})` MP_TAC THENL + [DISCH_THEN(MP_TAC o AP_TERM `FINITE:(A->bool)->bool`) THEN + REWRITE_TAC[FINITE_RULES; GSYM INFINITE] THEN + ASM_MESON_TAC[CARD_INFINITE_CONG]; + ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP + (ASSUME `a:A IN d`) o last o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o EXISTENCE) THEN + DISCH_THEN(X_CHOOSE_THEN `b:A#A` (CONJUNCTS_THEN ASSUME_TAC)) THEN + REWRITE_TAC[EXTENSION; NOT_FORALL_THM] THEN + EXISTS_TAC `(b:A#A,a:A)` THEN ASM_REWRITE_TAC[IN] THEN + DISCH_THEN(fun th -> FIRST_ASSUM + (MP_TAC o CONJUNCT2 o C MATCH_MP th o CONJUNCT1)) THEN + MAP_EVERY UNDISCH_TAC + [`a:A IN d`; `(d:A->bool) SUBSET (k DIFF s)`] THEN + REWRITE_TAC[SUBSET; IN_DIFF] THEN MESON_TAC[]] THEN + REWRITE_TAC[INFINITE; FINITE_UNION; DE_MORGAN_THM] THEN + ASM_REWRITE_TAC[GSYM INFINITE] THEN CONJ_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`(d:A->bool) SUBSET (k DIFF s)`; `(s:A->bool) SUBSET k`] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl)) THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_UNIQUE_THM; EXISTS_PAIR_THM; + IN_CARD_MUL; IN_UNION; PAIR_EQ] THEN + MAP_EVERY UNDISCH_TAC + [`(s:A->bool) SUBSET k`; + `(d:A->bool) SUBSET (k DIFF s)`] THEN + REWRITE_TAC[SUBSET; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_DIFF] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REPEAT DISCH_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ALL_TAC] THEN + GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + DISCH_THEN(fun th -> + FIRST_ASSUM(MP_TAC o C MATCH_MP th o last o CONJUNCTS)) THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of finiteness. *) +(* ------------------------------------------------------------------------- *) + +let CARD_ADD_FINITE = prove + (`!s t. FINITE s /\ FINITE t ==> FINITE(s +_c t)`, + SIMP_TAC[add_c; FINITE_UNION; SIMPLE_IMAGE; FINITE_IMAGE]);; + +let CARD_ADD_FINITE_EQ = prove + (`!s:A->bool t:B->bool. FINITE(s +_c t) <=> FINITE s /\ FINITE t`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CARD_ADD_FINITE] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) THEN + REWRITE_TAC[CARD_LE_ADDL; CARD_LE_ADDR]);; + +let CARD_MUL_FINITE = prove + (`!s t. FINITE s /\ FINITE t ==> FINITE(s *_c t)`, + SIMP_TAC[mul_c; FINITE_PRODUCT]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the "absorption laws" for arithmetic with an infinite cardinal. *) +(* ------------------------------------------------------------------------- *) + +let CARD_MUL_ABSORB_LE = prove + (`!s:A->bool t:B->bool. INFINITE(t) /\ s <=_c t ==> s *_c t <=_c t`, + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `(t:B->bool) *_c t` THEN + ASM_SIMP_TAC[CARD_LE_MUL; CARD_LE_REFL; + CARD_SQUARE_INFINITE; CARD_EQ_IMP_LE]);; + +let CARD_MUL2_ABSORB_LE = prove + (`!s:A->bool t:B->bool u:C->bool. + INFINITE(u) /\ s <=_c u /\ t <=_c u ==> s *_c t <=_c u`, + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `(s:A->bool) *_c (u:C->bool)` THEN + ASM_SIMP_TAC[CARD_MUL_ABSORB_LE] THEN MATCH_MP_TAC CARD_LE_MUL THEN + ASM_REWRITE_TAC[CARD_LE_REFL]);; + +let CARD_ADD_ABSORB_LE = prove + (`!s:A->bool t:B->bool. INFINITE(t) /\ s <=_c t ==> s +_c t <=_c t`, + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `(t:B->bool) *_c t` THEN + ASM_SIMP_TAC[CARD_SQUARE_INFINITE; CARD_EQ_IMP_LE] THEN + TRANS_TAC CARD_LE_TRANS `(t:B->bool) +_c t` THEN + ASM_SIMP_TAC[CARD_ADD_LE_MUL_INFINITE; CARD_LE_ADD; CARD_LE_REFL]);; + +let CARD_ADD2_ABSORB_LE = prove + (`!s:A->bool t:B->bool u:C->bool. + INFINITE(u) /\ s <=_c u /\ t <=_c u ==> s +_c t <=_c u`, + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c (u:C->bool)` THEN + ASM_SIMP_TAC[CARD_ADD_ABSORB_LE] THEN MATCH_MP_TAC CARD_LE_ADD THEN + ASM_REWRITE_TAC[CARD_LE_REFL]);; + +let CARD_MUL_ABSORB = prove + (`!s:A->bool t:B->bool. + INFINITE(t) /\ ~(s = {}) /\ s <=_c t ==> s *_c t =_c t`, + SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_MUL_ABSORB_LE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:B. (a:A,x)` THEN + ASM_SIMP_TAC[IN_CARD_MUL; PAIR_EQ]);; + +let CARD_ADD_ABSORB = prove + (`!s:A->bool t:B->bool. INFINITE(t) /\ s <=_c t ==> s +_c t =_c t`, + SIMP_TAC[GSYM CARD_LE_ANTISYM; CARD_LE_ADDL; CARD_ADD_ABSORB_LE]);; + +let CARD_ADD2_ABSORB_LT = prove + (`!s:A->bool t:B->bool u:C->bool. + INFINITE u /\ s <_c u /\ t <_c u ==> s +_c t <_c u`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `FINITE((s:A->bool) +_c (t:B->bool))` THEN + ASM_SIMP_TAC[CARD_LT_FINITE_INFINITE] THEN + DISJ_CASES_TAC(ISPECL [`s:A->bool`; `t:B->bool`] CARD_LE_TOTAL) THENL + [ASM_CASES_TAC `FINITE(t:B->bool)` THENL + [ASM_MESON_TAC[CARD_LE_FINITE; CARD_ADD_FINITE]; + TRANS_TAC CARD_LET_TRANS `t:B->bool`]; + ASM_CASES_TAC `FINITE(s:A->bool)` THENL + [ASM_MESON_TAC[CARD_LE_FINITE; CARD_ADD_FINITE]; + TRANS_TAC CARD_LET_TRANS `s:A->bool`]] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARD_ADD2_ABSORB_LE THEN + ASM_REWRITE_TAC[INFINITE; CARD_LE_REFL]);; + +let CARD_LT_ADD = prove + (`!s:A->bool s':B->bool t:C->bool t':D->bool. + s <_c s' /\ t <_c t' ==> s +_c t <_c s' +_c t'`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `FINITE((s':B->bool) +_c (t':D->bool))` THENL + [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I + [CARD_ADD_FINITE_EQ]) THEN + SUBGOAL_THEN `FINITE(s:A->bool) /\ FINITE(t:C->bool)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_FINITE) o + MATCH_MP CARD_LT_IMP_LE) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY UNDISCH_TAC + [`(s:A->bool) <_c (s':B->bool)`; + `(t:C->bool) <_c (t':D->bool)`] THEN + ASM_SIMP_TAC[CARD_LT_CARD; CARD_ADD_FINITE; CARD_ADD_C] THEN + ARITH_TAC]; + MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN ASM_REWRITE_TAC[INFINITE] THEN + CONJ_TAC THENL + [TRANS_TAC CARD_LTE_TRANS `s':B->bool` THEN + ASM_REWRITE_TAC[CARD_LE_ADDR]; + TRANS_TAC CARD_LTE_TRANS `t':D->bool` THEN + ASM_REWRITE_TAC[CARD_LE_ADDL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Some more ad-hoc but useful theorems. *) +(* ------------------------------------------------------------------------- *) + +let CARD_MUL_LT_LEMMA = prove + (`!s t:B->bool u. s <=_c t /\ t <_c u /\ INFINITE u ==> s *_c t <_c u`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(t:B->bool)` THENL + [REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[CARD_NOT_LT; INFINITE] THEN + ASM_MESON_TAC[CARD_LE_FINITE; CARD_MUL_FINITE]; + ASM_MESON_TAC[INFINITE; CARD_MUL_ABSORB_LE; CARD_LET_TRANS]]);; + +let CARD_MUL_LT_INFINITE = prove + (`!s:A->bool t:B->bool u. s <_c u /\ t <_c u /\ INFINITE u ==> s *_c t <_c u`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(ISPECL [`s:A->bool`; `t:B->bool`] CARD_LE_TOTAL) THENL + [ASM_MESON_TAC[CARD_MUL_SYM; CARD_MUL_LT_LEMMA]; + STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `t:B->bool *_c s:A->bool` THEN + ASM_MESON_TAC[CARD_EQ_IMP_LE; CARD_MUL_SYM; CARD_MUL_LT_LEMMA]]);; + +(* ------------------------------------------------------------------------- *) +(* Cantor's theorem. *) +(* ------------------------------------------------------------------------- *) + +let CANTOR_THM = prove + (`!s:A->bool. s <_c {t | t SUBSET s}`, + GEN_TAC THEN REWRITE_TAC[lt_c] THEN CONJ_TAC THENL + [REWRITE_TAC[le_c] THEN EXISTS_TAC `(=):A->A->bool` THEN + REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM; SUBSET; IN] THEN MESON_TAC[]; + REWRITE_TAC[LE_C; IN_ELIM_THM; SURJECTIVE_RIGHT_INVERSE] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `g:A->(A->bool)` THEN + DISCH_THEN(MP_TAC o SPEC `\x:A. s(x) /\ ~(g x x)`) THEN + REWRITE_TAC[SUBSET; IN; FUN_EQ_THM] THEN MESON_TAC[]]);; + +let CANTOR_THM_UNIV = prove + (`(UNIV:A->bool) <_c (UNIV:(A->bool)->bool)`, + MP_TAC(ISPEC `UNIV:A->bool` CANTOR_THM) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; SUBSET; IN_UNIV; IN_ELIM_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about countability. *) +(* ------------------------------------------------------------------------- *) + +let NUM_COUNTABLE = prove + (`COUNTABLE(:num)`, + REWRITE_TAC[COUNTABLE; ge_c; CARD_LE_REFL]);; + +let COUNTABLE_ALT = prove + (`!s. COUNTABLE s <=> s <=_c (:num)`, + REWRITE_TAC[COUNTABLE; ge_c]);; + +let COUNTABLE_CASES = prove + (`!s. COUNTABLE s <=> FINITE s \/ s =_c (:num)`, + REWRITE_TAC[COUNTABLE_ALT; FINITE_CARD_LT; CARD_LE_LT]);; + +let CARD_LE_COUNTABLE = prove + (`!s t:A->bool. COUNTABLE t /\ s <=_c t ==> COUNTABLE s`, + REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `t:A->bool` THEN ASM_REWRITE_TAC[]);; + +let CARD_EQ_COUNTABLE = prove + (`!s t:A->bool. COUNTABLE t /\ s =_c t ==> COUNTABLE s`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_COUNTABLE]);; + +let CARD_COUNTABLE_CONG = prove + (`!s t. s =_c t ==> (COUNTABLE s <=> COUNTABLE t)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN MESON_TAC[CARD_LE_COUNTABLE]);; + +let COUNTABLE_SUBSET = prove + (`!s t:A->bool. COUNTABLE t /\ s SUBSET t ==> COUNTABLE s`, + REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `t:A->bool` THEN + ASM_SIMP_TAC[CARD_LE_SUBSET]);; + +let COUNTABLE_RESTRICT = prove + (`!s P. COUNTABLE s ==> COUNTABLE {x | x IN s /\ P x}`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + SET_TAC[]);; + +let COUNTABLE_SUBSET_NUM = prove + (`!s:num->bool. COUNTABLE s`, + MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV]);; + +let FINITE_IMP_COUNTABLE = prove + (`!s. FINITE s ==> COUNTABLE s`, + SIMP_TAC[FINITE_CARD_LT; lt_c; COUNTABLE; ge_c]);; + +let COUNTABLE_IMAGE = prove + (`!f:A->B s. COUNTABLE s ==> COUNTABLE (IMAGE f s)`, + REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `s:A->bool` THEN + ASM_SIMP_TAC[CARD_LE_IMAGE]);; + +let COUNTABLE_IMAGE_INJ_GENERAL = prove + (`!(f:A->B) A s. + (!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ + COUNTABLE A + ==> COUNTABLE {x | x IN s /\ f(x) IN A}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `IMAGE (g:B->A) A` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);; + +let COUNTABLE_IMAGE_INJ_EQ = prove + (`!(f:A->B) s. + (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) + ==> (COUNTABLE(IMAGE f s) <=> COUNTABLE s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP COUNTABLE_IMAGE_INJ_GENERAL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +let COUNTABLE_IMAGE_INJ = prove + (`!(f:A->B) A. + (!x y. (f(x) = f(y)) ==> (x = y)) /\ + COUNTABLE A + ==> COUNTABLE {x | f(x) IN A}`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`f:A->B`; `A:B->bool`; `UNIV:A->bool`] + COUNTABLE_IMAGE_INJ_GENERAL) THEN REWRITE_TAC[IN_UNIV]);; + +let COUNTABLE_EMPTY = prove + (`COUNTABLE {}`, + SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_RULES]);; + +let COUNTABLE_INTER = prove + (`!s t. COUNTABLE s \/ COUNTABLE t ==> COUNTABLE (s INTER t)`, + REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + REPEAT GEN_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + SET_TAC[]);; + +let COUNTABLE_UNION_IMP = prove + (`!s t:A->bool. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s UNION t)`, + REWRITE_TAC[COUNTABLE; ge_c] THEN REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `(s:A->bool) +_c (t:A->bool)` THEN + ASM_SIMP_TAC[CARD_ADD2_ABSORB_LE; num_INFINITE; UNION_LE_ADD_C]);; + +let COUNTABLE_UNION = prove + (`!s t:A->bool. COUNTABLE(s UNION t) <=> COUNTABLE s /\ COUNTABLE t`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COUNTABLE_UNION_IMP] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + SET_TAC[]);; + +let COUNTABLE_SING = prove + (`!x. COUNTABLE {x}`, + SIMP_TAC[FINITE_IMP_COUNTABLE; FINITE_SING]);; + +let COUNTABLE_INSERT = prove + (`!x s. COUNTABLE(x INSERT s) <=> COUNTABLE s`, + ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN + REWRITE_TAC[COUNTABLE_UNION; COUNTABLE_SING]);; + +let COUNTABLE_DELETE = prove + (`!x:A s. COUNTABLE(s DELETE x) <=> COUNTABLE s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:A) IN s` THEN + ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `COUNTABLE((x:A) INSERT (s DELETE x))` THEN CONJ_TAC THENL + [REWRITE_TAC[COUNTABLE_INSERT]; AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let COUNTABLE_DIFF_FINITE = prove + (`!s t. FINITE s ==> (COUNTABLE(t DIFF s) <=> COUNTABLE t)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[DIFF_EMPTY; SET_RULE `s DIFF (x INSERT t) = (s DIFF t) DELETE x`; + COUNTABLE_DELETE]);; + +let COUNTABLE_CROSS = prove + (`!s t. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s CROSS t)`, + REWRITE_TAC[COUNTABLE; ge_c; CROSS; GSYM mul_c] THEN + SIMP_TAC[CARD_MUL2_ABSORB_LE; num_INFINITE]);; + +let COUNTABLE_AS_IMAGE_SUBSET = prove + (`!s. COUNTABLE s ==> ?f. s SUBSET (IMAGE f (:num))`, + REWRITE_TAC[COUNTABLE; ge_c; LE_C; SUBSET; IN_IMAGE] THEN MESON_TAC[]);; + +let COUNTABLE_AS_IMAGE_SUBSET_EQ = prove + (`!s:A->bool. COUNTABLE s <=> ?f. s SUBSET (IMAGE f (:num))`, + REWRITE_TAC[COUNTABLE; ge_c; LE_C; SUBSET; IN_IMAGE] THEN MESON_TAC[]);; + +let COUNTABLE_AS_IMAGE = prove + (`!s:A->bool. COUNTABLE s /\ ~(s = {}) ==> ?f. s = IMAGE f (:num)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP COUNTABLE_AS_IMAGE_SUBSET) THEN + DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN + EXISTS_TAC `\n. if (f:num->A) n IN s then f n else a` THEN + ASM SET_TAC[]);; + +let FORALL_COUNTABLE_AS_IMAGE = prove + (`(!d. COUNTABLE d ==> P d) <=> P {} /\ (!f. P(IMAGE f (:num)))`, + MESON_TAC[COUNTABLE_AS_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; + COUNTABLE_EMPTY]);; + +let COUNTABLE_AS_INJECTIVE_IMAGE = prove + (`!s. COUNTABLE s /\ INFINITE s + ==> ?f. s = IMAGE f (:num) /\ (!m n. f(m) = f(n) ==> m = n)`, + GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[INFINITE_CARD_LE; COUNTABLE; ge_c] THEN + REWRITE_TAC[CARD_LE_ANTISYM; eq_c] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let COUNTABLE_UNIONS = prove + (`!A:(A->bool)->bool. + COUNTABLE A /\ (!s. s IN A ==> COUNTABLE s) + ==> COUNTABLE (UNIONS A)`, + GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [COUNTABLE_AS_IMAGE_SUBSET_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f:num->A->bool`) MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `g:(A->bool)->num->A`) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\(m,n). (g:(A->bool)->num->A) ((f:num->A->bool) m) n) + ((:num) CROSS (:num))` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; NUM_COUNTABLE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS; IN_UNIV] THEN + ASM SET_TAC[]);; + +let COUNTABLE_PRODUCT_DEPENDENT = prove + (`!f:A->B->C s t. + COUNTABLE s /\ (!x. x IN s ==> COUNTABLE(t x)) + ==> COUNTABLE {f x y | x IN s /\ y IN (t x)}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `{(f:A->B->C) x y | x IN s /\ y IN (t x)} = + IMAGE (\(x,y). f x y) {(x,y) | x IN s /\ y IN (t x)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + SET_TAC[]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN POP_ASSUM MP_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [COUNTABLE_AS_IMAGE_SUBSET_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `f:num->A`) MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `g:A->num->B`) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\(m,n). (f:num->A) m,(g:A->num->B)(f m) n) + ((:num) CROSS (:num))` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; NUM_COUNTABLE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN + REWRITE_TAC[IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; + EXISTS_PAIR_THM; IN_CROSS; IN_UNIV] THEN + ASM SET_TAC[]);; + +let COUNTABLE_CARD_MUL = prove + (`!s:A->bool t:B->bool. COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s *_c t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mul_c] THEN + ASM_SIMP_TAC[COUNTABLE_PRODUCT_DEPENDENT]);; + +let COUNTABLE_CARD_MUL_EQ = prove + (`!s:A->bool t:B->bool. + COUNTABLE(s *_c t) <=> s = {} \/ t = {} \/ COUNTABLE s /\ COUNTABLE t`, + REPEAT GEN_TAC THEN REWRITE_TAC[mul_c] THEN + MAP_EVERY ASM_CASES_TAC [`s:A->bool = {}`; `t:B->bool = {}`] THEN + ASM_REWRITE_TAC[COUNTABLE_EMPTY; EMPTY_GSPEC; NOT_IN_EMPTY; + SET_RULE `{x,y | F} = {}`] THEN + EQ_TAC THEN SIMP_TAC[REWRITE_RULE[mul_c] COUNTABLE_CARD_MUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THENL + [EXISTS_TAC `IMAGE FST ((s:A->bool) *_c (t:B->bool))`; + EXISTS_TAC `IMAGE SND ((s:A->bool) *_c (t:B->bool))`] THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; mul_c; SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN ASM SET_TAC[]);; + +let CARD_EQ_PCROSS = prove + (`!s:A^M->bool t:A^N->bool. s PCROSS t =_c s *_c t`, + REPEAT GEN_TAC THEN REWRITE_TAC[EQ_C_BIJECTIONS; mul_c] THEN + EXISTS_TAC `\z:A^(M,N)finite_sum. fstcart z,sndcart z` THEN + EXISTS_TAC `\(x:A^M,y:A^N). pastecart x y` THEN + REWRITE_TAC[FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; PASTECART_FST_SND] THEN + REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);; + +let COUNTABLE_PCROSS_EQ = prove + (`!s:A^M->bool t:A^N->bool. + COUNTABLE(s PCROSS t) <=> + s = {} \/ t = {} \/ COUNTABLE s /\ COUNTABLE t`, + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `COUNTABLE((s:A^M->bool) *_c (t:A^N->bool))` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_COUNTABLE_CONG THEN REWRITE_TAC[CARD_EQ_PCROSS]; + REWRITE_TAC[COUNTABLE_CARD_MUL_EQ]]);; + +let COUNTABLE_PCROSS = prove + (`!s:A^M->bool t:A^N->bool. + COUNTABLE s /\ COUNTABLE t ==> COUNTABLE(s PCROSS t)`, + SIMP_TAC[COUNTABLE_PCROSS_EQ]);; + +let COUNTABLE_CART = prove + (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> COUNTABLE {x | P i x}) + ==> COUNTABLE {v:A^N | !i. 1 <= i /\ i <= dimindex(:N) ==> P i (v$i)}`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + ==> COUNTABLE {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n + ==> P i (v$i)) /\ + (!i. 1 <= i /\ i <= dimindex(:N) /\ n < i + ==> v$i = @x. F)}` + (MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL; LET_ANTISYM] THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n /\ i <= 0 <=> F`] THEN + SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n /\ 0 < i <=> 1 <= i /\ i <= n`] THEN + SUBGOAL_THEN + `{v | !i. 1 <= i /\ i <= dimindex (:N) ==> v$i = (@x. F)} = + {(lambda i. @x. F):A^N}` + (fun th -> SIMP_TAC[COUNTABLE_SING;th]) THEN + SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM; CART_EQ; LAMBDA_BETA]; + ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC + `IMAGE (\(x:A,v:A^N). (lambda i. if i = SUC n then x else v$i):A^N) + {x,v | x IN {x:A | P (SUC n) x} /\ + v IN {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n + ==> P i (v$i)) /\ + (!i. 1 <= i /\ i <= dimindex (:N) /\ n < i + ==> v$i = (@x. F))}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN + ASM_SIMP_TAC[REWRITE_RULE[CROSS] COUNTABLE_CROSS; ARITH_RULE `1 <= SUC n`; + ARITH_RULE `SUC n <= m ==> n <= m`]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN + X_GEN_TAC `v:A^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN EXISTS_TAC `(v:A^N)$(SUC n)` THEN + EXISTS_TAC `(lambda i. if i = SUC n then @x. F else (v:A^N)$i):A^N` THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; ARITH_RULE `i <= n ==> ~(i = SUC n)`] THEN + ASM_MESON_TAC[LE; ARITH_RULE `1 <= SUC n`; + ARITH_RULE `n < i /\ ~(i = SUC n) ==> SUC n < i`]);; + +let COUNTABLE_SUBSET_IMAGE = prove + (`!f:A->B s t. + COUNTABLE(t) /\ t SUBSET (IMAGE f s) <=> + ?s'. COUNTABLE s' /\ s' SUBSET s /\ (t = IMAGE f s')`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[COUNTABLE_IMAGE; IMAGE_SUBSET]] THEN + STRIP_TAC THEN + EXISTS_TAC `IMAGE (\y. @x. x IN s /\ ((f:A->B)(x) = y)) t` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN + REWRITE_TAC[EXTENSION; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_IMAGE]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN X_GEN_TAC `y:B` THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[UNWIND_THM2; GSYM CONJ_ASSOC] THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE]);; + +let EXISTS_COUNTABLE_SUBSET_IMAGE = prove + (`!P f s. + (?t. COUNTABLE t /\ t SUBSET IMAGE f s /\ P t) <=> + (?t. COUNTABLE t /\ t SUBSET s /\ P (IMAGE f t))`, + REWRITE_TAC[COUNTABLE_SUBSET_IMAGE; CONJ_ASSOC] THEN MESON_TAC[]);; + +let FORALL_COUNTABLE_SUBSET_IMAGE = prove + (`!P f s. (!t. COUNTABLE t /\ t SUBSET IMAGE f s ==> P t) <=> + (!t. COUNTABLE t /\ t SUBSET s ==> P(IMAGE f t))`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[MESON[] `(!x. P x) <=> ~(?x. ~P x)`] THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; EXISTS_COUNTABLE_SUBSET_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality of infinite list and cartesian product types. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_LIST_GEN = prove + (`!s:A->bool. INFINITE(s) ==> {l | !x. MEM x l ==> x IN s} =_c s`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[le_c; IN_UNIV] THEN + EXISTS_TAC `\x:A. [x]` THEN SIMP_TAC[CONS_11; IN_ELIM_THM; MEM]] THEN + TRANS_TAC CARD_LE_TRANS `(:num) *_c (s:A->bool)` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN + ASM_REWRITE_TAC[GSYM INFINITE_CARD_LE; CARD_LE_REFL]] THEN + SUBGOAL_THEN `s *_c s <=_c (s:A->bool)` MP_TAC THENL + [MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN ASM_REWRITE_TAC[CARD_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[le_c; mul_c; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; PAIR_EQ] THEN + REWRITE_TAC[IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + GEN_REWRITE_TAC I [FORALL_CURRY] THEN + X_GEN_TAC `pair:A->A->A` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `?b:A. b IN s` CHOOSE_TAC THENL + [ASM_MESON_TAC[INFINITE; FINITE_EMPTY; MEMBER_NOT_EMPTY]; ALL_TAC] THEN + EXISTS_TAC `\l. LENGTH l,ITLIST (pair:A->A->A) l b` THEN + REWRITE_TAC[PAIR_EQ; RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN + SUBGOAL_THEN + `!l:A list. (!x. MEM x l ==> x IN s) ==> (ITLIST pair l b) IN s` + ASSUME_TAC THENL + [LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; ITLIST] THEN ASM_MESON_TAC[]; + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + LIST_INDUCT_TAC THEN SIMP_TAC[LENGTH_EQ_NIL; LENGTH] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_SUC] THEN + REWRITE_TAC[ITLIST; SUC_INJ; MEM; CONS_11] THEN + REPEAT STRIP_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN + ASM_MESON_TAC[]);; + +let CARD_EQ_LIST = prove + (`INFINITE(:A) ==> (:A list) =_c (:A)`, + DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_LIST_GEN) THEN + REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`]);; + +let CARD_EQ_CART = prove + (`INFINITE(:A) ==> (:A^N) =_c (:A)`, + DISCH_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[le_c; IN_UNIV] THEN + EXISTS_TAC `(\x. lambda i. x):A->A^N` THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + MESON_TAC[LE_REFL; DIMINDEX_GE_1]] THEN + TRANS_TAC CARD_LE_TRANS `(:A list)` THEN + ASM_SIMP_TAC[CARD_EQ_LIST; CARD_EQ_IMP_LE] THEN REWRITE_TAC[LE_C] THEN + EXISTS_TAC `(\l. lambda i. EL i l):(A)list->A^N` THEN + ASM_SIMP_TAC[CART_EQ; IN_UNIV; LAMBDA_BETA] THEN X_GEN_TAC `x:A^N` THEN + SUBGOAL_THEN `!n f. ?l. !i. i < n ==> EL i l:A = f i` MP_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN X_GEN_TAC `f:num->A` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\i. (f:num->A)(SUC i)`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `l:A list` THEN + DISCH_TAC THEN EXISTS_TAC `CONS ((f:num->A) 0) l` THEN + INDUCT_TAC THEN ASM_SIMP_TAC[EL; HD; TL; LT_SUC]; + DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)+1`; `\i. (x:A^N)$i`]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; ARITH_RULE `i < n + 1 <=> i <= n`] THEN + MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality of the reals. This is done in a rather laborious way to avoid *) +(* any dependence on the theories of analysis. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_REAL = prove + (`(:real) =_c (:num->bool)`, + let lemma = prove + (`!s m n. sum (s INTER (m..n)) (\i. inv(&3 pow i)) < &3 / &2 / &3 pow m`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (m..n) (\i. inv(&3 pow i))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[FINITE_NUMSEG; INTER_SUBSET; REAL_LE_INV_EQ; + REAL_POW_LE; REAL_POS]; + WF_INDUCT_TAC `n - m:num` THEN + ASM_CASES_TAC `m:num <= n` THENL + [ASM_SIMP_TAC[SUM_CLAUSES_LEFT] THEN ASM_CASES_TAC `m + 1 <= n` THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `SUC m`]) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ADD1; REAL_POW_ADD]] THEN + MATCH_MP_TAC(REAL_ARITH + `a + j:real <= k ==> x < j ==> a + x < k`) THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_1] THEN REAL_ARITH_TAC; + ALL_TAC]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE; GSYM NUMSEG_EMPTY]) THEN + ASM_REWRITE_TAC[SUM_CLAUSES; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH `inv x < &3 / &2 / x <=> &0 < inv x`] THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; + ARITH]]) in + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:num) *_c (:num->bool)` THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CARD_MUL2_ABSORB_LE THEN REWRITE_TAC[INFINITE_CARD_LE] THEN + SIMP_TAC[CANTOR_THM_UNIV; CARD_LT_IMP_LE; CARD_LE_REFL]] THEN + TRANS_TAC CARD_LE_TRANS `(:num) *_c {x:real | &0 <= x}` THEN CONJ_TAC THENL + [REWRITE_TAC[LE_C; mul_c; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM; IN_UNIV] THEN + EXISTS_TAC `\(n,x:real). --(&1) pow n * x` THEN X_GEN_TAC `x:real` THEN + MATCH_MP_TAC(MESON[] `P 0 \/ P 1 ==> ?n. P n`) THEN + REWRITE_TAC[OR_EXISTS_THM] THEN EXISTS_TAC `abs x` THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CARD_LE_MUL THEN REWRITE_TAC[CARD_LE_REFL] THEN + MP_TAC(ISPECL [`(:num)`; `(:num)`] CARD_MUL_ABSORB_LE) THEN + REWRITE_TAC[CARD_LE_REFL; num_INFINITE] THEN + REWRITE_TAC[le_c; mul_c; IN_UNIV; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[GSYM FORALL_PAIR_THM; INJECTIVE_LEFT_INVERSE] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`pair:num#num->num`; `unpair:num->num#num`] THEN + DISCH_TAC THEN + EXISTS_TAC `\x:real n:num. &(FST(unpair n)) * x <= &(SND(unpair n))` THEN + MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[IN_ELIM_THM; FUN_EQ_THM] THEN + CONJ_TAC THENL [REWRITE_TAC[EQ_SYM_EQ; CONJ_ACI]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GENL [`p:num`; `q:num`] o + SPEC `(pair:num#num->num) (p,q)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + MP_TAC(SPEC `y - x:real` REAL_ARCH) THEN + ASM_REWRITE_TAC[REAL_SUB_LT; NOT_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `&2`) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN + MP_TAC(ISPEC `&p * x:real` REAL_ARCH_LT) THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN + MATCH_MP_TAC num_INDUCTION THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; + REAL_ARITH `x:real < &0 <=> ~(&0 <= x)`] THEN + X_GEN_TAC `q:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + DISCH_THEN(K ALL_TAC) THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN + REWRITE_TAC[LT] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[le_c; IN_UNIV] THEN + EXISTS_TAC `\s:num->bool. sup { sum (s INTER (0..n)) (\i. inv(&3 pow i)) | + n IN (:num) }` THEN + MAP_EVERY X_GEN_TAC [`x:num->bool`; `y:num->bool`] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[EXTENSION; NOT_FORALL_THM] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + MAP_EVERY (fun w -> SPEC_TAC(w,w)) [`y:num->bool`; `x:num->bool`] THEN + MATCH_MP_TAC(MESON[IN] + `((!P Q n. R P Q n <=> R Q P n) /\ (!P Q. S P Q <=> S Q P)) /\ + (!P Q. (?n. n IN P /\ ~(n IN Q) /\ R P Q n) ==> S P Q) + ==> !P Q. (?n:num. ~(n IN P <=> n IN Q) /\ R P Q n) ==> S P Q`) THEN + CONJ_TAC THENL [REWRITE_TAC[EQ_SYM_EQ]; REWRITE_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`x:num->bool`; `y:num->bool`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `!z:real. y < z /\ z <= x ==> ~(x = y)`) THEN + EXISTS_TAC `sum (x INTER (0..n)) (\i. inv(&3 pow i))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `sum (y INTER (0..n)) (\i. inv(&3 pow i)) + + &3 / &2 / &3 pow (SUC n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_SUP_LE THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]] THEN + X_GEN_TAC `p:num` THEN ASM_CASES_TAC `n:num <= p` THENL + [MATCH_MP_TAC(REAL_ARITH + `!d. s:real = t + d /\ d <= e ==> s <= t + e`) THEN + EXISTS_TAC `sum(y INTER (n+1..p)) (\i. inv (&3 pow i))` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[INTER_COMM] THEN + REWRITE_TAC[INTER; SUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SUM_COMBINE_R; LE_0]; + SIMP_TAC[ADD1; lemma; REAL_LT_IMP_LE]]; + MATCH_MP_TAC(REAL_ARITH `y:real <= x /\ &0 <= d ==> y <= x + d`) THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_POW_LE] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC + (SET_RULE `s SUBSET t ==> u INTER s SUBSET u INTER t`) THEN + REWRITE_TAC[SUBSET_NUMSEG] THEN ASM_ARITH_TAC]; + ONCE_REWRITE_TAC[INTER_COMM] THEN + REWRITE_TAC[INTER; SUM_RESTRICT_SET] THEN ASM_CASES_TAC `n = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REWRITE_TAC[SUM_SING; NUMSEG_SING; real_pow] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_1; LE_0; REAL_ADD_RID] THEN + MATCH_MP_TAC(REAL_ARITH `s:real = t /\ d < e ==> s + d < t + e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) /\ m <= n - 1 ==> m < n`]; + REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 * x < x <=> &0 < x`] THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH]]]]; + MP_TAC(ISPEC `{ sum (x INTER (0..n)) (\i. inv(&3 pow i)) | n IN (:num) }` + SUP) THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `&3 / &2 / &3 pow 0` THEN + SIMP_TAC[lemma; REAL_LT_IMP_LE]]]);; + +let UNCOUNTABLE_REAL = prove + (`~COUNTABLE(:real)`, + REWRITE_TAC[COUNTABLE; CARD_NOT_LE; ge_c] THEN + TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN + REWRITE_TAC[CANTOR_THM_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN REWRITE_TAC[CARD_EQ_REAL]);; + +let CARD_EQ_REAL_IMP_UNCOUNTABLE = prove + (`!(s : A -> bool). s =_c (:real) ==> ~COUNTABLE s`, + GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o ISPEC `(:real)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CARD_EQ_COUNTABLE)) THEN + REWRITE_TAC[UNCOUNTABLE_REAL] THEN ASM_MESON_TAC[CARD_EQ_SYM]);; + +let COUNTABLE_IMP_CARD_LT_REAL = prove + (`!s:A->bool. COUNTABLE s ==> s <_c (:real)`, + REWRITE_TAC[GSYM CARD_NOT_LE] THEN + ASM_MESON_TAC[CARD_LE_COUNTABLE; UNCOUNTABLE_REAL]);; + +(* ------------------------------------------------------------------------- *) +(* More about cardinality of lists and restricted powersets etc. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_FINITE_SUBSETS = prove + (`!s:A->bool. INFINITE(s) ==> {t | t SUBSET s /\ FINITE t} =_c s`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN + CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `{l:A list | !x. MEM x l ==> x IN s}` THEN + CONJ_TAC THENL + [REWRITE_TAC[LE_C; IN_ELIM_THM] THEN + EXISTS_TAC `set_of_list:A list->(A->bool)` THEN + X_GEN_TAC `t:A->bool` THEN STRIP_TAC THEN + EXISTS_TAC `list_of_set(t:A->bool)` THEN + ASM_SIMP_TAC[MEM_LIST_OF_SET; GSYM SUBSET; SET_OF_LIST_OF_SET]; + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + MATCH_MP_TAC CARD_EQ_LIST_GEN THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:A. {x}` THEN + REWRITE_TAC[IN_ELIM_THM; FINITE_SING] THEN SET_TAC[]]);; + +let CARD_LE_LIST = prove + (`!s:A->bool t:B->bool. + s <=_c t + ==> {l | !x. MEM x l ==> x IN s} <=_c {l | !x. MEM x l ==> x IN t}`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[le_c; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `MAP (f:A->B)` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[MEM_MAP] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + LIST_INDUCT_TAC THEN SIMP_TAC[MAP_EQ_NIL; MAP] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; NOT_CONS_NIL; MEM; CONS_11] THEN + ASM_MESON_TAC[]);; + +let CARD_LE_SUBPOWERSET = prove + (`!s:A->bool t:B->bool. + s <=_c t /\ (!f s. P s ==> Q(IMAGE f s)) + ==> {u | u SUBSET s /\ P u} <=_c {v | v SUBSET t /\ Q v}`, + REPEAT GEN_TAC THEN REWRITE_TAC[le_c; IN_ELIM_THM] THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (f:A->B)` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; + +let CARD_LE_FINITE_SUBSETS = prove + (`!s:A->bool t:B->bool. + s <=_c t + ==> {u | u SUBSET s /\ FINITE u} <=_c {v | v SUBSET t /\ FINITE v}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_SUBPOWERSET THEN + ASM_SIMP_TAC[FINITE_IMAGE]);; + +let CARD_LE_COUNTABLE_SUBSETS = prove + (`!s:A->bool t:B->bool. + s <=_c t + ==> {u | u SUBSET s /\ COUNTABLE u} <=_c {v | v SUBSET t /\ COUNTABLE v}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_LE_SUBPOWERSET THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE]);; + +let CARD_LE_POWERSET = prove + (`!s:A->bool t:B->bool. + s <=_c t ==> {u | u SUBSET s} <=_c {v | v SUBSET t}`, + REPEAT STRIP_TAC THEN PURE_ONCE_REWRITE_TAC[SET_RULE + `{x | x SUBSET y} = {x | x SUBSET y /\ T}`] THEN + MATCH_MP_TAC CARD_LE_SUBPOWERSET THEN + ASM_SIMP_TAC[]);; + +let COUNTABLE_LIST_GEN = prove + (`!s:A->bool. COUNTABLE s ==> COUNTABLE {l | !x. MEM x l ==> x IN s}`, + GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_LIST) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`] THEN + SIMP_TAC[CARD_EQ_LIST; num_INFINITE]);; + +let COUNTABLE_LIST = prove + (`COUNTABLE(:A) ==> COUNTABLE(:A list)`, + MP_TAC(ISPEC `(:A)` COUNTABLE_LIST_GEN) THEN + REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`]);; + +let COUNTABLE_FINITE_SUBSETS = prove + (`!s:A->bool. COUNTABLE(s) ==> COUNTABLE {t | t SUBSET s /\ FINITE t}`, + GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_FINITE_SUBSETS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CARD_LE_TRANS) THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[IN_UNIV; SET_RULE `{x | T} = UNIV`] THEN + SIMP_TAC[CARD_EQ_FINITE_SUBSETS; num_INFINITE]);; + +let CARD_EQ_REAL_SEQUENCES = prove + (`(:num->real) =_c (:real)`, + TRANS_TAC CARD_EQ_TRANS `(:num->num->bool)` THEN + ASM_SIMP_TAC[CARD_FUNSPACE_CONG; CARD_EQ_REFL; CARD_EQ_REAL] THEN + TRANS_TAC CARD_EQ_TRANS `(:num#num->bool)` THEN + ASM_SIMP_TAC[CARD_FUNSPACE_CURRY] THEN + TRANS_TAC CARD_EQ_TRANS `(:num->bool)` THEN + ASM_SIMP_TAC[CARD_FUNSPACE_CONG; CARD_EQ_REFL; + ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_REAL; + REWRITE_RULE[MUL_C_UNIV] CARD_SQUARE_NUM]);; + +let CARD_EQ_COUNTABLE_SUBSETS_REAL = prove + (`{s:real->bool | COUNTABLE s} =_c (:real)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS + `{{}:real->bool} +_c {s:real->bool | COUNTABLE s /\ ~(s = {})}` THEN + CONJ_TAC THENL + [W(MP_TAC o PART_MATCH rand UNION_LE_ADD_C o rand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN + MATCH_MP_TAC(MESON[CARD_LE_REFL] `s = t ==> s <=_c t`) THEN + ONCE_REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNION; IN_SING] THEN + MESON_TAC[COUNTABLE_EMPTY]; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `{{}:real->bool} +_c (:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_LE_ADD THEN + REWRITE_TAC[CARD_LE_REFL] THEN + TRANS_TAC CARD_LE_TRANS `(:num->real)` THEN + ASM_SIMP_TAC[CARD_EQ_REAL_SEQUENCES; CARD_EQ_IMP_LE] THEN + REWRITE_TAC[LE_C] THEN EXISTS_TAC `\f:num->real. IMAGE f (:num)` THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN + MESON_TAC[COUNTABLE_AS_IMAGE]; + MATCH_MP_TAC CARD_ADD_ABSORB_LE THEN + SIMP_TAC[real_INFINITE; le_c; IN_UNIV; IN_SING]]; + REWRITE_TAC[le_c] THEN EXISTS_TAC `\x:real. {x}` THEN + REWRITE_TAC[IN_UNIV; COUNTABLE_SING; IN_ELIM_THM] THEN SET_TAC[]]);; diff --git a/Library/floor.ml b/Library/floor.ml new file mode 100644 index 0000000..bb251de --- /dev/null +++ b/Library/floor.ml @@ -0,0 +1,643 @@ +(* ========================================================================= *) +(* The integer/rational-valued reals, and the "floor" and "frac" functions. *) +(* ========================================================================= *) + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Closure theorems and other lemmas for the integer-valued reals. *) +(* ------------------------------------------------------------------------- *) + +let INTEGER_CASES = prove + (`integer x <=> (?n. x = &n) \/ (?n. x = -- &n)`, + REWRITE_TAC[is_int; OR_EXISTS_THM]);; + +let REAL_ABS_INTEGER_LEMMA = prove + (`!x. integer(x) /\ ~(x = &0) ==> &1 <= abs(x)`, + GEN_TAC THEN REWRITE_TAC[integer] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[REAL_ARITH `(x = &0) <=> (abs(x) = &0)`] THEN + POP_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_LE] THEN ARITH_TAC);; + +let INTEGER_CLOSED = prove + (`(!n. integer(&n)) /\ + (!x y. integer(x) /\ integer(y) ==> integer(x + y)) /\ + (!x y. integer(x) /\ integer(y) ==> integer(x - y)) /\ + (!x y. integer(x) /\ integer(y) ==> integer(x * y)) /\ + (!x r. integer(x) ==> integer(x pow r)) /\ + (!x. integer(x) ==> integer(--x)) /\ + (!x. integer(x) ==> integer(abs x))`, + REWRITE_TAC[integer] THEN + MATCH_MP_TAC(TAUT + `x /\ c /\ d /\ e /\ f /\ (a /\ e ==> b) /\ a + ==> x /\ a /\ b /\ c /\ d /\ e /\ f`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_NUM] THEN MESON_TAC[]; + REWRITE_TAC[REAL_ABS_MUL] THEN MESON_TAC[REAL_OF_NUM_MUL]; + REWRITE_TAC[REAL_ABS_POW] THEN MESON_TAC[REAL_OF_NUM_POW]; + REWRITE_TAC[REAL_ABS_NEG]; REWRITE_TAC[REAL_ABS_ABS]; + REWRITE_TAC[real_sub] THEN MESON_TAC[]; ALL_TAC] THEN + SIMP_TAC[REAL_ARITH `&0 <= a ==> ((abs(x) = a) <=> (x = a) \/ (x = --a))`; + REAL_POS] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_NEG_ADD; REAL_OF_NUM_ADD] THENL + [MESON_TAC[]; ALL_TAC; ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[REAL_ARITH `(--a + b = c) <=> (a + c = b)`; + REAL_ARITH `(a + --b = c) <=> (b + c = a)`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + MESON_TAC[LE_EXISTS; ADD_SYM; LE_CASES]);; + +let INTEGER_ADD = prove + (`!x y. integer(x) /\ integer(y) ==> integer(x + y)`, + REWRITE_TAC[INTEGER_CLOSED]);; + +let INTEGER_SUB = prove + (`!x y. integer(x) /\ integer(y) ==> integer(x - y)`, + REWRITE_TAC[INTEGER_CLOSED]);; + +let INTEGER_MUL = prove + (`!x y. integer(x) /\ integer(y) ==> integer(x * y)`, + REWRITE_TAC[INTEGER_CLOSED]);; + +let INTEGER_POW = prove + (`!x n. integer(x) ==> integer(x pow n)`, + REWRITE_TAC[INTEGER_CLOSED]);; + +let REAL_LE_INTEGERS = prove + (`!x y. integer(x) /\ integer(y) ==> (x <= y <=> (x = y) \/ x + &1 <= y)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `y - x` REAL_ABS_INTEGER_LEMMA) THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let REAL_LE_CASES_INTEGERS = prove + (`!x y. integer(x) /\ integer(y) ==> x <= y \/ y + &1 <= x`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `y - x` REAL_ABS_INTEGER_LEMMA) THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let REAL_LE_REVERSE_INTEGERS = prove + (`!x y. integer(x) /\ integer(y) /\ ~(y + &1 <= x) ==> x <= y`, + MESON_TAC[REAL_LE_CASES_INTEGERS]);; + +let REAL_LT_INTEGERS = prove + (`!x y. integer(x) /\ integer(y) ==> (x < y <=> x + &1 <= y)`, + MESON_TAC[REAL_NOT_LT; REAL_LE_CASES_INTEGERS; + REAL_ARITH `x + &1 <= y ==> x < y`]);; + +let REAL_EQ_INTEGERS = prove + (`!x y. integer x /\ integer y ==> (x = y <=> abs(x - y) < &1)`, + REWRITE_TAC[REAL_ARITH `x = y <=> ~(x < y \/ y < x)`] THEN + SIMP_TAC[REAL_LT_INTEGERS] THEN REAL_ARITH_TAC);; + +let REAL_EQ_INTEGERS_IMP = prove + (`!x y. integer x /\ integer y /\ abs(x - y) < &1 ==> x = y`, + SIMP_TAC[REAL_EQ_INTEGERS]);; + +let INTEGER_NEG = prove + (`!x. integer(--x) <=> integer(x)`, + MESON_TAC[INTEGER_CLOSED; REAL_NEG_NEG]);; + +let INTEGER_ABS = prove + (`!x. integer(abs x) <=> integer(x)`, + GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN + REWRITE_TAC[INTEGER_NEG]);; + +let INTEGER_POS = prove + (`!x. &0 <= x ==> (integer(x) <=> ?n. x = &n)`, + SIMP_TAC[integer; real_abs]);; + +let INTEGER_ADD_EQ = prove + (`(!x y. integer(x) ==> (integer(x + y) <=> integer(y))) /\ + (!x y. integer(y) ==> (integer(x + y) <=> integer(x)))`, + MESON_TAC[REAL_ADD_SUB; REAL_ADD_SYM; INTEGER_CLOSED]);; + +let INTEGER_SUB_EQ = prove + (`(!x y. integer(x) ==> (integer(x - y) <=> integer(y))) /\ + (!x y. integer(y) ==> (integer(x - y) <=> integer(x)))`, + MESON_TAC[REAL_SUB_ADD; REAL_NEG_SUB; INTEGER_CLOSED]);; + +let FORALL_INTEGER = prove + (`!P. (!n. P(&n)) /\ (!x. P x ==> P(--x)) ==> !x. integer x ==> P x`, + MESON_TAC[INTEGER_CASES]);; + +let INTEGER_SUM = prove + (`!f:A->real s. (!x. x IN s ==> integer(f x)) ==> integer(sum s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_CLOSED THEN + ASM_REWRITE_TAC[INTEGER_CLOSED]);; + +let INTEGER_ABS_MUL_EQ_1 = prove + (`!x y. integer x /\ integer y + ==> (abs(x * y) = &1 <=> abs x = &1 /\ abs y = &1)`, + REWRITE_TAC[integer] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_MUL; MULT_EQ_1]);; + +let INTEGER_DIV = prove + (`!m n. integer(&m / &n) <=> n = 0 \/ n divides m`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; INTEGER_CLOSED]; + ASM_SIMP_TAC[INTEGER_POS; REAL_POS; REAL_LE_DIV; divides] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `~(n = &0) ==> (x / n = y <=> x = n * y)`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* Similar theorems for rational-valued reals. *) +(* ------------------------------------------------------------------------- *) + +let rational = new_definition + `rational x <=> ?m n. integer m /\ integer n /\ ~(n = &0) /\ x = m / n`;; + +let RATIONAL_INTEGER = prove + (`!x. integer x ==> rational x`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[rational] THEN + MAP_EVERY EXISTS_TAC [`x:real`; `&1`] THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN CONV_TAC REAL_FIELD);; + +let RATIONAL_NUM = prove + (`!n. rational(&n)`, + SIMP_TAC[RATIONAL_INTEGER; INTEGER_CLOSED]);; + +let RATIONAL_NEG = prove + (`!x. rational(x) ==> rational(--x)`, + REWRITE_TAC[rational; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `m:real`; `n:real`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`--m:real`; `n:real`] THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN CONV_TAC REAL_FIELD);; + +let RATIONAL_ABS = prove + (`!x. rational(x) ==> rational(abs x)`, + REWRITE_TAC[real_abs] THEN MESON_TAC[RATIONAL_NEG]);; + +let RATIONAL_INV = prove + (`!x. rational(x) ==> rational(inv x)`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_SIMP_TAC[REAL_INV_0; RATIONAL_NUM] THEN + REWRITE_TAC[rational; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`m:real`; `n:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`n:real`; `m:real`] THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let RATIONAL_ADD = prove + (`!x y. rational(x) /\ rational(y) ==> rational(x + y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[rational; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`m1:real`; `n1:real`; `m2:real`; `n2:real`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`m1 * n2 + m2 * n1:real`; `n1 * n2:real`] THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let RATIONAL_SUB = prove + (`!x y. rational(x) /\ rational(y) ==> rational(x - y)`, + SIMP_TAC[real_sub; RATIONAL_NEG; RATIONAL_ADD]);; + +let RATIONAL_MUL = prove + (`!x y. rational(x) /\ rational(y) ==> rational(x * y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[rational; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`m1:real`; `n1:real`; `m2:real`; `n2:real`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`m1 * m2:real`; `n1 * n2:real`] THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let RATIONAL_DIV = prove + (`!x y. rational(x) /\ rational(y) ==> rational(x / y)`, + SIMP_TAC[real_div; RATIONAL_INV; RATIONAL_MUL]);; + +let RATIONAL_POW = prove + (`!x n. rational(x) ==> rational(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[real_pow; RATIONAL_NUM; RATIONAL_MUL]);; + +let RATIONAL_CLOSED = prove + (`(!n. rational(&n)) /\ + (!x. integer x ==> rational x) /\ + (!x y. rational(x) /\ rational(y) ==> rational(x + y)) /\ + (!x y. rational(x) /\ rational(y) ==> rational(x - y)) /\ + (!x y. rational(x) /\ rational(y) ==> rational(x * y)) /\ + (!x y. rational(x) /\ rational(y) ==> rational(x / y)) /\ + (!x r. rational(x) ==> rational(x pow r)) /\ + (!x. rational(x) ==> rational(--x)) /\ + (!x. rational(x) ==> rational(inv x)) /\ + (!x. rational(x) ==> rational(abs x))`, + SIMP_TAC[RATIONAL_NUM; RATIONAL_NEG; RATIONAL_ABS; RATIONAL_INV; + RATIONAL_ADD; RATIONAL_SUB; RATIONAL_MUL; RATIONAL_DIV; + RATIONAL_POW; RATIONAL_INTEGER]);; + +let RATIONAL_NEG_EQ = prove + (`!x. rational(--x) <=> rational x`, + MESON_TAC[REAL_NEG_NEG; RATIONAL_NEG]);; + +let RATIONAL_INV_EQ = prove + (`!x. rational(inv x) <=> rational x`, + MESON_TAC[REAL_INV_INV; RATIONAL_INV]);; + +let RATIONAL_ALT = prove + (`!x. rational(x) <=> ?p q. ~(q = 0) /\ abs x = &p / &q`, + GEN_TAC THEN REWRITE_TAC[rational] THEN EQ_TAC THENL + [REWRITE_TAC[integer] THEN STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ABS_DIV] THEN + ASM_MESON_TAC[REAL_OF_NUM_EQ; REAL_ABS_ZERO]; + STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP + (REAL_ARITH `abs(x:real) = a ==> x = a \/ x = --a`)) THEN + ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_MESON_TAC[INTEGER_CLOSED; REAL_OF_NUM_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* The floor and frac functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ARCH_SIMPLE = prove + (`!x. ?n. x <= &n`, + let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in + MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN + MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL; + REAL_ARITH `~(M <= M - &1)`]);; + +let REAL_TRUNCATE_POS = prove + (`!x. &0 <= x ==> ?n r. &0 <= r /\ r < &1 /\ (x = &n + r)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[LT_SUC_LE; CONJUNCT1 LT] THENL + [DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`0`; `&0`] THEN ASM_REAL_ARITH_TAC; + POP_ASSUM_LIST(K ALL_TAC)] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL; REAL_NOT_LE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC o REWRITE_RULE[REAL_LE_LT]) + THENL + [MAP_EVERY EXISTS_TAC [`n:num`; `x - &n`] THEN ASM_REAL_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`SUC n`; `x - &(SUC n)`] THEN + REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_OF_NUM_SUC] THEN ASM_REAL_ARITH_TAC]);; + +let REAL_TRUNCATE = prove + (`!x. ?n r. integer(n) /\ &0 <= r /\ r < &1 /\ (x = n + r)`, + GEN_TAC THEN DISJ_CASES_TAC(SPECL [`x:real`; `&0`] REAL_LE_TOTAL) THENL + [MP_TAC(SPEC `--x` REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[REAL_ARITH `--a <= b <=> &0 <= a + b`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` + (MP_TAC o MATCH_MP REAL_TRUNCATE_POS)) THEN + REWRITE_TAC[REAL_ARITH `(a + b = c + d) <=> (a = (c - b) + d)`]; + ALL_TAC] THEN + ASM_MESON_TAC[integer; INTEGER_CLOSED; REAL_TRUNCATE_POS]);; + +let FLOOR_FRAC = + new_specification ["floor"; "frac"] + (REWRITE_RULE[SKOLEM_THM] REAL_TRUNCATE);; + +(* ------------------------------------------------------------------------- *) +(* Useful lemmas about floor and frac. *) +(* ------------------------------------------------------------------------- *) + +let FLOOR_UNIQUE = prove + (`!x a. integer(a) /\ a <= x /\ x < a + &1 <=> (floor x = a)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN STRIP_ASSUME_TAC(SPEC `x:real` FLOOR_FRAC) THEN + SUBGOAL_THEN `abs(floor x - a) < &1` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN CONJ_TAC THENL + [ASM_MESON_TAC[INTEGER_CLOSED]; ASM_REAL_ARITH_TAC]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN + SIMP_TAC[] THEN REAL_ARITH_TAC]);; + +let FLOOR_EQ_0 = prove + (`!x. (floor x = &0) <=> &0 <= x /\ x < &1`, + GEN_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN + REWRITE_TAC[INTEGER_CLOSED; REAL_ADD_LID]);; + +let FLOOR = prove + (`!x. integer(floor x) /\ floor(x) <= x /\ x < floor(x) + &1`, + GEN_TAC THEN MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let FLOOR_DOUBLE = prove + (`!u. &2 * floor(u) <= floor(&2 * u) /\ floor(&2 * u) <= &2 * floor(u) + &1`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN + SIMP_TAC[INTEGER_CLOSED; FLOOR] THEN + MP_TAC(SPEC `u:real` FLOOR) THEN MP_TAC(SPEC `&2 * u` FLOOR) THEN + REAL_ARITH_TAC);; + +let FRAC_FLOOR = prove + (`!x. frac(x) = x - floor(x)`, + MP_TAC FLOOR_FRAC THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let FLOOR_NUM = prove + (`!n. floor(&n) = &n`, + REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let REAL_LE_FLOOR = prove + (`!x n. integer(n) ==> (n <= floor x <=> n <= x)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[FLOOR; REAL_LE_TRANS]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_SIMP_TAC[REAL_LT_INTEGERS; FLOOR] THEN + MP_TAC(SPEC `x:real` FLOOR) THEN REAL_ARITH_TAC);; + +let REAL_FLOOR_LE = prove + (`!x n. integer n ==> (floor x <= n <=> x - &1 < n)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x + &1 <= y + &1`] THEN + ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; FLOOR; INTEGER_CLOSED] THEN + ONCE_REWRITE_TAC[TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN + ASM_SIMP_TAC[REAL_NOT_LT; REAL_LE_FLOOR; INTEGER_CLOSED] THEN + REAL_ARITH_TAC);; + +let FLOOR_POS = prove + (`!x. &0 <= x ==> ?n. floor(x) = &n`, + REPEAT STRIP_TAC THEN MP_TAC(CONJUNCT1(SPEC `x:real` FLOOR)) THEN + REWRITE_TAC[integer] THEN + ASM_SIMP_TAC[real_abs; REAL_LE_FLOOR; FLOOR; INTEGER_CLOSED]);; + +let FLOOR_DIV_DIV = prove + (`!m n. ~(m = 0) ==> floor(&n / &m) = &(n DIV m)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + REAL_OF_NUM_LE; REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; LT_NZ] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN ARITH_TAC);; + +let FLOOR_MONO = prove + (`!x y. x <= y ==> floor x <= floor y`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN + SIMP_TAC[FLOOR; REAL_LT_INTEGERS] THEN + MAP_EVERY (MP_TAC o C SPEC FLOOR) [`x:real`; `y:real`] THEN REAL_ARITH_TAC);; + +let REAL_FLOOR_EQ = prove + (`!x. floor x = x <=> integer x`, + REWRITE_TAC[GSYM FLOOR_UNIQUE; REAL_LE_REFL; REAL_ARITH `x < x + &1`]);; + +let REAL_FLOOR_LT = prove + (`!x. floor x < x <=> ~(integer x)`, + MESON_TAC[REAL_LT_LE; REAL_FLOOR_EQ; FLOOR]);; + +let REAL_FRAC_EQ_0 = prove + (`!x. frac x = &0 <=> integer x`, + REWRITE_TAC[FRAC_FLOOR; REAL_SUB_0] THEN MESON_TAC[REAL_FLOOR_EQ]);; + +let REAL_FRAC_POS_LT = prove + (`!x. &0 < frac x <=> ~(integer x)`, + REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LT; REAL_FLOOR_LT]);; + +let FRAC_NUM = prove + (`!n. frac(&n) = &0`, + REWRITE_TAC[REAL_FRAC_EQ_0; INTEGER_CLOSED]);; + +let REAL_FLOOR_REFL = prove + (`!x. integer x ==> floor x = x`, + REWRITE_TAC[REAL_FLOOR_EQ]);; + +let REAL_FRAC_ZERO = prove + (`!x. integer x ==> frac x = &0`, + REWRITE_TAC[REAL_FRAC_EQ_0]);; + +let REAL_FLOOR_ADD = prove + (`!x y. floor(x + y) = if frac x + frac y < &1 then floor(x) + floor(y) + else (floor(x) + floor(y)) + &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN + CONJ_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED; FLOOR]; ALL_TAC] THEN + MAP_EVERY (MP_TAC o C SPEC FLOOR_FRAC)[`x:real`; `y:real`; `x + y:real`] THEN + REAL_ARITH_TAC);; + +let REAL_FRAC_ADD = prove + (`!x y. frac(x + y) = if frac x + frac y < &1 then frac(x) + frac(y) + else (frac(x) + frac(y)) - &1`, + REWRITE_TAC[FRAC_FLOOR; REAL_FLOOR_ADD] THEN REAL_ARITH_TAC);; + +let FLOOR_POS_LE = prove + (`!x. &0 <= floor x <=> &0 <= x`, + SIMP_TAC[REAL_LE_FLOOR; INTEGER_CLOSED]);; + +let FRAC_UNIQUE = prove + (`!x a. integer(x - a) /\ &0 <= a /\ a < &1 <=> frac x = a`, + REWRITE_TAC[FRAC_FLOOR; REAL_ARITH `x - f:real = a <=> f = x - a`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let REAL_FRAC_EQ = prove + (`!x. frac x = x <=> &0 <= x /\ x < &1`, + REWRITE_TAC[GSYM FRAC_UNIQUE; REAL_SUB_REFL; INTEGER_CLOSED]);; + +let INTEGER_ROUND = prove + (`!x. ?n. integer n /\ abs(x - n) <= &1 / &2`, + GEN_TAC THEN MATCH_MP_TAC(MESON[] `!a. P a \/ P(a + &1) ==> ?x. P x`) THEN + EXISTS_TAC `floor x` THEN MP_TAC(ISPEC `x:real` FLOOR) THEN + SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Assertions that there are integers between well-spaced reals. *) +(* ------------------------------------------------------------------------- *) + +let INTEGER_EXISTS_BETWEEN_ALT = prove + (`!x y. x + &1 <= y ==> ?n. integer n /\ x < n /\ n <= y`, + REPEAT STRIP_TAC THEN EXISTS_TAC `floor y` THEN + MP_TAC(SPEC `y:real` FLOOR) THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let INTEGER_EXISTS_BETWEEN_LT = prove + (`!x y. x + &1 < y ==> ?n. integer n /\ x < n /\ n < y`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `integer y` THENL + [EXISTS_TAC `y - &1:real` THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGER_EXISTS_BETWEEN_ALT o + MATCH_MP REAL_LT_IMP_LE) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM_MESON_TAC[]]);; + +let INTEGER_EXISTS_BETWEEN = prove + (`!x y. x + &1 <= y ==> ?n. integer n /\ x <= n /\ n < y`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `integer y` THENL + [EXISTS_TAC `y - &1:real` THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGER_EXISTS_BETWEEN_ALT) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_LT_LE] THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]]);; + +let INTEGER_EXISTS_BETWEEN_ABS = prove + (`!x y. &1 <= abs(x - y) + ==> ?n. integer n /\ (x <= n /\ n < y \/ y <= n /\ n < x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL + [MP_TAC(ISPECL [`y:real`; `x:real`] INTEGER_EXISTS_BETWEEN); + MP_TAC(ISPECL [`x:real`; `y:real`] INTEGER_EXISTS_BETWEEN)] THEN + (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS]) THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +let INTEGER_EXISTS_BETWEEN_ABS_LT = prove + (`!x y. &1 < abs(x - y) + ==> ?n. integer n /\ (x < n /\ n < y \/ y < n /\ n < x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THENL + [MP_TAC(ISPECL [`y:real`; `x:real`] INTEGER_EXISTS_BETWEEN_LT); + MP_TAC(ISPECL [`x:real`; `y:real`] INTEGER_EXISTS_BETWEEN_LT)] THEN + (ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS]) THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A couple more theorems about real_of_int. *) +(* ------------------------------------------------------------------------- *) + +let INT_OF_REAL_OF_INT = prove + (`!i. int_of_real(real_of_int i) = i`, + REWRITE_TAC[int_abstr]);; + +let REAL_OF_INT_OF_REAL = prove + (`!x. integer(x) ==> real_of_int(int_of_real x) = x`, + SIMP_TAC[int_rep]);; + +(* ------------------------------------------------------------------------- *) +(* Finiteness of bounded set of integers. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_INTSEG_NUM = prove + (`!m n. {x | integer(x) /\ &m <= x /\ x <= &n} HAS_SIZE ((n + 1) - m)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x | integer(x) /\ &m <= x /\ x <= &n} = + IMAGE real_of_num (m..n)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN ASM_CASES_TAC `?k. x = &k` THENL + [FIRST_X_ASSUM(CHOOSE_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[REAL_OF_NUM_LE; INTEGER_CLOSED; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[UNWIND_THM1; IN_NUMSEG]; + ASM_MESON_TAC[INTEGER_POS; REAL_ARITH `&n <= x ==> &0 <= x`]]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG] THEN + SIMP_TAC[REAL_OF_NUM_EQ]]);; + +let FINITE_INTSEG = prove + (`!a b. FINITE {x | integer(x) /\ a <= x /\ x <= b}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `max (abs a) (abs b)` REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[REAL_MAX_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x | integer(x) /\ abs(x) <= &n}` THEN CONJ_TAC THENL + [ALL_TAC; SIMP_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\x. &x) (0..n) UNION IMAGE (\x. --(&x)) (0..n)` THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[INTEGER_CASES; SUBSET; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[IN_UNION; IN_IMAGE; REAL_OF_NUM_EQ; REAL_EQ_NEG2] THEN + REWRITE_TAC[UNWIND_THM1; IN_NUMSEG] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + ASM_REAL_ARITH_TAC);; + +let HAS_SIZE_INTSEG_INT = prove + (`!a b. integer a /\ integer b + ==> {x | integer(x) /\ a <= x /\ x <= b} HAS_SIZE + if b < a then 0 else num_of_int(int_of_real(b - a + &1))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x | integer(x) /\ a <= x /\ x <= b} = + IMAGE (\n. a + &n) {n | &n <= b - a}` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; INTEGER_CLOSED] THEN + CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + X_GEN_TAC `c:real` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + x:real = y <=> y - a = x`] THEN + ASM_SIMP_TAC[GSYM INTEGER_POS; REAL_SUB_LE; INTEGER_CLOSED]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + + SIMP_TAC[REAL_EQ_ADD_LCANCEL; REAL_OF_NUM_EQ] THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `b < a ==> ~(&n <= b - a)`] THEN + REWRITE_TAC[HAS_SIZE_0; EMPTY_GSPEC]; + SUBGOAL_THEN `?m. b - a = &m` (CHOOSE_THEN SUBST1_TAC) THENL + [ASM_MESON_TAC[INTEGER_POS; INTEGER_CLOSED; REAL_NOT_LT; REAL_SUB_LE]; + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; GSYM int_of_num; + NUM_OF_INT_OF_NUM; HAS_SIZE_NUMSEG_LE]]]]);; + +let CARD_INTSEG_INT = prove + (`!a b. integer a /\ integer b + ==> CARD {x | integer(x) /\ a <= x /\ x <= b} = + if b < a then 0 else num_of_int(int_of_real(b - a + &1))`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_INTSEG_INT) THEN + SIMP_TAC[HAS_SIZE]);; + +let REAL_CARD_INTSEG_INT = prove + (`!a b. integer a /\ integer b + ==> &(CARD {x | integer(x) /\ a <= x /\ x <= b}) = + if b < a then &0 else b - a + &1`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARD_INTSEG_INT] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_OF_INT_OF_REAL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM int_of_num_th] THEN + W(MP_TAC o PART_MATCH (lhs o rand) INT_OF_NUM_OF_INT o + rand o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[int_le; int_of_num_th; REAL_OF_INT_OF_REAL; + INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_OF_INT_OF_REAL THEN + ASM_SIMP_TAC[INTEGER_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* Yet set of all integers or rationals is infinite. *) +(* ------------------------------------------------------------------------- *) + +let INFINITE_INTEGER = prove + (`INFINITE integer`, + SUBGOAL_THEN `INFINITE(IMAGE real_of_num (:num))` MP_TAC THENL + [SIMP_TAC[INFINITE_IMAGE_INJ; REAL_OF_NUM_EQ; num_INFINITE]; ALL_TAC] THEN + REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[IN; INTEGER_CLOSED]);; + +let INFINITE_RATIONAL = prove + (`INFINITE rational`, + MP_TAC INFINITE_INTEGER THEN + REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN; RATIONAL_INTEGER]);; + +(* ------------------------------------------------------------------------- *) +(* Arbitrarily good rational approximations. *) +(* ------------------------------------------------------------------------- *) + +let RATIONAL_APPROXIMATION = prove + (`!x e. &0 < e ==> ?r. rational r /\ abs(r - x) < e`, + REPEAT STRIP_TAC THEN ABBREV_TAC `n = floor(inv e) + &1` THEN + EXISTS_TAC `floor(n * x) / n` THEN EXPAND_TAC "n" THEN + ASM_SIMP_TAC[RATIONAL_CLOSED; INTEGER_CLOSED; FLOOR] THEN + SUBGOAL_THEN `&0 < n` ASSUME_TAC THENL + [EXPAND_TAC "n" THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN + ASM_SIMP_TAC[FLOOR_POS_LE; REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_FIELD `&0 < n ==> a / n - b = (a - n * b) / n`] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ; + REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1` THEN CONJ_TAC THENL + [MP_TAC(SPEC `n * x:real` FLOOR) THEN REAL_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `inv e < n ==> &1 / e < abs n`) THEN + EXPAND_TAC "n" THEN MP_TAC(SPEC `inv e` FLOOR) THEN REAL_ARITH_TAC]]);; + +let RATIONAL_BETWEEN = prove + (`!a b. a < b ==> ?q. rational q /\ a < q /\ q < b`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`(a + b) / &2`; `(b - a) / &4`] RATIONAL_APPROXIMATION) THEN + ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN + ASM_REAL_ARITH_TAC);; + +let RATIONAL_APPROXIMATION_STRADDLE = prove + (`!x e. &0 < e + ==> ?a b. rational a /\ rational b /\ + a < x /\ x < b /\ abs(b - a) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`x - e / &4`; `e / &4`] RATIONAL_APPROXIMATION) THEN + ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC] THEN + MP_TAC(ISPECL [`x + e / &4`; `e / &4`] RATIONAL_APPROXIMATION) THEN + ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; diff --git a/Library/integer.ml b/Library/integer.ml new file mode 100644 index 0000000..29e0410 --- /dev/null +++ b/Library/integer.ml @@ -0,0 +1,1014 @@ +(* ========================================================================= *) +(* Basic divisibility notions over the integers. *) +(* *) +(* This is similar to stuff in Library/prime.ml etc. for natural numbers. *) +(* ========================================================================= *) + +prioritize_int();; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of divisibility. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVIDES_REFL = INTEGER_RULE + `!d. d divides d`;; + +let INT_DIVIDES_TRANS = INTEGER_RULE + `!x y z. x divides y /\ y divides z ==> x divides z`;; + +let INT_DIVIDES_ADD = INTEGER_RULE + `!d a b. d divides a /\ d divides b ==> d divides (a + b)`;; + +let INT_DIVIDES_SUB = INTEGER_RULE + `!d a b. d divides a /\ d divides b ==> d divides (a - b)`;; + +let INT_DIVIDES_0 = INTEGER_RULE + `!d. d divides &0`;; + +let INT_DIVIDES_ZERO = INTEGER_RULE + `!x. &0 divides x <=> x = &0`;; + +let INT_DIVIDES_LNEG = INTEGER_RULE + `!d x. (--d) divides x <=> d divides x`;; + +let INT_DIVIDES_RNEG = INTEGER_RULE + `!d x. d divides (--x) <=> d divides x`;; + +let INT_DIVIDES_RMUL = INTEGER_RULE + `!d x y. d divides x ==> d divides (x * y)`;; + +let INT_DIVIDES_LMUL = INTEGER_RULE + `!d x y. d divides y ==> d divides (x * y)`;; + +let INT_DIVIDES_1 = INTEGER_RULE + `!x. &1 divides x`;; + +let INT_DIVIDES_ADD_REVR = INTEGER_RULE + `!d a b. d divides a /\ d divides (a + b) ==> d divides b`;; + +let INT_DIVIDES_ADD_REVL = INTEGER_RULE + `!d a b. d divides b /\ d divides (a + b) ==> d divides a`;; + +let INT_DIVIDES_MUL_L = INTEGER_RULE + `!a b c. a divides b ==> (c * a) divides (c * b)`;; + +let INT_DIVIDES_MUL_R = INTEGER_RULE + `!a b c. a divides b ==> (a * c) divides (b * c)`;; + +let INT_DIVIDES_LMUL2 = INTEGER_RULE + `!d a x. (x * d) divides a ==> d divides a`;; + +let INT_DIVIDES_RMUL2 = INTEGER_RULE + `!d a x. (d * x) divides a ==> d divides a`;; + +let INT_DIVIDES_CMUL2 = INTEGER_RULE + `!a b c. (c * a) divides (c * b) /\ ~(c = &0) ==> a divides b`;; + +let INT_DIVIDES_LMUL2_EQ = INTEGER_RULE + `!a b c. ~(c = &0) ==> ((c * a) divides (c * b) <=> a divides b)`;; + +let INT_DIVIDES_RMUL2_EQ = INTEGER_RULE + `!a b c. ~(c = &0) ==> ((a * c) divides (b * c) <=> a divides b)`;; + +let INT_DIVIDES_MUL2 = INTEGER_RULE + `!a b c d. a divides b /\ c divides d ==> (a * c) divides (b * d)`;; + +let INT_DIVIDES_LABS = prove + (`!d n. abs(d) divides n <=> d divides n`, + REPEAT GEN_TAC THEN SIMP_TAC[INT_ABS] THEN COND_CASES_TAC THEN INTEGER_TAC);; + +let INT_DIVIDES_RABS = prove + (`!d n. d divides (abs n) <=> d divides n`, + REPEAT GEN_TAC THEN SIMP_TAC[INT_ABS] THEN COND_CASES_TAC THEN INTEGER_TAC);; + +let INT_DIVIDES_ABS = prove + (`(!d n. abs(d) divides n <=> d divides n) /\ + (!d n. d divides (abs n) <=> d divides n)`, + REWRITE_TAC[INT_DIVIDES_LABS; INT_DIVIDES_RABS]);; + +let INT_DIVIDES_POW = prove + (`!x y n. x divides y ==> (x pow n) divides (y pow n)`, + REWRITE_TAC[int_divides] THEN MESON_TAC[INT_POW_MUL]);; + +let INT_DIVIDES_POW2 = prove + (`!n x y. ~(n = 0) /\ (x pow n) divides y ==> x divides y`, + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; INT_POW] THEN INTEGER_TAC);; + +let INT_DIVIDES_RPOW = prove + (`!x y n. x divides y /\ ~(n = 0) ==> x divides (y pow n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[INT_DIVIDES_RMUL; INT_POW]);; + +let INT_DIVIDES_RPOW_SUC = prove + (`!x y n. x divides y ==> x divides (y pow (SUC n))`, + SIMP_TAC[INT_DIVIDES_RPOW; NOT_SUC]);; + +let INT_DIVIDES_ANTISYM_DIVISORS = prove + (`!a b:int. a divides b /\ b divides a <=> !d. d divides a <=> d divides b`, + MESON_TAC[INT_DIVIDES_REFL; INT_DIVIDES_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Now carefully distinguish signs. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVIDES_ONE_POS = prove + (`!x. &0 <= x ==> (x divides &1 <=> x = &1)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[int_divides]; INTEGER_TAC] THEN + DISCH_THEN(CHOOSE_THEN(MP_TAC o AP_TERM `abs` o SYM)) THEN + SIMP_TAC[INT_ABS_NUM; INT_ABS_MUL_1] THEN ASM_SIMP_TAC[INT_ABS]);; + +let INT_DIVIDES_ONE_ABS = prove + (`!d. d divides &1 <=> abs(d) = &1`, + MESON_TAC[INT_DIVIDES_LABS; INT_DIVIDES_ONE_POS; INT_ABS_POS]);; + +let INT_DIVIDES_ONE = prove + (`!d. d divides &1 <=> d = &1 \/ d = -- &1`, + REWRITE_TAC[INT_DIVIDES_ONE_ABS] THEN INT_ARITH_TAC);; + +let INT_DIVIDES_ANTISYM_ASSOCIATED = prove + (`!x y. x divides y /\ y divides x <=> ?u. u divides &1 /\ x = y * u`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; INTEGER_TAC] THEN + ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[INT_DIVIDES_ZERO; INT_MUL_LZERO] THEN + ASM_MESON_TAC[int_divides; INT_DIVIDES_REFL; + INTEGER_RULE `y = x * d /\ x = y * e /\ ~(y = &0) ==> d divides &1`]);; + +let INT_DIVIDES_ANTISYM = prove + (`!x y. x divides y /\ y divides x <=> x = y \/ x = --y`, + REWRITE_TAC[INT_DIVIDES_ANTISYM_ASSOCIATED; INT_DIVIDES_ONE] THEN + REWRITE_TAC[RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2] THEN + INT_ARITH_TAC);; + +let INT_DIVIDES_ANTISYM_ABS = prove + (`!x y. x divides y /\ y divides x <=> abs(x) = abs(y)`, + REWRITE_TAC[INT_DIVIDES_ANTISYM] THEN INT_ARITH_TAC);; + +let INT_DIVIDES_ANTISYM_POS = prove + (`!x y. &0 <= x /\ &0 <= y ==> (x divides y /\ y divides x <=> x = y)`, + REWRITE_TAC[INT_DIVIDES_ANTISYM_ABS] THEN INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about GCDs. *) +(* ------------------------------------------------------------------------- *) + +let INT_GCD_POS = prove + (`!a b. &0 <= gcd(a,b)`, + REWRITE_TAC[int_gcd]);; + +let INT_GCD_DIVIDES = prove + (`!a b. gcd(a,b) divides a /\ gcd(a,b) divides b`, + INTEGER_TAC);; + +let INT_GCD_BEZOUT = prove + (`!a b. ?x y. gcd(a,b) = a * x + b * y`, + INTEGER_TAC);; + +let INT_DIVIDES_GCD = prove + (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`, + INTEGER_TAC);; + +let INT_DIVIDES_GCD = prove + (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`, + INTEGER_TAC);; + +let INT_GCD = INTEGER_RULE + `!a b. (gcd(a,b) divides a /\ gcd(a,b) divides b) /\ + (!e. e divides a /\ e divides b ==> e divides gcd(a,b))`;; + +let INT_GCD_UNIQUE = prove + (`!a b d. gcd(a,b) = d <=> &0 <= d /\ d divides a /\ d divides b /\ + !e. e divides a /\ e divides b ==> e divides d`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[INT_GCD; INT_GCD_POS]; ALL_TAC] THEN + ASM_SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS; INT_DIVIDES_GCD] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN INTEGER_TAC);; + +let INT_GCD_UNIQUE_ABS = prove + (`!a b d. gcd(a,b) = abs(d) <=> + d divides a /\ d divides b /\ + !e. e divides a /\ e divides b ==> e divides d`, + REWRITE_TAC[INT_GCD_UNIQUE; INT_ABS_POS; INT_DIVIDES_ABS]);; + +let INT_GCD_REFL = prove + (`!a. gcd(a,a) = abs(a)`, + REWRITE_TAC[INT_GCD_UNIQUE_ABS] THEN INTEGER_TAC);; + +let INT_GCD_SYM = prove + (`!a b. gcd(a,b) = gcd(b,a)`, + SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS] THEN INTEGER_TAC);; + +let INT_GCD_ASSOC = prove + (`!a b c. gcd(a,gcd(b,c)) = gcd(gcd(a,b),c)`, + SIMP_TAC[INT_GCD_POS; GSYM INT_DIVIDES_ANTISYM_POS] THEN INTEGER_TAC);; + +let INT_GCD_1 = prove + (`!a. gcd(a,&1) = &1 /\ gcd(&1,a) = &1`, + SIMP_TAC[INT_GCD_UNIQUE; INT_POS; INT_DIVIDES_1]);; + +let INT_GCD_0 = prove + (`!a. gcd(a,&0) = abs(a) /\ gcd(&0,a) = abs(a)`, + SIMP_TAC[INT_GCD_UNIQUE_ABS] THEN INTEGER_TAC);; + +let INT_GCD_ABS = prove + (`!a b. gcd(abs(a),b) = gcd(a,b) /\ gcd(a,abs(b)) = gcd(a,b)`, + REWRITE_TAC[INT_GCD_UNIQUE; INT_DIVIDES_ABS; INT_GCD_POS; INT_GCD]);; + +let INT_GCD_MULTIPLE = + (`!a b. gcd(a,a * b) = abs(a) /\ gcd(b,a * b) = abs(b)`, + REWRITE_TAC[INT_GCD_UNIQUE_ABS] THEN INTEGER_TAC);; + +let INT_GCD_ADD = prove + (`(!a b. gcd(a + b,b) = gcd(a,b)) /\ + (!a b. gcd(b + a,b) = gcd(a,b)) /\ + (!a b. gcd(a,a + b) = gcd(a,b)) /\ + (!a b. gcd(a,b + a) = gcd(a,b))`, + SIMP_TAC[INT_GCD_UNIQUE; INT_GCD_POS] THEN INTEGER_TAC);; + +let INT_GCD_SUB = prove + (`(!a b. gcd(a - b,b) = gcd(a,b)) /\ + (!a b. gcd(b - a,b) = gcd(a,b)) /\ + (!a b. gcd(a,a - b) = gcd(a,b)) /\ + (!a b. gcd(a,b - a) = gcd(a,b))`, + SIMP_TAC[INT_GCD_UNIQUE; INT_GCD_POS] THEN INTEGER_TAC);; + +let INT_DIVIDES_GCD_LEFT = prove + (`!m n:int. m divides n <=> gcd(m,n) = abs m`, + SIMP_TAC[INT_GCD_UNIQUE; INT_ABS_POS; INT_DIVIDES_ABS; INT_DIVIDES_REFL] THEN + MESON_TAC[INT_DIVIDES_REFL; INT_DIVIDES_TRANS]);; + +let INT_DIVIDES_GCD_RIGHT = prove + (`!m n:int. n divides m <=> gcd(m,n) = abs n`, + SIMP_TAC[INT_GCD_UNIQUE; INT_ABS_POS; INT_DIVIDES_ABS; INT_DIVIDES_REFL] THEN + MESON_TAC[INT_DIVIDES_REFL; INT_DIVIDES_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas about coprimality. *) +(* ------------------------------------------------------------------------- *) + +let INT_COPRIME_GCD = prove + (`!a b. coprime(a,b) <=> gcd(a,b) = &1`, + SIMP_TAC[GSYM INT_DIVIDES_ONE_POS; INT_GCD_POS] THEN INTEGER_TAC);; + +let int_coprime = prove + (`!a b. coprime(a,b) <=> !d. d divides a /\ d divides b ==> d divides &1`, + REWRITE_TAC[INT_COPRIME_GCD; INT_GCD_UNIQUE; INT_POS; INT_DIVIDES_1]);; + +let COPRIME = prove + (`!a b. coprime(a,b) <=> !d. d divides a /\ d divides b <=> d divides &1`, + MESON_TAC[INT_DIVIDES_1; INT_DIVIDES_TRANS; int_coprime]);; + +let INT_COPRIME_SYM = prove + (`!a b. coprime(a,b) <=> coprime(b,a)`, + INTEGER_TAC);; + +let INT_COPRIME_DIVPROD = prove + (`!d a b. d divides (a * b) /\ coprime(d,a) ==> d divides b`, + INTEGER_TAC);; + +let INT_COPRIME_1 = prove + (`!a. coprime(a,&1) /\ coprime(&1,a)`, + INTEGER_TAC);; + +let INT_GCD_COPRIME = prove + (`!a b a' b'. ~(gcd(a,b) = &0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) + ==> coprime(a',b')`, + INTEGER_TAC);; + +let INT_GCD_COPRIME_EXISTS = prove + (`!a b. ~(gcd(a,b) = &0) ==> + ?a' b'. (a = a' * gcd(a,b)) /\ + (b = b' * gcd(a,b)) /\ + coprime(a',b')`, + INTEGER_TAC);; + +let INT_COPRIME_0 = prove + (`(!a. coprime(a,&0) <=> a divides &1) /\ + (!a. coprime(&0,a) <=> a divides &1)`, + INTEGER_TAC);; + +let INT_COPRIME_MUL = prove + (`!d a b. coprime(d,a) /\ coprime(d,b) ==> coprime(d,a * b)`, + INTEGER_TAC);; + +let INT_COPRIME_LMUL2 = prove + (`!d a b. coprime(d,a * b) ==> coprime(d,b)`, + INTEGER_TAC);; + +let INT_COPRIME_RMUL2 = prove + (`!d a b. coprime(d,a * b) ==> coprime(d,a)`, + INTEGER_TAC);; + +let INT_COPRIME_LMUL = prove + (`!d a b. coprime(a * b,d) <=> coprime(a,d) /\ coprime(b,d)`, + INTEGER_TAC);; + +let INT_COPRIME_RMUL = prove + (`!d a b. coprime(d,a * b) <=> coprime(d,a) /\ coprime(d,b)`, + INTEGER_TAC);; + +let INT_COPRIME_REFL = prove + (`!n. coprime(n,n) <=> n divides &1`, + INTEGER_TAC);; + +let INT_COPRIME_PLUS1 = prove + (`!n. coprime(n + &1,n) /\ coprime(n,n + &1)`, + INTEGER_TAC);; + +let INT_COPRIME_MINUS1 = prove + (`!n. coprime(n - &1,n) /\ coprime(n,n - &1)`, + INTEGER_TAC);; + +let INT_COPRIME_RPOW = prove + (`!m n k. coprime(m,n pow k) <=> coprime(m,n) \/ k = 0`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[INT_POW; INT_COPRIME_1; INT_COPRIME_RMUL; NOT_SUC] THEN + CONV_TAC TAUT);; + +let INT_COPRIME_LPOW = prove + (`!m n k. coprime(m pow k,n) <=> coprime(m,n) \/ k = 0`, + ONCE_REWRITE_TAC[INT_COPRIME_SYM] THEN REWRITE_TAC[INT_COPRIME_RPOW]);; + +let INT_COPRIME_POW2 = prove + (`!m n k. coprime(m pow k,n pow k) <=> coprime(m,n) \/ k = 0`, + REWRITE_TAC[INT_COPRIME_RPOW; INT_COPRIME_LPOW; DISJ_ACI]);; + +let INT_COPRIME_POW = prove + (`!n a d. coprime(d,a) ==> coprime(d,a pow n)`, + SIMP_TAC[INT_COPRIME_RPOW]);; + +let INT_COPRIME_POW_IMP = prove + (`!n a b. coprime(a,b) ==> coprime(a pow n,b pow n)`, + MESON_TAC[INT_COPRIME_POW; INT_COPRIME_SYM]);; + +let INT_GCD_EQ_0 = prove + (`!a b. gcd(a,b) = &0 <=> a = &0 /\ b = &0`, + INTEGER_TAC);; + +let INT_DIVISION_DECOMP = prove + (`!a b c. a divides (b * c) + ==> ?b' c'. (a = b' * c') /\ b' divides b /\ c' divides c`, + REPEAT STRIP_TAC THEN EXISTS_TAC `gcd(a,b)` THEN + ASM_CASES_TAC `gcd(a,b) = &0` THEN REPEAT(POP_ASSUM MP_TAC) THENL + [SIMP_TAC[INT_GCD_EQ_0; INT_GCD_0; INT_ABS_NUM]; INTEGER_TAC] THEN + REWRITE_TAC[INT_MUL_LZERO] THEN MESON_TAC[INT_DIVIDES_REFL]);; + +let INT_DIVIDES_MUL = prove + (`!m n r. m divides r /\ n divides r /\ coprime(m,n) ==> (m * n) divides r`, + INTEGER_TAC);; + +let INT_CHINESE_REMAINDER = prove + (`!a b u v. coprime(a,b) /\ ~(a = &0) /\ ~(b = &0) + ==> ?x q1 q2. (x = u + q1 * a) /\ (x = v + q2 * b)`, + INTEGER_TAC);; + +let INT_CHINESE_REMAINDER_USUAL = prove + (`!a b u v. coprime(a,b) ==> ?x. (x == u) (mod a) /\ (x == v) (mod b)`, + INTEGER_TAC);; + +let INT_COPRIME_DIVISORS = prove + (`!a b d e. d divides a /\ e divides b /\ coprime(a,b) ==> coprime(d,e)`, + INTEGER_TAC);; + +let INT_COPRIME_LNEG = prove + (`!a b. coprime(--a,b) <=> coprime(a,b)`, + INTEGER_TAC);; + +let INT_COPRIME_RNEG = prove + (`!a b. coprime(a,--b) <=> coprime(a,b)`, + INTEGER_TAC);; + +let INT_COPRIME_NEG = prove + (`(!a b. coprime(--a,b) <=> coprime(a,b)) /\ + (!a b. coprime(a,--b) <=> coprime(a,b))`, + INTEGER_TAC);; + +let INT_COPRIME_LABS = prove + (`!a b. coprime(abs a,b) <=> coprime(a,b)`, + REWRITE_TAC[INT_ABS] THEN MESON_TAC[INT_COPRIME_LNEG]);; + +let INT_COPRIME_RABS = prove + (`!a b. coprime(a,abs b) <=> coprime(a,b)`, + REWRITE_TAC[INT_ABS] THEN MESON_TAC[INT_COPRIME_RNEG]);; + +let INT_COPRIME_ABS = prove + (`(!a b. coprime(abs a,b) <=> coprime(a,b)) /\ + (!a b. coprime(a,abs b) <=> coprime(a,b))`, + REWRITE_TAC[INT_COPRIME_LABS; INT_COPRIME_RABS]);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas about congruences. *) +(* ------------------------------------------------------------------------- *) + +let INT_CONG_MOD_0 = prove + (`!x y. (x == y) (mod &0) <=> (x = y)`, + INTEGER_TAC);; + +let INT_CONG_MOD_1 = prove + (`!x y. (x == y) (mod &1)`, + INTEGER_TAC);; + +let INT_CONG_0 = prove + (`!x n. ((x == &0) (mod n) <=> n divides x)`, + INTEGER_TAC);; + +let INT_CONG = prove + (`!x y n. (x == y) (mod n) <=> n divides (x - y)`, + INTEGER_TAC);; + +let INT_CONG_MUL_LCANCEL = prove + (`!a n x y. coprime(a,n) /\ (a * x == a * y) (mod n) ==> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_MUL_RCANCEL = prove + (`!a n x y. coprime(a,n) /\ (x * a == y * a) (mod n) ==> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_REFL = prove + (`!x n. (x == x) (mod n)`, + INTEGER_TAC);; + +let INT_EQ_IMP_CONG = prove + (`!a b n. a = b ==> (a == b) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_SYM = prove + (`!x y n. (x == y) (mod n) <=> (y == x) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_TRANS = prove + (`!x y z n. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_ADD = prove + (`!x x' y y'. + (x == x') (mod n) /\ (y == y') (mod n) ==> (x + y == x' + y') (mod n)`, + INTEGER_TAC);; + +let INT_CONG_SUB = prove + (`!x x' y y'. + (x == x') (mod n) /\ (y == y') (mod n) ==> (x - y == x' - y') (mod n)`, + INTEGER_TAC);; + +let INT_CONG_MUL = prove + (`!x x' y y'. + (x == x') (mod n) /\ (y == y') (mod n) ==> (x * y == x' * y') (mod n)`, + INTEGER_TAC);; + +let INT_CONG_POW = prove + (`!n k x y. (x == y) (mod n) ==> (x pow k == y pow k) (mod n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[INT_CONG_MUL; INT_POW; INT_CONG_REFL]);; + +let INT_CONG_MUL_LCANCEL_EQ = prove + (`!a n x y. coprime(a,n) ==> ((a * x == a * y) (mod n) <=> (x == y) (mod n))`, + INTEGER_TAC);; + +let INT_CONG_MUL_RCANCEL_EQ = prove + (`!a n x y. coprime(a,n) ==> ((x * a == y * a) (mod n) <=> (x == y) (mod n))`, + INTEGER_TAC);; + +let INT_CONG_ADD_LCANCEL_EQ = prove + (`!a n x y. (a + x == a + y) (mod n) <=> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_ADD_RCANCEL_EQ = prove + (`!a n x y. (x + a == y + a) (mod n) <=> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_ADD_RCANCEL = prove + (`!a n x y. (x + a == y + a) (mod n) ==> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_ADD_LCANCEL = prove + (`!a n x y. (a + x == a + y) (mod n) ==> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_ADD_LCANCEL_EQ_0 = prove + (`!a n x y. (a + x == a) (mod n) <=> (x == &0) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_ADD_RCANCEL_EQ_0 = prove + (`!a n x y. (x + a == a) (mod n) <=> (x == &0) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_INT_DIVIDES_MODULUS = prove + (`!x y m n. (x == y) (mod m) /\ n divides m ==> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_0_DIVIDES = prove + (`!n x. (x == &0) (mod n) <=> n divides x`, + INTEGER_TAC);; + +let INT_CONG_1_DIVIDES = prove + (`!n x. (x == &1) (mod n) ==> n divides (x - &1)`, + INTEGER_TAC);; + +let INT_CONG_DIVIDES = prove + (`!x y n. (x == y) (mod n) ==> (n divides x <=> n divides y)`, + INTEGER_TAC);; + +let INT_CONG_COPRIME = prove + (`!x y n. (x == y) (mod n) ==> (coprime(n,x) <=> coprime(n,y))`, + INTEGER_TAC);; + +let INT_CONG_MOD_MULT = prove + (`!x y m n. (x == y) (mod n) /\ m divides n ==> (x == y) (mod m)`, + INTEGER_TAC);; + +let INT_CONG_TO_1 = prove + (`!a n. (a == &1) (mod n) <=> ?m. a = &1 + m * n`, + INTEGER_TAC);; + +let INT_CONG_SOLVE = prove + (`!a b n. coprime(a,n) ==> ?x. (a * x == b) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_SOLVE_UNIQUE = prove + (`!a b n. coprime(a,n) + ==> !x y. (a * x == b) (mod n) /\ (a * y == b) (mod n) + ==> (x == y) (mod n)`, + INTEGER_TAC);; + +let INT_CONG_CHINESE = prove + (`coprime(a,b) /\ (x == y) (mod a) /\ (x == y) (mod b) + ==> (x == y) (mod (a * b))`, + INTEGER_TAC);; + +let INT_CHINESE_REMAINDER_COPRIME = prove + (`!a b m n. + coprime(a,b) /\ ~(a = &0) /\ ~(b = &0) /\ coprime(m,a) /\ coprime(n,b) + ==> ?x. coprime(x,a * b) /\ + (x == m) (mod a) /\ (x == n) (mod b)`, + INTEGER_TAC);; + +let INT_CHINESE_REMAINDER_COPRIME_UNIQUE = prove + (`!a b m n x y. + coprime(a,b) /\ + (x == m) (mod a) /\ (x == n) (mod b) /\ + (y == m) (mod a) /\ (y == n) (mod b) + ==> (x == y) (mod (a * b))`, + INTEGER_TAC);; + +let SOLVABLE_GCD = prove + (`!a b n. gcd(a,n) divides b ==> ?x. (a * x == b) (mod n)`, + INTEGER_TAC);; + +let INT_LINEAR_CONG_POS = prove + (`!n a x:int. ~(n = &0) ==> ?y. &0 <= y /\ (a * x == a * y) (mod n)`, + REPEAT STRIP_TAC THEN EXISTS_TAC `x + abs(x * n):int` THEN CONJ_TAC THENL + [MATCH_MP_TAC(INT_ARITH `abs(x:int) * &1 <= y ==> &0 <= x + y`) THEN + REWRITE_TAC[INT_ABS_MUL] THEN MATCH_MP_TAC INT_LE_LMUL THEN + ASM_INT_ARITH_TAC; + MATCH_MP_TAC(INTEGER_RULE + `n divides y ==> (a * x:int == a * (x + y)) (mod n)`) THEN + REWRITE_TAC[INT_DIVIDES_RABS] THEN INTEGER_TAC]);; + +let INT_CONG_SOLVE_POS = prove + (`!a b n:int. + coprime(a,n) /\ ~(n = &0 /\ abs a = &1) + ==> ?x. &0 <= x /\ (a * x == b) (mod n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n:int = &0` THEN + ASM_REWRITE_TAC[INT_COPRIME_0; INT_DIVIDES_ONE] THENL + [INT_ARITH_TAC; + ASM_MESON_TAC[INT_LINEAR_CONG_POS; INT_CONG_SOLVE; INT_CONG_TRANS; + INT_CONG_SYM]]);; + +let INT_CONG_IMP_EQ = prove + (`!x y n:int. abs(x - y) < n /\ (x == y) (mod n) ==> x = y`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[int_congruent; GSYM INT_SUB_0] THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `abs(n * q) < n ==> abs(n * q) < abs n * &1`)) THEN + REWRITE_TAC[INT_ABS_MUL; INT_ENTIRE] THEN + REWRITE_TAC[INT_ARITH + `abs n * (q:int) < abs n * &1 <=> ~(&0 <= abs n * (q - &1))`] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN + STRIP_TAC THEN MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A stronger form of the CRT. *) +(* ------------------------------------------------------------------------- *) + +let INT_CRT_STRONG = prove + (`!a1 a2 n1 n2:int. + (a1 == a2) (mod (gcd(n1,n2))) + ==> ?x. (x == a1) (mod n1) /\ (x == a2) (mod n2)`, + INTEGER_TAC);; + +let INT_CRT_STRONG_IFF = prove + (`!a1 a2 n1 n2:int. + (?x. (x == a1) (mod n1) /\ (x == a2) (mod n2)) <=> + (a1 == a2) (mod (gcd(n1,n2)))`, + INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Other miscellaneous lemmas. *) +(* ------------------------------------------------------------------------- *) + +let EVEN_SQUARE_MOD4 = prove + (`((&2 * n) pow 2 == &0) (mod &4)`, + INTEGER_TAC);; + +let ODD_SQUARE_MOD4 = prove + (`((&2 * n + &1) pow 2 == &1) (mod &4)`, + INTEGER_TAC);; + +let INT_DIVIDES_LE = prove + (`!x y. x divides y ==> abs(x) <= abs(y) \/ y = &0`, + REWRITE_TAC[int_divides; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:int`; `y:int`; `z:int`] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INT_ABS_MUL; INT_ENTIRE] THEN + REWRITE_TAC[INT_ARITH `x <= x * z <=> &0 <= x * (z - &1)`] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `z = &0` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC);; + +let INT_DIVIDES_POW_LE = prove + (`!p m n. &2 <= abs p ==> ((p pow m) divides (p pow n) <=> m <= n)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN + ASM_SIMP_TAC[INT_POW_EQ_0; INT_ARITH `&2 <= abs p ==> ~(p = &0)`] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[INT_NOT_LE; NOT_LE; INT_ABS_POW] THEN + ASM_MESON_TAC[INT_POW_MONO_LT; ARITH_RULE `&2 <= x ==> &1 < x`]; + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; INT_POW_ADD] THEN INTEGER_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Integer primality / irreducibility. *) +(* ------------------------------------------------------------------------- *) + +let int_prime = new_definition + `int_prime p <=> abs(p) > &1 /\ + !x. x divides p ==> abs(x) = &1 \/ abs(x) = abs(p)`;; + +let INT_PRIME_NEG = prove + (`!p. int_prime(--p) <=> int_prime p`, + REWRITE_TAC[int_prime; INT_DIVIDES_RNEG; INT_ABS_NEG]);; + +let INT_PRIME_ABS = prove + (`!p. int_prime(abs p) <=> int_prime p`, + GEN_TAC THEN REWRITE_TAC[INT_ABS] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_PRIME_NEG]);; + +let INT_PRIME_GE_2 = prove + (`!p. int_prime p ==> &2 <= abs(p)`, + REWRITE_TAC[int_prime] THEN INT_ARITH_TAC);; + +let INT_PRIME_0 = prove + (`~(int_prime(&0))`, + REWRITE_TAC[int_prime] THEN INT_ARITH_TAC);; + +let INT_PRIME_1 = prove + (`~(int_prime(&1))`, + REWRITE_TAC[int_prime] THEN INT_ARITH_TAC);; + +let INT_PRIME_2 = prove + (`int_prime(&2)`, + REWRITE_TAC[int_prime] THEN CONV_TAC INT_REDUCE_CONV THEN + X_GEN_TAC `x:int` THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[INT_DIVIDES_ZERO] THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC);; + +let INT_PRIME_FACTOR = prove + (`!x. ~(abs x = &1) ==> ?p. int_prime p /\ p divides x`, + MATCH_MP_TAC WF_INT_MEASURE THEN EXISTS_TAC `abs` THEN + REWRITE_TAC[INT_ABS_POS] THEN X_GEN_TAC `x:int` THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `int_prime x` THENL + [EXISTS_TAC `x:int` THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `&2` THEN ASM_REWRITE_TAC[INT_PRIME_2; INT_DIVIDES_0]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [int_prime]) THEN + ASM_SIMP_TAC[INT_ARITH `~(x = &0) /\ ~(abs x = &1) ==> abs x > &1`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `y:int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:int`) THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN + UNDISCH_TAC `y divides x` THEN INTEGER_TAC]);; + +let INT_PRIME_FACTOR_LT = prove + (`!n m p. int_prime(p) /\ ~(n = &0) /\ n = p * m ==> abs m < abs n`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INT_ABS_MUL] THEN + MATCH_MP_TAC(INT_ARITH `&0 < m * (p - &1) ==> m < p * m`) THEN + MATCH_MP_TAC INT_LT_MUL THEN + UNDISCH_TAC `~(n = &0)` THEN ASM_CASES_TAC `m = &0` THEN + ASM_REWRITE_TAC[INT_MUL_RZERO] THEN DISCH_THEN(K ALL_TAC) THEN + CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INT_PRIME_GE_2) THEN INT_ARITH_TAC);; + +let INT_PRIME_FACTOR_INDUCT = prove + (`!P. P(&0) /\ P(&1) /\ P(-- &1) /\ + (!p n. int_prime p /\ ~(n = &0) /\ P n ==> P(p * n)) + ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC WF_INT_MEASURE THEN EXISTS_TAC `abs` THEN + REWRITE_TAC[INT_ABS_POS] THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN + ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `abs n = &1` THENL + [ASM_MESON_TAC[INT_ARITH `abs x = &a <=> x = &a \/ x = -- &a`]; + ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:int` + STRIP_ASSUME_TAC o MATCH_MP INT_PRIME_FACTOR) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:int` SUBST_ALL_TAC o + GEN_REWRITE_RULE I [int_divides]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:int`; `d:int`]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INT_ENTIRE; DE_MORGAN_THM]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[INT_PRIME_FACTOR_LT; INT_ENTIRE]);; + +(* ------------------------------------------------------------------------- *) +(* Infinitude. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVIDES_FACT = prove + (`!n x. &1 <= abs(x) /\ abs(x) <= &n ==> x divides &(FACT n)`, + INDUCT_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[FACT; INT_ARITH `x <= &n <=> x = &n \/ x < &n`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_SUC; INT_ARITH `x < &m + &1 <=> x <= &m`] THEN + REWRITE_TAC[INT_OF_NUM_SUC; GSYM INT_OF_NUM_MUL] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[INT_DIVIDES_LMUL] THEN + MATCH_MP_TAC INT_DIVIDES_RMUL THEN + ASM_MESON_TAC[INT_DIVIDES_LABS; INT_DIVIDES_REFL]);; + +let INT_EUCLID_BOUND = prove + (`!n. ?p. int_prime(p) /\ &n < p /\ p <= &(FACT n) + &1`, + GEN_TAC THEN MP_TAC(SPEC `&(FACT n) + &1` INT_PRIME_FACTOR) THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_ABS_NUM; INT_OF_NUM_EQ] THEN + REWRITE_TAC[EQ_ADD_RCANCEL_0; FACT_NZ; GSYM INT_OF_NUM_ADD] THEN + DISCH_THEN(X_CHOOSE_THEN `p:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `abs p` THEN ASM_REWRITE_TAC[INT_PRIME_ABS] THEN CONJ_TAC THENL + [ALL_TAC; + FIRST_ASSUM(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_SUC] THEN + INT_ARITH_TAC] THEN + REWRITE_TAC[GSYM INT_NOT_LE] THEN DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `p:int`] INT_DIVIDES_FACT) THEN + ASM_SIMP_TAC[INT_PRIME_GE_2; INT_ARITH `&2 <= p ==> &1 <= p`] THEN + DISCH_TAC THEN SUBGOAL_THEN `p divides &1` MP_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC; + REWRITE_TAC[INT_DIVIDES_ONE] THEN + ASM_MESON_TAC[INT_PRIME_NEG; INT_PRIME_1]]);; + +let INT_EUCLID = prove + (`!n. ?p. int_prime(p) /\ p > n`, + MP_TAC INT_IMAGE THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `n:int` THEN REWRITE_TAC[INT_GT] THEN + ASM_REWRITE_TAC[OR_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MP_TAC INT_EUCLID_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `m:num` THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN INT_ARITH_TAC);; + +let INT_PRIMES_INFINITE = prove + (`INFINITE {p | int_prime p}`, + SUBGOAL_THEN `INFINITE {n | int_prime(&n)}` MP_TAC THEN + REWRITE_TAC[INFINITE; CONTRAPOS_THM] THENL + [REWRITE_TAC[num_FINITE; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP; NOT_LE] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT; INT_EXISTS_POS] THEN + MP_TAC INT_EUCLID_BOUND THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + SIMP_TAC[] THEN INT_ARITH_TAC; + MP_TAC(ISPECL [`&`; `{p | int_prime p}`] FINITE_IMAGE_INJ) THEN + REWRITE_TAC[INT_OF_NUM_EQ; IN_ELIM_THM]]);; + +let INT_COPRIME_PRIME = prove + (`!p a b. coprime(a,b) ==> ~(int_prime(p) /\ p divides a /\ p divides b)`, + REWRITE_TAC[int_coprime] THEN + MESON_TAC[INT_DIVIDES_ONE; INT_PRIME_NEG; INT_PRIME_1]);; + +let INT_COPRIME_PRIME_EQ = prove + (`!a b. coprime(a,b) <=> !p. ~(int_prime(p) /\ p divides a /\ p divides b)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[INT_COPRIME_PRIME]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[int_coprime; INT_DIVIDES_ONE_ABS] THEN + ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `d:int` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `p:int` o MATCH_MP INT_PRIME_FACTOR) THEN + EXISTS_TAC `p:int` THEN ASM_MESON_TAC[INT_DIVIDES_TRANS]);; + +let INT_PRIME_COPRIME = prove + (`!x p. int_prime(p) ==> p divides x \/ coprime(p,x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[int_coprime] THEN + MATCH_MP_TAC(TAUT `(~b ==> a) ==> a \/ b`) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; INT_DIVIDES_ONE_ABS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [int_prime]) THEN + DISCH_THEN(MP_TAC o SPEC `d:int` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[INT_DIVIDES_TRANS; INT_DIVIDES_LABS; INT_DIVIDES_RABS]);; + +let INT_PRIME_COPRIME_EQ = prove + (`!p n. int_prime p ==> (coprime(p,n) <=> ~(p divides n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(b \/ a) /\ ~(a /\ b) ==> (a <=> ~b)`) THEN + ASM_SIMP_TAC[INT_PRIME_COPRIME; int_coprime; INT_DIVIDES_ONE_ABS] THEN + ASM_MESON_TAC[INT_DIVIDES_REFL; INT_PRIME_1; INT_PRIME_ABS]);; + +let INT_COPRIME_PRIMEPOW = prove + (`!p k m. int_prime p /\ ~(k = 0) + ==> (coprime(m,p pow k) <=> ~(p divides m))`, + SIMP_TAC[INT_COPRIME_RPOW] THEN ONCE_REWRITE_TAC[INT_COPRIME_SYM] THEN + SIMP_TAC[INT_PRIME_COPRIME_EQ]);; + +let INT_COPRIME_BEZOUT = prove + (`!a b. coprime(a,b) <=> ?x y. a * x + b * y = &1`, + INTEGER_TAC);; + +let INT_COPRIME_BEZOUT_ALT = prove + (`!a b. coprime(a,b) ==> ?x y. a * x = b * y + &1`, + INTEGER_TAC);; + +let INT_BEZOUT_PRIME = prove + (`!a p. int_prime p /\ ~(p divides a) ==> ?x y. a * x = p * y + &1`, + MESON_TAC[INT_COPRIME_BEZOUT_ALT; INT_COPRIME_SYM; INT_PRIME_COPRIME_EQ]);; + +let INT_PRIME_DIVPROD = prove + (`!p a b. int_prime(p) /\ p divides (a * b) ==> p divides a \/ p divides b`, + ONCE_REWRITE_TAC[TAUT `a /\ b ==> c \/ d <=> a ==> (~c /\ ~d ==> ~b)`] THEN + SIMP_TAC[GSYM INT_PRIME_COPRIME_EQ] THEN INTEGER_TAC);; + +let INT_PRIME_DIVPROD_EQ = prove + (`!p a b. int_prime(p) + ==> (p divides (a * b) <=> p divides a \/ p divides b)`, + MESON_TAC[INT_PRIME_DIVPROD; INT_DIVIDES_LMUL; INT_DIVIDES_RMUL]);; + +let INT_PRIME_DIVPOW = prove + (`!n p x. int_prime(p) /\ p divides (x pow n) ==> p divides x`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ASM_SIMP_TAC[GSYM INT_PRIME_COPRIME_EQ; INT_COPRIME_POW]);; + +let INT_PRIME_DIVPOW_N = prove + (`!n p x. int_prime p /\ p divides (x pow n) ==> (p pow n) divides (x pow n)`, + MESON_TAC[INT_PRIME_DIVPOW; INT_DIVIDES_POW]);; + +let INT_COPRIME_SOS = prove + (`!x y. coprime(x,y) ==> coprime(x * y,x pow 2 + y pow 2)`, + INTEGER_TAC);; + +let INT_PRIME_IMP_NZ = prove + (`!p. int_prime p ==> ~(p = &0)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INT_PRIME_GE_2) THEN + INT_ARITH_TAC);; + +let INT_DISTINCT_PRIME_COPRIME = prove + (`!p q. int_prime p /\ int_prime q /\ ~(abs p = abs q) ==> coprime(p,q)`, + REWRITE_TAC[GSYM INT_DIVIDES_ANTISYM_ABS] THEN + MESON_TAC[INT_COPRIME_SYM; INT_PRIME_COPRIME_EQ]);; + +let INT_PRIME_COPRIME_LT = prove + (`!x p. int_prime p /\ &0 < abs x /\ abs x < abs p ==> coprime(x,p)`, + ONCE_REWRITE_TAC[INT_COPRIME_SYM] THEN SIMP_TAC[INT_PRIME_COPRIME_EQ] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC);; + +let INT_DIVIDES_PRIME_PRIME = prove + (`!p q. int_prime p /\ int_prime q ==> (p divides q <=> abs p = abs q)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ASM_SIMP_TAC[GSYM INT_PRIME_COPRIME_EQ; INT_DISTINCT_PRIME_COPRIME]; + SIMP_TAC[GSYM INT_DIVIDES_ANTISYM_ABS]]);; + +let INT_COPRIME_POW_DIVPROD = prove + (`!d a b. (d pow n) divides (a * b) /\ coprime(d,a) ==> (d pow n) divides b`, + MESON_TAC[INT_COPRIME_DIVPROD; INT_COPRIME_POW; INT_COPRIME_SYM]);; + +let INT_PRIME_COPRIME_CASES = prove + (`!p a b. int_prime p /\ coprime(a,b) ==> coprime(p,a) \/ coprime(p,b)`, + MESON_TAC[INT_COPRIME_PRIME; INT_PRIME_COPRIME_EQ]);; + +let INT_PRIME_DIVPROD_POW = prove + (`!n p a b. int_prime(p) /\ coprime(a,b) /\ (p pow n) divides (a * b) + ==> (p pow n) divides a \/ (p pow n) divides b`, + MESON_TAC[INT_COPRIME_POW_DIVPROD; INT_PRIME_COPRIME_CASES; INT_MUL_SYM]);; + +let INT_DIVIDES_POW2_REV = prove + (`!n a b. (a pow n) divides (b pow n) /\ ~(n = 0) ==> a divides b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = &0` THENL + [ASM_MESON_TAC[INT_GCD_EQ_0; INT_DIVIDES_REFL]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INT_GCD_COPRIME_EXISTS) THEN + STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_POW_MUL] THEN + ASM_SIMP_TAC[INT_POW_EQ_0; INT_DIVIDES_RMUL2_EQ] THEN + DISCH_THEN(MP_TAC o MATCH_MP (INTEGER_RULE + `a divides b ==> coprime(a,b) ==> a divides &1`)) THEN + ASM_SIMP_TAC[INT_COPRIME_POW2] THEN + ASM_MESON_TAC[INT_DIVIDES_POW2; INT_DIVIDES_TRANS; INT_DIVIDES_1]);; + +let INT_DIVIDES_POW2_EQ = prove + (`!n a b. ~(n = 0) ==> ((a pow n) divides (b pow n) <=> a divides b)`, + MESON_TAC[INT_DIVIDES_POW2_REV; INT_DIVIDES_POW]);; + +let INT_POW_MUL_EXISTS = prove + (`!m n p k. ~(m = &0) /\ m pow k * n = p pow k ==> ?q. n = q pow k`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN + ASM_SIMP_TAC[INT_POW; INT_MUL_LID] THEN STRIP_TAC THEN + MP_TAC(SPECL [`k:num`; `m:int`; `p:int`] INT_DIVIDES_POW2_REV) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[int_divides; INT_MUL_SYM]; ALL_TAC] THEN + REWRITE_TAC[int_divides] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN + ASM_SIMP_TAC[INT_POW_MUL; INT_EQ_MUL_LCANCEL; INT_POW_EQ_0] THEN + MESON_TAC[]);; + +let INT_COPRIME_POW_ABS = prove + (`!n a b c. coprime(a,b) /\ a * b = c pow n + ==> ?r s. abs a = r pow n /\ abs b = s pow n`, + GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[INT_POW] THEN MESON_TAC[INT_ABS_MUL_1; INT_ABS_NUM]; + ALL_TAC] THEN + MATCH_MP_TAC INT_PRIME_FACTOR_INDUCT THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN ASM_REWRITE_TAC[INT_POW_ZERO; INT_ENTIRE] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC DISJ_CASES_TAC) THEN + ASM_SIMP_TAC[INT_COPRIME_0; INT_DIVIDES_ONE_ABS; INT_ABS_NUM] THEN + ASM_MESON_TAC[INT_POW_ONE; INT_POW_ZERO]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs:int->int`) THEN + SIMP_TAC[INT_POW_ONE; INT_ABS_NUM; INT_ABS_MUL_1] THEN + MESON_TAC[INT_POW_ONE]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM `abs:int->int`) THEN + SIMP_TAC[INT_POW_ONE; INT_ABS_POW; INT_ABS_NEG; INT_ABS_NUM; + INT_ABS_MUL_1] THEN MESON_TAC[INT_POW_ONE]; + REWRITE_TAC[INT_POW_MUL] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p pow n divides a \/ p pow n divides b` MP_TAC THENL + [ASM_MESON_TAC[INT_PRIME_DIVPROD_POW; int_divides]; ALL_TAC] THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `d:int` SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_COPRIME_SYM]) THEN + ASM_SIMP_TAC[INT_COPRIME_RMUL; INT_COPRIME_LMUL; + INT_COPRIME_LPOW; INT_COPRIME_RPOW] THEN + STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`b:int`; `d:int`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`d:int`; `a:int`])] THEN + ASM_REWRITE_TAC[] THEN + (ANTS_TAC THENL + [MATCH_MP_TAC(INT_RING `!p. ~(p = &0) /\ a * p = b * p ==> a = b`) THEN + EXISTS_TAC `p pow n` THEN + ASM_SIMP_TAC[INT_POW_EQ_0; INT_PRIME_IMP_NZ] THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC INT_RING; + STRIP_TAC THEN + ASM_REWRITE_TAC[INT_ABS_POW; GSYM INT_POW_MUL; INT_ABS_MUL] THEN + MESON_TAC[]])]);; + +let INT_COPRIME_POW_ODD = prove + (`!n a b c. ODD n /\ coprime(a,b) /\ a * b = c pow n + ==> ?r s. a = r pow n /\ b = s pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `a:int`; `b:int`; `c:int`] INT_COPRIME_POW_ABS) THEN + ASM_REWRITE_TAC[INT_ABS] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[INT_ABS] THEN + ASM_MESON_TAC[INT_POW_NEG; INT_NEG_NEG; NOT_ODD]);; + +let INT_DIVIDES_PRIME_POW_LE = prove + (`!p q m n. int_prime p /\ int_prime q + ==> ((p pow m) divides (q pow n) <=> + m = 0 \/ abs p = abs q /\ m <= n)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = 0` THEN + ASM_REWRITE_TAC[INT_POW; INT_DIVIDES_1] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM INT_DIVIDES_LABS] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM INT_DIVIDES_RABS] THEN + REWRITE_TAC[INT_ABS_POW] THEN EQ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`); + ALL_TAC] THEN + ASM_MESON_TAC[INT_DIVIDES_POW_LE; INT_PRIME_GE_2; INT_PRIME_DIVPOW; + INT_ABS_ABS; INT_PRIME_ABS; INT_DIVIDES_POW2; INT_DIVIDES_PRIME_PRIME]);; + +let INT_EQ_PRIME_POW_ABS = prove + (`!p q m n. int_prime p /\ int_prime q + ==> (abs p pow m = abs q pow n <=> + m = 0 /\ n = 0 \/ abs p = abs q /\ m = n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_ABS_POW] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM INT_DIVIDES_ANTISYM_ABS] THEN + ASM_SIMP_TAC[INT_DIVIDES_PRIME_POW_LE; INT_PRIME_ABS] THEN + ASM_CASES_TAC `abs p = abs q` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let INT_EQ_PRIME_POW_POS = prove + (`!p q m n. int_prime p /\ int_prime q /\ &0 <= p /\ &0 <= q + ==> (p pow m = q pow n <=> + m = 0 /\ n = 0 \/ p = q /\ m = n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:int`; `q:int`; `m:num`; `n:num`] INT_EQ_PRIME_POW_ABS) THEN + ASM_SIMP_TAC[INT_ABS]);; + +let INT_DIVIDES_FACT_PRIME = prove + (`!p. int_prime p ==> !n. p divides &(FACT n) <=> abs p <= &n`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT] THENL + [REWRITE_TAC[INT_ARITH `abs x <= &0 <=> x = &0`] THEN + ASM_MESON_TAC[INT_DIVIDES_ONE; INT_PRIME_NEG; INT_PRIME_0; INT_PRIME_1]; + ASM_SIMP_TAC[INT_PRIME_DIVPROD_EQ; GSYM INT_OF_NUM_MUL] THEN + REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN + ASM_MESON_TAC[INT_DIVIDES_LE; INT_ARITH `x <= n ==> x <= n + &1`; + INT_DIVIDES_REFL; INT_DIVIDES_LABS; + INT_ARITH `p <= n + &1 ==> p <= n \/ p = n + &1`; + INT_ARITH `~(&n + &1 = &0)`; + INT_ARITH `abs(&n + &1) = &n + &1`]]);; diff --git a/Library/isum.ml b/Library/isum.ml new file mode 100644 index 0000000..a20a129 --- /dev/null +++ b/Library/isum.ml @@ -0,0 +1,231 @@ +(* ========================================================================= *) +(* Define integer sums, with most theorems derived automatically. *) +(* ========================================================================= *) + +let isum = new_definition + `isum = iterate((+):int->int->int)`;; + +let NEUTRAL_INT_ADD = prove + (`neutral((+):int->int->int) = &0`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[INT_ADD_LID; INT_ADD_RID]);; + +let MONOIDAL_INT_ADD = prove + (`monoidal((+):int->int->int)`, + REWRITE_TAC[monoidal; NEUTRAL_INT_ADD] THEN INT_ARITH_TAC);; + +let ISUM_SUPPORT = prove + (`!f s. isum (support (+) f s) f = isum s f`, + REWRITE_TAC[isum; ITERATE_SUPPORT]);; + +let int_isum = prove + (`!f:A->int s. real_of_int(isum s f) = sum s (\x. real_of_int(f x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[sum; isum] THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + SUBGOAL_THEN + `support(+) (\x:A. real_of_int(f x)) s = support(+) f s` + SUBST1_TAC THENL + [REWRITE_TAC[support; NEUTRAL_REAL_ADD; NEUTRAL_INT_ADD] THEN + REWRITE_TAC[GSYM int_of_num_th; GSYM int_eq]; + ALL_TAC] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[NEUTRAL_REAL_ADD; NEUTRAL_INT_ADD; int_of_num_th] THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`support(+) (f:A->int) s`,`s:A->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_INT_ADD; MONOIDAL_REAL_ADD] THEN + SIMP_TAC[NEUTRAL_INT_ADD; NEUTRAL_REAL_ADD; int_of_num_th; int_add_th]);; + +(* ------------------------------------------------------------------------- *) +(* Generalize INT_OF_REAL_THM for most common sum patterns. *) +(* ------------------------------------------------------------------------- *) + +let INT_OF_REAL_THM = + let dest = `real_of_int` + and real_ty = `:real` + and int_ty = `:int` + and cond_th = prove + (`real_of_int(if b then x else y) = + if b then real_of_int x else real_of_int y`, + COND_CASES_TAC THEN REWRITE_TAC[]) + and compose_th = prove + (`(\x. real_of_int((f o g) x)) = (\x. real_of_int(f x)) o g`, + REWRITE_TAC[o_DEF]) in + let thlist = map GSYM + [int_eq; int_le; int_lt; int_ge; int_gt; + int_of_num_th; int_neg_th; int_add_th; int_mul_th; + int_sub_th; int_abs_th; int_max_th; int_min_th; int_pow_th; + int_isum; GSYM BETA_THM; GSYM ETA_AX; compose_th; cond_th] in + let REW_RULE = GEN_REWRITE_RULE REDEPTH_CONV thlist in + let is_fun_into_real ty = + try match dest_type ty with + "fun",[s;t] when t = real_ty -> mk_fun_ty s int_ty + | "real",[] -> int_ty + | _ -> failwith "" + with Failure _ -> ty in + let int_of_real_ty ty = + try match dest_type ty with + "real",[] -> int_ty + | "fun",[s;t] when t = real_ty -> mk_fun_ty s int_ty + | _ -> ty + with Failure _ -> ty in + let int_tm_of_real_var v = + let s,ty = dest_var v in + let tys,rty = splitlist dest_fun_ty ty in + if rty <> real_ty then v else + let ity = itlist mk_fun_ty tys int_ty in + let vs = map genvar tys in + list_mk_abs(vs,mk_comb(dest,list_mk_comb(mk_var(s,ity),vs))) in + let int_of_real_var v = + let s,ty = dest_var v in + let tys,rty = splitlist dest_fun_ty ty in + if rty <> real_ty then v else + let ity = itlist mk_fun_ty tys int_ty in + mk_var(s,ity) in + let INT_OF_REAL_THM1 th = + let newavs = subtract (frees (concl th)) (freesl (hyp th)) in + let avs,bod = strip_forall(concl th) in + let allavs = newavs@avs in + let avs' = map int_tm_of_real_var allavs in + let avs'' = map int_of_real_var avs in + GENL avs'' (REW_RULE(SPECL avs' (GENL newavs th))) in + let rec INT_OF_REAL_THM th = + if is_conj(concl th) then CONJ (INT_OF_REAL_THM1 (CONJUNCT1 th)) + (INT_OF_REAL_THM1 (CONJUNCT2 th)) + else INT_OF_REAL_THM1 th in + INT_OF_REAL_THM;; + +(* ------------------------------------------------------------------------- *) +(* Apply it in all the cases where it works. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_ISUM = INT_OF_REAL_THM CARD_EQ_SUM;; +let INT_SUB_POW = INT_OF_REAL_THM REAL_SUB_POW;; +let ISUM_0 = INT_OF_REAL_THM SUM_0;; +let ISUM_ABS = INT_OF_REAL_THM SUM_ABS;; +let ISUM_ABS_BOUND = INT_OF_REAL_THM SUM_ABS_BOUND;; +let ISUM_ABS_LE = INT_OF_REAL_THM SUM_ABS_LE;; +let ISUM_ABS_NUMSEG = INT_OF_REAL_THM SUM_ABS_NUMSEG;; +let ISUM_ADD = INT_OF_REAL_THM SUM_ADD;; +let ISUM_ADD_NUMSEG = INT_OF_REAL_THM SUM_ADD_NUMSEG;; +let ISUM_ADD_SPLIT = INT_OF_REAL_THM SUM_ADD_SPLIT;; +let ISUM_BIJECTION = INT_OF_REAL_THM SUM_BIJECTION;; +let ISUM_BOUND = INT_OF_REAL_THM SUM_BOUND;; +let ISUM_BOUND_LT = INT_OF_REAL_THM SUM_BOUND_LT;; +let ISUM_BOUND_LT_ALL = INT_OF_REAL_THM SUM_BOUND_LT_ALL;; +let ISUM_CASES = INT_OF_REAL_THM SUM_CASES;; +let ISUM_CLAUSES = INT_OF_REAL_THM SUM_CLAUSES;; +let ISUM_CLAUSES_LEFT = INT_OF_REAL_THM SUM_CLAUSES_LEFT;; +let ISUM_CLAUSES_NUMSEG = INT_OF_REAL_THM SUM_CLAUSES_NUMSEG;; +let ISUM_CLAUSES_RIGHT = INT_OF_REAL_THM SUM_CLAUSES_RIGHT;; +let ISUM_COMBINE_L = INT_OF_REAL_THM SUM_COMBINE_L;; +let ISUM_COMBINE_R = INT_OF_REAL_THM SUM_COMBINE_R;; +let ISUM_CONST = INT_OF_REAL_THM SUM_CONST;; +let ISUM_CONST_NUMSEG = INT_OF_REAL_THM SUM_CONST_NUMSEG;; +let ISUM_DELETE = INT_OF_REAL_THM SUM_DELETE;; +let ISUM_DELETE_CASES = INT_OF_REAL_THM SUM_DELETE_CASES;; +let ISUM_DELTA = INT_OF_REAL_THM SUM_DELTA;; +let ISUM_DIFF = INT_OF_REAL_THM SUM_DIFF;; +let ISUM_DIFFS = INT_OF_REAL_THM SUM_DIFFS;; +let ISUM_EQ = INT_OF_REAL_THM SUM_EQ;; +let ISUM_EQ_0 = INT_OF_REAL_THM SUM_EQ_0;; +let ISUM_EQ_0_NUMSEG = INT_OF_REAL_THM SUM_EQ_0_NUMSEG;; +let ISUM_EQ_GENERAL = INT_OF_REAL_THM SUM_EQ_GENERAL;; +let ISUM_EQ_GENERAL_INVERSES = INT_OF_REAL_THM SUM_EQ_GENERAL_INVERSES;; +let ISUM_EQ_NUMSEG = INT_OF_REAL_THM SUM_EQ_NUMSEG;; +let ISUM_EQ_SUPERSET = INT_OF_REAL_THM SUM_EQ_SUPERSET;; +let ISUM_GROUP = INT_OF_REAL_THM SUM_GROUP;; +let ISUM_IMAGE = INT_OF_REAL_THM SUM_IMAGE;; +let ISUM_IMAGE_GEN = INT_OF_REAL_THM SUM_IMAGE_GEN;; +let ISUM_IMAGE_LE = INT_OF_REAL_THM SUM_IMAGE_LE;; +let ISUM_IMAGE_NONZERO = INT_OF_REAL_THM SUM_IMAGE_NONZERO;; +let ISUM_INCL_EXCL = INT_OF_REAL_THM SUM_INCL_EXCL;; +let ISUM_INJECTION = INT_OF_REAL_THM SUM_INJECTION;; +let ISUM_LE = INT_OF_REAL_THM SUM_LE;; +let ISUM_LE_INCLUDED = INT_OF_REAL_THM SUM_LE_INCLUDED;; +let ISUM_LE_NUMSEG = INT_OF_REAL_THM SUM_LE_NUMSEG;; +let ISUM_LMUL = INT_OF_REAL_THM SUM_LMUL;; +let ISUM_LT = INT_OF_REAL_THM SUM_LT;; +let ISUM_LT_ALL = INT_OF_REAL_THM SUM_LT_ALL;; +let ISUM_MULTICOUNT = INT_OF_REAL_THM SUM_MULTICOUNT;; +let ISUM_MULTICOUNT_GEN = INT_OF_REAL_THM SUM_MULTICOUNT_GEN;; +let ISUM_NEG = INT_OF_REAL_THM SUM_NEG;; +let ISUM_OFFSET = INT_OF_REAL_THM SUM_OFFSET;; +let ISUM_OFFSET_0 = INT_OF_REAL_THM SUM_OFFSET_0;; +let ISUM_PARTIAL_PRE = INT_OF_REAL_THM SUM_PARTIAL_PRE;; +let ISUM_PARTIAL_SUC = INT_OF_REAL_THM SUM_PARTIAL_SUC;; +let ISUM_POS_BOUND = INT_OF_REAL_THM SUM_POS_BOUND;; +let ISUM_POS_EQ_0 = INT_OF_REAL_THM SUM_POS_EQ_0;; +let ISUM_POS_EQ_0_NUMSEG = INT_OF_REAL_THM SUM_POS_EQ_0_NUMSEG;; +let ISUM_POS_LE = INT_OF_REAL_THM SUM_POS_LE;; +let ISUM_POS_LE_NUMSEG = INT_OF_REAL_THM SUM_POS_LE_NUMSEG;; +let ISUM_RESTRICT = INT_OF_REAL_THM SUM_RESTRICT;; +let ISUM_RESTRICT_SET = INT_OF_REAL_THM SUM_RESTRICT_SET;; +let ISUM_RMUL = INT_OF_REAL_THM SUM_RMUL;; +let ISUM_SING = INT_OF_REAL_THM SUM_SING;; +let ISUM_SING_NUMSEG = INT_OF_REAL_THM SUM_SING_NUMSEG;; +let ISUM_SUB = INT_OF_REAL_THM SUM_SUB;; +let ISUM_SUBSET = INT_OF_REAL_THM SUM_SUBSET;; +let ISUM_SUBSET_SIMPLE = INT_OF_REAL_THM SUM_SUBSET_SIMPLE;; +let ISUM_SUB_NUMSEG = INT_OF_REAL_THM SUM_SUB_NUMSEG;; +let ISUM_ISUM_RESTRICT = INT_OF_REAL_THM SUM_SUM_RESTRICT;; +let ISUM_SUPERSET = INT_OF_REAL_THM SUM_SUPERSET;; +let ISUM_SWAP = INT_OF_REAL_THM SUM_SWAP;; +let ISUM_SWAP_NUMSEG = INT_OF_REAL_THM SUM_SWAP_NUMSEG;; +let ISUM_TRIV_NUMSEG = INT_OF_REAL_THM SUM_TRIV_NUMSEG;; +let ISUM_UNION = INT_OF_REAL_THM SUM_UNION;; +let ISUM_UNIONS_NONZERO = INT_OF_REAL_THM SUM_UNIONS_NONZERO;; +let ISUM_UNION_EQ = INT_OF_REAL_THM SUM_UNION_EQ;; +let ISUM_UNION_LZERO = INT_OF_REAL_THM SUM_UNION_LZERO;; +let ISUM_UNION_NONZERO = INT_OF_REAL_THM SUM_UNION_NONZERO;; +let ISUM_UNION_RZERO = INT_OF_REAL_THM SUM_UNION_RZERO;; +let ISUM_ZERO_EXISTS = INT_OF_REAL_THM SUM_ZERO_EXISTS;; +let REAL_OF_NUM_ISUM = INT_OF_REAL_THM REAL_OF_NUM_SUM;; +let REAL_OF_NUM_ISUM_NUMSEG = INT_OF_REAL_THM REAL_OF_NUM_SUM_NUMSEG;; + +(* ------------------------------------------------------------------------- *) +(* Manually derive the few cases where it doesn't. *) +(* *) +(* Note that SUM_BOUND_GEN and SUM_BOUND_LT_GEN don't seem to have immediate *) +(* analogs over the integers since they involve division. *) +(* *) +(* Should really roll ADMISSIBLE_ISUM into "define" as well. *) +(* ------------------------------------------------------------------------- *) + +let ISUM_ISUM_PRODUCT = prove + (`!s:A->bool t:A->B->bool x. + FINITE s /\ (!i. i IN s ==> FINITE(t i)) + ==> isum s (\i. isum (t i) (x i)) = + isum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, + REWRITE_TAC[isum] THEN MATCH_MP_TAC ITERATE_ITERATE_PRODUCT THEN + REWRITE_TAC[MONOIDAL_INT_ADD]);; + +let ADMISSIBLE_ISUM = prove + (`!(<<) p:(B->C)->P->bool s:P->A h a b. + admissible(<<) (\f (k,x). a(x) <= k /\ k <= b(x) /\ p f x) + (\(k,x). s x) (\f (k,x). h f x k) + ==> admissible(<<) p s (\f x. isum(a(x)..b(x)) (h f x))`, + REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ISUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; + +let INT_SUB_POW_L1 = prove + (`!x n. 1 <= n ==> &1 - x pow n = (&1 - x) * isum (0..n - 1) (\i. x pow i)`, + SIMP_TAC[INT_OF_REAL_THM REAL_SUB_POW_L1; ETA_AX]);; + +let INT_SUB_POW_R1 = prove + (`!x n. 1 <= n ==> x pow n - &1 = (x - &1) * isum (0..n - 1) (\i. x pow i)`, + SIMP_TAC[INT_OF_REAL_THM REAL_SUB_POW_R1; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Extend the congruences. *) +(* ------------------------------------------------------------------------- *) + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> isum s (\i. f(i)) = isum s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> isum(a..b) (\i. f(i)) = isum(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> isum {y | p y} (\i. f(i)) = isum {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ISUM_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; diff --git a/Library/iter.ml b/Library/iter.ml new file mode 100644 index 0000000..e667d6e --- /dev/null +++ b/Library/iter.ml @@ -0,0 +1,153 @@ +(* ========================================================================= *) +(* Iterated application of a function, ITER n f x = f^n(x). *) +(* *) +(* (c) Marco Maggesi, Graziano Gentili and Gianni Ciolli, 2008. *) +(* ========================================================================= *) + +let ITER = define + `(!f. ITER 0 f x = x) /\ + (!f n. ITER (SUC n) f x = f (ITER n f x))`;; + +let ITER_POINTLESS = prove + (`(!f. ITER 0 f = I) /\ + (!f n. ITER (SUC n) f = f o ITER n f)`, + REWRITE_TAC [FUN_EQ_THM; I_THM; o_THM; ITER]);; + +let ITER_ALT = prove + (`(!f x. ITER 0 f x = x) /\ + (!f n x. ITER (SUC n) f x = ITER n f (f x))`, + REWRITE_TAC [ITER] THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC [ITER]);; + +let ITER_ALT_POINTLESS = prove + (`(!f. ITER 0 f = I) /\ + (!f n. ITER (SUC n) f = ITER n f o f)`, + REWRITE_TAC [FUN_EQ_THM; I_THM; o_THM; ITER_ALT]);; + +let ITER_1 = prove + (`!f x. ITER 1 f x = f x`, + REWRITE_TAC[num_CONV `1`; ITER]);; + +let ITER_ADD = prove + (`!f n m x. ITER n f (ITER m f x) = ITER (n + m) f x`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; ADD]);; + +let ITER_MUL = prove + (`!f n m x. ITER n (ITER m f) x = ITER (n * m) f x`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ITER; MULT; ITER_ADD; ADD_AC]);; + +let ITER_FIXPOINT = prove + (`!f n x. f x = x ==> ITER n f x = x`, + GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC [ITER_ALT]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of "order" or "characteristic" in a general setting. *) +(* ------------------------------------------------------------------------- *) + +let ORDER_EXISTENCE_GEN = prove + (`!P f:num->A. + P(f 0) /\ (!m n. P(f m) /\ ~(m = 0) ==> (P(f(m + n)) <=> P(f n))) + ==> ?d. !n. P(f n) <=> d divides n`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `!n. ~(n = 0) ==> ~P(f n:A)` THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[NUMBER_RULE `0 divides n <=> n = 0`] THEN + ASM_MESON_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM])] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[NOT_IMP] THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_MESON_TAC[NUMBER_RULE `n divides 0`]; ALL_TAC] THEN + ASM_CASES_TAC `d <= n:num` THENL + [ALL_TAC; ASM_MESON_TAC[NOT_LT; DIVIDES_LE]] THEN + SUBGOAL_THEN `n:num = (n - d) + d` SUBST1_TAC THENL + [ASM_ARITH_TAC; ABBREV_TAC `m:num = n - d`] THEN + REWRITE_TAC[NUMBER_RULE `d divides m + d <=> d divides m`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ASM_MESON_TAC[ADD_SYM]]);; + +let ORDER_EXISTENCE_ITER = prove + (`!R f z:A. + R z z /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x y. R x y ==> R (f x) (f y)) + ==> ?d. !n. R (ITER n f z) z <=> d divides n`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. (R:A->A->bool) x z`; + `\n. ITER n f (z:A)`] ORDER_EXISTENCE_GEN) THEN + ASM_REWRITE_TAC[ITER] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM ITER_ADD] THEN + MP_TAC(MESON[] + `!a b:num->A. (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!n. R (a n) (b n)) + ==> (!n. R (a n) z <=> R (b n) z)`) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[ITER] THEN + ASM_MESON_TAC[]);; + +let ORDER_EXISTENCE_CARD = prove + (`!R f z:A k. + FINITE { R(ITER n f z) | n IN (:num)} /\ + CARD { R(ITER n f z) | n IN (:num)} <= k /\ + R z z /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x y. R (f x) (f y) <=> R x y) + ==> ?d. 0 < d /\ d <= k /\ !n. R (ITER n f z) z <=> d divides n`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?m. 0 < m /\ m <= k /\ (R:A->A->bool) (ITER m f z) z` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`\n. (R:A->A->bool) (ITER n f z)`; `0..k`] + CARD_IMAGE_EQ_INJ) THEN + REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG; SUB_0] THEN + MATCH_MP_TAC(TAUT `~p /\ (~q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `c <= k ==> s <= c ==> ~(s = k + 1)`)) THEN + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `q:num`] THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `q - p:num` THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + SUBGOAL_THEN + `!d. d <= p + ==> (R:A->A->bool) (ITER (p - d) f z) (ITER (q - d) f z)` + MP_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_0] THENL + [SPEC_TAC(`q:num`,`q:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ITER]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `q - d = SUC(q - SUC d) /\ p - d = SUC(p - SUC d)` + (fun th -> REWRITE_TAC[th]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[ITER]]; + DISCH_THEN(MP_TAC o SPEC `p:num`) THEN + REWRITE_TAC[LE_REFL; SUB_REFL; ITER] THEN ASM_MESON_TAC[]]]; + MP_TAC(ISPECL [`R:A->A->bool`; `f:A->A`; `z:A`] ORDER_EXISTENCE_ITER) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:num` THEN ASM_CASES_TAC `d = 0` THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `m:num`) THEN + ASM_SIMP_TAC[LE_1; NUMBER_RULE `!n. 0 divides n <=> n = 0`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_ARITH_TAC]);; + +let ORDER_EXISTENCE_FINITE = prove + (`!R f z:A. + FINITE { R(ITER n f z) | n IN (:num)} /\ + R z z /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x y. R (f x) (f y) <=> R x y) + ==> ?d. 0 < d /\ !n. R (ITER n f z) z <=> d divides n`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`R:A->A->bool`; `f:A->A`; `z:A`; + `CARD {(R:A->A->bool)(ITER n f z) | n IN (:num)}`] + ORDER_EXISTENCE_CARD) THEN ASM_REWRITE_TAC[LE_REFL] THEN MESON_TAC[]);; diff --git a/Library/multiplicative.ml b/Library/multiplicative.ml new file mode 100644 index 0000000..d45c6e8 --- /dev/null +++ b/Library/multiplicative.ml @@ -0,0 +1,415 @@ +(* ========================================================================= *) +(* Multiplicative functions into N or R (could add Z, C etc.) *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; + +(* ------------------------------------------------------------------------- *) +(* Definition of multiplicativity of functions into N. *) +(* ------------------------------------------------------------------------- *) + +let multiplicative = new_definition + `multiplicative f <=> + f(1) = 1 /\ !m n. coprime(m,n) ==> f(m * n) = f(m) * f(n)`;; + +let MULTIPLICATIVE_1 = prove + (`!f. multiplicative f ==> f(1) = 1`, + SIMP_TAC[multiplicative]);; + +(* ------------------------------------------------------------------------- *) +(* We can really ignore the value at zero. *) +(* ------------------------------------------------------------------------- *) + +let MULTIPLICATIVE = prove + (`multiplicative f <=> + f(1) = 1 /\ + !m n. ~(m = 0) /\ ~(n = 0) /\ coprime(m,n) ==> f(m * n) = f(m) * f(n)`, + REWRITE_TAC[multiplicative] THEN EQ_TAC THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + ASM_CASES_TAC `n = 0` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_CASES_TAC `m = 0` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN + ASM_MESON_TAC[COPRIME_SYM; COPRIME_0; DIVIDES_ONE; MULT_CLAUSES]);; + +let MULTIPLICATIVE_IGNOREZERO = prove + (`!f g. (!n. ~(n = 0) ==> g(n) = f(n)) /\ multiplicative f + ==> multiplicative g`, + REPEAT GEN_TAC THEN SIMP_TAC[MULTIPLICATIVE; ARITH_EQ] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MULT_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* A key "building block" theorem. *) +(* ------------------------------------------------------------------------- *) + + +let MULTIPLICATIVE_CONVOLUTION = prove + (`!f g. multiplicative f /\ multiplicative g + ==> multiplicative (\n. nsum {d | d divides n} + (\d. f(d) * g(n DIV d)))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [multiplicative] THEN + REWRITE_TAC[MULTIPLICATIVE; GSYM NSUM_LMUL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[DIVIDES_ONE; DIV_1; SING_GSPEC; NSUM_SING; MULT_CLAUSES] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + ASM_SIMP_TAC[GSYM NSUM_LMUL; NSUM_NSUM_PRODUCT; FINITE_DIVISORS] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_EQ_GENERAL THEN + EXISTS_TAC `\(a:num,b). a * b` THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_DECOMP) THEN + CONJ_TAC THENL [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a1:num`; `b1:num`; `a2:num`; `b2:num`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC COPRIME_DIVPROD THENL + (map EXISTS_TAC [`b2:num`; `b1:num`; `a2:num`; `a1:num`]) THEN + ASM_MESON_TAC[COPRIME_DIVISORS; DIVIDES_REFL; + DIVIDES_RMUL; COPRIME_SYM; MULT_SYM]; + MAP_EVERY X_GEN_TAC [`d:num`; `e:num`] THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_MUL2; MULT_SYM]; ALL_TAC] THEN + MP_TAC(REWRITE_RULE[divides] (ASSUME `(d:num) divides n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `d':num` SUBST_ALL_TAC) THEN + MP_TAC(REWRITE_RULE[divides] (ASSUME `(e:num) divides m`)) THEN + DISCH_THEN(X_CHOOSE_THEN `e':num` SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + ONCE_REWRITE_TAC[AC MULT_AC + `(e * e') * d * d':num = (d * e) * (d' * e')`] THEN + ASM_SIMP_TAC[DIV_MULT; MULT_EQ_0] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (NUMBER_RULE + `coprime(a * b,c * d) ==> coprime(c,a) /\ coprime(d,b)`)) THEN + ASM_SIMP_TAC[] THEN ARITH_TAC]);; + +let MULTIPLICATIVE_CONST = prove + (`!c. multiplicative(\n. c) <=> c = 1`, + GEN_TAC THEN REWRITE_TAC[multiplicative] THEN + ASM_CASES_TAC `c = 1` THEN ASM_REWRITE_TAC[MULT_CLAUSES]);; + +let MULTIPLICATIVE_DELTA = prove + (`multiplicative(\n. if n = 1 then 1 else 0)`, + REWRITE_TAC[MULTIPLICATIVE; MULT_EQ_1] THEN ARITH_TAC);; + +let MULTIPLICATIVE_DIVISORSUM = prove + (`!f. multiplicative f ==> multiplicative (\n. nsum {d | d divides n} f)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->num`; `\n:num. 1`] MULTIPLICATIVE_CONVOLUTION) THEN + ASM_REWRITE_TAC[MULT_CLAUSES; MULTIPLICATIVE_CONST; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Some particular multiplicative functions. *) +(* ------------------------------------------------------------------------- *) + +let MULTIPLICATIVE_ID = prove + (`multiplicative(\n. n)`, + REWRITE_TAC[multiplicative]);; + +let MULTIPLICATIVE_POWERSUM = prove + (`!k. multiplicative(\n. nsum {d | d divides n} (\d. d EXP k))`, + GEN_TAC THEN MATCH_MP_TAC MULTIPLICATIVE_DIVISORSUM THEN + REWRITE_TAC[MULTIPLICATIVE; EXP_ONE; MULT_EXP]);; + +let sigma = new_definition + `sigma(n) = if n = 0 then 0 else nsum {d | d divides n} (\i. i)`;; + +let tau = new_definition + `tau(n) = if n = 0 then 0 else CARD {d | d divides n}`;; + +let MULTIPLICATIVE_SIGMA = prove + (`multiplicative(sigma)`, + MP_TAC(SPEC `1` MULTIPLICATIVE_POWERSUM) THEN + MATCH_MP_TAC(REWRITE_RULE[GSYM IMP_IMP] MULTIPLICATIVE_IGNOREZERO) THEN + SIMP_TAC[sigma; EXP_1]);; + +let MULTIPLICATIVE_TAU = prove + (`multiplicative(tau)`, + MP_TAC(SPEC `0` MULTIPLICATIVE_POWERSUM) THEN + MATCH_MP_TAC(REWRITE_RULE[GSYM IMP_IMP] MULTIPLICATIVE_IGNOREZERO) THEN + SIMP_TAC[tau; EXP; NSUM_CONST; MULT_CLAUSES; FINITE_DIVISORS]);; + +let MULTIPLICATIVE_PHI = prove + (`multiplicative(phi)`, + REWRITE_TAC[multiplicative; PHI_MULTIPLICATIVE; PHI_1]);; + +let MULTIPLICATIVE_GCD = prove + (`!n. multiplicative(\m. gcd(n,m))`, + REWRITE_TAC[multiplicative; ONCE_REWRITE_RULE[GCD_SYM] GCD_1] THEN + ONCE_REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN NUMBER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Uniqueness of multiplicative functions if equal on prime powers. *) +(* ------------------------------------------------------------------------- *) + +let MULTIPLICATIVE_UNIQUE = prove + (`!f g. multiplicative f /\ multiplicative g /\ + (!p k. prime p ==> f(p EXP k) = g(p EXP k)) + ==> !n. ~(n = 0) ==> f n = g n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> n = 1 \/ 1 < n`)) + THENL [ASM_MESON_TAC[multiplicative]; ALL_TAC] THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN + ASM_MESON_TAC[multiplicative]);; + +(* ------------------------------------------------------------------------- *) +(* Derive the divisor-sum identity for phi from this. *) +(* ------------------------------------------------------------------------- *) + +let PHI_DIVISORSUM = prove + (`!n. ~(n = 0) ==> nsum {d | d divides n} (\d. phi(d)) = n`, + MATCH_MP_TAC MULTIPLICATIVE_UNIQUE THEN REWRITE_TAC[MULTIPLICATIVE_ID] THEN + SIMP_TAC[MULTIPLICATIVE_DIVISORSUM; ETA_AX; MULTIPLICATIVE_PHI] THEN + SIMP_TAC[DIVIDES_PRIMEPOW; SET_RULE + `{d | ?i. i <= k /\ d = p EXP i} = IMAGE (\i. p EXP i) {i | i <= k}`] THEN + SIMP_TAC[NSUM_IMAGE; EQ_PRIMEPOW; o_DEF; PHI_PRIMEPOW] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[LE; NOT_SUC] THEN + REWRITE_TAC[CONJUNCT1 EXP; SET_RULE `{x | x = 0} = {0}`; NSUM_SING] THEN + REWRITE_TAC[SET_RULE `{i | i = a \/ i <= b} = a INSERT {i | i <= b}`] THEN + ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_NUMSEG_LE; NOT_SUC] THEN + REWRITE_TAC[IN_ELIM_THM; SUC_SUB1; ARITH_RULE `~(SUC k <= k)`] THEN + MATCH_MP_TAC(ARITH_RULE `a:num <= b ==> b - a + a = b`) THEN + ASM_SIMP_TAC[LE_EXP; PRIME_IMP_NZ] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Now the real analog. *) +(* ------------------------------------------------------------------------- *) + +let real_multiplicative = new_definition + `real_multiplicative (f:num->real) <=> + f(1) = &1 /\ !m n. coprime(m,n) ==> f(m * n) = f(m) * f(n)`;; + +let REAL_MULTIPLICATIVE = prove + (`real_multiplicative f <=> + f(1) = &1 /\ + !m n. ~(m = 0) /\ ~(n = 0) /\ coprime(m,n) ==> f(m * n) = f(m) * f(n)`, + REWRITE_TAC[real_multiplicative] THEN EQ_TAC THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_SIMP_TAC[COPRIME_0; MULT_CLAUSES; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_CASES_TAC `m = 0` THEN + ASM_SIMP_TAC[COPRIME_0; MULT_CLAUSES; REAL_MUL_RID] THEN + ASM_MESON_TAC[COPRIME_SYM; COPRIME_0; DIVIDES_ONE; MULT_CLAUSES]);; + +let REAL_MULTIPLICATIVE_CONST = prove + (`!c. real_multiplicative(\n. c) <=> c = &1`, + GEN_TAC THEN REWRITE_TAC[real_multiplicative] THEN + ASM_CASES_TAC `c:real = &1` THEN ASM_REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_MULTIPLICATIVE_DELTA = prove + (`real_multiplicative(\n. if n = 1 then &1 else &0)`, + REWRITE_TAC[REAL_MULTIPLICATIVE; MULT_EQ_1] THEN REAL_ARITH_TAC);; + +let REAL_MULTIPLICATIVE_IGNOREZERO = prove + (`!f g. (!n. ~(n = 0) ==> g(n) = f(n)) /\ real_multiplicative f + ==> real_multiplicative g`, + REPEAT GEN_TAC THEN SIMP_TAC[REAL_MULTIPLICATIVE; ARITH_EQ] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[MULT_EQ_0]);; + +let REAL_MULTIPLICATIVE_CONVOLUTION = prove + (`!f g. real_multiplicative f /\ real_multiplicative g + ==> real_multiplicative (\n. sum {d | d divides n} + (\d. f(d) * g(n DIV d)))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [real_multiplicative] THEN + REWRITE_TAC[REAL_MULTIPLICATIVE; GSYM SUM_LMUL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[DIVIDES_ONE; DIV_1; SING_GSPEC; SUM_SING; REAL_MUL_LID] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM SUM_LMUL; SUM_SUM_PRODUCT; FINITE_DIVISORS] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN + EXISTS_TAC `\(a:num,b). a * b` THEN REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_DECOMP) THEN + CONJ_TAC THENL [ASM_MESON_TAC[MULT_SYM]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a1:num`; `b1:num`; `a2:num`; `b2:num`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC COPRIME_DIVPROD THENL + (map EXISTS_TAC [`b2:num`; `b1:num`; `a2:num`; `a1:num`]) THEN + ASM_MESON_TAC[COPRIME_DIVISORS; DIVIDES_REFL; + DIVIDES_RMUL; COPRIME_SYM; MULT_SYM]; + MAP_EVERY X_GEN_TAC [`d:num`; `e:num`] THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_MUL2; MULT_SYM]; ALL_TAC] THEN + MP_TAC(REWRITE_RULE[divides] (ASSUME `(d:num) divides n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `d':num` SUBST_ALL_TAC) THEN + MP_TAC(REWRITE_RULE[divides] (ASSUME `(e:num) divides m`)) THEN + DISCH_THEN(X_CHOOSE_THEN `e':num` SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + ONCE_REWRITE_TAC[AC MULT_AC + `(e * e') * d * d':num = (d * e) * (d' * e')`] THEN + ASM_SIMP_TAC[DIV_MULT; MULT_EQ_0] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (NUMBER_RULE + `coprime(a * b,c * d) ==> coprime(c,a) /\ coprime(d,b)`)) THEN + ASM_SIMP_TAC[] THEN REAL_ARITH_TAC]);; + +let REAL_MULTIPLICATIVE_DIVISORSUM = prove + (`!f. real_multiplicative f + ==> real_multiplicative (\n. sum {d | d divides n} f)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real`; `(\n. &1):num->real`] + REAL_MULTIPLICATIVE_CONVOLUTION) THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MULTIPLICATIVE_CONST; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* The Mobius function (into the reals). *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let mobius = new_definition + `mobius(n) = if ?p. prime p /\ (p EXP 2) divides n then &0 + else --(&1) pow CARD {p | prime p /\ p divides n}`;; + +let MOBIUS_0 = prove + (`mobius 0 = &0`, + REWRITE_TAC[mobius] THEN MP_TAC(SPEC `2 EXP 2` DIVIDES_0) THEN + MESON_TAC[PRIME_2]);; + +let MOBIUS_1 = prove + (`mobius 1 = &1`, + REWRITE_TAC[mobius; DIVIDES_ONE; EXP_EQ_1; ARITH] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + SUBGOAL_THEN `{p | prime p /\ p = 1} = {}` + (fun th -> SIMP_TAC[th; CARD_CLAUSES; real_pow]) THEN SET_TAC[PRIME_1]);; + +let REAL_ABS_MOBIUS = prove + (`!n. abs(mobius n) <= &1`, + GEN_TAC THEN REWRITE_TAC[mobius] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_ABS_NUM] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let MOBIUS_MULT = prove + (`!a b. coprime(a,b) ==> mobius(a * b) = mobius a * mobius b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mobius] THEN + ASM_CASES_TAC `?p. prime p /\ (p EXP 2) divides a` THENL + [ASM_CASES_TAC `?p. prime p /\ p EXP 2 divides (a * b)` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_MESON_TAC[DIVIDES_RMUL]; + ALL_TAC] THEN + ASM_CASES_TAC `?p. prime p /\ (p EXP 2) divides b` THENL + [ASM_CASES_TAC `?p. prime p /\ p EXP 2 divides (a * b)` THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_MESON_TAC[DIVIDES_LMUL]; + ALL_TAC] THEN + ASM_CASES_TAC `?p. prime p /\ p EXP 2 divides (a * b)` THENL + [ASM_MESON_TAC[PRIME_DIVPROD_POW]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_POW_ADD] THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN + ASM_CASES_TAC `a = 0` THENL [ASM_MESON_TAC[PRIME_2; DIVIDES_0]; ALL_TAC] THEN + ASM_CASES_TAC `b = 0` THENL [ASM_MESON_TAC[PRIME_2; DIVIDES_0]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{p | p divides a * b}` THEN + ASM_SIMP_TAC[FINITE_DIVISORS; MULT_EQ_0] THEN SET_TAC[]; + SIMP_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_UNION; AND_FORALL_THM] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN + UNDISCH_TAC `~(?p. prime p /\ p EXP 2 divides a * b)` THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN + ASM_CASES_TAC `prime p` THEN ASM_SIMP_TAC[PRIME_DIVPROD_EQ] THEN + REWRITE_TAC[CONTRAPOS_THM; EXP_2] THEN CONV_TAC NUMBER_RULE]);; + +let REAL_MULTIPLICATIVE_MOBIUS = prove + (`real_multiplicative mobius`, + SIMP_TAC[real_multiplicative; MOBIUS_1; MOBIUS_MULT]);; + +let MOBIUS_PRIME = prove + (`!p. prime p ==> mobius(p) = -- &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mobius] THEN COND_CASES_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC + (MATCH_MP(NUMBER_RULE `q EXP 2 divides p ==> q divides p`) th)) THEN + SUBGOAL_THEN `q:num = p` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[DIVIDES_PRIME_PRIME]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + REWRITE_TAC[ARITH_RULE `p EXP 2 <= p <=> p * p <= 1 * p`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; + SUBGOAL_THEN `{q | prime q /\ q divides p} = {p}` SUBST1_TAC THENL + [ASM SET_TAC[DIVIDES_PRIME_PRIME]; ALL_TAC] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ARITH; REAL_POW_1]]);; + +let MOBIUS_PRIMEPOW = prove + (`!p k. prime p ==> mobius(p EXP k) = if k = 0 then &1 + else if k = 1 then -- &1 + else &0`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[EXP; MOBIUS_1] THEN + ASM_CASES_TAC `k = 1` THEN ASM_SIMP_TAC[EXP_1; MOBIUS_PRIME] THEN + REWRITE_TAC[mobius] THEN + SUBGOAL_THEN `?q. prime q /\ q EXP 2 divides p EXP k` + (fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC `p:num` THEN ASM_SIMP_TAC[DIVIDES_PRIME_EXP_LE] THEN + ASM_ARITH_TAC);; + +let DIVISORSUM_MOBIUS = prove + (`!n. 1 <= n + ==> sum {d | d divides n} (\d. mobius d) = if n = 1 then &1 else &0`, + REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 1 < n`] THEN + REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[DIVIDES_ONE; SET_RULE `{x | x = a} = {a}`; SUM_SING; MOBIUS_1] THEN + SIMP_TAC[ARITH_RULE `1 < n ==> ~(n = 1)`] THEN + MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN CONJ_TAC THENL + [MP_TAC(MATCH_MP REAL_MULTIPLICATIVE_DIVISORSUM + REAL_MULTIPLICATIVE_MOBIUS) THEN + SIMP_TAC[real_multiplicative; ETA_AX; REAL_MUL_LZERO]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum {1,p} (\d. mobius d)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; IN_SING; + MOBIUS_PRIME; MOBIUS_1; REAL_ADD_RID; REAL_ADD_RINV] THEN + ASM_MESON_TAC[PRIME_1]] THEN + MATCH_MP_TAC SUM_SUPERSET THEN ASM_SIMP_TAC[DIVIDES_PRIMEPOW] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[EXP; LE_0]; + ASM_MESON_TAC[EXP_1; LE_1]; + ASM_SIMP_TAC[MOBIUS_PRIMEPOW] THEN ASM_MESON_TAC[EXP; EXP_1]]);; + +let MOBIUS_INVERSION = prove + (`!f g. (!n. 1 <= n ==> g(n) = sum {d | d divides n} f) + ==> !n. 1 <= n + ==> f(n) = sum {d | d divides n} (\d. mobius(d) * g(n DIV d))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!d. d divides n ==> ~(n DIV d = 0)` ASSUME_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `d = 0` THEN + ASM_SIMP_TAC[DIVIDES_ZERO; LE_1] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_SIMP_TAC[LE_1; NOT_LT; DIV_EQ_0]; + ALL_TAC] THEN + ASM_SIMP_TAC[LE_1] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {d | d divides n} (\d. f(d) * (if n DIV d = 1 then &1 else &0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {n} (\d. f(d) * (if n DIV d = 1 then &1 else &0))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SUM_SING; DIV_REFL; LE_1; REAL_MUL_RID]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[SUBSET; IN_SING; IN_ELIM_THM; DIVIDES_REFL] THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[DIVIDES_DIV_MULT] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; REAL_MUL_RZERO]; + ASM_SIMP_TAC[GSYM DIVISORSUM_MOBIUS; LE_1] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + ASM_SIMP_TAC[SUM_SUM_PRODUCT; FINITE_DIVISORS; LE_1; IN_ELIM_THM] THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC `\(m:num,n:num). (n,m)`) THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + CONJ_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_MESON_TAC[DIVIDES_DIVIDES_DIV; MULT_SYM; + NUMBER_RULE `(a * b) divides c ==> b divides c`]]);; diff --git a/Library/permutations.ml b/Library/permutations.ml new file mode 100644 index 0000000..5718545 --- /dev/null +++ b/Library/permutations.ml @@ -0,0 +1,831 @@ +(* ========================================================================= *) +(* Permutations, both general and specifically on finite sets. *) +(* ========================================================================= *) + +parse_as_infix("permutes",(12,"right"));; + +let permutes = new_definition + `p permutes s <=> (!x. ~(x IN s) ==> p(x) = x) /\ (!y. ?!x. p x = y)`;; + +(* ------------------------------------------------------------------------- *) +(* Inverse function (on whole universe). *) +(* ------------------------------------------------------------------------- *) + +let inverse = new_definition + `inverse(f) = \y. @x. f x = y`;; + +let SURJECTIVE_INVERSE = prove + (`!f. (!y. ?x. f x = y) <=> !y. f(inverse f y) = y`, + REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE; inverse] THEN MESON_TAC[]);; + +let SURJECTIVE_INVERSE_o = prove + (`!f. (!y. ?x. f x = y) <=> (f o inverse f = I)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; SURJECTIVE_INVERSE]);; + +let INJECTIVE_INVERSE = prove + (`!f. (!x x'. f x = f x' ==> x = x') <=> !x. inverse f (f x) = x`, + MESON_TAC[inverse]);; + +let INJECTIVE_INVERSE_o = prove + (`!f. (!x x'. f x = f x' ==> x = x') <=> (inverse f o f = I)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; INJECTIVE_INVERSE]);; + +let INVERSE_UNIQUE_o = prove + (`!f g. f o g = I /\ g o f = I ==> inverse f = g`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + MESON_TAC[INJECTIVE_INVERSE; SURJECTIVE_INVERSE]);; + +let INVERSE_I = prove + (`inverse I = I`, + MATCH_MP_TAC INVERSE_UNIQUE_o THEN REWRITE_TAC[I_O_ID]);; + +(* ------------------------------------------------------------------------- *) +(* Transpositions. *) +(* ------------------------------------------------------------------------- *) + +let swap = new_definition + `swap(i,j) k = if k = i then j else if k = j then i else k`;; + +let SWAP_REFL = prove + (`!a. swap(a,a) = I`, + REWRITE_TAC[FUN_EQ_THM; swap; I_THM] THEN MESON_TAC[]);; + +let SWAP_SYM = prove + (`!a b. swap(a,b) = swap(b,a)`, + REWRITE_TAC[FUN_EQ_THM; swap; I_THM] THEN MESON_TAC[]);; + +let SWAP_IDEMPOTENT = prove + (`!a b. swap(a,b) o swap(a,b) = I`, + REWRITE_TAC[FUN_EQ_THM; swap; o_THM; I_THM] THEN MESON_TAC[]);; + +let INVERSE_SWAP = prove + (`!a b. inverse(swap(a,b)) = swap(a,b)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC INVERSE_UNIQUE_o THEN + REWRITE_TAC[SWAP_SYM; SWAP_IDEMPOTENT]);; + +let SWAP_GALOIS = prove + (`!a b x y. x = swap(a,b) y <=> y = swap(a,b) x`, + REWRITE_TAC[swap] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Basic consequences of the definition. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_IN_IMAGE = prove + (`!p s x. p permutes s ==> (p(x) IN s <=> x IN s)`, + REWRITE_TAC[permutes] THEN MESON_TAC[]);; + +let PERMUTES_IMAGE = prove + (`!p s. p permutes s ==> IMAGE p s = s`, + REWRITE_TAC[permutes; EXTENSION; IN_IMAGE] THEN MESON_TAC[]);; + +let PERMUTES_INJECTIVE = prove + (`!p s. p permutes s ==> !x y. p(x) = p(y) <=> x = y`, + REWRITE_TAC[permutes] THEN MESON_TAC[]);; + +let PERMUTES_SURJECTIVE = prove + (`!p s. p permutes s ==> !y. ?x. p(x) = y`, + REWRITE_TAC[permutes] THEN MESON_TAC[]);; + +let PERMUTES_INVERSES_o = prove + (`!p s. p permutes s ==> p o inverse(p) = I /\ inverse(p) o p = I`, + REWRITE_TAC[GSYM INJECTIVE_INVERSE_o; GSYM SURJECTIVE_INVERSE_o] THEN + REWRITE_TAC[permutes] THEN MESON_TAC[]);; + +let PERMUTES_INVERSES = prove + (`!p s. p permutes s + ==> (!x. p(inverse p x) = x) /\ (!x. inverse p (p x) = x)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; + +let PERMUTES_SUBSET = prove + (`!p s t. p permutes s /\ s SUBSET t ==> p permutes t`, + REWRITE_TAC[permutes; SUBSET] THEN MESON_TAC[]);; + +let PERMUTES_EMPTY = prove + (`!p. p permutes {} <=> p = I`, + REWRITE_TAC[FUN_EQ_THM; I_THM; permutes; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let PERMUTES_SING = prove + (`!p a. p permutes {a} <=> p = I`, + REWRITE_TAC[FUN_EQ_THM; I_THM; permutes; IN_SING] THEN MESON_TAC[]);; + +let PERMUTES_UNIV = prove + (`!p. p permutes UNIV <=> !y:A. ?!x. p x = y`, + REWRITE_TAC[permutes; IN_UNIV] THEN MESON_TAC[]);; + +let PERMUTES_INVERSE_EQ = prove + (`!p s. p permutes s ==> !x y. inverse p y = x <=> p x = y`, + REWRITE_TAC[permutes; inverse] THEN MESON_TAC[]);; + +let PERMUTES_SWAP = prove + (`!a b s. a IN s /\ b IN s ==> swap(a,b) permutes s`, + REWRITE_TAC[permutes; swap] THEN MESON_TAC[]);; + +let PERMUTES_SUPERSET = prove + (`!p s t. p permutes s /\ (!x. x IN (s DIFF t) ==> p(x) = x) + ==> p permutes t`, + REWRITE_TAC[permutes; IN_DIFF] THEN MESON_TAC[]);; + +let PERMUTES_BIJECTIONS = prove + (`!p q. (!x. x IN s ==> p x IN s) /\ (!x. ~(x IN s) ==> p x = x) /\ + (!x. x IN s ==> q x IN s) /\ (!x. ~(x IN s) ==> q x = x) /\ + (!x. p(q x) = x) /\ (!x. q(p x) = x) + ==> p permutes s`, + REWRITE_TAC[permutes] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Group properties. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_I = prove + (`!s. I permutes s`, + REWRITE_TAC[permutes; I_THM] THEN MESON_TAC[]);; + +let PERMUTES_COMPOSE = prove + (`!p q s. p permutes s /\ q permutes s ==> (q o p) permutes s`, + REWRITE_TAC[permutes; o_THM] THEN MESON_TAC[]);; + +let PERMUTES_INVERSE = prove + (`!p s. p permutes s ==> inverse(p) permutes s`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_INVERSE_EQ) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[permutes] THEN MESON_TAC[]);; + +let PERMUTES_INVERSE_INVERSE = prove + (`!p. p permutes s ==> inverse(inverse p) = p`, + SIMP_TAC[FUN_EQ_THM] THEN MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE]);; + +(* ------------------------------------------------------------------------- *) +(* The number of permutations on a finite set. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_INSERT_LEMMA = prove + (`!p a:A s. p permutes (a INSERT s) ==> (swap(a,p(a)) o p) permutes s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PERMUTES_SUPERSET THEN + EXISTS_TAC `(a:A) INSERT s` THEN CONJ_TAC THENL + [ASM_MESON_TAC[PERMUTES_SWAP; PERMUTES_IN_IMAGE; + IN_INSERT; PERMUTES_COMPOSE]; + REWRITE_TAC[o_THM; swap; IN_INSERT; IN_DIFF] THEN ASM_MESON_TAC[]]);; + +let PERMUTES_INSERT = prove + (`{p:A->A | p permutes (a INSERT s)} = + IMAGE (\(b,p). swap(a,b) o p) + {(b,p) | b IN a INSERT s /\ p IN {p | p permutes s}}`, + REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN + X_GEN_TAC `p:A->A` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN EQ_TAC THENL + [DISCH_TAC THEN MAP_EVERY EXISTS_TAC + [`(p:A->A) a`; `swap(a,p a) o (p:A->A)`] THEN + ASM_SIMP_TAC[SWAP_IDEMPOTENT; o_ASSOC; I_O_ID; PERMUTES_INSERT_LEMMA] THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_INSERT]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`b:A`; `q:A->A`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PERMUTES_COMPOSE THEN + CONJ_TAC THENL + [ASM_MESON_TAC[PERMUTES_SUBSET; SUBSET; IN_INSERT]; + MATCH_MP_TAC PERMUTES_SWAP THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_INSERT]]]);; + +let HAS_SIZE_PERMUTATIONS = prove + (`!s:A->bool n. s HAS_SIZE n ==> {p | p permutes s} HAS_SIZE (FACT n)`, + REWRITE_TAC[HAS_SIZE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PERMUTES_EMPTY; CARD_CLAUSES; SET_RULE `{x | x = a} = {a}`] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN REWRITE_TAC[GSYM HAS_SIZE] THEN + STRIP_TAC THEN X_GEN_TAC `k:num` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + REWRITE_TAC[FACT; PERMUTES_INSERT] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + ASM_SIMP_TAC[HAS_SIZE_PRODUCT; HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM; PAIR_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + MAP_EVERY X_GEN_TAC [`b:A`; `q:A->A`; `c:A`; `r:A->A`] THEN + STRIP_TAC THEN SUBGOAL_THEN `c:A = b` SUBST_ALL_TAC THENL + [FIRST_X_ASSUM(MP_TAC o C AP_THM `a:A`) THEN REWRITE_TAC[o_THM; swap] THEN + SUBGOAL_THEN `(q:A->A) a = a /\ (r:A->A) a = a` (fun t -> SIMP_TAC[t]) THEN + ASM_MESON_TAC[permutes]; + FIRST_X_ASSUM(MP_TAC o AP_TERM `(\q:A->A. swap(a:A,b) o q)`) THEN + ASM_SIMP_TAC[SWAP_IDEMPOTENT; o_ASSOC; I_O_ID]]);; + +let FINITE_PERMUTATIONS = prove + (`!s. FINITE s ==> FINITE {p | p permutes s}`, + MESON_TAC[HAS_SIZE_PERMUTATIONS; HAS_SIZE]);; + +let CARD_PERMUTATIONS = prove + (`!s. FINITE s ==> CARD {p | p permutes s} = FACT(CARD s)`, + MESON_TAC[HAS_SIZE; HAS_SIZE_PERMUTATIONS]);; + +(* ------------------------------------------------------------------------- *) +(* Alternative characterizations of permutation of finite set. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_FINITE_INJECTIVE = prove + (`!s:A->bool p. + FINITE s + ==> (p permutes s <=> + (!x. ~(x IN s) ==> p x = x) /\ + (!x. x IN s ==> p x IN s) /\ + (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y))`, + REWRITE_TAC[permutes] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN + DISCH_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `p:A->A` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SURJECTIVE_IFF_INJECTIVE)) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IMP_IMP; GSYM CONJ_ASSOC] THEN + STRIP_TAC THEN X_GEN_TAC `y:A` THEN + ASM_CASES_TAC `(y:A) IN s` THEN ASM_MESON_TAC[]);; + +let PERMUTES_FINITE_SURJECTIVE = prove + (`!s:A->bool p. + FINITE s + ==> (p permutes s <=> + (!x. ~(x IN s) ==> p x = x) /\ (!x. x IN s ==> p x IN s) /\ + (!y. y IN s ==> ?x. x IN s /\ p x = y))`, + REWRITE_TAC[permutes] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN + DISCH_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `p:A->A` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SURJECTIVE_IFF_INJECTIVE)) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IMP_IMP; GSYM CONJ_ASSOC] THEN + STRIP_TAC THEN X_GEN_TAC `y:A` THEN + ASM_CASES_TAC `(y:A) IN s` THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Permutations of index set for iterated operations. *) +(* ------------------------------------------------------------------------- *) + +let ITERATE_PERMUTE = prove + (`!op. monoidal op + ==> !f p s. p permutes s ==> iterate op s f = iterate op s (f o p)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_BIJECTION) THEN + ASM_MESON_TAC[permutes]);; + +let NSUM_PERMUTE = prove + (`!f p s. p permutes s ==> nsum s f = nsum s (f o p)`, + REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_PERMUTE THEN + REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_PERMUTE_NUMSEG = prove + (`!f p m n. p permutes m..n ==> nsum(m..n) f = nsum(m..n) (f o p)`, + MESON_TAC[NSUM_PERMUTE; FINITE_NUMSEG]);; + +let SUM_PERMUTE = prove + (`!f p s. p permutes s ==> sum s f = sum s (f o p)`, + REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_PERMUTE THEN + REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_PERMUTE_NUMSEG = prove + (`!f p m n. p permutes m..n ==> sum(m..n) f = sum(m..n) (f o p)`, + MESON_TAC[SUM_PERMUTE; FINITE_NUMSEG]);; + +(* ------------------------------------------------------------------------- *) +(* Various combinations of transpositions with 2, 1 and 0 common elements. *) +(* ------------------------------------------------------------------------- *) + +let SWAP_COMMON = prove + (`!a b c:A. ~(a = c) /\ ~(b = c) + ==> swap(a,b) o swap(a,c) = swap(b,c) o swap(a,b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; swap; o_THM; I_THM] THEN + DISCH_TAC THEN X_GEN_TAC `x:A` THEN + MAP_EVERY ASM_CASES_TAC [`x:A = a`; `x:A = b`; `x:A = c`] THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +let SWAP_COMMON' = prove + (`!a b c:A. ~(a = b) /\ ~(a = c) + ==> swap(a,c) o swap(b,c) = swap(b,c) o swap(a,b)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SWAP_SYM] THEN + ASM_SIMP_TAC[GSYM SWAP_COMMON] THEN REWRITE_TAC[SWAP_SYM]);; + +let SWAP_INDEPENDENT = prove + (`!a b c d:A. ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d) + ==> swap(a,b) o swap(c,d) = swap(c,d) o swap(a,b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; swap; o_THM; I_THM] THEN + DISCH_TAC THEN X_GEN_TAC `x:A` THEN + MAP_EVERY ASM_CASES_TAC [`x:A = a`; `x:A = b`; `x:A = c`] THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Permutations as transposition sequences. *) +(* ------------------------------------------------------------------------- *) + +let swapseq_RULES,swapseq_INDUCT,swapseq_CASES = new_inductive_definition + `(swapseq 0 I) /\ + (!a b p n. swapseq n p /\ ~(a = b) ==> swapseq (SUC n) (swap(a,b) o p))`;; + +let permutation = new_definition + `permutation p <=> ?n. swapseq n p`;; + +(* ------------------------------------------------------------------------- *) +(* Some closure properties of the set of permutations, with lengths. *) +(* ------------------------------------------------------------------------- *) + +let SWAPSEQ_I = CONJUNCT1 swapseq_RULES;; + +let PERMUTATION_I = prove + (`permutation I`, + REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_I]);; + +let SWAPSEQ_SWAP = prove + (`!a b. swapseq (if a = b then 0 else 1) (swap(a,b))`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[num_CONV `1`] THEN + ASM_MESON_TAC[swapseq_RULES; I_O_ID; SWAPSEQ_I; SWAP_REFL]);; + +let PERMUTATION_SWAP = prove + (`!a b. permutation(swap(a,b))`, + REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_SWAP]);; + +let SWAPSEQ_COMPOSE = prove + (`!n p m q. swapseq n p /\ swapseq m q ==> swapseq (n + m) (p o q)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC swapseq_INDUCT THEN + REWRITE_TAC[ADD_CLAUSES; I_O_ID; GSYM o_ASSOC] THEN + MESON_TAC[swapseq_RULES]);; + +let PERMUTATION_COMPOSE = prove + (`!p q. permutation p /\ permutation q ==> permutation(p o q)`, + REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_COMPOSE]);; + +let SWAPSEQ_ENDSWAP = prove + (`!n p a b:A. swapseq n p /\ ~(a = b) ==> swapseq (SUC n) (p o swap(a,b))`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC swapseq_INDUCT THEN REWRITE_TAC[I_O_ID; GSYM o_ASSOC] THEN + MESON_TAC[o_ASSOC; swapseq_RULES; I_O_ID]);; + +let SWAPSEQ_INVERSE_EXISTS = prove + (`!n p:A->A. swapseq n p ==> ?q. swapseq n q /\ p o q = I /\ q o p = I`, + MATCH_MP_TAC swapseq_INDUCT THEN CONJ_TAC THENL + [MESON_TAC[I_O_ID; swapseq_RULES]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `q:A->A`; `a:A`; `b:A`] SWAPSEQ_ENDSWAP) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + EXISTS_TAC `(q:A->A) o swap (a,b)` THEN + ASM_REWRITE_TAC[GSYM o_ASSOC] THEN + GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o RAND_CONV) [o_ASSOC] THEN + ASM_REWRITE_TAC[SWAP_IDEMPOTENT; I_O_ID]);; + +let SWAPSEQ_INVERSE = prove + (`!n p. swapseq n p ==> swapseq n (inverse p)`, + MESON_TAC[SWAPSEQ_INVERSE_EXISTS; INVERSE_UNIQUE_o]);; + +let PERMUTATION_INVERSE = prove + (`!p. permutation p ==> permutation(inverse p)`, + REWRITE_TAC[permutation] THEN MESON_TAC[SWAPSEQ_INVERSE]);; + +(* ------------------------------------------------------------------------- *) +(* The identity map only has even transposition sequences. *) +(* ------------------------------------------------------------------------- *) + +let SYMMETRY_LEMMA = prove + (`(!a b c d. P a b c d ==> P a b d c) /\ + (!a b c d. ~(a = b) /\ ~(c = d) /\ + (a = c /\ b = d \/ a = c /\ ~(b = d) \/ ~(a = c) /\ b = d \/ + ~(a = c) /\ ~(a = d) /\ ~(b = c) /\ ~(b = d)) + ==> P a b c d) + ==> (!a b c d:A. ~(a = b) /\ ~(c = d) ==> P a b c d)`, + REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC + [`a:A = c`; `a:A = d`; `b:A = c`; `b:A = d`] THEN + ASM_MESON_TAC[]);; + +let SWAP_GENERAL = prove + (`!a b c d:A. + ~(a = b) /\ ~(c = d) + ==> swap(a,b) o swap(c,d) = I \/ + ?x y z. ~(x = a) /\ ~(y = a) /\ ~(z = a) /\ ~(x = y) /\ + swap(a,b) o swap(c,d) = swap(x,y) o swap(a,z)`, + MATCH_MP_TAC SYMMETRY_LEMMA THEN CONJ_TAC THENL + [REWRITE_TAC[SWAP_SYM] THEN SIMP_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THENL + [MESON_TAC[SWAP_IDEMPOTENT]; + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`b:A`; `d:A`; `b:A`] THEN + ASM_MESON_TAC[SWAP_COMMON]; + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:A`; `d:A`; `c:A`] THEN + ASM_MESON_TAC[SWAP_COMMON']; + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`c:A`; `d:A`; `b:A`] THEN + ASM_MESON_TAC[SWAP_INDEPENDENT]]);; + +let FIXING_SWAPSEQ_DECREASE = prove + (`!n p a b:A. + swapseq n p /\ ~(a = b) /\ (swap(a,b) o p) a = a + ==> ~(n = 0) /\ swapseq (n - 1) (swap(a,b) o p)`, + INDUCT_TAC THEN REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [swapseq_CASES] THEN + REWRITE_TAC[NOT_SUC] THENL + [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[I_THM; o_THM; swap] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:A`; `d:A`; `q:A->A`; `m:num`] THEN + REWRITE_TAC[SUC_INJ; GSYM CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[o_ASSOC] THEN STRIP_TAC THEN + MP_TAC(SPECL [`a:A`; `b:A`; `c:A`; `d:A`] SWAP_GENERAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC MP_TAC) THEN + ASM_REWRITE_TAC[I_O_ID; SUC_SUB1; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`; `z:A`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`q:A->A`; `a:A`; `z:A`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check(is_eq o concl)) THEN + REWRITE_TAC[GSYM o_ASSOC] THEN + ABBREV_TAC `r:A->A = swap(a:A,z) o q` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; swap] THEN ASM_MESON_TAC[]; + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[NOT_SUC; SUC_SUB1; GSYM o_ASSOC] THEN + ASM_MESON_TAC[swapseq_RULES]]);; + +let SWAPSEQ_IDENTITY_EVEN = prove + (`!n. swapseq n (I:A->A) ==> EVEN n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [swapseq_CASES] THEN + DISCH_THEN(DISJ_CASES_THEN2 (SUBST_ALL_TAC o CONJUNCT1) MP_TAC) THEN + REWRITE_TAC[EVEN; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`; `p:A->A`; `m:num`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + MP_TAC(SPECL [`m:num`; `p:A->A`; `a:A`; `b:A`] FIXING_SWAPSEQ_DECREASE) THEN + ASM_REWRITE_TAC[I_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m - 1`) THEN + UNDISCH_THEN `SUC m = n` (SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[ARITH_RULE `m - 1 < SUC m`] THEN UNDISCH_TAC `~(m = 0)` THEN + SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[SUC_SUB1; EVEN]);; + +(* ------------------------------------------------------------------------- *) +(* Therefore we have a welldefined notion of parity. *) +(* ------------------------------------------------------------------------- *) + +let evenperm = new_definition `evenperm(p) = EVEN(@n. swapseq n p)`;; + +let SWAPSEQ_EVEN_EVEN = prove + (`!m n p:A->A. swapseq m p /\ swapseq n p ==> (EVEN m <=> EVEN n)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP SWAPSEQ_INVERSE_EXISTS) THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `swapseq (n + m) :(A->A)->bool`) THEN + ASM_SIMP_TAC[SWAPSEQ_COMPOSE] THEN + DISCH_THEN(MP_TAC o MATCH_MP SWAPSEQ_IDENTITY_EVEN) THEN + SIMP_TAC[EVEN_ADD]);; + +let EVENPERM_UNIQUE = prove + (`!n p b. swapseq n p /\ EVEN n = b ==> evenperm p = b`, + REWRITE_TAC[evenperm] THEN MESON_TAC[SWAPSEQ_EVEN_EVEN]);; + +(* ------------------------------------------------------------------------- *) +(* And it has the expected composition properties. *) +(* ------------------------------------------------------------------------- *) + +let EVENPERM_I = prove + (`evenperm I = T`, + MATCH_MP_TAC EVENPERM_UNIQUE THEN MESON_TAC[swapseq_RULES; EVEN]);; + +let EVENPERM_SWAP = prove + (`!a b:A. evenperm(swap(a,b)) = (a = b)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC EVENPERM_UNIQUE THEN + MESON_TAC[SWAPSEQ_SWAP; NUM_RED_CONV `EVEN 0`; NUM_RED_CONV `EVEN 1`]);; + +let EVENPERM_COMPOSE = prove + (`!p q. permutation p /\ permutation q + ==> evenperm (p o q) = (evenperm p = evenperm q)`, + REWRITE_TAC[permutation; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + ASSUME_TAC(MATCH_MP SWAPSEQ_COMPOSE th)) THEN + ASM_MESON_TAC[EVENPERM_UNIQUE; SWAPSEQ_COMPOSE; EVEN_ADD]);; + +let EVENPERM_INVERSE = prove + (`!p. permutation p ==> evenperm(inverse p) = evenperm p`, + REWRITE_TAC[permutation] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC EVENPERM_UNIQUE THEN + ASM_MESON_TAC[SWAPSEQ_INVERSE; EVENPERM_UNIQUE]);; + +(* ------------------------------------------------------------------------- *) +(* A more abstract characterization of permutations. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTATION_BIJECTIVE = prove + (`!p. permutation p ==> !y. ?!x. p(x) = y`, + REWRITE_TAC[permutation] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP SWAPSEQ_INVERSE_EXISTS) THEN + REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM; LEFT_IMP_EXISTS_THM] THEN + MESON_TAC[]);; + +let PERMUTATION_FINITE_SUPPORT = prove + (`!p. permutation p ==> FINITE {x:A | ~(p x = x)}`, + REWRITE_TAC[permutation; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC swapseq_INDUCT THEN + REWRITE_TAC[I_THM; FINITE_RULES; SET_RULE `{x | F} = {}`] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`; `p:A->A`] THEN + STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `(a:A) INSERT b INSERT {x | ~(p x = x)}` THEN + ASM_REWRITE_TAC[FINITE_INSERT; SUBSET; IN_INSERT; IN_ELIM_THM] THEN + REWRITE_TAC[o_THM; swap] THEN MESON_TAC[]);; + +let PERMUTATION_LEMMA = prove + (`!s p:A->A. + FINITE s /\ + (!y. ?!x. p(x) = y) /\ (!x. ~(x IN s) ==> p x = x) + ==> permutation p`, + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REWRITE_TAC[NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p:A->A = I` (fun th -> REWRITE_TAC[th; PERMUTATION_I]) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; I_THM]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `permutation((swap(a,p(a)) o swap(a,p(a))) o (p:A->A))` + MP_TAC THENL [ALL_TAC; REWRITE_TAC[SWAP_IDEMPOTENT; I_O_ID]] THEN + REWRITE_TAC[GSYM o_ASSOC] THEN MATCH_MP_TAC PERMUTATION_COMPOSE THEN + REWRITE_TAC[PERMUTATION_SWAP] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL + [UNDISCH_TAC `!y. ?!x. (p:A->A) x = y` THEN + REWRITE_TAC[EXISTS_UNIQUE_THM; swap; o_THM] THEN + ASM_CASES_TAC `(p:A->A) a = a` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[TAUT + `(if p then x else y) = a <=> if p then x = a else y = a`] THEN + REWRITE_TAC[TAUT `(if p then x else y) <=> p /\ x \/ ~p /\ y`] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[swap; o_THM] THEN + ASM_CASES_TAC `(p:A->A) a = a` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]);; + +let PERMUTATION = prove + (`!p. permutation p <=> (!y. ?!x. p(x) = y) /\ FINITE {x:A | ~(p(x) = x)}`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[PERMUTATION_BIJECTIVE; PERMUTATION_FINITE_SUPPORT] THEN + STRIP_TAC THEN MATCH_MP_TAC PERMUTATION_LEMMA THEN + EXISTS_TAC `{x:A | ~(p x = x)}` THEN + ASM_SIMP_TAC[IN_ELIM_THM]);; + +let PERMUTATION_INVERSE_WORKS = prove + (`!p. permutation p ==> inverse p o p = I /\ p o inverse p = I`, + MESON_TAC[PERMUTATION_BIJECTIVE; SURJECTIVE_INVERSE_o; + INJECTIVE_INVERSE_o]);; + +let PERMUTATION_INVERSE_COMPOSE = prove + (`!p q. permutation p /\ permutation q + ==> inverse(p o q) = inverse q o inverse p`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INVERSE_UNIQUE_o THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP PERMUTATION_INVERSE_WORKS)) THEN + REWRITE_TAC[GSYM o_ASSOC] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_ASSOC] THEN + ASM_REWRITE_TAC[I_O_ID]);; + +let PERMUTATION_COMPOSE_EQ = prove + (`(!p q:A->A. permutation(p) ==> (permutation(p o q) <=> permutation q)) /\ + (!p q:A->A. permutation(q) ==> (permutation(p o q) <=> permutation p))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PERMUTATION_INVERSE) THEN + EQ_TAC THEN ASM_SIMP_TAC[PERMUTATION_COMPOSE] THENL + [DISCH_THEN(MP_TAC o SPEC `inverse(p:A->A)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] PERMUTATION_COMPOSE)); + DISCH_THEN(MP_TAC o SPEC `inverse(q:A->A)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] PERMUTATION_COMPOSE))] THEN + ASM_SIMP_TAC[GSYM o_ASSOC; PERMUTATION_INVERSE_WORKS] THEN + ASM_SIMP_TAC[o_ASSOC; PERMUTATION_INVERSE_WORKS] THEN + REWRITE_TAC[I_O_ID]);; + +let PERMUTATION_COMPOSE_SWAP = prove + (`(!p a b:A. permutation(swap(a,b) o p) <=> permutation p) /\ + (!p a b:A. permutation(p o swap(a,b)) <=> permutation p)`, + SIMP_TAC[PERMUTATION_COMPOSE_EQ; PERMUTATION_SWAP]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to "permutes". *) +(* ------------------------------------------------------------------------- *) + +let PERMUTATION_PERMUTES = prove + (`!p:A->A. permutation p <=> ?s. FINITE s /\ p permutes s`, + GEN_TAC THEN REWRITE_TAC[PERMUTATION; permutes] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `{x:A | ~(p x = x)}` THEN ASM_SIMP_TAC[IN_ELIM_THM]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN + ASM_SIMP_TAC[IN_ELIM_THM; SUBSET] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a sort of induction principle composing by swaps. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_INDUCT = prove + (`!P s. FINITE s /\ + P I /\ + (!a b:A p. a IN s /\ b IN s /\ P p /\ permutation p + ==> P (swap(a,b) o p)) + ==> (!p. p permutes s ==> P p)`, + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a ==> c ==> d`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_REWRITE_TAC[PERMUTES_EMPTY; IN_INSERT] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `p = swap(x,p x) o swap(x,p x) o (p:A->A)` SUBST1_TAC THENL + [REWRITE_TAC[o_ASSOC; SWAP_IDEMPOTENT; I_O_ID]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN ASSUME_TAC th) THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_INSERT; PERMUTES_INSERT_LEMMA; + PERMUTATION_PERMUTES; FINITE_INSERT; PERMUTATION_COMPOSE; + PERMUTATION_SWAP]);; + +(* ------------------------------------------------------------------------- *) +(* Sign of a permutation as a real number. *) +(* ------------------------------------------------------------------------- *) + +let sign = new_definition + `(sign p):real = if evenperm p then &1 else -- &1`;; + +let SIGN_NZ = prove + (`!p. ~(sign p = &0)`, + REWRITE_TAC[sign] THEN REAL_ARITH_TAC);; + +let SIGN_I = prove + (`sign I = &1`, + REWRITE_TAC[sign; EVENPERM_I]);; + +let SIGN_INVERSE = prove + (`!p. permutation p ==> sign(inverse p) = sign p`, + SIMP_TAC[sign; EVENPERM_INVERSE] THEN REAL_ARITH_TAC);; + +let SIGN_COMPOSE = prove + (`!p q. permutation p /\ permutation q ==> sign(p o q) = sign(p) * sign(q)`, + SIMP_TAC[sign; EVENPERM_COMPOSE] THEN REAL_ARITH_TAC);; + +let SIGN_SWAP = prove + (`!a b. sign(swap(a,b)) = if a = b then &1 else -- &1`, + REWRITE_TAC[sign; EVENPERM_SWAP]);; + +let SIGN_IDEMPOTENT = prove + (`!p. sign(p) * sign(p) = &1`, + GEN_TAC THEN REWRITE_TAC[sign] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let REAL_ABS_SIGN = prove + (`!p. abs(sign p) = &1`, + REWRITE_TAC[sign] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas about permutations. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTES_NUMSET_LE = prove + (`!p s:num->bool. p permutes s /\ (!i. i IN s ==> p(i) <= i) ==> p = I`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; I_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(n:num) IN s` THENL [ALL_TAC; ASM_MESON_TAC[permutes]] THEN + ASM_SIMP_TAC[GSYM LE_ANTISYM] THEN REWRITE_TAC[GSYM NOT_LT] THEN + ASM_MESON_TAC[PERMUTES_INJECTIVE; LT_REFL]);; + +let PERMUTES_NUMSET_GE = prove + (`!p s:num->bool. p permutes s /\ (!i. i IN s ==> i <= p(i)) ==> p = I`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`inverse(p:num->num)`; `s:num->bool`] PERMUTES_NUMSET_LE) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[PERMUTES_INVERSE; PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; + ASM_MESON_TAC[PERMUTES_INVERSE_INVERSE; INVERSE_I]]);; + +let IMAGE_INVERSE_PERMUTATIONS = prove + (`!s:A->bool. {inverse p | p permutes s} = {p | p permutes s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[PERMUTES_INVERSE_INVERSE; PERMUTES_INVERSE]);; + +let IMAGE_COMPOSE_PERMUTATIONS_L = prove + (`!s q:A->A. q permutes s ==> {q o p | p permutes s} = {p | p permutes s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `p:A->A` THEN EQ_TAC THENL + [ASM_MESON_TAC[PERMUTES_COMPOSE]; + DISCH_TAC THEN EXISTS_TAC `inverse(q:A->A) o (p:A->A)` THEN + ASM_SIMP_TAC[o_ASSOC; PERMUTES_INVERSE; PERMUTES_COMPOSE] THEN + ASM_MESON_TAC[PERMUTES_INVERSES_o; I_O_ID]]);; + +let IMAGE_COMPOSE_PERMUTATIONS_R = prove + (`!s q:A->A. q permutes s ==> {p o q | p permutes s} = {p | p permutes s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `p:A->A` THEN EQ_TAC THENL + [ASM_MESON_TAC[PERMUTES_COMPOSE]; + DISCH_TAC THEN EXISTS_TAC `(p:A->A) o inverse(q:A->A)` THEN + ASM_SIMP_TAC[GSYM o_ASSOC; PERMUTES_INVERSE; PERMUTES_COMPOSE] THEN + ASM_MESON_TAC[PERMUTES_INVERSES_o; I_O_ID]]);; + +let PERMUTES_IN_NUMSEG = prove + (`!p n i. p permutes 1..n /\ i IN 1..n ==> 1 <= p(i) /\ p(i) <= n`, + REWRITE_TAC[permutes; IN_NUMSEG] THEN MESON_TAC[]);; + +let SUM_PERMUTATIONS_INVERSE = prove + (`!f m n. sum {p | p permutes m..n} f = + sum {p | p permutes m..n} (\p. f(inverse p))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM IMAGE_INVERSE_PERMUTATIONS] THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) + [SET_RULE `{f x | p x} = IMAGE f {x | p x}`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC SUM_IMAGE THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_ELIM_THM] THEN + MESON_TAC[PERMUTES_INVERSE_INVERSE]);; + +let SUM_PERMUTATIONS_COMPOSE_L = prove + (`!f m n q. + q permutes m..n + ==> sum {p | p permutes m..n} f = + sum {p | p permutes m..n} (\p. f(q o p))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) + [GSYM(MATCH_MP IMAGE_COMPOSE_PERMUTATIONS_L th)]) THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) + [SET_RULE `{f x | p x} = IMAGE f {x | p x}`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC SUM_IMAGE THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\p:num->num. inverse(q:num->num) o p`) THEN + REWRITE_TAC[o_ASSOC] THEN + EVERY_ASSUM(CONJUNCTS_THEN SUBST1_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN + REWRITE_TAC[I_O_ID]);; + +let SUM_PERMUTATIONS_COMPOSE_R = prove + (`!f m n q. + q permutes m..n + ==> sum {p | p permutes m..n} f = + sum {p | p permutes m..n} (\p. f(p o q))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) + [GSYM(MATCH_MP IMAGE_COMPOSE_PERMUTATIONS_R th)]) THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) + [SET_RULE `{f x | p x} = IMAGE f {x | p x}`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC SUM_IMAGE THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\p:num->num. p o inverse(q:num->num)`) THEN + REWRITE_TAC[GSYM o_ASSOC] THEN + EVERY_ASSUM(CONJUNCTS_THEN SUBST1_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN + REWRITE_TAC[I_O_ID]);; + +(* ------------------------------------------------------------------------- *) +(* Conversion for `{p | p permutes s}` where s is a set enumeration. *) +(* ------------------------------------------------------------------------- *) + +let PERMSET_CONV = + let pth_empty = prove + (`{p | p permutes {}} = {I}`, + REWRITE_TAC[PERMUTES_EMPTY] THEN SET_TAC[]) + and pth_cross = SET_RULE + `IMAGE f {x,y | x IN {} /\ y IN t} = {} /\ + IMAGE f {x,y | x IN (a INSERT s) /\ y IN t} = + (IMAGE (\y. f(a,y)) t) UNION (IMAGE f {x,y | x IN s /\ y IN t})` + and pth_union = SET_RULE + `{} UNION t = t /\ + (x INSERT s) UNION t = x INSERT (s UNION t)` in + let rec PERMSET_CONV tm = + (GEN_REWRITE_CONV I [pth_empty] ORELSEC + (GEN_REWRITE_CONV I [PERMUTES_INSERT] THENC + ONCE_DEPTH_CONV PERMSET_CONV THENC + REWRITE_CONV[pth_cross] THENC + REWRITE_CONV[IMAGE_CLAUSES] THENC + REWRITE_CONV[pth_union] THENC + REWRITE_CONV[SWAP_REFL; I_O_ID])) tm in + PERMSET_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Sum over a set of permutations (could generalize to iteration). *) +(* ------------------------------------------------------------------------- *) + +let SUM_OVER_PERMUTATIONS_INSERT = prove + (`!f a s. FINITE s /\ ~(a IN s) + ==> sum {p:A->A | p permutes (a INSERT s)} f = + sum (a INSERT s) + (\b. sum {p | p permutes s} (\q. f(swap(a,b) o q)))`, + let lemma = prove + (`(\(b,p). f (swap (a,b) o p)) = f o (\(b,p). swap(a,b) o p)`, + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_THM]) in + REPEAT STRIP_TAC THEN REWRITE_TAC[PERMUTES_INSERT] THEN + ASM_SIMP_TAC[FINITE_PERMUTATIONS; FINITE_INSERT; SUM_SUM_PRODUCT] THEN + REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUM_IMAGE THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`b:A`; `p:A->A`; `c:A`; `q:A->A`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o C AP_THM `a:A`) THEN + REWRITE_TAC[o_THM; swap] THEN ASM_MESON_TAC[permutes]; + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(\p:A->A. swap(a:A,c) o p)`) THEN + REWRITE_TAC[o_ASSOC; SWAP_IDEMPOTENT; I_O_ID]]);; + +let SUM_OVER_PERMUTATIONS_NUMSEG = prove + (`!f m n. m <= n + ==> sum {p | p permutes (m..n)} f = + sum(m..n) (\i. sum {p | p permutes (m+1..n)} + (\q. f(swap(m,i) o q)))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM NUMSEG_LREC] THEN + MATCH_MP_TAC SUM_OVER_PERMUTATIONS_INSERT THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ARITH_TAC);; diff --git a/Library/pocklington.ml b/Library/pocklington.ml new file mode 100644 index 0000000..dc59df3 --- /dev/null +++ b/Library/pocklington.ml @@ -0,0 +1,1721 @@ +(* ========================================================================= *) +(* HOL primality proving via Pocklington-optimized Pratt certificates. *) +(* ========================================================================= *) + +needs "Library/iter.ml";; +needs "Library/prime.ml";; + +prioritize_num();; + +let num_0 = Int 0;; +let num_1 = Int 1;; +let num_2 = Int 2;; + +(* ------------------------------------------------------------------------- *) +(* Mostly for compatibility. Should eliminate this eventually. *) +(* ------------------------------------------------------------------------- *) + +let nat_mod_lemma = prove + (`!x y n:num. (x == y) (mod n) /\ y <= x ==> ?q. x = y + n * q`, + REPEAT GEN_TAC THEN REWRITE_TAC[num_congruent] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_REWRITE_TAC + [INTEGER_RULE `(x == y) (mod &n) <=> &n divides (x - y)`] THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; + ARITH_RULE `x <= y ==> (y:num = x + d <=> y - x = d)`] THEN + REWRITE_TAC[GSYM num_divides; divides]);; + +let nat_mod = prove + (`!x y n:num. (mod n) x y <=> ?q1 q2. x + n * q1 = y + n * q2`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM cong] THEN + EQ_TAC THENL [ALL_TAC; NUMBER_TAC] THEN + MP_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THEN + REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (c /\ b) \/ (c /\ a) ==> d`] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [ALL_TAC; + ONCE_REWRITE_TAC[NUMBER_RULE + `(x:num == y) (mod n) <=> (y == x) (mod n)`]] THEN + MESON_TAC[nat_mod_lemma; ARITH_RULE `x + y * 0 = x`]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about previously defined terms. *) +(* ------------------------------------------------------------------------- *) + +let PRIME = prove + (`!p. prime p <=> ~(p = 0) /\ ~(p = 1) /\ !m. 0 < m /\ m < p ==> coprime(p,m)`, + GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN + EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP PRIME_COPRIME) THEN + DISCH_TAC THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[COPRIME_1] THEN + ASM_MESON_TAC[NOT_LT; LT_REFL; DIVIDES_LE]; ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN + SUBGOAL_THEN `~(coprime(p,q))` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[coprime; NOT_FORALL_THM] THEN + EXISTS_TAC `q:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL] THEN + ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[LT_LE; LE_0] THEN + ASM_CASES_TAC `p:num = q` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[] THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[DIVIDES_ZERO]);; + +let FINITE_NUMBER_SEGMENT = prove + (`!n. { m | 0 < m /\ m < n } HAS_SIZE (n - 1)`, + INDUCT_TAC THENL + [SUBGOAL_THEN `{m | 0 < m /\ m < 0} = EMPTY` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN + CONV_TAC NUM_REDUCE_CONV; + ASM_CASES_TAC `n = 0` THENL + [SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = EMPTY` SUBST1_TAC THENL + [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[HAS_SIZE_0]; + SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = n INSERT {m | 0 < m /\ m < n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `~(n = 0)` THEN + POP_ASSUM MP_TAC THEN + SIMP_TAC[FINITE_RULES; HAS_SIZE; CARD_CLAUSES] THEN + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; LT_REFL] THEN + ARITH_TAC]]);; + +let COPRIME_MOD = prove + (`!a n. ~(n = 0) ==> (coprime(a MOD n,n) <=> coprime(a,n))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) + [MATCH_MP DIVISION th]) THEN REWRITE_TAC[coprime] THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MESON_TAC[DIVIDES_ADD; DIVIDES_ADD_REVR; DIVIDES_ADD_REVL; + DIVIDES_LMUL; DIVIDES_RMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Congruences. *) +(* ------------------------------------------------------------------------- *) + +let CONG = prove + (`!x y n. ~(n = 0) ==> ((x == y) (mod n) <=> (x MOD n = y MOD n))`, + REWRITE_TAC[cong; nat_mod] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [ASM_CASES_TAC `x <= y` THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q1 - q2`; + MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q2 - q1`] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; + MAP_EVERY EXISTS_TAC [`y DIV n`; `x DIV n`] THEN + UNDISCH_TAC `x MOD n = y MOD n` THEN + MATCH_MP_TAC(ARITH_RULE + `(y = dy + my) /\ (x = dx + mx) ==> (mx = my) ==> (x + dy = y + dx)`) THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[DIVISION]]);; + +let CONG_MOD_0 = prove + (`!x y. (x == y) (mod 0) <=> (x = y)`, + NUMBER_TAC);; + +let CONG_MOD_1 = prove + (`!x y. (x == y) (mod 1)`, + NUMBER_TAC);; + +let CONG_0 = prove + (`!x n. ((x == 0) (mod n) <=> n divides x)`, + NUMBER_TAC);; + +let CONG_SUB_CASES = prove + (`!x y n. (x == y) (mod n) <=> + if x <= y then (y - x == 0) (mod n) + else (x - y == 0) (mod n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN + COND_CASES_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]; ALL_TAC] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let CONG_CASES = prove + (`!x y n. (x == y) (mod n) <=> (?q. x = q * n + y) \/ (?q. y = q * n + x)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[] THEN NUMBER_TAC] THEN + REWRITE_TAC[cong; nat_mod; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`q1:num`; `q2:num`] THEN + DISCH_THEN(MP_TAC o MATCH_MP(ARITH_RULE + `x + a = y + b ==> x = (b - a) + y \/ y = (a - b) + x`)) THEN + REWRITE_TAC[GSYM LEFT_SUB_DISTRIB] THEN MESON_TAC[MULT_SYM]);; + +let CONG_MULT_LCANCEL = prove + (`!a n x y. coprime(a,n) /\ (a * x == a * y) (mod n) ==> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_MULT_RCANCEL = prove + (`!a n x y. coprime(a,n) /\ (x * a == y * a) (mod n) ==> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_REFL = prove + (`!x n. (x == x) (mod n)`, + NUMBER_TAC);; + +let EQ_IMP_CONG = prove + (`!a b n. a = b ==> (a == b) (mod n)`, + SIMP_TAC[CONG_REFL]);; + +let CONG_SYM = prove + (`!x y n. (x == y) (mod n) <=> (y == x) (mod n)`, + NUMBER_TAC);; + +let CONG_TRANS = prove + (`!x y z n. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, + NUMBER_TAC);; + +let CONG_ADD = prove + (`!x x' y y'. + (x == x') (mod n) /\ (y == y') (mod n) ==> (x + y == x' + y') (mod n)`, + NUMBER_TAC);; + +let CONG_MULT = prove + (`!x x' y y'. + (x == x') (mod n) /\ (y == y') (mod n) ==> (x * y == x' * y') (mod n)`, + NUMBER_TAC);; + +let CONG_EXP = prove + (`!n k x y. (x == y) (mod n) ==> (x EXP k == y EXP k) (mod n)`, + GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[CONG_MULT; EXP; CONG_REFL]);; + +let CONG_SUB = prove + (`!x x' y y'. + (x == x') (mod n) /\ (y == y') (mod n) /\ y <= x /\ y' <= x' + ==> (x - y == x' - y') (mod n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + a = x' + a') /\ (y + b = y' + b') /\ y <= x /\ y' <= x' + ==> ((x - y) + (a + b') = (x' - y') + (a' + b))`)) THEN + REWRITE_TAC[GSYM LEFT_ADD_DISTRIB] THEN MESON_TAC[]);; + +let CONG_MULT_LCANCEL_EQ = prove + (`!a n x y. coprime(a,n) ==> ((a * x == a * y) (mod n) <=> (x == y) (mod n))`, + NUMBER_TAC);; + +let CONG_MULT_RCANCEL_EQ = prove + (`!a n x y. coprime(a,n) ==> ((x * a == y * a) (mod n) <=> (x == y) (mod n))`, + NUMBER_TAC);; + +let CONG_ADD_LCANCEL_EQ = prove + (`!a n x y. (a + x == a + y) (mod n) <=> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_ADD_RCANCEL_EQ = prove + (`!a n x y. (x + a == y + a) (mod n) <=> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_ADD_RCANCEL = prove + (`!a n x y. (x + a == y + a) (mod n) ==> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_ADD_LCANCEL = prove + (`!a n x y. (a + x == a + y) (mod n) ==> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_ADD_LCANCEL_EQ_0 = prove + (`!a n x y. (a + x == a) (mod n) <=> (x == 0) (mod n)`, + NUMBER_TAC);; + +let CONG_ADD_RCANCEL_EQ_0 = prove + (`!a n x y. (x + a == a) (mod n) <=> (x == 0) (mod n)`, + NUMBER_TAC);; + +let CONG_IMP_EQ = prove + (`!x y n. x < n /\ y < n /\ (x == y) (mod n) ==> x = y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LT] THEN + ASM_MESON_TAC[CONG; MOD_LT]);; + +let CONG_DIVIDES_MODULUS = prove + (`!x y m n. (x == y) (mod m) /\ n divides m ==> (x == y) (mod n)`, + NUMBER_TAC);; + +let CONG_0_DIVIDES = prove + (`!n x. (x == 0) (mod n) <=> n divides x`, + NUMBER_TAC);; + +let CONG_1_DIVIDES = prove + (`!n x. (x == 1) (mod n) ==> n divides (x - 1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides; cong; nat_mod] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(x + q1 = 1 + q2) ==> ~(x = 0) ==> (x - 1 = q2 - q1)`)) THEN + ASM_CASES_TAC `x = 0` THEN + ASM_REWRITE_TAC[ARITH; GSYM LEFT_SUB_DISTRIB] THEN + ASM_MESON_TAC[MULT_CLAUSES]);; + +let CONG_DIVIDES = prove + (`!x y n. (x == y) (mod n) ==> (n divides x <=> n divides y)`, + NUMBER_TAC);; + +let CONG_COPRIME = prove + (`!x y n. (x == y) (mod n) ==> (coprime(n,x) <=> coprime(n,y))`, + NUMBER_TAC);; + +let CONG_MOD = prove + (`!a n. ~(n = 0) ==> (a MOD n == a) (mod n)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN + DISCH_THEN(MP_TAC o SPEC `a:num`) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[cong; nat_mod] THEN + MAP_EVERY EXISTS_TAC [`a DIV n`; `0`] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; ADD_AC; MULT_AC]);; + +let MOD_MULT_CONG = prove + (`!a b x y. ~(a = 0) /\ ~(b = 0) + ==> ((x MOD (a * b) == y) (mod a) <=> (x == y) (mod a))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `(x MOD (a * b) == x) (mod a)` + (fun th -> MESON_TAC[th; CONG_TRANS; CONG_SYM]) THEN + MATCH_MP_TAC CONG_DIVIDES_MODULUS THEN EXISTS_TAC `a * b` THEN + ASM_SIMP_TAC[CONG_MOD; MULT_EQ_0; DIVIDES_RMUL; DIVIDES_REFL]);; + +let CONG_MOD_MULT = prove + (`!x y m n. (x == y) (mod n) /\ m divides n ==> (x == y) (mod m)`, + NUMBER_TAC);; + +let CONG_LMOD = prove + (`!x y n. ~(n = 0) ==> ((x MOD n == y) (mod n) <=> (x == y) (mod n))`, + MESON_TAC[CONG_MOD; CONG_TRANS; CONG_SYM]);; + +let CONG_RMOD = prove + (`!x y n. ~(n = 0) ==> ((x == y MOD n) (mod n) <=> (x == y) (mod n))`, + MESON_TAC[CONG_MOD; CONG_TRANS; CONG_SYM]);; + +let CONG_MOD_LT = prove + (`!y. y < n ==> (x MOD n = y <=> (x == y) (mod n))`, + MESON_TAC[MOD_LT; CONG; LT]);; + +(* ------------------------------------------------------------------------- *) +(* Some things when we know more about the order. *) +(* ------------------------------------------------------------------------- *) + +let CONG_LT = prove + (`!x y n. y < n ==> ((x == y) (mod n) <=> ?d. x = d * n + y)`, + REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_LT; + GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + REWRITE_TAC[num_congruent; int_congruent] THEN + REWRITE_TAC[INT_ARITH `x = m * n + y <=> x - y:int = n * m`] THEN + REPEAT STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN + DISJ_CASES_TAC(SPEC `d:int` INT_IMAGE) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (INT_ARITH + `x - y:int = n * --m ==> y = x + n * m`)) THEN + POP_ASSUM MP_TAC THEN DISJ_CASES_TAC(ARITH_RULE `m = 0 \/ 1 <= m`) THEN + ASM_REWRITE_TAC[INT_MUL_RZERO; INT_ARITH `x - (x + a):int = --a`] THENL + [STRIP_TAC THEN EXISTS_TAC `0` THEN INT_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_LT] THEN + ARITH_TAC]);; + +let CONG_LE = prove + (`!x y n. y <= x ==> ((x == y) (mod n) <=> ?q. x = q * n + y)`, + ONCE_REWRITE_TAC[CONG_SYM] THEN ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN + SIMP_TAC[ARITH_RULE `y <= x ==> (x = a + y <=> x - y = a)`] THEN + REWRITE_TAC[CONG_0; divides] THEN MESON_TAC[MULT_SYM]);; + +let CONG_TO_1 = prove + (`!a n. (a == 1) (mod n) <=> a = 0 /\ n = 1 \/ ?m. a = 1 + m * n`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[CONG_MOD_1] THENL + [MESON_TAC[ARITH_RULE `n = 0 \/ n = 1 + (n - 1) * 1`]; ALL_TAC] THEN + DISJ_CASES_TAC(ARITH_RULE `a = 0 \/ ~(a = 0) /\ 1 <= a`) THEN + ASM_SIMP_TAC[CONG_LE] THENL [ALL_TAC; MESON_TAC[ADD_SYM; MULT_SYM]] THEN + ASM_MESON_TAC[CONG_SYM; CONG_0; DIVIDES_ONE; ARITH_RULE `~(0 = 1 + a)`]);; + +(* ------------------------------------------------------------------------- *) +(* In particular two common cases. *) +(* ------------------------------------------------------------------------- *) + +let EVEN_MOD_2 = prove + (`EVEN n <=> (n == 0) (mod 2)`, + SIMP_TAC[EVEN_EXISTS; CONG_LT; ARITH; ADD_CLAUSES; MULT_AC]);; + +let ODD_MOD_2 = prove + (`ODD n <=> (n == 1) (mod 2)`, + SIMP_TAC[ODD_EXISTS; CONG_LT; ARITH; ADD_CLAUSES; ADD1; MULT_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Conversion to evaluate congruences. *) +(* ------------------------------------------------------------------------- *) + +let CONG_CONV = + let pth = prove + (`(x == y) (mod n) <=> + if x <= y then n divides (y - x) else n divides (x - y)`, + ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN REWRITE_TAC[CONG_0_DIVIDES]) in + GEN_REWRITE_CONV I [pth] THENC + RATOR_CONV(LAND_CONV NUM_LE_CONV) THENC + GEN_REWRITE_CONV I [COND_CLAUSES] THENC + RAND_CONV NUM_SUB_CONV THENC + DIVIDES_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Some basic theorems about solving congruences. *) +(* ------------------------------------------------------------------------- *) + +let CONG_SOLVE = prove + (`!a b n. coprime(a,n) ==> ?x. (a * x == b) (mod n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `n:num`] BEZOUT_ADD_STRONG) THEN + ASM_CASES_TAC `a = 0` THENL + [ASM_MESON_TAC[COPRIME_0; COPRIME_SYM; CONG_MOD_1]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `d:num`; `y:num`] THEN + ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; ASM_MESON_TAC[COPRIME]] THEN + STRIP_TAC THEN EXISTS_TAC `x * b:num` THEN ASM_REWRITE_TAC[MULT_ASSOC] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `b = 0 + b`] THEN + MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL] THEN + REWRITE_TAC[CONG_0; GSYM MULT_ASSOC] THEN MESON_TAC[divides]);; + +let CONG_SOLVE_UNIQUE = prove + (`!a b n. coprime(a,n) /\ ~(n = 0) ==> ?!x. x < n /\ (a * x == b) (mod n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE] THEN + MP_TAC(SPECL [`a:num`; `b:num`; `n:num`] CONG_SOLVE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN + EXISTS_TAC `x MOD n` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[DIVISION] THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `a * x:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONG_MULT THEN REWRITE_TAC[CONG_REFL] THEN + ASM_SIMP_TAC[CONG; MOD_MOD_REFL]; + ALL_TAC] THEN + STRIP_TAC THEN X_GEN_TAC `y:num` THEN STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `y MOD n` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MOD_LT]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CONG] THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `a:num` THEN ASM_MESON_TAC[CONG_TRANS; CONG_SYM]);; + +let CONG_SOLVE_UNIQUE_NONTRIVIAL = prove + (`!a p x. prime p /\ coprime(p,a) /\ 0 < x /\ x < p + ==> ?!y. 0 < y /\ y < p /\ (x * y == a) (mod p)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN `1 < p` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 < p <=> ~(p = 0) /\ ~(p = 1)`] THEN + ASM_MESON_TAC[PRIME_1]; + ALL_TAC] THEN + MP_TAC(SPECL [`x:num`; `a:num`; `p:num`] CONG_SOLVE_UNIQUE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PRIME_0]] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + MP_TAC(SPECL [`x:num`; `p:num`] PRIME_COPRIME) THEN + ASM_CASES_TAC `x = 1` THEN ASM_REWRITE_TAC[COPRIME_1] THEN + ASM_MESON_TAC[COPRIME_SYM; NOT_LT; DIVIDES_LE; LT_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `0 < r <=> ~(r = 0)`] THEN + ASM_CASES_TAC `r = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + ASM_SIMP_TAC[ARITH_RULE `~(p = 0) ==> 0 < p`] THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN REWRITE_TAC[CONG_0] THEN + ASM_MESON_TAC[DIVIDES_REFL; PRIME_1; coprime]);; + +let CONG_UNIQUE_INVERSE_PRIME = prove + (`!p x. prime p /\ 0 < x /\ x < p + ==> ?!y. 0 < y /\ y < p /\ (x * y == 1) (mod p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_SOLVE_UNIQUE_NONTRIVIAL THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[COPRIME_1; COPRIME_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Forms of the Chinese remainder theorem. *) +(* ------------------------------------------------------------------------- *) + +let CONG_CHINESE = prove + (`coprime(a,b) /\ (x == y) (mod a) /\ (x == y) (mod b) + ==> (x == y) (mod (a * b))`, + ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN MESON_TAC[CONG_0; DIVIDES_MUL]);; + +let CHINESE_REMAINDER_UNIQUE = prove + (`!a b m n. + coprime(a,b) /\ ~(a = 0) /\ ~(b = 0) + ==> ?!x. x < a * b /\ (x == m) (mod a) /\ (x == n) (mod b)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`a:num`; `b:num`; `m:num`; `n:num`] CHINESE_REMAINDER) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `q1:num`; `q2:num`] THEN + DISCH_TAC THEN EXISTS_TAC `x MOD (a * b)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION; MULT_EQ_0]; ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o CONJUNCT1); + FIRST_X_ASSUM(SUBST1_TAC o CONJUNCT2)] THEN + ASM_SIMP_TAC[MOD_MULT_CONG] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[cong; nat_mod; GSYM ADD_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + MESON_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_IMP_EQ THEN + EXISTS_TAC `a * b` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONG_CHINESE; CONG_SYM; CONG_TRANS]]);; + +let CHINESE_REMAINDER_COPRIME_UNIQUE = prove + (`!a b m n. + coprime(a,b) /\ ~(a = 0) /\ ~(b = 0) /\ coprime(m,a) /\ coprime(n,b) + ==> ?!x. coprime(x,a * b) /\ x < a * b /\ + (x == m) (mod a) /\ (x == n) (mod b)`, + REPEAT STRIP_TAC THEN MP_TAC + (SPECL [`a:num`; `b:num`; `m:num`; `n:num`] CHINESE_REMAINDER_UNIQUE) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] + `(!x. P(x) ==> Q(x)) ==> (?!x. P x) ==> ?!x. Q(x) /\ P(x)`) THEN + ASM_SIMP_TAC[CHINESE_REMAINDER_UNIQUE] THEN + ASM_MESON_TAC[CONG_COPRIME; COPRIME_SYM; COPRIME_MUL]);; + +let CONG_CHINESE_EQ = prove + (`!a b x y. + coprime(a,b) + ==> ((x == y) (mod (a * b)) <=> (x == y) (mod a) /\ (x == y) (mod b))`, + NUMBER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Euler totient function. *) +(* ------------------------------------------------------------------------- *) + +let phi = new_definition + `phi(n) = CARD { m | 0 < m /\ m <= n /\ coprime(m,n) }`;; + +let PHI_ALT = prove + (`phi(n) = CARD { m | coprime(m,n) /\ m < n}`, + REWRITE_TAC[phi] THEN + ASM_CASES_TAC `n = 0` THENL + [AP_TERM_TAC THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[LT; NOT_LT]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [SUBGOAL_THEN + `({m | 0 < m /\ m <= n /\ coprime (m,n)} = {1}) /\ + ({m | coprime (m,n) /\ m < n} = {0})` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [ALL_TAC; SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY]] THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + REWRITE_TAC[COPRIME_1] THEN REPEAT STRIP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + AP_TERM_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN + ASM_REWRITE_TAC[LT] THENL + [ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]; + ASM_MESON_TAC[LE_LT; COPRIME_REFL; LT_NZ]]);; + +let PHI_FINITE_LEMMA = prove + (`!P n. FINITE {m | coprime(m,n) /\ m < n}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC);; + +let PHI_ANOTHER = prove + (`!n. ~(n = 1) ==> (phi(n) = CARD {m | 0 < m /\ m < n /\ coprime(m,n)})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phi] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[LE_LT; COPRIME_REFL; COPRIME_1; LT_NZ]);; + +let PHI_LIMIT = prove + (`!n. phi(n) <= n`, + GEN_TAC THEN REWRITE_TAC[PHI_ALT] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_LT] THEN + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[FINITE_NUMSEG_LT] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +let PHI_LIMIT_STRONG = prove + (`!n. ~(n = 1) ==> phi(n) <= n - 1`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN + ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +let PHI_0 = prove + (`phi 0 = 0`, + MP_TAC(SPEC `0` PHI_LIMIT) THEN REWRITE_TAC[ARITH] THEN ARITH_TAC);; + +let PHI_1 = prove + (`phi 1 = 1`, + REWRITE_TAC[PHI_ALT; COPRIME_1; CARD_NUMSEG_LT]);; + +let PHI_LOWERBOUND_1_STRONG = prove + (`!n. 1 <= n ==> 1 <= phi(n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1 = CARD {1}` SUBST1_TAC THENL + [SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; FINITE_RULES; ARITH]; ALL_TAC] THEN + REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN + GEN_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN + REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]]);; + +let PHI_LOWERBOUND_1 = prove + (`!n. 2 <= n ==> 1 <= phi(n)`, + MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_TRANS; ARITH_RULE `1 <= 2`]);; + +let PHI_LOWERBOUND_2 = prove + (`!n. 3 <= n ==> 2 <= phi(n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `2 = CARD {1,(n-1)}` SUBST1_TAC THENL + [SIMP_TAC[CARD_CLAUSES; IN_INSERT; NOT_IN_EMPTY; FINITE_RULES; ARITH] THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> ~(1 = n - 1)`]; ALL_TAC] THEN + REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN + ASM_SIMP_TAC[ARITH; + ARITH_RULE `3 <= n ==> 0 < n - 1 /\ n - 1 <= n /\ 1 <= n`] THEN + REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + MP_TAC(SPEC `n:num` COPRIME_1) THEN REWRITE_TAC[coprime] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `1 = n - (n - 1)` SUBST1_TAC THENL + [UNDISCH_TAC `3 <= n` THEN ARITH_TAC; + ASM_SIMP_TAC[DIVIDES_SUB]]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN + REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]]);; + +let PHI_EQ_0 = prove + (`!n. phi n = 0 <=> n = 0`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[PHI_0] THEN + MP_TAC(SPEC `n:num` PHI_LOWERBOUND_1_STRONG) THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Value on primes and prime powers. *) +(* ------------------------------------------------------------------------- *) + +let PHI_PRIME_EQ = prove + (`!n. (phi n = n - 1) /\ ~(n = 0) /\ ~(n = 1) <=> prime n`, + GEN_TAC THEN REWRITE_TAC[PRIME] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[PHI_1; ARITH] THEN + MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN + ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `{m | 0 < m /\ m < n /\ coprime (m,n)} = {m | 0 < m /\ m < n}` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[COPRIME_SYM] THEN CONV_TAC TAUT] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC CARD_SUBSET_EQ THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +let PHI_PRIME = prove + (`!p. prime p ==> phi p = p - 1`, + MESON_TAC[PHI_PRIME_EQ]);; + +let PHI_PRIMEPOW_SUC = prove + (`!p k. prime(p) ==> phi(p EXP (k + 1)) = p EXP (k + 1) - p EXP k`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[PHI_ALT; COPRIME_PRIMEPOW; ADD_EQ_0; ARITH] THEN + REWRITE_TAC[SET_RULE + `{n | ~(P n) /\ Q n} = {n | Q n} DIFF {n | P n /\ Q n}`] THEN + SIMP_TAC[FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM; CARD_DIFF] THEN + REWRITE_TAC[CARD_NUMSEG_LT] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `{m | p divides m /\ m < p EXP (k + 1)} = + IMAGE (\x. p * x) {m | m < p EXP k}` + (fun th -> ASM_SIMP_TAC[th; CARD_IMAGE_INJ; EQ_MULT_LCANCEL; PRIME_IMP_NZ; + FINITE_NUMSEG_LT; CARD_NUMSEG_LT]) THEN + REWRITE_TAC[EXTENSION; TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`; + FORALL_AND_THM; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[IN_ELIM_THM; GSYM ADD1; EXP; LT_MULT_LCANCEL; PRIME_IMP_NZ] THEN + CONJ_TAC THENL [ALL_TAC; NUMBER_TAC] THEN + X_GEN_TAC `x:num` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN + UNDISCH_TAC `p * n < p * p EXP k` THEN + ASM_SIMP_TAC[LT_MULT_LCANCEL; PRIME_IMP_NZ]);; + +let PHI_PRIMEPOW = prove + (`!p k. prime p + ==> phi(p EXP k) = if k = 0 then 1 else p EXP k - p EXP (k - 1)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; CONJUNCT1 EXP; PHI_1] THEN + ASM_SIMP_TAC[ADD1; PHI_PRIMEPOW_SUC; ADD_SUB]);; + +let PHI_2 = prove + (`phi 2 = 1`, + SIMP_TAC[PHI_PRIME; PRIME_2] THEN CONV_TAC NUM_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Multiplicativity property. *) +(* ------------------------------------------------------------------------- *) + +let PHI_MULTIPLICATIVE = prove + (`!a b. coprime(a,b) ==> phi(a * b) = phi(a) * phi(b)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`a = 0`; `b = 0`] THEN + ASM_REWRITE_TAC[PHI_0; MULT_CLAUSES] THEN + SIMP_TAC[PHI_ALT; GSYM CARD_PRODUCT; PHI_FINITE_LEMMA] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ_EQ THEN + EXISTS_TAC `\p. p MOD a,p MOD b` THEN + REWRITE_TAC[PHI_FINITE_LEMMA; IN_ELIM_PAIR_THM] THEN + ASM_SIMP_TAC[IN_ELIM_THM; COPRIME_MOD; DIVISION] THEN CONJ_TAC THENL + [MESON_TAC[COPRIME_LMUL2; COPRIME_RMUL2]; ALL_TAC] THEN + X_GEN_TAC `pp:num#num` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC] THEN MP_TAC(SPECL + [`a:num`; `b:num`; `m:num`; `n:num`] CHINESE_REMAINDER_COPRIME_UNIQUE) THEN + ASM_SIMP_TAC[CONG; MOD_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Even-ness of phi for most arguments. *) +(* ------------------------------------------------------------------------- *) + +let EVEN_PHI = prove + (`!n. 3 <= n ==> EVEN(phi n)`, + REWRITE_TAC[ARITH_RULE `3 <= n <=> 1 < n /\ ~(n = 2)`; IMP_CONJ] THEN + MATCH_MP_TAC INDUCT_COPRIME_STRONG THEN + SIMP_TAC[PHI_PRIMEPOW; PHI_MULTIPLICATIVE; EVEN_MULT; EVEN_SUB] THEN + CONJ_TAC THENL [MESON_TAC[COPRIME_REFL; ARITH_RULE `~(2 = 1)`]; ALL_TAC] THEN + REWRITE_TAC[EVEN_EXP] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP PRIME_ODD) THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `k = 1` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[GSYM NOT_ODD]]);; + +let EVEN_PHI_EQ = prove + (`!n. EVEN(phi n) <=> n = 0 \/ 3 <= n`, + GEN_TAC THEN EQ_TAC THENL + [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[ARITH_RULE `~(n = 0 \/ 3 <= n) <=> n = 1 \/ n = 2`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[PHI_1; PHI_2] THEN CONV_TAC NUM_REDUCE_CONV; + STRIP_TAC THEN ASM_SIMP_TAC[PHI_0; EVEN_PHI; EVEN]]);; + +let ODD_PHI_EQ = prove + (`!n. ODD(phi n) <=> n = 1 \/ n = 2`, + REWRITE_TAC[GSYM NOT_EVEN; EVEN_PHI_EQ] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some iteration theorems. *) +(* ------------------------------------------------------------------------- *) + +let NPRODUCT_MOD = prove + (`!s a:A->num n. + FINITE s /\ ~(n = 0) + ==> (iterate (*) s (\m. a(m) MOD n) == iterate (*) s a) (mod n)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x y. (x == y) (mod n)` + (MATCH_MP ITERATE_RELATED MONOIDAL_MUL)) THEN + SIMP_TAC[NEUTRAL_MUL; CONG_MULT; CONG_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[CONG_MOD]);; + +let NPRODUCT_CMUL = prove + (`!s a c n. + FINITE s + ==> iterate (*) s (\m. c * a(m)) = c EXP (CARD s) * iterate (*) s a`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_MUL; NEUTRAL_MUL; CARD_CLAUSES; + EXP; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC]);; + +let COPRIME_NPRODUCT = prove + (`!s n. FINITE s /\ (!x. x IN s ==> coprime(n,a(x))) + ==> coprime(n,iterate (*) s a)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_MUL; NEUTRAL_MUL; + IN_INSERT; COPRIME_MUL; COPRIME_1]);; + +let ITERATE_OVER_COPRIME = prove + (`!op f n k. + monoidal(op) /\ coprime(k,n) /\ + (!x y. (x == y) (mod n) ==> f x = f y) + ==> iterate op {d | coprime(d,n) /\ d < n} (\m. f(k * m)) = + iterate op {d | coprime(d,n) /\ d < n} f`, + let lemma = prove + (`~(n = 0) ==> ((a * x MOD n == b) (mod n) <=> (a * x == b) (mod n))`, + MESON_TAC[CONG_REFL; CONG_SYM; CONG_TRANS; CONG_MULT; CONG_MOD]) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[LT; SET_RULE `{x | F} = {}`; ITERATE_CLAUSES]; ALL_TAC] THEN + STRIP_TAC THEN SUBGOAL_THEN `?m. (k * m == 1) (mod n)` CHOOSE_TAC THENL + [ASM_MESON_TAC[CONG_SOLVE; MULT_SYM; CONG_SYM]; ALL_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ_GENERAL_INVERSES) THEN + MAP_EVERY EXISTS_TAC [`\x. (k * x) MOD n`; `\x. (m * x) MOD n`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[COPRIME_MOD; CONG_MOD_LT; CONG_LMOD; DIVISION; lemma; + COPRIME_LMUL] THEN + REPEAT STRIP_TAC THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CONG_LMOD]) THEN + UNDISCH_TAC `(k * m == 1) (mod n)` THEN CONV_TAC NUMBER_RULE);; + +let ITERATE_ITERATE_DIVISORS = prove + (`!op:A->A->A f x. + monoidal op + ==> iterate op (1..x) (\n. iterate op {d | d divides n} (f n)) = + iterate op (1..x) + (\n. iterate op (1..(x DIV n)) (\k. f (k * n) n))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ITERATE_ITERATE_PRODUCT; FINITE_NUMSEG; FINITE_DIVISORS; + IN_NUMSEG; LE_1] THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + ITERATE_EQ_GENERAL_INVERSES) THEN + MAP_EVERY EXISTS_TAC [`\(n,d). d,n DIV d`; `\(n:num,k). n * k,n`] THEN + ASM_SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM; PAIR_EQ] THEN CONJ_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `n:num` THENL + [X_GEN_TAC `k:num` THEN SIMP_TAC[DIV_MULT; LE_1; GSYM LE_RDIV_EQ] THEN + SIMP_TAC[MULT_EQ_0; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + DISCH_THEN(K ALL_TAC) THEN NUMBER_TAC; + X_GEN_TAC `d:num` THEN ASM_CASES_TAC `d = 0` THEN + ASM_REWRITE_TAC[DIVIDES_ZERO] THENL [ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN ASM_SIMP_TAC[DIV_MONO] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[DIVIDES_DIV_MULT; MULT_SYM]] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_SIMP_TAC[DIV_EQ_0; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Fermat's Little theorem / Fermat-Euler theorem. *) +(* ------------------------------------------------------------------------- *) + +let FERMAT_LITTLE = prove + (`!a n. coprime(a,n) ==> (a EXP (phi n) == 1) (mod n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_SIMP_TAC[COPRIME_0; PHI_0; CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `iterate (*) {m | coprime (m,n) /\ m < n} (\m. m)` THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[PHI_ALT; MULT_CLAUSES] THEN + SIMP_TAC[IN_ELIM_THM; ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_NPRODUCT; + PHI_FINITE_LEMMA; GSYM NPRODUCT_CMUL] THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `iterate (*) {m | coprime(m,n) /\ m < n} (\m. (a * m) MOD n)` THEN + ASM_SIMP_TAC[NPRODUCT_MOD; PHI_FINITE_LEMMA] THEN + MP_TAC(ISPECL [`( * ):num->num->num`; `\x. x MOD n`; `n:num`; `a:num`] + ITERATE_OVER_COPRIME) THEN + ASM_SIMP_TAC[MONOIDAL_MUL; GSYM CONG] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[CONG_SYM] THEN + MATCH_MP_TAC NPRODUCT_MOD THEN ASM_SIMP_TAC[PHI_FINITE_LEMMA]);; + +let FERMAT_LITTLE_PRIME = prove + (`!a p. prime p /\ coprime(a,p) ==> (a EXP (p - 1) == 1) (mod p)`, + MESON_TAC[FERMAT_LITTLE; PHI_PRIME_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Lucas's theorem. *) +(* ------------------------------------------------------------------------- *) + +let LUCAS_COPRIME_LEMMA = prove + (`!m n a. ~(m = 0) /\ (a EXP m == 1) (mod n) ==> coprime(a,n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[CONG_MOD_0; EXP_EQ_1] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[COPRIME_1]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[COPRIME_1] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN + ASM_SIMP_TAC[CONG] THEN + SUBGOAL_THEN `1 MOD n = 1` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `d divides (a EXP m) MOD n` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[DIVIDES_ONE]] THEN + MATCH_MP_TAC DIVIDES_ADD_REVR THEN + EXISTS_TAC `a EXP m DIV n * n` THEN + ASM_SIMP_TAC[GSYM DIVISION; DIVIDES_LMUL] THEN + SUBGOAL_THEN `m = SUC(m - 1)` SUBST1_TAC THENL + [UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; + ASM_SIMP_TAC[EXP; DIVIDES_RMUL]]);; + +let LUCAS_WEAK = prove + (`!a n. 2 <= n /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!m. 0 < m /\ m < n - 1 ==> ~(a EXP m == 1) (mod n)) + ==> prime(n)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM PHI_PRIME_EQ; PHI_LIMIT_STRONG; GSYM LE_ANTISYM; + ARITH_RULE `2 <= n ==> ~(n = 0) /\ ~(n = 1)`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `phi n`) THEN + SUBGOAL_THEN `coprime(a,n)` (fun th -> SIMP_TAC[FERMAT_LITTLE; th]) THENL + [MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN EXISTS_TAC `n - 1` THEN + ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n - 1 = 0)`]; ALL_TAC] THEN + REWRITE_TAC[GSYM NOT_LT] THEN + MATCH_MP_TAC(TAUT `a ==> ~(a /\ b) ==> ~b`) THEN + ASM_SIMP_TAC[PHI_LOWERBOUND_1; ARITH_RULE `1 <= n ==> 0 < n`]);; + +let LUCAS = prove + (`!a n. 2 <= n /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!p. prime(p) /\ p divides (n - 1) + ==> ~(a EXP ((n - 1) DIV p) == 1) (mod n)) + ==> prime(n)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `2 <= n ==> ~(n = 0)`)) THEN + MATCH_MP_TAC LUCAS_WEAK THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; GSYM NOT_EXISTS_THM] THEN + ONCE_REWRITE_TAC[num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN + SUBGOAL_THEN `m divides (n - 1)` MP_TAC THENL + [REWRITE_TAC[divides] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_SIMP_TAC[GSYM MOD_EQ_0] THEN + MATCH_MP_TAC(ARITH_RULE `~(0 < n) ==> (n = 0)`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(n - 1) MOD m`) THEN + ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `m:num` THEN + ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `a EXP ((n - 1) DIV m * m)` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN + EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM EXP_ADD] THEN + ASM_SIMP_TAC[GSYM DIVISION] THEN REWRITE_TAC[MULT_CLAUSES] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EXP_EXP] THEN + UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN + UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN + ASM_SIMP_TAC[CONG] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `((a EXP m) MOD n) EXP ((n - 1) DIV m) MOD n` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MOD_EXP_MOD]] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MOD_EXP_MOD] THEN + REWRITE_TAC[EXP_ONE]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `~(r = 1)` MP_TAC THENL + [UNDISCH_TAC `m < m * r` THEN CONV_TAC CONTRAPOS_CONV THEN + SIMP_TAC[MULT_CLAUSES; LT_REFL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN STRIP_TAC THEN + UNDISCH_TAC `!p. prime p /\ p divides m * r + ==> ~(a EXP ((m * r) DIV p) == 1) (mod n)` THEN + DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_SIMP_TAC[DIVIDES_LMUL] THEN + SUBGOAL_THEN `(m * r) DIV p = m * (r DIV p)` SUBST1_TAC THENL + [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + UNDISCH_TAC `prime p` THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + ASM_SIMP_TAC[ARITH_RULE `~(p = 0) ==> 0 < p`] THEN + DISCH_TAC THEN REWRITE_TAC[ADD_CLAUSES; GSYM MULT_ASSOC] THEN + AP_TERM_TAC THEN UNDISCH_TAC `p divides r` THEN + REWRITE_TAC[divides] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[DIV_MULT] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN + UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN + ASM_SIMP_TAC[CONG] THEN + DISCH_THEN(MP_TAC o C AP_THM `r DIV p` o AP_TERM `(EXP)`) THEN + DISCH_THEN(MP_TAC o C AP_THM `n:num` o AP_TERM `(MOD)`) THEN + ASM_SIMP_TAC[MOD_EXP_MOD] THEN + REWRITE_TAC[EXP_EXP; EXP_ONE]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of the order of a number mod n (always 0 in non-coprime case). *) +(* ------------------------------------------------------------------------- *) + +let order = new_definition + `order n a = @d. !k. (a EXP k == 1) (mod n) <=> d divides k`;; + +let EXP_ITER = prove + (`!x n. x EXP n = ITER n (\y. x * y) (1)`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ITER; EXP]);; + +let ORDER_DIVIDES = prove + (`!n a d. (a EXP d == 1) (mod n) <=> order(n) a divides d`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[order] THEN CONV_TAC SELECT_CONV THEN + MP_TAC(ISPECL [`\x y:num. (x == y) (mod n)`; `\x:num. a * x`; `1`] + ORDER_EXISTENCE_ITER) THEN + REWRITE_TAC[GSYM EXP_ITER] THEN DISCH_THEN MATCH_MP_TAC THEN + NUMBER_TAC);; + +let ORDER = prove + (`!n a. (a EXP (order(n) a) == 1) (mod n)`, + REWRITE_TAC[ORDER_DIVIDES; DIVIDES_REFL]);; + +let ORDER_MINIMAL = prove + (`!n a m. 0 < m /\ m < order(n) a ==> ~((a EXP m == 1) (mod n))`, + REWRITE_TAC[ORDER_DIVIDES] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_ARITH_TAC);; + +let ORDER_WORKS = prove + (`!n a. (a EXP (order(n) a) == 1) (mod n) /\ + !m. 0 < m /\ m < order(n) a ==> ~((a EXP m == 1) (mod n))`, + MESON_TAC[ORDER; ORDER_MINIMAL]);; + +let ORDER_1 = prove + (`!n. order n 1 = 1`, + REWRITE_TAC[GSYM DIVIDES_ONE; GSYM ORDER_DIVIDES; EXP_1; CONG_REFL]);; + +let ORDER_EQ_0 = prove + (`!n a. order(n) a = 0 <=> ~coprime(n,a)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FERMAT_LITTLE) THEN + ASM_REWRITE_TAC[ORDER_DIVIDES; DIVIDES_ZERO; PHI_EQ_0] THEN + ASM_MESON_TAC[COPRIME_0; ORDER_1; ARITH_RULE `~(1 = 0)`]; + MP_TAC(SPECL [`n:num`; `a:num`] ORDER) THEN + SPEC_TAC(`order n a`,`m:num`) THEN INDUCT_TAC THEN REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT + `~p ==> (q ==> p) ==> q ==> r`)) THEN + REWRITE_TAC[EXP] THEN CONV_TAC NUMBER_RULE]);; + +let ORDER_CONG = prove + (`!n a b. (a == b) (mod n) ==> order n a = order n b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[order] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_MESON_TAC[CONG_EXP; CONG_REFL; CONG_SYM; CONG_TRANS]);; + +let COPRIME_ORDER = prove + (`!n a. coprime(n,a) + ==> order(n) a > 0 /\ + (a EXP (order(n) a) == 1) (mod n) /\ + !m. 0 < m /\ m < order(n) a ==> ~((a EXP m == 1) (mod n))`, + SIMP_TAC[ARITH_RULE `n > 0 <=> ~(n = 0)`; ORDER_EQ_0] THEN + MESON_TAC[ORDER; ORDER_MINIMAL]);; + +let ORDER_DIVIDES_PHI = prove + (`!a n. coprime(n,a) ==> (order n a) divides (phi n)`, + MESON_TAC[ORDER_DIVIDES; FERMAT_LITTLE; COPRIME_SYM]);; + +let ORDER_DIVIDES_EXPDIFF = prove + (`!a n d e. coprime(n,a) + ==> ((a EXP d == a EXP e) (mod n) <=> (d == e) (mod (order n a)))`, + SUBGOAL_THEN + `!a n d e. coprime(n,a) /\ e <= d + ==> ((a EXP d == a EXP e) (mod n) <=> (d == e) (mod (order n a)))` + (fun th -> MESON_TAC[th; LE_CASES; CONG_SYM]) THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST1_TAC) THEN + SUBST1_TAC(ARITH_RULE `e = e + 0`) THEN + REWRITE_TAC[ARITH_RULE `(e + 0) + c = e + c`] THEN + REWRITE_TAC[EXP_ADD] THEN + ASM_SIMP_TAC[CONG_ADD_LCANCEL_EQ; COPRIME_EXP; + ONCE_REWRITE_RULE[COPRIME_SYM] CONG_MULT_LCANCEL_EQ] THEN + REWRITE_TAC[EXP; CONG_0_DIVIDES; ORDER_DIVIDES]);; + +let ORDER_UNIQUE = prove + (`!n a k. 0 < k /\ + (a EXP k == 1) (mod n) /\ + (!m. 0 < m /\ m < k ==> ~(a EXP m == 1) (mod n)) + ==> order n a = k`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `order n a`) THEN + MP_TAC(ISPECL [`n:num`; `a:num`] ORDER_WORKS) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `order n a = 0` THEN + ASM_REWRITE_TAC[] THENL [ALL_TAC; ASM_ARITH_TAC] THEN + FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [ORDER_EQ_0]) THEN + MP_TAC(ISPECL [`n:num`; `a:num`; `k:num`] COPRIME_REXP) THEN + ASM_SIMP_TAC[LE_1; LT] THEN + UNDISCH_TAC `(a EXP k == 1) (mod n)` THEN CONV_TAC NUMBER_RULE);; + +(* ------------------------------------------------------------------------- *) +(* Another trivial primality characterization. *) +(* ------------------------------------------------------------------------- *) + +let PRIME_PRIME_FACTOR = prove + (`!n. prime n <=> ~(n = 1) /\ !p. prime p /\ p divides n ==> (p = n)`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [prime] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [MESON_TAC[PRIME_1]; ALL_TAC] THEN + STRIP_TAC THEN X_GEN_TAC `d:num` THEN + ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o + MATCH_MP PRIME_FACTOR) THEN + ASM_MESON_TAC[DIVIDES_TRANS; DIVIDES_ANTISYM]);; + +let PRIME_DIVISOR_SQRT = prove + (`!n. prime(n) <=> ~(n = 1) /\ !d. d divides n /\ d EXP 2 <= n ==> (d = 1)`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [prime] THEN + ASM_CASES_TAC `n = 1` THEN ASM_SIMP_TAC[DIVIDES_ONE] THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[DIVIDES_0; LE; EXP_EQ_0; ARITH_EQ] THEN + MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a <=> b)`) THEN CONJ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `2`) THEN REWRITE_TAC[ARITH]; + DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[ARITH]]; + ALL_TAC] THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `d:num` THEN STRIP_TAC THENL + [ASM_CASES_TAC `d = n:num` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + UNDISCH_TAC `d EXP 2 <= n` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXP_2; ARITH_RULE `~(n * n <= n) <=> n * 1 < n * n`] THEN + ASM_REWRITE_TAC[LT_MULT_LCANCEL] THEN + MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `d divides n` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `d EXP 2 <= d * e \/ e EXP 2 <= d * e` MP_TAC THENL + [REWRITE_TAC[EXP_2; LE_MULT_LCANCEL; LE_MULT_RCANCEL] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `d:num`); + FIRST_X_ASSUM(MP_TAC o SPEC `e:num`)] THEN + ASM_SIMP_TAC[DIVIDES_RMUL; DIVIDES_LMUL; DIVIDES_REFL; MULT_CLAUSES]);; + +let PRIME_PRIME_FACTOR_SQRT = prove + (`!n. prime n <=> + ~(n = 0) /\ ~(n = 1) /\ ~(?p. prime p /\ p divides n /\ p EXP 2 <= n)`, + GEN_TAC THEN ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + GEN_REWRITE_TAC LAND_CONV [PRIME_DIVISOR_SQRT] THEN + EQ_TAC THENL [MESON_TAC[PRIME_1]; ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `d = 1` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `d EXP 2` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[num_CONV `2`; EXP_MONO_LE_SUC] THEN + ASM_MESON_TAC[DIVIDES_LE; DIVIDES_ZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Pocklington theorem. *) +(* ------------------------------------------------------------------------- *) + +let POCKLINGTON_LEMMA = prove + (`!a n q r. + 2 <= n /\ (n - 1 = q * r) /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!p. prime(p) /\ p divides q + ==> coprime(a EXP ((n - 1) DIV p) - 1,n)) + ==> !p. prime p /\ p divides n ==> (p == 1) (mod q)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `order p (a EXP r) = q` ASSUME_TAC THENL + [ALL_TAC; + SUBGOAL_THEN `coprime(a EXP r,p)` (MP_TAC o MATCH_MP FERMAT_LITTLE) THENL + [ALL_TAC; + ASM_REWRITE_TAC[ORDER_DIVIDES] THEN + SUBGOAL_THEN `phi p = p - 1` SUBST1_TAC THENL + [ASM_MESON_TAC[PHI_PRIME_EQ]; ALL_TAC] THEN + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(p - 1 = q * d) ==> ~(p = 0) ==> (p + q * 0 = 1 + q * d)`)) THEN + REWRITE_TAC[nat_mod; cong] THEN ASM_MESON_TAC[PRIME_0]] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN + UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[coprime; NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `d = p:num` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[prime]; ALL_TAC] THEN + SUBGOAL_THEN `p divides (a EXP (n - 1))` ASSUME_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `2 <= n ==> (n - 1 = SUC(n - 2))`)) THEN + REWRITE_TAC[EXP] THEN ASM_SIMP_TAC[DIVIDES_RMUL]; + ALL_TAC] THEN + REWRITE_TAC[cong; nat_mod] THEN + SUBGOAL_THEN `~(p divides 1)` MP_TAC THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN + ASM_MESON_TAC[DIVIDES_RMUL; DIVIDES_ADD; DIVIDES_ADD_REVL]] THEN + SUBGOAL_THEN `(order p (a EXP r)) divides q` MP_TAC THENL + [REWRITE_TAC[GSYM ORDER_DIVIDES; EXP_EXP] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[cong; nat_mod] THEN MESON_TAC[MULT_AC]; + ALL_TAC] THEN + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN + ASM_CASES_TAC `d = 1` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `P:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `P divides q` ASSUME_TAC THENL + [ASM_MESON_TAC[DIVIDES_LMUL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `P:num`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + UNDISCH_TAC `P divides q` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + SUBGOAL_THEN `~(P = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + ASM_SIMP_TAC[DIV_MULT] THEN + UNDISCH_TAC `P divides d` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `order p (a EXP r) * P * t = P * s` THEN + ONCE_REWRITE_TAC[ARITH_RULE + `(a * p * b = p * c) <=> (p * a * b = p * c)`] THEN + REWRITE_TAC[EQ_MULT_LCANCEL] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN REWRITE_TAC[coprime] THEN + DISCH_THEN(MP_TAC o SPEC `p:num`) THEN REWRITE_TAC[NOT_IMP] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PRIME_1]] THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[AC MULT_AC `(d * t) * r = r * d * t`] THEN + REWRITE_TAC[EXP_MULT] THEN + MATCH_MP_TAC CONG_1_DIVIDES THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `1 EXP t` THEN + SIMP_TAC[CONG_EXP; ORDER] THEN REWRITE_TAC[EXP_ONE; CONG_REFL]);; + +let POCKLINGTON = prove + (`!a n q r. + 2 <= n /\ (n - 1 = q * r) /\ n <= q EXP 2 /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!p. prime(p) /\ p divides q + ==> coprime(a EXP ((n - 1) DIV p) - 1,n)) + ==> prime(n)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[PRIME_PRIME_FACTOR_SQRT] THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 0) /\ ~(n = 1)`] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`a:num`; `n:num`; `q:num`; `r:num`] POCKLINGTON_LEMMA) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `p EXP 2 <= q EXP 2` MP_TAC THENL + [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN + REWRITE_TAC[num_CONV `2`; EXP_MONO_LE_SUC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONG_1_DIVIDES) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Variant for application, to separate the exponentiation. *) +(* ------------------------------------------------------------------------- *) + +let POCKLINGTON_ALT = prove + (`!a n q r. + 2 <= n /\ (n - 1 = q * r) /\ n <= q EXP 2 /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!p. prime(p) /\ p divides q + ==> ?b. (a EXP ((n - 1) DIV p) == b) (mod n) /\ + coprime(b - 1,n)) + ==> prime(n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POCKLINGTON THEN + MAP_EVERY EXISTS_TAC [`a:num`; `q:num`; `r:num`] THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `p:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(a EXP ((q * r) DIV p) - 1 == b - 1) (mod n)` + (fun th -> ASM_MESON_TAC[CONG_COPRIME; COPRIME_SYM; th]) THEN + MATCH_MP_TAC CONG_SUB THEN ASM_REWRITE_TAC[CONG_REFL] THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; EXP_EQ_0] THEN + SUBGOAL_THEN `~(a = 0)` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN + SIMP_TAC[ARITH_RULE `2 <= n ==> (n - 1 = SUC(n - 2))`; + ASSUME `a = 0`; ASSUME `2 <= n`] THEN + REWRITE_TAC[MULT_CLAUSES; EXP] THEN + ONCE_REWRITE_TAC[CONG_SYM] THEN + REWRITE_TAC[CONG_0_DIVIDES; DIVIDES_ONE] THEN + UNDISCH_TAC `2 <= n` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(a EXP ((q * r) DIV p) == b) (mod n)` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CONG_0_DIVIDES] THEN + SUBGOAL_THEN `~(n divides (a EXP (n - 1)))` MP_TAC THENL + [ASM_MESON_TAC[CONG_DIVIDES; DIVIDES_ONE; ARITH_RULE `~(2 <= 1)`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN UNDISCH_TAC `p divides q` THEN + GEN_REWRITE_TAC LAND_CONV [divides] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + ASM_SIMP_TAC[DIV_MULT] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EXP_MULT] THEN + SUBGOAL_THEN `p = SUC(p - 1)` SUBST1_TAC THENL + [UNDISCH_TAC `~(p = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXP; DIVIDES_RMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Prime factorizations. *) +(* ------------------------------------------------------------------------- *) + +let primefact = new_definition + `primefact ps n <=> (ITLIST (*) ps 1 = n) /\ !p. MEM p ps ==> prime(p)`;; + +let PRIMEFACT = prove + (`!n. ~(n = 0) ==> ?ps. primefact ps n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THENL + [REPEAT DISCH_TAC THEN EXISTS_TAC `[]:num list` THEN + REWRITE_TAC[primefact; ITLIST; MEM]; ALL_TAC] THEN + DISCH_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o + MATCH_MP PRIME_FACTOR) THEN + UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + UNDISCH_TAC `~(p * m = 0)` THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN + GEN_REWRITE_TAC (funpow 3 LAND_CONV) [ARITH_RULE `n = 1 * n`] THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + SUBGOAL_THEN `1 < p` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC(ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 1 < p`) THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `prime p` THEN + ASM_REWRITE_TAC[PRIME_0; PRIME_1]; ALL_TAC] THEN + REWRITE_TAC[primefact] THEN + DISCH_THEN(X_CHOOSE_THEN `ps:num list` ASSUME_TAC) THEN + EXISTS_TAC `CONS (p:num) ps` THEN + ASM_REWRITE_TAC[MEM; ITLIST] THEN ASM_MESON_TAC[]);; + +let PRIMAFACT_CONTAINS = prove + (`!ps n. primefact ps n ==> !p. prime p /\ p divides n ==> MEM p ps`, + REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + POP_ASSUM(SUBST1_TAC o SYM) THEN + SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ITLIST; MEM] THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN + STRIP_TAC THEN GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN + DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN + ASM_MESON_TAC[prime; PRIME_1]);; + +let PRIMEFACT_VARIANT = prove + (`!ps n. primefact ps n <=> (ITLIST (*) ps 1 = n) /\ ALL prime ps`, + REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN AP_TERM_TAC THEN + SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[MEM; ALL] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Variant of Lucas theorem. *) +(* ------------------------------------------------------------------------- *) + +let LUCAS_PRIMEFACT = prove + (`2 <= n /\ + (a EXP (n - 1) == 1) (mod n) /\ + (ITLIST (*) ps 1 = n - 1) /\ + ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps + ==> prime n`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LUCAS THEN + EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `primefact ps (n - 1)` MP_TAC THENL + [ASM_REWRITE_TAC[PRIMEFACT_VARIANT] THEN MATCH_MP_TAC ALL_IMP THEN + EXISTS_TAC `\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)` THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP PRIMAFACT_CONTAINS) THEN + X_GEN_TAC `p:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN UNDISCH_TAC + `ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps` THEN + SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN + SIMP_TAC[ALL; MEM] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Variant of Pocklington theorem. *) +(* ------------------------------------------------------------------------- *) + +let POCKLINGTON_PRIMEFACT = prove + (`2 <= n /\ (q * r = n - 1) /\ n <= q * q + ==> ((a EXP r) MOD n = b) + ==> (ITLIST (*) ps 1 = q) + ==> ((b EXP q) MOD n = 1) + ==> ALL (\p. prime p /\ + coprime((b EXP (q DIV p)) MOD n - 1,n)) ps + ==> prime n`, + DISCH_THEN(fun th -> DISCH_THEN(SUBST1_TAC o SYM) THEN MP_TAC th) THEN + SIMP_TAC[MOD_EXP_MOD; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] EXP_EXP] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC POCKLINGTON THEN + MAP_EVERY EXISTS_TAC [`a:num`; `q:num`; `r:num`] THEN + ASM_REWRITE_TAC[EXP_2] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`a EXP (n - 1)`; `n:num`] DIVISION) THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + STRIP_TAC THEN ABBREV_TAC `Q = a EXP (n - 1) DIV n` THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[cong; nat_mod] THEN + MAP_EVERY EXISTS_TAC [`0`; `Q:num`] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `primefact ps q` MP_TAC THENL + [ASM_REWRITE_TAC[PRIMEFACT_VARIANT] THEN MATCH_MP_TAC ALL_IMP THEN + EXISTS_TAC `\p. prime p /\ coprime(a EXP (q DIV p * r) MOD n - 1,n)` THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP PRIMAFACT_CONTAINS) THEN + X_GEN_TAC `p:num` THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM ALL_MEM]) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> a /\ b ==> c`) THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN + SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + SUBGOAL_THEN `q DIV p * r = (n - 1) DIV p` SUBST1_TAC THENL + [UNDISCH_TAC `p divides q` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + UNDISCH_THEN `(p * d) * r = n - 1` (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[DIV_MULT; GSYM MULT_ASSOC]; + ALL_TAC] THEN + MATCH_MP_TAC CONG_COPRIME THEN MATCH_MP_TAC CONG_SUB THEN + ASM_SIMP_TAC[CONG_MOD; ARITH_RULE `2 <= n ==> ~(n = 0)`; CONG_REFL] THEN + MATCH_MP_TAC(ARITH_RULE `a <= b /\ ~(a = 0) ==> 1 <= a /\ 1 <= b`) THEN + ASM_SIMP_TAC[MOD_LE; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + ASM_SIMP_TAC[MOD_EQ_0; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o C AP_THM `p:num` o AP_TERM `(EXP)`) THEN + REWRITE_TAC[EXP_EXP] THEN + SUBGOAL_THEN `(n - 1) DIV p * p = n - 1` SUBST1_TAC THENL + [SUBST1_TAC(SYM(ASSUME `q * r = n - 1`)) THEN + UNDISCH_TAC `p divides q` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + ASM_MESON_TAC[DIV_MULT; MULT_AC; PRIME_0]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o C AP_THM `n:num` o AP_TERM `(MOD)`) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(p = 0) ==> (p = SUC(p - 1))`)) THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN + ASM_SIMP_TAC[MOD_MULT; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + REWRITE_TAC[ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Utility functions. *) +(* ------------------------------------------------------------------------- *) + +let even_num n = + mod_num n num_2 =/ num_0;; + +let odd_num = not o even_num;; + +(* ------------------------------------------------------------------------- *) +(* Least p >= 0 with x <= 2^p. *) +(* ------------------------------------------------------------------------- *) + +let log2 = + let rec log2 x y = + if x log2 (x -/ num_1) num_0;; + +(* ------------------------------------------------------------------------- *) +(* Raise number to power (x^m) modulo n. *) +(* ------------------------------------------------------------------------- *) + +let rec powermod x m n = + if m =/ num_0 then num_1 else + let y = powermod x (quo_num m num_2) n in + let z = mod_num (y */ y) n in + if even_num m then z else + mod_num (x */ z) n;; + +(* ------------------------------------------------------------------------- *) +(* Make a call to PARI/GP to factor a number into (probable) primes. *) +(* ------------------------------------------------------------------------- *) + +let factor = + let suck_file s = let data = string_of_file s in Sys.remove s; data in + let extract_output s = + let l0 = explode s in + let l0' = rev l0 in + let l1 = snd(chop_list(index "]" l0') l0') in + let l2 = "["::rev(fst(chop_list(index "[" l1) l1)) in + let tm = parse_term (implode l2) in + map ((dest_numeral F_F dest_numeral) o dest_pair) (dest_list tm) in + fun n -> + if n =/ num_1 then [] else + let filename = Filename.temp_file "pocklington" ".out" in + let s = "echo 'print(factorint(" ^ + (string_of_num n) ^ + ")) \n quit' | gp >" ^ filename ^ " 2>/dev/null" in + if Sys.command s = 0 then + let output = suck_file filename in + extract_output output + else + failwith "factor: Call to GP/PARI failed";; + +(* ------------------------------------------------------------------------- *) +(* Alternative giving multiset instead of set plus indices. *) +(* Also just use a stupid algorithm for small enough numbers or if PARI/GP *) +(* is not installed. I should really write a better factoring algorithm. *) +(* ------------------------------------------------------------------------- *) + +let PARI_THRESHOLD = pow2 25;; + +let multifactor = + let rec findfactor m n = + if mod_num n m =/ num_0 then m + else if m */ m >/ n then n + else findfactor (m +/ num_1) n in + let rec stupidfactor n = + let p = findfactor num_2 n in + if p =/ n then [n] else p::(stupidfactor(quo_num n p)) in + let rec multilist l = + if l = [] then [] else + let (x,n) = hd l in + replicate x (Num.int_of_num n) @ multilist (tl l) in + fun n -> try if n sort ( powermod a k n <>/ num_1) ms + then a + else find_primitive_root (a +/ num_1) m ms n in + let find_primitive_root_from_2 = find_primitive_root num_2 in + fun m ms n -> + if n raise Unchanged + | (h::t) -> if x =/ h then + try uniq x t + with Unchanged -> l + else x::(uniq h t) in + fun l -> if l = [] then [] else uniq (hd l) (tl l);; + +let setify_num s = + let s' = sort (<=/) s in + try uniq_num s' with Unchanged -> s';; + +let certify_prime = + let rec cert_prime n = + if n <=/ num_2 then + if n =/ num_2 then Prime_2 + else failwith "certify_prime: not a prime!" + else + let m = n -/ num_1 in + let pfact = multifactor m in + let primes = setify_num pfact in + let ms = map (fun d -> div_num m d) primes in + let a = find_primitive_root m ms n in + Primroot_and_factors((n,pfact),a,map (fun n -> n,cert_prime n) primes) in + fun n -> if length(multifactor n) = 1 then cert_prime n + else failwith "certify_prime: input is not a prime";; + +(* ------------------------------------------------------------------------- *) +(* Relatively efficient evaluation of "(a EXP k) MOD n". *) +(* ------------------------------------------------------------------------- *) + +let EXP_MOD_CONV = + let pth = prove + (`~(n = 0) + ==> ((a EXP 0) MOD n = 1 MOD n) /\ + ((a EXP (NUMERAL (BIT0 m))) MOD n = + let b = (a EXP (NUMERAL m)) MOD n in + (b * b) MOD n) /\ + ((a EXP (NUMERAL (BIT1 m))) MOD n = + let b = (a EXP (NUMERAL m)) MOD n in + (a * ((b * b) MOD n)) MOD n)`, + DISCH_TAC THEN REWRITE_TAC[EXP] THEN + REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN + REWRITE_TAC[EXP; EXP_ADD] THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN + REWRITE_TAC[MULT_ASSOC] THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[MULT_ASSOC] THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD]) + and pth_cong = SPEC_ALL CONG + and n_tm = `n:num` in + fun tm -> + let ntm = rand tm in + let th1 = INST [ntm,n_tm] pth in + let th2 = EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1)))) in + let th_base,th_steps = CONJ_PAIR(MP th1 th2) in + let conv_base = GEN_REWRITE_CONV I [th_base] + and conv_step = GEN_REWRITE_CONV I [th_steps] in + let rec conv tm = + try conv_base tm with Failure _ -> + (conv_step THENC + RAND_CONV conv THENC + let_CONV THENC + NUM_REDUCE_CONV) tm in + conv tm;; + +(* ------------------------------------------------------------------------- *) +(* HOL checking of primality certificate, using Pocklington shortcut. *) +(* ------------------------------------------------------------------------- *) + +let prime_theorem_cache = ref [];; + +let rec lookup_under_num n l = + if l = [] then failwith "lookup_under_num" else + let h = hd l in + if fst h =/ n then snd h + else lookup_under_num n (tl l);; + +let rec split_factors q qs ps n = + if q */ q >=/ n then rev qs,ps + else split_factors (q */ hd ps) (hd ps :: qs) (tl ps) n;; + +let check_certificate = + let n_tm = `n:num` + and a_tm = `a:num` + and q_tm = `q:num` + and r_tm = `r:num` + and b_tm = `b:num` + and ps_tm = `ps:num list` + and conv_itlist = + GEN_REWRITE_CONV TOP_DEPTH_CONV [ITLIST] THENC NUM_REDUCE_CONV + and conv_all = + GEN_REWRITE_CONV TOP_DEPTH_CONV + [ALL; BETA_THM; TAUT `a /\ T <=> a`] THENC + GEN_REWRITE_CONV DEPTH_CONV + [TAUT `(a /\ a /\ b <=> a /\ b) /\ (a /\ a <=> a)`] + and subarith_conv = + let gconv_net = itlist (uncurry net_of_conv) + [`a - b`,NUM_SUB_CONV; + `a DIV b`,NUM_DIV_CONV; + `(a EXP b) MOD c`,EXP_MOD_CONV; + `coprime(a,b)`,COPRIME_CONV; + `p /\ T`,REWR_CONV(TAUT `p /\ T <=> p`); + `T /\ p`,REWR_CONV(TAUT `T /\ p <=> p`)] + empty_net in + DEPTH_CONV(REWRITES_CONV gconv_net) in + let rec check_certificate cert = + match cert with + Prime_2 -> + PRIME_2 + | Primroot_and_factors((n,ps),a,ncerts) -> + try lookup_under_num n (!prime_theorem_cache) with Failure _ -> + let qs,rs = split_factors num_1 [] (rev ps) n in + let q = itlist ( */ ) qs num_1 + and r = itlist ( */ ) rs num_1 in + let th1 = INST [mk_numeral n,n_tm; + mk_flist (map mk_numeral qs),ps_tm; + mk_numeral q,q_tm; + mk_numeral r,r_tm; + mk_numeral a,a_tm] + POCKLINGTON_PRIMEFACT in + let th2 = MP th1 (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th1)))) in + let tha = EXP_MOD_CONV(lhand(lhand(concl th2))) in + let thb = MP (INST [rand(concl tha),b_tm] th2) tha in + let th3 = MP thb (EQT_ELIM(conv_itlist (lhand(concl thb)))) in + let th4 = MP th3 (EXP_MOD_CONV (lhand(lhand(concl th3)))) in + let th5 = conv_all(lhand(concl th4)) in + let th6 = TRANS th5 (subarith_conv(rand(concl th5))) in + let th7 = IMP_TRANS (snd(EQ_IMP_RULE th6)) th4 in + let ants = conjuncts(lhand(concl th7)) in + let certs = + map (fun t -> lookup_under_num (dest_numeral(rand t)) ncerts) + ants in + let ths = map check_certificate certs in + let fth = MP th7 (end_itlist CONJ ths) in + prime_theorem_cache := (n,fth)::(!prime_theorem_cache); fth in + check_certificate;; + +(* ------------------------------------------------------------------------- *) +(* Hence a primality-proving rule. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_PRIME = check_certificate o certify_prime;; + +(* ------------------------------------------------------------------------- *) +(* Rule to generate prime factorization theorems. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_PRIMEFACT = + let pth = SPEC_ALL PRIMEFACT_VARIANT + and start_CONV = PURE_REWRITE_CONV[ITLIST; ALL] THENC NUM_REDUCE_CONV + and ps_tm = `ps:num list` + and n_tm = `n:num` in + fun n -> + let pfact = multifactor n in + let th1 = INST [mk_flist(map mk_numeral pfact),ps_tm; + mk_numeral n,n_tm] pth in + let th2 = TRANS th1 (start_CONV(rand(concl th1))) in + let ths = map PROVE_PRIME pfact in + EQ_MP (SYM th2) (end_itlist CONJ ths);; + +(* ------------------------------------------------------------------------- *) +(* Conversion for truth or falsity of primality assertion. *) +(* ------------------------------------------------------------------------- *) + +let PRIME_TEST = + let NOT_PRIME_THM = prove + (`((m = 1) <=> F) ==> ((m = p) <=> F) ==> (m * n = p) ==> (prime(p) <=> F)`, + MESON_TAC[prime; divides]) + and m_tm = `m:num` and n_tm = `n:num` and p_tm = `p:num` in + fun tm -> + let p = dest_numeral tm in + if p =/ num_0 then EQF_INTRO PRIME_0 + else if p =/ num_1 then EQF_INTRO PRIME_1 else + let pfact = multifactor p in + if length pfact = 1 then + (remark ("proving that " ^ string_of_num p ^ " is prime"); + EQT_INTRO(PROVE_PRIME p)) + else + (remark ("proving that " ^ string_of_num p ^ " is composite"); + let m = hd pfact and n = end_itlist ( */ ) (tl pfact) in + let th0 = INST [mk_numeral m,m_tm; mk_numeral n,n_tm; mk_numeral p,p_tm] + NOT_PRIME_THM in + let th1 = MP th0 (NUM_EQ_CONV (lhand(lhand(concl th0)))) in + let th2 = MP th1 (NUM_EQ_CONV (lhand(lhand(concl th1)))) in + MP th2 (NUM_MULT_CONV(lhand(lhand(concl th2)))));; + +let PRIME_CONV = + let prime_tm = `prime` in + fun tm0 -> + let ptm,tm = dest_comb tm0 in + if ptm <> prime_tm then failwith "expected term of form prime(n)" + else PRIME_TEST tm;; + +(* ------------------------------------------------------------------------- *) +(* Another lemma. *) +(* ------------------------------------------------------------------------- *) + +let PRIME_POWER_EXISTS = prove + (`!q. prime q + ==> ((?i. n = q EXP i) <=> + (!p. prime p /\ p divides n ==> p = q))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[IMP_CONJ; PRIME_DIVEXP_EQ; DIVIDES_PRIME_PRIME] THEN + ASM_CASES_TAC `n = 0` THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `2` th) THEN MP_TAC(SPEC `3` th)) THEN + ASM_REWRITE_TAC[PRIME_2; PRIME_CONV `prime 3`; DIVIDES_0] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[EXP]; ALL_TAC] THEN + MP_TAC(ISPEC `n:num` PRIMEPOW_FACTOR) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN + ASM_CASES_TAC `p:num = q` THENL + [FIRST_X_ASSUM(SUBST_ALL_TAC o SYM); + ASM_MESON_TAC[DIVIDES_REXP; LE_1; DIVIDES_RMUL; DIVIDES_REFL]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC(NUM_RING `m = 1 ==> x * m = x`) THEN + MATCH_MP_TAC(ARITH_RULE `~(m = 0) /\ ~(2 <= m) ==> m = 1`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[COPRIME_0; PRIME_1]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP PRIMEPOW_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `r:num`) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REXP; LE_1; DIVIDES_REFL]; + DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_RMUL]) THEN + ASM_SIMP_TAC[COPRIME_REXP; LE_1; COPRIME_REFL] THEN + ASM_MESON_TAC[PRIME_1]]);; + +(* ------------------------------------------------------------------------- *) +(* Example. *) +(* ------------------------------------------------------------------------- *) + +map (time PRIME_TEST o mk_small_numeral) (0--50);; + +time PRIME_TEST `65535`;; + +time PRIME_TEST `65536`;; + +time PRIME_TEST `65537`;; + +time PROVE_PRIMEFACT (Int 222);; + +time PROVE_PRIMEFACT (Int 151);; + +(* ------------------------------------------------------------------------- *) +(* The "Landau trick" in Erdos's proof of Chebyshev-Bertrand theorem. *) +(* ------------------------------------------------------------------------- *) + +map (time PRIME_TEST o mk_small_numeral) + [3; 5; 7; 13; 23; 43; 83; 163; 317; 631; 1259; 2503; 4001];; diff --git a/Library/poly.ml b/Library/poly.ml new file mode 100644 index 0000000..4a3018e --- /dev/null +++ b/Library/poly.ml @@ -0,0 +1,1690 @@ +(* ========================================================================= *) +(* Properties of real polynomials (not canonically represented). *) +(* ========================================================================= *) + +needs "Library/analysis.ml";; + +prioritize_real();; + +parse_as_infix("++",(16,"right"));; +parse_as_infix("**",(20,"right"));; +parse_as_infix("##",(20,"right"));; +parse_as_infix("divides",(14,"right"));; +parse_as_infix("exp",(22,"right"));; + +do_list override_interface + ["++",`poly_add:real list->real list->real list`; + "**",`poly_mul:real list->real list->real list`; + "##",`poly_cmul:real->real list->real list`; + "neg",`poly_neg:real list->real list`; + "exp",`poly_exp:real list -> num -> real list`; + "diff",`poly_diff:real list->real list`];; + +overload_interface ("divides",`poly_divides:real list->real list->bool`);; + +(* ------------------------------------------------------------------------- *) +(* Application of polynomial as a real function. *) +(* ------------------------------------------------------------------------- *) + +let poly = new_recursive_definition list_RECURSION + `(poly [] x = &0) /\ + (poly (CONS h t) x = h + x * poly t x)`;; + +let POLY_CONST = prove + (`!c x. poly [c] x = c`, + REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; + +let POLY_X = prove + (`!c x. poly [&0; &1] x = x`, + REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations on polynomials. *) +(* ------------------------------------------------------------------------- *) + +let poly_add = new_recursive_definition list_RECURSION + `([] ++ l2 = l2) /\ + ((CONS h t) ++ l2 = + (if l2 = [] then CONS h t + else CONS (h + HD l2) (t ++ TL l2)))`;; + +let poly_cmul = new_recursive_definition list_RECURSION + `(c ## [] = []) /\ + (c ## (CONS h t) = CONS (c * h) (c ## t))`;; + +let poly_neg = new_definition + `neg = (##) (--(&1))`;; + +let poly_mul = new_recursive_definition list_RECURSION + `([] ** l2 = []) /\ + ((CONS h t) ** l2 = + (if t = [] then h ## l2 + else (h ## l2) ++ CONS (&0) (t ** l2)))`;; + +let poly_exp = new_recursive_definition num_RECURSION + `(p exp 0 = [&1]) /\ + (p exp (SUC n) = p ** p exp n)`;; + +(* ------------------------------------------------------------------------- *) +(* Differentiation of polynomials (needs an auxiliary function). *) +(* ------------------------------------------------------------------------- *) + +let poly_diff_aux = new_recursive_definition list_RECURSION + `(poly_diff_aux n [] = []) /\ + (poly_diff_aux n (CONS h t) = CONS (&n * h) (poly_diff_aux (SUC n) t))`;; + +let poly_diff = new_definition + `diff l = (if l = [] then [] else (poly_diff_aux 1 (TL l)))`;; + +(* ------------------------------------------------------------------------- *) +(* Lengths. *) +(* ------------------------------------------------------------------------- *) + +let LENGTH_POLY_DIFF_AUX = prove + (`!l n. LENGTH(poly_diff_aux n l) = LENGTH l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; poly_diff_aux]);; + +let LENGTH_POLY_DIFF = prove + (`!l. LENGTH(poly_diff l) = PRE(LENGTH l)`, + LIST_INDUCT_TAC THEN + SIMP_TAC[poly_diff; LENGTH; LENGTH_POLY_DIFF_AUX; NOT_CONS_NIL; TL; PRE]);; + +(* ------------------------------------------------------------------------- *) +(* Useful clausifications. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD_CLAUSES = prove + (`([] ++ p2 = p2) /\ + (p1 ++ [] = p1) /\ + ((CONS h1 t1) ++ (CONS h2 t2) = CONS (h1 + h2) (t1 ++ t2))`, + REWRITE_TAC[poly_add; NOT_CONS_NIL; HD; TL] THEN + SPEC_TAC(`p1:real list`,`p1:real list`) THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly_add]);; + +let POLY_CMUL_CLAUSES = prove + (`(c ## [] = []) /\ + (c ## (CONS h t) = CONS (c * h) (c ## t))`, + REWRITE_TAC[poly_cmul]);; + +let POLY_NEG_CLAUSES = prove + (`(neg [] = []) /\ + (neg (CONS h t) = CONS (--h) (neg t))`, + REWRITE_TAC[poly_neg; POLY_CMUL_CLAUSES; REAL_MUL_LNEG; REAL_MUL_LID]);; + +let POLY_MUL_CLAUSES = prove + (`([] ** p2 = []) /\ + ([h1] ** p2 = h1 ## p2) /\ + ((CONS h1 (CONS k1 t1)) ** p2 = h1 ## p2 ++ CONS (&0) (CONS k1 t1 ** p2))`, + REWRITE_TAC[poly_mul; NOT_CONS_NIL]);; + +let POLY_DIFF_CLAUSES = prove + (`(diff [] = []) /\ + (diff [c] = []) /\ + (diff (CONS h t) = poly_diff_aux 1 t)`, + REWRITE_TAC[poly_diff; NOT_CONS_NIL; HD; TL; poly_diff_aux]);; + +(* ------------------------------------------------------------------------- *) +(* Various natural consequences of syntactic definitions. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD = prove + (`!p1 p2 x. poly (p1 ++ p2) x = poly p1 x + poly p2 x`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_add; poly; REAL_ADD_LID] THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[NOT_CONS_NIL; HD; TL; poly; REAL_ADD_RID] THEN + REAL_ARITH_TAC);; + +let POLY_CMUL = prove + (`!p c x. poly (c ## p) x = c * poly p x`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[poly; poly_cmul] THEN + REAL_ARITH_TAC);; + +let POLY_NEG = prove + (`!p x. poly (neg p) x = --(poly p x)`, + REWRITE_TAC[poly_neg; POLY_CMUL] THEN + REAL_ARITH_TAC);; + +let POLY_MUL = prove + (`!x p1 p2. poly (p1 ** p2) x = poly p1 x * poly p2 x`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[poly_mul; poly; REAL_MUL_LZERO; POLY_CMUL; POLY_ADD] THEN + SPEC_TAC(`h:real`,`h:real`) THEN + SPEC_TAC(`t:real list`,`t:real list`) THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC[poly_mul; POLY_CMUL; POLY_ADD; poly; POLY_CMUL; + REAL_MUL_RZERO; REAL_ADD_RID; NOT_CONS_NIL] THEN + ASM_REWRITE_TAC[POLY_ADD; POLY_CMUL; poly] THEN + REAL_ARITH_TAC);; + +let POLY_EXP = prove + (`!p n x. poly (p exp n) x = (poly p x) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[poly_exp; real_pow; POLY_MUL] THEN + REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The derivative is a bit more complicated. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DIFF_LEMMA = prove + (`!l n x. ((\x. (x pow (SUC n)) * poly l x) diffl + ((x pow n) * poly (poly_diff_aux (SUC n) l) x))(x)`, + LIST_INDUCT_TAC THEN + REWRITE_TAC[poly; poly_diff_aux; REAL_MUL_RZERO; DIFF_CONST] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN + REWRITE_TAC[REAL_LDISTRIB; REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 pow))] THEN + POP_ASSUM(MP_TAC o SPECL [`SUC n`; `x:real`]) THEN + SUBGOAL_THEN `(((\x. (x pow (SUC n)) * h)) diffl + ((x pow n) * &(SUC n) * h))(x)` + (fun th -> DISCH_THEN(MP_TAC o CONJ th)) THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(SPEC `\x. x pow (SUC n)` DIFF_CMUL) THEN BETA_TAC THEN + DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(SPEC `SUC n` DIFF_POW) THEN REWRITE_TAC[SUC_SUB1] THEN + DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[REAL_MUL_SYM]); + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC]]);; + +let POLY_DIFF = prove + (`!l x. ((\x. poly l x) diffl (poly (diff l) x))(x)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[POLY_DIFF_CLAUSES] THEN + ONCE_REWRITE_TAC[SYM(ETA_CONV `\x. poly l x`)] THEN + REWRITE_TAC[poly; DIFF_CONST] THEN + MAP_EVERY X_GEN_TAC [`x:real`] THEN + MP_TAC(SPECL [`t:(real)list`; `0`; `x:real`] POLY_DIFF_LEMMA) THEN + REWRITE_TAC[SYM(num_CONV `1`)] THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN + REWRITE_TAC[POW_1] THEN + DISCH_THEN(MP_TAC o CONJ (SPECL [`h:real`; `x:real`] DIFF_CONST)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN + REWRITE_TAC[REAL_ADD_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Trivial consequences. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DIFFERENTIABLE = prove + (`!l x. (\x. poly l x) differentiable x`, + REPEAT GEN_TAC THEN REWRITE_TAC[differentiable] THEN + EXISTS_TAC `poly (diff l) x` THEN + REWRITE_TAC[POLY_DIFF]);; + +let POLY_CONT = prove + (`!l x. (\x. poly l x) contl x`, + REPEAT GEN_TAC THEN MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `poly (diff l) x` THEN + MATCH_ACCEPT_TAC POLY_DIFF);; + +let POLY_IVT_POS = prove + (`!p a b. a < b /\ poly p a < &0 /\ poly p b > &0 + ==> ?x. a < x /\ x < b /\ (poly p x = &0)`, + REWRITE_TAC[real_gt] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x. poly p x`; `a:real`; `b:real`; `&0`] IVT) THEN + REWRITE_TAC[POLY_CONT] THEN + EVERY_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE th]) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN + CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_REFL]) THEN + FIRST_ASSUM CONTR_TAC);; + +let POLY_IVT_NEG = prove + (`!p a b. a < b /\ poly p a > &0 /\ poly p b < &0 + ==> ?x. a < x /\ x < b /\ (poly p x = &0)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `poly_neg p` POLY_IVT_POS) THEN + REWRITE_TAC[POLY_NEG; + REAL_ARITH `(--x < &0 <=> x > &0) /\ (--x > &0 <=> x < &0)`] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN + ASM_REWRITE_TAC[REAL_ARITH `(--x = &0) <=> (x = &0)`]);; + +let POLY_MVT = prove + (`!p a b. a < b ==> + ?x. a < x /\ x < b /\ + (poly p b - poly p a = (b - a) * poly (diff p) x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`poly p`; `a:real`; `b:real`] MVT) THEN + ASM_REWRITE_TAC[CONV_RULE(DEPTH_CONV ETA_CONV) (SPEC_ALL POLY_CONT); + CONV_RULE(DEPTH_CONV ETA_CONV) (SPEC_ALL POLY_DIFFERENTIABLE)] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN MATCH_MP_TAC DIFF_UNIQ THEN + EXISTS_TAC `poly p` THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[CONV_RULE(DEPTH_CONV ETA_CONV) (SPEC_ALL POLY_DIFF)]);; + +let POLY_MVT_ADD = prove + (`!p a x. ?y. abs(y) <= abs(x) /\ + (poly p (a + x) = poly p a + x * poly (diff p) (a + y))`, + REPEAT GEN_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THENL + [EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_RID; REAL_MUL_LZERO]; + MP_TAC(SPECL [`p:real list`; `a:real`; `a + x`] POLY_MVT) THEN + ASM_REWRITE_TAC[REAL_LT_ADDR] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN + REWRITE_TAC[REAL_ARITH `(x - y = ((a + b) - a) * z) <=> + (x = y + b * z)`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN + EXISTS_TAC `z - a` THEN REWRITE_TAC[REAL_ARITH `x + (y - x) = y`] THEN + MAP_EVERY UNDISCH_TAC [`&0 < x`; `a < z`; `z < a + x`] THEN + REAL_ARITH_TAC; + MP_TAC(SPECL [`p:real list`; `a + x`; `a:real`] POLY_MVT) THEN + ASM_REWRITE_TAC[REAL_ARITH `a + x < a <=> &0 < --x`] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN + REWRITE_TAC[REAL_ARITH `(x - y = (a - (a + b)) * z) <=> + (x = y + b * --z)`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN + EXISTS_TAC `z - a` THEN REWRITE_TAC[REAL_ARITH `x + (y - x) = y`] THEN + MAP_EVERY UNDISCH_TAC [`&0 < --x`; `a + x < z`; `z < a`] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD_RZERO = prove + (`!p. poly (p ++ []) = poly p`, + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; poly; REAL_ADD_RID]);; + +let POLY_MUL_ASSOC = prove + (`!p q r. poly (p ** (q ** r)) = poly ((p ** q) ** r)`, + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; REAL_MUL_ASSOC]);; + +let POLY_EXP_ADD = prove + (`!d n p. poly(p exp (n + d)) = poly(p exp n ** p exp d)`, + REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_MUL; ADD_CLAUSES; poly_exp; poly] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas for derivatives. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DIFF_AUX_ADD = prove + (`!p1 p2 n. poly (poly_diff_aux n (p1 ++ p2)) = + poly (poly_diff_aux n p1 ++ poly_diff_aux n p2)`, + REPEAT(LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff_aux; poly_add]) THEN + ASM_REWRITE_TAC[poly_diff_aux; FUN_EQ_THM; poly; NOT_CONS_NIL; HD; TL] THEN + REAL_ARITH_TAC);; + +let POLY_DIFF_AUX_CMUL = prove + (`!p c n. poly (poly_diff_aux n (c ## p)) = + poly (c ## poly_diff_aux n p)`, + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[FUN_EQ_THM; poly; poly_diff_aux; poly_cmul; REAL_MUL_AC]);; + +let POLY_DIFF_AUX_NEG = prove + (`!p n. poly (poly_diff_aux n (neg p)) = + poly (neg (poly_diff_aux n p))`, + REWRITE_TAC[poly_neg; POLY_DIFF_AUX_CMUL]);; + +let POLY_DIFF_AUX_MUL_LEMMA = prove + (`!p n. poly (poly_diff_aux (SUC n) p) = poly (poly_diff_aux n p ++ p)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff_aux; poly_add; NOT_CONS_NIL] THEN + ASM_REWRITE_TAC[HD; TL; poly; FUN_EQ_THM] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Final results for derivatives. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DIFF_ADD = prove + (`!p1 p2. poly (diff (p1 ++ p2)) = + poly (diff p1 ++ diff p2)`, + REPEAT LIST_INDUCT_TAC THEN + REWRITE_TAC[poly_add; poly_diff; NOT_CONS_NIL; POLY_ADD_RZERO] THEN + ASM_REWRITE_TAC[HD; TL; POLY_DIFF_AUX_ADD]);; + +let POLY_DIFF_CMUL = prove + (`!p c. poly (diff (c ## p)) = poly (c ## diff p)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff; poly_cmul] THEN + REWRITE_TAC[NOT_CONS_NIL; HD; TL; POLY_DIFF_AUX_CMUL]);; + +let POLY_DIFF_NEG = prove + (`!p. poly (diff (neg p)) = poly (neg (diff p))`, + REWRITE_TAC[poly_neg; POLY_DIFF_CMUL]);; + +let POLY_DIFF_MUL_LEMMA = prove + (`!t h. poly (diff (CONS h t)) = + poly (CONS (&0) (diff t) ++ t)`, + REWRITE_TAC[poly_diff; NOT_CONS_NIL] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff_aux; NOT_CONS_NIL; HD; TL] THENL + [REWRITE_TAC[FUN_EQ_THM; poly; poly_add; REAL_MUL_RZERO; REAL_ADD_LID]; + REWRITE_TAC[FUN_EQ_THM; poly; POLY_DIFF_AUX_MUL_LEMMA; POLY_ADD] THEN + REAL_ARITH_TAC]);; + +let POLY_DIFF_MUL = prove + (`!p1 p2. poly (diff (p1 ** p2)) = + poly (p1 ** diff p2 ++ diff p1 ** p2)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_mul] THENL + [REWRITE_TAC[poly_diff; poly_add; poly_mul]; ALL_TAC] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[POLY_DIFF_CLAUSES] THEN + REWRITE_TAC[poly_add; poly_mul; POLY_ADD_RZERO; POLY_DIFF_CMUL]; + ALL_TAC] THEN + REWRITE_TAC[FUN_EQ_THM; POLY_DIFF_ADD; POLY_ADD] THEN + REWRITE_TAC[poly; POLY_ADD; POLY_DIFF_MUL_LEMMA; POLY_MUL] THEN + ASM_REWRITE_TAC[POLY_DIFF_CMUL; POLY_ADD; POLY_MUL] THEN + REAL_ARITH_TAC);; + +let POLY_DIFF_EXP = prove + (`!p n. poly (diff (p exp (SUC n))) = + poly ((&(SUC n) ## (p exp n)) ** diff p)`, + GEN_TAC THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[poly_exp] THENL + [REWRITE_TAC[poly_exp; POLY_DIFF_MUL] THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD; POLY_CMUL] THEN + REWRITE_TAC[poly; POLY_DIFF_CLAUSES; ADD1; ADD_CLAUSES] THEN + REAL_ARITH_TAC; + REWRITE_TAC[POLY_DIFF_MUL] THEN + ASM_REWRITE_TAC[POLY_MUL; POLY_ADD; FUN_EQ_THM; POLY_CMUL] THEN + REWRITE_TAC[poly_exp; POLY_MUL] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC]);; + +let POLY_DIFF_EXP_PRIME = prove + (`!n a. poly (diff ([--a; &1] exp (SUC n))) = + poly (&(SUC n) ## ([--a; &1] exp n))`, + REPEAT GEN_TAC THEN REWRITE_TAC[POLY_DIFF_EXP] THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN + REWRITE_TAC[poly_diff; poly_diff_aux; TL; NOT_CONS_NIL] THEN + REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Key property that f(a) = 0 ==> (x - a) divides p(x). Very delicate! *) +(* ------------------------------------------------------------------------- *) + +let POLY_LINEAR_REM = prove + (`!t h. ?q r. CONS h t = [r] ++ [--a; &1] ** q`, + LIST_INDUCT_TAC THEN REWRITE_TAC[] THENL + [GEN_TAC THEN EXISTS_TAC `[]:real list` THEN + EXISTS_TAC `h:real` THEN + REWRITE_TAC[poly_add; poly_mul; poly_cmul; NOT_CONS_NIL] THEN + REWRITE_TAC[HD; TL; REAL_ADD_RID]; + X_GEN_TAC `k:real` THEN POP_ASSUM(STRIP_ASSUME_TAC o SPEC `h:real`) THEN + EXISTS_TAC `CONS (r:real) q` THEN EXISTS_TAC `r * a + k` THEN + ASM_REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN + REWRITE_TAC[CONS_11] THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SPEC_TAC(`q:real list`,`q:real list`) THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC[POLY_ADD_CLAUSES; POLY_MUL_CLAUSES; poly_cmul] THEN + REWRITE_TAC[REAL_ADD_RID; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ADD_AC]]);; + +let POLY_LINEAR_DIVIDES = prove + (`!a p. (poly p a = &0) <=> (p = []) \/ ?q. p = [--a; &1] ** q`, + GEN_TAC THEN LIST_INDUCT_TAC THENL + [REWRITE_TAC[poly]; ALL_TAC] THEN + EQ_TAC THEN STRIP_TAC THENL + [DISJ2_TAC THEN STRIP_ASSUME_TAC(SPEC_ALL POLY_LINEAR_REM) THEN + EXISTS_TAC `q:real list` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `r = &0` SUBST_ALL_TAC THENL + [UNDISCH_TAC `poly (CONS h t) a = &0` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[POLY_ADD; POLY_MUL] THEN + REWRITE_TAC[poly; REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `--a + a = &0`] THEN REAL_ARITH_TAC; + REWRITE_TAC[poly_mul] THEN REWRITE_TAC[NOT_CONS_NIL] THEN + SPEC_TAC(`q:real list`,`q:real list`) THEN LIST_INDUCT_TAC THENL + [REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; HD; TL; REAL_ADD_LID]; + REWRITE_TAC[poly_cmul; poly_add; NOT_CONS_NIL; HD; TL; REAL_ADD_LID]]]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[poly] THEN + REWRITE_TAC[POLY_MUL] THEN REWRITE_TAC[poly] THEN + REWRITE_TAC[poly; REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `--a + a = &0`] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Thanks to the finesse of the above, we can use length rather than degree. *) +(* ------------------------------------------------------------------------- *) + +let POLY_LENGTH_MUL = prove + (`!q. LENGTH([--a; &1] ** q) = SUC(LENGTH q)`, + let lemma = prove + (`!p h k a. LENGTH (k ## p ++ CONS h (a ## p)) = SUC(LENGTH p)`, + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[poly_cmul; POLY_ADD_CLAUSES; LENGTH]) in + REWRITE_TAC[poly_mul; NOT_CONS_NIL; lemma]);; + +(* ------------------------------------------------------------------------- *) +(* Thus a nontrivial polynomial of degree n has no more than n roots. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ROOTS_INDEX_LEMMA = prove + (`!n. !p. ~(poly p = poly []) /\ (LENGTH p = n) + ==> ?i. !x. (poly p (x) = &0) ==> ?m. m <= n /\ (x = i m)`, + INDUCT_TAC THENL + [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a. poly p a = &0` THENL + [UNDISCH_TAC `?a. poly p a = &0` THEN DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real list` SUBST_ALL_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + UNDISCH_TAC `~(poly ([-- a; &1] ** q) = poly [])` THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[POLY_LENGTH_MUL; SUC_INJ] THEN + DISCH_TAC THEN ASM_CASES_TAC `poly q = poly []` THENL + [ASM_REWRITE_TAC[POLY_MUL; poly; REAL_MUL_RZERO; FUN_EQ_THM]; + DISCH_THEN(K ALL_TAC)] THEN + DISCH_THEN(MP_TAC o SPEC `q:real list`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `i:num->real`) THEN + EXISTS_TAC `\m. if m = SUC n then (a:real) else i m` THEN + REWRITE_TAC[POLY_MUL; LE; REAL_ENTIRE] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(fun th -> EXISTS_TAC `SUC n` THEN MP_TAC th) THEN + REWRITE_TAC[poly] THEN REAL_ARITH_TAC; + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THEN ARITH_TAC]; + UNDISCH_TAC `~(?a. poly p a = &0)` THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; + +let POLY_ROOTS_INDEX_LENGTH = prove + (`!p. ~(poly p = poly []) + ==> ?i. !x. (poly p(x) = &0) ==> ?n. n <= LENGTH p /\ (x = i n)`, + MESON_TAC[POLY_ROOTS_INDEX_LEMMA]);; + +let POLY_ROOTS_FINITE_LEMMA = prove + (`!p. ~(poly p = poly []) + ==> ?N i. !x. (poly p(x) = &0) ==> ?n:num. n < N /\ (x = i n)`, + MESON_TAC[POLY_ROOTS_INDEX_LENGTH; LT_SUC_LE]);; + +let FINITE_LEMMA = prove + (`!i N P. (!x. P x ==> ?n:num. n < N /\ (x = i n)) + ==> ?a. !x. P x ==> x < a`, + GEN_TAC THEN ONCE_REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN INDUCT_TAC THENL + [REWRITE_TAC[LT] THEN MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `P:real->bool` THEN + POP_ASSUM(MP_TAC o SPEC `\z. P z /\ ~(z = (i:num->real) N)`) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN + EXISTS_TAC `abs(a) + abs(i(N:num)) + &1` THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[LT] THEN + MP_TAC(REAL_ARITH `!x v. x < abs(v) + abs(x) + &1`) THEN + MP_TAC(REAL_ARITH `!u v x. x < v ==> x < abs(v) + abs(u) + &1`) THEN + MESON_TAC[]);; + +let POLY_ROOTS_FINITE = prove + (`!p. ~(poly p = poly []) <=> + ?N i. !x. (poly p(x) = &0) ==> ?n:num. n < N /\ (x = i n)`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE_LEMMA] THEN + REWRITE_TAC[FUN_EQ_THM; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM; poly] THEN + MP_TAC(GENL [`i:num->real`; `N:num`] + (SPECL [`i:num->real`; `N:num`; `\x. poly p x = &0`] FINITE_LEMMA)) THEN + REWRITE_TAC[] THEN MESON_TAC[REAL_LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Hence get entirety and cancellation for polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ENTIRE_LEMMA = prove + (`!p q. ~(poly p = poly []) /\ ~(poly q = poly []) + ==> ~(poly (p ** q) = poly [])`, + REPEAT GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (X_CHOOSE_TAC `i2:num->real`)) THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (X_CHOOSE_TAC `i1:num->real`)) THEN + EXISTS_TAC `N1 + N2:num` THEN + EXISTS_TAC `\n:num. if n < N1 then i1(n):real else i2(n - N1)` THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_ENTIRE; POLY_MUL] THEN + DISCH_THEN(DISJ_CASES_THEN (ANTE_RES_THEN (X_CHOOSE_TAC `n:num`))) THENL + [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN ARITH_TAC; + EXISTS_TAC `N1 + n:num` THEN ASM_REWRITE_TAC[LT_ADD_LCANCEL] THEN + REWRITE_TAC[ARITH_RULE `~(m + n < m:num)`] THEN + AP_TERM_TAC THEN ARITH_TAC]);; + +let POLY_ENTIRE = prove + (`!p q. (poly (p ** q) = poly []) <=> + (poly p = poly []) \/ (poly q = poly [])`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[POLY_ENTIRE_LEMMA]; + REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_LZERO; poly]]);; + +let POLY_MUL_LCANCEL = prove + (`!p q r. (poly (p ** q) = poly (p ** r)) <=> + (poly p = poly []) \/ (poly q = poly r)`, + let lemma1 = prove + (`!p q. (poly (p ++ neg q) = poly []) <=> (poly p = poly q)`, + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; poly] THEN + REWRITE_TAC[REAL_ARITH `(p + --q = &0) <=> (p = q)`]) in + let lemma2 = prove + (`!p q r. poly (p ** q ++ neg(p ** r)) = poly (p ** (q ++ neg(r)))`, + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_NEG; POLY_MUL] THEN + REAL_ARITH_TAC) in + ONCE_REWRITE_TAC[GSYM lemma1] THEN + REWRITE_TAC[lemma2; POLY_ENTIRE] THEN + REWRITE_TAC[lemma1]);; + +let POLY_EXP_EQ_0 = prove + (`!p n. (poly (p exp n) = poly []) <=> (poly p = poly []) /\ ~(n = 0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN + REWRITE_TAC[LEFT_AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[poly_exp; poly; REAL_MUL_RZERO; REAL_ADD_RID; + REAL_OF_NUM_EQ; ARITH; NOT_SUC] THEN + ASM_REWRITE_TAC[POLY_MUL; poly; REAL_ENTIRE] THEN + CONV_TAC TAUT);; + +let POLY_PRIME_EQ_0 = prove + (`!a. ~(poly [a ; &1] = poly [])`, + GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN + DISCH_THEN(MP_TAC o SPEC `&1 - a`) THEN + REAL_ARITH_TAC);; + +let POLY_EXP_PRIME_EQ_0 = prove + (`!a n. ~(poly ([a ; &1] exp n) = poly [])`, + MESON_TAC[POLY_EXP_EQ_0; POLY_PRIME_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* Can also prove a more "constructive" notion of polynomial being trivial. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ZERO_LEMMA = prove + (`!h t. (poly (CONS h t) = poly []) ==> (h = &0) /\ (poly t = poly [])`, + let lemma = REWRITE_RULE[FUN_EQ_THM; poly] POLY_ROOTS_FINITE in + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN + ASM_CASES_TAC `h = &0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[REAL_ADD_LID]; + DISCH_THEN(MP_TAC o SPEC `&0`) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN + CONV_TAC CONTRAPOS_CONV THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[lemma]) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (X_CHOOSE_TAC `i:num->real`)) THEN + MP_TAC(SPECL [`i:num->real`; `N:num`; `\x. poly t x = &0`] FINITE_LEMMA) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `a:real`) THEN + DISCH_THEN(MP_TAC o SPEC `abs(a) + &1`) THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o MATCH_MP (ASSUME `!x. (poly t x = &0) ==> x < a`)) THEN + REAL_ARITH_TAC]);; + +let POLY_ZERO = prove + (`!p. (poly p = poly []) <=> ALL (\c. c = &0) p`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP POLY_ZERO_LEMMA) THEN ASM_REWRITE_TAC[]; + POP_ASSUM(SUBST1_TAC o SYM) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FUN_EQ_THM; poly] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Useful triviality. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DIFF_AUX_ISZERO = prove + (`!p n. ALL (\c. c = &0) (poly_diff_aux (SUC n) p) <=> + ALL (\c. c = &0) p`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC + [ALL; poly_diff_aux; REAL_ENTIRE; REAL_OF_NUM_EQ; NOT_SUC]);; + +let POLY_DIFF_ISZERO = prove + (`!p. (poly (diff p) = poly []) ==> ?h. poly p = poly [h]`, + REWRITE_TAC[POLY_ZERO] THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_DIFF_CLAUSES; ALL] THENL + [EXISTS_TAC `&0` THEN REWRITE_TAC[FUN_EQ_THM; poly] THEN REAL_ARITH_TAC; + REWRITE_TAC[num_CONV `1`; POLY_DIFF_AUX_ISZERO] THEN + REWRITE_TAC[GSYM POLY_ZERO] THEN DISCH_TAC THEN + EXISTS_TAC `h:real` THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM]]);; + +let POLY_DIFF_ZERO = prove + (`!p. (poly p = poly []) ==> (poly (diff p) = poly [])`, + REWRITE_TAC[POLY_ZERO] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[poly_diff; NOT_CONS_NIL] THEN + REWRITE_TAC[ALL; TL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SPEC_TAC(`1`,`n:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + SPEC_TAC(`t:real list`,`t:real list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; poly_diff_aux] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let POLY_DIFF_WELLDEF = prove + (`!p q. (poly p = poly q) ==> (poly (diff p) = poly (diff q))`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `p ++ neg(q)` POLY_DIFF_ZERO) THEN + REWRITE_TAC[FUN_EQ_THM; POLY_DIFF_ADD; POLY_DIFF_NEG; POLY_ADD] THEN + ASM_REWRITE_TAC[POLY_NEG; poly; REAL_ARITH `a + --a = &0`] THEN + REWRITE_TAC[REAL_ARITH `(a + --b = &0) <=> (a = b)`]);; + +(* ------------------------------------------------------------------------- *) +(* Basics of divisibility. *) +(* ------------------------------------------------------------------------- *) + +let divides = new_definition + `p1 divides p2 <=> ?q. poly p2 = poly (p1 ** q)`;; + +let POLY_PRIMES = prove + (`!a p q. [a; &1] divides (p ** q) <=> + [a; &1] divides p \/ [a; &1] divides q`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides; POLY_MUL; FUN_EQ_THM; poly] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `r:real list` (MP_TAC o SPEC `--a`)) THEN + REWRITE_TAC[REAL_ENTIRE; GSYM real_sub; REAL_SUB_REFL; REAL_MUL_LZERO] THEN + DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN + (POP_ASSUM(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (X_CHOOSE_THEN `s:real list` SUBST_ALL_TAC)) THENL + [EXISTS_TAC `[]:real list` THEN REWRITE_TAC[poly; REAL_MUL_RZERO]; + EXISTS_TAC `s:real list` THEN GEN_TAC THEN + REWRITE_TAC[POLY_MUL; poly] THEN REAL_ARITH_TAC]); + DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_TAC `s:real list`)) THEN + ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `s ** q`; EXISTS_TAC `p ** s`] THEN + GEN_TAC THEN REWRITE_TAC[POLY_MUL] THEN REAL_ARITH_TAC]);; + +let POLY_DIVIDES_REFL = prove + (`!p. p divides p`, + GEN_TAC THEN REWRITE_TAC[divides] THEN EXISTS_TAC `[&1]` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN REAL_ARITH_TAC);; + +let POLY_DIVIDES_TRANS = prove + (`!p q r. p divides q /\ q divides r ==> p divides r`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real list` ASSUME_TAC) THEN + EXISTS_TAC `t ** s` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; REAL_MUL_ASSOC]);; + +let POLY_DIVIDES_EXP = prove + (`!p m n. m <= n ==> (p exp m) divides (p exp n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; POLY_DIVIDES_REFL] THEN + MATCH_MP_TAC POLY_DIVIDES_TRANS THEN + EXISTS_TAC `p exp (m + d)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `p:real list` THEN + REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL] THEN + REAL_ARITH_TAC);; + +let POLY_EXP_DIVIDES = prove + (`!p q m n. (p exp n) divides q /\ m <= n ==> (p exp m) divides q`, + MESON_TAC[POLY_DIVIDES_TRANS; POLY_DIVIDES_EXP]);; + +let POLY_DIVIDES_ADD = prove + (`!p q r. p divides q /\ p divides r ==> p divides (q ++ r)`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real list` ASSUME_TAC) THEN + EXISTS_TAC `t ++ s` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL] THEN + REAL_ARITH_TAC);; + +let POLY_DIVIDES_SUB = prove + (`!p q r. p divides q /\ p divides (q ++ r) ==> p divides r`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real list` ASSUME_TAC) THEN + EXISTS_TAC `s ++ neg(t)` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[FUN_EQ_THM; POLY_ADD; POLY_MUL; POLY_NEG] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_MUL_RNEG] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let POLY_DIVIDES_SUB2 = prove + (`!p q r. p divides r /\ p divides (q ++ r) ==> p divides q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DIVIDES_SUB THEN + EXISTS_TAC `r:real list` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `p divides (q ++ r)` THEN + REWRITE_TAC[divides; POLY_ADD; FUN_EQ_THM; POLY_MUL] THEN + DISCH_THEN(X_CHOOSE_TAC `s:real list`) THEN + EXISTS_TAC `s:real list` THEN + X_GEN_TAC `x:real` THEN POP_ASSUM(MP_TAC o SPEC `x:real`) THEN + REAL_ARITH_TAC);; + +let POLY_DIVIDES_ZERO = prove + (`!p q. (poly p = poly []) ==> q divides p`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `[]:real list` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; REAL_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* At last, we can consider the order of a root. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ORDER_EXISTS = prove + (`!a d. !p. (LENGTH p = d) /\ ~(poly p = poly []) + ==> ?n. ([--a; &1] exp n) divides p /\ + ~(([--a; &1] exp (SUC n)) divides p)`, + GEN_TAC THEN + (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) + `(!p q. mulexp 0 p q = q) /\ + (!p q n. mulexp (SUC n) p q = p ** (mulexp n p q))` THEN + SUBGOAL_THEN + `!d. !p. (LENGTH p = d) /\ ~(poly p = poly []) + ==> ?n q. (p = mulexp (n:num) [--a; &1] q) /\ + ~(poly q a = &0)` + MP_TAC THENL + [INDUCT_TAC THENL + [REWRITE_TAC[LENGTH_EQ_NIL] THEN MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `p:real list` THEN + ASM_CASES_TAC `poly p a = &0` THENL + [STRIP_TAC THEN UNDISCH_TAC `poly p a = &0` THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real list` SUBST_ALL_TAC) THEN + UNDISCH_TAC + `!p. (LENGTH p = d) /\ ~(poly p = poly []) + ==> ?n q. (p = mulexp (n:num) [--a; &1] q) /\ + ~(poly q a = &0)` THEN + DISCH_THEN(MP_TAC o SPEC `q:real list`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[POLY_LENGTH_MUL; POLY_ENTIRE; + DE_MORGAN_THM; SUC_INJ]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` + (X_CHOOSE_THEN `s:real list` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `SUC n` THEN EXISTS_TAC `s:real list` THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THEN EXISTS_TAC `0` THEN EXISTS_TAC `p:real list` THEN + ASM_REWRITE_TAC[]]; + DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` + (X_CHOOSE_THEN `s:real list` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[divides] THEN CONJ_TAC THENL + [EXISTS_TAC `s:real list` THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[poly_exp; FUN_EQ_THM; POLY_MUL; poly] THEN + REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `r:real list` MP_TAC) THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `~(poly s a = &0)` THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[poly; poly_exp; POLY_MUL] THEN REAL_ARITH_TAC; + REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[poly_exp] THEN + REWRITE_TAC[GSYM POLY_MUL_ASSOC; POLY_MUL_LCANCEL] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a + &1`) THEN + REWRITE_TAC[poly] THEN REAL_ARITH_TAC; + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[]]]]]);; + +let POLY_ORDER = prove + (`!p a. ~(poly p = poly []) + ==> ?!n. ([--a; &1] exp n) divides p /\ + ~(([--a; &1] exp (SUC n)) divides p)`, + MESON_TAC[POLY_ORDER_EXISTS; POLY_EXP_DIVIDES; LE_SUC_LT; LT_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of order. *) +(* ------------------------------------------------------------------------- *) + +let order = new_definition + `order a p = @n. ([--a; &1] exp n) divides p /\ + ~(([--a; &1] exp (SUC n)) divides p)`;; + +let ORDER = prove + (`!p a n. ([--a; &1] exp n) divides p /\ + ~(([--a; &1] exp (SUC n)) divides p) <=> + (n = order a p) /\ + ~(poly p = poly [])`, + REPEAT GEN_TAC THEN REWRITE_TAC[order] THEN + EQ_TAC THEN STRIP_TAC THENL + [SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL + [FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[divides] THEN + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `[]:real list` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; REAL_MUL_RZERO]; + ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[]]; + ONCE_ASM_REWRITE_TAC[] THEN CONV_TAC SELECT_CONV] THEN + ASM_MESON_TAC[POLY_ORDER]);; + +let ORDER_THM = prove + (`!p a. ~(poly p = poly []) + ==> ([--a; &1] exp (order a p)) divides p /\ + ~(([--a; &1] exp (SUC(order a p))) divides p)`, + MESON_TAC[ORDER]);; + +let ORDER_UNIQUE = prove + (`!p a n. ~(poly p = poly []) /\ + ([--a; &1] exp n) divides p /\ + ~(([--a; &1] exp (SUC n)) divides p) + ==> (n = order a p)`, + MESON_TAC[ORDER]);; + +let ORDER_POLY = prove + (`!p q a. (poly p = poly q) ==> (order a p = order a q)`, + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[order; divides; FUN_EQ_THM; POLY_MUL]);; + +let ORDER_ROOT = prove + (`!p a. (poly p a = &0) <=> (poly p = poly []) \/ ~(order a p = 0)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN + ASM_REWRITE_TAC[poly] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o REWRITE_RULE[POLY_LINEAR_DIVIDES]) THEN + ASM_CASES_TAC `p:real list = []` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real list` SUBST_ALL_TAC) THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:real` o MATCH_MP ORDER_THM) THEN + ASM_REWRITE_TAC[poly_exp; DE_MORGAN_THM] THEN DISJ2_TAC THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `q:real list` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly] THEN REAL_ARITH_TAC; + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:real` o MATCH_MP ORDER_THM) THEN + UNDISCH_TAC `~(order a p = 0)` THEN + SPEC_TAC(`order a p`,`n:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[poly_exp; NOT_SUC] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real list` SUBST1_TAC) THEN + REWRITE_TAC[POLY_MUL; poly] THEN REAL_ARITH_TAC]);; + +let ORDER_DIVIDES = prove + (`!p a n. ([--a; &1] exp n) divides p <=> + (poly p = poly []) \/ n <= order a p`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `poly p = poly []` THEN + ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[divides] THEN EXISTS_TAC `[]:real list` THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; poly; REAL_MUL_RZERO]; + ASM_MESON_TAC[ORDER_THM; POLY_EXP_DIVIDES; NOT_LE; LE_SUC_LT]]);; + +let ORDER_DECOMP = prove + (`!p a. ~(poly p = poly []) + ==> ?q. (poly p = poly (([--a; &1] exp (order a p)) ** q)) /\ + ~([--a; &1] divides q)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_THM) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o SPEC `a:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `q:real list` o REWRITE_RULE[divides]) THEN + EXISTS_TAC `q:real list` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `r: real list` o REWRITE_RULE[divides]) THEN + UNDISCH_TAC `~([-- a; &1] exp SUC (order a p) divides p)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `r:real list` THEN + ASM_REWRITE_TAC[POLY_MUL; FUN_EQ_THM; poly_exp] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Important composition properties of orders. *) +(* ------------------------------------------------------------------------- *) + +let ORDER_MUL = prove + (`!a p q. ~(poly (p ** q) = poly []) ==> + (order a (p ** q) = order a p + order a q)`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `(order a p + order a q = order a (p ** q)) /\ + ~(poly (p ** q) = poly [])` + MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[GSYM ORDER] THEN CONJ_TAC THENL + [MP_TAC(CONJUNCT1 (SPEC `a:real` + (MATCH_MP ORDER_THM (ASSUME `~(poly p = poly [])`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `r: real list` o REWRITE_RULE[divides]) THEN + MP_TAC(CONJUNCT1 (SPEC `a:real` + (MATCH_MP ORDER_THM (ASSUME `~(poly q = poly [])`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `s: real list` o REWRITE_RULE[divides]) THEN + REWRITE_TAC[divides; FUN_EQ_THM] THEN EXISTS_TAC `s ** r` THEN + ASM_REWRITE_TAC[POLY_MUL; POLY_EXP_ADD] THEN REAL_ARITH_TAC; + X_CHOOSE_THEN `r: real list` STRIP_ASSUME_TAC + (SPEC `a:real` (MATCH_MP ORDER_DECOMP (ASSUME `~(poly p = poly [])`))) THEN + X_CHOOSE_THEN `s: real list` STRIP_ASSUME_TAC + (SPEC `a:real` (MATCH_MP ORDER_DECOMP (ASSUME `~(poly q = poly [])`))) THEN + ASM_REWRITE_TAC[divides; FUN_EQ_THM; POLY_EXP_ADD; POLY_MUL; poly_exp] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real list` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `[--a; &1] divides (r ** s)` MP_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[POLY_PRIMES]] THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `t:real list` THEN + SUBGOAL_THEN `poly ([-- a; &1] exp (order a p) ** r ** s) = + poly ([-- a; &1] exp (order a p) ** ([-- a; &1] ** t))` + MP_TAC THENL + [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN + SUBGOAL_THEN `poly ([-- a; &1] exp (order a q) ** + [-- a; &1] exp (order a p) ** r ** s) = + poly ([-- a; &1] exp (order a q) ** + [-- a; &1] exp (order a p) ** + [-- a; &1] ** t)` + MP_TAC THENL + [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN + REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + REWRITE_TAC[REAL_MUL_AC]]);; + +let ORDER_DIFF = prove + (`!p a. ~(poly (diff p) = poly []) /\ + ~(order a p = 0) + ==> (order a p = SUC (order a (diff p)))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `~(poly p = poly [])` MP_TAC THENL + [ASM_MESON_TAC[POLY_DIFF_ZERO]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real list` MP_TAC o + SPEC `a:real` o MATCH_MP ORDER_DECOMP) THEN + SPEC_TAC(`order a p`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_INJ] THEN + STRIP_TAC THEN MATCH_MP_TAC ORDER_UNIQUE THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!r. r divides (diff p) <=> + r divides (diff ([-- a; &1] exp SUC n ** q))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[divides] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POLY_DIFF_WELLDEF th]); + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[divides; FUN_EQ_THM] THEN + EXISTS_TAC `[--a; &1] ** (diff q) ++ &(SUC n) ## q` THEN + REWRITE_TAC[POLY_DIFF_MUL; POLY_DIFF_EXP_PRIME; + POLY_ADD; POLY_MUL; POLY_CMUL] THEN + REWRITE_TAC[poly_exp; POLY_MUL] THEN REAL_ARITH_TAC; + REWRITE_TAC[FUN_EQ_THM; divides; POLY_DIFF_MUL; POLY_DIFF_EXP_PRIME; + POLY_ADD; POLY_MUL; POLY_CMUL] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real list` ASSUME_TAC) THEN + UNDISCH_TAC `~([-- a; &1] divides q)` THEN + REWRITE_TAC[divides] THEN + EXISTS_TAC `inv(&(SUC n)) ## (r ++ neg(diff q))` THEN + SUBGOAL_THEN + `poly ([--a; &1] exp n ** q) = + poly ([--a; &1] exp n ** ([-- a; &1] ** (inv (&(SUC n)) ## + (r ++ neg (diff q)))))` + MP_TAC THENL + [ALL_TAC; MESON_TAC[POLY_MUL_LCANCEL; POLY_EXP_PRIME_EQ_0]] THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + SUBGOAL_THEN + `!a b. (&(SUC n) * a = &(SUC n) * b) ==> (a = b)` + MATCH_MP_TAC THENL + [REWRITE_TAC[REAL_EQ_MUL_LCANCEL; REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + REWRITE_TAC[POLY_MUL; POLY_CMUL] THEN + SUBGOAL_THEN `!a b c. &(SUC n) * a * b * inv(&(SUC n)) * c = + a * b * c` + (fun th -> REWRITE_TAC[th]) THENL + [REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_RINV THEN + REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[poly_exp; POLY_MUL; POLY_ADD; POLY_NEG] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Now justify the standard squarefree decomposition, i.e. f / gcd(f,f'). *) +(* ------------------------------------------------------------------------- *) + +let POLY_SQUAREFREE_DECOMP_ORDER = prove + (`!p q d e r s. + ~(poly (diff p) = poly []) /\ + (poly p = poly (q ** d)) /\ + (poly (diff p) = poly (e ** d)) /\ + (poly d = poly (r ** p ++ s ** diff p)) + ==> !a. order a q = (if order a p = 0 then 0 else 1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `order a p = order a q + order a d` MP_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `order a (q ** d)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ORDER_POLY THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ORDER_MUL THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th]) THEN + ASM_MESON_TAC[POLY_DIFF_ZERO]]; ALL_TAC] THEN + ASM_CASES_TAC `order a p = 0` THEN ASM_REWRITE_TAC[] THENL + [ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `order a (diff p) = + order a e + order a d` MP_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `order a (e ** d)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ORDER_POLY]; ASM_MESON_TAC[ORDER_MUL]]; ALL_TAC] THEN + SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL + [ASM_MESON_TAC[POLY_DIFF_ZERO]; ALL_TAC] THEN + MP_TAC(SPECL [`p:real list`; `a:real`] ORDER_DIFF) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `PRE` th)) THEN + REWRITE_TAC[PRE] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + SUBGOAL_THEN `order a (diff p) <= order a d` MP_TAC THENL + [SUBGOAL_THEN `([--a; &1] exp (order a (diff p))) divides d` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[POLY_ENTIRE; ORDER_DIVIDES]] THEN + SUBGOAL_THEN + `([--a; &1] exp (order a (diff p))) divides p /\ + ([--a; &1] exp (order a (diff p))) divides (diff p)` + MP_TAC THENL + [REWRITE_TAC[ORDER_DIVIDES; LE_REFL] THEN DISJ2_TAC THEN + REWRITE_TAC[ASSUME `order a (diff p) = PRE (order a p)`] THEN + ARITH_TAC; + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[divides] THEN + REWRITE_TAC[ASSUME `poly d = poly (r ** p ++ s ** diff p)`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `f:real list` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real list` ASSUME_TAC) THEN + EXISTS_TAC `r ** g ++ s ** f` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[FUN_EQ_THM; POLY_MUL; POLY_ADD] THEN ARITH_TAC]; + ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Define being "squarefree" --- NB with respect to real roots only. *) +(* ------------------------------------------------------------------------- *) + +let rsquarefree = new_definition + `rsquarefree p <=> ~(poly p = poly []) /\ + !a. (order a p = 0) \/ (order a p = 1)`;; + +(* ------------------------------------------------------------------------- *) +(* Standard squarefree criterion and rephasing of squarefree decomposition. *) +(* ------------------------------------------------------------------------- *) + +let RSQUAREFREE_ROOTS = prove + (`!p. rsquarefree p <=> !a. ~((poly p a = &0) /\ (poly (diff p) a = &0))`, + GEN_TAC THEN REWRITE_TAC[rsquarefree] THEN + ASM_CASES_TAC `poly p = poly []` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP POLY_DIFF_ZERO) THEN + ASM_REWRITE_TAC[poly; NOT_FORALL_THM]; + ASM_CASES_TAC `poly(diff p) = poly []` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(X_CHOOSE_THEN `h:real` MP_TAC o + MATCH_MP POLY_DIFF_ISZERO) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ORDER_POLY th]) THEN + UNDISCH_TAC `~(poly p = poly [])` THEN ASM_REWRITE_TAC[poly] THEN + REWRITE_TAC[FUN_EQ_THM; poly; REAL_MUL_RZERO; REAL_ADD_RID] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `a:real` THEN DISJ1_TAC THEN + MP_TAC(SPECL [`[h:real]`; `a:real`] ORDER_ROOT) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; poly; REAL_MUL_RZERO; REAL_ADD_RID]; + ASM_REWRITE_TAC[ORDER_ROOT; DE_MORGAN_THM; num_CONV `1`] THEN + ASM_MESON_TAC[ORDER_DIFF; SUC_INJ]]]);; + +let RSQUAREFREE_DECOMP = prove + (`!p a. rsquarefree p /\ (poly p a = &0) + ==> ?q. (poly p = poly ([--a; &1] ** q)) /\ + ~(poly q a = &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[rsquarefree] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORDER_DECOMP) THEN + DISCH_THEN(X_CHOOSE_THEN `q:real list` MP_TAC o SPEC `a:real`) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ORDER_ROOT]) THEN + FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + EXISTS_TAC `q:real list` THEN CONJ_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; POLY_MUL] THEN GEN_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [num_CONV `1`] THEN + REWRITE_TAC[poly_exp; POLY_MUL] THEN + REWRITE_TAC[poly] THEN REAL_ARITH_TAC; + DISCH_TAC THEN UNDISCH_TAC `~([-- a; &1] divides q)` THEN + REWRITE_TAC[divides] THEN + UNDISCH_TAC `poly q a = &0` THEN + GEN_REWRITE_TAC LAND_CONV [POLY_LINEAR_DIVIDES] THEN + ASM_CASES_TAC `q:real list = []` THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `[] : real list` THEN REWRITE_TAC[FUN_EQ_THM] THEN + REWRITE_TAC[POLY_MUL; poly; REAL_MUL_RZERO]; + MESON_TAC[]]]);; + +let POLY_SQUAREFREE_DECOMP = prove + (`!p q d e r s. + ~(poly (diff p) = poly []) /\ + (poly p = poly (q ** d)) /\ + (poly (diff p) = poly (e ** d)) /\ + (poly d = poly (r ** p ++ s ** diff p)) + ==> rsquarefree q /\ (!a. (poly q a = &0) <=> (poly p a = &0))`, + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> MP_TAC th THEN + ASSUME_TAC(MATCH_MP POLY_SQUAREFREE_DECOMP_ORDER th)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `~(poly p = poly [])` ASSUME_TAC THENL + [ASM_MESON_TAC[POLY_DIFF_ZERO]; ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN + UNDISCH_TAC `~(poly p = poly [])` THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THEN + DISCH_THEN(fun th -> ASM_REWRITE_TAC[] THEN ASSUME_TAC th) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[POLY_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + UNDISCH_TAC `poly p = poly (q ** d)` THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[rsquarefree; ORDER_ROOT] THEN + CONJ_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Normalization of a polynomial. *) +(* ------------------------------------------------------------------------- *) + +let normalize = new_recursive_definition list_RECURSION + `(normalize [] = []) /\ + (normalize (CONS h t) = + if normalize t = [] then if h = &0 then [] else [h] + else CONS h (normalize t))`;; + +let POLY_NORMALIZE = prove + (`!p. poly (normalize p) = poly p`, + LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN + ASM_CASES_TAC `h = &0` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN + UNDISCH_TAC `poly (normalize t) = poly t` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID]);; + +(* ------------------------------------------------------------------------- *) +(* The degree of a polynomial. *) +(* ------------------------------------------------------------------------- *) + +let degree = new_definition + `degree p = PRE(LENGTH(normalize p))`;; + +let DEGREE_ZERO = prove + (`!p. (poly p = poly []) ==> (degree p = 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[degree] THEN + SUBGOAL_THEN `normalize p = []` SUBST1_TAC THENL + [POP_ASSUM MP_TAC THEN SPEC_TAC(`p:real list`,`p:real list`) THEN + REWRITE_TAC[POLY_ZERO] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; ALL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `normalize t = []` (fun th -> REWRITE_TAC[th]) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[LENGTH; PRE]]);; + +(* ------------------------------------------------------------------------- *) +(* Tidier versions of finiteness of roots. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ROOTS_FINITE_SET = prove + (`!p. ~(poly p = poly []) ==> FINITE { x | poly p x = &0}`, + GEN_TAC THEN REWRITE_TAC[POLY_ROOTS_FINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `i:num->real` ASSUME_TAC) THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:real | ?n:num. n < N /\ (x = i n)}` THEN + CONJ_TAC THENL + [SPEC_TAC(`N:num`,`N:num`) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + INDUCT_TAC THENL + [SUBGOAL_THEN `{x:real | ?n. n < 0 /\ (x = i n)} = {}` + (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; + SUBGOAL_THEN `{x:real | ?n. n < SUC N /\ (x = i n)} = + (i N) INSERT {x:real | ?n. n < N /\ (x = i n)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; LT] THEN MESON_TAC[]; + MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN ASM_REWRITE_TAC[]]]; + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM]]);; + +(* ------------------------------------------------------------------------- *) +(* Crude bound for polynomial. *) +(* ------------------------------------------------------------------------- *) + +let POLY_MONO = prove + (`!x k p. abs(x) <= k ==> abs(poly p x) <= poly (MAP abs p) k`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[poly; REAL_LE_REFL; MAP; REAL_ABS_0] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(h) + abs(x * poly t x)` THEN + REWRITE_TAC[REAL_ABS_TRIANGLE; REAL_LE_LADD] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Conversions to perform operations if coefficients are rational constants. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DIFF_CONV = + let aux_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_diff_aux] + and aux_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_diff_aux] + and diff_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_DIFF_CLAUSES)) + and diff_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_DIFF_CLAUSES)] in + let rec POLY_DIFF_AUX_CONV tm = + (aux_conv0 ORELSEC + (aux_conv1 THENC + LAND_CONV REAL_RAT_MUL_CONV THENC + RAND_CONV (LAND_CONV NUM_SUC_CONV THENC POLY_DIFF_AUX_CONV))) tm in + diff_conv0 ORELSEC + (diff_conv1 THENC POLY_DIFF_AUX_CONV);; + +let POLY_CMUL_CONV = + let cmul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_cmul] + and cmul_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_cmul] in + let rec POLY_CMUL_CONV tm = + (cmul_conv0 ORELSEC + (cmul_conv1 THENC + LAND_CONV REAL_RAT_MUL_CONV THENC + RAND_CONV POLY_CMUL_CONV)) tm in + POLY_CMUL_CONV;; + +let POLY_ADD_CONV = + let add_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_ADD_CLAUSES)) + and add_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_ADD_CLAUSES)] in + let rec POLY_ADD_CONV tm = + (add_conv0 ORELSEC + (add_conv1 THENC + LAND_CONV REAL_RAT_ADD_CONV THENC + RAND_CONV POLY_ADD_CONV)) tm in + POLY_ADD_CONV;; + +let POLY_MUL_CONV = + let mul_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 POLY_MUL_CLAUSES] + and mul_conv1 = GEN_REWRITE_CONV I [CONJUNCT1(CONJUNCT2 POLY_MUL_CLAUSES)] + and mul_conv2 = GEN_REWRITE_CONV I [CONJUNCT2(CONJUNCT2 POLY_MUL_CLAUSES)] in + let rec POLY_MUL_CONV tm = + (mul_conv0 ORELSEC + (mul_conv1 THENC POLY_CMUL_CONV) ORELSEC + (mul_conv2 THENC + LAND_CONV POLY_CMUL_CONV THENC + RAND_CONV(RAND_CONV POLY_MUL_CONV) THENC + POLY_ADD_CONV)) tm in + POLY_MUL_CONV;; + +let POLY_NORMALIZE_CONV = + let pth = prove + (`normalize (CONS h t) = + (\n. if n = [] then if h = &0 then [] else [h] else CONS h n) + (normalize t)`, + REWRITE_TAC[normalize]) in + let norm_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 normalize] + and norm_conv1 = GEN_REWRITE_CONV I [pth] + and norm_conv2 = GEN_REWRITE_CONV DEPTH_CONV + [COND_CLAUSES; NOT_CONS_NIL; EQT_INTRO(SPEC_ALL EQ_REFL)] in + let rec POLY_NORMALIZE_CONV tm = + (norm_conv0 ORELSEC + (norm_conv1 THENC + RAND_CONV POLY_NORMALIZE_CONV THENC + BETA_CONV THENC + RATOR_CONV(RAND_CONV(RATOR_CONV(LAND_CONV REAL_RAT_EQ_CONV))) THENC + norm_conv2)) tm in + POLY_NORMALIZE_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Some theorems asserting that operations give non-nil results. *) +(* ------------------------------------------------------------------------- *) + +let NOT_POLY_CMUL_NIL = prove + (`!h p. ~(p = []) ==> ~((h ## p) = [])`, + STRIP_TAC THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[]; SIMP_TAC[poly_cmul; NOT_CONS_NIL]]);; + +let NOT_POLY_MUL_NIL = prove + (`!p1 p2. ~(p1 = []) /\ ~(p2 = []) ==> ~((p1 ** p2) = [])`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + SIMP_TAC[poly_mul;NOT_CONS_NIL] THEN + SPEC_TAC (`t:(real)list`,`t:(real)list`) THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_cmul;NOT_CONS_NIL]; + SIMP_TAC[poly_cmul;poly_add;NOT_CONS_NIL]] + ] + ]);; + +let NOT_POLY_EXP_NIL = prove + (`!n p . ~(p = []) ==> ~((poly_exp p n) = [])`, + let lem001 = ASSUME `!p . ~(p = []) ==> ~(poly_exp p n = [])` in + let lem002 = SIMP_RULE[NOT_CONS_NIL] (SPEC `CONS (h:real) t` lem001) in + INDUCT_TAC THENL + [SIMP_TAC[poly_exp;NOT_CONS_NIL]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + SIMP_TAC[lem002;NOT_POLY_MUL_NIL;poly_exp;NOT_CONS_NIL] + ] + ]);; + +let NOT_POLY_EXP_X_NIL = prove + (`!n. ~((poly_exp [&0;&1] n) = [])`, + let lem01 = prove(`~([&0;&1] = [])`,SIMP_TAC[NOT_CONS_NIL]) in + INDUCT_TAC THENL + [SIMP_TAC[poly_exp;NOT_CONS_NIL]; + ASM_SIMP_TAC[poly_exp;NOT_POLY_MUL_NIL;lem01]]);; + +(* ------------------------------------------------------------------------- *) +(* Some general lemmas. *) +(* ------------------------------------------------------------------------- *) + +let POLY_CMUL_LID = prove + (`!p. &1 ## p = p`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_cmul]; + ASM_SIMP_TAC[poly_cmul] THEN SIMP_TAC[REAL_ARITH `&1 * h = h`]]);; + +let POLY_MUL_LID = prove + (`!p. [&1] ** p = p`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_mul;poly_cmul]; + ONCE_REWRITE_TAC[poly_mul] THEN SIMP_TAC[POLY_CMUL_LID]]);; + +let POLY_MUL_RID = prove + (`!p. p ** [&1] = p`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_mul]; + ASM_CASES_TAC `t:(real)list = []` THEN + ASM_SIMP_TAC[poly_mul;poly_cmul;poly_add;NOT_CONS_NIL;HD;TL; + REAL_ARITH `h + (real_of_num 0) = h`;REAL_ARITH `h * (real_of_num 1) = h`] + ]);; + +let POLY_ADD_SYM = prove + (`!x y . x ++ y = y ++ x`, + let lem1 = ASSUME `!y . t ++ y = y ++ t` in + let lem2 = SPEC `t':(real)list` lem1 in + LIST_INDUCT_TAC THENL + [LIST_INDUCT_TAC THENL [SIMP_TAC[poly_add]; SIMP_TAC[poly_add]]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_add]; + SIMP_TAC[POLY_ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[lem2] THEN + SIMP_TAC[SPECL [`h:real`;`h':real`] REAL_ADD_SYM] + ] + ]);; + +let POLY_ADD_ASSOC = prove + (`!x y z . x ++ (y ++ z) = (x ++ y) ++ z`, + let lem1 = ASSUME `!y z. t ++ y ++ z = (t ++ y) ++ z` in + let lem2 = SPECL [`t':(real)list`;`t'':(real)list`] lem1 in + LIST_INDUCT_TAC THENL + [SIMP_TAC[POLY_ADD_CLAUSES]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[POLY_ADD_CLAUSES]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[POLY_ADD_CLAUSES]; + SIMP_TAC[POLY_ADD_CLAUSES] THEN + SIMP_TAC[REAL_ADD_ASSOC] THEN + SIMP_TAC[lem2] + ] + ] + ]);; + +(* ------------------------------------------------------------------------- *) +(* Heads and tails resulting from operations. *) +(* ------------------------------------------------------------------------- *) + +let TL_POLY_MUL_X = prove + (`!p. TL ([&0;&1] ** p) = p`, + LIST_INDUCT_TAC THENL + [ONCE_REWRITE_TAC[poly_mul] THEN + SIMP_TAC[NOT_CONS_NIL;poly_cmul;poly_add;TL;poly_mul]; + ONCE_REWRITE_TAC[poly_mul] THEN SIMP_TAC[NOT_CONS_NIL] THEN + ONCE_REWRITE_TAC[poly_cmul] THEN ONCE_REWRITE_TAC[poly_add] THEN + SIMP_TAC[NOT_CONS_NIL] THEN SIMP_TAC[TL;POLY_MUL_LID] THEN + SPEC_TAC (`h:real`,`h:real`) THEN + SPEC_TAC (`t:(real)list`,`t:(real)list`) THEN + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_cmul;poly_add]; + ASM_SIMP_TAC[poly_cmul;poly_add;NOT_CONS_NIL;HD;TL; + REAL_ARITH `(&0) * h + h' = h'`] + ] + ]);; + +let HD_POLY_MUL_X = prove + (`!p. HD ([&0;&1] ** p) = &0`, + LIST_INDUCT_TAC THEN + SIMP_TAC[poly_mul;NOT_CONS_NIL;poly_cmul;poly_add;HD; + REAL_ARITH `&0 * h + &0 = &0`]);; + +let TL_POLY_EXP_X_SUC = prove + (`!n . TL (poly_exp [&0;&1] (SUC n)) = poly_exp [&0;&1] n`, + SIMP_TAC[poly_exp;TL_POLY_MUL_X]);; + +let HD_POLY_EXP_X_SUC = prove + (`!n . HD (poly_exp [&0;&1] (SUC n)) = &0`, + INDUCT_TAC THENL + [SIMP_TAC[poly_exp;poly_add;HD;TL;poly_cmul;poly_mul;NOT_CONS_NIL; + REAL_ARITH `&0 * &1 + &0 = &0`]; + SIMP_TAC[poly_exp;HD_POLY_MUL_X]]);; + +let HD_POLY_ADD = prove + (`!p1 p2. ~(p1 = []) /\ ~(p2 = []) ==> HD (p1 ++ p2) = (HD p1) + (HD p2)`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + SIMP_TAC[NOT_CONS_NIL;poly_add] THEN + ONCE_REWRITE_TAC[ISPECL [`h':real`;`t':(real)list`] NOT_CONS_NIL] THEN + SIMP_TAC[HD] + ] + ]);; + +let HD_POLY_CMUL = prove + (`!x p . ~(p = []) ==> HD (x ## p) = x * (HD p)`, + STRIP_TAC THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[]; SIMP_TAC[NOT_CONS_NIL;poly_cmul;HD]]);; + +let TL_POLY_CMUL = prove + (`!x p . ~(p = []) ==> TL (x ## p) = x ## (TL p)`, + STRIP_TAC THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[]; SIMP_TAC[NOT_CONS_NIL;poly_cmul;TL]]);; + +let HD_POLY_MUL = prove + (`!p1 p2 . ~(p1 = []) /\ ~(p2 = []) ==> HD (p1 ** p2) = (HD p1) * (HD p2)`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + SIMP_TAC[NOT_CONS_NIL;poly_mul] THEN + ASM_CASES_TAC `(t:(real)list) = []` THENL + [ASM_SIMP_TAC[poly_cmul;HD]; + ASM_SIMP_TAC[poly_cmul;poly_add;NOT_CONS_NIL;HD] THEN REAL_ARITH_TAC + ] + ] + ]);; + +let HD_POLY_EXP = prove + (`!n p . ~(p = []) ==> HD (poly_exp p n) = (HD p) pow n`, + INDUCT_TAC THENL + [SIMP_TAC[poly_exp] THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[]; SIMP_TAC[HD;pow]]; + SIMP_TAC[poly_exp] THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[]; + SIMP_TAC[HD;GSYM pow;NOT_CONS_NIL;poly_mul] THEN + ASM_CASES_TAC `(t:(real)list) = []` THENL + [ASM_SIMP_TAC[HD_POLY_CMUL;NOT_POLY_CMUL_NIL;NOT_POLY_EXP_NIL; + NOT_CONS_NIL;HD;GSYM pow]; + ASM_SIMP_TAC[NOT_POLY_CMUL_NIL;NOT_POLY_EXP_NIL;NOT_CONS_NIL; + HD_POLY_ADD;HD;HD_POLY_CMUL;GSYM pow] THEN + REAL_ARITH_TAC] + ] + ]);; + +(* ------------------------------------------------------------------------- *) +(* Additional general lemmas. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD_IDENT = prove + (`neutral (++) = []`, + let l1 = ASSUME `!x. (!y. x ++ y = y /\ y ++ x = y) + ==> (!y. (CONS h t) ++ y = y /\ y ++ (CONS h t) = y)` in + let l2 = SPEC `[]:(real)list` l1 in + let l3 = SIMP_RULE[POLY_ADD_CLAUSES] l2 in + let l4 = SPEC `[]:(real)list` l3 in + let l5 = CONJUNCT1 l4 in + let l6 = SIMP_RULE[POLY_ADD_CLAUSES;NOT_CONS_NIL] l5 in + let l7 = NOT_INTRO (DISCH_ALL l6) in + ONCE_REWRITE_TAC[neutral] THEN SELECT_ELIM_TAC THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[];SIMP_TAC[l7]]);; + +let POLY_ADD_NEUTRAL = prove + (`!x. neutral (++) ++ x = x`, + SIMP_TAC[POLY_ADD_IDENT;POLY_ADD_CLAUSES]);; + +let MONOIDAL_POLY_ADD = prove + (`monoidal poly_add`, + let lem1 = CONJ POLY_ADD_SYM (CONJ POLY_ADD_ASSOC POLY_ADD_NEUTRAL) in + ONCE_REWRITE_TAC[monoidal] THEN ACCEPT_TAC lem1);; + +let POLY_DIFF_AUX_ADD_LEMMA = prove + (`!t1 t2 n. poly_diff_aux n (t1 ++ t2) = + (poly_diff_aux n t1) ++ (poly_diff_aux n t2)`, + let lem = REAL_ARITH `!n h h'. (&n * h) + (&n * h') = &n * (h + h')` in + LIST_INDUCT_TAC THEN SIMP_TAC[POLY_ADD_CLAUSES;poly_diff_aux] THEN + LIST_INDUCT_TAC THEN SIMP_TAC[POLY_ADD_CLAUSES;poly_diff_aux] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[POLY_ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[poly_diff_aux] THEN + ONCE_REWRITE_TAC[POLY_ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[lem] THEN + ASM_SIMP_TAC[]);; + +let POLYDIFF_ADD = prove + (`!p1 p2. (poly_diff (p1 ++ p2)) = (poly_diff p1 ++ poly_diff p2)`, + let lem1 = prove + (`!h0 t0 h1 t1. ~(((CONS h0 t0) ++ (CONS h1 t1)) = [])`, + SIMP_TAC[POLY_ADD_CLAUSES;NOT_CONS_NIL]) in + let lem2 = prove + (`!h0 t0 h1 t1. + (TL ((CONS h0 t0) ++ (CONS h1 t1)) + = (TL (CONS h0 t0)) ++ (TL (CONS h1 t1)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[poly_add] THEN + ONCE_REWRITE_TAC[NOT_CONS_NIL] THEN REWRITE_TAC[TL] + THEN SIMP_TAC[]) in + REPEAT LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_add;poly_diff]; + SIMP_TAC[poly_add;poly_diff]; + SIMP_TAC[poly_add;poly_diff;POLY_ADD_CLAUSES]; + SIMP_TAC[poly_diff] THEN + ONCE_REWRITE_TAC[lem1;NOT_CONS_NIL] THEN + SIMP_TAC[lem2;POLY_DIFF_AUX_ADD_LEMMA] + ]);; + +let POLY_DIFF_AUX_POLY_CMUL = prove + (`!p c n. poly_diff_aux n (c ## p) = c ## (poly_diff_aux n p)`, + let lem01 = ASSUME + `!c n. poly_diff_aux n (c ## t) = c ## poly_diff_aux n t` in + let lem02 = SPECL [`c:real`;`SUC n`] lem01 in + LIST_INDUCT_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + SIMP_TAC[poly_cmul;poly_diff_aux;lem02; + REAL_ARITH `(a:real) * b * c = b * a * c`]);; + +let POLY_CMUL_POLY_DIFF = prove + (`!p c. poly_diff (c ## p) = c ## (poly_diff p)`, + LIST_INDUCT_TAC THEN + SIMP_TAC[poly_diff;POLY_DIFF_AUX_POLY_CMUL;TL_POLY_CMUL; + poly_cmul;NOT_CONS_NIL]);; + +(* ------------------------------------------------------------------------- *) +(* Theorems about the lengths of lists from the polynomial operations. *) +(* ------------------------------------------------------------------------- *) + +let POLY_CMUL_LENGTH = prove + (`!c p. LENGTH (c ## p) = LENGTH p`, + STRIP_TAC THEN LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_cmul]; + SIMP_TAC[poly_cmul] THEN ASM_SIMP_TAC[LENGTH] + ]);; + +let POLY_ADD_LENGTH = prove + (`!p q. LENGTH (p ++ q) = MAX (LENGTH p) (LENGTH q)`, + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_add;LENGTH] THEN ARITH_TAC; + LIST_INDUCT_TAC THENL + [SIMP_TAC[poly_add;LENGTH] THEN ARITH_TAC; + SIMP_TAC[poly_add;LENGTH] THEN + ONCE_REWRITE_TAC[NOT_CONS_NIL] THEN SIMP_TAC[HD;TL;LENGTH] THEN + ASM_SIMP_TAC[] THEN + ONCE_REWRITE_TAC[ARITH_RULE `MAX x y = if (x > y) then x else y`] THEN + ASM_CASES_TAC `LENGTH (t:(real)list) > LENGTH (t':(real)list)` THENL + [ASM_SIMP_TAC[ARITH_RULE `x > y ==> (SUC x) > (SUC y)`]; + ASM_SIMP_TAC[ARITH_RULE `~(x > y) ==> ~((SUC x) > (SUC y))`]] + ] + ]);; + +let POLY_MUL_LENGTH = prove + (`!p h t. LENGTH (p ** (CONS h t)) >= LENGTH p`, + let lemma01 = ASSUME `!h t'. LENGTH (t ** CONS h t') >= LENGTH t` in + let lemma02 = SPECL [`h':real`;`t':(real)list`] lemma01 in + let lemma03 = ONCE_REWRITE_RULE[ARITH_RULE `(x:num) >= y <=> SUC x >= SUC y`] + lemma02 in + let lemma05 = ARITH_RULE `(y:num) >= z ==> (x + (y - x) >= z) ` in + let lemma06 = SPECL [`SUC (LENGTH (t ** (CONS (h':real) t')))`; + `LENGTH (h ## (CONS h' t'))`; + `SUC (LENGTH (t:(real)list))`] (GEN_ALL lemma05) in + let lemma07 = MATCH_MP (lemma06) (lemma03) in + LIST_INDUCT_TAC THENL + [SIMP_TAC[POLY_MUL_CLAUSES] THEN ARITH_TAC; + SIMP_TAC[poly_mul] THEN ASM_CASES_TAC `(t:(real)list) = []` THENL + [ASM_SIMP_TAC[POLY_CMUL_LENGTH;LENGTH] THEN ARITH_TAC; + ASM_SIMP_TAC[POLY_ADD_LENGTH;LENGTH;lemma07; + ARITH_RULE `!x y. (MAX x y) = x + (y - x)`] + ] + ]);; + +let POLY_EXP_X_REC = prove + (`!n. poly_exp [&0;&1] (SUC n) = CONS (&0) (poly_exp [&0;&1] n)`, + let lem01 = MATCH_MP CONS_HD_TL (SPEC `(SUC n)` NOT_POLY_EXP_X_NIL) in + let lem02 = ONCE_REWRITE_RULE[HD_POLY_EXP_X_SUC; TL_POLY_EXP_X_SUC] lem01 in + ACCEPT_TAC (GEN_ALL lem02));; + +let POLY_MUL_LENGTH2 = prove + (`!q p. ~(q = []) ==> LENGTH (p ** q) >= LENGTH p`, + LIST_INDUCT_TAC THEN SIMP_TAC[NOT_CONS_NIL; POLY_MUL_LENGTH]);; + +let POLY_EXP_X_LENGTH = prove + (`!n. LENGTH (poly_exp [&0;&1] n) = SUC n`, + INDUCT_TAC THEN + ASM_SIMP_TAC[poly_exp;LENGTH; POLY_EXP_X_REC; + ARITH_RULE `(SUC x) = (SUC y) <=> x = y`]);; + +(* ------------------------------------------------------------------------- *) +(* Expansion of a polynomial as a power sum. *) +(* ------------------------------------------------------------------------- *) + +let POLY_SUM_EQUIV = prove + (`!p x. + ~(p = []) ==> + poly p x = sum (0..(PRE (LENGTH p))) (\i. (EL i p)*(x pow i))`, + let lem000 = ARITH_RULE `0 <= 0 + 1 /\ 0 <= (LENGTH (t:(real)list))` in + let lem001 = SPECL + [`f:num->real`;`0`;`0`;`LENGTH (t:(real)list)`] + SUM_COMBINE_R in + let lem002 = MP lem001 lem000 in + let lem003 = SPECL + [`f:num->real`;`1`;`LENGTH (t:(real)list)`] + SUM_OFFSET_0 in + let lem004 = ASSUME `~((t:(real)list) = [])` in + let lem005 = ONCE_REWRITE_RULE[GSYM LENGTH_EQ_NIL] lem004 in + let lem006 = ONCE_REWRITE_RULE[ARITH_RULE `~(x = 0) <=> (1 <= x)`] lem005 in + let lem007 = MP lem003 lem006 in + let lem017 = ARITH_RULE `1 <= (LENGTH (t:(real)list)) + ==> ((LENGTH t) - 1 = PRE (LENGTH t))` in + let lem018 = MP lem017 lem006 in + LIST_INDUCT_TAC THENL + [ SIMP_TAC[NOT_CONS_NIL] + ; + ASM_CASES_TAC `(t:(real)list) = []` THENL + [ + ASM_SIMP_TAC[POLY_CONST;LENGTH;PRE] + THEN ONCE_REWRITE_TAC[NUMSEG_CONV `0..0`] + THEN ONCE_REWRITE_TAC[SUM_SING] + THEN BETA_TAC + THEN ONCE_REWRITE_TAC[EL] + THEN ONCE_REWRITE_TAC[HD] + THEN REAL_ARITH_TAC + ; + ASM_SIMP_TAC[POLY_CONST;LENGTH;PRE] + THEN ONCE_REWRITE_TAC[poly] + THEN ONCE_REWRITE_TAC[GSYM lem002] + THEN ONCE_REWRITE_TAC[ARITH_RULE `0 + 1 = 1`] + THEN ONCE_REWRITE_TAC[NUMSEG_CONV `0..0`] + THEN ONCE_REWRITE_TAC[SUM_SING] + THEN BETA_TAC + THEN SIMP_TAC[EL;HD] + THEN ONCE_REWRITE_TAC[lem007] + THEN BETA_TAC + THEN ONCE_REWRITE_TAC[GSYM ADD1] + THEN SIMP_TAC[EL;TL] + THEN ONCE_REWRITE_TAC[real_pow] + THEN ONCE_REWRITE_TAC[REAL_MUL_RID] + THEN ONCE_REWRITE_TAC[REAL_ARITH `(A:real) * B * C = B * (A * C)`] + THEN ONCE_REWRITE_TAC[NSUM_LMUL] + THEN ONCE_REWRITE_TAC[SUM_LMUL] + THEN ASM_SIMP_TAC[] + THEN SIMP_TAC[NOT_CONS_NIL] + THEN ONCE_REWRITE_TAC[lem018] + THEN SIMP_TAC[] + ]]);; + +let ITERATE_RADD_POLYADD = prove + (`!n x f. iterate (+) (0..n) (\i.poly (f i) x) = + poly (iterate (++) (0..n) f) x`, + INDUCT_TAC THEN + ASM_SIMP_TAC[ITERATE_CLAUSES_NUMSEG; MONOIDAL_REAL_ADD; MONOIDAL_POLY_ADD; + LE_0; POLY_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* Now we're finished with polynomials... *) +(* ------------------------------------------------------------------------- *) + +do_list reduce_interface + ["divides",`poly_divides:real list->real list->bool`; + "exp",`poly_exp:real list -> num -> real list`; + "diff",`poly_diff:real list->real list`];; + +unparse_as_infix "exp";; diff --git a/Library/pratt.ml b/Library/pratt.ml new file mode 100644 index 0000000..1c3cf5d --- /dev/null +++ b/Library/pratt.ml @@ -0,0 +1,1013 @@ +(* ========================================================================= *) +(* HOL primality proving procedure, based on Pratt certificates. *) +(* ========================================================================= *) + +needs "Library/prime.ml";; + +prioritize_num();; + +let num_0 = Int 0;; +let num_1 = Int 1;; +let num_2 = Int 2;; + +(* ------------------------------------------------------------------------- *) +(* Mostly for compatibility. Should eliminate this eventually. *) +(* ------------------------------------------------------------------------- *) + +let nat_mod_lemma = prove + (`!x y n:num. (x == y) (mod n) /\ y <= x ==> ?q. x = y + n * q`, + REPEAT GEN_TAC THEN REWRITE_TAC[num_congruent] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_REWRITE_TAC + [INTEGER_RULE `(x == y) (mod &n) <=> &n divides (x - y)`] THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; + ARITH_RULE `x <= y ==> (y:num = x + d <=> y - x = d)`] THEN + REWRITE_TAC[GSYM num_divides; divides]);; + +let nat_mod = prove + (`!x y n:num. (mod n) x y <=> ?q1 q2. x + n * q1 = y + n * q2`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM cong] THEN + EQ_TAC THENL [ALL_TAC; NUMBER_TAC] THEN + MP_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THEN + REWRITE_TAC[TAUT `a \/ b ==> c ==> d <=> (c /\ b) \/ (c /\ a) ==> d`] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [ALL_TAC; + ONCE_REWRITE_TAC[NUMBER_RULE + `(x:num == y) (mod n) <=> (y == x) (mod n)`]] THEN + MESON_TAC[nat_mod_lemma; ARITH_RULE `x + y * 0 = x`]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about previously defined terms. *) +(* ------------------------------------------------------------------------- *) + +let PRIME = prove + (`!p. prime p <=> + ~(p = 0) /\ ~(p = 1) /\ !m. 0 < m /\ m < p ==> coprime(p,m)`, + GEN_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1] THEN + EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP PRIME_COPRIME) THEN + DISCH_TAC THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[COPRIME_1] THEN + ASM_MESON_TAC[NOT_LT; LT_REFL; DIVIDES_LE]; ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `q:num` MP_TAC o MATCH_MP PRIME_FACTOR) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `q:num`) THEN + SUBGOAL_THEN `~(coprime(p,q))` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[coprime; NOT_FORALL_THM] THEN + EXISTS_TAC `q:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL] THEN + ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[LT_LE; LE_0] THEN + ASM_CASES_TAC `p:num = q` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[] THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[DIVIDES_ZERO]);; + +let FINITE_NUMBER_SEGMENT = prove + (`!n. { m | 0 < m /\ m < n } HAS_SIZE (n - 1)`, + INDUCT_TAC THENL + [SUBGOAL_THEN `{m | 0 < m /\ m < 0} = EMPTY` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN + CONV_TAC NUM_REDUCE_CONV; + ASM_CASES_TAC `n = 0` THENL + [SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = EMPTY` SUBST1_TAC THENL + [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[HAS_SIZE_0]; + SUBGOAL_THEN `{m | 0 < m /\ m < SUC n} = n INSERT {m | 0 < m /\ m < n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `~(n = 0)` THEN + POP_ASSUM MP_TAC THEN + SIMP_TAC[FINITE_RULES; HAS_SIZE; CARD_CLAUSES] THEN + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; LT_REFL] THEN + ARITH_TAC]]);; + +let COPRIME_MOD = prove + (`!a n. ~(n = 0) ==> (coprime(a MOD n,n) <=> coprime(a,n))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) + [MATCH_MP DIVISION th]) THEN REWRITE_TAC[coprime] THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MESON_TAC[DIVIDES_ADD; DIVIDES_ADD_REVR; DIVIDES_ADD_REVL; + DIVIDES_LMUL; DIVIDES_RMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Congruences. *) +(* ------------------------------------------------------------------------- *) + +let CONG = prove + (`!x y n. ~(n = 0) ==> ((x == y) (mod n) <=> (x MOD n = y MOD n))`, + REWRITE_TAC[cong; nat_mod] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [ASM_CASES_TAC `x <= y` THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q1 - q2`; + MATCH_MP_TAC MOD_EQ THEN EXISTS_TAC `q2 - q1`] THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN ARITH_TAC; + MAP_EVERY EXISTS_TAC [`y DIV n`; `x DIV n`] THEN + UNDISCH_TAC `x MOD n = y MOD n` THEN + MATCH_MP_TAC(ARITH_RULE + `(y = dy + my) /\ (x = dx + mx) ==> (mx = my) ==> (x + dy = y + dx)`) THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[DIVISION]]);; + +let CONG_MOD_0 = prove + (`!x y. (x == y) (mod 0) <=> (x = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod; MULT_CLAUSES; ADD_CLAUSES]);; + +let CONG_MOD_1 = prove + (`!x y. (x == y) (mod 1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN + MAP_EVERY EXISTS_TAC [`y:num`; `x:num`] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_AC]);; + +let CONG_0 = prove + (`!x n. ((x == 0) (mod n) <=> n divides x)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[DIVIDES_ZERO; CONG_MOD_0] THEN + ASM_SIMP_TAC[CONG; MOD_0; MOD_EQ_0] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[divides]);; + +let CONG_SUB_CASES = prove + (`!x y n. (x == y) (mod n) <=> + if x <= y then (y - x == 0) (mod n) + else (x - y == 0) (mod n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cong; nat_mod] THEN + COND_CASES_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]; ALL_TAC] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let CONG_MULT_LCANCEL = prove + (`!a n x y. coprime(a,n) /\ (a * x == a * y) (mod n) ==> (x == y) (mod n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = 0` THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[COPRIME_0] THEN + SIMP_TAC[CONG_MOD_1]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[CONG_SUB_CASES] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN + REWRITE_TAC[GSYM LEFT_SUB_DISTRIB; CONG_0] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[COPRIME_DIVPROD; COPRIME_SYM]);; + +let CONG_REFL = prove + (`!x n. (x == x) (mod n)`, + MESON_TAC[cong; nat_mod; ADD_CLAUSES; MULT_CLAUSES]);; + +let CONG_SYM = prove + (`!x y n. (x == y) (mod n) <=> (y == x) (mod n)`, + REWRITE_TAC[cong; nat_mod] THEN MESON_TAC[]);; + +let CONG_TRANS = prove + (`!x y z n. (x == y) (mod n) /\ (y == z) (mod n) ==> (x == z) (mod n)`, + REWRITE_TAC[cong; nat_mod] THEN + MESON_TAC[ARITH_RULE + `(x + n * q1 = y + n * q2) /\ + (y + n * q3 = z + n * q4) + ==> (x + n * (q1 + q3) = z + n * (q2 + q4))`]);; + +(* ------------------------------------------------------------------------- *) +(* Euler totient function. *) +(* ------------------------------------------------------------------------- *) + +let phi = new_definition + `phi(n) = CARD { m | 0 < m /\ m <= n /\ coprime(m,n) }`;; + +let PHI_ALT = prove + (`phi(n) = CARD { m | coprime(m,n) /\ m < n}`, + REWRITE_TAC[phi] THEN + ASM_CASES_TAC `n = 0` THENL + [AP_TERM_TAC THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[LT; NOT_LT]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [SUBGOAL_THEN + `({m | 0 < m /\ m <= n /\ coprime (m,n)} = {1}) /\ + ({m | coprime (m,n) /\ m < n} = {0})` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [ALL_TAC; SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY]] THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + REWRITE_TAC[COPRIME_1] THEN REPEAT STRIP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + AP_TERM_TAC THEN ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `m:num` THEN ASM_CASES_TAC `m = 0` THEN + ASM_REWRITE_TAC[LT] THENL + [ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]; + ASM_MESON_TAC[LE_LT; COPRIME_REFL; LT_NZ]]);; + +let PHI_ANOTHER = prove + (`!n. ~(n = 1) ==> (phi(n) = CARD {m | 0 < m /\ m < n /\ coprime(m,n)})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phi] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[LE_LT; COPRIME_REFL; COPRIME_1; LT_NZ]);; + +let PHI_LIMIT = prove + (`!n. phi(n) <= n`, + GEN_TAC THEN REWRITE_TAC[PHI_ALT] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_LT] THEN + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[FINITE_NUMSEG_LT] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +let PHI_LIMIT_STRONG = prove + (`!n. ~(n = 1) ==> phi(n) <= n - 1`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN + ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +let PHI_0 = prove + (`phi 0 = 0`, + MP_TAC(SPEC `0` PHI_LIMIT) THEN REWRITE_TAC[ARITH] THEN ARITH_TAC);; + +let PHI_1 = prove + (`phi 1 = 1`, + REWRITE_TAC[PHI_ALT; COPRIME_1; CARD_NUMSEG_LT]);; + +let PHI_LOWERBOUND_1_STRONG = prove + (`!n. 1 <= n ==> 1 <= phi(n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1 = CARD {1}` SUBST1_TAC THENL + [SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; FINITE_RULES; ARITH]; ALL_TAC] THEN + REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN + GEN_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN + REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]]);; + +let PHI_LOWERBOUND_1 = prove + (`!n. 2 <= n ==> 1 <= phi(n)`, + MESON_TAC[PHI_LOWERBOUND_1_STRONG; LE_TRANS; ARITH_RULE `1 <= 2`]);; + +let PHI_LOWERBOUND_2 = prove + (`!n. 3 <= n ==> 2 <= phi(n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `2 = CARD {1,(n-1)}` SUBST1_TAC THENL + [SIMP_TAC[CARD_CLAUSES; IN_INSERT; NOT_IN_EMPTY; FINITE_RULES; ARITH] THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> ~(1 = n - 1)`]; ALL_TAC] THEN + REWRITE_TAC[phi] THEN MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN + ASM_SIMP_TAC[ARITH; + ARITH_RULE `3 <= n ==> 0 < n - 1 /\ n - 1 <= n /\ 1 <= n`] THEN + REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + MP_TAC(SPEC `n:num` COPRIME_1) THEN REWRITE_TAC[coprime] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `1 = n - (n - 1)` SUBST1_TAC THENL + [UNDISCH_TAC `3 <= n` THEN ARITH_TAC; + ASM_SIMP_TAC[DIVIDES_SUB]]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | b <= n}` THEN + REWRITE_TAC[CARD_NUMSEG_LE; FINITE_NUMSEG_LE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]]);; + +let PHI_PRIME_EQ = prove + (`!n. (phi n = n - 1) /\ ~(n = 0) /\ ~(n = 1) <=> prime n`, + GEN_TAC THEN REWRITE_TAC[PRIME] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[PHI_1; ARITH] THEN + MP_TAC(SPEC `n:num` FINITE_NUMBER_SEGMENT) THEN + ASM_SIMP_TAC[PHI_ANOTHER; HAS_SIZE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `{m | 0 < m /\ m < n /\ coprime (m,n)} = {m | 0 < m /\ m < n}` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[COPRIME_SYM] THEN CONV_TAC TAUT] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC CARD_SUBSET_EQ THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +let PHI_PRIME = prove + (`!p. prime p ==> phi p = p - 1`, + MESON_TAC[PHI_PRIME_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Fermat's Little theorem. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENCE_POS_LEMMA = prove + (`b <= a /\ + (?x1 x2. x1 * n + a = x2 * n + b) + ==> ?x. a = x * n + b`, + STRIP_TAC THEN EXISTS_TAC `x2 - x1` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[RIGHT_SUB_DISTRIB] THEN ARITH_TAC);; + +let ITSET_MODMULT = prove + (`!n s. FINITE s /\ ~(n = 0) /\ ~(n = 1) /\ coprime(a,n) + ==> (!b. b IN s ==> b < n) + ==> (ITSET (\x y. (x * y) MOD n) (IMAGE (\b. (a * b) MOD n) s) 1 = + (a EXP (CARD s) * ITSET (\x y. (x * y) MOD n) s 1) MOD n)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `coprime(a,n)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + MP_TAC(ISPECL [`\x y. (x * y) MOD n`; `1`] FINITE_RECURSION) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_SIMP_TAC[MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[IMAGE_CLAUSES; CARD_CLAUSES; FINITE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `b:num` THEN X_GEN_TAC `s:num->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_INSERT] THEN + REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + ASM_CASES_TAC `!b. b IN s ==> b < n` THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `b:num`) THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~((a * b) MOD n IN IMAGE (\b. (a * b) MOD n) s)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[GSYM CONG] THEN DISCH_TAC THEN + UNDISCH_TAC `~(b:num IN s)` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `b:num = c` (fun th -> ASM_REWRITE_TAC[th]) THEN + SUBGOAL_THEN `b MOD n = c MOD n` MP_TAC THENL + [ASM_SIMP_TAC[GSYM CONG] THEN + MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[MOD_LT]; ALL_TAC] THEN + REWRITE_TAC[EXP] THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN + REWRITE_TAC[MULT_AC]);; + +let ITSET_MODMULT_COPRIME = prove + (`!n s. FINITE s /\ (!b. b IN s ==> coprime(b,n)) /\ ~(n = 0) + ==> coprime(ITSET (\x y. (x * y) MOD n) s 1,n)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + MP_TAC(ISPECL [`\x y. (x * y) MOD n`; `1`] FINITE_RECURSION) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_SIMP_TAC[MOD_MULT_RMOD] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[IMAGE_CLAUSES; CARD_CLAUSES; FINITE_IMAGE] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_1] THEN + REWRITE_TAC[IN_INSERT] THEN + REWRITE_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + MAP_EVERY X_GEN_TAC [`x:num`; `s:num->bool`] THEN + ASM_CASES_TAC `!b. b IN s ==> coprime(b,n)` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `x:num`) THEN + ASM_SIMP_TAC[COPRIME_MOD; ONCE_REWRITE_RULE[COPRIME_SYM] COPRIME_MUL]);; + +let FERMAT_LITTLE = prove + (`!a n. coprime(a,n) ==> (a EXP (phi n) == 1) (mod n)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN + ASM_SIMP_TAC[COPRIME_0; PHI_0; CONG_MOD_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[CONG_MOD_1] THEN DISCH_TAC THEN + SUBGOAL_THEN + `{ c | ?b. 0 < b /\ b < n /\ coprime(b,n) /\ (c = (a * b) MOD n) } = + { b | 0 < b /\ b < n /\ coprime(b,n) }` + MP_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `c:num` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `b:num` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[DIVISION] THEN + MATCH_MP_TAC(TAUT `b /\ (~a ==> ~b) ==> a /\ b`) THEN + SIMP_TAC[ARITH_RULE `~(0 < n) <=> (n = 0)`] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[COPRIME_0] THEN + SUBGOAL_THEN `coprime(n,a * b)` MP_TAC THENL + [MATCH_MP_TAC COPRIME_MUL THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `a * b = (a * b) DIV n * n + (a * b) MOD n` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN + STRIP_TAC THEN MP_TAC(SPECL [`a:num`; `n:num`] BEZOUT) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` + (X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)))) THEN + SUBGOAL_THEN `d = 1` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[coprime]; ALL_TAC] THEN + STRIP_TAC THENL + [EXISTS_TAC `(c * x) MOD n` THEN + MATCH_MP_TAC(TAUT `(~a ==> ~c) /\ b /\ c /\ d ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [SIMP_TAC[ARITH_RULE `~(0 < n) <=> (n = 0)`] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[COPRIME_0]; + ALL_TAC] THEN + ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL + [SUBGOAL_THEN `coprime(n,c * x)` MP_TAC THENL + [MATCH_MP_TAC COPRIME_MUL THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[coprime; GSYM DIVIDES_ONE] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + SIMP_TAC[DIVIDES_SUB; DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `c * x = (c * x) DIV n * n + (c * x) MOD n` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[MOD_MULT_RMOD] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `c * y:num` THEN + ASM_REWRITE_TAC[GSYM MULT_ASSOC] THEN + ONCE_REWRITE_TAC[ARITH_RULE + `(a * c * x = b:num) <=> (c * a * x = b)`] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `(a - b = 1) ==> (a = b + 1)`)) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_CLAUSES; MULT_AC]; + + EXISTS_TAC `(c * (n - y MOD n)) MOD n` THEN + MATCH_MP_TAC(TAUT `(~a ==> ~c) /\ b /\ c /\ d ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [SIMP_TAC[ARITH_RULE `~(0 < n) <=> (n = 0)`] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_SIMP_TAC[COPRIME_0]; + ALL_TAC] THEN + ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL + [SUBGOAL_THEN `coprime(n,c * (n - y MOD n))` MP_TAC THENL + [MATCH_MP_TAC COPRIME_MUL THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[coprime; GSYM DIVIDES_ONE] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + X_GEN_TAC `e:num` THEN STRIP_TAC THEN MATCH_MP_TAC DIVIDES_SUB THEN + ASM_SIMP_TAC[DIVIDES_RMUL; DIVIDES_REFL] THEN + MATCH_MP_TAC DIVIDES_LMUL THEN + SUBGOAL_THEN `y = (y DIV n) * n + y MOD n` SUBST1_TAC THENL + [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + MATCH_MP_TAC DIVIDES_ADD THEN + ASM_SIMP_TAC[DIVIDES_LMUL; DIVIDES_REFL] THEN + MATCH_MP_TAC DIVIDES_ADD_REVR THEN + EXISTS_TAC `n - y MOD n` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[ARITH_RULE `m < n ==> ((n - m) + m = n:num)`; + DIVISION]; + ALL_TAC] THEN + SUBGOAL_THEN `!x. c * x = (c * x) DIV n * n + (c * x) MOD n` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[DIVIDES_ADD; DIVIDES_LMUL; DIVIDES_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[MOD_MULT_RMOD] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_UNIQ THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFFERENCE_POS_LEMMA THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[ARITH_RULE + `c <= a * c * x <=> c * 1 <= c * a * x`] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; MULT_EQ_0; + SUB_EQ_0; DE_MORGAN_THM] THEN + UNDISCH_TAC `coprime(a,n)` THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_CASES_TAC `a = 0` THEN ASM_REWRITE_TAC[COPRIME_0] THEN + DISCH_TAC THEN ASM_SIMP_TAC[DIVISION; NOT_LE]; ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`c * x`; `c * a * (1 + y DIV n)`] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; LEFT_SUB_DISTRIB] THEN + MATCH_MP_TAC(ARITH_RULE + `y <= n /\ (a + n = x + y) ==> (a + (n - y) = x)`) THEN + CONJ_TAC THENL + [REWRITE_TAC[MULT_ASSOC] THEN REWRITE_TAC[LE_MULT_LCANCEL] THEN + ASM_SIMP_TAC[LT_IMP_LE; DIVISION]; ALL_TAC] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[GSYM ADD_ASSOC; GSYM MULT_ASSOC] THEN + REWRITE_TAC[ARITH_RULE + `(x + a * c * n = c * a * n + y) <=> (x = y)`] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `(n * x - a * y = 1) ==> (x * n = a * y + 1)`)) THEN + SUBGOAL_THEN `y = (y DIV n) * n + y MOD n` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC; ADD_AC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `{c | ?b. 0 < b /\ b < n /\ coprime (b,n) /\ (c = (a * b) MOD n)} = + IMAGE (\b. (a * b) MOD n) {b | 0 < b /\ b < n /\ coprime (b,n)}` + SUBST1_TAC THENL + [REWRITE_TAC[IMAGE; EXTENSION; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o AP_TERM `ITSET (\x y. (x * y) MOD n)`) THEN + DISCH_THEN(MP_TAC o C AP_THM `1`) THEN + SUBGOAL_THEN `FINITE {b | 0 < b /\ b < n /\ coprime (b,n)} /\ + !b. b IN {b | 0 < b /\ b < n /\ coprime (b,n)} ==> b < n` + ASSUME_TAC THENL + [CONJ_TAC THENL [ALL_TAC; SIMP_TAC[IN_ELIM_THM]] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{b | 0 < b /\ b < n}` THEN + REWRITE_TAC[REWRITE_RULE[HAS_SIZE] FINITE_NUMBER_SEGMENT] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM]; ALL_TAC] THEN + ASM_SIMP_TAC[REWRITE_RULE[IMP_IMP] + ITSET_MODMULT] THEN + ASM_SIMP_TAC[GSYM PHI_ANOTHER] THEN + DISCH_THEN(MP_TAC o AP_TERM `(MOD)`) THEN + DISCH_THEN(MP_TAC o C AP_THM `n:num`) THEN + ASM_SIMP_TAC[MOD_MOD_REFL] THEN ASM_SIMP_TAC[GSYM CONG] THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o RAND_CONV) + [ARITH_RULE `x = x * 1`] THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [MULT_SYM] THEN + DISCH_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `ITSET (\x y. (x * y) MOD n) + {b | 0 < b /\ b < n /\ coprime (b,n)} 1` THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[ITSET_MODMULT_COPRIME; IN_ELIM_THM]);; + +let FERMAT_LITTLE_PRIME = prove + (`!p a. prime p ==> (a EXP p == a) (mod p)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME) THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN STRIP_TAC THENL + [ASM_REWRITE_TAC[EXP_ONE; CONG_REFL]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `0` THEN + GEN_REWRITE_TAC RAND_CONV [CONG_SYM] THEN ASM_REWRITE_TAC[CONG_0] THEN + ASM_MESON_TAC[DIVIDES_EXP; DIVIDES_EXP2; PRIME_0]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FERMAT_LITTLE) THEN + ASM_SIMP_TAC[snd(EQ_IMP_RULE (SPEC_ALL PHI_PRIME_EQ))] THEN + REWRITE_TAC[cong; nat_mod] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:num` (X_CHOOSE_THEN `q2:num` MP_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `( * ) a`) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; GSYM(CONJUNCT2 EXP)] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + REWRITE_TAC[MULT_CLAUSES; GSYM MULT_ASSOC] THEN + ASM_MESON_TAC[ARITH_RULE `~(p = 0) ==> (SUC(p - 1) = p)`; PRIME_0]);; + +(* ------------------------------------------------------------------------- *) +(* Lucas's theorem. *) +(* ------------------------------------------------------------------------- *) + +let LUCAS_COPRIME_LEMMA = prove + (`!m n a. ~(m = 0) /\ (a EXP m == 1) (mod n) ==> coprime(a,n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[CONG_MOD_0; EXP_EQ_1] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN SIMP_TAC[COPRIME_1]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[COPRIME_1] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[coprime] THEN X_GEN_TAC `d:num` THEN STRIP_TAC THEN + UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN + ASM_SIMP_TAC[CONG] THEN + SUBGOAL_THEN `1 MOD n = 1` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + MAP_EVERY UNDISCH_TAC [`~(n = 0)`; `~(n = 1)`] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `d divides (a EXP m) MOD n` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[DIVIDES_ONE]] THEN + MATCH_MP_TAC DIVIDES_ADD_REVR THEN + EXISTS_TAC `a EXP m DIV n * n` THEN + ASM_SIMP_TAC[GSYM DIVISION; DIVIDES_LMUL] THEN + SUBGOAL_THEN `m = SUC(m - 1)` SUBST1_TAC THENL + [UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; + ASM_SIMP_TAC[EXP; DIVIDES_RMUL]]);; + +let LUCAS_WEAK = prove + (`!a n. 2 <= n /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!m. 0 < m /\ m < n - 1 ==> ~(a EXP m == 1) (mod n)) + ==> prime(n)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM PHI_PRIME_EQ; PHI_LIMIT_STRONG; GSYM LE_ANTISYM; + ARITH_RULE `2 <= n ==> ~(n = 0) /\ ~(n = 1)`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `phi n`) THEN + SUBGOAL_THEN `coprime(a,n)` (fun th -> SIMP_TAC[FERMAT_LITTLE; th]) THENL + [MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN EXISTS_TAC `n - 1` THEN + ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n - 1 = 0)`]; ALL_TAC] THEN + REWRITE_TAC[GSYM NOT_LT] THEN + MATCH_MP_TAC(TAUT `a ==> ~(a /\ b) ==> ~b`) THEN + ASM_SIMP_TAC[PHI_LOWERBOUND_1; ARITH_RULE `1 <= n ==> 0 < n`]);; + +let LUCAS = prove + (`!a n. 2 <= n /\ + (a EXP (n - 1) == 1) (mod n) /\ + (!p. prime(p) /\ p divides (n - 1) + ==> ~(a EXP ((n - 1) DIV p) == 1) (mod n)) + ==> prime(n)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `2 <= n ==> ~(n = 0)`)) THEN + MATCH_MP_TAC LUCAS_WEAK THEN EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`; GSYM NOT_EXISTS_THM] THEN + ONCE_REWRITE_TAC[num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN + SUBGOAL_THEN `m divides (n - 1)` MP_TAC THENL + [REWRITE_TAC[divides] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_SIMP_TAC[GSYM MOD_EQ_0] THEN + MATCH_MP_TAC(ARITH_RULE `~(0 < n) ==> (n = 0)`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(n - 1) MOD m`) THEN + ASM_SIMP_TAC[DIVISION] THEN CONJ_TAC THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `m:num` THEN + ASM_SIMP_TAC[DIVISION]; ALL_TAC] THEN + MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `a EXP ((n - 1) DIV m * m)` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC LUCAS_COPRIME_LEMMA THEN + EXISTS_TAC `m:num` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM EXP_ADD] THEN + ASM_SIMP_TAC[GSYM DIVISION] THEN REWRITE_TAC[MULT_CLAUSES] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EXP_EXP] THEN + UNDISCH_TAC `(a EXP (n - 1) == 1) (mod n)` THEN + UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN + ASM_SIMP_TAC[CONG] THEN REPEAT DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `((a EXP m) MOD n) EXP ((n - 1) DIV m) MOD n` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[MOD_EXP_MOD]] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MOD_EXP_MOD] THEN + REWRITE_TAC[EXP_ONE]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `~(r = 1)` MP_TAC THENL + [UNDISCH_TAC `m < m * r` THEN CONV_TAC CONTRAPOS_CONV THEN + SIMP_TAC[MULT_CLAUSES; LT_REFL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP PRIME_FACTOR) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN STRIP_TAC THEN + UNDISCH_TAC `!p. prime p /\ p divides m * r + ==> ~(a EXP ((m * r) DIV p) == 1) (mod n)` THEN + DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_SIMP_TAC[DIVIDES_LMUL] THEN + SUBGOAL_THEN `(m * r) DIV p = m * (r DIV p)` SUBST1_TAC THENL + [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + UNDISCH_TAC `prime p` THEN + ASM_CASES_TAC `p = 0` THEN ASM_REWRITE_TAC[PRIME_0] THEN + ASM_SIMP_TAC[ARITH_RULE `~(p = 0) ==> 0 < p`] THEN + DISCH_TAC THEN REWRITE_TAC[ADD_CLAUSES; GSYM MULT_ASSOC] THEN + AP_TERM_TAC THEN UNDISCH_TAC `p divides r` THEN + REWRITE_TAC[divides] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[DIV_MULT] THEN REWRITE_TAC[MULT_AC]; ALL_TAC] THEN + UNDISCH_TAC `(a EXP m == 1) (mod n)` THEN + ASM_SIMP_TAC[CONG] THEN + DISCH_THEN(MP_TAC o C AP_THM `r DIV p` o AP_TERM `(EXP)`) THEN + DISCH_THEN(MP_TAC o C AP_THM `n:num` o AP_TERM `(MOD)`) THEN + ASM_SIMP_TAC[MOD_EXP_MOD] THEN + REWRITE_TAC[EXP_EXP; EXP_ONE]);; + +(* ------------------------------------------------------------------------- *) +(* Prime factorizations. *) +(* ------------------------------------------------------------------------- *) + +let primefact = new_definition + `primefact ps n <=> (ITLIST (*) ps 1 = n) /\ !p. MEM p ps ==> prime(p)`;; + +let PRIMEFACT = prove + (`!n. ~(n = 0) ==> ?ps. primefact ps n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THENL + [REPEAT DISCH_TAC THEN EXISTS_TAC `[]:num list` THEN + REWRITE_TAC[primefact; ITLIST; MEM]; ALL_TAC] THEN + DISCH_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o + MATCH_MP PRIME_FACTOR) THEN + UNDISCH_TAC `p divides n` THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + UNDISCH_TAC `~(p * m = 0)` THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN + GEN_REWRITE_TAC (funpow 3 LAND_CONV) [ARITH_RULE `n = 1 * n`] THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL] THEN + SUBGOAL_THEN `1 < p` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC(ARITH_RULE `~(p = 0) /\ ~(p = 1) ==> 1 < p`) THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `prime p` THEN + ASM_REWRITE_TAC[PRIME_0; PRIME_1]; ALL_TAC] THEN + REWRITE_TAC[primefact] THEN + DISCH_THEN(X_CHOOSE_THEN `ps:num list` ASSUME_TAC) THEN + EXISTS_TAC `CONS (p:num) ps` THEN + ASM_REWRITE_TAC[MEM; ITLIST] THEN ASM_MESON_TAC[]);; + +let PRIMAFACT_CONTAINS = prove + (`!ps n. primefact ps n ==> !p. prime p /\ p divides n ==> MEM p ps`, + REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + POP_ASSUM(SUBST1_TAC o SYM) THEN + SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ITLIST; MEM] THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_1]; ALL_TAC] THEN + STRIP_TAC THEN GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN + DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN + ASM_MESON_TAC[prime; PRIME_1]);; + +let PRIMEFACT_VARIANT = prove + (`!ps n. primefact ps n <=> (ITLIST (*) ps 1 = n) /\ ALL prime ps`, + REPEAT GEN_TAC THEN REWRITE_TAC[primefact] THEN AP_TERM_TAC THEN + SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[MEM; ALL] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Variant of Lucas theorem. *) +(* ------------------------------------------------------------------------- *) + +let LUCAS_PRIMEFACT = prove + (`2 <= n /\ + (a EXP (n - 1) == 1) (mod n) /\ + (ITLIST (*) ps 1 = n - 1) /\ + ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps + ==> prime n`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LUCAS THEN + EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `primefact ps (n - 1)` MP_TAC THENL + [ASM_REWRITE_TAC[PRIMEFACT_VARIANT] THEN MATCH_MP_TAC ALL_IMP THEN + EXISTS_TAC `\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)` THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP PRIMAFACT_CONTAINS) THEN + X_GEN_TAC `p:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN UNDISCH_TAC + `ALL (\p. prime p /\ ~(a EXP ((n - 1) DIV p) == 1) (mod n)) ps` THEN + SPEC_TAC(`ps:num list`,`ps:num list`) THEN LIST_INDUCT_TAC THEN + SIMP_TAC[ALL; MEM] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Utility functions. *) +(* ------------------------------------------------------------------------- *) + +let even_num n = + mod_num n num_2 =/ num_0;; + +let odd_num = not o even_num;; + +(* ------------------------------------------------------------------------- *) +(* Least p >= 0 with x <= 2^p. *) +(* ------------------------------------------------------------------------- *) + +let log2 = + let rec log2 x y = + if x log2 (x -/ num_1) num_0;; + +(* ------------------------------------------------------------------------- *) +(* Raise number to power (x^m) modulo n. *) +(* ------------------------------------------------------------------------- *) + +let rec powermod x m n = + if m =/ num_0 then num_1 else + let y = powermod x (quo_num m num_2) n in + let z = mod_num (y */ y) n in + if even_num m then z else + mod_num (x */ z) n;; + +(* ------------------------------------------------------------------------- *) +(* Make a call to PARI/GP to factor a number into (probable) primes. *) +(* ------------------------------------------------------------------------- *) + +let factor = + let suck_file s = let data = string_of_file s in Sys.remove s; data in + let extract_output s = + let l0 = explode s in + let l0' = rev l0 in + let l1 = snd(chop_list(index "]" l0') l0') in + let l2 = "["::rev(fst(chop_list(index "[" l1) l1)) in + let tm = parse_term (implode l2) in + map ((dest_numeral F_F dest_numeral) o dest_pair) (dest_list tm) in + fun n -> + if n =/ num_1 then [] else + let filename = Filename.temp_file "pocklington" ".out" in + let s = "echo 'print(factorint(" ^ + (string_of_num n) ^ + ")) \n quit' | gp >" ^ filename ^ " 2>/dev/null" in + if Sys.command s = 0 then + let output = suck_file filename in + extract_output output + else + failwith "factor: Call to GP/PARI failed";; + +(* ------------------------------------------------------------------------- *) +(* Alternative giving multiset instead of set plus indices. *) +(* ------------------------------------------------------------------------- *) + +let multifactor = + let rec multilist l = + if l = [] then [] else + let (x,n) = hd l in + replicate x (Num.int_of_num n) @ multilist (tl l) in + fun n -> multilist (factor n);; + +(* ------------------------------------------------------------------------- *) +(* Recursive creation of Pratt primality certificates. *) +(* ------------------------------------------------------------------------- *) + +type certificate = + Prime_2 + | Primroot_and_factors of + ((num * num list) * num * (num * certificate) list);; + +let find_primitive_root = + let rec find_primitive_root a m ms n = + if gcd_num a n =/ num_1 & + powermod a m n =/ num_1 & + forall (fun k -> powermod a k n <>/ num_1) ms + then a + else find_primitive_root (a +/ num_1) m ms n in + let find_primitive_root_from_2 = find_primitive_root num_2 in + fun m ms n -> + if n raise Unchanged + | (h::t) -> if x =/ h then + try uniq x t + with Unchanged -> l + else x::(uniq h t) in + fun l -> if l = [] then [] else uniq (hd l) (tl l);; + +let setify_num s = + let s' = sort (<=/) s in + try uniq_num s' with Unchanged -> s';; + +let certify_prime = + let rec cert_prime n = + if n <=/ num_2 then + if n =/ num_2 then Prime_2 + else failwith "certify_prime: not a prime!" + else + let m = n -/ num_1 in + let pfact = multifactor m in + let primes = setify_num pfact in + let ms = map (fun d -> div_num m d) primes in + let a = find_primitive_root m ms n in + Primroot_and_factors((n,pfact),a,map (fun n -> n,cert_prime n) primes) in + fun n -> if length(multifactor n) = 1 then cert_prime n + else failwith "certify_prime: input is not a prime";; + +(* ------------------------------------------------------------------------- *) +(* Relatively efficient evaluation of "(a EXP m == 1) (mod n)". *) +(* ------------------------------------------------------------------------- *) + +let EXP_EQ_MOD_CONV = + let pth = prove + (`~(n = 0) + ==> ((a EXP 0) MOD n = 1 MOD n) /\ + ((a EXP (NUMERAL (BIT0 m))) MOD n = + let b = (a EXP (NUMERAL m)) MOD n in + (b * b) MOD n) /\ + ((a EXP (NUMERAL (BIT1 m))) MOD n = + let b = (a EXP (NUMERAL m)) MOD n in + (a * ((b * b) MOD n)) MOD n)`, + DISCH_TAC THEN REWRITE_TAC[EXP] THEN + REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN + REWRITE_TAC[EXP; EXP_ADD] THEN + CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN + REWRITE_TAC[MULT_ASSOC] THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[MULT_ASSOC] THEN + ASM_SIMP_TAC[MOD_MULT_LMOD; MOD_MULT_RMOD]) + and pth_cong = SPEC_ALL CONG + and n_tm = `n:num` in + let raw_conv tm = + let ntm = rand(rand tm) in + let th1 = INST [ntm,n_tm] pth_cong in + let th2 = EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1)))) in + let th3 = REWR_CONV (MP th1 th2) tm in + let th4 = MP (INST [ntm,n_tm] pth) th2 in + let th4a,th4b = CONJ_PAIR th4 in + let conv_base = GEN_REWRITE_CONV I [th4a] + and conv_step = GEN_REWRITE_CONV I [th4b] in + let rec conv tm = + try conv_base tm with Failure _ -> + (conv_step THENC + RAND_CONV conv THENC + let_CONV THENC + NUM_REDUCE_CONV) tm in + let th5 = (LAND_CONV conv THENC NUM_REDUCE_CONV) (rand(concl th3)) in + TRANS th3 th5 in + let gconv_net = itlist (uncurry net_of_conv) + [`(a EXP m == 1) (mod n)`,raw_conv] empty_net in + REWRITES_CONV gconv_net;; + +(* ------------------------------------------------------------------------- *) +(* HOL checking of such a certificate. We retain a cache for efficiency. *) +(* ------------------------------------------------------------------------- *) + +let prime_theorem_cache = ref [];; + +let rec lookup_under_num n l = + if l = [] then failwith "lookup_under_num" else + let h = hd l in + if fst h =/ n then snd h + else lookup_under_num n (tl l);; + +let check_certificate = + let n_tm = `n:num` + and a_tm = `a:num` + and ps_tm = `ps:num list` + and SIMPLE_REWRITE_CONV = REWRITE_CONV[] + and CONJ_AC_SORTED = TAUT `(a /\ a /\ b <=> a /\ b) /\ (a /\ a <=> a)` in + let CLEAN_RULE = CONV_RULE + (REWRITE_CONV[ITLIST; ALL; CONJ_AC_SORTED] THENC + ONCE_DEPTH_CONV NUM_SUB_CONV THENC + DEPTH_CONV NUM_MULT_CONV THENC + ONCE_DEPTH_CONV NUM_DIV_CONV THENC + ONCE_DEPTH_CONV(NUM_EQ_CONV ORELSEC NUM_LE_CONV) THENC + SIMPLE_REWRITE_CONV) in + let rec check_certificate cert = + match cert with + Prime_2 -> + PRIME_2 + | Primroot_and_factors((n,ps),a,ncerts) -> + try lookup_under_num n (!prime_theorem_cache) with Failure _ -> + let th1 = INST [mk_numeral n,n_tm; + mk_flist (map mk_numeral ps),ps_tm; + mk_numeral a,a_tm] + LUCAS_PRIMEFACT in + let th2 = CLEAN_RULE th1 in + let th3 = ONCE_DEPTH_CONV EXP_EQ_MOD_CONV (concl th2) in + let th4 = CONV_RULE SIMPLE_REWRITE_CONV (EQ_MP th3 th2) in + let ants = conjuncts(lhand(concl th4)) in + let certs = + map (fun t -> lookup_under_num (dest_numeral(rand t)) ncerts) + ants in + let ths = map check_certificate certs in + let fth = MP th4 (end_itlist CONJ ths) in + prime_theorem_cache := (n,fth)::(!prime_theorem_cache); fth in + check_certificate;; + +(* ------------------------------------------------------------------------- *) +(* Hence a primality-proving rule. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_PRIME = check_certificate o certify_prime;; + +(* ------------------------------------------------------------------------- *) +(* Rule to generate prime factorization theorems. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_PRIMEFACT = + let pth = SPEC_ALL PRIMEFACT_VARIANT + and start_CONV = PURE_REWRITE_CONV[ITLIST; ALL] THENC NUM_REDUCE_CONV + and ps_tm = `ps:num list` + and n_tm = `n:num` in + fun n -> + let pfact = multifactor n in + let th1 = INST [mk_flist(map mk_numeral pfact),ps_tm; + mk_numeral n,n_tm] pth in + let th2 = TRANS th1 (start_CONV(rand(concl th1))) in + let ths = map PROVE_PRIME pfact in + EQ_MP (SYM th2) (end_itlist CONJ ths);; + +(* ------------------------------------------------------------------------- *) +(* Conversion for truth or falsity of primality assertion. *) +(* ------------------------------------------------------------------------- *) + +let PRIME_TEST = + let NOT_PRIME_THM = prove + (`((m = 1) <=> F) ==> ((m = p) <=> F) ==> (m * n = p) ==> (prime(p) <=> F)`, + MESON_TAC[prime; divides]) + and m_tm = `m:num` and n_tm = `n:num` and p_tm = `p:num` in + fun tm -> + let p = dest_numeral tm in + if p =/ Int 0 then EQF_INTRO PRIME_0 + else if p =/ Int 1 then EQF_INTRO PRIME_1 else + let pfact = multifactor p in + if length pfact = 1 then + (remark ("proving that " ^ string_of_num p ^ " is prime"); + EQT_INTRO(PROVE_PRIME p)) + else + (remark ("proving that " ^ string_of_num p ^ " is composite"); + let m = hd pfact and n = end_itlist ( */ ) (tl pfact) in + let th0 = INST [mk_numeral m,m_tm; mk_numeral n,n_tm; mk_numeral p,p_tm] + NOT_PRIME_THM in + let th1 = MP th0 (NUM_EQ_CONV (lhand(lhand(concl th0)))) in + let th2 = MP th1 (NUM_EQ_CONV (lhand(lhand(concl th1)))) in + MP th2 (NUM_MULT_CONV(lhand(lhand(concl th2)))));; + +let PRIME_CONV = + let prime_tm = `prime` in + fun tm0 -> + let ptm,tm = dest_comb tm0 in + if ptm <> prime_tm then failwith "expected term of form prime(n)" + else PRIME_TEST tm;; + +(* ------------------------------------------------------------------------- *) +(* Example. *) +(* ------------------------------------------------------------------------- *) + +map (time PRIME_TEST o mk_small_numeral) (0--50);; + +time PRIME_TEST `65535`;; + +time PRIME_TEST `65536`;; + +time PRIME_TEST `65537`;; + +time PROVE_PRIMEFACT (Int 222);; + +time PROVE_PRIMEFACT (Int 151);; + +(* ------------------------------------------------------------------------- *) +(* The "Landau trick" in Erdos's proof of Chebyshev-Bertrand theorem. *) +(* ------------------------------------------------------------------------- *) + +map (time PRIME_TEST o mk_small_numeral) + [3; 5; 7; 13; 23; 43; 83; 163; 317; 631; 1259; 2503; 4001];; diff --git a/Library/prime.ml b/Library/prime.ml new file mode 100644 index 0000000..c06202f --- /dev/null +++ b/Library/prime.ml @@ -0,0 +1,2044 @@ +(* ========================================================================= *) +(* Basic theory of divisibility, gcd, coprimality and primality (over N). *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* HOL88 compatibility (since all this is a port of old HOL88 stuff). *) +(* ------------------------------------------------------------------------- *) + +let MULT_MONO_EQ = prove + (`!m i n. ((SUC n) * m = (SUC n) * i) <=> (m = i)`, + REWRITE_TAC[EQ_MULT_LCANCEL; NOT_SUC]);; + +let LESS_ADD_1 = prove + (`!m n. n < m ==> (?p. m = n + (p + 1))`, + REWRITE_TAC[LT_EXISTS; ADD1; ADD_ASSOC]);; + +let LESS_ADD_SUC = ARITH_RULE `!m n. m < (m + (SUC n))`;; + +let LESS_0_CASES = ARITH_RULE `!m. (0 = m) \/ 0 < m`;; + +let LESS_MONO_ADD = ARITH_RULE `!m n p. m < n ==> (m + p) < (n + p)`;; + +let LESS_EQ_0 = prove + (`!n. n <= 0 <=> (n = 0)`, + REWRITE_TAC[LE]);; + +let LESS_LESS_CASES = ARITH_RULE `!m n. (m = n) \/ m < n \/ n < m`;; + +let LESS_ADD_NONZERO = ARITH_RULE `!m n. ~(n = 0) ==> m < (m + n)`;; + +let NOT_EXP_0 = prove + (`!m n. ~((SUC n) EXP m = 0)`, + REWRITE_TAC[EXP_EQ_0; NOT_SUC]);; + +let LESS_THM = ARITH_RULE `!m n. m < (SUC n) <=> (m = n) \/ m < n`;; + +let NOT_LESS_0 = ARITH_RULE `!n. ~(n < 0)`;; + +let ZERO_LESS_EXP = prove + (`!m n. 0 < ((SUC n) EXP m)`, + REWRITE_TAC[LT_NZ; NOT_EXP_0]);; + +(* ------------------------------------------------------------------------- *) +(* General arithmetic lemmas. *) +(* ------------------------------------------------------------------------- *) + +let MULT_FIX = prove( + `!x y. (x * y = x) <=> (x = 0) \/ (y = 1)`, + REPEAT GEN_TAC THEN + STRUCT_CASES_TAC(SPEC `x:num` num_CASES) THEN + REWRITE_TAC[MULT_CLAUSES; NOT_SUC] THEN + REWRITE_TAC[GSYM(el 4 (CONJUNCTS (SPEC_ALL MULT_CLAUSES)))] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [GSYM(el 3 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))] THEN + MATCH_ACCEPT_TAC MULT_MONO_EQ);; + +let LESS_EQ_MULT = prove( + `!m n p q. m <= n /\ p <= q ==> (m * p) <= (n * q)`, + REPEAT GEN_TAC THEN + DISCH_THEN(STRIP_ASSUME_TAC o REWRITE_RULE[LE_EXISTS]) THEN + ASM_REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; + GSYM ADD_ASSOC; LE_ADD]);; + +let LESS_MULT = prove( + `!m n p q. m < n /\ p < q ==> (m * p) < (n * q)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN + ((CHOOSE_THEN SUBST_ALL_TAC) o MATCH_MP LESS_ADD_1)) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[GSYM ADD1; MULT_CLAUSES; ADD_CLAUSES; GSYM ADD_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM (el 3 (CONJUNCTS ADD_CLAUSES))] THEN + MATCH_ACCEPT_TAC LESS_ADD_SUC);; + +let MULT_LCANCEL = prove( + `!a b c. ~(a = 0) /\ (a * b = a * c) ==> (b = c)`, + REPEAT GEN_TAC THEN STRUCT_CASES_TAC(SPEC `a:num` num_CASES) THEN + REWRITE_TAC[NOT_SUC; MULT_MONO_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of the exponential function. *) +(* ------------------------------------------------------------------------- *) + +let EXP_0 = prove + (`!n. 0 EXP (SUC n) = 0`, + REWRITE_TAC[EXP; MULT_CLAUSES]);; + +let EXP_MONO_LT_SUC = prove + (`!n x y. (x EXP (SUC n)) < (y EXP (SUC n)) <=> (x < y)`, + REWRITE_TAC[EXP_MONO_LT; NOT_SUC]);; + +let EXP_MONO_LE_SUC = prove + (`!x y n. (x EXP (SUC n)) <= (y EXP (SUC n)) <=> x <= y`, + REWRITE_TAC[EXP_MONO_LE; NOT_SUC]);; + +let EXP_MONO_EQ_SUC = prove + (`!x y n. (x EXP (SUC n) = y EXP (SUC n)) <=> (x = y)`, + REWRITE_TAC[EXP_MONO_EQ; NOT_SUC]);; + +let EXP_EXP = prove + (`!x m n. (x EXP m) EXP n = x EXP (m * n)`, + REWRITE_TAC[EXP_MULT]);; + +(* ------------------------------------------------------------------------- *) +(* More ad-hoc arithmetic lemmas unlikely to be useful elsewhere. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_LEMMA = prove( + `!a b. a < b ==> (a = 0) \/ (a + (b - a)) < (a + b)`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(SPEC `a:num` LESS_0_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN + DISJ2_TAC THEN REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM (CONJUNCT1 ADD_CLAUSES)] THEN + REWRITE_TAC[ADD_ASSOC] THEN + REPEAT(MATCH_MP_TAC LESS_MONO_ADD) THEN POP_ASSUM ACCEPT_TAC);; + +let NOT_EVEN_EQ_ODD = prove( + `!m n. ~(2 * m = SUC(2 * n))`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN; EVEN_MULT; ARITH]);; + +let CANCEL_TIMES2 = prove( + `!x y. (2 * x = 2 * y) <=> (x = y)`, + REWRITE_TAC[num_CONV `2`; MULT_MONO_EQ]);; + +let EVEN_SQUARE = prove( + `!n. EVEN(n) ==> ?x. n EXP 2 = 4 * x`, + GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + EXISTS_TAC `m * m` THEN REWRITE_TAC[EXP_2] THEN + REWRITE_TAC[SYM(REWRITE_CONV[ARITH] `2 * 2`)] THEN + REWRITE_TAC[MULT_AC]);; + +let ODD_SQUARE = prove( + `!n. ODD(n) ==> ?x. n EXP 2 = (4 * x) + 1`, + GEN_TAC THEN REWRITE_TAC[ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[GSYM ADD1; SUC_INJ] THEN + EXISTS_TAC `(m * m) + m` THEN + REWRITE_TAC(map num_CONV [`4`; `3`; `2`; `1`]) THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[ADD_AC]);; + +let DIFF_SQUARE = prove( + `!x y. (x EXP 2) - (y EXP 2) = (x + y) * (x - y)`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THENL + [SUBGOAL_THEN `(x * x) <= (y * y)` MP_TAC THENL + [MATCH_MP_TAC LESS_EQ_MULT THEN ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM SUB_EQ_0] THEN + REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[EXP_2; MULT_CLAUSES]]; + POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN + REWRITE_TAC[EXP_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[GSYM ADD_ASSOC; ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [ADD_SYM] THEN + AP_TERM_TAC THEN MATCH_ACCEPT_TAC MULT_SYM]);; + +let ADD_IMP_SUB = prove( + `!x y z. (x + y = z) ==> (x = z - y)`, + REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_SUB]);; + +let ADD_SUM_DIFF = prove( + `!v w. v <= w ==> ((w + v) - (w - v) = 2 * v) /\ + ((w + v) + (w - v) = 2 * w)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN + REWRITE_TAC[MULT_2; GSYM ADD_ASSOC] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB; GSYM ADD_ASSOC]);; + +let EXP_4 = prove( + `!n. n EXP 4 = (n EXP 2) EXP 2`, + GEN_TAC THEN REWRITE_TAC[EXP_EXP] THEN + REWRITE_TAC[ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Elementary theory of divisibility *) +(* ------------------------------------------------------------------------- *) + +let DIVIDES_0 = prove + (`!x. x divides 0`, + NUMBER_TAC);; + +let DIVIDES_ZERO = prove + (`!x. 0 divides x <=> (x = 0)`, + NUMBER_TAC);; + +let DIVIDES_1 = prove + (`!x. 1 divides x`, + NUMBER_TAC);; + +let DIVIDES_ONE = prove( + `!x. (x divides 1) <=> (x = 1)`, + GEN_TAC THEN REWRITE_TAC[divides] THEN + CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN + REWRITE_TAC[MULT_EQ_1] THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `1` THEN REFL_TAC);; + +let DIVIDES_REFL = prove + (`!x. x divides x`, + NUMBER_TAC);; + +let DIVIDES_TRANS = prove + (`!a b c. a divides b /\ b divides c ==> a divides c`, + NUMBER_TAC);; + +let DIVIDES_ANTISYM = prove + (`!x y. x divides y /\ y divides x <=> (x = y)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (CHOOSE_THEN SUBST1_TAC)) THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN + CONV_TAC(LAND_CONV SYM_CONV) THEN + REWRITE_TAC[GSYM MULT_ASSOC; MULT_FIX; MULT_EQ_1] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[DIVIDES_REFL]]);; + +let DIVIDES_ADD = prove + (`!d a b. d divides a /\ d divides b ==> d divides (a + b)`, + NUMBER_TAC);; + +let DIVIDES_SUB = prove + (`!d a b. d divides a /\ d divides b ==> d divides (a - b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN (CHOOSE_THEN SUBST1_TAC)) THEN + REWRITE_TAC[GSYM LEFT_SUB_DISTRIB] THEN + W(EXISTS_TAC o rand o lhs o snd o dest_exists o snd) THEN + REFL_TAC);; + +let DIVIDES_LMUL = prove + (`!d a x. d divides a ==> d divides (x * a)`, + NUMBER_TAC);; + +let DIVIDES_RMUL = prove + (`!d a x. d divides a ==> d divides (a * x)`, + NUMBER_TAC);; + +let DIVIDES_ADD_REVR = prove + (`!d a b. d divides a /\ d divides (a + b) ==> d divides b`, + NUMBER_TAC);; + +let DIVIDES_ADD_REVL = prove + (`!d a b. d divides b /\ d divides (a + b) ==> d divides a`, + NUMBER_TAC);; + +let DIVIDES_DIV = prove + (`!n x. 0 < n /\ (x MOD n = 0) ==> n divides x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:num` o MATCH_MP DIVISION o + MATCH_MP (ARITH_RULE `0 < n ==> ~(n = 0)`)) THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `x DIV n` THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; + +let DIVIDES_MUL_L = prove + (`!a b c. a divides b ==> (c * a) divides (c * b)`, + NUMBER_TAC);; + +let DIVIDES_MUL_R = prove + (`!a b c. a divides b ==> (a * c) divides (b * c)`, + NUMBER_TAC);; + +let DIVIDES_LMUL2 = prove + (`!d a x. (x * d) divides a ==> d divides a`, + NUMBER_TAC);; + +let DIVIDES_RMUL2 = prove + (`!d a x. (d * x) divides a ==> d divides a`, + NUMBER_TAC);; + +let DIVIDES_CMUL2 = prove + (`!a b c. (c * a) divides (c * b) /\ ~(c = 0) ==> a divides b`, + NUMBER_TAC);; + +let DIVIDES_LMUL2_EQ = prove + (`!a b c. ~(c = 0) ==> ((c * a) divides (c * b) <=> a divides b)`, + NUMBER_TAC);; + +let DIVIDES_RMUL2_EQ = prove + (`!a b c. ~(c = 0) ==> ((a * c) divides (b * c) <=> a divides b)`, + NUMBER_TAC);; + +let DIVIDES_CASES = prove + (`!m n. n divides m ==> m = 0 \/ m = n \/ 2 * n <= m`, + SIMP_TAC[ARITH_RULE `m = n \/ 2 * n <= m <=> m = n * 1 \/ n * 2 <= m`] THEN + SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[MULT_EQ_0; EQ_MULT_LCANCEL; LE_MULT_LCANCEL] THEN ARITH_TAC);; + +let DIVIDES_LE_STRONG = prove + (`!m n. m divides n ==> 1 <= m /\ m <= n \/ n = 0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THEN + ASM_REWRITE_TAC[DIVIDES_ZERO; ARITH] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let DIVIDES_DIV_NOT = prove( + `!n x q r. (x = (q * n) + r) /\ 0 < r /\ r < n ==> ~(n divides x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `n:num` DIVIDES_REFL) THEN + DISCH_THEN(MP_TAC o SPEC `q:num` o MATCH_MP DIVIDES_LMUL) THEN + PURE_REWRITE_TAC[TAUT `a ==> ~b <=> a /\ b ==> F`] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_ADD_REVR) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[DE_MORGAN_THM; NOT_LE; GSYM LESS_EQ_0]);; + +let DIVIDES_MUL2 = prove + (`!a b c d. a divides b /\ c divides d ==> (a * c) divides (b * d)`, + NUMBER_TAC);; + +let DIVIDES_EXP = prove( + `!x y n. x divides y ==> (x EXP n) divides (y EXP n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + EXISTS_TAC `d EXP n` THEN MATCH_ACCEPT_TAC MULT_EXP);; + +let DIVIDES_EXP2 = prove( + `!n x y. ~(n = 0) /\ (x EXP n) divides y ==> x divides y`, + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EXP] THEN NUMBER_TAC);; + +let DIVIDES_EXP_LE = prove + (`!p m n. 2 <= p ==> ((p EXP m) divides (p EXP n) <=> m <= n)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[LE_EXP; EXP_EQ_0] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; EXP_ADD] THEN NUMBER_TAC]);; + +let DIVIDES_TRIVIAL_UPPERBOUND = prove + (`!p n. ~(n = 0) /\ 2 <= p ==> ~((p EXP n) divides n)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `2 EXP n` THEN REWRITE_TAC[LT_POW2_REFL] THEN + UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP_MONO_LE_SUC]);; + +let FACTORIZATION_INDEX = prove + (`!n p. ~(n = 0) /\ 2 <= p + ==> ?k. (p EXP k) divides n /\ + !l. k < l ==> ~((p EXP l) divides n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM] THEN + REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[EXP; DIVIDES_1]; + EXISTS_TAC `n:num` THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2 EXP l` THEN + SIMP_TAC[LT_POW2_REFL; LT_IMP_LE] THEN + SPEC_TAC(`l:num`,`l:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ARITH; CONJUNCT1 EXP; EXP_MONO_LE_SUC]]);; + +let DIVIDES_FACT = prove + (`!n p. 1 <= p /\ p <= n ==> p divides (FACT n)`, + INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL + [ARITH_TAC; ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; DIVIDES_REFL]]);; + +let DIVIDES_2 = prove( + `!n. 2 divides n <=> EVEN(n)`, + REWRITE_TAC[divides; EVEN_EXISTS]);; + +let DIVIDES_REXP_SUC = prove + (`!x y n. x divides y ==> x divides (y EXP (SUC n))`, + REWRITE_TAC[EXP; DIVIDES_RMUL]);; + +let DIVIDES_REXP = prove + (`!x y n. x divides y /\ ~(n = 0) ==> x divides (y EXP n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[DIVIDES_REXP_SUC]);; + +let DIVIDES_MOD = prove + (`!m n. ~(m = 0) ==> (m divides n <=> (n MOD m = 0))`, + REWRITE_TAC[divides] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[MOD_MULT]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN MESON_TAC[MULT_AC]);; + +let DIVIDES_DIV_MULT = prove + (`!m n. m divides n <=> ((n DIV m) * m = n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `m = 0` THENL + [ASM_REWRITE_TAC[DIVIDES_ZERO; MULT_CLAUSES; EQ_SYM_EQ]; ALL_TAC] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[DIVIDES_LMUL; DIVIDES_REFL]] THEN + DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `n DIV m * m + n MOD m` THEN CONJ_TAC THENL + [ASM_MESON_TAC[DIVIDES_MOD; ADD_CLAUSES]; + ASM_MESON_TAC[DIVISION]]);; + +let FINITE_DIVISORS = prove + (`!n. ~(n = 0) ==> FINITE {d | d divides n}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{d:num | d <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[DIVIDES_LE]);; + +let FINITE_SPECIAL_DIVISORS = prove + (`!n. ~(n = 0) ==> FINITE {d | P d /\ d divides n}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{d | d divides n}` THEN ASM_SIMP_TAC[FINITE_DIVISORS] THEN + SET_TAC[]);; + +let DIVIDES_DIVIDES_DIV = prove + (`!n d. 1 <= n /\ d divides n + ==> (e divides (n DIV d) <=> (d * e) divides n)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [DIVIDES_DIV_MULT] THEN + ABBREV_TAC `q = n DIV d` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `d = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; LE_1]; + ASM_MESON_TAC[DIVIDES_LMUL2_EQ; MULT_SYM]]);; + +let DIVISORS_EQ = prove + (`!m n. m = n <=> !d. d divides m <=> d divides n`, + REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN + MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; + +let MULTIPLES_EQ = prove + (`!m n. m = n <=> !d. m divides d <=> n divides d`, + REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN + MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; + +let DIVIDES_NSUM = prove + (`!n f s. FINITE s /\ (!i. i IN s ==> n divides (f i)) + ==> n divides nsum s f`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[DIVIDES_0; NSUM_CLAUSES; FORALL_IN_INSERT; DIVIDES_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* The Bezout theorem is a bit ugly for N; it'd be easier for Z *) +(* ------------------------------------------------------------------------- *) + +let IND_EUCLID = prove( + `!P. (!a b. P a b <=> P b a) /\ + (!a. P a 0) /\ + (!a b. P a b ==> P a (a + b)) ==> + !a b. P a b`, + REPEAT STRIP_TAC THEN + W(fun (asl,w) -> SUBGOAL_THEN `!n a b. (a + b = n) ==> P a b` + MATCH_MP_TAC) THENL + [ALL_TAC; EXISTS_TAC `a + b` THEN REFL_TAC] THEN + MATCH_MP_TAC num_WF THEN + REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN MP_TAC + (SPECL [`a:num`; `b:num`] LESS_LESS_CASES) THENL + [DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM ADD_0] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> SUBST1_TAC(SYM(MATCH_MP SUB_ADD + (MATCH_MP LT_IMP_LE th))) THEN + DISJ_CASES_THEN MP_TAC (MATCH_MP DIFF_LEMMA th)) THENL + [DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM (CONV_TAC o REWR_CONV) THEN + FIRST_ASSUM MATCH_ACCEPT_TAC; + REWRITE_TAC[ASSUME `a + b = n`] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `a + b - a < n` THEN + DISCH_THEN(ANTE_RES_THEN MATCH_MP_TAC); + DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (ASSUME `a + b = n`)] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + FIRST_ASSUM (CONV_TAC o REWR_CONV) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `b + a - b < n` THEN + DISCH_THEN(ANTE_RES_THEN MATCH_MP_TAC)] THEN + REWRITE_TAC[]);; + +let BEZOUT_LEMMA = prove( + `!a b. (?d x y. (d divides a /\ d divides b) /\ + ((a * x = (b * y) + d) \/ + (b * x = (a * y) + d))) + ==> (?d x y. (d divides a /\ d divides (a + b)) /\ + ((a * x = ((a + b) * y) + d) \/ + ((a + b) * x = (a * y) + d)))`, + REPEAT STRIP_TAC THEN EXISTS_TAC `d:num` THENL + [MAP_EVERY EXISTS_TAC [`x + y`; `y:num`]; + MAP_EVERY EXISTS_TAC [`x:num`; `x + y`]] THEN + ASM_REWRITE_TAC[] THEN + (CONJ_TAC THENL [MATCH_MP_TAC DIVIDES_ADD; ALL_TAC]) THEN + ASM_REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[ADD_ASSOC] THEN DISJ1_TAC THEN + REWRITE_TAC[ADD_AC]);; + +let BEZOUT_ADD = prove( + `!a b. ?d x y. (d divides a /\ d divides b) /\ + ((a * x = (b * y) + d) \/ + (b * x = (a * y) + d))`, + W(fun (asl,w) -> MP_TAC(SPEC (list_mk_abs([`a:num`; `b:num`], + snd(strip_forall w))) + IND_EUCLID)) THEN BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REPEAT + (AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + GEN_TAC THEN BETA_TAC) THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [DISJ_SYM] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [CONJ_SYM] THEN REFL_TAC; + GEN_TAC THEN MAP_EVERY EXISTS_TAC [`a:num`; `1`; `0`] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVIDES_0; DIVIDES_REFL]; + MATCH_ACCEPT_TAC BEZOUT_LEMMA]);; + +let BEZOUT = prove( + `!a b. ?d x y. (d divides a /\ d divides b) /\ + (((a * x) - (b * y) = d) \/ + ((b * x) - (a * y) = d))`, + REPEAT GEN_TAC THEN REPEAT_TCL STRIP_THM_THEN ASSUME_TAC + (SPECL [`a:num`; `b:num`] BEZOUT_ADD) THEN + REPEAT(W(EXISTS_TAC o fst o dest_exists o snd)) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* We can get a stronger version with a nonzeroness assumption. *) +(* ------------------------------------------------------------------------- *) + +let BEZOUT_ADD_STRONG = prove + (`!a b. ~(a = 0) + ==> ?d x y. d divides a /\ d divides b /\ (a * x = b * y + d)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT_ADD) THEN + REWRITE_TAC[TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c`] THEN + REWRITE_TAC[EXISTS_OR_THM; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT `(b ==> a) ==> a \/ b ==> a`) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` (X_CHOOSE_THEN `x:num` + (X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC))) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN + ASM_CASES_TAC `b = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; ADD_EQ_0; MULT_EQ_0; ADD_CLAUSES] THEN + STRIP_TAC THEN UNDISCH_TAC `d divides a` THEN + ASM_REWRITE_TAC[DIVIDES_ZERO]; ALL_TAC] THEN + MP_TAC(SPECL [`d:num`; `b:num`] DIVIDES_LE) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LE_LT] THEN STRIP_TAC THENL + [ALL_TAC; + DISCH_TAC THEN EXISTS_TAC `b:num` THEN EXISTS_TAC `b:num` THEN + EXISTS_TAC `a - 1` THEN + UNDISCH_TAC `d divides a` THEN ASM_SIMP_TAC[DIVIDES_REFL] THEN + REWRITE_TAC[ARITH_RULE `b * x + b = (x + 1) * b`] THEN + ASM_SIMP_TAC[ARITH_RULE `~(a = 0) ==> ((a - 1) + 1 = a)`]] THEN + ASM_CASES_TAC `x = 0` THENL + [ASM_SIMP_TAC[MULT_CLAUSES; ADD_EQ_0; MULT_EQ_0] THEN STRIP_TAC THEN + UNDISCH_TAC `d divides a` THEN ASM_REWRITE_TAC[DIVIDES_ZERO]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o AP_TERM `( * ) (b - 1)`) THEN + DISCH_THEN(MP_TAC o AP_TERM `(+) (d:num)`) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) + [LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[ARITH_RULE `d + bay + b1 * d = (1 + b1) * d + bay`] THEN + ASM_SIMP_TAC[ARITH_RULE `~(b = 0) ==> (1 + (b - 1) = b)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `(a + b = c + d) ==> a <= d ==> (b = (d - a) + c:num)`)) THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[AC MULT_AC `(b - 1) * b * x = b * (b - 1) * x`] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `d = d * 1`] THEN + MATCH_MP_TAC LE_MULT2 THEN + MAP_EVERY UNDISCH_TAC [`d < b:num`; `~(x = 0)`] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(fun th -> + MAP_EVERY EXISTS_TAC [`d:num`; `y * (b - 1)`; `(b - 1) * x - d`] THEN + MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV) [LEFT_SUB_DISTRIB] THEN + REWRITE_TAC[MULT_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Greatest common divisor. *) +(* ------------------------------------------------------------------------- *) + +let GCD = prove + (`!a b. (gcd(a,b) divides a /\ gcd(a,b) divides b) /\ + (!e. e divides a /\ e divides b ==> e divides gcd(a,b))`, + NUMBER_TAC);; + +let DIVIDES_GCD = prove + (`!a b d. d divides gcd(a,b) <=> d divides a /\ d divides b`, + NUMBER_TAC);; + +let GCD_UNIQUE = prove( + `!d a b. (d divides a /\ d divides b) /\ + (!e. e divides a /\ e divides b ==> e divides d) <=> + (d = gcd(a,b))`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[GCD] THEN + ONCE_REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN + ASM_REWRITE_TAC[DIVIDES_GCD] THEN + FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GCD]);; + +let GCD_EQ = prove + (`(!d. d divides x /\ d divides y <=> d divides u /\ d divides v) + ==> gcd(x,y) = gcd(u,v)`, + REWRITE_TAC[DIVIDES_GCD; GSYM DIVIDES_ANTISYM] THEN MESON_TAC[GCD]);; + +let GCD_SYM = prove + (`!a b. gcd(a,b) = gcd(b,a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM GCD_UNIQUE] THEN NUMBER_TAC);; + +let GCD_ASSOC = prove( + `!a b c. gcd(a,gcd(b,c)) = gcd(gcd(a,b),c)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN + REWRITE_TAC[DIVIDES_GCD; CONJ_ASSOC; GCD] THEN + CONJ_TAC THEN MATCH_MP_TAC DIVIDES_TRANS THEN + EXISTS_TAC `gcd(b,c)` THEN ASM_REWRITE_TAC[GCD]);; + +let BEZOUT_GCD = prove( + `!a b. ?x y. ((a * x) - (b * y) = gcd(a,b)) \/ + ((b * x) - (a * y) = gcd(a,b))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT) THEN + DISCH_THEN(EVERY_TCL (map X_CHOOSE_THEN [`d:num`; `x:num`; `y:num`]) + (CONJUNCTS_THEN ASSUME_TAC)) THEN + SUBGOAL_THEN `d divides gcd(a,b)` MP_TAC THENL + [MATCH_MP_TAC(last(CONJUNCTS(SPEC_ALL GCD))) THEN ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN + MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN + ASM_REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; MULT_ASSOC] THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[]]);; + +let BEZOUT_GCD_STRONG = prove + (`!a b. ~(a = 0) ==> ?x y. a * x = b * y + gcd(a,b)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `b:num` o MATCH_MP BEZOUT_ADD_STRONG) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:num`; `x:num`; `y:num`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `d divides gcd(a,b)` MP_TAC THENL + [ASM_MESON_TAC[GCD]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN + MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN + ASM_REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB; MULT_ASSOC]);; + +let GCD_LMUL = prove( + `!a b c. gcd(c * a, c * b) = c * gcd(a,b)`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC DIVIDES_MUL_L) THEN + REWRITE_TAC[GCD] THEN REPEAT STRIP_TAC THEN + REPEAT_TCL STRIP_THM_THEN (SUBST1_TAC o SYM) + (SPECL [`a:num`; `b:num`] BEZOUT_GCD) THEN + REWRITE_TAC[LEFT_SUB_DISTRIB; MULT_ASSOC] THEN + MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC DIVIDES_RMUL THEN ASM_REWRITE_TAC[]);; + +let GCD_RMUL = prove( + `!a b c. gcd(a * c, b * c) = c * gcd(a,b)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + MATCH_ACCEPT_TAC GCD_LMUL);; + +let GCD_BEZOUT = prove( + `!a b d. (?x y. ((a * x) - (b * y) = d) \/ ((b * x) - (a * y) = d)) <=> + gcd(a,b) divides d`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN POP_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[GCD]; + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN + STRIP_ASSUME_TAC(SPECL [`a:num`; `b:num`] BEZOUT_GCD) THEN + MAP_EVERY EXISTS_TAC [`x * k`; `y * k`] THEN + ASM_REWRITE_TAC[GSYM RIGHT_SUB_DISTRIB; MULT_ASSOC] THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC) THEN REWRITE_TAC[]]);; + +let GCD_BEZOUT_SUM = prove( + `!a b d x y. ((a * x) + (b * y) = d) ==> gcd(a,b) divides d`, + REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC DIVIDES_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[GCD]);; + +let GCD_0 = prove + (`(!a. gcd(0,a) = a) /\ (!a. gcd(a,0) = a)`, + MESON_TAC[GCD_UNIQUE; DIVIDES_0; DIVIDES_REFL]);; + +let GCD_ZERO = prove( + `!a b. (gcd(a,b) = 0) <=> (a = 0) /\ (b = 0)`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GCD_0] THEN + MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN + ASM_REWRITE_TAC[DIVIDES_ZERO] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +let GCD_REFL = prove( + `!a. gcd(a,a) = a`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN + ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN + REWRITE_TAC[DIVIDES_REFL]);; + +let GCD_1 = prove + (`(!a. gcd(1,a) = 1) /\ (!a. gcd(a,1) = 1)`, + MESON_TAC[GCD_UNIQUE; DIVIDES_1]);; + +let GCD_MULTIPLE = prove( + `!a b. gcd(b,a * b) = b`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) + [GSYM(el 2 (CONJUNCTS(SPEC_ALL MULT_CLAUSES)))] THEN + REWRITE_TAC[GCD_RMUL; GCD_1] THEN + REWRITE_TAC[MULT_CLAUSES]);; + +let GCD_ADD = prove + (`(!a b. gcd(a + b,b) = gcd(a,b)) /\ + (!a b. gcd(b + a,b) = gcd(a,b)) /\ + (!a b. gcd(a,a + b) = gcd(a,b)) /\ + (!a b. gcd(a,b + a) = gcd(a,b))`, + REWRITE_TAC[GSYM GCD_UNIQUE] THEN NUMBER_TAC);; + +let GCD_SUB = prove + (`(!a b. b <= a ==> gcd(a - b,b) = gcd(a,b)) /\ + (!a b. a <= b ==> gcd(a,b - a) = gcd(a,b))`, + MESON_TAC[SUB_ADD; GCD_ADD]);; + +let DIVIDES_GCD_LEFT = prove + (`!m n:num. m divides n <=> gcd(m,n) = m`, + REWRITE_TAC[DIVISORS_EQ; DIVIDES_GCD] THEN + MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; + +let DIVIDES_GCD_RIGHT = prove + (`!m n:num. n divides m <=> gcd(m,n) = n`, + REWRITE_TAC[DIVISORS_EQ; DIVIDES_GCD] THEN + MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Coprimality *) +(* ------------------------------------------------------------------------- *) + +let coprime = prove + (`coprime(a,b) <=> !d. d divides a /\ d divides b ==> (d = 1)`, + EQ_TAC THENL + [REWRITE_TAC[GSYM DIVIDES_ONE]; + DISCH_THEN(MP_TAC o SPEC `gcd(a,b)`) THEN REWRITE_TAC[GCD]] THEN + NUMBER_TAC);; + +let COPRIME = prove( + `!a b. coprime(a,b) <=> !d. d divides a /\ d divides b <=> (d = 1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[coprime] THEN + REPEAT(EQ_TAC ORELSE STRIP_TAC) THEN ASM_REWRITE_TAC[DIVIDES_1] THENL + [FIRST_ASSUM MATCH_MP_TAC; + FIRST_ASSUM(CONV_TAC o REWR_CONV o GSYM) THEN CONJ_TAC] THEN + ASM_REWRITE_TAC[]);; + +let COPRIME_GCD = prove + (`!a b. coprime(a,b) <=> (gcd(a,b) = 1)`, + REWRITE_TAC[GSYM DIVIDES_ONE] THEN NUMBER_TAC);; + +let COPRIME_SYM = prove + (`!a b. coprime(a,b) <=> coprime(b,a)`, + NUMBER_TAC);; + +let COPRIME_BEZOUT = prove( + `!a b. coprime(a,b) <=> ?x y. ((a * x) - (b * y) = 1) \/ + ((b * x) - (a * y) = 1)`, + REWRITE_TAC[GCD_BEZOUT; DIVIDES_ONE; COPRIME_GCD]);; + +let COPRIME_DIVPROD = prove + (`!d a b. d divides (a * b) /\ coprime(d,a) ==> d divides b`, + NUMBER_TAC);; + +let COPRIME_1 = prove + (`!a. coprime(a,1)`, + NUMBER_TAC);; + +let GCD_COPRIME = prove + (`!a b a' b'. ~(gcd(a,b) = 0) /\ a = a' * gcd(a,b) /\ b = b' * gcd(a,b) + ==> coprime(a',b')`, + NUMBER_TAC);; + +let GCD_COPRIME_EXISTS = prove( + `!a b. ~(gcd(a,b) = 0) ==> + ?a' b'. (a = a' * gcd(a,b)) /\ + (b = b' * gcd(a,b)) /\ + coprime(a',b')`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a':num` o GSYM) + (X_CHOOSE_TAC `b':num` o GSYM)) THEN + MAP_EVERY EXISTS_TAC [`a':num`; `b':num`] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC GCD_COPRIME THEN + MAP_EVERY EXISTS_TAC [`a:num`; `b:num`] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[]);; + +let COPRIME_0 = prove + (`(!d. coprime(d,0) <=> d = 1) /\ + (!d. coprime(0,d) <=> d = 1)`, + REWRITE_TAC[GSYM DIVIDES_ONE] THEN NUMBER_TAC);; + +let COPRIME_MUL = prove + (`!d a b. coprime(d,a) /\ coprime(d,b) ==> coprime(d,a * b)`, + NUMBER_TAC);; + +let COPRIME_LMUL2 = prove + (`!d a b. coprime(d,a * b) ==> coprime(d,b)`, + NUMBER_TAC);; + +let COPRIME_RMUL2 = prove + (`!d a b. coprime(d,a * b) ==> coprime(d,a)`, + NUMBER_TAC);; + +let COPRIME_LMUL = prove + (`!d a b. coprime(a * b,d) <=> coprime(a,d) /\ coprime(b,d)`, + NUMBER_TAC);; + +let COPRIME_RMUL = prove + (`!d a b. coprime(d,a * b) <=> coprime(d,a) /\ coprime(d,b)`, + NUMBER_TAC);; + +let COPRIME_EXP = prove + (`!n a d. coprime(d,a) ==> coprime(d,a EXP n)`, + INDUCT_TAC THEN REWRITE_TAC[EXP; COPRIME_1] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC COPRIME_MUL THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let COPRIME_EXP_IMP = prove + (`!n a b. coprime(a,b) ==> coprime(a EXP n,b EXP n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC COPRIME_EXP THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN + MATCH_MP_TAC COPRIME_EXP THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]);; + +let COPRIME_REXP = prove + (`!m n k. coprime(m,n EXP k) <=> coprime(m,n) \/ k = 0`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[CONJUNCT1 EXP; COPRIME_1] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[COPRIME_EXP; NOT_SUC] THEN + REWRITE_TAC[EXP] THEN CONV_TAC NUMBER_RULE);; + +let COPRIME_LEXP = prove + (`!m n k. coprime(m EXP k,n) <=> coprime(m,n) \/ k = 0`, + ONCE_REWRITE_TAC[COPRIME_SYM] THEN REWRITE_TAC[COPRIME_REXP]);; + +let COPRIME_EXP2 = prove + (`!m n k. coprime(m EXP k,n EXP k) <=> coprime(m,n) \/ k = 0`, + REWRITE_TAC[COPRIME_REXP; COPRIME_LEXP; DISJ_ACI]);; + +let COPRIME_EXP2_SUC = prove + (`!n a b. coprime(a EXP (SUC n),b EXP (SUC n)) <=> coprime(a,b)`, + REWRITE_TAC[COPRIME_EXP2; NOT_SUC]);; + +let COPRIME_REFL = prove + (`!n. coprime(n,n) <=> (n = 1)`, + REWRITE_TAC[COPRIME_GCD; GCD_REFL]);; + +let COPRIME_PLUS1 = prove + (`!n. coprime(n + 1,n)`, + NUMBER_TAC);; + +let COPRIME_MINUS1 = prove + (`!n. ~(n = 0) ==> coprime(n - 1,n)`, + REPEAT STRIP_TAC THEN SIMP_TAC[coprime] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_SUB) THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - (n - 1) = 1`; DIVIDES_ONE]);; + +let BEZOUT_GCD_POW = prove( + `!n a b. ?x y. (((a EXP n) * x) - ((b EXP n) * y) = gcd(a,b) EXP n) \/ + (((b EXP n) * x) - ((a EXP n) * y) = gcd(a,b) EXP n)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL + [STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THENL + [MAP_EVERY EXISTS_TAC [`1`; `0`] THEN REWRITE_TAC[SUB_0]; + REPEAT(EXISTS_TAC `0`) THEN REWRITE_TAC[MULT_CLAUSES; SUB_0]]; + MP_TAC(SPECL [`a:num`; `b:num`] GCD) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC) THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `b':num` ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a':num` ASSUME_TAC) THEN + MP_TAC(SPECL [`a:num`; `b:num`; `a':num`; `b':num`] GCD_COPRIME) THEN + RULE_ASSUM_TAC GSYM THEN RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o GSYM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP COPRIME_EXP_IMP) THEN + REWRITE_TAC[COPRIME_BEZOUT] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` MP_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + DISCH_THEN (MP_TAC o AP_TERM `(*) (gcd(a,b) EXP n)`) THEN + REWRITE_TAC[MULT_CLAUSES; LEFT_SUB_DISTRIB] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MAP_EVERY EXISTS_TAC [`x:num`; `y:num`] THEN + REWRITE_TAC[MULT_ASSOC; GSYM MULT_EXP] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[MULT_SYM]) THEN + ASM_REWRITE_TAC[]]);; + +let GCD_EXP = prove( + `!n a b. gcd(a EXP n,b EXP n) = gcd(a,b) EXP n`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + ONCE_REWRITE_TAC[GSYM GCD_UNIQUE] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC DIVIDES_EXP THEN REWRITE_TAC[GCD]; + MATCH_MP_TAC DIVIDES_EXP THEN REWRITE_TAC[GCD]; + X_GEN_TAC `d:num` THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `a:num`; `b:num`] BEZOUT_GCD_POW) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN (DISJ_CASES_THEN + (SUBST1_TAC o SYM))) THEN + MATCH_MP_TAC DIVIDES_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC DIVIDES_RMUL THEN ASM_REWRITE_TAC[]]);; + +let DIVISION_DECOMP = prove( + `!a b c. a divides (b * c) ==> + ?b' c'. (a = b' * c') /\ b' divides b /\ c' divides c`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `gcd(a,b)` THEN REWRITE_TAC[GCD] THEN + MP_TAC(SPECL [`a:num`; `b:num`] GCD_COPRIME_EXISTS) THEN + ASM_CASES_TAC `gcd(a,b) = 0` THENL + [ASM_REWRITE_TAC[] THEN EXISTS_TAC `1` THEN + RULE_ASSUM_TAC(REWRITE_RULE[GCD_ZERO]) THEN + ASM_REWRITE_TAC[MULT_CLAUSES; DIVIDES_1]; + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a':num` (X_CHOOSE_THEN `b':num` + (STRIP_ASSUME_TAC o GSYM o ONCE_REWRITE_RULE[MULT_SYM]))) THEN + EXISTS_TAC `a':num` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `a divides (b * c)` THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o LAND_CONV) [GSYM th]) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) + [GSYM th]) THEN REWRITE_TAC[MULT_ASSOC] THEN + DISCH_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN + EXISTS_TAC `b':num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIVIDES_CMUL2 THEN EXISTS_TAC `gcd(a,b)` THEN + REWRITE_TAC[MULT_ASSOC] THEN CONJ_TAC THEN + FIRST_ASSUM MATCH_ACCEPT_TAC]);; + +let DIVIDES_EXP2_REV = prove + (`!n a b. (a EXP n) divides (b EXP n) /\ ~(n = 0) ==> a divides b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `gcd(a,b) = 0` THENL + [ASM_MESON_TAC[GCD_ZERO; DIVIDES_REFL]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP GCD_COPRIME_EXISTS) THEN + STRIP_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[MULT_EXP] THEN + ASM_SIMP_TAC[EXP_EQ_0; DIVIDES_RMUL2_EQ] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE + `a divides b ==> coprime(a,b) ==> a divides 1`)) THEN + ASM_SIMP_TAC[COPRIME_EXP2; DIVIDES_ONE; DIVIDES_1; EXP_EQ_1]);; + +let DIVIDES_EXP2_EQ = prove + (`!n a b. ~(n = 0) ==> ((a EXP n) divides (b EXP n) <=> a divides b)`, + MESON_TAC[DIVIDES_EXP2_REV; DIVIDES_EXP]);; + +let DIVIDES_MUL = prove + (`!m n r. m divides r /\ n divides r /\ coprime(m,n) ==> (m * n) divides r`, + NUMBER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A binary form of the Chinese Remainder Theorem. *) +(* ------------------------------------------------------------------------- *) + +let CHINESE_REMAINDER = prove + (`!a b u v. coprime(a,b) /\ ~(a = 0) /\ ~(b = 0) + ==> ?x q1 q2. (x = u + q1 * a) /\ (x = v + q2 * b)`, + let lemma = prove + (`(?d x y. (d = 1) /\ P x y d) <=> (?x y. P x y 1)`, + MESON_TAC[]) in + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`b:num`; `a:num`] BEZOUT_ADD_STRONG) THEN + MP_TAC(SPECL [`a:num`; `b:num`] BEZOUT_ADD_STRONG) THEN + ASM_REWRITE_TAC[CONJ_ASSOC] THEN + SUBGOAL_THEN `!d. d divides a /\ d divides b <=> (d = 1)` + (fun th -> REWRITE_TAC[th; ONCE_REWRITE_RULE[CONJ_SYM] th]) + THENL + [UNDISCH_TAC `coprime(a,b)` THEN + SIMP_TAC[GSYM DIVIDES_GCD; COPRIME_GCD; DIVIDES_ONE]; ALL_TAC] THEN + REWRITE_TAC[lemma] THEN + DISCH_THEN(X_CHOOSE_THEN `x1:num` (X_CHOOSE_TAC `y1:num`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x2:num` (X_CHOOSE_TAC `y2:num`)) THEN + EXISTS_TAC `v * a * x1 + u * b * x2:num` THEN + EXISTS_TAC `v * x1 + u * y2:num` THEN + EXISTS_TAC `v * y1 + u * x2:num` THEN CONJ_TAC THENL + [SUBST1_TAC(ASSUME `b * x2 = a * y2 + 1`); + SUBST1_TAC(ASSUME `a * x1 = b * y1 + 1`)] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Primality *) +(* ------------------------------------------------------------------------- *) + +let prime = new_definition + `prime(p) <=> ~(p = 1) /\ !x. x divides p ==> (x = 1) \/ (x = p)`;; + +(* ------------------------------------------------------------------------- *) +(* A few useful theorems about primes *) +(* ------------------------------------------------------------------------- *) + +let PRIME_0 = prove( + `~prime(0)`, + REWRITE_TAC[prime] THEN + DISCH_THEN(MP_TAC o SPEC `2` o CONJUNCT2) THEN + REWRITE_TAC[DIVIDES_0; ARITH]);; + +let PRIME_1 = prove( + `~prime(1)`, + REWRITE_TAC[prime]);; + +let PRIME_2 = prove( + `prime(2)`, + REWRITE_TAC[prime; ARITH] THEN + REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + REWRITE_TAC[ARITH] THEN REWRITE_TAC[LE_LT] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; LESS_THM; NOT_LESS_0] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[DIVIDES_ZERO] THEN + REWRITE_TAC[ARITH] THEN REWRITE_TAC[]);; + +let PRIME_GE_2 = prove( + `!p. prime(p) ==> 2 <= p`, + GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; LESS_THM; NOT_LESS_0] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + REWRITE_TAC[SYM(num_CONV `1`); PRIME_0; PRIME_1]);; + +let PRIME_FACTOR = prove( + `!n. ~(n = 1) ==> ?p. prime(p) /\ p divides n`, + MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `prime(n)` THENL + [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[DIVIDES_REFL]; + UNDISCH_TAC `~prime(n)` THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[prime]) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN + REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_THEN MP_TAC o MATCH_MP DIVIDES_LE) THENL + [ASM_REWRITE_TAC[LE_LT] THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `m:num` THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `2` THEN + REWRITE_TAC[PRIME_2; DIVIDES_0]]]);; + +let PRIME_FACTOR_LT = prove( + `!n m p. prime(p) /\ ~(n = 0) /\ (n = p * m) ==> m < n`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN + ASM_REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[num_CONV `2`; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN MATCH_MP_TAC LESS_ADD_NONZERO THEN + REWRITE_TAC[ADD_EQ_0] THEN DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN + ASM_REWRITE_TAC[MULT_CLAUSES]);; + +let PRIME_FACTOR_INDUCT = prove + (`!P. P 0 /\ P 1 /\ + (!p n. prime p /\ ~(n = 0) /\ P n ==> P(p * n)) + ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN MAP_EVERY ASM_CASES_TAC [`n = 0`; `n = 1`] THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM(X_CHOOSE_THEN `p:num` + STRIP_ASSUME_TAC o MATCH_MP PRIME_FACTOR) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o + GEN_REWRITE_RULE I [divides]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `d:num`]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[PRIME_FACTOR_LT; MULT_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* Infinitude of primes. *) +(* ------------------------------------------------------------------------- *) + +let EUCLID_BOUND = prove + (`!n. ?p. prime(p) /\ n < p /\ p <= SUC(FACT n)`, + GEN_TAC THEN MP_TAC(SPEC `FACT n + 1` PRIME_FACTOR) THEN + SIMP_TAC[ARITH_RULE `0 < n ==> ~(n + 1 = 1)`; ADD1; FACT_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[DIVIDES_ADD_REVR; DIVIDES_ONE; PRIME_1; NOT_LT; PRIME_0; + ARITH_RULE `(p = 0) \/ 1 <= p`; DIVIDES_FACT]; + ASM_MESON_TAC[DIVIDES_LE; ARITH_RULE `~(x + 1 = 0)`]]);; + +let EUCLID = prove + (`!n. ?p. prime(p) /\ p > n`, + REWRITE_TAC[GT] THEN MESON_TAC[EUCLID_BOUND]);; + +let PRIMES_INFINITE = prove + (`INFINITE {p | prime p}`, + REWRITE_TAC[INFINITE; num_FINITE; IN_ELIM_THM] THEN + MESON_TAC[EUCLID; NOT_LE; GT]);; + +let COPRIME_PRIME = prove( + `!p a b. coprime(a,b) ==> ~(prime(p) /\ p divides a /\ p divides b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[coprime] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p = 1` SUBST_ALL_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `prime 1` THEN REWRITE_TAC[PRIME_1]]);; + +let COPRIME_PRIME_EQ = prove( + `!a b. coprime(a,b) <=> !p. ~(prime(p) /\ p divides a /\ p divides b)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP COPRIME_PRIME th]); + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[coprime] THEN + ONCE_REWRITE_TAC[NOT_FORALL_THM] THEN REWRITE_TAC[NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `p:num` o MATCH_MP PRIME_FACTOR) THEN + EXISTS_TAC `p:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC DIVIDES_TRANS THEN EXISTS_TAC `d:num` THEN + ASM_REWRITE_TAC[]]);; + +let PRIME_COPRIME = prove( + `!n p. prime(p) ==> (n = 1) \/ p divides n \/ coprime(p,n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[prime; COPRIME_GCD] THEN + STRIP_ASSUME_TAC(SPECL [`p:num`; `n:num`] GCD) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `gcd(p,n)`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[]);; + +let PRIME_COPRIME_STRONG = prove + (`!n p. prime(p) ==> p divides n \/ coprime(p,n)`, + MESON_TAC[PRIME_COPRIME; COPRIME_1]);; + +let PRIME_COPRIME_EQ = prove + (`!p n. prime p ==> (coprime(p,n) <=> ~(p divides n))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(b \/ a) /\ ~(a /\ b) ==> (a <=> ~b)`) THEN + ASM_SIMP_TAC[PRIME_COPRIME_STRONG] THEN + ASM_MESON_TAC[COPRIME_REFL; PRIME_1; NUMBER_RULE + `coprime(p,n) /\ p divides n ==> coprime(p,p)`]);; + +let COPRIME_PRIMEPOW = prove + (`!p k m. prime p /\ ~(k = 0) ==> (coprime(m,p EXP k) <=> ~(p divides m))`, + SIMP_TAC[COPRIME_REXP] THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN + SIMP_TAC[PRIME_COPRIME_EQ]);; + +let COPRIME_BEZOUT_STRONG = prove + (`!a b. coprime(a,b) /\ ~(b = 1) ==> ?x y. a * x = b * y + 1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_GCD]) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC BEZOUT_GCD_STRONG THEN + ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]);; + +let COPRIME_BEZOUT_ALT = prove + (`!a b. coprime(a,b) /\ ~(a = 0) ==> ?x y. a * x = b * y + 1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_GCD]) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC BEZOUT_GCD_STRONG THEN + ASM_MESON_TAC[COPRIME_0; COPRIME_SYM]);; + +let BEZOUT_PRIME = prove + (`!a p. prime p /\ ~(p divides a) ==> ?x y. a * x = p * y + 1`, + MESON_TAC[PRIME_COPRIME_STRONG; COPRIME_SYM; + COPRIME_BEZOUT_STRONG; PRIME_1]);; + +let PRIME_DIVPROD = prove( + `!p a b. prime(p) /\ p divides (a * b) ==> p divides a \/ p divides b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THENL + [DISJ2_TAC THEN UNDISCH_TAC `p divides (a * b)` THEN + ASM_REWRITE_TAC[MULT_CLAUSES]; + DISJ2_TAC THEN MATCH_MP_TAC COPRIME_DIVPROD THEN + EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[]]);; + +let PRIME_DIVPROD_EQ = prove + (`!p a b. prime(p) ==> (p divides (a * b) <=> p divides a \/ p divides b)`, + MESON_TAC[PRIME_DIVPROD; DIVIDES_LMUL; DIVIDES_RMUL]);; + +let PRIME_DIVEXP = prove( + `!n p x. prime(p) /\ p divides (x EXP n) ==> p divides x`, + INDUCT_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[EXP; DIVIDES_ONE] THENL + [DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN REWRITE_TAC[DIVIDES_1]; + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN + DISCH_THEN(DISJ_CASES_TAC o MATCH_MP PRIME_DIVPROD) THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + +let PRIME_DIVEXP_N = prove( + `!n p x. prime(p) /\ p divides (x EXP n) ==> (p EXP n) divides (x EXP n)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP PRIME_DIVEXP) THEN + MATCH_ACCEPT_TAC DIVIDES_EXP);; + +let PRIME_DIVEXP_EQ = prove + (`!n p x. prime p ==> (p divides x EXP n <=> p divides x /\ ~(n = 0))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[EXP; DIVIDES_ONE] THEN + ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_REXP; PRIME_1]);; + +let PARITY_EXP = prove( + `!n x. EVEN(x EXP (SUC n)) = EVEN(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM DIVIDES_2] THEN EQ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC PRIME_DIVEXP THEN + EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[PRIME_2]; + REWRITE_TAC[EXP] THEN MATCH_ACCEPT_TAC DIVIDES_RMUL]);; + +let COPRIME_SOS = prove + (`!x y. coprime(x,y) ==> coprime(x * y,(x EXP 2) + (y EXP 2))`, + NUMBER_TAC);; + +let PRIME_IMP_NZ = prove + (`!p. prime(p) ==> ~(p = 0)`, + MESON_TAC[PRIME_0]);; + +let DISTINCT_PRIME_COPRIME = prove + (`!p q. prime p /\ prime q /\ ~(p = q) ==> coprime(p,q)`, + MESON_TAC[prime; coprime; PRIME_1]);; + +let PRIME_COPRIME_LT = prove + (`!x p. prime p /\ 0 < x /\ x < p ==> coprime(x,p)`, + REWRITE_TAC[coprime; prime] THEN + MESON_TAC[LT_REFL; DIVIDES_LE; NOT_LT; PRIME_0]);; + +let DIVIDES_PRIME_PRIME = prove + (`!p q. prime p /\ prime q ==> (p divides q <=> p = q)`, + MESON_TAC[DIVIDES_REFL; DISTINCT_PRIME_COPRIME; PRIME_COPRIME_EQ]);; + +let DIVIDES_PRIME_EXP_LE = prove + (`!p q m n. prime p /\ prime q + ==> ((p EXP m) divides (q EXP n) <=> m = 0 \/ p = q /\ m <= n)`, + GEN_TAC THEN GEN_TAC THEN REPEAT INDUCT_TAC THEN + ASM_SIMP_TAC[EXP; DIVIDES_1; DIVIDES_ONE; MULT_EQ_1; NOT_SUC] THENL + [MESON_TAC[PRIME_1; ARITH_RULE `~(SUC m <= 0)`]; ALL_TAC] THEN + ASM_CASES_TAC `p:num = q` THEN + ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2; GSYM(CONJUNCT2 EXP)] THEN + ASM_MESON_TAC[PRIME_DIVEXP; DIVIDES_PRIME_PRIME; EXP; DIVIDES_RMUL2]);; + +let EQ_PRIME_EXP = prove + (`!p q m n. prime p /\ prime q + ==> (p EXP m = q EXP n <=> m = 0 /\ n = 0 \/ p = q /\ m = n)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM DIVIDES_ANTISYM] THEN + ASM_SIMP_TAC[DIVIDES_PRIME_EXP_LE] THEN ARITH_TAC);; + +let PRIME_ODD = prove + (`!p. prime p ==> p = 2 \/ ODD p`, + GEN_TAC THEN REWRITE_TAC[prime; GSYM NOT_EVEN; EVEN_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `2`)) THEN + REWRITE_TAC[divides; ARITH] THEN MESON_TAC[]);; + +let DIVIDES_FACT_PRIME = prove + (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1]; + ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL; + ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);; + +let EQ_PRIMEPOW = prove + (`!p m n. prime p ==> (p EXP m = p EXP n <=> m = n)`, + ONCE_REWRITE_TAC[GSYM LE_ANTISYM] THEN + SIMP_TAC[LE_EXP; PRIME_IMP_NZ] THEN MESON_TAC[PRIME_1]);; + +let COPRIME_2 = prove + (`(!n. coprime(2,n) <=> ODD n) /\ (!n. coprime(n,2) <=> ODD n)`, + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [COPRIME_SYM] THEN + SIMP_TAC[PRIME_COPRIME_EQ; PRIME_2; DIVIDES_2; NOT_EVEN]);; + +let DIVIDES_EXP_PLUS1 = prove + (`!n k. ODD k ==> (n + 1) divides (n EXP k + 1)`, + GEN_TAC THEN REWRITE_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN + INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[EXP_1; DIVIDES_REFL] THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * SUC n) = SUC(2 * n) + 2`] THEN + REWRITE_TAC[EXP_ADD; EXP_2] THEN POP_ASSUM MP_TAC THEN NUMBER_TAC);; + +let DIVIDES_EXP_MINUS1 = prove + (`!k n. (n - 1) divides (n EXP k - 1)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [STRUCT_CASES_TAC(SPEC `k:num` num_CASES) THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[DIVIDES_REFL]; + REWRITE_TAC[num_divides] THEN + ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB; LE_1; EXP_EQ_0; ARITH] THEN + POP_ASSUM(K ALL_TAC) THEN REWRITE_TAC[GSYM INT_OF_NUM_POW] THEN + SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN REWRITE_TAC[INT_POW] THEN + REPEAT(POP_ASSUM MP_TAC) THEN INTEGER_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* One property of coprimality is easier to prove via prime factors. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_EXP_DIVPROD = prove + (`!d n a b. + (d EXP n) divides (a * b) /\ coprime(d,a) ==> (d EXP n) divides b`, + MESON_TAC[COPRIME_DIVPROD; COPRIME_EXP; COPRIME_SYM]);; + +let PRIME_COPRIME_CASES = prove + (`!p a b. prime p /\ coprime(a,b) ==> coprime(p,a) \/ coprime(p,b)`, + MESON_TAC[COPRIME_PRIME; PRIME_COPRIME_EQ]);; + +let PRIME_DIVPROD_POW = prove + (`!n p a b. prime(p) /\ coprime(a,b) /\ (p EXP n) divides (a * b) + ==> (p EXP n) divides a \/ (p EXP n) divides b`, + MESON_TAC[COPRIME_EXP_DIVPROD; PRIME_COPRIME_CASES; MULT_SYM]);; + +let EXP_MULT_EXISTS = prove + (`!m n p k. ~(m = 0) /\ m EXP k * n = p EXP k ==> ?q. n = q EXP k`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `k = 0` THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN + MP_TAC(SPECL [`k:num`; `m:num`; `p:num`] DIVIDES_EXP2_REV) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[divides; MULT_SYM]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN + ASM_REWRITE_TAC[MULT_EXP; GSYM MULT_ASSOC; EQ_MULT_LCANCEL; EXP_EQ_0] THEN + MESON_TAC[]);; + +let COPRIME_POW = prove + (`!n a b c. coprime(a,b) /\ a * b = c EXP n + ==> ?r s. a = r EXP n /\ b = s EXP n`, + GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN ASM_CASES_TAC `n = 0` THEN + ASM_SIMP_TAC[EXP; MULT_EQ_1] THEN MATCH_MP_TAC PRIME_FACTOR_INDUCT THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[EXP_ZERO; MULT_EQ_0] THEN + ASM_MESON_TAC[COPRIME_0; EXP_ZERO; COPRIME_0; EXP_ONE]; + SIMP_TAC[EXP_ONE; MULT_EQ_1] THEN MESON_TAC[EXP_ONE]; + REWRITE_TAC[MULT_EXP] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p EXP n divides a \/ p EXP n divides b` MP_TAC THENL + [ASM_MESON_TAC[PRIME_DIVPROD_POW; divides]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN + DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COPRIME_SYM]) THEN + ASM_SIMP_TAC[COPRIME_RMUL; COPRIME_LMUL; COPRIME_LEXP; COPRIME_REXP] THEN + STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`b:num`; `d:num`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `a:num`])] THEN + ASM_REWRITE_TAC[] THEN + (ANTS_TAC THENL + [MATCH_MP_TAC(NUM_RING `!p. ~(p = 0) /\ a * p = b * p ==> a = b`) THEN + EXISTS_TAC `p EXP n` THEN ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN CONV_TAC NUM_RING; + STRIP_TAC THEN ASM_REWRITE_TAC[GSYM MULT_EXP] THEN MESON_TAC[]])]);; + +(* ------------------------------------------------------------------------- *) +(* More useful lemmas. *) +(* ------------------------------------------------------------------------- *) + +let PRIME_EXP = prove + (`!p n. prime(p EXP n) <=> prime(p) /\ (n = 1)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[EXP; PRIME_1; ARITH_EQ] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`n:num`,`n:num`) THEN + ASM_CASES_TAC `p = 0` THENL + [ASM_REWRITE_TAC[PRIME_0; EXP; MULT_CLAUSES]; ALL_TAC] THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH; EXP_1; EXP; MULT_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `~(SUC(SUC n) = 1)`] THEN + REWRITE_TAC[prime; DE_MORGAN_THM] THEN + ASM_REWRITE_TAC[MULT_EQ_1; EXP_EQ_1] THEN ASM_CASES_TAC `p = 1` THEN + ASM_REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN + DISCH_THEN(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[NOT_IMP] THEN + CONJ_TAC THENL [MESON_TAC[EXP; divides]; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `p < pn:num ==> ~(p = pn)`) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN + REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN + ASM_REWRITE_TAC[LT_EXP; ARITH_EQ] THEN + MAP_EVERY UNDISCH_TAC [`~(p = 0)`; `~(p = 1)`] THEN ARITH_TAC);; + +let PRIME_POWER_MULT = prove + (`!k x y p. prime p /\ (x * y = p EXP k) + ==> ?i j. (x = p EXP i) /\ (y = p EXP j)`, + INDUCT_TAC THEN REWRITE_TAC[EXP; MULT_EQ_1] THENL + [MESON_TAC[EXP]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `p divides x \/ p divides y` MP_TAC THENL + [ASM_MESON_TAC[PRIME_DIVPROD; divides; MULT_AC]; ALL_TAC] THEN + REWRITE_TAC[divides] THEN + SUBGOAL_THEN `~(p = 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_0]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `d:num` SUBST_ALL_TAC)) THENL + [UNDISCH_TAC `(p * d) * y = p * p EXP k`; + UNDISCH_TAC `x * p * d = p * p EXP k` THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [MULT_SYM]] THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN + ASM_REWRITE_TAC[EQ_MULT_LCANCEL] THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `y:num`; `p:num`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`d:num`; `x:num`; `p:num`])] THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[EXP]);; + +let PRIME_POWER_EXP = prove + (`!n x p k. prime p /\ ~(n = 0) /\ (x EXP n = p EXP k) ==> ?i. x = p EXP i`, + INDUCT_TAC THEN REWRITE_TAC[EXP] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[NOT_SUC] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[EXP] THEN + ASM_MESON_TAC[PRIME_POWER_MULT]);; + +let DIVIDES_PRIMEPOW = prove + (`!p. prime p ==> !d. d divides (p EXP k) <=> ?i. i <= k /\ d = p EXP i`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:num` THEN + DISCH_TAC THEN + MP_TAC(SPECL [`k:num`; `d:num`; `e:num`; `p:num`] PRIME_POWER_MULT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN REWRITE_TAC[GSYM EXP_ADD] THEN + REWRITE_TAC[GSYM LE_ANTISYM; LE_EXP] THEN REWRITE_TAC[LE_ANTISYM] THEN + POP_ASSUM MP_TAC THEN ASM_CASES_TAC `p = 0` THEN ASM_SIMP_TAC[PRIME_0] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[PRIME_1; LE_ANTISYM] THEN + MESON_TAC[LE_ADD]; + REWRITE_TAC[LE_EXISTS] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[EXP_ADD] THEN MESON_TAC[DIVIDES_RMUL; DIVIDES_REFL]]);; + +let PRIMEPOW_DIVIDES_PROD = prove + (`!p k m n. + prime p /\ (p EXP k) divides (m * n) + ==> ?i j. (p EXP i) divides m /\ (p EXP j) divides n /\ k = i + j`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_DECOMP) THEN + REWRITE_TAC[NUMBER_RULE + `a = b * c <=> b divides a /\ c divides a /\ b * c = a`] THEN + ASM_MESON_TAC[EXP_ADD; EQ_PRIMEPOW; DIVIDES_PRIMEPOW]);; + +let COPRIME_DIVISORS = prove + (`!a b d e. d divides a /\ e divides b /\ coprime(a,b) ==> coprime(d,e)`, + NUMBER_TAC);; + +let PRIMEPOW_FACTOR = prove + (`!n. 2 <= n + ==> ?p k m. prime p /\ 1 <= k /\ coprime(p,m) /\ n = p EXP k * m`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `n:num` PRIME_FACTOR) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN + ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `2 <= n ==> ~(n = 0)`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[divides; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k + 1`)) THEN + ASM_REWRITE_TAC[ARITH_RULE `k < k + 1`; EXP_ADD; GSYM MULT_ASSOC] THEN + ASM_SIMP_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; PRIME_IMP_NZ] THEN + REWRITE_TAC[EXP_1; GSYM divides] THEN UNDISCH_TAC `(p:num) divides n` THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `k = 0` THEN ASM_SIMP_TAC[EXP; MULT_CLAUSES; LE_1] THEN + ASM_MESON_TAC[PRIME_COPRIME_STRONG]);; + +let PRIMEPOW_DIVISORS_DIVIDES = prove + (`!m n. m divides n <=> + !p k. prime p /\ p EXP k divides m ==> p EXP k divides n`, + REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL + [MESON_TAC[DIVIDES_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[DIVIDES_0] THENL + [MP_TAC(SPEC `n:num` EUCLID) THEN REWRITE_TAC[GT] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`p:num`; `1`]) THEN ASM_REWRITE_TAC[EXP_1] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_SIMP_TAC[GSYM NOT_LT; DIVIDES_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `m = 1` THEN ASM_REWRITE_TAC[DIVIDES_1] THEN + MP_TAC(SPEC `m:num` PRIMEPOW_FACTOR) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `k:num`; `r:num`] THEN STRIP_TAC THEN + DISCH_THEN(fun th -> + MP_TAC(SPECL[`p:num`; `k:num`] th) THEN + ASM_REWRITE_TAC[NUMBER_RULE `a divides (a * b)`] THEN + ASSUME_TAC th) THEN + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `s:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[GSYM divides] THEN + MATCH_MP_TAC DIVIDES_MUL_L THEN REMOVE_THEN "*" (MP_TAC o SPEC `r:num`) THEN + ASM_CASES_TAC `r = 0` THENL [ASM_MESON_TAC[MULT_CLAUSES]; ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `q < p * q <=> 1 * q < p * q`] THEN + ASM_SIMP_TAC[LT_MULT_RCANCEL; ARITH_RULE `1 < p <=> ~(p = 0 \/ p = 1)`] THEN + REWRITE_TAC[EXP_EQ_0; EXP_EQ_1] THEN + ANTS_TAC THENL [ASM_MESON_TAC[PRIME_0; PRIME_1; LE_1]; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN MAP_EVERY X_GEN_TAC [`q:num`; `l:num`] THEN + ASM_CASES_TAC `l = 0` THEN ASM_REWRITE_TAC[EXP; DIVIDES_1] THEN + STRIP_TAC THEN ASM_CASES_TAC `q:num = p` THENL + [UNDISCH_TAC `coprime(p,r)` THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `p:num`) THEN + ASM_SIMP_TAC[DIVIDES_REFL; PRIME_GE_2; ARITH_RULE + `2 <= p ==> ~(p = 1)`] THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + TRANS_TAC DIVIDES_TRANS `p EXP l` THEN + ASM_MESON_TAC[DIVIDES_REXP; DIVIDES_REFL]; + FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `l:num`]) THEN + ASM_SIMP_TAC[DIVIDES_LMUL] THEN DISCH_THEN(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] COPRIME_EXP_DIVPROD)) THEN + MATCH_MP_TAC COPRIME_EXP THEN ASM_MESON_TAC[DISTINCT_PRIME_COPRIME]]);; + +let PRIMEPOW_DIVISORS_EQ = prove + (`!m n. m = n <=> + !p k. prime p ==> (p EXP k divides m <=> p EXP k divides n)`, + MESON_TAC[DIVIDES_ANTISYM; PRIMEPOW_DIVISORS_DIVIDES]);; + +(* ------------------------------------------------------------------------- *) +(* Index of a (usually prime) divisor of a number. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_EXP_LE = prove + (`!P p n. 2 <= p ==> FINITE {j | P j /\ p EXP j <= n}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_ELIM_THM; LE_0; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN TRANS_TAC LE_TRANS `p EXP i` THEN + ASM_REWRITE_TAC[] THEN TRANS_TAC LE_TRANS `2 EXP i` THEN + ASM_SIMP_TAC[EXP_MONO_LE_IMP; LT_POW2_REFL; LT_IMP_LE]);; + +let FINITE_INDICES = prove + (`!P p n. 2 <= p /\ ~(n = 0) ==> FINITE {j | P j /\ p EXP j divides n}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{j | P j /\ p EXP j <= n}` THEN + ASM_SIMP_TAC[FINITE_EXP_LE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[DIVIDES_LE]);; + +let index_def = new_definition + `index p n = if p <= 1 \/ n = 0 then 0 + else CARD {j | 1 <= j /\ p EXP j divides n}`;; + +let INDEX_0 = prove + (`!p. index p 0 = 0`, + REWRITE_TAC[index_def]);; + +let PRIMEPOW_DIVIDES_INDEX = prove + (`!n p k. p EXP k divides n <=> n = 0 \/ p = 1 \/ k <= index p n`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[INDEX_0; DIVIDES_0; EXP_EQ_0] THEN + ASM_CASES_TAC `p = 0` THEN + ASM_REWRITE_TAC[EXP_ZERO; COND_RAND; COND_RATOR] THEN + ASM_SIMP_TAC[LE_0; DIVIDES_1; ARITH; index_def; DIVIDES_ZERO] THEN + SIMP_TAC[CONJUNCT1 LE; COND_ID] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[EXP_ONE; DIVIDES_1] THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `2 <= p` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `!k. p EXP k divides n <=> k <= a` ASSUME_TAC THENL + [GEN_TAC THEN EQ_TAC THENL [ASM_MESON_TAC[NOT_LE]; ALL_TAC] THEN + DISCH_TAC THEN TRANS_TAC DIVIDES_TRANS `p EXP a` THEN + ASM_SIMP_TAC[DIVIDES_EXP_LE]; + ASM_REWRITE_TAC[GSYM numseg; CARD_NUMSEG_1]]);; + +let LE_INDEX = prove + (`!n p k. k <= index p n <=> (n = 0 \/ p = 1 ==> k = 0) /\ p EXP k divides n`, + REPEAT GEN_TAC THEN REWRITE_TAC[PRIMEPOW_DIVIDES_INDEX] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[INDEX_0; CONJUNCT1 LE] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[index_def; ARITH; CONJUNCT1 LE]);; + +let INDEX_1 = prove + (`!p. index p 1 = 0`, + GEN_TAC THEN REWRITE_TAC[index_def; ARITH] THEN COND_CASES_TAC THEN + REWRITE_TAC[DIVIDES_ONE; EXP_EQ_1] THEN + ASM_SIMP_TAC[ARITH_RULE `~(p <= 1) ==> ~(p = 1)`; + ARITH_RULE `~(1 <= j /\ j = 0)`; + EMPTY_GSPEC; CARD_CLAUSES]);; + +let INDEX_MUL = prove + (`!m n. prime p /\ ~(m = 0) /\ ~(n = 0) + ==> index p (m * n) = index p m + index p n`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN + SUBGOAL_THEN `~(p = 1)` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_1]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(MESON[LE_REFL] + `(!k:num. k <= m ==> k <= n) ==> m <= n`) THEN + MP_TAC(SPEC `p:num` PRIMEPOW_DIVIDES_PROD) THEN + ASM_REWRITE_TAC[LE_INDEX; MULT_EQ_0] THEN ASM_MESON_TAC[LE_ADD2; LE_INDEX]; + ASM_REWRITE_TAC[LE_INDEX; MULT_EQ_0; EXP_ADD] THEN + MATCH_MP_TAC DIVIDES_MUL2 THEN ASM_MESON_TAC[LE_INDEX; LE_REFL]]);; + +let INDEX_EXP = prove + (`!p n k. prime p ==> index p (n EXP k) = k * index p n`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[EXP_ZERO; INDEX_0; COND_RAND; COND_RATOR; INDEX_1; + MULT_CLAUSES; COND_ID] THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[INDEX_MUL; EXP_EQ_0; EXP; INDEX_1; MULT_CLAUSES] THEN + ARITH_TAC);; + +let INDEX_FACT = prove + (`!p n. prime p ==> index p (FACT n) = nsum(1..n) (\m. index p m)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[FACT; NSUM_CLAUSES_NUMSEG; INDEX_1; ARITH] THEN + ASM_SIMP_TAC[INDEX_MUL; NOT_SUC; FACT_NZ] THEN ARITH_TAC);; + +let INDEX_FACT_ALT = prove + (`!p n. prime p + ==> index p (FACT n) = + nsum {j | 1 <= j /\ p EXP j <= n} (\j. n DIV (p EXP j))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INDEX_FACT] THEN + SUBGOAL_THEN `~(p = 0) /\ ~(p = 1) /\ 2 <= p /\ ~(p <= 1)` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[index_def; LE_1] THEN + TRANS_TAC EQ_TRANS + `nsum(1..n) (\m. nsum {j | 1 <= j /\ p EXP j <= n} + (\j. if p EXP j divides m then 1 else 0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NSUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM NSUM_RESTRICT_SET; IN_ELIM_THM] THEN + ASM_SIMP_TAC[NSUM_CONST; FINITE_INDICES; LE_1; MULT_CLAUSES] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[DIVIDES_LE; LE_1; LE_TRANS]; + W(MP_TAC o PART_MATCH (lhs o rand) NSUM_SWAP o lhand o snd) THEN + ASM_SIMP_TAC[FINITE_NUMSEG; FINITE_EXP_LE] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC NSUM_EQ THEN X_GEN_TAC `j:num` THEN + REWRITE_TAC[IN_ELIM_THM; GSYM NSUM_RESTRICT_SET] THEN STRIP_TAC THEN + ASM_SIMP_TAC[NSUM_CONST; FINITE_NUMSEG; FINITE_RESTRICT; MULT_CLAUSES] THEN + SUBGOAL_THEN `{m | m IN 1..n /\ p EXP j divides m} = + IMAGE (\q. p EXP j * q) (1..(n DIV p EXP j))` + (fun th -> ASM_SIMP_TAC[CARD_IMAGE_INJ; FINITE_NUMSEG; EQ_MULT_LCANCEL; + th; EXP_EQ_0; PRIME_IMP_NZ; CARD_NUMSEG_1]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG; IN_ELIM_THM; divides] THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `q:num` THEN + ASM_CASES_TAC `d = p EXP j * q` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[LE_RDIV_EQ; EXP_EQ_0; PRIME_IMP_NZ; MULT_EQ_0; + ARITH_RULE `1 <= x <=> ~(x = 0)`]]);; + +let INDEX_FACT_UNBOUNDED = prove + (`!p n. prime p + ==> index p (FACT n) = nsum {j | 1 <= j} (\j. n DIV (p EXP j))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INDEX_FACT_ALT] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC NSUM_SUPERSET THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IMP_CONJ; DIV_EQ_0; EXP_EQ_0; + PRIME_IMP_NZ; NOT_LE]);; + +let PRIMEPOW_DIVIDES_FACT = prove + (`!p n k. prime p + ==> (p EXP k divides FACT n <=> + k <= nsum {j | 1 <= j /\ p EXP j <= n} (\j. n DIV (p EXP j)))`, + SIMP_TAC[PRIMEPOW_DIVIDES_INDEX; INDEX_FACT_ALT; FACT_NZ] THEN + MESON_TAC[PRIME_1]);; + +let INDEX_REFL = prove + (`!n. index n n = if n <= 1 then 0 else 1`, + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[index_def] THEN + ASM_CASES_TAC `n = 0` THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + ONCE_REWRITE_TAC[MESON[EXP_1] `a divides b <=> a divides b EXP 1`] THEN + ASM_CASES_TAC `2 <= n` THENL [ALL_TAC; ASM_ARITH_TAC] THEN + ASM_SIMP_TAC[DIVIDES_EXP_LE; GSYM numseg; CARD_NUMSEG_1]);; + +let INDEX_EQ_0 = prove + (`!p n. index p n = 0 <=> n = 0 \/ p = 1 \/ ~(p divides n)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `n = 0 <=> ~(1 <= n)`] THEN + REWRITE_TAC[LE_INDEX; EXP_1; ARITH] THEN MESON_TAC[]);; + +let INDEX_TRIVIAL_BOUND = prove + (`!n p. index p n <= n`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`n:num`; `p:num`; `n:num`] PRIMEPOW_DIVIDES_INDEX) THEN + REWRITE_TAC[index_def] THEN COND_CASES_TAC THEN REWRITE_TAC[LE_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM; NOT_LE]) THEN + ASM_SIMP_TAC[ARITH_RULE `1 < p ==> ~(p = 1)`] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + MATCH_MP_TAC(ARITH_RULE `~(m:num <= n) ==> n <= m`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_REWRITE_TAC[NOT_LE] THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 EXP n` THEN + REWRITE_TAC[LT_POW2_REFL] THEN + MATCH_MP_TAC EXP_MONO_LE_IMP THEN ASM_ARITH_TAC);; + +let INDEX_DECOMPOSITION = prove + (`!n p. ?m. p EXP (index p n) * m = n /\ (n = 0 \/ p = 1 \/ ~(p divides m))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`n:num`; `p:num`; `index p n`] LE_INDEX) THEN + REWRITE_TAC[LE_REFL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [divides]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`n:num`; `p:num`; `index p n + 1`] LE_INDEX) THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ARITH_RULE `~(n + 1 <= n)`] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `p = 1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXP_ADD; EXP_1; CONTRAPOS_THM] THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN POP_ASSUM_LIST(K ALL_TAC) THEN + NUMBER_TAC);; + +let INDEX_DECOMPOSITION_PRIME = prove + (`!n p. prime p ==> ?m. p EXP (index p n) * m = n /\ (n = 0 \/ coprime(p,m))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `p:num`] INDEX_DECOMPOSITION) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + ASM_CASES_TAC `p = 1` THENL [ASM_MESON_TAC[PRIME_1]; ASM_REWRITE_TAC[]] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[PRIME_COPRIME_STRONG]);; + +(* ------------------------------------------------------------------------- *) +(* Least common multiples. *) +(* ------------------------------------------------------------------------- *) + +let lcm = new_definition + `lcm(m,n) = if m * n = 0 then 0 else (m * n) DIV gcd(m,n)`;; + +let LCM_DIVIDES = prove + (`!m n d. lcm(m,n) divides d <=> m divides d /\ n divides d`, + REPEAT GEN_TAC THEN REWRITE_TAC[lcm] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[DIVIDES_ZERO] THENL [MESON_TAC[DIVIDES_0]; ALL_TAC] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[DIVIDES_ZERO] THENL [MESON_TAC[DIVIDES_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[MULT_EQ_0] THEN + TRANS_TAC EQ_TRANS `(m * n) divides (gcd(m,n) * d)` THEN CONJ_TAC THENL + [REWRITE_TAC[divides] THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `r:num` THEN TRANS_TAC EQ_TRANS + `gcd(m,n) * d = gcd(m,n) * ((m * n) DIV gcd (m,n) * r)` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[EQ_MULT_LCANCEL; GCD_ZERO]; + AP_TERM_TAC THEN REWRITE_TAC[MULT_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN + REWRITE_TAC[GSYM DIVIDES_DIV_MULT]]; + ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NUMBER_TAC);; + +let LCM = prove + (`!m n. m divides lcm(m,n) /\ + n divides lcm(m,n) /\ + (!d. m divides d /\ n divides d ==> lcm(m,n) divides d)`, + REPEAT GEN_TAC THEN SIMP_TAC[LCM_DIVIDES] THEN REWRITE_TAC[lcm] THEN + MAP_EVERY ASM_CASES_TAC [`m = 0`; `n = 0`] THEN + ASM_REWRITE_TAC[DIVIDES_0; MULT_CLAUSES] THEN + ASM_REWRITE_TAC[DIVIDES_ZERO; DIVIDES_REFL; MULT_EQ_0] THEN + CONJ_TAC THEN REWRITE_TAC[divides] THENL + [EXISTS_TAC `n DIV gcd(m,n)`; EXISTS_TAC `m DIV gcd(m,n)`] THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + ASM_SIMP_TAC[GCD_ZERO; LE_1; ADD_CLAUSES] THEN CONV_TAC SYM_CONV THENL + [ALL_TAC; GEN_REWRITE_TAC RAND_CONV [MULT_SYM]] THEN + REWRITE_TAC[GSYM MULT_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM DIVIDES_DIV_MULT] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NUMBER_TAC);; + +let DIVIDES_LCM = prove + (`!m n r. r divides m \/ r divides n + ==> r divides lcm(m,n)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM + (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] DIVIDES_TRANS)) THEN + ASM_MESON_TAC[LCM]);; + +let LCM_0 = prove + (`(!n. lcm(0,n) = 0) /\ (!n. lcm(n,0) = 0)`, + REWRITE_TAC[lcm; MULT_CLAUSES] THEN ARITH_TAC);; + +let LCM_1 = prove + (`(!n. lcm(1,n) = n) /\ (!n. lcm(n,1) = n)`, + SIMP_TAC[lcm; MULT_CLAUSES; GCD_1; DIV_1] THEN MESON_TAC[]);; + +let LCM_SYM = prove + (`!m n. lcm(m,n) = lcm(n,m)`, + REWRITE_TAC[lcm; MULT_SYM; GCD_SYM; ARITH_RULE `MAX m n = MAX n m`]);; + +let DIVIDES_LCM_GCD = prove + (`!m n d. d divides lcm(m,n) <=> d * gcd(m,n) divides m * n`, + REPEAT GEN_TAC THEN REWRITE_TAC[lcm] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[DIVIDES_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[MULT_EQ_0; DE_MORGAN_THM]) THEN + MP_TAC(NUMBER_RULE `gcd(m,n) divides m * n`) THEN + SIMP_TAC[divides; LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[GSYM divides] THEN + REPEAT STRIP_TAC THEN MP_TAC(SPECL [`m:num`; `n:num`] GCD_ZERO) THEN + ASM_SIMP_TAC[DIV_MULT] THEN CONV_TAC NUMBER_RULE);; + +let PRIMEPOW_DIVIDES_LCM = prove + (`!m n p k. + prime p + ==> (p EXP k divides lcm(m,n) <=> + p EXP k divides m \/ p EXP k divides n)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL [STRIP_TAC; MESON_TAC[DIVIDES_LCM]] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[LCM_0; DIVIDES_0] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LCM_0; DIVIDES_0] THEN + MP_TAC(SPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN + MP_TAC(SPECL [`m:num`; `p:num`] FACTORIZATION_INDEX) THEN + ASM_SIMP_TAC[PRIME_GE_2; LEFT_IMP_EXISTS_THM; divides; + LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `q:num`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`b:num`; `r:num`] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM divides] THEN + UNDISCH_TAC `p EXP k divides lcm (m,n)` THEN + ASM_REWRITE_TAC[DIVIDES_LCM_GCD] THEN + SUBGOAL_THEN + `gcd(p EXP a * q,p EXP b * r) = + p EXP (MIN a b) * gcd(p EXP (a - MIN a b) * q,p EXP (b - MIN a b) * r)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM GCD_LMUL; MULT_ASSOC; GSYM EXP_ADD] THEN + AP_TERM_TAC THEN BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN ARITH_TAC; + REWRITE_TAC[MULT_ASSOC; GSYM EXP_ADD]] THEN + DISCH_THEN(MP_TAC o + MATCH_MP (NUMBER_RULE `a * b divides c ==> a divides c`)) THEN + REWRITE_TAC[ARITH_RULE `((a * b) * c) * d:num = (a * c) * b * d`] THEN + REWRITE_TAC[GSYM EXP_ADD] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + (ONCE_REWRITE_RULE[MULT_SYM] COPRIME_EXP_DIVPROD))) THEN + ANTS_TAC THENL + [MATCH_MP_TAC COPRIME_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC(MESON[PRIME_COPRIME_STRONG] + `prime p /\ ~(p divides n) ==> coprime(p,n)`) THEN + ASM_REWRITE_TAC[divides] THEN STRIP_TAC THENL + [UNDISCH_TAC `!l. a < l ==> ~(?x. m = p EXP l * x)` THEN + DISCH_THEN(MP_TAC o SPEC `a + 1`); + UNDISCH_TAC `!l. b < l ==> ~(?x. n = p EXP l * x)` THEN + DISCH_THEN(MP_TAC o SPEC `b + 1`)] THEN + ASM_REWRITE_TAC[ARITH_RULE `a < a + 1`; EXP_ADD; EXP_1] THEN + MESON_TAC[MULT_AC]; + ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `k + MIN a b <= a + b ==> k <= a \/ k <= b`)) THEN + MATCH_MP_TAC MONO_OR THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC DIVIDES_RMUL THEN ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2]]);; + +let LCM_ZERO = prove + (`!m n. lcm(m,n) = 0 <=> m = 0 \/ n = 0`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [MULTIPLES_EQ] THEN + REWRITE_TAC[LCM_DIVIDES; DIVIDES_ZERO] THEN + MAP_EVERY ASM_CASES_TAC [`m = 0`; `n = 0`] THEN + ASM_REWRITE_TAC[DIVIDES_ZERO] THEN + ASM_MESON_TAC[DIVIDES_REFL; MULT_EQ_0; DIVIDES_LMUL; DIVIDES_RMUL]);; + +let LCM_ASSOC = prove + (`!m n p. lcm(m,lcm(n,p)) = lcm(lcm(m,n),p)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MULTIPLES_EQ] THEN + REWRITE_TAC[LCM_DIVIDES] THEN X_GEN_TAC `q:num` THEN + REWRITE_TAC[LCM_ZERO] THEN CONV_TAC TAUT);; + +let LCM_REFL = prove + (`!n. lcm(n,n) = n`, + REWRITE_TAC[lcm; GCD_REFL; MULT_EQ_0; ARITH_RULE `MAX n n = n`] THEN + SIMP_TAC[DIV_MULT] THEN MESON_TAC[]);; + +let LCM_MULTIPLE = prove + (`!a b. lcm(b,a * b) = a * b`, + REWRITE_TAC[MULTIPLES_EQ; LCM_DIVIDES] THEN NUMBER_TAC);; + +let LCM_GCD_DISTRIB = prove + (`!a b c. lcm(a,gcd(b,c)) = gcd(lcm(a,b),lcm(a,c))`, + REWRITE_TAC[PRIMEPOW_DIVISORS_EQ] THEN + SIMP_TAC[PRIMEPOW_DIVIDES_LCM; DIVIDES_GCD] THEN CONV_TAC TAUT);; + +let GCD_LCM_DISTRIB = prove + (`!a b c. gcd(a,lcm(b,c)) = lcm(gcd(a,b),gcd(a,c))`, + REWRITE_TAC[PRIMEPOW_DIVISORS_EQ] THEN + SIMP_TAC[PRIMEPOW_DIVIDES_LCM; DIVIDES_GCD] THEN CONV_TAC TAUT);; + +let LCM_UNIQUE = prove + (`!d m n. + m divides d /\ n divides d /\ + (!e. m divides e /\ n divides e ==> d divides e) <=> + d = lcm(m,n)`, + REWRITE_TAC[MULTIPLES_EQ; LCM_DIVIDES] THEN + MESON_TAC[DIVIDES_REFL; DIVIDES_TRANS]);; + +let LCM_EQ = prove + (`!x y u v. (!d. x divides d /\ y divides d <=> u divides d /\ v divides d) + ==> lcm(x,y) = lcm(u,v)`, + SIMP_TAC[MULTIPLES_EQ; LCM_DIVIDES]);; + +let LCM_LMUL = prove + (`!a b c. lcm(c * a,c * b) = c * lcm(a,b)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LCM_0] THEN + ASM_REWRITE_TAC[lcm; GCD_LMUL; MULT_EQ_0; DISJ_ACI] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN + ASM_SIMP_TAC[GSYM MULT_ASSOC; DIV_MULT2; MULT_EQ_0; GCD_ZERO] THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + ASM_SIMP_TAC[ADD_CLAUSES; LE_1; GCD_ZERO] THEN + ONCE_REWRITE_TAC[ARITH_RULE + `a * c * b:num = (c * d) * g <=> c * d * g = c * a * b`] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM DIVIDES_DIV_MULT] THEN + CONV_TAC NUMBER_RULE);; + +let LCM_RMUL = prove + (`!a b c. lcm(a * c,b * c) = c * lcm(a,b)`, + MESON_TAC[LCM_LMUL; MULT_SYM]);; + +let LCM_EXP = prove + (`!n a b. lcm(a EXP n,b EXP n) = lcm(a,b) EXP n`, + REPEAT GEN_TAC THEN REWRITE_TAC[lcm] THEN + REWRITE_TAC[MULT_EQ_0; EXP_EQ_0] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[EXP; GCD_REFL; DIV_1; MULT_CLAUSES] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[num_CASES; EXP_0]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN + REWRITE_TAC[GCD_EXP; GSYM MULT_EXP] THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + ASM_SIMP_TAC[ADD_CLAUSES; LE_1; GCD_ZERO; EXP_EQ_0] THEN + REWRITE_TAC[GSYM MULT_EXP] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM DIVIDES_DIV_MULT] THEN + CONV_TAC NUMBER_RULE);; + +(* ------------------------------------------------------------------------- *) +(* Induction principle for multiplicative functions etc. *) +(* ------------------------------------------------------------------------- *) + +let INDUCT_COPRIME = prove + (`!P. (!a b. 1 < a /\ 1 < b /\ coprime(a,b) /\ P a /\ P b ==> P(a * b)) /\ + (!p k. prime p ==> P(p EXP k)) + ==> !n. 1 < n ==> P n`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE `1 < n ==> ~(n = 1)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `p:num` o MATCH_MP PRIME_FACTOR) THEN + MP_TAC(SPECL [`n:num`; `p:num`] FACTORIZATION_INDEX) THEN + ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE `1 < n ==> ~(n = 0)`] THEN + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN STRIP_TAC THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_CASES_TAC `m = 1` THEN ASM_SIMP_TAC[MULT_CLAUSES] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 MATCH_MP_TAC MP_TAC) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC(TAUT + `!p. (a /\ b /\ ~p) /\ c /\ (a /\ ~p ==> b ==> d) + ==> a /\ b /\ c /\ d`) THEN + EXISTS_TAC `m = 0` THEN + SUBGOAL_THEN `~(k = 0)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `0 < 1`)) THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[EXP; EXP_1; MULT_CLAUSES; divides]; + ALL_TAC] THEN + CONJ_TAC THENL + [UNDISCH_TAC `1 < p EXP k * m` THEN + ASM_REWRITE_TAC[ARITH_RULE `1 < x <=> ~(x = 0) /\ ~(x = 1)`] THEN + ASM_REWRITE_TAC[EXP_EQ_0; EXP_EQ_1; MULT_EQ_0; MULT_EQ_1] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2 o CONJUNCT1) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `k < k + 1`)) THEN + REWRITE_TAC[EXP_ADD; EXP_1; GSYM MULT_ASSOC; EQ_MULT_LCANCEL] THEN + ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ; GSYM divides] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN MATCH_MP_TAC COPRIME_EXP THEN + ASM_MESON_TAC[PRIME_COPRIME; COPRIME_SYM]; + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `m = 1 * m`] THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL]]);; + +let INDUCT_COPRIME_STRONG = prove + (`!P. (!a b. 1 < a /\ 1 < b /\ coprime(a,b) /\ P a /\ P b ==> P(a * b)) /\ + (!p k. prime p /\ ~(k = 0) ==> P(p EXP k)) + ==> !n. 1 < n ==> P n`, + GEN_TAC THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `a ==> b <=> a ==> a ==> b`] THEN + MATCH_MP_TAC INDUCT_COPRIME THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN ASM_CASES_TAC `k = 0` THEN + ASM_REWRITE_TAC[LT_REFL; EXP] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* A conversion for divisibility. *) +(* ------------------------------------------------------------------------- *) + +let DIVIDES_CONV = + let pth_0 = SPEC `b:num` DIVIDES_ZERO + and pth_1 = prove + (`~(a = 0) ==> (a divides b <=> (b MOD a = 0))`, + REWRITE_TAC[DIVIDES_MOD]) + and a_tm = `a:num` and b_tm = `b:num` and zero_tm = `0` + and dest_divides = dest_binop `(divides)` in + fun tm -> + let a,b = dest_divides tm in + if a = zero_tm then + CONV_RULE (RAND_CONV NUM_EQ_CONV) (INST [b,b_tm] pth_0) + else + let th1 = INST [a,a_tm; b,b_tm] pth_1 in + let th2 = MP th1 (EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th1))))) in + CONV_RULE (RAND_CONV (LAND_CONV NUM_MOD_CONV THENC NUM_EQ_CONV)) th2;; + +(* ------------------------------------------------------------------------- *) +(* A conversion for coprimality. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_CONV = + let pth_yes_l = prove + (`(m * x = n * y + 1) ==> (coprime(m,n) <=> T)`, + MESON_TAC[coprime; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_ONE]) + and pth_yes_r = prove + (`(m * x = n * y + 1) ==> (coprime(n,m) <=> T)`, + MESON_TAC[coprime; DIVIDES_RMUL; DIVIDES_ADD_REVR; DIVIDES_ONE]) + and pth_no = prove + (`(m = x * d) /\ (n = y * d) /\ ~(d = 1) ==> (coprime(m,n) <=> F)`, + REWRITE_TAC[coprime; divides] THEN MESON_TAC[MULT_AC]) + and pth_oo = prove + (`coprime(0,0) <=> F`, + MESON_TAC[coprime; DIVIDES_REFL; NUM_REDUCE_CONV `1 = 0`]) + and m_tm = `m:num` and n_tm = `n:num` + and x_tm = `x:num` and y_tm = `y:num` + and d_tm = `d:num` and coprime_tm = `coprime` in + let rec bezout (m,n) = + if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0) + else if m <=/ n then + let q = quo_num n m and r = mod_num n m in + let (x,y) = bezout(m,r) in + (x -/ q */ y,y) + else let (x,y) = bezout(n,m) in (y,x) in + fun tm -> + let pop,ptm = dest_comb tm in + if pop <> coprime_tm then failwith "COPRIME_CONV" else + let l,r = dest_pair ptm in + let m = dest_numeral l and n = dest_numeral r in + if m =/ Int 0 & n =/ Int 0 then pth_oo else + let (x,y) = bezout(m,n) in + let d = x */ m +/ y */ n in + let th = + if d =/ Int 1 then + if x >/ Int 0 then + INST [l,m_tm; r,n_tm; mk_numeral x,x_tm; + mk_numeral(minus_num y),y_tm] pth_yes_l + else + INST [r,m_tm; l,n_tm; mk_numeral(minus_num x),y_tm; + mk_numeral y,x_tm] pth_yes_r + else + INST [l,m_tm; r,n_tm; mk_numeral d,d_tm; + mk_numeral(m // d),x_tm; mk_numeral(n // d),y_tm] pth_no in + MP th (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th))));; + +(* ------------------------------------------------------------------------- *) +(* More general (slightly less efficiently coded) GCD_CONV, and LCM_CONV. *) +(* ------------------------------------------------------------------------- *) + +let GCD_CONV = + let pth0 = prove(`gcd(0,0) = 0`,REWRITE_TAC[GCD_0]) in + let pth1 = prove + (`!m n x y d m' n'. + (m * x = n * y + d) /\ (m = m' * d) /\ (n = n' * d) ==> (gcd(m,n) = d)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN ASM_REWRITE_TAC[GSYM GCD_UNIQUE] THEN + ASM_MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL; + DIVIDES_ADD_REVR; DIVIDES_REFL]) in + let pth2 = prove + (`!m n x y d m' n'. + (n * y = m * x + d) /\ (m = m' * d) /\ (n = n' * d) ==> (gcd(m,n) = d)`, + MESON_TAC[pth1; GCD_SYM]) in + let gcd_tm = `gcd` in + let rec bezout (m,n) = + if m =/ Int 0 then (Int 0,Int 1) else if n =/ Int 0 then (Int 1,Int 0) + else if m <=/ n then + let q = quo_num n m and r = mod_num n m in + let (x,y) = bezout(m,r) in + (x -/ q */ y,y) + else let (x,y) = bezout(n,m) in (y,x) in + fun tm -> let gt,lr = dest_comb tm in + if gt <> gcd_tm then failwith "GCD_CONV" else + let mtm,ntm = dest_pair lr in + let m = dest_numeral mtm and n = dest_numeral ntm in + if m =/ Int 0 & n =/ Int 0 then pth0 else + let x0,y0 = bezout(m,n) in + let x = abs_num x0 and y = abs_num y0 in + let xtm = mk_numeral x and ytm = mk_numeral y in + let d = abs_num(x */ m -/ y */ n) in + let dtm = mk_numeral d in + let m' = m // d and n' = n // d in + let mtm' = mk_numeral m' and ntm' = mk_numeral n' in + let th = SPECL [mtm;ntm;xtm;ytm;dtm;mtm';ntm'] + (if m */ x =/ n */ y +/ d then pth1 else pth2) in + MP th (EQT_ELIM(NUM_REDUCE_CONV(lhand(concl th))));; + +let LCM_CONV = + GEN_REWRITE_CONV I [lcm] THENC + RATOR_CONV(LAND_CONV(LAND_CONV NUM_MULT_CONV THENC NUM_EQ_CONV)) THENC + (GEN_REWRITE_CONV I [CONJUNCT1(SPEC_ALL COND_CLAUSES)] ORELSEC + (GEN_REWRITE_CONV I [CONJUNCT2(SPEC_ALL COND_CLAUSES)] THENC + COMB2_CONV (RAND_CONV NUM_MULT_CONV) GCD_CONV THENC NUM_DIV_CONV));; diff --git a/Library/primitive.ml b/Library/primitive.ml new file mode 100644 index 0000000..29b01be --- /dev/null +++ b/Library/primitive.ml @@ -0,0 +1,765 @@ +(* ========================================================================= *) +(* Existence of primitive roots modulo certain numbers. *) +(* ========================================================================= *) + +needs "Library/integer.ml";; +needs "Library/isum.ml";; +needs "Library/binomial.ml";; +needs "Library/pocklington.ml";; +needs "Library/multiplicative.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas connecting concepts in the various background theories. *) +(* ------------------------------------------------------------------------- *) + +let DIVIDES_BINOM_PRIME = prove + (`!n p. prime p /\ 0 < n /\ n < p ==> p divides binom(p,n)`, + REPEAT STRIP_TAC THEN + MP_TAC(AP_TERM `(divides) p` (SPECL [`p - n:num`; `n:num`] BINOM_FACT)) THEN + ASM_SIMP_TAC[DIVIDES_FACT_PRIME; PRIME_DIVPROD_EQ; SUB_ADD; LT_IMP_LE] THEN + ASM_REWRITE_TAC[GSYM NOT_LT; LT_REFL] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < n /\ n < p ==> p - n < p`]);; + +let INT_PRIME = prove + (`!p. int_prime(&p) <=> prime p`, + GEN_TAC THEN REWRITE_TAC[prime; int_prime] THEN + ONCE_REWRITE_TAC[GSYM INT_DIVIDES_LABS] THEN + REWRITE_TAC[GSYM INT_FORALL_ABS; GSYM num_divides; INT_ABS_NUM] THEN + REWRITE_TAC[INT_OF_NUM_GT; INT_OF_NUM_EQ] THEN ASM_CASES_TAC `p = 0` THENL + [ASM_REWRITE_TAC[ARITH; DIVIDES_0] THEN DISCH_THEN(MP_TAC o SPEC `2`); + AP_THM_TAC THEN AP_TERM_TAC] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Explicit formula for difference of real/integer polynomials. *) +(* ------------------------------------------------------------------------- *) + +let REAL_POLY_DIFF_EXPLICIT = prove + (`!n a x y. + sum(0..n) (\i. a(i) * x pow i) - sum(0..n) (\i. a(i) * y pow i) = + (x - y) * + sum(0..n-1) (\i. sum(i+1..n) (\j. a j * y pow (j - 1 - i)) * x pow i)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM SUM_SUB_NUMSEG; GSYM REAL_SUB_LDISTRIB] THEN + MP_TAC(ISPEC `n:num` LE_0) THEN SIMP_TAC[SUM_CLAUSES_LEFT; ADD_CLAUSES] THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_LID; real_pow] THEN + SIMP_TAC[REAL_SUB_POW] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = b * a * c`] THEN + REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL; SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC `\(a:num,b:num). (b,a)`) THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; FORALL_PAIR_THM; REAL_MUL_AC] THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; + +let INT_POLY_DIFF_EXPLICIT = INT_OF_REAL_THM REAL_POLY_DIFF_EXPLICIT;; + +(* ------------------------------------------------------------------------- *) +(* Lagrange's theorem on number of roots modulo a prime. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_INTSEG_RESTRICT = prove + (`!P a b. FINITE {x:int | a <= x /\ x <= b /\ P x}`, + SIMP_TAC[FINITE_RESTRICT; FINITE_INTSEG; SET_RULE + `{x | P x /\ Q x /\ R x} = {x | x IN {x | P x /\ Q x} /\ R x}`]);; + +let INT_POLY_LAGRANGE = prove + (`!p l r. + int_prime p /\ r - l < p + ==> !n a. ~(!i. i <= n ==> (a i == &0) (mod p)) + ==> CARD {x | l <= x /\ x <= r /\ + (isum(0..n) (\i. a(i) * x pow i) == &0) (mod p)} + <= n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[INT_CONG_0_DIVIDES] THEN + MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] + `!a. (~(s = a) ==> CARD s <= n) /\ CARD a <= n ==> CARD s <= n`) THEN + EXISTS_TAC `{}:int->bool` THEN REWRITE_TAC[LE_0; CARD_CLAUSES] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + X_GEN_TAC `c:int` THEN STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [MAP_EVERY UNDISCH_TAC + [`~(!i:num. i <= n ==> (p:int) divides (a i))`; + `p divides (isum (0..n) (\i. a i * c pow i))`] THEN + ASM_SIMP_TAC[CONJUNCT1 LE; ISUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[INT_POW; LEFT_FORALL_IMP_THM; EXISTS_REFL; INT_MUL_RID] THEN + CONV_TAC TAUT; + ALL_TAC] THEN + ASM_CASES_TAC `p divides ((a:num->int) n)` THENL + [ASM_SIMP_TAC[ISUM_CLAUSES_RIGHT; LE_0; LE_1] THEN + ASM_SIMP_TAC[INTEGER_RULE + `(p:int) divides y ==> (p divides (x + y * z) <=> p divides x)`] THEN + MATCH_MP_TAC(ARITH_RULE `x <= n - 1 ==> x <= n`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ASM_REWRITE_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[ARITH_RULE `i <= n <=> i <= n - 1 \/ i = n`]; ALL_TAC] THEN + MP_TAC(GEN `x:int` (MATCH_MP + (INTEGER_RULE + `a - b:int = c ==> p divides b ==> (p divides a <=> p divides c)`) + (ISPECL [`n:num`; `a:num->int`; `x:int`; `c:int`] + INT_POLY_DIFF_EXPLICIT))) THEN + ASM_SIMP_TAC[INT_PRIME_DIVPROD_EQ] THEN DISCH_THEN(K ALL_TAC) THEN + ASM_REWRITE_TAC[LEFT_OR_DISTRIB; SET_RULE + `{x | q x \/ r x} = {x | q x} UNION {x | r x}`] THEN + SUBGOAL_THEN + `{x:int | l <= x /\ x <= r /\ p divides (x - c)} = {c}` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE `P c /\ (!x y. P x /\ P y ==> x = y) + ==> {x | P x} = {c}`) THEN + ASM_REWRITE_TAC[INT_SUB_REFL; INT_DIVIDES_0] THEN + MAP_EVERY X_GEN_TAC [`u:int`; `v:int`] THEN STRIP_TAC THEN + SUBGOAL_THEN `p divides (u - v:int)` MP_TAC THENL + [ASM_MESON_TAC[INT_CONG; INT_CONG_SYM; INT_CONG_TRANS]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP INT_DIVIDES_LE) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INTSEG_RESTRICT] THEN + MATCH_MP_TAC(ARITH_RULE + `~(n = 0) /\ x <= n - 1 ==> (if p then x else SUC x) <= n`) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + DISCH_THEN(MP_TAC o SPEC `n - 1`) THEN + ASM_SIMP_TAC[LE_REFL; SUB_ADD; LE_1; ISUM_SING_NUMSEG; SUB_REFL] THEN + ASM_REWRITE_TAC[INT_POW; INT_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Laborious instantiation to (x^d == 1) (mod p) over natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let NUM_LAGRANGE_LEMMA = prove + (`!p d. prime p /\ 1 <= d + ==> CARD {x | x IN 1..p-1 /\ (x EXP d == 1) (mod p)} <= d`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`&p:int`; `&1:int`; `&(p-1):int`] INT_POLY_LAGRANGE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[INT_PRIME; INT_LT_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_LT] THEN + ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL + [`d:num`; `\i. if i = d then &1 else if i = 0 then -- &1 else &0:int`]) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `d:num`) THEN REWRITE_TAC[LE_REFL] THEN + REWRITE_TAC[INT_CONG_0_DIVIDES; GSYM num_divides; DIVIDES_ONE] THEN + ASM_MESON_TAC[PRIME_1]; + ALL_TAC] THEN + REWRITE_TAC[MESON[] + `(if p then x else y) * z:int = if p then x * z else y * z`] THEN + SIMP_TAC[ISUM_CASES; FINITE_NUMSEG; FINITE_RESTRICT] THEN + REWRITE_TAC[INT_POW; INT_MUL_LZERO; ISUM_0; INT_ADD_RID] THEN + MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> y <= d ==> x <= d`) THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN + ASM_SIMP_TAC[ARITH_RULE `(0 <= i /\ i <= d) /\ i = d <=> i = d`; + ARITH_RULE `1 <= d + ==> (((0 <= i /\ i <= d) /\ ~(i = d)) /\ i = 0 <=> + i = 0)`] THEN + REWRITE_TAC[SING_GSPEC; ISUM_SING] THEN + REWRITE_TAC[INT_ARITH `&1 * x + -- &1 * &1:int = x - &1`] THEN + REWRITE_TAC[INTEGER_RULE `(x - a:int == &0) (mod p) <=> + (x == a) (mod p)`] THEN + MATCH_MP_TAC CARD_SUBSET_IMAGE THEN EXISTS_TAC `num_of_int` THEN + REWRITE_TAC[FINITE_INTSEG_RESTRICT; SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN EXISTS_TAC `&n:int` THEN + ASM_REWRITE_TAC[NUM_OF_INT_OF_NUM; INT_OF_NUM_LE; INT_OF_NUM_POW] THEN + ASM_REWRITE_TAC[GSYM num_congruent]);; + +(* ------------------------------------------------------------------------- *) +(* Count of elements with a given order modulo a prime. *) +(* ------------------------------------------------------------------------- *) + +let COUNT_ORDERS_MODULO_PRIME = prove + (`!p d. prime p /\ d divides (p - 1) + ==> CARD {x | x IN 1..p-1 /\ order p x = d} = phi(d)`, + let lemma = prove + (`!s f g:A->num. + FINITE s /\ (!x. x IN s ==> f(x) <= g(x)) /\ nsum s f = nsum s g + ==> !x. x IN s ==> f x = g x`, + REWRITE_TAC[GSYM LE_ANTISYM] THEN MESON_TAC[NSUM_LE; NSUM_LT; NOT_LE]) in + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `(!x. p x ==> q x) <=> (!x. x IN {x | p x} ==> q x)`] THEN + MATCH_MP_TAC lemma THEN SUBGOAL_THEN `~(p - 1 = 0)` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REWRITE_RULE[ETA_AX] PHI_DIVISORSUM; FINITE_DIVISORS] THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[CARD_EQ_NSUM; FINITE_RESTRICT; FINITE_NUMSEG] THEN + W(MP_TAC o PART_MATCH (lhs o rand) NSUM_GROUP o lhs o snd) THEN + REWRITE_TAC[NSUM_CONST_NUMSEG; FINITE_NUMSEG; ADD_SUB; MULT_CLAUSES] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + X_GEN_TAC `x:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[GSYM PHI_PRIME] THEN + MATCH_MP_TAC ORDER_DIVIDES_PHI THEN ONCE_REWRITE_TAC[COPRIME_SYM] THEN + MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC] THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + ASM_CASES_TAC `{x | x IN 1..p-1 /\ order p x = d} = {}` THEN + ASM_REWRITE_TAC[CARD_CLAUSES; LE_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN REWRITE_TAC[PHI_ALT] THEN + MATCH_MP_TAC CARD_SUBSET_IMAGE THEN EXISTS_TAC `\m. (a EXP m) MOD p` THEN + REWRITE_TAC[PHI_FINITE_LEMMA] THEN + SUBGOAL_THEN `1 <= d` ASSUME_TAC THENL + [ASM_MESON_TAC[LE_1; DIVIDES_ZERO]; ALL_TAC] THEN + SUBGOAL_THEN `coprime(p,a)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN + MATCH_MP_TAC PRIME_COPRIME_LT THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `{x | x IN 1..p-1 /\ (x EXP d == 1) (mod p)} = + IMAGE (\m. (a EXP m) MOD p) {m | m < d}` + MP_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBSET_LE THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + ASM_SIMP_TAC[ARITH_RULE `~(p - 1 = 0) ==> (x <= p - 1 <=> x < p)`] THEN + ASM_SIMP_TAC[DIVISION; PRIME_IMP_NZ] THEN CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + ASM_SIMP_TAC[GSYM DIVIDES_MOD; PRIME_IMP_NZ] THEN + ASM_MESON_TAC[PRIME_DIVEXP; PRIME_COPRIME_EQ]; + ASM_SIMP_TAC[CONG; PRIME_IMP_NZ; MOD_EXP_MOD] THEN + REWRITE_TAC[EXP_EXP] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[GSYM EXP_EXP] THEN + SUBST1_TAC(SYM(SPEC `m:num` EXP_ONE)) THEN + ASM_SIMP_TAC[GSYM CONG; PRIME_IMP_NZ] THEN + MATCH_MP_TAC CONG_EXP THEN ASM_MESON_TAC[ORDER]]; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `d:num` THEN + ASM_SIMP_TAC[NUM_LAGRANGE_LEMMA] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CARD_NUMSEG_LT] THEN + MATCH_MP_TAC EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN + ASM_SIMP_TAC[GSYM CONG; PRIME_IMP_NZ; FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + ASM_SIMP_TAC[ORDER_DIVIDES_EXPDIFF] THEN REWRITE_TAC[CONG_IMP_EQ]]; + MATCH_MP_TAC(SET_RULE + `s' SUBSET s /\ (!x. x IN t /\ f x IN s' ==> x IN t') + ==> s = IMAGE f t ==> s' SUBSET IMAGE f t'`) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; IN_NUMSEG] THEN + CONJ_TAC THENL [MESON_TAC[ORDER]; ALL_TAC] THEN + X_GEN_TAC `m:num` THEN ABBREV_TAC `b = (a EXP m) MOD p` THEN STRIP_TAC THEN + REWRITE_TAC[coprime; divides] THEN X_GEN_TAC `e:num` THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `m':num` (ASSUME_TAC o SYM)) + (X_CHOOSE_THEN `d':num` (ASSUME_TAC o SYM))) THEN + MP_TAC(ISPECL [`p:num`; `b:num`] ORDER_WORKS) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `d':num`)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> (a /\ b ==> ~c) ==> d`) THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `1 <= d` THEN EXPAND_TAC "d" THEN + REWRITE_TAC[ARITH_RULE `1 <= d <=> ~(d = 0)`; MULT_EQ_0] THEN + SIMP_TAC[DE_MORGAN_THM; ARITH_RULE `0 < d <=> ~(d = 0)`]; + EXPAND_TAC "b" THEN ASM_SIMP_TAC[CONG; PRIME_IMP_NZ; MOD_EXP_MOD] THEN + EXPAND_TAC "m" THEN REWRITE_TAC[EXP_EXP] THEN + ONCE_REWRITE_TAC[ARITH_RULE `(e * m') * d':num = (e * d') * m'`] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM EXP_EXP] THEN + SUBST1_TAC(SYM(SPEC `m':num` EXP_ONE)) THEN + ASM_SIMP_TAC[GSYM CONG; PRIME_IMP_NZ] THEN + MATCH_MP_TAC CONG_EXP THEN ASM_MESON_TAC[ORDER]; + EXPAND_TAC "d" THEN + REWRITE_TAC[ARITH_RULE `~(d < e * d) <=> e * d <= 1 * d`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + REWRITE_TAC[ARITH_RULE `e <= 1 <=> e = 0 \/ e = 1`] THEN + STRIP_TAC THEN UNDISCH_TAC `e * d':num = d` THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, primitive roots modulo a prime. *) +(* ------------------------------------------------------------------------- *) + +let PRIMITIVE_ROOTS_MODULO_PRIME = prove + (`!p. prime p ==> CARD {x | x IN 1..p-1 /\ order p x = p - 1} = phi(p - 1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:num`; `p - 1`] COUNT_ORDERS_MODULO_PRIME) THEN + ASM_REWRITE_TAC[DIVIDES_REFL]);; + +let PRIMITIVE_ROOT_MODULO_PRIME = prove + (`!p. prime p ==> ?x. x IN 1..p-1 /\ order p x = p - 1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIMITIVE_ROOTS_MODULO_PRIME) THEN + ASM_CASES_TAC `{x | x IN 1..p-1 /\ order p x = p - 1} = {}` THENL + [ASM_REWRITE_TAC[CARD_CLAUSES]; ASM SET_TAC[]] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC(ARITH_RULE `1 <= p ==> ~(0 = p)`) THEN + MATCH_MP_TAC PHI_LOWERBOUND_1_STRONG THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Now primitive roots modulo odd prime powers. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_1_PLUS_POWER_STEP = prove + (`!p z k. prime p /\ coprime(z,p) /\ 3 <= p /\ 1 <= k + ==> ?w. coprime(w,p) /\ + (1 + z * p EXP k) EXP p = 1 + w * p EXP (k + 1)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[ARITH_RULE `1 + a * b = a * b + 1`] THEN + REWRITE_TAC[BINOMIAL_THEOREM; EXP_ONE; MULT_CLAUSES] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0; EXP; binom; MULT_CLAUSES; ADD_CLAUSES] THEN + SUBGOAL_THEN `1 <= p` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; BINOM_1; EXP_1; ARITH] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(p EXP (k + 2)) divides (nsum(2..p) (\i. binom(p,i) * (z * p EXP k) EXP i))` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN + EXISTS_TAC `z + p * d:num` THEN + ASM_REWRITE_TAC[NUMBER_RULE + `coprime(z + p * d:num,p) <=> coprime(z,p)`] THEN + REWRITE_TAC[EXP_ADD] THEN ARITH_TAC] THEN + MATCH_MP_TAC NSUM_CLOSED THEN + REWRITE_TAC[DIVIDES_0; DIVIDES_ADD; IN_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[MULT_EXP] THEN + ONCE_REWRITE_TAC[ARITH_RULE `a * b * c:num = b * c * a`] THEN + REWRITE_TAC[EXP_EXP] THEN + MATCH_MP_TAC DIVIDES_LMUL THEN ASM_CASES_TAC `j:num = p` THENL + [MATCH_MP_TAC DIVIDES_RMUL THEN + ASM_SIMP_TAC[DIVIDES_EXP_LE; ARITH_RULE `3 <= p ==> 2 <= p`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `k * 3` THEN CONJ_TAC THENL + [ASM_ARITH_TAC; ASM_REWRITE_TAC[LE_MULT_LCANCEL]]; + ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[EXP; ARITH_RULE `k + 2 = SUC(k + 1)`] THEN + MATCH_MP_TAC DIVIDES_MUL2 THEN CONJ_TAC THENL + [MATCH_MP_TAC DIVIDES_BINOM_PRIME THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC; + ASM_SIMP_TAC[DIVIDES_EXP_LE; ARITH_RULE `3 <= p ==> 2 <= p`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `k * 2` THEN CONJ_TAC THENL + [ASM_ARITH_TAC; ASM_REWRITE_TAC[LE_MULT_LCANCEL]]]]);; + +let COPRIME_1_PLUS_POWER = prove + (`!p z k. prime p /\ coprime(z,p) /\ 3 <= p + ==> ?w. coprime(w,p) /\ + (1 + z * p) EXP (p EXP k) = 1 + w * p EXP (k + 1)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; EXP_1; EXP] THENL [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[MULT_SYM] EXP_EXP)] THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN STRIP_ASSUME_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `w:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`p:num`; `w:num`; `k + 1`] COPRIME_1_PLUS_POWER_STEP) THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= k + 1`] THEN + REWRITE_TAC[EXP_ADD; EXP_1; MULT_AC]);; + +let PRIMITIVE_ROOT_MODULO_PRIMEPOWS = prove + (`!p. prime p /\ 3 <= p + ==> ?g. !j. 1 <= j ==> order(p EXP j) g = phi(p EXP j)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIMITIVE_ROOT_MODULO_PRIME) THEN + REWRITE_TAC[IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`p:num`; `g:num`] ORDER) THEN + ASM_SIMP_TAC[CONG_TO_1; EXP_EQ_0; LE_1] THEN + DISCH_THEN(X_CHOOSE_THEN `y:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?x. coprime(p,y + (p - 1) * g EXP (p - 2) * x)` CHOOSE_TAC THENL + [MP_TAC(ISPECL [`(&p - &1:int) * &g pow (p - 2)`; `&1 - &y:int`; `&p:int`] + INT_CONG_SOLVE_POS) THEN + ANTS_TAC THENL + [REWRITE_TAC[INT_COPRIME_LMUL; INT_COPRIME_LPOW] THEN + REWRITE_TAC[INTEGER_RULE `coprime(p - &1,p)`; GSYM num_coprime] THEN + ASM_SIMP_TAC[INT_OF_NUM_EQ; ARITH_RULE `3 <= p ==> ~(p = 0)`] THEN + DISJ1_TAC THEN MATCH_MP_TAC PRIME_COPRIME_LT THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + REWRITE_TAC[GSYM INT_EXISTS_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (INTEGER_RULE + `(x:int == &1 - y) (mod n) ==> coprime(n,y + x)`)) THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_POW; INT_OF_NUM_MUL; + INT_OF_NUM_ADD; GSYM num_coprime; + ARITH_RULE `3 <= p ==> 1 <= p`] THEN + REWRITE_TAC[MULT_ASSOC]]; + ALL_TAC] THEN + EXISTS_TAC `g + p * x:num` THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN + STRIP_ASSUME_TAC(ISPECL [`p EXP j`; `g + p * x:num`] ORDER_WORKS) THEN + MP_TAC(SPECL [`p:num`; `g + p * x:num`; `order (p EXP j) (g + p * x)`] + ORDER_DIVIDES) THEN + SUBGOAL_THEN `order p (g + p * x) = p - 1` SUBST1_TAC THENL + [ASM_MESON_TAC[ORDER_CONG; NUMBER_RULE `(g:num == g + p * x) (mod p)`]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL + [MATCH_MP_TAC(NUMBER_RULE + `!y. (a == 1) (mod y) /\ x divides y ==> (a == 1) (mod x)`) THEN + EXISTS_TAC `p EXP j` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[DIVIDES_REFL; DIVIDES_REXP; LE_1]; + REWRITE_TAC[divides; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:num` THEN + DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)] THEN + MP_TAC(ISPECL [`g + p * x:num`; `p EXP j`] ORDER_DIVIDES_PHI) THEN + ASM_SIMP_TAC[PHI_PRIMEPOW; LE_1; COPRIME_LEXP] THEN ANTS_TAC THENL + [REWRITE_TAC[NUMBER_RULE `coprime(p,g + p * x) <=> coprime(g,p)`] THEN + MATCH_MP_TAC PRIME_COPRIME_LT THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `p EXP j - p EXP (j - 1) = (p - 1) * p EXP (j - 1)` + SUBST1_TAC THENL + [UNDISCH_TAC `1 <= j` THEN SPEC_TAC(`j:num`,`j:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH; SUC_SUB1] THEN + REWRITE_TAC[EXP; RIGHT_SUB_DISTRIB] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE + `(a * x:num) divides (a * y) ==> ~(a = 0) ==> x divides y`)) THEN + ASM_SIMP_TAC[DIVIDES_PRIMEPOW; ARITH_RULE `3 <= p ==> ~(p - 1 = 0)`] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `?z. (g + p * x) EXP (p - 1) = 1 + z * p /\ coprime(z,p)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[BINOMIAL_THEOREM] THEN + ASM_SIMP_TAC[NSUM_CLAUSES_RIGHT; LE_0; ARITH_RULE + `3 <= p ==> 0 < p - 1`] THEN + REWRITE_TAC[BINOM_REFL; SUB_REFL; EXP; MULT_CLAUSES] THEN + EXISTS_TAC + `y + nsum(0..p-2) (\k. binom(p - 1,k) * g EXP k * + p EXP (p - 2 - k) * x EXP (p - 1 - k))` THEN + REWRITE_TAC[ARITH_RULE `n - 1 - 1 = n - 2`] THEN + SIMP_TAC[ARITH_RULE `s + 1 + y * p = 1 + (y + t) * p <=> s = p * t`] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM NSUM_LMUL] THEN MATCH_MP_TAC NSUM_EQ THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + SIMP_TAC[ARITH_RULE `p * b * g * pp * x:num = b * g * (p * pp) * x`] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[MULT_EXP] THEN + REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[NSUM_CLAUSES_RIGHT; LE_0; ARITH_RULE + `3 <= p ==> 0 < p - 2`] THEN + REWRITE_TAC[BINOM_REFL; SUB_REFL; EXP; MULT_CLAUSES] THEN + ASM_SIMP_TAC[EXP_1; ARITH_RULE `3 <= p ==> p - 1 - (p - 2) = 1`] THEN + SUBGOAL_THEN `binom(p - 1,p - 2) = p - 1` SUBST1_TAC THENL + [SUBGOAL_THEN `p - 1 = SUC(p - 2)` SUBST1_TAC THENL + [ASM_ARITH_TAC; REWRITE_TAC[BINOM_PENULT]]; + ALL_TAC] THEN + MATCH_MP_TAC(NUMBER_RULE + `coprime(p:num,y + x) /\ p divides z ==> coprime(y + z + x,p)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NSUM_CLOSED THEN + REWRITE_TAC[DIVIDES_0; DIVIDES_ADD; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REPLICATE_TAC 2 (MATCH_MP_TAC DIVIDES_LMUL) THEN + MATCH_MP_TAC DIVIDES_RMUL THEN MATCH_MP_TAC DIVIDES_REXP THEN + REWRITE_TAC[DIVIDES_REFL] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?w. (g + p * x) EXP ((p - 1) * p EXP k) = 1 + p EXP (k + 1) * w /\ + coprime(w,p)` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM EXP_EXP] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + GEN_REWRITE_TAC (BINDER_CONV o funpow 3 RAND_CONV) [MULT_SYM] THEN + MATCH_MP_TAC COPRIME_1_PLUS_POWER THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC + `((g + p * x) EXP ((p - 1) * p EXP k) == 1) (mod (p EXP j))` THEN + ASM_REWRITE_TAC[NUMBER_RULE `(1 + x == 1) (mod n) <=> n divides x`] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN DISCH_TAC THEN + MP_TAC(SPECL [`p:num`; `j:num`; `w:num`; `p EXP (k + 1)`] + COPRIME_EXP_DIVPROD) THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[DIVIDES_EXP_LE; ARITH_RULE `3 <= p ==> 2 <= p`] THEN + UNDISCH_TAC `k <= j - 1` THEN ARITH_TAC]);; + +let PRIMITIVE_ROOT_MODULO_PRIMEPOW = prove + (`!p k. prime p /\ 3 <= p /\ 1 <= k + ==> ?x. x IN 1..(p EXP k - 1) /\ order (p EXP k) x = phi(p EXP k)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `p:num` PRIMITIVE_ROOT_MODULO_PRIMEPOWS) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:num` THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + EXISTS_TAC `x MOD (p EXP k)` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`p EXP k`; `x:num`] DIVIDES_MOD) THEN + ASM_SIMP_TAC[EXP_EQ_0; ARITH_RULE `3 <= p ==> ~(p = 0)`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p EXP k`; `x:num`] ORDER) THEN + DISCH_THEN(MP_TAC o MATCH_MP (NUMBER_RULE + `(x == 1) (mod p) ==> p divides x ==> p divides 1`)) THEN + ASM_SIMP_TAC[EXP_EQ_1; DIVIDES_ONE; LE_1] THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= p ==> ~(p = 1)`] THEN + MATCH_MP_TAC DIVIDES_REXP THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE `1 <= p ==> ~(p = 0)`) THEN + MATCH_MP_TAC PHI_LOWERBOUND_1_STRONG THEN + MATCH_MP_TAC(ARITH_RULE `~(p = 0) ==> 1 <= p`) THEN + ASM_SIMP_TAC[EXP_EQ_0] THEN ASM_ARITH_TAC; + MATCH_MP_TAC(ARITH_RULE `a < b ==> a <= b - 1`) THEN + MP_TAC(ISPECL [`x:num`; `p EXP k`] DIVISION) THEN + ASM_SIMP_TAC[EXP_EQ_0; ARITH_RULE `3 <= p ==> ~(p = 0)`]]; + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `order (p EXP k) x` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC ORDER_CONG THEN MATCH_MP_TAC CONG_MOD THEN + ASM_SIMP_TAC[EXP_EQ_0; ARITH_RULE `3 <= p ==> ~(p = 0)`]]);; + +(* ------------------------------------------------------------------------- *) +(* Double prime powers and the other remaining positive cases 2 and 4. *) +(* ------------------------------------------------------------------------- *) + +let PRIMITIVE_ROOT_MODULO_2 = prove + (`?x. x IN 1..1 /\ order 2 x = phi(2)`, + EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; ARITH] THEN + SIMP_TAC[PHI_PRIME; PRIME_2] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC ORDER_UNIQUE THEN + REWRITE_TAC[ARITH_RULE `~(0 < m /\ m < 1)`] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV CONG_CONV) THEN + REWRITE_TAC[]);; + +let PRIMITIVE_ROOT_MODULO_4 = prove + (`?x. x IN 1..3 /\ order 4 x = phi(4)`, + EXISTS_TAC `3` THEN REWRITE_TAC[IN_NUMSEG; ARITH] THEN + SUBST1_TAC(ARITH_RULE `4 = 2 EXP 2`) THEN + SIMP_TAC[PHI_PRIMEPOW; PRIME_2] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC ORDER_UNIQUE THEN + REWRITE_TAC[FORALL_UNWIND_THM2; ARITH_RULE `0 < m /\ m < 2 <=> m = 1`] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(ONCE_DEPTH_CONV CONG_CONV) THEN + REWRITE_TAC[]);; + +let PRIMITIVE_ROOT_DOUBLE_LEMMA = prove + (`!n a. ODD n /\ ODD a /\ order n a = phi n + ==> order (2 * n) a = phi(2 * n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ORDER_UNIQUE THEN + ASM_SIMP_TAC[CONG_CHINESE_EQ; COPRIME_2; PHI_MULTIPLICATIVE] THEN + REWRITE_TAC[PHI_2; MULT_CLAUSES] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[ODD; LE_1; PHI_LOWERBOUND_1_STRONG]; + ASM_REWRITE_TAC[GSYM ODD_MOD_2; ODD_EXP]; + ASM_MESON_TAC[ORDER_WORKS]; + ASM_MESON_TAC[ORDER_WORKS]]);; + +let PRIMITIVE_ROOT_MODULO_DOUBLE_PRIMEPOW = prove + (`!p k. prime p /\ 3 <= p /\ 1 <= k + ==> ?x. x IN 1..(2 * p EXP k - 1) /\ + order (2 * p EXP k) x = phi(2 * p EXP k)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `p:num` PRIME_ODD) THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= p ==> ~(p = 2)`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIMITIVE_ROOT_MODULO_PRIMEPOW) THEN + DISCH_THEN(X_CHOOSE_THEN `g:num` MP_TAC) THEN REWRITE_TAC[IN_NUMSEG] THEN + STRIP_TAC THEN DISJ_CASES_TAC (SPEC `g:num` EVEN_OR_ODD) THENL + [EXISTS_TAC `g + p EXP k` THEN CONJ_TAC THENL + [CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE + `g <= x - 1 /\ p EXP 1 <= x ==> g + p <= 2 * x - 1`) THEN + ASM_REWRITE_TAC[LE_EXP] THEN ASM_ARITH_TAC; + ALL_TAC]; + EXISTS_TAC `g:num` THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN + MATCH_MP_TAC PRIMITIVE_ROOT_DOUBLE_LEMMA THEN + ASM_REWRITE_TAC[ODD_ADD; ODD_EXP; NOT_ODD] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC ORDER_CONG THEN + CONV_TAC NUMBER_RULE);; + +(* ------------------------------------------------------------------------- *) +(* A couple of degenerate case not usually considered. *) +(* ------------------------------------------------------------------------- *) + +let PRIMITIVE_ROOT_MODULO_0 = prove + (`(?x. order 0 x = phi(0))`, + EXISTS_TAC `2` THEN REWRITE_TAC[PHI_0; ORDER_EQ_0; COPRIME_2; ODD]);; + +let PRIMITIVE_ROOT_MODULO_1 = prove + (`?x. order 1 x = phi(1)`, + EXISTS_TAC `1` THEN REWRITE_TAC[PHI_1] THEN MATCH_MP_TAC ORDER_UNIQUE THEN + REWRITE_TAC[ARITH_RULE `0 < m /\ m < 1 <=> F`; EXP_1; CONG_REFL] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The negative results. *) +(* ------------------------------------------------------------------------- *) + +let CONG_TO_1_POW2 = prove + (`!k x. ODD x /\ 1 <= k ==> (x EXP (2 EXP k) == 1) (mod (2 EXP (k + 2)))`, + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; EXP] THEN + CONV_TAC NUM_REDUCE_CONV THEN GEN_TAC THEN ASM_CASES_TAC `k = 0` THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + SIMP_TAC[ODD_EXISTS; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CONG_TO_1] THEN DISJ2_TAC THEN + REWRITE_TAC[GSYM EVEN_EXISTS; ARITH_RULE + `SUC(2 * m) EXP 2 = 1 + q * 8 <=> m * (m + 1) = 2 * q`] THEN + REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH] THEN CONV_TAC TAUT; + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:num`) THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[MULT_SYM] EXP_MULT; LE_1] THEN + REWRITE_TAC[CONG_TO_1; EXP_EQ_1; ADD_EQ_0; MULT_EQ_1] THEN + CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0; ARITH; GSYM EVEN_EXISTS; ARITH_RULE + `(1 + m * n) EXP 2 = 1 + q * 2 * n <=> + n * m * (2 + m * n) = n * 2 * q`] THEN + REWRITE_TAC[EVEN_MULT; EVEN_ADD; EVEN_EXP; ARITH] THEN ARITH_TAC]);; + +let NO_PRIMITIVE_ROOT_MODULO_POW2 = prove + (`!k. 3 <= k ==> ~(?x. order (2 EXP k) x = phi(2 EXP k))`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPEC `x:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `a = b ==> 1 <= b /\ a = 0 ==> F`)) THEN + ASM_SIMP_TAC[ORDER_EQ_0; PHI_LOWERBOUND_1_STRONG; LE_1; EXP_EQ_0; ARITH; + COPRIME_LEXP; COPRIME_2; DE_MORGAN_THM; NOT_ODD] THEN + ASM_ARITH_TAC; + MP_TAC(CONJUNCT2(ISPECL [`2 EXP k`; `x:num`] ORDER_WORKS)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `2 EXP (k - 2)`) THEN + ASM_SIMP_TAC[PHI_PRIMEPOW; PRIME_2; ARITH_RULE `3 <= k ==> ~(k = 0)`] THEN + ABBREV_TAC `j = k - 2` THEN + SUBGOAL_THEN `k - 1 = j + 1` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `k = j + 2` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `1 <= j` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[CONG_TO_1_POW2; ARITH_RULE `0 < x <=> ~(x = 0)`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH] THEN + MATCH_MP_TAC(ARITH_RULE `a + b:num < c ==> a < c - b`) THEN + REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ARITH_RULE `x + x * 2 < x * 4 <=> ~(x = 0)`] THEN + REWRITE_TAC[EXP_EQ_0; ARITH]]);; + +let NO_PRIMITIVE_ROOT_MODULO_COMPOSITE = prove + (`!a b. 3 <= a /\ 3 <= b /\ coprime(a,b) + ==> ~(?x. order (a * b) x = phi(a * b))`, + SIMP_TAC[PHI_MULTIPLICATIVE] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a * b:num`; `x:num`] ORDER_WORKS) THEN + ASM_SIMP_TAC[CONG_CHINESE_EQ] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(phi a * phi b) DIV 2`) THEN + REWRITE_TAC[ARITH_RULE `0 < a DIV 2 /\ a DIV 2 < a <=> 2 <= a`; NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `2 * 2 <= x ==> 2 <= x`) THEN + MATCH_MP_TAC LE_MULT2 THEN ASM_SIMP_TAC[PHI_LOWERBOUND_2]; + SUBGOAL_THEN `EVEN(phi b)` MP_TAC THENL + [ASM_SIMP_TAC[EVEN_PHI]; SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM]] THEN + REWRITE_TAC[ARITH_RULE `(a * 2 * b) DIV 2 = a * b`]; + SUBGOAL_THEN `EVEN(phi a)` MP_TAC THENL + [ASM_SIMP_TAC[EVEN_PHI]; SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM]] THEN + REWRITE_TAC[ARITH_RULE `((2 * a) * b) DIV 2 = b * a`]] THEN + X_GEN_TAC `m:num` THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[GSYM EXP_EXP] THEN SUBST1_TAC(SYM(SPEC `m:num` EXP_ONE)) THEN + MATCH_MP_TAC CONG_EXP THEN MATCH_MP_TAC FERMAT_LITTLE THEN + MP_TAC(ISPECL [`a * b:num`; `x:num`] ORDER_EQ_0) THEN + ASM_SIMP_TAC[MULT_EQ_0; LE_1; PHI_LOWERBOUND_1_STRONG; + ARITH_RULE `3 <= p ==> 1 <= p`] THEN + CONV_TAC NUMBER_RULE);; + +(* ------------------------------------------------------------------------- *) +(* Equivalences, one with some degenerate cases, one more conventional. *) +(* ------------------------------------------------------------------------- *) + +let PRIMITIVE_ROOT_EXISTS = prove + (`!n. (?x. order n x = phi n) <=> + n = 0 \/ n = 2 \/ n = 4 \/ + ?p k. prime p /\ 3 <= p /\ (n = p EXP k \/ n = 2 * p EXP k)`, + GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[PRIMITIVE_ROOT_MODULO_0] THEN + ASM_CASES_TAC `n = 2` THENL + [ASM_MESON_TAC[PRIMITIVE_ROOT_MODULO_2]; ALL_TAC] THEN + ASM_CASES_TAC `n = 4` THENL + [ASM_MESON_TAC[PRIMITIVE_ROOT_MODULO_4]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[PRIMITIVE_ROOT_MODULO_1] THEN + MAP_EVERY EXISTS_TAC [`3`; `0`] THEN + CONV_TAC(ONCE_DEPTH_CONV PRIME_CONV) THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + EQ_TAC THENL + [ALL_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `k:num`] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[LE_1; PRIMITIVE_ROOT_MODULO_PRIMEPOW; + PRIMITIVE_ROOT_MODULO_DOUBLE_PRIMEPOW]] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + MP_TAC(ISPEC `n:num` PRIMEPOW_FACTOR) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`p:num`; `k:num`; `m:num`] THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + ASM_CASES_TAC `m = 1` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:num`; `k:num`]) THEN + ASM_SIMP_TAC[PRIME_GE_2; ARITH_RULE + `2 <= p ==> (~(3 <= p) <=> p = 2)`] THEN + DISCH_THEN SUBST_ALL_TAC THEN ASM_CASES_TAC `3 <= k` THENL + [ASM_MESON_TAC[NO_PRIMITIVE_ROOT_MODULO_POW2]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `~(3 <= k) ==> 1 <= k ==> k = 1 \/ k = 2`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `m = 2` THENL + [ASM_REWRITE_TAC[COPRIME_2] THEN + ASM_CASES_TAC `p = 2` THEN ASM_REWRITE_TAC[ARITH] THEN + STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_GE_2) THEN + SUBGOAL_THEN `3 <= p` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[MULT_SYM]; + ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `k = 1` THENL + [UNDISCH_THEN `k = 1` SUBST_ALL_TAC; + MP_TAC(SPECL [`p EXP k`; `m:num`] NO_PRIMITIVE_ROOT_MODULO_COMPOSITE) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[COPRIME_LEXP] THEN + CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `2 EXP 2 <= x ==> 3 <= x`) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `p EXP 2` THEN + ASM_REWRITE_TAC[EXP_MONO_LE; LE_EXP] THEN + ASM_SIMP_TAC[PRIME_GE_2; PRIME_IMP_NZ] THEN ASM_ARITH_TAC] THEN + ASM_CASES_TAC `p = 2` THENL + [UNDISCH_THEN `p = 2` SUBST_ALL_TAC; + MP_TAC(SPECL [`p EXP 1`; `m:num`] NO_PRIMITIVE_ROOT_MODULO_COMPOSITE) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[COPRIME_LEXP] THEN REWRITE_TAC[EXP_1] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ASM_ARITH_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[EXP_1]) THEN REWRITE_TAC[EXP_1] THEN + MP_TAC(ISPEC `m:num` PRIMEPOW_FACTOR) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`q:num`; `j:num`; `r:num`] THEN + ASM_CASES_TAC `r = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + STRIP_TAC THEN UNDISCH_TAC `coprime(2,m)` THEN + ASM_SIMP_TAC[COPRIME_RMUL; COPRIME_REXP; LE_1] THEN + REWRITE_TAC[COPRIME_2] THEN STRIP_TAC THEN + SUBGOAL_THEN `3 <= q` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `~(p = 2) /\ 2 <= p ==> 3 <= p`) THEN + ASM_SIMP_TAC[PRIME_GE_2] THEN DISCH_TAC THEN + UNDISCH_TAC `ODD q` THEN ASM_REWRITE_TAC[ARITH]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `j:num`]) THEN + ASM_CASES_TAC `r = 1` THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN STRIP_TAC THEN + MP_TAC(SPECL [`2 * r`; `q EXP j`] NO_PRIMITIVE_ROOT_MODULO_COMPOSITE) THEN + REWRITE_TAC[COPRIME_LMUL; COPRIME_REXP] THEN ASM_REWRITE_TAC[COPRIME_2] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MULT_AC; NOT_EXISTS_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `3 <= r * 2 <=> ~(r = 0 \/ r = 1)`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `q EXP 1` THEN + ASM_REWRITE_TAC[LE_EXP; ARITH; COND_ID] THEN ASM_REWRITE_TAC[EXP_1]);; + +let PRIMITIVE_ROOT_EXISTS_NONTRIVIAL = prove + (`!n. (?x. x IN 1..n-1 /\ order n x = phi n) <=> + n = 2 \/ n = 4 \/ + ?p k. prime p /\ 3 <= p /\ 1 <= k /\ (n = p EXP k \/ n = 2 * p EXP k)`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[IN_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a <=> b)`) THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + REWRITE_TAC[MULT_EQ_0; EXP_EQ_0] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[IN_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a <=> b)`) THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + REWRITE_TAC[MULT_EQ_1; EXP_EQ_1] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `?x. order n x = phi n` THEN CONJ_TAC THENL + [EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN EXISTS_TAC `x MOD n` THEN + ASM_SIMP_TAC[IN_NUMSEG; DIVISION; ARITH_RULE + `~(n = 0) /\ ~(n = 1) ==> (x <= n - 1 <=> x < n)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + ASM_SIMP_TAC[GSYM DIVIDES_MOD] THEN DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `x:num`] ORDER_EQ_0) THEN + ASM_SIMP_TAC[LE_1; PHI_LOWERBOUND_1_STRONG] THEN + REWRITE_TAC[coprime] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[DIVIDES_REFL]; + FIRST_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC ORDER_CONG THEN + ASM_SIMP_TAC[CONG_MOD]]; + ASM_REWRITE_TAC[PRIMITIVE_ROOT_EXISTS] THEN + ASM_CASES_TAC `n = 2` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 4` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `p:num` THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + CONV_TAC(BINOP_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN + ASM_CASES_TAC `k = 0` THEN ASM_SIMP_TAC[LE_1] THEN + AP_TERM_TAC THEN ASM_ARITH_TAC]);; diff --git a/Library/products.ml b/Library/products.ml new file mode 100644 index 0000000..71682e2 --- /dev/null +++ b/Library/products.ml @@ -0,0 +1,446 @@ +(* ========================================================================= *) +(* Products of natural numbers and real numbers. *) +(* ========================================================================= *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* Products over natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let nproduct = new_definition + `nproduct = iterate(( * ):num->num->num)`;; + +let NPRODUCT_CLAUSES = prove + (`(!f. nproduct {} f = 1) /\ + (!x f s. FINITE(s) + ==> (nproduct (x INSERT s) f = + if x IN s then nproduct s f else f(x) * nproduct s f))`, + REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_MUL]);; + +let NPRODUCT_SUPPORT = prove + (`!f s. nproduct (support ( * ) f s) f = nproduct s f`, + REWRITE_TAC[nproduct; ITERATE_SUPPORT]);; + +let NPRODUCT_UNION = prove + (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t + ==> (nproduct (s UNION t) f = nproduct s f * nproduct t f)`, + SIMP_TAC[nproduct; ITERATE_UNION; MONOIDAL_MUL]);; + +let NPRODUCT_IMAGE = prove + (`!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> (nproduct (IMAGE f s) g = nproduct s (g o f))`, + REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN + MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_MUL]);; + +let NPRODUCT_ADD_SPLIT = prove + (`!f m n p. + m <= n + 1 + ==> (nproduct (m..(n+p)) f = nproduct(m..n) f * nproduct(n+1..n+p) f)`, + SIMP_TAC[NUMSEG_ADD_SPLIT; NPRODUCT_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; + ARITH_RULE `x < x + 1`]);; + +let NPRODUCT_POS_LT = prove + (`!f s. FINITE s /\ (!x. x IN s ==> 0 < f x) ==> 0 < nproduct s f`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; ARITH; IN_INSERT; LT_MULT]);; + +let NPRODUCT_POS_LT_NUMSEG = prove + (`!f m n. (!x. m <= x /\ x <= n ==> 0 < f x) ==> 0 < nproduct(m..n) f`, + SIMP_TAC[NPRODUCT_POS_LT; FINITE_NUMSEG; IN_NUMSEG]);; + +let NPRODUCT_OFFSET = prove + (`!f m p. nproduct(m+p..n+p) f = nproduct(m..n) (\i. f(i + p))`, + SIMP_TAC[NUMSEG_OFFSET_IMAGE; NPRODUCT_IMAGE; + EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[o_DEF]);; + +let NPRODUCT_SING = prove + (`!f x. nproduct {x} f = f(x)`, + SIMP_TAC[NPRODUCT_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; MULT_CLAUSES]);; + +let NPRODUCT_SING_NUMSEG = prove + (`!f n. nproduct(n..n) f = f(n)`, + REWRITE_TAC[NUMSEG_SING; NPRODUCT_SING]);; + +let NPRODUCT_CLAUSES_NUMSEG = prove + (`(!m. nproduct(m..0) f = if m = 0 then f(0) else 1) /\ + (!m n. nproduct(m..SUC n) f = if m <= SUC n then nproduct(m..n) f * f(SUC n) + else nproduct(m..n) f)`, + REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[NPRODUCT_SING; NPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; MULT_AC]);; + +let NPRODUCT_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> nproduct s f = nproduct s g`, + REWRITE_TAC[nproduct] THEN MATCH_MP_TAC ITERATE_EQ THEN + REWRITE_TAC[MONOIDAL_MUL]);; + +let NPRODUCT_EQ_NUMSEG = prove + (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) + ==> (nproduct(m..n) f = nproduct(m..n) g)`, + MESON_TAC[NPRODUCT_EQ; FINITE_NUMSEG; IN_NUMSEG]);; + +let NPRODUCT_EQ_0 = prove + (`!f s. FINITE s ==> (nproduct s f = 0 <=> ?x. x IN s /\ f(x) = 0)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; MULT_EQ_0; IN_INSERT; ARITH; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +let NPRODUCT_EQ_0_NUMSEG = prove + (`!f m n. nproduct(m..n) f = 0 <=> ?x. m <= x /\ x <= n /\ f(x) = 0`, + SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; GSYM CONJ_ASSOC]);; + +let NPRODUCT_LE = prove + (`!f s. FINITE s /\ (!x. x IN s ==> 0 <= f(x) /\ f(x) <= g(x)) + ==> nproduct s f <= nproduct s g`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[IN_INSERT; NPRODUCT_CLAUSES; NOT_IN_EMPTY; LE_REFL] THEN + MESON_TAC[LE_MULT2; LE_0]);; + +let NPRODUCT_LE_NUMSEG = prove + (`!f m n. (!i. m <= i /\ i <= n ==> 0 <= f(i) /\ f(i) <= g(i)) + ==> nproduct(m..n) f <= nproduct(m..n) g`, + SIMP_TAC[NPRODUCT_LE; FINITE_NUMSEG; IN_NUMSEG]);; + +let NPRODUCT_EQ_1 = prove + (`!f s. (!x:A. x IN s ==> (f(x) = 1)) ==> (nproduct s f = 1)`, + REWRITE_TAC[nproduct; GSYM NEUTRAL_MUL] THEN + SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_MUL]);; + +let NPRODUCT_EQ_1_NUMSEG = prove + (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = 1)) ==> (nproduct(m..n) f = 1)`, + SIMP_TAC[NPRODUCT_EQ_1; IN_NUMSEG]);; + +let NPRODUCT_MUL = prove + (`!f g s. FINITE s + ==> nproduct s (\x. f x * g x) = nproduct s f * nproduct s g`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; MULT_AC; MULT_CLAUSES]);; + +let NPRODUCT_MUL_NUMSEG = prove + (`!f g m n. + nproduct(m..n) (\x. f x * g x) = nproduct(m..n) f * nproduct(m..n) g`, + SIMP_TAC[NPRODUCT_MUL; FINITE_NUMSEG]);; + +let NPRODUCT_CONST = prove + (`!c s. FINITE s ==> nproduct s (\x. c) = c EXP (CARD s)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NPRODUCT_CLAUSES; CARD_CLAUSES; EXP]);; + +let NPRODUCT_CONST_NUMSEG = prove + (`!c m n. nproduct (m..n) (\x. c) = c EXP ((n + 1) - m)`, + SIMP_TAC[NPRODUCT_CONST; CARD_NUMSEG; FINITE_NUMSEG]);; + +let NPRODUCT_CONST_NUMSEG_1 = prove + (`!c n. nproduct(1..n) (\x. c) = c EXP n`, + SIMP_TAC[NPRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG]);; + +let NPRODUCT_ONE = prove + (`!s. nproduct s (\n. 1) = 1`, + SIMP_TAC[NPRODUCT_EQ_1]);; + +let NPRODUCT_CLOSED = prove + (`!P f:A->num s. + P(1) /\ (!x y. P x /\ P y ==> P(x * y)) /\ (!a. a IN s ==> P(f a)) + ==> P(nproduct s f)`, + REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_MUL) THEN + DISCH_THEN(MP_TAC o SPEC `P:num->bool`) THEN + ASM_SIMP_TAC[NEUTRAL_MUL; GSYM nproduct]);; + +let NPRODUCT_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> nproduct(m..n) f = f(m) * nproduct(m+1..n) f`, + SIMP_TAC[GSYM NUMSEG_LREC; NPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ARITH_TAC);; + +let NPRODUCT_CLAUSES_RIGHT = prove + (`!f m n. 0 < n /\ m <= n ==> nproduct(m..n) f = nproduct(m..n-1) f * f(n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LT_REFL; NPRODUCT_CLAUSES_NUMSEG; SUC_SUB1]);; + +let NPRODUCT_SUPERSET = prove + (`!f:A->num u v. + u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = 1) + ==> nproduct v f = nproduct u f`, + SIMP_TAC[nproduct; GSYM NEUTRAL_MUL; ITERATE_SUPERSET; MONOIDAL_MUL]);; + +let NPRODUCT_PAIR = prove + (`!f m n. nproduct(2*m..2*n+1) f = nproduct(m..n) (\i. f(2*i) * f(2*i+1))`, + MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_MUL) THEN + REWRITE_TAC[nproduct; NEUTRAL_MUL]);; + +let NPRODUCT_DELETE = prove + (`!f s a. FINITE s /\ a IN s + ==> f(a) * nproduct(s DELETE a) f = nproduct s f`, + SIMP_TAC[nproduct; ITERATE_DELETE; MONOIDAL_MUL]);; + +let NPRODUCT_FACT = prove + (`!n. nproduct(1..n) (\m. m) = FACT n`, + INDUCT_TAC THEN REWRITE_TAC[NPRODUCT_CLAUSES_NUMSEG; FACT; ARITH] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; MULT_SYM]);; + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> nproduct s (\i. f(i)) = nproduct s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> nproduct(a..b) (\i. f(i)) = nproduct(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> nproduct {y | p y} (\i. f(i)) = nproduct {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NPRODUCT_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; + +(* ------------------------------------------------------------------------- *) +(* Now products over real numbers. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let product = new_definition + `product = iterate (( * ):real->real->real)`;; + +let PRODUCT_CLAUSES = prove + (`(!f. product {} f = &1) /\ + (!x f s. FINITE(s) + ==> (product (x INSERT s) f = + if x IN s then product s f else f(x) * product s f))`, + REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; + +let PRODUCT_SUPPORT = prove + (`!f s. product (support ( * ) f s) f = product s f`, + REWRITE_TAC[product; ITERATE_SUPPORT]);; + +let PRODUCT_UNION = prove + (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t + ==> (product (s UNION t) f = product s f * product t f)`, + SIMP_TAC[product; ITERATE_UNION; MONOIDAL_REAL_MUL]);; + +let PRODUCT_IMAGE = prove + (`!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> (product (IMAGE f s) g = product s (g o f))`, + REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN + MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_REAL_MUL]);; + +let PRODUCT_ADD_SPLIT = prove + (`!f m n p. + m <= n + 1 + ==> (product (m..(n+p)) f = product(m..n) f * product(n+1..n+p) f)`, + SIMP_TAC[NUMSEG_ADD_SPLIT; PRODUCT_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; + ARITH_RULE `x < x + 1`]);; + +let PRODUCT_POS_LE = prove + (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f x) ==> &0 <= product s f`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_POS; IN_INSERT; REAL_LE_MUL]);; + +let PRODUCT_POS_LE_NUMSEG = prove + (`!f m n. (!x. m <= x /\ x <= n ==> &0 <= f x) ==> &0 <= product(m..n) f`, + SIMP_TAC[PRODUCT_POS_LE; FINITE_NUMSEG; IN_NUMSEG]);; + +let PRODUCT_POS_LT = prove + (`!f s. FINITE s /\ (!x. x IN s ==> &0 < f x) ==> &0 < product s f`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_LT_01; IN_INSERT; REAL_LT_MUL]);; + +let PRODUCT_POS_LT_NUMSEG = prove + (`!f m n. (!x. m <= x /\ x <= n ==> &0 < f x) ==> &0 < product(m..n) f`, + SIMP_TAC[PRODUCT_POS_LT; FINITE_NUMSEG; IN_NUMSEG]);; + +let PRODUCT_OFFSET = prove + (`!f m p. product(m+p..n+p) f = product(m..n) (\i. f(i + p))`, + SIMP_TAC[NUMSEG_OFFSET_IMAGE; PRODUCT_IMAGE; + EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[o_DEF]);; + +let PRODUCT_SING = prove + (`!f x. product {x} f = f(x)`, + SIMP_TAC[PRODUCT_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; REAL_MUL_RID]);; + +let PRODUCT_SING_NUMSEG = prove + (`!f n. product(n..n) f = f(n)`, + REWRITE_TAC[NUMSEG_SING; PRODUCT_SING]);; + +let PRODUCT_CLAUSES_NUMSEG = prove + (`(!m. product(m..0) f = if m = 0 then f(0) else &1) /\ + (!m n. product(m..SUC n) f = if m <= SUC n then product(m..n) f * f(SUC n) + else product(m..n) f)`, + REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[PRODUCT_SING; PRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; REAL_MUL_AC]);; + +let PRODUCT_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> product s f = product s g`, + REWRITE_TAC[product] THEN MATCH_MP_TAC ITERATE_EQ THEN + REWRITE_TAC[MONOIDAL_REAL_MUL]);; + +let PRODUCT_EQ_NUMSEG = prove + (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) + ==> (product(m..n) f = product(m..n) g)`, + MESON_TAC[PRODUCT_EQ; FINITE_NUMSEG; IN_NUMSEG]);; + +let PRODUCT_EQ_0 = prove + (`!f s. FINITE s ==> (product s f = &0 <=> ?x. x IN s /\ f(x) = &0)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_ENTIRE; IN_INSERT; REAL_OF_NUM_EQ; ARITH; + NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +let PRODUCT_EQ_0_NUMSEG = prove + (`!f m n. product(m..n) f = &0 <=> ?x. m <= x /\ x <= n /\ f(x) = &0`, + SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG; GSYM CONJ_ASSOC]);; + +let PRODUCT_LE = prove + (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f(x) /\ f(x) <= g(x)) + ==> product s f <= product s g`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[IN_INSERT; PRODUCT_CLAUSES; NOT_IN_EMPTY; REAL_LE_REFL] THEN + MESON_TAC[REAL_LE_MUL2; PRODUCT_POS_LE]);; + +let PRODUCT_LE_NUMSEG = prove + (`!f m n. (!i. m <= i /\ i <= n ==> &0 <= f(i) /\ f(i) <= g(i)) + ==> product(m..n) f <= product(m..n) g`, + SIMP_TAC[PRODUCT_LE; FINITE_NUMSEG; IN_NUMSEG]);; + +let PRODUCT_EQ_1 = prove + (`!f s. (!x:A. x IN s ==> (f(x) = &1)) ==> (product s f = &1)`, + REWRITE_TAC[product; GSYM NEUTRAL_REAL_MUL] THEN + SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_REAL_MUL]);; + +let PRODUCT_EQ_1_NUMSEG = prove + (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = &1)) ==> (product(m..n) f = &1)`, + SIMP_TAC[PRODUCT_EQ_1; IN_NUMSEG]);; + +let PRODUCT_MUL = prove + (`!f g s. FINITE s ==> product s (\x. f x * g x) = product s f * product s g`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_MUL_AC; REAL_MUL_LID]);; + +let PRODUCT_MUL_NUMSEG = prove + (`!f g m n. + product(m..n) (\x. f x * g x) = product(m..n) f * product(m..n) g`, + SIMP_TAC[PRODUCT_MUL; FINITE_NUMSEG]);; + +let PRODUCT_CONST = prove + (`!c s. FINITE s ==> product s (\x. c) = c pow (CARD s)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; CARD_CLAUSES; real_pow]);; + +let PRODUCT_CONST_NUMSEG = prove + (`!c m n. product (m..n) (\x. c) = c pow ((n + 1) - m)`, + SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG; FINITE_NUMSEG]);; + +let PRODUCT_CONST_NUMSEG_1 = prove + (`!c n. product(1..n) (\x. c) = c pow n`, + SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG]);; + +let PRODUCT_NEG = prove + (`!f s:A->bool. + FINITE s ==> product s (\i. --(f i)) = --(&1) pow (CARD s) * product s f`, + SIMP_TAC[GSYM PRODUCT_CONST; GSYM PRODUCT_MUL] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]);; + +let PRODUCT_NEG_NUMSEG = prove + (`!f m n. product(m..n) (\i. --(f i)) = + --(&1) pow ((n + 1) - m) * product(m..n) f`, + SIMP_TAC[PRODUCT_NEG; CARD_NUMSEG; FINITE_NUMSEG]);; + +let PRODUCT_NEG_NUMSEG_1 = prove + (`!f n. product(1..n) (\i. --(f i)) = --(&1) pow n * product(1..n) f`, + REWRITE_TAC[PRODUCT_NEG_NUMSEG; ADD_SUB]);; + +let PRODUCT_INV = prove + (`!f s. FINITE s ==> product s (\x. inv(f x)) = inv(product s f)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_INV_1; REAL_INV_MUL]);; + +let PRODUCT_DIV = prove + (`!f g s. FINITE s ==> product s (\x. f x / g x) = product s f / product s g`, + SIMP_TAC[real_div; PRODUCT_MUL; PRODUCT_INV]);; + +let PRODUCT_DIV_NUMSEG = prove + (`!f g m n. + product(m..n) (\x. f x / g x) = product(m..n) f / product(m..n) g`, + SIMP_TAC[PRODUCT_DIV; FINITE_NUMSEG]);; + +let PRODUCT_ONE = prove + (`!s. product s (\n. &1) = &1`, + SIMP_TAC[PRODUCT_EQ_1]);; + +let PRODUCT_LE_1 = prove + (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f x /\ f x <= &1) + ==> product s f <= &1`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_LE_REFL; IN_INSERT] THEN + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[PRODUCT_POS_LE]);; + +let PRODUCT_ABS = prove + (`!f s. FINITE s ==> product s (\x. abs(f x)) = abs(product s f)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_ABS_MUL; REAL_ABS_NUM]);; + +let PRODUCT_CLOSED = prove + (`!P f:A->real s. + P(&1) /\ (!x y. P x /\ P y ==> P(x * y)) /\ (!a. a IN s ==> P(f a)) + ==> P(product s f)`, + REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_REAL_MUL) THEN + DISCH_THEN(MP_TAC o SPEC `P:real->bool`) THEN + ASM_SIMP_TAC[NEUTRAL_REAL_MUL; GSYM product]);; + +let PRODUCT_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> product(m..n) f = f(m) * product(m+1..n) f`, + SIMP_TAC[GSYM NUMSEG_LREC; PRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ARITH_TAC);; + +let PRODUCT_CLAUSES_RIGHT = prove + (`!f m n. 0 < n /\ m <= n ==> product(m..n) f = product(m..n-1) f * f(n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LT_REFL; PRODUCT_CLAUSES_NUMSEG; SUC_SUB1]);; + +let REAL_OF_NUM_NPRODUCT = prove + (`!f:A->num s. FINITE s ==> &(nproduct s f) = product s (\x. &(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; NPRODUCT_CLAUSES; GSYM REAL_OF_NUM_MUL]);; + +let PRODUCT_SUPERSET = prove + (`!f:A->real u v. + u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> f(x) = &1) + ==> product v f = product u f`, + SIMP_TAC[product; GSYM NEUTRAL_REAL_MUL; + ITERATE_SUPERSET; MONOIDAL_REAL_MUL]);; + +let PRODUCT_PAIR = prove + (`!f m n. product(2*m..2*n+1) f = product(m..n) (\i. f(2*i) * f(2*i+1))`, + MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_REAL_MUL) THEN + REWRITE_TAC[product; NEUTRAL_REAL_MUL]);; + +let PRODUCT_DELETE = prove + (`!f s a. FINITE s /\ a IN s ==> f(a) * product(s DELETE a) f = product s f`, + SIMP_TAC[product; ITERATE_DELETE; MONOIDAL_REAL_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Extend congruences. *) +(* ------------------------------------------------------------------------- *) + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> product s (\i. f(i)) = product s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> product(a..b) (\i. f(i)) = product(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> product {y | p y} (\i. f(i)) = product {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; diff --git a/Library/rstc.ml b/Library/rstc.ml new file mode 100644 index 0000000..06947ad --- /dev/null +++ b/Library/rstc.ml @@ -0,0 +1,700 @@ +(* ========================================================================= *) +(* All you wanted to know about reflexive symmetric and transitive closures. *) +(* ========================================================================= *) + +prioritize_num();; + +let RULE_INDUCT_TAC = + MATCH_MP_TAC o DISCH_ALL o SPEC_ALL o UNDISCH o SPEC_ALL;; + +(* ------------------------------------------------------------------------- *) +(* Little lemmas about equivalent forms of symmetry and transitivity. *) +(* ------------------------------------------------------------------------- *) + +let SYM_ALT = prove + (`!R:A->A->bool. (!x y. R x y ==> R y x) <=> (!x y. R x y <=> R y x)`, + GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [EQ_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC; + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [th])] THEN + FIRST_ASSUM MATCH_ACCEPT_TAC);; + +let TRANS_ALT = prove + (`!(R:A->A->bool) (S:A->A->bool) U. + (!x z. (?y. R x y /\ S y z) ==> U x z) <=> + (!x y z. R x y /\ S y z ==> U x z)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Reflexive closure *) +(* ------------------------------------------------------------------------- *) + +let RC_RULES,RC_INDUCT,RC_CASES = new_inductive_definition + `(!x y. R x y ==> RC R x y) /\ + (!x:A. RC R x x)`;; + +let RC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> RC R x y`, + REWRITE_TAC[RC_RULES]);; + +let RC_REFL = prove + (`!(R:A->A->bool) x. RC R x x`, + REWRITE_TAC[RC_RULES]);; + +let RC_EXPLICIT = prove + (`!(R:A->A->bool) x y. RC R x y <=> R x y \/ (x = y)`, + REWRITE_TAC[RC_CASES; EQ_SYM_EQ]);; + +let RC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. RC R x y ==> RC S x y)`, + MESON_TAC[RC_CASES]);; + +let RC_CLOSED = prove + (`!R:A->A->bool. (RC R = R) <=> !x. R x x`, + REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT] THEN MESON_TAC[]);; + +let RC_IDEMP = prove + (`!R:A->A->bool. RC(RC R) = RC R`, + REWRITE_TAC[RC_CLOSED; RC_REFL]);; + +let RC_SYM = prove + (`!R:A->A->bool. + (!x y. R x y ==> R y x) ==> (!x y. RC R x y ==> RC R y x)`, + MESON_TAC[RC_CASES]);; + +let RC_TRANS = prove + (`!R:A->A->bool. + (!x y z. R x y /\ R y z ==> R x z) ==> + (!x y z. RC R x y /\ RC R y z ==> RC R x z)`, + REWRITE_TAC[RC_CASES] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Symmetric closure *) +(* ------------------------------------------------------------------------- *) + +let SC_RULES,SC_INDUCT,SC_CASES = new_inductive_definition + `(!x y. R x y ==> SC R x y) /\ + (!x:A y. SC R x y ==> SC R y x)`;; + +let SC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> SC R x y`, + REWRITE_TAC[SC_RULES]);; + +let SC_SYM = prove + (`!(R:A->A->bool) x y. SC R x y ==> SC R y x`, + REWRITE_TAC[SC_RULES]);; + +let SC_EXPLICIT = prove + (`!R:A->A->bool. SC(R) x y <=> R x y \/ R y x`, + GEN_TAC THEN EQ_TAC THENL + [RULE_INDUCT_TAC SC_INDUCT THEN MESON_TAC[]; MESON_TAC[SC_CASES]]);; + +let SC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. SC R x y ==> SC S x y)`, + MESON_TAC[SC_EXPLICIT]);; + +let SC_CLOSED = prove + (`!R:A->A->bool. (SC R = R) <=> !x y. R x y ==> R y x`, + REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT] THEN MESON_TAC[]);; + +let SC_IDEMP = prove + (`!R:A->A->bool. SC(SC R) = SC R`, + REWRITE_TAC[SC_CLOSED; SC_SYM]);; + +let SC_REFL = prove + (`!R:A->A->bool. (!x. R x x) ==> (!x. SC R x x)`, + MESON_TAC[SC_EXPLICIT]);; + +(* ------------------------------------------------------------------------- *) +(* Transitive closure *) +(* ------------------------------------------------------------------------- *) + +let TC_RULES,TC_INDUCT,TC_CASES = new_inductive_definition + `(!x y. R x y ==> TC R x y) /\ + (!(x:A) y z. TC R x y /\ TC R y z ==> TC R x z)`;; + +let TC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> TC R x y`, + REWRITE_TAC[TC_RULES]);; + +let TC_TRANS = prove + (`!(R:A->A->bool) x y z. TC R x y /\ TC R y z ==> TC R x z`, + REWRITE_TAC[TC_RULES]);; + +let TC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. TC R x y ==> TC S x y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[TC_RULES]);; + +let TC_CLOSED = prove + (`!R:A->A->bool. (TC R = R) <=> !x y z. R x y /\ R y z ==> R x z`, + GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN EQ_TAC THENL + [MESON_TAC[TC_RULES]; REPEAT STRIP_TAC] THEN + EQ_TAC THENL [RULE_INDUCT_TAC TC_INDUCT; ALL_TAC] THEN + ASM_MESON_TAC[TC_RULES]);; + +let TC_IDEMP = prove + (`!R:A->A->bool. TC(TC R) = TC R`, + REWRITE_TAC[TC_CLOSED; TC_TRANS]);; + +let TC_REFL = prove + (`!R:A->A->bool. (!x. R x x) ==> (!x. TC R x x)`, + MESON_TAC[TC_INC]);; + +let TC_SYM = prove + (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. TC R x y ==> TC R y x)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC TC_INDUCT THEN + ASM_MESON_TAC[TC_RULES]);; + +(* ------------------------------------------------------------------------- *) +(* Commutativity properties of the three basic closure operations *) +(* ------------------------------------------------------------------------- *) + +let RC_SC = prove + (`!R:A->A->bool. RC(SC R) = SC(RC R)`, + REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);; + +let SC_RC = prove + (`!R:A->A->bool. SC(RC R) = RC(SC R)`, + REWRITE_TAC[RC_SC]);; + +let RC_TC = prove + (`!R:A->A->bool. RC(TC R) = TC(RC R)`, + REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL + [RULE_INDUCT_TAC RC_INDUCT THEN MESON_TAC[TC_RULES; RC_RULES; TC_MONO]; + RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[RC_TRANS; TC_RULES; RC_MONO]]);; + +let TC_RC = prove + (`!R:A->A->bool. TC(RC R) = RC(TC R)`, + REWRITE_TAC[RC_TC]);; + +let TC_SC = prove + (`!(R:A->A->bool) x y. SC(TC R) x y ==> TC(SC R) x y`, + GEN_TAC THEN MATCH_MP_TAC SC_INDUCT THEN + MESON_TAC[TC_MONO; TC_SYM; SC_RULES]);; + +let SC_TC = prove + (`!(R:A->A->bool) x y. SC(TC R) x y ==> TC(SC R) x y`, + REWRITE_TAC[TC_SC]);; + +(* ------------------------------------------------------------------------- *) +(* Left and right variants of TC. *) +(* ------------------------------------------------------------------------- *) + +let TC_TRANS_L = prove + (`!(R:A->A->bool) x y z. TC R x y /\ R y z ==> TC R x z`, + MESON_TAC[TC_RULES]);; + +let TC_TRANS_R = prove + (`!(R:A->A->bool) x y z. R x y /\ TC R y z ==> TC R x z`, + MESON_TAC[TC_RULES]);; + +let TC_CASES_L = prove + (`!(R:A->A->bool) x z. TC R x z <=> R x z \/ (?y. TC R x y /\ R y z)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[TC_RULES]; MESON_TAC[TC_RULES]]);; + +let TC_CASES_R = prove + (`!(R:A->A->bool) x z. TC R x z <=> R x z \/ (?y. R x y /\ TC R y z)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[TC_RULES]; MESON_TAC[TC_RULES]]);; + +let TC_INDUCT_L = prove + (`!(R:A->A->bool) P. + (!x y. R x y ==> P x y) /\ + (!x y z. P x y /\ R y z ==> P x z) ==> + (!x y. TC R x y ==> P x y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!y:A z. TC(R) y z ==> !x:A. P x y ==> P x z` MP_TAC THENL + [MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[]; ASM_MESON_TAC[TC_CASES_R]]);; + +let TC_INDUCT_R = prove + (`!(R:A->A->bool) P. + (!x y. R x y ==> P x y) /\ + (!x z. (?y. R x y /\ P y z) ==> P x z) ==> + (!x y. TC R x y ==> P x y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!x:A y. TC(R) x y ==> !z:A. P y z ==> P x z` MP_TAC THENL + [MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[]; ASM_MESON_TAC[TC_CASES_L]]);; + +(* ------------------------------------------------------------------------- *) +(* Reflexive symmetric closure *) +(* ------------------------------------------------------------------------- *) + +let RSC = new_definition + `RSC(R:A->A->bool) = RC(SC R)`;; + +let RSC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> RSC R x y`, + REWRITE_TAC[RSC] THEN MESON_TAC[RC_INC; SC_INC]);; + +let RSC_REFL = prove + (`!(R:A->A->bool) x. RSC R x x`, + REWRITE_TAC[RSC; RC_REFL]);; + +let RSC_SYM = prove + (`!(R:A->A->bool) x y. RSC R x y ==> RSC R y x`, + REWRITE_TAC[RSC; RC_SC; SC_SYM]);; + +let RSC_CASES = prove + (`!(R:A->A->bool) x y. RSC R x y <=> (x = y) \/ R x y \/ R y x`, + REWRITE_TAC[RSC; RC_EXPLICIT; SC_EXPLICIT; DISJ_ACI]);; + +let RSC_INDUCT = prove + (`!(R:A->A->bool) P. + (!x y. R x y ==> P x y) /\ + (!x. P x x) /\ + (!x y. P x y ==> P y x) + ==> !x y. RSC R x y ==> P x y`, + REWRITE_TAC[RSC; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);; + +let RSC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. RSC R x y ==> RSC S x y)`, + REWRITE_TAC[RSC] THEN MESON_TAC[SC_MONO; RC_MONO]);; + +let RSC_CLOSED = prove + (`!R:A->A->bool. (RSC R = R) <=> (!x. R x x) /\ (!x y. R x y ==> R y x)`, + REWRITE_TAC[FUN_EQ_THM; RSC; RC_EXPLICIT; SC_EXPLICIT] THEN MESON_TAC[]);; + +let RSC_IDEMP = prove + (`!R:A->A->bool. RSC(RSC R) = RSC R`, + REWRITE_TAC[RSC_CLOSED; RSC_REFL; RSC_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Reflexive transitive closure *) +(* ------------------------------------------------------------------------- *) + +let RTC = new_definition + `RTC(R:A->A->bool) = RC(TC R)`;; + +let RTC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> RTC R x y`, + REWRITE_TAC[RTC] THEN MESON_TAC[RC_INC; TC_INC]);; + +let RTC_REFL = prove + (`!(R:A->A->bool) x. RTC R x x`, + REWRITE_TAC[RTC; RC_REFL]);; + +let RTC_TRANS = prove + (`!(R:A->A->bool) x y z. RTC R x y /\ RTC R y z ==> RTC R x z`, + REWRITE_TAC[RTC; RC_TC; TC_TRANS]);; + +let RTC_RULES = prove + (`!(R:A->A->bool). + (!x y. R x y ==> RTC R x y) /\ + (!x. RTC R x x) /\ + (!x y z. RTC R x y /\ RTC R y z ==> RTC R x z)`, + REWRITE_TAC[RTC_INC; RTC_REFL; RTC_TRANS]);; + +let RTC_TRANS_L = prove + (`!(R:A->A->bool) x y z. RTC R x y /\ R y z ==> RTC R x z`, + REWRITE_TAC[RTC; RC_TC] THEN MESON_TAC[TC_TRANS_L; RC_INC]);; + +let RTC_TRANS_R = prove + (`!(R:A->A->bool) x y z. R x y /\ RTC R y z ==> RTC R x z`, + REWRITE_TAC[RTC; RC_TC] THEN MESON_TAC[TC_TRANS_R; RC_INC]);; + +let RTC_CASES = prove + (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. RTC R x y /\ RTC R y z`, + REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_TRANS]);; + +let RTC_CASES_L = prove + (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. RTC R x y /\ R y z`, + REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CASES_L; TC_TRANS_L]);; + +let RTC_CASES_R = prove + (`!(R:A->A->bool) x z. RTC R x z <=> (x = z) \/ ?y. R x y /\ RTC R y z`, + REWRITE_TAC[RTC; RC_EXPLICIT] THEN MESON_TAC[TC_CASES_R; TC_TRANS_R]);; + +let RTC_INDUCT = prove + (`!(R:A->A->bool) P. + (!x y. R x y ==> P x y) /\ + (!x. P x x) /\ + (!x y z. P x y /\ P y z ==> P x z) + ==> !x y. RTC R x y ==> P x y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN + MATCH_MP_TAC TC_INDUCT THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);; + +let RTC_INDUCT_L = prove + (`!(R:A->A->bool) P. + (!x. P x x) /\ + (!x y z. P x y /\ R y z ==> P x z) + ==> !x y. RTC R x y ==> P x y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN + MATCH_MP_TAC TC_INDUCT_L THEN REWRITE_TAC[RC_EXPLICIT] THEN + ASM_MESON_TAC[]);; + +let RTC_INDUCT_R = prove + (`!(R:A->A->bool) P. + (!x. P x x) /\ + (!x y z. R x y /\ P y z ==> P x z) + ==> !x y. RTC R x y ==> P x y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[RTC; RC_TC] THEN + MATCH_MP_TAC TC_INDUCT_R THEN REWRITE_TAC[RC_EXPLICIT] THEN + ASM_MESON_TAC[]);; + +let RTC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. RTC R x y ==> RTC S x y)`, + REWRITE_TAC[RTC] THEN MESON_TAC[RC_MONO; TC_MONO]);; + +let RTC_CLOSED = prove + (`!R:A->A->bool. (RTC R = R) <=> (!x. R x x) /\ + (!x y z. R x y /\ R y z ==> R x z)`, + REWRITE_TAC[FUN_EQ_THM; RTC; RC_EXPLICIT] THEN + MESON_TAC[TC_CLOSED; TC_RULES]);; + +let RTC_IDEMP = prove + (`!R:A->A->bool. RTC(RTC R) = RTC R`, + REWRITE_TAC[RTC_CLOSED; RTC_REFL; RTC_TRANS]);; + +let RTC_SYM = prove + (`!R:A->A->bool. (!x y. R x y ==> R y x) ==> (!x y. RTC R x y ==> RTC R y x)`, + REWRITE_TAC[RTC] THEN MESON_TAC[RC_SYM; TC_SYM]);; + +let RTC_STUTTER = prove + (`RTC R = RTC (\x y. R x y /\ ~(x = y))`, + REWRITE_TAC[RC_TC; RTC] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + REWRITE_TAC[RC_CASES] THEN MESON_TAC[]);; + +let TC_RTC_CASES_L = prove + (`TC R x z <=> ?y. RTC R x y /\ R y z`, + REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_CASES_L; TC_INC]);; + +let TC_RTC_CASES_R = prove + (`!R x z. TC R x z <=> ?y. R x y /\ RTC R y z`, + REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_CASES_R; TC_INC]);; + +let TC_TC_RTC_CASES = prove + (`!R x z. TC R x z <=> ?y. TC R x y /\ RTC R y z`, + REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_TRANS]);; + +let TC_RTC_TC_CASES = prove + (`!R x z. TC R x z <=> ?y. RTC R x y /\ TC R y z`, + REWRITE_TAC[RTC; RC_CASES] THEN MESON_TAC[TC_TRANS]);; + +let RTC_NE_IMP_TC = prove + (`!R x y. RTC R x y /\ ~(x = y) ==> TC R x y`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM IMP_IMP] THEN + MATCH_MP_TAC RTC_INDUCT THEN REWRITE_TAC[] THEN + MESON_TAC[TC_INC; TC_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Symmetric transitive closure *) +(* ------------------------------------------------------------------------- *) + +let STC = new_definition + `STC(R:A->A->bool) = TC(SC R)`;; + +let STC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> STC R x y`, + REWRITE_TAC[STC] THEN MESON_TAC[SC_INC; TC_INC]);; + +let STC_SYM = prove + (`!(R:A->A->bool) x y. STC R x y ==> STC R y x`, + REWRITE_TAC[STC] THEN MESON_TAC[TC_SYM; SC_SYM]);; + +let STC_TRANS = prove + (`!(R:A->A->bool) x y z. STC R x y /\ STC R y z ==> STC R x z`, + REWRITE_TAC[STC; TC_TRANS]);; + +let STC_TRANS_L = prove + (`!(R:A->A->bool) x y z. STC R x y /\ R y z ==> STC R x z`, + REWRITE_TAC[STC] THEN MESON_TAC[TC_TRANS_L; SC_INC]);; + +let STC_TRANS_R = prove + (`!(R:A->A->bool) x y z. R x y /\ STC R y z ==> STC R x z`, + REWRITE_TAC[STC] THEN MESON_TAC[TC_TRANS_R; SC_INC]);; + +let STC_CASES = prove + (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/ + ?y. STC R x y /\ STC R y z`, + REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);; + +let STC_CASES_L = prove + (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/ + ?y. STC R x y /\ R y z`, + REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);; + +let STC_CASES_R = prove + (`!(R:A->A->bool) x z. STC R x z <=> R x z \/ STC R z x \/ + ?y. R x y /\ STC R y z`, + REWRITE_TAC[STC] THEN MESON_TAC[SC_SYM; TC_SYM; TC_INC; TC_TRANS; SC_INC]);; + +let STC_INDUCT = prove + (`!(R:A->A->bool) P. + (!x y. R x y ==> P x y) /\ + (!x y. P x y ==> P y x) /\ + (!x y z. P x y /\ P y z ==> P x z) ==> + !x y. STC R x y ==> P x y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[STC] THEN + MATCH_MP_TAC TC_INDUCT THEN ASM_MESON_TAC[SC_EXPLICIT]);; + +let STC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. STC R x y ==> STC S x y)`, + REWRITE_TAC[STC] THEN MESON_TAC[SC_MONO; TC_MONO]);; + +let STC_CLOSED = prove + (`!R:A->A->bool. (STC R = R) <=> (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z)`, + GEN_TAC THEN REWRITE_TAC[STC; SC_EXPLICIT] THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN MESON_TAC[TC_TRANS; TC_SYM; SC_SYM]; + REWRITE_TAC[GSYM SC_CLOSED; GSYM TC_CLOSED] THEN MESON_TAC[]]);; + +let STC_IDEMP = prove + (`!R:A->A->bool. STC(STC R) = STC R`, + REWRITE_TAC[STC_CLOSED; STC_SYM; STC_TRANS]);; + +let STC_REFL = prove + (`!R:A->A->bool. (!x. R x x) ==> !x. STC R x x`, + MESON_TAC[STC_INC]);; + +(* ------------------------------------------------------------------------- *) +(* Reflexive symmetric transitive closure (smallest equivalence relation) *) +(* ------------------------------------------------------------------------- *) + +let RSTC = new_definition + `RSTC(R:A->A->bool) = RC(TC(SC R))`;; + +let RSTC_INC = prove + (`!(R:A->A->bool) x y. R x y ==> RSTC R x y`, + REWRITE_TAC[RSTC] THEN MESON_TAC[RC_INC; TC_INC; SC_INC]);; + +let RSTC_REFL = prove + (`!(R:A->A->bool) x. RSTC R x x`, + REWRITE_TAC[RSTC; RC_REFL]);; + +let RSTC_SYM = prove + (`!(R:A->A->bool) x y. RSTC R x y ==> RSTC R y x`, + REWRITE_TAC[RSTC] THEN MESON_TAC[SC_SYM; TC_SYM; RC_SYM]);; + +let RSTC_TRANS = prove + (`!(R:A->A->bool) x y z. RSTC R x y /\ RSTC R y z ==> RSTC R x z`, + REWRITE_TAC[RSTC; RC_TC; TC_TRANS]);; + +let RSTC_RULES = prove + (`!(R:A->A->bool). + (!x y. R x y ==> RSTC R x y) /\ + (!x. RSTC R x x) /\ + (!x y. RSTC R x y ==> RSTC R y x) /\ + (!x y z. RSTC R x y /\ RSTC R y z ==> RSTC R x z)`, + REWRITE_TAC[RSTC_INC; RSTC_REFL; RSTC_SYM; RSTC_TRANS]);; + +let RSTC_TRANS_L = prove + (`!(R:A->A->bool) x y z. RSTC R x y /\ R y z ==> RSTC R x z`, + REWRITE_TAC[RSTC; RC_TC] THEN MESON_TAC[TC_TRANS_L; RC_INC; SC_INC]);; + +let RSTC_TRANS_R = prove + (`!(R:A->A->bool) x y z. R x y /\ RSTC R y z ==> RSTC R x z`, + REWRITE_TAC[RSTC; RC_TC] THEN MESON_TAC[TC_TRANS_R; RC_INC; SC_INC]);; + +let RSTC_CASES = prove + (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/ + ?y. RSTC R x y /\ RSTC R y z`, + REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN + MESON_TAC[STC_CASES; RC_CASES]);; + +let RSTC_CASES_L = prove + (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/ + ?y. RSTC R x y /\ R y z`, + REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN + MESON_TAC[STC_CASES_L; RC_CASES]);; + +let RSTC_CASES_R = prove + (`!(R:A->A->bool) x z. RSTC R x z <=> (x = z) \/ R x z \/ RSTC R z x \/ + ?y. R x y /\ RSTC R y z`, + REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN + MESON_TAC[STC_CASES_R; RC_CASES]);; + +let RSTC_INDUCT = prove + (`!(R:A->A->bool) P. + (!x y. R x y ==> P x y) /\ + (!x. P x x) /\ + (!x y. P x y ==> P y x) /\ + (!x y z. P x y /\ P y z ==> P x z) + ==> !x y. RSTC R x y ==> P x y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[RSTC; RC_TC; RC_SC] THEN REWRITE_TAC[GSYM STC] THEN + MATCH_MP_TAC STC_INDUCT THEN REWRITE_TAC[RC_EXPLICIT] THEN ASM_MESON_TAC[]);; + +let RSTC_MONO = prove + (`!(R:A->A->bool) S. + (!x y. R x y ==> S x y) ==> + (!x y. RSTC R x y ==> RSTC S x y)`, + REWRITE_TAC[RSTC] THEN MESON_TAC[RC_MONO; SC_MONO; TC_MONO]);; + +let RSTC_CLOSED = prove + (`!R:A->A->bool. (RSTC R = R) <=> (!x. R x x) /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z)`, + REWRITE_TAC[RSTC] THEN REWRITE_TAC[GSYM STC; GSYM STC_CLOSED] THEN + REWRITE_TAC[RC_EXPLICIT; FUN_EQ_THM] THEN MESON_TAC[STC_INC]);; + +let RSTC_IDEMP = prove + (`!R:A->A->bool. RSTC(RSTC R) = RSTC R`, + REWRITE_TAC[RSTC_CLOSED; RSTC_REFL; RSTC_SYM; RSTC_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Finally, we prove the inclusion properties for composite closures *) +(* ------------------------------------------------------------------------- *) + +let RSC_INC_RC = prove + (`!R:A->A->bool. !x y. RC R x y ==> RSC R x y`, + REWRITE_TAC[RSC; RC_SC; SC_INC]);; + +let RSC_INC_SC = prove + (`!R:A->A->bool. !x y. SC R x y ==> RSC R x y`, + REWRITE_TAC[RSC; RC_INC]);; + +let RTC_INC_RC = prove + (`!R:A->A->bool. !x y. RC R x y ==> RTC R x y`, + REWRITE_TAC[RTC; RC_TC; TC_INC]);; + +let RTC_INC_TC = prove + (`!R:A->A->bool. !x y. TC R x y ==> RTC R x y`, + REWRITE_TAC[RTC; RC_INC]);; + +let STC_INC_SC = prove + (`!R:A->A->bool. !x y. SC R x y ==> STC R x y`, + REWRITE_TAC[STC; TC_INC]);; + +let STC_INC_TC = prove + (`!R:A->A->bool. !x y. TC R x y ==> STC R x y`, + REWRITE_TAC[STC] THEN MESON_TAC[TC_MONO; SC_INC]);; + +let RSTC_INC_RC = prove + (`!R:A->A->bool. !x y. RC R x y ==> RSTC R x y`, + REWRITE_TAC[RSTC; RC_TC; RC_SC; GSYM STC; STC_INC]);; + +let RSTC_INC_SC = prove + (`!R:A->A->bool. !x y. SC R x y ==> RSTC R x y`, + REWRITE_TAC[RSTC; GSYM RTC; RTC_INC]);; + +let RSTC_INC_TC = prove + (`!R:A->A->bool. !x y. TC R x y ==> RSTC R x y`, + REWRITE_TAC[RSTC; RC_TC; GSYM RSC] THEN MESON_TAC[TC_MONO; RSC_INC]);; + +let RSTC_INC_RSC = prove + (`!R:A->A->bool. !x y. RSC R x y ==> RSTC R x y`, + REWRITE_TAC[RSC; RSTC; RC_TC; TC_INC]);; + +let RSTC_INC_RTC = prove + (`!R:A->A->bool. !x y. RTC R x y ==> RSTC R x y`, + REWRITE_TAC[GSYM RTC; RSTC] THEN MESON_TAC[RTC_MONO; SC_INC]);; + +let RSTC_INC_STC = prove + (`!R:A->A->bool. !x y. STC R x y ==> RSTC R x y`, + REWRITE_TAC[GSYM STC; RSTC; RC_INC]);; + +(* ------------------------------------------------------------------------- *) +(* Handy things about reverse relations. *) +(* ------------------------------------------------------------------------- *) + +let INV = new_definition + `INV R (x:A) (y:B) <=> R y x`;; + +let RC_INV = prove + (`RC(INV R) = INV(RC R)`, + REWRITE_TAC[FUN_EQ_THM; RC_EXPLICIT; INV; EQ_SYM_EQ]);; + +let SC_INV = prove + (`SC(INV R) = INV(SC R)`, + REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT; INV; DISJ_SYM]);; + +let SC_INV_STRONG = prove + (`SC(INV R) = SC R`, + REWRITE_TAC[FUN_EQ_THM; SC_EXPLICIT; INV; DISJ_SYM]);; + +let TC_INV = prove + (`TC(INV R) = INV(TC R)`, + REWRITE_TAC[FUN_EQ_THM; INV] THEN REPEAT GEN_TAC THEN EQ_TAC THEN + RULE_INDUCT_TAC TC_INDUCT THEN MESON_TAC[INV; TC_RULES]);; + +let RSC_INV = prove + (`RSC(INV R) = INV(RSC R)`, + REWRITE_TAC[RSC; RC_INV; SC_INV]);; + +let RTC_INV = prove + (`RTC(INV R) = INV(RTC R)`, + REWRITE_TAC[RTC; RC_INV; TC_INV]);; + +let STC_INV = prove + (`STC(INV R) = INV(STC R)`, + REWRITE_TAC[STC; SC_INV; TC_INV]);; + +let RSTC_INV = prove + (`RSTC(INV R) = INV(RSTC R)`, + REWRITE_TAC[RSTC; RC_INV; SC_INV; TC_INV]);; + +(* ------------------------------------------------------------------------- *) +(* An iterative version of (R)TC. *) +(* ------------------------------------------------------------------------- *) + +let RELPOW = new_recursive_definition num_RECURSION + `(RELPOW 0 (R:A->A->bool) x y <=> (x = y)) /\ + (RELPOW (SUC n) R x y <=> ?z. RELPOW n R x z /\ R z y)`;; + +let RELPOW_R = prove + (`(RELPOW 0 (R:A->A->bool) x y <=> (x = y)) /\ + (RELPOW (SUC n) R x y <=> ?z. R x z /\ RELPOW n R z y)`, + CONJ_TAC THENL [REWRITE_TAC[RELPOW]; ALL_TAC] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`x:A`; `y:A`; `n:num`] THEN + INDUCT_TAC THEN ASM_MESON_TAC[RELPOW]);; + +let RELPOW_M = prove + (`!m n x:A y. RELPOW (m + n) R x y <=> ?z. RELPOW m R x z /\ RELPOW n R z y`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; RELPOW_R; UNWIND_THM1] THEN + MESON_TAC[]);; + +let RTC_RELPOW = prove + (`!R (x:A) y. RTC R x y <=> ?n. RELPOW n R x y`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [RULE_INDUCT_TAC RTC_INDUCT_L THEN MESON_TAC[RELPOW]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`y:A`,`y:A`) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN + REWRITE_TAC[RELPOW] THEN ASM_MESON_TAC[RTC_REFL; RTC_TRANS_L]]);; + +let TC_RELPOW = prove + (`!R (x:A) y. TC R x y <=> ?n. RELPOW (SUC n) R x y`, + REWRITE_TAC[RELPOW] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; GSYM RTC_RELPOW] THEN + ONCE_REWRITE_TAC[TC_CASES_L] THEN REWRITE_TAC[RTC; RC_EXPLICIT] THEN + MESON_TAC[]);; + +let RELPOW_SEQUENCE = prove + (`!R n x y. RELPOW n R x y <=> ?f. (f(0) = x:A) /\ (f(n) = y) /\ + !i. i < n ==> R (f i) (f(SUC i))`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; RELPOW] THENL + [REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `\n:num. y:A` THEN REWRITE_TAC[]; + MESON_TAC[]]; + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [DISJ_CASES_TAC(ARITH_RULE `(n = 0) \/ 0 < n`) THENL + [EXISTS_TAC `\i. if i = 0 then x else y:A` THEN + ASM_REWRITE_TAC[ARITH; LT] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_SUC] THEN + ASM_MESON_TAC[]; + EXISTS_TAC `\i. if i <= n then f(i) else (y:A)` THEN + ASM_REWRITE_TAC[LE_0; ARITH_RULE `~(SUC n <= n)`] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC n <= n)`] THEN + ASM_REWRITE_TAC[LE_SUC_LT] THEN + ASM_REWRITE_TAC[LE_LT] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + EXISTS_TAC `(f:num->A) n` THEN CONJ_TAC THENL + [EXISTS_TAC `f:num->A` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]]]);; diff --git a/Library/transc.ml b/Library/transc.ml new file mode 100644 index 0000000..ddffe55 --- /dev/null +++ b/Library/transc.ml @@ -0,0 +1,6541 @@ +(* ======================================================================== *) +(* Properties of power series. *) +(* ======================================================================== *) + +needs "Library/analysis.ml";; + +(* ------------------------------------------------------------------------ *) +(* More theorems about rearranging finite sums *) +(* ------------------------------------------------------------------------ *) + +let POWDIFF_LEMMA = prove( + `!n x y. sum(0,SUC n)(\p. (x pow p) * y pow ((SUC n) - p)) = + y * sum(0,SUC n)(\p. (x pow p) * (y pow (n - p)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_CMUL] THEN + MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN DISCH_TAC THEN + BETA_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `~(n < p:num)` ASSUME_TAC THENL + [POP_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES] THEN + REWRITE_TAC[NOT_LT; CONJUNCT2 LT] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN + REWRITE_TAC[LE_REFL; LT_IMP_LE]; + ASM_REWRITE_TAC[SUB_OLD] THEN REWRITE_TAC[pow] THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM]);; + +let POWDIFF = prove( + `!n x y. (x pow (SUC n)) - (y pow (SUC n)) = + (x - y) * sum(0,SUC n)(\p. (x pow p) * (y pow (n - p)))`, + INDUCT_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[sum] THEN + REWRITE_TAC[REAL_ADD_LID; ADD_CLAUSES; SUB_0] THEN + BETA_TAC THEN REWRITE_TAC[pow] THEN + REWRITE_TAC[REAL_MUL_RID]; + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[sum] THEN + REWRITE_TAC[ADD_CLAUSES] THEN BETA_TAC THEN + REWRITE_TAC[POWDIFF_LEMMA] THEN REWRITE_TAC[REAL_LDISTRIB] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * (b * c) = b * (a * c)`] THEN + POP_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[SUB_REFL] THEN + SPEC_TAC(`SUC n`,`n:num`) THEN GEN_TAC THEN + REWRITE_TAC[pow; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_LDISTRIB; REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (d + a) + (c + b)`] THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [REAL_MUL_SYM] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_ADD_LINV]]);; + +let POWREV = prove( + `!n x y. sum(0,SUC n)(\p. (x pow p) * (y pow (n - p))) = + sum(0,SUC n)(\p. (x pow (n - p)) * (y pow p))`, + let REAL_EQ_LMUL2' = CONV_RULE(REDEPTH_CONV FORALL_IMP_CONV) REAL_EQ_LMUL2 in + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real = y` THENL + [ASM_REWRITE_TAC[GSYM POW_ADD] THEN + MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN + BETA_TAC THEN DISCH_TAC THEN AP_TERM_TAC THEN + MATCH_ACCEPT_TAC ADD_SYM; + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_0]) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_EQ_LMUL2' th]) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_NEGNEG] THEN + ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN + ONCE_REWRITE_TAC[REAL_NEG_SUB] THEN + REWRITE_TAC[GSYM POWDIFF] THEN REWRITE_TAC[REAL_NEG_SUB]]);; + +(* ------------------------------------------------------------------------ *) +(* Show (essentially) that a power series has a "circle" of convergence, *) +(* i.e. if it sums for x, then it sums absolutely for z with |z| < |x|. *) +(* ------------------------------------------------------------------------ *) + +let POWSER_INSIDEA = prove( + `!f x z. summable (\n. f(n) * (x pow n)) /\ abs(z) < abs(x) + ==> summable (\n. abs(f(n)) * (z pow n))`, + let th = (GEN_ALL o CONV_RULE LEFT_IMP_EXISTS_CONV o snd o + EQ_IMP_RULE o SPEC_ALL) convergent in + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_ZERO) THEN + DISCH_THEN(MP_TAC o MATCH_MP th) THEN REWRITE_TAC[GSYM SEQ_CAUCHY] THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_CBOUNDED) THEN + REWRITE_TAC[SEQ_BOUNDED] THEN BETA_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `K:real`) THEN MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. (K * abs(z pow n)) / abs(x pow n)` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + BETA_TAC THEN MATCH_MP_TAC REAL_LE_RDIV THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM ABS_NZ] THEN MATCH_MP_TAC POW_NZ THEN + REWRITE_TAC[ABS_NZ] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(z)` THEN ASM_REWRITE_TAC[ABS_POS]; + REWRITE_TAC[ABS_MUL; ABS_ABS; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c = (a * c) * b`] THEN + DISJ_CASES_TAC(SPEC `z pow n` ABS_CASES) THEN + ASM_REWRITE_TAC[ABS_0; REAL_MUL_RZERO; REAL_LE_REFL] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[GSYM ABS_MUL]]; + REWRITE_TAC[summable] THEN + EXISTS_TAC `K * inv(&1 - (abs(z) / abs(x)))` THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SER_CMUL THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [GSYM real_div] THEN + SUBGOAL_THEN `!n. abs(z pow n) / abs(x pow n) = + (abs(z) / abs(x)) pow n` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [ALL_TAC; REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC GP THEN REWRITE_TAC[real_div; ABS_MUL] THEN + SUBGOAL_THEN `~(abs(x) = &0)` (SUBST1_TAC o MATCH_MP ABS_INV) THENL + [DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `abs(z) < &0` THEN + REWRITE_TAC[REAL_NOT_LT; ABS_POS]; + REWRITE_TAC[ABS_ABS; GSYM real_div] THEN + MATCH_MP_TAC REAL_LT_1 THEN ASM_REWRITE_TAC[ABS_POS]]] THEN + REWRITE_TAC[GSYM POW_ABS] THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[real_div; POW_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC POW_INV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(z)` THEN + ASM_REWRITE_TAC[ABS_POS]]);; + +(* ------------------------------------------------------------------------ *) +(* Weaker but more commonly useful form for non-absolute convergence *) +(* ------------------------------------------------------------------------ *) + +let POWSER_INSIDE = prove( + `!f x z. summable (\n. f(n) * (x pow n)) /\ abs(z) < abs(x) + ==> summable (\n. f(n) * (z pow n))`, + REPEAT GEN_TAC THEN + SUBST1_TAC(SYM(SPEC `z:real` ABS_ABS)) THEN + DISCH_THEN(MP_TAC o MATCH_MP POWSER_INSIDEA) THEN + REWRITE_TAC[POW_ABS; GSYM ABS_MUL] THEN + DISCH_THEN((then_) (MATCH_MP_TAC SER_ACONV) o MP_TAC) THEN + BETA_TAC THEN DISCH_THEN ACCEPT_TAC);; + +(* ------------------------------------------------------------------------ *) +(* Define formal differentiation of power series *) +(* ------------------------------------------------------------------------ *) + +let diffs = new_definition + `diffs c = (\n. &(SUC n) * c(SUC n))`;; + +(* ------------------------------------------------------------------------ *) +(* Lemma about distributing negation over it *) +(* ------------------------------------------------------------------------ *) + +let DIFFS_NEG = prove( + `!c. diffs(\n. --(c n)) = \n. --((diffs c) n)`, + GEN_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN + REWRITE_TAC[REAL_NEG_RMUL]);; + +(* ------------------------------------------------------------------------ *) +(* Show that we can shift the terms down one *) +(* ------------------------------------------------------------------------ *) + +let DIFFS_LEMMA = prove( + `!n c x. sum(0,n) (\n. (diffs c)(n) * (x pow n)) = + sum(0,n) (\n. &n * c(n) * (x pow (n - 1))) + + (&n * c(n) * x pow (n - 1))`, + INDUCT_TAC THEN ASM_REWRITE_TAC[sum; REAL_MUL_LZERO; REAL_ADD_LID] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + AP_TERM_TAC THEN BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN + AP_TERM_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN + REWRITE_TAC[SUC_SUB1; REAL_MUL_ASSOC]);; + +let DIFFS_LEMMA2 = prove( + `!n c x. sum(0,n) (\n. &n * c(n) * (x pow (n - 1))) = + sum(0,n) (\n. (diffs c)(n) * (x pow n)) - + (&n * c(n) * x pow (n - 1))`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_EQ_SUB_LADD; DIFFS_LEMMA]);; + +let DIFFS_EQUIV = prove( + `!c x. summable(\n. (diffs c)(n) * (x pow n)) ==> + (\n. &n * c(n) * (x pow (n - 1))) sums + (suminf(\n. (diffs c)(n) * (x pow n)))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[diffs] o MATCH_MP SER_ZERO) THEN + BETA_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN DISCH_TAC THEN + SUBGOAL_THEN `(\n. &n * c(n) * (x pow (n - 1))) tends_num_real &0` + MP_TAC THENL + [ONCE_REWRITE_TAC[SEQ_SUC] THEN BETA_TAC THEN + ASM_REWRITE_TAC[SUC_SUB1]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o CONJ (MATCH_MP SUMMABLE_SUM + (ASSUME `summable(\n. (diffs c)(n) * (x pow n))`))) THEN + REWRITE_TAC[sums] THEN DISCH_THEN(MP_TAC o MATCH_MP SEQ_SUB) THEN + BETA_TAC THEN REWRITE_TAC[GSYM DIFFS_LEMMA2] THEN + REWRITE_TAC[REAL_SUB_RZERO]);; + +(* ======================================================================== *) +(* Show term-by-term differentiability of power series *) +(* (NB we hypothesize convergence of first two derivatives; we could prove *) +(* they all have the same radius of convergence, but we don't need to.) *) +(* ======================================================================== *) + +let TERMDIFF_LEMMA1 = prove( + `!m z h. + sum(0,m)(\p. (((z + h) pow (m - p)) * (z pow p)) - (z pow m)) = + sum(0,m)(\p. (z pow p) * + (((z + h) pow (m - p)) - (z pow (m - p))))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_SUBST THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; GSYM POW_ADD] THEN BINOP_TAC THENL + [MATCH_ACCEPT_TAC REAL_MUL_SYM; + AP_TERM_TAC THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUB_ADD THEN + MATCH_MP_TAC LT_IMP_LE THEN + POP_ASSUM(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[ADD_CLAUSES]]);; + +let TERMDIFF_LEMMA2 = prove( + `!z h. ~(h = &0) ==> + (((((z + h) pow n) - (z pow n)) / h) - (&n * (z pow (n - 1))) = + h * sum(0,n - 1)(\p. (z pow p) * + sum(0,(n - 1) - p) + (\q. ((z + h) pow q) * + (z pow (((n - 2) - p) - q)))))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_EQ_LMUL2 th]) THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_DIV_LMUL th]) THEN + DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `m:num` SUBST1_TAC) + (SPEC `n:num` num_CASES) THENL + [REWRITE_TAC[pow; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_REFL] THEN + REWRITE_TAC[SUB_0; sum; REAL_MUL_RZERO]; ALL_TAC] THEN + REWRITE_TAC[POWDIFF; REAL_ADD_SUB] THEN + ASM_REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_EQ_LMUL] THEN + REWRITE_TAC[SUC_SUB1] THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [POWREV] THEN + REWRITE_TAC[sum] THEN REWRITE_TAC[ADD_CLAUSES] THEN BETA_TAC THEN + REWRITE_TAC[SUB_REFL] THEN REWRITE_TAC[REAL; pow] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID; REAL_RDISTRIB] THEN + REWRITE_TAC[REAL_ADD2_SUB2; REAL_SUB_REFL; REAL_ADD_RID] THEN + REWRITE_TAC[SUM_NSUB] THEN BETA_TAC THEN + REWRITE_TAC[TERMDIFF_LEMMA1] THEN + ONCE_REWRITE_TAC[GSYM SUM_CMUL] THEN BETA_TAC THEN + MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `p:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN DISCH_TAC THEN BETA_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[POWDIFF; REAL_ADD_SUB] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + AP_TERM_TAC THEN MATCH_MP_TAC SUM_SUBST THEN X_GEN_TAC `q:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN + REWRITE_TAC[SUB_SUC; SUB_0; ADD_SUB]);; + +let TERMDIFF_LEMMA3 = prove( + `!z h n K. ~(h = &0) /\ abs(z) <= K /\ abs(z + h) <= K ==> + abs(((((z + h) pow n) - (z pow n)) / h) - (&n * (z pow (n - 1)))) + <= &n * &(n - 1) * (K pow (n - 2)) * abs(h)`, + let tac = W((then_) (MATCH_MP_TAC REAL_LE_TRANS) o + EXISTS_TAC o rand o concl o PART_MATCH (rand o rator) ABS_SUM o + rand o rator o snd) THEN REWRITE_TAC[ABS_SUM] in + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP TERMDIFF_LEMMA2 th]) THEN + REWRITE_TAC[ABS_MUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + FIRST_ASSUM(ASSUME_TAC o CONV_RULE(REWR_CONV ABS_NZ)) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [MATCH_MP REAL_LE_LMUL_LOCAL th]) THEN + tac THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC SUM_BOUND THEN X_GEN_TAC `p:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN STRIP_ASSUME_TAC THEN + BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN + DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) + (SPEC `n:num` num_CASES) THENL + [REWRITE_TAC[SUB_0; sum; ABS_0; REAL_MUL_RZERO; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[SUC_SUB1; num_CONV `2`; SUB_SUC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUC_SUB1]) THEN + SUBGOAL_THEN `p < r:num` MP_TAC THENL + [FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[ADD_CLAUSES; SUC_SUB1; ADD_SUB] THEN + REWRITE_TAC[POW_ADD] THEN GEN_REWRITE_TAC RAND_CONV + [AC REAL_MUL_AC + `(a * b) * c = b * (c * a)`] THEN + MATCH_MP_TAC REAL_LE_MUL2V THEN REWRITE_TAC[ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM POW_ABS] THEN MATCH_MP_TAC POW_LE THEN + ASM_REWRITE_TAC[ABS_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC d) * (K pow d)` THEN + CONJ_TAC THENL + [ALL_TAC; SUBGOAL_THEN `&0 <= K` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs z` THEN + ASM_REWRITE_TAC[ABS_POS]; + DISCH_THEN(MP_TAC o SPEC `d:num` o MATCH_MP POW_POS) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN + REWRITE_TAC[REAL_LE; LE_SUC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `SUC d` THEN + REWRITE_TAC[LE_SUC; LE_ADD] THEN + MATCH_MP_TAC LT_IMP_LE THEN REWRITE_TAC[LESS_SUC_REFL]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]]] THEN + tac THEN MATCH_MP_TAC SUM_BOUND THEN X_GEN_TAC `q:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN + UNDISCH_TAC `q < (SUC d)` THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; SUC_INJ] THEN + DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[POW_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2V THEN + REWRITE_TAC[ABS_POS; GSYM POW_ABS] THEN + CONJ_TAC THEN MATCH_MP_TAC POW_LE THEN ASM_REWRITE_TAC[ABS_POS]);; + +let TERMDIFF_LEMMA4 = prove( + `!f K k. &0 < k /\ + (!h. &0 < abs(h) /\ abs(h) < k ==> abs(f h) <= K * abs(h)) + ==> (f tends_real_real &0)(&0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[LIM; REAL_SUB_RZERO] THEN + SUBGOAL_THEN `&0 <= K` MP_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `k / &2`) THEN + MP_TAC(ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1] (ASSUME `&0 < k`)) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th; real_abs]) THEN + REWRITE_TAC[GSYM real_abs] THEN + ASM_REWRITE_TAC[REAL_LT_HALF1; REAL_LT_HALF2] THEN DISCH_TAC THEN + MP_TAC(GEN_ALL(MATCH_MP REAL_LE_RMUL_EQ (ASSUME `&0 < k / &2`))) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(f(k / &2))` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; ABS_POS]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THENL + [ALL_TAC; EXISTS_TAC `k:real` THEN REWRITE_TAC[ASSUME `&0 < k`] THEN + GEN_TAC THEN DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + DISCH_THEN(MP_TAC o C CONJ(SPEC `(f:real->real) x` ABS_POS)) THEN + REWRITE_TAC[REAL_LE_ANTISYM] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM ACCEPT_TAC] THEN + SUBGOAL_THEN `&0 < (e / K) / &2` ASSUME_TAC THENL + [REWRITE_TAC[real_div] THEN + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]; ALL_TAC] THEN + MP_TAC(SPECL [`(e / K) / &2`; `k:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `K * abs(h)` THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `d:real` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `K * d` THEN + ASM_REWRITE_TAC[MATCH_MP REAL_LT_LMUL_EQ (ASSUME `&0 < K`)] THEN + ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LT_RDIV (ASSUME `&0 < K`))] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * c = (c * a) * b`] THEN + ASSUME_TAC(GSYM(MATCH_MP REAL_LT_IMP_NE (ASSUME `&0 < K`))) THEN + REWRITE_TAC[MATCH_MP REAL_MUL_LINV (ASSUME `~(K = &0)`)] THEN + REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `(e / K) / &2` THEN + ASM_REWRITE_TAC[GSYM real_div] THEN REWRITE_TAC[REAL_LT_HALF2] THEN + ONCE_REWRITE_TAC[GSYM REAL_LT_HALF1] THEN ASM_REWRITE_TAC[]]);; + +let TERMDIFF_LEMMA5 = prove( + `!f g k. &0 < k /\ + summable(f) /\ + (!h. &0 < abs(h) /\ abs(h) < k ==> !n. abs(g(h) n) <= (f(n) * abs(h))) + ==> ((\h. suminf(g h)) tends_real_real &0)(&0)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o MATCH_MP SUMMABLE_SUM) MP_TAC) THEN + ASSUME_TAC((GEN `h:real` o SPEC `abs(h)` o + MATCH_MP SER_CMUL) (ASSUME `f sums (suminf f)`)) THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_MUL_SYM]) THEN + FIRST_ASSUM(ASSUME_TAC o GEN `h:real` o + MATCH_MP SUM_UNIQ o SPEC `h:real`) THEN DISCH_TAC THEN + C SUBGOAL_THEN ASSUME_TAC `!h. &0 < abs(h) /\ abs(h) < k ==> + abs(suminf(g h)) <= (suminf(f) * abs(h))` THENL + [GEN_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN DISCH_TAC THEN + SUBGOAL_THEN `summable(\n. f(n) * abs(h))` ASSUME_TAC THENL + [MATCH_MP_TAC SUM_SUMMABLE THEN + EXISTS_TAC `suminf(f) * abs(h)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `summable(\n. abs(g(h:real)(n:num)))` ASSUME_TAC THENL + [MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n:num. f(n) * abs(h)` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN REWRITE_TAC[ABS_ABS] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `suminf(\n. abs(g(h:real)(n:num)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SER_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SER_LE THEN + REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN + GEN_TAC THEN BETA_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC TERMDIFF_LEMMA4 THEN + MAP_EVERY EXISTS_TAC [`suminf(f)`; `k:real`] THEN + BETA_TAC THEN ASM_REWRITE_TAC[]);; + +let TERMDIFF = prove( + `!c K. summable(\n. c(n) * (K pow n)) /\ + summable(\n. (diffs c)(n) * (K pow n)) /\ + summable(\n. (diffs(diffs c))(n) * (K pow n)) /\ + abs(x) < abs(K) + ==> ((\x. suminf (\n. c(n) * (x pow n))) diffl + (suminf (\n. (diffs c)(n) * (x pow n))))(x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[diffl] THEN BETA_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\h. suminf(\n. ((c(n) * ((x + h) pow n)) - + (c(n) * (x pow n))) / h)` THEN CONJ_TAC THENL + [BETA_TAC THEN REWRITE_TAC[LIM] THEN BETA_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `abs(K) - abs(x)` THEN REWRITE_TAC[REAL_SUB_LT] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP ABS_CIRCLE) THEN + W(fun (asl,w) -> SUBGOAL_THEN (mk_eq(rand(rator w),`&0`)) SUBST1_TAC) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABS_ZERO] THEN + REWRITE_TAC[REAL_SUB_0] THEN C SUBGOAL_THEN MP_TAC + `(\n. (c n) * (x pow n)) sums + (suminf(\n. (c n) * (x pow n))) /\ + (\n. (c n) * ((x + h) pow n)) sums + (suminf(\n. (c n) * ((x + h) pow n)))` THENL + [CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN + MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN + DISCH_THEN(MP_TAC o SPEC `h:real` o MATCH_MP SER_CDIV) THEN + BETA_TAC THEN DISCH_THEN(ACCEPT_TAC o MATCH_MP SUM_UNIQ); ALL_TAC] THEN + ONCE_REWRITE_TAC[LIM_NULL] THEN BETA_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM THEN EXISTS_TAC + `\h. suminf (\n. c(n) * + (((((x + h) pow n) - (x pow n)) / h) - (&n * (x pow (n - 1)))))` THEN + BETA_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[LIM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `abs(K) - abs(x)` THEN REWRITE_TAC[REAL_SUB_LT] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP ABS_CIRCLE) THEN + W(fun (asl,w) -> SUBGOAL_THEN (mk_eq(rand(rator w),`&0`)) SUBST1_TAC) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO; ABS_ZERO] THEN + BETA_TAC THEN REWRITE_TAC[REAL_SUB_0] THEN + SUBGOAL_THEN `summable(\n. (diffs c)(n) * (x pow n))` MP_TAC THENL + [MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + MP_TAC (MATCH_MP DIFFS_EQUIV th)) THEN + DISCH_THEN(fun th -> SUBST1_TAC (MATCH_MP SUM_UNIQ th) THEN MP_TAC th) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUB_RZERO]) THEN C SUBGOAL_THEN MP_TAC + `(\n. (c n) * (x pow n)) sums + (suminf(\n. (c n) * (x pow n))) /\ + (\n. (c n) * ((x + h) pow n)) sums + (suminf(\n. (c n) * ((x + h) pow n)))` THENL + [CONJ_TAC THEN MATCH_MP_TAC SUMMABLE_SUM THEN + MATCH_MP_TAC POWSER_INSIDE THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN + DISCH_THEN(MP_TAC o SPEC `h:real` o MATCH_MP SER_CDIV) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM o MATCH_MP SUM_SUMMABLE) THEN + BETA_TAC THEN DISCH_THEN(fun th -> DISCH_THEN (MP_TAC o + MATCH_MP SUMMABLE_SUM o MATCH_MP SUM_SUMMABLE) THEN MP_TAC th) THEN + DISCH_THEN(fun th1 -> DISCH_THEN(fun th2 -> MP_TAC(CONJ th1 th2))) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_SUB) THEN BETA_TAC THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN AP_TERM_TAC THEN + ABS_TAC THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM; + ALL_TAC] THEN + MP_TAC(SPECL [`abs(x)`; `abs(K)`] REAL_MEAN) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL + [`\n. abs(c n) * &n * &(n - 1) * (R pow (n - 2))`; + `\h n. c(n) * (((((x + h) pow n) - (x pow n)) / h) - + (&n * (x pow (n - 1))))`; + `R - abs(x)`] TERMDIFF_LEMMA5) THEN + BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_SUB_LT]; + + SUBGOAL_THEN `summable(\n. abs(diffs(diffs c) n) * (R pow n))` MP_TAC THENL + [MATCH_MP_TAC POWSER_INSIDEA THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs(R) = R` (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(x)` THEN REWRITE_TAC[ABS_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[ABS_MUL] THEN + REWRITE_TAC[ABS_N] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + C SUBGOAL_THEN (fun th -> ONCE_REWRITE_TAC[GSYM th]) + `!n. diffs(diffs (\n. abs(c n))) n * (R pow n) = + &(SUC n) * &(SUC(SUC n)) * abs(c(SUC(SUC n))) * (R pow n)` THENL + [GEN_TAC THEN REWRITE_TAC[diffs] THEN BETA_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFFS_EQUIV) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `(\n. &n * &(SUC n) * abs(c(SUC n)) * (R pow (n - 1))) = + \n. diffs(\m. &(m - 1) * abs(c m) / R) n * (R pow n)` + SUBST1_TAC THENL + [REWRITE_TAC[diffs] THEN BETA_TAC THEN REWRITE_TAC[SUC_SUB1] THEN + ABS_TAC THEN + DISJ_CASES_THEN2 (SUBST1_TAC) (X_CHOOSE_THEN `m:num` SUBST1_TAC) + (SPEC `n:num` num_CASES) THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; SUC_SUB1] THEN + REWRITE_TAC[ADD1; POW_ADD] THEN REWRITE_TAC[GSYM ADD1; POW_1] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e * f = b * a * c * e * d * f`] THEN + REPEAT AP_TERM_TAC THEN SUBGOAL_THEN `inv(R) * R = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[ABS_NZ] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `abs(x)` THEN + ASM_REWRITE_TAC[ABS_POS] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `R:real` THEN ASM_REWRITE_TAC[ABS_LE]; + REWRITE_TAC[REAL_MUL_RID]]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFFS_EQUIV) THEN BETA_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN BETA_TAC THEN GEN_TAC THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV + [AC REAL_MUL_AC + `a * b * c * d = b * c * a * d`] THEN + DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `m:num` SUBST1_TAC) + (SPEC `n:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[num_CONV `2`; SUC_SUB1; SUB_SUC] THEN AP_TERM_TAC THEN + DISJ_CASES_THEN2 SUBST1_TAC (X_CHOOSE_THEN `n:num` SUBST1_TAC) + (SPEC `m:num` num_CASES) THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + REPEAT AP_TERM_TAC THEN REWRITE_TAC[SUC_SUB1] THEN + REWRITE_TAC[ADD1; POW_ADD; POW_1] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `R * inv(R) = &1` + (fun th -> REWRITE_TAC[th; REAL_MUL_RID]) THEN + MATCH_MP_TAC REAL_MUL_RINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(x)` THEN ASM_REWRITE_TAC[ABS_POS]; + + X_GEN_TAC `h:real` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_LMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN + MATCH_MP_TAC TERMDIFF_LEMMA3 THEN ASM_REWRITE_TAC[ABS_NZ] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(x) + abs(h)` THEN + REWRITE_TAC[ABS_TRIANGLE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ASM_REWRITE_TAC[GSYM REAL_LT_SUB_LADD]]]);; + +(* ------------------------------------------------------------------------- *) +(* I eventually decided to get rid of the pointless side-conditions. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_NPOW = prove + (`!x. abs(x) < &1 ==> (\n. &n * x pow n) tends_num_real &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n. abs(x) / (&1 - abs(x)) < &n <=> &(SUC n) * abs(x) < &n` + ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `abs(x) / (&1 - abs(x))` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC SER_ZERO THEN MATCH_MP_TAC SER_RATIO THEN + EXISTS_TAC `&(SUC(SUC N)) * abs(x) / &(SUC N)` THEN + EXISTS_TAC `SUC N` THEN CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_MUL_LID;REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LT_0] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT]; ALL_TAC] THEN + ABBREV_TAC `m = SUC N` THEN GEN_TAC THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + REWRITE_TAC[real_div; real_pow; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [AC REAL_MUL_AC + `a * b * c * d * e = ((a * d) * c) * (b * e)`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_ABS_POS; REAL_LE_MUL] THEN + SUBGOAL_THEN `&0 < &m` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN UNDISCH_TAC `m:num <= n` THEN + EXPAND_TAC "m" THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN + UNDISCH_TAC `m:num <= n` THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN ARITH_TAC);; + +let TERMDIFF_CONVERGES = prove + (`!K. (!x. abs(x) < K ==> summable(\n. c(n) * x pow n)) + ==> !x. abs(x) < K ==> summable (\n. diffs c n * x pow n)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL + [REWRITE_TAC[summable] THEN + EXISTS_TAC `sum(0,1) (\n. diffs c n * x pow n)` THEN + MATCH_MP_TAC SER_0 THEN + ASM_REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN + SIMP_TAC[ARITH_RULE `1 <= m <=> ~(m = 0)`]; ALL_TAC] THEN + SUBGOAL_THEN `?y. abs(x) < abs(y) /\ abs(y) < K` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `(abs(x) + K) / &2` THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; + REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < K` THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[diffs] THEN + SUBGOAL_THEN `summable (\n. (&n * c(n)) * x pow n)` MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SER_OFFSET) THEN + DISCH_THEN(MP_TAC o SPEC `inv(x)` o MATCH_MP SER_CMUL) THEN + REWRITE_TAC[GSYM ADD1; real_pow] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * (b * c) * d * e = (a * d) * (b * c) * e`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN + REWRITE_TAC[SUM_SUMMABLE]] THEN + MATCH_MP_TAC SER_COMPAR THEN EXISTS_TAC `\n:num. abs(c n * y pow n)` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN + MATCH_MP_TAC POWSER_INSIDEA THEN + EXISTS_TAC `(abs(y) + K) / &2` THEN + SUBGOAL_THEN `abs(abs y) < abs((abs y + K) / &2) /\ + abs((abs y + K) / &2) < K` + (fun th -> ASM_SIMP_TAC[th]) THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; + REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs y < K` THEN REAL_ARITH_TAC] THEN + SUBGOAL_THEN `&0 < abs(y)` ASSUME_TAC THENL + [MAP_EVERY UNDISCH_TAC [`abs x < abs y`; `~(x = &0)`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `x / y` SEQ_NPOW) THEN + ASM_SIMP_TAC[REAL_MUL_LID; REAL_LT_LDIV_EQ; REAL_ABS_DIV] THEN + REWRITE_TAC[SEQ] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_SUB_RZERO; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN MATCH_MP_TAC(TAUT `(b ==> c) ==> (a ==> b) ==> (a ==> c)`) THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_POW_DIV] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; REAL_POW_INV] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT] THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [AC REAL_MUL_AC `(a * b) * c = b * a * c`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE]);; + +let TERMDIFF_STRONG = prove + (`!c K x. + summable(\n. c(n) * (K pow n)) /\ abs(x) < abs(K) + ==> ((\x. suminf (\n. c(n) * (x pow n))) diffl + (suminf (\n. (diffs c)(n) * (x pow n))))(x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TERMDIFF THEN + EXISTS_TAC `(abs(x) + abs(K)) / &2` THEN + SUBGOAL_THEN `abs(x) < abs((abs(x) + abs(K)) / &2) /\ + abs((abs(x) + abs(K)) / &2) < abs(K)` + STRIP_ASSUME_TAC THENL + [SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_RDIV_EQ; + REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < abs(K)` THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ABS_ABS] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SER_ACONV THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN + MATCH_MP_TAC POWSER_INSIDEA THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[REAL_ABS_ABS]; + SUBGOAL_THEN + `!x. abs(x) < abs(K) ==> summable (\n. diffs c n * x pow n)` + (fun th -> ASM_SIMP_TAC[th]); + SUBGOAL_THEN + `!x. abs(x) < abs(K) ==> summable (\n. diffs(diffs c) n * x pow n)` + (fun th -> ASM_SIMP_TAC[th]) THEN + MATCH_MP_TAC TERMDIFF_CONVERGES] THEN + MATCH_MP_TAC TERMDIFF_CONVERGES THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SER_ACONV THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW] THEN + MATCH_MP_TAC POWSER_INSIDEA THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; + +(* ------------------------------------------------------------------------- *) +(* Term-by-term comparison of power series. *) +(* ------------------------------------------------------------------------- *) + +let POWSER_0 = prove + (`!a. (\n. a n * (&0) pow n) sums a(0)`, + GEN_TAC THEN + SUBGOAL_THEN `a(0) = sum(0,1) (\n. a n * (&0) pow n)` SUBST1_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_pow; REAL_MUL_RID]; ALL_TAC] THEN + MATCH_MP_TAC SER_0 THEN INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; ARITH]);; + +let POWSER_LIMIT_0 = prove + (`!f a s. &0 < s /\ + (!x. abs(x) < s ==> (\n. a n * x pow n) sums (f x)) + ==> (f tends_real_real a(0))(&0)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num->real`; `s / &2`; `&0`] TERMDIFF_STRONG) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_SIMP_TAC[REAL_ABS_NUM; REAL_ABS_DIV; REAL_LT_DIV; REAL_OF_NUM_LT; + ARITH; REAL_ARITH `&0 < x ==> &0 < abs(x)`] THEN + MATCH_MP_TAC SUM_SUMMABLE THEN + EXISTS_TAC `(f:real->real) (s / &2)` THEN + FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + ARITH] THEN + UNDISCH_TAC `&0 < s` THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CONT) THEN REWRITE_TAC[contl] THEN + SUBGOAL_THEN `suminf (\n. a n * &0 pow n) = a(0)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN + REWRITE_TAC[POWSER_0]; ALL_TAC] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + LIM_TRANSFORM) THEN + REWRITE_TAC[REAL_ADD_LID; LIM] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `s:real` THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `(a = b) /\ &0 < e ==> abs(a - b) < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]);; + +let POWSER_LIMIT_0_STRONG = prove + (`!f a s. + &0 < s /\ + (!x. &0 < abs(x) /\ abs(x) < s ==> (\n. a n * x pow n) sums (f x)) + ==> (f tends_real_real a(0))(&0)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\x. if x = &0 then a(0):real else f x) tends_real_real a(0))(&0)` + MP_TAC THENL + [MATCH_MP_TAC POWSER_LIMIT_0 THEN + EXISTS_TAC `s:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN REWRITE_TAC[sums; SEQ] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `1` THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH; ADD1] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RZERO; SUM_CONST] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + REWRITE_TAC[real_pow; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[REAL_ADD_LID; REAL_SUB_REFL; REAL_ABS_NUM]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC LIM_EQUAL THEN SIMP_TAC[]);; + +let POWSER_EQUAL_0 = prove + (`!f a b P. + (!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs(x) < e) /\ + (!x. &0 < abs(x) /\ P x + ==> (\n. a n * x pow n) sums (f x) /\ + (\n. b n * x pow n) sums (f x)) + ==> (a(0) = b(0))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?s. &0 < s /\ + !x. abs(x) < s + ==> summable (\n. a n * x pow n) /\ summable (\n. b n * x pow n)` + MP_TAC THENL + [FIRST_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `abs(k)` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC POWSER_INSIDE THEN + EXISTS_TAC `k:real` THEN + ASM_REWRITE_TAC[summable] THEN + EXISTS_TAC `(f:real->real) k` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + REWRITE_TAC[summable; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; RIGHT_IMP_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real->real` MP_TAC) THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(x - y)) ==> (x = y)`) THEN + ABBREV_TAC `e = abs(a 0 - b 0)` THEN DISCH_TAC THEN + MP_TAC(SPECL [`g:real->real`; `a:num->real`; `s:real`] + POWSER_LIMIT_0_STRONG) THEN + ASM_SIMP_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`h:real->real`; `b:num->real`; `s:real`] + POWSER_LIMIT_0_STRONG) THEN + ASM_SIMP_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d0:real`; `s:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs x < e` THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `abs(a 0 - b 0) < e` MP_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[REAL_LT_REFL]] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e / &2 + e / &2` THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[GSYM REAL_MUL_2; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC(REAL_ARITH + `!f g h. abs(g - a) < e2 /\ abs(h - b) < e2 /\ (g = f) /\ (h = f) + ==> abs(a - b) < e2 + e2`) THEN + MAP_EVERY EXISTS_TAC + [`(f:real->real) x`; `(g:real->real) x`; `(h:real->real) x`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `suminf(\n. a n * x pow n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_UNIQ; + MATCH_MP_TAC(GSYM SUM_UNIQ)] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `abs(x) < s` (fun th -> ASM_SIMP_TAC[th]) THEN + ASM_MESON_TAC[REAL_LT_TRANS]; + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `suminf(\n. b n * x pow n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_UNIQ; + MATCH_MP_TAC(GSYM SUM_UNIQ)] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `abs(x) < s` (fun th -> ASM_SIMP_TAC[th]) THEN + ASM_MESON_TAC[REAL_LT_TRANS]]);; + +let POWSER_EQUAL = prove + (`!f a b P. + (!e. &0 < e ==> ?x. P x /\ &0 < abs x /\ abs(x) < e) /\ + (!x. P x ==> (\n. a n * x pow n) sums (f x) /\ + (\n. b n * x pow n) sums (f x)) + ==> (a = b)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN + GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN + ONCE_REWRITE_TAC[num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN REWRITE_TAC[] THEN + REWRITE_TAC[TAUT `~(~a /\ b) <=> b ==> a`] THEN DISCH_TAC THEN + SUBGOAL_THEN `(\m. a(m + n):real) 0 = (\m. b(m + n)) 0` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[ADD_CLAUSES]] THEN + MATCH_MP_TAC POWSER_EQUAL_0 THEN + EXISTS_TAC `\x. inv(x pow n) * (f(x) - sum(0,n) (\n. b n * x pow n))` THEN + EXISTS_TAC `P:real->bool` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `!a m. a(m + n) * x pow m = + inv(x pow n) * a(m + n) * x pow (m + n)` + (fun th -> GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[REAL_POW_ADD] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `x' * a * b * x = (x * x') * a * b`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_POW_EQ_0; + REAL_ARITH `(x = &0) <=> ~(&0 < abs x)`] THEN + REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN + CONJ_TAC THEN MATCH_MP_TAC SER_CMUL THENL + [SUBGOAL_THEN `sum(0,n) (\n. b n * x pow n) = sum(0,n) (\n. a n * x pow n)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[ADD_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `f x = suminf (\n. a n * x pow n)` SUBST1_TAC THENL + [MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(SPEC `\n. a n * x pow n` SER_OFFSET); + SUBGOAL_THEN `f x = suminf (\n. b n * x pow n)` SUBST1_TAC THENL + [MATCH_MP_TAC SUM_UNIQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(SPEC `\n. b n * x pow n` SER_OFFSET)] THEN + REWRITE_TAC[] THEN + W(C SUBGOAL_THEN (fun th -> SIMP_TAC[th]) o funpow 2 lhand o snd) THEN + MATCH_MP_TAC SUM_SUMMABLE THEN + EXISTS_TAC `(f:real->real) x` THEN ASM_SIMP_TAC[]);; + +(* ======================================================================== *) +(* Definitions of the transcendental functions etc. *) +(* ======================================================================== *) + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* To avoid all those beta redexes vanishing without trace... *) +(* ------------------------------------------------------------------------- *) + +set_basic_rewrites (subtract' equals_thm (basic_rewrites()) + [SPEC_ALL BETA_THM]);; + +(* ------------------------------------------------------------------------ *) +(* Some miscellaneous lemmas *) +(* ------------------------------------------------------------------------ *) + +let MULT_DIV_2 = prove + (`!n. (2 * n) DIV 2 = n`, + GEN_TAC THEN MATCH_MP_TAC DIV_MULT THEN + REWRITE_TAC[ARITH]);; + +let EVEN_DIV2 = prove + (`!n. ~(EVEN n) ==> ((SUC n) DIV 2 = SUC((n - 1) DIV 2))`, + GEN_TAC THEN REWRITE_TAC[GSYM NOT_ODD; ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + REWRITE_TAC[SUC_SUB1] THEN REWRITE_TAC[ADD1; GSYM ADD_ASSOC] THEN + SUBST1_TAC(EQT_ELIM(NUM_REDUCE_CONV `1 + 1 = 2 * 1`)) THEN + REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; MULT_DIV_2]);; + +(* ------------------------------------------------------------------------ *) +(* Now set up real numbers interface *) +(* ------------------------------------------------------------------------ *) + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Another lost lemma. *) +(* ------------------------------------------------------------------------- *) + +let POW_ZERO = prove( + `!n x. (x pow n = &0) ==> (x = &0)`, + INDUCT_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[pow] THEN + REWRITE_TAC[REAL_10; REAL_ENTIRE] THEN + DISCH_THEN(DISJ_CASES_THEN2 ACCEPT_TAC ASSUME_TAC) THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC);; + +let POW_ZERO_EQ = prove( + `!n x. (x pow (SUC n) = &0) <=> (x = &0)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[POW_ZERO] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POW_0]);; + +let POW_LT = prove( + `!n x y. &0 <= x /\ x < y ==> (x pow (SUC n)) < (y pow (SUC n))`, + REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL + [ASM_REWRITE_TAC[pow; REAL_MUL_RID]; + ONCE_REWRITE_TAC[pow] THEN MATCH_MP_TAC REAL_LT_MUL2_ALT THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POW_POS THEN ASM_REWRITE_TAC[]]);; + +let POW_EQ = prove( + `!n x y. &0 <= x /\ &0 <= y /\ (x pow (SUC n) = y pow (SUC n)) + ==> (x = y)`, + REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x:real`; `y:real`] REAL_LT_TOTAL) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `x pow (SUC n) = y pow (SUC n)` THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THENL + [ALL_TAC; CONV_TAC(RAND_CONV SYM_CONV)] THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + MATCH_MP_TAC POW_LT THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Basic differentiation theorems --- none yet. *) +(* ------------------------------------------------------------------------- *) + +let diff_net = ref empty_net;; + +let add_to_diff_net th = + let t = lhand(rator(rand(concl th))) in + let net = !diff_net in + let net' = enter [] (t,PART_MATCH (lhand o rator o rand) th) net in + diff_net := net';; + +(* ------------------------------------------------------------------------ *) +(* The three functions we define by series are exp, sin, cos *) +(* ------------------------------------------------------------------------ *) + +let exp = new_definition + `exp(x) = suminf(\n. ((\n. inv(&(FACT n)))) n * (x pow n))`;; + +let sin = new_definition + `sin(x) = suminf(\n. ((\n. if EVEN n then &0 else + ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n))`;; + +let cos = new_definition + `cos(x) = suminf(\n. ((\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) + else &0)) n * (x pow n))`;; + +(* ------------------------------------------------------------------------ *) +(* Show the series for exp converges, using the ratio test *) +(* ------------------------------------------------------------------------ *) + +let REAL_EXP_CONVERGES = prove( + `!x. (\n. ((\n. inv(&(FACT n)))) n * (x pow n)) sums exp(x)`, + let fnz tm = + (GSYM o MATCH_MP REAL_LT_IMP_NE o + REWRITE_RULE[GSYM REAL_LT] o C SPEC FACT_LT) tm in + GEN_TAC THEN REWRITE_TAC[exp] THEN MATCH_MP_TAC SUMMABLE_SUM THEN + MATCH_MP_TAC SER_RATIO THEN + MP_TAC (SPEC `&1` REAL_DOWN) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `c:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `abs(x)`) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + BETA_TAC THEN + REWRITE_TAC[ADD1; POW_ADD; ABS_MUL; REAL_MUL_ASSOC; POW_1] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL_IMP THEN + REWRITE_TAC[ABS_POS] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN + REWRITE_TAC[GSYM REAL_MUL; MATCH_MP REAL_INV_MUL_WEAK (CONJ + (REWRITE_RULE[GSYM REAL_INJ] (SPEC `n:num` NOT_SUC)) (fnz `n:num`))] THEN + REWRITE_TAC[ABS_MUL; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN + MP_TAC(SPEC `n:num` LT_0) THEN REWRITE_TAC[GSYM REAL_LT] THEN + DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP REAL_LT_IMP_NE) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ABS_INV th]) THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LE_LDIV THEN + ASM_REWRITE_TAC[GSYM ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REWRITE_RULE[GSYM ABS_REFL; GSYM REAL_LE] LE_0] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N * c` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_LE_RMUL_EQ th]) THEN + REWRITE_TAC[REAL_LE] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]]);; + +(* ------------------------------------------------------------------------ *) +(* Show by the comparison test that sin and cos converge *) +(* ------------------------------------------------------------------------ *) + +let SIN_CONVERGES = prove( + `!x. (\n. ((\n. if EVEN n then &0 else + ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n)) sums + sin(x)`, + GEN_TAC THEN REWRITE_TAC[sin] THEN MATCH_MP_TAC SUMMABLE_SUM THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. ((\n. inv(&(FACT n)))) n * (abs(x) pow n)` THEN + REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[ABS_MUL; POW_ABS] THENL + [REWRITE_TAC[ABS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[ABS_POS]; + REWRITE_TAC[real_div; ABS_MUL; POW_M1; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]] THEN + MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE; REAL_INV_POS] THEN + REWRITE_TAC[REAL_LT; FACT_LT]);; + +let COS_CONVERGES = prove( + `!x. (\n. ((\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)) n + * (x pow n)) sums cos(x)`, + GEN_TAC THEN REWRITE_TAC[cos] THEN MATCH_MP_TAC SUMMABLE_SUM THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. ((\n. inv(&(FACT n)))) n * (abs(x) pow n)` THEN + REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[ABS_MUL; POW_ABS] THENL + [REWRITE_TAC[real_div; ABS_MUL; POW_M1; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL_IMP THEN REWRITE_TAC[ABS_POS] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[ABS_REFL]; + REWRITE_TAC[ABS_0; REAL_MUL_LZERO] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[ABS_POS]] THEN + MAP_EVERY MATCH_MP_TAC [REAL_LT_IMP_LE; REAL_INV_POS] THEN + REWRITE_TAC[REAL_LT; FACT_LT]);; + +(* ------------------------------------------------------------------------ *) +(* Show what the formal derivatives of these series are *) +(* ------------------------------------------------------------------------ *) + +let REAL_EXP_FDIFF = prove( + `diffs (\n. inv(&(FACT n))) = (\n. inv(&(FACT n)))`, + REWRITE_TAC[diffs] THEN BETA_TAC THEN + CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN + REWRITE_TAC[FACT; GSYM REAL_MUL] THEN + SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL + [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + REWRITE_TAC[REAL_LT; LT_0; FACT_LT]; + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN + MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);; + +let SIN_FDIFF = prove( + `diffs (\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / &(FACT n)) + = (\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0)`, + REWRITE_TAC[diffs] THEN BETA_TAC THEN + CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN + COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[SUC_SUB1] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[FACT; GSYM REAL_MUL] THEN + SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL + [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + REWRITE_TAC[REAL_LT; LT_0; FACT_LT]; + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN + MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]);; + +let COS_FDIFF = prove( + `diffs (\n. if EVEN n then ((--(&1)) pow (n DIV 2)) / &(FACT n) else &0) = + (\n. --(((\n. if EVEN n then &0 else ((--(&1)) pow ((n - 1) DIV 2)) / + &(FACT n))) n))`, + REWRITE_TAC[diffs] THEN BETA_TAC THEN + CONV_TAC(X_FUN_EQ_CONV `n:num`) THEN GEN_TAC THEN BETA_TAC THEN + COND_CASES_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[EVEN]) THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_NEG_LMUL] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN BINOP_TAC THENL + [POP_ASSUM(SUBST1_TAC o MATCH_MP EVEN_DIV2) THEN + REWRITE_TAC[pow] THEN REWRITE_TAC[GSYM REAL_NEG_MINUS1]; + REWRITE_TAC[FACT; GSYM REAL_MUL] THEN + SUBGOAL_THEN `~(&(SUC n) = &0) /\ ~(&(FACT n) = &0)` ASSUME_TAC THENL + [CONJ_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN + REWRITE_TAC[REAL_LT; LT_0; FACT_LT]; + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_MUL_WEAK th]) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_RMUL] THEN DISJ2_TAC THEN + MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------ *) +(* Now at last we can get the derivatives of exp, sin and cos *) +(* ------------------------------------------------------------------------ *) + +let SIN_NEGLEMMA = prove( + `!x. --(sin x) = suminf (\n. --(((\n. if EVEN n then &0 else ((--(&1)) + pow ((n - 1) DIV 2)) / &(FACT n))) n * (x pow n)))`, + GEN_TAC THEN MATCH_MP_TAC SUM_UNIQ THEN + MP_TAC(MATCH_MP SER_NEG (SPEC `x:real` SIN_CONVERGES)) THEN + BETA_TAC THEN DISCH_THEN ACCEPT_TAC);; + +let DIFF_EXP = prove( + `!x. (exp diffl exp(x))(x)`, + GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS exp] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_EXP_FDIFF] THEN + CONV_TAC(LAND_CONV BETA_CONV) THEN + MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN + REWRITE_TAC[REAL_EXP_FDIFF; MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN + REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN + REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]);; + +let DIFF_SIN = prove( + `!x. (sin diffl cos(x))(x)`, + GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS sin; cos] THEN + ONCE_REWRITE_TAC[GSYM SIN_FDIFF] THEN + MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL SIN_CONVERGES)]; + REWRITE_TAC[SIN_FDIFF; MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)]; + REWRITE_TAC[SIN_FDIFF; COS_FDIFF] THEN BETA_TAC THEN + MP_TAC(SPEC `abs(x) + &1` SIN_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL]; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN + REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN + REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]]);; + +let DIFF_COS = prove( + `!x. (cos diffl --(sin(x)))(x)`, + GEN_TAC THEN REWRITE_TAC[HALF_MK_ABS cos; SIN_NEGLEMMA] THEN + ONCE_REWRITE_TAC[REAL_NEG_LMUL] THEN + REWRITE_TAC[GSYM(CONV_RULE(RAND_CONV BETA_CONV) + (AP_THM COS_FDIFF `n:num`))] THEN + MATCH_MP_TAC TERMDIFF THEN EXISTS_TAC `abs(x) + &1` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL COS_CONVERGES)]; + REWRITE_TAC[COS_FDIFF] THEN + MP_TAC(SPEC `abs(x) + &1` SIN_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL]; + REWRITE_TAC[COS_FDIFF; DIFFS_NEG] THEN + MP_TAC SIN_FDIFF THEN BETA_TAC THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MP_TAC(SPEC `abs(x) + &1` COS_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN BETA_TAC THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL]; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `abs(x) + &1` THEN + REWRITE_TAC[ABS_LE; REAL_LT_ADDR] THEN + REWRITE_TAC[REAL_LT; num_CONV `1`; LT_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiation conversion. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_CONV = + let lookup_expr tm = + tryfind (fun f -> f tm) (lookup tm (!diff_net)) in + let v = `x:real` and k = `k:real` and diffl_tm = `(diffl)` in + let DIFF_var = SPEC v DIFF_X + and DIFF_const = SPECL [k;v] DIFF_CONST in + let uneta_CONV = REWR_CONV (GSYM ETA_AX) in + let rec DIFF_CONV tm = + if not (is_abs tm) then + let th0 = uneta_CONV tm in + let th1 = DIFF_CONV (rand(concl th0)) in + CONV_RULE (RATOR_CONV(LAND_CONV(K(SYM th0)))) th1 else + let x,bod = dest_abs tm in + if bod = x then INST [x,v] DIFF_var + else if not(free_in x bod) then INST [bod,k; x,v] DIFF_const else + let th = lookup_expr tm in + let hyp = fst(dest_imp(concl th)) in + let hyps = conjuncts hyp in + let dhyps,sides = partition + (fun t -> try funpow 3 rator t = diffl_tm + with Failure _ -> false) hyps in + let tha = CONJ_ACI_RULE(mk_eq(hyp,list_mk_conj(dhyps@sides))) in + let thb = CONV_RULE (LAND_CONV (K tha)) th in + let dths = map (DIFF_CONV o lhand o rator) dhyps in + MATCH_MP thb (end_itlist CONJ (dths @ map ASSUME sides)) in + fun tm -> + let xv = try bndvar tm with Failure _ -> v in + GEN xv (DISCH_ALL(DIFF_CONV tm));; + +(* ------------------------------------------------------------------------- *) +(* Processed versions of composition theorems. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_COMPOSITE = prove + (`((f diffl l)(x) /\ ~(f(x) = &0) ==> + ((\x. inv(f x)) diffl --(l / (f(x) pow 2)))(x)) /\ + ((f diffl l)(x) /\ (g diffl m)(x) /\ ~(g(x) = &0) ==> + ((\x. f(x) / g(x)) diffl (((l * g(x)) - (m * f(x))) / (g(x) pow 2)))(x)) /\ + ((f diffl l)(x) /\ (g diffl m)(x) ==> + ((\x. f(x) + g(x)) diffl (l + m))(x)) /\ + ((f diffl l)(x) /\ (g diffl m)(x) ==> + ((\x. f(x) * g(x)) diffl ((l * g(x)) + (m * f(x))))(x)) /\ + ((f diffl l)(x) /\ (g diffl m)(x) ==> + ((\x. f(x) - g(x)) diffl (l - m))(x)) /\ + ((f diffl l)(x) ==> ((\x. --(f x)) diffl --l)(x)) /\ + ((g diffl m)(x) ==> + ((\x. (g x) pow n) diffl ((&n * (g x) pow (n - 1)) * m))(x)) /\ + ((g diffl m)(x) ==> ((\x. exp(g x)) diffl (exp(g x) * m))(x)) /\ + ((g diffl m)(x) ==> ((\x. sin(g x)) diffl (cos(g x) * m))(x)) /\ + ((g diffl m)(x) ==> ((\x. cos(g x)) diffl (--(sin(g x)) * m))(x))`, + REWRITE_TAC[DIFF_INV; DIFF_DIV; DIFF_ADD; DIFF_SUB; DIFF_MUL; DIFF_NEG] THEN + REPEAT CONJ_TAC THEN DISCH_TAC THEN + TRY(MATCH_MP_TAC DIFF_CHAIN THEN + ASM_REWRITE_TAC[DIFF_SIN; DIFF_COS; DIFF_EXP]) THEN + MATCH_MP_TAC(BETA_RULE (SPEC `\x. x pow n` DIFF_CHAIN)) THEN + ASM_REWRITE_TAC[DIFF_POW]);; + +do_list add_to_diff_net (CONJUNCTS DIFF_COMPOSITE);; + +(* ------------------------------------------------------------------------- *) +(* Tactic for goals "(f diffl l) x" *) +(* ------------------------------------------------------------------------- *) + +let DIFF_TAC = + W(fun (asl,w) -> MP_TAC(SPEC(rand w) (DIFF_CONV(lhand(rator w)))) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Prove differentiability terms. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_RULE = + let pth = prove + (`(f diffl l) x ==> f differentiable x`, MESON_TAC[differentiable]) in + let match_pth = MATCH_MP pth in + fun tm -> + let tb,y = dest_comb tm in + let tm' = rand tb in + match_pth (SPEC y (DIFF_CONV tm'));; + +let DIFFERENTIABLE_CONV = EQT_INTRO o DIFFERENTIABLE_RULE;; + +(* ------------------------------------------------------------------------- *) +(* Prove continuity via differentiability (weak but useful). *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_RULE = + let pth = prove + (`!f x. f differentiable x ==> f contl x`, + MESON_TAC[differentiable; DIFF_CONT]) in + let match_pth = PART_MATCH rand pth in + fun tm -> + let th1 = match_pth tm in + MP th1 (DIFFERENTIABLE_RULE(lhand(concl th1)));; + +let CONTINUOUS_CONV = EQT_INTRO o CONTINUOUS_RULE;; + +(* ------------------------------------------------------------------------ *) +(* Properties of the exponential function *) +(* ------------------------------------------------------------------------ *) + +let REAL_EXP_0 = prove( + `exp(&0) = &1`, + REWRITE_TAC[exp] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN + W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[num_CONV `1`; sum] THEN + REWRITE_TAC[ADD_CLAUSES; REAL_ADD_LID] THEN BETA_TAC THEN + REWRITE_TAC[FACT; pow; REAL_MUL_RID; REAL_INV1] THEN + REWRITE_TAC[SYM(num_CONV `1`)] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[num_CONV `1`; LE_SUC_LT] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; ADD_CLAUSES]);; + +let REAL_EXP_LE_X = prove( + `!x. &0 <= x ==> (&1 + x) <= exp(x)`, + GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [MP_TAC(SPECL [`\n. ((\n. inv(&(FACT n)))) n * (x pow n)`; `2`] + SER_POS_LE) THEN + REWRITE_TAC[MATCH_MP SUM_SUMMABLE (SPEC_ALL REAL_EXP_CONVERGES)] THEN + REWRITE_TAC[GSYM exp] THEN BETA_TAC THEN + W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_INV_POS THEN + REWRITE_TAC[REAL_LT; FACT_LT]; + MATCH_MP_TAC POW_POS THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_ASSUM ACCEPT_TAC]; + CONV_TAC(TOP_DEPTH_CONV num_CONV) THEN REWRITE_TAC[sum] THEN + BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; pow; REAL_ADD_LID] THEN + REWRITE_TAC[MULT_CLAUSES; REAL_INV1; REAL_MUL_LID; ADD_CLAUSES] THEN + REWRITE_TAC[REAL_MUL_RID; SYM(num_CONV `1`)]]; + POP_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_EXP_0; REAL_ADD_RID; REAL_LE_REFL]]);; + +let REAL_EXP_LT_1 = prove( + `!x. &0 < x ==> &1 < exp(x)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 + x` THEN ASM_REWRITE_TAC[REAL_LT_ADDR] THEN + MATCH_MP_TAC REAL_EXP_LE_X THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + POP_ASSUM ACCEPT_TAC);; + +let REAL_EXP_ADD_MUL = prove( + `!x y. exp(x + y) * exp(--x) = exp(y)`, + REPEAT GEN_TAC THEN + CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN + SUBGOAL_THEN `exp(y) = (\x. exp(x + y) * exp(--x))(&0)` SUBST1_TAC THENL + [BETA_TAC THEN REWRITE_TAC[REAL_ADD_LID; REAL_NEG_0] THEN + REWRITE_TAC[REAL_EXP_0; REAL_MUL_RID]; + MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC `x:real` THEN + W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[GSYM real_sub; REAL_SUB_0; REAL_MUL_RID; REAL_ADD_RID] THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM]);; + +let REAL_EXP_NEG_MUL = prove( + `!x. exp(x) * exp(--x) = &1`, + GEN_TAC THEN MP_TAC(SPECL [`x:real`; `&0`] REAL_EXP_ADD_MUL) THEN + REWRITE_TAC[REAL_ADD_RID; REAL_EXP_0]);; + +let REAL_EXP_NEG_MUL2 = prove( + `!x. exp(--x) * exp(x) = &1`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EXP_NEG_MUL);; + +let REAL_EXP_NEG = prove( + `!x. exp(--x) = inv(exp(x))`, + GEN_TAC THEN MATCH_MP_TAC REAL_RINV_UNIQ THEN + MATCH_ACCEPT_TAC REAL_EXP_NEG_MUL);; + +let REAL_EXP_ADD = prove( + `!x y. exp(x + y) = exp(x) * exp(y)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`x:real`; `y:real`] REAL_EXP_ADD_MUL) THEN + DISCH_THEN(MP_TAC o C AP_THM `exp(x)` o AP_TERM `(*)`) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_EXP_NEG_MUL; REAL_MUL_RID] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; + +let REAL_EXP_POS_LE = prove( + `!x. &0 <= exp(x)`, + GEN_TAC THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN + REWRITE_TAC[REAL_EXP_ADD] THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE);; + +let REAL_EXP_NZ = prove( + `!x. ~(exp(x) = &0)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_EXP_NEG_MUL) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_ACCEPT_TAC REAL_10);; + +let REAL_EXP_POS_LT = prove( + `!x. &0 < exp(x)`, + GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + REWRITE_TAC[REAL_EXP_POS_LE; REAL_EXP_NZ]);; + +let REAL_EXP_N = prove( + `!n x. exp(&n * x) = exp(x) pow n`, + INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_EXP_0; pow] THEN + REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_ADD; REAL_EXP_ADD; REAL_RDISTRIB] THEN + GEN_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_EXP_SUB = prove( + `!x y. exp(x - y) = exp(x) / exp(y)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_sub; real_div; REAL_EXP_ADD; REAL_EXP_NEG]);; + +let REAL_EXP_MONO_IMP = prove( + `!x y. x < y ==> exp(x) < exp(y)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o + MATCH_MP REAL_EXP_LT_1 o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN + REWRITE_TAC[REAL_EXP_SUB] THEN + SUBGOAL_THEN `&1 < exp(y) / exp(x) <=> + (&1 * exp(x)) < ((exp(y) / exp(x)) * exp(x))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_LT_RMUL_EQ THEN + MATCH_ACCEPT_TAC REAL_EXP_POS_LT; + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_EXP_NEG_MUL2; + GSYM REAL_EXP_NEG] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]]);; + +let REAL_EXP_MONO_LT = prove( + `!x y. exp(x) < exp(y) <=> x < y`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[REAL_NOT_LT] THEN + REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC SUBST1_TAC) THEN + REWRITE_TAC[] THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_EXP_MONO_IMP THEN + POP_ASSUM ACCEPT_TAC; + MATCH_ACCEPT_TAC REAL_EXP_MONO_IMP]);; + +let REAL_EXP_MONO_LE = prove( + `!x y. exp(x) <= exp(y) <=> x <= y`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + REWRITE_TAC[REAL_EXP_MONO_LT]);; + +let REAL_EXP_INJ = prove( + `!x y. (exp(x) = exp(y)) <=> (x = y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + REWRITE_TAC[REAL_EXP_MONO_LE]);; + +let REAL_EXP_TOTAL_LEMMA = prove( + `!y. &1 <= y ==> ?x. &0 <= x /\ x <= y - &1 /\ (exp(x) = y)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC IVT THEN + ASM_REWRITE_TAC[REAL_EXP_0; REAL_LE_SUB_LADD; REAL_ADD_LID] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM REAL_SUB_LE]) THEN + POP_ASSUM(MP_TAC o MATCH_MP REAL_EXP_LE_X) THEN REWRITE_TAC[REAL_SUB_ADD2]; + X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `exp(x)` THEN + MATCH_ACCEPT_TAC DIFF_EXP]);; + +let REAL_EXP_TOTAL = prove( + `!y. &0 < y ==> ?x. exp(x) = y`, + GEN_TAC THEN DISCH_TAC THEN + DISJ_CASES_TAC(SPECL [`&1`; `y:real`] REAL_LET_TOTAL) THENL + [FIRST_ASSUM(X_CHOOSE_TAC `x:real` o MATCH_MP REAL_EXP_TOTAL_LEMMA) THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; + MP_TAC(SPEC `y:real` REAL_INV_LT1) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + DISCH_THEN(X_CHOOSE_TAC `x:real` o MATCH_MP REAL_EXP_TOTAL_LEMMA) THEN + EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[REAL_EXP_NEG] THEN + MATCH_MP_TAC REAL_INVINV THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN ASM_REWRITE_TAC[]]);; + +let REAL_EXP_BOUND_LEMMA = prove + (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `suminf (\n. x pow n)` THEN CONJ_TAC THENL + [REWRITE_TAC[exp; BETA_THM] THEN MATCH_MP_TAC SER_LE THEN + REWRITE_TAC[summable; BETA_THM] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL_IMP THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INV_LE_1 THEN + REWRITE_TAC[REAL_OF_NUM_LE; num_CONV `1`; LE_SUC_LT] THEN + REWRITE_TAC[FACT_LT]]; + EXISTS_TAC `exp x` THEN REWRITE_TAC[BETA_RULE REAL_EXP_CONVERGES]; + EXISTS_TAC `inv(&1 - x)` THEN MATCH_MP_TAC GP THEN + ASM_REWRITE_TAC[real_abs] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; + SUBGOAL_THEN `suminf (\n. x pow n) = inv (&1 - x)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN + MATCH_MP_TAC GP THEN + ASM_REWRITE_TAC[real_abs] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2)` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `&1 - x` THEN + SUBGOAL_THEN `(&1 - x) * inv (&1 - x) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN + REWRITE_TAC[REAL_ARITH `(&1 - x = &0) <=> (x = &1)`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV; + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `inv(&2) - x` THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= x - y <=> y <= x`] THEN + ASM_REWRITE_TAC[REAL_ARITH `a - x < b - x <=> a < b`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `&1 <= (&1 + &2 * x) - (x + x * &2 * x) <=> + x * (&2 * x) <= x * &1`] THEN + MATCH_MP_TAC REAL_LE_LMUL_IMP THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `inv(&2)` THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[REAL_MUL_LID; real_div]]]]]);; + +(* ------------------------------------------------------------------------ *) +(* Properties of the logarithmic function *) +(* ------------------------------------------------------------------------ *) + +let ln = new_definition + `ln x = @u. exp(u) = x`;; + +let LN_EXP = prove( + `!x. ln(exp x) = x`, + GEN_TAC THEN REWRITE_TAC[ln; REAL_EXP_INJ] THEN + CONV_TAC SYM_CONV THEN CONV_TAC(RAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN MATCH_MP_TAC SELECT_AX THEN + EXISTS_TAC `x:real` THEN REFL_TAC);; + +let REAL_EXP_LN = prove( + `!x. (exp(ln x) = x) <=> &0 < x`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_EXP_POS_LT; + DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC o MATCH_MP REAL_EXP_TOTAL) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_EXP_INJ; LN_EXP]]);; + +let EXP_LN = prove + (`!x. &0 < x ==> exp(ln x) = x`, + REWRITE_TAC[REAL_EXP_LN]);; + +let LN_MUL = prove( + `!x y. &0 < x /\ &0 < y ==> (ln(x * y) = ln(x) + ln(y))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + REWRITE_TAC[REAL_EXP_ADD] THEN SUBGOAL_THEN `&0 < x * y` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; + EVERY_ASSUM(fun th -> REWRITE_TAC[ONCE_REWRITE_RULE[GSYM REAL_EXP_LN] th])]);; + +let LN_INJ = prove( + `!x y. &0 < x /\ &0 < y ==> ((ln(x) = ln(y)) <=> (x = y))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN + CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_INJ);; + +let LN_1 = prove( + `ln(&1) = &0`, + ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + REWRITE_TAC[REAL_EXP_0; REAL_EXP_LN; REAL_LT_01]);; + +let LN_INV = prove( + `!x. &0 < x ==> (ln(inv x) = --(ln x))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM REAL_RNEG_UNIQ] THEN + SUBGOAL_THEN `&0 < x /\ &0 < inv(x)` MP_TAC THENL + [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP LN_MUL th)]) THEN + SUBGOAL_THEN `x * (inv x) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN + POP_ASSUM(ACCEPT_TAC o MATCH_MP REAL_POS_NZ); + REWRITE_TAC[LN_1]]]);; + +let LN_DIV = prove( + `!x. &0 < x /\ &0 < y ==> (ln(x / y) = ln(x) - ln(y))`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < x /\ &0 < inv(y)` MP_TAC THENL + [CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_INV_POS) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[real_div] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP LN_MUL th]) THEN + REWRITE_TAC[MATCH_MP LN_INV (ASSUME `&0 < y`)] THEN + REWRITE_TAC[real_sub]]);; + +let LN_MONO_LT = prove( + `!x y. &0 < x /\ &0 < y ==> (ln(x) < ln(y) <=> x < y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN + CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_MONO_LT);; + +let LN_MONO_LE = prove( + `!x y. &0 < x /\ &0 < y ==> (ln(x) <= ln(y) <=> x <= y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + EVERY_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [SYM(REWRITE_RULE[GSYM REAL_EXP_LN] th)]) THEN + CONV_TAC SYM_CONV THEN MATCH_ACCEPT_TAC REAL_EXP_MONO_LE);; + +let LN_POW = prove( + `!n x. &0 < x ==> (ln(x pow n) = &n * ln(x))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CHOOSE_THEN (SUBST1_TAC o SYM) o MATCH_MP REAL_EXP_TOTAL) THEN + REWRITE_TAC[GSYM REAL_EXP_N; LN_EXP]);; + +let LN_LE = prove( + `!x. &0 <= x ==> ln(&1 + x) <= x`, + GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM LN_EXP] THEN + MP_TAC(SPECL [`&1 + x`; `exp(x)`] LN_MONO_LE) THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 (fst o dest_imp) o snd) THENL + [REWRITE_TAC[REAL_EXP_POS_LT] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01]; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EXP_LE_X THEN ASM_REWRITE_TAC[]]);; + +let LN_LT_X = prove( + `!x. &0 < x ==> ln(x) < x`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `ln(&1 + x)` THEN CONJ_TAC THENL + [IMP_SUBST_TAC LN_MONO_LT THEN + ASM_REWRITE_TAC[REAL_LT_ADDL; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LT_ADD THEN ASM_REWRITE_TAC[REAL_LT_01]; + MATCH_MP_TAC LN_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_REWRITE_TAC[]]);; + +let LN_POS = prove + (`!x. &1 <= x ==> &0 <= ln(x)`, + REWRITE_TAC[GSYM LN_1] THEN + SIMP_TAC[LN_MONO_LE; ARITH_RULE `&1 <= x ==> &0 < x`; REAL_LT_01]);; + +let LN_POS_LT = prove + (`!x. &1 < x ==> &0 < ln(x)`, + REWRITE_TAC[GSYM LN_1] THEN + SIMP_TAC[LN_MONO_LT; ARITH_RULE `&1 < x ==> &0 < x`; REAL_LT_01]);; + +let DIFF_LN = prove( + `!x. &0 < x ==> (ln diffl (inv x))(x)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[GSYM REAL_EXP_LN]) THEN + FIRST_ASSUM (fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC DIFF_INVERSE_LT THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_POS_NZ) THEN + ASM_REWRITE_TAC[MATCH_MP DIFF_CONT (SPEC_ALL DIFF_EXP)] THEN + MP_TAC(SPEC `ln(x)` DIFF_EXP) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[LN_EXP] THEN + EXISTS_TAC `&1` THEN MATCH_ACCEPT_TAC REAL_LT_01);; + +(* ------------------------------------------------------------------------ *) +(* Some properties of roots (easier via logarithms) *) +(* ------------------------------------------------------------------------ *) + +let root = new_definition + `root(n) x = @u. (&0 < x ==> &0 < u) /\ (u pow n = x)`;; + +let sqrt_def = new_definition + `sqrt(x) = @y. &0 <= y /\ (y pow 2 = x)`;; + +let sqrt = prove + (`sqrt(x) = root(2) x`, + REWRITE_TAC[root; sqrt_def] THEN + AP_TERM_TAC THEN REWRITE_TAC[BETA_THM; FUN_EQ_THM] THEN + X_GEN_TAC `y:real` THEN ASM_CASES_TAC `x = y pow 2` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_2; REAL_LT_SQUARE] THEN REAL_ARITH_TAC);; + +let ROOT_LT_LEMMA = prove( + `!n x. &0 < x ==> (exp(ln(x) / &(SUC n)) pow (SUC n) = x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_EXP_N] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(&(SUC n)) * &(SUC n) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_EXP_LN]]);; + +let ROOT_LN = prove( + `!x. &0 < x ==> !n. root(SUC n) x = exp(ln(x) / &(SUC n))`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[root] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN BETA_TAC THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + SUBGOAL_THEN `!z. &0 < y /\ &0 < exp(z)` MP_TAC THENL + [ASM_REWRITE_TAC[REAL_EXP_POS_LT]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o GEN_ALL o SYM o MATCH_MP LN_INJ o SPEC_ALL) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC I [th]) THEN + REWRITE_TAC[LN_EXP] THEN + SUBGOAL_THEN `ln(y) * &(SUC n) = (ln(y pow(SUC n)) / &(SUC n)) * &(SUC n)` + MP_TAC THENL + [REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(&(SUC n)) * &(SUC n) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; + REWRITE_TAC[REAL_MUL_RID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC LN_POW THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_EQ_RMUL; REAL_INJ; NOT_SUC]]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_EXP_POS_LT] THEN + MATCH_MP_TAC ROOT_LT_LEMMA THEN ASM_REWRITE_TAC[]]);; + +let ROOT_0 = prove( + `!n. root(SUC n) (&0) = &0`, + GEN_TAC THEN REWRITE_TAC[root] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `y:real` THEN + BETA_TAC THEN REWRITE_TAC[REAL_LT_REFL] THEN EQ_TAC THENL + [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[pow] THENL + [REWRITE_TAC[pow; REAL_MUL_RID]; + REWRITE_TAC[REAL_ENTIRE] THEN DISCH_THEN DISJ_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[pow; REAL_MUL_LZERO]]);; + +let ROOT_1 = prove( + `!n. root(SUC n) (&1) = &1`, + GEN_TAC THEN REWRITE_TAC[MATCH_MP ROOT_LN REAL_LT_01] THEN + REWRITE_TAC[LN_1; REAL_DIV_LZERO; REAL_EXP_0]);; + +let ROOT_POW_POS = prove( + `!n x. &0 <= x ==> ((root(SUC n) x) pow (SUC n) = x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC + [MATCH_MP ROOT_LN th; MATCH_MP ROOT_LT_LEMMA th]); + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN + MATCH_ACCEPT_TAC POW_0]);; + +let POW_ROOT_POS = prove( + `!n x. &0 <= x ==> (root(SUC n)(x pow (SUC n)) = x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[root] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `y:real` THEN BETA_TAC THEN EQ_TAC THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THENL + [DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `&0 <= x`)) THENL + [DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_POS_LT th]) THEN + DISCH_TAC THEN MATCH_MP_TAC POW_EQ THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_conj o concl) THEN + REWRITE_TAC[POW_0; REAL_LT_REFL; POW_ZERO]]; + ASM_REWRITE_TAC[REAL_LT_LE] THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[POW_0]]);; + +let ROOT_POS_POSITIVE = prove + (`!x n. &0 <= x ==> &0 <= root(SUC n) x`, + REPEAT GEN_TAC THEN + DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ROOT_LN th]) THEN + REWRITE_TAC[REAL_EXP_POS_LE]; + POP_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[ROOT_0] THEN + REWRITE_TAC[REAL_LE_REFL]]);; + +let ROOT_POS_UNIQ = prove + (`!n x y. &0 <= x /\ &0 <= y /\ (y pow (SUC n) = x) + ==> (root (SUC n) x = y)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN + ASM_SIMP_TAC[POW_ROOT_POS]);; + +let ROOT_MUL = prove + (`!n x y. &0 <= x /\ &0 <= y + ==> (root(SUC n) (x * y) = root(SUC n) x * root(SUC n) y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN + ASM_SIMP_TAC[REAL_POW_MUL; ROOT_POW_POS; REAL_LE_MUL; + ROOT_POS_POSITIVE]);; + +let ROOT_INV = prove + (`!n x. &0 <= x ==> (root(SUC n) (inv x) = inv(root(SUC n) x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ROOT_POS_UNIQ THEN + ASM_SIMP_TAC[REAL_LE_INV; ROOT_POS_POSITIVE; REAL_POW_INV; + ROOT_POW_POS]);; + +let ROOT_DIV = prove + (`!n x y. &0 <= x /\ &0 <= y + ==> (root(SUC n) (x / y) = root(SUC n) x / root(SUC n) y)`, + SIMP_TAC[real_div; ROOT_MUL; ROOT_INV; REAL_LE_INV]);; + +let ROOT_MONO_LT = prove + (`!x y. &0 <= x /\ x < y ==> root(SUC n) x < root(SUC n) y`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= y` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN + UNDISCH_TAC `x < y` THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `(x = (root(SUC n) x) pow (SUC n)) /\ + (y = (root(SUC n) y) pow (SUC n))` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [ASM_SIMP_TAC[GSYM ROOT_POW_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[NOT_SUC; ROOT_POS_POSITIVE]);; + +let ROOT_MONO_LE = prove + (`!x y. &0 <= x /\ x <= y ==> root(SUC n) x <= root(SUC n) y`, + MESON_TAC[ROOT_MONO_LT; REAL_LE_LT]);; + +let ROOT_MONO_LT_EQ = prove + (`!x y. &0 <= x /\ &0 <= y ==> (root(SUC n) x < root(SUC n) y <=> x < y)`, + MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; + +let ROOT_MONO_LE_EQ = prove + (`!x y. &0 <= x /\ &0 <= y ==> (root(SUC n) x <= root(SUC n) y <=> x <= y)`, + MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; + +let ROOT_INJ = prove + (`!x y. &0 <= x /\ &0 <= y ==> ((root(SUC n) x = root(SUC n) y) <=> (x = y))`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; ROOT_MONO_LE_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of square roots. *) +(* ------------------------------------------------------------------------- *) + +let SQRT_0 = prove( + `sqrt(&0) = &0`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_0]);; + +let SQRT_1 = prove( + `sqrt(&1) = &1`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_1]);; + +let SQRT_POS_LT = prove + (`!x. &0 < x ==> &0 < sqrt(x)`, + SIMP_TAC[sqrt; num_CONV `2`; ROOT_LN; REAL_EXP_POS_LT]);; + +let SQRT_POS_LE = prove + (`!x. &0 <= x ==> &0 <= sqrt(x)`, + REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SQRT_POS_LT; SQRT_0]);; + +let SQRT_POW2 = prove( + `!x. (sqrt(x) pow 2 = x) <=> &0 <= x`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_ACCEPT_TAC REAL_LE_SQUARE_POW; + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_POW_POS]]);; + +let SQRT_POW_2 = prove + (`!x. &0 <= x ==> (sqrt(x) pow 2 = x)`, + REWRITE_TAC[SQRT_POW2]);; + +let POW_2_SQRT = prove + (`&0 <= x ==> (sqrt(x pow 2) = x)`, + SIMP_TAC[sqrt; num_CONV `2`; POW_ROOT_POS]);; + +let SQRT_POS_UNIQ = prove + (`!x y. &0 <= x /\ &0 <= y /\ (y pow 2 = x) + ==> (sqrt x = y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_POS_UNIQ]);; + +let SQRT_MUL = prove + (`!x y. &0 <= x /\ &0 <= y + ==> (sqrt(x * y) = sqrt x * sqrt y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MUL]);; + +let SQRT_INV = prove + (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_INV]);; + +let SQRT_DIV = prove + (`!x y. &0 <= x /\ &0 <= y + ==> (sqrt (x / y) = sqrt x / sqrt y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_DIV]);; + +let SQRT_MONO_LT = prove + (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LT]);; + +let SQRT_MONO_LE = prove + (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LE]);; + +let SQRT_MONO_LT_EQ = prove + (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LT_EQ]);; + +let SQRT_MONO_LE_EQ = prove + (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_MONO_LE_EQ]);; + +let SQRT_INJ = prove + (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`, + REWRITE_TAC[sqrt; num_CONV `2`; ROOT_INJ]);; + +let SQRT_EVEN_POW2 = prove + (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`, + GEN_TAC THEN REWRITE_TAC[EVEN_MOD] THEN DISCH_TAC THEN + MATCH_MP_TAC SQRT_POS_UNIQ THEN + SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_POW_POW] THEN + AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [MATCH_MP DIVISION (ARITH_RULE `~(2 = 0)`)] THEN + ASM_REWRITE_TAC[ADD_CLAUSES]);; + +let REAL_DIV_SQRT = prove + (`!x. &0 <= x ==> (x / sqrt(x) = sqrt(x))`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[SQRT_0; real_div; REAL_MUL_LZERO]; ALL_TAC] THEN + DISCH_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_POS_UNIQ THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_DIV] THEN + REWRITE_TAC[real_div; REAL_POW_MUL; REAL_POW_INV] THEN + ASM_SIMP_TAC[SQRT_POW_2] THEN + REWRITE_TAC[REAL_POW_2; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID]);; + +let POW_2_SQRT_ABS = prove + (`!x. sqrt(x pow 2) = abs(x)`, + GEN_TAC THEN DISJ_CASES_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THENL + [ASM_SIMP_TAC[real_abs; POW_2_SQRT]; + SUBST1_TAC(SYM(SPEC `x:real` REAL_NEG_NEG)) THEN + ONCE_REWRITE_TAC[REAL_ABS_NEG; REAL_POW_NEG] THEN + ASM_SIMP_TAC[POW_2_SQRT; real_abs; ARITH_EVEN]]);; + +let SQRT_EQ_0 = prove + (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`, + MESON_TAC[SQRT_INJ; SQRT_0; REAL_LE_REFL]);; + +let REAL_LE_LSQRT = prove + (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, + MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);; + +let REAL_LE_POW_2 = prove + (`!x. &0 <= x pow 2`, + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; + +let REAL_LE_RSQRT = prove + (`!x y. x pow 2 <= y ==> x <= sqrt(y)`, + MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; + REAL_LE_POW_2; REAL_LE_TRANS; POW_2_SQRT]);; + +(* ------------------------------------------------------------------------- *) +(* Derivative of sqrt (could do the other roots with a bit more care). *) +(* ------------------------------------------------------------------------- *) + +let DIFF_SQRT = prove + (`!x. &0 < x ==> (sqrt diffl inv(&2 * sqrt(x))) x`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x. x pow 2`; `sqrt`; `&2 * sqrt(x)`; `sqrt(x)`; `sqrt(x)`] + DIFF_INVERSE_LT) THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; BETA_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[SQRT_POS_LT; REAL_LT_IMP_NZ; REAL_ENTIRE] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[POW_2_SQRT; REAL_ARITH `abs(x - y) < y ==> &0 <= x`]; + REPEAT STRIP_TAC THEN CONV_TAC CONTINUOUS_CONV; + DIFF_TAC THEN REWRITE_TAC[ARITH; REAL_POW_1; REAL_MUL_RID]]);; + +let DIFF_SQRT_COMPOSITE = prove + (`!g m x. (g diffl m)(x) /\ &0 < g x + ==> ((\x. sqrt(g x)) diffl (inv(&2 * sqrt(g x)) * m))(x)`, + SIMP_TAC[DIFF_CHAIN; DIFF_SQRT]) in +add_to_diff_net (SPEC_ALL DIFF_SQRT_COMPOSITE);; + +(* ------------------------------------------------------------------------ *) +(* Basic properties of the trig functions *) +(* ------------------------------------------------------------------------ *) + +let SIN_0 = prove( + `sin(&0) = &0`, + REWRITE_TAC[sin] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN + W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN + DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[LE_0] THEN + BETA_TAC THEN + REWRITE_TAC[sum] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `n:num` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO]);; + +let COS_0 = prove( + `cos(&0) = &1`, + REWRITE_TAC[cos] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_UNIQ THEN BETA_TAC THEN + W(MP_TAC o C SPEC SER_0 o rand o rator o snd) THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[num_CONV `1`; sum; ADD_CLAUSES] THEN BETA_TAC THEN + REWRITE_TAC[EVEN; pow; FACT] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN + SUBGOAL_THEN `0 DIV 2 = 0` SUBST1_TAC THENL + [MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `0` THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[num_CONV `2`; LT_0]; + REWRITE_TAC[pow]] THEN + SUBGOAL_THEN `&1 / &1 = &(SUC 0)` SUBST1_TAC THENL + [REWRITE_TAC[SYM(num_CONV `1`)] THEN MATCH_MP_TAC REAL_DIV_REFL THEN + MATCH_ACCEPT_TAC REAL_10; + DISCH_THEN MATCH_MP_TAC] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[LE_SUC_LT] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; ADD_CLAUSES]);; + +let SIN_CIRCLE = prove( + `!x. (sin(x) pow 2) + (cos(x) pow 2) = &1`, + GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN + SUBGOAL_THEN `&1 = (\x.(sin(x) pow 2) + (cos(x) pow 2))(&0)` SUBST1_TAC THENL + [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0] THEN + REWRITE_TAC[num_CONV `2`; POW_0] THEN + REWRITE_TAC[pow; POW_1] THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID]; + MATCH_MP_TAC DIFF_ISCONST_ALL THEN X_GEN_TAC `x:real` THEN + W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[GSYM real_sub; REAL_SUB_0] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN + AP_TERM_TAC THEN REWRITE_TAC[num_CONV `2`; SUC_SUB1] THEN + REWRITE_TAC[POW_1] THEN MATCH_ACCEPT_TAC REAL_MUL_SYM]);; + +let SIN_BOUND = prove( + `!x. abs(sin x) <= &1`, + GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN + REWRITE_TAC[REAL_POW2_ABS] THEN + DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN + DISCH_THEN(MP_TAC o C CONJ(SPEC `cos(x)` REAL_LE_SQUARE)) THEN + REWRITE_TAC[GSYM POW_2] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LTE_ADD) THEN + REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `a + b + c = (a + c) + b`] THEN + REWRITE_TAC[SIN_CIRCLE; REAL_ADD_RINV; REAL_LT_REFL]);; + +let SIN_BOUNDS = prove( + `!x. --(&1) <= sin(x) /\ sin(x) <= &1`, + GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS; SIN_BOUND]);; + +let COS_BOUND = prove( + `!x. abs(cos x) <= &1`, + GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_ONCE_REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT1_POW2) THEN + REWRITE_TAC[REAL_POW2_ABS] THEN + DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) THEN + DISCH_THEN(MP_TAC o CONJ(SPEC `sin(x)` REAL_LE_SQUARE)) THEN + REWRITE_TAC[GSYM POW_2] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LET_ADD) THEN + REWRITE_TAC[real_sub; REAL_ADD_ASSOC; SIN_CIRCLE; + REAL_ADD_ASSOC; SIN_CIRCLE; REAL_ADD_RINV; REAL_LT_REFL]);; + +let COS_BOUNDS = prove( + `!x. --(&1) <= cos(x) /\ cos(x) <= &1`, + GEN_TAC THEN REWRITE_TAC[GSYM ABS_BOUNDS; COS_BOUND]);; + +let SIN_COS_ADD = prove( + `!x y. ((sin(x + y) - ((sin(x) * cos(y)) + (cos(x) * sin(y)))) pow 2) + + ((cos(x + y) - ((cos(x) * cos(y)) - (sin(x) * sin(y)))) pow 2) = &0`, + REPEAT GEN_TAC THEN + CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN + W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[`&0`,`x:real`] o snd) THENL + [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_SUB_REFL] THEN + REWRITE_TAC[num_CONV `2`; POW_0; REAL_ADD_LID]; + MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN + W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN + NUM_REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; REAL_MUL_RID] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_LMUL] THEN + ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN + REWRITE_TAC[REAL_SUB_LZERO; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_NEG_RMUL] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN BINOP_TAC THENL + [REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEGNEG; REAL_NEG_RMUL]; + REWRITE_TAC[GSYM REAL_NEG_RMUL; GSYM real_sub]]]);; + +let SIN_COS_NEG = prove( + `!x. ((sin(--x) + (sin x)) pow 2) + + ((cos(--x) - (cos x)) pow 2) = &0`, + GEN_TAC THEN CONV_TAC(LAND_CONV(X_BETA_CONV `x:real`)) THEN + W(C SUBGOAL_THEN (SUBST1_TAC o SYM) o subst[`&0`,`x:real`] o snd) THENL + [BETA_TAC THEN REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_SUB_REFL] THEN + REWRITE_TAC[num_CONV `2`; POW_0; REAL_ADD_LID]; + MATCH_MP_TAC DIFF_ISCONST_ALL THEN GEN_TAC THEN + W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN + NUM_REDUCE_TAC THEN REWRITE_TAC[POW_1] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_MUL_RID; real_sub; REAL_NEGNEG; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN + REWRITE_TAC[REAL_SUB_LZERO; REAL_NEG_RMUL] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; REAL_NEG_RMUL] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_NEGNEG]]);; + +let SIN_ADD = prove( + `!x y. sin(x + y) = (sin(x) * cos(y)) + (cos(x) * sin(y))`, + REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] SIN_COS_ADD) THEN + REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let COS_ADD = prove( + `!x y. cos(x + y) = (cos(x) * cos(y)) - (sin(x) * sin(y))`, + REPEAT GEN_TAC THEN MP_TAC(SPECL [`x:real`; `y:real`] SIN_COS_ADD) THEN + REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let SIN_NEG = prove( + `!x. sin(--x) = --(sin(x))`, + GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_COS_NEG) THEN + REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_LNEG_UNIQ] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let COS_NEG = prove( + `!x. cos(--x) = cos(x)`, + GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_COS_NEG) THEN + REWRITE_TAC[POW_2; REAL_SUMSQ] THEN REWRITE_TAC[REAL_SUB_0] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let SIN_DOUBLE = prove( + `!x. sin(&2 * x) = &2 * sin(x) * cos(x)`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; SIN_ADD] THEN + AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; + +let COS_DOUBLE = prove( + `!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; COS_ADD; POW_2]);; + +let COS_ABS = prove + (`!x. cos(abs x) = cos(x)`, + GEN_TAC THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN REWRITE_TAC[COS_NEG]);; + +(* ------------------------------------------------------------------------ *) +(* Show that there's a least positive x with cos(x) = 0; hence define pi *) +(* ------------------------------------------------------------------------ *) + +let SIN_PAIRED = prove( + `!x. (\n. (((--(&1)) pow n) / &(FACT((2 * n) + 1))) + * (x pow ((2 * n) + 1))) sums (sin x)`, + GEN_TAC THEN MP_TAC(SPEC `x:real` SIN_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM sin] THEN + BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN + REWRITE_TAC[GSYM ADD1; EVEN_DOUBLE; + REWRITE_RULE[GSYM NOT_EVEN] ODD_DOUBLE] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; SUC_SUB1; MULT_DIV_2]);; + +let SIN_POS = prove( + `!x. &0 < x /\ x < &2 ==> &0 < sin(x)`, + GEN_TAC THEN STRIP_TAC THEN MP_TAC(SPEC `x:real` SIN_PAIRED) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN + REWRITE_TAC[SYM(MATCH_MP SUM_UNIQ (SPEC `x:real` SIN_PAIRED))] THEN + REWRITE_TAC[SUM_2] THEN BETA_TAC THEN REWRITE_TAC[GSYM ADD1] THEN + REWRITE_TAC[pow; GSYM REAL_NEG_MINUS1; POW_MINUS1] THEN + REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM real_sub] THEN + REWRITE_TAC[REAL_MUL_LID] THEN REWRITE_TAC[ADD1] THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN + W(C SUBGOAL_THEN SUBST1_TAC o curry mk_eq `&0` o curry mk_comb `sum(0,0)` o + funpow 2 rand o snd) THENL [REWRITE_TAC[sum]; ALL_TAC] THEN + MATCH_MP_TAC SER_POS_LT THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN BETA_TAC THEN + REWRITE_TAC[GSYM ADD1; MULT_CLAUSES] THEN + REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; pow; FACT; GSYM REAL_MUL] THEN + REWRITE_TAC[SYM(num_CONV `2`)] THEN + REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; pow; FACT; GSYM REAL_MUL] THEN + REWRITE_TAC[REAL_SUB_LT] THEN ONCE_REWRITE_TAC[GSYM pow] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC POW_POS_LT THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM POW_2] THEN + SUBGOAL_THEN `!n. &0 < &(SUC n)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN + SUBGOAL_THEN `!n. &0 < &(FACT n)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(&(SUC n) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(&(FACT n) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN + REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN + REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e = (a * b * e) * (c * d)`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_INV_POS THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL_WEAK) THEN + ASM_REWRITE_TAC[REAL_ENTIRE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN + REWRITE_TAC[POW_2] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC; + MATCH_MP_TAC REAL_LT_MUL2_ALT THEN REPEAT CONJ_TAC] THEN + TRY(MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN NO_TAC) THENL + [W((then_) (MATCH_MP_TAC REAL_LT_TRANS) o EXISTS_TAC o + curry mk_comb `&` o funpow 3 rand o snd) THEN + REWRITE_TAC[REAL_LT; LESS_SUC_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC(REDEPTH_CONV num_CONV) THEN + REWRITE_TAC[REAL_LE; LE_SUC; LE_0]);; + +let COS_PAIRED = prove( + `!x. (\n. (((--(&1)) pow n) / &(FACT(2 * n))) + * (x pow (2 * n))) sums (cos x)`, + GEN_TAC THEN MP_TAC(SPEC `x:real` COS_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_PAIR) THEN REWRITE_TAC[GSYM cos] THEN + BETA_TAC THEN REWRITE_TAC[SUM_2] THEN BETA_TAC THEN + REWRITE_TAC[GSYM ADD1; EVEN_DOUBLE; + REWRITE_RULE[GSYM NOT_EVEN] ODD_DOUBLE] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; MULT_DIV_2]);; + +let COS_2 = prove( + `cos(&2) < &0`, + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NEGNEG] THEN + REWRITE_TAC[REAL_NEG_LT0] THEN MP_TAC(SPEC `&2` COS_PAIRED) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_NEG) THEN BETA_TAC THEN + DISCH_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `sum(0,3) (\n. --((((--(&1)) pow n) / &(FACT(2 * n))) + * (&2 pow (2 * n))))` THEN CONJ_TAC THENL + [REWRITE_TAC[num_CONV `3`; sum; SUM_2] THEN BETA_TAC THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; pow; FACT] THEN + REWRITE_TAC[REAL_MUL_RID; POW_1; POW_2; GSYM REAL_NEG_RMUL] THEN + IMP_SUBST_TAC REAL_DIV_REFL THEN REWRITE_TAC[REAL_NEGNEG; REAL_10] THEN + NUM_REDUCE_TAC THEN REWRITE_TAC[num_CONV `4`; num_CONV `3`; FACT; pow] THEN + REWRITE_TAC[SYM(num_CONV `4`); SYM(num_CONV `3`)] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; FACT; pow] THEN + REWRITE_TAC[SYM(num_CONV `1`); SYM(num_CONV `2`)] THEN + REWRITE_TAC[REAL_MUL] THEN NUM_REDUCE_TAC THEN + REWRITE_TAC[real_div; REAL_NEG_LMUL; REAL_NEGNEG; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_NEG_LMUL; REAL_ADD_ASSOC] THEN + REWRITE_TAC[GSYM real_sub; REAL_SUB_LT] THEN + SUBGOAL_THEN `inv(&2) * &4 = &1 + &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_EQ_LMUL_IMP THEN EXISTS_TAC `&2` THEN + REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC THEN + REWRITE_TAC[REAL_ADD; REAL_MUL] THEN NUM_REDUCE_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `&2 * inv(&2) = &1` SUBST1_TAC THEN + REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_MUL_RINV THEN + REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC; + REWRITE_TAC[REAL_MUL_LID; REAL_ADD_ASSOC] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC REAL_LT_1 THEN REWRITE_TAC[REAL_LE; REAL_LT] THEN + NUM_REDUCE_TAC]; ALL_TAC] THEN + MATCH_MP_TAC SER_POS_LT_PAIR THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUM_SUMMABLE th]) THEN + X_GEN_TAC `d:num` THEN BETA_TAC THEN + REWRITE_TAC[POW_ADD; POW_MINUS1; REAL_MUL_RID] THEN + REWRITE_TAC[num_CONV `3`; pow] THEN REWRITE_TAC[SYM(num_CONV `3`)] THEN + REWRITE_TAC[POW_2; POW_1] THEN + REWRITE_TAC[GSYM REAL_NEG_MINUS1; REAL_NEGNEG] THEN + REWRITE_TAC[real_div; GSYM REAL_NEG_LMUL; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_NEGNEG] THEN + REWRITE_TAC[GSYM real_sub; REAL_SUB_LT] THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[POW_ADD; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[num_CONV `2`; MULT_CLAUSES] THEN + REWRITE_TAC[num_CONV `3`; ADD_CLAUSES] THEN + MATCH_MP_TAC POW_POS_LT THEN REWRITE_TAC[REAL_LT] THEN + NUM_REDUCE_TAC] THEN + REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; FACT] THEN + REWRITE_TAC[SYM(num_CONV `2`)] THEN + REWRITE_TAC[num_CONV `1`; ADD_CLAUSES; FACT] THEN + REWRITE_TAC[SYM(num_CONV `1`)] THEN + SUBGOAL_THEN `!n. &0 < &(SUC n)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN + SUBGOAL_THEN `!n. &0 < &(FACT n)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(&(SUC n) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(&(FACT n) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN + REWRITE_TAC[REAL_LT; FACT_LT]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL] THEN + REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN ASM_REWRITE_TAC[REAL_ENTIRE]) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d = (a * b * d) * c`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_RMUL_IMP THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_INV_POS THEN REWRITE_TAC[REAL_LT; FACT_LT]] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + IMP_SUBST_TAC ((CONV_RULE(RAND_CONV SYM_CONV) o SPEC_ALL) REAL_INV_MUL_WEAK) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_LT_1 THEN + REWRITE_TAC[POW_2; REAL_MUL; REAL_LE; REAL_LT] THEN NUM_REDUCE_TAC THEN + REWRITE_TAC[num_CONV `4`; num_CONV `3`; MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[LT_SUC] THEN + REWRITE_TAC[num_CONV `2`; ADD_CLAUSES; MULT_CLAUSES] THEN + REWRITE_TAC[num_CONV `1`; LT_SUC; LT_0]);; + +let COS_ISZERO = prove( + `?!x. &0 <= x /\ x <= &2 /\ (cos x = &0)`, + REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN BETA_TAC THEN + W(C SUBGOAL_THEN ASSUME_TAC o hd o conjuncts o snd) THENL + [MATCH_MP_TAC IVT2 THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_LE; LE_0]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN ACCEPT_TAC COS_2; + REWRITE_TAC[COS_0; REAL_LE_01]; + X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN + REWRITE_TAC[DIFF_COS]]; + ASM_REWRITE_TAC[] THEN BETA_TAC THEN + MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_REWRITE_TAC[NOT_IMP] THEN REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THEN + SUBGOAL_THEN `(!x. cos differentiable x) /\ + (!x. cos contl x)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN GEN_TAC THENL + [REWRITE_TAC[differentiable]; MATCH_MP_TAC DIFF_CONT] THEN + EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL + [MP_TAC(SPECL [`cos`; `x1:real`; `x2:real`] ROLLE); + MP_TAC(SPECL [`cos`; `x2:real`; `x1:real`] ROLLE)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` MP_TAC) THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o CONJ(SPEC `x:real` DIFF_COS)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN + REWRITE_TAC[REAL_NEG_EQ0] THEN MATCH_MP_TAC REAL_POS_NZ THEN + MATCH_MP_TAC SIN_POS THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x2:real` THEN + ASM_REWRITE_TAC[]]; + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real` THEN + ASM_REWRITE_TAC[]]]]);; + +let pi = new_definition + `pi = &2 * @x. &0 <= x /\ x <= &2 /\ (cos x = &0)`;; + +(* ------------------------------------------------------------------------ *) +(* Periodicity and related properties of the trig functions *) +(* ------------------------------------------------------------------------ *) + +let PI2 = prove( + `pi / &2 = @x. &0 <= x /\ x <= &2 /\ (cos(x) = &0)`, + REWRITE_TAC[pi; real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * c = (c * a) * b`] THEN + IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_INJ] THEN + NUM_REDUCE_TAC THEN REWRITE_TAC[REAL_MUL_LID]);; + +let COS_PI2 = prove( + `cos(pi / &2) = &0`, + MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN + REWRITE_TAC[GSYM PI2] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let PI2_BOUNDS = prove( + `&0 < (pi / &2) /\ (pi / &2) < &2`, + MP_TAC(SELECT_RULE (EXISTENCE COS_ISZERO)) THEN + REWRITE_TAC[GSYM PI2] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL + [DISCH_TAC THEN MP_TAC COS_0 THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM REAL_10]; + DISCH_TAC THEN MP_TAC COS_PI2 THEN FIRST_ASSUM SUBST1_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_NE THEN + MATCH_ACCEPT_TAC COS_2]);; + +let PI_POS = prove( + `&0 < pi`, + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN + MATCH_MP_TAC REAL_LT_ADD THEN REWRITE_TAC[PI2_BOUNDS]);; + +let SIN_PI2 = prove( + `sin(pi / &2) = &1`, + MP_TAC(SPEC `pi / &2` SIN_CIRCLE) THEN + REWRITE_TAC[COS_PI2; POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM REAL_DIFFSQ; REAL_ENTIRE] THEN + DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM MP_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_LNEG_UNIQ] THEN DISCH_THEN(MP_TAC o AP_TERM `(--)`) THEN + REWRITE_TAC[REAL_NEGNEG] THEN DISCH_TAC THEN + MP_TAC REAL_LT_01 THEN POP_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_GT THEN + REWRITE_TAC[REAL_NEG_LT0] THEN MATCH_MP_TAC SIN_POS THEN + REWRITE_TAC[PI2_BOUNDS]);; + +let COS_PI = prove( + `cos(pi) = --(&1)`, + MP_TAC(SPECL [`pi / &2`; `pi / &2`] COS_ADD) THEN + REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_SUB_LZERO] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_DOUBLE] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC);; + +let SIN_PI = prove( + `sin(pi) = &0`, + MP_TAC(SPECL [`pi / &2`; `pi / &2`] SIN_ADD) THEN + REWRITE_TAC[COS_PI2; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_LID] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_DOUBLE] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_DIV_LMUL THEN + REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC);; + +let SIN_COS = prove( + `!x. sin(x) = cos((pi / &2) - x)`, + GEN_TAC THEN REWRITE_TAC[real_sub; COS_ADD] THEN + REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID] THEN + REWRITE_TAC[SIN_NEG; REAL_NEGNEG]);; + +let COS_SIN = prove( + `!x. cos(x) = sin((pi / &2) - x)`, + GEN_TAC THEN REWRITE_TAC[real_sub; SIN_ADD] THEN + REWRITE_TAC[SIN_PI2; COS_PI2; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_ADD_RID] THEN + REWRITE_TAC[COS_NEG]);; + +let SIN_PERIODIC_PI = prove( + `!x. sin(x + pi) = --(sin(x))`, + GEN_TAC THEN REWRITE_TAC[SIN_ADD; SIN_PI; COS_PI] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_MUL_RID]);; + +let COS_PERIODIC_PI = prove( + `!x. cos(x + pi) = --(cos(x))`, + GEN_TAC THEN REWRITE_TAC[COS_ADD; SIN_PI; COS_PI] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; GSYM REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_MUL_RID]);; + +let SIN_PERIODIC = prove( + `!x. sin(x + (&2 * pi)) = sin(x)`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_ADD_ASSOC] THEN + REWRITE_TAC[SIN_PERIODIC_PI; REAL_NEGNEG]);; + +let COS_PERIODIC = prove( + `!x. cos(x + (&2 * pi)) = cos(x)`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_DOUBLE; REAL_ADD_ASSOC] THEN + REWRITE_TAC[COS_PERIODIC_PI; REAL_NEGNEG]);; + +let COS_NPI = prove( + `!n. cos(&n * pi) = --(&1) pow n`, + INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; COS_0; pow] THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; COS_ADD] THEN + REWRITE_TAC[REAL_MUL_LID; SIN_PI; REAL_MUL_RZERO; REAL_SUB_RZERO] THEN + ASM_REWRITE_TAC[COS_PI] THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM);; + +let SIN_NPI = prove( + `!n. sin(&n * pi) = &0`, + INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; SIN_0; pow] THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; SIN_ADD] THEN + REWRITE_TAC[REAL_MUL_LID; SIN_PI; REAL_MUL_RZERO; REAL_ADD_RID] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO]);; + +let SIN_POS_PI2 = prove( + `!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SIN_POS THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `pi / &2` THEN ASM_REWRITE_TAC[PI2_BOUNDS]);; + +let COS_POS_PI2 = prove( + `!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)`, + GEN_TAC THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN + PURE_REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(SPECL [`cos`; `&0`; `x:real`; `&0`] IVT2) THEN + ASM_REWRITE_TAC[COS_0; REAL_LE_01; NOT_IMP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `z:real` THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin z)` THEN + REWRITE_TAC[DIFF_COS]; + DISCH_THEN(X_CHOOSE_TAC `z:real`) THEN + MP_TAC(CONJUNCT2 (CONV_RULE EXISTS_UNIQUE_CONV COS_ISZERO)) THEN + DISCH_THEN(MP_TAC o SPECL [`z:real`; `pi / &2`]) THEN + ASM_REWRITE_TAC[COS_PI2] THEN REWRITE_TAC[NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `pi / &2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC; + ALL_TAC; + ALL_TAC; + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `x < pi / &2` THEN + ASM_REWRITE_TAC[REAL_NOT_LT]] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[PI2_BOUNDS]]);; + +let COS_POS_PI = prove( + `!x. --(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)`, + GEN_TAC THEN STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THENL + [ASM_REWRITE_TAC[COS_0; REAL_LT_01]; + ONCE_REWRITE_TAC[GSYM COS_NEG] THEN MATCH_MP_TAC COS_POS_PI2 THEN + ONCE_REWRITE_TAC[GSYM REAL_NEG_LT0] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN + ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG]; + MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[]]);; + +let SIN_POS_PI = prove( + `!x. &0 < x /\ x < pi ==> &0 < sin(x)`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[SIN_COS] THEN ONCE_REWRITE_TAC[GSYM COS_NEG] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN + MATCH_MP_TAC COS_POS_PI THEN + REWRITE_TAC[REAL_LT_SUB_LADD; REAL_LT_SUB_RADD] THEN + ASM_REWRITE_TAC[REAL_HALF_DOUBLE; REAL_ADD_LINV]);; + +let SIN_POS_PI_LE = prove + (`!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)`, + REWRITE_TAC[REAL_LE_LT] THEN + MESON_TAC[SIN_POS_PI; SIN_PI; SIN_0; REAL_LE_REFL]);; + +let COS_TOTAL = prove( + `!y. --(&1) <= y /\ y <= &1 ==> ?!x. &0 <= x /\ x <= pi /\ (cos(x) = y)`, + GEN_TAC THEN STRIP_TAC THEN + CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL + [MATCH_MP_TAC IVT2 THEN ASM_REWRITE_TAC[COS_0; COS_PI] THEN + REWRITE_TAC[MATCH_MP REAL_LT_IMP_LE PI_POS] THEN + GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin x)` THEN + REWRITE_TAC[DIFF_COS]; + MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THENL + [FIRST_ASSUM ACCEPT_TAC; + MP_TAC(SPECL [`cos`; `x1:real`; `x2:real`] ROLLE); + MP_TAC(SPECL [`cos`; `x2:real`; `x1:real`] ROLLE)]] THEN + ASM_REWRITE_TAC[] THEN + (W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 + (fst o dest_imp) o snd) THENL + [CONJ_TAC THEN X_GEN_TAC `x:real` THEN DISCH_THEN(K ALL_TAC) THEN + TRY(MATCH_MP_TAC DIFF_CONT) THEN REWRITE_TAC[differentiable] THEN + EXISTS_TAC `--(sin x)` THEN REWRITE_TAC[DIFF_COS]; ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(cos diffl &0)(x)` THEN + DISCH_THEN(MP_TAC o CONJ (SPEC `x:real` DIFF_COS)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN + REWRITE_TAC[REAL_NEG_EQ0] THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` SIN_POS_PI) THEN + ASM_REWRITE_TAC[REAL_LT_REFL] THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x1:real`; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x2:real`; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real`; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real`] THEN + ASM_REWRITE_TAC[]);; + +let SIN_TOTAL = prove( + `!y. --(&1) <= y /\ y <= &1 ==> + ?!x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `!x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin(x) = y) <=> + &0 <= (x + pi / &2) /\ (x + pi / &2) <= pi /\ (cos(x + pi / &2) = --y)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[COS_ADD; SIN_PI2; COS_PI2] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RZERO; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_SUB_LZERO] THEN + REWRITE_TAC[GSYM REAL_LE_SUB_RADD; GSYM REAL_LE_SUB_LADD] THEN + REWRITE_TAC[REAL_SUB_LZERO] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_EQ_NEG] THEN AP_THM_TAC THEN + REPEAT AP_TERM_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_HALF_DOUBLE] THEN + REWRITE_TAC[REAL_ADD_SUB]; ALL_TAC] THEN + MP_TAC(SPEC `--y` COS_TOTAL) THEN ASM_REWRITE_TAC[REAL_LE_NEG] THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN ASM_REWRITE_TAC[REAL_NEGNEG] THEN + REWRITE_TAC[REAL_LE_NEG] THEN + CONV_TAC(ONCE_DEPTH_CONV EXISTS_UNIQUE_CONV) THEN + DISCH_THEN((then_) CONJ_TAC o MP_TAC) THENL + [DISCH_THEN(X_CHOOSE_TAC `x:real` o CONJUNCT1) THEN + EXISTS_TAC `x - pi / &2` THEN ASM_REWRITE_TAC[REAL_SUB_ADD]; + POP_ASSUM(K ALL_TAC) THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[REAL_EQ_RADD]]);; + +let COS_ZERO_LEMMA = prove( + `!x. &0 <= x /\ (cos(x) = &0) ==> + ?n. ~EVEN n /\ (x = &n * (pi / &2))`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `x:real` (MATCH_MP REAL_ARCH_LEAST PI_POS)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `&0 <= x - &n * pi /\ (x - &n * pi) <= pi /\ + (cos(x - &n * pi) = &0)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_SUB_LE] THEN + REWRITE_TAC[REAL_LE_SUB_RADD] THEN + REWRITE_TAC[real_sub; COS_ADD; SIN_NEG; COS_NEG; SIN_NPI; COS_NPI] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_NEG_RMUL; REAL_NEGNEG; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN UNDISCH_TAC `x < &(SUC n) * pi` THEN + REWRITE_TAC[ADD1] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID]; + MP_TAC(SPEC `&0` COS_TOTAL) THEN + REWRITE_TAC[REAL_LE_01; REAL_NEG_LE0] THEN + DISCH_THEN(MP_TAC o CONV_RULE EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(MP_TAC o SPECL [`x - &n * pi`; `pi / &2`] o CONJUNCT2) THEN + ASM_REWRITE_TAC[COS_PI2] THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN MP_TAC PI2_BOUNDS THEN + REWRITE_TAC[REAL_LT_HALF1; REAL_LT_HALF2] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + REWRITE_TAC[REAL_EQ_SUB_RADD] THEN DISCH_TAC THEN + EXISTS_TAC `SUC(2 * n)` THEN + REWRITE_TAC[GSYM NOT_ODD; ODD_DOUBLE] THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; GSYM REAL_MUL] THEN + REWRITE_TAC[REAL_RDISTRIB; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + REWRITE_TAC[REAL_INJ] THEN NUM_REDUCE_TAC]);; + +let SIN_ZERO_LEMMA = prove( + `!x. &0 <= x /\ (sin(x) = &0) ==> + ?n. EVEN n /\ (x = &n * (pi / &2))`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `x + pi / &2` COS_ZERO_LEMMA) THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[PI2_BOUNDS]; + ASM_REWRITE_TAC[COS_ADD; COS_PI2; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + MATCH_ACCEPT_TAC REAL_SUB_REFL]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `n:num` ODD_EXISTS) THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + EXISTS_TAC `2 * m` THEN REWRITE_TAC[EVEN_DOUBLE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_EQ_SUB_LADD]) THEN + FIRST_ASSUM SUBST1_TAC THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_SUB]);; + +let COS_ZERO = prove( + `!x. (cos(x) = &0) <=> (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/ + (?n. ~EVEN n /\ (x = --(&n * (pi / &2))))`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL + [DISJ1_TAC THEN MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN + MATCH_MP_TAC COS_ZERO_LEMMA THEN ASM_REWRITE_TAC[COS_NEG] THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN + ASM_REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0]]; + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`)) THEN + ASM_REWRITE_TAC[COS_NEG] THEN MP_TAC(SPEC `n:num` ODD_EXISTS) THEN + ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + REWRITE_TAC[ADD1] THEN SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; REAL_MUL_LID; COS_PI2] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[GSYM REAL_ADD] THEN + REWRITE_TAC[REAL_RDISTRIB] THEN REWRITE_TAC[COS_ADD] THEN + REWRITE_TAC[GSYM REAL_DOUBLE; REAL_HALF_DOUBLE] THEN + ASM_REWRITE_TAC[COS_PI; SIN_PI; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO]]);; + +let SIN_ZERO = prove( + `!x. (sin(x) = &0) <=> (?n. EVEN n /\ (x = &n * (pi / &2))) \/ + (?n. EVEN n /\ (x = --(&n * (pi / &2))))`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL + [DISJ1_TAC THEN MATCH_MP_TAC SIN_ZERO_LEMMA THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN REWRITE_TAC[GSYM REAL_NEG_EQ] THEN + MATCH_MP_TAC SIN_ZERO_LEMMA THEN + ASM_REWRITE_TAC[SIN_NEG; REAL_NEG_0; REAL_NEG_GE0]]; + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`)) THEN + ASM_REWRITE_TAC[SIN_NEG; REAL_NEG_EQ0] THEN + MP_TAC(SPEC `n:num` EVEN_EXISTS) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM REAL_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * c = b * (a * c)`] THEN + REWRITE_TAC[GSYM REAL_DOUBLE; REAL_HALF_DOUBLE; SIN_NPI]]);; + +let SIN_ZERO_PI = prove + (`!x. (sin(x) = &0) <=> (?n. x = &n * pi) \/ (?n. x = --(&n * pi))`, + GEN_TAC THEN REWRITE_TAC[SIN_ZERO; EVEN_EXISTS] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[UNWIND_THM2] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH]);; + +let COS_ONE_2PI = prove + (`!x. (cos(x) = &1) <=> (?n. x = &n * &2 * pi) \/ (?n. x = --(&n * &2 * pi))`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[COS_NEG] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_OF_NUM_MUL; COS_NPI] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]] THEN + DISCH_TAC THEN MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN + ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `(x + &1 * &1 = &1) <=> (x = &0)`] THEN + REWRITE_TAC[REAL_ENTIRE] THEN REWRITE_TAC[SIN_ZERO_PI] THEN + MATCH_MP_TAC(TAUT `(a ==> a') /\ (b ==> b') ==> (a \/ b ==> a' \/ b')`) THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + CONJ_TAC THEN X_GEN_TAC `m:num` THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_EQ_NEG2; COS_NEG] THEN + REWRITE_TAC[COS_NPI; REAL_POW_NEG; REAL_POW_ONE] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_EQ_MUL_RCANCEL] THEN + SIMP_TAC[PI_POS; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM EVEN_EXISTS] THEN + COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Tangent *) +(* ------------------------------------------------------------------------ *) + +let tan = new_definition + `tan(x) = sin(x) / cos(x)`;; + +let TAN_0 = prove( + `tan(&0) = &0`, + REWRITE_TAC[tan; SIN_0; REAL_DIV_LZERO]);; + +let TAN_PI = prove( + `tan(pi) = &0`, + REWRITE_TAC[tan; SIN_PI; REAL_DIV_LZERO]);; + +let TAN_NPI = prove( + `!n. tan(&n * pi) = &0`, + GEN_TAC THEN REWRITE_TAC[tan; SIN_NPI; REAL_DIV_LZERO]);; + +let TAN_NEG = prove( + `!x. tan(--x) = --(tan x)`, + GEN_TAC THEN REWRITE_TAC[tan; SIN_NEG; COS_NEG] THEN + REWRITE_TAC[real_div; REAL_NEG_LMUL]);; + +let TAN_PERIODIC = prove( + `!x. tan(x + &2 * pi) = tan(x)`, + GEN_TAC THEN REWRITE_TAC[tan; SIN_PERIODIC; COS_PERIODIC]);; + +let TAN_PERIODIC_PI = prove + (`!x. tan(x + pi) = tan(x)`, + REWRITE_TAC[tan; SIN_PERIODIC_PI; COS_PERIODIC_PI; + real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let TAN_PERIODIC_NPI = prove + (`!x n. tan(x + &n * pi) = tan(x)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_REWRITE_TAC[REAL_ADD_ASSOC; TAN_PERIODIC_PI]);; + +let TAN_ADD = prove( + `!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) ==> + (tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[tan] THEN + MP_TAC(SPECL [`cos(x) * cos(y)`; + `&1 - (sin(x) / cos(x)) * (sin(y) / cos(y))`] + REAL_DIV_MUL2) THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [DISCH_THEN(MP_TAC o AP_TERM `(*) (cos(x) * cos(y))`) THEN + REWRITE_TAC[real_div; REAL_SUB_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN + UNDISCH_TAC `~(cos(x + y) = &0)` THEN + MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[COS_ADD] THEN AP_TERM_TAC; + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN BINOP_TAC THENL + [REWRITE_TAC[real_div; REAL_LDISTRIB; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[SIN_ADD] THEN BINOP_TAC THENL + [ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d = (d * a) * (c * b)`] THEN + IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]; + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d = (d * b) * (a * c)`] THEN + IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[REAL_MUL_LID]]; + REWRITE_TAC[COS_ADD; REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN + AP_TERM_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC]]] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e * f = (f * b) * (d * a) * (c * e)`] THEN + REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let TAN_DOUBLE = prove( + `!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) ==> + (tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2)))`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`x:real`; `x:real`] TAN_ADD) THEN + ASM_REWRITE_TAC[REAL_DOUBLE; POW_2]);; + +let TAN_POS_PI2 = prove( + `!x. &0 < x /\ x < pi / &2 ==> &0 < tan(x)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan; real_div] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SIN_POS_PI2; + MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC COS_POS_PI2] THEN + ASM_REWRITE_TAC[]);; + +let DIFF_TAN = prove( + `!x. ~(cos(x) = &0) ==> (tan diffl inv(cos(x) pow 2))(x)`, + GEN_TAC THEN DISCH_TAC THEN MP_TAC(DIFF_CONV `\x. sin(x) / cos(x)`) THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[REAL_MUL_RID] THEN + REWRITE_TAC[GSYM tan; GSYM REAL_NEG_LMUL; REAL_NEGNEG; real_sub] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM POW_2; SIN_CIRCLE; GSYM REAL_INV_1OVER]);; + +let DIFF_TAN_COMPOSITE = prove + (`(g diffl m)(x) /\ ~(cos(g x) = &0) + ==> ((\x. tan(g x)) diffl (inv(cos(g x) pow 2) * m))(x)`, + ASM_SIMP_TAC[DIFF_CHAIN; DIFF_TAN]) in +add_to_diff_net DIFF_TAN_COMPOSITE;; + +let TAN_TOTAL_LEMMA = prove( + `!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `((\x. cos(x) / sin(x)) tends_real_real &0)(pi / &2)` + MP_TAC THENL + [SUBST1_TAC(SYM(SPEC `&1` REAL_DIV_LZERO)) THEN + CONV_TAC(ONCE_DEPTH_CONV HABS_CONV) THEN MATCH_MP_TAC LIM_DIV THEN + REWRITE_TAC[REAL_10] THEN CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + SUBST1_TAC(SYM COS_PI2) THEN SUBST1_TAC(SYM SIN_PI2) THEN + REWRITE_TAC[GSYM CONTL_LIM] THEN CONJ_TAC THEN MATCH_MP_TAC DIFF_CONT THENL + [EXISTS_TAC `--(sin(pi / &2))`; + EXISTS_TAC `cos(pi / &2)`] THEN + REWRITE_TAC[DIFF_SIN; DIFF_COS]; ALL_TAC] THEN + REWRITE_TAC[LIM] THEN DISCH_THEN(MP_TAC o SPEC `inv(y)`) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_INV_POS th]) THEN + BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d:real`; `pi / &2`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[PI2_BOUNDS] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(pi / &2) - e` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + CONJ_TAC THENL + [REWRITE_TAC[real_sub; GSYM REAL_NOT_LE; REAL_LE_ADDR; REAL_NEG_GE0] THEN + ASM_REWRITE_TAC[REAL_NOT_LE]; ALL_TAC] THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `(pi / &2) - e`) THEN + REWRITE_TAC[REAL_SUB_SUB; ABS_NEG] THEN + SUBGOAL_THEN `abs(e) = e` (fun th -> ASM_REWRITE_TAC[th]) THENL + [REWRITE_TAC[ABS_REFL] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < cos((pi / &2) - e) / sin((pi / &2) - e)` + MP_TAC THENL + [ONCE_REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC COS_POS_PI2; + MATCH_MP_TAC REAL_INV_POS THEN MATCH_MP_TAC SIN_POS_PI2] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; real_sub; REAL_LE_ADDR; REAL_NEG_GE0] THEN + ASM_REWRITE_TAC[REAL_NOT_LE]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_POS_NZ th)) THEN + REWRITE_TAC[ABS_NZ; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_INV2) THEN REWRITE_TAC[tan] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN + FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MP_TAC(ASSUME `&0 < cos((pi / &2) - e) / sin((pi / &2) - e)`) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + REWRITE_TAC[GSYM ABS_REFL] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[real_div] THEN IMP_SUBST_TAC REAL_INV_MUL_WEAK THENL + [REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM REAL_ENTIRE; GSYM real_div] THEN + MATCH_MP_TAC REAL_POS_NZ THEN FIRST_ASSUM ACCEPT_TAC; + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_INVINV THEN MATCH_MP_TAC REAL_POS_NZ THEN + MATCH_MP_TAC SIN_POS_PI2 THEN REWRITE_TAC[REAL_SUB_LT; GSYM real_div] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; real_sub; REAL_LE_ADDR; REAL_NEG_GE0] THEN + ASM_REWRITE_TAC[REAL_NOT_LE]]);; + +let TAN_TOTAL_POS = prove( + `!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ (tan(x) = y)`, + GEN_TAC THEN DISCH_THEN(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP TAN_TOTAL_LEMMA) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`tan`; `&0`; `x:real`; `y:real`] IVT) THEN + W(C SUBGOAL_THEN (fun th -> DISCH_THEN(MP_TAC o C MATCH_MP th)) o + funpow 2 (fst o dest_imp) o snd) THENL + [REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC REAL_LT_IMP_LE) THEN + ASM_REWRITE_TAC[TAN_0] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(z) pow 2)` THEN + MATCH_MP_TAC DIFF_TAN THEN UNDISCH_TAC `&0 <= z` THEN + REWRITE_TAC[REAL_LE_LT] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_TAC THEN MATCH_MP_TAC REAL_POS_NZ THEN + MATCH_MP_TAC COS_POS_PI2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[COS_0; REAL_10]]; + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]]; + POP_ASSUM(SUBST1_TAC o SYM) THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[TAN_0; REAL_LE_REFL; PI2_BOUNDS]]);; + +let TAN_TOTAL = prove( + `!y. ?!x. --(pi / &2) < x /\ x < (pi / &2) /\ (tan(x) = y)`, + GEN_TAC THEN CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL + [DISJ_CASES_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THEN + POP_ASSUM(X_CHOOSE_TAC `x:real` o MATCH_MP TAN_TOTAL_POS) THENL + [EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN + REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0; PI2_BOUNDS]; + EXISTS_TAC `--x` THEN ASM_REWRITE_TAC[REAL_LT_NEG] THEN + ASM_REWRITE_TAC[TAN_NEG; REAL_NEG_EQ; REAL_NEGNEG] THEN + ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN + REWRITE_TAC[REAL_LT_NEG] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[REAL_LE_NEGL]]; + MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`x1:real`; `x2:real`] REAL_LT_TOTAL) THENL + [DISCH_THEN(K ALL_TAC) THEN POP_ASSUM ACCEPT_TAC; + ALL_TAC; + POP_ASSUM MP_TAC THEN SPEC_TAC(`x1:real`,`z1:real`) THEN + SPEC_TAC(`x2:real`,`z2:real`) THEN + MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`] THEN DISCH_TAC THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN ONCE_REWRITE_TAC[CONJ_SYM]] THEN + (STRIP_TAC THEN MP_TAC(SPECL [`tan`; `x1:real`; `x2:real`] ROLLE) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC CONTRAPOS_CONV THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN STRIP_TAC THEN MATCH_MP_TAC DIFF_CONT THEN + EXISTS_TAC `inv(cos(x) pow 2)` THEN MATCH_MP_TAC DIFF_TAN; + X_GEN_TAC `x:real` THEN + DISCH_THEN(CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE)) THEN + REWRITE_TAC[differentiable] THEN EXISTS_TAC `inv(cos(x) pow 2)` THEN + MATCH_MP_TAC DIFF_TAN; + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(X_CHOOSE_THEN `x:real` + (CONJUNCTS_THEN2 (CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP + REAL_LT_IMP_LE)) ASSUME_TAC)) THEN + MP_TAC(SPEC `x:real` DIFF_TAN) THEN + SUBGOAL_THEN `~(cos(x) = &0)` ASSUME_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o C CONJ (ASSUME `(tan diffl &0)(x)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_UNIQ) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INV_NZ THEN MATCH_MP_TAC POW_NZ THEN + ASM_REWRITE_TAC[]]] THEN + (MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC COS_POS_PI THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `x1:real`; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `x2:real`] THEN + ASM_REWRITE_TAC[]))]);; + +let PI2_PI4 = prove + (`pi / &2 = &2 * pi / &4`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let TAN_PI4 = prove + (`tan(pi / &4) = &1`, + REWRITE_TAC[tan; COS_SIN; real_div; GSYM REAL_SUB_LDISTRIB] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN + REWRITE_TAC[SIN_ZERO] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_LNEG] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c = b * a * c`] THEN + SIMP_TAC[REAL_MUL_LID; REAL_EQ_MUL_LCANCEL; PI_POS; REAL_LT_IMP_NZ] THEN + SIMP_TAC[GSYM real_div; REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + SIMP_TAC[REAL_ARITH `&0 <= x ==> ~(&1 = --x)`; REAL_POS] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; ARITH_EVEN]);; + +let TAN_COT = prove + (`!x. tan(pi / &2 - x) = inv(tan x)`, + REWRITE_TAC[tan; GSYM SIN_COS; GSYM COS_SIN; REAL_INV_DIV]);; + +let TAN_BOUND_PI2 = prove + (`!x. abs(x) < pi / &4 ==> abs(tan x) < &1`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `!x. &0 < x /\ x < pi / &4 ==> &0 < tan(x) /\ tan(x) < &1` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[tan; REAL_LT_DIV; SIN_POS_PI2; COS_POS_PI2; PI2_PI4; + REAL_ARITH `&0 < x /\ x < a ==> x < &2 * a`]; + ALL_TAC] THEN + MP_TAC(SPECL [`tan`; `\x. inv(cos(x) pow 2)`; + `x:real`; `pi / &4`] MVT_ALT) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [ASM_REWRITE_TAC[BETA_THM] THEN X_GEN_TAC `z:real` THEN STRIP_TAC THEN + MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC COS_POS_PI2 THEN REWRITE_TAC[PI2_PI4] THEN + MAP_EVERY UNDISCH_TAC [`x <= z`; `z <= pi / &4`; `&0 < x`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[TAN_PI4; REAL_ARITH `x < &1 <=> &0 < &1 - x`; + LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:real` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + REWRITE_TAC[REAL_LT_INV_EQ; BETA_THM] THEN + MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC COS_POS_PI2 THEN + REWRITE_TAC[PI2_PI4] THEN + MAP_EVERY UNDISCH_TAC [`x < z`; `z < pi / &4`; `&0 < x`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_abs] THEN + REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[TAN_0; REAL_ABS_NUM; REAL_LT_01] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) < &1`] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM TAN_NEG] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) < &1`; + REAL_ARITH `~(x = &0) /\ ~(&0 < x) ==> &0 < --x`]);; + +let TAN_ABS_GE_X = prove + (`!x. abs(x) < pi / &2 ==> abs(x) <= abs(tan x)`, + SUBGOAL_THEN `!y. &0 < y /\ y < pi / &2 ==> y <= tan(y)` ASSUME_TAC THENL + [ALL_TAC; + GEN_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `x:real` REAL_LT_NEGTOTAL) THEN + ASM_REWRITE_TAC[TAN_0; REAL_ABS_0; REAL_LE_REFL] THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG] THEN REWRITE_TAC[GSYM TAN_NEG]] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ (x < p ==> x <= tx) + ==> abs(x) < p ==> abs(x) <= abs(tx)`) THEN ASM_SIMP_TAC[]] THEN + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`tan`; `\x. inv(cos(x) pow 2)`; `&0`; `y:real`] MVT_ALT) THEN + ASM_REWRITE_TAC[TAN_0; REAL_SUB_RZERO] THEN + MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a ==> b) ==> c`) THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN BETA_TAC THEN MATCH_MP_TAC DIFF_TAN THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC COS_POS_PI THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[BETA_THM] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_INV_1_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT; + MATCH_MP_TAC REAL_POW_1_LE THEN REWRITE_TAC[COS_BOUNDS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE] THEN + MATCH_MP_TAC COS_POS_PI THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------ *) +(* Inverse trig functions *) +(* ------------------------------------------------------------------------ *) + +let asn = new_definition + `asn(y) = @x. --(pi / &2) <= x /\ x <= pi / &2 /\ (sin x = y)`;; + +let acs = new_definition + `acs(y) = @x. &0 <= x /\ x <= pi /\ (cos x = y)`;; + +let atn = new_definition + `atn(y) = @x. --(pi / &2) < x /\ x < pi / &2 /\ (tan x = y)`;; + +let ASN = prove( + `!y. --(&1) <= y /\ y <= &1 ==> + --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2 /\ (sin(asn y) = y)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SIN_TOTAL) THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM asn]);; + +let ASN_SIN = prove( + `!y. --(&1) <= y /\ y <= &1 ==> (sin(asn(y)) = y)`, + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ASN th]));; + +let ASN_BOUNDS = prove( + `!y. --(&1) <= y /\ y <= &1 ==> --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2`, + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ASN th]));; + +let ASN_BOUNDS_LT = prove( + `!y. --(&1) < y /\ y < &1 ==> --(pi / &2) < asn(y) /\ asn(y) < pi / &2`, + GEN_TAC THEN STRIP_TAC THEN + EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MP_TAC(SPEC `y:real` ASN_BOUNDS) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN + CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `sin`) THEN + IMP_SUBST_TAC ASN_SIN THEN ASM_REWRITE_TAC[SIN_NEG; SIN_PI2] THEN + DISCH_THEN((then_) (POP_ASSUM_LIST (MP_TAC o end_itlist CONJ)) o + ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]);; + +let SIN_ASN = prove( + `!x. --(pi / &2) <= x /\ x <= pi / &2 ==> (asn(sin(x)) = x)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP SIN_TOTAL (SPEC `x:real` SIN_BOUNDS)) THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ASN THEN + MATCH_ACCEPT_TAC SIN_BOUNDS);; + +let ACS = prove( + `!y. --(&1) <= y /\ y <= &1 ==> + &0 <= acs(y) /\ acs(y) <= pi /\ (cos(acs y) = y)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP COS_TOTAL) THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM acs]);; + +let ACS_COS = prove( + `!y. --(&1) <= y /\ y <= &1 ==> (cos(acs(y)) = y)`, + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ACS th]));; + +let ACS_BOUNDS = prove( + `!y. --(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi`, + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP ACS th]));; + +let ACS_BOUNDS_LT = prove( + `!y. --(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi`, + GEN_TAC THEN STRIP_TAC THEN + EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MP_TAC(SPEC `y:real` ACS_BOUNDS) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN + CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN + IMP_SUBST_TAC ACS_COS THEN ASM_REWRITE_TAC[COS_0; COS_PI] THEN + DISCH_THEN((then_) (POP_ASSUM_LIST (MP_TAC o end_itlist CONJ)) o + ASSUME_TAC) THEN ASM_REWRITE_TAC[REAL_LT_REFL]);; + +let COS_ACS = prove( + `!x. &0 <= x /\ x <= pi ==> (acs(cos(x)) = x)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP COS_TOTAL (SPEC `x:real` COS_BOUNDS)) THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ACS THEN + MATCH_ACCEPT_TAC COS_BOUNDS);; + +let ATN = prove( + `!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2) /\ (tan(atn y) = y)`, + GEN_TAC THEN MP_TAC(SPEC `y:real` TAN_TOTAL) THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONV_RULE EXISTS_UNIQUE_CONV) THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN REWRITE_TAC[GSYM atn]);; + +let ATN_TAN = prove( + `!y. tan(atn y) = y`, + REWRITE_TAC[ATN]);; + +let ATN_BOUNDS = prove( + `!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2)`, + REWRITE_TAC[ATN]);; + +let TAN_ATN = prove( + `!x. --(pi / &2) < x /\ x < (pi / &2) ==> (atn(tan(x)) = x)`, + GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `tan(x)` TAN_TOTAL) THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2 o CONV_RULE EXISTS_UNIQUE_CONV) THEN + ASM_REWRITE_TAC[ATN]);; + +let ATN_0 = prove + (`atn(&0) = &0`, + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM TAN_0] THEN + MATCH_MP_TAC TAN_ATN THEN + MATCH_MP_TAC(REAL_ARITH `&0 < a ==> --a < &0 /\ &0 < a`) THEN + SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT; ARITH]);; + +let ATN_1 = prove + (`atn(&1) = pi / &4`, + MP_TAC(AP_TERM `atn` TAN_PI4) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC TAN_ATN THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < a /\ a < b ==> --b < a /\ a < b`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + SIMP_TAC[real_div; REAL_LT_LMUL_EQ; PI_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let ATN_NEG = prove + (`!x. atn(--x) = --(atn x)`, + GEN_TAC THEN MP_TAC(SPEC `atn(x)` TAN_NEG) THEN + REWRITE_TAC[ATN_TAN] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC TAN_ATN THEN + MATCH_MP_TAC(REAL_ARITH + `--a < x /\ x < a ==> --a < --x /\ --x < a`) THEN + REWRITE_TAC[ATN_BOUNDS]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiation of arctan. *) +(* ------------------------------------------------------------------------- *) + +let COS_ATN_NZ = prove( + `!x. ~(cos(atn(x)) = &0)`, + GEN_TAC THEN REWRITE_TAC[COS_ZERO; DE_MORGAN_THM] THEN CONJ_TAC THEN + CONV_TAC NOT_EXISTS_CONV THEN X_GEN_TAC `n:num` THEN + STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN + REWRITE_TAC[EVEN; DE_MORGAN_THM] THEN DISJ2_TAC THEN + DISCH_TAC THEN MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN + ASM_REWRITE_TAC[DE_MORGAN_THM] THENL + [DISJ2_TAC; DISJ1_TAC THEN REWRITE_TAC[REAL_LT_NEG]] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[MATCH_MP REAL_LT_RMUL_EQ (CONJUNCT1 PI2_BOUNDS)] THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[REAL_LE_ADDR; REAL_LE; LE_0]);; + +let TAN_SEC = prove( + `!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tan] THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM + (MATCH_MP REAL_DIV_REFL (SPEC `2` (MATCH_MP POW_NZ th)))]) THEN + REWRITE_TAC[real_div; POW_MUL] THEN + POP_ASSUM(fun th -> REWRITE_TAC[MATCH_MP POW_INV th]) THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_RDISTRIB; SIN_CIRCLE; REAL_MUL_LID]);; + +let DIFF_ATN = prove( + `!x. (atn diffl (inv(&1 + (x pow 2))))(x)`, + GEN_TAC THEN + SUBGOAL_THEN `(atn diffl (inv(&1 + (x pow 2))))(tan(atn x))` + MP_TAC THENL [MATCH_MP_TAC DIFF_INVERSE_LT; REWRITE_TAC[ATN_TAN]] THEN + SUBGOAL_THEN + `?d. &0 < d /\ + !z. abs(z - atn(x)) < d ==> (--(pi / (& 2))) < z /\ z < (pi / (& 2))` + (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THENL + [ONCE_REWRITE_TAC[ABS_SUB] THEN MATCH_MP_TAC INTERVAL_LEMMA_LT THEN + MATCH_ACCEPT_TAC ATN_BOUNDS; + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC TAN_ATN THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `inv(cos(z) pow 2)` THEN + MATCH_MP_TAC DIFF_TAN THEN MATCH_MP_TAC REAL_POS_NZ THEN + MATCH_MP_TAC COS_POS_PI THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ASSUME_TAC(SPEC `x:real` COS_ATN_NZ) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_TAN) THEN + FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP TAN_SEC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POW_INV) THEN + ASM_REWRITE_TAC[ATN_TAN]; + UNDISCH_TAC `&1 + (x pow 2) = &0` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POS_NZ THEN + MATCH_MP_TAC REAL_LTE_ADD THEN + REWRITE_TAC[REAL_LT_01; REAL_LE_SQUARE; POW_2]]]);; + +let DIFF_ATN_COMPOSITE = prove + (`(g diffl m)(x) ==> ((\x. atn(g x)) diffl (inv(&1 + (g x) pow 2) * m))(x)`, + ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ATN]) in +add_to_diff_net DIFF_ATN_COMPOSITE;; + +(* ------------------------------------------------------------------------- *) +(* A few more lemmas about arctan. *) +(* ------------------------------------------------------------------------- *) + +let ATN_MONO_LT = prove + (`!x y. x < y ==> atn(x) < atn(y)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`atn`; `\x. inv(&1 + x pow 2)`; `x:real`; `y:real`] + MVT_ALT) THEN + BETA_TAC THEN ASM_REWRITE_TAC[DIFF_ATN] THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `(l - r = d) ==> l < d + e ==> r < e`)) THEN + REWRITE_TAC[REAL_ARITH `a < b + a <=> &0 < b`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_LT_SUB_LADD; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; + +let ATN_MONO_LT_EQ = prove + (`!x y. atn(x) < atn(y) <=> x < y`, + MESON_TAC[REAL_NOT_LE; REAL_LE_LT; ATN_MONO_LT]);; + +let ATN_MONO_LE_EQ = prove + (`!x y. atn(x) <= atn(y) <=> x <= y`, + REWRITE_TAC[GSYM REAL_NOT_LT; ATN_MONO_LT_EQ]);; + +let ATN_INJ = prove + (`!x y. (atn x = atn y) <=> (x = y)`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; ATN_MONO_LE_EQ]);; + +let ATN_POS_LT = prove + (`&0 < atn(x) <=> &0 < x`, + MESON_TAC[ATN_0; ATN_MONO_LT_EQ]);; + +let ATN_POS_LE = prove + (`&0 <= atn(x) <=> &0 <= x`, + MESON_TAC[ATN_0; ATN_MONO_LE_EQ]);; + +let ATN_LT_PI4_POS = prove + (`!x. x < &1 ==> atn(x) < pi / &4`, + SIMP_TAC[GSYM ATN_1; ATN_MONO_LT]);; + +let ATN_LT_PI4_NEG = prove + (`!x. --(&1) < x ==> --(pi / &4) < atn(x)`, + SIMP_TAC[GSYM ATN_1; GSYM ATN_NEG; ATN_MONO_LT]);; + +let ATN_LT_PI4 = prove + (`!x. abs(x) < &1 ==> abs(atn x) < pi / &4`, + GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 < x ==> &0 < y) /\ + (x < &0 ==> y < &0) /\ + ((x = &0) ==> (y = &0)) /\ + (x < a ==> y < b) /\ + (--a < x ==> --b < y) + ==> abs(x) < a ==> abs(y) < b`) THEN + SIMP_TAC[ATN_LT_PI4_POS; ATN_LT_PI4_NEG; ATN_0] THEN CONJ_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ATN_0] THEN + SIMP_TAC[ATN_MONO_LT]);; + +let ATN_LE_PI4 = prove + (`!x. abs(x) <= &1 ==> abs(atn x) <= pi / &4`, + REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ATN_LT_PI4] THEN DISJ2_TAC THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP + (REAL_ARITH `(abs(x) = a) ==> (x = a) \/ (x = --a)`)) THEN + ASM_REWRITE_TAC[ATN_1; ATN_NEG] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NEG] THEN + SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiation of arcsin. *) +(* ------------------------------------------------------------------------- *) + +let COS_SIN_SQRT = prove( + `!x. &0 <= cos(x) ==> (cos(x) = sqrt(&1 - (sin(x) pow 2)))`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC (ONCE_REWRITE_RULE[REAL_ADD_SYM] (SPEC `x:real` SIN_CIRCLE)) THEN + REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[sqrt; num_CONV `2`] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN + ASM_REWRITE_TAC[]);; + +let COS_ASN_NZ = prove( + `!x. --(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ASN_BOUNDS_LT) THEN + REWRITE_TAC[COS_ZERO; DE_MORGAN_THM] THEN + CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN + X_GEN_TAC `n:num` THEN STRUCT_CASES_TAC(SPEC `n:num` num_CASES) THEN + REWRITE_TAC[EVEN] THEN STRIP_TAC THENL + [UNDISCH_TAC `asn(x) < (pi / &2)` THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `--(pi / &2) < asn(x)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_LT_NEG]] THEN + REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_ADDL] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]);; + +let DIFF_ASN_COS = prove( + `!x. --(&1) < x /\ x < &1 ==> (asn diffl (inv(cos(asn x))))(x)`, + REPEAT STRIP_TAC THEN + EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MP_TAC(SPEC `x:real` ASN_SIN) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC DIFF_INVERSE_LT THEN + MP_TAC(SPEC `x:real` ASN_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + MP_TAC(MATCH_MP INTERVAL_LEMMA_LT th)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[ABS_SUB]) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC SIN_ASN THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `cos(z)` THEN + REWRITE_TAC[DIFF_SIN]; + REWRITE_TAC[DIFF_SIN]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC COS_ASN_NZ THEN + ASM_REWRITE_TAC[]]);; + +let DIFF_ASN = prove( + `!x. --(&1) < x /\ x < &1 ==> (asn diffl (inv(sqrt(&1 - (x pow 2)))))(x)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ASN_COS) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `sin(asn x) = x` MP_TAC THENL + [MATCH_MP_TAC ASN_SIN THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (RAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN + MATCH_MP_TAC COS_SIN_SQRT THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ASN_BOUNDS_LT) THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC COS_POS_PI THEN + ASM_REWRITE_TAC[]]);; + +let DIFF_ASN_COMPOSITE = prove + (`(g diffl m)(x) /\ -- &1 < g(x) /\ g(x) < &1 + ==> ((\x. asn(g x)) diffl (inv(sqrt (&1 - g(x) pow 2)) * m))(x)`, + ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ASN]) in +add_to_diff_net DIFF_ASN_COMPOSITE;; + +(* ------------------------------------------------------------------------- *) +(* Differentiation of arccos. *) +(* ------------------------------------------------------------------------- *) + +let SIN_COS_SQRT = prove( + `!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC (SPEC `x:real` SIN_CIRCLE) THEN + REWRITE_TAC[GSYM REAL_EQ_SUB_LADD] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[sqrt; num_CONV `2`] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_ROOT_POS THEN + ASM_REWRITE_TAC[]);; + +let SIN_ACS_NZ = prove( + `!x. --(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ACS_BOUNDS_LT) THEN + REWRITE_TAC[SIN_ZERO; REAL_NEG_EQ0] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN + CONJ_TAC THEN CONV_TAC NOT_EXISTS_CONV THEN + (INDUCT_TAC THENL + [REWRITE_TAC[REAL_MUL_LZERO; EVEN; REAL_NEG_0] THEN + DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_LT_REFL]) THEN + CONTR_TAC(ASSUME `F`); ALL_TAC] THEN + SPEC_TAC(`n:num`,`n:num`) THEN REWRITE_TAC[EVEN] THEN + INDUCT_TAC THEN REWRITE_TAC[EVEN] THEN STRIP_TAC) THENL + [UNDISCH_TAC `acs(x) < pi` THEN + ASM_REWRITE_TAC[ADD1; GSYM REAL_ADD; REAL_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_LID; GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[REAL_HALF_DOUBLE] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_ADDL] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE; LE_0] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]; + UNDISCH_TAC `&0 < acs(x)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN + REWRITE_TAC[REAL_NEGNEG; REAL_NEG_LMUL; REAL_NEG_0] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE; LE_0] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[PI2_BOUNDS]]);; + +let DIFF_ACS_SIN = prove( + `!x. --(&1) < x /\ x < &1 ==> (acs diffl (inv(--(sin(acs x)))))(x)`, + REPEAT STRIP_TAC THEN + EVERY_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + MP_TAC(SPEC `x:real` ACS_COS) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC DIFF_INVERSE_LT THEN + MP_TAC(SPEC `x:real` ACS_BOUNDS_LT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + MP_TAC(MATCH_MP INTERVAL_LEMMA_LT th)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[ABS_SUB]) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC COS_ACS THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPEC `z:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC DIFF_CONT THEN EXISTS_TAC `--(sin(z))` THEN + REWRITE_TAC[DIFF_COS]; + REWRITE_TAC[DIFF_COS]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG] THEN + REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN + MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]]);; + +let DIFF_ACS = prove( + `!x. --(&1) < x /\ x < &1 ==> (acs diffl --(inv(sqrt(&1 - (x pow 2)))))(x)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIFF_ACS_SIN) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + IMP_SUBST_TAC (GSYM REAL_NEG_INV) THENL + [CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC SIN_ACS_NZ THEN ASM_REWRITE_TAC[]; + REPEAT AP_TERM_TAC] THEN + SUBGOAL_THEN `cos(acs x) = x` MP_TAC THENL + [MATCH_MP_TAC ACS_COS THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (RAND_CONV o ONCE_DEPTH_CONV) [GSYM th]) THEN + MATCH_MP_TAC SIN_COS_SQRT THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ACS_BOUNDS_LT) THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC SIN_POS_PI THEN + ASM_REWRITE_TAC[]]);; + +let DIFF_ACS_COMPOSITE = prove + (`(g diffl m)(x) /\ -- &1 < g(x) /\ g(x) < &1 + ==> ((\x. acs(g x)) diffl (--inv(sqrt(&1 - g(x) pow 2)) * m))(x)`, + ASM_SIMP_TAC[DIFF_CHAIN; DIFF_ACS]) in +add_to_diff_net DIFF_ACS_COMPOSITE;; + +(* ------------------------------------------------------------------------- *) +(* Back to normal service! *) +(* ------------------------------------------------------------------------- *) + +extend_basic_rewrites [BETA_THM];; + +(* ------------------------------------------------------------------------- *) +(* A kind of inverse to SIN_CIRCLE *) +(* ------------------------------------------------------------------------- *) + +let CIRCLE_SINCOS = prove + (`!x y. (x pow 2 + y pow 2 = &1) ==> ?t. (x = cos(t)) /\ (y = sin(t))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs(x) <= &1 /\ abs(y) <= &1` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `(&1 < x ==> &1 < x pow 2) /\ (&1 < y ==> &1 < y pow 2) /\ + &0 <= x pow 2 /\ &0 <= y pow 2 /\ x pow 2 + y pow 2 <= &1 + ==> x <= &1 /\ y <= &1`) THEN + ASM_REWRITE_TAC[REAL_POW2_ABS; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN + CONJ_TAC THEN DISCH_TAC THEN + SUBST1_TAC(SYM(REAL_RAT_REDUCE_CONV `&1 * &1`)) THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= sin(acs x)` MP_TAC THENL + [MATCH_MP_TAC SIN_POS_PI_LE THEN + MATCH_MP_TAC ACS_BOUNDS THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP SIN_COS_SQRT) THEN + SUBGOAL_THEN `abs(y) = sqrt(&1 - x pow 2)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN AP_TERM_TAC THEN + UNDISCH_TAC `x pow 2 + y pow 2 = &1` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `&0 <= y` THENL + [EXISTS_TAC `acs x`; EXISTS_TAC `--(acs x)`] THEN + ASM_SIMP_TAC[COS_NEG; SIN_NEG; ACS_COS; REAL_ARITH + `abs(x) <= &1 ==> --(&1) <= x /\ x <= &1`] + THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ (abs(y) = x) ==> (y = x)`); + MATCH_MP_TAC(REAL_ARITH `~(&0 <= y) /\ (abs(y) = x) ==> (y = --x)`)] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas. *) +(* ------------------------------------------------------------------------- *) + +let ACS_MONO_LT = prove + (`!x y. --(&1) < x /\ x < y /\ y < &1 ==> acs(y) < acs(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`acs`; `\x. --inv(sqrt(&1 - x pow 2))`; `x:real`; `y:real`] + MVT_ALT) THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC DIFF_ACS THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]; + REWRITE_TAC[REAL_EQ_SUB_RADD]] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `a * --c + x < x <=> &0 < a * c`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_LT_INV THEN MATCH_MP_TAC SQRT_POS_LT THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN REWRITE_TAC[REAL_POW_2] THEN + REWRITE_TAC[REAL_ARITH `&0 < &1 - z * z <=> z * z < &1 * &1`] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC);; + +(* ======================================================================== *) +(* Formalization of Kurzweil-Henstock gauge integral *) +(* ======================================================================== *) + +let LE_MATCH_TAC th (asl,w) = + let thi = PART_MATCH (rand o rator) th (rand(rator w)) in + let tm = rand(concl thi) in + (MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC th; ALL_TAC]) (asl,w);; + +(* ------------------------------------------------------------------------ *) +(* Some miscellaneous lemmas *) +(* ------------------------------------------------------------------------ *) + +let LESS_SUC_EQ = prove( + `!m n. m < SUC n <=> m <= n`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJUNCT2 LT; LE_LT] THEN + EQ_TAC THEN DISCH_THEN(DISJ_CASES_THEN(fun th -> REWRITE_TAC[th])));; + +let LESS_1 = prove( + `!n. n < 1 <=> (n = 0)`, + REWRITE_TAC[num_CONV `1`; LESS_SUC_EQ; CONJUNCT1 LE]);; + +(* ------------------------------------------------------------------------ *) +(* Divisions and tagged divisions etc. *) +(* ------------------------------------------------------------------------ *) + +let division = new_definition + `division(a,b) D <=> + (D 0 = a) /\ + (?N. (!n. n < N ==> D(n) < D(SUC n)) /\ + (!n. n >= N ==> (D(n) = b)))`;; + +let dsize = new_definition + `dsize D = + @N. (!n. n < N ==> D(n) < D(SUC n)) /\ + (!n. n >= N ==> (D(n) = D(N)))`;; + +let tdiv = new_definition + `tdiv(a,b) (D,p) <=> + division(a,b) D /\ + (!n. D(n) <= p(n) /\ p(n) <= D(SUC n))`;; + +(* ------------------------------------------------------------------------ *) +(* Gauges and gauge-fine divisions *) +(* ------------------------------------------------------------------------ *) + +let gauge = new_definition + `gauge(E) (g:real->real) <=> !x. E x ==> &0 < g(x)`;; + +let fine = new_definition + `fine(g:real->real) (D,p) <=> + !n. n < (dsize D) ==> (D(SUC n) - D(n)) < g(p(n))`;; + +(* ------------------------------------------------------------------------ *) +(* Riemann sum *) +(* ------------------------------------------------------------------------ *) + +let rsum = new_definition + `rsum (D,(p:num->real)) f = + sum(0,dsize(D))(\n. f(p n) * (D(SUC n) - D(n)))`;; + +(* ------------------------------------------------------------------------ *) +(* Gauge integrability (definite) *) +(* ------------------------------------------------------------------------ *) + +let defint = new_definition + `defint(a,b) f k <=> + !e. &0 < e ==> + ?g. gauge(\x. a <= x /\ x <= b) g /\ + !D p. tdiv(a,b) (D,p) /\ fine(g)(D,p) ==> + abs(rsum(D,p) f - k) < e`;; + +(* ------------------------------------------------------------------------ *) +(* Useful lemmas about the size of `trivial` divisions etc. *) +(* ------------------------------------------------------------------------ *) + +let DIVISION_0 = prove( + `!a b. (a = b) ==> (dsize(\n. if (n = 0) then a else b) = 0)`, + REPEAT GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[COND_ID] THEN + REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `n:num` THEN BETA_TAC THEN + REWRITE_TAC[REAL_LT_REFL; NOT_LT] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `0`) THEN REWRITE_TAC[CONJUNCT1 LE]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LE_0]]);; + +let DIVISION_1 = prove( + `!a b. a < b ==> (dsize(\n. if (n = 0) then a else b) = 1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dsize] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `n:num` THEN BETA_TAC THEN + REWRITE_TAC[NOT_SUC] THEN EQ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN CONJ_TAC THENL + [POP_ASSUM(MP_TAC o SPEC `1` o CONJUNCT1) THEN + REWRITE_TAC[ARITH] THEN + REWRITE_TAC[REAL_LT_REFL; NOT_LT]; + POP_ASSUM(MP_TAC o SPEC `2` o CONJUNCT2) THEN + REWRITE_TAC[num_CONV `2`; GE] THEN + CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[num_CONV `1`; NOT_SUC_LESS_EQ; CONJUNCT1 LE] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_SUC; NOT_IMP] THEN + REWRITE_TAC[LE_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN POP_ASSUM ACCEPT_TAC]; + DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[num_CONV `1`; CONJUNCT2 LT; NOT_LESS_0] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE; num_CONV `1`] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[CONJUNCT1 LE; GSYM NOT_SUC; NOT_SUC]]]);; + +let DIVISION_SINGLE = prove( + `!a b. a <= b ==> division(a,b)(\n. if (n = 0) then a else b)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[division] THEN + BETA_TAC THEN REWRITE_TAC[] THEN + POP_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [EXISTS_TAC `1` THEN CONJ_TAC THEN X_GEN_TAC `n:num` THENL + [REWRITE_TAC[LESS_1] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[NOT_SUC]; + REWRITE_TAC[GE] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[num_CONV `1`] THEN + REWRITE_TAC[GSYM NOT_LT; LESS_SUC_REFL]]; + EXISTS_TAC `0` THEN REWRITE_TAC[NOT_LESS_0] THEN + ASM_REWRITE_TAC[COND_ID]]);; + +let DIVISION_LHS = prove( + `!D a b. division(a,b) D ==> (D(0) = a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let DIVISION_THM = prove( + `!D a b. division(a,b) D <=> + (D(0) = a) /\ + (!n. n < (dsize D) ==> D(n) < D(SUC n)) /\ + (!n. n >= (dsize D) ==> (D(n) = b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[division] THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; EXISTS_TAC `dsize D` THEN ASM_REWRITE_TAC[]] THEN + POP_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o CONJUNCT2) THEN + SUBGOAL_THEN `dsize D = N` (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[dsize] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `M:num` THEN BETA_TAC THEN EQ_TAC THENL + [ALL_TAC; DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `N:num` (ASSUME `!n:num. n >= N ==> (D n :real = b)`)) THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[GE; LE_REFL]) THEN + DISCH_THEN SUBST1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`M:num`; `N:num`] LESS_LESS_CASES) THEN + ASM_REWRITE_TAC[] THENL + [DISCH_THEN(MP_TAC o SPEC `SUC M` o CONJUNCT2) THEN + REWRITE_TAC[GE; LESS_EQ_SUC_REFL] THEN DISCH_TAC THEN + UNDISCH_TAC `!n. n < N ==> (D n) < (D(SUC n))` THEN + DISCH_THEN(MP_TAC o SPEC `M:num`) THEN ASM_REWRITE_TAC[REAL_LT_REFL]; + DISCH_THEN(MP_TAC o SPEC `N:num` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `!n:num. n >= N ==> (D n :real = b)` THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `N:num` th) THEN + MP_TAC(SPEC `SUC N` th)) THEN + REWRITE_TAC[GE; LESS_EQ_SUC_REFL; LE_REFL] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_LT_REFL]]);; + +let DIVISION_RHS = prove( + `!D a b. division(a,b) D ==> (D(dsize D) = b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN + DISCH_THEN(MP_TAC o SPEC `dsize D` o last o CONJUNCTS) THEN + REWRITE_TAC[GE; LE_REFL]);; + +let DIVISION_LT_GEN = prove( + `!D a b m n. division(a,b) D /\ + m < n /\ + n <= (dsize D) ==> D(m) < D(n)`, + REPEAT STRIP_TAC THEN UNDISCH_TAC `m:num < n` THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` MP_TAC o MATCH_MP LESS_ADD_1) THEN + REWRITE_TAC[GSYM ADD1] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `(m + (SUC d)) <= (dsize D)` THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES] THEN + DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIVISION_THM]) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[ADD_CLAUSES] THEN + DISCH_THEN(MP_TAC o MATCH_MP OR_LESS) THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `D(m + (SUC d)):real` THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN + MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ADD_CLAUSES] THEN + FIRST_ASSUM(MATCH_MP_TAC o el 1 o + CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN + ASM_REWRITE_TAC[]]]);; + +let DIVISION_LT = prove( + `!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(0) < D(SUC n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_THM] THEN STRIP_TAC THEN + INDUCT_TAC THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `D(SUC n):real` THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `D(0):real = a` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]);; + +let DIVISION_LE = prove( + `!D a b. division(a,b) D ==> a <= b`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN + POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN + UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + UNDISCH_TAC `!n. n >= (dsize D) ==> (D n = b)` THEN + DISCH_THEN(MP_TAC o SPEC `dsize D`) THEN + REWRITE_TAC[GE; LE_REFL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_THEN(MP_TAC o SPEC `PRE(dsize D)`) THEN + STRUCT_CASES_TAC(SPEC `dsize D` num_CASES) THEN + ASM_REWRITE_TAC[PRE; REAL_LE_REFL; LESS_SUC_REFL; REAL_LT_IMP_LE]);; + +let DIVISION_GT = prove( + `!D a b. division(a,b) D ==> !n. n < (dsize D) ==> D(n) < D(dsize D)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_LT_GEN THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[LE_REFL]);; + +let DIVISION_EQ = prove( + `!D a b. division(a,b) D ==> ((a = b) <=> (dsize D = 0))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_LT) THEN + POP_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[DIVISION_THM]) THEN + UNDISCH_TAC `D(0):real = a` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + UNDISCH_TAC `!n. n >= (dsize D) ==> (D n = b)` THEN + DISCH_THEN(MP_TAC o SPEC `dsize D`) THEN + REWRITE_TAC[GE; LE_REFL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_THEN(MP_TAC o SPEC `PRE(dsize D)`) THEN + STRUCT_CASES_TAC(SPEC `dsize D` num_CASES) THEN + ASM_REWRITE_TAC[PRE; NOT_SUC; LESS_SUC_REFL; REAL_LT_IMP_NE]);; + +let DIVISION_LBOUND = prove( + `!D a b r. division(a,b) D ==> a <= D(r)`, + REWRITE_TAC[DIVISION_THM; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + DISJ_CASES_TAC(SPECL [`SUC r`; `dsize D`] LTE_CASES) THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(D:num->real) r` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC r` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_LE THEN + EXISTS_TAC `D:num->real` THEN ASM_REWRITE_TAC[DIVISION_THM]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE]]]);; + +let DIVISION_LBOUND_LT = prove( + `!D a b n. division(a,b) D /\ ~(dsize D = 0) ==> a < D(SUC n)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_LHS) THEN + DISJ_CASES_TAC(SPECL [`dsize D`; `SUC n`] LTE_CASES) THENL + [FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[GE] THEN + IMP_RES_THEN ASSUME_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN + ASM_REWRITE_TAC[GSYM NOT_LE; CONJUNCT1 LE]; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_LT) THEN + MATCH_MP_TAC OR_LESS THEN ASM_REWRITE_TAC[]]);; + +let DIVISION_UBOUND = prove( + `!D a b r. division(a,b) D ==> D(r) <= b`, + REWRITE_TAC[DIVISION_THM] THEN REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`r:num`; `dsize D`] LTE_CASES) THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GE]] THEN + SUBGOAL_THEN `!r. D((dsize D) - r) <= b` MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `(dsize D) - r`) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP SUB_SUB + (MATCH_MP LT_IMP_LE th)]) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB]] THEN + UNDISCH_TAC `r < (dsize D)` THEN DISCH_THEN(K ALL_TAC) THEN + INDUCT_TAC THENL + [REWRITE_TAC[SUB_0] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GE; LE_REFL]; + ALL_TAC] THEN + DISJ_CASES_TAC(SPECL [`r:num`; `dsize D`] LTE_CASES) THENL + [ALL_TAC; + SUBGOAL_THEN `(dsize D) - (SUC r) = 0` SUBST1_TAC THENL + [REWRITE_TAC[SUB_EQ_0] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `r:num` THEN ASM_REWRITE_TAC[LESS_EQ_SUC_REFL]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LE THEN + EXISTS_TAC `D:num->real` THEN ASM_REWRITE_TAC[DIVISION_THM]]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `D((dsize D) - r):real` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(dsize D) - r = SUC((dsize D) - (SUC r))` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LESS_CASES_IMP THEN + REWRITE_TAC[NOT_LT; LE_LT; SUB_LESS_EQ] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + REWRITE_TAC[SUB_EQ_EQ_0; NOT_SUC] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `r < 0` THEN REWRITE_TAC[NOT_LESS_0]] THEN + MP_TAC(SPECL [`dsize D`; `SUC r`] (CONJUNCT2 SUB_OLD)) THEN + COND_CASES_TAC THENL + [REWRITE_TAC[SUB_EQ_0; LE_SUC] THEN + ASM_REWRITE_TAC[GSYM NOT_LT]; + DISCH_THEN (SUBST1_TAC o SYM) THEN REWRITE_TAC[SUB_SUC]]);; + +let DIVISION_UBOUND_LT = prove( + `!D a b n. division(a,b) D /\ + n < dsize D ==> D(n) < b`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP DIVISION_RHS) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP DIVISION_GT) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Divisions of adjacent intervals can be combined into one *) +(* ------------------------------------------------------------------------ *) + +let DIVISION_APPEND_LEMMA1 = prove( + `!a b c D1 D2. division(a,b) D1 /\ division(b,c) D2 ==> + (!n. n < ((dsize D1) + (dsize D2)) ==> + (\n. if (n < (dsize D1)) then D1(n) else + D2(n - (dsize D1)))(n) < + (\n. if (n < (dsize D1)) then D1(n) else D2(n - (dsize D1)))(SUC n)) /\ + (!n. n >= ((dsize D1) + (dsize D2)) ==> + ((\n. if (n < (dsize D1)) then D1(n) else + D2(n - (dsize D1)))(n) = (\n. if (n < (dsize D1)) then D1(n) else + D2(n - (dsize D1)))((dsize D1) + (dsize D2))))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THENL + [ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THEN + ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; + UNDISCH_TAC `division(a,b) D1` THEN REWRITE_TAC[DIVISION_THM] THEN + STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM ACCEPT_TAC]; + ASM_CASES_TAC `n < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL + [RULE_ASSUM_TAC(REWRITE_RULE[NOT_LT]) THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_UBOUND_LT THEN + EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC DIVISION_LBOUND THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]]; + UNDISCH_TAC `~(n < (dsize D1))` THEN + REWRITE_TAC[NOT_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o + REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[SUB_OLD; GSYM NOT_LE; LE_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + FIRST_ASSUM(MATCH_MP_TAC o el 1 o CONJUNCTS o + REWRITE_RULE[DIVISION_THM]) THEN + UNDISCH_TAC `((dsize D1) + d) < + ((dsize D1) + (dsize D2))` THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LT_ADD_RCANCEL]]]; + REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[NOT_LE] THEN COND_CASES_TAC THEN + UNDISCH_TAC `n >= ((dsize D1) + (dsize D2))` THENL + [CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN + REWRITE_TAC[GE; NOT_LE] THEN + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `dsize D1` THEN + ASM_REWRITE_TAC[LE_ADD]; + REWRITE_TAC[GE; LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ADD_SUB] THEN + FIRST_ASSUM(CHANGED_TAC o + (SUBST1_TAC o MATCH_MP DIVISION_RHS)) THEN + FIRST_ASSUM(MATCH_MP_TAC o el 2 o CONJUNCTS o + REWRITE_RULE[DIVISION_THM]) THEN + REWRITE_TAC[GE; LE_ADD]]]);; + +let DIVISION_APPEND_LEMMA2 = prove( + `!a b c D1 D2. division(a,b) D1 /\ division(b,c) D2 ==> + (dsize(\n. if (n < (dsize D1)) then D1(n) else + D2(n - (dsize D1))) = dsize(D1) + dsize(D2))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [dsize] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `N:num` THEN BETA_TAC THEN EQ_TAC THENL + [DISCH_THEN((then_) (MATCH_MP_TAC LESS_EQUAL_ANTISYM) o MP_TAC) THEN + CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_LE] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [DISJ1_TAC THEN + DISCH_THEN(MP_TAC o SPEC `dsize(D1) + dsize(D2)`) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN + SUBGOAL_THEN `!x y. x <= SUC(x + y)` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `x + y:num` THEN + REWRITE_TAC[LE_ADD; LESS_EQ_SUC_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUB_OLD; GSYM NOT_LE] THEN + REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ADD_SUB] THEN + MP_TAC(ASSUME `division(b,c) D2`) THEN REWRITE_TAC[DIVISION_THM] THEN + DISCH_THEN(MP_TAC o SPEC `SUC(dsize D2)` o el 2 o CONJUNCTS) THEN + REWRITE_TAC[GE; LESS_EQ_SUC_REFL] THEN + DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN + REWRITE_TAC[REAL_LT_REFL]; + DISJ2_TAC THEN + DISCH_THEN(MP_TAC o SPEC `dsize(D1) + dsize(D2)`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LT_IMP_LE) THEN + ASM_REWRITE_TAC[GE] THEN + REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `D1(N:num) < D2(dsize D2)` MP_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN + ASM_REWRITE_TAC[GSYM NOT_LE]; + MATCH_MP_TAC DIVISION_LBOUND THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]]; + CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]; + RULE_ASSUM_TAC(REWRITE_RULE[]) THEN + SUBGOAL_THEN `D2(N - (dsize D1)) < D2(dsize D2)` MP_TAC THENL + [MATCH_MP_TAC DIVISION_LT_GEN THEN + MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN + ASM_REWRITE_TAC[LE_REFL] THEN + REWRITE_TAC[GSYM NOT_LE] THEN + REWRITE_TAC[SUB_LEFT_LESS_EQ; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[NOT_LE] THEN + UNDISCH_TAC `dsize(D1) <= N` THEN + REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[LT_ADD_RCANCEL]) THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `d:num` THEN + ASM_REWRITE_TAC[LE_0]; + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LT_REFL]]]]; + DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(SUC n) < (dsize(D1))` THEN + ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `n < (dsize(D1))` ASSUME_TAC THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_LT_GEN THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[LESS_SUC_REFL] THEN + MATCH_MP_TAC LT_IMP_LE THEN ASM_REWRITE_TAC[]; + COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `b:real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_UBOUND_LT THEN EXISTS_TAC `a:real` THEN + ASM_REWRITE_TAC[]; + FIRST_ASSUM(MATCH_ACCEPT_TAC o MATCH_MP DIVISION_LBOUND)]; + MATCH_MP_TAC DIVISION_LT_GEN THEN + MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[SUB_OLD; LESS_SUC_REFL]; ALL_TAC] THEN + REWRITE_TAC[REWRITE_RULE[GE] SUB_LEFT_GREATER_EQ] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[LE_SUC_LT]]]; + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN + SUBGOAL_THEN `(dsize D1) <= n` ASSUME_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `dsize D1 + dsize D2` THEN + ASM_REWRITE_TAC[LE_ADD]; + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ADD_SUB] THEN + FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_RHS) THEN + FIRST_ASSUM(MATCH_MP_TAC o el 2 o + CONJUNCTS o REWRITE_RULE[DIVISION_THM]) THEN + REWRITE_TAC[GE; SUB_LEFT_LESS_EQ] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[]]]]);; + +let DIVISION_APPEND_EXPLICIT = prove + (`!a b c g d1 p1 d2 p2. + tdiv(a,b) (d1,p1) /\ + fine g (d1,p1) /\ + tdiv(b,c) (d2,p2) /\ + fine g (d2,p2) + ==> tdiv(a,c) + ((\n. if n < dsize d1 then d1(n) else d2(n - (dsize d1))), + (\n. if n < dsize d1 + then p1(n) else p2(n - (dsize d1)))) /\ + fine g ((\n. if n < dsize d1 then d1(n) else d2(n - (dsize d1))), + (\n. if n < dsize d1 + then p1(n) else p2(n - (dsize d1)))) /\ + !f. rsum((\n. if n < dsize d1 then d1(n) else d2(n - (dsize d1))), + (\n. if n < dsize d1 + then p1(n) else p2(n - (dsize d1)))) f = + rsum(d1,p1) f + rsum(d2,p2) f`, + MAP_EVERY X_GEN_TAC + [`a:real`; `b:real`; `c:real`; `g:real->real`; + `D1:num->real`; `p1:num->real`; `D2:num->real`; `p2:num->real`] THEN + STRIP_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + GEN_TAC THEN REWRITE_TAC[rsum] THEN + MP_TAC(SPECL [`a:real`; `b:real`; `c:real`; + `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN + ANTS_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_SPLIT] THEN + REWRITE_TAC[SUM_REINDEX] THEN BINOP_TAC THEN MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[ADD_CLAUSES; ARITH_RULE `~(r + d < d:num)`; + ARITH_RULE `~(SUC(r + d) < d)`; ADD_SUB; + ARITH_RULE `SUC(r + d) - d = SUC r`] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `k < n ==> (SUC k < n <=> ~(n = SUC k))`] THEN + ASM_CASES_TAC `dsize D1 = SUC k` THEN ASM_REWRITE_TAC[SUB_REFL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_MESON_TAC[tdiv; DIVISION_LHS; DIVISION_RHS]] THEN + DISJ_CASES_TAC(GSYM (SPEC `dsize(D1)` LESS_0_CASES)) THENL + [ASM_REWRITE_TAC[NOT_LESS_0; SUB_0] THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + SUBGOAL_THEN `a:real = b` (fun th -> ASM_REWRITE_TAC[th]) THEN + MP_TAC(SPECL [`D1:num->real`; `a:real`; `b:real`] DIVISION_EQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[fine] THEN X_GEN_TAC `n:num` THEN + RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN + MP_TAC(SPECL [`a:real`; `b:real`; `c:real`; + `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN BETA_TAC THEN + DISCH_TAC THEN ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN + ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `n < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `SUC n = dsize D1` ASSUME_TAC THENL + [MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN + ASM_REWRITE_TAC[GSYM NOT_LT] THEN + REWRITE_TAC[NOT_LT] THEN MATCH_MP_TAC LESS_OR THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[SUB_REFL] THEN + FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o + CONJUNCT1) THEN + FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o + MATCH_MP DIVISION_RHS o CONJUNCT1) THEN + SUBST1_TAC(SYM(ASSUME `SUC n = dsize D1`)) THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[SUB_OLD] THEN UNDISCH_TAC `~(n < (dsize D1))` THEN + REWRITE_TAC[LE_EXISTS; NOT_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[fine]) THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[ADD_SYM]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[LT_ADD_RCANCEL]) THEN + FIRST_ASSUM ACCEPT_TAC]] THEN + REWRITE_TAC[tdiv] THEN BETA_TAC THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN + REWRITE_TAC[DIVISION_THM] THEN CONJ_TAC THENL + [BETA_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIVISION_LHS THEN EXISTS_TAC `b:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `c = (\n. if (n < (dsize D1)) then D1(n) else D2(n - + (dsize D1))) (dsize(D1) + dsize(D2))` SUBST1_TAC THENL + [BETA_TAC THEN REWRITE_TAC[GSYM NOT_LE; LE_ADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC DIVISION_RHS THEN + EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`a:real`; `b:real`; `c:real`; + `D1:num->real`; `D2:num->real`] DIVISION_APPEND_LEMMA2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC (BETA_RULE DIVISION_APPEND_LEMMA1) THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`; `c:real`] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `n:num` THEN RULE_ASSUM_TAC(REWRITE_RULE[tdiv]) THEN + ASM_CASES_TAC `(SUC n) < (dsize D1)` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `n < (dsize D1)` ASSUME_TAC THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[SUB_OLD] THEN + FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o MATCH_MP DIVISION_LHS o + CONJUNCT1) THEN + FIRST_ASSUM(CHANGED_TAC o SUBST1_TAC o SYM o + MATCH_MP DIVISION_RHS o CONJUNCT1) THEN + SUBGOAL_THEN `dsize D1 = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC LESS_EQUAL_ANTISYM THEN + ASM_REWRITE_TAC[GSYM NOT_LT] THEN REWRITE_TAC[NOT_LT] THEN + MATCH_MP_TAC LESS_OR THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[SUB_OLD]]);; + +let DIVISION_APPEND_STRONG = prove + (`!a b c D1 p1 D2 p2. + tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1) /\ + tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2) + ==> ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p) /\ + !f. rsum(D,p) f = rsum(D1,p1) f + rsum(D2,p2) f`, + REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`\n. if n < dsize D1 then D1(n):real else D2(n - (dsize D1))`; + `\n. if n < dsize D1 then p1(n):real else p2(n - (dsize D1))`] THEN + MATCH_MP_TAC DIVISION_APPEND_EXPLICIT THEN ASM_MESON_TAC[]);; + +let DIVISION_APPEND = prove( + `!a b c. + (?D1 p1. tdiv(a,b) (D1,p1) /\ fine(g) (D1,p1)) /\ + (?D2 p2. tdiv(b,c) (D2,p2) /\ fine(g) (D2,p2)) ==> + ?D p. tdiv(a,c) (D,p) /\ fine(g) (D,p)`, + MESON_TAC[DIVISION_APPEND_STRONG]);; + +(* ------------------------------------------------------------------------ *) +(* We can always find a division which is fine wrt any gauge *) +(* ------------------------------------------------------------------------ *) + +let DIVISION_EXISTS = prove( + `!a b g. a <= b /\ gauge(\x. a <= x /\ x <= b) g ==> + ?D p. tdiv(a,b) (D,p) /\ fine(g) (D,p)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + (MP_TAC o C SPEC BOLZANO_LEMMA) + `\(u,v). a <= u /\ v <= b ==> ?D p. tdiv(u,v) (D,p) /\ fine(g) (D,p)` THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC; + DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`]) THEN + REWRITE_TAC[REAL_LE_REFL]] + THENL + [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVISION_APPEND THEN + EXISTS_TAC `v:real` THEN CONJ_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `w:real`; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `u:real`] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:real` THEN ASM_CASES_TAC `a <= x /\ x <= b` THENL + [ALL_TAC; + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + MAP_EVERY X_GEN_TAC [`w:real`; `y:real`] THEN STRIP_TAC THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_neg o concl) THEN + REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [DISJ1_TAC THEN MATCH_MP_TAC REAL_LET_TRANS; + DISJ2_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS] THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]] THEN + UNDISCH_TAC `gauge(\x. a <= x /\ x <= b) g` THEN + REWRITE_TAC[gauge] THEN BETA_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o MATCH_MP th)) THEN + EXISTS_TAC `(g:real->real) x` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`w:real`; `y:real`] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `\n. if (n = 0) then (w:real) else y` THEN + EXISTS_TAC `\n. if (n = 0) then (x:real) else y` THEN + SUBGOAL_THEN `w <= y` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[tdiv] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_SINGLE THEN FIRST_ASSUM ACCEPT_TAC; + X_GEN_TAC `n:num` THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]]; + REWRITE_TAC[fine] THEN BETA_TAC THEN REWRITE_TAC[NOT_SUC] THEN + X_GEN_TAC `n:num` THEN + DISJ_CASES_THEN MP_TAC (REWRITE_RULE[REAL_LE_LT] (ASSUME `w <= y`)) THENL + [DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_1) THEN + ASM_REWRITE_TAC[num_CONV `1`; CONJUNCT2 LT; NOT_LESS_0] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o MATCH_MP DIVISION_0) THEN + REWRITE_TAC[NOT_LESS_0]]]);; + +(* ------------------------------------------------------------------------ *) +(* Lemmas about combining gauges *) +(* ------------------------------------------------------------------------ *) + +let GAUGE_MIN = prove( + `!E g1 g2. gauge(E) g1 /\ gauge(E) g2 ==> + gauge(E) (\x. if g1(x) < g2(x) then g1(x) else g2(x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[gauge] THEN STRIP_TAC THEN + X_GEN_TAC `x:real` THEN BETA_TAC THEN DISCH_TAC THEN + COND_CASES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM ACCEPT_TAC);; + +let FINE_MIN = prove( + `!g1 g2 D p. fine (\x. if g1(x) < g2(x) then g1(x) else g2(x)) (D,p) ==> + fine(g1) (D,p) /\ fine(g2) (D,p)`, + REPEAT GEN_TAC THEN REWRITE_TAC[fine] THEN + BETA_TAC THEN DISCH_TAC THEN CONJ_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN + MATCH_MP_TAC REAL_LTE_TRANS; + MATCH_MP_TAC REAL_LT_TRANS] THEN + FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN + ASM_REWRITE_TAC[] THEN NO_TAC));; + +(* ------------------------------------------------------------------------ *) +(* The integral is unique if it exists *) +(* ------------------------------------------------------------------------ *) + +let DINT_UNIQ = prove( + `!a b f k1 k2. a <= b /\ defint(a,b) f k1 /\ defint(a,b) f k2 ==> (k1 = k2)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_0] THEN + CONV_TAC CONTRAPOS_CONV THEN ONCE_REWRITE_TAC[ABS_NZ] THEN DISCH_TAC THEN + REWRITE_TAC[defint] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o SPEC `abs(k1 - k2) / &2`)) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`\x. a <= x /\ x <= b`; + `g1:real->real`; `g2:real->real`] GAUGE_MIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(SPECL [`a:real`; `b:real`; + `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`] DIVISION_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `D:num->real` (X_CHOOSE_THEN `p:num->real` + STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FINE_MIN) THEN + REPEAT(FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPECL [`D:num->real`; `p:num->real`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC) THEN + SUBGOAL_THEN `abs((rsum(D,p) f - k2) - (rsum(D,p) f - k1)) < abs(k1 - k2)` + MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(rsum(D,p) f - k2) + abs(rsum(D,p) f - k1)` THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_sub] THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM ABS_NEG] THEN + MATCH_ACCEPT_TAC ABS_TRIANGLE; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEG_SUB] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (d + a) + (c + b)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID; REAL_LT_REFL]]);; + +(* ------------------------------------------------------------------------ *) +(* Integral over a null interval is 0 *) +(* ------------------------------------------------------------------------ *) + +let INTEGRAL_NULL = prove( + `!f a. defint(a,a) f (&0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN GEN_TAC THEN + DISCH_TAC THEN EXISTS_TAC `\x:real. &1` THEN + REWRITE_TAC[gauge; REAL_LT_01] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[tdiv] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_EQ) THEN + REWRITE_TAC[rsum] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[sum; REAL_SUB_REFL; ABS_0]);; + +(* ------------------------------------------------------------------------ *) +(* Fundamental theorem of calculus (Part I) *) +(* ------------------------------------------------------------------------ *) + +let STRADDLE_LEMMA = prove( + `!f f' a b e. (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ &0 < e + ==> ?g. gauge(\x. a <= x /\ x <= b) g /\ + !x u v. a <= u /\ u <= x /\ x <= v /\ v <= b /\ (v - u) < g(x) + ==> abs((f(v) - f(u)) - (f'(x) * (v - u))) <= e * (v - u)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[gauge] THEN BETA_TAC THEN + SUBGOAL_THEN + `!x. a <= x /\ x <= b ==> + ?d. &0 < d /\ + !u v. u <= x /\ x <= v /\ (v - u) < d ==> + abs((f(v) - f(u)) - (f'(x) * (v - u))) <= e * (v - u)` MP_TAC THENL + [ALL_TAC; + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o CONV_RULE + ((ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV) THENC OLD_SKOLEM_CONV)) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `g:real->real` THEN CONJ_TAC THENL + [GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]); + REPEAT STRIP_TAC THEN + C SUBGOAL_THEN (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) + `a <= x /\ x <= b` THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `u:real`; EXISTS_TAC `v:real`] THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]]]] THEN + X_GEN_TAC `x:real` THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[diffl; LIM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + BETA_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!z. abs(z - x) < d ==> + abs((f(z) - f(x)) - (f'(x) * (z - x))) <= (e / &2) * abs(z - x)` + ASSUME_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `&0 < abs(z - x)` THENL + [ALL_TAC; + UNDISCH_TAC `~(&0 < abs(z - x))` THEN + REWRITE_TAC[GSYM ABS_NZ; REAL_SUB_0] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; ABS_0; REAL_LE_REFL]] THEN + DISCH_THEN(MP_TAC o CONJ (ASSUME `&0 < abs(z - x)`)) THEN + DISCH_THEN((then_) (MATCH_MP_TAC REAL_LT_IMP_LE) o MP_TAC) THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV + [GSYM(MATCH_MP REAL_LT_RMUL_EQ th)]) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM ABS_MUL] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_SUB_ADD2] THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + ASM_REWRITE_TAC[ABS_NZ]; ALL_TAC] THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `u <= v` (DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]; + ALL_TAC; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; ABS_0; REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((f(v) - f(x)) - (f'(x) * (v - x))) + + abs((f(x) - f(u)) - (f'(x) * (x - u)))` THEN + CONJ_TAC THENL + [MP_TAC(SPECL[`(f(v) - f(x)) - (f'(x) * (v - x))`; + `(f(x) - f(u)) - (f'(x) * (x - u))`] ABS_TRIANGLE) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN REPEAT AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_ADD2_SUB2] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + SUBGOAL_THEN `!a b c. (a - b) + (b - c) = (a - c)` + (fun th -> REWRITE_TAC[th]) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[real_sub] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC + `(a + b) + (c + d) = (b + c) + (a + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_HALF_DOUBLE] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(e / &2) * abs(v - x)` THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_sub; REAL_LE_LADD] THEN + ASM_REWRITE_TAC[REAL_LE_NEG]; + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN + GEN_REWRITE_TAC LAND_CONV + [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; + MATCH_MP REAL_LE_LMUL_LOCAL (ASSUME `&0 < e`)] THEN + SUBGOAL_THEN `!x y. (x * inv(&2)) <= (y * inv(&2)) <=> x <= y` + (fun th -> ASM_REWRITE_TAC[th; real_sub; REAL_LE_LADD; REAL_LE_NEG]) THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN + MATCH_MP_TAC REAL_INV_POS THEN + REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(e / &2) * abs(x - u)` THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [real_sub] THEN + ONCE_REWRITE_TAC[GSYM ABS_NEG] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_SUB] THEN + ONCE_REWRITE_TAC[REAL_NEG_RMUL] THEN + REWRITE_TAC[REAL_NEG_SUB] THEN REWRITE_TAC[GSYM real_sub] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[ABS_SUB] THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v - u` THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[real_sub; REAL_LE_RADD]; + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN REWRITE_TAC[real_div] THEN + GEN_REWRITE_TAC LAND_CONV + [AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; + MATCH_MP REAL_LE_LMUL_LOCAL (ASSUME `&0 < e`)] THEN + SUBGOAL_THEN `!x y. (x * inv(&2)) <= (y * inv(&2)) <=> x <= y` + (fun th -> ASM_REWRITE_TAC[th; real_sub; REAL_LE_RADD; REAL_LE_NEG]) THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_RMUL_EQ THEN + MATCH_MP_TAC REAL_INV_POS THEN + REWRITE_TAC[REAL_LT; num_CONV `2`; LT_0]]]);; + +let FTC1 = prove( + `!f f' a b. a <= b /\ (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) + ==> defint(a,b) f' (f(b) - f(a))`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC `a <= b` THEN REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[REAL_SUB_REFL; INTEGRAL_NULL]] THEN + REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!e. &0 < e ==> + ?g. gauge(\x. a <= x /\ x <= b)g /\ + (!D p. + tdiv(a,b)(D,p) /\ fine g(D,p) ==> + (abs((rsum(D,p)f') - ((f b) - (f a)))) <= e)` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_LT_HALF1] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2` THEN + ASM_REWRITE_TAC[REAL_LT_HALF2]] THEN + UNDISCH_TAC `&0 < e` THEN DISCH_THEN(K ALL_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`f:real->real`; `f':real->real`; + `a:real`; `b:real`; `e / (b - a)`] STRADDLE_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < e / (b - a)` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_POS THEN + ASM_REWRITE_TAC[REAL_SUB_LT]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`D:num->real`; `p:num->real`] THEN + REWRITE_TAC[tdiv] THEN STRIP_TAC THEN REWRITE_TAC[rsum] THEN + SUBGOAL_THEN `f(b) - f(a) = sum(0,dsize D)(\n. f(D(SUC n)) - f(D(n)))` + SUBST1_TAC THENL + [MP_TAC(SPECL [`\n:num. (f:real->real)(D(n))`; `0`; `dsize D`] + SUM_CANCEL) THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS; DIVISION_RHS] THEN + REFL_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[ABS_SUB] THEN REWRITE_TAC[GSYM SUM_SUB] THEN BETA_TAC THEN + LE_MATCH_TAC ABS_SUM THEN BETA_TAC THEN + SUBGOAL_THEN `e = sum(0,dsize D)(\n. (e / (b - a)) * (D(SUC n) - D(n)))` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SYM(BETA_CONV `(\n. (D(SUC n) - D(n))) n`)] THEN + ASM_REWRITE_TAC[SUM_CMUL; SUM_CANCEL; ADD_CLAUSES] THEN + MAP_EVERY (IMP_RES_THEN SUBST1_TAC) [DIVISION_LHS; DIVISION_RHS] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_DIV_RMUL THEN + REWRITE_TAC[REAL_SUB_0] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC REAL_LT_IMP_NE THEN FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE THEN X_GEN_TAC `r:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN BETA_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [IMP_RES_THEN (fun th -> REWRITE_TAC[th]) DIVISION_LBOUND; + IMP_RES_THEN (fun th -> REWRITE_TAC[th]) DIVISION_UBOUND; + UNDISCH_TAC `fine(g)(D,p)` THEN REWRITE_TAC[fine] THEN + DISCH_THEN MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of integral and integrability. *) +(* ------------------------------------------------------------------------- *) + +let integrable = new_definition + `integrable(a,b) f = ?i. defint(a,b) f i`;; + +let integral = new_definition + `integral(a,b) f = @i. defint(a,b) f i`;; + +let INTEGRABLE_DEFINT = prove + (`!f a b. integrable(a,b) f ==> defint(a,b) f (integral(a,b) f)`, + REPEAT GEN_TAC THEN REWRITE_TAC[integrable; integral] THEN + CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Other more or less trivial lemmas. *) +(* ------------------------------------------------------------------------- *) + +let DIVISION_BOUNDS = prove + (`!d a b. division(a,b) d ==> !n. a <= d(n) /\ d(n) <= b`, + MESON_TAC[DIVISION_UBOUND; DIVISION_LBOUND]);; + +let TDIV_BOUNDS = prove + (`!d p a b. tdiv(a,b) (d,p) + ==> !n. a <= d(n) /\ d(n) <= b /\ a <= p(n) /\ p(n) <= b`, + REWRITE_TAC[tdiv] THEN ASM_MESON_TAC[DIVISION_BOUNDS; REAL_LE_TRANS]);; + +let TDIV_LE = prove + (`!d p a b. tdiv(a,b) (d,p) ==> a <= b`, + MESON_TAC[tdiv; DIVISION_LE]);; + +let DEFINT_WRONG = prove + (`!a b f i. b < a ==> defint(a,b) f i`, + REWRITE_TAC[defint; gauge] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `\x:real. &0` THEN + ASM_SIMP_TAC[REAL_ARITH `b < a ==> (a <= x /\ x <= b <=> F)`] THEN + ASM_MESON_TAC[REAL_NOT_LE; TDIV_LE]);; + +let DEFINT_INTEGRAL = prove + (`!f a b i. a <= b /\ defint(a,b) f i ==> integral(a,b) f = i`, + REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[DINT_UNIQ]);; + +(* ------------------------------------------------------------------------- *) +(* Linearity. *) +(* ------------------------------------------------------------------------- *) + +let DEFINT_CONST = prove + (`!a b c. defint(a,b) (\x. c) (c * (b - a))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`\x. c * x`; `\x:real. c:real`; `a:real`; `b:real`] FTC1) THEN + DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN + ASM_SIMP_TAC[DEFINT_WRONG; REAL_SUB_LDISTRIB] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x:real` (DIFF_CONV `\x. c * x`)) THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; REAL_ADD_LID]);; + +let DEFINT_0 = prove + (`!a b. defint(a,b) (\x. &0) (&0)`, + MP_TAC DEFINT_CONST THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[REAL_MUL_LZERO]);; + +let DEFINT_NEG = prove + (`!f a b i. defint(a,b) f i ==> defint(a,b) (\x. --f x) (--i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN + REWRITE_TAC[rsum; REAL_MUL_LNEG; SUM_NEG] THEN + REWRITE_TAC[REAL_ARITH `abs(--x - --y) = abs(x - y)`]);; + +let DEFINT_CMUL = prove + (`!f a b c i. defint(a,b) f i ==> defint(a,b) (\x. c * f x) (c * i)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL + [MP_TAC(SPECL [`a:real`; `b:real`; `c:real`] DEFINT_CONST) THEN + ASM_SIMP_TAC[REAL_MUL_LZERO]; + ALL_TAC] THEN + REWRITE_TAC[defint] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / abs c`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; GSYM REAL_ABS_NZ] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REWRITE_TAC[rsum; SUM_CMUL; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_SYM]);; + +let DEFINT_ADD = prove + (`!f g a b i j. + defint(a,b) f i /\ defint(a,b) g j + ==> defint(a,b) (\x. f x + g x) (i + j)`, + REPEAT GEN_TAC THEN REWRITE_TAC[defint] THEN + STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`)) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)` THEN + ASM_SIMP_TAC[GAUGE_MIN; rsum] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD] THEN REWRITE_TAC[GSYM rsum] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x - i) < e / &2 /\ abs(y - j) < e / &2 + ==> abs((x + y) - (i + j)) < e`) THEN + ASM_MESON_TAC[FINE_MIN]);; + +let DEFINT_SUB = prove + (`!f g a b i j. + defint(a,b) f i /\ defint(a,b) g j + ==> defint(a,b) (\x. f x - g x) (i - j)`, + SIMP_TAC[real_sub; DEFINT_ADD; DEFINT_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Ordering properties of integral. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_LE = prove + (`!f g a b i j. + a <= b /\ integrable(a,b) f /\ integrable(a,b) g /\ + (!x. a <= x /\ x <= b ==> f(x) <= g(x)) + ==> integral(a,b) f <= integral(a,b) g`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP INTEGRABLE_DEFINT)) THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < x - y) ==> x <= y`) THEN + ABBREV_TAC `e = integral(a,b) f - integral(a,b) g` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + SPEC `e / &2` o GEN_REWRITE_RULE I [defint])) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &2 <=> &0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`a:real`; `b:real`; + `\x:real. if g1(x) < g2(x) then g1(x) else g2(x)`] + DIVISION_EXISTS) THEN + ASM_SIMP_TAC[GAUGE_MIN; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`D:num->real`; `p:num->real`] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`D:num->real`; `p:num->real`])) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`D:num->real`; `p:num->real`])) THEN + FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FINE_MIN th]) THEN + MATCH_MP_TAC(REAL_ARITH + `ih - ig = e /\ &0 < e /\ sh <= sg + ==> abs(sg - ig) < e / &2 ==> ~(abs(sh - ih) < e / &2)`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[rsum] THEN MATCH_MP_TAC SUM_LE THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_SUB_LE] THEN + ASM_MESON_TAC[TDIV_BOUNDS; REAL_LT_IMP_LE; DIVISION_THM; tdiv]);; + +let DEFINT_LE = prove + (`!f g a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) g j /\ + (!x. a <= x /\ x <= b ==> f(x) <= g(x)) + ==> i <= j`, + REPEAT GEN_TAC THEN MP_TAC(SPEC_ALL INTEGRAL_LE) THEN + MESON_TAC[integrable; DEFINT_INTEGRAL]);; + +let DEFINT_TRIANGLE = prove + (`!f a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) (\x. abs(f x)) j + ==> abs(i) <= j`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `--a <= b /\ b <= a ==> abs(b) <= a`) THEN + CONJ_TAC THEN MATCH_MP_TAC DEFINT_LE THENL + [MAP_EVERY EXISTS_TAC [`\x:real. --abs(f x)`; `f:real->real`]; + MAP_EVERY EXISTS_TAC [`f:real->real`; `\x:real. abs(f x)`]] THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_SIMP_TAC[DEFINT_NEG] THEN REAL_ARITH_TAC);; + +let DEFINT_EQ = prove + (`!f g a b i j. a <= b /\ defint(a,b) f i /\ defint(a,b) g j /\ + (!x. a <= x /\ x <= b ==> f(x) = g(x)) + ==> i = j`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[DEFINT_LE]);; + +let INTEGRAL_EQ = prove + (`!f g a b i. defint(a,b) f i /\ + (!x. a <= x /\ x <= b ==> f(x) = g(x)) + ==> defint(a,b) g i`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [defint]) THEN + REWRITE_TAC[defint] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real->real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `D:num->real` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:num->real` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN + REWRITE_TAC[rsum] THEN MATCH_MP_TAC SUM_EQ THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[tdiv; DIVISION_LBOUND; DIVISION_UBOUND; DIVISION_THM; + REAL_LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Integration by parts. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRATION_BY_PARTS = prove + (`!f g f' g' a b. + a <= b /\ + (!x. a <= x /\ x <= b ==> (f diffl f'(x))(x)) /\ + (!x. a <= x /\ x <= b ==> (g diffl g'(x))(x)) + ==> defint(a,b) (\x. f'(x) * g(x) + f(x) * g'(x)) + (f(b) * g(b) - f(a) * g(a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FTC1 THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + b * c = a + c * b`] THEN + ASM_SIMP_TAC[DIFF_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Various simple lemmas about divisions. *) +(* ------------------------------------------------------------------------- *) + +let DIVISION_LE_SUC = prove + (`!d a b. division(a,b) d ==> !n. d(n) <= d(SUC n)`, + REWRITE_TAC[DIVISION_THM; GE] THEN + MESON_TAC[LET_CASES; LE; REAL_LE_REFL; REAL_LT_IMP_LE]);; + +let DIVISION_MONO_LE = prove + (`!d a b. division(a,b) d ==> !m n. m <= n ==> d(m) <= d(n)`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o MATCH_MP DIVISION_LE_SUC) THEN + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN + ASM_MESON_TAC[REAL_LE_TRANS]);; + +let DIVISION_MONO_LE_SUC = prove + (`!d a b. division(a,b) d ==> !n. d(n) <= d(SUC n)`, + MESON_TAC[DIVISION_MONO_LE; LE; LE_REFL]);; + +let DIVISION_INTERMEDIATE = prove + (`!d a b c. division(a,b) d /\ a <= c /\ c <= b + ==> ?n. n <= dsize d /\ d(n) <= c /\ c <= d(SUC n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\n. n <= dsize d /\ (d:num->real)(n) <= c` num_MAX) THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL + [ASM_MESON_TAC[LE_0; DIVISION_THM]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN SIMP_TAC[] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; LE_SUC_LT; LT_LE] THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `SUC(dsize d)` o repeat CONJUNCT2) THEN + REWRITE_TAC[GE; LE; LE_REFL] THEN + ASM_REAL_ARITH_TAC);; + +let DIVISION_DSIZE_LE = prove + (`!a b d n. division(a,b) d /\ d(SUC n) = d(n) ==> dsize d <= n`, + REWRITE_TAC[DIVISION_THM] THEN MESON_TAC[REAL_LT_REFL; NOT_LT]);; + +let DIVISION_DSIZE_GE = prove + (`!a b d n. division(a,b) d /\ d(n) < d(SUC n) ==> SUC n <= dsize d`, + REWRITE_TAC[DIVISION_THM; LE_SUC_LT; GE] THEN + MESON_TAC[REAL_LT_REFL; LE; NOT_LT]);; + +let DIVISION_DSIZE_EQ = prove + (`!a b d n. division(a,b) d /\ d(n) < d(SUC n) /\ d(SUC(SUC n)) = d(SUC n) + ==> dsize d = SUC n`, + REWRITE_TAC[GSYM LE_ANTISYM] THEN + MESON_TAC[DIVISION_DSIZE_LE; DIVISION_DSIZE_GE]);; + +let DIVISION_DSIZE_EQ_ALT = prove + (`!a b d n. division(a,b) d /\ d(SUC n) = d(n) /\ + (!i. i < n ==> d(i) < d(SUC i)) + ==> dsize d = n`, + REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL + [MESON_TAC[ARITH_RULE `d <= 0 ==> d = 0`; DIVISION_DSIZE_LE]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN + ASM_MESON_TAC[DIVISION_DSIZE_LE; DIVISION_DSIZE_GE; LT]);; + +(* ------------------------------------------------------------------------- *) +(* Combination of adjacent intervals (quite painful in the details). *) +(* ------------------------------------------------------------------------- *) + +let DEFINT_COMBINE = prove + (`!f a b c i j. a <= b /\ b <= c /\ defint(a,b) f i /\ defint(b,c) f j + ==> defint(a,c) f (i + j)`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ASSUME `a <= b`) THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `a:real = b` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[INTEGRAL_NULL; DINT_UNIQ; REAL_LE_TRANS; REAL_ADD_LID]; + DISCH_TAC] THEN + MP_TAC(ASSUME `b <= c`) THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `b:real = c` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[INTEGRAL_NULL; DINT_UNIQ; REAL_LE_TRANS; REAL_ADD_RID]; + DISCH_TAC] THEN + REWRITE_TAC[defint; AND_FORALL_THM] THEN + DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `g1:real->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `g2:real->real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC + `\x. if x < b then min (g1 x) (b - x) + else if b < x then min (g2 x) (x - b) + else min (g1 x) (g2 x)` THEN + CONJ_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge])) THEN + REWRITE_TAC[gauge] THEN REPEAT STRIP_TAC THEN + REPEAT COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN + TRY CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN + REWRITE_TAC[tdiv; rsum] THEN STRIP_TAC THEN + MP_TAC(SPECL [`d:num->real`; `a:real`; `c:real`; `b:real`] + DIVISION_INTERMEDIATE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` + (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[DIVISION_THM; GE; LE_REFL; REAL_NOT_LT]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SPLIT; ADD_CLAUSES] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(n = 0) ==> n = 1 + PRE n`)) THEN + REWRITE_TAC[GSYM SUM_SPLIT; SUM_1] THEN + SUBGOAL_THEN `(p:num->real) m = b` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `m:num` o GEN_REWRITE_RULE I [fine]) THEN + ASM_REWRITE_TAC[ARITH_RULE `m < m + n <=> ~(n = 0)`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + MAP_EVERY UNDISCH_TAC [`(d:num->real) m <= b`; `b:real <= d(SUC m)`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!b. abs((s1 + x * (b - a)) - i) < e / &2 /\ + abs((s2 + x * (c - b)) - j) < e / &2 + ==> abs((s1 + x * (c - a) + s2) - (i + j)) < e`) THEN + EXISTS_TAC `b:real` THEN CONJ_TAC THENL + [UNDISCH_TAC + `!D p. tdiv(a,b) (D,p) /\ fine g1 (D,p) + ==> abs(rsum(D,p) f - i) < e / &2` THEN + DISCH_THEN(MP_TAC o SPEC `\i. if i <= m then (d:num->real)(i) else b`) THEN + DISCH_THEN(MP_TAC o SPEC `\i. if i <= m then (p:num->real)(i) else b`) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) /\ (a /\ c ==> d) + ==> (a /\ b ==> c) ==> d`) THEN + CONJ_TAC THENL + [REWRITE_TAC[tdiv; division] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[division; LE_0]; + ALL_TAC; + X_GEN_TAC `k:num` THEN + REWRITE_TAC[ARITH_RULE `SUC n <= m <=> n <= m /\ ~(m = n)`] THEN + ASM_CASES_TAC `k:num = m` THEN + ASM_REWRITE_TAC[LE_REFL; REAL_LE_REFL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + ASM_CASES_TAC `(d:num->real) m = b` THENL + [EXISTS_TAC `m:num` THEN + SIMP_TAC[ARITH_RULE `n < m ==> n <= m /\ SUC n <= m`] THEN + SIMP_TAC[ARITH_RULE `n >= m ==> (n <= m <=> m = n:num)`] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + ASM_REWRITE_TAC[] THEN + MESON_TAC[ARITH_RULE `i:num < m ==> i < m + n`]; + ALL_TAC] THEN + EXISTS_TAC `SUC m` THEN + SIMP_TAC[ARITH_RULE `n >= SUC m ==> ~(n <= m)`] THEN + SIMP_TAC[ARITH_RULE `n < SUC m ==> n <= m`] THEN + SIMP_TAC[ARITH_RULE `n < SUC m ==> (SUC n <= m <=> ~(m = n))`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[ARITH_RULE `k < SUC m /\ ~(n = 0) ==> k < m + n`; + REAL_LT_LE]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[tdiv; fine] THEN STRIP_TAC THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[ARITH_RULE `SUC n <= m <=> n <= m /\ ~(m = n)`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o GEN_REWRITE_RULE I [fine]) THEN + MATCH_MP_TAC MONO_IMP THEN ASM_CASES_TAC `k:num = m` THENL + [ASM_REWRITE_TAC[LE_REFL; REAL_LT_REFL] THEN + ASM_REWRITE_TAC[ARITH_RULE `m < m + n <=> ~(n = 0)`] THEN + MAP_EVERY UNDISCH_TAC [`d(m:num) <= b`; `b <= d(SUC m)`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `k:num <= m` THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[ARITH_RULE `k <= m /\ ~(n = 0) ==> k < m + n`] THEN + SUBGOAL_THEN `(p:num->real) k <= b` MP_TAC THENL + [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real) m` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(d:num->real) (SUC k)` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIVISION_MONO_LE; ARITH_RULE + `k <= m /\ ~(k = m) ==> SUC k <= m`]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `d:num <= SUC m /\ ~(n = 0) ==> k < d ==> k < m + n`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIVISION_DSIZE_LE THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN + ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `gauge (\x. a <= x /\ x <= b) g1` THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; gauge; REAL_LE_REFL] THEN + DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN + ASM_MESON_TAC[REAL_LE_REFL]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REAL_ARITH + `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN + REWRITE_TAC[rsum] THEN ASM_CASES_TAC `(d:num->real) m = b` THENL + [SUBGOAL_THEN `dsize (\i. if i <= m then d i else b) = m` ASSUME_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN + MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[ADD_CLAUSES; LT_IMP_LE; LE_SUC_LT]] THEN + MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN + ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN + SIMP_TAC[LT_IMP_LE; LE_SUC_LT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[ARITH_RULE `i < m:num ==> i < m + n`]; + ALL_TAC] THEN + SUBGOAL_THEN `dsize (\i. if i <= m then d i else b) = SUC m` + ASSUME_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[sum; ADD_CLAUSES; LE_REFL; + ARITH_RULE `~(SUC m <= m)`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[ADD_CLAUSES; LT_IMP_LE; LE_SUC_LT]] THEN + MATCH_MP_TAC DIVISION_DSIZE_EQ THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN + ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `~(SUC m <= m)`] THEN + REWRITE_TAC[ARITH_RULE `~(SUC(SUC m) <= m)`] THEN + ASM_REWRITE_TAC[REAL_LT_LE]; + ALL_TAC] THEN + ASM_CASES_TAC `d(SUC m):real = b` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; REAL_ADD_RID] THEN + UNDISCH_TAC + `!D p. tdiv(b,c) (D,p) /\ fine g2 (D,p) + ==> abs(rsum(D,p) f - j) < e / &2` THEN + DISCH_THEN(MP_TAC o SPEC `\i. (d:num->real) (i + SUC m)`) THEN + DISCH_THEN(MP_TAC o SPEC `\i. (p:num->real) (i + SUC m)`) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b /\ (b /\ c ==> d)) + ==> (a /\ b ==> c) ==> d`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[tdiv; division; ADD_CLAUSES] THEN EXISTS_TAC `PRE n` THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + ASM_MESON_TAC[ARITH_RULE + `~(n = 0) /\ k < PRE n ==> SUC(k + m) < m + n`; + ARITH_RULE + `~(n = 0) /\ k >= PRE n ==> SUC(k + m) >= m + n`]; + DISCH_TAC] THEN + SUBGOAL_THEN `dsize(\i. d (i + SUC m)) = PRE n` ASSUME_TAC THENL + [MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN + MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[ARITH_RULE `SUC(PRE n + m) >= m + n /\ + SUC(SUC(PRE n + m)) >= m + n`]] THEN + DISCH_THEN(fun th -> X_GEN_TAC `k:num` THEN DISCH_TAC THEN + MATCH_MP_TAC th) THEN + UNDISCH_TAC `k < PRE n` THEN ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[fine] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + DISCH_THEN(MP_TAC o SPEC `k + SUC m`) THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ANTS_TAC THENL + [UNDISCH_TAC `k < PRE n` THEN ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= a ==> x < b ==> x < a`) THEN + SUBGOAL_THEN `~(p(SUC (k + m)) < b)` + (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN + REWRITE_TAC[REAL_NOT_LT] THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o SPEC `SUC(k + m)`) THEN + UNDISCH_TAC `b <= d (SUC m)` THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVISION_MONO_LE) THEN + DISCH_THEN(MP_TAC o SPECL [`SUC m`; `k + SUC m`]) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ADD_CLAUSES] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[rsum] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBST1_TAC(ARITH_RULE `m + 1 = 0 + SUC m`) THEN + REWRITE_TAC[SUM_REINDEX] THEN + MATCH_MP_TAC(REAL_ARITH + `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[ADD_CLAUSES]; + ALL_TAC] THEN + UNDISCH_TAC + `!D p. tdiv(b,c) (D,p) /\ fine g2 (D,p) + ==> abs(rsum(D,p) f - j) < e / &2` THEN + DISCH_THEN(MP_TAC o SPEC `\i. if i = 0 then b:real else d(i + m)`) THEN + DISCH_THEN(MP_TAC o SPEC `\i. if i = 0 then b:real else p(i + m)`) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b /\ (b /\ c ==> d)) + ==> (a /\ b ==> c) ==> d`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[tdiv; division; ADD_CLAUSES] THEN CONJ_TAC THENL + [ALL_TAC; + GEN_TAC THEN REWRITE_TAC[NOT_SUC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `m:num`) THEN + ASM_REWRITE_TAC[ADD_CLAUSES]] THEN + EXISTS_TAC `n:num` THEN REWRITE_TAC[NOT_SUC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC MONO_AND THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN(fun th -> + X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k + m:num` th)) + THENL [ALL_TAC; UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC] THEN + ASM_CASES_TAC `k:num < n` THEN + ASM_REWRITE_TAC[ARITH_RULE `k + m:num < m + n <=> k < n`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + ASM_REWRITE_TAC[REAL_LT_LE]; + DISCH_TAC] THEN + SUBGOAL_THEN `dsize(\i. if i = 0 then b else d (i + m)) = n` ASSUME_TAC + THENL + [MATCH_MP_TAC DIVISION_DSIZE_EQ_ALT THEN + MAP_EVERY EXISTS_TAC [`b:real`; `c:real`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[tdiv]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + GEN_REWRITE_TAC RAND_CONV [CONJ_SYM] THEN REWRITE_TAC[NOT_SUC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [ALL_TAC; MESON_TAC[GE; ADD_SYM; LE_REFL; LE]] THEN + DISCH_THEN(fun th -> + X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k + m:num` th)) THEN + ASM_CASES_TAC `k:num < n` THEN + ASM_REWRITE_TAC[ARITH_RULE `k + m:num < m + n <=> k < n`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + ASM_REWRITE_TAC[REAL_LT_LE]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[fine] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + DISCH_THEN(MP_TAC o SPEC `k + m:num`) THEN + ASM_REWRITE_TAC[ADD_CLAUSES; NOT_SUC; + ARITH_RULE `k + m < m + n <=> k:num < n`] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[ADD_CLAUSES; REAL_LT_REFL] THEN + MAP_EVERY UNDISCH_TAC [`(d:num->real) m <= b`; `b <= d (SUC m)`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= a ==> x < b ==> x < a`) THEN + SUBGOAL_THEN `~((p:num->real) (k + m) < b)` + (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN + REWRITE_TAC[REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `d(SUC m):real` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(d:num->real)(k + m)` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVISION_MONO_LE) THEN + DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[rsum] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REAL_ARITH + `x = y ==> abs(x - i) < e ==> abs(y - i) < e`) THEN + SUBGOAL_THEN `n = 1 + PRE n` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [th]) + THENL [UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; NOT_SUC; ADD_CLAUSES] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> x + a = b + x`) THEN + SUBST1_TAC(ARITH_RULE `1 = 0 + 1`) THEN + SUBST1_TAC(ARITH_RULE `m + 0 + 1 = 0 + m + 1`) THEN + ONCE_REWRITE_TAC[SUM_REINDEX] THEN MATCH_MP_TAC SUM_EQ THEN + REWRITE_TAC[ADD_CLAUSES; ADD_EQ_0; ARITH] THEN REWRITE_TAC[ADD_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Pointwise perturbation and spike functions. *) +(* ------------------------------------------------------------------------- *) + +let DEFINT_DELTA_LEFT = prove + (`!a b. defint(a,b) (\x. if x = a then &1 else &0) (&0)`, + REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN + ASM_SIMP_TAC[DEFINT_WRONG] THEN REWRITE_TAC[defint] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. e):real->real` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + gauge; fine; rsum; tdiv; REAL_SUB_RZERO] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `dsize d = 0` THEN ASM_REWRITE_TAC[sum; REAL_ABS_NUM] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP + (ARITH_RULE `~(n = 0) ==> n = 1 + PRE n`)) THEN + REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 <= x /\ x < e) /\ y = &0 ==> abs(x + y) < e`) THEN + CONJ_TAC THENL + [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_SUB_LE] THEN + ASM_MESON_TAC[DIVISION_THM; LE_0; LT_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN + STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + FIRST_ASSUM(MP_TAC o SPECL [`1`; `r:num`] o MATCH_MP DIVISION_MONO_LE) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN + DISCH_THEN(MP_TAC o SPEC `0`) THEN ASM_REWRITE_TAC[ARITH; LT_NZ] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPEC `r:num`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let DEFINT_DELTA_RIGHT = prove + (`!a b. defint(a,b) (\x. if x = b then &1 else &0) (&0)`, + REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THEN + ASM_SIMP_TAC[DEFINT_WRONG] THEN REWRITE_TAC[defint] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `(\x. e):real->real` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + gauge; fine; rsum; tdiv; REAL_SUB_RZERO] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `dsize d = 0` THEN ASM_REWRITE_TAC[sum; REAL_ABS_NUM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP + (ARITH_RULE `~(n = 0) ==> n = PRE n + 1`)) THEN + ABBREV_TAC `m = PRE(dsize d)` THEN + ASM_REWRITE_TAC[GSYM SUM_SPLIT; SUM_1; ADD_CLAUSES] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 <= x /\ x < e) /\ y = &0 ==> abs(y + x) < e`) THEN + CONJ_TAC THENL + [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_SUB_LE] THEN + ASM_MESON_TAC[DIVISION_THM; ARITH_RULE `m < m + 1`; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `r:num` THEN + REWRITE_TAC[ADD_CLAUSES] THEN STRIP_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `r:num`) THEN + FIRST_ASSUM(MP_TAC o SPECL [`SUC r`; `m:num`] o + MATCH_MP DIVISION_MONO_LE) THEN + ASM_REWRITE_TAC[LE_SUC_LT] THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [DIVISION_THM]) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `m:num`) (MP_TAC o SPEC `m + 1`)) THEN + ASM_REWRITE_TAC[GE; LE_REFL; ARITH_RULE `x < x + 1`] THEN + REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC);; + +let DEFINT_DELTA = prove + (`!a b c. defint(a,b) (\x. if x = c then &1 else &0) (&0)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a <= b` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN + ASM_CASES_TAC `a <= c /\ c <= b` THENL + [ALL_TAC; + MATCH_MP_TAC INTEGRAL_EQ THEN EXISTS_TAC `\x:real. &0` THEN + ASM_REWRITE_TAC[DEFINT_0] THEN ASM_MESON_TAC[]] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ADD_LID] THEN + MATCH_MP_TAC DEFINT_COMBINE THEN EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[DEFINT_DELTA_LEFT; DEFINT_DELTA_RIGHT]);; + +let DEFINT_POINT_SPIKE = prove + (`!f g a b c i. + (!x. a <= x /\ x <= b /\ ~(x = c) ==> (f x = g x)) /\ defint(a,b) f i + ==> defint(a,b) g i`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG]] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN + EXISTS_TAC `\x:real. f(x) + (g c - f c) * (if x = c then &1 else &0)` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SUBST1_TAC(REAL_ARITH `i = i + ((g:real->real) c - f c) * &0`) THEN + MATCH_MP_TAC DEFINT_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DEFINT_CMUL THEN REWRITE_TAC[DEFINT_DELTA]; + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN + REAL_ARITH_TAC]);; + +let DEFINT_FINITE_SPIKE = prove + (`!f g a b s i. + FINITE s /\ + (!x. a <= x /\ x <= b /\ ~(x IN s) ==> (f x = g x)) /\ + defint(a,b) f i + ==> defint(a,b) g i`, + REPEAT GEN_TAC THEN + REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a ==> b ==> d`] THEN + DISCH_TAC THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) + [`g:real->real`; `s:real->bool`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN + CONJ_TAC THENL [ASM_MESON_TAC[INTEGRAL_EQ]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `s:real->bool`] THEN STRIP_TAC THEN + X_GEN_TAC `g:real->real` THEN REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC DEFINT_POINT_SPIKE THEN + EXISTS_TAC `\x. if x = c then (f:real->real) x else g x` THEN + EXISTS_TAC `c:real` THEN SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy-type integrability criterion. *) +(* ------------------------------------------------------------------------- *) + +let GAUGE_MIN_FINITE = prove + (`!s gs n. (!m:num. m <= n ==> gauge s (gs m)) + ==> ?g. gauge s g /\ + !d p. fine g (d,p) ==> !m. m <= n ==> fine (gs m) (d,p)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LE] THENL + [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `gm:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real. if gm x < gs(SUC n) x then gm x else gs(SUC n) x` THEN + ASM_SIMP_TAC[GAUGE_MIN; ETA_AX] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP FINE_MIN) THEN ASM_SIMP_TAC[ETA_AX]);; + +let INTEGRABLE_CAUCHY = prove + (`!f a b. integrable(a,b) f <=> + !e. &0 < e + ==> ?g. gauge (\x. a <= x /\ x <= b) g /\ + !d1 p1 d2 p2. + tdiv (a,b) (d1,p1) /\ fine g (d1,p1) /\ + tdiv (a,b) (d2,p2) /\ fine g (d2,p2) + ==> abs (rsum(d1,p1) f - rsum(d2,p2) f) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[integrable] THEN EQ_TAC THENL + [REWRITE_TAC[defint] THEN DISCH_THEN(X_CHOOSE_TAC `i:real`) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`d1:num->real`; `p1:num->real`; `d2:num->real`; `p2:num->real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN + MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THENL + [ASM_MESON_TAC[DEFINT_WRONG]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&1 / &2 pow n`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(GEN `n:num` + (SPECL [`\x. a <= x /\ x <= b`; `g:num->real->real`; `n:num`] + GAUGE_MIN_FINITE)) THEN + ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `G:num->real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(GEN `n:num` + (SPECL [`a:real`; `b:real`; `(G:num->real->real) n`] DIVISION_EXISTS)) THEN + ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + MAP_EVERY X_GEN_TAC [`d:num->num->real`; `p:num->num->real`] THEN + STRIP_TAC THEN SUBGOAL_THEN `cauchy (\n. rsum(d n,p n) f)` MP_TAC THENL + [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `&1 / e` REAL_ARCH_POW2) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN DISCH_TAC THEN + REWRITE_TAC[GE] THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`N:num`; `(d:num->num->real) m`; `(p:num->num->real) m`; + `(d:num->num->real) n`; `(p:num->num->real) n`]) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `d < e ==> x < d ==> x < e`) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + ASM_MESON_TAC[REAL_MUL_SYM]; + ALL_TAC] THEN + REWRITE_TAC[SEQ_CAUCHY; convergent; SEQ; defint] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` MP_TAC) THEN + X_CHOOSE_TAC `N2:num` (SPEC `&2 / e` REAL_ARCH_POW2) THEN + DISCH_THEN(MP_TAC o SPEC `N1 + N2:num`) THEN REWRITE_TAC[GE; LE_ADD] THEN + DISCH_TAC THEN EXISTS_TAC `(G:num->real->real)(N1 + N2)` THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`dx:num->real`; `px:num->real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`N1 + N2:num`; `dx:num->real`; `px:num->real`; + `(d:num->num->real)(N1 + N2)`; `(p:num->num->real)(N1 + N2)`]) THEN + ANTS_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(s1 - i) < e / &2 + ==> d < e / &2 + ==> abs(s2 - s1) < d ==> abs(s2 - i) < e`)) THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_DIV] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow N2` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Limit theorem. *) +(* ------------------------------------------------------------------------- *) + +let SUM_DIFFS = prove + (`!m n. sum(m,n) (\i. d(SUC i) - d(i)) = d(m + n) - d m`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[sum; ADD_CLAUSES; REAL_SUB_REFL] THEN REAL_ARITH_TAC);; + +let RSUM_BOUND = prove + (`!a b d p e f. + tdiv(a,b) (d,p) /\ + (!x. a <= x /\ x <= b ==> abs(f x) <= e) + ==> abs(rsum(d,p) f) <= e * (b - a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rsum] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,dsize d) (\i. abs(f(p i :real) * (d(SUC i) - d i)))` THEN + REWRITE_TAC[SUM_ABS_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0,dsize d) (\i. e * abs(d(SUC i) - d(i)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[ADD_CLAUSES; REAL_ABS_MUL] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[tdiv; DIVISION_UBOUND; DIVISION_LBOUND; REAL_LE_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[SUM_CMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN + ASM_MESON_TAC[REAL_LE_REFL; REAL_ABS_POS; REAL_LE_TRANS; DIVISION_LE; + tdiv]; + ALL_TAC] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o REWRITE_RULE[tdiv]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_MONO_LE_SUC) THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE; SUM_DIFFS; ADD_CLAUSES] THEN + MATCH_MP_TAC(REAL_ARITH `a <= d0 /\ d1 <= b ==> d1 - d0 <= b - a`) THEN + ASM_MESON_TAC[DIVISION_LBOUND; DIVISION_UBOUND]);; + +let RSUM_DIFF_BOUND = prove + (`!a b d p e f g. + tdiv(a,b) (d,p) /\ + (!x. a <= x /\ x <= b ==> abs(f x - g x) <= e) + ==> abs(rsum (d,p) f - rsum (d,p) g) <= e * (b - a)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP RSUM_BOUND) THEN + REWRITE_TAC[rsum; SUM_SUB; REAL_SUB_RDISTRIB]);; + +let INTEGRABLE_LIMIT = prove + (`!f a b. (!e. &0 < e + ==> ?g. (!x. a <= x /\ x <= b ==> abs(f x - g x) <= e) /\ + integrable(a,b) g) + ==> integrable(a,b) f`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a <= b` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LE; DEFINT_WRONG; integrable]] THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `&1 / &2 pow n`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM; integrable] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` (CONJUNCTS_THEN2 + ASSUME_TAC (X_CHOOSE_TAC `i:num->real`))) THEN + SUBGOAL_THEN `cauchy i` MP_TAC THENL + [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `(&4 * (b - a)) / e` REAL_ARCH_POW2) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [defint]) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `m:num` th) THEN + MP_TAC(SPEC `n:num` th)) THEN + DISCH_THEN(X_CHOOSE_THEN `gn:real->real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `gm:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`a:real`; `b:real`; + `\x:real. if gm x < gn x then gm x else gn x`] + DIVISION_EXISTS) THEN + ASM_SIMP_TAC[GAUGE_MIN; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC o MATCH_MP FINE_MIN) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`])) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs(rsum(d,p) (g(m:num)) - rsum(d,p) (g n)) <= e / &2` + (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 / &2 pow N * (b - a)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `!f. abs(f - gm) <= inv(k) /\ abs(f - gn) <= inv(k) + ==> abs(gm - gn) <= &2 / k`) THEN + EXISTS_TAC `(f:real->real) x` THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `&1 / &2 pow m`; EXISTS_TAC `&1 / &2 pow n`] THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_MONO; REAL_OF_NUM_LE; + REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&2 / n * x <= e / &2 <=> (&4 * x) / n <= e`] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_IMP_LE]; + ALL_TAC] THEN + REWRITE_TAC[SEQ_CAUCHY; convergent] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real` THEN DISCH_TAC THEN + REWRITE_TAC[defint] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3` o GEN_REWRITE_RULE I [SEQ]) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; GE] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + MP_TAC(SPEC `(&3 * (b - a)) / e` REAL_ARCH_POW2) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [defint]) THEN + DISCH_THEN(MP_TAC o SPECL [`N1 + N2:num`; `e / &3`]) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g:real->real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N1:num <= N1 + N2`)) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(sf - sg) <= e / &3 + ==> abs(i - s) < e / &3 ==> abs(sg - i) < e / &3 ==> abs(sf - s) < e`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 / &2 pow (N1 + N2) * (b - a)` THEN CONJ_TAC THENL + [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&1 / n * x <= e / &3 <=> (&3 * x) / n <= e`] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow N2` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_POW_MONO; REAL_OF_NUM_LE; ARITH; + ARITH_RULE `N2 <= N1 + N2:num`]);; + +(* ------------------------------------------------------------------------- *) +(* Hence continuous functions are integrable. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_CONST = prove + (`!a b c. integrable(a,b) (\x. c)`, + REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_CONST]);; + +let INTEGRABLE_COMBINE = prove + (`!f a b c. a <= b /\ b <= c /\ integrable(a,b) f /\ integrable(b,c) f + ==> integrable(a,c) f`, + REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_COMBINE]);; + +let INTEGRABLE_POINT_SPIKE = prove + (`!f g a b c. + (!x. a <= x /\ x <= b /\ ~(x = c) ==> f x = g x) /\ integrable(a,b) f + ==> integrable(a,b) g`, + REWRITE_TAC[integrable] THEN MESON_TAC[DEFINT_POINT_SPIKE]);; + +let INTEGRABLE_CONTINUOUS = prove + (`!f a b. (!x. a <= x /\ x <= b ==> f contl x) ==> integrable(a,b) f`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b < a \/ a <= b`) THENL + [ASM_MESON_TAC[integrable; DEFINT_WRONG]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_LIMIT THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`f:real->real`; `a:real`; `b:real`] CONT_UNIFORM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + UNDISCH_TAC `a <= b` THEN MAP_EVERY (fun t -> SPEC_TAC(t,t)) + [`b:real`; `a:real`] THEN + MATCH_MP_TAC BOLZANO_LEMMA_ALT THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `w:real`] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC(TAUT + `(a /\ b) /\ (c /\ d ==> e) ==> (a ==> c) /\ (b ==> d) ==> e`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `g:real->real`) + (X_CHOOSE_TAC `h:real->real`)) THEN + EXISTS_TAC `\x. if x <= v then g(x):real else h(x)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMBINE THEN EXISTS_TAC `v:real` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_POINT_SPIKE THENL + [EXISTS_TAC `g:real->real`; EXISTS_TAC `h:real->real`] THEN + EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN + ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= c /\ ~(x = b) ==> ~(x <= b)`]; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `\x:real. (f:real->real) u` THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Integrability on a subinterval. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_SPLIT_SIDES = prove + (`!f a b c. + a <= c /\ c <= b /\ integrable(a,b) f + ==> ?i. !e. &0 < e + ==> ?g. gauge(\x. a <= x /\ x <= b) g /\ + !d1 p1 d2 p2. tdiv(a,c) (d1,p1) /\ + fine g (d1,p1) /\ + tdiv(c,b) (d2,p2) /\ + fine g (d2,p2) + ==> abs((rsum(d1,p1) f + + rsum(d2,p2) f) - i) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[integrable; defint] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN + ASM_MESON_TAC[DIVISION_APPEND_STRONG]);; + +let INTEGRABLE_SUBINTERVAL_LEFT = prove + (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> integrable(a,c) f`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `i:real` o MATCH_MP INTEGRABLE_SPLIT_SIDES) THEN + REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + SIMP_TAC[ASSUME `&0 < e`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`c:real`; `b:real`; `g:real->real`] DIVISION_EXISTS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN + MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let INTEGRABLE_SUBINTERVAL_RIGHT = prove + (`!f a b c. a <= c /\ c <= b /\ integrable(a,b) f ==> integrable(c,b) f`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `i:real` o MATCH_MP INTEGRABLE_SPLIT_SIDES) THEN + REWRITE_TAC[INTEGRABLE_CAUCHY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + SIMP_TAC[ASSUME `&0 < e`; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real`; `c:real`; `g:real->real`] DIVISION_EXISTS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + REWRITE_TAC[gauge] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:num->real`; `p:num->real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`d:num->real`; `p:num->real`]) THEN + DISCH_THEN(fun th -> + MP_TAC(SPECL [`d1:num->real`; `p1:num->real`] th) THEN + MP_TAC(SPECL [`d2:num->real`; `p2:num->real`] th)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let INTEGRABLE_SUBINTERVAL = prove + (`!f a b c d. a <= c /\ c <= d /\ d <= b /\ integrable(a,b) f + ==> integrable(c,d) f`, + MESON_TAC[INTEGRABLE_SUBINTERVAL_LEFT; INTEGRABLE_SUBINTERVAL_RIGHT; + REAL_LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Basic integrability rule for everywhere-differentiable function. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_RULE = + let pth = prove + (`(!x. f contl x) ==> integrable(a,b) f`, + MESON_TAC[INTEGRABLE_CONTINUOUS]) in + let match_pth = PART_MATCH rand pth + and forsimp = GEN_REWRITE_RULE LAND_CONV [FORALL_SIMP] in + fun tm -> + let th1 = match_pth tm in + let th2 = CONV_RULE (LAND_CONV(BINDER_CONV CONTINUOUS_CONV)) th1 in + MP (forsimp th2) TRUTH;; + +let INTEGRABLE_CONV = EQT_INTRO o INTEGRABLE_RULE;; + +(* ------------------------------------------------------------------------- *) +(* More basic lemmas about integration. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_CONST = prove + (`!a b c. a <= b ==> integral(a,b) (\x. c) = c * (b - a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN + ASM_SIMP_TAC[DEFINT_CONST]);; + +let INTEGRAL_CMUL = prove + (`!f c a b. a <= b /\ integrable(a,b) f + ==> integral(a,b) (\x. c * f(x)) = c * integral(a,b) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN + ASM_SIMP_TAC[DEFINT_CMUL; INTEGRABLE_DEFINT]);; + +let INTEGRAL_ADD = prove + (`!f g a b. a <= b /\ integrable(a,b) f /\ integrable(a,b) g + ==> integral(a,b) (\x. f(x) + g(x)) = + integral(a,b) f + integral(a,b) g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN + ASM_SIMP_TAC[DEFINT_ADD; INTEGRABLE_DEFINT]);; + +let INTEGRAL_SUB = prove + (`!f g a b. a <= b /\ integrable(a,b) f /\ integrable(a,b) g + ==> integral(a,b) (\x. f(x) - g(x)) = + integral(a,b) f - integral(a,b) g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DEFINT_INTEGRAL THEN + ASM_SIMP_TAC[DEFINT_SUB; INTEGRABLE_DEFINT]);; + +let INTEGRAL_BY_PARTS = prove + (`!f g f' g' a b. + a <= b /\ + (!x. a <= x /\ x <= b ==> (f diffl f' x) x) /\ + (!x. a <= x /\ x <= b ==> (g diffl g' x) x) /\ + integrable(a,b) (\x. f' x * g x) /\ + integrable(a,b) (\x. f x * g' x) + ==> integral(a,b) (\x. f x * g' x) = + (f b * g b - f a * g a) - integral(a,b) (\x. f' x * g x)`, + MP_TAC INTEGRATION_BY_PARTS THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJ (ASSUME `a <= b`)) THEN + DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP DEFINT_INTEGRAL) THEN + ASM_SIMP_TAC[INTEGRAL_ADD] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------ *) +(* SYM_CANON_CONV - Canonicalizes single application of symmetric operator *) +(* Rewrites `so as to make fn true`, e.g. fn = (<<) or fn = (=) `1` o fst *) +(* ------------------------------------------------------------------------ *) + +let SYM_CANON_CONV sym fn = + REWR_CONV sym o check + (not o fn o ((snd o dest_comb) F_F I) o dest_comb);; + +(* ----------------------------------------------------------- *) +(* EXT_CONV `!x. f x = g x` = |- (!x. f x = g x) <=> (f = g) *) +(* ----------------------------------------------------------- *) + +let EXT_CONV = SYM o uncurry X_FUN_EQ_CONV o + (I F_F (mk_eq o (rator F_F rator) o dest_eq)) o dest_forall;; + +(* ------------------------------------------------------------------------ *) +(* Mclaurin's theorem with Lagrange form of remainder *) +(* We could weaken the hypotheses slightly, but it's not worth it *) +(* ------------------------------------------------------------------------ *) + +let MCLAURIN = prove( + `!f diff h n. + &0 < h /\ + 0 < n /\ + (diff(0) = f) /\ + (!m t. m < n /\ &0 <= t /\ t <= h ==> + (diff(m) diffl diff(SUC m)(t))(t)) ==> + (?t. &0 < t /\ t < h /\ + (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) + + ((diff(n)(t) / &(FACT n)) * (h pow n))))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + UNDISCH_TAC `0 < n` THEN + DISJ_CASES_THEN2 SUBST_ALL_TAC (X_CHOOSE_THEN `r:num` MP_TAC) + (SPEC `n:num` num_CASES) THEN REWRITE_TAC[LT_REFL] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `?B. f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) + + (B * ((h pow n) / &(FACT n)))` MP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ONCE_REWRITE_TAC[GSYM REAL_EQ_SUB_RADD] THEN + EXISTS_TAC `(f(h) - sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m))) + * &(FACT n) / (h pow n)` THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d = (d * a) * (b * c)`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN BINOP_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THENL + [MATCH_MP_TAC REAL_POS_NZ THEN REWRITE_TAC[REAL_LT; FACT_LT]; + MATCH_MP_TAC POW_NZ THEN MATCH_MP_TAC REAL_POS_NZ THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` (ASSUME_TAC o SYM)) THEN + ABBREV_TAC `g = \t. f(t) - + (sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (t pow m)) + + (B * ((t pow n) / &(FACT n))))` THEN + SUBGOAL_THEN `(g(&0) = &0) /\ (g(h) = &0)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN BETA_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN + EXPAND_TAC "n" THEN REWRITE_TAC[POW_0; REAL_DIV_LZERO] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN REWRITE_TAC[REAL_SUB_0] THEN + MP_TAC(GEN `j:num->real` + (SPECL [`j:num->real`; `r:num`; `1`] SUM_OFFSET)) THEN + REWRITE_TAC[ADD1; REAL_EQ_SUB_LADD] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN + REWRITE_TAC[SUM_1] THEN BETA_TAC THEN REWRITE_TAC[pow; FACT] THEN + ASM_REWRITE_TAC[real_div; REAL_INV1; REAL_MUL_RID] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ADD_LID_UNIQ] THEN + REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; SUM_0]; ALL_TAC] THEN + ABBREV_TAC `difg = \m t. diff(m) t - + (sum(0,n - m)(\p. (diff(m + p)(&0) / &(FACT p)) * (t pow p)) + + (B * ((t pow (n - m)) / &(FACT(n - m)))))` THEN + SUBGOAL_THEN `difg(0):real->real = g` ASSUME_TAC THENL + [EXPAND_TAC "difg" THEN BETA_TAC THEN EXPAND_TAC "g" THEN + CONV_TAC FUN_EQ_CONV THEN GEN_TAC THEN BETA_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; SUB_0]; ALL_TAC] THEN + SUBGOAL_THEN `(!m t. m < n /\ (& 0) <= t /\ t <= h ==> + (difg(m) diffl difg(SUC m)(t))(t))` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "difg" THEN BETA_TAC THEN + CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN + MATCH_MP_TAC DIFF_SUB THEN CONJ_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC((funpow 2 RATOR_CONV o RAND_CONV) HABS_CONV) THEN + MATCH_MP_TAC DIFF_ADD THEN CONJ_TAC THENL + [ALL_TAC; + W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RID; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_FACT_NZ; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `t:real`) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `t:real`)) THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; POW_2] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d = b * (a * (d * c))`] THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o + MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN + REWRITE_TAC[ADD_SUB] THEN AP_TERM_TAC THEN + IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN REWRITE_TAC[REAL_FACT_NZ] THEN + REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_MUL] THEN + REPEAT(IMP_SUBST_TAC REAL_INV_MUL_WEAK THEN + REWRITE_TAC[REAL_FACT_NZ; REAL_INJ; NOT_SUC]) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d * e * f * g = (b * a) * (d * f) * (c * g) * e`] THEN + REPEAT(IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_FACT_NZ] THEN + REWRITE_TAC[REAL_INJ; NOT_SUC]) THEN + REWRITE_TAC[REAL_MUL_LID]] THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o + MATCH_MP LESS_ADD_1 o CONJUNCT1) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN + REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[GSYM(REWRITE_RULE[REAL_EQ_SUB_LADD] SUM_OFFSET)] THEN + BETA_TAC THEN REWRITE_TAC[SUM_1] THEN BETA_TAC THEN + CONV_TAC (funpow 2 RATOR_CONV (RAND_CONV HABS_CONV)) THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC DIFF_ADD THEN REWRITE_TAC[pow; DIFF_CONST] THEN + (MP_TAC o C SPECL DIFF_SUM) + [`\p x. (diff((p + 1) + m)(&0) / &(FACT(p + 1))) + * (x pow (p + 1))`; + `\p x. (diff(p + (SUC m))(&0) / &(FACT p)) * (x pow p)`; + `0`; `d:num`; `t:real`] THEN BETA_TAC THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + W(MP_TAC o DIFF_CONV o rand o funpow 2 rator o snd) THEN + DISCH_THEN(MP_TAC o SPEC `t:real`) THEN + MATCH_MP_TAC EQ_IMP THEN + CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `z:real`)) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM ADD1; ADD_CLAUSES; real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[SUC_SUB1] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c * d = c * (a * d) * b`] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `&(SUC k) = inv(inv(&(SUC k)))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INVINV THEN + REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN + IMP_SUBST_TAC(GSYM REAL_INV_MUL_WEAK) THENL + [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[REAL_FACT_NZ] THEN + MATCH_MP_TAC REAL_POS_NZ THEN MATCH_MP_TAC REAL_INV_POS THEN + REWRITE_TAC[REAL_LT; LT_0]; ALL_TAC] THEN + AP_TERM_TAC THEN REWRITE_TAC[FACT; GSYM REAL_MUL; REAL_MUL_ASSOC] THEN + IMP_SUBST_TAC REAL_MUL_LINV THEN REWRITE_TAC[REAL_MUL_LID] THEN + REWRITE_TAC[REAL_INJ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `!m. m < n ==> + ?t. &0 < t /\ t < h /\ (difg(SUC m)(t) = &0)` MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `r:num`) THEN EXPAND_TAC "n" THEN + REWRITE_TAC[LESS_SUC_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `difg(SUC r)(t:real) = &0` THEN EXPAND_TAC "difg" THEN + ASM_REWRITE_TAC[SUB_REFL; sum; pow; FACT] THEN + REWRITE_TAC[REAL_SUB_0; REAL_ADD_LID; real_div] THEN + REWRITE_TAC[REAL_INV1; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) + [AC REAL_MUL_AC + `(a * b) * c = a * (c * b)`] THEN + ASM_REWRITE_TAC[GSYM real_div]] THEN + SUBGOAL_THEN `!m:num. m < n ==> (difg(m)(&0) = &0)` ASSUME_TAC THENL + [X_GEN_TAC `m:num` THEN EXPAND_TAC "difg" THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o MATCH_MP LESS_ADD_1) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[ADD_SUB] THEN + MP_TAC(GEN `j:num->real` + (SPECL [`j:num->real`; `d:num`; `1`] SUM_OFFSET)) THEN + REWRITE_TAC[ADD1; REAL_EQ_SUB_LADD] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN BETA_TAC THEN + REWRITE_TAC[SUM_1] THEN BETA_TAC THEN + REWRITE_TAC[FACT; pow; REAL_INV1; ADD_CLAUSES; real_div; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM ADD1; POW_0; REAL_MUL_RZERO; SUM_0; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_SUB_REFL]; ALL_TAC] THEN + SUBGOAL_THEN `!m:num. m < n ==> ?t. &0 < t /\ t < h /\ + (difg(m) diffl &0)(t)` MP_TAC THENL + [ALL_TAC; + DISCH_THEN(fun th -> GEN_TAC THEN + DISCH_THEN(fun t -> ASSUME_TAC t THEN MP_TAC(MATCH_MP th t))) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `difg(m:num):real->real` THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_ASSUM ACCEPT_TAC] THEN + INDUCT_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!t. &0 <= t /\ t <= h ==> g differentiable t` MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN + EXISTS_TAC `difg(SUC 0)(t:real):real` THEN + SUBST1_TAC(SYM(ASSUME `difg(0):real->real = g`)) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN + REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; + DISCH_TAC THEN + SUBGOAL_THEN `m < n:num` + (fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC m` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t0:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?t. (& 0) < t /\ t < t0 /\ ((difg(SUC m)) diffl (& 0))t` + MP_TAC THENL + [MATCH_MP_TAC ROLLE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SUBGOAL_THEN `difg(SUC m)(&0) = &0` SUBST1_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC DIFF_UNIQ THEN EXISTS_TAC `difg(m:num):real->real` THEN + EXISTS_TAC `t0:real` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LT_TRANS THEN EXISTS_TAC `SUC m` THEN + ASM_REWRITE_TAC[LESS_SUC_REFL]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]; ALL_TAC] THEN + SUBGOAL_THEN `!t. &0 <= t /\ t <= t0 ==> + difg(SUC m) differentiable t` ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[differentiable] THEN + EXISTS_TAC `difg(SUC(SUC m))(t:real):real` THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `t0:real` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIFF_CONT THEN + REWRITE_TAC[GSYM differentiable] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `t0:real` THEN + ASM_REWRITE_TAC[]]]);; + +let MCLAURIN_NEG = prove + (`!f diff h n. + h < &0 /\ + 0 < n /\ + (diff(0) = f) /\ + (!m t. m < n /\ h <= t /\ t <= &0 ==> + (diff(m) diffl diff(SUC m)(t))(t)) ==> + (?t. h < t /\ t < &0 /\ + (f(h) = sum(0,n)(\m. (diff(m)(&0) / &(FACT m)) * (h pow m)) + + ((diff(n)(t) / &(FACT n)) * (h pow n))))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`\x. (f(--x):real)`; + `\n x. ((--(&1)) pow n) * (diff:num->real->real)(n)(--x)`; + `--h`; `n:num`] MCLAURIN) THEN + BETA_TAC THEN ASM_REWRITE_TAC[REAL_NEG_GT0; pow; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG] THEN + REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN + ONCE_REWRITE_TAC[AC CONJ_ACI `a /\ b /\ c <=> a /\ c /\ b`] THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + DISCH_THEN(MP_TAC o C CONJ (SPEC `t:real` (DIFF_CONV `\x. --x`))) THEN + CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN) THEN + DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP DIFF_CMUL) THEN + DISCH_THEN(MP_TAC o SPEC `(--(&1)) pow m`) THEN BETA_TAC THEN + MATCH_MP_TAC EQ_IMP THEN + CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `z:real`)) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC(AC REAL_MUL_AC); + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `--t` THEN ONCE_REWRITE_TAC[GSYM REAL_LT_NEG] THEN + ASM_REWRITE_TAC[REAL_NEGNEG; REAL_NEG_0] THEN + BINOP_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[ADD_CLAUSES] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN BETA_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * b * c * d = (b * c) * (a * d)`] THEN + REWRITE_TAC[GSYM POW_MUL; GSYM REAL_NEG_MINUS1; REAL_NEGNEG] THEN + REWRITE_TAC[REAL_MUL_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* More convenient "bidirectional" version. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_BI_LE = prove + (`!f diff x n. + (diff 0 = f) /\ + (!m t. m < n /\ abs(t) <= abs(x) ==> (diff m diffl diff (SUC m) t) t) + ==> ?t. abs(t) <= abs(x) /\ + (f x = sum (0,n) (\m. diff m (&0) / &(FACT m) * x pow m) + + diff n t / &(FACT n) * x pow n)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[sum; real_pow; FACT; REAL_DIV_1; REAL_MUL_RID; + REAL_ADD_LID] THEN + EXISTS_TAC `x:real` THEN REWRITE_TAC[REAL_LE_REFL]; ALL_TAC] THEN + ASM_CASES_TAC `x = &0` THENL + [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[ADD1] THEN + REWRITE_TAC[REWRITE_RULE[REAL_EQ_SUB_RADD] (GSYM SUM_OFFSET)] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_RZERO; SUM_0] THEN + REWRITE_TAC[REAL_ADD_RID; REAL_ADD_LID] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_SUM_CONV) THEN + ASM_REWRITE_TAC[real_pow; FACT; REAL_MUL_RID; REAL_DIV_1]; ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ x < &0`)) + THENL + [MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`] + MCLAURIN) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= t /\ t <= x ==> abs(t) <= abs(x)`] THEN + ASM_REWRITE_TAC[LT_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[REAL_ARITH `&0 < t /\ t < x ==> abs(t) <= abs(x)`]; + MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; `x:real`; `n:num`] + MCLAURIN_NEG) THEN + ASM_SIMP_TAC[REAL_ARITH `x <= t /\ t <= &0 ==> abs(t) <= abs(x)`] THEN + ASM_REWRITE_TAC[LT_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[REAL_ARITH `x < t /\ t < &0 ==> abs(t) <= abs(x)`]]);; + +(* ------------------------------------------------------------------------- *) +(* Simple strong form if a function is differentiable everywhere. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_ALL_LT = prove + (`!f diff. + (diff 0 = f) /\ + (!m x. ((diff m) diffl (diff(SUC m) x)) x) + ==> !x n. ~(x = &0) /\ 0 < n + ==> ?t. &0 < abs(t) /\ abs(t) < abs(x) /\ + (f(x) = sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) + + (diff n t / &(FACT n)) * x pow n)`, + REPEAT STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN MP_TAC + (SPECL [`x:real`; `&0`] REAL_LT_TOTAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THENL + [MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; + `x:real`; `n:num`] MCLAURIN_NEG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `t < &0` THEN UNDISCH_TAC `x < t` THEN REAL_ARITH_TAC; + MP_TAC(SPECL [`f:real->real`; `diff:num->real->real`; + `x:real`; `n:num`] MCLAURIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&0 < t` THEN UNDISCH_TAC `t < x` THEN REAL_ARITH_TAC]);; + +let MCLAURIN_ZERO = prove + (`!diff n x. (x = &0) /\ 0 < n ==> + (sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) = diff 0 (&0))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN + REWRITE_TAC[LT] THEN + DISCH_THEN(DISJ_CASES_THEN2 (SUBST1_TAC o SYM) MP_TAC) THENL + [REWRITE_TAC[sum; ADD_CLAUSES; FACT; real_pow; real_div; REAL_INV_1] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID]; + REWRITE_TAC[sum] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN ANTE_RES_THEN SUBST1_TAC th) THEN + UNDISCH_TAC `0 < n` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN + REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_ADD_RID]]);; + +let MCLAURIN_ALL_LE = prove + (`!f diff. + (diff 0 = f) /\ + (!m x. ((diff m) diffl (diff(SUC m) x)) x) + ==> !x n. ?t. abs(t) <= abs(x) /\ + (f(x) = sum(0,n)(\m. (diff m (&0) / &(FACT m)) * x pow m) + + (diff n t / &(FACT n)) * x pow n)`, + REPEAT STRIP_TAC THEN + DISJ_CASES_THEN MP_TAC(SPECL [`n:num`; `0`] LET_CASES) THENL + [REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[sum; REAL_ADD_LID; FACT] THEN EXISTS_TAC `x:real` THEN + REWRITE_TAC[REAL_LE_REFL; real_pow; REAL_MUL_RID; REAL_DIV_1]; + DISCH_TAC THEN ASM_CASES_TAC `x = &0` THENL + [MP_TAC(SPEC_ALL MCLAURIN_ZERO) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[REAL_LE_REFL] THEN + SUBGOAL_THEN `&0 pow n = &0` SUBST1_TAC THENL + [ASM_REWRITE_TAC[REAL_POW_EQ_0; GSYM (CONJUNCT1 LE); NOT_LE]; + REWRITE_TAC[REAL_ADD_RID; REAL_MUL_RZERO]]; + MP_TAC(SPEC_ALL MCLAURIN_ALL_LT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC_ALL) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Version for exp. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_EXP_LEMMA = prove + (`((\n:num. exp) 0 = exp) /\ + (!m x. (((\n:num. exp) m) diffl ((\n:num. exp) (SUC m) x)) x)`, + REWRITE_TAC[DIFF_EXP]);; + +let MCLAURIN_EXP_LT = prove + (`!x n. ~(x = &0) /\ 0 < n + ==> ?t. &0 < abs(t) /\ + abs(t) < abs(x) /\ + (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) + + (exp(t) / &(FACT n)) * x pow n)`, + MP_TAC (MATCH_MP MCLAURIN_ALL_LT MCLAURIN_EXP_LEMMA) THEN + REWRITE_TAC[REAL_EXP_0; real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID]);; + +let MCLAURIN_EXP_LE = prove + (`!x n. ?t. abs(t) <= abs(x) /\ + (exp(x) = sum(0,n)(\m. x pow m / &(FACT m)) + + (exp(t) / &(FACT n)) * x pow n)`, + MP_TAC (MATCH_MP MCLAURIN_ALL_LE MCLAURIN_EXP_LEMMA) THEN + REWRITE_TAC[REAL_EXP_0; real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Version for ln(1 +/- x). *) +(* ------------------------------------------------------------------------- *) + +let DIFF_LN_COMPOSITE = prove + (`!g m x. (g diffl m)(x) /\ &0 < g x + ==> ((\x. ln(g x)) diffl (inv(g x) * m))(x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFF_CHAIN THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIFF_LN THEN + ASM_REWRITE_TAC[]) in +add_to_diff_net (SPEC_ALL DIFF_LN_COMPOSITE);; + +let MCLAURIN_LN_POS = prove + (`!x n. + &0 < x /\ 0 < n + ==> ?t. &0 < t /\ + t < x /\ + (ln(&1 + x) = sum(0,n) + (\m. --(&1) pow (SUC m) * (x pow m) / &m) + + --(&1) pow (SUC n) * x pow n / (&n * (&1 + t) pow n))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x. ln(&1 + x)` MCLAURIN) THEN + DISCH_THEN(MP_TAC o SPEC + `\n x. if n = 0 then ln(&1 + x) + else --(&1) pow (SUC n) * + &(FACT(PRE n)) * inv((&1 + x) pow n)`) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_SUC; REAL_ADD_RID; REAL_POW_ONE] THEN + REWRITE_TAC[LN_1; REAL_INV_1; REAL_MUL_RID] THEN + SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL + [UNDISCH_TAC `0 < n` THEN ARITH_TAC; ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))` + ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; PRE] THEN + REWRITE_TAC[real_div; FACT; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN + MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `!p. (if p = 0 then &0 else --(&1) pow (SUC p) * &(FACT (PRE p))) / + &(FACT p) = --(&1) pow (SUC p) * inv(&p)` + (fun th -> REWRITE_TAC[th]) THENL + [INDUCT_TAC THENL + [REWRITE_TAC[REAL_INV_0; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]; + REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NOT_SUC]]; ALL_TAC] THEN + SUBGOAL_THEN + `!t. (--(&1) pow (SUC n) * &(FACT(PRE n)) * inv ((&1 + t) pow n)) / + &(FACT n) * x pow n = --(&1) pow (SUC n) * + x pow n / (&n * (&1 + t) pow n)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_INV_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_MUL_AC] THEN + DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL + [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN + REWRITE_TAC[PRE; real_pow; REAL_ADD_LID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_MUL_RID] THEN + REWRITE_TAC[FACT; REAL_MUL_RID; REAL_NEG_NEG] THEN + DISCH_THEN MATCH_MP_TAC THEN UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC; + W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN + SUBGOAL_THEN `~((&1 + u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC; + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID] THEN + REWRITE_TAC[real_div; real_pow; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_RID; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[SUC_SUB1; PRE] THEN REWRITE_TAC[FACT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[real_pow; REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN + UNDISCH_TAC `&0 <= u` THEN REAL_ARITH_TAC]]);; + +let MCLAURIN_LN_NEG = prove + (`!x n. &0 < x /\ x < &1 /\ 0 < n + ==> ?t. &0 < t /\ + t < x /\ + (--(ln(&1 - x)) = sum(0,n) (\m. (x pow m) / &m) + + x pow n / (&n * (&1 - t) pow n))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x. --(ln(&1 - x))` MCLAURIN) THEN + DISCH_THEN(MP_TAC o SPEC + `\n x. if n = 0 then --(ln(&1 - x)) + else &(FACT(PRE n)) * inv((&1 - x) pow n)`) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + REWRITE_TAC[NOT_SUC; LN_1; REAL_POW_ONE] THEN + SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL + [UNDISCH_TAC `0 < n` THEN ARITH_TAC; ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[REAL_INV_1; REAL_MUL_RID; REAL_MUL_LID] THEN + SUBGOAL_THEN `!p. ~(p = 0) ==> (&(FACT(PRE p)) / &(FACT p) = inv(&p))` + ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; PRE] THEN + REWRITE_TAC[real_div; FACT; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + AP_TERM_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN + MP_TAC(SPEC `p:num` FACT_LT) THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_NEG_0] THEN + SUBGOAL_THEN `!p. (if p = 0 then &0 else &(FACT (PRE p))) / &(FACT p) = + inv(&p)` + (fun th -> REWRITE_TAC[th]) THENL + [INDUCT_TAC THENL + [REWRITE_TAC[REAL_INV_0; real_div; REAL_MUL_LZERO]; + REWRITE_TAC[NOT_SUC] THEN FIRST_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NOT_SUC]]; ALL_TAC] THEN + SUBGOAL_THEN + `!t. (&(FACT(PRE n)) * inv ((&1 - t) pow n)) / &(FACT n) * x pow n + = x pow n / (&n * (&1 - t) pow n)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_INV_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_MUL_AC] THEN + DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[] THENL + [W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN + REWRITE_TAC[PRE; pow; FACT; REAL_SUB_LZERO] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN + REAL_ARITH_TAC; + W(MP_TAC o SPEC `u:real` o DIFF_CONV o lhand o rator o snd) THEN + SUBGOAL_THEN `~((&1 - u) pow m = &0)` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN + REAL_ARITH_TAC; + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_SUB_LZERO; real_div; PRE] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC + [REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_NEG_NEG; REAL_MUL_RID] THEN + UNDISCH_TAC `~(m = 0)` THEN SPEC_TAC(`m:num`,`p:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[SUC_SUB1; PRE] THEN REWRITE_TAC[FACT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[real_pow; REAL_POW_2] THEN REWRITE_TAC[REAL_INV_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THEN + REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `x < &1` THEN UNDISCH_TAC `u:real <= x` THEN + REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Versions for sin and cos. *) +(* ------------------------------------------------------------------------- *) + +let MCLAURIN_SIN = prove + (`!x n. abs(sin x - + sum(0,n) (\m. (if EVEN m then &0 + else -- &1 pow ((m - 1) DIV 2) / &(FACT m)) * + x pow m)) + <= inv(&(FACT n)) * abs(x) pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`sin`; `\n x. if n MOD 4 = 0 then sin(x) + else if n MOD 4 = 1 then cos(x) + else if n MOD 4 = 2 then --sin(x) + else --cos(x)`] MCLAURIN_ALL_LE) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [CONJ_TAC THENL + [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN + REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN + REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN + SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THEN + W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN + SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN + MP_TAC(SYM th)) THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + UNDISCH_TAC `r MOD 4 < 4` THEN + SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + SIMP_TAC[ARITH_RULE `(x + 1) - 1 = x`; + ARITH_RULE `(x + 3) - 1 = x + 2`; + ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`; + ARITH_RULE `x * 4 = 2 * 2 * x`] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_LE_REFL]);; + +let MCLAURIN_COS = prove + (`!x n. abs(cos x - + sum(0,n) (\m. (if EVEN m + then -- &1 pow (m DIV 2) / &(FACT m) + else &0) * x pow m)) + <= inv(&(FACT n)) * abs(x) pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`cos`; `\n x. if n MOD 4 = 0 then cos(x) + else if n MOD 4 = 1 then --sin(x) + else if n MOD 4 = 2 then --cos(x) + else sin(x)`] MCLAURIN_ALL_LE) THEN + W(C SUBGOAL_THEN (fun th -> REWRITE_TAC[th]) o funpow 2 lhand o snd) THENL + [CONJ_TAC THENL + [SIMP_TAC[MOD_0; ARITH_EQ; EQT_INTRO(SPEC_ALL ETA_AX)]; ALL_TAC] THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`m:num`; `4`] DIVISION) THEN + REWRITE_TAC[ARITH_EQ] THEN ABBREV_TAC `d = m MOD 4` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THEN + REWRITE_TAC[ADD1; GSYM ADD_ASSOC; MOD_MULT_ADD] THEN + SPEC_TAC(`d:num`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THEN + W(MP_TAC o DIFF_CONV o lhand o rator o snd) THEN + SIMP_TAC[REAL_MUL_RID; REAL_NEG_NEG]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `n:num`]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `(x = y) /\ abs(u) <= v ==> abs((x + u) - y) <= v`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[SIN_0; COS_0; REAL_NEG_0] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`r:num`; `4`] DIVISION) THEN REWRITE_TAC[ARITH_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (RAND_CONV o ONCE_DEPTH_CONV) [th] THEN + MP_TAC(SYM th)) THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + UNDISCH_TAC `r MOD 4 < 4` THEN + SPEC_TAC(`r MOD 4`,`d:num`) THEN CONV_TAC EXPAND_CASES_CONV THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[ARITH_RULE `x * 4 + 2 = 2 * (2 * x + 1)`; + ARITH_RULE `x * 4 + 0 = 2 * 2 * x`] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN; REAL_POW_ONE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_MUL_ASSOC; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN + REWRITE_TAC[real_div; REAL_ABS_NUM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + REPEAT COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND; COS_BOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Taylor series for atan; needs a bit more preparation. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ATN_POWSER_SUMMABLE = prove + (`!x. abs(x) < &1 + ==> summable (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_ABS_POS; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC REAL_LE_LDIV THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_OF_NUM_LT; EVEN; LT_NZ]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN + ASM_MESON_TAC[REAL_OF_NUM_LE; EVEN; ARITH_RULE `1 <= n <=> ~(n = 0)`]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN + MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; + +let REAL_ATN_POWSER_DIFFS_SUMMABLE = prove + (`!x. abs(x) < &1 + ==> summable (\n. diffs (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n)) n * + x pow n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. abs(x) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_ABS_POS; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `inv(&1 - abs x)` THEN + MATCH_MP_TAC GP THEN ASM_REWRITE_TAC[REAL_ABS_ABS]);; + +let REAL_ATN_POWSER_DIFFS_SUM = prove + (`!x. abs(x) < &1 + ==> (\n. diffs (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n) + sums (inv(&1 + x pow 2))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUMMABLE) THEN + DISCH_THEN(fun th -> MP_TAC(MATCH_MP SUMMABLE_SUM th) THEN + MP_TAC(MATCH_MP SER_PAIR th)) THEN + SUBGOAL_THEN + `(\n. sum (2 * n,2) (\n. diffs + (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n)) n * x pow n)) = + (\n. --(x pow 2) pow n)` + SUBST1_TAC THENL + [ABS_TAC THEN + CONV_TAC(LAND_CONV(LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)))) THEN + REWRITE_TAC[sum; diffs; ADD_CLAUSES; EVEN_MULT; ARITH_EVEN; EVEN] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LZERO; + REAL_MUL_RZERO] THEN + SIMP_TAC[ARITH_RULE `SUC n - 1 = n`; DIV_MULT; ARITH_EQ] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW_POW] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID]; ALL_TAC] THEN + SUBGOAL_THEN `(\n. --(x pow 2) pow n) sums inv (&1 + x pow 2)` MP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `&1 + x = &1 - (--x)`] THEN + MATCH_MP_TAC GP THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL2; REAL_ABS_POS]; ALL_TAC] THEN + MESON_TAC[SUM_UNIQ]);; + +let REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE = prove + (`!x. abs(x) < &1 + ==> summable + (\n. diffs (diffs + (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n))) n * x pow n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diffs] THEN + MATCH_MP_TAC SER_COMPAR THEN + EXISTS_TAC `\n. &(SUC n) * abs(x) pow n` THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_MUL; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_POW_LE; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_ABS_POS; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; REAL_MUL_LID; + REAL_ABS_NUM; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SER_RATIO THEN + SUBGOAL_THEN `?c. abs(x) < c /\ c < &1` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `(&1 + abs(x)) / &2` THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?N. !n. n >= N ==> &(SUC(SUC n)) * abs(x) <= &(SUC n) * c` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[real_pow; REAL_ABS_MUL; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_ABS] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN ASM_SIMP_TAC[]] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO] THEN + EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS] THEN UNDISCH_TAC `abs(x) < c` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x + &1 <= y <=> &1 <= y - x * &1`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + SUBGOAL_THEN `?N. &1 <= &N * (c / abs x - &1)` STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC `N:num` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&1 <= x ==> x <= y ==> &1 <= y`)) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b ==> a <= b + &1`; + REAL_OF_NUM_LE; REAL_LE_RADD] THEN + REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; + REAL_LT_IMP_LE]] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_LT_SUB_LADD; REAL_ADD_LID; + REAL_LT_RDIV_EQ; GSYM REAL_ABS_NZ; REAL_MUL_LID; + REAL_ARCH_SIMPLE]);; + +let REAL_ATN_POWSER_DIFFL = prove + (`!x. abs(x) < &1 + ==> ((\x. suminf (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n)) + diffl (inv(&1 + x pow 2))) x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFS_SUM) THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP SUM_UNIQ) THEN + MATCH_MP_TAC TERMDIFF THEN + SUBGOAL_THEN `?K. abs(x) < abs(K) /\ abs(K) < &1` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `(&1 + abs(x)) / &2` THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ABS_DIV; REAL_ABS_NUM; + REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `abs(x) < &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_ATN_POWSER_SUMMABLE; REAL_ATN_POWSER_DIFFS_SUMMABLE; + REAL_ATN_POWSER_DIFFS_DIFFS_SUMMABLE]);; + +let REAL_ATN_POWSER = prove + (`!x. abs(x) < &1 + ==> (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) + sums (atn x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER_SUMMABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_SUM) THEN + SUBGOAL_THEN + `suminf (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) = atn(x)` + (fun th -> REWRITE_TAC[th]) THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a = b) <=> (a - b = &0)`] THEN + SUBGOAL_THEN + `suminf (\n. (if EVEN n then &0 + else --(&1) pow ((n - 1) DIV 2) / &n) * &0 pow n) - + atn(&0) = &0` + MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `(a = &0) /\ (b = &0) ==> (a - b = &0)`) THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNIQ THEN + MP_TAC(SPEC `&0` GP) THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(MP_TAC o SPEC `&0` o MATCH_MP SER_CMUL) THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + CONV_TAC SYM_CONV THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN ASM_MESON_TAC[EVEN]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM TAN_0] THEN + MATCH_MP_TAC TAN_ATN THEN + SIMP_TAC[PI2_BOUNDS; REAL_ARITH `&0 < x ==> --x < &0`]]; + ALL_TAC] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MP_TAC(SPEC `\x. suminf (\n. (if EVEN n then &0 + + else --(&1) pow ((n - 1) DIV 2) / &n) * x pow n) - + atn x` DIFF_ISCONST_END_SIMPLE) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ x < &0`)) + THENL + [DISCH_THEN(MP_TAC o SPECL [`&0`; `x:real`]); + CONV_TAC(RAND_CONV SYM_CONV) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `&0`])] THEN + (REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `u:real` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs(u) < &1` (MP_TAC o MATCH_MP REAL_ATN_POWSER_DIFFL) THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o C CONJ (SPEC `u:real` DIFF_ATN)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_SUB) THEN + REWRITE_TAC[REAL_SUB_REFL]));; + +let MCLAURIN_ATN = prove + (`!x n. abs(x) < &1 + ==> abs(atn x - + sum(0,n) (\m. (if EVEN m then &0 + else --(&1) pow ((m - 1) DIV 2) / &m) * + x pow m)) + <= abs(x) pow n / (&1 - abs x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ATN_POWSER) THEN + DISCH_THEN(fun th -> ASSUME_TAC(SYM(MATCH_MP SUM_UNIQ th)) THEN + MP_TAC(MATCH_MP SUM_SUMMABLE th)) THEN + DISCH_THEN(MP_TAC o MATCH_MP SER_OFFSET) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUM_UNIQ) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(r) <= e ==> (f - s = r) ==> abs(f - s) <= e`) THEN + SUBGOAL_THEN + `(\m. abs(x) pow (m + n)) sums (abs(x) pow n) * inv(&1 - abs(x))` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP GP o MATCH_MP (REAL_ARITH + `abs(x) < &1 ==> abs(abs x) < &1`)) THEN + DISCH_THEN(MP_TAC o SPEC `abs(x) pow n` o MATCH_MP SER_CMUL) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM REAL_POW_ADD]; + ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP SUM_UNIQ o REWRITE_RULE[GSYM real_div]) THEN + SUBGOAL_THEN + `!m. abs((if EVEN (m + n) then &0 + else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * + x pow (m + n)) + <= abs(x) pow (m + n)` + ASSUME_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_POW_LE; REAL_ABS_POS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_POW; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; REAL_ABS_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_MESON_TAC[EVEN]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `suminf (\m. abs((if EVEN (m + n) then &0 + else --(&1) pow (((m + n) - 1) DIV 2) / &(m + n)) * + x pow (m + n)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SER_ABS THEN MATCH_MP_TAC SER_COMPARA THEN + EXISTS_TAC `\m. abs(x) pow (m + n)` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUM_SUMMABLE]; ALL_TAC] THEN + MATCH_MP_TAC SER_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SER_COMPARA THEN + EXISTS_TAC `\m. abs(x) pow (m + n)` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[SUM_SUMMABLE]);; diff --git a/Library/wo.ml b/Library/wo.ml new file mode 100644 index 0000000..36ce8ff --- /dev/null +++ b/Library/wo.ml @@ -0,0 +1,834 @@ +(* ========================================================================= *) +(* Proof of some useful AC equivalents like wellordering and Zorn's Lemma. *) +(* *) +(* This is a straight port of the old HOL88 wellorder library. I started to *) +(* clean up the proofs to exploit first order automation, but didn't have *) +(* the patience to persist till the end. Anyway, the proofs work! *) +(* ========================================================================= *) + +let PBETA_TAC = CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV);; + +let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o + check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;; + +let SUBSET_PRED = prove + (`!P Q. P SUBSET Q <=> !x. P x ==> Q x`, + REWRITE_TAC[SUBSET; IN]);; + +let UNIONS_PRED = prove + (`UNIONS P = \x. ?p. P p /\ p x`, + REWRITE_TAC[UNIONS; FUN_EQ_THM; IN_ELIM_THM; IN]);; + +(* ======================================================================== *) +(* (1) Definitions and general lemmas. *) +(* ======================================================================== *) + +(* ------------------------------------------------------------------------ *) +(* Irreflexive version of an ordering. *) +(* ------------------------------------------------------------------------ *) + +let less = new_definition + `(less l)(x,y) <=> (l:A#A->bool)(x,y) /\ ~(x = y)`;; + +(* ------------------------------------------------------------------------ *) +(* Field of an uncurried binary relation *) +(* ------------------------------------------------------------------------ *) + +let fl = new_definition + `fl(l:A#A->bool) x <=> ?y:A. l(x,y) \/ l(y,x)`;; + +(* ------------------------------------------------------------------------ *) +(* Partial order (we infer the domain from the field of the relation) *) +(* ------------------------------------------------------------------------ *) + +let poset = new_definition + `poset (l:A#A->bool) <=> + (!x. fl(l) x ==> l(x,x)) /\ + (!x y z. l(x,y) /\ l(y,z) ==> l(x,z)) /\ + (!x y. l(x,y) /\ l(y,x) ==> (x = y))`;; + +(* ------------------------------------------------------------------------ *) +(* Chain in a poset (Defined as a subset of the field, not the ordering) *) +(* ------------------------------------------------------------------------ *) + +let chain = new_definition + `chain(l:A#A->bool) P <=> (!x y. P x /\ P y ==> l(x,y) \/ l(y,x))`;; + +(* ------------------------------------------------------------------------- *) +(* Total order. *) +(* ------------------------------------------------------------------------- *) + +let toset = new_definition + `toset (l:A#A->bool) <=> + poset l /\ !x y. x IN fl(l) /\ y IN fl(l) ==> l(x,y) \/ l(y,x)`;; + +(* ------------------------------------------------------------------------ *) +(* Wellorder *) +(* ------------------------------------------------------------------------ *) + +let woset = new_definition + `woset (l:A#A->bool) <=> + (!x. fl(l) x ==> l(x,x)) /\ + (!x y z. l(x,y) /\ l(y,z) ==> l(x,z)) /\ + (!x y. l(x,y) /\ l(y,x) ==> (x = y)) /\ + (!x y. fl(l) x /\ fl(l) y ==> l(x,y) \/ l(y,x)) /\ + (!P. (!x. P x ==> fl(l) x) /\ (?x. P x) ==> + (?y. P y /\ (!z. P z ==> l(y,z))))`;; + +(* ------------------------------------------------------------------------ *) +(* General (reflexive) notion of initial segment. *) +(* ------------------------------------------------------------------------ *) + +parse_as_infix("inseg",(12,"right"));; + +let inseg = new_definition + `(l:A#A->bool) inseg m <=> !x y. l(x,y) <=> m(x,y) /\ fl(l) y`;; + +(* ------------------------------------------------------------------------ *) +(* Specific form of initial segment: `all elements in fl(l) less than a`. *) +(* ------------------------------------------------------------------------ *) + +let linseg = new_definition + `linseg (l:A#A->bool) a = \(x,y). l(x,y) /\ (less l)(y,a)`;; + +(* ------------------------------------------------------------------------ *) +(* `Ordinals`, i.e. canonical wosets using choice operator. *) +(* ------------------------------------------------------------------------ *) + +let ordinal = new_definition + `ordinal(l:A#A->bool) <=> + woset(l) /\ (!x. fl(l) x ==> (x = (@) (\y. ~(less l)(y,x))))`;; + +(* ------------------------------------------------------------------------ *) +(* Now useful things about the orderings *) +(* ------------------------------------------------------------------------ *) + +let [POSET_REFL; POSET_TRANS; POSET_ANTISYM] = + map (GEN `l:A#A->bool` o DISCH_ALL) + (CONJUNCTS(PURE_ONCE_REWRITE_RULE[poset] (ASSUME `poset (l:A#A->bool)`)));; + +let POSET_FLEQ = prove + (`!l:A#A->bool. poset l ==> (!x. fl(l) x <=> l(x,x))`, + MESON_TAC[POSET_REFL; fl]);; + +let CHAIN_SUBSET = prove + (`!(l:A#A->bool) P Q. chain(l) P /\ Q SUBSET P ==> chain(l) Q`, + REWRITE_TAC[chain; SUBSET_PRED] THEN MESON_TAC[]);; + +let [WOSET_REFL; WOSET_TRANS; WOSET_ANTISYM; WOSET_TOTAL; WOSET_WELL] = + map (GEN `l:A#A->bool` o DISCH_ALL) + (CONJUNCTS(PURE_ONCE_REWRITE_RULE[woset] (ASSUME `woset (l:A#A->bool)`)));; + +let WOSET_POSET = prove + (`!l:A#A->bool. woset l ==> poset l`, + GEN_TAC THEN REWRITE_TAC[woset; poset] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]);; + +let WOSET_FLEQ = prove + (`!l:A#A->bool. woset l ==> (!x. fl(l) x <=> l(x,x))`, + MESON_TAC[WOSET_POSET; POSET_FLEQ]);; + +let WOSET_TRANS_LESS = prove + (`!l:A#A->bool. woset l ==> + !x y z. (less l)(x,y) /\ l(y,z) ==> (less l)(x,z)`, + REWRITE_TAC[woset; less] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Antisymmetry and wellfoundedness are sufficient for a wellorder *) +(* ------------------------------------------------------------------------ *) + +let WOSET = prove + (`!l:A#A->bool. woset l <=> + (!x y. l(x,y) /\ l(y,x) ==> (x = y)) /\ + (!P. (!x. P x ==> fl(l) x) /\ (?x. P x) ==> + (?y. P y /\ (!z. P z ==> l(y,z))))`, + GEN_TAC THEN REWRITE_TAC[woset] THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(!x y z. l(x,y) /\ l(y,z) ==> l(x,z)) /\ + (!x:A y. fl(l) x /\ fl(l) y ==> l(x,y) \/ l(y,x))` + MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT STRIP_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `\w:A. (w = x) \/ (w = y) \/ (w = z)`) THEN + REWRITE_TAC[fl]; + FIRST_ASSUM(MP_TAC o SPEC `\w:A. (w = x) \/ (w = y)`)] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Misc lemmas. *) +(* ------------------------------------------------------------------------ *) + +let PAIRED_EXT = prove + (`!(l:A#B->C) m. (!x y. l(x,y) = m(x,y)) <=> (l = m)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `p:A#B` THEN + SUBST1_TAC(SYM(SPEC `p:A#B` PAIR)) THEN POP_ASSUM MATCH_ACCEPT_TAC);; + +let WOSET_TRANS_LE = prove + (`!l:A#A->bool. woset l ==> + !x y z. l(x,y) /\ (less l)(y,z) ==> (less l)(x,z)`, + REWRITE_TAC[less] THEN MESON_TAC[WOSET_TRANS; WOSET_ANTISYM]);; + +let WOSET_WELL_CONTRAPOS = prove + (`!l:A#A->bool. woset l ==> + (!P. (!x. P x ==> fl(l) x) /\ (?x. P x) ==> + (?y. P y /\ (!z. (less l)(z,y) ==> ~P z)))`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `P:A->bool` o MATCH_MP WOSET_WELL) THEN + ASM_MESON_TAC[WOSET_TRANS_LE; less]);; + +let WOSET_TOTAL_LE = prove + (`!l:A#A->bool. woset l + ==> !x y. fl(l) x /\ fl(l) y ==> l(x,y) \/ (less l)(y,x)`, + REWRITE_TAC[less] THEN MESON_TAC[WOSET_REFL; WOSET_TOTAL]);; + +let WOSET_TOTAL_LT = prove + (`!l:A#A->bool. woset l ==> + !x y. fl(l) x /\ fl(l) y ==> (x = y) \/ (less l)(x,y) \/ (less l)(y,x)`, + REWRITE_TAC[less] THEN MESON_TAC[WOSET_TOTAL]);; + +(* ======================================================================== *) +(* (2) AXIOM OF CHOICE ==> CANTOR-ZERMELO WELLORDERING THEOREM *) +(* ======================================================================== *) + +(* ------------------------------------------------------------------------ *) +(* UNIONS of initial segments is an initial segment. *) +(* ------------------------------------------------------------------------ *) + +let UNION_FL = prove + (`!P (l:A#A->bool). fl(UNIONS P) x <=> ?l. P l /\ fl(l) x`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIONS_PRED; fl] THEN MESON_TAC[]);; + +let UNION_INSEG = prove + (`!P (l:A#A->bool). (!m. P m ==> m inseg l) ==> (UNIONS P) inseg l`, + REWRITE_TAC[inseg; UNION_FL; UNIONS_PRED] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Initial segment of a woset is a woset. *) +(* ------------------------------------------------------------------------ *) + +let INSEG_SUBSET = prove + (`!(l:A#A->bool) m. m inseg l ==> !x y. m(x,y) ==> l(x,y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[inseg] THEN MESON_TAC[]);; + +let INSEG_SUBSET_FL = prove + (`!(l:A#A->bool) m. m inseg l ==> !x. fl(m) x ==> fl(l) x`, + REWRITE_TAC[fl] THEN MESON_TAC[INSEG_SUBSET]);; + +let INSEG_WOSET = prove + (`!(l:A#A->bool) m. m inseg l /\ woset l ==> woset m`, + REWRITE_TAC[inseg] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[WOSET] THEN CONJ_TAC THENL + [ASM_MESON_TAC[WOSET_ANTISYM]; + GEN_TAC THEN FIRST_ASSUM(MP_TAC o SPEC_ALL o MATCH_MP WOSET_WELL) THEN + ASM_MESON_TAC[fl]]);; + +(* ------------------------------------------------------------------------ *) +(* Properties of segments of the `linseg` form. *) +(* ------------------------------------------------------------------------ *) + +let LINSEG_INSEG = prove + (`!(l:A#A->bool) a. woset l ==> (linseg l a) inseg l`, + REPEAT STRIP_TAC THEN REWRITE_TAC[inseg; linseg; fl] THEN PBETA_TAC THEN + ASM_MESON_TAC[WOSET_TRANS_LE]);; + +let LINSEG_WOSET = prove + (`!(l:A#A->bool) a. woset l ==> woset(linseg l a)`, + MESON_TAC[INSEG_WOSET; LINSEG_INSEG]);; + +let LINSEG_FL = prove + (`!(l:A#A->bool) a x. woset l ==> (fl (linseg l a) x <=> (less l)(x,a))`, + REWRITE_TAC[fl; linseg; less] THEN PBETA_TAC THEN + MESON_TAC[WOSET_REFL; WOSET_TRANS; WOSET_ANTISYM; fl]);; + +(* ------------------------------------------------------------------------ *) +(* Key fact: a proper initial segment is of the special form. *) +(* ------------------------------------------------------------------------ *) + +let INSEG_PROPER_SUBSET = prove + (`!(l:A#A->bool) m. m inseg l /\ ~(l = m) ==> + ?x y. l(x,y) /\ ~m(x,y)`, + REWRITE_TAC[GSYM PAIRED_EXT] THEN MESON_TAC[INSEG_SUBSET]);; + +let INSEG_PROPER_SUBSET_FL = prove + (`!(l:A#A->bool) m. m inseg l /\ ~(l = m) ==> + ?a. fl(l) a /\ ~fl(m) a`, + MESON_TAC[INSEG_PROPER_SUBSET; fl; inseg]);; + +let INSEG_LINSEG = prove + (`!(l:A#A->bool) m. woset l ==> + (m inseg l <=> (m = l) \/ (?a. fl(l) a /\ (m = linseg l a)))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `m:A#A->bool = l` THEN + ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[inseg; fl] THEN MESON_TAC[]; ALL_TAC] THEN + EQ_TAC THEN STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINSEG_INSEG]] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP WOSET_WELL_CONTRAPOS) THEN + DISCH_THEN(MP_TAC o SPEC `\x:A. fl(l) x /\ ~fl(m) x`) THEN REWRITE_TAC[] THEN + REWRITE_TAC[linseg; GSYM PAIRED_EXT] THEN PBETA_TAC THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) THENL + [ASM_MESON_TAC[INSEG_PROPER_SUBSET_FL]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[INSEG_SUBSET; INSEG_SUBSET_FL; fl; + WOSET_TOTAL_LE; less; inseg]);; + +(* ------------------------------------------------------------------------ *) +(* A proper initial segment can be extended by its bounding element. *) +(* ------------------------------------------------------------------------ *) + +let EXTEND_FL = prove + (`!(l:A#A->bool) x. woset l ==> (fl (\(x,y). l(x,y) /\ l(y,a)) x <=> l(x,a))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN + ASM_MESON_TAC[WOSET_TRANS; WOSET_REFL; fl]);; + +let EXTEND_INSEG = prove + (`!(l:A#A->bool) a. woset l /\ fl(l) a ==> (\(x,y). l(x,y) /\ l(y,a)) inseg l`, + REPEAT STRIP_TAC THEN REWRITE_TAC[inseg] THEN PBETA_TAC THEN + REPEAT GEN_TAC THEN IMP_RES_THEN (fun t ->REWRITE_TAC[t]) EXTEND_FL);; + +let EXTEND_LINSEG = prove + (`!(l:A#A->bool) a. woset l /\ fl(l) a ==> + (\(x,y). linseg l a (x,y) \/ (y = a) /\ (fl(linseg l a) x \/ (x = a))) + inseg l`, + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + MP_TAC (MATCH_MP EXTEND_INSEG th)) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM PAIRED_EXT] THEN PBETA_TAC THEN + REPEAT GEN_TAC THEN IMP_RES_THEN (fun th -> REWRITE_TAC[th]) LINSEG_FL THEN + REWRITE_TAC[linseg; less] THEN PBETA_TAC THEN ASM_MESON_TAC[WOSET_REFL]);; + +(* ------------------------------------------------------------------------ *) +(* Key canonicality property of ordinals. *) +(* ------------------------------------------------------------------------ *) + +let ORDINAL_CHAINED_LEMMA = prove + (`!(k:A#A->bool) l m. ordinal(l) /\ ordinal(m) + ==> k inseg l /\ k inseg m + ==> (k = l) \/ (k = m) \/ ?a. fl(l) a /\ fl(m) a /\ + (k = linseg l a) /\ + (k = linseg m a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[ordinal] THEN STRIP_TAC THEN + EVERY_ASSUM(fun th -> TRY + (fun g -> REWRITE_TAC[MATCH_MP INSEG_LINSEG th] g)) THEN + ASM_CASES_TAC `k:A#A->bool = l` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `k:A#A->bool = m` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `a:A = b` (fun th -> ASM_MESON_TAC[th]) THEN + FIRST_ASSUM(fun th -> SUBST1_TAC(MATCH_MP th (ASSUME `fl(l) (a:A)`))) THEN + FIRST_ASSUM(fun th -> SUBST1_TAC(MATCH_MP th (ASSUME `fl(m) (b:A)`))) THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `k = linseg m (b:A)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[linseg; GSYM PAIRED_EXT] THEN PBETA_TAC THEN + ASM_MESON_TAC[WOSET_REFL; less; fl]);; + +let ORDINAL_CHAINED = prove + (`!(l:A#A->bool) m. ordinal(l) /\ ordinal(m) ==> m inseg l \/ l inseg m`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[ordinal] th) THEN + ASSUME_TAC (MATCH_MP ORDINAL_CHAINED_LEMMA th)) THEN + MP_TAC(SPEC `\k:A#A->bool. k inseg l /\ k inseg m` UNION_INSEG) THEN + DISCH_THEN(fun th -> + MP_TAC(CONJ (SPEC `l:A#A->bool` th) (SPEC `m:A#A->bool` th))) THEN + REWRITE_TAC[TAUT `(a /\ b ==> a) /\ (a /\ b ==> b)`] THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + FIRST_ASSUM(REPEAT_TCL DISJ_CASES_THEN MP_TAC o + C MATCH_MP th)) THENL + [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN + MP_TAC(ASSUME `UNIONS (\k. k inseg l /\ k inseg m) = linseg l (a:A)`) THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `(a:A,a)`) THEN + REWRITE_TAC[linseg] THEN PBETA_TAC THEN REWRITE_TAC[less] THEN + REWRITE_TAC[UNIONS_PRED] THEN EXISTS_TAC + `\(x,y). linseg l a (x,y) \/ (y = a) /\ (fl(linseg l a) x \/ (x = a:A))` THEN + PBETA_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + UNDISCH_TAC `UNIONS (\k. k inseg l /\ k inseg m) = linseg l (a:A)` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC EXTEND_LINSEG THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------ *) +(* Proof that any none-universe ordinal can be extended to its "successor". *) +(* ------------------------------------------------------------------------ *) + +let FL_SUC = prove + (`!(l:A#A->bool) a. + fl(\(x,y). l(x,y) \/ (y = a) /\ (fl(l) x \/ (x = a))) x <=> + fl(l) x \/ (x = a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN EQ_TAC THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN TRY DISJ1_TAC THEN + ASM_MESON_TAC[]);; + +let ORDINAL_SUC = prove + (`!l:A#A->bool. ordinal(l) /\ (?x. ~(fl(l) x)) ==> + ordinal(\(x,y). l(x,y) \/ (y = @y. ~fl(l) y) /\ + (fl(l) x \/ (x = @y. ~fl(l) y)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[ordinal] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + ABBREV_TAC `a:A = @y. ~fl(l) y` THEN + SUBGOAL_THEN `~fl(l:A#A->bool) a` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN CONV_TAC SELECT_CONV THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + PBETA_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[WOSET] THEN PBETA_TAC THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[WOSET_ANTISYM]; ALL_TAC; ALL_TAC] THEN + UNDISCH_TAC `~fl(l:A#A->bool) a` THEN CONV_TAC CONTRAPOS_CONV THEN + DISCH_TAC THEN FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN + DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[fl] THENL + [EXISTS_TAC `y:A`; EXISTS_TAC `x:A`] THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `P:A->bool` THEN REWRITE_TAC[FL_SUC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `w:A`)) THEN + IMP_RES_THEN (MP_TAC o SPEC `\x:A. P x /\ fl(l) x`) WOSET_WELL THEN + BETA_TAC THEN REWRITE_TAC[TAUT `a /\ b ==> b`] THEN + ASM_CASES_TAC `?x:A. P x /\ fl(l) x` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; + FIRST_ASSUM(MP_TAC o SPEC `w:A` o + GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_MESON_TAC[]]]; + X_GEN_TAC `z:A` THEN REWRITE_TAC[FL_SUC; less] THEN + PBETA_TAC THEN DISCH_THEN DISJ_CASES_TAC THENL + [UNDISCH_TAC `!x:A. fl l x ==> (x = (@y. ~less l (y,x)))` THEN + DISCH_THEN(IMP_RES_THEN MP_TAC) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `y:A` THEN + BETA_TAC THEN REWRITE_TAC[less] THEN AP_TERM_TAC THEN + ASM_CASES_TAC `y:A = z` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `fl(l:A#A->bool) z` THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `z:A = a` THEN DISCH_THEN SUBST_ALL_TAC THEN + GEN_REWRITE_TAC LAND_CONV [SYM(ASSUME `(@y:A. ~fl(l) y) = a`)] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `y:A` THEN + BETA_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `y:A = a` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[fl] THEN EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------ *) +(* The union of a set of ordinals is an ordinal. *) +(* ------------------------------------------------------------------------ *) + +let ORDINAL_UNION = prove + (`!P. (!l:A#A->bool. P l ==> ordinal(l)) ==> ordinal(UNIONS P)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ordinal; WOSET] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN REWRITE_TAC[UNIONS_PRED] THEN + BETA_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `l:A#A->bool` (CONJUNCTS_THEN2 (ANTE_RES_THEN ASSUME_TAC) + ASSUME_TAC)) + (X_CHOOSE_THEN `m:A#A->bool` (CONJUNCTS_THEN2 (ANTE_RES_THEN ASSUME_TAC) + ASSUME_TAC))) THEN + MP_TAC(SPECL [`l:A#A->bool`; `m:A#A->bool`] ORDINAL_CHAINED) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THENL + [MP_TAC(SPEC `l:A#A->bool` WOSET_ANTISYM); + MP_TAC(SPEC `m:A#A->bool` WOSET_ANTISYM)] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ordinal]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `Q:A->bool` THEN REWRITE_TAC[UNION_FL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:A`)) THEN + MP_TAC(ASSUME `!x:A. Q x ==> (?l. P l /\ fl l x)`) THEN + DISCH_THEN(IMP_RES_THEN + (X_CHOOSE_THEN `l:A#A->bool` STRIP_ASSUME_TAC)) THEN + IMP_RES_THEN ASSUME_TAC (ASSUME `!l:A#A->bool. P l ==> ordinal l`) THEN + ASSUME_TAC(CONJUNCT1 + (REWRITE_RULE[ordinal] (ASSUME `ordinal(l:A#A->bool)`))) THEN + IMP_RES_THEN(MP_TAC o SPEC `\x:A. fl(l) x /\ Q x`) WOSET_WELL THEN + BETA_TAC THEN REWRITE_TAC[TAUT `a /\ b ==> a`] THEN + SUBGOAL_THEN `?x:A. fl(l) x /\ Q x` (fun th -> REWRITE_TAC[th]) THENL + [EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b:A` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + ANTE_RES_THEN MP_TAC (ASSUME `(Q:A->bool) x`) THEN + DISCH_THEN(X_CHOOSE_THEN `m:A#A->bool` STRIP_ASSUME_TAC) THEN + ANTE_RES_THEN ASSUME_TAC (ASSUME `(P:(A#A->bool)->bool) m`) THEN + MP_TAC(SPECL [`l:A#A->bool`; `m:A#A->bool`] ORDINAL_CHAINED) THEN + ASM_REWRITE_TAC[UNIONS_PRED] THEN BETA_TAC THEN + DISCH_THEN DISJ_CASES_TAC THENL + [EXISTS_TAC `l:A#A->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET_FL THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `m:A#A->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:A`; `b:A`] o REWRITE_RULE[inseg]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + IMP_RES_THEN (MP_TAC o SPEC `b:A`) INSEG_SUBSET_FL THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(CONJUNCT1(REWRITE_RULE[ordinal] + (ASSUME `ordinal(m:A#A->bool)`))) THEN + DISCH_THEN(MP_TAC o SPECL [`b:A`; `x:A`] o MATCH_MP WOSET_TOTAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN (DISJ_CASES_THEN MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[fl] THEN + EXISTS_TAC `b:A` THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN REWRITE_TAC[UNION_FL] THEN + DISCH_THEN(X_CHOOSE_THEN `l:A#A->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ASSUME `!l:A#A->bool. P l ==> ordinal l`) THEN + DISCH_THEN(IMP_RES_THEN MP_TAC) THEN REWRITE_TAC[ordinal] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:A`)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN + REPEAT AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `y:A` THEN BETA_TAC THEN AP_TERM_TAC THEN + ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[less; UNIONS_PRED] THEN + BETA_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [EXISTS_TAC `l:A#A->bool` THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM(X_CHOOSE_THEN `m:A#A->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `ordinal(l:A#A->bool) /\ ordinal(m:A#A->bool)` MP_TAC THENL + [CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(DISJ_CASES_TAC o MATCH_MP ORDINAL_CHAINED)] THENL + [IMP_RES_THEN MATCH_MP_TAC INSEG_SUBSET THEN ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[inseg]) THEN ASM_REWRITE_TAC[]]]]);; + +(* ------------------------------------------------------------------------ *) +(* Consequently, every type can be wellordered (and by an ordinal). *) +(* ------------------------------------------------------------------------ *) + +let ORDINAL_UNION_LEMMA = prove + (`!(l:A#A->bool) x. ordinal l ==> fl(l) x ==> fl(UNIONS(ordinal)) x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_FL] THEN + EXISTS_TAC `l:A#A->bool` THEN ASM_REWRITE_TAC[]);; + +let ORDINAL_UP = prove + (`!l:A#A->bool. ordinal(l) ==> (!x. fl(l) x) \/ + (?m x. ordinal(m) /\ fl(m) x /\ ~fl(l) x)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[TAUT `a \/ b <=> ~a ==> b`] THEN + GEN_REWRITE_TAC LAND_CONV [NOT_FORALL_THM] THEN DISCH_TAC THEN + MP_TAC(SPEC `l:A#A->bool` ORDINAL_SUC) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC + [`\(x,y). l(x,y) \/ (y = @y:A. ~fl l y) /\ (fl(l) x \/ (x = @y. ~fl l y))`; + `@y. ~fl(l:A#A->bool) y`] THEN + ASM_REWRITE_TAC[FL_SUC] THEN + CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[]);; + +let LEMMA = prove + (`?l:A#A->bool. ordinal(l) /\ !x. fl(l) x`, + EXISTS_TAC `UNIONS (ordinal:(A#A->bool)->bool)` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC ORDINAL_UNION THEN REWRITE_TAC[]; + DISCH_THEN(DISJ_CASES_TAC o MATCH_MP ORDINAL_UP) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM(X_CHOOSE_THEN `m:A#A->bool` + (X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC)) THEN + IMP_RES_THEN (IMP_RES_THEN MP_TAC) ORDINAL_UNION_LEMMA THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------ *) +(* At least -- every set can be wellordered. *) +(* ------------------------------------------------------------------------ *) + +let FL_RESTRICT = prove + (`!l. woset l ==> + !P. fl(\(x:A,y). P x /\ P y /\ l(x,y)) x <=> P x /\ fl(l) x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + TRY(EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN NO_TAC) THEN + EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN + IMP_RES_THEN MATCH_MP_TAC WOSET_REFL THEN + REWRITE_TAC[fl] THEN EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[]);; + +let WO = prove + (`!P. ?l:A#A->bool. woset l /\ (fl(l) = P)`, + GEN_TAC THEN X_CHOOSE_THEN `l:A#A->bool` STRIP_ASSUME_TAC + (REWRITE_RULE[ordinal] LEMMA) THEN + EXISTS_TAC `\(x:A,y). P x /\ P y /\ l(x,y)` THEN REWRITE_TAC[WOSET] THEN + PBETA_TAC THEN + GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FL_RESTRICT th]) THEN + PBETA_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP WOSET_ANTISYM) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `Q:A->bool` THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP WOSET_WELL) THEN + DISCH_THEN(MP_TAC o SPEC `Q:A->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN + REPEAT CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM ACCEPT_TAC]);; + +(* ======================================================================== *) +(* (3) CANTOR-ZERMELO WELL-ORDERING THEOREM ==> HAUSDORFF MAXIMAL PRINCIPLE *) +(* ======================================================================== *) + +let HP = prove + (`!l:A#A->bool. poset l ==> + ?P. chain(l) P /\ !Q. chain(l) Q /\ P SUBSET Q ==> (Q = P)`, + GEN_TAC THEN DISCH_TAC THEN + X_CHOOSE_THEN `w:A#A->bool` MP_TAC (SPEC `\x:A. T` WO) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [FUN_EQ_THM] THEN BETA_TAC THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + IMP_RES_THEN (MP_TAC o SPEC `\x:A. fl(l) x`) WOSET_WELL THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `?x:A. fl(l) x` THEN ASM_REWRITE_TAC[] THENL + [DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC); + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + EXISTS_TAC `\x:A. F` THEN REWRITE_TAC[chain; SUBSET_PRED] THEN + GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `u:A` MP_TAC o + GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`u:A`; `u:A`]) THEN + IMP_RES_THEN(ASSUME_TAC o GSYM) POSET_FLEQ THEN ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `?f. !x. f x = if fl(l) x /\ + (!y. less w (y,x) ==> l (x,f y) \/ l (f y,x)) + then (x:A) else b` + (CHOOSE_TAC o GSYM) THENL + [SUBGOAL_THEN `WF(\x:A y. (less w)(x,y))` MP_TAC THENL + [REWRITE_TAC[WF] THEN GEN_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC_ALL o MATCH_MP WOSET_WELL) THEN + ASM_REWRITE_TAC[less] THEN ASM_MESON_TAC[WOSET_ANTISYM]; + DISCH_THEN(MATCH_MP_TAC o MATCH_MP WF_REC) THEN + REWRITE_TAC[] THEN REPEAT GEN_TAC THEN + REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]; ALL_TAC] THEN + IMP_RES_THEN(IMP_RES_THEN ASSUME_TAC) POSET_REFL THEN + SUBGOAL_THEN `(f:A->A) b = b` ASSUME_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `b:A`) THEN + REWRITE_TAC[COND_ID] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x:A. fl(l:A#A->bool) (f x)` ASSUME_TAC THENL + [GEN_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `x:A`) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(ANTE_RES_THEN (ASSUME_TAC o GEN_ALL) o SPEC_ALL) THEN + SUBGOAL_THEN `!x:A. (l:A#A->bool)(b,f x) \/ l(f x,b)` ASSUME_TAC THENL + [GEN_TAC THEN MP_TAC(SPEC `x:A` (ASSUME `!x:A. (w:A#A->bool)(b,f x)`)) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `x:A`) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `x:A = b` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `(less w)(b:A,x)` MP_TAC THENL + [ASM_REWRITE_TAC[less] THEN CONV_TAC(RAND_CONV SYM_CONV) THEN + FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th o CONJUNCT2)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN DISJ_CASES_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x y. l((f:A->A) x,f y) \/ l(f y,f x)` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + IMP_RES_THEN(MP_TAC o SPECL [`x:A`; `y:A`]) WOSET_TOTAL_LT THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [ASM_REWRITE_TAC[] THEN IMP_RES_THEN MATCH_MP_TAC POSET_REFL; + ONCE_REWRITE_TAC[DISJ_SYM] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `y:A`); + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `x:A`)] THEN + TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(IMP_RES_THEN ACCEPT_TAC o CONJUNCT2); ALL_TAC] THEN + EXISTS_TAC `\y:A. ?x:A. y = f(x)` THEN + SUBGOAL_THEN `chain(l:A#A->bool)(\y. ?x:A. y = f x)` ASSUME_TAC THENL + [REWRITE_TAC[chain] THEN BETA_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN(CHOOSE_THEN SUBST1_TAC)); ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `Q:A->bool` THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `z:A` THEN EQ_TAC THENL + [DISCH_TAC THEN BETA_TAC THEN EXISTS_TAC `z:A` THEN + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `z:A`) THEN + SUBGOAL_THEN `fl(l:A#A->bool) z /\ + !y. (less w)(y,z) ==> l(z,f y) \/ l(f y,z)` + (fun th -> REWRITE_TAC[th]) THEN CONJ_TAC THENL + [UNDISCH_TAC `chain(l:A#A->bool) Q` THEN REWRITE_TAC[chain] THEN + DISCH_THEN(MP_TAC o SPECL [`z:A`; `z:A`]) THEN ASM_REWRITE_TAC[fl] THEN + DISCH_TAC THEN EXISTS_TAC `z:A` THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `y:A` THEN DISCH_TAC THEN + UNDISCH_TAC `chain(l:A#A->bool) Q` THEN REWRITE_TAC[chain] THEN + DISCH_THEN(MP_TAC o SPECL [`z:A`; `(f:A->A) y`]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET_PRED]) THEN + BETA_TAC THEN EXISTS_TAC `y:A` THEN REFL_TAC]; + SPEC_TAC(`z:A`,`z:A`) THEN ASM_REWRITE_TAC[GSYM SUBSET_PRED]]);; + +(* ======================================================================== *) +(* (4) HAUSDORFF MAXIMAL PRINCIPLE ==> ZORN'S LEMMA *) +(* ======================================================================== *) + +let ZL = prove + (`!l:A#A->bool. poset l /\ + (!P. chain(l) P ==> (?y. fl(l) y /\ !x. P x ==> l(x,y))) ==> + ?y. fl(l) y /\ !x. l(y,x) ==> (y = x)`, + GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `M:A->bool` STRIP_ASSUME_TAC o MATCH_MP HP) THEN + UNDISCH_TAC `!P. chain(l:A#A->bool) P + ==> (?y. fl(l) y /\ !x. P x ==> l(x,y))` THEN + DISCH_THEN(MP_TAC o SPEC `M:A->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:A` THEN + DISCH_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~a`] THEN DISCH_TAC THEN + SUBGOAL_THEN `chain(l) (\x:A. M x \/ (x = z))` MP_TAC THENL + [REWRITE_TAC[chain] THEN BETA_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN DISJ_CASES_TAC) THEN + ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `chain(l:A#A->bool) M` THEN REWRITE_TAC[chain] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + DISJ1_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP POSET_TRANS) THEN + EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; + DISJ2_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP POSET_TRANS) THEN + EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP POSET_REFL) THEN + REWRITE_TAC[fl] THEN EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `M SUBSET (\x:A. M x \/ (x = z))` MP_TAC THENL + [REWRITE_TAC[SUBSET_PRED] THEN GEN_TAC THEN BETA_TAC THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `(a ==> b ==> c) <=> (b /\ a ==> c)`] THEN + DISCH_THEN(fun th -> FIRST_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN + DISCH_THEN(MP_TAC o SPEC `z:A`) THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> FIRST_ASSUM(ASSUME_TAC o C MATCH_MP th)) THEN + FIRST_ASSUM(MP_TAC o SPECL [`m:A`; `z:A`] o MATCH_MP POSET_ANTISYM) THEN + ASM_REWRITE_TAC[]);; + +(* ======================================================================== *) +(* (5) ZORN'S LEMMA ==> KURATOWSKI'S LEMMA *) +(* ======================================================================== *) + +let KL_POSET_LEMMA = prove + (`poset (\(c1,c2). C SUBSET c1 /\ c1 SUBSET c2 /\ chain(l:A#A->bool) c2)`, + REWRITE_TAC[poset] THEN PBETA_TAC THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `P:A->bool` THEN REWRITE_TAC[fl] THEN PBETA_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `Q:A->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THENL + [MATCH_MP_TAC CHAIN_SUBSET; MATCH_MP_TAC SUBSET_TRANS]; + GEN_TAC THEN X_GEN_TAC `Q:A->bool` THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS; + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM] THEN + TRY(EXISTS_TAC `Q:A->bool`) THEN ASM_REWRITE_TAC[]);; + +let KL = prove + (`!l:A#A->bool. poset l ==> + !C. chain(l) C ==> + ?P. (chain(l) P /\ C SUBSET P) /\ + (!R. chain(l) R /\ P SUBSET R ==> (R = P))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\(c1,c2). C SUBSET c1 /\ c1 SUBSET c2 /\ + chain(l:A#A->bool) c2` ZL) THEN PBETA_TAC THEN + REWRITE_TAC[KL_POSET_LEMMA; MATCH_MP POSET_FLEQ KL_POSET_LEMMA] THEN + PBETA_TAC THEN + W(C SUBGOAL_THEN (fun t ->REWRITE_TAC[t]) o + funpow 2 (fst o dest_imp) o snd) THENL + [X_GEN_TAC `P:(A->bool)->bool` THEN GEN_REWRITE_TAC LAND_CONV [chain] THEN + PBETA_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `?D:A->bool. P D` THENL + [EXISTS_TAC `UNIONS(P) :A->bool` THEN REWRITE_TAC[SUBSET_REFL] THEN + FIRST_ASSUM(X_CHOOSE_TAC `D:A->bool`) THEN + FIRST_ASSUM(MP_TAC o SPECL [`D:A->bool`; `D:A->bool`]) THEN + REWRITE_TAC[ASSUME `(P:(A->bool)->bool) D`; SUBSET_REFL] THEN + STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> (a /\ b) /\ c`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_PRED; SUBSET_PRED] THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET_PRED]) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[chain; UNIONS_PRED] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN + BETA_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `A:A->bool`) (X_CHOOSE_TAC `B:A->bool`)) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + DISCH_THEN(MP_TAC o SPECL [`A:A->bool`; `B:A->bool`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [UNDISCH_TAC `chain(l:A#A->bool) B`; + UNDISCH_TAC `chain(l:A#A->bool) A`] THEN + REWRITE_TAC[chain] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET_PRED]) THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THEN X_GEN_TAC `X:A->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`X:A->bool`; `X:A->bool`]) THEN + REWRITE_TAC[] THEN DISCH_THEN(IMP_RES_THEN STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[UNIONS_PRED; SUBSET_PRED] THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN EXISTS_TAC `X:A->bool` THEN + ASM_REWRITE_TAC[]]; + EXISTS_TAC `C:A->bool` THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + ASM_REWRITE_TAC[SUBSET_REFL]]; + DISCH_THEN(X_CHOOSE_THEN `D:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `D:A->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Also the order extension theorem, using Abian's proof. *) +(* ------------------------------------------------------------------------- *) + +let OEP = prove + (`!p:A#A->bool. poset p ==> ?t. toset t /\ fl(t) = fl(p) /\ p SUBSET t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `fl(p:A#A->bool)` WO) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `w:A#A->bool` STRIP_ASSUME_TAC) THEN + ABBREV_TAC + `t = \(x:A,y:A). fl p x /\ fl p y /\ + (x = y \/ + ?i. fl p i /\ + (!j. w(j,i) /\ ~(j = i) ==> (p(j,x) <=> p(j,y))) /\ + ~p(i,x) /\ p(i,y))` THEN + EXISTS_TAC `t:A#A->bool` THEN + SUBGOAL_THEN + `!x:A y:A. fl p x /\ fl p y /\ ~(x = y) + ==> ?i. fl p i /\ + (!j:A. w(j,i) /\ ~(j = i) ==> (p(j,x) <=> p(j,y))) /\ + ~(p(i,x) <=> p(i,y))` + (LABEL_TAC "*") THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [woset]) THEN ASM_SIMP_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `\i:A. fl p i /\ ~(p(i,x) <=> p(i,y))`) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [poset]) THEN ASM_MESON_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:A` THEN + ASM_MESON_TAC[fl]]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A y:A. p(x,y) ==> t(x,y)` ASSUME_TAC THENL + [EXPAND_TAC "t" THEN REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[fl]; ALL_TAC]) THEN + ASM_CASES_TAC `x:A = y` THENL [ASM_MESON_TAC[fl]; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPECL [`x:A`; `y:A`]) THEN ASM_SIMP_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[fl]; MATCH_MP_TAC MONO_EXISTS] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [poset]) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN] THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[fl] THEN ASM_MESON_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[toset; poset]] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [poset]) THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:A`; `y:A`; `z:A`] THEN + ASM_CASES_TAC `x:A = z` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN + ASM_CASES_TAC `y:A = z` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN + ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN + ASM_CASES_TAC `fl p (x:A)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `fl p (y:A)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `fl p (z:A)` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [woset]) THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPECL [`m:A`; `n:A`] o CONJUNCT1) THEN + ANTS_TAC THENL [ASM_MESON_TAC[fl]; ALL_TAC] THEN STRIP_TAC THENL + [EXISTS_TAC `m:A`; EXISTS_TAC `n:A`] THEN ASM_MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN + ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `fl p (x:A)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `fl p (y:A)` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `n:A` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [woset]) THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPECL [`m:A`; `n:A`] o CONJUNCT1) THEN + ASM_MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN + ASM_CASES_TAC `y:A = x` THEN ASM_REWRITE_TAC[IN] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REMOVE_THEN "*" (MP_TAC o SPECL [`x:A`; `y:A`]) THEN + ASM_REWRITE_TAC[OR_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + MESON_TAC[]]);; diff --git a/Minisat/dimacs_tools.ml b/Minisat/dimacs_tools.ml new file mode 100644 index 0000000..c96afdf --- /dev/null +++ b/Minisat/dimacs_tools.ml @@ -0,0 +1,309 @@ + +(*open satCommonTools;;*) + +(* translation from terms to DIMACS cnf and back *) + +(* mapping from HOL variable names to DIMACS variable numbers + is stored in a global assignable (i.e. reference) variable sat_var_map. + The type of sat_var_map is (int * (term * int) map) ref and + the integer first component is the next available number + (i.e. it is one plus the number of elements in the map) + in th second component (t,n), if n<0 then the literal represented + is ~t (the stored t is never negated) +*) + +(* + initialise sat_var_map to integer 1 paired with the empty map + (in DIMACS variable numbering starts from 1 because 0 + is the clause separator) +*) + +let sat_var_map = ref(1, Termmap.empty) +let sat_var_arr = ref(Array.make 0 t_tm) (* varnum->+ve lit. *) + +(* + Reinitialise sat_var_map. + Needs to be done for each translation of a term to DIMACS + as numbers must be an initial segment of 1,2,3,... + (otherwise grasp, zchaff etc may crash) +*) + +(*+1 'cos var numbers start at 1*) +let initSatVarMap var_count = + (sat_var_map := (1, Termmap.empty); + sat_var_arr := Array.make (var_count+1) t_tm) + + +(* + Lookup the var number corresponding to a +ve literal s, possibly extending sat_var_map +*) + +let lookup_sat_var s = + let (c,svm) = !sat_var_map in + snd (try Termmap.find s svm with + Not_found -> + let svm' = Termmap.add s (s,c) svm in + let _ = (sat_var_map := (c+1,svm')) in + let _ = + try (Array.set (!sat_var_arr) c s) + with Invalid_argument _ -> + failwith ("lookup_sat_varError: "^(string_of_term s)^"::"^(string_of_int c)^"\n") in + (t_tm,c)) + + +(* + Lookup the +ve lit corresponding to a var number +*) +let lookup_sat_num n = + try (Array.get (!sat_var_arr) n) + with Invalid_argument _ -> + failwith ("lookup_sat_numError: "^(string_of_int n)^"\n") + + +(* + Show sat_var_map as a list of its elements +*) + +let showSatVarMap () = + let (c,st) = !sat_var_map in + (c, List.map snd (tm_listItems st)) + +(* + Print a term showing types +*) + +let all_string_of_term t = + ((string_of_term) t^" : "^(string_of_type (type_of t))) + +let print_all_term t = + print_string (all_string_of_term t);; + +(* + Convert a literal to a (bool * integer) pair, where + the boolean is true iff the literal is negated, + if necessary extend sat_var_map +*) + +exception Lit_to_int_err of string + +let literalToInt t = + let (sign,v) = + if is_neg t + then + let t1 = dest_neg t in + if type_of t1 = bool_ty + then (true, t1) + else raise (Lit_to_int_err (all_string_of_term t)) + else + if type_of t = bool_ty + then (false, t) + else raise (Lit_to_int_err (all_string_of_term t)) in + let v_num = lookup_sat_var v in + (sign, v_num) + +(* + Convert an integer (a possibly negated var number) to a literal, + raising lookup_sat_numError if the absolute value of + the integer isn't in sat_var_map +*) +let intToLiteral n = + let t = lookup_sat_num (abs n) in + if n>=0 then t else mk_neg t + +(* + termToDimacs t + checks t is CNF of the form + ``(v11 \/ ... \/ v1p) /\ (v21 \/ ... \/ v2q) /\ ... /\ (vr1 \/ ... \/vrt)`` + where vij is a literal, i.e. a boolean variable or a negated + boolean variable. + If t is such a CNF then termToDimacs t returns a list of lists of integers + [[n11,...,n1p],[n21,...,n2q], ... , [nr1,...,nrt]] + If vij is a boolean variable ``v`` then nij is the entry + for v in sat_var_map. If vij is ``~v``, then nij is the negation + of the entry for v in sat_var_map + N.B. Definition of termToDimacs processes last clause first, + so variables are not numbered in the left-to-right order. + Not clear if this matters. +*) + +let termToDimacs t = + List.fold_right + (fun c d -> (List.map literalToInt (disjuncts c)) :: d) + (conjuncts t) [] + +(* Test data +val t1 = ``x:bool``; +val t2 = ``~x``; +val t3 = ``x \/ y \/ ~z \/ w``; +val t4 = ``(x \/ y \/ ~z \/ w) /\ (~w \/ ~x \/ y)``; +val t5 = ``(x \/ y \/ ~z \/ w) /\ !x. (~w \/ ~x \/ y)``; +val t6 = ``(x \/ y \/ ~z \/ w) /\ (~w)``; +val t7 = ``(x \/ y \/ ~z \/ w) /\ (~w) /\ (w \/ x) /\ (p /\ q /\ r)``; +*) + +(* + reference containing prefix used to make variables from numbers + when reading DIMACS +*) + +let prefix = ref "v" + +(* + intToPrefixedLiteral n = ``(!prefix)n`` + intToPrefixedLiteral (~n) = ``~(!prefix)n`` +*) + +let intToPrefixedLiteral n = + if n >= 0 + then mk_var(((!prefix) ^ (string_of_int n)), bool_ty) + else mk_neg(mk_var((!prefix) ^ (string_of_int(abs n)), bool_ty)) + +(* + buildClause [n1,...,np] builds + ``(!prefix)np /\ ... /\ (!prefix)n1`` + Raises exception Empty on the empty list +*) + +let buildClause l = + List.fold_left + (fun t n -> mk_disj(intToPrefixedLiteral n, t)) + (intToPrefixedLiteral (hd l)) + (tl l) + +(* + dimacsToTerm l + converts a list of integers + [n11,...,n1p,0,n21,...,n2q,0, ... , 0,nr1,...,nrt,0] + into a term in CNF of the form + ``(v11 \/ ... \/ v1p) /\ (v21 \/ ... \/ v2q) /\ ... /\ (vr1 \/ ... \/vrt)`` + where vij is a literal, i.e. a boolean variable or a negated boolena variable. + If nij is non-negative then vij is ``(!prefix)nij``; + If nij is negative ~mij then vij is ``~(!prefix)mij``; +*) + +(* dimacsToTerm_aux splits off one clause, dimacsToTerm iterates it *) +let rec dimacsToTerm_aux acc = function + [] -> (buildClause acc,[]) + | (0::l) -> (buildClause acc,l) + | (x::l) -> dimacsToTerm_aux (x::acc) l + +let rec dimacsToTerm l = + let (t,l1) = dimacsToTerm_aux [] l in + if List.length l1 = 0 + then t + else mk_conj(t, dimacsToTerm l1) + +(* + Convert (true,n) to "-n" and (false,n) to "n" +*) + +let literalToString b n = + if b + then ("-" ^ (string_of_int n)) + else string_of_int n + +(* + termToDimacsFile t + converts t to DIMACS and then writes out a + file into the temporary directory. + the name of the temporary file (without extension ".cnf") is returned. +*) + +(* + Refererence containing name of temporary file used + for last invocation of a SAT solver +*) + +let tmp_name = ref "undefined" + +let termToDimacsFile fname t var_count = + let clause_count = List.length(conjuncts t) in + let _ = initSatVarMap var_count in + let dlist = termToDimacs t in + let tmp = Filename.temp_file "sat" "" in + let tmpname = + match fname with + (Some fname) -> fname^".cnf" + | None -> tmp^".cnf" in + let outstr = open_out tmpname in + let out s = output_string outstr s in + let res = (out "c File "; out tmpname; out " generated by HolSatLib\n"; + out "c\n"; + out "p cnf "; + out (string_of_int var_count); out " "; + out (string_of_int clause_count); out "\n"; + List.iter + (fun l -> (List.iter (fun (x,y) -> + (out(literalToString x y); out " ")) l; + out "\n0\n")) + dlist; + close_out outstr; + tmp_name := tmp; + match fname with + (Some _) -> tmpname + | None -> tmp) in + res;; + +(* + readDimacs filename + reads a DIMACS file called filename and returns + a term in CNF in which each number n in the DIMACS file + is a boolean variable (!prefix)n + Code below by Ken Larsen (replaces earlier implementation by MJCG) +*) +exception Read_dimacs_error;; + +let rec dropLine ins = + match Stream.peek ins with + Some '\n' -> Stream.junk ins + | Some _ -> (Stream.junk ins; dropLine ins) + | None -> raise Read_dimacs_error + +let rec stripPreamble ins = + match Stream.peek ins with + Some 'c' -> (dropLine ins; stripPreamble ins) + | Some 'p' -> (dropLine ins; stripPreamble ins) + | Some _ -> Some () + | None -> None + +let rec getIntClause lex acc = + match + (try Stream.next lex with + Stream.Failure -> Genlex.Kwd "EOF" (* EOF *)) + with + (Genlex.Int 0) -> Some acc + | (Genlex.Int i) -> getIntClause lex (i::acc) + | (Genlex.Kwd "EOF") -> + if List.length acc = 0 + then None + else Some acc + | _ -> raise Read_dimacs_error + + +(* This implementation is inspired by + (and hopefully faithful to) dimacsToTerm. +*) +let getTerms lex = + let rec loop acc = + match getIntClause lex [] with + Some ns -> loop (mk_conj(buildClause ns, acc)) + | None -> Some acc in + match getIntClause lex [] with + Some ns -> loop (buildClause ns) + | None -> None + +let readTerms ins = + match stripPreamble ins with + Some _ -> + let lex = (Genlex.make_lexer ["EOF"] ins) in + getTerms lex + | None -> None + +let readDimacs filename = + (*let val fullfilename = Path.mkAbsolute(filename, FileSys.getDir())*) + let inf = Pervasives.open_in filename in + let ins = Stream.of_channel inf in + let term = readTerms ins in + (close_in inf; + match term with Some t -> t | None -> raise Read_dimacs_error) + diff --git a/Minisat/make.ml b/Minisat/make.ml new file mode 100644 index 0000000..57adcba --- /dev/null +++ b/Minisat/make.ml @@ -0,0 +1,9 @@ +#load "str.cma";; +loads "Minisat/sat_common_tools.ml";; +loads "Minisat/dimacs_tools.ml";; +loads "Minisat/sat_solvers.ml";; +loads "Minisat/sat_script.ml";; +loads "Minisat/sat_tools.ml";; +loads "Minisat/minisat_parse.ml";; +loads "Minisat/minisat_resolve.ml";; +loads "Minisat/minisat_prove.ml";; diff --git a/Minisat/minisat_parse.ml b/Minisat/minisat_parse.ml new file mode 100644 index 0000000..796d57f --- /dev/null +++ b/Minisat/minisat_parse.ml @@ -0,0 +1,212 @@ +(*open satCommonTools dimacsTools;; *) + +(* parse minisat proof log into array cl. + array elements are either root clauses or + resolution chains for deriving the learnt clauses. + Last chain derives empty clause *) + +type rootc = + Rthm of thm * Litset.t * term * thm + | Ll of term * Litset.t + +type clause = + Blank + | Chain of (int * int) list * int (* var, cl index list and the length of that list *) + | Root of rootc + | Learnt of thm * Litset.t (* clause thm, lits as nums set *) + +let sat_fileopen s = open_in_bin s + +let sat_fileclose is = close_in is + +let sat_getChar is = Int32.of_int(input_byte is) + +(* copied from Minisat-p_v1.14::File::getUInt*) +(* this is technically able to parse int32's but no *) +(* point since we return int's always *) +(* FIXME: no idea what will happen on a 64-bit arch *) +let sat_getint is = + let (land) = Int32.logand in + let (lor) = Int32.logor in + let (lsl) = Int32.shift_left in + let (lsr) = Int32.shift_right in + let byte0 = sat_getChar is in + if ((byte0 land (0x80l))=(0x0l)) (* 8 *) + then Int32.to_int(byte0) + else + match Int32.to_int((byte0 land (0x60l)) lsr 5) with + 0 -> + let byte1 = sat_getChar is in + Int32.to_int(((byte0 land (0x1Fl)) lsl 8) lor byte1) (* 16 *) + | 1 -> + let byte1 = sat_getChar is in + let byte2 = sat_getChar is in + Int32.to_int( (((byte0 land (0x1Fl)) lsl 16) lor (byte1 lsl 8)) lor byte2) + | 2 -> + let byte1 = sat_getChar is in + let byte2 = sat_getChar is in + let byte3 = sat_getChar is in + Int32.to_int(((((byte0 land (0x1Fl)) lsl 24) lor (byte1 lsl 16)) + lor (byte2 lsl 8)) lor byte3) + (* default case is only where int64 is needed since we do a lsl 32*) + | _ -> + let byte0 = sat_getChar is in + let byte1 = sat_getChar is in + let byte2 = sat_getChar is in + let byte3 = sat_getChar is in + let byte4 = sat_getChar is in + let byte5 = sat_getChar is in + let byte6 = sat_getChar is in + let byte7 = sat_getChar is in + Int32.to_int((((byte0 lsl 24) lor (byte1 lsl 16) lor (byte2 lsl 8) lor byte3) lsl 32) + lor ((byte4 lsl 24) lor (byte5 lsl 16) lor (byte6 lsl 8) lor byte7)) + +let isRootClauseIdx cl ci = + match Array.get cl ci with + Root _ -> true + | _ -> false + +(* p is a literal *) +(* this mapping allows shadow ac-normalisation which keeps the lits for a given var together *) +(* the -1 is because literalToInt returns HolSatLib var numbers (base 1) *) +let literalToInt2 p = + let (sign,vnum) = literalToInt p in + 2*(vnum-1)+(if sign then 1 else 0) + +let literalToInt3 p = + let (sign,vnum) = literalToInt p in + (sign,vnum-1) + +(* parse a root clause *) +let getIntRoot fin idx = + let rec loop idx' acc = + let v = sat_getint fin in + if v=0 + then idx::(List.rev acc) + else loop (idx'+v) ((idx'+v)::acc) in + let res = loop idx [] in + res + +(*l1 and l2 are number reps of lits. Are they complements? *) +let is_compl l1 l2 = (abs(l2-l1)=1) && (l1 mod 2 = 0) + +(*il is clause input from minisat proof trace, + sl is internal clause sorted and unduped, with diff in var numbering account for *) +(* thus if il and sl are not exactly the same, + then the clause represented by sl was skipped *) +let isSameClause (il,sl) = (Pervasives.compare il sl = 0) + +let rec getNextRootClause scl vc cc lr il rcv = + let rc = Array.get rcv lr in + let rcl = disjuncts rc in + let lnl = List.map literalToInt3 rcl in + let lns = + List.fold_left (fun s e -> Litset.add e s) + Litset.empty lnl in + let slnl = (* FIXME: speed this up*) + List.sort Pervasives.compare + (setify + (List.map (fun (isn,vi) -> + if isn + then 2*vi+1 + else 2*vi) lnl)) in + if isSameClause(il,slnl) + then (Array.set scl lr cc;(lr,(rc,lns))) + else getNextRootClause scl vc cc (lr+1) il rcv + +(* this advances the file read pointer but we pick up the + actual clause from the list of clauses we already have + this is because minisatp removes duplicate literals + and sorts the literals so I can't efficiently find the + corresponding clause term in HOL. + assert: minisatp logs the root clauses in order of input*) +let addClause scl vc cc lr rcv fin sr lit1 = + let l = getIntRoot fin (lit1 lsr 1) in + let res = + match l with + [] -> failwith ("addClause:Failed parsing clause "^(string_of_int (cc))^"\n") + | _ -> + let (lr,(t,lns)) = + getNextRootClause scl vc cc lr l rcv in + (cc+1,lr+1,(Root (Ll (t,lns)))::sr) in + res + +(* parse resolve chain *) +let getIntBranch fin id h = + let rec loop acc len = + (*-1 is purely a decoding step *) + (* (i.e. not translating b/w HolSat and ms)*) + let v = (sat_getint fin)-1 in + if v=(-1) + then ((v,h)::(List.rev acc),len+1) + else + let ci = id-(sat_getint fin) in + loop ((v,ci)::acc) (len+1) in + let res = loop [] 0 in + res + +let addBranch fin sr cc id tc = + let (br,brl) = + getIntBranch fin id (id-(tc lsr 1)) in + let res = + if brl=1 (*(tl br = []) *) + then (cc,false,sr) (* delete *) + else (cc+1,true,(Chain (br,brl))::sr) (* resolve *) in + res + +(*this is modelled on MiniSat::Proof::traverse, + except we first read in everything then resolve backwards *) +(*sr is stack for originally reading in the clauses *) +(*lr is unskipped root clause count. *) +(*cc is clause count (inc learnt) *) + +let rec readTrace_aux scl vc cc lr rcv fin sr id = + let tmp,eof = try sat_getint fin,false with End_of_file -> 42,true in + if eof then (cc,sr) else + if (tmp land 1)=0 + then + let (cc,lr,sr) = + addClause scl vc cc lr rcv fin sr tmp in + readTrace_aux scl vc cc lr rcv fin sr (id+1) + else + let (cc,isch,sr') = + addBranch fin sr cc id tmp in + if isch + then readTrace_aux scl vc cc lr rcv fin sr' (id+1) (* chain *) + else readTrace_aux scl vc cc lr rcv fin sr' id (* deletion *) +;; + +(*fill in the root clause and chain array*) +let parseTrace nr fname vc rcv = + try + let fin = sat_fileopen fname in + let scl = Array.make nr (-1) in (*cl[scl[i]]=rcv[i] or scl[i]=~1 if rcv[i] was trivial *) + let (cc,sr) = readTrace_aux scl vc 0 0 rcv fin [] 0 in + let _ = sat_fileclose fin in + Some (cc,sr,scl) + with Sys_error _ -> None + +let getChain = function + Chain (vcl,vcll) -> vcl + | _ -> failwith("getChain: not a Chain") + +(*make backwards pass through cl, returning only the chains actually used in deriving F*) +let rec mk_sk cl ca ci = + let ch = List.fold_left + (fun ch (v,cci) -> + if (Array.get ca cci) or (isRootClauseIdx cl cci) + then ch + else (mk_sk cl ca cci)::ch) + [] (getChain (Array.get cl ci)) in + (Array.set ca ci true;ci::(List.concat ch)) + +let parseMinisatProof nr fname vc rcv = + match parseTrace nr fname vc rcv with + Some (cc,sr,scl) -> + let srl = List.length sr in + (*stores clauses as root clauses, learnt clauses or unresolved chains *) + let cl = Array.make srl Blank in + let _ = List.fold_left (fun i c -> (Array.set cl (i-1) c;i-1)) cc sr in + let sk = mk_sk cl (Array.make srl false) (cc-1) in + Some (cl,sk,scl,srl,cc) + | None -> None diff --git a/Minisat/minisat_prove.ml b/Minisat/minisat_prove.ml new file mode 100644 index 0000000..4d975ae --- /dev/null +++ b/Minisat/minisat_prove.ml @@ -0,0 +1,261 @@ +(* open satTools dimacsTools SatSolvers minisatResolve + satCommonTools minisatParse satScript def_cnf *) + +(* +for interactive use: + + #load "str.cma";; + #use "def_cnf.ml";; + #use "satCommonTools.ml";; + #use "dimacsTools.ml";; + #use "SatSolvers.ml";; + #use "satScript.ml";; + #use "satTools.ml";; + #use "minisatParse.ml";; + #use "minisatResolve.ml";; + #use "minisatProve.ml";; + #use "taut.ml";; +*) +(* ------------------------------------------------------------------------- *) +(* Flag to (de-)activate debugging facilities. *) +(* ------------------------------------------------------------------------- *) + +let sat_debugging = ref false;; + +(* ------------------------------------------------------------------------- *) +(* Split up a theorem according to conjuncts, in a general sense. *) +(* ------------------------------------------------------------------------- *) + +let GCONJUNCTS = + let [pth_ni1; pth_ni2; pth_no1; pth_no2; pth_an1; pth_an2; pth_nn] = + (map UNDISCH_ALL o CONJUNCTS o TAUT) + `(~(p ==> q) ==> p) /\ + (~(p ==> q) ==> ~q) /\ + (~(p \/ q) ==> ~p) /\ + (~(p \/ q) ==> ~q) /\ + (p /\ q ==> p) /\ + (p /\ q ==> q) /\ + (~ ~p ==> p)` in + let p_tm = concl pth_an1 and q_tm = concl pth_an2 in + let rec GCONJUNCTS th acc = + match (concl th) with + Comb(Const("~",_),Comb(Comb(Const("==>",_),p),q)) -> + GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_ni1)) + (GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_ni2)) + acc) + | Comb(Const("~",_),Comb(Comb(Const("\\/",_),p),q)) -> + GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_no1)) + (GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_no2)) + acc) + | Comb(Comb(Const("/\\",_),p),q) -> + GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_an1)) + (GCONJUNCTS (PROVE_HYP th (INST [p,p_tm; q,q_tm] pth_an2)) + acc) + | Comb(Const("~",_),Comb(Const("~",_),p)) -> + GCONJUNCTS (PROVE_HYP th (INST [p,p_tm] pth_nn)) acc + | _ -> th::acc in + fun th -> GCONJUNCTS th [];; + +(* ------------------------------------------------------------------------- *) +(* Generate fresh variable names (could just use genvars). *) +(* ------------------------------------------------------------------------- *) + +let propvar i = mk_var("x"^string_of_int i,bool_ty);; + +(* ------------------------------------------------------------------------- *) +(* Set up the basic definitional arrangement. *) +(* ------------------------------------------------------------------------- *) + +let rec localdefs tm (n,defs,lfn) = + if is_neg tm then + let n1,v1,defs1,lfn1 = localdefs (rand tm) (n,defs,lfn) in + let tm' = mk_neg v1 in + try (n1,apply defs1 tm',defs1,lfn1) with Failure _ -> + let n2 = n1 + 1 in + let v2 = propvar n2 in + n2,v2,(tm' |-> v2) defs1,(v2 |-> tm) lfn1 + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + let n1,v1,defs1,lfn1 = localdefs (lhand tm) (n,defs,lfn) in + let n2,v2,defs2,lfn2 = localdefs (rand tm) (n1,defs1,lfn1) in + let tm' = mk_comb(mk_comb(rator(rator tm),v1),v2) in + try (n2,apply defs2 tm',defs2,lfn2) with Failure _ -> + let n3 = n2 + 1 in + let v3 = propvar n3 in + n3,v3,(tm' |-> v3) defs2,(v3 |-> tm) lfn2 + else try (n,apply defs tm,defs,lfn) with Failure _ -> + let n1 = n + 1 in + let v1 = propvar n1 in + n1,v1,(tm |-> v1) defs,(v1 |-> tm) lfn;; + +(* ------------------------------------------------------------------------- *) +(* Just translate to fresh variables, but otherwise leave unchanged. *) +(* ------------------------------------------------------------------------- *) + +let rec transvar (n,tm,vdefs,lfn) = + if is_neg tm then + let n1,tm1,vdefs1,lfn1 = transvar (n,rand tm,vdefs,lfn) in + n1,mk_comb(rator tm,tm1),vdefs1,lfn1 + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + let n1,tm1,vdefs1,lfn1 = transvar (n,lhand tm,vdefs,lfn) in + let n2,tm2,vdefs2,lfn2 = transvar (n1,rand tm,vdefs1,lfn1) in + n2,mk_comb(mk_comb(rator(rator tm),tm1),tm2),vdefs2,lfn2 + else try n,apply vdefs tm,vdefs,lfn with Failure _ -> + let n1 = n + 1 in + let v1 = propvar n1 in + n1,v1,(tm |-> v1) vdefs,(v1 |-> tm) lfn;; + +(* ------------------------------------------------------------------------- *) +(* Flag to choose whether to exploit existing conjunctive structure. *) +(* ------------------------------------------------------------------------- *) + +let exploit_conjunctive_structure = ref true;; + +(* ------------------------------------------------------------------------- *) +(* Check if something is clausal (slightly stupid). *) +(* ------------------------------------------------------------------------- *) + +let is_literal tm = is_var tm or is_neg tm & is_var(rand tm);; + +let is_clausal tm = + let djs = disjuncts tm in + forall is_literal djs & list_mk_disj djs = tm;; + +(* ------------------------------------------------------------------------- *) +(* Now do the definitional arrangement but not wastefully at the top. *) +(* ------------------------------------------------------------------------- *) + +let definitionalize = + let transform_imp = + let pth = TAUT `(p ==> q) <=> ~p \/ q` in + let ptm = rand(concl pth) in + let p_tm = rand(lhand ptm) and q_tm = rand ptm in + fun th -> let ip,q = dest_comb(concl th) in + let p = rand ip in + EQ_MP (INST [p,p_tm; q,q_tm] pth) th + and transform_iff_1 = + let pth = UNDISCH(TAUT `(p <=> q) ==> (p \/ ~q)`) in + let ptm = concl pth in + let p_tm = lhand ptm and q_tm = rand(rand ptm) in + fun th -> let ip,q = dest_comb(concl th) in + let p = rand ip in + PROVE_HYP th (INST [p,p_tm; q,q_tm] pth) + and transform_iff_2 = + let pth = UNDISCH(TAUT `(p <=> q) ==> (~p \/ q)`) in + let ptm = concl pth in + let p_tm = rand(lhand ptm) and q_tm = rand ptm in + fun th -> let ip,q = dest_comb(concl th) in + let p = rand ip in + PROVE_HYP th (INST [p,p_tm; q,q_tm] pth) in + let definitionalize th (n,tops,defs,lfn) = + let t = concl th in + if is_clausal t then + let n',v,defs',lfn' = transvar (n,t,defs,lfn) in + (n',(v,th)::tops,defs',lfn') + else if is_neg t then + let n1,v1,defs1,lfn1 = localdefs (rand t) (n,defs,lfn) in + (n1,(mk_neg v1,th)::tops,defs1,lfn1) + else if is_disj t then + let n1,v1,defs1,lfn1 = localdefs (lhand t) (n,defs,lfn) in + let n2,v2,defs2,lfn2 = localdefs (rand t) (n1,defs1,lfn1) in + (n2,(mk_disj(v1,v2),th)::tops,defs2,lfn2) + else if is_imp t then + let n1,v1,defs1,lfn1 = localdefs (lhand t) (n,defs,lfn) in + let n2,v2,defs2,lfn2 = localdefs (rand t) (n1,defs1,lfn1) in + (n2,(mk_disj(v1,v2),transform_imp th)::tops,defs2,lfn2) + else if is_iff t then + let n1,v1,defs1,lfn1 = localdefs (lhand t) (n,defs,lfn) in + let n2,v2,defs2,lfn2 = localdefs (rand t) (n1,defs1,lfn1) in + (n2,(mk_disj(v1,mk_neg v2),transform_iff_1 th):: + (mk_disj(mk_neg v1,v2),transform_iff_2 th)::tops,defs2,lfn2) + else + let n',v,defs',lfn' = localdefs t (n,defs,lfn) in + (n',(v,th)::tops,defs',lfn') in + definitionalize;; + +(* SAT_PROVE is the main interface function. + Takes in a term t and returns thm or exception if not a taut *) +(* invokes minisatp, returns |- t or |- model ==> ~t *) + +(* if minisatp proof log does not exist after minisatp call returns, + we will assume that minisatp discovered UNSAT during the read-in + phase and did not bother with a proof log. + In that case the problem is simple and can be delegated to TAUT *) + +(* FIXME: I do not like the TAUT solution; + what is trivial for Minisat may not be so for TAUT *) + +exception Sat_counterexample of thm;; + +(* delete temporary files *) +(* if zChaff was used, also delete hard-wired trace filenames*) +let CLEANUP fname solvername = + let delete fname = try Sys.remove fname with Sys_error _ -> () in + (delete fname; + delete (fname^".cnf"); + delete (fname^"."^solvername); + delete (fname^"."^solvername^".proof"); + delete (fname^"."^solvername^".stats"); + if solvername="zchaff" then + (delete(Filename.concat (!temp_path) "resolve_trace"); + delete(Filename.concat (!temp_path) "zc2mso_trace")) + else ());; + +let GEN_SAT_PROVE solver solvername = + let false_tm = `F` + and presimp_conv = GEN_REWRITE_CONV DEPTH_CONV + [NOT_CLAUSES; AND_CLAUSES; OR_CLAUSES; IMP_CLAUSES; EQ_CLAUSES] + and p_tm = `p:bool` and q_tm = `q:bool` + and pth_triv = TAUT `(~p <=> F) <=> p` + and pth_main = UNDISCH_ALL(TAUT `(~p <=> q) ==> (q ==> F) ==> p`) in + let triv_rule p th = EQ_MP(INST [p,p_tm] pth_triv) th + and main_rule p q sth th = + itlist PROVE_HYP [sth; DISCH_ALL th] (INST [p,p_tm; q,q_tm] pth_main) in + let invoke_minisat lfn mcth stm t rcv vc = + let nr = Array.length rcv in + let res = match invokeSat solver None t (Some vc) with + Some model -> + let model2 = + mapfilter (fun l -> let x = hd(frees l) in + let y = apply lfn x in + if is_var y then vsubst [y,x] l else fail()) + model in + satCheck model2 stm + | None -> + (match parseMinisatProof nr ((!tmp_name)^"."^solvername^".proof") vc rcv with + Some (cl,sk,scl,srl,cc) -> + unsatProveResolve lfn mcth (cl,sk,srl) (* returns p |- F *) + | None -> UNDISCH(TAUT(mk_imp(stm,false_tm)))) in + res in + fun tm -> + let sth = presimp_conv (mk_neg tm) in + let stm = rand(concl sth) in + if stm = false_tm then triv_rule tm sth else + let th = ASSUME stm in + let ths = if !exploit_conjunctive_structure then GCONJUNCTS th + else [th] in + let n,tops,defs,lfn = + itlist definitionalize ths (-1,[],undefined,undefined) in + let defg = foldl (fun a t nv -> (t,nv)::a) [] defs in + let mdefs = filter (fun (r,_) -> not (is_var r)) defg in + let eqs = map (fun (r,l) -> mk_iff(l,r)) mdefs in + let clausify eq cls = + let fvs = frees eq and eth = (NNFC_CONV THENC CNF_CONV) eq in + let tth = INST (map (fun v -> apply lfn v,v) fvs) eth in + let xth = ADD_ASSUM stm (EQ_MP tth (REFL(apply lfn (lhand eq)))) in + zip (conjuncts(rand(concl eth))) (CONJUNCTS xth) @ cls in + let all_clauses = itlist clausify eqs tops in + let mcth = itlist (fun (c,th) m -> Termmap.add c th m) all_clauses + Termmap.empty in + let vc = n + 1 in + let rcv = Array.of_list (map fst all_clauses) in + let ntdcnf = list_mk_conj (map fst all_clauses) in + let th = invoke_minisat lfn mcth stm ntdcnf rcv vc in + (if not (!sat_debugging) then CLEANUP (!tmp_name) solvername else (); + if is_imp(concl th) + then raise (Sat_counterexample + (EQ_MP (AP_TERM (rator(concl th)) (SYM sth)) th)) + else main_rule tm stm sth th);; + +let SAT_PROVE = GEN_SAT_PROVE minisatp "minisatp";; + +let ZSAT_PROVE = GEN_SAT_PROVE zchaff "zchaff";; diff --git a/Minisat/minisat_resolve.ml b/Minisat/minisat_resolve.ml new file mode 100644 index 0000000..b616f8d --- /dev/null +++ b/Minisat/minisat_resolve.ml @@ -0,0 +1,129 @@ +(*open satCommonTools dimacsTools minisatParse satScript*) + +(* functions for replaying minisat proof LCF-style. + Called from minisatProve.ml after proof log has + been parsed. *) + +(* p is a literal *) +let toVar p = + if is_neg p + then rand p + else p;; + +let (NOT_NOT_ELIM,NOT_NOT_CONV) = + let t = mk_var("t",bool_ty) in + let NOT_NOT2 = SPEC_ALL NOT_NOT in + ((fun th -> EQ_MP (INST [rand(rand(concl th)),t] NOT_NOT2) th), + (fun tm -> INST [rand(rand tm),t] NOT_NOT2));; + +let l2hh = function + h0::h1::t -> (h0,h1,t) + | _ -> failwith("Match failure in l2hh");; + +(*+1 because minisat var numbers start at 0, dimacsTools at 1*) +let mk_sat_var lfn n = + let rv = lookup_sat_num (n+1) in + tryapplyd lfn rv rv;; + +let get_var_num lfn v = lookup_sat_var v - 1;; + +(* mcth maps clause term t to thm of the form cnf |- t, *) +(* where t is a clause of the cnf term *) +let dualise = + let pth_and = TAUT `F \/ F <=> F` and pth_not = TAUT `~T <=> F` in + let rec REFUTE_DISJ tm = + match tm with + Comb(Comb(Const("\\/",_) as op,l),r) -> + TRANS (MK_COMB(AP_TERM op (REFUTE_DISJ l),REFUTE_DISJ r)) pth_and + | Comb(Const("~",_) as l,r) -> + TRANS (AP_TERM l (EQT_INTRO(ASSUME r))) pth_not + | _ -> + ASSUME(mk_iff(tm,f_tm)) in + fun lfn -> let INSTANTIATE_ALL_UNDERLYING th = + let fvs = thm_frees th in + let tms = map (fun v -> tryapplyd lfn v v) fvs in + INST (zip tms fvs) th in + fun mcth t -> + EQ_MP (INSTANTIATE_ALL_UNDERLYING(REFUTE_DISJ t)) + (Termmap.find t mcth),t_tm,TRUTH;; + + +(* convert clause term to dualised thm form on first use *) +let prepareRootClause lfn mcth cl (t,lns) ci = + let (th,dl,cdef) = dualise lfn mcth t in + let _ = Array.set cl ci (Root (Rthm (th,lns,dl,cdef))) in + (th,lns);; + +(* will return clause info at index ci *) + +exception Fn_get_clause__match;; +exception Fn_get_root_clause__match;; + +(* will return clause info at index ci *) +let getRootClause cl ci = + let res = + match (Array.get cl ci) with + Root (Rthm (t,lns,dl,cdef)) -> (t,lns,dl,cdef) + | _ -> raise Fn_get_root_clause__match in + res;; + +(* will return clause thm at index ci *) + +let getClause lfn mcth cl ci = + let res = + match (Array.get cl ci) with + Root (Ll (t,lns)) -> prepareRootClause lfn mcth cl (t,lns) ci + | Root (Rthm (t,lns,dl,cdef)) -> (t,lns) + | Chain _ -> raise Fn_get_clause__match + | Learnt (th,lns) -> (th,lns) + | Blank -> raise Fn_get_clause__match in + res;; + +(* ground resolve clauses c0 and c1 on v, + where v is the only var that occurs with opposite signs in c0 and c1 *) +(* if n0 then v negated in c0 *) +(* (but remember we are working with dualised clauses) *) +let resolve = + let pth = UNDISCH(TAUT `F ==> p`) in + let p = concl pth + and f_tm = hd(hyp pth) in + fun v n0 rth0 rth1 -> + let th0 = DEDUCT_ANTISYM_RULE (INST [v,p] pth) (if n0 then rth0 else rth1) + and th1 = DEDUCT_ANTISYM_RULE (INST [mk_iff(v,f_tm),p] pth) + (if n0 then rth1 else rth0) in + EQ_MP th1 th0;; + +(* resolve c0 against c1 wrt v *) +let resolveClause lfn mcth cl vi rci (c0i,c1i) = + let ((rth0,lns0),(rth1,lns1)) = pair_map (getClause lfn mcth cl) (c0i,c1i) in + let piv = mk_sat_var lfn vi in + let n0 = mem piv (hyp rth0) in + let rth = resolve piv n0 rth0 rth1 in + let _ = Array.set cl rci (Learnt (rth,lns0)) in + ();; + +let resolveChain lfn mcth cl rci = + let (nl,lnl) = + match (Array.get cl rci) with + Chain (l,ll) -> (l,ll) + | _ -> failwith("resolveChain") in + let (vil,cil) = unzip nl in + let vil = tl vil in (* first pivot var is actually dummy value -1 *) + let (c0i,c1i,cilt) = l2hh cil in + let _ = resolveClause lfn mcth cl (List.hd vil) rci (c0i,c1i) in + let _ = + List.iter + (fun (vi,ci) -> + resolveClause lfn mcth cl vi rci (ci,rci)) + (tl (tl nl)) in + ();; + +(* rth should be A |- F, where A contains all and only *) +(* the root clauses used in the proof *) +let unsatProveResolve lfn mcth (cl,sk,srl) = + let _ = List.iter (resolveChain lfn mcth cl) (List.rev sk) in + let rth = + match (Array.get cl (srl-1)) with + Learnt (th,_) -> th + | _ -> failwith("unsatProveTrace") in + rth;; diff --git a/Minisat/sat_common_tools.ml b/Minisat/sat_common_tools.ml new file mode 100644 index 0000000..cdb7392 --- /dev/null +++ b/Minisat/sat_common_tools.ml @@ -0,0 +1,119 @@ + +(* miscellaneous useful stuff that doesn't fit in anywhere else *) + +let pair_map f (x,y) = (f x,f y) + +(* module for maps keyed on terms *) +module Termmap = Map.Make (struct type t = term let compare = Pervasives.compare end) + +module Litset = Set.Make (struct type t = bool * int let compare = Pervasives.compare end) + +let tm_listItems m = List.rev (Termmap.fold (fun k v l -> (k,v)::l) m []) + +let print_term t = print_string (string_of_term t) + +let print_type ty = print_string (string_of_type ty) + +(*FIXME: inefficient to read chars one by one; 1024 can be improved upon*) +let input_all in_ch = + let rec loop b = + match + (try Some (input_char in_ch) + with End_of_file -> None) + with + Some c -> (Buffer.add_char b c; loop b) + | None -> () in + let b = Buffer.create 1024 in + let _ = loop b in + Buffer.contents b + +let QUANT_CONV conv = RAND_CONV(ABS_CONV conv) + +let BINDER_CONV conv = ABS_CONV conv ORELSEC QUANT_CONV conv + +let rec LAST_FORALL_CONV c tm = + if is_forall (snd (dest_forall tm)) + then + BINDER_CONV (LAST_FORALL_CONV c) tm + else c tm + +let FORALL_IMP_CONV tm = + let (bvar,bbody) = dest_forall tm in + let (ant,conseq) = dest_imp bbody in + let fant = free_in bvar ant in + let fconseq = free_in bvar conseq in + let ant_thm = ASSUME ant in + let tm_thm = ASSUME tm in + if (fant && fconseq) + then failwith("FORALL_IMP_CONV"^ + ("`"^(fst(dest_var bvar))^"` free on both sides of `==>`")) + else + if fant + then + let asm = mk_exists(bvar,ant) in + let th1 = CHOOSE(bvar,ASSUME asm) (UNDISCH(SPEC bvar tm_thm)) in + let imp1 = DISCH tm (DISCH asm th1) in + let cncl = rand(concl imp1) in + let th2 = MP (ASSUME cncl) (EXISTS (asm,bvar) ant_thm) in + let imp2 = DISCH cncl (GEN bvar (DISCH ant th2)) in + IMP_ANTISYM_RULE imp1 imp2 + else + if fconseq + then + let imp1 = DISCH ant(GEN bvar(UNDISCH(SPEC bvar tm_thm))) in + let cncl = concl imp1 in + let imp2 = GEN bvar(DISCH ant(SPEC bvar(UNDISCH(ASSUME cncl)))) in + IMP_ANTISYM_RULE (DISCH tm imp1) (DISCH cncl imp2) + else + let asm = mk_exists(bvar,ant) in + let tmp = UNDISCH (SPEC bvar tm_thm) in + let th1 = GEN bvar (CHOOSE(bvar,ASSUME asm) tmp) in + let imp1 = DISCH tm (DISCH asm th1) in + let cncl = rand(concl imp1) in + let th2 = SPEC bvar (MP(ASSUME cncl) (EXISTS (asm,bvar) ant_thm)) in + let imp2 = DISCH cncl (GEN bvar (DISCH ant th2)) in + IMP_ANTISYM_RULE imp1 imp2 + +let LEFT_IMP_EXISTS_CONV tm = + let ant, _ = dest_imp tm in + let bvar,bdy = dest_exists ant in + let x' = variant (frees tm) bvar in + let t' = subst [x',bvar] bdy in + let th1 = GEN x' (DISCH t'(MP(ASSUME tm)(EXISTS(ant,x')(ASSUME t')))) in + let rtm = concl th1 in + let th2 = CHOOSE (x',ASSUME ant) (UNDISCH(SPEC x'(ASSUME rtm))) in + IMP_ANTISYM_RULE (DISCH tm th1) (DISCH rtm (DISCH ant th2)) + + + +(*********** terms **************) + +let lrand x = rand (rator x) + +let t_tm = `T`;; +let f_tm = `F`;; + +let is_T tm = (tm = t_tm) + +let is_F tm = (tm = f_tm) + +(************ HOL **************) + +let rec ERC lt tm = + if is_comb lt + then + let ((ltl,ltr),(tml,tmr)) = + pair_map dest_comb (lt,tm) in + (ERC ltl tml)@(ERC ltr tmr) + else + if is_var lt + then [(tm,lt)] + else [] + +(* easier REWR_CONV which assumes that the supplied theorem is ground and quantifier free, + so type instantiation and var capture checks are not needed *) +(* no restrictions on the term argument *) +let EREWR_CONV th tm = + let lt = lhs(concl th) in + let il = ERC lt tm in + INST il th diff --git a/Minisat/sat_script.ml b/Minisat/sat_script.ml new file mode 100644 index 0000000..d227a21 --- /dev/null +++ b/Minisat/sat_script.ml @@ -0,0 +1,33 @@ + +let AND_IMP = prove + (`!a b c. a /\ b ==> c <=> a ==> b ==> c`,CONV_TAC TAUT);; +let AND_IMP2 = prove + (`!a b c. a /\ b ==> c <=> (a<=>T) ==> b ==> c`,CONV_TAC TAUT);; +let AND_IMP3 = prove + (`!a b c. ~a /\ b ==> c <=> (a<=>F) ==> b ==> c`,CONV_TAC TAUT);; + +let NOT_NOT = GEN_ALL (hd (CONJUNCTS (SPEC_ALL NOT_CLAUSES)));; + +let AND_INV = prove + (`!a. (~a /\ a) <=> F`,CONV_TAC TAUT);; + +let AND_INV_IMP = prove + (`!a. a ==> ~a ==> F`,CONV_TAC TAUT);; + +let OR_DUAL = prove + (`(~(a \/ b) ==> F) = (~a ==> ~b ==> F)`,CONV_TAC TAUT);; + +let OR_DUAL2 = prove + (`(~(a \/ b) ==> F) = ((a==>F) ==> ~b ==> F)`,CONV_TAC TAUT);; + +let OR_DUAL3 = prove + (`(~(~a \/ b) ==> F) = (a ==> ~b ==> F)`,CONV_TAC TAUT);; + +let AND_INV2 = prove + (`(~a ==> F) ==> (a==>F) ==> F`,CONV_TAC TAUT) + +let NOT_ELIM2 = prove +(`(~a ==> F) <=> a`,CONV_TAC TAUT) + +let IMP_F_EQ_F = prove + (`!t. (t ==> F) <=> (t <=> F)`,CONV_TAC TAUT);; diff --git a/Minisat/sat_solvers.ml b/Minisat/sat_solvers.ml new file mode 100644 index 0000000..8a5fb4a --- /dev/null +++ b/Minisat/sat_solvers.ml @@ -0,0 +1,79 @@ +(* + This file contains specifications of the SAT tools that + can be invoked from HOL. + Details of format in the comments following each field name. + + {name (* solver name *) + url, (* source for downloading *) + executable, (* path to executable *) + good_exit, (* code return upon normal termination *) + notime_run, (* command to invoke solver on a file *) + time_run, (* command to invoke on a file and time *) + only_true (* true if only the true atoms are listed in models *) + failure_string, (* string whose presence indicates unsatisfiability *) + start_string, (* string signalling start of variable assignment *) + end_string} (* string signalling end of variable assignment *) +*) + +type sat_solver = + {name : string; + url : string; + executable : string; + good_exit : int; + notime_run : string -> string * string -> string; + time_run : string -> (string * string) * int -> string; + only_true : bool; + failure_string : string; + start_string : string; + end_string : string} + +let zchaff = + {name = "zchaff"; + url = + "http://www.ee.princeton.edu/~chaff/zchaff/zchaff.2001.2.17.linux.gz"; + executable = "zchaff"; + good_exit = 0; + notime_run = (fun ex -> fun (infile,outfile) -> + (ex ^ " " ^ infile ^ " > " ^ outfile ^ + "; zc2mso " ^ infile ^ + " -m " ^ outfile ^ ".proof -z "^ + (Filename.concat (!temp_path) "resolve_trace")^ + "> "^ + (Filename.concat (!temp_path) "zc2mso_trace"))); + time_run = (fun ex -> fun ((infile,outfile),time) -> + (ex ^ " " ^ infile ^ " " ^ (string_of_int time) ^ " > " ^ outfile)); + only_true = false; + failure_string = "UNSAT"; + start_string = "Instance Satisfiable"; + end_string = "Random Seed Used"} + +let minisat = + {name = "minisat"; + url = "http://www.cs.chalmers.se/Cs/Research/FormalMethods/MiniSat/cgi/MiniSat_v1.13_linux.cgi"; + executable = "minisat"; + good_exit = 10; + notime_run = (fun ex -> fun (infile,outfile) -> + (ex ^ " -r " ^ outfile ^" "^ infile ^ " > " ^ outfile ^".stats")); + time_run = (fun ex -> fun ((infile,outfile),time) -> + (ex ^ " " ^ infile ^ " " ^ (string_of_int time) ^ " > " ^ outfile)); + only_true = false; + failure_string = "UNSAT"; + start_string = "v"; + end_string = "0"} + +let minisatp = + {name = "minisatp"; + url = "http://www.cs.chalmers.se/Cs/Research/FormalMethods/MiniSat/cgi/MiniSat_v1.13_linux.cgi"; + executable = + (match (Sys.os_type) with + "Win32" | "Cygwin" -> "minisat.exe" + | _ -> "minisat"); + good_exit = 10; + notime_run = (fun ex -> fun (infile,outfile) -> + (ex ^ " -r " ^ outfile ^ " -p " ^ outfile ^ ".proof " ^ infile ^ " > " ^ outfile ^".stats")); + time_run = (fun ex -> fun ((infile,outfile),time) -> + (ex ^ " " ^ infile ^ " " ^ (string_of_int time) ^ " > " ^ outfile)); + only_true = false; + failure_string = "UNSAT"; + start_string = "SAT"; + end_string = "0"} diff --git a/Minisat/sat_tools.ml b/Minisat/sat_tools.ml new file mode 100644 index 0000000..8b1c258 --- /dev/null +++ b/Minisat/sat_tools.ml @@ -0,0 +1,177 @@ + +(*open dimacsTools;;*) + +(* Functions for parsing the DIMACS-compliant output of SAT solvers, + This is generic. Parser for minisat proof log is in minisatParse.ml *) + +(* +** Use Binaryset to encode mapping between HOL variable names +** and DIMACS variable numbers as a set of string*int pairs. +*) + +(* +** substringContains s ss +** tests whether substring ss contains string s +*) + +let substringContains s ss = + let re = Str.regexp_string s in + match + (try Str.search_forward re ss 0 with + Not_found -> -1) with + -1 -> false + | _ -> true + + +(* +** parseSat (s1,s2) ss +** returns a list of numbers corresponding to the tokenised +** substring of ss (tokenised wrt Char.isSpace) that starts immediately +** after the first occurrence of s1 and ends just before the first +** occurrence of s2 that is after the first occurrence of s1 +*) + +let parseSat (s1,s2) ss = + let p1 = Str.search_forward (Str.regexp s1) ss 0 in + let p2 = Str.search_backward (Str.regexp s2) ss (String.length ss) in + let ss1 = Str.string_before ss p2 in + let ss2 = Str.string_after ss1 (p1+String.length s1) in + let ssl = Str.split (Str.regexp "[ \n\t\r]") ss2 in + List.map int_of_string ssl + + +(* +** invokeSat solver t +** invokes solver on t and returns SOME s (where s is the satisfying instance +** as a string of integers) or NONE, if unsatisfiable +*) + +(* +** Reference containing last command used to invoke a SAT solver +*) + +let sat_command = ref "undef" + +(* +** Test for success of the result of Process.system +** N.B. isSuccess expected to primitive in next release of +** Moscow ML, and Process.status will lose eqtype status +*) + +let satdir = "";; + +(* if fname is NONE, then use a temp file, otherwise assume fname.cnf alredy exists*) +let invokeSat sat_solver fname t vc = + let {name=name; + url=url; + executable=executable; + good_exit=good_exit; + notime_run=notime_run; + time_run=time_run; + only_true=only_true; + failure_string=failure_string; + start_string=start_string; + end_string=end_string} = sat_solver in + let var_count = + match vc with + Some n -> n | + None -> List.length(variables t) in + let tmp = + match fname with + Some fnm -> + (initSatVarMap var_count; + ignore (termToDimacs t); (*FIXME: this regenerates sat_var_map: + better to save/load it*) + fnm) + | None -> termToDimacsFile None t var_count in + let infile = tmp ^ ".cnf" in + let outfile = tmp ^ "." ^ name in + let ex = Filename.concat satdir executable in + let run_cmd = notime_run ex (infile,outfile) in + let _ = (sat_command := run_cmd) in + let code = Sys.command run_cmd in + let _ = + if ((name = "minisat") or (name = "minisatp") or (code = good_exit)) + then () + else print_string("Warning:\n Failure signalled by\n " ^ run_cmd ^ "\n") in + let ins = Pervasives.open_in outfile in + let sat_res = input_all ins in + let _ = close_in ins in + let result = substringContains failure_string sat_res in + if result + then None + else + let model1 = parseSat(start_string,end_string) sat_res in + let model2 = + if only_true + then model1 + @ + (List.map + (fun n -> 0-n) + (subtract (List.map snd (snd(showSatVarMap()))) model1)) + else model1 in + Some (List.map intToLiteral model2) + + +(* +** satOracle sat_solver t +** invokes sat_solver on t and returns a theorem tagged by the solver name +** of the form |- (l1 /\ ... ln) ==> t (satisfied with literals l1,...,ln) +** or |- ~t (failure) +*) + +let satOracle sat_solver t = + let res = invokeSat sat_solver None t None in + match res with + Some l -> mk_thm ([], mk_imp(list_mk_conj l, t)) + | None -> mk_thm ([], mk_neg t) + +(* +** satProve sat_solver t +** invokes sat_solver on t and if a model is found then +** then it is verified using proof in HOL and a theorem +** |- (l1 /\ ... /\ ln) ==> t is returned +** (where l1,...,ln are the literals making up the model); +** Raises satProveError if no model is found. +** Raises satCheckError if the found model is bogus +*) + +(* +** satCheck [l1,...,ln] t +** attempts to prove (l1 /\ ... /\ ln) ==> t +** if it succeeds then the theorem is returned, else +** exception satCheckError is raised +*) + +let EQT_Imp1 = TAUT `!b. b ==> (b<=>T)` +let EQF_Imp1 = TAUT `!b. (~b) ==> (b<=>F)` +let EQT_Imp2 = TAUT `!b. (b<=>T) ==> b`;; + +exception Sat_check_error + +let satCheck model t = + try + let mtm = list_mk_conj model in + let th1 = ASSUME mtm in + let thl = List.map + (fun th -> + if is_neg(concl th) + then MP (SPEC (dest_neg(concl th)) EQF_Imp1) th + else MP (SPEC (concl th) EQT_Imp1) th) + (CONJUNCTS th1) in + let th3 = SUBS_CONV thl t in + let th4 = CONV_RULE(RAND_CONV(REWRITE_CONV[])) th3 in + let th5 = MP (SPEC t EQT_Imp2) th4 in + DISCH mtm th5 + with + Sys.Break -> raise Sys.Break + | _ -> raise Sat_check_error;; + +exception Sat_prove_error + +(* old interface by MJCG. assumes t is in cnf; only for finding SAT *) +let satProve sat_solver t = + match invokeSat sat_solver None t None with + Some model -> satCheck model t + | None -> raise Sat_prove_error + diff --git a/Minisat/taut.ml b/Minisat/taut.ml new file mode 100644 index 0000000..d4af58b --- /dev/null +++ b/Minisat/taut.ml @@ -0,0 +1,7792 @@ +(*--------------------------------------------------------------------------- + + Tautologies. The examples were originally collected by John + Harrison to exercise his implementation of Stalmarck's algorithm. + + Some of these can take a great deal of time and memory to complete. + + Modified by HA for testing on HolSatLib.SAT_PROVE + ---------------------------------------------------------------------------*) + +let syn323_1 = +`~((v0 \/ v1) /\ (~v0 \/ v1) /\ (~v1 \/ v0) /\ (~v0 \/ ~v1))`;; + +let syn029_1 = +`~((~v2 \/ ~v1) /\ v0 /\ (~v0 \/ ~v1 \/ v2) /\ (~v2 \/ v1) /\ (v1 \/ v2))`;; + +let syn052_1 = +`~((~v1 \/ v0) /\ (~v0 \/ v1) /\ (v1 \/ v0) /\ (~v1 \/ v1) /\ (~v0 \/ ~v1))`;; + +let syn051_1 = +`~((v1 \/ v0) /\ + (v1 \/ v2) /\ + (~v0 \/ ~v1) /\ + (~v2 \/ ~v1) /\ + (~v0 \/ v1) /\ + (~v1 \/ v2))`;; + +let syn044_1 = +`~((v0 \/ v1) /\ + (~v0 \/ ~v1) /\ + (~v0 \/ v1 \/ v2) /\ + (~v2 \/ v1) /\ + (~v2 \/ v0) /\ + (~v1 \/ v2))`;; + +let syn011_1 = +`~(v6 /\ + (~v0 \/ ~v2) /\ + (v0 \/ v1 \/ v5) /\ + (~v2 \/ ~v1) /\ + (~v4 \/ v2) /\ + (~v3 \/ v2) /\ + (v3 \/ v4 \/ v5) /\ + (~v5 \/ ~v6))`;; + +let syn032_1 = +`~((~v5 \/ ~v1) /\ + (~v4 \/ ~v0) /\ + (~v4 \/ v0) /\ + (~v5 \/ v1) /\ + (~v2 \/ v4 \/ v3) /\ + (v4 \/ v2 \/ v3) /\ + (~v3 \/ v4 \/ v5))`;; + +let ex2_be = + `~((a /\ b /\ ~c) \/ (~a /\ b /\ c /\ ~d)) + ==> + (s1 <=> (~a \/ d)) /\ (oh <=> (b /\ s1)) /\ (s2 <=> (~c \/ d)) ==> (oh <=> (b /\ s2))`;; + +let syn030_1 = +`~((~v4 \/ ~v0 \/ ~v1) /\ + (~v3 \/ ~v4 \/ v0) /\ + (~v1 \/ v0) /\ + (v0 \/ v1) /\ + (~v0 \/ v1) /\ + (~v1 \/ ~v0 \/ v2) /\ + (~v2 \/ v1) /\ + (~v1 \/ v3) /\ + (~v2 \/ ~v3 \/ v4))`;; + +let transp_be = + `(sub1x <=> ~(a \/ b)) /\ + (sub1y <=> ~(c \/ d)) /\ + (o2 <=> ~(sub1x \/ sub1y)) /\ + (o1 <=> (sub1x /\ sub1y)) + ==> (o1 <=> (~a /\ ~b /\ ~c /\ ~d)) /\ (o2 <=> ((a \/ b) /\ (c \/ d)))`;; + + +let syn054_1 = +`~((~v1 \/ ~v7) /\ + (~v2 \/ ~v0) /\ + (~v3 \/ v7 \/ v4) /\ + (~v6 \/ v0 \/ v5) /\ + (~v7 \/ v1) /\ + (~v0 \/ v2) /\ + (~v4 \/ v1) /\ + (~v5 \/ v2) /\ + (~v3 \/ ~v4) /\ + (~v6 \/ ~v5) /\ + (v6 \/ v7))`;; + +let gra001_1 = +`~((~v1 \/ v0) /\ + (~v0 \/ v1) /\ + (~v4 \/ ~v2 \/ ~v0) /\ + (~v4 \/ v2 \/ v0) /\ + (~v2 \/ v4 \/ v0) /\ + (~v0 \/ v4 \/ v2) /\ + (~v3 \/ ~v2 \/ ~v1) /\ + (~v3 \/ v2 \/ v1) /\ + (~v2 \/ v3 \/ v1) /\ + (~v1 \/ v3 \/ v2) /\ + (~v3 \/ ~v4) /\ + (v3 \/ v4))` ;; + +let syn321_1 = +`~((~v0 \/ v9) /\ + (~v0 \/ v6) /\ + (~v0 \/ v7) /\ + (~v8 \/ v9) /\ + (~v8 \/ v6) /\ + (~v8 \/ v7) /\ + (~v1 \/ v9) /\ + (~v1 \/ v6) /\ + (~v1 \/ v7) /\ + (~v2 \/ v3) /\ + (~v4 \/ v5) /\ + (~v7 \/ v8) /\ + (v8 \/ v9) /\ + (v8 \/ v6) /\ + (v8 \/ v7) /\ + (~v8 \/ ~v9))` ;; + +let rip02_be = + `(car1 <=> (a1 /\ b1)) /\ + (cout <=> ((a2 \/ b2) /\ car1 \/ a2 /\ b2)) /\ + (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ + (som1 <=> ~(a1 <=> b1)) /\ + (cout1 <=> (b1 /\ a1)) + ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ + (som2 <=> + ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ + cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ + (cout <=> (a2 /\ cout1 \/ b2 /\ cout1 \/ a2 /\ b2))`;; + +let puz014_1 = +`~(v3 /\ + v0 /\ + v10 /\ + (v4 \/ v5) /\ + (v9 \/ v2) /\ + (v8 \/ v1) /\ + (v7 \/ v0) /\ + (v3 \/ v12) /\ + (v11 \/ v10) /\ + (~v12 \/ ~v6 \/ v7) /\ + (~v10 \/ ~v3 \/ v1) /\ + (~v10 \/ ~v0 \/ ~v4 \/ v11) /\ + (~v5 \/ ~v2 \/ ~v8) /\ + (~v12 \/ ~v9 \/ ~v7) /\ + (~v0 \/ ~v1 \/ v4) /\ + (~v4 \/ v7 \/ v2) /\ + (~v12 \/ ~v3 \/ v8) /\ + (~v4 \/ v5 \/ v6) /\ + (~v7 \/ ~v8 \/ v9) /\ + (~v10 \/ ~v11 \/ v12))` ;; + +let mjcg_yes = +`((adder1____carry__1__1 <=> ~a__0 /\ b__0) /\ + (adder1____carry__1__2 <=> + b__1 /\ adder1____carry__1__1 \/ + ~a__1 /\ ~(b__1 <=> adder1____carry__1__1)) /\ + (adder1____carry__2__1 <=> a__0 /\ b__0) /\ + (adder1____carry__2__2 <=> + b__1 /\ adder1____carry__2__1 \/ + a__1 /\ ~(b__1 <=> adder1____carry__2__1))) /\ + (adder2____carry__1__1 <=> cnt__0 /\ a__0) /\ + (adder2____carry__1__2 <=> a__1 /\ adder2____carry__1__1) /\ + (adder2____carry__1__3 <=> a__2 /\ adder2____carry__1__2) /\ + (adder2____carry__2__1 <=> ~(cnt__0 <=> a__0) /\ ~(cnt__0 <=> b__0)) /\ + (adder2____carry__2__2 <=> + ~(cnt__0 <=> b__1) /\ adder2____carry__2__1 \/ + ~(a__1 <=> adder2____carry__1__1) /\ + ~(~(cnt__0 <=> b__1) <=> adder2____carry__2__1)) /\ + (adder2____carry__2__3 <=> + ~(cnt__0 <=> b__2) /\ adder2____carry__2__2 \/ + ~(a__2 <=> adder2____carry__1__2) /\ + ~(~(cnt__0 <=> b__2) <=> adder2____carry__2__2)) ==> + ((out__2 <=> + ~(~(a__2 <=> b__2) <=> adder1____carry__1__2) /\ cnt__0 \/ + ~(~(a__2 <=> b__2) <=> adder1____carry__2__2) /\ ~cnt__0) /\ + (out__1 <=> + ~(~(a__1 <=> b__1) <=> adder1____carry__1__1) /\ cnt__0 \/ + ~(~(a__1 <=> b__1) <=> adder1____carry__2__1) /\ ~cnt__0) /\ + (out__0 <=> ~(a__0 <=> b__0) /\ cnt__0 \/ ~(a__0 <=> b__0) /\ ~cnt__0) <=> + (out__2 <=> + ~(~(~(a__2 <=> adder2____carry__1__2) <=> ~(cnt__0 <=> b__2)) <=> + adder2____carry__2__2)) /\ + (out__1 <=> + ~(~(~(a__1 <=> adder2____carry__1__1) <=> ~(cnt__0 <=> b__1)) <=> + adder2____carry__2__1)) /\ + (out__0 <=> ~(~(cnt__0 <=> a__0) <=> ~(cnt__0 <=> b__0))))`;; + +let mul03_be = + `(p_00_00 <=> (x1 /\ y1)) /\ + (p_00_01 <=> (x1 /\ y2)) /\ + (p_00_02 <=> (x1 /\ y3)) /\ + (p_01_00 <=> (x2 /\ y1)) /\ + (p_01_01 <=> (x2 /\ y2)) /\ + (p_01_02 <=> (x2 /\ y3)) /\ + (p_02_00 <=> (x3 /\ y1)) /\ + (p_02_01 <=> (x3 /\ y2)) /\ + (p_02_02 <=> (x3 /\ y3)) /\ + (s_01_01 <=> ~(p_01_02 <=> p_02_01)) /\ + (c_01_01 <=> (p_01_02 /\ p_02_01)) /\ + (s_01_02 <=> ~(p_00_02 <=> p_02_00)) /\ + (c_01_02 <=> (p_00_02 /\ p_02_00)) /\ + (s_02_01 <=> ~(c_01_01 <=> ~(s_01_02 <=> p_01_01))) /\ + (s_02_02 <=> ~(c_01_02 <=> ~(p_01_00 <=> p_00_01))) /\ + (c_02_01 <=> (c_01_01 /\ s_01_02 \/ c_01_01 /\ p_01_01 \/ s_01_02 /\ p_01_01)) /\ + (c_02_02 <=> (c_01_02 /\ p_01_00 \/ c_01_02 /\ p_00_01 \/ p_01_00 /\ p_00_01)) /\ + (s_03_01 <=> ~(c_02_01 <=> s_02_02)) /\ + (c_03_01 <=> c_02_01 /\ s_02_02) /\ + (s_03_02 <=> ~(c_02_02 <=> ~(p_00_00 <=> c_03_01))) /\ + (c_03_02 <=> c_02_02 /\ p_00_00 \/ c_02_02 /\ c_03_01 \/ p_00_00 /\ c_03_01) /\ + (z05 <=> p_02_02) /\ + (z04 <=> s_01_01) /\ + (z03 <=> s_02_01) /\ + (z02 <=> s_03_01) /\ + (z01 <=> s_03_02) /\ + (z00 <=> c_03_02) /\ + (p_00_00' <=> y1 /\ x1) /\ + (p_00_01' <=> y1 /\ x2) /\ + (p_00_02' <=> y1 /\ x3) /\ + (p_01_00' <=> y2 /\ x1) /\ + (p_01_01' <=> y2 /\ x2) /\ + (p_01_02' <=> y2 /\ x3) /\ + (p_02_00' <=> y3 /\ x1) /\ + (p_02_01' <=> y3 /\ x2) /\ + (p_02_02' <=> y3 /\ x3) /\ + (s_01_01' <=> ~(p_01_02' <=> p_02_01')) /\ + (c_01_01' <=> p_01_02' /\ p_02_01') /\ + (s_01_02' <=> ~(p_00_02' <=> p_02_00')) /\ + (c_01_02' <=> p_00_02' /\ p_02_00') /\ + (s_02_01' <=> ~(c_01_01' <=> ~(s_01_02' <=> p_01_01'))) /\ + (s_02_02' <=> ~(c_01_02' <=> ~(p_01_00' <=> p_00_01'))) /\ + (c_02_01' <=> + c_01_01' /\ s_01_02' \/ c_01_01' /\ p_01_01' \/ s_01_02' /\ p_01_01') /\ + (c_02_02' <=> + c_01_02' /\ p_01_00' \/ c_01_02' /\ p_00_01' \/ p_01_00' /\ p_00_01') /\ + (s_03_01' <=> ~(c_02_01' <=> s_02_02')) /\ + (c_03_01' <=> c_02_01' /\ s_02_02') /\ + (s_03_02' <=> ~(c_02_02' <=> ~(p_00_00' <=> c_03_01'))) /\ + (c_03_02' <=> + c_02_02' /\ p_00_00' \/ c_02_02' /\ c_03_01' \/ p_00_00' /\ c_03_01') + ==> (z00 <=> c_03_02') /\ + (z01 <=> s_03_02') /\ + (z02 <=> s_03_01') /\ + (z03 <=> s_02_01') /\ + (z04 <=> s_01_01') /\ + (z05 <=> p_02_02')` ;; + +let puz030_2 = +`~((~v8 \/ ~v5 \/ ~v7 \/ ~v9 \/ v6 \/ v2 \/ v3 \/ v0 \/ v1 \/ v4) /\ + (v0 \/ v1 \/ v8) /\ + (v7 \/ v4 \/ v2) /\ + (v5 \/ v8 \/ v0) /\ + (v6 \/ v9 \/ v1) /\ + (v7 \/ v4 \/ v1) /\ + (v2 \/ v3 \/ v9) /\ + (v7 \/ v4 \/ v9) /\ + (~v5 \/ ~v3 \/ ~v2 \/ v6 \/ v9) /\ + (~v5 \/ ~v3 \/ ~v2 \/ ~v9 \/ ~v6) /\ + (~v6 \/ ~v1 \/ ~v0 \/ v5 \/ v8) /\ + (~v6 \/ ~v8 \/ ~v5 \/ v0 \/ v1) /\ + (~v6 \/ ~v8 \/ ~v5 \/ ~v1 \/ ~v0) /\ + (~v4 \/ v2 \/ v3 \/ v0 \/ v1) /\ + (~v4 \/ ~v3 \/ ~v2 \/ ~v1 \/ ~v0) /\ + (~v2 \/ ~v7 \/ v5 \/ v8) /\ + (~v2 \/ ~v4 \/ v5 \/ v8) /\ + (~v2 \/ ~v8 \/ ~v5 \/ ~v7) /\ + (~v2 \/ ~v8 \/ ~v5 \/ ~v4) /\ + (~v2 \/ v3 \/ v5) /\ + (~v3 \/ v2 \/ v5) /\ + (~v6 \/ v9 \/ v5) /\ + (~v9 \/ v6 \/ v5) /\ + (~v7 \/ ~v4 \/ v8) /\ + (~v5 \/ v8 \/ v2) /\ + (~v8 \/ v5 \/ v2) /\ + (~v0 \/ ~v1 \/ v3) /\ + (~v6 \/ ~v9 \/ v3) /\ + (~v2 \/ ~v3 \/ v0) /\ + (~v5 \/ v8 \/ v6) /\ + (~v8 \/ v5 \/ v6) /\ + (~v0 \/ v1 \/ v6) /\ + (~v1 \/ v0 \/ v6) /\ + (~v5 \/ ~v8 \/ v7) /\ + (~v6 \/ ~v9 \/ v7) /\ + (~v2 \/ v3 \/ v4) /\ + (~v3 \/ v2 \/ v4) /\ + (~v0 \/ v1 \/ v4) /\ + (~v1 \/ v0 \/ v4) /\ + (~v8 \/ ~v0 \/ v7) /\ + (~v8 \/ ~v0 \/ v4) /\ + (~v8 \/ ~v1 \/ v7) /\ + (~v8 \/ ~v1 \/ v4) /\ + (~v3 \/ v0 \/ v6) /\ + (~v3 \/ v0 \/ v9) /\ + (~v3 \/ v1 \/ v6) /\ + (~v3 \/ v1 \/ v9) /\ + (~v0 \/ ~v5 \/ v2) /\ + (~v0 \/ ~v5 \/ v3) /\ + (~v0 \/ ~v8 \/ v2) /\ + (~v0 \/ ~v8 \/ v3) /\ + (~v1 \/ ~v6 \/ ~v7) /\ + (~v1 \/ ~v6 \/ ~v4) /\ + (~v1 \/ ~v9 \/ ~v7) /\ + (~v1 \/ ~v9 \/ ~v4) /\ + (~v9 \/ ~v2 \/ ~v7) /\ + (~v9 \/ ~v2 \/ ~v4) /\ + (~v9 \/ ~v3 \/ ~v7) /\ + (~v9 \/ ~v3 \/ ~v4) /\ + (~v7 \/ v5 \/ v6) /\ + (~v7 \/ v5 \/ v9) /\ + (~v7 \/ v8 \/ v6) /\ + (~v7 \/ v8 \/ v9))` ;; + + +let puz030_1 = +`~((~v21 \/ v2) /\ + (~v14 \/ v10) /\ + (~v15 \/ v6) /\ + (~v12 \/ v16) /\ + (~v3 \/ v22) /\ + (~v21 \/ v1) /\ + (~v14 \/ v8) /\ + (~v15 \/ v4) /\ + (~v12 \/ v13) /\ + (~v3 \/ v19) /\ + (~v2 \/ ~v1 \/ v21) /\ + (~v10 \/ ~v8 \/ v14) /\ + (~v6 \/ ~v4 \/ v15) /\ + (~v16 \/ ~v13 \/ v12) /\ + (~v22 \/ ~v19 \/ v3) /\ + (~v0 \/ v2 \/ v1) /\ + (~v7 \/ v10 \/ v8) /\ + (~v24 \/ v6 \/ v4) /\ + (~v23 \/ v16 \/ v13) /\ + (~v17 \/ v22 \/ v19) /\ + (~v0 \/ ~v21) /\ + (~v7 \/ ~v14) /\ + (~v24 \/ ~v15) /\ + (~v23 \/ ~v12) /\ + (~v17 \/ ~v3) /\ + (~v0 \/ ~v18) /\ + (~v7 \/ ~v20) /\ + (~v24 \/ ~v9) /\ + (~v23 \/ ~v5) /\ + (~v17 \/ ~v11) /\ + (v21 \/ v18 \/ v0) /\ + (v14 \/ v20 \/ v7) /\ + (v15 \/ v9 \/ v24) /\ + (v12 \/ v5 \/ v23) /\ + (v3 \/ v11 \/ v17) /\ + (~v0 \/ ~v2 \/ ~v1) /\ + (~v7 \/ ~v10 \/ ~v8) /\ + (~v24 \/ ~v6 \/ ~v4) /\ + (~v23 \/ ~v16 \/ ~v13) /\ + (~v17 \/ ~v22 \/ ~v19) /\ + (~v21 \/ ~v18) /\ + (~v14 \/ ~v20) /\ + (~v15 \/ ~v9) /\ + (~v12 \/ ~v5) /\ + (~v3 \/ ~v11) /\ + (~v18 \/ ~v2) /\ + (~v20 \/ ~v10) /\ + (~v9 \/ ~v6) /\ + (~v5 \/ ~v16) /\ + (~v11 \/ ~v22) /\ + (~v18 \/ ~v1) /\ + (~v20 \/ ~v8) /\ + (~v9 \/ ~v4) /\ + (~v5 \/ ~v13) /\ + (~v11 \/ ~v19) /\ + (v2 \/ v1 \/ v18) /\ + (v10 \/ v8 \/ v20) /\ + (v6 \/ v4 \/ v9) /\ + (v16 \/ v13 \/ v5) /\ + (v22 \/ v19 \/ v11) /\ + (~v5 \/ ~v20 \/ ~v3 \/ ~v24 \/ ~v2 \/ ~v4 \/ ~v0) /\ + (~v7 \/ v1) /\ + (~v23 \/ v1) /\ + (~v1 \/ v23 \/ v7) /\ + (~v15 \/ v1) /\ + (~v3 \/ v2) /\ + (~v2 \/ v3 \/ v15) /\ + (~v18 \/ v4) /\ + (~v5 \/ v4) /\ + (~v4 \/ v5 \/ v18) /\ + (~v7 \/ v6) /\ + (~v17 \/ v6) /\ + (~v6 \/ v17 \/ v7) /\ + (~v18 \/ v8) /\ + (~v9 \/ v8) /\ + (~v8 \/ v9 \/ v18) /\ + (~v12 \/ v10) /\ + (~v11 \/ v10) /\ + (~v10 \/ v11 \/ v12) /\ + (~v15 \/ v13) /\ + (~v14 \/ v13) /\ + (~v13 \/ v14 \/ v15) /\ + (~v18 \/ v16) /\ + (~v17 \/ v16) /\ + (~v16 \/ v17 \/ v18) /\ + (~v21 \/ v19) /\ + (~v20 \/ v19) /\ + (~v19 \/ v20 \/ v21) /\ + (~v24 \/ v22) /\ + (~v23 \/ v22) /\ + (~v22 \/ v23 \/ v24))` ;; + + +let dk27_be = + `(ge2 <=> ~in4 /\ ~in3 /\ ~in2 /\ ~in0) /\ + (ge7 <=> ge2 /\ ~in1) /\ + (ge0 <=> ~in6 /\ ~in5 /\ ~in1 /\ ~in0) /\ + (ge4 <=> in8 /\ ~in7 /\ ~in5) /\ + (ge11 <=> ge7 /\ in6) /\ + (ge20 <=> ~in3 /\ ~in2 /\ ~in1 /\ in0) /\ + (ge21 <=> ~in6 /\ ~in4) /\ + (ge1 <=> ~in8 /\ in7 \/ in8 /\ ~in7) /\ + (ge8 <=> ge0 /\ ~in3) /\ + (ge9 <=> ge0 /\ ~in4 /\ in3 /\ ~in2) /\ + (ge10 <=> in8 /\ ~in7) /\ + (ge16 <=> ge11 /\ ge4) /\ + (ge5 <=> ge21 /\ ge20) /\ + (ge6 <=> ~in8 /\ in7 /\ ~in5) /\ + (ge14 <=> ge8 /\ ge1) /\ + (ge19 <=> ge10 /\ ge9 \/ ge16) /\ + (ge12 <=> ge7 /\ ~in6 /\ in5) /\ + (ge13 <=> ge2 /\ ~in6 /\ in1) /\ + (ge17 <=> ~in8 /\ in7) /\ + (ge18 <=> ge16 \/ ge6 /\ ge5) /\ + (ge15 <=> ge8 /\ in4 /\ ~in2 \/ ge8 /\ ~in4 /\ in2) /\ + (out0 <=> ge17 /\ ge15) /\ + (out1 <=> ge15 /\ ge10) /\ + (out2 <=> ge9 /\ ge1 \/ ge18) /\ + (out3 <=> ge5 /\ ge4) /\ + (out4 <=> ge11 /\ ge6 \/ ge13 /\ ge6 \/ ge17 /\ ge12) /\ + (out5 <=> ge13 /\ ge4) /\ + (out6 <=> ge12 /\ ge10) /\ + (out7 <=> ge14 /\ in4 /\ ~in2 \/ ge19) /\ + (out8 <=> ge14 /\ ~in4 /\ in2) /\ + (wres2 <=> ~in4 /\ ~in3 /\ ~in2 /\ ~in0) /\ + (wres0 <=> ~in6 /\ ~in5 /\ ~in1 /\ ~in0) /\ + (wres7 <=> wres2 /\ ~in1) /\ + (wres1 <=> ~in8 /\ in7 \/ in8 /\ ~in7) /\ + (wres8 <=> wres0 /\ ~in3) /\ + (wres4 <=> in8 /\ ~in7 /\ ~in5) /\ + (wres11 <=> wres7 /\ in6) /\ + (wres14 <=> wres8 /\ wres1) /\ + (wres9 <=> wres0 /\ ~in4 /\ in3 /\ ~in2) /\ + (wres10 <=> in8 /\ ~in7) /\ + (wres16 <=> wres11 /\ wres4) /\ + (wres12 <=> wres7 /\ ~in6 /\ in5) /\ + (wres13 <=> wres2 /\ ~in6 /\ in1) /\ + (wres6 <=> ~in8 /\ in7 /\ ~in5) /\ + (wres17 <=> ~in8 /\ in7) /\ + (wres5 <=> ~in6 /\ ~in4 /\ ~in3 /\ ~in2 /\ ~in1 /\ in0) /\ + (wres15 <=> wres8 /\ in4 /\ ~in2 \/ wres8 /\ ~in4 /\ in2) + ==> (out8 <=> wres14 /\ ~in4 /\ in2) /\ + (out7 <=> wres10 /\ wres9 \/ wres14 /\ in4 /\ ~in2 \/ wres16) /\ + (out6 <=> wres12 /\ wres10) /\ + (out5 <=> wres13 /\ wres4) /\ + (out4 <=> wres11 /\ wres6 \/ wres13 /\ wres6 \/ wres17 /\ wres12) /\ + (out3 <=> wres5 /\ wres4) /\ + (out2 <=> wres9 /\ wres1 \/ wres6 /\ wres5 \/ wres16) /\ + (out1 <=> wres15 /\ wres10) /\ + (out0 <=> wres17 /\ wres15)` ;; + +let syn071_1 = +`~(v8 /\ + v3 /\ + v1 /\ + v0 /\ + (~v9 \/ v11) /\ + (~v5 \/ v12) /\ + (~v2 \/ v14) /\ + (~v0 \/ v0) /\ + (~v7 \/ v13) /\ + (~v4 \/ v10) /\ + (~v1 \/ v1) /\ + (~v14 \/ v2) /\ + (~v6 \/ v15) /\ + (~v3 \/ v3) /\ + (~v10 \/ v4) /\ + (~v12 \/ v5) /\ + (~v8 \/ v8) /\ + (~v15 \/ v6) /\ + (~v13 \/ v7) /\ + (~v11 \/ v9) /\ + (~v0 \/ ~v11 \/ v11) /\ + (~v0 \/ ~v12 \/ v12) /\ + (~v0 \/ ~v14 \/ v14) /\ + (~v0 \/ ~v0 \/ v0) /\ + (~v2 \/ ~v11 \/ v13) /\ + (~v2 \/ ~v12 \/ v10) /\ + (~v2 \/ ~v14 \/ v1) /\ + (~v2 \/ ~v0 \/ v2) /\ + (~v5 \/ ~v11 \/ v15) /\ + (~v5 \/ ~v12 \/ v3) /\ + (~v5 \/ ~v14 \/ v4) /\ + (~v5 \/ ~v0 \/ v5) /\ + (~v9 \/ ~v11 \/ v8) /\ + (~v9 \/ ~v12 \/ v6) /\ + (~v9 \/ ~v14 \/ v7) /\ + (~v9 \/ ~v0 \/ v9) /\ + (~v14 \/ ~v13 \/ v11) /\ + (~v14 \/ ~v10 \/ v12) /\ + (~v14 \/ ~v1 \/ v14) /\ + (~v14 \/ ~v2 \/ v0) /\ + (~v1 \/ ~v13 \/ v13) /\ + (~v1 \/ ~v10 \/ v10) /\ + (~v1 \/ ~v1 \/ v1) /\ + (~v1 \/ ~v2 \/ v2) /\ + (~v4 \/ ~v13 \/ v15) /\ + (~v4 \/ ~v10 \/ v3) /\ + (~v4 \/ ~v1 \/ v4) /\ + (~v4 \/ ~v2 \/ v5) /\ + (~v7 \/ ~v13 \/ v8) /\ + (~v7 \/ ~v10 \/ v6) /\ + (~v7 \/ ~v1 \/ v7) /\ + (~v7 \/ ~v2 \/ v9) /\ + (~v12 \/ ~v15 \/ v11) /\ + (~v12 \/ ~v3 \/ v12) /\ + (~v12 \/ ~v4 \/ v14) /\ + (~v12 \/ ~v5 \/ v0) /\ + (~v10 \/ ~v15 \/ v13) /\ + (~v10 \/ ~v3 \/ v10) /\ + (~v10 \/ ~v4 \/ v1) /\ + (~v10 \/ ~v5 \/ v2) /\ + (~v3 \/ ~v15 \/ v15) /\ + (~v3 \/ ~v3 \/ v3) /\ + (~v3 \/ ~v4 \/ v4) /\ + (~v3 \/ ~v5 \/ v5) /\ + (~v6 \/ ~v15 \/ v8) /\ + (~v6 \/ ~v3 \/ v6) /\ + (~v6 \/ ~v4 \/ v7) /\ + (~v6 \/ ~v5 \/ v9) /\ + (~v11 \/ ~v8 \/ v11) /\ + (~v11 \/ ~v6 \/ v12) /\ + (~v11 \/ ~v7 \/ v14) /\ + (~v11 \/ ~v9 \/ v0) /\ + (~v13 \/ ~v8 \/ v13) /\ + (~v13 \/ ~v6 \/ v10) /\ + (~v13 \/ ~v7 \/ v1) /\ + (~v13 \/ ~v9 \/ v2) /\ + (~v15 \/ ~v8 \/ v15) /\ + (~v15 \/ ~v6 \/ v3) /\ + (~v15 \/ ~v7 \/ v4) /\ + (~v15 \/ ~v9 \/ v5) /\ + (~v8 \/ ~v8 \/ v8) /\ + (~v8 \/ ~v6 \/ v6) /\ + (~v8 \/ ~v7 \/ v7) /\ + (~v8 \/ ~v9 \/ v9) /\ + ~v10 /\ + ~v11 /\ + (v12 \/ v13) /\ + (v14 \/ v15))` ;; + +(* Hard : takes buddy17 73 secs. on sole *) +let aim_50_1_6_no_3 = +`~ +((v15 \/ v20 \/ v41) /\ + (~v15 \/ v20 \/ v41) /\ + (v7 \/ v8 \/ ~v41) /\ + (v7 \/ ~v8 \/ ~v41) /\ + (~v7 \/ v42 \/ v50) /\ + (~v7 \/ ~v42 \/ v50) /\ + (v22 \/ v35 \/ ~v50) /\ + (v22 \/ ~v35 \/ v45) /\ + (v18 \/ ~v22 \/ v45) /\ + (~v18 \/ ~v22 \/ v45) /\ + (v33 \/ ~v45 \/ ~v50) /\ + (~v7 \/ ~v33 \/ ~v50) /\ + (v19 \/ ~v20 \/ v21) /\ + (~v20 \/ v21 \/ ~v41) /\ + (v19 \/ ~v20 \/ ~v21) /\ + (v1 \/ v14 \/ v36) /\ + (~v1 \/ v14 \/ v36) /\ + (v13 \/ ~v14 \/ v36) /\ + (v3 \/ v13 \/ ~v36) /\ + (~v3 \/ v5 \/ ~v36) /\ + (~v3 \/ ~v5 \/ v13) /\ + (v4 \/ v44 \/ v49) /\ + (~v4 \/ v17 \/ v49) /\ + (~v4 \/ ~v17 \/ v44) /\ + (~v13 \/ v31 \/ ~v44) /\ + (~v13 \/ ~v31 \/ ~v44) /\ + (v23 \/ v33 \/ ~v49) /\ + (v23 \/ ~v33 \/ ~v49) /\ + (~v19 \/ v37 \/ v42) /\ + (~v19 \/ v37 \/ ~v42) /\ + (~v23 \/ v29 \/ ~v37) /\ + (~v23 \/ ~v29 \/ ~v37) /\ + (~v24 \/ ~v26 \/ v32) /\ + (v2 \/ ~v12 \/ ~v31) /\ + (v17 \/ v28 \/ v40) /\ + (~v15 \/ ~v17 \/ v40) /\ + (v2 \/ v28 \/ v47) /\ + (v26 \/ ~v28 \/ ~v39) /\ + (v21 \/ ~v26 \/ ~v28) /\ + (v16 \/ v24 \/ v29) /\ + (v12 \/ ~v34 \/ ~v39) /\ + (v10 \/ v31 \/ v40) /\ + (~v6 \/ ~v32 \/ v35) /\ + (v16 \/ ~v24 \/ v34) /\ + (~v24 \/ ~v31 \/ v38) /\ + (~v16 \/ ~v24 \/ ~v38) /\ + (~v2 \/ ~v10 \/ ~v47) /\ + (v4 \/ ~v16 \/ v27) /\ + (~v1 \/ v24 \/ ~v30) /\ + (~v18 \/ v26 \/ ~v46) /\ + (v27 \/ v30 \/ ~v45) /\ + (v4 \/ ~v14 \/ ~v44) /\ + (~v29 \/ v43 \/ v47) /\ + (~v8 \/ ~v10 \/ ~v46) /\ + (~v11 \/ v39 \/ ~v43) /\ + (~v11 \/ ~v40 \/ ~v43) /\ + (v6 \/ ~v21 \/ v26) /\ + (v8 \/ ~v25 \/ v46) /\ + (~v25 \/ ~v38 \/ v46) /\ + (v10 \/ ~v46 \/ ~v47) /\ + (v25 \/ ~v32 \/ ~v40) /\ + (v5 \/ v6 \/ ~v40) /\ + (v11 \/ v15 \/ v16) /\ + (v12 \/ v39 \/ v43) /\ + (v5 \/ v11 \/ v32) /\ + (~v5 \/ v17 \/ v32) /\ + (~v12 \/ ~v40 \/ ~v48) /\ + (~v2 \/ v18 \/ ~v30) /\ + (v3 \/ v10 \/ ~v34) /\ + (~v2 \/ ~v9 \/ v30) /\ + (~v3 \/ ~v5 \/ ~v28) /\ + (~v9 \/ v26 \/ v48) /\ + (v22 \/ ~v27 \/ ~v48) /\ + (v1 \/ v9 \/ v38) /\ + (v3 \/ ~v6 \/ v48) /\ + (v1 \/ ~v6 \/ v34) /\ + (v15 \/ ~v35 \/ v48) /\ + (v15 \/ v26 \/ ~v27) /\ + (~v9 \/ ~v9 \/ ~v27) /\ + (v1 \/ v9 \/ v25))` ;; + +(* Harder: runtime: 526.970s, gctime: 21.640s, systime: 0.650s. *) + +let aim_50_1_6_no_4 = +`~ +((v1 \/ v32 \/ v34) /\ + (v4 \/ v5 \/ v32) /\ + (~v4 \/ v5 \/ ~v34) /\ + (~v5 \/ v32 \/ ~v34) /\ + (v29 \/ ~v32 \/ v43) /\ + (v29 \/ v36 \/ ~v43) /\ + (v29 \/ ~v32 \/ ~v36) /\ + (v1 \/ v3 \/ ~v29) /\ + (~v3 \/ ~v29 \/ ~v32) /\ + (~v1 \/ v24 \/ v39) /\ + (~v1 \/ v24 \/ ~v39) /\ + (v7 \/ v18 \/ ~v24) /\ + (~v7 \/ v18 \/ v28) /\ + (~v7 \/ ~v21 \/ v28) /\ + (~v7 \/ v17 \/ ~v28) /\ + (v18 \/ ~v24 \/ ~v28) /\ + (v2 \/ v17 \/ v40) /\ + (~v17 \/ ~v18 \/ v40) /\ + (v2 \/ v39 \/ ~v40) /\ + (v2 \/ ~v39 \/ ~v40) /\ + (~v2 \/ ~v18 \/ v35) /\ + (~v2 \/ ~v18 \/ ~v35) /\ + (v9 \/ ~v32 \/ v41) /\ + (~v9 \/ v41 \/ v45) /\ + (~v1 \/ ~v9 \/ ~v45) /\ + (~v5 \/ v27 \/ v43) /\ + (v14 \/ v16 \/ v26) /\ + (v14 \/ ~v16 \/ v49) /\ + (v12 \/ ~v14 \/ v26) /\ + (~v12 \/ v26 \/ v35) /\ + (v26 \/ v30 \/ ~v35) /\ + (~v26 \/ v30 \/ v49) /\ + (v9 \/ v13 \/ v25) /\ + (v5 \/ ~v17 \/ v25) /\ + (v15 \/ v30 \/ v47) /\ + (~v20 \/ v27 \/ ~v49) /\ + (v13 \/ ~v20 \/ ~v27) /\ + (~v13 \/ ~v30 \/ ~v49) /\ + (v3 \/ v8 \/ v37) /\ + (v8 \/ v23 \/ ~v43) /\ + (v10 \/ v19 \/ v22) /\ + (v10 \/ ~v19 \/ v22) /\ + (~v10 \/ ~v19 \/ v36) /\ + (v4 \/ v21 \/ v38) /\ + (~v4 \/ v38 \/ v46) /\ + (v21 \/ ~v38 \/ ~v47) /\ + (~v21 \/ v45 \/ v46) /\ + (~v14 \/ ~v33 \/ ~v38) /\ + (~v10 \/ v11 \/ ~v26) /\ + (~v14 \/ v16 \/ ~v50) /\ + (~v14 \/ ~v16 \/ ~v23) /\ + (~v2 \/ ~v23 \/ ~v50) /\ + (v12 \/ ~v47 \/ v50) /\ + (v7 \/ v10 \/ v48) /\ + (~v6 \/ ~v13 \/ ~v41) /\ + (v11 \/ ~v41 \/ ~v48) /\ + (v23 \/ ~v41 \/ ~v48) /\ + (~v15 \/ v42 \/ v48) /\ + (~v15 \/ ~v21 \/ ~v42) /\ + (v11 \/ v34 \/ v44) /\ + (~v27 \/ ~v34 \/ ~v46) /\ + (v19 \/ v28 \/ v50) /\ + (~v3 \/ v6 \/ ~v35) /\ + (~v22 \/ ~v40 \/ ~v44) /\ + (~v25 \/ ~v37 \/ ~v42) /\ + (~v26 \/ ~v30 \/ ~v37) /\ + (v6 \/ ~v31 \/ v42) /\ + (v6 \/ ~v31 \/ ~v33) /\ + (~v44 \/ ~v45 \/ v47) /\ + (v4 \/ v20 \/ v47) /\ + (~v6 \/ v44 \/ ~v46) /\ + (~v11 \/ v12 \/ v20) /\ + (~v8 \/ v10 \/ v28) /\ + (~v22 \/ v31 \/ ~v36) /\ + (v7 \/ ~v25 \/ v37) /\ + (~v11 \/ v31 \/ v47) /\ + (~v4 \/ v10 \/ ~v12) /\ + (~v30 \/ ~v31 \/ v44) /\ + (v7 \/ v15 \/ v33) /\ + (~v8 \/ ~v11 \/ v33))` ;; + +let hostint1_be = + `(wnpls <=> + ~eos /\ ~s1 /\ ~s2 \/ + eof /\ eos /\ s1 /\ ~s2 \/ + eof /\ eos /\ ~mof /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2 \/ + ~eos /\ s1 /\ s2 \/ + eof /\ eos /\ mof /\ s1 /\ s2 \/ + ~eof /\ eos /\ ~mof /\ s1 /\ s2) /\ + (rnp <=> + ~eos /\ s1 /\ ~s2 \/ + ~eof /\ eos /\ s1 /\ ~s2 \/ + ~eof /\ eos /\ mof /\ s1 /\ s2) /\ + (wnp <=> + eos /\ ~s1 /\ s2 \/ + ~eos /\ s1 /\ s2 \/ + eof /\ eos /\ mof /\ s1 /\ s2 \/ + ~eof /\ eos /\ ~mof /\ s1 /\ s2) /\ + (fs <=> ~eos /\ ~s1 /\ s2 \/ eos /\ ~s1 /\ ~s2) /\ + (ls <=> + ~eos /\ ~s1 /\ ~s2 \/ + eof /\ eos /\ s1 /\ ~s2 \/ + eof /\ eos /\ ~mof /\ s1 /\ s2) /\ + (s1 <=> + ~eof /\ eos /\ mof /\ s1 /\ s2 \/ + ~eos /\ s1 /\ ~s2 \/ + ~eof /\ eos /\ s1 /\ ~s2 \/ + ~eos /\ s1 /\ s2 \/ + eof /\ eos /\ mof /\ s1 /\ s2 \/ + ~eof /\ eos /\ ~mof /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2) /\ + (s2 <=> + ~eos /\ s1 /\ s2 \/ + eof /\ eos /\ mof /\ s1 /\ s2 \/ + ~eof /\ eos /\ ~mof /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2 \/ + ~eos /\ ~s1 /\ s2 \/ + eos /\ ~s1 /\ ~s2) + ==> (s2 <=> + eof /\ mof /\ s1 /\ s2 \/ + ~eof /\ ~mof /\ s1 /\ s2 \/ + ~eos /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2 \/ + ~eos /\ ~s1 /\ s2 \/ + eos /\ ~s1 /\ ~s2) /\ + (s1 <=> + eof /\ mof /\ s1 /\ s2 \/ + ~eof /\ eos /\ mof /\ s1 \/ + ~eof /\ ~mof /\ s1 /\ s2 \/ + ~eos /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2 \/ + ~eof /\ s1 /\ ~s2 \/ + ~eos /\ s1 /\ ~s2) /\ + (ls <=> + eof /\ eos /\ ~mof /\ s1 \/ + eof /\ eos /\ s1 /\ ~s2 \/ + ~eos /\ ~s1 /\ ~s2) /\ + (fs <=> ~eos /\ ~s1 /\ s2 \/ eos /\ ~s1 /\ ~s2) /\ + (wnp <=> + eof /\ mof /\ s1 /\ s2 \/ + ~eof /\ ~mof /\ s1 /\ s2 \/ + ~eos /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2) /\ + (rnp <=> + ~eof /\ eos /\ mof /\ s1 \/ ~eof /\ s1 /\ ~s2 \/ ~eos /\ s1 /\ ~s2) /\ + (wnpls <=> + eof /\ mof /\ s1 /\ s2 \/ + eof /\ eos /\ ~mof /\ s1 \/ + ~eof /\ ~mof /\ s1 /\ s2 \/ + ~eos /\ s1 /\ s2 \/ + eos /\ ~s1 /\ s2 \/ + eof /\ eos /\ s1 /\ ~s2 \/ + ~eos /\ ~s1 /\ ~s2)` ;; + +(* Hard : runtime: 73.140s, gctime: 0.640s, systime: 0.020s. *) +let aim_50_2_0_no_4 = +`~ +((v2 \/ v26 \/ v32) /\ + (v2 \/ ~v21 \/ v32) /\ + (v2 \/ v3 \/ ~v26) /\ + (~v2 \/ v22 \/ v44) /\ + (~v2 \/ ~v22 \/ v44) /\ + (~v2 \/ v23 \/ ~v44) /\ + (v3 \/ ~v23 \/ v41) /\ + (v3 \/ ~v41 \/ ~v44) /\ + (~v3 \/ v9 \/ v20) /\ + (~v3 \/ ~v20 \/ v32) /\ + (v7 \/ v9 \/ ~v32) /\ + (~v7 \/ v16 \/ ~v32) /\ + (v9 \/ ~v16 \/ ~v32) /\ + (v1 \/ v16 \/ v37) /\ + (~v1 \/ v16 \/ v26) /\ + (~v16 \/ v26 \/ v37) /\ + (~v9 \/ ~v26 \/ v37) /\ + (v5 \/ ~v9 \/ v46) /\ + (v11 \/ v21 \/ ~v46) /\ + (v5 \/ v21 \/ ~v46) /\ + (~v5 \/ v21 \/ v39) /\ + (~v5 \/ ~v37 \/ ~v39) /\ + (~v9 \/ ~v21 \/ ~v37) /\ + (v10 \/ ~v19 \/ ~v48) /\ + (v10 \/ ~v13 \/ ~v19) /\ + (v5 \/ ~v36 \/ v47) /\ + (~v5 \/ ~v36 \/ v47) /\ + (~v16 \/ v42 \/ ~v43) /\ + (~v1 \/ v13 \/ ~v39) /\ + (v8 \/ ~v27 \/ v30) /\ + (v13 \/ v18 \/ ~v30) /\ + (v8 \/ v13 \/ ~v18) /\ + (~v13 \/ v15 \/ ~v17) /\ + (~v13 \/ ~v15 \/ ~v30) /\ + (~v17 \/ ~v27 \/ ~v45) /\ + (~v12 \/ ~v27 \/ ~v45) /\ + (~v18 \/ v25 \/ v40) /\ + (~v18 \/ v34 \/ ~v40) /\ + (v25 \/ ~v34 \/ v48) /\ + (~v19 \/ ~v25 \/ v48) /\ + (~v1 \/ ~v12 \/ ~v34) /\ + (v20 \/ ~v25 \/ ~v43) /\ + (v8 \/ v19 \/ ~v45) /\ + (v17 \/ v29 \/ v34) /\ + (~v17 \/ v29 \/ v41) /\ + (v15 \/ ~v31 \/ ~v35) /\ + (~v15 \/ ~v31 \/ ~v35) /\ + (v34 \/ v39 \/ ~v43) /\ + (~v11 \/ ~v14 \/ v45) /\ + (~v11 \/ ~v12 \/ ~v14) /\ + (~v24 \/ v28 \/ ~v39) /\ + (~v8 \/ ~v24 \/ ~v30) /\ + (v7 \/ ~v25 \/ v45) /\ + (~v7 \/ ~v44 \/ v45) /\ + (~v20 \/ v36 \/ v50) /\ + (~v8 \/ v36 \/ v50) /\ + (~v8 \/ ~v20 \/ ~v50) /\ + (v20 \/ ~v41 \/ v44) /\ + (v28 \/ ~v33 \/ v39) /\ + (v28 \/ ~v33 \/ v47) /\ + (v10 \/ v27 \/ v38) /\ + (~v10 \/ v27 \/ v30) /\ + (v4 \/ ~v10 \/ v38) /\ + (~v6 \/ ~v35 \/ v41) /\ + (v12 \/ v18 \/ v22) /\ + (v17 \/ v22 \/ v30) /\ + (v12 \/ v29 \/ v42) /\ + (~v4 \/ v23 \/ v31) /\ + (v1 \/ ~v4 \/ ~v31) /\ + (~v4 \/ ~v6 \/ ~v22) /\ + (~v22 \/ v40 \/ v50) /\ + (v4 \/ ~v33 \/ v43) /\ + (~v6 \/ ~v21 \/ v42) /\ + (v7 \/ ~v24 \/ ~v47) /\ + (~v3 \/ v31 \/ ~v46) /\ + (v4 \/ v12 \/ ~v36) /\ + (~v11 \/ ~v29 \/ v36) /\ + (~v14 \/ ~v23 \/ ~v48) /\ + (~v23 \/ ~v37 \/ ~v48) /\ + (v15 \/ ~v42 \/ v43) /\ + (~v7 \/ v24 \/ ~v50) /\ + (~v10 \/ v33 \/ v46) /\ + (v40 \/ ~v42 \/ v46) /\ + (v14 \/ v24 \/ ~v49) /\ + (v11 \/ v17 \/ ~v38) /\ + (v19 \/ ~v28 \/ ~v47) /\ + (v14 \/ v24 \/ v27) /\ + (v6 \/ ~v15 \/ v43) /\ + (v11 \/ v18 \/ ~v41) /\ + (v1 \/ v6 \/ v49) /\ + (~v29 \/ ~v47 \/ ~v50) /\ + (v25 \/ ~v34 \/ ~v38) /\ + (v6 \/ v31 \/ ~v49) /\ + (v33 \/ v35 \/ v35) /\ + (v33 \/ v35 \/ v48) /\ + (v49 \/ v49 \/ ~v49) /\ + (v23 \/ ~v29 \/ ~v40) /\ + (v19 \/ ~v26 \/ ~v42) /\ + (v14 \/ v38 \/ ~v38) /\ + (~v28 \/ ~v28 \/ ~v40))` ;; + +(* Hard runtime: 170.440s, gctime: 1.940s, systime: 0.050s. *) +let aim_50_2_0_no_1 = +`~ +((v7 \/ v11 \/ v19) /\ + (v7 \/ ~v11 \/ v27) /\ + (v7 \/ v16 \/ ~v27) /\ + (~v11 \/ v25 \/ v48) /\ + (~v16 \/ v17 \/ ~v48) /\ + (~v17 \/ v25 \/ ~v48) /\ + (~v16 \/ ~v25 \/ ~v27) /\ + (v19 \/ v36 \/ v49) /\ + (~v7 \/ ~v36 \/ v49) /\ + (~v7 \/ v19 \/ ~v49) /\ + (v4 \/ v12 \/ v44) /\ + (v4 \/ ~v12 \/ v44) /\ + (v1 \/ ~v44 \/ v47) /\ + (~v1 \/ v4 \/ v47) /\ + (v20 \/ v34 \/ v48) /\ + (~v19 \/ v20 \/ v34) /\ + (v24 \/ ~v34 \/ ~v44) /\ + (~v24 \/ ~v34 \/ ~v44) /\ + (~v24 \/ ~v32 \/ v41) /\ + (~v34 \/ ~v41 \/ ~v47) /\ + (~v4 \/ ~v19 \/ v20) /\ + (v30 \/ v39 \/ v41) /\ + (~v30 \/ v39 \/ v50) /\ + (~v20 \/ ~v30 \/ ~v50) /\ + (~v20 \/ ~v39 \/ v41) /\ + (~v19 \/ v32 \/ ~v41) /\ + (~v20 \/ ~v32 \/ ~v41) /\ + (v1 \/ v18 \/ ~v35) /\ + (~v14 \/ v18 \/ ~v35) /\ + (~v14 \/ ~v18 \/ v27) /\ + (~v1 \/ v25 \/ ~v46) /\ + (~v4 \/ v16 \/ ~v47) /\ + (v11 \/ v16 \/ ~v25) /\ + (~v4 \/ v11 \/ ~v25) /\ + (~v27 \/ ~v35 \/ ~v47) /\ + (v15 \/ v31 \/ v40) /\ + (v10 \/ v39 \/ ~v49) /\ + (~v8 \/ ~v10 \/ v21) /\ + (~v21 \/ ~v26 \/ v30) /\ + (v6 \/ ~v11 \/ v29) /\ + (v6 \/ v31 \/ v50) /\ + (v45 \/ v49 \/ ~v50) /\ + (v31 \/ ~v45 \/ ~v50) /\ + (v21 \/ v30 \/ v33) /\ + (v2 \/ v37 \/ ~v49) /\ + (~v2 \/ v17 \/ v37) /\ + (~v8 \/ v14 \/ v32) /\ + (~v14 \/ ~v15 \/ v32) /\ + (~v1 \/ v37 \/ v47) /\ + (v6 \/ ~v38 \/ v45) /\ + (~v21 \/ ~v38 \/ v45) /\ + (~v13 \/ ~v18 \/ ~v42) /\ + (v2 \/ ~v6 \/ v22) /\ + (~v2 \/ ~v6 \/ v22) /\ + (v9 \/ ~v28 \/ ~v36) /\ + (v8 \/ v29 \/ ~v39) /\ + (~v8 \/ ~v38 \/ ~v39) /\ + (~v12 \/ v17 \/ v38) /\ + (v1 \/ ~v15 \/ ~v26) /\ + (~v7 \/ ~v15 \/ ~v26) /\ + (~v9 \/ v36 \/ v42) /\ + (v12 \/ ~v16 \/ v21) /\ + (~v10 \/ ~v23 \/ ~v46) /\ + (~v9 \/ ~v29 \/ v34) /\ + (~v9 \/ ~v21 \/ v42) /\ + (~v12 \/ ~v23 \/ v38) /\ + (~v30 \/ v38 \/ v40) /\ + (v18 \/ v23 \/ v33) /\ + (~v6 \/ v15 \/ v33) /\ + (v9 \/ v27 \/ ~v43) /\ + (v22 \/ v40 \/ ~v48) /\ + (v8 \/ ~v22 \/ v26) /\ + (~v5 \/ ~v33 \/ ~v36) /\ + (v2 \/ ~v33 \/ v46) /\ + (v5 \/ v10 \/ ~v42) /\ + (v14 \/ ~v29 \/ ~v31) /\ + (v12 \/ ~v23 \/ v26) /\ + (v8 \/ v35 \/ v36) /\ + (~v10 \/ ~v17 \/ ~v18) /\ + (v10 \/ ~v22 \/ ~v28) /\ + (v15 \/ ~v17 \/ ~v43) /\ + (v23 \/ ~v29 \/ ~v37) /\ + (v13 \/ ~v33 \/ v35) /\ + (~v2 \/ v23 \/ v42) /\ + (v9 \/ v43 \/ v46) /\ + (v5 \/ ~v24 \/ ~v45) /\ + (~v5 \/ v43 \/ v46) /\ + (~v3 \/ ~v13 \/ ~v40) /\ + (v3 \/ ~v28 \/ ~v42) /\ + (v24 \/ ~v31 \/ v43) /\ + (v14 \/ ~v22 \/ ~v32) /\ + (v3 \/ v24 \/ v26) /\ + (~v13 \/ ~v43 \/ v44) /\ + (~v3 \/ ~v31 \/ ~v40) /\ + (~v5 \/ ~v40 \/ v50) /\ + (v35 \/ ~v37 \/ ~v45) /\ + (~v3 \/ v5 \/ v28) /\ + (v13 \/ v28 \/ ~v46) /\ + (v3 \/ v28 \/ ~v37) /\ + (v13 \/ v29 \/ v48))` ;; + +(* Hard *) +let aim_50_2_0_no_2 = +`~ +((v4 \/ v21 \/ v34) /\ + (v21 \/ ~v34 \/ v40) /\ + (v1 \/ ~v21 \/ v40) /\ + (~v21 \/ v39 \/ v40) /\ + (v20 \/ v29 \/ v41) /\ + (~v20 \/ v39 \/ v41) /\ + (v39 \/ ~v40 \/ v41) /\ + (~v40 \/ ~v41 \/ v42) /\ + (~v40 \/ ~v41 \/ ~v42) /\ + (v1 \/ v25 \/ ~v39) /\ + (v2 \/ ~v25 \/ ~v39) /\ + (~v2 \/ v5 \/ ~v39) /\ + (~v1 \/ v4 \/ v5) /\ + (v15 \/ v26 \/ v33) /\ + (v15 \/ v26 \/ ~v33) /\ + (~v5 \/ ~v15 \/ v26) /\ + (~v5 \/ ~v26 \/ v31) /\ + (~v5 \/ ~v26 \/ ~v31) /\ + (v6 \/ v9 \/ v47) /\ + (v9 \/ v37 \/ v38) /\ + (v9 \/ v14 \/ ~v38) /\ + (~v14 \/ ~v38 \/ ~v47) /\ + (~v9 \/ v11 \/ v37) /\ + (~v9 \/ ~v11 \/ v37) /\ + (v24 \/ ~v37 \/ v48) /\ + (v24 \/ v46 \/ ~v48) /\ + (~v24 \/ ~v37 \/ v46) /\ + (v16 \/ v18 \/ ~v46) /\ + (~v16 \/ v18 \/ ~v46) /\ + (~v18 \/ ~v37 \/ ~v46) /\ + (~v4 \/ ~v6 \/ v15) /\ + (~v4 \/ v13 \/ ~v15) /\ + (~v4 \/ ~v13 \/ ~v15) /\ + (~v1 \/ ~v6 \/ v38) /\ + (v3 \/ ~v9 \/ v35) /\ + (v7 \/ v43 \/ v44) /\ + (v7 \/ v29 \/ v43) /\ + (~v8 \/ ~v29 \/ v44) /\ + (~v29 \/ ~v32 \/ v48) /\ + (~v14 \/ v30 \/ v46) /\ + (~v1 \/ ~v14 \/ ~v30) /\ + (~v11 \/ v20 \/ v49) /\ + (v20 \/ ~v44 \/ ~v49) /\ + (v16 \/ v22 \/ ~v27) /\ + (v13 \/ ~v19 \/ ~v35) /\ + (v2 \/ v19 \/ ~v33) /\ + (v2 \/ v19 \/ ~v28) /\ + (v33 \/ ~v34 \/ ~v44) /\ + (~v33 \/ ~v44 \/ v50) /\ + (v5 \/ v30 \/ ~v48) /\ + (v10 \/ v22 \/ ~v50) /\ + (~v10 \/ v22 \/ ~v34) /\ + (v1 \/ v10 \/ ~v47) /\ + (~v10 \/ ~v25 \/ ~v47) /\ + (~v25 \/ ~v27 \/ v50) /\ + (v11 \/ v21 \/ v23) /\ + (~v3 \/ v11 \/ v23) /\ + (~v3 \/ v6 \/ ~v50) /\ + (~v6 \/ v23 \/ ~v50) /\ + (~v31 \/ ~v43 \/ v44) /\ + (~v7 \/ v16 \/ ~v26) /\ + (~v23 \/ v28 \/ ~v38) /\ + (v19 \/ v28 \/ v50) /\ + (~v18 \/ v45 \/ v49) /\ + (~v2 \/ ~v16 \/ ~v48) /\ + (v7 \/ v14 \/ ~v42) /\ + (v12 \/ v25 \/ ~v36) /\ + (v10 \/ ~v24 \/ ~v45) /\ + (~v21 \/ v32 \/ ~v42) /\ + (v12 \/ ~v18 \/ ~v27) /\ + (~v13 \/ ~v23 \/ ~v24) /\ + (v25 \/ v29 \/ v38) /\ + (~v8 \/ v43 \/ ~v45) /\ + (~v2 \/ ~v12 \/ v13) /\ + (~v7 \/ v14 \/ v30) /\ + (~v8 \/ ~v17 \/ ~v19) /\ + (v8 \/ ~v22 \/ v49) /\ + (~v12 \/ ~v17 \/ v33) /\ + (v27 \/ ~v29 \/ v32) /\ + (v8 \/ ~v12 \/ ~v13) /\ + (v24 \/ ~v31 \/ v47) /\ + (~v3 \/ v36 \/ v47) /\ + (v3 \/ v12 \/ v34) /\ + (~v7 \/ ~v16 \/ v36) /\ + (~v22 \/ v31 \/ v48) /\ + (v17 \/ ~v22 \/ ~v49) /\ + (~v17 \/ ~v19 \/ v32) /\ + (~v20 \/ v27 \/ v36) /\ + (v18 \/ ~v32 \/ ~v35) /\ + (v3 \/ ~v28 \/ ~v30) /\ + (v17 \/ v34 \/ v42) /\ + (~v32 \/ ~v43 \/ ~v49) /\ + (v17 \/ ~v28 \/ ~v43) /\ + (~v23 \/ v35 \/ ~v45) /\ + (~v10 \/ v31 \/ ~v36) /\ + (v27 \/ ~v41 \/ v42) /\ + (v35 \/ ~v36 \/ v45) /\ + (v8 \/ ~v30 \/ v45) /\ + (v4 \/ v28 \/ ~v35) /\ + (v6 \/ ~v11 \/ ~v20))` ;; + +(* Hard *) +let aim_50_2_0_no_3 = +`~ +((v33 \/ v37 \/ v43) /\ + (v21 \/ ~v37 \/ v43) /\ + (~v21 \/ ~v37 \/ v39) /\ + (v23 \/ v39 \/ ~v43) /\ + (v13 \/ ~v23 \/ v31) /\ + (~v13 \/ ~v23 \/ v31) /\ + (~v23 \/ ~v31 \/ ~v43) /\ + (v6 \/ v9 \/ v25) /\ + (~v6 \/ v9 \/ v25) /\ + (v9 \/ v33 \/ ~v38) /\ + (~v9 \/ v25 \/ ~v39) /\ + (v24 \/ ~v25 \/ ~v39) /\ + (~v24 \/ ~v25 \/ v33) /\ + (v6 \/ v27 \/ v41) /\ + (~v6 \/ v14 \/ v41) /\ + (v14 \/ ~v41 \/ v43) /\ + (v14 \/ ~v41 \/ ~v43) /\ + (v1 \/ v20 \/ v27) /\ + (v1 \/ v12 \/ ~v20) /\ + (v1 \/ ~v12 \/ ~v14) /\ + (~v1 \/ v27 \/ v28) /\ + (~v1 \/ ~v14 \/ ~v28) /\ + (~v1 \/ ~v11 \/ ~v14) /\ + (~v27 \/ ~v33 \/ v39) /\ + (v5 \/ v20 \/ v28) /\ + (v19 \/ v29 \/ ~v33) /\ + (~v19 \/ ~v20 \/ v29) /\ + (~v20 \/ v28 \/ ~v29) /\ + (v5 \/ ~v28 \/ v37) /\ + (v5 \/ ~v28 \/ ~v37) /\ + (~v5 \/ ~v33 \/ ~v39) /\ + (v7 \/ v17 \/ v22) /\ + (~v5 \/ v7 \/ v17) /\ + (~v7 \/ v18 \/ v22) /\ + (v22 \/ ~v24 \/ v41) /\ + (~v7 \/ v12 \/ v18) /\ + (~v12 \/ v18 \/ v34) /\ + (~v12 \/ v34 \/ ~v42) /\ + (~v7 \/ ~v34 \/ ~v41) /\ + (~v16 \/ ~v29 \/ v35) /\ + (~v3 \/ v13 \/ ~v29) /\ + (~v21 \/ ~v30 \/ v37) /\ + (~v15 \/ ~v21 \/ v47) /\ + (~v8 \/ v24 \/ v40) /\ + (~v3 \/ ~v8 \/ v42) /\ + (~v3 \/ ~v8 \/ ~v42) /\ + (~v2 \/ v30 \/ v36) /\ + (~v2 \/ ~v30 \/ v36) /\ + (~v4 \/ ~v35 \/ v44) /\ + (v42 \/ ~v45 \/ ~v50) /\ + (~v42 \/ ~v45 \/ ~v50) /\ + (~v11 \/ v15 \/ ~v40) /\ + (v3 \/ v46 \/ v48) /\ + (v3 \/ ~v46 \/ v48) /\ + (~v11 \/ v30 \/ v50) /\ + (~v16 \/ v30 \/ v50) /\ + (v4 \/ ~v36 \/ ~v40) /\ + (v8 \/ v46 \/ v47) /\ + (v24 \/ ~v40 \/ v44) /\ + (v12 \/ v16 \/ ~v46) /\ + (v2 \/ v6 \/ ~v36) /\ + (~v6 \/ ~v44 \/ v46) /\ + (~v22 \/ v32 \/ ~v36) /\ + (v3 \/ v32 \/ v38) /\ + (~v27 \/ ~v35 \/ v38) /\ + (v11 \/ v16 \/ ~v47) /\ + (v31 \/ ~v45 \/ ~v46) /\ + (v19 \/ ~v24 \/ v32) /\ + (~v15 \/ v23 \/ ~v31) /\ + (v4 \/ ~v34 \/ ~v49) /\ + (v11 \/ ~v22 \/ ~v49) /\ + (v23 \/ ~v26 \/ v50) /\ + (~v9 \/ ~v31 \/ ~v32) /\ + (~v2 \/ ~v27 \/ v35) /\ + (v26 \/ v34 \/ v45) /\ + (v7 \/ v36 \/ v47) /\ + (~v4 \/ ~v30 \/ v49) /\ + (~v26 \/ ~v44 \/ ~v50) /\ + (v2 \/ v40 \/ v48) /\ + (v26 \/ ~v44 \/ ~v47) /\ + (~v18 \/ v19 \/ ~v25) /\ + (~v38 \/ v42 \/ v49) /\ + (v13 \/ ~v22 \/ v49) /\ + (~v10 \/ ~v32 \/ ~v48) /\ + (v2 \/ ~v19 \/ v29) /\ + (~v13 \/ ~v15 \/ v26) /\ + (~v10 \/ ~v17 \/ v20) /\ + (~v17 \/ v21 \/ v45) /\ + (~v4 \/ ~v13 \/ ~v26) /\ + (~v9 \/ v21 \/ ~v48) /\ + (~v10 \/ v35 \/ v44) /\ + (~v32 \/ ~v48 \/ ~v49) /\ + (v4 \/ ~v16 \/ ~v19) /\ + (~v5 \/ v8 \/ v40) /\ + (v15 \/ ~v18 \/ ~v35) /\ + (v8 \/ v10 \/ ~v47) /\ + (v10 \/ v15 \/ v45) /\ + (v10 \/ ~v18 \/ ~v34) /\ + (v16 \/ v17 \/ v38) /\ + (v11 \/ ~v17 \/ ~v38))` ;; + +let mul_be = + `(ba0 <=> + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl) /\ + (ba1 <=> + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~c17 /\ ~repl) /\ + (ba2 <=> + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~c17 /\ ~repl) /\ + (by0 <=> + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl) /\ + (by1 <=> + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ c1 \/ + c0 \/ + repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ ~c17) /\ + (bx0 <=> + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl) /\ + (bx1 <=> + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ c1 \/ + c0 \/ + repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ ~c16 /\ ~c17) + ==> (bx1 <=> + repl \/ + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c14 /\ ~c15 /\ ~c16 /\ ~c17 \/ + c1 \/ + c0) /\ + (bx0 <=> + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~repl) /\ + (by1 <=> + repl \/ + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c14 /\ ~c15 /\ ~c16 /\ ~c17 \/ + c1 \/ + c0) /\ + (by0 <=> + ~c0 /\ ~c1 /\ ~c14 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~repl) /\ + (ba2 <=> ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ ~c16 /\ ~repl) /\ + (ba1 <=> ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c16 /\ ~repl) /\ + (ba0 <=> + ~c0 /\ ~c1 /\ ~c14 /\ ~c15 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ ~c16 /\ c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ ~c14 /\ c15 /\ c16 /\ ~c17 /\ ~repl \/ + ~c0 /\ ~c1 /\ c14 /\ ~c15 /\ ~c16 /\ ~c17 /\ ~repl)` ;; + +let dk17_be = + `(ge17 <=> ~in4 /\ ~in3 /\ ~in2 /\ ~in1) /\ + (ge0 <=> ge17 /\ ~in5) /\ + (ge22 <=> ~in9 /\ ~in7 /\ ~in6 /\ in0) /\ + (ge19 <=> ~in5 /\ ~in4 /\ ~in3 /\ ~in0) /\ + (ge20 <=> ~in7 /\ ~in6) /\ + (ge18 <=> ~in6 /\ ~in2 /\ ~in1 /\ ~in0) /\ + (ge21 <=> in9 /\ ~in7 /\ in6 /\ ~in0) /\ + (ge23 <=> ge22 /\ ge0) /\ + (ge25 <=> ~in9 /\ ~in7 /\ in6 /\ ~in0) /\ + (ge26 <=> in9 /\ ~in7 /\ ~in6 /\ in0) /\ + (ge2 <=> ge20 /\ ge19) /\ + (ge1 <=> ge18 /\ ~in7) /\ + (ge24 <=> ge23 \/ ge21 /\ ge0) /\ + (ge5 <=> ~in5 /\ in4 \/ in5 /\ ~in4) /\ + (ge6 <=> ge0 /\ in7 /\ ~in6 /\ ~in0) /\ + (ge12 <=> ge26 /\ ge0 \/ ge25 /\ ge0) /\ + (ge14 <=> ge2 /\ in8 /\ ~in2 /\ in1) /\ + (ge27 <=> ~in8 /\ in5 /\ ~in4 /\ ~in3) /\ + (ge9 <=> ge1 /\ ~in5 /\ ~in4 /\ in3) /\ + (ge7 <=> ge24 \/ ge2 /\ in2 /\ ~in1) /\ + (ge10 <=> ge6 \/ ge5 /\ ge1 /\ ~in3) /\ + (ge15 <=> ~in8 \/ in9) /\ + (ge16 <=> ge12 \/ ge14 /\ ~in9) /\ + (ge4 <=> + ge5 /\ ge1 /\ in8 /\ ~in3 \/ + ge0 /\ ~in7 /\ in6 /\ ~in0 \/ + ge2 /\ in2 /\ ~in1) /\ + (ge13 <=> ge27 /\ ge1) /\ + (ge11 <=> ge9 \/ ge6 /\ ~in8) /\ + (ge8 <=> ge1 /\ ~in5 /\ in4 /\ ~in3 \/ ge2 /\ ~in2 /\ in1) /\ + (out0 <=> ge7 /\ ~in8) /\ + (out1 <=> ge7 /\ in8) /\ + (out2 <=> ge8 /\ ~in9 \/ ge10 /\ in8) /\ + (out3 <=> ge8 /\ in9 /\ ~in8 \/ ge11 /\ ~in9 \/ ge12 /\ ~in8) /\ + (out4 <=> ge11 /\ in9 \/ ge12 /\ in8) /\ + (out5 <=> ge14 /\ in9) /\ + (out6 <=> ge13 /\ ~in9) /\ + (out7 <=> ge13 /\ in9) /\ + (out8 <=> ge9 /\ ~in8 \/ ge15 /\ ge6 \/ ge4 /\ in9) /\ + (out9 <=> ge9 /\ in8 \/ ~ge15 /\ ge10 \/ ge16) /\ + (out10 <=> ge7) /\ + (wres0 <=> ~in5 /\ ~in4 /\ ~in3 /\ ~in2 /\ ~in1) /\ + (wres1 <=> ~in7 /\ ~in6 /\ ~in2 /\ ~in1 /\ ~in0) /\ + (wres2 <=> ~in7 /\ ~in6 /\ ~in5 /\ ~in4 /\ ~in3 /\ ~in0) /\ + (wres5 <=> ~in5 /\ in4 \/ in5 /\ ~in4) /\ + (wres6 <=> wres0 /\ in7 /\ ~in6 /\ ~in0) /\ + (wres9 <=> wres1 /\ ~in5 /\ ~in4 /\ in3) /\ + (wres7 <=> + wres0 /\ ~in9 /\ ~in7 /\ ~in6 /\ in0 \/ + wres0 /\ in9 /\ ~in7 /\ in6 /\ ~in0 \/ + wres2 /\ in2 /\ ~in1) /\ + (wres10 <=> wres6 \/ wres5 /\ wres1 /\ ~in3) /\ + (wres12 <=> wres0 /\ in9 /\ ~in7 /\ ~in6 /\ in0 \/ + wres0 /\ ~in9 /\ ~in7 /\ in6 /\ ~in0) /\ + (wres14 <=> wres2 /\ in8 /\ ~in2 /\ in1) /\ + (wres15 <=> ~in8 \/ in9) /\ + (wres4 <=> wres5 /\ wres1 /\ in8 /\ ~in3 \/ + wres2 /\ in2 /\ ~in1 \/ + wres0 /\ ~in7 /\ in6 /\ ~in0) /\ + (wres13 <=> wres1 /\ ~in8 /\ in5 /\ ~in4 /\ ~in3) /\ + (wres11 <=> wres9 \/ wres6 /\ ~in8) /\ + (wres8 <=> wres1 /\ ~in5 /\ in4 /\ ~in3 \/ wres2 /\ ~in2 /\ in1) + ==> (out10 <=> wres7) /\ + (out9 <=> wres9 /\ in8 \/ wres12 \/ wres14 /\ ~in9 \/ ~wres15 /\ wres10) /\ + (out8 <=> wres9 /\ ~in8 \/ wres15 /\ wres6 \/ wres4 /\ in9) /\ + (out7 <=> wres13 /\ in9) /\ + (out6 <=> wres13 /\ ~in9) /\ + (out5 <=> wres14 /\ in9) /\ + (out4 <=> wres11 /\ in9 \/ wres12 /\ in8) /\ + (out3 <=> wres8 /\ in9 /\ ~in8 \/ wres11 /\ ~in9 \/ wres12 /\ ~in8) /\ + (out2 <=> wres8 /\ ~in9 \/ wres10 /\ in8) /\ + (out1 <=> wres7 /\ in8) /\ + (out0 <=> wres7 /\ ~in8)` ;; + +(* Hard *) +let risc_be = + `(ge1 <=> ~in4 /\ ~in2 /\ ~in1 /\ in0) /\ + (ge2 <=> in2 /\ ~in1 /\ ~in0) /\ + (ge3 <=> in2 /\ ~in1 /\ in0) /\ + (ge8 <=> in2 /\ in1) /\ + (ge16 <=> ~in2 /\ in1) /\ + (ge5 <=> ~in3 /\ ~in2 /\ in1 /\ in0) /\ + (ge11 <=> ge1 /\ in3) /\ + (ge0 <=> ~in3 /\ ~in2 /\ in1 /\ ~in0) /\ + (ge9 <=> ge2 /\ in3) /\ + (ge10 <=> ge3 /\ ~in3) /\ + (ge17 <=> ~in4 /\ in3) /\ + (ge20 <=> ge2 /\ ~in3) /\ + (ge15 <=> ge8 /\ in0) /\ + (ge19 <=> ge1 /\ in5) /\ + (ge6 <=> ge16 \/ in4 /\ ~in2) /\ + (ge13 <=> ge11 \/ ge5) /\ + (ge4 <=> in2 \/ in1 \/ in0) /\ + (ge7 <=> ~in6 /\ in5 \/ in4) /\ + (ge12 <=> ge0 /\ ~in6 /\ ~in4 \/ ge0 /\ ~in5 /\ ~in4) /\ + (ge14 <=> ge8 /\ ~in0) /\ + (ge18 <=> ge9 /\ in4) /\ + (out0 <=> ge12 \/ ge18) /\ + (out1 <=> ge9 /\ in5 /\ ~in4) /\ + (out2 <=> ge17 /\ in5 /\ in2 /\ ~in0 \/ ge5 \/ ge14) /\ + (out3 <=> ge1 /\ in7 \/ ge13) /\ + (out4 <=> ge3 \/ ~ge4) /\ + (out5 <=> ge9) /\ + (out6 <=> ge20) /\ + (out7 <=> ge2 /\ ~in5 \/ ge18) /\ + (out8 <=> ge14) /\ + (out9 <=> ge12) /\ + (out10 <=> ge0) /\ + (out11 <=> ~ge7 /\ ge0) /\ + (out12 <=> ge7 /\ ge0) /\ + (out13 <=> ge16 /\ ~in0) /\ + (out14 <=> ~ge4) /\ + (out15 <=> ge4) /\ + (out16 <=> ge10 /\ in5) /\ + (out17 <=> ge10 /\ ~in5) /\ + (out18 <=> ~ge4 /\ ~in4 /\ ~in3) /\ + (out19 <=> ~ge4 /\ in3) /\ + (out20 <=> ge15) /\ + (out21 <=> ge13) /\ + (out22 <=> ge11) /\ + (out23 <=> ge1 /\ ~in3) /\ + (out24 <=> ge19) /\ + (out25 <=> ge6 /\ in3 /\ in0) /\ + (out26 <=> ge19 \/ ge15) /\ + (out27 <=> in1 /\ ~in0) /\ + (out28 <=> ge20 /\ in5) /\ + (out29 <=> ge17 /\ ge3) /\ + (out30 <=> ge10 /\ ~in4) /\ + (wres1 <=> ~in4 /\ ~in2 /\ ~in1 /\ in0) /\ + (wres2 <=> in2 /\ ~in1 /\ ~in0) /\ + (wres3 <=> in2 /\ ~in1 /\ in0) /\ + (wres8 <=> in2 /\ in1) /\ + (wres16 <=> ~in2 /\ in1) /\ + (wres5 <=> ~in3 /\ ~in2 /\ in1 /\ in0) /\ + (wres11 <=> wres1 /\ in3) /\ + (wres0 <=> ~in3 /\ ~in2 /\ in1 /\ ~in0) /\ + (wres9 <=> wres2 /\ in3) /\ + (wres10 <=> wres3 /\ ~in3) /\ + (wres17 <=> ~in4 /\ in3) /\ + (wres20 <=> wres2 /\ ~in3) /\ + (wres15 <=> wres8 /\ in0) /\ + (wres19 <=> wres1 /\ in5) /\ + (wres6 <=> wres16 \/ in4 /\ ~in2) /\ + (wres13 <=> wres11 \/ wres5) /\ + (wres4 <=> in2 \/ in1 \/ in0) /\ + (wres7 <=> ~in6 /\ in5 \/ in4) /\ + (wres12 <=> wres0 /\ ~in6 /\ ~in4 \/ wres0 /\ ~in5 /\ ~in4) /\ + (wres14 <=> wres8 /\ ~in0) /\ + (wres18 <=> wres9 /\ in4) + ==> (out30 <=> wres10 /\ ~in4) /\ + (out29 <=> wres17 /\ wres3) /\ + (out28 <=> wres20 /\ in5) /\ + (out27 <=> in1 /\ ~in0) /\ + (out26 <=> wres19 \/ wres15) /\ + (out25 <=> wres6 /\ in3 /\ in0) /\ + (out24 <=> wres19) /\ + (out23 <=> wres1 /\ ~in3) /\ + (out22 <=> wres11) /\ + (out21 <=> wres13) /\ + (out20 <=> wres15) /\ + (out19 <=> ~wres4 /\ in3) /\ + (out18 <=> ~wres4 /\ ~in4 /\ ~in3) /\ + (out17 <=> wres10 /\ ~in5) /\ + (out16 <=> wres10 /\ in5) /\ + (out15 <=> wres4) /\ + (out14 <=> ~wres4) /\ + (out13 <=> wres16 /\ ~in0) /\ + (out12 <=> wres7 /\ wres0) /\ + (out11 <=> ~wres7 /\ wres0) /\ + (out10 <=> wres0) /\ + (out9 <=> wres12) /\ + (out8 <=> wres14) /\ + (out7 <=> wres2 /\ ~in5 \/ wres18) /\ + (out6 <=> wres20) /\ + (out5 <=> wres9) /\ + (out4 <=> wres3 \/ ~wres4) /\ + (out3 <=> wres1 /\ in7 \/ wres13) /\ + (out2 <=> wres5 \/ wres14 \/ wres17 /\ in5 /\ in2 /\ ~in0) /\ + (out1 <=> wres9 /\ in5 /\ ~in4) /\ + (out0 <=> wres12 \/ wres18)` ;; + +let msc006_1 = +`~((~v5 \/ ~v0 \/ v0) /\ + (~v5 \/ ~v2 \/ v2) /\ + (~v5 \/ ~v31 \/ v31) /\ + (~v5 \/ ~v5 \/ v5) /\ + (~v13 \/ ~v0 \/ v7) /\ + (~v13 \/ ~v2 \/ v9) /\ + (~v13 \/ ~v31 \/ v11) /\ + (~v13 \/ ~v5 \/ v13) /\ + (~v20 \/ ~v0 \/ v15) /\ + (~v20 \/ ~v2 \/ v16) /\ + (~v20 \/ ~v31 \/ v18) /\ + (~v20 \/ ~v5 \/ v20) /\ + (~v28 \/ ~v0 \/ v22) /\ + (~v28 \/ ~v2 \/ v24) /\ + (~v28 \/ ~v31 \/ v26) /\ + (~v28 \/ ~v5 \/ v28) /\ + (~v31 \/ ~v7 \/ v0) /\ + (~v31 \/ ~v9 \/ v2) /\ + (~v31 \/ ~v11 \/ v31) /\ + (~v31 \/ ~v13 \/ v5) /\ + (~v11 \/ ~v7 \/ v7) /\ + (~v11 \/ ~v9 \/ v9) /\ + (~v11 \/ ~v11 \/ v11) /\ + (~v11 \/ ~v13 \/ v13) /\ + (~v18 \/ ~v7 \/ v15) /\ + (~v18 \/ ~v9 \/ v16) /\ + (~v18 \/ ~v11 \/ v18) /\ + (~v18 \/ ~v13 \/ v20) /\ + (~v26 \/ ~v7 \/ v22) /\ + (~v26 \/ ~v9 \/ v24) /\ + (~v26 \/ ~v11 \/ v26) /\ + (~v26 \/ ~v13 \/ v28) /\ + (~v2 \/ ~v15 \/ v0) /\ + (~v2 \/ ~v16 \/ v2) /\ + (~v2 \/ ~v18 \/ v31) /\ + (~v2 \/ ~v20 \/ v5) /\ + (~v9 \/ ~v15 \/ v7) /\ + (~v9 \/ ~v16 \/ v9) /\ + (~v9 \/ ~v18 \/ v11) /\ + (~v9 \/ ~v20 \/ v13) /\ + (~v16 \/ ~v15 \/ v15) /\ + (~v16 \/ ~v16 \/ v16) /\ + (~v16 \/ ~v18 \/ v18) /\ + (~v16 \/ ~v20 \/ v20) /\ + (~v24 \/ ~v15 \/ v22) /\ + (~v24 \/ ~v16 \/ v24) /\ + (~v24 \/ ~v18 \/ v26) /\ + (~v24 \/ ~v20 \/ v28) /\ + (~v0 \/ ~v22 \/ v0) /\ + (~v0 \/ ~v24 \/ v2) /\ + (~v0 \/ ~v26 \/ v31) /\ + (~v0 \/ ~v28 \/ v5) /\ + (~v7 \/ ~v22 \/ v7) /\ + (~v7 \/ ~v24 \/ v9) /\ + (~v7 \/ ~v26 \/ v11) /\ + (~v7 \/ ~v28 \/ v13) /\ + (~v15 \/ ~v22 \/ v15) /\ + (~v15 \/ ~v24 \/ v16) /\ + (~v15 \/ ~v26 \/ v18) /\ + (~v15 \/ ~v28 \/ v20) /\ + (~v22 \/ ~v22 \/ v22) /\ + (~v22 \/ ~v24 \/ v24) /\ + (~v22 \/ ~v26 \/ v26) /\ + (~v22 \/ ~v28 \/ v28) /\ + (~v6 \/ ~v1 \/ v1) /\ + (~v6 \/ ~v3 \/ v3) /\ + (~v6 \/ ~v4 \/ v4) /\ + (~v6 \/ ~v6 \/ v6) /\ + (~v14 \/ ~v1 \/ v8) /\ + (~v14 \/ ~v3 \/ v10) /\ + (~v14 \/ ~v4 \/ v12) /\ + (~v14 \/ ~v6 \/ v14) /\ + (~v21 \/ ~v1 \/ v30) /\ + (~v21 \/ ~v3 \/ v17) /\ + (~v21 \/ ~v4 \/ v19) /\ + (~v21 \/ ~v6 \/ v21) /\ + (~v29 \/ ~v1 \/ v23) /\ + (~v29 \/ ~v3 \/ v25) /\ + (~v29 \/ ~v4 \/ v27) /\ + (~v29 \/ ~v6 \/ v29) /\ + (~v4 \/ ~v8 \/ v1) /\ + (~v4 \/ ~v10 \/ v3) /\ + (~v4 \/ ~v12 \/ v4) /\ + (~v4 \/ ~v14 \/ v6) /\ + (~v12 \/ ~v8 \/ v8) /\ + (~v12 \/ ~v10 \/ v10) /\ + (~v12 \/ ~v12 \/ v12) /\ + (~v12 \/ ~v14 \/ v14) /\ + (~v19 \/ ~v8 \/ v30) /\ + (~v19 \/ ~v10 \/ v17) /\ + (~v19 \/ ~v12 \/ v19) /\ + (~v19 \/ ~v14 \/ v21) /\ + (~v27 \/ ~v8 \/ v23) /\ + (~v27 \/ ~v10 \/ v25) /\ + (~v27 \/ ~v12 \/ v27) /\ + (~v27 \/ ~v14 \/ v29) /\ + (~v3 \/ ~v30 \/ v1) /\ + (~v3 \/ ~v17 \/ v3) /\ + (~v3 \/ ~v19 \/ v4) /\ + (~v3 \/ ~v21 \/ v6) /\ + (~v10 \/ ~v30 \/ v8) /\ + (~v10 \/ ~v17 \/ v10) /\ + (~v10 \/ ~v19 \/ v12) /\ + (~v10 \/ ~v21 \/ v14) /\ + (~v17 \/ ~v30 \/ v30) /\ + (~v17 \/ ~v17 \/ v17) /\ + (~v17 \/ ~v19 \/ v19) /\ + (~v17 \/ ~v21 \/ v21) /\ + (~v25 \/ ~v30 \/ v23) /\ + (~v25 \/ ~v17 \/ v25) /\ + (~v25 \/ ~v19 \/ v27) /\ + (~v25 \/ ~v21 \/ v29) /\ + (~v1 \/ ~v23 \/ v1) /\ + (~v1 \/ ~v25 \/ v3) /\ + (~v1 \/ ~v27 \/ v4) /\ + (~v1 \/ ~v29 \/ v6) /\ + (~v8 \/ ~v23 \/ v8) /\ + (~v8 \/ ~v25 \/ v10) /\ + (~v8 \/ ~v27 \/ v12) /\ + (~v8 \/ ~v29 \/ v14) /\ + (~v30 \/ ~v23 \/ v30) /\ + (~v30 \/ ~v25 \/ v17) /\ + (~v30 \/ ~v27 \/ v19) /\ + (~v30 \/ ~v29 \/ v21) /\ + (~v23 \/ ~v23 \/ v23) /\ + (~v23 \/ ~v25 \/ v25) /\ + (~v23 \/ ~v27 \/ v27) /\ + (~v23 \/ ~v29 \/ v29) /\ + (~v29 \/ v1) /\ + (~v21 \/ v3) /\ + (~v14 \/ v4) /\ + (~v6 \/ v6) /\ + (~v27 \/ v8) /\ + (~v19 \/ v10) /\ + (~v12 \/ v12) /\ + (~v4 \/ v14) /\ + (~v25 \/ v30) /\ + (~v17 \/ v17) /\ + (~v10 \/ v19) /\ + (~v3 \/ v21) /\ + (~v23 \/ v23) /\ + (~v30 \/ v25) /\ + (~v8 \/ v27) /\ + (~v1 \/ v29) /\ + (v0 \/ v1) /\ + (v2 \/ v3) /\ + (v31 \/ v4) /\ + (v5 \/ v6) /\ + (v7 \/ v8) /\ + (v9 \/ v10) /\ + (v11 \/ v12) /\ + (v13 \/ v14) /\ + (v15 \/ v30) /\ + (v16 \/ v17) /\ + (v18 \/ v19) /\ + (v20 \/ v21) /\ + (v22 \/ v23) /\ + (v24 \/ v25) /\ + (v26 \/ v27) /\ + (v28 \/ v29) /\ + ~v30 /\ + ~v31)` ;; + +let syn072_1 = +`~(v11 /\ + v9 /\ + v7 /\ + v23 /\ + v24 /\ + (~v16 \/ v0) /\ + (~v18 \/ v1) /\ + (~v20 \/ v2) /\ + (~v22 \/ v25) /\ + (~v24 \/ v24) /\ + (~v17 \/ v3) /\ + (~v19 \/ v4) /\ + (~v21 \/ v5) /\ + (~v23 \/ v23) /\ + (~v25 \/ v22) /\ + (~v13 \/ v6) /\ + (~v10 \/ v27) /\ + (~v7 \/ v7) /\ + (~v5 \/ v21) /\ + (~v2 \/ v20) /\ + (~v12 \/ v8) /\ + (~v9 \/ v9) /\ + (~v27 \/ v10) /\ + (~v4 \/ v19) /\ + (~v1 \/ v18) /\ + (~v11 \/ v11) /\ + (~v8 \/ v12) /\ + (~v6 \/ v13) /\ + (~v3 \/ v17) /\ + (~v0 \/ v16) /\ + (~v24 \/ ~v0 \/ v0) /\ + (~v24 \/ ~v1 \/ v1) /\ + (~v24 \/ ~v2 \/ v2) /\ + (~v24 \/ ~v25 \/ v25) /\ + (~v24 \/ ~v24 \/ v24) /\ + (~v22 \/ ~v0 \/ v3) /\ + (~v22 \/ ~v1 \/ v4) /\ + (~v22 \/ ~v2 \/ v5) /\ + (~v22 \/ ~v25 \/ v23) /\ + (~v22 \/ ~v24 \/ v22) /\ + (~v20 \/ ~v0 \/ v6) /\ + (~v20 \/ ~v1 \/ v27) /\ + (~v20 \/ ~v2 \/ v7) /\ + (~v20 \/ ~v25 \/ v21) /\ + (~v20 \/ ~v24 \/ v20) /\ + (~v18 \/ ~v0 \/ v8) /\ + (~v18 \/ ~v1 \/ v9) /\ + (~v18 \/ ~v2 \/ v10) /\ + (~v18 \/ ~v25 \/ v19) /\ + (~v18 \/ ~v24 \/ v18) /\ + (~v16 \/ ~v0 \/ v11) /\ + (~v16 \/ ~v1 \/ v12) /\ + (~v16 \/ ~v2 \/ v13) /\ + (~v16 \/ ~v25 \/ v17) /\ + (~v16 \/ ~v24 \/ v16) /\ + (~v25 \/ ~v3 \/ v0) /\ + (~v25 \/ ~v4 \/ v1) /\ + (~v25 \/ ~v5 \/ v2) /\ + (~v25 \/ ~v23 \/ v25) /\ + (~v25 \/ ~v22 \/ v24) /\ + (~v23 \/ ~v3 \/ v3) /\ + (~v23 \/ ~v4 \/ v4) /\ + (~v23 \/ ~v5 \/ v5) /\ + (~v23 \/ ~v23 \/ v23) /\ + (~v23 \/ ~v22 \/ v22) /\ + (~v21 \/ ~v3 \/ v6) /\ + (~v21 \/ ~v4 \/ v27) /\ + (~v21 \/ ~v5 \/ v7) /\ + (~v21 \/ ~v23 \/ v21) /\ + (~v21 \/ ~v22 \/ v20) /\ + (~v19 \/ ~v3 \/ v8) /\ + (~v19 \/ ~v4 \/ v9) /\ + (~v19 \/ ~v5 \/ v10) /\ + (~v19 \/ ~v23 \/ v19) /\ + (~v19 \/ ~v22 \/ v18) /\ + (~v17 \/ ~v3 \/ v11) /\ + (~v17 \/ ~v4 \/ v12) /\ + (~v17 \/ ~v5 \/ v13) /\ + (~v17 \/ ~v23 \/ v17) /\ + (~v17 \/ ~v22 \/ v16) /\ + (~v2 \/ ~v6 \/ v0) /\ + (~v2 \/ ~v27 \/ v1) /\ + (~v2 \/ ~v7 \/ v2) /\ + (~v2 \/ ~v21 \/ v25) /\ + (~v2 \/ ~v20 \/ v24) /\ + (~v5 \/ ~v6 \/ v3) /\ + (~v5 \/ ~v27 \/ v4) /\ + (~v5 \/ ~v7 \/ v5) /\ + (~v5 \/ ~v21 \/ v23) /\ + (~v5 \/ ~v20 \/ v22) /\ + (~v7 \/ ~v6 \/ v6) /\ + (~v7 \/ ~v27 \/ v27) /\ + (~v7 \/ ~v7 \/ v7) /\ + (~v7 \/ ~v21 \/ v21) /\ + (~v7 \/ ~v20 \/ v20) /\ + (~v10 \/ ~v6 \/ v8) /\ + (~v10 \/ ~v27 \/ v9) /\ + (~v10 \/ ~v7 \/ v10) /\ + (~v10 \/ ~v21 \/ v19) /\ + (~v10 \/ ~v20 \/ v18) /\ + (~v13 \/ ~v6 \/ v11) /\ + (~v13 \/ ~v27 \/ v12) /\ + (~v13 \/ ~v7 \/ v13) /\ + (~v13 \/ ~v21 \/ v17) /\ + (~v13 \/ ~v20 \/ v16) /\ + (~v1 \/ ~v8 \/ v0) /\ + (~v1 \/ ~v9 \/ v1) /\ + (~v1 \/ ~v10 \/ v2) /\ + (~v1 \/ ~v19 \/ v25) /\ + (~v1 \/ ~v18 \/ v24) /\ + (~v4 \/ ~v8 \/ v3) /\ + (~v4 \/ ~v9 \/ v4) /\ + (~v4 \/ ~v10 \/ v5) /\ + (~v4 \/ ~v19 \/ v23) /\ + (~v4 \/ ~v18 \/ v22) /\ + (~v27 \/ ~v8 \/ v6) /\ + (~v27 \/ ~v9 \/ v27) /\ + (~v27 \/ ~v10 \/ v7) /\ + (~v27 \/ ~v19 \/ v21) /\ + (~v27 \/ ~v18 \/ v20) /\ + (~v9 \/ ~v8 \/ v8) /\ + (~v9 \/ ~v9 \/ v9) /\ + (~v9 \/ ~v10 \/ v10) /\ + (~v9 \/ ~v19 \/ v19) /\ + (~v9 \/ ~v18 \/ v18) /\ + (~v12 \/ ~v8 \/ v11) /\ + (~v12 \/ ~v9 \/ v12) /\ + (~v12 \/ ~v10 \/ v13) /\ + (~v12 \/ ~v19 \/ v17) /\ + (~v12 \/ ~v18 \/ v16) /\ + (~v0 \/ ~v11 \/ v0) /\ + (~v0 \/ ~v12 \/ v1) /\ + (~v0 \/ ~v13 \/ v2) /\ + (~v0 \/ ~v17 \/ v25) /\ + (~v0 \/ ~v16 \/ v24) /\ + (~v3 \/ ~v11 \/ v3) /\ + (~v3 \/ ~v12 \/ v4) /\ + (~v3 \/ ~v13 \/ v5) /\ + (~v3 \/ ~v17 \/ v23) /\ + (~v3 \/ ~v16 \/ v22) /\ + (~v6 \/ ~v11 \/ v6) /\ + (~v6 \/ ~v12 \/ v27) /\ + (~v6 \/ ~v13 \/ v7) /\ + (~v6 \/ ~v17 \/ v21) /\ + (~v6 \/ ~v16 \/ v20) /\ + (~v8 \/ ~v11 \/ v8) /\ + (~v8 \/ ~v12 \/ v9) /\ + (~v8 \/ ~v13 \/ v10) /\ + (~v8 \/ ~v17 \/ v19) /\ + (~v8 \/ ~v16 \/ v18) /\ + (~v11 \/ ~v11 \/ v11) /\ + (~v11 \/ ~v12 \/ v12) /\ + (~v11 \/ ~v13 \/ v13) /\ + (~v11 \/ ~v17 \/ v17) /\ + (~v11 \/ ~v16 \/ v16) /\ + (~v0 \/ ~v15 \/ v26) /\ + (~v1 \/ ~v15 \/ v28) /\ + (~v2 \/ ~v15 \/ v29) /\ + (~v25 \/ ~v15 \/ v14) /\ + (~v24 \/ ~v15 \/ v15) /\ + (~v3 \/ ~v14 \/ v26) /\ + (~v4 \/ ~v14 \/ v28) /\ + (~v5 \/ ~v14 \/ v29) /\ + (~v23 \/ ~v14 \/ v14) /\ + (~v22 \/ ~v14 \/ v15) /\ + (~v6 \/ ~v29 \/ v26) /\ + (~v27 \/ ~v29 \/ v28) /\ + (~v7 \/ ~v29 \/ v29) /\ + (~v21 \/ ~v29 \/ v14) /\ + (~v20 \/ ~v29 \/ v15) /\ + (~v8 \/ ~v28 \/ v26) /\ + (~v9 \/ ~v28 \/ v28) /\ + (~v10 \/ ~v28 \/ v29) /\ + (~v19 \/ ~v28 \/ v14) /\ + (~v18 \/ ~v28 \/ v15) /\ + (~v11 \/ ~v26 \/ v26) /\ + (~v12 \/ ~v26 \/ v28) /\ + (~v13 \/ ~v26 \/ v29) /\ + (~v17 \/ ~v26 \/ v14) /\ + (~v16 \/ ~v26 \/ v15) /\ + (v16 \/ v17) /\ + (v18 \/ v19) /\ + (v20 \/ v21) /\ + (v22 \/ v23) /\ + (v24 \/ v25) /\ + ~v26 /\ + ~v27 /\ + v28 /\ + v29)` ;; + +(* Hard *) +let aim_100_2_0_no_1 = +`~ +((v6 \/ v55 \/ v66) /\ + (v6 \/ v62 \/ ~v66) /\ + (~v62 \/ ~v66 \/ v68) /\ + (v6 \/ v8 \/ ~v55) /\ + (v8 \/ v58 \/ v70) /\ + (~v6 \/ v58 \/ ~v70) /\ + (~v6 \/ v33 \/ ~v58) /\ + (~v6 \/ v8 \/ ~v33) /\ + (~v8 \/ v61 \/ v68) /\ + (~v8 \/ ~v61 \/ v68) /\ + (v35 \/ v42 \/ v51) /\ + (v30 \/ ~v42 \/ v51) /\ + (v30 \/ ~v51 \/ v75) /\ + (v20 \/ ~v51 \/ ~v75) /\ + (~v20 \/ ~v51 \/ ~v75) /\ + (~v30 \/ v35 \/ ~v68) /\ + (v34 \/ ~v35 \/ v46) /\ + (~v35 \/ v46 \/ v86) /\ + (~v34 \/ v46 \/ ~v68) /\ + (~v35 \/ ~v46 \/ ~v68) /\ + (~v31 \/ v42 \/ v91) /\ + (~v7 \/ v20 \/ v85) /\ + (~v20 \/ ~v24 \/ ~v42) /\ + (v18 \/ ~v85 \/ v91) /\ + (~v18 \/ ~v24 \/ ~v31) /\ + (~v24 \/ ~v31 \/ ~v91) /\ + (~v17 \/ v32 \/ v60) /\ + (~v17 \/ v39 \/ ~v60) /\ + (v36 \/ v50 \/ v56) /\ + (~v50 \/ v56 \/ v91) /\ + (~v44 \/ v52 \/ ~v54) /\ + (~v52 \/ v53 \/ ~v54) /\ + (v71 \/ v79 \/ ~v97) /\ + (v9 \/ v71 \/ ~v79) /\ + (~v8 \/ v34 \/ ~v71) /\ + (v34 \/ ~v71 \/ v95) /\ + (~v56 \/ v85 \/ ~v95) /\ + (~v71 \/ ~v85 \/ ~v95) /\ + (~v18 \/ ~v56 \/ v87) /\ + (~v52 \/ ~v56 \/ v87) /\ + (~v7 \/ ~v76 \/ ~v93) /\ + (v3 \/ v9 \/ v86) /\ + (v3 \/ ~v86 \/ ~v96) /\ + (v3 \/ v12 \/ v67) /\ + (~v9 \/ ~v40 \/ v67) /\ + (~v9 \/ v13 \/ ~v67) /\ + (~v9 \/ ~v67 \/ ~v88) /\ + (~v3 \/ v13 \/ ~v96) /\ + (v2 \/ v12 \/ v27) /\ + (~v33 \/ v36 \/ ~v74) /\ + (~v13 \/ ~v29 \/ ~v41) /\ + (v11 \/ v52 \/ ~v98) /\ + (~v50 \/ v90 \/ v92) /\ + (~v26 \/ ~v47 \/ ~v77) /\ + (v5 \/ v42 \/ ~v93) /\ + (v28 \/ v36 \/ ~v42) /\ + (v5 \/ v28 \/ ~v36) /\ + (~v28 \/ v45 \/ ~v73) /\ + (v5 \/ ~v45 \/ ~v73) /\ + (v7 \/ v25 \/ ~v86) /\ + (~v25 \/ v37 \/ ~v86) /\ + (v19 \/ ~v25 \/ ~v37) /\ + (v7 \/ ~v19 \/ v41) /\ + (v12 \/ ~v34 \/ ~v47) /\ + (~v12 \/ ~v34 \/ ~v47) /\ + (~v13 \/ ~v60 \/ v93) /\ + (v19 \/ ~v94 \/ v98) /\ + (v92 \/ ~v94 \/ ~v98) /\ + (v67 \/ ~v92 \/ ~v98) /\ + (v1 \/ v26 \/ v55) /\ + (v26 \/ ~v53 \/ v55) /\ + (v18 \/ ~v29 \/ v31) /\ + (~v1 \/ v69 \/ v94) /\ + (v23 \/ v69 \/ ~v93) /\ + (~v1 \/ ~v23 \/ v69) /\ + (~v19 \/ v29 \/ v43) /\ + (v33 \/ v37 \/ v62) /\ + (~v20 \/ ~v33 \/ v62) /\ + (~v18 \/ v39 \/ v65) /\ + (v45 \/ v51 \/ ~v53) /\ + (~v1 \/ v11 \/ ~v28) /\ + (v18 \/ v33 \/ v84) /\ + (~v14 \/ ~v52 \/ v84) /\ + (v7 \/ ~v40 \/ ~v53) /\ + (~v7 \/ ~v17 \/ ~v40) /\ + (~v19 \/ v65 \/ v72) /\ + (~v63 \/ v77 \/ ~v85) /\ + (v27 \/ ~v63 \/ ~v77) /\ + (~v4 \/ v64 \/ v94) /\ + (v22 \/ ~v82 \/ v99) /\ + (~v11 \/ v41 \/ ~v99) /\ + (~v11 \/ v85 \/ ~v99) /\ + (v4 \/ ~v65 \/ ~v87) /\ + (v17 \/ v37 \/ v100) /\ + (v25 \/ ~v37 \/ v100) /\ + (v17 \/ ~v25 \/ ~v37) /\ + (v83 \/ ~v89 \/ ~v100) /\ + (v15 \/ v17 \/ ~v89) /\ + (~v15 \/ ~v83 \/ ~v100) /\ + (~v39 \/ ~v74 \/ ~v90) /\ + (v19 \/ ~v26 \/ v40) /\ + (v41 \/ ~v70 \/ ~v99) /\ + (~v26 \/ ~v41 \/ ~v70) /\ + (~v28 \/ v59 \/ ~v62) /\ + (v4 \/ v78 \/ v90) /\ + (v4 \/ v21 \/ v78) /\ + (v39 \/ ~v49 \/ v63) /\ + (~v39 \/ ~v49 \/ ~v95) /\ + (v48 \/ ~v54 \/ v65) /\ + (v60 \/ v82 \/ v98) /\ + (v49 \/ ~v74 \/ v97) /\ + (~v21 \/ v49 \/ ~v97) /\ + (~v79 \/ v87 \/ ~v88) /\ + (v21 \/ v45 \/ ~v75) /\ + (v16 \/ ~v84 \/ ~v89) /\ + (~v21 \/ ~v46 \/ v63) /\ + (v14 \/ v16 \/ ~v81) /\ + (~v14 \/ ~v81 \/ ~v87) /\ + (~v66 \/ ~v67 \/ ~v83) /\ + (~v80 \/ v81 \/ v100) /\ + (v2 \/ ~v29 \/ v99) /\ + (~v2 \/ ~v39 \/ v99) /\ + (~v44 \/ ~v64 \/ ~v90) /\ + (~v13 \/ v14 \/ v23) /\ + (~v10 \/ ~v45 \/ ~v91) /\ + (v10 \/ v40 \/ v73) /\ + (v40 \/ ~v73 \/ ~v76) /\ + (v22 \/ ~v76 \/ v78) /\ + (v21 \/ ~v32 \/ ~v57) /\ + (~v38 \/ ~v64 \/ v86) /\ + (~v12 \/ ~v15 \/ v54) /\ + (~v12 \/ v47 \/ ~v69) /\ + (v47 \/ ~v69 \/ ~v82) /\ + (~v22 \/ ~v23 \/ v32) /\ + (~v22 \/ ~v23 \/ ~v78) /\ + (~v10 \/ v20 \/ ~v50) /\ + (~v5 \/ v10 \/ v84) /\ + (v23 \/ ~v92 \/ v97) /\ + (~v69 \/ v72 \/ ~v78) /\ + (v1 \/ v11 \/ ~v80) /\ + (~v2 \/ v27 \/ v50) /\ + (~v57 \/ ~v61 \/ ~v79) /\ + (v43 \/ v76 \/ ~v90) /\ + (~v22 \/ ~v49 \/ ~v92) /\ + (v26 \/ v43 \/ ~v60) /\ + (~v10 \/ v50 \/ v98) /\ + (v10 \/ ~v30 \/ v59) /\ + (~v55 \/ ~v72 \/ ~v100) /\ + (~v41 \/ v53 \/ ~v78) /\ + (v38 \/ ~v65 \/ v94) /\ + (v38 \/ ~v65 \/ ~v94) /\ + (v29 \/ ~v55 \/ v61) /\ + (~v46 \/ ~v48 \/ v59) /\ + (v53 \/ v73 \/ v90) /\ + (v1 \/ ~v11 \/ v74) /\ + (v15 \/ v76 \/ v82) /\ + (~v27 \/ ~v82 \/ ~v97) /\ + (~v3 \/ ~v36 \/ ~v48) /\ + (v28 \/ ~v32 \/ v80) /\ + (v9 \/ ~v63 \/ v80) /\ + (v70 \/ v73 \/ v89) /\ + (~v80 \/ ~v91 \/ v93) /\ + (v22 \/ ~v64 \/ v77) /\ + (v66 \/ v72 \/ ~v87) /\ + (~v36 \/ v83 \/ v88) /\ + (v24 \/ ~v38 \/ v52) /\ + (~v43 \/ v81 \/ ~v96) /\ + (~v59 \/ ~v62 \/ v81) /\ + (v48 \/ v66 \/ v71) /\ + (~v2 \/ v48 \/ v63) /\ + (v29 \/ ~v83 \/ v93) /\ + (~v16 \/ v25 \/ ~v72) /\ + (~v27 \/ v57 \/ ~v84) /\ + (~v5 \/ v77 \/ v88) /\ + (~v5 \/ ~v59 \/ v88) /\ + (v15 \/ v44 \/ ~v45) /\ + (v13 \/ ~v84 \/ v89) /\ + (v47 \/ ~v48 \/ v83) /\ + (~v14 \/ ~v44 \/ v54) /\ + (~v30 \/ v31 \/ v64) /\ + (v24 \/ v70 \/ v75) /\ + (~v15 \/ ~v32 \/ v92) /\ + (~v16 \/ ~v58 \/ v74) /\ + (~v4 \/ v54 \/ ~v77) /\ + (~v43 \/ v57 \/ v60) /\ + (~v16 \/ v61 \/ v64) /\ + (~v59 \/ v79 \/ v95) /\ + (~v4 \/ ~v61 \/ ~v88) /\ + (v58 \/ v74 \/ v80) /\ + (v49 \/ ~v58 \/ v82) /\ + (v16 \/ v44 \/ ~v57) /\ + (v2 \/ v89 \/ v95) /\ + (~v3 \/ ~v27 \/ ~v81) /\ + (v24 \/ v75 \/ v79) /\ + (v44 \/ v96 \/ v97) /\ + (v31 \/ ~v38 \/ v57) /\ + (v14 \/ ~v43 \/ ~v72) /\ + (v38 \/ v76 \/ v96) /\ + (v30 \/ v32 \/ v96) /\ + (~v21 \/ v35 \/ v56))` ;; + + +let aim_100_2_0_no_2 = +`~ +((v40 \/ v54 \/ v75) /\ + (~v40 \/ v54 \/ v58) /\ + (~v40 \/ ~v58 \/ v69) /\ + (~v40 \/ ~v69 \/ v95) /\ + (~v51 \/ ~v69 \/ v95) /\ + (v64 \/ v75 \/ v89) /\ + (v26 \/ ~v64 \/ v89) /\ + (v26 \/ ~v69 \/ ~v95) /\ + (~v26 \/ v75 \/ ~v95) /\ + (v11 \/ v28 \/ v82) /\ + (~v11 \/ v23 \/ v82) /\ + (v14 \/ ~v23 \/ v28) /\ + (~v11 \/ ~v14 \/ v28) /\ + (~v28 \/ ~v75 \/ v88) /\ + (~v28 \/ v84 \/ ~v88) /\ + (v62 \/ ~v75 \/ ~v84) /\ + (v12 \/ v51 \/ ~v62) /\ + (v12 \/ ~v51 \/ ~v62) /\ + (~v12 \/ v43 \/ v65) /\ + (~v12 \/ ~v65 \/ v82) /\ + (~v12 \/ ~v28 \/ ~v43) /\ + (v54 \/ ~v75 \/ ~v82) /\ + (~v54 \/ v77 \/ v86) /\ + (v8 \/ ~v86 \/ v94) /\ + (~v8 \/ v36 \/ ~v86) /\ + (~v8 \/ ~v36 \/ ~v86) /\ + (v24 \/ v77 \/ ~v94) /\ + (v4 \/ v7 \/ v78) /\ + (v4 \/ ~v78 \/ v84) /\ + (v4 \/ v7 \/ ~v84) /\ + (~v4 \/ v7 \/ ~v77) /\ + (~v7 \/ v63 \/ v76) /\ + (~v7 \/ v24 \/ ~v63) /\ + (~v7 \/ ~v55 \/ ~v63) /\ + (v24 \/ ~v76 \/ v93) /\ + (~v76 \/ ~v77 \/ ~v93) /\ + (v6 \/ ~v24 \/ v98) /\ + (v6 \/ v94 \/ ~v98) /\ + (~v6 \/ ~v54 \/ v94) /\ + (v62 \/ ~v94 \/ v96) /\ + (~v62 \/ ~v94 \/ v96) /\ + (~v54 \/ ~v88 \/ v96) /\ + (v20 \/ ~v24 \/ ~v96) /\ + (~v20 \/ ~v24 \/ ~v96) /\ + (v20 \/ v27 \/ v32) /\ + (~v20 \/ v27 \/ v32) /\ + (~v15 \/ ~v53 \/ v78) /\ + (v26 \/ v44 \/ ~v46) /\ + (~v26 \/ v44 \/ ~v89) /\ + (v12 \/ v35 \/ ~v39) /\ + (v1 \/ ~v51 \/ ~v80) /\ + (~v3 \/ v21 \/ v60) /\ + (~v3 \/ ~v48 \/ v60) /\ + (~v48 \/ ~v60 \/ v100) /\ + (~v48 \/ ~v60 \/ v61) /\ + (~v60 \/ ~v61 \/ ~v100) /\ + (v9 \/ ~v22 \/ ~v93) /\ + (~v21 \/ v44 \/ v93) /\ + (~v44 \/ v46 \/ v69) /\ + (~v46 \/ v69 \/ v93) /\ + (v13 \/ ~v46 \/ ~v85) /\ + (~v13 \/ ~v44 \/ ~v85) /\ + (v41 \/ v43 \/ v84) /\ + (~v41 \/ v43 \/ v87) /\ + (~v37 \/ v49 \/ v74) /\ + (~v29 \/ ~v37 \/ ~v70) /\ + (~v37 \/ v49 \/ ~v74) /\ + (v33 \/ v35 \/ v41) /\ + (~v15 \/ v33 \/ v41) /\ + (~v5 \/ ~v43 \/ ~v85) /\ + (~v92 \/ ~v93 \/ ~v98) /\ + (v15 \/ v50 \/ v63) /\ + (~v21 \/ ~v58 \/ v87) /\ + (v25 \/ ~v39 \/ ~v97) /\ + (~v25 \/ v51 \/ ~v97) /\ + (~v25 \/ ~v39 \/ ~v97) /\ + (~v4 \/ ~v38 \/ ~v52) /\ + (v59 \/ v79 \/ v95) /\ + (v14 \/ v59 \/ ~v79) /\ + (v76 \/ ~v89 \/ v99) /\ + (v40 \/ v76 \/ ~v99) /\ + (v40 \/ ~v76 \/ ~v89) /\ + (~v5 \/ ~v22 \/ v46) /\ + (~v31 \/ v86 \/ v100) /\ + (v10 \/ v31 \/ v62) /\ + (v14 \/ v31 \/ v58) /\ + (v10 \/ v31 \/ ~v58) /\ + (~v30 \/ v42 \/ ~v67) /\ + (~v21 \/ ~v30 \/ v42) /\ + (~v30 \/ v42 \/ ~v77) /\ + (v5 \/ ~v11 \/ v13) /\ + (v11 \/ ~v26 \/ v92) /\ + (v15 \/ v38 \/ v83) /\ + (~v13 \/ v56 \/ ~v100) /\ + (~v16 \/ v47 \/ v87) /\ + (v47 \/ v83 \/ ~v87) /\ + (v6 \/ ~v35 \/ v92) /\ + (~v6 \/ ~v65 \/ v92) /\ + (v61 \/ v66 \/ ~v82) /\ + (~v1 \/ ~v18 \/ v68) /\ + (~v18 \/ v52 \/ ~v68) /\ + (v32 \/ v64 \/ ~v96) /\ + (~v8 \/ v35 \/ ~v67) /\ + (v10 \/ ~v83 \/ ~v90) /\ + (~v10 \/ ~v32 \/ ~v91) /\ + (v20 \/ v68 \/ v72) /\ + (v16 \/ v85 \/ ~v95) /\ + (v9 \/ v29 \/ v30) /\ + (~v1 \/ ~v29 \/ v30) /\ + (v39 \/ v45 \/ v51) /\ + (v39 \/ v45 \/ ~v82) /\ + (v19 \/ v70 \/ v88) /\ + (~v19 \/ ~v45 \/ v88) /\ + (~v36 \/ ~v45 \/ ~v70) /\ + (~v59 \/ ~v70 \/ ~v81) /\ + (~v1 \/ ~v52 \/ v81) /\ + (v15 \/ ~v35 \/ v55) /\ + (~v18 \/ ~v45 \/ v48) /\ + (~v35 \/ ~v53 \/ ~v68) /\ + (v16 \/ ~v38 \/ ~v64) /\ + (v27 \/ v46 \/ v57) /\ + (v9 \/ ~v27 \/ v57) /\ + (~v32 \/ ~v43 \/ v70) /\ + (~v23 \/ v34 \/ ~v67) /\ + (v55 \/ v85 \/ ~v92) /\ + (v18 \/ ~v25 \/ v48) /\ + (~v36 \/ v67 \/ ~v78) /\ + (~v59 \/ v66 \/ v86) /\ + (~v4 \/ ~v44 \/ v60) /\ + (~v20 \/ ~v31 \/ ~v78) /\ + (~v61 \/ ~v80 \/ v97) /\ + (v21 \/ ~v84 \/ v91) /\ + (v22 \/ v52 \/ ~v90) /\ + (v73 \/ ~v83 \/ ~v98) /\ + (v13 \/ v80 \/ ~v91) /\ + (v1 \/ ~v15 \/ v19) /\ + (v64 \/ v83 \/ v90) /\ + (v16 \/ v33 \/ v99) /\ + (~v16 \/ ~v65 \/ v99) /\ + (~v16 \/ v53 \/ ~v74) /\ + (v53 \/ ~v63 \/ v85) /\ + (v17 \/ v61 \/ ~v80) /\ + (v3 \/ v17 \/ ~v61) /\ + (~v41 \/ v74 \/ ~v83) /\ + (v47 \/ ~v72 \/ ~v73) /\ + (v8 \/ v30 \/ v72) /\ + (~v27 \/ ~v34 \/ v53) /\ + (v1 \/ v56 \/ v97) /\ + (v29 \/ ~v68 \/ v79) /\ + (v67 \/ ~v73 \/ ~v92) /\ + (v18 \/ ~v57 \/ v89) /\ + (v22 \/ v36 \/ v91) /\ + (~v14 \/ ~v23 \/ v56) /\ + (~v52 \/ v68 \/ v100) /\ + (v37 \/ ~v38 \/ ~v50) /\ + (~v13 \/ ~v33 \/ v57) /\ + (v55 \/ v58 \/ v59) /\ + (v19 \/ v36 \/ v37) /\ + (~v19 \/ v78 \/ v97) /\ + (v3 \/ ~v14 \/ v37) /\ + (~v5 \/ ~v57 \/ v98) /\ + (~v9 \/ v72 \/ ~v87) /\ + (v48 \/ ~v90 \/ ~v99) /\ + (v23 \/ ~v55 \/ ~v99) /\ + (v39 \/ ~v64 \/ ~v81) /\ + (v66 \/ v81 \/ ~v87) /\ + (~v17 \/ ~v41 \/ v90) /\ + (~v17 \/ ~v53 \/ ~v57) /\ + (~v47 \/ ~v79 \/ v80) /\ + (~v3 \/ ~v42 \/ ~v56) /\ + (v3 \/ ~v27 \/ ~v33) /\ + (~v6 \/ v22 \/ ~v34) /\ + (~v22 \/ ~v34 \/ v81) /\ + (~v2 \/ v23 \/ v73) /\ + (v29 \/ ~v55 \/ ~v59) /\ + (~v10 \/ v65 \/ ~v79) /\ + (v34 \/ v63 \/ v79) /\ + (v67 \/ ~v71 \/ ~v88) /\ + (v38 \/ ~v50 \/ v90) /\ + (~v10 \/ v25 \/ v98) /\ + (v52 \/ v73 \/ ~v91) /\ + (v45 \/ ~v73 \/ v91) /\ + (v25 \/ v34 \/ v38) /\ + (~v9 \/ ~v47 \/ ~v72) /\ + (v5 \/ v8 \/ ~v17) /\ + (v2 \/ ~v32 \/ v71) /\ + (~v9 \/ v65 \/ v80) /\ + (~v47 \/ ~v49 \/ ~v66) /\ + (~v19 \/ ~v33 \/ ~v50) /\ + (~v42 \/ ~v56 \/ ~v66) /\ + (v17 \/ ~v56 \/ ~v74) /\ + (v5 \/ ~v31 \/ v77) /\ + (v2 \/ v11 \/ ~v100) /\ + (v18 \/ ~v49 \/ v71) /\ + (v2 \/ ~v2 \/ v49) /\ + (v50 \/ v70 \/ ~v72) /\ + (v21 \/ ~v42 \/ v74) /\ + (~v49 \/ ~v71 \/ ~v81) /\ + (~v29 \/ ~v66 \/ v71) /\ + (~v2 \/ v50 \/ ~v71))` ;; + +let prv001_1 = +`~((~v0 \/ ~v111 \/ v47) /\ + (~v1 \/ ~v111 \/ v37) /\ + (~v2 \/ ~v111 \/ v28) /\ + (~v114 \/ ~v113 \/ v46) /\ + (~v3 \/ ~v113 \/ v36) /\ + (~v4 \/ ~v113 \/ v27) /\ + (~v5 \/ ~v105 \/ v44) /\ + (~v6 \/ ~v105 \/ v35) /\ + (~v7 \/ ~v105 \/ v26) /\ + (~v8 \/ ~v112 \/ v51) /\ + (~v9 \/ ~v112 \/ v40) /\ + (~v10 \/ ~v112 \/ v31) /\ + (~v11 \/ ~v109 \/ v50) /\ + (~v12 \/ ~v109 \/ v39) /\ + (~v13 \/ ~v109 \/ v30) /\ + (~v14 \/ ~v106 \/ v48) /\ + (~v15 \/ ~v106 \/ v38) /\ + (~v16 \/ ~v106 \/ v29) /\ + (~v17 \/ ~v103 \/ v56) /\ + (~v18 \/ ~v103 \/ v43) /\ + (~v19 \/ ~v103 \/ v34) /\ + (~v20 \/ ~v107 \/ v54) /\ + (~v21 \/ ~v107 \/ v42) /\ + (~v22 \/ ~v107 \/ v33) /\ + (~v23 \/ ~v102 \/ v53) /\ + (~v24 \/ ~v102 \/ v41) /\ + (~v25 \/ ~v102 \/ v32) /\ + (~v0 \/ v111 \/ v80) /\ + (~v1 \/ v111 \/ v69) /\ + (~v2 \/ v111 \/ v60) /\ + (~v114 \/ v113 \/ v86) /\ + (~v3 \/ v113 \/ v72) /\ + (~v4 \/ v113 \/ v63) /\ + (~v5 \/ v105 \/ v91) /\ + (~v6 \/ v105 \/ v75) /\ + (~v7 \/ v105 \/ v66) /\ + (~v8 \/ v112 \/ v78) /\ + (~v9 \/ v112 \/ v68) /\ + (~v10 \/ v112 \/ v59) /\ + (~v11 \/ v109 \/ v84) /\ + (~v12 \/ v109 \/ v71) /\ + (~v13 \/ v109 \/ v62) /\ + (~v14 \/ v106 \/ v89) /\ + (~v15 \/ v106 \/ v74) /\ + (~v16 \/ v106 \/ v65) /\ + (~v17 \/ v103 \/ v76) /\ + (~v18 \/ v103 \/ v67) /\ + (~v19 \/ v103 \/ v58) /\ + (~v20 \/ v107 \/ v82) /\ + (~v21 \/ v107 \/ v70) /\ + (~v22 \/ v107 \/ v61) /\ + (~v23 \/ v102 \/ v87) /\ + (~v24 \/ v102 \/ v73) /\ + (~v25 \/ v102 \/ v64) /\ + (~v26 \/ v45) /\ + (~v27 \/ v108) /\ + (~v28 \/ v81) /\ + (~v29 \/ v49) /\ + (~v30 \/ v85) /\ + (~v31 \/ v52) /\ + (~v32 \/ v88) /\ + (~v33 \/ v55) /\ + (~v34 \/ v57) /\ + (~v35 \/ v45) /\ + (~v36 \/ v108) /\ + (~v37 \/ v81) /\ + (~v38 \/ v49) /\ + (~v39 \/ v85) /\ + (~v40 \/ v52) /\ + (~v41 \/ v88) /\ + (~v42 \/ v55) /\ + (~v43 \/ v57) /\ + (~v44 \/ v45) /\ + (~v46 \/ v108) /\ + (~v47 \/ v81) /\ + (~v48 \/ v49) /\ + (~v50 \/ v85) /\ + (~v51 \/ v52) /\ + (~v53 \/ v88) /\ + (~v54 \/ v55) /\ + (~v56 \/ v57) /\ + (~v58 \/ v77) /\ + (~v59 \/ v79) /\ + (~v60 \/ v81) /\ + (~v61 \/ v83) /\ + (~v62 \/ v85) /\ + (~v63 \/ v110) /\ + (~v64 \/ v88) /\ + (~v65 \/ v90) /\ + (~v66 \/ v92) /\ + (~v67 \/ v77) /\ + (~v68 \/ v79) /\ + (~v69 \/ v81) /\ + (~v70 \/ v83) /\ + (~v71 \/ v85) /\ + (~v72 \/ v110) /\ + (~v73 \/ v88) /\ + (~v74 \/ v90) /\ + (~v75 \/ v92) /\ + (~v76 \/ v77) /\ + (~v78 \/ v79) /\ + (~v80 \/ v81) /\ + (~v82 \/ v83) /\ + (~v84 \/ v85) /\ + (~v86 \/ v110) /\ + (~v87 \/ v88) /\ + (~v89 \/ v90) /\ + (~v91 \/ v92) /\ + v102 /\ + v109 /\ + v111 /\ + (~v105 \/ ~v103 \/ v93) /\ + (~v113 \/ ~v112 \/ v94) /\ + (~v111 \/ ~v111 \/ v95) /\ + (~v106 \/ ~v107 \/ v96) /\ + (~v109 \/ ~v109 \/ v97) /\ + (~v112 \/ ~v113 \/ v98) /\ + (~v102 \/ ~v102 \/ v99) /\ + (~v107 \/ ~v106 \/ v100) /\ + (~v103 \/ ~v105 \/ v101) /\ + (~v111 \/ ~v105 \/ v105) /\ + (~v111 \/ ~v113 \/ v113) /\ + (~v111 \/ ~v111 \/ v111) /\ + (~v112 \/ ~v105 \/ v106) /\ + (~v112 \/ ~v113 \/ v109) /\ + (~v112 \/ ~v111 \/ v112) /\ + (~v103 \/ ~v105 \/ v102) /\ + (~v103 \/ ~v113 \/ v107) /\ + (~v103 \/ ~v111 \/ v103) /\ + (~v113 \/ ~v106 \/ v105) /\ + (~v113 \/ ~v109 \/ v113) /\ + (~v113 \/ ~v112 \/ v111) /\ + (~v109 \/ ~v106 \/ v106) /\ + (~v109 \/ ~v109 \/ v109) /\ + (~v109 \/ ~v112 \/ v112) /\ + (~v107 \/ ~v106 \/ v102) /\ + (~v107 \/ ~v109 \/ v107) /\ + (~v107 \/ ~v112 \/ v103) /\ + (~v105 \/ ~v102 \/ v105) /\ + (~v105 \/ ~v107 \/ v113) /\ + (~v105 \/ ~v103 \/ v111) /\ + (~v106 \/ ~v102 \/ v106) /\ + (~v106 \/ ~v107 \/ v109) /\ + (~v106 \/ ~v103 \/ v112) /\ + (~v102 \/ ~v102 \/ v102) /\ + (~v102 \/ ~v107 \/ v107) /\ + (~v102 \/ ~v103 \/ v103) /\ + (v103 \/ v105) /\ + (v112 \/ v113) /\ + (v111 \/ v111) /\ + (v107 \/ v106) /\ + (v109 \/ v109) /\ + (v113 \/ v112) /\ + (v102 \/ v102) /\ + (v106 \/ v107) /\ + (v105 \/ v103) /\ + (~v93 \/ v105) /\ + (~v94 \/ v113) /\ + (~v95 \/ v111) /\ + (~v96 \/ v106) /\ + (~v97 \/ v109) /\ + (~v98 \/ v112) /\ + (~v99 \/ v102) /\ + (~v100 \/ v107) /\ + (~v101 \/ v103) /\ + (~v95 \/ ~v105 \/ v105) /\ + (~v95 \/ ~v113 \/ v113) /\ + (~v95 \/ ~v111 \/ v111) /\ + (~v94 \/ ~v105 \/ v106) /\ + (~v94 \/ ~v113 \/ v109) /\ + (~v94 \/ ~v111 \/ v112) /\ + (~v93 \/ ~v105 \/ v102) /\ + (~v93 \/ ~v113 \/ v107) /\ + (~v93 \/ ~v111 \/ v103) /\ + (~v98 \/ ~v106 \/ v105) /\ + (~v98 \/ ~v109 \/ v113) /\ + (~v98 \/ ~v112 \/ v111) /\ + (~v97 \/ ~v106 \/ v106) /\ + (~v97 \/ ~v109 \/ v109) /\ + (~v97 \/ ~v112 \/ v112) /\ + (~v96 \/ ~v106 \/ v102) /\ + (~v96 \/ ~v109 \/ v107) /\ + (~v96 \/ ~v112 \/ v103) /\ + (~v101 \/ ~v102 \/ v105) /\ + (~v101 \/ ~v107 \/ v113) /\ + (~v101 \/ ~v103 \/ v111) /\ + (~v100 \/ ~v102 \/ v106) /\ + (~v100 \/ ~v107 \/ v109) /\ + (~v100 \/ ~v103 \/ v112) /\ + (~v99 \/ ~v102 \/ v102) /\ + (~v99 \/ ~v107 \/ v107) /\ + (~v99 \/ ~v103 \/ v103) /\ + (~v93 \/ ~v111 \/ v105) /\ + (~v94 \/ ~v111 \/ v113) /\ + (~v95 \/ ~v111 \/ v111) /\ + (~v93 \/ ~v112 \/ v106) /\ + (~v94 \/ ~v112 \/ v109) /\ + (~v95 \/ ~v112 \/ v112) /\ + (~v93 \/ ~v103 \/ v102) /\ + (~v94 \/ ~v103 \/ v107) /\ + (~v95 \/ ~v103 \/ v103) /\ + (~v96 \/ ~v113 \/ v105) /\ + (~v97 \/ ~v113 \/ v113) /\ + (~v98 \/ ~v113 \/ v111) /\ + (~v96 \/ ~v109 \/ v106) /\ + (~v97 \/ ~v109 \/ v109) /\ + (~v98 \/ ~v109 \/ v112) /\ + (~v96 \/ ~v107 \/ v102) /\ + (~v97 \/ ~v107 \/ v107) /\ + (~v98 \/ ~v107 \/ v103) /\ + (~v99 \/ ~v105 \/ v105) /\ + (~v100 \/ ~v105 \/ v113) /\ + (~v101 \/ ~v105 \/ v111) /\ + (~v99 \/ ~v106 \/ v106) /\ + (~v100 \/ ~v106 \/ v109) /\ + (~v101 \/ ~v106 \/ v112) /\ + (~v99 \/ ~v102 \/ v102) /\ + (~v100 \/ ~v102 \/ v107) /\ + (~v101 \/ ~v102 \/ v103) /\ + (~v104 \/ ~v105 \/ ~v106 \/ ~v103) /\ + (~v108 \/ ~v113 \/ ~v109 \/ ~v112) /\ + (~v110 \/ ~v111 \/ ~v112 \/ ~v111) /\ + (~v104 \/ ~v105 \/ ~v106 \/ ~v107) /\ + (~v108 \/ ~v113 \/ ~v109 \/ ~v109) /\ + (~v110 \/ ~v111 \/ ~v112 \/ ~v113) /\ + v114)` ;; + +let ssa0432_003 = +`~ +((v435) /\ + (v174) /\ + (~v175) /\ + (v173) /\ + (~v39 \/ ~v433) /\ + (v37 \/ ~v433) /\ + (v39 \/ ~v434) /\ + (~v37 \/ ~v434) /\ + (~v434 \/ v432) /\ + (~v433 \/ v432) /\ + (~v79 \/ ~v37) /\ + (~v67 \/ ~v37) /\ + (~v68 \/ v38) /\ + (~v68 \/ ~v79) /\ + (~v79 \/ ~v39) /\ + (~v69 \/ ~v39) /\ + (~v76 \/ ~v67) /\ + (~v71 \/ ~v67) /\ + (~v74 \/ ~v67) /\ + (~v138 \/ ~v67) /\ + (~v72 \/ v68) /\ + (~v72 \/ ~v138) /\ + (~v72 \/ ~v74) /\ + (~v72 \/ ~v76) /\ + (~v76 \/ ~v69) /\ + (~v73 \/ ~v69) /\ + (~v74 \/ ~v69) /\ + (~v138 \/ ~v69) /\ + (v75 \/ ~v138) /\ + (~v75 \/ v138) /\ + (v75 \/ ~v139) /\ + (~v75 \/ v139) /\ + (v75 \/ ~v147) /\ + (~v75 \/ v147) /\ + (~v311 \/ ~v75) /\ + (~v307 \/ ~v75) /\ + (v312 \/ v307) /\ + (~v312 \/ ~v307) /\ + (v15 \/ ~v315) /\ + (~v15 \/ v315) /\ + (v15 \/ ~v316) /\ + (~v15 \/ v316) /\ + (v53 \/ ~v93) /\ + (~v53 \/ v93) /\ + (v53 \/ ~v94) /\ + (~v53 \/ v94) /\ + (v53 \/ ~v98) /\ + (~v53 \/ v98) /\ + (v53 \/ ~v102) /\ + (~v53 \/ v102) /\ + (v53 \/ ~v105) /\ + (~v53 \/ v105) /\ + (v53 \/ ~v119) /\ + (~v53 \/ v119) /\ + (v53 \/ ~v121) /\ + (~v53 \/ v121) /\ + (v53 \/ ~v124) /\ + (~v53 \/ v124) /\ + (v53 \/ ~v129) /\ + (~v53 \/ v129) /\ + (v53 \/ ~v169) /\ + (~v53 \/ v169) /\ + (v53 \/ ~v207) /\ + (~v53 \/ v207) /\ + (v53 \/ ~v221) /\ + (~v53 \/ v221) /\ + (v53 \/ ~v244) /\ + (~v53 \/ v244) /\ + (v53 \/ ~v250) /\ + (~v53 \/ v250) /\ + (v53 \/ ~v304) /\ + (~v53 \/ v304) /\ + (v53 \/ ~v314) /\ + (~v53 \/ v314) /\ + (v53 \/ ~v330) /\ + (~v53 \/ v330) /\ + (v53 \/ ~v343) /\ + (~v53 \/ v343) /\ + (v53 \/ ~v345) /\ + (~v53 \/ v345) /\ + (v53 \/ ~v360) /\ + (~v53 \/ v360) /\ + (v53 \/ ~v378) /\ + (~v53 \/ v378) /\ + (v60 \/ v53) /\ + (v263 \/ v53) /\ + (v176 \/ v53) /\ + (v182 \/ v53) /\ + (v188 \/ v182) /\ + (~v188 \/ ~v182) /\ + (v104 \/ ~v187) /\ + (~v104 \/ v187) /\ + (v104 \/ ~v188) /\ + (~v104 \/ v188) /\ + (~v196 \/ ~v104) /\ + (~v191 \/ ~v104) /\ + (~v193 \/ ~v104) /\ + (v184 \/ ~v192) /\ + (~v184 \/ v192) /\ + (v184 \/ ~v193) /\ + (~v184 \/ v193) /\ + (v184 \/ ~v200) /\ + (~v184 \/ v200) /\ + (v184 \/ ~v203) /\ + (~v184 \/ v203) /\ + (v34 \/ v184) /\ + (~v34 \/ ~v184) /\ + (v12 \/ ~v190) /\ + (~v12 \/ v190) /\ + (v12 \/ ~v191) /\ + (~v12 \/ v191) /\ + (v189 \/ ~v196) /\ + (~v189 \/ v196) /\ + (v189 \/ ~v197) /\ + (~v189 \/ v197) /\ + (~v271 \/ ~v422) /\ + (v195 \/ ~v422) /\ + (v271 \/ ~v423) /\ + (~v195 \/ ~v423) /\ + (~v423 \/ v189) /\ + (~v422 \/ v189) /\ + (v42 \/ ~v80) /\ + (~v42 \/ v80) /\ + (v42 \/ ~v81) /\ + (~v42 \/ v81) /\ + (v42 \/ ~v84) /\ + (~v42 \/ v84) /\ + (v42 \/ ~v101) /\ + (~v42 \/ v101) /\ + (v42 \/ ~v112) /\ + (~v42 \/ v112) /\ + (v42 \/ ~v166) /\ + (~v42 \/ v166) /\ + (v42 \/ ~v195) /\ + (~v42 \/ v195) /\ + (v42 \/ ~v218) /\ + (~v42 \/ v218) /\ + (v42 \/ ~v241) /\ + (~v42 \/ v241) /\ + (v42 \/ ~v259) /\ + (~v42 \/ v259) /\ + (v42 \/ ~v291) /\ + (~v42 \/ v291) /\ + (v42 \/ ~v303) /\ + (~v42 \/ v303) /\ + (v42 \/ ~v313) /\ + (~v42 \/ v313) /\ + (v42 \/ ~v323) /\ + (~v42 \/ v323) /\ + (v42 \/ ~v344) /\ + (~v42 \/ v344) /\ + (v42 \/ ~v349) /\ + (~v42 \/ v349) /\ + (v42 \/ ~v357) /\ + (~v42 \/ v357) /\ + (v42 \/ ~v385) /\ + (~v42 \/ v385) /\ + (v42 \/ ~v404) /\ + (~v42 \/ v404) /\ + (v286 \/ v42) /\ + (v267 \/ v42) /\ + (v43 \/ v42) /\ + (v278 \/ v42) /\ + (v347 \/ v278) /\ + (~v347 \/ ~v278) /\ + (v279 \/ ~v347) /\ + (~v279 \/ v347) /\ + (v279 \/ ~v348) /\ + (~v279 \/ v348) /\ + (~v369 \/ ~v279) /\ + (~v370 \/ ~v279) /\ + (v281 \/ ~v284) /\ + (~v281 \/ v284) /\ + (v281 \/ ~v285) /\ + (~v281 \/ v285) /\ + (v281 \/ ~v301) /\ + (~v281 \/ v301) /\ + (v281 \/ ~v370) /\ + (~v281 \/ v370) /\ + (v26 \/ v281) /\ + (~v26 \/ ~v281) /\ + (v7 \/ ~v368) /\ + (~v7 \/ v368) /\ + (v7 \/ ~v369) /\ + (~v7 \/ v369) /\ + (~v110 \/ ~v43) /\ + (~v46 \/ ~v43) /\ + (v41 \/ ~v45) /\ + (~v41 \/ v45) /\ + (v41 \/ ~v46) /\ + (~v41 \/ v46) /\ + (~v219 \/ ~v41) /\ + (~v211 \/ ~v41) /\ + (v204 \/ ~v211) /\ + (~v204 \/ v211) /\ + (v204 \/ ~v212) /\ + (~v204 \/ v212) /\ + (v214 \/ v204) /\ + (~v214 \/ ~v204) /\ + (v32 \/ ~v214) /\ + (~v32 \/ v214) /\ + (v32 \/ ~v215) /\ + (~v32 \/ v215) /\ + (v32 \/ ~v228) /\ + (~v32 \/ v228) /\ + (v5 \/ ~v219) /\ + (~v5 \/ v219) /\ + (v5 \/ ~v220) /\ + (~v5 \/ v220) /\ + (v44 \/ ~v110) /\ + (~v44 \/ v110) /\ + (v44 \/ ~v111) /\ + (~v44 \/ v111) /\ + (~v358 \/ ~v44) /\ + (~v355 \/ ~v44) /\ + (v350 \/ ~v353) /\ + (~v350 \/ v353) /\ + (v350 \/ ~v354) /\ + (~v350 \/ v354) /\ + (v350 \/ ~v355) /\ + (~v350 \/ v355) /\ + (v350 \/ ~v367) /\ + (~v350 \/ v367) /\ + (v9 \/ v350) /\ + (~v9 \/ ~v350) /\ + (v21 \/ ~v358) /\ + (~v21 \/ v358) /\ + (v21 \/ ~v359) /\ + (~v21 \/ v359) /\ + (~v270 \/ ~v267) /\ + (~v268 \/ ~v267) /\ + (~v272 \/ ~v267) /\ + (v194 \/ ~v271) /\ + (~v194 \/ v271) /\ + (v194 \/ ~v272) /\ + (~v194 \/ v272) /\ + (~v202 \/ ~v194) /\ + (~v203 \/ ~v194) /\ + (v25 \/ ~v201) /\ + (~v25 \/ v201) /\ + (v25 \/ ~v202) /\ + (~v25 \/ v202) /\ + (v331 \/ v268) /\ + (v324 \/ v268) /\ + (v332 \/ v268) /\ + (v402 \/ v332) /\ + (~v402 \/ ~v332) /\ + (v391 \/ ~v402) /\ + (~v391 \/ v402) /\ + (v391 \/ ~v403) /\ + (~v391 \/ v403) /\ + (~v400 \/ ~v391) /\ + (~v401 \/ ~v391) /\ + (v392 \/ ~v397) /\ + (~v392 \/ v397) /\ + (v392 \/ ~v398) /\ + (~v392 \/ v398) /\ + (v392 \/ ~v401) /\ + (~v392 \/ v401) /\ + (v392 \/ ~v409) /\ + (~v392 \/ v409) /\ + (v19 \/ v392) /\ + (~v19 \/ ~v392) /\ + (v17 \/ ~v399) /\ + (~v17 \/ v399) /\ + (v17 \/ ~v400) /\ + (~v17 \/ v400) /\ + (v326 \/ v324) /\ + (~v326 \/ ~v324) /\ + (v322 \/ ~v325) /\ + (~v322 \/ v325) /\ + (v322 \/ ~v326) /\ + (~v322 \/ v326) /\ + (~v389 \/ ~v322) /\ + (~v390 \/ ~v322) /\ + (v235 \/ ~v386) /\ + (~v235 \/ v386) /\ + (v235 \/ ~v387) /\ + (~v235 \/ v387) /\ + (v235 \/ ~v390) /\ + (~v235 \/ v390) /\ + (v383 \/ v235) /\ + (~v383 \/ ~v235) /\ + (v35 \/ ~v382) /\ + (~v35 \/ v382) /\ + (v35 \/ ~v383) /\ + (~v35 \/ v383) /\ + (v30 \/ ~v388) /\ + (~v30 \/ v388) /\ + (v30 \/ ~v389) /\ + (~v30 \/ v389) /\ + (v334 \/ v331) /\ + (~v334 \/ ~v331) /\ + (v83 \/ ~v333) /\ + (~v83 \/ v333) /\ + (v83 \/ ~v334) /\ + (~v83 \/ v334) /\ + (~v320 \/ ~v83) /\ + (~v321 \/ ~v83) /\ + (v86 \/ ~v91) /\ + (~v86 \/ v91) /\ + (v86 \/ ~v92) /\ + (~v86 \/ v92) /\ + (v86 \/ ~v158) /\ + (~v86 \/ v158) /\ + (v86 \/ ~v321) /\ + (~v86 \/ v321) /\ + (v28 \/ v86) /\ + (~v28 \/ ~v86) /\ + (v4 \/ ~v317) /\ + (~v4 \/ v317) /\ + (v4 \/ ~v320) /\ + (~v4 \/ v320) /\ + (v237 \/ ~v269) /\ + (~v237 \/ v269) /\ + (v237 \/ ~v270) /\ + (~v237 \/ v270) /\ + (~v242 \/ ~v237) /\ + (~v239 \/ ~v237) /\ + (v232 \/ ~v238) /\ + (~v232 \/ v238) /\ + (v232 \/ ~v239) /\ + (~v232 \/ v239) /\ + (v253 \/ v232) /\ + (~v253 \/ ~v232) /\ + (v6 \/ ~v253) /\ + (~v6 \/ v253) /\ + (v6 \/ ~v254) /\ + (~v6 \/ v254) /\ + (v6 \/ ~v258) /\ + (~v6 \/ v258) /\ + (v10 \/ ~v242) /\ + (~v10 \/ v242) /\ + (v10 \/ ~v243) /\ + (~v10 \/ v243) /\ + (v289 \/ v286) /\ + (~v289 \/ ~v286) /\ + (v287 \/ ~v289) /\ + (~v287 \/ v289) /\ + (v287 \/ ~v290) /\ + (~v287 \/ v290) /\ + (~v372 \/ ~v287) /\ + (~v373 \/ ~v287) /\ + (v292 \/ ~v295) /\ + (~v292 \/ v295) /\ + (v292 \/ ~v296) /\ + (~v292 \/ v296) /\ + (v292 \/ ~v311) /\ + (~v292 \/ v311) /\ + (v292 \/ ~v373) /\ + (~v292 \/ v373) /\ + (v27 \/ v292) /\ + (~v27 \/ ~v292) /\ + (v11 \/ ~v371) /\ + (~v11 \/ v371) /\ + (v11 \/ ~v372) /\ + (~v11 \/ v372) /\ + (~v180 \/ ~v176) /\ + (~v328 \/ ~v176) /\ + (~v276 \/ ~v176) /\ + (v178 \/ ~v276) /\ + (~v178 \/ v276) /\ + (v178 \/ ~v277) /\ + (~v178 \/ v277) /\ + (v178 \/ ~v342) /\ + (~v178 \/ v342) /\ + (~v405 \/ ~v178) /\ + (~v396 \/ ~v178) /\ + (~v398 \/ ~v178) /\ + (v18 \/ ~v395) /\ + (~v18 \/ v395) /\ + (v18 \/ ~v396) /\ + (~v18 \/ v396) /\ + (v394 \/ ~v405) /\ + (~v394 \/ v405) /\ + (v394 \/ ~v406) /\ + (~v394 \/ v406) /\ + (~v403 \/ ~v410) /\ + (v404 \/ ~v410) /\ + (v403 \/ ~v411) /\ + (~v404 \/ ~v411) /\ + (~v411 \/ v394) /\ + (~v410 \/ v394) /\ + (v177 \/ ~v328) /\ + (~v177 \/ v328) /\ + (v177 \/ ~v329) /\ + (~v177 \/ v329) /\ + (~v337 \/ ~v177) /\ + (~v376 \/ ~v177) /\ + (~v386 \/ ~v177) /\ + (v22 \/ ~v376) /\ + (~v22 \/ v376) /\ + (v22 \/ ~v377) /\ + (~v22 \/ v377) /\ + (v234 \/ ~v337) /\ + (~v234 \/ v337) /\ + (v234 \/ ~v338) /\ + (~v234 \/ v338) /\ + (~v325 \/ ~v416) /\ + (v323 \/ ~v416) /\ + (v325 \/ ~v417) /\ + (~v323 \/ ~v417) /\ + (~v417 \/ v234) /\ + (~v416 \/ v234) /\ + (v85 \/ ~v179) /\ + (~v85 \/ v179) /\ + (v85 \/ ~v180) /\ + (~v85 \/ v180) /\ + (~v89 \/ ~v85) /\ + (~v172 \/ ~v85) /\ + (~v91 \/ ~v85) /\ + (v23 \/ ~v172) /\ + (~v23 \/ v172) /\ + (v23 \/ ~v173) /\ + (~v23 \/ v173) /\ + (v82 \/ ~v89) /\ + (~v82 \/ v89) /\ + (v82 \/ ~v90) /\ + (~v82 \/ v90) /\ + (~v333 \/ ~v428) /\ + (v84 \/ ~v428) /\ + (v333 \/ ~v429) /\ + (~v84 \/ ~v429) /\ + (~v429 \/ v82) /\ + (~v428 \/ v82) /\ + (v181 \/ ~v263) /\ + (~v181 \/ v263) /\ + (v181 \/ ~v264) /\ + (~v181 \/ v264) /\ + (v248 \/ v181) /\ + (~v248 \/ ~v181) /\ + (v233 \/ ~v248) /\ + (~v233 \/ v248) /\ + (v233 \/ ~v249) /\ + (~v233 \/ v249) /\ + (~v261 \/ ~v233) /\ + (~v245 \/ ~v233) /\ + (~v238 \/ ~v233) /\ + (v33 \/ ~v245) /\ + (~v33 \/ v245) /\ + (v33 \/ ~v246) /\ + (~v33 \/ v246) /\ + (v236 \/ ~v261) /\ + (~v236 \/ v261) /\ + (v236 \/ ~v262) /\ + (~v236 \/ v262) /\ + (~v269 \/ ~v420) /\ + (v259 \/ ~v420) /\ + (v269 \/ ~v421) /\ + (~v259 \/ ~v421) /\ + (~v421 \/ v236) /\ + (~v420 \/ v236) /\ + (~v65 \/ ~v60) /\ + (~v122 \/ ~v60) /\ + (~v117 \/ ~v60) /\ + (~v127 \/ ~v60) /\ + (v63 \/ ~v127) /\ + (~v63 \/ v127) /\ + (v63 \/ ~v128) /\ + (~v63 \/ v128) /\ + (v63 \/ ~v206) /\ + (~v63 \/ v206) /\ + (~v210 \/ ~v63) /\ + (~v222 \/ ~v63) /\ + (~v212 \/ ~v63) /\ + (v29 \/ ~v222) /\ + (~v29 \/ v222) /\ + (v29 \/ ~v223) /\ + (~v29 \/ v223) /\ + (v40 \/ ~v209) /\ + (~v40 \/ v209) /\ + (v40 \/ ~v210) /\ + (~v40 \/ v210) /\ + (~v45 \/ ~v430) /\ + (v80 \/ ~v430) /\ + (v45 \/ ~v431) /\ + (~v80 \/ ~v431) /\ + (~v431 \/ v40) /\ + (~v430 \/ v40) /\ + (v62 \/ ~v117) /\ + (~v62 \/ v117) /\ + (v62 \/ ~v118) /\ + (~v62 \/ v118) /\ + (v62 \/ ~v120) /\ + (~v62 \/ v120) /\ + (~v283 \/ ~v62) /\ + (~v305 \/ ~v62) /\ + (~v285 \/ ~v62) /\ + (v31 \/ ~v305) /\ + (~v31 \/ v305) /\ + (v31 \/ ~v306) /\ + (~v31 \/ v306) /\ + (v280 \/ ~v282) /\ + (~v280 \/ v282) /\ + (v280 \/ ~v283) /\ + (~v280 \/ v283) /\ + (~v348 \/ ~v412) /\ + (v349 \/ ~v412) /\ + (v348 \/ ~v413) /\ + (~v349 \/ ~v413) /\ + (~v413 \/ v280) /\ + (~v412 \/ v280) /\ + (v61 \/ ~v122) /\ + (~v61 \/ v122) /\ + (v61 \/ ~v123) /\ + (~v61 \/ v123) /\ + (~v351 \/ ~v61) /\ + (~v361 \/ ~v61) /\ + (~v353 \/ ~v61) /\ + (v20 \/ ~v361) /\ + (~v20 \/ v361) /\ + (v20 \/ ~v362) /\ + (~v20 \/ v362) /\ + (v109 \/ ~v351) /\ + (~v109 \/ v351) /\ + (v109 \/ ~v352) /\ + (~v109 \/ v352) /\ + (~v111 \/ ~v424) /\ + (v112 \/ ~v424) /\ + (v111 \/ ~v425) /\ + (~v112 \/ ~v425) /\ + (~v425 \/ v109) /\ + (~v424 \/ v109) /\ + (v52 \/ ~v64) /\ + (~v52 \/ v64) /\ + (v52 \/ ~v65) /\ + (~v52 \/ v65) /\ + (~v293 \/ ~v52) /\ + (~v315 \/ ~v52) /\ + (~v295 \/ ~v52) /\ + (v288 \/ ~v293) /\ + (~v288 \/ v293) /\ + (v288 \/ ~v294) /\ + (~v288 \/ v294) /\ + (~v290 \/ ~v418) /\ + (v291 \/ ~v418) /\ + (v290 \/ ~v419) /\ + (~v291 \/ ~v419) /\ + (~v419 \/ v288) /\ + (~v418 \/ v288) /\ + (v2 \/ ~v309) /\ + (~v2 \/ v309) /\ + (v2 \/ ~v310) /\ + (~v2 \/ v310) /\ + (v58 \/ ~v185) /\ + (~v58 \/ v185) /\ + (v58 \/ ~v186) /\ + (~v58 \/ v186) /\ + (v58 \/ ~v231) /\ + (~v58 \/ v231) /\ + (v58 \/ ~v298) /\ + (~v58 \/ v298) /\ + (v58 \/ ~v308) /\ + (~v58 \/ v308) /\ + (v58 \/ ~v364) /\ + (~v58 \/ v364) /\ + (v58 \/ ~v375) /\ + (~v58 \/ v375) /\ + (v58 \/ ~v393) /\ + (~v58 \/ v393) /\ + (v49 \/ v58) /\ + (v59 \/ v58) /\ + (v54 \/ v58) /\ + (~v57 \/ ~v54) /\ + (~v209 \/ ~v57) /\ + (~v208 \/ ~v57) /\ + (v226 \/ v208) /\ + (v215 \/ v208) /\ + (v213 \/ ~v226) /\ + (~v213 \/ v226) /\ + (v213 \/ ~v227) /\ + (~v213 \/ v227) /\ + (v14 \/ v213) /\ + (~v14 \/ ~v213) /\ + (v126 \/ v125) /\ + (~v126 \/ ~v125) /\ + (~v128 \/ ~v126) /\ + (~v129 \/ ~v126) /\ + (v206 \/ v205) /\ + (v207 \/ v205) /\ + (~v352 \/ ~v56) /\ + (~v365 \/ ~v56) /\ + (~v354 \/ ~v56) /\ + (v8 \/ ~v365) /\ + (~v8 \/ v365) /\ + (v8 \/ ~v366) /\ + (~v8 \/ v366) /\ + (~v95 \/ ~v59) /\ + (~v87 \/ ~v59) /\ + (~v96 \/ ~v59) /\ + (v336 \/ v96) /\ + (v346 \/ v336) /\ + (~v406 \/ ~v346) /\ + (~v408 \/ ~v346) /\ + (~v409 \/ ~v346) /\ + (v3 \/ ~v407) /\ + (~v3 \/ v407) /\ + (v3 \/ ~v408) /\ + (~v3 \/ v408) /\ + (~v342 \/ ~v341) /\ + (~v343 \/ ~v341) /\ + (~v274 \/ ~v273) /\ + (~v275 \/ ~v273) /\ + (v78 \/ ~v265) /\ + (~v78 \/ v265) /\ + (v78 \/ ~v266) /\ + (~v78 \/ v266) /\ + (v78 \/ ~v275) /\ + (~v78 \/ v275) /\ + (v98 \/ v78) /\ + (~v98 \/ ~v78) /\ + (v277 \/ v274) /\ + (~v277 \/ ~v274) /\ + (v379 \/ v335) /\ + (v382 \/ v335) /\ + (v381 \/ v379) /\ + (~v381 \/ ~v379) /\ + (v1 \/ ~v380) /\ + (~v1 \/ v380) /\ + (v1 \/ ~v381) /\ + (~v1 \/ v381) /\ + (~v329 \/ ~v414) /\ + (v330 \/ ~v414) /\ + (v329 \/ ~v415) /\ + (~v330 \/ ~v415) /\ + (~v415 \/ v327) /\ + (~v414 \/ v327) /\ + (~v88 \/ ~v87) /\ + (~v90 \/ ~v87) /\ + (~v156 \/ ~v87) /\ + (~v92 \/ ~v87) /\ + (v16 \/ ~v156) /\ + (~v16 \/ v156) /\ + (v16 \/ ~v157) /\ + (~v16 \/ v157) /\ + (~v179 \/ ~v426) /\ + (v94 \/ ~v426) /\ + (v179 \/ ~v427) /\ + (~v94 \/ ~v427) /\ + (~v427 \/ v88) /\ + (~v426 \/ v88) /\ + (v106 \/ v95) /\ + (~v106 \/ ~v95) /\ + (~v108 \/ ~v106) /\ + (~v262 \/ ~v108) /\ + (~v255 \/ ~v108) /\ + (v257 \/ v255) /\ + (v258 \/ v255) /\ + (v251 \/ ~v256) /\ + (~v251 \/ v256) /\ + (v251 \/ ~v257) /\ + (~v251 \/ v257) /\ + (v13 \/ v251) /\ + (~v13 \/ ~v251) /\ + (v264 \/ v260) /\ + (v266 \/ v260) /\ + (v249 \/ v247) /\ + (v250 \/ v247) /\ + (~v197 \/ ~v107) /\ + (~v199 \/ ~v107) /\ + (~v200 \/ ~v107) /\ + (v36 \/ ~v198) /\ + (~v36 \/ v198) /\ + (v36 \/ ~v199) /\ + (~v36 \/ v199) /\ + (~v47 \/ ~v49) /\ + (v48 \/ v47) /\ + (~v48 \/ ~v47) /\ + (v115 \/ v48) /\ + (~v282 \/ ~v115) /\ + (~v299 \/ ~v115) /\ + (~v284 \/ ~v115) /\ + (v24 \/ ~v299) /\ + (~v24 \/ v299) /\ + (v24 \/ ~v300) /\ + (~v24 \/ v300) /\ + (~v120 \/ ~v114) /\ + (~v121 \/ ~v114) /\ + (v116 \/ v113) /\ + (~v116 \/ ~v113) /\ + (v118 \/ v116) /\ + (v119 \/ v116) /\ + (~v294 \/ ~v51) /\ + (~v309 \/ ~v51) /\ + (~v296 \/ ~v51) /\ + (v229 \/ v74) /\ + (v230 \/ v74) /\ + (v66 \/ ~v132) /\ + (~v66 \/ v132) /\ + (v66 \/ ~v133) /\ + (~v66 \/ v133) /\ + (v66 \/ ~v135) /\ + (~v66 \/ v135) /\ + (v66 \/ ~v230) /\ + (~v66 \/ v230) /\ + (v216 \/ v66) /\ + (~v216 \/ ~v66) /\ + (~v356 \/ ~v216) /\ + (v363 \/ v356) /\ + (~v363 \/ ~v356) /\ + (~v367 \/ ~v363) /\ + (v131 \/ ~v136) /\ + (~v131 \/ v136) /\ + (v131 \/ ~v137) /\ + (~v131 \/ v137) /\ + (v131 \/ ~v140) /\ + (~v131 \/ v140) /\ + (v131 \/ ~v148) /\ + (~v131 \/ v148) /\ + (v131 \/ ~v229) /\ + (~v131 \/ v229) /\ + (v302 \/ v131) /\ + (v297 \/ v131) /\ + (~v301 \/ ~v297) /\ + (v146 \/ v71) /\ + (v141 \/ v71) /\ + (v149 \/ v71) /\ + (~v142 \/ v72) /\ + (~v142 \/ v149) /\ + (~v142 \/ v146) /\ + (v146 \/ v73) /\ + (v143 \/ v73) /\ + (v149 \/ v73) /\ + (v144 \/ ~v149) /\ + (~v144 \/ v149) /\ + (v144 \/ ~v150) /\ + (~v144 \/ v150) /\ + (v152 \/ v144) /\ + (~v152 \/ ~v144) /\ + (v134 \/ ~v151) /\ + (~v134 \/ v151) /\ + (v134 \/ ~v152) /\ + (~v134 \/ v152) /\ + (~v240 \/ ~v134) /\ + (v254 \/ v240) /\ + (v97 \/ ~v224) /\ + (~v97 \/ v224) /\ + (v97 \/ ~v225) /\ + (~v97 \/ v225) /\ + (v97 \/ ~v252) /\ + (~v97 \/ v252) /\ + (v231 \/ v97) /\ + (~v231 \/ ~v97) /\ + (~v163 \/ ~v141) /\ + (~v160 \/ v142) /\ + (~v160 \/ v153) /\ + (~v154 \/ ~v163) /\ + (~v160 \/ ~v163) /\ + (~v163 \/ ~v143) /\ + (v99 \/ ~v162) /\ + (~v99 \/ v162) /\ + (v99 \/ ~v163) /\ + (~v99 \/ v163) /\ + (~v100 \/ ~v99) /\ + (v183 \/ v100) /\ + (~v183 \/ ~v100) /\ + (~v192 \/ ~v183) /\ + (~v158 \/ ~v153) /\ + (~v174 \/ v160) /\ + (~v174 \/ v169) /\ + (~v318 \/ v166) /\ + (~v167 \/ v317) /\ + (v130 \/ ~v145) /\ + (~v130 \/ v145) /\ + (v130 \/ ~v146) /\ + (~v130 \/ v146) /\ + (v228 \/ v130) /\ + (v217 \/ v130) /\ + (v70 \/ ~v76) /\ + (~v70 \/ v76) /\ + (v70 \/ ~v77) /\ + (~v70 \/ v77) /\ + (~v339 \/ ~v70) /\ + (v340 \/ v339) /\ + (~v340 \/ ~v339) /\ + (~v397 \/ ~v340) /\ + (~v384 \/ ~v79) /\ + (~v387 \/ ~v79) /\ + (v374 \/ v384) /\ + (~v374 \/ ~v384) /\ + (~v432 \/ v435) /\ + (~v435 \/ v432) /\ + (v433 \/ v39 \/ ~v37) /\ + (v434 \/ ~v39 \/ v37) /\ + (~v432 \/ v434 \/ v433) /\ + (v37 \/ v79 \/ v67) /\ + (~v38 \/ v37 \/ v39) /\ + (~v38 \/ ~v37 \/ ~v39) /\ + (v39 \/ v79 \/ v69) /\ + (~v68 \/ v67 \/ v69) /\ + (~v68 \/ ~v67 \/ ~v69) /\ + (~v310 \/ ~v308 \/ ~v75) /\ + (~v371 \/ ~v313 \/ ~v312) /\ + (~v316 \/ ~v314 \/ ~v312) /\ + (v314 \/ v313 \/ v312) /\ + (v316 \/ v313 \/ v312) /\ + (v314 \/ v371 \/ v312) /\ + (v316 \/ v371 \/ v312) /\ + (v422 \/ v271 \/ ~v195) /\ + (v423 \/ ~v271 \/ v195) /\ + (~v189 \/ v423 \/ v422) /\ + (v279 \/ v369 \/ v370) /\ + (v43 \/ v110 \/ v46) /\ + (v41 \/ v219 \/ v211) /\ + (v44 \/ v358 \/ v355) /\ + (v194 \/ v202 \/ v203) /\ + (v391 \/ v400 \/ v401) /\ + (v322 \/ v389 \/ v390) /\ + (v83 \/ v320 \/ v321) /\ + (v237 \/ v242 \/ v239) /\ + (v287 \/ v372 \/ v373) /\ + (v410 \/ v403 \/ ~v404) /\ + (v411 \/ ~v403 \/ v404) /\ + (~v394 \/ v411 \/ v410) /\ + (v416 \/ v325 \/ ~v323) /\ + (v417 \/ ~v325 \/ v323) /\ + (~v234 \/ v417 \/ v416) /\ + (v428 \/ v333 \/ ~v84) /\ + (v429 \/ ~v333 \/ v84) /\ + (~v82 \/ v429 \/ v428) /\ + (v420 \/ v269 \/ ~v259) /\ + (v421 \/ ~v269 \/ v259) /\ + (~v236 \/ v421 \/ v420) /\ + (v430 \/ v45 \/ ~v80) /\ + (v431 \/ ~v45 \/ v80) /\ + (~v40 \/ v431 \/ v430) /\ + (v412 \/ v348 \/ ~v349) /\ + (v413 \/ ~v348 \/ v349) /\ + (~v280 \/ v413 \/ v412) /\ + (v424 \/ v111 \/ ~v112) /\ + (v425 \/ ~v111 \/ v112) /\ + (~v109 \/ v425 \/ v424) /\ + (v418 \/ v290 \/ ~v291) /\ + (v419 \/ ~v290 \/ v291) /\ + (~v288 \/ v419 \/ v418) /\ + (~v56 \/ ~v55 \/ ~v54) /\ + (v57 \/ v55 \/ v54) /\ + (v57 \/ v56 \/ v54) /\ + (~v125 \/ ~v205 \/ ~v57) /\ + (~v208 \/ ~v226 \/ ~v215) /\ + (v126 \/ v128 \/ v129) /\ + (~v205 \/ ~v206 \/ ~v207) /\ + (v124 \/ v123 \/ v55) /\ + (~v124 \/ ~v123 \/ v55) /\ + (~v124 \/ v123 \/ ~v55) /\ + (v124 \/ ~v123 \/ ~v55) /\ + (~v336 \/ ~v327 \/ ~v96) /\ + (~v336 \/ ~v338 \/ ~v96) /\ + (~v336 \/ ~v335 \/ ~v96) /\ + (v341 \/ v273 \/ v336) /\ + (~v346 \/ ~v273 \/ ~v336) /\ + (~v346 \/ ~v341 \/ ~v336) /\ + (v341 \/ v342 \/ v343) /\ + (v273 \/ v274 \/ v275) /\ + (~v335 \/ ~v379 \/ ~v382) /\ + (v414 \/ v329 \/ ~v330) /\ + (v415 \/ ~v329 \/ v330) /\ + (~v327 \/ v415 \/ v414) /\ + (v426 \/ v179 \/ ~v94) /\ + (v427 \/ ~v179 \/ v94) /\ + (~v88 \/ v427 \/ v426) /\ + (~v107 \/ ~v103 \/ ~v106) /\ + (v108 \/ v103 \/ v106) /\ + (v108 \/ v107 \/ v106) /\ + (~v260 \/ ~v247 \/ ~v108) /\ + (~v255 \/ ~v257 \/ ~v258) /\ + (~v260 \/ ~v264 \/ ~v266) /\ + (~v247 \/ ~v249 \/ ~v250) /\ + (v105 \/ v187 \/ v103) /\ + (~v105 \/ ~v187 \/ v103) /\ + (~v105 \/ v187 \/ ~v103) /\ + (v105 \/ ~v187 \/ ~v103) /\ + (~v51 \/ ~v50 \/ ~v49) /\ + (v47 \/ v50 \/ v49) /\ + (v47 \/ v51 \/ v49) /\ + (v114 \/ v113 \/ v48) /\ + (~v115 \/ ~v113 \/ ~v48) /\ + (~v115 \/ ~v114 \/ ~v48) /\ + (v114 \/ v120 \/ v121) /\ + (~v116 \/ ~v118 \/ ~v119) /\ + (v93 \/ v64 \/ v50) /\ + (~v93 \/ ~v64 \/ v50) /\ + (~v93 \/ v64 \/ ~v50) /\ + (v93 \/ ~v64 \/ ~v50) /\ + (~v74 \/ ~v229 \/ ~v230) /\ + (~v359 \/ ~v357 \/ ~v216) /\ + (~v362 \/ ~v360 \/ ~v216) /\ + (~v366 \/ ~v364 \/ ~v363) /\ + (v367 \/ v364 \/ v363) /\ + (v367 \/ v366 \/ v363) /\ + (~v131 \/ ~v302 \/ ~v297) /\ + (~v300 \/ ~v298 \/ ~v297) /\ + (v301 \/ v298 \/ v297) /\ + (v301 \/ v300 \/ v297) /\ + (~v368 \/ ~v303 \/ ~v302) /\ + (~v306 \/ ~v304 \/ ~v302) /\ + (v304 \/ v303 \/ v302) /\ + (v306 \/ v303 \/ v302) /\ + (v304 \/ v368 \/ v302) /\ + (v306 \/ v368 \/ v302) /\ + (~v72 \/ v71 \/ v73) /\ + (~v72 \/ ~v71 \/ ~v73) /\ + (~v243 \/ ~v241 \/ ~v134) /\ + (~v246 \/ ~v244 \/ ~v134) /\ + (v256 \/ v252 \/ v240) /\ + (~v254 \/ ~v252 \/ ~v240) /\ + (~v254 \/ ~v256 \/ ~v240) /\ + (~v153 \/ ~v159 \/ ~v141) /\ + (v163 \/ v159 \/ v141) /\ + (v163 \/ v153 \/ v141) /\ + (~v154 \/ ~v155 \/ v161) /\ + (~v154 \/ ~v153 \/ v159) /\ + (~v154 \/ v159 \/ v161) /\ + (~v142 \/ v141 \/ v143) /\ + (~v142 \/ ~v141 \/ ~v143) /\ + (~v153 \/ ~v161 \/ ~v143) /\ + (v163 \/ v161 \/ v143) /\ + (v163 \/ v153 \/ v143) /\ + (~v201 \/ ~v101 \/ ~v99) /\ + (~v190 \/ ~v102 \/ ~v99) /\ + (~v198 \/ ~v186 \/ ~v183) /\ + (v192 \/ v186 \/ v183) /\ + (v192 \/ v198 \/ v183) /\ + (~v157 \/ ~v185 \/ ~v153) /\ + (v158 \/ v185 \/ v153) /\ + (v158 \/ v157 \/ v153) /\ + (~v317 \/ ~v166 \/ ~v159) /\ + (~v173 \/ ~v169 \/ ~v159) /\ + (v169 \/ v166 \/ v159) /\ + (v173 \/ v166 \/ v159) /\ + (v169 \/ v317 \/ v159) /\ + (v173 \/ v317 \/ v159) /\ + (~v170 \/ ~v171 \/ v175) /\ + (~v170 \/ ~v169 \/ v173) /\ + (~v170 \/ v173 \/ v175) /\ + (~v174 \/ ~v317 \/ ~v166) /\ + (~v170 \/ ~v317 \/ ~v166) /\ + (~v160 \/ v159 \/ v161) /\ + (~v160 \/ ~v159 \/ ~v161) /\ + (~v317 \/ ~v166 \/ ~v161) /\ + (~v175 \/ ~v169 \/ ~v161) /\ + (v169 \/ v166 \/ v161) /\ + (v175 \/ v166 \/ v161) /\ + (v169 \/ v317 \/ v161) /\ + (v175 \/ v317 \/ v161) /\ + (v227 \/ v225 \/ v130) /\ + (~v220 \/ ~v218 \/ ~v217) /\ + (~v223 \/ ~v221 \/ ~v217) /\ + (v221 \/ v218 \/ v217) /\ + (v223 \/ v218 \/ v217) /\ + (v221 \/ v220 \/ v217) /\ + (v223 \/ v220 \/ v217) /\ + (~v399 \/ ~v344 \/ ~v70) /\ + (~v395 \/ ~v345 \/ ~v70) /\ + (~v407 \/ ~v393 \/ ~v340) /\ + (v397 \/ v393 \/ v340) /\ + (v397 \/ v407 \/ v340) /\ + (~v385 \/ ~v388 \/ ~v79) /\ + (~v375 \/ ~v380 \/ ~v374) /\ + (~v378 \/ ~v377 \/ ~v374) /\ + (v377 \/ v380 \/ v374) /\ + (v378 \/ v380 \/ v374) /\ + (v377 \/ v375 \/ v374) /\ + (v378 \/ v375 \/ v374) /\ + (v307 \/ v311 \/ v308 \/ v75) /\ + (v307 \/ v311 \/ v310 \/ v75) /\ + (v104 \/ v196 \/ v191 \/ v193) /\ + (v267 \/ v270 \/ v268 \/ v272) /\ + (~v268 \/ ~v331 \/ ~v324 \/ ~v332) /\ + (v176 \/ v180 \/ v328 \/ v276) /\ + (v178 \/ v405 \/ v396 \/ v398) /\ + (v177 \/ v337 \/ v376 \/ v386) /\ + (v85 \/ v89 \/ v172 \/ v91) /\ + (v233 \/ v261 \/ v245 \/ v238) /\ + (v63 \/ v210 \/ v222 \/ v212) /\ + (v62 \/ v283 \/ v305 \/ v285) /\ + (v61 \/ v351 \/ v361 \/ v353) /\ + (v52 \/ v293 \/ v315 \/ v295) /\ + (~v58 \/ ~v49 \/ ~v59 \/ ~v54) /\ + (v208 \/ v209 \/ v205 \/ v57) /\ + (v208 \/ v209 \/ v125 \/ v57) /\ + (v56 \/ v352 \/ v365 \/ v354) /\ + (v59 \/ v95 \/ v87 \/ v96) /\ + (v335 \/ v338 \/ v327 \/ v96) /\ + (v346 \/ v406 \/ v408 \/ v409) /\ + (v255 \/ v262 \/ v247 \/ v108) /\ + (v255 \/ v262 \/ v260 \/ v108) /\ + (v107 \/ v197 \/ v199 \/ v200) /\ + (v115 \/ v282 \/ v299 \/ v284) /\ + (v51 \/ v294 \/ v309 \/ v296) /\ + (v356 \/ v360 \/ v357 \/ v216) /\ + (v356 \/ v362 \/ v357 \/ v216) /\ + (v356 \/ v360 \/ v359 \/ v216) /\ + (v356 \/ v362 \/ v359 \/ v216) /\ + (~v71 \/ ~v146 \/ ~v141 \/ ~v149) /\ + (~v73 \/ ~v146 \/ ~v143 \/ ~v149) /\ + (v240 \/ v244 \/ v241 \/ v134) /\ + (v240 \/ v246 \/ v241 \/ v134) /\ + (v240 \/ v244 \/ v243 \/ v134) /\ + (v240 \/ v246 \/ v243 \/ v134) /\ + (~v164 \/ ~v153 \/ ~v165 \/ ~v159) /\ + (~v164 \/ ~v153 \/ ~v163 \/ ~v161) /\ + (~v164 \/ ~v153 \/ ~v159 \/ ~v161) /\ + (v100 \/ v102 \/ v101 \/ v99) /\ + (v100 \/ v190 \/ v101 \/ v99) /\ + (v100 \/ v102 \/ v201 \/ v99) /\ + (v100 \/ v190 \/ v201 \/ v99) /\ + (~v318 \/ ~v169 \/ ~v319 \/ ~v173) /\ + (~v318 \/ ~v169 \/ ~v317 \/ ~v175) /\ + (~v318 \/ ~v169 \/ ~v173 \/ ~v175) /\ + (~v167 \/ ~v169 \/ ~v168 \/ ~v173) /\ + (~v167 \/ ~v169 \/ ~v166 \/ ~v175) /\ + (~v167 \/ ~v169 \/ ~v173 \/ ~v175) /\ + (~v217 \/ ~v228 \/ ~v225 \/ ~v130) /\ + (~v217 \/ ~v228 \/ ~v227 \/ ~v130) /\ + (v339 \/ v345 \/ v344 \/ v70) /\ + (v339 \/ v395 \/ v344 \/ v70) /\ + (v339 \/ v345 \/ v399 \/ v70) /\ + (v339 \/ v395 \/ v399 \/ v70) /\ + (v387 \/ v384 \/ v388 \/ v79) /\ + (v387 \/ v384 \/ v385 \/ v79) /\ + (v67 \/ v76 \/ v71 \/ v74 \/ v138) /\ + (v69 \/ v76 \/ v73 \/ v74 \/ v138) /\ + (~v53 \/ ~v60 \/ ~v263 \/ ~v176 \/ ~v182) /\ + (~v42 \/ ~v286 \/ ~v267 \/ ~v43 \/ ~v278) /\ + (v60 \/ v65 \/ v122 \/ v117 \/ v127) /\ + (v87 \/ v88 \/ v90 \/ v156 \/ v92))` +;; + +let jnh211 = +`~ +((v7 \/ ~v9 \/ ~v29) /\ + (v13 \/ ~v35 \/ v44 \/ ~v45 \/ ~v48) /\ + (~v50 \/ v60) /\ + (v1 \/ v2 \/ v13 \/ v21 \/ ~v29 \/ ~v36 \/ ~v75) /\ + (v1 \/ ~v9 \/ v12 \/ ~v13 \/ v47 \/ v59 \/ v83 \/ ~v84) /\ + (~v13 \/ v29 \/ v47 \/ ~v53 \/ ~v97) /\ + (v32 \/ ~v54 \/ ~v58 \/ ~v70) /\ + (~v7 \/ v24 \/ v48) /\ + (v31 \/ v94) /\ + (~v3 \/ ~v5 \/ v11 \/ v59 \/ ~v90 \/ ~v99) /\ + (~v6 \/ v41) /\ + (~v2 \/ v17 \/ ~v28 \/ v67 \/ v68 \/ ~v77 \/ ~v100) /\ + (v37 \/ v61 \/ v78 \/ v88 \/ v89 \/ ~v92) /\ + (v31 \/ ~v70 \/ v73 \/ ~v79 \/ v82) /\ + (~v4 \/ v28 \/ v37 \/ ~v75 \/ v91) /\ + (v81 \/ ~v88 \/ v97) /\ + (~v2 \/ v23 \/ ~v31 \/ ~v48 \/ v66) /\ + (~v20 \/ v57 \/ ~v61 \/ ~v83 \/ v86 \/ v92 \/ ~v99) /\ + (~v35 \/ v38 \/ ~v50 \/ v63 \/ ~v68 \/ ~v84 \/ v87 \/ ~v90) /\ + (v22 \/ v34 \/ ~v56 \/ ~v65 \/ v76 \/ ~v77 \/ ~v95) /\ + (v14 \/ ~v42 \/ v44 \/ v83) /\ + (v32 \/ v87) /\ + (~v22 \/ ~v51 \/ ~v77) /\ + (~v70 \/ v85) /\ + (~v3 \/ ~v15 \/ v44 \/ ~v50 \/ ~v92) /\ + (v3 \/ v10 \/ v37 \/ ~v41 \/ ~v60 \/ ~v69 \/ v89) /\ + (~v37 \/ v45 \/ ~v83 \/ ~v97) /\ + (~v31 \/ v44 \/ v69) /\ + (v13 \/ ~v19 \/ ~v29 \/ v36) /\ + (v8 \/ v44 \/ v54 \/ ~v82 \/ v98) /\ + (v61 \/ ~v62 \/ ~v84) /\ + (~v23 \/ ~v74 \/ ~v85 \/ ~v90) /\ + (v12 \/ v64 \/ ~v77 \/ ~v92) /\ + (v17 \/ v22 \/ v38 \/ v40 \/ ~v48 \/ ~v66 \/ v69 \/ ~v79 \/ v94) /\ + (v19 \/ v24 \/ v39 \/ ~v76 \/ ~v88 \/ ~v94) /\ + (v37 \/ ~v57 \/ v71 \/ ~v73 \/ ~v93) /\ + (v79 \/ ~v80 \/ v92) /\ + (v1 \/ v12 \/ ~v14 \/ ~v18 \/ v45 \/ v61 \/ v63 \/ ~v85 \/ v88 \/ v90) /\ + (~v6 \/ v19 \/ v68 \/ ~v73) /\ + (~v11 \/ ~v46 \/ ~v85 \/ v89) /\ + (~v31 \/ ~v43 \/ v63 \/ ~v73) /\ + (v26 \/ ~v62 \/ ~v71 \/ v77) /\ + (~v14 \/ ~v23 \/ ~v30 \/ v34 \/ ~v47 \/ v71 \/ v73) /\ + (~v13 \/ v16 \/ ~v31 \/ v81 \/ v94) /\ + (~v6 \/ ~v56 \/ ~v85 \/ ~v96) /\ + (~v7 \/ v27 \/ ~v32 \/ v35 \/ ~v74) /\ + (v3 \/ v6 \/ ~v8 \/ ~v17 \/ ~v43 \/ ~v54 \/ v65) /\ + (v4 \/ ~v53 \/ v58 \/ ~v71 \/ v89 \/ ~v99) /\ + (v36 \/ v92 \/ v97) /\ + (~v1 \/ v11 \/ v29 \/ v36 \/ v37 \/ v98) /\ + (~v31 \/ v34 \/ ~v47 \/ ~v64) /\ + (~v26 \/ v80 \/ v88 \/ v91 \/ v98) /\ + (v10 \/ ~v21 \/ v43 \/ v62 \/ ~v68 \/ ~v85 \/ ~v87) /\ + (v71 \/ ~v88 \/ ~v93 \/ v96) /\ + (~v4 \/ ~v63) /\ + (~v21 \/ v36 \/ ~v61 \/ v79 \/ v82 \/ v88) /\ + (v21 \/ v32 \/ ~v66 \/ ~v95) /\ + (v37 \/ ~v51 \/ v86 \/ ~v88) /\ + (v3 \/ v25 \/ v34 \/ v74 \/ v95 \/ v96) /\ + (v35 \/ v76 \/ v91) /\ + (~v24 \/ v90 \/ ~v93) /\ + (~v19 \/ ~v23) /\ + (v27 \/ v58 \/ ~v75) /\ + (~v9 \/ v31 \/ ~v54 \/ ~v58 \/ ~v70) /\ + (v2 \/ ~v5 \/ ~v49 \/ v51 \/ ~v52 \/ v62 \/ ~v66 \/ ~v69 \/ v73) /\ + (v11 \/ ~v22 \/ ~v33 \/ v72 \/ v96 \/ v99) /\ + (v12 \/ v30 \/ ~v35) /\ + (~v39 \/ v44 \/ v48 \/ ~v60 \/ v62 \/ v66) /\ + (~v3 \/ v20 \/ ~v45 \/ v67 \/ v71 \/ v83 \/ ~v100) /\ + (v13 \/ v23 \/ ~v32 \/ ~v84) /\ + (v9 \/ v13 \/ ~v16 \/ ~v64) /\ + (v13 \/ ~v28 \/ v39 \/ v45 \/ v48 \/ v50 \/ ~v64 \/ ~v80) /\ + (~v18 \/ ~v42 \/ ~v47 \/ ~v60) /\ + (v24 \/ v29 \/ ~v32 \/ ~v45 \/ ~v87 \/ ~v92 \/ ~v99) /\ + (v13 \/ ~v15 \/ ~v18 \/ ~v39 \/ ~v62) /\ + (~v4 \/ v51) /\ + (v6 \/ v70 \/ v94) /\ + (v44 \/ v45 \/ ~v60 \/ v98) /\ + (v12 \/ ~v21 \/ v42 \/ v58) /\ + (v3 \/ ~v15 \/ v19 \/ v21 \/ ~v24 \/ v32) /\ + (v13 \/ v19 \/ ~v56) /\ + (~v4 \/ ~v78) /\ + (v3 \/ v4 \/ ~v45 \/ ~v49 \/ ~v53 \/ v80) /\ + (~v4 \/ v17 \/ ~v82 \/ ~v92) /\ + (v34 \/ ~v39 \/ ~v56 \/ v63 \/ v68 \/ ~v73 \/ v83) /\ + (v20 \/ ~v22 \/ ~v27 \/ v31 \/ v37 \/ v48 \/ v57 \/ v100) /\ + (~v9 \/ ~v22 \/ v26 \/ v38 \/ ~v41 \/ v47 \/ ~v53 \/ v73) /\ + (v74 \/ v91) /\ + (~v5 \/ ~v59 \/ ~v79 \/ ~v82 \/ ~v98) /\ + (~v2 \/ ~v46 \/ ~v76 \/ ~v85) /\ + (~v19 \/ ~v23 \/ v64 \/ v75 \/ ~v76 \/ ~v86 \/ ~v89 \/ v92 \/ ~v100) /\ + (~v12 \/ v25 \/ ~v59 \/ v74 \/ v96) /\ + (~v3 \/ ~v5 \/ v29 \/ v57 \/ ~v67 \/ ~v75 \/ ~v80) /\ + (~v14 \/ ~v17 \/ ~v42 \/ v55) /\ + (v18 \/ ~v58 \/ v62) /\ + (~v6 \/ v31 \/ v54 \/ v59) /\ + (v12 \/ ~v66) /\ + (v12 \/ ~v26 \/ ~v41 \/ v46) /\ + (v36 \/ v78) /\ + (~v1 \/ ~v13 \/ v30) /\ + (v30 \/ ~v36 \/ v58 \/ v59 \/ ~v71) /\ + (v2 \/ ~v22 \/ v26 \/ ~v41 \/ v55 \/ v58 \/ v60 \/ v92) /\ + (~v24 \/ v44 \/ v64 \/ v67 \/ v68 \/ ~v100) /\ + (v18 \/ ~v32 \/ v54) /\ + (~v9 \/ v41 \/ v52 \/ ~v98) /\ + (~v25 \/ ~v57 \/ v60) /\ + (v20 \/ v21 \/ v73) /\ + (v30 \/ v49 \/ v51 \/ v53 \/ v88 \/ ~v97 \/ v100) /\ + (v47 \/ v52 \/ ~v94) /\ + (~v25 \/ ~v38 \/ ~v48) /\ + (v8 \/ v19 \/ v76 \/ ~v85 \/ ~v97) /\ + (~v7 \/ v13 \/ ~v49) /\ + (v3 \/ v22 \/ v23 \/ ~v58 \/ v67 \/ v77) /\ + (v10 \/ ~v15 \/ ~v34 \/ v36 \/ v41 \/ ~v47) /\ + (v44 \/ ~v46 \/ ~v79 \/ ~v99) /\ + (v26 \/ v28 \/ ~v43 \/ v45 \/ v81) /\ + (~v51 \/ ~v73 \/ ~v83) /\ + (v2 \/ ~v46 \/ ~v69 \/ ~v84) /\ + (~v28 \/ ~v41 \/ v63) /\ + (v4 \/ ~v5 \/ ~v19 \/ v29 \/ ~v60 \/ ~v62 \/ ~v85 \/ v87 \/ ~v88) /\ + (v5 \/ v14 \/ ~v26 \/ ~v30 \/ v66) /\ + (~v2 \/ ~v47 \/ v78) /\ + (v11 \/ v14 \/ v43 \/ v99) /\ + (~v2 \/ v89 \/ v100) /\ + (v68 \/ ~v82 \/ v86 \/ ~v97) /\ + (v7 \/ v8 \/ ~v24 \/ v28 \/ v30 \/ v51 \/ ~v58 \/ ~v67 \/ ~v84 \/ ~v89) /\ + (v36 \/ v51) /\ + (~v17 \/ ~v42 \/ v53 \/ v54 \/ ~v69 \/ ~v72 \/ v99) /\ + (v31 \/ v34 \/ v56 \/ ~v71 \/ ~v80) /\ + (v31 \/ ~v52 \/ v64 \/ ~v65) /\ + (v17 \/ ~v23 \/ ~v35 \/ ~v56 \/ v58 \/ v59 \/ ~v61 \/ v63 \/ v64 \/ ~v66 \/ ~v71) /\ + (~v9 \/ v30 \/ ~v51) /\ + (v2 \/ v3 \/ v22 \/ v37 \/ ~v60 \/ ~v69 \/ v81 \/ v92) /\ + (v8 \/ ~v44 \/ ~v94) /\ + (v9 \/ ~v37 \/ v55 \/ ~v73) /\ + (v30 \/ v47 \/ ~v87 \/ v92) /\ + (v12 \/ v26 \/ ~v41 \/ ~v57 \/ ~v65 \/ v93) /\ + (v41 \/ ~v45 \/ ~v84 \/ v90) /\ + (~v6 \/ ~v13) /\ + (v31 \/ v45 \/ ~v56 \/ v67) /\ + (v1 \/ v33 \/ ~v79 \/ ~v84) /\ + (v14 \/ v21 \/ v30 \/ v32 \/ v37 \/ v48 \/ ~v62 \/ ~v65 \/ v75) /\ + (~v6 \/ ~v33 \/ v41 \/ v50) /\ + (~v12 \/ v17 \/ ~v37 \/ ~v68 \/ ~v77 \/ v88 \/ v89 \/ v96) /\ + (~v28 \/ ~v60 \/ v79 \/ ~v84 \/ v95) /\ + (~v12 \/ v37 \/ ~v54 \/ v95 \/ v99) /\ + (v2 \/ v35 \/ ~v68 \/ ~v81 \/ v100) /\ + (v4 \/ ~v10 \/ v13 \/ v31 \/ ~v33 \/ ~v83) /\ + (v18 \/ v80 \/ v90) /\ + (~v31 \/ ~v69 \/ v89) /\ + (v51 \/ v52 \/ ~v57 \/ ~v71 \/ v79 \/ ~v81) /\ + (v35 \/ v63) /\ + (~v13 \/ v17 \/ ~v39 \/ v43 \/ ~v75 \/ v86) /\ + (~v35 \/ v58 \/ ~v73 \/ ~v78 \/ ~v82 \/ v95 \/ v100) /\ + (~v36 \/ v60 \/ ~v67) /\ + (v33 \/ ~v36 \/ v43 \/ v78 \/ ~v88 \/ ~v99) /\ + (v77 \/ v79 \/ v97) /\ + (v2 \/ v5 \/ ~v32 \/ v38 \/ v63 \/ ~v94) /\ + (~v1 \/ v52) /\ + (v7 \/ ~v88 \/ v91) /\ + (v10 \/ v17 \/ ~v22 \/ v75 \/ v76) /\ + (~v34 \/ v74 \/ v80 \/ v95) /\ + (~v33 \/ v36 \/ ~v57 \/ ~v74) /\ + (~v47 \/ v66 \/ v71 \/ v80 \/ ~v92) /\ + (v2 \/ ~v17 \/ ~v43 \/ v54 \/ v56 \/ ~v77 \/ ~v79 \/ v88 \/ ~v94 \/ ~v98) /\ + (~v17 \/ ~v46 \/ v97) /\ + (v27 \/ v55 \/ v82) /\ + (~v4 \/ ~v27 \/ v34 \/ ~v40 \/ v71) /\ + (v28 \/ ~v32 \/ ~v94) /\ + (~v29 \/ v60 \/ v63 \/ ~v70 \/ v76) /\ + (v1 \/ v2 \/ ~v9 \/ ~v14 \/ ~v20 \/ v79 \/ v93 \/ v94) /\ + (~v33 \/ v42 \/ ~v45 \/ ~v69 \/ ~v73) /\ + (~v10 \/ ~v16 \/ ~v29 \/ v56 \/ v58 \/ v75 \/ ~v88 \/ v95 \/ ~v96) /\ + (v2 \/ ~v3 \/ v41 \/ ~v51 \/ v67 \/ ~v78) /\ + (~v11 \/ ~v15 \/ ~v20 \/ ~v50 \/ v95) /\ + (~v13 \/ ~v27 \/ ~v31 \/ ~v35 \/ v45 \/ ~v64 \/ ~v84 \/ v89 \/ ~v96) /\ + (v5 \/ ~v16 \/ ~v45 \/ v47 \/ v87) /\ + (~v15 \/ ~v18 \/ v31 \/ v98) /\ + (v27 \/ ~v32 \/ v39 \/ v40 \/ v75 \/ ~v88) /\ + (v14 \/ v16 \/ v29 \/ v30 \/ v46 \/ v50 \/ ~v56 \/ ~v80) /\ + (v9 \/ v22 \/ v25 \/ v27 \/ ~v41 \/ ~v58 \/ v84 \/ ~v94) /\ + (~v21 \/ ~v27) /\ + (v10 \/ v11 \/ ~v17 \/ v38 \/ ~v57 \/ ~v98) /\ + (v7 \/ v33 \/ ~v46 \/ ~v56 \/ ~v67) /\ + (v20 \/ v26 \/ v69) /\ + (~v35 \/ ~v42 \/ v69 \/ ~v90 \/ v98) /\ + (v26 \/ ~v39 \/ ~v62 \/ ~v81 \/ v94) /\ + (v24 \/ v25 \/ ~v36) /\ + (~v3 \/ v10 \/ v37 \/ ~v38 \/ ~v49 \/ ~v64 \/ ~v67 \/ ~v88 \/ ~v100) /\ + (~v26 \/ ~v31 \/ v37 \/ v38 \/ v66 \/ v98) /\ + (v46 \/ ~v75 \/ v78 \/ ~v87 \/ ~v90) /\ + (~v35 \/ v40 \/ v69 \/ ~v84 \/ v88) /\ + (v22 \/ ~v44 \/ v53 \/ ~v54 \/ ~v57) /\ + (~v59 \/ v69) /\ + (v10 \/ v11 \/ v22 \/ v30 \/ ~v38 \/ ~v45 \/ ~v84) /\ + (~v6 \/ v10 \/ ~v18 \/ v21 \/ ~v22 \/ v56 \/ v68 \/ v92 \/ ~v93) /\ + (~v22 \/ v38 \/ v56 \/ ~v62) /\ + (v41 \/ ~v63 \/ ~v67 \/ ~v79) /\ + (v3 \/ ~v16 \/ v33 \/ v57) /\ + (~v8 \/ v40) /\ + (~v12 \/ ~v14 \/ v20 \/ v68 \/ ~v99) /\ + (~v9 \/ ~v15 \/ v50) /\ + (~v1 \/ ~v11 \/ v26 \/ ~v37 \/ v76 \/ v77 \/ ~v86) /\ + (v46 \/ v70 \/ v87 \/ v97 \/ v98) /\ + (v40 \/ ~v79 \/ v82 \/ ~v88 \/ v91) /\ + (v6 \/ ~v13 \/ v37 \/ v46 \/ ~v84 \/ v100) /\ + (v90 \/ ~v97) /\ + (v1 \/ ~v8 \/ ~v11 \/ v32 \/ ~v40 \/ ~v57 \/ v75) /\ + (~v29 \/ v66 \/ ~v70 \/ ~v92 \/ v95) /\ + (~v4 \/ ~v44 \/ v47 \/ ~v59 \/ v72 \/ ~v77 \/ ~v93 \/ v96 \/ ~v99) /\ + (v31 \/ v43 \/ ~v65 \/ ~v74 \/ v85 \/ ~v86) /\ + (v23 \/ ~v51 \/ v53 \/ v92) /\ + (v41 \/ v96) /\ + (~v31 \/ ~v60 \/ ~v86) /\ + (~v1 \/ ~v79 \/ v94) /\ + (~v12 \/ ~v24 \/ v53 \/ ~v59) /\ + (~v6 \/ v12 \/ v19 \/ v46 \/ ~v50 \/ ~v69 \/ ~v78 \/ v98) /\ + (~v46 \/ v54 \/ ~v92) /\ + (~v40 \/ v53 \/ v78) /\ + (v7 \/ v22 \/ ~v28 \/ ~v38 \/ v45) /\ + (v17 \/ v53 \/ v63 \/ ~v91) /\ + (v70 \/ ~v71 \/ ~v93) /\ + (~v32 \/ ~v83 \/ ~v94 \/ ~v99) /\ + (~v1 \/ ~v77) /\ + (v3 \/ v21 \/ v73 \/ ~v86) /\ + (~v3 \/ v26 \/ v31 \/ v47 \/ v49 \/ ~v57 \/ ~v75 \/ v78 \/ ~v88) /\ + (v28 \/ v33 \/ v48 \/ ~v85 \/ ~v97) /\ + (~v2 \/ v88) /\ + (v1 \/ v46 \/ ~v66 \/ v80 \/ ~v82) /\ + (v88 \/ ~v89) /\ + (v10 \/ v21 \/ ~v23 \/ ~v27 \/ v54 \/ v70 \/ v72 \/ ~v94 \/ v97 \/ v99) /\ + (~v15 \/ v28 \/ v77 \/ ~v82) /\ + (~v20 \/ ~v55 \/ ~v94 \/ v98) /\ + (~v40 \/ ~v52 \/ v72 \/ ~v82) /\ + (v35 \/ ~v71 \/ ~v80 \/ v86) /\ + (v3 \/ ~v23 \/ ~v32 \/ ~v39 \/ v43 \/ ~v56 \/ v80 \/ v82) /\ + (~v5 \/ ~v22 \/ v25 \/ ~v40 \/ v90) /\ + (~v15 \/ ~v65 \/ ~v94) /\ + (~v16 \/ v36 \/ ~v41 \/ v44 \/ ~v83) /\ + (~v8 \/ v12 \/ v15 \/ ~v17 \/ ~v26 \/ ~v52 \/ ~v63 \/ v74) /\ + (v1 \/ v6 \/ v13 \/ ~v62 \/ v67 \/ ~v80 \/ v98) /\ + (v7 \/ v45) /\ + (~v10 \/ v20 \/ v38 \/ v45 \/ v46) /\ + (v7 \/ ~v40 \/ v43 \/ ~v56 \/ ~v73) /\ + (~v35 \/ v89 \/ v97 \/ v100) /\ + (~v2 \/ v5 \/ v19 \/ ~v30 \/ v52 \/ v71 \/ ~v77 \/ ~v94 \/ ~v96) /\ + (v80 \/ ~v97) /\ + (~v13 \/ ~v72) /\ + (~v4 \/ ~v30 \/ v45 \/ ~v70 \/ v88 \/ v91 \/ v97) /\ + (v30 \/ v41 \/ ~v75) /\ + (v4 \/ v5 \/ v46 \/ ~v60 \/ v95 \/ ~v97) /\ + (v12 \/ v34 \/ v43 \/ v83) /\ + (~v2 \/ v44 \/ v85 \/ v100) /\ + (~v33 \/ v99) /\ + (~v28 \/ ~v32) /\ + (v36 \/ v67 \/ ~v84) /\ + (~v18 \/ v40 \/ ~v63 \/ ~v67 \/ ~v79) /\ + (v5 \/ v8 \/ v11 \/ ~v14 \/ ~v58 \/ v60 \/ ~v61 \/ v71 \/ ~v75 \/ ~v78 \/ v82) /\ + (v20 \/ ~v31 \/ ~v42 \/ v81) /\ + (v21 \/ v39 \/ ~v44) /\ + (~v9 \/ ~v48 \/ v53 \/ v57 \/ ~v69 \/ v71 \/ v75) /\ + (~v12 \/ v29 \/ ~v54 \/ v76 \/ v80 \/ v92) /\ + (v22 \/ v32 \/ ~v41 \/ ~v93) /\ + (v18 \/ v22 \/ ~v25 \/ ~v73) /\ + (v22 \/ ~v37 \/ v48 \/ v54 \/ v57 \/ v59 \/ ~v73 \/ ~v89) /\ + (~v1 \/ ~v8 \/ ~v27 \/ ~v51 \/ ~v56 \/ ~v69) /\ + (v33 \/ v38 \/ ~v41 \/ ~v54 \/ ~v96) /\ + (v22 \/ ~v24 \/ ~v27 \/ ~v48 \/ ~v71) /\ + (v3 \/ ~v13 \/ v60) /\ + (v7 \/ v15 \/ v79) /\ + (v53 \/ v54 \/ ~v69) /\ + (v21 \/ ~v30 \/ v51 \/ v67) /\ + (v12 \/ ~v24 \/ v28 \/ v30 \/ ~v33 \/ v41) /\ + (v22 \/ v28 \/ ~v65) /\ + (~v13 \/ ~v87) /\ + (~v1 \/ v12 \/ v13 \/ ~v54 \/ ~v58 \/ ~v62 \/ v89) /\ + (~v13 \/ v26 \/ ~v91) /\ + (v9 \/ v43 \/ ~v48 \/ ~v65 \/ v72 \/ v77 \/ ~v82 \/ v92) /\ + (v29 \/ ~v31 \/ ~v36 \/ v40 \/ v46 \/ v57 \/ v66) /\ + (~v18 \/ ~v31 \/ v35 \/ v47 \/ ~v50 \/ v56 \/ ~v62 \/ v82) /\ + (~v7 \/ v83 \/ v100) /\ + (~v14 \/ ~v68 \/ ~v88 \/ ~v91) /\ + (v1 \/ ~v9 \/ ~v11 \/ ~v55 \/ ~v85 \/ ~v94) /\ + (v5 \/ ~v28 \/ ~v32 \/ v73 \/ v84 \/ ~v85 \/ ~v95 \/ ~v98) /\ + (~v21 \/ v34 \/ ~v68 \/ v83) /\ + (~v12 \/ ~v14 \/ v38 \/ v66 \/ ~v76 \/ ~v84 \/ ~v89) /\ + (~v23 \/ ~v26 \/ ~v51 \/ v64) /\ + (v27 \/ ~v67 \/ v71) /\ + (~v15 \/ v40 \/ v63 \/ v68) /\ + (v21 \/ ~v75) /\ + (v21 \/ ~v35 \/ ~v50 \/ v55) /\ + (v45 \/ v87) /\ + (~v10 \/ ~v22 \/ v39) /\ + (v1 \/ v39 \/ ~v45 \/ v67 \/ v68 \/ ~v80) /\ + (~v9 \/ v11 \/ ~v31 \/ v35 \/ ~v50 \/ v64 \/ v67 \/ v69) /\ + (~v33 \/ v53 \/ v73 \/ v76 \/ v77) /\ + (~v7 \/ v27 \/ ~v41 \/ v63) /\ + (~v18 \/ v50 \/ v61) /\ + (~v34 \/ ~v66 \/ v69) /\ + (~v6 \/ v9 \/ v29 \/ v30 \/ v82) /\ + (~v3 \/ v39 \/ v58 \/ v60 \/ v62 \/ v97) /\ + (v56 \/ v61) /\ + (~v6 \/ ~v34 \/ ~v47 \/ ~v57) /\ + (v17 \/ v28 \/ v85 \/ ~v94) /\ + (~v16 \/ v22 \/ ~v58) /\ + (v12 \/ v31 \/ v32 \/ ~v67 \/ v76 \/ v86) /\ + (~v8 \/ v19 \/ ~v24 \/ ~v43 \/ v45 \/ v50 \/ ~v56) /\ + (v53 \/ ~v55 \/ ~v88) /\ + (v35 \/ v37 \/ ~v52 \/ v54 \/ v90) /\ + (~v60 \/ ~v82 \/ ~v92) /\ + (v11 \/ ~v55 \/ ~v78 \/ ~v93) /\ + (~v37 \/ ~v50 \/ v72) /\ + (v13 \/ ~v14 \/ ~v28 \/ v38 \/ ~v69 \/ ~v71 \/ ~v94 \/ v96 \/ ~v97) /\ + (v14 \/ v23 \/ ~v35 \/ ~v39 \/ v75) /\ + (v8 \/ ~v11 \/ ~v56 \/ v87) /\ + (v9 \/ v20 \/ v23 \/ v52) /\ + (~v6 \/ ~v11 \/ v98) /\ + (v77 \/ ~v91 \/ v95) /\ + (v16 \/ v17 \/ ~v33 \/ v37 \/ v39 \/ v60 \/ ~v67 \/ ~v76 \/ ~v93 \/ ~v98) /\ + (v8 \/ v45 \/ v60) /\ + (~v26 \/ ~v51 \/ v62 \/ v63 \/ ~v78 \/ ~v81) /\ + (v40 \/ v43 \/ v65 \/ ~v80 \/ ~v89) /\ + (v40 \/ ~v61 \/ v73 \/ ~v74) /\ + (v26 \/ ~v32 \/ ~v44 \/ ~v65 \/ v67 \/ v68 \/ ~v70 \/ v72 \/ v73 \/ ~v75 \/ ~v80) /\ + (~v18 \/ v39 \/ ~v60) /\ + (v1 \/ ~v19) /\ + (~v3 \/ v11 \/ v12 \/ v31 \/ v46 \/ ~v69 \/ ~v78 \/ v90) /\ + (v17 \/ ~v53) /\ + (v1 \/ v18 \/ ~v46 \/ v64 \/ ~v82) /\ + (v2 \/ v39 \/ v56 \/ ~v96) /\ + (v21 \/ v35 \/ ~v50 \/ ~v66 \/ ~v74) /\ + (v50 \/ ~v54 \/ ~v93 \/ v99) /\ + (~v15 \/ ~v22) /\ + (v40 \/ v54 \/ ~v65 \/ v76) /\ + (v10 \/ v42 \/ ~v88 \/ ~v93) /\ + (v23 \/ v30 \/ v39 \/ v41 \/ v46 \/ v57 \/ ~v71 \/ ~v74 \/ v84) /\ + (v5 \/ ~v15 \/ ~v42 \/ v50 \/ v59) /\ + (v4 \/ ~v21 \/ v26 \/ ~v46 \/ ~v77 \/ ~v86 \/ v97 \/ v98) /\ + (v4 \/ v8 \/ ~v37 \/ ~v69 \/ v88 \/ ~v93) /\ + (v9 \/ ~v21 \/ v46 \/ ~v63) /\ + (v11 \/ v44 \/ ~v77 \/ ~v90) /\ + (v13 \/ ~v19 \/ v22 \/ v40 \/ ~v42 \/ ~v92) /\ + (v27 \/ v89 \/ v99) /\ + (~v40 \/ ~v78 \/ v98) /\ + (v60 \/ v61 \/ ~v66 \/ ~v80 \/ v88 \/ ~v90) /\ + (v2 \/ v44 \/ v72) /\ + (v4 \/ v9 \/ ~v22 \/ v26 \/ ~v48 \/ v52 \/ ~v84 \/ v95) /\ + (~v44 \/ v67 \/ ~v82 \/ ~v87 \/ ~v91) /\ + (~v8 \/ ~v45 \/ v69 \/ ~v76) /\ + (v6 \/ v42 \/ ~v45 \/ v52 \/ v87 \/ ~v97) /\ + (~v3 \/ v86 \/ v88) /\ + (v11 \/ v14 \/ ~v41 \/ v47 \/ v72) /\ + (~v10 \/ v61) /\ + (v16 \/ ~v97 \/ v100) /\ + (v4 \/ v19 \/ v26 \/ ~v31 \/ v84 \/ v85) /\ + (~v43 \/ v83 \/ v89) /\ + (~v1 \/ ~v42 \/ v45 \/ ~v66 \/ ~v83) /\ + (~v3 \/ ~v7 \/ ~v56 \/ v75 \/ v80 \/ v89) /\ + (v6 \/ v11 \/ ~v26 \/ ~v52 \/ v63 \/ v65 \/ ~v86 \/ ~v88 \/ v97) /\ + (~v26 \/ ~v55) /\ + (v36 \/ v64 \/ v91) /\ + (~v3 \/ ~v13 \/ ~v36 \/ v43 \/ ~v49 \/ v80) /\ + (v37 \/ ~v41) /\ + (v2 \/ v3 \/ ~v38 \/ v69 \/ v72 \/ ~v79 \/ v85) /\ + (v10 \/ v11 \/ ~v18 \/ ~v23 \/ ~v29 \/ v88) /\ + (v4 \/ ~v5 \/ ~v42 \/ v51 \/ ~v54 \/ ~v78 \/ ~v82) /\ + (~v19 \/ ~v25 \/ ~v38 \/ v65 \/ v67 \/ v84 \/ ~v97) /\ + (v4 \/ v11 \/ ~v12 \/ v50 \/ ~v60 \/ v76 \/ ~v87) /\ + (~v5 \/ ~v20 \/ ~v24 \/ ~v29 \/ ~v59) /\ + (~v22 \/ ~v36 \/ ~v40 \/ ~v44 \/ v54 \/ ~v73 \/ ~v93 \/ v98) /\ + (v7 \/ v14 \/ ~v25 \/ ~v54 \/ v56 \/ v96) /\ + (~v24 \/ ~v27 \/ v40) /\ + (v36 \/ ~v41 \/ v48 \/ v49 \/ v84 \/ ~v97) /\ + (~v3 \/ v23 \/ v25 \/ v38 \/ v39 \/ v55 \/ v59 \/ ~v65 \/ ~v89) /\ + (v18 \/ v31 \/ v34 \/ v36 \/ ~v50 \/ ~v67 \/ v93) /\ + (~v7 \/ ~v30 \/ ~v36) /\ + (v19 \/ v20 \/ ~v26 \/ v47 \/ ~v66) /\ + (v16 \/ v42 \/ ~v55 \/ ~v65 \/ ~v76) /\ + (v7 \/ v29 \/ v35 \/ v78) /\ + (v3 \/ ~v44 \/ ~v51 \/ v78 \/ ~v99) /\ + (v35 \/ ~v48 \/ ~v71 \/ ~v90) /\ + (~v9 \/ v33 \/ v34 \/ ~v45) /\ + (v7 \/ ~v12 \/ v19 \/ v46 \/ ~v47 \/ ~v58 \/ ~v73 \/ ~v76 \/ ~v97) /\ + (~v35 \/ ~v40 \/ v46 \/ v47 \/ v75) /\ + (v55 \/ ~v84 \/ v87 \/ ~v96 \/ ~v99) /\ + (~v44 \/ v49 \/ v78 \/ ~v93 \/ v97) /\ + (v31 \/ ~v53 \/ v62 \/ ~v63 \/ ~v66) /\ + (~v68 \/ v78) /\ + (v1 \/ ~v2 \/ v19 \/ v20 \/ v31 \/ v39 \/ ~v47 \/ ~v54 \/ ~v93) /\ + (~v15 \/ v19 \/ ~v27 \/ v30 \/ ~v31 \/ v65 \/ v77) /\ + (~v31 \/ v47 \/ v65 \/ ~v71) /\ + (v50 \/ ~v72 \/ ~v76 \/ ~v88) /\ + (v12 \/ ~v25 \/ v42 \/ v66) /\ + (~v8 \/ ~v17 \/ v49) /\ + (~v21 \/ ~v23 \/ v29 \/ v77) /\ + (~v18 \/ ~v24 \/ v59) /\ + (v6 \/ v7 \/ ~v10 \/ ~v20 \/ v35 \/ ~v46 \/ v85 \/ v86 \/ ~v95) /\ + (v55 \/ v79 \/ v96) /\ + (v9 \/ v49 \/ ~v88 \/ v91 \/ ~v97 \/ v100) /\ + (~v6 \/ v15 \/ ~v22 \/ v46 \/ v55 \/ ~v93) /\ + (~v1 \/ v4 \/ v10 \/ ~v17 \/ ~v20 \/ v41 \/ ~v49 \/ ~v66 \/ v84) /\ + (~v2 \/ v5 \/ ~v8 \/ ~v38 \/ v75 \/ ~v79) /\ + (~v13 \/ ~v53 \/ v56 \/ ~v68 \/ v81 \/ ~v86) /\ + (v1 \/ v40 \/ v52 \/ ~v74 \/ ~v83 \/ v94 \/ ~v95) /\ + (v5 \/ v32 \/ ~v60 \/ v62) /\ + (v3 \/ ~v40 \/ ~v69 \/ ~v95) /\ + (~v10 \/ ~v88) /\ + (v7 \/ ~v21 \/ ~v33 \/ v62 \/ ~v68) /\ + (~v1 \/ ~v15 \/ v21 \/ v28 \/ v55 \/ ~v59 \/ ~v78 \/ ~v87) /\ + (~v55 \/ v63) /\ + (~v49 \/ v62 \/ v87) /\ + (v16 \/ v31 \/ ~v37 \/ ~v47 \/ v54) /\ + (~v2 \/ v26 \/ v62 \/ v72 \/ ~v100) /\ + (~v3 \/ ~v8 \/ v79 \/ ~v80) /\ + (~v41 \/ ~v92) /\ + (~v10 \/ ~v86) /\ + (v12 \/ v30 \/ v82 \/ ~v95) /\ + (~v6 \/ ~v12 \/ v35 \/ v40 \/ v56 \/ v58 \/ ~v66 \/ ~v84 \/ v87 \/ ~v97) /\ + (v37 \/ v42 \/ v57 \/ ~v94) /\ + (~v11 \/ v97) /\ + (v10 \/ v55 \/ ~v75 \/ v89 \/ ~v91) /\ + (v97 \/ ~v98) /\ + (~v3 \/ v6 \/ v8 \/ ~v29) /\ + (v19 \/ v30 \/ ~v32 \/ ~v36 \/ v63 \/ v79 \/ v81) /\ + (~v3 \/ v7 \/ ~v24 \/ v37 \/ v86 \/ ~v91) /\ + (~v29 \/ ~v64) /\ + (~v49 \/ ~v61 \/ v81 \/ ~v91) /\ + (v44 \/ ~v80 \/ ~v89 \/ v95) /\ + (v12 \/ ~v32 \/ ~v41 \/ ~v48 \/ v52 \/ ~v65 \/ v89 \/ v91) /\ + (~v3 \/ ~v14 \/ ~v31 \/ v34 \/ ~v49 \/ v99) /\ + (~v24 \/ ~v74) /\ + (~v25 \/ v45 \/ ~v50 \/ v53 \/ ~v92) /\ + (v7 \/ ~v17 \/ v21 \/ v24 \/ ~v26 \/ ~v35 \/ ~v61 \/ ~v72 \/ v83) /\ + (v10 \/ v15 \/ v22 \/ ~v71 \/ v76 \/ ~v89) /\ + (v16 \/ v54) /\ + (~v19 \/ v29 \/ v47 \/ v54 \/ v55) /\ + (v6 \/ v9 \/ v16 \/ ~v49 \/ v52 \/ ~v65 \/ ~v82) /\ + (~v3 \/ ~v5 \/ ~v44 \/ v98) /\ + (~v6 \/ ~v11 \/ v14 \/ v28 \/ ~v39 \/ v61 \/ v80 \/ ~v86) /\ + (v6 \/ ~v22 \/ ~v81) /\ + (~v13 \/ ~v39 \/ v54 \/ ~v79 \/ v97 \/ v100) /\ + (v4 \/ ~v6 \/ v39 \/ v50 \/ ~v84) /\ + (v13 \/ v14 \/ v55 \/ ~v69) /\ + (v9 \/ v21 \/ v43 \/ v52 \/ v92) /\ + (v8 \/ ~v11 \/ v53 \/ v94) /\ + (~v37 \/ ~v41) /\ + (v45 \/ v76 \/ ~v93) /\ + (~v27 \/ v49 \/ ~v72 \/ ~v76 \/ ~v88) /\ + (v14 \/ v17 \/ v20 \/ ~v23 \/ ~v67 \/ v69 \/ ~v70 \/ v80 \/ ~v84 \/ ~v87 \/ v91) /\ + (v29 \/ ~v40 \/ ~v51 \/ v90) /\ + (v30 \/ v48 \/ ~v53) /\ + (v1 \/ ~v18 \/ ~v57 \/ v62 \/ v66 \/ ~v78 \/ v80 \/ v84) /\ + (~v2 \/ ~v21 \/ v38 \/ ~v63 \/ v85 \/ v89) /\ + (v31 \/ v41 \/ ~v50) /\ + (v27 \/ v31 \/ ~v34 \/ ~v82) /\ + (v31 \/ ~v46 \/ v57 \/ v63 \/ v66 \/ v68 \/ ~v82 \/ ~v98) /\ + (~v5 \/ ~v10 \/ ~v17 \/ ~v36 \/ ~v60 \/ ~v65 \/ ~v78) /\ + (v42 \/ v47 \/ ~v50 \/ ~v63) /\ + (v31 \/ ~v33 \/ ~v36 \/ ~v57 \/ ~v80) /\ + (v12 \/ ~v22 \/ v69) /\ + (v16 \/ v24 \/ v88) /\ + (v62 \/ v63 \/ ~v78) /\ + (v30 \/ ~v39 \/ v60 \/ v76) /\ + (v21 \/ ~v33 \/ v37 \/ v39 \/ ~v42 \/ v50) /\ + (v31 \/ v37 \/ ~v74) /\ + (~v22 \/ ~v96) /\ + (~v10 \/ v21 \/ v22 \/ ~v63 \/ ~v67 \/ ~v71 \/ v98) /\ + (v1 \/ ~v22 \/ v35 \/ ~v100) /\ + (v18 \/ v52 \/ ~v57 \/ ~v74 \/ v81 \/ v86 \/ ~v91) /\ + (v38 \/ ~v40 \/ ~v45 \/ v49 \/ v55 \/ v66 \/ v75) /\ + (v9 \/ ~v27 \/ ~v40 \/ v44 \/ v56 \/ ~v59 \/ v65 \/ ~v71 \/ v91) /\ + (~v16 \/ v92) /\ + (~v3 \/ ~v23 \/ ~v77 \/ ~v97 \/ ~v100) /\ + (~v4 \/ ~v7 \/ v10 \/ ~v18 \/ ~v20 \/ ~v64 \/ ~v94) /\ + (v14 \/ ~v37 \/ ~v41 \/ v82 \/ v93 \/ ~v94) /\ + (~v30 \/ v43 \/ ~v77 \/ v92) /\ + (~v21 \/ ~v23 \/ v47 \/ v75 \/ ~v85 \/ ~v93 \/ ~v98) /\ + (~v32 \/ ~v35 \/ ~v60 \/ v73) /\ + (v36 \/ ~v76 \/ v80) /\ + (~v24 \/ v49 \/ v72 \/ v77) /\ + (v30 \/ ~v84) /\ + (v30 \/ ~v44 \/ ~v59 \/ v64) /\ + (v54 \/ v96) /\ + (~v19 \/ ~v31 \/ v48) /\ + (v10 \/ v48 \/ ~v54 \/ v76 \/ v77 \/ ~v89) /\ + (~v18 \/ v20 \/ ~v40 \/ v44 \/ ~v59 \/ v73 \/ v76 \/ v78) /\ + (~v42 \/ v62 \/ v82 \/ v85 \/ v86) /\ + (~v16 \/ v36 \/ ~v50 \/ v72) /\ + (~v27 \/ v59 \/ v70) /\ + (~v43 \/ ~v75 \/ v78) /\ + (v6 \/ ~v15 \/ v18 \/ v38 \/ v39 \/ v91) /\ + (~v12 \/ v48 \/ v67 \/ v69 \/ v71) /\ + (v65 \/ v70) /\ + (~v3 \/ ~v15 \/ ~v43 \/ ~v56 \/ ~v66) /\ + (v26 \/ v37 \/ v94) /\ + (~v25 \/ v31 \/ ~v67) /\ + (v21 \/ v40 \/ v41 \/ ~v76 \/ v85 \/ v95) /\ + (~v17 \/ v28 \/ ~v33 \/ ~v52 \/ v54 \/ v59 \/ ~v65) /\ + (v62 \/ ~v64 \/ ~v97) /\ + (~v1 \/ v44 \/ v46 \/ ~v61 \/ v63 \/ v99) /\ + (~v2 \/ ~v69 \/ ~v91) /\ + (v20 \/ ~v64 \/ ~v87) /\ + (~v46 \/ ~v59 \/ v81) /\ + (~v3 \/ v5 \/ ~v6) /\ + (v22 \/ ~v23 \/ ~v37 \/ v47 \/ ~v78 \/ ~v80) /\ + (v23 \/ v32 \/ ~v44 \/ ~v48 \/ v84) /\ + (v17 \/ ~v20 \/ ~v65 \/ v96) /\ + (v7 \/ v18 \/ v29 \/ v32 \/ v61) /\ + (v4 \/ ~v15 \/ ~v20) /\ + (~v2 \/ ~v7 \/ v86 \/ ~v100) /\ + (v25 \/ v26 \/ ~v42 \/ v46 \/ v48 \/ v69 \/ ~v76 \/ ~v85) /\ + (v17 \/ v54 \/ v69) /\ + (~v35 \/ ~v60 \/ v71 \/ v72 \/ ~v87 \/ ~v90) /\ + (v49 \/ v52 \/ v74 \/ ~v89 \/ ~v98) /\ + (v49 \/ ~v70 \/ v82 \/ ~v83) /\ + (v35 \/ ~v41 \/ ~v53 \/ ~v74 \/ v76 \/ v77 \/ ~v79 \/ v81 \/ v82 \/ ~v84 \/ ~v89) /\ + (~v27 \/ v48 \/ ~v69) /\ + (v10 \/ ~v28) /\ + (~v12 \/ v20 \/ v21 \/ v40 \/ v55 \/ ~v78 \/ ~v87 \/ v99) /\ + (v26 \/ ~v62) /\ + (~v5 \/ v10 \/ v27 \/ ~v55 \/ v73 \/ ~v91) /\ + (v11 \/ v48 \/ v65) /\ + (~v2 \/ v8 \/ v30 \/ v44 \/ ~v59 \/ ~v75 \/ ~v83) /\ + (v59 \/ ~v63) /\ + (~v24 \/ ~v31) /\ + (~v2 \/ v49 \/ v63 \/ ~v74 \/ v85) /\ + (v19 \/ v51 \/ ~v97) /\ + (v32 \/ v39 \/ v48 \/ v50 \/ v55 \/ v66 \/ ~v80 \/ ~v83 \/ v93) /\ + (v6 \/ v7 \/ v14 \/ ~v24 \/ ~v51 \/ v59 \/ v68) /\ + (~v2 \/ v13 \/ ~v30 \/ v35 \/ ~v55 \/ ~v86 \/ ~v95) /\ + (v13 \/ v17 \/ ~v46 \/ ~v78 \/ v97) /\ + (v18 \/ ~v30 \/ v55 \/ ~v72) /\ + (~v1 \/ v20 \/ v53 \/ ~v86 \/ ~v99) /\ + (v8 \/ v22 \/ ~v28 \/ v31 \/ v49 \/ ~v51) /\ + (v7 \/ v36 \/ v98) /\ + (~v49 \/ ~v87) /\ + (v69 \/ v70 \/ ~v75 \/ ~v89 \/ v97 \/ ~v99) /\ + (v11 \/ v53 \/ v81) /\ + (v13 \/ v18 \/ ~v31 \/ v35 \/ ~v57 \/ v61 \/ ~v93) /\ + (~v53 \/ v76 \/ ~v91 \/ ~v96 \/ ~v100) /\ + (~v6 \/ ~v17 \/ ~v54 \/ v78 \/ ~v85) /\ + (v15 \/ v51 \/ ~v54 \/ v61 \/ v96) /\ + (~v12 \/ v95 \/ v97) /\ + (v20 \/ v23 \/ ~v50 \/ v56 \/ v81) /\ + (~v6 \/ v9 \/ ~v19 \/ v70) /\ + (v13 \/ v28 \/ v35 \/ ~v40 \/ v93 \/ v94) /\ + (~v52 \/ v92 \/ v98) /\ + (~v10 \/ ~v51 \/ v54 \/ ~v75 \/ ~v92) /\ + (v6 \/ ~v12 \/ ~v16 \/ ~v65 \/ v84 \/ v89 \/ v98) /\ + (v15 \/ v20 \/ ~v35 \/ ~v61 \/ v72 \/ v74 \/ ~v95 \/ ~v97) /\ + (~v35 \/ ~v64) /\ + (v45 \/ v73 \/ v100) /\ + (~v12 \/ ~v22 \/ ~v45 \/ v52 \/ ~v58 \/ v89) /\ + (v46 \/ ~v50) /\ + (v11 \/ v12 \/ ~v47 \/ v78 \/ v81 \/ ~v88 \/ v94) /\ + (v19 \/ v20 \/ ~v27 \/ ~v32 \/ ~v38 \/ v97) /\ + (~v6 \/ v13 \/ ~v14 \/ ~v51 \/ v60 \/ ~v63 \/ ~v87 \/ ~v91) /\ + (~v28 \/ ~v34 \/ ~v47 \/ v74 \/ v76 \/ v93) /\ + (v13 \/ v20 \/ ~v21 \/ v59 \/ ~v69 \/ v85 \/ ~v96) /\ + (~v2 \/ v7 \/ ~v14 \/ ~v29 \/ ~v33 \/ ~v38 \/ ~v68) /\ + (v5 \/ ~v31 \/ ~v45 \/ ~v49 \/ ~v53 \/ v63 \/ ~v82) /\ + (v16 \/ v23 \/ ~v34 \/ ~v63 \/ v65) /\ + (~v6 \/ ~v33 \/ ~v36 \/ v49) /\ + (v45 \/ ~v50 \/ v57 \/ v58 \/ v93) /\ + (v2 \/ ~v12 \/ v32 \/ v34 \/ v47 \/ v48 \/ v64 \/ v68 \/ ~v74 \/ ~v98) /\ + (v27 \/ v40 \/ v43 \/ v45 \/ ~v59 \/ ~v76) /\ + (~v16 \/ ~v39 \/ ~v45) /\ + (v28 \/ v29 \/ ~v35 \/ v56 \/ ~v75) /\ + (v25 \/ v51 \/ ~v64 \/ ~v74 \/ ~v85) /\ + (~v8 \/ v16 \/ v38 \/ v44 \/ v87) /\ + (v12 \/ ~v53 \/ ~v60 \/ v87) /\ + (v44 \/ ~v57 \/ ~v80 \/ ~v99) /\ + (~v6 \/ ~v18 \/ v42 \/ v43 \/ ~v54) /\ + (v16 \/ ~v21 \/ v28 \/ v55 \/ ~v56 \/ ~v67 \/ ~v82 \/ ~v85) /\ + (~v5 \/ ~v8 \/ ~v44 \/ ~v49 \/ v55 \/ v56 \/ v84) /\ + (~v2 \/ v6 \/ v64 \/ ~v93 \/ v96) /\ + (~v53 \/ v58 \/ v87) /\ + (v40 \/ ~v62 \/ v71 \/ ~v72 \/ ~v75) /\ + (~v2 \/ ~v77 \/ v87) /\ + (v10 \/ ~v11 \/ v28 \/ v29 \/ v40 \/ v48 \/ ~v56 \/ ~v63) /\ + (~v24 \/ v28 \/ ~v36 \/ v39 \/ ~v40 \/ v74 \/ v86) /\ + (~v40 \/ v56 \/ v74 \/ ~v80) /\ + (v59 \/ ~v81 \/ ~v85 \/ ~v97) /\ + (v21 \/ ~v34 \/ v51 \/ v75) /\ + (~v17 \/ ~v26 \/ v58) /\ + (~v30 \/ ~v32 \/ v38 \/ v86) /\ + (~v4 \/ ~v27 \/ ~v33 \/ v68) /\ + (v5 \/ v15 \/ v16 \/ ~v19 \/ ~v29 \/ v44 \/ ~v55 \/ v94 \/ v95) /\ + (~v6 \/ v9 \/ v64 \/ v88) /\ + (~v2 \/ v18 \/ v58 \/ ~v97 \/ v100) /\ + (v8 \/ ~v15 \/ v24 \/ ~v31 \/ v55 \/ v64) /\ + (~v10 \/ v13 \/ v19 \/ ~v26 \/ ~v29 \/ v50 \/ ~v58 \/ ~v75 \/ v93) /\ + (~v11 \/ v14 \/ ~v17 \/ ~v47 \/ v84 \/ ~v88) /\ + (v3 \/ ~v4 \/ ~v22 \/ ~v62 \/ v65 \/ ~v77 \/ v90 \/ ~v95) /\ + (v10 \/ v49 \/ v61 \/ ~v83 \/ ~v92) /\ + (v14 \/ v41 \/ ~v69 \/ v71) /\ + (~v4 \/ v59) /\ + (v12 \/ ~v49 \/ ~v78) /\ + (~v19 \/ ~v97) /\ + (v16 \/ ~v30 \/ ~v42 \/ v71 \/ ~v77) /\ + (~v10 \/ ~v24 \/ v30 \/ v37 \/ v64 \/ ~v68 \/ ~v87 \/ ~v96) /\ + (~v64 \/ v72) /\ + (~v58 \/ v71 \/ v96) /\ + (~v9 \/ v25 \/ v40 \/ ~v46 \/ ~v56 \/ v63) /\ + (~v11 \/ v35 \/ v71 \/ v81) /\ + (~v1 \/ ~v12 \/ ~v17 \/ v88 \/ ~v89) /\ + (~v4 \/ ~v19 \/ ~v95) /\ + (~v6 \/ v21 \/ v39 \/ v91) /\ + (~v3 \/ ~v15 \/ ~v21 \/ v44 \/ v49 \/ v65 \/ v67 \/ ~v75 \/ ~v93 \/ v96) /\ + (v6 \/ v46 \/ v51 \/ v66) /\ + (v6 \/ ~v7 \/ v19 \/ v64 \/ ~v84 \/ v98 \/ ~v100) /\ + (~v12 \/ v15 \/ v17 \/ ~v38) /\ + (v28 \/ v39 \/ ~v41 \/ ~v45 \/ v72 \/ v88 \/ v90) /\ + (~v12 \/ v16 \/ ~v33 \/ v46 \/ v95 \/ ~v100) /\ + (~v38 \/ ~v73) /\ + (v4 \/ ~v58 \/ ~v70 \/ v90 \/ ~v100) /\ + (v53 \/ ~v89 \/ ~v98) /\ + (v8 \/ v21 \/ ~v41 \/ ~v50 \/ ~v57 \/ v61 \/ ~v74 \/ v98 \/ v100) /\ + (~v12 \/ ~v23 \/ ~v40 \/ v43 \/ ~v58) /\ + (~v1 \/ ~v33 \/ ~v83) /\ + (~v34 \/ v54 \/ ~v59 \/ v62) /\ + (v16 \/ ~v26 \/ v30 \/ v33 \/ ~v35 \/ ~v44 \/ ~v70 \/ ~v81 \/ v92) /\ + (v19 \/ v24 \/ v31 \/ ~v80 \/ v85 \/ ~v98) /\ + (v25 \/ v63) /\ + (~v28 \/ v38 \/ v56 \/ v63 \/ v64) /\ + (v7 \/ v15 \/ v18 \/ v25 \/ ~v58 \/ v61 \/ ~v74 \/ ~v91) /\ + (~v12 \/ ~v14 \/ ~v53) /\ + (~v15 \/ ~v20 \/ v23 \/ v37 \/ ~v48 \/ v70 \/ v89 \/ ~v95) /\ + (v6 \/ v9 \/ v15 \/ ~v31 \/ ~v90) /\ + (~v22 \/ ~v48 \/ v63 \/ ~v88) /\ + (v13 \/ ~v15 \/ v48 \/ v59 \/ ~v93) /\ + (v1 \/ v22 \/ v23 \/ v64 \/ ~v78) /\ + (v3 \/ v18 \/ v30 \/ v52 \/ v61) /\ + (v17 \/ ~v20 \/ v62) /\ + (~v2 \/ ~v46 \/ ~v50) /\ + (v54 \/ v85) /\ + (~v36 \/ v58 \/ ~v81 \/ ~v85 \/ ~v97) /\ + (v23 \/ v26 \/ v29 \/ ~v32 \/ ~v76 \/ v78 \/ ~v79 \/ v89 \/ ~v93 \/ ~v96 \/ v100) /\ + (v38 \/ ~v49 \/ ~v60 \/ v99) /\ + (v39 \/ v57 \/ ~v62) /\ + (v10 \/ ~v27 \/ ~v66 \/ v71 \/ v75 \/ ~v87 \/ v89 \/ v93) /\ + (~v11 \/ ~v30 \/ v47 \/ ~v72 \/ v94 \/ v98) /\ + (v40 \/ v50 \/ ~v59) /\ + (v36 \/ v40 \/ ~v43 \/ ~v91) /\ + (~v7 \/ v75) /\ + (v40 \/ ~v55 \/ v66 \/ v72 \/ v75 \/ v77 \/ ~v91) /\ + (~v14 \/ ~v19 \/ ~v26 \/ ~v45 \/ ~v69 \/ ~v74 \/ ~v87) /\ + (v51 \/ v56 \/ ~v59 \/ ~v72) /\ + (v40 \/ ~v42 \/ ~v45 \/ ~v66 \/ ~v89) /\ + (v21 \/ ~v31 \/ v78) /\ + (v25 \/ v33 \/ v97) /\ + (v71 \/ v72 \/ ~v87) /\ + (v39 \/ ~v48 \/ v69 \/ v85) /\ + (v30 \/ ~v42 \/ v46 \/ v48 \/ ~v51 \/ v59) /\ + (~v5 \/ v40 \/ v46 \/ ~v83) /\ + (v7 \/ ~v31) /\ + (~v9 \/ ~v19 \/ v30 \/ v31 \/ ~v72 \/ ~v76 \/ ~v80) /\ + (v10 \/ ~v31 \/ v44) /\ + (v27 \/ v61 \/ ~v66 \/ ~v83 \/ v90 \/ v95 \/ ~v100) /\ + (v47 \/ ~v49 \/ ~v54 \/ v58 \/ v64 \/ v75 \/ v84) /\ + (v1 \/ v18 \/ ~v36 \/ ~v49 \/ v53 \/ v65 \/ ~v68 \/ v74 \/ ~v80 \/ v100) /\ + (~v6 \/ ~v9 \/ ~v25) /\ + (~v3 \/ ~v12 \/ ~v32 \/ ~v86) /\ + (v2 \/ ~v3 \/ ~v13 \/ ~v16 \/ v19 \/ ~v27 \/ ~v29 \/ ~v73) /\ + (v1 \/ v23 \/ ~v46 \/ ~v50 \/ v91) /\ + (~v2 \/ ~v7 \/ ~v39 \/ v52 \/ ~v86) /\ + (~v30 \/ ~v32 \/ v56 \/ v84 \/ ~v94) /\ + (~v41 \/ ~v44 \/ ~v69 \/ v82) /\ + (v45 \/ ~v85 \/ v89) /\ + (~v33 \/ v58 \/ v81 \/ v86) /\ + (v39 \/ ~v93) /\ + (v5 \/ v39 \/ ~v53 \/ ~v68 \/ v73) /\ + (~v28 \/ ~v40 \/ v57) /\ + (v19 \/ v57 \/ ~v63 \/ v85 \/ v86 \/ ~v98) /\ + (~v27 \/ v29 \/ ~v49 \/ v53 \/ ~v68 \/ v82 \/ v85 \/ v87) /\ + (~v51 \/ v71 \/ v91 \/ v94 \/ v95) /\ + (~v25 \/ v45 \/ ~v59 \/ v81) /\ + (~v36 \/ v68 \/ v79) /\ + (~v52 \/ ~v84 \/ v87) /\ + (v15 \/ ~v24 \/ v27 \/ v47 \/ v48 \/ v100) /\ + (~v21 \/ v57 \/ v76 \/ v78 \/ v80) /\ + (v74 \/ v79) /\ + (v3 \/ ~v12 \/ ~v24 \/ ~v52 \/ ~v65 \/ ~v75) /\ + (v35 \/ v46) /\ + (v4 \/ ~v34 \/ v40 \/ ~v76) /\ + (v30 \/ v49 \/ v50 \/ ~v85 \/ v94) /\ + (~v6 \/ ~v26 \/ v37 \/ ~v42 \/ ~v61 \/ v63 \/ v68 \/ ~v74) /\ + (v8 \/ v71 \/ ~v73) /\ + (~v10 \/ v53 \/ v55 \/ ~v70 \/ v72) /\ + (~v11 \/ ~v78 \/ ~v100) /\ + (v29 \/ ~v73 \/ ~v96) /\ + (~v55 \/ ~v68 \/ v90) /\ + (~v12 \/ v14 \/ ~v15) /\ + (v31 \/ ~v32 \/ ~v46 \/ v56 \/ ~v87 \/ ~v89) /\ + (v5 \/ v32 \/ v41 \/ ~v53 \/ ~v57 \/ v93) /\ + (v26 \/ ~v29 \/ ~v74) /\ + (v16 \/ v27 \/ v38 \/ v41 \/ v70) /\ + (~v9 \/ v13 \/ ~v24 \/ ~v29) /\ + (~v11 \/ ~v16 \/ v95) /\ + (v34 \/ v35 \/ ~v51 \/ v55 \/ v57 \/ v78 \/ ~v85 \/ ~v94) /\ + (v26 \/ v63 \/ v78) /\ + (~v7 \/ ~v44 \/ ~v69 \/ v80 \/ v81 \/ ~v96 \/ ~v99) /\ + (v58 \/ v61 \/ v83 \/ ~v98) /\ + (v58 \/ ~v79 \/ v91 \/ ~v92) /\ + (v44 \/ ~v50 \/ ~v62 \/ ~v83 \/ v85 \/ v86 \/ ~v88 \/ v90 \/ v91 \/ ~v93 \/ ~v98) /\ + (~v36 \/ v57 \/ ~v78) /\ + (v8 \/ v19 \/ ~v37) /\ + (~v21 \/ v29 \/ v30 \/ v49 \/ v64 \/ ~v87 \/ ~v96) /\ + (v35 \/ ~v71) /\ + (~v14 \/ v19 \/ v36 \/ ~v64 \/ v82 \/ ~v100) /\ + (v20 \/ v57 \/ v74) /\ + (~v11 \/ v17 \/ v39 \/ v53 \/ ~v68 \/ ~v84 \/ ~v92) /\ + (v68 \/ ~v72) /\ + (~v33 \/ ~v40) /\ + (~v6 \/ ~v11 \/ v58 \/ v72 \/ ~v83 \/ v94) /\ + (v2 \/ v28 \/ v60) /\ + (v41 \/ v48 \/ v57 \/ v59 \/ v64 \/ v75 \/ ~v89 \/ ~v92) /\ + (~v4 \/ v15 \/ v16 \/ v23 \/ ~v33 \/ ~v60 \/ v68 \/ v77) /\ + (v6 \/ ~v11 \/ v22 \/ ~v39 \/ v44 \/ ~v64 \/ ~v95) /\ + (v22 \/ v26 \/ ~v55 \/ ~v87) /\ + (~v8 \/ v27 \/ ~v39 \/ v64 \/ ~v81) /\ + (~v10 \/ v29 \/ v62 \/ ~v95) /\ + (v7 \/ v17 \/ v31 \/ ~v37 \/ v40 \/ v58 \/ ~v60) /\ + (v16 \/ v45) /\ + (v6 \/ ~v8 \/ ~v58 \/ ~v96) /\ + (v78 \/ v79 \/ ~v84 \/ ~v98) /\ + (v20 \/ v62 \/ v90) /\ + (~v2 \/ v13) /\ + (~v5 \/ ~v9 \/ v22 \/ v27 \/ ~v40 \/ v44 \/ ~v66 \/ v70) /\ + (~v62 \/ v85 \/ ~v100) /\ + (v5 \/ ~v15 \/ ~v26 \/ ~v63 \/ v87 \/ ~v94) /\ + (v4 \/ v6 \/ v24 \/ v60 \/ ~v63 \/ v70) /\ + (v29 \/ v32 \/ ~v59 \/ v65 \/ v90) /\ + (~v15 \/ v18 \/ ~v28 \/ v79) /\ + (v2 \/ v3 \/ v34) /\ + (v1 \/ v7 \/ v22 \/ v37 \/ v44 \/ ~v49) /\ + (~v1 \/ ~v61) /\ + (v7 \/ ~v19 \/ ~v60 \/ v63 \/ ~v84) /\ + (~v4 \/ ~v6 \/ v15 \/ ~v21 \/ ~v25 \/ ~v74 \/ v93 \/ v98) /\ + (v24 \/ v29 \/ ~v44 \/ ~v70 \/ v81 \/ v83) /\ + (v9 \/ ~v44 \/ ~v73) /\ + (v54 \/ v82) /\ + (~v21 \/ ~v31 \/ ~v54 \/ v61 \/ ~v67 \/ v98) /\ + (v3 \/ v55 \/ ~v59) /\ + (v6 \/ v20 \/ v21 \/ ~v56 \/ v87 \/ v90 \/ ~v97) /\ + (v28 \/ v29 \/ ~v36 \/ ~v41 \/ ~v47) /\ + (v2 \/ ~v15 \/ v22 \/ ~v23 \/ ~v60 \/ v69 \/ ~v72 \/ ~v96 \/ ~v100) /\ + (~v5 \/ ~v37 \/ ~v43 \/ ~v56 \/ v83 \/ v85) /\ + (v22 \/ v29 \/ ~v30 \/ v68 \/ ~v78 \/ v94) /\ + (~v11 \/ v16 \/ ~v23 \/ ~v38 \/ ~v42 \/ ~v47 \/ ~v77) /\ + (v14 \/ ~v40 \/ ~v54 \/ ~v58 \/ ~v62 \/ v72 \/ ~v91) /\ + (v25 \/ v32 \/ ~v43 \/ ~v72 \/ v74) /\ + (v2 \/ ~v15 \/ ~v42 \/ ~v45 \/ v58) /\ + (~v7 \/ v54 \/ ~v59 \/ v66 \/ v67) /\ + (v11 \/ ~v21 \/ v41 \/ v43 \/ v56 \/ v57 \/ v73 \/ v77 \/ ~v83) /\ + (v36 \/ v49 \/ v52 \/ v54 \/ ~v68 \/ ~v85) /\ + (~v25 \/ ~v48 \/ ~v54) /\ + (v37 \/ v38 \/ ~v44 \/ v65 \/ ~v84) /\ + (v34 \/ v60 \/ ~v73 \/ ~v83 \/ ~v94) /\ + (~v17 \/ v25 \/ v47 \/ v53 \/ v96) /\ + (~v8 \/ v21 \/ ~v62 \/ ~v69 \/ v96) /\ + (v53 \/ ~v66 \/ ~v89) /\ + (~v15 \/ ~v27 \/ v51 \/ v52 \/ ~v63) /\ + (v25 \/ ~v30 \/ v37 \/ v64 \/ ~v65 \/ ~v76 \/ ~v91 \/ ~v94) /\ + (~v2 \/ v5 \/ ~v14 \/ ~v17 \/ ~v53 \/ ~v58 \/ v64 \/ v65 \/ v93) /\ + (~v11 \/ v15 \/ v73) /\ + (~v62 \/ v67 \/ v96) /\ + (v49 \/ ~v71 \/ v80 \/ ~v81 \/ ~v84) /\ + (~v11 \/ ~v86 \/ v96) /\ + (v19 \/ ~v20 \/ v37 \/ v38 \/ v49 \/ v57 \/ ~v65 \/ ~v72) /\ + (~v33 \/ v37 \/ ~v45 \/ v48 \/ ~v49 \/ v83 \/ v95) /\ + (~v6 \/ ~v49 \/ v65 \/ v83 \/ ~v89) /\ + (v68 \/ ~v90 \/ ~v94) /\ + (v30 \/ ~v43 \/ v60 \/ v84) /\ + (~v26 \/ ~v35 \/ v67) /\ + (~v39 \/ ~v41 \/ v47 \/ v95) /\ + (v3 \/ v4 \/ ~v13 \/ ~v36 \/ ~v42 \/ v77) /\ + (v14 \/ v24 \/ v25 \/ ~v28 \/ ~v38 \/ v53 \/ ~v64) /\ + (~v6 \/ v9 \/ ~v15 \/ v18 \/ v73 \/ v97) /\ + (~v11 \/ v27 \/ v67) /\ + (v17 \/ ~v24 \/ v33 \/ ~v40 \/ v64 \/ v73) /\ + (~v19 \/ v22 \/ v28 \/ ~v35 \/ ~v38 \/ v59 \/ ~v67 \/ ~v84) /\ + (~v4 \/ ~v20 \/ v23 \/ ~v26 \/ ~v56 \/ v93 \/ ~v97) /\ + (~v1 \/ v12 \/ ~v13 \/ ~v31 \/ ~v71 \/ v74 \/ ~v86 \/ v99) /\ + (v19 \/ v58 \/ v70 \/ ~v92) /\ + (v23 \/ v50 \/ ~v78 \/ v80) /\ + (~v13 \/ v68) /\ + (~v6 \/ v21 \/ ~v58 \/ ~v87) /\ + (~v5 \/ v25 \/ ~v39 \/ ~v51 \/ v80 \/ ~v86) /\ + (~v19 \/ ~v33 \/ v39 \/ v46 \/ v73 \/ ~v77 \/ ~v96) /\ + (v5 \/ ~v73 \/ v81) /\ + (~v67 \/ v80) /\ + (~v18 \/ v34 \/ v49 \/ ~v55 \/ ~v65 \/ v72) /\ + (~v20 \/ v44 \/ v80 \/ v90) /\ + (~v10 \/ ~v21 \/ ~v26 \/ v97 \/ ~v98) /\ + (~v4 \/ ~v59) /\ + (~v13 \/ ~v28) /\ + (~v2 \/ v5 \/ ~v15 \/ v30 \/ v48 \/ v100) /\ + (~v12 \/ ~v24 \/ ~v30 \/ v53 \/ v58 \/ v74 \/ v76 \/ ~v84) /\ + (v15 \/ v55 \/ v60 \/ v75))` ;; + +let rip04_be = + `(car1 <=> a1 /\ b1) /\ + (car2 <=> (a2 \/ b2) /\ car1 \/ a2 /\ b2) /\ + (car3 <=> (a3 \/ b3) /\ car2 \/ a3 /\ b3) /\ + (cout <=> (a4 \/ b4) /\ car3 \/ a4 /\ b4) /\ + (som4 <=> ~(a4 <=> ~(b4 <=> car3))) /\ + (som3 <=> ~(a3 <=> ~(b3 <=> car2))) /\ + (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ + (som1 <=> ~(a1 <=> b1)) /\ + (cout1 <=> b1 /\ a1) /\ + (cout2 <=> cout1 /\ b2 \/ cout1 /\ a2 \/ b2 /\ a2) /\ + (cout3 <=> cout2 /\ b3 \/ cout2 /\ a3 \/ b3 /\ a3) + ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ + (som2 <=> + ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ + cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ + (som3 <=> + ~((~a3 /\ ~b3 \/ a3 /\ b3) /\ ~cout2 \/ + cout2 /\ ~(~a3 /\ ~b3 \/ a3 /\ b3))) /\ + (som4 <=> + ~((~a4 /\ ~b4 \/ a4 /\ b4) /\ ~cout3 \/ + cout3 /\ ~(~a4 /\ ~b4 \/ a4 /\ b4))) /\ + (cout <=> a4 /\ cout3 \/ b4 /\ cout3 \/ a4 /\ b4)` +;; + +let ztwaalf2_be = + `(out <=> + ~(a1 /\ a2 \/ ~a3 /\ (a4 <=> a5) <=> a6 /\ b6) \/ + (b1 /\ (b2 \/ b3 /\ (b4 <=> b5)) <=> b6 /\ a1)) + ==> (out <=> + a1 /\ a2 /\ ~a6 \/ + ~a3 /\ ~a4 /\ ~a5 /\ ~a6 \/ + ~a3 /\ a4 /\ a5 /\ ~a6 \/ + ~a1 /\ ~b1 \/ + ~a1 /\ ~b2 /\ ~b3 \/ + ~a1 /\ ~b2 /\ b4 /\ ~b5 \/ + ~a1 /\ ~b2 /\ ~b4 /\ b5 \/ + a1 /\ a2 /\ ~b6 \/ + ~a3 /\ ~a4 /\ ~a5 /\ ~b6 \/ + ~a3 /\ a4 /\ a5 /\ ~b6 \/ + ~b1 /\ ~b6 \/ + ~b2 /\ ~b3 /\ ~b6 \/ + ~b2 /\ b4 /\ ~b5 /\ ~b6 \/ + ~b2 /\ ~b4 /\ b5 /\ ~b6 \/ + ~a1 /\ a3 /\ a6 /\ b6 \/ + ~a2 /\ a3 /\ a6 /\ b6 \/ + ~a1 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ + ~a2 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ + ~a1 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ + ~a2 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ + a1 /\ b1 /\ b2 /\ b6 \/ + a1 /\ b1 /\ b3 /\ ~b4 /\ ~b5 /\ b6 \/ + a1 /\ b1 /\ b3 /\ b4 /\ b5 /\ b6)` +;; + +let ztwaalf1_be = + `(out <=> + a1 /\ a2 /\ ~a6 \/ + ~a3 /\ ~a4 /\ ~a5 /\ ~a6 \/ + ~a3 /\ a4 /\ a5 /\ ~a6 \/ + ~a1 /\ ~b1 \/ + ~a1 /\ ~b2 /\ ~b3 \/ + ~a1 /\ ~b2 /\ b4 /\ ~b5 \/ + ~a1 /\ ~b2 /\ ~b4 /\ b5 \/ + a1 /\ a2 /\ ~b6 \/ + ~a3 /\ ~a4 /\ ~a5 /\ ~b6 \/ + ~a3 /\ a4 /\ a5 /\ ~b6 \/ + ~b1 /\ ~b6 \/ + ~b2 /\ ~b3 /\ ~b6 \/ + ~b2 /\ b4 /\ ~b5 /\ ~b6 \/ + ~b2 /\ ~b4 /\ b5 /\ ~b6 \/ + ~a1 /\ a3 /\ a6 /\ b6 \/ + ~a2 /\ a3 /\ a6 /\ b6 \/ + ~a1 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ + ~a2 /\ a4 /\ ~a5 /\ a6 /\ b6 \/ + ~a1 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ + ~a2 /\ ~a4 /\ a5 /\ a6 /\ b6 \/ + a1 /\ b1 /\ b2 /\ b6 \/ + a1 /\ b1 /\ b3 /\ ~b4 /\ ~b5 /\ b6 \/ + a1 /\ b1 /\ b3 /\ b4 /\ b5 /\ b6) /\ + (s1 <=> ~(a1 /\ a2 \/ ~a3 /\ (a4 <=> a5) <=> a6 /\ b6)) /\ + (s2 <=> ~(b1 /\ (b2 \/ b3 /\ (b4 <=> b5)) <=> b6 /\ a1)) + ==> (out <=> s1 \/ ~s2)` ;; + +let z4_be = + `(ge2 <=> in3 \/ in0) /\ + (ge4 <=> ~in3 \/ ~in0) /\ + (ge1 <=> in5 \/ in2) /\ + (ge3 <=> ge2 /\ in6 \/ in3 /\ in0) /\ + (ge5 <=> ~ge2 \/ ge4 /\ ~in6) /\ + (ge7 <=> ~in5 \/ ~in2) /\ + (ge0 <=> in4 \/ in1) /\ + (ge6 <=> ge3 /\ ge1 \/ in5 /\ in2) /\ + (ge8 <=> in4 /\ in1) /\ + (ge9 <=> ~in4 /\ in1 \/ in4 /\ ~in1) /\ + (out0 <=> ge6 /\ ge0 \/ ge8) /\ + (out1 <=> ge9 /\ ge7 /\ ge5 \/ ge6 /\ ~ge0 \/ ge9 /\ ~ge1 \/ ge8 /\ ge6) /\ + (out2 <=> + ge5 /\ in5 /\ ~in2 \/ ge5 /\ ~in5 /\ in2 \/ ge3 /\ ~ge1 \/ ~ge7 /\ ge3) /\ + (out3 <=> + ~in6 /\ in3 /\ ~in0 \/ ~in6 /\ ~in3 /\ in0 \/ ~ge2 /\ in6 \/ ~ge4 /\ in6) /\ + (wres2 <=> in3 \/ in0) /\ + (wres4 <=> ~in3 \/ ~in0) /\ + (wres1 <=> in5 \/ in2) /\ + (wres3 <=> wres2 /\ in6 \/ in3 /\ in0) /\ + (wres5 <=> ~wres2 \/ wres4 /\ ~in6) /\ + (wres7 <=> ~in5 \/ ~in2) /\ + (wres0 <=> in4 \/ in1) /\ + (wres6 <=> wres3 /\ wres1 \/ in5 /\ in2) /\ + (wres8 <=> in4 /\ in1) /\ + (wres9 <=> ~in4 /\ in1 \/ in4 /\ ~in1) + ==> (out3 <=> + ~in6 /\ in3 /\ ~in0 \/ + ~in6 /\ ~in3 /\ in0 \/ + ~wres2 /\ in6 \/ + ~wres4 /\ in6) /\ + (out2 <=> + wres3 /\ ~wres1 \/ + wres5 /\ ~in5 /\ in2 \/ + wres5 /\ in5 /\ ~in2 \/ + ~wres7 /\ wres3) /\ + (out1 <=> + wres6 /\ ~wres0 \/ + wres8 /\ wres6 \/ + wres9 /\ ~wres1 \/ + wres9 /\ wres7 /\ wres5) /\ + (out0 <=> wres6 /\ wres0 \/ wres8)` ;; + +let rip06_be = + `(car1 <=> a1 /\ b1) /\ + (car2 <=> (a2 \/ b2) /\ car1 \/ a2 /\ b2) /\ + (car3 <=> (a3 \/ b3) /\ car2 \/ a3 /\ b3) /\ + (car4 <=> (a4 \/ b4) /\ car3 \/ a4 /\ b4) /\ + (car5 <=> (a5 \/ b5) /\ car4 \/ a5 /\ b5) /\ + (cout <=> (a6 \/ b6) /\ car5 \/ a6 /\ b6) /\ + (som6 <=> ~(a6 <=> ~(b6 <=> car5))) /\ + (som5 <=> ~(a5 <=> ~(b5 <=> car4))) /\ + (som4 <=> ~(a4 <=> ~(b4 <=> car3))) /\ + (som3 <=> ~(a3 <=> ~(b3 <=> car2))) /\ + (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ + (som1 <=> ~(a1 <=> b1)) /\ + (cout1 <=> b1 /\ a1) /\ + (cout2 <=> cout1 /\ b2 \/ cout1 /\ a2 \/ b2 /\ a2) /\ + (cout3 <=> cout2 /\ b3 \/ cout2 /\ a3 \/ b3 /\ a3) /\ + (cout4 <=> cout3 /\ b4 \/ cout3 /\ a4 \/ b4 /\ a4) /\ + (cout5 <=> cout4 /\ b5 \/ cout4 /\ a5 \/ b5 /\ a5) + ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ + (som2 <=> + ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ + cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ + (som3 <=> + ~((~a3 /\ ~b3 \/ a3 /\ b3) /\ ~cout2 \/ + cout2 /\ ~(~a3 /\ ~b3 \/ a3 /\ b3))) /\ + (som4 <=> + ~((~a4 /\ ~b4 \/ a4 /\ b4) /\ ~cout3 \/ + cout3 /\ ~(~a4 /\ ~b4 \/ a4 /\ b4))) /\ + (som5 <=> + ~((~a5 /\ ~b5 \/ a5 /\ b5) /\ ~cout4 \/ + cout4 /\ ~(~a5 /\ ~b5 \/ a5 /\ b5))) /\ + (som6 <=> + ~((~a6 /\ ~b6 \/ a6 /\ b6) /\ ~cout5 \/ + cout5 /\ ~(~a6 /\ ~b6 \/ a6 /\ b6))) /\ + (cout <=> a6 /\ cout5 \/ b6 /\ cout5 \/ a6 /\ b6)` ;; + +let add1_be = + `(n3 <=> a_1_) /\ + (n4 <=> a_3_) /\ + (n5 <=> a_2_) /\ + (n6 <=> a_4_) /\ + (n7 <=> ~carryin) /\ + (n8 <=> b_3_) /\ + (n9 <=> b_1_) /\ + (n10 <=> b_2_) /\ + (n11 <=> b_4_) /\ + (n17 <=> ~n3) /\ + (n31 <=> ~n4) /\ + (n29 <=> ~n5) /\ + (n19 <=> ~n7) /\ + (n43 <=> ~n6) /\ + (n20 <=> ~n19) /\ + (n18 <=> ~(n9 /\ ~n3 \/ ~n9 /\ n3)) /\ + (n28 <=> ~(n10 /\ ~n5 \/ ~n10 /\ n5)) /\ + (n32 <=> ~(n8 /\ ~n4 \/ ~n8 /\ n4)) /\ + (n16 <=> ~n18) /\ + (n24 <=> ~n28) /\ + (n22 <=> ~n16) /\ + (n42 <=> ~(n11 /\ ~n6 \/ ~n11 /\ n6)) /\ + (n38 <=> ~n42) /\ + (n27 <=> ~n24) /\ + (n21 <=> ~(n20 /\ n16 \/ ~n20 /\ ~n16)) /\ + (n23 <=> ~n16 /\ ~n3 \/ ~n22 /\ ~n19) /\ + (n25 <=> ~n23) /\ + (n26 <=> ~(n25 /\ ~n24 \/ ~n25 /\ n24)) /\ + (n13 <=> ~n26) /\ + (n30 <=> ~n32) /\ + (n33 <=> ~n27 /\ ~n23 \/ ~n29 /\ ~n24) /\ + (n36 <=> ~n30) /\ + (n15 <=> ~n21) /\ + (n34 <=> ~n33) /\ + (n41 <=> ~n38) /\ + (n37 <=> ~n30 /\ ~n4 \/ ~n36 /\ ~n33) /\ + (n39 <=> ~n37) /\ + (n40 <=> ~(n39 /\ ~n38 \/ ~n39 /\ n38)) /\ + (n12 <=> ~n40) /\ + (n35 <=> ~(n34 /\ n30 \/ ~n34 /\ ~n30)) /\ + (n14 <=> ~n35) /\ + (n44 <=> ~n41 /\ ~n37 \/ ~n43 /\ ~n38) /\ + (cout <=> n44) /\ + (o_4_ <=> n12) /\ + (o_3_ <=> n14) /\ + (o_2_ <=> n13) /\ + (o_1_ <=> n15) /\ + (cout1 <=> carryin /\ b_1_ \/ carryin /\ a_1_ \/ b_1_ /\ a_1_) /\ + (cout2 <=> cout1 /\ b_2_ \/ cout1 /\ a_2_ \/ b_2_ /\ a_2_) /\ + (cout3 <=> cout2 /\ b_3_ \/ cout2 /\ a_3_ \/ b_3_ /\ a_3_) + ==> (o_1_ <=> ~(a_1_ <=> ~(b_1_ <=> carryin))) /\ + (o_2_ <=> ~(a_2_ <=> ~(b_2_ <=> cout1))) /\ + (o_3_ <=> ~(a_3_ <=> ~(b_3_ <=> cout2))) /\ + (o_4_ <=> ~(a_4_ <=> ~(b_4_ <=> cout3))) /\ + (cout <=> cout3 /\ b_4_ \/ cout3 /\ a_4_ \/ b_4_ /\ a_4_)` ;; + +let rip08_be = + `(car1 <=> a1 /\ b1) /\ + (car2 <=> (a2 \/ b2) /\ car1 \/ a2 /\ b2) /\ + (car3 <=> (a3 \/ b3) /\ car2 \/ a3 /\ b3) /\ + (car4 <=> (a4 \/ b4) /\ car3 \/ a4 /\ b4) /\ + (car5 <=> (a5 \/ b5) /\ car4 \/ a5 /\ b5) /\ + (car6 <=> (a6 \/ b6) /\ car5 \/ a6 /\ b6) /\ + (car7 <=> (a7 \/ b7) /\ car6 \/ a7 /\ b7) /\ + (cout <=> (a8 \/ b8) /\ car7 \/ a8 /\ b8) /\ + (som8 <=> ~(a8 <=> ~(b8 <=> car7))) /\ + (som7 <=> ~(a7 <=> ~(b7 <=> car6))) /\ + (som6 <=> ~(a6 <=> ~(b6 <=> car5))) /\ + (som5 <=> ~(a5 <=> ~(b5 <=> car4))) /\ + (som4 <=> ~(a4 <=> ~(b4 <=> car3))) /\ + (som3 <=> ~(a3 <=> ~(b3 <=> car2))) /\ + (som2 <=> ~(a2 <=> ~(b2 <=> car1))) /\ + (som1 <=> ~(a1 <=> b1)) /\ + (cout1 <=> b1 /\ a1) /\ + (cout2 <=> cout1 /\ b2 \/ cout1 /\ a2 \/ b2 /\ a2) /\ + (cout3 <=> cout2 /\ b3 \/ cout2 /\ a3 \/ b3 /\ a3) /\ + (cout4 <=> cout3 /\ b4 \/ cout3 /\ a4 \/ b4 /\ a4) /\ + (cout5 <=> cout4 /\ b5 \/ cout4 /\ a5 \/ b5 /\ a5) /\ + (cout6 <=> cout5 /\ b6 \/ cout5 /\ a6 \/ b6 /\ a6) /\ + (cout7 <=> cout6 /\ b7 \/ cout6 /\ a7 \/ b7 /\ a7) + ==> (som1 <=> ~(~a1 /\ ~b1 \/ a1 /\ b1)) /\ + (som2 <=> + ~((~a2 /\ ~b2 \/ a2 /\ b2) /\ ~cout1 \/ + cout1 /\ ~(~a2 /\ ~b2 \/ a2 /\ b2))) /\ + (som3 <=> + ~((~a3 /\ ~b3 \/ a3 /\ b3) /\ ~cout2 \/ + cout2 /\ ~(~a3 /\ ~b3 \/ a3 /\ b3))) /\ + (som4 <=> + ~((~a4 /\ ~b4 \/ a4 /\ b4) /\ ~cout3 \/ + cout3 /\ ~(~a4 /\ ~b4 \/ a4 /\ b4))) /\ + (som5 <=> + ~((~a5 /\ ~b5 \/ a5 /\ b5) /\ ~cout4 \/ + cout4 /\ ~(~a5 /\ ~b5 \/ a5 /\ b5))) /\ + (som6 <=> + ~((~a6 /\ ~b6 \/ a6 /\ b6) /\ ~cout5 \/ + cout5 /\ ~(~a6 /\ ~b6 \/ a6 /\ b6))) /\ + (som7 <=> + ~((~a7 /\ ~b7 \/ a7 /\ b7) /\ ~cout6 \/ + cout6 /\ ~(~a7 /\ ~b7 \/ a7 /\ b7))) /\ + (som8 <=> + ~((~a8 /\ ~b8 \/ a8 /\ b8) /\ ~cout7 \/ + cout7 /\ ~(~a8 /\ ~b8 \/ a8 /\ b8))) /\ + (cout <=> a8 /\ cout7 \/ b8 /\ cout7 \/ a8 /\ b8)` ;; + +let aim_50_1_6_no_1 = +`~ +((v16 \/ v23 \/ v42) /\ + (~v16 \/ v23 \/ v42) /\ + (v26 \/ v41 \/ ~v42) /\ + (~v26 \/ v41 \/ ~v42) /\ + (v32 \/ ~v41 \/ ~v42) /\ + (v6 \/ v15 \/ ~v41) /\ + (~v6 \/ v15 \/ ~v32) /\ + (v1 \/ ~v32 \/ v46) /\ + (~v1 \/ ~v32 \/ v46) /\ + (~v15 \/ ~v41 \/ ~v46) /\ + (~v15 \/ ~v21 \/ ~v46) /\ + (~v23 \/ v33 \/ v38) /\ + (~v23 \/ ~v33 \/ v38) /\ + (v8 \/ v22 \/ v33) /\ + (v8 \/ v22 \/ ~v33) /\ + (~v22 \/ v37 \/ ~v38) /\ + (v13 \/ v36 \/ ~v37) /\ + (v13 \/ ~v22 \/ ~v36) /\ + (~v13 \/ ~v22 \/ ~v37) /\ + (v11 \/ ~v23 \/ v47) /\ + (~v8 \/ v11 \/ ~v47) /\ + (~v8 \/ ~v11 \/ v39) /\ + (~v11 \/ v27 \/ ~v39) /\ + (~v8 \/ ~v11 \/ ~v39) /\ + (~v7 \/ v26 \/ v29) /\ + (~v7 \/ ~v26 \/ v29) /\ + (~v13 \/ v20 \/ v36) /\ + (~v13 \/ v17 \/ v20) /\ + (v5 \/ ~v17 \/ v20) /\ + (v5 \/ ~v19 \/ ~v45) /\ + (~v5 \/ ~v10 \/ ~v45) /\ + (v6 \/ v25 \/ v47) /\ + (~v6 \/ ~v10 \/ v25) /\ + (~v2 \/ ~v27 \/ v37) /\ + (~v27 \/ ~v36 \/ v40) /\ + (v18 \/ v39 \/ ~v40) /\ + (~v2 \/ ~v19 \/ v31) /\ + (v5 \/ v18 \/ ~v30) /\ + (~v31 \/ ~v43 \/ ~v50) /\ + (v10 \/ ~v30 \/ v43) /\ + (v10 \/ ~v41 \/ v43) /\ + (v19 \/ v21 \/ v29) /\ + (v37 \/ v42 \/ v45) /\ + (~v20 \/ v27 \/ v40) /\ + (~v21 \/ ~v36 \/ v48) /\ + (v31 \/ ~v36 \/ ~v48) /\ + (v3 \/ ~v9 \/ ~v18) /\ + (v16 \/ ~v40 \/ ~v47) /\ + (v1 \/ ~v18 \/ v21) /\ + (v2 \/ v28 \/ v32) /\ + (~v1 \/ ~v24 \/ ~v50) /\ + (~v12 \/ v35 \/ v49) /\ + (~v6 \/ ~v36 \/ v45) /\ + (v7 \/ v12 \/ ~v43) /\ + (v7 \/ v30 \/ ~v43) /\ + (~v5 \/ v9 \/ ~v17) /\ + (v3 \/ v14 \/ v50) /\ + (~v12 \/ v17 \/ ~v49) /\ + (v24 \/ v34 \/ v49) /\ + (v14 \/ ~v20 \/ v24) /\ + (~v9 \/ v35 \/ ~v49) /\ + (~v4 \/ ~v47 \/ v50) /\ + (v4 \/ v44 \/ ~v44) /\ + (v28 \/ ~v28 \/ ~v38) /\ + (v2 \/ v4 \/ ~v48) /\ + (~v20 \/ v35 \/ ~v44) /\ + (v30 \/ ~v31 \/ ~v43) /\ + (~v14 \/ ~v29 \/ v35) /\ + (~v20 \/ v35 \/ ~v35) /\ + (v19 \/ ~v22 \/ ~v24) /\ + (~v25 \/ ~v28 \/ v48) /\ + (~v14 \/ ~v34 \/ v44) /\ + (v9 \/ v20 \/ v44) /\ + (~v3 \/ v9 \/ ~v29) /\ + (v17 \/ v34 \/ ~v34) /\ + (v12 \/ v48 \/ v48) /\ + (~v12 \/ ~v25 \/ ~v43) /\ + (~v25 \/ ~v31 \/ v48) /\ + (v14 \/ ~v16 \/ v49) /\ + (~v3 \/ ~v4 \/ ~v35))` ;; + +let aim_50_1_6_no_2 = +`~ +((v5 \/ v17 \/ v37) /\ + (v24 \/ v28 \/ v37) /\ + (v24 \/ ~v28 \/ v40) /\ + (v4 \/ ~v28 \/ ~v40) /\ + (v4 \/ ~v24 \/ v29) /\ + (v13 \/ ~v24 \/ ~v29) /\ + (~v13 \/ ~v24 \/ ~v29) /\ + (~v4 \/ v10 \/ ~v17) /\ + (~v4 \/ ~v10 \/ ~v17) /\ + (v26 \/ v33 \/ ~v37) /\ + (v5 \/ ~v26 \/ v34) /\ + (v33 \/ ~v34 \/ v48) /\ + (v33 \/ ~v37 \/ ~v48) /\ + (v5 \/ ~v33 \/ ~v37) /\ + (v2 \/ ~v5 \/ v10) /\ + (v2 \/ ~v5 \/ ~v10) /\ + (~v2 \/ v15 \/ v47) /\ + (v15 \/ v30 \/ ~v47) /\ + (~v2 \/ ~v15 \/ v30) /\ + (v20 \/ ~v30 \/ v42) /\ + (~v2 \/ v20 \/ ~v30) /\ + (v13 \/ ~v20 \/ v29) /\ + (v13 \/ v16 \/ ~v20) /\ + (~v13 \/ ~v20 \/ v31) /\ + (~v13 \/ v16 \/ ~v31) /\ + (~v16 \/ v23 \/ v38) /\ + (~v16 \/ v19 \/ ~v38) /\ + (~v19 \/ v23 \/ ~v38) /\ + (v14 \/ ~v23 \/ v34) /\ + (v1 \/ v14 \/ ~v34) /\ + (~v1 \/ v9 \/ v14) /\ + (~v1 \/ ~v9 \/ ~v23) /\ + (~v14 \/ v21 \/ ~v23) /\ + (~v14 \/ ~v16 \/ ~v21) /\ + (v25 \/ ~v35 \/ v41) /\ + (~v25 \/ v41 \/ v50) /\ + (~v35 \/ v49 \/ ~v50) /\ + (~v25 \/ ~v49 \/ ~v50) /\ + (~v19 \/ ~v48 \/ ~v49) /\ + (v3 \/ ~v39 \/ v44) /\ + (v1 \/ v3 \/ ~v44) /\ + (v9 \/ v35 \/ v44) /\ + (~v9 \/ ~v31 \/ v44) /\ + (v22 \/ v25 \/ ~v44) /\ + (~v12 \/ ~v43 \/ v46) /\ + (~v12 \/ ~v28 \/ ~v46) /\ + (v6 \/ v35 \/ v48) /\ + (v11 \/ v18 \/ ~v48) /\ + (v22 \/ v38 \/ ~v42) /\ + (v22 \/ ~v35 \/ ~v42) /\ + (~v3 \/ v11 \/ v41) /\ + (v27 \/ v28 \/ ~v43) /\ + (~v15 \/ ~v21 \/ v31) /\ + (~v33 \/ v39 \/ v50) /\ + (~v8 \/ ~v22 \/ ~v47) /\ + (~v22 \/ ~v40 \/ ~v47) /\ + (v39 \/ v44 \/ ~v46) /\ + (~v25 \/ ~v26 \/ v47) /\ + (v38 \/ v43 \/ v45) /\ + (~v6 \/ ~v14 \/ ~v45) /\ + (~v7 \/ v12 \/ v36) /\ + (v8 \/ ~v11 \/ v45) /\ + (v27 \/ ~v38 \/ ~v50) /\ + (v7 \/ ~v11 \/ ~v36) /\ + (~v7 \/ ~v41 \/ v42) /\ + (v7 \/ v21 \/ v23) /\ + (~v18 \/ v32 \/ v46) /\ + (v8 \/ v19 \/ ~v36) /\ + (~v32 \/ ~v45 \/ ~v50) /\ + (v7 \/ v17 \/ v21) /\ + (v6 \/ v18 \/ v43) /\ + (~v6 \/ v24 \/ ~v27) /\ + (v40 \/ ~v41 \/ v49) /\ + (~v11 \/ v12 \/ v26) /\ + (~v3 \/ v32 \/ ~v36) /\ + (~v6 \/ v36 \/ ~v44) /\ + (~v3 \/ v36 \/ v42) /\ + (~v8 \/ ~v11 \/ ~v32) /\ + (~v18 \/ ~v27 \/ ~v38) /\ + (~v18 \/ ~v27 \/ ~v39))` ;; + +let vg2_be = + `(ge0 <=> ~in2 /\ in1 /\ in0 \/ ~in1 /\ ~in0) /\ + (ge1 <=> in1 \/ in0) /\ + (ge3 <=> in6 /\ ~in5 /\ ~in4 /\ ~in2 \/ ge1 /\ in3 /\ in2 \/ ge0 /\ in7) /\ + (ge2 <=> in9 /\ ~in5 /\ ~in4 /\ ~in2 \/ ge1 /\ in8 /\ in2 \/ ge0 /\ in10) /\ + (ge23 <=> in17 /\ in16 /\ in12 /\ in11) /\ + (ge24 <=> ge3 /\ in19 /\ in18) /\ + (ge21 <=> ~in17 /\ ~in16 /\ ~in12 /\ ~in11) /\ + (ge22 <=> ge2 /\ ~in19 /\ ~in18) /\ + (ge25 <=> ge24 /\ ge23) /\ + (ge6 <=> ~in14 /\ ~in13) /\ + (ge14 <=> ~in24 \/ ~in23 /\ in13) /\ + (ge4 <=> ge22 /\ ge21) /\ + (ge5 <=> ge25) /\ + (ge9 <=> ge6 /\ ~in22) /\ + (ge26 <=> in15 \/ in24 /\ ~in14) /\ + (ge7 <=> in22 /\ in14 /\ in13) /\ + (ge27 <=> ~in15 \/ ge14 /\ in14) /\ + (ge10 <=> ge4 /\ ~in15) /\ + (ge8 <=> ge5 /\ in15) /\ + (ge13 <=> ge6 /\ in23 \/ ge9 /\ in21 \/ ge26) /\ + (ge15 <=> ge7 /\ ~in21 \/ ge27) /\ + (ge11 <=> ~in19 \/ in18 /\ ~in17) /\ + (ge12 <=> in19 \/ ~in18 /\ in17) /\ + (ge20 <=> ge2 /\ in12 \/ ge3 /\ ~in12) /\ + (ge16 <=> ~in24 /\ ~in23 /\ ~in21 /\ ~in20) /\ + (ge17 <=> ge10 /\ ge9) /\ + (ge18 <=> in24 /\ in23 /\ in21 /\ in20) /\ + (ge19 <=> ge8 /\ ge7) /\ + (out0 <=> ge3) /\ + (out1 <=> ge2) /\ + (out2 <=> ge8 \/ ge10) /\ + (out3 <=> ge19 /\ ge18 \/ ge17 /\ ge16) /\ + (out4 <=> ge11 /\ ge3 /\ in11 \/ ge12 /\ ge2 /\ ~in11 \/ ge20) /\ + (out5 <=> ge13 /\ ge2 \/ ge15 /\ ge3) /\ + (out6 <=> ge5) /\ + (out7 <=> ge4) /\ + (wres0 <=> ~in2 /\ in1 /\ in0 \/ ~in1 /\ ~in0) /\ + (wres1 <=> in1 \/ in0) /\ + (wres6 <=> ~in14 /\ ~in13) /\ + (wres3 <=> + wres0 /\ in7 \/ wres1 /\ in3 /\ in2 \/ in6 /\ ~in5 /\ ~in4 /\ ~in2) /\ + (wres2 <=> + wres0 /\ in10 \/ wres1 /\ in8 /\ in2 \/ in9 /\ ~in5 /\ ~in4 /\ ~in2) /\ + (wres9 <=> wres6 /\ ~in22) /\ + (wres7 <=> in22 /\ in14 /\ in13) /\ + (wres14 <=> ~in24 \/ ~in23 /\ in13) /\ + (wres5 <=> wres3 /\ in19 /\ in18 /\ in17 /\ in16 /\ in12 /\ in11) /\ + (wres4 <=> wres2 /\ ~in19 /\ ~in18 /\ ~in17 /\ ~in16 /\ ~in12 /\ ~in11) /\ + (wres13 <=> wres6 /\ in23 \/ wres9 /\ in21 \/ in15 \/ in24 /\ ~in14) /\ + (wres15 <=> wres7 /\ ~in21 \/ ~in15 \/ wres14 /\ in14) /\ + (wres11 <=> ~in19 \/ in18 /\ ~in17) /\ + (wres12 <=> in19 \/ ~in18 /\ in17) /\ + (wres8 <=> wres5 /\ in15) /\ + (wres10 <=> wres4 /\ ~in15) + ==> (out7 <=> wres4) /\ + (out6 <=> wres5) /\ + (out5 <=> wres13 /\ wres2 \/ wres15 /\ wres3) /\ + (out4 <=> + wres2 /\ in12 \/ + wres3 /\ ~in12 \/ + wres11 /\ wres3 /\ in11 \/ + wres12 /\ wres2 /\ ~in11) /\ + (out3 <=> + wres8 /\ wres7 /\ in24 /\ in23 /\ in21 /\ in20 \/ + wres10 /\ wres9 /\ ~in24 /\ ~in23 /\ ~in21 /\ ~in20) /\ + (out2 <=> wres8 \/ wres10) /\ + (out1 <=> wres2) /\ + (out0 <=> wres3)` ;; + +let misg_be = + `(ge1 <=> ~in45 \/ ~in40) /\ + (ge10 <=> ~in45 /\ ~in36 \/ ge1 /\ ~in43) /\ + (ge6 <=> ~in43 \/ ~in36) /\ + (ge16 <=> ge10 /\ ~in38 \/ ~in53) /\ + (ge3 <=> ~in54 \/ ~in34) /\ + (ge11 <=> ge6 /\ ge1 /\ ~in44 \/ ge16) /\ + (ge4 <=> ~in39 \/ ~in40) /\ + (ge2 <=> ~in45 /\ ~in39 \/ ~in40) /\ + (ge5 <=> ~in38 \/ ~in44 /\ ~in37) /\ + (ge8 <=> ~in43 /\ ~in35 \/ ~in36) /\ + (ge14 <=> ~in49 \/ ge11 /\ ge3) /\ + (ge0 <=> in54 /\ in33 /\ in20) /\ + (ge7 <=> ~in37 \/ ~in38) /\ + (ge9 <=> ge4 /\ ~in37 \/ ~in39 /\ ~in38) /\ + (ge15 <=> ge14 \/ ~in47 \/ ~in32 \/ ge8 /\ ge5 /\ ge2) /\ + (ge13 <=> ~in49 \/ in10 \/ ~in22) /\ + (ge12 <=> in10 \/ in13 /\ in11) /\ + (out0 <=> in7 /\ in6 \/ in5 /\ in4 \/ in3 /\ in2 \/ in1 /\ in0) /\ + (out1 <=> ~in48) /\ + (out2 <=> ~in9 \/ ge12) /\ + (out3 <=> ~in8 \/ ~in14) /\ + (out4 <=> ~in15) /\ + (out5 <=> ~in16) /\ + (out6 <=> ~in17) /\ + (out7 <=> ~in12) /\ + (out8 <=> ge13 \/ ~in21) /\ + (out9 <=> ~in23 \/ ~in24) /\ + (out10 <=> in20 /\ in19 /\ in18) /\ + (out11 <=> ~in26 \/ ~in25) /\ + (out12 <=> ~in28 \/ in27 \/ in17) /\ + (out13 <=> ~in29 \/ in27) /\ + (out14 <=> ~in50 /\ in49 \/ in27) /\ + (out15 <=> in30 \/ in31) /\ + (out16 <=> ~in51) /\ + (out17 <=> ~in52) /\ + (out18 <=> ~in41 \/ ~in42) /\ + (out19 <=> ~in46 \/ ge0) /\ + (out20 <=> ge15 \/ ge7 /\ ge4 /\ ~in53 /\ ~in35 \/ ge9 /\ ~in53 /\ ~in36) /\ + (out21 <=> ~in55) /\ + (out22 <=> ~in32 \/ ge0) /\ + (wres1 <=> ~in45 \/ ~in40) /\ + (wres4 <=> ~in39 \/ ~in40) /\ + (wres6 <=> ~in43 \/ ~in36) /\ + (wres10 <=> ~in45 /\ ~in36 \/ wres1 /\ ~in43) /\ + (wres0 <=> in54 /\ in33 /\ in20) /\ + (wres2 <=> ~in45 /\ ~in39 \/ ~in40) /\ + (wres3 <=> ~in54 \/ ~in34) /\ + (wres5 <=> ~in38 \/ ~in44 /\ ~in37) /\ + (wres7 <=> ~in37 \/ ~in38) /\ + (wres8 <=> ~in36 \/ ~in43 /\ ~in35) /\ + (wres9 <=> wres4 /\ ~in37 \/ ~in39 /\ ~in38) /\ + (wres11 <=> wres10 /\ ~in38 \/ wres6 /\ wres1 /\ ~in44 \/ ~in53) + ==> (out22 <=> ~in32 \/ wres0) /\ + (out21 <=> ~in55) /\ + (out20 <=> + ~in47 \/ + wres7 /\ wres4 /\ ~in53 /\ ~in35 \/ + wres8 /\ wres5 /\ wres2 \/ + wres9 /\ ~in53 /\ ~in36 \/ + ~in32 \/ + wres11 /\ wres3 \/ + ~in49) /\ + (out19 <=> ~in46 \/ wres0) /\ + (out18 <=> ~in41 \/ ~in42) /\ + (out17 <=> ~in52) /\ + (out16 <=> ~in51) /\ + (out15 <=> in30 \/ in31) /\ + (out14 <=> ~in50 /\ in49 \/ in27) /\ + (out13 <=> ~in29 \/ in27) /\ + (out12 <=> ~in28 \/ in27 \/ in17) /\ + (out11 <=> ~in26 \/ ~in25) /\ + (out10 <=> in20 /\ in19 /\ in18) /\ + (out9 <=> ~in23 \/ ~in24) /\ + (out8 <=> ~in21 \/ ~in22 \/ ~in49 \/ in10) /\ + (out7 <=> ~in12) /\ + (out6 <=> ~in17) /\ + (out5 <=> ~in16) /\ + (out4 <=> ~in15) /\ + (out3 <=> ~in8 \/ ~in14) /\ + (out2 <=> in13 /\ in11 \/ ~in9 \/ in10) /\ + (out1 <=> ~in48) /\ + (out0 <=> in7 /\ in6 \/ in5 /\ in4 \/ in3 /\ in2 \/ in1 /\ in0)` ;; + +let x1dn_be = + `(ge0 <=> ~in8 /\ ~in7 \/ in8 /\ in7 /\ ~in6) /\ + (ge1 <=> in8 \/ in7) /\ + (ge3 <=> in14 /\ ~in11 /\ ~in10 /\ ~in6 \/ ge1 /\ in15 /\ in6 \/ ge0 /\ in13) /\ + (ge2 <=> ~in11 /\ ~in10 /\ in9 /\ ~in6 \/ ge1 /\ in12 /\ in6 \/ ge0 /\ in5) /\ + (ge20 <=> in3 /\ in2 /\ in1 /\ in0) /\ + (ge21 <=> ge3 /\ in23 /\ in4) /\ + (ge18 <=> ~in3 /\ ~in2 /\ ~in1 /\ ~in0) /\ + (ge19 <=> ge2 /\ ~in23 /\ ~in4) /\ + (ge22 <=> ge21 /\ ge20) /\ + (ge4 <=> ge19 /\ ge18) /\ + (ge5 <=> ge22) /\ + (ge6 <=> ~in22 /\ ~in20 /\ ~in18) /\ + (ge9 <=> ge4 /\ ~in16) /\ + (ge7 <=> in22 /\ in20 /\ in18) /\ + (ge8 <=> ge5 /\ in16) /\ + (ge12 <=> in20 /\ ~in19 \/ ~in17) /\ + (ge14 <=> ~in20 /\ in19 \/ in17) /\ + (ge25 <=> ~in26 /\ ~in21 /\ ~in19 /\ ~in17) /\ + (ge26 <=> ge9 /\ ge6) /\ + (ge27 <=> in26 /\ in21 /\ in19 /\ in17) /\ + (ge28 <=> ge8 /\ ge7) /\ + (ge23 <=> ~in16 \/ ge12 /\ in18) /\ + (ge24 <=> in16 \/ ge14 /\ ~in18) /\ + (ge16 <=> ge28 /\ ge27 \/ ge26 /\ ge25) /\ + (ge13 <=> ge7 /\ ~in21 \/ ge23) /\ + (ge15 <=> ge6 /\ in21 \/ ge24) /\ + (ge10 <=> ~in4 \/ in3 /\ ~in2) /\ + (ge11 <=> in4 \/ ~in3 /\ in2) /\ + (ge17 <=> ge2 /\ in0 \/ ge3 /\ ~in0) /\ + (out0 <=> ge10 /\ ge3 /\ in1 \/ ge11 /\ ge2 /\ ~in1 \/ ge17) /\ + (out1 <=> ge13 /\ ge3 \/ ge15 /\ ge2) /\ + (out2 <=> ge8 \/ ge9) /\ + (out3 <=> ge5) /\ + (out4 <=> ge4) /\ + (out5 <=> ge16 /\ ~in25 \/ ge16 /\ ~in24) /\ + (wres0 <=> ~in8 /\ ~in7 \/ in8 /\ in7 /\ ~in6) /\ + (wres1 <=> in8 \/ in7) /\ + (wres3 <=> + wres0 /\ in13 \/ wres1 /\ in15 /\ in6 \/ in14 /\ ~in11 /\ ~in10 /\ ~in6) /\ + (wres2 <=> + wres1 /\ in12 /\ in6 \/ ~in11 /\ ~in10 /\ in9 /\ ~in6 \/ wres0 /\ in5) /\ + (wres5 <=> wres3 /\ in23 /\ in4 /\ in3 /\ in2 /\ in1 /\ in0) /\ + (wres4 <=> wres2 /\ ~in23 /\ ~in4 /\ ~in3 /\ ~in2 /\ ~in1 /\ ~in0) /\ + (wres6 <=> ~in22 /\ ~in20 /\ ~in18) /\ + (wres7 <=> in22 /\ in20 /\ in18) /\ + (wres8 <=> wres5 /\ in16) /\ + (wres9 <=> wres4 /\ ~in16) /\ + (wres12 <=> in20 /\ ~in19 \/ ~in17) /\ + (wres14 <=> ~in20 /\ in19 \/ in17) /\ + (wres16 <=> + wres8 /\ wres7 /\ in26 /\ in21 /\ in19 /\ in17 \/ + wres9 /\ wres6 /\ ~in26 /\ ~in21 /\ ~in19 /\ ~in17) /\ + (wres13 <=> wres7 /\ ~in21 \/ wres12 /\ in18 \/ ~in16) /\ + (wres15 <=> wres6 /\ in21 \/ wres14 /\ ~in18 \/ in16) /\ + (wres10 <=> ~in4 \/ in3 /\ ~in2) /\ + (wres11 <=> in4 \/ ~in3 /\ in2) + ==> (out5 <=> wres16 /\ ~in25 \/ wres16 /\ ~in24) /\ + (out4 <=> wres4) /\ + (out3 <=> wres5) /\ + (out2 <=> wres8 \/ wres9) /\ + (out1 <=> wres13 /\ wres3 \/ wres15 /\ wres2) /\ + (out0 <=> + wres2 /\ in0 \/ + wres3 /\ ~in0 \/ + wres10 /\ wres3 /\ in1 \/ + wres11 /\ wres2 /\ ~in1)` ;; + +let counter_be = + `(b6 <=> a1 /\ ~a2 \/ ~a1 /\ a2 \/ ~a0 /\ a1 \/ a3) /\ + (b5 <=> a0 /\ ~a1 /\ a2 \/ ~a0 /\ a1 \/ a1 /\ ~a2 \/ ~a0 /\ ~a2 \/ a3) /\ + (b4 <=> a0 \/ a2 \/ ~a1) /\ + (b3 <=> ~a2 /\ ~a3 \/ a0 /\ a1 \/ ~a0 /\ ~a1 \/ a3) /\ + (b2 <=> ~a0 /\ ~a2 \/ a0 /\ a2 \/ a1 \/ a3) /\ + (b1 <=> ~a0 /\ a2 \/ a3 \/ ~a1 /\ a2 \/ ~a0 /\ ~a1) /\ + (b0 <=> ~a0 /\ a1 \/ ~a0 /\ ~a2) /\ + (ta3 <=> + cb /\ a3 \/ + ~ca /\ a3 \/ + ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ + ca /\ ~cb /\ ~a0 /\ a3) /\ + (ta2 <=> + cb /\ a2 \/ + ~ca /\ a2 \/ + ca /\ ~cb /\ a0 /\ a1 /\ ~a2 \/ + ca /\ ~cb /\ ~a0 /\ a1 /\ a2 \/ + ca /\ ~cb /\ ~a1 /\ a2) /\ + (ta1 <=> + cb /\ a1 \/ + ~ca /\ a1 \/ + ca /\ ~cb /\ ~a0 /\ a1 /\ ~a3 \/ + ca /\ ~cb /\ a0 /\ ~a1 /\ ~a3) /\ + (ta0 <=> cb /\ a0 \/ ~ca /\ a0 \/ ca /\ ~cb /\ ~a0) /\ + (tcb <=> ca) + ==> (tcb <=> ca) /\ + (ta0 <=> cb /\ a0 \/ ~ca /\ a0 \/ ca /\ ~cb /\ ~a0) /\ + (ta1 <=> + ~a0 /\ a1 /\ ~a3 \/ + ca /\ ~cb /\ a0 /\ ~a1 /\ ~a3 \/ + cb /\ a1 \/ + ~ca /\ a1) /\ + (ta2 <=> + ~a0 /\ a2 \/ + a0 /\ ~a1 /\ a2 \/ + cb /\ a0 /\ a1 /\ a2 \/ + ~ca /\ a0 /\ a1 /\ a2 \/ + ca /\ ~cb /\ a0 /\ a1 /\ ~a2) /\ + (ta3 <=> + ~a0 /\ a3 \/ + cb /\ a0 /\ a3 \/ + ~ca /\ a3 \/ + ca /\ ~cb /\ a0 /\ a1 /\ a2) /\ + (b0 <=> ~a0 /\ ~a1 /\ ~a2 \/ ~a0 /\ a1) /\ + (b1 <=> + ~a0 /\ a3 \/ + a0 /\ a3 \/ + ~a0 /\ a2 \/ + a0 /\ ~a1 /\ a2 \/ + ~a0 /\ ~a1 /\ ~a2) /\ + (b2 <=> + ~a0 /\ a3 \/ + a0 /\ a3 \/ + ~a0 /\ a1 /\ ~a3 \/ + ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ + a0 /\ ~a1 /\ a2 \/ + cb /\ a0 /\ a1 /\ a2 \/ + ~ca /\ a0 /\ a1 /\ a2 \/ + a1 /\ ~a2 \/ + ~a0 /\ ~a1 /\ ~a2) /\ + (b3 <=> + ~a0 /\ a3 \/ + a0 /\ a3 \/ + ~a2 \/ + ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ + ~a0 /\ ~a1 /\ a2 \/ + cb /\ a0 /\ a1 /\ a2 \/ + ~ca /\ a0 /\ a1 /\ a2) /\ + (b4 <=> + a0 /\ a3 \/ + ca /\ ~cb /\ a0 /\ ~a1 /\ ~a3 \/ + ca /\ ~cb /\ a0 /\ a1 /\ a2 \/ + ~a0 /\ a2 \/ + ca /\ ~cb /\ a0 /\ a1 /\ ~a2 \/ + ~a0 /\ ~a1 /\ ~a2 \/ + cb /\ a0 \/ + ~ca /\ a0) /\ + (b5 <=> + ~a0 /\ a3 \/ + a0 /\ a3 \/ + a0 /\ ~a1 /\ a2 \/ + a1 /\ ~a2 \/ + ~a0 /\ ~a1 /\ ~a2 \/ + ~a0 /\ a1) /\ + (b6 <=> + ~a0 /\ a3 \/ + a0 /\ a3 \/ + a0 /\ ~a1 /\ a2 \/ + ~a0 /\ ~a1 /\ a2 \/ + a1 /\ ~a2 \/ + ~a0 /\ a1)` ;; + +let sqn_be = + `(ge0 <=> in6 /\ in1 \/ ~in6 /\ ~in1) /\ + (ge8 <=> ~in3 /\ ~in1) /\ + (ge5 <=> in6 \/ in5) /\ + (ge9 <=> ~ge0 \/ in2 \/ ~in5) /\ + (ge1 <=> in3 \/ ~in0) /\ + (ge11 <=> ge8 /\ in4) /\ + (ge3 <=> ~in4 \/ ~in2) /\ + (ge34 <=> ~ge5 /\ in4 \/ ~ge9) /\ + (ge2 <=> ~in4 /\ in1) /\ + (ge14 <=> ~ge1 /\ ~in4) /\ + (ge19 <=> ge11 /\ ~ge5) /\ + (ge13 <=> ge8 /\ ~ge3 /\ ~in0) /\ + (ge20 <=> ~in5 /\ in2 \/ ge34) /\ + (ge12 <=> ge2 /\ ~in3) /\ + (ge27 <=> ge14 /\ in6 \/ ge19) /\ + (ge10 <=> ~in6 \/ in5) /\ + (ge28 <=> ge13 \/ ge20 /\ ~ge1) /\ + (ge6 <=> ~in5 \/ in6) /\ + (ge15 <=> ge2 /\ in2) /\ + (ge29 <=> ge27 \/ ge12 /\ ge5) /\ + (ge4 <=> in3 /\ ~in0) /\ + (ge21 <=> ~ge10 /\ ~in1 \/ ~in5 /\ ~in2) /\ + (ge30 <=> ge28 \/ ge14 /\ in2) /\ + (ge31 <=> ge29 \/ ge15 /\ ~ge6) /\ + (ge7 <=> ~in6 \/ ~in5) /\ + (ge17 <=> ~ge3 /\ ~in1) /\ + (ge18 <=> ge4 /\ in2) /\ + (ge16 <=> ge2 /\ in0) /\ + (ge23 <=> ge19 \/ ge9 /\ ~ge1) /\ + (ge32 <=> ge15 /\ ~in6 /\ ~in0 \/ ge21 /\ ge4 /\ ~in4 \/ ge30 \/ ge31) /\ + (ge33 <=> + ge18 /\ ~ge6 /\ ~in4 \/ + ge17 /\ ~ge7 /\ in3 \/ + ~ge7 /\ ge4 /\ ~ge3 \/ + ge11 /\ in5 /\ ~in0) /\ + (ge25 <=> ge14 /\ ~ge6 \/ ge13 /\ ~ge5 \/ ge16 /\ ~in5 \/ ge15 /\ ge1) /\ + (ge26 <=> + ge12 /\ in5 /\ ~in2 \/ + ge10 /\ ge4 /\ in1 \/ + ge17 /\ ~ge6 /\ in0 \/ + ge2 /\ ~in6) /\ + (ge24 <=> ge23 \/ ge16 /\ ge7) /\ + (out0 <=> + ge6 /\ in4 /\ ~in1 /\ in0 \/ ge18 /\ ge0 /\ ~in5 \/ ge12 /\ ~ge10 \/ ge24) /\ + (out1 <=> ge26 \/ ge25 \/ ~ge5 /\ ge4 /\ ge3 \/ ge7 /\ ~ge1 /\ in1) /\ + (out2 <=> ge33 \/ ge32) /\ + (wres8 <=> ~in3 /\ ~in1) /\ + (wres0 <=> in6 /\ in1 \/ ~in6 /\ ~in1) /\ + (wres2 <=> ~in4 /\ in1) /\ + (wres3 <=> ~in4 \/ ~in2) /\ + (wres1 <=> in3 \/ ~in0) /\ + (wres4 <=> in3 /\ ~in0) /\ + (wres5 <=> in6 \/ in5) /\ + (wres11 <=> wres8 /\ in4) /\ + (wres9 <=> ~wres0 \/ in2 \/ ~in5) /\ + (wres10 <=> ~in6 \/ in5) /\ + (wres6 <=> ~in5 \/ in6) /\ + (wres7 <=> ~in6 \/ ~in5) /\ + (wres12 <=> wres2 /\ ~in3) /\ + (wres13 <=> wres8 /\ ~wres3 /\ ~in0) /\ + (wres14 <=> ~wres1 /\ ~in4) /\ + (wres15 <=> wres2 /\ in2) /\ + (wres17 <=> ~wres3 /\ ~in1) /\ + (wres18 <=> wres4 /\ in2) /\ + (wres19 <=> wres11 /\ ~wres5) /\ + (wres20 <=> ~in5 /\ in2 \/ ~wres5 /\ in4 \/ ~wres9) /\ + (wres21 <=> ~wres10 /\ ~in1 \/ ~in5 /\ ~in2) /\ + (wres16 <=> wres2 /\ in0) + ==> (out2 <=> + wres11 /\ in5 /\ ~in0 \/ + ~wres7 /\ wres4 /\ ~wres3 \/ + wres12 /\ wres5 \/ + wres13 \/ + wres14 /\ in2 \/ + wres14 /\ in6 \/ + wres15 /\ ~wres6 \/ + wres15 /\ ~in6 /\ ~in0 \/ + wres17 /\ ~wres7 /\ in3 \/ + wres18 /\ ~wres6 /\ ~in4 \/ + wres20 /\ ~wres1 \/ + wres21 /\ wres4 /\ ~in4 \/ + wres19) /\ + (out1 <=> + ~wres5 /\ wres4 /\ wres3 \/ + wres7 /\ ~wres1 /\ in1 \/ + wres2 /\ ~in6 \/ + wres10 /\ wres4 /\ in1 \/ + wres12 /\ in5 /\ ~in2 \/ + wres13 /\ ~wres5 \/ + wres14 /\ ~wres6 \/ + wres15 /\ wres1 \/ + wres16 /\ ~in5 \/ + wres17 /\ ~wres6 /\ in0) /\ + (out0 <=> + wres6 /\ in4 /\ ~in1 /\ in0 \/ + wres9 /\ ~wres1 \/ + wres12 /\ ~wres10 \/ + wres16 /\ wres7 \/ + wres18 /\ wres0 /\ ~in5 \/ + wres19)` ;; + +let add2_be = + `(n3 <=> a_0_) /\ + (n4 <=> a_3_) /\ + (n5 <=> a_1_) /\ + (n6 <=> a_2_) /\ + (n7 <=> anda) /\ + (n8 <=> exora) /\ + (n9 <=> b_3_) /\ + (n10 <=> b_1_) /\ + (n11 <=> b_0_) /\ + (n12 <=> b_2_) /\ + (n13 <=> andb) /\ + (n14 <=> exorb) /\ + (n15 <=> carryin) /\ + (n42 <=> ~n13) /\ + (n48 <=> ~n14) /\ + (n41 <=> ~n7) /\ + (n47 <=> ~n8) /\ + (n46 <=> ~n15) /\ + (n49 <=> ~n46) /\ + (n86 <=> ~n9 \/ ~n42) /\ + (n94 <=> ~n48) /\ + (n85 <=> ~n4 \/ ~n41) /\ + (n93 <=> ~n47) /\ + (n60 <=> ~n10 \/ ~n42) /\ + (n68 <=> ~n48) /\ + (n59 <=> ~n5 \/ ~n41) /\ + (n67 <=> ~n47) /\ + (n54 <=> ~n11 \/ ~n42) /\ + (n44 <=> ~n48) /\ + (n53 <=> ~n3 \/ ~n41) /\ + (n43 <=> ~n47) /\ + (n80 <=> ~n12 \/ ~n42) /\ + (n72 <=> ~n48) /\ + (n79 <=> ~n6 \/ ~n41) /\ + (n71 <=> ~n47) /\ + (n35 <=> ~n86) /\ + (n37 <=> ~n85) /\ + (n27 <=> ~n60) /\ + (n29 <=> ~n59) /\ + (n25 <=> ~n54) /\ + (n23 <=> ~n53) /\ + (n33 <=> ~n80) /\ + (n31 <=> ~n79) /\ + (n89 <=> n35 /\ n48 \/ ~n35 /\ ~n48) /\ + (n88 <=> n37 /\ n47 \/ ~n37 /\ ~n47) /\ + (n63 <=> n27 /\ n48 \/ ~n27 /\ ~n48) /\ + (n62 <=> n29 /\ n47 \/ ~n29 /\ ~n47) /\ + (n52 <=> n25 /\ n48 \/ ~n25 /\ ~n48) /\ + (n51 <=> n23 /\ n47 \/ ~n23 /\ ~n47) /\ + (n78 <=> n33 /\ n48 \/ ~n33 /\ ~n48) /\ + (n77 <=> n31 /\ n47 \/ ~n31 /\ ~n47) /\ + (n36 <=> ~n89) /\ + (n38 <=> ~n88) /\ + (n28 <=> ~n63) /\ + (n30 <=> ~n62) /\ + (n26 <=> ~n52) /\ + (n24 <=> ~n51) /\ + (n34 <=> ~n78) /\ + (n32 <=> ~n77) /\ + (n92 <=> ~n38) /\ + (n66 <=> ~n30) /\ + (n40 <=> ~n24) /\ + (n70 <=> ~n32) /\ + (n91 <=> n36 /\ n38 \/ ~n36 /\ ~n38) /\ + (n65 <=> n28 /\ n30 \/ ~n28 /\ ~n30) /\ + (n45 <=> n26 /\ n24 \/ ~n26 /\ ~n24) /\ + (n73 <=> n34 /\ n32 \/ ~n34 /\ ~n32) /\ + (n83 <=> ~n91) /\ + (n57 <=> ~n65) /\ + (n39 <=> ~n45) /\ + (n69 <=> ~n73) /\ + (n90 <=> ~n83) /\ + (n64 <=> ~n57) /\ + (n55 <=> ~n39) /\ + (n81 <=> ~n69) /\ + (n50 <=> n49 /\ ~n39 \/ ~n49 /\ n39) /\ + (n56 <=> ~n39 /\ ~n24 \/ ~n55 /\ ~n46) /\ + (n58 <=> ~n56) /\ + (n17 <=> ~n50) /\ + (n74 <=> ~n64 /\ ~n56 \/ ~n66 /\ ~n57) /\ + (n61 <=> n58 /\ n57 \/ ~n58 /\ ~n57) /\ + (n82 <=> ~n69 /\ ~n32 \/ ~n81 /\ ~n74) /\ + (n75 <=> ~n74) /\ + (n95 <=> ~n82) /\ + (n96 <=> ~n90 /\ ~n82 \/ ~n92 /\ ~n83) /\ + (n16 <=> ~n61) /\ + (n84 <=> ~n82) /\ + (n76 <=> n75 /\ ~n69 \/ ~n75 /\ n69) /\ + (n97 <=> n96 /\ n82 \/ ~n96 /\ ~n82) /\ + (n19 <=> ~n96) /\ + (n87 <=> n84 /\ n83 \/ ~n84 /\ ~n83) /\ + (n18 <=> ~n76) /\ + (n20 <=> ~n97) /\ + (n22 <=> ~n87) /\ + (n21 <=> ~n22) /\ + (sign <=> n21) /\ + (overflow <=> n20) /\ + (carryout <=> n19) /\ + (o_3_ <=> n22) /\ + (o_2_ <=> n18) /\ + (o_1_ <=> n16) /\ + (o_0_ <=> n17) /\ + (buf1 <=> ~anda) /\ + (buf2 <=> ~andb) /\ + (buf3 <=> ~exora) /\ + (buf4 <=> ~exorb) /\ + (buf5 <=> ~carryin) /\ + (n1_0_ <=> buf1 /\ a_0_) /\ + (n1_1_ <=> buf1 /\ a_1_) /\ + (n1_2_ <=> buf1 /\ a_2_) /\ + (n1_3_ <=> buf1 /\ a_3_) /\ + (n3_0_ <=> buf2 /\ b_0_) /\ + (n3_1_ <=> buf2 /\ b_1_) /\ + (n3_2_ <=> buf2 /\ b_2_) /\ + (n3_3_ <=> buf2 /\ b_3_) /\ + (n2_0_ <=> buf3 /\ ~n1_0_ \/ ~buf3 /\ n1_0_) /\ + (n2_1_ <=> buf3 /\ ~n1_1_ \/ ~buf3 /\ n1_1_) /\ + (n2_2_ <=> buf3 /\ ~n1_2_ \/ ~buf3 /\ n1_2_) /\ + (n2_3_ <=> buf3 /\ ~n1_3_ \/ ~buf3 /\ n1_3_) /\ + (n4_0_ <=> buf4 /\ ~n3_0_ \/ ~buf4 /\ n3_0_) /\ + (n4_1_ <=> buf4 /\ ~n3_1_ \/ ~buf4 /\ n3_1_) /\ + (n4_2_ <=> buf4 /\ ~n3_2_ \/ ~buf4 /\ n3_2_) /\ + (n4_3_ <=> buf4 /\ ~n3_3_ \/ ~buf4 /\ n3_3_) /\ + (cout1 <=> buf5 /\ n4_0_ \/ buf5 /\ n2_0_ \/ n4_0_ /\ n2_0_) /\ + (cout2 <=> cout1 /\ n4_1_ \/ cout1 /\ n2_1_ \/ n4_1_ /\ n2_1_) /\ + (cout3 <=> cout2 /\ n4_2_ \/ cout2 /\ n2_2_ \/ n4_2_ /\ n2_2_) /\ + (hulp0 <=> ~(n2_0_ <=> ~(n4_0_ <=> buf5))) /\ + (hulp1 <=> ~(n2_1_ <=> ~(n4_1_ <=> cout1))) /\ + (hulp2 <=> ~(n2_2_ <=> ~(n4_2_ <=> cout2))) /\ + (hulp3 <=> ~(n2_3_ <=> ~(n4_3_ <=> cout3))) /\ + (hulp4 <=> cout3 /\ n4_3_ \/ cout3 /\ n2_3_ \/ n4_3_ /\ n2_3_) + ==> (o_0_ <=> hulp0) /\ + (o_1_ <=> hulp1) /\ + (o_2_ <=> hulp2) /\ + (o_3_ <=> hulp3) /\ + (carryout <=> ~hulp4) /\ + (overflow <=> (cout3 <=> hulp4)) /\ + (sign <=> ~hulp3)` ;; + +let dc2_be = + `(ge0 <=> ~in4 /\ ~in0) /\ + (ge10 <=> ge0 /\ in5 /\ ~in2) /\ + (ge2 <=> ~in6 /\ ~in5 /\ in4 /\ ~in0) /\ + (ge4 <=> ge0 /\ in5 /\ in2) /\ + (ge22 <=> ge0 /\ ~in5) /\ + (ge23 <=> ge10 /\ ~in6) /\ + (ge6 <=> ge0 /\ ~in3) /\ + (ge21 <=> ge4 /\ in3 \/ ge2 /\ in3 /\ in2) /\ + (ge44 <=> ge22 /\ in6 \/ ge23) /\ + (ge11 <=> ge6 /\ ~in5) /\ + (ge1 <=> ~in4 /\ ~in2 /\ ~in1) /\ + (ge8 <=> ge21 \/ ge44) /\ + (ge24 <=> ge11 /\ in1) /\ + (ge3 <=> ~in6 /\ ~in5 /\ ~in1) /\ + (ge18 <=> ge0 /\ in2) /\ + (ge19 <=> ge11 /\ in2) /\ + (ge20 <=> ge1 /\ in3) /\ + (ge45 <=> ge1 /\ ~in5 \/ ge4) /\ + (ge16 <=> ~in2 /\ in1) /\ + (ge33 <=> ge8 /\ in1 \/ ge24) /\ + (ge5 <=> ge2 \/ in3 /\ ~in0) /\ + (ge29 <=> ge19 \/ ge18 /\ ge3) /\ + (ge14 <=> ge3 /\ in3) /\ + (ge41 <=> ge6 /\ in6 \/ ge20 /\ ~in6) /\ + (ge7 <=> in6 /\ in3) /\ + (ge25 <=> ge22 /\ ~in2 \/ ge45) /\ + (ge13 <=> ~in6 /\ ~in5 /\ ~in0) /\ + (ge12 <=> ~in3 /\ ~in1) /\ + (ge34 <=> ge33 \/ ge16 /\ ge6) /\ + (ge15 <=> ~in2 /\ in0) /\ + (ge30 <=> ge29 \/ ge16 /\ ge5) /\ + (ge42 <=> ge41 \/ ge14 /\ ~in2) /\ + (ge17 <=> ge1 /\ in5) /\ + (ge37 <=> ge25 /\ ge7 \/ ge19) /\ + (ge38 <=> ge23 \/ ge13 /\ in2) /\ + (ge35 <=> ge34 \/ ge12 /\ ge4) /\ + (ge31 <=> ge30 \/ ge15 /\ ge12) /\ + (ge27 <=> ge24 \/ ge21 /\ ~in1) /\ + (ge43 <=> ge0 /\ ~in6 /\ in3 \/ ge13 /\ in3 \/ ge42) /\ + (ge39 <=> ge37 \/ ge17 /\ ~in3) /\ + (ge40 <=> ge38 \/ ge17 /\ ~in6) /\ + (ge9 <=> ~in6 \/ ~in5) /\ + (ge36 <=> ge35 \/ ge12 /\ ge2) /\ + (ge32 <=> ge31 \/ ge10 /\ ge7) /\ + (ge28 <=> ge27 \/ ge16 /\ ~in0) /\ + (ge26 <=> ge4 /\ in1 \/ ge15 /\ ~in1) /\ + (out0 <=> ge5 /\ in2 /\ in1 \/ ge26) /\ + (out1 <=> + ge15 /\ ge14 /\ in4 \/ ge17 /\ ge7 /\ in0 \/ ge18 /\ ge7 /\ ~in1 \/ ge28) /\ + (out2 <=> + ge12 /\ in2 /\ ~in0 \/ ge9 /\ ge1 /\ in0 \/ ge2 /\ in3 /\ ~in2 \/ ge32) /\ + (out3 <=> ge3 /\ in4 /\ ~in3 /\ ~in2 \/ ge14 /\ ge0 \/ ge20 /\ ge9 \/ ge36) /\ + (out4 <=> ge6 /\ in5 /\ ~in2 \/ ge40 \/ ge39) /\ + (out5 <=> ge43 \/ ge1 /\ in6 /\ ~in3) /\ + (out6 <=> in7) /\ + (wres0 <=> ~in4 /\ ~in0) /\ + (wres6 <=> wres0 /\ ~in3) /\ + (wres2 <=> ~in6 /\ ~in5 /\ in4 /\ ~in0) /\ + (wres4 <=> wres0 /\ in5 /\ in2) /\ + (wres10 <=> wres0 /\ in5 /\ ~in2) /\ + (wres3 <=> ~in6 /\ ~in5 /\ ~in1) /\ + (wres1 <=> ~in4 /\ ~in2 /\ ~in1) /\ + (wres11 <=> wres6 /\ ~in5) /\ + (wres22 <=> wres0 /\ ~in5) /\ + (wres21 <=> wres4 /\ in3 \/ wres2 /\ in3 /\ in2) /\ + (wres23 <=> wres10 /\ ~in6) /\ + (wres13 <=> ~in6 /\ ~in5 /\ ~in0) /\ + (wres14 <=> wres3 /\ in3) /\ + (wres20 <=> wres1 /\ in3) /\ + (wres7 <=> in6 /\ in3) /\ + (wres17 <=> wres1 /\ in5) /\ + (wres19 <=> wres11 /\ in2) /\ + (wres25 <=> wres22 /\ ~in2 \/ wres1 /\ ~in5 \/ wres4) /\ + (wres8 <=> wres21 \/ wres22 /\ in6 \/ wres23) /\ + (wres9 <=> ~in6 \/ ~in5) /\ + (wres12 <=> ~in3 /\ ~in1) /\ + (wres16 <=> ~in2 /\ in1) /\ + (wres24 <=> wres11 /\ in1) /\ + (wres5 <=> wres2 \/ in3 /\ ~in0) /\ + (wres15 <=> ~in2 /\ in0) /\ + (wres18 <=> wres0 /\ in2) + ==> (out6:bool <=> in7) /\ + (out5 <=> + wres1 /\ in6 /\ ~in3 \/ + wres0 /\ ~in6 /\ in3 \/ + wres6 /\ in6 \/ + wres13 /\ in3 \/ + wres14 /\ ~in2 \/ + wres20 /\ ~in6) /\ + (out4 <=> + wres13 /\ in2 \/ + wres17 /\ ~in6 \/ + wres17 /\ ~in3 \/ + wres6 /\ in5 /\ ~in2 \/ + wres23 \/ + wres25 /\ wres7 \/ + wres19) /\ + (out3 <=> + wres14 /\ wres0 \/ + wres16 /\ wres6 \/ + wres20 /\ wres9 \/ + wres12 /\ wres2 \/ + wres12 /\ wres4 \/ + wres3 /\ in4 /\ ~in3 /\ ~in2 \/ + wres8 /\ in1 \/ + wres24) /\ + (out2 <=> + wres10 /\ wres7 \/ + wres9 /\ wres1 /\ in0 \/ + wres12 /\ in2 /\ ~in0 \/ + wres2 /\ in3 /\ ~in2 \/ + wres15 /\ wres12 \/ + wres16 /\ wres5 \/ + wres18 /\ wres3 \/ + wres19) /\ + (out1 <=> + wres15 /\ wres14 /\ in4 \/ + wres16 /\ ~in0 \/ + wres17 /\ wres7 /\ in0 \/ + wres18 /\ wres7 /\ ~in1 \/ + wres21 /\ ~in1 \/ + wres24) /\ + (out0 <=> wres4 /\ in1 \/ wres5 /\ in2 /\ in1 \/ wres15 /\ ~in1)`;; + +let f51m_be = + `(ge10 <=> in6 \/ ~in7) /\ + (ge5 <=> ~in5 /\ ~in4 /\ in2) /\ + (ge11 <=> ~in3 /\ in2) /\ + (ge21 <=> ~ge10 /\ in5) /\ + (ge23 <=> ge5 /\ ~in3) /\ + (ge7 <=> in7 /\ in6) /\ + (ge20 <=> ~in7 /\ ~in4) /\ + (ge35 <=> ge21 /\ ge11 \/ ge23) /\ + (ge8 <=> ~in6 /\ ~in5) /\ + (ge12 <=> ~in4 /\ ~in2) /\ + (ge19 <=> ge7 /\ in3) /\ + (ge36 <=> ge35 \/ ge20 /\ ge11) /\ + (ge44 <=> in4 \/ in7 /\ in6) /\ + (ge1 <=> in7 /\ in6 \/ in3) /\ + (ge18 <=> ge8 /\ ~in2) /\ + (ge37 <=> ge36 \/ ge19 /\ ge12) /\ + (ge43 <=> ~in3 \/ ~in6 /\ ~in5) /\ + (ge3 <=> in5 \/ in1 \/ ge44) /\ + (ge14 <=> ~ge1 /\ ~in4) /\ + (ge38 <=> ge37 \/ ge18 /\ in4) /\ + (ge9 <=> in4 \/ in5) /\ + (ge17 <=> in2 /\ in1) /\ + (ge0 <=> ~in7 /\ ~in6 \/ ~in5) /\ + (ge2 <=> ~in4 \/ ge43) /\ + (ge26 <=> ge14 \/ ~ge3) /\ + (ge22 <=> ~in7 /\ ~in6) /\ + (ge39 <=> ge38 \/ ge5 /\ ~in6) /\ + (ge47 <=> ge14 \/ ge7 /\ ge5) /\ + (ge29 <=> ge12 \/ ge18) /\ + (ge48 <=> ~ge3 \/ ge17 /\ ge9) /\ + (ge6 <=> ~ge0 /\ in4 \/ in3) /\ + (ge16 <=> ~in2 /\ in1) /\ + (ge45 <=> ~ge2 /\ ~in2 \/ ge26 /\ in2) /\ + (ge33 <=> ge8 \/ ge7 \/ ge22) /\ + (ge49 <=> ge8 \/ ~ge0 /\ in4) /\ + (ge50 <=> ge22 /\ ~in3 \/ ge19) /\ + (ge40 <=> ge39 \/ ge5 /\ ~in7) /\ + (ge4 <=> in7 /\ in6 /\ in5 \/ in4) /\ + (ge15 <=> ge11 /\ ~in1) /\ + (ge28 <=> ~ge2 \/ ge47) /\ + (ge30 <=> ge29 /\ ~in1 \/ ge48) /\ + (ge24 <=> ~ge6 \/ ge2 /\ ~in1) /\ + (ge46 <=> ge16 /\ ge6 \/ ge45) /\ + (ge42 <=> ge21 /\ ~in4 \/ ge33 /\ in4) /\ + (ge13 <=> in4 /\ ~in3) /\ + (ge31 <=> ~ge9 /\ ~in7 \/ ge49) /\ + (ge32 <=> ge50 \/ ge14) /\ + (ge41 <=> ge40 \/ ~ge2 /\ in2) /\ + (ge34 <=> ge16 /\ ~ge6 \/ ge28 /\ in1 \/ ge15 /\ ge4 \/ ge30 /\ in3) /\ + (ge25 <=> ge3 /\ in3 /\ in2 \/ ge17 /\ ge4 \/ ge24 /\ ~in2) /\ + (ge27 <=> ge15 \/ ge23 \/ ge46) /\ + (out0 <=> ge25 /\ in0 \/ ge27 /\ ~in0) /\ + (out1 <=> ge34 \/ ge13 /\ ~ge0 /\ ~in1) /\ + (out2 <=> + in6 /\ in5 /\ in4 /\ in2 \/ + ge12 /\ ge1 /\ in5 \/ + ge13 /\ ge0 /\ ~in2 \/ + ge41) /\ + (out3 <=> + ge13 /\ in6 /\ ~in5 \/ ge7 /\ ~in5 /\ ~in3 \/ ge31 /\ in3 \/ ge32 /\ in5) /\ + (out4 <=> ge20 /\ in6 \/ ge42) /\ + (out5 <=> ge8 /\ in7 \/ ge10 /\ in5) /\ + (out6 <=> ~in7 /\ in6 \/ ~ge10) /\ + (out7 <=> ~in7) /\ + (wres8 <=> ~in6 /\ ~in5) /\ + (wres0 <=> ~in7 /\ ~in6 \/ ~in5) /\ + (wres1 <=> in7 /\ in6 \/ in3) /\ + (wres7 <=> in7 /\ in6) /\ + (wres12 <=> ~in4 /\ ~in2) /\ + (wres18 <=> wres8 /\ ~in2) /\ + (wres2 <=> ~in6 /\ ~in5 \/ ~in4 \/ ~in3) /\ + (wres6 <=> ~wres0 /\ in4 \/ in3) /\ + (wres11 <=> ~in3 /\ in2) /\ + (wres5 <=> ~in5 /\ ~in4 /\ in2) /\ + (wres3 <=> in5 \/ in4 \/ in1 \/ in7 /\ in6) /\ + (wres14 <=> ~wres1 /\ ~in4) /\ + (wres10 <=> in6 \/ ~in7) /\ + (wres22 <=> ~in7 /\ ~in6) /\ + (wres9 <=> in5 \/ in4) /\ + (wres19 <=> wres7 /\ in3) /\ + (wres17 <=> in2 /\ in1) /\ + (wres29 <=> wres12 \/ wres18) /\ + (wres4 <=> in7 /\ in6 /\ in5 \/ in4) /\ + (wres24 <=> ~wres6 \/ wres2 /\ ~in1) /\ + (wres15 <=> wres11 /\ ~in1) /\ + (wres16 <=> ~in2 /\ in1) /\ + (wres23 <=> wres5 /\ ~in3) /\ + (wres26 <=> wres14 \/ ~wres3) /\ + (wres20 <=> ~in7 /\ ~in4) /\ + (wres21 <=> ~wres10 /\ in5) /\ + (wres33 <=> wres8 \/ wres7 \/ wres22) /\ + (wres13 <=> in4 /\ ~in3) /\ + (wres31 <=> ~wres9 /\ ~in7 \/ wres8 \/ ~wres0 /\ in4) /\ + (wres32 <=> wres14 \/ wres22 /\ ~in3 \/ wres19) /\ + (wres28 <=> wres7 /\ wres5 \/ ~wres2 \/ wres14) /\ + (wres30 <=> ~wres3 \/ wres29 /\ ~in1 \/ wres17 /\ wres9) /\ + (wres25 <=> wres17 /\ wres4 \/ wres3 /\ in3 /\ in2 \/ wres24 /\ ~in2) /\ + (wres27 <=> + wres15 \/ wres16 /\ wres6 \/ wres26 /\ in2 \/ ~wres2 /\ ~in2 \/ wres23) + ==> (out7 <=> ~in7) /\ + (out6 <=> ~in7 /\ in6 \/ ~wres10) /\ + (out5 <=> wres8 /\ in7 \/ wres10 /\ in5) /\ + (out4 <=> wres21 /\ ~in4 \/ wres20 /\ in6 \/ wres33 /\ in4) /\ + (out3 <=> + wres13 /\ in6 /\ ~in5 \/ + wres7 /\ ~in5 /\ ~in3 \/ + wres31 /\ in3 \/ + wres32 /\ in5) /\ + (out2 <=> + in6 /\ in5 /\ in4 /\ in2 \/ + wres5 /\ ~in6 \/ + ~wres2 /\ in2 \/ + wres12 /\ wres1 /\ in5 \/ + wres5 /\ ~in7 \/ + wres13 /\ wres0 /\ ~in2 \/ + wres18 /\ in4 \/ + wres19 /\ wres12 \/ + wres20 /\ wres11 \/ + wres21 /\ wres11 \/ + wres23) /\ + (out1 <=> + wres16 /\ ~wres6 \/ + wres13 /\ ~wres0 /\ ~in1 \/ + wres28 /\ in1 \/ + wres15 /\ wres4 \/ + wres30 /\ in3) /\ + (out0 <=> wres25 /\ in0 \/ wres27 /\ ~in0)` ;; + +let aim_100_1_6_no_3 = +`~ +((v5 \/ v31 \/ v91) /\ + (v31 \/ v38 \/ v40) /\ + (~v38 \/ v40 \/ ~v91) /\ + (v31 \/ ~v40 \/ ~v91) /\ + (v30 \/ ~v31 \/ v39) /\ + (~v30 \/ v39 \/ v88) /\ + (~v31 \/ v39 \/ ~v88) /\ + (~v39 \/ v69 \/ v82) /\ + (~v39 \/ v69 \/ ~v82) /\ + (v10 \/ v60 \/ v94) /\ + (~v10 \/ v24 \/ v74) /\ + (~v10 \/ v60 \/ ~v74) /\ + (v20 \/ v26 \/ ~v60) /\ + (~v20 \/ v52 \/ v87) /\ + (v52 \/ ~v60 \/ ~v87) /\ + (v26 \/ ~v52 \/ v94) /\ + (~v26 \/ v45 \/ v57) /\ + (~v26 \/ ~v45 \/ v57) /\ + (~v26 \/ ~v57 \/ v100) /\ + (v24 \/ ~v60 \/ ~v100) /\ + (v11 \/ ~v24 \/ v38) /\ + (v5 \/ v11 \/ ~v38) /\ + (v5 \/ ~v11 \/ ~v24) /\ + (v4 \/ v42 \/ ~v69) /\ + (v4 \/ ~v42 \/ v100) /\ + (~v42 \/ ~v69 \/ ~v100) /\ + (v71 \/ v83 \/ ~v94) /\ + (~v4 \/ ~v71 \/ v83) /\ + (~v4 \/ ~v83 \/ ~v94) /\ + (~v5 \/ v59 \/ v73) /\ + (~v5 \/ v59 \/ ~v73) /\ + (v13 \/ ~v59 \/ v78) /\ + (v15 \/ v77 \/ v92) /\ + (v53 \/ ~v77 \/ v92) /\ + (v28 \/ ~v53 \/ v98) /\ + (~v28 \/ ~v53 \/ v98) /\ + (v22 \/ v89 \/ ~v98) /\ + (v22 \/ ~v53 \/ ~v89) /\ + (v12 \/ ~v22 \/ v58) /\ + (v12 \/ ~v58 \/ ~v98) /\ + (~v12 \/ ~v22 \/ ~v53) /\ + (v15 \/ v18 \/ v36) /\ + (v21 \/ ~v36 \/ ~v92) /\ + (v18 \/ ~v21 \/ ~v36) /\ + (~v18 \/ ~v92 \/ v96) /\ + (~v18 \/ ~v78 \/ ~v96) /\ + (v13 \/ ~v15 \/ ~v78) /\ + (v1 \/ v8 \/ v42) /\ + (v56 \/ v61 \/ v91) /\ + (v2 \/ ~v56 \/ v61) /\ + (v2 \/ v8 \/ v61) /\ + (~v2 \/ ~v42 \/ v61) /\ + (v1 \/ ~v42 \/ ~v61) /\ + (~v8 \/ ~v13 \/ v64) /\ + (v32 \/ ~v64 \/ v88) /\ + (~v8 \/ ~v32 \/ ~v64) /\ + (~v8 \/ v28 \/ ~v88) /\ + (~v28 \/ ~v64 \/ ~v88) /\ + (~v1 \/ ~v13 \/ ~v59) /\ + (~v35 \/ ~v40 \/ v65) /\ + (~v40 \/ ~v65 \/ v77) /\ + (~v35 \/ ~v77 \/ ~v83) /\ + (v33 \/ v62 \/ v78) /\ + (v47 \/ v53 \/ ~v65) /\ + (v30 \/ v37 \/ v58) /\ + (~v37 \/ v58 \/ v71) /\ + (~v12 \/ ~v37 \/ v71) /\ + (v20 \/ v30 \/ v51) /\ + (v20 \/ ~v51 \/ ~v71) /\ + (~v32 \/ ~v61 \/ v89) /\ + (v27 \/ ~v63 \/ v65) /\ + (~v22 \/ ~v48 \/ v50) /\ + (~v89 \/ ~v97 \/ v98) /\ + (v49 \/ ~v50 \/ ~v82) /\ + (~v16 \/ ~v46 \/ v95) /\ + (~v16 \/ ~v46 \/ ~v95) /\ + (~v17 \/ ~v37 \/ ~v76) /\ + (v51 \/ ~v93 \/ ~v99) /\ + (v27 \/ v76 \/ v79) /\ + (~v52 \/ v76 \/ v79) /\ + (~v1 \/ ~v25 \/ v68) /\ + (v34 \/ ~v58 \/ ~v75) /\ + (~v15 \/ ~v20 \/ ~v90) /\ + (v33 \/ v64 \/ v85) /\ + (~v11 \/ v64 \/ ~v85) /\ + (~v18 \/ ~v33 \/ ~v48) /\ + (v54 \/ ~v63 \/ v75) /\ + (v3 \/ ~v49 \/ ~v95) /\ + (~v3 \/ v74 \/ ~v95) /\ + (~v33 \/ v44 \/ ~v54) /\ + (~v44 \/ ~v50 \/ ~v54) /\ + (~v2 \/ v82 \/ v96) /\ + (v16 \/ v49 \/ v82) /\ + (~v19 \/ ~v41 \/ ~v44) /\ + (v46 \/ ~v49 \/ v81) /\ + (~v3 \/ ~v23 \/ v25) /\ + (v29 \/ v34 \/ v63) /\ + (~v25 \/ ~v34 \/ ~v75) /\ + (~v23 \/ v44 \/ ~v70) /\ + (~v29 \/ ~v38 \/ ~v82) /\ + (~v7 \/ ~v49 \/ ~v77) /\ + (v6 \/ v44 \/ v81) /\ + (v17 \/ ~v19 \/ ~v86) /\ + (~v29 \/ ~v73 \/ v93) /\ + (v11 \/ ~v52 \/ ~v85) /\ + (~v44 \/ v46 \/ v64) /\ + (~v17 \/ ~v34 \/ v95) /\ + (v17 \/ v47 \/ ~v57) /\ + (~v81 \/ ~v96 \/ v97) /\ + (v3 \/ ~v34 \/ v99) /\ + (v43 \/ ~v56 \/ ~v76) /\ + (~v27 \/ v72 \/ ~v79) /\ + (~v6 \/ ~v27 \/ v70) /\ + (v55 \/ v67 \/ v73) /\ + (v16 \/ ~v74 \/ ~v84) /\ + (~v43 \/ v90 \/ v97) /\ + (v50 \/ v56 \/ ~v93) /\ + (~v47 \/ ~v70 \/ ~v90) /\ + (v14 \/ v16 \/ ~v79) /\ + (v45 \/ ~v66 \/ v80) /\ + (v66 \/ ~v66 \/ ~v68) /\ + (v10 \/ ~v80 \/ v87) /\ + (~v55 \/ ~v81 \/ v93) /\ + (v37 \/ ~v45 \/ v72) /\ + (v19 \/ v68 \/ ~v97) /\ + (~v9 \/ ~v70 \/ ~v93) /\ + (v7 \/ v35 \/ v54) /\ + (~v41 \/ ~v41 \/ ~v55) /\ + (v14 \/ ~v14 \/ v70) /\ + (v23 \/ ~v23 \/ ~v62) /\ + (v23 \/ ~v67 \/ ~v80) /\ + (v10 \/ v36 \/ ~v51) /\ + (v21 \/ ~v68 \/ v85) /\ + (~v6 \/ v43 \/ ~v55) /\ + (v32 \/ v48 \/ v86) /\ + (v21 \/ ~v41 \/ v99) /\ + (v14 \/ v81 \/ v97) /\ + (~v9 \/ ~v43 \/ ~v72) /\ + (v7 \/ ~v9 \/ ~v79) /\ + (~v41 \/ v84 \/ ~v90) /\ + (v25 \/ ~v72 \/ v86) /\ + (~v9 \/ ~v46 \/ v63) /\ + (v6 \/ ~v14 \/ v38) /\ + (v7 \/ ~v21 \/ v35) /\ + (v9 \/ ~v87 \/ v99) /\ + (~v20 \/ ~v58 \/ v80) /\ + (~v3 \/ v75 \/ ~v86) /\ + (v19 \/ ~v62 \/ v84) /\ + (~v14 \/ ~v67 \/ v82) /\ + (~v27 \/ v48 \/ ~v68) /\ + (~v25 \/ v45 \/ ~v84) /\ + (~v7 \/ v41 \/ v67) /\ + (~v30 \/ ~v47 \/ v48) /\ + (v66 \/ v97 \/ ~v99) /\ + (v9 \/ v41 \/ v55) /\ + (~v29 \/ v36 \/ ~v86) /\ + (v50 \/ v62 \/ ~v81) /\ + (v29 \/ ~v86 \/ v90) /\ + (~v48 \/ v54 \/ ~v55) /\ + (v19 \/ ~v34 \/ v89))` ;; + +let dubois20 = +`~ +((v39 \/ v40 \/ v1) /\ + (~v39 \/ ~v40 \/ v1) /\ + (v39 \/ ~v40 \/ ~v1) /\ + (~v39 \/ v40 \/ ~v1) /\ + (v1 \/ v41 \/ v2) /\ + (~v1 \/ ~v41 \/ v2) /\ + (v1 \/ ~v41 \/ ~v2) /\ + (~v1 \/ v41 \/ ~v2) /\ + (v2 \/ v42 \/ v3) /\ + (~v2 \/ ~v42 \/ v3) /\ + (v2 \/ ~v42 \/ ~v3) /\ + (~v2 \/ v42 \/ ~v3) /\ + (v3 \/ v43 \/ v4) /\ + (~v3 \/ ~v43 \/ v4) /\ + (v3 \/ ~v43 \/ ~v4) /\ + (~v3 \/ v43 \/ ~v4) /\ + (v4 \/ v44 \/ v5) /\ + (~v4 \/ ~v44 \/ v5) /\ + (v4 \/ ~v44 \/ ~v5) /\ + (~v4 \/ v44 \/ ~v5) /\ + (v5 \/ v45 \/ v6) /\ + (~v5 \/ ~v45 \/ v6) /\ + (v5 \/ ~v45 \/ ~v6) /\ + (~v5 \/ v45 \/ ~v6) /\ + (v6 \/ v46 \/ v7) /\ + (~v6 \/ ~v46 \/ v7) /\ + (v6 \/ ~v46 \/ ~v7) /\ + (~v6 \/ v46 \/ ~v7) /\ + (v7 \/ v47 \/ v8) /\ + (~v7 \/ ~v47 \/ v8) /\ + (v7 \/ ~v47 \/ ~v8) /\ + (~v7 \/ v47 \/ ~v8) /\ + (v8 \/ v48 \/ v9) /\ + (~v8 \/ ~v48 \/ v9) /\ + (v8 \/ ~v48 \/ ~v9) /\ + (~v8 \/ v48 \/ ~v9) /\ + (v9 \/ v49 \/ v10) /\ + (~v9 \/ ~v49 \/ v10) /\ + (v9 \/ ~v49 \/ ~v10) /\ + (~v9 \/ v49 \/ ~v10) /\ + (v10 \/ v50 \/ v11) /\ + (~v10 \/ ~v50 \/ v11) /\ + (v10 \/ ~v50 \/ ~v11) /\ + (~v10 \/ v50 \/ ~v11) /\ + (v11 \/ v51 \/ v12) /\ + (~v11 \/ ~v51 \/ v12) /\ + (v11 \/ ~v51 \/ ~v12) /\ + (~v11 \/ v51 \/ ~v12) /\ + (v12 \/ v52 \/ v13) /\ + (~v12 \/ ~v52 \/ v13) /\ + (v12 \/ ~v52 \/ ~v13) /\ + (~v12 \/ v52 \/ ~v13) /\ + (v13 \/ v53 \/ v14) /\ + (~v13 \/ ~v53 \/ v14) /\ + (v13 \/ ~v53 \/ ~v14) /\ + (~v13 \/ v53 \/ ~v14) /\ + (v14 \/ v54 \/ v15) /\ + (~v14 \/ ~v54 \/ v15) /\ + (v14 \/ ~v54 \/ ~v15) /\ + (~v14 \/ v54 \/ ~v15) /\ + (v15 \/ v55 \/ v16) /\ + (~v15 \/ ~v55 \/ v16) /\ + (v15 \/ ~v55 \/ ~v16) /\ + (~v15 \/ v55 \/ ~v16) /\ + (v16 \/ v56 \/ v17) /\ + (~v16 \/ ~v56 \/ v17) /\ + (v16 \/ ~v56 \/ ~v17) /\ + (~v16 \/ v56 \/ ~v17) /\ + (v17 \/ v57 \/ v18) /\ + (~v17 \/ ~v57 \/ v18) /\ + (v17 \/ ~v57 \/ ~v18) /\ + (~v17 \/ v57 \/ ~v18) /\ + (v18 \/ v58 \/ v19) /\ + (~v18 \/ ~v58 \/ v19) /\ + (v18 \/ ~v58 \/ ~v19) /\ + (~v18 \/ v58 \/ ~v19) /\ + (v19 \/ v59 \/ v60) /\ + (~v19 \/ ~v59 \/ v60) /\ + (v19 \/ ~v59 \/ ~v60) /\ + (~v19 \/ v59 \/ ~v60) /\ + (v20 \/ v59 \/ v60) /\ + (~v20 \/ ~v59 \/ v60) /\ + (v20 \/ ~v59 \/ ~v60) /\ + (~v20 \/ v59 \/ ~v60) /\ + (v21 \/ v58 \/ v20) /\ + (~v21 \/ ~v58 \/ v20) /\ + (v21 \/ ~v58 \/ ~v20) /\ + (~v21 \/ v58 \/ ~v20) /\ + (v22 \/ v57 \/ v21) /\ + (~v22 \/ ~v57 \/ v21) /\ + (v22 \/ ~v57 \/ ~v21) /\ + (~v22 \/ v57 \/ ~v21) /\ + (v23 \/ v56 \/ v22) /\ + (~v23 \/ ~v56 \/ v22) /\ + (v23 \/ ~v56 \/ ~v22) /\ + (~v23 \/ v56 \/ ~v22) /\ + (v24 \/ v55 \/ v23) /\ + (~v24 \/ ~v55 \/ v23) /\ + (v24 \/ ~v55 \/ ~v23) /\ + (~v24 \/ v55 \/ ~v23) /\ + (v25 \/ v54 \/ v24) /\ + (~v25 \/ ~v54 \/ v24) /\ + (v25 \/ ~v54 \/ ~v24) /\ + (~v25 \/ v54 \/ ~v24) /\ + (v26 \/ v53 \/ v25) /\ + (~v26 \/ ~v53 \/ v25) /\ + (v26 \/ ~v53 \/ ~v25) /\ + (~v26 \/ v53 \/ ~v25) /\ + (v27 \/ v52 \/ v26) /\ + (~v27 \/ ~v52 \/ v26) /\ + (v27 \/ ~v52 \/ ~v26) /\ + (~v27 \/ v52 \/ ~v26) /\ + (v28 \/ v51 \/ v27) /\ + (~v28 \/ ~v51 \/ v27) /\ + (v28 \/ ~v51 \/ ~v27) /\ + (~v28 \/ v51 \/ ~v27) /\ + (v29 \/ v50 \/ v28) /\ + (~v29 \/ ~v50 \/ v28) /\ + (v29 \/ ~v50 \/ ~v28) /\ + (~v29 \/ v50 \/ ~v28) /\ + (v30 \/ v49 \/ v29) /\ + (~v30 \/ ~v49 \/ v29) /\ + (v30 \/ ~v49 \/ ~v29) /\ + (~v30 \/ v49 \/ ~v29) /\ + (v31 \/ v48 \/ v30) /\ + (~v31 \/ ~v48 \/ v30) /\ + (v31 \/ ~v48 \/ ~v30) /\ + (~v31 \/ v48 \/ ~v30) /\ + (v32 \/ v47 \/ v31) /\ + (~v32 \/ ~v47 \/ v31) /\ + (v32 \/ ~v47 \/ ~v31) /\ + (~v32 \/ v47 \/ ~v31) /\ + (v33 \/ v46 \/ v32) /\ + (~v33 \/ ~v46 \/ v32) /\ + (v33 \/ ~v46 \/ ~v32) /\ + (~v33 \/ v46 \/ ~v32) /\ + (v34 \/ v45 \/ v33) /\ + (~v34 \/ ~v45 \/ v33) /\ + (v34 \/ ~v45 \/ ~v33) /\ + (~v34 \/ v45 \/ ~v33) /\ + (v35 \/ v44 \/ v34) /\ + (~v35 \/ ~v44 \/ v34) /\ + (v35 \/ ~v44 \/ ~v34) /\ + (~v35 \/ v44 \/ ~v34) /\ + (v36 \/ v43 \/ v35) /\ + (~v36 \/ ~v43 \/ v35) /\ + (v36 \/ ~v43 \/ ~v35) /\ + (~v36 \/ v43 \/ ~v35) /\ + (v37 \/ v42 \/ v36) /\ + (~v37 \/ ~v42 \/ v36) /\ + (v37 \/ ~v42 \/ ~v36) /\ + (~v37 \/ v42 \/ ~v36) /\ + (v38 \/ v41 \/ v37) /\ + (~v38 \/ ~v41 \/ v37) /\ + (v38 \/ ~v41 \/ ~v37) /\ + (~v38 \/ v41 \/ ~v37) /\ + (v39 \/ v40 \/ ~v38) /\ + (~v39 \/ ~v40 \/ ~v38) /\ + (v39 \/ ~v40 \/ v38) /\ + (~v39 \/ v40 \/ v38))` ;; + +let add3_be = + `(aftbuf1 <=> ~anda) /\ + (aftbuf2 <=> ~andb) /\ + (aftbuf3 <=> ~exora) /\ + (aftbuf4 <=> ~exorb) /\ + (aftbuf5 <=> ~carryin) /\ + (n1_0_ <=> aftbuf1 /\ a_0_) /\ + (n1_1_ <=> aftbuf1 /\ a_1_) /\ + (n1_2_ <=> aftbuf1 /\ a_2_) /\ + (n1_3_ <=> aftbuf1 /\ a_3_) /\ + (n1_4_ <=> aftbuf1 /\ a_4_) /\ + (n1_5_ <=> aftbuf1 /\ a_5_) /\ + (n1_6_ <=> aftbuf1 /\ a_6_) /\ + (n1_7_ <=> aftbuf1 /\ a_7_) /\ + (n3_0_ <=> aftbuf2 /\ b_0_) /\ + (n3_1_ <=> aftbuf2 /\ b_1_) /\ + (n3_2_ <=> aftbuf2 /\ b_2_) /\ + (n3_3_ <=> aftbuf2 /\ b_3_) /\ + (n3_4_ <=> aftbuf2 /\ b_4_) /\ + (n3_5_ <=> aftbuf2 /\ b_5_) /\ + (n3_6_ <=> aftbuf2 /\ b_6_) /\ + (n3_7_ <=> aftbuf2 /\ b_7_) /\ + (n2_0_ <=> aftbuf3 /\ ~n1_0_ \/ ~aftbuf3 /\ n1_0_) /\ + (n2_1_ <=> aftbuf3 /\ ~n1_1_ \/ ~aftbuf3 /\ n1_1_) /\ + (n2_2_ <=> aftbuf3 /\ ~n1_2_ \/ ~aftbuf3 /\ n1_2_) /\ + (n2_3_ <=> aftbuf3 /\ ~n1_3_ \/ ~aftbuf3 /\ n1_3_) /\ + (n2_4_ <=> aftbuf3 /\ ~n1_4_ \/ ~aftbuf3 /\ n1_4_) /\ + (n2_5_ <=> aftbuf3 /\ ~n1_5_ \/ ~aftbuf3 /\ n1_5_) /\ + (n2_6_ <=> aftbuf3 /\ ~n1_6_ \/ ~aftbuf3 /\ n1_6_) /\ + (n2_7_ <=> aftbuf3 /\ ~n1_7_ \/ ~aftbuf3 /\ n1_7_) /\ + (n4_0_ <=> aftbuf4 /\ ~n3_0_ \/ ~aftbuf4 /\ n3_0_) /\ + (n4_1_ <=> aftbuf4 /\ ~n3_1_ \/ ~aftbuf4 /\ n3_1_) /\ + (n4_2_ <=> aftbuf4 /\ ~n3_2_ \/ ~aftbuf4 /\ n3_2_) /\ + (n4_3_ <=> aftbuf4 /\ ~n3_3_ \/ ~aftbuf4 /\ n3_3_) /\ + (n4_4_ <=> aftbuf4 /\ ~n3_4_ \/ ~aftbuf4 /\ n3_4_) /\ + (n4_5_ <=> aftbuf4 /\ ~n3_5_ \/ ~aftbuf4 /\ n3_5_) /\ + (n4_6_ <=> aftbuf4 /\ ~n3_6_ \/ ~aftbuf4 /\ n3_6_) /\ + (n4_7_ <=> aftbuf4 /\ ~n3_7_ \/ ~aftbuf4 /\ n3_7_) /\ + (cout1 <=> aftbuf5 /\ n4_0_ \/ aftbuf5 /\ n2_0_ \/ n4_0_ /\ n2_0_) /\ + (cout2 <=> cout1 /\ n4_1_ \/ cout1 /\ n2_1_ \/ n4_1_ /\ n2_1_) /\ + (cout3 <=> cout2 /\ n4_2_ \/ cout2 /\ n2_2_ \/ n4_2_ /\ n2_2_) /\ + (cout4 <=> cout3 /\ n4_3_ \/ cout3 /\ n2_3_ \/ n4_3_ /\ n2_3_) /\ + (cout5 <=> cout4 /\ n4_4_ \/ cout4 /\ n2_4_ \/ n4_4_ /\ n2_4_) /\ + (cout6 <=> cout5 /\ n4_5_ \/ cout5 /\ n2_5_ \/ n4_5_ /\ n2_5_) /\ + (cout7 <=> cout6 /\ n4_6_ \/ cout6 /\ n2_6_ \/ n4_6_ /\ n2_6_) /\ + (hulp0 <=> ~(n2_0_ <=> ~(n4_0_ <=> aftbuf5))) /\ + (hulp1 <=> ~(n2_1_ <=> ~(n4_1_ <=> cout1))) /\ + (hulp2 <=> ~(n2_2_ <=> ~(n4_2_ <=> cout2))) /\ + (hulp3 <=> ~(n2_3_ <=> ~(n4_3_ <=> cout3))) /\ + (hulp4 <=> ~(n2_4_ <=> ~(n4_4_ <=> cout4))) /\ + (hulp5 <=> ~(n2_5_ <=> ~(n4_5_ <=> cout5))) /\ + (hulp6 <=> ~(n2_6_ <=> ~(n4_6_ <=> cout6))) /\ + (hulp7 <=> ~(n2_7_ <=> ~(n4_7_ <=> cout7))) /\ + (hulp8 <=> cout7 /\ n4_7_ \/ cout7 /\ n2_7_ \/ n4_7_ /\ n2_7_) /\ + (sign <=> ~hulp7) /\ + (overflow <=> (cout7 <=> hulp8)) /\ + (carryout <=> ~hulp8) /\ + (o_7_ <=> hulp7) /\ + (o_6_ <=> hulp6) /\ + (o_5_ <=> hulp5) /\ + (o_4_ <=> hulp4) /\ + (o_3_ <=> hulp3) /\ + (o_2_ <=> hulp2) /\ + (o_1_ <=> hulp1) /\ + (o_0_ <=> hulp0) /\ + (n3 <=> a_1_) /\ + (n4 <=> a_4_) /\ + (n5 <=> a_6_) /\ + (n6 <=> a_5_) /\ + (n7 <=> a_0_) /\ + (n8 <=> a_2_) /\ + (n9 <=> a_7_) /\ + (n10 <=> a_3_) /\ + (n11 <=> anda) /\ + (n12 <=> exora) /\ + (n13 <=> b_4_) /\ + (n14 <=> b_6_) /\ + (n15 <=> b_3_) /\ + (n16 <=> b_0_) /\ + (n17 <=> b_1_) /\ + (n18 <=> b_7_) /\ + (n19 <=> b_5_) /\ + (n20 <=> b_2_) /\ + (n21 <=> andb) /\ + (n22 <=> exorb) /\ + (n23 <=> carryin) /\ + (n74 <=> ~n23) /\ + (n70 <=> ~n21) /\ + (n76 <=> ~n22) /\ + (n69 <=> ~n11) /\ + (n75 <=> ~n12) /\ + (n165 <=> ~n9 \/ ~n69) /\ + (n173 <=> ~n75) /\ + (n166 <=> ~n18 \/ ~n70) /\ + (n174 <=> ~n76) /\ + (n160 <=> ~n14 \/ ~n70) /\ + (n152 <=> ~n76) /\ + (n159 <=> ~n5 \/ ~n69) /\ + (n151 <=> ~n75) /\ + (n134 <=> ~n13 \/ ~n70) /\ + (n126 <=> ~n76) /\ + (n133 <=> ~n4 \/ ~n69) /\ + (n125 <=> ~n75) /\ + (n113 <=> ~n10 \/ ~n69) /\ + (n121 <=> ~n75) /\ + (n114 <=> ~n15 \/ ~n70) /\ + (n122 <=> ~n76) /\ + (n140 <=> ~n19 \/ ~n70) /\ + (n148 <=> ~n76) /\ + (n139 <=> ~n6 \/ ~n69) /\ + (n147 <=> ~n75) /\ + (n87 <=> ~n3 \/ ~n69) /\ + (n95 <=> ~n75) /\ + (n88 <=> ~n17 \/ ~n70) /\ + (n96 <=> ~n76) /\ + (n108 <=> ~n20 \/ ~n70) /\ + (n100 <=> ~n76) /\ + (n107 <=> ~n8 \/ ~n69) /\ + (n99 <=> ~n75) /\ + (n77 <=> ~n74) /\ + (n82 <=> ~n16 \/ ~n70) /\ + (n72 <=> ~n76) /\ + (n81 <=> ~n7 \/ ~n69) /\ + (n71 <=> ~n75) /\ + (n65 <=> ~n165) /\ + (n63 <=> ~n166) /\ + (n61 <=> ~n160) /\ + (n59 <=> ~n159) /\ + (n53 <=> ~n134) /\ + (n51 <=> ~n133) /\ + (n49 <=> ~n113) /\ + (n47 <=> ~n114) /\ + (n55 <=> ~n140) /\ + (n57 <=> ~n139) /\ + (n41 <=> ~n87) /\ + (n39 <=> ~n88) /\ + (n45 <=> ~n108) /\ + (n43 <=> ~n107) /\ + (n37 <=> ~n82) /\ + (n35 <=> ~n81) /\ + (n168 <=> (n65 <=> n75)) /\ + (n169 <=> (n63 <=> n76)) /\ + (n158 <=> (n61 <=> n76)) /\ + (n157 <=> (n59 <=> n75)) /\ + (n132 <=> (n53 <=> n76)) /\ + (n131 <=> (n51 <=> n75)) /\ + (n116 <=> (n49 <=> n75)) /\ + (n117 <=> (n47 <=> n76)) /\ + (n143 <=> (n55 <=> n76)) /\ + (n142 <=> (n57 <=> n75)) /\ + (n90 <=> (n41 <=> n75)) /\ + (n91 <=> (n39 <=> n76)) /\ + (n106 <=> (n45 <=> n76)) /\ + (n105 <=> (n43 <=> n75)) /\ + (n80 <=> (n37 <=> n76)) /\ + (n79 <=> (n35 <=> n75)) /\ + (n66 <=> ~n168) /\ + (n64 <=> ~n169) /\ + (n62 <=> ~n158) /\ + (n60 <=> ~n157) /\ + (n54 <=> ~n132) /\ + (n52 <=> ~n131) /\ + (n50 <=> ~n116) /\ + (n48 <=> ~n117) /\ + (n56 <=> ~n143) /\ + (n58 <=> ~n142) /\ + (n42 <=> ~n90) /\ + (n40 <=> ~n91) /\ + (n46 <=> ~n106) /\ + (n44 <=> ~n105) /\ + (n38 <=> ~n80) /\ + (n36 <=> ~n79) /\ + (n172 <=> ~n66) /\ + (n150 <=> ~n60) /\ + (n124 <=> ~n52) /\ + (n120 <=> ~n50) /\ + (n146 <=> ~n58) /\ + (n94 <=> ~n42) /\ + (n98 <=> ~n44) /\ + (n68 <=> ~n36) /\ + (n171 <=> (n64 <=> n66)) /\ + (n153 <=> (n62 <=> n60)) /\ + (n127 <=> (n54 <=> n52)) /\ + (n119 <=> (n48 <=> n50)) /\ + (n145 <=> (n56 <=> n58)) /\ + (n93 <=> (n40 <=> n42)) /\ + (n101 <=> (n46 <=> n44)) /\ + (n73 <=> (n38 <=> n36)) /\ + (n163 <=> ~n171) /\ + (n149 <=> ~n153) /\ + (n123 <=> ~n127) /\ + (n111 <=> ~n119) /\ + (n137 <=> ~n145) /\ + (n85 <=> ~n93) /\ + (n97 <=> ~n101) /\ + (n67 <=> ~n73) /\ + (n170 <=> ~n163) /\ + (n161 <=> ~n149) /\ + (n135 <=> ~n123) /\ + (n118 <=> ~n111) /\ + (n144 <=> ~n137) /\ + (n92 <=> ~n85) /\ + (n109 <=> ~n97) /\ + (n83 <=> ~n67) /\ + (n84 <=> ~n67 /\ ~n36 \/ ~n83 /\ ~n74) /\ + (n78 <=> ~(n77 <=> n67)) /\ + (n86 <=> ~n84) /\ + (n102 <=> ~n92 /\ ~n84 \/ ~n94 /\ ~n85) /\ + (n28 <=> ~n78) /\ + (n110 <=> ~n97 /\ ~n44 \/ ~n109 /\ ~n102) /\ + (n89 <=> (n86 <=> n85)) /\ + (n103 <=> ~n102) /\ + (n112 <=> ~n110) /\ + (n128 <=> ~n118 /\ ~n110 \/ ~n120 /\ ~n111) /\ + (n24 <=> ~n89) /\ + (n104 <=> ~(n103 <=> n97)) /\ + (n115 <=> (n112 <=> n111)) /\ + (n129 <=> ~n128) /\ + (n136 <=> ~n123 /\ ~n52 \/ ~n135 /\ ~n128) /\ + (n26 <=> ~n104) /\ + (n25 <=> ~n115) /\ + (n130 <=> ~(n129 <=> n123)) /\ + (n154 <=> ~n144 /\ ~n136 \/ ~n146 /\ ~n137) /\ + (n138 <=> ~n136) /\ + (n27 <=> ~n130) /\ + (n162 <=> ~n149 /\ ~n60 \/ ~n161 /\ ~n154) /\ + (n155 <=> ~n154) /\ + (n141 <=> (n138 <=> n137)) /\ + (n164 <=> ~n162) /\ + (n175 <=> ~n162) /\ + (n176 <=> ~n170 /\ ~n162 \/ ~n172 /\ ~n163) /\ + (n156 <=> ~(n155 <=> n149)) /\ + (n30 <=> ~n141) /\ + (n167 <=> (n164 <=> n163)) /\ + (n177 <=> (n176 <=> n162)) /\ + (n31 <=> ~n176) /\ + (n29 <=> ~n156) /\ + (n34 <=> ~n167) /\ + (n32 <=> ~n177) /\ + (n33 <=> ~n34) + ==> (o_1_ <=> n24) /\ + (o_3_ <=> n25) /\ + (o_2_ <=> n26) /\ + (o_4_ <=> n27) /\ + (o_0_ <=> n28) /\ + (o_6_ <=> n29) /\ + (o_5_ <=> n30) /\ + (carryout <=> n31) /\ + (overflow <=> n32) /\ + (sign <=> n33) /\ + (o_7_ <=> n34)` ;; + +let add4_be = + `(n3 <=> a_0_) /\ + (n4 <=> a_2_) /\ + (n5 <=> a_4_) /\ + (n6 <=> a_5_) /\ + (n7 <=> a_6_) /\ + (n8 <=> a_8_) /\ + (n9 <=> a_3_) /\ + (n10 <=> a_7_) /\ + (n11 <=> a_9_) /\ + (n12 <=> a_11_) /\ + (n13 <=> a_1_) /\ + (n14 <=> a_10_) /\ + (n15 <=> anda) /\ + (n16 <=> exora) /\ + (n17 <=> b_3_) /\ + (n18 <=> b_4_) /\ + (n19 <=> b_6_) /\ + (n20 <=> b_1_) /\ + (n21 <=> b_7_) /\ + (n22 <=> b_9_) /\ + (n23 <=> b_2_) /\ + (n24 <=> b_5_) /\ + (n25 <=> b_8_) /\ + (n26 <=> b_10_) /\ + (n27 <=> b_11_) /\ + (n28 <=> b_0_) /\ + (n29 <=> andb) /\ + (n30 <=> exorb) /\ + (n31 <=> carryin) /\ + (n98 <=> ~n29) /\ + (n104 <=> ~n30) /\ + (n97 <=> ~n15) /\ + (n103 <=> ~n16) /\ + (n102 <=> ~n31) /\ + (n105 <=> ~n102) /\ + (n243 <=> ~n14 \/ ~n97) /\ + (n235 <=> ~n103) /\ + (n244 <=> ~n26 \/ ~n98) /\ + (n236 <=> ~n104) /\ + (n224 <=> ~n22 \/ ~n98) /\ + (n232 <=> ~n104) /\ + (n223 <=> ~n11 \/ ~n97) /\ + (n231 <=> ~n103) /\ + (n217 <=> ~n8 \/ ~n97) /\ + (n209 <=> ~n103) /\ + (n218 <=> ~n25 \/ ~n98) /\ + (n210 <=> ~n104) /\ + (n197 <=> ~n21 \/ ~n98) /\ + (n206 <=> ~n104) /\ + (n196 <=> ~n10 \/ ~n97) /\ + (n205 <=> ~n103) /\ + (n190 <=> ~n19 \/ ~n98) /\ + (n182 <=> ~n104) /\ + (n189 <=> ~n7 \/ ~n97) /\ + (n181 <=> ~n103) /\ + (n251 <=> ~n27 \/ ~n98) /\ + (n259 <=> ~n104) /\ + (n250 <=> ~n12 \/ ~n97) /\ + (n258 <=> ~n103) /\ + (n163 <=> ~n18 \/ ~n98) /\ + (n155 <=> ~n104) /\ + (n162 <=> ~n5 \/ ~n97) /\ + (n154 <=> ~n103) /\ + (n170 <=> ~n24 \/ ~n98) /\ + (n178 <=> ~n104) /\ + (n169 <=> ~n6 \/ ~n97) /\ + (n177 <=> ~n103) /\ + (n136 <=> ~n23 \/ ~n98) /\ + (n128 <=> ~n104) /\ + (n135 <=> ~n4 \/ ~n97) /\ + (n127 <=> ~n103) /\ + (n116 <=> ~n20 \/ ~n98) /\ + (n124 <=> ~n104) /\ + (n115 <=> ~n13 \/ ~n97) /\ + (n123 <=> ~n103) /\ + (n110 <=> ~n28 \/ ~n98) /\ + (n100 <=> ~n104) /\ + (n109 <=> ~n3 \/ ~n97) /\ + (n99 <=> ~n103) /\ + (n142 <=> ~n17 \/ ~n98) /\ + (n150 <=> ~n104) /\ + (n141 <=> ~n9 \/ ~n97) /\ + (n149 <=> ~n103) /\ + (n87 <=> ~n243) /\ + (n89 <=> ~n244) /\ + (n83 <=> ~n224) /\ + (n85 <=> ~n223) /\ + (n79 <=> ~n217) /\ + (n81 <=> ~n218) /\ + (n75 <=> ~n197) /\ + (n77 <=> ~n196) /\ + (n73 <=> ~n190) /\ + (n71 <=> ~n189) /\ + (n91 <=> ~n251) /\ + (n93 <=> ~n250) /\ + (n65 <=> ~n163) /\ + (n63 <=> ~n162) /\ + (n67 <=> ~n170) /\ + (n69 <=> ~n169) /\ + (n57 <=> ~n136) /\ + (n55 <=> ~n135) /\ + (n51 <=> ~n116) /\ + (n53 <=> ~n115) /\ + (n49 <=> ~n110) /\ + (n47 <=> ~n109) /\ + (n59 <=> ~n142) /\ + (n61 <=> ~n141) /\ + (n241 <=> n87 /\ n103 \/ ~n87 /\ ~n103) /\ + (n242 <=> n89 /\ n104 \/ ~n89 /\ ~n104) /\ + (n227 <=> n83 /\ n104 \/ ~n83 /\ ~n104) /\ + (n226 <=> n85 /\ n103 \/ ~n85 /\ ~n103) /\ + (n215 <=> n79 /\ n103 \/ ~n79 /\ ~n103) /\ + (n216 <=> n81 /\ n104 \/ ~n81 /\ ~n104) /\ + (n200 <=> n75 /\ n104 \/ ~n75 /\ ~n104) /\ + (n199 <=> n77 /\ n103 \/ ~n77 /\ ~n103) /\ + (n188 <=> n73 /\ n104 \/ ~n73 /\ ~n104) /\ + (n187 <=> n71 /\ n103 \/ ~n71 /\ ~n103) /\ + (n254 <=> n91 /\ n104 \/ ~n91 /\ ~n104) /\ + (n253 <=> n93 /\ n103 \/ ~n93 /\ ~n103) /\ + (n160 <=> n65 /\ n104 \/ ~n65 /\ ~n104) /\ + (n159 <=> n63 /\ n103 \/ ~n63 /\ ~n103) /\ + (n173 <=> n67 /\ n104 \/ ~n67 /\ ~n104) /\ + (n172 <=> n69 /\ n103 \/ ~n69 /\ ~n103) /\ + (n134 <=> n57 /\ n104 \/ ~n57 /\ ~n104) /\ + (n133 <=> n55 /\ n103 \/ ~n55 /\ ~n103) /\ + (n119 <=> n51 /\ n104 \/ ~n51 /\ ~n104) /\ + (n118 <=> n53 /\ n103 \/ ~n53 /\ ~n103) /\ + (n108 <=> n49 /\ n104 \/ ~n49 /\ ~n104) /\ + (n107 <=> n47 /\ n103 \/ ~n47 /\ ~n103) /\ + (n145 <=> n59 /\ n104 \/ ~n59 /\ ~n104) /\ + (n144 <=> n61 /\ n103 \/ ~n61 /\ ~n103) /\ + (n88 <=> ~n241) /\ + (n90 <=> ~n242) /\ + (n84 <=> ~n227) /\ + (n86 <=> ~n226) /\ + (n80 <=> ~n215) /\ + (n82 <=> ~n216) /\ + (n76 <=> ~n200) /\ + (n78 <=> ~n199) /\ + (n74 <=> ~n188) /\ + (n72 <=> ~n187) /\ + (n92 <=> ~n254) /\ + (n94 <=> ~n253) /\ + (n66 <=> ~n160) /\ + (n64 <=> ~n159) /\ + (n68 <=> ~n173) /\ + (n70 <=> ~n172) /\ + (n58 <=> ~n134) /\ + (n56 <=> ~n133) /\ + (n52 <=> ~n119) /\ + (n54 <=> ~n118) /\ + (n50 <=> ~n108) /\ + (n48 <=> ~n107) /\ + (n60 <=> ~n145) /\ + (n62 <=> ~n144) /\ + (n234 <=> ~n88) /\ + (n230 <=> ~n86) /\ + (n208 <=> ~n80) /\ + (n204 <=> ~n78) /\ + (n180 <=> ~n72) /\ + (n257 <=> ~n94) /\ + (n152 <=> ~n64) /\ + (n176 <=> ~n70) /\ + (n126 <=> ~n56) /\ + (n122 <=> ~n54) /\ + (n96 <=> ~n48) /\ + (n148 <=> ~n62) /\ + (n237 <=> n90 /\ n88 \/ ~n90 /\ ~n88) /\ + (n229 <=> n84 /\ n86 \/ ~n84 /\ ~n86) /\ + (n211 <=> n82 /\ n80 \/ ~n82 /\ ~n80) /\ + (n203 <=> n76 /\ n78 \/ ~n76 /\ ~n78) /\ + (n183 <=> n74 /\ n72 \/ ~n74 /\ ~n72) /\ + (n256 <=> n92 /\ n94 \/ ~n92 /\ ~n94) /\ + (n156 <=> n66 /\ n64 \/ ~n66 /\ ~n64) /\ + (n175 <=> n68 /\ n70 \/ ~n68 /\ ~n70) /\ + (n129 <=> n58 /\ n56 \/ ~n58 /\ ~n56) /\ + (n121 <=> n52 /\ n54 \/ ~n52 /\ ~n54) /\ + (n101 <=> n50 /\ n48 \/ ~n50 /\ ~n48) /\ + (n147 <=> n60 /\ n62 \/ ~n60 /\ ~n62) /\ + (n233 <=> ~n237) /\ + (n221 <=> ~n229) /\ + (n207 <=> ~n211) /\ + (n193 <=> ~n203) /\ + (n179 <=> ~n183) /\ + (n248 <=> ~n256) /\ + (n151 <=> ~n156) /\ + (n166 <=> ~n175) /\ + (n125 <=> ~n129) /\ + (n113 <=> ~n121) /\ + (n95 <=> ~n101) /\ + (n139 <=> ~n147) /\ + (n245 <=> ~n233) /\ + (n228 <=> ~n221) /\ + (n219 <=> ~n207) /\ + (n167 <=> ~n166 \/ ~n151 \/ ~n179 \/ ~n193) /\ + (n202 <=> ~n193) /\ + (n191 <=> ~n179) /\ + (n255 <=> ~n248) /\ + (n164 <=> ~n151) /\ + (n174 <=> ~n166) /\ + (n137 <=> ~n125) /\ + (n120 <=> ~n113) /\ + (n111 <=> ~n95) /\ + (n146 <=> ~n139) /\ + (n106 <=> n105 /\ ~n95 \/ ~n105 /\ n95) /\ + (n161 <=> ~n167) /\ + (n112 <=> ~n95 /\ ~n48 \/ ~n111 /\ ~n102) /\ + (n114 <=> ~n112) /\ + (n39 <=> ~n106) /\ + (n130 <=> ~n120 /\ ~n112 \/ ~n122 /\ ~n113) /\ + (n117 <=> n114 /\ n113 \/ ~n114 /\ ~n113) /\ + (n131 <=> ~n130) /\ + (n138 <=> ~n125 /\ ~n56 \/ ~n137 /\ ~n130) /\ + (n32 <=> ~n117) /\ + (n132 <=> n131 /\ ~n125 \/ ~n131 /\ n125) /\ + (n153 <=> ~n146 /\ ~n138 \/ ~n148 /\ ~n139) /\ + (n140 <=> ~n138) /\ + (n37 <=> ~n132) /\ + (n157 <=> ~n153) /\ + (n165 <=> ~n151 /\ ~n64 \/ ~n164 /\ ~n153) /\ + (n143 <=> n140 /\ n139 \/ ~n140 /\ ~n139) /\ + (n158 <=> n157 /\ ~n151 \/ ~n157 /\ n151) /\ + (n184 <=> ~n174 /\ ~n165 \/ ~n176 /\ ~n166) /\ + (n168 <=> ~n165) /\ + (n33 <=> ~n143) /\ + (n43 <=> ~n158) /\ + (n185 <=> ~n184) /\ + (n192 <=> ~n179 /\ ~n72 \/ ~n191 /\ ~n184) /\ + (n171 <=> n168 /\ n166 \/ ~n168 /\ ~n166) /\ + (n195 <=> ~n192) /\ + (n186 <=> n185 /\ ~n179 \/ ~n185 /\ n179) /\ + (n201 <=> ~n202 /\ ~n192 \/ ~n204 /\ ~n193) /\ + (n34 <=> ~n171) /\ + (n198 <=> n195 /\ n193 \/ ~n195 /\ ~n193) /\ + (n35 <=> ~n186) /\ + (n194 <=> ~n167 /\ ~n153 \/ ~n161 /\ ~n201) /\ + (n36 <=> ~n198) /\ + (n212 <=> ~n194) /\ + (n213 <=> ~n212) /\ + (n220 <=> ~n207 /\ ~n80 \/ ~n219 /\ ~n212) /\ + (n214 <=> n213 /\ ~n207 \/ ~n213 /\ n207) /\ + (n222 <=> ~n220) /\ + (n238 <=> ~n228 /\ ~n220 \/ ~n230 /\ ~n221) /\ + (n38 <=> ~n214) /\ + (n225 <=> n222 /\ n221 \/ ~n222 /\ ~n221) /\ + (n239 <=> ~n238) /\ + (n246 <=> ~n233 /\ ~n88 \/ ~n245 /\ ~n238) /\ + (n40 <=> ~n225) /\ + (n240 <=> n239 /\ ~n233 \/ ~n239 /\ n233) /\ + (n261 <=> ~n255 /\ ~n246 \/ ~n257 /\ ~n248) /\ + (n249 <=> ~n246) /\ + (n262 <=> n261 /\ n246 \/ ~n261 /\ ~n246) /\ + (n41 <=> ~n240) /\ + (n44 <=> ~n261) /\ + (n252 <=> n249 /\ n248 \/ ~n249 /\ ~n248) /\ + (n45 <=> ~n262) /\ + (n42 <=> ~n252) /\ + (n46 <=> ~n42) /\ + (o_4_ <=> n43) /\ + (o_11_ <=> n42) /\ + (o_10_ <=> n41) /\ + (o_9_ <=> n40) /\ + (o_0_ <=> n39) /\ + (o_8_ <=> n38) /\ + (o_2_ <=> n37) /\ + (o_7_ <=> n36) /\ + (o_6_ <=> n35) /\ + (o_5_ <=> n34) /\ + (o_3_ <=> n33) /\ + (o_1_ <=> n32) /\ + (aftbuf1 <=> ~anda) /\ + (aftbuf2 <=> ~andb) /\ + (aftbuf3 <=> ~exora) /\ + (aftbuf4 <=> ~exorb) /\ + (aftbuf5 <=> ~carryin) /\ + (n1_0_ <=> aftbuf1 /\ a_0_) /\ + (n1_1_ <=> aftbuf1 /\ a_1_) /\ + (n1_2_ <=> aftbuf1 /\ a_2_) /\ + (n1_3_ <=> aftbuf1 /\ a_3_) /\ + (n1_4_ <=> aftbuf1 /\ a_4_) /\ + (n1_5_ <=> aftbuf1 /\ a_5_) /\ + (n1_6_ <=> aftbuf1 /\ a_6_) /\ + (n1_7_ <=> aftbuf1 /\ a_7_) /\ + (n1_8_ <=> aftbuf1 /\ a_8_) /\ + (n1_9_ <=> aftbuf1 /\ a_9_) /\ + (n1_10_ <=> aftbuf1 /\ a_10_) /\ + (n1_11_ <=> aftbuf1 /\ a_11_) /\ + (n3_0_ <=> aftbuf2 /\ b_0_) /\ + (n3_1_ <=> aftbuf2 /\ b_1_) /\ + (n3_2_ <=> aftbuf2 /\ b_2_) /\ + (n3_3_ <=> aftbuf2 /\ b_3_) /\ + (n3_4_ <=> aftbuf2 /\ b_4_) /\ + (n3_5_ <=> aftbuf2 /\ b_5_) /\ + (n3_6_ <=> aftbuf2 /\ b_6_) /\ + (n3_7_ <=> aftbuf2 /\ b_7_) /\ + (n3_8_ <=> aftbuf2 /\ b_8_) /\ + (n3_9_ <=> aftbuf2 /\ b_9_) /\ + (n3_10_ <=> aftbuf2 /\ b_10_) /\ + (n3_11_ <=> aftbuf2 /\ b_11_) /\ + (n2_0_ <=> aftbuf3 /\ ~n1_0_ \/ ~aftbuf3 /\ n1_0_) /\ + (n2_1_ <=> aftbuf3 /\ ~n1_1_ \/ ~aftbuf3 /\ n1_1_) /\ + (n2_2_ <=> aftbuf3 /\ ~n1_2_ \/ ~aftbuf3 /\ n1_2_) /\ + (n2_3_ <=> aftbuf3 /\ ~n1_3_ \/ ~aftbuf3 /\ n1_3_) /\ + (n2_4_ <=> aftbuf3 /\ ~n1_4_ \/ ~aftbuf3 /\ n1_4_) /\ + (n2_5_ <=> aftbuf3 /\ ~n1_5_ \/ ~aftbuf3 /\ n1_5_) /\ + (n2_6_ <=> aftbuf3 /\ ~n1_6_ \/ ~aftbuf3 /\ n1_6_) /\ + (n2_7_ <=> aftbuf3 /\ ~n1_7_ \/ ~aftbuf3 /\ n1_7_) /\ + (n2_8_ <=> aftbuf3 /\ ~n1_8_ \/ ~aftbuf3 /\ n1_8_) /\ + (n2_9_ <=> aftbuf3 /\ ~n1_9_ \/ ~aftbuf3 /\ n1_9_) /\ + (n2_10_ <=> aftbuf3 /\ ~n1_10_ \/ ~aftbuf3 /\ n1_10_) /\ + (n2_11_ <=> aftbuf3 /\ ~n1_11_ \/ ~aftbuf3 /\ n1_11_) /\ + (n4_0_ <=> aftbuf4 /\ ~n3_0_ \/ ~aftbuf4 /\ n3_0_) /\ + (n4_1_ <=> aftbuf4 /\ ~n3_1_ \/ ~aftbuf4 /\ n3_1_) /\ + (n4_2_ <=> aftbuf4 /\ ~n3_2_ \/ ~aftbuf4 /\ n3_2_) /\ + (n4_3_ <=> aftbuf4 /\ ~n3_3_ \/ ~aftbuf4 /\ n3_3_) /\ + (n4_4_ <=> aftbuf4 /\ ~n3_4_ \/ ~aftbuf4 /\ n3_4_) /\ + (n4_5_ <=> aftbuf4 /\ ~n3_5_ \/ ~aftbuf4 /\ n3_5_) /\ + (n4_6_ <=> aftbuf4 /\ ~n3_6_ \/ ~aftbuf4 /\ n3_6_) /\ + (n4_7_ <=> aftbuf4 /\ ~n3_7_ \/ ~aftbuf4 /\ n3_7_) /\ + (n4_8_ <=> aftbuf4 /\ ~n3_8_ \/ ~aftbuf4 /\ n3_8_) /\ + (n4_9_ <=> aftbuf4 /\ ~n3_9_ \/ ~aftbuf4 /\ n3_9_) /\ + (n4_10_ <=> aftbuf4 /\ ~n3_10_ \/ ~aftbuf4 /\ n3_10_) /\ + (n4_11_ <=> aftbuf4 /\ ~n3_11_ \/ ~aftbuf4 /\ n3_11_) /\ + (cout1 <=> aftbuf5 /\ n4_0_ \/ aftbuf5 /\ n2_0_ \/ n4_0_ /\ n2_0_) /\ + (cout2 <=> cout1 /\ n4_1_ \/ cout1 /\ n2_1_ \/ n4_1_ /\ n2_1_) /\ + (cout3 <=> cout2 /\ n4_2_ \/ cout2 /\ n2_2_ \/ n4_2_ /\ n2_2_) /\ + (cout4 <=> cout3 /\ n4_3_ \/ cout3 /\ n2_3_ \/ n4_3_ /\ n2_3_) /\ + (cout5 <=> cout4 /\ n4_4_ \/ cout4 /\ n2_4_ \/ n4_4_ /\ n2_4_) /\ + (cout6 <=> cout5 /\ n4_5_ \/ cout5 /\ n2_5_ \/ n4_5_ /\ n2_5_) /\ + (cout7 <=> cout6 /\ n4_6_ \/ cout6 /\ n2_6_ \/ n4_6_ /\ n2_6_) /\ + (cout8 <=> cout7 /\ n4_7_ \/ cout7 /\ n2_7_ \/ n4_7_ /\ n2_7_) /\ + (cout9 <=> cout8 /\ n4_8_ \/ cout8 /\ n2_8_ \/ n4_8_ /\ n2_8_) /\ + (cout10 <=> cout9 /\ n4_9_ \/ cout9 /\ n2_9_ \/ n4_9_ /\ n2_9_) /\ + (cout11 <=> cout10 /\ n4_10_ \/ cout10 /\ n2_10_ \/ n4_10_ /\ n2_10_) /\ + (hulp0 <=> ~(n2_0_ <=> ~(n4_0_ <=> aftbuf5))) /\ + (hulp1 <=> ~(n2_1_ <=> ~(n4_1_ <=> cout1))) /\ + (hulp2 <=> ~(n2_2_ <=> ~(n4_2_ <=> cout2))) /\ + (hulp3 <=> ~(n2_3_ <=> ~(n4_3_ <=> cout3))) /\ + (hulp4 <=> ~(n2_4_ <=> ~(n4_4_ <=> cout4))) /\ + (hulp5 <=> ~(n2_5_ <=> ~(n4_5_ <=> cout5))) /\ + (hulp6 <=> ~(n2_6_ <=> ~(n4_6_ <=> cout6))) /\ + (hulp7 <=> ~(n2_7_ <=> ~(n4_7_ <=> cout7))) /\ + (hulp8 <=> ~(n2_8_ <=> ~(n4_8_ <=> cout8))) /\ + (hulp9 <=> ~(n2_9_ <=> ~(n4_9_ <=> cout9))) /\ + (hulp10 <=> ~(n2_10_ <=> ~(n4_10_ <=> cout10))) /\ + (hulp11 <=> ~(n2_11_ <=> ~(n4_11_ <=> cout11))) /\ + (hulp12 <=> cout11 /\ n4_11_ \/ cout11 /\ n2_11_ \/ n4_11_ /\ n2_11_) + ==> (o_0_ <=> hulp0) /\ + (o_1_ <=> hulp1) /\ + (o_2_ <=> hulp2) /\ + (o_3_ <=> hulp3) /\ + (o_4_ <=> hulp4) /\ + (o_5_ <=> hulp5) /\ + (o_6_ <=> hulp6) /\ + (o_7_ <=> hulp7) /\ + (o_8_ <=> hulp8) /\ + (o_9_ <=> hulp9) /\ + (o_10_ <=> hulp10) /\ + (o_11_ <=> hulp11)` ;; + +let u5 = `(s0_0 <=> (x_0 <=> ~y_0)) /\ (c0_1 <=> x_0 /\ y_0) /\ + (s0_1 <=> ((x_1 <=> ~y_1) <=> ~c0_1)) /\ + (c0_2 <=> x_1 /\ y_1 \/ (x_1 \/ y_1) /\ c0_1) /\ + (s0_2 <=> ((x_2 <=> ~y_2) <=> ~c0_2)) /\ + (c0_3 <=> x_2 /\ y_2 \/ (x_2 \/ y_2) /\ c0_2) /\ + (s1_0 <=> ~(x_0 <=> ~y_0)) /\ (c1_1 <=> x_0 /\ y_0 \/ x_0 \/ y_0) /\ + (s1_1 <=> ((x_1 <=> ~y_1) <=> ~c1_1)) /\ + (c1_2 <=> x_1 /\ y_1 \/ (x_1 \/ y_1) /\ c1_1) /\ + (s1_2 <=> ((x_2 <=> ~y_2) <=> ~c1_2)) /\ + (c1_3 <=> x_2 /\ y_2 \/ (x_2 \/ y_2) /\ c1_2) /\ + (c_3 <=> ~c_0 /\ c0_3 \/ c_0 /\ c1_3) /\ + (s_0 <=> ~c_0 /\ s0_0 \/ c_0 /\ s1_0) /\ + (s_1 <=> ~c_0 /\ s0_1 \/ c_0 /\ s1_1) /\ + (s_2 <=> ~c_0 /\ s0_2 \/ c_0 /\ s1_2) /\ ~c_0 /\ + (s2_0 <=> (x_0 <=> ~y_0)) /\ (c2_1 <=> x_0 /\ y_0) /\ + (s2_1 <=> ((x_1 <=> ~y_1) <=> ~c2_1)) /\ + (c2_2 <=> x_1 /\ y_1 \/ (x_1 \/ y_1) /\ c2_1) /\ + (s2_2 <=> ((x_2 <=> ~y_2) <=> ~c2_2)) /\ + (c2_3 <=> x_2 /\ y_2 \/ (x_2 \/ y_2) /\ c2_2) ==> + (c_3 <=> c2_3) /\ (s_0 <=> s2_0) /\ (s_1 <=> s2_1) /\ (s_2 <=> s2_2)`;; + +let msc007_1_008 = +`~((~hslv49 \/ ~hslv56) /\ (~hslv42 \/ ~hslv56) /\ + (~hslv42 \/ ~hslv49) /\ (~hslv35 \/ ~hslv56) /\ + (~hslv35 \/ ~hslv49) /\ (~hslv35 \/ ~hslv42) /\ + (~hslv28 \/ ~hslv56) /\ (~hslv28 \/ ~hslv49) /\ + (~hslv28 \/ ~hslv42) /\ (~hslv28 \/ ~hslv35) /\ + (~hslv21 \/ ~hslv56) /\ (~hslv21 \/ ~hslv49) /\ + (~hslv21 \/ ~hslv42) /\ (~hslv21 \/ ~hslv35) /\ + (~hslv21 \/ ~hslv28) /\ (~hslv14 \/ ~hslv56) /\ + (~hslv14 \/ ~hslv49) /\ (~hslv14 \/ ~hslv42) /\ + (~hslv14 \/ ~hslv35) /\ (~hslv14 \/ ~hslv28) /\ + (~hslv14 \/ ~hslv21) /\ (~hslv7 \/ ~hslv56) /\ + (~hslv7 \/ ~hslv49) /\ (~hslv7 \/ ~hslv42) /\ (~hslv7 \/ ~hslv35) /\ + (~hslv7 \/ ~hslv28) /\ (~hslv7 \/ ~hslv21) /\ (~hslv7 \/ ~hslv14) /\ + (~hslv48 \/ ~hslv55) /\ (~hslv41 \/ ~hslv55) /\ + (~hslv41 \/ ~hslv48) /\ (~hslv34 \/ ~hslv55) /\ + (~hslv34 \/ ~hslv48) /\ (~hslv34 \/ ~hslv41) /\ + (~hslv27 \/ ~hslv55) /\ (~hslv27 \/ ~hslv48) /\ + (~hslv27 \/ ~hslv41) /\ (~hslv27 \/ ~hslv34) /\ + (~hslv20 \/ ~hslv55) /\ (~hslv20 \/ ~hslv48) /\ + (~hslv20 \/ ~hslv41) /\ (~hslv20 \/ ~hslv34) /\ + (~hslv20 \/ ~hslv27) /\ (~hslv13 \/ ~hslv55) /\ + (~hslv13 \/ ~hslv48) /\ (~hslv13 \/ ~hslv41) /\ + (~hslv13 \/ ~hslv34) /\ (~hslv13 \/ ~hslv27) /\ + (~hslv13 \/ ~hslv20) /\ (~hslv6 \/ ~hslv55) /\ + (~hslv6 \/ ~hslv48) /\ (~hslv6 \/ ~hslv41) /\ (~hslv6 \/ ~hslv34) /\ + (~hslv6 \/ ~hslv27) /\ (~hslv6 \/ ~hslv20) /\ (~hslv6 \/ ~hslv13) /\ + (~hslv47 \/ ~hslv54) /\ (~hslv40 \/ ~hslv54) /\ + (~hslv40 \/ ~hslv47) /\ (~hslv33 \/ ~hslv54) /\ + (~hslv33 \/ ~hslv47) /\ (~hslv33 \/ ~hslv40) /\ + (~hslv26 \/ ~hslv54) /\ (~hslv26 \/ ~hslv47) /\ + (~hslv26 \/ ~hslv40) /\ (~hslv26 \/ ~hslv33) /\ + (~hslv19 \/ ~hslv54) /\ (~hslv19 \/ ~hslv47) /\ + (~hslv19 \/ ~hslv40) /\ (~hslv19 \/ ~hslv33) /\ + (~hslv19 \/ ~hslv26) /\ (~hslv12 \/ ~hslv54) /\ + (~hslv12 \/ ~hslv47) /\ (~hslv12 \/ ~hslv40) /\ + (~hslv12 \/ ~hslv33) /\ (~hslv12 \/ ~hslv26) /\ + (~hslv12 \/ ~hslv19) /\ (~hslv5 \/ ~hslv54) /\ + (~hslv5 \/ ~hslv47) /\ (~hslv5 \/ ~hslv40) /\ (~hslv5 \/ ~hslv33) /\ + (~hslv5 \/ ~hslv26) /\ (~hslv5 \/ ~hslv19) /\ (~hslv5 \/ ~hslv12) /\ + (~hslv46 \/ ~hslv53) /\ (~hslv39 \/ ~hslv53) /\ + (~hslv39 \/ ~hslv46) /\ (~hslv32 \/ ~hslv53) /\ + (~hslv32 \/ ~hslv46) /\ (~hslv32 \/ ~hslv39) /\ + (~hslv25 \/ ~hslv53) /\ (~hslv25 \/ ~hslv46) /\ + (~hslv25 \/ ~hslv39) /\ (~hslv25 \/ ~hslv32) /\ + (~hslv18 \/ ~hslv53) /\ (~hslv18 \/ ~hslv46) /\ + (~hslv18 \/ ~hslv39) /\ (~hslv18 \/ ~hslv32) /\ + (~hslv18 \/ ~hslv25) /\ (~hslv11 \/ ~hslv53) /\ + (~hslv11 \/ ~hslv46) /\ (~hslv11 \/ ~hslv39) /\ + (~hslv11 \/ ~hslv32) /\ (~hslv11 \/ ~hslv25) /\ + (~hslv11 \/ ~hslv18) /\ (~hslv4 \/ ~hslv53) /\ + (~hslv4 \/ ~hslv46) /\ (~hslv4 \/ ~hslv39) /\ (~hslv4 \/ ~hslv32) /\ + (~hslv4 \/ ~hslv25) /\ (~hslv4 \/ ~hslv18) /\ (~hslv4 \/ ~hslv11) /\ + (~hslv45 \/ ~hslv52) /\ (~hslv38 \/ ~hslv52) /\ + (~hslv38 \/ ~hslv45) /\ (~hslv31 \/ ~hslv52) /\ + (~hslv31 \/ ~hslv45) /\ (~hslv31 \/ ~hslv38) /\ + (~hslv24 \/ ~hslv52) /\ (~hslv24 \/ ~hslv45) /\ + (~hslv24 \/ ~hslv38) /\ (~hslv24 \/ ~hslv31) /\ + (~hslv17 \/ ~hslv52) /\ (~hslv17 \/ ~hslv45) /\ + (~hslv17 \/ ~hslv38) /\ (~hslv17 \/ ~hslv31) /\ + (~hslv17 \/ ~hslv24) /\ (~hslv10 \/ ~hslv52) /\ + (~hslv10 \/ ~hslv45) /\ (~hslv10 \/ ~hslv38) /\ + (~hslv10 \/ ~hslv31) /\ (~hslv10 \/ ~hslv24) /\ + (~hslv10 \/ ~hslv17) /\ (~hslv3 \/ ~hslv52) /\ + (~hslv3 \/ ~hslv45) /\ (~hslv3 \/ ~hslv38) /\ (~hslv3 \/ ~hslv31) /\ + (~hslv3 \/ ~hslv24) /\ (~hslv3 \/ ~hslv17) /\ (~hslv3 \/ ~hslv10) /\ + (~hslv44 \/ ~hslv51) /\ (~hslv37 \/ ~hslv51) /\ + (~hslv37 \/ ~hslv44) /\ (~hslv30 \/ ~hslv51) /\ + (~hslv30 \/ ~hslv44) /\ (~hslv30 \/ ~hslv37) /\ + (~hslv23 \/ ~hslv51) /\ (~hslv23 \/ ~hslv44) /\ + (~hslv23 \/ ~hslv37) /\ (~hslv23 \/ ~hslv30) /\ + (~hslv16 \/ ~hslv51) /\ (~hslv16 \/ ~hslv44) /\ + (~hslv16 \/ ~hslv37) /\ (~hslv16 \/ ~hslv30) /\ + (~hslv16 \/ ~hslv23) /\ (~hslv9 \/ ~hslv51) /\ + (~hslv9 \/ ~hslv44) /\ (~hslv9 \/ ~hslv37) /\ (~hslv9 \/ ~hslv30) /\ + (~hslv9 \/ ~hslv23) /\ (~hslv9 \/ ~hslv16) /\ (~hslv2 \/ ~hslv51) /\ + (~hslv2 \/ ~hslv44) /\ (~hslv2 \/ ~hslv37) /\ (~hslv2 \/ ~hslv30) /\ + (~hslv2 \/ ~hslv23) /\ (~hslv2 \/ ~hslv16) /\ (~hslv2 \/ ~hslv9) /\ + (~hslv43 \/ ~hslv50) /\ (~hslv36 \/ ~hslv50) /\ + (~hslv36 \/ ~hslv43) /\ (~hslv29 \/ ~hslv50) /\ + (~hslv29 \/ ~hslv43) /\ (~hslv29 \/ ~hslv36) /\ + (~hslv22 \/ ~hslv50) /\ (~hslv22 \/ ~hslv43) /\ + (~hslv22 \/ ~hslv36) /\ (~hslv22 \/ ~hslv29) /\ + (~hslv15 \/ ~hslv50) /\ (~hslv15 \/ ~hslv43) /\ + (~hslv15 \/ ~hslv36) /\ (~hslv15 \/ ~hslv29) /\ + (~hslv15 \/ ~hslv22) /\ (~hslv8 \/ ~hslv50) /\ + (~hslv8 \/ ~hslv43) /\ (~hslv8 \/ ~hslv36) /\ (~hslv8 \/ ~hslv29) /\ + (~hslv8 \/ ~hslv22) /\ (~hslv8 \/ ~hslv15) /\ (~hslv1 \/ ~hslv50) /\ + (~hslv1 \/ ~hslv43) /\ (~hslv1 \/ ~hslv36) /\ (~hslv1 \/ ~hslv29) /\ + (~hslv1 \/ ~hslv22) /\ (~hslv1 \/ ~hslv15) /\ (~hslv1 \/ ~hslv8) /\ + (hslv50 \/ hslv51 \/ hslv52 \/ hslv53 \/ hslv54 \/ hslv55 \/ + hslv56) /\ + (hslv43 \/ hslv44 \/ hslv45 \/ hslv46 \/ hslv47 \/ hslv48 \/ + hslv49) /\ + (hslv36 \/ hslv37 \/ hslv38 \/ hslv39 \/ hslv40 \/ hslv41 \/ + hslv42) /\ + (hslv29 \/ hslv30 \/ hslv31 \/ hslv32 \/ hslv33 \/ hslv34 \/ + hslv35) /\ + (hslv22 \/ hslv23 \/ hslv24 \/ hslv25 \/ hslv26 \/ hslv27 \/ + hslv28) /\ + (hslv15 \/ hslv16 \/ hslv17 \/ hslv18 \/ hslv19 \/ hslv20 \/ + hslv21) /\ + (hslv8 \/ hslv9 \/ hslv10 \/ hslv11 \/ hslv12 \/ hslv13 \/ + hslv14) /\ + (hslv1 \/ hslv2 \/ hslv3 \/ hslv4 \/ hslv5 \/ hslv6 \/ hslv7))` + +let ahb_arb_8 = + `(if ~hmask_7 /\ hbusreq_7 /\ ~htrans_0 /\ ~htrans_1 then + ~hgrant_3' /\ hgrant_2' /\ hgrant_1' /\ hgrant_0' + else + (if ~hmask_6 /\ hbusreq_6 /\ ~htrans_0 /\ ~htrans_1 then + ~hgrant_3' /\ hgrant_2' /\ hgrant_1' /\ ~hgrant_0' + else + (if ~hmask_5 /\ hbusreq_5 /\ ~htrans_0 /\ ~htrans_1 then + ~hgrant_3' /\ hgrant_2' /\ ~hgrant_1' /\ hgrant_0' + else + (if ~hmask_4 /\ hbusreq_4 /\ ~htrans_0 /\ ~htrans_1 then + ~hgrant_3' /\ hgrant_2' /\ ~hgrant_1' /\ ~hgrant_0' + else + (if ~hmask_3 /\ hbusreq_3 /\ ~htrans_0 /\ ~htrans_1 then + ~hgrant_3' /\ ~hgrant_2' /\ hgrant_1' /\ hgrant_0' + else + (if + ~hmask_2 /\ hbusreq_2 /\ ~htrans_0 /\ ~htrans_1 + then + ~hgrant_3' /\ ~hgrant_2' /\ hgrant_1' /\ ~hgrant_0' + else + (if + ~hmask_1 /\ hbusreq_1 /\ ~htrans_0 /\ ~htrans_1 + then + ~hgrant_3' /\ ~hgrant_2' /\ ~hgrant_1' /\ + hgrant_0' + else + hgrant_0' /\ + ((hmaster_3':bool) <=> + (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + ((hmaster_2':bool) <=> + (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + ((hmaster_1':bool) <=> + (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + ((hmaster_0':bool) <=> + (if ~hreadyout then + hmaster_0 + else + hgrant_0))) /\ + (hmaster_3' <=> + (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + (hmaster_2' <=> + (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + (hmaster_1' <=> + (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + (hmaster_0' <=> + (if ~hreadyout then hmaster_0 else hgrant_0))) /\ + (hmaster_3' <=> + (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + (hmaster_2' <=> + (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + (hmaster_1' <=> + (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + (hmaster_0' <=> + (if ~hreadyout then hmaster_0 else hgrant_0))) /\ + (hmaster_3' <=> + (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + (hmaster_2' <=> + (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + (hmaster_1' <=> + (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + (hmaster_0' <=> + (if ~hreadyout then hmaster_0 else hgrant_0))) /\ + (hmaster_3' <=> + (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + (hmaster_2' <=> + (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + (hmaster_1' <=> + (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + (hmaster_0' <=> + (if ~hreadyout then hmaster_0 else hgrant_0))) /\ + (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0))) /\ + (hmaster_3' <=> (if ~hreadyout then hmaster_3 else hgrant_3)) /\ + (hmaster_2' <=> (if ~hreadyout then hmaster_2 else hgrant_2)) /\ + (hmaster_1' <=> (if ~hreadyout then hmaster_1 else hgrant_1)) /\ + (hmaster_0' <=> (if ~hreadyout then hmaster_0 else hgrant_0)))` + +let ssa = `~ +((v435) /\ + (v174) /\ + (~v175) /\ + (v173) /\ + (~v39 \/ ~v433) /\ + (v37 \/ ~v433) /\ + (v39 \/ ~v434) /\ + (~v37 \/ ~v434) /\ + (~v434 \/ v432) /\ + (~v433 \/ v432) /\ + (~v79 \/ ~v37) /\ + (~v67 \/ ~v37) /\ + (~v68 \/ v38) /\ + (~v68 \/ ~v79) /\ + (~v79 \/ ~v39) /\ + (~v69 \/ ~v39) /\ + (~v76 \/ ~v67) /\ + (~v71 \/ ~v67) /\ + (~v74 \/ ~v67) /\ + (~v138 \/ ~v67) /\ + (~v72 \/ v68) /\ + (~v72 \/ ~v138) /\ + (~v72 \/ ~v74) /\ + (~v72 \/ ~v76) /\ + (~v76 \/ ~v69) /\ + (~v73 \/ ~v69) /\ + (~v74 \/ ~v69) /\ + (~v138 \/ ~v69) /\ + (v75 \/ ~v138) /\ + (~v75 \/ v138) /\ + (v75 \/ ~v139) /\ + (~v75 \/ v139) /\ + (v75 \/ ~v147) /\ + (~v75 \/ v147) /\ + (~v311 \/ ~v75) /\ + (~v307 \/ ~v75) /\ + (v312 \/ v307) /\ + (~v312 \/ ~v307) /\ + (v15 \/ ~v315) /\ + (~v15 \/ v315) /\ + (v15 \/ ~v316) /\ + (~v15 \/ v316) /\ + (v53 \/ ~v93) /\ + (~v53 \/ v93) /\ + (v53 \/ ~v94) /\ + (~v53 \/ v94) /\ + (v53 \/ ~v98) /\ + (~v53 \/ v98) /\ + (v53 \/ ~v102) /\ + (~v53 \/ v102) /\ + (v53 \/ ~v105) /\ + (~v53 \/ v105) /\ + (v53 \/ ~v119) /\ + (~v53 \/ v119) /\ + (v53 \/ ~v121) /\ + (~v53 \/ v121) /\ + (v53 \/ ~v124) /\ + (~v53 \/ v124) /\ + (v53 \/ ~v129) /\ + (~v53 \/ v129) /\ + (v53 \/ ~v169) /\ + (~v53 \/ v169) /\ + (v53 \/ ~v207) /\ + (~v53 \/ v207) /\ + (v53 \/ ~v221) /\ + (~v53 \/ v221) /\ + (v53 \/ ~v244) /\ + (~v53 \/ v244) /\ + (v53 \/ ~v250) /\ + (~v53 \/ v250) /\ + (v53 \/ ~v304) /\ + (~v53 \/ v304) /\ + (v53 \/ ~v314) /\ + (~v53 \/ v314) /\ + (v53 \/ ~v330) /\ + (~v53 \/ v330) /\ + (v53 \/ ~v343) /\ + (~v53 \/ v343) /\ + (v53 \/ ~v345) /\ + (~v53 \/ v345) /\ + (v53 \/ ~v360) /\ + (~v53 \/ v360) /\ + (v53 \/ ~v378) /\ + (~v53 \/ v378) /\ + (v60 \/ v53) /\ + (v263 \/ v53) /\ + (v176 \/ v53) /\ + (v182 \/ v53) /\ + (v188 \/ v182) /\ + (~v188 \/ ~v182) /\ + (v104 \/ ~v187) /\ + (~v104 \/ v187) /\ + (v104 \/ ~v188) /\ + (~v104 \/ v188) /\ + (~v196 \/ ~v104) /\ + (~v191 \/ ~v104) /\ + (~v193 \/ ~v104) /\ + (v184 \/ ~v192) /\ + (~v184 \/ v192) /\ + (v184 \/ ~v193) /\ + (~v184 \/ v193) /\ + (v184 \/ ~v200) /\ + (~v184 \/ v200) /\ + (v184 \/ ~v203) /\ + (~v184 \/ v203) /\ + (v34 \/ v184) /\ + (~v34 \/ ~v184) /\ + (v12 \/ ~v190) /\ + (~v12 \/ v190) /\ + (v12 \/ ~v191) /\ + (~v12 \/ v191) /\ + (v189 \/ ~v196) /\ + (~v189 \/ v196) /\ + (v189 \/ ~v197) /\ + (~v189 \/ v197) /\ + (~v271 \/ ~v422) /\ + (v195 \/ ~v422) /\ + (v271 \/ ~v423) /\ + (~v195 \/ ~v423) /\ + (~v423 \/ v189) /\ + (~v422 \/ v189) /\ + (v42 \/ ~v80) /\ + (~v42 \/ v80) /\ + (v42 \/ ~v81) /\ + (~v42 \/ v81) /\ + (v42 \/ ~v84) /\ + (~v42 \/ v84) /\ + (v42 \/ ~v101) /\ + (~v42 \/ v101) /\ + (v42 \/ ~v112) /\ + (~v42 \/ v112) /\ + (v42 \/ ~v166) /\ + (~v42 \/ v166) /\ + (v42 \/ ~v195) /\ + (~v42 \/ v195) /\ + (v42 \/ ~v218) /\ + (~v42 \/ v218) /\ + (v42 \/ ~v241) /\ + (~v42 \/ v241) /\ + (v42 \/ ~v259) /\ + (~v42 \/ v259) /\ + (v42 \/ ~v291) /\ + (~v42 \/ v291) /\ + (v42 \/ ~v303) /\ + (~v42 \/ v303) /\ + (v42 \/ ~v313) /\ + (~v42 \/ v313) /\ + (v42 \/ ~v323) /\ + (~v42 \/ v323) /\ + (v42 \/ ~v344) /\ + (~v42 \/ v344) /\ + (v42 \/ ~v349) /\ + (~v42 \/ v349) /\ + (v42 \/ ~v357) /\ + (~v42 \/ v357) /\ + (v42 \/ ~v385) /\ + (~v42 \/ v385) /\ + (v42 \/ ~v404) /\ + (~v42 \/ v404) /\ + (v286 \/ v42) /\ + (v267 \/ v42) /\ + (v43 \/ v42) /\ + (v278 \/ v42) /\ + (v347 \/ v278) /\ + (~v347 \/ ~v278) /\ + (v279 \/ ~v347) /\ + (~v279 \/ v347) /\ + (v279 \/ ~v348) /\ + (~v279 \/ v348) /\ + (~v369 \/ ~v279) /\ + (~v370 \/ ~v279) /\ + (v281 \/ ~v284) /\ + (~v281 \/ v284) /\ + (v281 \/ ~v285) /\ + (~v281 \/ v285) /\ + (v281 \/ ~v301) /\ + (~v281 \/ v301) /\ + (v281 \/ ~v370) /\ + (~v281 \/ v370) /\ + (v26 \/ v281) /\ + (~v26 \/ ~v281) /\ + (v7 \/ ~v368) /\ + (~v7 \/ v368) /\ + (v7 \/ ~v369) /\ + (~v7 \/ v369) /\ + (~v110 \/ ~v43) /\ + (~v46 \/ ~v43) /\ + (v41 \/ ~v45) /\ + (~v41 \/ v45) /\ + (v41 \/ ~v46) /\ + (~v41 \/ v46) /\ + (~v219 \/ ~v41) /\ + (~v211 \/ ~v41) /\ + (v204 \/ ~v211) /\ + (~v204 \/ v211) /\ + (v204 \/ ~v212) /\ + (~v204 \/ v212) /\ + (v214 \/ v204) /\ + (~v214 \/ ~v204) /\ + (v32 \/ ~v214) /\ + (~v32 \/ v214) /\ + (v32 \/ ~v215) /\ + (~v32 \/ v215) /\ + (v32 \/ ~v228) /\ + (~v32 \/ v228) /\ + (v5 \/ ~v219) /\ + (~v5 \/ v219) /\ + (v5 \/ ~v220) /\ + (~v5 \/ v220) /\ + (v44 \/ ~v110) /\ + (~v44 \/ v110) /\ + (v44 \/ ~v111) /\ + (~v44 \/ v111) /\ + (~v358 \/ ~v44) /\ + (~v355 \/ ~v44) /\ + (v350 \/ ~v353) /\ + (~v350 \/ v353) /\ + (v350 \/ ~v354) /\ + (~v350 \/ v354) /\ + (v350 \/ ~v355) /\ + (~v350 \/ v355) /\ + (v350 \/ ~v367) /\ + (~v350 \/ v367) /\ + (v9 \/ v350) /\ + (~v9 \/ ~v350) /\ + (v21 \/ ~v358) /\ + (~v21 \/ v358) /\ + (v21 \/ ~v359) /\ + (~v21 \/ v359) /\ + (~v270 \/ ~v267) /\ + (~v268 \/ ~v267) /\ + (~v272 \/ ~v267) /\ + (v194 \/ ~v271) /\ + (~v194 \/ v271) /\ + (v194 \/ ~v272) /\ + (~v194 \/ v272) /\ + (~v202 \/ ~v194) /\ + (~v203 \/ ~v194) /\ + (v25 \/ ~v201) /\ + (~v25 \/ v201) /\ + (v25 \/ ~v202) /\ + (~v25 \/ v202) /\ + (v331 \/ v268) /\ + (v324 \/ v268) /\ + (v332 \/ v268) /\ + (v402 \/ v332) /\ + (~v402 \/ ~v332) /\ + (v391 \/ ~v402) /\ + (~v391 \/ v402) /\ + (v391 \/ ~v403) /\ + (~v391 \/ v403) /\ + (~v400 \/ ~v391) /\ + (~v401 \/ ~v391) /\ + (v392 \/ ~v397) /\ + (~v392 \/ v397) /\ + (v392 \/ ~v398) /\ + (~v392 \/ v398) /\ + (v392 \/ ~v401) /\ + (~v392 \/ v401) /\ + (v392 \/ ~v409) /\ + (~v392 \/ v409) /\ + (v19 \/ v392) /\ + (~v19 \/ ~v392) /\ + (v17 \/ ~v399) /\ + (~v17 \/ v399) /\ + (v17 \/ ~v400) /\ + (~v17 \/ v400) /\ + (v326 \/ v324) /\ + (~v326 \/ ~v324) /\ + (v322 \/ ~v325) /\ + (~v322 \/ v325) /\ + (v322 \/ ~v326) /\ + (~v322 \/ v326) /\ + (~v389 \/ ~v322) /\ + (~v390 \/ ~v322) /\ + (v235 \/ ~v386) /\ + (~v235 \/ v386) /\ + (v235 \/ ~v387) /\ + (~v235 \/ v387) /\ + (v235 \/ ~v390) /\ + (~v235 \/ v390) /\ + (v383 \/ v235) /\ + (~v383 \/ ~v235) /\ + (v35 \/ ~v382) /\ + (~v35 \/ v382) /\ + (v35 \/ ~v383) /\ + (~v35 \/ v383) /\ + (v30 \/ ~v388) /\ + (~v30 \/ v388) /\ + (v30 \/ ~v389) /\ + (~v30 \/ v389) /\ + (v334 \/ v331) /\ + (~v334 \/ ~v331) /\ + (v83 \/ ~v333) /\ + (~v83 \/ v333) /\ + (v83 \/ ~v334) /\ + (~v83 \/ v334) /\ + (~v320 \/ ~v83) /\ + (~v321 \/ ~v83) /\ + (v86 \/ ~v91) /\ + (~v86 \/ v91) /\ + (v86 \/ ~v92) /\ + (~v86 \/ v92) /\ + (v86 \/ ~v158) /\ + (~v86 \/ v158) /\ + (v86 \/ ~v321) /\ + (~v86 \/ v321) /\ + (v28 \/ v86) /\ + (~v28 \/ ~v86) /\ + (v4 \/ ~v317) /\ + (~v4 \/ v317) /\ + (v4 \/ ~v320) /\ + (~v4 \/ v320) /\ + (v237 \/ ~v269) /\ + (~v237 \/ v269) /\ + (v237 \/ ~v270) /\ + (~v237 \/ v270) /\ + (~v242 \/ ~v237) /\ + (~v239 \/ ~v237) /\ + (v232 \/ ~v238) /\ + (~v232 \/ v238) /\ + (v232 \/ ~v239) /\ + (~v232 \/ v239) /\ + (v253 \/ v232) /\ + (~v253 \/ ~v232) /\ + (v6 \/ ~v253) /\ + (~v6 \/ v253) /\ + (v6 \/ ~v254) /\ + (~v6 \/ v254) /\ + (v6 \/ ~v258) /\ + (~v6 \/ v258) /\ + (v10 \/ ~v242) /\ + (~v10 \/ v242) /\ + (v10 \/ ~v243) /\ + (~v10 \/ v243) /\ + (v289 \/ v286) /\ + (~v289 \/ ~v286) /\ + (v287 \/ ~v289) /\ + (~v287 \/ v289) /\ + (v287 \/ ~v290) /\ + (~v287 \/ v290) /\ + (~v372 \/ ~v287) /\ + (~v373 \/ ~v287) /\ + (v292 \/ ~v295) /\ + (~v292 \/ v295) /\ + (v292 \/ ~v296) /\ + (~v292 \/ v296) /\ + (v292 \/ ~v311) /\ + (~v292 \/ v311) /\ + (v292 \/ ~v373) /\ + (~v292 \/ v373) /\ + (v27 \/ v292) /\ + (~v27 \/ ~v292) /\ + (v11 \/ ~v371) /\ + (~v11 \/ v371) /\ + (v11 \/ ~v372) /\ + (~v11 \/ v372) /\ + (~v180 \/ ~v176) /\ + (~v328 \/ ~v176) /\ + (~v276 \/ ~v176) /\ + (v178 \/ ~v276) /\ + (~v178 \/ v276) /\ + (v178 \/ ~v277) /\ + (~v178 \/ v277) /\ + (v178 \/ ~v342) /\ + (~v178 \/ v342) /\ + (~v405 \/ ~v178) /\ + (~v396 \/ ~v178) /\ + (~v398 \/ ~v178) /\ + (v18 \/ ~v395) /\ + (~v18 \/ v395) /\ + (v18 \/ ~v396) /\ + (~v18 \/ v396) /\ + (v394 \/ ~v405) /\ + (~v394 \/ v405) /\ + (v394 \/ ~v406) /\ + (~v394 \/ v406) /\ + (~v403 \/ ~v410) /\ + (v404 \/ ~v410) /\ + (v403 \/ ~v411) /\ + (~v404 \/ ~v411) /\ + (~v411 \/ v394) /\ + (~v410 \/ v394) /\ + (v177 \/ ~v328) /\ + (~v177 \/ v328) /\ + (v177 \/ ~v329) /\ + (~v177 \/ v329) /\ + (~v337 \/ ~v177) /\ + (~v376 \/ ~v177) /\ + (~v386 \/ ~v177) /\ + (v22 \/ ~v376) /\ + (~v22 \/ v376) /\ + (v22 \/ ~v377) /\ + (~v22 \/ v377) /\ + (v234 \/ ~v337) /\ + (~v234 \/ v337) /\ + (v234 \/ ~v338) /\ + (~v234 \/ v338) /\ + (~v325 \/ ~v416) /\ + (v323 \/ ~v416) /\ + (v325 \/ ~v417) /\ + (~v323 \/ ~v417) /\ + (~v417 \/ v234) /\ + (~v416 \/ v234) /\ + (v85 \/ ~v179) /\ + (~v85 \/ v179) /\ + (v85 \/ ~v180) /\ + (~v85 \/ v180) /\ + (~v89 \/ ~v85) /\ + (~v172 \/ ~v85) /\ + (~v91 \/ ~v85) /\ + (v23 \/ ~v172) /\ + (~v23 \/ v172) /\ + (v23 \/ ~v173) /\ + (~v23 \/ v173) /\ + (v82 \/ ~v89) /\ + (~v82 \/ v89) /\ + (v82 \/ ~v90) /\ + (~v82 \/ v90) /\ + (~v333 \/ ~v428) /\ + (v84 \/ ~v428) /\ + (v333 \/ ~v429) /\ + (~v84 \/ ~v429) /\ + (~v429 \/ v82) /\ + (~v428 \/ v82) /\ + (v181 \/ ~v263) /\ + (~v181 \/ v263) /\ + (v181 \/ ~v264) /\ + (~v181 \/ v264) /\ + (v248 \/ v181) /\ + (~v248 \/ ~v181) /\ + (v233 \/ ~v248) /\ + (~v233 \/ v248) /\ + (v233 \/ ~v249) /\ + (~v233 \/ v249) /\ + (~v261 \/ ~v233) /\ + (~v245 \/ ~v233) /\ + (~v238 \/ ~v233) /\ + (v33 \/ ~v245) /\ + (~v33 \/ v245) /\ + (v33 \/ ~v246) /\ + (~v33 \/ v246) /\ + (v236 \/ ~v261) /\ + (~v236 \/ v261) /\ + (v236 \/ ~v262) /\ + (~v236 \/ v262) /\ + (~v269 \/ ~v420) /\ + (v259 \/ ~v420) /\ + (v269 \/ ~v421) /\ + (~v259 \/ ~v421) /\ + (~v421 \/ v236) /\ + (~v420 \/ v236) /\ + (~v65 \/ ~v60) /\ + (~v122 \/ ~v60) /\ + (~v117 \/ ~v60) /\ + (~v127 \/ ~v60) /\ + (v63 \/ ~v127) /\ + (~v63 \/ v127) /\ + (v63 \/ ~v128) /\ + (~v63 \/ v128) /\ + (v63 \/ ~v206) /\ + (~v63 \/ v206) /\ + (~v210 \/ ~v63) /\ + (~v222 \/ ~v63) /\ + (~v212 \/ ~v63) /\ + (v29 \/ ~v222) /\ + (~v29 \/ v222) /\ + (v29 \/ ~v223) /\ + (~v29 \/ v223) /\ + (v40 \/ ~v209) /\ + (~v40 \/ v209) /\ + (v40 \/ ~v210) /\ + (~v40 \/ v210) /\ + (~v45 \/ ~v430) /\ + (v80 \/ ~v430) /\ + (v45 \/ ~v431) /\ + (~v80 \/ ~v431) /\ + (~v431 \/ v40) /\ + (~v430 \/ v40) /\ + (v62 \/ ~v117) /\ + (~v62 \/ v117) /\ + (v62 \/ ~v118) /\ + (~v62 \/ v118) /\ + (v62 \/ ~v120) /\ + (~v62 \/ v120) /\ + (~v283 \/ ~v62) /\ + (~v305 \/ ~v62) /\ + (~v285 \/ ~v62) /\ + (v31 \/ ~v305) /\ + (~v31 \/ v305) /\ + (v31 \/ ~v306) /\ + (~v31 \/ v306) /\ + (v280 \/ ~v282) /\ + (~v280 \/ v282) /\ + (v280 \/ ~v283) /\ + (~v280 \/ v283) /\ + (~v348 \/ ~v412) /\ + (v349 \/ ~v412) /\ + (v348 \/ ~v413) /\ + (~v349 \/ ~v413) /\ + (~v413 \/ v280) /\ + (~v412 \/ v280) /\ + (v61 \/ ~v122) /\ + (~v61 \/ v122) /\ + (v61 \/ ~v123) /\ + (~v61 \/ v123) /\ + (~v351 \/ ~v61) /\ + (~v361 \/ ~v61) /\ + (~v353 \/ ~v61) /\ + (v20 \/ ~v361) /\ + (~v20 \/ v361) /\ + (v20 \/ ~v362) /\ + (~v20 \/ v362) /\ + (v109 \/ ~v351) /\ + (~v109 \/ v351) /\ + (v109 \/ ~v352) /\ + (~v109 \/ v352) /\ + (~v111 \/ ~v424) /\ + (v112 \/ ~v424) /\ + (v111 \/ ~v425) /\ + (~v112 \/ ~v425) /\ + (~v425 \/ v109) /\ + (~v424 \/ v109) /\ + (v52 \/ ~v64) /\ + (~v52 \/ v64) /\ + (v52 \/ ~v65) /\ + (~v52 \/ v65) /\ + (~v293 \/ ~v52) /\ + (~v315 \/ ~v52) /\ + (~v295 \/ ~v52) /\ + (v288 \/ ~v293) /\ + (~v288 \/ v293) /\ + (v288 \/ ~v294) /\ + (~v288 \/ v294) /\ + (~v290 \/ ~v418) /\ + (v291 \/ ~v418) /\ + (v290 \/ ~v419) /\ + (~v291 \/ ~v419) /\ + (~v419 \/ v288) /\ + (~v418 \/ v288) /\ + (v2 \/ ~v309) /\ + (~v2 \/ v309) /\ + (v2 \/ ~v310) /\ + (~v2 \/ v310) /\ + (v58 \/ ~v185) /\ + (~v58 \/ v185) /\ + (v58 \/ ~v186) /\ + (~v58 \/ v186) /\ + (v58 \/ ~v231) /\ + (~v58 \/ v231) /\ + (v58 \/ ~v298) /\ + (~v58 \/ v298) /\ + (v58 \/ ~v308) /\ + (~v58 \/ v308) /\ + (v58 \/ ~v364) /\ + (~v58 \/ v364) /\ + (v58 \/ ~v375) /\ + (~v58 \/ v375) /\ + (v58 \/ ~v393) /\ + (~v58 \/ v393) /\ + (v49 \/ v58) /\ + (v59 \/ v58) /\ + (v54 \/ v58) /\ + (~v57 \/ ~v54) /\ + (~v209 \/ ~v57) /\ + (~v208 \/ ~v57) /\ + (v226 \/ v208) /\ + (v215 \/ v208) /\ + (v213 \/ ~v226) /\ + (~v213 \/ v226) /\ + (v213 \/ ~v227) /\ + (~v213 \/ v227) /\ + (v14 \/ v213) /\ + (~v14 \/ ~v213) /\ + (v126 \/ v125) /\ + (~v126 \/ ~v125) /\ + (~v128 \/ ~v126) /\ + (~v129 \/ ~v126) /\ + (v206 \/ v205) /\ + (v207 \/ v205) /\ + (~v352 \/ ~v56) /\ + (~v365 \/ ~v56) /\ + (~v354 \/ ~v56) /\ + (v8 \/ ~v365) /\ + (~v8 \/ v365) /\ + (v8 \/ ~v366) /\ + (~v8 \/ v366) /\ + (~v95 \/ ~v59) /\ + (~v87 \/ ~v59) /\ + (~v96 \/ ~v59) /\ + (v336 \/ v96) /\ + (v346 \/ v336) /\ + (~v406 \/ ~v346) /\ + (~v408 \/ ~v346) /\ + (~v409 \/ ~v346) /\ + (v3 \/ ~v407) /\ + (~v3 \/ v407) /\ + (v3 \/ ~v408) /\ + (~v3 \/ v408) /\ + (~v342 \/ ~v341) /\ + (~v343 \/ ~v341) /\ + (~v274 \/ ~v273) /\ + (~v275 \/ ~v273) /\ + (v78 \/ ~v265) /\ + (~v78 \/ v265) /\ + (v78 \/ ~v266) /\ + (~v78 \/ v266) /\ + (v78 \/ ~v275) /\ + (~v78 \/ v275) /\ + (v98 \/ v78) /\ + (~v98 \/ ~v78) /\ + (v277 \/ v274) /\ + (~v277 \/ ~v274) /\ + (v379 \/ v335) /\ + (v382 \/ v335) /\ + (v381 \/ v379) /\ + (~v381 \/ ~v379) /\ + (v1 \/ ~v380) /\ + (~v1 \/ v380) /\ + (v1 \/ ~v381) /\ + (~v1 \/ v381) /\ + (~v329 \/ ~v414) /\ + (v330 \/ ~v414) /\ + (v329 \/ ~v415) /\ + (~v330 \/ ~v415) /\ + (~v415 \/ v327) /\ + (~v414 \/ v327) /\ + (~v88 \/ ~v87) /\ + (~v90 \/ ~v87) /\ + (~v156 \/ ~v87) /\ + (~v92 \/ ~v87) /\ + (v16 \/ ~v156) /\ + (~v16 \/ v156) /\ + (v16 \/ ~v157) /\ + (~v16 \/ v157) /\ + (~v179 \/ ~v426) /\ + (v94 \/ ~v426) /\ + (v179 \/ ~v427) /\ + (~v94 \/ ~v427) /\ + (~v427 \/ v88) /\ + (~v426 \/ v88) /\ + (v106 \/ v95) /\ + (~v106 \/ ~v95) /\ + (~v108 \/ ~v106) /\ + (~v262 \/ ~v108) /\ + (~v255 \/ ~v108) /\ + (v257 \/ v255) /\ + (v258 \/ v255) /\ + (v251 \/ ~v256) /\ + (~v251 \/ v256) /\ + (v251 \/ ~v257) /\ + (~v251 \/ v257) /\ + (v13 \/ v251) /\ + (~v13 \/ ~v251) /\ + (v264 \/ v260) /\ + (v266 \/ v260) /\ + (v249 \/ v247) /\ + (v250 \/ v247) /\ + (~v197 \/ ~v107) /\ + (~v199 \/ ~v107) /\ + (~v200 \/ ~v107) /\ + (v36 \/ ~v198) /\ + (~v36 \/ v198) /\ + (v36 \/ ~v199) /\ + (~v36 \/ v199) /\ + (~v47 \/ ~v49) /\ + (v48 \/ v47) /\ + (~v48 \/ ~v47) /\ + (v115 \/ v48) /\ + (~v282 \/ ~v115) /\ + (~v299 \/ ~v115) /\ + (~v284 \/ ~v115) /\ + (v24 \/ ~v299) /\ + (~v24 \/ v299) /\ + (v24 \/ ~v300) /\ + (~v24 \/ v300) /\ + (~v120 \/ ~v114) /\ + (~v121 \/ ~v114) /\ + (v116 \/ v113) /\ + (~v116 \/ ~v113) /\ + (v118 \/ v116) /\ + (v119 \/ v116) /\ + (~v294 \/ ~v51) /\ + (~v309 \/ ~v51) /\ + (~v296 \/ ~v51) /\ + (v229 \/ v74) /\ + (v230 \/ v74) /\ + (v66 \/ ~v132) /\ + (~v66 \/ v132) /\ + (v66 \/ ~v133) /\ + (~v66 \/ v133) /\ + (v66 \/ ~v135) /\ + (~v66 \/ v135) /\ + (v66 \/ ~v230) /\ + (~v66 \/ v230) /\ + (v216 \/ v66) /\ + (~v216 \/ ~v66) /\ + (~v356 \/ ~v216) /\ + (v363 \/ v356) /\ + (~v363 \/ ~v356) /\ + (~v367 \/ ~v363) /\ + (v131 \/ ~v136) /\ + (~v131 \/ v136) /\ + (v131 \/ ~v137) /\ + (~v131 \/ v137) /\ + (v131 \/ ~v140) /\ + (~v131 \/ v140) /\ + (v131 \/ ~v148) /\ + (~v131 \/ v148) /\ + (v131 \/ ~v229) /\ + (~v131 \/ v229) /\ + (v302 \/ v131) /\ + (v297 \/ v131) /\ + (~v301 \/ ~v297) /\ + (v146 \/ v71) /\ + (v141 \/ v71) /\ + (v149 \/ v71) /\ + (~v142 \/ v72) /\ + (~v142 \/ v149) /\ + (~v142 \/ v146) /\ + (v146 \/ v73) /\ + (v143 \/ v73) /\ + (v149 \/ v73) /\ + (v144 \/ ~v149) /\ + (~v144 \/ v149) /\ + (v144 \/ ~v150) /\ + (~v144 \/ v150) /\ + (v152 \/ v144) /\ + (~v152 \/ ~v144) /\ + (v134 \/ ~v151) /\ + (~v134 \/ v151) /\ + (v134 \/ ~v152) /\ + (~v134 \/ v152) /\ + (~v240 \/ ~v134) /\ + (v254 \/ v240) /\ + (v97 \/ ~v224) /\ + (~v97 \/ v224) /\ + (v97 \/ ~v225) /\ + (~v97 \/ v225) /\ + (v97 \/ ~v252) /\ + (~v97 \/ v252) /\ + (v231 \/ v97) /\ + (~v231 \/ ~v97) /\ + (~v163 \/ ~v141) /\ + (~v160 \/ v142) /\ + (~v160 \/ v153) /\ + (~v154 \/ ~v163) /\ + (~v160 \/ ~v163) /\ + (~v163 \/ ~v143) /\ + (v99 \/ ~v162) /\ + (~v99 \/ v162) /\ + (v99 \/ ~v163) /\ + (~v99 \/ v163) /\ + (~v100 \/ ~v99) /\ + (v183 \/ v100) /\ + (~v183 \/ ~v100) /\ + (~v192 \/ ~v183) /\ + (~v158 \/ ~v153) /\ + (~v174 \/ v160) /\ + (~v174 \/ v169) /\ + (~v318 \/ v166) /\ + (~v167 \/ v317) /\ + (v130 \/ ~v145) /\ + (~v130 \/ v145) /\ + (v130 \/ ~v146) /\ + (~v130 \/ v146) /\ + (v228 \/ v130) /\ + (v217 \/ v130) /\ + (v70 \/ ~v76) /\ + (~v70 \/ v76) /\ + (v70 \/ ~v77) /\ + (~v70 \/ v77) /\ + (~v339 \/ ~v70) /\ + (v340 \/ v339) /\ + (~v340 \/ ~v339) /\ + (~v397 \/ ~v340) /\ + (~v384 \/ ~v79) /\ + (~v387 \/ ~v79) /\ + (v374 \/ v384) /\ + (~v374 \/ ~v384) /\ + (~v432 \/ v435) /\ + (~v435 \/ v432) /\ + (v433 \/ v39 \/ ~v37) /\ + (v434 \/ ~v39 \/ v37) /\ + (~v432 \/ v434 \/ v433) /\ + (v37 \/ v79 \/ v67) /\ + (~v38 \/ v37 \/ v39) /\ + (~v38 \/ ~v37 \/ ~v39) /\ + (v39 \/ v79 \/ v69) /\ + (~v68 \/ v67 \/ v69) /\ + (~v68 \/ ~v67 \/ ~v69) /\ + (~v310 \/ ~v308 \/ ~v75) /\ + (~v371 \/ ~v313 \/ ~v312) /\ + (~v316 \/ ~v314 \/ ~v312) /\ + (v314 \/ v313 \/ v312) /\ + (v316 \/ v313 \/ v312) /\ + (v314 \/ v371 \/ v312) /\ + (v316 \/ v371 \/ v312) /\ + (v422 \/ v271 \/ ~v195) /\ + (v423 \/ ~v271 \/ v195) /\ + (~v189 \/ v423 \/ v422) /\ + (v279 \/ v369 \/ v370) /\ + (v43 \/ v110 \/ v46) /\ + (v41 \/ v219 \/ v211) /\ + (v44 \/ v358 \/ v355) /\ + (v194 \/ v202 \/ v203) /\ + (v391 \/ v400 \/ v401) /\ + (v322 \/ v389 \/ v390) /\ + (v83 \/ v320 \/ v321) /\ + (v237 \/ v242 \/ v239) /\ + (v287 \/ v372 \/ v373) /\ + (v410 \/ v403 \/ ~v404) /\ + (v411 \/ ~v403 \/ v404) /\ + (~v394 \/ v411 \/ v410) /\ + (v416 \/ v325 \/ ~v323) /\ + (v417 \/ ~v325 \/ v323) /\ + (~v234 \/ v417 \/ v416) /\ + (v428 \/ v333 \/ ~v84) /\ + (v429 \/ ~v333 \/ v84) /\ + (~v82 \/ v429 \/ v428) /\ + (v420 \/ v269 \/ ~v259) /\ + (v421 \/ ~v269 \/ v259) /\ + (~v236 \/ v421 \/ v420) /\ + (v430 \/ v45 \/ ~v80) /\ + (v431 \/ ~v45 \/ v80) /\ + (~v40 \/ v431 \/ v430) /\ + (v412 \/ v348 \/ ~v349) /\ + (v413 \/ ~v348 \/ v349) /\ + (~v280 \/ v413 \/ v412) /\ + (v424 \/ v111 \/ ~v112) /\ + (v425 \/ ~v111 \/ v112) /\ + (~v109 \/ v425 \/ v424) /\ + (v418 \/ v290 \/ ~v291) /\ + (v419 \/ ~v290 \/ v291) /\ + (~v288 \/ v419 \/ v418) /\ + (~v56 \/ ~v55 \/ ~v54) /\ + (v57 \/ v55 \/ v54) /\ + (v57 \/ v56 \/ v54) /\ + (~v125 \/ ~v205 \/ ~v57) /\ + (~v208 \/ ~v226 \/ ~v215) /\ + (v126 \/ v128 \/ v129) /\ + (~v205 \/ ~v206 \/ ~v207) /\ + (v124 \/ v123 \/ v55) /\ + (~v124 \/ ~v123 \/ v55) /\ + (~v124 \/ v123 \/ ~v55) /\ + (v124 \/ ~v123 \/ ~v55) /\ + (~v336 \/ ~v327 \/ ~v96) /\ + (~v336 \/ ~v338 \/ ~v96) /\ + (~v336 \/ ~v335 \/ ~v96) /\ + (v341 \/ v273 \/ v336) /\ + (~v346 \/ ~v273 \/ ~v336) /\ + (~v346 \/ ~v341 \/ ~v336) /\ + (v341 \/ v342 \/ v343) /\ + (v273 \/ v274 \/ v275) /\ + (~v335 \/ ~v379 \/ ~v382) /\ + (v414 \/ v329 \/ ~v330) /\ + (v415 \/ ~v329 \/ v330) /\ + (~v327 \/ v415 \/ v414) /\ + (v426 \/ v179 \/ ~v94) /\ + (v427 \/ ~v179 \/ v94) /\ + (~v88 \/ v427 \/ v426) /\ + (~v107 \/ ~v103 \/ ~v106) /\ + (v108 \/ v103 \/ v106) /\ + (v108 \/ v107 \/ v106) /\ + (~v260 \/ ~v247 \/ ~v108) /\ + (~v255 \/ ~v257 \/ ~v258) /\ + (~v260 \/ ~v264 \/ ~v266) /\ + (~v247 \/ ~v249 \/ ~v250) /\ + (v105 \/ v187 \/ v103) /\ + (~v105 \/ ~v187 \/ v103) /\ + (~v105 \/ v187 \/ ~v103) /\ + (v105 \/ ~v187 \/ ~v103) /\ + (~v51 \/ ~v50 \/ ~v49) /\ + (v47 \/ v50 \/ v49) /\ + (v47 \/ v51 \/ v49) /\ + (v114 \/ v113 \/ v48) /\ + (~v115 \/ ~v113 \/ ~v48) /\ + (~v115 \/ ~v114 \/ ~v48) /\ + (v114 \/ v120 \/ v121) /\ + (~v116 \/ ~v118 \/ ~v119) /\ + (v93 \/ v64 \/ v50) /\ + (~v93 \/ ~v64 \/ v50) /\ + (~v93 \/ v64 \/ ~v50) /\ + (v93 \/ ~v64 \/ ~v50) /\ + (~v74 \/ ~v229 \/ ~v230) /\ + (~v359 \/ ~v357 \/ ~v216) /\ + (~v362 \/ ~v360 \/ ~v216) /\ + (~v366 \/ ~v364 \/ ~v363) /\ + (v367 \/ v364 \/ v363) /\ + (v367 \/ v366 \/ v363) /\ + (~v131 \/ ~v302 \/ ~v297) /\ + (~v300 \/ ~v298 \/ ~v297) /\ + (v301 \/ v298 \/ v297) /\ + (v301 \/ v300 \/ v297) /\ + (~v368 \/ ~v303 \/ ~v302) /\ + (~v306 \/ ~v304 \/ ~v302) /\ + (v304 \/ v303 \/ v302) /\ + (v306 \/ v303 \/ v302) /\ + (v304 \/ v368 \/ v302) /\ + (v306 \/ v368 \/ v302) /\ + (~v72 \/ v71 \/ v73) /\ + (~v72 \/ ~v71 \/ ~v73) /\ + (~v243 \/ ~v241 \/ ~v134) /\ + (~v246 \/ ~v244 \/ ~v134) /\ + (v256 \/ v252 \/ v240) /\ + (~v254 \/ ~v252 \/ ~v240) /\ + (~v254 \/ ~v256 \/ ~v240) /\ + (~v153 \/ ~v159 \/ ~v141) /\ + (v163 \/ v159 \/ v141) /\ + (v163 \/ v153 \/ v141) /\ + (~v154 \/ ~v155 \/ v161) /\ + (~v154 \/ ~v153 \/ v159) /\ + (~v154 \/ v159 \/ v161) /\ + (~v142 \/ v141 \/ v143) /\ + (~v142 \/ ~v141 \/ ~v143) /\ + (~v153 \/ ~v161 \/ ~v143) /\ + (v163 \/ v161 \/ v143) /\ + (v163 \/ v153 \/ v143) /\ + (~v201 \/ ~v101 \/ ~v99) /\ + (~v190 \/ ~v102 \/ ~v99) /\ + (~v198 \/ ~v186 \/ ~v183) /\ + (v192 \/ v186 \/ v183) /\ + (v192 \/ v198 \/ v183) /\ + (~v157 \/ ~v185 \/ ~v153) /\ + (v158 \/ v185 \/ v153) /\ + (v158 \/ v157 \/ v153) /\ + (~v317 \/ ~v166 \/ ~v159) /\ + (~v173 \/ ~v169 \/ ~v159) /\ + (v169 \/ v166 \/ v159) /\ + (v173 \/ v166 \/ v159) /\ + (v169 \/ v317 \/ v159) /\ + (v173 \/ v317 \/ v159) /\ + (~v170 \/ ~v171 \/ v175) /\ + (~v170 \/ ~v169 \/ v173) /\ + (~v170 \/ v173 \/ v175) /\ + (~v174 \/ ~v317 \/ ~v166) /\ + (~v170 \/ ~v317 \/ ~v166) /\ + (~v160 \/ v159 \/ v161) /\ + (~v160 \/ ~v159 \/ ~v161) /\ + (~v317 \/ ~v166 \/ ~v161) /\ + (~v175 \/ ~v169 \/ ~v161) /\ + (v169 \/ v166 \/ v161) /\ + (v175 \/ v166 \/ v161) /\ + (v169 \/ v317 \/ v161) /\ + (v175 \/ v317 \/ v161) /\ + (v227 \/ v225 \/ v130) /\ + (~v220 \/ ~v218 \/ ~v217) /\ + (~v223 \/ ~v221 \/ ~v217) /\ + (v221 \/ v218 \/ v217) /\ + (v223 \/ v218 \/ v217) /\ + (v221 \/ v220 \/ v217) /\ + (v223 \/ v220 \/ v217) /\ + (~v399 \/ ~v344 \/ ~v70) /\ + (~v395 \/ ~v345 \/ ~v70) /\ + (~v407 \/ ~v393 \/ ~v340) /\ + (v397 \/ v393 \/ v340) /\ + (v397 \/ v407 \/ v340) /\ + (~v385 \/ ~v388 \/ ~v79) /\ + (~v375 \/ ~v380 \/ ~v374) /\ + (~v378 \/ ~v377 \/ ~v374) /\ + (v377 \/ v380 \/ v374) /\ + (v378 \/ v380 \/ v374) /\ + (v377 \/ v375 \/ v374) /\ + (v378 \/ v375 \/ v374) /\ + (v307 \/ v311 \/ v308 \/ v75) /\ + (v307 \/ v311 \/ v310 \/ v75) /\ + (v104 \/ v196 \/ v191 \/ v193) /\ + (v267 \/ v270 \/ v268 \/ v272) /\ + (~v268 \/ ~v331 \/ ~v324 \/ ~v332) /\ + (v176 \/ v180 \/ v328 \/ v276) /\ + (v178 \/ v405 \/ v396 \/ v398) /\ + (v177 \/ v337 \/ v376 \/ v386) /\ + (v85 \/ v89 \/ v172 \/ v91) /\ + (v233 \/ v261 \/ v245 \/ v238) /\ + (v63 \/ v210 \/ v222 \/ v212) /\ + (v62 \/ v283 \/ v305 \/ v285) /\ + (v61 \/ v351 \/ v361 \/ v353) /\ + (v52 \/ v293 \/ v315 \/ v295) /\ + (~v58 \/ ~v49 \/ ~v59 \/ ~v54) /\ + (v208 \/ v209 \/ v205 \/ v57) /\ + (v208 \/ v209 \/ v125 \/ v57) /\ + (v56 \/ v352 \/ v365 \/ v354) /\ + (v59 \/ v95 \/ v87 \/ v96) /\ + (v335 \/ v338 \/ v327 \/ v96) /\ + (v346 \/ v406 \/ v408 \/ v409) /\ + (v255 \/ v262 \/ v247 \/ v108) /\ + (v255 \/ v262 \/ v260 \/ v108) /\ + (v107 \/ v197 \/ v199 \/ v200) /\ + (v115 \/ v282 \/ v299 \/ v284) /\ + (v51 \/ v294 \/ v309 \/ v296) /\ + (v356 \/ v360 \/ v357 \/ v216) /\ + (v356 \/ v362 \/ v357 \/ v216) /\ + (v356 \/ v360 \/ v359 \/ v216) /\ + (v356 \/ v362 \/ v359 \/ v216) /\ + (~v71 \/ ~v146 \/ ~v141 \/ ~v149) /\ + (~v73 \/ ~v146 \/ ~v143 \/ ~v149) /\ + (v240 \/ v244 \/ v241 \/ v134) /\ + (v240 \/ v246 \/ v241 \/ v134) /\ + (v240 \/ v244 \/ v243 \/ v134) /\ + (v240 \/ v246 \/ v243 \/ v134) /\ + (~v164 \/ ~v153 \/ ~v165 \/ ~v159) /\ + (~v164 \/ ~v153 \/ ~v163 \/ ~v161) /\ + (~v164 \/ ~v153 \/ ~v159 \/ ~v161) /\ + (v100 \/ v102 \/ v101 \/ v99) /\ + (v100 \/ v190 \/ v101 \/ v99) /\ + (v100 \/ v102 \/ v201 \/ v99) /\ + (v100 \/ v190 \/ v201 \/ v99) /\ + (~v318 \/ ~v169 \/ ~v319 \/ ~v173) /\ + (~v318 \/ ~v169 \/ ~v317 \/ ~v175) /\ + (~v318 \/ ~v169 \/ ~v173 \/ ~v175) /\ + (~v167 \/ ~v169 \/ ~v168 \/ ~v173) /\ + (~v167 \/ ~v169 \/ ~v166 \/ ~v175) /\ + (~v167 \/ ~v169 \/ ~v173 \/ ~v175) /\ + (~v217 \/ ~v228 \/ ~v225 \/ ~v130) /\ + (~v217 \/ ~v228 \/ ~v227 \/ ~v130) /\ + (v339 \/ v345 \/ v344 \/ v70) /\ + (v339 \/ v395 \/ v344 \/ v70) /\ + (v339 \/ v345 \/ v399 \/ v70) /\ + (v339 \/ v395 \/ v399 \/ v70) /\ + (v387 \/ v384 \/ v388 \/ v79) /\ + (v387 \/ v384 \/ v385 \/ v79) /\ + (v67 \/ v76 \/ v71 \/ v74 \/ v138) /\ + (v69 \/ v76 \/ v73 \/ v74 \/ v138) /\ + (~v53 \/ ~v60 \/ ~v263 \/ ~v176 \/ ~v182) /\ + (~v42 \/ ~v286 \/ ~v267 \/ ~v43 \/ ~v278) /\ + (v60 \/ v65 \/ v122 \/ v117 \/ v127) /\ + (v87 \/ v88 \/ v90 \/ v156 \/ v92))`;; + +let all_taut = [ + (syn323_1, "syn323_1" ); + (syn029_1, "syn029_1" ); + (syn052_1 , "syn052_1" ); + (syn051_1 , "syn051_1" ); + (syn044_1 , "syn044_1" ); + (syn011_1 , "syn011_1" ); + (syn032_1 , "syn032_1" ); + (ex2_be , "ex2_be" ); + (syn030_1 , "syn030_1" ); + (transp_be , "transp_be" ); + (syn054_1 , "syn054_1" ); + (gra001_1 , "gra001_1" ); + (syn321_1 , "syn321_1" ); + (rip02_be , "rip02_be" ); + (puz014_1 , "puz014_1" ); + (mjcg_yes , "mjcg_yes" ); + (mul03_be , "mul03_be" ); + (puz030_2 , "puz030_2" ); + (puz030_1 , "puz030_1" ); + (dk27_be , "dk27_be" ); + (syn071_1 , "syn071_1" ); + (aim_50_1_6_no_3 , "aim_50_1_6_no_3" ); + (aim_50_1_6_no_4 , "aim_50_1_6_no_4" ); + (hostint1_be , "hostint1_be" ); + (aim_50_2_0_no_4 , "aim_50_2_0_no_4" ); + (aim_50_2_0_no_1 , "aim_50_2_0_no_1" ); + (aim_50_2_0_no_2 , "aim_50_2_0_no_2" ); + (aim_50_2_0_no_3 , "aim_50_2_0_no_3" ); + (mul_be , "mul_be" ); + (dk17_be , "dk17_be" ); + (risc_be , "risc_be" ); + (msc006_1 , "msc006_1" ); + (syn072_1 , "syn072_1" ); + (aim_100_2_0_no_1 , "aim_100_2_0_no_1" ); + (aim_100_2_0_no_2 , "aim_100_2_0_no_2" ); + (prv001_1 , "prv001_1" ); + (ssa0432_003 , "ssa0432_003" ); + (jnh211 , "jnh211" ); + (rip04_be , "rip04_be" ); + (ztwaalf2_be , "ztwaalf2_be" ); + (ztwaalf1_be , "ztwaalf1_be" ); + (z4_be , "z4_be" ); + (rip06_be , "rip06_be" ); + (add1_be , "add1_be" ); + (rip08_be , "rip08_be" ); + (aim_50_1_6_no_1 , "aim_50_1_6_no_1" ); + (aim_50_1_6_no_2 , "aim_50_1_6_no_2" ); + (vg2_be , "vg2_be" ); + (misg_be , "misg_be" ); + (x1dn_be , "x1dn_be" ); + (counter_be , "counter_be" ); + (sqn_be , "sqn_be" ); + (add2_be , "add2_be" ); + (dc2_be , "dc2_be" ); + (f51m_be , "f51m_be" ); + (aim_100_1_6_no_3 , "aim_100_1_6_no_3 " ); + (dubois20 , "dubois20 " ); + (msc007_1_008, "msc007_1_008" ); + (add3_be , "add3_be" ); + (add4_be, "add4_be" ); + (u5, "u5" )];; + +let TEST_TAUT TAUTCHECKER p = + try let th = time TAUTCHECKER p in + if hyp th = [] & concl th = p + then true else failwith "Wrong theorem" + with Sat_counterexample th -> + if rand(rand(concl th)) = p then false + else failwith "Wrong counterexample";; + +map (fun (p,s) -> print_string("Attempting "^s); print_newline(); + s,TEST_TAUT SAT_PROVE p,TEST_TAUT ZSAT_PROVE p) + all_taut;; diff --git a/Mizarlight/duality.ml b/Mizarlight/duality.ml new file mode 100644 index 0000000..4dd50ed --- /dev/null +++ b/Mizarlight/duality.ml @@ -0,0 +1,240 @@ +(* ========================================================================= *) +(* Mizar Light proof of duality in projective geometry. *) +(* ========================================================================= *) + +current_prover := standard_prover;; + +(* ------------------------------------------------------------------------- *) +(* Axioms for projective geometry. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("ON",(11,"right"));; + +let projective = new_definition + `projective((ON):Point->Line->bool) <=> + (!p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l) /\ + (!l l'. ?p. p ON l /\ p ON l') /\ + (?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l)) /\ + (!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l)`;; + +(* ------------------------------------------------------------------------- *) +(* To get round extreme slowness of MESON for one situation. *) +(* ------------------------------------------------------------------------- *) + +let USE_PROJ_TAC [prth; proj_def] = + REWRITE_TAC[REWRITE_RULE[proj_def] prth];; + +(* ------------------------------------------------------------------------- *) +(* The main result, via two lemmas. *) +(* ------------------------------------------------------------------------- *) + +let LEMMA_1 = theorem + "!(ON):Point->Line->bool. projective(ON) ==> !p. ?l. p ON l" + [fix ["(ON):Point->Line->bool"]; + assume "projective(ON)" at 0; + have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" + at 1 from [0] by [projective] using USE_PROJ_TAC; + have "?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" + at 3 from [0] by [projective] using USE_PROJ_TAC; + fix ["p:Point"]; + consider ["q:Point"; "q':Point"] st "~(q = q')" from [3]; + so have "~(p = q) \/ ~(p = q')"; + so consider ["l:Line"] st "p ON l" from [1]; + take ["l"]; + qed];; + +let LEMMA_2 = theorem + "!(ON):Point->Line->bool. projective(ON) + ==> !p1 p2 q l l1 l2. + p1 ON l /\\ p2 ON l /\\ p1 ON l1 /\\ p2 ON l2 /\\ q ON l2 /\\ + ~(q ON l) /\\ ~(p1 = p2) ==> ~(l1 = l2)" + [fix ["(ON):Point->Line->bool"]; + assume "projective(ON)" at 0; + have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" + at 1 from [0] by [projective] using USE_PROJ_TAC; + fix ["p1:Point"; "p2:Point"; "q:Point"; "l:Line"; "l1:Line"; "l2:Line"]; + assume "p1 ON l" at 5; + assume "p2 ON l" at 6; + assume "p1 ON l1" at 7; + assume "p2 ON l2" at 9; + assume "q ON l2" at 10; + assume "~(q ON l)" at 11; + assume "~(p1 = p2)" at 12; + assume "l1 = l2" at 13; + so have "p1 ON l2" from [7]; + so have "l = l2" from [1;5;6;9;12]; + hence contradiction from [10;11]];; + +let PROJECTIVE_DUALITY = theorem + "!(ON):Point->Line->bool. projective(ON) ==> projective (\l p. p ON l)" + [fix ["(ON):Point->Line->bool"]; + assume "projective(ON)" at 0; + have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" + at 1 from [0] by [projective] using USE_PROJ_TAC; + have "!l l'. ?p. p ON l /\\ p ON l'" + at 2 from [0] by [projective] using USE_PROJ_TAC; + have "?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" + at 3 from [0] by [projective] using USE_PROJ_TAC; + have "!l. ?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + p ON l /\\ p' ON l /\\ p'' ON l" + at 4 from [0] by [projective] using USE_PROJ_TAC; +(* dual of axiom 1 *) + have "!l1 l2. ~(l1 = l2) ==> ?!p. p ON l1 /\\ p ON l2" at 5 + proof + [fix ["l1:Line"; "l2:Line"]; + assume "~(l1 = l2)" at 6; + consider ["p:Point"] st "p ON l1 /\\ p ON l2" at 7 from [2]; + have "!p'. p' ON l1 /\\ p' ON l2 ==> (p' = p)" + proof + [fix ["p':Point"]; + assume "p' ON l1 /\\ p' ON l2" at 8; + assume "~(p' = p)"; + so have "l1 = l2" from [1;7;8]; + hence contradiction from [6]]; + qed from [7]]; +(* dual of axiom 2 *) + have "!p1 p2. ?l. p1 ON l /\\ p2 ON l" at 9 + proof + [fix ["p1:Point"; "p2:Point"]; + per cases + [[suppose "p1 = p2"; + qed from [0] by [LEMMA_1]]; + [suppose "~(p1 = p2)"; + qed from [1]]]]; +(* dual of axiom 3 *) + have "?l1 l2 l3. ~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3) /\\ + ~(?p. p ON l1 /\\ p ON l2 /\\ p ON l3)" at 10 + proof + [consider ["p1:Point"; "p2:Point"; "p3:Point"] st + "~(p1 = p2) /\\ ~(p2 = p3) /\\ ~(p1 = p3) /\\ + ~(?l. p1 ON l /\\ p2 ON l /\\ p3 ON l)" from [3] at 11; + have "~(p1 = p3)" from [11]; + so consider ["l1:Line"] st "p1 ON l1 /\\ p3 ON l1 /\\ + !l'. p1 ON l' /\\ p3 ON l' ==> (l1 = l')" from [1] at 12; + have "~(p2 = p3)" from [11]; + so consider ["l2:Line"] st "p2 ON l2 /\\ p3 ON l2 /\\ + !l'. p2 ON l' /\\ p3 ON l' ==> (l2 = l')" from [1] at 13; + have "~(p1 = p2)" from [11]; + so consider ["l3:Line"] st "p1 ON l3 /\\ p2 ON l3 /\\ + !l'. p1 ON l' /\\ p2 ON l' ==> (l3 = l')" from [1] at 14; + take ["l1"; "l2"; "l3"]; + thus "~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3)" from [11;12;13;14] at 15; + assume "?q. q ON l1 /\\ q ON l2 /\\ q ON l3"; + so consider ["q:Point"] st "q ON l1 /\\ q ON l2 /\\ q ON l3"; + so have "(p1 = q) /\\ (p2 = q) /\\ (p3 = q)" from [5;12;13;14;15]; + hence contradiction from [11]]; +(* dual of axiom 4 *) + have "!p0. ?l0 L1 L2. ~(l0 = L1) /\\ ~(L1 = L2) /\\ ~(l0 = L2) /\\ + p0 ON l0 /\\ p0 ON L1 /\\ p0 ON L2" + proof + [fix ["p0:Point"]; + consider ["l0:Line"] st "p0 ON l0" from [0] by [LEMMA_1] at 16; + consider ["p:Point"] st "~(p = p0) /\\ p ON l0" from [4] at 17; + consider ["q:Point"] st "~(q ON l0)" from [3] at 18; + so consider ["l1:Line"] st "p ON l1 /\\ q ON l1" from [1;16] at 19; + consider ["r:Point"] st "r ON l1 /\\ ~(r = p) /\\ ~(r = q)" at 20 + proof + [consider ["r1:Point"; "r2:Point"; "r3:Point"] st + "~(r1 = r2) /\\ ~(r2 = r3) /\\ ~(r1 = r3) /\\ + r1 ON l1 /\\ r2 ON l1 /\\ r3 ON l1" from [4] at 21; + so have "~(r1 = p) /\\ ~(r1 = q) \/ + ~(r2 = p) /\\ ~(r2 = q) \/ + ~(r3 = p) /\\ ~(r3 = q)"; + qed from [21]]; + have "~(p0 ON l1)" at 22 + proof + [assume "p0 ON l1"; + so have "l1 = l0" from [1;16;17;19]; + qed from [18;19]]; + so have "~(p0 = r)" from [20]; + so consider ["L1:Line"] st "r ON L1 /\\ p0 ON L1" from [1] at 23; + consider ["L2:Line"] st "q ON L2 /\\ p0 ON L2" from [1;16;18] at 24; + take ["l0"; "L1"; "L2"]; + thus "~(l0 = L1)" from [0;17;19;20;22;23] by [LEMMA_2]; + thus "~(L1 = L2)" from [0;19;20;22;23;24] by [LEMMA_2]; + thus "~(l0 = L2)" from [18;24]; + thus "p0 ON l0 /\\ p0 ON L2 /\\ p0 ON L1" from [16;24;23]]; + qed from [5;9;10] by [projective]];; + +current_prover := sketch_prover;; + +let PROJECTIVE_DUALITY = theorem + "!(ON):Point->Line->bool. projective(ON) = projective (\l p. p ON l)" + [have "!(ON):Point->Line->bool. projective(ON) ==> projective (\l p. p ON l)" + proof + [fix ["(ON):Point->Line->bool"]; + assume "projective(ON)"; + have "!p p'. ~(p = p') ==> ?!l. p ON l /\\ p' ON l" at 1; + have "!l l'. ?p. p ON l /\\ p ON l'" at 2; + have "?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" at 3; + have "!l. ?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + p ON l /\\ p' ON l /\\ p'' ON l" at 4; + (* dual of axiom 1 *) + have "!l1 l2. ~(l1 = l2) ==> ?!p. p ON l1 /\\ p ON l2" + proof + [fix ["l1:Line"; "l2:Line"]; + otherwise have "?p p'. ~(l1 = l2) /\\ ~(p = p') /\\ + p ON l1 /\\ p' ON l1 /\\ p ON l2 /\\ p' ON l2"; + so have "l1 = l2" from [1]; + hence contradiction]; + (* dual of axiom 2 *) + have "!p1 p2. ?l. p1 ON l /\\ p2 ON l" + proof + [fix ["p1:Point"; "p2:Point"]; + qed from [1]]; + (* dual of axiom 3 *) + have "?l1 l2 l3. ~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3) /\\ + ~(?p. p ON l1 /\\ p ON l2 /\\ p ON l3)" + proof + [consider ["p1:Point"; "p2:Point"; "p3:Point"] st + "~(p1 = p2) /\\ ~(p2 = p3) /\\ ~(p1 = p3) /\\ + ~(?l. p1 ON l /\\ p2 ON l /\\ p3 ON l)" from [3]; + consider ["l1:Line"] st "p1 ON l1 /\\ p3 ON l1 /\\ + !l'. p1 ON l' /\\ p3 ON l' ==> (l1 = l')" from [1]; + consider ["l2:Line"] st "p2 ON l2 /\\ p3 ON l2 /\\ + !l'. p2 ON l' /\\ p3 ON l' ==> (l2 = l')" from [1]; + consider ["l3:Line"] st "p1 ON l3 /\\ p2 ON l3 /\\ + !l'. p1 ON l' /\\ p2 ON l' ==> (l3 = l')" from [1]; + take ["l1"; "l2"; "l3"]; + thus "~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3)"; + assume "?q. q ON l1 /\\ q ON l2 /\\ q ON l3"; + so consider ["q:Point"] st "q ON l1 /\\ q ON l2 /\\ q ON l3"; + have "(q = p1) \/ (q = p2) \/ (q = p3)"; + so have "p1 ON l2 \/ p2 ON l1 \/ p3 ON l3"; + hence contradiction]; + (* dual of axiom 4 *) + have "!O. ?OP OQ OR. ~(OP = OQ) /\\ ~(OQ = OR) /\\ ~(OP = OR) /\\ + O ON OP /\\ O ON OQ /\\ O ON OR" + proof + [fix ["O:Point"]; + consider ["OP:Line"] st "O ON OP"; + consider ["P:Point"] st "~(P = O) /\\ P ON OP"; + have "?Q:Point. ~(Q ON OP)" + proof + [otherwise have "!Q:Point. Q ON OP"; + so have "~(?p p' p''. ~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + ~(?l. p ON l /\\ p' ON l /\\ p'' ON l))"; + hence contradiction from [3]]; + so consider ["Q:Point"] st "~(Q ON OP)"; + consider ["l:Line"] st "P ON l /\\ Q ON l" from [1]; + consider ["R:Point"] st "R ON l /\\ ~(R = P) /\\ ~(R = Q)" from [4]; + have "~(P = Q) /\\ ~(R = P) /\\ ~(R = Q)"; + consider ["OQ:Line"] st "O ON OQ /\\ Q ON OQ"; + consider ["OR:Line"] st "O ON OR /\\ R ON OR"; + take ["OP"; "OQ"; "OR"]; + thus "~(OP = OQ)" + proof + [otherwise have "OP = OQ"; + hence contradiction]; + thus "~(OQ = OR)"; + thus "~(OP = OR)"; + thus "O ON OP /\\ O ON OQ /\\ O ON OR"]; + qed]; + have "!(ON):Point->Line->bool. projective (\l p. p ON l) ==> projective(ON)"; + qed];; + diff --git a/Mizarlight/duality_holby.ml b/Mizarlight/duality_holby.ml new file mode 100644 index 0000000..4f25888 --- /dev/null +++ b/Mizarlight/duality_holby.ml @@ -0,0 +1,270 @@ +(* ========================================================================= *) +(* Mizar Light proof of duality in projective geometry. *) +(* ========================================================================= *) + +let holby_prover = + fun ths (asl,w as gl) -> ACCEPT_TAC(HOL_BY ths w) gl;; + +current_prover := holby_prover;; + +(* ------------------------------------------------------------------------- *) +(* To avoid adding any axioms, pick a simple model: the Fano plane. *) +(* ------------------------------------------------------------------------- *) + +let Line_INDUCT,Line_RECURSION = define_type + "Line = Line_1 | Line_2 | Line_3 | Line_4 | + Line_5 | Line_6 | Line_7";; + +let Point_INDUCT,Point_RECURSION = define_type + "Point = Point_1 | Point_2 | Point_3 | Point_4 | + Point_5 | Point_6 | Point_7";; + +let Point_DISTINCT = distinctness "Point";; + +let Line_DISTINCT = distinctness "Line";; + +let fano_incidence = + [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; + 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; + +let fano_point i = mk_const("Point_"^string_of_int i,[]) +and fano_line i = mk_const("Line_"^string_of_int i,[]);; + +let p = `p:Point` and l = `l:Line` ;; + +let fano_clause (i,j) = + mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; + +(* ------------------------------------------------------------------------- *) +(* Define the incidence relation "ON" from "fano_incidence" *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("ON",(11,"right"));; + +let ON = new_definition + `(p:Point) ON (l:Line) <=> + (p = Point_1 /\ l = Line_1) \/ + (p = Point_1 /\ l = Line_2) \/ + (p = Point_1 /\ l = Line_3) \/ + (p = Point_2 /\ l = Line_1) \/ + (p = Point_2 /\ l = Line_4) \/ + (p = Point_2 /\ l = Line_5) \/ + (p = Point_3 /\ l = Line_1) \/ + (p = Point_3 /\ l = Line_6) \/ + (p = Point_3 /\ l = Line_7) \/ + (p = Point_4 /\ l = Line_2) \/ + (p = Point_4 /\ l = Line_4) \/ + (p = Point_4 /\ l = Line_6) \/ + (p = Point_5 /\ l = Line_2) \/ + (p = Point_5 /\ l = Line_5) \/ + (p = Point_5 /\ l = Line_7) \/ + (p = Point_6 /\ l = Line_3) \/ + (p = Point_6 /\ l = Line_4) \/ + (p = Point_6 /\ l = Line_7) \/ + (p = Point_7 /\ l = Line_3) \/ + (p = Point_7 /\ l = Line_5) \/ + (p = Point_7 /\ l = Line_6)`;; + +(* ------------------------------------------------------------------------- *) +(* Also produce a more convenient case-by-case rewrite. *) +(* ------------------------------------------------------------------------- *) + +let ON_CLAUSES = prove + (`(Point_1 ON Line_1 <=> T) /\ + (Point_1 ON Line_2 <=> T) /\ + (Point_1 ON Line_3 <=> T) /\ + (Point_1 ON Line_4 <=> F) /\ + (Point_1 ON Line_5 <=> F) /\ + (Point_1 ON Line_6 <=> F) /\ + (Point_1 ON Line_7 <=> F) /\ + (Point_2 ON Line_1 <=> T) /\ + (Point_2 ON Line_2 <=> F) /\ + (Point_2 ON Line_3 <=> F) /\ + (Point_2 ON Line_4 <=> T) /\ + (Point_2 ON Line_5 <=> T) /\ + (Point_2 ON Line_6 <=> F) /\ + (Point_2 ON Line_7 <=> F) /\ + (Point_3 ON Line_1 <=> T) /\ + (Point_3 ON Line_2 <=> F) /\ + (Point_3 ON Line_3 <=> F) /\ + (Point_3 ON Line_4 <=> F) /\ + (Point_3 ON Line_5 <=> F) /\ + (Point_3 ON Line_6 <=> T) /\ + (Point_3 ON Line_7 <=> T) /\ + (Point_4 ON Line_1 <=> F) /\ + (Point_4 ON Line_2 <=> T) /\ + (Point_4 ON Line_3 <=> F) /\ + (Point_4 ON Line_4 <=> T) /\ + (Point_4 ON Line_5 <=> F) /\ + (Point_4 ON Line_6 <=> T) /\ + (Point_4 ON Line_7 <=> F) /\ + (Point_5 ON Line_1 <=> F) /\ + (Point_5 ON Line_2 <=> T) /\ + (Point_5 ON Line_3 <=> F) /\ + (Point_5 ON Line_4 <=> F) /\ + (Point_5 ON Line_5 <=> T) /\ + (Point_5 ON Line_6 <=> F) /\ + (Point_5 ON Line_7 <=> T) /\ + (Point_6 ON Line_1 <=> F) /\ + (Point_6 ON Line_2 <=> F) /\ + (Point_6 ON Line_3 <=> T) /\ + (Point_6 ON Line_4 <=> T) /\ + (Point_6 ON Line_5 <=> F) /\ + (Point_6 ON Line_6 <=> F) /\ + (Point_6 ON Line_7 <=> T) /\ + (Point_7 ON Line_1 <=> F) /\ + (Point_7 ON Line_2 <=> F) /\ + (Point_7 ON Line_3 <=> T) /\ + (Point_7 ON Line_4 <=> F) /\ + (Point_7 ON Line_5 <=> T) /\ + (Point_7 ON Line_6 <=> T) /\ + (Point_7 ON Line_7 <=> F)`, + REWRITE_TAC[ON; Line_DISTINCT; Point_DISTINCT]);; + +(* ------------------------------------------------------------------------- *) +(* Case analysis theorems. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_POINT = prove + (`(!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ + P Point_5 /\ P Point_6 /\ P Point_7`, + EQ_TAC THEN REWRITE_TAC[Point_INDUCT] THEN SIMP_TAC[]);; + +let EXISTS_POINT = prove + (`(?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ + P Point_5 \/ P Point_6 \/ P Point_7`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_POINT]);; + +let FORALL_LINE = prove + (`(!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ + P Line_5 /\ P Line_6 /\ P Line_7`, + EQ_TAC THEN REWRITE_TAC[Line_INDUCT] THEN SIMP_TAC[]);; + +let EXISTS_LINE = prove + (`(?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ + P Line_5 \/ P Line_6 \/ P Line_7`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_LINE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence prove the axioms by a naive case split (a bit slow but easy). *) +(* ------------------------------------------------------------------------- *) + +let FANO_TAC = + GEN_REWRITE_TAC DEPTH_CONV + [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN + GEN_REWRITE_TAC DEPTH_CONV + (basic_rewrites() @ [ON_CLAUSES; Point_DISTINCT; Line_DISTINCT]);; + +let AXIOM_1 = time prove + (`!p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ + !l'. p ON l' /\ p' ON l' ==> (l' = l)`, + FANO_TAC);; + +let AXIOM_2 = time prove + (`!l l'. ?p. p ON l /\ p ON l'`, + FANO_TAC);; + +let AXIOM_3 = time prove + (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l)`, + FANO_TAC);; + +let AXIOM_4 = time prove + (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l`, + FANO_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Now the interesting bit. *) +(* ------------------------------------------------------------------------- *) + +let AXIOM_1' = theorem + "!p p' l l'. ~(p = p') /\\ p ON l /\\ p' ON l /\\ p ON l' /\\ p' ON l' + ==> (l' = l)" + [fix ["p:Point"; "p':Point"; "l:Line"; "l':Line"]; + assume "~(p = p') /\\ p ON l /\\ p' ON l /\\ p ON l' /\\ p' ON l'" at 1; + consider ["l1:Line"] st "p ON l1 /\\ p' ON l1 /\\ + !l'. p ON l' /\\ p' ON l' ==> (l' = l1)" from [1] by [AXIOM_1] at 2; + have "l = l1" from [1;2]; + so have "... = l'" from [1;2]; + qed];; + +let LEMMA_1 = theorem + "!O. ?l. O ON l" + [consider ["p:Point"; "p':Point"; "p'':Point"] st + "~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + ~(?l. p ON l /\\ p' ON l /\\ p'' ON l)" by [AXIOM_3] at 1; + fix ["O:Point"]; + have "~(p = O) \/ ~(p' = O)" from [1]; + so consider ["P:Point"] st "~(P = O)" at 2; + consider ["l:Line"] st "O ON l /\\ P ON l /\\ + !l'. O ON l' /\\ P ON l' ==> (l' = l)" from [2] by [AXIOM_1] at 3; + thus "?l. O ON l" from [3]];; + +let DUAL_1 = theorem + "!l l'. ~(l = l') ==> ?p. p ON l /\\ p ON l' /\\ + !p'. p' ON l /\\ p' ON l' ==> (p' = p)" + [otherwise consider ["l:Line"; "l':Line"] st + "~(l = l') /\\ !p. p ON l /\\ p ON l' + ==> ?p'. p' ON l /\\ p' ON l' /\\ ~(p' = p)" at 1; + consider ["p:Point"] st "p ON l /\\ p ON l'" by [AXIOM_2] at 2; + consider ["p':Point"] st "p' ON l /\\ p' ON l' /\\ ~(p' = p)" from [1;2] at 3; + hence contradiction from [1;2] by [AXIOM_1']];; + +let DUAL_2 = theorem + "!p p'. ?l. p ON l /\\ p' ON l" + [fix ["p:Point"; "p':Point"]; + have "?l. p ON l" by [LEMMA_1] at 1; + have "(p = p') \/ + ?l. p ON l /\\ p' ON l /\\ + !l'. p ON l' /\\ p' ON l' ==> (l' = l)" by [AXIOM_1]; + hence thesis from [1]];; + +let DUAL_3 = theorem + "?l1 l2 l3. ~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3) /\\ + ~(?p. p ON l1 /\\ p ON l2 /\\ p ON l3)" + [consider ["p1:Point"; "p2:Point"; "p3:Point"] st + "~(p1 = p2) /\\ ~(p2 = p3) /\\ ~(p1 = p3) /\\ + ~(?l. p1 ON l /\\ p2 ON l /\\ p3 ON l)" by [AXIOM_3] at 1; + consider ["l1:Line"] st "p1 ON l1 /\\ p3 ON l1" by [DUAL_2] at 2; + consider ["l2:Line"] st "p2 ON l2 /\\ p3 ON l2" by [DUAL_2] at 3; + consider ["l3:Line"] st "p1 ON l3 /\\ p2 ON l3" by [DUAL_2] at 4; + take ["l1"; "l2"; "l3"]; + thus "~(l1 = l2) /\\ ~(l2 = l3) /\\ ~(l1 = l3)" from [1;2;3;4] at 5; + otherwise consider ["q:Point"] st "q ON l1 /\\ q ON l2 /\\ q ON l3" at 6; + consider ["q':Point"] st "q' ON l1 /\\ q' ON l3 /\\ + !p'. p' ON l1 /\\ p' ON l3 ==> (p' = q')" from [5] by [DUAL_1] at 7; + have "q = q'" from [6;7]; + so have "... = p1" from [2;4;7]; + hence contradiction from [1;3;6]];; + +let DUAL_4 = theorem + "!O. ?OP OQ OR. ~(OP = OQ) /\\ ~(OQ = OR) /\\ ~(OP = OR) /\\ + O ON OP /\\ O ON OQ /\\ O ON OR" + [fix ["O:Point"]; + consider ["OP:Line"] st "O ON OP" by [LEMMA_1] at 1; + consider ["p:Point"; "p':Point"; "p'':Point"] st + "~(p = p') /\\ ~(p' = p'') /\\ ~(p = p'') /\\ + p ON OP /\\ p' ON OP /\\ p'' ON OP" by [AXIOM_4] at 2; + have "~(p = O) \/ ~(p' = O)" from [2]; + so consider ["P:Point"] st "~(P = O) /\\ P ON OP" from [2] at 3; + consider ["q:Point"; "q':Point"; "q'':Point"] st + "~(q = q') /\\ ~(q' = q'') /\\ ~(q = q'') /\\ + ~(?l. q ON l /\\ q' ON l /\\ q'' ON l)" by [AXIOM_3] at 4; + have "~(q ON OP) \/ ~(q' ON OP) \/ ~(q'' ON OP)" from [4]; + so consider ["Q:Point"] st "~(Q ON OP)" at 5; + consider ["l:Line"] st "P ON l /\\ Q ON l" by [DUAL_2] at 6; + consider ["r:Point"; "r':Point"; "r'':Point"] st + "~(r = r') /\\ ~(r' = r'') /\\ ~(r = r'') /\\ + r ON l /\\ r' ON l /\\ r'' ON l" by [AXIOM_4] at 7; + have "((r = P) \/ (r = Q) \/ ~(r = P) /\\ ~(r = Q)) /\\ + ((r' = P) \/ (r' = Q) \/ ~(r' = P) /\\ ~(r' = Q))"; + so consider ["R:Point"] st "R ON l /\\ ~(R = P) /\\ ~(R = Q)" from [7] at 8; + consider ["OQ:Line"] st "O ON OQ /\\ Q ON OQ" by [DUAL_2] at 9; + consider ["OR:Line"] st "O ON OR /\\ R ON OR" by [DUAL_2] at 10; + take ["OP"; "OQ"; "OR"]; + have "~(O ON l)" from [1;3;5;6] by [AXIOM_1']; + hence "~(OP = OQ) /\\ ~(OQ = OR) /\\ ~(OP = OR) /\\ + O ON OP /\\ O ON OQ /\\ O ON OR" from [1;3;5;6;8;9;10] by [AXIOM_1']];; diff --git a/Mizarlight/make.ml b/Mizarlight/make.ml new file mode 100644 index 0000000..b904ae0 --- /dev/null +++ b/Mizarlight/make.ml @@ -0,0 +1,52 @@ +(* ========================================================================= *) +(* "Mizar Light" by Freek Wiedijk. *) +(* *) +(* http://www.cs.ru.nl/~freek/mizar/miz.pdf *) +(* ========================================================================= *) + +exception Innergoal of goal;; + +let (GOAL_TAC:tactic) = fun gl -> raise(Innergoal gl);; + +let e tac = + try refine(by(VALID tac)) + with Innergoal gl -> + let oldgoalstack = !current_goalstack in + current_goalstack := (mk_goalstate gl)::oldgoalstack; + !current_goalstack;; + +(* ------------------------------------------------------------------------- *) +(* Set up more infix operators. *) +(* ------------------------------------------------------------------------- *) + +Topdirs.dir_directory (!hol_dir);; + +Topdirs.load_file Format.std_formatter + (Filename.concat (!hol_dir) "Mizarlight/pa_f.cmo");; + +List.iter (fun s -> Hashtbl.add (Pa_j.ht) s true) + ["st'";"st";"at";"from";"by";"using";"proof"; "THEN'"];; + +(* ------------------------------------------------------------------------- *) +(* Mizar Light. *) +(* ------------------------------------------------------------------------- *) + +loadt "Mizarlight/miz2a.ml";; + +(* ------------------------------------------------------------------------- *) +(* Projective duality proof in Mizar Light. *) +(* ------------------------------------------------------------------------- *) + +loadt "Mizarlight/duality.ml";; + +(* ------------------------------------------------------------------------- *) +(* A prover more closely approximating Mizar's own. *) +(* ------------------------------------------------------------------------- *) + +loadt "Examples/holby.ml";; + +(* ------------------------------------------------------------------------- *) +(* A version of the duality proof based on that. *) +(* ------------------------------------------------------------------------- *) + +loadt "Mizarlight/duality_holby.ml";; diff --git a/Mizarlight/miz2a.ml b/Mizarlight/miz2a.ml new file mode 100644 index 0000000..2739e03 --- /dev/null +++ b/Mizarlight/miz2a.ml @@ -0,0 +1,245 @@ +(* ========================================================================= *) +(* Mizar Light II *) +(* *) +(* Freek Wiedijk, University of Nijmegen *) +(* ========================================================================= *) + +type mterm = string;; + +let parse_context_term s env = + let ptm,l = (parse_preterm o lex o explode) s in + if l = [] then + (term_of_preterm o retypecheck + (map ((fun (s,ty) -> s,pretype_of_type ty) o dest_var) env)) ptm + else failwith "Unexpected junk after term";; + +let goal_frees (asl,w as g) = + frees (itlist (curry mk_imp) (map (concl o snd) asl) w);; + +let (parse_mterm: mterm -> goal -> term) = + let ttm = mk_var("thesis",bool_ty) in + let atm = mk_var("antecedent",bool_ty) in + let otm = mk_var("opposite",bool_ty) in + fun s (asl,w as g) -> + let ant = try fst (dest_imp w) with Failure _ -> atm in + let opp = try dest_neg w with Failure _ -> mk_neg w in + let t = + (subst [w,ttm; ant,atm; opp,otm] + (parse_context_term s ((goal_frees g) @ [ttm; atm; otm]))) in + try + let lhs = lhand (concl (snd (hd asl))) in + let itm = mk_var("...",type_of lhs) in + subst [lhs,itm] t + with Failure _ -> t;; + +type stepinfo = + (goal -> term) option * int option * + (goal -> thm list) * (thm list -> tactic);; + +type step = (stepinfo -> tactic) * stepinfo;; + +let TRY' tac thl = TRY (tac thl);; + +let (then'_) = fun tac1 tac2 thl -> tac1 thl THEN tac2 thl;; + +let standard_prover = TRY' (REWRITE_TAC THEN' MESON_TAC);; +let sketch_prover = K CHEAT_TAC;; +let current_prover = ref standard_prover;; + +let (default_stepinfo: (goal -> term) option -> stepinfo) = + fun t -> t,None, + (map snd o filter ((=) "=" o fst) o fst), + (fun thl -> !current_prover thl);; + +let ((st'): step -> (goal -> term) -> step) = + fun (tac,(t,l,thl,just)) t' -> (tac,(Some t',l,thl,just));; + +let (st) = fun stp -> (st') stp o parse_mterm;; + +let (((at)): step -> int -> step) = + fun (tac,(t,l,thl,just)) l' -> (tac,(t,Some l',thl,just));; + +let (((from)): step -> int list -> step) = + fun (tac,(t,l,thl,just)) ll -> (tac,(t,l, + (fun (asl,_ as g) -> thl g @ + let n = length asl in + map + (fun l -> + if l < 0 then snd (el ((n - l - 1) mod n) asl) + else assoc (string_of_int l) asl) + ll), + just));; + +let so x = fun y -> x y from [-1];; + +let (((by)): step -> thm list -> step) = + fun (tac,(t,l,thl,just)) thl' -> (tac,(t,l,(fun g -> thl g @ thl'),just));; + +let (((using)): step -> (thm list -> tactic) -> step) = + fun (tac,(t,l,thl,just)) just' -> (tac,(t,l,thl,just' THEN' just));; + +let (step: step -> tactic) = fun (f,x) -> f x;; + +let (steps: step list -> tactic) = + fun stpl -> + itlist (fun tac1 tac2 -> tac1 THENL [tac2]) (map step stpl) ALL_TAC;; + +let (tactics: tactic list -> step) = + fun tacl -> ((K (itlist ((THEN)) tacl ALL_TAC)), + default_stepinfo None);; + +let (theorem': (goal -> term) -> step list -> thm) = + let g = ([],`T`) in + fun t stpl -> prove(t g,steps stpl);; + +let (((proof)): step -> step list -> step) = + fun (tac,(t,l,thl,just)) prf -> (tac,(t,l,thl,K (steps prf)));; + +let (N_ASSUME_TAC: int option -> thm_tactic) = + fun l th (asl,_ as g) -> + match l with + None -> ASSUME_TAC th g + | Some n -> + warn (n >= 0 && length asl <> n) "*** out of sequence label ***"; + LABEL_TAC (if n < 0 then "=" else string_of_int n) th g;; + +let (per: step -> step list list -> step) = + let F = `F` in + fun (_,(_,_,thl,just)) cases -> + (fun (_,_,thl',just') g -> + let tx (t',_,_,_) = + match t' with None -> failwith "per" | Some t -> t g in + let dj = itlist (curry mk_disj) + (map (tx o snd o hd) cases) F in + (SUBGOAL_THEN dj + (EVERY_TCL (map (fun case -> let _,l,_,_ = snd (hd case) in + (DISJ_CASES_THEN2 (N_ASSUME_TAC l))) cases) CONTR_TAC) THENL + ([(just' THEN' just) ((thl' g) @ (thl g))] @ + map (steps o tl) cases)) g), + (None,None,(K []),(K ALL_TAC));; + +let (cases: step) = + (fun _ -> failwith "cases"),default_stepinfo None;; + +let (suppose': (goal -> term) -> step) = + fun t -> (fun _ -> failwith "suppose"),default_stepinfo (Some t);; + +let (consider': (goal -> term) list -> step) = + let T = `T` in + fun tl' -> + (fun (t',l,thl,just) (asl,w as g) -> + let tl = map (fun t' -> t' g) tl' in + let g' = ((asl @ (map (fun t -> ("",REFL t)) tl)),w) in + let ex = itlist (curry mk_exists) tl + (match t' with + None -> failwith "consider" + | Some t -> t g') in + (SUBGOAL_THEN ex + ((EVERY_TCL (map X_CHOOSE_THEN tl)) (N_ASSUME_TAC l)) THENL + [just (thl g); ALL_TAC]) g), + default_stepinfo (Some + (fun g -> end_itlist (curry mk_conj) + (map (fun t' -> let t = t' g in mk_eq(t,t)) tl')));; + +let (take': (goal -> term) list -> step) = + fun tl -> + (fun _ g -> (MAP_EVERY EXISTS_TAC o map (fun t -> t g)) tl g), + default_stepinfo None;; + +let (assume': (goal -> term) -> step) = + fun t -> + (fun (t',l,thl,just) g -> + match t' with + None -> failwith "assume" + | Some t -> + (DISJ_CASES_THEN2 + (fun th -> REWRITE_TAC[th] THEN + N_ASSUME_TAC l th) + (fun th -> just ((REWRITE_RULE[] th)::(thl g))) + (SPEC (t g) EXCLUDED_MIDDLE)) g), + default_stepinfo (Some t);; + +let (have': (goal -> term) -> step) = + fun t -> + (fun (t',l,thl,just) g -> + match t' with + None -> failwith "have" + | Some t -> + (SUBGOAL_THEN (t g) (N_ASSUME_TAC l) THENL + [just (thl g); ALL_TAC]) g), + default_stepinfo (Some t);; + +let (thus': (goal -> term) -> step) = + fun t -> + (fun (t',l,thl,just) g -> + match t' with + None -> failwith "thus" + | Some t -> + (SUBGOAL_THEN (t g) ASSUME_TAC THENL + [just (thl g); + POP_ASSUM (fun th -> + N_ASSUME_TAC l th THEN + EVERY (map (fun th -> REWRITE_TAC[EQT_INTRO th]) + (CONJUNCTS th)))]) + g), + default_stepinfo (Some t);; + +let (fix': (goal -> term) list -> step) = + fun tl -> + (fun _ g -> (MAP_EVERY X_GEN_TAC o (map (fun t -> t g))) tl g), + default_stepinfo None;; + +let (set': (goal -> term) -> step) = + fun t -> + let stp = + (fun (t',l,_,_) g -> + match t' with + None -> failwith "set" + | Some t -> + let eq = t g in + let lhs,rhs = dest_eq eq in + let lv,largs = strip_comb lhs in + let rtm = list_mk_abs(largs,rhs) in + let ex = mk_exists(lv,mk_eq(lv,rtm)) in + (SUBGOAL_THEN ex (X_CHOOSE_THEN lv + (fun th -> (N_ASSUME_TAC l) (prove(eq,REWRITE_TAC[th])))) THENL + [REWRITE_TAC[EXISTS_REFL]; + ALL_TAC]) g), + default_stepinfo (Some t) in + stp at -1;; + +let theorem = theorem' o parse_mterm;; +let suppose = suppose' o parse_mterm;; +let consider = consider' o map parse_mterm;; +let take = take' o map parse_mterm;; +let assume = assume' o parse_mterm;; +let have = have' o parse_mterm;; +let thus = thus' o parse_mterm;; +let fix = fix' o map parse_mterm;; +let set = set' o parse_mterm;; + +let iff prfs = tactics [EQ_TAC THENL map steps prfs];; + +let (otherwise: ('a -> step) -> ('a -> step)) = + fun stp x -> + let tac,si = stp x in + ((fun (t,l,thl,just) g -> + REFUTE_THEN (fun th -> + tac (t,l,K ([REWRITE_RULE[] th] @ thl g),just)) g), + si);; + +let (thesis:mterm) = "thesis";; +let (antecedent:mterm) = "antecedent";; +let (opposite:mterm) = "opposite";; +let (contradiction:mterm) = "F";; + +let hence = so thus;; +let qed = hence thesis;; + +let h = g o parse_term;; +let f = e o step;; +let ff = e o steps;; +let ee = e o EVERY;; +let fp = f o (fun x -> x proof []);; + +let GOAL_HERE = tactics [GOAL_TAC];; diff --git a/Mizarlight/pa_f.ml b/Mizarlight/pa_f.ml new file mode 100644 index 0000000..9cdf072 --- /dev/null +++ b/Mizarlight/pa_f.ml @@ -0,0 +1,25 @@ +(* ------------------------------------------------------------------------- *) +(* Some additional infixes to support Freek's "Mizar Light". *) +(* ------------------------------------------------------------------------- *) + +open Pcaml; + +Pcaml.syntax_name.val := "Freek"; + +Format.print_string "New infixes set up"; +Format.print_newline(); + +EXTEND + expr: AFTER "<" + [[ f = expr; "by"; g = expr -> <:expr< ((by $f$) $g$) >> + | f = expr; "st'"; g = expr -> <:expr< ((st' $f$) $g$) >> + | f = expr; "st"; g = expr -> <:expr< ((st $f$) $g$) >> + | f = expr; "at"; g = expr -> <:expr< ((at $f$) $g$) >> + | f = expr; "from"; g = expr -> <:expr< ((from $f$) $g$) >> + | f = expr; "using"; g = expr -> <:expr< ((using $f$) $g$) >> + | f = expr; "proof"; g = expr -> <:expr< ((proof $f$) $g$) >> + | f = expr; "THEN'"; g = expr -> <:expr< ((then'_ $f$) $g$) >> + + ]]; + +END; diff --git a/Model/make.ml b/Model/make.ml new file mode 100644 index 0000000..48b9cce --- /dev/null +++ b/Model/make.ml @@ -0,0 +1,23 @@ +(* ========================================================================= *) +(* Consistency proof of "pure HOL" (no axioms or definitions) in itself. *) +(* ========================================================================= *) + +loadt "Library/card.ml";; + +(* ------------------------------------------------------------------------- *) +(* Syntactic definitions (terms, types, theorems etc.) *) +(* ------------------------------------------------------------------------- *) + +loadt "Model/syntax.ml";; + +(* ------------------------------------------------------------------------- *) +(* Set-theoretic hierarchy to support semantics. *) +(* ------------------------------------------------------------------------- *) + +loadt "Model/modelset.ml";; + +(* ------------------------------------------------------------------------- *) +(* Semantics. *) +(* ------------------------------------------------------------------------- *) + +loadt "Model/semantics.ml";; diff --git a/Model/modelset.ml b/Model/modelset.ml new file mode 100644 index 0000000..dfeac71 --- /dev/null +++ b/Model/modelset.ml @@ -0,0 +1,788 @@ +(* ========================================================================= *) +(* Set-theoretic hierarchy for modelling HOL inside itself. *) +(* ========================================================================= *) + +let INJ_LEMMA = prove + (`(!x y. (f x = f y) ==> (x = y)) <=> (!x y. (f x = f y) <=> (x = y))`, + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Useful to have a niceish "function update" notation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("|->",(12,"right"));; + +let valmod = new_definition + `(x |-> a) (v:A->B) = \y. if y = x then a else v(y)`;; + +let VALMOD = prove + (`!v x y a. ((x |-> y) v) a = if a = x then y else v(a)`, + REWRITE_TAC[valmod]);; + +let VALMOD_BASIC = prove + (`!v x y. (x |-> y) v x = y`, + REWRITE_TAC[valmod]);; + +let VALMOD_VALMOD_BASIC = prove + (`!v a b x. (x |-> a) ((x |-> b) v) = (x |-> a) v`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; + +let VALMOD_REPEAT = prove + (`!v x. (x |-> v(x)) v = v`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; + +let FORALL_VALMOD = prove + (`!x. (!v a. P((x |-> a) v)) = (!v. P v)`, + MESON_TAC[VALMOD_REPEAT]);; + +let VALMOD_SWAP = prove + (`!v x y a b. + ~(x = y) ==> ((x |-> a) ((y |-> b) v) = (y |-> b) ((x |-> a) v))`, + REWRITE_TAC[valmod; FUN_EQ_THM] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A dummy finite type inadequately modelling ":ind". *) +(* ------------------------------------------------------------------------- *) + +let ind_model_tybij_th = + prove(`?x. x IN @s:num->bool. ~(s = {}) /\ FINITE s`, + MESON_TAC[MEMBER_NOT_EMPTY; IN_SING; FINITE_RULES]);; + +let ind_model_tybij = + new_type_definition "ind_model" ("mk_ind","dest_ind") ind_model_tybij_th;; + +(* ------------------------------------------------------------------------- *) +(* Introduce a type whose universe is "inaccessible" starting from *) +(* "ind_model". Since "ind_model" is finite, we can just use any *) +(* infinite set. In order to make "ind_model" infinite, we would need *) +(* a new axiom. In order to keep things generic we try to deduce *) +(* everything from this one uniform "axiom". Note that even in the *) +(* infinite case, this can still be a small set in ZF terms, not a real *) +(* inaccessible cardinal. *) +(* ------------------------------------------------------------------------- *) + +(****** Here's what we'd do in the infinite case + + new_type("I",0);; + + let I_AXIOM = new_axiom + `UNIV:ind_model->bool <_c UNIV:I->bool /\ + (!s:A->bool. s <_c UNIV:I->bool ==> {t | t SUBSET s} <_c UNIV:I->bool)`;; + + *******) + +let inacc_tybij_th = prove + (`?x:num. x IN UNIV`,REWRITE_TAC[IN_UNIV]);; + +let inacc_tybij = + new_type_definition "I" ("mk_I","dest_I") inacc_tybij_th;; + +let I_AXIOM = prove + (`UNIV:ind_model->bool <_c UNIV:I->bool /\ + (!s:A->bool. s <_c UNIV:I->bool ==> {t | t SUBSET s} <_c UNIV:I->bool)`, + let lemma = prove + (`!s. s <_c UNIV:I->bool <=> FINITE s`, + GEN_TAC THEN REWRITE_TAC[FINITE_CARD_LT] THEN + MATCH_MP_TAC CARD_LT_CONG THEN REWRITE_TAC[CARD_EQ_REFL] THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM; le_c; IN_UNIV] THEN + MESON_TAC[inacc_tybij; IN_UNIV]) in + REWRITE_TAC[lemma; FINITE_POWERSET] THEN + SUBGOAL_THEN `UNIV = IMAGE mk_ind (@s. ~(s = {}) /\ FINITE s)` + SUBST1_TAC THENL + [MESON_TAC[EXTENSION; IN_IMAGE; IN_UNIV; ind_model_tybij]; + MESON_TAC[FINITE_IMAGE; NOT_INSERT_EMPTY; FINITE_RULES]]);; + +(* ------------------------------------------------------------------------- *) +(* I is infinite and therefore admits an injective pairing. *) +(* ------------------------------------------------------------------------- *) + +let I_INFINITE = prove + (`INFINITE(UNIV:I->bool)`, + REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN + MP_TAC(ISPEC `{n | n < CARD(UNIV:I->bool) - 1}` (CONJUNCT2 I_AXIOM)) THEN + ASM_SIMP_TAC[CARD_LT_CARD; FINITE_NUMSEG_LT; FINITE_POWERSET] THEN + SIMP_TAC[CARD_NUMSEG_LT; CARD_POWERSET; FINITE_NUMSEG_LT] THEN + SUBGOAL_THEN `~(CARD(UNIV:I->bool) = 0)` MP_TAC THENL + [ASM_SIMP_TAC[CARD_EQ_0; GSYM MEMBER_NOT_EMPTY; IN_UNIV]; ALL_TAC] THEN + SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 < n`; NOT_LT] THEN + MATCH_MP_TAC(ARITH_RULE `a - 1 < b ==> ~(a = 0) ==> a <= b`) THEN + SPEC_TAC(`CARD(UNIV:I->bool) - 1`,`n:num`) THEN POP_ASSUM(K ALL_TAC) THEN + INDUCT_TAC THEN REWRITE_TAC[EXP; ARITH] THEN POP_ASSUM MP_TAC THEN + ARITH_TAC);; + +let I_PAIR_EXISTS = prove + (`?f:I#I->I. !x y. (f x = f y) ==> (x = y)`, + SUBGOAL_THEN `UNIV:I#I->bool <=_c UNIV:I->bool` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[le_c; IN_UNIV]] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + MP_TAC(MATCH_MP CARD_SQUARE_INFINITE I_INFINITE) THEN + MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; mul_c; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[PAIR]);; + +let I_PAIR = REWRITE_RULE[INJ_LEMMA] + (new_specification ["I_PAIR"] I_PAIR_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* It also admits injections from "bool" and "ind_model". *) +(* ------------------------------------------------------------------------- *) + +let CARD_BOOL_LT_I = prove + (`UNIV:bool->bool <_c UNIV:I->bool`, + REWRITE_TAC[GSYM CARD_NOT_LE] THEN + DISCH_TAC THEN MP_TAC I_INFINITE THEN REWRITE_TAC[INFINITE] THEN + SUBGOAL_THEN `FINITE(UNIV:bool->bool)` + (fun th -> ASM_MESON_TAC[th; CARD_LE_FINITE]) THEN + SUBGOAL_THEN `UNIV:bool->bool = {F,T}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT] THEN MESON_TAC[]; + SIMP_TAC[FINITE_RULES]]);; + +let I_BOOL_EXISTS = prove + (`?f:bool->I. !x y. (f x = f y) ==> (x = y)`, + MP_TAC(MATCH_MP CARD_LT_IMP_LE CARD_BOOL_LT_I) THEN + SIMP_TAC[lt_c; le_c; IN_UNIV]);; + +let I_BOOL = REWRITE_RULE[INJ_LEMMA] + (new_specification ["I_BOOL"] I_BOOL_EXISTS);; + +let I_IND_EXISTS = prove + (`?f:ind_model->I. !x y. (f x = f y) ==> (x = y)`, + MP_TAC(CONJUNCT1 I_AXIOM) THEN SIMP_TAC[lt_c; le_c; IN_UNIV]);; + +let I_IND = REWRITE_RULE[INJ_LEMMA] + (new_specification ["I_IND"] I_IND_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* And the injection from powerset of any accessible set. *) +(* ------------------------------------------------------------------------- *) + +let I_SET_EXISTS = prove + (`!s:I->bool. + s <_c UNIV:I->bool + ==> ?f:(I->bool)->I. !t u. t SUBSET s /\ u SUBSET s /\ (f t = f u) + ==> (t = u)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP(CONJUNCT2 I_AXIOM)) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_LT_IMP_LE) THEN + REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM]);; + +let I_SET = new_specification ["I_SET"] + (REWRITE_RULE[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] I_SET_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Define a type for "levels" of our set theory. *) +(* ------------------------------------------------------------------------- *) + +let setlevel_INDUCT,setlevel_RECURSION = define_type + "setlevel = Ur_bool + | Ur_ind + | Powerset setlevel + | Cartprod setlevel setlevel";; + +let setlevel_DISTINCT = distinctness "setlevel";; +let setlevel_INJ = injectivity "setlevel";; + +(* ------------------------------------------------------------------------- *) +(* Now define a subset of I corresponding to each. *) +(* ------------------------------------------------------------------------- *) + +let setlevel = new_recursive_definition setlevel_RECURSION + `(setlevel Ur_bool = IMAGE I_BOOL UNIV) /\ + (setlevel Ur_ind = IMAGE I_IND UNIV) /\ + (setlevel (Cartprod l1 l2) = + IMAGE I_PAIR {x,y | x IN setlevel l1 /\ y IN setlevel l2}) /\ + (setlevel (Powerset l) = IMAGE (I_SET (setlevel l)) + {s | s SUBSET (setlevel l)})`;; + +(* ------------------------------------------------------------------------- *) +(* Show they all satisfy the cardinal limits. *) +(* ------------------------------------------------------------------------- *) + +let SETLEVEL_CARD = prove + (`!l. setlevel l <_c UNIV:I->bool`, + MATCH_MP_TAC setlevel_INDUCT THEN REWRITE_TAC[setlevel] THEN + REPEAT CONJ_TAC THENL + [TRANS_TAC CARD_LET_TRANS `UNIV:bool->bool` THEN + REWRITE_TAC[CARD_LE_IMAGE; CARD_BOOL_LT_I]; + TRANS_TAC CARD_LET_TRANS `UNIV:ind_model->bool` THEN + REWRITE_TAC[CARD_LE_IMAGE; I_AXIOM]; + X_GEN_TAC `l:setlevel` THEN DISCH_TAC THEN + TRANS_TAC CARD_LET_TRANS `{s | s SUBSET (setlevel l)}` THEN + ASM_SIMP_TAC[I_AXIOM; CARD_LE_IMAGE]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`l1:setlevel`; `l2:setlevel`] THEN STRIP_TAC THEN + TRANS_TAC CARD_LET_TRANS `setlevel l1 *_c setlevel l2` THEN + ASM_SIMP_TAC[CARD_MUL_LT_INFINITE; I_INFINITE; GSYM mul_c; CARD_LE_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the injectivity of the mapping from powerset. *) +(* ------------------------------------------------------------------------- *) + +let I_SET_SETLEVEL = prove + (`!l s t. s SUBSET setlevel l /\ t SUBSET setlevel l /\ + (I_SET (setlevel l) s = I_SET (setlevel l) t) + ==> (s = t)`, + MESON_TAC[SETLEVEL_CARD; I_SET]);; + +(* ------------------------------------------------------------------------- *) +(* Now our universe of sets and (ur)elements. *) +(* ------------------------------------------------------------------------- *) + +let universe = new_definition + `universe = {(t,x) | x IN setlevel t}`;; + +(* ------------------------------------------------------------------------- *) +(* Define an actual type V. *) +(* *) +(* This satisfies a suitable number of the ZF axioms. It isn't extensional *) +(* but we could then construct a quotient structure if desired. Anyway it's *) +(* only empty sets that aren't. A more significant difference is that we *) +(* have urelements and the hierarchy levels are all distinct rather than *) +(* being cumulative. *) +(* ------------------------------------------------------------------------- *) + +let v_tybij_th = prove + (`?a. a IN universe`, + EXISTS_TAC `Ur_bool,I_BOOL T` THEN + REWRITE_TAC[universe; IN_ELIM_THM; PAIR_EQ; CONJ_ASSOC; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1; + setlevel; IN_IMAGE; IN_UNIV] THEN + MESON_TAC[]);; + +let v_tybij = + new_type_definition "V" ("mk_V","dest_V") v_tybij_th;; + +let V_TYBIJ = prove + (`!l e. e IN setlevel l <=> (dest_V(mk_V(l,e)) = (l,e))`, + REWRITE_TAC[GSYM(CONJUNCT2 v_tybij)] THEN + REWRITE_TAC[IN_ELIM_THM; universe; FORALL_PAIR_THM; PAIR_EQ] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Drop a level; test if something is a set. *) +(* ------------------------------------------------------------------------- *) + +let droplevel = new_recursive_definition setlevel_RECURSION + `droplevel(Powerset l) = l`;; + +let isasetlevel = new_recursive_definition setlevel_RECURSION + `(isasetlevel Ur_bool = F) /\ + (isasetlevel Ur_ind = F) /\ + (isasetlevel (Cartprod l1 l2) = F) /\ + (isasetlevel (Powerset l) = T)`;; + +(* ------------------------------------------------------------------------- *) +(* Define some useful inversions. *) +(* ------------------------------------------------------------------------- *) + +let level = new_definition + `level x = FST(dest_V x)`;; + +let element = new_definition + `element x = SND(dest_V x)`;; + +let ELEMENT_IN_LEVEL = prove + (`!x. (element x) IN setlevel(level x)`, + REWRITE_TAC[V_TYBIJ; v_tybij; level; element; PAIR]);; + +let SET = prove + (`!x. mk_V(level x,element x) = x`, + REWRITE_TAC[level; element; PAIR; v_tybij]);; + +let set = new_definition + `set x = @s. s SUBSET (setlevel(droplevel(level x))) /\ + (I_SET (setlevel(droplevel(level x))) s = element x)`;; + +let isaset = new_definition + `isaset x <=> ?l. level x = Powerset l`;; + +(* ------------------------------------------------------------------------- *) +(* Now all the critical relations. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("<:",(11,"right"));; + +let inset = new_definition + `x <: s <=> (level s = Powerset(level x)) /\ (element x) IN (set s)`;; + +parse_as_infix("<=:",(12,"right"));; + +let subset_def = new_definition + `s <=: t <=> (level s = level t) /\ !x. x <: s ==> x <: t`;; + +(* ------------------------------------------------------------------------- *) +(* If something has members, it's a set. *) +(* ------------------------------------------------------------------------- *) + +let MEMBERS_ISASET = prove + (`!x s. x <: s ==> isaset s`, + REWRITE_TAC[inset; isaset] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Each level is nonempty. *) +(* ------------------------------------------------------------------------- *) + +let LEVEL_NONEMPTY = prove + (`!l. ?x. x IN setlevel l`, + REWRITE_TAC[MEMBER_NOT_EMPTY] THEN + MATCH_MP_TAC setlevel_INDUCT THEN REWRITE_TAC[setlevel; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIV] THEN + REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_THM] THEN + MESON_TAC[EMPTY_SUBSET]);; + +let LEVEL_SET_EXISTS = prove + (`!l. ?s. level s = l`, + MP_TAC LEVEL_NONEMPTY THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[level] THEN MESON_TAC[FST; PAIR; V_TYBIJ]);; + +(* ------------------------------------------------------------------------- *) +(* Empty sets (or non-sets, of course) exist at all set levels. *) +(* ------------------------------------------------------------------------- *) + +let MK_V_CLAUSES = prove + (`e IN setlevel l + ==> (level(mk_V(l,e)) = l) /\ (element(mk_V(l,e)) = e)`, + REWRITE_TAC[level; element; PAIR; GSYM PAIR_EQ; V_TYBIJ]);; + +let MK_V_SET = prove + (`s SUBSET setlevel l + ==> (set(mk_V(Powerset l,I_SET (setlevel l) s)) = s) /\ + (level(mk_V(Powerset l,I_SET (setlevel l) s)) = Powerset l) /\ + (element(mk_V(Powerset l,I_SET (setlevel l) s)) = I_SET (setlevel l) s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `I_SET (setlevel l) s IN setlevel(Powerset l)` ASSUME_TAC THENL + [REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[MK_V_CLAUSES; set] THEN + SUBGOAL_THEN `I_SET (setlevel l) s IN setlevel(Powerset l)` ASSUME_TAC THENL + [REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[MK_V_CLAUSES; droplevel] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[I_SET_SETLEVEL]);; + +let EMPTY_EXISTS = prove + (`!l. ?s. (level s = l) /\ !x. ~(x <: s)`, + MATCH_MP_TAC setlevel_INDUCT THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; ALL_TAC; + X_GEN_TAC `l:setlevel` THEN DISCH_THEN(K ALL_TAC) THEN + EXISTS_TAC `mk_V(Powerset l,I_SET (setlevel l) {})` THEN + SIMP_TAC[inset; MK_V_CLAUSES; MK_V_SET; EMPTY_SUBSET; NOT_IN_EMPTY]; + ALL_TAC] THEN + MESON_TAC[LEVEL_SET_EXISTS; MEMBERS_ISASET; isaset; + setlevel_DISTINCT]);; + +let EMPTY_SET = new_specification ["emptyset"] + (REWRITE_RULE[SKOLEM_THM] EMPTY_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Comprehension principle, with no change of levels. *) +(* ------------------------------------------------------------------------- *) + +let COMPREHENSION_EXISTS = prove + (`!s p. ?t. (level t = level s) /\ !x. x <: t <=> x <: s /\ p x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL + [ALL_TAC; ASM_MESON_TAC[MEMBERS_ISASET]] THEN + POP_ASSUM(X_CHOOSE_TAC `l:setlevel` o REWRITE_RULE[isaset]) THEN + MP_TAC(SPEC `s:V` ELEMENT_IN_LEVEL) THEN + ASM_REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `u:I->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `mk_V(Powerset l, + I_SET(setlevel l) + {i | i IN u /\ p(mk_V(l,i))})` THEN + SUBGOAL_THEN `{i | i IN u /\ p (mk_V (l,i))} SUBSET (setlevel l)` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]; + ALL_TAC] THEN + ASM_SIMP_TAC[MK_V_SET; inset] THEN X_GEN_TAC `x:V` THEN + REWRITE_TAC[setlevel_INJ] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[SET; MK_V_SET]);; + +parse_as_infix("suchthat",(21,"left"));; + +let SUCHTHAT = new_specification ["suchthat"] + (REWRITE_RULE[SKOLEM_THM] COMPREHENSION_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Each setlevel exists as a set. *) +(* ------------------------------------------------------------------------- *) + +let SETLEVEL_EXISTS = prove + (`!l. ?s. (level s = Powerset l) /\ + !x. x <: s <=> (level x = l) /\ element(x) IN setlevel l`, + GEN_TAC THEN + EXISTS_TAC `mk_V(Powerset l,I_SET (setlevel l) (setlevel l))` THEN + SIMP_TAC[MK_V_SET; SUBSET_REFL; inset; setlevel_INJ] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Conversely, set(s) belongs in the appropriate level. *) +(* ------------------------------------------------------------------------- *) + +let SET_DECOMP = prove + (`!s. isaset s + ==> (set s) SUBSET (setlevel(droplevel(level s))) /\ + (I_SET (setlevel(droplevel(level s))) (set s) = element s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[isaset] THEN + DISCH_THEN(X_CHOOSE_TAC `l:setlevel`) THEN + REWRITE_TAC[set] THEN CONV_TAC SELECT_CONV THEN + ASM_REWRITE_TAC[setlevel; droplevel] THEN + MP_TAC(SPEC `s:V` ELEMENT_IN_LEVEL) THEN + ASM_REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[]);; + +let SET_SUBSET_SETLEVEL = prove + (`!s. isaset s ==> set(s) SUBSET setlevel(droplevel(level s))`, + MESON_TAC[SET_DECOMP]);; + +(* ------------------------------------------------------------------------- *) +(* Power set exists. *) +(* ------------------------------------------------------------------------- *) + +let POWERSET_EXISTS = prove + (`!s. ?t. (level t = Powerset(level s)) /\ !x. x <: t <=> x <=: s`, + GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL + [FIRST_ASSUM(MP_TAC o GSYM o MATCH_MP SET_DECOMP) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [isaset]) THEN + DISCH_THEN(X_CHOOSE_THEN `l:setlevel` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[droplevel] THEN STRIP_TAC THEN + X_CHOOSE_THEN `t:V` STRIP_ASSUME_TAC + (SPEC `Powerset l` SETLEVEL_EXISTS) THEN + MP_TAC(SPECL [`t:V`; `\v. !x. x <: v ==> x <: s`] + COMPREHENSION_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:V` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[subset_def] THEN + ASM_MESON_TAC[ELEMENT_IN_LEVEL]; + MP_TAC(SPEC `level s` SETLEVEL_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:V` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[subset_def] THEN + ASM_MESON_TAC[ELEMENT_IN_LEVEL; MEMBERS_ISASET; isaset]]);; + +let POWERSET = new_specification ["powerset"] + (REWRITE_RULE[SKOLEM_THM] POWERSET_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Pairing operation. *) +(* ------------------------------------------------------------------------- *) + +let pair = new_definition + `pair x y = + mk_V(Cartprod (level x) (level y),I_PAIR(element x,element y))`;; + +let PAIR_IN_LEVEL = prove + (`!x y l m. x IN setlevel l /\ y IN setlevel m + ==> I_PAIR(x,y) IN setlevel (Cartprod l m)`, + REWRITE_TAC[setlevel; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; + +let DEST_MK_PAIR = prove + (`dest_V(mk_V(Cartprod (level x) (level y),I_PAIR(element x,element y))) = + Cartprod (level x) (level y),I_PAIR(element x,element y)`, + REWRITE_TAC[GSYM V_TYBIJ] THEN SIMP_TAC[PAIR_IN_LEVEL; ELEMENT_IN_LEVEL]);; + +let PAIR_INJ = prove + (`!x1 y1 x2 y2. (pair x1 y1 = pair x2 y2) <=> (x1 = x2) /\ (y1 = y2)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + REWRITE_TAC[pair] THEN + DISCH_THEN(MP_TAC o AP_TERM `dest_V`) THEN REWRITE_TAC[DEST_MK_PAIR] THEN + REWRITE_TAC[setlevel_INJ; PAIR_EQ; I_PAIR] THEN + REWRITE_TAC[level; element] THEN MESON_TAC[PAIR; CONJUNCT1 v_tybij]);; + +let LEVEL_PAIR = prove + (`!x y. level(pair x y) = Cartprod (level x) (level y)`, + REWRITE_TAC[level; + REWRITE_RULE[DEST_MK_PAIR] (AP_TERM `dest_V` (SPEC_ALL pair))]);; + +(* ------------------------------------------------------------------------- *) +(* Decomposition functions. *) +(* ------------------------------------------------------------------------- *) + +let fst_def = new_definition + `fst p = @x. ?y. p = pair x y`;; + +let snd_def = new_definition + `snd p = @y. ?x. p = pair x y`;; + +let PAIR_CLAUSES = prove + (`!x y. (fst(pair x y) = x) /\ (snd(pair x y) = y)`, + REWRITE_TAC[fst_def; snd_def] THEN MESON_TAC[PAIR_INJ]);; + +(* ------------------------------------------------------------------------- *) +(* And the Cartesian product space. *) +(* ------------------------------------------------------------------------- *) + +let CARTESIAN_EXISTS = prove + (`!s t. ?u. (level u = + Powerset(Cartprod (droplevel(level s)) + (droplevel(level t)))) /\ + !z. z <: u <=> ?x y. (z = pair x y) /\ x <: s /\ y <: t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `isaset s` THENL + [ALL_TAC; ASM_MESON_TAC[EMPTY_EXISTS; MEMBERS_ISASET]] THEN + SUBGOAL_THEN `?l. (level s = Powerset l)` CHOOSE_TAC THENL + [ASM_MESON_TAC[isaset]; ALL_TAC] THEN + ASM_CASES_TAC `isaset t` THENL + [ALL_TAC; ASM_MESON_TAC[EMPTY_EXISTS; MEMBERS_ISASET]] THEN + SUBGOAL_THEN `?m. (level t = Powerset m)` CHOOSE_TAC THENL + [ASM_MESON_TAC[isaset]; ALL_TAC] THEN + MP_TAC(SPEC `Cartprod l m` SETLEVEL_EXISTS) THEN + ASM_REWRITE_TAC[droplevel] THEN + DISCH_THEN(X_CHOOSE_THEN `u:V` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`u:V`; `\z. ?x y. (z = pair x y) /\ x <: s /\ y <: t`] + COMPREHENSION_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:V` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:V` THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> a) ==> ((a /\ b) /\ c <=> c)`) THEN + CONJ_TAC THENL [MESON_TAC[ELEMENT_IN_LEVEL]; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[LEVEL_PAIR] THEN BINOP_TAC THEN + ASM_MESON_TAC[inset; setlevel_INJ]);; + +let PRODUCT = new_specification ["product"] + (REWRITE_RULE[SKOLEM_THM] CARTESIAN_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Extensionality for sets at the same level. *) +(* ------------------------------------------------------------------------- *) + +let IN_SET_ELEMENT = prove + (`!s. isaset s /\ e IN set(s) + ==> ?x. (e = element x) /\ (level s = Powerset(level x)) /\ x <: s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `l:setlevel` o REWRITE_RULE[isaset]) THEN + EXISTS_TAC `mk_V(l,e)` THEN REWRITE_TAC[inset] THEN + SUBGOAL_THEN `e IN setlevel l` (fun t -> ASM_SIMP_TAC[t; MK_V_CLAUSES]) THEN + ASM_MESON_TAC[SET_SUBSET_SETLEVEL; SUBSET; droplevel]);; + +let SUBSET_ALT = prove + (`isaset s /\ isaset t + ==> (s <=: t <=> (level s = level t) /\ set(s) SUBSET set(t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[subset_def; inset] THEN + ASM_CASES_TAC `level s = level t` THEN ASM_REWRITE_TAC[SUBSET] THEN + STRIP_TAC THEN EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_MESON_TAC[IN_SET_ELEMENT]);; + +let SUBSET_ANTISYM_LEVEL = prove + (`!s t. isaset s /\ isaset t /\ s <=: t /\ t <=: s ==> (s = t)`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[SUBSET_ALT] THEN + EVERY_ASSUM(MP_TAC o GSYM o MATCH_MP SET_DECOMP) THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `s:V` SET) THEN MP_TAC(SPEC `t:V` SET) THEN + REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN + AP_TERM_TAC THEN BINOP_TAC THEN ASM_MESON_TAC[SUBSET_ANTISYM]);; + +let EXTENSIONALITY_LEVEL = prove + (`!s t. isaset s /\ isaset t /\ (level s = level t) /\ (!x. x <: s <=> x <: t) + ==> (s = t)`, + MESON_TAC[SUBSET_ANTISYM_LEVEL; subset_def]);; + +(* ------------------------------------------------------------------------- *) +(* And hence for any nonempty sets. *) +(* ------------------------------------------------------------------------- *) + +let EXTENSIONALITY_NONEMPTY = prove + (`!s t. (?x. x <: s) /\ (?x. x <: t) /\ (!x. x <: s <=> x <: t) + ==> (s = t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTENSIONALITY_LEVEL THEN + ASM_MESON_TAC[MEMBERS_ISASET; inset]);; + +(* ------------------------------------------------------------------------- *) +(* Union set exists. I don't need this but if might be a sanity check. *) +(* ------------------------------------------------------------------------- *) + +let UNION_EXISTS = prove + (`!s. ?t. (level t = droplevel(level s)) /\ + !x. x <: t <=> ?u. x <: u /\ u <: s`, + GEN_TAC THEN ASM_CASES_TAC `isaset s` THENL + [ALL_TAC; + MP_TAC(SPEC `droplevel(level s)` EMPTY_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[MEMBERS_ISASET]] THEN + FIRST_ASSUM(X_CHOOSE_TAC `l:setlevel` o REWRITE_RULE[isaset]) THEN + ASM_REWRITE_TAC[droplevel] THEN ASM_CASES_TAC `?m. l = Powerset m` THENL + [ALL_TAC; + MP_TAC(SPEC `l:setlevel` EMPTY_EXISTS) THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[inset] THEN + ASM_MESON_TAC[setlevel_INJ]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:setlevel` SUBST_ALL_TAC) THEN + MP_TAC(SPEC `m:setlevel` SETLEVEL_EXISTS) THEN + ASM_REWRITE_TAC[droplevel] THEN + DISCH_THEN(X_CHOOSE_THEN `t:V` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`t:V`; `\x. ?u. x <: u /\ u <: s`] + COMPREHENSION_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[inset; ELEMENT_IN_LEVEL; setlevel_INJ]);; + +let SETUNION = new_specification ["setunion"] + (REWRITE_RULE[SKOLEM_THM] UNION_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Boolean stuff. *) +(* ------------------------------------------------------------------------- *) + +let true_def = new_definition + `true = mk_V(Ur_bool,I_BOOL T)`;; + +let false_def = new_definition + `false = mk_V(Ur_bool,I_BOOL F)`;; + +let boolset = new_definition + `boolset = + mk_V(Powerset Ur_bool,I_SET (setlevel Ur_bool) (setlevel Ur_bool))`;; + +let IN_BOOL = prove + (`!x. x <: boolset <=> (x = true) \/ (x = false)`, + REWRITE_TAC[inset; boolset; true_def; false_def] THEN + SIMP_TAC[MK_V_SET; SUBSET_REFL] THEN + REWRITE_TAC[setlevel_INJ; setlevel] THEN + SUBGOAL_THEN `IMAGE I_BOOL UNIV = {I_BOOL F,I_BOOL T}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[I_BOOL]; + ALL_TAC] THEN + GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o BINOP_CONV o LAND_CONV) [GSYM SET] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + SUBGOAL_THEN `!b. (I_BOOL b) IN setlevel Ur_bool` ASSUME_TAC THENL + [REWRITE_TAC[setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; + ASM_MESON_TAC[V_TYBIJ; ELEMENT_IN_LEVEL; PAIR_EQ]]);; + +let TRUE_NE_FALSE = prove + (`~(true = false)`, + REWRITE_TAC[true_def; false_def] THEN + DISCH_THEN(MP_TAC o AP_TERM `dest_V`) THEN + SUBGOAL_THEN `!b. (I_BOOL b) IN setlevel Ur_bool` ASSUME_TAC THENL + [REWRITE_TAC[setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; + ASM_MESON_TAC[V_TYBIJ; I_BOOL; PAIR_EQ]]);; + +let BOOLEAN_EQ = prove + (`!x y. x <: boolset /\ y <: boolset /\ + ((x = true) <=> (y = true)) + ==> (x = y)`, + MESON_TAC[TRUE_NE_FALSE; IN_BOOL]);; + +(* ------------------------------------------------------------------------- *) +(* Ind stuff. *) +(* ------------------------------------------------------------------------- *) + +let indset = new_definition + `indset = mk_V(Powerset Ur_ind,I_SET (setlevel Ur_ind) (setlevel Ur_ind))`;; + +let INDSET_IND_MODEL = prove + (`?f. (!i:ind_model. f(i) <: indset) /\ (!i j. (f i = f j) ==> (i = j))`, + EXISTS_TAC `\i. mk_V(Ur_ind,I_IND i)` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `!i. (I_IND i) IN setlevel Ur_ind` ASSUME_TAC THENL + [REWRITE_TAC[setlevel; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[MK_V_SET; SUBSET_REFL; inset; indset; MK_V_CLAUSES] THEN + ASM_MESON_TAC[V_TYBIJ; I_IND; ELEMENT_IN_LEVEL; PAIR_EQ]);; + +let INDSET_INHABITED = prove + (`?x. x <: indset`, + MESON_TAC[INDSET_IND_MODEL]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom of choice (this is trivially so in HOL anyway, but...) *) +(* ------------------------------------------------------------------------- *) + +let ch = + let th = prove + (`?ch. !s. (?x. x <: s) ==> ch(s) <: s`, + REWRITE_TAC[GSYM SKOLEM_THM] THEN MESON_TAC[]) in + new_specification ["ch"] th;; + +(* ------------------------------------------------------------------------- *) +(* Sanity check lemmas. *) +(* ------------------------------------------------------------------------- *) + +let IN_POWERSET = prove + (`!x s. x <: powerset s <=> x <=: s`, + MESON_TAC[POWERSET]);; + +let IN_PRODUCT = prove + (`!z s t. z <: product s t <=> ?x y. (z = pair x y) /\ x <: s /\ y <: t`, + MESON_TAC[PRODUCT]);; + +let IN_COMPREHENSION = prove + (`!p s x. x <: s suchthat p <=> x <: s /\ p x`, + MESON_TAC[SUCHTHAT]);; + +let PRODUCT_INHABITED = prove + (`(?x. x <: s) /\ (?y. y <: t) ==> ?z. z <: product s t`, + MESON_TAC[IN_PRODUCT]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of function space. *) +(* ------------------------------------------------------------------------- *) + +let funspace = new_definition + `funspace s t = + powerset(product s t) suchthat + (\u. !x. x <: s ==> ?!y. pair x y <: u)`;; + +let apply_def = new_definition + `apply f x = @y. pair x y <: f`;; + +let abstract = new_definition + `abstract s t f = + (product s t) suchthat (\z. !x y. (pair x y = z) ==> (y = f x))`;; + +let APPLY_ABSTRACT = prove + (`!x s t. x <: s /\ f(x) <: t ==> (apply(abstract s t f) x = f(x))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[apply_def; abstract; IN_PRODUCT; SUCHTHAT] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[PAIR_INJ] THEN + ASM_MESON_TAC[]);; + +let APPLY_IN_RANSPACE = prove + (`!f x s t. x <: s /\ f <: funspace s t ==> apply f x <: t`, + REWRITE_TAC[funspace; SUCHTHAT; IN_POWERSET; IN_PRODUCT; subset_def] THEN + REWRITE_TAC[apply_def] THEN MESON_TAC[PAIR_INJ]);; + +let ABSTRACT_IN_FUNSPACE = prove + (`!f x s t. (!x. x <: s ==> f(x) <: t) + ==> abstract s t f <: funspace s t`, + REWRITE_TAC[funspace; abstract; SUCHTHAT; IN_POWERSET; IN_PRODUCT; + subset_def; PAIR_INJ] THEN + SIMP_TAC[LEFT_FORALL_IMP_THM; GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[UNWIND_THM1; EXISTS_REFL] THEN MESON_TAC[]);; + +let FUNSPACE_INHABITED = prove + (`!s t. ((?x. x <: s) ==> (?y. y <: t)) ==> ?f. f <: funspace s t`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `abstract s t (\x. @y. y <: t)` THEN + MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN ASM_MESON_TAC[]);; + +let ABSTRACT_EQ = prove + (`!s t1 t2 f g. + (?x. x <: s) /\ + (!x. x <: s ==> f(x) <: t1 /\ g(x) <: t2 /\ (f x = g x)) + ==> (abstract s t1 f = abstract s t2 g)`, + REWRITE_TAC[abstract] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC EXTENSIONALITY_NONEMPTY THEN + REWRITE_TAC[SUCHTHAT; IN_PRODUCT] THEN REPEAT CONJ_TAC THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + SIMP_TAC[TAUT `(a /\ b /\ c) /\ d <=> ~(a ==> b /\ c ==> ~d)`] THEN + REWRITE_TAC[PAIR_INJ] THEN SIMP_TAC[LEFT_FORALL_IMP_THM] THENL + [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[PAIR_INJ] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN + REWRITE_TAC[NOT_IMP] THEN GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[PAIR_INJ] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of treating a Boolean function as a set. *) +(* ------------------------------------------------------------------------- *) + +let boolean = new_definition + `boolean b = if b then true else false`;; + +let holds = new_definition + `holds s x <=> (apply s x = true)`;; + +let BOOLEAN_IN_BOOLSET = prove + (`!b. boolean b <: boolset`, + REWRITE_TAC[boolean] THEN MESON_TAC[IN_BOOL]);; + +let BOOLEAN_EQ_TRUE = prove + (`!b. (boolean b = true) <=> b`, + REWRITE_TAC[boolean] THEN MESON_TAC[TRUE_NE_FALSE]);; diff --git a/Model/semantics.ml b/Model/semantics.ml new file mode 100644 index 0000000..65a1dff --- /dev/null +++ b/Model/semantics.ml @@ -0,0 +1,1116 @@ +(* ========================================================================= *) +(* Formal semantics of HOL inside itself. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Semantics of types. *) +(* ------------------------------------------------------------------------- *) + +let typeset = new_recursive_definition type_RECURSION + `(typeset tau (Tyvar s) = tau(s)) /\ + (typeset tau Bool = boolset) /\ + (typeset tau Ind = indset) /\ + (typeset tau (Fun a b) = funspace (typeset tau a) (typeset tau b))`;; + +(* ------------------------------------------------------------------------- *) +(* Semantics of terms. *) +(* ------------------------------------------------------------------------- *) + +let semantics = new_recursive_definition term_RECURSION + `(semantics sigma tau (Var n ty) = sigma(n,ty)) /\ + (semantics sigma tau (Equal ty) = + abstract (typeset tau ty) (typeset tau (Fun ty Bool)) + (\x. abstract (typeset tau ty) (typeset tau Bool) + (\y. boolean(x = y)))) /\ + (semantics sigma tau (Select ty) = + abstract (typeset tau (Fun ty Bool)) (typeset tau ty) + (\s. if ?x. x <: ((typeset tau ty) suchthat (holds s)) + then ch ((typeset tau ty) suchthat (holds s)) + else ch (typeset tau ty))) /\ + (semantics sigma tau (Comb s t) = + apply (semantics sigma tau s) (semantics sigma tau t)) /\ + (semantics sigma tau (Abs n ty t) = + abstract (typeset tau ty) (typeset tau (typeof t)) + (\x. semantics (((n,ty) |-> x) sigma) tau t))`;; + +(* ------------------------------------------------------------------------- *) +(* Valid type and term valuations. *) +(* ------------------------------------------------------------------------- *) + +let type_valuation = new_definition + `type_valuation tau <=> !x. (?y. y <: tau x)`;; + +let term_valuation = new_definition + `term_valuation tau sigma <=> !n ty. sigma(n,ty) <: typeset tau ty`;; + +let TERM_VALUATION_VALMOD = prove + (`!sigma taut n ty x. + term_valuation tau sigma /\ x <: typeset tau ty + ==> term_valuation tau (((n,ty) |-> x) sigma)`, + REWRITE_TAC[term_valuation; valmod; PAIR_EQ] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* All the typesets are nonempty. *) +(* ------------------------------------------------------------------------- *) + +let TYPESET_INHABITED = prove + (`!tau ty. type_valuation tau ==> ?x. x <: typeset tau ty`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC type_INDUCT THEN REWRITE_TAC[typeset] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[type_valuation]; + ASM_MESON_TAC[BOOLEAN_IN_BOOLSET; INDSET_INHABITED; FUNSPACE_INHABITED]]);; + +(* ------------------------------------------------------------------------- *) +(* Semantics maps into the right place. *) +(* ------------------------------------------------------------------------- *) + +let SEMANTICS_TYPESET_INDUCT = prove + (`!tm ty. tm has_type ty + ==> tm has_type ty /\ + !sigma tau. type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau tm) <: (typeset tau ty)`, + MATCH_MP_TAC has_type_INDUCT THEN + ASM_SIMP_TAC[semantics; typeset; has_type_RULES] THEN + CONJ_TAC THENL [MESON_TAC[term_valuation]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN + REWRITE_TAC[BOOLEAN_IN_BOOLSET]; + MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN + ASM_MESON_TAC[ch; SUCHTHAT; TYPESET_INHABITED]; + ASM_MESON_TAC[has_type_RULES]; + MATCH_MP_TAC APPLY_IN_RANSPACE THEN ASM_MESON_TAC[]; + FIRST_ASSUM(SUBST1_TAC o MATCH_MP WELLTYPED_LEMMA) THEN + MATCH_MP_TAC ABSTRACT_IN_FUNSPACE THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD]]);; + +let SEMANTICS_TYPESET = prove + (`!sigma tau tm ty. + type_valuation tau /\ term_valuation tau sigma /\ tm has_type ty + ==> (semantics sigma tau tm) <: (typeset tau ty)`, + MESON_TAC[SEMANTICS_TYPESET_INDUCT]);; + +(* ------------------------------------------------------------------------- *) +(* Semantics of equations. *) +(* ------------------------------------------------------------------------- *) + +let SEMANTICS_EQUATION = prove + (`!sigma tau s t. + s has_type (typeof s) /\ t has_type (typeof s) /\ + type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau (s === t) = + boolean(semantics sigma tau s = semantics sigma tau t))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[equation; semantics] THEN + ASM_SIMP_TAC[APPLY_ABSTRACT; typeset; SEMANTICS_TYPESET; + ABSTRACT_IN_FUNSPACE; BOOLEAN_IN_BOOLSET]);; + +let SEMANTICS_EQUATION_ALT = prove + (`!sigma tau s t. + (s === t) has_type Bool /\ + type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau (s === t) = + boolean(semantics sigma tau s = semantics sigma tau t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SEMANTICS_EQUATION THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `welltyped(s === t)` MP_TAC THENL + [ASM_MESON_TAC[welltyped]; ALL_TAC] THEN + REWRITE_TAC[equation; WELLTYPED_CLAUSES; typeof; codomain] THEN + MESON_TAC[welltyped; type_INJ; WELLTYPED; WELLTYPED_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Quick sanity check. *) +(* ------------------------------------------------------------------------- *) + +let SEMANTICS_SELECT = prove + (`p has_type (Fun ty Bool) /\ + type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau (Comb (Select ty) p) = + if ?x. x <: (typeset tau ty) suchthat (holds (semantics sigma tau p)) + then ch((typeset tau ty) suchthat (holds (semantics sigma tau p))) + else ch(typeset tau ty))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[semantics] THEN + W(fun (asl,w) -> + let t = find_term (fun t -> + can (PART_MATCH (lhs o rand) APPLY_ABSTRACT) t) w in + MP_TAC(PART_MATCH (lhs o rand) APPLY_ABSTRACT t)) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[SEMANTICS_TYPESET; typeset]; + REWRITE_TAC[SUCHTHAT] THEN + ASM_MESON_TAC[ch; SUCHTHAT; TYPESET_INHABITED]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Semantics of a sequent. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("|=",(11,"right"));; + +let sequent = new_definition + `asms |= p <=> ALL (\a. a has_type Bool) (CONS p asms) /\ + !sigma tau. type_valuation tau /\ + term_valuation tau sigma /\ + ALL (\a. semantics sigma tau a = true) asms + ==> (semantics sigma tau p = true)`;; + +(* ------------------------------------------------------------------------- *) +(* Invariance of semantics under alpha-conversion. *) +(* ------------------------------------------------------------------------- *) + +let SEMANTICS_RACONV = prove + (`!env tp. + RACONV env tp + ==> !sigma1 sigma2 tau. + type_valuation tau /\ + term_valuation tau sigma1 /\ term_valuation tau sigma2 /\ + (!x1 ty1 x2 ty2. + ALPHAVARS env (Var x1 ty1,Var x2 ty2) + ==> (semantics sigma1 tau (Var x1 ty1) = + semantics sigma2 tau (Var x2 ty2))) + ==> welltyped(FST tp) /\ welltyped(SND tp) + ==> (semantics sigma1 tau (FST tp) = + semantics sigma2 tau (SND tp))`, + MATCH_MP_TAC RACONV_INDUCT THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[semantics; WELLTYPED_CLAUSES] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[]; + BINOP_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC ABSTRACT_EQ THEN + ASM_SIMP_TAC[TYPESET_INHABITED] THEN + X_GEN_TAC `x:V` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SEMANTICS_TYPESET THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD; GSYM WELLTYPED]; + MATCH_MP_TAC SEMANTICS_TYPESET THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD; GSYM WELLTYPED]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP]) THEN + FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN CONJ_TAC) THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + REWRITE_TAC[ALPHAVARS; PAIR_EQ; term_INJ] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VALMOD; PAIR_EQ] THEN + ASM_MESON_TAC[]);; + +let SEMANTICS_ACONV = prove + (`!sigma tau s t. + type_valuation tau /\ term_valuation tau sigma /\ + welltyped s /\ welltyped t /\ ACONV s t + ==> (semantics sigma tau s = semantics sigma tau t)`, + REWRITE_TAC[ACONV] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM; FORALL_PAIR_THM] + SEMANTICS_RACONV) THEN + EXISTS_TAC `[]:(term#term)list` THEN + ASM_SIMP_TAC[ALPHAVARS; term_INJ; PAIR_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* General semantic lemma about binary inference rules. *) +(* ------------------------------------------------------------------------- *) + +let BINARY_INFERENCE_RULE = prove + (`(p1 has_type Bool /\ p2 has_type Bool + ==> q has_type Bool /\ + !sigma tau. type_valuation tau /\ term_valuation tau sigma /\ + (semantics sigma tau p1 = true) /\ + (semantics sigma tau p2 = true) + ==> (semantics sigma tau q = true)) + ==> (asl1 |= p1 /\ asl2 |= p2 ==> TERM_UNION asl1 asl2 |= q)`, + REWRITE_TAC[sequent; ALL] THEN STRIP_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[ALL_BOOL_TERM_UNION] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC + `ALL (\a. semantics sigma tau a = true) (TERM_UNION asl1 asl2)` THEN + REWRITE_TAC[GSYM ALL_MEM] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ALL_MEM])) THEN + REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN + DISCH_THEN(fun th -> X_GEN_TAC `r:term` THEN DISCH_TAC THEN MP_TAC th) THEN + MP_TAC(SPECL [`asl1:term list`; `asl2:term list`; `r:term`] + TERM_UNION_THM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `s:term`) THEN + DISCH_THEN(MP_TAC o SPEC `s:term`) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SEMANTICS_ACONV; welltyped; TERM_UNION_NONEW]);; + +(* ------------------------------------------------------------------------- *) +(* Semantics only depends on valuations of free variables. *) +(* ------------------------------------------------------------------------- *) + +let TERM_VALUATION_VFREE_IN = prove + (`!tau sigma1 sigma2 t. + type_valuation tau /\ + term_valuation tau sigma1 /\ term_valuation tau sigma2 /\ + welltyped t /\ + (!x ty. VFREE_IN (Var x ty) t ==> (sigma1(x,ty) = sigma2(x,ty))) + ==> (semantics sigma1 tau t = semantics sigma2 tau t)`, + GEN_TAC THEN GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[semantics; VFREE_IN; term_DISTINCT; term_INJ] THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[]; + BINOP_TAC THEN ASM_MESON_TAC[WELLTYPED_CLAUSES]; + ALL_TAC] THEN + MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN + X_GEN_TAC `x:V` THEN DISCH_TAC THEN REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[TERM_VALUATION_VALMOD; WELLTYPED; WELLTYPED_CLAUSES; + SEMANTICS_TYPESET]; + ALL_TAC]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + CONJ_TAC THENL [ASM_MESON_TAC[WELLTYPED_CLAUSES]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`] THEN DISCH_TAC THEN + REWRITE_TAC[VALMOD; PAIR_EQ] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Prove some inference rules correct. *) +(* ------------------------------------------------------------------------- *) + +let ASSUME_correct = prove + (`!p. p has_type Bool ==> [p] |= p`, + SIMP_TAC[sequent; ALL]);; + +let REFL_correct = prove + (`!t. welltyped t ==> [] |= t === t`, + SIMP_TAC[sequent; SEMANTICS_EQUATION; ALL; WELLTYPED] THEN + REWRITE_TAC[boolean; equation] THEN MESON_TAC[has_type_RULES]);; + +let TRANS_correct = prove + (`!asl1 asl2 l m1 m2 r. + asl1 |= l === m1 /\ asl2 |= m2 === r /\ ACONV m1 m2 + ==> TERM_UNION asl1 asl2 |= l === r`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC BINARY_INFERENCE_RULE THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL; ACONV_TYPE]; + ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; IMP_CONJ; boolean] THEN + ASM_MESON_TAC[SEMANTICS_ACONV; TRUE_NE_FALSE; EQUATION_HAS_TYPE_BOOL]]);; + +let MK_COMB_correct = prove + (`!asl1 l1 r1 asl2 l2 r2. + asl1 |= l1 === r1 /\ asl2 |= l2 === r2 /\ + (?rty. typeof l1 = Fun (typeof l2) rty) + ==> TERM_UNION asl1 asl2 |= Comb l1 l2 === Comb r1 r2`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC BINARY_INFERENCE_RULE THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_CLAUSES; typeof] THEN + MESON_TAC[codomain]; + ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; IMP_CONJ; boolean] THEN + REWRITE_TAC[semantics] THEN + ASM_MESON_TAC[SEMANTICS_ACONV; TRUE_NE_FALSE; EQUATION_HAS_TYPE_BOOL]]);; + +let EQ_MP_correct = prove + (`!asl1 asl2 p q p'. + asl1 |= p === q /\ asl2 |= p' /\ ACONV p p' + ==> TERM_UNION asl1 asl2 |= q`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC BINARY_INFERENCE_RULE THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_LEMMA; WELLTYPED; + ACONV_TYPE]; + ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; IMP_CONJ; boolean] THEN + ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL; TRUE_NE_FALSE; SEMANTICS_ACONV; + welltyped]]);; + +let BETA_correct = prove + (`!x ty t. welltyped t ==> [] |= Comb (Abs x ty t) (Var x ty) === t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[sequent; ALL] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[EQUATION_HAS_TYPE_BOOL; typeof; WELLTYPED_CLAUSES] THEN + REWRITE_TAC[codomain; type_INJ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SIMP_TAC[SEMANTICS_EQUATION_ALT] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[BOOLEAN_EQ_TRUE; semantics] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `semantics (((x,ty) |-> sigma(x,ty)) sigma) tau t` THEN + CONJ_TAC THENL [MATCH_MP_TAC APPLY_ABSTRACT; ALL_TAC] THEN + REWRITE_TAC[VALMOD_REPEAT] THEN + ASM_MESON_TAC[term_valuation; SEMANTICS_TYPESET; WELLTYPED]);; + +let ABS_correct = prove + (`!asl x ty l r. + ~(EX (VFREE_IN (Var x ty)) asl) /\ asl |= l === r + ==> asl |= (Abs x ty l) === (Abs x ty r)`, + REPEAT GEN_TAC THEN REWRITE_TAC[sequent; ALL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL + [UNDISCH_TAC `(l === r) has_type Bool` THEN + SIMP_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_CLAUSES; typeof]; + ALL_TAC] THEN + DISCH_TAC THEN ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; BOOLEAN_EQ_TRUE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[semantics] THEN + SUBGOAL_THEN `typeof r = typeof l` SUBST1_TAC THENL + [ASM_MESON_TAC[EQUATION_HAS_TYPE_BOOL]; ALL_TAC] THEN + MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN + X_GEN_TAC `x:V` THEN DISCH_TAC THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[SEMANTICS_TYPESET; TERM_VALUATION_VALMOD; + WELLTYPED; EQUATION_HAS_TYPE_BOOL]; + ALL_TAC]) THEN + FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN + ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; BOOLEAN_EQ_TRUE] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + SUBGOAL_THEN `ALL (\a. a has_type Bool) asl /\ + ALL (\a. ~(VFREE_IN (Var x ty) a)) asl /\ + ALL (\a. semantics sigma tau a = true) asl` + MP_TAC THENL [ASM_REWRITE_TAC[GSYM NOT_EX; ETA_AX]; ALL_TAC] THEN + REWRITE_TAC[AND_ALL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN + X_GEN_TAC `p:term` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + CONJ_TAC THENL [ASM_MESON_TAC[welltyped]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN ASM_MESON_TAC[]);; + +let DEDUCT_ANTISYM_RULE_correct = prove + (`!asl1 asl2 p q. + asl1 |= c1 /\ asl2 |= c2 + ==> let asl1' = FILTER((~) o ACONV c2) asl1 + and asl2' = FILTER((~) o ACONV c1) asl2 in + (TERM_UNION asl1' asl2') |= c1 === c2`, + REPEAT GEN_TAC THEN + REWRITE_TAC[sequent; o_DEF; LET_DEF; LET_END_DEF; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT ` + (a1 /\ b1 ==> c1) /\ (a1 /\ b1 /\ c1 ==> a2 /\ b2 ==> c2) + ==> a1 /\ a2 /\ b1 /\ b2 ==> c1 /\ c2`) THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM ALL_MEM; MEM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[EQUATION_HAS_TYPE_BOOL] THEN + ASM_MESON_TAC[MEM_FILTER; TERM_UNION_NONEW; welltyped; WELLTYPED_LEMMA]; + ALL_TAC] THEN + REWRITE_TAC[ALL; AND_FORALL_THM] THEN REWRITE_TAC[GSYM ALL_MEM] THEN + STRIP_TAC THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[SEMANTICS_EQUATION_ALT; BOOLEAN_EQ_TRUE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOOLEAN_EQ THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[typeset; SEMANTICS_TYPESET]; ALL_TAC]) THEN + EQ_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + X_GEN_TAC `a:term` THEN DISCH_TAC THENL + [ASM_CASES_TAC `ACONV c1 a` THENL + [ASM_MESON_TAC[SEMANTICS_ACONV; welltyped]; ALL_TAC]; + ASM_CASES_TAC `ACONV c2 a` THENL + [ASM_MESON_TAC[SEMANTICS_ACONV; welltyped]; ALL_TAC]] THEN + (SUBGOAL_THEN + `MEM a (FILTER (\x. ~ACONV c2 x) asl1) \/ + MEM a (FILTER (\x. ~ACONV c1 x) asl2)` + MP_TAC THENL + [REWRITE_TAC[MEM_FILTER] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP TERM_UNION_THM) THEN + ASM_MESON_TAC[SEMANTICS_ACONV; welltyped]));; + +(* ------------------------------------------------------------------------- *) +(* Correct semantics for term substitution. *) +(* ------------------------------------------------------------------------- *) + +let DEST_VAR = new_recursive_definition term_RECURSION + `DEST_VAR (Var x ty) = (x,ty)`;; + +let TERM_VALUATION_ITLIST = prove + (`!ilist sigma tau. + type_valuation tau /\ term_valuation tau sigma /\ + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) + ==> term_valuation tau + (ITLIST (\(t,x). DEST_VAR x |-> semantics sigma tau t) ilist sigma)`, + MATCH_MP_TAC list_INDUCT THEN SIMP_TAC[ITLIST] THEN + REWRITE_TAC[FORALL_PAIR_THM; MEM; PAIR_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[LEFT_FORALL_IMP_THM; FORALL_AND_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[DEST_VAR] THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD; SEMANTICS_TYPESET]);; + +let ITLIST_VALMOD_FILTER = prove + (`!ilist sigma sem x ty y yty. + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) + ==> (ITLIST (\(t,x). DEST_VAR x |-> sem x t) + (FILTER (\(s',s). ~(s = Var x ty)) ilist) sigma (y,yty) = + if (y = x) /\ (yty = ty) then sigma(y,yty) + else ITLIST (\(t,x). DEST_VAR x |-> sem x t) ilist sigma (y,yty))`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[FILTER; ITLIST; COND_ID] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[MEM; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN + REWRITE_TAC[WELLTYPED_CLAUSES; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + MAP_EVERY X_GEN_TAC [`t:term`; `pp:term`; `ilist:(term#term)list`] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:string` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `sty:type` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RAND] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RATOR] THEN + ASM_REWRITE_TAC[ITLIST] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[DEST_VAR] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RATOR] THEN + REWRITE_TAC[VALMOD] THEN REWRITE_TAC[term_INJ] THEN + ASM_CASES_TAC `(s:string = x) /\ (sty:type = ty)` THEN + ASM_SIMP_TAC[PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; + +let ITLIST_VALMOD_EQ = prove + (`!l. (!t x. MEM (t,x) l /\ (f x = a) ==> (g x t = h x t)) /\ (i a = j a) + ==> (ITLIST (\(t,x). f(x) |-> g x t) l i a = + ITLIST (\(t,x). f(x) |-> h x t) l j a)`, + MATCH_MP_TAC list_INDUCT THEN SIMP_TAC[MEM; ITLIST; FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ; VALMOD] THEN MESON_TAC[]);; + +let SEMANTICS_VSUBST = prove + (`!tm sigma tau ilist. + welltyped tm /\ + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) + ==> !sigma tau. type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau (VSUBST ilist tm) = + semantics + (ITLIST + (\(t,x). DEST_VAR x |-> semantics sigma tau t) + ilist sigma) + tau tm)`, + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VSUBST; semantics] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`] THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[MEM; REV_ASSOCD; ITLIST; semantics; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`t:term`; `s:term`; `ilist:(term#term)list`] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN + REWRITE_TAC[WELLTYPED_CLAUSES; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `y:string` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `tty:type` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[DEST_VAR; VALMOD; term_INJ; PAIR_EQ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[WELLTYPED_CLAUSES] THEN REPEAT STRIP_TAC THEN + BINOP_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN + REWRITE_TAC[WELLTYPED_CLAUSES] THEN + ASM_CASES_TAC `welltyped t` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN LET_TAC THEN LET_TAC THEN + SUBGOAL_THEN + `!s s'. MEM (s',s) ilist' ==> (?x ty. (s = Var x ty) /\ s' has_type ty)` + ASSUME_TAC THENL + [EXPAND_TAC "ilist'" THEN ASM_SIMP_TAC[MEM_FILTER]; ALL_TAC] THEN + COND_CASES_TAC THENL + [REPEAT LET_TAC THEN + SUBGOAL_THEN + `!s s'. MEM (s',s) ilist'' ==> (?x ty. (s = Var x ty) /\ s' has_type ty)` + ASSUME_TAC THENL + [EXPAND_TAC "ilist''" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN + ASM_MESON_TAC[has_type_RULES]; + ALL_TAC]; + ALL_TAC] THEN + REWRITE_TAC[semantics] THEN + MATCH_MP_TAC ABSTRACT_EQ THEN ASM_SIMP_TAC[TYPESET_INHABITED] THEN + X_GEN_TAC `a:V` THEN DISCH_TAC THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC SEMANTICS_TYPESET) THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD; TERM_VALUATION_ITLIST] THEN + EXPAND_TAC "t'" THEN + ASM_SIMP_TAC[VSUBST_WELLTYPED; GSYM WELLTYPED; TERM_VALUATION_VALMOD] THEN + MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD; TERM_VALUATION_ITLIST] THEN + MAP_EVERY X_GEN_TAC [`u:string`; `uty:type`] THEN DISCH_TAC THENL + [EXPAND_TAC "ilist''" THEN REWRITE_TAC[ITLIST] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[DEST_VAR; VALMOD; PAIR_EQ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[semantics; VALMOD]; + ALL_TAC] THEN + EXPAND_TAC "ilist'" THEN ASM_SIMP_TAC[ITLIST_VALMOD_FILTER] THEN + REWRITE_TAC[VALMOD] THENL + [ALL_TAC; + REWRITE_TAC[PAIR_EQ] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ITLIST_VALMOD_EQ THEN ASM_REWRITE_TAC[VALMOD; PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC [`s':term`; `s:term`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP + (ASSUME `MEM (s':term,s:term) ilist`)) THEN + DISCH_THEN(X_CHOOSE_THEN `w:string` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `wty:type` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + UNDISCH_TAC `DEST_VAR (Var w wty) = u,uty` THEN + REWRITE_TAC[DEST_VAR; PAIR_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + CONJ_TAC THENL [ASM_MESON_TAC[welltyped]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`v:string`; `vty:type`] THEN + DISCH_TAC THEN REWRITE_TAC[VALMOD; PAIR_EQ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN + REWRITE_TAC[GSYM ALL_MEM] THEN + DISCH_THEN(MP_TAC o SPEC `(s':term,Var u uty)`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "ilist'" THEN + REWRITE_TAC[MEM_FILTER] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ASM_REWRITE_TAC[term_INJ]] THEN + MP_TAC(ISPECL [`t':term`; `x:string`; `ty:type`] VARIANT) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "t'" THEN + REWRITE_TAC[VFREE_IN_VSUBST] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) = b ==> ~a`] THEN + DISCH_THEN(MP_TAC o SPECL [`u:string`; `uty:type`]) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `REV_ASSOCD (Var u uty) ilist' (Var u uty) = + REV_ASSOCD (Var u uty) ilist (Var u uty)` + SUBST1_TAC THENL + [EXPAND_TAC "ilist'" THEN REWRITE_TAC[REV_ASSOCD_FILTER] THEN + ASM_REWRITE_TAC[term_INJ]; + ALL_TAC] THEN + UNDISCH_TAC + `!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty` THEN + SPEC_TAC(`ilist:(term#term)list`,`l:(term#term)list`) THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[REV_ASSOCD; ITLIST; VFREE_IN; VALMOD; term_INJ] THEN + SIMP_TAC[PAIR_EQ] THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[VALMOD; REV_ASSOCD; MEM] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN + REWRITE_TAC[WELLTYPED_CLAUSES; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + MAP_EVERY X_GEN_TAC [`t1:term`; `t2:term`; `i:(term#term)list`] THEN + DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN MP_TAC th) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `v:string` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `vty:type` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_REWRITE_TAC[DEST_VAR; term_INJ; PAIR_EQ] THEN + SUBGOAL_THEN `(v:string = u) /\ (vty:type = uty) <=> (u = v) /\ (uty = vty)` + SUBST1_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD; VALMOD] THEN + REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[welltyped; term_INJ]);; + +(* ------------------------------------------------------------------------- *) +(* Hence correctness of INST. *) +(* ------------------------------------------------------------------------- *) + +let INST_correct = prove + (`!ilist asl p. + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) + ==> asl |= p ==> MAP (VSUBST ilist) asl |= VSUBST ilist p`, + REWRITE_TAC[sequent] THEN REPEAT STRIP_TAC THENL + [UNDISCH_TAC `ALL (\a. a has_type Bool) (CONS p asl)` THEN + REWRITE_TAC[ALL; ALL_MAP] THEN MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_THM]] THEN + DISCH_TAC THEN MATCH_MP_TAC VSUBST_HAS_TYPE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `welltyped p` ASSUME_TAC THENL + [ASM_MESON_TAC[welltyped; ALL]; ALL_TAC] THEN + ASM_SIMP_TAC[SEMANTICS_VSUBST] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[TERM_VALUATION_ITLIST] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ALL_MAP]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN + X_GEN_TAC `a:term` THEN DISCH_TAC THEN + SUBGOAL_THEN `welltyped a` MP_TAC THENL + [ASM_MESON_TAC[ALL_MEM; MEM; welltyped]; ALL_TAC] THEN + ASM_SIMP_TAC[SEMANTICS_VSUBST; o_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Lemma about typesets to simplify some later goals. *) +(* ------------------------------------------------------------------------- *) + +let TYPESET_LEMMA = prove + (`!ty tau tyin. + typeset (\s. typeset tau (REV_ASSOCD (Tyvar s) tyin (Tyvar s))) ty = + typeset tau (TYPE_SUBST tyin ty)`, + MATCH_MP_TAC type_INDUCT THEN SIMP_TAC[typeset; TYPE_SUBST]);; + +(* ------------------------------------------------------------------------- *) +(* Semantics of type instantiation core. *) +(* ------------------------------------------------------------------------- *) + +let SEMANTICS_INST_CORE = prove + (`!n tm env tyin. + welltyped tm /\ (sizeof tm = n) /\ + (!s s'. MEM (s,s') env + ==> ?x ty. (s = Var x ty) /\ + (s' = Var x (TYPE_SUBST tyin ty))) + ==> (?x ty. (INST_CORE env tyin tm = + Clash(Var x (TYPE_SUBST tyin ty))) /\ + VFREE_IN (Var x ty) tm /\ + ~(REV_ASSOCD (Var x (TYPE_SUBST tyin ty)) + env (Var x ty) = Var x ty)) \/ + (!x ty. VFREE_IN (Var x ty) tm + ==> (REV_ASSOCD (Var x (TYPE_SUBST tyin ty)) + env (Var x ty) = Var x ty)) /\ + (?tm'. (INST_CORE env tyin tm = Result tm') /\ + tm' has_type (TYPE_SUBST tyin (typeof tm)) /\ + (!u uty. VFREE_IN (Var u uty) tm' <=> + ?oty. VFREE_IN (Var u oty) tm /\ + (uty = TYPE_SUBST tyin oty)) /\ + !sigma tau. + type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau tm' = + semantics + (\(x,ty). sigma(x,TYPE_SUBST tyin ty)) + (\s. typeset tau (TYPE_SUBST tyin (Tyvar s))) + tm))`, + MATCH_MP_TAC num_WF THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC term_INDUCT THEN + ONCE_REWRITE_TAC[INST_CORE] THEN REWRITE_TAC[semantics] THEN + REPEAT CONJ_TAC THENL + [POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[REV_ASSOCD; LET_DEF; LET_END_DEF] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[result_DISTINCT; result_INJ; UNWIND_THM1] THEN + REWRITE_TAC[typeof; has_type_RULES] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[RESULT; semantics; VFREE_IN; term_INJ] THEN ASM_MESON_TAC[]; + POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[TYPE_SUBST; RESULT; VFREE_IN; term_DISTINCT] THEN + ASM_REWRITE_TAC[result_DISTINCT; result_INJ; UNWIND_THM1] THEN + REWRITE_TAC[typeof; has_type_RULES; TYPE_SUBST; VFREE_IN] THEN + REWRITE_TAC[semantics; typeset; TYPESET_LEMMA; TYPE_SUBST; term_DISTINCT]; + POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[TYPE_SUBST; RESULT; VFREE_IN; term_DISTINCT] THEN + ASM_REWRITE_TAC[result_DISTINCT; result_INJ; UNWIND_THM1] THEN + REWRITE_TAC[typeof; has_type_RULES; TYPE_SUBST; VFREE_IN] THEN + REWRITE_TAC[semantics; typeset; TYPESET_LEMMA; TYPE_SUBST; term_DISTINCT]; + MAP_EVERY X_GEN_TAC [`s:term`; `t:term`] THEN DISCH_THEN(K ALL_TAC) THEN + POP_ASSUM MP_TAC THEN ASM_CASES_TAC `n = sizeof(Comb s t)` THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `sizeof t` th) THEN + MP_TAC(SPEC `sizeof s` th)) THEN + REWRITE_TAC[sizeof; ARITH_RULE `s < 1 + s + t /\ t < 1 + s + t`] THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o SPEC `t:term`) THEN + MP_TAC(SPEC `s:term` th)) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM; WELLTYPED_CLAUSES] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC I [IMP_CONJ] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN + DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; IS_CLASH; VFREE_IN]; + ALL_TAC] THEN + REWRITE_TAC[TYPE_SUBST] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s':term` STRIP_ASSUME_TAC) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[LET_DEF; LET_END_DEF; IS_CLASH; VFREE_IN]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t':term` STRIP_ASSUME_TAC) THEN + DISJ2_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[VFREE_IN] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `Comb s' t'` THEN + ASM_SIMP_TAC[LET_DEF; LET_END_DEF; IS_CLASH; semantics; RESULT] THEN + ASM_REWRITE_TAC[VFREE_IN] THEN + ASM_REWRITE_TAC[typeof] THEN ONCE_REWRITE_TAC[has_type_CASES] THEN + REWRITE_TAC[term_DISTINCT; term_INJ; codomain] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN + DISCH_THEN(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN + ASM_CASES_TAC `n = sizeof (Abs x ty t)` THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[WELLTYPED_CLAUSES] THEN STRIP_TAC THEN REPEAT LET_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `sizeof t`) THEN + REWRITE_TAC[sizeof; ARITH_RULE `t < 2 + t`] THEN + DISCH_THEN(MP_TAC o SPECL + [`t:term`; `env':(term#term)list`; `tyin:(type#type)list`]) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [EXPAND_TAC "env'" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [ALL_TAC; + FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t':term` STRIP_ASSUME_TAC) THEN + DISJ2_TAC THEN ASM_REWRITE_TAC[IS_RESULT] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o check (is_imp o concl))) THEN + EXPAND_TAC "env'" THEN + REWRITE_TAC[VFREE_IN; REV_ASSOCD; term_INJ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[term_INJ] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[result_INJ; UNWIND_THM1; RESULT] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (b ==> c) ==> b /\ a /\ c`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[VFREE_IN; term_INJ] THEN + MAP_EVERY X_GEN_TAC [`u:string`; `uty:type`] THEN + ASM_CASES_TAC `u:string = x` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_THEN `u:string = x` SUBST_ALL_TAC THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `oty:type` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `uty = TYPE_SUBST tyin oty` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `VFREE_IN (Var x oty) t` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`x:string`; `oty:type`] th) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN NO_TAC; ALL_TAC]) THEN + EXPAND_TAC "env'" THEN REWRITE_TAC[REV_ASSOCD] THEN + ASM_MESON_TAC[term_INJ]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[typeof; TYPE_SUBST] THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[has_type_RULES]; + ALL_TAC] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[semantics] THEN + ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN + MATCH_MP_TAC ABSTRACT_EQ THEN + CONJ_TAC THENL [ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN + X_GEN_TAC `a:V` THEN REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SEMANTICS_TYPESET THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + ASM_MESON_TAC[welltyped; WELLTYPED]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN CONJ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SEMANTICS_TYPESET THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(x,ty' |-> a) (sigma:(string#type)->V)`; `tau:string->V`]) THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM(CONJUNCT1 TYPE_SUBST)] THEN + MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN CONJ_TAC THENL + [REWRITE_TAC[type_valuation] THEN ASM_SIMP_TAC[TYPESET_INHABITED]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[term_valuation] THEN + MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[VALMOD; PAIR_EQ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN + ASM_MESON_TAC[term_valuation]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[term_valuation] THEN + MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN + REWRITE_TAC[VALMOD] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[VALMOD; PAIR_EQ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN + ASM_MESON_TAC[term_valuation]; + ALL_TAC] THEN + UNDISCH_THEN + `!u uty. + VFREE_IN (Var u uty) t' <=> + (?oty. VFREE_IN (Var u oty) t /\ (uty = TYPE_SUBST tyin oty))` + (K ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[VALMOD] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ASM_CASES_TAC `y:string = x` THEN ASM_REWRITE_TAC[PAIR_EQ] THEN + ASM_CASES_TAC `yty:type = ty` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_THEN `y:string = x` SUBST_ALL_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:string`; `yty:type`]) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "env'" THEN + ASM_REWRITE_TAC[REV_ASSOCD; term_INJ]] THEN + DISCH_THEN(X_CHOOSE_THEN `z:string` (X_CHOOSE_THEN `zty:type` + (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC))) THEN + EXPAND_TAC "w" THEN REWRITE_TAC[CLASH; IS_RESULT; term_INJ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN + DISCH_THEN(fun th -> + DISJ1_TAC THEN REWRITE_TAC[result_INJ] THEN + MAP_EVERY EXISTS_TAC [`z:string`; `zty:type`] THEN + MP_TAC th) THEN + ASM_REWRITE_TAC[VFREE_IN; term_INJ] THEN + EXPAND_TAC "env'" THEN ASM_REWRITE_TAC[REV_ASSOCD; term_INJ] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[INST_CORE] THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[letlemma] THEN + ABBREV_TAC `env'' = CONS (Var x' ty,Var x' ty') env` THEN + ONCE_REWRITE_TAC[letlemma] THEN + ABBREV_TAC + `ures = INST_CORE env'' tyin (VSUBST[Var x' ty,Var x ty] t)` THEN + ONCE_REWRITE_TAC[letlemma] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `sizeof t`) THEN + REWRITE_TAC[sizeof; ARITH_RULE `t < 2 + t`] THEN + DISCH_THEN(fun th -> + MP_TAC(SPECL [`VSUBST [Var x' ty,Var x ty] t`; + `env'':(term#term)list`; `tyin:(type#type)list`] th) THEN + MP_TAC(SPECL [`t:term`; `[]:(term#term)list`; `tyin:(type#type)list`] + th)) THEN + REWRITE_TAC[MEM; REV_ASSOCD] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t':term` MP_TAC) THEN STRIP_TAC THEN + UNDISCH_TAC `VARIANT (RESULT (INST_CORE [] tyin t)) x ty' = x'` THEN + ASM_REWRITE_TAC[RESULT] THEN DISCH_TAC THEN + MP_TAC(SPECL [`t':term`; `x:string`; `ty':type`] VARIANT) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC VSUBST_WELLTYPED THEN ASM_REWRITE_TAC[MEM; PAIR_EQ] THEN + ASM_MESON_TAC[has_type_RULES]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SIZEOF_VSUBST THEN + ASM_REWRITE_TAC[MEM; PAIR_EQ] THEN ASM_MESON_TAC[has_type_RULES]; + ALL_TAC] THEN + EXPAND_TAC "env''" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:string` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `vty:type` THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN + ASM_REWRITE_TAC[IS_RESULT; CLASH] THEN + ONCE_REWRITE_TAC[letlemma] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[VFREE_IN_VSUBST] THEN EXPAND_TAC "env''" THEN + REWRITE_TAC[REV_ASSOCD] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[term_INJ] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN MP_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VFREE_IN; term_INJ] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [term_INJ]) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + EXPAND_TAC "env''" THEN REWRITE_TAC[REV_ASSOCD] THEN + ASM_CASES_TAC `vty:type = ty` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[VFREE_IN_VSUBST; NOT_EXISTS_THM; REV_ASSOCD] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN; term_INJ] THEN + MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN + MP_TAC(SPECL [`t':term`; `x:string`; `ty':type`] VARIANT) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `t'':term` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IS_RESULT; result_INJ; UNWIND_THM1; result_DISTINCT] THEN + REWRITE_TAC[RESULT] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> c /\ a /\ d) ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[typeof; TYPE_SUBST] THEN + MATCH_MP_TAC(last(CONJUNCTS has_type_RULES)) THEN + SUBGOAL_THEN `(VSUBST [Var x' ty,Var x ty] t) has_type (typeof t)` + (fun th -> ASM_MESON_TAC[th; WELLTYPED_LEMMA]) THEN + MATCH_MP_TAC VSUBST_HAS_TYPE THEN ASM_REWRITE_TAC[GSYM WELLTYPED] THEN + REWRITE_TAC[MEM; PAIR_EQ] THEN MESON_TAC[has_type_RULES]; + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[VFREE_IN] THEN + MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN + ASM_REWRITE_TAC[VFREE_IN_VSUBST; REV_ASSOCD] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN; term_INJ] THEN + SIMP_TAC[] THEN + REWRITE_TAC[TAUT `x /\ (if p then a /\ b else c /\ b) <=> + b /\ x /\ (if p then a else c)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[TAUT `x /\ (if p /\ q then a else b) <=> + p /\ q /\ a /\ x \/ b /\ ~(p /\ q) /\ x`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM1; UNWIND_THM2] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN + REWRITE_TAC[VFREE_IN] THEN STRIP_TAC THEN + UNDISCH_TAC `!x'' ty'. + VFREE_IN (Var x'' ty') (VSUBST [Var x' ty,Var x ty] t) + ==> (REV_ASSOCD (Var x'' (TYPE_SUBST tyin ty')) env'' + (Var x'' ty') = Var x'' ty')` THEN + DISCH_THEN(MP_TAC o SPECL [`k:string`; `kty:type`]) THEN + REWRITE_TAC[VFREE_IN_VSUBST; REV_ASSOCD] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN] THEN + REWRITE_TAC[VFREE_IN; term_INJ] THEN + SIMP_TAC[] THEN + REWRITE_TAC[TAUT `x /\ (if p then a /\ b else c /\ b) <=> + b /\ x /\ (if p then a else c)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[TAUT `x /\ (if p /\ q then a else b) <=> + p /\ q /\ a /\ x \/ b /\ ~(p /\ q) /\ x`] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM1; UNWIND_THM2] THEN + UNDISCH_TAC `~(Var x ty = Var k kty)` THEN + REWRITE_TAC[term_INJ] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "env''" THEN REWRITE_TAC[REV_ASSOCD] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[semantics] THEN + REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ABSTRACT_EQ THEN + CONJ_TAC THENL [ASM_SIMP_TAC[TYPESET_INHABITED]; ALL_TAC] THEN + X_GEN_TAC `a:V` THEN REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SEMANTICS_TYPESET THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + ASM_MESON_TAC[welltyped; WELLTYPED]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN CONJ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SEMANTICS_TYPESET THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN + SUBGOAL_THEN `(VSUBST [Var x' ty,Var x ty] t) has_type (typeof t)` + (fun th -> ASM_MESON_TAC[th; WELLTYPED_LEMMA]) THEN + MATCH_MP_TAC VSUBST_HAS_TYPE THEN ASM_REWRITE_TAC[GSYM WELLTYPED] THEN + REWRITE_TAC[MEM; PAIR_EQ] THEN MESON_TAC[has_type_RULES]; + ALL_TAC] THEN + W(fun (asl,w) -> FIRST_X_ASSUM(fun th -> + MP_TAC(PART_MATCH (lhand o rand) th (lhand w)))) THEN + ASM_SIMP_TAC[TERM_VALUATION_VALMOD] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM(CONJUNCT1 TYPE_SUBST)] THEN + MP_TAC SEMANTICS_VSUBST THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + DISCH_THEN(fun th -> + W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) th (lhand w)))) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[MEM; PAIR_EQ] THEN CONJ_TAC THENL + [MESON_TAC[has_type_RULES]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[type_valuation] THEN ASM_SIMP_TAC[TYPESET_INHABITED]; + ALL_TAC] THEN + REWRITE_TAC[term_valuation] THEN + MAP_EVERY X_GEN_TAC [`y:string`; `yty:type`] THEN + REWRITE_TAC[VALMOD] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[VALMOD; PAIR_EQ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN + ASM_MESON_TAC[term_valuation]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM(CONJUNCT1 TYPE_SUBST)] THEN + MATCH_MP_TAC TERM_VALUATION_VFREE_IN THEN CONJ_TAC THENL + [REWRITE_TAC[type_valuation] THEN ASM_SIMP_TAC[TYPESET_INHABITED]; + ALL_TAC] THEN + REWRITE_TAC[ITLIST] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[DEST_VAR] THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + REWRITE_TAC[term_valuation; semantics] THEN + MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN + REWRITE_TAC[VALMOD] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[TYPESET_LEMMA; TYPE_SUBST] THEN + SIMP_TAC[PAIR_EQ] THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[term_valuation]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`k:string`; `kty:type`] THEN DISCH_TAC THEN + REWRITE_TAC[VALMOD; semantics] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + SIMP_TAC[PAIR_EQ] THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* So in particular, we get key properties of INST itself. *) +(* ------------------------------------------------------------------------- *) + +let SEMANTICS_INST = prove + (`!tyin tm. + welltyped tm + ==> (INST tyin tm) has_type (TYPE_SUBST tyin (typeof tm)) /\ + (!u uty. VFREE_IN (Var u uty) (INST tyin tm) <=> + ?oty. VFREE_IN (Var u oty) tm /\ + (uty = TYPE_SUBST tyin oty)) /\ + !sigma tau. + type_valuation tau /\ term_valuation tau sigma + ==> (semantics sigma tau (INST tyin tm) = + semantics + (\(x,ty). sigma(x,TYPE_SUBST tyin ty)) + (\s. typeset tau (TYPE_SUBST tyin (Tyvar s))) tm)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`sizeof tm`; `tm:term`; `[]:(term#term)list`; + `tyin:(type#type)list`] SEMANTICS_INST_CORE) THEN + ASM_REWRITE_TAC[MEM; INST_DEF; REV_ASSOCD] THEN MESON_TAC[RESULT]);; + +(* ------------------------------------------------------------------------- *) +(* Hence soundness of the INST_TYPE rule. *) +(* ------------------------------------------------------------------------- *) + +let INST_TYPE_correct = prove + (`!tyin asl p. asl |= p ==> MAP (INST tyin) asl |= INST tyin p`, + REWRITE_TAC[sequent] THEN REPEAT STRIP_TAC THENL + [UNDISCH_TAC `ALL (\a. a has_type Bool) (CONS p asl)` THEN + REWRITE_TAC[ALL; ALL_MAP] THEN MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_THM]] THEN + ASM_MESON_TAC[SEMANTICS_INST; TYPE_SUBST; welltyped; WELLTYPED; + WELLTYPED_LEMMA]; + ALL_TAC] THEN + SUBGOAL_THEN `welltyped p` ASSUME_TAC THENL + [ASM_MESON_TAC[welltyped; ALL]; ALL_TAC] THEN + ASM_SIMP_TAC[SEMANTICS_INST] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[type_valuation] THEN ASM_MESON_TAC[TYPESET_INHABITED]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[term_valuation] THEN + REWRITE_TAC[TYPE_SUBST; TYPESET_LEMMA] THEN + ASM_MESON_TAC[term_valuation]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ALL_MAP]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ALL_IMP) THEN + X_GEN_TAC `a:term` THEN DISCH_TAC THEN + SUBGOAL_THEN `welltyped a` MP_TAC THENL + [ASM_MESON_TAC[ALL_MEM; MEM; welltyped]; ALL_TAC] THEN + ASM_SIMP_TAC[SEMANTICS_INST; o_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Soundness. *) +(* ------------------------------------------------------------------------- *) + +let HOL_IS_SOUND = prove + (`!asl p. asl |- p ==> asl |= p`, + MATCH_MP_TAC proves_INDUCT THEN + REWRITE_TAC[REFL_correct; TRANS_correct; ABS_correct; + BETA_correct; ASSUME_correct; EQ_MP_correct; INST_TYPE_correct; + REWRITE_RULE[LET_DEF; LET_END_DEF] DEDUCT_ANTISYM_RULE_correct; + REWRITE_RULE[IMP_IMP] INST_correct] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MK_COMB_correct THEN + ASM_MESON_TAC[WELLTYPED_CLAUSES; MK_COMB_correct]);; + +(* ------------------------------------------------------------------------- *) +(* Consistency. *) +(* ------------------------------------------------------------------------- *) + +let HOL_IS_CONSISTENT = prove + (`?p. p has_type Bool /\ ~([] |- p)`, + SUBGOAL_THEN `?p. p has_type Bool /\ ~([] |= p)` + (fun th -> MESON_TAC[th; HOL_IS_SOUND]) THEN + EXISTS_TAC `Var x Bool === Var (VARIANT (Var x Bool) x Bool) Bool` THEN + SIMP_TAC[EQUATION_HAS_TYPE_BOOL; WELLTYPED_CLAUSES; typeof; + sequent; ALL; SEMANTICS_EQUATION; has_type_RULES; semantics; + BOOLEAN_EQ_TRUE] THEN + MP_TAC(SPECL [`Var x Bool`; `x:string`; `Bool`] VARIANT) THEN + ABBREV_TAC `y = VARIANT (Var x Bool) x Bool` THEN + REWRITE_TAC[VFREE_IN; term_INJ; NOT_FORALL_THM] THEN DISCH_TAC THEN + EXISTS_TAC `((x:string,Bool) |-> false) (((y,Bool) |-> true) + (\(x,ty). @a. a <: typeset (\x. boolset) ty))` THEN + EXISTS_TAC `\x:string. boolset` THEN + ASM_REWRITE_TAC[type_valuation; VALMOD; PAIR_EQ; TRUE_NE_FALSE] THEN + CONJ_TAC THENL [MESON_TAC[IN_BOOL]; ALL_TAC] THEN + REWRITE_TAC[term_valuation] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[VALMOD; PAIR_EQ] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[typeset; IN_BOOL]) THEN + CONV_TAC SELECT_CONV THEN MATCH_MP_TAC TYPESET_INHABITED THEN + REWRITE_TAC[type_valuation] THEN MESON_TAC[IN_BOOL]);; diff --git a/Model/syntax.ml b/Model/syntax.ml new file mode 100644 index 0000000..0d35305 --- /dev/null +++ b/Model/syntax.ml @@ -0,0 +1,648 @@ +(* ========================================================================= *) +(* Syntactic definitions for "core HOL", including provability. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* HOL types. Just do the primitive ones for now. *) +(* ------------------------------------------------------------------------- *) + +let type_INDUCT,type_RECURSION = define_type + "type = Tyvar string + | Bool + | Ind + | Fun type type";; + +let type_DISTINCT = distinctness "type";; + +let type_INJ = injectivity "type";; + +let domain = define + `domain (Fun s t) = s`;; + +let codomain = define + `codomain (Fun s t) = t`;; + +(* ------------------------------------------------------------------------- *) +(* HOL terms. To avoid messing round with specification of the language, *) +(* we just put "=" and "@" in as the only constants. For now... *) +(* ------------------------------------------------------------------------- *) + +let term_INDUCT,term_RECURSION = define_type + "term = Var string type + | Equal type | Select type + | Comb term term + | Abs string type term";; + +let term_DISTINCT = distinctness "term";; + +let term_INJ = injectivity "term";; + +(* ------------------------------------------------------------------------- *) +(* Typing judgements. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_type",(12,"right"));; + +let has_type_RULES,has_type_INDUCT,has_type_CASES = new_inductive_definition + `(!n ty. (Var n ty) has_type ty) /\ + (!ty. (Equal ty) has_type (Fun ty (Fun ty Bool))) /\ + (!ty. (Select ty) has_type (Fun (Fun ty Bool) ty)) /\ + (!s t dty rty. s has_type (Fun dty rty) /\ t has_type dty + ==> (Comb s t) has_type rty) /\ + (!n dty t rty. t has_type rty ==> (Abs n dty t) has_type (Fun dty rty))`;; + +let welltyped = new_definition + `welltyped tm <=> ?ty. tm has_type ty`;; + +let typeof = define + `(typeof (Var n ty) = ty) /\ + (typeof (Equal ty) = Fun ty (Fun ty Bool)) /\ + (typeof (Select ty) = Fun (Fun ty Bool) ty) /\ + (typeof (Comb s t) = codomain (typeof s)) /\ + (typeof (Abs n ty t) = Fun ty (typeof t))`;; + +let WELLTYPED_LEMMA = prove + (`!tm ty. tm has_type ty ==> (typeof tm = ty)`, + MATCH_MP_TAC has_type_INDUCT THEN + SIMP_TAC[typeof; has_type_RULES; codomain]);; + +let WELLTYPED = prove + (`!tm. welltyped tm <=> tm has_type (typeof tm)`, + REWRITE_TAC[welltyped] THEN MESON_TAC[WELLTYPED_LEMMA]);; + +let WELLTYPED_CLAUSES = prove + (`(!n ty. welltyped(Var n ty)) /\ + (!ty. welltyped(Equal ty)) /\ + (!ty. welltyped(Select ty)) /\ + (!s t. welltyped (Comb s t) <=> + welltyped s /\ welltyped t /\ + ?rty. typeof s = Fun (typeof t) rty) /\ + (!n ty t. welltyped (Abs n ty t) = welltyped t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[welltyped] THEN + (GEN_REWRITE_TAC BINDER_CONV [has_type_CASES] ORELSE + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [has_type_CASES]) THEN + REWRITE_TAC[term_INJ; term_DISTINCT] THEN + MESON_TAC[WELLTYPED; WELLTYPED_LEMMA]);; + +(* ------------------------------------------------------------------------- *) +(* Since equations are important, a bit of derived syntax. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("===",(18,"right"));; + +let equation = new_definition + `(s === t) = Comb (Comb (Equal(typeof s)) s) t`;; + +let EQUATION_HAS_TYPE_BOOL = prove + (`!s t. (s === t) has_type Bool + <=> welltyped s /\ welltyped t /\ (typeof s = typeof t)`, + REWRITE_TAC[equation] THEN + ONCE_REWRITE_TAC[has_type_CASES] THEN + REWRITE_TAC[term_DISTINCT; term_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[UNWIND_THM1] THEN REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o LAND_CONV) [has_type_CASES] THEN + REWRITE_TAC[term_DISTINCT; term_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[UNWIND_THM1] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2(BINDER_CONV o LAND_CONV)) + [has_type_CASES] THEN + REWRITE_TAC[term_DISTINCT; term_INJ; type_INJ] THEN + MESON_TAC[WELLTYPED; WELLTYPED_LEMMA]);; + +(* ------------------------------------------------------------------------- *) +(* Alpha-conversion. *) +(* ------------------------------------------------------------------------- *) + +let ALPHAVARS = define + `(ALPHAVARS [] tmp <=> (FST tmp = SND tmp)) /\ + (ALPHAVARS (CONS tp oenv) tmp <=> + (tmp = tp) \/ + ~(FST tp = FST tmp) /\ ~(SND tp = SND tmp) /\ ALPHAVARS oenv tmp)`;; + +let RACONV_RULES,RACONV_INDUCT,RACONV_CASES = new_inductive_definition + `(!env x1 ty1 x2 ty2. + ALPHAVARS env (Var x1 ty1,Var x2 ty2) + ==> RACONV env (Var x1 ty1,Var x2 ty2)) /\ + (!env ty. RACONV env (Equal ty,Equal ty)) /\ + (!env ty. RACONV env (Select ty,Select ty)) /\ + (!env s1 t1 s2 t2. + RACONV env (s1,s2) /\ RACONV env (t1,t2) + ==> RACONV env (Comb s1 t1,Comb s2 t2)) /\ + (!env x1 ty1 t1 x2 ty2 t2. + (ty1 = ty2) /\ RACONV (CONS ((Var x1 ty1),(Var x2 ty2)) env) (t1,t2) + ==> RACONV env (Abs x1 ty1 t1,Abs x2 ty2 t2))`;; + +let RACONV = prove + (`(RACONV env (Var x1 ty1,Var x2 ty2) <=> + ALPHAVARS env (Var x1 ty1,Var x2 ty2)) /\ + (RACONV env (Var x1 ty1,Equal ty2) <=> F) /\ + (RACONV env (Var x1 ty1,Select ty2) <=> F) /\ + (RACONV env (Var x1 ty1,Comb l2 r2) <=> F) /\ + (RACONV env (Var x1 ty1,Abs x2 ty2 t2) <=> F) /\ + (RACONV env (Equal ty1,Var x2 ty2) <=> F) /\ + (RACONV env (Equal ty1,Equal ty2) <=> (ty1 = ty2)) /\ + (RACONV env (Equal ty1,Select ty2) <=> F) /\ + (RACONV env (Equal ty1,Comb l2 r2) <=> F) /\ + (RACONV env (Equal ty1,Abs x2 ty2 t2) <=> F) /\ + (RACONV env (Select ty1,Var x2 ty2) <=> F) /\ + (RACONV env (Select ty1,Equal ty2) <=> F) /\ + (RACONV env (Select ty1,Select ty2) <=> (ty1 = ty2)) /\ + (RACONV env (Select ty1,Comb l2 r2) <=> F) /\ + (RACONV env (Select ty1,Abs x2 ty2 t2) <=> F) /\ + (RACONV env (Comb l1 r1,Var x2 ty2) <=> F) /\ + (RACONV env (Comb l1 r1,Equal ty2) <=> F) /\ + (RACONV env (Comb l1 r1,Select ty2) <=> F) /\ + (RACONV env (Comb l1 r1,Comb l2 r2) <=> + RACONV env (l1,l2) /\ RACONV env (r1,r2)) /\ + (RACONV env (Comb l1 r1,Abs x2 ty2 t2) <=> F) /\ + (RACONV env (Abs x1 ty1 t1,Var x2 ty2) <=> F) /\ + (RACONV env (Abs x1 ty1 t1,Equal ty2) <=> F) /\ + (RACONV env (Abs x1 ty1 t1,Select ty2) <=> F) /\ + (RACONV env (Abs x1 ty1 t1,Comb l2 r2) <=> F) /\ + (RACONV env (Abs x1 ty1 t1,Abs x2 ty2 t2) <=> + (ty1 = ty2) /\ RACONV (CONS (Var x1 ty1,Var x2 ty2) env) (t1,t2))`, + REPEAT CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [RACONV_CASES] THEN + REWRITE_TAC[term_INJ; term_DISTINCT; PAIR_EQ] THEN MESON_TAC[]);; + +let ACONV = new_definition + `ACONV t1 t2 <=> RACONV [] (t1,t2)`;; + +(* ------------------------------------------------------------------------- *) +(* Reflexivity. *) +(* ------------------------------------------------------------------------- *) + +let ALPHAVARS_REFL = prove + (`!env t. ALL (\(s,t). s = t) env ==> ALPHAVARS env (t,t)`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; ALPHAVARS] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[PAIR_EQ]);; + +let RACONV_REFL = prove + (`!t env. ALL (\(s,t). s = t) env ==> RACONV env (t,t)`, + MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[RACONV] THEN REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[ALPHAVARS_REFL]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ALL] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]]);; + +let ACONV_REFL = prove + (`!t. ACONV t t`, + REWRITE_TAC[ACONV] THEN SIMP_TAC[RACONV_REFL; ALL]);; + +(* ------------------------------------------------------------------------- *) +(* Alpha-convertible terms have the same type (if welltyped). *) +(* ------------------------------------------------------------------------- *) + +let ALPHAVARS_TYPE = prove + (`!env s t. ALPHAVARS env (s,t) /\ + ALL (\(x,y). welltyped x /\ welltyped y /\ + (typeof x = typeof y)) env /\ + welltyped s /\ welltyped t + ==> (typeof s = typeof t)`, + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[FORALL_PAIR_THM; ALPHAVARS; ALL; PAIR_EQ] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + CONJ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[]);; + +let RACONV_TYPE = prove + (`!env p. RACONV env p + ==> ALL (\(x,y). welltyped x /\ welltyped y /\ + (typeof x = typeof y)) env /\ + welltyped (FST p) /\ welltyped (SND p) + ==> (typeof (FST p) = typeof (SND p))`, + MATCH_MP_TAC RACONV_INDUCT THEN + REWRITE_TAC[FORALL_PAIR_THM; typeof] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[typeof; ALPHAVARS_TYPE]; + AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[WELLTYPED_CLAUSES]; + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ALL] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[typeof] THEN ASM_MESON_TAC[WELLTYPED_CLAUSES]]);; + +let ACONV_TYPE = prove + (`!s t. ACONV s t ==> welltyped s /\ welltyped t ==> (typeof s = typeof t)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`[]:(term#term)list`; `(s:term,t:term)`] RACONV_TYPE) THEN + REWRITE_TAC[ACONV; ALL] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* HOL version of "term_union". *) +(* ------------------------------------------------------------------------- *) + +let TERM_UNION = define + `(TERM_UNION [] l2 = l2) /\ + (TERM_UNION (CONS h t) l2 = + let subun = TERM_UNION t l2 in + if EX (ACONV h) subun then subun else CONS h subun)`;; + +let TERM_UNION_NONEW = prove + (`!l1 l2 x. MEM x (TERM_UNION l1 l2) ==> MEM x l1 \/ MEM x l2`, + LIST_INDUCT_TAC THEN REWRITE_TAC[TERM_UNION; MEM] THEN + LET_TAC THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[MEM] THEN ASM_MESON_TAC[ACONV_REFL]);; + +let TERM_UNION_THM = prove + (`!l1 l2 x. MEM x l1 \/ MEM x l2 + ==> ?y. MEM y (TERM_UNION l1 l2) /\ ACONV x y`, + LIST_INDUCT_TAC THEN REWRITE_TAC[TERM_UNION; MEM; GSYM EX_MEM] THENL + [MESON_TAC[ACONV_REFL]; ALL_TAC] THEN + REPEAT GEN_TAC THEN LET_TAC THEN COND_CASES_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[MEM] THEN ASM_MESON_TAC[ACONV_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Handy lemma for using it in a sequent. *) +(* ------------------------------------------------------------------------- *) + +let ALL_BOOL_TERM_UNION = prove + (`ALL (\a. a has_type Bool) l1 /\ ALL (\a. a has_type Bool) l2 + ==> ALL (\a. a has_type Bool) (TERM_UNION l1 l2)`, + REWRITE_TAC[GSYM ALL_MEM] THEN MESON_TAC[TERM_UNION_NONEW]);; + +(* ------------------------------------------------------------------------- *) +(* Whether a variable/constant is free in a term. *) +(* ------------------------------------------------------------------------- *) + +let VFREE_IN = define + `(VFREE_IN v (Var x ty) <=> (Var x ty = v)) /\ + (VFREE_IN v (Equal ty) <=> (Equal ty = v)) /\ + (VFREE_IN v (Select ty) <=> (Select ty = v)) /\ + (VFREE_IN v (Comb s t) <=> VFREE_IN v s \/ VFREE_IN v t) /\ + (VFREE_IN v (Abs x ty t) <=> ~(Var x ty = v) /\ VFREE_IN v t)`;; + +let VFREE_IN_RACONV = prove + (`!env p. RACONV env p + ==> !x ty. VFREE_IN (Var x ty) (FST p) /\ + ~(?y. MEM (Var x ty,y) env) <=> + VFREE_IN (Var x ty) (SND p) /\ + ~(?y. MEM (y,Var x ty) env)`, + MATCH_MP_TAC RACONV_INDUCT THEN REWRITE_TAC[VFREE_IN; term_DISTINCT] THEN + REWRITE_TAC[PAIR_EQ; term_INJ; MEM] THEN CONJ_TAC THENL + [ALL_TAC; MESON_TAC[]] THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALPHAVARS] THEN + REWRITE_TAC[MEM; FORALL_PAIR_THM; term_INJ; PAIR_EQ] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REPEAT GEN_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MESON_TAC[]);; + +let VFREE_IN_ACONV = prove + (`!s t x t. ACONV s t ==> (VFREE_IN (Var x ty) s <=> VFREE_IN (Var x ty) t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[ACONV] THEN + DISCH_THEN(MP_TAC o MATCH_MP VFREE_IN_RACONV) THEN + SIMP_TAC[MEM; FST; SND]);; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary association list function. *) +(* ------------------------------------------------------------------------- *) + +let REV_ASSOCD = define + `(REV_ASSOCD a [] d = d) /\ + (REV_ASSOCD a (CONS (x,y) t) d = + if y = a then x else REV_ASSOCD a t d)`;; + +(* ------------------------------------------------------------------------- *) +(* Substition of types in types. *) +(* ------------------------------------------------------------------------- *) + +let TYPE_SUBST = define + `(TYPE_SUBST i (Tyvar v) = REV_ASSOCD (Tyvar v) i (Tyvar v)) /\ + (TYPE_SUBST i Bool = Bool) /\ + (TYPE_SUBST i Ind = Ind) /\ + (TYPE_SUBST i (Fun ty1 ty2) = Fun (TYPE_SUBST i ty1) (TYPE_SUBST i ty2))`;; + +(* ------------------------------------------------------------------------- *) +(* Variant function. Deliberately underspecified at the moment. In a bid to *) +(* expunge use of sets, just pick it distinct from what's free in a term. *) +(* ------------------------------------------------------------------------- *) + +let VFREE_IN_FINITE = prove + (`!t. FINITE {x | VFREE_IN x t}`, + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VFREE_IN] THEN + REWRITE_TAC[SET_RULE `{x | a = x} = {a}`; + SET_RULE `{x | P x \/ Q x} = {x | P x} UNION {x | Q x}`; + SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[FINITE_INSERT; FINITE_RULES; FINITE_UNION; FINITE_INTER]);; + +let VFREE_IN_FINITE_ALT = prove + (`!t ty. FINITE {x | VFREE_IN (Var x ty) t}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\(Var x ty). x) {x | VFREE_IN x t}` THEN + SIMP_TAC[VFREE_IN_FINITE; FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `x:string` THEN DISCH_TAC THEN + EXISTS_TAC `Var x ty` THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ASM_REWRITE_TAC[]);; + +let VARIANT_EXISTS = prove + (`!t x:string ty. ?x'. ~(VFREE_IN (Var x' ty) t)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`t:term`; `ty:type`] VFREE_IN_FINITE_ALT) THEN + DISCH_THEN(MP_TAC o CONJ string_INFINITE) THEN + DISCH_THEN(MP_TAC o MATCH_MP INFINITE_DIFF_FINITE) THEN + DISCH_THEN(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_ELIM_THM; IN_UNIV]);; + +let VARIANT = new_specification ["VARIANT"] + (PURE_REWRITE_RULE[SKOLEM_THM] VARIANT_EXISTS);; + +(* ------------------------------------------------------------------------- *) +(* Term substitution. *) +(* ------------------------------------------------------------------------- *) + +let VSUBST = define + `(VSUBST ilist (Var x ty) = REV_ASSOCD (Var x ty) ilist (Var x ty)) /\ + (VSUBST ilist (Equal ty) = Equal ty) /\ + (VSUBST ilist (Select ty) = Select ty) /\ + (VSUBST ilist (Comb s t) = Comb (VSUBST ilist s) (VSUBST ilist t)) /\ + (VSUBST ilist (Abs x ty t) = + let ilist' = FILTER (\(s',s). ~(s = Var x ty)) ilist in + let t' = VSUBST ilist' t in + if EX (\(s',s). VFREE_IN (Var x ty) s' /\ VFREE_IN s t) ilist' + then let z = VARIANT t' x ty in + let ilist'' = CONS (Var z ty,Var x ty) ilist' in + Abs z ty (VSUBST ilist'' t) + else Abs x ty t')`;; + +(* ------------------------------------------------------------------------- *) +(* Preservation of type. *) +(* ------------------------------------------------------------------------- *) + +let VSUBST_HAS_TYPE = prove + (`!tm ty ilist. + tm has_type ty /\ + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) + ==> (VSUBST ilist tm) has_type ty`, + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VSUBST] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `tty:type`] THEN + MATCH_MP_TAC list_INDUCT THEN + SIMP_TAC[REV_ASSOCD; MEM; FORALL_PAIR_THM] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; PAIR_EQ] THEN + REWRITE_TAC[ LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + ASM_CASES_TAC `(Var x ty) has_type tty` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_type_CASES]) THEN + REWRITE_TAC[term_DISTINCT; term_INJ; LEFT_EXISTS_AND_THM] THEN + REWRITE_TAC[GSYM EXISTS_REFL] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + MAP_EVERY X_GEN_TAC [`s:term`; `u:term`; `ilist:(term#term)list`] THEN + DISCH_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `y:string` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `aty:type` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_MESON_TAC[term_INJ]; + SIMP_TAC[]; + SIMP_TAC[]; + MAP_EVERY X_GEN_TAC [`s:term`; `t:term`] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_type_CASES]) THEN + REWRITE_TAC[term_DISTINCT; term_INJ; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + DISCH_THEN(X_CHOOSE_THEN `dty:type` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(el 3 (CONJUNCTS has_type_RULES)) THEN + EXISTS_TAC `dty:type` THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`fty:type`; `ilist:(term#term)list`] THEN STRIP_TAC THEN + LET_TAC THEN LET_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_type_CASES]) THEN + REWRITE_TAC[term_DISTINCT; term_INJ; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + DISCH_THEN(X_CHOOSE_THEN `rty:type` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN DISCH_TAC THEN + COND_CASES_TAC THEN REPEAT LET_TAC THEN + MATCH_MP_TAC(el 4 (CONJUNCTS has_type_RULES)) THEN + EXPAND_TAC "t'" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXPAND_TAC ["ilist''"; "ilist'"]; EXPAND_TAC "ilist'"] THEN + REWRITE_TAC[MEM; MEM_FILTER] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[has_type_RULES]);; + +let VSUBST_WELLTYPED = prove + (`!tm ty ilist. + welltyped tm /\ + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) + ==> welltyped (VSUBST ilist tm)`, + MESON_TAC[VSUBST_HAS_TYPE; welltyped]);; + +(* ------------------------------------------------------------------------- *) +(* Right set of free variables. *) +(* ------------------------------------------------------------------------- *) + +let REV_ASSOCD_FILTER = prove + (`!l:(B#A)list a b d. + REV_ASSOCD a (FILTER (\(y,x). P x) l) b = + if P a then REV_ASSOCD a l b else b`, + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[REV_ASSOCD; FILTER; COND_ID] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + MAP_EVERY X_GEN_TAC [`y:B`; `x:A`; `l:(B#A)list`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REV_ASSOCD] THEN + ASM_CASES_TAC `(P:A->bool) x` THEN ASM_REWRITE_TAC[REV_ASSOCD] THEN + ASM_MESON_TAC[]);; + +let VFREE_IN_VSUBST = prove + (`!tm u uty ilist. + VFREE_IN (Var u uty) (VSUBST ilist tm) <=> + ?y ty. VFREE_IN (Var y ty) tm /\ + VFREE_IN (Var u uty) (REV_ASSOCD (Var y ty) ilist (Var y ty))`, + MATCH_MP_TAC term_INDUCT THEN + REWRITE_TAC[VFREE_IN; VSUBST; term_DISTINCT] THEN REPEAT CONJ_TAC THENL + [MESON_TAC[term_INJ]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN LET_TAC THEN LET_TAC THEN + COND_CASES_TAC THEN REPEAT LET_TAC THEN + ASM_REWRITE_TAC[VFREE_IN] THENL + [MAP_EVERY EXPAND_TAC ["ilist''"; "ilist'"]; + EXPAND_TAC "t'" THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "ilist'"] THEN + SIMP_TAC[REV_ASSOCD; REV_ASSOCD_FILTER] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VFREE_IN] THEN + REWRITE_TAC[TAUT `(if ~b then x:bool else y) <=> (if b then y else x)`] THEN + ONCE_REWRITE_TAC[TAUT `~a /\ b <=> ~(~a ==> ~b)`] THEN + SIMP_TAC[TAUT `(if b then F else c) <=> ~b /\ c`] THEN + MATCH_MP_TAC(TAUT + `(a ==> ~c) /\ (~a ==> (b <=> c)) ==> (~(~a ==> ~b) <=> c)`) THEN + (CONJ_TAC THENL [ALL_TAC; MESON_TAC[]]) THEN + GEN_REWRITE_TAC LAND_CONV [term_INJ] THEN + DISCH_THEN(CONJUNCTS_THEN(SUBST_ALL_TAC o SYM)) THEN + REWRITE_TAC[NOT_IMP] THENL + [MP_TAC(ISPECL [`VSUBST ilist' t`; `x:string`; `ty:type`] VARIANT) THEN + ASM_REWRITE_TAC[] THEN + EXPAND_TAC "ilist'" THEN ASM_REWRITE_TAC[REV_ASSOCD_FILTER] THEN + MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EX]) THEN + EXPAND_TAC "ilist'" THEN + SPEC_TAC(`ilist:(term#term)list`,`l:(term#term)list`) THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[ALL; REV_ASSOCD; VFREE_IN] THEN + REWRITE_TAC[REV_ASSOCD; FILTER; FORALL_PAIR_THM] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[ALL] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Sum type to model exception-raising. *) +(* ------------------------------------------------------------------------- *) + +let result_INDUCT,result_RECURSION = define_type + "result = Clash term | Result term";; + +let result_INJ = injectivity "result";; + +let result_DISTINCT = distinctness "result";; + +(* ------------------------------------------------------------------------- *) +(* Discriminators and extractors. (Nicer to pattern-match...) *) +(* ------------------------------------------------------------------------- *) + +let IS_RESULT = define + `(IS_RESULT(Clash t) = F) /\ + (IS_RESULT(Result t) = T)`;; + +let IS_CLASH = define + `(IS_CLASH(Clash t) = T) /\ + (IS_CLASH(Result t) = F)`;; + +let RESULT = define + `RESULT(Result t) = t`;; + +let CLASH = define + `CLASH(Clash t) = t`;; + +(* ------------------------------------------------------------------------- *) +(* We want induction/recursion on term size next. *) +(* ------------------------------------------------------------------------- *) + +let rec sizeof = define + `(sizeof (Var x ty) = 1) /\ + (sizeof (Equal ty) = 1) /\ + (sizeof (Select ty) = 1) /\ + (sizeof (Comb s t) = 1 + sizeof s + sizeof t) /\ + (sizeof (Abs x ty t) = 2 + sizeof t)`;; + +let SIZEOF_VSUBST = prove + (`!t ilist. (!s' s. MEM (s',s) ilist ==> ?x ty. s' = Var x ty) + ==> (sizeof (VSUBST ilist t) = sizeof t)`, + MATCH_MP_TAC term_INDUCT THEN REWRITE_TAC[VSUBST; sizeof] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`] THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[MEM; REV_ASSOCD; sizeof; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`s':term`; `s:term`; `l:(term#term)list`] THEN + REWRITE_TAC[PAIR_EQ] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[sizeof]; + ALL_TAC] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:string`; `ty:type`; `t:term`] THEN + DISCH_TAC THEN X_GEN_TAC `ilist:(term#term)list` THEN DISCH_TAC THEN + LET_TAC THEN LET_TAC THEN COND_CASES_TAC THEN + REPEAT LET_TAC THEN REWRITE_TAC[sizeof; EQ_ADD_LCANCEL] THENL + [ALL_TAC; ASM_MESON_TAC[MEM_FILTER]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + EXPAND_TAC "ilist''" THEN REWRITE_TAC[MEM; PAIR_EQ] THEN + ASM_MESON_TAC[MEM_FILTER]);; + +(* ------------------------------------------------------------------------- *) +(* Prove existence of INST_CORE. *) +(* ------------------------------------------------------------------------- *) + +let INST_CORE_EXISTS = prove + (`?INST_CORE. + (!env tyin x ty. + INST_CORE env tyin (Var x ty) = + let tm = Var x ty + and tm' = Var x (TYPE_SUBST tyin ty) in + if REV_ASSOCD tm' env tm = tm then Result tm' else Clash tm') /\ + (!env tyin ty. + INST_CORE env tyin (Equal ty) = Result(Equal(TYPE_SUBST tyin ty))) /\ + (!env tyin ty. + INST_CORE env tyin (Select ty) = Result(Select(TYPE_SUBST tyin ty))) /\ + (!env tyin s t. + INST_CORE env tyin (Comb s t) = + let sres = INST_CORE env tyin s in + if IS_CLASH sres then sres else + let tres = INST_CORE env tyin t in + if IS_CLASH tres then tres else + let s' = RESULT sres and t' = RESULT tres in + Result (Comb s' t')) /\ + (!env tyin x ty t. + INST_CORE env tyin (Abs x ty t) = + let ty' = TYPE_SUBST tyin ty in + let env' = CONS (Var x ty,Var x ty') env in + let tres = INST_CORE env' tyin t in + if IS_RESULT tres then Result(Abs x ty' (RESULT tres)) else + let w = CLASH tres in + if ~(w = Var x ty') then tres else + let x' = VARIANT (RESULT(INST_CORE [] tyin t)) x ty' in + INST_CORE env tyin (Abs x' ty (VSUBST [Var x' ty,Var x ty] t)))`, + W(fun (asl,w) -> MATCH_MP_TAC(DISCH_ALL + (pure_prove_recursive_function_exists w))) THEN + EXISTS_TAC `MEASURE(\(env:(term#term)list,tyin:(type#type)list,t). + sizeof t)` THEN + REWRITE_TAC[WF_MEASURE; MEASURE_LE; MEASURE] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + SIMP_TAC[MEM; PAIR_EQ; term_INJ; RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM; + GSYM EXISTS_REFL; SIZEOF_VSUBST; LE_REFL; sizeof] THEN + REPEAT STRIP_TAC THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* So define it. *) +(* ------------------------------------------------------------------------- *) + +let INST_CORE = new_specification ["INST_CORE"] INST_CORE_EXISTS;; + +(* ------------------------------------------------------------------------- *) +(* And the overall function. *) +(* ------------------------------------------------------------------------- *) + +let INST_DEF = new_definition + `INST tyin tm = RESULT(INST_CORE [] tyin tm)`;; + +(* ------------------------------------------------------------------------- *) +(* Various misc lemmas. *) +(* ------------------------------------------------------------------------- *) + +let NOT_IS_RESULT = prove + (`!r. ~(IS_RESULT r) <=> IS_CLASH r`, + MATCH_MP_TAC result_INDUCT THEN REWRITE_TAC[IS_RESULT; IS_CLASH]);; + +let letlemma = prove + (`(let x = t in P x) = P t`, + REWRITE_TAC[LET_DEF; LET_END_DEF]);; + +(* ------------------------------------------------------------------------- *) +(* Put everything together into a deductive system. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("|-",(11,"right"));; + +let prove_RULES,proves_INDUCT,proves_CASES = new_inductive_definition + `(!t. welltyped t ==> [] |- t === t) /\ + (!asl1 asl2 l m1 m2 r. + asl1 |- l === m1 /\ asl2 |- m2 === r /\ ACONV m1 m2 + ==> TERM_UNION asl1 asl2 |- l === r) /\ + (!asl1 l1 r1 asl2 l2 r2. + asl1 |- l1 === r1 /\ asl2 |- l2 === r2 /\ welltyped(Comb l1 l2) + ==> TERM_UNION asl1 asl2 |- Comb l1 l2 === Comb r1 r2) /\ + (!asl x ty l r. + ~(EX (VFREE_IN (Var x ty)) asl) /\ asl |- l === r + ==> asl |- (Abs x ty l) === (Abs x ty r)) /\ + (!x ty t. welltyped t ==> [] |- Comb (Abs x ty t) (Var x ty) === t) /\ + (!p. p has_type Bool ==> [p] |- p) /\ + (!asl1 asl2 p q p'. + asl1 |- p === q /\ asl2 |- p' /\ ACONV p p' + ==> TERM_UNION asl1 asl2 |- q) /\ + (!asl1 asl2 c1 c2. + asl1 |- c1 /\ asl2 |- c2 + ==> TERM_UNION (FILTER((~) o ACONV c2) asl1) + (FILTER((~) o ACONV c1) asl2) + |- c1 === c2) /\ + (!tyin asl p. asl |- p ==> MAP (INST tyin) asl |- INST tyin p) /\ + (!ilist asl p. + (!s s'. MEM (s',s) ilist ==> ?x ty. (s = Var x ty) /\ s' has_type ty) /\ + asl |- p ==> MAP (VSUBST ilist) asl |- VSUBST ilist p)`;; diff --git a/Multivariate/canal.ml b/Multivariate/canal.ml new file mode 100644 index 0000000..04183a0 --- /dev/null +++ b/Multivariate/canal.ml @@ -0,0 +1,3760 @@ +(* ========================================================================= *) +(* Complex analysis. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* (c) Copyright, Marco Maggesi, Graziano Gentili and Gianni Ciolli, 2008. *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "Library/floor.ml";; +needs "Library/iter.ml";; +needs "Multivariate/complexes.ml";; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* Some toplogical facts formulated for the complex numbers. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_HALFSPACE_RE_GE = prove + (`!b. closed {z | Re(z) >= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CLOSED_HALFSPACE_GE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[RE_CX; IM_CX; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CLOSED_HALFSPACE_RE_LE = prove + (`!b. closed {z | Re(z) <= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CLOSED_HALFSPACE_LE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[RE_CX; IM_CX; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CLOSED_HALFSPACE_RE_EQ = prove + (`!b. closed {z | Re(z) = b}`, + GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x = y <=> x >= y /\ x <= y`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_RE_GE; CLOSED_HALFSPACE_RE_LE]);; + +let OPEN_HALFSPACE_RE_GT = prove + (`!b. open {z | Re(z) > b}`, + REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_RE_LE; + REAL_ARITH `x > y <=> ~(x <= y)`; + SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; + +let OPEN_HALFSPACE_RE_LT = prove + (`!b. open {z | Re(z) < b}`, + REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_RE_GE; + REAL_ARITH `x < y <=> ~(x >= y)`; + SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; + +let CLOSED_HALFSPACE_IM_GE = prove + (`!b. closed {z | Im(z) >= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CLOSED_HALFSPACE_GE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CLOSED_HALFSPACE_IM_LE = prove + (`!b. closed {z | Im(z) <= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CLOSED_HALFSPACE_LE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CLOSED_HALFSPACE_IM_EQ = prove + (`!b. closed {z | Im(z) = b}`, + GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x = y <=> x >= y /\ x <= y`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_IM_GE; CLOSED_HALFSPACE_IM_LE]);; + +let OPEN_HALFSPACE_IM_GT = prove + (`!b. open {z | Im(z) > b}`, + REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_IM_LE; + REAL_ARITH `x > y <=> ~(x <= y)`; + SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; + +let OPEN_HALFSPACE_IM_LT = prove + (`!b. open {z | Im(z) < b}`, + REWRITE_TAC[OPEN_CLOSED; CLOSED_HALFSPACE_IM_GE; + REAL_ARITH `x < y <=> ~(x >= y)`; + SET_RULE `UNIV DIFF {x | ~p x} = {x | p x}`]);; + +let CONVEX_HALFSPACE_RE_GE = prove + (`!b. convex {z | Re(z) >= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_GE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_RE_GT = prove + (`!b. convex {z | Re(z) > b}`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_GT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_RE_LE = prove + (`!b. convex {z | Re(z) <= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_LE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_RE_LT = prove + (`!b. convex {z | Re(z) < b}`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `b:real`] CONVEX_HALFSPACE_LT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_IM_GE = prove + (`!b. convex {z | Im(z) >= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_GE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_IM_GT = prove + (`!b. convex {z | Im(z) > b}`, + GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_GT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_IM_LE = prove + (`!b. convex {z | Im(z) <= b}`, + GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_LE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_IM_LT = prove + (`!b. convex {z | Im(z) < b}`, + GEN_TAC THEN MP_TAC(ISPECL [`ii`; `b:real`] CONVEX_HALFSPACE_LT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; dot; SUM_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[ii; RE_CX; IM_CX; RE; IM; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let COMPLEX_IN_BALL_0 = prove + (`!v r. v IN ball(Cx(&0),r) <=> norm v < r`, + REWRITE_TAC [GSYM COMPLEX_VEC_0; IN_BALL_0]);; + +let COMPLEX_IN_CBALL_0 = prove + (`!v r. v IN cball(Cx(&0),r) <=> norm v <= r`, + REWRITE_TAC [GSYM COMPLEX_VEC_0; IN_CBALL_0]);; + +let COMPLEX_IN_SPHERE_0 = prove + (`!v r. v IN sphere(Cx(&0),r) <=> norm v = r`, + REWRITE_TAC [GSYM COMPLEX_VEC_0; IN_SPHERE_0]);; + +let IN_BALL_RE = prove + (`!x z e. x IN ball(z,e) ==> abs(Re(x) - Re(z)) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_BALL; dist] THEN + MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN REAL_ARITH_TAC);; + +let IN_BALL_IM = prove + (`!x z e. x IN ball(z,e) ==> abs(Im(x) - Im(z)) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_BALL; dist] THEN + MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[IM_SUB] THEN REAL_ARITH_TAC);; + +let IN_CBALL_RE = prove + (`!x z e. x IN cball(z,e) ==> abs(Re(x) - Re(z)) <= e`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN + MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_SUB] THEN REAL_ARITH_TAC);; + +let IN_CBALL_IM = prove + (`!x z e. x IN cball(z,e) ==> abs(Im(x) - Im(z)) <= e`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN + MP_TAC(SPEC `z - x:complex` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[IM_SUB] THEN REAL_ARITH_TAC);; + +let CLOSED_REAL_SET = prove + (`closed {z | real z}`, + REWRITE_TAC[CLOSED_HALFSPACE_IM_EQ; real]);; + +let CLOSED_REAL = prove + (`closed real`, + GEN_REWRITE_TAC RAND_CONV [SET_RULE `s = {x | s x}`] THEN + REWRITE_TAC[CLOSED_REAL_SET]);; + +let UNBOUNDED_REAL = prove + (`~(bounded real)`, + REWRITE_TAC[bounded; IN; REAL_EXISTS; LEFT_IMP_EXISTS_THM] THEN + MESON_TAC[COMPLEX_NORM_CX; REAL_ARITH `~(abs(abs B + &1) <= B)`]);; + +let CONNECTED_REAL = prove + (`connected real`, + SIMP_TAC[CONVEX_REAL; CONVEX_CONNECTED]);; + +let PATH_CONNECTED_REAL = prove + (`path_connected real`, + SIMP_TAC[CONVEX_REAL; CONVEX_IMP_PATH_CONNECTED]);; + +let TRIVIAL_LIMIT_WITHIN_REAL = prove + (`!z. trivial_limit (at z within real) <=> ~(real z)`, + GEN_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM IN] THEN + MATCH_MP_TAC CONNECTED_IMP_PERFECT_CLOSED THEN + REWRITE_TAC[CONNECTED_REAL; CLOSED_REAL] THEN + MESON_TAC[UNBOUNDED_REAL; BOUNDED_SING]);; + +(* ------------------------------------------------------------------------- *) +(* Complex-specific uniform limit composition theorems. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORM_LIM_COMPLEX_MUL = prove + (`!net:(A)net P f g l m b1 b2. + eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ + eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm(f n x * g n x - l n * m n) < e) + net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o CONJ BILINEAR_COMPLEX_MUL) THEN + REWRITE_TAC[UNIFORM_LIM_BILINEAR]);; + +let UNIFORM_LIM_COMPLEX_INV = prove + (`!net:(A)net P f l b. + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + &0 < b /\ eventually (\x. !n. P n ==> b <= norm(l n)) net + ==> !e. &0 < e + ==> eventually + (\x. !n. P n ==> norm(inv(f n x) - inv(l n)) < e) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EVENTUALLY_MONO THEN + EXISTS_TAC + `\x. !n. P n ==> b <= norm(l n) /\ + b / &2 <= norm((f:B->A->complex) n x) /\ + norm(f n x - l n) < e * b pow 2 / &2` THEN + REWRITE_TAC[TAUT `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN STRIP_TAC THEN X_GEN_TAC `n:B` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:B`) THEN ASM_REWRITE_TAC[]) THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `~((f:B->A->complex) n x = Cx(&0)) /\ ~(l n = Cx(&0))` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_NORM_CX]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = Cx(&0)) /\ ~(y = Cx(&0)) + ==> inv x - inv y = (y - x) / (x * y)`] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; + COMPLEX_ENTIRE] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LTE_TRANS)) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `b pow 2 / &2 = b / &2 * b`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `b / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN + ASM_MESON_TAC[NORM_ARITH + `b <= norm l /\ norm(f - l) < b / &2 ==> b / &2 <= norm f`]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_HALF; REAL_POW_LT; REAL_LT_MUL]]]);; + +let UNIFORM_LIM_COMPLEX_DIV = prove + (`!net:(A)net P f g l m b1 b2. + eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ + &0 < b2 /\ eventually (\x. !n. P n ==> b2 <= norm(m n)) net /\ + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm(f n x / g n x - l n / m n) < e) + net`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC UNIFORM_LIM_COMPLEX_MUL THEN + MAP_EVERY EXISTS_TAC [`b1:real`; `inv(b2):real`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o CONJUNCT1) o CONJUNCT2) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC UNIFORM_LIM_COMPLEX_INV THEN + EXISTS_TAC `b2:real` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The usual non-uniform versions. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPLEX_MUL = prove + (`!net:(A)net f g l m. + (f --> l) net /\ (g --> m) net ==> ((\x. f x * g x) --> l * m) net`, + SIMP_TAC[LIM_BILINEAR; BILINEAR_COMPLEX_MUL]);; + +let LIM_COMPLEX_INV = prove + (`!net:(A)net f g l m. + (f --> l) net /\ ~(l = Cx(&0)) ==> ((\x. inv(f x)) --> inv(l)) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`net:(A)net`; `\x:one. T`; + `\n:one. (f:A->complex)`; + `\n:one. (l:complex)`; + `norm(l:complex)`] UNIFORM_LIM_COMPLEX_INV) THEN + ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN + ASM_REWRITE_TAC[GSYM dist; GSYM tendsto; COMPLEX_NORM_NZ]);; + +let LIM_COMPLEX_DIV = prove + (`!net:(A)net f g l m. + (f --> l) net /\ (g --> m) net /\ ~(m = Cx(&0)) + ==> ((\x. f x / g x) --> l / m) net`, + REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN ASM_SIMP_TAC[LIM_COMPLEX_INV]);; + +let LIM_COMPLEX_POW = prove + (`!net:(A)net f l n. + (f --> l) net ==> ((\x. f(x) pow n) --> l pow n) net`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN ASM_SIMP_TAC[LIM_COMPLEX_MUL; complex_pow; LIM_CONST]);; + +let LIM_COMPLEX_LMUL = prove + (`!f l c. (f --> l) net ==> ((\x. c * f x) --> c * l) net`, + SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; + +let LIM_COMPLEX_RMUL = prove + (`!f l c. (f --> l) net ==> ((\x. f x * c) --> l * c) net`, + SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; + +(* ------------------------------------------------------------------------- *) +(* Mapping real limits between C and R^1. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CX_LIFT = prove + (`!net f l. + ((\x. Cx(f x)) --> Cx l) net <=> ((\x. lift(f x)) --> lift l) net`, + REWRITE_TAC[LIM; DIST_LIFT; DIST_CX]);; + +let SERIES_CX_LIFT = prove + (`!f s x. + ((\x. Cx(f x)) sums (Cx x)) s <=> ((\x. lift(f x)) sums (lift x)) s`, + SIMP_TAC[sums; LIM_CX_LIFT; VSUM_CX; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM LIFT_SUM)]);; + +let LIM_INFINITY_POSINFINITY_CX = prove + (`!f l:real^N. (f --> l) at_infinity ==> ((f o Cx) --> l) at_posinfinity`, + REWRITE_TAC[LIM_AT_INFINITY; LIM_AT_POSINFINITY; o_THM] THEN + MESON_TAC[COMPLEX_NORM_CX; REAL_ARITH `x >= b ==> abs(x) >= b`]);; + +(* ------------------------------------------------------------------------- *) +(* Special cases of null limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_NULL_COMPLEX = prove + (`!net f. (f --> l) net <=> ((\x. f x - l) --> Cx(&0)) net`, + REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM LIM_NULL]);; + +let LIM_NULL_COMPLEX_NORM = prove + (`!net f. (f --> Cx(&0)) net <=> ((\x. Cx(norm(f x))) --> Cx(&0)) net`, + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NORM]);; + +let LIM_NULL_COMPLEX_NEG = prove + (`!net f. (f --> Cx(&0)) net ==> ((\x. --(f x)) --> Cx(&0)) net`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN + REWRITE_TAC[COMPLEX_NEG_0]);; + +let LIM_NULL_COMPLEX_ADD = prove + (`!net f g. (f --> Cx(&0)) net /\ (g --> Cx(&0)) net + ==> ((\x. f x + g x) --> Cx(&0)) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + REWRITE_TAC[COMPLEX_ADD_LID]);; + +let LIM_NULL_COMPLEX_SUB = prove + (`!net f g. (f --> Cx(&0)) net /\ (g --> Cx(&0)) net + ==> ((\x. f x - g x) --> Cx(&0)) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + REWRITE_TAC[COMPLEX_SUB_REFL]);; + +let LIM_NULL_COMPLEX_MUL = prove + (`!net f g. (f --> Cx(&0)) net /\ (g --> Cx(&0)) net + ==> ((\x. f x * g x) --> Cx(&0)) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL) THEN + REWRITE_TAC[COMPLEX_MUL_LZERO]);; + +let LIM_NULL_COMPLEX_LMUL = prove + (`!net f c. (f --> Cx(&0)) net ==> ((\x. c * f x) --> Cx(&0)) net`, + REPEAT STRIP_TAC THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = c * Cx(&0)`) THEN + ASM_SIMP_TAC[LIM_COMPLEX_LMUL]);; + +let LIM_NULL_COMPLEX_RMUL = prove + (`!net f c. (f --> Cx(&0)) net ==> ((\x. f x * c) --> Cx(&0)) net`, + REPEAT STRIP_TAC THEN SUBST1_TAC(COMPLEX_RING `Cx(&0) = Cx(&0) * c`) THEN + ASM_SIMP_TAC[LIM_COMPLEX_RMUL]);; + +let LIM_NULL_COMPLEX_POW = prove + (`!net f n. (f --> Cx(&0)) net /\ ~(n = 0) + ==> ((\x. (f x) pow n) --> Cx(&0)) net`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP LIM_COMPLEX_POW) THEN + ASM_REWRITE_TAC[COMPLEX_POW_ZERO]);; + +let LIM_NULL_COMPLEX_BOUND = prove + (`!f g. eventually (\n. norm (f n) <= norm (g n)) net /\ (g --> Cx(&0)) net + ==> (f --> Cx(&0)) net`, + REWRITE_TAC[GSYM COMPLEX_VEC_0; LIM_TRANSFORM_BOUND]);; + +let SUMS_COMPLEX_0 = prove + (`!f s. (!n. n IN s ==> f n = Cx(&0)) ==> (f sums Cx(&0)) s`, + REWRITE_TAC[GSYM COMPLEX_VEC_0; SUMS_0]);; + +let LIM_NULL_COMPLEX_RMUL_BOUNDED = prove + (`!net f g B. + (f --> Cx(&0)) net /\ + eventually (\a. f a = Cx(&0) \/ norm(g a) <= B) net + ==> ((\z. f(z) * g(z)) --> Cx(&0)) net`, + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN + REWRITE_TAC[LIFT_CMUL; COMPLEX_NORM_MUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN + EXISTS_TAC `B:real` THEN + ASM_REWRITE_TAC[o_DEF; NORM_LIFT; REAL_ABS_NORM; NORM_EQ_0]);; + +let LIM_NULL_COMPLEX_LMUL_BOUNDED = prove + (`!net f g B. + eventually (\a. norm(f a) <= B \/ g a = Cx(&0)) net /\ + (g --> Cx(&0)) net + ==> ((\z. f(z) * g(z)) --> Cx(&0)) net`, + ONCE_REWRITE_TAC[DISJ_SYM; COMPLEX_MUL_SYM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Bound results for real and imaginary components of limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_RE_UBOUND = prove + (`!net:(A)net f l b. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. Re(f x) <= b) net + ==> Re(l) <= b`, + REWRITE_TAC[RE_DEF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `1`] + LIM_COMPONENT_UBOUND) THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +let LIM_RE_LBOUND = prove + (`!net:(A)net f l b. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. b <= Re(f x)) net + ==> b <= Re(l)`, + REWRITE_TAC[RE_DEF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `1`] + LIM_COMPONENT_LBOUND) THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +let LIM_IM_UBOUND = prove + (`!net:(A)net f l b. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. Im(f x) <= b) net + ==> Im(l) <= b`, + REWRITE_TAC[IM_DEF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `2`] + LIM_COMPONENT_UBOUND) THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +let LIM_IM_LBOUND = prove + (`!net:(A)net f l b. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. b <= Im(f x)) net + ==> b <= Im(l)`, + REWRITE_TAC[IM_DEF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `f:A->complex`; `l:complex`; `b:real`; `2`] + LIM_COMPONENT_LBOUND) THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Case analysis for limit of reciprocal of a function. This can be true *) +(* degenerately, and it's a bit tiresome to show otherwise that it means *) +(* what you expect. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPLEX_INV_NONDEGENERATE = prove + (`!f:real^N->complex s a l. + 2 <= dimindex(:N) /\ + a IN s /\ open s /\ + f continuous_on (s DELETE a) /\ + ((inv o f) --> l) (at a) + ==> ?t. open t /\ t SUBSET s /\ + ((!x. x IN t DELETE a ==> f x = Cx(&0)) /\ l = Cx(&0) \/ + (!x. x IN t DELETE a ==> ~(f x = Cx(&0))))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC + `!e. &0 < e ==> ?z:real^N. norm(z - a) < e /\ ~(z = a) /\ f(z) = Cx(&0)` + THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + EXISTS_TAC `s INTER ball(a:real^N,e)` THEN + ASM_SIMP_TAC[INTER_SUBSET; OPEN_INTER; OPEN_BALL] THEN DISJ2_TAC THEN + REWRITE_TAC[IN_DELETE; IN_INTER; IN_BALL; dist] THEN + ASM_MESON_TAC[NORM_SUB]] THEN + SUBGOAL_THEN `l = Cx(&0)` SUBST_ALL_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `norm(l:complex)`) THEN + ASM_SIMP_TAC[COMPLEX_NORM_NZ; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN + ASM_REWRITE_TAC[NORM_POS_LT; o_THM; VECTOR_SUB_EQ; COMPLEX_INV_0] THEN + REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; REAL_LT_REFL]; + REWRITE_TAC[]] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !z:real^N. norm(z - a) < e /\ ~(z = a) + ==> z IN s /\ (f z = Cx(&0) \/ norm(f z) >= &1)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT]) THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + REWRITE_TAC[o_THM; VECTOR_SUB_EQ; dist; COMPLEX_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d e:real` THEN ASM_SIMP_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`)) THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN REPEAT DISCH_TAC THEN + SUBST1_TAC(REAL_ARITH `&1 = inv(&1)`) THEN REWRITE_TAC[real_ge] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[GSYM COMPLEX_NORM_INV; REAL_LT_IMP_LE] THEN + ASM_REWRITE_TAC[NORM_POS_LT; COMPLEX_INV_EQ_0; COMPLEX_VEC_0]; + ALL_TAC] THEN + EXISTS_TAC `ball(a:real^N,e)` THEN + ASM_REWRITE_TAC[OPEN_BALL; SUBSET; IN_DELETE; IN_BALL; dist] THEN + CONJ_TAC THENL [ASM_MESON_TAC[NORM_SUB]; DISJ1_TAC] THEN + X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN + ASM_CASES_TAC `f(z:real^N) = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `connected (IMAGE (lift o norm o (f:real^N->complex)) (ball(a,e) DELETE a))` + MP_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[CONNECTED_PUNCTURED_BALL; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; IN_DELETE; IN_BALL; dist] THEN + ASM_MESON_TAC[NORM_SUB]; + REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1]] THEN + REWRITE_TAC[IS_INTERVAL_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_DELETE; IN_BALL; dist] THEN + DISCH_THEN(MP_TAC o SPEC `w:real^N`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP; COMPLEX_NORM_0] THEN + DISCH_THEN(MP_TAC o SPEC `lift(&1 / &2)`) THEN + ASM_REWRITE_TAC[LIFT_DROP; NOT_IMP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x >= &1 ==> &1 / &2 <= x`) THEN + ASM_MESON_TAC[NORM_SUB]; + REWRITE_TAC[IN_IMAGE; o_THM; LIFT_EQ; IN_BALL; IN_DELETE; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST_ALL_TAC o CONJUNCT2) THEN + RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_NORM_0]) THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Left and right multiplication of series. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_COMPLEX_LMUL = prove + (`!f l c s. (f sums l) s ==> ((\x. c * f x) sums c * l) s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_LINEAR THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[LINEAR_COMPLEX_MUL]);; + +let SERIES_COMPLEX_RMUL = prove + (`!f l c s. (f sums l) s ==> ((\x. f x * c) sums l * c) s`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[SERIES_COMPLEX_LMUL]);; + +let SERIES_COMPLEX_DIV = prove + (`!f l c s. (f sums l) s ==> ((\x. f x / c) sums (l / c)) s`, + REWRITE_TAC[complex_div; SERIES_COMPLEX_RMUL]);; + +let SUMMABLE_COMPLEX_LMUL = prove + (`!f c s. summable s f ==> summable s (\x. c * f x)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_COMPLEX_LMUL]);; + +let SUMMABLE_COMPLEX_RMUL = prove + (`!f c s. summable s f ==> summable s (\x. f x * c)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_COMPLEX_RMUL]);; + +let SUMMABLE_COMPLEX_DIV = prove + (`!f c s. summable s f ==> summable s (\x. f x / c)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_COMPLEX_DIV]);; + +(* ------------------------------------------------------------------------- *) +(* Complex-specific continuity closures. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_COMPLEX_MUL = prove + (`!net f g. + f continuous net /\ g continuous net ==> (\x. f(x) * g(x)) continuous net`, + SIMP_TAC[continuous; LIM_COMPLEX_MUL]);; + +let CONTINUOUS_COMPLEX_LMUL = prove + (`!c f net. f continuous net ==> (\x. c * f x) continuous net`, + SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST]);; + +let CONTINUOUS_COMPLEX_RMUL = prove + (`!c f net. f continuous net ==> (\x. f x * c) continuous net`, + SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST]);; + +let CONTINUOUS_COMPLEX_INV = prove + (`!net f. + f continuous net /\ ~(f(netlimit net) = Cx(&0)) + ==> (\x. inv(f x)) continuous net`, + SIMP_TAC[continuous; LIM_COMPLEX_INV]);; + +let CONTINUOUS_COMPLEX_DIV = prove + (`!net f g. + f continuous net /\ g continuous net /\ ~(g(netlimit net) = Cx(&0)) + ==> (\x. f(x) / g(x)) continuous net`, + SIMP_TAC[continuous; LIM_COMPLEX_DIV]);; + +let CONTINUOUS_COMPLEX_POW = prove + (`!net f n. f continuous net ==> (\x. f(x) pow n) continuous net`, + SIMP_TAC[continuous; LIM_COMPLEX_POW]);; + +(* ------------------------------------------------------------------------- *) +(* Write away the netlimit, which is otherwise a bit tedious. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_COMPLEX_INV_WITHIN = prove + (`!f s a. + f continuous (at a within s) /\ ~(f a = Cx(&0)) + ==> (\x. inv(f x)) continuous (at a within s)`, + MESON_TAC[CONTINUOUS_COMPLEX_INV; CONTINUOUS_TRIVIAL_LIMIT; + NETLIMIT_WITHIN]);; + +let CONTINUOUS_COMPLEX_INV_AT = prove + (`!f a. + f continuous (at a) /\ ~(f a = Cx(&0)) + ==> (\x. inv(f x)) continuous (at a)`, + SIMP_TAC[CONTINUOUS_COMPLEX_INV; NETLIMIT_AT]);; + +let CONTINUOUS_COMPLEX_DIV_WITHIN = prove + (`!f g s a. + f continuous (at a within s) /\ g continuous (at a within s) /\ + ~(g a = Cx(&0)) + ==> (\x. f x / g x) continuous (at a within s)`, + MESON_TAC[CONTINUOUS_COMPLEX_DIV; CONTINUOUS_TRIVIAL_LIMIT; + NETLIMIT_WITHIN]);; + +let CONTINUOUS_COMPLEX_DIV_AT = prove + (`!f g a. + f continuous at a /\ g continuous at a /\ ~(g a = Cx(&0)) + ==> (\x. f x / g x) continuous at a`, + SIMP_TAC[CONTINUOUS_COMPLEX_DIV; NETLIMIT_AT]);; + +(* ------------------------------------------------------------------------- *) +(* Also prove "on" variants as needed. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_COMPLEX_MUL = prove + (`!f g s. f continuous_on s /\ g continuous_on s + ==> (\x. f(x) * g(x)) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_COMPLEX_MUL]);; + +let CONTINUOUS_ON_COMPLEX_LMUL = prove + (`!f:real^N->complex s. f continuous_on s ==> (\x. c * f(x)) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON] THEN SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; + +let CONTINUOUS_ON_COMPLEX_RMUL = prove + (`!f:real^N->complex s. f continuous_on s ==> (\x. f(x) * c) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON] THEN SIMP_TAC[LIM_COMPLEX_MUL; LIM_CONST]);; + +let CONTINUOUS_ON_COMPLEX_INV = prove + (`!f:real^N->complex. + f continuous_on s /\ + (!x. x IN s ==> ~(f x = Cx(&0))) + ==> (\x. inv(f x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_COMPLEX_INV_WITHIN]);; + +let CONTINUOUS_ON_COMPLEX_DIV = prove + (`!f g s. f continuous_on s /\ g continuous_on s /\ + (!x. x IN s ==> ~(g x = Cx(&0))) + ==> (\x. f(x) / g(x)) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_COMPLEX_DIV_WITHIN]);; + +let CONTINUOUS_ON_COMPLEX_POW = prove + (`!f n s. f continuous_on s ==> (\x. f(x) pow n) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_COMPLEX_POW]);; + +(* ------------------------------------------------------------------------- *) +(* And also uniform versions. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_ON_COMPLEX_MUL = prove + (`!f g s:real^N->bool. + f uniformly_continuous_on s /\ g uniformly_continuous_on s /\ + bounded(IMAGE f s) /\ bounded(IMAGE g s) + ==> (\x. f(x) * g(x)) uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real^N->complex`; `g:real^N->complex`; + `( * ):complex->complex->complex`; `s:real^N->bool`] + BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL]);; + +let UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL = prove + (`!f c s:real^N->bool. + f uniformly_continuous_on s ==> (\x. c * f x) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o ISPEC `\x:complex. c * x` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN + ASM_SIMP_TAC[o_DEF; LINEAR_COMPLEX_MUL; LINEAR_UNIFORMLY_CONTINUOUS_ON]);; + +let UNIFORMLY_CONTINUOUS_ON_COMPLEX_RMUL = prove + (`!f c s:real^N->bool. + f uniformly_continuous_on s ==> (\x. f x * c) uniformly_continuous_on s`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity prover (not just for complex numbers but with more for them). *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_TAC = + let ETA_THM = prove + (`f continuous net <=> (\x. f x) continuous net`, + REWRITE_TAC[ETA_AX]) in + let ETA_TWEAK = + GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o SPEC_ALL in + let tac_base = + MATCH_ACCEPT_TAC CONTINUOUS_CONST ORELSE + MATCH_ACCEPT_TAC CONTINUOUS_AT_ID ORELSE + MATCH_ACCEPT_TAC CONTINUOUS_WITHIN_ID + and tac_1 = + MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_CMUL) ORELSE + MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_NEG) ORELSE + MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_COMPLEX_POW) + and tac_2 = + MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_ADD) ORELSE + MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_SUB) ORELSE + MATCH_MP_TAC(ETA_TWEAK CONTINUOUS_COMPLEX_MUL) + and tac_1' = MATCH_MP_TAC (ETA_TWEAK CONTINUOUS_COMPLEX_INV) + and tac_2' = MATCH_MP_TAC (ETA_TWEAK CONTINUOUS_COMPLEX_DIV) in + let rec CONTINUOUS_TAC gl = + (tac_base ORELSE + (tac_1 THEN CONTINUOUS_TAC) ORELSE + (tac_2 THEN CONJ_TAC THEN CONTINUOUS_TAC) ORELSE + (tac_1' THEN CONJ_TAC THENL + [CONTINUOUS_TAC; REWRITE_TAC[NETLIMIT_AT; NETLIMIT_WITHIN]]) ORELSE + (tac_2' THEN REPEAT CONJ_TAC THENL + [CONTINUOUS_TAC; CONTINUOUS_TAC; + REWRITE_TAC[NETLIMIT_AT; NETLIMIT_WITHIN]]) ORELSE + ALL_TAC) gl in + CONTINUOUS_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Hence a limit calculator *) +(* ------------------------------------------------------------------------- *) + +let LIM_CONTINUOUS = prove + (`!net f l. f continuous net /\ f(netlimit net) = l ==> (f --> l) net`, + MESON_TAC[continuous]);; + +let LIM_TAC = + MATCH_MP_TAC LIM_CONTINUOUS THEN CONJ_TAC THENL + [CONTINUOUS_TAC; REWRITE_TAC[NETLIMIT_AT; NETLIMIT_WITHIN]];; + +(* ------------------------------------------------------------------------- *) +(* Continuity of the norm. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_AT_CX_NORM = prove + (`!z:real^N. (\z. Cx(norm z)) continuous at z`, + REWRITE_TAC[continuous_at; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + MESON_TAC[NORM_ARITH `norm(a - b:real^N) < d ==> abs(norm a - norm b) < d`]);; + +let CONTINUOUS_WITHIN_CX_NORM = prove + (`!z:real^N s. (\z. Cx(norm z)) continuous (at z within s)`, + SIMP_TAC[CONTINUOUS_AT_CX_NORM; CONTINUOUS_AT_WITHIN]);; + +let CONTINUOUS_ON_CX_NORM = prove + (`!s. (\z. Cx(norm z)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_CX_NORM]);; + +let CONTINUOUS_AT_CX_DOT = prove + (`!c z:real^N. (\z. Cx(c dot z)) continuous at z`, + REPEAT GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear; DOT_RADD; DOT_RMUL; CX_ADD; COMPLEX_CMUL; CX_MUL]);; + +let CONTINUOUS_WITHIN_CX_DOT = prove + (`!c z:real^N s. (\z. Cx(c dot z)) continuous (at z within s)`, + SIMP_TAC[CONTINUOUS_AT_CX_DOT; CONTINUOUS_AT_WITHIN]);; + +let CONTINUOUS_ON_CX_DOT = prove + (`!s c:real^N. (\z. Cx(c dot z)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_CX_DOT]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity switching range between complex and real^1 *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_CX_DROP = prove + (`!net f. f continuous net ==> (\x. Cx(drop(f x))) continuous net`, + REWRITE_TAC[continuous; tendsto] THEN + REWRITE_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX; GSYM DROP_SUB] THEN + REWRITE_TAC[GSYM ABS_DROP]);; + +let CONTINUOUS_ON_CX_DROP = prove + (`!f s. f continuous_on s ==> (\x. Cx(drop(f x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CX_DROP]);; + +let CONTINUOUS_CX_LIFT = prove + (`!f. (\x. Cx(f x)) continuous net <=> (\x. lift(f x)) continuous net`, + REWRITE_TAC[continuous; LIM; dist; GSYM CX_SUB; GSYM LIFT_SUB] THEN + REWRITE_TAC[COMPLEX_NORM_CX; NORM_LIFT]);; + +let CONTINUOUS_ON_CX_LIFT = prove + (`!f s. (\x. Cx(f x)) continuous_on s <=> (\x. lift(f x)) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CX_LIFT]);; + +(* ------------------------------------------------------------------------- *) +(* Linearity and continuity of the components. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_CX_RE = prove + (`linear(Cx o Re)`, + SIMP_TAC[linear; o_THM; COMPLEX_CMUL; RE_ADD; RE_MUL_CX; CX_MUL; CX_ADD]);; + +let CONTINUOUS_AT_CX_RE = prove + (`!z. (Cx o Re) continuous at z`, + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_CX_RE]);; + +let CONTINUOUS_ON_CX_RE = prove + (`!s. (Cx o Re) continuous_on s`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CX_RE]);; + +let LINEAR_CX_IM = prove + (`linear(Cx o Im)`, + SIMP_TAC[linear; o_THM; COMPLEX_CMUL; IM_ADD; IM_MUL_CX; CX_MUL; CX_ADD]);; + +let CONTINUOUS_AT_CX_IM = prove + (`!z. (Cx o Im) continuous at z`, + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_CX_IM]);; + +let CONTINUOUS_ON_CX_IM = prove + (`!s. (Cx o Im) continuous_on s`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CX_IM]);; + +(* ------------------------------------------------------------------------- *) +(* Complex differentiability. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("has_complex_derivative",(12,"right"));; +parse_as_infix ("complex_differentiable",(12,"right"));; +parse_as_infix ("holomorphic_on",(12,"right"));; + +let has_complex_derivative = new_definition + `(f has_complex_derivative f') net <=> (f has_derivative (\x. f' * x)) net`;; + +let complex_differentiable = new_definition + `f complex_differentiable net <=> ?f'. (f has_complex_derivative f') net`;; + +let complex_derivative = new_definition + `complex_derivative f x = @f'. (f has_complex_derivative f') (at x)`;; + +let higher_complex_derivative = define + `higher_complex_derivative 0 f = f /\ + (!n. higher_complex_derivative (SUC n) f = + complex_derivative (higher_complex_derivative n f))`;; + +let holomorphic_on = new_definition + `f holomorphic_on s <=> + !x. x IN s ==> ?f'. (f has_complex_derivative f') (at x within s)`;; + +let HOLOMORPHIC_ON_EMPTY = prove + (`!f. f holomorphic_on {}`, + REWRITE_TAC[holomorphic_on; NOT_IN_EMPTY]);; + +let HOLOMORPHIC_ON_DIFFERENTIABLE = prove + (`!f s. f holomorphic_on s <=> + !x. x IN s ==> f complex_differentiable (at x within s)`, + REWRITE_TAC[holomorphic_on; complex_differentiable]);; + +let HOLOMORPHIC_ON_OPEN = prove + (`!f s. open s + ==> (f holomorphic_on s <=> + !x. x IN s ==> ?f'. (f has_complex_derivative f') (at x))`, + REWRITE_TAC[holomorphic_on; has_complex_derivative] THEN + REWRITE_TAC[has_derivative_at; has_derivative_within] THEN + SIMP_TAC[LIM_WITHIN_OPEN]);; + +let HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN = prove + (`!f s x. f holomorphic_on s /\ x IN s + ==> f complex_differentiable (at x within s)`, + MESON_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE]);; + +let HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT = prove + (`!f s x. f holomorphic_on s /\ open s /\ x IN s + ==> f complex_differentiable (at x)`, + MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable]);; + +let HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT = prove + (`!f f' x. (f has_complex_derivative f') (at x) ==> f continuous at x`, + REWRITE_TAC[has_complex_derivative] THEN + MESON_TAC[differentiable; DIFFERENTIABLE_IMP_CONTINUOUS_AT]);; + +let HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN = prove + (`!f f' x s. (f has_complex_derivative f') (at x within s) + ==> f continuous (at x within s)`, + REWRITE_TAC[has_complex_derivative] THEN + MESON_TAC[differentiable; DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE = prove + (`!net f. f complex_differentiable net ==> f differentiable net`, + SIMP_TAC[complex_differentiable; differentiable; has_complex_derivative] THEN + MESON_TAC[]);; + +let COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT = prove + (`!f x. f complex_differentiable at x ==> f continuous at x`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; complex_differentiable]);; + +let COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN = prove + (`!f x s. f complex_differentiable (at x within s) + ==> f continuous (at x within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE; + DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; + +let HOLOMORPHIC_ON_IMP_CONTINUOUS_ON = prove + (`!f s. f holomorphic_on s ==> f continuous_on s`, + REWRITE_TAC[holomorphic_on; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[has_complex_derivative] THEN + MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; differentiable]);; + +let HOLOMORPHIC_ON_SUBSET = prove + (`!f s t. f holomorphic_on s /\ t SUBSET s ==> f holomorphic_on t`, + REWRITE_TAC[holomorphic_on; has_complex_derivative] THEN + MESON_TAC[SUBSET; HAS_DERIVATIVE_WITHIN_SUBSET]);; + +let HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET = prove + (`!f s t x. (f has_complex_derivative f') (at x within s) /\ t SUBSET s + ==> (f has_complex_derivative f') (at x within t)`, + REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_WITHIN_SUBSET]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET = prove + (`!f s t. f complex_differentiable (at x within s) /\ t SUBSET s + ==> f complex_differentiable (at x within t)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET]);; + +let HAS_COMPLEX_DERIVATIVE_AT_WITHIN = prove + (`!f f' x s. (f has_complex_derivative f') (at x) + ==> (f has_complex_derivative f') (at x within s)`, + REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_AT_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN = prove + (`!f f' a s. + a IN s /\ open s + ==> ((f has_complex_derivative f') (at a within s) <=> + (f has_complex_derivative f') (at a))`, + REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_WITHIN_OPEN]);; + +let COMPLEX_DIFFERENTIABLE_AT_WITHIN = prove + (`!f s z. f complex_differentiable (at z) + ==> f complex_differentiable (at z within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN = prove + (`!f f' g x s d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ + (f has_complex_derivative f') (at x within s) + ==> (g has_complex_derivative f') (at x within s)`, + REWRITE_TAC[has_complex_derivative] THEN + MESON_TAC[HAS_DERIVATIVE_TRANSFORM_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove + (`!f g f' s z. open s /\ z IN s /\ (!w. w IN s ==> f w = g w) /\ + (f has_complex_derivative f') (at z) + ==> (g has_complex_derivative f') (at z)`, + REWRITE_TAC [has_complex_derivative] THEN + ASM_MESON_TAC [HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN]);; + +let HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT = prove + (`!f f' g x d. + &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ + (f has_complex_derivative f') (at x) + ==> (g has_complex_derivative f') (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);; + +let HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT = prove + (`!f s. + convex s /\ + (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x within s)) + ==> ?c. !x. x IN s ==> f(x) = c`, + REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_CONSTANT]);; + +let HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE = prove + (`!f s c a. + convex s /\ a IN s /\ f a = c /\ + (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x within s)) + ==> !x. x IN s ==> f(x) = c`, + REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_UNIQUE]);; + +let HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT = prove + (`!f s. + open s /\ connected s /\ + (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x)) + ==> ?c. !x. x IN s ==> f(x) = c`, + REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT]);; + +let HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_UNIQUE = prove + (`!f s c a. + open s /\ connected s /\ a IN s /\ f a = c /\ + (!x. x IN s ==> (f has_complex_derivative Cx(&0)) (at x)) + ==> !x. x IN s ==> f(x) = c`, + REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE]);; + +let COMPLEX_DIFF_CHAIN_WITHIN = prove + (`!f g f' g' x s. + (f has_complex_derivative f') (at x within s) /\ + (g has_complex_derivative g') (at (f x) within (IMAGE f s)) + ==> ((g o f) has_complex_derivative (g' * f'))(at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_WITHIN) THEN + REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]);; + +let COMPLEX_DIFF_CHAIN_AT = prove + (`!f g f' g' x. + (f has_complex_derivative f') (at x) /\ + (g has_complex_derivative g') (at (f x)) + ==> ((g o f) has_complex_derivative (g' * f')) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + ASM_MESON_TAC[COMPLEX_DIFF_CHAIN_WITHIN; SUBSET_UNIV; + HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET]);; + +let HAS_COMPLEX_DERIVATIVE_CHAIN = prove + (`!P f g. + (!x. P x ==> (g has_complex_derivative g'(x)) (at x)) + ==> (!x s. (f has_complex_derivative f') (at x within s) /\ P(f x) + ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) + (at x within s)) /\ + (!x. (f has_complex_derivative f') (at x) /\ P(f x) + ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) + (at x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + ASM_MESON_TAC[COMPLEX_DIFF_CHAIN_WITHIN; COMPLEX_DIFF_CHAIN_AT; + HAS_COMPLEX_DERIVATIVE_AT_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV = prove + (`!f g. (!x. (g has_complex_derivative g'(x)) (at x)) + ==> (!x s. (f has_complex_derivative f') (at x within s) + ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) + (at x within s)) /\ + (!x. (f has_complex_derivative f') (at x) + ==> ((\x. g(f x)) has_complex_derivative f' * g'(f x)) + (at x))`, + MP_TAC(SPEC `\x:complex. T` HAS_COMPLEX_DERIVATIVE_CHAIN) THEN SIMP_TAC[]);; + +let COMPLEX_DERIVATIVE_UNIQUE_AT = prove + (`!f z f' f''. + (f has_complex_derivative f') (at z) /\ + (f has_complex_derivative f'') (at z) + ==> f' = f''`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP FRECHET_DERIVATIVE_UNIQUE_AT) THEN + DISCH_THEN(MP_TAC o C AP_THM `Cx(&1)`) THEN + REWRITE_TAC[COMPLEX_MUL_RID]);; + +let HIGHER_COMPLEX_DERIVATIVE_1 = prove + (`!f z. higher_complex_derivative 1 f z = complex_derivative f z`, + REWRITE_TAC[num_CONV `1`; higher_complex_derivative]);; + +(* ------------------------------------------------------------------------- *) +(* A more direct characterization. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_WITHIN = prove + (`!f s a. (f has_complex_derivative f') (at a within s) <=> + ((\x. (f(x) - f(a)) / (x - a)) --> f') (at a within s)`, + REWRITE_TAC[has_complex_derivative; has_derivative_within] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[LINEAR_COMPLEX_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [LIM_NULL] THEN + REWRITE_TAC[LIM_WITHIN; dist; VECTOR_SUB_RZERO; NORM_MUL] THEN + REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN SIMP_TAC[COMPLEX_FIELD + `~(x:complex = a) ==> y / (x - a) - z = inv(x - a) * (y - z * (x - a))`] THEN + REWRITE_TAC[REAL_ABS_INV; COMPLEX_NORM_MUL; REAL_ABS_NORM; + COMPLEX_NORM_INV; VECTOR_ARITH `a:complex - (b + c) = a - b - c`]);; + +let HAS_COMPLEX_DERIVATIVE_AT = prove + (`!f a. (f has_complex_derivative f') (at a) <=> + ((\x. (f(x) - f(a)) / (x - a)) --> f') (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetical combining theorems. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_COMPLEX_CMUL = prove + (`!net c. ((\x. c * x) has_derivative (\x. c * x)) net`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[LINEAR_COMPLEX_MUL]);; + +let HAS_COMPLEX_DERIVATIVE_LINEAR = prove + (`!net c. ((\x. c * x) has_complex_derivative c) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN + MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; + +let HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN = prove + (`!f f' c x s. + (f has_complex_derivative f') (at x within s) + ==> ((\x. c * f(x)) has_complex_derivative (c * f')) (at x within s)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`at ((f:complex->complex) x) within (IMAGE f s)`; `c:complex`] + HAS_COMPLEX_DERIVATIVE_LINEAR) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP COMPLEX_DIFF_CHAIN_WITHIN) THEN + REWRITE_TAC[o_DEF]);; + +let HAS_COMPLEX_DERIVATIVE_LMUL_AT = prove + (`!f f' c x. + (f has_complex_derivative f') (at x) + ==> ((\x. c * f(x)) has_complex_derivative (c * f')) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN = prove + (`!f f' c x s. + (f has_complex_derivative f') (at x within s) + ==> ((\x. f(x) * c) has_complex_derivative (f' * c)) (at x within s)`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_RMUL_AT = prove + (`!f f' c x. + (f has_complex_derivative f') (at x) + ==> ((\x. f(x) * c) has_complex_derivative (f' * c)) (at x)`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_AT]);; + +let HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN = prove + (`!f f' c x s. + (f has_complex_derivative f') (at x within s) + ==> ((\x. f(x) / c) has_complex_derivative (f' / c)) (at x within s)`, + SIMP_TAC[complex_div; HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_CDIV_AT = prove + (`!f f' c x s. + (f has_complex_derivative f') (at x) + ==> ((\x. f(x) / c) has_complex_derivative (f' / c)) (at x)`, + SIMP_TAC[complex_div; HAS_COMPLEX_DERIVATIVE_RMUL_AT]);; + +let HAS_COMPLEX_DERIVATIVE_ID = prove + (`!net. ((\x. x) has_complex_derivative Cx(&1)) net`, + REWRITE_TAC[has_complex_derivative; HAS_DERIVATIVE_ID; COMPLEX_MUL_LID]);; + +let HAS_COMPLEX_DERIVATIVE_CONST = prove + (`!c net. ((\x. c) has_complex_derivative Cx(&0)) net`, + REWRITE_TAC[has_complex_derivative; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_DERIVATIVE_CONST]);; + +let HAS_COMPLEX_DERIVATIVE_NEG = prove + (`!f f' net. (f has_complex_derivative f') net + ==> ((\x. --(f(x))) has_complex_derivative (--f')) net`, + SIMP_TAC[has_complex_derivative; COMPLEX_MUL_LNEG; HAS_DERIVATIVE_NEG]);; + +let HAS_COMPLEX_DERIVATIVE_ADD = prove + (`!f f' g g' net. + (f has_complex_derivative f') net /\ (g has_complex_derivative g') net + ==> ((\x. f(x) + g(x)) has_complex_derivative (f' + g')) net`, + SIMP_TAC[has_complex_derivative; COMPLEX_ADD_RDISTRIB; HAS_DERIVATIVE_ADD]);; + +let HAS_COMPLEX_DERIVATIVE_SUB = prove + (`!f f' g g' net. + (f has_complex_derivative f') net /\ (g has_complex_derivative g') net + ==> ((\x. f(x) - g(x)) has_complex_derivative (f' - g')) net`, + SIMP_TAC[has_complex_derivative; COMPLEX_SUB_RDISTRIB; HAS_DERIVATIVE_SUB]);; + +let HAS_COMPLEX_DERIVATIVE_MUL_WITHIN = prove + (`!f f' g g' x s. + (f has_complex_derivative f') (at x within s) /\ + (g has_complex_derivative g') (at x within s) + ==> ((\x. f(x) * g(x)) has_complex_derivative + (f(x) * g' + f' * g(x))) (at x within s)`, + REPEAT GEN_TAC THEN SIMP_TAC[has_complex_derivative] THEN + DISCH_THEN(MP_TAC o C CONJ BILINEAR_COMPLEX_MUL) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_WITHIN) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + CONV_TAC COMPLEX_RING);; + +let HAS_COMPLEX_DERIVATIVE_MUL_AT = prove + (`!f f' g g' x. + (f has_complex_derivative f') (at x) /\ + (g has_complex_derivative g') (at x) + ==> ((\x. f(x) * g(x)) has_complex_derivative + (f(x) * g' + f' * g(x))) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_MUL_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_POW_WITHIN = prove + (`!f f' x s n. (f has_complex_derivative f') (at x within s) + ==> ((\x. f(x) pow n) has_complex_derivative + (Cx(&n) * f(x) pow (n - 1) * f')) (at x within s)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST; COMPLEX_MUL_LZERO] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN + REWRITE_TAC[SUC_SUB1] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + BINOP_TAC THEN REWRITE_TAC[COMPLEX_MUL_AC; GSYM REAL_OF_NUM_SUC] THEN + SPEC_TAC(`n:num`,`n:num`) THEN REWRITE_TAC[CX_ADD] THEN INDUCT_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[SUC_SUB1; complex_pow] THEN + CONV_TAC COMPLEX_FIELD);; + +let HAS_COMPLEX_DERIVATIVE_POW_AT = prove + (`!f f' x n. (f has_complex_derivative f') (at x) + ==> ((\x. f(x) pow n) has_complex_derivative + (Cx(&n) * f(x) pow (n - 1) * f')) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_POW_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_INV_BASIC = prove + (`!x. ~(x = Cx(&0)) + ==> ((inv) has_complex_derivative (--inv(x pow 2))) (at x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_complex_derivative; has_derivative_at] THEN + REWRITE_TAC[LINEAR_COMPLEX_MUL; COMPLEX_VEC_0] THEN + MATCH_MP_TAC LIM_TRANSFORM_AWAY_AT THEN + MAP_EVERY EXISTS_TAC + [`\y. inv(norm(y - x)) % inv(x pow 2 * y) * (y - x) pow 2`; `Cx(&0)`] THEN + ASM_REWRITE_TAC[COMPLEX_CMUL] THEN CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN + SUBGOAL_THEN `((\y. inv(x pow 2 * y) * (y - x)) --> Cx(&0)) (at x)` + MP_TAC THENL + [LIM_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[LIM_AT] THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_INV; COMPLEX_NORM_POW] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_INV; REAL_ABS_NORM] THEN + REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC) THEN + AP_TERM_TAC THEN ABS_TAC THEN + MATCH_MP_TAC(MESON[] + `(p ==> x = y) ==> ((p ==> x < e) <=> (p ==> y < e))`) THEN + MAP_EVERY ABBREV_TAC + [`n = norm(x' - x:complex)`; + `m = inv (norm(x:complex) pow 2 * norm(x':complex))`] THEN + CONV_TAC REAL_FIELD);; + +let HAS_COMPLEX_DERIVATIVE_INV_WITHIN = prove + (`!f f' x s. (f has_complex_derivative f') (at x within s) /\ + ~(f x = Cx(&0)) + ==> ((\x. inv(f(x))) has_complex_derivative (--f' / f(x) pow 2)) + (at x within s)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(g = Cx(&0)) ==> --f / g pow 2 = --inv(g pow 2) * f`] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_INV_BASIC]);; + +let HAS_COMPLEX_DERIVATIVE_INV_AT = prove + (`!f f' x. (f has_complex_derivative f') (at x) /\ + ~(f x = Cx(&0)) + ==> ((\x. inv(f(x))) has_complex_derivative (--f' / f(x) pow 2)) + (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_INV_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_DIV_WITHIN = prove + (`!f f' g g' x s. + (f has_complex_derivative f') (at x within s) /\ + (g has_complex_derivative g') (at x within s) /\ + ~(g(x) = Cx(&0)) + ==> ((\x. f(x) / g(x)) has_complex_derivative + (f' * g(x) - f(x) * g') / g(x) pow 2) (at x within s)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_INV_WITHIN) THEN + UNDISCH_TAC `(f has_complex_derivative f') (at x within s)` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN + REWRITE_TAC[GSYM complex_div] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; + +let HAS_COMPLEX_DERIVATIVE_DIV_AT = prove + (`!f f' g g' x. + (f has_complex_derivative f') (at x) /\ + (g has_complex_derivative g') (at x) /\ + ~(g(x) = Cx(&0)) + ==> ((\x. f(x) / g(x)) has_complex_derivative + (f' * g(x) - f(x) * g') / g(x) pow 2) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIV_WITHIN]);; + +let HAS_COMPLEX_DERIVATIVE_VSUM = prove + (`!f net s. + FINITE s /\ (!a. a IN s ==> (f a has_complex_derivative f' a) net) + ==> ((\x. vsum s (\a. f a x)) has_complex_derivative (vsum s f')) + net`, + SIMP_TAC[GSYM VSUM_COMPLEX_RMUL; has_complex_derivative] THEN + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_VSUM) THEN + REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing just for complex differentiability. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DIFFERENTIABLE_LINEAR = prove + (`(\z. c * z) complex_differentiable p`, + REWRITE_TAC [complex_differentiable] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_LINEAR]);; + +let COMPLEX_DIFFERENTIABLE_CONST = prove + (`!c net. (\z. c) complex_differentiable net`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CONST]);; + +let COMPLEX_DIFFERENTIABLE_ID = prove + (`!net. (\z. z) complex_differentiable net`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_ID]);; + +let COMPLEX_DIFFERENTIABLE_NEG = prove + (`!f net. + f complex_differentiable net + ==> (\z. --(f z)) complex_differentiable net`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_NEG]);; + +let COMPLEX_DIFFERENTIABLE_ADD = prove + (`!f g net. + f complex_differentiable net /\ + g complex_differentiable net + ==> (\z. f z + g z) complex_differentiable net`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_ADD]);; + +let COMPLEX_DIFFERENTIABLE_SUB = prove + (`!f g net. + f complex_differentiable net /\ + g complex_differentiable net + ==> (\z. f z - g z) complex_differentiable net`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_SUB]);; + +let COMPLEX_DIFFERENTIABLE_INV_WITHIN = prove + (`!f z s. + f complex_differentiable (at z within s) /\ ~(f z = Cx(&0)) + ==> (\z. inv(f z)) complex_differentiable (at z within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_INV_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_MUL_WITHIN = prove + (`!f g z s. + f complex_differentiable (at z within s) /\ + g complex_differentiable (at z within s) + ==> (\z. f z * g z) complex_differentiable (at z within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_MUL_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_DIV_WITHIN = prove + (`!f g z s. + f complex_differentiable (at z within s) /\ + g complex_differentiable (at z within s) /\ + ~(g z = Cx(&0)) + ==> (\z. f z / g z) complex_differentiable (at z within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIV_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_POW_WITHIN = prove + (`!f n z s. + f complex_differentiable (at z within s) + ==> (\z. f z pow n) complex_differentiable (at z within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_POW_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN = prove + (`!f k:A->bool z s. + FINITE k /\ + (!i. i IN k ==> f i complex_differentiable (at z within s)) + ==> (\z. cproduct k (\i. f i z)) complex_differentiable + (at z within s)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_DIFFERENTIABLE_CONST; FORALL_IN_INSERT; + ETA_AX; COMPLEX_DIFFERENTIABLE_MUL_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN = prove + (`!f g x s d. + &0 < d /\ + x IN s /\ + (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ + f complex_differentiable (at x within s) + ==> g complex_differentiable (at x within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN]);; + +let HOLOMORPHIC_TRANSFORM = prove + (`!f g s. (!x. x IN s ==> f x = g x) /\ f holomorphic_on s + ==> g holomorphic_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`f:complex->complex`; `&1`] THEN + ASM_SIMP_TAC[REAL_LT_01]);; + +let HOLOMORPHIC_EQ = prove + (`!f g s. (!x. x IN s ==> f x = g x) + ==> (f holomorphic_on s <=> g holomorphic_on s)`, + MESON_TAC[HOLOMORPHIC_TRANSFORM]);; + +let COMPLEX_DIFFERENTIABLE_INV_AT = prove + (`!f z. + f complex_differentiable at z /\ ~(f z = Cx(&0)) + ==> (\z. inv(f z)) complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_INV_AT]);; + +let COMPLEX_DIFFERENTIABLE_MUL_AT = prove + (`!f g z. + f complex_differentiable at z /\ + g complex_differentiable at z + ==> (\z. f z * g z) complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_MUL_AT]);; + +let COMPLEX_DIFFERENTIABLE_DIV_AT = prove + (`!f g z. + f complex_differentiable at z /\ + g complex_differentiable at z /\ + ~(g z = Cx(&0)) + ==> (\z. f z / g z) complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIV_AT]);; + +let COMPLEX_DIFFERENTIABLE_POW_AT = prove + (`!f n z. + f complex_differentiable at z + ==> (\z. f z pow n) complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_POW_AT]);; + +let COMPLEX_DIFFERENTIABLE_CPRODUCT_AT = prove + (`!f k:A->bool z. + FINITE k /\ + (!i. i IN k ==> f i complex_differentiable (at z)) + ==> (\z. cproduct k (\i. f i z)) complex_differentiable (at z)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_DIFFERENTIABLE_CONST; FORALL_IN_INSERT; + ETA_AX; COMPLEX_DIFFERENTIABLE_MUL_AT]);; + +let COMPLEX_DIFFERENTIABLE_TRANSFORM_AT = prove + (`!f g x d. + &0 < d /\ + (!x'. dist (x',x) < d ==> f x' = g x') /\ + f complex_differentiable at x + ==> g complex_differentiable at x`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT]);; + +let COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN = prove + (`!f g x s. + f complex_differentiable (at x within s) /\ + g complex_differentiable (at (f x) within IMAGE f s) + ==> (g o f) complex_differentiable (at x within s)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[COMPLEX_DIFF_CHAIN_WITHIN]);; + +let COMPLEX_DIFFERENTIABLE_COMPOSE_AT = prove + (`!f g x s. + f complex_differentiable (at x) /\ + g complex_differentiable (at (f x)) + ==> (g o f) complex_differentiable (at x)`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[COMPLEX_DIFF_CHAIN_AT]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_OPEN = prove + (`!f a s. + a IN s /\ open s + ==> (f complex_differentiable at a within s <=> + f complex_differentiable at a)`, + SIMP_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN]);; + +(* ------------------------------------------------------------------------- *) +(* Same again for being holomorphic on a set. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_ON_LINEAR = prove + (`!s c. (\w. c * w) holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_LINEAR]);; + +let HOLOMORPHIC_ON_CONST = prove + (`!c s. (\z. c) holomorphic_on s`, + REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_CONST]);; + +let HOLOMORPHIC_ON_ID = prove + (`!s. (\z. z) holomorphic_on s`, + REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_ID]);; + +let HOLOMORPHIC_ON_COMPOSE = prove + (`!f g s. f holomorphic_on s /\ g holomorphic_on (IMAGE f s) + ==> (g o f) holomorphic_on s`, + SIMP_TAC[holomorphic_on; GSYM complex_differentiable; FORALL_IN_IMAGE] THEN + MESON_TAC[COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN]);; + +let HOLOMORPHIC_ON_NEG = prove + (`!f s. f holomorphic_on s ==> (\z. --(f z)) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_NEG]);; + +let HOLOMORPHIC_ON_ADD = prove + (`!f g s. + f holomorphic_on s /\ g holomorphic_on s + ==> (\z. f z + g z) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_ADD]);; + +let HOLOMORPHIC_ON_SUB = prove + (`!f g s. + f holomorphic_on s /\ g holomorphic_on s + ==> (\z. f z - g z) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_SUB]);; + +let HOLOMORPHIC_ON_MUL = prove + (`!f g s. + f holomorphic_on s /\ g holomorphic_on s + ==> (\z. f z * g z) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_MUL_WITHIN]);; + +let HOLOMORPHIC_ON_LMUL = prove + (`!f c s. f holomorphic_on s ==> (\x. c * f x) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST]);; + +let HOLOMORPHIC_ON_RMUL = prove + (`!f c s. f holomorphic_on s ==> (\x. f x * c) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST]);; + +let HOLOMORPHIC_ON_INV = prove + (`!f s. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> (\z. inv(f z)) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_INV_WITHIN]);; + +let HOLOMORPHIC_ON_DIV = prove + (`!f g s. + f holomorphic_on s /\ g holomorphic_on s /\ + (!z. z IN s ==> ~(g z = Cx(&0))) + ==> (\z. f z / g z) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_DIV_WITHIN]);; + +let HOLOMORPHIC_ON_POW = prove + (`!f s n. f holomorphic_on s ==> (\z. (f z) pow n) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; COMPLEX_DIFFERENTIABLE_POW_WITHIN]);; + +let HOLOMORPHIC_ON_VSUM = prove + (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) holomorphic_on s) + ==> (\x. vsum k (\a. f a x)) holomorphic_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN + SIMP_TAC[HOLOMORPHIC_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN + ASM_SIMP_TAC[ETA_AX]);; + +let HOLOMORPHIC_ON_CPRODUCT = prove + (`!f k:A->bool s. + FINITE k /\ + (!i. i IN k ==> f i holomorphic_on s) + ==> (\z. cproduct k (\i. f i z)) holomorphic_on s`, + SIMP_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; + COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN]);; + +let HOLOMORPHIC_ON_COMPOSE_GEN = prove + (`!f g s t. f holomorphic_on s /\ g holomorphic_on t /\ + (!z. z IN s ==> f z IN t) + ==> g o f holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:complex->complex) s SUBSET t` MP_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET; + COMPLEX_DIFF_CHAIN_WITHIN]]);; + +(* ------------------------------------------------------------------------- *) +(* Same again for the actual derivative function. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_DERIVATIVE = prove + (`!f f' x. (f has_complex_derivative f') (at x) + ==> complex_derivative f x = f'`, + REWRITE_TAC[complex_derivative] THEN + MESON_TAC[COMPLEX_DERIVATIVE_UNIQUE_AT]);; + +let HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE = prove + (`!f x. (f has_complex_derivative (complex_derivative f x)) (at x) <=> + f complex_differentiable at x`, + REWRITE_TAC[complex_differentiable; complex_derivative] THEN MESON_TAC[]);; + +let COMPLEX_DIFFERENTIABLE_COMPOSE = prove + (`!f g z. f complex_differentiable at z /\ g complex_differentiable at (f z) + ==> (g o f) complex_differentiable at z`, + REWRITE_TAC [complex_differentiable] THEN + MESON_TAC [COMPLEX_DIFF_CHAIN_AT]);; + +let COMPLEX_DERIVATIVE_CHAIN = prove + (`!f g z. f complex_differentiable at z /\ g complex_differentiable at (f z) + ==> complex_derivative (g o f) z = + complex_derivative g (f z) * complex_derivative f z`, + MESON_TAC [HAS_COMPLEX_DERIVATIVE_DERIVATIVE; COMPLEX_DIFF_CHAIN_AT; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_LINEAR = prove + (`!c. complex_derivative (\w. c * w) = \z. c`, + REWRITE_TAC [FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + REWRITE_TAC [HAS_COMPLEX_DERIVATIVE_LINEAR]);; + +let COMPLEX_DERIVATIVE_ID = prove + (`complex_derivative (\w.w) = \z. Cx(&1)`, + REWRITE_TAC [FUN_EQ_THM] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_DERIVATIVE; HAS_COMPLEX_DERIVATIVE_ID]);; + +let COMPLEX_DERIVATIVE_CONST = prove + (`!c. complex_derivative (\w.c) = \z. Cx(&0)`, + REWRITE_TAC [FUN_EQ_THM] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_DERIVATIVE; + HAS_COMPLEX_DERIVATIVE_CONST]);; + +let COMPLEX_DERIVATIVE_ADD = prove + (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z + ==> complex_derivative (\w. f w + g w) z = + complex_derivative f z + complex_derivative g z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_ADD; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_SUB = prove + (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z + ==> complex_derivative (\w. f w - g w) z = + complex_derivative f z - complex_derivative g z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_SUB; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_MUL = prove + (`!f g z. f complex_differentiable at z /\ g complex_differentiable at z + ==> complex_derivative (\w. f w * g w) z = + f z * complex_derivative g z + complex_derivative f z * g z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_MUL_AT; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_LMUL = prove + (`!f c z. f complex_differentiable at z + ==> complex_derivative (\w. c * f w) z = + c * complex_derivative f z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_LMUL_AT; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_RMUL = prove + (`!f c z. f complex_differentiable at z + ==> complex_derivative (\w. f w * c) z = + complex_derivative f z * c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ASM_SIMP_TAC [HAS_COMPLEX_DERIVATIVE_RMUL_AT; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove + (`!f g s z. open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s /\ + (!w. w IN s ==> f w = g w) + ==> complex_derivative f z = complex_derivative g z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; + HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]);; + +let COMPLEX_DERIVATIVE_COMPOSE_LINEAR = prove + (`!f c z. f complex_differentiable at (c * z) + ==> complex_derivative (\w. f (c * w)) z = + c * complex_derivative f (c * z)`, + SIMP_TAC + [COMPLEX_MUL_SYM; REWRITE_RULE [o_DEF; COMPLEX_DIFFERENTIABLE_ID; + COMPLEX_DIFFERENTIABLE_LINEAR; + COMPLEX_DERIVATIVE_LINEAR] + (SPECL [`\w:complex. c * w`] COMPLEX_DERIVATIVE_CHAIN)]);; + +(* ------------------------------------------------------------------------- *) +(* Caratheodory characterization. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT = prove + (`!f f' z. + (f has_complex_derivative f') (at z) <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ + g continuous at z /\ g(z) = f'`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_RING `w' - z':complex = a <=> w' = z' + a`] THEN + SIMP_TAC[GSYM FUN_EQ_THM; HAS_COMPLEX_DERIVATIVE_AT; CONTINUOUS_AT] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `\w. if w = z then f':complex else (f(w) - f(z)) / (w - z)` THEN + ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; COMPLEX_SUB_REFL] THEN + CONV_TAC COMPLEX_FIELD; + FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN + ASM_SIMP_TAC[COMPLEX_RING `(z + a) - (z + b * (w - w)):complex = a`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + LIM_TRANSFORM)) THEN + SIMP_TAC[LIM_CONST; COMPLEX_VEC_0; COMPLEX_FIELD + `~(w = z) ==> x - (x * (w - z)) / (w - z) = Cx(&0)`]]);; + +let HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN = prove + (`!f f' z s. + (f has_complex_derivative f') (at z within s) <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ + g continuous (at z within s) /\ g(z) = f'`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_RING `w' - z':complex = a <=> w' = z' + a`] THEN + SIMP_TAC[GSYM FUN_EQ_THM; HAS_COMPLEX_DERIVATIVE_WITHIN; + CONTINUOUS_WITHIN] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `\w. if w = z then f':complex else (f(w) - f(z)) / (w - z)` THEN + ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; COMPLEX_SUB_REFL] THEN + CONV_TAC COMPLEX_FIELD; + FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN + ASM_SIMP_TAC[COMPLEX_RING `(z + a) - (z + b * (w - w)):complex = a`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + LIM_TRANSFORM)) THEN + SIMP_TAC[LIM_CONST; COMPLEX_VEC_0; COMPLEX_FIELD + `~(w = z) ==> x - (x * (w - z)) / (w - z) = Cx(&0)`]]);; + +let COMPLEX_DIFFERENTIABLE_CARATHEODORY_AT = prove + (`!f z. f complex_differentiable at z <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g continuous at z`, + SIMP_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT] THEN + MESON_TAC[]);; + +let COMPLEX_DIFFERENTIABLE_CARATHEODORY_WITHIN = prove + (`!f z s. + f complex_differentiable (at z within s) <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g continuous (at z within s)`, + SIMP_TAC[complex_differentiable; + HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A slightly stronger, more traditional notion of analyticity on a set. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("analytic_on",(12,"right"));; + +let analytic_on = new_definition + `f analytic_on s <=> + !x. x IN s ==> ?e. &0 < e /\ f holomorphic_on ball(x,e)`;; + +let ANALYTIC_IMP_HOLOMORPHIC = prove + (`!f s. f analytic_on s ==> f holomorphic_on s`, + REWRITE_TAC[analytic_on; holomorphic_on] THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; CENTRE_IN_BALL]);; + +let ANALYTIC_ON_OPEN = prove + (`!f s. open s ==> (f analytic_on s <=> f holomorphic_on s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[ANALYTIC_IMP_HOLOMORPHIC] THEN + REWRITE_TAC[analytic_on; holomorphic_on] THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + REWRITE_TAC[SUBSET] THEN MESON_TAC[CENTRE_IN_BALL]);; + +let ANALYTIC_ON_IMP_DIFFERENTIABLE_AT = prove + (`!f s x. f analytic_on s /\ x IN s ==> f complex_differentiable (at x)`, + SIMP_TAC[analytic_on; HOLOMORPHIC_ON_OPEN; OPEN_BALL; + complex_differentiable] THEN + MESON_TAC[CENTRE_IN_BALL]);; + +let ANALYTIC_ON_SUBSET = prove + (`!f s t. f analytic_on s /\ t SUBSET s ==> f analytic_on t`, + REWRITE_TAC[analytic_on; SUBSET] THEN MESON_TAC[]);; + +let ANALYTIC_ON_UNION = prove + (`!f s t. f analytic_on (s UNION t) <=> f analytic_on s /\ f analytic_on t`, + REWRITE_TAC [analytic_on; IN_UNION] THEN MESON_TAC[]);; + +let ANALYTIC_ON_UNIONS = prove + (`!f s. f analytic_on (UNIONS s) <=> (!t. t IN s ==> f analytic_on t)`, + REWRITE_TAC [analytic_on; IN_UNIONS] THEN MESON_TAC[]);; + +let ANALYTIC_ON_HOLOMORPHIC = prove + (`!f s. f analytic_on s <=> ?t. open t /\ s SUBSET t /\ f holomorphic_on t`, + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `?t. open t /\ s SUBSET t /\ f analytic_on t` THEN CONJ_TAC THENL + [EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `UNIONS {u | open u /\ f analytic_on u}` THEN + SIMP_TAC [IN_ELIM_THM; OPEN_UNIONS; ANALYTIC_ON_UNIONS] THEN + REWRITE_TAC [SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + ASM_MESON_TAC [analytic_on; ANALYTIC_ON_OPEN; OPEN_BALL; CENTRE_IN_BALL]; + MESON_TAC [ANALYTIC_ON_SUBSET]]; + MESON_TAC [ANALYTIC_ON_OPEN]]);; + +let ANALYTIC_ON_LINEAR = prove + (`!s c. (\w. c * w) analytic_on s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [ANALYTIC_ON_HOLOMORPHIC; HOLOMORPHIC_ON_LINEAR] THEN + EXISTS_TAC `(:complex)` THEN REWRITE_TAC [OPEN_UNIV; SUBSET_UNIV]);; + +let ANALYTIC_ON_CONST = prove + (`!c s. (\z. c) analytic_on s`, + REWRITE_TAC[analytic_on; HOLOMORPHIC_ON_CONST] THEN MESON_TAC[REAL_LT_01]);; + +let ANALYTIC_ON_ID = prove + (`!s. (\z. z) analytic_on s`, + REWRITE_TAC[analytic_on; HOLOMORPHIC_ON_ID] THEN MESON_TAC[REAL_LT_01]);; + +let ANALYTIC_ON_COMPOSE = prove + (`!f g s. f analytic_on s /\ g analytic_on (IMAGE f s) + ==> (g o f) analytic_on s`, + REWRITE_TAC[analytic_on; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "f") (LABEL_TAC "g")) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + REMOVE_THEN "f" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; CONTINUOUS_AT_BALL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (d:real) k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THENL + [EXISTS_TAC `ball(z:complex,d)`; + EXISTS_TAC `ball((f:complex->complex) z,e)`] THEN + ASM_REWRITE_TAC[BALL_MIN_INTER; INTER_SUBSET] THEN ASM SET_TAC[]);; + +let ANALYTIC_ON_COMPOSE_GEN = prove + (`!f g s t. f analytic_on s /\ g analytic_on t /\ (!z. z IN s ==> f z IN t) + ==> g o f analytic_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ANALYTIC_ON_COMPOSE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ANALYTIC_ON_SUBSET THEN ASM SET_TAC[]);; + +let ANALYTIC_ON_NEG = prove + (`!f s. f analytic_on s ==> (\z. --(f z)) analytic_on s`, + SIMP_TAC[analytic_on] THEN MESON_TAC[HOLOMORPHIC_ON_NEG]);; + +let ANALYTIC_ON_ADD = prove + (`!f g s. + f analytic_on s /\ g analytic_on s ==> (\z. f z + g z) analytic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `e:real`)) THEN + EXISTS_TAC `min (d:real) e` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; BALL_MIN_INTER; IN_INTER] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; + +let ANALYTIC_ON_SUB = prove + (`!f g s. + f analytic_on s /\ g analytic_on s ==> (\z. f z - g z) analytic_on s`, + SIMP_TAC[complex_sub; ANALYTIC_ON_ADD; ANALYTIC_ON_NEG]);; + +let ANALYTIC_ON_MUL = prove + (`!f g s. + f analytic_on s /\ g analytic_on s ==> (\z. f z * g z) analytic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `e:real`)) THEN + EXISTS_TAC `min (d:real) e` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; BALL_MIN_INTER; IN_INTER] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; + +let ANALYTIC_ON_INV = prove + (`!f s. f analytic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> (\z. inv(f z)) analytic_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[analytic_on] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [analytic_on]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?e. &0 < e /\ !y:complex. dist(z,y) < e ==> ~(f y = Cx(&0))` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_OPEN_AVOID THEN + EXISTS_TAC `ball(z:complex,d)` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CENTRE_IN_BALL; OPEN_BALL]; + REWRITE_TAC[GSYM IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN + ASM_SIMP_TAC[BALL_MIN_INTER; IN_INTER] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]]);; + +let ANALYTIC_ON_DIV = prove + (`!f g s. + f analytic_on s /\ g analytic_on s /\ + (!z. z IN s ==> ~(g z = Cx(&0))) + ==> (\z. f z / g z) analytic_on s`, + SIMP_TAC[complex_div; ANALYTIC_ON_MUL; ANALYTIC_ON_INV]);; + +let ANALYTIC_ON_POW = prove + (`!f s n. f analytic_on s ==> (\z. (f z) pow n) analytic_on s`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[complex_pow] THEN + ASM_SIMP_TAC[ANALYTIC_ON_CONST; ANALYTIC_ON_MUL]);; + +let ANALYTIC_ON_VSUM = prove + (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) analytic_on s) + ==> (\x. vsum k (\a. f a x)) analytic_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[VSUM_CLAUSES] THEN + SIMP_TAC[ANALYTIC_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ANALYTIC_ON_ADD THEN + ASM_SIMP_TAC[ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* The case of analyticity at a point. *) +(* ------------------------------------------------------------------------- *) + +let ANALYTIC_AT_BALL = prove + (`!f z. f analytic_on {z} <=> ?e. &0 ?s. open s /\ z IN s /\ f holomorphic_on s`, + REWRITE_TAC [ANALYTIC_ON_HOLOMORPHIC; SING_SUBSET]);; + +let ANALYTIC_ON_ANALYTIC_AT = prove + (`!f s. f analytic_on s <=> !z. z IN s ==> f analytic_on {z}`, + REWRITE_TAC [ANALYTIC_AT_BALL; analytic_on]);; + +let ANALYTIC_AT_TWO = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} <=> + ?s. open s /\ z IN s /\ f holomorphic_on s /\ g holomorphic_on s`, + REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HOLOMORPHIC_ON_SUBSET; OPEN_INTER; INTER_SUBSET; IN_INTER]);; + +let ANALYTIC_AT_ADD = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} + ==> (\w. f w + g w) analytic_on {z}`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HOLOMORPHIC_ON_ADD]);; + +let ANALYTIC_AT_SUB = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} + ==> (\w. f w - g w) analytic_on {z}`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HOLOMORPHIC_ON_SUB]);; + +let ANALYTIC_AT_MUL = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} + + ==> (\w. f w * g w) analytic_on {z}`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HOLOMORPHIC_ON_MUL]);; + +let ANALYTIC_AT_POW = prove + (`!f n z. f analytic_on {z} + ==> (\w. f w pow n) analytic_on {z}`, + REWRITE_TAC [ANALYTIC_AT] THEN MESON_TAC [HOLOMORPHIC_ON_POW]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems for derivative with analytic_at {z} hypotheses. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DERIVATIVE_ADD_AT = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} + ==> complex_derivative (\w. f w + g w) z = + complex_derivative f z + complex_derivative g z`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_ADD THEN + ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]);; + +let COMPLEX_DERIVATIVE_SUB_AT = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} + ==> complex_derivative (\w. f w - g w) z = + complex_derivative f z - complex_derivative g z`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_SUB THEN + ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]);; + +let COMPLEX_DERIVATIVE_MUL_AT = prove + (`!f g z. f analytic_on {z} /\ g analytic_on {z} + ==> complex_derivative (\w. f w * g w) z = + f z * complex_derivative g z + complex_derivative f z * g z`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_MUL THEN + ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]);; + +let COMPLEX_DERIVATIVE_LMUL_AT = prove + (`!f c z. f analytic_on {z} + ==> complex_derivative (\w. c * f w) z = c * complex_derivative f z`, + REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; COMPLEX_DERIVATIVE_LMUL]);; + +let COMPLEX_DERIVATIVE_RMUL_AT = prove + (`!f c z. f analytic_on {z} + ==> complex_derivative (\w. f w * c) z = complex_derivative f z * c`, + REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; COMPLEX_DERIVATIVE_RMUL]);; + +(* ------------------------------------------------------------------------- *) +(* A composition lemma for functions of mixed type. *) +(* ------------------------------------------------------------------------- *) + +let HAS_VECTOR_DERIVATIVE_REAL_COMPLEX = prove + (`(f has_complex_derivative f') (at(Cx(drop a))) + ==> ((\x. f(Cx(drop x))) has_vector_derivative f') (at a)`, + REWRITE_TAC[has_complex_derivative; has_vector_derivative] THEN + REWRITE_TAC[COMPLEX_CMUL] THEN MP_TAC(ISPECL + [`\x. Cx(drop x)`; `f:complex->complex`; + `\x. Cx(drop x)`; `\x:complex. f' * x`; `a:real^1`] DIFF_CHAIN_AT) THEN + REWRITE_TAC[o_DEF; COMPLEX_MUL_SYM; IMP_CONJ] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL; COMPLEX_CMUL]);; + +let DIFFERENTIABLE_REAL_COMPLEX = prove + (`!f a. f complex_differentiable at (Cx(drop a)) + ==> (\x. f(Cx(drop x))) differentiable at a`, + REWRITE_TAC[complex_differentiable; VECTOR_DERIVATIVE_WORKS] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_derivative] THEN + ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_REAL_COMPLEX]);; + +(* ------------------------------------------------------------------------- *) +(* Complex differentiation of sequences and series. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_SEQUENCE = prove + (`!s f f' g'. + convex s /\ + (!n x. x IN s + ==> (f n has_complex_derivative f' n x) (at x within s)) /\ + (!e. &0 < e + ==> ?N. !n x. n >= N /\ x IN s ==> norm (f' n x - g' x) <= e) /\ + (?x l. x IN s /\ ((\n. f n x) --> l) sequentially) + ==> ?g. !x. x IN s + ==> ((\n. f n x) --> g x) sequentially /\ + (g has_complex_derivative g' x) (at x within s)`, + REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_SEQUENCE THEN + EXISTS_TAC `\n x h:complex. (f':num->complex->complex) n x * h` THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN + ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]);; + +let HAS_COMPLEX_DERIVATIVE_SERIES = prove + (`!s f f' g' k. + convex s /\ + (!n x. x IN s + ==> (f n has_complex_derivative f' n x) (at x within s)) /\ + (!e. &0 < e + ==> ?N. !n x. n >= N /\ x IN s + ==> norm(vsum (k INTER (0..n)) (\i. f' i x) - g' x) + <= e) /\ + (?x l. x IN s /\ ((\n. f n x) sums l) k) + ==> ?g. !x. x IN s + ==> ((\n. f n x) sums g x) k /\ + (g has_complex_derivative g' x) (at x within s)`, + REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_SERIES THEN + EXISTS_TAC `\n x h:complex. (f':num->complex->complex) n x * h` THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + SIMP_TAC[GSYM COMPLEX_SUB_RDISTRIB; VSUM_COMPLEX_RMUL; FINITE_NUMSEG; + FINITE_INTER; COMPLEX_NORM_MUL] THEN + ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Bound theorem. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DIFFERENTIABLE_BOUND = prove + (`!f f' s B. + convex s /\ + (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s) /\ + norm(f' x) <= B) + ==> !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_complex_derivative] THEN + STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_BOUND THEN + EXISTS_TAC `\x:complex h. f' x * h` THEN ASM_SIMP_TAC[] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\h. (f':complex->complex) x * h` ONORM) THEN + REWRITE_TAC[LINEAR_COMPLEX_MUL] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN + GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Inverse function theorem for complex derivatives. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC = prove + (`!f g f' t y. + (f has_complex_derivative f') (at (g y)) /\ + ~(f' = Cx(&0)) /\ + g continuous at y /\ + open t /\ + y IN t /\ + (!z. z IN t ==> f (g z) = z) + ==> (g has_complex_derivative inv(f')) (at y)`, + REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC THEN + MAP_EVERY EXISTS_TAC + [`f:complex->complex`; `\x:complex. f' * x`; `t:complex->bool`] THEN + ASM_REWRITE_TAC[LINEAR_COMPLEX_MUL; FUN_EQ_THM; o_THM; I_THM] THEN + UNDISCH_TAC `~(f' = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD);; + +let HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG = prove + (`!f g f' s x. + open s /\ + x IN s /\ + f continuous_on s /\ + (!x. x IN s ==> g (f x) = x) /\ + (f has_complex_derivative f') (at x) /\ + ~(f' = Cx(&0)) + ==> (g has_complex_derivative inv(f')) (at (f x))`, + REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN + MAP_EVERY EXISTS_TAC [`\x:complex. f' * x`; `s:complex->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + UNDISCH_TAC `~(f' = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD);; + +let HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X = prove + (`!f g f' s y. + open s /\ (g y) IN s /\ f continuous_on s /\ + (!x. x IN s ==> (g(f(x)) = x)) /\ + (f has_complex_derivative f') (at (g y)) /\ ~(f' = Cx(&0)) /\ + f(g y) = y + ==> (g has_complex_derivative inv(f')) (at y)`, + REWRITE_TAC[has_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG_X THEN MAP_EVERY EXISTS_TAC + [`f:complex->complex`; `\x:complex. f' * x`; `s:complex->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + UNDISCH_TAC `~(f' = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy-Riemann condition and relation to conformal. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_BASIS = prove + (`basis 1 = Cx(&1) /\ basis 2 = ii`, + SIMP_TAC[CART_EQ; FORALL_2; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE_CX; IM_CX] THEN + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let CAUCHY_RIEMANN = prove + (`!f z. f complex_differentiable at z <=> + f differentiable at z /\ + (jacobian f (at z))$1$1 = (jacobian f (at z))$2$2 /\ + (jacobian f (at z))$1$2 = --((jacobian f (at z))$2$1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[complex_differentiable] THEN EQ_TAC THENL + [REWRITE_TAC[has_complex_derivative] THEN + DISCH_THEN(X_CHOOSE_THEN `f':complex` ASSUME_TAC) THEN + CONJ_TAC THENL [ASM_MESON_TAC[differentiable]; ALL_TAC] THEN + REWRITE_TAC[jacobian] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP FRECHET_DERIVATIVE_AT) THEN + SIMP_TAC[matrix; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[COMPLEX_BASIS; GSYM RE_DEF; GSYM IM_DEF; ii] THEN + SIMPLE_COMPLEX_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC + `complex(jacobian (f:complex->complex) (at z)$1$1, + jacobian f (at z)$2$1)` THEN + REWRITE_TAC[has_complex_derivative] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [JACOBIAN_WORKS]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; DIMINDEX_2; SUM_2; ARITH; + FORALL_2; FUN_EQ_THM; LAMBDA_BETA] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; IM; RE; complex_mul] THEN + REAL_ARITH_TAC]);; + +let COMPLEX_DERIVATIVE_JACOBIAN = prove + (`!f z. + f complex_differentiable (at z) + ==> complex_derivative f z = + complex(jacobian f (at z)$1$1,jacobian f (at z)$2$1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN + MAP_EVERY EXISTS_TAC [`f:complex->complex`; `z:complex`] THEN + ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + REWRITE_TAC[has_complex_derivative] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [CAUCHY_RIEMANN]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [JACOBIAN_WORKS]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; DIMINDEX_2; SUM_2; ARITH; + FORALL_2; FUN_EQ_THM; LAMBDA_BETA] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; IM; RE; complex_mul] THEN + REAL_ARITH_TAC);; + +let COMPLEX_DIFFERENTIABLE_EQ_CONFORMAL = prove + (`!f z. + f complex_differentiable at z /\ ~(complex_derivative f z = Cx(&0)) <=> + f differentiable at z /\ + ?a. ~(a = &0) /\ rotation_matrix (a %% jacobian f (at z))`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE; + COMPLEX_DERIVATIVE_JACOBIAN] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM DOT_EQ_0] THEN + REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF; RE; IM; GSYM REAL_POW_2] THEN + REWRITE_TAC[RE_DEF; IM_DEF; ROTATION_MATRIX_2] THEN + RULE_ASSUM_TAC(REWRITE_RULE[CAUCHY_RIEMANN]) THEN + ASM_REWRITE_TAC[MATRIX_CMUL_COMPONENT] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_MUL_RNEG; GSYM REAL_ADD_LDISTRIB; + REAL_ARITH `(a * x:real) pow 2 = a pow 2 * x pow 2`] THEN + EXISTS_TAC + `inv(sqrt(jacobian (f:complex->complex) (at z)$2$2 pow 2 + + jacobian f (at z)$2$1 pow 2))` THEN + MATCH_MP_TAC(REAL_FIELD + `x pow 2 = y /\ ~(y = &0) + ==> ~(inv x = &0) /\ inv(x) pow 2 * y = &1`) THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2]; + REWRITE_TAC[ROTATION_MATRIX_2; MATRIX_CMUL_COMPONENT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[GSYM REAL_MUL_RNEG; REAL_EQ_MUL_LCANCEL] THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[CAUCHY_RIEMANN]; DISCH_TAC] THEN + ASM_SIMP_TAC[COMPLEX_DERIVATIVE_JACOBIAN] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM DOT_EQ_0] THEN + REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF; RE; IM; GSYM REAL_POW_2] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP + (REAL_RING `(a * x) pow 2 + (a * y) pow 2 = &1 + ==> ~(x pow 2 + y pow 2 = &0)`)) THEN + ASM_REWRITE_TAC[RE_DEF; IM_DEF]]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiation conversion. *) +(* ------------------------------------------------------------------------- *) + +let complex_differentiation_theorems = ref [];; + +let add_complex_differentiation_theorems = + let ETA_THM = prove + (`(f has_complex_derivative f') net <=> + ((\x. f x) has_complex_derivative f') net`, + REWRITE_TAC[ETA_AX]) in + let ETA_TWEAK = + PURE_REWRITE_RULE [IMP_CONJ] o + GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o + SPEC_ALL in + fun l -> complex_differentiation_theorems := + !complex_differentiation_theorems @ map ETA_TWEAK l;; + +add_complex_differentiation_theorems + [HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN; HAS_COMPLEX_DERIVATIVE_LMUL_AT; + HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN; HAS_COMPLEX_DERIVATIVE_RMUL_AT; + HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN; HAS_COMPLEX_DERIVATIVE_CDIV_AT; + HAS_COMPLEX_DERIVATIVE_ID; + HAS_COMPLEX_DERIVATIVE_CONST; + HAS_COMPLEX_DERIVATIVE_NEG; + HAS_COMPLEX_DERIVATIVE_ADD; + HAS_COMPLEX_DERIVATIVE_SUB; + HAS_COMPLEX_DERIVATIVE_MUL_WITHIN; HAS_COMPLEX_DERIVATIVE_MUL_AT; + HAS_COMPLEX_DERIVATIVE_DIV_WITHIN; HAS_COMPLEX_DERIVATIVE_DIV_AT; + HAS_COMPLEX_DERIVATIVE_POW_WITHIN; HAS_COMPLEX_DERIVATIVE_POW_AT; + HAS_COMPLEX_DERIVATIVE_INV_WITHIN; HAS_COMPLEX_DERIVATIVE_INV_AT];; + +let GEN_COMPLEX_DIFF_CONV ths = + let partfn tm = let l,r = dest_comb tm in mk_pair(lhand l,r) + and is_deriv = can (term_match [] `(f has_complex_derivative f') net`) + and ths' = + unions(mapfilter (CONJUNCTS o REWRITE_RULE[FORALL_AND_THM] o + MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV) ths) in + let rec COMPLEX_DIFF_CONV tm = + try tryfind (fun th -> PART_MATCH partfn th (partfn tm)) + (!complex_differentiation_theorems @ ths') + with Failure _ -> + let ith = tryfind (fun th -> + PART_MATCH (partfn o repeat (snd o dest_imp)) th (partfn tm)) + (!complex_differentiation_theorems @ ths') in + COMPLEX_DIFF_ELIM ith + and COMPLEX_DIFF_ELIM th = + let tm = concl th in + if not(is_imp tm) then th else + let t = lhand tm in + if not(is_deriv t) then UNDISCH th + else COMPLEX_DIFF_ELIM (MATCH_MP th (COMPLEX_DIFF_CONV t)) in + COMPLEX_DIFF_CONV;; + +let COMPLEX_DIFF_CONV = GEN_COMPLEX_DIFF_CONV [];; + +(* ------------------------------------------------------------------------- *) +(* Hence a tactic. *) +(* ------------------------------------------------------------------------- *) + +let GEN_COMPLEX_DIFF_TAC ths = + let pth = MESON[] + `(f has_complex_derivative f') net + ==> f' = g' + ==> (f has_complex_derivative g') net` in + W(fun (asl,w) -> let th = MATCH_MP pth (GEN_COMPLEX_DIFF_CONV ths w) in + MATCH_MP_TAC(repeat (GEN_REWRITE_RULE I [IMP_IMP]) (DISCH_ALL th)));; + +let COMPLEX_DIFF_TAC = GEN_COMPLEX_DIFF_TAC [];; + +let COMPLEX_DIFFERENTIABLE_TAC = + let DISCH_FIRST th = DISCH (hd(hyp th)) th in + GEN_REWRITE_TAC I [complex_differentiable] THEN + W(fun (asl,w) -> + let th = COMPLEX_DIFF_CONV(snd(dest_exists w)) in + let f' = rand(rator(concl th)) in + EXISTS_TAC f' THEN + (if hyp th = [] then MATCH_ACCEPT_TAC th else + let th' = repeat (GEN_REWRITE_RULE I [IMP_IMP] o DISCH_FIRST) + (DISCH_FIRST th) in + MATCH_MP_TAC th'));; + +(* ------------------------------------------------------------------------- *) +(* A kind of complex Taylor theorem. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_TAYLOR = prove + (`!f n s B. + convex s /\ + (!i x. x IN s /\ i <= n + ==> ((f i) has_complex_derivative f (i + 1) x) (at x within s)) /\ + (!x. x IN s ==> norm(f (n + 1) x) <= B) + ==> !w z. w IN s /\ z IN s + ==> norm(f 0 z - + vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i)))) + <= B * norm(z - w) pow (n + 1) / &(FACT n)`, + let lemma = prove + (`!f:num->real^N. + vsum (0..n) f = f 0 - f (n + 1) + vsum (0..n) (\i. f (i + 1))`, + REWRITE_TAC[GSYM(REWRITE_CONV[o_DEF] `(f:num->real^N) o (\i. i + 1)`)] THEN + ASM_SIMP_TAC[GSYM VSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM NUMSEG_OFFSET_IMAGE] THEN + SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM ADD1] THEN + REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN VECTOR_ARITH_TAC) in + REPEAT STRIP_TAC THEN MP_TAC(SPECL + [`(\w. vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i))))`; + `\w. (f:num->complex->complex) (n + 1) w * + (z - w) pow n / Cx(&(FACT n))`; `segment[w:complex,z]`; + `B * norm(z - w:complex) pow n / &(FACT n)`] + COMPLEX_DIFFERENTIABLE_BOUND) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[CONVEX_SEGMENT] THEN X_GEN_TAC `u:complex` THEN + DISCH_TAC THEN SUBGOAL_THEN `(u:complex) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET]; ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX; + COMPLEX_NORM_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_POS; REAL_POW_LE] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; FACT_LT] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_MESON_TAC[SEGMENT_BOUND; NORM_SUB]] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]] THEN + SUBGOAL_THEN + `((\u. vsum (0..n) (\i. f i u * (z - u) pow i / Cx (&(FACT i)))) + has_complex_derivative + vsum (0..n) (\i. f i u * (-- Cx(&i) * (z - u) pow (i - 1)) / + Cx(&(FACT i)) + + f (i + 1) u * (z - u) pow i / Cx (&(FACT i)))) + (at u within s)` + MP_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_WITHIN THEN + ASM_SIMP_TAC[ETA_AX] THEN W(MP_TAC o COMPLEX_DIFF_CONV o snd) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[VSUM_ADD_NUMSEG] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [lemma] THEN + REWRITE_TAC[GSYM VSUM_ADD_NUMSEG; GSYM COMPLEX_ADD_ASSOC] THEN + REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL; CX_MUL] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_RING + `--a * b * inv a * c:complex = --(a * inv a) * b * c`] THEN + SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_MUL_LID] THEN + REWRITE_TAC[COMPLEX_ADD_LINV; GSYM COMPLEX_VEC_0; VSUM_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`z:complex`; `w:complex`]) THEN ANTS_TAC THEN + ASM_REWRITE_TAC[ENDS_IN_SEGMENT] THEN MATCH_MP_TAC EQ_IMP THEN + BINOP_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_POW_ADD; real_div; REAL_POW_1] THEN REAL_ARITH_TAC] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; complex_pow; FACT; COMPLEX_DIV_1] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x * Cx(&1) + y = x <=> y = Cx(&0)`] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN + INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; complex_div; COMPLEX_MUL_LZERO; + COMPLEX_MUL_RZERO; COMPLEX_SUB_REFL; COMPLEX_VEC_0] THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The simplest special case. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_MVT = prove + (`!f f' s B. + convex s /\ + (!z. z IN s ==> (f has_complex_derivative f' z) (at z within s)) /\ + (!z. z IN s ==> norm (f' z) <= B) + ==> !w z. w IN s /\ z IN s ==> norm (f z - f w) <= B * norm (z - w)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`(\n. if n = 0 then f else f'):num->complex->complex`; + `0`; `s:complex->bool`; `B:real`] COMPLEX_TAYLOR) THEN + SIMP_TAC[NUMSEG_SING; VSUM_SING; LE; ARITH] THEN + REWRITE_TAC[complex_pow; REAL_POW_1; FACT; REAL_DIV_1] THEN + ASM_SIMP_TAC[COMPLEX_DIV_1; COMPLEX_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Something more like the traditional MVT for real components. *) +(* Could, perhaps should, sharpen this to derivatives inside the segment. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_MVT_LINE = prove + (`!f f' w z. + (!u. u IN segment[w,z] + ==> (f has_complex_derivative f'(u)) (at u)) + ==> ?u. u IN segment[w,z] /\ Re(f z) - Re(f w) = Re(f'(u) * (z - w))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(lift o Re) o (f:complex->complex) o + (\t. (&1 - drop t) % w + drop t % z)`; + `\u. (lift o Re) o + (\h. (f':complex->complex)((&1 - drop u) % w + drop u % z) * h) o + (\t. drop t % (z - w))`; + `vec 0:real^1`; `vec 1:real^1`] + MVT_VERY_SIMPLE) THEN + ANTS_TAC THENL + [REWRITE_TAC[DROP_VEC; REAL_POS] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC DIFF_CHAIN_AT THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[linear; LIFT_ADD; RE_ADD; LIFT_CMUL; RE_CMUL; o_DEF]] THEN + MATCH_MP_TAC DIFF_CHAIN_AT THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `(&1 - t) % w + t % z = w + t % (z - w)`] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o ABS_CONV) + [GSYM VECTOR_ADD_LID] THEN + MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN + MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM has_complex_derivative] THEN + FIRST_X_ASSUM MATCH_MP_TAC; + REWRITE_TAC[o_THM; GSYM LIFT_SUB; LIFT_EQ; DROP_VEC; VECTOR_SUB_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(&1 - drop t) % w + drop t % z:complex`] THEN + ASM_REWRITE_TAC[segment; IN_ELIM_THM] THEN + EXISTS_TAC `drop t` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[DROP_VEC]);; + +let COMPLEX_TAYLOR_MVT = prove + (`!f w z n. + (!i x. x IN segment[w,z] /\ i <= n + ==> ((f i) has_complex_derivative f (i + 1) x) (at x)) + ==> ?u. u IN segment[w,z] /\ + Re(f 0 z) = + Re(vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i))) + + (f (n + 1) u * (z - u) pow n / Cx (&(FACT n))) * (z - w))`, + let lemma = prove + (`!f:num->real^N. + vsum (0..n) f = f 0 - f (n + 1) + vsum (0..n) (\i. f (i + 1))`, + REWRITE_TAC[GSYM(REWRITE_CONV[o_DEF] `(f:num->real^N) o (\i. i + 1)`)] THEN + ASM_SIMP_TAC[GSYM VSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM NUMSEG_OFFSET_IMAGE] THEN + SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM ADD1] THEN + REWRITE_TAC[ARITH; ARITH_RULE `1 <= SUC n`] THEN VECTOR_ARITH_TAC) in + REPEAT STRIP_TAC THEN MP_TAC(SPECL + [`(\w. vsum (0..n) (\i. f i w * (z - w) pow i / Cx(&(FACT i))))`; + `\w. (f:num->complex->complex) (n + 1) w * + (z - w) pow n / Cx(&(FACT n))`; + `w:complex`; `z:complex`] + COMPLEX_MVT_LINE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[CONVEX_SEGMENT] THEN X_GEN_TAC `u:complex` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `((\u. vsum (0..n) (\i. f i u * (z - u) pow i / Cx (&(FACT i)))) + has_complex_derivative + vsum (0..n) (\i. f i u * (-- Cx(&i) * (z - u) pow (i - 1)) / + Cx(&(FACT i)) + + f (i + 1) u * (z - u) pow i / Cx (&(FACT i)))) + (at u)` + MP_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN + ASM_SIMP_TAC[ETA_AX] THEN W(MP_TAC o COMPLEX_DIFF_CONV o snd) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[VSUM_ADD_NUMSEG] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [lemma] THEN + REWRITE_TAC[GSYM VSUM_ADD_NUMSEG; GSYM COMPLEX_ADD_ASSOC] THEN + REWRITE_TAC[ADD_SUB] THEN REWRITE_TAC[GSYM ADD1; FACT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL; CX_MUL] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_RING + `--a * b * inv a * c:complex = --(a * inv a) * b * c`] THEN + SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_MUL_LID] THEN + REWRITE_TAC[COMPLEX_ADD_LINV; GSYM COMPLEX_VEC_0; VSUM_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_NEG_0] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:complex` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[RE_ADD] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_EQ_SUB_RADD] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; complex_pow; FACT; COMPLEX_DIV_1] THEN + REWRITE_TAC[COMPLEX_MUL_RID; RE_ADD] THEN + MATCH_MP_TAC(REAL_ARITH `Re x = &0 ==> y = y + Re x`) THEN + SIMP_TAC[RE_VSUM; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; complex_pow; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; RE_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Further useful properties of complex conjugation. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CNJ = prove + (`!net f l. ((\x. cnj(f x)) --> cnj l) net <=> (f --> l) net`, + REWRITE_TAC[LIM; dist; GSYM CNJ_SUB; COMPLEX_NORM_CNJ]);; + +let SUMS_CNJ = prove + (`!net f l. ((\x. cnj(f x)) sums cnj l) net <=> (f sums l) net`, + SIMP_TAC[sums; LIM_CNJ; GSYM CNJ_VSUM; FINITE_INTER_NUMSEG]);; + +let CONTINUOUS_WITHIN_CNJ = prove + (`!s z. cnj continuous (at z within s)`, + SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; LINEAR_CNJ]);; + +let CONTINUOUS_AT_CNJ = prove + (`!z. cnj continuous (at z)`, + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_CNJ]);; + +let CONTINUOUS_ON_CNJ = prove + (`!s. cnj continuous_on s`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_CNJ]);; + +(* ------------------------------------------------------------------------- *) +(* Some limit theorems about real part of real series etc. *) +(* ------------------------------------------------------------------------- *) + +let REAL_LIM = prove + (`!net:(A)net f l. + (f --> l) net /\ ~(trivial_limit net) /\ + (?b. (?a. netord net a b) /\ !a. netord net a b ==> real(f a)) + ==> real l`, + REWRITE_TAC[IM_DEF; real] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_COMPONENT_EQ THEN + REWRITE_TAC[eventually; DIMINDEX_2; ARITH] THEN ASM_MESON_TAC[]);; + +let REAL_LIM_SEQUENTIALLY = prove + (`!f l. (f --> l) sequentially /\ (?N. !n. n >= N ==> real(f n)) + ==> real l`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN + REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_MESON_TAC[GE_REFL]);; + +let REAL_SERIES = prove + (`!f l s. (f sums l) s /\ (!n. real(f n)) ==> real l`, + REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LIM_SEQUENTIALLY THEN + EXISTS_TAC `\n. vsum(s INTER (0..n)) f :complex` THEN + ASM_SIMP_TAC[REAL_VSUM; FINITE_INTER; FINITE_NUMSEG]);; + +(* ------------------------------------------------------------------------- *) +(* Often convenient to use comparison with real limit of complex type. *) +(* ------------------------------------------------------------------------- *) + +let LIM_NULL_COMPARISON_COMPLEX = prove + (`!net:(A)net f g. + eventually (\x. norm(f x) <= norm(g x)) net /\ + (g --> Cx(&0)) net + ==> (f --> Cx(&0)) net`, + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `net:(A)net` LIM_NULL_COMPARISON) THEN + EXISTS_TAC `norm o (g:A->complex)` THEN + ASM_REWRITE_TAC[o_THM; GSYM LIM_NULL_NORM]);; + +let LIM_NULL_COMPARISON_COMPLEX_RE = prove + (`!net:(A)net f g. + eventually (\x. norm(f x) <= Re(g x)) net /\ + (g --> Cx(&0)) net + ==> (f --> Cx(&0)) net`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `net:(A)net` LIM_NULL_COMPARISON_COMPLEX) THEN + EXISTS_TAC `g:A->complex` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] EVENTUALLY_MONO)) THEN + REWRITE_TAC[] THEN + MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_ABS_LE; REAL_LE_TRANS]);; + +let SERIES_COMPARISON_COMPLEX = prove + (`!f:num->real^N g s. + summable s g /\ + (!n. n IN s ==> real(g n) /\ &0 <= Re(g n)) /\ + (?N. !n. n >= N /\ n IN s ==> norm(f n) <= norm(g n)) + ==> summable s f`, + REPEAT GEN_TAC THEN REWRITE_TAC[summable] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\n. norm((g:num->complex) n)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `lift(Re l)` THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\i:num. lift(Re(g i))` THEN + ASM_SIMP_TAC[REAL_NORM_POS; o_DEF] THEN + REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC SERIES_COMPONENT THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +let SERIES_COMPARISON_UNIFORM_COMPLEX = prove + (`!f:A->num->real^N g P s. + summable s g /\ + (!n. n IN s ==> real(g n) /\ &0 <= Re(g n)) /\ + (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= norm(g n)) + ==> ?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> dist(vsum(s INTER (0..n)) (f x),l x) < + e`, + REPEAT GEN_TAC THEN REWRITE_TAC[summable] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC SERIES_COMPARISON_UNIFORM THEN + EXISTS_TAC `\n. norm((g:num->complex) n)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `lift(Re l)` THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\i:num. lift(Re(g i))` THEN + ASM_SIMP_TAC[REAL_NORM_POS; o_DEF] THEN + REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC SERIES_COMPONENT THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +let SUMMABLE_SUBSET_COMPLEX = prove + (`!x s t. (!n. n IN s ==> real(x n) /\ &0 <= Re(x n)) /\ + summable s x /\ t SUBSET s + ==> summable t x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN + EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `x:num->complex` THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[REAL_LE_REFL; NORM_0; NORM_POS_LE]);; + +let SERIES_ABSCONV_IMP_CONV = prove + (`!x:num->real^N k. summable k (\n. Cx(norm(x n))) ==> summable k x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n:num. Cx(norm(x n:real^N))` THEN + ASM_REWRITE_TAC[REAL_CX; RE_CX; NORM_POS_LE; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NORM; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Complex-valued geometric series. *) +(* ------------------------------------------------------------------------- *) + +let SUMS_GP = prove + (`!n z. norm(z) < &1 + ==> ((\k. z pow k) sums (z pow n / (Cx(&1) - z))) (from n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SERIES_FROM; VSUM_GP] THEN + ASM_CASES_TAC `z = Cx(&1)` THENL + [ASM_MESON_TAC[COMPLEX_NORM_NUM; REAL_LT_REFL]; ALL_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\m. (z pow n - z pow SUC m) / (Cx (&1) - z)` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `n:num` THEN SIMP_TAC[GSYM NOT_LE]; + MATCH_MP_TAC LIM_COMPLEX_DIV THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0; LIM_CONST] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; GSYM COMPLEX_VEC_0] THEN + REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`norm(z:complex)`; `e:real`] REAL_ARCH_POW_INV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> y <= x ==> y < e`)) THEN + REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN + UNDISCH_TAC `n:num <= m` THEN ARITH_TAC]);; + +let SUMMABLE_GP = prove + (`!z k. norm(z) < &1 ==> summable k (\n. z pow n)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUMMABLE_SUBSET THEN EXISTS_TAC `(:num)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(norm(z:complex) pow n)` THEN + REWRITE_TAC[REAL_CX; RE_CX; COMPLEX_NORM_CX] THEN + SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN CONJ_TAC THENL + [REWRITE_TAC[summable; GSYM FROM_0; CX_POW] THEN + EXISTS_TAC `Cx(norm z) pow 0 / (Cx(&1) - Cx(norm(z:complex)))` THEN + MATCH_MP_TAC SUMS_GP THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NORM]; + EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NORM; REAL_LE_REFL; NORM_POS_LE; + COMPLEX_NORM_POW; NORM_0; REAL_ABS_POS; REAL_POW_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* Convergence of 1/n^k for n >= 2. *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_ZETA_INTEGER = prove + (`!n m. 2 <= m ==> summable (from n) (\k. inv(Cx(&k) pow m))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN + EXISTS_TAC `1` THEN + REWRITE_TAC[summable; GSYM CX_INV; GSYM CX_POW] THEN + MATCH_MP_TAC(MESON[] `(?x. P(Cx x)) ==> ?x. P x`) THEN + REWRITE_TAC[SERIES_CX_LIFT] THEN + REWRITE_TAC[sums; FROM_INTER_NUMSEG; LIM_SEQUENTIALLY; DIST_REAL] THEN + REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; GSYM drop] THEN + MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN + EXISTS_TAC `&2 pow m / (&1 - (&1 / &2) pow (m - 1))` THEN CONJ_TAC THENL + [ALL_TAC; + DISJ1_TAC THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + DISCH_TAC THEN REWRITE_TAC[DROP_VSUM; o_DEF; LIFT_DROP] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[FINITE_NUMSEG; SUBSET_NUMSEG] THEN ASM_ARITH_TAC] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[DROP_VSUM; o_DEF; LIFT_DROP] THEN + SIMP_TAC[real_abs; SUM_POS_LE_NUMSEG; REAL_LE_INV_EQ; + REAL_POW_LE; REAL_POS] THEN + TRANS_TAC REAL_LE_TRANS `sum(1..2 EXP n) (\x. inv(&x pow m))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET_NUMSEG; LE_REFL; + LT_POW2_REFL; LT_IMP_LE]; + ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS + `sum(0..n) (\k. &2 pow m / &2 pow (k * (m - 1)))` THEN + CONJ_TAC THENL + [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + SIMP_TAC[EXP; SUM_SING_NUMSEG; REAL_POW_ONE; MULT_CLAUSES; real_pow] THEN + REWRITE_TAC[REAL_DIV_1; REAL_INV_1; REAL_LE_POW2] THEN + MP_TAC(ISPECL + [`\k. inv(&k pow m)`; `1`; `2 EXP n`; `2 EXP n`] + SUM_ADD_SPLIT) THEN + ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[MULT_2]] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + TRANS_TAC REAL_LE_TRANS + `sum (2 EXP n + 1..2 EXP n + 2 EXP n) (\k. inv(&2 pow n pow m))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; LE_0] THEN ASM_ARITH_TAC; + REWRITE_TAC[SUM_CONST_NUMSEG; ARITH_RULE `((n + n) + 1) - (n + 1) = n`; + GSYM REAL_OF_NUM_POW; REAL_INV_POW; REAL_POW_2] THEN + REWRITE_TAC[REAL_POW_POW; REAL_POW_INV] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_ARITH `a / b * c:real = (a * c) / b`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow); GSYM REAL_POW_ADD] THEN + MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + UNDISCH_TAC `2 <= m` THEN SPEC_TAC(`m:num`,`m:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ARITH; SUC_SUB1] THEN ARITH_TAC]; + ONCE_REWRITE_TAC[MULT_SYM] THEN + REWRITE_TAC[GSYM REAL_POW_POW; real_div] THEN + REWRITE_TAC[REAL_INV_POW; SUM_LMUL] THEN REWRITE_TAC[SUM_GP] THEN + REWRITE_TAC[REAL_INV_EQ_1; REAL_POW_EQ_1; LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= m ==> ~(m - 1 = 0)`] THEN + REWRITE_TAC[CONJUNCT1 real_pow] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH `a / b <= inv b <=> a * inv b <= &1 * inv b`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_ARITH `&1 - x <= &1 <=> &0 <= x`; REAL_LE_INV_EQ] THEN + SIMP_TAC[REAL_POW_LE; REAL_LE_DIV; REAL_POS; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; + +(* ------------------------------------------------------------------------- *) +(* Complex version (the usual one) of Dirichlet convergence test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_DIRICHLET_COMPLEX_GEN = prove + (`!f g N k m p l. + bounded {vsum (m..n) f | n IN (:num)} /\ + summable (from p) (\n. Cx(norm(g(n + 1) - g(n)))) /\ + ((\n. vsum(1..n) f * g(n + 1)) --> l) sequentially + ==> summable (from k) (\n. f(n) * g(n))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + MATCH_MP_TAC SERIES_DIRICHLET_BILINEAR THEN + MAP_EVERY EXISTS_TAC [`m:num`; `p:num`; `l:complex`] THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [summable]) THEN + REWRITE_TAC[summable; SERIES_CAUCHY] THEN + SIMP_TAC[GSYM(REWRITE_RULE[o_DEF] LIFT_SUM); FINITE_NUMSEG; FINITE_INTER; + VSUM_CX; NORM_LIFT; COMPLEX_NORM_CX]);; + +let SERIES_DIRICHLET_COMPLEX = prove + (`!f g N k m. + bounded {vsum (m..n) f | n IN (:num)} /\ + (!n. real(g n)) /\ + (!n. N <= n ==> Re(g(n + 1)) <= Re(g n)) /\ + (g --> Cx(&0)) sequentially + ==> summable (from k) (\n. f(n) * g(n))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->complex`; `\n:num. Re(g n)`; `N:num`; `k:num`; + `m:num`] SERIES_DIRICHLET) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; dist; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; NORM_LIFT] THEN + MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_CMUL; FUN_EQ_THM] THEN + ASM_MESON_TAC[REAL; COMPLEX_MUL_SYM]]);; + +(* ------------------------------------------------------------------------- *) +(* Versions with explicit bounds are sometimes useful. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT = prove + (`!f g B p. + &0 < B /\ 1 <= p /\ + (!m n. p <= m ==> norm(vsum(m..n) f) <= B) /\ + (!n. p <= n ==> real(g n) /\ &0 <= Re(g n)) /\ + (!n. p <= n ==> Re(g(n + 1)) <= Re(g n)) + ==> !m n. p <= m + ==> norm(vsum(m..n) (\k. f k * g k)) <= &2 * B * norm(g m)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `norm(vsum(m..n) (\k. (vsum(p..k) f - vsum(p..(k-1)) f) * g k))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `p:num <= k` + (fun th -> SIMP_TAC[GSYM(MATCH_MP NUMSEG_RREC th)]) + THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE BILINEAR_COMPLEX_MUL] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_0; REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; NORM_POS_LE] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(c) <= e - norm(a) - norm(b) ==> norm(a - b - c) <= e`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (m..n) (\k. norm(g(k + 1) - g(k)) * B)` THEN CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_REFL; LE_REFL; NORM_POS_LE]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. Re(g(k)) - Re(g(k + 1))) * B` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[SUM_RMUL; REAL_LE_RMUL_EQ] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `p <= i /\ p <= i + 1` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_NORM; REAL_SUB; RE_SUB] THEN + ASM_SIMP_TAC[REAL_ARITH `abs(x - y) = y - x <=> x <= y`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[SUM_DIFFS; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `w * n1 <= w * B /\ z * n2 <= z * B /\ &0 <= B * (&2 * y - (x + w + z)) + ==> x * B <= &2 * B * y - w * n1 - z * n2`) THEN + REPEAT(CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[NORM_POS_LE; LE_REFL]; ALL_TAC]) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + SUBGOAL_THEN + `p <= m /\ p <= m + 1 /\ p <= n /\ p <= n + 1` + STRIP_ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_NORM; real_abs] THEN REAL_ARITH_TAC);; + +let SERIES_DIRICHLET_COMPLEX_EXPLICIT = prove + (`!f g p q. + 1 <= p /\ + bounded {vsum (q..n) f | n IN (:num)} /\ + (!n. p <= n ==> real(g n) /\ &0 <= Re(g n)) /\ + (!n. p <= n ==> Re(g(n + 1)) <= Re(g n)) + ==> ?B. &0 < B /\ + !m n. p <= m + ==> norm(vsum(m..n) (\k. f k * g k)) + <= B * norm(g m)`, + REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN + SIMP_TAC[BOUNDED_POS; IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN EXISTS_TAC `&2 * B` THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Integrals and complex multiplication. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_COMPLEX_LMUL = prove + (`!f y i c. (f has_integral y) i ==> ((\x. c * f(x)) has_integral (c * y)) i`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[o_DEF] HAS_INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; + +let HAS_INTEGRAL_COMPLEX_RMUL = prove + (`!f y i c. (f has_integral y) i ==> ((\x. f(x) * c) has_integral (y * c)) i`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[HAS_INTEGRAL_COMPLEX_LMUL]);; + +let HAS_INTEGRAL_COMPLEX_0 = prove + (`!s. ((\x. Cx(&0)) has_integral Cx(&0)) s`, + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; + +let INTEGRABLE_COMPLEX_LMUL = prove + (`!f:real^N->complex s c. + f integrable_on s ==> (\x. c * f x) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMPLEX_LMUL]);; + +let INTEGRABLE_COMPLEX_RMUL = prove + (`!f:real^N->complex s c. + f integrable_on s ==> (\x. f x * c) integrable_on s`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[INTEGRABLE_COMPLEX_LMUL]);; + +let INTEGRABLE_COMPLEX_0 = prove + (`!s. (\x. Cx(&0)) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMPLEX_0]);; + +let INTEGRABLE_COMPLEX_LMUL_EQ = prove + (`!f:real^N->complex s c. + (\x. c * f x) integrable_on s <=> c = Cx(&0) \/ f integrable_on s`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[INTEGRABLE_COMPLEX_LMUL; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[INTEGRABLE_COMPLEX_0] THEN + ASM_CASES_TAC `c = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv c:complex` o + MATCH_MP INTEGRABLE_COMPLEX_LMUL) THEN + ASM_SIMP_TAC[COMPLEX_MUL_ASSOC; COMPLEX_MUL_LID; COMPLEX_MUL_LINV; ETA_AX]);; + +let INTEGRABLE_COMPLEX_RMUL_EQ = prove + (`!f:real^N->complex s c. + (\x. f x * c) integrable_on s <=> c = Cx(&0) \/ f integrable_on s`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[INTEGRABLE_COMPLEX_LMUL_EQ]);; + +let INTEGRAL_COMPLEX_LMUL = prove + (`!f:real^N->complex s c. + f integrable_on s ==> integral s (\x. c * f x) = c * integral s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_COMPLEX_LMUL THEN + ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; + +let INTEGRAL_COMPLEX_RMUL = prove + (`!f:real^N->complex s c. + f integrable_on s ==> integral s (\x. f x * c) = integral s f * c`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[INTEGRAL_COMPLEX_LMUL]);; + +let REAL_COMPLEX_INTEGRAL = prove + (`!f:real^N->complex s. + f integrable_on s /\ (!x. x IN s ==> real(f x)) ==> real(integral s f)`, + REWRITE_TAC[real; IM_DEF] THEN SIMP_TAC[INTEGRAL_COMPONENT] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN + MATCH_MP_TAC INTEGRAL_EQ_0 THEN + ASM_REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Relations among convergence and absolute convergence for power series. *) +(* ------------------------------------------------------------------------- *) + +let ABEL_LEMMA = prove + (`!a M r r0. + &0 <= r /\ r < r0 /\ + (!n. n IN k ==> norm(a n) * r0 pow n <= M) + ==> summable k (\n. Cx(norm(a(n)) * r pow n))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < r0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `k:num->bool = {}` THEN ASM_REWRITE_TAC[SUMMABLE_TRIVIAL] THEN + SUBGOAL_THEN `&0 <= M` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> x <= y ==> &0 <= y`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(M * (r / r0) pow n)` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[CX_MUL; CX_POW] THEN MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SUMMABLE_GP THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; real_abs; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID]; + REWRITE_TAC[REAL_CX; RE_CX] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE]; + EXISTS_TAC `0` THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NORM; REAL_ABS_DIV] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POW_DIV] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN + ASM_SIMP_TAC[REAL_LE_RMUL; REAL_POW_LE; REAL_LT_IMP_LE]]);; + +let POWER_SERIES_CONV_IMP_ABSCONV = prove + (`!a k w z. + summable k (\n. a(n) * z pow n) /\ norm(w) < norm(z) + ==> summable k (\n. Cx(norm(a(n) * w pow n)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC ABEL_LEMMA THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUMMABLE_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN + EXISTS_TAC `norm(z:complex)` THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REWRITE_TAC[GSYM COMPLEX_NORM_POW; GSYM COMPLEX_NORM_MUL]);; + +let POWER_SERIES_CONV_IMP_ABSCONV_WEAK = prove + (`!a k w z. + summable k (\n. a(n) * z pow n) /\ norm(w) < norm(z) + ==> summable k (\n. Cx(norm(a(n))) * w pow n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(norm(a(n) * w pow n))` THEN CONJ_TAC THENL + [MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN + EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REAL_CX; RE_CX; NORM_POS_LE] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NORM; + REAL_ABS_MUL; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Comparing sums and "integrals" via complex antiderivatives. *) +(* ------------------------------------------------------------------------- *) + +let SUM_INTEGRAL_UBOUND_INCREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN segment[Cx(&m),Cx(&n + &1)] + ==> (g has_complex_derivative f(x)) (at x)) /\ + (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> Re(f(Cx x)) <= Re(f(Cx y))) + ==> sum(m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n + &1)) - g(Cx(&m)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `--sum(m..n) (\k. Re(g(Cx(&k))) - Re(g(Cx(&(k + 1)))))` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[SUM_DIFFS; RE_SUB; REAL_NEG_SUB; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_LE_REFL]] THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + REWRITE_TAC[REAL_NEG_SUB] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:complex->complex`; `f:complex->complex`; + `Cx(&r)`; `Cx(&r + &1)`] COMPLEX_MVT_LINE) THEN + ANTS_TAC THENL + [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `u IN segment[Cx(&r),Cx(&r + &1)]` THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + SPEC_TAC(`u:complex`,`u:complex`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; GSYM SEGMENT_CONVEX_HULL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_SEGMENT_CX] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `u:complex` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[CX_ADD; COMPLEX_RING `y * ((x + Cx(&1)) - x) = y`] THEN + SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN + REPEAT(FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN + REAL_ARITH_TAC]);; + +let SUM_INTEGRAL_UBOUND_DECREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN segment[Cx(&m - &1),Cx(&n)] + ==> (g has_complex_derivative f(x)) (at x)) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> Re(f(Cx y)) <= Re(f(Cx x))) + ==> sum(m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n)) - g(Cx(&m - &1)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `--sum(m..n) (\k. Re(g(Cx(&(k) - &1))) - Re(g(Cx(&(k+1) - &1))))` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[SUM_DIFFS; REAL_NEG_SUB] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB] THEN + REWRITE_TAC[RE_SUB; REAL_ARITH `(x + &1) - &1 = x`; REAL_LE_REFL]] THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + REWRITE_TAC[REAL_NEG_SUB] THEN X_GEN_TAC `r:num` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN + MP_TAC(ISPECL [`g:complex->complex`; `f:complex->complex`; + `Cx(&r - &1)`; `Cx(&r)`] COMPLEX_MVT_LINE) THEN + ANTS_TAC THENL + [X_GEN_TAC `u:complex` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `u IN segment[Cx(&r - &1),Cx(&r)]` THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + SPEC_TAC(`u:complex`,`u:complex`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; GSYM SEGMENT_CONVEX_HULL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_SEGMENT_CX] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN DISCH_THEN(X_CHOOSE_THEN `u:complex` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[CX_SUB; COMPLEX_RING `y * (x - (x - Cx(&1))) = y`] THEN + SUBGOAL_THEN `?y. u = Cx y` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[REAL_SEGMENT; REAL_CX; REAL]; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT_CX]) THEN + REPEAT(FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_OF_NUM_LE])) THEN + REAL_ARITH_TAC]);; + +let SUM_INTEGRAL_LBOUND_INCREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN segment[Cx(&m - &1),Cx(&n)] + ==> (g has_complex_derivative f(x)) (at x)) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> Re(f(Cx x)) <= Re(f(Cx y))) + ==> Re(g(Cx(&n)) - g(Cx(&m - &1))) <= sum(m..n) (\k. Re(f(Cx(&k))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. --((f:complex->complex) z)`; + `\z. --((g:complex->complex) z)`; + `m:num`; `n:num`] SUM_INTEGRAL_UBOUND_DECREASING) THEN + REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; + REAL_ARITH `--x - --y:real = --(x - y)`] THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_NEG]);; + +let SUM_INTEGRAL_LBOUND_DECREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN segment[Cx(&m),Cx(&n + &1)] + ==> (g has_complex_derivative f(x)) (at x)) /\ + (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> Re(f(Cx y)) <= Re(f(Cx x))) + ==> Re(g(Cx(&n + &1)) - g(Cx(&m))) <= sum(m..n) (\k. Re(f(Cx(&k))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. --((f:complex->complex) z)`; + `\z. --((g:complex->complex) z)`; + `m:num`; `n:num`] SUM_INTEGRAL_UBOUND_INCREASING) THEN + REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; + REAL_ARITH `--x - --y:real = --(x - y)`] THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_NEG]);; + +let SUM_INTEGRAL_BOUNDS_INCREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN segment[Cx(&m - &1),Cx (&n + &1)] + ==> (g has_complex_derivative f x) (at x)) /\ + (!x y. + &m - &1 <= x /\ x <= y /\ y <= &n + &1 + ==> Re(f(Cx x)) <= Re(f(Cx y))) + ==> Re(g(Cx(&n)) - g(Cx(&m - &1))) <= sum(m..n) (\k. Re(f(Cx(&k)))) /\ + sum (m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n + &1)) - g(Cx(&m)))`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC SUM_INTEGRAL_LBOUND_INCREASING; + MATCH_MP_TAC SUM_INTEGRAL_UBOUND_INCREASING] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_SEGMENT_CX_GEN; GSYM REAL_OF_NUM_LE]) THEN + REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN ASM_REAL_ARITH_TAC);; + +let SUM_INTEGRAL_BOUNDS_DECREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN segment[Cx(&m - &1),Cx(&n + &1)] + ==> (g has_complex_derivative f(x)) (at x)) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 + ==> Re(f(Cx y)) <= Re(f(Cx x))) + ==> Re(g(Cx(&n + &1)) - g(Cx(&m))) <= sum(m..n) (\k. Re(f(Cx(&k)))) /\ + sum(m..n) (\k. Re(f(Cx(&k)))) <= Re(g(Cx(&n)) - g(Cx(&m - &1)))`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC SUM_INTEGRAL_LBOUND_DECREASING; + MATCH_MP_TAC SUM_INTEGRAL_UBOUND_DECREASING] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_SEGMENT_CX_GEN; GSYM REAL_OF_NUM_LE]) THEN + REWRITE_TAC[IN_SEGMENT_CX_GEN] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Relating different kinds of complex limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_INFINITY_SEQUENTIALLY_COMPLEX = prove + (`!f l. (f --> l) at_infinity ==> ((\n. f(Cx(&n))) --> l) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY; LIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + MP_TAC(ISPEC `B:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC);; + +let LIM_AT_INFINITY_COMPLEX_0 = prove + (`!f l:real^N. + (f --> l) at_infinity <=> ((f o inv) --> l) (at(Cx(&0)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_LE; LIM_AT_INFINITY_POS; o_DEF] THEN + REWRITE_TAC[GSYM DIST_NZ; real_ge] THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[real_ge] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(b:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THENL + [ALL_TAC; SUBST1_TAC(SYM(SPEC `z:complex` COMPLEX_INV_INV))] THEN + FIRST_X_ASSUM MATCH_MP_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; + ASM_REWRITE_TAC[COMPLEX_INV_EQ_0] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_NORM_NZ] THEN + TRANS_TAC REAL_LTE_TRANS `inv(b:real)` THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ]]]);; + +let LIM_ZERO_INFINITY_COMPLEX = prove + (`!f l:real^N. + ((\x. f(Cx(&1) / x)) --> l) (at (Cx(&0))) ==> (f --> l) at_infinity`, + REWRITE_TAC[LIM_AT_INFINITY_COMPLEX_0; o_DEF; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Transforming complex limits to real ones. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPLEX_REAL = prove + (`!f g l m. + eventually (\n. Re(g n) = f n) sequentially /\ + Re m = l /\ + (g --> m) sequentially + ==> !e. &0 < e ==> ?N. !n. N <= n ==> abs(f n - l) < e`, + REPEAT GEN_TAC THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; LIM_SEQUENTIALLY] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `N1:num`) + (CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC)) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN EXISTS_TAC `N0 + N1:num` THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (ARITH_RULE + `N0 + N1:num <= n ==> N0 <= n /\ N1 <= n`)) THEN + UNDISCH_THEN `!n. N0 <= n ==> norm ((g:num->complex) n - m) < e` + (MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM RE_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM]);; + +let LIM_COMPLEX_REAL_0 = prove + (`!f g. eventually (\n. Re(g n) = f n) sequentially /\ + (g --> Cx(&0)) sequentially + ==> !e. &0 < e ==> ?N. !n. N <= n ==> abs(f n) < e`, + MP_TAC LIM_COMPLEX_REAL THEN + REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`&0`; `Cx(&0)`]) THEN + REWRITE_TAC[RE_CX; REAL_SUB_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Uniform convergence of power series in a "Stolz angle". *) +(* ------------------------------------------------------------------------- *) + +let POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1 = prove + (`!M a s e. + summable s a /\ &0 < M /\ &0 < e + ==> eventually + (\n. !z. norm(Cx(&1) - z) <= M * (&1 - norm z) + ==> norm(vsum (s INTER (0..n)) (\i. a i * z pow i) - + infsum s (\i. a i * z pow i)) < e) + sequentially`, + let lemma = prove + (`!M w z. &0 < M /\ norm(w - z) <= M * (norm w - norm z) /\ ~(z = w) + ==> norm(z) < norm(w)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_MUL_EQ; REAL_SUB_LE; NORM_POS_LE; REAL_LE_TRANS]; + DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[REAL_SUB_REFL; REAL_MUL_RZERO;NORM_LE_0; VECTOR_SUB_EQ]]) + and lemma1 = prove + (`!m n. m < n + ==> vsum (m..n) (\i. a i * z pow i) = + (Cx(&1) - z) * vsum(m..n-1) (\i. vsum (m..i) a * z pow i) + + vsum(m..n) a * z pow n`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; SUC_SUB1] THEN + SIMP_TAC[VSUM_CLAUSES_NUMSEG; LT; LT_IMP_LE] THEN STRIP_TAC THENL + [ASM_REWRITE_TAC[VSUM_SING_NUMSEG; complex_pow] THEN CONV_TAC COMPLEX_RING; + ASM_SIMP_TAC[] THEN UNDISCH_TAC `m:num < n` THEN + POP_ASSUM(K ALL_TAC)] THEN + SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN POP_ASSUM(K ALL_TAC) THEN + SIMP_TAC[SUC_SUB1; VSUM_CLAUSES_NUMSEG; LT_IMP_LE] THEN + ASM_REWRITE_TAC[VSUM_SING_NUMSEG; complex_pow] THEN + CONV_TAC COMPLEX_RING) in + SUBGOAL_THEN + `!M a e. + summable (:num) a /\ &0 < M /\ &0 < e + ==> eventually + (\n. !z. norm(Cx(&1) - z) <= M * (&1 - norm z) + ==> norm(vsum (0..n) (\i. a i * z pow i) - + infsum (:num) (\i. a i * z pow i)) < e) + sequentially` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL + [`M:real`; `\i:num. if i IN s then a i else Cx(&0)`; `e:real`]) THEN + REWRITE_TAC[COND_RAND; COND_RATOR; COMPLEX_MUL_LZERO] THEN + ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM VSUM_RESTRICT_SET; + INFSUM_RESTRICT; SUMMABLE_RESTRICT] THEN + REWRITE_TAC[SET_RULE `{i | i IN t /\ i IN s} = s INTER t`]] THEN + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[] + `(!z. P z) <=> P (Cx(&1)) /\ (!z. ~(z = Cx(&1)) ==> P z)`] THEN + REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_SUB_REFL; + REAL_SUB_REFL; REAL_MUL_RZERO; REAL_LE_REFL] THEN + UNDISCH_TAC `&0 < e` THEN SPEC_TAC(`e:real`,`e:real`) THEN + REWRITE_TAC[GSYM tendsto; COMPLEX_POW_ONE; COMPLEX_MUL_RID; GSYM dist; + ETA_AX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM SUMS_INFSUM]) THEN + REWRITE_TAC[sums; INTER_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP; EVENTUALLY_SEQUENTIALLY] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM dist] THEN + UNDISCH_TAC `&0 < e` THEN SPEC_TAC(`e:real`,`e:real`) THEN + MATCH_MP_TAC UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT THEN + REWRITE_TAC[GSYM LIM_SEQUENTIALLY] THEN CONJ_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[MESON[] `(!m n z. P m /\ P n /\ Q z ==> R m n z) <=> + (!z. Q z ==> !m n. P m /\ P n ==> R m n z)`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM SUMS_INFSUM]) THEN + REWRITE_TAC[sums] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN + REWRITE_TAC[cauchy; GSYM dist] THEN + DISCH_THEN(MP_TAC o SPEC `min (e / &2) (e / &2 / M)`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_HALF; GE; INTER_UNIV] THEN + REWRITE_TAC[GSYM REAL_LT_MIN] THEN + ONCE_REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN + SUBGOAL_THEN + `!f:num->complex m n. m <= n + ==> dist(vsum (0..m) f,vsum (0..n) f) = norm(vsum (m+1..n) f)` + (fun th -> SIMP_TAC[th]) + THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH `a + c = b ==> dist(a,b) = norm c`) THEN + MATCH_MP_TAC VSUM_COMBINE_R THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[REAL_LT_MIN] THEN STRIP_TAC THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN + SUBGOAL_THEN `norm(z:complex) < &1` ASSUME_TAC THENL + [UNDISCH_TAC `~(z = Cx(&1))` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `norm(a - b) <= M ==> &0 <= --M ==> b = a`)) THEN + REWRITE_TAC[GSYM REAL_MUL_RNEG; REAL_NEG_SUB] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `m + 1 < n` THENL + [ASM_SIMP_TAC[lemma1] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(a) < e / &2 /\ norm(b) < e / &2 ==> norm(a + b) < e`) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(M * (&1 - norm(z:complex))) * + sum (m+1..n-1) (\i. e / &2 / M * norm(z) pow i)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `p:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `x < e / &2 /\ x < e / &2 / M ==> x <= e / &2 / M`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + REWRITE_TAC[SUM_LMUL] THEN + REWRITE_TAC[REAL_ARITH + `(M * z1) * e / &2 / M * s < e / &2 <=> + e * (M / M) * s * z1 < e * &1`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN + REWRITE_TAC[SUM_GP] THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THENL + [UNDISCH_TAC `norm(Cx(&1) - z) <= M * (&1 - norm z)` THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN + ASM_REWRITE_TAC[NORM_ARITH `norm(x - y:complex) <= &0 <=> x = y`]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ x < &1 ==> x - y < &1`) THEN + ASM_SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN + MATCH_MP_TAC REAL_POW_1_LT THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN ARITH_TAC]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN SIMP_TAC[NORM_POS_LE; REAL_POW_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `x < e / &2 /\ x < e / &2 / M ==> x < e / &2`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + MATCH_MP_TAC REAL_POW_1_LT THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_ARITH_TAC]]; + ASM_CASES_TAC `(m+1)..n = {}` THENL + [ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NUMSEG_EMPTY]) THEN + SUBGOAL_THEN `m + 1 = n` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[VSUM_SING_NUMSEG] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN SIMP_TAC[NORM_POS_LE; REAL_POW_LE] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN + SUBGOAL_THEN `m + 1 = n` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[VSUM_SING_NUMSEG]] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_1_LT THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_ARITH_TAC]]; + X_GEN_TAC `z:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`M:real`; `Cx(&1)`; `z:complex`] lemma) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN DISCH_TAC THEN + SUBGOAL_THEN `summable (:num) (\i. a i * z pow i)` MP_TAC THENL + [MATCH_MP_TAC SERIES_ABSCONV_IMP_CONV THEN + REWRITE_TAC[] THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN + EXISTS_TAC `Cx(&1)` THEN + REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_NORM_CX] THEN + ASM_REWRITE_TAC[REAL_ABS_NUM; COMPLEX_MUL_RID; ETA_AX]; + REWRITE_TAC[GSYM SUMS_INFSUM] THEN + REWRITE_TAC[sums; INTER_UNIV]]]);; + +let POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ = prove + (`!M a w s e. + summable s (\i. a i * w pow i) /\ &0 < M /\ &0 < e + ==> eventually + (\n. !z. norm(w - z) <= M * (norm w - norm z) + ==> norm(vsum (s INTER (0..n)) (\i. a i * z pow i) - + infsum s (\i. a i * z pow i)) < e) + sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `w = Cx(&0)` THENL + [ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; REAL_SUB_LZERO; COMPLEX_NORM_0] THEN + REWRITE_TAC[NORM_NEG; REAL_ARITH + `n <= M * --n <=> &0 <= --n * (&1 + M)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_ARITH `&0 < M ==> &0 < &1 + M`] THEN + REWRITE_TAC[NORM_ARITH `&0 <= --norm z <=> z = vec 0`] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; FORALL_UNWIND_THM2] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_POW_ZERO] THEN + REWRITE_TAC[COND_RATOR; COND_RAND; COMPLEX_MUL_RZERO; COMPLEX_MUL_RID] THEN + MATCH_MP_TAC(NORM_ARITH `x = y /\ &0 < e ==> norm(y - x) < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + REWRITE_TAC[sums] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SIMP_TAC[GSYM COMPLEX_VEC_0; VSUM_DELTA] THEN + REWRITE_TAC[IN_INTER; LE_0; IN_NUMSEG]; + FIRST_ASSUM(MP_TAC o MATCH_MP POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN DISCH_TAC THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z / w:complex`) THEN + ASM_SIMP_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_POW_MUL] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `norm(w:complex)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(w = Cx(&0)) ==> (Cx(&1) - z / w) * w = w - z`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM COMPLEX_NORM_MUL; REAL_MUL_LID] THEN + ASM_SIMP_TAC[COMPLEX_DIV_RMUL]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence continuity and the Abel limit theorem. *) +(* ------------------------------------------------------------------------- *) + +let ABEL_POWER_SERIES_CONTINUOUS = prove + (`!M s a. + summable s a /\ &0 < M + ==> (\z. infsum s (\i. a i * z pow i)) continuous_on + {z | norm(Cx(&1) - z) <= M * (&1 - norm z)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN + EXISTS_TAC `\n z. vsum (s INTER (0..n)) (\i. a i * z pow i)` THEN + ASM_SIMP_TAC[POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1; IN_ELIM_THM; + TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN + SIMP_TAC[CONTINUOUS_ON_COMPLEX_MUL; CONTINUOUS_ON_COMPLEX_POW; + CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; FINITE_INTER; + FINITE_NUMSEG]);; + +let ABEL_LIMIT_THEOREM = prove + (`!M s a. + summable s a /\ &0 < M + ==> (!z. norm(z) < &1 ==> summable s (\i. a i * z pow i)) /\ + ((\z. infsum s (\i. a i * z pow i)) --> infsum s a) + (at (Cx(&1)) within {z | norm(Cx(&1) - z) <= M * (&1 - norm z)})`, + GEN_TAC THEN ASM_CASES_TAC `&0 < M` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!a. summable (:num) a + ==> (!z. norm(z) < &1 ==> summable (:num) (\i. a i * z pow i)) /\ + ((\z. infsum (:num) (\i. a i * z pow i)) + --> infsum (:num) a) + (at (Cx(&1)) within {z | norm(Cx(&1) - z) <= M * (&1 - norm z)})` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(\n. if n IN s then a n else vec 0):num->complex`) THEN + REWRITE_TAC[COND_RAND; COND_RATOR; COMPLEX_VEC_0; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + ASM_REWRITE_TAC[SUMMABLE_RESTRICT; INFSUM_RESTRICT]] THEN + GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC SERIES_ABSCONV_IMP_CONV THEN + REWRITE_TAC[] THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN + EXISTS_TAC `Cx(&1)` THEN REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_NORM_CX] THEN + ASM_REWRITE_TAC[REAL_ABS_NUM; COMPLEX_MUL_RID; ETA_AX]; + MP_TAC(ISPECL [`M:real`; `(:num)`; `a:num->complex`] + ABEL_POWER_SERIES_CONTINUOUS) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1)`) THEN + REWRITE_TAC[IN_ELIM_THM; CONTINUOUS_WITHIN] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_CX; COMPLEX_POW_ONE; + COMPLEX_MUL_RID; ETA_AX; REAL_ABS_NUM; REAL_SUB_REFL; + REAL_LE_REFL; REAL_MUL_RZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity and uniqueness of power series. These would drop easily out *) +(* of later developments, but it seems nice to prove them without all the *) +(* machinery of Cauchy's theorem etc. *) +(* ------------------------------------------------------------------------- *) + +let POWER_SERIES_CONTINUOUS = prove + (`!a k f z r. + (!w. w IN ball(z,r) ==> ((\n. a n * (w - z) pow n) sums f w) k) + ==> f continuous_on ball(z,r)`, + REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN + ABBREV_TAC `R = (r + dist(z,w:complex)) / &2` THEN + MATCH_MP_TAC CONTINUOUS_ON_INTERIOR THEN + EXISTS_TAC `cball(z:complex,R)` THEN + REWRITE_TAC[INTERIOR_CBALL; IN_BALL] THEN CONJ_TAC THENL + [ALL_TAC; + EXPAND_TAC "R" THEN UNDISCH_TAC `dist(z:complex,w) < r` THEN + CONV_TAC NORM_ARITH] THEN + MATCH_MP_TAC(ISPEC `sequentially` CONTINUOUS_UNIFORM_LIMIT) THEN + EXISTS_TAC + `\n w. vsum(k INTER (0..n)) (\i. (a:num->complex) i * (w - z) pow i)` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN + SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_POW THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\w n. (a:num->complex) n * (w - z) pow n`; + `\n. Cx (norm (a n * Cx R pow n))`; + `\x:complex. x IN cball(z,R)`; + `k:num->bool`] SERIES_COMPARISON_UNIFORM_COMPLEX) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; dist] THEN ANTS_TAC THENL + [REWRITE_TAC[RE_CX; NORM_POS_LE; REAL_CX] THEN CONJ_TAC THENL + [MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN + EXISTS_TAC `Cx((r + R) / &2)` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `z + Cx((r + R) / &2)`) THEN + ANTS_TAC THENL + [REWRITE_TAC[NORM_ARITH `dist(z,z + r) = norm r`]; + REWRITE_TAC[summable; COMPLEX_RING `(z + r) - z:complex = r`] THEN + MESON_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN + EXPAND_TAC "R" THEN UNDISCH_TAC `dist(z:complex,w) < r` THEN + CONV_TAC NORM_ARITH; + EXISTS_TAC `1` THEN REWRITE_TAC[IN_CBALL; dist] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_MUL; REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_CX] THEN + UNDISCH_TAC `norm(z - x:complex) <= R` THEN CONV_TAC NORM_ARITH]; + DISCH_THEN(X_CHOOSE_TAC `g:complex->complex`) THEN + SUBGOAL_THEN `!x. x IN cball(z,R) ==> (f:complex->complex) x = g x` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `y:complex` THEN REWRITE_TAC[IN_CBALL] THEN DISCH_TAC THEN + MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `\n. (a:num->complex) n * (y - z) pow n` THEN + EXISTS_TAC `k:num->bool` THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(K ALL_TAC o SPEC `&0`) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[sums; LIM_SEQUENTIALLY; dist] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL]) THEN ASM_MESON_TAC[]]]);; + +let POWER_SERIES_LIMIT_POINT_OF_ZEROS = prove + (`!f k r s. + &0 < r /\ + (!w. dist(w,z) < r ==> ((\i. c i * (w - z) pow i) sums f(w)) k) /\ + (!w. w IN s ==> f(w) = Cx(&0)) /\ z limit_point_of s + ==> !i. i IN k ==> c(i) = Cx(&0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[] `(!x. P x ==> Q x) <=> ~(?x. P x /\ ~Q x)`] THEN + GEN_REWRITE_TAC RAND_CONV [num_WOP] THEN + REWRITE_TAC[TAUT `(p ==> ~(q /\ ~r)) <=> q /\ p ==> r`] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!w. w IN ball(z,r) /\ ~(w = z) + ==> ((\i. c(m + i) * (w - z) pow i) sums f(w) / (w - z) pow m) + {i | m + i IN k}` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\i. (c(m + i) * (w - z) pow (m + i)) / (w - z) pow m` THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM complex_div] THEN + ASM_SIMP_TAC[COMPLEX_DIV_POW2; COMPLEX_SUB_0; LE_ADD] THEN + AP_TERM_TAC THEN ARITH_TAC; + REWRITE_TAC[complex_div] THEN + MATCH_MP_TAC SERIES_COMPLEX_RMUL THEN + MP_TAC(ISPECL [`m:num`; `\i. (c:num->complex) i * (w - z) pow i`; + `(f:complex->complex) w`; `{i:num | m + i IN k}`] + (ONCE_REWRITE_RULE[ADD_SYM] SUMS_REINDEX_GEN)) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN + SUBGOAL_THEN `((\i. c i * (w - z) pow i) sums (f:complex->complex) w) k` + MP_TAC THENL [ASM_MESON_TAC[IN_BALL; DIST_SYM]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMS_EQ) THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM LE_EXISTS; MESON[] + `(?x. f x IN k /\ y = f x) <=> y IN k /\ (?x. y = f x)`] THEN + ASM_CASES_TAC `(i:num) IN k` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN + ASM_MESON_TAC[NOT_LE]]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\i. c(m + i) * (z - z) pow i) sums + vsum {0} (\i. c(m + i) * (z - z) pow i)) + {i | m + i IN k}` + MP_TAC THENL + [MATCH_MP_TAC SERIES_VSUM THEN EXISTS_TAC `{0}` THEN + REWRITE_TAC[FINITE_SING; SING_SUBSET; IN_ELIM_THM; IN_SING] THEN + ASM_REWRITE_TAC[ADD_CLAUSES; COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN + SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_POW_EQ_0]; + REWRITE_TAC[VSUM_SING; complex_pow; ADD_CLAUSES; COMPLEX_MUL_RID] THEN + DISCH_TAC] THEN + SUBGOAL_THEN + `!w. w IN ball(z,r) + ==> summable {i | m + i IN k} (\i. c(m + i) * (w - z) pow i)` + MP_TAC THENL + [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[summable] THEN + ASM_CASES_TAC `w:complex = z` THEN ASM_MESON_TAC[]; + REWRITE_TAC[summable; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `g:complex->complex`)] THEN + SUBGOAL_THEN `(g:complex->complex) continuous_on ball(z,r)` + ASSUME_TAC THENL + [MATCH_MP_TAC POWER_SERIES_CONTINUOUS THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN closure((s INTER cball(z,r / &2)) DELETE z) + ==> (g:complex->complex) x IN {Cx(&0)}` + MP_TAC THENL + [MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_SING; IN_SING] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + TRANS_TAC SUBSET_TRANS `closure(cball(z:complex,r / &2))` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET; + SET_RULE `s SUBSET t ==> (s DELETE z) SUBSET t`] THEN + SIMP_TAC[CLOSURE_CLOSED; CLOSED_CBALL; SUBSET_BALLS; DIST_REFL] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_INTER; IN_DELETE] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(g:complex->complex) w = f w / (w - z) pow m` + (fun th -> ASM_SIMP_TAC[COMPLEX_DIV_EQ_0; th]) THEN + MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `\i. (c:num->complex) (m + i) * (w - z) pow i` THEN + EXISTS_TAC `{i:num | m + i IN k}` THEN + REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `w IN cball(z:complex,r / &2)` THEN + REWRITE_TAC[IN_CBALL; IN_BALL] THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + REWRITE_TAC[IN_CLOSURE_DELETE; NOT_IMP; IN_SING] THEN CONJ_TAC THENL + [UNDISCH_TAC `(z:complex) limit_point_of s` THEN + REWRITE_TAC[LIMPT_INFINITE_CBALL; INTER_ASSOC] THEN + REWRITE_TAC[GSYM CBALL_MIN_INTER] THEN + DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN + MP_TAC(SPEC `min (r / &2) e` th)) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN]; + SUBGOAL_THEN `(g:complex->complex) z = c(m:num)` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `\i. (c:num->complex) (m + i) * (z - z) pow i` THEN + EXISTS_TAC `{i:num | m + i IN k}` THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL]]]);; diff --git a/Multivariate/cauchy.ml b/Multivariate/cauchy.ml new file mode 100644 index 0000000..948d3d2 --- /dev/null +++ b/Multivariate/cauchy.ml @@ -0,0 +1,18231 @@ +(* ========================================================================= *) +(* Complex path integrals and Cauchy's theorem. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* (c) Copyright, Gianni Ciolli, Graziano Gentili, Marco Maggesi 2008-2009. *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "Library/binomial.ml";; +needs "Library/iter.ml";; +needs "Multivariate/moretop.ml";; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* A couple of extra tactics used in some proofs below. *) +(* ------------------------------------------------------------------------- *) + +let ASSERT_TAC tm = + SUBGOAL_THEN tm STRIP_ASSUME_TAC;; + +let EQ_TRANS_TAC tm = + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Piecewise differentiability on a 1-D interval. The definition doesn't *) +(* tie it to real^1 but it's not obviously that useful elsewhere. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("piecewise_differentiable_on",(12,"right"));; + +let piecewise_differentiable_on = new_definition + `f piecewise_differentiable_on i <=> + f continuous_on i /\ + (?s. FINITE s /\ !x. x IN (i DIFF s) ==> f differentiable at x)`;; + +let PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON = prove + (`!f s. f piecewise_differentiable_on s ==> f continuous_on s`, + SIMP_TAC[piecewise_differentiable_on]);; + +let PIECEWISE_DIFFERENTIABLE_ON_SUBSET = prove + (`!f s t. + f piecewise_differentiable_on s /\ t SUBSET s + ==> f piecewise_differentiable_on t`, + REWRITE_TAC[piecewise_differentiable_on] THEN + MESON_TAC[SUBSET; IN_DIFF; CONTINUOUS_ON_SUBSET]);; + +let DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE = prove + (`!f:real^1->real^N a b. + f differentiable_on interval[a,b] + ==> f piecewise_differentiable_on interval[a,b]`, + SIMP_TAC[piecewise_differentiable_on; + DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `{a,b}:real^1->bool` THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN + SIMP_TAC[GSYM DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; OPEN_INTERVAL] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_SUBSET THEN + EXISTS_TAC `interval[a:real^1,b]` THEN + ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);; + +let DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE = prove + (`!f s. (!x. x IN s ==> f differentiable (at x)) + ==> f piecewise_differentiable_on s`, + SIMP_TAC[piecewise_differentiable_on; DIFFERENTIABLE_IMP_CONTINUOUS_AT; + CONTINUOUS_AT_IMP_CONTINUOUS_ON; IN_DIFF] THEN + MESON_TAC[FINITE_RULES]);; + +let PIECEWISE_DIFFERENTIABLE_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s. + f piecewise_differentiable_on s /\ + g piecewise_differentiable_on (IMAGE f s) /\ + (!b. FINITE {x | x IN s /\ f(x) = b}) + ==> (g o f) piecewise_differentiable_on s`, + REPEAT GEN_TAC THEN + SIMP_TAC[piecewise_differentiable_on; CONTINUOUS_ON_COMPOSE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `ks:real^M->bool` + STRIP_ASSUME_TAC)) + (CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `kt:real^N->bool` + STRIP_ASSUME_TAC)) + ASSUME_TAC)) THEN + EXISTS_TAC + `ks UNION + UNIONS(IMAGE (\b. {x | x IN s /\ (f:real^M->real^N) x = b}) kt)` THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_UNIONS; FINITE_IMAGE] THEN + REWRITE_TAC[UNIONS_IMAGE; FORALL_IN_IMAGE; IN_DIFF; IN_UNION] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let PIECEWISE_DIFFERENTIABLE_AFFINE = prove + (`!f:real^M->real^N s m c. + f piecewise_differentiable_on (IMAGE (\x. m % x + c) s) + ==> (f o (\x. m % x + c)) piecewise_differentiable_on s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `m = &0` THENL + [ASM_REWRITE_TAC[o_DEF; VECTOR_MUL_LZERO] THEN + MATCH_MP_TAC DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE THEN + SIMP_TAC[DIFFERENTIABLE_CONST]; + MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_COMPOSE THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE THEN + SIMP_TAC[DIFFERENTIABLE_ADD; DIFFERENTIABLE_CMUL; DIFFERENTIABLE_CONST; + DIFFERENTIABLE_ID]; + X_GEN_TAC `b:real^M` THEN ASM_SIMP_TAC[VECTOR_AFFINITY_EQ] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{inv m % b + --(inv m % c):real^M}` THEN + SIMP_TAC[FINITE_RULES] THEN SET_TAC[]]]);; + +let PIECEWISE_DIFFERENTIABLE_CASES = prove + (`!f g:real^1->real^N a b c. + drop a <= drop c /\ drop c <= drop b /\ f c = g c /\ + f piecewise_differentiable_on interval[a,c] /\ + g piecewise_differentiable_on interval[c,b] + ==> (\x. if drop x <= drop c then f(x) else g(x)) + piecewise_differentiable_on interval[a,b]`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `s:real^1->bool` + STRIP_ASSUME_TAC)) + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `t:real^1->bool` + STRIP_ASSUME_TAC))) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `interval[a:real^1,b] = interval[a,c] UNION interval[c,b]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + ASM_REWRITE_TAC[CLOSED_INTERVAL; IN_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]; + ALL_TAC] THEN + EXISTS_TAC `(c:real^1) INSERT s UNION t` THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN + REWRITE_TAC[DE_MORGAN_THM; IN_DIFF; IN_INTERVAL_1; IN_INSERT; IN_UNION] THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `drop x <= drop c \/ drop c <= drop x`) THEN + MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THENL + [EXISTS_TAC `f:real^1->real^N`; EXISTS_TAC `g:real^1->real^N`] THEN + EXISTS_TAC `dist(x:real^1,c)` THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN + (CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DIFF]]));; + +let PIECEWISE_DIFFERENTIABLE_NEG = prove + (`!f:real^M->real^N s. + f piecewise_differentiable_on s + ==> (\x. --(f x)) piecewise_differentiable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[piecewise_differentiable_on] THEN + MATCH_MP_TAC MONO_AND THEN SIMP_TAC[CONTINUOUS_ON_NEG] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[DIFFERENTIABLE_NEG]);; + +let PIECEWISE_DIFFERENTIABLE_ADD = prove + (`!f g:real^M->real^N s. + f piecewise_differentiable_on s /\ + g piecewise_differentiable_on s + ==> (\x. f x + g x) piecewise_differentiable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t UNION u :real^M->bool` THEN + ASM_SIMP_TAC[FINITE_UNION; DIFFERENTIABLE_ADD; IN_INTER; + SET_RULE `s DIFF (t UNION u) = (s DIFF t) INTER (s DIFF u)`]);; + +let PIECEWISE_DIFFERENTIABLE_SUB = prove + (`!f g:real^M->real^N s. + f piecewise_differentiable_on s /\ + g piecewise_differentiable_on s + ==> (\x. f x - g x) piecewise_differentiable_on s`, + SIMP_TAC[VECTOR_SUB; PIECEWISE_DIFFERENTIABLE_ADD; + PIECEWISE_DIFFERENTIABLE_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Valid paths, and their start and finish. *) +(* ------------------------------------------------------------------------- *) + +let valid_path = new_definition + `valid_path (f:real^1->complex) <=> + f piecewise_differentiable_on interval[vec 0,vec 1]`;; + +let closed_path = new_definition + `closed_path g <=> pathstart g = pathfinish g`;; + +let VALID_PATH_COMPOSE = prove + (`!f g. valid_path g /\ f differentiable_on (path_image g) + ==> valid_path (f o g)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC)) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; path_image]; + EXISTS_TAC `{vec 0:real^1,vec 1} UNION s` THEN + ASM_REWRITE_TAC[FINITE_UNION; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF t) DIFF u`] THEN + REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + SUBGOAL_THEN + `((f:complex->complex) o (g:real^1->complex)) + differentiable (at t within (interval(vec 0,vec 1) DIFF s))` + MP_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN + DISCH_THEN(MP_TAC o SPEC `(g:real^1->complex) t`) THEN + ANTS_TAC THENL + [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `t:real^1`; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + DIFFERENTIABLE_WITHIN_SUBSET) THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET]] THEN + MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`] + INTERVAL_OPEN_SUBSET_CLOSED) THEN ASM SET_TAC[]; + ASM_SIMP_TAC[DIFFERENTIABLE_WITHIN_OPEN; OPEN_DIFF; OPEN_INTERVAL; + FINITE_IMP_CLOSED]]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, all results for paths apply. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_IMP_PATH = prove + (`!g. valid_path g ==> path g`, + SIMP_TAC[valid_path; path; piecewise_differentiable_on]);; + +let CONNECTED_VALID_PATH_IMAGE = prove + (`!g. valid_path g ==> connected(path_image g)`, + MESON_TAC[CONNECTED_PATH_IMAGE; VALID_PATH_IMP_PATH]);; + +let COMPACT_VALID_PATH_IMAGE = prove + (`!g. valid_path g ==> compact(path_image g)`, + MESON_TAC[COMPACT_PATH_IMAGE; VALID_PATH_IMP_PATH]);; + +let BOUNDED_VALID_PATH_IMAGE = prove + (`!g. valid_path g ==> bounded(path_image g)`, + MESON_TAC[BOUNDED_PATH_IMAGE; VALID_PATH_IMP_PATH]);; + +let CLOSED_VALID_PATH_IMAGE = prove + (`!g. valid_path g ==> closed(path_image g)`, + MESON_TAC[CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH]);; + +(* ------------------------------------------------------------------------- *) +(* Theorems about rectifiable valid paths. *) +(* ------------------------------------------------------------------------- *) + +let RECTIFIABLE_VALID_PATH = prove + (`!g. valid_path g + ==> (rectifiable_path g <=> + (\t. vector_derivative g (at t)) absolutely_integrable_on + interval [vec 0,vec 1])`, + REWRITE_TAC[valid_path; piecewise_differentiable_on; GSYM path] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC RECTIFIABLE_PATH_DIFFERENTIABLE THEN + ASM_MESON_TAC[FINITE_IMP_COUNTABLE]);; + +let PATH_LENGTH_VALID_PATH = prove + (`!g. valid_path g /\ rectifiable_path g + ==> path_length g = + drop(integral (interval[vec 0,vec 1]) + (\t. lift(norm(vector_derivative g (at t)))))`, + REWRITE_TAC[valid_path; piecewise_differentiable_on; GSYM path] THEN + + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_LENGTH_DIFFERENTIABLE THEN + ASM_MESON_TAC[FINITE_IMP_COUNTABLE]);; + +(* ------------------------------------------------------------------------- *) +(* Negligibility of valid_path image *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_VALID_PATH_IMAGE = prove + (`!g. valid_path g ==> negligible(path_image g)`, + REWRITE_TAC[piecewise_differentiable_on; piecewise_differentiable_on; + valid_path; path_image] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `IMAGE (g:real^1->real^2) + (k UNION (interval [vec 0,vec 1] DIFF k))` THEN + CONJ_TAC THENL [REWRITE_TAC[IMAGE_UNION]; SET_TAC[]] THEN + ASM_SIMP_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_FINITE; FINITE_IMAGE] THEN + MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM THEN + REWRITE_TAC[DIMINDEX_1; DIMINDEX_2; ARITH] THEN + ASM_SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON]);; + +(* ------------------------------------------------------------------------- *) +(* Integrals along a path (= piecewise differentiable function on [0,1]). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_path_integral",(12,"right"));; +parse_as_infix("path_integrable_on",(12,"right"));; + +let has_path_integral = define + `(f has_path_integral i) (g) <=> + ((\x. f(g(x)) * vector_derivative g (at x within interval[vec 0,vec 1])) + has_integral i) + (interval[vec 0,vec 1])`;; + +let path_integral = new_definition + `path_integral g f = @i. (f has_path_integral i) (g)`;; + +let path_integrable_on = new_definition + `f path_integrable_on g <=> ?i. (f has_path_integral i) g`;; + +let PATH_INTEGRAL_UNIQUE = prove + (`!f g i. (f has_path_integral i) (g) ==> path_integral(g) f = i`, + REWRITE_TAC[path_integral; has_path_integral; GSYM integral] THEN + MESON_TAC[INTEGRAL_UNIQUE]);; + +let HAS_PATH_INTEGRAL_INTEGRAL = prove + (`!f i. f path_integrable_on i + ==> (f has_path_integral (path_integral i f)) i`, + REWRITE_TAC[path_integral; path_integrable_on] THEN + MESON_TAC[PATH_INTEGRAL_UNIQUE]);; + +let HAS_PATH_INTEGRAL_UNIQUE = prove + (`!f i j g. (f has_path_integral i) g /\ + (f has_path_integral j) g + ==> i = j`, + REWRITE_TAC[has_path_integral] THEN MESON_TAC[HAS_INTEGRAL_UNIQUE]);; + +let HAS_PATH_INTEGRAL_INTEGRABLE = prove + (`!f g i. (f has_path_integral i) g ==> f path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Show that we can forget about the localized derivative. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_DERIVATIVE_WITHIN_INTERIOR = prove + (`!a b x. + x IN interior(interval[a,b]) + ==> vector_derivative f (at x within interval[a,b]) = + vector_derivative f (at x)`, + SIMP_TAC[vector_derivative; has_vector_derivative; has_derivative; + LIM_WITHIN_INTERIOR; NETLIMIT_WITHIN_INTERIOR; NETLIMIT_AT]);; + +let HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE = prove + (`((\x. f' (g x) * vector_derivative g (at x within interval [a,b])) + has_integral i) (interval [a,b]) <=> + ((\x. f' (g x) * vector_derivative g (at x)) + has_integral i) (interval [a,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN + EXISTS_TAC `{a:real^1,b}` THEN + REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN + SUBGOAL_THEN `interval[a:real^1,b] DIFF {a,b} = interior(interval[a,b])` + (fun th -> SIMP_TAC[th; VECTOR_DERIVATIVE_WITHIN_INTERIOR]) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; GSYM DROP_EQ] THEN + REAL_ARITH_TAC);; + +let HAS_PATH_INTEGRAL = prove + (`(f has_path_integral i) g <=> + ((\x. f (g x) * vector_derivative g (at x)) has_integral i) + (interval[vec 0,vec 1])`, + SIMP_TAC[HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE; has_path_integral]);; + +let PATH_INTEGRABLE_ON = prove + (`f path_integrable_on g <=> + (\t. f(g t) * vector_derivative g (at t)) + integrable_on interval[vec 0,vec 1]`, + REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL; GSYM integrable_on]);; + +(* ------------------------------------------------------------------------- *) +(* Reversing a path. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_REVERSEPATH = prove + (`!g. valid_path(reversepath g) <=> valid_path g`, + SUBGOAL_THEN `!g. valid_path g ==> valid_path(reversepath g)` + (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN GEN_TAC THEN + SIMP_TAC[valid_path; piecewise_differentiable_on; GSYM path; + PATH_REVERSEPATH] THEN + DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) MP_TAC) THEN + REWRITE_TAC[IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\x:real^1. vec 1 - x) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE; reversepath] THEN + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN + SIMP_TAC[DIFFERENTIABLE_SUB; DIFFERENTIABLE_CONST; DIFFERENTIABLE_ID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [UNDISCH_TAC `(x:real^1) IN interval[vec 0,vec 1]` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o ISPEC `\x:real^1. vec 1 - x` o + MATCH_MP FUN_IN_IMAGE) THEN + UNDISCH_TAC `~((x:real^1) IN IMAGE (\x. vec 1 - x) s)` THEN + REWRITE_TAC[VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]]);; + +let HAS_PATH_INTEGRAL_REVERSEPATH = prove + (`!f g i. valid_path g /\ (f has_path_integral i) g + ==> (f has_path_integral (--i)) (reversepath g)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(-- &1 = &0)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_ARITH `x + --x:real^1 = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_LNEG] THEN + REWRITE_TAC[VECTOR_MUL_LID; VECTOR_NEG_NEG; REAL_POW_ONE] THEN + REWRITE_TAC[reversepath; VECTOR_ARITH `-- x + a:real^N = a - x`] THEN + REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC(REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE_FINITE) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN + REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC o CONJUNCT2) THEN + EXISTS_TAC `IMAGE (\x:real^1. vec 1 - x) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM COMPLEX_MUL_RNEG] THEN + AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN + REWRITE_TAC[GSYM DROP_VEC; GSYM DROP_NEG] THEN + MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `--x:real^N = vec 0 - x`] THEN + SIMP_TAC[HAS_VECTOR_DERIVATIVE_SUB; HAS_VECTOR_DERIVATIVE_CONST; + HAS_VECTOR_DERIVATIVE_ID] THEN + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DIFF]) THEN + REWRITE_TAC[IN_DIFF] THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[CONTRAPOS_THM; IN_DIFF; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[IN_IMAGE] THEN + MESON_TAC[VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);; + +let PATH_INTEGRABLE_REVERSEPATH = prove + (`!f g. valid_path g /\ f path_integrable_on g + ==> f path_integrable_on (reversepath g)`, + REWRITE_TAC[path_integrable_on] THEN + MESON_TAC[HAS_PATH_INTEGRAL_REVERSEPATH]);; + +let PATH_INTEGRABLE_REVERSEPATH_EQ = prove + (`!f g. valid_path g + ==> (f path_integrable_on (reversepath g) <=> + f path_integrable_on g)`, + MESON_TAC[PATH_INTEGRABLE_REVERSEPATH; VALID_PATH_REVERSEPATH; + REVERSEPATH_REVERSEPATH]);; + +let PATH_INTEGRAL_REVERSEPATH = prove + (`!f g. valid_path g /\ f path_integrable_on g + ==> path_integral (reversepath g) f = --(path_integral g f)`, + MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_REVERSEPATH; + HAS_PATH_INTEGRAL_INTEGRAL]);; + +(* ------------------------------------------------------------------------- *) +(* Joining two paths together. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_JOIN_EQ = prove + (`!g1 g2. + pathfinish g1 = pathstart g2 + ==> (valid_path(g1 ++ g2) <=> valid_path g1 /\ valid_path g2)`, + REWRITE_TAC[valid_path; piecewise_differentiable_on; GSYM path] THEN + ASM_SIMP_TAC[PATH_JOIN] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `path(g1:real^1->complex)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `path(g2:real^1->complex)` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL + [EXISTS_TAC `(vec 0) INSERT (vec 1) INSERT + {x:real^1 | ((&1 / &2) % x) IN s}` THEN + CONJ_TAC THENL + [REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / &2) % x:real^1`) THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTERVAL_1; DROP_CMUL; DROP_VEC; + IN_INSERT; DE_MORGAN_THM; GSYM DROP_EQ; NOT_EXISTS_THM] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(g1:real^1->complex) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN + SIMP_TAC[DIFFERENTIABLE_CMUL; DIFFERENTIABLE_ID] THEN + MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `(g1 ++ g2):real^1->complex` THEN + EXISTS_TAC `dist(&1 / &2 % x:real^1,lift(&1 / &2))` THEN + ASM_REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; + LIFT_DROP] THEN + REWRITE_TAC[joinpaths] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + + EXISTS_TAC `(vec 0) INSERT (vec 1) INSERT + {x:real^1 | ((&1 / &2) % (x + vec 1)) IN s}` THEN + CONJ_TAC THENL + [REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / &2) % (x + vec 1):real^1`) THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTERVAL_1; DROP_CMUL; DROP_VEC; + DROP_ADD; IN_INSERT; DE_MORGAN_THM; GSYM DROP_EQ; NOT_EXISTS_THM] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(g2:real^1->complex) = + (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN + SIMP_TAC[DIFFERENTIABLE_CMUL; DIFFERENTIABLE_ADD; + DIFFERENTIABLE_CONST; DIFFERENTIABLE_ID] THEN + MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `(g1 ++ g2):real^1->complex` THEN + EXISTS_TAC `dist(&1 / &2 % (x + vec 1):real^1,lift(&1 / &2))` THEN + ASM_REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; + DROP_ADD; DROP_VEC; LIFT_DROP] THEN + REWRITE_TAC[joinpaths] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s1:real^1->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `s2:real^1->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(&1 / &2 % vec 1:real^1) INSERT + {x:real^1 | (&2 % x) IN s1} UNION + {x:real^1 | (&2 % x - vec 1) IN s2}` THEN + CONJ_TAC THENL + [REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN + CONJ_TAC THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; IN_DIFF; DROP_VEC; IN_INSERT; IN_ELIM_THM; + DE_MORGAN_THM; IN_UNION; GSYM DROP_EQ; DROP_CMUL] THEN + STRIP_TAC THEN + REWRITE_TAC[joinpaths] THEN ASM_CASES_TAC `drop x <= &1 / &2` THENL + [MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\x. (g1:real^1->complex)(&2 % x)` THEN + EXISTS_TAC `abs(&1 / &2 - drop x)` THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; + DROP_ADD; DROP_VEC; LIFT_DROP] THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC]; + MATCH_MP_TAC DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\x. (g2:real^1->complex)(&2 % x - vec 1)` THEN + EXISTS_TAC `abs(&1 / &2 - drop x)` THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; DROP_CMUL; + DROP_ADD; DROP_VEC; LIFT_DROP] THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC]] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN + SIMP_TAC[DIFFERENTIABLE_CMUL; DIFFERENTIABLE_SUB; DIFFERENTIABLE_CONST; + DIFFERENTIABLE_ID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; IN_DIFF; DROP_VEC; DROP_CMUL] THEN + ASM_REAL_ARITH_TAC);; + +let VALID_PATH_JOIN = prove + (`!g1 g2. + valid_path g1 /\ valid_path g2 /\ pathfinish g1 = pathstart g2 + ==> valid_path(g1 ++ g2)`, + MESON_TAC[VALID_PATH_JOIN_EQ]);; + +let HAS_PATH_INTEGRAL_JOIN = prove + (`!f g1 g2 i1 i2. + (f has_path_integral i1) g1 /\ + (f has_path_integral i2) g2 /\ + valid_path g1 /\ valid_path g2 + ==> (f has_path_integral (i1 + i2)) (g1 ++ g2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL; CONJ_ASSOC] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN + (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY))) THEN + DISCH_THEN(ASSUME_TAC o SPECL [`&2`; `--(vec 1):real^1`]) THEN + DISCH_THEN(MP_TAC o SPECL [`&2`; `vec 0:real^1`]) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[DIMINDEX_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_RNEG; VECTOR_NEG_NEG; VECTOR_MUL_RZERO; + VECTOR_ADD_LID; VECTOR_NEG_0; VECTOR_ADD_RID; + VECTOR_ARITH `&1 / &2 % x + &1 / &2 % x = x:real^N`] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_NEG; DROP_VEC; VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[VECTOR_ARITH `x % (a + b) + y % b = x % a + (x + y) % b`; + VECTOR_ARITH `x % a + y % (a + b) = (x + y) % a + y % b`] THEN + REWRITE_TAC[REAL_ARITH `(&1 - (&2 * x + --(&1))) * inv(&2) = &1 - x`; + REAL_ARITH `&1 - x + &2 * x + --(&1) = x`; + REAL_ARITH `&1 - &2 * x + (&2 * x) * inv(&2) = &1 - x`; + REAL_ARITH `(&2 * x) * inv(&2) = x`] THEN + REWRITE_TAC[VECTOR_ARITH `b - inv(&2) % (a + b) = inv(&2) % (b - a)`; + VECTOR_ARITH `inv(&2) % (a + b) - a = inv(&2) % (b - a)`] THEN + REPEAT(DISCH_THEN(MP_TAC o SPEC `&2` o MATCH_MP HAS_INTEGRAL_CMUL) THEN + REWRITE_TAC[COMPLEX_CMUL; SIMPLE_COMPLEX_ARITH + `Cx(&2) * Cx(&1 / &2) * j = j /\ + Cx(&2) * (a * Cx(inv(&2)) * b) = a * b`] THEN DISCH_TAC) THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN + EXISTS_TAC `&1 / &2 % vec 1:real^1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE + [TAUT `a1 /\ a2 /\ b ==> c <=> b ==> a1 /\ a2 ==> c`] + HAS_INTEGRAL_SPIKE_FINITE)) THENL + [MP_TAC(REWRITE_RULE[valid_path] (ASSUME `valid_path g1`)); + MP_TAC(REWRITE_RULE[valid_path] (ASSUME `valid_path g2`))] THEN + REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `((&1 / &2) % vec 1) INSERT {x:real^1 | (&2 % x) IN s}`; + EXISTS_TAC `((&1 / &2) % vec 1) INSERT + {x:real^1 | (&2 % x - vec 1) IN s}`] THEN + (CONJ_TAC THENL + [REWRITE_TAC[FINITE_INSERT] THEN MATCH_MP_TAC FINITE_IMAGE_INJ THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC]) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INSERT; IN_DIFF; IN_INSERT; DE_MORGAN_THM; + joinpaths; IN_INTERVAL_1; DROP_VEC; DROP_CMUL; GSYM DROP_EQ] THEN + SIMP_TAC[REAL_LT_IMP_LE; REAL_MUL_RID; IN_ELIM_THM; + REAL_ARITH `&1 / &2 <= x /\ ~(x = &1 / &2) ==> ~(x <= &1 / &2)`] THEN + REWRITE_TAC[LIFT_CMUL; LIFT_SUB; LIFT_DROP; LIFT_NUM; GSYM VECTOR_SUB] THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + MATCH_MP_TAC(COMPLEX_RING `x = Cx(&2) * y ==> g * x = Cx(&2) * g * y`) THEN + MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THENL + [EXISTS_TAC `(\x. g1(&2 % x)):real^1->complex`; + EXISTS_TAC `(\x. g2(&2 % x - vec 1)):real^1->complex`] THEN + EXISTS_TAC `abs(drop x - &1 / &2)` THEN + REWRITE_TAC[DIST_REAL; GSYM drop; GSYM REAL_ABS_NZ] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NE; REAL_SUB_0] THEN + (CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC]) THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[GSYM COMPLEX_CMUL] THEN + SUBST1_TAC(SYM(SPEC `2` DROP_VEC)) THEN + MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN + (CONJ_TAC THENL + [TRY(GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_SUB THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]) THEN + REWRITE_TAC[has_vector_derivative] THEN + MATCH_MP_TAC(MESON[HAS_DERIVATIVE_LINEAR] + `f = g /\ linear f ==> (f has_derivative g) net`) THEN + REWRITE_TAC[linear; FUN_EQ_THM; DROP_VEC] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN + REAL_ARITH_TAC; + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[IN_DIFF; IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC] THEN + ASM_REAL_ARITH_TAC]));; + +let PATH_INTEGRABLE_JOIN = prove + (`!f g1 g2. + valid_path g1 /\ valid_path g2 + ==> (f path_integrable_on (g1 ++ g2) <=> + f path_integrable_on g1 /\ f path_integrable_on g2)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + REWRITE_TAC[path_integrable_on] THEN + ASM_MESON_TAC[HAS_PATH_INTEGRAL_JOIN]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[valid_path]) THEN + REWRITE_TAC[PATH_INTEGRABLE_ON; joinpaths] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) + THENL + [DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]); + DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&1)`])] THEN + REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] INTEGRABLE_AFFINITY)) + THENL + [DISCH_THEN(MP_TAC o SPECL [`&1 / &2`; `vec 0:real^1`]); + DISCH_THEN(MP_TAC o SPECL [`&1 / &2`; `lift(&1 / &2)`])] THEN + REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN + REWRITE_TAC[LIFT_DROP; LIFT_NUM; VECTOR_MUL_RZERO; VECTOR_NEG_0; + GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RNEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN + REWRITE_TAC[VECTOR_ARITH `vec 2 + --vec 1:real^1 = vec 1`; + VECTOR_ARITH `vec 1 + --vec 1:real^1 = vec 0`] THEN + DISCH_THEN(MP_TAC o SPEC `&1 / &2` o MATCH_MP INTEGRABLE_CMUL) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SPIKE_FINITE THEN + REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD; + LIFT_DROP; COMPLEX_CMUL] THEN + REWRITE_TAC[COMPLEX_RING `a * b = Cx(&1 / &2) * x * y <=> + x * y = a * Cx(&2) * b`] + THENL + [UNDISCH_TAC `(g1:real^1->complex) piecewise_differentiable_on + interval[vec 0,vec 1]`; + UNDISCH_TAC `(g2:real^1->complex) piecewise_differentiable_on + interval[vec 0,vec 1]`] THEN + REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN + ASM_REWRITE_TAC[FINITE_INSERT; IN_INSERT; DE_MORGAN_THM] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN X_GEN_TAC `t:real^1` THEN + STRIP_TAC THEN BINOP_TAC THENL + [AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `x <= &1 ==> &1 / &2 * x <= &1 / &2`] THEN + AP_TERM_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC; + AP_TERM_TAC THEN ASM_SIMP_TAC[REAL_ARITH + `&0 <= t /\ ~(t = &0) ==> ~(&1 / &2 * t + &1 / &2 <= &1 / &2)`] THEN + AP_TERM_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB; LIFT_DROP] THEN + REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THENL + [EXISTS_TAC `(\x. g1(&2 % x)):real^1->complex` THEN + EXISTS_TAC `abs(drop t - &1) / &2` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < abs x / &2 <=> ~(x = &0)`; REAL_SUB_0] THEN + REWRITE_TAC[DIST_REAL; GSYM drop; DROP_CMUL] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[REAL_ARITH + `t <= &1 /\ ~(t = &1) /\ abs(x - &1 / &2 * t) < abs(t - &1) / &2 + ==> x <= &1 / &2`]; + ALL_TAC]; + EXISTS_TAC `(\x. g2(&2 % x - vec 1)):real^1->complex` THEN + EXISTS_TAC `abs(drop t) / &2` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < abs x / &2 <=> ~(x = &0)`; REAL_SUB_0] THEN + REWRITE_TAC[DIST_REAL; GSYM drop; DROP_CMUL; DROP_ADD; LIFT_DROP] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[REAL_ARITH + `&0 <= t /\ abs(x - (&1 / &2 * t + &1 / &2)) < abs(t) / &2 + ==> ~(x <= &1 / &2)`]; + ALL_TAC]] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[GSYM COMPLEX_CMUL] THEN + SUBST1_TAC(SYM(SPEC `2` DROP_VEC)) THEN + MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN + (CONJ_TAC THENL + [TRY(GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_SUB THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]) THEN + REWRITE_TAC[has_vector_derivative] THEN + MATCH_MP_TAC(MESON[HAS_DERIVATIVE_LINEAR] + `f = g /\ linear f ==> (f has_derivative g) net`) THEN + REWRITE_TAC[linear; FUN_EQ_THM; DROP_VEC] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(MESON[VECTOR_DERIVATIVE_WORKS] + `f differentiable (at t) /\ t' = t + ==> (f has_vector_derivative + (vector_derivative f (at t))) (at t')`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; DROP_VEC]; + ALL_TAC] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB; LIFT_DROP; + DROP_VEC] THEN + REAL_ARITH_TAC]));; + +let PATH_INTEGRAL_JOIN = prove + (`!f g1 g2:real^1->complex. + valid_path g1 /\ valid_path g2 /\ + f path_integrable_on g1 /\ f path_integrable_on g2 + ==> path_integral (g1 ++ g2) f = + path_integral g1 f + path_integral g2 f`, + MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_INTEGRAL; + HAS_PATH_INTEGRAL_JOIN]);; + +(* ------------------------------------------------------------------------- *) +(* Reparametrizing to shift the starting point of a (closed) path. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_SHIFTPATH = prove + (`!g a. valid_path g /\ pathfinish g = pathstart g /\ + a IN interval[vec 0,vec 1] + ==> valid_path(shiftpath a g)`, + REWRITE_TAC[valid_path; shiftpath; DROP_ADD; GSYM DROP_VEC] THEN + REWRITE_TAC[REAL_ARITH `a + x <= y <=> x <= y - a`; GSYM DROP_SUB] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_CASES THEN + REPLICATE_TAC 2 (CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; + ALL_TAC]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a - vec 1:real^1 = vec 0`; + VECTOR_ARITH `a + vec 1 - a:real^1 = vec 1`] THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[VECTOR_ARITH `a + x:real^1 = &1 % x + a`]; + ONCE_REWRITE_TAC[VECTOR_ARITH + `a + x - vec 1:real^1 = &1 % x + (a - vec 1)`]] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_AFFINE THEN + MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS; INTERVAL_EQ_EMPTY_1; + IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[EMPTY_SUBSET; SUBSET_INTERVAL_1; DROP_ADD; DROP_CMUL; + DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC);; + +let HAS_PATH_INTEGRAL_SHIFTPATH = prove + (`!f g i a. + (f has_path_integral i) g /\ valid_path g /\ + a IN interval[vec 0,vec 1] + ==> (f has_path_integral i) (shiftpath a g)`, + REWRITE_TAC[HAS_PATH_INTEGRAL; IN_INTERVAL_1; DROP_VEC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `i = integral (interval[a,vec 1]) + (\x. f ((g:real^1->real^2) x) * vector_derivative g (at x)) + + integral (interval[vec 0,a]) + (\x. f (g x) * vector_derivative g (at x))` + SUBST1_TAC THENL + [MATCH_MP_TAC(INST_TYPE [`:1`,`:M`; `:2`,`:N`] HAS_INTEGRAL_UNIQUE) THEN + MAP_EVERY EXISTS_TAC + [`\x. f ((g:real^1->real^2) x) * vector_derivative g (at x)`; + `interval[vec 0:real^1,vec 1]`] THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `a:real^1` THEN + ASM_REWRITE_TAC[DROP_VEC] THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN + (CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC]) THEN + REWRITE_TAC[DROP_SUB; DROP_VEC; SUBSET_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `vec 1 - a:real^1` THEN + ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; + REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN + REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[shiftpath] THEN CONJ_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_FINITE THENL + [EXISTS_TAC `\x. f(g(a + x)) * vector_derivative g (at(a + x))` THEN + EXISTS_TAC `(vec 1 - a) INSERT IMAGE (\x:real^1. x - a) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INSERT] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; IN_INSERT; IN_IMAGE; UNWIND_THM2; + DROP_SUB; DROP_ADD; DROP_VEC; DE_MORGAN_THM; + VECTOR_ARITH `x:real^1 = y - a <=> y = a + x`] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `x <= &1 - a ==> a + x <= &1`] THEN + AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC + [`\x. (g:real^1->complex)(a + x)`; `dist(vec 1 - a:real^1,x)`] THEN + SIMP_TAC[CONJ_ASSOC; dist; NORM_REAL; GSYM drop; DROP_VEC; DROP_SUB] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN + REWRITE_TAC[GSYM DROP_VEC] THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN + SUBST1_TAC(VECTOR_ARITH `vec 1:real^1 = vec 0 + vec 1`) THEN + SIMP_TAC[HAS_VECTOR_DERIVATIVE_ADD; HAS_VECTOR_DERIVATIVE_CONST; + HAS_VECTOR_DERIVATIVE_ID] THEN + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; DROP_VEC; DROP_ADD] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(\x. f (g x) * vector_derivative g (at x)) integrable_on + (interval [a,vec 1])` + MP_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN + ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; SUBSET_INTERVAL_1; REAL_LE_REFL]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(&1 = &0)`) o MATCH_MP + INTEGRABLE_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^1` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[VECTOR_ARITH `&1 % x + a:real^1 = a + x`] THEN + REWRITE_TAC[REAL_INV_1; REAL_POS; REAL_ABS_NUM; REAL_POW_ONE] THEN + ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE] THEN + REWRITE_TAC[VECTOR_MUL_LID; GSYM VECTOR_SUB; VECTOR_SUB_REFL]; + EXISTS_TAC `\x. f(g(a + x - vec 1)) * + vector_derivative g (at(a + x - vec 1))` THEN + EXISTS_TAC `(vec 1 - a) INSERT IMAGE (\x:real^1. x - a + vec 1) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INSERT] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; IN_INSERT; IN_IMAGE; UNWIND_THM2; + DROP_SUB; DROP_ADD; DROP_VEC; DE_MORGAN_THM; + VECTOR_ARITH `x:real^1 = y - a + z <=> y = a + (x - z)`] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC; DROP_SUB] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH + `&1 - a <= x /\ ~(x = &1 - a) ==> ~(a + x <= &1)`] THEN + AP_TERM_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC + [`\x. (g:real^1->complex)(a + x - vec 1)`; + `dist(vec 1 - a:real^1,x)`] THEN + SIMP_TAC[CONJ_ASSOC; dist; NORM_REAL; GSYM drop; DROP_VEC; DROP_SUB] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN + REWRITE_TAC[GSYM DROP_VEC] THEN MATCH_MP_TAC VECTOR_DIFF_CHAIN_AT THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `a + x - vec 1:real^1 = (a - vec 1) + x`] THEN + SIMP_TAC[HAS_VECTOR_DERIVATIVE_ADD; HAS_VECTOR_DERIVATIVE_CONST; + HAS_VECTOR_DERIVATIVE_ID]; + ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[IN_DIFF; DROP_SUB; IN_INTERVAL_1; DROP_VEC; DROP_ADD] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(\x. f (g x) * vector_derivative g (at x)) integrable_on + (interval [vec 0,a])` + MP_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^1`; `vec 1:real^1`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN + ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; SUBSET_INTERVAL_1; REAL_LE_REFL]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o C CONJ (REAL_ARITH `~(&1 = &0)`) o MATCH_MP + INTEGRABLE_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPEC `a - vec 1:real^1` o + MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[VECTOR_ARITH `&1 % x + a - vec 1:real^1 = a + x - vec 1`] THEN + REWRITE_TAC[REAL_INV_1; REAL_POS; REAL_ABS_NUM; REAL_POW_ONE] THEN + ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; GSYM REAL_NOT_LE] THEN + REWRITE_TAC[VECTOR_MUL_LID; + VECTOR_ARITH `vec 0 + --(a - vec 1):real^1 = vec 1 - a`; + VECTOR_ARITH `a + --(a - vec 1):real^1 = vec 1`]]);; + +let HAS_PATH_INTEGRAL_SHIFTPATH_EQ = prove + (`!f g i a. + valid_path g /\ pathfinish g = pathstart g /\ + a IN interval[vec 0,vec 1] + ==> ((f has_path_integral i) (shiftpath a g) <=> + (f has_path_integral i) g)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_SHIFTPATH] THEN + SUBGOAL_THEN + `(f has_path_integral i) (shiftpath (vec 1 - a) (shiftpath a g))` + MP_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_SHIFTPATH THEN + ASM_SIMP_TAC[VALID_PATH_SHIFTPATH] THEN REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_PATH_INTEGRAL] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_FINITE_EQ THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN + REWRITE_TAC[piecewise_differentiable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(s:real^1->bool) UNION {vec 0,vec 1}` THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_RULES] THEN + REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = (s DIFF u) DIFF t`] THEN + REWRITE_TAC[GSYM OPEN_CLOSED_INTERVAL_1] THEN X_GEN_TAC `x:real^1` THEN + STRIP_TAC THEN BINOP_TAC THEN CONV_TAC SYM_CONV THENL + [AP_TERM_TAC THEN MATCH_MP_TAC SHIFTPATH_SHIFTPATH THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]; + ALL_TAC] THEN + MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + MAP_EVERY EXISTS_TAC + [`g:real^1->real^2`; `interval(vec 0,vec 1) DIFF s:real^1->bool`] THEN + ASM_SIMP_TAC[GSYM VECTOR_DERIVATIVE_WORKS; OPEN_DIFF; FINITE_IMP_CLOSED; + OPEN_INTERVAL] THEN + REPEAT STRIP_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SHIFTPATH_SHIFTPATH; + FIRST_X_ASSUM MATCH_MP_TAC] THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]);; + +let PATH_INTEGRAL_SHIFTPATH = prove + (`!f g a. valid_path g /\ pathfinish g = pathstart g /\ + a IN interval[vec 0,vec 1] + ==> path_integral (shiftpath a g) f = path_integral g f`, + SIMP_TAC[path_integral; HAS_PATH_INTEGRAL_SHIFTPATH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* More about straight-line paths. *) +(* ------------------------------------------------------------------------- *) + +let HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN = prove + (`!a b:complex x s. + (linepath(a,b) has_vector_derivative (b - a)) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[linepath; has_vector_derivative] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `u % (b - a) = vec 0 + u % (b - a)`] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % b = a + u % (b - a)`] THEN + MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN + MATCH_MP_TAC HAS_DERIVATIVE_VMUL_DROP THEN REWRITE_TAC[HAS_DERIVATIVE_ID]);; + +let HAS_VECTOR_DERIVATIVE_LINEPATH_AT = prove + (`!a b:complex x. + (linepath(a,b) has_vector_derivative (b - a)) (at x)`, + MESON_TAC[WITHIN_UNIV; HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN]);; + +let VALID_PATH_LINEPATH = prove + (`!a b. valid_path(linepath(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[valid_path] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN + REWRITE_TAC[differentiable_on; differentiable] THEN + MESON_TAC[HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN; has_vector_derivative]);; + +let VECTOR_DERIVATIVE_LINEPATH_WITHIN = prove + (`!a b x. x IN interval[vec 0,vec 1] + ==> vector_derivative (linepath(a,b)) + (at x within interval[vec 0,vec 1]) = b - a`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL THEN + ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN] THEN + REWRITE_TAC[DROP_VEC; REAL_LT_01]);; + +let VECTOR_DERIVATIVE_LINEPATH_AT = prove + (`!a b x. vector_derivative (linepath(a,b)) (at x) = b - a`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_LINEPATH_AT]);; + +let HAS_PATH_INTEGRAL_LINEPATH = prove + (`!f i a b. (f has_path_integral i) (linepath(a,b)) <=> + ((\x. f(linepath(a,b) x) * (b - a)) has_integral i) + (interval[vec 0,vec 1])`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_path_integral] THEN + MATCH_MP_TAC HAS_INTEGRAL_EQ_EQ THEN + SIMP_TAC[VECTOR_DERIVATIVE_LINEPATH_WITHIN]);; + +let LINEPATH_IN_PATH = prove + (`!x. x IN interval[vec 0,vec 1] ==> linepath(a,b) x IN segment[a,b]`, + REWRITE_TAC[segment; linepath; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + MESON_TAC[]);; + +let RE_LINEPATH_CX = prove + (`!a b x. Re(linepath(Cx a,Cx b) x) = (&1 - drop x) * a + drop x * b`, + REWRITE_TAC[linepath; RE_ADD; COMPLEX_CMUL; RE_MUL_CX; RE_CX]);; + +let IM_LINEPATH_CX = prove + (`!a b x. Im(linepath(Cx a,Cx b) x) = &0`, + REWRITE_TAC[linepath; IM_ADD; COMPLEX_CMUL; IM_MUL_CX; IM_CX] THEN + REAL_ARITH_TAC);; + +let LINEPATH_CX = prove + (`!a b x. linepath(Cx a,Cx b) x = Cx((&1 - drop x) * a + drop x * b)`, + REWRITE_TAC[COMPLEX_EQ; RE_LINEPATH_CX; IM_LINEPATH_CX; RE_CX; IM_CX]);; + +let HAS_PATH_INTEGRAL_TRIVIAL = prove + (`!f a. (f has_path_integral (Cx(&0))) (linepath(a,a))`, + REWRITE_TAC[HAS_PATH_INTEGRAL_LINEPATH; COMPLEX_SUB_REFL; + COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; + +let PATH_INTEGRAL_TRIVIAL = prove + (`!f a. path_integral (linepath(a,a)) f = Cx(&0)`, + MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_UNIQUE]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to subpath construction. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_SUBPATH = prove + (`!g u v. valid_path g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] + ==> valid_path(subpath u v g)`, + SIMP_TAC[valid_path; PATH_SUBPATH] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[subpath] THEN + ASM_CASES_TAC `v:real^1 = u` THENL + [MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_LZERO; DROP_VEC] THEN + REWRITE_TAC[DIFFERENTIABLE_ON_CONST]; + MATCH_MP_TAC(REWRITE_RULE[o_DEF] PIECEWISE_DIFFERENTIABLE_COMPOSE) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN + MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_ADD THEN + REWRITE_TAC[DIFFERENTIABLE_CONST] THEN + MATCH_MP_TAC DIFFERENTIABLE_CMUL THEN REWRITE_TAC[DIFFERENTIABLE_ID]; + MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REPEAT(COND_CASES_TAC THEN REWRITE_TAC[EMPTY_SUBSET]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + SIMP_TAC[SUBSET_INTERVAL_1; DROP_ADD; DROP_CMUL; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC; + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB] THEN + ASM_SIMP_TAC[DROP_EQ; REAL_FIELD `~(u:real = v) ==> + (u + (v - u) * x = b <=> x = (b - u) / (v - u))`] THEN + X_GEN_TAC `b:real^1` THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{lift((drop b - drop u) / (drop v - drop u))}` THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; SUBSET; IN_ELIM_THM] THEN + SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; IN_SING]]]);; + +let HAS_PATH_INTEGRAL_SUBPATH_REFL = prove + (`!f g u. (f has_path_integral (Cx(&0))) (subpath u u g)`, + REWRITE_TAC[HAS_PATH_INTEGRAL; subpath; VECTOR_SUB_REFL] THEN + REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_DERIVATIVE_CONST_AT] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; + +let PATH_INTEGRABLE_SUBPATH_REFL = prove + (`!f g u. f path_integrable_on (subpath u u g)`, + REWRITE_TAC[path_integrable_on] THEN + MESON_TAC[HAS_PATH_INTEGRAL_SUBPATH_REFL]);; + +let PATH_INTEGRAL_SUBPATH_REFL = prove + (`!f g u. path_integral (subpath u u g) f = Cx(&0)`, + MESON_TAC[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_SUBPATH_REFL]);; + +let HAS_PATH_INTEGRAL_SUBPATH = prove + (`!f g u v. + valid_path g /\ f path_integrable_on g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + drop u <= drop v + ==> (f has_path_integral + integral (interval[u,v]) + (\x. f(g x) * vector_derivative g (at x))) + (subpath u v g)`, + REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL; subpath] THEN + REWRITE_TAC[GSYM integrable_on] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `v:real^1 = u` THENL + [ASM_REWRITE_TAC[INTEGRAL_REFL; VECTOR_SUB_REFL; DROP_VEC] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_DERIVATIVE_CONST_AT] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]; + SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]; ALL_TAC]] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o + MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LT_IMP_LE]; + REWRITE_TAC[HAS_INTEGRAL_INTEGRAL]] THEN + DISCH_THEN(MP_TAC o SPECL [`drop(v - u)`; `u:real^1`] o + MATCH_MP(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY)) THEN + ASM_SIMP_TAC[DROP_SUB; REAL_ARITH `u < v ==> ~(v - u = &0)`] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_SUB] THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_ARITH `u < v ==> ~(v < u) /\ &0 <= v - u`; + VECTOR_ARITH `a % u + --(a % v):real^N = a % (u - v)`] THEN + REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_MUL_RZERO] THEN + SUBGOAL_THEN `inv(drop v - drop u) % (v - u) = vec 1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + UNDISCH_TAC `drop u < drop v` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `drop(v - u)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1; VECTOR_MUL_ASSOC; DROP_SUB] THEN + ASM_SIMP_TAC[REAL_FIELD `u < v ==> (v - u) * inv(v - u) = &1`] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE_FINITE) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [valid_path]) THEN + REWRITE_TAC[piecewise_differentiable_on; IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC o CONJUNCT2) THEN + EXISTS_TAC `{t | ((drop v - drop u) % t + u) IN k}` THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ THEN + ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_SUB; DROP_ADD] THEN + UNDISCH_TAC `drop u < drop v` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_CMUL] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN + REWRITE_TAC[VECTOR_ARITH `x + a % y:real^N = a % y + x`] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM COMPLEX_CMUL; GSYM DROP_SUB] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] VECTOR_DIFF_CHAIN_AT) THEN + REWRITE_TAC[DROP_SUB] THEN CONJ_TAC THENL + [SUBST1_TAC(VECTOR_ARITH `v - u:real^1 = (v - u) + vec 0`) THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN + SUBST1_TAC(MESON[LIFT_DROP; LIFT_EQ_CMUL] + `v - u = drop(v - u) % vec 1`) THEN REWRITE_TAC[GSYM DROP_SUB] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_CMUL THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_ID]; + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_CMUL; DROP_VEC] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(drop v - drop u) * &1 + drop u` THEN + ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; + REAL_SUB_LE; REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC]]);; + +let PATH_INTEGRABLE_SUBPATH = prove + (`!f g u v. + valid_path g /\ f path_integrable_on g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] + ==> f path_integrable_on (subpath u v g)`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH + `drop u <= drop v \/ drop v <= drop u`) + THENL + [ASM_MESON_TAC[path_integrable_on; HAS_PATH_INTEGRAL_SUBPATH]; + ONCE_REWRITE_TAC[GSYM REVERSEPATH_SUBPATH] THEN + MATCH_MP_TAC PATH_INTEGRABLE_REVERSEPATH THEN + ASM_SIMP_TAC[VALID_PATH_SUBPATH] THEN + ASM_MESON_TAC[path_integrable_on; HAS_PATH_INTEGRAL_SUBPATH]]);; + +let HAS_INTEGRAL_PATH_INTEGRAL_SUBPATH = prove + (`!f g u v. + valid_path g /\ f path_integrable_on g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + drop u <= drop v + ==> (((\x. f(g x) * vector_derivative g (at x))) has_integral + path_integral (subpath u v g) f) + (interval[u,v])`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[GSYM PATH_INTEGRABLE_ON; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[IN_INTERVAL_1]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_SUBPATH]]);; + +let PATH_INTEGRAL_SUBPATH_INTEGRAL = prove + (`!f g u v. + valid_path g /\ f path_integrable_on g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + drop u <= drop v + ==> path_integral (subpath u v g) f = + integral (interval[u,v]) + (\x. f(g x) * vector_derivative g (at x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_SUBPATH]);; + +let PATH_INTEGRAL_SUBPATH_COMBINE = prove + (`!f g u v w. + valid_path g /\ f path_integrable_on g /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] /\ + w IN interval[vec 0,vec 1] + ==> path_integral (subpath u v g) f + path_integral (subpath v w g) f = + path_integral (subpath u w g) f`, + REPLICATE_TAC 3 GEN_TAC THEN + SUBGOAL_THEN + `!u v w. + drop u <= drop v /\ drop v <= drop w + ==> valid_path g /\ f path_integrable_on g /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] /\ + w IN interval[vec 0,vec 1] + ==> path_integral (subpath u v g) f + + path_integral (subpath v w g) f = + path_integral (subpath u w g) f` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `drop u <= drop v /\ drop v <= drop w \/ + drop u <= drop w /\ drop w <= drop v \/ + drop v <= drop u /\ drop u <= drop w \/ + drop v <= drop w /\ drop w <= drop u \/ + drop w <= drop u /\ drop u <= drop v \/ + drop w <= drop v /\ drop v <= drop u`) THEN + FIRST_ASSUM(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC (MESON[REVERSEPATH_SUBPATH] + `subpath v u (g:real^1->complex) = reversepath(subpath u v g) /\ + subpath w u g = reversepath(subpath u w g) /\ + subpath w v g = reversepath(subpath v w g)`) THEN + ASM_SIMP_TAC[PATH_INTEGRAL_REVERSEPATH; PATH_INTEGRABLE_SUBPATH; + VALID_PATH_REVERSEPATH; VALID_PATH_SUBPATH] THEN + CONV_TAC COMPLEX_RING] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `drop u <= drop w` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN + ASM_SIMP_TAC[PATH_INTEGRAL_SUBPATH_INTEGRAL] THEN + MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[GSYM PATH_INTEGRABLE_ON; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[IN_INTERVAL_1]);; + +let PATH_INTEGRAL_INTEGRAL = prove + (`!f g. path_integral g f = + integral (interval [vec 0,vec 1]) + (\x. f (g x) * vector_derivative g (at x))`, + REWRITE_TAC[path_integral; integral; HAS_PATH_INTEGRAL]);; + +(* ------------------------------------------------------------------------- *) +(* Easier to reason about segments via convex hulls. *) +(* ------------------------------------------------------------------------- *) + +let SEGMENTS_SUBSET_CONVEX_HULL = prove + (`!a b c. segment[a,b] SUBSET (convex hull {a,b,c}) /\ + segment[a,c] SUBSET (convex hull {a,b,c}) /\ + segment[b,c] SUBSET (convex hull {a,b,c}) /\ + segment[b,a] SUBSET (convex hull {a,b,c}) /\ + segment[c,a] SUBSET (convex hull {a,b,c}) /\ + segment[c,b] SUBSET (convex hull {a,b,c})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; + +let POINTS_IN_CONVEX_HULL = prove + (`!x s. x IN s ==> x IN convex hull s`, + MESON_TAC[SUBSET; HULL_SUBSET]);; + +let CONVEX_HULL_SUBSET = prove + (`(!x. x IN s ==> x IN convex hull t) + ==> (convex hull s) SUBSET (convex hull t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET]);; + +let NOT_IN_INTERIOR_CONVEX_HULL_3 = prove + (`!a b c:complex. ~(a IN interior(convex hull {a,b,c})) /\ + ~(b IN interior(convex hull {a,b,c})) /\ + ~(c IN interior(convex hull {a,b,c}))`, + REPEAT GEN_TAC THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC NOT_IN_INTERIOR_CONVEX_HULL THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN + REWRITE_TAC[DIMINDEX_2] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy's theorem where there's a primitive. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRAL_PRIMITIVE_LEMMA = prove + (`!f f' g a b s. + ~(interval[a,b] = {}) /\ + (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s)) /\ + g piecewise_differentiable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> g(x) IN s) + ==> ((\x. f'(g x) * vector_derivative g (at x within interval[a,b])) + has_integral (f(g b) - f(g a))) (interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[valid_path; piecewise_differentiable_on] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN + EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS] THEN + ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; GSYM o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + ASM_MESON_TAC[holomorphic_on]; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[has_vector_derivative; COMPLEX_CMUL] THEN + SUBGOAL_THEN `(f has_complex_derivative f'(g x)) + (at (g x) within (IMAGE g (interval[a:real^1,b])))` + MP_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]; + ALL_TAC] THEN + SUBGOAL_THEN + `(g:real^1->complex) differentiable (at x within interval[a,b])` + MP_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; IN_DIFF]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [VECTOR_DERIVATIVE_WORKS] THEN + REWRITE_TAC[has_vector_derivative; IMP_IMP; has_complex_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_WITHIN) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_DERIVATIVE_WITHIN_SUBSET)) THEN + DISCH_THEN(MP_TAC o SPEC `interval(a:real^1,b)`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN + ASM_SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL; + HAS_DERIVATIVE_WITHIN_OPEN] THEN + REWRITE_TAC[o_DEF; COMPLEX_CMUL] THEN REWRITE_TAC[COMPLEX_MUL_AC]);; + +let PATH_INTEGRAL_PRIMITIVE = prove + (`!f f' g s. + (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s)) /\ + valid_path g /\ (path_image g) SUBSET s + ==> (f' has_path_integral (f(pathfinish g) - f(pathstart g))) (g)`, + REWRITE_TAC[valid_path; path_image; pathfinish; pathstart] THEN + REWRITE_TAC[has_path_integral] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_PRIMITIVE_LEMMA THEN + ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_POS; REAL_NOT_LT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_MESON_TAC[]);; + +let CAUCHY_THEOREM_PRIMITIVE = prove + (`!f f' g s. + (!x. x IN s ==> (f has_complex_derivative f'(x)) (at x within s)) /\ + valid_path g /\ (path_image g) SUBSET s /\ + pathfinish g = pathstart g + ==> (f' has_path_integral Cx(&0)) (g)`, + MESON_TAC[PATH_INTEGRAL_PRIMITIVE; COMPLEX_SUB_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of path integral for continuous function. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRABLE_CONTINUOUS_LINEPATH = prove + (`!f a b. f continuous_on segment[a,b] + ==> f path_integrable_on (linepath(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_integrable_on; has_path_integral] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[GSYM integrable_on] THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `\x. f(linepath(a,b) x) * (b - a)` THEN + SIMP_TAC[VECTOR_DERIVATIVE_LINEPATH_WITHIN] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[GSYM path_image; ETA_AX; PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[CONTINUOUS_ON_LINEPATH]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetical combining theorems. *) +(* ------------------------------------------------------------------------- *) + +let HAS_PATH_INTEGRAL_CONST_LINEPATH = prove + (`!a b c. ((\x. c) has_path_integral (c * (b - a))) (linepath(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL_LINEPATH] THEN + MP_TAC(ISPECL [`vec 0:real^1`; `vec 1:real^1`; `c * (b - a):complex`] + HAS_INTEGRAL_CONST) THEN + REWRITE_TAC[CONTENT_UNIT; VECTOR_MUL_LID]);; + +let HAS_PATH_INTEGRAL_NEG = prove + (`!f i g. (f has_path_integral i) g + ==> ((\x. --(f x)) has_path_integral (--i)) g`, + REWRITE_TAC[has_path_integral; COMPLEX_MUL_LNEG; HAS_INTEGRAL_NEG]);; + +let HAS_PATH_INTEGRAL_ADD = prove + (`!f1 i1 f2 i2 g. + (f1 has_path_integral i1) g /\ (f2 has_path_integral i2) g + ==> ((\x. f1(x) + f2(x)) has_path_integral (i1 + i2)) g`, + REWRITE_TAC[has_path_integral; COMPLEX_ADD_RDISTRIB] THEN + SIMP_TAC[HAS_INTEGRAL_ADD]);; + +let HAS_PATH_INTEGRAL_SUB = prove + (`!f1 i1 f2 i2 g. + (f1 has_path_integral i1) g /\ (f2 has_path_integral i2) g + ==> ((\x. f1(x) - f2(x)) has_path_integral (i1 - i2)) g`, + REWRITE_TAC[has_path_integral; COMPLEX_SUB_RDISTRIB] THEN + SIMP_TAC[HAS_INTEGRAL_SUB]);; + +let HAS_PATH_INTEGRAL_COMPLEX_LMUL = prove + (`!f g i c. (f has_path_integral i) g + ==> ((\x. c * f x) has_path_integral (c * i)) g`, + REWRITE_TAC[has_path_integral; HAS_INTEGRAL_COMPLEX_LMUL; + GSYM COMPLEX_MUL_ASSOC]);; + +let HAS_PATH_INTEGRAL_COMPLEX_RMUL = prove + (`!f g i c. (f has_path_integral i) g + ==> ((\x. f x * c) has_path_integral (i * c)) g`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[HAS_PATH_INTEGRAL_COMPLEX_LMUL]);; + +let HAS_PATH_INTEGRAL_COMPLEX_DIV = prove + (`!f g i c. (f has_path_integral i) g + ==> ((\x. f x / c) has_path_integral (i / c)) g`, + REWRITE_TAC[complex_div; HAS_PATH_INTEGRAL_COMPLEX_RMUL]);; + +let HAS_PATH_INTEGRAL_EQ = prove + (`!f g p y. + (!x. x IN path_image p ==> f x = g x) /\ + (f has_path_integral y) p + ==> (g has_path_integral y) p`, + REPEAT GEN_TAC THEN + REWRITE_TAC[path_image; IN_IMAGE; has_path_integral; IMP_CONJ] THEN + DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]);; + +let HAS_PATH_INTEGRAL_BOUND_LINEPATH = prove + (`!f i a b B. + (f has_path_integral i) (linepath(a,b)) /\ + &0 <= B /\ (!x. x IN segment[a,b] ==> norm(f x) <= B) + ==> norm(i) <= B * norm(b - a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_path_integral] THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM CONTENT_UNIT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN + EXISTS_TAC `\x. f (linepath (a,b) x) * + vector_derivative (linepath (a,b)) + (at x within interval [vec 0,vec 1])` THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; + VECTOR_DERIVATIVE_LINEPATH_WITHIN] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH; path_image] THEN + ASM SET_TAC[]);; + +let HAS_PATH_INTEGRAL_BOUND_LINEPATH_STRONG = prove + (`!f i a b B k. + FINITE k /\ + (f has_path_integral i) (linepath(a,b)) /\ + &0 <= B /\ (!x. x IN segment[a,b] DIFF k ==> norm(f x) <= B) + ==> norm(i) <= B * norm(b - a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:complex = a` THENL + [ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO] THEN + STRIP_TAC THEN SUBGOAL_THEN `i = Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_NORM_0; REAL_LE_REFL]) THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_UNIQUE THEN + ASM_MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL]; + STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\x. if x IN k then Cx(&0) else (f:complex->complex) x` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM SET_TAC[COMPLEX_NORM_0]] THEN + UNDISCH_TAC `(f has_path_integral i) (linepath (a,b))` THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[has_path_integral] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN + EXISTS_TAC `{t | t IN interval[vec 0,vec 1] /\ + linepath(a:complex,b) t IN k}` THEN + CONJ_TAC THENL [MATCH_MP_TAC NEGLIGIBLE_FINITE; SET_TAC[]] THEN + MATCH_MP_TAC FINITE_FINITE_PREIMAGE_GENERAL THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `c:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET] + `(?a. s SUBSET {a}) ==> FINITE s`) THEN + MATCH_MP_TAC(SET_RULE + `(!a b. a IN s /\ b IN s ==> a = b) ==> (?a. s SUBSET {a})`) THEN + MAP_EVERY X_GEN_TAC [`s:real^1`; `t:real^1`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[linepath; VECTOR_ARITH + `(&1 - s) % a + s % b:real^N = (&1 - t) % a + t % b <=> + (s - t) % (b - a) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0] THEN + REWRITE_TAC[DROP_EQ]]);; + +let HAS_PATH_INTEGRAL_0 = prove + (`!g. ((\x. Cx(&0)) has_path_integral Cx(&0)) g`, + REWRITE_TAC[has_path_integral; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0]);; + +let HAS_PATH_INTEGRAL_IS_0 = prove + (`!f g. (!z. z IN path_image g ==> f(z) = Cx(&0)) + ==> (f has_path_integral Cx(&0)) g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_EQ THEN + EXISTS_TAC `\z:complex. Cx(&0)` THEN + ASM_REWRITE_TAC[HAS_PATH_INTEGRAL_0] THEN ASM_MESON_TAC[]);; + +let HAS_PATH_INTEGRAL_VSUM = prove + (`!f p s. FINITE s /\ (!a. a IN s ==> (f a has_path_integral i a) p) + ==> ((\x. vsum s (\a. f a x)) has_path_integral vsum s i) p`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; HAS_PATH_INTEGRAL_0; COMPLEX_VEC_0; IN_INSERT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN + ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing non-relationally. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRAL_CONST_LINEPATH = prove + (`!a b c. path_integral (linepath(a,b)) (\x. c) = c * (b - a)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + REWRITE_TAC[HAS_PATH_INTEGRAL_CONST_LINEPATH]);; + +let PATH_INTEGRAL_NEG = prove + (`!f g. f path_integrable_on g + ==> path_integral g (\x. --(f x)) = --(path_integral g f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_NEG THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRAL_ADD = prove + (`!f1 f2 g. + f1 path_integrable_on g /\ f2 path_integrable_on g + ==> path_integral g (\x. f1(x) + f2(x)) = + path_integral g f1 + path_integral g f2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRAL_SUB = prove + (`!f1 f2 g. + f1 path_integrable_on g /\ f2 path_integrable_on g + ==> path_integral g (\x. f1(x) - f2(x)) = + path_integral g f1 - path_integral g f2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRAL_COMPLEX_LMUL = prove + (`!f g c. f path_integrable_on g + ==> path_integral g (\x. c * f x) = c * path_integral g f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_LMUL THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRAL_COMPLEX_RMUL = prove + (`!f g c. f path_integrable_on g + ==> path_integral g (\x. f x * c) = path_integral g f * c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_RMUL THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRAL_COMPLEX_DIV = prove + (`!f g c. f path_integrable_on g + ==> path_integral g (\x. f x / c) = path_integral g f / c`, + REWRITE_TAC[complex_div; PATH_INTEGRAL_COMPLEX_RMUL]);; + +let PATH_INTEGRAL_EQ = prove + (`!f g p. + (!x. x IN path_image p ==> f x = g x) + ==> path_integral p f = path_integral p g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[path_integral] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + ASM_MESON_TAC[HAS_PATH_INTEGRAL_EQ]);; + +let PATH_INTEGRAL_EQ_0 = prove + (`!f g. (!z. z IN path_image g ==> f(z) = Cx(&0)) + ==> path_integral g f = Cx(&0)`, + MESON_TAC[HAS_PATH_INTEGRAL_IS_0; PATH_INTEGRAL_UNIQUE]);; + +let PATH_INTEGRAL_BOUND_LINEPATH = prove + (`!f a b. + f path_integrable_on (linepath(a,b)) /\ + &0 <= B /\ (!x. x IN segment[a,b] ==> norm(f x) <= B) + ==> norm(path_integral (linepath(a,b)) f) <= B * norm(b - a)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `f:complex->complex` THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRAL_0 = prove + (`!g. path_integral g (\x. Cx(&0)) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + REWRITE_TAC[HAS_PATH_INTEGRAL_0]);; + +let PATH_INTEGRAL_VSUM = prove + (`!f p s. FINITE s /\ (!a. a IN s ==> (f a) path_integrable_on p) + ==> path_integral p (\x. vsum s (\a. f a x)) = + vsum s (\a. path_integral p (f a))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_VSUM THEN + ASM_SIMP_TAC[HAS_PATH_INTEGRAL_INTEGRAL]);; + +let PATH_INTEGRABLE_EQ = prove + (`!f g p. (!x. x IN path_image p ==> f x = g x) /\ f path_integrable_on p + ==> g path_integrable_on p`, + REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic theorems for path integrability. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRABLE_NEG = prove + (`!f g. f path_integrable_on g + ==> (\x. --(f x)) path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_NEG]);; + +let PATH_INTEGRABLE_ADD = prove + (`!f1 f2 g. + f1 path_integrable_on g /\ f2 path_integrable_on g + ==> (\x. f1(x) + f2(x)) path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_ADD]);; + +let PATH_INTEGRABLE_SUB = prove + (`!f1 f2 g. + f1 path_integrable_on g /\ f2 path_integrable_on g + ==> (\x. f1(x) - f2(x)) path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN MESON_TAC[HAS_PATH_INTEGRAL_SUB]);; + +let PATH_INTEGRABLE_COMPLEX_LMUL = prove + (`!f g c. f path_integrable_on g + ==> (\x. c * f x) path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN + MESON_TAC[HAS_PATH_INTEGRAL_COMPLEX_LMUL]);; + +let PATH_INTEGRABLE_COMPLEX_RMUL = prove + (`!f g c. f path_integrable_on g + ==> (\x. f x * c) path_integrable_on g`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[PATH_INTEGRABLE_COMPLEX_LMUL]);; + +let PATH_INTEGRABLE_COMPLEX_DIV = prove + (`!f g c. f path_integrable_on g + ==> (\x. f x / c) path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN + MESON_TAC[HAS_PATH_INTEGRAL_COMPLEX_DIV]);; + +let PATH_INTEGRABLE_VSUM = prove + (`!f g s. FINITE s /\ (!a. a IN s ==> f a path_integrable_on g) + ==> (\x. vsum s (\a. f a x)) path_integrable_on g`, + REWRITE_TAC[path_integrable_on] THEN + MESON_TAC[HAS_PATH_INTEGRAL_VSUM]);; + +(* ------------------------------------------------------------------------- *) +(* Considering a path integral "backwards". *) +(* ------------------------------------------------------------------------- *) + +let HAS_PATH_INTEGRAL_REVERSE_LINEPATH = prove + (`!f a b i. + (f has_path_integral i) (linepath(a,b)) + ==> (f has_path_integral (--i)) (linepath(b,a))`, + MESON_TAC[REVERSEPATH_LINEPATH; VALID_PATH_LINEPATH; + HAS_PATH_INTEGRAL_REVERSEPATH]);; + +let PATH_INTEGRAL_REVERSE_LINEPATH = prove + (`!f a b. + f continuous_on (segment[a,b]) + ==> path_integral(linepath(a,b)) f = + --(path_integral(linepath(b,a)) f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_REVERSE_LINEPATH THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + ASM_MESON_TAC[SEGMENT_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Splitting a path integral in a flat way. *) +(* ------------------------------------------------------------------------- *) + +let HAS_PATH_INTEGRAL_SPLIT = prove + (`!f a b c i j k. + &0 <= k /\ k <= &1 /\ c - a = k % (b - a) /\ + (f has_path_integral i) (linepath(a,c)) /\ + (f has_path_integral j) (linepath(c,b)) + ==> (f has_path_integral (i + j)) (linepath(a,b))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `k = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_UNIQUE; + COMPLEX_ADD_LID]; + ALL_TAC] THEN + ASM_CASES_TAC `k = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THENL + [REWRITE_TAC[VECTOR_ARITH `c - a = b - a <=> c = b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HAS_PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_UNIQUE; + COMPLEX_ADD_RID]; + ALL_TAC] THEN + REWRITE_TAC[HAS_PATH_INTEGRAL_LINEPATH] THEN + REWRITE_TAC[linepath] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN + (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY))) THEN + DISCH_THEN(ASSUME_TAC o SPECL + [`inv(&1 - k):real`; `--(k / (&1 - k)) % vec 1:real^1`]) THEN + DISCH_THEN(MP_TAC o SPECL [`inv(k):real`; `vec 0:real^1`]) THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[REAL_INV_EQ_0; REAL_SUB_0] THEN + REWRITE_TAC[REAL_INV_INV; DIMINDEX_1; REAL_POW_1; REAL_ABS_INV] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REWRITE_TAC[REAL_SUB_LE; REAL_ARITH `~(&1 < &0)`] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_0; VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LNEG] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(k = &1) ==> (&1 - k) * --(k / (&1 - k)) = --k`] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LNEG; VECTOR_NEG_NEG; + VECTOR_ARITH `(&1 - k) % x + k % x:real^1 = x`] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; REAL_MUL_RID] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH + `c - a = x ==> c = x + a`)) THEN + REWRITE_TAC[VECTOR_ARITH `b - (k % (b - a) + a) = (&1 - k) % (b - a)`] THEN + SUBGOAL_THEN + `!x. (&1 - (inv (&1 - k) * drop x + --(k / (&1 - k)))) % (k % (b - a) + a) + + (inv (&1 - k) * drop x + --(k / (&1 - k))) % b = + (&1 - drop x) % a + drop x % b` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[VECTOR_ARITH + `x % (k % (b - a) + a) + y % b = + (x * (&1 - k)) % a + (y + x * k) % b`] THEN + GEN_TAC THEN BINOP_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. (&1 - inv k * drop x) % a + (inv k * drop x) % (k % (b - a) + a) = + (&1 - drop x) % a + drop x % b` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[VECTOR_ARITH + `x % a + y % (k % (b - a) + a) = + (x + y * (&1 - k)) % a + (y * k) % b`] THEN + GEN_TAC THEN BINOP_TAC THEN BINOP_TAC THEN REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `inv(k:real)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN + FIRST_ASSUM(MP_TAC o SPEC `inv(&1 - k)` o MATCH_MP HAS_INTEGRAL_CMUL) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= k ==> abs k = k`; + REAL_ARITH `k <= &1 ==> abs(&1 - k) = &1 - k`] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_SUB_0] THEN + REWRITE_TAC[IMP_IMP; VECTOR_MUL_LID] THEN + REWRITE_TAC[COMPLEX_CMUL] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `Cx(inv a) * b * Cx(a) * c = (Cx(inv a) * Cx a) * b * c`] THEN + ASM_SIMP_TAC[GSYM CX_MUL; REAL_MUL_LINV; REAL_SUB_0; COMPLEX_MUL_LID] THEN + STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN EXISTS_TAC `k % vec 1:real^1` THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID]);; + +let PATH_INTEGRAL_SPLIT = prove + (`!f a b c k. + &0 <= k /\ k <= &1 /\ c - a = k % (b - a) /\ + f continuous_on (segment[a,b]) + ==> path_integral(linepath(a,b)) f = + path_integral(linepath(a,c)) f + + path_integral(linepath(c,b)) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_SPLIT THEN + MAP_EVERY EXISTS_TAC [`c:complex`; `k:real`] THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `segment[a:complex,b]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[POINTS_IN_CONVEX_HULL; IN_INSERT] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH + `c - a = k % (b - a) ==> c = (&1 - k) % a + k % b`)) THEN + MATCH_MP_TAC IN_CONVEX_SET THEN + ASM_SIMP_TAC[CONVEX_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]);; + +let PATH_INTEGRAL_SPLIT_LINEPATH = prove + (`!f a b c. + f continuous_on segment[a,b] /\ c IN segment[a,b] + ==> path_integral(linepath (a,b)) f = + path_integral(linepath (a,c)) f + + path_integral(linepath (c,b)) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_SPLIT THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The special case of midpoints used in the main quadrisection. *) +(* ------------------------------------------------------------------------- *) + +let HAS_PATH_INTEGRAL_MIDPOINT = prove + (`!f a b i j. + (f has_path_integral i) (linepath(a,midpoint(a,b))) /\ + (f has_path_integral j) (linepath(midpoint(a,b),b)) + ==> (f has_path_integral (i + j)) (linepath(a,b))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_SPLIT THEN + MAP_EVERY EXISTS_TAC [`midpoint(a:complex,b)`; `&1 / &2`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);; + +let PATH_INTEGRAL_MIDPOINT = prove + (`!f a b. + f continuous_on (segment[a,b]) + ==> path_integral(linepath(a,b)) f = + path_integral(linepath(a,midpoint(a,b))) f + + path_integral(linepath(midpoint(a,b),b)) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_SPLIT THEN + EXISTS_TAC `&1 / &2` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A couple of special case lemmas that are useful below. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL = prove + (`!a b c m d. ((\x. m * x + d) has_path_integral Cx(&0)) + (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_PRIMITIVE THEN + MAP_EVERY EXISTS_TAC [`\x. m / Cx(&2) * x pow 2 + d * x`; `(:complex)`] THEN + SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; SUBSET_UNIV; + PATHFINISH_LINEPATH; VALID_PATH_JOIN; VALID_PATH_LINEPATH] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC COMPLEX_RING);; + +let HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL = prove + (`!f i a b c d. + (f has_path_integral i) + (linepath(a,b) ++ linepath(b,c) ++ linepath(c,d)) + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,d)) f = i`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE) THEN + SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_LINEPATH; VALID_PATH_JOIN; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + REPEAT(MATCH_MP_TAC HAS_PATH_INTEGRAL_JOIN THEN + SIMP_TAC[VALID_PATH_LINEPATH; VALID_PATH_JOIN; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + CONJ_TAC) THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Reversing the order in a double path integral. The condition is *) +(* stronger than needed but it's often true in typical situations. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRAL_SWAP = prove + (`!f g h. + (\y. f (fstcart y) (sndcart y)) continuous_on + (path_image g PCROSS path_image h) /\ + valid_path g /\ valid_path h /\ + (\t. vector_derivative g (at t)) continuous_on interval[vec 0,vec 1] /\ + (\t. vector_derivative h (at t)) continuous_on interval[vec 0,vec 1] + ==> path_integral g (\w. path_integral h (f w)) = + path_integral h (\z. path_integral g (\w. f w z))`, + REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[PATH_INTEGRAL_INTEGRAL] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `integral (interval[vec 0,vec 1]) + (\x. path_integral h + (\y. f (g x) y * vector_derivative g (at x)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN + DISCH_TAC THEN REWRITE_TAC[] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_COMPLEX_RMUL THEN + REWRITE_TAC[PATH_INTEGRABLE_ON] THEN + MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\t:real^1. (f:complex->complex->complex) (g x) (h t)) = + (\y. f (fstcart y) (sndcart y)) o + (\t. pastecart (g(x:real^1)) (h t))` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST; GSYM path; VALID_PATH_IMP_PATH]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN + ASM_SIMP_TAC[path_image; FUN_IN_IMAGE]]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `integral (interval[vec 0,vec 1]) + (\y. path_integral g + (\x. f x (h y) * vector_derivative h (at y)))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `y:real^1` THEN + DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC PATH_INTEGRAL_COMPLEX_RMUL THEN + REWRITE_TAC[PATH_INTEGRABLE_ON] THEN + MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\t:real^1. (f:complex->complex->complex) (g t) (h y)) = + (\z. f (fstcart z) (sndcart z)) o + (\t. pastecart (g t) (h(y:real^1)))` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST; GSYM path; VALID_PATH_IMP_PATH]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN + ASM_SIMP_TAC[path_image; FUN_IN_IMAGE]]] THEN + REWRITE_TAC[PATH_INTEGRAL_INTEGRAL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + INTEGRAL_SWAP_CONTINUOUS o lhs o snd) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + REPEAT(MATCH_MP_TAC INTEGRAL_EQ THEN + REWRITE_TAC[] THEN REPEAT STRIP_TAC) THEN + REWRITE_TAC[COMPLEX_MUL_AC]] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC) THENL + [ALL_TAC; + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. vector_derivative g (at (fstcart z))) = + (\t. vector_derivative (g:real^1->complex) (at t)) o fstcart` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; PCROSS; + FORALL_PASTECART; GSYM PCROSS_INTERVAL; FSTCART_PASTECART]; + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. vector_derivative h (at (sndcart z))) = + (\t. vector_derivative (h:real^1->complex) (at t)) o sndcart` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; PCROSS; + FORALL_PASTECART; GSYM PCROSS_INTERVAL; SNDCART_PASTECART]] THEN + SUBGOAL_THEN + `(\z. f (g (fstcart z)) (h (sndcart z))) = + (\y. (f:complex->complex->complex) (fstcart y) (sndcart y)) o + (\p. pastecart (g(fstcart p:real^1)) (h(sndcart p:real^1)))` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + REWRITE_TAC[GSYM PCROSS_INTERVAL; PCROSS; GSYM SIMPLE_IMAGE] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; + SET_RULE `{f x | x IN {g a b | P a /\ Q b}} = + {f(g a b) | P a /\ Q b}`] THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o REWRITE_RULE[path] o + MATCH_MP VALID_PATH_IMP_PATH)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_GSPEC]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; + FORALL_PASTECART; GSYM PCROSS_INTERVAL; PCROSS; + path_image; FSTCART_PASTECART; SNDCART_PASTECART] THEN + SIMP_TAC[FUN_IN_IMAGE]]);; + +(* ------------------------------------------------------------------------- *) +(* The key quadrisection step. *) +(* ------------------------------------------------------------------------- *) + +let NORM_SUM_LEMMA = prove + (`norm(a + b + c + d:complex) >= e + ==> norm(a) >= e / &4 \/ + norm(b) >= e / &4 \/ + norm(c) >= e / &4 \/ + norm(d) >= e / &4`, + NORM_ARITH_TAC);; + +let CAUCHY_THEOREM_QUADRISECTION = prove + (`!f a b c e K. + f continuous_on (convex hull {a,b,c}) /\ + dist (a,b) <= K /\ + dist (b,c) <= K /\ + dist (c,a) <= K /\ + norm(path_integral(linepath(a,b)) f + + path_integral(linepath(b,c)) f + + path_integral(linepath(c,a)) f) >= e * K pow 2 + ==> ?a' b' c'. a' IN convex hull {a,b,c} /\ + b' IN convex hull {a,b,c} /\ + c' IN convex hull {a,b,c} /\ + dist(a',b') <= K / &2 /\ + dist(b',c') <= K / &2 /\ + dist(c',a') <= K / &2 /\ + norm(path_integral(linepath(a',b')) f + + path_integral(linepath(b',c')) f + + path_integral(linepath(c',a')) f) + >= e * (K / &2) pow 2`, + REPEAT STRIP_TAC THEN MAP_EVERY ABBREV_TAC + [`a':complex = midpoint(b,c)`; + `b':complex = midpoint(c,a)`; + `c':complex = midpoint(a,b)`] THEN + SUBGOAL_THEN + `path_integral(linepath(a,b)) f + + path_integral(linepath(b,c)) f + + path_integral(linepath(c,a)) f = + (path_integral(linepath(a,c')) f + + path_integral(linepath(c',b')) f + + path_integral(linepath(b',a)) f) + + (path_integral(linepath(a',c')) f + + path_integral(linepath(c',b)) f + + path_integral(linepath(b,a')) f) + + (path_integral(linepath(a',c)) f + + path_integral(linepath(c,b')) f + + path_integral(linepath(b',a')) f) + + (path_integral(linepath(a',b')) f + + path_integral(linepath(b',c')) f + + path_integral(linepath(c',a')) f)` + SUBST_ALL_TAC THENL + [MP_TAC(SPEC `f:complex->complex` PATH_INTEGRAL_MIDPOINT) THEN DISCH_THEN + (fun th -> MP_TAC(SPECL [`a:complex`; `b:complex`] th) THEN + MP_TAC(SPECL [`b:complex`; `c:complex`] th) THEN + MP_TAC(SPECL [`c:complex`; `a:complex`] th)) THEN + MP_TAC(SPEC `f:complex->complex` PATH_INTEGRAL_REVERSE_LINEPATH) THEN DISCH_THEN + (fun th -> MP_TAC(SPECL [`a':complex`; `b':complex`] th) THEN + MP_TAC(SPECL [`b':complex`; `c':complex`] th) THEN + MP_TAC(SPECL [`c':complex`; `a':complex`] th)) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC(TAUT + `((a /\ c ==> b /\ d) ==> e) ==> (a ==> b) ==> (c ==> d) ==> e`)) THEN + ANTS_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + SIMP_TAC[IN_INSERT; NOT_IN_EMPTY; + TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + MAP_EVERY EXPAND_TAC ["a'"; "b'"; "c'"] THEN + SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `e * (K / &2) pow 2 = (e * K pow 2) / &4`] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP NORM_SUM_LEMMA) THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:complex`; `c':complex`; `b':complex`]; + MAP_EVERY EXISTS_TAC [`a':complex`; `c':complex`; `b:complex`]; + MAP_EVERY EXISTS_TAC [`a':complex`; `c:complex`; `b':complex`]; + MAP_EVERY EXISTS_TAC [`a':complex`; `b':complex`; `c':complex`]] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["a'"; "b'"; "c'"] THEN + SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT] THEN + REWRITE_TAC[midpoint; dist; GSYM VECTOR_SUB_LDISTRIB; + VECTOR_ARITH `a - inv(&2) % (a + b) = inv(&2) % (a - b)`; + VECTOR_ARITH `inv(&2) % (c + a) - a = inv(&2) % (c - a)`; + VECTOR_ARITH `(a + b) - (c + a) = b - c`; + VECTOR_ARITH `(b + c) - (c + a) = b - a`] THEN + SIMP_TAC[NORM_MUL; REAL_ARITH `abs(inv(&2)) * x <= k / &2 <=> x <= k`] THEN + ASM_REWRITE_TAC[GSYM dist] THEN ASM_MESON_TAC[DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Yet at small enough scales this cannot be the case. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_POINTS_CLOSER = prove + (`!a b c x y:real^N. + x IN convex hull {a,b,c} /\ + y IN convex hull {a,b,c} + ==> norm(x - y) <= norm(a - b) \/ + norm(x - y) <= norm(b - c) \/ + norm(x - y) <= norm(c - a)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `{a:real^N,b,c}` SIMPLEX_EXTREMAL_LE) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_LE_TRANS; NORM_SUB]);; + +let HOLOMORPHIC_POINT_SMALL_TRIANGLE = prove + (`!f s x e. + x IN s /\ f continuous_on s /\ + f complex_differentiable (at x within s) /\ + &0 < e + ==> ?k. &0 < k /\ + !a b c. dist(a,b) <= k /\ dist(b,c) <= k /\ dist(c,a) <= k /\ + x IN convex hull {a,b,c} /\ convex hull {a,b,c} SUBSET s + ==> norm(path_integral(linepath(a,b)) f + + path_integral(linepath(b,c)) f + + path_integral(linepath(c,a)) f) + <= e * (dist(a,b) + dist(b,c) + dist(c,a)) pow 2`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [complex_differentiable]) THEN + DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [has_complex_derivative] THEN + REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN + DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [TAUT `a /\ b ==> c <=> b ==> a ==> c`] THEN + REWRITE_TAC[APPROACHABLE_LT_LE] THEN + ONCE_REWRITE_TAC[TAUT `b ==> a ==> c <=> a /\ b ==> c`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[dist] THEN + MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`; `c:complex`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = + path_integral (linepath(a,b)) (\y. f y - f x - f' * (y - x)) + + path_integral (linepath(b,c)) (\y. f y - f x - f' * (y - x)) + + path_integral (linepath(c,a)) (\y. f y - f x - f' * (y - x))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `path_integral (linepath(a,b)) (\y. f y - f x - f' * (y - x)) = + path_integral (linepath(a,b)) f - + path_integral (linepath(a,b)) (\y. f x + f' * (y - x)) /\ + path_integral (linepath(b,c)) (\y. f y - f x - f' * (y - x)) = + path_integral (linepath(b,c)) f - + path_integral (linepath(b,c)) (\y. f x + f' * (y - x)) /\ + path_integral (linepath(c,a)) (\y. f y - f x - f' * (y - x)) = + path_integral (linepath(c,a)) f - + path_integral (linepath(c,a)) (\y. f x + f' * (y - x))` + (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL + [REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a - b - c = a - (b + c)`] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_COMPLEX_MUL; CONTINUOUS_ON_SUB] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_RING + `x + y + z = (x - x') + (y - y') + (z - z') <=> + x' + y' + z' = Cx(&0)`] THEN + MP_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`; + `f':complex`; `f x - f' * x`] + TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL) THEN + REWRITE_TAC[COMPLEX_RING + `f' * x' + f x - f' * x = f x + f' * (x' - x)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x * y /\ &0 <= x * z /\ &0 <= y * z /\ + a <= (e * (x + y + z)) * x + + (e * (x + y + z)) * y + + (e * (x + y + z)) * z + ==> a <= e * (x + y + z) pow 2`) THEN + SIMP_TAC[REAL_LE_MUL; NORM_POS_LE] THEN + REPEAT(MATCH_MP_TAC NORM_TRIANGLE_LE THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN + (MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\y:complex. f y - f x - f' * (y - x)` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_LT_IMP_LE; NORM_POS_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; ETA_AX; CONTINUOUS_ON_COMPLEX_MUL; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; IN_INSERT]; + ALL_TAC] THEN + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e * norm(y - x:complex)` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE `!t. y IN t /\ t SUBSET s ==> y IN s`) THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(REAL_ARITH + `!n1 n2 n3. n1 <= d /\ n2 <= d /\ n3 <= d /\ + (n <= n1 \/ n <= n2 \/ n <= n3) + ==> n <= d`) THEN + MAP_EVERY EXISTS_TAC + [`norm(a - b:complex)`; `norm(b - c:complex)`; + `norm(c - a:complex)`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TRIANGLE_POINTS_CLOSER]; + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `(x <= a \/ x <= b \/ x <= c) /\ (&0 <= a /\ &0 <= b /\ &0 <= c) + ==> x <= a + b + c`) THEN + REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC TRIANGLE_POINTS_CLOSER THEN + ASM_REWRITE_TAC[]] THEN + REPEAT CONJ_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MIDPOINTS_IN_CONVEX_HULL; POINTS_IN_CONVEX_HULL; + IN_INSERT]));; + +(* ------------------------------------------------------------------------- *) +(* Hence the most basic theorem for a triangle. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_THEOREM_TRIANGLE = prove + (`!f a b c. + f holomorphic_on (convex hull {a,b,c}) + ==> (f has_path_integral Cx(&0)) + (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))`, + let lemma1 = prove + (`!P Q abc. + P abc 0 /\ + (!abc:A n. P abc n ==> ?abc'. P abc' (SUC n) /\ Q abc' abc) + ==> ?ABC. ABC 0 = abc /\ !n. P (ABC n) n /\ Q (ABC(SUC n)) (ABC n)`, + REPEAT STRIP_TAC THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `ABC 0 = abc:A /\ + !n. ABC(SUC n) = @abc. P abc (SUC n) /\ Q abc (ABC n)` THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + STRIP_TAC THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]) in + let lemma3 = prove + (`!P Q a:A b:A c:A. + P a b c 0 /\ + (!a b c n. P a b c n + ==> ?a' b' c'. P a' b' c' (SUC n) /\ Q a' b' c' a b c) + ==> ?A B C. A 0 = a /\ B 0 = b /\ C 0 = c /\ + !n. P (A n) (B n) (C n) n /\ + Q (A(SUC n)) (B(SUC n)) (C(SUC n)) (A n) (B n) (C n)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\(a,b,c). (P:A->A->A->num->bool) a b c`; + `\(a,b,c) (a',b',c'). (Q:A->A->A->A->A->A->bool) a b c a' b' c'`; + `(a:A,b:A,c:A)`] + lemma1) THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `ABC:num->A#A#A` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC + [`(\(a,b,c). a) o (ABC:num->A#A#A)`; + `(\(a,b,c). b) o (ABC:num->A#A#A)`; + `(\(a,b,c). c) o (ABC:num->A#A#A)`] THEN + REWRITE_TAC[o_THM] THEN + REPEAT(CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]) THEN + X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + SPEC_TAC(`(ABC:num->A#A#A) (SUC n)`,`y:A#A#A`) THEN + SPEC_TAC(`(ABC:num->A#A#A) n`,`x:A#A#A`) THEN + REWRITE_TAC[FORALL_PAIR_THM]) in + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] + SEGMENTS_SUBSET_CONVEX_HULL) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN + SUBGOAL_THEN + `f path_integrable_on (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))` + MP_TAC THENL + [SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; VALID_PATH_LINEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + ASM_MESON_TAC[PATH_INTEGRABLE_CONTINUOUS_LINEPATH; CONTINUOUS_ON_SUBSET]; + ALL_TAC] THEN + SIMP_TAC[path_integrable_on] THEN DISCH_THEN(X_CHOOSE_TAC `y:complex`) THEN + ASM_CASES_TAC `y = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ABBREV_TAC + `K = &1 + max (dist(a:complex,b)) (max (dist(b,c)) (dist(c,a)))` THEN + SUBGOAL_THEN `&0 < K` ASSUME_TAC THENL + [EXPAND_TAC "K" THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN + REWRITE_TAC[REAL_LE_MAX; DIST_POS_LE]; + ALL_TAC] THEN + ABBREV_TAC `e = norm(y:complex) / K pow 2` THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [EXPAND_TAC "e" THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; COMPLEX_NORM_NZ]; + ALL_TAC] THEN + SUBGOAL_THEN + `?A B C. A 0 = a /\ B 0 = b /\ C 0 = c /\ + !n. (convex hull {A n,B n,C n} SUBSET convex hull {a,b,c} /\ + dist(A n,B n) <= K / &2 pow n /\ + dist(B n,C n) <= K / &2 pow n /\ + dist(C n,A n) <= K / &2 pow n /\ + norm(path_integral(linepath (A n,B n)) f + + path_integral(linepath (B n,C n)) f + + path_integral(linepath (C n,A n)) f) >= + e * (K / &2 pow n) pow 2) /\ + convex hull {A(SUC n),B(SUC n),C(SUC n)} SUBSET + convex hull {A n,B n,C n}` + MP_TAC THENL + [MATCH_MP_TAC lemma3 THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[real_pow; REAL_DIV_1; CONJ_ASSOC; SUBSET_REFL] THEN + CONJ_TAC THENL [EXPAND_TAC "K" THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXPAND_TAC "e" THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_POW_LT] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x >= y`) THEN AP_TERM_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o + MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC + [`a':complex`; `b':complex`; `c':complex`; `n:num`] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `a':complex`; `b':complex`; + `c':complex`; `e:real`; `K / &2 pow n`] + CAUCHY_THEOREM_QUADRISECTION) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[real_pow; REAL_FIELD `x / (&2 * y) = x / y / &2`] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ t SUBSET u ==> s SUBSET u /\ s SUBSET t`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `?x:complex. !n:num. x IN convex hull {A n,B n,C n}` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC BOUNDED_CLOSED_NEST THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC COMPACT_IMP_CLOSED; + REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY]; + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; + MATCH_MP_TAC COMPACT_IMP_BOUNDED] THEN + MATCH_MP_TAC FINITE_IMP_COMPACT_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:complex->complex`; `convex hull {a:complex,b,c}`; + `x:complex`; `e / &10`] HOLOMORPHIC_POINT_SMALL_TRIANGLE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; complex_differentiable] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + ASM_MESON_TAC[holomorphic_on; SUBSET]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `K:real / k` REAL_ARCH_POW2) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`(A:num->complex) n`; `(B:num->complex) n`; `(C:num->complex) n`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[REAL_NOT_LE] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e * (K / &2 pow n) pow 2` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[GSYM real_ge]] THEN + ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ y <= &9 * x ==> inv(&10) * y < x`) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_MUL; REAL_LT_INV_EQ; + REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_ARITH `&9 * x pow 2 = (&3 * x) pow 2`] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + SIMP_TAC[REAL_LE_ADD; DIST_POS_LE; GSYM real_div] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= a /\ y <= a /\ z <= a ==> x + y + z <= &3 * a`) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Version needing function holomorphic in interior only. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_THEOREM_FLAT_LEMMA = prove + (`!f a b c k. + f continuous_on convex hull {a,b,c} /\ c - a = k % (b - a) /\ &0 <= k + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)`, + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] + SEGMENTS_SUBSET_CONVEX_HULL) THEN + ASM_CASES_TAC `k <= &1` THENL + [MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `b:complex`; `c:complex`; + `k:real`] PATH_INTEGRAL_SPLIT) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(COMPLEX_RING + `x = --b /\ y = --a ==> (x + y) + (a + b) = Cx(&0)`) THEN + CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_REVERSE_LINEPATH THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `c:complex`; `b:complex`; + `inv k:real`] PATH_INTEGRAL_SPLIT) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LE_INV_EQ; REAL_MUL_LINV; REAL_INV_LE_1; + VECTOR_MUL_LID; REAL_ARITH `~(k <= &1) ==> ~(k = &0) /\ &1 <= k`] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(COMPLEX_RING + `ac = --ca ==> ac = ab + bc ==> ab + bc + ca = Cx(&0)`) THEN + MATCH_MP_TAC PATH_INTEGRAL_REVERSE_LINEPATH THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; + +let CAUCHY_THEOREM_FLAT = prove + (`!f a b c k. + f continuous_on convex hull {a,b,c} /\ c - a = k % (b - a) + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= k` THENL + [ASM_MESON_TAC[CAUCHY_THEOREM_FLAT_LEMMA]; ALL_TAC] THEN + STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] + SEGMENTS_SUBSET_CONVEX_HULL) THEN + MP_TAC(ISPECL [`f:complex->complex`; `b:complex`; `a:complex`; `c:complex`; + `&1 - k`] CAUCHY_THEOREM_FLAT_LEMMA) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[INSERT_AC; REAL_ARITH `~(&0 <= k) ==> &0 <= &1 - k`; + VECTOR_ARITH `b - a = k % (c - a) ==> (b - c) = (&1 - k) % (a - c)`]; + ALL_TAC] THEN + MATCH_MP_TAC(COMPLEX_RING + `ab = --ba /\ ac = --ca /\ bc = --cb + ==> ba + ac + cb = Cx(&0) ==> ab + bc + ca = Cx(&0)`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_REVERSE_LINEPATH THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]);; + +let CAUCHY_THEOREM_TRIANGLE_INTERIOR = prove + (`!f a b c. + f continuous_on (convex hull {a,b,c}) /\ + f holomorphic_on interior (convex hull {a,b,c}) + ==> (f has_path_integral Cx(&0)) + (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a))`, + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] + SEGMENTS_SUBSET_CONVEX_HULL) THEN + SUBGOAL_THEN + `?B. &0 < B /\ + !y. y IN IMAGE (f:complex->complex) (convex hull {a,b,c}) + ==> norm(y) <= B` + MP_TAC THENL + [REWRITE_TAC[GSYM BOUNDED_POS] THEN MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL; FINITE_INSERT; FINITE_RULES]; + REWRITE_TAC[FORALL_IN_IMAGE] THEN STRIP_TAC] THEN + SUBGOAL_THEN + `?C. &0 < C /\ !x:complex. x IN convex hull {a,b,c} ==> norm(x) <= C` + MP_TAC THENL + [REWRITE_TAC[GSYM BOUNDED_POS] THEN + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL; FINITE_INSERT; FINITE_RULES]; + STRIP_TAC] THEN + SUBGOAL_THEN + `(f:complex->complex) uniformly_continuous_on (convex hull {a,b,c})` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN + ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL; FINITE_RULES; FINITE_INSERT]; + ALL_TAC] THEN + REWRITE_TAC[uniformly_continuous_on] THEN DISCH_TAC THEN + SUBGOAL_THEN + `f path_integrable_on + (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))` + MP_TAC THENL + [SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; VALID_PATH_LINEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + ASM_MESON_TAC[PATH_INTEGRABLE_CONTINUOUS_LINEPATH; CONTINUOUS_ON_SUBSET]; + ALL_TAC] THEN + SIMP_TAC[path_integrable_on] THEN DISCH_THEN(X_CHOOSE_TAC `y:complex`) THEN + ASM_CASES_TAC `y = Cx(&0)` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `~(y = Cx(&0))` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP + HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `c:complex = a` THENL + [MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN + EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ]; + ALL_TAC] THEN + ASM_CASES_TAC `b:complex = c` THENL + [ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = c + a + b`] THEN + MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN + EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[INSERT_AC]; + ALL_TAC] THEN + ASM_CASES_TAC `a:complex = b` THENL + [ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = b + c + a`] THEN + MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN + EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[INSERT_AC]; + ALL_TAC] THEN + ASM_CASES_TAC `interior(convex hull {a:complex,b,c}) = {}` THENL + [MATCH_MP_TAC CAUCHY_THEOREM_FLAT THEN + SUBGOAL_THEN `{a:complex,b,c} HAS_SIZE (dimindex(:2) + 1)` + MP_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH; IN_INSERT; NOT_IN_EMPTY]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTERIOR_CONVEX_HULL_EQ_EMPTY) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `collinear{a:complex,b,c}` MP_TAC THENL + [ASM_REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + ASM_REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `d:complex`) THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN + DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `y = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `norm(y:complex) / &24 / C`) THEN + SUBGOAL_THEN `&0 < norm(y:complex) / &24 / C` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_POS_LE; REAL_LTE_ADD; + COMPLEX_NORM_NZ; COMPLEX_SUB_0]; + ASM_REWRITE_TAC[dist]] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN ABBREV_TAC + `e = min (&1) + (min (d1 / (&4 * C)) + ((norm(y:complex) / &24 / C) / B))` THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [EXPAND_TAC "e" THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_MIN; REAL_LT_DIV; COMPLEX_NORM_NZ; + REAL_LT_MUL; REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + ABBREV_TAC `shrink = \x:complex. x - e % (x - d)` THEN + SUBGOAL_THEN `shrink (a:complex) IN interior(convex hull {a,b,c}) /\ + shrink b IN interior(convex hull {a,b,c}) /\ + shrink c IN interior(convex hull {a,b,c})` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN EXPAND_TAC "shrink" THEN + MATCH_MP_TAC IN_INTERIOR_CONVEX_SHRINK THEN + ASM_REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + (CONJ_TAC THENL [ALL_TAC; EXPAND_TAC "e" THEN REAL_ARITH_TAC]) THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + REWRITE_TAC[IN_INSERT]; + ALL_TAC] THEN + SUBGOAL_THEN + `norm((path_integral(linepath(shrink a,shrink b)) f - + path_integral(linepath(a,b)) f) + + (path_integral(linepath(shrink b,shrink c)) f - + path_integral(linepath(b,c)) f) + + (path_integral(linepath(shrink c,shrink a)) f - + path_integral(linepath(c,a)) f)) <= norm(y:complex) / &2` + MP_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[COMPLEX_RING + `(ab' - ab) + (bc' - bc) + (ca' - ca) = + (ab' + bc' + ca') - (ab + bc + ca)`] THEN + SUBGOAL_THEN + `(f has_path_integral (Cx(&0))) + (linepath (shrink a,shrink b) ++ + linepath (shrink b,shrink c) ++ + linepath (shrink c,shrink (a:complex)))` + MP_TAC THENL + [MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `interior(convex hull {a:complex,b,c})` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[CONVEX_INTERIOR; CONVEX_CONVEX_HULL] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL) THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ ~(y = &0) ==> ~(y <= y / &2)`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; NORM_POS_LE]] THEN + SUBGOAL_THEN + `!x y. x IN convex hull {a,b,c} /\ y IN convex hull {a,b,c} + ==> norm(x - y) <= &2 * C` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MUL_2; VECTOR_SUB] THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `x / &2 = x / &6 + x / &6 + x / &6`] THEN + REPEAT(MATCH_MP_TAC NORM_TRIANGLE_LE THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM CONTENT_UNIT_1] THEN + MATCH_MP_TAC HAS_INTEGRAL_BOUND THENL + [EXISTS_TAC `\x. f(linepath(shrink a,shrink b) x) * + (shrink b - shrink a) - + f(linepath(a,b) x) * (b - a)`; + EXISTS_TAC `\x. f(linepath(shrink b,shrink c) x) * + (shrink c - shrink b) - + f(linepath(b,c) x) * (c - b)`; + EXISTS_TAC `\x. f(linepath(shrink c,shrink a) x) * + (shrink a - shrink c) - + f(linepath(c,a) x) * (a - c)`] THEN + ASM_SIMP_TAC[COMPLEX_NORM_NZ; REAL_ARITH `&0 < x ==> &0 <= x / &6`] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_SUB THEN + REWRITE_TAC[GSYM HAS_PATH_INTEGRAL_LINEPATH] THEN + CONJ_TAC THEN MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `f' * x' - f * x = f' * (x' - x) + x * (f' - f):complex`] THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B * (norm(y:complex) / &24 / C / B) * &2 * C + + (&2 * C) * (norm y / &24 / C)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MAP_EVERY UNDISCH_TAC [`&0 < B`; `&0 < C`] THEN CONV_TAC REAL_FIELD] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THENL + [CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + W(fun (asl,w) -> + MP_TAC(PART_MATCH (lhand o rand) LINEPATH_IN_PATH (lhand w))) THEN + ASM_REWRITE_TAC[] THEN + W(fun (asl,w) -> SPEC_TAC(lhand(rand w),`x:complex`)) THEN + REWRITE_TAC[GSYM SUBSET; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + ALL_TAC] THEN + EXPAND_TAC "shrink" THEN + REWRITE_TAC[VECTOR_ARITH `(b - e % (b - d)) - (a - e % (a - d)) - + (b - a) = e % (a - b)`] THEN + REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 < x ==> abs x = x`; + REAL_ABS_POS] THEN + CONJ_TAC THENL [EXPAND_TAC "e" THEN REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + REWRITE_TAC[IN_INSERT]; + ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + REWRITE_TAC[IN_INSERT]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL + [W(fun (asl,w) -> + MP_TAC(PART_MATCH (lhand o rand) LINEPATH_IN_PATH (lhand w))) THEN + ASM_MESON_TAC[SUBSET]; + ALL_TAC] THEN + CONJ_TAC THENL + [W(fun (asl,w) -> + MP_TAC(PART_MATCH (lhand o rand) LINEPATH_IN_PATH (lhand w))) THEN + ASM_REWRITE_TAC[] THEN + W(fun (asl,w) -> SPEC_TAC(lhand(rand w),`x:complex`)) THEN + REWRITE_TAC[GSYM SUBSET; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONVEX_HULL; SUBSET; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[linepath] THEN REWRITE_TAC[VECTOR_ARITH + `((&1 - x) % a' + x % b') - ((&1 - x) % a + x % b) = + (&1 - x) % (a' - a) + x % (b' - b)`] THEN + EXPAND_TAC "shrink" THEN REWRITE_TAC[VECTOR_ARITH `a - b - a = --b`] THEN + MATCH_MP_TAC NORM_TRIANGLE_LT THEN REWRITE_TAC[NORM_MUL; NORM_NEG] THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d /\ e <=> (c /\ d /\ e) /\ a /\ b`] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e * &2 * C` THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < x ==> abs x = x`] THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET; HULL_SUBSET; IN_INSERT]; + ALL_TAC]) THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + EXPAND_TAC "e" THEN REWRITE_TAC[REAL_MIN_LT] THEN + DISJ2_TAC THEN DISJ1_TAC THEN + REWRITE_TAC[REAL_FIELD `d / (a * b) = inv(a:real) * d / b`] THEN + REWRITE_TAC[REAL_ARITH `inv(&4) * x < inv(&2) * x <=> &0 < x`] THEN + ASM_SIMP_TAC[REAL_LT_DIV]));; + +(* ------------------------------------------------------------------------- *) +(* Version allowing finite number of exceptional points. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_THEOREM_TRIANGLE_COFINITE = prove + (`!f s a b c. + f continuous_on (convex hull {a,b,c}) /\ + FINITE s /\ + (!x. x IN interior(convex hull {a,b,c}) DIFF s + ==> f complex_differentiable (at x)) + ==> (f has_path_integral Cx(&0)) + (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))`, + GEN_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `CARD(s:complex->bool)` THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:complex->bool = {}` THENL + [MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_INTERIOR THEN + ASM_REWRITE_TAC[holomorphic_on] THEN X_GEN_TAC `z:complex` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[complex_differentiable; IN_DIFF; NOT_IN_EMPTY] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `d:complex`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (d:complex)`) THEN + ASM_SIMP_TAC[CARD_DELETE; CARD_EQ_0; + ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + ASM_CASES_TAC `(d:complex) IN convex hull {a,b,c}` THENL + [ALL_TAC; + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DIFF; IN_DELETE] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]] THEN + DISCH_TAC THEN SUBGOAL_THEN + `(f has_path_integral Cx(&0)) + (linepath(a,b) ++ linepath(b,d) ++ linepath(d,a)) /\ + (f has_path_integral Cx(&0)) + (linepath(b,c) ++ linepath(c,d) ++ linepath(d,b)) /\ + (f has_path_integral Cx(&0)) + (linepath(c,a) ++ linepath(a,d) ++ linepath(d,c))` + MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[FINITE_DELETE] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + REWRITE_TAC[IN_INSERT]; + ALL_TAC]) THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DIFF; IN_DELETE] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + (ASM_CASES_TAC `x:complex = d` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[NOT_IN_INTERIOR_CONVEX_HULL_3]; ALL_TAC]) THEN + DISCH_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN interior s + ==> interior s SUBSET interior t ==> x IN interior t`)) THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN + MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + SIMP_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]; + ALL_TAC] THEN + SUBGOAL_THEN + `f path_integrable_on + (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))` + MP_TAC THENL + [SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN; VALID_PATH_LINEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + STRIP_ASSUME_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] + SEGMENTS_SUBSET_CONVEX_HULL) THEN + ASM_MESON_TAC[PATH_INTEGRABLE_CONTINUOUS_LINEPATH; CONTINUOUS_ON_SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:complex` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN + (MP_TAC o MATCH_MP HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL)) THEN + ASM_CASES_TAC `y = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; UNDISCH_TAC `~(y = Cx(&0))`] THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `(f:complex->complex) continuous_on segment[a,d] /\ + f continuous_on segment[b,d] /\ + f continuous_on segment[c,d]` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (MP_TAC o MATCH_MP + PATH_INTEGRAL_REVERSE_LINEPATH)) THEN + CONV_TAC COMPLEX_RING] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `convex hull {a:complex,b,c}` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC CONVEX_HULL_SUBSET THEN + SIMP_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN REWRITE_TAC[IN_INSERT]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of a primitive. *) +(* ------------------------------------------------------------------------- *) + +let STARLIKE_CONVEX_SUBSET = prove + (`!s a b c:real^N. + a IN s /\ segment[b,c] SUBSET s /\ + (!x. x IN s ==> segment[a,x] SUBSET s) + ==> convex hull {a,b,c} SUBSET s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{b:real^N,c}`; `a:real^N`] CONVEX_HULL_INSERT) THEN + REWRITE_TAC[NOT_INSERT_EMPTY] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real`; `v:real`; `d:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^N`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[SUBSET; SEGMENT_CONVEX_HULL]; + ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_2; IN_ELIM_THM] THEN + ASM_MESON_TAC[]]);; + +let TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE = prove + (`!f s a. + a IN s /\ open s /\ f continuous_on s /\ + (!z. z IN s ==> segment[a,z] SUBSET s) /\ + (!b c. segment[b,c] SUBSET s + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)) + ==> ?g. !z. z IN s ==> (g has_complex_derivative f(z)) (at z)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. path_integral (linepath(a,x)) f` THEN + X_GEN_TAC `x:complex` THEN STRIP_TAC THEN + REWRITE_TAC[has_complex_derivative] THEN + REWRITE_TAC[has_derivative_at; LINEAR_COMPLEX_MUL] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\y. inv(norm(y - x)) % (path_integral(linepath(x,y)) f - + f x * (y - x))` THEN + REWRITE_TAC[VECTOR_ARITH + `i % (x - a) - i % (y - (z + a)) = i % (x + z - y)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:complex` THEN REWRITE_TAC[dist] THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `y:complex`] + PATH_INTEGRAL_REVERSE_LINEPATH) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[NORM_SUB] dist]; + REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC(COMPLEX_RING + `ax + xy + ya = Cx(&0) ==> ay = --ya ==> xy + ax - ay = Cx(&0)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[dist; NORM_0; VECTOR_SUB_REFL] THEN + ASM_MESON_TAC[NORM_SUB]]; + REWRITE_TAC[LIM_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:complex->complex) continuous at x` MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_INTERIOR THEN ASM_MESON_TAC[INTERIOR_OPEN]; + ALL_TAC] THEN + REWRITE_TAC[continuous_at; dist; VECTOR_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `f path_integrable_on linepath(x,y)` MP_TAC THENL + [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(x:complex,d2)` THEN + CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[dist; NORM_0; VECTOR_SUB_REFL] THEN + ASM_MESON_TAC[NORM_SUB]; + ASM_REWRITE_TAC[SUBSET; IN_BALL; dist]]; + ALL_TAC] THEN + REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:complex` THEN + MP_TAC(SPECL [`x:complex`; `y:complex`; `(f:complex->complex) x`] + HAS_PATH_INTEGRAL_CONST_LINEPATH) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_NEG) THEN + REWRITE_TAC[COMPLEX_NEG_SUB] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN + ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\w. (f:complex->complex) w - f x` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e / &2`] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[REAL_LET_TRANS; SEGMENT_BOUND]]);; + +let HOLOMORPHIC_STARLIKE_PRIMITIVE = prove + (`!f s k. open s /\ starlike s /\ FINITE k /\ f continuous_on s /\ + (!x. x IN s DIFF k ==> f complex_differentiable at x) + ==> ?g. !x. x IN s ==> (g has_complex_derivative f(x)) (at x)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [starlike]) THEN + MATCH_MP_TAC TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE THEN + EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:complex`; `y:complex`] THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL THEN + MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_COFINITE THEN + EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `convex hull {a:complex,x,y} SUBSET s` ASSUME_TAC THENL + [MATCH_MP_TAC STARLIKE_CONVEX_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy's theorem for an open starlike set. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_THEOREM_STARLIKE = prove + (`!f s k g. open s /\ starlike s /\ FINITE k /\ f continuous_on s /\ + (!x. x IN s DIFF k ==> f complex_differentiable at x) /\ + valid_path g /\ (path_image g) SUBSET s /\ + pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) (g)`, + MESON_TAC[HOLOMORPHIC_STARLIKE_PRIMITIVE; CAUCHY_THEOREM_PRIMITIVE; + HAS_COMPLEX_DERIVATIVE_AT_WITHIN]);; + +let CAUCHY_THEOREM_STARLIKE_SIMPLE = prove + (`!f s g. open s /\ starlike s /\ f holomorphic_on s /\ + valid_path g /\ (path_image g) SUBSET s /\ + pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) (g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_STARLIKE THEN + MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; FINITE_RULES] THEN + REWRITE_TAC[IN_DIFF; NOT_IN_EMPTY; complex_differentiable] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; holomorphic_on]);; + +(* ------------------------------------------------------------------------- *) +(* For a convex set we can avoid assuming openness and boundary analyticity. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE = prove + (`!f s a. + a IN s /\ convex s /\ f continuous_on s /\ + (!b c. b IN s /\ c IN s + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)) + ==> ?g. !z. z IN s ==> (g has_complex_derivative f(z)) (at z within s)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. path_integral (linepath(a,x)) f` THEN + X_GEN_TAC `x:complex` THEN STRIP_TAC THEN + REWRITE_TAC[has_complex_derivative] THEN + REWRITE_TAC[has_derivative_within; LINEAR_COMPLEX_MUL] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\y. inv(norm(y - x)) % (path_integral(linepath(x,y)) f - + f x * (y - x))` THEN + REWRITE_TAC[VECTOR_ARITH + `i % (x - a) - i % (y - (z + a)) = i % (x + z - y)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_WITHIN] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `y:complex`] + PATH_INTEGRAL_REVERSE_LINEPATH) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; + REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC(COMPLEX_RING + `ax + xy + ya = Cx(&0) ==> ay = --ya ==> xy + ax - ay = Cx(&0)`) THEN + ASM_SIMP_TAC[]]; + REWRITE_TAC[LIM_WITHIN] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `(f:complex->complex) continuous (at x within s)` MP_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; ALL_TAC] THEN + REWRITE_TAC[continuous_within; dist; VECTOR_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d1:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `f path_integrable_on linepath(x,y)` MP_TAC THENL + [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:complex` THEN + MP_TAC(SPECL [`x:complex`; `y:complex`; `(f:complex->complex) x`] + HAS_PATH_INTEGRAL_CONST_LINEPATH) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_NEG) THEN + REWRITE_TAC[COMPLEX_NEG_SUB] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN + ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\w. (f:complex->complex) w - f x` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e / &2`] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `w IN t ==> t SUBSET s ==> w IN s`)) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; + ASM_MESON_TAC[REAL_LET_TRANS; SEGMENT_BOUND]]]);; + +let PATHINTEGRAL_CONVEX_PRIMITIVE = prove + (`!f s. convex s /\ f continuous_on s /\ + (!a b c. a IN s /\ b IN s /\ c IN s + ==> (f has_path_integral Cx(&0)) + (linepath (a,b) ++ linepath(b,c) ++ linepath(c,a))) + ==> ?g. !x. x IN s + ==> (g has_complex_derivative f(x)) (at x within s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE THEN + EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL THEN + ASM_SIMP_TAC[]);; + +let HOLOMORPHIC_CONVEX_PRIMITIVE = prove + (`!f s k. convex s /\ FINITE k /\ f continuous_on s /\ + (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) + ==> ?g. !x. x IN s + ==> (g has_complex_derivative f(x)) (at x within s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATHINTEGRAL_CONVEX_PRIMITIVE THEN + ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_COFINITE THEN + EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `w:complex` THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + SPEC_TAC(`w:complex`,`w:complex`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (s DIFF k) SUBSET (t DIFF k)`) THEN + MATCH_MP_TAC SUBSET_INTERIOR] THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let CAUCHY_THEOREM_CONVEX = prove + (`!f s k g. convex s /\ FINITE k /\ f continuous_on s /\ + (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) /\ + valid_path g /\ (path_image g) SUBSET s /\ + pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) (g)`, + MESON_TAC[HOLOMORPHIC_CONVEX_PRIMITIVE; CAUCHY_THEOREM_PRIMITIVE]);; + +let CAUCHY_THEOREM_CONVEX_SIMPLE = prove + (`!f s g. convex s /\ f holomorphic_on s /\ + valid_path g /\ (path_image g) SUBSET s /\ + pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) (g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX THEN + MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; FINITE_RULES] THEN + REWRITE_TAC[IN_DIFF; NOT_IN_EMPTY; complex_differentiable] THEN + SUBGOAL_THEN `f holomorphic_on (interior s)` MP_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN + MESON_TAC[holomorphic_on; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; + OPEN_INTERIOR]);; + +(* ------------------------------------------------------------------------- *) +(* In particular for a disc. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_THEOREM_DISC = prove + (`!f g k a e. + FINITE k /\ f continuous_on cball(a,e) /\ + (!x. x IN ball(a,e) DIFF k ==> f complex_differentiable at x) /\ + valid_path g /\ (path_image g) SUBSET cball(a,e) /\ + pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) (g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX THEN + MAP_EVERY EXISTS_TAC [`cball(a:complex,e)`; `k:complex->bool`] THEN + ASM_REWRITE_TAC[INTERIOR_CBALL; CONVEX_CBALL]);; + +let CAUCHY_THEOREM_DISC_SIMPLE = prove + (`!f g a e. + f holomorphic_on ball(a,e) /\ + valid_path g /\ (path_image g) SUBSET ball(a,e) /\ + pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) (g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_CONVEX_SIMPLE THEN + EXISTS_TAC `ball(a:complex,e)` THEN ASM_REWRITE_TAC[CONVEX_BALL; OPEN_BALL]);; + +(* ------------------------------------------------------------------------- *) +(* Generalize integrability to local primitives. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA = prove + (`!f f' g s a b. + (!x. x IN s ==> (f has_complex_derivative f' x) (at x within s)) /\ + g piecewise_differentiable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> g(x) IN s) + ==> (\x. f' (g x) * vector_derivative g (at x within interval[a,b])) + integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL + [ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY]; + REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `(f:complex->complex) (g(b:real^1)) - f(g a)` THEN + MATCH_MP_TAC PATH_INTEGRAL_PRIMITIVE_LEMMA THEN + ASM_MESON_TAC[]]);; + +let PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY = prove + (`!f g s a b. + (!x. x IN s + ==> ?d h. &0 < d /\ + !y. norm(y - x) < d + ==> (h has_complex_derivative f(y)) (at y within s)) /\ + g piecewise_differentiable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> g(x) IN s) + ==> (\x. f(g x) * vector_derivative g (at x)) integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_LITTLE_SUBINTERVALS THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^1->complex) x`) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:real`; `h:complex->complex`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP + PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON) THEN + REWRITE_TAC[continuous_on] THEN DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[integrable_on; GSYM HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN + REWRITE_TAC[GSYM integrable_on] THEN + MATCH_MP_TAC PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA THEN + MAP_EVERY EXISTS_TAC + [`h:complex->complex`; `IMAGE (g:real^1->complex) (interval[u,v])`] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[SUBSET; IN_BALL; DIST_SYM]; + ASM_MESON_TAC[PIECEWISE_DIFFERENTIABLE_ON_SUBSET]; + ASM SET_TAC[]]);; + +let PATH_INTEGRAL_LOCAL_PRIMITIVE = prove + (`!f g s. + (!x. x IN s + ==> ?d h. &0 < d /\ + !y. norm(y - x) < d + ==> (h has_complex_derivative f(y)) (at y within s)) /\ + valid_path g /\ (path_image g) SUBSET s + ==> f path_integrable_on g`, + REWRITE_TAC[valid_path; path_image; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[path_integrable_on; has_path_integral] THEN + REWRITE_TAC[HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN + REWRITE_TAC[GSYM integrable_on; PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY]);; + +(* ------------------------------------------------------------------------- *) +(* In particular if a function is holomorphic. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRABLE_HOLOMORPHIC = prove + (`!f g s k. + open s /\ FINITE k /\ + f continuous_on s /\ + (!x. x IN s DIFF k ==> f complex_differentiable at x) /\ + valid_path g /\ path_image g SUBSET s + ==> f path_integrable_on g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRAL_LOCAL_PRIMITIVE THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,d)`; + `k:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[CONVEX_BALL; DIFF_EMPTY] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + GEN_TAC THEN DISCH_THEN(fun th -> + FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + SIMP_TAC[IN_DIFF] THEN ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[IN_BALL; dist] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]]);; + +let PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE = prove + (`!f g s. open s /\ f holomorphic_on s /\ valid_path g /\ path_image g SUBSET s + ==> f path_integrable_on g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC THEN + MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; FINITE_RULES; DIFF_EMPTY] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable]);; + +(* ------------------------------------------------------------------------- *) +(* Key fact that path integral is the same for a "nearby" path. This is the *) +(* main lemma for the homotopy form of Cauchy's theorem and is also useful *) +(* if we want "without loss of generality" to assume some niceness of our *) +(* path (e.g. smoothness). It can also be used to define the integrals of *) +(* analytic functions over arbitrary continuous paths. This is just done for *) +(* winding numbers now; I'm not sure if it's worth going further with that. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRAL_NEARBY_ENDS,PATH_INTEGRAL_NEARBY_LOOP = (CONJ_PAIR o prove) + (`(!s p. + open s /\ path p /\ path_image p SUBSET s + ==> ?d. &0 < d /\ + !g h. valid_path g /\ valid_path h /\ + (!t. t IN interval[vec 0,vec 1] + ==> norm(g t - p t) < d /\ norm(h t - p t) < d) /\ + pathstart h = pathstart g /\ pathfinish h = pathfinish g + ==> path_image g SUBSET s /\ + path_image h SUBSET s /\ + !f. f holomorphic_on s + ==> path_integral h f = path_integral g f) /\ + (!s p. + open s /\ path p /\ path_image p SUBSET s + ==> ?d. &0 < d /\ + !g h. valid_path g /\ valid_path h /\ + (!t. t IN interval[vec 0,vec 1] + ==> norm(g t - p t) < d /\ norm(h t - p t) < d) /\ + pathfinish g = pathstart g /\ pathfinish h = pathstart h + ==> path_image g SUBSET s /\ + path_image h SUBSET s /\ + !f. f holomorphic_on s + ==> path_integral h f = path_integral g f)`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[]) + [`open(s:complex->bool)`; + `path(p:real^1->complex)`; + `path_image(p:real^1->complex) SUBSET s`] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN + MATCH_MP_TAC(MESON[] `(?x. P x /\ Q x) ==> (?x. P x) /\ (?x. Q x)`) THEN + SUBGOAL_THEN + `!z. z IN path_image p ==> ?e. &0 < e /\ ball(z:complex,e) SUBSET s` + MP_TAC THENL + [ASM_MESON_TAC[OPEN_CONTAINS_BALL; SUBSET]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; SKOLEM_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `ee:complex->real` THEN + DISCH_THEN(LABEL_TAC "*") THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL o + MATCH_MP COMPACT_PATH_IMAGE) THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\z:complex. ball(z,ee z / &3)) (path_image p)`) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; SUBSET] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `z:complex` THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_ARITH `&0 < e / &3 <=> &0 < e`]; + ALL_TAC] THEN + REWRITE_TAC[path_image; GSYM IMAGE_o] THEN REWRITE_TAC[GSYM path_image] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; MESON[] + `(?f s. (P s /\ f = g s) /\ Q f) <=> ?s. P s /\ Q(g s)`] THEN + REWRITE_TAC[UNIONS_IMAGE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:real^1->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; o_THM] THEN + ASM_CASES_TAC `k:real^1->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[PATH_IMAGE_NONEMPTY]; + DISCH_THEN(LABEL_TAC "+")] THEN + SUBGOAL_THEN + `!i:real^1. i IN k ==> &0 < ee((p i):complex)` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE]; ALL_TAC] THEN + ABBREV_TAC `e = inf(IMAGE ((ee:complex->real) o (p:real^1->complex)) k)` THEN + MP_TAC(ISPEC `IMAGE ((ee:complex->real) o (p:real^1->complex)) k` + INF_FINITE) THEN + MP_TAC(ISPECL [`IMAGE ((ee:complex->real) o (p:real^1->complex)) k`; `&0`] + REAL_LT_INF_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN + EXISTS_TAC `e / &3` THEN + MP_TAC(ISPECL [`p:real^1->complex`; `interval[vec 0:real^1,vec 1]`] + COMPACT_UNIFORMLY_CONTINUOUS) THEN REWRITE_TAC[COMPACT_INTERVAL] THEN + ANTS_TAC THENL [ASM_MESON_TAC[path]; ALL_TAC] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; AND_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->complex`; `h:real^1->complex`] THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[]) + [`!t. t IN interval[vec 0,vec 1] + ==> norm((g:real^1->complex) t - p t) < e / &3 /\ + norm((h:real^1->complex) t - p t) < e / &3`; + `valid_path(g:real^1->complex)`; `valid_path(h:real^1->complex)`] THEN + MATCH_MP_TAC(TAUT + `q /\ (p1 \/ p2 ==> q ==> r) ==> (p1 ==> q /\ r) /\ (p2 ==> q /\ r)`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REMOVE_THEN "+" (MP_TAC o SPEC `(p:real^1->complex) t`) THEN + ASM_SIMP_TAC[path_image; FUN_IN_IMAGE; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THENL + [SUBGOAL_THEN `(g:real^1->complex) t IN ball(p(u:real^1),ee(p u))` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]]; + SUBGOAL_THEN `(h:real^1->complex) t IN ball(p(u:real^1),ee(p u))` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]]] THEN + REWRITE_TAC[IN_BALL] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (NORM_ARITH `dist(gu,gt) < eu / &3 + ==> norm(ht - gt) < e / &3 /\ e <= eu + ==> dist(gu,ht) < eu`)) THEN + ASM_SIMP_TAC[]; + DISCH_TAC THEN STRIP_TAC THEN + X_GEN_TAC `f:complex->complex` THEN DISCH_TAC] THEN + SUBGOAL_THEN + `?ff. !z. z IN path_image p + ==> &0 < ee z /\ ball(z,ee z) SUBSET s /\ + !w. w IN ball(z,ee z) + ==> (ff z has_complex_derivative f w) (at w)` + MP_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM; + RIGHT_EXISTS_AND_THM] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,ee z)`; + `{}:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CONVEX_BALL; FINITE_EMPTY] THEN + SIMP_TAC[DIFF_EMPTY; INTERIOR_OPEN; OPEN_BALL] THEN + SUBGOAL_THEN `f holomorphic_on ball(z,ee z)` MP_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[]; + SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + SIMP_TAC[holomorphic_on; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; + complex_differentiable]]; + REMOVE_THEN "*" (K ALL_TAC) THEN + DISCH_THEN(CHOOSE_THEN (LABEL_TAC "*"))] THEN + MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!n. n <= N + ==> path_integral(subpath (vec 0) (&n / &N % vec 1) h) f - + path_integral(subpath (vec 0) (&n / &N % vec 1) g) f = + path_integral(linepath (g(&n / &N % vec 1),h(&n / &N % vec 1))) f - + path_integral(linepath (g(vec 0),h(vec 0))) f` + (MP_TAC o SPEC `N:num`) THENL + [ALL_TAC; + ASM_SIMP_TAC[LE_REFL; REAL_DIV_REFL; REAL_OF_NUM_EQ; VECTOR_MUL_LID] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN + REWRITE_TAC[pathstart; pathfinish] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[SUBPATH_TRIVIAL; PATH_INTEGRAL_TRIVIAL] THEN + CONV_TAC COMPLEX_RING] THEN + INDUCT_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN + REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[PATH_INTEGRAL_TRIVIAL; PATH_INTEGRAL_SUBPATH_REFL] THEN + REWRITE_TAC[COMPLEX_SUB_REFL]; + DISCH_TAC THEN FIRST_X_ASSUM(K ALL_TAC o check (is_disj o concl))] THEN + REMOVE_THEN "+" (MP_TAC o SPEC `(p:real^1->complex)(&n / &N % vec 1)`) THEN + REWRITE_TAC[IN_BALL] THEN ANTS_TAC THENL + [REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL + [`(ff:complex->complex->complex) (p(t:real^1))`; `f:complex->complex`; + `subpath (&n / &N % vec 1) (&(SUC n) / &N % vec 1) (g:real^1->complex) ++ + linepath(g (&(SUC n) / &N % vec 1),h(&(SUC n) / &N % vec 1)) ++ + subpath (&(SUC n) / &N % vec 1) (&n / &N % vec 1) h ++ + linepath(h (&n / &N % vec 1),g (&n / &N % vec 1))`; + `ball((p:real^1->complex) t,ee(p t))`] CAUCHY_THEOREM_PRIMITIVE) THEN + ASM_SIMP_TAC[VALID_PATH_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_IMAGE_JOIN; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; VALID_PATH_LINEPATH; UNION_SUBSET] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN ANTS_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `(p:real^1->complex) t`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]; + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; CENTRE_IN_BALL]]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `p /\ q /\ (p ==> r ==> s) ==> (p /\ q ==> r) ==> s`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC VALID_PATH_SUBPATH THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `drop(&n / &N % vec 1) <= drop(&(SUC n) / &N % vec 1)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID; REAL_LE_DIV2_EQ; + REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE] THEN + ARITH_TAC; + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; PATH_IMAGE_LINEPATH] THEN + ONCE_REWRITE_TAC[GSYM REVERSEPATH_SUBPATH] THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH; PATH_IMAGE_REVERSEPATH]] THEN + MATCH_MP_TAC(TAUT + `(p /\ r) /\ (p /\ r ==> q /\ s) ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[AND_FORALL_THM; TAUT + `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN STRIP_TAC THEN + REWRITE_TAC[IN_BALL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `!e pu. dist(pt,pn) < ee / &3 + ==> dist(pn,pu) < e / &3 /\ e <= ee /\ + norm(gu - pu) < e / &3 /\ norm(hu - pu) < e / &3 + ==> dist(pt,gu) < ee /\ dist(pt,hu) < ee`)) THEN + MAP_EVERY EXISTS_TAC [`e:real`; `(p:real^1->complex) u`] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `(u:real^1) IN interval[vec 0,vec 1]` ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LE_TRANS)) THEN ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LE_TRANS)) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE]]; + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1; + DROP_VEC; DROP_CMUL; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POS; REAL_LE_DIV; + REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE; + ARITH_RULE `SUC n <= N ==> n <= N`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `u <= s ==> n <= u /\ s - n < d ==> abs(n - u) < d`)) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN + SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `n <= SUC n`] THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC n - n = 1`; REAL_MUL_LID]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN STRIP_TAC THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN + REWRITE_TAC[DROP_VEC; DROP_CMUL; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POS; REAL_LE_DIV; + REAL_OF_NUM_LT; LE_1; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ARITH_TAC]; + STRIP_TAC THEN DISCH_THEN(fun th -> + MP_TAC(MATCH_MP PATH_INTEGRAL_UNIQUE th) THEN + MP_TAC(MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE th)) THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN_EQ; VALID_PATH_LINEPATH; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; VALID_PATH_LINEPATH; + PATH_INTEGRAL_JOIN] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> n <= N`] THEN + MATCH_MP_TAC(COMPLEX_RING + `hn - he = hn' /\ gn + gd = gn' /\ hgn = --ghn + ==> hn - gn = ghn - gh0 + ==> gd + ghn' + he + hgn = Cx(&0) + ==> hn' - gn' = ghn' - gh0`) THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[complex_sub; GSYM PATH_INTEGRAL_REVERSEPATH] THEN + REWRITE_TAC[REVERSEPATH_SUBPATH] THEN + MATCH_MP_TAC PATH_INTEGRAL_SUBPATH_COMBINE; + MATCH_MP_TAC PATH_INTEGRAL_SUBPATH_COMBINE; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM REVERSEPATH_LINEPATH] THEN + MATCH_MP_TAC PATH_INTEGRAL_REVERSEPATH] THEN + ASM_REWRITE_TAC[VALID_PATH_LINEPATH] THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1; + REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> n <= N`] THEN + TRY(MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN NO_TAC) THEN + ASM_MESON_TAC[PATH_INTEGRABLE_REVERSEPATH; VALID_PATH_LINEPATH; + REVERSEPATH_LINEPATH]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we can treat even non-rectifiable paths as having a "length" *) +(* for bounds on analytic functions in open sets. *) +(* ------------------------------------------------------------------------- *) + +let VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!p:real^1->complex. + vector_polynomial_function p ==> valid_path p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[valid_path] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN + MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN + REWRITE_TAC[VECTOR_DERIVATIVE_WORKS] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_derivative] THEN + CONV_TAC SELECT_CONV THEN + ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION]);; + +let PATH_INTEGRAL_BOUND_EXISTS = prove + (`!s g. open s /\ valid_path g /\ path_image g SUBSET s + ==> ?L. &0 < L /\ + !f B. f holomorphic_on s /\ (!z. z IN s ==> norm(f z) <= B) + ==> norm(path_integral g f) <= L * B`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:complex->bool`; `g:real^1->complex`] + PATH_INTEGRAL_NEARBY_ENDS) THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `g:real^1->complex`) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `d:real`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->complex`) THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `p':real^1->complex` STRIP_ASSUME_TAC o + MATCH_MP HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION) THEN + SUBGOAL_THEN `bounded(IMAGE (p':real^1->complex) (interval[vec 0,vec 1]))` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + ASM_MESON_TAC[CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; + CONTINUOUS_AT_IMP_CONTINUOUS_ON]; + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `L:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `f path_integrable_on p /\ valid_path p` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE; + VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:complex->complex`; `p:real^1->complex`] + PATH_INTEGRAL_INTEGRAL) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `drop(integral (interval[vec 0,vec 1]) (\x:real^1. lift(L * B)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST; GSYM PATH_INTEGRABLE_ON] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[path_image; SUBSET; IN_IMAGE]; + ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_UNIQUE_AT]]; + REWRITE_TAC[INTEGRAL_CONST; CONTENT_UNIT_1; VECTOR_MUL_LID] THEN + REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Winding number. *) +(* ------------------------------------------------------------------------- *) + +let winding_number = new_definition + `winding_number(g,z) = + @n. !e. &0 < e + ==> ?p. valid_path p /\ ~(z IN path_image p) /\ + pathstart p = pathstart g /\ + pathfinish p = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ + path_integral p (\w. Cx(&1) / (w - z)) = + Cx(&2) * Cx(pi) * ii * n`;; + +let CX_2PII_NZ = prove + (`~(Cx(&2) * Cx(pi) * ii = Cx(&0))`, + SIMP_TAC[COMPLEX_ENTIRE; CX_PI_NZ; II_NZ; CX_INJ; REAL_OF_NUM_EQ; ARITH]);; + +let PATH_INTEGRABLE_INVERSEDIFF = prove + (`!g z. valid_path g /\ ~(z IN path_image g) + ==> (\w. Cx(&1) / (w - z)) path_integrable_on g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `(:complex) DELETE z` THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN; SET_RULE + `s SUBSET (UNIV DELETE x) <=> ~(x IN s)`] THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_UNIV; IN_DELETE] THEN + STRIP_TAC THEN + W(MP_TAC o DISCH_ALL o COMPLEX_DIFF_CONV o snd o dest_exists o snd) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN MESON_TAC[]);; + +let WINDING_NUMBER = prove + (`!g z e. + path g /\ ~(z IN path_image g) /\ &0 < e + ==> ?p. valid_path p /\ ~(z IN path_image p) /\ + pathstart p = pathstart g /\ + pathfinish p = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ + path_integral p (\w. Cx(&1) / (w - z)) = + Cx(&2) * Cx(pi) * ii * winding_number(g,z)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[winding_number] THEN CONV_TAC SELECT_CONV THEN + MP_TAC(ISPECL [`(:complex) DELETE z`; `g:real^1->complex`] + PATH_INTEGRAL_NEARBY_ENDS) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `d / &2`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^1->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Cx(&1) / (Cx(&2) * Cx pi * ii) * + path_integral h (\w. Cx(&1) / (w - z))` THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `min d e / &2`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->complex` THEN + STRIP_TAC THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION; CX_2PII_NZ; COMPLEX_FIELD + `~(a * b * c = Cx(&0)) + ==> a * b * c * Cx(&1) / (a * b * c) * z = z`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`h:real^1->complex`; `p:real^1->complex`]) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + ASM_MESON_TAC[NORM_ARITH + `norm(h - g) < d / &2 /\ norm(p - g) < min d e / &2 + ==> norm(h - g) < d /\ norm(p - g) < d`]; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `t SUBSET UNIV DELETE x <=> ~(x IN t)`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[NORM_SUB; REAL_ARITH `&0 < e /\ x < min d e / &2 ==> x < e`]; + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN] THEN + REWRITE_TAC[IN_DELETE; IN_UNIV; GSYM complex_differentiable] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0]);; + +let WINDING_NUMBER_UNIQUE = prove + (`!g z e n. + path g /\ ~(z IN path_image g) /\ + (!e. &0 < e + ==> ?p. valid_path p /\ ~(z IN path_image p) /\ + pathstart p = pathstart g /\ + pathfinish p = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] + ==> norm(g t - p t) < e) /\ + path_integral p (\w. Cx(&1) / (w - z)) = + Cx(&2) * Cx(pi) * ii * n) + ==> winding_number(g,z) = n`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:complex) DELETE z`; `g:real^1->complex`] + PATH_INTEGRAL_NEARBY_ENDS) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] WINDING_NUMBER) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `q:real^1->complex`]) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\w. Cx(&1) / (w - z)`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN] THEN + REWRITE_TAC[IN_DELETE; IN_UNIV; GSYM complex_differentiable] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0]; + ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN + CONV_TAC COMPLEX_RING]);; + +let WINDING_NUMBER_UNIQUE_LOOP = prove + (`!g z e n. + path g /\ ~(z IN path_image g) /\ pathfinish g = pathstart g /\ + (!e. &0 < e + ==> ?p. valid_path p /\ ~(z IN path_image p) /\ + pathfinish p = pathstart p /\ + (!t. t IN interval[vec 0,vec 1] + ==> norm(g t - p t) < e) /\ + path_integral p (\w. Cx(&1) / (w - z)) = + Cx(&2) * Cx(pi) * ii * n) + ==> winding_number(g,z) = n`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:complex) DELETE z`; `g:real^1->complex`] + PATH_INTEGRAL_NEARBY_LOOP) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] WINDING_NUMBER) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `q:real^1->complex`]) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_SIMP_TAC[] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\w. Cx(&1) / (w - z)`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; HOLOMORPHIC_ON_OPEN] THEN + REWRITE_TAC[IN_DELETE; IN_UNIV; GSYM complex_differentiable] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0]; + ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN + CONV_TAC COMPLEX_RING]);; + +let WINDING_NUMBER_VALID_PATH = prove + (`!g z. valid_path g /\ ~(z IN path_image g) + ==> winding_number(g,z) = + Cx(&1) / (Cx(&2) * Cx(pi) * ii) * + path_integral g (\w. Cx(&1) / (w - z))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `g:real^1->complex` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_FIELD);; + +let HAS_PATH_INTEGRAL_WINDING_NUMBER = prove + (`!g z. valid_path g /\ ~(z IN path_image g) + ==> ((\w. Cx(&1) / (w - z)) has_path_integral + (Cx(&2) * Cx(pi) * ii * winding_number(g,z))) g`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH] THEN + ASM_SIMP_TAC[CX_2PII_NZ; COMPLEX_FIELD + `~(a * b * c = Cx(&0)) + ==> a * b * c * Cx(&1) / (a * b * c) * z = z`] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]);; + +let WINDING_NUMBER_TRIVIAL = prove + (`!a z. ~(z = a) ==> winding_number(linepath(a,a),z) = Cx(&0)`, + SIMP_TAC[VALID_PATH_LINEPATH; PATH_INTEGRAL_TRIVIAL; COMPLEX_MUL_RZERO; + WINDING_NUMBER_VALID_PATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; + IN_SING]);; + +let WINDING_NUMBER_JOIN = prove + (`!g1 g2 z. + path g1 /\ path g2 /\ pathfinish g1 = pathstart g2 /\ + ~(z IN path_image g1) /\ ~(z IN path_image g2) + ==> winding_number(g1 ++ g2,z) = + winding_number(g1,z) + winding_number(g2,z)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; IN_UNION] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g2:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN + MP_TAC(ISPECL [`g1:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p1:real^1->complex` THEN STRIP_TAC THEN + X_GEN_TAC `p2:real^1->complex` THEN STRIP_TAC THEN + EXISTS_TAC `p1 ++ p2:real^1->complex` THEN + ASM_SIMP_TAC[VALID_PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; IN_UNION] THEN CONJ_TAC THENL + [REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC; + W(MP_TAC o PART_MATCH (lhs o rand) PATH_INTEGRAL_JOIN o lhand o snd) THEN + ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN + DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_INVERSEDIFF THEN + ASM_REWRITE_TAC[]]);; + +let WINDING_NUMBER_REVERSEPATH = prove + (`!g z. path g /\ ~(z IN path_image g) + ==> winding_number(reversepath g,z) = --(winding_number(g,z))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN + ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `reversepath p:real^1->complex` THEN + ASM_SIMP_TAC[VALID_PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATH_INTEGRAL_REVERSEPATH; PATH_INTEGRABLE_INVERSEDIFF] THEN + REWRITE_TAC[COMPLEX_MUL_RNEG; reversepath; IN_INTERVAL_1; DROP_VEC] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB] THEN ASM_REAL_ARITH_TAC);; + +let WINDING_NUMBER_SHIFTPATH = prove + (`!g a z. path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) /\ + a IN interval[vec 0,vec 1] + ==> winding_number(shiftpath a g,z) = winding_number(g,z)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_UNIQUE_LOOP THEN + ASM_SIMP_TAC[PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `shiftpath a p:real^1->complex` THEN + ASM_SIMP_TAC[VALID_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; + PATH_INTEGRAL_SHIFTPATH; PATH_INTEGRABLE_INVERSEDIFF] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH] THEN + SIMP_TAC[COMPLEX_MUL_RNEG; shiftpath; IN_INTERVAL_1; DROP_ADD; DROP_VEC] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN + ASM_REAL_ARITH_TAC);; + +let WINDING_NUMBER_SPLIT_LINEPATH = prove + (`!a b c z. + c IN segment[a,b] /\ ~(z IN segment[a,b]) + ==> winding_number(linepath(a,b),z) = + winding_number(linepath(a,c),z) + + winding_number(linepath(c,b),z)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~((z:complex) IN segment[a,c]) /\ ~(z IN segment[c,b])` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(z IN s) ==> t SUBSET s ==> ~(z IN t)`)) THEN + ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; PATH_IMAGE_LINEPATH; + VALID_PATH_LINEPATH] THEN + REWRITE_TAC[GSYM COMPLEX_ADD_LDISTRIB] THEN AP_TERM_TAC THEN + MATCH_MP_TAC PATH_INTEGRAL_SPLIT_LINEPATH THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN + SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID] THEN + ASM_MESON_TAC[COMPLEX_SUB_0]]);; + +let WINDING_NUMBER_EQUAL = prove + (`!p q z. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) + ==> winding_number(p,z) = winding_number(q,z)`, + REPEAT STRIP_TAC THEN SIMP_TAC[winding_number; PATH_INTEGRAL_INTEGRAL] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `W:complex` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `e:real` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `g:real^1->complex` THEN + ASM_SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]);; + +let WINDING_NUMBER_OFFSET = prove + (`!p z. winding_number(p,z) = winding_number((\w. p w - z),Cx(&0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[winding_number; PATH_INTEGRAL_INTEGRAL] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `W:complex` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `e:real` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `&0 < e` THEN + ASM_REWRITE_TAC[path_image; valid_path; pathstart; pathfinish] THEN + EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->complex` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `\t. (g:real^1->complex) t - z`; + EXISTS_TAC `\t. (g:real^1->complex) t + z`] THEN + ASM_REWRITE_TAC[COMPLEX_RING `(p - z) - (g - z):complex = p - g`; + COMPLEX_RING `p - (g + z):complex = p - z - g`; + COMPLEX_RING `(p - z) + z:complex = p`; + COMPLEX_SUB_RZERO] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN + ASM_SIMP_TAC[PIECEWISE_DIFFERENTIABLE_ADD; PIECEWISE_DIFFERENTIABLE_SUB; + DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE; + DIFFERENTIABLE_ON_CONST; IN_IMAGE] THEN + ASM_REWRITE_TAC[COMPLEX_RING `Cx(&0) = w - z <=> z = w`; + COMPLEX_RING `z = w + z <=> Cx(&0) = w`] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_RING `(w + z) - z = w - Cx(&0)`] THEN AP_TERM_TAC THEN + REWRITE_TAC[vector_derivative; has_vector_derivative; HAS_DERIVATIVE_AT; + COMPLEX_RING `(x - z) - (w - z):complex = x - w`; + COMPLEX_RING `(x + z) - (w + z):complex = x - w`]);; + +(* ------------------------------------------------------------------------- *) +(* A combined theorem deducing several things piecewise. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_JOIN_POS_COMBINED = prove + (`!g1 g2 z. + (valid_path g1 /\ + ~(z IN path_image g1) /\ + &0 < Re(winding_number(g1,z))) /\ + (valid_path g2 /\ + ~(z IN path_image g2) /\ + &0 < Re(winding_number(g2,z))) /\ + pathfinish g1 = pathstart g2 + ==> valid_path(g1 ++ g2) /\ + ~(z IN path_image(g1 ++ g2)) /\ + &0 < Re(winding_number(g1 ++ g2,z))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[VALID_PATH_JOIN] THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; VALID_PATH_IMP_PATH; IN_UNION] THEN + ASM_SIMP_TAC[WINDING_NUMBER_JOIN; VALID_PATH_IMP_PATH; RE_ADD] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Useful sufficient conditions for the winding number to be positive etc. *) +(* ------------------------------------------------------------------------- *) + +let RE_WINDING_NUMBER = prove + (`!g z. valid_path g /\ ~(z IN path_image g) + ==> Re(winding_number(g,z)) = + Im(path_integral g (\w. Cx(&1) / (w - z))) / (&2 * pi)`, + SIMP_TAC[WINDING_NUMBER_VALID_PATH; complex_div; COMPLEX_MUL_LID] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + REWRITE_TAC[COMPLEX_INV_MUL; GSYM CX_INV; COMPLEX_INV_II] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; RE_NEG] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; RE_MUL_CX; RE_MUL_II] THEN + MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);; + +let WINDING_NUMBER_POS_LE = prove + (`!g z. valid_path g /\ ~(z IN path_image g) /\ + (!x. x IN interval(vec 0,vec 1) + ==> &0 <= Im(vector_derivative g (at x) * cnj(g x - z))) + ==> &0 <= Re(winding_number(g,z))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RE_WINDING_NUMBER] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; PI_POS; REAL_LT_IMP_LE; IM_DEF] THEN + MATCH_MP_TAC(INST_TYPE [`:1`,`:M`; `:2`,`:N`] + HAS_INTEGRAL_COMPONENT_POS) THEN + MAP_EVERY EXISTS_TAC + [`\x:real^1. if x IN interval(vec 0,vec 1) + then Cx(&1) / (g x - z) * vector_derivative g (at x) + else Cx(&0)`; + `interval[vec 0:real^1,vec 1]`] THEN + REWRITE_TAC[ARITH; DIMINDEX_2] THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN + EXISTS_TAC `\x:real^1. Cx(&1) / (g x - z) * vector_derivative g (at x)` THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM HAS_PATH_INTEGRAL] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[GSYM IM_DEF; IM_CX; REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN + ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN + REWRITE_TAC[complex_inv; complex_inv; complex_mul; RE; IM; cnj] THEN + REWRITE_TAC[real_div; REAL_RING + `(a * x) * b + (--c * x) * d:real = x * (a * b - c * d)`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_POW_2; REAL_LE_INV_EQ; REAL_LE_ADD; REAL_LE_SQUARE] THEN + ASM_REAL_ARITH_TAC);; + +let WINDING_NUMBER_POS_LT_LEMMA = prove + (`!g z e. valid_path g /\ ~(z IN path_image g) /\ &0 < e /\ + (!x. x IN interval(vec 0,vec 1) + ==> e <= Im(vector_derivative g (at x) / (g x - z))) + ==> &0 < Re(winding_number(g,z))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RE_WINDING_NUMBER] THEN + MATCH_MP_TAC REAL_LT_DIV THEN + SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `Im(ii * Cx e)` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_MUL_LNEG; IM_MUL_II; IM_NEG; RE_CX]; ALL_TAC] THEN + REWRITE_TAC[IM_DEF] THEN + MATCH_MP_TAC(ISPECL [`\x:real^1. ii * Cx e`; + `\x:real^1. if x IN interval(vec 0,vec 1) + then Cx(&1) / (g x - z) * vector_derivative g (at x) + else ii * Cx e`; + `interval[vec 0:real^1,vec 1]`; `ii * Cx e`; + `path_integral g (\w. Cx(&1) / (w - z))`; `2`] + HAS_INTEGRAL_COMPONENT_LE) THEN + REWRITE_TAC[DIMINDEX_2; ARITH] THEN REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN + ONCE_REWRITE_TAC[GSYM CONTENT_UNIT_1] THEN + REWRITE_TAC[HAS_INTEGRAL_CONST]; + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN + EXISTS_TAC `\x:real^1. Cx(&1) / (g x - z) * vector_derivative g (at x)` THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM HAS_PATH_INTEGRAL] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[GSYM IM_DEF; IM_CX; REAL_LE_REFL] THEN + REWRITE_TAC[IM_MUL_II; RE_CX] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN + ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LID; COMPLEX_MUL_SYM]]);; + +let WINDING_NUMBER_POS_LT = prove + (`!g z e. valid_path g /\ ~(z IN path_image g) /\ &0 < e /\ + (!x. x IN interval(vec 0,vec 1) + ==> e <= Im(vector_derivative g (at x) * cnj(g x - z))) + ==> &0 < Re(winding_number(g,z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `bounded (IMAGE (\w. w - z) (path_image g))` MP_TAC THENL + [REWRITE_TAC[path_image; GSYM IMAGE_o] THEN + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON THEN + ASM_REWRITE_TAC[GSYM valid_path]; + ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC WINDING_NUMBER_POS_LT_LEMMA THEN + EXISTS_TAC `e:real / B pow 2` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN + REWRITE_TAC[real_div; complex_div; GSYM CX_INV; GSYM CX_POW] THEN + REWRITE_TAC[IM_MUL_CX] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ; REAL_POW_LE] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + UNDISCH_TAC `~((z:complex) IN path_image g)`; + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[NORM_POS_LE] THEN + FIRST_X_ASSUM MATCH_MP_TAC] THEN + REWRITE_TAC[path_image; IN_IMAGE] THEN + ASM_MESON_TAC[SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* The winding number is an integer (proof from Ahlfors's book). *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_AHLFORS_LEMMA = prove + (`!g a b. + g piecewise_differentiable_on interval [a,b] /\ + drop a <= drop b /\ (!x. x IN interval [a,b] ==> ~(g x = z)) + ==> (\x. vector_derivative g (at x within interval[a,b]) / (g(x) - z)) + integrable_on interval[a,b] /\ + cexp(--(integral (interval[a,b]) + (\x. vector_derivative g (at x within interval[a,b]) / + (g(x) - z)))) * + (g(b) - z) = g(a) - z`, + let lemma = prove + (`!f g g' s x z. + (g has_vector_derivative g') (at x within s) /\ + (f has_vector_derivative (g' / (g x - z))) (at x within s) /\ + ~(g x = z) + ==> ((\x. cexp(--f x) * (g x - z)) has_vector_derivative Cx(&0)) + (at x within s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `cexp(--f x) * (g' - Cx(&0)) + + (cexp(--f x) * --(g' / ((g:real^1->complex) x - z))) * (g x - z) = Cx(&0)` + (SUBST1_TAC o SYM) + THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + CONV_TAC COMPLEX_FIELD; + ALL_TAC] THEN + MATCH_MP_TAC(ISPEC `( * ):complex->complex->complex` + HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL; GSYM COMPLEX_VEC_0] THEN + ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_SUB; ETA_AX; + HAS_VECTOR_DERIVATIVE_CONST] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[has_vector_derivative] THEN + SUBGOAL_THEN `!x y. (\z. drop z % (x * y :complex)) = + (\w. x * w) o (\z. drop z % y)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; COMPLEX_CMUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN + REWRITE_TAC[GSYM has_complex_derivative; GSYM has_vector_derivative] THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CEXP; HAS_COMPLEX_DERIVATIVE_AT_WITHIN] THEN + ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_NEG]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!w. ~(w = z) + ==> ?h. !y. norm(y - w) < norm(w - z) + ==> (h has_complex_derivative inv(y - z)) (at y)` + (LABEL_TAC "P") + THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\w:complex. inv(w - z)`; + `ball(w:complex,norm(w - z))`; + `{}:complex->bool`] + HOLOMORPHIC_CONVEX_PRIMITIVE) THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; INTERIOR_OPEN] THEN + REWRITE_TAC[CONVEX_BALL; FINITE_RULES; DIFF_EMPTY] THEN ANTS_TAC THENL + [SUBGOAL_THEN `(\w. inv(w - z)) holomorphic_on ball(w:complex,norm(w - z))` + (fun th -> + MESON_TAC[HOLOMORPHIC_ON_OPEN; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + OPEN_BALL; complex_differentiable; th]) THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; IN_BALL] THEN + X_GEN_TAC `u:complex` THEN DISCH_TAC THEN + EXISTS_TAC `--Cx(&1) / (u - z) pow 2` THEN COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_SUB_0] THEN + ASM_MESON_TAC[REAL_LT_REFL; dist]; + ALL_TAC] THEN + REWRITE_TAC[IN_BALL; dist] THEN MESON_TAC[NORM_SUB]; + ALL_TAC] THEN + SUBGOAL_THEN + `!t. t IN interval[a,b] + ==> (\x. vector_derivative g (at x within interval[a,b]) / (g(x) - z)) + integrable_on interval[a,t] /\ + cexp(--(integral (interval[a,t]) + (\x. vector_derivative g (at x within interval[a,b]) / + (g(x) - z)))) * + (g(t) - z) = g(a) - z` + (fun th -> MATCH_MP_TAC th THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]) THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_INTERVAL_1]] THEN + REWRITE_TAC[integrable_on; complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN + REWRITE_TAC[GSYM integrable_on] THEN + MATCH_MP_TAC PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY THEN + EXISTS_TAC `(:complex) DELETE z` THEN + ASM_SIMP_TAC[IN_DELETE; IN_UNIV; + DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + EXISTS_TAC `norm(w - z:complex)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [piecewise_differentiable_on]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_DIFF; FINITE_IMP_COUNTABLE] THEN + X_GEN_TAC `k:real^1->bool` THEN STRIP_TAC THEN + ASM_SIMP_TAC[CONVEX_INTERVAL; INTEGRAL_REFL] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_NEG_0; CEXP_0; COMPLEX_MUL_LID] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; ETA_AX; + PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]; + ALL_TAC] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\w:complex. inv(w - z)`; + `ball((g:real^1->complex) t,dist(g t,z))`; + `{}:complex->bool`] + HOLOMORPHIC_CONVEX_PRIMITIVE) THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; INTERIOR_OPEN] THEN + REWRITE_TAC[CONVEX_BALL; FINITE_RULES; DIFF_EMPTY] THEN ANTS_TAC THENL + [SUBGOAL_THEN `(\w. inv(w - z)) holomorphic_on ball(g(t:real^1),dist(g t,z))` + (fun th -> + MESON_TAC[HOLOMORPHIC_ON_OPEN; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + OPEN_BALL; complex_differentiable; th]) THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; IN_BALL] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + EXISTS_TAC `--Cx(&1) / (w - z) pow 2` THEN COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_SUB_0] THEN + ASM_MESON_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + REWRITE_TAC[IN_BALL; dist] THEN + DISCH_THEN(X_CHOOSE_TAC `h:complex->complex`) THEN + SUBGOAL_THEN `(\h. Cx(&0)) = (\h. drop h % Cx(&0))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; GSYM COMPLEX_VEC_0; VECTOR_MUL_RZERO]; + ALL_TAC] THEN + REWRITE_TAC[GSYM has_vector_derivative] THEN MATCH_MP_TAC lemma THEN + EXISTS_TAC `vector_derivative g (at t within interval[a,b]):complex` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + ASM_MESON_TAC[DIFFERENTIABLE_AT_WITHIN]; + ALL_TAC; + ASM_MESON_TAC[]] THEN + REWRITE_TAC[has_vector_derivative] THEN + MATCH_MP_TAC HAS_DERIVATIVE_TRANSFORM_WITHIN THEN + ASM_REWRITE_TAC[GSYM has_vector_derivative] THEN + EXISTS_TAC `\u. integral (interval [a,t]) + (\x. vector_derivative g (at x within interval [a,b]) / + ((g:real^1->complex) x - z)) + (h(g(u)) - h(g(t)))` THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; CONJ_ASSOC] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[COMPLEX_RING `a + (b - c) = b + (a - c):complex`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN + REWRITE_TAC[has_vector_derivative] THEN + SUBGOAL_THEN `!x y. (\h. drop h % x / y) = + (\x. inv(y) * x) o (\h. drop h % x)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; COMPLEX_CMUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN + REWRITE_TAC[GSYM has_complex_derivative; GSYM has_vector_derivative] THEN + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIFFERENTIABLE_AT_WITHIN]; ALL_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; COMPLEX_NORM_NZ] THEN + ASM_SIMP_TAC[COMPLEX_SUB_0]] THEN + SUBGOAL_THEN + `?d. &0 < d /\ + !y:real^1. y IN interval[a,b] /\ dist(y,t) < d + ==> dist(g y:complex,g t) < norm(g t - z) /\ ~(y IN k)` + MP_TAC THENL + [SUBGOAL_THEN `(g:real^1->complex) continuous (at t within interval[a,b])` + MP_TAC THENL + [ASM_MESON_TAC[PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON; + CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; + ALL_TAC] THEN + REWRITE_TAC[continuous_within] THEN + DISCH_THEN(MP_TAC o SPEC `norm((g:real^1->complex) t - z)`) THEN + ASM_SIMP_TAC[COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC o + SPEC `t:real^1` o MATCH_MP FINITE_SET_AVOID) THEN + EXISTS_TAC `min d1 d2` THEN ASM_SIMP_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[DIST_SYM; REAL_NOT_LE]; + ALL_TAC] THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real^1` THEN REWRITE_TAC[dist] THEN + STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `drop t <= drop u \/ drop u <= drop t`) THENL + [SUBGOAL_THEN + `integral (interval [a,u]) + (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) = + integral (interval [a,t]) + (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) + + integral (interval [t,u]) + (\x. vector_derivative g (at x within interval [a,b]) / (g x - z))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN + ASM_MESON_TAC[IN_INTERVAL_1]; + ALL_TAC] THEN + SIMP_TAC[COMPLEX_RING `a + x = a + y <=> y:complex = x`]; + SUBGOAL_THEN + `integral (interval [a,t]) + (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) = + integral (interval [a,u]) + (\x. vector_derivative g (at x within interval [a,b]) / (g x - z)) + + integral (interval [u,t]) + (\x. vector_derivative g (at x within interval [a,b]) / (g x - z))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN + ASM_MESON_TAC[IN_INTERVAL_1]; + ALL_TAC] THEN + SIMP_TAC[COMPLEX_RING `(a + x) + (w - z) = a <=> x:complex = z - w`]] THEN + (MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[GSYM o_DEF] THEN X_GEN_TAC `x:real^1` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[has_vector_derivative; COMPLEX_CMUL] THEN + SUBGOAL_THEN `!x y. (\h. Cx(drop h) * x / y) = + (\x. inv(y) * x) o (\h. drop h % x)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; COMPLEX_CMUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN + REWRITE_TAC[GSYM has_complex_derivative; GSYM has_vector_derivative] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `interval[a:real^1,b]` THEN + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC]; + ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + check (fun t -> not(is_forall (concl t))))) THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB] THEN + REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LE_REFL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM dist] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1; REAL_LE_TRANS]; ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + check (fun t -> not(is_forall (concl t))))) THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB] THEN + REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1; REAL_LE_REFL] THEN + REAL_ARITH_TAC));; + +let WINDING_NUMBER_AHLFORS = prove + (`!g z a b. + g piecewise_differentiable_on interval [a,b] /\ + drop a <= drop b /\ (!x. x IN interval [a,b] ==> ~(g x = z)) + ==> (\x. vector_derivative g (at x) / (g(x) - z)) + integrable_on interval[a,b] /\ + cexp(--(integral (interval[a,b]) + (\x. vector_derivative g (at x) / (g(x) - z)))) * + (g(b) - z) = g(a) - z`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[integrable_on; integral] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN + REWRITE_TAC[GSYM HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN + ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM](GSYM complex_div)] THEN + REWRITE_TAC[GSYM integral; GSYM integrable_on] THEN + MATCH_MP_TAC WINDING_NUMBER_AHLFORS_LEMMA THEN ASM_REWRITE_TAC[]);; + +let WINDING_NUMBER_AHLFORS_FULL = prove + (`!p z. path p /\ ~(z IN path_image p) + ==> pathfinish p - z = + cexp(Cx(&2) * Cx pi * ii * winding_number(p,z)) * + (pathstart p - z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:real^1->complex`; `z:complex`; `&1`] WINDING_NUMBER) THEN + ASM_REWRITE_TAC[REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^1->complex` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[valid_path; path_image; IN_IMAGE; + NOT_EXISTS_THM]) THEN + MP_TAC(ISPECL + [`g:real^1->complex`; `z:complex`; `vec 0:real^1`; `vec 1:real^1`] + WINDING_NUMBER_AHLFORS) THEN + ASM_SIMP_TAC[DROP_VEC; REAL_POS; pathstart; pathfinish] THEN ANTS_TAC THENL + [ASM_MESON_TAC[]; DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2)] THEN + REWRITE_TAC[GSYM CEXP_ADD; COMPLEX_MUL_ASSOC; PATH_INTEGRAL_INTEGRAL] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `Cx(&1) / z * w = w / z`] THEN + REWRITE_TAC[GSYM complex_sub; COMPLEX_SUB_REFL; CEXP_0; COMPLEX_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* State in terms of complex integers. Note the useful equality version. *) +(* ------------------------------------------------------------------------- *) + +let complex_integer = new_definition + `complex_integer z <=> integer(Re z) /\ Im z = &0`;; + +let COMPLEX_INTEGER = prove + (`complex_integer z <=> ?n. integer n /\ z = Cx n`, + REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX; complex_integer] THEN MESON_TAC[]);; + +let INTEGER_WINDING_NUMBER_EQ = prove + (`!g z. path g /\ ~(z IN path_image g) + ==> (complex_integer(winding_number(g,z)) <=> + pathfinish g = pathstart g)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_BALL) THEN + ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `complex_integer(winding_number(p,z)) <=> + pathfinish p = pathstart p` + MP_TAC THENL + [UNDISCH_THEN + `path_integral p (\w. Cx(&1) / (w - z)) = + Cx(&2) * Cx pi * ii * winding_number (g,z)` (K ALL_TAC) THEN + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH]; + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; CX_2PII_NZ; COMPLEX_FIELD + `~(a * b * c = Cx(&0)) + ==> Cx(&1) / (a * b * c) * a * b * c * z = z`]] THEN + UNDISCH_THEN `pathstart p:complex = pathstart g` (SUBST_ALL_TAC o SYM) THEN + UNDISCH_THEN `pathfinish p:complex = pathfinish g` (SUBST_ALL_TAC o SYM) THEN + RULE_ASSUM_TAC(REWRITE_RULE[valid_path; path_image]) THEN + REWRITE_TAC[pathfinish; pathstart] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `cexp(path_integral p (\w. Cx(&1) / (w - z))) = Cx(&1)` THEN + CONJ_TAC THENL + [REWRITE_TAC[CEXP_EQ_1; complex_integer] THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID; COMPLEX_INV_MUL] THEN + SIMP_TAC[GSYM CX_INV; GSYM CX_MUL; COMPLEX_MUL_ASSOC; COMPLEX_INV_II] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; RE_MUL_II; IM_MUL_II; RE_NEG; IM_NEG] THEN + REWRITE_TAC[REAL_NEGNEG; REAL_ENTIRE; REAL_INV_EQ_0; REAL_NEG_EQ_0] THEN + SIMP_TAC[REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ; PI_POS] THEN + SIMP_TAC[PI_POS; REAL_FIELD + `&0 < p ==> (x = &2 * n * p <=> (inv(&2) * inv(p)) * x = n)`] THEN + MESON_TAC[]; + MP_TAC(ISPECL [`p:real^1->complex`; `z:complex`; + `vec 0:real^1`; `vec 1:real^1`] + WINDING_NUMBER_AHLFORS) THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_POS] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN + REWRITE_TAC[integral; GSYM HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE] THEN + REWRITE_TAC[GSYM has_path_integral; GSYM path_integral] THEN + REWRITE_TAC[CEXP_NEG; COMPLEX_MUL_RID] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(i = Cx(&0)) /\ ~(g0 = z) + ==> (inv i * (g1 - z) = g0 - z ==> (i = Cx(&1) <=> g1 = g0))`) THEN + REWRITE_TAC[CEXP_NZ] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_IMAGE]) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN MESON_TAC[REAL_POS; DROP_VEC]]);; + +let INTEGER_WINDING_NUMBER = prove + (`!g z. path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) + ==> complex_integer(winding_number(g,z))`, + MESON_TAC[INTEGER_WINDING_NUMBER_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* For |WN| >= 1 the path must contain points in every direction. *) +(* We can thus bound the WN of a path that doesn't meet some "cut". *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_POS_MEETS = prove + (`!g z. valid_path g /\ ~(z IN path_image g) /\ + Re(winding_number(g,z)) >= &1 + ==> !w. ~(w = z) + ==> ?a. &0 < a /\ z + (Cx a * (w - z)) IN path_image g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!t. t IN interval[vec 0,vec 1] ==> ~((g:real^1->complex) t = z)` + ASSUME_TAC THENL + [UNDISCH_TAC `~((z:complex) IN path_image g)` THEN + REWRITE_TAC[path_image; IN_IMAGE] THEN MESON_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `r:complex = (w - z) / (pathstart g - z)` THEN + STRIP_ASSUME_TAC(GSYM(SPEC `r:complex` ARG)) THEN + SUBGOAL_THEN + `?t. t IN interval[vec 0,vec 1] /\ + Im(integral (interval[vec 0,t]) + (\x. vector_derivative g (at x) / (g x - z))) = Arg r` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IM_DEF] THEN MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN + ASM_SIMP_TAC[DIMINDEX_2; DROP_VEC; ARITH; INTEGRAL_REFL; REAL_POS; + VEC_COMPONENT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN + REWRITE_TAC[GSYM PATH_INTEGRABLE_ON] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv z = Cx(&1) / z`] THEN + MATCH_MP_TAC PATH_INTEGRABLE_INVERSEDIFF THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * pi` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + UNDISCH_TAC `Re(winding_number (g,z)) >= &1` THEN + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; GSYM IM_DEF] THEN + REWRITE_TAC[path_integral; HAS_PATH_INTEGRAL; GSYM integral] THEN + SUBST1_TAC(COMPLEX_FIELD `ii = --inv ii`) THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_NEG] THEN + REWRITE_TAC[GSYM CX_INV; GSYM CX_MUL; COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[RE_MUL_CX; RE; COMPLEX_MUL_RNEG; RE_NEG; COMPLEX_MUL_LNEG; + COMPLEX_INV_INV; GSYM COMPLEX_MUL_ASSOC; RE_MUL_II] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_NEGNEG] THEN + SIMP_TAC[REAL_ARITH `((&1 * inv(&2)) * p) * x >= &1 <=> &2 <= x * p`] THEN + SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; PI_POS] THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_AC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g:real^1->complex`; `z:complex`; `vec 0:real^1`; `t:real^1`] + WINDING_NUMBER_AHLFORS) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + RULE_ASSUM_TAC(REWRITE_RULE[valid_path]) THEN ASM_REWRITE_TAC[]; + ALL_TAC; + GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th)] THEN + UNDISCH_TAC `(t:real^1) IN interval[vec 0,vec 1]` THEN + REWRITE_TAC[SUBSET; IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[CEXP_NEG] THEN + ABBREV_TAC `i = integral (interval [vec 0,t]) + (\x. vector_derivative g (at x) / (g x - z))` THEN + SUBST1_TAC(SPEC `i:complex` COMPLEX_EXPAND) THEN + ASM_REWRITE_TAC[CEXP_ADD; COMPLEX_INV_MUL; GSYM CX_EXP] THEN + UNDISCH_TAC `Cx(norm r) * cexp(ii * Cx(Arg r)) = r` THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_FIELD + `x * e = r /\ (y * inv e) * w = z + ==> ~(e = Cx(&0)) ==> x * y * w = r * z`)) THEN + REWRITE_TAC[CEXP_NZ] THEN + EXPAND_TAC "r" THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [pathstart] THEN + SUBGOAL_THEN `~((g:real^1->complex)(vec 0) = z)` ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_SUB_0; GSYM CX_INV; GSYM CX_MUL; + COMPLEX_MUL_ASSOC; GSYM real_div] THEN + DISCH_TAC THEN + EXISTS_TAC `exp(Re i) / norm(r:complex)` THEN + SUBGOAL_THEN `~(r = Cx(&0))` ASSUME_TAC THENL + [EXPAND_TAC "r" THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0; pathstart]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_EXP_POS_LT; COMPLEX_NORM_NZ] THEN + REWRITE_TAC[path_image; IN_IMAGE] THEN + EXISTS_TAC `t:real^1` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `inv i * (gt - z) = wz /\ ~(i = Cx(&0)) ==> z + i * wz = gt`) THEN + ASM_REWRITE_TAC[GSYM CX_INV; REAL_INV_DIV; CX_INJ] THEN + MATCH_MP_TAC(REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> ~(x / y = &0)`) THEN + ASM_REWRITE_TAC[REAL_EXP_NZ; COMPLEX_NORM_ZERO]);; + +let WINDING_NUMBER_BIG_MEETS = prove + (`!g z. valid_path g /\ ~(z IN path_image g) /\ + abs(Re(winding_number(g,z))) >= &1 + ==> !w. ~(w = z) + ==> ?a. &0 < a /\ z + (Cx a * (w - z)) IN path_image g`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[WINDING_NUMBER_POS_MEETS] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[GSYM RE_NEG; VALID_PATH_IMP_PATH; + GSYM WINDING_NUMBER_REVERSEPATH] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN + MATCH_MP_TAC WINDING_NUMBER_POS_MEETS THEN + ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH; VALID_PATH_REVERSEPATH]);; + +let WINDING_NUMBER_LT_1 = prove + (`!g w z. valid_path g /\ ~(z IN path_image g) /\ ~(w = z) /\ + (!a. &0 < a ==> ~(z + (Cx a * (w - z)) IN path_image g)) + ==> Re(winding_number(g,z)) < &1`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_NOT_LE; GSYM real_ge] THEN + ASM_MESON_TAC[WINDING_NUMBER_POS_MEETS]);; + +(* ------------------------------------------------------------------------- *) +(* One way of proving that WN=1 for a loop. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_EQ_1 = prove + (`!g z. valid_path g /\ ~(z IN path_image g) /\ pathfinish g = pathstart g /\ + &0 < Re(winding_number(g,z)) /\ Re(winding_number(g,z)) < &2 + ==> winding_number(g,z) = Cx(&1)`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN `complex_integer(winding_number(g,z))` MP_TAC THENL + [ASM_SIMP_TAC[INTEGER_WINDING_NUMBER; VALID_PATH_IMP_PATH]; ALL_TAC] THEN + SIMP_TAC[complex_integer; COMPLEX_EQ; RE_CX; IM_CX] THEN + SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of winding number and invariance on connected sets. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_AT_WINDING_NUMBER = prove + (`!g z. path g /\ ~(z IN path_image g) + ==> (\w. winding_number(g,w)) continuous (at z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_CBALL) THEN + ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_CBALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(:complex) DIFF cball(z,e / &2)`; `g:real^1->complex`] + PATH_INTEGRAL_NEARBY_ENDS) THEN + ASM_SIMP_TAC[OPEN_DIFF; OPEN_UNIV; CLOSED_CBALL] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL; SUBSET; IN_UNIV] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `min d e / &2`] + WINDING_NUMBER) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CONTINUOUS_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`\w. winding_number(p,w)`; `min d e / &2`] THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[path_image; IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^1->complex) t`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`) THEN + ASM_SIMP_TAC[path_image; FUN_IN_IMAGE] THEN + UNDISCH_TAC `dist (w:complex,z) < min d e / &2` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; + DISCH_TAC THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `w:complex`; `min k (min d e) / &2`] + WINDING_NUMBER) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN ANTS_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `p:real^1->complex` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`p:real^1->complex`; `q:real^1->complex`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`)) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; + DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS)] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; + IN_DELETE; IN_UNIV; COMPLEX_SUB_0] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[IN_DIFF] THEN + REWRITE_TAC[IN_UNIV; IN_CBALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC]; + UNDISCH_TAC `~((z:complex) IN path_image p)` THEN + UNDISCH_TAC `valid_path(p:real^1->complex)` THEN + POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`z:complex`,`z:complex`) THEN + SPEC_TAC(`p:real^1->complex`,`g:real^1->complex`)] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_BALL) THEN + ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(:complex) DIFF cball(z, &3 / &4 * d)`; `g:real^1->complex`] + PATH_INTEGRAL_BOUND_EXISTS) THEN + ASM_REWRITE_TAC[GSYM closed; CLOSED_CBALL; SUBSET; IN_DIFF; + IN_CBALL; IN_UNIV; REAL_NOT_LE] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `&0 < d /\ ~(&3 / &4 * d < x) ==> x < d`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `L:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[continuous_at] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + EXISTS_TAC `min (d / &4) (e / &2 * d pow 2 / L / &4)` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_POW_LT; REAL_LT_DIV; REAL_LT_MUL; REAL_HALF; + REAL_ARITH `&0 < x / &4 <=> &0 < x`] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `~((w:complex) IN path_image g)` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[dist; WINDING_NUMBER_VALID_PATH; GSYM COMPLEX_SUB_LDISTRIB] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NUM; COMPLEX_NORM_II; REAL_ABS_PI] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_ARITH + `inv p * x <= &1 * x /\ x < e ==> inv p * x < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `!d. &0 < e /\ d = e / &2 /\ x <= d ==> x < e`) THEN + EXISTS_TAC `L * (e / &2 * d pow 2 / L / &4) * inv(d / &2) pow 2` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY UNDISCH_TAC [`&0 < d`; `&0 < L`] THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `path_integral g (\x. Cx(&1) / (x - w)) - + path_integral g (\x. Cx(&1) / (x - z)) = + path_integral g (\x. Cx(&1) / (x - w) - Cx(&1) / (x - z))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC PATH_INTEGRABLE_INVERSEDIFF THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; GSYM closed; CLOSED_CBALL] THEN + REWRITE_TAC[IN_UNIV; IN_DIFF; IN_CBALL; REAL_NOT_LE; AND_FORALL_THM] THEN + X_GEN_TAC `x:complex` THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM complex_differentiable] THEN + SUBGOAL_THEN `~(x:complex = w) /\ ~(x = z)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN + CONV_TAC NORM_ARITH; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; COMPLEX_DIFFERENTIABLE_SUB; + COMPLEX_DIFFERENTIABLE_ID; COMPLEX_DIFFERENTIABLE_CONST]; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = w) /\ ~(x = z) + ==> Cx(&1) / (x - w) - Cx(&1) / (x - z) = + (w - z) * inv((x - w) * (x - z))`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; GSYM dist; REAL_LT_IMP_LE] THEN + REWRITE_TAC[COMPLEX_NORM_INV; REAL_POW_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_POW_2; REAL_LT_MUL; REAL_HALF; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_HALF; REAL_LT_IMP_LE] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN + CONV_TAC NORM_ARITH);; + +let CONTINUOUS_ON_WINDING_NUMBER = prove + (`!g. path g + ==> (\w. winding_number(g,w)) continuous_on + ((:complex) DIFF path_image g)`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; GSYM closed; + OPEN_UNIV; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN + SIMP_TAC[IN_DIFF; IN_UNIV; CONTINUOUS_AT_WINDING_NUMBER]);; + +let WINDING_NUMBER_CONSTANT = prove + (`!s g. path g /\ pathfinish g = pathstart g /\ + connected s /\ s INTER path_image g = {} + ==> ?k. !z. z IN s ==> winding_number(g,z) = k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:complex) DIFF path_image g` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_WINDING_NUMBER] THEN ASM SET_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `w:complex` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN + `complex_integer(winding_number(g,w)) /\ + complex_integer(winding_number(g,z))` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGER_WINDING_NUMBER THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[COMPLEX_INTEGER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[GSYM CX_SUB; CX_INJ; COMPLEX_NORM_CX] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN + ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED]);; + +let WINDING_NUMBER_EQ = prove + (`!g s w z. + path g /\ pathfinish g = pathstart g /\ + w IN s /\ z IN s /\ connected s /\ s INTER path_image g = {} + ==> winding_number(g,w) = winding_number(g,z)`, + MESON_TAC[WINDING_NUMBER_CONSTANT]);; + +let OPEN_WINDING_NUMBER_LEVELSETS = prove + (`!g k. path g /\ pathfinish g = pathstart g + ==> open {z | ~(z IN path_image g) /\ winding_number(g,z) = k}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[open_def; IN_ELIM_THM] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + MP_TAC(ISPEC `(:complex) DIFF path_image g` OPEN_CONTAINS_BALL) THEN + ASM_SIMP_TAC[GSYM closed; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; SUBSET; IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN + REPEAT STRIP_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + MP_TAC(ISPECL [`ball(z:complex,e)`; `g:real^1->complex`] + WINDING_NUMBER_CONSTANT) THEN + ASM_SIMP_TAC[CONNECTED_BALL; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN + ASM_MESON_TAC[DIST_REFL; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Winding number is zero "outside" a curve, in various senses. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_ZERO_IN_OUTSIDE = prove + (`!g z. path g /\ pathfinish g = pathstart g /\ z IN outside(path_image g) + ==> winding_number(g,z) = Cx(&0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`path_image(g:real^1->complex)`; `Cx(&0)`] + BOUNDED_SUBSET_BALL) THEN ASM_SIMP_TAC[BOUNDED_PATH_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?w. ~(w IN ball(Cx(&0),B + &1))` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE `~(s = UNIV) ==> ?z. ~(z IN s)`) THEN + MESON_TAC[BOUNDED_BALL; NOT_BOUNDED_UNIV]; + ALL_TAC] THEN + MP_TAC(ISPECL [`Cx(&0)`; `B:real`; `B + &1`] SUBSET_BALL) THEN + REWRITE_TAC[REAL_ARITH `B <= B + &1`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`path_image(g:real^1->complex)`; `ball(Cx(&0),B + &1)`] + OUTSIDE_SUBSET_CONVEX) THEN + ASM_REWRITE_TAC[CONVEX_BALL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN DISCH_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `winding_number(g,w)` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`outside(path_image(g:real^1->complex))`; + `g:real^1->complex`] WINDING_NUMBER_CONSTANT) THEN + ASM_SIMP_TAC[OUTSIDE_NO_OVERLAP; CONNECTED_OUTSIDE; + DIMINDEX_2; LE_REFL; BOUNDED_PATH_IMAGE] THEN + ASM SET_TAC[]; + MATCH_MP_TAC WINDING_NUMBER_UNIQUE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM SET_TAC[]; DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC] THEN + MP_TAC(ISPECL [`g:real^1->complex`; `min e (&1)`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->complex` THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN CONJ_TAC THENL + [UNDISCH_TAC `~(w IN ball (Cx(&0),B + &1))` THEN + REWRITE_TAC[CONTRAPOS_THM; path_image; IN_BALL] THEN + SPEC_TAC(`w:complex`,`x:complex`) THEN REWRITE_TAC[FORALL_IN_IMAGE]; + REWRITE_TAC[COMPLEX_MUL_RZERO] THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC CAUCHY_THEOREM_CONVEX_SIMPLE THEN + EXISTS_TAC `ball(Cx(&0),B + &1)` THEN + ASM_SIMP_TAC[CONVEX_BALL; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; + COMPLEX_SUB_0] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; IN_BALL]]] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + MATCH_MP_TAC(NORM_ARITH + `!g:real^1->complex. norm(p t - g t) < &1 /\ norm(g t) <= B + ==> norm(p t) < B + &1`) THEN + EXISTS_TAC `g:real^1->complex` THEN + UNDISCH_TAC `path_image g SUBSET ball (Cx(&0),B)` THEN + ASM_SIMP_TAC[SUBSET; IN_BALL; path_image; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; REAL_LT_IMP_LE]]);; + +let WINDING_NUMBER_ZERO_OUTSIDE = prove + (`!g s z. path g /\ convex s /\ pathfinish g = pathstart g /\ + ~(z IN s) /\ path_image g SUBSET s + ==> winding_number(g,z) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_ZERO_IN_OUTSIDE THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`path_image(g:real^1->complex)`; `s:complex->bool`] + OUTSIDE_SUBSET_CONVEX) THEN + ASM SET_TAC[]);; + +let WINDING_NUMBER_ZERO_ATINFINITY = prove + (`!g. path g /\ pathfinish g = pathstart g + ==> ?B. !z. B <= norm(z) ==> winding_number(g,z) = Cx(&0)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `bounded (path_image g :complex->bool)` MP_TAC THENL + [ASM_SIMP_TAC[BOUNDED_PATH_IMAGE]; ALL_TAC] THEN + REWRITE_TAC[bounded] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + EXISTS_TAC `B + &1` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC WINDING_NUMBER_ZERO_OUTSIDE THEN + EXISTS_TAC `cball(Cx(&0),B)` THEN ASM_REWRITE_TAC[CONVEX_CBALL] THEN + REWRITE_TAC[SUBSET; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + ASM_MESON_TAC[REAL_ARITH `~(B + &1 <= z /\ z <= B)`]);; + +let WINDING_NUMBER_ZERO_POINT = prove + (`!g s. path g /\ pathfinish g = pathstart g /\ + open s /\ path_image g SUBSET s + ==> ?z. z IN s /\ winding_number(g,z) = Cx(&0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`path_image g:complex->bool`; `s:complex->bool`] + OUTSIDE_COMPACT_IN_OPEN) THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN ANTS_TAC THENL + [ASM_MESON_TAC[SUBSET_EMPTY; PATH_IMAGE_NONEMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN REWRITE_TAC[IN_INTER] THEN + ASM_SIMP_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE]);; + +(* ------------------------------------------------------------------------- *) +(* If a path winds round a set, it winds rounds its inside. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_AROUND_INSIDE = prove + (`!g s z. + path g /\ pathfinish g = pathstart g /\ + closed s /\ connected s /\ s INTER path_image g = {} /\ + z IN s /\ ~(winding_number(g,z) = Cx(&0)) + ==> !w. w IN s UNION inside(s) + ==> winding_number(g,w) = winding_number(g,z)`, + MAP_EVERY X_GEN_TAC + [`g:real^1->complex`; `s:complex->bool`; `z0:complex`] THEN STRIP_TAC THEN + SUBGOAL_THEN `!z. z IN s ==> winding_number(g,z) = winding_number(g,z0)` + ASSUME_TAC THENL [ASM_MESON_TAC[WINDING_NUMBER_EQ]; ALL_TAC] THEN + ABBREV_TAC `k = winding_number (g,z0)` THEN + SUBGOAL_THEN `(s:complex->bool) SUBSET inside(path_image g)` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; INSIDE_OUTSIDE; IN_DIFF; IN_UNIV; IN_UNION] THEN + X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE]]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_UNION] THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MP_TAC(ISPECL [`s:complex->bool`; + `path_image g:complex->bool`] + INSIDE_INSIDE_COMPACT_CONNECTED) THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN STRIP_TAC THEN + EXPAND_TAC "k" THEN MATCH_MP_TAC WINDING_NUMBER_EQ THEN + EXISTS_TAC `s UNION inside s :complex->bool` THEN + ASM_SIMP_TAC[CONNECTED_WITH_INSIDE; IN_UNION] THEN + MP_TAC(ISPEC `path_image g :complex->bool` INSIDE_NO_OVERLAP) THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Bounding a WN by 1/2 for a path and point in opposite halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_SUBPATH_CONTINUOUS = prove + (`!g z. valid_path g /\ ~(z IN path_image g) + ==> (\a. winding_number(subpath (vec 0) a g,z)) continuous_on + interval[vec 0,vec 1]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC + `\a. Cx(&1) / (Cx(&2) * Cx pi * ii) * + integral (interval[vec 0,a]) + (\t. Cx(&1) / (g t - z) * vector_derivative g (at t))` THEN + CONJ_TAC THENL + [X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `Cx(&1) / (Cx(&2) * Cx pi * ii) * + path_integral (subpath (vec 0) a g) (\w. Cx(&1) / (w - z))` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PATH_INTEGRAL_SUBPATH_INTEGRAL THEN + ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; PATH_INTEGRABLE_INVERSEDIFF] THEN + ASM_MESON_TAC[IN_INTERVAL_1]; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC WINDING_NUMBER_VALID_PATH THEN + ASM_MESON_TAC[VALID_PATH_SUBPATH; SUBSET; VALID_PATH_IMP_PATH; + ENDS_IN_UNIT_INTERVAL; PATH_IMAGE_SUBPATH_SUBSET]]; + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + REWRITE_TAC[GSYM PATH_INTEGRABLE_ON] THEN + ASM_SIMP_TAC[PATH_INTEGRABLE_INVERSEDIFF]]);; + +let WINDING_NUMBER_IVT_POS = prove + (`!g z w. + valid_path g /\ ~(z IN path_image g) /\ + &0 <= w /\ w <= Re(winding_number(g,z)) + ==> ?t. t IN interval[vec 0,vec 1] /\ + Re(winding_number(subpath (vec 0) t g,z)) = w`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN + ASM_SIMP_TAC[WINDING_NUMBER_SUBPATH_CONTINUOUS] THEN + ASM_REWRITE_TAC[SUBPATH_TRIVIAL; GSYM RE_DEF; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[DROP_VEC; REAL_POS; SUBPATH_REFL] THEN + MP_TAC(ISPECL [`(g:real^1->complex) (vec 0)`; `z:complex`] + WINDING_NUMBER_TRIVIAL) THEN + ASM_MESON_TAC[pathstart; PATHSTART_IN_PATH_IMAGE; RE_CX]);; + +let WINDING_NUMBER_IVT_NEG = prove + (`!g z w. + valid_path g /\ ~(z IN path_image g) /\ + Re(winding_number(g,z)) <= w /\ w <= &0 + ==> ?t. t IN interval[vec 0,vec 1] /\ + Re(winding_number(subpath (vec 0) t g,z)) = w`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC IVT_DECREASING_COMPONENT_ON_1 THEN + ASM_SIMP_TAC[WINDING_NUMBER_SUBPATH_CONTINUOUS] THEN + ASM_REWRITE_TAC[SUBPATH_TRIVIAL; GSYM RE_DEF; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[DROP_VEC; REAL_POS; SUBPATH_REFL] THEN + MP_TAC(ISPECL [`(g:real^1->complex) (vec 0)`; `z:complex`] + WINDING_NUMBER_TRIVIAL) THEN + ASM_MESON_TAC[pathstart; PATHSTART_IN_PATH_IMAGE; RE_CX]);; + +let WINDING_NUMBER_IVT_ABS = prove + (`!g z w. + valid_path g /\ ~(z IN path_image g) /\ + &0 <= w /\ w <= abs(Re(winding_number(g,z))) + ==> ?t. t IN interval[vec 0,vec 1] /\ + abs(Re(winding_number(subpath (vec 0) t g,z))) = w`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= Re(winding_number(g,z))` THEN + ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `w:real`] + WINDING_NUMBER_IVT_POS); + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `--w:real`] + WINDING_NUMBER_IVT_NEG)] THEN + (ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let WINDING_NUMBER_LT_HALF = prove + (`!g z a b. + valid_path g /\ a dot z <= b /\ path_image g SUBSET {w | a dot w > b} + ==> abs(Re(winding_number(g,z))) < &1 / &2`, + let lemma = prove + (`!g z a b. + valid_path g /\ ~(z IN path_image g) /\ + a dot z <= b /\ path_image g SUBSET {w | a dot w > b} + ==> Re(winding_number(g,z)) < &1 / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `&1 / &2`] + WINDING_NUMBER_IVT_POS) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`subpath (vec 0) t (g:real^1->complex)`; `z:complex`] + WINDING_NUMBER_AHLFORS_FULL) THEN + ASM_SIMP_TAC[VALID_PATH_SUBPATH; VALID_PATH_IMP_PATH; + ENDS_IN_UNIT_INTERVAL; NOT_IMP] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(z IN t) ==> s SUBSET t ==> ~(z IN s)`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; ENDS_IN_UNIT_INTERVAL; + VALID_PATH_IMP_PATH]; + ASM_REWRITE_TAC[EULER; RE_MUL_CX; RE_MUL_II; IM_MUL_CX; IM_MUL_II] THEN + REWRITE_TAC[REAL_ARITH `&2 * pi * &1 / &2 = pi`; SIN_PI; COS_PI] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_RID; GSYM COMPLEX_CMUL] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 < a dot ((g:real^1->complex) t - z) /\ + &0 < a dot (g(vec 0) - z)` + MP_TAC THENL + [REWRITE_TAC[DOT_RSUB; REAL_SUB_LT] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `b:real` THEN + ASM_REWRITE_TAC[GSYM real_gt] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `g SUBSET {z | a dot z > b} ==> t IN g ==> a dot t > b`)) THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; + ASM_REWRITE_TAC[DOT_RMUL] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(&0 < -- x)`) THEN + REWRITE_TAC[REAL_EXP_POS_LT]]]) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN + DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH `x < a /\ --x < a ==> abs x < a`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[lemma]; ALL_TAC] THEN + MP_TAC(ISPECL [`reversepath g:real^1->complex`; `z:complex`; + `a:complex`; `b:real`] lemma) THEN + ASM_SIMP_TAC[VALID_PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; + WINDING_NUMBER_REVERSEPATH; VALID_PATH_IMP_PATH; RE_NEG] THEN + REAL_ARITH_TAC);; + +let WINDING_NUMBER_LE_HALF = prove + (`!g z a b. + valid_path g /\ ~(z IN path_image g) /\ + ~(a = vec 0) /\ a dot z <= b /\ path_image g SUBSET {w | a dot w >= b} + ==> abs(Re(winding_number(g,z))) <= &1 / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] + CONTINUOUS_AT_WINDING_NUMBER) THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH; continuous_at] THEN + DISCH_THEN(MP_TAC o SPEC `abs(Re(winding_number(g,z))) - &1 / &2`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z - d / &2 / norm(a) % a:complex`) THEN + REWRITE_TAC[NORM_ARITH `dist(z - d:complex,z) = norm d`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; + NORM_EQ_0; NOT_IMP] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `abs(Re w' - Re w) <= norm(w' - w) /\ abs(Re w') < &1 / &2 + ==> ~(dist(w',w) < abs(Re w) - &1 / &2)`) THEN + REWRITE_TAC[GSYM RE_SUB] THEN CONJ_TAC THENL + [SIMP_TAC[COMPONENT_LE_NORM; RE_DEF; DIMINDEX_2; ARITH]; ALL_TAC] THEN + MATCH_MP_TAC WINDING_NUMBER_LT_HALF THEN EXISTS_TAC `a:complex` THEN + EXISTS_TAC `b - d / &3 * norm(a:complex)` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[DOT_RSUB; DOT_RMUL; GSYM NORM_POW_2] THEN + ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD + `~(a = &0) ==> x / a * a pow 2 = x * a`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a:real <= b ==> d <= e ==> a - e <= b - d`)) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < e ==> !x. a dot x >= b ==> a dot x > b - e`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[NORM_POS_LT] THEN + ASM_REAL_ARITH_TAC]);; + +let WINDING_NUMBER_LT_HALF_LINEPATH = prove + (`!a b z. + ~(z IN segment[a,b]) + ==> abs(Re(winding_number(linepath(a,b),z))) < &1 / &2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_HALF THEN + MP_TAC(ISPECL [`segment[a:complex,b]`; `z:complex`] + SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + ASM_REWRITE_TAC[CONVEX_SEGMENT; CLOSED_SEGMENT] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH; SUBSET; IN_ELIM_THM; + REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Positivity of WN for a linepath. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_LINEPATH_POS_LT = prove + (`!a b z. &0 < Im((b - a) * cnj(b - z)) + ==> &0 < Re(winding_number(linepath(a,b),z))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_POS_LT THEN + EXISTS_TAC `Im((b - a) * cnj(b - z))` THEN + ASM_REWRITE_TAC[VALID_PATH_LINEPATH; VECTOR_DERIVATIVE_LINEPATH_AT] THEN + CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SPEC_TAC(`z:complex`,`z:complex`) THEN + REWRITE_TAC[path_image; FORALL_IN_IMAGE; linepath] THEN + REWRITE_TAC[VECTOR_ARITH + `b - ((&1 - x) % a + x % b) = (&1 - x) % (b - a)`] THEN + REWRITE_TAC[COMPLEX_CMUL; CNJ_MUL; CNJ_CX] THEN + REWRITE_TAC[COMPLEX_RING `a * Cx x * cnj a = Cx x * a * cnj a`] THEN + SIMP_TAC[COMPLEX_MUL_CNJ; GSYM CX_POW; GSYM CX_MUL; IM_CX; REAL_LT_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `segment[a,b] SUBSET + {y | Im((b - a) * cnj(b - z)) <= Im((b - a) * cnj(y - z))}` + MP_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{a,b} SUBSET {y | P y} <=> P a /\ P b`] THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[cnj; complex_mul; RE; IM; RE_SUB; IM_SUB] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB; IM_SUB; CNJ_SUB; REAL_LE_SUB_LADD] THEN + REWRITE_TAC[CONVEX_ALT; cnj; complex_mul; RE; IM; RE_SUB; IM_SUB] THEN + REWRITE_TAC[IN_ELIM_THM; IM_ADD; RE_ADD; IM_CMUL; RE_CMUL] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_RMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `e <= ab * ((&1 - u) * x + u * y) + ab' * ((&1 - u) * x' + u * y') <=> + (&1 - u) * e + u * e <= + (&1 - u) * (ab * x + ab' * x') + u * (ab * y + ab' * y')`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* Winding number for a triangle. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_TRIANGLE = prove + (`!a b c z. + z IN interior(convex hull {a,b,c}) + ==> winding_number(linepath(a,b) ++ linepath(b,c) ++ linepath(c,a),z) = + if &0 < Im((b - a) * cnj (b - z)) then Cx(&1) else --Cx(&1)`, + let lemma1 = prove + (`!a b c. vec 0 IN interior(convex hull {a,b,c}) + ==> ~(Im(a / b) <= &0 /\ &0 <= Im(b / c))`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN SIMP_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [GSYM COMPLEX_INV_DIV] THEN + REWRITE_TAC[IM_COMPLEX_INV_GE_0] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:complex` THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; GSYM CX_MUL; REAL_MUL_RID] THEN + X_GEN_TAC `x:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + REWRITE_TAC[IM_DIV_CX] THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[NOT_IN_INTERIOR_CONVEX_HULL_3; COMPLEX_VEC_0] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LZERO] THEN STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `!s. ~(x IN s) /\ t SUBSET s ==> ~(x IN t)`) THEN + EXISTS_TAC `interior {z | Im z <= &0}` THEN CONJ_TAC THENL + [REWRITE_TAC[IM_DEF; INTERIOR_HALFSPACE_COMPONENT_LE] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; IN_ELIM_THM; VEC_COMPONENT] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_HALFSPACE_IM_LE] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[IM_CX; REAL_LE_REFL]]) in + let lemma2 = prove + (`z IN interior(convex hull {a,b,c}) + ==> &0 < Im((b - a) * cnj (b - z)) /\ + &0 < Im((c - b) * cnj (c - z)) /\ + &0 < Im((a - c) * cnj (a - z)) \/ + Im((b - a) * cnj (b - z)) < &0 /\ + &0 < Im((b - c) * cnj (b - z)) /\ + &0 < Im((a - b) * cnj (a - z)) /\ + &0 < Im((c - a) * cnj (c - z))`, + GEOM_ORIGIN_TAC `z:complex` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; COMPLEX_SUB_RDISTRIB] THEN + REWRITE_TAC[COMPLEX_MUL_CNJ; IM_SUB; GSYM CX_POW; IM_CX] THEN + REWRITE_TAC[REAL_ARITH `&0 < &0 - x <=> x < &0`; + REAL_ARITH `&0 - x < &0 <=> &0 < x`] THEN + REWRITE_TAC[GSYM IM_COMPLEX_DIV_GT_0; GSYM IM_COMPLEX_DIV_LT_0] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_INV_DIV] THEN + REWRITE_TAC[IM_COMPLEX_INV_LT_0; IM_COMPLEX_INV_GT_0] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV o RAND_CONV) + [GSYM COMPLEX_INV_DIV] THEN + REWRITE_TAC[IM_COMPLEX_INV_LT_0] THEN + MP_TAC(ISPECL [`a:complex`; `b:complex`; `c:complex`] lemma1) THEN + MP_TAC(ISPECL [`b:complex`; `c:complex`; `a:complex`] lemma1) THEN + MP_TAC(ISPECL [`c:complex`; `a:complex`; `b:complex`] lemma1) THEN + POP_ASSUM MP_TAC THEN SIMP_TAC[INSERT_AC] THEN REAL_ARITH_TAC) in + let lemma3 = prove + (`!a b c z. + z IN interior(convex hull {a,b,c}) /\ + &0 < Im((b - a) * cnj (b - z)) /\ + &0 < Im((c - b) * cnj (c - z)) /\ + &0 < Im((a - c) * cnj (a - z)) + ==> winding_number + (linepath(a,b) ++ linepath(b,c) ++ linepath(c,a),z) = Cx(&1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC WINDING_NUMBER_EQ_1 THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; CONJ_ASSOC; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM CONJ_ASSOC] THEN + REPEAT(MATCH_MP_TAC WINDING_NUMBER_JOIN_POS_COMBINED THEN + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + CONJ_TAC) THEN + ASM_SIMP_TAC[WINDING_NUMBER_LINEPATH_POS_LT; VALID_PATH_LINEPATH] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]; + RULE_ASSUM_TAC(REWRITE_RULE + [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN + ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_IMAGE_JOIN; PATH_JOIN; IN_UNION; + PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; RE_ADD; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN + MATCH_MP_TAC(REAL_ARITH + `abs a < &1 / &2 /\ abs b < &1 / &2 /\ abs c < &1 / &2 + ==> a + b + c < &2`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_LT_HALF_LINEPATH THEN + ASM_REWRITE_TAC[]]) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP lemma2) THEN + ASM_SIMP_TAC[lemma3; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + SUBGOAL_THEN + `winding_number + (linepath(c,b) ++ linepath(b,a) ++ linepath(a,c),z) = Cx(&1)` + MP_TAC THENL + [MATCH_MP_TAC lemma3 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[INSERT_AC]; + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN + FIRST_ASSUM(ASSUME_TAC o ONCE_REWRITE_RULE[SEGMENT_SYM] o CONJUNCT2) THEN + ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_IMAGE_JOIN; PATH_JOIN; IN_UNION; + PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; RE_ADD; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN + ASM_SIMP_TAC[COMPLEX_NEG_ADD; GSYM WINDING_NUMBER_REVERSEPATH; + PATH_IMAGE_LINEPATH; PATH_LINEPATH; REVERSEPATH_LINEPATH] THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy's integral formula, again for a convex enclosing set. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_INTEGRAL_FORMULA_WEAK = prove + (`!f s k g z. + convex s /\ FINITE k /\ f continuous_on s /\ + (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) /\ + z IN interior(s) DIFF k /\ + valid_path g /\ (path_image g) SUBSET (s DELETE z) /\ + pathfinish g = pathstart g + ==> ((\w. f(w) / (w - z)) has_path_integral + (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, + REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `z:complex`) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[complex_differentiable; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f':complex` THEN DISCH_TAC THEN MP_TAC(SPECL + [`\w:complex. if w = z then f' else (f w - f z) / (w - z)`; + `s:complex->bool`; + `(z:complex) INSERT k`; + `g:real^1->complex`] CAUCHY_THEOREM_CONVEX) THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; DE_MORGAN_THM] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[FINITE_INSERT] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\w:complex. (f w - f z) / (w - z)` THEN + EXISTS_TAC `dist(w:complex,z)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN + CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_CONST; + COMPLEX_DIFFERENTIABLE_ID]; + ASM SET_TAC[]] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `w:complex = z` THENL + [ALL_TAC; + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN + EXISTS_TAC `\w:complex. (f w - f z) / (w - z)` THEN + EXISTS_TAC `dist(w:complex,z)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN + CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV_WITHIN THEN + RULE_ASSUM_TAC(REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN + ASM_SIMP_TAC[CONTINUOUS_CONST; CONTINUOUS_SUB; CONTINUOUS_WITHIN_ID; + ETA_AX; COMPLEX_SUB_0]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN + MATCH_MP_TAC LIM_TRANSFORM_AWAY_WITHIN THEN + EXISTS_TAC `\w:complex. (f w - f z) / (w - z)` THEN SIMP_TAC[] THEN + EXISTS_TAC `z + Cx(&1)` THEN + CONJ_TAC THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_WITHIN] THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; + ALL_TAC] THEN + MP_TAC(SPECL [`g:real^1->complex`; `z:complex`] + HAS_PATH_INTEGRAL_WINDING_NUMBER) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `(f:complex->complex) z` o MATCH_MP + HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_ADD) THEN + REWRITE_TAC[COMPLEX_RING + `f * Cx(&2) * a * b * c + Cx(&0) = Cx(&2) * a * b * c * f`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(w:complex = z)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_FIELD);; + +let CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE = prove + (`!f s g z. + convex s /\ f holomorphic_on s /\ + z IN interior(s) /\ + valid_path g /\ (path_image g) SUBSET (s DELETE z) /\ + pathfinish g = pathstart g + ==> ((\w. f(w) / (w - z)) has_path_integral + (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_INTEGRAL_FORMULA_WEAK THEN + MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN + ASM_REWRITE_TAC[DIFF_EMPTY; FINITE_RULES] THEN + SIMP_TAC[OPEN_INTERIOR; complex_differentiable; GSYM HOLOMORPHIC_ON_OPEN] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + HOLOMORPHIC_ON_SUBSET; INTERIOR_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy forms of Cauchy's theorem. The first two proofs are almost the *) +(* same and could potentially be unified with a little more work. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_THEOREM_HOMOTOPIC_PATHS = prove + (`!f g h s. + open s /\ f holomorphic_on s /\ + valid_path g /\ valid_path h /\ homotopic_paths s g h + ==> path_integral g f = path_integral h f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + FIRST_ASSUM(ASSUME_TAC o SYM o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN + REWRITE_TAC[homotopic_with; LEFT_IMP_EXISTS_THM; PCROSS] THEN + X_GEN_TAC `k:real^(1,1)finite_sum->complex` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!t. t IN interval[vec 0:real^1,vec 1] + ==> ?e. &0 < e /\ + !t1 t2. t1 IN interval[vec 0:real^1,vec 1] /\ + t2 IN interval[vec 0,vec 1] /\ + norm(t1 - t) < e /\ norm(t2 - t) < e + ==> ?d. &0 < d /\ + !g1 g2. valid_path g1 /\ valid_path g2 /\ + (!u. u IN interval[vec 0,vec 1] + ==> norm(g1 u - k(pastecart t1 u)) < d /\ + norm(g2 u - k(pastecart t2 u)) < d) /\ + pathstart g1 = pathstart g /\ + pathfinish g1 = pathfinish g /\ + pathstart g2 = pathstart g /\ + pathfinish g2 = pathfinish g + ==> path_image g1 SUBSET s /\ + path_image g2 SUBSET s /\ + path_integral g2 f = path_integral g1 f` + MP_TAC THENL + [X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:complex->bool`; `\u. (k:real^(1,1)finite_sum->complex)(pastecart t u)`] + PATH_INTEGRAL_NEARBY_ENDS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[path_image; path; IMAGE_o] THEN CONJ_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPACT_UNIFORMLY_CONTINUOUS)) THEN + SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_INTERVAL] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `(!t x t' x'. P t x t' x') ==> (!t t' u. P t u t' u)`)) THEN + REWRITE_TAC[dist; NORM_PASTECART; PASTECART_SUB] THEN + REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[TAUT `a /\ b /\ c /\ b /\ d <=> a /\ c /\ b /\ d`] THEN + SIMP_TAC[REAL_ADD_RID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN + STRIP_TAC THEN EXISTS_TAC `e / &4` THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + MAP_EVERY X_GEN_TAC [`g1:real^1->complex`; `g2:real^1->complex`] THEN + STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`g1:real^1->complex`; `g2:real^1->complex`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN + ASM_MESON_TAC[NORM_ARITH + `norm(g1 - k1) < e / &4 /\ norm(g2 - k2) < e / &4 /\ + norm(k1 - kt) < e / &4 /\ norm(k2 - kt) < e / &4 + ==> norm(g1 - kt) < e /\ norm(g2 - kt) < e`]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[ SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `ee:real^1->real` THEN DISCH_THEN(LABEL_TAC "*") THEN + MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` COMPACT_IMP_HEINE_BOREL) THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\t:real^1. ball(t,ee t / &3)) (interval[vec 0,vec 1])`) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; SUBSET] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `t:real^1` THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_ARITH `&0 < e / &3 <=> &0 < e`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; MESON[] + `(?f s. (P s /\ f = g s) /\ Q f) <=> ?s. P s /\ Q(g s)`] THEN + REWRITE_TAC[UNIONS_IMAGE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:real^1->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC `k:real^1->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN REAL_ARITH_TAC; + DISCH_THEN(LABEL_TAC "+")] THEN + SUBGOAL_THEN `!i:real^1. i IN k ==> &0 < ee(i)` + ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + ABBREV_TAC `e = inf(IMAGE (ee:real^1->real) k)` THEN + MP_TAC(ISPEC `IMAGE (ee:real^1->real) k` INF_FINITE) THEN + MP_TAC(ISPECL [`IMAGE (ee:real^1->real) k`; `&0`] + REAL_LT_INF_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN + MP_TAC(ISPEC `e / &3` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!n. n <= N + ==> ?d. &0 < d /\ + !j. valid_path j /\ + (!u. u IN interval [vec 0,vec 1] + ==> norm(j u - k(pastecart (lift(&n / &N)) u)) < d) /\ + pathstart j = pathstart g /\ + pathfinish j = pathfinish g + ==> path_image j SUBSET s /\ + path_integral j f = path_integral g f` + (MP_TAC o SPEC `N:num`) THENL + [ALL_TAC; + REWRITE_TAC[LE_REFL; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `h:real^1->complex`) THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM] THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]] THEN + INDUCT_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `vec 0:real^1`) THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; LE_0; LIFT_NUM] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REPEAT(DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `j:real^1->complex` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`g:real^1->complex`; `j:real^1->complex`]) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]; + DISCH_TAC] THEN + SUBGOAL_THEN `lift(&n / &N) IN interval[vec 0,vec 1] /\ + lift(&(SUC n) / &N) IN interval[vec 0,vec 1]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REMOVE_THEN "+" (MP_TAC o SPEC `lift(&n / &N)`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `t:real^1`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`lift(&n / &N)`; `lift(&(SUC n) / &N)`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + MATCH_MP_TAC(NORM_ARITH + `!e. norm(n' - n:real^N) < e / &3 /\ e <= ee + ==> dist(t,n) < ee / &3 ==> norm(n - t) < ee /\ norm(n' - t) < ee`) THEN + EXISTS_TAC `e:real` THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP] THEN + REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN + SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `n <= SUC n`] THEN + REWRITE_TAC[ARITH_RULE `SUC n - n = 1`; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[GSYM real_div]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d2:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:real^1->complex` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\u:real^1. (k(pastecart (lift (&n / &N)) u):complex)`; + `min d1 d2`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + ANTS_TAC THENL + [REWRITE_TAC[path] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC)] THEN + REMOVE_THEN "1" (MP_TAC o SPEC `p:real^1->complex`) THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `j:real^1->complex`]) THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]);; + +let CAUCHY_THEOREM_HOMOTOPIC_LOOPS = prove + (`!f g h s. + open s /\ f holomorphic_on s /\ + valid_path g /\ valid_path h /\ homotopic_loops s g h + ==> path_integral g f = path_integral h f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN + REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:real^(1,1)finite_sum->complex` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!t. t IN interval[vec 0:real^1,vec 1] + ==> ?e. &0 < e /\ + !t1 t2. t1 IN interval[vec 0:real^1,vec 1] /\ + t2 IN interval[vec 0,vec 1] /\ + norm(t1 - t) < e /\ norm(t2 - t) < e + ==> ?d. &0 < d /\ + !g1 g2. valid_path g1 /\ valid_path g2 /\ + (!u. u IN interval[vec 0,vec 1] + ==> norm(g1 u - k(pastecart t1 u)) < d /\ + norm(g2 u - k(pastecart t2 u)) < d) /\ + pathfinish g1 = pathstart g1 /\ + pathfinish g2 = pathstart g2 + ==> path_image g1 SUBSET s /\ + path_image g2 SUBSET s /\ + path_integral g2 f = path_integral g1 f` + MP_TAC THENL + [X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:complex->bool`; `\u. (k:real^(1,1)finite_sum->complex)(pastecart t u)`] + PATH_INTEGRAL_NEARBY_LOOP) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[path_image; path; IMAGE_o] THEN CONJ_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPACT_UNIFORMLY_CONTINUOUS)) THEN + SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_INTERVAL] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `(!t x t' x'. P t x t' x') ==> (!t t' u. P t u t' u)`)) THEN + REWRITE_TAC[dist; NORM_PASTECART; PASTECART_SUB] THEN + REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[TAUT `a /\ b /\ c /\ b /\ d <=> a /\ c /\ b /\ d`] THEN + SIMP_TAC[REAL_ADD_RID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN + STRIP_TAC THEN EXISTS_TAC `e / &4` THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + MAP_EVERY X_GEN_TAC [`g1:real^1->complex`; `g2:real^1->complex`] THEN + STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`g1:real^1->complex`; `g2:real^1->complex`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN + ASM_MESON_TAC[NORM_ARITH + `norm(g1 - k1) < e / &4 /\ norm(g2 - k2) < e / &4 /\ + norm(k1 - kt) < e / &4 /\ norm(k2 - kt) < e / &4 + ==> norm(g1 - kt) < e /\ norm(g2 - kt) < e`]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[ SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `ee:real^1->real` THEN DISCH_THEN(LABEL_TAC "*") THEN + MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` COMPACT_IMP_HEINE_BOREL) THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\t:real^1. ball(t,ee t / &3)) (interval[vec 0,vec 1])`) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; SUBSET] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN EXISTS_TAC `t:real^1` THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_ARITH `&0 < e / &3 <=> &0 < e`]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; MESON[] + `(?f s. (P s /\ f = g s) /\ Q f) <=> ?s. P s /\ Q(g s)`] THEN + REWRITE_TAC[UNIONS_IMAGE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:real^1->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC `k:real^1->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN REAL_ARITH_TAC; + DISCH_THEN(LABEL_TAC "+")] THEN + SUBGOAL_THEN `!i:real^1. i IN k ==> &0 < ee(i)` + ASSUME_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + ABBREV_TAC `e = inf(IMAGE (ee:real^1->real) k)` THEN + MP_TAC(ISPEC `IMAGE (ee:real^1->real) k` INF_FINITE) THEN + MP_TAC(ISPECL [`IMAGE (ee:real^1->real) k`; `&0`] + REAL_LT_INF_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + DISCH_TAC THEN DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN + MP_TAC(ISPEC `e / &3` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!n. n <= N + ==> ?d. &0 < d /\ + !j. valid_path j /\ + (!u. u IN interval [vec 0,vec 1] + ==> norm(j u - k(pastecart (lift(&n / &N)) u)) < d) /\ + pathfinish j = pathstart j + ==> path_image j SUBSET s /\ + path_integral j f = path_integral g f` + (MP_TAC o SPEC `N:num`) THENL + [ALL_TAC; + REWRITE_TAC[LE_REFL; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `h:real^1->complex`) THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM] THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]] THEN + INDUCT_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `vec 0:real^1`) THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; LE_0; LIFT_NUM] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REPEAT(DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `j:real^1->complex` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`g:real^1->complex`; `j:real^1->complex`]) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN MESON_TAC[]; + DISCH_TAC] THEN + SUBGOAL_THEN `lift(&n / &N) IN interval[vec 0,vec 1] /\ + lift(&(SUC n) / &N) IN interval[vec 0,vec 1]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REMOVE_THEN "+" (MP_TAC o SPEC `lift(&n / &N)`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `t:real^1`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`lift(&n / &N)`; `lift(&(SUC n) / &N)`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + MATCH_MP_TAC(NORM_ARITH + `!e. norm(n' - n:real^N) < e / &3 /\ e <= ee + ==> dist(t,n) < ee / &3 ==> norm(n - t) < ee /\ norm(n' - t) < ee`) THEN + EXISTS_TAC `e:real` THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP] THEN + REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN + SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `n <= SUC n`] THEN + REWRITE_TAC[ARITH_RULE `SUC n - n = 1`; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[GSYM real_div]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d2:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:real^1->complex` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\u:real^1. (k(pastecart (lift (&n / &N)) u):complex)`; + `min d1 d2`] PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + ANTS_TAC THENL + [REWRITE_TAC[path] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC)] THEN + REMOVE_THEN "1" (MP_TAC o SPEC `p:real^1->complex`) THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`p:real^1->complex`; `j:real^1->complex`]) THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]);; + +let CAUCHY_THEOREM_NULL_HOMOTOPIC = prove + (`!f g s a. + open s /\ f holomorphic_on s /\ a IN s /\ valid_path g /\ + homotopic_loops s g (linepath(a,a)) + ==> (f has_path_integral Cx(&0)) g`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN + MATCH_MP_TAC + (MESON[HAS_PATH_INTEGRAL_INTEGRAL; path_integrable_on; PATH_INTEGRAL_UNIQUE] + `!p. f path_integrable_on g /\ (f has_path_integral y) p /\ + path_integral g f = path_integral p f + ==> (f has_path_integral y) g`) THEN + EXISTS_TAC `linepath(a:complex,a)` THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE]; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CAUCHY_THEOREM_CONVEX_SIMPLE THEN + EXISTS_TAC `ball(a:complex,e)` THEN + ASM_REWRITE_TAC[VALID_PATH_LINEPATH; CONVEX_BALL; PATH_IMAGE_LINEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[SEGMENT_REFL; SING_SUBSET; IN_BALL; CENTRE_IN_BALL] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; + MATCH_MP_TAC CAUCHY_THEOREM_HOMOTOPIC_LOOPS THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[VALID_PATH_LINEPATH]]);; + +let CAUCHY_THEOREM_SIMPLY_CONNECTED = prove + (`!f g s. open s /\ simply_connected s /\ f holomorphic_on s /\ + valid_path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g + ==> (f has_path_integral Cx(&0)) g`, + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CAUCHY_THEOREM_NULL_HOMOTOPIC THEN + MAP_EVERY EXISTS_TAC [`s:complex->bool`; `pathstart g :complex`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; + MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN + ASM_SIMP_TAC[PATHFINISH_LINEPATH; VALID_PATH_IMP_PATH]]);; + +(* ------------------------------------------------------------------------- *) +(* More winding number properties, including the fact that it's +-1 inside *) +(* a simple closed curve. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_HOMOTOPIC_PATHS = prove + (`!g h z. homotopic_paths ((:complex) DELETE z) g h + ==> winding_number(g,z) = winding_number(h,z)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `(:complex) DELETE z`] + HOMOTOPIC_NEARBY_PATHS) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE + `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `d:real`] + WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:real^1->complex`; `(:complex) DELETE z`] + HOMOTOPIC_NEARBY_PATHS) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE + `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `path_integral p (\w. Cx(&1) / (w - z)) = + path_integral q (\w. Cx(&1) / (w - z))` + MP_TAC THENL + [MATCH_MP_TAC CAUCHY_THEOREM_HOMOTOPIC_PATHS THEN + EXISTS_TAC `(:complex) DELETE z` THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_SUB; IN_DELETE; COMPLEX_SUB_0]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `g:real^1->complex` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]; + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `h:real^1->complex` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]]; + ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_RING]);; + +let WINDING_NUMBER_HOMOTOPIC_LOOPS = prove + (`!g h z. homotopic_loops ((:complex) DELETE z) g h + ==> winding_number(g,z) = winding_number(h,z)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `(:complex) DELETE z`] + HOMOTOPIC_NEARBY_LOOPS) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE + `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`; `d:real`] + WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:real^1->complex`; `(:complex) DELETE z`] + HOMOTOPIC_NEARBY_LOOPS) THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV; SET_RULE + `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:real^1->complex`; `z:complex`; `e:real`] + WINDING_NUMBER) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `path_integral p (\w. Cx(&1) / (w - z)) = + path_integral q (\w. Cx(&1) / (w - z))` + MP_TAC THENL + [MATCH_MP_TAC CAUCHY_THEOREM_HOMOTOPIC_LOOPS THEN + EXISTS_TAC `(:complex) DELETE z` THEN + ASM_SIMP_TAC[OPEN_DELETE; OPEN_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_SUB; IN_DELETE; COMPLEX_SUB_0]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `g:real^1->complex` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]; + MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `h:real^1->complex` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[NORM_SUB; VALID_PATH_IMP_PATH]]; + ASM_REWRITE_TAC[] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_RING]);; + +let WINDING_NUMBER_PATHS_LINEAR_EQ = prove + (`!g h z. + path g /\ path h /\ + pathstart h = pathstart g /\ + pathfinish h = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] ==> ~(z IN segment[g t,h t])) + ==> winding_number(h,z) = winding_number(g,z)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR THEN ASM SET_TAC[]);; + +let WINDING_NUMBER_LOOPS_LINEAR_EQ = prove + (`!g h z. + path g /\ path h /\ + pathfinish g = pathstart g /\ + pathfinish h = pathstart h /\ + (!t. t IN interval[vec 0,vec 1] ==> ~(z IN segment[g t,h t])) + ==> winding_number(h,z) = winding_number(g,z)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_LOOPS THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR THEN ASM SET_TAC[]);; + +let WINDING_NUMBER_NEARBY_PATHS_EQ = prove + (`!g h z. + path g /\ path h /\ + pathstart h = pathstart g /\ + pathfinish h = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < norm(g t - z)) + ==> winding_number(h,z) = winding_number(g,z)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT THEN ASM SET_TAC[]);; + +let WINDING_NUMBER_NEARBY_LOOPS_EQ = prove + (`!g h z. + path g /\ path h /\ + pathfinish g = pathstart g /\ + pathfinish h = pathstart h /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < norm(g t - z)) + ==> winding_number(h,z) = winding_number(g,z)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_LOOPS THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT THEN ASM SET_TAC[]);; + +let WINDING_NUMBER_SUBPATH_COMBINE = prove + (`!g u v w z. + path g /\ ~(z IN path_image g) /\ + u IN interval [vec 0,vec 1] /\ + v IN interval [vec 0,vec 1] /\ + w IN interval [vec 0,vec 1] + ==> winding_number(subpath u v g,z) + + winding_number(subpath v w g,z) = + winding_number(subpath u w g,z)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `winding_number(subpath u v g ++ subpath v w g,z)` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_JOIN THEN + ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + ASM_MESON_TAC[SUBSET; PATH_IMAGE_SUBPATH_SUBSET]; + MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN + MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +let WINDING_NUMBER_STRONG = prove + (`!g z e. + path g /\ ~(z IN path_image g) /\ &0 < e + ==> ?p. vector_polynomial_function p /\ valid_path p /\ + ~(z IN path_image p) /\ + pathstart p = pathstart g /\ + pathfinish p = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(g t - p t) < e) /\ + path_integral p (\w. Cx(&1) / (w - z)) = + Cx(&2) * Cx(pi) * ii * winding_number(g,z)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?d. &0 < d /\ + !t. t IN interval[vec 0,vec 1] ==> d <= norm((g:real^1->complex) t - z)` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `setdist({z:complex},path_image g)` THEN + REWRITE_TAC[SETDIST_POS_LE; REAL_ARITH + `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + ASM_SIMP_TAC[SETDIST_EQ_0_CLOSED_COMPACT; CLOSED_SING; COMPACT_PATH_IMAGE; + PATH_IMAGE_NONEMPTY] THEN + CONJ_TAC THENL [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN + MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[path_image] THEN + ASM SET_TAC[]; + MP_TAC(ISPECL [`g:real^1->complex`; `min d e`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[path_image; IN_IMAGE] THEN + ASM_MESON_TAC[NORM_SUB; REAL_NOT_LT]; + DISCH_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `!w'. ~(a * b * c = Cx(&0)) /\ w' = w /\ w' = Cx(&1) / (a * b * c) * i + ==> i = a * b * c * w`) THEN + EXISTS_TAC `winding_number(p,z)` THEN + REWRITE_TAC[CX_2PII_NZ] THEN CONJ_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_NEARBY_PATHS_EQ; ALL_TAC] THEN + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; VALID_PATH_IMP_PATH; + VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + ASM_MESON_TAC[REAL_LTE_TRANS; NORM_SUB]]]);; + +let WINDING_NUMBER_FROM_INNERPATH = prove + (`!c1 c2 c a b z:complex d. + ~(a = b) /\ + simple_path c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\ + simple_path c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\ + simple_path c /\ pathstart c = a /\ pathfinish c = b /\ + path_image c1 INTER path_image c2 = {a,b} /\ + path_image c1 INTER path_image c = {a,b} /\ + path_image c2 INTER path_image c = {a,b} /\ + ~(path_image c INTER inside(path_image c1 UNION path_image c2) = {}) /\ + z IN inside(path_image c1 UNION path_image c) /\ + winding_number(c1 ++ reversepath c,z) = d /\ ~(d = Cx(&0)) + ==> z IN inside(path_image c1 UNION path_image c2) /\ + winding_number(c1 ++ reversepath c2,z) = d`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`c1:real^1->complex`; `c2:real^1->complex`; + `c:real^1->complex`; `a:complex`; `b:complex`] + SPLIT_INSIDE_SIMPLE_CLOSED_CURVE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `winding_number(c1 ++ reversepath c,z) = d` THEN + MP_TAC(ISPECL + [`c ++ reversepath(c2:real^1->complex)`; `z:complex`] + WINDING_NUMBER_ZERO_IN_OUTSIDE) THEN + SUBGOAL_THEN + `~((z:complex) IN path_image c) /\ + ~(z IN path_image c1) /\ + ~(z IN path_image c2)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `(path_image c1 UNION path_image c):complex->bool` + INSIDE_NO_OVERLAP) THEN + MP_TAC(ISPEC `(path_image c1 UNION path_image c2):complex->bool` + INSIDE_NO_OVERLAP) THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; + PATH_JOIN; PATH_REVERSEPATH; SIMPLE_PATH_IMP_PATH; + WINDING_NUMBER_JOIN; WINDING_NUMBER_REVERSEPATH] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN + ONCE_REWRITE_TAC[UNION_COMM] THEN ASM SET_TAC[]; + CONV_TAC COMPLEX_RING]]);; + +let SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE = prove + (`!g. simple_path g + ==> (!z. z IN inside(path_image g) ==> winding_number(g,z) = Cx(&1)) \/ + (!z. z IN inside(path_image g) ==> winding_number(g,z) = --Cx(&1))`, + let lemma1 = prove + (`!p a e. + &0 < e /\ + simple_path(p ++ linepath(a - e % basis 1,a + e % basis 1)) /\ + pathstart p = a + e % basis 1 /\ pathfinish p = a - e % basis 1 /\ + ball(a,e) INTER path_image p = {} + ==> ?z. z IN inside(path_image + (p ++ linepath(a - e % basis 1,a + e % basis 1))) /\ + norm(winding_number + (p ++ linepath(a - e % basis 1,a + e % basis 1),z)) = &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`p:real^1->complex`; `linepath(a - e % basis 1,a + e % basis 1)`] + SIMPLE_PATH_JOIN_LOOP_EQ) THEN + ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_LINEPATH] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(a:complex) IN frontier(inside + (path_image(p ++ linepath(a - e % basis 1,a + e % basis 1))))` + MP_TAC THENL + [FIRST_ASSUM + (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] JORDAN_INSIDE_OUTSIDE)) THEN + ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHFINISH_LINEPATH] THEN + STRIP_TAC THEN ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH] THEN + REWRITE_TAC[IN_UNION; PATH_IMAGE_LINEPATH] THEN DISJ2_TAC THEN + REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FRONTIER_STRADDLE] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:complex` STRIP_ASSUME_TAC o CONJUNCT1) THEN + MP_TAC(ISPEC + `path_image (p ++ linepath(a - e % basis 1:complex,a + e % basis 1))` + INSIDE_NO_OVERLAP) THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `c:complex`) THEN + ASM_REWRITE_TAC[IN_INTER; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH; PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SEGMENT_AS_BALL] THEN + ASM_REWRITE_TAC[IN_INTER; + VECTOR_ARITH `inv(&2) % ((a - e) + (a + e)):complex = a`; + VECTOR_ARITH `(a + e) - (a - e):complex = &2 % e`] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> (abs(&2) * abs e * &1) / &2 = e`] THEN + ASM_SIMP_TAC[IN_CBALL; REAL_LT_IMP_LE] THEN STRIP_TAC THEN + SUBGOAL_THEN + `~collinear{a - e % basis 1,c:complex,a + e % basis 1}` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`a - e % basis 1:complex`; `a + e % basis 1:complex`; `c:complex`] + COLLINEAR_3_AFFINE_HULL) THEN + ASM_SIMP_TAC[VECTOR_ARITH `a - x:complex = a + x <=> x = vec 0`; + BASIS_NONZERO; DIMINDEX_2; ARITH; VECTOR_MUL_EQ_0; + REAL_LT_IMP_NZ] THEN + REWRITE_TAC[INSERT_AC]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(interior(convex hull {a - e % basis 1,c:complex,a + e % basis 1}) = {})` + MP_TAC THENL + [ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3_MINIMAL] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + REPEAT(ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `&1 / &3`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o AP_TERM `norm:complex->real` o + MATCH_MP WINDING_NUMBER_TRIANGLE) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[NORM_NEG; COND_ID; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + DISCH_TAC THEN + MP_TAC(ISPECL + [`linepath(a + e % basis 1:complex,a - e % basis 1)`; + `p:real^1->complex`; + `linepath(a + e % basis 1:complex,c) ++ linepath(c,a - e % basis 1)`; + `a + e % basis 1:complex`; `a - e % basis 1:complex`; + `z:complex`; + `winding_number + (linepath(a - e % basis 1,c) ++ + linepath(c,a + e % basis 1) ++ + linepath(a + e % basis 1,a - e % basis 1), + z)`] WINDING_NUMBER_FROM_INNERPATH) THEN + ASM_SIMP_TAC[SIMPLE_PATH_LINEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; + VECTOR_ARITH `a + x:complex = a - x <=> x = vec 0`; + BASIS_NONZERO; DIMINDEX_2; ARITH; VECTOR_MUL_EQ_0; + REAL_LT_IMP_NZ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + ARC_IMP_SIMPLE_PATH; PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH] THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(TAUT + `(p ==> p') /\ (p /\ q ==> q') ==> p /\ q ==> p' /\ q'`) THEN + CONJ_TAC THENL [MESON_TAC[UNION_COMM; SEGMENT_SYM]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST_ALL_TAC o SYM)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `norm(z:complex) = &1 ==> u = --z ==> norm u = &1`)) THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [GSYM REVERSEPATH_LINEPATH] THEN + ASM_SIMP_TAC[GSYM REVERSEPATH_JOINPATHS; PATHSTART_LINEPATH] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a:complex = --b <=> b = --a`] THEN + MATCH_MP_TAC WINDING_NUMBER_REVERSEPATH THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_LINEPATH; PATH_IMAGE_JOIN; + PATH_LINEPATH; ARC_IMP_PATH; PATH_IMAGE_LINEPATH] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ARC_IMP_SIMPLE_PATH THEN MATCH_MP_TAC ARC_JOIN THEN + REWRITE_TAC[ARC_LINEPATH_EQ; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH] THEN + REPEAT(CONJ_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN + FIRST_X_ASSUM CONTR_TAC; + ALL_TAC]) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN + MATCH_MP_TAC INTER_SEGMENT THEN ASM_MESON_TAC[INSERT_AC]; + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b INTER p = {} + ==> s SUBSET b /\ k SUBSET p + ==> (s UNION k) INTER p = k`)) THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_SEGMENT; IN_BALL] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % (a + e) + u % (a - e):complex = + a + (&1 - &2 * u) % e`] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(a:complex,a + e) = norm e`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `x * e < &1 * e /\ &0 < e ==> x * abs e * &1 < e`) THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]; + MATCH_MP_TAC(SET_RULE + `s INTER t1 = {a} /\ s INTER t2 = {b} + ==> s INTER (t1 UNION t2) = {a,b}`) THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_SYM]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SEGMENT_SYM]] THEN + MATCH_MP_TAC INTER_SEGMENT THEN DISJ2_TAC THEN + ASM_MESON_TAC[INSERT_AC]; + MATCH_MP_TAC(SET_RULE + `s INTER t1 = {a} /\ s INTER t2 = {b} + ==> s INTER (t1 UNION t2) = {a,b}`) THEN + CONJ_TAC THENL [ONCE_REWRITE_TAC[SEGMENT_SYM]; ALL_TAC] THEN + REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + MATCH_MP_TAC(SET_RULE + `b IN p /\ ~(c IN p) /\ p INTER s = {} + ==> p INTER (s UNION {c,b}) = {b}`) THEN + (CONJ_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ASM_REWRITE_TAC[]]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b INTER p = {} ==> s SUBSET b ==> p INTER s = {}`)) THEN + REWRITE_TAC[GSYM INTERIOR_CBALL] THEN + MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN + ASM_REWRITE_TAC[CONVEX_CBALL; INTERIOR_CBALL; IN_BALL] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + REWRITE_TAC[IN_CBALL; + NORM_ARITH `dist(a:complex,a - e) = norm e`; + NORM_ARITH `dist(a:complex,a + e) = norm e`] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `c:complex` THEN + REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT; IN_UNION] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `c IN s ==> s = t ==> c IN t`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_LINEPATH] THEN + REWRITE_TAC[UNION_COMM; PATH_IMAGE_LINEPATH; SEGMENT_SYM]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM + INSIDE_OF_TRIANGLE]) THEN + REWRITE_TAC[UNION_ACI; SEGMENT_SYM]; + ASM_SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; REVERSEPATH_LINEPATH] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [INTERIOR_OF_TRIANGLE; IN_DIFF; IN_UNION; DE_MORGAN_THM]) THEN + ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_JOIN; PATH_LINEPATH; + PATH_IMAGE_JOIN; IN_UNION; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH] THEN + CONV_TAC COMPLEX_RING; + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [COMPLEX_NORM_CX]) THEN + REAL_ARITH_TAC]) in + let lemma2 = prove + (`!p a d e. + &0 < d /\ &0 < e /\ + simple_path(p ++ linepath(a - d % basis 1,a + e % basis 1)) /\ + pathstart p = a + e % basis 1 /\ pathfinish p = a - d % basis 1 + ==> ?z. z IN inside(path_image + (p ++ linepath(a - d % basis 1,a + e % basis 1))) /\ + norm(winding_number + (p ++ linepath(a - d % basis 1,a + e % basis 1),z)) = &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`p:real^1->complex`; `linepath(a - d % basis 1,a + e % basis 1)`] + SIMPLE_PATH_JOIN_LOOP_EQ) THEN + ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_LINEPATH] THEN + REWRITE_TAC[ARC_LINEPATH_EQ; PATH_IMAGE_LINEPATH] THEN STRIP_TAC THEN + SUBGOAL_THEN `~((a:complex) IN path_image p)` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `p INTER s SUBSET {d,e} + ==> a IN s /\ ~(d = a) /\ ~(e = a) ==> ~(a IN p)`)) THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; + NORM_ARITH `dist(a - d:complex,a) + dist(a,a + e) = norm(d) + norm(e)`; + VECTOR_ARITH `a + e:complex = a <=> e = vec 0`; + VECTOR_ARITH `a - d:complex = a <=> d = vec 0`] THEN + SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_EQ_0] THEN + ASM_SIMP_TAC[BASIS_NONZERO; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `(:complex) DIFF path_image p` OPEN_CONTAINS_BALL) THEN + ASM_SIMP_TAC[GSYM closed; CLOSED_ARC_IMAGE; IN_UNIV; IN_DIFF] THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `kde:real = min k (min d e) / &2` THEN + SUBGOAL_THEN `&0 < kde /\ kde < k /\ kde < d /\ kde < e` + STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`linepath(a + kde % basis 1,a + e % basis 1) ++ p ++ + linepath(a - d % basis 1,a - kde % basis 1)`; + `a:complex`; `kde:real`] lemma1) THEN + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; + SIMPLE_PATH_JOIN_LOOP_EQ] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ARC_JOIN THEN + ASM_SIMP_TAC[ARC_JOIN_EQ; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_LINEPATH; + ARC_LINEPATH_EQ; PATH_IMAGE_JOIN] THEN + REWRITE_TAC[VECTOR_ARITH `a + e:complex = a + d <=> e - d = vec 0`; + VECTOR_ARITH `a - d:complex = a - e <=> e - d = vec 0`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; VECTOR_MUL_EQ_0; REAL_SUB_0] THEN + ASM_SIMP_TAC[BASIS_NONZERO; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `p INTER de SUBSET {e,d} + ==> dk SUBSET de /\ ke SUBSET de /\ ~(e IN dk) /\ ~(d IN ke) /\ + ke INTER dk = {} + ==> p INTER dk SUBSET {d} /\ ke INTER (p UNION dk) SUBSET {e}`)) THEN + REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT] THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e) /\ + dist(a + d,a - e) = norm(d + e) /\ + dist(a - d,a - e) = norm(d - e) /\ + dist(a + d,a + e) = norm(d - e)`] THEN + REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(MESON[REAL_LT_ANTISYM] + `!a:complex. (!x. x IN t ==> x$1 < a$1) /\ (!x. x IN s ==> a$1 < x$1) + ==> !x. ~(x IN s /\ x IN t)`) THEN + EXISTS_TAC `a:complex` THEN + SIMP_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[REAL_ARITH + `(a < (&1 - u) * (a + x) + u * (a + y) <=> + &0 < (&1 - u) * x + u * y) /\ + ((&1 - u) * (a - x) + u * (a - y) < a <=> + &0 < (&1 - u) * x + u * y)`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `&0 < (&1 - u) * x + u * y <=> + (&1 - u) * --x + u * --y < &0`] THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[ARC_LINEPATH_EQ; VECTOR_MUL_EQ_0; + VECTOR_ARITH `a - k:complex = a + k <=> k = vec 0`] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_2; ARITH]; + MATCH_MP_TAC(SET_RULE + `kk INTER p = {} /\ kk INTER ke = {kp} /\ dk INTER kk = {kn} + ==> (ke UNION p UNION dk) INTER kk SUBSET {kp,kn}`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b INTER p = {} ==> s SUBSET b ==> s INTER p = {}`)) THEN + SIMP_TAC[SUBSET; IN_SEGMENT; IN_BALL; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % (a - d) + u % (a + d):complex = a - (&1 - &2 * u) % d`; + NORM_ARITH `dist(a:complex,a - d) = norm d`] THEN + REPEAT STRIP_TAC THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < kd /\ a * kd <= &1 * kd /\ kd < k + ==> a * abs kd * &1 < k`) THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN ASM_REAL_ARITH_TAC; + CONJ_TAC THEN MATCH_MP_TAC INTER_SEGMENT THEN DISJ1_TAC THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e) /\ + dist(a + d,a - e) = norm(d + e) /\ + dist(a - d,a - e) = norm(d - e) /\ + dist(a + d,a + e) = norm(d - e)`] THEN + REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[UNION_OVER_INTER; EMPTY_UNION] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b INTER p = {} ==> c SUBSET b ==> c INTER p = {}`)) THEN + MATCH_MP_TAC SUBSET_BALL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s INTER t = {} <=> + !x. x IN t ==> ~(x IN s)`] THEN + SIMP_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM; IN_BALL] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % (a - d) + u % (a - e):complex = + a - ((&1 - u) % d + u % e) /\ + (&1 - u) % (a + d) + u % (a + e):complex = + a + ((&1 - u) % d + u % e)`; + NORM_ARITH + `dist(a:complex,a + d) = norm d /\ dist(a,a - e) = norm e`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_MUL_RID] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN + REWRITE_TAC[REAL_ARITH + `(k <= (&1 - u) * k + u * e <=> &0 <= u * (e - k)) /\ + (k <= (&1 - u) * d + u * k <=> &0 <= (&1 - u) * (d - k))`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN + MATCH_MP_TAC(TAUT + `(p <=> p') /\ (p /\ p' ==> (q <=> q')) ==> p /\ q ==> p' /\ q'`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `(c UNION p UNION a) UNION b = p UNION (a UNION b UNION c)`] THEN + AP_TERM_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) UNION_SEGMENT o + rand o lhand o snd) THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between; + NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; + NORM_ARITH `dist(a + d:complex,a + e) = norm(d - e)`] THEN + ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB; + NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC UNION_SEGMENT THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between; + NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; + NORM_ARITH `dist(a - d:complex,a - e) = norm(d - e)`] THEN + ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB; + NORM_MUL; NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP + (MESON[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY] + `z IN inside s ==> ~(z IN s)`))) THEN + REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[WINDING_NUMBER_JOIN; PATH_JOIN; ARC_IMP_PATH; PATH_LINEPATH; + PATH_IMAGE_JOIN; IN_UNION; PATH_IMAGE_LINEPATH; PATHSTART_JOIN; + PATHFINISH_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + MATCH_MP_TAC(COMPLEX_RING + `d + k + e:complex = z ==> (e + p + d) + k = p + z`) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `winding_number(linepath (a - d % basis 1:complex,a - kde % basis 1),z) + + winding_number(linepath (a - kde % basis 1,a + e % basis 1),z)` THEN + CONJ_TAC THENL [AP_TERM_TAC; ALL_TAC] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC WINDING_NUMBER_SPLIT_LINEPATH THEN + ASM_REWRITE_TAC[] THENL + [CONJ_TAC THENL + [ALL_TAC; + SUBGOAL_THEN + `~(z IN segment[a - kde % basis 1:complex,a + kde % basis 1]) /\ + ~(z IN segment[a + kde % basis 1,a + e % basis 1])` + MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s UNION t = u ==> ~(z IN s) /\ ~(z IN t) ==> ~(z IN u)`) THEN + MATCH_MP_TAC UNION_SEGMENT]; + ALL_TAC] THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; + NORM_ARITH `dist(a - d:complex,a - e) = norm(d - e)`; + NORM_ARITH `dist(a + d:complex,a + e) = norm(d - e)`] THEN + ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB; NORM_MUL; + NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC) in + let lemma3 = prove + (`!p:real^1->complex. + simple_path p /\ pathfinish p = pathstart p + ==> ?z. z IN inside(path_image p) /\ norm(winding_number(p,z)) = &1`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `p:real^1->complex` JORDAN_INSIDE_OUTSIDE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + UNDISCH_TAC `~(inside(path_image p):complex->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN + MP_TAC(ISPECL [`inside(path_image p):complex->bool`; + `a:complex`; `basis 1:complex`] + RAY_TO_FRONTIER) THEN + MP_TAC(ISPECL [`inside(path_image p):complex->bool`; + `a:complex`; `--basis 1:complex`] + RAY_TO_FRONTIER) THEN + ASM_SIMP_TAC[INTERIOR_OPEN; VECTOR_NEG_EQ_0; BASIS_NONZERO; + DIMINDEX_2; ARITH] THEN + REWRITE_TAC[VECTOR_ARITH `a + d % --b:complex = a - d % b`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?t. t IN interval[vec 0,vec 1] /\ + (p:real^1->complex) t = a - d % basis 1` + STRIP_ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[path_image; IN_IMAGE]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?q. simple_path q /\ + pathstart q:complex = a - d % basis 1 /\ + pathfinish q = a - d % basis 1 /\ + path_image q = path_image p /\ + (!z. z IN inside(path_image p) + ==> winding_number(q,z) = winding_number(p,z))` + MP_TAC THENL + [EXISTS_TAC `shiftpath t (p:real^1->complex)` THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; DROP_VEC; + SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_SHIFTPATH THEN + ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` MP_TAC) THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN + `?z. z IN inside(path_image q) /\ norm(winding_number(q,z)) = &1` + (fun th -> MESON_TAC[th]) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev o + filter (fun tm -> not(free_in `t:real^1` (concl tm) or + free_in `p:real^1->complex` (concl tm)))) THEN + STRIP_TAC] THEN + SUBGOAL_THEN + `?t. t IN interval[vec 0,vec 1] /\ + (q:real^1->complex) t = a + e % basis 1` + STRIP_ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[path_image; IN_IMAGE]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(a - d % basis 1:complex = a + e % basis 1)` + ASSUME_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `a - d % l:complex = a + e % l <=> (e + d) % l = vec 0`] THEN + SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `path_image q INTER segment[a - d % basis 1,a + e % basis 1] = + {a - d % basis 1:complex,a + e % basis 1}` + ASSUME_TAC THENL + [REWRITE_TAC[SEGMENT_CLOSED_OPEN] THEN + MATCH_MP_TAC(SET_RULE + `a IN p /\ b IN p /\ p INTER s = {} + ==> p INTER (s UNION {a,b}) = {a,b}`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[path_image; IN_IMAGE]; ALL_TAC] THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; + ENDS_IN_UNIT_INTERVAL] THEN + REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN t ==> ~(x IN s)`] THEN + REWRITE_TAC[IN_SEGMENT; VECTOR_ARITH + `(&1 - u) % (a - d % l) + u % (a + e % l):complex = + a + (u * e - (&1 - u) * d) % l`] THEN + X_GEN_TAC `y:complex` THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON + [INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY] + `x IN inside s ==> ~(x IN s)`) THEN + ASM_CASES_TAC `&0 <= k * e - (&1 - k) * d` THENL + [ALL_TAC; + ONCE_REWRITE_TAC[VECTOR_ARITH + `a + (s - t) % l:complex = a - (t - s) % l`]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `~(&0 <= a - b) ==> &0 <= b - a`] THEN + REWRITE_TAC[REAL_ARITH `k * e - (&1 - k) * d < e <=> + &0 < (&1 - k) * (d + e)`] THEN + REWRITE_TAC[REAL_ARITH `(&1 - k) * d - k * e < d <=> + &0 < k * (d + e)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`subpath t (vec 0) (q:real^1->complex)`; + `a:complex`; `d:real`; `e:real`] lemma2) THEN + ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + PATH_IMAGE_JOIN; PATHSTART_LINEPATH] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[pathstart]] THEN + MATCH_MP_TAC SIMPLE_PATH_JOIN_LOOP THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[ARC_LINEPATH_EQ] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; + RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `p INTER s = {a,b} ==> p' SUBSET p ==> p' INTER s SUBSET {b,a}`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; + ENDS_IN_UNIT_INTERVAL]]; + DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL + [`subpath (vec 0) t (q:real^1->complex)`; + `subpath (vec 1) t (q:real^1->complex)`; + `linepath(a - d % basis 1:complex,a + e % basis 1)`; + `a - d % basis 1:complex`; `a + e % basis 1:complex`; + `z:complex`; + `--winding_number + (subpath t (vec 0) q ++ + linepath (a - d % basis 1,a + e % basis 1),z)`] + WINDING_NUMBER_FROM_INNERPATH) THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[REVERSEPATH_SUBPATH; REVERSEPATH_LINEPATH] THEN + SUBGOAL_THEN + `path_image (subpath (vec 0) t q) UNION + path_image (subpath (vec 1) t q) :complex->bool = + path_image q` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN + ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN + REWRITE_TAC[REVERSEPATH_SUBPATH] THEN + SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM IMAGE_UNION; PATH_IMAGE_REVERSEPATH] THEN + SUBGOAL_THEN `interval[vec 0:real^1,t] UNION interval[t,vec 1] = + interval[vec 0,vec 1]` + (fun th -> ASM_REWRITE_TAC[th; GSYM path_image]) THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + REPLICATE_TAC 2 (ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SIMPLE_PATH_SUBPATH THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]; + ALL_TAC]) THEN + ASM_REWRITE_TAC[SIMPLE_PATH_LINEPATH_EQ; PATH_IMAGE_LINEPATH] THEN + REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN + ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN + REWRITE_TAC[REVERSEPATH_SUBPATH] THEN + SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `a IN s /\ a IN t /\ b IN s /\ b IN t /\ + (!x. x IN s ==> !y. y IN t ==> x = y ==> x = a \/ x = b) + ==> s INTER t = {a,b}`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `t:real^1` THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `t:real^1` THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN + X_GEN_TAC `s:real^1` THEN STRIP_TAC THEN + X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN + DISCH_THEN(MP_TAC o SPECL [`s:real^1`; `u:real^1`] o CONJUNCT2) THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (REPEAT_TCL CONJUNCTS_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `drop u = drop t` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ]]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `p INTER s = {a,b} + ==> a IN q /\ b IN q /\ q SUBSET p ==> q INTER s = {a,b}`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; + ENDS_IN_UNIT_INTERVAL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN CONJ_TAC THENL + [EXISTS_TAC `vec 0:real^1`; EXISTS_TAC `t:real^1`] THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `p INTER s = {a,b} + ==> a IN q /\ b IN q /\ q SUBSET p ==> q INTER s = {a,b}`)) THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; SIMPLE_PATH_IMP_PATH; + ENDS_IN_UNIT_INTERVAL] THEN + ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN + REWRITE_TAC[REVERSEPATH_SUBPATH] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + SIMP_TAC[DROP_VEC; PATH_IMAGE_SUBPATH] THEN STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN CONJ_TAC THENL + [EXISTS_TAC `vec 1:real^1`; EXISTS_TAC `t:real^1`] THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `a:complex` THEN + ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; between] THEN + REWRITE_TAC[NORM_ARITH `dist(a - d:complex,a + e) = norm(d + e)`; + NORM_ARITH `dist(a - d:complex,a) = norm(d)`; + NORM_ARITH `dist(a:complex,a + e) = norm e`] THEN + ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; + NORM_BASIS; DIMINDEX_2; ARITH] THEN + ASM_REAL_ARITH_TAC; + ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN + RULE_ASSUM_TAC(REWRITE_RULE[PATH_IMAGE_LINEPATH]) THEN + ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]; + W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_REVERSEPATH o + rand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_IMAGE_JOIN; PATH_LINEPATH; + SIMPLE_PATH_IMP_PATH; PATHSTART_LINEPATH; PATHFINISH_SUBPATH; + PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH; + REVERSEPATH_SUBPATH; PATHFINISH_SUBPATH; + PATHSTART_LINEPATH] THEN + MATCH_MP_TAC(MESON[COMPLEX_ADD_SYM] + `winding_number(g ++ h,z) = + winding_number(g,z) + winding_number(h,z) /\ + winding_number(h ++ g,z) = + winding_number(h,z) + winding_number(g,z) + ==> winding_number(g ++ h,z) =winding_number(h ++ g,z)`) THEN + CONJ_TAC THEN MATCH_MP_TAC WINDING_NUMBER_JOIN THEN + ASM_SIMP_TAC[PATH_LINEPATH; PATH_SUBPATH; PATH_SUBPATH; + SIMPLE_PATH_IMP_PATH; ENDS_IN_UNIT_INTERVAL; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH] + THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN + REWRITE_TAC[SET_RULE + `~(z IN s) /\ ~(z IN t) <=> ~(z IN s UNION t)`] THEN + ONCE_REWRITE_TAC[GSYM PATH_IMAGE_REVERSEPATH] THEN + REWRITE_TAC[REVERSEPATH_LINEPATH; REVERSEPATH_SUBPATH] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]]; + REWRITE_TAC[COMPLEX_NEG_EQ_0] THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE + [COMPLEX_NORM_CX; REAL_OF_NUM_EQ; REAL_ABS_NUM; ARITH]) THEN + FIRST_X_ASSUM CONTR_TAC]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a:complex = --b <=> --a = b`] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + RULE_ASSUM_TAC(REWRITE_RULE[NORM_NEG])] THEN + EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `winding_number(subpath (vec 0) t q ++ subpath t (vec 1) q,z) = + winding_number(subpath (vec 0) (vec 1) q,z)` + (fun th -> ASM_MESON_TAC[th; SUBPATH_TRIVIAL]) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `winding_number(subpath (vec 0) t q,z) + + winding_number(subpath t (vec 1) q,z)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_JOIN THEN + ASM_SIMP_TAC[PATH_SUBPATH; ENDS_IN_UNIT_INTERVAL; SIMPLE_PATH_IMP_PATH; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + SUBGOAL_THEN `~((z:complex) IN path_image q)` MP_TAC THENL + [ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; + MATCH_MP_TAC(SET_RULE + `s1 SUBSET s /\ s2 SUBSET s + ==> ~(z IN s) ==> ~(z IN s1) /\ ~(z IN s2)`) THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET; ENDS_IN_UNIT_INTERVAL; + SIMPLE_PATH_IMP_PATH]]; + MATCH_MP_TAC WINDING_NUMBER_SUBPATH_COMBINE THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; GSYM IN_INTERVAL_1] THEN + ASM_SIMP_TAC[UNIT_INTERVAL_NONEMPTY; SIMPLE_PATH_IMP_PATH] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]]) in + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `pathfinish g:complex = pathstart g` THENL + [ALL_TAC; ASM_MESON_TAC[INSIDE_SIMPLE_CURVE_IMP_CLOSED]] THEN + MATCH_MP_TAC(MESON[] + `(?k. !z. z IN s ==> f z = k) /\ + (?z. z IN s /\ (f z = a \/ f z = b)) + ==> (!z. z IN s ==> f z = a) \/ (!z. z IN s ==> f z = b)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_CONSTANT THEN + ASM_SIMP_TAC[INSIDE_NO_OVERLAP; SIMPLE_PATH_IMP_PATH] THEN + ASM_SIMP_TAC[JORDAN_INSIDE_OUTSIDE]; + MP_TAC(SPEC `g:real^1->complex` lemma3) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] + INTEGER_WINDING_NUMBER) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; + SIMP_TAC[complex_integer; COMPLEX_EQ; IM_NEG; IM_CX] THEN + SIMP_TAC[GSYM real; REAL_NORM; RE_NEG; RE_CX] THEN REAL_ARITH_TAC]]);; + +let SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE = prove + (`!g z. simple_path g /\ z IN inside(path_image g) + ==> abs(Re(winding_number(g,z))) = &1`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP + SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE) THEN + ASM_SIMP_TAC[RE_NEG; RE_CX; REAL_ABS_NUM; REAL_ABS_NEG]);; + +let SIMPLE_CLOSED_PATH_NORM_WINDING_NUMBER_INSIDE = prove + (`!g z. simple_path g /\ z IN inside(path_image g) + ==> norm(winding_number(g,z)) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `pathfinish g:complex = pathstart g` ASSUME_TAC THENL + [ASM_MESON_TAC[INSIDE_SIMPLE_CURVE_IMP_CLOSED]; ALL_TAC] THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] + INTEGER_WINDING_NUMBER) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN + ASM_MESON_TAC[INSIDE_NO_OVERLAP; IN_INTER; NOT_IN_EMPTY]; + ASM_SIMP_TAC[complex_integer; GSYM real; REAL_NORM; + SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE]]);; + +let SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES = prove + (`!g z. simple_path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) + ==> winding_number(g,z) IN {--Cx(&1),Cx(&0),Cx(&1)}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `path_image g:complex->bool` INSIDE_UNION_OUTSIDE) THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_UNION] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN + ASM_SIMP_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE; SIMPLE_PATH_IMP_PATH] THEN + ASM_MESON_TAC[SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE]);; + +let SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS = prove + (`!g z. simple_path g /\ pathfinish g = pathstart g /\ ~(z IN path_image g) /\ + &0 < Re(winding_number(g,z)) + ==> winding_number(g,z) = Cx(&1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^1->complex`; `z:complex`] + SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES) THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + STRIP_TAC THEN UNDISCH_TAC `&0 < Re(winding_number(g,z))` THEN + ASM_REWRITE_TAC[RE_NEG; RE_CX] THEN REAL_ARITH_TAC);; + +let SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO = prove + (`!s g z. simply_connected s /\ + path g /\ path_image g SUBSET s /\ + pathfinish g = pathstart g /\ ~(z IN s) + ==> winding_number(g,z) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `winding_number(linepath(pathstart g,pathstart g),z)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_HOMOTOPIC_PATHS THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN + EXISTS_TAC `pathstart(g:real^1->complex)` THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [simply_connected]) THEN + ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; + INSERT_SUBSET; EMPTY_SUBSET]; + MATCH_MP_TAC WINDING_NUMBER_TRIVIAL] THEN + MP_TAC(ISPEC `g:real^1->complex` PATHSTART_IN_PATH_IMAGE) THEN + ASM SET_TAC[]);; + +let NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO = prove + (`!s. ~(?z. ~(z IN s) /\ bounded(connected_component ((:complex) DIFF s) z)) + ==> !g z. path g /\ path_image g SUBSET s /\ + pathfinish g = pathstart g /\ ~(z IN s) + ==> winding_number(g,z) = Cx(&0)`, + REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC WINDING_NUMBER_ZERO_IN_OUTSIDE THEN + ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; + +let NO_BOUNDED_PATH_COMPONENT_IMP_WINDING_NUMBER_ZERO = prove + (`!s. ~(?z. ~(z IN s) /\ bounded(path_component ((:complex) DIFF s) z)) + ==> !g z. path g /\ path_image g SUBSET s /\ + pathfinish g = pathstart g /\ ~(z IN s) + ==> winding_number(g,z) = Cx(&0)`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO THEN + ASM_MESON_TAC[PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; BOUNDED_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Partial circle path. *) +(* ------------------------------------------------------------------------- *) + +let partcirclepath = new_definition + `partcirclepath(z,r,s,t) = + \x. z + Cx(r) * cexp(ii * linepath(Cx(s),Cx(t)) x)`;; + +let PATHSTART_PARTCIRCLEPATH = prove + (`!r z s t. pathstart(partcirclepath(z,r,s,t)) = + z + Cx(r) * cexp(ii * Cx(s))`, + REWRITE_TAC[pathstart; partcirclepath; + REWRITE_RULE[pathstart] PATHSTART_LINEPATH]);; + +let PATHFINISH_PARTCIRCLEPATH = prove + (`!r z s t. pathfinish(partcirclepath(z,r,s,t)) = + z + Cx(r) * cexp(ii * Cx(t))`, + REWRITE_TAC[pathfinish; partcirclepath; + REWRITE_RULE[pathfinish] PATHFINISH_LINEPATH]);; + +let HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH = prove + (`!z r s t x. + ((partcirclepath(z,r,s,t)) has_vector_derivative + (ii * Cx(r) * (Cx t - Cx s) * cexp(ii * linepath(Cx(s),Cx(t)) x))) + (at x)`, + REWRITE_TAC[partcirclepath; linepath; COMPLEX_CMUL; CX_SUB] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; + +let VECTOR_DERIVATIVE_PARTCIRCLEPATH = prove + (`!z r s t x. + vector_derivative (partcirclepath(z,r,s,t)) (at x) = + ii * Cx(r) * (Cx t - Cx s) * cexp(ii * linepath(Cx(s),Cx(t)) x)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH]);; + +let VALID_PATH_PARTCIRCLEPATH = prove + (`!z r s t. valid_path(partcirclepath(z,r,s,t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[valid_path] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN + REWRITE_TAC[differentiable_on] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN + REWRITE_TAC[VECTOR_DERIVATIVE_WORKS; VECTOR_DERIVATIVE_PARTCIRCLEPATH; + HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH]);; + +let PATH_PARTCIRCLEPATH = prove + (`!z r s t. path(partcirclepath(z,r,s,t))`, + SIMP_TAC[VALID_PATH_PARTCIRCLEPATH; VALID_PATH_IMP_PATH]);; + +let PATH_IMAGE_PARTCIRCLEPATH = prove + (`!z r s t. + &0 <= r /\ s <= t + ==> path_image(partcirclepath(z,r,s,t)) = + {z + Cx(r) * cexp(ii * Cx x) | s <= x /\ x <= t}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[path_image; partcirclepath] THEN + REWRITE_TAC[EXTENSION; TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN + REWRITE_TAC[FORALL_AND_THM; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + DISCH_TAC THEN EXISTS_TAC `(&1 - drop x) * s + drop x * t` THEN + REWRITE_TAC[linepath; CX_ADD; CX_SUB; COMPLEX_CMUL; CX_MUL] THEN + REWRITE_TAC[REAL_ARITH `s <= (&1 - x) * s + x * t <=> &0 <= x * (t - s)`; + REAL_ARITH `(&1 - x) * s + x * t <= t <=> &0 <= (&1 - x) * (t - s)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE]; + ALL_TAC] THEN + X_GEN_TAC `w:complex` THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_CASES_TAC `s:real < t` THENL + [EXISTS_TAC `lift((x - s) / (t - s))` THEN + ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT; + LIFT_DROP; DROP_VEC; linepath; REAL_MUL_LZERO; REAL_MUL_LID; + REAL_SUB_LE; REAL_ARITH `x - s:real <= t - s <=> x <= t`] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_CMUL; CX_SUB; CX_DIV] THEN + SUBGOAL_THEN `~(Cx(s) = Cx(t))` MP_TAC THENL + [ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NE]; CONV_TAC COMPLEX_FIELD]; + UNDISCH_TAC `s:real <= t` THEN ASM_REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN SUBST_ALL_TAC THEN EXISTS_TAC `vec 0:real^1` THEN + SIMP_TAC[IN_INTERVAL_1; DROP_VEC; linepath; VECTOR_MUL_LZERO; + REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_ADD_RID; REAL_POS] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_INJ] THEN ASM_REAL_ARITH_TAC]);; + +let PATH_IMAGE_PARTCIRCLEPATH_SUBSET = prove + (`!z r s t. + &0 <= r /\ s <= t + ==> path_image(partcirclepath(z,r,s,t)) SUBSET sphere(z,r)`, + SIMP_TAC[PATH_IMAGE_PARTCIRCLEPATH] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; IN_SPHERE; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[NORM_ARITH `dist(z,z + a) = norm a`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; COMPLEX_NORM_CX; + RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0] THEN + REAL_ARITH_TAC);; + +let IN_PATH_IMAGE_PARTCIRCLEPATH = prove + (`!z r s t w. + &0 <= r /\ s <= t /\ w IN path_image(partcirclepath(z,r,s,t)) + ==> norm(w - z) = r`, + MP_TAC PATH_IMAGE_PARTCIRCLEPATH_SUBSET THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[SUBSET; IN_SPHERE; dist; NORM_SUB] THEN SET_TAC[]);; + +let HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG = prove + (`!f i z r s t B k. + FINITE k /\ + (f has_path_integral i) (partcirclepath(z,r,s,t)) /\ + &0 <= B /\ &0 < r /\ s <= t /\ + (!x. x IN path_image(partcirclepath(z,r,s,t)) DIFF k + ==> norm(f x) <= B) + ==> norm(i) <= B * r * (t - s)`, + let lemma1 = prove + (`!b w. FINITE {z | norm(z) <= b /\ cexp(z) = w}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `w = Cx(&0)` THEN + ASM_REWRITE_TAC[CEXP_NZ; SET_RULE `{x | F} = {}`; FINITE_RULES] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CEXP_CLOG) THEN + REWRITE_TAC[CEXP_EQ] THEN + REWRITE_TAC[SET_RULE + `{z | P z /\ ?n. Q n /\ z = f n} = IMAGE f {n | Q n /\ P(f n)}`] THEN + MATCH_MP_TAC FINITE_IMAGE THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{n | integer n /\ + norm(Cx(&2 * n * pi) * ii) <= b + norm(clog w)}` THEN + CONJ_TAC THENL + [ALL_TAC; SIMP_TAC[SUBSET; IN_ELIM_THM] THEN NORM_ARITH_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_LE_RDIV_EQ; PI_POS] THEN + REWRITE_TAC[REAL_ARITH `&2 * x <= a <=> x <= a / &2`] THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG]) in + let lemma2 = prove + (`!a b. ~(a = Cx(&0)) ==> FINITE {z | norm(z) <= b /\ cexp(a * z) = w}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `IMAGE (\z. z / a) {z | norm(z) <= b * norm(a) /\ cexp(z) = w}` THEN + SIMP_TAC[lemma1; FINITE_IMAGE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + ASM_SIMP_TAC[COMPLEX_FIELD `~(a = Cx(&0)) ==> (x = y / a <=> a * x = y)`; + UNWIND_THM1; COMPLEX_NORM_MUL; REAL_LE_LMUL; NORM_POS_LE]) in + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_PATH_INTEGRAL] THEN STRIP_TAC THEN + MP_TAC(ASSUME `s <= t`) THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + STRIP_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + SIMP_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0_EQ; NORM_0] THEN + REAL_ARITH_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM CONTENT_UNIT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN + EXISTS_TAC `\x. if (partcirclepath(z,r,s,t) x) IN k then Cx(&0) + else f(partcirclepath(z,r,s,t) x) * + vector_derivative (partcirclepath(z,r,s,t)) (at x)` THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; REAL_SUB_LE]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `\x. f(partcirclepath(z,r,s,t) x) * + vector_derivative (partcirclepath(z,r,s,t)) (at x)` THEN + EXISTS_TAC `{x | x IN interval[vec 0,vec 1] /\ + (partcirclepath(z,r,s,t) x) IN k}` THEN + ASM_SIMP_TAC[IN_DIFF; IN_ELIM_THM; IMP_CONJ] THEN + MATCH_MP_TAC NEGLIGIBLE_FINITE THEN + MATCH_MP_TAC FINITE_FINITE_PREIMAGE_GENERAL THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:complex` THEN DISCH_TAC THEN + REWRITE_TAC[partcirclepath] THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD + `~(r = Cx(&0)) ==> (z + r * e = y <=> e = (y - z) / r)`] THEN + REWRITE_TAC[linepath; COMPLEX_CMUL] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_ADD] THEN + REWRITE_TAC[REAL_ARITH `(&1 - t) * x + t * y = x + t * (y - x)`] THEN + REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(e = Cx(&0)) ==> (e * x = y <=> x = y / e)`] THEN + ABBREV_TAC `w = (y - z) / Cx r / cexp(ii * Cx s)` THEN + REWRITE_TAC[CX_MUL; COMPLEX_RING + `ii * Cx x * Cx(t - s) = (ii * Cx(t - s)) * Cx x`] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `{x | Cx(drop x) IN + {z | norm(z) <= &1 /\ cexp((ii * Cx(t - s)) * z) = w}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ THEN REWRITE_TAC[CX_INJ; DROP_EQ] THEN + MATCH_MP_TAC lemma2 THEN + REWRITE_TAC[COMPLEX_RING `ii * x = Cx(&0) <=> x = Cx(&0)`] THEN + ASM_SIMP_TAC[CX_INJ; REAL_SUB_0; REAL_LT_IMP_NE]; + SIMP_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN + REWRITE_TAC[NORM_CEXP; RE_MUL_II; IM_LINEPATH_CX] THEN + REWRITE_TAC[REAL_EXP_0; REAL_NEG_0; REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[path_image] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + ASM_REAL_ARITH_TAC);; + +let HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH = prove + (`!f i z r s t B. + (f has_path_integral i) (partcirclepath(z,r,s,t)) /\ + &0 <= B /\ &0 < r /\ s <= t /\ + (!x. x IN path_image(partcirclepath(z,r,s,t)) + ==> norm(f x) <= B) + ==> norm(i) <= B * r * (t - s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG THEN + MAP_EVERY EXISTS_TAC + [`f:complex->complex`; `z:complex`; `{}:complex->bool`] THEN + ASM_REWRITE_TAC[FINITE_RULES; IN_DIFF; NOT_IN_EMPTY]);; + +let PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH = prove + (`!f z r s t. f continuous_on path_image(partcirclepath(z,r,s,t)) + ==> f path_integrable_on (partcirclepath(z,r,s,t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL] THEN + REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH; GSYM integrable_on] THEN + DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[GSYM path_image; ETA_AX] THEN + MATCH_MP_TAC PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON THEN + ASM_REWRITE_TAC[GSYM valid_path; VALID_PATH_PARTCIRCLEPATH]; + ALL_TAC] THEN + REWRITE_TAC[linepath] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - x) % s + x % t = s + x % (t - s)`] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; COMPLEX_CMUL; CX_MUL; + CX_SUB] THEN + CONV_TAC COMPLEX_RING);; + +let WINDING_NUMBER_PARTCIRCLEPATH_POS_LT = prove + (`!r z s t w. + s < t /\ norm(w - z) < r + ==> &0 < Re(winding_number(partcirclepath(z,r,s,t),w))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WINDING_NUMBER_POS_LT THEN + EXISTS_TAC `r * (t - s) * (r - norm(w - z:complex))` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `n < r ==> &0 <= n ==> &0 < r`)) THEN + REWRITE_TAC[NORM_POS_LE] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT; VALID_PATH_PARTCIRCLEPATH] THEN + ASM_REWRITE_TAC[VALID_PATH_PARTCIRCLEPATH] THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_PATH_IMAGE_PARTCIRCLEPATH; REAL_LT_IMP_LE; REAL_LT_REFL]; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_DERIVATIVE_PARTCIRCLEPATH] THEN + REWRITE_TAC[partcirclepath] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; IM_MUL_II; RE_MUL_CX; GSYM CX_SUB] THEN + REWRITE_TAC[CNJ_ADD; CNJ_SUB; CNJ_MUL; CNJ_CX] THEN + REWRITE_TAC[COMPLEX_RING + `c * ((z + r * c') - w):complex = r * c * c' - c * (w - z)`] THEN + REWRITE_TAC[COMPLEX_MUL_CNJ; NORM_CEXP; RE_MUL_II] THEN + REWRITE_TAC[IM_LINEPATH_CX; REAL_NEG_0; REAL_EXP_0; COMPLEX_MUL_RID; + COMPLEX_POW_2] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT; RE_SUB; RE_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `norm(x) <= norm(y) /\ abs(Re(x)) <= norm(x) + ==> r - norm(y) <= r - Re x`) THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; RE_MUL_II; IM_LINEPATH_CX] THEN + REWRITE_TAC[REAL_EXP_0; REAL_NEG_0; REAL_MUL_LID; GSYM CNJ_SUB] THEN + REWRITE_TAC[COMPLEX_NORM_CNJ; REAL_LE_REFL]);; + +let SIMPLE_PATH_PARTCIRCLEPATH = prove + (`!z r s t. simple_path(partcirclepath(z,r,s,t)) <=> + ~(r = &0) /\ ~(s = t) /\ abs(s - t) <= &2 * pi`, + let lemma = prove + (`(!x y. (&0 <= x /\ x <= &1) /\ (&0 <= y /\ y <= &1) ==> P(abs(x - y))) <=> + (!x. &0 <= x /\ x <= &1 ==> P x)`, + MESON_TAC[REAL_ARITH `(&0 <= x /\ x <= &1) /\ (&0 <= y /\ y <= &1) + ==> &0 <= abs(x - y) /\ abs(x - y) <= &1`; + REAL_ARITH `&0 <= &0 /\ &0 <= &1`; + REAL_ARITH `(&0 <= x ==> abs(x - &0) = x)`]) in + REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_PARTCIRCLEPATH] THEN + REWRITE_TAC[partcirclepath] THEN + SIMP_TAC[COMPLEX_RING `z + r * x = z + r * y <=> r * (x - y) = Cx(&0)`] THEN + REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ] THEN + ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[] THENL + [DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &3)`; `lift(&1 / &2)`]) THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `s:real = t` THEN ASM_REWRITE_TAC[] THENL + [DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &3)`; `lift(&1 / &2)`]) THEN + REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - t) % x + t % x = x`] THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_SUB_0]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_SUB_0; CEXP_EQ] THEN + REWRITE_TAC[COMPLEX_RING + `ii * x = ii * y + z * ii <=> ii * (x - (y + z)) = Cx(&0)`] THEN + REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; LINEPATH_CX] THEN + REWRITE_TAC[GSYM CX_SUB; GSYM CX_ADD; CX_INJ] THEN + REWRITE_TAC[REAL_ARITH + `((&1 - x) * s + x * t) - (((&1 - y) * s + y * t) + z) = &0 <=> + (x - y) * (t - s) = z`] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; IN_INTERVAL_1] THEN + SIMP_TAC[REAL_ARITH + `&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 + ==> (x = y \/ x = &0 /\ y = &1 \/ x = &1 /\ y = &0 <=> + abs(x - y) = &0 \/ abs(x - y) = &1)`] THEN + SIMP_TAC[PI_POS; REAL_FIELD + `&0 < pi ==> (x = &2 * n * pi <=> n = x / (&2 * pi))`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM2] THEN + ONCE_REWRITE_TAC[GSYM INTEGER_ABS] THEN + REWRITE_TAC[GSYM FORALL_DROP; REAL_ABS_MUL; REAL_ABS_DIV] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] THEN + REWRITE_TAC[lemma] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `(&2 * pi) / abs(t - s)`) THEN + ASM_SIMP_TAC[REAL_ABS_SUB; REAL_FIELD + `~(s = t) ==> x / abs(s - t) * abs(s - t) = x`] THEN + ASM_SIMP_TAC[PI_POS; INTEGER_CLOSED; REAL_FIELD + `&0 < pi ==> (&2 * pi) / (&2 * pi) = &1`] THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; + GSYM REAL_ABS_NZ; REAL_SUB_0] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + DISCH_TAC THEN X_GEN_TAC `x:real` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + REAL_ABS_INTEGER_LEMMA)) THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_NUM; + REAL_ABS_PI] THEN + SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_LT_MUL; + REAL_OF_NUM_LT; ARITH] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + ASM_REWRITE_TAC[REAL_ENTIRE; REAL_MUL_LID; + REAL_ARITH `abs(t - s) = &0 <=> s = t`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `p <= x * abs(s - t) + ==> abs(s - t) <= p ==> &1 * abs(s - t) <= x * abs(s - t)`)) THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; GSYM REAL_ABS_NZ; REAL_SUB_0] THEN + ASM_REAL_ARITH_TAC]);; + +let ARC_PARTCIRCLEPATH = prove + (`!z r s t. ~(r = &0) /\ ~(s = t) /\ abs(s - t) < &2 * pi + ==> arc(partcirclepath(z,r,s,t))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_PARTCIRCLEPATH] THEN + REWRITE_TAC[partcirclepath] THEN + SIMP_TAC[COMPLEX_RING `z + r * x = z + r * y <=> r * (x - y) = Cx(&0)`] THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ] THEN + REWRITE_TAC[COMPLEX_SUB_0; CEXP_EQ] THEN + REWRITE_TAC[COMPLEX_RING + `ii * x = ii * y + z * ii <=> ii * (x - (y + z)) = Cx(&0)`] THEN + REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; LINEPATH_CX] THEN + REWRITE_TAC[GSYM CX_SUB; GSYM CX_ADD; CX_INJ] THEN + REWRITE_TAC[REAL_ARITH + `((&1 - x) * s + x * t) - (((&1 - y) * s + y * t) + z) = &0 <=> + (x - y) * (t - s) = z`] THEN + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `n:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `n = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ENTIRE; REAL_SUB_0; + DROP_EQ] THEN + MP_TAC(SPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `abs x < abs y ==> ~(x = y)`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 * &2 * pi` THEN + CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `&2 * n * pi = n * &2 * pi`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&1 * abs(t - s)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[REAL_MUL_LID] THEN ASM_MESON_TAC[REAL_ABS_SUB]] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Special case of one complete circle. *) +(* ------------------------------------------------------------------------- *) + +let circlepath = new_definition + `circlepath(z,r) = partcirclepath(z,r,&0,&2 * pi)`;; + +let CIRCLEPATH = prove + (`circlepath(z,r) = \x. z + Cx(r) * cexp(Cx(&2) * Cx pi * ii * Cx(drop x))`, + REWRITE_TAC[circlepath; partcirclepath; linepath; COMPLEX_CMUL] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN + REWRITE_TAC[CX_MUL; COMPLEX_MUL_AC]);; + +let PATHSTART_CIRCLEPATH = prove + (`!r z. pathstart(circlepath(z,r)) = z + Cx(r)`, + REWRITE_TAC[circlepath; PATHSTART_PARTCIRCLEPATH] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_MUL_RID]);; + +let PATHFINISH_CIRCLEPATH = prove + (`!r z. pathfinish(circlepath(z,r)) = z + Cx(r)`, + REWRITE_TAC[circlepath; PATHFINISH_PARTCIRCLEPATH] THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN] THEN + REWRITE_TAC[SIN_NPI; COS_NPI; REAL_POW_NEG; ARITH; REAL_POW_ONE] THEN + CONV_TAC COMPLEX_RING);; + +let HAS_VECTOR_DERIVATIVE_CIRCLEPATH = prove + (`((circlepath (z,r)) has_vector_derivative + (Cx(&2) * Cx(pi) * ii * Cx(r) * cexp(Cx(&2) * Cx pi * ii * Cx(drop x)))) + (at x)`, + REWRITE_TAC[CIRCLEPATH] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; + +let VECTOR_DERIVATIVE_CIRCLEPATH = prove + (`vector_derivative (circlepath (z,r)) (at x) = + Cx(&2) * Cx(pi) * ii * Cx(r) * cexp(Cx(&2) * Cx pi * ii * Cx(drop x))`, + MATCH_MP_TAC VECTOR_DERIVATIVE_AT THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CIRCLEPATH]);; + +let VALID_PATH_CIRCLEPATH = prove + (`!z r. valid_path (circlepath(z,r))`, + REWRITE_TAC[circlepath; VALID_PATH_PARTCIRCLEPATH]);; + +let PATH_IMAGE_CIRCLEPATH = prove + (`!z r. &0 <= r ==> path_image (circlepath(z,r)) = sphere(z,r)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CIRCLEPATH; path_image] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(w,z) = norm(z - w)`] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; COMPLEX_RING `(z + r) - z = r:complex`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[COMPLEX_RING + `Cx(&2) * p * i * z = (Cx(&2) * p * z) * i`] THEN + REWRITE_TAC[RE_MUL_II; GSYM CX_MUL; IM_CX] THEN + REWRITE_TAC[REAL_EXP_NEG; REAL_EXP_0; REAL_MUL_RID; COMPLEX_NORM_CX] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:complex` THEN DISCH_TAC THEN ABBREV_TAC `w:complex = x - z` THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (COMPLEX_RING + `x - z = w:complex ==> x = z + w`)) THEN + REWRITE_TAC[IN_IMAGE; COMPLEX_RING `z + a = z + b:complex <=> a = b`] THEN + ASM_CASES_TAC `w = Cx(&0)` THENL + [UNDISCH_THEN `norm(w:complex) = r` (MP_TAC o SYM) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0; REAL_ABS_ZERO] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[MEMBER_NOT_EMPTY; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_POS]; + ALL_TAC] THEN + MP_TAC(SPECL [`Re(w / Cx(norm w))`; `Im(w / Cx(norm w))`] + SINCOS_TOTAL_2PI) THEN + REWRITE_TAC[GSYM COMPLEX_SQNORM] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_ONE; COMPLEX_NORM_ZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` (STRIP_ASSUME_TAC o GSYM)) THEN + EXISTS_TAC `lift(t / (&2 * pi))` THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `Cx(&2) * p * i * z = i * (Cx(&2) * p * z)`] THEN + REWRITE_TAC[CEXP_EULER; LIFT_DROP; CX_DIV; CX_MUL] THEN + ASM_SIMP_TAC[CX_PI_NZ; COMPLEX_FIELD + `~(p = Cx(&0)) ==> Cx(&2) * p * t / (Cx(&2) * p) = t`] THEN + ASM_REWRITE_TAC[GSYM CX_COS; GSYM CX_SIN] THEN CONJ_TAC THENL + [REWRITE_TAC[complex_div; GSYM CX_INV] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `Re(w * Cx x) = Re(w) * x`; + SIMPLE_COMPLEX_ARITH `Im(w * Cx x) = Im(w) * x`] THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB; GSYM CX_MUL] THEN + SUBGOAL_THEN `!z:real. r * z * inv r = z` MP_TAC THENL + [SUBGOAL_THEN `~(r = &0)` MP_TAC THENL [ALL_TAC; CONV_TAC REAL_FIELD] THEN + ASM_MESON_TAC[COMPLEX_NORM_ZERO]; + ONCE_REWRITE_TAC[COMPLEX_RING `t * ii * s = ii * t * s`] THEN + SIMP_TAC[GSYM CX_MUL; GSYM COMPLEX_EXPAND]]; + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_MUL; + PI_POS; REAL_OF_NUM_LT; ARITH] THEN + ASM_REAL_ARITH_TAC]);; + +let HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH_STRONG = prove + (`!f i z r B k. + FINITE k /\ + (f has_path_integral i) (circlepath(z,r)) /\ + &0 <= B /\ &0 < r /\ + (!x. norm(x - z) = r /\ ~(x IN k) ==> norm(f x) <= B) + ==> norm(i) <= B * (&2 * pi * r)`, + REWRITE_TAC[circlepath] THEN REPEAT STRIP_TAC THEN + SUBST1_TAC(REAL_ARITH `B * (&2 * pi * r) = B * r * (&2 * pi - &0)`) THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG THEN + MAP_EVERY EXISTS_TAC + [`f:complex->complex`; `z:complex`; `k:complex->bool`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; PI_POS; IN_DIFF] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; GSYM circlepath; REAL_LT_IMP_LE] THEN + ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(w,z) = norm(z - w)`]);; + +let HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH = prove + (`!f i z r B. + (f has_path_integral i) (circlepath(z,r)) /\ + &0 <= B /\ &0 < r /\ (!x. norm(x - z) = r ==> norm(f x) <= B) + ==> norm(i) <= B * (&2 * pi * r)`, + REWRITE_TAC[circlepath] THEN REPEAT STRIP_TAC THEN + SUBST1_TAC(REAL_ARITH `B * (&2 * pi * r) = B * r * (&2 * pi - &0)`) THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH THEN + MAP_EVERY EXISTS_TAC [`f:complex->complex`; `z:complex`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE; PI_POS] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; GSYM circlepath; REAL_LT_IMP_LE] THEN + ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(w,z) = norm(z - w)`]);; + +let PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH = prove + (`!f z r. f continuous_on path_image(circlepath(z,r)) + ==> f path_integrable_on (circlepath(z,r))`, + SIMP_TAC[PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH; circlepath]);; + +let SIMPLE_PATH_CIRCLEPATH = prove + (`!z r. simple_path(circlepath(z,r)) <=> ~(r = &0)`, + REWRITE_TAC[circlepath; SIMPLE_PATH_PARTCIRCLEPATH] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let WINDING_NUMBER_CIRCLEPATH = prove + (`!z r w. norm(w - z) < r ==> winding_number(circlepath(z,r),w) = Cx(&1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS THEN + REWRITE_TAC[SIMPLE_PATH_CIRCLEPATH; + PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH; CONJ_ASSOC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `n < r ==> (&0 <= n ==> &0 <= r /\ &0 < r) /\ n < r`)) THEN + SIMP_TAC[NORM_POS_LE; PATH_IMAGE_CIRCLEPATH; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(w,z) = norm(z - w)`] THEN + REAL_ARITH_TAC; + REWRITE_TAC[circlepath] THEN + MATCH_MP_TAC WINDING_NUMBER_PARTCIRCLEPATH_POS_LT THEN + ASM_SIMP_TAC[REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the Cauchy formula for points inside a circle. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_INTEGRAL_CIRCLEPATH = prove + (`!f z r w. + f continuous_on cball(z,r) /\ + f holomorphic_on ball(z,r) /\ + w IN ball(z,r) + ==> ((\u. f(u) / (u - w)) has_path_integral + (Cx(&2) * Cx(pi) * ii * f(w))) (circlepath(z,r))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `cball(z:complex,r)`; + `{}:complex->bool`; `circlepath(z,r)`; `w:complex`] + CAUCHY_INTEGRAL_FORMULA_WEAK) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN + ASM_SIMP_TAC[WINDING_NUMBER_CIRCLEPATH; COMPLEX_MUL_LID] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[VALID_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; FINITE_RULES; + PATHFINISH_CIRCLEPATH; CONVEX_CBALL; INTERIOR_CBALL; DIFF_EMPTY] THEN + REWRITE_TAC[complex_differentiable] THEN + CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `n < r ==> &0 <= n ==> &0 <= r`)) THEN + SIMP_TAC[NORM_POS_LE; PATH_IMAGE_CIRCLEPATH] THEN + REWRITE_TAC[SET_RULE `s SUBSET c DELETE q <=> s SUBSET c /\ ~(q IN s)`] THEN + REWRITE_TAC[SPHERE_SUBSET_CBALL; IN_SPHERE] THEN + UNDISCH_TAC `norm(w - z:complex) < r` THEN CONV_TAC NORM_ARITH);; + +let CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE = prove + (`!f z r w. + f holomorphic_on cball(z,r) /\ w IN ball(z,r) + ==> ((\u. f(u) / (u - w)) has_path_integral + (Cx(&2) * Cx(pi) * ii * f(w))) (circlepath(z,r))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_INTEGRAL_CIRCLEPATH THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + ASM_MESON_TAC[BALL_SUBSET_CBALL; HOLOMORPHIC_ON_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Uniform convergence of path integral when the derivative of the path is *) +(* bounded, and in particular for the special case of a circle. *) +(* ------------------------------------------------------------------------- *) + +let PATH_INTEGRAL_UNIFORM_LIMIT = prove + (`!net f B g l. + ~(trivial_limit net) /\ valid_path g /\ + (!t. t IN interval[vec 0,vec 1] + ==> norm(vector_derivative g (at t)) <= B) /\ + eventually (\n:A. (f n) path_integrable_on g) net /\ + (!e. &0 < e + ==> eventually (\n. !x. x IN path_image g + ==> norm(f n x - l x) < e) net) + ==> l path_integrable_on g /\ + ((\n. path_integral g (f n)) --> path_integral g l) net`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[path_integrable_on; HAS_PATH_INTEGRAL; GSYM integrable_on] THEN + MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs B + &1`] THEN + UNDISCH_TAC `eventually (\n:A. (f n) path_integrable_on g) net` THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN + ASM_REWRITE_TAC[path_image; path_integrable_on; FORALL_IN_IMAGE] THEN + REWRITE_TAC[HAS_PATH_INTEGRAL; GSYM integrable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. f (a:A) (g x) * vector_derivative g (at x)` THEN + ASM_REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e / (abs B + &1) * B` THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; + REWRITE_TAC[REAL_ARITH `e / x * B <= e <=> &0 <= e * (&1 - B / x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_SUB_LE; REAL_LE_LDIV_EQ; + REAL_ARITH `&0 < abs B + &1`] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[tendsto] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs B + &1`; REAL_HALF] THEN + UNDISCH_TAC `eventually (\n:A. (f n) path_integrable_on g) net` THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[PATH_INTEGRAL_INTEGRAL; DIST_0; GSYM INTEGRAL_SUB; + GSYM PATH_INTEGRABLE_ON; ETA_AX] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC + `drop(integral (interval[vec 0,vec 1]) (\x:real^1. lift(e / &2)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[INTEGRABLE_SUB; GSYM PATH_INTEGRABLE_ON; ETA_AX] THEN + REWRITE_TAC[INTEGRABLE_CONST; GSYM COMPLEX_SUB_RDISTRIB; LIFT_DROP] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e / &2 / (abs B + &1) * B` THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_IMAGE; path_image] THEN ASM_MESON_TAC[]; + REWRITE_TAC[REAL_ARITH `e / x * B <= e <=> &0 <= e * (&1 - B / x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_SUB_LE; REAL_LE_LDIV_EQ; + REAL_ARITH `&0 < abs B + &1`] THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[INTEGRAL_CONST; CONTENT_UNIT_1; VECTOR_MUL_LID; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]);; + +let PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH = prove + (`!net f l z r. + &0 < r /\ ~(trivial_limit net) /\ + eventually (\n:A. (f n) path_integrable_on circlepath(z,r)) net /\ + (!e. &0 < e + ==> eventually (\n. !x. x IN path_image (circlepath(z,r)) + ==> norm(f n x - l x) < e) net) + ==> l path_integrable_on circlepath(z,r) /\ + ((\n. path_integral (circlepath(z,r)) (f n)) + --> path_integral (circlepath(z,r)) l) net`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIFORM_LIMIT THEN EXISTS_TAC `&2 * pi * r` THEN + ASM_SIMP_TAC[PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[VALID_PATH_CIRCLEPATH; VECTOR_DERIVATIVE_CIRCLEPATH] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_LID] THEN + REWRITE_TAC[NORM_CEXP; RE_MUL_CX; RE_MUL_II; IM_CX] THEN + REWRITE_TAC[REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID] THEN + ASM_SIMP_TAC[real_abs; REAL_LE_REFL; REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* General stepping result for derivative formulas. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_NEXT_DERIVATIVE = prove + (`!f' f g s k B. + ~(k = 0) /\ + open s /\ valid_path g /\ + (!t. t IN interval[vec 0,vec 1] + ==> norm(vector_derivative g (at t)) <= B) /\ + f' continuous_on path_image g /\ + (!w. w IN s DIFF path_image g + ==> ((\u. f'(u) / (u - w) pow k) has_path_integral f w) g) + ==> !w. w IN s DIFF path_image g + ==> (\u. f'(u) / (u - w) pow (k + 1)) path_integrable_on g /\ + (f has_complex_derivative + (Cx(&k) * path_integral g (\u. f'(u) / (u - w) pow (k + 1)))) + (at w)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `w:complex` THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + MP_TAC(ISPEC `s DIFF path_image(g:real^1->complex)` + OPEN_CONTAINS_BALL) THEN + ASM_SIMP_TAC[OPEN_DIFF; CLOSED_PATH_IMAGE; VALID_PATH_IMP_PATH] THEN + DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`at(w:complex)`; + `\u x:complex. f'(x) * (inv(x - u) pow k - inv(x - w) pow k) / + (u - w) / Cx(&k)`; + `B:real`; `g:real^1->complex`; + `\u. f'(u) / (u - w) pow (k + 1)`] + PATH_INTEGRAL_UNIFORM_LIMIT) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&k)` o MATCH_MP LIM_COMPLEX_LMUL) THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + LIM_TRANSFORM_AT) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:complex` THEN + REWRITE_TAC[dist] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(u:complex = w)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_SUB_0; COMPLEX_NORM_0; REAL_LT_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD + `~(y = Cx(&0)) ==> (y * x = z <=> x = z / y)`] THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_SUB_LDISTRIB; + COMPLEX_FIELD `~(c = Cx(&0)) ==> (a - b) / c = a / c - b / c`] THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[GSYM complex_div] THEN + CONJ_TAC THEN REPEAT(MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_DIV) THEN + REWRITE_TAC[GSYM complex_div; COMPLEX_POW_INV] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_REFL; NORM_0] THEN + ASM_MESON_TAC[NORM_SUB]] THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_AT] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `d:real` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:complex` THEN + REWRITE_TAC[dist] THEN STRIP_TAC THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN + REPEAT(MATCH_MP_TAC PATH_INTEGRABLE_COMPLEX_RMUL) THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB; COMPLEX_POW_INV; GSYM complex_div] THEN + MATCH_MP_TAC PATH_INTEGRABLE_SUB THEN + REWRITE_TAC[path_integrable_on] THEN CONJ_TAC THENL + [EXISTS_TAC `(f:complex->complex) u`; + EXISTS_TAC `(f:complex->complex) w`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_REFL; NORM_0] THEN + ASM_MESON_TAC[NORM_SUB]; + ALL_TAC] THEN + SUBGOAL_THEN + `!e. &0 < e + ==> eventually + (\n. !x. x IN path_image g + ==> norm + ((inv (x - n) pow k - inv (x - w) pow k) / + (n - w) / Cx(&k) - inv(x - w) pow (k + 1)) < + e) + (at w)` + ASSUME_TAC THENL + [ALL_TAC; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `bounded(IMAGE (f':complex->complex) (path_image g))` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[COMPACT_VALID_PATH_IMAGE]; + ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / C:real`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `u:complex` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN + REWRITE_TAC[COMPLEX_POW_INV] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_AT] THEN + EXISTS_TAC `min (d / &2) ((e * (d / &2) pow (k + 2)) / (&k + &1))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_HALF; REAL_POW_LT; REAL_LT_MUL; dist; + REAL_LT_DIV; REAL_ARITH `&0 < &k + &1`] THEN + X_GEN_TAC `u:complex` THEN STRIP_TAC THEN + X_GEN_TAC `x:complex` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\n w. if n = 0 then inv(x - w) pow k + else if n = 1 then Cx(&k) / (x - w) pow (k + 1) + else (Cx(&k) * Cx(&k + &1)) / (x - w) pow (k + 2)`; + `1`; `ball(w:complex,d / &2)`; + `(&k * (&k + &1)) / (d / &2) pow (k + 2)`] + COMPLEX_TAYLOR) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[CONVEX_BALL; ADD_EQ_0; ARITH] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `v:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_CX]THEN + REWRITE_TAC[real_div; GSYM REAL_POW_INV; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ARITH `abs(&k + &1) = &k + &1`] THEN + REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[GSYM real_div; REAL_POW_LT; REAL_HALF] THEN + REWRITE_TAC[COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> &0 <= d / &2`] THEN + UNDISCH_TAC `ball(w:complex,d) SUBSET s DIFF path_image g` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_BALL] THEN + UNDISCH_TAC `norm(w - v:complex) < d / &2` THEN + CONV_TAC NORM_ARITH] THEN + GEN_TAC THEN X_GEN_TAC `y:complex` THEN + REWRITE_TAC[IN_BALL; dist] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(y:complex = x)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `ball(w:complex,d) SUBSET s DIFF path_image g` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_BALL; dist] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP + (ARITH_RULE `i <= 1 ==> i = 0 \/ i = 1`)) THEN + REWRITE_TAC[ARITH] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_POW_EQ_0; COMPLEX_INV_EQ_0; CONJ_ASSOC; + COMPLEX_MUL_LZERO; COMPLEX_SUB_0; ADD_EQ_0; ARITH] THEN + REWRITE_TAC[COMPLEX_SUB_LZERO; COMPLEX_NEG_NEG; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LID; GSYM COMPLEX_MUL_ASSOC; + GSYM COMPLEX_POW_INV; GSYM COMPLEX_INV_MUL; GSYM COMPLEX_POW_ADD] THEN + ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> k - 1 + 2 = k + 1`] THEN + REWRITE_TAC[COMPLEX_INV_INV; ADD_SUB; COMPLEX_MUL_RNEG; + COMPLEX_NEG_NEG; COMPLEX_MUL_RID; COMPLEX_POW_POW] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM REAL_OF_NUM_ADD] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_POW_INV] THEN + ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_INV_EQ_0; COMPLEX_SUB_0; + COMPLEX_FIELD `~(x = Cx(&0)) /\ ~(y = Cx(&0)) + ==> (z * inv x = inv y <=> y * z = x)`] THEN + REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN AP_TERM_TAC THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`w:complex`; `u:complex`]) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; NUMSEG_CONV `0..1`] THEN + ASM_SIMP_TAC[IN_BALL; dist; VSUM_CLAUSES; FINITE_RULES] THEN + ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + REWRITE_TAC[complex_pow; VECTOR_ADD_RID; ARITH; FACT] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_DIV_1; COMPLEX_MUL_RID; COMPLEX_POW_1] THEN + SUBGOAL_THEN `~(u:complex = w)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; REAL_LT_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `~(x:complex = w)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; COMPLEX_POW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; + COMPLEX_FIELD + `~(d = Cx(&0)) /\ ~(c = Cx(&0)) /\ ~(e = Cx(&0)) + ==> a - (b + c / d * e) = ((a - b) / e / c - inv d) * c * e`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_DIV_1] THEN + REWRITE_TAC[REAL_ABS_NUM; GSYM COMPLEX_POW_INV] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN + EXISTS_TAC `&k * norm(u - w:complex)` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; LT_NZ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `n <= x ==> x < y ==> n < y`)) THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_POW_2; REAL_MUL_ASSOC; REAL_LT_RMUL_EQ] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT; LT_NZ] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = (c * a) * b`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_HALF; REAL_POW_LT] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ARITH `&0 < &k + &1`]);; + +let CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH = prove + (`!f g z r k. + ~(k = 0) /\ + (f continuous_on path_image(circlepath(z,r))) /\ + (!w. w IN ball(z,r) + ==> ((\u. f(u) / (u - w) pow k) has_path_integral g w) + (circlepath(z,r))) + ==> !w. w IN ball(z,r) + ==> (\u. f(u) / (u - w) pow (k + 1)) path_integrable_on + (circlepath(z,r)) /\ + (g has_complex_derivative + (Cx(&k) * path_integral(circlepath(z,r)) + (\u. f(u) / (u - w) pow (k + 1)))) + (at w)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_CASES_TAC `&0 <= r` THENL + [ALL_TAC; + GEN_TAC THEN REWRITE_TAC[IN_BALL] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + UNDISCH_TAC `~(&0 <= r)` THEN CONV_TAC NORM_ARITH] THEN + MP_TAC(ISPECL + [`f:complex->complex`; `g:complex->complex`; `circlepath(z,r)`; + `ball(z:complex,r)`; `k:num`; `&2 * pi * r`] CAUCHY_NEXT_DERIVATIVE) THEN + ASM_REWRITE_TAC[OPEN_BALL; VALID_PATH_CIRCLEPATH] THEN + SUBGOAL_THEN `ball(z,r) DIFF path_image(circlepath (z,r)) = ball(z,r)` + SUBST1_TAC THENL + [REWRITE_TAC[SET_RULE `s DIFF t = s <=> !x. x IN t ==> ~(x IN s)`] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; IN_SPHERE; IN_BALL; REAL_LT_REFL]; + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_DERIVATIVE_CIRCLEPATH] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_LID] THEN + REWRITE_TAC[NORM_CEXP; RE_MUL_CX; RE_MUL_II; IM_CX] THEN + REWRITE_TAC[REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID] THEN + ASM_SIMP_TAC[real_abs; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, the first derivative formula. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH = prove + (`!f z r w. + f continuous_on cball(z,r) /\ + f holomorphic_on ball(z,r) /\ + w IN ball(z,r) + ==> (\u. f(u) / (u - w) pow 2) path_integrable_on circlepath(z,r) /\ + (f has_complex_derivative + (Cx(&1) / (Cx(&2) * Cx(pi) * ii) * + path_integral(circlepath(z,r)) (\u. f(u) / (u - w) pow 2))) + (at w)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `\x:complex. Cx(&2) * Cx(pi) * ii * f x`; + `z:complex`; `r:real`; `1`] + CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN + ASM_SIMP_TAC[COMPLEX_POW_1; ARITH; CAUCHY_INTEGRAL_CIRCLEPATH] THEN + ANTS_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `n < r ==> &0 <= n ==> &0 <= r`)) THEN + SIMP_TAC[DIST_POS_LE; PATH_IMAGE_CIRCLEPATH; SPHERE_SUBSET_CBALL]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o + MATCH_MP HAS_COMPLEX_DERIVATIVE_LMUL_AT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN MP_TAC CX_2PII_NZ THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Existence of all higher derivatives. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_DERIVATIVE = prove + (`!f f' s. open s /\ (!z. z IN s ==> (f has_complex_derivative f'(z)) (at z)) + ==> f' holomorphic_on s`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`\x. Cx(&1) / (Cx(&2) * Cx pi * ii) * f(x:complex)`; + `f':complex->complex`; `z:complex`; `r:real`; `2`] + CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[CENTRE_IN_BALL]] THEN + SUBGOAL_THEN `f holomorphic_on cball(z,r)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[holomorphic_on] THEN + ASM_MESON_TAC[SUBSET; HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; + ALL_TAC] THEN + REWRITE_TAC[ARITH] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `cball(z:complex,r)` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE; SPHERE_SUBSET_CBALL]; + ALL_TAC] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `r:real`; `w:complex`] + CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; + BALL_SUBSET_CBALL]; + ALL_TAC] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o + MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM complex_div] THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN + MAP_EVERY EXISTS_TAC [`f:complex->complex`; `w:complex`] THEN + ASM_REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL]);; + +let HOLOMORPHIC_COMPLEX_DERIVATIVE = prove + (`!f s. open s /\ f holomorphic_on s + ==> (complex_derivative f) holomorphic_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOLOMORPHIC_DERIVATIVE THEN + EXISTS_TAC `f:complex->complex` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DERIVATIVE; HOLOMORPHIC_ON_OPEN]);; + +let ANALYTIC_COMPLEX_DERIVATIVE = prove + (`!f s. f analytic_on s ==> (complex_derivative f) analytic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN DISCH_TAC THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_BALL]);; + +let HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE = prove + (`!f s n. open s /\ f holomorphic_on s + ==> (higher_complex_derivative n f) holomorphic_on s`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; higher_complex_derivative]);; + +let ANALYTIC_HIGHER_COMPLEX_DERIVATIVE = prove + (`!f s n. f analytic_on s ==> (higher_complex_derivative n f) analytic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN DISCH_TAC THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_SIMP_TAC[HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE; OPEN_BALL]);; + +let HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE = prove + (`!f s x n. open s /\ f holomorphic_on s /\ x IN s + ==> ((higher_complex_derivative n f) has_complex_derivative + (higher_complex_derivative (SUC n) f x)) (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[higher_complex_derivative] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]);; + +(* ------------------------------------------------------------------------- *) +(* Morera's theorem. *) +(* ------------------------------------------------------------------------- *) + +let MORERA_LOCAL_TRIANGLE_GEN = prove + (`!f s. + (!z. z IN s + ==> ?e a. &0 < e /\ z IN ball(a,e) /\ f continuous_on ball(a,e) /\ + !b c. segment[b,c] SUBSET ball(a,e) + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)) + ==> f analytic_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[analytic_on] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`e:real`; `a:complex`] THEN STRIP_TAC THEN + EXISTS_TAC `e - dist(a:complex,z)` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN NORM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(a:complex,e)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_DERIVATIVE THEN REWRITE_TAC[OPEN_BALL] THEN + MATCH_MP_TAC TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE THEN + EXISTS_TAC `a:complex` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL]; + REWRITE_TAC[SUBSET; IN_BALL] THEN NORM_ARITH_TAC]);; + +let MORERA_LOCAL_TRIANGLE = prove + (`!f s. (!z. z IN s + ==> ?t. open t /\ z IN t /\ f continuous_on t /\ + !a b c. convex hull {a,b,c} SUBSET t + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)) + ==> f analytic_on s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC MORERA_LOCAL_TRIANGLE_GEN THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:complex->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:complex`; `w:complex`] THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM + (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL] THEN + MP_TAC(ISPECL [`x:complex`; `w:complex`] ENDS_IN_SEGMENT) THEN + ASM SET_TAC[]);; + +let MORERA_TRIANGLE = prove + (`!f s. open s /\ f continuous_on s /\ + (!a b c. convex hull {a,b,c} SUBSET s + ==> path_integral (linepath(a,b)) f + + path_integral (linepath(b,c)) f + + path_integral (linepath(c,a)) f = Cx(&0)) + ==> f analytic_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MORERA_LOCAL_TRIANGLE THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems for higher derivatives including Leibniz rule. *) +(* ------------------------------------------------------------------------- *) + +let HIGHER_COMPLEX_DERIVATIVE_EQ_ITER = prove + (`!n. higher_complex_derivative n = ITER n complex_derivative`, + INDUCT_TAC THEN + ASM_REWRITE_TAC [FUN_EQ_THM; ITER; higher_complex_derivative]);; + +let HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE = prove + (`!f m n. higher_complex_derivative m (higher_complex_derivative n f) = + higher_complex_derivative (m + n) f`, + REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_EQ_ITER; ITER_ADD]);; + +let higher_complex_derivative_alt = prove + (`(!f. higher_complex_derivative 0 f = f) /\ + (!f z n. higher_complex_derivative (SUC n) f = + higher_complex_derivative n (complex_derivative f))`, + REWRITE_TAC [HIGHER_COMPLEX_DERIVATIVE_EQ_ITER; ITER_ALT]);; + +let HIGHER_COMPLEX_DERIVATIVE_LINEAR = prove + (`!c n. higher_complex_derivative n (\w. c * w) = + \z. if n = 0 then c * z else if n = 1 then c else (Cx(&0))`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC [higher_complex_derivative; NOT_SUC; SUC_INJ; ONE] THEN + STRUCT_CASES_TAC (SPEC `n:num` num_CASES) THEN + REWRITE_TAC [NOT_SUC; SUC_INJ; + COMPLEX_DERIVATIVE_LINEAR; COMPLEX_DERIVATIVE_CONST]);; + +let HIGHER_COMPLEX_DERIVATIVE_CONST = prove + (`!i c. higher_complex_derivative i (\w.c) = \w. if i=0 then c else Cx(&0)`, + INDUCT_TAC THEN ASM_REWRITE_TAC [higher_complex_derivative_alt; NOT_SUC; + COMPLEX_DERIVATIVE_CONST; FUN_EQ_THM] THEN + MESON_TAC[]);; + +let HIGHER_COMPLEX_DERIVATIVE_ID = prove + (`!z i. higher_complex_derivative i (\w.w) z = + if i = 0 then z else if i = 1 then Cx(&1) else Cx(&0)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC [higher_complex_derivative_alt; NOT_SUC; ONE; SUC_INJ] THEN + REWRITE_TAC[COMPLEX_DERIVATIVE_ID; HIGHER_COMPLEX_DERIVATIVE_CONST; ONE]);; + +let HAS_COMPLEX_DERIVATIVE_ITER_1 = prove + (`!f n z. f z = z /\ (f has_complex_derivative Cx(&1)) (at z) + ==> (ITER n f has_complex_derivative Cx(&1)) (at z)`, + GEN_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THEN + REWRITE_TAC [ITER_POINTLESS; I_DEF; HAS_COMPLEX_DERIVATIVE_ID] THEN + SUBGOAL_THEN `Cx(&1) = Cx(&1) * Cx(&1)` SUBST1_TAC THENL + [REWRITE_TAC [COMPLEX_MUL_LID]; + ASM_SIMP_TAC [ITER_FIXPOINT; COMPLEX_DIFF_CHAIN_AT]]);; + +let HIGHER_COMPLEX_DERIVATIVE_NEG = prove + (`!f s n z. + open s /\ f holomorphic_on s /\ z IN s + ==> higher_complex_derivative n (\w. --(f w)) z = + --(higher_complex_derivative n f z)`, + REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC [higher_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `(\w. --(higher_complex_derivative n f w))` THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_NEG THEN + REWRITE_TAC [ETA_AX; GSYM higher_complex_derivative] THEN + ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]);; + +let HIGHER_COMPLEX_DERIVATIVE_ADD = prove + (`!f g s n z. + open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s ==> + higher_complex_derivative n (\w. f w + g w) z = + higher_complex_derivative n f z + higher_complex_derivative n g z`, + REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC [higher_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `(\w. higher_complex_derivative n f w + + higher_complex_derivative n g w)` THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ADD THEN + REWRITE_TAC [ETA_AX; GSYM higher_complex_derivative] THEN + ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]);; + +let HIGHER_COMPLEX_DERIVATIVE_SUB = prove + (`!f g s n z. + open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s ==> + higher_complex_derivative n (\w. f w - g w) z = + higher_complex_derivative n f z - higher_complex_derivative n g z`, + REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC [higher_complex_derivative] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `(\w. higher_complex_derivative n f w - + higher_complex_derivative n g w)` THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN + REWRITE_TAC [ETA_AX; GSYM higher_complex_derivative] THEN + ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]);; + +let HIGHER_COMPLEX_DERIVATIVE_MUL = prove + (`!f g s n z. + open s /\ f holomorphic_on s /\ g holomorphic_on s /\ z IN s + ==> higher_complex_derivative n (\w. f w * g w) z = + vsum (0..n) (\i. Cx(&(binom(n,i))) * + higher_complex_derivative i f z * + higher_complex_derivative (n-i) g z)`, + REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN INDUCT_TAC THEN + REPEAT STRIP_TAC THEN REWRITE_TAC [NUMSEG_SING; VSUM_SING; SUB] THEN + REWRITE_TAC [higher_complex_derivative; binom; COMPLEX_MUL_LID] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\w. vsum (0..n) + (\i. Cx(&(binom (n,i))) * + higher_complex_derivative i f w * + higher_complex_derivative (n-i) g w)` THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC [] THEN + SUBGOAL_THEN `vsum (0..SUC n) (\i. Cx(&(binom (SUC n,i))) * + higher_complex_derivative i f z * + higher_complex_derivative (SUC n-i) g z) = + vsum (0..n) (\i. Cx(&(binom (n,i))) * + (higher_complex_derivative i f z * + higher_complex_derivative (SUC n-i) g z + + higher_complex_derivative (SUC i) f z * + higher_complex_derivative (n-i) g z))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `!i. binom(SUC n,i) = binom(n,i) + if i=0 then 0 else binom(n,PRE i)` + (fun th -> REWRITE_TAC[th; GSYM REAL_OF_NUM_ADD; CX_ADD]) THENL + [INDUCT_TAC THEN REWRITE_TAC[binom; NOT_SUC; PRE; ADD_SYM; ADD_0]; + REWRITE_TAC [COMPLEX_ADD_LDISTRIB; COMPLEX_ADD_RDISTRIB]] THEN + SIMP_TAC [VSUM_ADD; FINITE_NUMSEG] THEN BINOP_TAC THENL + [REWRITE_TAC [VSUM_CLAUSES_NUMSEG; LE_0] THEN + SUBGOAL_THEN `binom(n,SUC n)=0` SUBST1_TAC THENL + [REWRITE_TAC [BINOM_EQ_0] THEN ARITH_TAC; CONV_TAC COMPLEX_RING]; + SIMP_TAC [VSUM_CLAUSES_LEFT; SPEC `SUC n` LE_0] THEN + REWRITE_TAC [COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; GSYM ADD1; + VSUM_SUC; o_DEF; SUB_SUC; NOT_SUC; PRE]]; + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_VSUM THEN + REWRITE_TAC [FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN + ASM_SIMP_TAC [ETA_AX; ARITH_RULE `i <= n ==> SUC n - i = SUC (n-i)`] THEN + ASM_MESON_TAC [HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]]);; + +let HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove + (`!f g s i z. + open s /\ f holomorphic_on s /\ g holomorphic_on s /\ + (!w. w IN s ==> f w = g w) /\ z IN s + ==> higher_complex_derivative i f z = higher_complex_derivative i g z`, + REWRITE_TAC [IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN INDUCT_TAC THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC [higher_complex_derivative] THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + ASM_MESON_TAC [HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]);; + +let HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR = prove + (`!f u s t n z. + f holomorphic_on t /\ open s /\ open t /\ + (!w. w IN s ==> u * w IN t) /\ z IN s + ==> higher_complex_derivative n (\w. f (u * w)) z = + u pow n * higher_complex_derivative n f (u * z)`, + REWRITE_TAC [RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC [higher_complex_derivative; complex_pow; COMPLEX_MUL_LID] THEN + REPEAT STRIP_TAC THEN EQ_TRANS_TAC + `complex_derivative + (\z. u pow n * higher_complex_derivative n f (u * z)) z` THENL + [MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC + (REWRITE_RULE [o_DEF] + (SPECL [`\z:complex. u * z`; `f:complex->complex`] + HOLOMORPHIC_ON_COMPOSE_GEN)) THEN + EXISTS_TAC `t:complex->bool` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC + (REWRITE_RULE [o_DEF] + (SPECL [`\w:complex. u:complex`; `\w:complex. w`] + HOLOMORPHIC_ON_MUL)) THEN + REWRITE_TAC [HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; + MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + SIMP_TAC [HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_CONST] THEN MATCH_MP_TAC + (REWRITE_RULE [o_DEF] + (SPECL [`\w. u * w`; `higher_complex_derivative f n`] + HOLOMORPHIC_ON_COMPOSE_GEN)) THEN + EXISTS_TAC `t:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC + (REWRITE_RULE [o_DEF] + (SPECL [`\w:complex. u:complex`; `\w:complex. w`] + HOLOMORPHIC_ON_MUL)) THEN + REWRITE_TAC [HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; + ASM_SIMP_TAC [HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]]]; + EQ_TRANS_TAC + `u pow n * complex_derivative + (\z. higher_complex_derivative n f (u * z)) z` THENL + [MATCH_MP_TAC COMPLEX_DERIVATIVE_LMUL THEN + MATCH_MP_TAC ANALYTIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC (REWRITE_RULE [o_DEF] ANALYTIC_ON_COMPOSE_GEN) THEN + EXISTS_TAC `t:complex->bool` THEN + ASM_SIMP_TAC [ANALYTIC_ON_LINEAR; ANALYTIC_HIGHER_COMPLEX_DERIVATIVE; + ANALYTIC_ON_OPEN]; + ABBREV_TAC `a = u:complex pow n` THEN + REWRITE_TAC [COMPLEX_MUL_AC; COMPLEX_EQ_MUL_LCANCEL] THEN + ASM_CASES_TAC `a = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [COMPLEX_MUL_SYM] THEN MATCH_MP_TAC + (REWRITE_RULE [o_DEF; COMPLEX_DIFFERENTIABLE_LINEAR; + COMPLEX_DERIVATIVE_LINEAR] + (SPECL [`\w. u * w`;`higher_complex_derivative n f`] + COMPLEX_DERIVATIVE_CHAIN)) THEN + ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; + HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]]]);; + +let HIGHER_COMPLEX_DERIVATIVE_ADD_AT = prove + (`!f g n z. + f analytic_on {z} /\ g analytic_on {z} + ==> higher_complex_derivative n (\w. f w + g w) z = + higher_complex_derivative n f z + + higher_complex_derivative n g z`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN + MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_ADD]);; + +let HIGHER_COMPLEX_DERIVATIVE_SUB_AT = prove + (`!f g n z. + f analytic_on {z} /\ g analytic_on {z} + ==> higher_complex_derivative n (\w. f w - g w) z = + higher_complex_derivative n f z - + higher_complex_derivative n g z`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN + MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_SUB]);; + +let HIGHER_COMPLEX_DERIVATIVE_NEG_AT = prove + (`!f n z. + f analytic_on {z} + ==> higher_complex_derivative n (\w. --(f w)) z = + --(higher_complex_derivative n f z)`, + REWRITE_TAC [ANALYTIC_AT] THEN + MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_NEG]);; + +let HIGHER_COMPLEX_DERIVATIVE_MUL_AT = prove + (`!f g n z. + f analytic_on {z} /\ g analytic_on {z} + ==> higher_complex_derivative n (\w. f w * g w) z = + vsum (0..n) (\i. Cx(&(binom(n,i))) * + higher_complex_derivative i f z * + higher_complex_derivative (n-i) g z)`, + REWRITE_TAC [ANALYTIC_AT_TWO] THEN + MESON_TAC [HIGHER_COMPLEX_DERIVATIVE_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Nonexistence of isolated singularities and a stronger integral formula. *) +(* ------------------------------------------------------------------------- *) + +let NO_ISOLATED_SINGULARITY = prove + (`!f s k. open s /\ FINITE k /\ + f continuous_on s /\ f holomorphic_on (s DIFF k) + ==> f holomorphic_on s`, + REPEAT GEN_TAC THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DIFF; FINITE_IMP_CLOSED; IMP_CONJ] THEN + REWRITE_TAC[GSYM complex_differentiable] THEN REPEAT DISCH_TAC THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `(z:complex) IN k` THEN ASM_SIMP_TAC[IN_DIFF] THEN + MP_TAC(ISPECL [`z:complex`; `k:complex->bool`] FINITE_SET_AVOID) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `f holomorphic_on ball(z,min d e)` MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; CENTRE_IN_BALL; REAL_LT_MIN; + complex_differentiable]] THEN + SUBGOAL_THEN + `?g. !w. w IN ball(z,min d e) + ==> (g has_complex_derivative f w) (at w within ball(z,min d e))` + MP_TAC THENL + [ALL_TAC; + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL] THEN + MESON_TAC[HOLOMORPHIC_DERIVATIVE; OPEN_BALL]] THEN + MATCH_MP_TAC PATHINTEGRAL_CONVEX_PRIMITIVE THEN + REWRITE_TAC[CONVEX_BALL] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `b SUBSET s ==> c SUBSET b ==> c SUBSET s`)) THEN + REWRITE_TAC[SUBSET; IN_BALL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE_COFINITE THEN + EXISTS_TAC `k:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `w:complex` THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + SPEC_TAC(`w:complex`,`w:complex`) THEN ASM_REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> (s DIFF k) SUBSET (t DIFF k)`) THEN + MATCH_MP_TAC(SET_RULE + `interior s SUBSET s /\ s SUBSET t ==> interior s SUBSET t`) THEN + REWRITE_TAC[INTERIOR_SUBSET]] THEN + (MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,e)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,min d e)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_BALL] THEN REAL_ARITH_TAC]));; + +let CAUCHY_INTEGRAL_FORMULA_CONVEX = prove + (`!f s k g z. + convex s /\ FINITE k /\ f continuous_on s /\ + (!x. x IN interior(s) DIFF k ==> f complex_differentiable at x) /\ + z IN interior(s) /\ + valid_path g /\ (path_image g) SUBSET (s DELETE z) /\ + pathfinish g = pathstart g + ==> ((\w. f(w) / (w - z)) has_path_integral + (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_INTEGRAL_FORMULA_WEAK THEN + MAP_EVERY EXISTS_TAC [`s:complex->bool`; `{}:complex->bool`] THEN + ASM_REWRITE_TAC[DIFF_EMPTY; FINITE_RULES] THEN + SIMP_TAC[GSYM HOLOMORPHIC_ON_OPEN; complex_differentiable; OPEN_INTERIOR] THEN + MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN + EXISTS_TAC `k:complex->bool` THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[INTERIOR_SUBSET]; + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DIFF; FINITE_IMP_CLOSED; + OPEN_INTERIOR; GSYM complex_differentiable]]);; + +(* ------------------------------------------------------------------------- *) +(* Formula for higher derivatives. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH = prove + (`!f z r k w. + f continuous_on cball(z,r) /\ + f holomorphic_on ball(z,r) /\ + w IN ball(z,r) + ==> ((\u. f(u) / (u - w) pow (k + 1)) + has_path_integral + ((Cx(&2) * Cx(pi) * ii) / Cx(&(FACT k)) * + higher_complex_derivative k f w)) + (circlepath(z,r))`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `&0 < r` THENL + [ALL_TAC; + REWRITE_TAC[IN_BALL] THEN + ASM_MESON_TAC[NORM_ARITH `~(&0 < r) ==> ~(dist(a,b) < r)`]] THEN + INDUCT_TAC THEN REWRITE_TAC[higher_complex_derivative] THENL + [REWRITE_TAC[ARITH; COMPLEX_POW_1; FACT; COMPLEX_DIV_1] THEN + ASM_SIMP_TAC[GSYM COMPLEX_MUL_ASSOC; CAUCHY_INTEGRAL_CIRCLEPATH]; + ALL_TAC] THEN + MP_TAC(SPECL + [`f:complex->complex`; + `\x. (Cx(&2) * Cx(pi) * ii) / Cx(&(FACT k)) * + higher_complex_derivative k f x`; + `z:complex`; `r:real`; `k + 1`] CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN + ASM_REWRITE_TAC[ADD1; ARITH_RULE `(k + 1) + 1 = k + 2`] THEN ANTS_TAC THENL + [REWRITE_TAC[ADD_EQ_0; ARITH_EQ] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE; SPHERE_SUBSET_CBALL]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN MP_TAC(SPEC `w:complex` th)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:complex` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(b = Cx(&0)) /\ x = b / a * y ==> y = a / b * x`) THEN + REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_LMUL_AT) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&(FACT k)) / (Cx(&2) * Cx pi * ii)`) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> (a / b) * (b / a) * x = x`) THEN + REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]; + REWRITE_TAC[FACT; GSYM REAL_OF_NUM_MUL; GSYM ADD1; CX_MUL] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `z:complex = y /\ ~(d = Cx(&0)) + ==> k / d * k1 * z = (k1 * k) / d * y`) THEN + REWRITE_TAC[CX_2PII_NZ] THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + ASM_REWRITE_TAC[]]);; + +let CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH = prove + (`!f z r k w. + f continuous_on cball(z,r) /\ + f holomorphic_on ball(z,r) /\ + w IN ball(z,r) + ==> (\u. f(u) / (u - w) pow (k + 1)) + path_integrable_on circlepath(z,r) /\ + higher_complex_derivative k f w = + Cx(&(FACT k)) / (Cx(&2) * Cx(pi) * ii) * + path_integral(circlepath(z,r)) (\u. f(u) / (u - w) pow (k + 1))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP + CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH) THEN + CONJ_TAC THENL [ASM_MESON_TAC[path_integrable_on]; ALL_TAC] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(b = Cx(&0)) /\ x = b / a * y ==> y = a / b * x`) THEN + REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A holomorphic function is analytic, i.e. has local power series. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_POWER_SERIES = prove + (`!f z w r. + f holomorphic_on ball(z,r) /\ w IN ball(z,r) + ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (w - z) pow n) + sums f(w)) (from 0)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?r. &0 < r /\ f holomorphic_on cball(z,r) /\ w IN ball(z,r)` + MP_TAC THENL + [EXISTS_TAC `(r + dist(w:complex,z)) / &2` THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `ball(z:complex,r)` THEN ASM_REWRITE_TAC[SUBSET]; + ALL_TAC] THEN + UNDISCH_TAC `(w:complex) IN ball(z,r)` THEN + REWRITE_TAC[IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC; + ALL_TAC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `f holomorphic_on ball(z,r) /\ f continuous_on cball(z,r)` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN ASM_MESON_TAC[BALL_SUBSET_CBALL]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\k. path_integral (circlepath(z,r)) (\u. f u / (u - z) pow (k + 1)) * + (w - z) pow k) + sums path_integral (circlepath(z,r)) (\u. f u / (u - w))) (from 0)` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `inv(Cx(&2) * Cx(pi) * ii)` o + MATCH_MP SERIES_COMPLEX_LMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `r:real`; `k:num`; + `z:complex`] CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(pit = Cx(&0)) /\ ~(fact = Cx(&0)) + ==> inv(pit) * ((pit / fact) * d) * wz = d / fact * wz`) THEN + REWRITE_TAC[CX_2PII_NZ; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]; + MP_TAC(SPECL [`f:complex->complex`; `z:complex`; `r:real`; `w:complex`] + CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(x * y * z = Cx(&0)) ==> inv(x * y * z) * x * y * z * w = w`) THEN + REWRITE_TAC[CX_2PII_NZ]]] THEN + REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. path_integral (circlepath(z,r)) + (\u. vsum (0..n) + (\k. f u * (w - z) pow k / (u - z) pow (k + 1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhs o rand) PATH_INTEGRAL_VSUM o lhand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `a * b / c:complex = b * a / c`] THEN + MATCH_MP_TAC PATH_INTEGRABLE_COMPLEX_LMUL THEN + ASM_SIMP_TAC[CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; + CENTRE_IN_BALL]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * b / c:complex = a / c * b`] THEN + MATCH_MP_TAC PATH_INTEGRAL_COMPLEX_RMUL THEN + ASM_SIMP_TAC[CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; CENTRE_IN_BALL]; + ALL_TAC] THEN + MATCH_MP_TAC(CONJUNCT2 + (REWRITE_RULE[FORALL_AND_THM; TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] + PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH)) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC PATH_INTEGRABLE_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * b / c:complex = b * a / c`] THEN + MATCH_MP_TAC PATH_INTEGRABLE_COMPLEX_LMUL THEN + ASM_SIMP_TAC[CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; CENTRE_IN_BALL]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE; IN_ELIM_THM] THEN + SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG; complex_div] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_INV_MUL; COMPLEX_POW_1] THEN + SIMP_TAC[COMPLEX_MUL_ASSOC; VSUM_COMPLEX_RMUL; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM complex_div; GSYM COMPLEX_POW_DIV] THEN + REWRITE_TAC[VSUM_GP; CONJUNCT1 LT; CONJUNCT1 complex_pow] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + SUBGOAL_THEN + `?B. &0 < B /\ + !u:complex. u IN cball(z,r) ==> norm(f u:complex) <= B` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `IMAGE (f:complex->complex) (cball(z,r))` + COMPACT_IMP_BOUNDED) THEN + ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_CBALL] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE]; + ALL_TAC] THEN + SUBGOAL_THEN `?k. &0 < k /\ k <= r /\ norm(w - z) <= r - k /\ + !u. norm(u - z) = r ==> k <= norm(u - w)` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `r - dist(z:complex,w)` THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_BALL] THEN + NORM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(z,x) = r <=> norm(x - z) = r`] THEN + MP_TAC(SPECL [`(r - k) / r:real`; `e / B * k:real`] REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_HALF; REAL_LT_MUL] THEN + ASM_REWRITE_TAC[REAL_ARITH `r - k < &1 * r <=> &0 < k`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + X_GEN_TAC `u:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(u:complex = z) /\ ~(u = w)` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + MAP_EVERY UNDISCH_TAC [`&0 < r`; `norm(u - z:complex) = r`] THEN + NORM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(u = z) /\ ~(u = w) ==> ~((w - z) / (u - z) = Cx(&1))`] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(u = z) /\ ~(u = w) + ==> x / (Cx(&1) - (w - z) / (u - z)) / (u - z) = x / (u - w)`] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(u = w) + ==> (Cx(&1) - e) / (u - w) - inv(u - w) = --(e / (u - w))`] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; NORM_NEG; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * ((r - k) / r) pow N / k:real` THEN CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ]] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[NORM_POS_LE] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_CBALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[dist; REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; + ALL_TAC] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[GSYM real_div] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; + ALL_TAC; + REWRITE_TAC[REAL_LE_INV_EQ; NORM_POS_LE]; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `((r - k) / r:real) pow (SUC n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_SIMP_TAC[ARITH_RULE `N <= n ==> N <= SUC n`] THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* These weak Liouville versions don't even need the derivative formula. *) +(* ------------------------------------------------------------------------- *) + +let LIOUVILLE_WEAK = prove + (`!f l. f holomorphic_on (:complex) /\ (f --> l) at_infinity + ==> !z. f(z) = l`, + SUBGOAL_THEN + `!f. f holomorphic_on (:complex) /\ (f --> Cx(&0)) at_infinity + ==> !z. f(z) = Cx(&0)` + MP_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPEC + `\z. (f:complex->complex) z - l`) THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; + ETA_AX; GSYM LIM_NULL; GSYM COMPLEX_VEC_0]] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TAUT `p = ~ ~ p`] THEN + PURE_REWRITE_TAC[GSYM COMPLEX_NORM_NZ] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_INFINITY]) THEN + DISCH_THEN(MP_TAC o SPEC `norm((f:complex->complex) z) / &2`) THEN + ASM_REWRITE_TAC[dist; REAL_HALF; COMPLEX_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`f:complex->complex`; `z:complex`; + `&1 + abs B + norm(z:complex)`; `z:complex`] + CAUCHY_INTEGRAL_CIRCLEPATH) THEN + ASM_SIMP_TAC[CONVEX_UNIV; INTERIOR_OPEN; OPEN_UNIV; IN_UNIV] THEN + ABBREV_TAC `R = &1 + abs B + norm(z:complex)` THEN + SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL + [ASM_MESON_TAC[NORM_POS_LE; REAL_ABS_POS; REAL_ARITH + `&0 <= x /\ &0 <= y ==> &0 < &1 + x + y`]; ALL_TAC] THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; NOT_IMP; CONJ_ASSOC] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; + SUBSET_UNIV]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH)) THEN + DISCH_THEN(MP_TAC o SPEC `norm((f:complex->complex) z) / &2 / R`) THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_POS; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < R ==> x / R * &2 * pi * R = &2 * pi * x`] THEN + REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LE_DIV2_EQ] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `norm(x - z:complex) = R` THEN EXPAND_TAC "R" THEN + MATCH_MP_TAC(REAL_ARITH + `d <= x + z ==> d = &1 + abs b + z ==> x >= b`) THEN + REWRITE_TAC[VECTOR_SUB] THEN MESON_TAC[NORM_TRIANGLE; NORM_NEG]; + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_PI; + COMPLEX_NORM_II] THEN + SIMP_TAC[REAL_LT_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS; REAL_MUL_LID] THEN + SUBGOAL_THEN `?w:complex. norm w = abs B` MP_TAC THENL + [MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_ABS_POS]; ALL_TAC] THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH + `abs B >= B /\ (&0 <= x /\ x < z / &2 ==> z / &2 < z)`]]);; + +let LIOUVILLE_WEAK_INVERSE = prove + (`!f. f holomorphic_on (:complex) /\ + (!B. eventually (\x. norm(f x) >= B) at_infinity) + ==> ?z. f(z) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN + PURE_REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN + MP_TAC(SPECL [`\x:complex. Cx(&1) / (f(x))`; `Cx(&0)`] LIOUVILLE_WEAK) THEN + ASM_SIMP_TAC[COMPLEX_FIELD `~(y = Cx(&0)) ==> ~(Cx(&1) / y = Cx(&0))`] THEN + CONJ_TAC THENL + [REWRITE_TAC[holomorphic_on; complex_div; COMPLEX_MUL_LID; IN_UNIV] THEN + GEN_TAC THEN REWRITE_TAC[GSYM complex_differentiable; WITHIN_UNIV] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_INV_AT THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[OPEN_UNIV; HOLOMORPHIC_ON_OPEN; IN_UNIV; + complex_differentiable]; + REWRITE_TAC[tendsto] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&2/ e`) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO; real_ge; COMPLEX_NORM_DIV; + COMPLEX_NORM_CX; REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* In particular we get the Fundamental Theorem of Algebra. *) +(* ------------------------------------------------------------------------- *) + +let FTA = prove + (`!a n. a(0) = Cx(&0) \/ ~(!k. k IN 1..n ==> a(k) = Cx(&0)) + ==> ?z. vsum(0..n) (\i. a(i) * z pow i) = Cx(&0)`, + REPEAT STRIP_TAC THENL + [EXISTS_TAC `Cx(&0)` THEN + SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0] THEN + ASM_SIMP_TAC[ADD_CLAUSES; COMPLEX_POW_ZERO; LE_1; COMPLEX_ADD_LID; + COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0]; + MATCH_MP_TAC LIOUVILLE_WEAK_INVERSE THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_VSUM THEN + SIMP_TAC[FINITE_NUMSEG; HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_MUL; + HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID]; + ASM_MESON_TAC[COMPLEX_POLYFUN_EXTREMAL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Weierstrass convergence theorem. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_UNIFORM_LIMIT = prove + (`!net:(A net) f g z r. + ~(trivial_limit net) /\ + eventually + (\n. (f n) continuous_on cball(z,r) /\ + (f n) holomorphic_on ball(z,r)) + net /\ + (!e. &0 < e + ==> eventually (\n. !x. x IN cball(z,r) ==> norm(f n x - g x) < e) + net) + ==> g continuous_on cball(z,r) /\ g holomorphic_on ball(z,r)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL + [ASM_SIMP_TAC[BALL_EMPTY; holomorphic_on; NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `r <= &0 ==> r < &0 \/ r = &0`)) THEN + ASM_SIMP_TAC[continuous_on; CBALL_EMPTY; CBALL_SING; NOT_IN_EMPTY] THEN + SIMP_TAC[IN_SING; DIST_REFL] THEN MESON_TAC[REAL_LT_01]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_UNIFORM_LIMIT THEN + MAP_EVERY EXISTS_TAC [`net:A net`; `f:A->complex->complex`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[EVENTUALLY_AND]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL + [`\x. Cx(&1) / (Cx(&2) * Cx pi * ii) * g(x:complex)`; + `g:complex->complex`; `z:complex`; `r:real`; `1`] + CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH) THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[ARITH] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN + EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN + SIMP_TAC[SPHERE_SUBSET_CBALL]; + ALL_TAC] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN REWRITE_TAC[COMPLEX_POW_1] THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[GSYM complex_div] THEN REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + SUBGOAL_THEN + `(\u. g u / (u - w)) path_integrable_on circlepath(z,r) /\ + ((\n:A. path_integral(circlepath(z,r)) + (\u. f n u / (u - w))) --> + path_integral(circlepath(z,r)) (\u. g u / (u - w))) net` + MP_TAC THENL + [MATCH_MP_TAC PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN + SIMP_TAC[SUBSET; IN_CBALL; IN_ELIM_THM; NORM_SUB; dist; REAL_LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[COMPLEX_POW_EQ_0; ARITH; IN_ELIM_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[COMPLEX_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e * abs(r - norm(w - z:complex))`) THEN + SUBGOAL_THEN `&0 < e * abs(r - norm(w - z:complex))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[GSYM REAL_ABS_NZ] THEN + SIMP_TAC[REAL_SUB_0] THEN + ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[dist; REAL_LE_REFL] THEN + SUBGOAL_THEN `~(x:complex = w)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[IN_BALL; dist; NORM_SUB; REAL_LT_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = w) ==> a / (x - w) - b / (x - w) = + (a - b:complex) / (x - w)`] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; + COMPLEX_POW_EQ_0; COMPLEX_SUB_0] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC(REAL_ARITH `w < r /\ r <= x + w ==> abs(r - w) <= x`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL; dist; NORM_SUB]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE]; + ALL_TAC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o + MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_LMUL) THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC LIM_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`net:A net`; `\n. (f:A->complex->complex) n w`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[tendsto; dist] THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL]] THEN + SUBGOAL_THEN + `((\n:A. Cx(&2) * Cx pi * ii * f n w) + --> path_integral (circlepath (z,r)) (\u. g u / (u - w))) net` + MP_TAC THENL + [MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC + `\n:A. path_integral (circlepath (z,r)) (\u. f n u / (u - w))` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC CAUCHY_INTEGRAL_CIRCLEPATH THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` o + MATCH_MP LIM_COMPLEX_LMUL) THEN + SIMP_TAC[CX_2PII_NZ; COMPLEX_FIELD + `~(x * y * z = Cx(&0)) ==> Cx(&1) / (x * y * z) * x * y * z * w = w`]);; + +(* ------------------------------------------------------------------------- *) +(* Version showing that the limit is the limit of the derivatives. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT = prove + (`!net:(A net) f f' g z r. + &0 < r /\ ~(trivial_limit net) /\ + eventually + (\n. (f n) continuous_on cball(z,r) /\ + (!w. w IN ball(z,r) + ==> ((f n) has_complex_derivative (f' n w)) (at w))) + net /\ + (!e. &0 < e + ==> eventually (\n. !x. x IN cball(z,r) ==> norm(f n x - g x) < e) + net) + ==> g continuous_on cball(z,r) /\ + ?g'. !w. w IN ball(z,r) + ==> (g has_complex_derivative (g' w)) (at w) /\ + ((\n. f' n w) --> g' w) net`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`net:(A)net`; `f:A->complex->complex`; + `g:complex->complex`; `z:complex`; `r:real`] + HOLOMORPHIC_UNIFORM_LIMIT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + EVENTUALLY_MONO)) THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN MESON_TAC[]; + ALL_TAC] THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM])) THEN + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g':complex->complex` THEN STRIP_TAC THEN + ASM_SIMP_TAC[] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\n. Cx(&1) / (Cx(&2) * Cx pi * ii) * + (path_integral(circlepath(z,r)) (\x. f (n:A) x / (x - w) pow 2) - + path_integral(circlepath(z,r)) (\x. g x / (x - w) pow 2))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + EVENTUALLY_MONO)) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN BINOP_TAC THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THENL + [EXISTS_TAC `(f:A->complex->complex) a`; + EXISTS_TAC `g:complex->complex`] THEN + EXISTS_TAC `w:complex` THEN ASM_SIMP_TAC[] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (rand o rand) + CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH w)) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + ANTS_TAC THEN SIMP_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN + SUBST1_TAC(SYM(SPEC `Cx(&1) / (Cx(&2) * Cx pi * ii)` COMPLEX_MUL_RZERO)) THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[GSYM LIM_NULL] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (rand o rand) + PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH w)) THEN + ANTS_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO)) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN + SIMP_TAC[SUBSET; IN_CBALL; IN_ELIM_THM; NORM_SUB; dist; REAL_LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[COMPLEX_POW_EQ_0; ARITH; IN_ELIM_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[COMPLEX_SUB_0] THEN DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e * abs(r - norm(w - z:complex)) pow 2`) THEN + SUBGOAL_THEN `&0 < e * abs(r - norm(w - z:complex)) pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[GSYM REAL_ABS_NZ] THEN + SIMP_TAC[REAL_SUB_0] THEN + ASM_MESON_TAC[IN_BALL; dist; REAL_LT_REFL; DIST_SYM]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `a:A` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:complex` THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[dist; REAL_LE_REFL] THEN + SUBGOAL_THEN `~(x:complex = w)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[IN_BALL; dist; NORM_SUB; REAL_LT_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = w) ==> a / (x - w) pow 2 - b / (x - w) pow 2 = + (a - b:complex) / (x - w) pow 2`] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; + COMPLEX_POW_EQ_0; COMPLEX_SUB_0] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `w < r /\ r <= x + w ==> abs(r - w) <= x`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL; dist; NORM_SUB]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE]);; + +(* ------------------------------------------------------------------------- *) +(* Some more simple/convenient versions for applications. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_UNIFORM_SEQUENCE = prove + (`!f g s. + open s /\ + (!n. (f n) holomorphic_on s) /\ + (!x. x IN s + ==> ?d. &0 < d /\ cball(x,d) SUBSET s /\ + !e. &0 < e + ==> eventually (\n. !y. y IN cball(x,d) + ==> norm(f n y - g y) < e) + sequentially) + ==> g holomorphic_on s`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`sequentially`; `f:num->complex->complex`; + `g:complex->complex`; `z:complex`; `r:real`] + HOLOMORPHIC_UNIFORM_LIMIT) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ANTS_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; + BALL_SUBSET_CBALL]; + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + ASM_MESON_TAC[CENTRE_IN_BALL]]);; + +let HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE = prove + (`!f f' g s. + open s /\ + (!n x. x IN s ==> ((f n) has_complex_derivative f' n x) (at x)) /\ + (!x. x IN s + ==> ?d. &0 < d /\ cball(x,d) SUBSET s /\ + !e. &0 < e + ==> eventually (\n. !y. y IN cball(x,d) + ==> norm(f n y - g y) < e) + sequentially) + ==> ?g'. !x. x IN s ==> (g has_complex_derivative g'(x)) (at x) /\ + ((\n. f' n x) --> g'(x)) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`sequentially`; `f:num->complex->complex`; + `f':num->complex->complex`; + `g:complex->complex`; `z:complex`; `r:real`] + HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN ANTS_TAC THENL + [ALL_TAC; ASM_MESON_TAC[CENTRE_IN_BALL]] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; SUBSET]; + ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* A one-stop shop for an analytic function defined by a series. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_AND_DERIVATIVE_COMPARISON = prove + (`!f f' s k h. + open s /\ + (!n x. n IN k /\ x IN s ==> (f n has_complex_derivative f' n x) (at x)) /\ + (?l. (lift o h sums l) k) /\ + (?N. !n x. N <= n /\ n IN k /\ x IN s ==> norm(f n x) <= h n) + ==> ?g g'. !x. x IN s + ==> ((\n. f n x) sums g x) k /\ + ((\n. f' n x) sums g' x) k /\ + (g has_complex_derivative g' x) (at x)`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o MATCH_MP SERIES_COMPARISON_UNIFORM) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[TAUT `a ==> b /\ c /\ d <=> (a ==> b) /\ (a ==> d /\ c)`] THEN + REWRITE_TAC[FORALL_AND_THM; RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[sums] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE THEN + EXISTS_TAC `\n x. vsum + (k INTER (0..n)) (\n. (f:num->complex->complex) n x)` THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_VSUM; FINITE_INTER_NUMSEG; IN_INTER] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN + ASM_MESON_TAC[SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A version where we only have local uniform/comparative convergence. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_AND_DERIVATIVE_COMPARISON_LOCAL = prove + (`!f f' s k. + open s /\ + (!n x. n IN k /\ x IN s ==> (f n has_complex_derivative f' n x) (at x)) /\ + (!x. x IN s + ==> ?d h N. &0 < d /\ (?l. (lift o h sums l) k) /\ + !n y. N <= n /\ n IN k /\ y IN ball(x,d) + ==> norm(f n y) <= h n) + ==> ?g g'. !x. x IN s + ==> ((\n. f n x) sums g x) k /\ + ((\n. f' n x) sums g' x) k /\ + (g has_complex_derivative g' x) (at x)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. infsum k (\n. (f:num->complex->complex) n x)` THEN + REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:real`; `h:num->real`; `N:num`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:num->complex->complex`; `f':num->complex->complex`; + `ball(z:complex,d) INTER s`; `k:num->bool`; `h:num->real`] + SERIES_AND_DERIVATIVE_COMPARISON) THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL; IN_INTER] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM; RIGHT_EXISTS_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_AND_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN + X_GEN_TAC `g':complex` THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[SUMS_INFSUM; CENTRE_IN_BALL; summable]; ALL_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + EXISTS_TAC `g:complex->complex` THEN + MP_TAC(ISPEC `ball(z:complex,d) INTER s` OPEN_CONTAINS_BALL) THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_INTER] THEN + ASM_MESON_TAC[INFSUM_UNIQUE; SUBSET; IN_BALL; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Sometimes convenient to compare with a complex series of +ve reals. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX = prove + (`!f f' s k. + open s /\ + (!n x. n IN k /\ x IN s ==> (f n has_complex_derivative f' n x) (at x)) /\ + (!x. x IN s + ==> ?d h N. &0 < d /\ summable k h /\ + (!n. n IN k ==> real(h n) /\ &0 <= Re(h n)) /\ + (!n y. N <= n /\ n IN k /\ y IN ball(x,d) + ==> norm(f n y) <= norm(h n))) + ==> ?g g'. !x. x IN s + ==> ((\n. f n x) sums g x) k /\ + ((\n. f' n x) sums g' x) k /\ + (g has_complex_derivative g' x) (at x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_LOCAL THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:real` THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_THEN(X_CHOOSE_THEN `h:num->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n. norm((h:num->complex) n)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [summable]) THEN + DISCH_THEN(X_CHOOSE_THEN `l:complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `lift(Re l)` THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\i:num. lift(Re(h i))` THEN + ASM_SIMP_TAC[REAL_NORM_POS; o_DEF] THEN + REWRITE_TAC[RE_DEF] THEN MATCH_MP_TAC SERIES_COMPONENT THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH]);; + +let SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX = prove + (`!f s k. + open s /\ + (!n x. n IN k /\ x IN s ==> (f n) complex_differentiable (at x)) /\ + (!x. x IN s + ==> ?d h N. &0 < d /\ summable k h /\ + (!n. n IN k ==> real(h n) /\ &0 <= Re(h n)) /\ + (!n y. N <= n /\ n IN k /\ y IN ball(x,d) + ==> norm(f n y) <= norm(h n))) + ==> ?g. !x. x IN s + ==> ((\n. f n x) sums g x) k /\ + g complex_differentiable (at x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[complex_differentiable; RIGHT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC (PAT_CONV `\x. a /\ x /\ b ==> x` o ONCE_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP + SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX)) THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, a power series is analytic inside circle of convergence. *) +(* ------------------------------------------------------------------------- *) + +let POWER_SERIES_AND_DERIVATIVE_0 = prove + (`!k a r. summable k (\n. a(n) * Cx(r) pow n) + ==> ?g g'. + !z. norm(z) < r + ==> ((\n. a(n) * z pow n) sums g(z)) k /\ + ((\n. Cx(&n) * a(n) * z pow (n - 1)) sums g'(z)) k /\ + (g has_complex_derivative g' z) (at z)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `&0 < r` THEN + ASM_SIMP_TAC[NORM_ARITH `~(&0 < r) ==> ~(norm z < r)`] THEN + SUBGOAL_THEN `!z. norm(z) < r <=> z IN ball(Cx(&0),r)` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG]; ALL_TAC] THEN + MATCH_MP_TAC SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX THEN + REWRITE_TAC[OPEN_BALL; IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC + [`(r - norm(z:complex)) / &2`; + `\n. Cx(norm(a(n):complex) * ((r + norm(z:complex)) / &2) pow n)`; + `0`] THEN + ASM_REWRITE_TAC[REAL_SUB_LT; REAL_HALF; REAL_CX; RE_CX] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[CX_MUL; CX_POW] THEN + MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV_WEAK THEN + EXISTS_TAC `Cx r` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_NORM_CX]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_POW_LE; + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + REWRITE_TAC[COMPLEX_NORM_POW; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_LE2] THEN + ASM_NORM_ARITH_TAC);; + +let POWER_SERIES_AND_DERIVATIVE = prove + (`!k a r w. + summable k (\n. a(n) * Cx(r) pow n) + ==> ?g g'. + !z. z IN ball(w,r) + ==> ((\n. a(n) * (z - w) pow n) sums g(z)) k /\ + ((\n. Cx(&n) * a(n) * (z - w) pow (n - 1)) sums g'(z)) k /\ + (g has_complex_derivative g' z) (at z)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POWER_SERIES_AND_DERIVATIVE_0) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:complex->complex`; `g':complex->complex`] THEN + DISCH_TAC THEN + EXISTS_TAC `(\z. g(z - w)):complex->complex` THEN + EXISTS_TAC `(\z. g'(z - w)):complex->complex` THEN + REWRITE_TAC[IN_BALL; dist] THEN X_GEN_TAC `z:complex` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z - w:complex`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[NORM_SUB]; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM COMPLEX_MUL_RID] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN ASM_REWRITE_TAC[] THEN + COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO]);; + +let POWER_SERIES_HOLOMORPHIC = prove + (`!a k f z r. (!w. w IN ball(z,r) ==> ((\n. a(n) * (w - z) pow n) sums f w) k) + ==> f holomorphic_on ball(z,r)`, + REPEAT STRIP_TAC THEN SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_BALL; dist] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`k:num->bool`; `a:num->complex`; + `(norm(z - w:complex) + r) / &2`; `z:complex`] + POWER_SERIES_AND_DERIVATIVE) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `z + Cx((norm(z - w) + r) / &2)`) THEN + REWRITE_TAC[IN_BALL; dist; COMPLEX_RING `(z + w) - z:complex = w`; + NORM_ARITH `norm(z - (z + w)) = norm w`; summable] THEN + ANTS_TAC THENL [REWRITE_TAC[COMPLEX_NORM_CX]; MESON_TAC[]] THEN + POP_ASSUM MP_TAC THEN NORM_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g':complex->complex` (LABEL_TAC "*")) THEN + EXISTS_TAC `(g':complex->complex) w` THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC + [`g:complex->complex`; `(r - norm(z - w:complex)) / &2`] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `norm(z - w:complex) < r` THEN NORM_ARITH_TAC; + ALL_TAC; + REMOVE_THEN "*" (MP_TAC o SPEC `w:complex`) THEN ANTS_TAC THENL + [ALL_TAC; SIMP_TAC[]] THEN REWRITE_TAC[IN_BALL] THEN + UNDISCH_TAC `norm(z - w:complex) < r` THEN NORM_ARITH_TAC] THEN + X_GEN_TAC `u:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN + MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `(\n. a(n) * (u - z) pow n):num->complex` THEN + EXISTS_TAC `k:num->bool` THEN CONJ_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `u:complex`) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]]; + FIRST_X_ASSUM MATCH_MP_TAC] THEN + REWRITE_TAC[IN_BALL] THEN ASM_NORM_ARITH_TAC);; + +let HOLOMORPHIC_IFF_POWER_SERIES = prove + (`!f z r. f holomorphic_on ball(z,r) <=> + !w. w IN ball(z,r) + ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (w - z) pow n) sums + f w) + (from 0)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_POWER_SERIES]; ALL_TAC] THEN + MATCH_MP_TAC POWER_SERIES_HOLOMORPHIC THEN + MAP_EVERY EXISTS_TAC + [`\n. higher_complex_derivative n f z / Cx(&(FACT n))`; + `from 0`] THEN + ASM_REWRITE_TAC[]);; + +let POWER_SERIES_ANALYTIC = prove + (`!a k f z r. (!w. w IN ball(z,r) ==> ((\n. a(n) * (w - z) pow n) sums f w) k) + ==> f analytic_on ball(z,r)`, + SIMP_TAC[ANALYTIC_ON_OPEN; OPEN_BALL] THEN + REWRITE_TAC[POWER_SERIES_HOLOMORPHIC]);; + +let ANALYTIC_IFF_POWER_SERIES = prove + (`!f z r. f analytic_on ball(z,r) <=> + !w. w IN ball(z,r) + ==> ((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (w - z) pow n) sums + f w) + (from 0)`, + SIMP_TAC[ANALYTIC_ON_OPEN; OPEN_BALL] THEN + REWRITE_TAC[HOLOMORPHIC_IFF_POWER_SERIES]);; + +let HIGHER_COMPLEX_DERIVATIVE_POWER_SERIES = prove + (`!f c r n. + &0 < r /\ n IN k /\ + (!w. dist(w,z) < r ==> ((\i. c i * (w - z) pow i) sums f(w)) k) + ==> higher_complex_derivative n f z / Cx(&(FACT n)) = c n`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `f holomorphic_on ball(z,r)` ASSUME_TAC THENL + [MATCH_MP_TAC POWER_SERIES_HOLOMORPHIC THEN + REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[DIST_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. i IN (:num) + ==> higher_complex_derivative i f z / Cx(&(FACT i)) - + (if i IN k then c i else vec 0) = Cx(&0)` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[IN_UNIV; COMPLEX_SUB_0]] THEN + MATCH_MP_TAC POWER_SERIES_LIMIT_POINT_OF_ZEROS THEN MAP_EVERY EXISTS_TAC + [`\w:complex. Cx(&0)`; `r:real`; `ball(z:complex,r)`] THEN + ASM_SIMP_TAC[LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_SUB_RDISTRIB] THEN + SUBST1_TAC(COMPLEX_RING `Cx(&0) = (f:complex->complex) w - f w`) THEN + MATCH_MP_TAC SERIES_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM FROM_0] THEN MATCH_MP_TAC HOLOMORPHIC_POWER_SERIES THEN + ASM_MESON_TAC[IN_BALL; DIST_SYM]; + REWRITE_TAC[COND_RAND; COND_RATOR; COMPLEX_VEC_0] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO] THEN + ASM_SIMP_TAC[GSYM COMPLEX_VEC_0; SERIES_RESTRICT]]);; + +(* ------------------------------------------------------------------------- *) +(* Taylor series for arctan. So we can do term-by-term integration of *) +(* geometric series, this ends up quite late in the development. *) +(* ------------------------------------------------------------------------- *) + +let CATAN_CONVERGS = prove + (`!z. norm(z) < &1 + ==> ((\n. --(Cx(&1)) pow n / Cx(&(2 * n + 1)) * z pow (2 * n + 1)) + sums catn(z)) (from 0)`, + MP_TAC(ISPECL + [`\n z. --(Cx(&1)) pow n / Cx(&(2 * n + 1)) * z pow (2 * n + 1)`; + `\n z. --(Cx(&1)) pow n * z pow (2 * n)`; + `ball(Cx(&0),&1)`; `from 0` + ] SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX) THEN + REWRITE_TAC[OPEN_BALL; COMPLEX_IN_BALL_0] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_RID; ADD_SUB] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_NEG; GSYM CX_MUL; GSYM CX_DIV; CX_INJ; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + CONV_TAC REAL_FIELD; + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + EXISTS_TAC `(&1 - norm(z:complex)) / &2` THEN + EXISTS_TAC `\n. Cx((&1 + norm(z:complex)) / &2) pow (2 * n + 1)` THEN + EXISTS_TAC `1` THEN REWRITE_TAC[o_DEF] THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_POW_ADD; GSYM COMPLEX_POW_POW] THEN + MATCH_MP_TAC SUMMABLE_COMPLEX_RMUL THEN MATCH_MP_TAC SUMMABLE_GP THEN + REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_POW; ABS_SQUARE_LT_1] THEN + POP_ASSUM MP_TAC THEN NORM_ARITH_TAC; + SIMP_TAC[RE_CX; REAL_POW; REAL_CX; GSYM CX_POW] THEN + SIMP_TAC[REAL_POW_LE; NORM_ARITH `&0 <= (&1 + norm(z:complex)) / &2`]; + REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_POW; NORM_NEG; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POS; NORM_POS_LE; REAL_POW_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INV_LE_1 THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + ARITH_TAC; + MATCH_MP_TAC REAL_POW_LE2 THEN + UNDISCH_TAC `dist(z:complex,y) < (&1 - norm z) / &2` THEN + CONV_TAC NORM_ARITH]]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM COMPLEX_POW_POW] THEN + MAP_EVERY X_GEN_TAC [`a:complex->complex`; `i:complex->complex`] THEN + REWRITE_TAC[GSYM COMPLEX_POW_MUL; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\z. a z - catn(z)`; `ball(Cx(&0),&1)`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN + REWRITE_TAC[CONVEX_BALL; COMPLEX_IN_BALL_0] THEN ANTS_TAC THENL + [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + SUBST1_TAC(COMPLEX_RING `Cx(&0) = i(w:complex) - i w`) THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN + ASM_SIMP_TAC[COMPLEX_SUB_REFL; HAS_COMPLEX_DERIVATIVE_AT_WITHIN] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MP_TAC(ISPEC `w:complex` HAS_COMPLEX_DERIVATIVE_CATN) THEN ANTS_TAC THENL + [ASM_MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC SERIES_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`\n. --(w pow 2) pow n`; `from 0`] THEN + ASM_SIMP_TAC[] THEN + MP_TAC(SPECL [`0`; `--((w:complex) pow 2)`] SUMS_GP) THEN + ASM_SIMP_TAC[complex_pow; COMPLEX_NORM_POW; NORM_NEG; ABS_SQUARE_LT_1; + REAL_ABS_NORM; complex_div; COMPLEX_MUL_LID; COMPLEX_SUB_RNEG]; + DISCH_THEN(X_CHOOSE_THEN `c:complex` (fun th -> + MP_TAC th THEN MP_TAC(SPEC `Cx(&0)` th))) THEN + ASM_SIMP_TAC[CATN_0; COMPLEX_NORM_0; REAL_LT_01; COMPLEX_SUB_RZERO] THEN + FIRST_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN + SIMP_TAC[COMPLEX_NORM_0; REAL_LT_01] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_POW_1; COMPLEX_MUL_RZERO] THEN + MP_TAC(SPECL [`\n:num. Cx(&0)`; `from 0`] SUMS_COMPLEX_0) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP SERIES_UNIQUE) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_SIMP_TAC[COMPLEX_POW_ADD; COMPLEX_POW_1]]]);; + +let TAYLOR_CATN = prove + (`!n z. norm(z) < &1 + ==> norm(catn z - + vsum(0..n) (\k. --(Cx(&1)) pow k / Cx(&(2 * k + 1)) * + z pow (2 * k + 1))) + <= norm(z) pow (2 * n + 3) / + ((&2 * &n + &3) * (&1 - norm z pow 2))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CATAN_CONVERGS) THEN + DISCH_THEN(MP_TAC o SPEC `n + 1` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `0 < n + 1`; ADD_SUB] THEN + MATCH_MP_TAC(MESON[] + `(!l. (f sums l) k ==> norm l <= e) ==> (f sums a) k ==> norm a <= e`) THEN + GEN_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] SERIES_BOUND) THEN + EXISTS_TAC + `\i. norm(z:complex) / (&2 * &n + &3) * (norm(z) pow 2) pow i` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SERIES_CX_LIFT; o_DEF] THEN + MP_TAC(ISPECL [`n + 1`; `Cx(norm(z:complex) pow 2)`] SUMS_GP) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_POW; REAL_ABS_NORM; + ABS_SQUARE_LT_1; REAL_ABS_ABS] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(norm(z:complex) / (&2 * &n + &3))` o + MATCH_MP SERIES_COMPLEX_LMUL) THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_SUB; GSYM CX_DIV; GSYM CX_MUL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_POW_POW; REAL_POW_ADD; REAL_POW_1; real_div; + REAL_INV_MUL] THEN + REAL_ARITH_TAC; + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM] THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_POW_ONE] THEN + GEN_REWRITE_TAC RAND_CONV + [REAL_ARITH `a / b * c:real = inv b * (a * c)`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow); REAL_POW_POW; ADD1] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN + REWRITE_TAC[REAL_MUL_LID; real_div] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; + REAL_OF_NUM_LT; REAL_OF_NUM_MUL] THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Taylor series for log. It's this late because we can more easily get *) +(* a good error bound given the convergence of the series. *) +(* ------------------------------------------------------------------------- *) + +let CLOG_CONVERGES = prove + (`!z. norm(z) < &1 + ==> ((\n. --Cx(&1) pow (n + 1) * z pow n / Cx(&n)) sums clog(Cx(&1) + z)) + (from 1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`clog o (\z. Cx(&1) + z)`; `Cx(&0)`; `&1`] + HOLOMORPHIC_IFF_POWER_SERIES) THEN + REWRITE_TAC[COMPLEX_IN_BALL_0; o_THM] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC; + MATCH_MP_TAC HOLOMORPHIC_ON_CLOG THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RE_ADD; RE_CX] THEN + REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN + + MATCH_MP_TAC(REAL_ARITH + `abs(Re x) <= norm x /\ norm x < &1 ==> &0 < &1 + Re x`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `1` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN + REWRITE_TAC[o_DEF; higher_complex_derivative; CLOG_1; COMPLEX_ADD_RID] THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMS_EQ) THEN + REWRITE_TAC[COMPLEX_RING + `(h * f) * z = p * z * g <=> z = Cx(&0) \/ h * f = p * g`] THEN + SUBGOAL_THEN + `!n w. 1 <= n /\ norm w < &1 + ==> higher_complex_derivative n (\z. clog(Cx(&1) + z)) w = + --Cx(&1) pow (n + 1) * Cx(&(FACT(n - 1))) / (Cx(&1) + w) pow n` + (fun th -> SIMP_TAC[IN_FROM; COMPLEX_NORM_0; REAL_LT_01; th]) + THENL + [INDUCT_TAC THEN REWRITE_TAC[ARITH; higher_complex_derivative] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[higher_complex_derivative] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_POW_1] THEN + COMPLEX_DIFF_TAC THEN + REWRITE_TAC[complex_div; COMPLEX_POW_NEG; COMPLEX_ADD_LID] THEN + REWRITE_TAC[COMPLEX_POW_ONE; ARITH; COMPLEX_MUL_LID] THEN + DISCH_TAC THEN REWRITE_TAC[RE_ADD; RE_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(Re x) <= norm x /\ norm x < &1 ==> &0 < &1 + Re x`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REAL_ARITH_TAC; + + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + MAP_EVERY EXISTS_TAC + [`\w. --Cx(&1) pow (n + 1) * Cx(&(FACT(n - 1))) / (Cx(&1) + w) pow n`; + `ball(Cx(&0),&1)`] THEN + ASM_SIMP_TAC[OPEN_BALL; LE_1; COMPLEX_IN_BALL_0] THEN + COMPLEX_DIFF_TAC THEN + ASM_SIMP_TAC[FACT; ARITH_RULE `~(n = 0) ==> SUC n - 1 = SUC(n - 1)`] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_POW_ADD; complex_pow; COMPLEX_POW_1] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; complex_div; + COMPLEX_SUB_LZERO] THEN + REWRITE_TAC[GSYM complex_div; COMPLEX_NEG_NEG; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + REWRITE_TAC[GSYM(CONJUNCT2 complex_pow); complex_div] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + ASM_REWRITE_TAC[GSYM complex_div; COMPLEX_POW_EQ_0] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ (p ==> q)`] THEN + SIMP_TAC[COMPLEX_DIV_POW2; COMPLEX_POW_POW] THEN + ASM_REWRITE_TAC[ARITH_RULE `n * 2 <= n - 1 <=> n = 0`] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n * 2 - (n - 1) = SUC n`] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN + REWRITE_TAC[complex_div; CX_MUL; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[COMPLEX_MUL_AC] THEN + MP_TAC(SPEC `&1` COMPLEX_NORM_CX) THEN + UNDISCH_TAC `norm(w:complex) < &1` THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN CONV_TAC NORM_ARITH]; + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH] THEN + X_GEN_TAC `n:num` THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN DISJ2_TAC THEN + REWRITE_TAC[FACT; ARITH_RULE `SUC n - 1 = n`; COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_DIV_1; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[CX_MUL; COMPLEX_INV_MUL; COMPLEX_RING + `(a * f) * i * n = a * i <=> f * n = Cx(&1) \/ a * i = Cx(&0)`] THEN + SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]]);; + +let TAYLOR_CLOG = prove + (`!n z. norm(z) < &1 + ==> norm(clog(Cx(&1) + z) - + vsum(1..n) (\k. --Cx(&1) pow (k + 1) * z pow k / Cx(&k))) + <= norm z pow (n + 1) / (&1 - norm z)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `z:complex` CLOG_CONVERGES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o + SPEC `n + 1` o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ADD_SUB]] THEN + DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + SERIES_BOUND)) THEN + EXISTS_TAC `\k. norm(z:complex) pow k` THEN + REWRITE_TAC[GSYM SERIES_CX_LIFT; o_DEF; CX_POW; CX_DIV; CX_SUB] THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NORM; SUMS_GP] THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW; NORM_NEG] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; GSYM COMPLEX_NORM_POW] THEN + SUBGOAL_THEN `0 < m` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x * (m - &1) ==> x <= x * m`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE; REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_1]);; + +let TAYLOR_CLOG_NEG = prove + (`!n z. norm(z) < &1 + ==> norm(clog(Cx(&1) - z) + vsum(1..n) (\k. z pow k / Cx(&k))) + <= norm z pow (n + 1) / (&1 - norm z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `--z:complex`] TAYLOR_CLOG) THEN + ASM_REWRITE_TAC[NORM_NEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + REWRITE_TAC[VECTOR_SUB; GSYM VSUM_NEG] THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_POW_ADD; COMPLEX_POW_ONE; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_POW_1] THEN + REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM COMPLEX_POW_MUL] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_MUL_LID; COMPLEX_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* The classical limit for e and other useful limits. *) +(* ------------------------------------------------------------------------- *) + +let CEXP_LIMIT = prove + (`!z. ((\n. (Cx(&1) + z / Cx(&n)) pow n) --> cexp(z)) sequentially`, + GEN_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. cexp(Cx(&n) * clog(Cx(&1) + z / Cx(&n)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[CEXP_N; EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `norm(z:complex) + &1` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[LE] THEN DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[NORM_ARITH `~(norm(z:complex) + &1 <= &0)`]; + DISCH_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CEXP_CLOG THEN + ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD + `~(n = Cx(&0)) ==> (Cx(&1) + z / n = Cx(&0) <=> z = --n)`] THEN + DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN + REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + CONV_TAC NORM_ARITH; + MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN + REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(&2 * norm(z:complex) pow 2) * inv(Cx(&n))` THEN + SIMP_TAC[LIM_INV_N; LIM_NULL_COMPLEX_LMUL] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `&2 * norm(z:complex) + &1` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `MAX N (MAX 1 2)` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; + COMPLEX_FIELD `~(n = Cx(&0)) ==> n * l - z = (l - z / n) * n`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM; + COMPLEX_NORM_INV] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + MP_TAC(ISPECL [`1`; `z / Cx(&n)`] TAYLOR_CLOG) THEN + REWRITE_TAC[GSYM CX_ADD; VSUM_SING_NUMSEG; COMPLEX_NORM_CX] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; COMPLEX_DIV_1] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_POW_1; COMPLEX_POW_NEG; COMPLEX_POW_ONE; ARITH] THEN + REWRITE_TAC[COMPLEX_MUL_LID; REAL_POW_DIV] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_ARITH `a / b / c:real = (a / c) * inv b`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_NORM; + REAL_ABS_POW; real_div] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH + `&1 / &2 <= &1 - x * &1 / n <=> x / n <= &1 / &2`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]);; + +let EXP_LIMIT = prove + (`!x. ((\n. (&1 + x / &n) pow n) ---> exp(x)) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_POW; CX_ADD; CX_DIV; CX_EXP] THEN + REWRITE_TAC[CEXP_LIMIT]);; + +let LIM_LOGPLUS1_OVER_X = prove + (`((\x. clog(Cx(&1) + x) / x) --> Cx(&1)) (at(Cx(&0)))`, + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\x. Cx(&2) * x` THEN CONJ_TAC THENL + [ALL_TAC; LIM_TAC THEN REWRITE_TAC[COMPLEX_MUL_RZERO]] THEN + REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `&1 / &2` THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO; COMPLEX_NORM_NZ] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `norm(z:complex)` THEN + ASM_REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_NORM_NZ] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(z = Cx(&0)) ==> z * (l / z - Cx(&1)) = l - z`] THEN + MP_TAC(ISPECL [`1`; `z:complex`] TAYLOR_CLOG) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[VSUM_SING_NUMSEG]] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_POW_1; COMPLEX_DIV_1] THEN + REWRITE_TAC[COMPLEX_POW_NEG; ARITH_EVEN; COMPLEX_POW_ONE] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[COMPLEX_RING `z * Cx(&2) * z = z pow 2 * Cx(&2)`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; real_div; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM COMPLEX_NORM_POW] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC);; + +let LIM_N_MUL_SUB_CLOG = prove + (`!w z. ((\n. Cx(&n) * (clog(Cx(&n) + w) - clog(Cx(&n) + z))) --> w - z) + sequentially`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `w:complex = z` THEN + ASM_REWRITE_TAC[COMPLEX_SUB_REFL; LIM_CONST; COMPLEX_MUL_RZERO] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. (Cx(&n) + z) / (Cx(&1) + z / Cx(&n)) * + clog(Cx(&1) + (w - z) / (Cx(&n) + z))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `max (norm(w:complex)) (norm(z:complex)) + &1` + REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < Re(Cx(&n) + w) /\ &0 < Re(Cx(&n) + z)` MP_TAC THENL + [REWRITE_TAC[RE_ADD; RE_CX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN CONJ_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `norm z < n /\ abs(Re z) <= norm z ==> &0 < n + Re z`) THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN ASM_REAL_ARITH_TAC; + MAP_EVERY ASM_CASES_TAC + [`Cx(&n) + w = Cx(&0)`; `Cx(&n) + z = Cx(&0)`] THEN + ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN STRIP_TAC] THEN + SUBGOAL_THEN `~(Cx(&n) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `max (norm(w:complex)) (norm (z:complex)) + &1 <= &N` THEN + RULE_ASSUM_TAC(REWRITE_RULE[CONJUNCT1 LE]) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; + ASM_SIMP_TAC[COMPLEX_FIELD + `~(n + z = Cx(&0)) /\ ~(n = Cx(&0)) + ==> (n + z) / (Cx(&1) + z / n) = n`] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[COMPLEX_FIELD + `~(n + z = Cx(&0)) + ==> Cx(&1) + (w - z) / (n + z) = (n + w) / (n + z)`] THEN + REWRITE_TAC[complex_div] THEN IMP_REWRITE_TAC[CLOG_MUL_SIMPLE] THEN + ASM_REWRITE_TAC[COMPLEX_INV_EQ_0] THEN ASM_SIMP_TAC[CLOG_INV] THEN + CONJ_TAC THENL [CONV_TAC COMPLEX_RING; REWRITE_TAC[IM_NEG]] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) < pi / &2 /\ abs(y) < pi / &2 + ==> --pi < x + --y /\ x + --y <= pi`) THEN + ASM_SIMP_TAC[RE_CLOG_POS_LT]]; + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a / b * c:complex = inv b * a * c`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_LID] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_INV_1] THEN + MATCH_MP_TAC LIM_COMPLEX_INV THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST; complex_div] THEN + SIMP_TAC[LIM_NULL_COMPLEX_LMUL; LIM_INV_N]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\n. (Cx(&n) + z) * clog (Cx(&1) + (w - z) / (Cx(&n) + z))) = + (\x. (w - z) * clog(Cx(&1) + x) / x) o (\n. (w - z) / (Cx(&n) + z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; complex_div] THEN + REWRITE_TAC[COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; + ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPOSE_AT THEN EXISTS_TAC `Cx(&0)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[complex_div] THEN + SIMP_TAC[LIM_INV_N_OFFSET; LIM_NULL_COMPLEX_LMUL]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `norm(z:complex) + &1` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN X_GEN_TAC `n:num` THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + ASM_REWRITE_TAC[COMPLEX_DIV_EQ_0; COMPLEX_SUB_0] THEN + REWRITE_TAC[COMPLEX_RING `n + z = Cx(&0) <=> z = --n`] THEN + DISCH_TAC THEN UNDISCH_TAC `norm(z:complex) + &1 <= &N` THEN + ASM_REWRITE_TAC[NORM_NEG; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_RID] THEN + SIMP_TAC[LIM_COMPLEX_LMUL; LIM_LOGPLUS1_OVER_X]]]);; + +let LIM_SUB_CLOG = prove + (`!w z. ((\n. clog(Cx(&n) + w) - clog(Cx(&n) + z)) --> Cx(&0)) sequentially`, + REPEAT GEN_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + SUBST1_TAC(COMPLEX_RING `Cx(&0) = Cx(&0) * (w - z)`) THEN EXISTS_TAC + `\n. inv(Cx(&n)) * Cx(&n) * (clog(Cx(&n) + w) - clog(Cx(&n) + z))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; GSYM REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD; + MATCH_MP_TAC LIM_COMPLEX_MUL THEN + REWRITE_TAC[LIM_INV_N; LIM_N_MUL_SUB_CLOG]]);; + +(* ------------------------------------------------------------------------- *) +(* Equality between holomorphic functions, on open ball then connected set. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_FUN_EQ_ON_BALL = prove + (`!f g z r w. + f holomorphic_on ball(z,r) /\ g holomorphic_on ball(z,r) /\ + w IN ball(z,r) /\ + (!n. higher_complex_derivative n f z = higher_complex_derivative n g z) + ==> f w = g w`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `(\n. higher_complex_derivative n f z / + Cx(&(FACT n)) * (w - z) pow n)` THEN + EXISTS_TAC `(from 0)` THEN CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC []] THEN + ASM_MESON_TAC [HOLOMORPHIC_POWER_SERIES]);; + +let HOLOMORPHIC_FUN_EQ_0_ON_BALL = prove + (`!f z r w. + w IN ball(z,r) /\ f holomorphic_on ball(z,r) /\ + (!n. higher_complex_derivative n f z = Cx(&0)) + ==> f w = Cx(&0)`, + REPEAT STRIP_TAC THEN + SUBST1_TAC (GSYM (BETA_CONV `(\z:complex. Cx(&0)) w`)) THEN + MATCH_MP_TAC HOLOMORPHIC_FUN_EQ_ON_BALL THEN + REWRITE_TAC [HOLOMORPHIC_ON_CONST; HIGHER_COMPLEX_DERIVATIVE_CONST] THEN + ASM_MESON_TAC []);; + +let HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED = prove + (`!f s z. + open s /\ connected s /\ f holomorphic_on s /\ + z IN s /\ (!n. higher_complex_derivative n f z = Cx(&0)) + ==> !w. w IN s ==> f w = Cx(&0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `{w | w IN s /\ !n. higher_complex_derivative n f w = Cx(&0)}`) THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[higher_complex_derivative]] THEN + CONJ_TAC THENL + [MATCH_MP_TAC OPEN_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `open(s:complex->bool)` THEN + REWRITE_TAC[OPEN_CONTAINS_BALL; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:complex` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + X_GEN_TAC `u:complex` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOLOMORPHIC_FUN_EQ_0_ON_BALL THEN + MAP_EVERY EXISTS_TAC [`w:complex`; `e:real`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; OPEN_BALL; SUBSET]; + ASM_REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE]]; + SUBGOAL_THEN + `closed_in (subtopology euclidean s) + (INTERS (IMAGE + (\n. {w | w IN s /\ higher_complex_derivative n f w = Cx(&0)}) + (:num)))` + MP_TAC THENL + [MATCH_MP_TAC CLOSED_IN_INTERS THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; UNIV_NOT_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN SIMP_TAC[ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + SIMP_TAC[INTERS; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN SET_TAC[]]]);; + +let HOLOMORPHIC_FUN_EQ_ON_CONNECTED = prove + (`!f g z s w. + open s /\ connected s /\ f holomorphic_on s /\ g holomorphic_on s /\ + w IN s /\ z IN s /\ + (!n. higher_complex_derivative n f z = higher_complex_derivative n g z) + ==> f w = g w`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. (f:complex->complex) z - g z`; `s:complex->bool`; + `z:complex`] HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED) THEN + ASM_REWRITE_TAC[RIGHT_IMP_FORALL_THM; HOLOMORPHIC_ON_SUB] THEN + DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB] THEN + MP_TAC(ISPECL [`f:complex->complex`; `g:complex->complex`; `s:complex->bool`] + HIGHER_COMPLEX_DERIVATIVE_SUB) THEN + ASM_SIMP_TAC[COMPLEX_SUB_0]);; + +let HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED = prove + (`!f s z. + open s /\ + connected s /\ + f holomorphic_on s /\ + z IN s /\ + (!n. 0 < n ==> higher_complex_derivative n f z = Cx(&0)) + ==> !w. w IN s ==> f w = f z`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\w. (f:complex->complex) w - f z`; `s:complex->bool`; `z:complex`] + HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST] THEN + X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[higher_complex_derivative; COMPLEX_SUB_REFL] THEN + MP_TAC(ISPECL + [`f:complex->complex`; `(\w. f(z:complex)):complex->complex`; + `s:complex->bool`; `n:num`; `z:complex`] + HIGHER_COMPLEX_DERIVATIVE_SUB) THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[LE_1; HIGHER_COMPLEX_DERIVATIVE_CONST; COMPLEX_SUB_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Some basic lemmas about poles/singularities. *) +(* ------------------------------------------------------------------------- *) + +let POLE_LEMMA = prove + (`!f s a. + f holomorphic_on s /\ a IN interior(s) + ==> (\z. if z = a then complex_derivative f a + else (f(z) - f(a)) / (z - a)) holomorphic_on s`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `(a:complex) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `!z. z IN s /\ ~(z = a) + ==> (\z. if z = a then complex_derivative f a + else (f(z) - f(a)) / (z - a)) + complex_differentiable (at z within s)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN + EXISTS_TAC `\z:complex. (f(z) - f(a)) / (z - a)` THEN + EXISTS_TAC `dist(a:complex,z)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN + CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LT_REFL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_WITHIN THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN + ASM_MESON_TAC[holomorphic_on; complex_differentiable]]; + ALL_TAC] THEN + REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `z:complex = a` THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN + SUBGOAL_THEN + `(\z. if z = a then complex_derivative f a else (f z - f a) / (z - a)) + holomorphic_on ball(a,e)` + MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; GSYM complex_differentiable; + CENTRE_IN_BALL; COMPLEX_DIFFERENTIABLE_AT_WITHIN]] THEN + MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN + EXISTS_TAC `{a:complex}` THEN SIMP_TAC[OPEN_BALL; FINITE_RULES] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `s DELETE (a:complex)` THEN + ASM_SIMP_TAC[SET_RULE `b SUBSET s ==> b DIFF {a} SUBSET s DELETE a`] THEN + ASM_SIMP_TAC[holomorphic_on; GSYM complex_differentiable; IN_DELETE] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; CONTINUOUS_ON_EQ_CONTINUOUS_AT; + OPEN_DIFF; FINITE_IMP_CLOSED; OPEN_BALL; FINITE_INSERT; + FINITE_RULES; GSYM complex_differentiable] THEN + REWRITE_TAC[IN_DIFF; IN_BALL; IN_SING] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:complex` THEN + ASM_CASES_TAC `w:complex = a` THENL + [ALL_TAC; ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `f holomorphic_on ball(a,e)` MP_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + REWRITE_TAC[GSYM complex_differentiable; IN_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN + ASM_REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; CONTINUOUS_AT] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + LIM_TRANSFORM_AT) THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[GSYM DIST_NZ; REAL_LT_01] THEN + X_GEN_TAC `u:complex` THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +let POLE_LEMMA_OPEN = prove + (`!f s a. + open s /\ f holomorphic_on s + ==> (\z. if z = a + then complex_derivative f a + else (f z - f a) / (z - a)) holomorphic_on s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:complex) IN s` THENL + [MATCH_MP_TAC POLE_LEMMA THEN ASM_SIMP_TAC[INTERIOR_OPEN]; + ALL_TAC] THEN + REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`\z:complex. (f(z) - f(a)) / (z - a)`; `&1`] THEN + ASM_REWRITE_TAC[REAL_LT_01] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_WITHIN THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0; CONJ_ASSOC] THEN + CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_CONST; COMPLEX_DIFFERENTIABLE_ID] THEN + ASM_MESON_TAC[holomorphic_on; complex_differentiable]);; + +let POLE_THEOREM = prove + (`!f g s a. + g holomorphic_on s /\ a IN interior(s) /\ + (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) + ==> (\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) holomorphic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLE_LEMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex` o last o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN + CONV_TAC COMPLEX_FIELD);; + +let POLE_THEOREM_OPEN = prove + (`!f g s a. + open s /\ g holomorphic_on s /\ + (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) + ==> (\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) holomorphic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `a:complex` o MATCH_MP POLE_LEMMA_OPEN) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex` o last o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN + CONV_TAC COMPLEX_FIELD);; + +let POLE_THEOREM_0 = prove + (`!f g s a. + g holomorphic_on s /\ a IN interior(s) /\ + (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) /\ + f a = complex_derivative g a /\ g(a) = Cx(&0) + ==> f holomorphic_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) holomorphic_on s` + MP_TAC THENL [ASM_SIMP_TAC[POLE_THEOREM]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[complex_div] THEN + CONV_TAC COMPLEX_RING);; + +let POLE_THEOREM_OPEN_0 = prove + (`!f g s a. + open s /\ g holomorphic_on s /\ + (!z. z IN s /\ ~(z = a) ==> g(z) = (z - a) * f(z)) /\ + f a = complex_derivative g a /\ g(a) = Cx(&0) + ==> f holomorphic_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) holomorphic_on s` + MP_TAC THENL [ASM_SIMP_TAC[POLE_THEOREM_OPEN]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_TRANSFORM) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[complex_div] THEN + CONV_TAC COMPLEX_RING);; + +let POLE_THEOREM_ANALYTIC = prove + (`!f g s a. + g analytic_on s /\ + (!z. z IN s + ==> ?d. &0 < d /\ + !w. w IN ball(z,d) /\ ~(w = a) ==> g(w) = (w - a) * f(w)) + ==> (\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) analytic_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[analytic_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B")) THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + REMOVE_THEN "A" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MATCH_MP_TAC POLE_THEOREM_OPEN THEN + ASM_SIMP_TAC[BALL_MIN_INTER; OPEN_BALL; IN_INTER] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; + +let POLE_THEOREM_ANALYTIC_0 = prove + (`!f g s a. + g analytic_on s /\ + (!z. z IN s + ==> ?d. &0 < d /\ + !w. w IN ball(z,d) /\ ~(w = a) + ==> g(w) = (w - a) * f(w)) /\ + f a = complex_derivative g a /\ g(a) = Cx(&0) + ==> f analytic_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) analytic_on s` + MP_TAC THENL [ASM_SIMP_TAC[POLE_THEOREM_ANALYTIC]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING);; + +let POLE_THEOREM_ANALYTIC_OPEN_SUPERSET = prove + (`!f g s a t. + s SUBSET t /\ open t /\ g analytic_on s /\ + (!z. z IN t /\ ~(z = a) ==> g(z) = (z - a) * f(z)) + ==> (\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) analytic_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLE_THEOREM_ANALYTIC THEN + ASM_MESON_TAC[OPEN_CONTAINS_BALL; SUBSET]);; + +let POLE_THEOREM_ANALYTIC_OPEN_SUPERSET_0 = prove + (`!f g s a t. + s SUBSET t /\ open t /\ g analytic_on s /\ + (!z. z IN t /\ ~(z = a) ==> g(z) = (z - a) * f(z)) /\ + f a = complex_derivative g a /\ g(a) = Cx(&0) + ==> f analytic_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. if z = a then complex_derivative g a + else f(z) - g(a) / (z - a)) analytic_on s` + MP_TAC THENL + [MATCH_MP_TAC POLE_THEOREM_ANALYTIC_OPEN_SUPERSET THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[complex_div] THEN CONV_TAC COMPLEX_RING);; + +let HOLOMORPHIC_ON_EXTEND_LIM,HOLOMORPHIC_ON_EXTEND_BOUNDED = + (CONJ_PAIR o prove) + (`(!f a s. + f holomorphic_on (s DELETE a) /\ a IN interior s + ==> ((?g. g holomorphic_on s /\ (!z. z IN s DELETE a ==> g z = f z)) <=> + ((\z. (z - a) * f(z)) --> Cx(&0)) (at a))) /\ + (!f a s. + f holomorphic_on (s DELETE a) /\ a IN interior s + ==> ((?g. g holomorphic_on s /\ (!z. z IN s DELETE a ==> g z = f z)) <=> + (?B. eventually (\z. norm(f z) <= B) (at a))))`, + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> (p ==> q /\ r)`] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> r) /\ (r ==> q) /\ (q ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` + (CONJUNCTS_THEN2 + (MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) ASSUME_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `interior s:complex->bool` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[INTERIOR_SUBSET; CONTINUOUS_ON] THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN + ASM_SIMP_TAC[LIM_WITHIN_OPEN; OPEN_INTERIOR; tendsto] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(fun th -> EXISTS_TAC `norm((g:complex->complex) a) + &1` THEN + MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[GSYM(MATCH_MP EVENTUALLY_WITHIN_INTERIOR th)]) THEN + ASM_SIMP_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ] THEN + EXISTS_TAC `&1` THEN CONV_TAC NORM_ARITH; + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN EXISTS_TAC `B:real` THEN + SUBST1_TAC(COMPLEX_RING `Cx(&0) = a - a`) THEN + SIMP_TAC[LIM_AT_ID; LIM_CONST; LIM_SUB] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + EVENTUALLY_MONO)) THEN + SIMP_TAC[]; + DISCH_TAC THEN ABBREV_TAC `h = \z. (z - a) pow 2 * f z` THEN + SUBGOAL_THEN `(h has_complex_derivative Cx(&0)) (at a)` ASSUME_TAC THENL + [EXPAND_TAC "h" THEN REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT] THEN + MATCH_MP_TAC LIM_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`\z:complex. (z - a) * f z`; `&1`] THEN + ASM_SIMP_TAC[REAL_LT_01; GSYM DIST_NZ] THEN CONV_TAC COMPLEX_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `h holomorphic_on s` ASSUME_TAC THENL + [REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `z:complex = a` THENL + [ASM_MESON_TAC[complex_differentiable; COMPLEX_DIFFERENTIABLE_AT_WITHIN]; + ALL_TAC] THEN + EXPAND_TAC "h" THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_MUL_WITHIN THEN + CONJ_TAC THENL [COMPLEX_DIFFERENTIABLE_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_DELETE; complex_differentiable] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:complex` THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN + REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `dist(a:complex,z)` THEN + ASM_REWRITE_TAC[IN_DELETE; NORM_ARITH `&0 < dist(a,b) <=> ~(a = b)`] THEN + MESON_TAC[REAL_LT_REFL]; + MP_TAC(SPECL [`h:complex->complex`; `s:complex->bool`; `a:complex`] + POLE_LEMMA) THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC + `g = \z. if z = a then complex_derivative h a + else (h z - h a) / (z - a)` THEN + DISCH_TAC THEN + EXISTS_TAC + `\z. if z = a then complex_derivative g a + else (g z - g a) / (z - a)` THEN + ASM_SIMP_TAC[POLE_LEMMA; IN_DELETE] THEN EXPAND_TAC "g" THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE th]) THEN + SIMP_TAC[COMPLEX_SUB_RZERO] THEN + EXPAND_TAC "h" THEN SIMP_TAC[] THEN CONV_TAC COMPLEX_FIELD]]);; + +(* ------------------------------------------------------------------------- *) +(* General, homology form of Cauchy's theorem. Proof is based on Dixon's, *) +(* as presented in Lang's "Complex Analysis" book. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_INTEGRAL_FORMULA_GLOBAL = prove + (`!f s g z. + open s /\ f holomorphic_on s /\ z IN s /\ + valid_path g /\ pathfinish g = pathstart g /\ + path_image g SUBSET s DELETE z /\ + (!w. ~(w IN s) ==> winding_number(g,w) = Cx(&0)) + ==> ((\w. f(w) / (w - z)) has_path_integral + (Cx(&2) * Cx(pi) * ii * winding_number(g,z) * f(z))) g`, + MATCH_MP_TAC(MESON[] + `((!f s g. vector_polynomial_function g ==> P f s g) ==> !f s g. P f s g) /\ + (!f s g. vector_polynomial_function g ==> P f s g) + ==> !f s g. P f s g`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s DELETE (z:complex)`; `g:real^1->complex`] + PATH_INTEGRAL_NEARBY_ENDS) THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH; OPEN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->complex`; `d:real`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->complex` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`g:real^1->complex`; `p:real^1->complex`]) THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; + VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`f:complex->complex`; `s:complex->bool`; `p:real^1->complex`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + SUBGOAL_THEN + `winding_number(p,z) = winding_number(g,z) /\ + !w. ~(w IN s) ==> winding_number(p,w) = winding_number(g,w)` + (fun th -> SIMP_TAC[th]) + THENL + [FIRST_X_ASSUM(K ALL_TAC o SPEC `z:complex`) THEN + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (SET_RULE + `g SUBSET s DELETE z + ==> ~(z IN g) /\ (!y. ~(y IN s) ==> ~(y IN g))`))) THEN + ASM_SIMP_TAC[WINDING_NUMBER_VALID_PATH; + VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN + SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; + IN_DELETE; COMPLEX_SUB_0] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + MATCH_MP_TAC(MESON[HAS_PATH_INTEGRAL_INTEGRAL; path_integrable_on; + PATH_INTEGRAL_UNIQUE] + `f path_integrable_on g /\ path_integral p f = path_integral g f + ==> (f has_path_integral y) p ==> (f has_path_integral y) g`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `s DELETE (z:complex)` THEN ASM_SIMP_TAC[OPEN_DELETE]; + FIRST_X_ASSUM MATCH_MP_TAC] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; + IN_DELETE; COMPLEX_SUB_0] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; DELETE_SUBSET]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC + [`f:complex->complex`; `u:complex->bool`; `g:real^1->complex`] THEN + DISCH_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `g':real^1->complex` STRIP_ASSUME_TAC o + MATCH_MP HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION) THEN + SUBGOAL_THEN + `bounded(IMAGE (g':real^1->complex) (interval[vec 0,vec 1]))` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + ASM_MESON_TAC[CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; + CONTINUOUS_AT_IMP_CONTINUOUS_ON]; + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP VALID_PATH_IMP_PATH) THEN + MAP_EVERY ABBREV_TAC + [`d = \z w. if w = z then complex_derivative f z + else (f(w) - f(z)) / (w - z)`; + `v = {w | ~(w IN path_image g) /\ winding_number(g,w) = Cx(&0)}`] THEN + SUBGOAL_THEN `open(v:complex->bool)` ASSUME_TAC THENL + [EXPAND_TAC "v" THEN MATCH_MP_TAC OPEN_WINDING_NUMBER_LEVELSETS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `u UNION v = (:complex)` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!y:complex. y IN u ==> (d y) holomorphic_on u` ASSUME_TAC THENL + [X_GEN_TAC `y:complex` THEN STRIP_TAC THEN EXPAND_TAC "d" THEN + MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{y:complex}` THEN + ASM_REWRITE_TAC[FINITE_SING] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `w:complex = y` THENL + [UNDISCH_THEN `w:complex = y` SUBST_ALL_TAC THEN + REWRITE_TAC[CONTINUOUS_AT] THEN + MATCH_MP_TAC LIM_TRANSFORM_AWAY_AT THEN + EXISTS_TAC `\w:complex. (f w - f y) / (w - y)` THEN SIMP_TAC[] THEN + EXISTS_TAC `y + Cx(&1)` THEN + CONJ_TAC THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[GSYM HAS_COMPLEX_DERIVATIVE_AT] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT]; + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DELETE; IN_DELETE; + SET_RULE `s DIFF {x} = s DELETE x`; GSYM complex_differentiable] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\w:complex. (f w - f y) / (w - y)` THEN + EXISTS_TAC `dist(w:complex,y)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN + (CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC]) THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_CONST; + COMPLEX_DIFFERENTIABLE_ID] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y. ~(y IN path_image g) + ==> (\x. (f x - f y) / (x - y)) path_integrable_on g` + ASSUME_TAC THENL + [X_GEN_TAC `y:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `u DELETE (y:complex)` THEN ASM_SIMP_TAC[OPEN_DELETE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[IN_DELETE; COMPLEX_SUB_0] THEN + CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `u:complex->bool` THEN ASM_REWRITE_TAC[DELETE_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y:complex. d y path_integrable_on g` + ASSUME_TAC THENL + [X_GEN_TAC `y:complex` THEN + ASM_CASES_TAC `(y:complex) IN path_image g` THENL + [MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]; + MATCH_MP_TAC PATH_INTEGRABLE_EQ THEN + EXISTS_TAC `\x:complex. (f x - f y) / (x - y)` THEN + ASM_SIMP_TAC[] THEN EXPAND_TAC "d" THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `?h. (!z. z IN u ==> ((d z) has_path_integral h(z)) g) /\ + (!z. z IN v ==> ((\w. f(w) / (w - z)) has_path_integral h(z)) g)` + (CHOOSE_THEN (CONJUNCTS_THEN2 (LABEL_TAC "u") (LABEL_TAC "v"))) + THENL + [EXISTS_TAC `\z. if z IN u then path_integral g (d z) + else path_integral g (\w. f(w) / (w - z))` THEN + SIMP_TAC[] THEN CONJ_TAC THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THENL + [ASM_MESON_TAC[HAS_PATH_INTEGRAL_INTEGRAL]; ALL_TAC] THEN + ASM_CASES_TAC `(w:complex) IN u` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; + HOLOMORPHIC_ON_ID] THEN + ASM_MESON_TAC[]; + ASM SET_TAC[]]] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_EQ THEN + EXISTS_TAC `\x:complex. (f x - f w) / (x - w) + f(w) / (x - w)` THEN + CONJ_TAC THENL + [X_GEN_TAC `x:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN + UNDISCH_TAC `(w:complex) IN v` THEN EXPAND_TAC "v" THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(MESON[PATH_INTEGRAL_UNIQUE; HAS_PATH_INTEGRAL_INTEGRAL; + path_integrable_on; PATH_INTEGRAL_EQ; PATH_INTEGRABLE_EQ] + `g path_integrable_on p /\ + (!x. x IN path_image p ==> f x = g x) + ==> (f has_path_integral path_integral p g) p`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "d" THEN ASM_MESON_TAC[]; + SUBGOAL_THEN + `Cx(&0) = (f w) * Cx(&2) * Cx pi * ii * winding_number(g,w)` + SUBST1_TAC THENL [ASM_REWRITE_TAC[COMPLEX_MUL_RZERO]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `x / y = x * Cx(&1) / y`] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_WINDING_NUMBER THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `!z. (h:complex->complex) z = Cx(&0)` ASSUME_TAC THENL + [ALL_TAC; + REMOVE_THEN "u" (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "d" THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `\w. (f w - f z) / (w - z)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] HAS_PATH_INTEGRAL_EQ)) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`g:real^1->complex`; `z:complex`] + HAS_PATH_INTEGRAL_WINDING_NUMBER) THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_COMPLEX_RMUL) THEN + DISCH_THEN(MP_TAC o SPEC `(f:complex->complex) z`) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_ADD) THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_RID; COMPLEX_RING + `(Cx(&1) * i) * fz + (fx - fz) * i = fx * i`] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC]] THEN + UNDISCH_THEN `(z:complex) IN u` (K ALL_TAC) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE + `p SUBSET u DELETE z ==> p SUBSET u`)) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN STRIP_TAC THEN + MATCH_MP_TAC LIOUVILLE_WEAK THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [SUBGOAL_THEN + `?t:complex->bool. + compact t /\ path_image g SUBSET interior t /\ t SUBSET u` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `?dd. &0 < dd /\ + {y + k | y IN path_image g /\ k IN ball(vec 0,dd)} SUBSET u` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `u = (:complex)` THENL + [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01; SUBSET_UNIV]; + ALL_TAC] THEN + MP_TAC(ISPECL [`path_image g:complex->bool`; `(:complex) DIFF u`] + SEPARATE_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `dd:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `dd / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`y:complex`; `k:complex`] THEN + MATCH_MP_TAC(TAUT `(a /\ ~c ==> ~b) ==> a /\ b ==> c`) THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:complex`; `y + k:complex`]) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_BALL] THEN CONV_TAC NORM_ARITH; + ALL_TAC] THEN + EXISTS_TAC `{y + k:complex | + y IN path_image g /\ k IN cball(vec 0,dd / &2)}` THEN + ASM_SIMP_TAC[COMPACT_SUMS; COMPACT_PATH_IMAGE; COMPACT_CBALL] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_INTERIOR; IN_ELIM_THM] THEN + X_GEN_TAC `y:complex` THEN DISCH_TAC THEN + EXISTS_TAC `dd / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`y:complex`; `x - y:complex`] THEN + ASM_REWRITE_TAC[IN_CBALL] THEN + UNDISCH_TAC `dist(y:complex,x) < dd / &2` THEN CONV_TAC NORM_ARITH; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `{x + y:real^N | x IN s /\ y IN t} SUBSET u + ==> t' SUBSET t ==> {x + y | x IN s /\ y IN t'} SUBSET u`)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN + UNDISCH_TAC `&0 < dd` THEN CONV_TAC NORM_ARITH]; + ALL_TAC] THEN + MP_TAC(ISPECL [`interior t:complex->bool`; `g:real^1->complex`] + PATH_INTEGRAL_BOUND_EXISTS) THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN + DISCH_THEN(X_CHOOSE_THEN `L:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `bounded(IMAGE (f:complex->complex) t)` MP_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC)] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIM_AT_INFINITY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `(D * L) / (e / &2) + C:real` THEN REWRITE_TAC[real_ge] THEN + X_GEN_TAC `y:complex` THEN DISCH_TAC THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN + SUBGOAL_THEN `h y = path_integral g (\w. f w / (w - y))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "v" THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `(D * L) / (e / &2) + C <= norm(y:complex)` THEN + MATCH_MP_TAC(REAL_ARITH `&0 < d /\ x <= c ==> d + c <= x ==> F`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN + ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; + MATCH_MP_TAC WINDING_NUMBER_ZERO_OUTSIDE THEN + EXISTS_TAC `cball(Cx(&0),C)` THEN + ASM_REWRITE_TAC[CONVEX_CBALL; SUBSET; IN_CBALL; dist; + COMPLEX_SUB_LZERO; NORM_NEG] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]] THEN + UNDISCH_TAC `(D * L) / (e / &2) + C <= norm(y:complex)` THEN + MATCH_MP_TAC(REAL_ARITH `&0 < d ==> d + c <= x ==> ~(x <= c)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `L * (e / &2 / L)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_HALF] THEN + ASM_REAL_ARITH_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS; INTERIOR_SUBSET]; + SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_CONST; COMPLEX_SUB_0]] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `d + c <= norm y ==> &0 < d /\ norm w <= c ==> ~(w = y)`)) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + ALL_TAC] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN SIMP_TAC[COMPLEX_NORM_DIV] THEN + SUBGOAL_THEN `&0 < norm(w - y)` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `d + c <= norm y ==> &0 < d /\ norm w <= c ==> &0 < norm(w - y)`)) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_HALF] THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + ASM_SIMP_TAC[REAL_LE_LDIV_EQ]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `D:real` THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `e / &2 / L * x = (x * (e / &2)) / L`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ; REAL_HALF] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `d + c <= norm y ==> norm w <= c ==> d <= norm(w - y)`)) THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + DISCH_TAC] THEN + SUBGOAL_THEN + `(\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) continuous_on + {pastecart x z | x IN u /\ z IN u}` + ASSUME_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN EXPAND_TAC "d" THEN + REWRITE_TAC[FORALL_IN_GSPEC; continuous_within; IMP_CONJ] THEN + MAP_EVERY X_GEN_TAC [`x:complex`; `z:complex`] THEN REPEAT DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; FORALL_PASTECART] THEN + REWRITE_TAC[dist; IMP_IMP; GSYM CONJ_ASSOC; PASTECART_SUB] THEN + ASM_CASES_TAC `z:complex = x` THEN ASM_REWRITE_TAC[] THENL + [UNDISCH_THEN `z:complex = x` (SUBST_ALL_TAC o SYM); + SUBGOAL_THEN + `(\y. (f(sndcart y) - f(fstcart y)) / (sndcart y - fstcart y)) + continuous at (pastecart x z)` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV_AT THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; COMPLEX_SUB_0] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART; LINEAR_SNDCART] THEN + CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART; LINEAR_SNDCART] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + CONTINUOUS_ON_EQ_CONTINUOUS_AT]; + ALL_TAC] THEN + REWRITE_TAC[continuous_at; dist; FORALL_PASTECART] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_SUB] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `open({pastecart x z | x IN u /\ z IN u} DIFF + {y | y IN UNIV /\ fstcart y - sndcart y = Cx(&0)})` + MP_TAC THENL + [MATCH_MP_TAC OPEN_DIFF THEN + ASM_SIMP_TAC[REWRITE_RULE[PCROSS] OPEN_PCROSS] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN + REWRITE_TAC[CLOSED_UNIV] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; + SIMP_TAC[OPEN_CONTAINS_BALL; IN_DIFF; IMP_CONJ; FORALL_IN_GSPEC] THEN + DISCH_THEN(MP_TAC o SPECL [`x:complex`; `z:complex`]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; COMPLEX_SUB_0] THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; FORALL_PASTECART; IN_DIFF; + IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; PASTECART_SUB; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `min k1 k2:real` THEN + ASM_SIMP_TAC[REAL_LT_MIN; COMPLEX_NORM_NZ; COMPLEX_SUB_0]] THEN + SUBGOAL_THEN `(complex_derivative f) continuous at z` MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_INTERIOR THEN + EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[INTERIOR_OPEN] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[continuous_at] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[dist; REAL_HALF]] THEN + DISCH_THEN(X_CHOOSE_THEN `k1:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_BALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min k1 k2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MAP_EVERY X_GEN_TAC [`x':complex`; `z':complex`] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS; REAL_LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `e / &2 = e / &2 / norm(z' - x') * norm(z' - x':complex)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\u. (complex_derivative f u - complex_derivative f z) / + (z' - x')` THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE; REAL_HALF] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[COMPLEX_FIELD + `~(z:complex = x) + ==> a / (z - x) - b = (a - b * (z - x)) / (z - x)`] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_COMPLEX_DIV THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_SUB THEN + REWRITE_TAC[HAS_PATH_INTEGRAL_CONST_LINEPATH] THEN + MP_TAC(ISPECL [`f:complex->complex`; `complex_derivative f`; + `linepath(x':complex,z')`; `u:complex->bool`] + PATH_INTEGRAL_PRIMITIVE) THEN + REWRITE_TAC[ETA_AX; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[VALID_PATH_LINEPATH] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; + GSYM HOLOMORPHIC_ON_DIFFERENTIABLE; + HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HOLOMORPHIC_ON_OPEN; + complex_differentiable]; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,k2)`]; + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_LE_INV_EQ; NORM_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 ==> x <= e * inv(&2)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[NORM_SUB] dist] + (GSYM IN_BALL)] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `w IN s ==> s SUBSET t ==> w IN t`))] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_BALL; dist] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; + ALL_TAC] THEN + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_UNIV; IN_UNIV; + GSYM complex_differentiable] THEN + X_GEN_TAC `z0:complex` THEN ASM_CASES_TAC `(z0:complex) IN v` THENL + [MP_TAC(ISPECL + [`f:complex->complex`; `h:complex->complex`; `g:real^1->complex`; + `v:complex->bool`; `1`; `B:real`] + CAUCHY_NEXT_DERIVATIVE) THEN + ASM_SIMP_TAC[IN_DIFF; ARITH_EQ; COMPLEX_POW_1] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_UNIQUE_AT]; ALL_TAC] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `u:complex->bool` THEN ASM SET_TAC[]; + DISCH_THEN(MP_TAC o SPEC `z0:complex`) THEN + UNDISCH_TAC `(z0:complex) IN v` THEN EXPAND_TAC "v" THEN + SIMP_TAC[IN_ELIM_THM; complex_differentiable] THEN MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(z0:complex) IN u` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_BALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `z0:complex`) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `ball(z0:complex,e)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + MATCH_MP_TAC ANALYTIC_IMP_HOLOMORPHIC THEN MATCH_MP_TAC MORERA_TRIANGLE THEN + REWRITE_TAC[OPEN_BALL] THEN + SUBGOAL_THEN `(h:complex->complex) continuous_on u` ASSUME_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`a:num->complex`; `x:complex`] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`sequentially`; `\n:num x. (d:complex->complex->complex) (a n) x`; + `B:real`; `g:real^1->complex`; `(d:complex->complex->complex) x`] + PATH_INTEGRAL_UNIFORM_LIMIT) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; ETA_AX; EVENTUALLY_TRUE] THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_UNIQUE_AT]; ALL_TAC] THEN + X_GEN_TAC `ee:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_CBALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `dd:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) + uniformly_continuous_on + {pastecart w z | w IN cball(x,dd) /\ z IN path_image g}` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN + ASM_SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; COMPACT_CBALL; + COMPACT_VALID_PATH_IMAGE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `ee:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `kk:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GENL [`w:complex`; `z:complex`] o + SPECL [`pastecart (x:complex) (z:complex)`; + `pastecart (w:complex) (z:complex)`]) THEN + SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE; dist; PASTECART_SUB] THEN + REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_PASTECART] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[TAUT `b /\ (a /\ b) /\ c ==> d <=> a /\ b /\ c ==> d`] THEN + SIMP_TAC[REAL_ADD_RID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `min dd kk:real`) THEN + ASM_REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; REAL_LT_MIN] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_CBALL; GSYM dist; + REAL_LT_IMP_LE]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + + SUBGOAL_THEN + `!w. w IN u ==> (\z. d z w) holomorphic_on u` + ASSUME_TAC THENL + [EXPAND_TAC "d" THEN X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{y:complex}` THEN + ASM_REWRITE_TAC[FINITE_SING] THEN CONJ_TAC THENL + [SUBGOAL_THEN + `((\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) o + (\z. pastecart y z)) + continuous_on u` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM]; + EXPAND_TAC "d" THEN + REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN + GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING + `x':complex = --x /\ y' = --y ==> x * y = x' * y'`) THEN + REWRITE_TAC[GSYM COMPLEX_INV_NEG; COMPLEX_NEG_SUB]]; + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_DELETE; IN_DELETE; + SET_RULE `s DIFF {x} = s DELETE x`; GSYM complex_differentiable] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\w:complex. (f y - f w) / (y - w)` THEN + EXISTS_TAC `dist(w:complex,y)` THEN ASM_SIMP_TAC[DIST_POS_LT] THEN + (CONJ_TAC THENL [MESON_TAC[DIST_SYM; REAL_LT_REFL]; ALL_TAC]) THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + ASM_SIMP_TAC[ETA_AX; COMPLEX_DIFFERENTIABLE_CONST; + COMPLEX_DIFFERENTIABLE_ID] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!w a b:complex. w IN u /\ segment[a,b] SUBSET u + ==> (\z. d z w) path_integrable_on (linepath(a,b))` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a b:complex. + segment[a,b] SUBSET u + ==> (\w. path_integral (linepath(a,b)) (\z. d z w)) + continuous_on u` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:complex = b` THENL + [ASM_SIMP_TAC[PATH_INTEGRAL_TRIVIAL; CONTINUOUS_ON_CONST]; ALL_TAC] THEN + REWRITE_TAC[continuous_on] THEN X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + X_GEN_TAC `ee:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[dist; GSYM PATH_INTEGRAL_SUB] THEN + MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_CBALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `dd:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\y. (d:complex->complex->complex) (fstcart y) (sndcart y)) + uniformly_continuous_on + {pastecart z t | z IN segment[a,b] /\ t IN cball(w,dd)}` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN + ASM_SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; + COMPACT_CBALL; COMPACT_SEGMENT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `ee / &2 / norm(b - a:complex)`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; COMPLEX_NORM_NZ; COMPLEX_SUB_0] THEN + DISCH_THEN(X_CHOOSE_THEN `kk:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GENL [`z:complex`; `r:complex`] o + SPECL [`pastecart (r:complex) (z:complex)`; + `pastecart (r:complex) (w:complex)`]) THEN + SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE; dist; PASTECART_SUB] THEN + REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_PASTECART] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[TAUT `(a /\ b) /\ a /\ c ==> d <=> a /\ b /\ c ==> d`] THEN + SIMP_TAC[REAL_ADD_LID; POW_2_SQRT; NORM_POS_LE] THEN DISCH_TAC THEN + EXISTS_TAC `min dd kk:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x:complex` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `ee / &2 = ee / &2 / norm(b - a) * norm(b - a:complex)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\r. (d:complex->complex->complex) r x - d r w` THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE; REAL_HALF] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_INTEGRAL THEN + MATCH_MP_TAC PATH_INTEGRABLE_SUB THEN ASM_SIMP_TAC[]; + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [NORM_SUB] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_CBALL; dist] THEN + ASM_MESON_TAC[NORM_SUB; REAL_LT_IMP_LE]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a b. segment[a,b] SUBSET u + ==> (\w. path_integral (linepath (a,b)) (\z. d z w)) + path_integrable_on g` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_INTEGRABLE_ON] THEN + MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [SUBGOAL_THEN + `((\w. path_integral (linepath(a,b)) (\z. d z w)) o (g:real^1->complex)) + continuous_on interval[vec 0,vec 1]` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[GSYM path; VALID_PATH_IMP_PATH] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `u:complex->bool` THEN ASM_SIMP_TAC[GSYM path_image]; + REWRITE_TAC[o_DEF]]; + FIRST_ASSUM(fun th -> REWRITE_TAC + [MATCH_MP HAS_VECTOR_DERIVATIVE_UNIQUE_AT (SPEC_ALL th)]) THEN + ASM_SIMP_TAC[ETA_AX; GSYM path; VALID_PATH_IMP_PATH; + VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a b. segment[a,b] SUBSET u + ==> path_integral (linepath(a,b)) h = + path_integral g (\w. path_integral (linepath (a,b)) (\z. d z w))` + ASSUME_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`; `c:complex`] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `segment[a:complex,b] SUBSET u /\ + segment[b,c] SUBSET u /\ segment[c,a] SUBSET u` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SEGMENTS_SUBSET_CONVEX_HULL; SUBSET_TRANS]; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + ASM_SIMP_TAC[GSYM PATH_INTEGRAL_ADD; PATH_INTEGRABLE_ADD] THEN + MATCH_MP_TAC PATH_INTEGRAL_EQ_0 THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `(w:complex) IN u` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM PATH_INTEGRAL_JOIN; VALID_PATH_LINEPATH; + VALID_PATH_JOIN; PATHSTART_JOIN; + PATH_INTEGRABLE_JOIN; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC CAUCHY_THEOREM_TRIANGLE THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `u:complex->bool` THEN + ASM_SIMP_TAC[] THEN ASM SET_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN DISCH_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `path_integral (linepath(a,b)) (\z. path_integral g (d z))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PATH_INTEGRAL_EQ THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET]; + MATCH_MP_TAC(REWRITE_RULE[PCROSS] PATH_INTEGRAL_SWAP) THEN + REWRITE_TAC[VALID_PATH_LINEPATH; VECTOR_DERIVATIVE_LINEPATH_AT; + CONTINUOUS_ON_CONST] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC + [MATCH_MP HAS_VECTOR_DERIVATIVE_UNIQUE_AT (SPEC_ALL th)]) THEN + ASM_SIMP_TAC[ETA_AX; CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; + CONTINUOUS_AT_IMP_CONTINUOUS_ON] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN ASM SET_TAC[]]);; + +let CAUCHY_THEOREM_GLOBAL = prove + (`!f s g. + open s /\ f holomorphic_on s /\ + valid_path g /\ pathfinish g = pathstart g /\ path_image g SUBSET s /\ + (!z. ~(z IN s) ==> winding_number(g,z) = Cx(&0)) + ==> (f has_path_integral Cx(&0)) g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?z:complex. z IN s /\ ~(z IN path_image g)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `t SUBSET s /\ ~(t = s) ==> ?z. z IN s /\ ~(z IN t)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON + [CLOPEN; COMPACT_EQ_BOUNDED_CLOSED; NOT_BOUNDED_UNIV] + `open s /\ compact t /\ ~(t = {}) ==> ~(t = s)`) THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY; VALID_PATH_IMP_PATH]; + MP_TAC(ISPECL [`\w:complex. (w - z) * f(w)`; `s:complex->bool`; + `g:real^1->complex`; `z:complex`] + CAUCHY_INTEGRAL_FORMULA_GLOBAL) THEN + ASM_SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; + HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_SUB; + HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_EQ) THEN + X_GEN_TAC `w:complex` THEN ASM_CASES_TAC `w:complex = z` THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(w:complex = z) ==> ((w - z) * f) / (w - z) = f`]]);; + +let CAUCHY_THEOREM_GLOBAL_OUTSIDE = prove + (`!f s g. + open s /\ f holomorphic_on s /\ + valid_path g /\ pathfinish g = pathstart g /\ + (!z. ~(z IN s) ==> z IN outside(path_image g)) + ==> (f has_path_integral Cx(&0)) g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CAUCHY_THEOREM_GLOBAL THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[WINDING_NUMBER_ZERO_IN_OUTSIDE; VALID_PATH_IMP_PATH] THEN + MP_TAC(ISPEC `path_image(g:real^1->complex)` OUTSIDE_NO_OVERLAP) THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* First Cartan Theorem. *) +(* ------------------------------------------------------------------------- *) + +let HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA = prove + (`!f g z s t n i. + open s /\ f holomorphic_on s /\ z IN s /\ + open t /\ g holomorphic_on t /\ (!w. w IN s ==> f w IN t) /\ + complex_derivative f z = Cx(&1) /\ + (!i. 1 < i /\ i <= n ==> higher_complex_derivative i f z = Cx(&0)) /\ + i <= n + ==> higher_complex_derivative i (g o f) z = + higher_complex_derivative i g (f z)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `open s /\ f holomorphic_on s /\ z IN s /\ open t /\ + (!w. w IN s ==> f w IN t) /\ + complex_derivative f z = Cx(&1) /\ + (!i. 1 < i /\ i <= n ==> higher_complex_derivative i f z = Cx(&0)) + ==> !i g. g holomorphic_on t /\ i <= n + ==> higher_complex_derivative i (g o f) z = + higher_complex_derivative i g (f z)` + (fun th -> MESON_TAC [th]) THEN + STRIP_TAC THEN + INDUCT_TAC THEN + REWRITE_TAC [LE_SUC_LT; higher_complex_derivative_alt; o_THM] THEN + REPEAT STRIP_TAC THEN + EQ_TRANS_TAC `higher_complex_derivative i + (\w. complex_derivative g (f w) * complex_derivative f w) z` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC [] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC [] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `t:complex->bool` THEN + ASM_SIMP_TAC []; + MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + CONJ_TAC THENL + [REWRITE_TAC [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `t:complex->bool` THEN + ASM_REWRITE_TAC [] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC []; + ASM_REWRITE_TAC [ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC []]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_CHAIN THEN + ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]]; + EQ_TRANS_TAC + `vsum (0..i) + (\j. Cx(&(binom (i,j))) * + higher_complex_derivative j (\w. complex_derivative g (f w)) z * + higher_complex_derivative (i - j) (complex_derivative f) z)` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_MUL THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC [] THEN + ASM_SIMP_TAC [HOLOMORPHIC_COMPLEX_DERIVATIVE] THEN + REWRITE_TAC [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `t:complex->bool` THEN + ASM_REWRITE_TAC [] THEN + ASM_SIMP_TAC [HOLOMORPHIC_COMPLEX_DERIVATIVE]; + REWRITE_TAC [GSYM higher_complex_derivative_alt] THEN + EQ_TRANS_TAC + `vsum (i..i) + (\j. Cx(&(binom (i,j))) * + higher_complex_derivative j + (\w. complex_derivative g (f w)) z * + higher_complex_derivative (SUC (i - j)) f z)` THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[SUBSET_NUMSEG; LT_REFL; LE_0; + LE_REFL; IN_NUMSEG_0; NUMSEG_SING; IN_SING] THEN + X_GEN_TAC `j:num` THEN + REWRITE_TAC [ARITH_RULE `j:num <= i /\ ~(j = i) <=> j < i`] THEN + DISCH_TAC THEN + ASSERT_TAC `1 < SUC (i - j) /\ SUC (i - j) <= n` THENL + [ASM_SIMP_TAC [ARITH_RULE + `i < n /\ j < i ==> 1 < SUC (i - j) /\ SUC (i - j) <= n`] THEN + MATCH_MP_TAC (ARITH_RULE `i < n /\ j < i ==> 1 < SUC (i - j)`) THEN + ASM_REWRITE_TAC []; + ASM_SIMP_TAC [COMPLEX_MUL_RZERO; COMPLEX_VEC_0]]; + REWRITE_TAC [NUMSEG_SING; VSUM_SING; BINOM_REFL; SUB_REFL] THEN + ASM_REWRITE_TAC [COMPLEX_MUL_LID; COMPLEX_MUL_RID; + higher_complex_derivative] THEN + ASM_REWRITE_TAC [GSYM o_DEF] THEN + REWRITE_TAC [GSYM higher_complex_derivative; + higher_complex_derivative_alt] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC [ARITH_RULE `i:num < n ==> i <= n`] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC []]]]);; + +let HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA = prove + (`!f s z n m i. + open s /\ f holomorphic_on s /\ (!w. w IN s ==> f w IN s) /\ + z IN s /\ f z = z /\ complex_derivative f z = Cx(&1) /\ + (!i. 1 < i /\ i <= n ==> higher_complex_derivative i f z = Cx(&0)) /\ + i <= n + ==> higher_complex_derivative i (ITER m f) z = + higher_complex_derivative i f z`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC [RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + REWRITE_TAC [IMP_IMP] THEN + STRIP_TAC THEN + ASSERT_TAC `!m. ITER m f z = z:complex` THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC [ITER]; ALL_TAC] THEN + ASSERT_TAC `!m (w:complex). w IN s ==> ITER m f w IN s` THENL + [INDUCT_TAC THEN ASM_SIMP_TAC [ITER]; ALL_TAC] THEN + ASSERT_TAC `!m. ITER m f holomorphic_on s` THENL + [INDUCT_TAC THEN REWRITE_TAC [ITER_POINTLESS] THENL + [ASM_SIMP_TAC [I_DEF; HOLOMORPHIC_ON_ID]; + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex ->bool` THEN + ASM_REWRITE_TAC []]; + ALL_TAC] THEN + INDUCT_TAC THENL + [REWRITE_TAC [ITER_POINTLESS; I_DEF; HIGHER_COMPLEX_DERIVATIVE_ID] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC [higher_complex_derivative]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC [higher_complex_derivative; ONE]; ALL_TAC] THEN + MATCH_MP_TAC EQ_SYM THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC [ARITH_RULE `~(i = 0) /\ ~(i = 1) ==> 1 < i`]; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC [ITER_ALT_POINTLESS] THEN + EQ_TRANS_TAC `higher_complex_derivative i (ITER m f) (f z)` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA THEN + EXISTS_TAC `s:complex ->bool` THEN + EXISTS_TAC `s:complex ->bool` THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC []; + ASM_REWRITE_TAC [] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC []]]);; + +let HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA = prove + (`!f s z n m. + open s /\ f holomorphic_on s /\ (!w. w IN s ==> f w IN s) /\ + z IN s /\ f z = z /\ complex_derivative f z = Cx(&1) /\ + (!i. 1 < i /\ i < n ==> higher_complex_derivative i f z = Cx(&0)) /\ + 1 < n + ==> higher_complex_derivative n (ITER m f) z = + Cx(&m) * higher_complex_derivative n f z`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + INDUCT_TAC THEN REWRITE_TAC [LT_SUC_LE] THEN REWRITE_TAC [LT] THEN + REWRITE_TAC [RIGHT_FORALL_IMP_THM] THEN + STRIP_TAC THEN + ASSERT_TAC `!m. ITER m f z = z:complex` THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC [ITER]; ALL_TAC] THEN + ASSERT_TAC `!m (w:complex). w IN s ==> ITER m f w IN s` THENL + [INDUCT_TAC THEN ASM_SIMP_TAC [ITER]; ALL_TAC] THEN + ASSERT_TAC `!m. ITER m f holomorphic_on s` THENL + [INDUCT_TAC THEN REWRITE_TAC [ITER_POINTLESS] THEN + ASM_SIMP_TAC [I_DEF; HOLOMORPHIC_ON_ID] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex ->bool` THEN + ASM_REWRITE_TAC []; + ALL_TAC] THEN + ASSERT_TAC `!w. w IN s ==> f complex_differentiable at w` THENL + [ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN + ASSERT_TAC `!m w. w IN s ==> ITER m f complex_differentiable at w` THENL + [ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN + ASSERT_TAC `!m. complex_derivative (ITER m f) z = Cx(&1)` THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC [ITER_POINTLESS] THENL + [REWRITE_TAC [I_DEF; COMPLEX_DERIVATIVE_ID]; ALL_TAC] THEN + ASM_SIMP_TAC [COMPLEX_DERIVATIVE_CHAIN; + HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT] THEN + REWRITE_TAC [COMPLEX_MUL_LID]; + ALL_TAC] THEN + INDUCT_TAC THEN + REWRITE_TAC [higher_complex_derivative_alt; ITER_POINTLESS] THENL + [ASM_REWRITE_TAC [COMPLEX_MUL_LZERO; I_DEF; COMPLEX_DERIVATIVE_ID; + HIGHER_COMPLEX_DERIVATIVE_CONST; + ARITH_RULE `n = 0 <=> ~(1 <= n)`]; + ALL_TAC] THEN + EQ_TRANS_TAC `higher_complex_derivative n + (\w. complex_derivative f (ITER m f w) * + complex_derivative (ITER m f) w) z` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC [o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC [] THEN + ONCE_REWRITE_TAC [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC [ETA_AX]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_ID] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_CHAIN THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + ASM_MESON_TAC []; + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + ASM_MESON_TAC []]]; + ALL_TAC] THEN + EQ_TRANS_TAC + `vsum (0..n) + (\i. Cx(&(binom (n,i))) * + higher_complex_derivative i + (\w. complex_derivative f (ITER m f w)) z * + higher_complex_derivative (n - i) + (complex_derivative (ITER m f)) z)` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_MUL THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + EQ_TRANS_TAC + `vsum {0,n} + (\i. Cx(&(binom (n,i))) * + higher_complex_derivative i + (\w. complex_derivative f (ITER m f w)) z * + higher_complex_derivative (n - i) + (complex_derivative (ITER m f)) z)` THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC [INSERT_SUBSET; EMPTY_SUBSET; IN_NUMSEG_0; LE_0; LE_REFL; + IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + X_GEN_TAC `i:num` THEN + STRIP_TAC THEN + REWRITE_TAC [GSYM higher_complex_derivative_alt] THEN + ASSERT_TAC `1 < SUC (n-i) /\ SUC (n-i) <= n` THENL + [ASM_SIMP_TAC [ARITH_RULE `i <= n /\ ~(i=0) /\ ~(i=n) + ==> 1 < SUC (n-i) /\ SUC (n-i) <= n`]; + ALL_TAC] THEN + ASM_SIMP_TAC [] THEN + SUBGOAL_THEN + `higher_complex_derivative (SUC (n - i)) (ITER m f) z = Cx(&0)` + SUBST1_TAC THENL + [EQ_TRANS_TAC `higher_complex_derivative (SUC (n - i)) f z` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC [] THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC []; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC []]; + ASM_REWRITE_TAC [COMPLEX_MUL_RZERO; COMPLEX_VEC_0]]; + ALL_TAC] THEN + SIMP_TAC [VSUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC [binom; BINOM_REFL; COMPLEX_MUL_LID; + SUB_REFL; SUB; higher_complex_derivative] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC [] THENL + [REWRITE_TAC [higher_complex_derivative] THEN + POP_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC (REWRITE_RULE [higher_complex_derivative]) THEN + ASM_REWRITE_TAC [COMPLEX_MUL_RID; COMPLEX_MUL_LID; + COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN + ASM_MESON_TAC [ARITH_RULE `~(1 <= 0)`]; + ALL_TAC] THEN + ASM_REWRITE_TAC [COMPLEX_MUL_LID; COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN + ASM_REWRITE_TAC [COMPLEX_MUL_RID] THEN + ASM_REWRITE_TAC [GSYM higher_complex_derivative_alt] THEN + SUBGOAL_THEN + `(\w. complex_derivative f (ITER m f w)) = complex_derivative f o ITER m f` + SUBST1_TAC + THENL [REWRITE_TAC [FUN_EQ_THM; o_THM]; ALL_TAC] THEN + SUBGOAL_THEN + `higher_complex_derivative n (complex_derivative f o ITER m f) z = + higher_complex_derivative n (complex_derivative f) (ITER m f z)` + SUBST1_TAC THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA THEN + EXISTS_TAC `s:complex->bool` THEN + EXISTS_TAC `s:complex->bool` THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; LE_REFL] THEN + REPEAT STRIP_TAC THEN + EQ_TRANS_TAC `higher_complex_derivative i f z` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA THEN + EXISTS_TAC `s:complex->bool` THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + ASSERT_TAC `Cx(&(SUC m)) = Cx(&m) + Cx(&1)` THENL + [REWRITE_TAC [GSYM CX_ADD; REAL_OF_NUM_ADD; ONE; ADD_SUC; ADD_0]; + ASM_REWRITE_TAC[COMPLEX_POLY_CLAUSES; + GSYM higher_complex_derivative_alt]]);; + +let CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND = prove + (`!f z y r B0 n. + &0 < r /\ 0 < n /\ + f holomorphic_on ball(z,r) /\ + f continuous_on cball(z,r) /\ + (!w. w IN ball(z,r) ==> f w IN ball(y,B0)) + ==> norm (higher_complex_derivative n f z) <= &(FACT n) * B0 / r pow n`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `higher_complex_derivative n f z = + higher_complex_derivative n (\w. f w - y) z` + SUBST1_TAC THENL + [EQ_TRANS_TAC `higher_complex_derivative n (\w. f w) z - + higher_complex_derivative n (\w. y) z` THENL + [ASM_SIMP_TAC + [HIGHER_COMPLEX_DERIVATIVE_CONST; ARITH_RULE `0 ~(n=0)`] THEN + REWRITE_TAC [COMPLEX_SUB_RZERO; ETA_AX]; + MATCH_MP_TAC EQ_SYM THEN + REWRITE_TAC [ETA_AX] THEN + MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_SUB THEN + EXISTS_TAC `ball(z:complex,r)` THEN + ASM_SIMP_TAC [OPEN_BALL; HOLOMORPHIC_ON_CONST; CENTRE_IN_BALL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `norm ((Cx(&2) * Cx pi * ii) / Cx(&(FACT n)) + * higher_complex_derivative n (\w. f w - y) z) + <= (B0 / r pow (n + 1)) * &2 * pi * r` + MP_TAC THENL + [MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH THEN + EXISTS_TAC `(\u. (f u - y) / (u - z) pow (n + 1))` THEN + EXISTS_TAC `z:complex` THEN STRIP_TAC THENL + [MATCH_MP_TAC CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH THEN + ASM_SIMP_TAC[CENTRE_IN_BALL] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ASM_REWRITE_TAC [CONTINUOUS_ON_CONST]; + MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + ASM_REWRITE_TAC [HOLOMORPHIC_ON_CONST]]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN STRIP_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC + (prove(`(?x. &0 <= x /\ x < B0) ==> &0 < B0`, REAL_ARITH_TAC)) THEN + EXISTS_TAC `norm ((\u. (f:complex->complex) u - y) z)` THEN + SIMP_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN + `!w:complex. f w IN ball(y,B0) ==> norm (f w - y) < B0` + MATCH_MP_TAC THENL + [ASM_MESON_TAC [dist; DIST_SYM; IN_BALL; CENTRE_IN_BALL]; + ALL_TAC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CENTRE_IN_BALL]; + MATCH_MP_TAC(SPECL [`r:real`;`n + 1`] REAL_POW_LE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]]; + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[COMPLEX_NORM_DIV;COMPLEX_NORM_POW] THEN + ASM_SIMP_TAC [REAL_LE_DIV2_EQ; REAL_POW_LT] THEN + ONCE_REWRITE_TAC[MESON[] `!(f:complex->complex). + (f x - y) = (\w. f w - y) x`] THEN + MATCH_MP_TAC CONTINUOUS_ON_CLOSURE_NORM_LE THEN + EXISTS_TAC `ball(z:complex,r)` THEN + ASM_SIMP_TAC[CLOSURE_BALL] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST]; + SUBGOAL_THEN + `!w:complex. f w IN ball(y,B0) ==> norm (f w - y) <= B0` + MATCH_MP_TAC THENL + [REWRITE_TAC[GSYM dist;IN_BALL;DIST_SYM;REAL_LT_IMP_LE]; + ASM_MESON_TAC [dist; DIST_SYM; IN_BALL; CENTRE_IN_BALL]]; + ASM_REWRITE_TAC[cball;IN_ELIM_THM;dist;DIST_SYM] THEN + ASM_SIMP_TAC[REAL_EQ_IMP_LE]]]; + ALL_TAC] THEN + REWRITE_TAC [COMPLEX_NORM_MUL; COMPLEX_NORM_DIV; COMPLEX_NORM_II; + COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_PI; + REAL_MUL_RID] THEN + STRIP_TAC THEN + ABBREV_TAC `a = (&2 * pi) / &(FACT n)` THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN + SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; FACT_LT; ARITH; PI_POS]; + ALL_TAC] THEN + SUBGOAL_THEN + `B0 / r pow (n + 1) * &2 * pi * r = a * (&(FACT n) * B0 / r pow n)` + SUBST_ALL_TAC THENL + [EXPAND_TAC "a" THEN + REWRITE_TAC [GSYM ADD1; real_pow] THEN + SUBGOAL_THEN `~(&(FACT n) = &0) /\ &0 < r` MP_TAC THENL + [ASM_REWRITE_TAC[FACT_NZ; REAL_OF_NUM_EQ]; + CONV_TAC REAL_FIELD]; + ASM_MESON_TAC [REAL_LE_LCANCEL_IMP]]);; + +let FIRST_CARTAN_THM_DIM_1 = prove + (`!f s z w. + open s /\ connected s /\ bounded s /\ + (!w. w IN s ==> f w IN s) /\ f holomorphic_on s /\ + z IN s /\ f z = z /\ + complex_derivative f z = Cx(&1) /\ w IN s + ==> f w = w`, + REWRITE_TAC [RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN REPEAT STRIP_TAC THEN EQ_TRANS_TAC `I w:complex` THENL + [MATCH_MP_TAC HOLOMORPHIC_FUN_EQ_ON_CONNECTED; + REWRITE_TAC [I_THM]] THEN + EXISTS_TAC `z:complex` THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC [I_DEF; HOLOMORPHIC_ON_ID] THEN + GEN_TAC THEN STRIP_ASSUME_TAC (ARITH_RULE `n = 0 \/ n = 1 \/ 1 < n`) THENL + [ASM_REWRITE_TAC [higher_complex_derivative]; + ASM_REWRITE_TAC [ONE; higher_complex_derivative; COMPLEX_DERIVATIVE_ID]; + ASM_REWRITE_TAC [HIGHER_COMPLEX_DERIVATIVE_ID]] THEN + ASM_SIMP_TAC [ARITH_RULE `1 < n ==> ~(n=0) /\ ~(n=1)`] THEN + POP_ASSUM MP_TAC THEN SPEC_TAC (`n:num`,`n:num`) THEN + MATCH_MP_TAC num_WF THEN REPEAT STRIP_TAC THEN + REWRITE_TAC [GSYM COMPLEX_NORM_ZERO] THEN + MATCH_MP_TAC REAL_ARCH_RDIV_EQ_0 THEN REWRITE_TAC [NORM_POS_LE] THEN + ASSERT_TAC `?c. s SUBSET ball(z:complex,c)` THENL + [ASSERT_TAC `?c. !w:complex. w IN s ==> norm w <= c` THENL + [ASM_REWRITE_TAC[GSYM bounded]; + EXISTS_TAC `&2 * c + &1` THEN REWRITE_TAC [SUBSET] THEN GEN_TAC THEN + DISCH_TAC THEN + SUBGOAL_THEN `norm (x:complex) <= c /\ norm (z:complex) <= c` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC [IN_BALL] THEN NORM_ARITH_TAC]]; + ALL_TAC] THEN + ASSERT_TAC `?r. &0 < r /\ cball(z:complex,r) SUBSET s` THENL + [ASM_MESON_TAC [OPEN_CONTAINS_CBALL]; + EXISTS_TAC `&(FACT n) * c / r pow n`] THEN + ASSERT_TAC `&0 < c` THENL + [SUBGOAL_THEN `~(ball(z:complex,c) = {})` MP_TAC THENL + [ASM SET_TAC[]; ASM_REWRITE_TAC [BALL_EQ_EMPTY; REAL_NOT_LE]]; + ALL_TAC] THEN + ASSERT_TAC `ball(z:complex,r) SUBSET s` THENL + [ASM_MESON_TAC [SUBSET_TRANS; BALL_SUBSET_CBALL]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1` THEN REWRITE_TAC [REAL_LT_01; FACT_LE; REAL_OF_NUM_LE]; + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC [REAL_LT_IMP_LE; REAL_POW_LE]]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [GSYM COMPLEX_NORM_NUM] THEN + REWRITE_TAC [GSYM COMPLEX_NORM_MUL] THEN SUBGOAL_THEN + `Cx(&m) * higher_complex_derivative n f z = + higher_complex_derivative n (ITER m f) z` + SUBST1_TAC THENL + [MATCH_MP_TAC (GSYM HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA) THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC []; + ALL_TAC] THEN + REWRITE_TAC [COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_POS] THEN + MATCH_MP_TAC CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND THEN + EXISTS_TAC `z:complex` THEN ASM_SIMP_TAC [ARITH_RULE `1 0 < n`] THEN + ASSERT_TAC `!m w. w:complex IN s ==> ITER m f w IN s` THENL + [INDUCT_TAC THEN ASM_SIMP_TAC [ITER]; + ASSERT_TAC `!m. ITER m f holomorphic_on s` THENL + [INDUCT_TAC THEN REWRITE_TAC [ITER_POINTLESS] THENL + [ASM_SIMP_TAC [I_DEF; HOLOMORPHIC_ON_ID]; + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC []]; + ASSERT_TAC `ITER m f holomorphic_on ball(z,r)` THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN ASM SET_TAC []; + ASM_REWRITE_TAC[]] THEN + CONJ_TAC THENL + [ASM_MESON_TAC [CONTINUOUS_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; + ASM SET_TAC []]]]);; + +(* ------------------------------------------------------------------------- *) +(* Second Cartan Theorem. *) +(* ------------------------------------------------------------------------- *) + +let SECOND_CARTAN_THM_DIM_1 = prove + (`!g f r. + &0 < r /\ + g holomorphic_on ball(Cx(&0),r) /\ + (!z. z IN ball(Cx(&0),r) ==> g z IN ball(Cx(&0),r)) /\ + g(Cx(&0)) = Cx(&0) /\ + f holomorphic_on ball(Cx(&0),r) /\ + (!z. z IN ball(Cx(&0),r) ==> f z IN ball(Cx(&0),r)) /\ + f (Cx(&0)) = Cx(&0) /\ + (!z. z IN ball(Cx(&0),r) ==> g (f z) = z) /\ + (!z. z IN ball(Cx(&0),r) ==> f (g z) = z) + ==> ?t. !z. z IN ball(Cx(&0),r) ==> g z = cexp(ii * Cx t) * z`, + let COMPLEX_DERIVATIVE_LEFT_INVERSE = prove + (`!s t f g w. + open s /\ open t /\ + (!z. z IN s ==> f z IN t) /\ f holomorphic_on s /\ + (!z. z IN t ==> g z IN s) /\ g holomorphic_on t /\ + (!z. z IN s ==> g (f z) = z) /\ w IN s + ==> complex_derivative f w * complex_derivative g (f w) = Cx(&1)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [COMPLEX_MUL_SYM] THEN + SUBGOAL_THEN `complex_derivative g (f w) * complex_derivative f w = + complex_derivative (g o f) w ` SUBST1_TAC THENL + [ASM_MESON_TAC [HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; + COMPLEX_DERIVATIVE_CHAIN]; + EQ_TRANS_TAC `complex_derivative (\u. u) w` THENL + [MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_ID;o_THM] THEN + ASM_MESON_TAC [HOLOMORPHIC_ON_COMPOSE_GEN]; + ASM_SIMP_TAC[COMPLEX_DERIVATIVE_ID]]]) in + let LEMMA_1 = prove + (`!s f. + open s /\ connected s /\ f holomorphic_on s /\ Cx(&0) IN s /\ + (!u z. norm u = &1 /\ z IN s ==> u * z IN s) /\ + (!u z. norm u = &1 /\ z IN s ==> f (u * z) = u * f z) + ==> ?c. !z. z IN s ==> f z = c * z`, + REPEAT STRIP_TAC THEN ABBREV_TAC `c = complex_derivative f (Cx(&0))` THEN + EXISTS_TAC `c : complex` THEN + SUBGOAL_THEN `f(Cx(&0)) = Cx(&0)` ASSUME_TAC THENL + [FIRST_X_ASSUM (MP_TAC o SPECL [`--Cx(&1)`;`Cx(&0)`]) THEN + ASM_REWRITE_TAC [NORM_NEG; COMPLEX_NORM_NUM; COMPLEX_MUL_RZERO] THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + SUBGOAL_THEN + `!n u z. + norm u = &1 /\ z IN s ==> + u pow n * higher_complex_derivative n f (u * z) = + u * higher_complex_derivative n f z` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + EQ_TRANS_TAC `higher_complex_derivative n (\w. f (u * w)) z` THENL + [MATCH_MP_TAC EQ_SYM THEN + MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR THEN + EXISTS_TAC `s:complex->bool` THEN EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + EQ_TRANS_TAC `higher_complex_derivative n (\w. u * f w) z` THENL + [MATCH_MP_TAC HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC + (REWRITE_RULE [o_DEF] + (SPECL [`\w:complex. u*w`; `f:complex->complex`] + HOLOMORPHIC_ON_COMPOSE_GEN)) THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC [HOLOMORPHIC_ON_LINEAR]; + MATCH_MP_TAC + (REWRITE_RULE [o_DEF] + (SPECL [`f:complex->complex`; `\w:complex. u*w`] + HOLOMORPHIC_ON_COMPOSE_GEN)) THEN + EXISTS_TAC `(:complex)` THEN + ASM_REWRITE_TAC [HOLOMORPHIC_ON_LINEAR; IN_UNIV]]; + POP_ASSUM MP_TAC THEN SPEC_TAC (`z:complex`,`z:complex`) THEN + SPEC_TAC (`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC [higher_complex_derivative] THEN GEN_TAC THEN + DISCH_TAC THEN EQ_TRANS_TAC + `complex_derivative (\w. u * higher_complex_derivative n f w) z` + THENL + [MATCH_MP_TAC COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + ASM_REWRITE_TAC [HOLOMORPHIC_ON_CONST]; + MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + ASM_REWRITE_TAC [HOLOMORPHIC_ON_CONST; ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC COMPLEX_DERIVATIVE_LMUL THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + ASM_MESON_TAC [HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE]]]; + SUBGOAL_THEN + `!n. 2 <= n ==> higher_complex_derivative n f (Cx(&0)) = Cx(&0)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN + `!n z. 2 <= n /\ + (!u. norm u = &1 ==> u pow n * z = u * z) ==> z = Cx(&0)` + MATCH_MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC + (COMPLEX_RING + `!u. ~(u pow n' = u) /\ u pow n' * z = u * z ==> z = Cx(&0)`) THEN + SUBGOAL_THEN `2 <= n' ==> ?u. norm u = &1 /\ ~(u pow n' = u)` + (fun th -> ASM_MESON_TAC [th]) THEN + STRUCT_CASES_TAC (SPEC `n':num` num_CASES) THEN + REWRITE_TAC + [ARITH_LE; ARITH_RULE `2 <= SUC n'' <=> 1 <= n''`; complex_pow] THEN + DISCH_TAC THEN MP_TAC (SPEC `n'':num` COMPLEX_NOT_ROOT_UNITY) THEN + ASM_REWRITE_TAC [] THEN STRIP_TAC THEN EXISTS_TAC `u:complex` THEN + ASM_REWRITE_TAC [] THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC [CONTRAPOS_THM] THEN + SUBGOAL_THEN `~(u = Cx(&0))` MP_TAC THENL + [ASM_REWRITE_TAC [GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]; + CONV_TAC COMPLEX_FIELD]; + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM (MP_TAC o SPECL [`n:num`;`u:complex`;`Cx(&0)`]) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO]]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE [] + (SPECL [`f:complex->complex`; `\z. c*z`; `Cx(&0)`; + `s:complex->bool`] + HOLOMORPHIC_FUN_EQ_ON_CONNECTED)) THEN + ASM_REWRITE_TAC [COMPLEX_MUL_RZERO; HOLOMORPHIC_ON_LINEAR; + HIGHER_COMPLEX_DERIVATIVE_LINEAR] THEN + GEN_TAC THEN FIRST_X_ASSUM (MP_TAC o SPEC `n:num`) THEN + STRUCT_CASES_TAC (ARITH_RULE `n = 0 \/ n = 1 \/ 2 <= n`) THEN + ASM_SIMP_TAC [higher_complex_derivative; ARITH_EQ; ARITH_LE; ONE] THEN + ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n=0)`] THEN + ASM_SIMP_TAC [ARITH_RULE `2 <= n ==> ~(n=SUC 0)`]]]) in + let LEMMA_2 = prove + (`!r c. &0 < r /\ &0 <= c /\ + (!x. &0 <= x /\ x < r ==> c * x < r) + ==> c <= &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC [GSYM REAL_NOT_LT] THEN STRIP_TAC THEN + FIRST_X_ASSUM (MP_TAC o SPEC `r * (c + &1) / (&2 * c)`) THEN + REWRITE_TAC [MESON [] `((a ==> b) ==> F) <=> (a /\ ~b)`] THEN + CONJ_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `r * &1` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC [REAL_MUL_RID; REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 * c` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC [REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC [REAL_NOT_LT] THEN + ONCE_REWRITE_TAC [REAL_RING `!a b c:real. a * b * c = b * a * c`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `r * &1` THEN CONJ_TAC THENL + [REWRITE_TAC [REAL_MUL_RID; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 * c` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC [REAL_ARITH `&0 < c ==> a * b / c = (a * b) / c`] THEN + SUBGOAL_THEN `(c * (c + &1)) / (&2 * c) = (c + &1) / &2` + SUBST1_TAC THENL + [ASM_SIMP_TAC [RAT_LEMMA5; REAL_ARITH `&0 < &2`] THEN + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]) in + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `!u z. norm u = &1 /\ z IN ball(Cx(&0),r) ==> u * g z = g (u * z)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(u = Cx(&0))` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM COMPLEX_NORM_NZ] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!w. w IN ball(Cx(&0),r) ==> f (u * g w) / u = w` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC FIRST_CARTAN_THM_DIM_1 THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN EXISTS_TAC `Cx(&0)` THEN + ASM_REWRITE_TAC [OPEN_BALL;CONNECTED_BALL;BOUNDED_BALL; + COMPLEX_MUL_RZERO; CENTRE_IN_BALL] THEN + ASSERT_TAC `!z. norm (u * z) = norm z` THENL + [ASM_REWRITE_TAC [COMPLEX_NORM_MUL; REAL_MUL_LID]; ALL_TAC] THEN + ASSERT_TAC `!z. z IN ball(Cx(&0),r) ==> u * z IN ball(Cx(&0),r)` THENL + [ASM_REWRITE_TAC [COMPLEX_IN_BALL_0]; ALL_TAC] THEN + ASSERT_TAC `!z. z IN ball(Cx(&0),r) ==> z / u IN ball(Cx(&0),r)` THENL + [ASM_REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_DIV; REAL_DIV_1]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN CONJ_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST]] THEN + SUBGOAL_THEN `(\w:complex. f (u * g w) : complex) = f o (\w. u * g w)` + SUBST1_TAC THENL + [REWRITE_TAC [o_DEF]; MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN] THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST]; + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC [complex_div; COMPLEX_MUL_LZERO]; ALL_TAC] THEN + SUBGOAL_THEN `Cx(&1) = u / u` SUBST1_TAC THENL + [ASM_SIMP_TAC [COMPLEX_DIV_REFL]; ALL_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CDIV_AT THEN + SUBGOAL_THEN `(\w:complex. f (u * g w) : complex) = f o (\w. u * g w)` + SUBST1_TAC THENL [REWRITE_TAC [o_DEF]; ALL_TAC] THEN + SUBGOAL_THEN + `((\w. f (u * g w)) has_complex_derivative + complex_derivative f (u * g(Cx(&0))) * + (u * complex_derivative g (Cx(&0)))) + (at (Cx(&0)))` MP_TAC THENL + [MATCH_MP_TAC (REWRITE_RULE [o_DEF] + (SPECL [`\w:complex. u * g(w):complex`; `f:complex->complex`] + COMPLEX_DIFF_CHAIN_AT)) THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT THEN + REWRITE_TAC [HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL]; + REWRITE_TAC [HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; COMPLEX_MUL_RZERO]]; + SUBGOAL_THEN + `complex_derivative f (u * g (Cx(&0))) * + (u * complex_derivative g (Cx(&0))) = u` + SUBST1_TAC THENL + [ALL_TAC; REWRITE_TAC[o_DEF]] THEN + ABBREV_TAC `g' = complex_derivative g (Cx(&0))` THEN + ABBREV_TAC `f' = complex_derivative f (Cx(&0))` THEN + SUBGOAL_THEN `f' * g' = Cx(&1)` ASSUME_TAC THENL + [EXPAND_TAC "g'" THEN EXPAND_TAC "f'" THEN + SUBGOAL_THEN `complex_derivative g (Cx(&0)) = + complex_derivative g (f (Cx(&0)))` SUBST1_TAC THENL + [ASM_REWRITE_TAC []; + MATCH_MP_TAC COMPLEX_DERIVATIVE_LEFT_INVERSE THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN EXISTS_TAC `ball(Cx(&0),r)` THEN + ASM_REWRITE_TAC [OPEN_BALL; CENTRE_IN_BALL]]; + ASM_REWRITE_TAC [COMPLEX_MUL_RZERO] THEN + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_RING]]; + SUBGOAL_THEN `f(u*g(z)) = f (g (u * z)) : complex` MP_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `u * z:complex` THEN CONJ_TAC THENL + [SUBGOAL_THEN `!x y:complex. x / u = y ==> x = u * y` MATCH_MP_TAC THENL + [REWRITE_TAC [complex_div] THEN GEN_TAC THEN GEN_TAC THEN + DISCH_THEN (SUBST1_TAC o GSYM) THEN + SUBGOAL_THEN `x = (inv u * u) * x` MP_TAC THENL + [ASM_SIMP_TAC [COMPLEX_MUL_LINV; COMPLEX_MUL_LID]; + REWRITE_TAC [COMPLEX_MUL_AC]]; + POP_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC []]; + MATCH_MP_TAC EQ_SYM THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; REAL_MUL_LID] THEN + ASM_REWRITE_TAC [GSYM COMPLEX_IN_BALL_0]]; + DISCH_TAC THEN SUBGOAL_THEN + `g (f (u * g z)) = g (f (g (u * z : complex))) : complex` MP_TAC THENL + [POP_ASSUM SUBST1_TAC THEN REWRITE_TAC []; + SUBGOAL_THEN `u * g z IN ball (Cx(&0),r) /\ u * z IN ball(Cx(&0),r)` + MP_TAC THENL + [ASM_REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; REAL_MUL_LID] THEN + REWRITE_TAC [GSYM COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[]; + ASM_SIMP_TAC[]]]]]; + SUBGOAL_THEN `?c. !z. z IN ball(Cx(&0),r) ==> g z = c * z` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC LEMMA_1 THEN + ASM_SIMP_TAC [OPEN_BALL; CONNECTED_BALL; CENTRE_IN_BALL] THEN + SIMP_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_MUL; REAL_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `norm (c:complex) = &1` ASSUME_TAC THENL + [ALL_TAC; ASM_MESON_TAC [COMPLEX_NORM_EQ_1_CEXP]] THEN + SUBGOAL_THEN `~(norm (c:complex) = &0)` ASSUME_TAC THENL + [REWRITE_TAC [COMPLEX_NORM_ZERO] THEN STRIP_TAC THEN + SUBGOAL_THEN `Cx(&0) = Cx(r / &2)` MP_TAC THENL + [ALL_TAC; REWRITE_TAC [CX_INJ] THEN ASM_REAL_ARITH_TAC] THEN + SUBGOAL_THEN `Cx(r / &2) IN ball(Cx(&0),r)` ASSUME_TAC THENL + [REWRITE_TAC [COMPLEX_IN_BALL_0; CX_DIV; COMPLEX_NORM_DIV; + COMPLEX_NORM_NUM] THEN + REWRITE_TAC [COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; + EQ_TRANS_TAC `g (f (Cx(r / &2)):complex):complex` THENL + [EQ_TRANS_TAC `c * (f (Cx(r / &2)):complex)` THENL + [ASM_REWRITE_TAC [COMPLEX_MUL_LZERO]; ASM_MESON_TAC[]]; + ASM_MESON_TAC[]]]; + ALL_TAC] THEN SUBGOAL_THEN `&0 < norm (c:complex)` ASSUME_TAC THENL + [POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH; ALL_TAC] THEN + REWRITE_TAC [GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC LEMMA_2 THEN EXISTS_TAC `r : real` THEN + ASM_REWRITE_TAC [NORM_POS_LE] THEN GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `p = Cx x` THEN + SUBGOAL_THEN `x = norm (p:complex)` SUBST_ALL_TAC THENL + [EXPAND_TAC "p" THEN REWRITE_TAC [COMPLEX_NORM_CX] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC [GSYM COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN `c * p = g p` SUBST1_TAC THENL + [ALL_TAC; ASM_MESON_TAC [COMPLEX_IN_BALL_0]] THEN + FIRST_X_ASSUM (MATCH_MP_TAC o GSYM) THEN + ASM_MESON_TAC [COMPLEX_IN_BALL_0]]; + ALL_TAC] THEN + SUBST1_TAC (GSYM (SPEC `norm (c:complex)` REAL_INV_INV)) THEN + MATCH_MP_TAC REAL_INV_1_LE THEN CONJ_TAC THENL + [ASM_MESON_TAC [REAL_LT_INV]; ALL_TAC] THEN + MATCH_MP_TAC LEMMA_2 THEN EXISTS_TAC `r:real` THEN ASM_REWRITE_TAC [] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `x = norm (g (f (Cx x):complex):complex)` SUBST1_TAC THENL + [SUBGOAL_THEN `g (f (Cx x):complex) = Cx x` SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_CX] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC [COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `g (f (Cx x):complex) = c * f (Cx x) : complex` + SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_CX] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC [COMPLEX_NORM_MUL; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC [REAL_MUL_LINV; REAL_MUL_LID; GSYM COMPLEX_IN_BALL_0] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC [COMPLEX_IN_BALL_0; COMPLEX_NORM_CX] THEN + ASM_REAL_ARITH_TAC]]]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy's inequality and more versions of Liouville. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_INEQUALITY = prove + (`!f z r (B:real) n. + f continuous_on cball(z,r) /\ + f holomorphic_on ball(z,r) /\ &0 < r /\ + (!x:complex. norm(z-x) = r ==> norm(f x) <= B) + ==> norm (higher_complex_derivative n f z) <= &(FACT n) * B / r pow n`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `&0 <= B` ASSUME_TAC THENL + [SUBGOAL_THEN `?x:complex. norm (z-x) = r` STRIP_ASSUME_TAC THENL [ + EXISTS_TAC `z + Cx r` THEN ASM_SIMP_TAC[COMPLEX_ADD_SUB2;NORM_NEG; + COMPLEX_NORM_CX;REAL_ABS_REFL;REAL_LT_IMP_LE];ALL_TAC] THEN + ASM_MESON_TAC [NORM_POS_LE;REAL_LE_TRANS]; + SUBGOAL_THEN `norm ((Cx(&2) * Cx pi * ii) / Cx(&(FACT n)) + * higher_complex_derivative n f z) + <= (B / r pow (n + 1)) * &2 * pi * r` MP_TAC THENL[ + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH THEN + EXISTS_TAC `\u. (f:complex->complex) u / (u - z) pow (n + 1)` THEN + EXISTS_TAC `z:complex` THEN CONJ_TAC THENL [MATCH_MP_TAC + CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH THEN + ASM_SIMP_TAC [CENTRE_IN_BALL]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC + [REAL_POW_LE;REAL_LT_IMP_LE];ALL_TAC]THEN ASM_REWRITE_TAC [] + THEN GEN_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC [COMPLEX_NORM_DIV;COMPLEX_NORM_POW] THEN MATCH_MP_TAC + REAL_LE_TRANS THEN EXISTS_TAC `B:real / r pow (n+1)` THEN + ASM_SIMP_TAC[ REAL_LE_DIV2_EQ; REAL_POW_LT;NORM_SUB;REAL_LE_REFL]; + REWRITE_TAC[COMPLEX_NORM_DIV;COMPLEX_NORM_MUL; COMPLEX_NORM_II; + COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID;REAL_ABS_NUM] + THEN SUBGOAL_THEN `B / r pow (n + 1) * &2 * pi * r = + (&2 * pi) / &(FACT n) * (((&(FACT n) * B) * r/ r pow (n+1)))` + SUBST1_TAC THENL [SUBGOAL_THEN `~(&(FACT n) = &0)` MP_TAC THENL + [REWRITE_TAC [FACT_NZ;REAL_OF_NUM_EQ];ALL_TAC] + THEN CONV_TAC REAL_FIELD;SUBGOAL_THEN `&0 < (&2 * pi) / &(FACT n)` ASSUME_TAC + THENL[MATCH_MP_TAC REAL_LT_DIV THEN SIMP_TAC[FACT_LT;REAL_OF_NUM_LT] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC;SUBGOAL_THEN `(&(FACT n) * B) * r / r pow + (n + 1) = &(FACT n) * B / r pow n` SUBST1_TAC THENL + [REWRITE_TAC[GSYM ADD1; real_pow] THEN MP_TAC (ASSUME `&0 < r`) THEN + CONV_TAC REAL_FIELD; ASM_MESON_TAC [REAL_LE_LCANCEL_IMP]]]]]]);; + +let LIOUVILLE_POLYNOMIAL = prove + (`!f A B n. + f holomorphic_on (:complex) /\ + (!z. A <= norm(z) ==> norm(f z) <= B * norm(z) pow n) + ==> !z. f(z) = vsum (0..n) + (\k. higher_complex_derivative k f (Cx(&0)) / + Cx(&(FACT k)) * z pow k)`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `B <= &0 \/ &0 < B`) THENL + [MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`] LIOUVILLE_WEAK) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN + EXISTS_TAC `A:real` THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC(NORM_ARITH + `r <= &0 ==> norm z <= r ==> z = vec 0`) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --b * x ==> b * x <= &0`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[NORM_POS_LE; REAL_POW_LE] THEN ASM_REAL_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM FUN_EQ_THM] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_CONST] THEN + REWRITE_TAC[COND_ID; complex_div; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0]]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN + SUBGOAL_THEN + `((\n. higher_complex_derivative n f (Cx(&0)) / Cx(&(FACT n)) * + (z - Cx(&0)) pow n) sums f(z)) (from 0)` + MP_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_POWER_SERIES THEN + EXISTS_TAC `norm(z:complex) + &1` THEN + REWRITE_TAC[COMPLEX_IN_BALL_0; REAL_ARITH `x < x + &1`] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; + REWRITE_TAC[COMPLEX_SUB_RZERO] THEN DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `n + 1` o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ADD_SUB; ARITH_RULE `0 < n + 1`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SERIES_UNIQUE) THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC SUMS_0 THEN + X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_FROM; ARITH_RULE `n + 1 <= k <=> n < k`] THEN + DISCH_TAC THEN REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN + REWRITE_TAC[COMPLEX_DIV_EQ_0] THEN REPEAT DISJ1_TAC THEN + MATCH_MP_TAC(MESON[COMPLEX_NORM_NZ] `~(&0 < norm w) ==> w = Cx(&0)`) THEN + DISCH_TAC THEN ABBREV_TAC + `w = Cx(&(FACT k) * + B / norm(higher_complex_derivative k f (Cx(&0))) + + abs A + &1)` THEN + SUBGOAL_THEN `~(w = Cx(&0))` ASSUME_TAC THENL + [EXPAND_TAC "w" THEN REWRITE_TAC[CX_INJ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> ~(x + abs a + &1 = &0)`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MP_TAC(SPECL + [`f:complex->complex`; `Cx(&0)`; `norm(w:complex)`; + `B * norm(w:complex) pow n`; `k:num`] + CAUCHY_INEQUALITY) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_SUBSET; + SUBSET_UNIV]; + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; + ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; + REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN + X_GEN_TAC `x:complex` THEN DISCH_THEN(fun th -> + SUBST1_TAC(SYM th) THEN ASSUME_TAC th) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "w" THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= k ==> a <= abs(k + abs a + &1)`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]; + REWRITE_TAC[REAL_ARITH + `~(d:real <= f * (b * n) / k) <=> f * b * (n / k) < d`] THEN + ASM_SIMP_TAC[REAL_DIV_POW2; COMPLEX_NORM_ZERO] THEN + ASM_REWRITE_TAC[REAL_MUL_ASSOC; GSYM NOT_LT] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ; + REAL_POW_LT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ] THEN + TRANS_TAC REAL_LTE_TRANS `norm(w:complex) pow 1` THEN CONJ_TAC THENL + [EXPAND_TAC "w" THEN REWRITE_TAC[REAL_POW_1; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= k * B / d ==> (B * k) / d < abs(k * B / d + abs a + &1)`); + MATCH_MP_TAC REAL_POW_MONO THEN + CONJ_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN + EXPAND_TAC "w" THEN REWRITE_TAC[REAL_POW_1; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= k * B / d ==> &1 <= abs(k * B / d + abs a + &1)`)] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE]]);; + +let LIOUVILLE_THEOREM = prove + (`!f. f holomorphic_on (:complex) /\ bounded (IMAGE f (:complex)) + ==> ?c. !z. f(z) = c`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `&0`; `B:real`; `0`] + LIOUVILLE_POLYNOMIAL) THEN + ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; real_pow; REAL_MUL_RID; complex_pow] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A holomorphic function f has only isolated zeros unless f is 0. *) +(* ------------------------------------------------------------------------- *) + +let ISOLATED_ZEROS = prove + (`!f a z w. + open a /\ connected a /\ f holomorphic_on a /\ z IN a /\ f z = Cx(&0) /\ + w IN a /\ ~(f w = Cx(&0)) + ==> (?r. &0 < r /\ ball(z,r) SUBSET a /\ + (!w. w IN ball(z,r) /\ ~(w=z) ==> ~(f w = Cx(&0))))`, + REPEAT STRIP_TAC THEN ASSERT_TAC `?k. + ~(higher_complex_derivative k f z = Cx(&0)) /\ + (!n. n < k ==> higher_complex_derivative n f z = Cx(&0))` THENL + [EXISTS_TAC `minimal n. (~(higher_complex_derivative n f z = Cx(&0)))` + THEN SUBGOAL_THEN `?k'. ~(higher_complex_derivative k' f z = Cx(&0))` + (fun th-> ASM_MESON_TAC[th;MINIMAL]) THEN REWRITE_TAC[GSYM NOT_FORALL_THM] + THEN STRIP_TAC THEN ASM_MESON_TAC[HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED]; + ALL_TAC] THEN SUBGOAL_THEN `~(k = 0)`ASSUME_TAC THENL + [STRIP_TAC THEN MP_TAC(ASSUME `~(higher_complex_derivative k f z = Cx(&0))`) + THEN ASM_MESON_TAC[higher_complex_derivative]; + STRIP_ASSUME_TAC (MESON [OPEN_CONTAINS_BALL;ASSUME `open (a:complex->bool)`; + ASSUME `z:complex IN a`] `?s. &0 < s /\ ball (z:complex,s) SUBSET a`) + THEN ASSUME_TAC (MESON [HOLOMORPHIC_POWER_SERIES; + ASSUME `f holomorphic_on a`;ASSUME `ball (z:complex,s) + SUBSET a`;HOLOMORPHIC_ON_SUBSET] `!w:complex. w IN ball(z,s) ==> + ((\n. higher_complex_derivative n f z / Cx(&(FACT n))*(w -z) pow n) sums f w) + (from 0)`) THEN ASSERT_TAC `?g:complex->complex. !x:complex. + x IN ball(z,s) ==> + (((\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (x - z) pow (n-k))) sums g x) (from k)` THENL + [EXISTS_TAC `\x:complex. lim sequentially + (\m. vsum (k..m) (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (x - z) pow (n-k)))` THEN GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `!m. k..m = (0..m) INTER from k` ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_FROM; IN_INTER; IN_ELIM_THM; IN_NUMSEG] THEN + ARITH_TAC;ASM_REWRITE_TAC[] THEN REWRITE_TAC + [SET_RULE `!m. (0..m) INTER from k = from k INTER (0..m)`;SUMS_LIM]] THEN + ASM_CASES_TAC `x:complex = z` THENL + [ASM_REWRITE_TAC[COMPLEX_SUB_REFL;summable] THEN + EXISTS_TAC `higher_complex_derivative k f z / Cx(&(FACT k))` THEN + MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n. if n = k then + higher_complex_derivative k f z / Cx(&(FACT k)) else Cx(&0)` + THEN CONJ_TAC THENL [REWRITE_TAC [IN_FROM] THEN GEN_TAC THEN DISCH_TAC + THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_POW_ZERO;SUB_REFL;COMPLEX_MUL_RID]; + ASM_SIMP_TAC[COMPLEX_POW_ZERO; ARITH_RULE `k <= x' /\ ~(x' = k) ==> + ~(x' - k = 0)`;COMPLEX_MUL_RZERO]]; MATCH_MP_TAC SERIES_VSUM THEN + EXISTS_TAC `{k:num}` THEN SIMP_TAC [FINITE_SING;from;IN_SING; + COMPLEX_VEC_0;VSUM_SING] THEN SET_TAC[LE_REFL]]; + MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC + `\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (x - z) pow n / (x-z) pow k` THEN CONJ_TAC THENL [REWRITE_TAC [IN_FROM] + THEN GEN_TAC THEN DISCH_TAC THEN SUBGOAL_THEN `(x:complex - z) pow (x' - k) + = (x - z) pow x' / (x - z) pow k` (fun th-> + REWRITE_TAC[th;COMPLEX_EQ_MUL_LCANCEL]) THEN MATCH_MP_TAC + COMPLEX_DIV_POW THEN ASM_SIMP_TAC [COMPLEX_SUB_0]; + SUBGOAL_THEN `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (x - z) pow n / (x - z) pow k) = (\n. (higher_complex_derivative n f z / + Cx(&(FACT n)) *(x - z) pow n) / (x - z) pow k) ` SUBST1_TAC + THENL [REWRITE_TAC [FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC COMPLEX_FIELD; + MATCH_MP_TAC SUMMABLE_COMPLEX_DIV THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE + THEN EXISTS_TAC `0` THEN ASM_MESON_TAC[summable]]]];ALL_TAC] THEN + ASSERT_TAC `~(g (z:complex) = Cx(&0)) /\ + (!x. x IN ball(z,s) ==> f x = (x - z) pow k * g(x))` THENL + [CONJ_TAC THENL [MATCH_MP_TAC + (COMPLEX_FIELD `!x y:complex. x = y /\ ~(y= Cx(&0)) ==> ~(x=Cx(&0))`) THEN + EXISTS_TAC `higher_complex_derivative k f z / Cx(&(FACT k))` THEN + CONJ_TAC THENL [ONCE_REWRITE_TAC [GSYM COMPLEX_SUB_0] THEN + MATCH_MP_TAC SERIES_UNIQUE THEN EXISTS_TAC + `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + Cx(&0) pow (n-k))` THEN EXISTS_TAC `from (k +1)` THEN + CONJ_TAC THENL [SUBST1_TAC (MESON [VSUM_SING_NUMSEG] + `higher_complex_derivative k f z / Cx(&(FACT k)) = + vsum (k..k) (\n. higher_complex_derivative n f z / Cx(&(FACT n))) `) + THEN SUBGOAL_THEN `vsum (k..k) (\n. higher_complex_derivative n f z + / Cx(&(FACT n))) = vsum (k..((k+1)-1)) (\n. higher_complex_derivative n f z + / Cx(&(FACT n)) * Cx(&0) pow (n - k))` SUBST1_TAC THENL [ + REWRITE_TAC[VSUM_SING_NUMSEG; COMPLEX_POW_ZERO;SUB_REFL;COMPLEX_MUL_RID; + ARITH_RULE `((k:num) + 1) -1 = k`]; + MATCH_MP_TAC SUMS_OFFSET THEN + ASM_REWRITE_TAC[ARITH_RULE `k:num <= k+1 /\ 0 < k+1`] + THEN POP_ASSUM (MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL;COMPLEX_SUB_REFL]];MATCH_MP_TAC + SUMS_COMPLEX_0 THEN GEN_TAC THEN SIMP_TAC [IN_FROM;COMPLEX_POW_ZERO; + ARITH_RULE `k + 1 <= n <=> ~(n-k= 0)`;COMPLEX_MUL_RZERO]]; + MATCH_MP_TAC (COMPLEX_FIELD `!x y. ~(x = Cx(&0)) /\ ~(y = Cx(&0)) + ==> ~(x / y = Cx(&0))`) THEN ASM_REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN + SUBST1_TAC (MESON [COMPLEX_NORM_CX] + `norm (Cx(&(FACT k))) = abs ((&(FACT k)))`) THEN + SIMP_TAC [REAL_ABS_ZERO;FACT_LT;REAL_OF_NUM_LT;REAL_LT_IMP_NZ]]; ALL_TAC] + THEN GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (x - z) pow n)`THEN EXISTS_TAC `(from 0)` THEN + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_CASES_TAC `x:complex = z` THENL [ + ASM_REWRITE_TAC[COMPLEX_SUB_REFL] THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\n:num. Cx(&0)` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_FROM;COMPLEX_POW_ZERO] THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN COND_CASES_TAC THENL [ + ASM_REWRITE_TAC[higher_complex_derivative] THEN CONV_TAC COMPLEX_FIELD; + REWRITE_TAC[COMPLEX_MUL_RZERO]]; + ASM_REWRITE_TAC[COMPLEX_POW_ZERO;COMPLEX_MUL_LZERO] THEN + ASM_REWRITE_TAC[SERIES_0;GSYM COMPLEX_VEC_0]];ALL_TAC] THEN + MATCH_MP_TAC SUMS_EQ THEN EXISTS_TAC `\n.(x-z) pow k * + higher_complex_derivative n f z / Cx(&(FACT n)) *(x - z) pow (n - k)` + THEN CONJ_TAC THENL [REWRITE_TAC[IN_FROM] THEN X_GEN_TAC `n:num` + THEN DISCH_TAC THEN ASM_CASES_TAC `n:num < k` THENL [ASM_SIMP_TAC[] + THEN CONV_TAC COMPLEX_FIELD; + SUBGOAL_THEN `(x:complex-z) pow (n-k) = (x-z) pow n / (x-z) pow k` + SUBST1_TAC THENL [MATCH_MP_TAC COMPLEX_DIV_POW THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; ARITH_RULE `~(n:num < k) ==> k <= n`]; + SUBST1_TAC (COMPLEX_FIELD `(x - z) pow k * + higher_complex_derivative n f z / Cx(&(FACT n)) * + (x - z) pow n / (x - z) pow k = + higher_complex_derivative n f z / Cx(&(FACT n)) * (x-z) pow k * + (x - z) pow n / (x - z) pow k`) THEN MESON_TAC [ASSUME `~(x:complex = z)`; + COMPLEX_DIV_LMUL;COMPLEX_SUB_0;COMPLEX_POW_EQ_0]]]; + MATCH_MP_TAC SERIES_COMPLEX_LMUL THEN SUBST1_TAC + (MESON [COMPLEX_ADD_RID] `(g:complex->complex) x = g x + Cx(&0)`) THEN + SUBGOAL_THEN `Cx(&0) = vsum (0.. (k-1)) + (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * (x - z) pow (n - k))` + SUBST1_TAC THENL [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC [GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN + REWRITE_TAC [IN_NUMSEG] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[ARITH_RULE ` ~(k = 0) /\ n <= k - 1 ==> n < k`] THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_FIELD; + MATCH_MP_TAC SUMS_OFFSET_REV THEN + ASM_SIMP_TAC[ARITH_RULE `0 <= k /\ ~(k = 0) ==> 0 < k`;LE_0]]]];ALL_TAC] THEN + ASSERT_TAC `?r. &0 < r /\ (!x:complex. dist (z,x) < r ==> + ~((g:complex->complex) x = Cx(&0)))` THENL [ + MATCH_MP_TAC CONTINUOUS_ON_OPEN_AVOID THEN + EXISTS_TAC `ball(z:complex, s)` THEN + ASM_REWRITE_TAC[OPEN_BALL;CENTRE_IN_BALL] + THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC ANALYTIC_IMP_HOLOMORPHIC THEN MATCH_MP_TAC POWER_SERIES_ANALYTIC + THEN EXISTS_TAC `\n. higher_complex_derivative (n+k) f z / Cx(&(FACT (n+k)))` + THEN EXISTS_TAC `from 0` THEN REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC + THEN REWRITE_TAC[SERIES_FROM] THEN MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `(\n.vsum (k..(k+n)) + (\n. higher_complex_derivative n f z / Cx(&(FACT n)) *(w' - z) pow (n-k)))` + THEN CONJ_TAC THENL [SIMP_TAC [VSUM_OFFSET_0;ARITH_RULE + `!k n :num.(k + n) - k = n`; ARITH_RULE `!k n:num. k <= k + n`;ADD_ASSOC; + ARITH_RULE `!k n :num.(n + k) - k = n`] THEN + SUBGOAL_THEN `(\x. vsum (0..x) (\i. higher_complex_derivative (i + k) + f z / Cx(&(FACT (i + k))) * (w' - z) pow i) + - vsum (0..x) (\n. higher_complex_derivative (n + k) f z + / Cx(&(FACT (n + k))) * (w' - z) pow n)) = (\x. Cx(&0))` + (fun th-> SIMP_TAC[th;COMPLEX_VEC_0;LIM_CONST]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_SUB_0]; + SUBGOAL_THEN `(\n. vsum (k..k + n) + (\n. higher_complex_derivative n f z / Cx(&(FACT n)) *(w' - z) pow (n - k))) + = (\n. vsum (k..n+k)(\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (w' - z) pow (n - k)))` SUBST1_TAC THENL [ + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[ADD_SYM]; + MP_TAC (ISPECL [`(\n. vsum (k..n) + (\n. higher_complex_derivative n f z / Cx(&(FACT n)) * + (w' - z) pow (n - k)))`;`(g:complex->complex) w'`;`k:num`] + SEQ_OFFSET) THEN ONCE_REWRITE_TAC[GSYM SERIES_FROM] THEN ASM_SIMP_TAC[]]]; + ALL_TAC] THEN EXISTS_TAC `min r s` THEN CONJ_TAC THENL + [MP_TAC (CONJ (ASSUME `&0 < r`) (ASSUME `&0 < s`)) THEN REAL_ARITH_TAC; + CONJ_TAC THENL [REWRITE_TAC[real_min] THEN COND_CASES_TAC + THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,s)` + THEN ASM_REWRITE_TAC[ball] THEN SET_TAC[ASSUME `r:real <= s`;REAL_LTE_TRANS]; + ASM_REWRITE_TAC[]];GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(f:complex->complex) w' = + (w' - z) pow k * (g:complex->complex) w'` SUBST1_TAC + THENL [FIRST_ASSUM MATCH_MP_TAC THEN + MP_TAC (ASSUME `w':complex IN ball (z,min r s)`) THEN REWRITE_TAC [real_min] + THEN COND_CASES_TAC THENL [ASM_MESON_TAC[IN_BALL;REAL_LTE_TRANS]; + REWRITE_TAC[]];SIMP_TAC [COMPLEX_ENTIRE;DE_MORGAN_THM] THEN + CONJ_TAC THENL [REWRITE_TAC[COMPLEX_POW_EQ_0;DE_MORGAN_THM] + THEN DISJ1_TAC THEN ASM_REWRITE_TAC [COMPLEX_SUB_0]; + FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC (ASSUME `w':complex IN + ball (z,min r s)`) THEN REWRITE_TAC [real_min] THEN COND_CASES_TAC + THENL [REWRITE_TAC[IN_BALL]; + ASM_MESON_TAC[REAL_NOT_LE;IN_BALL;REAL_LT_TRANS]]]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Analytic continuation. *) +(* ------------------------------------------------------------------------- *) + +let ANALYTIC_CONTINUATION = prove + (`!f a u z. + open a /\ connected a /\ f holomorphic_on a /\ u SUBSET a /\ z IN a /\ + z limit_point_of u /\ (!w. w IN u ==> f w = Cx(&0)) + ==> (!w. w IN a ==> f w = Cx(&0))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[TAUT ` (p ==> q) <=> ~( p /\ (~ q))`;GSYM NOT_EXISTS_THM] + THEN STRIP_TAC THEN SUBGOAL_THEN `(f:complex->complex) z = Cx(&0)` + ASSUME_TAC THENL [STRIP_ASSUME_TAC(MESON [OPEN_CONTAINS_CBALL; + ASSUME `open (a:complex->bool)`; ASSUME `z:complex IN a`] + `?e. &0 < e /\ cball (z:complex,e) SUBSET a`) THEN ABBREV_TAC + `s = cball(z:complex,e) INTER (u:complex->bool)` THEN + ASSERT_TAC `f:complex->complex continuous_on closure s /\ + (!x:complex. x IN s ==> f x = Cx(&0)) /\ + z:complex IN closure s` + THENL [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `a:complex->bool` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN MATCH_MP_TAC + SUBSET_TRANS THEN EXISTS_TAC `cball(z:complex,e)` THEN + ASM_MESON_TAC[CLOSED_CBALL;INTER_SUBSET;CLOSURE_MINIMAL]; + CONJ_TAC THENL [ASM_MESON_TAC[INTER_SUBSET;SUBSET]; + ASM_SIMP_TAC[closure;IN_UNION] THEN DISJ2_TAC THEN SUBGOAL_THEN + `z:complex limit_point_of s` (fun thm-> SET_TAC[thm]) THEN + REWRITE_TAC [LIMPT_APPROACHABLE] THEN GEN_TAC THEN DISCH_TAC THEN + ASSERT_TAC `?x:complex. x IN u /\ ~(x = z) /\ dist (x , z) < min e' e` + THENL [MP_TAC (ISPECL [`z:complex`;`u:complex->bool`] LIMPT_APPROACHABLE) + THEN ASM_SIMP_TAC[REAL_LT_MIN];EXISTS_TAC `x:complex` THEN ASM_REWRITE_TAC[] + THEN CONJ_TAC THENL + [REWRITE_TAC [GSYM (ASSUME `cball (z:complex,e) INTER u = s`);IN_INTER; + ASSUME `x:complex IN u`;IN_CBALL] THEN ASM_MESON_TAC[REAL_LT_IMP_LE; + REAL_LT_MIN;DIST_SYM]; ASM_MESON_TAC [REAL_LT_MIN]]]]]; + ASM_MESON_TAC [CONTINUOUS_CONSTANT_ON_CLOSURE]]; + MP_TAC(SPECL [`f:complex->complex`;`a:complex->bool`;`z:complex`;`w:complex`] + ISOLATED_ZEROS) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `?x:complex. x IN ball(z,r) /\ x IN u /\ ~(x=z) /\ + (f:complex->complex) x = Cx(&0)`(fun thm->ASM_MESON_TAC[thm]) THEN + MP_TAC (ISPECL [`z:complex`;`u:complex->bool`] LIMPT_APPROACHABLE) THEN + ASM_REWRITE_TAC [] THEN DISCH_TAC THEN POP_ASSUM (MP_TAC o SPEC `r:real`) + THEN ASM_REWRITE_TAC [] THEN STRIP_TAC THEN EXISTS_TAC `x':complex` + THEN ASM_MESON_TAC[IN_BALL;DIST_SYM]]);; + +(* ------------------------------------------------------------------------- *) +(* Open mapping theorem. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_MAPPING_THM = prove + (`!a f. + open a /\ connected a /\ f holomorphic_on a /\ + ~(?c:complex. !z:complex. z IN a ==> f z = c) + ==> (!u. open u /\ u SUBSET a ==> open(IMAGE f u))`, + let LEMMA_ZERO = prove + (`!f z r. f continuous_on cball(z,r) /\ f holomorphic_on ball(z,r) /\ + &0 < r /\ (!w. norm(z-w) =r ==> norm(f z) < norm(f w)) + ==> (?w. w IN ball(z,r) /\ f w = Cx(&0))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN ` ((!x:complex. x IN ball(z,r) ==> + ~((f:complex->complex) x = Cx(&0))) ==> F ) ==> ( ?w:complex. w IN ball(z,r) + /\ f w = Cx(&0))` MATCH_MP_TAC THENL [MESON_TAC[]; + STRIP_TAC THEN SUBGOAL_THEN `&0 < norm ((f:complex->complex) z)` ASSUME_TAC + THENL [ASM_SIMP_TAC[COMPLEX_NORM_NZ; CENTRE_IN_BALL; SPEC `z:complex` + (ASSUME`!x:complex. x IN ball(z,r) ==> ~((f:complex->complex) x = Cx(&0))`)]; + ALL_TAC] THEN SUBGOAL_THEN + `(!x:complex. x IN cball(z,r) ==> ~((f:complex->complex) x = Cx(&0)))` + ASSUME_TAC THENL [GEN_TAC THEN REWRITE_TAC [IN_CBALL;dist] + THEN REWRITE_TAC[REAL_ARITH `a <= b <=> a < b \/ a = b`] THEN + REWRITE_TAC [TAUT `((p \/ q) ==> r ) <=> ((p ==> r ) /\ (q ==> r))`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_BALL;dist]; + DISCH_TAC THEN REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC + REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC + `norm ((f:complex->complex) z)` THEN + ASM_SIMP_TAC [SPEC `z':complex` (ASSUME `!w:complex. norm (w - z) = r + ==> norm ((f:complex->complex) z) < norm (f w)`)]]; + ALL_TAC] THEN SUBGOAL_THEN `~(frontier(cball(z:complex,r))={})` ASSUME_TAC + THENL [REWRITE_TAC[FRONTIER_CBALL;sphere;dist] THEN SUBGOAL_THEN `?x:complex. + norm(z-x) = r` (fun th-> SET_TAC [MEMBER_NOT_EMPTY;th]) THEN EXISTS_TAC + `z + Cx r` THEN ASM_SIMP_TAC[COMPLEX_ADD_SUB2;NORM_NEG;COMPLEX_NORM_CX; + REAL_ABS_REFL;REAL_LT_IMP_LE];ALL_TAC] THEN + ABBREV_TAC `g = \z. inv ((f:complex->complex) z)` THEN ASSERT_TAC + `(g:complex->complex) continuous_on cball(z,r) /\ g holomorphic_on ball(z,r)` + THENL [CONJ_TAC THENL [EXPAND_TAC "g" THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN GEN_TAC THEN DISCH_TAC + THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_WITHIN THEN ASM_MESON_TAC + [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN];EXPAND_TAC "g" THEN MATCH_MP_TAC + HOLOMORPHIC_ON_INV THEN ASM_REWRITE_TAC[]];ALL_TAC] THEN + SUBGOAL_THEN `?w:complex. w IN frontier(cball(z,r)) /\ + (!x:complex. x IN frontier(cball(z,r)) ==> + norm ((f:complex->complex) w) <= norm (f x))` + STRIP_ASSUME_TAC THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_INF + THEN ASM_SIMP_TAC[COMPACT_FRONTIER;COMPACT_CBALL;CBALL_EQ_EMPTY; + REAL_ARITH `!r:real. &0 < r ==> ~(r < &0)` ] THEN + SUBGOAL_THEN `lift o (\x. norm ((f:complex->complex) x)) = + (lift o norm) o (\x. f x) ` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE + THEN CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC + `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[SUBSET_TRANS;CLOSED_CBALL;FRONTIER_SUBSET_CLOSED]; + ASM_MESON_TAC [CONTINUOUS_ON_LIFT_NORM; HOLOMORPHIC_ON_SUBSET; + HOLOMORPHIC_ON_IMP_CONTINUOUS_ON;SUBSET_TRANS;CLOSED_CBALL; + FRONTIER_SUBSET_CLOSED]]];ALL_TAC] THEN + SUBGOAL_THEN `?w:complex. norm (z-w) = r /\ + norm ((f:complex->complex) w) <= norm (f z)` + (fun thm -> ASM_MESON_TAC[thm;REAL_NOT_LE]) + THEN EXISTS_TAC `w:complex` THEN CONJ_TAC + THENL [MP_TAC (ASSUME `w:complex IN frontier (cball (z,r))`) THEN + REWRITE_TAC[FRONTIER_CBALL;sphere;dist] THEN SET_TAC[];ALL_TAC] THEN + SUBGOAL_THEN `&0 < norm ((f:complex->complex) w)` ASSUME_TAC THENL + [REWRITE_TAC[NORM_POS_LT;COMPLEX_VEC_0] THEN MATCH_MP_TAC (ASSUME `!x. + x:complex IN cball (z,r) ==> ~(f x = Cx(&0))`) THEN MATCH_MP_TAC + (SET_RULE `!x:complex u s. x IN u /\ u SUBSET s ==> x IN s `) THEN + EXISTS_TAC `frontier(cball(z:complex,r))` THEN + ASM_SIMP_TAC[CLOSED_CBALL;FRONTIER_SUBSET_CLOSED];ALL_TAC] THEN + SUBGOAL_THEN `inv (norm ((f:complex-> complex) w)) = &1/ (norm (f w))` + ASSUME_TAC THENL [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC + REAL_DIV_LMUL THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO;GSYM COMPLEX_NORM_NZ]; + ASSERT_TAC `?x:complex. x IN frontier(cball(z,r)) /\ (!y. y IN + frontier(cball(z,r)) ==> norm ((g:complex->complex) y) <= norm (g x))` + THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN + ASM_SIMP_TAC[COMPACT_FRONTIER; + COMPACT_CBALL;CBALL_EQ_EMPTY; REAL_ARITH `!r:real. &0 < r ==> ~(r < &0)`] + THEN SUBGOAL_THEN `lift o (\x. norm ((g:complex->complex) x)) = + (lift o norm) o (\x. g x) ` SUBST1_TAC + THENL [REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(z:complex,r)` THEN ASM_REWRITE_TAC[ETA_AX] + THEN ASM_SIMP_TAC[SUBSET_TRANS;CLOSED_CBALL; + FRONTIER_SUBSET_CLOSED]; ASM_MESON_TAC [CONTINUOUS_ON_LIFT_NORM; + HOLOMORPHIC_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON;SUBSET_TRANS; + CLOSED_CBALL; FRONTIER_SUBSET_CLOSED]]];ALL_TAC] THEN SUBGOAL_THEN + `&0 < norm ((f:complex->complex) x)` ASSUME_TAC THENL + [REWRITE_TAC[NORM_POS_LT;COMPLEX_VEC_0] THEN MATCH_MP_TAC + (ASSUME `!x. x:complex IN cball (z,r) ==> ~(f x = Cx(&0))`) + THEN MATCH_MP_TAC (SET_RULE `!x:complex u s. x IN u /\ u SUBSET s + ==> x IN s `) THEN EXISTS_TAC `frontier(cball(z:complex,r))` + THEN ASM_SIMP_TAC[CLOSED_CBALL;FRONTIER_SUBSET_CLOSED]; + ABBREV_TAC `B = norm ((g:complex->complex) x)` + THEN SUBGOAL_THEN `norm (higher_complex_derivative 0 g z) <= + (&(FACT 0)) * B / (r pow 0) ` + MP_TAC THENL[MATCH_MP_TAC CAUCHY_INEQUALITY THEN + ASM_REWRITE_TAC[] THEN MP_TAC + (ASSUME `!y:complex. y IN frontier (cball (z,r)) ==> + norm ((g:complex ->complex) y) <= B`) + THEN SIMP_TAC [FRONTIER_CBALL;sphere;dist] THEN SET_TAC[]; + REWRITE_TAC [higher_complex_derivative;FACT;real_pow; + REAL_MUL_LID;REAL_DIV_1] THEN DISCH_TAC THEN SUBGOAL_THEN + `inv (norm ((f:complex->complex) z)) <= + inv (norm (f w)) ==> norm (f w) <= norm (f z)` MATCH_MP_TAC + THENL [SUBGOAL_THEN `inv (norm ((f:complex-> complex) z)) = + &1/ (norm (f z))` SUBST1_TAC + THENL [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < norm ((f:complex->complex) z) ==> + ~(norm (f z) = &0) `]; ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBST1_TAC + (REAL_ARITH `norm ((f:complex->complex) w)= &1 * norm (f w)`) THEN + SUBST1_TAC(REAL_ARITH `norm ((f:complex->complex) z)= + &1 * norm (f z)`) THEN POP_ASSUM + MP_TAC THEN MATCH_MP_TAC (TAUT `(p <=> q ) ==> ( p ==> q)`) + THEN MATCH_MP_TAC RAT_LEMMA4 THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[GSYM COMPLEX_NORM_INV] THEN + SUBGOAL_THEN `inv ((f:complex->complex) z) = g z /\ inv (f w) = g w` + (fun thm -> REWRITE_TAC[thm]) + THENL [ASM_MESON_TAC[];MATCH_MP_TAC (REAL_ARITH + `!x y z:real. x <= y /\ y = z ==> x <= z`) THEN EXISTS_TAC `B:real` THEN + ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL [EXPAND_TAC "B" + THEN REWRITE_TAC[SYM (ASSUME`(\z. inv ((f:complex->complex) z)) = + g`);COMPLEX_NORM_INV] THEN SUBGOAL_THEN `inv (norm ((f:complex->complex) x)) + = &1 / norm (f x)` (fun thm -> REWRITE_TAC[thm]) THENL [MATCH_MP_TAC + REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ASM_REWRITE_TAC[] THEN + MP_TAC (SPEC `x:complex`(ASSUME`!x:complex. x IN frontier (cball (z,r)) + ==> norm ((f:complex->complex) w) <= norm (f x)`)) + THEN REWRITE_TAC [ASSUME`x:complex IN frontier + (cball (z,r))`] THEN SUBST1_TAC + (REAL_ARITH `norm ((f:complex->complex) w)= &1* norm (f w)`) THEN + SUBST1_TAC (REAL_ARITH `norm ((f:complex->complex) x)= &1 * norm (f x)`) + THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_LID] THEN POP_ASSUM + MP_TAC THEN MATCH_MP_TAC (TAUT `(q <=> p ) ==> ( p ==> q)`) THEN MATCH_MP_TAC + (RAT_LEMMA4) THEN ASM_REWRITE_TAC[]];ASM_MESON_TAC[]]]]]]]]) in + REPEAT STRIP_TAC THEN ASSUME_TAC (MESON [HOLOMORPHIC_ON_SUBSET; + ASSUME `(u:complex->bool) SUBSET a`;ASSUME `f holomorphic_on a`] + `f holomorphic_on u`) THEN ASM_CASES_TAC `(u:complex->bool)={}` THENL [ + ASM_MESON_TAC[SUBSET_EMPTY;IMAGE_EQ_EMPTY;OPEN_EMPTY];ALL_TAC] THEN + SUBGOAL_THEN `!f u. ~(u={}) /\ open u /\ connected u /\ + f holomorphic_on u /\ + ~(?c:complex. !z:complex. z IN u ==> f z=c) ==> + open (IMAGE f u)` ASSUME_TAC + THENL [REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL;IN_IMAGE] + THEN GEN_TAC THEN STRIP_TAC THEN + ASSERT_TAC `(\z:complex.(f':complex->complex)z - f' x') holomorphic_on + (u':complex->bool) /\ (\z:complex. f' z - f' x')x' = Cx(&0)` THENL [ + ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST;HOLOMORPHIC_ON_SUB; + BETA_THM;COMPLEX_SUB_REFL];ALL_TAC] THEN + ASSERT_TAC `?s:real. &0 < s /\ ball(x',s) SUBSET u' /\ + (!z:complex. z IN ball(x',s) /\ ~(z = x') ==> + ~((\z:complex.(f':complex->complex)z - f' x') z = Cx(&0)))` THENL [ + MATCH_MP_TAC ISOLATED_ZEROS THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[COMPLEX_SUB_0]; + ASSERT_TAC `?r. &0 < r /\ cball(x':complex,r) SUBSET ball(x',s)` THENL[ + EXISTS_TAC `s:real / &2` THEN ASM_SIMP_TAC [REAL_ARITH `&0 < s + ==> &0 < s/ &2`;SUBSET;IN_CBALL;IN_BALL] THEN MP_TAC (ASSUME `&0 < s`) + THEN REAL_ARITH_TAC;ALL_TAC] THEN + ASSERT_TAC `cball(x',r) SUBSET u' /\ + (!z:complex. z IN cball(x',r) /\ + ~(z=x')==> ~((\z:complex.(f':complex->complex)z - f' x') z = Cx(&0)))` + THENL [CONJ_TAC THENL [ASM_MESON_TAC[SUBSET_TRANS]; + MESON_TAC[ASSUME `!z:complex. z IN ball (x',s) /\ ~(z = x') + ==> ~((\z. (f':complex->complex) z - f' x') z = Cx(&0))`; + ASSUME `cball (x':complex,r) SUBSET ball (x',s)`;SUBSET]];ALL_TAC] + THEN SUBGOAL_THEN `frontier (cball (x':complex,r)) SUBSET u'` ASSUME_TAC + THENL [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x':complex,r)` + THEN ASM_MESON_TAC[CLOSED_CBALL;FRONTIER_SUBSET_CLOSED];ALL_TAC] THEN + ASSERT_TAC `?w. w IN frontier(cball(x':complex,r)) /\ + (!z. z IN frontier(cball(x',r)) ==> + norm ((f':complex->complex)w - f' x') <= norm(f' z - f' x'))` + THENL [MATCH_MP_TAC CONTINUOUS_ATTAINS_INF THEN + ASM_SIMP_TAC[COMPACT_FRONTIER;COMPACT_CBALL;CBALL_EQ_EMPTY; + REAL_ARITH `!r:real. &0 < r ==> ~(r < &0)` ] THEN + CONJ_TAC THENL [REWRITE_TAC[REWRITE_RULE[sphere] FRONTIER_CBALL;dist] THEN + SUBGOAL_THEN `?x:complex. norm(x'-x) = r` (fun th-> SET_TAC + [MEMBER_NOT_EMPTY;th]) THEN EXISTS_TAC `x' + Cx r` THEN + ASM_SIMP_TAC[COMPLEX_ADD_SUB2;NORM_NEG;COMPLEX_NORM_CX; + REAL_ABS_REFL;REAL_LT_IMP_LE]; + SUBGOAL_THEN `lift o (\z. norm ((f':complex->complex) z - f' x')) = + (lift o norm) o (\z. f' z - f' x') ` SUBST1_TAC THENL [ + REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC [CONTINUOUS_ON_LIFT_NORM; HOLOMORPHIC_ON_SUBSET; + HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]]];ALL_TAC] THEN + ABBREV_TAC `e = (norm ((f':complex->complex) w - f' x'))*(&1/ &3)` + THEN SUBGOAL_THEN `&0complex) w - f' x' = + (\w. f' w - f' x')w `) THEN FIRST_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL[MESON_TAC[ASSUME `w:complex IN frontier (cball (x',r))`; + FRONTIER_SUBSET_CLOSED; CLOSED_CBALL;SET_RULE `!x:complex s t. x IN s /\ + s SUBSET t ==> x IN t` ];ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN + REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN MATCH_MP_TAC REAL_LT_IMP_NZ + THEN MATCH_MP_TAC (REAL_ARITH `&0 < r /\ r = norm (w:complex - x') ==> + &0 < norm (w - x')`) THEN ASM_REWRITE_TAC[] THEN + MP_TAC (ASSUME `w:complex IN frontier (cball (x',r))`) THEN + SIMP_TAC[FRONTIER_CBALL; sphere; dist; IN_ELIM_THM; NORM_SUB]]; + ALL_TAC] + THEN EXISTS_TAC `e:real` THEN REWRITE_TAC[ASSUME `&0complex) x = Cx(&0)) ==> + ?x. x'' - f' x = Cx(&0) /\ x IN u'` MATCH_MP_TAC THENL [ + STRIP_TAC THEN EXISTS_TAC `x''':complex` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC (SET_RULE `!x:complex u s. x IN u /\ u SUBSET s ==> x IN s`) + THEN EXISTS_TAC `ball(x':complex,r)` THEN ASM_REWRITE_TAC[] + THEN ASM_MESON_TAC[BALL_SUBSET_CBALL;SUBSET_TRANS]; + MATCH_MP_TAC LEMMA_ZERO THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_MESON_TAC + [HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_SUBSET]; + CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN ASM_MESON_TAC[ + HOLOMORPHIC_ON_CONST;HOLOMORPHIC_ON_SUBSET;BALL_SUBSET_CBALL]; + ASM_REWRITE_TAC[] THEN X_GEN_TAC `w':complex` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e:real` THEN CONJ_TAC THENL + [MESON_TAC [NORM_SUB;dist;IN_BALL; ASSUME`x'':complex IN ball (x,e)`; + ASSUME `x:complex = (f':complex->complex) x'`]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2*e` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 e <= &2 * e`;NORM_SUB] THEN + SUBST1_TAC (COMPLEX_RING `(f':complex->complex) w' - x'' = + f' w' -x + x - x''`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm ((f':complex->complex) w' - x) - norm (x-x'')` THEN + CONJ_TAC THENL [SUBST1_TAC (REAL_ARITH `&2 * e = &3 *e - e`) THEN + MATCH_MP_TAC (REAL_ARITH `!x y z w:real. x<=y /\ z x-w <= y-z`) + THEN CONJ_TAC THENL [EXPAND_TAC "e" THEN + ASM_REWRITE_TAC[REAL_ARITH `&3 * norm ((f':complex->complex) w - f' x') * + &1 / &3 = norm (f' w - f' x')`] THEN FIRST_ASSUM MATCH_MP_TAC THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[FRONTIER_CBALL; sphere; NORM_SUB; IN_ELIM_THM; dist]; + UNDISCH_TAC `x'':complex IN ball (x,e)` THEN + REWRITE_TAC [IN_BALL;dist;ASSUME`x:complex = (f':complex->complex) x'`]]; + MATCH_MP_TAC (REAL_ARITH `!x y z:real. x<=y+z ==> x-z<=y`) THEN + REWRITE_TAC[COMPLEX_NORM_TRIANGLE_SUB]]]]]]];ALL_TAC] THEN + ASM_CASES_TAC `connected (u:complex->bool)` THENL [ + SUBGOAL_THEN `~(?c:complex. !z:complex. z IN u ==> f z=c)` + (fun th-> ASM_MESON_TAC [th]) THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] + THEN STRIP_TAC THEN ABBREV_TAC `w:complex= CHOICE u` THEN + ASSUME_TAC (MESON [CHOICE_DEF;GSYM (ASSUME `CHOICE u = w:complex`); + ASSUME `~(u:complex->bool = {})`] `w:complex IN u`) THEN + ASSERT_TAC `w:complex limit_point_of u` THENL + [MATCH_MP_TAC INTERIOR_LIMIT_POINT THEN ASM_SIMP_TAC [INTERIOR_OPEN]; + SUBGOAL_THEN `(\z. (f:complex->complex) z - c) holomorphic_on a` ASSUME_TAC + THENL [ASM_SIMP_TAC [HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST]; + ASSUME_TAC (MESON [ASSUME `w:complex IN u`;ASSUME `u:complex->bool SUBSET a`; + SET_RULE `w:complex IN u /\ u SUBSET a ==> w IN a`] `w:complex IN a`) THEN + MP_TAC(SPECL [`\z:complex.(f:complex->complex)z - c`; + `a:complex->bool`; `u:complex->bool`; `w:complex`] + ANALYTIC_CONTINUATION) THEN + ASM_REWRITE_TAC [] THEN MP_TAC (ASSUME `~(?c:complex. !z. z IN a ==> + (f:complex->complex) z = c)`) THEN ONCE_REWRITE_TAC [GSYM COMPLEX_SUB_0; + GSYM COMPLEX_SUB_RZERO] THEN ONCE_REWRITE_TAC [COMPLEX_SUB_RZERO] THEN + MESON_TAC[]]];ALL_TAC] THEN SUBST1_TAC (MESON [UNIONS_COMPONENTS] + `u:complex->bool = UNIONS ( components u)`) THEN + REWRITE_TAC [IMAGE_UNIONS] THEN MATCH_MP_TAC OPEN_UNIONS THEN + REWRITE_TAC[IN_IMAGE] THEN GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM SUBST1_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + STRIP_ASSUME_TAC(MESON [IN_COMPONENTS; + ASSUME `(x:complex->bool) IN components u`] + `?w:complex. w IN u /\ x = connected_component u w`) THEN + ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_EMPTY;OPEN_CONNECTED_COMPONENT; + CONNECTED_CONNECTED_COMPONENT] THEN CONJ_TAC THENL + [ASM_MESON_TAC [CONNECTED_COMPONENT_SUBSET; + HOLOMORPHIC_ON_SUBSET]; ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN + STRIP_TAC THEN ABBREV_TAC `y = CHOICE (x:complex->bool)` THEN + SUBGOAL_THEN `y:complex IN x` ASSUME_TAC THENL + [EXPAND_TAC "y" THEN MATCH_MP_TAC CHOICE_DEF THEN + ASM_MESON_TAC [CONNECTED_COMPONENT_EQ_EMPTY]; + ASSUME_TAC (MESON [OPEN_COMPONENTS;ASSUME `open (u:complex->bool)`; + ASSUME` x:complex->bool IN components u`] `open (x:complex->bool)`) THEN + ASSERT_TAC `y:complex limit_point_of x` THENL [ + MATCH_MP_TAC INTERIOR_LIMIT_POINT THEN ASSUME_TAC + (MESON [OPEN_COMPONENTS;ASSUME `open (u:complex->bool)`; + ASSUME` x:complex->bool IN components u`] `open (x:complex->bool)`) THEN + SIMP_TAC [INTERIOR_OPEN;ASSUME `open (x:complex->bool)`; + ASSUME `y:complex IN x`]; SUBGOAL_THEN `(\z. (f:complex->complex) z - c) + holomorphic_on a` ASSUME_TAC THENL [ + ASM_SIMP_TAC [HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST]; + SUBGOAL_THEN `x:complex->bool SUBSET a` ASSUME_TAC THENL [ + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `u:complex->bool` THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; + SUBGOAL_THEN `y:complex IN a` ASSUME_TAC THENL [ + MATCH_MP_TAC (SET_RULE `y:complex IN x /\ x SUBSET a ==> y IN a`) + THEN ASM_REWRITE_TAC[]; MP_TAC(SPECL [`\z:complex.(f:complex->complex)z - c`; + `a:complex->bool`; `x:complex->bool`; `y:complex`] ANALYTIC_CONTINUATION) + THEN ASM_REWRITE_TAC [] THEN MP_TAC (ASSUME `~(?c:complex. !z. z IN a ==> + (f:complex->complex) z = c)`) THEN + ONCE_REWRITE_TAC [GSYM COMPLEX_SUB_0;GSYM COMPLEX_SUB_RZERO] THEN + ONCE_REWRITE_TAC [COMPLEX_SUB_RZERO] THEN MESON_TAC[]]]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Maximum modulus principle. *) +(* ------------------------------------------------------------------------- *) + +let MAXIMUM_MODULUS_PRINCIPLE = prove + (`!f a u w. + open a /\ connected a /\ f holomorphic_on a /\ + open u /\ u SUBSET a /\ w IN u /\ + (!z. z IN u ==> norm(f z) <= norm(f w)) + ==> (?c. !z. z IN a ==> f z = c)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `~(open (IMAGE (f:complex->complex) u))` + (fun th -> ASM_MESON_TAC[th; OPEN_MAPPING_THM]) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL;NOT_FORALL_THM] THEN + EXISTS_TAC `(f:complex->complex) w` THEN + MATCH_MP_TAC (TAUT `!p q. (p /\ ~ q) ==> ~(p ==> q)`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_IMAGE]; ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM;SUBSET] THEN + GEN_TAC THEN ASM_CASES_TAC `~(&0 < e)` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN + DISCH_TAC THEN DISJ2_TAC THEN REWRITE_TAC[NOT_FORALL_THM] THEN + EXISTS_TAC `if &0 < Re((f:complex->complex) w) + then f w + Cx(e / &2) + else f w - Cx(e/ &2) ` THEN + ABBREV_TAC `x = if &0complex) w) + then f w + Cx(e / &2) + else f w - Cx(e / &2)` THEN + MATCH_MP_TAC (TAUT `!p q. (p /\ ~ q) ==> ~(p ==> q)`) THEN CONJ_TAC THENL + [REWRITE_TAC[IN_BALL;dist] THEN + MATCH_MP_TAC (REAL_ARITH `!x y z:real. x = y /\ y < z ==> x < z `) THEN + EXISTS_TAC `e / &2` THEN EXPAND_TAC "x" THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC [NORM_NEG;COMPLEX_ADD_SUB2;REAL_ARITH `&0 < e ==> e / &2 &0 <= e / &2`]; + ASM_SIMP_TAC [COMPLEX_SUB_SUB2; REAL_ARITH `&0 < e ==> e / &2 &0 <= e / &2`]]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM; DE_MORGAN_THM] THEN + GEN_TAC THEN ASM_CASES_TAC `~(x':complex IN u)` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISJ1_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC (NORM_ARITH `!x y:complex. ~(norm x=norm y) ==> ~(x=y)`) THEN + REWRITE_TAC[REAL_NOT_EQ] THEN DISJ2_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm ((f:complex->complex) w)` THEN ASM_SIMP_TAC[] THEN + EXPAND_TAC "x" THEN COND_CASES_TAC THEN + REWRITE_TAC [complex_norm;RE_ADD;IM_ADD; IM_CX;RE_CX;REAL_ADD_RID] THENL + [MATCH_MP_TAC SQRT_MONO_LT THEN + MATCH_MP_TAC (REAL_ARITH `!x:real y z. x < y ==> x + z < y + z`) THEN + REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS] THEN + ASM_SIMP_TAC [REAL_ARITH `!x y. &0 < x /\ &0 < y + ==> abs (x+y) = abs x + abs y`; + REAL_ARITH `!x:real. &0 < x ==> &0 < x / &2`] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC [complex_norm;RE_SUB;IM_SUB; IM_CX;RE_CX;REAL_SUB_RZERO] THEN + MATCH_MP_TAC SQRT_MONO_LT THEN + MATCH_MP_TAC (REAL_ARITH `!x:real y z. x < y ==> x + z < y + z`) THEN + REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS] THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC THEN + ASM_SIMP_TAC [REAL_ARITH `!x y. x <= &0 /\ &0 < y + ==> abs (x - y) = abs x + abs y`; + REAL_ARITH `!x. &0 < x ==> &0 < x/ &2`] THEN + ASM_REAL_ARITH_TAC);; + +let MAXIMUM_MODULUS_FRONTIER = prove + (`!f s B. + bounded s /\ + f holomorphic_on (interior s) /\ + f continuous_on (closure s) /\ + (!z. z IN frontier s ==> norm(f z) <= B) + ==> !z. z IN s ==> norm(f z) <= B`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`norm o (f:complex->complex)`; `closure s:complex->bool`] + CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSURE_EQ_EMPTY] THEN + ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[o_DEF; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN + DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `norm((f:complex->complex) z) <= B` ASSUME_TAC THENL + [ALL_TAC; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET; REAL_LE_TRANS]] THEN + ASM_CASES_TAC `(z:complex) IN frontier s` THEN ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `(z:complex) IN interior s` ASSUME_TAC THENL + [ASM_MESON_TAC[frontier; IN_DIFF]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:complex->complex`; + `connected_component (interior s) (z:complex)`; + `connected_component (interior s) (z:complex)`; + `z:complex`] + MAXIMUM_MODULUS_PRINCIPLE) THEN + ASSUME_TAC(ISPECL [`interior s:complex->bool`; `z:complex`] + CONNECTED_COMPONENT_SUBSET) THEN + ASSUME_TAC(ISPEC `s:complex->bool` INTERIOR_SUBSET) THEN + ASSUME_TAC(ISPEC `s:complex->bool` CLOSURE_SUBSET) THEN + SUBGOAL_THEN `(z:complex) IN connected_component (interior s) z` + ASSUME_TAC THENL [ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]; ALL_TAC] THEN + SIMP_TAC[OPEN_CONNECTED_COMPONENT; OPEN_INTERIOR; SUBSET_REFL] THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS]; + DISCH_THEN(X_CHOOSE_TAC `c:complex`)] THEN + SUBGOAL_THEN + `!w. w IN closure(connected_component (interior s) z) + ==> (f:complex->complex) w IN {c}` + MP_TAC THENL + [MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[IN_SING; CLOSED_SING] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET_TRANS]; + REWRITE_TAC[IN_SING]] THEN + SUBGOAL_THEN + `~(frontier(connected_component (interior s) (z:complex)) = {})` + MP_TAC THENL + [REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; NOT_BOUNDED_UNIV]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `a:complex` THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN + ASM_SIMP_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `a IN s ==> s SUBSET t ==> a IN t`)) THEN + TRANS_TAC SUBSET_TRANS `frontier(interior s:complex->bool)` THEN + SIMP_TAC[FRONTIER_INTERIOR_SUBSET; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]);; + +let MAXIMUM_REAL_FRONTIER = prove + (`!f s B. + bounded s /\ + f holomorphic_on (interior s) /\ + f continuous_on (closure s) /\ + (!z. z IN frontier s ==> Re(f z) <= B) + ==> !z. z IN s ==> Re(f z) <= B`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`cexp o (f:complex->complex)`; `s:complex->bool`; `exp B`] + MAXIMUM_MODULUS_FRONTIER) THEN + ASM_SIMP_TAC[NORM_CEXP; o_THM; HOLOMORPHIC_ON_COMPOSE; HOLOMORPHIC_ON_CEXP; + CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP] THEN + ASM_REWRITE_TAC[REAL_EXP_MONO_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Factoring out a zero according to its order. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_FACTOR_ORDER_OF_ZERO = prove + (`!f s n. + open s /\ z IN s /\ f holomorphic_on s /\ + 0 < n /\ ~(higher_complex_derivative n f z = Cx(&0)) /\ + (!m. 0 < m /\ m < n ==> higher_complex_derivative m f z = Cx(&0)) + ==> ?g r. &0 < r /\ + g holomorphic_on ball(z,r) /\ + (!w. w IN ball(z,r) ==> f(w) - f(z) = (w - z) pow n * g(w)) /\ + (!w. w IN ball(z,r) ==> ~(g w = Cx(&0)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!w. w IN ball(z,r) + ==> ((\m. higher_complex_derivative m f z / Cx(&(FACT m)) * + (w - z) pow m) sums f(w) - f(z)) (from n)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `z:complex`; `w:complex`; `r:real`] + HOLOMORPHIC_POWER_SERIES) THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `1` o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN + REWRITE_TAC[FACT; higher_complex_derivative; COMPLEX_DIV_1] THEN + REWRITE_TAC[complex_pow; COMPLEX_MUL_RID] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; MATCH_MP_TAC EQ_IMP] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_RING + `p = Cx(&0) ==> w - z - p = w - z`) THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC VSUM_EQ_0 THEN + REWRITE_TAC[IN_NUMSEG; COMPLEX_VEC_0] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[COMPLEX_ENTIRE; complex_div] THEN REPEAT DISJ1_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC + `g = \w. infsum (from 0) + (\m. higher_complex_derivative (m + n) f z / + Cx(&(FACT(m + n))) * (w - z) pow m)` THEN + SUBGOAL_THEN + `!w. w IN ball(z,r) + ==> ((\m. higher_complex_derivative (m + n) f z / + Cx(&(FACT(m + n))) * (w - z) pow m) + sums g(w)) (from 0)` + (LABEL_TAC "*") THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[SUMS_INFSUM] THEN + ASM_CASES_TAC `w:complex = z` THENL + [MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `1` THEN + MATCH_MP_TAC SUMMABLE_EQ THEN EXISTS_TAC `\n:num. Cx(&0)` THEN + REWRITE_TAC[SUMMABLE_0; GSYM COMPLEX_VEC_0] THEN + ASM_SIMP_TAC[IN_FROM; COMPLEX_VEC_0; COMPLEX_SUB_REFL; + COMPLEX_POW_ZERO; LE_1; COMPLEX_MUL_RZERO]; + SUBGOAL_THEN + `!x:complex m. x * (w - z) pow m = + (x * (w - z) pow (m + n)) / (w - z) pow n` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [REPEAT GEN_TAC THEN + SIMP_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC; COMPLEX_POW_ADD] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_POW_EQ_0; COMPLEX_SUB_0] THEN + REWRITE_TAC[COMPLEX_MUL_RID]; + MATCH_MP_TAC SUMMABLE_COMPLEX_DIV THEN + MP_TAC(GEN `a:num->complex` + (ISPECL [`n:num`; `a:num->complex`] SUMMABLE_REINDEX)) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[summable; ADD_CLAUSES] THEN ASM_MESON_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `g holomorphic_on ball(z,r)` ASSUME_TAC THENL + [MATCH_MP_TAC POWER_SERIES_HOLOMORPHIC THEN + EXISTS_TAC `\m. higher_complex_derivative (m + n) f z / + Cx(&(FACT (m + n)))` THEN + EXISTS_TAC `from 0` THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!w. w IN ball(z,r) ==> f w - f z = (w - z) pow n * g(w)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `\m. higher_complex_derivative m f z / Cx(&(FACT m)) * + (w - z) pow m` THEN + EXISTS_TAC `from n` THEN ASM_SIMP_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ARITH_RULE `n = 0 + n`] THEN + REWRITE_TAC[GSYM SUMS_REINDEX] THEN REWRITE_TAC[COMPLEX_POW_ADD] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = c * a * b`] THEN + MATCH_MP_TAC SERIES_COMPLEX_LMUL THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `g:complex->complex` THEN + SUBGOAL_THEN `(g:complex->complex) continuous_on ball(z,r)` MP_TAC THENL + [ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; ALL_TAC] THEN + REWRITE_TAC[continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_THEN(MP_TAC o SPEC + `norm((g:complex->complex) z)`) THEN + ANTS_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `1` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[VSUM_SING_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&0)` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] SERIES_UNIQUE)) THEN + REWRITE_TAC[complex_pow; ADD_CLAUSES; COMPLEX_MUL_RID] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC SUMS_0 THEN + SIMP_TAC[IN_FROM; LE_1; COMPLEX_SUB_REFL; COMPLEX_POW_ZERO] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]; + SIMP_TAC[COMPLEX_SUB_0; NORM_POS_LT] THEN DISCH_THEN(K ALL_TAC) THEN + ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_ENTIRE] THEN + REWRITE_TAC[COMPLEX_INV_EQ_0; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + SUBGOAL_THEN `ball(z,min d r) SUBSET ball(z:complex,r)` ASSUME_TAC THENL + [SIMP_TAC[SUBSET_BALL; REAL_ARITH `min d r <= r`]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IN_BALL; REAL_LT_MIN; GSYM COMPLEX_VEC_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN + ASM_MESON_TAC[DIST_SYM; NORM_ARITH `dist(x,y) < norm y ==> ~(x = vec 0)`]);; + +let HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG = prove + (`!f s n z. + open s /\ z IN s /\ f holomorphic_on s /\ + 0 < n /\ ~(higher_complex_derivative n f z = Cx(&0)) /\ + (!m. 0 < m /\ m < n ==> higher_complex_derivative m f z = Cx(&0)) + ==> ?g r. &0 < r /\ + g holomorphic_on ball(z,r) /\ + (!w. w IN ball(z,r) + ==> f(w) - f(z) = ((w - z) * g w) pow n) /\ + (!w. w IN ball(z,r) ==> ~(g w = Cx(&0)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`] + HOLOMORPHIC_FACTOR_ORDER_OF_ZERO) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `r:real` THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\z. complex_derivative g z / g z`; `ball(z:complex,r)`; + `{}:complex->bool`] HOLOMORPHIC_CONVEX_PRIMITIVE) THEN + REWRITE_TAC[CONVEX_BALL; FINITE_RULES; DIFF_EMPTY] THEN ANTS_TAC THENL + [SIMP_TAC[GSYM HOLOMORPHIC_ON_OPEN; OPEN_BALL; + INTERIOR_OPEN; complex_differentiable] THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN + REWRITE_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_BALL; + HOLOMORPHIC_ON_DIV; ETA_AX]; + SIMP_TAC[OPEN_BALL; HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL [`\z:complex. cexp(h z) / g z`; `ball(z:complex,r)`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN + REWRITE_TAC[OPEN_BALL; CONNECTED_BALL] THEN ANTS_TAC THENL + [X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN + `Cx(&0) = ((complex_derivative g w / g w * cexp(h w)) * g w - + cexp(h w) * complex_derivative g w) / g w pow 2` + SUBST1_TAC THENL + [ASM_SIMP_TAC[COMPLEX_FIELD + `~(z = Cx(&0)) ==> (d / z * e) * z = e * d`] THEN + SIMPLE_COMPLEX_ARITH_TAC; + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DIV_AT THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CEXP]; + ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable; + OPEN_BALL; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]]]; + DISCH_THEN(X_CHOOSE_THEN `c:complex` MP_TAC) THEN + ASM_CASES_TAC `c = Cx(&0)` THENL + [ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`] THEN + ASM_MESON_TAC[]; + ASM_SIMP_TAC[COMPLEX_FIELD + `~(y = Cx(&0)) /\ ~(z = Cx(&0)) + ==> (x / y = z <=> y = inv(z) * x)`] THEN + DISCH_TAC THEN EXISTS_TAC + `\z:complex. cexp((clog(inv c) + h z) / Cx(&n))` THEN + REWRITE_TAC[CEXP_NZ; GSYM CEXP_N; COMPLEX_POW_MUL] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG; COMPLEX_INV_EQ_0] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST; CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN + REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL]]]);; + +let HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT = prove + (`!f s z. + open s /\ connected s /\ z IN s /\ + f holomorphic_on s /\ f(z) = Cx(&0) /\ ~(?c. !w. w IN s ==> f w = c) + ==> ?g r n. + 0 < n /\ &0 < r /\ ball(z,r) SUBSET s /\ + g holomorphic_on ball(z,r) /\ + (!w. w IN ball(z,r) ==> f w = (w - z) pow n * g w) /\ + (!w. w IN ball(z,r) ==> ~(g w = Cx(&0)))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `!n. 0 < n ==> higher_complex_derivative n f z = Cx(&0)` THENL + [MP_TAC(ISPECL + [`f:complex->complex`; `s:complex->bool`; `z:complex`] + HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r0:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[NOT_IMP; GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`] + HOLOMORPHIC_FACTOR_ORDER_OF_ZERO) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_RZERO] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g:complex->complex` THEN + DISCH_THEN(X_CHOOSE_THEN `r1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min r0 r1:real` THEN EXISTS_TAC `n:num` THEN + ASM_SIMP_TAC[BALL_MIN_INTER; IN_INTER; REAL_LT_MIN] THEN CONJ_TAC THENL + [ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + ASM SET_TAC[]]]);; + +let HOLOMORPHIC_LOWER_BOUND_DIFFERENCE = prove + (`!f s z. + open s /\ connected s /\ z IN s /\ f holomorphic_on s /\ + ~(!w. w IN s ==> f w = f z) + ==> ?k n r. &0 < k /\ &0 < r /\ ball(z,r) SUBSET s /\ + !w. w IN ball(z,r) + ==> k * norm(w - z) pow n <= norm(f w - f z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `z:complex`] + HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED) THEN + ASM_REWRITE_TAC[NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[NOT_IMP; IMP_IMP] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`] + HOLOMORPHIC_FACTOR_ORDER_OF_ZERO) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:complex->complex`; `r:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `d = min e r / &2` THEN + SUBGOAL_THEN `ball(z,d) SUBSET cball(z,d) /\ + cball(z:complex,d) SUBSET ball(z,r) /\ + cball(z,d) SUBSET ball(z,e)` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`IMAGE (g:complex->complex) (cball(z,d))`; `Cx(&0)`] + DISTANCE_ATTAINS_INF) THEN + REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_SUB; CBALL_EQ_EMPTY] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_CLOSED; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_CBALL] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + SUBSET_TRANS]; + REWRITE_TAC[COMPLEX_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `p:complex` STRIP_ASSUME_TAC)] THEN + MAP_EVERY EXISTS_TAC [`norm((g:complex->complex) p)`; `d:real`] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; ASM_REAL_ARITH_TAC; ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; NORM_POS_LE] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let POLE_AT_INFINITY = prove + (`!f l. f holomorphic_on (:complex) /\ ((inv o f) --> l) at_infinity + ==> ?a n. !z. f(z) = vsum(0..n) (\i. a i * z pow i)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `l = Cx(&0)` THENL + [FIRST_X_ASSUM SUBST1_TAC THEN STRIP_TAC; + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_INV)) THEN + ASM_REWRITE_TAC[o_THM; COMPLEX_INV_INV; ETA_AX] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `inv(l:complex)`] + LIOUVILLE_WEAK) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(\n. inv l):num->complex` THEN EXISTS_TAC `0` THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; complex_pow; COMPLEX_MUL_RID]] THEN + ASM_CASES_TAC + `?r. &0 < r /\ + !z. z IN ball(Cx(&0),r) DELETE Cx(&0) ==> ~(f(inv z) = Cx(&0))` + THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`inv o (f:complex->complex) o inv`; `Cx(&0)`; + `ball(Cx(&0),r)`] HOLOMORPHIC_ON_EXTEND_BOUNDED) THEN + ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL + [REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN + REWRITE_TAC[HOLOMORPHIC_ON_ID] THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [LIM_AT_INFINITY_COMPLEX_0]) THEN + REWRITE_TAC[tendsto] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT_01] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[o_THM; dist; COMPLEX_SUB_RZERO] THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `(g:complex->complex)(Cx(&0)) = Cx(&0)` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `at(Cx(&0))` LIM_UNIQUE) THEN + EXISTS_TAC `g:complex->complex` THEN REWRITE_TAC[TRIVIAL_LIMIT_AT] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM CONTINUOUS_AT] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL; + CENTRE_IN_BALL; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `inv o (f:complex->complex) o inv` THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_ASSOC; o_THM; + GSYM LIM_AT_INFINITY_COMPLEX_0] THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC`\k. higher_complex_derivative k f (Cx(&0)) / Cx(&(FACT k))` THEN + MP_TAC(ISPECL [`g:complex->complex`; `ball(Cx(&0),r)`; `Cx(&0)`] + HOLOMORPHIC_LOWER_BOUND_DIFFERENCE) THEN + ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; CENTRE_IN_BALL] THEN + ANTS_TAC THENL + [SUBGOAL_THEN `~(ball(Cx(&0),r) DELETE Cx(&0) = {})` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[COMPLEX_INV_EQ_0]] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; COMPLEX_IN_BALL_0; IN_DELETE] THEN + EXISTS_TAC `Cx(r / &2)` THEN REWRITE_TAC[COMPLEX_NORM_CX; CX_INJ] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_SUB_RZERO]] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC LIOUVILLE_POLYNOMIAL THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` (X_CHOOSE_THEN `e:real` + STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`&2 / e`; `inv(B:real)`] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `inv(z) IN ball(Cx(&0),e) DELETE Cx(&0)` ASSUME_TAC THENL + [REWRITE_TAC[IN_DELETE; COMPLEX_INV_EQ_0; COMPLEX_IN_BALL_0] THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_LINV THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&2 / e <= z ==> &0 < inv e ==> inv e < z`)) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ]; + UNDISCH_TAC `&2 / e <= norm(z:complex)` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[COMPLEX_NORM_0; REAL_NOT_LE] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]; + ALL_TAC] THEN + SUBGOAL_THEN `inv(z) IN ball(Cx(&0),r) DELETE Cx(&0)` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(f:complex->complex) z = inv(g(inv z))` SUBST1_TAC THENL + [ASM_SIMP_TAC[COMPLEX_INV_INV]; ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) + [GSYM COMPLEX_INV_INV] THEN + ONCE_REWRITE_TAC[COMPLEX_NORM_INV] THEN + REWRITE_TAC[REAL_POW_INV; GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[COMPLEX_NORM_NZ] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [LIM_AT_INFINITY_COMPLEX_0]) THEN + REWRITE_TAC[LIM_AT; o_THM; dist; COMPLEX_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_DELETE; COMPLEX_IN_BALL_0] THEN + DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`] LIOUVILLE_WEAK) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`\n:num. Cx(&0)`; `0`] THEN + ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; COMPLEX_MUL_LZERO]] THEN + REWRITE_TAC[LIM_AT_INFINITY_COMPLEX_0] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN + EXISTS_TAC `r:real` THEN ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[o_THM; COMPLEX_NORM_NZ] THEN + STRIP_TAC THEN + MP_TAC(ISPEC + `IMAGE ((f:complex->complex) o inv) (ball(Cx(&0),r) DELETE Cx(&0))` + CONNECTED_CLOSED) THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL; + DIMINDEX_2; LE_REFL] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN + REWRITE_TAC[CONTINUOUS_ON_ID] THEN SET_TAC[]; + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]]; + ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL + [`{Cx(&0)}`; `(:complex) DIFF ball(Cx(&0),&1)`]) THEN + SIMP_TAC[CLOSED_SING; CLOSED_DIFF; CLOSED_UNIV; OPEN_BALL] THEN + SIMP_TAC[CENTRE_IN_BALL; REAL_LT_01; SET_RULE + `a IN s ==> {a} INTER (UNIV DIFF s) INTER t = {}`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; SET_RULE + `s INTER IMAGE f t = {} <=> !x. x IN t ==> ~(f x IN s)`] THEN + REWRITE_TAC[IN_SING; IN_DIFF; IN_UNIV; IN_UNION] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0; GSYM COMPLEX_NORM_NZ] THEN + X_GEN_TAC `x:complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:complex`) THEN + MATCH_MP_TAC(TAUT `(~q /\ ~r ==> ~p) ==> p ==> q \/ r`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_INV; REAL_NOT_LT] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_INV_1_LE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPLEX_NORM_NZ]; + REWRITE_TAC[COMPLEX_IN_BALL_0; IN_DELETE] THEN ASM SET_TAC[]; + DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN + ASM_REWRITE_TAC[COMPLEX_IN_BALL_0; IN_DELETE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:complex`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; REAL_NOT_LT; COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_INV_1_LE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPLEX_NORM_NZ]]]);; + +(* ------------------------------------------------------------------------- *) +(* Entire proper functions C->C are precisely the non-trivial polynomials. *) +(* ------------------------------------------------------------------------- *) + +let PROPER_MAP_COMPLEX_POLYFUN = prove + (`!s k c n. closed s /\ compact k /\ (?i. i IN 1..n /\ ~(c i = Cx(&0))) + ==> compact {z | z IN s /\ vsum(0..n) (\i. c i * z pow i) IN k}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`c:num->complex`; `n:num`] COMPLEX_POLYFUN_EXTREMAL) THEN + DISCH_THEN DISJ_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `B + &1`) THEN + REWRITE_TAC[EVENTUALLY_AT_INFINITY_POS; real_ge; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:complex` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `vsum(0..n) (\i. c i * z pow i)` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN + GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_LMUL THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_POW THEN + REWRITE_TAC[CONTINUOUS_AT_ID]]);; + +let PROPER_MAP_COMPLEX_POLYFUN_UNIV = prove + (`!k c n. compact k /\ (?i. i IN 1..n /\ ~(c i = Cx(&0))) + ==> compact {z | vsum(0..n) (\i. c i * z pow i) IN k}`, + MP_TAC(SPEC `(:complex)` PROPER_MAP_COMPLEX_POLYFUN) THEN + REWRITE_TAC[IN_UNIV; CLOSED_UNIV]);; + +let PROPER_MAP_COMPLEX_POLYFUN_EQ = prove + (`!f. f holomorphic_on (:complex) + ==> ((!k. compact k ==> compact {z | f z IN k}) <=> + ?c n. 0 < n /\ ~(c n = Cx(&0)) /\ + f = \z. vsum(0..n) (\i. c i * z pow i))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC PROPER_MAP_COMPLEX_POLYFUN_UNIV THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_REFL; LE_1]] THEN + MP_TAC(ISPECL [`f:complex->complex`; `Cx(&0)`] POLE_AT_INFINITY) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[LIM_AT_INFINITY; real_ge] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0; DIST_0; o_THM] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `cball(vec 0:complex,inv e)`) THEN + REWRITE_TAC[COMPACT_CBALL] THEN + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; IN_ELIM_THM; IN_CBALL_0] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B + &1` THEN ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_01] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_SIMP_TAC[REAL_ARITH `B + &1 <= x ==> ~(x <= B)`; REAL_NOT_LE] THEN + ASM_SIMP_TAC[COMPLEX_NORM_INV; REAL_LT_LINV]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->complex` THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + ASM_CASES_TAC `!i. i IN 1..n ==> a i = Cx(&0)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `{a 0:complex}`) THEN + ASM_SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES; COMPACT_SING] THEN + SIMP_TAC[IN_SING; COMPLEX_MUL_LZERO; complex_pow; COMPLEX_MUL_RID] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0; VECTOR_ADD_RID; UNIV_GSPEC] THEN + MESON_TAC[COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + (fst(EQ_IMP_RULE(SPEC_ALL num_MAX))))) THEN + REWRITE_TAC[NOT_IMP; IN_NUMSEG] THEN + ANTS_TAC THENL [MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LE_1; FUN_EQ_THM] THEN + GEN_TAC THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN + ASM_REWRITE_TAC[SUBSET_NUMSEG; FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[COMPLEX_VEC_0; NOT_LE] THEN + STRIP_TAC THEN REWRITE_TAC[COMPLEX_ENTIRE] THEN DISJ1_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Relating invertibility and nonvanishing of derivative. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE = prove + (`!f s z. + f holomorphic_on s /\ open s /\ z IN s /\ + ~(complex_derivative f z = Cx(&0)) + ==> ?t. z IN t /\ + open t /\ + (!x x'. x IN t /\ x' IN t /\ f x' = f x ==> x' = x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LOCALLY_INJECTIVE THEN + EXISTS_TAC `\z h. complex_derivative f z * h` THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[GSYM has_complex_derivative] THEN + REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM] THEN + ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_INJECTIVE_LEFT_INVERSE THEN + ASM_SIMP_TAC[LINEAR_COMPLEX_MUL; COMPLEX_EQ_MUL_LCANCEL]; + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `(complex_derivative f) continuous_on s` MP_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[dist; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d r:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB] THEN MATCH_MP_TAC + (CONJUNCT2(MATCH_MP ONORM (SPEC_ALL LINEAR_COMPLEX_MUL))) THEN + GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]]);; + +let HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE = prove + (`!f s z. + f holomorphic_on s /\ open s /\ z IN s /\ + ~(complex_derivative f z = Cx(&0)) + ==> ?t g. z IN t /\ open t /\ open(IMAGE f t) /\ t SUBSET s /\ + (!w. w IN t ==> g(f w) = w) /\ + (!y. y IN (IMAGE f t) ==> f(g y) = y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN + DISCH_THEN(X_CHOOSE_TAC `g:complex->complex`) THEN + EXISTS_TAC `s INTER t:complex->bool` THEN + EXISTS_TAC `g:complex->complex` THEN + ASM_SIMP_TAC[OPEN_INTER; IN_INTER; INTER_SUBSET; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + HOLOMORPHIC_ON_SUBSET; INTER_SUBSET]);; + +let HOLOMORPHIC_INJECTIVE_IMP_REGULAR = prove + (`!f s. + f holomorphic_on s /\ open s /\ + (!w z. w IN s /\ z IN s /\ f w = f z ==> w = z) + ==> !z. z IN s ==> ~(complex_derivative f z = Cx(&0))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `!n. 0 < n ==> higher_complex_derivative n f z = Cx(&0)` THENL + [MP_TAC(ISPECL + [`f:complex->complex`; `ball(z:complex,r)`; `z:complex`] + HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED) THEN + ASM_SIMP_TAC[OPEN_BALL; CONNECTED_BALL; CENTRE_IN_BALL; NOT_IMP] THEN + CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `z + Cx(r / &2)`) THEN + REWRITE_TAC[IN_BALL; NORM_ARITH `dist(z,z + r) = norm r`] THEN + REWRITE_TAC[COMPLEX_NORM_CX; NOT_IMP] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`z:complex`; `z + Cx(r / &2)`]) THEN + ASM_REWRITE_TAC[COMPLEX_RING `z = z + a <=> a = Cx(&0)`] THEN + REWRITE_TAC[NOT_IMP; CX_INJ] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_BALL; NORM_ARITH `dist(z,z + r) = norm r`] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM])] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[NOT_IMP; GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`; `n:num`; `z:complex`] + HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:complex->complex`; `k:real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `n = 1` THENL + [ASM_MESON_TAC[HIGHER_COMPLEX_DERIVATIVE_1]; ALL_TAC] THEN + MP_TAC(ISPECL[`\w:complex. (w - z) * g(w)`; `ball(z:complex,min r k)`; + `z:complex`] HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE) THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; NOT_IMP; REAL_LT_MIN] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `!w. w IN ball(z,min r k) + ==> ((\w. (w - z) * g w) has_complex_derivative + ((w - z) * complex_derivative g w + (Cx(&1) - Cx(&0)) * g w)) + (at w)` + (LABEL_TAC "*") + THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `w IN ball(z:complex,k)` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_ARITH `min r k <= k`]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_ID; HAS_COMPLEX_DERIVATIVE_SUB; + HAS_COMPLEX_DERIVATIVE_CONST; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_BALL]; + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_MIN] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; + COMPLEX_SUB_RZERO; COMPLEX_MUL_LID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[CENTRE_IN_BALL]]; + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:complex->bool`; `h:complex->complex`] THEN + ABBREV_TAC `u = IMAGE (\w:complex. (w - z) * g w) t` THEN STRIP_TAC THEN + MP_TAC(ISPEC `u:complex->bool` OPEN_CONTAINS_CBALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN + ANTS_TAC THENL + [EXPAND_TAC "u" THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM; SUBSET; IN_CBALL; dist; + COMPLEX_SUB_LZERO; NORM_NEG] THEN + X_GEN_TAC `e:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `Cx(e) * cexp(Cx(&2) * Cx pi * ii * Cx(&0 / &n))` th) THEN + MP_TAC(ISPEC `Cx(e) * cexp(Cx(&2) * Cx pi * ii * Cx(&1 / &n))` th)) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP; RE_MUL_CX; RE_MUL_II] THEN + REWRITE_TAC[IM_CX; REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_MUL_RID] THEN + SIMP_TAC[REAL_ARITH `&0 < e ==> abs e <= e`; ASSUME `&0 < e`] THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `y1:complex` (STRIP_ASSUME_TAC o GSYM)) THEN + DISCH_THEN(X_CHOOSE_THEN `y0:complex` (STRIP_ASSUME_TAC o GSYM)) THEN + UNDISCH_THEN `!w. w IN ball (z,k) ==> f w - f z = ((w - z) * g w) pow n` + (fun th -> MP_TAC(SPEC `y1:complex` th) THEN + MP_TAC(SPEC `y0:complex` th)) THEN + MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ ~(q1 /\ q2) + ==> (p1 ==> q1) ==> (p2 ==> q2) ==> F`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_ARITH `min r k <= k`]; + MATCH_MP_TAC(MESON[] `x' = y' /\ ~(x = y) ==> ~(x = x' /\ y = y')`)] THEN + CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_LEFT_INVERSE]) THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[COMPLEX_POW_MUL] THEN + ASM_SIMP_TAC[COMPLEX_ROOT_UNITY; LE_1]; + REWRITE_TAC[COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN + DISCH_TAC THEN UNDISCH_THEN + `!w z. w IN s /\ z IN s /\ (f:complex->complex) w = f z ==> w = z` + (MP_TAC o SPECL [`y0:complex`; `y1:complex`]) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; SUBSET_BALL; REAL_ARITH `min r k <= r`]; + DISCH_THEN SUBST_ALL_TAC] THEN + MP_TAC(ISPECL [`n:num`; `0`; `1`] COMPLEX_ROOT_UNITY_EQ) THEN + ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(TAUT `a /\ ~b ==> ~(a <=> b)`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (COMPLEX_RING + `z = e * y ==> z = e * x /\ ~(e = Cx(&0)) ==> x = y`)) THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ]; + REWRITE_TAC[num_congruent; int_congruent] THEN + DISCH_THEN(X_CHOOSE_THEN `d:int` + (MP_TAC o AP_TERM `abs:int->int` o SYM)) THEN + REWRITE_TAC[INT_ABS_NUM; INT_SUB_LZERO; INT_ABS_NEG] THEN + ASM_REWRITE_TAC[INT_ABS_MUL_1; INT_OF_NUM_EQ; INT_ABS_NUM]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a nice clean inverse function theorem. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_ON_INVERSE = prove + (`!f s. f holomorphic_on s /\ open s /\ + (!w z. w IN s /\ z IN s /\ f w = f z ==> w = z) + ==> open(IMAGE f s) /\ + ?g. g holomorphic_on (IMAGE f s) /\ + (!z. z IN s + ==> complex_derivative f z * complex_derivative g (f z) = + Cx(&1)) /\ + (!z. z IN s ==> g(f z) = z) /\ + (!y. y IN (IMAGE f s) ==> f(g y) = y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; + DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + STRIP_TAC THEN ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN; FORALL_IN_IMAGE] THEN + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `z:complex` THEN + ASM_CASES_TAC `(z:complex) IN s` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`f:complex->complex`; `g:complex->complex`; + `complex_derivative f z`; `s:complex->bool`; + `z:complex`] HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; IMP_CONJ] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; HOLOMORPHIC_ON_OPEN; + complex_differentiable]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] + HOLOMORPHIC_INJECTIVE_IMP_REGULAR) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(MP_TAC o SPEC `z:complex`)] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(z = Cx(&0)) ==> (z * w = Cx(&1) <=> w = inv z)`] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_DERIVATIVE]);; + +(* ------------------------------------------------------------------------- *) +(* Holomorphism of covering maps and lifts. *) +(* ------------------------------------------------------------------------- *) + +let COVERING_SPACE_LIFT_IS_HOLOMORPHIC = prove + (`!p c s f g u. + covering_space (c,p) s /\ open c /\ p holomorphic_on c /\ + f holomorphic_on u /\ IMAGE f u SUBSET s /\ IMAGE g u SUBSET c /\ + g continuous_on u /\ (!x. x IN u ==> p(g x) = f x) + ==> g holomorphic_on u`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `(f:complex->complex) z` o last o CONJUNCTS o + GEN_REWRITE_RULE I [covering_space]) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_OPEN_EQ]] THEN + DISCH_THEN(X_CHOOSE_THEN `t:complex->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vv:(complex->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE o SPEC `(g:complex->complex) z`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN + DISCH_THEN(X_CHOOSE_THEN `v:complex->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`p:complex->complex`; `v:complex->bool`] + HOLOMORPHIC_ON_INVERSE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `p':complex->complex` STRIP_ASSUME_TAC)] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN THEN + EXISTS_TAC `(p':complex->complex) o (f:complex->complex)` THEN + MP_TAC(ISPECL + [`g:complex->complex`; `u:complex->bool`; `c:complex->bool`; + `v:complex->bool`] CONTINUOUS_OPEN_IN_PREIMAGE_GEN) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_EQ] THEN REWRITE_TAC[open_in] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex` o CONJUNCT2) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[o_THM; IN_ELIM_THM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `IMAGE (p:complex->complex) v` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +let COVERING_SPACE_LIFT_HOLOMORPHIC = prove + (`!p c s f u. + covering_space (c,p) s /\ p holomorphic_on c /\ open c /\ + simply_connected u /\ locally path_connected u /\ + f holomorphic_on u /\ IMAGE f u SUBSET s + ==> ?g. g holomorphic_on u /\ IMAGE g u SUBSET c /\ + !y. y IN u ==> p(g y) = f y`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`p:complex->complex`; `c:complex->bool`; `s:complex->bool`; + `f:complex->complex`; `u:complex->bool`] COVERING_SPACE_LIFT) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_LIFT_IS_HOLOMORPHIC)) THEN + EXISTS_TAC `f:complex->complex` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The Schwarz lemma. *) +(* ------------------------------------------------------------------------- *) + +let SCHWARZ_LEMMA = prove + (`!f. f holomorphic_on ball(Cx(&0),&1) /\ + (!z:complex. norm z < &1 ==> norm (f z) < &1) /\ + f(Cx(&0)) = Cx(&0) + ==> (!z. norm z < &1 ==> norm(f z) <= norm z) /\ + norm(complex_derivative f(Cx(&0))) <= &1 /\ + ((?z. norm z < &1 /\ ~(z= Cx(&0)) /\ norm(f z) = norm z) \/ + norm(complex_derivative f (Cx(&0))) = &1 + ==> ?c. (!z. norm z < &1 ==> f z = c*z) /\ norm c = &1)`, + let LEMMA1 = prove + (`!f a. open a /\ connected a /\ bounded a /\ ~(a = {}) /\ + f holomorphic_on a /\ f continuous_on (closure a) + ==> (?w. w IN (frontier a) /\ + (!z. z IN (closure a) ==> norm (f z) <= norm (f w)))`, + REPEAT STRIP_TAC THEN ASSERT_TAC + `?x. x IN closure a /\ + (!z. z IN closure a ==> + norm((f:complex->complex) z) <= norm(f x))` THENL + [MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN + ASM_SIMP_TAC [COMPACT_CLOSURE;CLOSURE_EQ_EMPTY] THEN + SUBGOAL_THEN `lift o (\x. norm((f:complex->complex) x)) = + (lift o norm) o (\x. f x) ` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF]; MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC [CONTINUOUS_ON_LIFT_NORM;ETA_AX]]; ALL_TAC] THEN + ASM_CASES_TAC `x:complex IN frontier a` THENL + [EXISTS_TAC `x:complex` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `x:complex IN interior a` MP_TAC THENL + [POP_ASSUM MP_TAC THEN REWRITE_TAC[frontier;DIFF] THEN + SET_TAC[ASSUME `x:complex IN closure a`]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERIOR_OPEN] THEN DISCH_TAC THEN + SUBGOAL_THEN `?c. !z. z IN a ==> (f:complex->complex) z = c` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MAXIMUM_MODULUS_PRINCIPLE THEN + EXISTS_TAC `a:complex->bool` THEN + EXISTS_TAC `x:complex` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN GEN_TAC THEN + DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[closure;UNION] THEN + SET_TAC[ASSUME `z:complex IN a`]; ALL_TAC] THEN + SUBGOAL_THEN `CHOICE(frontier(a:complex->bool)) IN frontier a` + ASSUME_TAC THENL + [MATCH_MP_TAC CHOICE_DEF THEN MATCH_MP_TAC FRONTIER_NOT_EMPTY THEN + CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[NOT_BOUNDED_UNIV]]; + ALL_TAC] THEN + EXISTS_TAC `CHOICE(frontier(a:complex->bool))` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `!z. z IN closure a ==> (f:complex->complex) z = c` + ASSUME_TAC THENL + [MP_TAC (ISPECL [`f:complex->complex`; `closure (a:complex->bool)`; + `{c:complex}`] CONTINUOUS_CLOSED_PREIMAGE) THEN + ASM_REWRITE_TAC [CLOSED_CLOSURE; CLOSED_SING] THEN + ABBREV_TAC `s = {x | x IN closure(a:complex->bool) /\ + (f:complex->complex) x IN {c}}` THEN DISCH_TAC THEN + SUBGOAL_THEN `closure a SUBSET (s:complex->bool)` ASSUME_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN EXPAND_TAC "s" THEN + ASSUME_TAC (MESON [CLOSURE_SUBSET;GSYM SUBSET] + `!x:complex. x IN a ==> x IN closure a`) THEN + SET_TAC [ASSUME `!x:complex. x IN a ==> x IN closure a`; + ASSUME `!z:complex. z IN a ==> f z = c:complex`]; + ASM_REWRITE_TAC[]]; + POP_ASSUM MP_TAC THEN EXPAND_TAC "s" THEN SET_TAC[]]; + EQ_TRANS_TAC `norm(c:complex)` THENL + [ASM_SIMP_TAC[]; ONCE_REWRITE_TAC [EQ_SYM_EQ] THEN + MATCH_MP_TAC (NORM_ARITH `!x y:complex. x = y ==> norm x = norm y`) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[frontier;IN_DIFF]]]) + in + let LEMMA2 = prove + (`!(f:complex->complex) r w s. + &0 < r /\ f holomorphic_on ball(Cx(&0),r) /\ + &0 < s /\ ball(w,s) SUBSET ball(Cx(&0),r) /\ + (!z. norm (w-z) < s ==> norm(f z) <= norm(f w)) + ==> (?c. !z. norm z < r ==> f z = c)`, + REPEAT STRIP_TAC THEN + MP_TAC (SPECL[`f:complex->complex`;`ball (Cx(&0),r)`; `ball (w:complex,s)`; + `w:complex`] MAXIMUM_MODULUS_PRINCIPLE) THEN + ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; IN_BALL;DIST_REFL] THEN + ASM_REWRITE_TAC[dist;COMPLEX_SUB_LZERO;NORM_NEG]) + in + let LEMMA3 = prove + (`!r:real f. f holomorphic_on (ball(Cx(&0),r)) /\ f (Cx(&0))=Cx(&0) + ==> (?h. h holomorphic_on (ball(Cx(&0),r)) /\ + ((!z. norm z < r ==> f z=z*(h z)) /\ + (complex_derivative f (Cx(&0)))= h (Cx(&0))))`, + REPEAT STRIP_TAC THEN ABBREV_TAC `h = \z. if z = Cx(&0) then + complex_derivative f (Cx(&0)) else f z/z` THEN EXISTS_TAC + `h:complex->complex` THEN ASSERT_TAC `(!z:complex. norm z < r ==> + (f:complex->complex) z = z * h z) /\ complex_derivative f (Cx(&0)) + = h (Cx(&0))` THENL [CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "h" THEN + COND_CASES_TAC THENL [ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]; + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD]; + EXPAND_TAC "h" THEN ASM_REWRITE_TAC[]];ALL_TAC] THEN ASM_REWRITE_TAC[] + THEN MATCH_MP_TAC POLE_THEOREM_OPEN_0 THEN EXISTS_TAC `(f:complex->complex)` + THEN EXISTS_TAC `Cx(&0)` THEN + ASM_SIMP_TAC[OPEN_BALL;IN_BALL;COMPLEX_SUB_RZERO; + dist;COMPLEX_SUB_LZERO;NORM_NEG]) + in + GEN_TAC THEN STRIP_TAC THEN + MP_TAC (SPECL [`&1`;`f:complex->complex`] LEMMA3) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN SUBGOAL_THEN + `!z. norm z < &1 ==> norm ((h:complex->complex) z) <= &1` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC + (prove + (`!x y:real. (!a. y x x <= y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[REAL_LT_BETWEEN] THEN REWRITE_TAC[NOT_EXISTS_THM; + DE_MORGAN_THM] THEN X_GEN_TAC `z:real` THEN + POP_ASSUM (MP_TAC o SPEC `z:real`) THEN REAL_ARITH_TAC)) THEN + X_GEN_TAC `a:real` THEN + DISCH_TAC THEN SUBGOAL_THEN + `?r. norm (z:complex) < r /\ inv r < a /\ r < &1` MP_TAC THENL + [SUBGOAL_THEN `max (inv a) (norm(z:complex)) < &1` MP_TAC THENL + [ASM_SIMP_TAC[REAL_MAX_LT; REAL_INV_LT_1]; + GEN_REWRITE_TAC LAND_CONV [REAL_LT_BETWEEN] THEN + DISCH_THEN (X_CHOOSE_TAC `r:real`) THEN EXISTS_TAC `r:real` THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[REAL_MAX_LT] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_LINV THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LET_TRANS; NORM_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN `inv (r:real) = &1/r` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + SUBGOAL_THEN `?w. norm w = r /\ (!z. norm z < r + ==> norm((h:complex->complex) z) <= norm(h w))` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(prove (`!f r. &0 < r /\ f holomorphic_on ball(Cx(&0),r) /\ + f continuous_on cball(Cx(&0),r) + ==> (?w. norm w = r /\ (!z. norm z < r ==> norm(f z) <= norm(f w)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL[`f:complex->complex`; `ball(Cx(&0),r)`] LEMMA1) THEN + ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL; BOUNDED_BALL; BALL_EQ_EMPTY; + REAL_ARITH `!r:real. ~(r <= &0) <=> &0 < r`] THEN + ASM_SIMP_TAC[CLOSURE_BALL] THEN STRIP_TAC THEN EXISTS_TAC `w:complex` THEN + CONJ_TAC THENL + [UNDISCH_TAC `w:complex IN frontier(ball(Cx(&0),r))` THEN + ASM_SIMP_TAC[FRONTIER_BALL;sphere;dist;COMPLEX_SUB_LZERO;NORM_NEG] THEN + SET_TAC[]; + POP_ASSUM MP_TAC THEN + REWRITE_TAC[IN_CBALL;dist;COMPLEX_SUB_LZERO;NORM_NEG] THEN + MESON_TAC [REAL_LT_IMP_LE]])) THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET + THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN + ASM_SIMP_TAC [SUBSET_BALL;REAL_LT_IMP_LE]; + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN EXISTS_TAC `ball(Cx(&0),&1)` THEN + ASM_REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN + ASM_MESON_TAC[REAL_LET_TRANS]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm(h(w:complex):complex)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `h w:complex = f w / w` SUBST1_TAC THENL + [ASM_SIMP_TAC[] THEN + MP_TAC (MESON [GSYM COMPLEX_NORM_ZERO;REAL_NOT_EQ; + ASSUME `norm(w:complex) =r`; + ASSUME `&0 < r`] `~(w=Cx(&0))`) THEN + CONV_TAC(COMPLEX_FIELD); + ASM_REWRITE_TAC[COMPLEX_NORM_DIV] THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `&1/(r:real)` THEN ASM_SIMP_TAC [REAL_LT_DIV2_EQ] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv (r:real)` THEN + ASM_REWRITE_TAC[REAL_LE_REFL]]; ALL_TAC] THEN + CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_SIMP_TAC[COMPLEX_MUL_LZERO;REAL_LE_REFL]; + SUBST1_TAC (REAL_ARITH `norm (z:complex) = norm z * &1`) THEN + ASM_SIMP_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[NORM_POS_LE]]; ALL_TAC] THEN CONJ_TAC THENL + [ASM_MESON_TAC [COMPLEX_NORM_ZERO;REAL_LT_01]; ALL_TAC] THEN + REWRITE_TAC[TAUT `((p \/ q) ==> r) <=> ((p ==> r) /\ (q ==> r))`] THEN + CONJ_TAC THENL [STRIP_TAC THEN SUBGOAL_THEN + `norm ((h:complex->complex) z) = &1` ASSUME_TAC THENL + [SUBGOAL_THEN `(h:complex->complex) z = f z/z` SUBST1_TAC THENL + [UNDISCH_THEN `!z:complex. norm z < &1 ==> f z = z * h z` + (MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(z = Cx(&0))` THEN CONV_TAC(COMPLEX_FIELD); + ASM_SIMP_TAC[COMPLEX_NORM_ZERO;REAL_DIV_REFL;COMPLEX_NORM_DIV]]; + SUBGOAL_THEN `?c. (!z. norm z < &1 ==> (h:complex->complex) z = c)` + STRIP_ASSUME_TAC THENL [MATCH_MP_TAC LEMMA2 + THEN EXISTS_TAC `z:complex` THEN EXISTS_TAC `&1 - norm(z:complex)` + THEN ASM_REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_SUB_LT]; CONJ_TAC THENL + [REWRITE_TAC[SUBSET;IN_BALL] THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `dist(Cx(&0), z) + dist(z,x)` THEN + REWRITE_TAC[DIST_TRIANGLE] THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[dist;COMPLEX_SUB_LZERO;NORM_NEG] THEN REAL_ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm(z:complex) + norm(z' - z)` THEN + REWRITE_TAC[NORM_TRIANGLE_SUB] THEN REWRITE_TAC[NORM_SUB] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NORM_SUB] THEN REAL_ARITH_TAC]]; + EXISTS_TAC `c:complex` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[COMPLEX_MUL_SYM]; + POP_ASSUM (MP_TAC o SPEC `z:complex`) THEN ASM_MESON_TAC[]]]]; + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `?c. (!z. norm z < &1 ==> (h:complex->complex) z = c)` + STRIP_ASSUME_TAC THENL[MATCH_MP_TAC LEMMA2 THEN EXISTS_TAC `Cx(&0)` + THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`; + SUBSET_REFL; COMPLEX_SUB_LZERO; NORM_NEG]; + EXISTS_TAC `c:complex` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[COMPLEX_MUL_SYM];POP_ASSUM (MP_TAC o SPEC `Cx(&0)`) THEN + ASM_MESON_TAC[COMPLEX_NORM_0; REAL_LT_01]]]]);; + +(* ------------------------------------------------------------------------- *) +(* The Schwarz reflection principle. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_ON_PASTE_ACROSS_LINE = prove + (`!f s a k. + open s /\ ~(a = vec 0) /\ + f holomorphic_on {z | z IN s /\ k < a dot z} /\ + f holomorphic_on {z | z IN s /\ a dot z < k} /\ + f continuous_on s + ==> f holomorphic_on s`, + let lemma0 = prove + (`!d a b:real^N k. + d dot a <= k /\ k <= d dot b + ==> ?c. c IN segment[a,b] /\ d dot c = k /\ + (!z. z IN segment[a,c] ==> d dot z <= k) /\ + (!z. z IN segment[c,b] ==> k <= d dot z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`segment[a:real^N,b]`; `a:real^N`; `b:real^N`; + `d:real^N`; `k:real`] CONNECTED_IVT_HYPERPLANE) THEN + ASM_REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[SET_RULE + `(!z. z IN s ==> P z) <=> s SUBSET {x | P x}`] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_HALFSPACE_LE; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_GE; + SUBSET; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL]) in + let lemma1 = prove + (`!f s d k a b c. + convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ + d dot a <= k /\ d dot b <= k /\ d dot c <= k /\ + f holomorphic_on {z | z IN s /\ d dot z < k} /\ + f holomorphic_on {z | z IN s /\ k < d dot z} /\ + f continuous_on s + ==> path_integral (linepath (a,b)) f + + path_integral (linepath (b,c)) f + + path_integral (linepath (c,a)) f = Cx(&0)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `a:complex`; `b:complex`; `c:complex`] + CAUCHY_THEOREM_TRIANGLE_INTERIOR) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]; + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `{z:complex | z IN s /\ d dot z < k}` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `interior(s INTER {x:complex | d dot x <= k})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HALFSPACE_LE] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[INTERIOR_INTER; INTERIOR_HALFSPACE_LE; + INTERIOR_OPEN] THEN + SET_TAC[]]]; + REWRITE_TAC[HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL]]) in + let lemma2 = prove + (`!f s d k a b c. + convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ + d dot a <= k /\ d dot b <= k /\ + f holomorphic_on {z | z IN s /\ d dot z < k} /\ + f holomorphic_on {z | z IN s /\ k < d dot z} /\ + f continuous_on s + ==> path_integral (linepath (a,b)) f + + path_integral (linepath (b,c)) f + + path_integral (linepath (c,a)) f = Cx(&0)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(d:complex) dot c <= k` THENL + [MATCH_MP_TAC lemma1 THEN ASM_MESON_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + MP_TAC(ISPECL [`d:complex`; `b:complex`; `c:complex`; `k:real`] + lemma0) THEN + MP_TAC(ISPECL [`d:complex`; `a:complex`; `c:complex`; `k:real`] + lemma0) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_THEN `a':complex` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b':complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(a':complex) IN s /\ b' IN s` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SEGMENT_SYM; SUBSET]; + ALL_TAC] THEN + MP_TAC(SPECL + [`f:complex->complex`; `c:complex`; `a:complex`; `a':complex`] + PATH_INTEGRAL_SPLIT_LINEPATH) THEN + MP_TAC(SPECL + [`f:complex->complex`; `b:complex`; `c:complex`; `b':complex`] + PATH_INTEGRAL_SPLIT_LINEPATH) THEN + ASM_REWRITE_TAC[] THEN REPEAT(ANTS_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; SEGMENT_SYM; + CONTINUOUS_ON_SUBSET]; + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN + MP_TAC(ISPECL [`f:complex->complex`; `linepath(a':complex,b')`] + PATH_INTEGRAL_REVERSEPATH) THEN + REWRITE_TAC[REVERSEPATH_LINEPATH; VALID_PATH_LINEPATH] THEN ANTS_TAC THENL + [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONTINUOUS_ON_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:complex->complex`; `s INTER {x:complex | d dot x <= k}`; + `{}:complex->bool`; + `linepath(a:complex,b) ++ linepath(b,b') ++ + linepath(b',a') ++ linepath(a',a)`] + CAUCHY_THEOREM_CONVEX) THEN + MP_TAC(ISPECL [`f:complex->complex`; `s INTER {x:complex | k <= d dot x}`; + `{}:complex->bool`; + `linepath(b':complex,c) ++ linepath(c,a') ++ + linepath(a',b')`] + CAUCHY_THEOREM_CONVEX) THEN + MATCH_MP_TAC(TAUT + `(q /\ q' ==> r) /\ (p /\ p') ==> (p ==> q) ==> (p' ==> q') ==> r`) THEN + CONJ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN + (fun th -> MP_TAC(MATCH_MP PATH_INTEGRAL_UNIQUE th) THEN + MP_TAC(MATCH_MP HAS_PATH_INTEGRAL_INTEGRABLE th))); + ASM_SIMP_TAC[DIFF_EMPTY; INTERIOR_INTER; INTERIOR_HALFSPACE_LE; + REWRITE_RULE[real_ge] INTERIOR_HALFSPACE_GE] THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HALFSPACE_LE; FINITE_EMPTY; + REWRITE_RULE[real_ge] CONVEX_HALFSPACE_GE]] THEN + SIMP_TAC[PATH_INTEGRABLE_JOIN; VALID_PATH_JOIN_EQ; + PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; + VALID_PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATH_INTEGRAL_JOIN] + THENL [CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; UNION_SUBSET; SUBSET_INTER] THEN + ASM_SIMP_TAC[fst(EQ_IMP_RULE(SPEC_ALL CONVEX_CONTAINS_SEGMENT_EQ)); + CONVEX_HALFSPACE_LE; REWRITE_RULE[real_ge] CONVEX_HALFSPACE_GE; + IN_ELIM_THM; REAL_LT_IMP_LE; REAL_LE_REFL] THEN + ASM_SIMP_TAC[complex_differentiable; GSYM HOLOMORPHIC_ON_OPEN; + OPEN_INTER; INTERIOR_OPEN; OPEN_HALFSPACE_LT; + OPEN_HALFSPACE_GT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`]) THEN + ASM_REWRITE_TAC[real_gt] THEN + ASM_MESON_TAC[INTER_SUBSET; CONTINUOUS_ON_SUBSET]) in + let lemma3 = prove + (`!f s d k a b c. + convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ + d dot a <= k /\ + f holomorphic_on {z | z IN s /\ d dot z < k} /\ + f holomorphic_on {z | z IN s /\ k < d dot z} /\ + f continuous_on s + ==> path_integral (linepath (a,b)) f + + path_integral (linepath (b,c)) f + + path_integral (linepath (c,a)) f = Cx(&0)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(d:complex) dot b <= k` THENL + [MATCH_MP_TAC lemma2 THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `(d:complex) dot c <= k` THENL + [ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = c + a + b`] THEN + MATCH_MP_TAC(GEN_ALL lemma2) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a + b + c:complex = b + c + a`] THEN + MATCH_MP_TAC(GEN_ALL lemma2) THEN + MAP_EVERY EXISTS_TAC + [`s:complex->bool`; `--d:real^2`; `--k:real`] THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN + ASM_REAL_ARITH_TAC) in + let lemma4 = prove + (`!f s d k a b c. + convex s /\ open s /\ a IN s /\ b IN s /\ c IN s /\ ~(d = vec 0) /\ + f holomorphic_on {z | z IN s /\ d dot z < k} /\ + f holomorphic_on {z | z IN s /\ k < d dot z} /\ + f continuous_on s + ==> path_integral (linepath (a,b)) f + + path_integral (linepath (b,c)) f + + path_integral (linepath (c,a)) f = Cx(&0)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(d:complex) dot a <= k` THENL + [MATCH_MP_TAC lemma3 THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC lemma3 THEN + MAP_EVERY EXISTS_TAC + [`s:complex->bool`; `--d:real^2`; `--k:real`] THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN + ASM_REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC ANALYTIC_IMP_HOLOMORPHIC THEN + MATCH_MP_TAC MORERA_LOCAL_TRIANGLE THEN + X_GEN_TAC `p:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `p:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(p:complex,e)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`u:complex`; `v:complex`; `w:complex`] THEN + SIMP_TAC[SUBSET_HULL; CONVEX_BALL; INSERT_SUBSET; EMPTY_SUBSET] THEN + STRIP_TAC THEN MATCH_MP_TAC lemma4 THEN + MAP_EVERY EXISTS_TAC [`ball(p:complex,e)`; `a:complex`; `k:real`] THEN + ASM_REWRITE_TAC[CONVEX_BALL; OPEN_BALL] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `{z:complex | z IN s /\ a dot z < k}`; + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `{z:complex | z IN s /\ k < a dot z}`; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let SCHWARZ_REFLECTION = prove + (`!f s. open s /\ (!z. z IN s ==> cnj z IN s) /\ + f holomorphic_on {z | z IN s /\ &0 < Im z} /\ + f continuous_on {z | z IN s /\ &0 <= Im z} /\ + (!z. z IN s /\ real z ==> real(f z)) + ==> (\z. if &0 <= Im z then f(z) else cnj(f(cnj z))) + holomorphic_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOLOMORPHIC_ON_PASTE_ACROSS_LINE THEN + MAP_EVERY EXISTS_TAC [`basis 2:complex`; `&0`] THEN + ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[GSYM IM_DEF] THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `f holomorphic_on {z | z IN s /\ &0 < Im z}` THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLOMORPHIC_EQ THEN + SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_LE]; + SUBGOAL_THEN + `(cnj o f o cnj) holomorphic_on {z | z IN s /\ Im z < &0}` + MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOLOMORPHIC_EQ THEN + SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; o_THM]] THEN + UNDISCH_TAC `f holomorphic_on {z | z IN s /\ &0 < Im z}` THEN + REWRITE_TAC[holomorphic_on; IN_ELIM_THM] THEN DISCH_TAC THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `cnj z`) THEN + ASM_SIMP_TAC[IM_CNJ; REAL_ARITH `&0 < --x <=> x < &0`] THEN + DISCH_THEN(X_CHOOSE_THEN `w:complex` + (fun th -> EXISTS_TAC `cnj w` THEN MP_TAC th)) THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN; LIM_WITHIN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM FORALL_CNJ] THEN + REWRITE_TAC[IN_ELIM_THM; dist; GSYM CNJ_SUB; o_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_NORM_CNJ] THEN + REWRITE_TAC[CNJ_SUB; CNJ_DIV; CNJ_CNJ] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[IM_CNJ] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `s = {z | z IN s /\ &0 <= Im z} UNION + {z | z IN s /\ Im z <= &0}` + (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) + THENL [SET_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE `{z | z IN s /\ P z} = s INTER {z | P z}`] THEN + SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HALFSPACE_IM_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_IM_GE] THEN + CONJ_TAC THENL + [REPLICATE_TAC 2 + (MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + REWRITE_TAC[CONTINUOUS_ON_CNJ]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_INTER; IM_CNJ] THEN + REAL_ARITH_TAC; + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `real z` ASSUME_TAC THENL + [REWRITE_TAC[real] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_CNJ]) THEN ASM_MESON_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Bloch's theorem. *) +(* ------------------------------------------------------------------------- *) + +let BLOCH_LEMMA = prove + (`!f a r. + &0 < r /\ f holomorphic_on cball(a,r) /\ + (!z. z IN ball(a,r) + ==> norm(complex_derivative f z) <= &2 * norm(complex_derivative f a)) + ==> ball(f(a),(&3 - &2 * sqrt(&2)) * r * norm(complex_derivative f a)) + SUBSET IMAGE f (ball(a,r))`, + SUBGOAL_THEN + `!f r. + &0 < r /\ f holomorphic_on cball(Cx(&0),r) /\ f(Cx(&0)) = Cx(&0) /\ + (!z. z IN ball(Cx(&0),r) + ==> norm(complex_derivative f z) + <= &2 * norm(complex_derivative f (Cx(&0)))) + ==> ball(Cx(&0), + (&3 - &2 * sqrt(&2)) * + r * norm(complex_derivative f (Cx(&0)))) + SUBSET IMAGE f (ball(Cx(&0),r))` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`\z. (f:complex->complex)(a + z) - f(a)`; `r:real`]) THEN + ASM_REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_SUB_REFL] THEN + SUBGOAL_THEN + `!z. z IN ball(Cx(&0),r) + ==> complex_derivative (\w. f (a + w) - f a) z = + complex_derivative f (a + z)` + (fun th -> ASM_SIMP_TAC[CENTRE_IN_BALL; COMPLEX_ADD_RID; th]) + THENL + [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + ONCE_REWRITE_TAC [COMPLEX_RING + `complex_derivative f z = + complex_derivative f z * (Cx(&0) + Cx(&1)) - Cx(&0)`] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_ADD; HAS_COMPLEX_DERIVATIVE_CONST; + HAS_COMPLEX_DERIVATIVE_ID; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN + DISCH_THEN(MP_TAC o SPEC `a + z:complex`) THEN + ASM_SIMP_TAC[IN_CBALL; NORM_ARITH `norm z < r ==> dist(a,a+z) <= r`] THEN + REWRITE_TAC[GSYM complex_differentiable] THEN + DISCH_THEN(MP_TAC o SPEC `ball(a:complex,r)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET)) THEN + ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_WITHIN_OPEN THEN + ASM_REWRITE_TAC[IN_BALL; OPEN_BALL; NORM_ARITH `dist(a,a + z) = norm z`]; + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE_GEN THEN + EXISTS_TAC `cball(a:complex,r)` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_CONST; COMPLEX_IN_CBALL_0] THEN + REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; + X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a,a + z) = norm z`]]; + REWRITE_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_IMAGE] THEN + REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + DISCH_THEN(fun th -> + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MP_TAC(SPEC `z - (f:complex->complex) a` th)) THEN + ASM_REWRITE_TAC[COMPLEX_RING `z - a:complex = w - a <=> z = w`] THEN + DISCH_THEN(X_CHOOSE_TAC `x:complex`) THEN + EXISTS_TAC `a + x:complex` THEN + ASM_REWRITE_TAC[COMPLEX_ADD_SUB]]]] THEN + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &3 - &2 * sqrt(&2)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH `&0 < a - &2 * b <=> b < a / &2`] THEN + MATCH_MP_TAC REAL_LT_LSQRT THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_CASES_TAC `complex_derivative f (Cx(&0)) = Cx(&0)` THEN + ASM_SIMP_TAC[COMPLEX_NORM_0; REAL_MUL_RZERO; BALL_TRIVIAL; EMPTY_SUBSET] THEN + ABBREV_TAC `C = &2 * norm(complex_derivative f (Cx(&0)))` THEN + SUBGOAL_THEN `&0 < C` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_NORM_NZ; REAL_ARITH `&0 < &2 * x <=> &0 < x`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!z. z IN ball(Cx(&0),r) + ==> norm(complex_derivative f z - complex_derivative f (Cx(&0))) + <= norm(z) / (r - norm(z)) * C` + (LABEL_TAC "+") THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!R. norm z < R /\ R < r + ==> norm(complex_derivative f z - complex_derivative f (Cx(&0))) + <= norm(z) / (R - norm(z)) * C` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`complex_derivative f`; + `cball(Cx(&0),R)`; + `circlepath(Cx(&0),R)`] + CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN + REWRITE_TAC[CONVEX_CBALL; VALID_PATH_CIRCLEPATH; INTERIOR_CBALL; + PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH] THEN + SUBGOAL_THEN `&0 < R` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LET_TRANS; NORM_POS_LE]; ALL_TAC] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_CBALL; IN_BALL; IN_DELETE] THEN + SIMP_TAC[WINDING_NUMBER_CIRCLEPATH; COMPLEX_SUB_RZERO; COMPLEX_SUB_LZERO; + dist; NORM_NEG; REAL_LE_REFL; MESON[REAL_LT_REFL] + `norm z < R /\ (!w. norm w = R ==> ~(w = z)) <=> norm z < R`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN ANTS_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + REWRITE_TAC[OPEN_BALL] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `cball(Cx(&0),r)` THEN ASM_REWRITE_TAC[BALL_SUBSET_CBALL]; + ASM_REWRITE_TAC[SUBSET_BALLS; DIST_REFL; REAL_ADD_LID]]; + REWRITE_TAC[COMPLEX_MUL_LID]] THEN + DISCH_THEN(fun th -> + MP_TAC (CONJ (SPEC `z:complex` th) (SPEC `Cx(&0)` th))) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN + DISCH_THEN(MP_TAC o SPEC `C * norm(z) / (R * (R - norm(z:complex)))` o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH)) THEN + ASM_REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; COMPLEX_NORM_II] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID; REAL_ABS_PI] THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < R /\ z < R + ==> (C * z / (R * (R - z))) * &2 * pi * R = + &2 * pi * z / (R - z) * C`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH `&0 < &2`; PI_POS] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_DIV; REAL_LE_MUL; REAL_SUB_LE; + REAL_LT_IMP_LE; NORM_POS_LE; COMPLEX_SUB_RZERO] THEN + X_GEN_TAC `x:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(x = Cx(&0)) /\ ~(x = z)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LT_REFL; COMPLEX_NORM_0]; ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = Cx(&0)) /\ ~(x = z) + ==> d / (x - z) - d / x = d * z / (x * (x - z))`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE; IN_BALL; dist; NORM_NEG; + COMPLEX_SUB_LZERO] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; real_div] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT; COMPLEX_NORM_MUL] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + UNDISCH_TAC `norm(x:complex) = R` THEN CONV_TAC NORM_ARITH; + DISCH_TAC THEN MP_TAC(ISPECL + [`\x. lift(norm(z:complex) / (drop x - norm z) * C)`; + `interval(lift((norm(z:complex) + r) / &2),lift r)`; `lift r`; + `norm(complex_derivative f z - complex_derivative f (Cx(&0)))`; + `1`] CONTINUOUS_ON_CLOSURE_COMPONENT_GE) THEN + REWRITE_TAC[GSYM drop; LIFT_DROP; CLOSURE_INTERVAL] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN + ASM_SIMP_TAC[ENDS_IN_INTERVAL; INTERVAL_EQ_EMPTY_1; LIFT_DROP; REAL_ARITH + `z < r ==> ~(r <= (z + r) / &2) /\ ~(r < (z + r) / &2)`] THEN + REWRITE_TAC[FORALL_LIFT; LIFT_DROP; IN_INTERVAL_1] THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[REAL_ARITH `(z + r) / &2 < R /\ R < r ==> z < R`]] THEN + REWRITE_TAC[LIFT_CMUL; real_div] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF; LIFT_CMUL] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LIFT_DROP; + CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!z. z IN ball(Cx(&0),r) + ==> (norm(z) - norm(z) pow 2 / (r - norm(z))) * + norm(complex_derivative f (Cx(&0))) + <= norm(f z)` + (LABEL_TAC "*") THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN DISCH_TAC THEN + MP_TAC(ISPECL[`\z. f(z) - complex_derivative f (Cx(&0)) * z`; + `\z. complex_derivative f z - complex_derivative f (Cx(&0))`; + `linepath(Cx(&0),z)`; `ball(Cx(&0),r)`] + PATH_INTEGRAL_PRIMITIVE) THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN ANTS_TAC THENL + [REWRITE_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `a - complex_derivative f b = a - complex_derivative f b * Cx(&1)`] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN; + HAS_COMPLEX_DERIVATIVE_ID] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN + DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN + REWRITE_TAC[GSYM complex_differentiable] THEN + DISCH_THEN(MP_TAC o SPEC `ball(Cx(&0),r)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET)) THEN + ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_WITHIN_OPEN; OPEN_BALL] THEN + REWRITE_TAC[BALL_SUBSET_CBALL]; + MATCH_MP_TAC(REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_BALL) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL]]; + ALL_TAC] THEN + SIMP_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; HAS_PATH_INTEGRAL_LINEPATH] THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[linepath; COMPLEX_CMUL; COMPLEX_MUL_RZERO; LIFT_DROP] THEN + REWRITE_TAC[COMPLEX_ADD_LID; FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o + SPEC `\t. lift(norm(z:complex) pow 2 * drop t / (r - norm(z)) * C)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] INTEGRAL_NORM_BOUND_INTEGRAL)) THEN + REWRITE_TAC[linepath; COMPLEX_CMUL; COMPLEX_MUL_RZERO; LIFT_DROP] THEN + REWRITE_TAC[COMPLEX_ADD_LID; FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `a * b / c * d:real = (a / c * d) * b`] THEN + REWRITE_TAC[LIFT_CMUL; LIFT_DROP; DROP_VEC] THEN + MP_TAC(ISPECL + [`\x. inv(&2) * x pow 2`; `\x:real. x`; `&0`; `&1`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[REAL_POS] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + REAL_ARITH_TAC; + REWRITE_TAC[has_real_integral; o_DEF; IMAGE_LIFT_REAL_INTERVAL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_DROP; LIFT_NUM] THEN + DISCH_THEN(MP_TAC o SPEC `norm(z:complex) pow 2 / (r - norm z) * C` o + MATCH_MP HAS_INTEGRAL_CMUL) THEN + REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN + ANTS_TAC THENL + [X_GEN_TAC `t:real` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH + `(z pow 2 / y * c) * t:real = (z / y * t * c) * z`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN + REMOVE_THEN "+" (MP_TAC o SPEC `Cx(t) * z`) THEN + REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + SUBGOAL_THEN `norm(Cx t * z) <= norm z` ASSUME_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_MUL_ASSOC; real_div] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; real_abs] THEN + GEN_REWRITE_TAC LAND_CONV + [REAL_ARITH `(t * z) * w:real = (z * w) * t`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[NORM_POS_LE; REAL_LE_INV_EQ; REAL_SUB_LE] THEN + REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC REAL_LE_INV2] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE LAND_CONV [COMPLEX_NORM_MUL]) THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_SUB_RZERO]] THEN + MATCH_MP_TAC(NORM_ARITH + `abc <= norm d - e ==> norm(f - d) <= e ==> abc <= norm f`) THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; + ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `y <= x ==> a - x <= a - y`) THEN + REWRITE_TAC[DROP_CMUL; GSYM REAL_MUL_ASSOC; LIFT_DROP] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_POW_2] THEN + EXPAND_TAC "C" THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (f:complex->complex) + (ball(Cx(&0),(&1 - sqrt(&2) / &2) * r))` THEN + SUBGOAL_THEN `&0 < &1 - sqrt(&2) / &2 /\ &1 - sqrt(&2) / &2 < &1` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH + `&0 < &1 - s / &2 /\ &1 - s / &2 < &1 <=> &0 < s /\ s < &2`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RSQRT; MATCH_MP_TAC REAL_LT_LSQRT] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC IMAGE_SUBSET THEN MATCH_MP_TAC SUBSET_BALL THEN + REWRITE_TAC[REAL_ARITH `x * r <= r <=> &0 <= r * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC] THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN + MATCH_MP_TAC BALL_SUBSET_OPEN_MAP_IMAGE THEN + ASM_SIMP_TAC[REAL_LT_MUL; BOUNDED_BALL; CLOSURE_BALL; CENTRE_IN_BALL] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(Cx(&0),r)` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + MATCH_MP_TAC SUBSET_CBALL THEN + REWRITE_TAC[REAL_ARITH `x * r <= r <=> &0 <= r * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + OPEN_MAPPING_THM) THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN + ASM_SIMP_TAC[OPEN_BALL; CONNECTED_BALL; INTERIOR_OPEN; SUBSET_REFL] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; BALL_SUBSET_CBALL]; + ALL_TAC; + MATCH_MP_TAC SUBSET_BALL THEN + REWRITE_TAC[REAL_ARITH `x * r <= r <=> &0 <= r * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `y:complex`) THEN + MP_TAC(ISPECL + [`f:complex->complex`; `(\x. y):complex->complex`; + `ball(Cx(&0),r)`; `Cx(&0)`] + COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN) THEN + ASM_REWRITE_TAC[OPEN_BALL; HOLOMORPHIC_ON_CONST; COMPLEX_DERIVATIVE_CONST; + CENTRE_IN_BALL] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; BALL_SUBSET_CBALL]; + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &3 - &2 * s <=> s < &3 / &2`] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[FRONTIER_BALL; sphere; REAL_LT_MUL; dist; IN_ELIM_THM] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG] THEN + DISCH_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_BALL; dist; COMPLEX_SUB_LZERO; COMPLEX_SUB_RZERO] THEN + ASM_REWRITE_TAC[NORM_NEG] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_ARITH `x * r < r <=> &0 < r * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS)] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE; REAL_ARITH `r - (&1 - s) * r = s * r`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_FIELD + `&0 < r + ==> a * r - (b * r) pow 2 * x * inv r = (a - b pow 2 * x) * r`] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MP_TAC(SPEC `&2` SQRT_WORKS) THEN CONV_TAC REAL_FIELD);; + +let BLOCH_UNIT = prove + (`!f a. f holomorphic_on ball(a,&1) /\ + complex_derivative f a = Cx(&1) + ==> ?b r. &1 / &12 < r /\ ball(b,r) SUBSET IMAGE f (ball(a,&1))`, + REPEAT STRIP_TAC THEN ABBREV_TAC `r = &249 / &256` THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `g = \z. complex_derivative f z * Cx(r - norm(z - a))` THEN + MP_TAC(ISPECL [`IMAGE (g:complex->complex) (cball(a,r))`; `Cx(&0)`] + DISTANCE_ATTAINS_SUP) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; CBALL_EQ_EMPTY] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN REWRITE_TAC[COMPACT_CBALL] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `ball(a:complex,&1)` THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN EXPAND_TAC "g" THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; ETA_AX; OPEN_BALL]; + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_SUB] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]]; + REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH `dist(a,b) = norm(b - a)`] THEN + REWRITE_TAC[COMPLEX_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `p:complex` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `norm(p - a:complex) < r` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:complex`) THEN + ASM_SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; REAL_LT_IMP_LE] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; COMPLEX_SUB_RZERO; COMPLEX_NORM_CX] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `t = (r - norm(p - a:complex)) / &2` THEN + SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `(f:complex->complex) p` THEN + EXISTS_TAC `(&3 - &2 * sqrt (&2)) * t * norm (complex_derivative f p)` THEN + MP_TAC(ISPECL [`f:complex->complex`; `p:complex`; `t:real`] + BLOCH_LEMMA) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_BALLS; dist; COMPLEX_SUB_RZERO] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_BALL] THEN DISCH_TAC THEN + SUBGOAL_THEN `norm(z - a:complex) < r` ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "g" THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; GSYM REAL_LE_RDIV_EQ; + REAL_ARITH `z < r ==> &0 < abs(r - z)`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_ARITH + `z < r ==> &0 < abs(r - z)`] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC]; + DISCH_TAC THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a:complex`) THEN + ASM_SIMP_TAC[COMPLEX_SUB_REFL; COMPLEX_NORM_0; REAL_LT_IMP_LE] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_SUB_RZERO; real_abs; REAL_SUB_LE; REAL_LT_IMP_LE; + COMPLEX_SUB_REFL; COMPLEX_NORM_0] THEN + EXPAND_TAC "t" THEN + REWRITE_TAC[REAL_ARITH + `a < b * c / &2 * d <=> a < (d * c) * (b / &2)`] THEN + SUBGOAL_THEN `sqrt (&2) < &2113 / &1494` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_LSQRT THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < &3 - &2 * sqrt(&2)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_HALF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_HALF] THEN + EXPAND_TAC "r" THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET_BALLS; dist; COMPLEX_SUB_RZERO] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC]]);; + +let BLOCH = prove + (`!f a r r'. + &0 < r /\ f holomorphic_on ball(a,r) /\ + r' <= r * norm(complex_derivative f a) / &12 + ==> ?b. ball(b,r') SUBSET IMAGE f (ball(a,r))`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `complex_derivative f a = Cx(&0)` THENL + [ASM_SIMP_TAC[COMPLEX_NORM_0; real_div; REAL_MUL_RZERO; REAL_MUL_LZERO; + BALL_EMPTY; EMPTY_SUBSET]; + ALL_TAC] THEN + ABBREV_TAC `C = complex_derivative f a` THEN + SUBGOAL_THEN `&0 < norm(C:complex)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_NORM_NZ]; STRIP_TAC] THEN + MP_TAC(ISPECL + [`\z. (f:complex->complex)(a + Cx r * z) / (C * Cx r)`; `Cx(&0)`] + BLOCH_UNIT) THEN + SUBGOAL_THEN + `!z. z IN ball(Cx(&0),&1) + ==> ((\z. f (a + Cx r * z) / (C * Cx r)) has_complex_derivative + (complex_derivative f (a + Cx r * z) / C)) (at z)` + ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `complex_derivative f (a + Cx r * z) / C = + (complex_derivative f (a + Cx r * z) * Cx r) / (C * Cx r)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD + `~(r = Cx(&0)) /\ ~(c = Cx(&0)) ==> (d * r) / (c * r) = d / c`]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CDIV_AT THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN CONJ_TAC THENL + [COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + FIRST_ASSUM(MATCH_MP_TAC o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT)) THEN + REWRITE_TAC[OPEN_BALL; IN_BALL; NORM_ARITH `dist(a,a + b) = norm b`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> (abs r * z < r <=> &0 < r * (&1 - z))`; + REAL_LT_MUL; REAL_SUB_LT]; + ALL_TAC] THEN + ANTS_TAC THENL + [SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN + ASM_SIMP_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_DIV_REFL]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`b:complex`; `t:real`] THEN STRIP_TAC THEN + EXISTS_TAC `(C * Cx r) * b` THEN + FIRST_ASSUM(MP_TAC o ISPEC `\z. (C * Cx r) * z` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC(SET_RULE + `v SUBSET s /\ t SUBSET w + ==> s SUBSET IMAGE f t ==> v SUBSET IMAGE f w`) THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE; IN_BALL; dist] THEN + X_GEN_TAC `x:complex` THEN DISCH_TAC THEN + EXISTS_TAC `x / (C * Cx r)` THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `norm(C * Cx r)` THEN + ASM_SIMP_TAC[COMPLEX_NORM_NZ; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[GSYM COMPLEX_NORM_MUL; COMPLEX_SUB_LDISTRIB] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LTE_TRANS)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LE_TRANS)) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> a * abs r = r * a`] THEN + ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; COMPLEX_NORM_NZ] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN + REWRITE_TAC[OPEN_BALL; IN_BALL; NORM_ARITH `dist(a,a + b) = norm b`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> (abs r * z < r <=> &0 < r * (&1 - z))`; + REAL_LT_MUL; REAL_SUB_LT]]);; + +let BLOCH_COROLLARY = prove + (`!f s a t r. + f holomorphic_on s /\ a IN s /\ + (!z. z IN frontier s ==> t <= dist(a,z)) /\ + r <= t * norm(complex_derivative f a) / &12 + ==> ?b. ball(b,r) SUBSET IMAGE f s`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN MP_TAC o + MATCH_MP (REAL_ARITH `r <= t ==> r <= &0 \/ &0 < t`)) THEN + SIMP_TAC[BALL_EMPTY; EMPTY_SUBSET] THEN + ASM_CASES_TAC `complex_derivative f a = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0] THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_ARITH `&0 < x / &12 <=> &0 < x`; + COMPLEX_NORM_NZ] THEN + DISCH_TAC THEN + SUBGOAL_THEN `ball(a:complex,t) SUBSET s` ASSUME_TAC THENL + [MP_TAC(ISPECL [`ball(a:complex,t)`; `s:complex->bool`] + CONNECTED_INTER_FRONTIER) THEN + REWRITE_TAC[CONNECTED_BALL; SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN + MATCH_MP_TAC(TAUT `~p /\ r ==> (~p /\ ~q ==> ~r) ==> q`) THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `a:complex` THEN + + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL]; + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_BALL] THEN + ASM_MESON_TAC[REAL_NOT_LE]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:complex->complex`; `a:complex`; `t:real`; `r:real`] BLOCH) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Schottky's theorem. *) +(* ------------------------------------------------------------------------- *) + +let SCHOTTKY = prove + (`!f r. f holomorphic_on cball(Cx(&0),&1) /\ norm(f(Cx(&0))) <= r /\ + (!z. z IN cball(Cx(&0),&1) ==> ~(f z = Cx(&0) \/ f z = Cx(&1))) + ==> !t z. &0 < t /\ t < &1 /\ norm(z) <= t + ==> norm(f z) + <= exp(pi * exp(pi * + (&2 + &2 * r + &12 * t / (&1 - t))))`, + let lemma0 = prove + (`!f s a. + f holomorphic_on s /\ + contractible s /\ + a IN s /\ + (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1))) + ==> (?g. g holomorphic_on s /\ + norm(g a) <= &1 + norm(f a) / &3 /\ + (!z. z IN s ==> f z = ccos(Cx pi * g z)))`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC o MATCH_MP + CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED) THEN + EXISTS_TAC `\z:complex. g z / Cx pi` THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; PI_NZ; COMPLEX_NORM_DIV; + HOLOMORPHIC_ON_DIV; HOLOMORPHIC_ON_CONST; REAL_LE_LDIV_EQ; + COMPLEX_NORM_CX; REAL_ABS_PI; PI_POS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x <= pi + a ==> a * &3 <= n * pi ==> x <= (&1 + n / &3) * pi`)) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC) in + let lemma1 = prove + (`!n. 0 < n ==> &0 < &n + sqrt(&n pow 2 - &1)`, + MESON_TAC[REAL_LTE_ADD; REAL_OF_NUM_LT; SQRT_POS_LE; REAL_POW_LE_1; + REAL_SUB_LE; REAL_OF_NUM_LE; LE_1]) in + let lemma2 = prove + (`!x. &0 <= x + ==> ?n. 0 < n /\ + abs(x - log(&n + sqrt(&n pow 2 - &1)) / pi) < &1 / &2`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC + `\n. 0 < n /\ log(&n + sqrt(&n pow 2 - &1)) / pi <= x` num_MAX) THEN + SIMP_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `1` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[ARITH; SQRT_0; REAL_ADD_RID; LOG_1] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN ASM_REAL_ARITH_TAC; + MP_TAC(ISPEC `exp(x * pi)` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SIMP_TAC[REAL_LE_LDIV_EQ; PI_POS] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[lemma1; EXP_LOG] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN MATCH_MP_TAC(REAL_ARITH + `e <= n /\ &0 <= x ==> m + x <= e ==> m <= n`) THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_POW_LE_1; REAL_SUB_LE; + REAL_OF_NUM_LE; LE_1]; + DISCH_THEN(X_CHOOSE_THEN `n:num` + (CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) + (MP_TAC o SPEC `n + 1`))) THEN + REWRITE_TAC[ARITH_RULE `~(n + 1 <= n) /\ 0 < n + 1`] THEN + REWRITE_TAC[REAL_NOT_LE; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `x < b /\ a <= x ==> b - a < &1 + ==> abs(x - a) < &1 / &2 \/ abs(x - b) < &1 / &2`)) THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `0 < n + 1`]] THEN + REWRITE_TAC[REAL_ARITH `x / pi - y / pi = (x - y) / pi`] THEN + SIMP_TAC[PI_POS; REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&3` THEN + CONJ_TAC THENL [ALL_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[lemma1; GSYM LOG_DIV; ARITH_RULE `0 < n + 1`] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `0 < n ==> n = 1 \/ 2 <= n`)) + THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SQRT_0; REAL_ADD_RID; REAL_DIV_1] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + SIMP_TAC[EXP_LOG; REAL_LTE_ADD; SQRT_POS_LE; REAL_POS; REAL_OF_NUM_LT; + ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 + &3` THEN + SIMP_TAC[REAL_EXP_LE_X; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH `&2 + s <= a <=> s <= a - &2`] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `log(&2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC LOG_MONO_LE_IMP THEN + ASM_SIMP_TAC[lemma1; ARITH_RULE `0 < n + 1`; REAL_LT_DIV; + REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN MATCH_MP_TAC(REAL_ARITH + `&1 <= n /\ s <= &2 * t ==> (n + &1) + s <= &2 * (n + t)`) THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_1] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_POW_LE_1; REAL_ARITH `&1 <= &n + &1`; + REAL_ARITH `&0 <= &2 * x <=> &0 <= x`; REAL_POW_MUL; SQRT_POW_2; + REAL_LE_MUL; REAL_POS; SQRT_POS_LE; REAL_OF_NUM_LE; LE_1] THEN + MATCH_MP_TAC(REAL_ARITH + `&2 <= n /\ &2 * n <= n * n + ==> (n + &1) pow 2 - &1 <= &2 pow 2 * (n pow 2 - &1)`) THEN + ASM_SIMP_TAC[REAL_LE_RMUL; REAL_OF_NUM_LE; LE_0]; + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 + &3` THEN + SIMP_TAC[REAL_EXP_LE_X; REAL_POS] THEN REAL_ARITH_TAC]]]) in + let lemma3 = prove + (`!z. + z IN + ({complex(m,log(&n + sqrt(&n pow 2 - &1)) / pi) | integer m /\ 0 < n} + UNION + {complex(m,--log(&n + sqrt(&n pow 2 - &1)) / pi) | integer m /\ 0 < n}) + ==> ccos(Cx(pi) * ccos(Cx pi * z)) = Cx(&1) \/ + ccos(Cx(pi) * ccos(Cx pi * z)) = --Cx(&1)`, + REWRITE_TAC[COMPLEX_RING + `x = Cx(&1) \/ x = --Cx(&1) <=> Cx(&1) - x pow 2 = Cx(&0)`] THEN + REWRITE_TAC[COMPLEX_POW_EQ_0; ARITH_EQ; CSIN_EQ_0; + REWRITE_RULE[COMPLEX_RING + `s pow 2 + c pow 2 = Cx(&1) <=> + Cx(&1) - c pow 2 = s pow 2`] CSIN_CIRCLE] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[CX_MUL] THEN + REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL; CX_INJ; PI_NZ] THEN + REWRITE_TAC[IN_UNION; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[complex_mul; RE; IM; RE_CX; IM_CX; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; PI_NZ; REAL_ADD_RID; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; CEXP_NEG] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(e = Cx(&0)) + ==> ((e + inv e) / Cx(&2) = n <=> + inv e pow 2 - Cx(&2) * n * inv e + Cx(&1) = Cx(&0))`]; + ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(e = Cx(&0)) + ==> ((e + inv e) / Cx(&2) = n <=> + e pow 2 - Cx(&2) * n * e + Cx(&1) = Cx(&0))`]] THEN + SIMP_TAC[COMPLEX_TRAD; COMPLEX_RING + `ii * (a + ii * b) = --b + ii * a`] THEN + REWRITE_TAC[GSYM COMPLEX_TRAD; GSYM CX_NEG; CEXP_COMPLEX] THEN + SIMP_TAC[REAL_EXP_NEG; EXP_LOG; lemma1] THEN + SIMP_TAC[SIN_INTEGER_PI; REAL_INV_INV] THEN + REWRITE_TAC[COMPLEX_TRAD; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_MUL; GSYM CX_ADD; GSYM CX_ADD; + GSYM CX_SUB; GSYM CX_INV; CX_INJ] THEN + REWRITE_TAC[REAL_INV_MUL; REAL_INV_INV; REAL_POW_MUL] THEN + ONCE_REWRITE_TAC[GSYM COS_ABS] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + MAP_EVERY X_GEN_TAC [`i:real`; `n:num`] THEN REWRITE_TAC[integer] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) ASSUME_TAC) THEN + REWRITE_TAC[GSYM integer] THEN REWRITE_TAC[real_abs; PI_POS_LE] THEN + REWRITE_TAC[COS_NPI; REAL_POW_INV; REAL_POW_POW] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH; REAL_POW_ONE] THEN + (ASM_CASES_TAC `EVEN m` THEN + ASM_REWRITE_TAC[REAL_INV_NEG; REAL_INV_1; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `a - &2 * n * x * --(&1) = a - &2 * --n * x`] THENL + [EXISTS_TAC `&n:real`; EXISTS_TAC `--(&n):real`] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_RING + `(n + s) pow 2 - &2 * n * (n + s) + &1 = &0 <=> + s pow 2 = n pow 2 - &1`] THEN + SIMP_TAC[INTEGER_CLOSED] THEN MATCH_MP_TAC SQRT_POW_2 THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_POW_LE_1; REAL_OF_NUM_LE; LE_1])) in + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\z:complex. Cx(&2) * f z - Cx(&1)`; `cball(Cx(&0),&1)`; `Cx(&0)`] + lemma0) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_MUL; + HOLOMORPHIC_ON_CONST; CENTRE_IN_CBALL; REAL_POS; + COMPLEX_RING `Cx(&2) * z - Cx(&1) = Cx(&1) <=> z = Cx(&1)`; + COMPLEX_RING `Cx(&2) * z - Cx(&1) = --Cx(&1) <=> z = Cx(&0)`; + CONVEX_IMP_CONTRACTIBLE; CONVEX_CBALL] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`h:complex->complex`; `cball(Cx(&0),&1)`; `Cx(&0)`] + lemma0) THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_POS; CONVEX_IMP_CONTRACTIBLE; + CONVEX_CBALL] THEN + ANTS_TAC THENL + [X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RID; COMPLEX_MUL_RNEG; CCOS_NEG; + GSYM CX_COS; COS_PI; CX_NEG] THEN + CONV_TAC COMPLEX_RING; + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)] THEN + MAP_EVERY UNDISCH_TAC + [`!z. z IN cball (Cx(&0),&1) + ==> Cx(&2) * f z - Cx(&1) = ccos(Cx pi * h z)`; + `!z. z IN cball(Cx(&0),&1) ==> h z = ccos(Cx pi * g z)`] THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN + SUBGOAL_THEN + `norm(g(Cx(&0)):complex) <= &2 + norm(f(Cx(&0)):complex)` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LE_TRANS)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `h <= p ==> p / &3 <= &1 + f ==> &1 + h / &3 <= &2 + f`)) THEN + MP_TAC(ISPEC `&1` COMPLEX_NORM_CX) THEN + REWRITE_TAC[GSYM COMPLEX_CMUL] THEN CONV_TAC NORM_ARITH; + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) + [`h holomorphic_on cball(Cx(&0),&1)`; + `norm(g(Cx(&0)):complex) <= &1 + norm(h(Cx(&0)):complex) / &3`; + `norm(h(Cx(&0)):complex) <= + &1 + norm(Cx(&2) * f(Cx(&0)) - Cx(&1)) / &3`]] THEN + MAP_EVERY X_GEN_TAC [`t:real`; `z:complex`] THEN STRIP_TAC THEN + SUBGOAL_THEN `z IN ball(Cx(&0),&1)` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_IN_BALL_0] THEN ASM_REAL_ARITH_TAC; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP + (REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL))] THEN + SUBGOAL_THEN + `norm(g(z) - g(Cx(&0))) <= &12 * t / (&1 - t)` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [holomorphic_on]) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `g':complex->complex`) THEN + MP_TAC(ISPECL [`g:complex->complex`; `g':complex->complex`; + `linepath(Cx(&0),z)`; `cball(Cx(&0),&1)`] + PATH_INTEGRAL_PRIMITIVE) THEN + ASM_REWRITE_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_SIMP_TAC[CONVEX_CONTAINS_SEGMENT_IMP; CONVEX_CBALL] THEN + REWRITE_TAC[CENTRE_IN_CBALL; REAL_POS] THEN + DISCH_THEN(MP_TAC o SPEC `&12 / (&1 - t)` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] HAS_PATH_INTEGRAL_BOUND_LINEPATH)) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_SUB_LT; REAL_LT_IMP_LE] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`Cx(&0)`; `z:complex`; `w:complex`] SEGMENT_BOUND) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_RZERO] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`g:complex->complex`; `cball(Cx(&0),&1)`; `w:complex`; + `&1 - t`; `&1`] BLOCH_COROLLARY) THEN + ASM_REWRITE_TAC[FRONTIER_CBALL; COMPLEX_IN_CBALL_0; + COMPLEX_IN_SPHERE_0] THEN + MATCH_MP_TAC(TAUT + `p /\ q /\ ~s /\ (~r ==> t) ==> (p /\ q /\ r ==> s) ==> t`) THEN + REWRITE_TAC[REAL_NOT_LE] THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MAP_EVERY UNDISCH_TAC + [`norm(w:complex) <= norm(z:complex)`; `norm(z:complex) <= t`] THEN + CONV_TAC NORM_ARITH; + MATCH_MP_TAC(SET_RULE + `!t u. (!b. (?w. w IN t /\ w IN ball(b,&1)) \/ + (?w. w IN u /\ w IN ball(b,&1))) /\ + (!x. x IN d ==> ~(g x IN t UNION u)) + ==> ~(?b. ball(b,&1) SUBSET IMAGE g d)`) THEN + MAP_EVERY EXISTS_TAC + [`{ complex(m,log(&n + sqrt(&n pow 2 - &1)) / pi) | + integer m /\ 0 < n}`; + `{ complex(m,--log(&n + sqrt(&n pow 2 - &1)) / pi) | + integer m /\ 0 < n}`] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN CONJ_TAC THENL + [X_GEN_TAC `b:complex` THEN REWRITE_TAC[OR_EXISTS_THM] THEN + MP_TAC(ISPEC `Re b` INTEGER_ROUND) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IN_BALL] THEN + DISJ_CASES_TAC(REAL_ARITH `&0 <= Im b \/ &0 <= --(Im b)`) THENL + [MP_TAC(SPEC `Im b` lemma2); MP_TAC(SPEC `--(Im b)` lemma2)] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [DISJ1_TAC; DISJ2_TAC] THEN + REWRITE_TAC[dist] THEN + W(MP_TAC o PART_MATCH lhand COMPLEX_NORM_LE_RE_IM o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC(REAL_ARITH + `x <= &1 / &2 /\ y < &1 / &2 ==> x + y < &1`) THEN + ASM_REWRITE_TAC[RE_SUB; IM_SUB; RE; IM] THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `v:complex` THEN DISCH_TAC THEN + DISCH_THEN(DISJ_CASES_TAC o MATCH_MP lemma3) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:complex`)) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING]; + REWRITE_TAC[REAL_ARITH `a * c / &12 < &1 <=> c * a < &12`] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN MATCH_MP_TAC + (NORM_ARITH `x = y ==> norm(x) < d ==> norm(y) <= d`) THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN + MAP_EVERY EXISTS_TAC [`g:complex->complex`; `w:complex`] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN + CONJ_TAC THENL [MESON_TAC[complex_differentiable]; ALL_TAC] THEN + MATCH_MP_TAC(MESON[] + `!s. (g has_complex_derivative g') (at x within s) /\ + ((g has_complex_derivative g') (at x within s) <=> + (g has_complex_derivative g') (at x)) + ==> (g has_complex_derivative g') (at x)`) THEN + EXISTS_TAC `cball(Cx(&0),&1)` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_IN_CBALL_0] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN; + HAS_COMPLEX_DERIVATIVE_AT] THEN + MATCH_MP_TAC LIM_WITHIN_INTERIOR THEN + REWRITE_TAC[INTERIOR_CBALL; COMPLEX_IN_BALL_0] THEN + ASM_REAL_ARITH_TAC]]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + ONCE_REWRITE_TAC[REAL_ARITH `&12 * t / s = &12 / s * t`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_SUB_LT; REAL_LT_IMP_LE] THEN + ASM_REWRITE_TAC[COMPLEX_SUB_RZERO]]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [COMPLEX_RING `y = (Cx(&1) + (Cx(&2) * y - Cx(&1))) / Cx(&2)`] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN + W(MP_TAC o PART_MATCH lhand NORM_CCOS_PLUS1_LE o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_POS; REAL_EXP_MONO_LE; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_PI] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[PI_POS_LE] THEN + W(MP_TAC o PART_MATCH lhand NORM_CCOS_LE o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_EXP_MONO_LE; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_PI] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[PI_POS_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `norm(z - w) <= c ==> norm w <= a + b ==> norm z <= a + b + c`)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LE_TRANS)) THEN + UNDISCH_TAC `norm(f(Cx(&0)):complex) <= r` THEN + CONV_TAC NORM_ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* The Little Picard Theorem. *) +(* ------------------------------------------------------------------------- *) + +let LANDAU_PICARD = prove + (`?R. (!z. &0 < R z) /\ + !f. f holomorphic_on cball(Cx(&0),R(f(Cx(&0)))) /\ + (!z. z IN cball(Cx(&0),R(f(Cx(&0)))) + ==> ~(f(z) = Cx(&0)) /\ ~(f(z) = Cx(&1))) + ==> norm(complex_derivative f (Cx(&0))) < &1`, + ABBREV_TAC + `R = \z:complex. &3 * exp(pi * exp(pi * (&2 + &2 * norm(z) + &12)))` THEN + EXISTS_TAC `R:complex->real` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [EXPAND_TAC "R" THEN + REWRITE_TAC[REAL_EXP_POS_LT; REAL_ARITH `&0 < &3 * x <=> &0 < x`]; + DISCH_TAC] THEN + REPEAT STRIP_TAC THEN + ABBREV_TAC `r = (R:complex->real)(f(Cx(&0)))` THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ABBREV_TAC `g = \z. (f:complex->complex)(Cx r * z)` THEN + SUBGOAL_THEN + `!z. z IN cball(Cx(&0),&1) ==> (Cx r * z) IN cball(Cx(&0),r)` + ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_IN_CBALL_0; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH + `&0 < r ==> (abs r * z <= r <=> r * z <= r * &1)`]; + ALL_TAC] THEN + SUBGOAL_THEN `g holomorphic_on cball(Cx(&0),&1)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`g:complex->complex`; `norm(f(Cx(&0)):complex)`] + SCHOTTKY) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_MUL_RZERO; REAL_LE_REFL] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `&1 / &2`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MP_TAC(ASSUME `(R:complex->real)(f(Cx(&0))) = r`) THEN + EXPAND_TAC "R" THEN + SIMP_TAC[REAL_ARITH `&3 * x = r <=> x = r / &3`] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN(LABEL_TAC "*") THEN + MP_TAC(ISPECL + [`g:complex->complex`; `Cx(&0)`; `&1 / &2`; `r / &3`; `1`] + CAUCHY_INEQUALITY) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_1] THEN + ASM_SIMP_TAC[COMPLEX_SUB_LZERO; NORM_NEG; REAL_EQ_IMP_LE] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN + `complex_derivative g (Cx(&0)) = Cx r * complex_derivative f (Cx(&0))` + SUBST1_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN EXPAND_TAC "g" THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN + CONJ_TAC THENL + [COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `ball(Cx(&0),r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + ASM_MESON_TAC[BALL_SUBSET_CBALL; HOLOMORPHIC_ON_SUBSET]; + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH + `&0 < r ==> (abs r * z <= &1 * r / &3 / (&1 / &2) <=> + r * z <= r * &2 / &3)`] THEN + REAL_ARITH_TAC]);; + +let LITTLE_PICARD = prove + (`!f a b. + f holomorphic_on (:complex) /\ + ~(a = b) /\ IMAGE f (:complex) INTER {a,b} = {} + ==> ?c. f = \x. c`, + let lemma = prove + (`!f. f holomorphic_on (:complex) /\ + (!z. ~(f z = Cx(&0)) /\ ~(f z = Cx(&1))) + ==> ?c. f = \x. c`, + X_CHOOSE_THEN `R:complex->real` MP_TAC LANDAU_PICARD THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `(:complex)`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN + REWRITE_TAC[IN_UNIV; FUN_EQ_THM; CONNECTED_UNIV; OPEN_UNIV] THEN + DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `w:complex` THEN + ASM_CASES_TAC `complex_derivative f w = Cx(&0)` THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_UNIV; IN_UNIV]; + MATCH_MP_TAC(TAUT `F ==> p`)] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `\z. (f:complex->complex)(w + z / complex_derivative f w)`) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]] THEN + REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN COMPLEX_DIFFERENTIABLE_TAC; + SUBGOAL_THEN + `complex_derivative (\z. f (w + z / complex_derivative f w)) (Cx(&0)) = + complex_derivative f w * inv(complex_derivative f w)` + SUBST1_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_NORM_CX; REAL_ABS_NUM; + REAL_LT_REFL]] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN CONJ_TAC THENL + [COMPLEX_DIFF_TAC THEN + REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_MUL_LID; complex_div]; + REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_UNIV; + IN_UNIV]]]) in + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x:complex. Cx(&1) / (b - a) * (f x - b) + Cx(&1)` lemma) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_SUB; + HOLOMORPHIC_ON_CONST] THEN + ASM_SIMP_TAC[FUN_EQ_THM; COMPLEX_FIELD + `~(a = b) + ==> (Cx(&1) / (b - a) * (f - b) + Cx(&1) = c <=> + f = b + (b - a) / Cx(&1) * (c - Cx(&1)))`] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [SET_RULE `IMAGE f UNIV INTER t = {} <=> !x. ~(f x IN t)`]) THEN + MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[CONTRAPOS_THM; IN_INSERT; NOT_IN_EMPTY] THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* A couple of little applications of Little Picard. *) +(* ------------------------------------------------------------------------- *) + +let HOLOMORPHIC_PERIODIC_FIXPOINT = prove + (`!f p. f holomorphic_on (:complex) /\ ~(p = Cx(&0)) /\ (!z. f(z + p) = f(z)) + ==> ?x. f(x) = x`, + REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\z:complex. f(z) - z`; `Cx(&0)`; `p:complex`] LITTLE_PICARD) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; NOT_IMP] THEN + REWRITE_TAC[SET_RULE `IMAGE f UNIV INTER {a,b} = {} <=> + !x. ~(f x = a) /\ ~(f x = b)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_RING `a - b:complex = c <=> a = b + c`; + COMPLEX_ADD_RID] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[NOT_EXISTS_THM; FUN_EQ_THM] THEN GEN_TAC THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `p + p:complex` th) THEN + MP_TAC(SPEC `p:complex` th)) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(p = Cx(&0))` THEN CONV_TAC COMPLEX_RING]);; + +let HOLOMORPHIC_INVOLUTION_POINT = prove + (`!f. f holomorphic_on (:complex) /\ ~(?a. f = \x. a + x) ==> ?x. f(f x) = x`, + REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!z:complex. ~(f z = z)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. (f(f x) - x) / (f x - x)`; `Cx(&0)`; `Cx(&1)`] + LITTLE_PICARD) THEN + REWRITE_TAC[NOT_IMP; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[SET_RULE `IMAGE f UNIV INTER {a,b} = {} <=> + !x. ~(f x = a) /\ ~(f x = b)`] THEN + ASM_SIMP_TAC[FUN_EQ_THM; COMPLEX_FIELD + `~(a:complex = b) ==> (x / (a - b) = c <=> x = c * (a - b))`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_SIMP_TAC[COMPLEX_SUB_0] THEN CONJ_TAC THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_ID] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_UNIV]; + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_LID; COMPLEX_SUB_0] THEN + REWRITE_TAC[COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN + ASM_MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `c:complex` MP_TAC)] THEN + ASM_CASES_TAC `c = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_SUB_0] THEN + ASM_CASES_TAC `c = Cx(&1)` THEN + ASM_REWRITE_TAC[COMPLEX_RING `ffx - x = Cx(&1) * (fx - x) <=> ffx = fx`] THEN + REWRITE_TAC[COMPLEX_RING + `ffx - x = c * (fx - x) <=> (ffx - c * fx) = x * (Cx(&1) - c)`] THEN + DISCH_TAC THEN + MP_TAC(SPECL + [`complex_derivative f o f`; `Cx(&0)`; `c:complex`] LITTLE_PICARD) THEN + REWRITE_TAC[SET_RULE `IMAGE f UNIV INTER {a,b} = {} <=> + !x. ~(f x = a) /\ ~(f x = b)`] THEN + ASM_REWRITE_TAC[o_THM; NOT_IMP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + ASM_MESON_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_UNIV; SUBSET_UNIV; + HOLOMORPHIC_ON_SUBSET]; + MP_TAC(MATCH_MP MONO_FORALL (GEN `z:complex` (SPECL + [`\x:complex. f(f x) - c * f x`; `z:complex`; + `complex_derivative f z * (complex_derivative f (f z) - c)`; + `Cx(&1) * (Cx(&1) - c)`] COMPLEX_DERIVATIVE_UNIQUE_AT))) THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THENL + [REWRITE_TAC[COMPLEX_RING `a * (b - c):complex = b * a - c * a`] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT; + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_LMUL_AT] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; IN_UNIV; OPEN_UNIV]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_RMUL_AT THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_ID]]; + DISCH_THEN(fun th -> X_GEN_TAC `z:complex` THEN REPEAT STRIP_TAC THEN + MP_TAC th) + THENL [DISCH_THEN(MP_TAC o SPEC `(f:complex->complex) z`); + DISCH_THEN(MP_TAC o SPEC `z:complex`)] THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(c = Cx(&1))` THEN CONV_TAC COMPLEX_RING]; + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `k:complex`) THEN + SUBGOAL_THEN `open(IMAGE (f:complex->complex) (:complex))` + ASSUME_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + OPEN_MAPPING_THM) THEN + EXISTS_TAC `(:complex)` THEN + ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; SUBSET_UNIV; IN_UNIV] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\z. complex_derivative f z - k`; `(:complex)`; + `IMAGE (f:complex->complex) (:complex)`; `(f:complex->complex) z`] + ANALYTIC_CONTINUATION) THEN + REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; SUBSET_UNIV; IN_UNIV] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; COMPLEX_SUB_0; NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; OPEN_UNIV; SUBSET_UNIV; + HOLOMORPHIC_ON_SUBSET; HOLOMORPHIC_ON_CONST]; + MATCH_MP_TAC LIMPT_OF_OPEN THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + DISCH_TAC] THEN + MP_TAC(ISPECL + [`\x:complex. f x - k * x`; `(:complex)`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN + REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; IN_UNIV; NOT_IMP] THEN + CONJ_TAC THENL + [X_GEN_TAC `z:complex` THEN + SUBST1_TAC(COMPLEX_RING `Cx(&0) = k - k * Cx(&1)`) THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_SUB THEN CONJ_TAC THENL + [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; + HOLOMORPHIC_ON_OPEN; OPEN_UNIV; IN_UNIV; + complex_differentiable]; + COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING]; + DISCH_THEN(X_CHOOSE_THEN `l:complex` MP_TAC) THEN + REWRITE_TAC[COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN + DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th; FUN_EQ_THM])) THEN + ASM_CASES_TAC `k = Cx(&1)` THENL + [UNDISCH_TAC `!a:complex. ~(!x. k * x + l = a + x)` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LID] THEN MESON_TAC[COMPLEX_ADD_SYM]; + UNDISCH_TAC `!z:complex. ~(k * z + l = z)` THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(k = Cx(&1)) ==> (k * z + l = z <=> z = l / (Cx(&1) - k))`] THEN + MESON_TAC[]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Montel's theorem: a sequence of holomorphic functions uniformly bounded *) +(* on compact subsets of an open set S has a subsequence that converges to a *) +(* holomorphic function, and converges *uniformly* on compact subsets of S. *) +(* ------------------------------------------------------------------------- *) + +let MONTEL = prove + (`!(f:num->complex->complex) p s. + open s /\ (!h. h IN p ==> h holomorphic_on s) /\ + (!k. compact k /\ k SUBSET s + ==> ?b. !h z. h IN p /\ z IN k ==> norm(h z) <= b) /\ + (!n. (f n) IN p) + ==> ?g r. g holomorphic_on s /\ + (!m n:num. m < n ==> r m < r n) /\ + (!x. x IN s ==> ((\n. f (r n) x) --> g(x)) sequentially) /\ + (!k e. compact k /\ k SUBSET s /\ &0 < e + ==> ?N. !n x. n >= N /\ x IN k + ==> norm(f (r n) x - g x) < e)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SPEC_TAC(`f:num->complex->complex`,`f:num->complex->complex`) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM GE; dist] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_UNION_COMPACT_SUBSETS) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num->complex->bool` + (fun th -> FIRST_X_ASSUM(MP_TAC o GEN `i:num `o + SPEC `(k:num->complex->bool) i`) THEN + STRIP_ASSUME_TAC th)) THEN + ASM_REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:num->real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!(f:num->complex->complex) (i:num). + (!n. f n IN p) + ==> ?r g. (!m n:num. m < n ==> r m < r n) /\ + (!e. &0 < e ==> ?N. !n x. n >= N /\ x IN k i + ==> norm((f o r) n x - g x) < e)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + MP_TAC(ISPECL [`f:num->complex->complex`; `(k:num->complex->bool) i`; + `(B:num->real) i`] ARZELA_ASCOLI) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[]; MESON_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`z:complex`; `e:real`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; IN_CBALL]] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?M. &0 < M /\ + !n w. dist(z,w) <= &2 / &3 * r + ==> norm((f:num->complex->complex) n w) <= M` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `cball(z:complex,&2 / &3 * r)`) THEN + ASM_SIMP_TAC[SUBSET; IN_CBALL; COMPACT_CBALL; + NORM_ARITH `dist(a,b) <= &2 / &3 * r ==> dist(a,b) <= r`] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[GE; LE_REFL] THEN DISCH_TAC THEN + EXISTS_TAC `abs(B(N:num)) + &1` THEN + REWRITE_TAC[REAL_ARITH `&0 < abs x + &1`] THEN + ASM_MESON_TAC[SUBSET; REAL_ARITH `x <= b ==> x <= abs b + &1`]; + ALL_TAC] THEN + EXISTS_TAC `min (r / &3) ((e * r) / (&6 * M))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; + REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `y:complex`] THEN STRIP_TAC THEN + MP_TAC + (ISPECL [`(f:num->complex->complex) n`; `cball(z:complex,&2 / &3 * r)`; + `circlepath(z:complex,&2 / &3 * r)`] + CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE) THEN + REWRITE_TAC[CONVEX_CBALL; VALID_PATH_CIRCLEPATH] THEN + REWRITE_TAC[PATHSTART_CIRCLEPATH; PATHFINISH_CIRCLEPATH] THEN + SIMP_TAC[INTERIOR_CBALL; IN_BALL; WINDING_NUMBER_CIRCLEPATH; + NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; + REAL_ARITH `&0 < r ==> &0 <= &2 / &3 * r`] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + SIMP_TAC[SUBSET; IN_CBALL; IN_DELETE; IN_ELIM_THM; REAL_LE_REFL; + NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + ONCE_REWRITE_TAC[TAUT `p ==> ~q <=> q ==> ~p`] THEN + SIMP_TAC[FORALL_UNWIND_THM2; IMP_CONJ; REAL_LT_IMP_NE] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; COMPLEX_MUL_LID] THEN ANTS_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[SUBSET; IN_CBALL] THEN + ASM_SIMP_TAC[NORM_ARITH `dist(a,b) <= &2 / &3 * r ==> dist(a,b) <= r`]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `y:complex` th) THEN MP_TAC(SPEC `z:complex` th)) THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_MUL; REAL_LT_DIV; + REAL_OF_NUM_LT; ARITH; NORM_ARITH + `norm(z - y) < r / &3 ==> norm(y - z) < &2 / &3 * r`] THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH)) THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_II; COMPLEX_NORM_CX; REAL_ABS_PI; + REAL_ABS_NUM; REAL_MUL_LID] THEN + DISCH_THEN(MP_TAC o SPEC `e / r:real`) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < r ==> e / r * &2 * pi * c * r = &2 * pi * e * c`] THEN + SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; PI_POS] THEN + ANTS_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + REAL_LT_MUL] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `~(w:complex = z) /\ ~(w = y)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[NORM_0; VECTOR_SUB_REFL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[NORM_SUB]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(w:complex = z) /\ ~(w = y) + ==> (a / (w - z) - a / (w - y) = + (a * (z - y)) / ((w - z) * (w - y)))`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_FIELD `&0 < r ==> e / r * (&2 / &3 * r) * x = &2 / &3 * e * x`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `M * (e * r) / (&6 * M)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(x,y) = norm(y - x)`; REAL_LE_REFL]; + ASM_SIMP_TAC[REAL_FIELD `&0 < M ==> M * e / (&6 * M) = e / &6`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x <= y * &3 ==> x / &6 <= &2 / &3 * y`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN + MAP_EVERY UNDISCH_TAC + [`norm(w - z:complex) = &2 / &3 * r`; + `norm(z - y:complex) < r / &3`] THEN + CONV_TAC NORM_ARITH]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + DISCH_THEN(fun th -> X_GEN_TAC `f:num->complex->complex` THEN + DISCH_TAC THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o GENL [`i:num`; `r:num->num`] o + SPECL [`(f:num->complex->complex) o (r:num->num)`; `i:num`]) THEN + GEN_REWRITE_TAC + (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV o ONCE_DEPTH_CONV) + [o_THM] THEN ASM_REWRITE_TAC[GSYM o_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + SUBSEQUENCE_DIAGONALIZATION_LEMMA)) THEN + ANTS_TAC THENL + [SIMP_TAC[o_THM; GE] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + EXISTS_TAC `MAX M N` THEN + REWRITE_TAC[ARITH_RULE `MAX m n <= x <=> m <= x /\ n <= x`] THEN + ASM_MESON_TAC[LE_TRANS]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `I:num->num`) THEN + REWRITE_TAC[I_O_ID; RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN + REWRITE_TAC[o_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x. x IN s + ==> ?l. !e. &0 < e + ==> ?N:num. !n. n >= N + ==> norm((f:num->complex->complex) (r n) x - l) + < e` + MP_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{z:complex}`) THEN + ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN + DISCH_THEN(X_CHOOSE_THEN `G:num->complex->complex` MP_TAC) THEN + DISCH_THEN(LABEL_TAC "*" o SPEC `N:num`) THEN + EXISTS_TAC `(G:num->complex->complex) N z` THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `MAX M N` THEN + REWRITE_TAC[ARITH_RULE `a >= MAX m n <=> a >= m /\ a >= n`] THEN + ASM_MESON_TAC[GE_REFL]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`t:complex->bool`; `e:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:complex->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `h:complex->complex` (LABEL_TAC "*") o + SPEC `N:num`) THEN + SUBGOAL_THEN + `!w. w IN t ==> g w = (h:complex->complex) w` + (fun th -> ASM_MESON_TAC[GE_REFL; SUBSET; th]) THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (f:num->complex->complex)(r n) w` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SEQUENTIALLY] THEN + REWRITE_TAC[GSYM GE; dist; o_THM] THEN + ASM_MESON_TAC[SUBSET; GE_REFL]; + DISCH_THEN(LABEL_TAC "*")] THEN + MATCH_MP_TAC HOLOMORPHIC_UNIFORM_SEQUENCE THEN + EXISTS_TAC `(f:num->complex->complex) o (r:num->num)` THEN + ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[COMPACT_CBALL; GE]);; + +(* ------------------------------------------------------------------------- *) +(* Moebius functions are biholomorphisms of the unit disc. *) +(* ------------------------------------------------------------------------- *) + +let moebius_function = new_definition + `!t w z. moebius_function t w z = + cexp(ii * Cx t) * (z - w) / (Cx(&1) - cnj w * z)`;; + +let MOEBIUS_FUNCTION_SIMPLE = prove + (`!w z. moebius_function (&0) w z = (z - w) / (Cx(&1) - cnj w * z)`, + REWRITE_TAC[moebius_function; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_MUL_LID]);; + +let MOEBIUS_FUNCTION_EQ_ZERO = prove + (`!t w. moebius_function t w w = Cx(&0)`, + REWRITE_TAC [moebius_function] THEN CONV_TAC COMPLEX_FIELD);; + +let MOEBIUS_FUNCTION_OF_ZERO = prove + (`!t w. moebius_function t w (Cx(&0)) = -- cexp(ii * Cx t) * w`, + REWRITE_TAC [moebius_function] THEN CONV_TAC COMPLEX_FIELD);; + +let MOEBIUS_FUNCTION_NORM_LT_1 = prove + (`!t w z. norm w < &1 /\ norm z < &1 + ==> norm (moebius_function t w z) < &1`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `!a. &0 <= a /\ &0 < &1 - a pow 2 ==> a < &1` MATCH_MP_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `&0 <= a` THEN + ASM_REWRITE_TAC [REAL_FIELD `&1 - a pow 2 = (&1 - a) * (&1 + a)`; + REAL_MUL_POS_LT] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC [NORM_POS_LE] THEN + SUBGOAL_THEN `~(Cx(&1) - cnj w * z = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC [COMPLEX_SUB_0] THEN + SUBGOAL_THEN `~(norm (Cx(&1)) = norm (cnj w * z))` + (fun th -> MESON_TAC [th]) THEN + REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ] THEN + MATCH_MP_TAC (REAL_ARITH `a * b < &1 ==> ~(&1 = a * b)`) THEN + STRIP_ASSUME_TAC (NORM_ARITH `norm (z:complex) = &0 \/ &0 < norm z`) THENL + [ASM_REWRITE_TAC [REAL_MUL_RZERO; REAL_LT_01]; + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (z:complex)` THEN + ASM_SIMP_TAC[REAL_LT_RMUL; REAL_MUL_LID]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&1 - norm (moebius_function t w z) pow 2 = + ((&1 - norm w pow 2) / (norm (Cx(&1) - cnj w * z) pow 2)) * + (&1 - norm z pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC [moebius_function; + GSYM CX_INJ; CX_SUB; CX_MUL; CX_DIV; CX_POW; CNJ_SUB; CNJ_CX; + CNJ_MUL; CNJ_DIV; CNJ_CNJ; COMPLEX_NORM_POW_2] THEN + SUBGOAL_THEN + `cnj (cexp(ii * Cx t)) * (cexp(ii * Cx t)) = Cx(&1) /\ + ~(Cx(&1) - cnj w * z = Cx(&0)) /\ ~(Cx(&1) - w * cnj z = Cx(&0))` + MP_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD] THEN + REWRITE_TAC [CNJ_CEXP; CNJ_MUL; CNJ_II; CNJ_CX; + COMPLEX_MUL_LNEG; CEXP_NEG_LMUL] THEN ASM_REWRITE_TAC [] THEN + SUBGOAL_THEN `~(cnj (Cx(&1) - cnj w * z) = Cx(&0))` MP_TAC THENL + [ASM_REWRITE_TAC [CNJ_EQ_0]; + REWRITE_TAC [CNJ_SUB; CNJ_CX; CNJ_MUL; CNJ_CNJ]]; + SUBGOAL_THEN `!u:complex. norm u < &1 ==> &0 < &1 - norm u pow 2` + ASSUME_TAC THENL + [REWRITE_TAC [REAL_FIELD `!a. &1 - a pow 2 = (&1 - a) * (&1 + a)`] THEN + ASM_SIMP_TAC [REAL_LT_MUL; REAL_SUB_LT; REAL_LTE_ADD; REAL_LT_01; + NORM_POS_LE]; + SUBGOAL_THEN `&0 < norm (Cx(&1) - cnj w * z) pow 2` + (fun th -> ASM_MESON_TAC [th; REAL_LT_MUL; REAL_LT_DIV]) THEN + ASM_REWRITE_TAC [REAL_RING `!a:real. a pow 2 = a * a`; + REAL_LT_SQUARE; COMPLEX_NORM_ZERO]]]);; + +let MOEBIUS_FUNCTION_HOLOMORPHIC = prove + (`!t w. norm w < &1 ==> moebius_function t w holomorphic_on ball(Cx(&0),&1)`, + let LEMMA_1 = prove + (`!a b:complex. norm a < &1 /\ norm b < &1 ==> ~(Cx(&1) - a * b = Cx(&0))`, + GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [COMPLEX_SUB_0] THEN + SUBGOAL_THEN `~(norm (Cx(&1)) = norm (a * b))` + (fun th -> MESON_TAC[th]) THEN + REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC (REAL_ARITH `!x y. y < x ==> ~(x = y)`) THEN + ASM_CASES_TAC `b = Cx(&0)` THEN + ASM_REWRITE_TAC [COMPLEX_NORM_NUM; REAL_MUL_RZERO; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (b:complex)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC [COMPLEX_NORM_NZ]; + ASM_REWRITE_TAC [REAL_MUL_LID]]) in + REPEAT STRIP_TAC THEN + SUBST1_TAC (GSYM (ISPEC `moebius_function t w` ETA_AX)) THEN + REWRITE_TAC [moebius_function] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC (REWRITE_RULE [o_DEF] HOLOMORPHIC_ON_COMPOSE_GEN) THEN + EXISTS_TAC `(:complex)` THEN REWRITE_TAC [HOLOMORPHIC_ON_CEXP; IN_UNIV] THEN + SIMP_TAC [HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST]; + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; + HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_MUL] THEN + ASM_SIMP_TAC[COMPLEX_IN_BALL_0; LEMMA_1; COMPLEX_NORM_CNJ]]);; + +let MOEBIUS_FUNCTION_COMPOSE = prove + (`!w1 w2 z. + -- w1 = w2 /\ norm w1 < &1 /\ norm z < &1 + ==> moebius_function (&0) w1 (moebius_function (&0) w2 z) = z`, + let LEMMA_1 = prove + (`!a b:complex. norm a < &1 /\ norm b < &1 + ==> ~(Cx(&1) - a * b = Cx(&0))`, + GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [COMPLEX_SUB_0] THEN + SUBGOAL_THEN `~(norm (Cx(&1)) = norm (a * b))` + (fun th -> MESON_TAC[th]) THEN + REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC (REAL_ARITH `!x y. y < x ==> ~(x = y)`) THEN + ASM_CASES_TAC `b = Cx(&0)` THEN + ASM_REWRITE_TAC [COMPLEX_NORM_NUM; REAL_MUL_RZERO; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (b:complex)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC [COMPLEX_NORM_NZ]; + ASM_REWRITE_TAC [REAL_MUL_LID]]) in + let LEMMA_1_ALT = prove + (`!a b:complex. norm a < &1 /\ norm b < &1 + ==> ~(Cx(&1) + a * b = Cx(&0))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBST1_TAC (COMPLEX_RING `a : complex = -- (-- a)`) THEN + ABBREV_TAC `u : complex= -- a` THEN + REWRITE_TAC [COMPLEX_MUL_LNEG; GSYM complex_sub] THEN + MATCH_MP_TAC LEMMA_1 THEN EXPAND_TAC "u" THEN + ASM_REWRITE_TAC[NORM_NEG]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `norm (w2:complex) < &1` ASSUME_TAC THENL + [EXPAND_TAC "w2" THEN ASM_REWRITE_TAC [NORM_NEG]; ALL_TAC] THEN + REWRITE_TAC [moebius_function; COMPLEX_MUL_RZERO; + CEXP_0; COMPLEX_MUL_LID] THEN + MATCH_MP_TAC (COMPLEX_FIELD + `!a b c. ~(b = Cx(&0)) /\ a = b * c ==> a / b = c`) THEN + CONJ_TAC THENL + [ALL_TAC; MP_TAC (SPECL [`cnj w2`;`z:complex`] LEMMA_1) THEN + ASM_REWRITE_TAC [COMPLEX_NORM_CNJ] THEN EXPAND_TAC "w2" THEN + REWRITE_TAC [CNJ_NEG] THEN CONV_TAC COMPLEX_FIELD] THEN + MATCH_MP_TAC (COMPLEX_FIELD + `!a b c d. ~(d = Cx(&0)) /\ ~(d * a - b * c = Cx(&0)) + ==> ~(a - b * c / d = Cx(&0))`) THEN + ASM_SIMP_TAC [LEMMA_1; COMPLEX_NORM_CNJ] THEN + ASM_REWRITE_TAC [COMPLEX_MUL_RID] THEN + SUBGOAL_THEN + `Cx(&1) - cnj w2 * z - cnj w1 * (z - w2) = + Cx(&1) + cnj w1 * w2` SUBST1_TAC THENL + [EXPAND_TAC "w2" THEN REWRITE_TAC [CNJ_NEG] THEN CONV_TAC COMPLEX_RING; + ASM_SIMP_TAC [LEMMA_1_ALT; COMPLEX_NORM_CNJ]]);; + +let BALL_BIHOLOMORPHISM_EXISTS = prove + (`!a. a IN ball(Cx(&0),&1) + ==> ?f g. f(a) = Cx(&0) /\ + f holomorphic_on ball (Cx(&0),&1) /\ + (!z. z IN ball (Cx(&0),&1) ==> f z IN ball (Cx(&0),&1)) /\ + g holomorphic_on ball (Cx(&0),&1) /\ + (!z. z IN ball (Cx(&0),&1) ==> g z IN ball (Cx(&0),&1)) /\ + (!z. z IN ball (Cx(&0),&1) ==> f (g z) = z) /\ + (!z. z IN ball (Cx(&0),&1) ==> g (f z) = z)`, + REWRITE_TAC[COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `moebius_function (&0) a` THEN + EXISTS_TAC `moebius_function (&0) (--a)` THEN + ASM_SIMP_TAC[COMPLEX_IN_BALL_0; MOEBIUS_FUNCTION_COMPOSE; COMPLEX_NEG_NEG; + NORM_NEG] THEN + ASM_SIMP_TAC[MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG; + MOEBIUS_FUNCTION_HOLOMORPHIC; MOEBIUS_FUNCTION_EQ_ZERO]);; + +let BALL_BIHOLOMORPHISM_MOEBIUS_FUNCTION = prove + (`!f g. + f holomorphic_on ball (Cx(&0),&1) /\ + (!z. z IN ball (Cx(&0),&1) ==> f z IN ball (Cx(&0),&1)) /\ + g holomorphic_on ball (Cx(&0),&1) /\ + (!z. z IN ball (Cx(&0),&1) ==> g z IN ball (Cx(&0),&1)) /\ + (!z. z IN ball (Cx(&0),&1) ==> f (g z) = z) /\ + (!z. z IN ball (Cx(&0),&1) ==> g (f z) = z) + ==> ?t w. w IN ball (Cx(&0),&1) /\ + (!z. z IN ball (Cx(&0),&1) ==> f z = moebius_function t w z)`, + let LEMMA_1 = prove + (`!a b:complex. norm a < &1 /\ norm b < &1 + ==> ~(Cx(&1) - a * b = Cx(&0))`, + GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [COMPLEX_SUB_0] THEN + SUBGOAL_THEN `~(norm (Cx(&1)) = norm (a * b))` + (fun th -> MESON_TAC[th]) THEN + REWRITE_TAC [COMPLEX_NORM_NUM; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC (REAL_ARITH `!x y. y < x ==> ~(x = y)`) THEN + ASM_CASES_TAC `b = Cx(&0)` THEN + ASM_REWRITE_TAC [COMPLEX_NORM_NUM; REAL_MUL_RZERO; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1 * norm (b:complex)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC [COMPLEX_NORM_NZ]; + ASM_REWRITE_TAC [REAL_MUL_LID]]) in + let LEMMA_2 = prove + (`!t w s z. norm w < &1 /\ norm z < &1 + ==> moebius_function t w (cexp(ii * Cx s) * z) = + moebius_function (t + s) (cexp(-- (ii * Cx s)) * w) z`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[moebius_function; CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD; + GSYM COMPLEX_MUL_ASSOC; COMPLEX_EQ_MUL_LCANCEL; CEXP_NZ; + CNJ_MUL] THEN + MATCH_MP_TAC (COMPLEX_FIELD + `!a b c d e. ~(b = Cx(&0)) /\ ~(e = Cx(&0)) /\ e * a = b * c * d + ==> a / b = c * d / e`) THEN CONJ_TAC THENL + [MATCH_MP_TAC LEMMA_1 THEN + ASM_REWRITE_TAC [COMPLEX_NORM_CNJ; COMPLEX_NORM_MUL; NORM_CEXP_II; + REAL_MUL_LID]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC [COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LEMMA_1 THEN + ASM_REWRITE_TAC [COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; COMPLEX_NEG_RMUL; + GSYM CX_NEG; NORM_CEXP_II; REAL_MUL_LID]; + REWRITE_TAC [CNJ_CEXP; CNJ_NEG; CNJ_MUL; CNJ_II; CNJ_CX; + COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG; CEXP_NEG] THEN + ABBREV_TAC `a = cexp(ii * Cx s)` THEN + SUBGOAL_THEN `inv a * a = Cx(&1)` MP_TAC THENL + [ALL_TAC; CONV_TAC COMPLEX_RING] THEN + MATCH_MP_TAC COMPLEX_MUL_LINV THEN EXPAND_TAC "a" THEN + REWRITE_TAC [CEXP_NZ]]) in + REWRITE_TAC [COMPLEX_IN_BALL_0] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC `w:complex = f (Cx(&0))` THEN + SUBGOAL_THEN `norm(w:complex) < &1` ASSUME_TAC THENL + [ASM_MESON_TAC [COMPLEX_NORM_NUM; REAL_LT_01]; ALL_TAC] THEN + SUBGOAL_THEN + `?t. !z. z IN ball (Cx(&0),&1) + ==> moebius_function (&0) w (f z) = cexp(ii * Cx t) * z` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC `t:real` THEN EXISTS_TAC `-- (cexp(-- (ii * Cx t)) * w)` THEN + ASM_REWRITE_TAC [NORM_NEG; COMPLEX_NORM_MUL; COMPLEX_NEG_RMUL; + GSYM CX_NEG; NORM_CEXP_II; REAL_MUL_LID] THEN + GEN_TAC THEN DISCH_TAC THEN EQ_TRANS_TAC + `moebius_function (&0) (--w) + (moebius_function (&0) w (f (z:complex)))` THENL + [MATCH_MP_TAC EQ_SYM THEN MATCH_MP_TAC MOEBIUS_FUNCTION_COMPOSE THEN + ASM_SIMP_TAC [COMPLEX_NEG_NEG; NORM_NEG]; + ASM_SIMP_TAC[COMPLEX_IN_BALL_0] THEN ASM_SIMP_TAC[LEMMA_2; NORM_NEG] THEN + REWRITE_TAC [REAL_ADD_LID; CX_NEG; COMPLEX_MUL_RNEG]]] THEN + MATCH_MP_TAC SECOND_CARTAN_THM_DIM_1 THEN EXISTS_TAC + `\z. g (moebius_function (&0) (--w) z) : complex` THEN + REWRITE_TAC [COMPLEX_IN_BALL_0] THEN REWRITE_TAC [REAL_LT_01] THEN + CONJ_TAC THENL + [MATCH_MP_TAC (REWRITE_RULE [o_DEF] HOLOMORPHIC_ON_COMPOSE_GEN) THEN + EXISTS_TAC `ball(Cx(&0),&1)` THEN + ASM_SIMP_TAC [ETA_AX; MOEBIUS_FUNCTION_HOLOMORPHIC; COMPLEX_IN_BALL_0]; + ALL_TAC] THEN CONJ_TAC THENL [ASM_SIMP_TAC [MOEBIUS_FUNCTION_NORM_LT_1]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC [MOEBIUS_FUNCTION_EQ_ZERO]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC (REWRITE_RULE [o_DEF] HOLOMORPHIC_ON_COMPOSE_GEN) THEN + EXISTS_TAC `ball(Cx(&0),&1)` THEN + ASM_SIMP_TAC [COMPLEX_IN_BALL_0; MOEBIUS_FUNCTION_NORM_LT_1; + NORM_NEG] THEN + ASM_SIMP_TAC [ETA_AX; MOEBIUS_FUNCTION_HOLOMORPHIC; NORM_NEG]; + ALL_TAC] THEN CONJ_TAC THENL + [ASM_SIMP_TAC [MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG]; ALL_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC [MOEBIUS_FUNCTION_OF_ZERO; COMPLEX_MUL_RZERO; CEXP_0; + GSYM COMPLEX_NEG_LMUL; COMPLEX_MUL_LID; + COMPLEX_NEG_NEG] THEN + ASM_MESON_TAC [COMPLEX_NORM_0; REAL_LT_01]; + ALL_TAC] THEN CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC [REWRITE_RULE [COMPLEX_NEG_NEG; NORM_NEG] + (SPECL [`--w:complex`;`w:complex`] MOEBIUS_FUNCTION_COMPOSE)]] THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `f (g (moebius_function (&0) (--w) z) : complex) = + (moebius_function (&0) (--w) z)` + SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC [MOEBIUS_FUNCTION_NORM_LT_1; NORM_NEG]; + MATCH_MP_TAC MOEBIUS_FUNCTION_COMPOSE THEN ASM_REWRITE_TAC []]);; + +(* ------------------------------------------------------------------------- *) +(* Some simple but useful cases of Hurwitz's theorem. *) +(* ------------------------------------------------------------------------- *) + +let HURWITZ_NO_ZEROS = prove + (`!f:num->complex->complex g s. + open s /\ connected s /\ + (!n. (f n) holomorphic_on s) /\ g holomorphic_on s /\ + (!k e. compact k /\ k SUBSET s /\ &0 < e + ==> ?N. !n x. n >= N /\ x IN k ==> norm(f n x - g x) < e) /\ + ~(?c. !z. z IN s ==> g z = c) /\ + (!n z. z IN s ==> ~(f n z = Cx(&0))) + ==> (!z. z IN s ==> ~(g z = Cx(&0)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `z0:complex` THEN + REPEAT DISCH_TAC THEN + MP_TAC(ISPECL [`g:complex->complex`; `s:complex->bool`; `z0:complex`] + HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:complex->complex`; `r:real`; `m:num`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`sequentially`; `\n:num z. complex_derivative (f n) z / f n z`; + `\z. complex_derivative g z / g z`; `z0:complex`; `r / &2`] + PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH) THEN + ASM_REWRITE_TAC[REAL_HALF; TRIVIAL_LIMIT_SEQUENTIALLY; NOT_IMP] THEN + SUBGOAL_THEN + `!n:num. ((\z. complex_derivative (f n) z / f n z) + has_path_integral (Cx(&0))) (circlepath(z0,r / &2))` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC CAUCHY_THEOREM_DISC_SIMPLE THEN + MAP_EVERY EXISTS_TAC [`z0:complex`; `r:real`] THEN + ASM_SIMP_TAC[VALID_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; + PATHFINISH_CIRCLEPATH; PATH_IMAGE_CIRCLEPATH; + REAL_HALF; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + REWRITE_TAC[SUBSET; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_ARITH `&0 < r ==> r / &2 < r`] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + REWRITE_TAC[OPEN_BALL]; + REWRITE_TAC[ETA_AX]; + ASM_MESON_TAC[SUBSET]] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + REWRITE_TAC[path_integrable_on] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC UNIFORM_LIM_COMPLEX_DIV THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; REAL_HALF; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `IMAGE (complex_derivative g) {w | norm(w - z0) = r / &2}` + COMPACT_IMP_BOUNDED) THEN + ANTS_TAC THENL + [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[o_DEF; + REWRITE_RULE[sphere; NORM_ARITH `dist(w:real^N,z) = norm(z - w)`] + COMPACT_SPHERE] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN + UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[]]; + MP_TAC(ISPEC `IMAGE (norm o (g:complex->complex)) + {w | norm(w - z0) = r / &2}` + COMPACT_ATTAINS_INF) THEN + REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM IMAGE_o; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; o_THM] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[o_DEF; + REWRITE_RULE[sphere; NORM_ARITH `dist(w:real^N,z) = norm(z - w)`] + COMPACT_SPHERE] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN + UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `z0 + Cx(r / &2)` THEN + REWRITE_TAC[VECTOR_ARITH `(a + b) - a:real^N = b`] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `ww:complex` MP_TAC) THEN + STRIP_TAC THEN EXISTS_TAC `norm((g:complex->complex) ww)` THEN + ASM_SIMP_TAC[ALWAYS_EVENTUALLY; COMPLEX_NORM_NZ] THEN + DISCH_THEN(ASSUME_TAC o REWRITE_RULE[COMPLEX_NORM_ZERO]) THEN + UNDISCH_TAC `!w. w IN ball(z0,r) ==> g w = (w - z0) pow m * h w` THEN + DISCH_THEN(MP_TAC o SPEC `ww:complex`) THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0] THEN + REWRITE_TAC[IN_BALL; GSYM COMPLEX_NORM_ZERO] THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + ASM_REAL_ARITH_TAC]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL + [`cball(z0:complex,&3 * r / &4)`; `r / &4 * e / &2`]) THEN + REWRITE_TAC[COMPACT_CBALL] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; IN_ELIM_THM] THEN + UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[GE; EVENTUALLY_SEQUENTIALLY; IN_CBALL; dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\z. (f:num->complex->complex) n z - g z`; + `w:complex`; `Cx(&0)`; `r / &4`; `r / &4 * e / &2`; `1`] + CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND) THEN + REWRITE_TAC[HIGHER_COMPLEX_DERIVATIVE_1; COMPLEX_IN_BALL_0] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; CONV_TAC NUM_REDUCE_CONV] THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + X_GEN_TAC `y:complex` THEN REWRITE_TAC[IN_BALL] THEN + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY UNDISCH_TAC + [`norm(w - z0:complex) = r / &2`; `dist(w:complex,y) < r / &4`] THEN + CONV_TAC NORM_ARITH] THEN + (MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; IN_ELIM_THM] THEN + UNDISCH_TAC `norm(w - z0:complex) = r / &2` THEN + UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH); + CONV_TAC NUM_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < r /\ &0 < e + ==> &1 * (r / &4 * e / &2) / (r / &4) pow 1 = e / &2`] THEN + MATCH_MP_TAC(NORM_ARITH + `x = y /\ &0 < e ==> norm(x) <= e / &2 ==> norm(y) < e`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + ASM_REAL_ARITH_TAC]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`{w:complex | norm(w - z0) = r / &2}`; `e:real`]) THEN + ASM_REWRITE_TAC[GE; IN_ELIM_THM; + REWRITE_RULE[sphere; NORM_ARITH `dist(w:real^N,z) = norm(z - w)`] + COMPACT_SPHERE] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN + UNDISCH_TAC `&0 < r` THEN CONV_TAC NORM_ARITH]; + FIRST_ASSUM(ASSUME_TAC o GEN `n:num` o MATCH_MP PATH_INTEGRAL_UNIQUE o + SPEC `n:num`) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + ASM_REWRITE_TAC[LIM_CONST_EQ; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC(COMPLEX_RING + `!q r. p = q /\ q = r /\ ~(r = Cx(&0)) ==> ~(Cx(&0) = p)`) THEN + MAP_EVERY EXISTS_TAC + [`path_integral (circlepath(z0,r / &2)) + (\z. Cx(&m) / (z - z0) + + complex_derivative h z / h z)`; + `Cx(&2) * Cx pi * ii * Cx(&m)`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PATH_INTEGRAL_EQ THEN X_GEN_TAC `w:complex` THEN + ASM_SIMP_TAC[PATH_IMAGE_CIRCLEPATH; IN_ELIM_THM; REAL_HALF; + REAL_LT_IMP_LE; sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + ASM_CASES_TAC `w:complex = z0` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THENL + [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + SUBGOAL_THEN `w IN ball(z0:complex,r)` ASSUME_TAC THENL + [REWRITE_TAC[IN_BALL] THEN + MAP_EVERY UNDISCH_TAC [`norm (w - z0) = r / &2`; `&0 < r`] THEN + CONV_TAC NORM_ARITH; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_POW_EQ_0; COMPLEX_SUB_0; + COMPLEX_FIELD `~(y = Cx(&0)) ==> (x / y = w <=> x = y * w)`] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(h = Cx(&0)) ==> (m * h) * (x + y / h) = m * y + m * h * x`] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\w:complex. (w - z0) pow m * h w` THEN + EXISTS_TAC `ball(z0:complex,r)` THEN ASM_SIMP_TAC[OPEN_BALL] THEN + SUBGOAL_THEN + `(w - z0) pow m * h w * Cx(&m) / (w - z0) = + (Cx(&m) * (w - z0) pow (m - 1)) * h w` + SUBST1_TAC THENL + [MATCH_MP_TAC(COMPLEX_FIELD + `w * mm = z /\ ~(w = Cx(&0)) + ==> z * h * m / w = (m * mm) * h`) THEN + ASM_REWRITE_TAC[COMPLEX_SUB_0; GSYM(CONJUNCT2 complex_pow)] THEN + AP_TERM_TAC THEN ASM_ARITH_TAC; + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_MUL_AT THEN CONJ_TAC THENL + [COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; OPEN_BALL]]]; + GEN_REWRITE_TAC RAND_CONV [GSYM COMPLEX_ADD_RID] THEN + MATCH_MP_TAC PATH_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; HOLOMORPHIC_ON_CONST]; + MATCH_MP_TAC CAUCHY_THEOREM_DISC_SIMPLE THEN + MAP_EVERY EXISTS_TAC [`z0:complex`; `r:real`] THEN + ASM_SIMP_TAC[VALID_PATH_CIRCLEPATH; PATHSTART_CIRCLEPATH; + PATHFINISH_CIRCLEPATH; PATH_IMAGE_CIRCLEPATH; + REAL_HALF; REAL_LT_IMP_LE] THEN + REWRITE_TAC[sphere; NORM_ARITH `dist(z,w) = norm(w - z)`] THEN + REWRITE_TAC[SUBSET; IN_BALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_ARITH `&0 < r ==> r / &2 < r`] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC HOLOMORPHIC_COMPLEX_DERIVATIVE THEN + ASM_REWRITE_TAC[OPEN_BALL]]; + REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; PI_NZ; II_NZ; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[LE_1; ARITH_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL]]]);; + +let HURWITZ_INJECTIVE = prove + (`!f:num->complex->complex g s. + open s /\ connected s /\ + (!n. (f n) holomorphic_on s) /\ g holomorphic_on s /\ + (!k e. compact k /\ k SUBSET s /\ &0 < e + ==> ?N. !n x. n >= N /\ x IN k ==> norm(f n x - g x) < e) /\ + ~(?c. !z. z IN s ==> g z = c) /\ + (!n w z. w IN s /\ z IN s /\ f n w = f n z ==> w = z) + ==> (!w z. w IN s /\ z IN s /\ g w = g z ==> w = z)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`z1:complex`; `z2:complex`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `(g:complex->complex) z2`) THEN + REWRITE_TAC[] THEN X_GEN_TAC `z0:complex` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REPEAT DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[MESON[] + `(!x y. x IN s /\ y IN s /\ g x = g y ==> x = y) <=> + (!x y. x IN s /\ y IN s ==> (g x = g y <=> x = y))`]) THEN + MP_TAC(ISPECL + [`\z. (g:complex->complex) z - g z1`; `s:complex->bool`; + `z2:complex`; `z0:complex`] + ISOLATED_ZEROS) THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_CONST] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\n z. (f:num->complex->complex) n z - f n z1`; + `\z. (g:complex->complex) z - g z1`; `s DELETE (z1:complex)`] + HURWITZ_NO_ZEROS) THEN + REWRITE_TAC[NOT_IMP; COMPLEX_SUB_0] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[OPEN_DELETE]; + ASM_SIMP_TAC[CONNECTED_OPEN_DELETE; DIMINDEX_2; LE_REFL]; + GEN_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; ETA_AX; HOLOMORPHIC_ON_CONST] THEN + SET_TAC[]; + MATCH_MP_TAC HOLOMORPHIC_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; ETA_AX; HOLOMORPHIC_ON_CONST] THEN + SET_TAC[]; + MAP_EVERY X_GEN_TAC [`k:complex->bool`; `e:real`] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE + `k SUBSET s DELETE z ==> k SUBSET s`)) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`k:complex->bool`; `e / &2`] th) THEN + MP_TAC(SPECL [`{z1:complex}`; `e / &2`] th)) THEN + ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET; REAL_HALF] THEN + SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; FORALL_UNWIND_THM2] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `N1:num`) (X_CHOOSE_TAC `N2:num`)) THEN + EXISTS_TAC `MAX N1 N2` THEN REPEAT STRIP_TAC THEN + UNDISCH_THEN `(g:complex->complex) z1 = g z2` (SUBST1_TAC o SYM) THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x1 - x2) < e / &2 /\ norm(y1 - y2) < e / &2 + ==> norm(x1 - y1 - (x2 - y2)) < e`) THEN + ASM_MESON_TAC[ARITH_RULE `x >= MAX m n <=> x >= m /\ x >= n`]; + REWRITE_TAC[IN_DELETE; COMPLEX_EQ_SUB_RADD] THEN DISCH_THEN(CHOOSE_THEN + (fun th -> MAP_EVERY (MP_TAC o C SPEC th) + [`z0:complex`; `z1:complex`; `z2:complex`])) THEN + ASM_MESON_TAC[]; + REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[]; + REWRITE_TAC[IN_DELETE] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The Great Picard theorem. *) +(* ------------------------------------------------------------------------- *) + +let GREAT_PICARD = prove + (`!f n a b z. + open n /\ z IN n /\ ~(a = b) /\ f holomorphic_on (n DELETE z) /\ + (!w. w IN n DELETE z ==> ~(f w = a) /\ ~(f w = b)) + ==> ?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)`, + let lemma1 = prove + (`!p q r s w. + open s /\ connected s /\ w IN s /\ &0 < r /\ + (!h. h IN p + ==> h holomorphic_on s /\ + !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))) /\ + (!h. h IN q ==> h IN p /\ norm(h w) <= r) + ==> ?B n. &0 < B /\ open n /\ w IN n /\ n SUBSET s /\ + !h z. h IN q /\ z IN n ==> norm(h z) <= B`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `w:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC + [`exp(pi * exp(pi * (&2 + &2 * r + &12)))`; + `ball(w:complex,e / &2)`] THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_HALF] THEN + REWRITE_TAC[REAL_EXP_POS_LT] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`f:complex->complex`; `z:complex`] THEN + STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`)) THEN + ASM_CASES_TAC `(f:complex->complex) IN p` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\z. (f:complex->complex) (w + Cx e * z)`; `r:real`] + SCHOTTKY) THEN + ASM_REWRITE_TAC[DE_MORGAN_THM; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; + HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `u:complex` THEN DISCH_TAC; + X_GEN_TAC `u:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(w,w + z) = norm z`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH + `&0 < e ==> (abs e * u <= e <=> e * u <= e * &1)`] THEN + ASM_MESON_TAC[COMPLEX_IN_CBALL_0]; + DISCH_THEN(MP_TAC o SPECL [`&1 / &2`; `Cx(inv e) * (z - w)`]) THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; COMPLEX_NORM_MUL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[COMPLEX_RING `w + Cx(&1) * (z - w) = z`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_INV] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv e * x:real = x / e`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + CONV_TAC NORM_ARITH]) in + let lemma2 = prove + (`!s t:real^N->bool. + connected t /\ ~(s = {}) /\ s SUBSET t /\ open s /\ + (!x. x limit_point_of s /\ x IN t ==> x IN s) + ==> s = t`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[CLOSED_IN_LIMPT] THEN ASM_SIMP_TAC[OPEN_SUBSET]) in + let lemma3 = prove + (`!p s w q. + open s /\ connected s /\ w IN s /\ + (!h. h IN p + ==> h holomorphic_on s /\ + !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))) /\ + (!h. h IN q ==> h IN p /\ norm(h w) <= &1) + ==> !k. compact k /\ k SUBSET s + ==> ?b. !h z. h IN q /\ z IN k ==> norm(h z) <= b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC + `u = {z | z IN s /\ + ?B n. &0 < B /\ open n /\ z IN n /\ n SUBSET s /\ + !h:complex->complex z'. + h IN q /\ z' IN n ==> norm(h z') <= B}` THEN + SUBGOAL_THEN `(u:complex->bool) SUBSET s` ASSUME_TAC THENL + [EXPAND_TAC "u" THEN REWRITE_TAC[SUBSET_RESTRICT]; ALL_TAC] THEN + SUBGOAL_THEN `u:complex->bool = s` ASSUME_TAC THENL + [MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `w:complex` THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma1 THEN + MAP_EVERY EXISTS_TAC [`p:(complex->complex)->bool`; `&1`] THEN + ASM_REWRITE_TAC[REAL_LT_01]; + ALL_TAC] THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN X_GEN_TAC `z:complex` THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:complex->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXPAND_TAC "u" THEN + ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `v:complex` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`B:real`; `n:complex->bool`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `v:complex` THEN STRIP_TAC THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma1 THEN + EXISTS_TAC `p:(complex->complex)->bool` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MESON[] + `(?r. P r /\ Q r) <=> ~(!r. P r ==> ~Q r)`] THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&n + &1:real`) THEN + REWRITE_TAC[REAL_ARITH `&0 < &n + &1`] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [NOT_FORALL_THM] THEN + ASM_SIMP_TAC[SKOLEM_THM] THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; REAL_NOT_LE] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->complex->complex` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `g:num->complex->complex = \n z. inv(f n z)` THEN + SUBGOAL_THEN `!n:num. (g n) holomorphic_on s` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "g" THEN MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN + REWRITE_TAC[ETA_AX] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n:num z:complex. z IN s ==> ~(g n z = Cx(&0)) /\ ~(g n z = Cx(&1))` + STRIP_ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN + REWRITE_TAC[COMPLEX_INV_EQ_0; COMPLEX_INV_EQ_1] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?B n. &0 < B /\ + open n /\ + v IN n /\ + n SUBSET s /\ + !h z. h IN {(g:num->complex->complex) n | n IN (:num)} /\ z IN n + ==> norm(h z) <= B` + MP_TAC THENL + [MATCH_MP_TAC lemma1 THEN + EXISTS_TAC `{h | h holomorphic_on s /\ + !z. z IN s ==> ~(h z = Cx(&0)) /\ ~(h z = Cx(&1))}` THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; REAL_LT_01] THEN + X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + ASM_MESON_TAC[REAL_ARITH `&n + &1 < f ==> &1 <= f`]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_UNIV] THEN STRIP_TAC] THEN + UNDISCH_TAC `open(n:complex->bool)` THEN + REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:num->complex->complex`; + `{(g:num->complex->complex) n | n IN (:num)}`; + `ball(v:complex,e)`] MONTEL) THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_UNIV; IMP_IMP; OPEN_BALL; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET]; ASM SET_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:complex->complex`; `j:num->num`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `h(v:complex) = Cx(&0)` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (g:num->complex->complex) (j n) v` THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON THEN EXISTS_TAC `\n. inv(&n)` THEN + REWRITE_TAC[SEQ_HARMONIC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN + REWRITE_TAC[COMPLEX_NORM_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN + TRANS_TAC REAL_LE_TRANS `&i + &1` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS `&((j:num->num) i) + &1` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_RADD; REAL_OF_NUM_LE] THEN + ASM_MESON_TAC[MONOTONE_BIGGER]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(g:num->complex->complex) o (j:num->num)`; + `h:complex->complex`; `ball(v:complex,e)`] + HURWITZ_NO_ZEROS) THEN + ASM_REWRITE_TAC[OPEN_BALL; CONNECTED_BALL] THEN + ASM_REWRITE_TAC[NOT_IMP; o_THM] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS]; + ASM_MESON_TAC[]; + ALL_TAC; + ASM SET_TAC[]; + DISCH_THEN(MP_TAC o SPEC `v:complex`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL]] THEN + DISCH_THEN(X_CHOOSE_THEN `c:complex` (fun th -> + MP_TAC th THEN MP_TAC(SPEC `v:complex` th))) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `y IN ball(v:complex,e)` ASSUME_TAC THENL + [REWRITE_TAC[IN_BALL] THEN ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + UNDISCH_TAC `(y:complex) IN u` THEN EXPAND_TAC "u" THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `C:real` MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `nn:complex->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o + SPECL [`(f:num->complex->complex) n`; `y:complex`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:complex}`) THEN + ASM_REWRITE_TAC[COMPACT_SING; SING_SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `inv(C:real)`) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + ASM_SIMP_TAC[GE; LE_REFL; COMPLEX_SUB_RZERO; REAL_NOT_LT] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN + ASM SET_TAC[]; + X_GEN_TAC `k:complex->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x:complex. x IN k ==> x IN u` MP_TAC + THENL [ASM SET_TAC[]; ALL_TAC] THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `(!x. P x ==> Q x /\ ?y z. R x y z) ==> !x. ?y z. P x ==> R x y z`)) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`b:complex->real`; `n:complex->complex->bool`] THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o + MATCH_MP COMPACT_IMP_HEINE_BOREL) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (n:complex->complex->bool) k`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `j:complex->bool` MP_TAC) THEN + ASM_CASES_TAC `j:complex->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0] THENL + [SET_TAC[]; STRIP_TAC] THEN + EXISTS_TAC `sup(IMAGE (b:complex->real) j)` THEN + ASM_SIMP_TAC[REAL_LE_SUP_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN ASM SET_TAC[]]) in + let lemma4 = prove + (`!f k B. + &0 < k /\ f holomorphic_on ball(Cx(&0),k) DELETE Cx(&0) /\ + (!e. &0 < e /\ e < k + ==> ?d. &0 < d /\ d < e /\ + !z. z IN sphere(Cx(&0),d) ==> norm(f z) <= B) + ==> ?e. &0 < e /\ e < k /\ + !z. z IN ball(Cx(&0),e) DELETE Cx(&0) ==> norm(f z) <= B`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `k / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `norm(z:complex)`) THEN + REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!w. w IN cball(Cx(&0),e) DIFF ball(Cx(&0),d) ==> norm(f w:complex) <= B` + MATCH_MP_TAC THENL + [MATCH_MP_TAC MAXIMUM_MODULUS_FRONTIER; + ASM_REWRITE_TAC[IN_DIFF; COMPLEX_IN_BALL_0; COMPLEX_IN_CBALL_0] THEN + ASM_REAL_ARITH_TAC] THEN + SIMP_TAC[BOUNDED_CBALL; BOUNDED_DIFF; CONJ_ASSOC] THEN CONJ_TAC THENL + [SIMP_TAC[CLOSURE_CLOSED; CLOSED_DIFF; CLOSED_CBALL; OPEN_BALL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (MESON[INTERIOR_SUBSET; HOLOMORPHIC_ON_SUBSET; SUBSET_TRANS; + HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] + `f holomorphic_on t ==> s SUBSET t + ==> f holomorphic_on interior s /\ f continuous_on s`)) THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ a IN u ==> s DIFF u SUBSET t DELETE a`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; SUBSET_BALLS; DIST_REFL] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `w:complex` THEN + ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (s DIFF t) = (UNIV DIFF s) UNION t`] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[SUBSET] FRONTIER_UNION_SUBSET)) THEN + ASM_SIMP_TAC[FRONTIER_COMPLEMENT; FRONTIER_BALL; FRONTIER_CBALL] THEN + ASM SET_TAC[]]) in + let lemma5 = prove + (`!f. f holomorphic_on (ball(Cx(&0),&1) DELETE (Cx(&0))) /\ + (!z. z IN ball(Cx(&0),&1) DELETE Cx(&0) + ==> ~(f z = Cx(&0)) /\ ~(f z = Cx(&1))) + ==> ?e b. &0 < e /\ e < &1 /\ &0 < b /\ + ((!z. z IN ball(Cx(&0),e) DELETE Cx(&0) + ==> norm(f z) <= b) \/ + (!z. z IN ball(Cx(&0),e) DELETE Cx(&0) + ==> norm(f z) >= b))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `h = \n z. (f:complex->complex) (z / Cx(&n + &1))` THEN + SUBGOAL_THEN + `(!n:num. (h n) holomorphic_on ball(Cx(&0),&1) DELETE Cx(&0)) /\ + (!n z. z IN ball(Cx(&0),&1) DELETE Cx(&0) + ==> ~(h n z = Cx(&0)) /\ ~(h n z = Cx(&1)))` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN X_GEN_TAC `n:num` THEN EXPAND_TAC "h" THEN SIMP_TAC[] THENL + [ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + REWRITE_TAC[HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST; CX_INJ] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET))]; + SUBGOAL_THEN + `!z. z IN ball (Cx(&0),&1) DELETE Cx(&0) + ==> z / Cx(&n + &1) IN ball (Cx(&0),&1) DELETE Cx(&0)` + (fun th -> ASM_MESON_TAC[th])] THEN + REWRITE_TAC[IN_DELETE; FORALL_IN_IMAGE; SUBSET; COMPLEX_IN_BALL_0] THEN + SIMP_TAC[COMPLEX_DIV_EQ_0; CX_INJ; REAL_ARITH `~(&n + &1 = &0)`] THEN + SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ARITH `&0 < &n + &1`; + REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_LDIV_EQ] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `?w. w IN ball(Cx(&0),&1) DELETE Cx(&0)` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `Cx(&1 / &2)` THEN + REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0; COMPLEX_NORM_CX; CX_INJ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(ISPECL + [`{g | g holomorphic_on ball(Cx(&0),&1) DELETE Cx(&0) /\ + !z. z IN ball(Cx(&0),&1) DELETE Cx(&0) + ==> ~(g z = Cx(&0)) /\ ~(g z = Cx(&1))}`; + `ball(Cx(&0),&1) DELETE Cx(&0)`; `w:complex`] lemma3) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN + SIMP_TAC[OPEN_BALL; OPEN_DELETE; CONNECTED_BALL; DIMINDEX_2; LE_REFL; + CONNECTED_OPEN_DELETE; IN_ELIM_THM] THEN + SUBGOAL_THEN + `INFINITE {n | norm((h:num->complex->complex) n w) <= &1} \/ + INFINITE {n | &1 <= norm((h:num->complex->complex) n w)}` + MP_TAC THENL + [MP_TAC num_INFINITE THEN + REWRITE_TAC[INFINITE; GSYM DE_MORGAN_THM; GSYM FINITE_UNION] THEN + REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN SIMP_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INFINITE_ENUMERATE_WEAK) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + X_GEN_TAC `r:num->num` THEN STRIP_TAC THENL + [DISCH_THEN(MP_TAC o SPEC + `{(h:num->complex->complex) (r n) | n IN (:num)}`); + DISCH_THEN(MP_TAC o SPEC + `{inv o (h:num->complex->complex) (r n) | n IN (:num)}`)] THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + ASM_SIMP_TAC[o_DEF; COMPLEX_INV_EQ_0; COMPLEX_INV_EQ_1] THEN + ASM_SIMP_TAC[COMPLEX_NORM_INV; REAL_INV_LE_1] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_INV; ETA_AX] THEN + DISCH_THEN(MP_TAC o SPEC `sphere(Cx(&0),&1 / &2)`) THEN + (ANTS_TAC THENL + [REWRITE_TAC[SUBSET; COMPLEX_IN_SPHERE_0; IN_DELETE; COMPLEX_IN_BALL_0; + COMPACT_SPHERE; GSYM COMPLEX_NORM_NZ] THEN + SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC]) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + EXPAND_TAC "h" THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THENL + [EXISTS_TAC `abs b + &1`; EXISTS_TAC `inv(abs b + &1)`] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < abs b + &1`] THEN + REWRITE_TAC[LEFT_OR_DISTRIB; EXISTS_OR_THM] THENL + [DISJ1_TAC THEN MATCH_MP_TAC lemma4 THEN + ASM_REWRITE_TAC[REAL_LT_01]; + DISJ2_TAC THEN + MP_TAC(ISPECL [`inv o (f:complex->complex)`; `&1`; `abs b + &1`] + lemma4) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_INV; ETA_AX; o_DEF; REAL_LT_01] THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + REWRITE_TAC[COMPLEX_NORM_INV; real_ge; + IN_DELETE; COMPLEX_IN_BALL_0] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV_EQ] THEN + REWRITE_TAC[COMPLEX_NORM_NZ] THEN + MATCH_MP_TAC(TAUT `!q. ~p /\ ~q ==> ~p`) THEN + EXISTS_TAC `f(z:complex) = Cx(&1)` THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_DELETE; COMPLEX_IN_BALL_0] THEN + ASM_REAL_ARITH_TAC]] THEN + (X_GEN_TAC `e:real` THEN STRIP_TAC THEN + MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + EXISTS_TAC `inv(&2 * (&(r(n:num)) + &1))` THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL + [TRANS_TAC REAL_LET_TRANS `inv(&n)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC(ARITH_RULE `m <= n ==> m <= 2 * (n + 1)`) THEN + ASM_MESON_TAC[MONOTONE_BIGGER]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_SPHERE_0] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`n:num`; `Cx(&(r(n:num)) + &1) * z`]) THEN + ASM_REWRITE_TAC[COMPLEX_IN_SPHERE_0; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; + REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + ANTS_TAC THENL [CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `x = y ==> norm x <= b ==> norm y <= abs b + &1`) THEN + REPEAT AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(z = Cx(&0)) ==> (z * w) / z = w`) THEN + REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC)) in + let lemma6 = prove + (`!f n a z. + open n /\ z IN n /\ ~(a = Cx(&0)) /\ f holomorphic_on (n DELETE z) /\ + (!w. w IN n DELETE z ==> ~(f w = Cx(&0)) /\ ~(f w = a)) + ==> ?r. &0 < r /\ ball(z,r) SUBSET n /\ + (bounded(IMAGE f (ball (z,r) DELETE z)) \/ + bounded(IMAGE (inv o f) (ball (z,r) DELETE z)))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC + `\w. (f:complex->complex) (z + Cx r * w) / a` lemma5) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; + HOLOMORPHIC_ON_ID; HOLOMORPHIC_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0; IN_DELETE] THEN + GEN_TAC THEN STRIP_TAC; + ASM_SIMP_TAC[COMPLEX_FIELD + `~(a = Cx(&0)) ==> (x / a = z <=> x = a * z)`] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_IN_BALL_0; IN_DELETE] THEN GEN_TAC THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_DELETE]] THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_RING + `z + a * b = z <=> a = Cx(&0) \/ b = Cx(&0)`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a,a + b) = norm b`] THEN + ASM_SIMP_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE; + REAL_ARITH `r * x < r <=> &0 < r * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; bounded; FORALL_IN_IMAGE; o_THM]] THEN + MAP_EVERY X_GEN_TAC [`e:real`; `b:real`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + EXISTS_TAC `e * r:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + ASM_SIMP_TAC[SUBSET_BALLS; REAL_ADD_LID; DIST_REFL; REAL_LT_MUL; + REAL_SUB_LT; REAL_ARITH `&0 < r * (&1 - e) ==> e * r <= r`]; + DISCH_TAC] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN (LABEL_TAC "*")) THENL + [DISJ1_TAC THEN EXISTS_TAC `norm(a:complex) * b`; + DISJ2_TAC THEN EXISTS_TAC `inv(norm(a:complex) * b)`] THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_BALL; IN_DELETE] THEN + STRIP_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `(w - z) / Cx r`) THEN + ASM_SIMP_TAC[IN_DELETE; COMPLEX_IN_BALL_0; COMPLEX_DIV_EQ_0; + COMPLEX_SUB_0; CX_INJ; REAL_LT_IMP_NZ; COMPLEX_NORM_DIV; + COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE; REAL_LT_LDIV_EQ; + NORM_ARITH `norm(w - z) = dist(z,w)`; COMPLEX_DIV_LMUL] THEN + REWRITE_TAC[real_ge; COMPLEX_RING `z + w - z:complex = w`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; COMPLEX_NORM_NZ] THEN + DISCH_TAC THEN REWRITE_TAC[COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_MUL; COMPLEX_NORM_NZ]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. (f:complex->complex) z - a`; `n:complex->bool`; + `b - a:complex`; `z:complex`] + lemma6) THEN + ASM_SIMP_TAC[COMPLEX_SUB_0; HOLOMORPHIC_ON_SUB; ETA_AX; HOLOMORPHIC_ON_CONST; + COMPLEX_RING `x - a:complex = y - a <=> x = y`] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[EXISTS_OR_THM] THEN MATCH_MP_TAC(TAUT + `(p ==> r) /\ (~r /\ q ==> s) ==> p \/ q ==> r \/ s`) THEN + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`f:complex->complex`; `z:complex`; `ball(z:complex,r)`] + HOLOMORPHIC_ON_EXTEND_BOUNDED) THEN + ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + ASM SET_TAC[]; + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`)] THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT; FORALL_IN_IMAGE; IN_BALL; IN_DELETE] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `r:real` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_BALL; DIST_NZ; IN_DELETE] THEN + ASM_MESON_TAC[NORM_ARITH `norm(x - y) <= B ==> norm(x) <= norm(y) + B`; + DIST_SYM]; + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:complex->complex) z` THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + MAP_EVERY EXISTS_TAC [`g:complex->complex`; `ball(z:complex,r)`] THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; IN_DELETE] THEN + ASM_SIMP_TAC[GSYM CONTINUOUS_AT] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; OPEN_BALL; + CONTINUOUS_ON_EQ_CONTINUOUS_AT; CENTRE_IN_BALL]]; + MP_TAC(ISPECL [`\z. inv((f:complex->complex) z - a)`; + `z:complex`; `ball(z:complex,r)`] + HOLOMORPHIC_ON_EXTEND_BOUNDED) THEN + ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_INV THEN REWRITE_TAC[COMPLEX_SUB_0] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + REWRITE_TAC[HOLOMORPHIC_ON_CONST; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + ASM SET_TAC[]; + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`)] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + SIMP_TAC[EVENTUALLY_AT; o_DEF; FORALL_IN_IMAGE; IN_BALL; IN_DELETE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN + EXISTS_TAC `r:real` THEN ASM_MESON_TAC[DIST_NZ; DIST_SYM]; + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `((g:complex->complex) --> g z) (at z)` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM CONTINUOUS_AT] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; OPEN_BALL; + CONTINUOUS_ON_EQ_CONTINUOUS_AT; CENTRE_IN_BALL]; + ALL_TAC] THEN + ASM_CASES_TAC `(g:complex->complex) z = Cx(&0)` THENL + [EXISTS_TAC `Cx(&0)` THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\w:complex. g(w) / (Cx(&1) + a * g w)` THEN + EXISTS_TAC `ball(z:complex,r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_DEF] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(g = Cx(&0)) /\ inv(g) = f - a + ==> (Cx(&1) + a * g) / g = f`) THEN + ASM_SIMP_TAC[IN_DELETE; COMPLEX_INV_INV; COMPLEX_INV_EQ_0] THEN + REWRITE_TAC[COMPLEX_SUB_0] THEN ASM SET_TAC[]; + SUBST1_TAC(COMPLEX_FIELD + `Cx(&0) = Cx(&0) / (Cx(&1) + a * Cx(&0))`) THEN + MATCH_MP_TAC LIM_COMPLEX_DIV THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC; CONV_TAC COMPLEX_RING] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN REWRITE_TAC[LIM_CONST] THEN + ASM_MESON_TAC[]]; + EXISTS_TAC `g(z:complex) / (Cx(&1) + a * g z)` THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\w:complex. g(w) / (Cx(&1) + a * g w)` THEN + EXISTS_TAC `ball(z:complex,r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_DEF] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(g = Cx(&0)) /\ inv(g) = f - a + ==> (Cx(&1) + a * g) / g = f`) THEN + ASM_SIMP_TAC[IN_DELETE; COMPLEX_INV_INV; COMPLEX_INV_EQ_0] THEN + REWRITE_TAC[COMPLEX_SUB_0] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_DIV THEN + ASM_SIMP_TAC[LIM_ADD; LIM_COMPLEX_MUL; LIM_CONST] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&0) / g(z:complex)`) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\w:complex. (Cx(&1) + a * g w) / g w` THEN + EXISTS_TAC `ball(z:complex,r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; o_DEF] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN + DISCH_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(g = Cx(&0)) /\ inv(g) = f - a + ==> (Cx(&1) + a * g) / g = f`) THEN + ASM_SIMP_TAC[IN_DELETE; COMPLEX_INV_INV; COMPLEX_INV_EQ_0] THEN + REWRITE_TAC[COMPLEX_SUB_0] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_DIV THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[LIM_ADD; LIM_CONST; LIM_COMPLEX_MUL]]]);; + +let GREAT_PICARD_ALT = prove + (`!f n z. + open n /\ z IN n /\ f holomorphic_on (n DELETE z) /\ + ~(?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) + ==> ?a. (:complex) DELETE a SUBSET IMAGE f (n DELETE z)`, + REPEAT STRIP_TAC THEN + MP_TAC(GENL [`a:complex`; `b:complex`] + (ISPECL [`f:complex->complex`; `n:complex->bool`; `a:complex`; `b:complex`; + `z:complex`] GREAT_PICARD)) THEN + ASM_REWRITE_TAC[IN_DELETE; SUBSET; IN_UNIV; IN_IMAGE] THEN MESON_TAC[]);; + +let GREAT_PICARD_INFINITE = prove + (`!f n z. + open n /\ z IN n /\ f holomorphic_on (n DELETE z) /\ + ~(?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) + ==> ?a. !w. ~(w = a) ==> INFINITE {x | x IN n DELETE z /\ f x = w}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] + `(!a b. ~(a = b) /\ ~(P a) /\ ~(P b) ==> F) + ==> ?a. !w. ~(w = a) ==> P w`) THEN + MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN + REWRITE_TAC[INFINITE; GSYM FINITE_UNION; SET_RULE + `{x | x IN s /\ f x = a} UNION {x | x IN s /\ f x = b} = + {x | x IN s /\ f x IN {a,b}}`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `?r. &0 < r /\ ball(z:complex,r) SUBSET n /\ + !x. x IN n DELETE z /\ f x IN {a:complex, b} ==> ~(x IN ball(z,r))` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC + `{x | x IN n DELETE z /\ (f:complex->complex) x IN {a, b}} = {}` + THENL [EXISTS_TAC `r:real` THEN ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `min r (inf (IMAGE (\x. dist(z,x)) + {x | x IN n DELETE z /\ + (f:complex->complex) x IN {a, b}}))` THEN + REWRITE_TAC[IN_BALL; REAL_LT_MIN] THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + SIMP_TAC[IN_DELETE; DIST_NZ; DIST_SYM] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_REFL]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET_BALLS; REAL_MIN_LE; DIST_REFL; REAL_ADD_LID; + REAL_LE_REFL]; + MP_TAC(ISPECL [`f:complex->complex`; `ball(z:complex,r)`; + `a:complex`; `b:complex`; `z:complex`] GREAT_PICARD) THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOLOMORPHIC_ON_SUBSET)) THEN + ASM SET_TAC[]]);; + +let CASORATI_WEIERSTRASS = prove + (`!f n z. + open n /\ z IN n /\ f holomorphic_on (n DELETE z) /\ + ~(?l. (f --> l) (at z) \/ ((inv o f) --> l) (at z)) + ==> closure(IMAGE f (n DELETE z)) = (:complex)`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `a:complex` o MATCH_MP GREAT_PICARD_ALT) THEN + MATCH_MP_TAC(SET_RULE + `!t. t SUBSET s /\ t = UNIV ==> s = UNIV`) THEN + EXISTS_TAC `closure((:complex) DELETE a)` THEN + ASM_SIMP_TAC[SUBSET_CLOSURE] THEN + REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN + REWRITE_TAC[CLOSURE_COMPLEMENT; INTERIOR_SING; DIFF_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* A big chain of equivalents of simple connectedness for an open set. *) +(* ------------------------------------------------------------------------- *) + +let [SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO; + SIMPLY_CONNECTED_EQ_PATH_INTEGRAL_ZERO; + SIMPLY_CONNECTED_EQ_GLOBAL_PRIMITIVE; + SIMPLY_CONNECTED_EQ_HOLOMORPHIC_LOG; + SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT; + SIMPLY_CONNECTED_EQ_INJECTIVE_HOLOMORPHIC_SQRT; + SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC; + SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] = + (CONJUNCTS o prove) + (`(!s. open s + ==> (simply_connected s <=> + connected s /\ + !g z. path g /\ path_image g SUBSET s /\ + pathfinish g = pathstart g /\ ~(z IN s) + ==> winding_number(g,z) = Cx(&0))) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !g f. valid_path g /\ path_image g SUBSET s /\ + pathfinish g = pathstart g /\ f holomorphic_on s + ==> (f has_path_integral Cx(&0)) g)) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !f. f holomorphic_on s + ==> ?h. !z. z IN s + ==> (h has_complex_derivative f(z)) (at z))) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g holomorphic_on s /\ + !z. z IN s ==> f z = cexp(g z))) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g holomorphic_on s /\ + !z. z IN s ==> f z = g z pow 2)) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ?g. g holomorphic_on s /\ + !z. z IN s ==> f z = g z pow 2)) /\ + (!s. open s + ==> (simply_connected s <=> + s = {} \/ s = (:complex) \/ + ?f g. f holomorphic_on s /\ g holomorphic_on ball(Cx(&0),&1) /\ + (!z. z IN s ==> f(z) IN ball(Cx(&0),&1) /\ g(f z) = z) /\ + (!z. z IN ball(Cx(&0),&1) ==> g(z) IN s /\ f(g z) = z))) /\ + (!s. open s + ==> (simply_connected(s:complex->bool) <=> + s = {} \/ s homeomorphic ball(Cx(&0),&1)))`, + REWRITE_TAC[AND_FORALL_THM; TAUT + `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + X_GEN_TAC `s:complex->bool` THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT + `(p0 ==> p1) /\ (p1 ==> p2) /\ (p2 ==> p3) /\ (p3 ==> p4) /\ + (p4 ==> p5) /\ (p5 ==> p6) /\ (p6 ==> p7) /\ (p7 ==> p8) /\ (p8 ==> p0) + ==> (p0 <=> p1) /\ (p0 <=> p2) /\ + (p0 <=> p3) /\ (p0 <=> p4) /\ + (p0 <=> p5) /\ (p0 <=> p6) /\ (p0 <=> p7) /\ (p0 <=> p8)`) THEN + REPEAT CONJ_TAC THENL + [SIMP_TAC[SIMPLY_CONNECTED_IMP_CONNECTED] THEN + MESON_TAC[SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO]; + + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CAUCHY_THEOREM_GLOBAL THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[VALID_PATH_IMP_PATH]; + + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `f:complex->complex` THEN + ASM_CASES_TAC `s:complex->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN EXISTS_TAC + `\z. path_integral + (@g. vector_polynomial_function g /\ path_image g SUBSET s /\ + pathstart g = a /\ pathfinish g = z) + f` THEN + X_GEN_TAC `x:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[has_complex_derivative] THEN + REWRITE_TAC[has_derivative_at; LINEAR_COMPLEX_MUL] THEN + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\y. inv(norm(y - x)) % (path_integral(linepath(x,y)) f - + f x * (y - x))` THEN + REWRITE_TAC[VECTOR_ARITH + `i % (x - a) - i % (y - (z + a)) = i % (x + z - y)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN MP_TAC(ISPEC + `s:complex->bool` CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(y:complex) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_CBALL; REAL_LT_IMP_LE; DIST_SYM]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `y:complex` th) THEN MP_TAC(SPEC `x:complex` th)) THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY ABBREV_TAC + [`g1 = @g. vector_polynomial_function g /\ path_image g SUBSET s /\ + pathstart g = (a:complex) /\ pathfinish g = x`; + `g2 = @g. vector_polynomial_function g /\ path_image g SUBSET s /\ + pathstart g = (a:complex) /\ pathfinish g = y`] THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SELECT_RULE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`g1 ++ linepath (x:complex,y) ++ reversepath g2`; + `f:complex->complex`]) THEN + ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + SUBGOAL_THEN `segment[x:complex,y] SUBSET s` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball(x:complex,d)` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CBALL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_SIMP_TAC[IN_CBALL; DIST_REFL] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; DIST_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN + `f path_integrable_on g1 /\ f path_integrable_on g2 /\ + f path_integrable_on linepath(x,y)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN + MATCH_MP_TAC PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE THEN + EXISTS_TAC `s:complex->bool` THEN + ASM_SIMP_TAC[VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + ASM_REWRITE_TAC[VALID_PATH_LINEPATH; PATH_IMAGE_LINEPATH]; + ALL_TAC] THEN + ANTS_TAC THENL + [ALL_TAC; DISCH_THEN(MP_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE)] THEN + ASM_SIMP_TAC[VALID_PATH_JOIN_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHFINISH_REVERSEPATH; PATHSTART_LINEPATH; + PATHFINISH_LINEPATH; VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION; + PATH_IMAGE_JOIN; PATH_IMAGE_LINEPATH; + PATH_IMAGE_REVERSEPATH; PATHSTART_REVERSEPATH; + VALID_PATH_LINEPATH; VALID_PATH_REVERSEPATH; UNION_SUBSET; + PATH_INTEGRAL_JOIN; PATH_INTEGRABLE_JOIN; + PATH_INTEGRABLE_REVERSEPATH; PATH_INTEGRAL_REVERSEPATH] THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[LIM_AT] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:complex->complex) continuous at x` MP_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + CONTINUOUS_ON_EQ_CONTINUOUS_AT]; + ALL_TAC] THEN + REWRITE_TAC[continuous_at; dist; VECTOR_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:complex`) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `y:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `f path_integrable_on linepath(x,y)` MP_TAC THENL + [MATCH_MP_TAC PATH_INTEGRABLE_CONTINUOUS_LINEPATH THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + CONTINUOUS_ON_EQ_CONTINUOUS_AT]; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(x:complex,d2)` THEN CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_INSERT; NOT_IN_EMPTY; dist] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[dist; NORM_0; VECTOR_SUB_REFL] THEN + ASM_MESON_TAC[NORM_SUB]; + ASM_REWRITE_TAC[SUBSET; dist; IN_BALL]]]; + ALL_TAC] THEN + REWRITE_TAC[path_integrable_on; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:complex` THEN + MP_TAC(SPECL [`x:complex`; `y:complex`; `(f:complex->complex) x`] + HAS_PATH_INTEGRAL_CONST_LINEPATH) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP PATH_INTEGRAL_UNIQUE) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_PATH_INTEGRAL_NEG) THEN + REWRITE_TAC[COMPLEX_NEG_SUB] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN + ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC HAS_PATH_INTEGRAL_BOUND_LINEPATH THEN + EXISTS_TAC `\w. (f:complex->complex) w - f x` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 <= e / &2`] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[REAL_LET_TRANS; SEGMENT_BOUND]]; + + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `f:complex->complex` THEN + ASM_CASES_TAC `s:complex->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\z. complex_derivative f z / f z`) THEN + ASM_SIMP_TAC[HOLOMORPHIC_COMPLEX_DERIVATIVE; + HOLOMORPHIC_ON_DIV; ETA_AX] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`\z:complex. cexp(g z) / f z`; `s:complex->bool`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN + `Cx(&0) = ((complex_derivative f z / f z * cexp(g z)) * f z - + cexp(g z) * complex_derivative f z) / f z pow 2` + SUBST1_TAC THENL + [ASM_SIMP_TAC[COMPLEX_FIELD + `~(z = Cx(&0)) ==> (d / z * e) * z = e * d`] THEN + SIMPLE_COMPLEX_ARITH_TAC; + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DIV_AT THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_CEXP]; + ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN; complex_differentiable; + HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]]]; + DISCH_THEN(X_CHOOSE_THEN `c:complex` MP_TAC) THEN + ASM_CASES_TAC `c = Cx(&0)` THENL + [ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(x = Cx(&0)) /\ ~(y = Cx(&0)) ==> ~(x / y = Cx(&0))`] THEN + ASM_MESON_TAC[]; + ASM_SIMP_TAC[COMPLEX_FIELD + `~(y = Cx(&0)) /\ ~(z = Cx(&0)) + ==> (x / y = z <=> y = inv(z) * x)`] THEN + DISCH_TAC THEN EXISTS_TAC `\z:complex. clog(inv c) + g z` THEN + ASM_SIMP_TAC[CEXP_CLOG; CEXP_ADD; COMPLEX_INV_EQ_0] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_ADD THEN + REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_OPEN]]]; + + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN + ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN + CONV_TAC COMPLEX_RING; + + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[]; + + POP_ASSUM MP_TAC THEN SPEC_TAC(`s:complex->bool`,`s:complex->bool`) THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; FORALL_AND_THM] THEN + SUBGOAL_THEN + `!s:complex->bool. + open s /\ connected s /\ Cx(&0) IN s /\ s SUBSET ball(Cx(&0),&1) /\ + (!f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ?g. g holomorphic_on s /\ (!z. z IN s ==> f z = g z pow 2)) + ==> ?f g. f holomorphic_on s /\ + g holomorphic_on ball(Cx(&0),&1) /\ + (!z. z IN s ==> f z IN ball(Cx(&0),&1) /\ g(f z) = z) /\ + (!z. z IN ball(Cx(&0),&1) ==> g z IN s /\ f(g z) = z)` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `s = (:complex)` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?a b:complex. a IN s /\ ~(b IN s)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?f. f holomorphic_on s /\ + f(a) = Cx(&0) /\ + IMAGE f s SUBSET ball(Cx(&0),&1) /\ + (!w z. w IN s /\ z IN s /\ f w = f z ==> w = z)` + MP_TAC THENL + [FIRST_X_ASSUM(K ALL_TAC o SPEC `(:complex)`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\z:complex. z - b`) THEN ANTS_TAC THENL + [SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_ID; + COMPLEX_RING `x - b:complex = y - b <=> x = y`] THEN + ASM_MESON_TAC[COMPLEX_SUB_0]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_EQ_SUB_RADD] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:complex->bool`; `g:complex->complex`] + OPEN_MAPPING_THM) THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:complex`) THEN ASM_REWRITE_TAC[SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN ANTS_TAC THENL + [SUBGOAL_THEN `a IN ball(a,d) /\ (a + Cx(d / &2)) IN ball(a,d) /\ + ~(a + Cx(d / &2) = a)` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; + COMPLEX_EQ_ADD_LCANCEL_0; CX_INJ] THEN + REWRITE_TAC[IN_BALL; NORM_ARITH `dist(a,a + d) = norm d`] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `ball(a:complex,d)`) THEN + ASM_REWRITE_TAC[OPEN_BALL] THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `(g:complex->complex) a`) THEN + ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!z:complex. z IN s ==> ~(g(z) IN ball(--(g a),r))` + MP_TAC THENL + [REWRITE_TAC[IN_BALL] THEN X_GEN_TAC `z:complex` THEN + REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `--((g:complex->complex) z)`) THEN + ASM_REWRITE_TAC[IN_BALL; NORM_ARITH `dist(w,--z) = dist(--w,z)`] THEN + REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN X_GEN_TAC `w:complex` THEN + ASM_CASES_TAC `w:complex = z` THENL + [ASM_REWRITE_TAC[COMPLEX_RING `--z = z <=> z = Cx(&0)`] THEN + ASM_MESON_TAC[COMPLEX_RING `Cx(&0) pow 2 + b = b`]; + ASM_MESON_TAC[COMPLEX_RING `(--z:complex) pow 2 = z pow 2`]]; + REWRITE_TAC[IN_BALL; NORM_ARITH `dist(--a,b) = norm(b + a)`] THEN + ASM_CASES_TAC `!z:complex. z IN s ==> ~(g z + g a = Cx(&0))` THENL + [REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC; + ASM_MESON_TAC[COMPLEX_NORM_0]] THEN + EXISTS_TAC `\z:complex. + Cx(r / &3) / (g z + g a) - Cx(r / &3) / (g a + g a)` THEN + REWRITE_TAC[COMPLEX_SUB_REFL] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + REWRITE_TAC[HOLOMORPHIC_ON_CONST] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_CONST; ETA_AX]; + ASM_SIMP_TAC[IMP_CONJ; CX_INJ; REAL_LT_IMP_NZ; + REAL_ARITH `&0 < r ==> ~(r / &3 = &0)`; + COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(x + k = Cx(&0)) /\ ~(y + k = Cx(&0)) + ==> (a / (x + k) - c = a / (y + k) - c <=> x = y)`] THEN + CONJ_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]] THEN + REWRITE_TAC[FORALL_IN_IMAGE; COMPLEX_SUB_LZERO; NORM_NEG] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x) <= &1 / &3 /\ norm(y) <= &1 / &3 + ==> norm(x - y) < &1`) THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_DIV] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH + `r / &3 / x <= &1 / &3 <=> r / x <= &1`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT; COMPLEX_NORM_NZ] THEN + ASM_SIMP_TAC[REAL_MUL_LID]]]; + REWRITE_TAC[MESON[] + `(!x y. P x /\ P y /\ f x = f y ==> x = y) <=> + (!x y. P x /\ P y ==> (f x = f y <=> x = y))`] THEN + DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:complex->complex`; `s:complex->bool`] + HOLOMORPHIC_ON_INVERSE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `k:complex->complex` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (h:complex->complex) s`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]; + ASM SET_TAC[]; + REWRITE_TAC[FORALL_IN_IMAGE]] THEN + X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(f:complex->complex) o (h:complex->complex)`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_COMPOSE]; ALL_TAC] THEN + ASM_REWRITE_TAC[o_THM] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:complex->complex) o (k:complex->complex)` THEN + ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `f:complex->complex` + (X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(f:complex->complex) o (h:complex->complex)` THEN + EXISTS_TAC `(k:complex->complex) o (g:complex->complex)` THEN + ASM_SIMP_TAC[o_THM; HOLOMORPHIC_ON_COMPOSE] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE; ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN + ASM SET_TAC[]]] THEN + X_GEN_TAC `s:complex->bool` THEN STRIP_TAC THEN + ABBREV_TAC + `ff = { h | h holomorphic_on s /\ + IMAGE h s SUBSET ball(Cx(&0),&1) /\ + h(Cx(&0)) = Cx(&0) /\ + (!x y. x IN s /\ y IN s ==> (h x = h y <=> x = y))}` THEN + SUBGOAL_THEN `(\z:complex. z) IN ff` MP_TAC THENL + [EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM; IMAGE_ID] THEN + ASM_REWRITE_TAC[HOLOMORPHIC_ON_ID]; + ASM_CASES_TAC `ff:(complex->complex)->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN DISCH_TAC] THEN + SUBGOAL_THEN `!h. h IN ff ==> h holomorphic_on s` ASSUME_TAC THENL + [EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]; ALL_TAC] THEN + SUBGOAL_THEN + `?f:complex->complex. + f IN ff /\ + (!h. h IN ff + ==> norm(complex_derivative h (Cx(&0))) + <= norm(complex_derivative f (Cx(&0))))` + MP_TAC THENL + [MP_TAC(ISPEC + `{ norm(complex_derivative h (Cx(&0))) | h IN ff}` SUP) THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; COMPLEX_SUB_LZERO; + dist; NORM_NEG] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(r):real` THEN X_GEN_TAC `f:complex->complex` THEN + EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM; FORALL_IN_IMAGE; SUBSET] THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; COMPLEX_SUB_LZERO; + dist; NORM_NEG] THEN + STRIP_TAC THEN + MP_TAC(ISPEC `\z. (f:complex->complex) (Cx(r) * z)` + SCHWARZ_LEMMA) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO] THEN + SUBGOAL_THEN + `!z. z IN ball(Cx(&0),&1) + ==> ((\z. f (Cx r * z)) has_complex_derivative + complex_derivative f (Cx(r) * z) * Cx(r)) (at z)` + (LABEL_TAC "*") + THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[o_DEF] COMPLEX_DIFF_CHAIN_AT) THEN + CONJ_TAC THENL + [COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_RID]; + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE]] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + ASM_SIMP_TAC[GSYM COMPLEX_IN_BALL_0; REAL_LT_LMUL_EQ]; + ALL_TAC] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[holomorphic_on] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + ASM_SIMP_TAC[GSYM COMPLEX_IN_BALL_0; REAL_LT_LMUL_EQ]]; + REMOVE_THEN "*" (MP_TAC o SPEC `Cx(&0)`) THEN + REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01] THEN + DISCH_THEN(SUBST1_TAC o + MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_NORM_MUL] THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; real_abs; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; real_div; REAL_MUL_LID]]; + ALL_TAC] THEN + ABBREV_TAC + `l = sup { norm(complex_derivative h (Cx(&0))) | h IN ff}` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?f. (!n. (f n) IN ff) /\ + ((\n. Cx(norm(complex_derivative (f n) (Cx(&0))))) --> Cx(l)) + sequentially` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `!n. ?f. f IN ff /\ + abs(norm(complex_derivative f (Cx(&0))) - l) < inv(&n + &1)` + MP_TAC THENL + [X_GEN_TAC `n:num` THEN + FIRST_ASSUM(MP_TAC o SPEC `l - inv(&n + &1)` o CONJUNCT2) THEN + REWRITE_TAC[REAL_ARITH `l <= l - i <=> ~(&0 < i)`; REAL_LT_INV_EQ; + REAL_ARITH `&0 < &n + &1`; NOT_FORALL_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:complex->complex` THEN + ASM_CASES_TAC `(f:complex->complex) IN ff` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `n <= l ==> ~(n <= l - e) ==> abs(n - l) < e`) THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `f:num->complex->complex` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN + DISCH_THEN(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&m + &1)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_SUB] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:num->complex->complex`; `ff:(complex->complex)->bool`; + `s:complex->bool`] MONTEL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; COMPLEX_SUB_LZERO; + dist; NORM_NEG] THEN + MESON_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `g complex_differentiable (at(Cx(&0))) /\ + norm(complex_derivative g (Cx(&0))) = l` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`(f:num->complex->complex) o (r:num->num)`; + `(\n:num z. complex_derivative (f n) z) o (r:num->num)`; + `g:complex->complex`; `s:complex->bool`] + HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE) THEN + ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `s:complex->bool` THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`cball(z:complex,d)`; `e:real`]) THEN + ASM_REWRITE_TAC[COMPACT_CBALL; GE] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `g':complex->complex` MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&0)`) THEN + ASM_REWRITE_TAC[IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o ISPEC `\z:complex. Cx(norm z)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] LIM_CONTINUOUS_FUNCTION)) THEN + REWRITE_TAC[CONTINUOUS_AT_CX_NORM] THEN DISCH_TAC THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[complex_differentiable]; ALL_TAC] THEN + GEN_REWRITE_TAC I [GSYM CX_INJ] THEN + FIRST_ASSUM(SUBST1_TAC o + MATCH_MP HAS_COMPLEX_DERIVATIVE_DERIVATIVE) THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC + `\n. Cx(norm(complex_derivative(f((r:num->num) n)) (Cx(&0))))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MP_TAC(ISPECL + [`\n:num. Cx(norm(complex_derivative (f n) (Cx(&0))))`; + `r:num->num`; `Cx l`] LIM_SUBSEQUENCE) THEN + ASM_REWRITE_TAC[o_DEF]]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `~(?c. !z. z IN s ==> (g:complex->complex) z = c)` + ASSUME_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `c:complex`) THEN + SUBGOAL_THEN `complex_derivative g (Cx(&0)) = Cx(&0)` MP_TAC THENL + [MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + MAP_EVERY EXISTS_TAC + [`(\z. c):complex->complex`; `s:complex->bool`] THEN + ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_CONST] THEN ASM_MESON_TAC[]; + DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\z:complex. z` o CONJUNCT1) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_DERIVATIVE_ID; COMPLEX_NORM_CX] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN + SUBGOAL_THEN `!z. z IN s ==> norm((g:complex->complex) z) <= &1` + ASSUME_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n:num. (f:num->complex->complex) (r n) z` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + SUBGOAL_THEN + `(f:num->complex->complex) (r(n:num)) IN ff` + MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0; + REAL_LT_IMP_LE]; + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LT_LE] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`g:complex->complex`; `s:complex->bool`; `s:complex->bool`; + `z:complex`] MAXIMUM_MODULUS_PRINCIPLE) THEN + ASM_REWRITE_TAC[SUBSET_REFL]]; + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (f:num->complex->complex) (r n) (Cx(&0))` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `(f:num->complex->complex) (r(n:num)) IN ff` + MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]; + MATCH_MP_TAC(REWRITE_RULE + [MESON[] `(!x y. P x /\ P y /\ f x = f y ==> x = y) <=> + (!x y. P x /\ P y ==> (f x = f y <=> x = y))`] + HURWITZ_INJECTIVE) THEN + EXISTS_TAC `(f:num->complex->complex) o (r:num->num)` THEN + ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `(f:num->complex->complex) (r(n:num)) IN ff` + MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "ff" THEN SIMP_TAC[IN_ELIM_THM]]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:complex->complex` THEN + STRIP_TAC THEN + MP_TAC(SPECL [`f:complex->complex`; `s:complex->bool`] + HOLOMORPHIC_ON_INVERSE) THEN + ANTS_TAC THENL + [UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + DISCH_THEN(MP_TAC o CONJUNCT2)] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + ASM_CASES_TAC `IMAGE (f:complex->complex) s = ball(Cx(&0),&1)` THENL + [ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN + UNDISCH_TAC `~(IMAGE (f:complex->complex) s = ball(Cx(&0),&1))` THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; COMPLEX_IN_BALL_0] THEN + X_GEN_TAC `a:complex` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE; MESON[] + `(?x. a = f x /\ x IN s) <=> ~(!x. x IN s ==> ~(f x = a))`] THEN + DISCH_TAC THEN + MP_TAC(ISPEC `a:complex` BALL_BIHOLOMORPHISM_EXISTS) THEN + ASM_REWRITE_TAC[COMPLEX_IN_BALL_0; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:complex->complex`; `t':complex->complex`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!z. z IN s ==> norm((f:complex->complex) z) < &1` + ASSUME_TAC THENL + [UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + SIMP_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0]; + ALL_TAC] THEN + SUBGOAL_THEN + `?sq. sq holomorphic_on (IMAGE (t o f) s) /\ + !z. z IN s + ==> sq((t:complex->complex) ((f:complex->complex) z)) pow 2 = + t(f z)` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC + `!f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ?g. g holomorphic_on s /\ + (!z. z IN s ==> f z = g z pow 2)` THEN + DISCH_THEN(MP_TAC o SPEC + `(t:complex->complex) o (f:complex->complex)`) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN + UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; COMPLEX_IN_BALL_0]) THEN + REWRITE_TAC[COMPLEX_IN_BALL_0] THEN STRIP_TAC THEN + GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `t':complex->complex`) THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; + UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM_MESON_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `q:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(q:complex->complex) o (g:complex->complex) o + (t':complex->complex)` THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_BALL_0; o_THM] THENL + [ASM_MESON_TAC[]; ASM SET_TAC[]; ASM_MESON_TAC[]]; + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(q:complex->complex) z pow 2` THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + REWRITE_TAC[IN_ELIM_THM; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[COMPLEX_IN_BALL_0] THEN ASM_MESON_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!z. z IN s + ==> norm((sq:complex->complex) + ((t:complex->complex)((f:complex->complex) z))) < &1` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM ABS_SQUARE_LT_1; GSYM COMPLEX_NORM_POW] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC + `(sq:complex->complex) + ((t:complex->complex)((f:complex->complex) (Cx(&0))))` + BALL_BIHOLOMORPHISM_EXISTS) THEN + ASM_SIMP_TAC[COMPLEX_IN_BALL_0; NOT_IMP; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`r:complex->complex`; `r':complex->complex`] THEN + STRIP_TAC THEN UNDISCH_TAC + `!h. h IN ff + ==> norm(complex_derivative h (Cx(&0))) <= + norm(complex_derivative f (Cx(&0)))` THEN + DISCH_THEN(fun th -> MP_TAC(SPEC + `(r:complex->complex) o (sq:complex->complex) o + (t:complex->complex) o (f:complex->complex)` th) THEN + MP_TAC(SPEC `\z:complex. z` th)) THEN + ASM_REWRITE_TAC[COMPLEX_DERIVATIVE_ID; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + DISCH_TAC THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LE] THEN + EXPAND_TAC "ff" THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC) THEN + ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN + ASM_SIMP_TAC[]; + ASM_SIMP_TAC[o_THM]; + MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN STRIP_TAC THEN + EQ_TAC THEN SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `r':complex->complex`) THEN + ASM_SIMP_TAC[o_THM] THEN + DISCH_THEN(MP_TAC o AP_TERM `\z:complex. z pow 2`) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `t':complex->complex`) THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; + STRIP_TAC] THEN + MP_TAC(ISPEC + `(t':complex->complex) o (\z. z pow 2) o (r':complex->complex)` + SCHWARZ_LEMMA) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC) THEN + SIMP_TAC[HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN + ASM_SIMP_TAC[COMPLEX_NORM_POW; ABS_SQUARE_LT_1; REAL_ABS_NORM]; + ASM_SIMP_TAC[COMPLEX_NORM_POW; ABS_SQUARE_LT_1; REAL_ABS_NORM; o_THM]; + UNDISCH_THEN `(r:complex->complex) ((sq:complex->complex) + ((t:complex->complex) (f(Cx(&0))))) = Cx(&0)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM th]) THEN + ASM_SIMP_TAC[o_THM] THEN + UNDISCH_TAC `(f:complex->complex) IN ff` THEN EXPAND_TAC "ff" THEN + SIMP_TAC[IN_ELIM_THM]]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN MATCH_MP_TAC + (TAUT `~r /\ (p /\ ~q ==> s) ==> p /\ (q' \/ q ==> r) ==> s`) THEN + CONJ_TAC THENL + [REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN + ASM_CASES_TAC `c = Cx(&0)` THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `(r:complex->complex) (--(Cx(&1) / Cx(&2)))` th) THEN + MP_TAC(ISPEC `(r:complex->complex) (Cx(&1) / Cx(&2))` th)) THEN + MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r) + ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(MESON[] + `~(b1 = b2) /\ a1 = a2 ==> (a1 = b1 /\ a2 = b2 ==> F)`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL] THEN + DISCH_THEN(MP_TAC o AP_TERM `r':complex->complex`) THEN + FIRST_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o + lhand o lhand o snd)) THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(COMPLEX_RING + `x = --(Cx(&1) / Cx(&2)) ==> ~(Cx(&1) / Cx(&2) = x)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + REWRITE_TAC[o_DEF] THEN AP_TERM_TAC THEN + MATCH_MP_TAC(COMPLEX_RING + `x = Cx(&1) / Cx(&2) /\ y = --(Cx(&1) / Cx(&2)) + ==> x pow 2 = y pow 2`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_NEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV]; + REWRITE_TAC[GSYM REAL_LT_LE] THEN DISCH_TAC THEN + UNDISCH_TAC `&1 <= norm (complex_derivative f (Cx(&0)))` THEN + SUBGOAL_THEN + `complex_derivative f (Cx(&0)) = + complex_derivative (t' o (\z:complex. z pow 2) o r') (Cx(&0)) * + complex_derivative + (r o (sq:complex->complex) o (t:complex->complex) o f) (Cx(&0))` + (fun th -> REWRITE_TAC[th; COMPLEX_NORM_MUL]) + THENL + [ALL_TAC; + REWRITE_TAC[REAL_ARITH `a * b < b <=> &0 < (&1 - a) * b`] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REAL_ARITH `&1 <= x ==> ~(x = &0)`)) THEN + SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; GSYM NORM_POS_LT; DE_MORGAN_THM] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_DERIVATIVE THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `((t':complex->complex) o + (\z:complex. z pow 2) o (r':complex->complex)) o + ((r:complex->complex) o (sq:complex->complex) o + (t:complex->complex) o (f:complex->complex))` THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[o_THM]; ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFF_CHAIN_AT THEN + ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE] THEN + CONJ_TAC THEN MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THENL + [EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `ball(Cx(&0),&1)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN + REPEAT(MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN CONJ_TAC) THEN + SIMP_TAC[HOLOMORPHIC_ON_POW; HOLOMORPHIC_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOLOMORPHIC_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; COMPLEX_IN_BALL_0] THEN + ASM_SIMP_TAC[COMPLEX_NORM_POW; ABS_SQUARE_LT_1; REAL_ABS_NORM]]]]; + ASM_CASES_TAC `s:complex->bool = {}` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `s = (:complex)` THEN ASM_REWRITE_TAC[] THENL + [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_BALL_UNIV THEN REWRITE_TAC[REAL_LT_01]; + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON]]; + STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN + SIMP_TAC[CONVEX_IMP_SIMPLY_CONNECTED; CONVEX_BALL]]);; + +let CONTRACTIBLE_EQ_SIMPLY_CONNECTED_2D = prove + (`!s:real^2->bool. open s ==> (contractible s <=> simply_connected s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + REWRITE_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED] THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONTRACTIBLE_EMPTY] THEN + ASM_MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ; CONVEX_IMP_CONTRACTIBLE; + CONVEX_BALL]);; + +(* ------------------------------------------------------------------------- *) +(* A further chain of equivalents about components of the complement of a *) +(* simply connected set (following 1.35 in Burckel's book). *) +(* ------------------------------------------------------------------------- *) + +let [SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES; + SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS; + SIMPLY_CONNECTED_EQ_EMPTY_INSIDE] = (CONJUNCTS o prove) + (`(!s:complex->bool. + open s + ==> (simply_connected s <=> + connected s /\ + if bounded s then connected(frontier s) + else !c. c IN components(frontier s) ==> ~bounded c)) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !c. c IN components ((:complex) DIFF s) ==> ~bounded c)) /\ + (!s:complex->bool. + open s ==> (simply_connected s <=> connected s /\ inside s = {}))`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:complex->bool` THEN + ASM_CASES_TAC `open(s:complex->bool)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT + `(q3 ==> p) /\ (q2 ==> q3) /\ (q1 ==> q2) /\ (p ==> q1) + ==> (p <=> q1) /\ (p <=> q2) /\ (p <=> q3)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INSIDE_OUTSIDE] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = {} <=> + !x. ~(x IN s) ==> x IN t`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO] THEN + GEN_TAC THEN X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + MATCH_MP_TAC WINDING_NUMBER_ZERO_IN_OUTSIDE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_MONO) THEN ASM SET_TAC[]; + REWRITE_TAC[components; FORALL_IN_GSPEC; inside] THEN SET_TAC[]; + ASM_CASES_TAC `connected(s:complex->bool)` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THENL + [DISCH_TAC THEN + REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN + ASM_CASES_TAC `s:complex->bool = {}` THEN + ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_EQ_SELF; + CONNECTED_UNIV; IN_UNIV; NOT_BOUNDED_UNIV] THEN + ASM_CASES_TAC `s = (:complex)` THENL + [ASM_MESON_TAC[NOT_BOUNDED_UNIV]; ALL_TAC] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY) THEN + REWRITE_TAC[outside; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `z:complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `connected_component ((:complex) DIFF s) w = + connected_component ((:complex) DIFF s) z` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC JOINABLE_CONNECTED_COMPONENT_EQ THEN + EXISTS_TAC `frontier s :complex->bool` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `i = s ==> s' DIFF i SUBSET UNIV DIFF s`) THEN + ASM_REWRITE_TAC[INTERIOR_EQ]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN CONJ_TAC THEN + MATCH_MP_TAC(SET_RULE + `frontier c SUBSET c /\ frontier c SUBSET f /\ ~(frontier c = {}) + ==> ~(c INTER f = {})`) THEN + REWRITE_TAC[FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] THEN + ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; + IN_DIFF; IN_UNIV; CONNECTED_COMPONENT_EQ_UNIV; + SET_RULE `UNIV DIFF s = UNIV <=> s = {}`] THEN + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `c = s ==> c DIFF i SUBSET s`) THEN + ASM_REWRITE_TAC[CLOSURE_EQ] THEN + MATCH_MP_TAC CLOSED_CONNECTED_COMPONENT THEN + ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; + DISCH_TAC THEN REWRITE_TAC[components; FORALL_IN_GSPEC] THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `?z:complex. z IN frontier s /\ + z IN connected_component ((:real^2) DIFF s) w` + STRIP_ASSUME_TAC THENL + [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN + MATCH_MP_TAC(SET_RULE + `frontier c SUBSET c /\ frontier c SUBSET f /\ ~(frontier c = {}) + ==> ?z. z IN f /\ z IN c`) THEN + ASM_REWRITE_TAC[FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] THEN + CONJ_TAC THENL + [REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `c = s ==> c DIFF i SUBSET s`) THEN + ASM_REWRITE_TAC[CLOSURE_EQ] THEN + MATCH_MP_TAC CLOSED_CONNECTED_COMPONENT THEN + ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; + ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; + CONNECTED_COMPONENT_EQ_UNIV; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF s = UNIV <=> s = {}`] THEN + ASM_MESON_TAC[BOUNDED_EMPTY]]; + FIRST_X_ASSUM(MP_TAC o SPEC + `connected_component (frontier s) (z:complex)`) THEN + REWRITE_TAC[components; IN_ELIM_THM] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[CONTRAPOS_THM]] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + SUBGOAL_THEN + `connected_component ((:complex) DIFF s) w = + connected_component ((:complex) DIFF s) z` + SUBST1_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `frontier s :complex->bool` THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET] THEN + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `i = s ==> s' DIFF i SUBSET UNIV DIFF s`) THEN + ASM_REWRITE_TAC[INTERIOR_EQ]]]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + ASSUME_TAC(MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED th) THEN MP_TAC th) THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY; FRONTIER_EMPTY; CONNECTED_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism] THEN + MAP_EVERY X_GEN_TAC [`g:real^2->real^2`; `f:real^2->real^2`] THEN + STRIP_TAC THEN MAP_EVERY ABBREV_TAC + [`D = \n. ball(vec 0:real^2,&1 - inv(&n + &2))`; + `A = \n. {z:real^2 | &1 - inv(&n + &2) < norm z /\ norm z < &1}`; + `X = \n:num. closure(IMAGE (f:real^2->real^2) (A n))`] THEN + SUBGOAL_THEN + `frontier s = INTERS {X n:real^2->bool | n IN (:num)}` + SUBST1_TAC THENL + [ASM_SIMP_TAC[frontier; INTERIOR_OPEN; INTERS_GSPEC; IN_UNIV] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_DIFF] THEN X_GEN_TAC `x:real^2` THEN + STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN + UNDISCH_TAC `(x:real^2) IN closure s` THEN + SUBGOAL_THEN + `s = IMAGE (f:real^2->real^2) (closure (D(n:num))) UNION IMAGE f (A n)` + SUBST1_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC(SET_RULE + `t UNION u = s /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> IMAGE f s = IMAGE f t UNION IMAGE f u`) THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MAP_EVERY EXPAND_TAC ["A"; "D"] THEN + SIMP_TAC[CLOSURE_BALL; REAL_SUB_LT; REAL_INV_LT_1; + REAL_ARITH `&1 < &n + &2`] THEN + REWRITE_TAC[EXTENSION; IN_UNION; COMPLEX_IN_BALL_0; IN_CBALL_0; + IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ e <= &1 + ==> (x <= &1 - e \/ &1 - e < x /\ x < &1 <=> x < &1)`) THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_INV_LE_1; REAL_ARITH `&1 <= &n + &2`; + REAL_ARITH `&0 < &n + &2`]; + EXPAND_TAC "X" THEN REWRITE_TAC[CLOSURE_UNION] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(x IN s) ==> t SUBSET s ==> x IN t UNION u ==> x IN u`)) THEN + EXPAND_TAC "D" THEN + SIMP_TAC[CLOSURE_BALL; REAL_SUB_LT; REAL_INV_LT_1; + REAL_ARITH `&1 < &n + &2`; COMPACT_CBALL] THEN + MATCH_MP_TAC(SET_RULE + `closure s = s /\ s SUBSET t ==> closure s SUBSET t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[COMPACT_CBALL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + EXPAND_TAC "s" THEN MATCH_MP_TAC IMAGE_SUBSET] THEN + REWRITE_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_CBALL_0] THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> a <= &1 - x ==> a < &1`) THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]; + MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN + CONJ_TAC THENL + [EXPAND_TAC "X" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^2` THEN DISCH_THEN(MP_TAC o SPEC `0`) THEN + SPEC_TAC(`x:real^2`,`x:real^2`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN EXPAND_TAC "s" THEN + MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; COMPLEX_IN_BALL_0] THEN + REAL_ARITH_TAC; + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + MAP_EVERY EXPAND_TAC ["s"; "X"] THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> b ==> ~a`; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^2` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN + DISCH_TAC THEN MP_TAC(SPEC `&1 - norm(x:real^2)` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_SUB_LT; NOT_FORALL_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `!s. y IN s /\ (s INTER t = {}) ==> ~(y IN t)`) THEN + EXISTS_TAC `IMAGE (f:real^2->real^2) (D(n:num))` THEN CONJ_TAC THENL + [MATCH_MP_TAC FUN_IN_IMAGE THEN EXPAND_TAC "D" THEN + REWRITE_TAC[IN_BALL_0] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `n < &1 - x ==> m < n ==> x < &1 - m`)) THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN REAL_ARITH_TAC; + SUBGOAL_THEN `open(IMAGE (f:real^2->real^2) (D(n:num)))` MP_TAC THENL + [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + SUBGOAL_THEN `(D:num->real^2->bool) n SUBSET ball(Cx(&0),&1)` + ASSUME_TAC THENL + [EXPAND_TAC "D" THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC SUBSET_BALL THEN + REWRITE_TAC[REAL_ARITH `&1 - x <= &1 <=> &0 <= x`] THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN REAL_ARITH_TAC; + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + EXPAND_TAC "D" THEN REWRITE_TAC[OPEN_BALL]; + ASM SET_TAC[]]]; + SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE + `!u. (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\ + s UNION t SUBSET u /\ s INTER t = {} + ==> IMAGE f s INTER IMAGE f t = {}`) THEN + EXISTS_TAC `ball(Cx(&0),&1)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY EXPAND_TAC ["D"; "A"] THEN + REWRITE_TAC[COMPLEX_IN_BALL_0; IN_BALL_0; SUBSET; NOT_IN_EMPTY; + IN_UNION; IN_ELIM_THM; IN_INTER; EXTENSION] THEN + CONJ_TAC THENL [GEN_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e ==> x < &1 - e \/ &1 - e < x /\ x < &1 ==> x < &1`) THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]]]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. closed((X:num->complex->bool) n)` ASSUME_TAC THENL + [EXPAND_TAC "X" THEN REWRITE_TAC[CLOSED_CLOSURE]; ALL_TAC] THEN + SUBGOAL_THEN `!n. connected((X:num->complex->bool) n)` ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN EXPAND_TAC "X" THEN + MATCH_MP_TAC CONNECTED_CLOSURE THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + EXPAND_TAC "A" THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_ELIM_THM]; + ONCE_REWRITE_TAC[NORM_ARITH `norm z = norm(z - vec 0)`] THEN + SIMP_TAC[CONNECTED_ANNULUS; DIMINDEX_2; LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. ((X:num->complex->bool) n) SUBSET closure s` + ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "X" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN EXPAND_TAC "s" THEN + MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN + SIMP_TAC[SUBSET; COMPLEX_IN_BALL_0; IN_ELIM_THM]; + ALL_TAC] THEN + SUBGOAL_THEN `!m n. m <= n ==> (X:num->complex->bool) n SUBSET X m` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + EXPAND_TAC "X" THEN MATCH_MP_TAC SUBSET_CLOSURE THEN + MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `n <= m ==> &1 - n < x /\ x < &1 ==> &1 - m < x /\ x < &1`) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_LE_RADD; REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + COND_CASES_TAC THENL + [MATCH_MP_TAC CONNECTED_NEST THEN + ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_CLOSURE]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(bounded((X:num->complex->bool) n))` ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN DISCH_TAC THEN + UNDISCH_TAC `~bounded(s:complex->bool)` THEN EXPAND_TAC "s" THEN + REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC + `IMAGE (f:complex->complex) + (cball(Cx(&0),&1 - inv(&n + &2)) UNION A n)` THEN + CONJ_TAC THENL + [REWRITE_TAC[IMAGE_UNION; BOUNDED_UNION] THEN CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN SIMP_TAC[COMPACT_CBALL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; COMPLEX_IN_CBALL_0; COMPLEX_IN_BALL_0] THEN + GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 < e ==> x <= &1 - e ==> x < &1`) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + BOUNDED_SUBSET)) THEN EXPAND_TAC "X" THEN + REWRITE_TAC[CLOSURE_SUBSET]]; + MATCH_MP_TAC IMAGE_SUBSET THEN EXPAND_TAC "A" THEN + REWRITE_TAC[SUBSET; IN_UNION; COMPLEX_IN_BALL_0; COMPLEX_IN_CBALL_0; + IN_ELIM_THM] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + X_GEN_TAC `c:complex->bool` THEN REPEAT DISCH_TAC THEN + SUBGOAL_THEN `closed(INTERS {X n:complex->bool | n IN (:num)})` + ASSUME_TAC THENL + [ASM_SIMP_TAC[CLOSED_INTERS; FORALL_IN_GSPEC]; ALL_TAC] THEN + SUBGOAL_THEN `closed(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_COMPONENTS]; ALL_TAC] THEN + SUBGOAL_THEN `compact(c:complex->bool)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED]; ALL_TAC] THEN + SUBGOAL_THEN + `?k:complex->bool. + c SUBSET k /\ compact k /\ + k SUBSET INTERS {X n | n IN (:num)} /\ + closed(INTERS {X n | n IN (:num)} DIFF k)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL[`INTERS {X n:complex->bool | n IN (:num)}`;`c:complex->bool`] + SURA_BURA) THEN + ASM_SIMP_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; + CLOSED_IMP_LOCALLY_COMPACT] THEN + MATCH_MP_TAC(MESON[] + `~(c = i {}) /\ (~(f = {}) ==> P) + ==> c = i f ==> P`) THEN + CONJ_TAC THENL + [REWRITE_TAC[INTERS_0] THEN ASM_MESON_TAC[NOT_BOUNDED_UNIV]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:complex->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`k:complex->bool`; + `INTERS {X n:complex->bool | n IN (:num)} DIFF k`] + SEPARATION_NORMAL_COMPACT) THEN + ASM_SIMP_TAC[NOT_EXISTS_THM; SET_RULE `k INTER (s DIFF k) = {}`] THEN + MAP_EVERY X_GEN_TAC [`v:complex->bool`; `v':complex->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `v INTER (INTERS {X n:complex->bool | n IN (:num)} DIFF k) = {}` + ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`closure(v) DIFF v:complex->bool`; + `{X n INTER closure(v:complex->bool) | n IN (:num)}`] + COMPACT_IMP_FIP) THEN + ASM_SIMP_TAC[COMPACT_DIFF; FORALL_IN_GSPEC; CLOSED_INTER; CLOSED_CLOSURE; + NOT_IMP] THEN + CONJ_TAC THENL + [ALL_TAC; + SUBGOAL_THEN + `INTERS {X n INTER closure v :complex->bool | n IN (:num)} = + INTERS {X n | n IN (:num)} INTER closure v` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNIV] THEN + MESON_TAC[]; + MP_TAC(ISPECL [`v':complex->bool`; `v:complex->bool`] + OPEN_INTER_CLOSURE_EQ_EMPTY) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FINITE_SUBSET_IMAGE; SUBSET_UNIV; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `i:num->bool = {}` THENL + [ASM_REWRITE_TAC[IMAGE_CLAUSES; INTERS_0; INTER_UNIV] THEN + MP_TAC(ISPEC `v:complex->bool` FRONTIER_EQ_EMPTY) THEN + ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN DISCH_THEN SUBST1_TAC THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + ASM SET_TAC[]; + ASM_MESON_TAC[CLOSURE_UNIV; COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]]; + ALL_TAC] THEN + SUBGOAL_THEN `?n:num. n IN i /\ !m. m IN i ==> m <= n` + (X_CHOOSE_TAC `p:num`) THENL + [MAP_EVERY UNDISCH_TAC [`~(i:num->bool = {})`; `FINITE(i:num->bool)`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`i:num->bool`,`i:num->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_INSERT_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `i:num->bool`] THEN + ASM_CASES_TAC `i:num->bool = {}` THEN + ASM_REWRITE_TAC[LE_REFL; NOT_IN_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC o CONJUNCT1) THEN + DISJ_CASES_TAC(ARITH_RULE `n:num <= p \/ p <= n`) THEN + ASM_MESON_TAC[LE_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `INTERS (IMAGE (\n:num. X n INTER closure v) i):complex->bool = + X p INTER closure v` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; INTERS_IMAGE; IN_ELIM_THM; IN_INTER] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE + `(c DIFF v) INTER (x INTER c) = {} ==> x INTER c SUBSET v`)) THEN + SUBGOAL_THEN `connected((X:num->complex->bool) p)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CONNECTED_CLOPEN] THEN + DISCH_THEN(MP_TAC o SPEC `(X:num->complex->bool) p INTER closure v`) THEN + REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `(X:num->complex->bool) p INTER closure v = X p INTER v` + SUBST1_TAC THENL + [MP_TAC(ISPEC `v:complex->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN REWRITE_TAC[CLOSED_CLOSURE]; + MATCH_MP_TAC(SET_RULE `!k. k SUBSET s /\ ~(k = {}) ==> ~(s = {})`) THEN + EXISTS_TAC `k:complex->bool` THEN CONJ_TAC THENL + [MP_TAC(ISPEC `v:complex->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + ASM SET_TAC[]]; + DISCH_THEN(MP_TAC o AP_TERM `bounded:(complex->bool)->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `closure v:complex->bool` THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN SET_TAC[]]);; + +let SIMPLY_CONNECTED_IFF_SIMPLE = prove + (`!s:real^2->bool. + open s /\ bounded s + ==> (simply_connected s <=> + connected s /\ connected((:real^2) DIFF s))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS] THEN + ASM_CASES_TAC `connected(s:real^2->bool)` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL + [REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN + EXISTS_TAC `(:real^2) DIFF s` THEN + ASM_SIMP_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + REWRITE_TAC[LE_REFL; DIMINDEX_2]; + DISCH_TAC THEN + ASM_CASES_TAC `(:real^2) DIFF s = {}` THEN + ASM_REWRITE_TAC[COMPONENTS_EMPTY; NOT_IN_EMPTY] THEN + SUBGOAL_THEN `components((:real^2) DIFF s) = {(:real^2) DIFF s}` + SUBST1_TAC THENL [ASM_REWRITE_TAC[COMPONENTS_EQ_SING]; ALL_TAC] THEN + GEN_TAC THEN SIMP_TAC[IN_SING] THEN DISCH_TAC THEN + MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN + ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]]);; + +let CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS = prove + (`!s:real^2->bool. + open s /\ bounded s + ==> (connected((:real^2) DIFF s) <=> + !c. c IN components s ==> simply_connected c)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `!c. c IN components s ==> connected((:real^2) DIFF c)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[NONSEPARATION_BY_COMPONENT_EQ]; ALL_TAC] THEN + ASM_MESON_TAC[SIMPLY_CONNECTED_IFF_SIMPLE; OPEN_COMPONENTS; + IN_COMPONENTS_SUBSET; BOUNDED_SUBSET; IN_COMPONENTS_CONNECTED]);; + +(* ------------------------------------------------------------------------- *) +(* Yet another set of equivalences based on *continuous* logs and sqrts. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG,SIMPLY_CONNECTED_EQ_CONTINUOUS_SQRT = + (CONJ_PAIR o prove) + (`(!s. open s + ==> (simply_connected s <=> + connected s /\ + !f. f continuous_on s /\ (!z:complex. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g continuous_on s /\ + !z. z IN s ==> f z = cexp(g z))) /\ + (!s. open s + ==> (simply_connected s <=> + connected s /\ + !f. f continuous_on s /\ (!z:complex. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g continuous_on s /\ + !z. z IN s ==> f z = g z pow 2))`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:complex->bool` THEN + ASM_CASES_TAC `open(s:complex->bool)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `connected(s:complex->bool)` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; ASM_MESON_TAC[SIMPLY_CONNECTED_IMP_CONNECTED]] THEN + MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:complex->complex`; `h:complex->complex`] THEN + STRIP_TAC THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`(f:complex->complex) o (h:complex->complex)`; `Cx(&0)`; `&1`] + CONTINUOUS_LOGARITHM_ON_BALL) THEN + ASM_REWRITE_TAC[o_THM] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:complex->complex) o (k:complex->complex)` THEN + REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; + DISCH_TAC THEN X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN + ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN + CONV_TAC COMPLEX_RING; + DISCH_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT] THEN + X_GEN_TAC `f:complex->complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + STRIP_TAC THEN ASM_SIMP_TAC[HOLOMORPHIC_ON_OPEN] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `~((g:complex->complex) z = Cx(&0))` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_RING `Cx(&0) pow 2 = Cx(&0)`]; ALL_TAC] THEN + EXISTS_TAC `complex_derivative f z / (Cx(&2) * g z)` THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\x:complex. (f(x) - f(z)) / (x - z) / (g(x) + g(z))` THEN + SUBGOAL_THEN + `?d. &0 < d /\ + !w:complex. w IN s /\ w IN ball(z,d) ==> ~(g w + g z = Cx(&0))` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `z:complex` o + GEN_REWRITE_RULE I [continuous_on]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `norm((g:complex->complex) z)`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN MATCH_MP_TAC MONO_EXISTS THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[IN_BALL; GSYM COMPLEX_VEC_0] THEN + MESON_TAC[NORM_ARITH `dist(z,x) < norm z ==> ~(x + z = vec 0)`]; + ALL_TAC] THEN + EXISTS_TAC `ball(z:complex,d) INTER s` THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL]; + ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(x = z) /\ ~(gx + gz = Cx(&0)) + ==> (gx pow 2 - gz pow 2) / (x - z) / (gx + gz) = + (gx - gz) / (x - z)`) THEN + ASM_SIMP_TAC[]; + MATCH_MP_TAC LIM_COMPLEX_DIV THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; GSYM HAS_COMPLEX_DERIVATIVE_AT] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; CX_INJ] THEN + REWRITE_TAC[COMPLEX_MUL_2; REAL_OF_NUM_EQ; ARITH_EQ] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT]; ALL_TAC] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST; GSYM CONTINUOUS_AT] THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + CONTINUOUS_ON_INTERIOR; INTERIOR_OPEN]]]);; + +(* ------------------------------------------------------------------------- *) +(* Relations to the borsukian property. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLY_CONNECTED_EQ_BORSUKIAN = prove + (`!s:real^2->bool. + open s ==> (simply_connected s <=> connected s /\ borsukian s)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG] THEN + AP_TERM_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN + AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);; + +let BORSUKIAN_EQ_SIMPLY_CONNECTED = prove + (`!s:real^2->bool. + open s + ==> (borsukian s <=> !c. c IN components s ==> simply_connected c)`, + ASM_SIMP_TAC[BORSUKIAN_COMPONENTWISE_EQ; OPEN_IMP_LOCALLY_CONNECTED] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM + (ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] OPEN_COMPONENTS)) THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_BORSUKIAN] THEN + ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]);; + +let BORSUKIAN_SEPARATION_OPEN_CLOSED = prove + (`!s:real^2->bool. + (open s \/ closed s) /\ bounded s + ==> (borsukian s <=> connected((:real^2) DIFF s))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[BORSUKIAN_SEPARATION_COMPACT; COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_SIMP_TAC[BORSUKIAN_EQ_SIMPLY_CONNECTED; + CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS]);; + +(* ------------------------------------------------------------------------- *) +(* A per-function version for continuous logs, a kind of monodromy. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_COMPOSE_CEXP = prove + (`!p. path p + ==> winding_number(cexp o p,Cx(&0)) = + Cx(&1) / (Cx(&2) * Cx pi * ii) * (pathfinish p - pathstart p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !t:real^1. t IN interval[vec 0,vec 1] ==> e <= norm(cexp(p t))` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `setdist({Cx(&0)},path_image (cexp o p))` THEN + REWRITE_TAC[SETDIST_POS_LE; REAL_ARITH + `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + ASM_SIMP_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_CEXP; CLOSED_SING; + SETDIST_EQ_0_CLOSED_COMPACT; COMPACT_PATH_IMAGE; PATH_IMAGE_NONEMPTY] THEN + REWRITE_TAC[NOT_INSERT_EMPTY; path_image; IMAGE_o] THEN CONJ_TAC THENL + [MP_TAC CEXP_NZ THEN SET_TAC[]; REPEAT STRIP_TAC] THEN + ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN + REWRITE_TAC[COMPLEX_RING `--x = Cx(&0) - x`] THEN + REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`path_image(p:real^1->complex)`; `Cx(&0)`] + BOUNDED_SUBSET_CBALL) THEN + ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN REWRITE_TAC[SUBSET; COMPLEX_IN_CBALL_0] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`cexp`; `cball(Cx(&0),B + &1)`] + COMPACT_UNIFORMLY_CONTINUOUS) THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP; COMPACT_CBALL] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[COMPLEX_IN_CBALL_0] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`p:real^1->complex`; `min (&1) d`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^1->complex` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `winding_number(cexp o g,Cx(&0))` THEN CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC WINDING_NUMBER_NEARBY_PATHS_EQ THEN + ASM_SIMP_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_CEXP; + PATH_VECTOR_POLYNOMIAL_FUNCTION] THEN + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; o_THM] THEN + REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e:real` THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[dist] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(g - p) < &1 /\ norm(p) <= B + ==> norm(p) <= B + &1 /\ norm(g) <= B + &1`) THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[path_image] THEN ASM SET_TAC[]; + W(MP_TAC o + PART_MATCH (lhs o rand) WINDING_NUMBER_VALID_PATH o lhs o snd) THEN + REWRITE_TAC[PATH_INTEGRAL_INTEGRAL; COMPLEX_SUB_RZERO] THEN ANTS_TAC THENL + [REWRITE_TAC[path_image; IN_IMAGE; o_THM; CEXP_NZ] THEN + REWRITE_TAC[valid_path] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN + REWRITE_TAC[differentiable_on] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_AT_WITHIN THEN + REWRITE_TAC[differentiable] THEN + ASM_MESON_TAC[has_vector_derivative; + HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION]; + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE THEN + COMPLEX_DIFFERENTIABLE_TAC]; + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral (interval [vec 0,vec 1]) + (\x. vector_derivative (g:real^1->complex) (at x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(e = Cx(&0)) /\ v' = e * v ==> Cx(&1) / e * v' = v`) THEN + REWRITE_TAC[CEXP_NZ] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN + MP_TAC(ISPECL [`g:real^1->complex`; `cexp`; + `\h. drop h % vector_derivative (g:real^1->complex) (at t)`; + `\w. cexp(g(t:real^1)) * w`; `t:real^1`] + DIFF_CHAIN_AT) THEN + REWRITE_TAC[GSYM has_vector_derivative; GSYM has_complex_derivative; + GSYM VECTOR_DERIVATIVE_WORKS; + HAS_COMPLEX_DERIVATIVE_CEXP; differentiable] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION; + has_vector_derivative]; + REWRITE_TAC[has_vector_derivative; o_DEF] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; COMPLEX_CMUL] THEN + CONV_TAC COMPLEX_RING]; + MP_TAC(ISPECL [`g:real^1->complex`; + `\x. vector_derivative (g:real^1->complex) (at x)`; + `vec 0:real^1`; `vec 1:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_POS] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + REWRITE_TAC[differentiable] THEN + ASM_MESON_TAC[has_vector_derivative; + HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION]; + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[pathstart; pathfinish]]]]]);; + +let MONODROMY_CONTINUOUS_LOG = prove + (`!f:complex->complex s. + open s /\ f continuous_on s /\ + (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ((!p. path p /\ path_image p SUBSET s /\ + pathfinish p = pathstart p + ==> winding_number(f o p,Cx(&0)) = Cx(&0)) <=> + (?g. g continuous_on s /\ !z. z IN s ==> f(z) = cexp(g z)))`, + let lemma = prove + (`!f g s p. + f continuous_on s /\ g continuous_on s /\ + (!z:complex. z IN s ==> f(z) = cexp(g z)) /\ + path p /\ path_image p SUBSET s + ==> winding_number(f o p,Cx(&0)) = + Cx(&1) / (Cx(&2) * Cx pi * ii) * + (pathfinish(g o p) - pathstart(g o p))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `winding_number(cexp o g o (p:real^1->complex),Cx(&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_NEARBY_PATHS_EQ THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[PATHSTART_COMPOSE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE]; + REWRITE_TAC[PATHFINISH_COMPOSE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[SUBSET; PATHFINISH_IN_PATH_IMAGE]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_THM; COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC(NORM_ARITH + `x = y /\ ~(z = vec 0) ==> norm(x - y) < norm z`) THEN + REWRITE_TAC[COMPLEX_VEC_0; CEXP_NZ] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE]]; + MATCH_MP_TAC WINDING_NUMBER_COMPOSE_CEXP THEN + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN + MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]) in + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `g:complex->complex`; + `s:complex->bool`; `p:real^1->complex`] + lemma) THEN + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_RZERO]] THEN + DISCH_TAC THEN + EXISTS_TAC `\z. let c = connected_component s (z:complex) in + let z0 = (@) c in + let p = @p. path p /\ path_image p SUBSET c /\ + pathstart p = z0 /\ pathfinish p = z in + Cx(&2) * Cx(pi) * ii * winding_number(f o p,Cx(&0)) + + clog(f z0)` THEN + + CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + REPEAT LET_TAC THEN + SUBGOAL_THEN `(z:complex) IN c` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN + SUBGOAL_THEN `(z0:complex) IN c` ASSUME_TAC THENL + [EXPAND_TAC "z0" THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC SELECT_AX THEN + ASM_MESON_TAC[IN]; + ALL_TAC] THEN + SUBGOAL_THEN `(c:complex->bool) SUBSET s` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `connected(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN + SUBGOAL_THEN `open(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_CONNECTED_COMPONENT]; ALL_TAC] THEN + SUBGOAL_THEN `path_connected(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN + SUBGOAL_THEN + `path p /\ path_image p SUBSET c /\ + pathstart p = z0 /\ pathfinish p = (z:complex)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "p" THEN CONV_TAC SELECT_CONV THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[path_connected]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(f:complex->complex) o (p:real^1->complex)`; `Cx(&0)`] + WINDING_NUMBER_AHLFORS_FULL) THEN + REWRITE_TAC[CEXP_ADD] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[path_image; IMAGE_o] THEN + REWRITE_TAC[GSYM path_image] THEN ASM SET_TAC[]]; + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN + REWRITE_TAC[COMPLEX_SUB_RZERO] THEN DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CEXP_CLOG THEN + ASM SET_TAC[]]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_OPEN THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:complex->bool` THEN DISCH_TAC THEN + ABBREV_TAC `z0:complex = (@) c` THEN + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + ABBREV_TAC + `g = \z. let p = @p. path p /\ path_image p SUBSET c /\ + pathstart p = z0 /\ pathfinish p = z in + Cx(&2) * Cx(pi) * ii * winding_number(f o p,Cx(&0)) + + clog(f(z0:complex))` THEN + EXISTS_TAC `g:complex->complex` THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN EXPAND_TAC "z0" THEN + SUBGOAL_THEN `connected_component s (z:complex) = c` + (fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_COMPONENTS]) THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; + ALL_TAC] THEN + SUBGOAL_THEN `(z0:complex) IN c` ASSUME_TAC THENL + [EXPAND_TAC "z0" THEN REWRITE_TAC[IN] THEN MATCH_MP_TAC SELECT_AX THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(c:complex->bool) SUBSET s` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `connected(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN + SUBGOAL_THEN `open(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_COMPONENTS]; ALL_TAC] THEN + SUBGOAL_THEN `path_connected(c:complex->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN c + ==> ?p. path (p:real^1->complex) /\ path_image p SUBSET c /\ + pathstart p = z0 /\ pathfinish p = x /\ + g(x) = Cx(&2) * Cx pi * ii * winding_number(f o p,Cx(&0)) + + clog (f z0)` + (LABEL_TAC "*") + THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN + ABBREV_TAC `p = @p. path p /\ path_image p SUBSET c /\ + pathstart p = z0 /\ pathfinish p = (z:complex)` THEN + EXISTS_TAC `p:real^1->complex` THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REWRITE_TAC[] THEN + EXPAND_TAC "p" THEN CONV_TAC SELECT_CONV THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `z:complex` o GEN_REWRITE_RULE I + [OPEN_CONTAINS_BALL]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN + MP_TAC(SPEC `ball(z:complex,e)` SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG) THEN + SIMP_TAC[OPEN_BALL; CONVEX_BALL; CONVEX_IMP_SIMPLY_CONNECTED] THEN + DISCH_THEN(MP_TAC o SPEC `f:complex->complex` o CONJUNCT2) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; + DISCH_THEN(X_CHOOSE_THEN `l:complex->complex` STRIP_ASSUME_TAC)] THEN + REWRITE_TAC[CONTINUOUS_AT] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN + MATCH_MP_TAC LIM_TRANSFORM_AT THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN EXISTS_TAC + `\w. Cx(&2) * Cx pi * ii * + winding_number((f:complex->complex) o linepath(z,w),Cx(&0))` THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN REMOVE_THEN "*" + (fun th -> MP_TAC(SPEC `w:complex` th) THEN + MP_TAC(SPEC `z:complex` th)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:real^1->complex` THEN STRIP_TAC THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; IN_BALL; DIST_SYM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(COMPLEX_RING + `(z + x) - y = Cx(&0) + ==> a * b * c * x = (a * b * c * y + l) - (a * b * c * z + l)`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `p ++ linepath(z:complex,w) ++ reversepath q`) THEN + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATH_JOIN_EQ; PATH_LINEPATH; PATH_REVERSEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN + ASM_REWRITE_TAC[UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `c:complex->bool` THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,e)` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL; EMPTY_SUBSET] THEN + ASM_REWRITE_TAC[IN_BALL; CONVEX_BALL]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + REWRITE_TAC[PATH_COMPOSE_JOIN; PATH_COMPOSE_REVERSEPATH] THEN + W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_JOIN o + rand o snd) THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[VECTOR_SUB; GSYM VECTOR_ADD_ASSOC] THEN + AP_TERM_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) WINDING_NUMBER_JOIN o + rand o snd) THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(GSYM WINDING_NUMBER_REVERSEPATH)]] THEN + ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATHSTART_COMPOSE; PATHFINISH_COMPOSE; PATH_IMAGE_REVERSEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATH_REVERSEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_JOIN; + PATH_IMAGE_JOIN; IN_UNION; DE_MORGAN_THM] THEN + REWRITE_TAC[PATH_IMAGE_COMPOSE; SET_RULE + `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN + REPEAT CONJ_TAC THEN + ((MATCH_MP_TAC PATH_CONTINUOUS_IMAGE) + ORELSE + (X_GEN_TAC `x:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC)) THEN + ASM_REWRITE_TAC[PATH_LINEPATH] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:complex` THEN STRIP_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + TRY(FIRST_X_ASSUM(fun th -> + MATCH_MP_TAC(GEN_REWRITE_RULE I [SUBSET] th) THEN + FIRST_X_ASSUM ACCEPT_TAC)) THEN + UNDISCH_TAC `(x:complex) IN path_image(linepath(z,w))` THEN + SPEC_TAC(`x:complex`,`x:complex`) THEN + REWRITE_TAC[GSYM SUBSET; PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(z:complex,e)` THEN + ASM_REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL; EMPTY_SUBSET] THEN + ASM_REWRITE_TAC[IN_BALL; CONVEX_BALL]]; + MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\w. Cx(&2) * Cx pi * ii * + Cx(&1) / (Cx(&2) * Cx pi * ii) * + (pathfinish(l o linepath(z:complex,w)) - + pathstart (l o linepath(z,w)))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_AT] THEN + EXISTS_TAC `e:real` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_ARITH `x - y = vec 0 <=> y = x`] THEN + REPLICATE_TAC 3 AP_TERM_TAC THEN MATCH_MP_TAC lemma THEN + EXISTS_TAC `ball(z:complex,e)` THEN ASM_REWRITE_TAC[PATH_LINEPATH] THEN + CONJ_TAC THENL[ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_BALL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL; EMPTY_SUBSET] THEN + ASM_REWRITE_TAC[IN_BALL]; + REWRITE_TAC[COMPLEX_VEC_0] THEN + REPEAT(MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL) THEN + REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH; + PATHFINISH_COMPOSE; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM LIM_NULL; GSYM CONTINUOUS_AT] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL; + CENTRE_IN_BALL]]]);; + +(* ------------------------------------------------------------------------- *) +(* The winding number defines a continuous logarithm for the path itself. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM = prove + (`!p z. + path p /\ ~(z IN path_image p) + ==> ?q. path q /\ + pathfinish q - pathstart q = + Cx(&2) * Cx pi * ii * winding_number(p,z) /\ + !t. t IN interval[vec 0,vec 1] ==> p(t) = z + cexp(q t)`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `\t:real^1. Cx(&2) * Cx pi * ii * winding_number(subpath (vec 0) t p,z) + + clog(pathstart p - z)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `~((p:real^1->complex) t = z)` ASSUME_TAC THENL + [ASM_MESON_TAC[path_image; IN_IMAGE]; ALL_TAC] THEN + MP_TAC(SPEC `ball((p:real^1->complex) t,norm(p t - z))` + SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG) THEN + SIMP_TAC[OPEN_BALL; CONVEX_BALL; CONVEX_IMP_SIMPLY_CONNECTED] THEN + DISCH_THEN(MP_TAC o SPEC `\w:complex. w - z` o CONJUNCT2) THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[COMPLEX_SUB_0] THEN ANTS_TAC THENL + [GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[IN_BALL; dist; REAL_LT_REFL]; + DISCH_THEN(X_CHOOSE_THEN `l:complex->complex` STRIP_ASSUME_TAC)] THEN + ONCE_REWRITE_TAC[WINDING_NUMBER_OFFSET] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN + GEN_REWRITE_TAC LAND_CONV [continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `t:real^1`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `norm((p:real^1->complex) t - z)`) THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[CONTINUOUS_WITHIN] THEN ONCE_REWRITE_TAC[LIM_NULL] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN EXISTS_TAC + `\u. Cx(&1) / (Cx(&2) * Cx pi * ii) * + (pathfinish((l:complex->complex) o subpath t u p) - + pathstart(l o subpath t u p))` THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN + SUBGOAL_THEN + `path_image(subpath t u p) SUBSET ball(p t:complex,norm (p t - z))` + ASSUME_TAC THENL + [REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + SUBGOAL_THEN + `segment[t,u] SUBSET interval[vec 0,vec 1] /\ + segment[t,u] SUBSET ball(t:real^1,d)` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + CONJ_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_BALL; CONVEX_INTERVAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; CENTRE_IN_BALL] THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_COMPOSE_CEXP o + lhand o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN ASM_SIMP_TAC[PATH_SUBPATH] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `winding_number((\w. subpath t u p w - z),Cx(&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC WINDING_NUMBER_EQUAL THEN + REWRITE_TAC[o_THM; GSYM path_image; SET_RULE + `(!x. x IN s ==> cexp(l(subpath t u p x)) = subpath t u p x - z) <=> + (!y. y IN IMAGE (subpath t u p) s ==> cexp(l y) = y - z)`] THEN + ASM SET_TAC[]; + ONCE_REWRITE_TAC[GSYM WINDING_NUMBER_OFFSET] THEN + REWRITE_TAC[ETA_AX] THEN + MP_TAC(ISPECL [`p:real^1->complex`; `vec 0:real^1`; `t:real^1`; + `u:real^1`; `z:complex`] + WINDING_NUMBER_SUBPATH_COMBINE) THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + CONV_TAC COMPLEX_RING]; + REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_SUBPATH; + PATHFINISH_COMPOSE; PATHFINISH_SUBPATH] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM LIM_NULL] THEN + REWRITE_TAC[GSYM CONTINUOUS_WITHIN] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; path]; + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + UNDISCH_TAC `(l:complex->complex) continuous_on + ball(p(t:real^1),norm(p t - z))` THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CENTRE_IN_BALL] THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; NORM_POS_LT]]]; + REWRITE_TAC[pathstart; pathfinish; SUBPATH_REFL; SUBPATH_TRIVIAL] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `w' = Cx(&0) + ==> (a * b * c * w + l) - (a * b * c * w' + l) = a * b * c * w`) THEN + MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN + MP_TAC(ISPEC `p:real^1->complex` PATHSTART_IN_PATH_IMAGE) THEN + REWRITE_TAC[pathstart] THEN ASM_MESON_TAC[]; + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`subpath (vec 0) t (p:real^1->complex)`; `z:complex`] + WINDING_NUMBER_AHLFORS_FULL) THEN + REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; PATH_SUBPATH; CEXP_ADD; + REWRITE_RULE[SET_RULE `s SUBSET t <=> !x. ~(x IN t) ==> ~(x IN s)`] + PATH_IMAGE_SUBPATH_SUBSET] THEN + MATCH_MP_TAC(COMPLEX_RING + `t:complex = s ==> p - z = e * s ==> p = z + e * t`) THEN + REWRITE_TAC[pathstart] THEN MATCH_MP_TAC CEXP_CLOG THEN + REWRITE_TAC[COMPLEX_SUB_0] THEN + ASM_MESON_TAC[pathstart; PATHSTART_IN_PATH_IMAGE]]);; + +(* ------------------------------------------------------------------------- *) +(* Winding number equality is the same as path/loop homotopy in C - {0}. *) +(* ------------------------------------------------------------------------- *) + +let WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ = prove + (`!p z. path p /\ ~(z IN path_image p) + ==> (winding_number(p,z) = Cx(&0) <=> + ?a. homotopic_loops ((:complex) DELETE z) p (\t. a))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:real^1->complex`; `z:complex`] + WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_SUB_0] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `z + Cx(&1)` THEN + MP_TAC(ISPECL [`\r:real^1->complex. pathfinish r = pathstart r`; + `q:real^1->complex`; `\t:real^1. Cx(&0)`; + `\w. z + cexp w`; + `interval[vec 0:real^1,vec 1]`; `(:complex)`; + `(:complex) DELETE z`] + HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CEXP; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; + CEXP_0; homotopic_loops; o_DEF] THEN + ANTS_TAC THENL + [REWRITE_TAC[CEXP_NZ; COMPLEX_EQ_ADD_LCANCEL_0; SET_RULE + `IMAGE f UNIV SUBSET UNIV DELETE z <=> !x. ~(f x = z)`] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_MONO THEN + EXISTS_TAC `\r:real^1->complex. pathfinish r = pathstart r` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM homotopic_loops] THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[path; pathstart; pathfinish; CONTINUOUS_ON_CONST]; + SIMP_TAC[pathstart; pathfinish]]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + ASM_SIMP_TAC[o_THM; pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]]; + FIRST_ASSUM(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_LOOPS) THEN + ASM_REWRITE_TAC[GSYM LINEPATH_REFL] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN + REWRITE_TAC[GSYM LINEPATH_REFL; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + SET_TAC[]]);; + +let WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ = prove + (`!p z. path p /\ ~(z IN path_image p) + ==> (winding_number(p,z) = Cx(&0) <=> + homotopic_paths ((:complex) DELETE z) + p (linepath(pathstart p,pathstart p)))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_SIMP_TAC[WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ] THEN + REWRITE_TAC[GSYM LINEPATH_REFL; HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL; + LEFT_IMP_EXISTS_THM]; + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_PATHS) THEN + ASM_REWRITE_TAC[GSYM LINEPATH_REFL] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);; + +let WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ = prove + (`!p z. path p /\ ~(z IN path_image p) + ==> (winding_number(p,z) = Cx(&0) <=> + ?a. homotopic_paths ((:complex) DELETE z) p (\t. a))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_SIMP_TAC[WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ] THEN + REWRITE_TAC[GSYM LINEPATH_REFL] THEN MESON_TAC[]; + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP WINDING_NUMBER_HOMOTOPIC_PATHS) THEN + ASM_REWRITE_TAC[GSYM LINEPATH_REFL] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WINDING_NUMBER_TRIVIAL THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN + REWRITE_TAC[GSYM LINEPATH_REFL; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + SET_TAC[]]);; + +let WINDING_NUMBER_HOMOTOPIC_PATHS_EQ = prove + (`!p q z. + path p /\ ~(z IN path_image p) /\ + path q /\ ~(z IN path_image q) /\ + pathstart q = pathstart p /\ pathfinish q = pathfinish p + ==> (winding_number(p,z) = winding_number(q,z) <=> + homotopic_paths ((:complex) DELETE z) p q)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + REWRITE_TAC[WINDING_NUMBER_HOMOTOPIC_PATHS] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p ++ reversepath q:real^1->complex`; `z:complex`] + WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ) THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH; PATH_IMAGE_JOIN; IN_UNION; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATH_IMAGE_REVERSEPATH; WINDING_NUMBER_JOIN; + WINDING_NUMBER_REVERSEPATH; COMPLEX_ADD_RINV] THEN + REWRITE_TAC[GSYM LINEPATH_REFL] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + ASM_REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_PATHS_LOOP_PARTS)) THEN + ASM_REWRITE_TAC[]);; + +let WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ = prove + (`!p q z. + path p /\ pathfinish p = pathstart p /\ ~(z IN path_image p) /\ + path q /\ pathfinish q = pathstart q /\ ~(z IN path_image q) + ==> (winding_number(p,z) = winding_number(q,z) <=> + homotopic_loops ((:complex) DELETE z) p q)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + REWRITE_TAC[WINDING_NUMBER_HOMOTOPIC_LOOPS] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(pathstart p:complex = z) /\ ~(pathstart q = z)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(:complex)`; `z:complex`] + PATH_CONNECTED_OPEN_DELETE) THEN + REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; DIMINDEX_2; LE_REFL] THEN + REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL + [`pathstart p:complex`; `pathstart q:complex`]) THEN + ASM_REWRITE_TAC[IN_UNIV; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^1->complex` THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + STRIP_TAC THEN SUBGOAL_THEN `~(pathstart r:complex = z)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `r ++ q ++ reversepath r:real^1->complex` THEN + ASM_SIMP_TAC[HOMOTOPIC_LOOPS_CONJUGATE; SET_RULE + `s SUBSET UNIV DELETE z <=> ~(z IN s)`] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN + ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN + W(MP_TAC o PART_MATCH (rand o rand) WINDING_NUMBER_HOMOTOPIC_PATHS_EQ o + snd) THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATH_IMAGE_JOIN; IN_UNION; PATH_IMAGE_REVERSEPATH; + WINDING_NUMBER_JOIN; WINDING_NUMBER_REVERSEPATH] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A few simple corollaries from the various equivalences. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH = prove + (`!p:real^1->real^2. + simple_path p ==> simply_connected(inside(path_image p))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_EMPTY_INSIDE; + OPEN_INSIDE; CLOSED_PATH_IMAGE; INSIDE_INSIDE_EQ_EMPTY; + CONNECTED_PATH_IMAGE] THEN + ASM_CASES_TAC `pathstart(p):real^2 = pathfinish p` THEN + ASM_SIMP_TAC[JORDAN_INSIDE_OUTSIDE; INSIDE_ARC_EMPTY; ARC_SIMPLE_PATH] THEN + REWRITE_TAC[CONNECTED_EMPTY]);; + +let SIMPLY_CONNECTED_INTER = prove + (`!s t:real^2->bool. + open s /\ open t /\ simply_connected s /\ simply_connected t /\ + connected (s INTER t) + ==> simply_connected (s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + SIMP_TAC[SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO; OPEN_INTER] THEN + REWRITE_TAC[SUBSET; IN_INTER] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Pick out the Riemann Mapping Theorem from the earlier chain. *) +(* ------------------------------------------------------------------------- *) + +let RIEMANN_MAPPING_THEOREM = prove + (`!s. open s /\ simply_connected s <=> + s = {} \/ + s = (:real^2) \/ + ?f g. f holomorphic_on s /\ + g holomorphic_on ball(Cx(&0),&1) /\ + (!z. z IN s ==> f z IN ball(Cx(&0),&1) /\ g(f z) = z) /\ + (!z. z IN ball(Cx(&0),&1) ==> g z IN s /\ f(g z) = z)`, + GEN_TAC THEN MATCH_MP_TAC(TAUT + `(a ==> (b <=> c)) /\ (c ==> a) ==> (a /\ b <=> c)`) THEN + REWRITE_TAC[SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN + SUBGOAL_THEN `s = IMAGE (g:complex->complex) (ball(Cx(&0),&1))` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + ASM_SIMP_TAC[OPEN_BALL; HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + ASM_MESON_TAC[]);; diff --git a/Multivariate/clifford.ml b/Multivariate/clifford.ml new file mode 100644 index 0000000..f8a6969 --- /dev/null +++ b/Multivariate/clifford.ml @@ -0,0 +1,979 @@ +(* ========================================================================= *) +(* Geometric algebra. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Multivariate/vectors.ml";; +needs "Library/binary.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Some basic lemmas, mostly set theory. *) +(* ------------------------------------------------------------------------- *) + +let CARD_UNION_LEMMA = prove + (`FINITE s /\ FINITE t /\ FINITE u /\ FINITE v /\ + s INTER t = {} /\ u INTER v = {} /\ s UNION t = u UNION v + ==> CARD(s) + CARD(t) = CARD(u) + CARD(v)`, + MESON_TAC[CARD_UNION]);; + +let CARD_DIFF_INTER = prove + (`!s t. FINITE s ==> CARD s = CARD(s DIFF t) + CARD(s INTER t)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let CARD_ADD_SYMDIFF_INTER = prove + (`!s t:A->bool. + FINITE s /\ FINITE t + ==> CARD s + CARD t = + CARD((s DIFF t) UNION (t DIFF s)) + 2 * CARD(s INTER t)`, + REPEAT STRIP_TAC THEN + SUBST1_TAC(SPEC `t:A->bool`(MATCH_MP CARD_DIFF_INTER + (ASSUME `FINITE(s:A->bool)`))) THEN + SUBST1_TAC(SPEC `s:A->bool`(MATCH_MP CARD_DIFF_INTER + (ASSUME `FINITE(t:A->bool)`))) THEN + REWRITE_TAC[INTER_ACI] THEN + MATCH_MP_TAC(ARITH_RULE `c = a + b ==> (a + x) + (b + x) = c + 2 * x`) THEN + MATCH_MP_TAC CARD_UNION THEN ASM_SIMP_TAC[FINITE_DIFF] THEN SET_TAC[]);; + +let SYMDIFF_PARITY_LEMMA = prove + (`!s t u. FINITE s /\ FINITE t /\ (s DIFF t) UNION (t DIFF s) = u + ==> EVEN(CARD u) = (EVEN(CARD s) <=> EVEN(CARD t))`, + ONCE_REWRITE_TAC[GSYM EVEN_ADD] THEN + SIMP_TAC[CARD_ADD_SYMDIFF_INTER] THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH]);; + +let FINITE_CART_SUBSET_LEMMA = prove + (`!P m n. FINITE {i,j | i IN 1..m /\ j IN 1..n /\ P i j}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{i,j | i IN 1..m /\ j IN 1..n}` THEN + SIMP_TAC[SUBSET; FINITE_PRODUCT; FINITE_NUMSEG] THEN + SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Index type for "multivectors" (k-vectors for all k <= N). *) +(* ------------------------------------------------------------------------- *) + +let multivector_tybij_th = prove + (`?s. s SUBSET (1..dimindex(:N))`, + MESON_TAC[EMPTY_SUBSET]);; + +let multivector_tybij = + new_type_definition "multivector" ("mk_multivector","dest_multivector") + multivector_tybij_th;; + +let MULTIVECTOR_IMAGE = prove + (`(:(N)multivector) = IMAGE mk_multivector {s | s SUBSET 1..dimindex(:N)}`, + REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[multivector_tybij]);; + +let HAS_SIZE_MULTIVECTOR = prove + (`(:(N)multivector) HAS_SIZE (2 EXP dimindex(:N))`, + REWRITE_TAC[MULTIVECTOR_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + SIMP_TAC[HAS_SIZE_POWERSET; HAS_SIZE_NUMSEG_1; IN_ELIM_THM] THEN + MESON_TAC[multivector_tybij]);; + +let FINITE_MULTIVECTOR = prove + (`FINITE(:(N)multivector)`, + MESON_TAC[HAS_SIZE; HAS_SIZE_MULTIVECTOR]);; + +let DIMINDEX_MULTIVECTOR = prove + (`dimindex(:(N)multivector) = 2 EXP dimindex(:N)`, + MESON_TAC[DIMINDEX_UNIQUE; HAS_SIZE_MULTIVECTOR]);; + +let DEST_MK_MULTIVECTOR = prove + (`!s. s SUBSET 1..dimindex(:N) + ==> dest_multivector(mk_multivector s :(N)multivector) = s`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM multivector_tybij] THEN + ASM_REWRITE_TAC[]);; + +let FORALL_MULTIVECTOR = prove + (`(!s. s SUBSET 1..dimindex(:N) ==> P(mk_multivector s)) <=> + (!m:(N)multivector. P m)`, + EQ_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN DISCH_TAC THEN GEN_TAC THEN + MP_TAC(ISPEC `m:(N)multivector` + (REWRITE_RULE[EXTENSION] MULTIVECTOR_IMAGE)) THEN + REWRITE_TAC[IN_UNIV; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The bijections we use for indexing. *) +(* *) +(* Note that we need a *single* bijection over the entire space that also *) +(* works for the various subsets. Hence the tedious explicit construction. *) +(* ------------------------------------------------------------------------- *) + +let setcode = new_definition + `setcode s = 1 + binarysum (IMAGE PRE s)`;; + +let codeset = new_definition + `codeset n = IMAGE SUC (bitset(n - 1))`;; + +let CODESET_SETCODE_BIJECTIONS = prove + (`(!i. i IN 1..(2 EXP n) + ==> codeset i SUBSET 1..n /\ setcode(codeset i) = i) /\ + (!s. s SUBSET (1..n) + ==> (setcode s) IN 1..(2 EXP n) /\ codeset(setcode s) = s)`, + REWRITE_TAC[codeset; setcode; ADD_SUB2; GSYM IMAGE_o; o_DEF; PRE] THEN + REWRITE_TAC[SET_RULE `IMAGE (\x. x) s = s`] THEN CONJ_TAC THEN GEN_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + SIMP_TAC[ARITH_RULE `1 <= i ==> (1 + b = i <=> b = i - 1)`] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n /\ SUC n <= k <=> n < k`] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (ARITH_RULE `1 <= i /\ i <= t ==> i - 1 < t`)) THEN + MESON_TAC[BITSET_BOUND; BINARYSUM_BITSET]; + ALL_TAC] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `PRE` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[IN_NUMSEG; SUBSET] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `x < n ==> 1 <= 1 + x /\ 1 + x <= n`) THEN + MATCH_MP_TAC BINARYSUM_BOUND THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `IMAGE SUC (IMAGE PRE s)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[FINITE_IMAGE; FINITE_SUBSET; FINITE_NUMSEG; BITSET_BINARYSUM]; + ALL_TAC] THEN + UNDISCH_TAC `s SUBSET 1..n` THEN + REWRITE_TAC[SUBSET; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN + MESON_TAC[ARITH_RULE `1 <= n ==> SUC(PRE n) = n`]);; + +let FORALL_SETCODE = prove + (`(!s. s SUBSET (1..n) ==> P(setcode s)) <=> (!i. i IN 1..(2 EXP n) ==> P i)`, + MESON_TAC[CODESET_SETCODE_BIJECTIONS; SUBSET]);; + +let SETCODE_BOUNDS = prove + (`!s n. s SUBSET 1..n ==> setcode s IN (1..(2 EXP n))`, + MESON_TAC[CODESET_SETCODE_BIJECTIONS]);; + +(* ------------------------------------------------------------------------- *) +(* Indexing directly via subsets. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("$$",(25,"left"));; + +let sindex = new_definition + `(x:real^(N)multivector)$$s = x$(setcode s)`;; + +parse_as_binder "lambdas";; + +let lambdas = new_definition + `(lambdas) (g:(num->bool)->real) = + (lambda i. g(codeset i)):real^(N)multivector`;; + +(* ------------------------------------------------------------------------- *) +(* Crucial properties. *) +(* ------------------------------------------------------------------------- *) + +let MULTIVECTOR_EQ = prove + (`!x y:real^(N)multivector. + x = y <=> !s. s SUBSET 1..dimindex(:N) ==> x$$s = y$$s`, + SIMP_TAC[CART_EQ; sindex; FORALL_SETCODE; GSYM IN_NUMSEG; + DIMINDEX_MULTIVECTOR]);; + +let MULTIVECTOR_BETA = prove + (`!s. s SUBSET 1..dimindex(:N) + ==> ((lambdas) g :real^(N)multivector)$$s = g s`, + SIMP_TAC[sindex; lambdas; LAMBDA_BETA; SETCODE_BOUNDS; + DIMINDEX_MULTIVECTOR; GSYM IN_NUMSEG] THEN + MESON_TAC[CODESET_SETCODE_BIJECTIONS]);; + +let MULTIVECTOR_UNIQUE = prove + (`!m:real^(N)multivector g. + (!s. s SUBSET 1..dimindex(:N) ==> m$$s = g s) + ==> (lambdas) g = m`, + SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_BETA] THEN MESON_TAC[]);; + +let MULTIVECTOR_ETA = prove + (`(lambdas s. m$$s) = m`, + SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_BETA]);; + +(* ------------------------------------------------------------------------- *) +(* Also componentwise operations; they all work in this style. *) +(* ------------------------------------------------------------------------- *) + +let MULTIVECTOR_ADD_COMPONENT = prove + (`!x y:real^(N)multivector s. + s SUBSET (1..dimindex(:N)) ==> (x + y)$$s = x$$s + y$$s`, + SIMP_TAC[sindex; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; + GSYM IN_NUMSEG; VECTOR_ADD_COMPONENT]);; + +let MULTIVECTOR_MUL_COMPONENT = prove + (`!c x:real^(N)multivector s. + s SUBSET (1..dimindex(:N)) ==> (c % x)$$s = c * x$$s`, + SIMP_TAC[sindex; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; + GSYM IN_NUMSEG; VECTOR_MUL_COMPONENT]);; + +let MULTIVECTOR_VEC_COMPONENT = prove + (`!k s. s SUBSET (1..dimindex(:N)) ==> (vec k :real^(N)multivector)$$s = &k`, + SIMP_TAC[sindex; SETCODE_BOUNDS; DIMINDEX_MULTIVECTOR; + GSYM IN_NUMSEG; VEC_COMPONENT]);; + +let MULTIVECTOR_VSUM_COMPONENT = prove + (`!f:A->real^(N)multivector t s. + s SUBSET (1..dimindex(:N)) + ==> (vsum t f)$$s = sum t (\x. (f x)$$s)`, + SIMP_TAC[vsum; sindex; LAMBDA_BETA; SETCODE_BOUNDS; GSYM IN_NUMSEG; + DIMINDEX_MULTIVECTOR]);; + +let MULTIVECTOR_VSUM = prove + (`!t f. vsum t f = lambdas s. sum t (\x. (f x)$$s)`, + SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_BETA; MULTIVECTOR_VSUM_COMPONENT]);; + +(* ------------------------------------------------------------------------- *) +(* Basis vectors indexed by subsets of 1..N. *) +(* ------------------------------------------------------------------------- *) + +let mbasis = new_definition + `mbasis i = lambdas s. if i = s then &1 else &0`;; + +let MBASIS_COMPONENT = prove + (`!s t. s SUBSET (1..dimindex(:N)) + ==> (mbasis t :real^(N)multivector)$$s = if s = t then &1 else &0`, + SIMP_TAC[mbasis; IN_ELIM_THM; MULTIVECTOR_BETA] THEN MESON_TAC[]);; + +let MBASIS_EQ_0 = prove + (`!s. (mbasis s :real^(N)multivector = vec 0) <=> + ~(s SUBSET 1..dimindex(:N))`, + SIMP_TAC[MULTIVECTOR_EQ; MBASIS_COMPONENT; MULTIVECTOR_VEC_COMPONENT] THEN + MESON_TAC[REAL_ARITH `~(&1 = &0)`]);; + +let MBASIS_NONZERO = prove + (`!s. s SUBSET 1..dimindex(:N) ==> ~(mbasis s :real^(N)multivector = vec 0)`, + REWRITE_TAC[MBASIS_EQ_0]);; + +let MBASIS_EXPANSION = prove + (`!x:real^(N)multivector. + vsum {s | s SUBSET 1..dimindex(:N)} (\s. x$$s % mbasis s) = x`, + SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_VSUM_COMPONENT; + MULTIVECTOR_MUL_COMPONENT; MBASIS_COMPONENT] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `x * (if p then &1 else &0) = if p then x else &0`; + SUM_DELTA; IN_ELIM_THM]);; + +let SPAN_MBASIS = prove + (`span {mbasis s :real^(N)multivector | s SUBSET 1..dimindex(:N)} = UNIV`, + REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^(N)multivector` THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MBASIS_EXPANSION] THEN + MATCH_MP_TAC SPAN_VSUM THEN + SIMP_TAC[FINITE_NUMSEG; FINITE_POWERSET; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Linear and bilinear functions are determined by their effect on basis. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_EQ_MBASIS = prove + (`!f:real^(M)multivector->real^N g b s. + linear f /\ linear g /\ + (!s. s SUBSET 1..dimindex(:M) ==> f(mbasis s) = g(mbasis s)) + ==> f = g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^(M)multivector->real^N) x = g x` + (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN + MATCH_MP_TAC LINEAR_EQ THEN + EXISTS_TAC `{mbasis s :real^(M)multivector | s SUBSET 1..dimindex(:M)}` THEN + ASM_REWRITE_TAC[SPAN_MBASIS; SUBSET_REFL; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +let BILINEAR_EQ_MBASIS = prove + (`!f:real^(M)multivector->real^(N)multivector->real^P g b s. + bilinear f /\ bilinear g /\ + (!s t. s SUBSET 1..dimindex(:M) /\ t SUBSET 1..dimindex(:N) + ==> f (mbasis s) (mbasis t) = g (mbasis s) (mbasis t)) + ==> f = g`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `!x y. x IN UNIV /\ y IN UNIV + ==> (f:real^(M)multivector->real^(N)multivector->real^P) x y = g x y` + (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN + MATCH_MP_TAC BILINEAR_EQ THEN + EXISTS_TAC `{mbasis s :real^(M)multivector | s SUBSET 1..dimindex(:M)}` THEN + EXISTS_TAC `{mbasis t :real^(N)multivector | t SUBSET 1..dimindex(:N)}` THEN + ASM_REWRITE_TAC[SPAN_MBASIS; SUBSET_REFL; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A way of proving linear properties by extension from basis. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_PROPERTY = prove + (`!P. P(vec 0) /\ (!x y. P x /\ P y ==> P(x + y)) + ==> !f s. FINITE s /\ (!i. i IN s ==> P(f i)) ==> P(vsum s f)`, + GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[VSUM_CLAUSES; IN_INSERT]);; + +let MBASIS_EXTENSION = prove + (`!P. (!s. s SUBSET 1..dimindex(:N) ==> P(mbasis s)) /\ + (!c x. P x ==> P(c % x)) /\ (!x y. P x /\ P y ==> P(x + y)) + ==> !x:real^(N)multivector. P x`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM MBASIS_EXPANSION] THEN + MATCH_MP_TAC(SIMP_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] LINEAR_PROPERTY) THEN + ASM_SIMP_TAC[FINITE_POWERSET; FINITE_NUMSEG; IN_ELIM_THM] THEN + ASM_MESON_TAC[EMPTY_SUBSET; VECTOR_MUL_LZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Injection from regular vectors. *) +(* ------------------------------------------------------------------------- *) + +let multivec = new_definition + `(multivec:real^N->real^(N)multivector) x = + vsum(1..dimindex(:N)) (\i. x$i % mbasis{i})`;; + +(* ------------------------------------------------------------------------- *) +(* Subspace of k-vectors. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("multivector",(12,"right"));; + +let multivector = new_definition + `k multivector (p:real^(N)multivector) <=> + !s. s SUBSET (1..dimindex(:N)) /\ ~(p$$s = &0) ==> s HAS_SIZE k`;; + +(* ------------------------------------------------------------------------- *) +(* k-grade part of a multivector. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("grade",(22,"right"));; + +let grade = new_definition + `k grade (p:real^(N)multivector) = + (lambdas s. if s HAS_SIZE k then p$$s else &0):real^(N)multivector`;; + +let MULTIVECTOR_GRADE = prove + (`!k x. k multivector (k grade x)`, + SIMP_TAC[multivector; grade; MULTIVECTOR_BETA; IMP_CONJ] THEN + MESON_TAC[]);; + +let GRADE_ADD = prove + (`!x y k. k grade (x + y) = (k grade x) + (k grade y)`, + SIMP_TAC[grade; MULTIVECTOR_EQ; MULTIVECTOR_ADD_COMPONENT; + MULTIVECTOR_BETA; COND_COMPONENT] THEN + REAL_ARITH_TAC);; + +let GRADE_CMUL = prove + (`!c x k. k grade (c % x) = c % (k grade x)`, + SIMP_TAC[grade; MULTIVECTOR_EQ; MULTIVECTOR_MUL_COMPONENT; + MULTIVECTOR_BETA; COND_COMPONENT] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* General product construct. *) +(* ------------------------------------------------------------------------- *) + +let Product_DEF = new_definition + `(Product mult op + :real^(N)multivector->real^(N)multivector->real^(N)multivector) x y = + vsum {s | s SUBSET 1..dimindex(:N)} + (\s. vsum {s | s SUBSET 1..dimindex(:N)} + (\t. (x$$s * y$$t * mult s t) % mbasis (op s t)))`;; + +(* ------------------------------------------------------------------------- *) +(* This is always bilinear. *) +(* ------------------------------------------------------------------------- *) + +let BILINEAR_PRODUCT = prove + (`!mult op. bilinear(Product mult op)`, + REWRITE_TAC[bilinear; linear; Product_DEF] THEN + SIMP_TAC[GSYM VSUM_LMUL; MULTIVECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[Product_DEF] THEN + SIMP_TAC[GSYM VSUM_ADD; FINITE_POWERSET; FINITE_NUMSEG] THEN + REPEAT(MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC) THEN + ASM_SIMP_TAC[MULTIVECTOR_ADD_COMPONENT] THEN VECTOR_ARITH_TAC);; + +let PRODUCT_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_PRODUCT;; +let PRODUCT_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_PRODUCT;; + +(* ------------------------------------------------------------------------- *) +(* Under suitable conditions, it's also associative. *) +(* ------------------------------------------------------------------------- *) + +let PRODUCT_ASSOCIATIVE = prove + (`!op mult. (!s t. s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) + ==> (op s t) SUBSET 1..dimindex(:N)) /\ + (!s t u. op s (op t u) = op (op s t) u) /\ + (!s t u. mult t u * mult s (op t u) = mult s t * mult (op s t) u) + ==> !x y z:real^(N)multivector. + Product mult op x (Product mult op y z) = + Product mult op (Product mult op x y) z`, + let SUM_SWAP_POWERSET = + SIMP_RULE[FINITE_POWERSET; FINITE_NUMSEG] + (repeat(SPEC `{s | s SUBSET 1..dimindex(:N)}`) + (ISPEC `f:(num->bool)->(num->bool)->real` SUM_SWAP)) in + let SWAP_TAC cnv n = + GEN_REWRITE_TAC (cnv o funpow n BINDER_CONV) [SUM_SWAP_POWERSET] THEN + REWRITE_TAC[] in + let SWAPS_TAC cnv ns x = + MAP_EVERY (SWAP_TAC cnv) ns THEN MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC x THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC in + REWRITE_TAC[Product_DEF] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[MULTIVECTOR_EQ; MULTIVECTOR_VSUM_COMPONENT; MBASIS_COMPONENT; + MULTIVECTOR_MUL_COMPONENT] THEN + SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + X_GEN_TAC `r:num->bool` THEN STRIP_TAC THEN + SWAPS_TAC RAND_CONV [1;0] `s:num->bool` THEN + SWAP_TAC LAND_CONV 0 THEN SWAPS_TAC RAND_CONV [1;0] `t:num->bool` THEN + SWAP_TAC RAND_CONV 0 THEN SWAPS_TAC LAND_CONV [0] `u:num->bool` THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; + REAL_ARITH `(if p then a else &0) * b = if p then a * b else &0`; + REAL_ARITH `a * (if p then b else &0) = if p then a * b else &0`] THEN + SIMP_TAC[SUM_DELTA] THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Geometric product. *) +(* ------------------------------------------------------------------------- *) + +overload_interface + ("*", + `geom_mul:real^(N)multivector->real^(N)multivector->real^(N)multivector`);; + +let geom_mul = new_definition + `(x:real^(N)multivector) * y = + Product (\s t. --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ + j IN 1..dimindex(:N) /\ + i IN s /\ j IN t /\ i > j}) + (\s t. (s DIFF t) UNION (t DIFF s)) + x y`;; + +let BILINEAR_GEOM = prove + (`bilinear(geom_mul)`, + REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] geom_mul] THEN + MATCH_ACCEPT_TAC BILINEAR_PRODUCT);; + +let GEOM_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_GEOM;; +let GEOM_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_GEOM;; + +let GEOM_ASSOC = prove + (`!x y z:real^(N)multivector. x * (y * z) = (x * y) * z`, + REWRITE_TAC[geom_mul] THEN MATCH_MP_TAC PRODUCT_ASSOCIATIVE THEN + REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN + REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EVEN_ADD] THEN + W(fun (_,w) -> let tu = funpow 2 lhand w in + let su = vsubst[`s:num->bool`,`t:num->bool`] tu in + let st = vsubst[`t:num->bool`,`u:num->bool`] su in + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC(end_itlist (curry mk_eq) [st; su; tu])) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(TAUT `(x <=> y <=> z) ==> ((a <=> x) <=> (y <=> z <=> a))`); + AP_TERM_TAC THEN CONV_TAC SYM_CONV] THEN + MATCH_MP_TAC SYMDIFF_PARITY_LEMMA THEN + REWRITE_TAC[FINITE_CART_SUBSET_LEMMA] THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; + IN_UNION; IN_DIFF] THEN + CONV_TAC TAUT);; + +(* ------------------------------------------------------------------------- *) +(* Outer product. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("outer",(20,"right"));; + +let outer = new_definition + `!x y:real^(N)multivector. + x outer y = + Product (\s t. if ~(s INTER t = {}) then &0 + else --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ + j IN 1..dimindex(:N) /\ + i IN s /\ j IN t /\ i > j}) + (\s t. (s DIFF t) UNION (t DIFF s)) + x y`;; + +let OUTER = prove + (`!x y:real^(N)multivector. + x outer y = + Product (\s t. if ~(s INTER t = {}) then &0 + else --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ + j IN 1..dimindex(:N) /\ + i IN s /\ j IN t /\ i > j}) + (UNION) + x y`, + REPEAT GEN_TAC THEN REWRITE_TAC[outer; Product_DEF] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + ASM_CASES_TAC `s INTER t :num->bool = {}` THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[SET_RULE + `(s INTER t = {}) ==> (s DIFF t) UNION (t DIFF s) = s UNION t`]);; + +let BILINEAR_OUTER = prove + (`bilinear(outer)`, + REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] outer] THEN + MATCH_ACCEPT_TAC BILINEAR_PRODUCT);; + +let OUTER_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_OUTER;; +let OUTER_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_OUTER;; + +let OUTER_ASSOC = prove + (`!x y z:real^(N)multivector. x outer (y outer z) = (x outer y) outer z`, + REWRITE_TAC[OUTER] THEN MATCH_MP_TAC PRODUCT_ASSOCIATIVE THEN + SIMP_TAC[UNION_SUBSET; UNION_ASSOC; + SET_RULE `s INTER (t UNION u) = (s INTER t) UNION (s INTER u)`; + SET_RULE `(t UNION u) INTER s = (t INTER s) UNION (u INTER s)`] THEN + REWRITE_TAC[EMPTY_UNION] THEN REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`s INTER t :num->bool = {}`; + `s INTER u :num->bool = {}`; + `t INTER u :num->bool = {}`] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[GSYM REAL_POW_ADD] THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARD_UNION_LEMMA THEN REWRITE_TAC[FINITE_CART_SUBSET_LEMMA] THEN + SIMP_TAC[EXTENSION; FORALL_PAIR_THM; NOT_IN_EMPTY; IN_UNION; IN_INTER] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN ASM SET_TAC []);; + +(* ------------------------------------------------------------------------- *) +(* Inner product. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("inner",(20,"right"));; + +let inner = new_definition + `!x y:real^(N)multivector. + x inner y = + Product (\s t. if s = {} \/ t = {} \/ + ~((s DIFF t) = {} /\ ~(t DIFF s = {})) + then &0 + else --(&1) pow CARD {i,j | i IN 1..dimindex(:N) /\ + j IN 1..dimindex(:N) /\ + i IN s /\ j IN t /\ i > j}) + (\s t. (s DIFF t) UNION (t DIFF s)) + x y`;; + +let BILINEAR_INNER = prove + (`bilinear(inner)`, + REWRITE_TAC[REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] inner] THEN + MATCH_ACCEPT_TAC BILINEAR_PRODUCT);; + +let INNER_LADD = (MATCH_MP BILINEAR_LADD o SPEC_ALL) BILINEAR_INNER;; +let INNER_RADD = (MATCH_MP BILINEAR_RADD o SPEC_ALL) BILINEAR_INNER;; +let INNER_LMUL = (MATCH_MP BILINEAR_LMUL o SPEC_ALL) BILINEAR_INNER;; +let INNER_RMUL = (MATCH_MP BILINEAR_RMUL o SPEC_ALL) BILINEAR_INNER;; +let INNER_LNEG = (MATCH_MP BILINEAR_LNEG o SPEC_ALL) BILINEAR_INNER;; +let INNER_RNEG = (MATCH_MP BILINEAR_RNEG o SPEC_ALL) BILINEAR_INNER;; +let INNER_LZERO = (MATCH_MP BILINEAR_LZERO o SPEC_ALL) BILINEAR_INNER;; +let INNER_RZERO = (MATCH_MP BILINEAR_RZERO o SPEC_ALL) BILINEAR_INNER;; + +(* ------------------------------------------------------------------------- *) +(* Actions of products on basis and singleton basis. *) +(* ------------------------------------------------------------------------- *) + +let PRODUCT_MBASIS = prove + (`!s t. Product mult op (mbasis s) (mbasis t) :real^(N)multivector = + if s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) + then mult s t % mbasis(op s t) + else vec 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[Product_DEF] THEN + SIMP_TAC[MULTIVECTOR_MUL_COMPONENT; MBASIS_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH + `(if p then &1 else &0) * (if q then &1 else &0) * x = + if q then if p then x else &0 else &0`] THEN + REPEAT + (GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RAND] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COND_RATOR] THEN + SIMP_TAC[VECTOR_MUL_LZERO; COND_ID; VSUM_DELTA; IN_ELIM_THM; VSUM_0] THEN + ASM_CASES_TAC `t SUBSET 1..dimindex(:N)` THEN ASM_REWRITE_TAC[]));; + +let PRODUCT_MBASIS_SING = prove + (`!i j. Product mult op (mbasis{i}) (mbasis{j}) :real^(N)multivector = + if i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) + then mult {i} {j} % mbasis(op {i} {j}) + else vec 0`, + REWRITE_TAC[PRODUCT_MBASIS; SET_RULE `{x} SUBSET s <=> x IN s`]);; + +let GEOM_MBASIS = prove + (`!s t. mbasis s * mbasis t :real^(N)multivector = + if s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) + then --(&1) pow CARD {i,j | i IN s /\ j IN t /\ i > j} % + mbasis((s DIFF t) UNION (t DIFF s)) + else vec 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[geom_mul; PRODUCT_MBASIS] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM] THEN + ASM_MESON_TAC[SUBSET]);; + +let GEOM_MBASIS_SING = prove + (`!i j. mbasis{i} * mbasis{j} :real^(N)multivector = + if i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) + then if i = j then mbasis{} + else if i < j then mbasis{i,j} + else --(mbasis{i,j}) + else vec 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[geom_mul; PRODUCT_MBASIS_SING] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THEN + SUBGOAL_THEN + `{i',j' | i' IN 1 .. dimindex (:N) /\ + j' IN 1 .. dimindex (:N) /\ + i' = i /\ + j' = j /\ + i' > j'} = + if i > j then {(i,j)} else {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_SING] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; PAIR_EQ] THEN + ASM_MESON_TAC[LT_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[GT; LT_REFL] THENL + [REWRITE_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID] THEN + AP_TERM_TAC THEN SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SET_RULE + `~(i = j) ==> ({i} DIFF {j}) UNION ({j} DIFF {i}) = {i,j}`] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(i:num = j) ==> (j < i <=> ~(i < j))`)) THEN + ASM_CASES_TAC `i:num < j` THEN + ASM_SIMP_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID; FINITE_RULES; + NOT_IN_EMPTY] THEN + VECTOR_ARITH_TAC);; + +let OUTER_MBASIS = prove + (`!s t. (mbasis s) outer (mbasis t) :real^(N)multivector = + if s SUBSET 1..dimindex(:N) /\ t SUBSET 1..dimindex(:N) /\ + s INTER t = {} + then --(&1) pow CARD {i,j | i IN s /\ j IN t /\ i > j} % + mbasis(s UNION t) + else vec 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[OUTER; PRODUCT_MBASIS] THEN + ASM_CASES_TAC `(s:num->bool) INTER t = {}` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; COND_ID] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_PAIR_THM; FORALL_PAIR_THM] THEN + ASM_MESON_TAC[SUBSET]);; + +let OUTER_MBASIS_SING = prove + (`!i j. mbasis{i} outer mbasis{j} :real^(N)multivector = + if i IN 1..dimindex(:N) /\ j IN 1..dimindex(:N) /\ ~(i = j) + then if i < j then mbasis{i,j} else --(mbasis{i,j}) + else vec 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[OUTER; PRODUCT_MBASIS_SING] THEN + REWRITE_TAC[SET_RULE `{i} INTER {j} = {} <=> ~(i = j)`] THEN + ASM_CASES_TAC `i:num = j` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; COND_ID] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THEN + SUBGOAL_THEN + `{i',j' | i' IN 1 .. dimindex (:N) /\ + j' IN 1 .. dimindex (:N) /\ + i' = i /\ + j' = j /\ + i' > j'} = + if i > j then {(i,j)} else {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_SING] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; PAIR_EQ] THEN + ASM_MESON_TAC[LT_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[GT; SET_RULE `{i} UNION {j} = {i,j}`] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `~(i:num = j) ==> (j < i <=> ~(i < j))`)) THEN + ASM_CASES_TAC `i:num < j` THEN + ASM_SIMP_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID; FINITE_RULES; + NOT_IN_EMPTY] THEN + VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some simple consequences. *) +(* ------------------------------------------------------------------------- *) + +let OUTER_MBASIS_SKEWSYM = prove + (`!i j. mbasis{i} outer mbasis{j} = --(mbasis{j} outer mbasis{i})`, + REPEAT GEN_TAC THEN REWRITE_TAC[OUTER_MBASIS_SING] THEN + ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[VECTOR_NEG_0] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(i:num = j) ==> i < j /\ ~(j < i) \/ j < i /\ ~(i < j)`)) THEN + ASM_REWRITE_TAC[CONJ_ACI] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[VECTOR_NEG_NEG; VECTOR_NEG_0] THEN + REPEAT AP_TERM_TAC THEN SET_TAC[]);; + +let OUTER_MBASIS_REFL = prove + (`!i. mbasis{i} outer mbasis{i} = vec 0`, + GEN_TAC THEN MATCH_MP_TAC(VECTOR_ARITH + `!x:real^N. x = --x ==> x = vec 0`) THEN + MATCH_ACCEPT_TAC OUTER_MBASIS_SKEWSYM);; + +let OUTER_MBASIS_LSCALAR = prove + (`!x. mbasis{} outer x = x`, + MATCH_MP_TAC MBASIS_EXTENSION THEN SIMP_TAC[OUTER_RMUL; OUTER_RADD] THEN + SIMP_TAC[OUTER_MBASIS; EMPTY_SUBSET; INTER_EMPTY; UNION_EMPTY] THEN + REWRITE_TAC[SET_RULE `{i,j | i IN {} /\ j IN s /\ i:num > j} = {}`] THEN + REWRITE_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID]);; + +let OUTER_MBASIS_RSCALAR = prove + (`!x. x outer mbasis{} = x`, + MATCH_MP_TAC MBASIS_EXTENSION THEN SIMP_TAC[OUTER_LMUL; OUTER_LADD] THEN + SIMP_TAC[OUTER_MBASIS; EMPTY_SUBSET; INTER_EMPTY; UNION_EMPTY] THEN + REWRITE_TAC[SET_RULE `{i,j | i IN s /\ j IN {} /\ i:num > j} = {}`] THEN + REWRITE_TAC[CARD_CLAUSES; real_pow; VECTOR_MUL_LID]);; + +let MBASIS_SPLIT = prove + (`!a s. (!x. x IN s ==> a < x) + ==> mbasis (a INSERT s) = mbasis{a} outer mbasis s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OUTER_MBASIS] THEN + SUBGOAL_THEN `{a:num} INTER s = {}` SUBST1_TAC THENL + [ASM SET_TAC [LT_REFL]; ALL_TAC] THEN + SIMP_TAC[SET_RULE`{a} SUBSET t /\ s SUBSET t <=> (a INSERT s) SUBSET t`] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[MBASIS_EQ_0]] THEN + REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN + SUBGOAL_THEN `{(i:num),(j:num) | i IN {a} /\ j IN s /\ i > j} = {}` + (fun th -> SIMP_TAC[th; CARD_CLAUSES; real_pow; VECTOR_MUL_LID]) THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_SING; + NOT_IN_EMPTY] THEN + ASM_MESON_TAC[ARITH_RULE `~(n < m /\ n:num > m)`]);; + +(* ------------------------------------------------------------------------- *) +(* Just for generality, normalize a set enumeration. *) +(* ------------------------------------------------------------------------- *) + +let SETENUM_NORM_CONV = + let conv = + GEN_REWRITE_CONV I [EXTENSION] THENC + GEN_REWRITE_CONV TOP_SWEEP_CONV [IN_SING; IN_INSERT] THENC + BINDER_CONV(EQT_INTRO o DISJ_ACI_RULE) THENC + GEN_REWRITE_CONV I [FORALL_SIMP] in + fun tm -> + let nums = dest_setenum tm in + let nums' = map mk_numeral (sort ( a < x) <=> T) /\ + ((!x:num. x IN (y INSERT s) ==> a < x) <=> + a < y /\ (!x. x IN s ==> a < x))` in + let SET_CHECK_CONV = + GEN_REWRITE_CONV TOP_SWEEP_CONV [setlemma] THENC NUM_REDUCE_CONV + and INST_SPLIT = PART_MATCH (lhs o rand) MBASIS_SPLIT + and INST_MERGE = PART_MATCH (lhs o rand) (GSYM MBASIS_SPLIT) in + let rec conv tm = + if length(dest_setenum(rand tm)) <= 1 then REFL tm else + let th = MP_CONV SET_CHECK_CONV (INST_SPLIT tm) in + let th' = RAND_CONV conv (rand(concl th)) in + TRANS th th' in + (fun tm -> + try let op,se = dest_comb tm in + if fst(dest_const op) = "mbasis" & forall is_numeral (dest_setenum se) + then (RAND_CONV SETENUM_NORM_CONV THENC conv) tm + else fail() + with Failure _ -> failwith "MBASIS_SPLIT_CONV"), + (fun tm -> try MP_CONV SET_CHECK_CONV (INST_MERGE tm) + with Failure _ -> failwith "MBASIS_MERGE_CONV");; + +(* ------------------------------------------------------------------------- *) +(* Convergent (if slow) rewrite set to bubble into position. *) +(* ------------------------------------------------------------------------- *) + +let OUTER_ACI = prove + (`(!x y z. (x outer y) outer z = x outer (y outer z)) /\ + (!i j. i > j + ==> mbasis{i} outer mbasis{j} = + --(&1) % (mbasis{j} outer mbasis{i})) /\ + (!i j x. i > j + ==> mbasis{i} outer mbasis{j} outer x = + --(&1) % (mbasis{j} outer mbasis{i} outer x)) /\ + (!i. mbasis{i} outer mbasis{i} = vec 0) /\ + (!i x. mbasis{i} outer mbasis{i} outer x = vec 0) /\ + (!x. mbasis{} outer x = x) /\ + (!x. x outer mbasis{} = x)`, + REWRITE_TAC[OUTER_ASSOC; OUTER_LZERO; OUTER_RZERO; OUTER_LADD; + OUTER_RADD; OUTER_LMUL; OUTER_RMUL; OUTER_LZERO; OUTER_RZERO] THEN + REWRITE_TAC[OUTER_MBASIS_REFL; OUTER_LZERO] THEN + REWRITE_TAC[OUTER_MBASIS_LSCALAR; OUTER_MBASIS_RSCALAR] THEN + SIMP_TAC[GSYM VECTOR_NEG_MINUS1; VECTOR_ARITH `x - y:real^N = x + --y`] THEN + MESON_TAC[OUTER_MBASIS_SKEWSYM; OUTER_LNEG]);; + +(* ------------------------------------------------------------------------- *) +(* Group the final "c1 % mbasis s1 + ... + cn % mbasis sn". *) +(* ------------------------------------------------------------------------- *) + +let MBASIS_GROUP_CONV tm = + let tms = striplist(dest_binary "vector_add") tm in + if length tms = 1 then LAND_CONV REAL_POLY_CONV tm else + let vadd_tm = rator(rator tm) in + let mk_vadd = mk_binop vadd_tm in + let mbs = map (snd o dest_binary "%") tms in + let tmbs = zip mbs tms and mset = setify mbs in + let grps = map (fun x -> map snd (filter (fun (x',_) -> x' = x) tmbs)) + mset in + let tm' = end_itlist mk_vadd (map (end_itlist mk_vadd) grps) in + let th1 = AC VECTOR_ADD_AC (mk_eq(tm,tm')) + and th2 = + (GEN_REWRITE_CONV DEPTH_CONV [GSYM VECTOR_ADD_RDISTRIB] THENC + DEPTH_BINOP_CONV vadd_tm (LAND_CONV REAL_POLY_CONV)) tm' in + TRANS th1 th2;; + +(* ------------------------------------------------------------------------- *) +(* Overall conversion. *) +(* ------------------------------------------------------------------------- *) + +let OUTER_CANON_CONV = + ONCE_DEPTH_CONV MBASIS_SPLIT_CONV THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV + [VECTOR_SUB; VECTOR_NEG_MINUS1; + OUTER_LADD; OUTER_RADD; OUTER_LMUL; OUTER_RMUL; OUTER_LZERO; OUTER_RZERO; + VECTOR_ADD_LDISTRIB; VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC; + VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THENC + REAL_RAT_REDUCE_CONV THENC + PURE_SIMP_CONV[OUTER_ACI; ARITH_GT; ARITH_GE; OUTER_LMUL; OUTER_RMUL; + OUTER_LZERO; OUTER_RZERO] THENC + PURE_REWRITE_CONV[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; + VECTOR_ADD_LID; VECTOR_ADD_RID; VECTOR_MUL_ASSOC] THENC + GEN_REWRITE_CONV I [GSYM VECTOR_MUL_LID] THENC + PURE_REWRITE_CONV + [VECTOR_ADD_LDISTRIB; VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC] THENC + REAL_RAT_REDUCE_CONV THENC PURE_REWRITE_CONV[GSYM VECTOR_ADD_ASSOC] THENC + DEPTH_CONV MBASIS_MERGE_CONV THENC + MBASIS_GROUP_CONV THENC + GEN_REWRITE_CONV DEPTH_CONV [GSYM VECTOR_ADD_RDISTRIB] THENC + REAL_RAT_REDUCE_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Iterated operation in order. *) +(* I guess this ought to be added to the core... *) +(* ------------------------------------------------------------------------- *) + +let seqiterate_EXISTS = prove + (`!op f. ?h. + !s. h s = if INFINITE s \/ s = {} then neutral op else + let i = minimal x. x IN s in + if s = {i} then f(i) else op (f i) (h (s DELETE i))`, + REPEAT GEN_TAC THEN REWRITE_TAC[INFINITE] THEN + MATCH_MP_TAC(MATCH_MP WF_REC (ISPEC `CARD:(num->bool)->num` WF_MEASURE)) THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + LET_TAC THEN CONV_TAC(ONCE_DEPTH_CONV let_CONV) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[MEASURE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN + SUBGOAL_THEN `?i:num. i IN s` MP_TAC THENL + [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [MINIMAL] THEN + ASM_SIMP_TAC[CARD_DELETE; CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`]);; + +let EXISTS_SWAP = prove + (`!P. (?f. P f) <=> (?f:A->B->C. P (\b a. f a b))`, + GEN_TAC THEN EQ_TAC THEN DISCH_THEN CHOOSE_TAC THENL + [EXISTS_TAC `\a b. (f:B->A->C) b a` THEN ASM_REWRITE_TAC[ETA_AX]; + ASM_MESON_TAC[]]);; + +let seqiterate = new_specification ["seqiterate"] + (REWRITE_RULE[SKOLEM_THM] + (ONCE_REWRITE_RULE[EXISTS_SWAP] + (ONCE_REWRITE_RULE[SKOLEM_THM] seqiterate_EXISTS)));; + +let MINIMAL_IN_INSERT = prove + (`!s i. (!j. j IN s ==> i < j) ==> (minimal j. j IN (i INSERT s)) = i`, + REPEAT STRIP_TAC THEN REWRITE_TAC[minimal] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN + REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[LT_ANTISYM]);; + +let SEQITERATE_CLAUSES = prove + (`(!op f. seqiterate op {} f = neutral op) /\ + (!op f i. seqiterate op {i} f = f(i)) /\ + (!op f i s. FINITE s /\ ~(s = {}) /\ (!j. j IN s ==> i < j) + ==> seqiterate op (i INSERT s) f = + op (f i) (seqiterate op s f))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [seqiterate] THEN + ASM_SIMP_TAC[NOT_INSERT_EMPTY; INFINITE; FINITE_INSERT; FINITE_RULES] THEN + ASM_SIMP_TAC[MINIMAL_IN_INSERT; NOT_IN_EMPTY; LET_DEF; LET_END_DEF] THEN + SUBGOAL_THEN `~((i:num) IN s)` ASSUME_TAC THENL + [ASM_MESON_TAC[LT_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[DELETE_INSERT; SET_RULE + `~(i IN s) /\ ~(s = {}) ==> (s DELETE i = s) /\ ~(i INSERT s = {i})`]);; + +(* ------------------------------------------------------------------------- *) +(* In the "common" case this agrees with ordinary iteration. *) +(* ------------------------------------------------------------------------- *) + +let SEQITERATE_ITERATE = prove + (`!op f s. monoidal op /\ FINITE s ==> seqiterate op s f = iterate op s f`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_DELETE THEN + ASM_SIMP_TAC[SEQITERATE_CLAUSES; ITERATE_CLAUSES] THEN + GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `i IN s ==> s = i INSERT (s DELETE i)`)) THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + ASM_CASES_TAC `s DELETE (i:num) = {}` THEN + ASM_SIMP_TAC[SEQITERATE_CLAUSES; ITERATE_CLAUSES] THENL + [ASM_MESON_TAC[monoidal]; FIRST_X_ASSUM(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC(last(CONJUNCTS SEQITERATE_CLAUSES)) THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN + ASM_MESON_TAC[LT_ANTISYM; LT_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Outermorphism extension. *) +(* ------------------------------------------------------------------------- *) + +let outermorphism = new_definition + `outermorphism(f:real^N->real^P) (x:real^(N)multivector) = + vsum {s | s SUBSET 1..dimindex(:N)} + (\s. x$$s % seqiterate(outer) s (multivec o f o basis))`;; + +let NEUTRAL_OUTER = prove + (`neutral(outer) = mbasis{}`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[OUTER_MBASIS_LSCALAR; OUTER_MBASIS_RSCALAR]);; + +let OUTERMORPHISM_MBASIS = prove + (`!f:real^M->real^N s t. + s SUBSET 1..dimindex(:M) + ==> outermorphism f (mbasis s) = + seqiterate(outer) s (multivec o f o basis)`, + REWRITE_TAC[outermorphism] THEN SIMP_TAC[MBASIS_COMPONENT] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + SIMP_TAC[VECTOR_MUL_LZERO; VSUM_DELTA; IN_ELIM_THM; VECTOR_MUL_LID]);; + +let OUTERMORPHISM_MBASIS_EMPTY = prove + (`!f. outermorphism f (mbasis {}) = mbasis {}`, + SIMP_TAC[OUTERMORPHISM_MBASIS; EMPTY_SUBSET; SEQITERATE_CLAUSES] THEN + REWRITE_TAC[NEUTRAL_OUTER]);; + +(* ------------------------------------------------------------------------- *) +(* Reversion operation. *) +(* ------------------------------------------------------------------------- *) + +let reversion = new_definition + `(reversion:real^(N)multivector->real^(N)multivector) x = + lambdas s. --(&1) pow ((CARD(s) * (CARD(s) - 1)) DIV 2) * x$$s`;; diff --git a/Multivariate/complex_database.ml b/Multivariate/complex_database.ml new file mode 100644 index 0000000..1587d05 --- /dev/null +++ b/Multivariate/complex_database.ml @@ -0,0 +1,12130 @@ +needs "help.ml";; + +theorems := +[ +"ABEL_LEMMA",ABEL_LEMMA; +"ABEL_LIMIT_THEOREM",ABEL_LIMIT_THEOREM; +"ABEL_POWER_SERIES_CONTINUOUS",ABEL_POWER_SERIES_CONTINUOUS; +"ABSOLUTELY_CONTINUOUS_INTEGRAL",ABSOLUTELY_CONTINUOUS_INTEGRAL; +"ABSOLUTELY_INTEGRABLE_0",ABSOLUTELY_INTEGRABLE_0; +"ABSOLUTELY_INTEGRABLE_ABS",ABSOLUTELY_INTEGRABLE_ABS; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND; +"ABSOLUTELY_INTEGRABLE_ABS_1",ABSOLUTELY_INTEGRABLE_ABS_1; +"ABSOLUTELY_INTEGRABLE_ABS_EQ",ABSOLUTELY_INTEGRABLE_ABS_EQ; +"ABSOLUTELY_INTEGRABLE_ADD",ABSOLUTELY_INTEGRABLE_ADD; +"ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS; +"ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT; +"ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; +"ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ; +"ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ; +"ABSOLUTELY_INTEGRABLE_CMUL",ABSOLUTELY_INTEGRABLE_CMUL; +"ABSOLUTELY_INTEGRABLE_COMPONENTWISE",ABSOLUTELY_INTEGRABLE_COMPONENTWISE; +"ABSOLUTELY_INTEGRABLE_CONST",ABSOLUTELY_INTEGRABLE_CONST; +"ABSOLUTELY_INTEGRABLE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_CONTINUOUS; +"ABSOLUTELY_INTEGRABLE_EQ",ABSOLUTELY_INTEGRABLE_EQ; +"ABSOLUTELY_INTEGRABLE_IMPROPER",ABSOLUTELY_INTEGRABLE_IMPROPER; +"ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE",ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; +"ABSOLUTELY_INTEGRABLE_INF_1",ABSOLUTELY_INTEGRABLE_INF_1; +"ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND; +"ABSOLUTELY_INTEGRABLE_LE",ABSOLUTELY_INTEGRABLE_LE; +"ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS",ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS; +"ABSOLUTELY_INTEGRABLE_LINEAR",ABSOLUTELY_INTEGRABLE_LINEAR; +"ABSOLUTELY_INTEGRABLE_MAX",ABSOLUTELY_INTEGRABLE_MAX; +"ABSOLUTELY_INTEGRABLE_MAX_1",ABSOLUTELY_INTEGRABLE_MAX_1; +"ABSOLUTELY_INTEGRABLE_MEASURABLE",ABSOLUTELY_INTEGRABLE_MEASURABLE; +"ABSOLUTELY_INTEGRABLE_MIN",ABSOLUTELY_INTEGRABLE_MIN; +"ABSOLUTELY_INTEGRABLE_MIN_1",ABSOLUTELY_INTEGRABLE_MIN_1; +"ABSOLUTELY_INTEGRABLE_NEG",ABSOLUTELY_INTEGRABLE_NEG; +"ABSOLUTELY_INTEGRABLE_NORM",ABSOLUTELY_INTEGRABLE_NORM; +"ABSOLUTELY_INTEGRABLE_ON_CONST",ABSOLUTELY_INTEGRABLE_ON_CONST; +"ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER",ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER; +"ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET",ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET; +"ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC",ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC; +"ABSOLUTELY_INTEGRABLE_ON_NULL",ABSOLUTELY_INTEGRABLE_ON_NULL; +"ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL",ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL; +"ABSOLUTELY_INTEGRABLE_PASTECART_SYM",ABSOLUTELY_INTEGRABLE_PASTECART_SYM; +"ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV",ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; +"ABSOLUTELY_INTEGRABLE_RESTRICT_INTER",ABSOLUTELY_INTEGRABLE_RESTRICT_INTER; +"ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV",ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; +"ABSOLUTELY_INTEGRABLE_SET_VARIATION",ABSOLUTELY_INTEGRABLE_SET_VARIATION; +"ABSOLUTELY_INTEGRABLE_SPIKE",ABSOLUTELY_INTEGRABLE_SPIKE; +"ABSOLUTELY_INTEGRABLE_SUB",ABSOLUTELY_INTEGRABLE_SUB; +"ABSOLUTELY_INTEGRABLE_SUP_1",ABSOLUTELY_INTEGRABLE_SUP_1; +"ABSOLUTELY_INTEGRABLE_VSUM",ABSOLUTELY_INTEGRABLE_VSUM; +"ABSOLUTELY_REAL_INTEGRABLE_0",ABSOLUTELY_REAL_INTEGRABLE_0; +"ABSOLUTELY_REAL_INTEGRABLE_ABS",ABSOLUTELY_REAL_INTEGRABLE_ABS; +"ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND",ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND; +"ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND",ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND; +"ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND",ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND; +"ABSOLUTELY_REAL_INTEGRABLE_ADD",ABSOLUTELY_REAL_INTEGRABLE_ADD; +"ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT",ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT; +"ABSOLUTELY_REAL_INTEGRABLE_CONST",ABSOLUTELY_REAL_INTEGRABLE_CONST; +"ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS",ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS; +"ABSOLUTELY_REAL_INTEGRABLE_DECREASING",ABSOLUTELY_REAL_INTEGRABLE_DECREASING; +"ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT",ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT; +"ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE",ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; +"ABSOLUTELY_REAL_INTEGRABLE_INCREASING",ABSOLUTELY_REAL_INTEGRABLE_INCREASING; +"ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT",ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT; +"ABSOLUTELY_REAL_INTEGRABLE_INF",ABSOLUTELY_REAL_INTEGRABLE_INF; +"ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND",ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND; +"ABSOLUTELY_REAL_INTEGRABLE_LE",ABSOLUTELY_REAL_INTEGRABLE_LE; +"ABSOLUTELY_REAL_INTEGRABLE_LINEAR",ABSOLUTELY_REAL_INTEGRABLE_LINEAR; +"ABSOLUTELY_REAL_INTEGRABLE_LMUL",ABSOLUTELY_REAL_INTEGRABLE_LMUL; +"ABSOLUTELY_REAL_INTEGRABLE_MAX",ABSOLUTELY_REAL_INTEGRABLE_MAX; +"ABSOLUTELY_REAL_INTEGRABLE_MIN",ABSOLUTELY_REAL_INTEGRABLE_MIN; +"ABSOLUTELY_REAL_INTEGRABLE_NEG",ABSOLUTELY_REAL_INTEGRABLE_NEG; +"ABSOLUTELY_REAL_INTEGRABLE_ON",ABSOLUTELY_REAL_INTEGRABLE_ON; +"ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL",ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL; +"ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE",ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE; +"ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV",ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV; +"ABSOLUTELY_REAL_INTEGRABLE_RMUL",ABSOLUTELY_REAL_INTEGRABLE_RMUL; +"ABSOLUTELY_REAL_INTEGRABLE_SUB",ABSOLUTELY_REAL_INTEGRABLE_SUB; +"ABSOLUTELY_REAL_INTEGRABLE_SUM",ABSOLUTELY_REAL_INTEGRABLE_SUM; +"ABSOLUTELY_REAL_INTEGRABLE_SUP",ABSOLUTELY_REAL_INTEGRABLE_SUP; +"ABSOLUTE_EXTENSOR_IMP_AR",ABSOLUTE_EXTENSOR_IMP_AR; +"ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR",ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR; +"ABSOLUTE_RETRACTION_CONVEX_CLOSED",ABSOLUTE_RETRACTION_CONVEX_CLOSED; +"ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE",ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE; +"ABSOLUTE_RETRACT_CONTRACTIBLE_ANR",ABSOLUTE_RETRACT_CONTRACTIBLE_ANR; +"ABSOLUTE_RETRACT_CONVEX",ABSOLUTE_RETRACT_CONVEX; +"ABSOLUTE_RETRACT_CONVEX_CLOSED",ABSOLUTE_RETRACT_CONVEX_CLOSED; +"ABSOLUTE_RETRACT_FROM_UNION_AND_INTER",ABSOLUTE_RETRACT_FROM_UNION_AND_INTER; +"ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT",ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT; +"ABSOLUTE_RETRACT_IMP_AR",ABSOLUTE_RETRACT_IMP_AR; +"ABSOLUTE_RETRACT_IMP_AR_GEN",ABSOLUTE_RETRACT_IMP_AR_GEN; +"ABSOLUTE_RETRACT_PATH_IMAGE_ARC",ABSOLUTE_RETRACT_PATH_IMAGE_ARC; +"ABSOLUTE_RETRACT_UNION",ABSOLUTE_RETRACT_UNION; +"ABSORPTION",ABSORPTION; +"ABS_DROP",ABS_DROP; +"ABS_SIMP",ABS_SIMP; +"ABS_SQUARE_EQ_1",ABS_SQUARE_EQ_1; +"ABS_SQUARE_LE_1",ABS_SQUARE_LE_1; +"ABS_SQUARE_LT_1",ABS_SQUARE_LT_1; +"ACS_0",ACS_0; +"ACS_1",ACS_1; +"ACS_ASN",ACS_ASN; +"ACS_ASN_SQRT_NEG",ACS_ASN_SQRT_NEG; +"ACS_ASN_SQRT_POS",ACS_ASN_SQRT_POS; +"ACS_ATN",ACS_ATN; +"ACS_BOUNDS",ACS_BOUNDS; +"ACS_BOUNDS_LT",ACS_BOUNDS_LT; +"ACS_COS",ACS_COS; +"ACS_INJ",ACS_INJ; +"ACS_MONO_LE",ACS_MONO_LE; +"ACS_MONO_LE_EQ",ACS_MONO_LE_EQ; +"ACS_MONO_LT",ACS_MONO_LT; +"ACS_MONO_LT_EQ",ACS_MONO_LT_EQ; +"ACS_NEG",ACS_NEG; +"ACS_NEG_1",ACS_NEG_1; +"ADD",ADD; +"ADD1",ADD1; +"ADDITIVE_CONTENT_DIVISION",ADDITIVE_CONTENT_DIVISION; +"ADDITIVE_CONTENT_TAGGED_DIVISION",ADDITIVE_CONTENT_TAGGED_DIVISION; +"ADDITIVE_TAGGED_DIVISION_1",ADDITIVE_TAGGED_DIVISION_1; +"ADD_0",ADD_0; +"ADD_AC",ADD_AC; +"ADD_ASSOC",ADD_ASSOC; +"ADD_CLAUSES",ADD_CLAUSES; +"ADD_EQ_0",ADD_EQ_0; +"ADD_SUB",ADD_SUB; +"ADD_SUB2",ADD_SUB2; +"ADD_SUBR",ADD_SUBR; +"ADD_SUBR2",ADD_SUBR2; +"ADD_SUC",ADD_SUC; +"ADD_SYM",ADD_SYM; +"ADJOINT_ADJOINT",ADJOINT_ADJOINT; +"ADJOINT_CLAUSES",ADJOINT_CLAUSES; +"ADJOINT_COMPOSE",ADJOINT_COMPOSE; +"ADJOINT_INJECTIVE",ADJOINT_INJECTIVE; +"ADJOINT_INJECTIVE_INJECTIVE",ADJOINT_INJECTIVE_INJECTIVE; +"ADJOINT_INJECTIVE_INJECTIVE_0",ADJOINT_INJECTIVE_INJECTIVE_0; +"ADJOINT_LINEAR",ADJOINT_LINEAR; +"ADJOINT_MATRIX",ADJOINT_MATRIX; +"ADJOINT_SURJECTIVE",ADJOINT_SURJECTIVE; +"ADJOINT_UNIQUE",ADJOINT_UNIQUE; +"ADJOINT_WORKS",ADJOINT_WORKS; +"ADMISSIBLE_BASE",ADMISSIBLE_BASE; +"ADMISSIBLE_COMB",ADMISSIBLE_COMB; +"ADMISSIBLE_COND",ADMISSIBLE_COND; +"ADMISSIBLE_CONST",ADMISSIBLE_CONST; +"ADMISSIBLE_GUARDED_PATTERN",ADMISSIBLE_GUARDED_PATTERN; +"ADMISSIBLE_IMP_SUPERADMISSIBLE",ADMISSIBLE_IMP_SUPERADMISSIBLE; +"ADMISSIBLE_LAMBDA",ADMISSIBLE_LAMBDA; +"ADMISSIBLE_MAP",ADMISSIBLE_MAP; +"ADMISSIBLE_MATCH",ADMISSIBLE_MATCH; +"ADMISSIBLE_MATCH_SEQPATTERN",ADMISSIBLE_MATCH_SEQPATTERN; +"ADMISSIBLE_NEST",ADMISSIBLE_NEST; +"ADMISSIBLE_NSUM",ADMISSIBLE_NSUM; +"ADMISSIBLE_RAND",ADMISSIBLE_RAND; +"ADMISSIBLE_SEQPATTERN",ADMISSIBLE_SEQPATTERN; +"ADMISSIBLE_SUM",ADMISSIBLE_SUM; +"ADMISSIBLE_UNGUARDED_PATTERN",ADMISSIBLE_UNGUARDED_PATTERN; +"AFFINE",AFFINE; +"AFFINE_AFFINE_HULL",AFFINE_AFFINE_HULL; +"AFFINE_AFFINITY",AFFINE_AFFINITY; +"AFFINE_ALT",AFFINE_ALT; +"AFFINE_BASIS_EXISTS",AFFINE_BASIS_EXISTS; +"AFFINE_BOUNDED_EQ_LOWDIM",AFFINE_BOUNDED_EQ_LOWDIM; +"AFFINE_BOUNDED_EQ_TRIVIAL",AFFINE_BOUNDED_EQ_TRIVIAL; +"AFFINE_DEPENDENT_BIGGERSET",AFFINE_DEPENDENT_BIGGERSET; +"AFFINE_DEPENDENT_BIGGERSET_GENERAL",AFFINE_DEPENDENT_BIGGERSET_GENERAL; +"AFFINE_DEPENDENT_CHOOSE",AFFINE_DEPENDENT_CHOOSE; +"AFFINE_DEPENDENT_EXPLICIT",AFFINE_DEPENDENT_EXPLICIT; +"AFFINE_DEPENDENT_EXPLICIT_FINITE",AFFINE_DEPENDENT_EXPLICIT_FINITE; +"AFFINE_DEPENDENT_IMP_COLLINEAR_3",AFFINE_DEPENDENT_IMP_COLLINEAR_3; +"AFFINE_DEPENDENT_IMP_DEPENDENT",AFFINE_DEPENDENT_IMP_DEPENDENT; +"AFFINE_DEPENDENT_LINEAR_IMAGE",AFFINE_DEPENDENT_LINEAR_IMAGE; +"AFFINE_DEPENDENT_LINEAR_IMAGE_EQ",AFFINE_DEPENDENT_LINEAR_IMAGE_EQ; +"AFFINE_DEPENDENT_MONO",AFFINE_DEPENDENT_MONO; +"AFFINE_DEPENDENT_TRANSLATION",AFFINE_DEPENDENT_TRANSLATION; +"AFFINE_DEPENDENT_TRANSLATION_EQ",AFFINE_DEPENDENT_TRANSLATION_EQ; +"AFFINE_DIFFERENCES",AFFINE_DIFFERENCES; +"AFFINE_DIFFS_SUBSPACE",AFFINE_DIFFS_SUBSPACE; +"AFFINE_EMPTY",AFFINE_EMPTY; +"AFFINE_EQ_SUBSPACE",AFFINE_EQ_SUBSPACE; +"AFFINE_EXPLICIT",AFFINE_EXPLICIT; +"AFFINE_HULLS_EQ",AFFINE_HULLS_EQ; +"AFFINE_HULL_2",AFFINE_HULL_2; +"AFFINE_HULL_2_ALT",AFFINE_HULL_2_ALT; +"AFFINE_HULL_3",AFFINE_HULL_3; +"AFFINE_HULL_3_IMP_COLLINEAR",AFFINE_HULL_3_IMP_COLLINEAR; +"AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR; +"AFFINE_HULL_AFFINE_INTER_OPEN",AFFINE_HULL_AFFINE_INTER_OPEN; +"AFFINE_HULL_AFFINE_INTER_OPEN_IN",AFFINE_HULL_AFFINE_INTER_OPEN_IN; +"AFFINE_HULL_CLOSURE",AFFINE_HULL_CLOSURE; +"AFFINE_HULL_CONVEX_HULL",AFFINE_HULL_CONVEX_HULL; +"AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; +"AFFINE_HULL_CONVEX_INTER_OPEN",AFFINE_HULL_CONVEX_INTER_OPEN; +"AFFINE_HULL_CONVEX_INTER_OPEN_IN",AFFINE_HULL_CONVEX_INTER_OPEN_IN; +"AFFINE_HULL_EMPTY",AFFINE_HULL_EMPTY; +"AFFINE_HULL_EQ",AFFINE_HULL_EQ; +"AFFINE_HULL_EQ_EMPTY",AFFINE_HULL_EQ_EMPTY; +"AFFINE_HULL_EQ_SING",AFFINE_HULL_EQ_SING; +"AFFINE_HULL_EQ_SPAN",AFFINE_HULL_EQ_SPAN; +"AFFINE_HULL_EQ_SPAN_EQ",AFFINE_HULL_EQ_SPAN_EQ; +"AFFINE_HULL_EXPLICIT",AFFINE_HULL_EXPLICIT; +"AFFINE_HULL_EXPLICIT_ALT",AFFINE_HULL_EXPLICIT_ALT; +"AFFINE_HULL_EXPLICIT_UNIQUE",AFFINE_HULL_EXPLICIT_UNIQUE; +"AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR",AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR; +"AFFINE_HULL_FINITE",AFFINE_HULL_FINITE; +"AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES",AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES; +"AFFINE_HULL_FINITE_STEP",AFFINE_HULL_FINITE_STEP; +"AFFINE_HULL_FINITE_STEP_GEN",AFFINE_HULL_FINITE_STEP_GEN; +"AFFINE_HULL_HALFSPACE_GE",AFFINE_HULL_HALFSPACE_GE; +"AFFINE_HULL_HALFSPACE_GT",AFFINE_HULL_HALFSPACE_GT; +"AFFINE_HULL_HALFSPACE_LE",AFFINE_HULL_HALFSPACE_LE; +"AFFINE_HULL_HALFSPACE_LT",AFFINE_HULL_HALFSPACE_LT; +"AFFINE_HULL_INDEXED",AFFINE_HULL_INDEXED; +"AFFINE_HULL_INSERT_SPAN",AFFINE_HULL_INSERT_SPAN; +"AFFINE_HULL_INSERT_SUBSET_SPAN",AFFINE_HULL_INSERT_SUBSET_SPAN; +"AFFINE_HULL_INTER",AFFINE_HULL_INTER; +"AFFINE_HULL_INTERS",AFFINE_HULL_INTERS; +"AFFINE_HULL_LINEAR_IMAGE",AFFINE_HULL_LINEAR_IMAGE; +"AFFINE_HULL_NONEMPTY_INTERIOR",AFFINE_HULL_NONEMPTY_INTERIOR; +"AFFINE_HULL_OPEN",AFFINE_HULL_OPEN; +"AFFINE_HULL_OPEN_IN",AFFINE_HULL_OPEN_IN; +"AFFINE_HULL_PCROSS",AFFINE_HULL_PCROSS; +"AFFINE_HULL_RELATIVE_INTERIOR",AFFINE_HULL_RELATIVE_INTERIOR; +"AFFINE_HULL_SEGMENT",AFFINE_HULL_SEGMENT; +"AFFINE_HULL_SING",AFFINE_HULL_SING; +"AFFINE_HULL_SPAN",AFFINE_HULL_SPAN; +"AFFINE_HULL_SUBSET_SPAN",AFFINE_HULL_SUBSET_SPAN; +"AFFINE_HULL_TRANSLATION",AFFINE_HULL_TRANSLATION; +"AFFINE_HULL_UNIV",AFFINE_HULL_UNIV; +"AFFINE_HYPERPLANE",AFFINE_HYPERPLANE; +"AFFINE_HYPERPLANE_SUMS_EQ_UNIV",AFFINE_HYPERPLANE_SUMS_EQ_UNIV; +"AFFINE_IMP_CONVEX",AFFINE_IMP_CONVEX; +"AFFINE_IMP_POLYHEDRON",AFFINE_IMP_POLYHEDRON; +"AFFINE_IMP_SUBSPACE",AFFINE_IMP_SUBSPACE; +"AFFINE_INDEPENDENT_1",AFFINE_INDEPENDENT_1; +"AFFINE_INDEPENDENT_2",AFFINE_INDEPENDENT_2; +"AFFINE_INDEPENDENT_CARD_DIM_DIFFS",AFFINE_INDEPENDENT_CARD_DIM_DIFFS; +"AFFINE_INDEPENDENT_CARD_LE",AFFINE_INDEPENDENT_CARD_LE; +"AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL",AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL; +"AFFINE_INDEPENDENT_DELETE",AFFINE_INDEPENDENT_DELETE; +"AFFINE_INDEPENDENT_EMPTY",AFFINE_INDEPENDENT_EMPTY; +"AFFINE_INDEPENDENT_IFF_CARD",AFFINE_INDEPENDENT_IFF_CARD; +"AFFINE_INDEPENDENT_IMP_FINITE",AFFINE_INDEPENDENT_IMP_FINITE; +"AFFINE_INDEPENDENT_INSERT",AFFINE_INDEPENDENT_INSERT; +"AFFINE_INDEPENDENT_SPAN_EQ",AFFINE_INDEPENDENT_SPAN_EQ; +"AFFINE_INDEPENDENT_SPAN_GT",AFFINE_INDEPENDENT_SPAN_GT; +"AFFINE_INDEPENDENT_STDBASIS",AFFINE_INDEPENDENT_STDBASIS; +"AFFINE_INDEPENDENT_SUBSET",AFFINE_INDEPENDENT_SUBSET; +"AFFINE_INDEXED",AFFINE_INDEXED; +"AFFINE_INTER",AFFINE_INTER; +"AFFINE_INTERS",AFFINE_INTERS; +"AFFINE_LINEAR_IMAGE",AFFINE_LINEAR_IMAGE; +"AFFINE_LINEAR_IMAGE_EQ",AFFINE_LINEAR_IMAGE_EQ; +"AFFINE_NEGATIONS",AFFINE_NEGATIONS; +"AFFINE_PARALLEL_SLICE",AFFINE_PARALLEL_SLICE; +"AFFINE_PCROSS",AFFINE_PCROSS; +"AFFINE_PCROSS_EQ",AFFINE_PCROSS_EQ; +"AFFINE_SCALING",AFFINE_SCALING; +"AFFINE_SCALING_EQ",AFFINE_SCALING_EQ; +"AFFINE_SING",AFFINE_SING; +"AFFINE_SPAN",AFFINE_SPAN; +"AFFINE_STANDARD_HYPERPLANE",AFFINE_STANDARD_HYPERPLANE; +"AFFINE_SUMS",AFFINE_SUMS; +"AFFINE_TRANSLATION",AFFINE_TRANSLATION; +"AFFINE_TRANSLATION_EQ",AFFINE_TRANSLATION_EQ; +"AFFINE_TRANSLATION_SUBSPACE",AFFINE_TRANSLATION_SUBSPACE; +"AFFINE_TRANSLATION_SUBSPACE_EXPLICIT",AFFINE_TRANSLATION_SUBSPACE_EXPLICIT; +"AFFINE_TRANSLATION_UNIQUE_SUBSPACE",AFFINE_TRANSLATION_UNIQUE_SUBSPACE; +"AFFINE_UNIV",AFFINE_UNIV; +"AFFINE_VSUM",AFFINE_VSUM; +"AFFINE_VSUM_STRONG",AFFINE_VSUM_STRONG; +"AFFINITY_INVERSES",AFFINITY_INVERSES; +"AFF_DIM",AFF_DIM; +"AFF_DIM_2",AFF_DIM_2; +"AFF_DIM_AFFINE_HULL",AFF_DIM_AFFINE_HULL; +"AFF_DIM_AFFINE_INDEPENDENT",AFF_DIM_AFFINE_INDEPENDENT; +"AFF_DIM_AFFINE_INTER_HYPERPLANE",AFF_DIM_AFFINE_INTER_HYPERPLANE; +"AFF_DIM_BALL",AFF_DIM_BALL; +"AFF_DIM_CBALL",AFF_DIM_CBALL; +"AFF_DIM_CLOSURE",AFF_DIM_CLOSURE; +"AFF_DIM_CONVEX_HULL",AFF_DIM_CONVEX_HULL; +"AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR",AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR; +"AFF_DIM_CONVEX_INTER_OPEN",AFF_DIM_CONVEX_INTER_OPEN; +"AFF_DIM_DIM_0",AFF_DIM_DIM_0; +"AFF_DIM_DIM_AFFINE_DIFFS",AFF_DIM_DIM_AFFINE_DIFFS; +"AFF_DIM_DIM_SUBSPACE",AFF_DIM_DIM_SUBSPACE; +"AFF_DIM_EMPTY",AFF_DIM_EMPTY; +"AFF_DIM_EQ_0",AFF_DIM_EQ_0; +"AFF_DIM_EQ_AFFINE_HULL",AFF_DIM_EQ_AFFINE_HULL; +"AFF_DIM_EQ_FULL",AFF_DIM_EQ_FULL; +"AFF_DIM_EQ_HYPERPLANE",AFF_DIM_EQ_HYPERPLANE; +"AFF_DIM_EQ_MINUS1",AFF_DIM_EQ_MINUS1; +"AFF_DIM_GE",AFF_DIM_GE; +"AFF_DIM_HALFSPACE_GE",AFF_DIM_HALFSPACE_GE; +"AFF_DIM_HALFSPACE_GT",AFF_DIM_HALFSPACE_GT; +"AFF_DIM_HALFSPACE_LE",AFF_DIM_HALFSPACE_LE; +"AFF_DIM_HALFSPACE_LT",AFF_DIM_HALFSPACE_LT; +"AFF_DIM_HYPERPLANE",AFF_DIM_HYPERPLANE; +"AFF_DIM_INJECTIVE_LINEAR_IMAGE",AFF_DIM_INJECTIVE_LINEAR_IMAGE; +"AFF_DIM_INSERT",AFF_DIM_INSERT; +"AFF_DIM_INTERVAL",AFF_DIM_INTERVAL; +"AFF_DIM_LE_CARD",AFF_DIM_LE_CARD; +"AFF_DIM_LE_DIM",AFF_DIM_LE_DIM; +"AFF_DIM_LE_UNIV",AFF_DIM_LE_UNIV; +"AFF_DIM_LINEAR_IMAGE_LE",AFF_DIM_LINEAR_IMAGE_LE; +"AFF_DIM_LT_FULL",AFF_DIM_LT_FULL; +"AFF_DIM_NONEMPTY_INTERIOR",AFF_DIM_NONEMPTY_INTERIOR; +"AFF_DIM_NONEMPTY_INTERIOR_EQ",AFF_DIM_NONEMPTY_INTERIOR_EQ; +"AFF_DIM_OPEN",AFF_DIM_OPEN; +"AFF_DIM_OPEN_IN",AFF_DIM_OPEN_IN; +"AFF_DIM_POS_LE",AFF_DIM_POS_LE; +"AFF_DIM_PSUBSET",AFF_DIM_PSUBSET; +"AFF_DIM_SIMPLEX",AFF_DIM_SIMPLEX; +"AFF_DIM_SING",AFF_DIM_SING; +"AFF_DIM_SUBSET",AFF_DIM_SUBSET; +"AFF_DIM_SUMS_INTER",AFF_DIM_SUMS_INTER; +"AFF_DIM_TRANSLATION_EQ",AFF_DIM_TRANSLATION_EQ; +"AFF_DIM_UNIQUE",AFF_DIM_UNIQUE; +"AFF_DIM_UNIV",AFF_DIM_UNIV; +"AFF_LOWDIM_SUBSET_HYPERPLANE",AFF_LOWDIM_SUBSET_HYPERPLANE; +"AGM",AGM; +"AGM_2",AGM_2; +"AGM_GEN",AGM_GEN; +"AGM_ROOT",AGM_ROOT; +"AGM_RPOW",AGM_RPOW; +"AGM_SQRT",AGM_SQRT; +"ALL",ALL; +"ALL2",ALL2; +"ALL2_ALL",ALL2_ALL; +"ALL2_AND_RIGHT",ALL2_AND_RIGHT; +"ALL2_DEF",ALL2_DEF; +"ALL2_MAP",ALL2_MAP; +"ALL2_MAP2",ALL2_MAP2; +"ALL_APPEND",ALL_APPEND; +"ALL_EL",ALL_EL; +"ALL_FILTER",ALL_FILTER; +"ALL_IMP",ALL_IMP; +"ALL_MAP",ALL_MAP; +"ALL_MEM",ALL_MEM; +"ALL_MP",ALL_MP; +"ALL_T",ALL_T; +"ALWAYS_EVENTUALLY",ALWAYS_EVENTUALLY; +"ANALYTIC_AT",ANALYTIC_AT; +"ANALYTIC_AT_ADD",ANALYTIC_AT_ADD; +"ANALYTIC_AT_BALL",ANALYTIC_AT_BALL; +"ANALYTIC_AT_MUL",ANALYTIC_AT_MUL; +"ANALYTIC_AT_POW",ANALYTIC_AT_POW; +"ANALYTIC_AT_SUB",ANALYTIC_AT_SUB; +"ANALYTIC_AT_TWO",ANALYTIC_AT_TWO; +"ANALYTIC_COMPLEX_DERIVATIVE",ANALYTIC_COMPLEX_DERIVATIVE; +"ANALYTIC_CONTINUATION",ANALYTIC_CONTINUATION; +"ANALYTIC_HIGHER_COMPLEX_DERIVATIVE",ANALYTIC_HIGHER_COMPLEX_DERIVATIVE; +"ANALYTIC_IFF_POWER_SERIES",ANALYTIC_IFF_POWER_SERIES; +"ANALYTIC_IMP_HOLOMORPHIC",ANALYTIC_IMP_HOLOMORPHIC; +"ANALYTIC_ON_ADD",ANALYTIC_ON_ADD; +"ANALYTIC_ON_ANALYTIC_AT",ANALYTIC_ON_ANALYTIC_AT; +"ANALYTIC_ON_COMPOSE",ANALYTIC_ON_COMPOSE; +"ANALYTIC_ON_COMPOSE_GEN",ANALYTIC_ON_COMPOSE_GEN; +"ANALYTIC_ON_CONST",ANALYTIC_ON_CONST; +"ANALYTIC_ON_DIV",ANALYTIC_ON_DIV; +"ANALYTIC_ON_HOLOMORPHIC",ANALYTIC_ON_HOLOMORPHIC; +"ANALYTIC_ON_ID",ANALYTIC_ON_ID; +"ANALYTIC_ON_IMP_DIFFERENTIABLE_AT",ANALYTIC_ON_IMP_DIFFERENTIABLE_AT; +"ANALYTIC_ON_INV",ANALYTIC_ON_INV; +"ANALYTIC_ON_LINEAR",ANALYTIC_ON_LINEAR; +"ANALYTIC_ON_MUL",ANALYTIC_ON_MUL; +"ANALYTIC_ON_NEG",ANALYTIC_ON_NEG; +"ANALYTIC_ON_OPEN",ANALYTIC_ON_OPEN; +"ANALYTIC_ON_POW",ANALYTIC_ON_POW; +"ANALYTIC_ON_SUB",ANALYTIC_ON_SUB; +"ANALYTIC_ON_SUBSET",ANALYTIC_ON_SUBSET; +"ANALYTIC_ON_UNION",ANALYTIC_ON_UNION; +"ANALYTIC_ON_UNIONS",ANALYTIC_ON_UNIONS; +"ANALYTIC_ON_VSUM",ANALYTIC_ON_VSUM; +"AND_ALL",AND_ALL; +"AND_ALL2",AND_ALL2; +"AND_CLAUSES",AND_CLAUSES; +"AND_DEF",AND_DEF; +"AND_FORALL_THM",AND_FORALL_THM; +"ANR",ANR; +"ANR_BALL",ANR_BALL; +"ANR_CBALL",ANR_CBALL; +"ANR_CLOSED_UNION",ANR_CLOSED_UNION; +"ANR_CLOSED_UNION_LOCAL",ANR_CLOSED_UNION_LOCAL; +"ANR_COMPONENT_ANR",ANR_COMPONENT_ANR; +"ANR_CONNECTED_COMPONENT_ANR",ANR_CONNECTED_COMPONENT_ANR; +"ANR_DELETE",ANR_DELETE; +"ANR_EMPTY",ANR_EMPTY; +"ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; +"ANR_FINITE_UNIONS_CONVEX_CLOSED",ANR_FINITE_UNIONS_CONVEX_CLOSED; +"ANR_FROM_UNION_AND_INTER",ANR_FROM_UNION_AND_INTER; +"ANR_FROM_UNION_AND_INTER_LOCAL",ANR_FROM_UNION_AND_INTER_LOCAL; +"ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR; +"ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT; +"ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; +"ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; +"ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; +"ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT; +"ANR_IMP_LOCALLY_CONNECTED",ANR_IMP_LOCALLY_CONNECTED; +"ANR_IMP_LOCALLY_PATH_CONNECTED",ANR_IMP_LOCALLY_PATH_CONNECTED; +"ANR_IMP_NEIGHBOURHOOD_RETRACT",ANR_IMP_NEIGHBOURHOOD_RETRACT; +"ANR_INSERT",ANR_INSERT; +"ANR_INTERIOR",ANR_INTERIOR; +"ANR_INTERVAL",ANR_INTERVAL; +"ANR_LINEAR_IMAGE_EQ",ANR_LINEAR_IMAGE_EQ; +"ANR_NEIGHBORHOOD_RETRACT",ANR_NEIGHBORHOOD_RETRACT; +"ANR_OPEN_IN",ANR_OPEN_IN; +"ANR_PATH_COMPONENT_ANR",ANR_PATH_COMPONENT_ANR; +"ANR_PATH_IMAGE_SIMPLE_PATH",ANR_PATH_IMAGE_SIMPLE_PATH; +"ANR_PCROSS",ANR_PCROSS; +"ANR_PCROSS_EQ",ANR_PCROSS_EQ; +"ANR_RELATIVE_FRONTIER_CONVEX",ANR_RELATIVE_FRONTIER_CONVEX; +"ANR_RELATIVE_INTERIOR",ANR_RELATIVE_INTERIOR; +"ANR_RETRACT_OF_ANR",ANR_RETRACT_OF_ANR; +"ANR_SIMPLICIAL_COMPLEX",ANR_SIMPLICIAL_COMPLEX; +"ANR_SING",ANR_SING; +"ANR_SPHERE",ANR_SPHERE; +"ANR_TRANSLATION",ANR_TRANSLATION; +"ANR_TRIANGULATION",ANR_TRIANGULATION; +"ANR_UNIV",ANR_UNIV; +"ANTIDERIVATIVE_CONTINUOUS",ANTIDERIVATIVE_CONTINUOUS; +"ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",ANTIDERIVATIVE_INTEGRAL_CONTINUOUS; +"ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL",ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL; +"ANY_CLOSEST_POINT_DOT",ANY_CLOSEST_POINT_DOT; +"ANY_CLOSEST_POINT_UNIQUE",ANY_CLOSEST_POINT_UNIQUE; +"APPELL_SEQUENCE",APPELL_SEQUENCE; +"APPEND",APPEND; +"APPEND_ASSOC",APPEND_ASSOC; +"APPEND_BUTLAST_LAST",APPEND_BUTLAST_LAST; +"APPEND_EQ_NIL",APPEND_EQ_NIL; +"APPEND_NIL",APPEND_NIL; +"APPEND_SING",APPEND_SING; +"APPROACHABLE_LT_LE",APPROACHABLE_LT_LE; +"APPROXIMABLE_ON_DIVISION",APPROXIMABLE_ON_DIVISION; +"AR",AR; +"ARC_ASSOC",ARC_ASSOC; +"ARC_CONNECTED_TRANS",ARC_CONNECTED_TRANS; +"ARC_DISTINCT_ENDS",ARC_DISTINCT_ENDS; +"ARC_IMP_PATH",ARC_IMP_PATH; +"ARC_IMP_SIMPLE_PATH",ARC_IMP_SIMPLE_PATH; +"ARC_JOIN",ARC_JOIN; +"ARC_JOIN_EQ",ARC_JOIN_EQ; +"ARC_JOIN_EQ_ALT",ARC_JOIN_EQ_ALT; +"ARC_LINEAR_IMAGE_EQ",ARC_LINEAR_IMAGE_EQ; +"ARC_LINEPATH",ARC_LINEPATH; +"ARC_LINEPATH_EQ",ARC_LINEPATH_EQ; +"ARC_PARTCIRCLEPATH",ARC_PARTCIRCLEPATH; +"ARC_REVERSEPATH",ARC_REVERSEPATH; +"ARC_SIMPLE_PATH",ARC_SIMPLE_PATH; +"ARC_SIMPLE_PATH_SUBPATH",ARC_SIMPLE_PATH_SUBPATH; +"ARC_SIMPLE_PATH_SUBPATH_INTERIOR",ARC_SIMPLE_PATH_SUBPATH_INTERIOR; +"ARC_SUBPATH_ARC",ARC_SUBPATH_ARC; +"ARC_SUBPATH_EQ",ARC_SUBPATH_EQ; +"ARC_TRANSLATION_EQ",ARC_TRANSLATION_EQ; +"ARG",ARG; +"ARG_0",ARG_0; +"ARG_ATAN_UPPERHALF",ARG_ATAN_UPPERHALF; +"ARG_CEXP",ARG_CEXP; +"ARG_CLOG",ARG_CLOG; +"ARG_CNJ",ARG_CNJ; +"ARG_DIV_CX",ARG_DIV_CX; +"ARG_EQ",ARG_EQ; +"ARG_EQ_0",ARG_EQ_0; +"ARG_EQ_0_PI",ARG_EQ_0_PI; +"ARG_EQ_PI",ARG_EQ_PI; +"ARG_INV",ARG_INV; +"ARG_INV_EQ_0",ARG_INV_EQ_0; +"ARG_LE_DIV_SUM",ARG_LE_DIV_SUM; +"ARG_LE_DIV_SUM_EQ",ARG_LE_DIV_SUM_EQ; +"ARG_LE_PI",ARG_LE_PI; +"ARG_LT_NZ",ARG_LT_NZ; +"ARG_LT_PI",ARG_LT_PI; +"ARG_MUL",ARG_MUL; +"ARG_MUL_CX",ARG_MUL_CX; +"ARG_NUM",ARG_NUM; +"ARG_REAL",ARG_REAL; +"ARG_ROTATE2D",ARG_ROTATE2D; +"ARG_ROTATE2D_UNIQUE",ARG_ROTATE2D_UNIQUE; +"ARG_ROTATE2D_UNIQUE_2PI",ARG_ROTATE2D_UNIQUE_2PI; +"ARG_UNIQUE",ARG_UNIQUE; +"ARITH",ARITH; +"ARITH_ADD",ARITH_ADD; +"ARITH_EQ",ARITH_EQ; +"ARITH_EVEN",ARITH_EVEN; +"ARITH_EXP",ARITH_EXP; +"ARITH_GE",ARITH_GE; +"ARITH_GT",ARITH_GT; +"ARITH_LE",ARITH_LE; +"ARITH_LT",ARITH_LT; +"ARITH_MULT",ARITH_MULT; +"ARITH_ODD",ARITH_ODD; +"ARITH_PRE",ARITH_PRE; +"ARITH_SUB",ARITH_SUB; +"ARITH_SUC",ARITH_SUC; +"ARITH_ZERO",ARITH_ZERO; +"ARZELA_ASCOLI",ARZELA_ASCOLI; +"AR_ANR",AR_ANR; +"AR_BALL",AR_BALL; +"AR_CBALL",AR_CBALL; +"AR_CLOSED_UNION",AR_CLOSED_UNION; +"AR_CLOSED_UNION_LOCAL",AR_CLOSED_UNION_LOCAL; +"AR_EQ_ABSOLUTE_EXTENSOR",AR_EQ_ABSOLUTE_EXTENSOR; +"AR_FROM_UNION_AND_INTER",AR_FROM_UNION_AND_INTER; +"AR_FROM_UNION_AND_INTER_LOCAL",AR_FROM_UNION_AND_INTER_LOCAL; +"AR_IMP_ABSOLUTE_EXTENSOR",AR_IMP_ABSOLUTE_EXTENSOR; +"AR_IMP_ABSOLUTE_RETRACT",AR_IMP_ABSOLUTE_RETRACT; +"AR_IMP_ABSOLUTE_RETRACT_UNIV",AR_IMP_ABSOLUTE_RETRACT_UNIV; +"AR_IMP_ANR",AR_IMP_ANR; +"AR_IMP_CONTRACTIBLE",AR_IMP_CONTRACTIBLE; +"AR_IMP_LOCALLY_CONNECTED",AR_IMP_LOCALLY_CONNECTED; +"AR_IMP_LOCALLY_PATH_CONNECTED",AR_IMP_LOCALLY_PATH_CONNECTED; +"AR_IMP_RETRACT",AR_IMP_RETRACT; +"AR_INTERVAL",AR_INTERVAL; +"AR_LINEAR_IMAGE_EQ",AR_LINEAR_IMAGE_EQ; +"AR_PCROSS",AR_PCROSS; +"AR_PCROSS_EQ",AR_PCROSS_EQ; +"AR_RETRACT_OF_AR",AR_RETRACT_OF_AR; +"AR_SING",AR_SING; +"AR_TRANSLATION",AR_TRANSLATION; +"AR_UNIV",AR_UNIV; +"ASN_0",ASN_0; +"ASN_1",ASN_1; +"ASN_ACS",ASN_ACS; +"ASN_ACS_SQRT_NEG",ASN_ACS_SQRT_NEG; +"ASN_ACS_SQRT_POS",ASN_ACS_SQRT_POS; +"ASN_ATN",ASN_ATN; +"ASN_BOUNDS",ASN_BOUNDS; +"ASN_BOUNDS_LT",ASN_BOUNDS_LT; +"ASN_BOUNDS_PI2",ASN_BOUNDS_PI2; +"ASN_MONO_LE",ASN_MONO_LE; +"ASN_MONO_LE_EQ",ASN_MONO_LE_EQ; +"ASN_MONO_LT",ASN_MONO_LT; +"ASN_MONO_LT_EQ",ASN_MONO_LT_EQ; +"ASN_NEG",ASN_NEG; +"ASN_NEG_1",ASN_NEG_1; +"ASN_PLUS_ACS",ASN_PLUS_ACS; +"ASN_SIN",ASN_SIN; +"ASSOC",ASSOC; +"AT",AT; +"ATN_0",ATN_0; +"ATN_1",ATN_1; +"ATN_ABS",ATN_ABS; +"ATN_ABS_LE_X",ATN_ABS_LE_X; +"ATN_ADD",ATN_ADD; +"ATN_ADD_SMALL",ATN_ADD_SMALL; +"ATN_BOUND",ATN_BOUND; +"ATN_BOUNDS",ATN_BOUNDS; +"ATN_INJ",ATN_INJ; +"ATN_INV",ATN_INV; +"ATN_LE_PI4",ATN_LE_PI4; +"ATN_LE_X",ATN_LE_X; +"ATN_LT_PI4",ATN_LT_PI4; +"ATN_LT_PI4_NEG",ATN_LT_PI4_NEG; +"ATN_LT_PI4_POS",ATN_LT_PI4_POS; +"ATN_MONO_LE_EQ",ATN_MONO_LE_EQ; +"ATN_MONO_LT",ATN_MONO_LT; +"ATN_MONO_LT_EQ",ATN_MONO_LT_EQ; +"ATN_NEG",ATN_NEG; +"ATN_POS_LE",ATN_POS_LE; +"ATN_POS_LT",ATN_POS_LT; +"ATN_TAN",ATN_TAN; +"ATREAL",ATREAL; +"AT_INFINITY",AT_INFINITY; +"AT_NEGINFINITY",AT_NEGINFINITY; +"AT_POSINFINITY",AT_POSINFINITY; +"AUSTIN_LEMMA",AUSTIN_LEMMA; +"Arg_DEF",Arg_DEF; +"BABY_SARD",BABY_SARD; +"BAIRE",BAIRE; +"BAIRE_ALT",BAIRE_ALT; +"BALL_1",BALL_1; +"BALL_BIHOLOMORPHISM_EXISTS",BALL_BIHOLOMORPHISM_EXISTS; +"BALL_BIHOLOMORPHISM_MOEBIUS_FUNCTION",BALL_BIHOLOMORPHISM_MOEBIUS_FUNCTION; +"BALL_EMPTY",BALL_EMPTY; +"BALL_EQ_EMPTY",BALL_EQ_EMPTY; +"BALL_INTERVAL",BALL_INTERVAL; +"BALL_INTERVAL_0",BALL_INTERVAL_0; +"BALL_LINEAR_IMAGE",BALL_LINEAR_IMAGE; +"BALL_MAX_UNION",BALL_MAX_UNION; +"BALL_MIN_INTER",BALL_MIN_INTER; +"BALL_SCALING",BALL_SCALING; +"BALL_SUBSET_CBALL",BALL_SUBSET_CBALL; +"BALL_SUBSET_OPEN_MAP_IMAGE",BALL_SUBSET_OPEN_MAP_IMAGE; +"BALL_TRANSLATION",BALL_TRANSLATION; +"BALL_TRIVIAL",BALL_TRIVIAL; +"BALL_UNION_SPHERE",BALL_UNION_SPHERE; +"BANACH_FIX",BANACH_FIX; +"BASIS_CARD_EQ_DIM",BASIS_CARD_EQ_DIM; +"BASIS_COMPONENT",BASIS_COMPONENT; +"BASIS_COORDINATES_CONTINUOUS",BASIS_COORDINATES_CONTINUOUS; +"BASIS_COORDINATES_LIPSCHITZ",BASIS_COORDINATES_LIPSCHITZ; +"BASIS_EQ_0",BASIS_EQ_0; +"BASIS_EXISTS",BASIS_EXISTS; +"BASIS_EXISTS_FINITE",BASIS_EXISTS_FINITE; +"BASIS_EXPANSION",BASIS_EXPANSION; +"BASIS_EXPANSION_UNIQUE",BASIS_EXPANSION_UNIQUE; +"BASIS_HAS_SIZE_DIM",BASIS_HAS_SIZE_DIM; +"BASIS_HAS_SIZE_UNIV",BASIS_HAS_SIZE_UNIV; +"BASIS_INJ",BASIS_INJ; +"BASIS_INJ_EQ",BASIS_INJ_EQ; +"BASIS_NE",BASIS_NE; +"BASIS_NONZERO",BASIS_NONZERO; +"BASIS_ORTHOGONAL",BASIS_ORTHOGONAL; +"BASIS_SUBSPACE_EXISTS",BASIS_SUBSPACE_EXISTS; +"BEPPO_LEVI_DECREASING",BEPPO_LEVI_DECREASING; +"BEPPO_LEVI_INCREASING",BEPPO_LEVI_INCREASING; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE; +"BERNOULLI",BERNOULLI; +"BERNOULLI_1",BERNOULLI_1; +"BERNOULLI_1_0",BERNOULLI_1_0; +"BERNOULLI_ADD",BERNOULLI_ADD; +"BERNOULLI_ALT",BERNOULLI_ALT; +"BERNOULLI_BOUND",BERNOULLI_BOUND; +"BERNOULLI_EVEN_BOUND",BERNOULLI_EVEN_BOUND; +"BERNOULLI_EXPANSION",BERNOULLI_EXPANSION; +"BERNOULLI_HALF",BERNOULLI_HALF; +"BERNOULLI_NUMBER",BERNOULLI_NUMBER; +"BERNOULLI_NUMBER_ALT",BERNOULLI_NUMBER_ALT; +"BERNOULLI_NUMBER_EQ_0",BERNOULLI_NUMBER_EQ_0; +"BERNOULLI_NUMBER_ZERO",BERNOULLI_NUMBER_ZERO; +"BERNOULLI_RAABE_2",BERNOULLI_RAABE_2; +"BERNOULLI_REFLECT",BERNOULLI_REFLECT; +"BERNOULLI_SUB_ADD1",BERNOULLI_SUB_ADD1; +"BERNOULLI_UNIQUE",BERNOULLI_UNIQUE; +"BERNSTEIN_LEMMA",BERNSTEIN_LEMMA; +"BERNSTEIN_POS",BERNSTEIN_POS; +"BERNSTEIN_WEIERSTRASS",BERNSTEIN_WEIERSTRASS; +"BESSEL_INEQUALITY",BESSEL_INEQUALITY; +"BETA_THM",BETA_THM; +"BETWEEN_ANTISYM",BETWEEN_ANTISYM; +"BETWEEN_COLLINEAR_DIST_EQ",BETWEEN_COLLINEAR_DIST_EQ; +"BETWEEN_DIST_LE",BETWEEN_DIST_LE; +"BETWEEN_DIST_LT",BETWEEN_DIST_LT; +"BETWEEN_DOT",BETWEEN_DOT; +"BETWEEN_EXISTS_EXTENSION",BETWEEN_EXISTS_EXTENSION; +"BETWEEN_IMP_COLLINEAR",BETWEEN_IMP_COLLINEAR; +"BETWEEN_IN_CONVEX_HULL",BETWEEN_IN_CONVEX_HULL; +"BETWEEN_IN_SEGMENT",BETWEEN_IN_SEGMENT; +"BETWEEN_LINEAR_IMAGE_EQ",BETWEEN_LINEAR_IMAGE_EQ; +"BETWEEN_MIDPOINT",BETWEEN_MIDPOINT; +"BETWEEN_NORM",BETWEEN_NORM; +"BETWEEN_NORM_LE",BETWEEN_NORM_LE; +"BETWEEN_NORM_LT",BETWEEN_NORM_LT; +"BETWEEN_REFL",BETWEEN_REFL; +"BETWEEN_REFL_EQ",BETWEEN_REFL_EQ; +"BETWEEN_SYM",BETWEEN_SYM; +"BETWEEN_TRANS",BETWEEN_TRANS; +"BETWEEN_TRANSLATION",BETWEEN_TRANSLATION; +"BETWEEN_TRANS_2",BETWEEN_TRANS_2; +"BIJ",BIJ; +"BIJECTIONS_CARD_EQ",BIJECTIONS_CARD_EQ; +"BIJECTIONS_HAS_SIZE",BIJECTIONS_HAS_SIZE; +"BIJECTIONS_HAS_SIZE_EQ",BIJECTIONS_HAS_SIZE_EQ; +"BIJECTIVE_INJECTIVE_SURJECTIVE",BIJECTIVE_INJECTIVE_SURJECTIVE; +"BIJECTIVE_INVERSES",BIJECTIVE_INVERSES; +"BIJECTIVE_LEFT_RIGHT_INVERSE",BIJECTIVE_LEFT_RIGHT_INVERSE; +"BIJECTIVE_ON_LEFT_RIGHT_INVERSE",BIJECTIVE_ON_LEFT_RIGHT_INVERSE; +"BILINEAR_BOUNDED",BILINEAR_BOUNDED; +"BILINEAR_BOUNDED_POS",BILINEAR_BOUNDED_POS; +"BILINEAR_COMPLEX_MUL",BILINEAR_COMPLEX_MUL; +"BILINEAR_CONTINUOUS_COMPOSE",BILINEAR_CONTINUOUS_COMPOSE; +"BILINEAR_CONTINUOUS_ON_COMPOSE",BILINEAR_CONTINUOUS_ON_COMPOSE; +"BILINEAR_DIFFERENTIABLE_AT_COMPOSE",BILINEAR_DIFFERENTIABLE_AT_COMPOSE; +"BILINEAR_DIFFERENTIABLE_ON_COMPOSE",BILINEAR_DIFFERENTIABLE_ON_COMPOSE; +"BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE",BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE; +"BILINEAR_DOT",BILINEAR_DOT; +"BILINEAR_DROP_MUL",BILINEAR_DROP_MUL; +"BILINEAR_EQ",BILINEAR_EQ; +"BILINEAR_EQ_MBASIS",BILINEAR_EQ_MBASIS; +"BILINEAR_EQ_STDBASIS",BILINEAR_EQ_STDBASIS; +"BILINEAR_GEOM",BILINEAR_GEOM; +"BILINEAR_INNER",BILINEAR_INNER; +"BILINEAR_LADD",BILINEAR_LADD; +"BILINEAR_LMUL",BILINEAR_LMUL; +"BILINEAR_LNEG",BILINEAR_LNEG; +"BILINEAR_LSUB",BILINEAR_LSUB; +"BILINEAR_LZERO",BILINEAR_LZERO; +"BILINEAR_OUTER",BILINEAR_OUTER; +"BILINEAR_PRODUCT",BILINEAR_PRODUCT; +"BILINEAR_RADD",BILINEAR_RADD; +"BILINEAR_RMUL",BILINEAR_RMUL; +"BILINEAR_RNEG",BILINEAR_RNEG; +"BILINEAR_RSUB",BILINEAR_RSUB; +"BILINEAR_RZERO",BILINEAR_RZERO; +"BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE",BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE; +"BILINEAR_VSUM",BILINEAR_VSUM; +"BILINEAR_VSUM_PARTIAL_PRE",BILINEAR_VSUM_PARTIAL_PRE; +"BILINEAR_VSUM_PARTIAL_SUC",BILINEAR_VSUM_PARTIAL_SUC; +"BINARYSUM_BITSET",BINARYSUM_BITSET; +"BINARYSUM_BOUND",BINARYSUM_BOUND; +"BINARYSUM_BOUND_EQ",BINARYSUM_BOUND_EQ; +"BINARYSUM_BOUND_LEMMA",BINARYSUM_BOUND_LEMMA; +"BINARYSUM_DIV",BINARYSUM_DIV; +"BINARYSUM_DIV_DIVISIBLE",BINARYSUM_DIV_DIVISIBLE; +"BINARY_INDUCT",BINARY_INDUCT; +"BINOM",BINOM; +"BINOMIAL_THEOREM",BINOMIAL_THEOREM; +"BINOM_0",BINOM_0; +"BINOM_1",BINOM_1; +"BINOM_BOTH_STEP",BINOM_BOTH_STEP; +"BINOM_BOTH_STEP_DOWN",BINOM_BOTH_STEP_DOWN; +"BINOM_BOTH_STEP_REAL",BINOM_BOTH_STEP_REAL; +"BINOM_BOTTOM_STEP",BINOM_BOTTOM_STEP; +"BINOM_BOTTOM_STEP_REAL",BINOM_BOTTOM_STEP_REAL; +"BINOM_EQ_0",BINOM_EQ_0; +"BINOM_FACT",BINOM_FACT; +"BINOM_GE_TOP",BINOM_GE_TOP; +"BINOM_LT",BINOM_LT; +"BINOM_MUL_SHIFT",BINOM_MUL_SHIFT; +"BINOM_PENULT",BINOM_PENULT; +"BINOM_REFL",BINOM_REFL; +"BINOM_SYM",BINOM_SYM; +"BINOM_TOP_STEP",BINOM_TOP_STEP; +"BINOM_TOP_STEP_REAL",BINOM_TOP_STEP_REAL; +"BIT0",BIT0; +"BIT0_DEF",BIT0_DEF; +"BIT0_THM",BIT0_THM; +"BIT1",BIT1; +"BIT1_DEF",BIT1_DEF; +"BIT1_THM",BIT1_THM; +"BITSET_0",BITSET_0; +"BITSET_BINARYSUM",BITSET_BINARYSUM; +"BITSET_BOUND",BITSET_BOUND; +"BITSET_BOUND_EQ",BITSET_BOUND_EQ; +"BITSET_BOUND_LEMMA",BITSET_BOUND_LEMMA; +"BITSET_BOUND_WEAK",BITSET_BOUND_WEAK; +"BITSET_EQ",BITSET_EQ; +"BITSET_EQ_EMPTY",BITSET_EQ_EMPTY; +"BITSET_STEP",BITSET_STEP; +"BLOCH",BLOCH; +"BLOCH_COROLLARY",BLOCH_COROLLARY; +"BLOCH_LEMMA",BLOCH_LEMMA; +"BLOCH_UNIT",BLOCH_UNIT; +"BOLZANO_WEIERSTRASS",BOLZANO_WEIERSTRASS; +"BOLZANO_WEIERSTRASS_CONTRAPOS",BOLZANO_WEIERSTRASS_CONTRAPOS; +"BOLZANO_WEIERSTRASS_IMP_BOUNDED",BOLZANO_WEIERSTRASS_IMP_BOUNDED; +"BOLZANO_WEIERSTRASS_IMP_CLOSED",BOLZANO_WEIERSTRASS_IMP_CLOSED; +"BOOL_CASES_AX",BOOL_CASES_AX; +"BORSUKIAN_ALT",BORSUKIAN_ALT; +"BORSUKIAN_CIRCLE",BORSUKIAN_CIRCLE; +"BORSUKIAN_CIRCLE_ALT",BORSUKIAN_CIRCLE_ALT; +"BORSUKIAN_CLOSED_UNION",BORSUKIAN_CLOSED_UNION; +"BORSUKIAN_COMPONENTWISE",BORSUKIAN_COMPONENTWISE; +"BORSUKIAN_COMPONENTWISE_EQ",BORSUKIAN_COMPONENTWISE_EQ; +"BORSUKIAN_CONTINUOUS_LOGARITHM",BORSUKIAN_CONTINUOUS_LOGARITHM; +"BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE",BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE; +"BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX",BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX; +"BORSUKIAN_EMPTY",BORSUKIAN_EMPTY; +"BORSUKIAN_EQ_SIMPLY_CONNECTED",BORSUKIAN_EQ_SIMPLY_CONNECTED; +"BORSUKIAN_IMP_UNICOHERENT",BORSUKIAN_IMP_UNICOHERENT; +"BORSUKIAN_INJECTIVE_LINEAR_IMAGE",BORSUKIAN_INJECTIVE_LINEAR_IMAGE; +"BORSUKIAN_MONOTONE_IMAGE_COMPACT",BORSUKIAN_MONOTONE_IMAGE_COMPACT; +"BORSUKIAN_OPEN_MAP_IMAGE_COMPACT",BORSUKIAN_OPEN_MAP_IMAGE_COMPACT; +"BORSUKIAN_OPEN_UNION",BORSUKIAN_OPEN_UNION; +"BORSUKIAN_RETRACTION_GEN",BORSUKIAN_RETRACTION_GEN; +"BORSUKIAN_SEPARATION_COMPACT",BORSUKIAN_SEPARATION_COMPACT; +"BORSUKIAN_SEPARATION_OPEN_CLOSED",BORSUKIAN_SEPARATION_OPEN_CLOSED; +"BORSUKIAN_SPHERE",BORSUKIAN_SPHERE; +"BORSUKIAN_TRANSLATION",BORSUKIAN_TRANSLATION; +"BORSUKIAN_UNIV",BORSUKIAN_UNIV; +"BORSUK_HOMOTOPY_EXTENSION",BORSUK_HOMOTOPY_EXTENSION; +"BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC",BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC; +"BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ",BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ; +"BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT",BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT; +"BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT",BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT; +"BORSUK_MAP_INTO_SPHERE",BORSUK_MAP_INTO_SPHERE; +"BORSUK_SEPARATION_THEOREM",BORSUK_SEPARATION_THEOREM; +"BORSUK_SEPARATION_THEOREM_GEN",BORSUK_SEPARATION_THEOREM_GEN; +"BOTTOM",BOTTOM; +"BOUNDED_ARC_IMAGE",BOUNDED_ARC_IMAGE; +"BOUNDED_BALL",BOUNDED_BALL; +"BOUNDED_CBALL",BOUNDED_CBALL; +"BOUNDED_CLOSED_CHAIN",BOUNDED_CLOSED_CHAIN; +"BOUNDED_CLOSED_IMP_COMPACT",BOUNDED_CLOSED_IMP_COMPACT; +"BOUNDED_CLOSED_INTERVAL",BOUNDED_CLOSED_INTERVAL; +"BOUNDED_CLOSED_NEST",BOUNDED_CLOSED_NEST; +"BOUNDED_CLOSURE",BOUNDED_CLOSURE; +"BOUNDED_CLOSURE_EQ",BOUNDED_CLOSURE_EQ; +"BOUNDED_COMPONENTWISE",BOUNDED_COMPONENTWISE; +"BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS",BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS; +"BOUNDED_CONVEX_HULL",BOUNDED_CONVEX_HULL; +"BOUNDED_CONVEX_HULL_EQ",BOUNDED_CONVEX_HULL_EQ; +"BOUNDED_DECREASING_CONVERGENT",BOUNDED_DECREASING_CONVERGENT; +"BOUNDED_DIFF",BOUNDED_DIFF; +"BOUNDED_DIFFS",BOUNDED_DIFFS; +"BOUNDED_EMPTY",BOUNDED_EMPTY; +"BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION",BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION; +"BOUNDED_EQ_BOLZANO_WEIERSTRASS",BOUNDED_EQ_BOLZANO_WEIERSTRASS; +"BOUNDED_FINITE",BOUNDED_FINITE; +"BOUNDED_FRONTIER",BOUNDED_FRONTIER; +"BOUNDED_FUNCTIONS_BIJECTIONS_1",BOUNDED_FUNCTIONS_BIJECTIONS_1; +"BOUNDED_FUNCTIONS_BIJECTIONS_2",BOUNDED_FUNCTIONS_BIJECTIONS_2; +"BOUNDED_HALFSPACE_GE",BOUNDED_HALFSPACE_GE; +"BOUNDED_HALFSPACE_GT",BOUNDED_HALFSPACE_GT; +"BOUNDED_HALFSPACE_LE",BOUNDED_HALFSPACE_LE; +"BOUNDED_HALFSPACE_LT",BOUNDED_HALFSPACE_LT; +"BOUNDED_HAS_INF",BOUNDED_HAS_INF; +"BOUNDED_HAS_SUP",BOUNDED_HAS_SUP; +"BOUNDED_HYPERPLANE_EQ_TRIVIAL",BOUNDED_HYPERPLANE_EQ_TRIVIAL; +"BOUNDED_INCREASING_CONVERGENT",BOUNDED_INCREASING_CONVERGENT; +"BOUNDED_INSERT",BOUNDED_INSERT; +"BOUNDED_INSIDE",BOUNDED_INSIDE; +"BOUNDED_INTEGRALS_OVER_SUBINTERVALS",BOUNDED_INTEGRALS_OVER_SUBINTERVALS; +"BOUNDED_INTER",BOUNDED_INTER; +"BOUNDED_INTERIOR",BOUNDED_INTERIOR; +"BOUNDED_INTERS",BOUNDED_INTERS; +"BOUNDED_INTERVAL",BOUNDED_INTERVAL; +"BOUNDED_LIFT",BOUNDED_LIFT; +"BOUNDED_LINEAR_IMAGE",BOUNDED_LINEAR_IMAGE; +"BOUNDED_LINEAR_IMAGE_EQ",BOUNDED_LINEAR_IMAGE_EQ; +"BOUNDED_NEGATIONS",BOUNDED_NEGATIONS; +"BOUNDED_PARTIAL_REAL_SUMS",BOUNDED_PARTIAL_REAL_SUMS; +"BOUNDED_PARTIAL_SUMS",BOUNDED_PARTIAL_SUMS; +"BOUNDED_PATH_IMAGE",BOUNDED_PATH_IMAGE; +"BOUNDED_PCROSS",BOUNDED_PCROSS; +"BOUNDED_PCROSS_EQ",BOUNDED_PCROSS_EQ; +"BOUNDED_POS",BOUNDED_POS; +"BOUNDED_POS_LT",BOUNDED_POS_LT; +"BOUNDED_RECTIFIABLE_PATH_IMAGE",BOUNDED_RECTIFIABLE_PATH_IMAGE; +"BOUNDED_RELATIVE_FRONTIER",BOUNDED_RELATIVE_FRONTIER; +"BOUNDED_SCALING",BOUNDED_SCALING; +"BOUNDED_SEGMENT",BOUNDED_SEGMENT; +"BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE; +"BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL; +"BOUNDED_SIMPLE_PATH_IMAGE",BOUNDED_SIMPLE_PATH_IMAGE; +"BOUNDED_SING",BOUNDED_SING; +"BOUNDED_SLICE",BOUNDED_SLICE; +"BOUNDED_SPHERE",BOUNDED_SPHERE; +"BOUNDED_SUBSET",BOUNDED_SUBSET; +"BOUNDED_SUBSET_BALL",BOUNDED_SUBSET_BALL; +"BOUNDED_SUBSET_CBALL",BOUNDED_SUBSET_CBALL; +"BOUNDED_SUBSET_CLOSED_INTERVAL",BOUNDED_SUBSET_CLOSED_INTERVAL; +"BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC; +"BOUNDED_SUBSET_OPEN_INTERVAL",BOUNDED_SUBSET_OPEN_INTERVAL; +"BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC; +"BOUNDED_SUMS",BOUNDED_SUMS; +"BOUNDED_SUMS_IMAGE",BOUNDED_SUMS_IMAGE; +"BOUNDED_SUMS_IMAGES",BOUNDED_SUMS_IMAGES; +"BOUNDED_TRANSLATION",BOUNDED_TRANSLATION; +"BOUNDED_TRANSLATION_EQ",BOUNDED_TRANSLATION_EQ; +"BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE",BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE; +"BOUNDED_UNION",BOUNDED_UNION; +"BOUNDED_UNIONS",BOUNDED_UNIONS; +"BOUNDED_UNIQUE_OUTSIDE",BOUNDED_UNIQUE_OUTSIDE; +"BOUNDED_VALID_PATH_IMAGE",BOUNDED_VALID_PATH_IMAGE; +"BOUNDS_DIVIDED",BOUNDS_DIVIDED; +"BOUNDS_IGNORE",BOUNDS_IGNORE; +"BOUNDS_LINEAR",BOUNDS_LINEAR; +"BOUNDS_LINEAR_0",BOUNDS_LINEAR_0; +"BOUNDS_NOTZERO",BOUNDS_NOTZERO; +"BROUWER",BROUWER; +"BROUWER_ABSOLUTE_RETRACT",BROUWER_ABSOLUTE_RETRACT; +"BROUWER_ABSOLUTE_RETRACT_GEN",BROUWER_ABSOLUTE_RETRACT_GEN; +"BROUWER_AR",BROUWER_AR; +"BROUWER_BALL",BROUWER_BALL; +"BROUWER_COMPACTNESS_LEMMA",BROUWER_COMPACTNESS_LEMMA; +"BROUWER_CONTRACTIBLE_ANR",BROUWER_CONTRACTIBLE_ANR; +"BROUWER_CUBE",BROUWER_CUBE; +"BROUWER_FACTOR_THROUGH_AR",BROUWER_FACTOR_THROUGH_AR; +"BROUWER_INESSENTIAL_ANR",BROUWER_INESSENTIAL_ANR; +"BROUWER_REDUCTION_THEOREM",BROUWER_REDUCTION_THEOREM; +"BROUWER_REDUCTION_THEOREM_GEN",BROUWER_REDUCTION_THEOREM_GEN; +"BROUWER_SURJECTIVE",BROUWER_SURJECTIVE; +"BROUWER_SURJECTIVE_CBALL",BROUWER_SURJECTIVE_CBALL; +"BROUWER_WEAK",BROUWER_WEAK; +"BUTLAST",BUTLAST; +"CACS_0",CACS_0; +"CACS_1",CACS_1; +"CACS_BODY_LEMMA",CACS_BODY_LEMMA; +"CACS_BOUNDS",CACS_BOUNDS; +"CACS_CASN_SQRT_POS",CACS_CASN_SQRT_POS; +"CACS_CCOS",CACS_CCOS; +"CACS_NEG_1",CACS_NEG_1; +"CACS_RANGE_LEMMA",CACS_RANGE_LEMMA; +"CACS_UNIQUE",CACS_UNIQUE; +"CANTOR_BENDIXSON",CANTOR_BENDIXSON; +"CANTOR_THM",CANTOR_THM; +"CANTOR_THM_UNIV",CANTOR_THM_UNIV; +"CARATHEODORY",CARATHEODORY; +"CARATHEODORY_AFF_DIM",CARATHEODORY_AFF_DIM; +"CARD",CARD; +"CARD_ADD2_ABSORB_LE",CARD_ADD2_ABSORB_LE; +"CARD_ADD2_ABSORB_LT",CARD_ADD2_ABSORB_LT; +"CARD_ADD_ABSORB",CARD_ADD_ABSORB; +"CARD_ADD_ABSORB_LE",CARD_ADD_ABSORB_LE; +"CARD_ADD_ASSOC",CARD_ADD_ASSOC; +"CARD_ADD_C",CARD_ADD_C; +"CARD_ADD_CONG",CARD_ADD_CONG; +"CARD_ADD_FINITE",CARD_ADD_FINITE; +"CARD_ADD_FINITE_EQ",CARD_ADD_FINITE_EQ; +"CARD_ADD_LE_MUL_INFINITE",CARD_ADD_LE_MUL_INFINITE; +"CARD_ADD_SYM",CARD_ADD_SYM; +"CARD_ADD_SYMDIFF_INTER",CARD_ADD_SYMDIFF_INTER; +"CARD_BOOL",CARD_BOOL; +"CARD_CART_UNIV",CARD_CART_UNIV; +"CARD_CLAUSES",CARD_CLAUSES; +"CARD_COMPLEX_ROOTS_UNITY",CARD_COMPLEX_ROOTS_UNITY; +"CARD_COUNTABLE_CONG",CARD_COUNTABLE_CONG; +"CARD_CROSS",CARD_CROSS; +"CARD_DELETE",CARD_DELETE; +"CARD_DIFF",CARD_DIFF; +"CARD_DIFF_INTER",CARD_DIFF_INTER; +"CARD_DISJOINT_UNION",CARD_DISJOINT_UNION; +"CARD_EQ_0",CARD_EQ_0; +"CARD_EQ_ARC_IMAGE",CARD_EQ_ARC_IMAGE; +"CARD_EQ_BALL",CARD_EQ_BALL; +"CARD_EQ_BIJECTION",CARD_EQ_BIJECTION; +"CARD_EQ_BIJECTIONS",CARD_EQ_BIJECTIONS; +"CARD_EQ_CARD",CARD_EQ_CARD; +"CARD_EQ_CARD_IMP",CARD_EQ_CARD_IMP; +"CARD_EQ_CART",CARD_EQ_CART; +"CARD_EQ_CBALL",CARD_EQ_CBALL; +"CARD_EQ_CLOSED",CARD_EQ_CLOSED; +"CARD_EQ_CLOSED_SETS",CARD_EQ_CLOSED_SETS; +"CARD_EQ_COMPACT_SETS",CARD_EQ_COMPACT_SETS; +"CARD_EQ_CONDENSATION_POINTS",CARD_EQ_CONDENSATION_POINTS; +"CARD_EQ_CONDENSATION_POINTS_IN_SET",CARD_EQ_CONDENSATION_POINTS_IN_SET; +"CARD_EQ_CONG",CARD_EQ_CONG; +"CARD_EQ_CONNECTED",CARD_EQ_CONNECTED; +"CARD_EQ_CONVEX",CARD_EQ_CONVEX; +"CARD_EQ_COUNTABLE",CARD_EQ_COUNTABLE; +"CARD_EQ_COUNTABLE_SUBSETS_REAL",CARD_EQ_COUNTABLE_SUBSETS_REAL; +"CARD_EQ_COVERING_MAP_FIBRES",CARD_EQ_COVERING_MAP_FIBRES; +"CARD_EQ_DIM",CARD_EQ_DIM; +"CARD_EQ_EMPTY",CARD_EQ_EMPTY; +"CARD_EQ_EUCLIDEAN",CARD_EQ_EUCLIDEAN; +"CARD_EQ_FINITE",CARD_EQ_FINITE; +"CARD_EQ_FINITE_SUBSETS",CARD_EQ_FINITE_SUBSETS; +"CARD_EQ_IMAGE",CARD_EQ_IMAGE; +"CARD_EQ_IMP_LE",CARD_EQ_IMP_LE; +"CARD_EQ_INTEGER",CARD_EQ_INTEGER; +"CARD_EQ_INTERVAL",CARD_EQ_INTERVAL; +"CARD_EQ_LIST",CARD_EQ_LIST; +"CARD_EQ_LIST_GEN",CARD_EQ_LIST_GEN; +"CARD_EQ_NONEMPTY_INTERIOR",CARD_EQ_NONEMPTY_INTERIOR; +"CARD_EQ_NSUM",CARD_EQ_NSUM; +"CARD_EQ_OPEN",CARD_EQ_OPEN; +"CARD_EQ_OPEN_IN",CARD_EQ_OPEN_IN; +"CARD_EQ_OPEN_IN_AFFINE",CARD_EQ_OPEN_IN_AFFINE; +"CARD_EQ_OPEN_SETS",CARD_EQ_OPEN_SETS; +"CARD_EQ_PATH_CONNECTED",CARD_EQ_PATH_CONNECTED; +"CARD_EQ_PCROSS",CARD_EQ_PCROSS; +"CARD_EQ_PERFECT_SET",CARD_EQ_PERFECT_SET; +"CARD_EQ_RATIONAL",CARD_EQ_RATIONAL; +"CARD_EQ_REAL",CARD_EQ_REAL; +"CARD_EQ_REAL_IMP_UNCOUNTABLE",CARD_EQ_REAL_IMP_UNCOUNTABLE; +"CARD_EQ_REAL_SEQUENCES",CARD_EQ_REAL_SEQUENCES; +"CARD_EQ_REFL",CARD_EQ_REFL; +"CARD_EQ_SEGMENT",CARD_EQ_SEGMENT; +"CARD_EQ_SIMPLE_PATH_IMAGE",CARD_EQ_SIMPLE_PATH_IMAGE; +"CARD_EQ_SPHERE",CARD_EQ_SPHERE; +"CARD_EQ_SUM",CARD_EQ_SUM; +"CARD_EQ_SYM",CARD_EQ_SYM; +"CARD_EQ_TRANS",CARD_EQ_TRANS; +"CARD_FACES_OF_SIMPLEX",CARD_FACES_OF_SIMPLEX; +"CARD_FINITE_CONG",CARD_FINITE_CONG; +"CARD_FINITE_IMAGE",CARD_FINITE_IMAGE; +"CARD_FUNSPACE",CARD_FUNSPACE; +"CARD_FUNSPACE_CONG",CARD_FUNSPACE_CONG; +"CARD_FUNSPACE_CURRY",CARD_FUNSPACE_CURRY; +"CARD_FUNSPACE_LE",CARD_FUNSPACE_LE; +"CARD_FUNSPACE_UNIV",CARD_FUNSPACE_UNIV; +"CARD_GE_DIM_INDEPENDENT",CARD_GE_DIM_INDEPENDENT; +"CARD_HAS_SIZE_CONG",CARD_HAS_SIZE_CONG; +"CARD_IMAGE_EQ_INJ",CARD_IMAGE_EQ_INJ; +"CARD_IMAGE_INJ",CARD_IMAGE_INJ; +"CARD_IMAGE_INJ_EQ",CARD_IMAGE_INJ_EQ; +"CARD_IMAGE_LE",CARD_IMAGE_LE; +"CARD_INFINITE_CONG",CARD_INFINITE_CONG; +"CARD_INTSEG_INT",CARD_INTSEG_INT; +"CARD_LDISTRIB",CARD_LDISTRIB; +"CARD_LET_TOTAL",CARD_LET_TOTAL; +"CARD_LET_TRANS",CARD_LET_TRANS; +"CARD_LE_ADD",CARD_LE_ADD; +"CARD_LE_ADDL",CARD_LE_ADDL; +"CARD_LE_ADDR",CARD_LE_ADDR; +"CARD_LE_ANTISYM",CARD_LE_ANTISYM; +"CARD_LE_CARD",CARD_LE_CARD; +"CARD_LE_CARD_IMP",CARD_LE_CARD_IMP; +"CARD_LE_COMPONENTS",CARD_LE_COMPONENTS; +"CARD_LE_CONG",CARD_LE_CONG; +"CARD_LE_CONNECTED_COMPONENTS",CARD_LE_CONNECTED_COMPONENTS; +"CARD_LE_COUNTABLE",CARD_LE_COUNTABLE; +"CARD_LE_COUNTABLE_SUBSETS",CARD_LE_COUNTABLE_SUBSETS; +"CARD_LE_DIM_SPANNING",CARD_LE_DIM_SPANNING; +"CARD_LE_EMPTY",CARD_LE_EMPTY; +"CARD_LE_EQ_SUBSET",CARD_LE_EQ_SUBSET; +"CARD_LE_FINITE",CARD_LE_FINITE; +"CARD_LE_FINITE_SUBSETS",CARD_LE_FINITE_SUBSETS; +"CARD_LE_IMAGE",CARD_LE_IMAGE; +"CARD_LE_IMAGE_GEN",CARD_LE_IMAGE_GEN; +"CARD_LE_INFINITE",CARD_LE_INFINITE; +"CARD_LE_INJ",CARD_LE_INJ; +"CARD_LE_LIST",CARD_LE_LIST; +"CARD_LE_LT",CARD_LE_LT; +"CARD_LE_MUL",CARD_LE_MUL; +"CARD_LE_PATH_COMPONENTS",CARD_LE_PATH_COMPONENTS; +"CARD_LE_POWERSET",CARD_LE_POWERSET; +"CARD_LE_REFL",CARD_LE_REFL; +"CARD_LE_RELATIONAL",CARD_LE_RELATIONAL; +"CARD_LE_RELATIONAL_FULL",CARD_LE_RELATIONAL_FULL; +"CARD_LE_RETRACT_COMPLEMENT_COMPONENTS",CARD_LE_RETRACT_COMPLEMENT_COMPONENTS; +"CARD_LE_SQUARE",CARD_LE_SQUARE; +"CARD_LE_SUBPOWERSET",CARD_LE_SUBPOWERSET; +"CARD_LE_SUBSET",CARD_LE_SUBSET; +"CARD_LE_TOTAL",CARD_LE_TOTAL; +"CARD_LE_TRANS",CARD_LE_TRANS; +"CARD_LE_UNIV",CARD_LE_UNIV; +"CARD_LTE_TOTAL",CARD_LTE_TOTAL; +"CARD_LTE_TRANS",CARD_LTE_TRANS; +"CARD_LT_ADD",CARD_LT_ADD; +"CARD_LT_CARD",CARD_LT_CARD; +"CARD_LT_CONG",CARD_LT_CONG; +"CARD_LT_FINITE_INFINITE",CARD_LT_FINITE_INFINITE; +"CARD_LT_IMP_DISCONNECTED",CARD_LT_IMP_DISCONNECTED; +"CARD_LT_IMP_LE",CARD_LT_IMP_LE; +"CARD_LT_LE",CARD_LT_LE; +"CARD_LT_REFL",CARD_LT_REFL; +"CARD_LT_TOTAL",CARD_LT_TOTAL; +"CARD_LT_TRANS",CARD_LT_TRANS; +"CARD_MUL2_ABSORB_LE",CARD_MUL2_ABSORB_LE; +"CARD_MUL_ABSORB",CARD_MUL_ABSORB; +"CARD_MUL_ABSORB_LE",CARD_MUL_ABSORB_LE; +"CARD_MUL_ASSOC",CARD_MUL_ASSOC; +"CARD_MUL_CONG",CARD_MUL_CONG; +"CARD_MUL_FINITE",CARD_MUL_FINITE; +"CARD_MUL_LT_INFINITE",CARD_MUL_LT_INFINITE; +"CARD_MUL_LT_LEMMA",CARD_MUL_LT_LEMMA; +"CARD_MUL_SYM",CARD_MUL_SYM; +"CARD_NOT_LE",CARD_NOT_LE; +"CARD_NOT_LT",CARD_NOT_LT; +"CARD_NUMSEG",CARD_NUMSEG; +"CARD_NUMSEG_1",CARD_NUMSEG_1; +"CARD_NUMSEG_LE",CARD_NUMSEG_LE; +"CARD_NUMSEG_LEMMA",CARD_NUMSEG_LEMMA; +"CARD_NUMSEG_LT",CARD_NUMSEG_LT; +"CARD_PERMUTATIONS",CARD_PERMUTATIONS; +"CARD_POWERSET",CARD_POWERSET; +"CARD_PRODUCT",CARD_PRODUCT; +"CARD_PSUBSET",CARD_PSUBSET; +"CARD_RDISTRIB",CARD_RDISTRIB; +"CARD_SET_OF_LIST_LE",CARD_SET_OF_LIST_LE; +"CARD_SING",CARD_SING; +"CARD_SQUARE_INFINITE",CARD_SQUARE_INFINITE; +"CARD_SQUARE_NUM",CARD_SQUARE_NUM; +"CARD_STDBASIS",CARD_STDBASIS; +"CARD_SUBSET",CARD_SUBSET; +"CARD_SUBSET_EQ",CARD_SUBSET_EQ; +"CARD_SUBSET_IMAGE",CARD_SUBSET_IMAGE; +"CARD_SUBSET_LE",CARD_SUBSET_LE; +"CARD_UNION",CARD_UNION; +"CARD_UNIONS",CARD_UNIONS; +"CARD_UNIONS_LE",CARD_UNIONS_LE; +"CARD_UNION_EQ",CARD_UNION_EQ; +"CARD_UNION_GEN",CARD_UNION_GEN; +"CARD_UNION_LE",CARD_UNION_LE; +"CARD_UNION_LEMMA",CARD_UNION_LEMMA; +"CARD_UNION_OVERLAP",CARD_UNION_OVERLAP; +"CARD_UNION_OVERLAP_EQ",CARD_UNION_OVERLAP_EQ; +"CART_EQ",CART_EQ; +"CART_EQ_FULL",CART_EQ_FULL; +"CASEWISE",CASEWISE; +"CASEWISE_CASES",CASEWISE_CASES; +"CASEWISE_DEF",CASEWISE_DEF; +"CASEWISE_WORKS",CASEWISE_WORKS; +"CASN_0",CASN_0; +"CASN_1",CASN_1; +"CASN_BODY_LEMMA",CASN_BODY_LEMMA; +"CASN_BOUNDS",CASN_BOUNDS; +"CASN_CACS_SQRT_POS",CASN_CACS_SQRT_POS; +"CASN_CSIN",CASN_CSIN; +"CASN_NEG_1",CASN_NEG_1; +"CASN_RANGE_LEMMA",CASN_RANGE_LEMMA; +"CASN_UNIQUE",CASN_UNIQUE; +"CASORATI_WEIERSTRASS",CASORATI_WEIERSTRASS; +"CATAN_CONVERGS",CATAN_CONVERGS; +"CATN_0",CATN_0; +"CATN_CTAN",CATN_CTAN; +"CAUCHY",CAUCHY; +"CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE",CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE; +"CAUCHY_CONTINUOUS_IMP_CONTINUOUS",CAUCHY_CONTINUOUS_IMP_CONTINUOUS; +"CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA",CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA; +"CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH",CAUCHY_DERIVATIVE_INTEGRAL_CIRCLEPATH; +"CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH",CAUCHY_HAS_PATH_INTEGRAL_HIGHER_DERIVATIVE_CIRCLEPATH; +"CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND",CAUCHY_HIGHER_COMPLEX_DERIVATIVE_BOUND; +"CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH",CAUCHY_HIGHER_DERIVATIVE_INTEGRAL_CIRCLEPATH; +"CAUCHY_IMP_BOUNDED",CAUCHY_IMP_BOUNDED; +"CAUCHY_INEQUALITY",CAUCHY_INEQUALITY; +"CAUCHY_INTEGRAL_CIRCLEPATH",CAUCHY_INTEGRAL_CIRCLEPATH; +"CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE",CAUCHY_INTEGRAL_CIRCLEPATH_SIMPLE; +"CAUCHY_INTEGRAL_FORMULA_CONVEX",CAUCHY_INTEGRAL_FORMULA_CONVEX; +"CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE",CAUCHY_INTEGRAL_FORMULA_CONVEX_SIMPLE; +"CAUCHY_INTEGRAL_FORMULA_GLOBAL",CAUCHY_INTEGRAL_FORMULA_GLOBAL; +"CAUCHY_INTEGRAL_FORMULA_WEAK",CAUCHY_INTEGRAL_FORMULA_WEAK; +"CAUCHY_ISOMETRIC",CAUCHY_ISOMETRIC; +"CAUCHY_NEXT_DERIVATIVE",CAUCHY_NEXT_DERIVATIVE; +"CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH",CAUCHY_NEXT_DERIVATIVE_CIRCLEPATH; +"CAUCHY_RIEMANN",CAUCHY_RIEMANN; +"CAUCHY_THEOREM_CONVEX",CAUCHY_THEOREM_CONVEX; +"CAUCHY_THEOREM_CONVEX_SIMPLE",CAUCHY_THEOREM_CONVEX_SIMPLE; +"CAUCHY_THEOREM_DISC",CAUCHY_THEOREM_DISC; +"CAUCHY_THEOREM_DISC_SIMPLE",CAUCHY_THEOREM_DISC_SIMPLE; +"CAUCHY_THEOREM_FLAT",CAUCHY_THEOREM_FLAT; +"CAUCHY_THEOREM_FLAT_LEMMA",CAUCHY_THEOREM_FLAT_LEMMA; +"CAUCHY_THEOREM_GLOBAL",CAUCHY_THEOREM_GLOBAL; +"CAUCHY_THEOREM_GLOBAL_OUTSIDE",CAUCHY_THEOREM_GLOBAL_OUTSIDE; +"CAUCHY_THEOREM_HOMOTOPIC_LOOPS",CAUCHY_THEOREM_HOMOTOPIC_LOOPS; +"CAUCHY_THEOREM_HOMOTOPIC_PATHS",CAUCHY_THEOREM_HOMOTOPIC_PATHS; +"CAUCHY_THEOREM_NULL_HOMOTOPIC",CAUCHY_THEOREM_NULL_HOMOTOPIC; +"CAUCHY_THEOREM_PRIMITIVE",CAUCHY_THEOREM_PRIMITIVE; +"CAUCHY_THEOREM_QUADRISECTION",CAUCHY_THEOREM_QUADRISECTION; +"CAUCHY_THEOREM_SIMPLY_CONNECTED",CAUCHY_THEOREM_SIMPLY_CONNECTED; +"CAUCHY_THEOREM_STARLIKE",CAUCHY_THEOREM_STARLIKE; +"CAUCHY_THEOREM_STARLIKE_SIMPLE",CAUCHY_THEOREM_STARLIKE_SIMPLE; +"CAUCHY_THEOREM_TRIANGLE",CAUCHY_THEOREM_TRIANGLE; +"CAUCHY_THEOREM_TRIANGLE_COFINITE",CAUCHY_THEOREM_TRIANGLE_COFINITE; +"CAUCHY_THEOREM_TRIANGLE_INTERIOR",CAUCHY_THEOREM_TRIANGLE_INTERIOR; +"CBALL_DIFF_BALL",CBALL_DIFF_BALL; +"CBALL_DIFF_SPHERE",CBALL_DIFF_SPHERE; +"CBALL_EMPTY",CBALL_EMPTY; +"CBALL_EQ_EMPTY",CBALL_EQ_EMPTY; +"CBALL_EQ_SING",CBALL_EQ_SING; +"CBALL_INTERVAL",CBALL_INTERVAL; +"CBALL_INTERVAL_0",CBALL_INTERVAL_0; +"CBALL_LINEAR_IMAGE",CBALL_LINEAR_IMAGE; +"CBALL_MAX_UNION",CBALL_MAX_UNION; +"CBALL_MIN_INTER",CBALL_MIN_INTER; +"CBALL_SCALING",CBALL_SCALING; +"CBALL_SING",CBALL_SING; +"CBALL_TRANSLATION",CBALL_TRANSLATION; +"CBALL_TRIVIAL",CBALL_TRIVIAL; +"CCOS_0",CCOS_0; +"CCOS_ADD",CCOS_ADD; +"CCOS_CACS",CCOS_CACS; +"CCOS_CASN",CCOS_CASN; +"CCOS_CASN_NZ",CCOS_CASN_NZ; +"CCOS_CONVERGES",CCOS_CONVERGES; +"CCOS_CSIN_CSQRT",CCOS_CSIN_CSQRT; +"CCOS_DOUBLE",CCOS_DOUBLE; +"CCOS_DOUBLE_CCOS",CCOS_DOUBLE_CCOS; +"CCOS_DOUBLE_CSIN",CCOS_DOUBLE_CSIN; +"CCOS_EQ",CCOS_EQ; +"CCOS_EQ_0",CCOS_EQ_0; +"CCOS_EQ_1",CCOS_EQ_1; +"CCOS_EQ_MINUS1",CCOS_EQ_MINUS1; +"CCOS_NEG",CCOS_NEG; +"CCOS_SUB",CCOS_SUB; +"CELL_COMPLEX_SUBDIVISION_EXISTS",CELL_COMPLEX_SUBDIVISION_EXISTS; +"CENTRE_IN_BALL",CENTRE_IN_BALL; +"CENTRE_IN_CBALL",CENTRE_IN_CBALL; +"CEXP_0",CEXP_0; +"CEXP_ADD",CEXP_ADD; +"CEXP_ADD_MUL",CEXP_ADD_MUL; +"CEXP_BOUND_BLEMMA",CEXP_BOUND_BLEMMA; +"CEXP_BOUND_HALF",CEXP_BOUND_HALF; +"CEXP_BOUND_LEMMA",CEXP_BOUND_LEMMA; +"CEXP_CLOG",CEXP_CLOG; +"CEXP_COMPLEX",CEXP_COMPLEX; +"CEXP_CONVERGES",CEXP_CONVERGES; +"CEXP_CONVERGES_UNIFORMLY",CEXP_CONVERGES_UNIFORMLY; +"CEXP_CONVERGES_UNIFORMLY_CAUCHY",CEXP_CONVERGES_UNIFORMLY_CAUCHY; +"CEXP_CONVERGES_UNIQUE",CEXP_CONVERGES_UNIQUE; +"CEXP_EQ",CEXP_EQ; +"CEXP_EQ_1",CEXP_EQ_1; +"CEXP_EULER",CEXP_EULER; +"CEXP_II_NE_1",CEXP_II_NE_1; +"CEXP_INTEGER_2PI",CEXP_INTEGER_2PI; +"CEXP_LIMIT",CEXP_LIMIT; +"CEXP_MUL_CPOW",CEXP_MUL_CPOW; +"CEXP_N",CEXP_N; +"CEXP_NEG",CEXP_NEG; +"CEXP_NEG_LMUL",CEXP_NEG_LMUL; +"CEXP_NEG_RMUL",CEXP_NEG_RMUL; +"CEXP_NZ",CEXP_NZ; +"CEXP_SUB",CEXP_SUB; +"CEXP_VSUM",CEXP_VSUM; +"CHAIN_SUBSET",CHAIN_SUBSET; +"CHARACTERISTIC_POLYNOMIAL",CHARACTERISTIC_POLYNOMIAL; +"CHOICE",CHOICE; +"CHOICE_DEF",CHOICE_DEF; +"CHOOSE_AFFINE_SUBSET",CHOOSE_AFFINE_SUBSET; +"CHOOSE_POLYTOPE",CHOOSE_POLYTOPE; +"CHOOSE_SIMPLEX",CHOOSE_SIMPLEX; +"CHOOSE_SUBSET",CHOOSE_SUBSET; +"CHOOSE_SUBSET_BETWEEN",CHOOSE_SUBSET_BETWEEN; +"CHOOSE_SUBSET_STRONG",CHOOSE_SUBSET_STRONG; +"CHOOSE_SUBSPACE_OF_SUBSPACE",CHOOSE_SUBSPACE_OF_SUBSPACE; +"CIRCLEPATH",CIRCLEPATH; +"CIRCLE_SINCOS",CIRCLE_SINCOS; +"CLOG_1",CLOG_1; +"CLOG_CEXP",CLOG_CEXP; +"CLOG_CONVERGES",CLOG_CONVERGES; +"CLOG_EQ",CLOG_EQ; +"CLOG_II",CLOG_II; +"CLOG_INV",CLOG_INV; +"CLOG_MUL",CLOG_MUL; +"CLOG_MUL_CX",CLOG_MUL_CX; +"CLOG_MUL_II",CLOG_MUL_II; +"CLOG_MUL_SIMPLE",CLOG_MUL_SIMPLE; +"CLOG_MUL_UNWINDING",CLOG_MUL_UNWINDING; +"CLOG_NEG",CLOG_NEG; +"CLOG_NEG_1",CLOG_NEG_1; +"CLOG_NEG_II",CLOG_NEG_II; +"CLOG_UNIQUE",CLOG_UNIQUE; +"CLOG_WORKS",CLOG_WORKS; +"CLOPEN",CLOPEN; +"CLOPEN_IN_COMPONENTS",CLOPEN_IN_COMPONENTS; +"CLOPEN_UNIONS_COMPONENTS",CLOPEN_UNIONS_COMPONENTS; +"CLOSED_AFFINE",CLOSED_AFFINE; +"CLOSED_AFFINE_HULL",CLOSED_AFFINE_HULL; +"CLOSED_APPROACHABLE",CLOSED_APPROACHABLE; +"CLOSED_ARC_IMAGE",CLOSED_ARC_IMAGE; +"CLOSED_ARG_LE",CLOSED_ARG_LE; +"CLOSED_AS_FRONTIER",CLOSED_AS_FRONTIER; +"CLOSED_AS_FRONTIER_OF_SUBSET",CLOSED_AS_FRONTIER_OF_SUBSET; +"CLOSED_AS_GDELTA",CLOSED_AS_GDELTA; +"CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE",CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE; +"CLOSED_CBALL",CLOSED_CBALL; +"CLOSED_CLOSURE",CLOSED_CLOSURE; +"CLOSED_COMPACT_DIFFERENCES",CLOSED_COMPACT_DIFFERENCES; +"CLOSED_COMPACT_PROJECTION",CLOSED_COMPACT_PROJECTION; +"CLOSED_COMPACT_SUMS",CLOSED_COMPACT_SUMS; +"CLOSED_COMPONENTS",CLOSED_COMPONENTS; +"CLOSED_CONDENSATION_POINTS",CLOSED_CONDENSATION_POINTS; +"CLOSED_CONNECTED_COMPONENT",CLOSED_CONNECTED_COMPONENT; +"CLOSED_CONTAINS_SEQUENTIAL_LIMIT",CLOSED_CONTAINS_SEQUENTIAL_LIMIT; +"CLOSED_CONVEX_CONE_HULL",CLOSED_CONVEX_CONE_HULL; +"CLOSED_DIFF",CLOSED_DIFF; +"CLOSED_DIFF_OPEN_INTERVAL_1",CLOSED_DIFF_OPEN_INTERVAL_1; +"CLOSED_EMPTY",CLOSED_EMPTY; +"CLOSED_FIP",CLOSED_FIP; +"CLOSED_FORALL",CLOSED_FORALL; +"CLOSED_FORALL_IN",CLOSED_FORALL_IN; +"CLOSED_HALFSPACE_COMPONENT_GE",CLOSED_HALFSPACE_COMPONENT_GE; +"CLOSED_HALFSPACE_COMPONENT_LE",CLOSED_HALFSPACE_COMPONENT_LE; +"CLOSED_HALFSPACE_GE",CLOSED_HALFSPACE_GE; +"CLOSED_HALFSPACE_IM_EQ",CLOSED_HALFSPACE_IM_EQ; +"CLOSED_HALFSPACE_IM_GE",CLOSED_HALFSPACE_IM_GE; +"CLOSED_HALFSPACE_IM_LE",CLOSED_HALFSPACE_IM_LE; +"CLOSED_HALFSPACE_LE",CLOSED_HALFSPACE_LE; +"CLOSED_HALFSPACE_RE_EQ",CLOSED_HALFSPACE_RE_EQ; +"CLOSED_HALFSPACE_RE_GE",CLOSED_HALFSPACE_RE_GE; +"CLOSED_HALFSPACE_RE_LE",CLOSED_HALFSPACE_RE_LE; +"CLOSED_HYPERPLANE",CLOSED_HYPERPLANE; +"CLOSED_IMP_FIP",CLOSED_IMP_FIP; +"CLOSED_IMP_FIP_COMPACT",CLOSED_IMP_FIP_COMPACT; +"CLOSED_IMP_LOCALLY_COMPACT",CLOSED_IMP_LOCALLY_COMPACT; +"CLOSED_IN",CLOSED_IN; +"CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE; +"CLOSED_INJECTIVE_IMAGE_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSPACE; +"CLOSED_INJECTIVE_LINEAR_IMAGE",CLOSED_INJECTIVE_LINEAR_IMAGE; +"CLOSED_INJECTIVE_LINEAR_IMAGE_EQ",CLOSED_INJECTIVE_LINEAR_IMAGE_EQ; +"CLOSED_INSERT",CLOSED_INSERT; +"CLOSED_INTER",CLOSED_INTER; +"CLOSED_INTERS",CLOSED_INTERS; +"CLOSED_INTERS_COMPACT",CLOSED_INTERS_COMPACT; +"CLOSED_INTERVAL",CLOSED_INTERVAL; +"CLOSED_INTERVAL_AS_CONVEX_HULL",CLOSED_INTERVAL_AS_CONVEX_HULL; +"CLOSED_INTERVAL_DROPOUT",CLOSED_INTERVAL_DROPOUT; +"CLOSED_INTERVAL_EQ",CLOSED_INTERVAL_EQ; +"CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL",CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL; +"CLOSED_INTERVAL_LEFT",CLOSED_INTERVAL_LEFT; +"CLOSED_INTERVAL_RIGHT",CLOSED_INTERVAL_RIGHT; +"CLOSED_INTER_COMPACT",CLOSED_INTER_COMPACT; +"CLOSED_IN_CLOSED",CLOSED_IN_CLOSED; +"CLOSED_IN_CLOSED_EQ",CLOSED_IN_CLOSED_EQ; +"CLOSED_IN_CLOSED_INTER",CLOSED_IN_CLOSED_INTER; +"CLOSED_IN_CLOSED_TRANS",CLOSED_IN_CLOSED_TRANS; +"CLOSED_IN_COMPACT",CLOSED_IN_COMPACT; +"CLOSED_IN_COMPACT_EQ",CLOSED_IN_COMPACT_EQ; +"CLOSED_IN_COMPACT_PROJECTION",CLOSED_IN_COMPACT_PROJECTION; +"CLOSED_IN_COMPONENT",CLOSED_IN_COMPONENT; +"CLOSED_IN_CONNECTED_COMPONENT",CLOSED_IN_CONNECTED_COMPONENT; +"CLOSED_IN_DIFF",CLOSED_IN_DIFF; +"CLOSED_IN_EMPTY",CLOSED_IN_EMPTY; +"CLOSED_IN_IMP_SUBSET",CLOSED_IN_IMP_SUBSET; +"CLOSED_IN_INJECTIVE_LINEAR_IMAGE",CLOSED_IN_INJECTIVE_LINEAR_IMAGE; +"CLOSED_IN_INTER",CLOSED_IN_INTER; +"CLOSED_IN_INTERS",CLOSED_IN_INTERS; +"CLOSED_IN_INTER_CLOSED",CLOSED_IN_INTER_CLOSED; +"CLOSED_IN_INTER_CLOSURE",CLOSED_IN_INTER_CLOSURE; +"CLOSED_IN_LIMPT",CLOSED_IN_LIMPT; +"CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; +"CLOSED_IN_PCROSS",CLOSED_IN_PCROSS; +"CLOSED_IN_PCROSS_EQ",CLOSED_IN_PCROSS_EQ; +"CLOSED_IN_REFL",CLOSED_IN_REFL; +"CLOSED_IN_RETRACT",CLOSED_IN_RETRACT; +"CLOSED_IN_SING",CLOSED_IN_SING; +"CLOSED_IN_SUBSET",CLOSED_IN_SUBSET; +"CLOSED_IN_SUBSET_TRANS",CLOSED_IN_SUBSET_TRANS; +"CLOSED_IN_SUBTOPOLOGY",CLOSED_IN_SUBTOPOLOGY; +"CLOSED_IN_SUBTOPOLOGY_EMPTY",CLOSED_IN_SUBTOPOLOGY_EMPTY; +"CLOSED_IN_SUBTOPOLOGY_REFL",CLOSED_IN_SUBTOPOLOGY_REFL; +"CLOSED_IN_SUBTOPOLOGY_UNION",CLOSED_IN_SUBTOPOLOGY_UNION; +"CLOSED_IN_TOPSPACE",CLOSED_IN_TOPSPACE; +"CLOSED_IN_TRANS",CLOSED_IN_TRANS; +"CLOSED_IN_TRANSLATION_EQ",CLOSED_IN_TRANSLATION_EQ; +"CLOSED_IN_TRANS_EQ",CLOSED_IN_TRANS_EQ; +"CLOSED_IN_UNION",CLOSED_IN_UNION; +"CLOSED_IN_UNIONS",CLOSED_IN_UNIONS; +"CLOSED_IN_UNION_COMPLEMENT_COMPONENT",CLOSED_IN_UNION_COMPLEMENT_COMPONENT; +"CLOSED_IN_UNION_COMPLEMENT_COMPONENTS",CLOSED_IN_UNION_COMPLEMENT_COMPONENTS; +"CLOSED_IRREDUCIBLE_SEPARATOR",CLOSED_IRREDUCIBLE_SEPARATOR; +"CLOSED_LIFT",CLOSED_LIFT; +"CLOSED_LIMPT",CLOSED_LIMPT; +"CLOSED_LIMPTS",CLOSED_LIMPTS; +"CLOSED_MAP_FROM_COMPOSITION_INJECTIVE",CLOSED_MAP_FROM_COMPOSITION_INJECTIVE; +"CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE",CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE; +"CLOSED_MAP_FSTCART",CLOSED_MAP_FSTCART; +"CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE",CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE; +"CLOSED_MAP_IMP_OPEN_MAP",CLOSED_MAP_IMP_OPEN_MAP; +"CLOSED_MAP_IMP_QUOTIENT_MAP",CLOSED_MAP_IMP_QUOTIENT_MAP; +"CLOSED_MAP_OPEN_SUPERSET_PREIMAGE",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE; +"CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ; +"CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT; +"CLOSED_MAP_RESTRICT",CLOSED_MAP_RESTRICT; +"CLOSED_MAP_SNDCART",CLOSED_MAP_SNDCART; +"CLOSED_NEGATIONS",CLOSED_NEGATIONS; +"CLOSED_OPEN_INTERVAL_1",CLOSED_OPEN_INTERVAL_1; +"CLOSED_PATH_IMAGE",CLOSED_PATH_IMAGE; +"CLOSED_PCROSS",CLOSED_PCROSS; +"CLOSED_PCROSS_EQ",CLOSED_PCROSS_EQ; +"CLOSED_POSITIVE_ORTHANT",CLOSED_POSITIVE_ORTHANT; +"CLOSED_REAL",CLOSED_REAL; +"CLOSED_REAL_SET",CLOSED_REAL_SET; +"CLOSED_RELATIVE_BOUNDARY",CLOSED_RELATIVE_BOUNDARY; +"CLOSED_RELATIVE_FRONTIER",CLOSED_RELATIVE_FRONTIER; +"CLOSED_SCALING",CLOSED_SCALING; +"CLOSED_SEGMENT",CLOSED_SEGMENT; +"CLOSED_SEGMENT_LINEAR_IMAGE",CLOSED_SEGMENT_LINEAR_IMAGE; +"CLOSED_SEQUENTIAL_LIMITS",CLOSED_SEQUENTIAL_LIMITS; +"CLOSED_SHIFTPATH",CLOSED_SHIFTPATH; +"CLOSED_SIMPLEX",CLOSED_SIMPLEX; +"CLOSED_SIMPLE_PATH_IMAGE",CLOSED_SIMPLE_PATH_IMAGE; +"CLOSED_SING",CLOSED_SING; +"CLOSED_SLICE",CLOSED_SLICE; +"CLOSED_SPAN",CLOSED_SPAN; +"CLOSED_SPHERE",CLOSED_SPHERE; +"CLOSED_STANDARD_HYPERPLANE",CLOSED_STANDARD_HYPERPLANE; +"CLOSED_SUBSET",CLOSED_SUBSET; +"CLOSED_SUBSET_EQ",CLOSED_SUBSET_EQ; +"CLOSED_SUBSPACE",CLOSED_SUBSPACE; +"CLOSED_SUBSTANDARD",CLOSED_SUBSTANDARD; +"CLOSED_TRANSLATION",CLOSED_TRANSLATION; +"CLOSED_TRANSLATION_EQ",CLOSED_TRANSLATION_EQ; +"CLOSED_UNION",CLOSED_UNION; +"CLOSED_UNIONS",CLOSED_UNIONS; +"CLOSED_UNION_COMPACT_SUBSETS",CLOSED_UNION_COMPACT_SUBSETS; +"CLOSED_UNION_COMPLEMENT_COMPONENT",CLOSED_UNION_COMPLEMENT_COMPONENT; +"CLOSED_UNION_COMPLEMENT_COMPONENTS",CLOSED_UNION_COMPLEMENT_COMPONENTS; +"CLOSED_UNIV",CLOSED_UNIV; +"CLOSED_VALID_PATH_IMAGE",CLOSED_VALID_PATH_IMAGE; +"CLOSER_POINTS_LEMMA",CLOSER_POINTS_LEMMA; +"CLOSER_POINT_LEMMA",CLOSER_POINT_LEMMA; +"CLOSEST_POINT_AFFINE_ORTHOGONAL",CLOSEST_POINT_AFFINE_ORTHOGONAL; +"CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ",CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ; +"CLOSEST_POINT_DOT",CLOSEST_POINT_DOT; +"CLOSEST_POINT_EXISTS",CLOSEST_POINT_EXISTS; +"CLOSEST_POINT_IN_FRONTIER",CLOSEST_POINT_IN_FRONTIER; +"CLOSEST_POINT_IN_INTERIOR",CLOSEST_POINT_IN_INTERIOR; +"CLOSEST_POINT_IN_RELATIVE_FRONTIER",CLOSEST_POINT_IN_RELATIVE_FRONTIER; +"CLOSEST_POINT_IN_RELATIVE_INTERIOR",CLOSEST_POINT_IN_RELATIVE_INTERIOR; +"CLOSEST_POINT_IN_SET",CLOSEST_POINT_IN_SET; +"CLOSEST_POINT_LE",CLOSEST_POINT_LE; +"CLOSEST_POINT_LIPSCHITZ",CLOSEST_POINT_LIPSCHITZ; +"CLOSEST_POINT_LT",CLOSEST_POINT_LT; +"CLOSEST_POINT_REFL",CLOSEST_POINT_REFL; +"CLOSEST_POINT_SELF",CLOSEST_POINT_SELF; +"CLOSEST_POINT_UNIQUE",CLOSEST_POINT_UNIQUE; +"CLOSURE_APPROACHABLE",CLOSURE_APPROACHABLE; +"CLOSURE_BALL",CLOSURE_BALL; +"CLOSURE_BOUNDED_LINEAR_IMAGE",CLOSURE_BOUNDED_LINEAR_IMAGE; +"CLOSURE_CLOSED",CLOSURE_CLOSED; +"CLOSURE_CLOSURE",CLOSURE_CLOSURE; +"CLOSURE_COCOUNTABLE_COORDINATES",CLOSURE_COCOUNTABLE_COORDINATES; +"CLOSURE_COMPLEMENT",CLOSURE_COMPLEMENT; +"CLOSURE_CONVEX_HULL",CLOSURE_CONVEX_HULL; +"CLOSURE_CONVEX_INTER_AFFINE",CLOSURE_CONVEX_INTER_AFFINE; +"CLOSURE_CONVEX_INTER_SUPERSET",CLOSURE_CONVEX_INTER_SUPERSET; +"CLOSURE_COSMALL_COORDINATES",CLOSURE_COSMALL_COORDINATES; +"CLOSURE_DYADIC_RATIONALS",CLOSURE_DYADIC_RATIONALS; +"CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET",CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; +"CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET",CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET; +"CLOSURE_EMPTY",CLOSURE_EMPTY; +"CLOSURE_EQ",CLOSURE_EQ; +"CLOSURE_EQ_EMPTY",CLOSURE_EQ_EMPTY; +"CLOSURE_HALFSPACE_COMPONENT_GT",CLOSURE_HALFSPACE_COMPONENT_GT; +"CLOSURE_HALFSPACE_COMPONENT_LT",CLOSURE_HALFSPACE_COMPONENT_LT; +"CLOSURE_HALFSPACE_GT",CLOSURE_HALFSPACE_GT; +"CLOSURE_HALFSPACE_LT",CLOSURE_HALFSPACE_LT; +"CLOSURE_HULL",CLOSURE_HULL; +"CLOSURE_IMAGE_BOUNDED",CLOSURE_IMAGE_BOUNDED; +"CLOSURE_IMAGE_CLOSURE",CLOSURE_IMAGE_CLOSURE; +"CLOSURE_INJECTIVE_LINEAR_IMAGE",CLOSURE_INJECTIVE_LINEAR_IMAGE; +"CLOSURE_INSIDE_SUBSET",CLOSURE_INSIDE_SUBSET; +"CLOSURE_INTERIOR",CLOSURE_INTERIOR; +"CLOSURE_INTERIOR_IDEMP",CLOSURE_INTERIOR_IDEMP; +"CLOSURE_INTERIOR_UNION_CLOSED",CLOSURE_INTERIOR_UNION_CLOSED; +"CLOSURE_INTERS_CONVEX",CLOSURE_INTERS_CONVEX; +"CLOSURE_INTERS_CONVEX_OPEN",CLOSURE_INTERS_CONVEX_OPEN; +"CLOSURE_INTERS_SUBSET",CLOSURE_INTERS_SUBSET; +"CLOSURE_INTERVAL",CLOSURE_INTERVAL; +"CLOSURE_INTER_CONVEX",CLOSURE_INTER_CONVEX; +"CLOSURE_INTER_CONVEX_OPEN",CLOSURE_INTER_CONVEX_OPEN; +"CLOSURE_INTER_SUBSET",CLOSURE_INTER_SUBSET; +"CLOSURE_IRRATIONAL_COORDINATES",CLOSURE_IRRATIONAL_COORDINATES; +"CLOSURE_LINEAR_IMAGE_SUBSET",CLOSURE_LINEAR_IMAGE_SUBSET; +"CLOSURE_MINIMAL",CLOSURE_MINIMAL; +"CLOSURE_MINIMAL_EQ",CLOSURE_MINIMAL_EQ; +"CLOSURE_NEGATIONS",CLOSURE_NEGATIONS; +"CLOSURE_OPEN_INTERVAL",CLOSURE_OPEN_INTERVAL; +"CLOSURE_OPEN_INTER_SUPERSET",CLOSURE_OPEN_INTER_SUPERSET; +"CLOSURE_OUTSIDE_SUBSET",CLOSURE_OUTSIDE_SUBSET; +"CLOSURE_PCROSS",CLOSURE_PCROSS; +"CLOSURE_RATIONALS_IN_CONVEX_SET",CLOSURE_RATIONALS_IN_CONVEX_SET; +"CLOSURE_RATIONALS_IN_OPEN_SET",CLOSURE_RATIONALS_IN_OPEN_SET; +"CLOSURE_RATIONAL_COORDINATES",CLOSURE_RATIONAL_COORDINATES; +"CLOSURE_SEGMENT",CLOSURE_SEGMENT; +"CLOSURE_SEQUENTIAL",CLOSURE_SEQUENTIAL; +"CLOSURE_SING",CLOSURE_SING; +"CLOSURE_SUBSET",CLOSURE_SUBSET; +"CLOSURE_SUBSET_AFFINE_HULL",CLOSURE_SUBSET_AFFINE_HULL; +"CLOSURE_SUBSET_EQ",CLOSURE_SUBSET_EQ; +"CLOSURE_SUMS",CLOSURE_SUMS; +"CLOSURE_SURJECTIVE_LINEAR_IMAGE",CLOSURE_SURJECTIVE_LINEAR_IMAGE; +"CLOSURE_TRANSLATION",CLOSURE_TRANSLATION; +"CLOSURE_UNION",CLOSURE_UNION; +"CLOSURE_UNIONS",CLOSURE_UNIONS; +"CLOSURE_UNION_FRONTIER",CLOSURE_UNION_FRONTIER; +"CLOSURE_UNIQUE",CLOSURE_UNIQUE; +"CLOSURE_UNIV",CLOSURE_UNIV; +"CNJ_ADD",CNJ_ADD; +"CNJ_CCOS",CNJ_CCOS; +"CNJ_CEXP",CNJ_CEXP; +"CNJ_CLOG",CNJ_CLOG; +"CNJ_CNJ",CNJ_CNJ; +"CNJ_CPRODUCT",CNJ_CPRODUCT; +"CNJ_CSIN",CNJ_CSIN; +"CNJ_CSQRT",CNJ_CSQRT; +"CNJ_CTAN",CNJ_CTAN; +"CNJ_CX",CNJ_CX; +"CNJ_DIV",CNJ_DIV; +"CNJ_EQ_0",CNJ_EQ_0; +"CNJ_EQ_CX",CNJ_EQ_CX; +"CNJ_II",CNJ_II; +"CNJ_INJ",CNJ_INJ; +"CNJ_INV",CNJ_INV; +"CNJ_MUL",CNJ_MUL; +"CNJ_NEG",CNJ_NEG; +"CNJ_POW",CNJ_POW; +"CNJ_SUB",CNJ_SUB; +"CNJ_VSUM",CNJ_VSUM; +"COBOUNDED_HAS_BOUNDED_COMPONENT",COBOUNDED_HAS_BOUNDED_COMPONENT; +"COBOUNDED_IMP_UNBOUNDED",COBOUNDED_IMP_UNBOUNDED; +"COBOUNDED_INTER_UNBOUNDED",COBOUNDED_INTER_UNBOUNDED; +"COBOUNDED_OUTSIDE",COBOUNDED_OUTSIDE; +"COBOUNDED_UNBOUNDED_COMPONENT",COBOUNDED_UNBOUNDED_COMPONENT; +"COBOUNDED_UNBOUNDED_COMPONENTS",COBOUNDED_UNBOUNDED_COMPONENTS; +"COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT; +"COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS; +"COCOUNTABLE_APPROXIMATION",COCOUNTABLE_APPROXIMATION; +"CODESET_SETCODE_BIJECTIONS",CODESET_SETCODE_BIJECTIONS; +"COFACTOR_0",COFACTOR_0; +"COFACTOR_CMUL",COFACTOR_CMUL; +"COFACTOR_COFACTOR",COFACTOR_COFACTOR; +"COFACTOR_COLUMN",COFACTOR_COLUMN; +"COFACTOR_EQ_0",COFACTOR_EQ_0; +"COFACTOR_I",COFACTOR_I; +"COFACTOR_MATRIX_INV",COFACTOR_MATRIX_INV; +"COFACTOR_MATRIX_MUL",COFACTOR_MATRIX_MUL; +"COFACTOR_ROW",COFACTOR_ROW; +"COFACTOR_TRANSP",COFACTOR_TRANSP; +"COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS; +"COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL; +"COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; +"COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; +"COLLINEAR_1",COLLINEAR_1; +"COLLINEAR_2",COLLINEAR_2; +"COLLINEAR_3",COLLINEAR_3; +"COLLINEAR_3_2D",COLLINEAR_3_2D; +"COLLINEAR_3_AFFINE_HULL",COLLINEAR_3_AFFINE_HULL; +"COLLINEAR_3_DOT_MULTIPLES",COLLINEAR_3_DOT_MULTIPLES; +"COLLINEAR_3_EQ_AFFINE_DEPENDENT",COLLINEAR_3_EQ_AFFINE_DEPENDENT; +"COLLINEAR_3_EXPAND",COLLINEAR_3_EXPAND; +"COLLINEAR_3_IN_AFFINE_HULL",COLLINEAR_3_IN_AFFINE_HULL; +"COLLINEAR_3_TRANS",COLLINEAR_3_TRANS; +"COLLINEAR_4_3",COLLINEAR_4_3; +"COLLINEAR_AFFINE_HULL",COLLINEAR_AFFINE_HULL; +"COLLINEAR_AFFINE_HULL_COLLINEAR",COLLINEAR_AFFINE_HULL_COLLINEAR; +"COLLINEAR_AFF_DIM",COLLINEAR_AFF_DIM; +"COLLINEAR_BETWEEN_CASES",COLLINEAR_BETWEEN_CASES; +"COLLINEAR_CONVEX_HULL_COLLINEAR",COLLINEAR_CONVEX_HULL_COLLINEAR; +"COLLINEAR_DIST_BETWEEN",COLLINEAR_DIST_BETWEEN; +"COLLINEAR_DIST_IN_CLOSED_SEGMENT",COLLINEAR_DIST_IN_CLOSED_SEGMENT; +"COLLINEAR_DIST_IN_OPEN_SEGMENT",COLLINEAR_DIST_IN_OPEN_SEGMENT; +"COLLINEAR_EMPTY",COLLINEAR_EMPTY; +"COLLINEAR_EXTREME_POINTS",COLLINEAR_EXTREME_POINTS; +"COLLINEAR_IMP_COPLANAR",COLLINEAR_IMP_COPLANAR; +"COLLINEAR_LEMMA",COLLINEAR_LEMMA; +"COLLINEAR_LEMMA_ALT",COLLINEAR_LEMMA_ALT; +"COLLINEAR_LINEAR_IMAGE",COLLINEAR_LINEAR_IMAGE; +"COLLINEAR_LINEAR_IMAGE_EQ",COLLINEAR_LINEAR_IMAGE_EQ; +"COLLINEAR_MIDPOINT",COLLINEAR_MIDPOINT; +"COLLINEAR_SEGMENT",COLLINEAR_SEGMENT; +"COLLINEAR_SING",COLLINEAR_SING; +"COLLINEAR_SMALL",COLLINEAR_SMALL; +"COLLINEAR_SUBSET",COLLINEAR_SUBSET; +"COLLINEAR_TRANSLATION",COLLINEAR_TRANSLATION; +"COLLINEAR_TRANSLATION_EQ",COLLINEAR_TRANSLATION_EQ; +"COLLINEAR_TRIPLES",COLLINEAR_TRIPLES; +"COLUMNS_IMAGE_BASIS",COLUMNS_IMAGE_BASIS; +"COLUMNS_TRANSP",COLUMNS_TRANSP; +"COLUMN_TRANSP",COLUMN_TRANSP; +"COMMA_DEF",COMMA_DEF; +"COMPACT_AFFINITY",COMPACT_AFFINITY; +"COMPACT_AR",COMPACT_AR; +"COMPACT_ARC_IMAGE",COMPACT_ARC_IMAGE; +"COMPACT_ATTAINS_INF",COMPACT_ATTAINS_INF; +"COMPACT_ATTAINS_SUP",COMPACT_ATTAINS_SUP; +"COMPACT_CBALL",COMPACT_CBALL; +"COMPACT_CHAIN",COMPACT_CHAIN; +"COMPACT_CLOSED_DIFFERENCES",COMPACT_CLOSED_DIFFERENCES; +"COMPACT_CLOSED_SUMS",COMPACT_CLOSED_SUMS; +"COMPACT_CLOSURE",COMPACT_CLOSURE; +"COMPACT_COMPONENTS",COMPACT_COMPONENTS; +"COMPACT_CONTINUOUS_IMAGE",COMPACT_CONTINUOUS_IMAGE; +"COMPACT_CONTINUOUS_IMAGE_EQ",COMPACT_CONTINUOUS_IMAGE_EQ; +"COMPACT_CONVEX_COLLINEAR_SEGMENT",COMPACT_CONVEX_COLLINEAR_SEGMENT; +"COMPACT_CONVEX_COMBINATIONS",COMPACT_CONVEX_COMBINATIONS; +"COMPACT_CONVEX_HULL",COMPACT_CONVEX_HULL; +"COMPACT_DIFF",COMPACT_DIFF; +"COMPACT_DIFFERENCES",COMPACT_DIFFERENCES; +"COMPACT_EMPTY",COMPACT_EMPTY; +"COMPACT_EQ_BOLZANO_WEIERSTRASS",COMPACT_EQ_BOLZANO_WEIERSTRASS; +"COMPACT_EQ_BOUNDED_CLOSED",COMPACT_EQ_BOUNDED_CLOSED; +"COMPACT_EQ_HEINE_BOREL",COMPACT_EQ_HEINE_BOREL; +"COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY",COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY; +"COMPACT_FIP",COMPACT_FIP; +"COMPACT_FRONTIER",COMPACT_FRONTIER; +"COMPACT_FRONTIER_BOUNDED",COMPACT_FRONTIER_BOUNDED; +"COMPACT_FRONTIER_LINE_LEMMA",COMPACT_FRONTIER_LINE_LEMMA; +"COMPACT_IMP_BOUNDED",COMPACT_IMP_BOUNDED; +"COMPACT_IMP_CLOSED",COMPACT_IMP_CLOSED; +"COMPACT_IMP_COMPLETE",COMPACT_IMP_COMPLETE; +"COMPACT_IMP_FIP",COMPACT_IMP_FIP; +"COMPACT_IMP_HEINE_BOREL",COMPACT_IMP_HEINE_BOREL; +"COMPACT_IMP_TOTALLY_BOUNDED",COMPACT_IMP_TOTALLY_BOUNDED; +"COMPACT_INSERT",COMPACT_INSERT; +"COMPACT_INTER",COMPACT_INTER; +"COMPACT_INTERS",COMPACT_INTERS; +"COMPACT_INTERVAL",COMPACT_INTERVAL; +"COMPACT_INTERVAL_EQ",COMPACT_INTERVAL_EQ; +"COMPACT_INTER_CLOSED",COMPACT_INTER_CLOSED; +"COMPACT_LEMMA",COMPACT_LEMMA; +"COMPACT_LINEAR_IMAGE",COMPACT_LINEAR_IMAGE; +"COMPACT_LINEAR_IMAGE_EQ",COMPACT_LINEAR_IMAGE_EQ; +"COMPACT_NEGATIONS",COMPACT_NEGATIONS; +"COMPACT_NEST",COMPACT_NEST; +"COMPACT_OPEN",COMPACT_OPEN; +"COMPACT_PATH_IMAGE",COMPACT_PATH_IMAGE; +"COMPACT_PCROSS",COMPACT_PCROSS; +"COMPACT_PCROSS_EQ",COMPACT_PCROSS_EQ; +"COMPACT_REAL_LEMMA",COMPACT_REAL_LEMMA; +"COMPACT_RELATIVE_BOUNDARY",COMPACT_RELATIVE_BOUNDARY; +"COMPACT_RELATIVE_FRONTIER",COMPACT_RELATIVE_FRONTIER; +"COMPACT_RELATIVE_FRONTIER_BOUNDED",COMPACT_RELATIVE_FRONTIER_BOUNDED; +"COMPACT_SCALING",COMPACT_SCALING; +"COMPACT_SEGMENT",COMPACT_SEGMENT; +"COMPACT_SEQUENCE_WITH_LIMIT",COMPACT_SEQUENCE_WITH_LIMIT; +"COMPACT_SIMPLEX",COMPACT_SIMPLEX; +"COMPACT_SIMPLE_PATH_IMAGE",COMPACT_SIMPLE_PATH_IMAGE; +"COMPACT_SING",COMPACT_SING; +"COMPACT_SLICE",COMPACT_SLICE; +"COMPACT_SPHERE",COMPACT_SPHERE; +"COMPACT_SUBSET_FRONTIER_RETRACTION",COMPACT_SUBSET_FRONTIER_RETRACTION; +"COMPACT_SUMS",COMPACT_SUMS; +"COMPACT_SUP_MAXDISTANCE",COMPACT_SUP_MAXDISTANCE; +"COMPACT_TRANSLATION",COMPACT_TRANSLATION; +"COMPACT_TRANSLATION_EQ",COMPACT_TRANSLATION_EQ; +"COMPACT_UNIFORMLY_CONTINUOUS",COMPACT_UNIFORMLY_CONTINUOUS; +"COMPACT_UNIFORMLY_EQUICONTINUOUS",COMPACT_UNIFORMLY_EQUICONTINUOUS; +"COMPACT_UNION",COMPACT_UNION; +"COMPACT_UNIONS",COMPACT_UNIONS; +"COMPACT_VALID_PATH_IMAGE",COMPACT_VALID_PATH_IMAGE; +"COMPLEMENT_CONNECTED_COMPONENT_UNIONS",COMPLEMENT_CONNECTED_COMPONENT_UNIONS; +"COMPLEMENT_PATH_COMPONENT_UNIONS",COMPLEMENT_PATH_COMPONENT_UNIONS; +"COMPLETE_EQ_CLOSED",COMPLETE_EQ_CLOSED; +"COMPLETE_FACE_TOP",COMPLETE_FACE_TOP; +"COMPLETE_INJECTIVE_LINEAR_IMAGE",COMPLETE_INJECTIVE_LINEAR_IMAGE; +"COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ",COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ; +"COMPLETE_ISOMETRIC_IMAGE",COMPLETE_ISOMETRIC_IMAGE; +"COMPLETE_SUBSPACE",COMPLETE_SUBSPACE; +"COMPLETE_TRANSLATION_EQ",COMPLETE_TRANSLATION_EQ; +"COMPLETE_UNIV",COMPLETE_UNIV; +"COMPLEX",COMPLEX; +"COMPLEX_ADD2_SUB2",COMPLEX_ADD2_SUB2; +"COMPLEX_ADD_AC",COMPLEX_ADD_AC; +"COMPLEX_ADD_ASSOC",COMPLEX_ADD_ASSOC; +"COMPLEX_ADD_CCOS",COMPLEX_ADD_CCOS; +"COMPLEX_ADD_CNJ",COMPLEX_ADD_CNJ; +"COMPLEX_ADD_CSIN",COMPLEX_ADD_CSIN; +"COMPLEX_ADD_CTAN",COMPLEX_ADD_CTAN; +"COMPLEX_ADD_LDISTRIB",COMPLEX_ADD_LDISTRIB; +"COMPLEX_ADD_LID",COMPLEX_ADD_LID; +"COMPLEX_ADD_LINV",COMPLEX_ADD_LINV; +"COMPLEX_ADD_RDISTRIB",COMPLEX_ADD_RDISTRIB; +"COMPLEX_ADD_RID",COMPLEX_ADD_RID; +"COMPLEX_ADD_RINV",COMPLEX_ADD_RINV; +"COMPLEX_ADD_SUB",COMPLEX_ADD_SUB; +"COMPLEX_ADD_SUB2",COMPLEX_ADD_SUB2; +"COMPLEX_ADD_SYM",COMPLEX_ADD_SYM; +"COMPLEX_BASIS",COMPLEX_BASIS; +"COMPLEX_CMUL",COMPLEX_CMUL; +"COMPLEX_DERIVATIVE_ADD",COMPLEX_DERIVATIVE_ADD; +"COMPLEX_DERIVATIVE_ADD_AT",COMPLEX_DERIVATIVE_ADD_AT; +"COMPLEX_DERIVATIVE_CHAIN",COMPLEX_DERIVATIVE_CHAIN; +"COMPLEX_DERIVATIVE_COMPOSE_LINEAR",COMPLEX_DERIVATIVE_COMPOSE_LINEAR; +"COMPLEX_DERIVATIVE_CONST",COMPLEX_DERIVATIVE_CONST; +"COMPLEX_DERIVATIVE_ID",COMPLEX_DERIVATIVE_ID; +"COMPLEX_DERIVATIVE_JACOBIAN",COMPLEX_DERIVATIVE_JACOBIAN; +"COMPLEX_DERIVATIVE_LINEAR",COMPLEX_DERIVATIVE_LINEAR; +"COMPLEX_DERIVATIVE_LMUL",COMPLEX_DERIVATIVE_LMUL; +"COMPLEX_DERIVATIVE_LMUL_AT",COMPLEX_DERIVATIVE_LMUL_AT; +"COMPLEX_DERIVATIVE_MUL",COMPLEX_DERIVATIVE_MUL; +"COMPLEX_DERIVATIVE_MUL_AT",COMPLEX_DERIVATIVE_MUL_AT; +"COMPLEX_DERIVATIVE_RMUL",COMPLEX_DERIVATIVE_RMUL; +"COMPLEX_DERIVATIVE_RMUL_AT",COMPLEX_DERIVATIVE_RMUL_AT; +"COMPLEX_DERIVATIVE_SUB",COMPLEX_DERIVATIVE_SUB; +"COMPLEX_DERIVATIVE_SUB_AT",COMPLEX_DERIVATIVE_SUB_AT; +"COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN",COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"COMPLEX_DERIVATIVE_UNIQUE_AT",COMPLEX_DERIVATIVE_UNIQUE_AT; +"COMPLEX_DIFFERENTIABLE_ADD",COMPLEX_DIFFERENTIABLE_ADD; +"COMPLEX_DIFFERENTIABLE_AT_CACS",COMPLEX_DIFFERENTIABLE_AT_CACS; +"COMPLEX_DIFFERENTIABLE_AT_CASN",COMPLEX_DIFFERENTIABLE_AT_CASN; +"COMPLEX_DIFFERENTIABLE_AT_CATN",COMPLEX_DIFFERENTIABLE_AT_CATN; +"COMPLEX_DIFFERENTIABLE_AT_CCOS",COMPLEX_DIFFERENTIABLE_AT_CCOS; +"COMPLEX_DIFFERENTIABLE_AT_CEXP",COMPLEX_DIFFERENTIABLE_AT_CEXP; +"COMPLEX_DIFFERENTIABLE_AT_CLOG",COMPLEX_DIFFERENTIABLE_AT_CLOG; +"COMPLEX_DIFFERENTIABLE_AT_CSIN",COMPLEX_DIFFERENTIABLE_AT_CSIN; +"COMPLEX_DIFFERENTIABLE_AT_CSQRT",COMPLEX_DIFFERENTIABLE_AT_CSQRT; +"COMPLEX_DIFFERENTIABLE_AT_CTAN",COMPLEX_DIFFERENTIABLE_AT_CTAN; +"COMPLEX_DIFFERENTIABLE_AT_WITHIN",COMPLEX_DIFFERENTIABLE_AT_WITHIN; +"COMPLEX_DIFFERENTIABLE_BOUND",COMPLEX_DIFFERENTIABLE_BOUND; +"COMPLEX_DIFFERENTIABLE_CARATHEODORY_AT",COMPLEX_DIFFERENTIABLE_CARATHEODORY_AT; +"COMPLEX_DIFFERENTIABLE_CARATHEODORY_WITHIN",COMPLEX_DIFFERENTIABLE_CARATHEODORY_WITHIN; +"COMPLEX_DIFFERENTIABLE_COMPOSE",COMPLEX_DIFFERENTIABLE_COMPOSE; +"COMPLEX_DIFFERENTIABLE_COMPOSE_AT",COMPLEX_DIFFERENTIABLE_COMPOSE_AT; +"COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN",COMPLEX_DIFFERENTIABLE_COMPOSE_WITHIN; +"COMPLEX_DIFFERENTIABLE_CONST",COMPLEX_DIFFERENTIABLE_CONST; +"COMPLEX_DIFFERENTIABLE_CPOW_RIGHT",COMPLEX_DIFFERENTIABLE_CPOW_RIGHT; +"COMPLEX_DIFFERENTIABLE_CPRODUCT_AT",COMPLEX_DIFFERENTIABLE_CPRODUCT_AT; +"COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN",COMPLEX_DIFFERENTIABLE_CPRODUCT_WITHIN; +"COMPLEX_DIFFERENTIABLE_DIV_AT",COMPLEX_DIFFERENTIABLE_DIV_AT; +"COMPLEX_DIFFERENTIABLE_DIV_WITHIN",COMPLEX_DIFFERENTIABLE_DIV_WITHIN; +"COMPLEX_DIFFERENTIABLE_EQ_CONFORMAL",COMPLEX_DIFFERENTIABLE_EQ_CONFORMAL; +"COMPLEX_DIFFERENTIABLE_ID",COMPLEX_DIFFERENTIABLE_ID; +"COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT",COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; +"COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN",COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; +"COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE",COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE; +"COMPLEX_DIFFERENTIABLE_INV_AT",COMPLEX_DIFFERENTIABLE_INV_AT; +"COMPLEX_DIFFERENTIABLE_INV_WITHIN",COMPLEX_DIFFERENTIABLE_INV_WITHIN; +"COMPLEX_DIFFERENTIABLE_LINEAR",COMPLEX_DIFFERENTIABLE_LINEAR; +"COMPLEX_DIFFERENTIABLE_MUL_AT",COMPLEX_DIFFERENTIABLE_MUL_AT; +"COMPLEX_DIFFERENTIABLE_MUL_WITHIN",COMPLEX_DIFFERENTIABLE_MUL_WITHIN; +"COMPLEX_DIFFERENTIABLE_NEG",COMPLEX_DIFFERENTIABLE_NEG; +"COMPLEX_DIFFERENTIABLE_POW_AT",COMPLEX_DIFFERENTIABLE_POW_AT; +"COMPLEX_DIFFERENTIABLE_POW_WITHIN",COMPLEX_DIFFERENTIABLE_POW_WITHIN; +"COMPLEX_DIFFERENTIABLE_SUB",COMPLEX_DIFFERENTIABLE_SUB; +"COMPLEX_DIFFERENTIABLE_TRANSFORM_AT",COMPLEX_DIFFERENTIABLE_TRANSFORM_AT; +"COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN",COMPLEX_DIFFERENTIABLE_TRANSFORM_WITHIN; +"COMPLEX_DIFFERENTIABLE_WITHIN_CACS",COMPLEX_DIFFERENTIABLE_WITHIN_CACS; +"COMPLEX_DIFFERENTIABLE_WITHIN_CASN",COMPLEX_DIFFERENTIABLE_WITHIN_CASN; +"COMPLEX_DIFFERENTIABLE_WITHIN_CATN",COMPLEX_DIFFERENTIABLE_WITHIN_CATN; +"COMPLEX_DIFFERENTIABLE_WITHIN_CCOS",COMPLEX_DIFFERENTIABLE_WITHIN_CCOS; +"COMPLEX_DIFFERENTIABLE_WITHIN_CEXP",COMPLEX_DIFFERENTIABLE_WITHIN_CEXP; +"COMPLEX_DIFFERENTIABLE_WITHIN_CLOG",COMPLEX_DIFFERENTIABLE_WITHIN_CLOG; +"COMPLEX_DIFFERENTIABLE_WITHIN_CSIN",COMPLEX_DIFFERENTIABLE_WITHIN_CSIN; +"COMPLEX_DIFFERENTIABLE_WITHIN_CSQRT",COMPLEX_DIFFERENTIABLE_WITHIN_CSQRT; +"COMPLEX_DIFFERENTIABLE_WITHIN_CTAN",COMPLEX_DIFFERENTIABLE_WITHIN_CTAN; +"COMPLEX_DIFFERENTIABLE_WITHIN_OPEN",COMPLEX_DIFFERENTIABLE_WITHIN_OPEN; +"COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET",COMPLEX_DIFFERENTIABLE_WITHIN_SUBSET; +"COMPLEX_DIFFSQ",COMPLEX_DIFFSQ; +"COMPLEX_DIFF_CHAIN_AT",COMPLEX_DIFF_CHAIN_AT; +"COMPLEX_DIFF_CHAIN_WITHIN",COMPLEX_DIFF_CHAIN_WITHIN; +"COMPLEX_DIV_1",COMPLEX_DIV_1; +"COMPLEX_DIV_CNJ",COMPLEX_DIV_CNJ; +"COMPLEX_DIV_EQ_0",COMPLEX_DIV_EQ_0; +"COMPLEX_DIV_LMUL",COMPLEX_DIV_LMUL; +"COMPLEX_DIV_POW",COMPLEX_DIV_POW; +"COMPLEX_DIV_POW2",COMPLEX_DIV_POW2; +"COMPLEX_DIV_REFL",COMPLEX_DIV_REFL; +"COMPLEX_DIV_RMUL",COMPLEX_DIV_RMUL; +"COMPLEX_DIV_ROTATION",COMPLEX_DIV_ROTATION; +"COMPLEX_ENTIRE",COMPLEX_ENTIRE; +"COMPLEX_EQ",COMPLEX_EQ; +"COMPLEX_EQ_0",COMPLEX_EQ_0; +"COMPLEX_EQ_ADD_LCANCEL",COMPLEX_EQ_ADD_LCANCEL; +"COMPLEX_EQ_ADD_LCANCEL_0",COMPLEX_EQ_ADD_LCANCEL_0; +"COMPLEX_EQ_ADD_RCANCEL",COMPLEX_EQ_ADD_RCANCEL; +"COMPLEX_EQ_ADD_RCANCEL_0",COMPLEX_EQ_ADD_RCANCEL_0; +"COMPLEX_EQ_CEXP",COMPLEX_EQ_CEXP; +"COMPLEX_EQ_MUL_LCANCEL",COMPLEX_EQ_MUL_LCANCEL; +"COMPLEX_EQ_MUL_RCANCEL",COMPLEX_EQ_MUL_RCANCEL; +"COMPLEX_EQ_NEG2",COMPLEX_EQ_NEG2; +"COMPLEX_EQ_SUB_LADD",COMPLEX_EQ_SUB_LADD; +"COMPLEX_EQ_SUB_RADD",COMPLEX_EQ_SUB_RADD; +"COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE",COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE; +"COMPLEX_EXPAND",COMPLEX_EXPAND; +"COMPLEX_INTEGER",COMPLEX_INTEGER; +"COMPLEX_INV_0",COMPLEX_INV_0; +"COMPLEX_INV_1",COMPLEX_INV_1; +"COMPLEX_INV_CNJ",COMPLEX_INV_CNJ; +"COMPLEX_INV_DIV",COMPLEX_INV_DIV; +"COMPLEX_INV_EQ_0",COMPLEX_INV_EQ_0; +"COMPLEX_INV_EQ_1",COMPLEX_INV_EQ_1; +"COMPLEX_INV_II",COMPLEX_INV_II; +"COMPLEX_INV_INV",COMPLEX_INV_INV; +"COMPLEX_INV_MUL",COMPLEX_INV_MUL; +"COMPLEX_INV_NEG",COMPLEX_INV_NEG; +"COMPLEX_IN_BALL_0",COMPLEX_IN_BALL_0; +"COMPLEX_IN_CBALL_0",COMPLEX_IN_CBALL_0; +"COMPLEX_IN_SPHERE_0",COMPLEX_IN_SPHERE_0; +"COMPLEX_L1_LE_NORM",COMPLEX_L1_LE_NORM; +"COMPLEX_LNEG_UNIQ",COMPLEX_LNEG_UNIQ; +"COMPLEX_MUL_2",COMPLEX_MUL_2; +"COMPLEX_MUL_AC",COMPLEX_MUL_AC; +"COMPLEX_MUL_ASSOC",COMPLEX_MUL_ASSOC; +"COMPLEX_MUL_CCOS_CCOS",COMPLEX_MUL_CCOS_CCOS; +"COMPLEX_MUL_CCOS_CSIN",COMPLEX_MUL_CCOS_CSIN; +"COMPLEX_MUL_CNJ",COMPLEX_MUL_CNJ; +"COMPLEX_MUL_CSIN_CCOS",COMPLEX_MUL_CSIN_CCOS; +"COMPLEX_MUL_CSIN_CSIN",COMPLEX_MUL_CSIN_CSIN; +"COMPLEX_MUL_LID",COMPLEX_MUL_LID; +"COMPLEX_MUL_LINV",COMPLEX_MUL_LINV; +"COMPLEX_MUL_LNEG",COMPLEX_MUL_LNEG; +"COMPLEX_MUL_LZERO",COMPLEX_MUL_LZERO; +"COMPLEX_MUL_RID",COMPLEX_MUL_RID; +"COMPLEX_MUL_RINV",COMPLEX_MUL_RINV; +"COMPLEX_MUL_RNEG",COMPLEX_MUL_RNEG; +"COMPLEX_MUL_RZERO",COMPLEX_MUL_RZERO; +"COMPLEX_MUL_SYM",COMPLEX_MUL_SYM; +"COMPLEX_MVT",COMPLEX_MVT; +"COMPLEX_MVT_LINE",COMPLEX_MVT_LINE; +"COMPLEX_NEG_0",COMPLEX_NEG_0; +"COMPLEX_NEG_ADD",COMPLEX_NEG_ADD; +"COMPLEX_NEG_EQ",COMPLEX_NEG_EQ; +"COMPLEX_NEG_EQ_0",COMPLEX_NEG_EQ_0; +"COMPLEX_NEG_INV",COMPLEX_NEG_INV; +"COMPLEX_NEG_LMUL",COMPLEX_NEG_LMUL; +"COMPLEX_NEG_MINUS1",COMPLEX_NEG_MINUS1; +"COMPLEX_NEG_MUL2",COMPLEX_NEG_MUL2; +"COMPLEX_NEG_NEG",COMPLEX_NEG_NEG; +"COMPLEX_NEG_RMUL",COMPLEX_NEG_RMUL; +"COMPLEX_NEG_SUB",COMPLEX_NEG_SUB; +"COMPLEX_NORM_0",COMPLEX_NORM_0; +"COMPLEX_NORM_ABS_NORM",COMPLEX_NORM_ABS_NORM; +"COMPLEX_NORM_CNJ",COMPLEX_NORM_CNJ; +"COMPLEX_NORM_CX",COMPLEX_NORM_CX; +"COMPLEX_NORM_DIV",COMPLEX_NORM_DIV; +"COMPLEX_NORM_EQ_1_CEXP",COMPLEX_NORM_EQ_1_CEXP; +"COMPLEX_NORM_GE_RE_IM",COMPLEX_NORM_GE_RE_IM; +"COMPLEX_NORM_II",COMPLEX_NORM_II; +"COMPLEX_NORM_INV",COMPLEX_NORM_INV; +"COMPLEX_NORM_LE_RE_IM",COMPLEX_NORM_LE_RE_IM; +"COMPLEX_NORM_MUL",COMPLEX_NORM_MUL; +"COMPLEX_NORM_NUM",COMPLEX_NORM_NUM; +"COMPLEX_NORM_NZ",COMPLEX_NORM_NZ; +"COMPLEX_NORM_POW",COMPLEX_NORM_POW; +"COMPLEX_NORM_POW_2",COMPLEX_NORM_POW_2; +"COMPLEX_NORM_TRIANGLE_SUB",COMPLEX_NORM_TRIANGLE_SUB; +"COMPLEX_NORM_VSUM_BOUND",COMPLEX_NORM_VSUM_BOUND; +"COMPLEX_NORM_VSUM_BOUND_SUBSET",COMPLEX_NORM_VSUM_BOUND_SUBSET; +"COMPLEX_NORM_VSUM_SUM_RE",COMPLEX_NORM_VSUM_SUM_RE; +"COMPLEX_NORM_ZERO",COMPLEX_NORM_ZERO; +"COMPLEX_NOT_ROOT_UNITY",COMPLEX_NOT_ROOT_UNITY; +"COMPLEX_POLYFUN_EQ_0",COMPLEX_POLYFUN_EQ_0; +"COMPLEX_POLYFUN_EQ_CONST",COMPLEX_POLYFUN_EQ_CONST; +"COMPLEX_POLYFUN_EXTREMAL",COMPLEX_POLYFUN_EXTREMAL; +"COMPLEX_POLYFUN_EXTREMAL_LEMMA",COMPLEX_POLYFUN_EXTREMAL_LEMMA; +"COMPLEX_POLYFUN_FINITE_ROOTS",COMPLEX_POLYFUN_FINITE_ROOTS; +"COMPLEX_POLYFUN_LINEAR_FACTOR",COMPLEX_POLYFUN_LINEAR_FACTOR; +"COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT",COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT; +"COMPLEX_POLYFUN_ROOTBOUND",COMPLEX_POLYFUN_ROOTBOUND; +"COMPLEX_POLY_CLAUSES",COMPLEX_POLY_CLAUSES; +"COMPLEX_POLY_NEG_CLAUSES",COMPLEX_POLY_NEG_CLAUSES; +"COMPLEX_POW_1",COMPLEX_POW_1; +"COMPLEX_POW_2",COMPLEX_POW_2; +"COMPLEX_POW_ADD",COMPLEX_POW_ADD; +"COMPLEX_POW_DIV",COMPLEX_POW_DIV; +"COMPLEX_POW_EQ_0",COMPLEX_POW_EQ_0; +"COMPLEX_POW_EQ_1",COMPLEX_POW_EQ_1; +"COMPLEX_POW_II_2",COMPLEX_POW_II_2; +"COMPLEX_POW_INV",COMPLEX_POW_INV; +"COMPLEX_POW_MUL",COMPLEX_POW_MUL; +"COMPLEX_POW_NEG",COMPLEX_POW_NEG; +"COMPLEX_POW_ONE",COMPLEX_POW_ONE; +"COMPLEX_POW_POW",COMPLEX_POW_POW; +"COMPLEX_POW_ZERO",COMPLEX_POW_ZERO; +"COMPLEX_RNEG_UNIQ",COMPLEX_RNEG_UNIQ; +"COMPLEX_ROOTS_UNITY",COMPLEX_ROOTS_UNITY; +"COMPLEX_ROOT_POLYFUN",COMPLEX_ROOT_POLYFUN; +"COMPLEX_ROOT_UNITY",COMPLEX_ROOT_UNITY; +"COMPLEX_ROOT_UNITY_EQ",COMPLEX_ROOT_UNITY_EQ; +"COMPLEX_ROOT_UNITY_EQ_1",COMPLEX_ROOT_UNITY_EQ_1; +"COMPLEX_SQNORM",COMPLEX_SQNORM; +"COMPLEX_STONE_WEIERSTRASS",COMPLEX_STONE_WEIERSTRASS; +"COMPLEX_STONE_WEIERSTRASS_ALT",COMPLEX_STONE_WEIERSTRASS_ALT; +"COMPLEX_SUB_0",COMPLEX_SUB_0; +"COMPLEX_SUB_ADD",COMPLEX_SUB_ADD; +"COMPLEX_SUB_ADD2",COMPLEX_SUB_ADD2; +"COMPLEX_SUB_CCOS",COMPLEX_SUB_CCOS; +"COMPLEX_SUB_CSIN",COMPLEX_SUB_CSIN; +"COMPLEX_SUB_CTAN",COMPLEX_SUB_CTAN; +"COMPLEX_SUB_LDISTRIB",COMPLEX_SUB_LDISTRIB; +"COMPLEX_SUB_LNEG",COMPLEX_SUB_LNEG; +"COMPLEX_SUB_LZERO",COMPLEX_SUB_LZERO; +"COMPLEX_SUB_NEG2",COMPLEX_SUB_NEG2; +"COMPLEX_SUB_POLYFUN",COMPLEX_SUB_POLYFUN; +"COMPLEX_SUB_POLYFUN_ALT",COMPLEX_SUB_POLYFUN_ALT; +"COMPLEX_SUB_POW",COMPLEX_SUB_POW; +"COMPLEX_SUB_POW_L1",COMPLEX_SUB_POW_L1; +"COMPLEX_SUB_POW_R1",COMPLEX_SUB_POW_R1; +"COMPLEX_SUB_RDISTRIB",COMPLEX_SUB_RDISTRIB; +"COMPLEX_SUB_REFL",COMPLEX_SUB_REFL; +"COMPLEX_SUB_RNEG",COMPLEX_SUB_RNEG; +"COMPLEX_SUB_RZERO",COMPLEX_SUB_RZERO; +"COMPLEX_SUB_SUB",COMPLEX_SUB_SUB; +"COMPLEX_SUB_SUB2",COMPLEX_SUB_SUB2; +"COMPLEX_SUB_TRIANGLE",COMPLEX_SUB_TRIANGLE; +"COMPLEX_TAYLOR",COMPLEX_TAYLOR; +"COMPLEX_TAYLOR_MVT",COMPLEX_TAYLOR_MVT; +"COMPLEX_TRAD",COMPLEX_TRAD; +"COMPLEX_UNIMODULAR_POLAR",COMPLEX_UNIMODULAR_POLAR; +"COMPLEX_VEC_0",COMPLEX_VEC_0; +"COMPONENT",COMPONENT; +"COMPONENTS_EMPTY",COMPONENTS_EMPTY; +"COMPONENTS_EQ",COMPONENTS_EQ; +"COMPONENTS_EQ_EMPTY",COMPONENTS_EQ_EMPTY; +"COMPONENTS_EQ_SING",COMPONENTS_EQ_SING; +"COMPONENTS_EQ_SING_EXISTS",COMPONENTS_EQ_SING_EXISTS; +"COMPONENTS_INTERMEDIATE_SUBSET",COMPONENTS_INTERMEDIATE_SUBSET; +"COMPONENTS_LINEAR_IMAGE",COMPONENTS_LINEAR_IMAGE; +"COMPONENTS_MAXIMAL",COMPONENTS_MAXIMAL; +"COMPONENTS_NONOVERLAP",COMPONENTS_NONOVERLAP; +"COMPONENTS_OPEN_UNIQUE",COMPONENTS_OPEN_UNIQUE; +"COMPONENTS_TRANSLATION",COMPONENTS_TRANSLATION; +"COMPONENTS_UNIQUE",COMPONENTS_UNIQUE; +"COMPONENTS_UNIQUE_EQ",COMPONENTS_UNIQUE_EQ; +"COMPONENTS_UNIV",COMPONENTS_UNIV; +"COMPONENT_COMPLEMENT_CONNECTED",COMPONENT_COMPLEMENT_CONNECTED; +"COMPONENT_LE_INFNORM",COMPONENT_LE_INFNORM; +"COMPONENT_LE_NORM",COMPONENT_LE_NORM; +"COMPONENT_LE_ONORM",COMPONENT_LE_ONORM; +"COMPONENT_RETRACT_COMPLEMENT_MEETS",COMPONENT_RETRACT_COMPLEMENT_MEETS; +"CONDENSATION_POINTS_EQ_EMPTY",CONDENSATION_POINTS_EQ_EMPTY; +"CONDENSATION_POINT_IMP_LIMPT",CONDENSATION_POINT_IMP_LIMPT; +"CONDENSATION_POINT_INFINITE_BALL",CONDENSATION_POINT_INFINITE_BALL; +"CONDENSATION_POINT_INFINITE_CBALL",CONDENSATION_POINT_INFINITE_CBALL; +"CONDENSATION_POINT_OF_CONDENSATION_POINTS",CONDENSATION_POINT_OF_CONDENSATION_POINTS; +"CONDENSATION_POINT_OF_SUBSET",CONDENSATION_POINT_OF_SUBSET; +"COND_ABS",COND_ABS; +"COND_CLAUSES",COND_CLAUSES; +"COND_COMPONENT",COND_COMPONENT; +"COND_DEF",COND_DEF; +"COND_ELIM_THM",COND_ELIM_THM; +"COND_EXPAND",COND_EXPAND; +"COND_ID",COND_ID; +"COND_RAND",COND_RAND; +"COND_RATOR",COND_RATOR; +"CONGRUENT_IMAGE_STD_SIMPLEX",CONGRUENT_IMAGE_STD_SIMPLEX; +"CONIC_CONIC_HULL",CONIC_CONIC_HULL; +"CONIC_CONTAINS_0",CONIC_CONTAINS_0; +"CONIC_CONVEX_CONE_HULL",CONIC_CONVEX_CONE_HULL; +"CONIC_EMPTY",CONIC_EMPTY; +"CONIC_HALFSPACE_GE",CONIC_HALFSPACE_GE; +"CONIC_HALFSPACE_LE",CONIC_HALFSPACE_LE; +"CONIC_HULL_EMPTY",CONIC_HULL_EMPTY; +"CONIC_HULL_EQ",CONIC_HULL_EQ; +"CONIC_HULL_EQ_EMPTY",CONIC_HULL_EQ_EMPTY; +"CONIC_HULL_EXPLICIT",CONIC_HULL_EXPLICIT; +"CONIC_HULL_LINEAR_IMAGE",CONIC_HULL_LINEAR_IMAGE; +"CONIC_HULL_SUBSET_CONVEX_CONE_HULL",CONIC_HULL_SUBSET_CONVEX_CONE_HULL; +"CONIC_INTERS",CONIC_INTERS; +"CONIC_LINEAR_IMAGE",CONIC_LINEAR_IMAGE; +"CONIC_LINEAR_IMAGE_EQ",CONIC_LINEAR_IMAGE_EQ; +"CONIC_NEGATIONS",CONIC_NEGATIONS; +"CONIC_PCROSS",CONIC_PCROSS; +"CONIC_PCROSS_EQ",CONIC_PCROSS_EQ; +"CONIC_POSITIVE_ORTHANT",CONIC_POSITIVE_ORTHANT; +"CONIC_SPAN",CONIC_SPAN; +"CONIC_SUMS",CONIC_SUMS; +"CONIC_UNIV",CONIC_UNIV; +"CONJ_ACI",CONJ_ACI; +"CONJ_ASSOC",CONJ_ASSOC; +"CONJ_SYM",CONJ_SYM; +"CONNECTED_ANNULUS",CONNECTED_ANNULUS; +"CONNECTED_ARC_COMPLEMENT",CONNECTED_ARC_COMPLEMENT; +"CONNECTED_ARC_IMAGE",CONNECTED_ARC_IMAGE; +"CONNECTED_BALL",CONNECTED_BALL; +"CONNECTED_CARD_EQ_IFF_NONTRIVIAL",CONNECTED_CARD_EQ_IFF_NONTRIVIAL; +"CONNECTED_CBALL",CONNECTED_CBALL; +"CONNECTED_CHAIN",CONNECTED_CHAIN; +"CONNECTED_CHAIN_GEN",CONNECTED_CHAIN_GEN; +"CONNECTED_CLOPEN",CONNECTED_CLOPEN; +"CONNECTED_CLOSED",CONNECTED_CLOSED; +"CONNECTED_CLOSED_IN",CONNECTED_CLOSED_IN; +"CONNECTED_CLOSED_IN_EQ",CONNECTED_CLOSED_IN_EQ; +"CONNECTED_CLOSED_MONOTONE_PREIMAGE",CONNECTED_CLOSED_MONOTONE_PREIMAGE; +"CONNECTED_CLOSED_SET",CONNECTED_CLOSED_SET; +"CONNECTED_CLOSURE",CONNECTED_CLOSURE; +"CONNECTED_COMPACT_INTERVAL_1",CONNECTED_COMPACT_INTERVAL_1; +"CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; +"CONNECTED_COMPLEMENT_BOUNDED_CONVEX",CONNECTED_COMPLEMENT_BOUNDED_CONVEX; +"CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; +"CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS",CONNECTED_COMPLEMENT_IFF_SIMPLY_CONNECTED_COMPONENTS; +"CONNECTED_COMPONENT_1",CONNECTED_COMPONENT_1; +"CONNECTED_COMPONENT_1_GEN",CONNECTED_COMPONENT_1_GEN; +"CONNECTED_COMPONENT_DISJOINT",CONNECTED_COMPONENT_DISJOINT; +"CONNECTED_COMPONENT_EMPTY",CONNECTED_COMPONENT_EMPTY; +"CONNECTED_COMPONENT_EQ",CONNECTED_COMPONENT_EQ; +"CONNECTED_COMPONENT_EQUIVALENCE_RELATION",CONNECTED_COMPONENT_EQUIVALENCE_RELATION; +"CONNECTED_COMPONENT_EQ_EMPTY",CONNECTED_COMPONENT_EQ_EMPTY; +"CONNECTED_COMPONENT_EQ_EQ",CONNECTED_COMPONENT_EQ_EQ; +"CONNECTED_COMPONENT_EQ_SELF",CONNECTED_COMPONENT_EQ_SELF; +"CONNECTED_COMPONENT_EQ_UNIV",CONNECTED_COMPONENT_EQ_UNIV; +"CONNECTED_COMPONENT_IDEMP",CONNECTED_COMPONENT_IDEMP; +"CONNECTED_COMPONENT_IN",CONNECTED_COMPONENT_IN; +"CONNECTED_COMPONENT_INTERMEDIATE_SUBSET",CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; +"CONNECTED_COMPONENT_LINEAR_IMAGE",CONNECTED_COMPONENT_LINEAR_IMAGE; +"CONNECTED_COMPONENT_MAXIMAL",CONNECTED_COMPONENT_MAXIMAL; +"CONNECTED_COMPONENT_MONO",CONNECTED_COMPONENT_MONO; +"CONNECTED_COMPONENT_NONOVERLAP",CONNECTED_COMPONENT_NONOVERLAP; +"CONNECTED_COMPONENT_OF_SUBSET",CONNECTED_COMPONENT_OF_SUBSET; +"CONNECTED_COMPONENT_OVERLAP",CONNECTED_COMPONENT_OVERLAP; +"CONNECTED_COMPONENT_REFL",CONNECTED_COMPONENT_REFL; +"CONNECTED_COMPONENT_REFL_EQ",CONNECTED_COMPONENT_REFL_EQ; +"CONNECTED_COMPONENT_SET",CONNECTED_COMPONENT_SET; +"CONNECTED_COMPONENT_SUBSET",CONNECTED_COMPONENT_SUBSET; +"CONNECTED_COMPONENT_SYM",CONNECTED_COMPONENT_SYM; +"CONNECTED_COMPONENT_SYM_EQ",CONNECTED_COMPONENT_SYM_EQ; +"CONNECTED_COMPONENT_TRANS",CONNECTED_COMPONENT_TRANS; +"CONNECTED_COMPONENT_TRANSLATION",CONNECTED_COMPONENT_TRANSLATION; +"CONNECTED_COMPONENT_UNIONS",CONNECTED_COMPONENT_UNIONS; +"CONNECTED_COMPONENT_UNIQUE",CONNECTED_COMPONENT_UNIQUE; +"CONNECTED_COMPONENT_UNIV",CONNECTED_COMPONENT_UNIV; +"CONNECTED_CONNECTED_COMPONENT",CONNECTED_CONNECTED_COMPONENT; +"CONNECTED_CONNECTED_COMPONENT_SET",CONNECTED_CONNECTED_COMPONENT_SET; +"CONNECTED_CONTINUOUS_IMAGE",CONNECTED_CONTINUOUS_IMAGE; +"CONNECTED_CONVEX_1",CONNECTED_CONVEX_1; +"CONNECTED_CONVEX_1_GEN",CONNECTED_CONVEX_1_GEN; +"CONNECTED_CONVEX_DIFF_CARD_LT",CONNECTED_CONVEX_DIFF_CARD_LT; +"CONNECTED_CONVEX_DIFF_COUNTABLE",CONNECTED_CONVEX_DIFF_COUNTABLE; +"CONNECTED_DIFF_BALL",CONNECTED_DIFF_BALL; +"CONNECTED_DIFF_OPEN_FROM_CLOSED",CONNECTED_DIFF_OPEN_FROM_CLOSED; +"CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE",CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE; +"CONNECTED_EMPTY",CONNECTED_EMPTY; +"CONNECTED_EQUIVALENCE_RELATION",CONNECTED_EQUIVALENCE_RELATION; +"CONNECTED_EQUIVALENCE_RELATION_GEN",CONNECTED_EQUIVALENCE_RELATION_GEN; +"CONNECTED_EQ_COMPONENTS_SUBSET_SING",CONNECTED_EQ_COMPONENTS_SUBSET_SING; +"CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS",CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS; +"CONNECTED_EQ_CONNECTED_COMPONENTS_EQ",CONNECTED_EQ_CONNECTED_COMPONENTS_EQ; +"CONNECTED_EQ_CONNECTED_COMPONENT_EQ",CONNECTED_EQ_CONNECTED_COMPONENT_EQ; +"CONNECTED_FINITE_IFF_COUNTABLE",CONNECTED_FINITE_IFF_COUNTABLE; +"CONNECTED_FINITE_IFF_SING",CONNECTED_FINITE_IFF_SING; +"CONNECTED_FROM_CLOSED_UNION_AND_INTER",CONNECTED_FROM_CLOSED_UNION_AND_INTER; +"CONNECTED_FROM_OPEN_UNION_AND_INTER",CONNECTED_FROM_OPEN_UNION_AND_INTER; +"CONNECTED_FRONTIER_COMPONENT_COMPLEMENT",CONNECTED_FRONTIER_COMPONENT_COMPLEMENT; +"CONNECTED_FRONTIER_DISJOINT",CONNECTED_FRONTIER_DISJOINT; +"CONNECTED_FRONTIER_SIMPLE",CONNECTED_FRONTIER_SIMPLE; +"CONNECTED_IFF_CONNECTED_COMPONENT",CONNECTED_IFF_CONNECTED_COMPONENT; +"CONNECTED_IMP_PERFECT",CONNECTED_IMP_PERFECT; +"CONNECTED_IMP_PERFECT_AFF_DIM",CONNECTED_IMP_PERFECT_AFF_DIM; +"CONNECTED_IMP_PERFECT_CLOSED",CONNECTED_IMP_PERFECT_CLOSED; +"CONNECTED_INDUCTION",CONNECTED_INDUCTION; +"CONNECTED_INDUCTION_SIMPLE",CONNECTED_INDUCTION_SIMPLE; +"CONNECTED_INFINITE_IFF_CARD_EQ",CONNECTED_INFINITE_IFF_CARD_EQ; +"CONNECTED_INTERMEDIATE_CLOSURE",CONNECTED_INTERMEDIATE_CLOSURE; +"CONNECTED_INTERVAL",CONNECTED_INTERVAL; +"CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS",CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS; +"CONNECTED_INTER_FRONTIER",CONNECTED_INTER_FRONTIER; +"CONNECTED_INTER_RELATIVE_FRONTIER",CONNECTED_INTER_RELATIVE_FRONTIER; +"CONNECTED_IVT_COMPONENT",CONNECTED_IVT_COMPONENT; +"CONNECTED_IVT_HYPERPLANE",CONNECTED_IVT_HYPERPLANE; +"CONNECTED_LINEAR_IMAGE",CONNECTED_LINEAR_IMAGE; +"CONNECTED_LINEAR_IMAGE_EQ",CONNECTED_LINEAR_IMAGE_EQ; +"CONNECTED_MONOTONE_QUOTIENT_PREIMAGE",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE; +"CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN; +"CONNECTED_NEGATIONS",CONNECTED_NEGATIONS; +"CONNECTED_NEST",CONNECTED_NEST; +"CONNECTED_NEST_GEN",CONNECTED_NEST_GEN; +"CONNECTED_OPEN_ARC_CONNECTED",CONNECTED_OPEN_ARC_CONNECTED; +"CONNECTED_OPEN_DELETE",CONNECTED_OPEN_DELETE; +"CONNECTED_OPEN_DIFF_CARD_LT",CONNECTED_OPEN_DIFF_CARD_LT; +"CONNECTED_OPEN_DIFF_CBALL",CONNECTED_OPEN_DIFF_CBALL; +"CONNECTED_OPEN_DIFF_COUNTABLE",CONNECTED_OPEN_DIFF_COUNTABLE; +"CONNECTED_OPEN_IN",CONNECTED_OPEN_IN; +"CONNECTED_OPEN_IN_DIFF_CARD_LT",CONNECTED_OPEN_IN_DIFF_CARD_LT; +"CONNECTED_OPEN_IN_EQ",CONNECTED_OPEN_IN_EQ; +"CONNECTED_OPEN_MONOTONE_PREIMAGE",CONNECTED_OPEN_MONOTONE_PREIMAGE; +"CONNECTED_OPEN_PATH_CONNECTED",CONNECTED_OPEN_PATH_CONNECTED; +"CONNECTED_OPEN_SET",CONNECTED_OPEN_SET; +"CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED",CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED; +"CONNECTED_OUTSIDE",CONNECTED_OUTSIDE; +"CONNECTED_PATH_IMAGE",CONNECTED_PATH_IMAGE; +"CONNECTED_PCROSS",CONNECTED_PCROSS; +"CONNECTED_PCROSS_EQ",CONNECTED_PCROSS_EQ; +"CONNECTED_PUNCTURED_BALL",CONNECTED_PUNCTURED_BALL; +"CONNECTED_PUNCTURED_CONVEX",CONNECTED_PUNCTURED_CONVEX; +"CONNECTED_PUNCTURED_UNIVERSE",CONNECTED_PUNCTURED_UNIVERSE; +"CONNECTED_REAL",CONNECTED_REAL; +"CONNECTED_REAL_LEMMA",CONNECTED_REAL_LEMMA; +"CONNECTED_RETRACT_COMPLEMENT",CONNECTED_RETRACT_COMPLEMENT; +"CONNECTED_SCALING",CONNECTED_SCALING; +"CONNECTED_SEGMENT",CONNECTED_SEGMENT; +"CONNECTED_SEMIOPEN_SEGMENT",CONNECTED_SEMIOPEN_SEGMENT; +"CONNECTED_SIMPLE_PATH_ENDLESS",CONNECTED_SIMPLE_PATH_ENDLESS; +"CONNECTED_SIMPLE_PATH_IMAGE",CONNECTED_SIMPLE_PATH_IMAGE; +"CONNECTED_SING",CONNECTED_SING; +"CONNECTED_SPHERE",CONNECTED_SPHERE; +"CONNECTED_SPHERE_EQ",CONNECTED_SPHERE_EQ; +"CONNECTED_SPHERE_GEN",CONNECTED_SPHERE_GEN; +"CONNECTED_SUBSET_CLOPEN",CONNECTED_SUBSET_CLOPEN; +"CONNECTED_SUMS",CONNECTED_SUMS; +"CONNECTED_TRANSLATION",CONNECTED_TRANSLATION; +"CONNECTED_TRANSLATION_EQ",CONNECTED_TRANSLATION_EQ; +"CONNECTED_UNION",CONNECTED_UNION; +"CONNECTED_UNIONS",CONNECTED_UNIONS; +"CONNECTED_UNION_CLOPEN_IN_COMPLEMENT",CONNECTED_UNION_CLOPEN_IN_COMPLEMENT; +"CONNECTED_UNION_STRONG",CONNECTED_UNION_STRONG; +"CONNECTED_UNIV",CONNECTED_UNIV; +"CONNECTED_VALID_PATH_IMAGE",CONNECTED_VALID_PATH_IMAGE; +"CONNECTED_WITH_INSIDE",CONNECTED_WITH_INSIDE; +"CONNECTED_WITH_OUTSIDE",CONNECTED_WITH_OUTSIDE; +"CONSTR",CONSTR; +"CONSTR_BOT",CONSTR_BOT; +"CONSTR_IND",CONSTR_IND; +"CONSTR_INJ",CONSTR_INJ; +"CONSTR_REC",CONSTR_REC; +"CONS_11",CONS_11; +"CONS_HD_TL",CONS_HD_TL; +"CONTENT_0_SUBSET",CONTENT_0_SUBSET; +"CONTENT_0_SUBSET_GEN",CONTENT_0_SUBSET_GEN; +"CONTENT_1",CONTENT_1; +"CONTENT_CLOSED_INTERVAL",CONTENT_CLOSED_INTERVAL; +"CONTENT_CLOSED_INTERVAL_CASES",CONTENT_CLOSED_INTERVAL_CASES; +"CONTENT_DOUBLESPLIT",CONTENT_DOUBLESPLIT; +"CONTENT_EMPTY",CONTENT_EMPTY; +"CONTENT_EQ_0",CONTENT_EQ_0; +"CONTENT_EQ_0_1",CONTENT_EQ_0_1; +"CONTENT_EQ_0_GEN",CONTENT_EQ_0_GEN; +"CONTENT_EQ_0_INTERIOR",CONTENT_EQ_0_INTERIOR; +"CONTENT_IMAGE_AFFINITY_INTERVAL",CONTENT_IMAGE_AFFINITY_INTERVAL; +"CONTENT_IMAGE_STRETCH_INTERVAL",CONTENT_IMAGE_STRETCH_INTERVAL; +"CONTENT_LT_NZ",CONTENT_LT_NZ; +"CONTENT_PASTECART",CONTENT_PASTECART; +"CONTENT_POS_LE",CONTENT_POS_LE; +"CONTENT_POS_LT",CONTENT_POS_LT; +"CONTENT_POS_LT_1",CONTENT_POS_LT_1; +"CONTENT_POS_LT_EQ",CONTENT_POS_LT_EQ; +"CONTENT_SPLIT",CONTENT_SPLIT; +"CONTENT_SUBSET",CONTENT_SUBSET; +"CONTENT_UNIT",CONTENT_UNIT; +"CONTENT_UNIT_1",CONTENT_UNIT_1; +"CONTINUOUS_ABS",CONTINUOUS_ABS; +"CONTINUOUS_ADD",CONTINUOUS_ADD; +"CONTINUOUS_ADDITIVE_IMP_LINEAR",CONTINUOUS_ADDITIVE_IMP_LINEAR; +"CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"CONTINUOUS_AGREE_ON_CLOSURE",CONTINUOUS_AGREE_ON_CLOSURE; +"CONTINUOUS_AT",CONTINUOUS_AT; +"CONTINUOUS_ATREAL",CONTINUOUS_ATREAL; +"CONTINUOUS_ATREAL_COMPOSE",CONTINUOUS_ATREAL_COMPOSE; +"CONTINUOUS_ATREAL_SQRT_COMPOSE",CONTINUOUS_ATREAL_SQRT_COMPOSE; +"CONTINUOUS_ATREAL_WITHINREAL",CONTINUOUS_ATREAL_WITHINREAL; +"CONTINUOUS_ATTAINS_INF",CONTINUOUS_ATTAINS_INF; +"CONTINUOUS_ATTAINS_SUP",CONTINUOUS_ATTAINS_SUP; +"CONTINUOUS_AT_ARG",CONTINUOUS_AT_ARG; +"CONTINUOUS_AT_AVOID",CONTINUOUS_AT_AVOID; +"CONTINUOUS_AT_BALL",CONTINUOUS_AT_BALL; +"CONTINUOUS_AT_CACS",CONTINUOUS_AT_CACS; +"CONTINUOUS_AT_CASN",CONTINUOUS_AT_CASN; +"CONTINUOUS_AT_CATN",CONTINUOUS_AT_CATN; +"CONTINUOUS_AT_CCOS",CONTINUOUS_AT_CCOS; +"CONTINUOUS_AT_CEXP",CONTINUOUS_AT_CEXP; +"CONTINUOUS_AT_CLOG",CONTINUOUS_AT_CLOG; +"CONTINUOUS_AT_CLOSEST_POINT",CONTINUOUS_AT_CLOSEST_POINT; +"CONTINUOUS_AT_CNJ",CONTINUOUS_AT_CNJ; +"CONTINUOUS_AT_COMPOSE",CONTINUOUS_AT_COMPOSE; +"CONTINUOUS_AT_COMPOSE_EQ",CONTINUOUS_AT_COMPOSE_EQ; +"CONTINUOUS_AT_CSIN",CONTINUOUS_AT_CSIN; +"CONTINUOUS_AT_CSQRT",CONTINUOUS_AT_CSQRT; +"CONTINUOUS_AT_CTAN",CONTINUOUS_AT_CTAN; +"CONTINUOUS_AT_CX_DOT",CONTINUOUS_AT_CX_DOT; +"CONTINUOUS_AT_CX_IM",CONTINUOUS_AT_CX_IM; +"CONTINUOUS_AT_CX_NORM",CONTINUOUS_AT_CX_NORM; +"CONTINUOUS_AT_CX_RE",CONTINUOUS_AT_CX_RE; +"CONTINUOUS_AT_DIST_CLOSEST_POINT",CONTINUOUS_AT_DIST_CLOSEST_POINT; +"CONTINUOUS_AT_ID",CONTINUOUS_AT_ID; +"CONTINUOUS_AT_IMP_CONTINUOUS_ON",CONTINUOUS_AT_IMP_CONTINUOUS_ON; +"CONTINUOUS_AT_INV",CONTINUOUS_AT_INV; +"CONTINUOUS_AT_LIFT_COMPONENT",CONTINUOUS_AT_LIFT_COMPONENT; +"CONTINUOUS_AT_LIFT_DIST",CONTINUOUS_AT_LIFT_DIST; +"CONTINUOUS_AT_LIFT_DOT",CONTINUOUS_AT_LIFT_DOT; +"CONTINUOUS_AT_LIFT_INFNORM",CONTINUOUS_AT_LIFT_INFNORM; +"CONTINUOUS_AT_LIFT_NORM",CONTINUOUS_AT_LIFT_NORM; +"CONTINUOUS_AT_LIFT_RANGE",CONTINUOUS_AT_LIFT_RANGE; +"CONTINUOUS_AT_LIFT_SETDIST",CONTINUOUS_AT_LIFT_SETDIST; +"CONTINUOUS_AT_LINEAR_IMAGE",CONTINUOUS_AT_LINEAR_IMAGE; +"CONTINUOUS_AT_OPEN",CONTINUOUS_AT_OPEN; +"CONTINUOUS_AT_SEQUENTIALLY",CONTINUOUS_AT_SEQUENTIALLY; +"CONTINUOUS_AT_SQRT",CONTINUOUS_AT_SQRT; +"CONTINUOUS_AT_SQRT_COMPOSE",CONTINUOUS_AT_SQRT_COMPOSE; +"CONTINUOUS_AT_TRANSLATION",CONTINUOUS_AT_TRANSLATION; +"CONTINUOUS_AT_WINDING_NUMBER",CONTINUOUS_AT_WINDING_NUMBER; +"CONTINUOUS_AT_WITHIN",CONTINUOUS_AT_WITHIN; +"CONTINUOUS_AT_WITHIN_INV",CONTINUOUS_AT_WITHIN_INV; +"CONTINUOUS_CARD_LT_RANGE_CONSTANT",CONTINUOUS_CARD_LT_RANGE_CONSTANT; +"CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ",CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ; +"CONTINUOUS_CLOSED_GRAPH",CONTINUOUS_CLOSED_GRAPH; +"CONTINUOUS_CLOSED_GRAPH_EQ",CONTINUOUS_CLOSED_GRAPH_EQ; +"CONTINUOUS_CLOSED_GRAPH_GEN",CONTINUOUS_CLOSED_GRAPH_GEN; +"CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS",CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS; +"CONTINUOUS_CLOSED_IN_PREIMAGE",CONTINUOUS_CLOSED_IN_PREIMAGE; +"CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT; +"CONTINUOUS_CLOSED_IN_PREIMAGE_EQ",CONTINUOUS_CLOSED_IN_PREIMAGE_EQ; +"CONTINUOUS_CLOSED_IN_PREIMAGE_GEN",CONTINUOUS_CLOSED_IN_PREIMAGE_GEN; +"CONTINUOUS_CLOSED_PREIMAGE",CONTINUOUS_CLOSED_PREIMAGE; +"CONTINUOUS_CLOSED_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_PREIMAGE_CONSTANT; +"CONTINUOUS_CLOSED_PREIMAGE_UNIV",CONTINUOUS_CLOSED_PREIMAGE_UNIV; +"CONTINUOUS_CMUL",CONTINUOUS_CMUL; +"CONTINUOUS_COMPLEX_DIV",CONTINUOUS_COMPLEX_DIV; +"CONTINUOUS_COMPLEX_DIV_AT",CONTINUOUS_COMPLEX_DIV_AT; +"CONTINUOUS_COMPLEX_DIV_WITHIN",CONTINUOUS_COMPLEX_DIV_WITHIN; +"CONTINUOUS_COMPLEX_INV",CONTINUOUS_COMPLEX_INV; +"CONTINUOUS_COMPLEX_INV_AT",CONTINUOUS_COMPLEX_INV_AT; +"CONTINUOUS_COMPLEX_INV_WITHIN",CONTINUOUS_COMPLEX_INV_WITHIN; +"CONTINUOUS_COMPLEX_LMUL",CONTINUOUS_COMPLEX_LMUL; +"CONTINUOUS_COMPLEX_MUL",CONTINUOUS_COMPLEX_MUL; +"CONTINUOUS_COMPLEX_POW",CONTINUOUS_COMPLEX_POW; +"CONTINUOUS_COMPLEX_RMUL",CONTINUOUS_COMPLEX_RMUL; +"CONTINUOUS_COMPONENTWISE",CONTINUOUS_COMPONENTWISE; +"CONTINUOUS_COMPONENTWISE_LIFT",CONTINUOUS_COMPONENTWISE_LIFT; +"CONTINUOUS_CONST",CONTINUOUS_CONST; +"CONTINUOUS_CONSTANT_ON_CLOSURE",CONTINUOUS_CONSTANT_ON_CLOSURE; +"CONTINUOUS_CONTINUOUS_ATREAL",CONTINUOUS_CONTINUOUS_ATREAL; +"CONTINUOUS_CONTINUOUS_WITHINREAL",CONTINUOUS_CONTINUOUS_WITHINREAL; +"CONTINUOUS_COUNTABLE_RANGE_CONSTANT",CONTINUOUS_COUNTABLE_RANGE_CONSTANT; +"CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ",CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ; +"CONTINUOUS_CX_ATREAL",CONTINUOUS_CX_ATREAL; +"CONTINUOUS_CX_DROP",CONTINUOUS_CX_DROP; +"CONTINUOUS_CX_LIFT",CONTINUOUS_CX_LIFT; +"CONTINUOUS_CX_WITHINREAL",CONTINUOUS_CX_WITHINREAL; +"CONTINUOUS_DIAMETER",CONTINUOUS_DIAMETER; +"CONTINUOUS_DISCONNECTED_RANGE_CONSTANT",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT; +"CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; +"CONTINUOUS_DISCRETE_RANGE_CONSTANT",CONTINUOUS_DISCRETE_RANGE_CONSTANT; +"CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ",CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; +"CONTINUOUS_FINITE_RANGE_CONSTANT",CONTINUOUS_FINITE_RANGE_CONSTANT; +"CONTINUOUS_FINITE_RANGE_CONSTANT_EQ",CONTINUOUS_FINITE_RANGE_CONSTANT_EQ; +"CONTINUOUS_FROM_CLOSED_GRAPH",CONTINUOUS_FROM_CLOSED_GRAPH; +"CONTINUOUS_GE_ON_CLOSURE",CONTINUOUS_GE_ON_CLOSURE; +"CONTINUOUS_IMAGE_SUBSET_INTERIOR",CONTINUOUS_IMAGE_SUBSET_INTERIOR; +"CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR",CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR; +"CONTINUOUS_IMP_CLOSED_MAP",CONTINUOUS_IMP_CLOSED_MAP; +"CONTINUOUS_IMP_MEASURABLE_ON",CONTINUOUS_IMP_MEASURABLE_ON; +"CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET; +"CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"CONTINUOUS_IMP_QUOTIENT_MAP",CONTINUOUS_IMP_QUOTIENT_MAP; +"CONTINUOUS_IMP_REAL_MEASURABLE_ON",CONTINUOUS_IMP_REAL_MEASURABLE_ON; +"CONTINUOUS_INJECTIVE_IFF_MONOTONIC",CONTINUOUS_INJECTIVE_IFF_MONOTONIC; +"CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1; +"CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1; +"CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE",CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE; +"CONTINUOUS_INTERVAL_BIJ",CONTINUOUS_INTERVAL_BIJ; +"CONTINUOUS_INV",CONTINUOUS_INV; +"CONTINUOUS_IVT_LOCAL_EXTREMUM",CONTINUOUS_IVT_LOCAL_EXTREMUM; +"CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP; +"CONTINUOUS_LEVELSET_OPEN",CONTINUOUS_LEVELSET_OPEN; +"CONTINUOUS_LEVELSET_OPEN_IN",CONTINUOUS_LEVELSET_OPEN_IN; +"CONTINUOUS_LEVELSET_OPEN_IN_CASES",CONTINUOUS_LEVELSET_OPEN_IN_CASES; +"CONTINUOUS_LE_ON_CLOSURE",CONTINUOUS_LE_ON_CLOSURE; +"CONTINUOUS_LIFT_COMPONENT_COMPOSE",CONTINUOUS_LIFT_COMPONENT_COMPOSE; +"CONTINUOUS_LIFT_DET",CONTINUOUS_LIFT_DET; +"CONTINUOUS_LIFT_DOT2",CONTINUOUS_LIFT_DOT2; +"CONTINUOUS_LIFT_NORM_COMPOSE",CONTINUOUS_LIFT_NORM_COMPOSE; +"CONTINUOUS_LIFT_POW",CONTINUOUS_LIFT_POW; +"CONTINUOUS_LIFT_PRODUCT",CONTINUOUS_LIFT_PRODUCT; +"CONTINUOUS_LINEPATH_AT",CONTINUOUS_LINEPATH_AT; +"CONTINUOUS_LOGARITHM_ON_BALL",CONTINUOUS_LOGARITHM_ON_BALL; +"CONTINUOUS_LOGARITHM_ON_CBALL",CONTINUOUS_LOGARITHM_ON_CBALL; +"CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE",CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE; +"CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED",CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED; +"CONTINUOUS_MAX",CONTINUOUS_MAX; +"CONTINUOUS_MIDPOINT_CONVEX",CONTINUOUS_MIDPOINT_CONVEX; +"CONTINUOUS_MIN",CONTINUOUS_MIN; +"CONTINUOUS_MUL",CONTINUOUS_MUL; +"CONTINUOUS_NEG",CONTINUOUS_NEG; +"CONTINUOUS_ON",CONTINUOUS_ON; +"CONTINUOUS_ON_ABS",CONTINUOUS_ON_ABS; +"CONTINUOUS_ON_ADD",CONTINUOUS_ON_ADD; +"CONTINUOUS_ON_AVOID",CONTINUOUS_ON_AVOID; +"CONTINUOUS_ON_BORSUK_MAP",CONTINUOUS_ON_BORSUK_MAP; +"CONTINUOUS_ON_CACS",CONTINUOUS_ON_CACS; +"CONTINUOUS_ON_CACS_REAL",CONTINUOUS_ON_CACS_REAL; +"CONTINUOUS_ON_CASES",CONTINUOUS_ON_CASES; +"CONTINUOUS_ON_CASES_1",CONTINUOUS_ON_CASES_1; +"CONTINUOUS_ON_CASES_LE",CONTINUOUS_ON_CASES_LE; +"CONTINUOUS_ON_CASES_LOCAL",CONTINUOUS_ON_CASES_LOCAL; +"CONTINUOUS_ON_CASES_LOCAL_OPEN",CONTINUOUS_ON_CASES_LOCAL_OPEN; +"CONTINUOUS_ON_CASES_OPEN",CONTINUOUS_ON_CASES_OPEN; +"CONTINUOUS_ON_CASN",CONTINUOUS_ON_CASN; +"CONTINUOUS_ON_CASN_REAL",CONTINUOUS_ON_CASN_REAL; +"CONTINUOUS_ON_CATN",CONTINUOUS_ON_CATN; +"CONTINUOUS_ON_CCOS",CONTINUOUS_ON_CCOS; +"CONTINUOUS_ON_CEXP",CONTINUOUS_ON_CEXP; +"CONTINUOUS_ON_CLOG",CONTINUOUS_ON_CLOG; +"CONTINUOUS_ON_CLOSED",CONTINUOUS_ON_CLOSED; +"CONTINUOUS_ON_CLOSED_GEN",CONTINUOUS_ON_CLOSED_GEN; +"CONTINUOUS_ON_CLOSEST_POINT",CONTINUOUS_ON_CLOSEST_POINT; +"CONTINUOUS_ON_CLOSURE",CONTINUOUS_ON_CLOSURE; +"CONTINUOUS_ON_CLOSURE_COMPONENT_GE",CONTINUOUS_ON_CLOSURE_COMPONENT_GE; +"CONTINUOUS_ON_CLOSURE_COMPONENT_LE",CONTINUOUS_ON_CLOSURE_COMPONENT_LE; +"CONTINUOUS_ON_CLOSURE_NORM_LE",CONTINUOUS_ON_CLOSURE_NORM_LE; +"CONTINUOUS_ON_CLOSURE_SEQUENTIALLY",CONTINUOUS_ON_CLOSURE_SEQUENTIALLY; +"CONTINUOUS_ON_CMUL",CONTINUOUS_ON_CMUL; +"CONTINUOUS_ON_CNJ",CONTINUOUS_ON_CNJ; +"CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION",CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION; +"CONTINUOUS_ON_COMPLEX_DIV",CONTINUOUS_ON_COMPLEX_DIV; +"CONTINUOUS_ON_COMPLEX_INV",CONTINUOUS_ON_COMPLEX_INV; +"CONTINUOUS_ON_COMPLEX_LMUL",CONTINUOUS_ON_COMPLEX_LMUL; +"CONTINUOUS_ON_COMPLEX_MUL",CONTINUOUS_ON_COMPLEX_MUL; +"CONTINUOUS_ON_COMPLEX_POW",CONTINUOUS_ON_COMPLEX_POW; +"CONTINUOUS_ON_COMPLEX_RMUL",CONTINUOUS_ON_COMPLEX_RMUL; +"CONTINUOUS_ON_COMPONENTS",CONTINUOUS_ON_COMPONENTS; +"CONTINUOUS_ON_COMPONENTS_EQ",CONTINUOUS_ON_COMPONENTS_EQ; +"CONTINUOUS_ON_COMPONENTS_FINITE",CONTINUOUS_ON_COMPONENTS_FINITE; +"CONTINUOUS_ON_COMPONENTS_GEN",CONTINUOUS_ON_COMPONENTS_GEN; +"CONTINUOUS_ON_COMPONENTS_OPEN",CONTINUOUS_ON_COMPONENTS_OPEN; +"CONTINUOUS_ON_COMPONENTS_OPEN_EQ",CONTINUOUS_ON_COMPONENTS_OPEN_EQ; +"CONTINUOUS_ON_COMPONENTWISE_LIFT",CONTINUOUS_ON_COMPONENTWISE_LIFT; +"CONTINUOUS_ON_COMPOSE",CONTINUOUS_ON_COMPOSE; +"CONTINUOUS_ON_COMPOSE_ARG",CONTINUOUS_ON_COMPOSE_ARG; +"CONTINUOUS_ON_COMPOSE_QUOTIENT",CONTINUOUS_ON_COMPOSE_QUOTIENT; +"CONTINUOUS_ON_CONST",CONTINUOUS_ON_CONST; +"CONTINUOUS_ON_CONST_DYADIC_RATIONALS",CONTINUOUS_ON_CONST_DYADIC_RATIONALS; +"CONTINUOUS_ON_CSIN",CONTINUOUS_ON_CSIN; +"CONTINUOUS_ON_CSQRT",CONTINUOUS_ON_CSQRT; +"CONTINUOUS_ON_CTAN",CONTINUOUS_ON_CTAN; +"CONTINUOUS_ON_CX_DOT",CONTINUOUS_ON_CX_DOT; +"CONTINUOUS_ON_CX_DROP",CONTINUOUS_ON_CX_DROP; +"CONTINUOUS_ON_CX_IM",CONTINUOUS_ON_CX_IM; +"CONTINUOUS_ON_CX_LIFT",CONTINUOUS_ON_CX_LIFT; +"CONTINUOUS_ON_CX_NORM",CONTINUOUS_ON_CX_NORM; +"CONTINUOUS_ON_CX_RE",CONTINUOUS_ON_CX_RE; +"CONTINUOUS_ON_DIST_CLOSEST_POINT",CONTINUOUS_ON_DIST_CLOSEST_POINT; +"CONTINUOUS_ON_EMPTY",CONTINUOUS_ON_EMPTY; +"CONTINUOUS_ON_EQ",CONTINUOUS_ON_EQ; +"CONTINUOUS_ON_EQ_CONTINUOUS_AT",CONTINUOUS_ON_EQ_CONTINUOUS_AT; +"CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN",CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; +"CONTINUOUS_ON_FINITE",CONTINUOUS_ON_FINITE; +"CONTINUOUS_ON_ID",CONTINUOUS_ON_ID; +"CONTINUOUS_ON_IMP_CLOSED_IN",CONTINUOUS_ON_IMP_CLOSED_IN; +"CONTINUOUS_ON_IMP_OPEN_IN",CONTINUOUS_ON_IMP_OPEN_IN; +"CONTINUOUS_ON_INTERIOR",CONTINUOUS_ON_INTERIOR; +"CONTINUOUS_ON_INTERVAL_BIJ",CONTINUOUS_ON_INTERVAL_BIJ; +"CONTINUOUS_ON_INV",CONTINUOUS_ON_INV; +"CONTINUOUS_ON_INVERSE",CONTINUOUS_ON_INVERSE; +"CONTINUOUS_ON_INVERSE_CLOSED_MAP",CONTINUOUS_ON_INVERSE_CLOSED_MAP; +"CONTINUOUS_ON_INVERSE_INTO_1D",CONTINUOUS_ON_INVERSE_INTO_1D; +"CONTINUOUS_ON_INVERSE_OPEN",CONTINUOUS_ON_INVERSE_OPEN; +"CONTINUOUS_ON_INVERSE_OPEN_MAP",CONTINUOUS_ON_INVERSE_OPEN_MAP; +"CONTINUOUS_ON_LIFT_COMPONENT",CONTINUOUS_ON_LIFT_COMPONENT; +"CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE",CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; +"CONTINUOUS_ON_LIFT_DET",CONTINUOUS_ON_LIFT_DET; +"CONTINUOUS_ON_LIFT_DIST",CONTINUOUS_ON_LIFT_DIST; +"CONTINUOUS_ON_LIFT_DOT",CONTINUOUS_ON_LIFT_DOT; +"CONTINUOUS_ON_LIFT_DOT2",CONTINUOUS_ON_LIFT_DOT2; +"CONTINUOUS_ON_LIFT_NORM",CONTINUOUS_ON_LIFT_NORM; +"CONTINUOUS_ON_LIFT_NORM_COMPOSE",CONTINUOUS_ON_LIFT_NORM_COMPOSE; +"CONTINUOUS_ON_LIFT_POW",CONTINUOUS_ON_LIFT_POW; +"CONTINUOUS_ON_LIFT_PRODUCT",CONTINUOUS_ON_LIFT_PRODUCT; +"CONTINUOUS_ON_LIFT_RANGE",CONTINUOUS_ON_LIFT_RANGE; +"CONTINUOUS_ON_LIFT_SETDIST",CONTINUOUS_ON_LIFT_SETDIST; +"CONTINUOUS_ON_LIFT_SQRT",CONTINUOUS_ON_LIFT_SQRT; +"CONTINUOUS_ON_LIFT_SQRT_COMPOSE",CONTINUOUS_ON_LIFT_SQRT_COMPOSE; +"CONTINUOUS_ON_LINEPATH",CONTINUOUS_ON_LINEPATH; +"CONTINUOUS_ON_MAX",CONTINUOUS_ON_MAX; +"CONTINUOUS_ON_MIN",CONTINUOUS_ON_MIN; +"CONTINUOUS_ON_MUL",CONTINUOUS_ON_MUL; +"CONTINUOUS_ON_NEG",CONTINUOUS_ON_NEG; +"CONTINUOUS_ON_NO_LIMPT",CONTINUOUS_ON_NO_LIMPT; +"CONTINUOUS_ON_OPEN",CONTINUOUS_ON_OPEN; +"CONTINUOUS_ON_OPEN_AVOID",CONTINUOUS_ON_OPEN_AVOID; +"CONTINUOUS_ON_OPEN_GEN",CONTINUOUS_ON_OPEN_GEN; +"CONTINUOUS_ON_PASTECART",CONTINUOUS_ON_PASTECART; +"CONTINUOUS_ON_SEQUENTIALLY",CONTINUOUS_ON_SEQUENTIALLY; +"CONTINUOUS_ON_SING",CONTINUOUS_ON_SING; +"CONTINUOUS_ON_SUB",CONTINUOUS_ON_SUB; +"CONTINUOUS_ON_SUBSET",CONTINUOUS_ON_SUBSET; +"CONTINUOUS_ON_UNION",CONTINUOUS_ON_UNION; +"CONTINUOUS_ON_UNION_LOCAL",CONTINUOUS_ON_UNION_LOCAL; +"CONTINUOUS_ON_UNION_LOCAL_OPEN",CONTINUOUS_ON_UNION_LOCAL_OPEN; +"CONTINUOUS_ON_UNION_OPEN",CONTINUOUS_ON_UNION_OPEN; +"CONTINUOUS_ON_UPPERHALF_ARG",CONTINUOUS_ON_UPPERHALF_ARG; +"CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION",CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION; +"CONTINUOUS_ON_VMUL",CONTINUOUS_ON_VMUL; +"CONTINUOUS_ON_VSUM",CONTINUOUS_ON_VSUM; +"CONTINUOUS_ON_WINDING_NUMBER",CONTINUOUS_ON_WINDING_NUMBER; +"CONTINUOUS_OPEN_IN_PREIMAGE",CONTINUOUS_OPEN_IN_PREIMAGE; +"CONTINUOUS_OPEN_IN_PREIMAGE_EQ",CONTINUOUS_OPEN_IN_PREIMAGE_EQ; +"CONTINUOUS_OPEN_IN_PREIMAGE_GEN",CONTINUOUS_OPEN_IN_PREIMAGE_GEN; +"CONTINUOUS_OPEN_PREIMAGE",CONTINUOUS_OPEN_PREIMAGE; +"CONTINUOUS_OPEN_PREIMAGE_UNIV",CONTINUOUS_OPEN_PREIMAGE_UNIV; +"CONTINUOUS_PASTECART",CONTINUOUS_PASTECART; +"CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE; +"CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE; +"CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE; +"CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE",CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE; +"CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP; +"CONTINUOUS_SQRT_ON_CONTRACTIBLE",CONTINUOUS_SQRT_ON_CONTRACTIBLE; +"CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED",CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED; +"CONTINUOUS_SUB",CONTINUOUS_SUB; +"CONTINUOUS_TRANSFORM_AT",CONTINUOUS_TRANSFORM_AT; +"CONTINUOUS_TRANSFORM_WITHIN",CONTINUOUS_TRANSFORM_WITHIN; +"CONTINUOUS_TRANSFORM_WITHIN_OPEN",CONTINUOUS_TRANSFORM_WITHIN_OPEN; +"CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN",CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN; +"CONTINUOUS_TRIVIAL_LIMIT",CONTINUOUS_TRIVIAL_LIMIT; +"CONTINUOUS_UNIFORM_LIMIT",CONTINUOUS_UNIFORM_LIMIT; +"CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION",CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION; +"CONTINUOUS_VMUL",CONTINUOUS_VMUL; +"CONTINUOUS_VSUM",CONTINUOUS_VSUM; +"CONTINUOUS_WITHIN",CONTINUOUS_WITHIN; +"CONTINUOUS_WITHINREAL",CONTINUOUS_WITHINREAL; +"CONTINUOUS_WITHINREAL_COMPOSE",CONTINUOUS_WITHINREAL_COMPOSE; +"CONTINUOUS_WITHINREAL_SQRT_COMPOSE",CONTINUOUS_WITHINREAL_SQRT_COMPOSE; +"CONTINUOUS_WITHINREAL_SUBSET",CONTINUOUS_WITHINREAL_SUBSET; +"CONTINUOUS_WITHIN_AVOID",CONTINUOUS_WITHIN_AVOID; +"CONTINUOUS_WITHIN_BALL",CONTINUOUS_WITHIN_BALL; +"CONTINUOUS_WITHIN_CACS",CONTINUOUS_WITHIN_CACS; +"CONTINUOUS_WITHIN_CACS_REAL",CONTINUOUS_WITHIN_CACS_REAL; +"CONTINUOUS_WITHIN_CASN",CONTINUOUS_WITHIN_CASN; +"CONTINUOUS_WITHIN_CASN_REAL",CONTINUOUS_WITHIN_CASN_REAL; +"CONTINUOUS_WITHIN_CATN",CONTINUOUS_WITHIN_CATN; +"CONTINUOUS_WITHIN_CCOS",CONTINUOUS_WITHIN_CCOS; +"CONTINUOUS_WITHIN_CEXP",CONTINUOUS_WITHIN_CEXP; +"CONTINUOUS_WITHIN_CLOG",CONTINUOUS_WITHIN_CLOG; +"CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL",CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL; +"CONTINUOUS_WITHIN_CNJ",CONTINUOUS_WITHIN_CNJ; +"CONTINUOUS_WITHIN_COMPOSE",CONTINUOUS_WITHIN_COMPOSE; +"CONTINUOUS_WITHIN_CSIN",CONTINUOUS_WITHIN_CSIN; +"CONTINUOUS_WITHIN_CSQRT",CONTINUOUS_WITHIN_CSQRT; +"CONTINUOUS_WITHIN_CSQRT_POSREAL",CONTINUOUS_WITHIN_CSQRT_POSREAL; +"CONTINUOUS_WITHIN_CTAN",CONTINUOUS_WITHIN_CTAN; +"CONTINUOUS_WITHIN_CX_DOT",CONTINUOUS_WITHIN_CX_DOT; +"CONTINUOUS_WITHIN_CX_NORM",CONTINUOUS_WITHIN_CX_NORM; +"CONTINUOUS_WITHIN_ID",CONTINUOUS_WITHIN_ID; +"CONTINUOUS_WITHIN_LIFT_SQRT",CONTINUOUS_WITHIN_LIFT_SQRT; +"CONTINUOUS_WITHIN_OPEN",CONTINUOUS_WITHIN_OPEN; +"CONTINUOUS_WITHIN_SEQUENTIALLY",CONTINUOUS_WITHIN_SEQUENTIALLY; +"CONTINUOUS_WITHIN_SQRT_COMPOSE",CONTINUOUS_WITHIN_SQRT_COMPOSE; +"CONTINUOUS_WITHIN_SUBSET",CONTINUOUS_WITHIN_SUBSET; +"CONTINUOUS_WITHIN_UPPERHALF_ARG",CONTINUOUS_WITHIN_UPPERHALF_ARG; +"CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS",CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS; +"CONTRACTIBLE_EMPTY",CONTRACTIBLE_EMPTY; +"CONTRACTIBLE_EQ_SIMPLY_CONNECTED_2D",CONTRACTIBLE_EQ_SIMPLY_CONNECTED_2D; +"CONTRACTIBLE_IMP_BORSUKIAN",CONTRACTIBLE_IMP_BORSUKIAN; +"CONTRACTIBLE_IMP_CONNECTED",CONTRACTIBLE_IMP_CONNECTED; +"CONTRACTIBLE_IMP_HOLOMORPHIC_ACS",CONTRACTIBLE_IMP_HOLOMORPHIC_ACS; +"CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED",CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED; +"CONTRACTIBLE_IMP_HOLOMORPHIC_LOG",CONTRACTIBLE_IMP_HOLOMORPHIC_LOG; +"CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT",CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT; +"CONTRACTIBLE_IMP_PATH_CONNECTED",CONTRACTIBLE_IMP_PATH_CONNECTED; +"CONTRACTIBLE_IMP_SIMPLY_CONNECTED",CONTRACTIBLE_IMP_SIMPLY_CONNECTED; +"CONTRACTIBLE_IMP_UNICOHERENT",CONTRACTIBLE_IMP_UNICOHERENT; +"CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE",CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE; +"CONTRACTIBLE_PCROSS",CONTRACTIBLE_PCROSS; +"CONTRACTIBLE_PCROSS_EQ",CONTRACTIBLE_PCROSS_EQ; +"CONTRACTIBLE_PUNCTURED_SPHERE",CONTRACTIBLE_PUNCTURED_SPHERE; +"CONTRACTIBLE_SING",CONTRACTIBLE_SING; +"CONTRACTIBLE_SPHERE",CONTRACTIBLE_SPHERE; +"CONTRACTIBLE_TRANSLATION",CONTRACTIBLE_TRANSLATION; +"CONTRACTIBLE_UNIV",CONTRACTIBLE_UNIV; +"CONTRACTION_IMP_CONTINUOUS_ON",CONTRACTION_IMP_CONTINUOUS_ON; +"CONTRAPOS_THM",CONTRAPOS_THM; +"CONVERGENCE_IN_MEASURE",CONVERGENCE_IN_MEASURE; +"CONVERGENT_BOUNDED_INCREASING",CONVERGENT_BOUNDED_INCREASING; +"CONVERGENT_BOUNDED_MONOTONE",CONVERGENT_BOUNDED_MONOTONE; +"CONVERGENT_EQ_CAUCHY",CONVERGENT_EQ_CAUCHY; +"CONVERGENT_IMP_BOUNDED",CONVERGENT_IMP_BOUNDED; +"CONVERGENT_IMP_CAUCHY",CONVERGENT_IMP_CAUCHY; +"CONVEX",CONVEX; +"CONVEX_ADD",CONVEX_ADD; +"CONVEX_AFFINITY",CONVEX_AFFINITY; +"CONVEX_ALT",CONVEX_ALT; +"CONVEX_AND_AFFINE_INTER_OPEN",CONVEX_AND_AFFINE_INTER_OPEN; +"CONVEX_BALL",CONVEX_BALL; +"CONVEX_BOUNDS_LEMMA",CONVEX_BOUNDS_LEMMA; +"CONVEX_CBALL",CONVEX_CBALL; +"CONVEX_CLOSED_CONTAINS_SAME_RAY",CONVEX_CLOSED_CONTAINS_SAME_RAY; +"CONVEX_CLOSURE",CONVEX_CLOSURE; +"CONVEX_CLOSURE_INTERIOR",CONVEX_CLOSURE_INTERIOR; +"CONVEX_CLOSURE_RELATIVE_INTERIOR",CONVEX_CLOSURE_RELATIVE_INTERIOR; +"CONVEX_CMUL",CONVEX_CMUL; +"CONVEX_CONE",CONVEX_CONE; +"CONVEX_CONE_ADD",CONVEX_CONE_ADD; +"CONVEX_CONE_CONTAINS_0",CONVEX_CONE_CONTAINS_0; +"CONVEX_CONE_CONVEX_CONE_HULL",CONVEX_CONE_CONVEX_CONE_HULL; +"CONVEX_CONE_HALFSPACE_GE",CONVEX_CONE_HALFSPACE_GE; +"CONVEX_CONE_HALFSPACE_LE",CONVEX_CONE_HALFSPACE_LE; +"CONVEX_CONE_HULL_ADD",CONVEX_CONE_HULL_ADD; +"CONVEX_CONE_HULL_CONTAINS_0",CONVEX_CONE_HULL_CONTAINS_0; +"CONVEX_CONE_HULL_CONVEX_HULL",CONVEX_CONE_HULL_CONVEX_HULL; +"CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY",CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; +"CONVEX_CONE_HULL_EMPTY",CONVEX_CONE_HULL_EMPTY; +"CONVEX_CONE_HULL_LINEAR_IMAGE",CONVEX_CONE_HULL_LINEAR_IMAGE; +"CONVEX_CONE_HULL_MUL",CONVEX_CONE_HULL_MUL; +"CONVEX_CONE_HULL_NONEMPTY",CONVEX_CONE_HULL_NONEMPTY; +"CONVEX_CONE_HULL_SEPARATE",CONVEX_CONE_HULL_SEPARATE; +"CONVEX_CONE_HULL_SEPARATE_NONEMPTY",CONVEX_CONE_HULL_SEPARATE_NONEMPTY; +"CONVEX_CONE_HULL_UNION",CONVEX_CONE_HULL_UNION; +"CONVEX_CONE_INTERS",CONVEX_CONE_INTERS; +"CONVEX_CONE_LINEAR_IMAGE",CONVEX_CONE_LINEAR_IMAGE; +"CONVEX_CONE_LINEAR_IMAGE_EQ",CONVEX_CONE_LINEAR_IMAGE_EQ; +"CONVEX_CONE_MUL",CONVEX_CONE_MUL; +"CONVEX_CONE_NEGATIONS",CONVEX_CONE_NEGATIONS; +"CONVEX_CONE_NONEMPTY",CONVEX_CONE_NONEMPTY; +"CONVEX_CONE_PCROSS",CONVEX_CONE_PCROSS; +"CONVEX_CONE_PCROSS_EQ",CONVEX_CONE_PCROSS_EQ; +"CONVEX_CONE_SING",CONVEX_CONE_SING; +"CONVEX_CONE_SPAN",CONVEX_CONE_SPAN; +"CONVEX_CONE_SUMS",CONVEX_CONE_SUMS; +"CONVEX_CONIC_HULL",CONVEX_CONIC_HULL; +"CONVEX_CONNECTED",CONVEX_CONNECTED; +"CONVEX_CONNECTED_1",CONVEX_CONNECTED_1; +"CONVEX_CONNECTED_1_GEN",CONVEX_CONNECTED_1_GEN; +"CONVEX_CONNECTED_COLLINEAR",CONVEX_CONNECTED_COLLINEAR; +"CONVEX_CONTAINS_OPEN_SEGMENT",CONVEX_CONTAINS_OPEN_SEGMENT; +"CONVEX_CONTAINS_SEGMENT",CONVEX_CONTAINS_SEGMENT; +"CONVEX_CONTAINS_SEGMENT_EQ",CONVEX_CONTAINS_SEGMENT_EQ; +"CONVEX_CONTAINS_SEGMENT_IMP",CONVEX_CONTAINS_SEGMENT_IMP; +"CONVEX_CONVEX_CONE_HULL",CONVEX_CONVEX_CONE_HULL; +"CONVEX_CONVEX_HULL",CONVEX_CONVEX_HULL; +"CONVEX_DIFFERENCES",CONVEX_DIFFERENCES; +"CONVEX_DISTANCE",CONVEX_DISTANCE; +"CONVEX_EMPTY",CONVEX_EMPTY; +"CONVEX_EPIGRAPH",CONVEX_EPIGRAPH; +"CONVEX_EPIGRAPH_CONVEX",CONVEX_EPIGRAPH_CONVEX; +"CONVEX_EQ_CONNECTED_LINE_INTERSECTION",CONVEX_EQ_CONNECTED_LINE_INTERSECTION; +"CONVEX_EQ_CONVEX_LINE_INTERSECTION",CONVEX_EQ_CONVEX_LINE_INTERSECTION; +"CONVEX_EXPLICIT",CONVEX_EXPLICIT; +"CONVEX_FINITE",CONVEX_FINITE; +"CONVEX_HALFSPACE_COMPONENT_GE",CONVEX_HALFSPACE_COMPONENT_GE; +"CONVEX_HALFSPACE_COMPONENT_GT",CONVEX_HALFSPACE_COMPONENT_GT; +"CONVEX_HALFSPACE_COMPONENT_LE",CONVEX_HALFSPACE_COMPONENT_LE; +"CONVEX_HALFSPACE_COMPONENT_LT",CONVEX_HALFSPACE_COMPONENT_LT; +"CONVEX_HALFSPACE_GE",CONVEX_HALFSPACE_GE; +"CONVEX_HALFSPACE_GT",CONVEX_HALFSPACE_GT; +"CONVEX_HALFSPACE_IM_GE",CONVEX_HALFSPACE_IM_GE; +"CONVEX_HALFSPACE_IM_GT",CONVEX_HALFSPACE_IM_GT; +"CONVEX_HALFSPACE_IM_LE",CONVEX_HALFSPACE_IM_LE; +"CONVEX_HALFSPACE_IM_LT",CONVEX_HALFSPACE_IM_LT; +"CONVEX_HALFSPACE_INTERSECTION",CONVEX_HALFSPACE_INTERSECTION; +"CONVEX_HALFSPACE_LE",CONVEX_HALFSPACE_LE; +"CONVEX_HALFSPACE_LT",CONVEX_HALFSPACE_LT; +"CONVEX_HALFSPACE_RE_GE",CONVEX_HALFSPACE_RE_GE; +"CONVEX_HALFSPACE_RE_GT",CONVEX_HALFSPACE_RE_GT; +"CONVEX_HALFSPACE_RE_LE",CONVEX_HALFSPACE_RE_LE; +"CONVEX_HALFSPACE_RE_LT",CONVEX_HALFSPACE_RE_LT; +"CONVEX_HULLS_EQ",CONVEX_HULLS_EQ; +"CONVEX_HULL_2",CONVEX_HULL_2; +"CONVEX_HULL_2_ALT",CONVEX_HULL_2_ALT; +"CONVEX_HULL_3",CONVEX_HULL_3; +"CONVEX_HULL_3_ALT",CONVEX_HULL_3_ALT; +"CONVEX_HULL_AFFINITY",CONVEX_HULL_AFFINITY; +"CONVEX_HULL_CARATHEODORY",CONVEX_HULL_CARATHEODORY; +"CONVEX_HULL_CARATHEODORY_AFF_DIM",CONVEX_HULL_CARATHEODORY_AFF_DIM; +"CONVEX_HULL_EMPTY",CONVEX_HULL_EMPTY; +"CONVEX_HULL_EQ",CONVEX_HULL_EQ; +"CONVEX_HULL_EQ_EMPTY",CONVEX_HULL_EQ_EMPTY; +"CONVEX_HULL_EQ_SING",CONVEX_HULL_EQ_SING; +"CONVEX_HULL_EXCHANGE_INTER",CONVEX_HULL_EXCHANGE_INTER; +"CONVEX_HULL_EXCHANGE_UNION",CONVEX_HULL_EXCHANGE_UNION; +"CONVEX_HULL_EXPLICIT",CONVEX_HULL_EXPLICIT; +"CONVEX_HULL_FINITE",CONVEX_HULL_FINITE; +"CONVEX_HULL_FINITE_STEP",CONVEX_HULL_FINITE_STEP; +"CONVEX_HULL_INDEXED",CONVEX_HULL_INDEXED; +"CONVEX_HULL_INSERT",CONVEX_HULL_INSERT; +"CONVEX_HULL_INSERT_ALT",CONVEX_HULL_INSERT_ALT; +"CONVEX_HULL_INTER",CONVEX_HULL_INTER; +"CONVEX_HULL_INTERIOR_SUBSET",CONVEX_HULL_INTERIOR_SUBSET; +"CONVEX_HULL_INTERS",CONVEX_HULL_INTERS; +"CONVEX_HULL_LINEAR_IMAGE",CONVEX_HULL_LINEAR_IMAGE; +"CONVEX_HULL_PCROSS",CONVEX_HULL_PCROSS; +"CONVEX_HULL_SCALING",CONVEX_HULL_SCALING; +"CONVEX_HULL_SING",CONVEX_HULL_SING; +"CONVEX_HULL_SUBSET",CONVEX_HULL_SUBSET; +"CONVEX_HULL_SUBSET_AFFINE_HULL",CONVEX_HULL_SUBSET_AFFINE_HULL; +"CONVEX_HULL_SUBSET_CONVEX_CONE_HULL",CONVEX_HULL_SUBSET_CONVEX_CONE_HULL; +"CONVEX_HULL_SUBSET_SPAN",CONVEX_HULL_SUBSET_SPAN; +"CONVEX_HULL_SUMS",CONVEX_HULL_SUMS; +"CONVEX_HULL_TRANSLATION",CONVEX_HULL_TRANSLATION; +"CONVEX_HULL_UNION_EXPLICIT",CONVEX_HULL_UNION_EXPLICIT; +"CONVEX_HULL_UNION_NONEMPTY_EXPLICIT",CONVEX_HULL_UNION_NONEMPTY_EXPLICIT; +"CONVEX_HULL_UNION_UNIONS",CONVEX_HULL_UNION_UNIONS; +"CONVEX_HULL_UNIV",CONVEX_HULL_UNIV; +"CONVEX_HYPERPLANE",CONVEX_HYPERPLANE; +"CONVEX_IMP_ANR",CONVEX_IMP_ANR; +"CONVEX_IMP_AR",CONVEX_IMP_AR; +"CONVEX_IMP_BORSUKIAN",CONVEX_IMP_BORSUKIAN; +"CONVEX_IMP_CONTRACTIBLE",CONVEX_IMP_CONTRACTIBLE; +"CONVEX_IMP_LOCALLY_CONNECTED",CONVEX_IMP_LOCALLY_CONNECTED; +"CONVEX_IMP_LOCALLY_PATH_CONNECTED",CONVEX_IMP_LOCALLY_PATH_CONNECTED; +"CONVEX_IMP_PATH_CONNECTED",CONVEX_IMP_PATH_CONNECTED; +"CONVEX_IMP_SIMPLY_CONNECTED",CONVEX_IMP_SIMPLY_CONNECTED; +"CONVEX_IMP_STARLIKE",CONVEX_IMP_STARLIKE; +"CONVEX_IMP_UNICOHERENT",CONVEX_IMP_UNICOHERENT; +"CONVEX_INDEXED",CONVEX_INDEXED; +"CONVEX_INNER_APPROXIMATION",CONVEX_INNER_APPROXIMATION; +"CONVEX_INNER_POLYTOPE",CONVEX_INNER_POLYTOPE; +"CONVEX_INTER",CONVEX_INTER; +"CONVEX_INTERIOR",CONVEX_INTERIOR; +"CONVEX_INTERIOR_CLOSURE",CONVEX_INTERIOR_CLOSURE; +"CONVEX_INTERMEDIATE_BALL",CONVEX_INTERMEDIATE_BALL; +"CONVEX_INTERS",CONVEX_INTERS; +"CONVEX_INTERVAL",CONVEX_INTERVAL; +"CONVEX_LINEAR_IMAGE",CONVEX_LINEAR_IMAGE; +"CONVEX_LINEAR_IMAGE_EQ",CONVEX_LINEAR_IMAGE_EQ; +"CONVEX_LINEAR_PREIMAGE",CONVEX_LINEAR_PREIMAGE; +"CONVEX_LOCAL_GLOBAL_MINIMUM",CONVEX_LOCAL_GLOBAL_MINIMUM; +"CONVEX_LOWER",CONVEX_LOWER; +"CONVEX_LOWER_SEGMENT",CONVEX_LOWER_SEGMENT; +"CONVEX_MAX",CONVEX_MAX; +"CONVEX_NEGATIONS",CONVEX_NEGATIONS; +"CONVEX_NORM",CONVEX_NORM; +"CONVEX_ON_BOUNDED_CONTINUOUS",CONVEX_ON_BOUNDED_CONTINUOUS; +"CONVEX_ON_COMPOSE_LINEAR",CONVEX_ON_COMPOSE_LINEAR; +"CONVEX_ON_CONTINUOUS",CONVEX_ON_CONTINUOUS; +"CONVEX_ON_CONVEX_HULL_BOUND",CONVEX_ON_CONVEX_HULL_BOUND; +"CONVEX_ON_DERIVATIVES",CONVEX_ON_DERIVATIVES; +"CONVEX_ON_DERIVATIVES_IMP",CONVEX_ON_DERIVATIVES_IMP; +"CONVEX_ON_DERIVATIVE_SECANT",CONVEX_ON_DERIVATIVE_SECANT; +"CONVEX_ON_DERIVATIVE_SECANT_IMP",CONVEX_ON_DERIVATIVE_SECANT_IMP; +"CONVEX_ON_EPIGRAPH_SLICE_LE",CONVEX_ON_EPIGRAPH_SLICE_LE; +"CONVEX_ON_EPIGRAPH_SLICE_LT",CONVEX_ON_EPIGRAPH_SLICE_LT; +"CONVEX_ON_EQ",CONVEX_ON_EQ; +"CONVEX_ON_IMP_JENSEN",CONVEX_ON_IMP_JENSEN; +"CONVEX_ON_JENSEN",CONVEX_ON_JENSEN; +"CONVEX_ON_LEFT_SECANT",CONVEX_ON_LEFT_SECANT; +"CONVEX_ON_LEFT_SECANT_MUL",CONVEX_ON_LEFT_SECANT_MUL; +"CONVEX_ON_RIGHT_SECANT",CONVEX_ON_RIGHT_SECANT; +"CONVEX_ON_RIGHT_SECANT_MUL",CONVEX_ON_RIGHT_SECANT_MUL; +"CONVEX_ON_SECANT_DERIVATIVE",CONVEX_ON_SECANT_DERIVATIVE; +"CONVEX_ON_SECANT_DERIVATIVE_IMP",CONVEX_ON_SECANT_DERIVATIVE_IMP; +"CONVEX_ON_SETDIST",CONVEX_ON_SETDIST; +"CONVEX_ON_SUBSET",CONVEX_ON_SUBSET; +"CONVEX_ON_TRANSLATION",CONVEX_ON_TRANSLATION; +"CONVEX_OPEN_SEGMENT_CASES",CONVEX_OPEN_SEGMENT_CASES; +"CONVEX_OUTER_APPROXIMATION",CONVEX_OUTER_APPROXIMATION; +"CONVEX_OUTER_POLYTOPE",CONVEX_OUTER_POLYTOPE; +"CONVEX_PCROSS",CONVEX_PCROSS; +"CONVEX_PCROSS_EQ",CONVEX_PCROSS_EQ; +"CONVEX_POSITIVE_ORTHANT",CONVEX_POSITIVE_ORTHANT; +"CONVEX_REAL",CONVEX_REAL; +"CONVEX_RELATIVE_INTERIOR",CONVEX_RELATIVE_INTERIOR; +"CONVEX_RELATIVE_INTERIOR_CLOSURE",CONVEX_RELATIVE_INTERIOR_CLOSURE; +"CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE; +"CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE; +"CONVEX_SCALING",CONVEX_SCALING; +"CONVEX_SCALING_EQ",CONVEX_SCALING_EQ; +"CONVEX_SEGMENT",CONVEX_SEGMENT; +"CONVEX_SEMIOPEN_SEGMENT",CONVEX_SEMIOPEN_SEGMENT; +"CONVEX_SIMPLEX",CONVEX_SIMPLEX; +"CONVEX_SING",CONVEX_SING; +"CONVEX_SLICE",CONVEX_SLICE; +"CONVEX_SPAN",CONVEX_SPAN; +"CONVEX_STANDARD_HYPERPLANE",CONVEX_STANDARD_HYPERPLANE; +"CONVEX_SUMS",CONVEX_SUMS; +"CONVEX_TRANSLATION",CONVEX_TRANSLATION; +"CONVEX_TRANSLATION_EQ",CONVEX_TRANSLATION_EQ; +"CONVEX_UNIV",CONVEX_UNIV; +"CONVEX_VSUM",CONVEX_VSUM; +"CONVEX_VSUM_STRONG",CONVEX_VSUM_STRONG; +"COPLANAR_2",COPLANAR_2; +"COPLANAR_3",COPLANAR_3; +"COPLANAR_AFFINE_HULL_COPLANAR",COPLANAR_AFFINE_HULL_COPLANAR; +"COPLANAR_EMPTY",COPLANAR_EMPTY; +"COPLANAR_LINEAR_IMAGE",COPLANAR_LINEAR_IMAGE; +"COPLANAR_LINEAR_IMAGE_EQ",COPLANAR_LINEAR_IMAGE_EQ; +"COPLANAR_SING",COPLANAR_SING; +"COPLANAR_SMALL",COPLANAR_SMALL; +"COPLANAR_SUBSET",COPLANAR_SUBSET; +"COPLANAR_TRANSLATION",COPLANAR_TRANSLATION; +"COPLANAR_TRANSLATION_EQ",COPLANAR_TRANSLATION_EQ; +"COSMALL_APPROXIMATION",COSMALL_APPROXIMATION; +"COS_0",COS_0; +"COS_ABS",COS_ABS; +"COS_ACS",COS_ACS; +"COS_ADD",COS_ADD; +"COS_ASN",COS_ASN; +"COS_ASN_NZ",COS_ASN_NZ; +"COS_ATN",COS_ATN; +"COS_ATN_NZ",COS_ATN_NZ; +"COS_BOUND",COS_BOUND; +"COS_BOUNDS",COS_BOUNDS; +"COS_DOUBLE",COS_DOUBLE; +"COS_DOUBLE_BOUND",COS_DOUBLE_BOUND; +"COS_DOUBLE_COS",COS_DOUBLE_COS; +"COS_DOUBLE_SIN",COS_DOUBLE_SIN; +"COS_EQ",COS_EQ; +"COS_EQ_0",COS_EQ_0; +"COS_EQ_1",COS_EQ_1; +"COS_EQ_MINUS1",COS_EQ_MINUS1; +"COS_GOESNEGATIVE",COS_GOESNEGATIVE; +"COS_GOESNEGATIVE_LEMMA",COS_GOESNEGATIVE_LEMMA; +"COS_HASZERO",COS_HASZERO; +"COS_INJ_PI",COS_INJ_PI; +"COS_INTEGER_2PI",COS_INTEGER_2PI; +"COS_MONO_LE",COS_MONO_LE; +"COS_MONO_LE_EQ",COS_MONO_LE_EQ; +"COS_MONO_LT",COS_MONO_LT; +"COS_MONO_LT_EQ",COS_MONO_LT_EQ; +"COS_NEG",COS_NEG; +"COS_NONTRIVIAL",COS_NONTRIVIAL; +"COS_NPI",COS_NPI; +"COS_ONE_2PI",COS_ONE_2PI; +"COS_PERIODIC",COS_PERIODIC; +"COS_PERIODIC_PI",COS_PERIODIC_PI; +"COS_PI",COS_PI; +"COS_PI2",COS_PI2; +"COS_PI6",COS_PI6; +"COS_POS_PI",COS_POS_PI; +"COS_POS_PI2",COS_POS_PI2; +"COS_POS_PI_LE",COS_POS_PI_LE; +"COS_SIN",COS_SIN; +"COS_SUB",COS_SUB; +"COS_TAN",COS_TAN; +"COS_TREBLE_COS",COS_TREBLE_COS; +"COS_ZERO",COS_ZERO; +"COS_ZERO_PI",COS_ZERO_PI; +"COUNTABLE",COUNTABLE; +"COUNTABLE_ALT",COUNTABLE_ALT; +"COUNTABLE_ANR_COMPONENTS",COUNTABLE_ANR_COMPONENTS; +"COUNTABLE_ANR_CONNECTED_COMPONENTS",COUNTABLE_ANR_CONNECTED_COMPONENTS; +"COUNTABLE_ANR_PATH_COMPONENTS",COUNTABLE_ANR_PATH_COMPONENTS; +"COUNTABLE_AS_IMAGE",COUNTABLE_AS_IMAGE; +"COUNTABLE_AS_IMAGE_SUBSET",COUNTABLE_AS_IMAGE_SUBSET; +"COUNTABLE_AS_IMAGE_SUBSET_EQ",COUNTABLE_AS_IMAGE_SUBSET_EQ; +"COUNTABLE_AS_INJECTIVE_IMAGE",COUNTABLE_AS_INJECTIVE_IMAGE; +"COUNTABLE_CARD_MUL",COUNTABLE_CARD_MUL; +"COUNTABLE_CARD_MUL_EQ",COUNTABLE_CARD_MUL_EQ; +"COUNTABLE_CART",COUNTABLE_CART; +"COUNTABLE_CASES",COUNTABLE_CASES; +"COUNTABLE_COMPONENTS",COUNTABLE_COMPONENTS; +"COUNTABLE_CONNECTED_COMPONENTS",COUNTABLE_CONNECTED_COMPONENTS; +"COUNTABLE_CROSS",COUNTABLE_CROSS; +"COUNTABLE_DELETE",COUNTABLE_DELETE; +"COUNTABLE_DIFF_FINITE",COUNTABLE_DIFF_FINITE; +"COUNTABLE_DISJOINT_OPEN_SUBSETS",COUNTABLE_DISJOINT_OPEN_SUBSETS; +"COUNTABLE_ELEMENTARY_DIVISION",COUNTABLE_ELEMENTARY_DIVISION; +"COUNTABLE_EMPTY",COUNTABLE_EMPTY; +"COUNTABLE_EMPTY_INTERIOR",COUNTABLE_EMPTY_INTERIOR; +"COUNTABLE_ENR_COMPONENTS",COUNTABLE_ENR_COMPONENTS; +"COUNTABLE_ENR_CONNECTED_COMPONENTS",COUNTABLE_ENR_CONNECTED_COMPONENTS; +"COUNTABLE_ENR_PATH_COMPONENTS",COUNTABLE_ENR_PATH_COMPONENTS; +"COUNTABLE_FINITE_SUBSETS",COUNTABLE_FINITE_SUBSETS; +"COUNTABLE_IMAGE",COUNTABLE_IMAGE; +"COUNTABLE_IMAGE_INJ",COUNTABLE_IMAGE_INJ; +"COUNTABLE_IMAGE_INJ_EQ",COUNTABLE_IMAGE_INJ_EQ; +"COUNTABLE_IMAGE_INJ_GENERAL",COUNTABLE_IMAGE_INJ_GENERAL; +"COUNTABLE_IMP_CARD_LT_REAL",COUNTABLE_IMP_CARD_LT_REAL; +"COUNTABLE_IMP_DISCONNECTED",COUNTABLE_IMP_DISCONNECTED; +"COUNTABLE_INSERT",COUNTABLE_INSERT; +"COUNTABLE_INTEGER",COUNTABLE_INTEGER; +"COUNTABLE_INTEGER_COORDINATES",COUNTABLE_INTEGER_COORDINATES; +"COUNTABLE_INTER",COUNTABLE_INTER; +"COUNTABLE_LIST",COUNTABLE_LIST; +"COUNTABLE_LIST_GEN",COUNTABLE_LIST_GEN; +"COUNTABLE_NON_CONDENSATION_POINTS",COUNTABLE_NON_CONDENSATION_POINTS; +"COUNTABLE_OPEN_INTERVAL",COUNTABLE_OPEN_INTERVAL; +"COUNTABLE_PATH_COMPONENTS",COUNTABLE_PATH_COMPONENTS; +"COUNTABLE_PCROSS",COUNTABLE_PCROSS; +"COUNTABLE_PCROSS_EQ",COUNTABLE_PCROSS_EQ; +"COUNTABLE_PRODUCT_DEPENDENT",COUNTABLE_PRODUCT_DEPENDENT; +"COUNTABLE_RATIONAL",COUNTABLE_RATIONAL; +"COUNTABLE_RATIONAL_COORDINATES",COUNTABLE_RATIONAL_COORDINATES; +"COUNTABLE_RESTRICT",COUNTABLE_RESTRICT; +"COUNTABLE_SING",COUNTABLE_SING; +"COUNTABLE_SUBSET",COUNTABLE_SUBSET; +"COUNTABLE_SUBSET_IMAGE",COUNTABLE_SUBSET_IMAGE; +"COUNTABLE_SUBSET_NUM",COUNTABLE_SUBSET_NUM; +"COUNTABLE_UNION",COUNTABLE_UNION; +"COUNTABLE_UNIONS",COUNTABLE_UNIONS; +"COUNTABLE_UNION_IMP",COUNTABLE_UNION_IMP; +"COVERING_LEMMA",COVERING_LEMMA; +"COVERING_SPACE_CEXP_PUNCTURED_PLANE",COVERING_SPACE_CEXP_PUNCTURED_PLANE; +"COVERING_SPACE_CLOSED_MAP",COVERING_SPACE_CLOSED_MAP; +"COVERING_SPACE_COMPACT",COVERING_SPACE_COMPACT; +"COVERING_SPACE_COUNTABLE_SHEETS",COVERING_SPACE_COUNTABLE_SHEETS; +"COVERING_SPACE_FIBRE_NO_LIMPT",COVERING_SPACE_FIBRE_NO_LIMPT; +"COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE",COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE; +"COVERING_SPACE_FINITE_SHEETS",COVERING_SPACE_FINITE_SHEETS; +"COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP; +"COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG; +"COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP; +"COVERING_SPACE_HOMEOMORPHISM",COVERING_SPACE_HOMEOMORPHISM; +"COVERING_SPACE_IMP_CONTINUOUS",COVERING_SPACE_IMP_CONTINUOUS; +"COVERING_SPACE_IMP_SURJECTIVE",COVERING_SPACE_IMP_SURJECTIVE; +"COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP",COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP; +"COVERING_SPACE_INJECTIVE",COVERING_SPACE_INJECTIVE; +"COVERING_SPACE_LIFT",COVERING_SPACE_LIFT; +"COVERING_SPACE_LIFT_GENERAL",COVERING_SPACE_LIFT_GENERAL; +"COVERING_SPACE_LIFT_HOLOMORPHIC",COVERING_SPACE_LIFT_HOLOMORPHIC; +"COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION",COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION; +"COVERING_SPACE_LIFT_HOMOTOPIC_PATH",COVERING_SPACE_LIFT_HOMOTOPIC_PATH; +"COVERING_SPACE_LIFT_HOMOTOPIC_PATHS",COVERING_SPACE_LIFT_HOMOTOPIC_PATHS; +"COVERING_SPACE_LIFT_HOMOTOPY",COVERING_SPACE_LIFT_HOMOTOPY; +"COVERING_SPACE_LIFT_HOMOTOPY_ALT",COVERING_SPACE_LIFT_HOMOTOPY_ALT; +"COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION",COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION; +"COVERING_SPACE_LIFT_IS_HOLOMORPHIC",COVERING_SPACE_LIFT_IS_HOLOMORPHIC; +"COVERING_SPACE_LIFT_PATH",COVERING_SPACE_LIFT_PATH; +"COVERING_SPACE_LIFT_PATH_STRONG",COVERING_SPACE_LIFT_PATH_STRONG; +"COVERING_SPACE_LIFT_STRONG",COVERING_SPACE_LIFT_STRONG; +"COVERING_SPACE_LIFT_STRONGER",COVERING_SPACE_LIFT_STRONGER; +"COVERING_SPACE_LIFT_UNIQUE",COVERING_SPACE_LIFT_UNIQUE; +"COVERING_SPACE_LIFT_UNIQUE_GEN",COVERING_SPACE_LIFT_UNIQUE_GEN; +"COVERING_SPACE_LIFT_UNIQUE_IDENTITY",COVERING_SPACE_LIFT_UNIQUE_IDENTITY; +"COVERING_SPACE_LOCALLY",COVERING_SPACE_LOCALLY; +"COVERING_SPACE_LOCALLY_COMPACT",COVERING_SPACE_LOCALLY_COMPACT; +"COVERING_SPACE_LOCALLY_COMPACT_EQ",COVERING_SPACE_LOCALLY_COMPACT_EQ; +"COVERING_SPACE_LOCALLY_CONNECTED",COVERING_SPACE_LOCALLY_CONNECTED; +"COVERING_SPACE_LOCALLY_CONNECTED_EQ",COVERING_SPACE_LOCALLY_CONNECTED_EQ; +"COVERING_SPACE_LOCALLY_EQ",COVERING_SPACE_LOCALLY_EQ; +"COVERING_SPACE_LOCALLY_PATH_CONNECTED",COVERING_SPACE_LOCALLY_PATH_CONNECTED; +"COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ",COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ; +"COVERING_SPACE_LOCAL_HOMEOMORPHISM",COVERING_SPACE_LOCAL_HOMEOMORPHISM; +"COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT",COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT; +"COVERING_SPACE_MONODROMY",COVERING_SPACE_MONODROMY; +"COVERING_SPACE_OPEN_MAP",COVERING_SPACE_OPEN_MAP; +"COVERING_SPACE_POW_PUNCTURED_PLANE",COVERING_SPACE_POW_PUNCTURED_PLANE; +"COVERING_SPACE_QUOTIENT_MAP",COVERING_SPACE_QUOTIENT_MAP; +"COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP",COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP; +"COVERING_SPACE_SQUARE_PUNCTURED_PLANE",COVERING_SPACE_SQUARE_PUNCTURED_PLANE; +"CPOW_0",CPOW_0; +"CPOW_1",CPOW_1; +"CPOW_ADD",CPOW_ADD; +"CPOW_EQ_0",CPOW_EQ_0; +"CPOW_MUL_REAL",CPOW_MUL_REAL; +"CPOW_N",CPOW_N; +"CPOW_NEG",CPOW_NEG; +"CPOW_REAL_REAL",CPOW_REAL_REAL; +"CPOW_SUB",CPOW_SUB; +"CPOW_SUC",CPOW_SUC; +"CPRODUCT_1",CPRODUCT_1; +"CPRODUCT_CLAUSES",CPRODUCT_CLAUSES; +"CPRODUCT_CLAUSES_LEFT",CPRODUCT_CLAUSES_LEFT; +"CPRODUCT_CLAUSES_NUMSEG",CPRODUCT_CLAUSES_NUMSEG; +"CPRODUCT_CLAUSES_RIGHT",CPRODUCT_CLAUSES_RIGHT; +"CPRODUCT_CONST",CPRODUCT_CONST; +"CPRODUCT_CONST_NUMSEG",CPRODUCT_CONST_NUMSEG; +"CPRODUCT_EQ",CPRODUCT_EQ; +"CPRODUCT_EQ_0",CPRODUCT_EQ_0; +"CPRODUCT_EQ_1",CPRODUCT_EQ_1; +"CPRODUCT_IMAGE",CPRODUCT_IMAGE; +"CPRODUCT_INV",CPRODUCT_INV; +"CPRODUCT_MUL",CPRODUCT_MUL; +"CPRODUCT_OFFSET",CPRODUCT_OFFSET; +"CPRODUCT_PAIR",CPRODUCT_PAIR; +"CPRODUCT_POW",CPRODUCT_POW; +"CPRODUCT_SING",CPRODUCT_SING; +"CRAMER",CRAMER; +"CRAMER_LEMMA",CRAMER_LEMMA; +"CRAMER_LEMMA_TRANSP",CRAMER_LEMMA_TRANSP; +"CRAMER_MATRIX_LEFT",CRAMER_MATRIX_LEFT; +"CRAMER_MATRIX_LEFT_INVERSE",CRAMER_MATRIX_LEFT_INVERSE; +"CRAMER_MATRIX_RIGHT",CRAMER_MATRIX_RIGHT; +"CRAMER_MATRIX_RIGHT_INVERSE",CRAMER_MATRIX_RIGHT_INVERSE; +"CROSS",CROSS; +"CROSS_EQ_EMPTY",CROSS_EQ_EMPTY; +"CSIN_0",CSIN_0; +"CSIN_ADD",CSIN_ADD; +"CSIN_CACS",CSIN_CACS; +"CSIN_CACS_NZ",CSIN_CACS_NZ; +"CSIN_CASN",CSIN_CASN; +"CSIN_CCOS_CSQRT",CSIN_CCOS_CSQRT; +"CSIN_CIRCLE",CSIN_CIRCLE; +"CSIN_CONVERGES",CSIN_CONVERGES; +"CSIN_DOUBLE",CSIN_DOUBLE; +"CSIN_EQ",CSIN_EQ; +"CSIN_EQ_0",CSIN_EQ_0; +"CSIN_EQ_1",CSIN_EQ_1; +"CSIN_EQ_MINUS1",CSIN_EQ_MINUS1; +"CSIN_NEG",CSIN_NEG; +"CSIN_SUB",CSIN_SUB; +"CSQRT",CSQRT; +"CSQRT_0",CSQRT_0; +"CSQRT_1",CSQRT_1; +"CSQRT_CEXP_CLOG",CSQRT_CEXP_CLOG; +"CSQRT_CX",CSQRT_CX; +"CSQRT_EQ_0",CSQRT_EQ_0; +"CSQRT_PRINCIPAL",CSQRT_PRINCIPAL; +"CSQRT_UNIQUE",CSQRT_UNIQUE; +"CTAN_0",CTAN_0; +"CTAN_ADD",CTAN_ADD; +"CTAN_CATN",CTAN_CATN; +"CTAN_DOUBLE",CTAN_DOUBLE; +"CTAN_NEG",CTAN_NEG; +"CTAN_SUB",CTAN_SUB; +"CURRY_DEF",CURRY_DEF; +"CX_2PII_NZ",CX_2PII_NZ; +"CX_ABS",CX_ABS; +"CX_ACS",CX_ACS; +"CX_ADD",CX_ADD; +"CX_ASN",CX_ASN; +"CX_ATN",CX_ATN; +"CX_COS",CX_COS; +"CX_COSH",CX_COSH; +"CX_DEF",CX_DEF; +"CX_DIV",CX_DIV; +"CX_EXP",CX_EXP; +"CX_IM_CNJ",CX_IM_CNJ; +"CX_INJ",CX_INJ; +"CX_INV",CX_INV; +"CX_LOG",CX_LOG; +"CX_MUL",CX_MUL; +"CX_NEG",CX_NEG; +"CX_PI_NZ",CX_PI_NZ; +"CX_POW",CX_POW; +"CX_PRODUCT",CX_PRODUCT; +"CX_RE_CNJ",CX_RE_CNJ; +"CX_SIN",CX_SIN; +"CX_SINH",CX_SINH; +"CX_SQRT",CX_SQRT; +"CX_SUB",CX_SUB; +"CX_TAN",CX_TAN; +"DECIMAL",DECIMAL; +"DECOMPOSITION",DECOMPOSITION; +"DECREASING_BOUNDED_VARIATION",DECREASING_BOUNDED_VARIATION; +"DECREASING_CLOSED_NEST",DECREASING_CLOSED_NEST; +"DECREASING_CLOSED_NEST_SING",DECREASING_CLOSED_NEST_SING; +"DECREASING_LEFT_LIMIT",DECREASING_LEFT_LIMIT; +"DECREASING_LEFT_LIMIT_1",DECREASING_LEFT_LIMIT_1; +"DECREASING_RIGHT_LIMIT",DECREASING_RIGHT_LIMIT; +"DECREASING_RIGHT_LIMIT_1",DECREASING_RIGHT_LIMIT_1; +"DECREASING_VECTOR_VARIATION",DECREASING_VECTOR_VARIATION; +"DEFORMATION_RETRACT",DEFORMATION_RETRACT; +"DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT",DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT; +"DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING",DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING; +"DELETE",DELETE; +"DELETE_COMM",DELETE_COMM; +"DELETE_DELETE",DELETE_DELETE; +"DELETE_INSERT",DELETE_INSERT; +"DELETE_INTER",DELETE_INTER; +"DELETE_NON_ELEMENT",DELETE_NON_ELEMENT; +"DELETE_SUBSET",DELETE_SUBSET; +"DEMOIVRE",DEMOIVRE; +"DENSE_ACCESSIBLE_FRONTIER_POINTS",DENSE_ACCESSIBLE_FRONTIER_POINTS; +"DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED",DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED; +"DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS",DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS; +"DEPENDENT_2",DEPENDENT_2; +"DEPENDENT_3",DEPENDENT_3; +"DEPENDENT_AFFINE_DEPENDENT_CASES",DEPENDENT_AFFINE_DEPENDENT_CASES; +"DEPENDENT_BIGGERSET",DEPENDENT_BIGGERSET; +"DEPENDENT_BIGGERSET_GENERAL",DEPENDENT_BIGGERSET_GENERAL; +"DEPENDENT_CHOICE",DEPENDENT_CHOICE; +"DEPENDENT_CHOICE_FIXED",DEPENDENT_CHOICE_FIXED; +"DEPENDENT_EXPLICIT",DEPENDENT_EXPLICIT; +"DEPENDENT_FINITE",DEPENDENT_FINITE; +"DEPENDENT_IMP_AFFINE_DEPENDENT",DEPENDENT_IMP_AFFINE_DEPENDENT; +"DEPENDENT_LINEAR_IMAGE",DEPENDENT_LINEAR_IMAGE; +"DEPENDENT_LINEAR_IMAGE_EQ",DEPENDENT_LINEAR_IMAGE_EQ; +"DEPENDENT_MONO",DEPENDENT_MONO; +"DEPENDENT_SING",DEPENDENT_SING; +"DEST_MK_MULTIVECTOR",DEST_MK_MULTIVECTOR; +"DEST_REC_INJ",DEST_REC_INJ; +"DET_0",DET_0; +"DET_1",DET_1; +"DET_2",DET_2; +"DET_3",DET_3; +"DET_4",DET_4; +"DET_CMUL",DET_CMUL; +"DET_COFACTOR",DET_COFACTOR; +"DET_COFACTOR_EXPANSION",DET_COFACTOR_EXPANSION; +"DET_DEPENDENT_COLUMNS",DET_DEPENDENT_COLUMNS; +"DET_DEPENDENT_ROWS",DET_DEPENDENT_ROWS; +"DET_DIAGONAL",DET_DIAGONAL; +"DET_EQ_0",DET_EQ_0; +"DET_EQ_0_RANK",DET_EQ_0_RANK; +"DET_I",DET_I; +"DET_IDENTICAL_COLUMNS",DET_IDENTICAL_COLUMNS; +"DET_IDENTICAL_ROWS",DET_IDENTICAL_ROWS; +"DET_LINEAR_ROWS_VSUM",DET_LINEAR_ROWS_VSUM; +"DET_LINEAR_ROWS_VSUM_LEMMA",DET_LINEAR_ROWS_VSUM_LEMMA; +"DET_LINEAR_ROW_VSUM",DET_LINEAR_ROW_VSUM; +"DET_LOWERTRIANGULAR",DET_LOWERTRIANGULAR; +"DET_MATRIX_EQ_0",DET_MATRIX_EQ_0; +"DET_MATRIX_EQ_0_LEFT",DET_MATRIX_EQ_0_LEFT; +"DET_MATRIX_EQ_0_RIGHT",DET_MATRIX_EQ_0_RIGHT; +"DET_MATRIX_REFLECT_ALONG",DET_MATRIX_REFLECT_ALONG; +"DET_MATRIX_ROTATE2D",DET_MATRIX_ROTATE2D; +"DET_MUL",DET_MUL; +"DET_NEG",DET_NEG; +"DET_OPEN_MAP",DET_OPEN_MAP; +"DET_ORTHOGONAL_MATRIX",DET_ORTHOGONAL_MATRIX; +"DET_PERMUTE_COLUMNS",DET_PERMUTE_COLUMNS; +"DET_PERMUTE_ROWS",DET_PERMUTE_ROWS; +"DET_ROWS_MUL",DET_ROWS_MUL; +"DET_ROW_ADD",DET_ROW_ADD; +"DET_ROW_MUL",DET_ROW_MUL; +"DET_ROW_OPERATION",DET_ROW_OPERATION; +"DET_ROW_SPAN",DET_ROW_SPAN; +"DET_TRANSP",DET_TRANSP; +"DET_UPPERTRIANGULAR",DET_UPPERTRIANGULAR; +"DET_ZERO_COLUMN",DET_ZERO_COLUMN; +"DET_ZERO_ROW",DET_ZERO_ROW; +"DE_MORGAN_THM",DE_MORGAN_THM; +"DIAMETER_ATTAINED_FRONTIER",DIAMETER_ATTAINED_FRONTIER; +"DIAMETER_ATTAINED_RELATIVE_FRONTIER",DIAMETER_ATTAINED_RELATIVE_FRONTIER; +"DIAMETER_BALL",DIAMETER_BALL; +"DIAMETER_BOUNDED",DIAMETER_BOUNDED; +"DIAMETER_BOUNDED_BOUND",DIAMETER_BOUNDED_BOUND; +"DIAMETER_BOUNDED_BOUND_LT",DIAMETER_BOUNDED_BOUND_LT; +"DIAMETER_CBALL",DIAMETER_CBALL; +"DIAMETER_CLOSURE",DIAMETER_CLOSURE; +"DIAMETER_COMPACT_ATTAINED",DIAMETER_COMPACT_ATTAINED; +"DIAMETER_CONVEX_HULL",DIAMETER_CONVEX_HULL; +"DIAMETER_EMPTY",DIAMETER_EMPTY; +"DIAMETER_EQ_0",DIAMETER_EQ_0; +"DIAMETER_FRONTIER",DIAMETER_FRONTIER; +"DIAMETER_INTERVAL",DIAMETER_INTERVAL; +"DIAMETER_LE",DIAMETER_LE; +"DIAMETER_LINEAR_IMAGE",DIAMETER_LINEAR_IMAGE; +"DIAMETER_POS_LE",DIAMETER_POS_LE; +"DIAMETER_RELATIVE_FRONTIER",DIAMETER_RELATIVE_FRONTIER; +"DIAMETER_SIMPLEX",DIAMETER_SIMPLEX; +"DIAMETER_SING",DIAMETER_SING; +"DIAMETER_SPHERE",DIAMETER_SPHERE; +"DIAMETER_SUBSET",DIAMETER_SUBSET; +"DIAMETER_SUBSET_CBALL",DIAMETER_SUBSET_CBALL; +"DIAMETER_SUBSET_CBALL_NONEMPTY",DIAMETER_SUBSET_CBALL_NONEMPTY; +"DIAMETER_SUMS",DIAMETER_SUMS; +"DIAMETER_TRANSLATION",DIAMETER_TRANSLATION; +"DIFF",DIFF; +"DIFFERENTIABLE_ADD",DIFFERENTIABLE_ADD; +"DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON",DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; +"DIFFERENTIABLE_AT_LIFT_DOT2",DIFFERENTIABLE_AT_LIFT_DOT2; +"DIFFERENTIABLE_AT_WITHIN",DIFFERENTIABLE_AT_WITHIN; +"DIFFERENTIABLE_BOUND",DIFFERENTIABLE_BOUND; +"DIFFERENTIABLE_CHAIN_AT",DIFFERENTIABLE_CHAIN_AT; +"DIFFERENTIABLE_CHAIN_WITHIN",DIFFERENTIABLE_CHAIN_WITHIN; +"DIFFERENTIABLE_CMUL",DIFFERENTIABLE_CMUL; +"DIFFERENTIABLE_COMPONENTWISE_AT",DIFFERENTIABLE_COMPONENTWISE_AT; +"DIFFERENTIABLE_COMPONENTWISE_WITHIN",DIFFERENTIABLE_COMPONENTWISE_WITHIN; +"DIFFERENTIABLE_CONST",DIFFERENTIABLE_CONST; +"DIFFERENTIABLE_ID",DIFFERENTIABLE_ID; +"DIFFERENTIABLE_IMP_CONTINUOUS_AT",DIFFERENTIABLE_IMP_CONTINUOUS_AT; +"DIFFERENTIABLE_IMP_CONTINUOUS_ON",DIFFERENTIABLE_IMP_CONTINUOUS_ON; +"DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN",DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; +"DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE",DIFFERENTIABLE_IMP_PIECEWISE_DIFFERENTIABLE; +"DIFFERENTIABLE_LIFT_COMPONENT",DIFFERENTIABLE_LIFT_COMPONENT; +"DIFFERENTIABLE_LINEAR",DIFFERENTIABLE_LINEAR; +"DIFFERENTIABLE_MUL_AT",DIFFERENTIABLE_MUL_AT; +"DIFFERENTIABLE_MUL_WITHIN",DIFFERENTIABLE_MUL_WITHIN; +"DIFFERENTIABLE_NEG",DIFFERENTIABLE_NEG; +"DIFFERENTIABLE_NORM_AT",DIFFERENTIABLE_NORM_AT; +"DIFFERENTIABLE_ON_ADD",DIFFERENTIABLE_ON_ADD; +"DIFFERENTIABLE_ON_COMPOSE",DIFFERENTIABLE_ON_COMPOSE; +"DIFFERENTIABLE_ON_CONST",DIFFERENTIABLE_ON_CONST; +"DIFFERENTIABLE_ON_EMPTY",DIFFERENTIABLE_ON_EMPTY; +"DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT",DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; +"DIFFERENTIABLE_ON_ID",DIFFERENTIABLE_ON_ID; +"DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE",DIFFERENTIABLE_ON_IMP_PIECEWISE_DIFFERENTIABLE; +"DIFFERENTIABLE_ON_LIFT_DOT2",DIFFERENTIABLE_ON_LIFT_DOT2; +"DIFFERENTIABLE_ON_LINEAR",DIFFERENTIABLE_ON_LINEAR; +"DIFFERENTIABLE_ON_MUL",DIFFERENTIABLE_ON_MUL; +"DIFFERENTIABLE_ON_NEG",DIFFERENTIABLE_ON_NEG; +"DIFFERENTIABLE_ON_NORM",DIFFERENTIABLE_ON_NORM; +"DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION",DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION; +"DIFFERENTIABLE_ON_SQNORM",DIFFERENTIABLE_ON_SQNORM; +"DIFFERENTIABLE_ON_SUB",DIFFERENTIABLE_ON_SUB; +"DIFFERENTIABLE_ON_SUBSET",DIFFERENTIABLE_ON_SUBSET; +"DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION",DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; +"DIFFERENTIABLE_REAL_COMPLEX",DIFFERENTIABLE_REAL_COMPLEX; +"DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT",DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT; +"DIFFERENTIABLE_SQNORM_AT",DIFFERENTIABLE_SQNORM_AT; +"DIFFERENTIABLE_SUB",DIFFERENTIABLE_SUB; +"DIFFERENTIABLE_TRANSFORM_AT",DIFFERENTIABLE_TRANSFORM_AT; +"DIFFERENTIABLE_TRANSFORM_WITHIN",DIFFERENTIABLE_TRANSFORM_WITHIN; +"DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION",DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION; +"DIFFERENTIABLE_VSUM",DIFFERENTIABLE_VSUM; +"DIFFERENTIABLE_VSUM_NUMSEG",DIFFERENTIABLE_VSUM_NUMSEG; +"DIFFERENTIABLE_WITHIN_LIFT_DOT2",DIFFERENTIABLE_WITHIN_LIFT_DOT2; +"DIFFERENTIABLE_WITHIN_OPEN",DIFFERENTIABLE_WITHIN_OPEN; +"DIFFERENTIABLE_WITHIN_SUBSET",DIFFERENTIABLE_WITHIN_SUBSET; +"DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM",DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM; +"DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM",DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM; +"DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN",DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN; +"DIFFERENTIAL_ZERO_MAXMIN",DIFFERENTIAL_ZERO_MAXMIN; +"DIFFERENTIAL_ZERO_MAXMIN_COMPONENT",DIFFERENTIAL_ZERO_MAXMIN_COMPONENT; +"DIFFERENT_NORM_3_COLLINEAR_POINTS",DIFFERENT_NORM_3_COLLINEAR_POINTS; +"DIFFS_AFFINE_HULL_SPAN",DIFFS_AFFINE_HULL_SPAN; +"DIFF_CHAIN_AT",DIFF_CHAIN_AT; +"DIFF_CHAIN_WITHIN",DIFF_CHAIN_WITHIN; +"DIFF_CLOSURE_SUBSET",DIFF_CLOSURE_SUBSET; +"DIFF_DIFF",DIFF_DIFF; +"DIFF_EMPTY",DIFF_EMPTY; +"DIFF_EQ_EMPTY",DIFF_EQ_EMPTY; +"DIFF_INSERT",DIFF_INSERT; +"DIFF_INTERS",DIFF_INTERS; +"DIFF_UNIONS",DIFF_UNIONS; +"DIFF_UNIONS_NONEMPTY",DIFF_UNIONS_NONEMPTY; +"DIFF_UNIV",DIFF_UNIV; +"DIMINDEX_1",DIMINDEX_1; +"DIMINDEX_2",DIMINDEX_2; +"DIMINDEX_3",DIMINDEX_3; +"DIMINDEX_4",DIMINDEX_4; +"DIMINDEX_FINITE_IMAGE",DIMINDEX_FINITE_IMAGE; +"DIMINDEX_FINITE_SUM",DIMINDEX_FINITE_SUM; +"DIMINDEX_GE_1",DIMINDEX_GE_1; +"DIMINDEX_HAS_SIZE_FINITE_SUM",DIMINDEX_HAS_SIZE_FINITE_SUM; +"DIMINDEX_MULTIVECTOR",DIMINDEX_MULTIVECTOR; +"DIMINDEX_NONZERO",DIMINDEX_NONZERO; +"DIMINDEX_UNIQUE",DIMINDEX_UNIQUE; +"DIMINDEX_UNIV",DIMINDEX_UNIV; +"DIM_CLOSURE",DIM_CLOSURE; +"DIM_EMPTY",DIM_EMPTY; +"DIM_EQ_0",DIM_EQ_0; +"DIM_EQ_CARD",DIM_EQ_CARD; +"DIM_EQ_FULL",DIM_EQ_FULL; +"DIM_EQ_HYPERPLANE",DIM_EQ_HYPERPLANE; +"DIM_EQ_SPAN",DIM_EQ_SPAN; +"DIM_HYPERPLANE",DIM_HYPERPLANE; +"DIM_IMAGE_KERNEL",DIM_IMAGE_KERNEL; +"DIM_IMAGE_KERNEL_GEN",DIM_IMAGE_KERNEL_GEN; +"DIM_INJECTIVE_LINEAR_IMAGE",DIM_INJECTIVE_LINEAR_IMAGE; +"DIM_INSERT",DIM_INSERT; +"DIM_INSERT_0",DIM_INSERT_0; +"DIM_KERNEL_COMPOSE",DIM_KERNEL_COMPOSE; +"DIM_LE_CARD",DIM_LE_CARD; +"DIM_LINEAR_IMAGE_LE",DIM_LINEAR_IMAGE_LE; +"DIM_OPEN",DIM_OPEN; +"DIM_OPEN_IN",DIM_OPEN_IN; +"DIM_ORTHOGONAL_SUM",DIM_ORTHOGONAL_SUM; +"DIM_PCROSS",DIM_PCROSS; +"DIM_PCROSS_STRONG",DIM_PCROSS_STRONG; +"DIM_PSUBSET",DIM_PSUBSET; +"DIM_ROWS_LE_DIM_COLUMNS",DIM_ROWS_LE_DIM_COLUMNS; +"DIM_SING",DIM_SING; +"DIM_SPAN",DIM_SPAN; +"DIM_SPECIAL_HYPERPLANE",DIM_SPECIAL_HYPERPLANE; +"DIM_SPECIAL_SUBSPACE",DIM_SPECIAL_SUBSPACE; +"DIM_SUBSET",DIM_SUBSET; +"DIM_SUBSET_UNIV",DIM_SUBSET_UNIV; +"DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS",DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS; +"DIM_SUBSTANDARD",DIM_SUBSTANDARD; +"DIM_SUMS_INTER",DIM_SUMS_INTER; +"DIM_UNIQUE",DIM_UNIQUE; +"DIM_UNIV",DIM_UNIV; +"DINI",DINI; +"DISCRETE_BOUNDED_IMP_FINITE",DISCRETE_BOUNDED_IMP_FINITE; +"DISCRETE_IMP_CLOSED",DISCRETE_IMP_CLOSED; +"DISCRETE_IMP_COUNTABLE",DISCRETE_IMP_COUNTABLE; +"DISJOINT",DISJOINT; +"DISJOINT_AFFINE_HULL",DISJOINT_AFFINE_HULL; +"DISJOINT_DELETE_SYM",DISJOINT_DELETE_SYM; +"DISJOINT_EMPTY",DISJOINT_EMPTY; +"DISJOINT_EMPTY_REFL",DISJOINT_EMPTY_REFL; +"DISJOINT_INSERT",DISJOINT_INSERT; +"DISJOINT_INTERVAL",DISJOINT_INTERVAL; +"DISJOINT_INTERVAL_1",DISJOINT_INTERVAL_1; +"DISJOINT_NUMSEG",DISJOINT_NUMSEG; +"DISJOINT_SYM",DISJOINT_SYM; +"DISJOINT_UNION",DISJOINT_UNION; +"DISJ_ACI",DISJ_ACI; +"DISJ_ASSOC",DISJ_ASSOC; +"DISJ_SYM",DISJ_SYM; +"DISTANCE_ATTAINS_INF",DISTANCE_ATTAINS_INF; +"DISTANCE_ATTAINS_SUP",DISTANCE_ATTAINS_SUP; +"DIST_0",DIST_0; +"DIST_ADD2",DIST_ADD2; +"DIST_ADD2_REV",DIST_ADD2_REV; +"DIST_ADDBOUND",DIST_ADDBOUND; +"DIST_CEXP_II_1",DIST_CEXP_II_1; +"DIST_CLOSEST_POINT_LIPSCHITZ",DIST_CLOSEST_POINT_LIPSCHITZ; +"DIST_CX",DIST_CX; +"DIST_DECREASES_CLOSED_SEGMENT",DIST_DECREASES_CLOSED_SEGMENT; +"DIST_DECREASES_OPEN_SEGMENT",DIST_DECREASES_OPEN_SEGMENT; +"DIST_ELIM_THM",DIST_ELIM_THM; +"DIST_EQ",DIST_EQ; +"DIST_EQ_0",DIST_EQ_0; +"DIST_FSTCART",DIST_FSTCART; +"DIST_INCREASES_ONLINE",DIST_INCREASES_ONLINE; +"DIST_IN_CLOSED_SEGMENT",DIST_IN_CLOSED_SEGMENT; +"DIST_IN_OPEN_SEGMENT",DIST_IN_OPEN_SEGMENT; +"DIST_LADD",DIST_LADD; +"DIST_LADD_0",DIST_LADD_0; +"DIST_LE_0",DIST_LE_0; +"DIST_LE_CASES",DIST_LE_CASES; +"DIST_LIFT",DIST_LIFT; +"DIST_LMUL",DIST_LMUL; +"DIST_LZERO",DIST_LZERO; +"DIST_MIDPOINT",DIST_MIDPOINT; +"DIST_MUL",DIST_MUL; +"DIST_NZ",DIST_NZ; +"DIST_PASTECART_CANCEL",DIST_PASTECART_CANCEL; +"DIST_POS_LE",DIST_POS_LE; +"DIST_POS_LT",DIST_POS_LT; +"DIST_RADD",DIST_RADD; +"DIST_RADD_0",DIST_RADD_0; +"DIST_REAL",DIST_REAL; +"DIST_REFL",DIST_REFL; +"DIST_RMUL",DIST_RMUL; +"DIST_RZERO",DIST_RZERO; +"DIST_SNDCART",DIST_SNDCART; +"DIST_SYM",DIST_SYM; +"DIST_TRIANGLE",DIST_TRIANGLE; +"DIST_TRIANGLES_LE",DIST_TRIANGLES_LE; +"DIST_TRIANGLE_ADD",DIST_TRIANGLE_ADD; +"DIST_TRIANGLE_ADD_HALF",DIST_TRIANGLE_ADD_HALF; +"DIST_TRIANGLE_ALT",DIST_TRIANGLE_ALT; +"DIST_TRIANGLE_EQ",DIST_TRIANGLE_EQ; +"DIST_TRIANGLE_HALF_L",DIST_TRIANGLE_HALF_L; +"DIST_TRIANGLE_HALF_R",DIST_TRIANGLE_HALF_R; +"DIST_TRIANGLE_LE",DIST_TRIANGLE_LE; +"DIST_TRIANGLE_LT",DIST_TRIANGLE_LT; +"DIVIDES_LE",DIVIDES_LE; +"DIVISION",DIVISION; +"DIVISION_0",DIVISION_0; +"DIVISION_COMMON_POINT_BOUND",DIVISION_COMMON_POINT_BOUND; +"DIVISION_CONTAINS",DIVISION_CONTAINS; +"DIVISION_DISJOINT_UNION",DIVISION_DISJOINT_UNION; +"DIVISION_DOUBLESPLIT",DIVISION_DOUBLESPLIT; +"DIVISION_INTER",DIVISION_INTER; +"DIVISION_INTER_1",DIVISION_INTER_1; +"DIVISION_OF",DIVISION_OF; +"DIVISION_OF_AFFINITY",DIVISION_OF_AFFINITY; +"DIVISION_OF_CLOSED",DIVISION_OF_CLOSED; +"DIVISION_OF_CONTENT_0",DIVISION_OF_CONTENT_0; +"DIVISION_OF_FINITE",DIVISION_OF_FINITE; +"DIVISION_OF_NONTRIVIAL",DIVISION_OF_NONTRIVIAL; +"DIVISION_OF_REFLECT",DIVISION_OF_REFLECT; +"DIVISION_OF_SELF",DIVISION_OF_SELF; +"DIVISION_OF_SING",DIVISION_OF_SING; +"DIVISION_OF_SUBSET",DIVISION_OF_SUBSET; +"DIVISION_OF_TAGGED_DIVISION",DIVISION_OF_TAGGED_DIVISION; +"DIVISION_OF_TRANSLATION",DIVISION_OF_TRANSLATION; +"DIVISION_OF_TRIVIAL",DIVISION_OF_TRIVIAL; +"DIVISION_OF_UNIONS",DIVISION_OF_UNIONS; +"DIVISION_OF_UNION_SELF",DIVISION_OF_UNION_SELF; +"DIVISION_POINTS_FINITE",DIVISION_POINTS_FINITE; +"DIVISION_POINTS_PSUBSET",DIVISION_POINTS_PSUBSET; +"DIVISION_POINTS_SUBSET",DIVISION_POINTS_SUBSET; +"DIVISION_SIMP",DIVISION_SIMP; +"DIVISION_SPLIT",DIVISION_SPLIT; +"DIVISION_SPLIT_LEFT_INJ",DIVISION_SPLIT_LEFT_INJ; +"DIVISION_SPLIT_RIGHT_INJ",DIVISION_SPLIT_RIGHT_INJ; +"DIVISION_UNION_INTERVALS_EXISTS",DIVISION_UNION_INTERVALS_EXISTS; +"DIVMOD_ELIM_THM",DIVMOD_ELIM_THM; +"DIVMOD_ELIM_THM'",DIVMOD_ELIM_THM'; +"DIVMOD_EXIST",DIVMOD_EXIST; +"DIVMOD_EXIST_0",DIVMOD_EXIST_0; +"DIVMOD_UNIQ",DIVMOD_UNIQ; +"DIVMOD_UNIQ_LEMMA",DIVMOD_UNIQ_LEMMA; +"DIV_0",DIV_0; +"DIV_1",DIV_1; +"DIV_ADD_MOD",DIV_ADD_MOD; +"DIV_DIV",DIV_DIV; +"DIV_EQ_0",DIV_EQ_0; +"DIV_EQ_EXCLUSION",DIV_EQ_EXCLUSION; +"DIV_LE",DIV_LE; +"DIV_LE_EXCLUSION",DIV_LE_EXCLUSION; +"DIV_LT",DIV_LT; +"DIV_MOD",DIV_MOD; +"DIV_MONO",DIV_MONO; +"DIV_MONO2",DIV_MONO2; +"DIV_MONO_LT",DIV_MONO_LT; +"DIV_MULT",DIV_MULT; +"DIV_MULT2",DIV_MULT2; +"DIV_MULT_ADD",DIV_MULT_ADD; +"DIV_MUL_LE",DIV_MUL_LE; +"DIV_REFL",DIV_REFL; +"DIV_UNIQ",DIV_UNIQ; +"DOMINATED_CONVERGENCE",DOMINATED_CONVERGENCE; +"DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE",DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE; +"DOMINATED_CONVERGENCE_AE",DOMINATED_CONVERGENCE_AE; +"DOMINATED_CONVERGENCE_INTEGRABLE",DOMINATED_CONVERGENCE_INTEGRABLE; +"DOT_1",DOT_1; +"DOT_2",DOT_2; +"DOT_3",DOT_3; +"DOT_4",DOT_4; +"DOT_BASIS",DOT_BASIS; +"DOT_BASIS_BASIS",DOT_BASIS_BASIS; +"DOT_BASIS_BASIS_UNEQUAL",DOT_BASIS_BASIS_UNEQUAL; +"DOT_CAUCHY_SCHWARZ_EQUAL",DOT_CAUCHY_SCHWARZ_EQUAL; +"DOT_DROPOUT",DOT_DROPOUT; +"DOT_EQ_0",DOT_EQ_0; +"DOT_LADD",DOT_LADD; +"DOT_LMUL",DOT_LMUL; +"DOT_LMUL_MATRIX",DOT_LMUL_MATRIX; +"DOT_LNEG",DOT_LNEG; +"DOT_LSUB",DOT_LSUB; +"DOT_LSUM",DOT_LSUM; +"DOT_LZERO",DOT_LZERO; +"DOT_MATRIX_PRODUCT",DOT_MATRIX_PRODUCT; +"DOT_MATRIX_VECTOR_MUL",DOT_MATRIX_VECTOR_MUL; +"DOT_NORM",DOT_NORM; +"DOT_NORM_NEG",DOT_NORM_NEG; +"DOT_NORM_SUB",DOT_NORM_SUB; +"DOT_PASTECART",DOT_PASTECART; +"DOT_POS_LE",DOT_POS_LE; +"DOT_POS_LT",DOT_POS_LT; +"DOT_PUSHIN",DOT_PUSHIN; +"DOT_RADD",DOT_RADD; +"DOT_RMUL",DOT_RMUL; +"DOT_RNEG",DOT_RNEG; +"DOT_ROWVECTOR_COLUMNVECTOR",DOT_ROWVECTOR_COLUMNVECTOR; +"DOT_RSUB",DOT_RSUB; +"DOT_RSUM",DOT_RSUM; +"DOT_RZERO",DOT_RZERO; +"DOT_SQUARE_NORM",DOT_SQUARE_NORM; +"DOT_SYM",DOT_SYM; +"DROPOUT_0",DROPOUT_0; +"DROPOUT_ADD",DROPOUT_ADD; +"DROPOUT_EQ",DROPOUT_EQ; +"DROPOUT_GALOIS",DROPOUT_GALOIS; +"DROPOUT_MUL",DROPOUT_MUL; +"DROPOUT_PUSHIN",DROPOUT_PUSHIN; +"DROPOUT_SUB",DROPOUT_SUB; +"DROP_ADD",DROP_ADD; +"DROP_CMUL",DROP_CMUL; +"DROP_DIFFERENTIAL_NEG_AT_MAXIMUM",DROP_DIFFERENTIAL_NEG_AT_MAXIMUM; +"DROP_DIFFERENTIAL_POS_AT_MINIMUM",DROP_DIFFERENTIAL_POS_AT_MINIMUM; +"DROP_EQ",DROP_EQ; +"DROP_EQ_0",DROP_EQ_0; +"DROP_INDICATOR",DROP_INDICATOR; +"DROP_INDICATOR_ABS_LE_1",DROP_INDICATOR_ABS_LE_1; +"DROP_INDICATOR_LE_1",DROP_INDICATOR_LE_1; +"DROP_INDICATOR_POS_LE",DROP_INDICATOR_POS_LE; +"DROP_IN_IMAGE_DROP",DROP_IN_IMAGE_DROP; +"DROP_LAMBDA",DROP_LAMBDA; +"DROP_NEG",DROP_NEG; +"DROP_SUB",DROP_SUB; +"DROP_VEC",DROP_VEC; +"DROP_VSUM",DROP_VSUM; +"DROP_WLOG_LE",DROP_WLOG_LE; +"DSUM_BOUND",DSUM_BOUND; +"DUGUNDJI",DUGUNDJI; +"EDELSTEIN_FIX",EDELSTEIN_FIX; +"EDGE_OF_IMP_SUBSET",EDGE_OF_IMP_SUBSET; +"EDGE_OF_LINEAR_IMAGE",EDGE_OF_LINEAR_IMAGE; +"EDGE_OF_TRANSLATION_EQ",EDGE_OF_TRANSLATION_EQ; +"EGOROV",EGOROV; +"EL",EL; +"ELEMENTARY_BOUNDED",ELEMENTARY_BOUNDED; +"ELEMENTARY_COMPACT",ELEMENTARY_COMPACT; +"ELEMENTARY_EMPTY",ELEMENTARY_EMPTY; +"ELEMENTARY_INTER",ELEMENTARY_INTER; +"ELEMENTARY_INTERS",ELEMENTARY_INTERS; +"ELEMENTARY_INTERVAL",ELEMENTARY_INTERVAL; +"ELEMENTARY_SUBSET_INTERVAL",ELEMENTARY_SUBSET_INTERVAL; +"ELEMENTARY_UNION",ELEMENTARY_UNION; +"ELEMENTARY_UNIONS_INTERVALS",ELEMENTARY_UNIONS_INTERVALS; +"ELEMENTARY_UNION_INTERVAL",ELEMENTARY_UNION_INTERVAL; +"ELEMENTARY_UNION_INTERVAL_STRONG",ELEMENTARY_UNION_INTERVAL_STRONG; +"EL_APPEND",EL_APPEND; +"EL_CONS",EL_CONS; +"EL_MAP",EL_MAP; +"EL_TL",EL_TL; +"EMPTY",EMPTY; +"EMPTY_AS_INTERVAL",EMPTY_AS_INTERVAL; +"EMPTY_AS_REAL_INTERVAL",EMPTY_AS_REAL_INTERVAL; +"EMPTY_DELETE",EMPTY_DELETE; +"EMPTY_DIFF",EMPTY_DIFF; +"EMPTY_DIVISION_OF",EMPTY_DIVISION_OF; +"EMPTY_EXPOSED_FACE_OF",EMPTY_EXPOSED_FACE_OF; +"EMPTY_FACE_OF",EMPTY_FACE_OF; +"EMPTY_GSPEC",EMPTY_GSPEC; +"EMPTY_INTERIOR_AFFINE_HULL",EMPTY_INTERIOR_AFFINE_HULL; +"EMPTY_INTERIOR_CONVEX_HULL",EMPTY_INTERIOR_CONVEX_HULL; +"EMPTY_INTERIOR_FINITE",EMPTY_INTERIOR_FINITE; +"EMPTY_INTERIOR_LOWDIM",EMPTY_INTERIOR_LOWDIM; +"EMPTY_INTERIOR_SUBSET_HYPERPLANE",EMPTY_INTERIOR_SUBSET_HYPERPLANE; +"EMPTY_NOT_UNIV",EMPTY_NOT_UNIV; +"EMPTY_SUBSET",EMPTY_SUBSET; +"EMPTY_UNION",EMPTY_UNION; +"EMPTY_UNIONS",EMPTY_UNIONS; +"ENDPOINTS_SHIFTPATH",ENDPOINTS_SHIFTPATH; +"ENDS_IN_INTERVAL",ENDS_IN_INTERVAL; +"ENDS_IN_REAL_INTERVAL",ENDS_IN_REAL_INTERVAL; +"ENDS_IN_REAL_SEGMENT",ENDS_IN_REAL_SEGMENT; +"ENDS_IN_SEGMENT",ENDS_IN_SEGMENT; +"ENDS_IN_UNIT_INTERVAL",ENDS_IN_UNIT_INTERVAL; +"ENDS_NOT_IN_SEGMENT",ENDS_NOT_IN_SEGMENT; +"ENR",ENR; +"ENR_ANR",ENR_ANR; +"ENR_BALL",ENR_BALL; +"ENR_BOUNDED",ENR_BOUNDED; +"ENR_CBALL",ENR_CBALL; +"ENR_CLOSED_UNION",ENR_CLOSED_UNION; +"ENR_CLOSED_UNION_LOCAL",ENR_CLOSED_UNION_LOCAL; +"ENR_COMPONENT_ENR",ENR_COMPONENT_ENR; +"ENR_CONNECTED_COMPONENT_ENR",ENR_CONNECTED_COMPONENT_ENR; +"ENR_CONVEX_CLOSED",ENR_CONVEX_CLOSED; +"ENR_DELETE",ENR_DELETE; +"ENR_EMPTY",ENR_EMPTY; +"ENR_FINITE_UNIONS_CONVEX_CLOSED",ENR_FINITE_UNIONS_CONVEX_CLOSED; +"ENR_FROM_UNION_AND_INTER",ENR_FROM_UNION_AND_INTER; +"ENR_FROM_UNION_AND_INTER_GEN",ENR_FROM_UNION_AND_INTER_GEN; +"ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; +"ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; +"ENR_IMP_ANR",ENR_IMP_ANR; +"ENR_IMP_LOCALLY_COMPACT",ENR_IMP_LOCALLY_COMPACT; +"ENR_IMP_LOCALLY_CONNECTED",ENR_IMP_LOCALLY_CONNECTED; +"ENR_IMP_LOCALLY_PATH_CONNECTED",ENR_IMP_LOCALLY_PATH_CONNECTED; +"ENR_INSERT",ENR_INSERT; +"ENR_INTERIOR",ENR_INTERIOR; +"ENR_INTERVAL",ENR_INTERVAL; +"ENR_LINEAR_IMAGE_EQ",ENR_LINEAR_IMAGE_EQ; +"ENR_NEIGHBORHOOD_RETRACT",ENR_NEIGHBORHOOD_RETRACT; +"ENR_OPEN_IN",ENR_OPEN_IN; +"ENR_PATH_COMPONENT_ENR",ENR_PATH_COMPONENT_ENR; +"ENR_PATH_IMAGE_SIMPLE_PATH",ENR_PATH_IMAGE_SIMPLE_PATH; +"ENR_PCROSS",ENR_PCROSS; +"ENR_PCROSS_EQ",ENR_PCROSS_EQ; +"ENR_RELATIVE_FRONTIER_CONVEX",ENR_RELATIVE_FRONTIER_CONVEX; +"ENR_RELATIVE_INTERIOR",ENR_RELATIVE_INTERIOR; +"ENR_RETRACT_OF_ENR",ENR_RETRACT_OF_ENR; +"ENR_SIMPLICIAL_COMPLEX",ENR_SIMPLICIAL_COMPLEX; +"ENR_SING",ENR_SING; +"ENR_SPHERE",ENR_SPHERE; +"ENR_TRANSLATION",ENR_TRANSLATION; +"ENR_TRIANGULATION",ENR_TRIANGULATION; +"ENR_UNIV",ENR_UNIV; +"EPSILON_DELTA_MINIMAL",EPSILON_DELTA_MINIMAL; +"EQUIINTEGRABLE_ADD",EQUIINTEGRABLE_ADD; +"EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS; +"EQUIINTEGRABLE_CMUL",EQUIINTEGRABLE_CMUL; +"EQUIINTEGRABLE_DIVISION",EQUIINTEGRABLE_DIVISION; +"EQUIINTEGRABLE_EQ",EQUIINTEGRABLE_EQ; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT; +"EQUIINTEGRABLE_LIMIT",EQUIINTEGRABLE_LIMIT; +"EQUIINTEGRABLE_NEG",EQUIINTEGRABLE_NEG; +"EQUIINTEGRABLE_ON_NULL",EQUIINTEGRABLE_ON_NULL; +"EQUIINTEGRABLE_ON_SING",EQUIINTEGRABLE_ON_SING; +"EQUIINTEGRABLE_ON_SPLIT",EQUIINTEGRABLE_ON_SPLIT; +"EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS; +"EQUIINTEGRABLE_REFLECT",EQUIINTEGRABLE_REFLECT; +"EQUIINTEGRABLE_SUB",EQUIINTEGRABLE_SUB; +"EQUIINTEGRABLE_SUBSET",EQUIINTEGRABLE_SUBSET; +"EQUIINTEGRABLE_SUM",EQUIINTEGRABLE_SUM; +"EQUIINTEGRABLE_UNIFORM_LIMIT",EQUIINTEGRABLE_UNIFORM_LIMIT; +"EQUIINTEGRABLE_UNION",EQUIINTEGRABLE_UNION; +"EQ_ADD_LCANCEL",EQ_ADD_LCANCEL; +"EQ_ADD_LCANCEL_0",EQ_ADD_LCANCEL_0; +"EQ_ADD_RCANCEL",EQ_ADD_RCANCEL; +"EQ_ADD_RCANCEL_0",EQ_ADD_RCANCEL_0; +"EQ_BALLS",EQ_BALLS; +"EQ_C",EQ_C; +"EQ_CLAUSES",EQ_CLAUSES; +"EQ_C_BIJECTIONS",EQ_C_BIJECTIONS; +"EQ_EXP",EQ_EXP; +"EQ_EXT",EQ_EXT; +"EQ_IMP",EQ_IMP; +"EQ_IMP_LE",EQ_IMP_LE; +"EQ_INTERVAL",EQ_INTERVAL; +"EQ_INTERVAL_1",EQ_INTERVAL_1; +"EQ_MULT_LCANCEL",EQ_MULT_LCANCEL; +"EQ_MULT_RCANCEL",EQ_MULT_RCANCEL; +"EQ_REFL",EQ_REFL; +"EQ_SPAN_INSERT_EQ",EQ_SPAN_INSERT_EQ; +"EQ_SUMS_LCANCEL",EQ_SUMS_LCANCEL; +"EQ_SUMS_RCANCEL",EQ_SUMS_RCANCEL; +"EQ_SYM",EQ_SYM; +"EQ_SYM_EQ",EQ_SYM_EQ; +"EQ_TRANS",EQ_TRANS; +"EQ_UNIV",EQ_UNIV; +"ETA_AX",ETA_AX; +"EUCLIDEAN_SPACE_INFINITE",EUCLIDEAN_SPACE_INFINITE; +"EULER",EULER; +"EULER_ROTATION_THEOREM",EULER_ROTATION_THEOREM; +"EULER_ROTOINVERSION_THEOREM",EULER_ROTOINVERSION_THEOREM; +"EVEN",EVEN; +"EVENPERM_COMPOSE",EVENPERM_COMPOSE; +"EVENPERM_I",EVENPERM_I; +"EVENPERM_INVERSE",EVENPERM_INVERSE; +"EVENPERM_SWAP",EVENPERM_SWAP; +"EVENPERM_UNIQUE",EVENPERM_UNIQUE; +"EVENTUALLY_AND",EVENTUALLY_AND; +"EVENTUALLY_AT",EVENTUALLY_AT; +"EVENTUALLY_ATREAL",EVENTUALLY_ATREAL; +"EVENTUALLY_AT_INFINITY",EVENTUALLY_AT_INFINITY; +"EVENTUALLY_AT_INFINITY_POS",EVENTUALLY_AT_INFINITY_POS; +"EVENTUALLY_AT_NEGINFINITY",EVENTUALLY_AT_NEGINFINITY; +"EVENTUALLY_AT_POSINFINITY",EVENTUALLY_AT_POSINFINITY; +"EVENTUALLY_FALSE",EVENTUALLY_FALSE; +"EVENTUALLY_FORALL",EVENTUALLY_FORALL; +"EVENTUALLY_HAPPENS",EVENTUALLY_HAPPENS; +"EVENTUALLY_MONO",EVENTUALLY_MONO; +"EVENTUALLY_MP",EVENTUALLY_MP; +"EVENTUALLY_SEQUENTIALLY",EVENTUALLY_SEQUENTIALLY; +"EVENTUALLY_TRUE",EVENTUALLY_TRUE; +"EVENTUALLY_WITHIN",EVENTUALLY_WITHIN; +"EVENTUALLY_WITHINREAL",EVENTUALLY_WITHINREAL; +"EVENTUALLY_WITHINREAL_LE",EVENTUALLY_WITHINREAL_LE; +"EVENTUALLY_WITHIN_INTERIOR",EVENTUALLY_WITHIN_INTERIOR; +"EVENTUALLY_WITHIN_LE",EVENTUALLY_WITHIN_LE; +"EVEN_ADD",EVEN_ADD; +"EVEN_AND_ODD",EVEN_AND_ODD; +"EVEN_DOUBLE",EVEN_DOUBLE; +"EVEN_EXISTS",EVEN_EXISTS; +"EVEN_EXISTS_LEMMA",EVEN_EXISTS_LEMMA; +"EVEN_EXP",EVEN_EXP; +"EVEN_MOD",EVEN_MOD; +"EVEN_MULT",EVEN_MULT; +"EVEN_NSUM",EVEN_NSUM; +"EVEN_ODD_DECOMPOSITION",EVEN_ODD_DECOMPOSITION; +"EVEN_OR_ODD",EVEN_OR_ODD; +"EVEN_SUB",EVEN_SUB; +"EX",EX; +"EXCHANGE_LEMMA",EXCHANGE_LEMMA; +"EXCLUDED_MIDDLE",EXCLUDED_MIDDLE; +"EXISTS_ARC_PSUBSET_SIMPLE_PATH",EXISTS_ARC_PSUBSET_SIMPLE_PATH; +"EXISTS_BOOL_THM",EXISTS_BOOL_THM; +"EXISTS_CNJ",EXISTS_CNJ; +"EXISTS_COMPLEX",EXISTS_COMPLEX; +"EXISTS_COMPLEX'",EXISTS_COMPLEX'; +"EXISTS_COMPLEX_ROOT",EXISTS_COMPLEX_ROOT; +"EXISTS_COMPONENT_SUPERSET",EXISTS_COMPONENT_SUPERSET; +"EXISTS_COUNTABLE_SUBSET_IMAGE",EXISTS_COUNTABLE_SUBSET_IMAGE; +"EXISTS_CURRY",EXISTS_CURRY; +"EXISTS_DEF",EXISTS_DEF; +"EXISTS_DIFF",EXISTS_DIFF; +"EXISTS_DOUBLE_ARC",EXISTS_DOUBLE_ARC; +"EXISTS_DROP",EXISTS_DROP; +"EXISTS_DROP_FUN",EXISTS_DROP_FUN; +"EXISTS_DROP_IMAGE",EXISTS_DROP_IMAGE; +"EXISTS_EX",EXISTS_EX; +"EXISTS_FINITE_SUBSET_IMAGE",EXISTS_FINITE_SUBSET_IMAGE; +"EXISTS_IN_CLAUSES",EXISTS_IN_CLAUSES; +"EXISTS_IN_GSPEC",EXISTS_IN_GSPEC; +"EXISTS_IN_IMAGE",EXISTS_IN_IMAGE; +"EXISTS_IN_INSERT",EXISTS_IN_INSERT; +"EXISTS_IN_PCROSS",EXISTS_IN_PCROSS; +"EXISTS_IN_UNION",EXISTS_IN_UNION; +"EXISTS_IN_UNIONS",EXISTS_IN_UNIONS; +"EXISTS_LIFT",EXISTS_LIFT; +"EXISTS_LIFT_FUN",EXISTS_LIFT_FUN; +"EXISTS_LIFT_IMAGE",EXISTS_LIFT_IMAGE; +"EXISTS_NOT_THM",EXISTS_NOT_THM; +"EXISTS_ONE_REP",EXISTS_ONE_REP; +"EXISTS_OPTION",EXISTS_OPTION; +"EXISTS_OR_THM",EXISTS_OR_THM; +"EXISTS_PAIRED_THM",EXISTS_PAIRED_THM; +"EXISTS_PAIR_THM",EXISTS_PAIR_THM; +"EXISTS_PASTECART",EXISTS_PASTECART; +"EXISTS_PATH_SUBPATH_TO_FRONTIER",EXISTS_PATH_SUBPATH_TO_FRONTIER; +"EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED",EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED; +"EXISTS_REAL",EXISTS_REAL; +"EXISTS_REFL",EXISTS_REFL; +"EXISTS_SIMP",EXISTS_SIMP; +"EXISTS_SUBARC_OF_ARC_NOENDS",EXISTS_SUBARC_OF_ARC_NOENDS; +"EXISTS_SUBPATH_OF_ARC_NOENDS",EXISTS_SUBPATH_OF_ARC_NOENDS; +"EXISTS_SUBPATH_OF_PATH",EXISTS_SUBPATH_OF_PATH; +"EXISTS_SUBSET_IMAGE",EXISTS_SUBSET_IMAGE; +"EXISTS_SUBSET_UNION",EXISTS_SUBSET_UNION; +"EXISTS_SUM_THM",EXISTS_SUM_THM; +"EXISTS_SWAP",EXISTS_SWAP; +"EXISTS_THM",EXISTS_THM; +"EXISTS_TRIPLED_THM",EXISTS_TRIPLED_THM; +"EXISTS_UNCURRY",EXISTS_UNCURRY; +"EXISTS_UNIQUE",EXISTS_UNIQUE; +"EXISTS_UNIQUE_ALT",EXISTS_UNIQUE_ALT; +"EXISTS_UNIQUE_DEF",EXISTS_UNIQUE_DEF; +"EXISTS_UNIQUE_REFL",EXISTS_UNIQUE_REFL; +"EXISTS_UNIQUE_THM",EXISTS_UNIQUE_THM; +"EXISTS_UNPAIR_THM",EXISTS_UNPAIR_THM; +"EXISTS_VECTOR_1",EXISTS_VECTOR_1; +"EXISTS_VECTOR_2",EXISTS_VECTOR_2; +"EXISTS_VECTOR_3",EXISTS_VECTOR_3; +"EXISTS_VECTOR_4",EXISTS_VECTOR_4; +"EXP",EXP; +"EXPAND_CLOSED_OPEN_INTERVAL",EXPAND_CLOSED_OPEN_INTERVAL; +"EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL; +"EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL; +"EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL; +"EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL; +"EXPOSED_FACE_OF",EXPOSED_FACE_OF; +"EXPOSED_FACE_OF_INTER",EXPOSED_FACE_OF_INTER; +"EXPOSED_FACE_OF_INTERS",EXPOSED_FACE_OF_INTERS; +"EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"EXPOSED_FACE_OF_LINEAR_IMAGE",EXPOSED_FACE_OF_LINEAR_IMAGE; +"EXPOSED_FACE_OF_PARALLEL",EXPOSED_FACE_OF_PARALLEL; +"EXPOSED_FACE_OF_POLYHEDRON",EXPOSED_FACE_OF_POLYHEDRON; +"EXPOSED_FACE_OF_REFL",EXPOSED_FACE_OF_REFL; +"EXPOSED_FACE_OF_REFL_EQ",EXPOSED_FACE_OF_REFL_EQ; +"EXPOSED_FACE_OF_SUMS",EXPOSED_FACE_OF_SUMS; +"EXPOSED_FACE_OF_TRANSLATION_EQ",EXPOSED_FACE_OF_TRANSLATION_EQ; +"EXPOSED_POINT_OF_FURTHEST_POINT",EXPOSED_POINT_OF_FURTHEST_POINT; +"EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"EXP_1",EXP_1; +"EXP_2",EXP_2; +"EXP_ADD",EXP_ADD; +"EXP_EQ_0",EXP_EQ_0; +"EXP_EQ_1",EXP_EQ_1; +"EXP_LIMIT",EXP_LIMIT; +"EXP_LOG",EXP_LOG; +"EXP_LT_0",EXP_LT_0; +"EXP_MONO_EQ",EXP_MONO_EQ; +"EXP_MONO_LE",EXP_MONO_LE; +"EXP_MONO_LE_IMP",EXP_MONO_LE_IMP; +"EXP_MONO_LT",EXP_MONO_LT; +"EXP_MONO_LT_IMP",EXP_MONO_LT_IMP; +"EXP_MULT",EXP_MULT; +"EXP_ONE",EXP_ONE; +"EXP_ZERO",EXP_ZERO; +"EXTEND_FL",EXTEND_FL; +"EXTEND_INSEG",EXTEND_INSEG; +"EXTEND_LINSEG",EXTEND_LINSEG; +"EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE",EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE; +"EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN",EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN; +"EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE",EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE; +"EXTEND_MAP_CELL_COMPLEX_TO_SPHERE",EXTEND_MAP_CELL_COMPLEX_TO_SPHERE; +"EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE",EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE; +"EXTEND_MAP_SPHERE_TO_SPHERE",EXTEND_MAP_SPHERE_TO_SPHERE; +"EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE",EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE; +"EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN",EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN; +"EXTEND_MAP_SPHERE_TO_SPHERE_GEN",EXTEND_MAP_SPHERE_TO_SPHERE_GEN; +"EXTEND_MAP_UNIV_TO_SPHERE_COFINITE",EXTEND_MAP_UNIV_TO_SPHERE_COFINITE; +"EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT",EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT; +"EXTEND_TO_AFFINE_BASIS",EXTEND_TO_AFFINE_BASIS; +"EXTENSION",EXTENSION; +"EXTENSION_FROM_CLOPEN",EXTENSION_FROM_CLOPEN; +"EXTENSION_FROM_COMPONENT",EXTENSION_FROM_COMPONENT; +"EXTENSION_INTO_AR",EXTENSION_INTO_AR; +"EXTENSION_INTO_AR_LOCAL",EXTENSION_INTO_AR_LOCAL; +"EXTREME_POINTS_OF_CONVEX_HULL",EXTREME_POINTS_OF_CONVEX_HULL; +"EXTREME_POINTS_OF_CONVEX_HULL_EQ",EXTREME_POINTS_OF_CONVEX_HULL_EQ; +"EXTREME_POINTS_OF_LINEAR_IMAGE",EXTREME_POINTS_OF_LINEAR_IMAGE; +"EXTREME_POINTS_OF_TRANSLATION",EXTREME_POINTS_OF_TRANSLATION; +"EXTREME_POINT_EXISTS_CONVEX",EXTREME_POINT_EXISTS_CONVEX; +"EXTREME_POINT_NOT_IN_INTERIOR",EXTREME_POINT_NOT_IN_INTERIOR; +"EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR",EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; +"EXTREME_POINT_OF_CONIC",EXTREME_POINT_OF_CONIC; +"EXTREME_POINT_OF_CONVEX_HULL",EXTREME_POINT_OF_CONVEX_HULL; +"EXTREME_POINT_OF_CONVEX_HULL_2",EXTREME_POINT_OF_CONVEX_HULL_2; +"EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT; +"EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT; +"EXTREME_POINT_OF_CONVEX_HULL_EQ",EXTREME_POINT_OF_CONVEX_HULL_EQ; +"EXTREME_POINT_OF_CONVEX_HULL_INSERT",EXTREME_POINT_OF_CONVEX_HULL_INSERT; +"EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ",EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ; +"EXTREME_POINT_OF_EMPTY",EXTREME_POINT_OF_EMPTY; +"EXTREME_POINT_OF_FACE",EXTREME_POINT_OF_FACE; +"EXTREME_POINT_OF_INTER",EXTREME_POINT_OF_INTER; +"EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"EXTREME_POINT_OF_LINEAR_IMAGE",EXTREME_POINT_OF_LINEAR_IMAGE; +"EXTREME_POINT_OF_MIDPOINT",EXTREME_POINT_OF_MIDPOINT; +"EXTREME_POINT_OF_SEGMENT",EXTREME_POINT_OF_SEGMENT; +"EXTREME_POINT_OF_SING",EXTREME_POINT_OF_SING; +"EXTREME_POINT_OF_STILLCONVEX",EXTREME_POINT_OF_STILLCONVEX; +"EXTREME_POINT_OF_TRANSLATION_EQ",EXTREME_POINT_OF_TRANSLATION_EQ; +"EX_IMP",EX_IMP; +"EX_MAP",EX_MAP; +"EX_MEM",EX_MEM; +"E_APPROX_32",E_APPROX_32; +"FACES_OF_LINEAR_IMAGE",FACES_OF_LINEAR_IMAGE; +"FACES_OF_SIMPLEX",FACES_OF_SIMPLEX; +"FACES_OF_TRANSLATION",FACES_OF_TRANSLATION; +"FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT",FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT; +"FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT; +"FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT; +"FACET_OF_EMPTY",FACET_OF_EMPTY; +"FACET_OF_HALFSPACE_GE",FACET_OF_HALFSPACE_GE; +"FACET_OF_HALFSPACE_LE",FACET_OF_HALFSPACE_LE; +"FACET_OF_IMP_FACE_OF",FACET_OF_IMP_FACE_OF; +"FACET_OF_IMP_PROPER",FACET_OF_IMP_PROPER; +"FACET_OF_IMP_SUBSET",FACET_OF_IMP_SUBSET; +"FACET_OF_LINEAR_IMAGE",FACET_OF_LINEAR_IMAGE; +"FACET_OF_POLYHEDRON",FACET_OF_POLYHEDRON; +"FACET_OF_POLYHEDRON_EXPLICIT",FACET_OF_POLYHEDRON_EXPLICIT; +"FACET_OF_REFL",FACET_OF_REFL; +"FACET_OF_TRANSLATION_EQ",FACET_OF_TRANSLATION_EQ; +"FACE_OF_AFFINE_EQ",FACE_OF_AFFINE_EQ; +"FACE_OF_AFFINE_TRIVIAL",FACE_OF_AFFINE_TRIVIAL; +"FACE_OF_AFF_DIM_LT",FACE_OF_AFF_DIM_LT; +"FACE_OF_CONIC",FACE_OF_CONIC; +"FACE_OF_CONVEX_HULLS",FACE_OF_CONVEX_HULLS; +"FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT; +"FACE_OF_CONVEX_HULL_INSERT",FACE_OF_CONVEX_HULL_INSERT; +"FACE_OF_CONVEX_HULL_INSERT_EQ",FACE_OF_CONVEX_HULL_INSERT_EQ; +"FACE_OF_CONVEX_HULL_SUBSET",FACE_OF_CONVEX_HULL_SUBSET; +"FACE_OF_DISJOINT_INTERIOR",FACE_OF_DISJOINT_INTERIOR; +"FACE_OF_DISJOINT_RELATIVE_INTERIOR",FACE_OF_DISJOINT_RELATIVE_INTERIOR; +"FACE_OF_EMPTY",FACE_OF_EMPTY; +"FACE_OF_EQ",FACE_OF_EQ; +"FACE_OF_FACE",FACE_OF_FACE; +"FACE_OF_HALFSPACE_GE",FACE_OF_HALFSPACE_GE; +"FACE_OF_HALFSPACE_LE",FACE_OF_HALFSPACE_LE; +"FACE_OF_IMP_CLOSED",FACE_OF_IMP_CLOSED; +"FACE_OF_IMP_COMPACT",FACE_OF_IMP_COMPACT; +"FACE_OF_IMP_CONVEX",FACE_OF_IMP_CONVEX; +"FACE_OF_IMP_SUBSET",FACE_OF_IMP_SUBSET; +"FACE_OF_INTER",FACE_OF_INTER; +"FACE_OF_INTERS",FACE_OF_INTERS; +"FACE_OF_INTER_INTER",FACE_OF_INTER_INTER; +"FACE_OF_INTER_SUBFACE",FACE_OF_INTER_SUBFACE; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG; +"FACE_OF_LINEAR_IMAGE",FACE_OF_LINEAR_IMAGE; +"FACE_OF_PCROSS",FACE_OF_PCROSS; +"FACE_OF_PCROSS_DECOMP",FACE_OF_PCROSS_DECOMP; +"FACE_OF_PCROSS_EQ",FACE_OF_PCROSS_EQ; +"FACE_OF_POLYHEDRON",FACE_OF_POLYHEDRON; +"FACE_OF_POLYHEDRON_EXPLICIT",FACE_OF_POLYHEDRON_EXPLICIT; +"FACE_OF_POLYHEDRON_POLYHEDRON",FACE_OF_POLYHEDRON_POLYHEDRON; +"FACE_OF_POLYHEDRON_SUBSET_EXPLICIT",FACE_OF_POLYHEDRON_SUBSET_EXPLICIT; +"FACE_OF_POLYHEDRON_SUBSET_FACET",FACE_OF_POLYHEDRON_SUBSET_FACET; +"FACE_OF_POLYTOPE_POLYTOPE",FACE_OF_POLYTOPE_POLYTOPE; +"FACE_OF_REFL",FACE_OF_REFL; +"FACE_OF_REFL_EQ",FACE_OF_REFL_EQ; +"FACE_OF_SIMPLEX_SUBSET",FACE_OF_SIMPLEX_SUBSET; +"FACE_OF_SING",FACE_OF_SING; +"FACE_OF_SLICE",FACE_OF_SLICE; +"FACE_OF_STILLCONVEX",FACE_OF_STILLCONVEX; +"FACE_OF_SUBSET",FACE_OF_SUBSET; +"FACE_OF_SUBSET_RELATIVE_BOUNDARY",FACE_OF_SUBSET_RELATIVE_BOUNDARY; +"FACE_OF_SUBSET_RELATIVE_FRONTIER",FACE_OF_SUBSET_RELATIVE_FRONTIER; +"FACE_OF_TRANS",FACE_OF_TRANS; +"FACE_OF_TRANSLATION_EQ",FACE_OF_TRANSLATION_EQ; +"FACT",FACT; +"FACT_LE",FACT_LE; +"FACT_LT",FACT_LT; +"FACT_MONO",FACT_MONO; +"FACT_NZ",FACT_NZ; +"FARKAS_LEMMA",FARKAS_LEMMA; +"FARKAS_LEMMA_ALT",FARKAS_LEMMA_ALT; +"FASHODA",FASHODA; +"FASHODA_INTERLACE",FASHODA_INTERLACE; +"FASHODA_UNIT",FASHODA_UNIT; +"FASHODA_UNIT_PATH",FASHODA_UNIT_PATH; +"FATOU",FATOU; +"FCONS",FCONS; +"FCONS_UNDO",FCONS_UNDO; +"FILTER",FILTER; +"FILTER_APPEND",FILTER_APPEND; +"FILTER_MAP",FILTER_MAP; +"FINE_DIVISION_EXISTS",FINE_DIVISION_EXISTS; +"FINE_INTER",FINE_INTER; +"FINE_INTERS",FINE_INTERS; +"FINE_SUBSET",FINE_SUBSET; +"FINE_UNION",FINE_UNION; +"FINE_UNIONS",FINE_UNIONS; +"FINITELY_GENERATED_CONIC_POLYHEDRON",FINITELY_GENERATED_CONIC_POLYHEDRON; +"FINITE_ANR_COMPONENTS",FINITE_ANR_COMPONENTS; +"FINITE_BALL",FINITE_BALL; +"FINITE_BITSET",FINITE_BITSET; +"FINITE_BOOL",FINITE_BOOL; +"FINITE_BOUNDED_FUNCTIONS",FINITE_BOUNDED_FUNCTIONS; +"FINITE_CARD_COMPLEX_ROOTS_UNITY",FINITE_CARD_COMPLEX_ROOTS_UNITY; +"FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT",FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT; +"FINITE_CARD_LT",FINITE_CARD_LT; +"FINITE_CART",FINITE_CART; +"FINITE_CART_SUBSET_LEMMA",FINITE_CART_SUBSET_LEMMA; +"FINITE_CART_UNIV",FINITE_CART_UNIV; +"FINITE_CASES",FINITE_CASES; +"FINITE_CBALL",FINITE_CBALL; +"FINITE_COLUMNS",FINITE_COLUMNS; +"FINITE_COMPLEMENT_ANR_COMPONENTS",FINITE_COMPLEMENT_ANR_COMPONENTS; +"FINITE_COMPLEMENT_ENR_COMPONENTS",FINITE_COMPLEMENT_ENR_COMPONENTS; +"FINITE_COMPLEX_ROOTS_UNITY",FINITE_COMPLEX_ROOTS_UNITY; +"FINITE_COMPONENTS",FINITE_COMPONENTS; +"FINITE_CROSS",FINITE_CROSS; +"FINITE_DELETE",FINITE_DELETE; +"FINITE_DELETE_IMP",FINITE_DELETE_IMP; +"FINITE_DIFF",FINITE_DIFF; +"FINITE_EMPTY",FINITE_EMPTY; +"FINITE_EMPTY_INTERIOR",FINITE_EMPTY_INTERIOR; +"FINITE_ENR_COMPONENTS",FINITE_ENR_COMPONENTS; +"FINITE_FACES_OF_SIMPLEX",FINITE_FACES_OF_SIMPLEX; +"FINITE_FINITE_IMAGE",FINITE_FINITE_IMAGE; +"FINITE_FINITE_PREIMAGE",FINITE_FINITE_PREIMAGE; +"FINITE_FINITE_PREIMAGE_GENERAL",FINITE_FINITE_PREIMAGE_GENERAL; +"FINITE_FINITE_UNIONS",FINITE_FINITE_UNIONS; +"FINITE_FUNSPACE",FINITE_FUNSPACE; +"FINITE_FUNSPACE_UNIV",FINITE_FUNSPACE_UNIV; +"FINITE_HAS_SIZE",FINITE_HAS_SIZE; +"FINITE_IMAGE",FINITE_IMAGE; +"FINITE_IMAGE_EXPAND",FINITE_IMAGE_EXPAND; +"FINITE_IMAGE_IMAGE",FINITE_IMAGE_IMAGE; +"FINITE_IMAGE_INJ",FINITE_IMAGE_INJ; +"FINITE_IMAGE_INJ_EQ",FINITE_IMAGE_INJ_EQ; +"FINITE_IMAGE_INJ_GENERAL",FINITE_IMAGE_INJ_GENERAL; +"FINITE_IMP_ANR",FINITE_IMP_ANR; +"FINITE_IMP_BOUNDED",FINITE_IMP_BOUNDED; +"FINITE_IMP_BOUNDED_CONVEX_HULL",FINITE_IMP_BOUNDED_CONVEX_HULL; +"FINITE_IMP_CLOSED",FINITE_IMP_CLOSED; +"FINITE_IMP_CLOSED_IN",FINITE_IMP_CLOSED_IN; +"FINITE_IMP_COMPACT",FINITE_IMP_COMPACT; +"FINITE_IMP_COMPACT_CONVEX_HULL",FINITE_IMP_COMPACT_CONVEX_HULL; +"FINITE_IMP_COUNTABLE",FINITE_IMP_COUNTABLE; +"FINITE_IMP_ENR",FINITE_IMP_ENR; +"FINITE_IMP_NOT_OPEN",FINITE_IMP_NOT_OPEN; +"FINITE_INDEX_INJ",FINITE_INDEX_INJ; +"FINITE_INDEX_INRANGE",FINITE_INDEX_INRANGE; +"FINITE_INDEX_INRANGE_2",FINITE_INDEX_INRANGE_2; +"FINITE_INDEX_NUMBERS",FINITE_INDEX_NUMBERS; +"FINITE_INDEX_NUMSEG",FINITE_INDEX_NUMSEG; +"FINITE_INDEX_NUMSEG_SPECIAL",FINITE_INDEX_NUMSEG_SPECIAL; +"FINITE_INDEX_WORKS",FINITE_INDEX_WORKS; +"FINITE_INDUCT",FINITE_INDUCT; +"FINITE_INDUCT_DELETE",FINITE_INDUCT_DELETE; +"FINITE_INDUCT_STRONG",FINITE_INDUCT_STRONG; +"FINITE_INSERT",FINITE_INSERT; +"FINITE_INTER",FINITE_INTER; +"FINITE_INTERVAL_1",FINITE_INTERVAL_1; +"FINITE_INTER_COLLINEAR_OPEN_SEGMENTS",FINITE_INTER_COLLINEAR_OPEN_SEGMENTS; +"FINITE_INTER_NUMSEG",FINITE_INTER_NUMSEG; +"FINITE_INTSEG",FINITE_INTSEG; +"FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS",FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS; +"FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS",FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS; +"FINITE_MULTIVECTOR",FINITE_MULTIVECTOR; +"FINITE_NUMSEG",FINITE_NUMSEG; +"FINITE_NUMSEG_LE",FINITE_NUMSEG_LE; +"FINITE_NUMSEG_LT",FINITE_NUMSEG_LT; +"FINITE_PCROSS",FINITE_PCROSS; +"FINITE_PCROSS_EQ",FINITE_PCROSS_EQ; +"FINITE_PERMUTATIONS",FINITE_PERMUTATIONS; +"FINITE_POLYHEDRON_EXPOSED_FACES",FINITE_POLYHEDRON_EXPOSED_FACES; +"FINITE_POLYHEDRON_EXTREME_POINTS",FINITE_POLYHEDRON_EXTREME_POINTS; +"FINITE_POLYHEDRON_FACES",FINITE_POLYHEDRON_FACES; +"FINITE_POLYHEDRON_FACETS",FINITE_POLYHEDRON_FACETS; +"FINITE_POLYTOPE_FACES",FINITE_POLYTOPE_FACES; +"FINITE_POLYTOPE_FACETS",FINITE_POLYTOPE_FACETS; +"FINITE_POWERSET",FINITE_POWERSET; +"FINITE_PRODUCT",FINITE_PRODUCT; +"FINITE_PRODUCT_DEPENDENT",FINITE_PRODUCT_DEPENDENT; +"FINITE_REAL_INTERVAL",FINITE_REAL_INTERVAL; +"FINITE_RECURSION",FINITE_RECURSION; +"FINITE_RECURSION_DELETE",FINITE_RECURSION_DELETE; +"FINITE_RESTRICT",FINITE_RESTRICT; +"FINITE_ROWS",FINITE_ROWS; +"FINITE_RULES",FINITE_RULES; +"FINITE_SEGMENT",FINITE_SEGMENT; +"FINITE_SET_AVOID",FINITE_SET_AVOID; +"FINITE_SET_OF_LIST",FINITE_SET_OF_LIST; +"FINITE_SIMPLICES",FINITE_SIMPLICES; +"FINITE_SING",FINITE_SING; +"FINITE_SPHERE",FINITE_SPHERE; +"FINITE_SPHERE_1",FINITE_SPHERE_1; +"FINITE_STDBASIS",FINITE_STDBASIS; +"FINITE_SUBSET",FINITE_SUBSET; +"FINITE_SUBSET_IMAGE",FINITE_SUBSET_IMAGE; +"FINITE_SUBSET_IMAGE_IMP",FINITE_SUBSET_IMAGE_IMP; +"FINITE_SUM_IMAGE",FINITE_SUM_IMAGE; +"FINITE_SUPPORT",FINITE_SUPPORT; +"FINITE_SUPPORT_DELTA",FINITE_SUPPORT_DELTA; +"FINITE_TRANSITIVITY_CHAIN",FINITE_TRANSITIVITY_CHAIN; +"FINITE_UNION",FINITE_UNION; +"FINITE_UNIONS",FINITE_UNIONS; +"FINITE_UNION_IMP",FINITE_UNION_IMP; +"FINREC",FINREC; +"FINREC_1_LEMMA",FINREC_1_LEMMA; +"FINREC_EXISTS_LEMMA",FINREC_EXISTS_LEMMA; +"FINREC_FUN",FINREC_FUN; +"FINREC_FUN_LEMMA",FINREC_FUN_LEMMA; +"FINREC_SUC_LEMMA",FINREC_SUC_LEMMA; +"FINREC_UNIQUE_LEMMA",FINREC_UNIQUE_LEMMA; +"FIRST_CARTAN_THM_DIM_1",FIRST_CARTAN_THM_DIM_1; +"FIXED_POINT_INESSENTIAL_SPHERE_MAP",FIXED_POINT_INESSENTIAL_SPHERE_MAP; +"FIXING_SWAPSEQ_DECREASE",FIXING_SWAPSEQ_DECREASE; +"FLATTEN_LEMMA",FLATTEN_LEMMA; +"FLOOR",FLOOR; +"FLOOR_DIV_DIV",FLOOR_DIV_DIV; +"FLOOR_DOUBLE",FLOOR_DOUBLE; +"FLOOR_EQ_0",FLOOR_EQ_0; +"FLOOR_FRAC",FLOOR_FRAC; +"FLOOR_MONO",FLOOR_MONO; +"FLOOR_NUM",FLOOR_NUM; +"FLOOR_POS",FLOOR_POS; +"FLOOR_POS_LE",FLOOR_POS_LE; +"FLOOR_UNIQUE",FLOOR_UNIQUE; +"FL_RESTRICT",FL_RESTRICT; +"FL_RESTRICTED_SUBSET",FL_RESTRICTED_SUBSET; +"FL_SUC",FL_SUC; +"FNIL",FNIL; +"FORALL_1",FORALL_1; +"FORALL_2",FORALL_2; +"FORALL_3",FORALL_3; +"FORALL_4",FORALL_4; +"FORALL_ALL",FORALL_ALL; +"FORALL_AND_THM",FORALL_AND_THM; +"FORALL_BOOL_THM",FORALL_BOOL_THM; +"FORALL_CNJ",FORALL_CNJ; +"FORALL_COMPLEX",FORALL_COMPLEX; +"FORALL_COUNTABLE_AS_IMAGE",FORALL_COUNTABLE_AS_IMAGE; +"FORALL_COUNTABLE_SUBSET_IMAGE",FORALL_COUNTABLE_SUBSET_IMAGE; +"FORALL_CURRY",FORALL_CURRY; +"FORALL_DEF",FORALL_DEF; +"FORALL_DIMINDEX_1",FORALL_DIMINDEX_1; +"FORALL_DOT_EQ_0",FORALL_DOT_EQ_0; +"FORALL_DROP",FORALL_DROP; +"FORALL_DROP_FUN",FORALL_DROP_FUN; +"FORALL_DROP_IMAGE",FORALL_DROP_IMAGE; +"FORALL_EVENTUALLY",FORALL_EVENTUALLY; +"FORALL_FINITE_INDEX",FORALL_FINITE_INDEX; +"FORALL_FINITE_SUBSET_IMAGE",FORALL_FINITE_SUBSET_IMAGE; +"FORALL_INTEGER",FORALL_INTEGER; +"FORALL_IN_CLAUSES",FORALL_IN_CLAUSES; +"FORALL_IN_CLOSURE",FORALL_IN_CLOSURE; +"FORALL_IN_CLOSURE_EQ",FORALL_IN_CLOSURE_EQ; +"FORALL_IN_DIVISION",FORALL_IN_DIVISION; +"FORALL_IN_DIVISION_NONEMPTY",FORALL_IN_DIVISION_NONEMPTY; +"FORALL_IN_GSPEC",FORALL_IN_GSPEC; +"FORALL_IN_IMAGE",FORALL_IN_IMAGE; +"FORALL_IN_INSERT",FORALL_IN_INSERT; +"FORALL_IN_PCROSS",FORALL_IN_PCROSS; +"FORALL_IN_UNION",FORALL_IN_UNION; +"FORALL_IN_UNIONS",FORALL_IN_UNIONS; +"FORALL_LIFT",FORALL_LIFT; +"FORALL_LIFT_FUN",FORALL_LIFT_FUN; +"FORALL_LIFT_IMAGE",FORALL_LIFT_IMAGE; +"FORALL_MULTIVECTOR",FORALL_MULTIVECTOR; +"FORALL_NOT_THM",FORALL_NOT_THM; +"FORALL_OF_DROP",FORALL_OF_DROP; +"FORALL_OF_PASTECART",FORALL_OF_PASTECART; +"FORALL_OPTION",FORALL_OPTION; +"FORALL_PAIRED_THM",FORALL_PAIRED_THM; +"FORALL_PAIR_THM",FORALL_PAIR_THM; +"FORALL_PASTECART",FORALL_PASTECART; +"FORALL_POS_MONO",FORALL_POS_MONO; +"FORALL_POS_MONO_1",FORALL_POS_MONO_1; +"FORALL_REAL",FORALL_REAL; +"FORALL_REAL_ONE",FORALL_REAL_ONE; +"FORALL_SETCODE",FORALL_SETCODE; +"FORALL_SIMP",FORALL_SIMP; +"FORALL_SUBSET_IMAGE",FORALL_SUBSET_IMAGE; +"FORALL_SUBSET_UNION",FORALL_SUBSET_UNION; +"FORALL_SUC",FORALL_SUC; +"FORALL_SUM_THM",FORALL_SUM_THM; +"FORALL_TRIPLED_THM",FORALL_TRIPLED_THM; +"FORALL_UNCURRY",FORALL_UNCURRY; +"FORALL_UNPAIR_THM",FORALL_UNPAIR_THM; +"FORALL_UNWIND_THM1",FORALL_UNWIND_THM1; +"FORALL_UNWIND_THM2",FORALL_UNWIND_THM2; +"FORALL_VECTOR_1",FORALL_VECTOR_1; +"FORALL_VECTOR_2",FORALL_VECTOR_2; +"FORALL_VECTOR_3",FORALL_VECTOR_3; +"FORALL_VECTOR_4",FORALL_VECTOR_4; +"FRAC_FLOOR",FRAC_FLOOR; +"FRAC_NUM",FRAC_NUM; +"FRAC_UNIQUE",FRAC_UNIQUE; +"FRECHET_DERIVATIVE_AT",FRECHET_DERIVATIVE_AT; +"FRECHET_DERIVATIVE_CONST_AT",FRECHET_DERIVATIVE_CONST_AT; +"FRECHET_DERIVATIVE_UNIQUE_AT",FRECHET_DERIVATIVE_UNIQUE_AT; +"FRECHET_DERIVATIVE_UNIQUE_WITHIN",FRECHET_DERIVATIVE_UNIQUE_WITHIN; +"FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; +"FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL; +"FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL; +"FRECHET_DERIVATIVE_WORKS",FRECHET_DERIVATIVE_WORKS; +"FROM_0",FROM_0; +"FROM_INTER_NUMSEG",FROM_INTER_NUMSEG; +"FROM_INTER_NUMSEG_GEN",FROM_INTER_NUMSEG_GEN; +"FROM_INTER_NUMSEG_MAX",FROM_INTER_NUMSEG_MAX; +"FRONTIER_BALL",FRONTIER_BALL; +"FRONTIER_BIJECTIVE_LINEAR_IMAGE",FRONTIER_BIJECTIVE_LINEAR_IMAGE; +"FRONTIER_CBALL",FRONTIER_CBALL; +"FRONTIER_CLOSED",FRONTIER_CLOSED; +"FRONTIER_CLOSED_INTERVAL",FRONTIER_CLOSED_INTERVAL; +"FRONTIER_CLOSURES",FRONTIER_CLOSURES; +"FRONTIER_CLOSURE_CONVEX",FRONTIER_CLOSURE_CONVEX; +"FRONTIER_CLOSURE_SUBSET",FRONTIER_CLOSURE_SUBSET; +"FRONTIER_COMPLEMENT",FRONTIER_COMPLEMENT; +"FRONTIER_CONVEX_HULL_CASES",FRONTIER_CONVEX_HULL_CASES; +"FRONTIER_CONVEX_HULL_EXPLICIT",FRONTIER_CONVEX_HULL_EXPLICIT; +"FRONTIER_DISJOINT_EQ",FRONTIER_DISJOINT_EQ; +"FRONTIER_EMPTY",FRONTIER_EMPTY; +"FRONTIER_EQ_EMPTY",FRONTIER_EQ_EMPTY; +"FRONTIER_FRONTIER",FRONTIER_FRONTIER; +"FRONTIER_FRONTIER_FRONTIER",FRONTIER_FRONTIER_FRONTIER; +"FRONTIER_FRONTIER_SUBSET",FRONTIER_FRONTIER_SUBSET; +"FRONTIER_HALFSPACE_GE",FRONTIER_HALFSPACE_GE; +"FRONTIER_HALFSPACE_GT",FRONTIER_HALFSPACE_GT; +"FRONTIER_HALFSPACE_LE",FRONTIER_HALFSPACE_LE; +"FRONTIER_HALFSPACE_LT",FRONTIER_HALFSPACE_LT; +"FRONTIER_INJECTIVE_LINEAR_IMAGE",FRONTIER_INJECTIVE_LINEAR_IMAGE; +"FRONTIER_INSIDE_SUBSET",FRONTIER_INSIDE_SUBSET; +"FRONTIER_INTERIORS",FRONTIER_INTERIORS; +"FRONTIER_INTERIOR_SUBSET",FRONTIER_INTERIOR_SUBSET; +"FRONTIER_INTER_SUBSET",FRONTIER_INTER_SUBSET; +"FRONTIER_INTER_SUBSET_INTER",FRONTIER_INTER_SUBSET_INTER; +"FRONTIER_MINIMAL_SEPARATING_CLOSED",FRONTIER_MINIMAL_SEPARATING_CLOSED; +"FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE",FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE; +"FRONTIER_NOT_EMPTY",FRONTIER_NOT_EMPTY; +"FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT",FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; +"FRONTIER_OF_COMPONENTS_SUBSET",FRONTIER_OF_COMPONENTS_SUBSET; +"FRONTIER_OF_CONNECTED_COMPONENT_SUBSET",FRONTIER_OF_CONNECTED_COMPONENT_SUBSET; +"FRONTIER_OF_CONVEX_HULL",FRONTIER_OF_CONVEX_HULL; +"FRONTIER_OF_TRIANGLE",FRONTIER_OF_TRIANGLE; +"FRONTIER_OPEN_INTERVAL",FRONTIER_OPEN_INTERVAL; +"FRONTIER_OUTSIDE_SUBSET",FRONTIER_OUTSIDE_SUBSET; +"FRONTIER_PCROSS",FRONTIER_PCROSS; +"FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE",FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE; +"FRONTIER_SING",FRONTIER_SING; +"FRONTIER_STRADDLE",FRONTIER_STRADDLE; +"FRONTIER_SUBSET_CLOSED",FRONTIER_SUBSET_CLOSED; +"FRONTIER_SUBSET_COMPACT",FRONTIER_SUBSET_COMPACT; +"FRONTIER_SUBSET_EQ",FRONTIER_SUBSET_EQ; +"FRONTIER_SUBSET_RETRACTION",FRONTIER_SUBSET_RETRACTION; +"FRONTIER_SURJECTIVE_LINEAR_IMAGE",FRONTIER_SURJECTIVE_LINEAR_IMAGE; +"FRONTIER_TRANSLATION",FRONTIER_TRANSLATION; +"FRONTIER_UNION",FRONTIER_UNION; +"FRONTIER_UNIONS_SUBSET",FRONTIER_UNIONS_SUBSET; +"FRONTIER_UNIONS_SUBSET_CLOSURE",FRONTIER_UNIONS_SUBSET_CLOSURE; +"FRONTIER_UNION_SUBSET",FRONTIER_UNION_SUBSET; +"FRONTIER_UNIV",FRONTIER_UNIV; +"FST",FST; +"FSTCART_ADD",FSTCART_ADD; +"FSTCART_CMUL",FSTCART_CMUL; +"FSTCART_NEG",FSTCART_NEG; +"FSTCART_PASTECART",FSTCART_PASTECART; +"FSTCART_SUB",FSTCART_SUB; +"FSTCART_VEC",FSTCART_VEC; +"FSTCART_VSUM",FSTCART_VSUM; +"FST_DEF",FST_DEF; +"FTA",FTA; +"FUBINI_ABSOLUTELY_INTEGRABLE",FUBINI_ABSOLUTELY_INTEGRABLE; +"FUBINI_ABSOLUTELY_INTEGRABLE_ALT",FUBINI_ABSOLUTELY_INTEGRABLE_ALT; +"FUBINI_CLOSED_INTERVAL",FUBINI_CLOSED_INTERVAL; +"FUBINI_INTEGRAL",FUBINI_INTEGRAL; +"FUBINI_INTEGRAL_ALT",FUBINI_INTEGRAL_ALT; +"FUBINI_INTEGRAL_INTERVAL",FUBINI_INTEGRAL_INTERVAL; +"FUBINI_INTEGRAL_INTERVAL_ALT",FUBINI_INTEGRAL_INTERVAL_ALT; +"FUBINI_LEBESGUE_MEASURABLE",FUBINI_LEBESGUE_MEASURABLE; +"FUBINI_LEBESGUE_MEASURABLE_ALT",FUBINI_LEBESGUE_MEASURABLE_ALT; +"FUBINI_MEASURE",FUBINI_MEASURE; +"FUBINI_MEASURE_ALT",FUBINI_MEASURE_ALT; +"FUBINI_NEGLIGIBLE",FUBINI_NEGLIGIBLE; +"FUBINI_NEGLIGIBLE_ALT",FUBINI_NEGLIGIBLE_ALT; +"FUBINI_SIMPLE",FUBINI_SIMPLE; +"FUBINI_SIMPLE_ALT",FUBINI_SIMPLE_ALT; +"FUBINI_SIMPLE_COMPACT",FUBINI_SIMPLE_COMPACT; +"FUBINI_SIMPLE_COMPACT_STRONG",FUBINI_SIMPLE_COMPACT_STRONG; +"FUBINI_SIMPLE_CONVEX",FUBINI_SIMPLE_CONVEX; +"FUBINI_SIMPLE_CONVEX_STRONG",FUBINI_SIMPLE_CONVEX_STRONG; +"FUBINI_SIMPLE_LEMMA",FUBINI_SIMPLE_LEMMA; +"FUBINI_SIMPLE_OPEN",FUBINI_SIMPLE_OPEN; +"FUBINI_SIMPLE_OPEN_STRONG",FUBINI_SIMPLE_OPEN_STRONG; +"FUBINI_TONELLI",FUBINI_TONELLI; +"FUBINI_TONELLI_ALT",FUBINI_TONELLI_ALT; +"FUBINI_TONELLI_MEASURE",FUBINI_TONELLI_MEASURE; +"FUBINI_TONELLI_MEASURE_ALT",FUBINI_TONELLI_MEASURE_ALT; +"FUBINI_TONELLI_NEGLIGIBLE",FUBINI_TONELLI_NEGLIGIBLE; +"FUBINI_TONELLI_NEGLIGIBLE_ALT",FUBINI_TONELLI_NEGLIGIBLE_ALT; +"FULL_RANK_INJECTIVE",FULL_RANK_INJECTIVE; +"FULL_RANK_SURJECTIVE",FULL_RANK_SURJECTIVE; +"FUNCTION_CONVERGENT_SUBSEQUENCE",FUNCTION_CONVERGENT_SUBSEQUENCE; +"FUNCTION_FACTORS_LEFT",FUNCTION_FACTORS_LEFT; +"FUNCTION_FACTORS_LEFT_GEN",FUNCTION_FACTORS_LEFT_GEN; +"FUNCTION_FACTORS_RIGHT",FUNCTION_FACTORS_RIGHT; +"FUNCTION_FACTORS_RIGHT_GEN",FUNCTION_FACTORS_RIGHT_GEN; +"FUNDAMENTAL_THEOREM_OF_CALCULUS",FUNDAMENTAL_THEOREM_OF_CALCULUS; +"FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR; +"FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG; +"FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG; +"FUN_EQ_THM",FUN_EQ_THM; +"FUN_IN_IMAGE",FUN_IN_IMAGE; +"F_DEF",F_DEF; +"GABS_DEF",GABS_DEF; +"GAUGE_BALL",GAUGE_BALL; +"GAUGE_BALL_DEPENDENT",GAUGE_BALL_DEPENDENT; +"GAUGE_EXISTENCE_LEMMA",GAUGE_EXISTENCE_LEMMA; +"GAUGE_INTER",GAUGE_INTER; +"GAUGE_INTERS",GAUGE_INTERS; +"GAUGE_MODIFY",GAUGE_MODIFY; +"GAUGE_TRIVIAL",GAUGE_TRIVIAL; +"GE",GE; +"GENERAL_CONNECTED_OPEN",GENERAL_CONNECTED_OPEN; +"GEOM_ASSOC",GEOM_ASSOC; +"GEOM_LADD",GEOM_LADD; +"GEOM_LMUL",GEOM_LMUL; +"GEOM_LNEG",GEOM_LNEG; +"GEOM_LZERO",GEOM_LZERO; +"GEOM_MBASIS",GEOM_MBASIS; +"GEOM_MBASIS_SING",GEOM_MBASIS_SING; +"GEOM_RADD",GEOM_RADD; +"GEOM_RMUL",GEOM_RMUL; +"GEOM_RNEG",GEOM_RNEG; +"GEOM_RZERO",GEOM_RZERO; +"GEQ_DEF",GEQ_DEF; +"GE_C",GE_C; +"GE_REFL",GE_REFL; +"GRADE_ADD",GRADE_ADD; +"GRADE_CMUL",GRADE_CMUL; +"GRAM_SCHMIDT_STEP",GRAM_SCHMIDT_STEP; +"GRASSMANN_PLUCKER_2",GRASSMANN_PLUCKER_2; +"GRASSMANN_PLUCKER_3",GRASSMANN_PLUCKER_3; +"GRASSMANN_PLUCKER_4",GRASSMANN_PLUCKER_4; +"GREAT_PICARD",GREAT_PICARD; +"GREAT_PICARD_ALT",GREAT_PICARD_ALT; +"GREAT_PICARD_INFINITE",GREAT_PICARD_INFINITE; +"GSPEC",GSPEC; +"GT",GT; +"HALFSPACE_EQ_EMPTY_GE",HALFSPACE_EQ_EMPTY_GE; +"HALFSPACE_EQ_EMPTY_GT",HALFSPACE_EQ_EMPTY_GT; +"HALFSPACE_EQ_EMPTY_LE",HALFSPACE_EQ_EMPTY_LE; +"HALFSPACE_EQ_EMPTY_LT",HALFSPACE_EQ_EMPTY_LT; +"HAS_ANTIDERIVATIVE_LIMIT",HAS_ANTIDERIVATIVE_LIMIT; +"HAS_ANTIDERIVATIVE_SEQUENCE",HAS_ANTIDERIVATIVE_SEQUENCE; +"HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ",HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ; +"HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ",HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ; +"HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES",HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES; +"HAS_BOUNDED_REAL_VARIATION_DARBOUX",HAS_BOUNDED_REAL_VARIATION_DARBOUX; +"HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT",HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT; +"HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG",HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG; +"HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT",HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT; +"HAS_BOUNDED_REAL_VARIATION_ON_ABS",HAS_BOUNDED_REAL_VARIATION_ON_ABS; +"HAS_BOUNDED_REAL_VARIATION_ON_ADD",HAS_BOUNDED_REAL_VARIATION_ON_ADD; +"HAS_BOUNDED_REAL_VARIATION_ON_COMBINE",HAS_BOUNDED_REAL_VARIATION_ON_COMBINE; +"HAS_BOUNDED_REAL_VARIATION_ON_EMPTY",HAS_BOUNDED_REAL_VARIATION_ON_EMPTY; +"HAS_BOUNDED_REAL_VARIATION_ON_EQ",HAS_BOUNDED_REAL_VARIATION_ON_EQ; +"HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL; +"HAS_BOUNDED_REAL_VARIATION_ON_LMUL",HAS_BOUNDED_REAL_VARIATION_ON_LMUL; +"HAS_BOUNDED_REAL_VARIATION_ON_MAX",HAS_BOUNDED_REAL_VARIATION_ON_MAX; +"HAS_BOUNDED_REAL_VARIATION_ON_MIN",HAS_BOUNDED_REAL_VARIATION_ON_MIN; +"HAS_BOUNDED_REAL_VARIATION_ON_MUL",HAS_BOUNDED_REAL_VARIATION_ON_MUL; +"HAS_BOUNDED_REAL_VARIATION_ON_NEG",HAS_BOUNDED_REAL_VARIATION_ON_NEG; +"HAS_BOUNDED_REAL_VARIATION_ON_NULL",HAS_BOUNDED_REAL_VARIATION_ON_NULL; +"HAS_BOUNDED_REAL_VARIATION_ON_RMUL",HAS_BOUNDED_REAL_VARIATION_ON_RMUL; +"HAS_BOUNDED_REAL_VARIATION_ON_SUB",HAS_BOUNDED_REAL_VARIATION_ON_SUB; +"HAS_BOUNDED_REAL_VARIATION_ON_SUBSET",HAS_BOUNDED_REAL_VARIATION_ON_SUBSET; +"HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ",HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ; +"HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ",HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ; +"HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL",HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL; +"HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT",HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT; +"HAS_BOUNDED_REAL_VARIATION_TRANSLATION",HAS_BOUNDED_REAL_VARIATION_TRANSLATION; +"HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ",HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ; +"HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ",HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ; +"HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL",HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL; +"HAS_BOUNDED_SETVARIATION_ON",HAS_BOUNDED_SETVARIATION_ON; +"HAS_BOUNDED_SETVARIATION_ON_0",HAS_BOUNDED_SETVARIATION_ON_0; +"HAS_BOUNDED_SETVARIATION_ON_ADD",HAS_BOUNDED_SETVARIATION_ON_ADD; +"HAS_BOUNDED_SETVARIATION_ON_CMUL",HAS_BOUNDED_SETVARIATION_ON_CMUL; +"HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE",HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE; +"HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR; +"HAS_BOUNDED_SETVARIATION_ON_DIVISION",HAS_BOUNDED_SETVARIATION_ON_DIVISION; +"HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY; +"HAS_BOUNDED_SETVARIATION_ON_EQ",HAS_BOUNDED_SETVARIATION_ON_EQ; +"HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; +"HAS_BOUNDED_SETVARIATION_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_ON_INTERVAL; +"HAS_BOUNDED_SETVARIATION_ON_NEG",HAS_BOUNDED_SETVARIATION_ON_NEG; +"HAS_BOUNDED_SETVARIATION_ON_NORM",HAS_BOUNDED_SETVARIATION_ON_NORM; +"HAS_BOUNDED_SETVARIATION_ON_NULL",HAS_BOUNDED_SETVARIATION_ON_NULL; +"HAS_BOUNDED_SETVARIATION_ON_SUB",HAS_BOUNDED_SETVARIATION_ON_SUB; +"HAS_BOUNDED_SETVARIATION_ON_SUBSET",HAS_BOUNDED_SETVARIATION_ON_SUBSET; +"HAS_BOUNDED_SETVARIATION_ON_UNIV",HAS_BOUNDED_SETVARIATION_ON_UNIV; +"HAS_BOUNDED_SETVARIATION_REFLECT2_EQ",HAS_BOUNDED_SETVARIATION_REFLECT2_EQ; +"HAS_BOUNDED_SETVARIATION_TRANSLATION",HAS_BOUNDED_SETVARIATION_TRANSLATION; +"HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ",HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ; +"HAS_BOUNDED_SETVARIATION_WORKS",HAS_BOUNDED_SETVARIATION_WORKS; +"HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY; +"HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL; +"HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE",HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE; +"HAS_BOUNDED_VARIATION_AFFINITY2_EQ",HAS_BOUNDED_VARIATION_AFFINITY2_EQ; +"HAS_BOUNDED_VARIATION_AFFINITY_EQ",HAS_BOUNDED_VARIATION_AFFINITY_EQ; +"HAS_BOUNDED_VARIATION_COMPOSE_DECREASING",HAS_BOUNDED_VARIATION_COMPOSE_DECREASING; +"HAS_BOUNDED_VARIATION_COMPOSE_INCREASING",HAS_BOUNDED_VARIATION_COMPOSE_INCREASING; +"HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES",HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES; +"HAS_BOUNDED_VARIATION_DARBOUX",HAS_BOUNDED_VARIATION_DARBOUX; +"HAS_BOUNDED_VARIATION_DARBOUX_STRICT",HAS_BOUNDED_VARIATION_DARBOUX_STRICT; +"HAS_BOUNDED_VARIATION_DARBOUX_STRONG",HAS_BOUNDED_VARIATION_DARBOUX_STRONG; +"HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE",HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE; +"HAS_BOUNDED_VARIATION_ON_ADD",HAS_BOUNDED_VARIATION_ON_ADD; +"HAS_BOUNDED_VARIATION_ON_CMUL",HAS_BOUNDED_VARIATION_ON_CMUL; +"HAS_BOUNDED_VARIATION_ON_COMBINE",HAS_BOUNDED_VARIATION_ON_COMBINE; +"HAS_BOUNDED_VARIATION_ON_COMPONENTWISE",HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; +"HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR; +"HAS_BOUNDED_VARIATION_ON_CONST",HAS_BOUNDED_VARIATION_ON_CONST; +"HAS_BOUNDED_VARIATION_ON_DIVISION",HAS_BOUNDED_VARIATION_ON_DIVISION; +"HAS_BOUNDED_VARIATION_ON_EMPTY",HAS_BOUNDED_VARIATION_ON_EMPTY; +"HAS_BOUNDED_VARIATION_ON_EQ",HAS_BOUNDED_VARIATION_ON_EQ; +"HAS_BOUNDED_VARIATION_ON_ID",HAS_BOUNDED_VARIATION_ON_ID; +"HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL; +"HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; +"HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT; +"HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT; +"HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE",HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE; +"HAS_BOUNDED_VARIATION_ON_MAX",HAS_BOUNDED_VARIATION_ON_MAX; +"HAS_BOUNDED_VARIATION_ON_MIN",HAS_BOUNDED_VARIATION_ON_MIN; +"HAS_BOUNDED_VARIATION_ON_MUL",HAS_BOUNDED_VARIATION_ON_MUL; +"HAS_BOUNDED_VARIATION_ON_NEG",HAS_BOUNDED_VARIATION_ON_NEG; +"HAS_BOUNDED_VARIATION_ON_NORM",HAS_BOUNDED_VARIATION_ON_NORM; +"HAS_BOUNDED_VARIATION_ON_NULL",HAS_BOUNDED_VARIATION_ON_NULL; +"HAS_BOUNDED_VARIATION_ON_REFLECT",HAS_BOUNDED_VARIATION_ON_REFLECT; +"HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL",HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL; +"HAS_BOUNDED_VARIATION_ON_SUB",HAS_BOUNDED_VARIATION_ON_SUB; +"HAS_BOUNDED_VARIATION_ON_SUBSET",HAS_BOUNDED_VARIATION_ON_SUBSET; +"HAS_BOUNDED_VARIATION_REFLECT2_EQ",HAS_BOUNDED_VARIATION_REFLECT2_EQ; +"HAS_BOUNDED_VARIATION_REFLECT_EQ",HAS_BOUNDED_VARIATION_REFLECT_EQ; +"HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL",HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL; +"HAS_BOUNDED_VARIATION_TRANSLATION",HAS_BOUNDED_VARIATION_TRANSLATION; +"HAS_BOUNDED_VARIATION_TRANSLATION2_EQ",HAS_BOUNDED_VARIATION_TRANSLATION2_EQ; +"HAS_BOUNDED_VARIATION_TRANSLATION_EQ",HAS_BOUNDED_VARIATION_TRANSLATION_EQ; +"HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL",HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL; +"HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT; +"HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT; +"HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL",HAS_CHAIN_INTEGRAL_CHAIN_INTEGRAL; +"HAS_COMPLEX_DERIVATIVE_ADD",HAS_COMPLEX_DERIVATIVE_ADD; +"HAS_COMPLEX_DERIVATIVE_AT",HAS_COMPLEX_DERIVATIVE_AT; +"HAS_COMPLEX_DERIVATIVE_AT_WITHIN",HAS_COMPLEX_DERIVATIVE_AT_WITHIN; +"HAS_COMPLEX_DERIVATIVE_CACS",HAS_COMPLEX_DERIVATIVE_CACS; +"HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT",HAS_COMPLEX_DERIVATIVE_CARATHEODORY_AT; +"HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN",HAS_COMPLEX_DERIVATIVE_CARATHEODORY_WITHIN; +"HAS_COMPLEX_DERIVATIVE_CASN",HAS_COMPLEX_DERIVATIVE_CASN; +"HAS_COMPLEX_DERIVATIVE_CATN",HAS_COMPLEX_DERIVATIVE_CATN; +"HAS_COMPLEX_DERIVATIVE_CCOS",HAS_COMPLEX_DERIVATIVE_CCOS; +"HAS_COMPLEX_DERIVATIVE_CDIV_AT",HAS_COMPLEX_DERIVATIVE_CDIV_AT; +"HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN",HAS_COMPLEX_DERIVATIVE_CDIV_WITHIN; +"HAS_COMPLEX_DERIVATIVE_CEXP",HAS_COMPLEX_DERIVATIVE_CEXP; +"HAS_COMPLEX_DERIVATIVE_CHAIN",HAS_COMPLEX_DERIVATIVE_CHAIN; +"HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV",HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV; +"HAS_COMPLEX_DERIVATIVE_CLOG",HAS_COMPLEX_DERIVATIVE_CLOG; +"HAS_COMPLEX_DERIVATIVE_CONST",HAS_COMPLEX_DERIVATIVE_CONST; +"HAS_COMPLEX_DERIVATIVE_CPOW",HAS_COMPLEX_DERIVATIVE_CPOW; +"HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT",HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT; +"HAS_COMPLEX_DERIVATIVE_CSIN",HAS_COMPLEX_DERIVATIVE_CSIN; +"HAS_COMPLEX_DERIVATIVE_CSQRT",HAS_COMPLEX_DERIVATIVE_CSQRT; +"HAS_COMPLEX_DERIVATIVE_CTAN",HAS_COMPLEX_DERIVATIVE_CTAN; +"HAS_COMPLEX_DERIVATIVE_DERIVATIVE",HAS_COMPLEX_DERIVATIVE_DERIVATIVE; +"HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE",HAS_COMPLEX_DERIVATIVE_DIFFERENTIABLE; +"HAS_COMPLEX_DERIVATIVE_DIV_AT",HAS_COMPLEX_DERIVATIVE_DIV_AT; +"HAS_COMPLEX_DERIVATIVE_DIV_WITHIN",HAS_COMPLEX_DERIVATIVE_DIV_WITHIN; +"HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE",HAS_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE; +"HAS_COMPLEX_DERIVATIVE_ID",HAS_COMPLEX_DERIVATIVE_ID; +"HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT",HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; +"HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN",HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN; +"HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC",HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC; +"HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG",HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG; +"HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X",HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X; +"HAS_COMPLEX_DERIVATIVE_INV_AT",HAS_COMPLEX_DERIVATIVE_INV_AT; +"HAS_COMPLEX_DERIVATIVE_INV_BASIC",HAS_COMPLEX_DERIVATIVE_INV_BASIC; +"HAS_COMPLEX_DERIVATIVE_INV_WITHIN",HAS_COMPLEX_DERIVATIVE_INV_WITHIN; +"HAS_COMPLEX_DERIVATIVE_ITER_1",HAS_COMPLEX_DERIVATIVE_ITER_1; +"HAS_COMPLEX_DERIVATIVE_LINEAR",HAS_COMPLEX_DERIVATIVE_LINEAR; +"HAS_COMPLEX_DERIVATIVE_LMUL_AT",HAS_COMPLEX_DERIVATIVE_LMUL_AT; +"HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN",HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN; +"HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE",HAS_COMPLEX_DERIVATIVE_LOCALLY_INJECTIVE; +"HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE",HAS_COMPLEX_DERIVATIVE_LOCALLY_INVERTIBLE; +"HAS_COMPLEX_DERIVATIVE_MUL_AT",HAS_COMPLEX_DERIVATIVE_MUL_AT; +"HAS_COMPLEX_DERIVATIVE_MUL_WITHIN",HAS_COMPLEX_DERIVATIVE_MUL_WITHIN; +"HAS_COMPLEX_DERIVATIVE_NEG",HAS_COMPLEX_DERIVATIVE_NEG; +"HAS_COMPLEX_DERIVATIVE_POW_AT",HAS_COMPLEX_DERIVATIVE_POW_AT; +"HAS_COMPLEX_DERIVATIVE_POW_WITHIN",HAS_COMPLEX_DERIVATIVE_POW_WITHIN; +"HAS_COMPLEX_DERIVATIVE_RMUL_AT",HAS_COMPLEX_DERIVATIVE_RMUL_AT; +"HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN",HAS_COMPLEX_DERIVATIVE_RMUL_WITHIN; +"HAS_COMPLEX_DERIVATIVE_SEQUENCE",HAS_COMPLEX_DERIVATIVE_SEQUENCE; +"HAS_COMPLEX_DERIVATIVE_SERIES",HAS_COMPLEX_DERIVATIVE_SERIES; +"HAS_COMPLEX_DERIVATIVE_SUB",HAS_COMPLEX_DERIVATIVE_SUB; +"HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT",HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT; +"HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN",HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN; +"HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT",HAS_COMPLEX_DERIVATIVE_UNIFORM_LIMIT; +"HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE",HAS_COMPLEX_DERIVATIVE_UNIFORM_SEQUENCE; +"HAS_COMPLEX_DERIVATIVE_VSUM",HAS_COMPLEX_DERIVATIVE_VSUM; +"HAS_COMPLEX_DERIVATIVE_WITHIN",HAS_COMPLEX_DERIVATIVE_WITHIN; +"HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN",HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; +"HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET",HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET; +"HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT",HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_CONSTANT; +"HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_UNIQUE",HAS_COMPLEX_DERIVATIVE_ZERO_CONNECTED_UNIQUE; +"HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT",HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT; +"HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE",HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE; +"HAS_COMPLEX_REAL_DERIVATIVE_AT",HAS_COMPLEX_REAL_DERIVATIVE_AT; +"HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN",HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN; +"HAS_COMPLEX_REAL_DERIVATIVE_WITHIN",HAS_COMPLEX_REAL_DERIVATIVE_WITHIN; +"HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN",HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN; +"HAS_DERIVATIVE_ADD",HAS_DERIVATIVE_ADD; +"HAS_DERIVATIVE_AT",HAS_DERIVATIVE_AT; +"HAS_DERIVATIVE_AT_ALT",HAS_DERIVATIVE_AT_ALT; +"HAS_DERIVATIVE_AT_WITHIN",HAS_DERIVATIVE_AT_WITHIN; +"HAS_DERIVATIVE_BILINEAR_AT",HAS_DERIVATIVE_BILINEAR_AT; +"HAS_DERIVATIVE_BILINEAR_WITHIN",HAS_DERIVATIVE_BILINEAR_WITHIN; +"HAS_DERIVATIVE_CMUL",HAS_DERIVATIVE_CMUL; +"HAS_DERIVATIVE_CMUL_EQ",HAS_DERIVATIVE_CMUL_EQ; +"HAS_DERIVATIVE_COMPLEX_CMUL",HAS_DERIVATIVE_COMPLEX_CMUL; +"HAS_DERIVATIVE_COMPONENTWISE_AT",HAS_DERIVATIVE_COMPONENTWISE_AT; +"HAS_DERIVATIVE_COMPONENTWISE_WITHIN",HAS_DERIVATIVE_COMPONENTWISE_WITHIN; +"HAS_DERIVATIVE_CONST",HAS_DERIVATIVE_CONST; +"HAS_DERIVATIVE_ID",HAS_DERIVATIVE_ID; +"HAS_DERIVATIVE_IMP_DIFFERENTIABLE",HAS_DERIVATIVE_IMP_DIFFERENTIABLE; +"HAS_DERIVATIVE_INVERSE",HAS_DERIVATIVE_INVERSE; +"HAS_DERIVATIVE_INVERSE_BASIC",HAS_DERIVATIVE_INVERSE_BASIC; +"HAS_DERIVATIVE_INVERSE_BASIC_X",HAS_DERIVATIVE_INVERSE_BASIC_X; +"HAS_DERIVATIVE_INVERSE_DIEUDONNE",HAS_DERIVATIVE_INVERSE_DIEUDONNE; +"HAS_DERIVATIVE_INVERSE_ON",HAS_DERIVATIVE_INVERSE_ON; +"HAS_DERIVATIVE_INVERSE_STRONG",HAS_DERIVATIVE_INVERSE_STRONG; +"HAS_DERIVATIVE_INVERSE_STRONG_X",HAS_DERIVATIVE_INVERSE_STRONG_X; +"HAS_DERIVATIVE_LIFT_COMPONENT",HAS_DERIVATIVE_LIFT_COMPONENT; +"HAS_DERIVATIVE_LIFT_DOT",HAS_DERIVATIVE_LIFT_DOT; +"HAS_DERIVATIVE_LINEAR",HAS_DERIVATIVE_LINEAR; +"HAS_DERIVATIVE_LOCALLY_INJECTIVE",HAS_DERIVATIVE_LOCALLY_INJECTIVE; +"HAS_DERIVATIVE_MUL_AT",HAS_DERIVATIVE_MUL_AT; +"HAS_DERIVATIVE_MUL_WITHIN",HAS_DERIVATIVE_MUL_WITHIN; +"HAS_DERIVATIVE_NEG",HAS_DERIVATIVE_NEG; +"HAS_DERIVATIVE_NEG_EQ",HAS_DERIVATIVE_NEG_EQ; +"HAS_DERIVATIVE_SEQUENCE",HAS_DERIVATIVE_SEQUENCE; +"HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ",HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ; +"HAS_DERIVATIVE_SERIES",HAS_DERIVATIVE_SERIES; +"HAS_DERIVATIVE_SQNORM_AT",HAS_DERIVATIVE_SQNORM_AT; +"HAS_DERIVATIVE_SUB",HAS_DERIVATIVE_SUB; +"HAS_DERIVATIVE_TRANSFORM_AT",HAS_DERIVATIVE_TRANSFORM_AT; +"HAS_DERIVATIVE_TRANSFORM_WITHIN",HAS_DERIVATIVE_TRANSFORM_WITHIN; +"HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"HAS_DERIVATIVE_VMUL_COMPONENT",HAS_DERIVATIVE_VMUL_COMPONENT; +"HAS_DERIVATIVE_VMUL_DROP",HAS_DERIVATIVE_VMUL_DROP; +"HAS_DERIVATIVE_VSUM",HAS_DERIVATIVE_VSUM; +"HAS_DERIVATIVE_VSUM_NUMSEG",HAS_DERIVATIVE_VSUM_NUMSEG; +"HAS_DERIVATIVE_WITHIN",HAS_DERIVATIVE_WITHIN; +"HAS_DERIVATIVE_WITHIN_ALT",HAS_DERIVATIVE_WITHIN_ALT; +"HAS_DERIVATIVE_WITHIN_OPEN",HAS_DERIVATIVE_WITHIN_OPEN; +"HAS_DERIVATIVE_WITHIN_SUBSET",HAS_DERIVATIVE_WITHIN_SUBSET; +"HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT",HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT; +"HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE",HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE; +"HAS_DERIVATIVE_ZERO_CONSTANT",HAS_DERIVATIVE_ZERO_CONSTANT; +"HAS_DERIVATIVE_ZERO_UNIQUE",HAS_DERIVATIVE_ZERO_UNIQUE; +"HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED; +"HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX; +"HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL; +"HAS_FRECHET_DERIVATIVE_UNIQUE_AT",HAS_FRECHET_DERIVATIVE_UNIQUE_AT; +"HAS_INTEGRAL",HAS_INTEGRAL; +"HAS_INTEGRAL_0",HAS_INTEGRAL_0; +"HAS_INTEGRAL_0_EQ",HAS_INTEGRAL_0_EQ; +"HAS_INTEGRAL_ADD",HAS_INTEGRAL_ADD; +"HAS_INTEGRAL_AFFINITY",HAS_INTEGRAL_AFFINITY; +"HAS_INTEGRAL_ALT",HAS_INTEGRAL_ALT; +"HAS_INTEGRAL_BOUND",HAS_INTEGRAL_BOUND; +"HAS_INTEGRAL_CLOSURE",HAS_INTEGRAL_CLOSURE; +"HAS_INTEGRAL_CMUL",HAS_INTEGRAL_CMUL; +"HAS_INTEGRAL_COMBINE",HAS_INTEGRAL_COMBINE; +"HAS_INTEGRAL_COMBINE_DIVISION",HAS_INTEGRAL_COMBINE_DIVISION; +"HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN; +"HAS_INTEGRAL_COMBINE_TAGGED_DIVISION",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION; +"HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; +"HAS_INTEGRAL_COMPLEX_0",HAS_INTEGRAL_COMPLEX_0; +"HAS_INTEGRAL_COMPLEX_LMUL",HAS_INTEGRAL_COMPLEX_LMUL; +"HAS_INTEGRAL_COMPLEX_RMUL",HAS_INTEGRAL_COMPLEX_RMUL; +"HAS_INTEGRAL_COMPONENTWISE",HAS_INTEGRAL_COMPONENTWISE; +"HAS_INTEGRAL_COMPONENT_LBOUND",HAS_INTEGRAL_COMPONENT_LBOUND; +"HAS_INTEGRAL_COMPONENT_LE",HAS_INTEGRAL_COMPONENT_LE; +"HAS_INTEGRAL_COMPONENT_LE_AE",HAS_INTEGRAL_COMPONENT_LE_AE; +"HAS_INTEGRAL_COMPONENT_NEG",HAS_INTEGRAL_COMPONENT_NEG; +"HAS_INTEGRAL_COMPONENT_POS",HAS_INTEGRAL_COMPONENT_POS; +"HAS_INTEGRAL_COMPONENT_UBOUND",HAS_INTEGRAL_COMPONENT_UBOUND; +"HAS_INTEGRAL_CONST",HAS_INTEGRAL_CONST; +"HAS_INTEGRAL_DIFF",HAS_INTEGRAL_DIFF; +"HAS_INTEGRAL_DROP_LE",HAS_INTEGRAL_DROP_LE; +"HAS_INTEGRAL_DROP_LE_AE",HAS_INTEGRAL_DROP_LE_AE; +"HAS_INTEGRAL_DROP_NEG",HAS_INTEGRAL_DROP_NEG; +"HAS_INTEGRAL_DROP_POS",HAS_INTEGRAL_DROP_POS; +"HAS_INTEGRAL_DROP_POS_AE",HAS_INTEGRAL_DROP_POS_AE; +"HAS_INTEGRAL_EMPTY",HAS_INTEGRAL_EMPTY; +"HAS_INTEGRAL_EMPTY_EQ",HAS_INTEGRAL_EMPTY_EQ; +"HAS_INTEGRAL_EQ",HAS_INTEGRAL_EQ; +"HAS_INTEGRAL_EQ_EQ",HAS_INTEGRAL_EQ_EQ; +"HAS_INTEGRAL_FACTOR_CONTENT",HAS_INTEGRAL_FACTOR_CONTENT; +"HAS_INTEGRAL_INTEGRABLE",HAS_INTEGRAL_INTEGRABLE; +"HAS_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_INTEGRAL_INTEGRABLE_INTEGRAL; +"HAS_INTEGRAL_INTEGRAL",HAS_INTEGRAL_INTEGRAL; +"HAS_INTEGRAL_INTERIOR",HAS_INTEGRAL_INTERIOR; +"HAS_INTEGRAL_IS_0",HAS_INTEGRAL_IS_0; +"HAS_INTEGRAL_LIM_AT_POSINFINITY",HAS_INTEGRAL_LIM_AT_POSINFINITY; +"HAS_INTEGRAL_LIM_SEQUENTIALLY",HAS_INTEGRAL_LIM_SEQUENTIALLY; +"HAS_INTEGRAL_LINEAR",HAS_INTEGRAL_LINEAR; +"HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE",HAS_INTEGRAL_LOCALIZED_VECTOR_DERIVATIVE; +"HAS_INTEGRAL_MEASURE_UNDER_CURVE",HAS_INTEGRAL_MEASURE_UNDER_CURVE; +"HAS_INTEGRAL_NEG",HAS_INTEGRAL_NEG; +"HAS_INTEGRAL_NEGLIGIBLE",HAS_INTEGRAL_NEGLIGIBLE; +"HAS_INTEGRAL_NEGLIGIBLE_EQ",HAS_INTEGRAL_NEGLIGIBLE_EQ; +"HAS_INTEGRAL_NEGLIGIBLE_EQ_AE",HAS_INTEGRAL_NEGLIGIBLE_EQ_AE; +"HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; +"HAS_INTEGRAL_NULL",HAS_INTEGRAL_NULL; +"HAS_INTEGRAL_NULL_EQ",HAS_INTEGRAL_NULL_EQ; +"HAS_INTEGRAL_ON_SUPERSET",HAS_INTEGRAL_ON_SUPERSET; +"HAS_INTEGRAL_OPEN_INTERVAL",HAS_INTEGRAL_OPEN_INTERVAL; +"HAS_INTEGRAL_PASTECART_SYM",HAS_INTEGRAL_PASTECART_SYM; +"HAS_INTEGRAL_PASTECART_SYM_ALT",HAS_INTEGRAL_PASTECART_SYM_ALT; +"HAS_INTEGRAL_PASTECART_SYM_UNIV",HAS_INTEGRAL_PASTECART_SYM_UNIV; +"HAS_INTEGRAL_PATH_INTEGRAL_SUBPATH",HAS_INTEGRAL_PATH_INTEGRAL_SUBPATH; +"HAS_INTEGRAL_REFL",HAS_INTEGRAL_REFL; +"HAS_INTEGRAL_REFLECT",HAS_INTEGRAL_REFLECT; +"HAS_INTEGRAL_REFLECT_GEN",HAS_INTEGRAL_REFLECT_GEN; +"HAS_INTEGRAL_REFLECT_LEMMA",HAS_INTEGRAL_REFLECT_LEMMA; +"HAS_INTEGRAL_RESTRICT",HAS_INTEGRAL_RESTRICT; +"HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL; +"HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ; +"HAS_INTEGRAL_RESTRICT_INTER",HAS_INTEGRAL_RESTRICT_INTER; +"HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL; +"HAS_INTEGRAL_RESTRICT_UNIV",HAS_INTEGRAL_RESTRICT_UNIV; +"HAS_INTEGRAL_SEPARATE_SIDES",HAS_INTEGRAL_SEPARATE_SIDES; +"HAS_INTEGRAL_SPIKE",HAS_INTEGRAL_SPIKE; +"HAS_INTEGRAL_SPIKE_EQ",HAS_INTEGRAL_SPIKE_EQ; +"HAS_INTEGRAL_SPIKE_FINITE",HAS_INTEGRAL_SPIKE_FINITE; +"HAS_INTEGRAL_SPIKE_FINITE_EQ",HAS_INTEGRAL_SPIKE_FINITE_EQ; +"HAS_INTEGRAL_SPIKE_INTERIOR",HAS_INTEGRAL_SPIKE_INTERIOR; +"HAS_INTEGRAL_SPIKE_INTERIOR_EQ",HAS_INTEGRAL_SPIKE_INTERIOR_EQ; +"HAS_INTEGRAL_SPIKE_SET",HAS_INTEGRAL_SPIKE_SET; +"HAS_INTEGRAL_SPIKE_SET_EQ",HAS_INTEGRAL_SPIKE_SET_EQ; +"HAS_INTEGRAL_SPLIT",HAS_INTEGRAL_SPLIT; +"HAS_INTEGRAL_STRADDLE_NULL",HAS_INTEGRAL_STRADDLE_NULL; +"HAS_INTEGRAL_STRETCH",HAS_INTEGRAL_STRETCH; +"HAS_INTEGRAL_SUB",HAS_INTEGRAL_SUB; +"HAS_INTEGRAL_SUBSET_COMPONENT_LE",HAS_INTEGRAL_SUBSET_COMPONENT_LE; +"HAS_INTEGRAL_SUBSET_DROP_LE",HAS_INTEGRAL_SUBSET_DROP_LE; +"HAS_INTEGRAL_SUBSTITUTION_STRONG",HAS_INTEGRAL_SUBSTITUTION_STRONG; +"HAS_INTEGRAL_TWIDDLE",HAS_INTEGRAL_TWIDDLE; +"HAS_INTEGRAL_TWIZZLE",HAS_INTEGRAL_TWIZZLE; +"HAS_INTEGRAL_TWIZZLE_EQ",HAS_INTEGRAL_TWIZZLE_EQ; +"HAS_INTEGRAL_TWIZZLE_INTERVAL",HAS_INTEGRAL_TWIZZLE_INTERVAL; +"HAS_INTEGRAL_UNION",HAS_INTEGRAL_UNION; +"HAS_INTEGRAL_UNIONS",HAS_INTEGRAL_UNIONS; +"HAS_INTEGRAL_UNIQUE",HAS_INTEGRAL_UNIQUE; +"HAS_INTEGRAL_VSUM",HAS_INTEGRAL_VSUM; +"HAS_MEASURE",HAS_MEASURE; +"HAS_MEASURE_0",HAS_MEASURE_0; +"HAS_MEASURE_AFFINITY",HAS_MEASURE_AFFINITY; +"HAS_MEASURE_ALMOST",HAS_MEASURE_ALMOST; +"HAS_MEASURE_ALMOST_EQ",HAS_MEASURE_ALMOST_EQ; +"HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS; +"HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED; +"HAS_MEASURE_DIFF_NEGLIGIBLE",HAS_MEASURE_DIFF_NEGLIGIBLE; +"HAS_MEASURE_DIFF_NEGLIGIBLE_EQ",HAS_MEASURE_DIFF_NEGLIGIBLE_EQ; +"HAS_MEASURE_DIFF_SUBSET",HAS_MEASURE_DIFF_SUBSET; +"HAS_MEASURE_DISJOINT_UNION",HAS_MEASURE_DISJOINT_UNION; +"HAS_MEASURE_DISJOINT_UNIONS",HAS_MEASURE_DISJOINT_UNIONS; +"HAS_MEASURE_DISJOINT_UNIONS_IMAGE",HAS_MEASURE_DISJOINT_UNIONS_IMAGE; +"HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; +"HAS_MEASURE_ELEMENTARY",HAS_MEASURE_ELEMENTARY; +"HAS_MEASURE_EMPTY",HAS_MEASURE_EMPTY; +"HAS_MEASURE_IMAGE_STD_SIMPLEX",HAS_MEASURE_IMAGE_STD_SIMPLEX; +"HAS_MEASURE_IMP_MEASURABLE",HAS_MEASURE_IMP_MEASURABLE; +"HAS_MEASURE_INNER_OUTER",HAS_MEASURE_INNER_OUTER; +"HAS_MEASURE_INNER_OUTER_LE",HAS_MEASURE_INNER_OUTER_LE; +"HAS_MEASURE_INTERVAL",HAS_MEASURE_INTERVAL; +"HAS_MEASURE_ISOMETRY",HAS_MEASURE_ISOMETRY; +"HAS_MEASURE_LIMIT",HAS_MEASURE_LIMIT; +"HAS_MEASURE_LINEAR_IMAGE",HAS_MEASURE_LINEAR_IMAGE; +"HAS_MEASURE_LINEAR_IMAGE_ALT",HAS_MEASURE_LINEAR_IMAGE_ALT; +"HAS_MEASURE_LINEAR_IMAGE_SAME",HAS_MEASURE_LINEAR_IMAGE_SAME; +"HAS_MEASURE_LINEAR_SUFFICIENT",HAS_MEASURE_LINEAR_SUFFICIENT; +"HAS_MEASURE_MEASURABLE_MEASURE",HAS_MEASURE_MEASURABLE_MEASURE; +"HAS_MEASURE_MEASURE",HAS_MEASURE_MEASURE; +"HAS_MEASURE_NEGLIGIBLE_SYMDIFF",HAS_MEASURE_NEGLIGIBLE_SYMDIFF; +"HAS_MEASURE_NEGLIGIBLE_UNION",HAS_MEASURE_NEGLIGIBLE_UNION; +"HAS_MEASURE_NEGLIGIBLE_UNIONS",HAS_MEASURE_NEGLIGIBLE_UNIONS; +"HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE; +"HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; +"HAS_MEASURE_NESTED_INTERS",HAS_MEASURE_NESTED_INTERS; +"HAS_MEASURE_NESTED_UNIONS",HAS_MEASURE_NESTED_UNIONS; +"HAS_MEASURE_ORTHOGONAL_IMAGE",HAS_MEASURE_ORTHOGONAL_IMAGE; +"HAS_MEASURE_ORTHOGONAL_IMAGE_EQ",HAS_MEASURE_ORTHOGONAL_IMAGE_EQ; +"HAS_MEASURE_PCROSS",HAS_MEASURE_PCROSS; +"HAS_MEASURE_POS_LE",HAS_MEASURE_POS_LE; +"HAS_MEASURE_SCALING",HAS_MEASURE_SCALING; +"HAS_MEASURE_SCALING_EQ",HAS_MEASURE_SCALING_EQ; +"HAS_MEASURE_SHEAR_INTERVAL",HAS_MEASURE_SHEAR_INTERVAL; +"HAS_MEASURE_SIMPLEX",HAS_MEASURE_SIMPLEX; +"HAS_MEASURE_SIMPLEX_0",HAS_MEASURE_SIMPLEX_0; +"HAS_MEASURE_STD_SIMPLEX",HAS_MEASURE_STD_SIMPLEX; +"HAS_MEASURE_STRETCH",HAS_MEASURE_STRETCH; +"HAS_MEASURE_SUBSET",HAS_MEASURE_SUBSET; +"HAS_MEASURE_TETRAHEDRON",HAS_MEASURE_TETRAHEDRON; +"HAS_MEASURE_TRANSLATION",HAS_MEASURE_TRANSLATION; +"HAS_MEASURE_TRANSLATION_EQ",HAS_MEASURE_TRANSLATION_EQ; +"HAS_MEASURE_TRIANGLE",HAS_MEASURE_TRIANGLE; +"HAS_MEASURE_UNION_NEGLIGIBLE",HAS_MEASURE_UNION_NEGLIGIBLE; +"HAS_MEASURE_UNION_NEGLIGIBLE_EQ",HAS_MEASURE_UNION_NEGLIGIBLE_EQ; +"HAS_MEASURE_UNIQUE",HAS_MEASURE_UNIQUE; +"HAS_PATH_INTEGRAL",HAS_PATH_INTEGRAL; +"HAS_PATH_INTEGRAL_0",HAS_PATH_INTEGRAL_0; +"HAS_PATH_INTEGRAL_ADD",HAS_PATH_INTEGRAL_ADD; +"HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH",HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH; +"HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH_STRONG",HAS_PATH_INTEGRAL_BOUND_CIRCLEPATH_STRONG; +"HAS_PATH_INTEGRAL_BOUND_LINEPATH",HAS_PATH_INTEGRAL_BOUND_LINEPATH; +"HAS_PATH_INTEGRAL_BOUND_LINEPATH_STRONG",HAS_PATH_INTEGRAL_BOUND_LINEPATH_STRONG; +"HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH",HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH; +"HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG",HAS_PATH_INTEGRAL_BOUND_PARTCIRCLEPATH_STRONG; +"HAS_PATH_INTEGRAL_COMPLEX_DIV",HAS_PATH_INTEGRAL_COMPLEX_DIV; +"HAS_PATH_INTEGRAL_COMPLEX_LMUL",HAS_PATH_INTEGRAL_COMPLEX_LMUL; +"HAS_PATH_INTEGRAL_COMPLEX_RMUL",HAS_PATH_INTEGRAL_COMPLEX_RMUL; +"HAS_PATH_INTEGRAL_CONST_LINEPATH",HAS_PATH_INTEGRAL_CONST_LINEPATH; +"HAS_PATH_INTEGRAL_EQ",HAS_PATH_INTEGRAL_EQ; +"HAS_PATH_INTEGRAL_INTEGRABLE",HAS_PATH_INTEGRAL_INTEGRABLE; +"HAS_PATH_INTEGRAL_INTEGRAL",HAS_PATH_INTEGRAL_INTEGRAL; +"HAS_PATH_INTEGRAL_IS_0",HAS_PATH_INTEGRAL_IS_0; +"HAS_PATH_INTEGRAL_JOIN",HAS_PATH_INTEGRAL_JOIN; +"HAS_PATH_INTEGRAL_LINEPATH",HAS_PATH_INTEGRAL_LINEPATH; +"HAS_PATH_INTEGRAL_MIDPOINT",HAS_PATH_INTEGRAL_MIDPOINT; +"HAS_PATH_INTEGRAL_NEG",HAS_PATH_INTEGRAL_NEG; +"HAS_PATH_INTEGRAL_REVERSEPATH",HAS_PATH_INTEGRAL_REVERSEPATH; +"HAS_PATH_INTEGRAL_REVERSE_LINEPATH",HAS_PATH_INTEGRAL_REVERSE_LINEPATH; +"HAS_PATH_INTEGRAL_SHIFTPATH",HAS_PATH_INTEGRAL_SHIFTPATH; +"HAS_PATH_INTEGRAL_SHIFTPATH_EQ",HAS_PATH_INTEGRAL_SHIFTPATH_EQ; +"HAS_PATH_INTEGRAL_SPLIT",HAS_PATH_INTEGRAL_SPLIT; +"HAS_PATH_INTEGRAL_SUB",HAS_PATH_INTEGRAL_SUB; +"HAS_PATH_INTEGRAL_SUBPATH",HAS_PATH_INTEGRAL_SUBPATH; +"HAS_PATH_INTEGRAL_SUBPATH_REFL",HAS_PATH_INTEGRAL_SUBPATH_REFL; +"HAS_PATH_INTEGRAL_TRIVIAL",HAS_PATH_INTEGRAL_TRIVIAL; +"HAS_PATH_INTEGRAL_UNIQUE",HAS_PATH_INTEGRAL_UNIQUE; +"HAS_PATH_INTEGRAL_VSUM",HAS_PATH_INTEGRAL_VSUM; +"HAS_PATH_INTEGRAL_WINDING_NUMBER",HAS_PATH_INTEGRAL_WINDING_NUMBER; +"HAS_REAL_COMPLEX_DERIVATIVE_AT",HAS_REAL_COMPLEX_DERIVATIVE_AT; +"HAS_REAL_COMPLEX_DERIVATIVE_WITHIN",HAS_REAL_COMPLEX_DERIVATIVE_WITHIN; +"HAS_REAL_DERIVATIVE_ACS",HAS_REAL_DERIVATIVE_ACS; +"HAS_REAL_DERIVATIVE_ACS_SIN",HAS_REAL_DERIVATIVE_ACS_SIN; +"HAS_REAL_DERIVATIVE_ADD",HAS_REAL_DERIVATIVE_ADD; +"HAS_REAL_DERIVATIVE_ASN",HAS_REAL_DERIVATIVE_ASN; +"HAS_REAL_DERIVATIVE_ASN_COS",HAS_REAL_DERIVATIVE_ASN_COS; +"HAS_REAL_DERIVATIVE_ATN",HAS_REAL_DERIVATIVE_ATN; +"HAS_REAL_DERIVATIVE_ATREAL",HAS_REAL_DERIVATIVE_ATREAL; +"HAS_REAL_DERIVATIVE_ATREAL_WITHIN",HAS_REAL_DERIVATIVE_ATREAL_WITHIN; +"HAS_REAL_DERIVATIVE_BERNOULLI",HAS_REAL_DERIVATIVE_BERNOULLI; +"HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL",HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL; +"HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL",HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL; +"HAS_REAL_DERIVATIVE_CDIV_ATREAL",HAS_REAL_DERIVATIVE_CDIV_ATREAL; +"HAS_REAL_DERIVATIVE_CDIV_WITHIN",HAS_REAL_DERIVATIVE_CDIV_WITHIN; +"HAS_REAL_DERIVATIVE_CHAIN",HAS_REAL_DERIVATIVE_CHAIN; +"HAS_REAL_DERIVATIVE_CHAIN_UNIV",HAS_REAL_DERIVATIVE_CHAIN_UNIV; +"HAS_REAL_DERIVATIVE_CONST",HAS_REAL_DERIVATIVE_CONST; +"HAS_REAL_DERIVATIVE_COS",HAS_REAL_DERIVATIVE_COS; +"HAS_REAL_DERIVATIVE_DERIVATIVE",HAS_REAL_DERIVATIVE_DERIVATIVE; +"HAS_REAL_DERIVATIVE_DIFFERENTIABLE",HAS_REAL_DERIVATIVE_DIFFERENTIABLE; +"HAS_REAL_DERIVATIVE_DIV_ATREAL",HAS_REAL_DERIVATIVE_DIV_ATREAL; +"HAS_REAL_DERIVATIVE_DIV_WITHIN",HAS_REAL_DERIVATIVE_DIV_WITHIN; +"HAS_REAL_DERIVATIVE_EXP",HAS_REAL_DERIVATIVE_EXP; +"HAS_REAL_DERIVATIVE_FRAC",HAS_REAL_DERIVATIVE_FRAC; +"HAS_REAL_DERIVATIVE_ID",HAS_REAL_DERIVATIVE_ID; +"HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL",HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL; +"HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL",HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL; +"HAS_REAL_DERIVATIVE_INCREASING",HAS_REAL_DERIVATIVE_INCREASING; +"HAS_REAL_DERIVATIVE_INCREASING_IMP",HAS_REAL_DERIVATIVE_INCREASING_IMP; +"HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL",HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL; +"HAS_REAL_DERIVATIVE_INVERSE_BASIC",HAS_REAL_DERIVATIVE_INVERSE_BASIC; +"HAS_REAL_DERIVATIVE_INVERSE_STRONG",HAS_REAL_DERIVATIVE_INVERSE_STRONG; +"HAS_REAL_DERIVATIVE_INVERSE_STRONG_X",HAS_REAL_DERIVATIVE_INVERSE_STRONG_X; +"HAS_REAL_DERIVATIVE_INV_ATREAL",HAS_REAL_DERIVATIVE_INV_ATREAL; +"HAS_REAL_DERIVATIVE_INV_BASIC",HAS_REAL_DERIVATIVE_INV_BASIC; +"HAS_REAL_DERIVATIVE_INV_WITHIN",HAS_REAL_DERIVATIVE_INV_WITHIN; +"HAS_REAL_DERIVATIVE_LMUL_ATREAL",HAS_REAL_DERIVATIVE_LMUL_ATREAL; +"HAS_REAL_DERIVATIVE_LMUL_WITHIN",HAS_REAL_DERIVATIVE_LMUL_WITHIN; +"HAS_REAL_DERIVATIVE_LOG",HAS_REAL_DERIVATIVE_LOG; +"HAS_REAL_DERIVATIVE_MUL_ATREAL",HAS_REAL_DERIVATIVE_MUL_ATREAL; +"HAS_REAL_DERIVATIVE_MUL_WITHIN",HAS_REAL_DERIVATIVE_MUL_WITHIN; +"HAS_REAL_DERIVATIVE_NEG",HAS_REAL_DERIVATIVE_NEG; +"HAS_REAL_DERIVATIVE_POW_ATREAL",HAS_REAL_DERIVATIVE_POW_ATREAL; +"HAS_REAL_DERIVATIVE_POW_WITHIN",HAS_REAL_DERIVATIVE_POW_WITHIN; +"HAS_REAL_DERIVATIVE_RMUL_ATREAL",HAS_REAL_DERIVATIVE_RMUL_ATREAL; +"HAS_REAL_DERIVATIVE_RMUL_WITHIN",HAS_REAL_DERIVATIVE_RMUL_WITHIN; +"HAS_REAL_DERIVATIVE_RPOW",HAS_REAL_DERIVATIVE_RPOW; +"HAS_REAL_DERIVATIVE_RPOW_RIGHT",HAS_REAL_DERIVATIVE_RPOW_RIGHT; +"HAS_REAL_DERIVATIVE_SEQUENCE",HAS_REAL_DERIVATIVE_SEQUENCE; +"HAS_REAL_DERIVATIVE_SERIES",HAS_REAL_DERIVATIVE_SERIES; +"HAS_REAL_DERIVATIVE_SIN",HAS_REAL_DERIVATIVE_SIN; +"HAS_REAL_DERIVATIVE_SQRT",HAS_REAL_DERIVATIVE_SQRT; +"HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP",HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP; +"HAS_REAL_DERIVATIVE_SUB",HAS_REAL_DERIVATIVE_SUB; +"HAS_REAL_DERIVATIVE_SUM",HAS_REAL_DERIVATIVE_SUM; +"HAS_REAL_DERIVATIVE_TAN",HAS_REAL_DERIVATIVE_TAN; +"HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL",HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL; +"HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN",HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN; +"HAS_REAL_DERIVATIVE_WITHINREAL",HAS_REAL_DERIVATIVE_WITHINREAL; +"HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN",HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN; +"HAS_REAL_DERIVATIVE_WITHIN_SUBSET",HAS_REAL_DERIVATIVE_WITHIN_SUBSET; +"HAS_REAL_DERIVATIVE_ZERO_CONSTANT",HAS_REAL_DERIVATIVE_ZERO_CONSTANT; +"HAS_REAL_DERIVATIVE_ZERO_UNIQUE",HAS_REAL_DERIVATIVE_ZERO_UNIQUE; +"HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX",HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX; +"HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL; +"HAS_REAL_FRECHET_DERIVATIVE_AT",HAS_REAL_FRECHET_DERIVATIVE_AT; +"HAS_REAL_FRECHET_DERIVATIVE_WITHIN",HAS_REAL_FRECHET_DERIVATIVE_WITHIN; +"HAS_REAL_INTEGRAL",HAS_REAL_INTEGRAL; +"HAS_REAL_INTEGRAL_0",HAS_REAL_INTEGRAL_0; +"HAS_REAL_INTEGRAL_0_EQ",HAS_REAL_INTEGRAL_0_EQ; +"HAS_REAL_INTEGRAL_ADD",HAS_REAL_INTEGRAL_ADD; +"HAS_REAL_INTEGRAL_AFFINITY",HAS_REAL_INTEGRAL_AFFINITY; +"HAS_REAL_INTEGRAL_ALT",HAS_REAL_INTEGRAL_ALT; +"HAS_REAL_INTEGRAL_BERNOULLI",HAS_REAL_INTEGRAL_BERNOULLI; +"HAS_REAL_INTEGRAL_BOUND",HAS_REAL_INTEGRAL_BOUND; +"HAS_REAL_INTEGRAL_COMBINE",HAS_REAL_INTEGRAL_COMBINE; +"HAS_REAL_INTEGRAL_CONST",HAS_REAL_INTEGRAL_CONST; +"HAS_REAL_INTEGRAL_EMPTY",HAS_REAL_INTEGRAL_EMPTY; +"HAS_REAL_INTEGRAL_EMPTY_EQ",HAS_REAL_INTEGRAL_EMPTY_EQ; +"HAS_REAL_INTEGRAL_EQ",HAS_REAL_INTEGRAL_EQ; +"HAS_REAL_INTEGRAL_EQ_EQ",HAS_REAL_INTEGRAL_EQ_EQ; +"HAS_REAL_INTEGRAL_INTEGRABLE",HAS_REAL_INTEGRAL_INTEGRABLE; +"HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL; +"HAS_REAL_INTEGRAL_INTEGRAL",HAS_REAL_INTEGRAL_INTEGRAL; +"HAS_REAL_INTEGRAL_ISNEG",HAS_REAL_INTEGRAL_ISNEG; +"HAS_REAL_INTEGRAL_IS_0",HAS_REAL_INTEGRAL_IS_0; +"HAS_REAL_INTEGRAL_LBOUND",HAS_REAL_INTEGRAL_LBOUND; +"HAS_REAL_INTEGRAL_LE",HAS_REAL_INTEGRAL_LE; +"HAS_REAL_INTEGRAL_LINEAR",HAS_REAL_INTEGRAL_LINEAR; +"HAS_REAL_INTEGRAL_LMUL",HAS_REAL_INTEGRAL_LMUL; +"HAS_REAL_INTEGRAL_NEG",HAS_REAL_INTEGRAL_NEG; +"HAS_REAL_INTEGRAL_NEGLIGIBLE",HAS_REAL_INTEGRAL_NEGLIGIBLE; +"HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ",HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ; +"HAS_REAL_INTEGRAL_NULL",HAS_REAL_INTEGRAL_NULL; +"HAS_REAL_INTEGRAL_NULL_EQ",HAS_REAL_INTEGRAL_NULL_EQ; +"HAS_REAL_INTEGRAL_ON_SUPERSET",HAS_REAL_INTEGRAL_ON_SUPERSET; +"HAS_REAL_INTEGRAL_OPEN_INTERVAL",HAS_REAL_INTEGRAL_OPEN_INTERVAL; +"HAS_REAL_INTEGRAL_POS",HAS_REAL_INTEGRAL_POS; +"HAS_REAL_INTEGRAL_REFL",HAS_REAL_INTEGRAL_REFL; +"HAS_REAL_INTEGRAL_REFLECT",HAS_REAL_INTEGRAL_REFLECT; +"HAS_REAL_INTEGRAL_REFLECT_GEN",HAS_REAL_INTEGRAL_REFLECT_GEN; +"HAS_REAL_INTEGRAL_REFLECT_LEMMA",HAS_REAL_INTEGRAL_REFLECT_LEMMA; +"HAS_REAL_INTEGRAL_RESTRICT",HAS_REAL_INTEGRAL_RESTRICT; +"HAS_REAL_INTEGRAL_RESTRICT_INTER",HAS_REAL_INTEGRAL_RESTRICT_INTER; +"HAS_REAL_INTEGRAL_RESTRICT_UNIV",HAS_REAL_INTEGRAL_RESTRICT_UNIV; +"HAS_REAL_INTEGRAL_RMUL",HAS_REAL_INTEGRAL_RMUL; +"HAS_REAL_INTEGRAL_SPIKE",HAS_REAL_INTEGRAL_SPIKE; +"HAS_REAL_INTEGRAL_SPIKE_EQ",HAS_REAL_INTEGRAL_SPIKE_EQ; +"HAS_REAL_INTEGRAL_SPIKE_FINITE",HAS_REAL_INTEGRAL_SPIKE_FINITE; +"HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ",HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ; +"HAS_REAL_INTEGRAL_SPIKE_INTERIOR",HAS_REAL_INTEGRAL_SPIKE_INTERIOR; +"HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ",HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ; +"HAS_REAL_INTEGRAL_SPIKE_SET",HAS_REAL_INTEGRAL_SPIKE_SET; +"HAS_REAL_INTEGRAL_SPIKE_SET_EQ",HAS_REAL_INTEGRAL_SPIKE_SET_EQ; +"HAS_REAL_INTEGRAL_STRADDLE_NULL",HAS_REAL_INTEGRAL_STRADDLE_NULL; +"HAS_REAL_INTEGRAL_STRETCH",HAS_REAL_INTEGRAL_STRETCH; +"HAS_REAL_INTEGRAL_SUB",HAS_REAL_INTEGRAL_SUB; +"HAS_REAL_INTEGRAL_SUBSET_LE",HAS_REAL_INTEGRAL_SUBSET_LE; +"HAS_REAL_INTEGRAL_SUBSTITUTION",HAS_REAL_INTEGRAL_SUBSTITUTION; +"HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE",HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE; +"HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG",HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG; +"HAS_REAL_INTEGRAL_SUM",HAS_REAL_INTEGRAL_SUM; +"HAS_REAL_INTEGRAL_UBOUND",HAS_REAL_INTEGRAL_UBOUND; +"HAS_REAL_INTEGRAL_UNION",HAS_REAL_INTEGRAL_UNION; +"HAS_REAL_INTEGRAL_UNIONS",HAS_REAL_INTEGRAL_UNIONS; +"HAS_REAL_INTEGRAL_UNIQUE",HAS_REAL_INTEGRAL_UNIQUE; +"HAS_REAL_MEASURE",HAS_REAL_MEASURE; +"HAS_REAL_MEASURE_0",HAS_REAL_MEASURE_0; +"HAS_REAL_MEASURE_AFFINITY",HAS_REAL_MEASURE_AFFINITY; +"HAS_REAL_MEASURE_ALMOST",HAS_REAL_MEASURE_ALMOST; +"HAS_REAL_MEASURE_ALMOST_EQ",HAS_REAL_MEASURE_ALMOST_EQ; +"HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS",HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS; +"HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED",HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED; +"HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE",HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE; +"HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ",HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ; +"HAS_REAL_MEASURE_DIFF_SUBSET",HAS_REAL_MEASURE_DIFF_SUBSET; +"HAS_REAL_MEASURE_DISJOINT_UNION",HAS_REAL_MEASURE_DISJOINT_UNION; +"HAS_REAL_MEASURE_DISJOINT_UNIONS",HAS_REAL_MEASURE_DISJOINT_UNIONS; +"HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE",HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE; +"HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; +"HAS_REAL_MEASURE_EMPTY",HAS_REAL_MEASURE_EMPTY; +"HAS_REAL_MEASURE_HAS_MEASURE",HAS_REAL_MEASURE_HAS_MEASURE; +"HAS_REAL_MEASURE_IMP_REAL_MEASURABLE",HAS_REAL_MEASURE_IMP_REAL_MEASURABLE; +"HAS_REAL_MEASURE_INNER_OUTER",HAS_REAL_MEASURE_INNER_OUTER; +"HAS_REAL_MEASURE_INNER_OUTER_LE",HAS_REAL_MEASURE_INNER_OUTER_LE; +"HAS_REAL_MEASURE_MEASURE",HAS_REAL_MEASURE_MEASURE; +"HAS_REAL_MEASURE_NESTED_UNIONS",HAS_REAL_MEASURE_NESTED_UNIONS; +"HAS_REAL_MEASURE_POS_LE",HAS_REAL_MEASURE_POS_LE; +"HAS_REAL_MEASURE_REAL_INTERVAL",HAS_REAL_MEASURE_REAL_INTERVAL; +"HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE",HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE; +"HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; +"HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION; +"HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS; +"HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE; +"HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG",HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG; +"HAS_REAL_MEASURE_SCALING",HAS_REAL_MEASURE_SCALING; +"HAS_REAL_MEASURE_SCALING_EQ",HAS_REAL_MEASURE_SCALING_EQ; +"HAS_REAL_MEASURE_SUBSET",HAS_REAL_MEASURE_SUBSET; +"HAS_REAL_MEASURE_TRANSLATION",HAS_REAL_MEASURE_TRANSLATION; +"HAS_REAL_MEASURE_TRANSLATION_EQ",HAS_REAL_MEASURE_TRANSLATION_EQ; +"HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE",HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE; +"HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ",HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ; +"HAS_REAL_MEASURE_UNIQUE",HAS_REAL_MEASURE_UNIQUE; +"HAS_REAL_VECTOR_DERIVATIVE_AT",HAS_REAL_VECTOR_DERIVATIVE_AT; +"HAS_REAL_VECTOR_DERIVATIVE_WITHIN",HAS_REAL_VECTOR_DERIVATIVE_WITHIN; +"HAS_SIZE",HAS_SIZE; +"HAS_SIZE_0",HAS_SIZE_0; +"HAS_SIZE_1",HAS_SIZE_1; +"HAS_SIZE_1_EXISTS",HAS_SIZE_1_EXISTS; +"HAS_SIZE_2",HAS_SIZE_2; +"HAS_SIZE_2_EXISTS",HAS_SIZE_2_EXISTS; +"HAS_SIZE_3",HAS_SIZE_3; +"HAS_SIZE_4",HAS_SIZE_4; +"HAS_SIZE_BOOL",HAS_SIZE_BOOL; +"HAS_SIZE_CARD",HAS_SIZE_CARD; +"HAS_SIZE_CART_UNIV",HAS_SIZE_CART_UNIV; +"HAS_SIZE_CLAUSES",HAS_SIZE_CLAUSES; +"HAS_SIZE_COMPLEX_ROOTS_UNITY",HAS_SIZE_COMPLEX_ROOTS_UNITY; +"HAS_SIZE_CROSS",HAS_SIZE_CROSS; +"HAS_SIZE_DIFF",HAS_SIZE_DIFF; +"HAS_SIZE_FACES_OF_SIMPLEX",HAS_SIZE_FACES_OF_SIMPLEX; +"HAS_SIZE_FINITE_IMAGE",HAS_SIZE_FINITE_IMAGE; +"HAS_SIZE_FUNSPACE",HAS_SIZE_FUNSPACE; +"HAS_SIZE_FUNSPACE_UNIV",HAS_SIZE_FUNSPACE_UNIV; +"HAS_SIZE_IMAGE_INJ",HAS_SIZE_IMAGE_INJ; +"HAS_SIZE_IMAGE_INJ_EQ",HAS_SIZE_IMAGE_INJ_EQ; +"HAS_SIZE_INDEX",HAS_SIZE_INDEX; +"HAS_SIZE_INTSEG_INT",HAS_SIZE_INTSEG_INT; +"HAS_SIZE_INTSEG_NUM",HAS_SIZE_INTSEG_NUM; +"HAS_SIZE_MULTIVECTOR",HAS_SIZE_MULTIVECTOR; +"HAS_SIZE_NUMSEG",HAS_SIZE_NUMSEG; +"HAS_SIZE_NUMSEG_1",HAS_SIZE_NUMSEG_1; +"HAS_SIZE_NUMSEG_LE",HAS_SIZE_NUMSEG_LE; +"HAS_SIZE_NUMSEG_LT",HAS_SIZE_NUMSEG_LT; +"HAS_SIZE_PCROSS",HAS_SIZE_PCROSS; +"HAS_SIZE_PERMUTATIONS",HAS_SIZE_PERMUTATIONS; +"HAS_SIZE_POWERSET",HAS_SIZE_POWERSET; +"HAS_SIZE_PRODUCT",HAS_SIZE_PRODUCT; +"HAS_SIZE_PRODUCT_DEPENDENT",HAS_SIZE_PRODUCT_DEPENDENT; +"HAS_SIZE_SET_OF_LIST",HAS_SIZE_SET_OF_LIST; +"HAS_SIZE_STDBASIS",HAS_SIZE_STDBASIS; +"HAS_SIZE_SUC",HAS_SIZE_SUC; +"HAS_SIZE_UNION",HAS_SIZE_UNION; +"HAS_SIZE_UNIONS",HAS_SIZE_UNIONS; +"HAS_VECTOR_DERIVATIVE_ADD",HAS_VECTOR_DERIVATIVE_ADD; +"HAS_VECTOR_DERIVATIVE_AT_WITHIN",HAS_VECTOR_DERIVATIVE_AT_WITHIN; +"HAS_VECTOR_DERIVATIVE_BILINEAR_AT",HAS_VECTOR_DERIVATIVE_BILINEAR_AT; +"HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN",HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN; +"HAS_VECTOR_DERIVATIVE_CIRCLEPATH",HAS_VECTOR_DERIVATIVE_CIRCLEPATH; +"HAS_VECTOR_DERIVATIVE_CMUL",HAS_VECTOR_DERIVATIVE_CMUL; +"HAS_VECTOR_DERIVATIVE_CMUL_EQ",HAS_VECTOR_DERIVATIVE_CMUL_EQ; +"HAS_VECTOR_DERIVATIVE_CONST",HAS_VECTOR_DERIVATIVE_CONST; +"HAS_VECTOR_DERIVATIVE_ID",HAS_VECTOR_DERIVATIVE_ID; +"HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL",HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL; +"HAS_VECTOR_DERIVATIVE_LINEPATH_AT",HAS_VECTOR_DERIVATIVE_LINEPATH_AT; +"HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN",HAS_VECTOR_DERIVATIVE_LINEPATH_WITHIN; +"HAS_VECTOR_DERIVATIVE_NEG",HAS_VECTOR_DERIVATIVE_NEG; +"HAS_VECTOR_DERIVATIVE_NEG_EQ",HAS_VECTOR_DERIVATIVE_NEG_EQ; +"HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH",HAS_VECTOR_DERIVATIVE_PARTCIRCLEPATH; +"HAS_VECTOR_DERIVATIVE_REAL_COMPLEX",HAS_VECTOR_DERIVATIVE_REAL_COMPLEX; +"HAS_VECTOR_DERIVATIVE_SUB",HAS_VECTOR_DERIVATIVE_SUB; +"HAS_VECTOR_DERIVATIVE_TRANSFORM_AT",HAS_VECTOR_DERIVATIVE_TRANSFORM_AT; +"HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN; +"HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"HAS_VECTOR_DERIVATIVE_UNIQUE_AT",HAS_VECTOR_DERIVATIVE_UNIQUE_AT; +"HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION",HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION; +"HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET",HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; +"HAUSDIST_ALT",HAUSDIST_ALT; +"HAUSDIST_BALLS",HAUSDIST_BALLS; +"HAUSDIST_CLOSURE",HAUSDIST_CLOSURE; +"HAUSDIST_COMPACT_EXISTS",HAUSDIST_COMPACT_EXISTS; +"HAUSDIST_COMPACT_NONTRIVIAL",HAUSDIST_COMPACT_NONTRIVIAL; +"HAUSDIST_COMPACT_SUMS",HAUSDIST_COMPACT_SUMS; +"HAUSDIST_CONVEX_HULLS",HAUSDIST_CONVEX_HULLS; +"HAUSDIST_EMPTY",HAUSDIST_EMPTY; +"HAUSDIST_EQ",HAUSDIST_EQ; +"HAUSDIST_EQ_0",HAUSDIST_EQ_0; +"HAUSDIST_LINEAR_IMAGE",HAUSDIST_LINEAR_IMAGE; +"HAUSDIST_NONTRIVIAL",HAUSDIST_NONTRIVIAL; +"HAUSDIST_NONTRIVIAL_ALT",HAUSDIST_NONTRIVIAL_ALT; +"HAUSDIST_POS_LE",HAUSDIST_POS_LE; +"HAUSDIST_REFL",HAUSDIST_REFL; +"HAUSDIST_SINGS",HAUSDIST_SINGS; +"HAUSDIST_SUMS",HAUSDIST_SUMS; +"HAUSDIST_SYM",HAUSDIST_SYM; +"HAUSDIST_TRANS",HAUSDIST_TRANS; +"HAUSDIST_TRANSLATION",HAUSDIST_TRANSLATION; +"HD",HD; +"HD_APPEND",HD_APPEND; +"HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS",HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS; +"HEINE_BOREL_LEMMA",HEINE_BOREL_LEMMA; +"HELLY",HELLY; +"HELLY_ALT",HELLY_ALT; +"HELLY_CLOSED",HELLY_CLOSED; +"HELLY_CLOSED_ALT",HELLY_CLOSED_ALT; +"HELLY_COMPACT",HELLY_COMPACT; +"HELLY_COMPACT_ALT",HELLY_COMPACT_ALT; +"HELLY_INDUCT",HELLY_INDUCT; +"HENSTOCK_LEMMA",HENSTOCK_LEMMA; +"HENSTOCK_LEMMA_PART1",HENSTOCK_LEMMA_PART1; +"HENSTOCK_LEMMA_PART2",HENSTOCK_LEMMA_PART2; +"HIGHER_COMPLEX_DERIVATIVE_1",HIGHER_COMPLEX_DERIVATIVE_1; +"HIGHER_COMPLEX_DERIVATIVE_ADD",HIGHER_COMPLEX_DERIVATIVE_ADD; +"HIGHER_COMPLEX_DERIVATIVE_ADD_AT",HIGHER_COMPLEX_DERIVATIVE_ADD_AT; +"HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR",HIGHER_COMPLEX_DERIVATIVE_COMPOSE_LINEAR; +"HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA",HIGHER_COMPLEX_DERIVATIVE_COMP_ITER_LEMMA; +"HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA",HIGHER_COMPLEX_DERIVATIVE_COMP_LEMMA; +"HIGHER_COMPLEX_DERIVATIVE_CONST",HIGHER_COMPLEX_DERIVATIVE_CONST; +"HIGHER_COMPLEX_DERIVATIVE_EQ_ITER",HIGHER_COMPLEX_DERIVATIVE_EQ_ITER; +"HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE",HIGHER_COMPLEX_DERIVATIVE_HIGHER_COMPLEX_DERIVATIVE; +"HIGHER_COMPLEX_DERIVATIVE_ID",HIGHER_COMPLEX_DERIVATIVE_ID; +"HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA",HIGHER_COMPLEX_DERIVATIVE_ITER_TOP_LEMMA; +"HIGHER_COMPLEX_DERIVATIVE_LINEAR",HIGHER_COMPLEX_DERIVATIVE_LINEAR; +"HIGHER_COMPLEX_DERIVATIVE_MUL",HIGHER_COMPLEX_DERIVATIVE_MUL; +"HIGHER_COMPLEX_DERIVATIVE_MUL_AT",HIGHER_COMPLEX_DERIVATIVE_MUL_AT; +"HIGHER_COMPLEX_DERIVATIVE_NEG",HIGHER_COMPLEX_DERIVATIVE_NEG; +"HIGHER_COMPLEX_DERIVATIVE_NEG_AT",HIGHER_COMPLEX_DERIVATIVE_NEG_AT; +"HIGHER_COMPLEX_DERIVATIVE_POWER_SERIES",HIGHER_COMPLEX_DERIVATIVE_POWER_SERIES; +"HIGHER_COMPLEX_DERIVATIVE_SUB",HIGHER_COMPLEX_DERIVATIVE_SUB; +"HIGHER_COMPLEX_DERIVATIVE_SUB_AT",HIGHER_COMPLEX_DERIVATIVE_SUB_AT; +"HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HIGHER_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"HOELDER",HOELDER; +"HOLOMORPHIC_COMPLEX_DERIVATIVE",HOLOMORPHIC_COMPLEX_DERIVATIVE; +"HOLOMORPHIC_CONVEX_PRIMITIVE",HOLOMORPHIC_CONVEX_PRIMITIVE; +"HOLOMORPHIC_DERIVATIVE",HOLOMORPHIC_DERIVATIVE; +"HOLOMORPHIC_EQ",HOLOMORPHIC_EQ; +"HOLOMORPHIC_FACTOR_ORDER_OF_ZERO",HOLOMORPHIC_FACTOR_ORDER_OF_ZERO; +"HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG",HOLOMORPHIC_FACTOR_ORDER_OF_ZERO_STRONG; +"HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT",HOLOMORPHIC_FACTOR_ZERO_NONCONSTANT; +"HOLOMORPHIC_FUN_EQ_0_ON_BALL",HOLOMORPHIC_FUN_EQ_0_ON_BALL; +"HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED",HOLOMORPHIC_FUN_EQ_0_ON_CONNECTED; +"HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED",HOLOMORPHIC_FUN_EQ_CONST_ON_CONNECTED; +"HOLOMORPHIC_FUN_EQ_ON_BALL",HOLOMORPHIC_FUN_EQ_ON_BALL; +"HOLOMORPHIC_FUN_EQ_ON_CONNECTED",HOLOMORPHIC_FUN_EQ_ON_CONNECTED; +"HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE",HOLOMORPHIC_HIGHER_COMPLEX_DERIVATIVE; +"HOLOMORPHIC_IFF_POWER_SERIES",HOLOMORPHIC_IFF_POWER_SERIES; +"HOLOMORPHIC_INJECTIVE_IMP_REGULAR",HOLOMORPHIC_INJECTIVE_IMP_REGULAR; +"HOLOMORPHIC_INVOLUTION_POINT",HOLOMORPHIC_INVOLUTION_POINT; +"HOLOMORPHIC_LOWER_BOUND_DIFFERENCE",HOLOMORPHIC_LOWER_BOUND_DIFFERENCE; +"HOLOMORPHIC_ON_ADD",HOLOMORPHIC_ON_ADD; +"HOLOMORPHIC_ON_CACS",HOLOMORPHIC_ON_CACS; +"HOLOMORPHIC_ON_CASN",HOLOMORPHIC_ON_CASN; +"HOLOMORPHIC_ON_CATN",HOLOMORPHIC_ON_CATN; +"HOLOMORPHIC_ON_CCOS",HOLOMORPHIC_ON_CCOS; +"HOLOMORPHIC_ON_CEXP",HOLOMORPHIC_ON_CEXP; +"HOLOMORPHIC_ON_CLOG",HOLOMORPHIC_ON_CLOG; +"HOLOMORPHIC_ON_COMPOSE",HOLOMORPHIC_ON_COMPOSE; +"HOLOMORPHIC_ON_COMPOSE_GEN",HOLOMORPHIC_ON_COMPOSE_GEN; +"HOLOMORPHIC_ON_CONST",HOLOMORPHIC_ON_CONST; +"HOLOMORPHIC_ON_CPOW_RIGHT",HOLOMORPHIC_ON_CPOW_RIGHT; +"HOLOMORPHIC_ON_CPRODUCT",HOLOMORPHIC_ON_CPRODUCT; +"HOLOMORPHIC_ON_CSIN",HOLOMORPHIC_ON_CSIN; +"HOLOMORPHIC_ON_CSQRT",HOLOMORPHIC_ON_CSQRT; +"HOLOMORPHIC_ON_CTAN",HOLOMORPHIC_ON_CTAN; +"HOLOMORPHIC_ON_DIFFERENTIABLE",HOLOMORPHIC_ON_DIFFERENTIABLE; +"HOLOMORPHIC_ON_DIV",HOLOMORPHIC_ON_DIV; +"HOLOMORPHIC_ON_EMPTY",HOLOMORPHIC_ON_EMPTY; +"HOLOMORPHIC_ON_EXTEND_BOUNDED",HOLOMORPHIC_ON_EXTEND_BOUNDED; +"HOLOMORPHIC_ON_EXTEND_LIM",HOLOMORPHIC_ON_EXTEND_LIM; +"HOLOMORPHIC_ON_ID",HOLOMORPHIC_ON_ID; +"HOLOMORPHIC_ON_IMP_CONTINUOUS_ON",HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; +"HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT",HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT; +"HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN",HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_WITHIN; +"HOLOMORPHIC_ON_INV",HOLOMORPHIC_ON_INV; +"HOLOMORPHIC_ON_INVERSE",HOLOMORPHIC_ON_INVERSE; +"HOLOMORPHIC_ON_LINEAR",HOLOMORPHIC_ON_LINEAR; +"HOLOMORPHIC_ON_LMUL",HOLOMORPHIC_ON_LMUL; +"HOLOMORPHIC_ON_MUL",HOLOMORPHIC_ON_MUL; +"HOLOMORPHIC_ON_NEG",HOLOMORPHIC_ON_NEG; +"HOLOMORPHIC_ON_OPEN",HOLOMORPHIC_ON_OPEN; +"HOLOMORPHIC_ON_PASTE_ACROSS_LINE",HOLOMORPHIC_ON_PASTE_ACROSS_LINE; +"HOLOMORPHIC_ON_POW",HOLOMORPHIC_ON_POW; +"HOLOMORPHIC_ON_RMUL",HOLOMORPHIC_ON_RMUL; +"HOLOMORPHIC_ON_SUB",HOLOMORPHIC_ON_SUB; +"HOLOMORPHIC_ON_SUBSET",HOLOMORPHIC_ON_SUBSET; +"HOLOMORPHIC_ON_VSUM",HOLOMORPHIC_ON_VSUM; +"HOLOMORPHIC_PERIODIC_FIXPOINT",HOLOMORPHIC_PERIODIC_FIXPOINT; +"HOLOMORPHIC_POINT_SMALL_TRIANGLE",HOLOMORPHIC_POINT_SMALL_TRIANGLE; +"HOLOMORPHIC_POWER_SERIES",HOLOMORPHIC_POWER_SERIES; +"HOLOMORPHIC_STARLIKE_PRIMITIVE",HOLOMORPHIC_STARLIKE_PRIMITIVE; +"HOLOMORPHIC_TRANSFORM",HOLOMORPHIC_TRANSFORM; +"HOLOMORPHIC_UNIFORM_LIMIT",HOLOMORPHIC_UNIFORM_LIMIT; +"HOLOMORPHIC_UNIFORM_SEQUENCE",HOLOMORPHIC_UNIFORM_SEQUENCE; +"HOMEOMORPHIC_AFFINE_SETS",HOMEOMORPHIC_AFFINE_SETS; +"HOMEOMORPHIC_AFFINE_SETS_EQ",HOMEOMORPHIC_AFFINE_SETS_EQ; +"HOMEOMORPHIC_AFFINITY",HOMEOMORPHIC_AFFINITY; +"HOMEOMORPHIC_ANRNESS",HOMEOMORPHIC_ANRNESS; +"HOMEOMORPHIC_ARC_IMAGES",HOMEOMORPHIC_ARC_IMAGES; +"HOMEOMORPHIC_ARC_IMAGE_INTERVAL",HOMEOMORPHIC_ARC_IMAGE_INTERVAL; +"HOMEOMORPHIC_ARC_IMAGE_SEGMENT",HOMEOMORPHIC_ARC_IMAGE_SEGMENT; +"HOMEOMORPHIC_ARNESS",HOMEOMORPHIC_ARNESS; +"HOMEOMORPHIC_BALLS",HOMEOMORPHIC_BALLS; +"HOMEOMORPHIC_BALLS_EQ",HOMEOMORPHIC_BALLS_EQ; +"HOMEOMORPHIC_BALL_UNIV",HOMEOMORPHIC_BALL_UNIV; +"HOMEOMORPHIC_BORSUKIAN",HOMEOMORPHIC_BORSUKIAN; +"HOMEOMORPHIC_BORSUKIAN_EQ",HOMEOMORPHIC_BORSUKIAN_EQ; +"HOMEOMORPHIC_CBALLS",HOMEOMORPHIC_CBALLS; +"HOMEOMORPHIC_CBALLS_EQ",HOMEOMORPHIC_CBALLS_EQ; +"HOMEOMORPHIC_CLOSED_INTERVALS",HOMEOMORPHIC_CLOSED_INTERVALS; +"HOMEOMORPHIC_CLOSED_IN_CONVEX",HOMEOMORPHIC_CLOSED_IN_CONVEX; +"HOMEOMORPHIC_COMPACT",HOMEOMORPHIC_COMPACT; +"HOMEOMORPHIC_COMPACTNESS",HOMEOMORPHIC_COMPACTNESS; +"HOMEOMORPHIC_COMPACT_ARNESS",HOMEOMORPHIC_COMPACT_ARNESS; +"HOMEOMORPHIC_CONNECTEDNESS",HOMEOMORPHIC_CONNECTEDNESS; +"HOMEOMORPHIC_CONTRACTIBLE",HOMEOMORPHIC_CONTRACTIBLE; +"HOMEOMORPHIC_CONTRACTIBLE_EQ",HOMEOMORPHIC_CONTRACTIBLE_EQ; +"HOMEOMORPHIC_CONVEX_COMPACT",HOMEOMORPHIC_CONVEX_COMPACT; +"HOMEOMORPHIC_CONVEX_COMPACT_CBALL",HOMEOMORPHIC_CONVEX_COMPACT_CBALL; +"HOMEOMORPHIC_CONVEX_COMPACT_SETS",HOMEOMORPHIC_CONVEX_COMPACT_SETS; +"HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ",HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; +"HOMEOMORPHIC_CONVEX_SETS",HOMEOMORPHIC_CONVEX_SETS; +"HOMEOMORPHIC_EMPTY",HOMEOMORPHIC_EMPTY; +"HOMEOMORPHIC_ENRNESS",HOMEOMORPHIC_ENRNESS; +"HOMEOMORPHIC_FINITE",HOMEOMORPHIC_FINITE; +"HOMEOMORPHIC_FINITE_STRONG",HOMEOMORPHIC_FINITE_STRONG; +"HOMEOMORPHIC_FIXPOINT_PROPERTY",HOMEOMORPHIC_FIXPOINT_PROPERTY; +"HOMEOMORPHIC_FRONTIERS",HOMEOMORPHIC_FRONTIERS; +"HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION",HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION; +"HOMEOMORPHIC_HYPERPLANES",HOMEOMORPHIC_HYPERPLANES; +"HOMEOMORPHIC_HYPERPLANES_EQ",HOMEOMORPHIC_HYPERPLANES_EQ; +"HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE",HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE; +"HOMEOMORPHIC_HYPERPLANE_UNIV",HOMEOMORPHIC_HYPERPLANE_UNIV; +"HOMEOMORPHIC_IMP_CARD_EQ",HOMEOMORPHIC_IMP_CARD_EQ; +"HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT",HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; +"HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; +"HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; +"HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; +"HOMEOMORPHIC_INTERIORS",HOMEOMORPHIC_INTERIORS; +"HOMEOMORPHIC_INTERIORS_SAME_DIMENSION",HOMEOMORPHIC_INTERIORS_SAME_DIMENSION; +"HOMEOMORPHIC_INTERVALS_EQ",HOMEOMORPHIC_INTERVALS_EQ; +"HOMEOMORPHIC_LOCALLY",HOMEOMORPHIC_LOCALLY; +"HOMEOMORPHIC_LOCAL_COMPACTNESS",HOMEOMORPHIC_LOCAL_COMPACTNESS; +"HOMEOMORPHIC_LOCAL_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_CONNECTEDNESS; +"HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS; +"HOMEOMORPHIC_MINIMAL",HOMEOMORPHIC_MINIMAL; +"HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL",HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL; +"HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS",HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS; +"HOMEOMORPHIC_OPEN_INTERVALS",HOMEOMORPHIC_OPEN_INTERVALS; +"HOMEOMORPHIC_OPEN_INTERVALS_1",HOMEOMORPHIC_OPEN_INTERVALS_1; +"HOMEOMORPHIC_OPEN_INTERVAL_UNIV",HOMEOMORPHIC_OPEN_INTERVAL_UNIV; +"HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1",HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; +"HOMEOMORPHIC_PATH_CONNECTEDNESS",HOMEOMORPHIC_PATH_CONNECTEDNESS; +"HOMEOMORPHIC_PCROSS",HOMEOMORPHIC_PCROSS; +"HOMEOMORPHIC_PCROSS_ASSOC",HOMEOMORPHIC_PCROSS_ASSOC; +"HOMEOMORPHIC_PCROSS_SING",HOMEOMORPHIC_PCROSS_SING; +"HOMEOMORPHIC_PCROSS_SYM",HOMEOMORPHIC_PCROSS_SYM; +"HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE; +"HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE; +"HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN; +"HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE",HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE; +"HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV",HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV; +"HOMEOMORPHIC_REFL",HOMEOMORPHIC_REFL; +"HOMEOMORPHIC_RELATIVE_BOUNDARIES",HOMEOMORPHIC_RELATIVE_BOUNDARIES; +"HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION",HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION; +"HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS",HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS; +"HOMEOMORPHIC_RELATIVE_INTERIORS",HOMEOMORPHIC_RELATIVE_INTERIORS; +"HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION",HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION; +"HOMEOMORPHIC_SCALING",HOMEOMORPHIC_SCALING; +"HOMEOMORPHIC_SCALING_LEFT",HOMEOMORPHIC_SCALING_LEFT; +"HOMEOMORPHIC_SCALING_RIGHT",HOMEOMORPHIC_SCALING_RIGHT; +"HOMEOMORPHIC_SIMPLE_PATH_IMAGES",HOMEOMORPHIC_SIMPLE_PATH_IMAGES; +"HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE",HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; +"HOMEOMORPHIC_SIMPLY_CONNECTED",HOMEOMORPHIC_SIMPLY_CONNECTED; +"HOMEOMORPHIC_SIMPLY_CONNECTED_EQ",HOMEOMORPHIC_SIMPLY_CONNECTED_EQ; +"HOMEOMORPHIC_SING",HOMEOMORPHIC_SING; +"HOMEOMORPHIC_SPHERES",HOMEOMORPHIC_SPHERES; +"HOMEOMORPHIC_SPHERES_EQ",HOMEOMORPHIC_SPHERES_EQ; +"HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE",HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE; +"HOMEOMORPHIC_SUBSPACES",HOMEOMORPHIC_SUBSPACES; +"HOMEOMORPHIC_SUBSPACES_EQ",HOMEOMORPHIC_SUBSPACES_EQ; +"HOMEOMORPHIC_SYM",HOMEOMORPHIC_SYM; +"HOMEOMORPHIC_TRANS",HOMEOMORPHIC_TRANS; +"HOMEOMORPHIC_TRANSLATION",HOMEOMORPHIC_TRANSLATION; +"HOMEOMORPHIC_TRANSLATION_LEFT_EQ",HOMEOMORPHIC_TRANSLATION_LEFT_EQ; +"HOMEOMORPHIC_TRANSLATION_RIGHT_EQ",HOMEOMORPHIC_TRANSLATION_RIGHT_EQ; +"HOMEOMORPHIC_TRANSLATION_SELF",HOMEOMORPHIC_TRANSLATION_SELF; +"HOMEOMORPHIC_UNICOHERENT",HOMEOMORPHIC_UNICOHERENT; +"HOMEOMORPHIC_UNICOHERENT_EQ",HOMEOMORPHIC_UNICOHERENT_EQ; +"HOMEOMORPHIC_UNIV_UNIV",HOMEOMORPHIC_UNIV_UNIV; +"HOMEOMORPHISM",HOMEOMORPHISM; +"HOMEOMORPHISM_ARC",HOMEOMORPHISM_ARC; +"HOMEOMORPHISM_COMPACT",HOMEOMORPHISM_COMPACT; +"HOMEOMORPHISM_COMPOSE",HOMEOMORPHISM_COMPOSE; +"HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE; +"HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE; +"HOMEOMORPHISM_GROUPING_POINTS_EXISTS",HOMEOMORPHISM_GROUPING_POINTS_EXISTS; +"HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN",HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN; +"HOMEOMORPHISM_I",HOMEOMORPHISM_I; +"HOMEOMORPHISM_ID",HOMEOMORPHISM_ID; +"HOMEOMORPHISM_IMP_CLOSED_MAP",HOMEOMORPHISM_IMP_CLOSED_MAP; +"HOMEOMORPHISM_IMP_COVERING_SPACE",HOMEOMORPHISM_IMP_COVERING_SPACE; +"HOMEOMORPHISM_IMP_OPEN_MAP",HOMEOMORPHISM_IMP_OPEN_MAP; +"HOMEOMORPHISM_IMP_QUOTIENT_MAP",HOMEOMORPHISM_IMP_QUOTIENT_MAP; +"HOMEOMORPHISM_INJECTIVE_CLOSED_MAP",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP; +"HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ; +"HOMEOMORPHISM_INJECTIVE_OPEN_MAP",HOMEOMORPHISM_INJECTIVE_OPEN_MAP; +"HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ",HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; +"HOMEOMORPHISM_LOCALLY",HOMEOMORPHISM_LOCALLY; +"HOMEOMORPHISM_MOVING_POINTS_EXISTS",HOMEOMORPHISM_MOVING_POINTS_EXISTS; +"HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN",HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN; +"HOMEOMORPHISM_MOVING_POINT_EXISTS",HOMEOMORPHISM_MOVING_POINT_EXISTS; +"HOMEOMORPHISM_OF_SUBSETS",HOMEOMORPHISM_OF_SUBSETS; +"HOMEOMORPHISM_SYM",HOMEOMORPHISM_SYM; +"HOMOGENEOUS_LINEAR_EQUATIONS_DET",HOMOGENEOUS_LINEAR_EQUATIONS_DET; +"HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; +"HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; +"HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT",HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT; +"HOMOTOPIC_CIRCLEMAPS_DIV",HOMOTOPIC_CIRCLEMAPS_DIV; +"HOMOTOPIC_CIRCLEMAPS_DIV_1",HOMOTOPIC_CIRCLEMAPS_DIV_1; +"HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS",HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS; +"HOMOTOPIC_COMPOSE",HOMOTOPIC_COMPOSE; +"HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT; +"HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT; +"HOMOTOPIC_CONSTANT_MAPS",HOMOTOPIC_CONSTANT_MAPS; +"HOMOTOPIC_FROM_CONTRACTIBLE",HOMOTOPIC_FROM_CONTRACTIBLE; +"HOMOTOPIC_INTO_CONTRACTIBLE",HOMOTOPIC_INTO_CONTRACTIBLE; +"HOMOTOPIC_INTO_RETRACT",HOMOTOPIC_INTO_RETRACT; +"HOMOTOPIC_JOIN_LEMMA",HOMOTOPIC_JOIN_LEMMA; +"HOMOTOPIC_JOIN_SUBPATHS",HOMOTOPIC_JOIN_SUBPATHS; +"HOMOTOPIC_LOOPS",HOMOTOPIC_LOOPS; +"HOMOTOPIC_LOOPS_ADD_SYM",HOMOTOPIC_LOOPS_ADD_SYM; +"HOMOTOPIC_LOOPS_CONJUGATE",HOMOTOPIC_LOOPS_CONJUGATE; +"HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE",HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE; +"HOMOTOPIC_LOOPS_EQ",HOMOTOPIC_LOOPS_EQ; +"HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS",HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS; +"HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL",HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL; +"HOMOTOPIC_LOOPS_IMP_LOOP",HOMOTOPIC_LOOPS_IMP_LOOP; +"HOMOTOPIC_LOOPS_IMP_PATH",HOMOTOPIC_LOOPS_IMP_PATH; +"HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE",HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE; +"HOMOTOPIC_LOOPS_IMP_SUBSET",HOMOTOPIC_LOOPS_IMP_SUBSET; +"HOMOTOPIC_LOOPS_LINEAR",HOMOTOPIC_LOOPS_LINEAR; +"HOMOTOPIC_LOOPS_NEARBY_EXPLICIT",HOMOTOPIC_LOOPS_NEARBY_EXPLICIT; +"HOMOTOPIC_LOOPS_REFL",HOMOTOPIC_LOOPS_REFL; +"HOMOTOPIC_LOOPS_SHIFTPATH",HOMOTOPIC_LOOPS_SHIFTPATH; +"HOMOTOPIC_LOOPS_SHIFTPATH_SELF",HOMOTOPIC_LOOPS_SHIFTPATH_SELF; +"HOMOTOPIC_LOOPS_SUBSET",HOMOTOPIC_LOOPS_SUBSET; +"HOMOTOPIC_LOOPS_SYM",HOMOTOPIC_LOOPS_SYM; +"HOMOTOPIC_LOOPS_TRANS",HOMOTOPIC_LOOPS_TRANS; +"HOMOTOPIC_NEARBY_LOOPS",HOMOTOPIC_NEARBY_LOOPS; +"HOMOTOPIC_NEARBY_PATHS",HOMOTOPIC_NEARBY_PATHS; +"HOMOTOPIC_NEIGHBOURHOOD_EXTENSION",HOMOTOPIC_NEIGHBOURHOOD_EXTENSION; +"HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS",HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS; +"HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS",HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS; +"HOMOTOPIC_ON_CLOPEN_UNIONS",HOMOTOPIC_ON_CLOPEN_UNIONS; +"HOMOTOPIC_ON_COMPONENTS",HOMOTOPIC_ON_COMPONENTS; +"HOMOTOPIC_ON_COMPONENTS_EQ",HOMOTOPIC_ON_COMPONENTS_EQ; +"HOMOTOPIC_ON_EMPTY",HOMOTOPIC_ON_EMPTY; +"HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS",HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS; +"HOMOTOPIC_PATHS",HOMOTOPIC_PATHS; +"HOMOTOPIC_PATHS_ASSOC",HOMOTOPIC_PATHS_ASSOC; +"HOMOTOPIC_PATHS_CONTINUOUS_IMAGE",HOMOTOPIC_PATHS_CONTINUOUS_IMAGE; +"HOMOTOPIC_PATHS_EQ",HOMOTOPIC_PATHS_EQ; +"HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS",HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS; +"HOMOTOPIC_PATHS_IMP_PATH",HOMOTOPIC_PATHS_IMP_PATH; +"HOMOTOPIC_PATHS_IMP_PATHFINISH",HOMOTOPIC_PATHS_IMP_PATHFINISH; +"HOMOTOPIC_PATHS_IMP_PATHSTART",HOMOTOPIC_PATHS_IMP_PATHSTART; +"HOMOTOPIC_PATHS_IMP_SUBSET",HOMOTOPIC_PATHS_IMP_SUBSET; +"HOMOTOPIC_PATHS_JOIN",HOMOTOPIC_PATHS_JOIN; +"HOMOTOPIC_PATHS_LID",HOMOTOPIC_PATHS_LID; +"HOMOTOPIC_PATHS_LINEAR",HOMOTOPIC_PATHS_LINEAR; +"HOMOTOPIC_PATHS_LINV",HOMOTOPIC_PATHS_LINV; +"HOMOTOPIC_PATHS_LOOP_PARTS",HOMOTOPIC_PATHS_LOOP_PARTS; +"HOMOTOPIC_PATHS_NEARBY_EXPLICIT",HOMOTOPIC_PATHS_NEARBY_EXPLICIT; +"HOMOTOPIC_PATHS_REFL",HOMOTOPIC_PATHS_REFL; +"HOMOTOPIC_PATHS_REPARAMETRIZE",HOMOTOPIC_PATHS_REPARAMETRIZE; +"HOMOTOPIC_PATHS_REVERSEPATH",HOMOTOPIC_PATHS_REVERSEPATH; +"HOMOTOPIC_PATHS_RID",HOMOTOPIC_PATHS_RID; +"HOMOTOPIC_PATHS_RINV",HOMOTOPIC_PATHS_RINV; +"HOMOTOPIC_PATHS_SUBSET",HOMOTOPIC_PATHS_SUBSET; +"HOMOTOPIC_PATHS_SYM",HOMOTOPIC_PATHS_SYM; +"HOMOTOPIC_PATHS_TRANS",HOMOTOPIC_PATHS_TRANS; +"HOMOTOPIC_POINTS_EQ_PATH_COMPONENT",HOMOTOPIC_POINTS_EQ_PATH_COMPONENT; +"HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS",HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS; +"HOMOTOPIC_THROUGH_CONTRACTIBLE",HOMOTOPIC_THROUGH_CONTRACTIBLE; +"HOMOTOPIC_TRIVIALITY",HOMOTOPIC_TRIVIALITY; +"HOMOTOPIC_WITH",HOMOTOPIC_WITH; +"HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT; +"HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT; +"HOMOTOPIC_WITH_EQ",HOMOTOPIC_WITH_EQ; +"HOMOTOPIC_WITH_EQUAL",HOMOTOPIC_WITH_EQUAL; +"HOMOTOPIC_WITH_IMP_CONTINUOUS",HOMOTOPIC_WITH_IMP_CONTINUOUS; +"HOMOTOPIC_WITH_IMP_PROPERTY",HOMOTOPIC_WITH_IMP_PROPERTY; +"HOMOTOPIC_WITH_IMP_SUBSET",HOMOTOPIC_WITH_IMP_SUBSET; +"HOMOTOPIC_WITH_LINEAR",HOMOTOPIC_WITH_LINEAR; +"HOMOTOPIC_WITH_MONO",HOMOTOPIC_WITH_MONO; +"HOMOTOPIC_WITH_PCROSS",HOMOTOPIC_WITH_PCROSS; +"HOMOTOPIC_WITH_REFL",HOMOTOPIC_WITH_REFL; +"HOMOTOPIC_WITH_SUBSET_LEFT",HOMOTOPIC_WITH_SUBSET_LEFT; +"HOMOTOPIC_WITH_SUBSET_RIGHT",HOMOTOPIC_WITH_SUBSET_RIGHT; +"HOMOTOPIC_WITH_SYM",HOMOTOPIC_WITH_SYM; +"HOMOTOPIC_WITH_TRANS",HOMOTOPIC_WITH_TRANS; +"HOMOTOPY_DOMINATED_CONTRACTIBILITY",HOMOTOPY_DOMINATED_CONTRACTIBILITY; +"HOMOTOPY_EQUIVALENT",HOMOTOPY_EQUIVALENT; +"HOMOTOPY_EQUIVALENT_BORSUKIANNESS",HOMOTOPY_EQUIVALENT_BORSUKIANNESS; +"HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY; +"HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL; +"HOMOTOPY_EQUIVALENT_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_CONNECTEDNESS; +"HOMOTOPY_EQUIVALENT_CONTRACTIBILITY",HOMOTOPY_EQUIVALENT_CONTRACTIBILITY; +"HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS",HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; +"HOMOTOPY_EQUIVALENT_EMPTY",HOMOTOPY_EQUIVALENT_EMPTY; +"HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY; +"HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL; +"HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; +"HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; +"HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF; +"HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS; +"HOMOTOPY_EQUIVALENT_REFL",HOMOTOPY_EQUIVALENT_REFL; +"HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL; +"HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX; +"HOMOTOPY_EQUIVALENT_SEPARATION",HOMOTOPY_EQUIVALENT_SEPARATION; +"HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS; +"HOMOTOPY_EQUIVALENT_SING",HOMOTOPY_EQUIVALENT_SING; +"HOMOTOPY_EQUIVALENT_SPHERES_EQ",HOMOTOPY_EQUIVALENT_SPHERES_EQ; +"HOMOTOPY_EQUIVALENT_SYM",HOMOTOPY_EQUIVALENT_SYM; +"HOMOTOPY_EQUIVALENT_TRANS",HOMOTOPY_EQUIVALENT_TRANS; +"HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ; +"HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ; +"HOMOTOPY_EQUIVALENT_TRANSLATION_SELF",HOMOTOPY_EQUIVALENT_TRANSLATION_SELF; +"HOMOTOPY_INVARIANT_CONNECTEDNESS",HOMOTOPY_INVARIANT_CONNECTEDNESS; +"HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS",HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS; +"HP",HP; +"HREAL_ADD_AC",HREAL_ADD_AC; +"HREAL_ADD_ASSOC",HREAL_ADD_ASSOC; +"HREAL_ADD_LCANCEL",HREAL_ADD_LCANCEL; +"HREAL_ADD_LDISTRIB",HREAL_ADD_LDISTRIB; +"HREAL_ADD_LID",HREAL_ADD_LID; +"HREAL_ADD_RDISTRIB",HREAL_ADD_RDISTRIB; +"HREAL_ADD_RID",HREAL_ADD_RID; +"HREAL_ADD_SYM",HREAL_ADD_SYM; +"HREAL_ARCH",HREAL_ARCH; +"HREAL_COMPLETE",HREAL_COMPLETE; +"HREAL_EQ_ADD_LCANCEL",HREAL_EQ_ADD_LCANCEL; +"HREAL_EQ_ADD_RCANCEL",HREAL_EQ_ADD_RCANCEL; +"HREAL_INV_0",HREAL_INV_0; +"HREAL_LE_ADD",HREAL_LE_ADD; +"HREAL_LE_ADD2",HREAL_LE_ADD2; +"HREAL_LE_ADD_LCANCEL",HREAL_LE_ADD_LCANCEL; +"HREAL_LE_ADD_RCANCEL",HREAL_LE_ADD_RCANCEL; +"HREAL_LE_ANTISYM",HREAL_LE_ANTISYM; +"HREAL_LE_EXISTS",HREAL_LE_EXISTS; +"HREAL_LE_EXISTS_DEF",HREAL_LE_EXISTS_DEF; +"HREAL_LE_MUL_RCANCEL_IMP",HREAL_LE_MUL_RCANCEL_IMP; +"HREAL_LE_REFL",HREAL_LE_REFL; +"HREAL_LE_TOTAL",HREAL_LE_TOTAL; +"HREAL_LE_TRANS",HREAL_LE_TRANS; +"HREAL_MUL_ASSOC",HREAL_MUL_ASSOC; +"HREAL_MUL_LID",HREAL_MUL_LID; +"HREAL_MUL_LINV",HREAL_MUL_LINV; +"HREAL_MUL_LZERO",HREAL_MUL_LZERO; +"HREAL_MUL_RZERO",HREAL_MUL_RZERO; +"HREAL_MUL_SYM",HREAL_MUL_SYM; +"HREAL_OF_NUM_ADD",HREAL_OF_NUM_ADD; +"HREAL_OF_NUM_EQ",HREAL_OF_NUM_EQ; +"HREAL_OF_NUM_LE",HREAL_OF_NUM_LE; +"HREAL_OF_NUM_MUL",HREAL_OF_NUM_MUL; +"HULLS_EQ",HULLS_EQ; +"HULL_ANTIMONO",HULL_ANTIMONO; +"HULL_EQ",HULL_EQ; +"HULL_HULL",HULL_HULL; +"HULL_IMAGE",HULL_IMAGE; +"HULL_IMAGE_GALOIS",HULL_IMAGE_GALOIS; +"HULL_IMAGE_SUBSET",HULL_IMAGE_SUBSET; +"HULL_INC",HULL_INC; +"HULL_INDUCT",HULL_INDUCT; +"HULL_MINIMAL",HULL_MINIMAL; +"HULL_MONO",HULL_MONO; +"HULL_P",HULL_P; +"HULL_P_AND_Q",HULL_P_AND_Q; +"HULL_REDUNDANT",HULL_REDUNDANT; +"HULL_REDUNDANT_EQ",HULL_REDUNDANT_EQ; +"HULL_SUBSET",HULL_SUBSET; +"HULL_UNION",HULL_UNION; +"HULL_UNION_LEFT",HULL_UNION_LEFT; +"HULL_UNION_RIGHT",HULL_UNION_RIGHT; +"HULL_UNION_SUBSET",HULL_UNION_SUBSET; +"HULL_UNIQUE",HULL_UNIQUE; +"HURWITZ_INJECTIVE",HURWITZ_INJECTIVE; +"HURWITZ_NO_ZEROS",HURWITZ_NO_ZEROS; +"HYPERPLANE_EQ_EMPTY",HYPERPLANE_EQ_EMPTY; +"HYPERPLANE_EQ_UNIV",HYPERPLANE_EQ_UNIV; +"HYPERPLANE_FACET_OF_HALFSPACE_GE",HYPERPLANE_FACET_OF_HALFSPACE_GE; +"HYPERPLANE_FACET_OF_HALFSPACE_LE",HYPERPLANE_FACET_OF_HALFSPACE_LE; +"HYPERPLANE_FACE_OF_HALFSPACE_GE",HYPERPLANE_FACE_OF_HALFSPACE_GE; +"HYPERPLANE_FACE_OF_HALFSPACE_LE",HYPERPLANE_FACE_OF_HALFSPACE_LE; +"IDEMPOTENT_IMP_RETRACTION",IDEMPOTENT_IMP_RETRACTION; +"II_NZ",II_NZ; +"IM",IM; +"IMAGE",IMAGE; +"IMAGE_AFFINITY_INTERVAL",IMAGE_AFFINITY_INTERVAL; +"IMAGE_AFFINITY_REAL_INTERVAL",IMAGE_AFFINITY_REAL_INTERVAL; +"IMAGE_CLAUSES",IMAGE_CLAUSES; +"IMAGE_CLOSURE_SUBSET",IMAGE_CLOSURE_SUBSET; +"IMAGE_COMPOSE_PERMUTATIONS_L",IMAGE_COMPOSE_PERMUTATIONS_L; +"IMAGE_COMPOSE_PERMUTATIONS_R",IMAGE_COMPOSE_PERMUTATIONS_R; +"IMAGE_CONST",IMAGE_CONST; +"IMAGE_CX",IMAGE_CX; +"IMAGE_DELETE_INJ",IMAGE_DELETE_INJ; +"IMAGE_DIFF_INJ",IMAGE_DIFF_INJ; +"IMAGE_DROPOUT_CLOSED_INTERVAL",IMAGE_DROPOUT_CLOSED_INTERVAL; +"IMAGE_DROP_INTERVAL",IMAGE_DROP_INTERVAL; +"IMAGE_DROP_UNIV",IMAGE_DROP_UNIV; +"IMAGE_EQ_EMPTY",IMAGE_EQ_EMPTY; +"IMAGE_FSTCART_PCROSS",IMAGE_FSTCART_PCROSS; +"IMAGE_I",IMAGE_I; +"IMAGE_ID",IMAGE_ID; +"IMAGE_IMP_INJECTIVE",IMAGE_IMP_INJECTIVE; +"IMAGE_IMP_INJECTIVE_GEN",IMAGE_IMP_INJECTIVE_GEN; +"IMAGE_INJECTIVE_IMAGE_OF_SUBSET",IMAGE_INJECTIVE_IMAGE_OF_SUBSET; +"IMAGE_INTER_INJ",IMAGE_INTER_INJ; +"IMAGE_INVERSE_PERMUTATIONS",IMAGE_INVERSE_PERMUTATIONS; +"IMAGE_LEMMA_0",IMAGE_LEMMA_0; +"IMAGE_LEMMA_1",IMAGE_LEMMA_1; +"IMAGE_LEMMA_2",IMAGE_LEMMA_2; +"IMAGE_LIFT_DROP",IMAGE_LIFT_DROP; +"IMAGE_LIFT_REAL_INTERVAL",IMAGE_LIFT_REAL_INTERVAL; +"IMAGE_LIFT_REAL_SEGMENT",IMAGE_LIFT_REAL_SEGMENT; +"IMAGE_LIFT_UNIV",IMAGE_LIFT_UNIV; +"IMAGE_SNDCART_PCROSS",IMAGE_SNDCART_PCROSS; +"IMAGE_STRETCH_INTERVAL",IMAGE_STRETCH_INTERVAL; +"IMAGE_STRETCH_REAL_INTERVAL",IMAGE_STRETCH_REAL_INTERVAL; +"IMAGE_SUBSET",IMAGE_SUBSET; +"IMAGE_TWIZZLE_INTERVAL",IMAGE_TWIZZLE_INTERVAL; +"IMAGE_UNION",IMAGE_UNION; +"IMAGE_UNIONS",IMAGE_UNIONS; +"IMAGE_o",IMAGE_o; +"IMP_CLAUSES",IMP_CLAUSES; +"IMP_CONJ",IMP_CONJ; +"IMP_CONJ_ALT",IMP_CONJ_ALT; +"IMP_DEF",IMP_DEF; +"IMP_IMP",IMP_IMP; +"IM_ADD",IM_ADD; +"IM_CCOS",IM_CCOS; +"IM_CEXP",IM_CEXP; +"IM_CLOG_EQ_0",IM_CLOG_EQ_0; +"IM_CLOG_EQ_PI",IM_CLOG_EQ_PI; +"IM_CLOG_POS_LE",IM_CLOG_POS_LE; +"IM_CLOG_POS_LT",IM_CLOG_POS_LT; +"IM_CLOG_POS_LT_IMP",IM_CLOG_POS_LT_IMP; +"IM_CMUL",IM_CMUL; +"IM_CNJ",IM_CNJ; +"IM_COMPLEX_DIV_EQ_0",IM_COMPLEX_DIV_EQ_0; +"IM_COMPLEX_DIV_GE_0",IM_COMPLEX_DIV_GE_0; +"IM_COMPLEX_DIV_GT_0",IM_COMPLEX_DIV_GT_0; +"IM_COMPLEX_DIV_LEMMA",IM_COMPLEX_DIV_LEMMA; +"IM_COMPLEX_DIV_LE_0",IM_COMPLEX_DIV_LE_0; +"IM_COMPLEX_DIV_LT_0",IM_COMPLEX_DIV_LT_0; +"IM_COMPLEX_INV_EQ_0",IM_COMPLEX_INV_EQ_0; +"IM_COMPLEX_INV_GE_0",IM_COMPLEX_INV_GE_0; +"IM_COMPLEX_INV_GT_0",IM_COMPLEX_INV_GT_0; +"IM_COMPLEX_INV_LE_0",IM_COMPLEX_INV_LE_0; +"IM_COMPLEX_INV_LT_0",IM_COMPLEX_INV_LT_0; +"IM_CSIN",IM_CSIN; +"IM_CX",IM_CX; +"IM_DEF",IM_DEF; +"IM_DIV_CX",IM_DIV_CX; +"IM_II",IM_II; +"IM_LINEPATH_CX",IM_LINEPATH_CX; +"IM_MUL_CX",IM_MUL_CX; +"IM_MUL_II",IM_MUL_II; +"IM_NEG",IM_NEG; +"IM_POW_2",IM_POW_2; +"IM_SUB",IM_SUB; +"IM_VSUM",IM_VSUM; +"IN",IN; +"INCREASING_BOUNDED_REAL_VARIATION",INCREASING_BOUNDED_REAL_VARIATION; +"INCREASING_BOUNDED_VARIATION",INCREASING_BOUNDED_VARIATION; +"INCREASING_LEFT_LIMIT",INCREASING_LEFT_LIMIT; +"INCREASING_LEFT_LIMIT_1",INCREASING_LEFT_LIMIT_1; +"INCREASING_REAL_VARIATION",INCREASING_REAL_VARIATION; +"INCREASING_RIGHT_LIMIT",INCREASING_RIGHT_LIMIT; +"INCREASING_RIGHT_LIMIT_1",INCREASING_RIGHT_LIMIT_1; +"INCREASING_VECTOR_VARIATION",INCREASING_VECTOR_VARIATION; +"INDEFINITE_INTEGRAL_CONTINUOUS",INDEFINITE_INTEGRAL_CONTINUOUS; +"INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; +"INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; +"INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS; +"INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT; +"INDEPENDENT_2",INDEPENDENT_2; +"INDEPENDENT_3",INDEPENDENT_3; +"INDEPENDENT_BOUND",INDEPENDENT_BOUND; +"INDEPENDENT_BOUND_GENERAL",INDEPENDENT_BOUND_GENERAL; +"INDEPENDENT_CARD_LE_DIM",INDEPENDENT_CARD_LE_DIM; +"INDEPENDENT_EMPTY",INDEPENDENT_EMPTY; +"INDEPENDENT_EXPLICIT",INDEPENDENT_EXPLICIT; +"INDEPENDENT_IMP_AFFINE_DEPENDENT_0",INDEPENDENT_IMP_AFFINE_DEPENDENT_0; +"INDEPENDENT_IMP_FINITE",INDEPENDENT_IMP_FINITE; +"INDEPENDENT_INJECTIVE_IMAGE",INDEPENDENT_INJECTIVE_IMAGE; +"INDEPENDENT_INJECTIVE_IMAGE_GEN",INDEPENDENT_INJECTIVE_IMAGE_GEN; +"INDEPENDENT_INSERT",INDEPENDENT_INSERT; +"INDEPENDENT_LINEAR_IMAGE_EQ",INDEPENDENT_LINEAR_IMAGE_EQ; +"INDEPENDENT_MONO",INDEPENDENT_MONO; +"INDEPENDENT_NONZERO",INDEPENDENT_NONZERO; +"INDEPENDENT_SING",INDEPENDENT_SING; +"INDEPENDENT_SPAN_BOUND",INDEPENDENT_SPAN_BOUND; +"INDEPENDENT_STDBASIS",INDEPENDENT_STDBASIS; +"INDUCT_LINEAR_ELEMENTARY",INDUCT_LINEAR_ELEMENTARY; +"INDUCT_MATRIX_ELEMENTARY",INDUCT_MATRIX_ELEMENTARY; +"INDUCT_MATRIX_ELEMENTARY_ALT",INDUCT_MATRIX_ELEMENTARY_ALT; +"INDUCT_MATRIX_ROW_OPERATIONS",INDUCT_MATRIX_ROW_OPERATIONS; +"IND_SUC_0",IND_SUC_0; +"IND_SUC_0_EXISTS",IND_SUC_0_EXISTS; +"IND_SUC_INJ",IND_SUC_INJ; +"IND_SUC_SPEC",IND_SUC_SPEC; +"INESSENTIAL_EQ_CONTINUOUS_LOGARITHM",INESSENTIAL_EQ_CONTINUOUS_LOGARITHM; +"INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE",INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE; +"INESSENTIAL_EQ_EXTENSIBLE",INESSENTIAL_EQ_EXTENSIBLE; +"INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE",INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE; +"INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM",INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM; +"INESSENTIAL_ON_CLOPEN_UNIONS",INESSENTIAL_ON_CLOPEN_UNIONS; +"INESSENTIAL_ON_COMPONENTS",INESSENTIAL_ON_COMPONENTS; +"INESSENTIAL_ON_COMPONENTS_EQ",INESSENTIAL_ON_COMPONENTS_EQ; +"INESSENTIAL_SPHEREMAP_2",INESSENTIAL_SPHEREMAP_2; +"INESSENTIAL_SPHEREMAP_LOWDIM",INESSENTIAL_SPHEREMAP_LOWDIM; +"INESSENTIAL_SPHEREMAP_LOWDIM_GEN",INESSENTIAL_SPHEREMAP_LOWDIM_GEN; +"INF",INF; +"INFINITE",INFINITE; +"INFINITE_ARC_IMAGE",INFINITE_ARC_IMAGE; +"INFINITE_CARD_LE",INFINITE_CARD_LE; +"INFINITE_DIFF_FINITE",INFINITE_DIFF_FINITE; +"INFINITE_ENUMERATE",INFINITE_ENUMERATE; +"INFINITE_ENUMERATE_WEAK",INFINITE_ENUMERATE_WEAK; +"INFINITE_FROM",INFINITE_FROM; +"INFINITE_IMAGE_INJ",INFINITE_IMAGE_INJ; +"INFINITE_INTEGER",INFINITE_INTEGER; +"INFINITE_NONEMPTY",INFINITE_NONEMPTY; +"INFINITE_OPEN_IN",INFINITE_OPEN_IN; +"INFINITE_RATIONAL",INFINITE_RATIONAL; +"INFINITE_SIMPLE_PATH_IMAGE",INFINITE_SIMPLE_PATH_IMAGE; +"INFINITE_SUPERSET",INFINITE_SUPERSET; +"INFINITY_AX",INFINITY_AX; +"INFNORM_0",INFNORM_0; +"INFNORM_2",INFNORM_2; +"INFNORM_EQ_0",INFNORM_EQ_0; +"INFNORM_EQ_1_2",INFNORM_EQ_1_2; +"INFNORM_EQ_1_IMP",INFNORM_EQ_1_IMP; +"INFNORM_LE_NORM",INFNORM_LE_NORM; +"INFNORM_MUL",INFNORM_MUL; +"INFNORM_MUL_LEMMA",INFNORM_MUL_LEMMA; +"INFNORM_NEG",INFNORM_NEG; +"INFNORM_POS_LE",INFNORM_POS_LE; +"INFNORM_POS_LT",INFNORM_POS_LT; +"INFNORM_SET_IMAGE",INFNORM_SET_IMAGE; +"INFNORM_SET_LEMMA",INFNORM_SET_LEMMA; +"INFNORM_SUB",INFNORM_SUB; +"INFNORM_TRIANGLE",INFNORM_TRIANGLE; +"INFSUM_0",INFSUM_0; +"INFSUM_ADD",INFSUM_ADD; +"INFSUM_CMUL",INFSUM_CMUL; +"INFSUM_EQ",INFSUM_EQ; +"INFSUM_LINEAR",INFSUM_LINEAR; +"INFSUM_NEG",INFSUM_NEG; +"INFSUM_RESTRICT",INFSUM_RESTRICT; +"INFSUM_SUB",INFSUM_SUB; +"INFSUM_UNIQUE",INFSUM_UNIQUE; +"INF_CLOSURE",INF_CLOSURE; +"INF_EQ",INF_EQ; +"INF_FINITE",INF_FINITE; +"INF_FINITE_LEMMA",INF_FINITE_LEMMA; +"INF_INSERT",INF_INSERT; +"INF_INSERT_FINITE",INF_INSERT_FINITE; +"INF_SING",INF_SING; +"INF_UNION",INF_UNION; +"INF_UNIQUE",INF_UNIQUE; +"INF_UNIQUE_FINITE",INF_UNIQUE_FINITE; +"INJ",INJ; +"INJA",INJA; +"INJA_INJ",INJA_INJ; +"INJECTIVE_ALT",INJECTIVE_ALT; +"INJECTIVE_EQ_1D_OPEN_MAP_UNIV",INJECTIVE_EQ_1D_OPEN_MAP_UNIV; +"INJECTIVE_IMAGE",INJECTIVE_IMAGE; +"INJECTIVE_IMP_ISOMETRIC",INJECTIVE_IMP_ISOMETRIC; +"INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM",INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM; +"INJECTIVE_INTO_1D_IMP_OPEN_MAP",INJECTIVE_INTO_1D_IMP_OPEN_MAP; +"INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV",INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV; +"INJECTIVE_INVERSE",INJECTIVE_INVERSE; +"INJECTIVE_INVERSE_o",INJECTIVE_INVERSE_o; +"INJECTIVE_LEFT_INVERSE",INJECTIVE_LEFT_INVERSE; +"INJECTIVE_LEFT_INVERSE_NONEMPTY",INJECTIVE_LEFT_INVERSE_NONEMPTY; +"INJECTIVE_MAP",INJECTIVE_MAP; +"INJECTIVE_MAP_OPEN_IFF_CLOSED",INJECTIVE_MAP_OPEN_IFF_CLOSED; +"INJECTIVE_ON_ALT",INJECTIVE_ON_ALT; +"INJECTIVE_ON_IMAGE",INJECTIVE_ON_IMAGE; +"INJECTIVE_ON_LEFT_INVERSE",INJECTIVE_ON_LEFT_INVERSE; +"INJECTIVE_SCALING",INJECTIVE_SCALING; +"INJF",INJF; +"INJF_INJ",INJF_INJ; +"INJN",INJN; +"INJN_INJ",INJN_INJ; +"INJP",INJP; +"INJP_INJ",INJP_INJ; +"INJ_INVERSE2",INJ_INVERSE2; +"INNER_LADD",INNER_LADD; +"INNER_LMUL",INNER_LMUL; +"INNER_LNEG",INNER_LNEG; +"INNER_LZERO",INNER_LZERO; +"INNER_RADD",INNER_RADD; +"INNER_RMUL",INNER_RMUL; +"INNER_RNEG",INNER_RNEG; +"INNER_RZERO",INNER_RZERO; +"INSEG_LINSEG",INSEG_LINSEG; +"INSEG_PROPER_SUBSET",INSEG_PROPER_SUBSET; +"INSEG_PROPER_SUBSET_FL",INSEG_PROPER_SUBSET_FL; +"INSEG_SUBSET",INSEG_SUBSET; +"INSEG_SUBSET_FL",INSEG_SUBSET_FL; +"INSEG_WOSET",INSEG_WOSET; +"INSERT",INSERT; +"INSERT_AC",INSERT_AC; +"INSERT_COMM",INSERT_COMM; +"INSERT_DEF",INSERT_DEF; +"INSERT_DELETE",INSERT_DELETE; +"INSERT_DIFF",INSERT_DIFF; +"INSERT_INSERT",INSERT_INSERT; +"INSERT_INTER",INSERT_INTER; +"INSERT_SUBSET",INSERT_SUBSET; +"INSERT_UNION",INSERT_UNION; +"INSERT_UNION_EQ",INSERT_UNION_EQ; +"INSERT_UNIV",INSERT_UNIV; +"INSIDE_ARC_EMPTY",INSIDE_ARC_EMPTY; +"INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY",INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY; +"INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY",INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY; +"INSIDE_CONNECTED_COMPONENT_LE",INSIDE_CONNECTED_COMPONENT_LE; +"INSIDE_CONNECTED_COMPONENT_LT",INSIDE_CONNECTED_COMPONENT_LT; +"INSIDE_CONVEX",INSIDE_CONVEX; +"INSIDE_EMPTY",INSIDE_EMPTY; +"INSIDE_EQ_OUTSIDE",INSIDE_EQ_OUTSIDE; +"INSIDE_FRONTIER_EQ_INTERIOR",INSIDE_FRONTIER_EQ_INTERIOR; +"INSIDE_INSIDE",INSIDE_INSIDE; +"INSIDE_INSIDE_COMPACT_CONNECTED",INSIDE_INSIDE_COMPACT_CONNECTED; +"INSIDE_INSIDE_EQ_EMPTY",INSIDE_INSIDE_EQ_EMPTY; +"INSIDE_INSIDE_SUBSET",INSIDE_INSIDE_SUBSET; +"INSIDE_INTER_OUTSIDE",INSIDE_INTER_OUTSIDE; +"INSIDE_IN_COMPONENTS",INSIDE_IN_COMPONENTS; +"INSIDE_LINEAR_IMAGE",INSIDE_LINEAR_IMAGE; +"INSIDE_MONO",INSIDE_MONO; +"INSIDE_NO_OVERLAP",INSIDE_NO_OVERLAP; +"INSIDE_OF_TRIANGLE",INSIDE_OF_TRIANGLE; +"INSIDE_OUTSIDE",INSIDE_OUTSIDE; +"INSIDE_OUTSIDE_INTERSECT_CONNECTED",INSIDE_OUTSIDE_INTERSECT_CONNECTED; +"INSIDE_OUTSIDE_UNIQUE",INSIDE_OUTSIDE_UNIQUE; +"INSIDE_SAME_COMPONENT",INSIDE_SAME_COMPONENT; +"INSIDE_SIMPLE_CURVE_IMP_CLOSED",INSIDE_SIMPLE_CURVE_IMP_CLOSED; +"INSIDE_SUBSET",INSIDE_SUBSET; +"INSIDE_TRANSLATION",INSIDE_TRANSLATION; +"INSIDE_UNION_OUTSIDE",INSIDE_UNION_OUTSIDE; +"INSIDE_UNIQUE",INSIDE_UNIQUE; +"INTEGER_ABS",INTEGER_ABS; +"INTEGER_ABS_MUL_EQ_1",INTEGER_ABS_MUL_EQ_1; +"INTEGER_ADD",INTEGER_ADD; +"INTEGER_ADD_EQ",INTEGER_ADD_EQ; +"INTEGER_CASES",INTEGER_CASES; +"INTEGER_CLOSED",INTEGER_CLOSED; +"INTEGER_DET",INTEGER_DET; +"INTEGER_DIV",INTEGER_DIV; +"INTEGER_EXISTS_BETWEEN",INTEGER_EXISTS_BETWEEN; +"INTEGER_EXISTS_BETWEEN_ABS",INTEGER_EXISTS_BETWEEN_ABS; +"INTEGER_EXISTS_BETWEEN_ABS_LT",INTEGER_EXISTS_BETWEEN_ABS_LT; +"INTEGER_EXISTS_BETWEEN_ALT",INTEGER_EXISTS_BETWEEN_ALT; +"INTEGER_EXISTS_BETWEEN_LT",INTEGER_EXISTS_BETWEEN_LT; +"INTEGER_MUL",INTEGER_MUL; +"INTEGER_NEG",INTEGER_NEG; +"INTEGER_POS",INTEGER_POS; +"INTEGER_POW",INTEGER_POW; +"INTEGER_PRODUCT",INTEGER_PRODUCT; +"INTEGER_ROUND",INTEGER_ROUND; +"INTEGER_SIGN",INTEGER_SIGN; +"INTEGER_SUB",INTEGER_SUB; +"INTEGER_SUB_EQ",INTEGER_SUB_EQ; +"INTEGER_SUM",INTEGER_SUM; +"INTEGER_WINDING_NUMBER",INTEGER_WINDING_NUMBER; +"INTEGER_WINDING_NUMBER_EQ",INTEGER_WINDING_NUMBER_EQ; +"INTEGRABLE_0",INTEGRABLE_0; +"INTEGRABLE_ADD",INTEGRABLE_ADD; +"INTEGRABLE_AFFINITY",INTEGRABLE_AFFINITY; +"INTEGRABLE_ALT",INTEGRABLE_ALT; +"INTEGRABLE_ALT_SUBSET",INTEGRABLE_ALT_SUBSET; +"INTEGRABLE_BOUNDED_VARIATION_PRODUCT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT; +"INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT; +"INTEGRABLE_BY_PARTS",INTEGRABLE_BY_PARTS; +"INTEGRABLE_BY_PARTS_EQ",INTEGRABLE_BY_PARTS_EQ; +"INTEGRABLE_CASES",INTEGRABLE_CASES; +"INTEGRABLE_CAUCHY",INTEGRABLE_CAUCHY; +"INTEGRABLE_CCONTINUOUS_EXPLICIT",INTEGRABLE_CCONTINUOUS_EXPLICIT; +"INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC",INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC; +"INTEGRABLE_CMUL",INTEGRABLE_CMUL; +"INTEGRABLE_CMUL_EQ",INTEGRABLE_CMUL_EQ; +"INTEGRABLE_COMBINE",INTEGRABLE_COMBINE; +"INTEGRABLE_COMBINE_DIVISION",INTEGRABLE_COMBINE_DIVISION; +"INTEGRABLE_COMPLEX_0",INTEGRABLE_COMPLEX_0; +"INTEGRABLE_COMPLEX_LMUL",INTEGRABLE_COMPLEX_LMUL; +"INTEGRABLE_COMPLEX_LMUL_EQ",INTEGRABLE_COMPLEX_LMUL_EQ; +"INTEGRABLE_COMPLEX_RMUL",INTEGRABLE_COMPLEX_RMUL; +"INTEGRABLE_COMPLEX_RMUL_EQ",INTEGRABLE_COMPLEX_RMUL_EQ; +"INTEGRABLE_COMPONENTWISE",INTEGRABLE_COMPONENTWISE; +"INTEGRABLE_CONST",INTEGRABLE_CONST; +"INTEGRABLE_CONTINUOUS",INTEGRABLE_CONTINUOUS; +"INTEGRABLE_DECREASING",INTEGRABLE_DECREASING; +"INTEGRABLE_DECREASING_1",INTEGRABLE_DECREASING_1; +"INTEGRABLE_DECREASING_PRODUCT",INTEGRABLE_DECREASING_PRODUCT; +"INTEGRABLE_DECREASING_PRODUCT_UNIV",INTEGRABLE_DECREASING_PRODUCT_UNIV; +"INTEGRABLE_EQ",INTEGRABLE_EQ; +"INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE",INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE; +"INTEGRABLE_IMP_MEASURABLE",INTEGRABLE_IMP_MEASURABLE; +"INTEGRABLE_IMP_REAL_MEASURABLE",INTEGRABLE_IMP_REAL_MEASURABLE; +"INTEGRABLE_INCREASING",INTEGRABLE_INCREASING; +"INTEGRABLE_INCREASING_1",INTEGRABLE_INCREASING_1; +"INTEGRABLE_INCREASING_PRODUCT",INTEGRABLE_INCREASING_PRODUCT; +"INTEGRABLE_INCREASING_PRODUCT_UNIV",INTEGRABLE_INCREASING_PRODUCT_UNIV; +"INTEGRABLE_INTEGRAL",INTEGRABLE_INTEGRAL; +"INTEGRABLE_LINEAR",INTEGRABLE_LINEAR; +"INTEGRABLE_MIN_CONST_1",INTEGRABLE_MIN_CONST_1; +"INTEGRABLE_NEG",INTEGRABLE_NEG; +"INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND",INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND; +"INTEGRABLE_ON_CONST",INTEGRABLE_ON_CONST; +"INTEGRABLE_ON_EMPTY",INTEGRABLE_ON_EMPTY; +"INTEGRABLE_ON_LITTLE_SUBINTERVALS",INTEGRABLE_ON_LITTLE_SUBINTERVALS; +"INTEGRABLE_ON_NULL",INTEGRABLE_ON_NULL; +"INTEGRABLE_ON_OPEN_INTERVAL",INTEGRABLE_ON_OPEN_INTERVAL; +"INTEGRABLE_ON_REFL",INTEGRABLE_ON_REFL; +"INTEGRABLE_ON_SUBDIVISION",INTEGRABLE_ON_SUBDIVISION; +"INTEGRABLE_ON_SUBINTERVAL",INTEGRABLE_ON_SUBINTERVAL; +"INTEGRABLE_ON_SUPERSET",INTEGRABLE_ON_SUPERSET; +"INTEGRABLE_PASTECART_SYM",INTEGRABLE_PASTECART_SYM; +"INTEGRABLE_PASTECART_SYM_UNIV",INTEGRABLE_PASTECART_SYM_UNIV; +"INTEGRABLE_REFLECT",INTEGRABLE_REFLECT; +"INTEGRABLE_REFLECT_GEN",INTEGRABLE_REFLECT_GEN; +"INTEGRABLE_RESTRICT",INTEGRABLE_RESTRICT; +"INTEGRABLE_RESTRICT_INTER",INTEGRABLE_RESTRICT_INTER; +"INTEGRABLE_RESTRICT_UNIV",INTEGRABLE_RESTRICT_UNIV; +"INTEGRABLE_SPIKE",INTEGRABLE_SPIKE; +"INTEGRABLE_SPIKE_EQ",INTEGRABLE_SPIKE_EQ; +"INTEGRABLE_SPIKE_FINITE",INTEGRABLE_SPIKE_FINITE; +"INTEGRABLE_SPIKE_INTERIOR",INTEGRABLE_SPIKE_INTERIOR; +"INTEGRABLE_SPIKE_SET",INTEGRABLE_SPIKE_SET; +"INTEGRABLE_SPIKE_SET_EQ",INTEGRABLE_SPIKE_SET_EQ; +"INTEGRABLE_SPLIT",INTEGRABLE_SPLIT; +"INTEGRABLE_STRADDLE",INTEGRABLE_STRADDLE; +"INTEGRABLE_STRADDLE_INTERVAL",INTEGRABLE_STRADDLE_INTERVAL; +"INTEGRABLE_STRETCH",INTEGRABLE_STRETCH; +"INTEGRABLE_SUB",INTEGRABLE_SUB; +"INTEGRABLE_SUBINTERVAL",INTEGRABLE_SUBINTERVAL; +"INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE",INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE; +"INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE",INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE; +"INTEGRABLE_UNIFORM_LIMIT",INTEGRABLE_UNIFORM_LIMIT; +"INTEGRABLE_VSUM",INTEGRABLE_VSUM; +"INTEGRAL_0",INTEGRAL_0; +"INTEGRAL_ADD",INTEGRAL_ADD; +"INTEGRAL_CMUL",INTEGRAL_CMUL; +"INTEGRAL_COMBINE",INTEGRAL_COMBINE; +"INTEGRAL_COMBINE_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_DIVISION_BOTTOMUP; +"INTEGRAL_COMBINE_DIVISION_TOPDOWN",INTEGRAL_COMBINE_DIVISION_TOPDOWN; +"INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP; +"INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; +"INTEGRAL_COMPLEX_LMUL",INTEGRAL_COMPLEX_LMUL; +"INTEGRAL_COMPLEX_RMUL",INTEGRAL_COMPLEX_RMUL; +"INTEGRAL_COMPONENT",INTEGRAL_COMPONENT; +"INTEGRAL_COMPONENT_LBOUND",INTEGRAL_COMPONENT_LBOUND; +"INTEGRAL_COMPONENT_LE",INTEGRAL_COMPONENT_LE; +"INTEGRAL_COMPONENT_LE_AE",INTEGRAL_COMPONENT_LE_AE; +"INTEGRAL_COMPONENT_POS",INTEGRAL_COMPONENT_POS; +"INTEGRAL_COMPONENT_UBOUND",INTEGRAL_COMPONENT_UBOUND; +"INTEGRAL_CONST",INTEGRAL_CONST; +"INTEGRAL_DIFF",INTEGRAL_DIFF; +"INTEGRAL_DROP_LE",INTEGRAL_DROP_LE; +"INTEGRAL_DROP_LE_AE",INTEGRAL_DROP_LE_AE; +"INTEGRAL_DROP_LE_MEASURABLE",INTEGRAL_DROP_LE_MEASURABLE; +"INTEGRAL_DROP_POS",INTEGRAL_DROP_POS; +"INTEGRAL_DROP_POS_AE",INTEGRAL_DROP_POS_AE; +"INTEGRAL_EMPTY",INTEGRAL_EMPTY; +"INTEGRAL_EQ",INTEGRAL_EQ; +"INTEGRAL_EQ_0",INTEGRAL_EQ_0; +"INTEGRAL_EQ_HAS_INTEGRAL",INTEGRAL_EQ_HAS_INTEGRAL; +"INTEGRAL_HAS_VECTOR_DERIVATIVE",INTEGRAL_HAS_VECTOR_DERIVATIVE; +"INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE",INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE; +"INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION; +"INTEGRAL_INTERVALS_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION; +"INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT; +"INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT; +"INTEGRAL_LINEAR",INTEGRAL_LINEAR; +"INTEGRAL_MEASURE",INTEGRAL_MEASURE; +"INTEGRAL_MEASURE_UNIV",INTEGRAL_MEASURE_UNIV; +"INTEGRAL_NEG",INTEGRAL_NEG; +"INTEGRAL_NORM_BOUND_INTEGRAL",INTEGRAL_NORM_BOUND_INTEGRAL; +"INTEGRAL_NORM_BOUND_INTEGRAL_AE",INTEGRAL_NORM_BOUND_INTEGRAL_AE; +"INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; +"INTEGRAL_NULL",INTEGRAL_NULL; +"INTEGRAL_OPEN_INTERVAL",INTEGRAL_OPEN_INTERVAL; +"INTEGRAL_PASTECART_CONST",INTEGRAL_PASTECART_CONST; +"INTEGRAL_PASTECART_CONTINUOUS",INTEGRAL_PASTECART_CONTINUOUS; +"INTEGRAL_PASTECART_SYM",INTEGRAL_PASTECART_SYM; +"INTEGRAL_PASTECART_SYM_UNIV",INTEGRAL_PASTECART_SYM_UNIV; +"INTEGRAL_REFL",INTEGRAL_REFL; +"INTEGRAL_REFLECT",INTEGRAL_REFLECT; +"INTEGRAL_REFLECT_GEN",INTEGRAL_REFLECT_GEN; +"INTEGRAL_RESTRICT",INTEGRAL_RESTRICT; +"INTEGRAL_RESTRICT_INTER",INTEGRAL_RESTRICT_INTER; +"INTEGRAL_RESTRICT_UNIV",INTEGRAL_RESTRICT_UNIV; +"INTEGRAL_SPIKE",INTEGRAL_SPIKE; +"INTEGRAL_SPIKE_SET",INTEGRAL_SPIKE_SET; +"INTEGRAL_SPLIT",INTEGRAL_SPLIT; +"INTEGRAL_SPLIT_SIGNED",INTEGRAL_SPLIT_SIGNED; +"INTEGRAL_SUB",INTEGRAL_SUB; +"INTEGRAL_SUBSET_COMPONENT_LE",INTEGRAL_SUBSET_COMPONENT_LE; +"INTEGRAL_SUBSET_DROP_LE",INTEGRAL_SUBSET_DROP_LE; +"INTEGRAL_SWAP_CONTINUOUS",INTEGRAL_SWAP_CONTINUOUS; +"INTEGRAL_UNION",INTEGRAL_UNION; +"INTEGRAL_UNIQUE",INTEGRAL_UNIQUE; +"INTEGRAL_VSUM",INTEGRAL_VSUM; +"INTEGRATION_BY_PARTS",INTEGRATION_BY_PARTS; +"INTEGRATION_BY_PARTS_SIMPLE",INTEGRATION_BY_PARTS_SIMPLE; +"INTER",INTER; +"INTERIOR_BALL",INTERIOR_BALL; +"INTERIOR_BIJECTIVE_LINEAR_IMAGE",INTERIOR_BIJECTIVE_LINEAR_IMAGE; +"INTERIOR_CBALL",INTERIOR_CBALL; +"INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER",INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER; +"INTERIOR_CLOSED_INTERVAL",INTERIOR_CLOSED_INTERVAL; +"INTERIOR_CLOSED_UNION_EMPTY_INTERIOR",INTERIOR_CLOSED_UNION_EMPTY_INTERIOR; +"INTERIOR_CLOSURE",INTERIOR_CLOSURE; +"INTERIOR_CLOSURE_IDEMP",INTERIOR_CLOSURE_IDEMP; +"INTERIOR_CLOSURE_INTER_OPEN",INTERIOR_CLOSURE_INTER_OPEN; +"INTERIOR_COMPLEMENT",INTERIOR_COMPLEMENT; +"INTERIOR_CONVEX_HULL_3",INTERIOR_CONVEX_HULL_3; +"INTERIOR_CONVEX_HULL_3_MINIMAL",INTERIOR_CONVEX_HULL_3_MINIMAL; +"INTERIOR_CONVEX_HULL_EQ_EMPTY",INTERIOR_CONVEX_HULL_EQ_EMPTY; +"INTERIOR_CONVEX_HULL_EXPLICIT",INTERIOR_CONVEX_HULL_EXPLICIT; +"INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL",INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL; +"INTERIOR_DIFF",INTERIOR_DIFF; +"INTERIOR_EMPTY",INTERIOR_EMPTY; +"INTERIOR_EQ",INTERIOR_EQ; +"INTERIOR_EQ_EMPTY",INTERIOR_EQ_EMPTY; +"INTERIOR_EQ_EMPTY_ALT",INTERIOR_EQ_EMPTY_ALT; +"INTERIOR_FINITE_INTERS",INTERIOR_FINITE_INTERS; +"INTERIOR_FRONTIER",INTERIOR_FRONTIER; +"INTERIOR_FRONTIER_EMPTY",INTERIOR_FRONTIER_EMPTY; +"INTERIOR_HALFSPACE_COMPONENT_GE",INTERIOR_HALFSPACE_COMPONENT_GE; +"INTERIOR_HALFSPACE_COMPONENT_LE",INTERIOR_HALFSPACE_COMPONENT_LE; +"INTERIOR_HALFSPACE_GE",INTERIOR_HALFSPACE_GE; +"INTERIOR_HALFSPACE_LE",INTERIOR_HALFSPACE_LE; +"INTERIOR_HYPERPLANE",INTERIOR_HYPERPLANE; +"INTERIOR_IMAGE_SUBSET",INTERIOR_IMAGE_SUBSET; +"INTERIOR_INJECTIVE_LINEAR_IMAGE",INTERIOR_INJECTIVE_LINEAR_IMAGE; +"INTERIOR_INSIDE_FRONTIER",INTERIOR_INSIDE_FRONTIER; +"INTERIOR_INTER",INTERIOR_INTER; +"INTERIOR_INTERIOR",INTERIOR_INTERIOR; +"INTERIOR_INTERS_SUBSET",INTERIOR_INTERS_SUBSET; +"INTERIOR_INTERVAL",INTERIOR_INTERVAL; +"INTERIOR_LIMIT_POINT",INTERIOR_LIMIT_POINT; +"INTERIOR_MAXIMAL",INTERIOR_MAXIMAL; +"INTERIOR_MAXIMAL_EQ",INTERIOR_MAXIMAL_EQ; +"INTERIOR_NEGATIONS",INTERIOR_NEGATIONS; +"INTERIOR_OF_TRIANGLE",INTERIOR_OF_TRIANGLE; +"INTERIOR_OPEN",INTERIOR_OPEN; +"INTERIOR_PCROSS",INTERIOR_PCROSS; +"INTERIOR_SEGMENT",INTERIOR_SEGMENT; +"INTERIOR_SIMPLEX_NONEMPTY",INTERIOR_SIMPLEX_NONEMPTY; +"INTERIOR_SING",INTERIOR_SING; +"INTERIOR_STANDARD_HYPERPLANE",INTERIOR_STANDARD_HYPERPLANE; +"INTERIOR_STD_SIMPLEX",INTERIOR_STD_SIMPLEX; +"INTERIOR_SUBSET",INTERIOR_SUBSET; +"INTERIOR_SUBSET_RELATIVE_INTERIOR",INTERIOR_SUBSET_RELATIVE_INTERIOR; +"INTERIOR_SUBSET_UNION_INTERVALS",INTERIOR_SUBSET_UNION_INTERVALS; +"INTERIOR_SURJECTIVE_LINEAR_IMAGE",INTERIOR_SURJECTIVE_LINEAR_IMAGE; +"INTERIOR_TRANSLATION",INTERIOR_TRANSLATION; +"INTERIOR_UNIONS_OPEN_SUBSETS",INTERIOR_UNIONS_OPEN_SUBSETS; +"INTERIOR_UNION_EQ_EMPTY",INTERIOR_UNION_EQ_EMPTY; +"INTERIOR_UNIQUE",INTERIOR_UNIQUE; +"INTERIOR_UNIV",INTERIOR_UNIV; +"INTERS",INTERS; +"INTERS_0",INTERS_0; +"INTERS_1",INTERS_1; +"INTERS_2",INTERS_2; +"INTERS_FACES_FINITE_ALTBOUND",INTERS_FACES_FINITE_ALTBOUND; +"INTERS_FACES_FINITE_BOUND",INTERS_FACES_FINITE_BOUND; +"INTERS_GSPEC",INTERS_GSPEC; +"INTERS_IMAGE",INTERS_IMAGE; +"INTERS_INSERT",INTERS_INSERT; +"INTERS_OVER_UNIONS",INTERS_OVER_UNIONS; +"INTERS_UNION",INTERS_UNION; +"INTERS_UNIONS",INTERS_UNIONS; +"INTERVAL_BIJ_AFFINE",INTERVAL_BIJ_AFFINE; +"INTERVAL_BIJ_BIJ",INTERVAL_BIJ_BIJ; +"INTERVAL_BISECTION",INTERVAL_BISECTION; +"INTERVAL_BISECTION_STEP",INTERVAL_BISECTION_STEP; +"INTERVAL_BOUNDS_EMPTY_1",INTERVAL_BOUNDS_EMPTY_1; +"INTERVAL_BOUNDS_NULL_1",INTERVAL_BOUNDS_NULL_1; +"INTERVAL_CASES_1",INTERVAL_CASES_1; +"INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD",INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD; +"INTERVAL_DOUBLESPLIT",INTERVAL_DOUBLESPLIT; +"INTERVAL_EQ_EMPTY",INTERVAL_EQ_EMPTY; +"INTERVAL_EQ_EMPTY_1",INTERVAL_EQ_EMPTY_1; +"INTERVAL_IMAGE_AFFINITY_INTERVAL",INTERVAL_IMAGE_AFFINITY_INTERVAL; +"INTERVAL_IMAGE_STRETCH_INTERVAL",INTERVAL_IMAGE_STRETCH_INTERVAL; +"INTERVAL_INTER_HYPERPLANE",INTERVAL_INTER_HYPERPLANE; +"INTERVAL_LOWERBOUND",INTERVAL_LOWERBOUND; +"INTERVAL_LOWERBOUND_1",INTERVAL_LOWERBOUND_1; +"INTERVAL_LOWERBOUND_NONEMPTY",INTERVAL_LOWERBOUND_NONEMPTY; +"INTERVAL_NE_EMPTY",INTERVAL_NE_EMPTY; +"INTERVAL_NE_EMPTY_1",INTERVAL_NE_EMPTY_1; +"INTERVAL_OPEN_SUBSET_CLOSED",INTERVAL_OPEN_SUBSET_CLOSED; +"INTERVAL_REAL_INTERVAL",INTERVAL_REAL_INTERVAL; +"INTERVAL_SING",INTERVAL_SING; +"INTERVAL_SPLIT",INTERVAL_SPLIT; +"INTERVAL_SUBDIVISION",INTERVAL_SUBDIVISION; +"INTERVAL_SUBSET_IS_INTERVAL",INTERVAL_SUBSET_IS_INTERVAL; +"INTERVAL_TRANSLATION",INTERVAL_TRANSLATION; +"INTERVAL_UPPERBOUND",INTERVAL_UPPERBOUND; +"INTERVAL_UPPERBOUND_1",INTERVAL_UPPERBOUND_1; +"INTERVAL_UPPERBOUND_NONEMPTY",INTERVAL_UPPERBOUND_NONEMPTY; +"INTER_ACI",INTER_ACI; +"INTER_ASSOC",INTER_ASSOC; +"INTER_BALLS_EQ_EMPTY",INTER_BALLS_EQ_EMPTY; +"INTER_COMM",INTER_COMM; +"INTER_EMPTY",INTER_EMPTY; +"INTER_IDEMPOT",INTER_IDEMPOT; +"INTER_INTERIOR_UNIONS_INTERVALS",INTER_INTERIOR_UNIONS_INTERVALS; +"INTER_INTERVAL",INTER_INTERVAL; +"INTER_INTERVAL_1",INTER_INTERVAL_1; +"INTER_INTERVAL_MIXED_EQ_EMPTY",INTER_INTERVAL_MIXED_EQ_EMPTY; +"INTER_OVER_UNION",INTER_OVER_UNION; +"INTER_PCROSS",INTER_PCROSS; +"INTER_SEGMENT",INTER_SEGMENT; +"INTER_SUBSET",INTER_SUBSET; +"INTER_UNIONS",INTER_UNIONS; +"INTER_UNIV",INTER_UNIV; +"INT_ABS",INT_ABS; +"INT_ABS_0",INT_ABS_0; +"INT_ABS_1",INT_ABS_1; +"INT_ABS_ABS",INT_ABS_ABS; +"INT_ABS_BETWEEN",INT_ABS_BETWEEN; +"INT_ABS_BETWEEN1",INT_ABS_BETWEEN1; +"INT_ABS_BETWEEN2",INT_ABS_BETWEEN2; +"INT_ABS_BOUND",INT_ABS_BOUND; +"INT_ABS_CASES",INT_ABS_CASES; +"INT_ABS_CIRCLE",INT_ABS_CIRCLE; +"INT_ABS_LE",INT_ABS_LE; +"INT_ABS_MUL",INT_ABS_MUL; +"INT_ABS_MUL_1",INT_ABS_MUL_1; +"INT_ABS_NEG",INT_ABS_NEG; +"INT_ABS_NUM",INT_ABS_NUM; +"INT_ABS_NZ",INT_ABS_NZ; +"INT_ABS_POS",INT_ABS_POS; +"INT_ABS_POW",INT_ABS_POW; +"INT_ABS_REFL",INT_ABS_REFL; +"INT_ABS_SGN",INT_ABS_SGN; +"INT_ABS_SIGN",INT_ABS_SIGN; +"INT_ABS_SIGN2",INT_ABS_SIGN2; +"INT_ABS_STILLNZ",INT_ABS_STILLNZ; +"INT_ABS_SUB",INT_ABS_SUB; +"INT_ABS_SUB_ABS",INT_ABS_SUB_ABS; +"INT_ABS_TRIANGLE",INT_ABS_TRIANGLE; +"INT_ABS_ZERO",INT_ABS_ZERO; +"INT_ADD2_SUB2",INT_ADD2_SUB2; +"INT_ADD_AC",INT_ADD_AC; +"INT_ADD_ASSOC",INT_ADD_ASSOC; +"INT_ADD_LDISTRIB",INT_ADD_LDISTRIB; +"INT_ADD_LID",INT_ADD_LID; +"INT_ADD_LINV",INT_ADD_LINV; +"INT_ADD_RDISTRIB",INT_ADD_RDISTRIB; +"INT_ADD_RID",INT_ADD_RID; +"INT_ADD_RINV",INT_ADD_RINV; +"INT_ADD_SUB",INT_ADD_SUB; +"INT_ADD_SUB2",INT_ADD_SUB2; +"INT_ADD_SYM",INT_ADD_SYM; +"INT_ARCH",INT_ARCH; +"INT_BOUNDS_LE",INT_BOUNDS_LE; +"INT_BOUNDS_LT",INT_BOUNDS_LT; +"INT_DIFFSQ",INT_DIFFSQ; +"INT_DIVISION",INT_DIVISION; +"INT_DIVISION_0",INT_DIVISION_0; +"INT_DIVMOD_EXIST_0",INT_DIVMOD_EXIST_0; +"INT_DIVMOD_UNIQ",INT_DIVMOD_UNIQ; +"INT_ENTIRE",INT_ENTIRE; +"INT_EQ_ADD_LCANCEL",INT_EQ_ADD_LCANCEL; +"INT_EQ_ADD_LCANCEL_0",INT_EQ_ADD_LCANCEL_0; +"INT_EQ_ADD_RCANCEL",INT_EQ_ADD_RCANCEL; +"INT_EQ_ADD_RCANCEL_0",INT_EQ_ADD_RCANCEL_0; +"INT_EQ_IMP_LE",INT_EQ_IMP_LE; +"INT_EQ_MUL_LCANCEL",INT_EQ_MUL_LCANCEL; +"INT_EQ_MUL_RCANCEL",INT_EQ_MUL_RCANCEL; +"INT_EQ_NEG2",INT_EQ_NEG2; +"INT_EQ_SGN_ABS",INT_EQ_SGN_ABS; +"INT_EQ_SQUARE_ABS",INT_EQ_SQUARE_ABS; +"INT_EQ_SUB_LADD",INT_EQ_SUB_LADD; +"INT_EQ_SUB_RADD",INT_EQ_SUB_RADD; +"INT_EXISTS_ABS",INT_EXISTS_ABS; +"INT_EXISTS_POS",INT_EXISTS_POS; +"INT_FORALL_ABS",INT_FORALL_ABS; +"INT_FORALL_POS",INT_FORALL_POS; +"INT_GCD_EXISTS",INT_GCD_EXISTS; +"INT_GCD_EXISTS_POS",INT_GCD_EXISTS_POS; +"INT_GE",INT_GE; +"INT_GT",INT_GT; +"INT_GT_DISCRETE",INT_GT_DISCRETE; +"INT_IMAGE",INT_IMAGE; +"INT_LET_ADD",INT_LET_ADD; +"INT_LET_ADD2",INT_LET_ADD2; +"INT_LET_ANTISYM",INT_LET_ANTISYM; +"INT_LET_TOTAL",INT_LET_TOTAL; +"INT_LET_TRANS",INT_LET_TRANS; +"INT_LE_01",INT_LE_01; +"INT_LE_ADD",INT_LE_ADD; +"INT_LE_ADD2",INT_LE_ADD2; +"INT_LE_ADDL",INT_LE_ADDL; +"INT_LE_ADDR",INT_LE_ADDR; +"INT_LE_ANTISYM",INT_LE_ANTISYM; +"INT_LE_DISCRETE",INT_LE_DISCRETE; +"INT_LE_DOUBLE",INT_LE_DOUBLE; +"INT_LE_LADD",INT_LE_LADD; +"INT_LE_LADD_IMP",INT_LE_LADD_IMP; +"INT_LE_LMUL",INT_LE_LMUL; +"INT_LE_LNEG",INT_LE_LNEG; +"INT_LE_LT",INT_LE_LT; +"INT_LE_MAX",INT_LE_MAX; +"INT_LE_MIN",INT_LE_MIN; +"INT_LE_MUL",INT_LE_MUL; +"INT_LE_MUL_EQ",INT_LE_MUL_EQ; +"INT_LE_NEG",INT_LE_NEG; +"INT_LE_NEG2",INT_LE_NEG2; +"INT_LE_NEGL",INT_LE_NEGL; +"INT_LE_NEGR",INT_LE_NEGR; +"INT_LE_NEGTOTAL",INT_LE_NEGTOTAL; +"INT_LE_POW2",INT_LE_POW2; +"INT_LE_RADD",INT_LE_RADD; +"INT_LE_REFL",INT_LE_REFL; +"INT_LE_RMUL",INT_LE_RMUL; +"INT_LE_RNEG",INT_LE_RNEG; +"INT_LE_SQUARE",INT_LE_SQUARE; +"INT_LE_SQUARE_ABS",INT_LE_SQUARE_ABS; +"INT_LE_SUB_LADD",INT_LE_SUB_LADD; +"INT_LE_SUB_RADD",INT_LE_SUB_RADD; +"INT_LE_TOTAL",INT_LE_TOTAL; +"INT_LE_TRANS",INT_LE_TRANS; +"INT_LNEG_UNIQ",INT_LNEG_UNIQ; +"INT_LT",INT_LT; +"INT_LTE_ADD",INT_LTE_ADD; +"INT_LTE_ADD2",INT_LTE_ADD2; +"INT_LTE_ANTISYM",INT_LTE_ANTISYM; +"INT_LTE_TOTAL",INT_LTE_TOTAL; +"INT_LTE_TRANS",INT_LTE_TRANS; +"INT_LT_01",INT_LT_01; +"INT_LT_ADD",INT_LT_ADD; +"INT_LT_ADD1",INT_LT_ADD1; +"INT_LT_ADD2",INT_LT_ADD2; +"INT_LT_ADDL",INT_LT_ADDL; +"INT_LT_ADDNEG",INT_LT_ADDNEG; +"INT_LT_ADDNEG2",INT_LT_ADDNEG2; +"INT_LT_ADDR",INT_LT_ADDR; +"INT_LT_ADD_SUB",INT_LT_ADD_SUB; +"INT_LT_ANTISYM",INT_LT_ANTISYM; +"INT_LT_DISCRETE",INT_LT_DISCRETE; +"INT_LT_GT",INT_LT_GT; +"INT_LT_IMP_LE",INT_LT_IMP_LE; +"INT_LT_IMP_NE",INT_LT_IMP_NE; +"INT_LT_LADD",INT_LT_LADD; +"INT_LT_LE",INT_LT_LE; +"INT_LT_LMUL_EQ",INT_LT_LMUL_EQ; +"INT_LT_MAX",INT_LT_MAX; +"INT_LT_MIN",INT_LT_MIN; +"INT_LT_MUL",INT_LT_MUL; +"INT_LT_MUL_EQ",INT_LT_MUL_EQ; +"INT_LT_NEG",INT_LT_NEG; +"INT_LT_NEG2",INT_LT_NEG2; +"INT_LT_NEGTOTAL",INT_LT_NEGTOTAL; +"INT_LT_POW2",INT_LT_POW2; +"INT_LT_RADD",INT_LT_RADD; +"INT_LT_REFL",INT_LT_REFL; +"INT_LT_RMUL_EQ",INT_LT_RMUL_EQ; +"INT_LT_SQUARE_ABS",INT_LT_SQUARE_ABS; +"INT_LT_SUB_LADD",INT_LT_SUB_LADD; +"INT_LT_SUB_RADD",INT_LT_SUB_RADD; +"INT_LT_TOTAL",INT_LT_TOTAL; +"INT_LT_TRANS",INT_LT_TRANS; +"INT_MAX",INT_MAX; +"INT_MAX_ACI",INT_MAX_ACI; +"INT_MAX_ASSOC",INT_MAX_ASSOC; +"INT_MAX_LE",INT_MAX_LE; +"INT_MAX_LT",INT_MAX_LT; +"INT_MAX_MAX",INT_MAX_MAX; +"INT_MAX_MIN",INT_MAX_MIN; +"INT_MAX_SYM",INT_MAX_SYM; +"INT_MIN",INT_MIN; +"INT_MIN_ACI",INT_MIN_ACI; +"INT_MIN_ASSOC",INT_MIN_ASSOC; +"INT_MIN_LE",INT_MIN_LE; +"INT_MIN_LT",INT_MIN_LT; +"INT_MIN_MAX",INT_MIN_MAX; +"INT_MIN_MIN",INT_MIN_MIN; +"INT_MIN_SYM",INT_MIN_SYM; +"INT_MUL_AC",INT_MUL_AC; +"INT_MUL_ASSOC",INT_MUL_ASSOC; +"INT_MUL_LID",INT_MUL_LID; +"INT_MUL_LNEG",INT_MUL_LNEG; +"INT_MUL_LZERO",INT_MUL_LZERO; +"INT_MUL_POS_LE",INT_MUL_POS_LE; +"INT_MUL_POS_LT",INT_MUL_POS_LT; +"INT_MUL_RID",INT_MUL_RID; +"INT_MUL_RNEG",INT_MUL_RNEG; +"INT_MUL_RZERO",INT_MUL_RZERO; +"INT_MUL_SYM",INT_MUL_SYM; +"INT_NEGNEG",INT_NEGNEG; +"INT_NEG_0",INT_NEG_0; +"INT_NEG_ADD",INT_NEG_ADD; +"INT_NEG_EQ",INT_NEG_EQ; +"INT_NEG_EQ_0",INT_NEG_EQ_0; +"INT_NEG_GE0",INT_NEG_GE0; +"INT_NEG_GT0",INT_NEG_GT0; +"INT_NEG_LE0",INT_NEG_LE0; +"INT_NEG_LMUL",INT_NEG_LMUL; +"INT_NEG_LT0",INT_NEG_LT0; +"INT_NEG_MINUS1",INT_NEG_MINUS1; +"INT_NEG_MUL2",INT_NEG_MUL2; +"INT_NEG_NEG",INT_NEG_NEG; +"INT_NEG_RMUL",INT_NEG_RMUL; +"INT_NEG_SUB",INT_NEG_SUB; +"INT_NOT_EQ",INT_NOT_EQ; +"INT_NOT_LE",INT_NOT_LE; +"INT_NOT_LT",INT_NOT_LT; +"INT_OF_NUM_ADD",INT_OF_NUM_ADD; +"INT_OF_NUM_EQ",INT_OF_NUM_EQ; +"INT_OF_NUM_EXISTS",INT_OF_NUM_EXISTS; +"INT_OF_NUM_GE",INT_OF_NUM_GE; +"INT_OF_NUM_GT",INT_OF_NUM_GT; +"INT_OF_NUM_LE",INT_OF_NUM_LE; +"INT_OF_NUM_LT",INT_OF_NUM_LT; +"INT_OF_NUM_MAX",INT_OF_NUM_MAX; +"INT_OF_NUM_MIN",INT_OF_NUM_MIN; +"INT_OF_NUM_MUL",INT_OF_NUM_MUL; +"INT_OF_NUM_OF_INT",INT_OF_NUM_OF_INT; +"INT_OF_NUM_POW",INT_OF_NUM_POW; +"INT_OF_NUM_SUB",INT_OF_NUM_SUB; +"INT_OF_NUM_SUC",INT_OF_NUM_SUC; +"INT_OF_REAL_OF_INT",INT_OF_REAL_OF_INT; +"INT_POS",INT_POS; +"INT_POS_NZ",INT_POS_NZ; +"INT_POW",INT_POW; +"INT_POW2_ABS",INT_POW2_ABS; +"INT_POW_1",INT_POW_1; +"INT_POW_1_LE",INT_POW_1_LE; +"INT_POW_1_LT",INT_POW_1_LT; +"INT_POW_2",INT_POW_2; +"INT_POW_ADD",INT_POW_ADD; +"INT_POW_EQ",INT_POW_EQ; +"INT_POW_EQ_0",INT_POW_EQ_0; +"INT_POW_EQ_ABS",INT_POW_EQ_ABS; +"INT_POW_LE",INT_POW_LE; +"INT_POW_LE2",INT_POW_LE2; +"INT_POW_LE2_ODD",INT_POW_LE2_ODD; +"INT_POW_LE2_REV",INT_POW_LE2_REV; +"INT_POW_LE_1",INT_POW_LE_1; +"INT_POW_LT",INT_POW_LT; +"INT_POW_LT2",INT_POW_LT2; +"INT_POW_LT2_REV",INT_POW_LT2_REV; +"INT_POW_LT_1",INT_POW_LT_1; +"INT_POW_MONO",INT_POW_MONO; +"INT_POW_MONO_LT",INT_POW_MONO_LT; +"INT_POW_MUL",INT_POW_MUL; +"INT_POW_NEG",INT_POW_NEG; +"INT_POW_NZ",INT_POW_NZ; +"INT_POW_ONE",INT_POW_ONE; +"INT_POW_POW",INT_POW_POW; +"INT_POW_ZERO",INT_POW_ZERO; +"INT_RNEG_UNIQ",INT_RNEG_UNIQ; +"INT_SGN",INT_SGN; +"INT_SGN_0",INT_SGN_0; +"INT_SGN_ABS",INT_SGN_ABS; +"INT_SGN_CASES",INT_SGN_CASES; +"INT_SGN_EQ",INT_SGN_EQ; +"INT_SGN_INEQS",INT_SGN_INEQS; +"INT_SGN_INT_SGN",INT_SGN_INT_SGN; +"INT_SGN_MUL",INT_SGN_MUL; +"INT_SGN_NEG",INT_SGN_NEG; +"INT_SGN_POW",INT_SGN_POW; +"INT_SGN_POW_2",INT_SGN_POW_2; +"INT_SOS_EQ_0",INT_SOS_EQ_0; +"INT_SUB",INT_SUB; +"INT_SUB_0",INT_SUB_0; +"INT_SUB_ABS",INT_SUB_ABS; +"INT_SUB_ADD",INT_SUB_ADD; +"INT_SUB_ADD2",INT_SUB_ADD2; +"INT_SUB_LDISTRIB",INT_SUB_LDISTRIB; +"INT_SUB_LE",INT_SUB_LE; +"INT_SUB_LNEG",INT_SUB_LNEG; +"INT_SUB_LT",INT_SUB_LT; +"INT_SUB_LZERO",INT_SUB_LZERO; +"INT_SUB_NEG2",INT_SUB_NEG2; +"INT_SUB_RDISTRIB",INT_SUB_RDISTRIB; +"INT_SUB_REFL",INT_SUB_REFL; +"INT_SUB_RNEG",INT_SUB_RNEG; +"INT_SUB_RZERO",INT_SUB_RZERO; +"INT_SUB_SUB",INT_SUB_SUB; +"INT_SUB_SUB2",INT_SUB_SUB2; +"INT_SUB_TRIANGLE",INT_SUB_TRIANGLE; +"INT_WOP",INT_WOP; +"INVARIANCE_OF_DIMENSION",INVARIANCE_OF_DIMENSION; +"INVARIANCE_OF_DIMENSION_AFFINE_SETS",INVARIANCE_OF_DIMENSION_AFFINE_SETS; +"INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN",INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN; +"INVARIANCE_OF_DIMENSION_SUBSPACES",INVARIANCE_OF_DIMENSION_SUBSPACES; +"INVARIANCE_OF_DOMAIN",INVARIANCE_OF_DOMAIN; +"INVARIANCE_OF_DOMAIN_AFFINE_SETS",INVARIANCE_OF_DOMAIN_AFFINE_SETS; +"INVARIANCE_OF_DOMAIN_GEN",INVARIANCE_OF_DOMAIN_GEN; +"INVARIANCE_OF_DOMAIN_HOMEOMORPHIC",INVARIANCE_OF_DOMAIN_HOMEOMORPHIC; +"INVARIANCE_OF_DOMAIN_HOMEOMORPHISM",INVARIANCE_OF_DOMAIN_HOMEOMORPHISM; +"INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET",INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET; +"INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN",INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN; +"INVARIANCE_OF_DOMAIN_SUBSPACES",INVARIANCE_OF_DOMAIN_SUBSPACES; +"INVERSE_FUNCTION_C1",INVERSE_FUNCTION_C1; +"INVERSE_I",INVERSE_I; +"INVERSE_SWAP",INVERSE_SWAP; +"INVERSE_UNIQUE_o",INVERSE_UNIQUE_o; +"INVERTIBLE_COFACTOR",INVERTIBLE_COFACTOR; +"INVERTIBLE_DET_NZ",INVERTIBLE_DET_NZ; +"INVERTIBLE_FIXPOINT_PROPERTY",INVERTIBLE_FIXPOINT_PROPERTY; +"INVERTIBLE_IMP_SQUARE_MATRIX",INVERTIBLE_IMP_SQUARE_MATRIX; +"INVERTIBLE_LEFT_INVERSE",INVERTIBLE_LEFT_INVERSE; +"INVERTIBLE_MATRIX_MUL",INVERTIBLE_MATRIX_MUL; +"INVERTIBLE_NEG",INVERTIBLE_NEG; +"INVERTIBLE_RIGHT_INVERSE",INVERTIBLE_RIGHT_INVERSE; +"INVERTIBLE_TRANSP",INVERTIBLE_TRANSP; +"IN_AFFINE_ADD_MUL",IN_AFFINE_ADD_MUL; +"IN_AFFINE_ADD_MUL_DIFF",IN_AFFINE_ADD_MUL_DIFF; +"IN_AFFINE_HULL_LINEAR_IMAGE",IN_AFFINE_HULL_LINEAR_IMAGE; +"IN_AFFINE_MUL_DIFF_ADD",IN_AFFINE_MUL_DIFF_ADD; +"IN_AFFINE_SUB_MUL_DIFF",IN_AFFINE_SUB_MUL_DIFF; +"IN_BALL",IN_BALL; +"IN_BALL_0",IN_BALL_0; +"IN_BALL_IM",IN_BALL_IM; +"IN_BALL_RE",IN_BALL_RE; +"IN_CARD_ADD",IN_CARD_ADD; +"IN_CARD_MUL",IN_CARD_MUL; +"IN_CBALL",IN_CBALL; +"IN_CBALL_0",IN_CBALL_0; +"IN_CBALL_IM",IN_CBALL_IM; +"IN_CBALL_RE",IN_CBALL_RE; +"IN_CLOSURE_CONNECTED_COMPONENT",IN_CLOSURE_CONNECTED_COMPONENT; +"IN_CLOSURE_DELETE",IN_CLOSURE_DELETE; +"IN_COMPONENTS",IN_COMPONENTS; +"IN_COMPONENTS_CONNECTED",IN_COMPONENTS_CONNECTED; +"IN_COMPONENTS_MAXIMAL",IN_COMPONENTS_MAXIMAL; +"IN_COMPONENTS_NONEMPTY",IN_COMPONENTS_NONEMPTY; +"IN_COMPONENTS_SELF",IN_COMPONENTS_SELF; +"IN_COMPONENTS_SUBSET",IN_COMPONENTS_SUBSET; +"IN_COMPONENTS_UNIONS_COMPLEMENT",IN_COMPONENTS_UNIONS_COMPLEMENT; +"IN_CONVEX_HULL_EXCHANGE",IN_CONVEX_HULL_EXCHANGE; +"IN_CONVEX_HULL_EXCHANGE_UNIQUE",IN_CONVEX_HULL_EXCHANGE_UNIQUE; +"IN_CONVEX_HULL_LINEAR_IMAGE",IN_CONVEX_HULL_LINEAR_IMAGE; +"IN_CONVEX_SET",IN_CONVEX_SET; +"IN_CROSS",IN_CROSS; +"IN_DELETE",IN_DELETE; +"IN_DELETE_EQ",IN_DELETE_EQ; +"IN_DIFF",IN_DIFF; +"IN_DIMINDEX_SWAP",IN_DIMINDEX_SWAP; +"IN_DIRECTION",IN_DIRECTION; +"IN_DISJOINT",IN_DISJOINT; +"IN_ELIM_PAIR_THM",IN_ELIM_PAIR_THM; +"IN_ELIM_PASTECART_THM",IN_ELIM_PASTECART_THM; +"IN_ELIM_THM",IN_ELIM_THM; +"IN_EPIGRAPH",IN_EPIGRAPH; +"IN_FROM",IN_FROM; +"IN_FRONTIER_CONVEX_HULL",IN_FRONTIER_CONVEX_HULL; +"IN_IMAGE",IN_IMAGE; +"IN_IMAGE_DROPOUT",IN_IMAGE_DROPOUT; +"IN_IMAGE_LIFT_DROP",IN_IMAGE_LIFT_DROP; +"IN_INSERT",IN_INSERT; +"IN_INTER",IN_INTER; +"IN_INTERIOR",IN_INTERIOR; +"IN_INTERIOR_CBALL",IN_INTERIOR_CBALL; +"IN_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_INTERIOR_CLOSURE_CONVEX_SEGMENT; +"IN_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_INTERIOR_CLOSURE_CONVEX_SHRINK; +"IN_INTERIOR_CONVEX_SHRINK",IN_INTERIOR_CONVEX_SHRINK; +"IN_INTERIOR_LINEAR_IMAGE",IN_INTERIOR_LINEAR_IMAGE; +"IN_INTERS",IN_INTERS; +"IN_INTERVAL",IN_INTERVAL; +"IN_INTERVAL_1",IN_INTERVAL_1; +"IN_INTERVAL_INTERVAL_BIJ",IN_INTERVAL_INTERVAL_BIJ; +"IN_INTERVAL_REFLECT",IN_INTERVAL_REFLECT; +"IN_NUMSEG",IN_NUMSEG; +"IN_NUMSEG_0",IN_NUMSEG_0; +"IN_OPEN_SEGMENT",IN_OPEN_SEGMENT; +"IN_OPEN_SEGMENT_ALT",IN_OPEN_SEGMENT_ALT; +"IN_PATH_IMAGE_PARTCIRCLEPATH",IN_PATH_IMAGE_PARTCIRCLEPATH; +"IN_REAL_INTERVAL",IN_REAL_INTERVAL; +"IN_REAL_INTERVAL_REFLECT",IN_REAL_INTERVAL_REFLECT; +"IN_REAL_SEGMENT",IN_REAL_SEGMENT; +"IN_RELATIVE_INTERIOR",IN_RELATIVE_INTERIOR; +"IN_RELATIVE_INTERIOR_CBALL",IN_RELATIVE_INTERIOR_CBALL; +"IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; +"IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK; +"IN_RELATIVE_INTERIOR_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CONVEX_SHRINK; +"IN_REST",IN_REST; +"IN_SEGMENT",IN_SEGMENT; +"IN_SEGMENT_COMPONENT",IN_SEGMENT_COMPONENT; +"IN_SEGMENT_CX",IN_SEGMENT_CX; +"IN_SEGMENT_CX_GEN",IN_SEGMENT_CX_GEN; +"IN_SET_OF_LIST",IN_SET_OF_LIST; +"IN_SING",IN_SING; +"IN_SLICE",IN_SLICE; +"IN_SPAN_DELETE",IN_SPAN_DELETE; +"IN_SPAN_IMAGE_BASIS",IN_SPAN_IMAGE_BASIS; +"IN_SPAN_INSERT",IN_SPAN_INSERT; +"IN_SPHERE",IN_SPHERE; +"IN_SPHERE_0",IN_SPHERE_0; +"IN_SUPPORT",IN_SUPPORT; +"IN_UNION",IN_UNION; +"IN_UNIONS",IN_UNIONS; +"IN_UNIV",IN_UNIV; +"IRRATIONAL_APPROXIMATION",IRRATIONAL_APPROXIMATION; +"ISO",ISO; +"ISOLATED_ZEROS",ISOLATED_ZEROS; +"ISOMETRIES_SUBSPACES",ISOMETRIES_SUBSPACES; +"ISOMETRY_IMP_AFFINITY",ISOMETRY_IMP_AFFINITY; +"ISOMETRY_IMP_EMBEDDING",ISOMETRY_IMP_EMBEDDING; +"ISOMETRY_IMP_HOMEOMORPHISM_COMPACT",ISOMETRY_IMP_HOMEOMORPHISM_COMPACT; +"ISOMETRY_IMP_OPEN_MAP",ISOMETRY_IMP_OPEN_MAP; +"ISOMETRY_LINEAR",ISOMETRY_LINEAR; +"ISOMETRY_ON_IMP_CONTINUOUS_ON",ISOMETRY_ON_IMP_CONTINUOUS_ON; +"ISOMETRY_SPHERE_EXTEND",ISOMETRY_SPHERE_EXTEND; +"ISOMETRY_SUBSET_SUBSPACE",ISOMETRY_SUBSET_SUBSPACE; +"ISOMETRY_SUBSPACES",ISOMETRY_SUBSPACES; +"ISOMETRY_UNIV_SUBSPACE",ISOMETRY_UNIV_SUBSPACE; +"ISOMETRY_UNIV_SUPERSET_SUBSPACE",ISOMETRY_UNIV_SUPERSET_SUBSPACE; +"ISOMETRY_UNIV_UNIV",ISOMETRY_UNIV_UNIV; +"ISOMORPHISMS_UNIV_UNIV",ISOMORPHISMS_UNIV_UNIV; +"ISOMORPHISM_EXPAND",ISOMORPHISM_EXPAND; +"ISO_FUN",ISO_FUN; +"ISO_REFL",ISO_REFL; +"ISO_USAGE",ISO_USAGE; +"ISTOPLOGY_SUBTOPOLOGY",ISTOPLOGY_SUBTOPOLOGY; +"ISTOPOLOGY_OPEN_IN",ISTOPOLOGY_OPEN_IN; +"IS_AFFINE_HULL",IS_AFFINE_HULL; +"IS_CONVEX_HULL",IS_CONVEX_HULL; +"IS_HULL",IS_HULL; +"IS_INTERVAL_1",IS_INTERVAL_1; +"IS_INTERVAL_1_CASES",IS_INTERVAL_1_CASES; +"IS_INTERVAL_COMPACT",IS_INTERVAL_COMPACT; +"IS_INTERVAL_CONNECTED",IS_INTERVAL_CONNECTED; +"IS_INTERVAL_CONNECTED_1",IS_INTERVAL_CONNECTED_1; +"IS_INTERVAL_CONTRACTIBLE_1",IS_INTERVAL_CONTRACTIBLE_1; +"IS_INTERVAL_CONVEX",IS_INTERVAL_CONVEX; +"IS_INTERVAL_CONVEX_1",IS_INTERVAL_CONVEX_1; +"IS_INTERVAL_EMPTY",IS_INTERVAL_EMPTY; +"IS_INTERVAL_IMP_LOCALLY_COMPACT",IS_INTERVAL_IMP_LOCALLY_COMPACT; +"IS_INTERVAL_INTER",IS_INTERVAL_INTER; +"IS_INTERVAL_INTERVAL",IS_INTERVAL_INTERVAL; +"IS_INTERVAL_PATH_CONNECTED",IS_INTERVAL_PATH_CONNECTED; +"IS_INTERVAL_PATH_CONNECTED_1",IS_INTERVAL_PATH_CONNECTED_1; +"IS_INTERVAL_PCROSS",IS_INTERVAL_PCROSS; +"IS_INTERVAL_PCROSS_EQ",IS_INTERVAL_PCROSS_EQ; +"IS_INTERVAL_POINTWISE",IS_INTERVAL_POINTWISE; +"IS_INTERVAL_SCALING",IS_INTERVAL_SCALING; +"IS_INTERVAL_SCALING_EQ",IS_INTERVAL_SCALING_EQ; +"IS_INTERVAL_SIMPLY_CONNECTED_1",IS_INTERVAL_SIMPLY_CONNECTED_1; +"IS_INTERVAL_SING",IS_INTERVAL_SING; +"IS_INTERVAL_SUMS",IS_INTERVAL_SUMS; +"IS_INTERVAL_TRANSLATION",IS_INTERVAL_TRANSLATION; +"IS_INTERVAL_TRANSLATION_EQ",IS_INTERVAL_TRANSLATION_EQ; +"IS_INTERVAL_UNIV",IS_INTERVAL_UNIV; +"IS_REALINTERVAL_CONNECTED",IS_REALINTERVAL_CONNECTED; +"IS_REALINTERVAL_CONTAINS_SEGMENT_EQ",IS_REALINTERVAL_CONTAINS_SEGMENT_EQ; +"IS_REALINTERVAL_CONTAINS_SEGMENT_IMP",IS_REALINTERVAL_CONTAINS_SEGMENT_IMP; +"IS_REALINTERVAL_CONTINUOUS_IMAGE",IS_REALINTERVAL_CONTINUOUS_IMAGE; +"IS_REALINTERVAL_CONVEX",IS_REALINTERVAL_CONVEX; +"IS_REALINTERVAL_CONVEX_COMPLEX",IS_REALINTERVAL_CONVEX_COMPLEX; +"IS_REALINTERVAL_EMPTY",IS_REALINTERVAL_EMPTY; +"IS_REALINTERVAL_INTERVAL",IS_REALINTERVAL_INTERVAL; +"IS_REALINTERVAL_IS_INTERVAL",IS_REALINTERVAL_IS_INTERVAL; +"IS_REALINTERVAL_SEGMENT",IS_REALINTERVAL_SEGMENT; +"IS_REALINTERVAL_UNION",IS_REALINTERVAL_UNION; +"IS_REALINTERVAL_UNIV",IS_REALINTERVAL_UNIV; +"IS_REAL_INTERVAL_CASES",IS_REAL_INTERVAL_CASES; +"IS_REAL_INTERVAL_CONTAINS_SEGMENT",IS_REAL_INTERVAL_CONTAINS_SEGMENT; +"ITER",ITER; +"ITERATE_AND",ITERATE_AND; +"ITERATE_BIJECTION",ITERATE_BIJECTION; +"ITERATE_CASES",ITERATE_CASES; +"ITERATE_CLAUSES",ITERATE_CLAUSES; +"ITERATE_CLAUSES_GEN",ITERATE_CLAUSES_GEN; +"ITERATE_CLAUSES_NUMSEG",ITERATE_CLAUSES_NUMSEG; +"ITERATE_CLOSED",ITERATE_CLOSED; +"ITERATE_DELETE",ITERATE_DELETE; +"ITERATE_DELTA",ITERATE_DELTA; +"ITERATE_DIFF",ITERATE_DIFF; +"ITERATE_DIFF_GEN",ITERATE_DIFF_GEN; +"ITERATE_EQ",ITERATE_EQ; +"ITERATE_EQ_GENERAL",ITERATE_EQ_GENERAL; +"ITERATE_EQ_GENERAL_INVERSES",ITERATE_EQ_GENERAL_INVERSES; +"ITERATE_EQ_NEUTRAL",ITERATE_EQ_NEUTRAL; +"ITERATE_EXPAND_CASES",ITERATE_EXPAND_CASES; +"ITERATE_IMAGE",ITERATE_IMAGE; +"ITERATE_IMAGE_NONZERO",ITERATE_IMAGE_NONZERO; +"ITERATE_INCL_EXCL",ITERATE_INCL_EXCL; +"ITERATE_INJECTION",ITERATE_INJECTION; +"ITERATE_ITERATE_PRODUCT",ITERATE_ITERATE_PRODUCT; +"ITERATE_NONZERO_IMAGE_LEMMA",ITERATE_NONZERO_IMAGE_LEMMA; +"ITERATE_OP",ITERATE_OP; +"ITERATE_OP_GEN",ITERATE_OP_GEN; +"ITERATE_PAIR",ITERATE_PAIR; +"ITERATE_PERMUTE",ITERATE_PERMUTE; +"ITERATE_RELATED",ITERATE_RELATED; +"ITERATE_SING",ITERATE_SING; +"ITERATE_SOME",ITERATE_SOME; +"ITERATE_SUPERSET",ITERATE_SUPERSET; +"ITERATE_SUPPORT",ITERATE_SUPPORT; +"ITERATE_UNION",ITERATE_UNION; +"ITERATE_UNION_GEN",ITERATE_UNION_GEN; +"ITERATE_UNION_NONZERO",ITERATE_UNION_NONZERO; +"ITER_1",ITER_1; +"ITER_ADD",ITER_ADD; +"ITER_ALT",ITER_ALT; +"ITER_ALT_POINTLESS",ITER_ALT_POINTLESS; +"ITER_FIXPOINT",ITER_FIXPOINT; +"ITER_MUL",ITER_MUL; +"ITER_POINTLESS",ITER_POINTLESS; +"ITLIST",ITLIST; +"ITLIST2",ITLIST2; +"ITLIST2_DEF",ITLIST2_DEF; +"ITLIST_APPEND",ITLIST_APPEND; +"ITLIST_EXTRA",ITLIST_EXTRA; +"ITSET",ITSET; +"ITSET_EQ",ITSET_EQ; +"IVT_DECREASING_COMPONENT_1",IVT_DECREASING_COMPONENT_1; +"IVT_DECREASING_COMPONENT_ON_1",IVT_DECREASING_COMPONENT_ON_1; +"IVT_DECREASING_IM",IVT_DECREASING_IM; +"IVT_DECREASING_RE",IVT_DECREASING_RE; +"IVT_INCREASING_COMPONENT_1",IVT_INCREASING_COMPONENT_1; +"IVT_INCREASING_COMPONENT_ON_1",IVT_INCREASING_COMPONENT_ON_1; +"IVT_INCREASING_IM",IVT_INCREASING_IM; +"IVT_INCREASING_RE",IVT_INCREASING_RE; +"I_DEF",I_DEF; +"I_O_ID",I_O_ID; +"I_THM",I_THM; +"JACOBIAN_WORKS",JACOBIAN_WORKS; +"JANISZEWSKI",JANISZEWSKI; +"JANISZEWSKI_CONNECTED",JANISZEWSKI_CONNECTED; +"JANISZEWSKI_DUAL",JANISZEWSKI_DUAL; +"JANISZEWSKI_GEN",JANISZEWSKI_GEN; +"JOINABLE_COMPONENTS_EQ",JOINABLE_COMPONENTS_EQ; +"JOINABLE_CONNECTED_COMPONENT_EQ",JOINABLE_CONNECTED_COMPONENT_EQ; +"JOINPATHS",JOINPATHS; +"JOINPATHS_LINEAR_IMAGE",JOINPATHS_LINEAR_IMAGE; +"JOINPATHS_TRANSLATION",JOINPATHS_TRANSLATION; +"JOIN_PATHS_EQ",JOIN_PATHS_EQ; +"JOIN_SUBPATHS_MIDDLE",JOIN_SUBPATHS_MIDDLE; +"JORDAN_BROUWER_ACCESSIBILITY",JORDAN_BROUWER_ACCESSIBILITY; +"JORDAN_BROUWER_FRONTIER",JORDAN_BROUWER_FRONTIER; +"JORDAN_BROUWER_NONSEPARATION",JORDAN_BROUWER_NONSEPARATION; +"JORDAN_BROUWER_SEPARATION",JORDAN_BROUWER_SEPARATION; +"JORDAN_CURVE_THEOREM",JORDAN_CURVE_THEOREM; +"JORDAN_DISCONNECTED",JORDAN_DISCONNECTED; +"JORDAN_INSIDE_OUTSIDE",JORDAN_INSIDE_OUTSIDE; +"JUNG",JUNG; +"KIRCHBERGER",KIRCHBERGER; +"KL",KL; +"KLE_ADJACENT",KLE_ADJACENT; +"KLE_ANTISYM",KLE_ANTISYM; +"KLE_BETWEEN_L",KLE_BETWEEN_L; +"KLE_BETWEEN_R",KLE_BETWEEN_R; +"KLE_IMP_POINTWISE",KLE_IMP_POINTWISE; +"KLE_MAXIMAL",KLE_MAXIMAL; +"KLE_MINIMAL",KLE_MINIMAL; +"KLE_RANGE_COMBINE",KLE_RANGE_COMBINE; +"KLE_RANGE_COMBINE_L",KLE_RANGE_COMBINE_L; +"KLE_RANGE_COMBINE_R",KLE_RANGE_COMBINE_R; +"KLE_RANGE_INDUCT",KLE_RANGE_INDUCT; +"KLE_REFL",KLE_REFL; +"KLE_STRICT",KLE_STRICT; +"KLE_STRICT_SET",KLE_STRICT_SET; +"KLE_SUC",KLE_SUC; +"KLE_TRANS",KLE_TRANS; +"KLE_TRANS_1",KLE_TRANS_1; +"KLE_TRANS_2",KLE_TRANS_2; +"KL_POSET_LEMMA",KL_POSET_LEMMA; +"KREIN_MILMAN",KREIN_MILMAN; +"KREIN_MILMAN_FRONTIER",KREIN_MILMAN_FRONTIER; +"KREIN_MILMAN_MINKOWSKI",KREIN_MILMAN_MINKOWSKI; +"KREIN_MILMAN_POLYTOPE",KREIN_MILMAN_POLYTOPE; +"KREIN_MILMAN_RELATIVE_FRONTIER",KREIN_MILMAN_RELATIVE_FRONTIER; +"KSIMPLEX_0",KSIMPLEX_0; +"KSIMPLEX_EXTREMA",KSIMPLEX_EXTREMA; +"KSIMPLEX_EXTREMA_STRONG",KSIMPLEX_EXTREMA_STRONG; +"KSIMPLEX_FIX_PLANE",KSIMPLEX_FIX_PLANE; +"KSIMPLEX_FIX_PLANE_0",KSIMPLEX_FIX_PLANE_0; +"KSIMPLEX_FIX_PLANE_P",KSIMPLEX_FIX_PLANE_P; +"KSIMPLEX_PREDECESSOR",KSIMPLEX_PREDECESSOR; +"KSIMPLEX_REPLACE_0",KSIMPLEX_REPLACE_0; +"KSIMPLEX_REPLACE_1",KSIMPLEX_REPLACE_1; +"KSIMPLEX_REPLACE_2",KSIMPLEX_REPLACE_2; +"KSIMPLEX_SUCCESSOR",KSIMPLEX_SUCCESSOR; +"KUHN_COMBINATORIAL",KUHN_COMBINATORIAL; +"KUHN_COMPLETE_LEMMA",KUHN_COMPLETE_LEMMA; +"KUHN_COUNTING_LEMMA",KUHN_COUNTING_LEMMA; +"KUHN_INDUCTION",KUHN_INDUCTION; +"KUHN_LABELLING_LEMMA",KUHN_LABELLING_LEMMA; +"KUHN_LEMMA",KUHN_LEMMA; +"KUHN_SIMPLEX_LEMMA",KUHN_SIMPLEX_LEMMA; +"L1_LE_NORM",L1_LE_NORM; +"LAMBDA_ADD_GALOIS",LAMBDA_ADD_GALOIS; +"LAMBDA_BETA",LAMBDA_BETA; +"LAMBDA_BETA_PERM",LAMBDA_BETA_PERM; +"LAMBDA_ETA",LAMBDA_ETA; +"LAMBDA_PAIR",LAMBDA_PAIR; +"LAMBDA_PAIR_THM",LAMBDA_PAIR_THM; +"LAMBDA_SKOLEM",LAMBDA_SKOLEM; +"LAMBDA_SWAP_GALOIS",LAMBDA_SWAP_GALOIS; +"LAMBDA_UNIQUE",LAMBDA_UNIQUE; +"LANDAU_PICARD",LANDAU_PICARD; +"LAST",LAST; +"LAST_APPEND",LAST_APPEND; +"LAST_CLAUSES",LAST_CLAUSES; +"LAST_EL",LAST_EL; +"LE",LE; +"LEBESGUE_COVERING_LEMMA",LEBESGUE_COVERING_LEMMA; +"LEBESGUE_DENSITY_THEOREM",LEBESGUE_DENSITY_THEOREM; +"LEBESGUE_MEASURABLE_ALMOST_FSIGMA",LEBESGUE_MEASURABLE_ALMOST_FSIGMA; +"LEBESGUE_MEASURABLE_CLOSED",LEBESGUE_MEASURABLE_CLOSED; +"LEBESGUE_MEASURABLE_COMPACT",LEBESGUE_MEASURABLE_COMPACT; +"LEBESGUE_MEASURABLE_COMPL",LEBESGUE_MEASURABLE_COMPL; +"LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE",LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE; +"LEBESGUE_MEASURABLE_CONVEX",LEBESGUE_MEASURABLE_CONVEX; +"LEBESGUE_MEASURABLE_COUNTABLE_INTERS",LEBESGUE_MEASURABLE_COUNTABLE_INTERS; +"LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT; +"LEBESGUE_MEASURABLE_COUNTABLE_UNIONS",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; +"LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; +"LEBESGUE_MEASURABLE_DIFF",LEBESGUE_MEASURABLE_DIFF; +"LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE",LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE; +"LEBESGUE_MEASURABLE_EMPTY",LEBESGUE_MEASURABLE_EMPTY; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ; +"LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ; +"LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ; +"LEBESGUE_MEASURABLE_IFF_MEASURABLE",LEBESGUE_MEASURABLE_IFF_MEASURABLE; +"LEBESGUE_MEASURABLE_INNER_CLOSED",LEBESGUE_MEASURABLE_INNER_CLOSED; +"LEBESGUE_MEASURABLE_INTER",LEBESGUE_MEASURABLE_INTER; +"LEBESGUE_MEASURABLE_INTERS",LEBESGUE_MEASURABLE_INTERS; +"LEBESGUE_MEASURABLE_INTERVAL",LEBESGUE_MEASURABLE_INTERVAL; +"LEBESGUE_MEASURABLE_JORDAN",LEBESGUE_MEASURABLE_JORDAN; +"LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ; +"LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN; +"LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; +"LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS; +"LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS; +"LEBESGUE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_ON_SUBINTERVALS; +"LEBESGUE_MEASURABLE_OPEN",LEBESGUE_MEASURABLE_OPEN; +"LEBESGUE_MEASURABLE_OUTER_OPEN",LEBESGUE_MEASURABLE_OUTER_OPEN; +"LEBESGUE_MEASURABLE_PCROSS",LEBESGUE_MEASURABLE_PCROSS; +"LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"LEBESGUE_MEASURABLE_REGULAR_INNER",LEBESGUE_MEASURABLE_REGULAR_INNER; +"LEBESGUE_MEASURABLE_REGULAR_OUTER",LEBESGUE_MEASURABLE_REGULAR_OUTER; +"LEBESGUE_MEASURABLE_TRANSLATION",LEBESGUE_MEASURABLE_TRANSLATION; +"LEBESGUE_MEASURABLE_UNION",LEBESGUE_MEASURABLE_UNION; +"LEBESGUE_MEASURABLE_UNIONS",LEBESGUE_MEASURABLE_UNIONS; +"LEBESGUE_MEASURABLE_UNIV",LEBESGUE_MEASURABLE_UNIV; +"LEFT_ADD_DISTRIB",LEFT_ADD_DISTRIB; +"LEFT_AND_EXISTS_THM",LEFT_AND_EXISTS_THM; +"LEFT_AND_FORALL_THM",LEFT_AND_FORALL_THM; +"LEFT_EXISTS_AND_THM",LEFT_EXISTS_AND_THM; +"LEFT_EXISTS_IMP_THM",LEFT_EXISTS_IMP_THM; +"LEFT_FORALL_IMP_THM",LEFT_FORALL_IMP_THM; +"LEFT_FORALL_OR_THM",LEFT_FORALL_OR_THM; +"LEFT_IMP_EXISTS_THM",LEFT_IMP_EXISTS_THM; +"LEFT_IMP_FORALL_THM",LEFT_IMP_FORALL_THM; +"LEFT_INVERSE_LINEAR",LEFT_INVERSE_LINEAR; +"LEFT_INVERTIBLE_TRANSP",LEFT_INVERTIBLE_TRANSP; +"LEFT_OR_DISTRIB",LEFT_OR_DISTRIB; +"LEFT_OR_EXISTS_THM",LEFT_OR_EXISTS_THM; +"LEFT_OR_FORALL_THM",LEFT_OR_FORALL_THM; +"LEFT_RIGHT_INVERSE_EQ",LEFT_RIGHT_INVERSE_EQ; +"LEFT_RIGHT_INVERSE_LINEAR",LEFT_RIGHT_INVERSE_LINEAR; +"LEFT_SUB_DISTRIB",LEFT_SUB_DISTRIB; +"LEMMA",LEMMA; +"LENGTH",LENGTH; +"LENGTH_APPEND",LENGTH_APPEND; +"LENGTH_EQ_CONS",LENGTH_EQ_CONS; +"LENGTH_EQ_NIL",LENGTH_EQ_NIL; +"LENGTH_LIST_OF_SET",LENGTH_LIST_OF_SET; +"LENGTH_MAP",LENGTH_MAP; +"LENGTH_MAP2",LENGTH_MAP2; +"LENGTH_REPLICATE",LENGTH_REPLICATE; +"LENGTH_TL",LENGTH_TL; +"LET_ADD2",LET_ADD2; +"LET_ANTISYM",LET_ANTISYM; +"LET_CASES",LET_CASES; +"LET_DEF",LET_DEF; +"LET_END_DEF",LET_END_DEF; +"LET_TRANS",LET_TRANS; +"LE_0",LE_0; +"LE_1",LE_1; +"LE_ADD",LE_ADD; +"LE_ADD2",LE_ADD2; +"LE_ADDR",LE_ADDR; +"LE_ADD_LCANCEL",LE_ADD_LCANCEL; +"LE_ADD_RCANCEL",LE_ADD_RCANCEL; +"LE_ANTISYM",LE_ANTISYM; +"LE_C",LE_C; +"LE_CASES",LE_CASES; +"LE_EXISTS",LE_EXISTS; +"LE_EXP",LE_EXP; +"LE_LDIV",LE_LDIV; +"LE_LDIV_EQ",LE_LDIV_EQ; +"LE_LT",LE_LT; +"LE_MULT2",LE_MULT2; +"LE_MULT_LCANCEL",LE_MULT_LCANCEL; +"LE_MULT_RCANCEL",LE_MULT_RCANCEL; +"LE_RDIV_EQ",LE_RDIV_EQ; +"LE_REFL",LE_REFL; +"LE_SQUARE_REFL",LE_SQUARE_REFL; +"LE_SUC",LE_SUC; +"LE_SUC_LT",LE_SUC_LT; +"LE_TRANS",LE_TRANS; +"LHOSPITAL",LHOSPITAL; +"LIEB",LIEB; +"LIFT_ADD",LIFT_ADD; +"LIFT_CMUL",LIFT_CMUL; +"LIFT_COMPONENT",LIFT_COMPONENT; +"LIFT_DROP",LIFT_DROP; +"LIFT_EQ",LIFT_EQ; +"LIFT_EQ_CMUL",LIFT_EQ_CMUL; +"LIFT_INTEGRAL_COMPONENT",LIFT_INTEGRAL_COMPONENT; +"LIFT_IN_IMAGE_LIFT",LIFT_IN_IMAGE_LIFT; +"LIFT_NEG",LIFT_NEG; +"LIFT_NUM",LIFT_NUM; +"LIFT_SUB",LIFT_SUB; +"LIFT_SUM",LIFT_SUM; +"LIFT_TO_QUOTIENT_SPACE",LIFT_TO_QUOTIENT_SPACE; +"LIM",LIM; +"LIMIT_POINT_FINITE",LIMIT_POINT_FINITE; +"LIMIT_POINT_OF_SPHERE",LIMIT_POINT_OF_SPHERE; +"LIMIT_POINT_UNION",LIMIT_POINT_UNION; +"LIMPT_APPROACHABLE",LIMPT_APPROACHABLE; +"LIMPT_APPROACHABLE_LE",LIMPT_APPROACHABLE_LE; +"LIMPT_APPROACHABLE_LIFT",LIMPT_APPROACHABLE_LIFT; +"LIMPT_BALL",LIMPT_BALL; +"LIMPT_EMPTY",LIMPT_EMPTY; +"LIMPT_INFINITE_BALL",LIMPT_INFINITE_BALL; +"LIMPT_INFINITE_CBALL",LIMPT_INFINITE_CBALL; +"LIMPT_INFINITE_OPEN",LIMPT_INFINITE_OPEN; +"LIMPT_INJECTIVE_LINEAR_IMAGE_EQ",LIMPT_INJECTIVE_LINEAR_IMAGE_EQ; +"LIMPT_INSERT",LIMPT_INSERT; +"LIMPT_OF_CLOSURE",LIMPT_OF_CLOSURE; +"LIMPT_OF_CONDENSATION_POINTS",LIMPT_OF_CONDENSATION_POINTS; +"LIMPT_OF_CONVEX",LIMPT_OF_CONVEX; +"LIMPT_OF_LIMPTS",LIMPT_OF_LIMPTS; +"LIMPT_OF_OPEN",LIMPT_OF_OPEN; +"LIMPT_OF_OPEN_IN",LIMPT_OF_OPEN_IN; +"LIMPT_OF_SEQUENCE_SUBSEQUENCE",LIMPT_OF_SEQUENCE_SUBSEQUENCE; +"LIMPT_OF_UNIV",LIMPT_OF_UNIV; +"LIMPT_PCROSS",LIMPT_PCROSS; +"LIMPT_SEQUENTIAL",LIMPT_SEQUENTIAL; +"LIMPT_SEQUENTIAL_INJ",LIMPT_SEQUENTIAL_INJ; +"LIMPT_SING",LIMPT_SING; +"LIMPT_SUBSET",LIMPT_SUBSET; +"LIMPT_TRANSLATION_EQ",LIMPT_TRANSLATION_EQ; +"LIMPT_UNIV",LIMPT_UNIV; +"LIM_1_OVER_LOG",LIM_1_OVER_LOG; +"LIM_1_OVER_N",LIM_1_OVER_N; +"LIM_1_OVER_POWER",LIM_1_OVER_POWER; +"LIM_ABS",LIM_ABS; +"LIM_ADD",LIM_ADD; +"LIM_AT",LIM_AT; +"LIM_ATREAL",LIM_ATREAL; +"LIM_ATREAL_AT",LIM_ATREAL_AT; +"LIM_ATREAL_ATCOMPLEX",LIM_ATREAL_ATCOMPLEX; +"LIM_ATREAL_WITHINREAL",LIM_ATREAL_WITHINREAL; +"LIM_AT_ID",LIM_AT_ID; +"LIM_AT_INFINITY",LIM_AT_INFINITY; +"LIM_AT_INFINITY_COMPLEX_0",LIM_AT_INFINITY_COMPLEX_0; +"LIM_AT_INFINITY_POS",LIM_AT_INFINITY_POS; +"LIM_AT_LE",LIM_AT_LE; +"LIM_AT_NEGINFINITY",LIM_AT_NEGINFINITY; +"LIM_AT_POSINFINITY",LIM_AT_POSINFINITY; +"LIM_AT_WITHIN",LIM_AT_WITHIN; +"LIM_AT_ZERO",LIM_AT_ZERO; +"LIM_BILINEAR",LIM_BILINEAR; +"LIM_CASES_COFINITE_SEQUENTIALLY",LIM_CASES_COFINITE_SEQUENTIALLY; +"LIM_CASES_FINITE_SEQUENTIALLY",LIM_CASES_FINITE_SEQUENTIALLY; +"LIM_CASES_SEQUENTIALLY",LIM_CASES_SEQUENTIALLY; +"LIM_CEXP_MINUS_1",LIM_CEXP_MINUS_1; +"LIM_CMUL",LIM_CMUL; +"LIM_CMUL_EQ",LIM_CMUL_EQ; +"LIM_CNJ",LIM_CNJ; +"LIM_COMPLEX_DIV",LIM_COMPLEX_DIV; +"LIM_COMPLEX_INV",LIM_COMPLEX_INV; +"LIM_COMPLEX_INV_NONDEGENERATE",LIM_COMPLEX_INV_NONDEGENERATE; +"LIM_COMPLEX_LMUL",LIM_COMPLEX_LMUL; +"LIM_COMPLEX_MUL",LIM_COMPLEX_MUL; +"LIM_COMPLEX_POW",LIM_COMPLEX_POW; +"LIM_COMPLEX_REAL",LIM_COMPLEX_REAL; +"LIM_COMPLEX_REAL_0",LIM_COMPLEX_REAL_0; +"LIM_COMPLEX_RMUL",LIM_COMPLEX_RMUL; +"LIM_COMPONENT",LIM_COMPONENT; +"LIM_COMPONENTWISE",LIM_COMPONENTWISE; +"LIM_COMPONENTWISE_LIFT",LIM_COMPONENTWISE_LIFT; +"LIM_COMPONENT_EQ",LIM_COMPONENT_EQ; +"LIM_COMPONENT_LBOUND",LIM_COMPONENT_LBOUND; +"LIM_COMPONENT_LE",LIM_COMPONENT_LE; +"LIM_COMPONENT_UBOUND",LIM_COMPONENT_UBOUND; +"LIM_COMPOSE_AT",LIM_COMPOSE_AT; +"LIM_COMPOSE_WITHIN",LIM_COMPOSE_WITHIN; +"LIM_CONG_AT",LIM_CONG_AT; +"LIM_CONG_ATREAL",LIM_CONG_ATREAL; +"LIM_CONG_WITHIN",LIM_CONG_WITHIN; +"LIM_CONG_WITHINREAL",LIM_CONG_WITHINREAL; +"LIM_CONST",LIM_CONST; +"LIM_CONST_EQ",LIM_CONST_EQ; +"LIM_CONTINUOUS",LIM_CONTINUOUS; +"LIM_CONTINUOUS_FUNCTION",LIM_CONTINUOUS_FUNCTION; +"LIM_CSIN_OVER_X",LIM_CSIN_OVER_X; +"LIM_CX_LIFT",LIM_CX_LIFT; +"LIM_CX_OVER_CEXP",LIM_CX_OVER_CEXP; +"LIM_DROP_LBOUND",LIM_DROP_LBOUND; +"LIM_DROP_LE",LIM_DROP_LE; +"LIM_DROP_UBOUND",LIM_DROP_UBOUND; +"LIM_EVENTUALLY",LIM_EVENTUALLY; +"LIM_IM_LBOUND",LIM_IM_LBOUND; +"LIM_IM_UBOUND",LIM_IM_UBOUND; +"LIM_INFINITY_POSINFINITY_CX",LIM_INFINITY_POSINFINITY_CX; +"LIM_INFINITY_POSINFINITY_LIFT",LIM_INFINITY_POSINFINITY_LIFT; +"LIM_INFINITY_SEQUENTIALLY_COMPLEX",LIM_INFINITY_SEQUENTIALLY_COMPLEX; +"LIM_INV",LIM_INV; +"LIM_INV_N",LIM_INV_N; +"LIM_INV_N_OFFSET",LIM_INV_N_OFFSET; +"LIM_INV_N_POW",LIM_INV_N_POW; +"LIM_INV_N_POW_OFFSET",LIM_INV_N_POW_OFFSET; +"LIM_INV_X",LIM_INV_X; +"LIM_INV_X_OFFSET",LIM_INV_X_OFFSET; +"LIM_INV_X_POW",LIM_INV_X_POW; +"LIM_INV_X_POW_OFFSET",LIM_INV_X_POW_OFFSET; +"LIM_INV_Z",LIM_INV_Z; +"LIM_INV_Z_OFFSET",LIM_INV_Z_OFFSET; +"LIM_INV_Z_POW",LIM_INV_Z_POW; +"LIM_INV_Z_POW_OFFSET",LIM_INV_Z_POW_OFFSET; +"LIM_IN_CLOSED_SET",LIM_IN_CLOSED_SET; +"LIM_LIFT_DOT",LIM_LIFT_DOT; +"LIM_LINEAR",LIM_LINEAR; +"LIM_LOGPLUS1_OVER_X",LIM_LOGPLUS1_OVER_X; +"LIM_LOG_OVER_N",LIM_LOG_OVER_N; +"LIM_LOG_OVER_POWER",LIM_LOG_OVER_POWER; +"LIM_LOG_OVER_POWER_N",LIM_LOG_OVER_POWER_N; +"LIM_LOG_OVER_X",LIM_LOG_OVER_X; +"LIM_LOG_OVER_Z",LIM_LOG_OVER_Z; +"LIM_MAX",LIM_MAX; +"LIM_MIN",LIM_MIN; +"LIM_MUL",LIM_MUL; +"LIM_MUL_NORM_WITHIN",LIM_MUL_NORM_WITHIN; +"LIM_NEG",LIM_NEG; +"LIM_NEG_EQ",LIM_NEG_EQ; +"LIM_NORM",LIM_NORM; +"LIM_NORM_LBOUND",LIM_NORM_LBOUND; +"LIM_NORM_UBOUND",LIM_NORM_UBOUND; +"LIM_NULL",LIM_NULL; +"LIM_NULL_ADD",LIM_NULL_ADD; +"LIM_NULL_CMUL",LIM_NULL_CMUL; +"LIM_NULL_CMUL_BOUNDED",LIM_NULL_CMUL_BOUNDED; +"LIM_NULL_CMUL_EQ",LIM_NULL_CMUL_EQ; +"LIM_NULL_COMPARISON",LIM_NULL_COMPARISON; +"LIM_NULL_COMPARISON_COMPLEX",LIM_NULL_COMPARISON_COMPLEX; +"LIM_NULL_COMPARISON_COMPLEX_RE",LIM_NULL_COMPARISON_COMPLEX_RE; +"LIM_NULL_COMPLEX",LIM_NULL_COMPLEX; +"LIM_NULL_COMPLEX_ADD",LIM_NULL_COMPLEX_ADD; +"LIM_NULL_COMPLEX_BOUND",LIM_NULL_COMPLEX_BOUND; +"LIM_NULL_COMPLEX_LMUL",LIM_NULL_COMPLEX_LMUL; +"LIM_NULL_COMPLEX_LMUL_BOUNDED",LIM_NULL_COMPLEX_LMUL_BOUNDED; +"LIM_NULL_COMPLEX_MUL",LIM_NULL_COMPLEX_MUL; +"LIM_NULL_COMPLEX_NEG",LIM_NULL_COMPLEX_NEG; +"LIM_NULL_COMPLEX_NORM",LIM_NULL_COMPLEX_NORM; +"LIM_NULL_COMPLEX_POW",LIM_NULL_COMPLEX_POW; +"LIM_NULL_COMPLEX_POW_EQ",LIM_NULL_COMPLEX_POW_EQ; +"LIM_NULL_COMPLEX_RMUL",LIM_NULL_COMPLEX_RMUL; +"LIM_NULL_COMPLEX_RMUL_BOUNDED",LIM_NULL_COMPLEX_RMUL_BOUNDED; +"LIM_NULL_COMPLEX_SUB",LIM_NULL_COMPLEX_SUB; +"LIM_NULL_NORM",LIM_NULL_NORM; +"LIM_NULL_SUB",LIM_NULL_SUB; +"LIM_NULL_VMUL_BOUNDED",LIM_NULL_VMUL_BOUNDED; +"LIM_N_MUL_SUB_CLOG",LIM_N_MUL_SUB_CLOG; +"LIM_N_OVER_POWN",LIM_N_OVER_POWN; +"LIM_N_TIMES_POWN",LIM_N_TIMES_POWN; +"LIM_PASTECART",LIM_PASTECART; +"LIM_PASTECART_EQ",LIM_PASTECART_EQ; +"LIM_POSINFINITY_SEQUENTIALLY",LIM_POSINFINITY_SEQUENTIALLY; +"LIM_POWN",LIM_POWN; +"LIM_REAL_CONTINUOUS_FUNCTION",LIM_REAL_CONTINUOUS_FUNCTION; +"LIM_RE_LBOUND",LIM_RE_LBOUND; +"LIM_RE_UBOUND",LIM_RE_UBOUND; +"LIM_SEQUENTIALLY",LIM_SEQUENTIALLY; +"LIM_SUB",LIM_SUB; +"LIM_SUBSEQUENCE",LIM_SUBSEQUENCE; +"LIM_SUB_CLOG",LIM_SUB_CLOG; +"LIM_TRANSFORM",LIM_TRANSFORM; +"LIM_TRANSFORM_AT",LIM_TRANSFORM_AT; +"LIM_TRANSFORM_AWAY_AT",LIM_TRANSFORM_AWAY_AT; +"LIM_TRANSFORM_AWAY_WITHIN",LIM_TRANSFORM_AWAY_WITHIN; +"LIM_TRANSFORM_BOUND",LIM_TRANSFORM_BOUND; +"LIM_TRANSFORM_EQ",LIM_TRANSFORM_EQ; +"LIM_TRANSFORM_EVENTUALLY",LIM_TRANSFORM_EVENTUALLY; +"LIM_TRANSFORM_WITHIN",LIM_TRANSFORM_WITHIN; +"LIM_TRANSFORM_WITHINREAL_SET",LIM_TRANSFORM_WITHINREAL_SET; +"LIM_TRANSFORM_WITHIN_OPEN",LIM_TRANSFORM_WITHIN_OPEN; +"LIM_TRANSFORM_WITHIN_OPEN_IN",LIM_TRANSFORM_WITHIN_OPEN_IN; +"LIM_TRANSFORM_WITHIN_SET",LIM_TRANSFORM_WITHIN_SET; +"LIM_UNION",LIM_UNION; +"LIM_UNION_UNIV",LIM_UNION_UNIV; +"LIM_UNIQUE",LIM_UNIQUE; +"LIM_VMUL",LIM_VMUL; +"LIM_VSUM",LIM_VSUM; +"LIM_WITHIN",LIM_WITHIN; +"LIM_WITHINREAL",LIM_WITHINREAL; +"LIM_WITHINREAL_LE",LIM_WITHINREAL_LE; +"LIM_WITHINREAL_SUBSET",LIM_WITHINREAL_SUBSET; +"LIM_WITHINREAL_WITHIN",LIM_WITHINREAL_WITHIN; +"LIM_WITHINREAL_WITHINCOMPLEX",LIM_WITHINREAL_WITHINCOMPLEX; +"LIM_WITHIN_CLOSED_TRIVIAL",LIM_WITHIN_CLOSED_TRIVIAL; +"LIM_WITHIN_EMPTY",LIM_WITHIN_EMPTY; +"LIM_WITHIN_ID",LIM_WITHIN_ID; +"LIM_WITHIN_INTERIOR",LIM_WITHIN_INTERIOR; +"LIM_WITHIN_LE",LIM_WITHIN_LE; +"LIM_WITHIN_OPEN",LIM_WITHIN_OPEN; +"LIM_WITHIN_REAL_OPEN",LIM_WITHIN_REAL_OPEN; +"LIM_WITHIN_SUBSET",LIM_WITHIN_SUBSET; +"LIM_WITHIN_UNION",LIM_WITHIN_UNION; +"LIM_ZERO_INFINITY_COMPLEX",LIM_ZERO_INFINITY_COMPLEX; +"LIM_ZERO_NEGINFINITY",LIM_ZERO_NEGINFINITY; +"LIM_ZERO_POSINFINITY",LIM_ZERO_POSINFINITY; +"LIM_Z_TIMES_CLOG",LIM_Z_TIMES_CLOG; +"LINDELOF",LINDELOF; +"LINDELOF_OPEN_IN",LINDELOF_OPEN_IN; +"LINEAR_0",LINEAR_0; +"LINEAR_1",LINEAR_1; +"LINEAR_ADD",LINEAR_ADD; +"LINEAR_BIJECTIVE_DIMINDEX_EQ",LINEAR_BIJECTIVE_DIMINDEX_EQ; +"LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE",LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE; +"LINEAR_BOUNDED",LINEAR_BOUNDED; +"LINEAR_BOUNDED_POS",LINEAR_BOUNDED_POS; +"LINEAR_CMUL",LINEAR_CMUL; +"LINEAR_CNJ",LINEAR_CNJ; +"LINEAR_COMPLEX_MUL",LINEAR_COMPLEX_MUL; +"LINEAR_COMPONENTWISE",LINEAR_COMPONENTWISE; +"LINEAR_COMPONENTWISE_EXPANSION",LINEAR_COMPONENTWISE_EXPANSION; +"LINEAR_COMPOSE",LINEAR_COMPOSE; +"LINEAR_COMPOSE_ADD",LINEAR_COMPOSE_ADD; +"LINEAR_COMPOSE_CMUL",LINEAR_COMPOSE_CMUL; +"LINEAR_COMPOSE_NEG",LINEAR_COMPOSE_NEG; +"LINEAR_COMPOSE_SUB",LINEAR_COMPOSE_SUB; +"LINEAR_COMPOSE_VSUM",LINEAR_COMPOSE_VSUM; +"LINEAR_CONTINUOUS_AT",LINEAR_CONTINUOUS_AT; +"LINEAR_CONTINUOUS_COMPOSE",LINEAR_CONTINUOUS_COMPOSE; +"LINEAR_CONTINUOUS_ON",LINEAR_CONTINUOUS_ON; +"LINEAR_CONTINUOUS_ON_COMPOSE",LINEAR_CONTINUOUS_ON_COMPOSE; +"LINEAR_CONTINUOUS_WITHIN",LINEAR_CONTINUOUS_WITHIN; +"LINEAR_CX_IM",LINEAR_CX_IM; +"LINEAR_CX_RE",LINEAR_CX_RE; +"LINEAR_DROPOUT",LINEAR_DROPOUT; +"LINEAR_EQ",LINEAR_EQ; +"LINEAR_EQ_0",LINEAR_EQ_0; +"LINEAR_EQ_0_SPAN",LINEAR_EQ_0_SPAN; +"LINEAR_EQ_MATRIX",LINEAR_EQ_MATRIX; +"LINEAR_EQ_MBASIS",LINEAR_EQ_MBASIS; +"LINEAR_EQ_STDBASIS",LINEAR_EQ_STDBASIS; +"LINEAR_FRECHET_DERIVATIVE",LINEAR_FRECHET_DERIVATIVE; +"LINEAR_FROM_REALS",LINEAR_FROM_REALS; +"LINEAR_FSTCART",LINEAR_FSTCART; +"LINEAR_I",LINEAR_I; +"LINEAR_ID",LINEAR_ID; +"LINEAR_IMAGE_SUBSET_INTERIOR",LINEAR_IMAGE_SUBSET_INTERIOR; +"LINEAR_INDEPENDENT_EXTEND",LINEAR_INDEPENDENT_EXTEND; +"LINEAR_INDEPENDENT_EXTEND_LEMMA",LINEAR_INDEPENDENT_EXTEND_LEMMA; +"LINEAR_INDEP_IMAGE_LEMMA",LINEAR_INDEP_IMAGE_LEMMA; +"LINEAR_INJECTIVE_0",LINEAR_INJECTIVE_0; +"LINEAR_INJECTIVE_0_SUBSPACE",LINEAR_INJECTIVE_0_SUBSPACE; +"LINEAR_INJECTIVE_BOUNDED_BELOW_POS",LINEAR_INJECTIVE_BOUNDED_BELOW_POS; +"LINEAR_INJECTIVE_DIMINDEX_LE",LINEAR_INJECTIVE_DIMINDEX_LE; +"LINEAR_INJECTIVE_IFF_DIM",LINEAR_INJECTIVE_IFF_DIM; +"LINEAR_INJECTIVE_IMP_SURJECTIVE",LINEAR_INJECTIVE_IMP_SURJECTIVE; +"LINEAR_INJECTIVE_ISOMORPHISM",LINEAR_INJECTIVE_ISOMORPHISM; +"LINEAR_INJECTIVE_LEFT_INVERSE",LINEAR_INJECTIVE_LEFT_INVERSE; +"LINEAR_INTERIOR_IMAGE_SUBSET",LINEAR_INTERIOR_IMAGE_SUBSET; +"LINEAR_INVERSE_LEFT",LINEAR_INVERSE_LEFT; +"LINEAR_INVERTIBLE_BOUNDED_BELOW",LINEAR_INVERTIBLE_BOUNDED_BELOW; +"LINEAR_INVERTIBLE_BOUNDED_BELOW_POS",LINEAR_INVERTIBLE_BOUNDED_BELOW_POS; +"LINEAR_LIFT_COMPONENT",LINEAR_LIFT_COMPONENT; +"LINEAR_LIFT_DOT",LINEAR_LIFT_DOT; +"LINEAR_LIM_0",LINEAR_LIM_0; +"LINEAR_MATRIX_EXISTS",LINEAR_MATRIX_EXISTS; +"LINEAR_NEG",LINEAR_NEG; +"LINEAR_NEGATION",LINEAR_NEGATION; +"LINEAR_OPEN_MAPPING",LINEAR_OPEN_MAPPING; +"LINEAR_PASTECART",LINEAR_PASTECART; +"LINEAR_PROPERTY",LINEAR_PROPERTY; +"LINEAR_REFLECT_ALONG",LINEAR_REFLECT_ALONG; +"LINEAR_ROTATE2D",LINEAR_ROTATE2D; +"LINEAR_SCALING",LINEAR_SCALING; +"LINEAR_SINGULAR_IMAGE_HYPERPLANE",LINEAR_SINGULAR_IMAGE_HYPERPLANE; +"LINEAR_SINGULAR_INTO_HYPERPLANE",LINEAR_SINGULAR_INTO_HYPERPLANE; +"LINEAR_SNDCART",LINEAR_SNDCART; +"LINEAR_SUB",LINEAR_SUB; +"LINEAR_SUBSPACE_GRAPH",LINEAR_SUBSPACE_GRAPH; +"LINEAR_SURJECTIVE_DIMINDEX_LE",LINEAR_SURJECTIVE_DIMINDEX_LE; +"LINEAR_SURJECTIVE_IFF_DIM",LINEAR_SURJECTIVE_IFF_DIM; +"LINEAR_SURJECTIVE_IFF_INJECTIVE",LINEAR_SURJECTIVE_IFF_INJECTIVE; +"LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN",LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN; +"LINEAR_SURJECTIVE_IMP_INJECTIVE",LINEAR_SURJECTIVE_IMP_INJECTIVE; +"LINEAR_SURJECTIVE_ISOMORPHISM",LINEAR_SURJECTIVE_ISOMORPHISM; +"LINEAR_SURJECTIVE_RIGHT_INVERSE",LINEAR_SURJECTIVE_RIGHT_INVERSE; +"LINEAR_TO_REALS",LINEAR_TO_REALS; +"LINEAR_UNIFORMLY_CONTINUOUS_ON",LINEAR_UNIFORMLY_CONTINUOUS_ON; +"LINEAR_VMUL_COMPONENT",LINEAR_VMUL_COMPONENT; +"LINEAR_VMUL_DROP",LINEAR_VMUL_DROP; +"LINEAR_VSUM",LINEAR_VSUM; +"LINEAR_VSUM_MUL",LINEAR_VSUM_MUL; +"LINEAR_ZERO",LINEAR_ZERO; +"LINEPATH_CX",LINEPATH_CX; +"LINEPATH_IN_PATH",LINEPATH_IN_PATH; +"LINEPATH_LINEAR_IMAGE",LINEPATH_LINEAR_IMAGE; +"LINEPATH_REFL",LINEPATH_REFL; +"LINEPATH_TRANSLATION",LINEPATH_TRANSLATION; +"LINSEG_FL",LINSEG_FL; +"LINSEG_INSEG",LINSEG_INSEG; +"LINSEG_WOSET",LINSEG_WOSET; +"LIOUVILLE_POLYNOMIAL",LIOUVILLE_POLYNOMIAL; +"LIOUVILLE_THEOREM",LIOUVILLE_THEOREM; +"LIOUVILLE_WEAK",LIOUVILLE_WEAK; +"LIOUVILLE_WEAK_INVERSE",LIOUVILLE_WEAK_INVERSE; +"LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION",LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION; +"LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION",LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION; +"LIST_OF_SET_EMPTY",LIST_OF_SET_EMPTY; +"LIST_OF_SET_PROPERTIES",LIST_OF_SET_PROPERTIES; +"LIST_OF_SET_SING",LIST_OF_SET_SING; +"LITTLE_PICARD",LITTLE_PICARD; +"LOCALLY_CLOSED",LOCALLY_CLOSED; +"LOCALLY_COMPACT",LOCALLY_COMPACT; +"LOCALLY_COMPACT_ALT",LOCALLY_COMPACT_ALT; +"LOCALLY_COMPACT_CLOSED_IN",LOCALLY_COMPACT_CLOSED_IN; +"LOCALLY_COMPACT_CLOSED_INTER_OPEN",LOCALLY_COMPACT_CLOSED_INTER_OPEN; +"LOCALLY_COMPACT_CLOSED_IN_OPEN",LOCALLY_COMPACT_CLOSED_IN_OPEN; +"LOCALLY_COMPACT_CLOSED_UNION",LOCALLY_COMPACT_CLOSED_UNION; +"LOCALLY_COMPACT_COMPACT",LOCALLY_COMPACT_COMPACT; +"LOCALLY_COMPACT_COMPACT_ALT",LOCALLY_COMPACT_COMPACT_ALT; +"LOCALLY_COMPACT_COMPACT_SUBOPEN",LOCALLY_COMPACT_COMPACT_SUBOPEN; +"LOCALLY_COMPACT_DELETE",LOCALLY_COMPACT_DELETE; +"LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED",LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED; +"LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED",LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED; +"LOCALLY_COMPACT_INTER",LOCALLY_COMPACT_INTER; +"LOCALLY_COMPACT_INTER_CBALL",LOCALLY_COMPACT_INTER_CBALL; +"LOCALLY_COMPACT_INTER_CBALLS",LOCALLY_COMPACT_INTER_CBALLS; +"LOCALLY_COMPACT_LINEAR_IMAGE_EQ",LOCALLY_COMPACT_LINEAR_IMAGE_EQ; +"LOCALLY_COMPACT_OPEN_IN",LOCALLY_COMPACT_OPEN_IN; +"LOCALLY_COMPACT_OPEN_INTER_CLOSURE",LOCALLY_COMPACT_OPEN_INTER_CLOSURE; +"LOCALLY_COMPACT_OPEN_UNION",LOCALLY_COMPACT_OPEN_UNION; +"LOCALLY_COMPACT_PCROSS",LOCALLY_COMPACT_PCROSS; +"LOCALLY_COMPACT_PCROSS_EQ",LOCALLY_COMPACT_PCROSS_EQ; +"LOCALLY_COMPACT_PROPER_IMAGE",LOCALLY_COMPACT_PROPER_IMAGE; +"LOCALLY_COMPACT_PROPER_IMAGE_EQ",LOCALLY_COMPACT_PROPER_IMAGE_EQ; +"LOCALLY_COMPACT_TRANSLATION_EQ",LOCALLY_COMPACT_TRANSLATION_EQ; +"LOCALLY_COMPACT_UNIV",LOCALLY_COMPACT_UNIV; +"LOCALLY_CONNECTED",LOCALLY_CONNECTED; +"LOCALLY_CONNECTED_COMPONENTS",LOCALLY_CONNECTED_COMPONENTS; +"LOCALLY_CONNECTED_CONNECTED_COMPONENT",LOCALLY_CONNECTED_CONNECTED_COMPONENT; +"LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT; +"LOCALLY_CONNECTED_IM_KLEINEN",LOCALLY_CONNECTED_IM_KLEINEN; +"LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE; +"LOCALLY_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_CONNECTED_LINEAR_IMAGE_EQ; +"LOCALLY_CONNECTED_OPEN_COMPONENT",LOCALLY_CONNECTED_OPEN_COMPONENT; +"LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT",LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT; +"LOCALLY_CONNECTED_PATH_IMAGE",LOCALLY_CONNECTED_PATH_IMAGE; +"LOCALLY_CONNECTED_PCROSS",LOCALLY_CONNECTED_PCROSS; +"LOCALLY_CONNECTED_PCROSS_EQ",LOCALLY_CONNECTED_PCROSS_EQ; +"LOCALLY_CONNECTED_QUOTIENT_IMAGE",LOCALLY_CONNECTED_QUOTIENT_IMAGE; +"LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE; +"LOCALLY_CONNECTED_SPHERE",LOCALLY_CONNECTED_SPHERE; +"LOCALLY_CONNECTED_SPHERE_GEN",LOCALLY_CONNECTED_SPHERE_GEN; +"LOCALLY_CONNECTED_TRANSLATION_EQ",LOCALLY_CONNECTED_TRANSLATION_EQ; +"LOCALLY_CONNECTED_UNIV",LOCALLY_CONNECTED_UNIV; +"LOCALLY_CONVEX",LOCALLY_CONVEX; +"LOCALLY_DIFF_CLOSED",LOCALLY_DIFF_CLOSED; +"LOCALLY_EMPTY",LOCALLY_EMPTY; +"LOCALLY_INJECTIVE_LINEAR_IMAGE",LOCALLY_INJECTIVE_LINEAR_IMAGE; +"LOCALLY_INTER",LOCALLY_INTER; +"LOCALLY_MONO",LOCALLY_MONO; +"LOCALLY_OPEN_MAP_IMAGE",LOCALLY_OPEN_MAP_IMAGE; +"LOCALLY_OPEN_SUBSET",LOCALLY_OPEN_SUBSET; +"LOCALLY_PATH_CONNECTED",LOCALLY_PATH_CONNECTED; +"LOCALLY_PATH_CONNECTED_COMPONENTS",LOCALLY_PATH_CONNECTED_COMPONENTS; +"LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT",LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT; +"LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT; +"LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED",LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED; +"LOCALLY_PATH_CONNECTED_IM_KLEINEN",LOCALLY_PATH_CONNECTED_IM_KLEINEN; +"LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE; +"LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ; +"LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT; +"LOCALLY_PATH_CONNECTED_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_PATH_COMPONENT; +"LOCALLY_PATH_CONNECTED_PATH_IMAGE",LOCALLY_PATH_CONNECTED_PATH_IMAGE; +"LOCALLY_PATH_CONNECTED_PCROSS",LOCALLY_PATH_CONNECTED_PCROSS; +"LOCALLY_PATH_CONNECTED_PCROSS_EQ",LOCALLY_PATH_CONNECTED_PCROSS_EQ; +"LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE",LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE; +"LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE; +"LOCALLY_PATH_CONNECTED_SPHERE",LOCALLY_PATH_CONNECTED_SPHERE; +"LOCALLY_PATH_CONNECTED_SPHERE_GEN",LOCALLY_PATH_CONNECTED_SPHERE_GEN; +"LOCALLY_PATH_CONNECTED_TRANSLATION_EQ",LOCALLY_PATH_CONNECTED_TRANSLATION_EQ; +"LOCALLY_PATH_CONNECTED_UNIV",LOCALLY_PATH_CONNECTED_UNIV; +"LOCALLY_PCROSS",LOCALLY_PCROSS; +"LOCALLY_SING",LOCALLY_SING; +"LOCALLY_TRANSLATION",LOCALLY_TRANSLATION; +"LOG_1",LOG_1; +"LOG_CONVEX_ADD",LOG_CONVEX_ADD; +"LOG_CONVEX_CONST",LOG_CONVEX_CONST; +"LOG_CONVEX_IMP_CONVEX",LOG_CONVEX_IMP_CONVEX; +"LOG_CONVEX_IMP_POS",LOG_CONVEX_IMP_POS; +"LOG_CONVEX_MUL",LOG_CONVEX_MUL; +"LOG_CONVEX_ON",LOG_CONVEX_ON; +"LOG_CONVEX_ON_CONVEX",LOG_CONVEX_ON_CONVEX; +"LOG_CONVEX_ON_SUBSET",LOG_CONVEX_ON_SUBSET; +"LOG_CONVEX_PRODUCT",LOG_CONVEX_PRODUCT; +"LOG_DIV",LOG_DIV; +"LOG_EXP",LOG_EXP; +"LOG_INJ",LOG_INJ; +"LOG_INV",LOG_INV; +"LOG_LE",LOG_LE; +"LOG_LE_STRONG",LOG_LE_STRONG; +"LOG_LT_X",LOG_LT_X; +"LOG_MONO_LE",LOG_MONO_LE; +"LOG_MONO_LE_IMP",LOG_MONO_LE_IMP; +"LOG_MONO_LE_REV",LOG_MONO_LE_REV; +"LOG_MONO_LT",LOG_MONO_LT; +"LOG_MONO_LT_IMP",LOG_MONO_LT_IMP; +"LOG_MONO_LT_REV",LOG_MONO_LT_REV; +"LOG_MUL",LOG_MUL; +"LOG_POS",LOG_POS; +"LOG_POS_LT",LOG_POS_LT; +"LOG_POW",LOG_POW; +"LOG_PRODUCT",LOG_PRODUCT; +"LOG_ROOT",LOG_ROOT; +"LOG_RPOW",LOG_RPOW; +"LOG_SQRT",LOG_SQRT; +"LOWDIM_EQ_HYPERPLANE",LOWDIM_EQ_HYPERPLANE; +"LOWDIM_EXPAND_BASIS",LOWDIM_EXPAND_BASIS; +"LOWDIM_EXPAND_DIMENSION",LOWDIM_EXPAND_DIMENSION; +"LOWDIM_SUBSET_HYPERPLANE",LOWDIM_SUBSET_HYPERPLANE; +"LOWER_BOUND_FINITE_SET",LOWER_BOUND_FINITE_SET; +"LOWER_BOUND_FINITE_SET_REAL",LOWER_BOUND_FINITE_SET_REAL; +"LOWER_HEMICONTINUOUS",LOWER_HEMICONTINUOUS; +"LT",LT; +"LTE_ADD2",LTE_ADD2; +"LTE_ANTISYM",LTE_ANTISYM; +"LTE_CASES",LTE_CASES; +"LTE_TRANS",LTE_TRANS; +"LT_0",LT_0; +"LT_ADD",LT_ADD; +"LT_ADD2",LT_ADD2; +"LT_ADDR",LT_ADDR; +"LT_ADD_LCANCEL",LT_ADD_LCANCEL; +"LT_ADD_RCANCEL",LT_ADD_RCANCEL; +"LT_ANTISYM",LT_ANTISYM; +"LT_CASES",LT_CASES; +"LT_EXISTS",LT_EXISTS; +"LT_EXP",LT_EXP; +"LT_IMP_LE",LT_IMP_LE; +"LT_LE",LT_LE; +"LT_LMULT",LT_LMULT; +"LT_MULT",LT_MULT; +"LT_MULT2",LT_MULT2; +"LT_MULT_LCANCEL",LT_MULT_LCANCEL; +"LT_MULT_RCANCEL",LT_MULT_RCANCEL; +"LT_NZ",LT_NZ; +"LT_POW2_REFL",LT_POW2_REFL; +"LT_REFL",LT_REFL; +"LT_SUC",LT_SUC; +"LT_SUC_LE",LT_SUC_LE; +"LT_TRANS",LT_TRANS; +"LUZIN",LUZIN; +"LUZIN_EQ",LUZIN_EQ; +"LUZIN_EQ_ALT",LUZIN_EQ_ALT; +"MACHIN",MACHIN; +"MACHIN_EULER",MACHIN_EULER; +"MACHIN_GAUSS",MACHIN_GAUSS; +"MAP",MAP; +"MAP2",MAP2; +"MAP2_DEF",MAP2_DEF; +"MAPPING_CONNECTED_ONTO_SEGMENT",MAPPING_CONNECTED_ONTO_SEGMENT; +"MAP_APPEND",MAP_APPEND; +"MAP_EQ",MAP_EQ; +"MAP_EQ_ALL2",MAP_EQ_ALL2; +"MAP_EQ_DEGEN",MAP_EQ_DEGEN; +"MAP_EQ_NIL",MAP_EQ_NIL; +"MAP_FST_ZIP",MAP_FST_ZIP; +"MAP_I",MAP_I; +"MAP_ID",MAP_ID; +"MAP_REVERSE",MAP_REVERSE; +"MAP_SND_ZIP",MAP_SND_ZIP; +"MAP_o",MAP_o; +"MATCH_SEQPATTERN",MATCH_SEQPATTERN; +"MATRIX_ADD_AC",MATRIX_ADD_AC; +"MATRIX_ADD_ASSOC",MATRIX_ADD_ASSOC; +"MATRIX_ADD_COMPONENT",MATRIX_ADD_COMPONENT; +"MATRIX_ADD_LDISTRIB",MATRIX_ADD_LDISTRIB; +"MATRIX_ADD_LID",MATRIX_ADD_LID; +"MATRIX_ADD_LNEG",MATRIX_ADD_LNEG; +"MATRIX_ADD_RDISTRIB",MATRIX_ADD_RDISTRIB; +"MATRIX_ADD_RID",MATRIX_ADD_RID; +"MATRIX_ADD_RNEG",MATRIX_ADD_RNEG; +"MATRIX_ADD_SYM",MATRIX_ADD_SYM; +"MATRIX_ADJOINT",MATRIX_ADJOINT; +"MATRIX_CMUL_ADD_LDISTRIB",MATRIX_CMUL_ADD_LDISTRIB; +"MATRIX_CMUL_ADD_RDISTRIB",MATRIX_CMUL_ADD_RDISTRIB; +"MATRIX_CMUL_ASSOC",MATRIX_CMUL_ASSOC; +"MATRIX_CMUL_COMPONENT",MATRIX_CMUL_COMPONENT; +"MATRIX_CMUL_EQ_0",MATRIX_CMUL_EQ_0; +"MATRIX_CMUL_LID",MATRIX_CMUL_LID; +"MATRIX_CMUL_LZERO",MATRIX_CMUL_LZERO; +"MATRIX_CMUL_RZERO",MATRIX_CMUL_RZERO; +"MATRIX_CMUL_SUB_LDISTRIB",MATRIX_CMUL_SUB_LDISTRIB; +"MATRIX_CMUL_SUB_RDISTRIB",MATRIX_CMUL_SUB_RDISTRIB; +"MATRIX_COMPONENT_LE_ONORM",MATRIX_COMPONENT_LE_ONORM; +"MATRIX_COMPOSE",MATRIX_COMPOSE; +"MATRIX_EQ",MATRIX_EQ; +"MATRIX_EQUAL_COLUMNS",MATRIX_EQUAL_COLUMNS; +"MATRIX_EQUAL_ROWS",MATRIX_EQUAL_ROWS; +"MATRIX_FULL_LINEAR_EQUATIONS",MATRIX_FULL_LINEAR_EQUATIONS; +"MATRIX_I",MATRIX_I; +"MATRIX_ID",MATRIX_ID; +"MATRIX_INV",MATRIX_INV; +"MATRIX_INVERTIBLE",MATRIX_INVERTIBLE; +"MATRIX_INV_COFACTOR",MATRIX_INV_COFACTOR; +"MATRIX_INV_I",MATRIX_INV_I; +"MATRIX_INV_MUL",MATRIX_INV_MUL; +"MATRIX_INV_UNIQUE",MATRIX_INV_UNIQUE; +"MATRIX_INV_UNIQUE_LEFT",MATRIX_INV_UNIQUE_LEFT; +"MATRIX_INV_UNIQUE_RIGHT",MATRIX_INV_UNIQUE_RIGHT; +"MATRIX_LEFT_INVERSE_COFACTOR",MATRIX_LEFT_INVERSE_COFACTOR; +"MATRIX_LEFT_INVERTIBLE",MATRIX_LEFT_INVERTIBLE; +"MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS",MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS; +"MATRIX_LEFT_INVERTIBLE_INJECTIVE",MATRIX_LEFT_INVERTIBLE_INJECTIVE; +"MATRIX_LEFT_INVERTIBLE_KER",MATRIX_LEFT_INVERTIBLE_KER; +"MATRIX_LEFT_INVERTIBLE_SPAN_ROWS",MATRIX_LEFT_INVERTIBLE_SPAN_ROWS; +"MATRIX_LEFT_RIGHT_INVERSE",MATRIX_LEFT_RIGHT_INVERSE; +"MATRIX_MUL_ASSOC",MATRIX_MUL_ASSOC; +"MATRIX_MUL_COMPONENT",MATRIX_MUL_COMPONENT; +"MATRIX_MUL_DOT",MATRIX_MUL_DOT; +"MATRIX_MUL_LEFT_COFACTOR",MATRIX_MUL_LEFT_COFACTOR; +"MATRIX_MUL_LID",MATRIX_MUL_LID; +"MATRIX_MUL_LINV",MATRIX_MUL_LINV; +"MATRIX_MUL_LMUL",MATRIX_MUL_LMUL; +"MATRIX_MUL_LNEG",MATRIX_MUL_LNEG; +"MATRIX_MUL_LTRANSP_DOT_COLUMN",MATRIX_MUL_LTRANSP_DOT_COLUMN; +"MATRIX_MUL_LZERO",MATRIX_MUL_LZERO; +"MATRIX_MUL_RID",MATRIX_MUL_RID; +"MATRIX_MUL_RIGHT_COFACTOR",MATRIX_MUL_RIGHT_COFACTOR; +"MATRIX_MUL_RINV",MATRIX_MUL_RINV; +"MATRIX_MUL_RMUL",MATRIX_MUL_RMUL; +"MATRIX_MUL_RNEG",MATRIX_MUL_RNEG; +"MATRIX_MUL_RTRANSP_DOT_ROW",MATRIX_MUL_RTRANSP_DOT_ROW; +"MATRIX_MUL_RZERO",MATRIX_MUL_RZERO; +"MATRIX_MUL_VSUM",MATRIX_MUL_VSUM; +"MATRIX_MUL_VSUM_ALT",MATRIX_MUL_VSUM_ALT; +"MATRIX_NEG_0",MATRIX_NEG_0; +"MATRIX_NEG_ADD",MATRIX_NEG_ADD; +"MATRIX_NEG_COMPONENT",MATRIX_NEG_COMPONENT; +"MATRIX_NEG_EQ_0",MATRIX_NEG_EQ_0; +"MATRIX_NEG_MINUS1",MATRIX_NEG_MINUS1; +"MATRIX_NEG_NEG",MATRIX_NEG_NEG; +"MATRIX_NEG_SUB",MATRIX_NEG_SUB; +"MATRIX_NONFULL_LINEAR_EQUATIONS",MATRIX_NONFULL_LINEAR_EQUATIONS; +"MATRIX_NONFULL_LINEAR_EQUATIONS_EQ",MATRIX_NONFULL_LINEAR_EQUATIONS_EQ; +"MATRIX_OF_MATRIX_VECTOR_MUL",MATRIX_OF_MATRIX_VECTOR_MUL; +"MATRIX_REFLECT_ALONG_BASIS",MATRIX_REFLECT_ALONG_BASIS; +"MATRIX_RIGHT_INVERSE_COFACTOR",MATRIX_RIGHT_INVERSE_COFACTOR; +"MATRIX_RIGHT_INVERTIBLE",MATRIX_RIGHT_INVERTIBLE; +"MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS",MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS; +"MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS",MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS; +"MATRIX_RIGHT_INVERTIBLE_SURJECTIVE",MATRIX_RIGHT_INVERTIBLE_SURJECTIVE; +"MATRIX_ROTATE2D",MATRIX_ROTATE2D; +"MATRIX_SELF_ADJOINT",MATRIX_SELF_ADJOINT; +"MATRIX_SUB",MATRIX_SUB; +"MATRIX_SUB_COMPONENT",MATRIX_SUB_COMPONENT; +"MATRIX_SUB_LDISTRIB",MATRIX_SUB_LDISTRIB; +"MATRIX_SUB_LZERO",MATRIX_SUB_LZERO; +"MATRIX_SUB_RDISTRIB",MATRIX_SUB_RDISTRIB; +"MATRIX_SUB_REFL",MATRIX_SUB_REFL; +"MATRIX_SUB_RZERO",MATRIX_SUB_RZERO; +"MATRIX_TRANSP_MUL",MATRIX_TRANSP_MUL; +"MATRIX_TRIVIAL_LINEAR_EQUATIONS",MATRIX_TRIVIAL_LINEAR_EQUATIONS; +"MATRIX_VECTOR_COLUMN",MATRIX_VECTOR_COLUMN; +"MATRIX_VECTOR_MUL",MATRIX_VECTOR_MUL; +"MATRIX_VECTOR_MUL_ADD_LDISTRIB",MATRIX_VECTOR_MUL_ADD_LDISTRIB; +"MATRIX_VECTOR_MUL_ADD_RDISTRIB",MATRIX_VECTOR_MUL_ADD_RDISTRIB; +"MATRIX_VECTOR_MUL_ASSOC",MATRIX_VECTOR_MUL_ASSOC; +"MATRIX_VECTOR_MUL_BASIS",MATRIX_VECTOR_MUL_BASIS; +"MATRIX_VECTOR_MUL_COMPONENT",MATRIX_VECTOR_MUL_COMPONENT; +"MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE",MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE; +"MATRIX_VECTOR_MUL_IN_COLUMNSPACE",MATRIX_VECTOR_MUL_IN_COLUMNSPACE; +"MATRIX_VECTOR_MUL_LID",MATRIX_VECTOR_MUL_LID; +"MATRIX_VECTOR_MUL_LINEAR",MATRIX_VECTOR_MUL_LINEAR; +"MATRIX_VECTOR_MUL_LZERO",MATRIX_VECTOR_MUL_LZERO; +"MATRIX_VECTOR_MUL_RMUL",MATRIX_VECTOR_MUL_RMUL; +"MATRIX_VECTOR_MUL_RZERO",MATRIX_VECTOR_MUL_RZERO; +"MATRIX_VECTOR_MUL_SUB_LDISTRIB",MATRIX_VECTOR_MUL_SUB_LDISTRIB; +"MATRIX_VECTOR_MUL_SUB_RDISTRIB",MATRIX_VECTOR_MUL_SUB_RDISTRIB; +"MATRIX_VECTOR_MUL_TRANSP",MATRIX_VECTOR_MUL_TRANSP; +"MATRIX_WLOG_INVERTIBLE",MATRIX_WLOG_INVERTIBLE; +"MATRIX_WORKS",MATRIX_WORKS; +"MAT_0_COMPONENT",MAT_0_COMPONENT; +"MAT_COMPONENT",MAT_COMPONENT; +"MAT_EQ",MAT_EQ; +"MAX",MAX; +"MAXIMAL_AFFINE_INDEPENDENT_SUBSET",MAXIMAL_AFFINE_INDEPENDENT_SUBSET; +"MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE",MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE; +"MAXIMAL_INDEPENDENT_SUBSET",MAXIMAL_INDEPENDENT_SUBSET; +"MAXIMAL_INDEPENDENT_SUBSET_EXTEND",MAXIMAL_INDEPENDENT_SUBSET_EXTEND; +"MAXIMUM_MODULUS_FRONTIER",MAXIMUM_MODULUS_FRONTIER; +"MAXIMUM_MODULUS_PRINCIPLE",MAXIMUM_MODULUS_PRINCIPLE; +"MAXIMUM_REAL_FRONTIER",MAXIMUM_REAL_FRONTIER; +"MBASIS_COMPONENT",MBASIS_COMPONENT; +"MBASIS_EQ_0",MBASIS_EQ_0; +"MBASIS_EXPANSION",MBASIS_EXPANSION; +"MBASIS_EXTENSION",MBASIS_EXTENSION; +"MBASIS_NONZERO",MBASIS_NONZERO; +"MBASIS_SPLIT",MBASIS_SPLIT; +"MEASURABLE",MEASURABLE; +"MEASURABLE_ADDITIVE_IMP_LINEAR",MEASURABLE_ADDITIVE_IMP_LINEAR; +"MEASURABLE_ALMOST",MEASURABLE_ALMOST; +"MEASURABLE_BALL",MEASURABLE_BALL; +"MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE; +"MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; +"MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE; +"MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE; +"MEASURABLE_CBALL",MEASURABLE_CBALL; +"MEASURABLE_CLOSURE",MEASURABLE_CLOSURE; +"MEASURABLE_COMPACT",MEASURABLE_COMPACT; +"MEASURABLE_CONVEX",MEASURABLE_CONVEX; +"MEASURABLE_CONVEX_HULL",MEASURABLE_CONVEX_HULL; +"MEASURABLE_COUNTABLE_INTERS",MEASURABLE_COUNTABLE_INTERS; +"MEASURABLE_COUNTABLE_INTERS_GEN",MEASURABLE_COUNTABLE_INTERS_GEN; +"MEASURABLE_COUNTABLE_UNIONS",MEASURABLE_COUNTABLE_UNIONS; +"MEASURABLE_COUNTABLE_UNIONS_BOUNDED",MEASURABLE_COUNTABLE_UNIONS_BOUNDED; +"MEASURABLE_COUNTABLE_UNIONS_STRONG",MEASURABLE_COUNTABLE_UNIONS_STRONG; +"MEASURABLE_DIFF",MEASURABLE_DIFF; +"MEASURABLE_ELEMENTARY",MEASURABLE_ELEMENTARY; +"MEASURABLE_EMPTY",MEASURABLE_EMPTY; +"MEASURABLE_FRONTIER",MEASURABLE_FRONTIER; +"MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE",MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE; +"MEASURABLE_IMP_LEBESGUE_MEASURABLE",MEASURABLE_IMP_LEBESGUE_MEASURABLE; +"MEASURABLE_INNER_COMPACT",MEASURABLE_INNER_COMPACT; +"MEASURABLE_INNER_OUTER",MEASURABLE_INNER_OUTER; +"MEASURABLE_INSERT",MEASURABLE_INSERT; +"MEASURABLE_INSIDE",MEASURABLE_INSIDE; +"MEASURABLE_INTEGRABLE",MEASURABLE_INTEGRABLE; +"MEASURABLE_INTER",MEASURABLE_INTER; +"MEASURABLE_INTERIOR",MEASURABLE_INTERIOR; +"MEASURABLE_INTERVAL",MEASURABLE_INTERVAL; +"MEASURABLE_INTER_HALFSPACE_GE",MEASURABLE_INTER_HALFSPACE_GE; +"MEASURABLE_INTER_HALFSPACE_LE",MEASURABLE_INTER_HALFSPACE_LE; +"MEASURABLE_INTER_INTERVAL",MEASURABLE_INTER_INTERVAL; +"MEASURABLE_JORDAN",MEASURABLE_JORDAN; +"MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE",MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; +"MEASURABLE_LEGESGUE_MEASURABLE_SUBSET",MEASURABLE_LEGESGUE_MEASURABLE_SUBSET; +"MEASURABLE_LINEAR_IMAGE",MEASURABLE_LINEAR_IMAGE; +"MEASURABLE_LINEAR_IMAGE_EQ",MEASURABLE_LINEAR_IMAGE_EQ; +"MEASURABLE_LINEAR_IMAGE_EQ_GEN",MEASURABLE_LINEAR_IMAGE_EQ_GEN; +"MEASURABLE_LINEAR_IMAGE_GEN",MEASURABLE_LINEAR_IMAGE_GEN; +"MEASURABLE_LINEAR_IMAGE_INTERVAL",MEASURABLE_LINEAR_IMAGE_INTERVAL; +"MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE",MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE; +"MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE",MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE; +"MEASURABLE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_MEASURABLE_PREIMAGE_CLOSED; +"MEASURABLE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_MEASURABLE_PREIMAGE_OPEN; +"MEASURABLE_MEASURE_EQ_0",MEASURABLE_MEASURE_EQ_0; +"MEASURABLE_MEASURE_POS_LT",MEASURABLE_MEASURE_POS_LT; +"MEASURABLE_NEGLIGIBLE_SYMDIFF",MEASURABLE_NEGLIGIBLE_SYMDIFF; +"MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ",MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ; +"MEASURABLE_NESTED_UNIONS",MEASURABLE_NESTED_UNIONS; +"MEASURABLE_NONNEGLIGIBLE_IMP_LARGE",MEASURABLE_NONNEGLIGIBLE_IMP_LARGE; +"MEASURABLE_ON_0",MEASURABLE_ON_0; +"MEASURABLE_ON_ADD",MEASURABLE_ON_ADD; +"MEASURABLE_ON_BILINEAR",MEASURABLE_ON_BILINEAR; +"MEASURABLE_ON_CASES",MEASURABLE_ON_CASES; +"MEASURABLE_ON_CMUL",MEASURABLE_ON_CMUL; +"MEASURABLE_ON_COMBINE",MEASURABLE_ON_COMBINE; +"MEASURABLE_ON_COMPLEX_DIV",MEASURABLE_ON_COMPLEX_DIV; +"MEASURABLE_ON_COMPLEX_INV",MEASURABLE_ON_COMPLEX_INV; +"MEASURABLE_ON_COMPLEX_MUL",MEASURABLE_ON_COMPLEX_MUL; +"MEASURABLE_ON_COMPONENTWISE",MEASURABLE_ON_COMPONENTWISE; +"MEASURABLE_ON_COMPOSE_CONTINUOUS",MEASURABLE_ON_COMPOSE_CONTINUOUS; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_0; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL",MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL; +"MEASURABLE_ON_COMPOSE_FSTCART",MEASURABLE_ON_COMPOSE_FSTCART; +"MEASURABLE_ON_COMPOSE_SNDCART",MEASURABLE_ON_COMPOSE_SNDCART; +"MEASURABLE_ON_COMPOSE_SUB",MEASURABLE_ON_COMPOSE_SUB; +"MEASURABLE_ON_CONST",MEASURABLE_ON_CONST; +"MEASURABLE_ON_COUNTABLE_UNIONS",MEASURABLE_ON_COUNTABLE_UNIONS; +"MEASURABLE_ON_DIFF",MEASURABLE_ON_DIFF; +"MEASURABLE_ON_DROP_MUL",MEASURABLE_ON_DROP_MUL; +"MEASURABLE_ON_EMPTY",MEASURABLE_ON_EMPTY; +"MEASURABLE_ON_INTER",MEASURABLE_ON_INTER; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"MEASURABLE_ON_LIFT_MUL",MEASURABLE_ON_LIFT_MUL; +"MEASURABLE_ON_LIMIT",MEASURABLE_ON_LIMIT; +"MEASURABLE_ON_LINEAR_IMAGE_EQ",MEASURABLE_ON_LINEAR_IMAGE_EQ; +"MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN",MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN; +"MEASURABLE_ON_MAX",MEASURABLE_ON_MAX; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL; +"MEASURABLE_ON_MEASURABLE_SUBSET",MEASURABLE_ON_MEASURABLE_SUBSET; +"MEASURABLE_ON_MIN",MEASURABLE_ON_MIN; +"MEASURABLE_ON_NEG",MEASURABLE_ON_NEG; +"MEASURABLE_ON_NEG_EQ",MEASURABLE_ON_NEG_EQ; +"MEASURABLE_ON_NORM",MEASURABLE_ON_NORM; +"MEASURABLE_ON_PASTECART",MEASURABLE_ON_PASTECART; +"MEASURABLE_ON_PREIMAGE_CLOSED",MEASURABLE_ON_PREIMAGE_CLOSED; +"MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; +"MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE; +"MEASURABLE_ON_PREIMAGE_OPEN",MEASURABLE_ON_PREIMAGE_OPEN; +"MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; +"MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GT",MEASURABLE_ON_PREIMAGE_ORTHANT_GT; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LT",MEASURABLE_ON_PREIMAGE_ORTHANT_LT; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE; +"MEASURABLE_ON_RESTRICT",MEASURABLE_ON_RESTRICT; +"MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT; +"MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING; +"MEASURABLE_ON_SPIKE",MEASURABLE_ON_SPIKE; +"MEASURABLE_ON_SPIKE_SET",MEASURABLE_ON_SPIKE_SET; +"MEASURABLE_ON_SUB",MEASURABLE_ON_SUB; +"MEASURABLE_ON_TRANSLATION",MEASURABLE_ON_TRANSLATION; +"MEASURABLE_ON_TRANSLATION_EQ",MEASURABLE_ON_TRANSLATION_EQ; +"MEASURABLE_ON_UNION",MEASURABLE_ON_UNION; +"MEASURABLE_ON_UNIONS",MEASURABLE_ON_UNIONS; +"MEASURABLE_ON_UNIV",MEASURABLE_ON_UNIV; +"MEASURABLE_ON_VECTOR_DERIVATIVE",MEASURABLE_ON_VECTOR_DERIVATIVE; +"MEASURABLE_ON_VSUM",MEASURABLE_ON_VSUM; +"MEASURABLE_OPEN",MEASURABLE_OPEN; +"MEASURABLE_OUTER_CLOSED_INTERVALS",MEASURABLE_OUTER_CLOSED_INTERVALS; +"MEASURABLE_OUTER_INTERVALS_BOUNDED",MEASURABLE_OUTER_INTERVALS_BOUNDED; +"MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL",MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL; +"MEASURABLE_OUTER_OPEN",MEASURABLE_OUTER_OPEN; +"MEASURABLE_OUTER_OPEN_INTERVALS",MEASURABLE_OUTER_OPEN_INTERVALS; +"MEASURABLE_PCROSS",MEASURABLE_PCROSS; +"MEASURABLE_SCALING",MEASURABLE_SCALING; +"MEASURABLE_SCALING_EQ",MEASURABLE_SCALING_EQ; +"MEASURABLE_SIMPLEX",MEASURABLE_SIMPLEX; +"MEASURABLE_SMALL_IMP_NEGLIGIBLE",MEASURABLE_SMALL_IMP_NEGLIGIBLE; +"MEASURABLE_TETRAHEDRON",MEASURABLE_TETRAHEDRON; +"MEASURABLE_TRANSLATION",MEASURABLE_TRANSLATION; +"MEASURABLE_TRANSLATION_EQ",MEASURABLE_TRANSLATION_EQ; +"MEASURABLE_TRIANGLE",MEASURABLE_TRIANGLE; +"MEASURABLE_UNION",MEASURABLE_UNION; +"MEASURABLE_UNIONS",MEASURABLE_UNIONS; +"MEASURE",MEASURE; +"MEASURE_BALL_BOUND",MEASURE_BALL_BOUND; +"MEASURE_BALL_POS",MEASURE_BALL_POS; +"MEASURE_CBALL_BOUND",MEASURE_CBALL_BOUND; +"MEASURE_CBALL_POS",MEASURE_CBALL_POS; +"MEASURE_CLOSURE",MEASURE_CLOSURE; +"MEASURE_COUNTABLE_UNIONS_APPROACHABLE",MEASURE_COUNTABLE_UNIONS_APPROACHABLE; +"MEASURE_COUNTABLE_UNIONS_LE",MEASURE_COUNTABLE_UNIONS_LE; +"MEASURE_COUNTABLE_UNIONS_LE_GEN",MEASURE_COUNTABLE_UNIONS_LE_GEN; +"MEASURE_COUNTABLE_UNIONS_LE_STRONG",MEASURE_COUNTABLE_UNIONS_LE_STRONG; +"MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN",MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN; +"MEASURE_DIFF_SUBSET",MEASURE_DIFF_SUBSET; +"MEASURE_DISJOINT_UNION",MEASURE_DISJOINT_UNION; +"MEASURE_DISJOINT_UNIONS",MEASURE_DISJOINT_UNIONS; +"MEASURE_DISJOINT_UNIONS_IMAGE",MEASURE_DISJOINT_UNIONS_IMAGE; +"MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; +"MEASURE_DISJOINT_UNION_EQ",MEASURE_DISJOINT_UNION_EQ; +"MEASURE_ELEMENTARY",MEASURE_ELEMENTARY; +"MEASURE_EMPTY",MEASURE_EMPTY; +"MEASURE_EQ_0",MEASURE_EQ_0; +"MEASURE_FRONTIER",MEASURE_FRONTIER; +"MEASURE_INSERT",MEASURE_INSERT; +"MEASURE_INTEGRAL",MEASURE_INTEGRAL; +"MEASURE_INTEGRAL_UNIV",MEASURE_INTEGRAL_UNIV; +"MEASURE_INTERIOR",MEASURE_INTERIOR; +"MEASURE_INTERVAL",MEASURE_INTERVAL; +"MEASURE_INTERVAL_1",MEASURE_INTERVAL_1; +"MEASURE_INTERVAL_1_ALT",MEASURE_INTERVAL_1_ALT; +"MEASURE_INTERVAL_2",MEASURE_INTERVAL_2; +"MEASURE_INTERVAL_2_ALT",MEASURE_INTERVAL_2_ALT; +"MEASURE_INTERVAL_3",MEASURE_INTERVAL_3; +"MEASURE_INTERVAL_3_ALT",MEASURE_INTERVAL_3_ALT; +"MEASURE_INTERVAL_4",MEASURE_INTERVAL_4; +"MEASURE_INTERVAL_4_ALT",MEASURE_INTERVAL_4_ALT; +"MEASURE_ISOMETRY",MEASURE_ISOMETRY; +"MEASURE_LE",MEASURE_LE; +"MEASURE_LIMIT",MEASURE_LIMIT; +"MEASURE_LINEAR_IMAGE",MEASURE_LINEAR_IMAGE; +"MEASURE_LINEAR_IMAGE_SAME",MEASURE_LINEAR_IMAGE_SAME; +"MEASURE_NEGLIGIBLE_SYMDIFF",MEASURE_NEGLIGIBLE_SYMDIFF; +"MEASURE_NEGLIGIBLE_UNION",MEASURE_NEGLIGIBLE_UNION; +"MEASURE_NEGLIGIBLE_UNIONS",MEASURE_NEGLIGIBLE_UNIONS; +"MEASURE_NEGLIGIBLE_UNIONS_IMAGE",MEASURE_NEGLIGIBLE_UNIONS_IMAGE; +"MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; +"MEASURE_NEGLIGIBLE_UNION_EQ",MEASURE_NEGLIGIBLE_UNION_EQ; +"MEASURE_OPEN_POS_LT",MEASURE_OPEN_POS_LT; +"MEASURE_ORTHOGONAL_IMAGE_EQ",MEASURE_ORTHOGONAL_IMAGE_EQ; +"MEASURE_PCROSS",MEASURE_PCROSS; +"MEASURE_POS_LE",MEASURE_POS_LE; +"MEASURE_SCALING",MEASURE_SCALING; +"MEASURE_SIMPLEX",MEASURE_SIMPLEX; +"MEASURE_SUBSET",MEASURE_SUBSET; +"MEASURE_TETRAHEDRON",MEASURE_TETRAHEDRON; +"MEASURE_TRANSLATION",MEASURE_TRANSLATION; +"MEASURE_TRIANGLE",MEASURE_TRIANGLE; +"MEASURE_UNION",MEASURE_UNION; +"MEASURE_UNIONS_LE",MEASURE_UNIONS_LE; +"MEASURE_UNIONS_LE_IMAGE",MEASURE_UNIONS_LE_IMAGE; +"MEASURE_UNION_LE",MEASURE_UNION_LE; +"MEASURE_UNIQUE",MEASURE_UNIQUE; +"MEM",MEM; +"MEMBER_NOT_EMPTY",MEMBER_NOT_EMPTY; +"MEM_APPEND",MEM_APPEND; +"MEM_APPEND_DECOMPOSE",MEM_APPEND_DECOMPOSE; +"MEM_APPEND_DECOMPOSE_LEFT",MEM_APPEND_DECOMPOSE_LEFT; +"MEM_ASSOC",MEM_ASSOC; +"MEM_EL",MEM_EL; +"MEM_EXISTS_EL",MEM_EXISTS_EL; +"MEM_FILTER",MEM_FILTER; +"MEM_LINEAR_IMAGE",MEM_LINEAR_IMAGE; +"MEM_LIST_OF_SET",MEM_LIST_OF_SET; +"MEM_MAP",MEM_MAP; +"MEM_TRANSLATION",MEM_TRANSLATION; +"MIDPOINTS_IN_CONVEX_HULL",MIDPOINTS_IN_CONVEX_HULL; +"MIDPOINT_BETWEEN",MIDPOINT_BETWEEN; +"MIDPOINT_COLLINEAR",MIDPOINT_COLLINEAR; +"MIDPOINT_CONVEX_DYADIC_RATIONALS",MIDPOINT_CONVEX_DYADIC_RATIONALS; +"MIDPOINT_EQ_ENDPOINT",MIDPOINT_EQ_ENDPOINT; +"MIDPOINT_IN_CONVEX",MIDPOINT_IN_CONVEX; +"MIDPOINT_IN_SEGMENT",MIDPOINT_IN_SEGMENT; +"MIDPOINT_LINEAR_IMAGE",MIDPOINT_LINEAR_IMAGE; +"MIDPOINT_LOG_CONVEX",MIDPOINT_LOG_CONVEX; +"MIDPOINT_REAL_LOG_CONVEX",MIDPOINT_REAL_LOG_CONVEX; +"MIDPOINT_REFL",MIDPOINT_REFL; +"MIDPOINT_SYM",MIDPOINT_SYM; +"MIN",MIN; +"MINIMAL",MINIMAL; +"MINIMAL_CONTINUUM",MINIMAL_CONTINUUM; +"MINIMAL_IN_INSERT",MINIMAL_IN_INSERT; +"MK_REC_INJ",MK_REC_INJ; +"MOD_0",MOD_0; +"MOD_1",MOD_1; +"MOD_ADD_MOD",MOD_ADD_MOD; +"MOD_EQ",MOD_EQ; +"MOD_EQ_0",MOD_EQ_0; +"MOD_EXISTS",MOD_EXISTS; +"MOD_EXP_MOD",MOD_EXP_MOD; +"MOD_LE",MOD_LE; +"MOD_LT",MOD_LT; +"MOD_MOD",MOD_MOD; +"MOD_MOD_EXP_MIN",MOD_MOD_EXP_MIN; +"MOD_MOD_REFL",MOD_MOD_REFL; +"MOD_MULT",MOD_MULT; +"MOD_MULT2",MOD_MULT2; +"MOD_MULT_ADD",MOD_MULT_ADD; +"MOD_MULT_LMOD",MOD_MULT_LMOD; +"MOD_MULT_MOD2",MOD_MULT_MOD2; +"MOD_MULT_RMOD",MOD_MULT_RMOD; +"MOD_NSUM_MOD",MOD_NSUM_MOD; +"MOD_NSUM_MOD_NUMSEG",MOD_NSUM_MOD_NUMSEG; +"MOD_REFL",MOD_REFL; +"MOD_UNIQ",MOD_UNIQ; +"MOEBIUS_FUNCTION_COMPOSE",MOEBIUS_FUNCTION_COMPOSE; +"MOEBIUS_FUNCTION_EQ_ZERO",MOEBIUS_FUNCTION_EQ_ZERO; +"MOEBIUS_FUNCTION_HOLOMORPHIC",MOEBIUS_FUNCTION_HOLOMORPHIC; +"MOEBIUS_FUNCTION_NORM_LT_1",MOEBIUS_FUNCTION_NORM_LT_1; +"MOEBIUS_FUNCTION_OF_ZERO",MOEBIUS_FUNCTION_OF_ZERO; +"MOEBIUS_FUNCTION_SIMPLE",MOEBIUS_FUNCTION_SIMPLE; +"MONODROMY_CONTINUOUS_LOG",MONODROMY_CONTINUOUS_LOG; +"MONOIDAL_AC",MONOIDAL_AC; +"MONOIDAL_ADD",MONOIDAL_ADD; +"MONOIDAL_AND",MONOIDAL_AND; +"MONOIDAL_COMPLEX_MUL",MONOIDAL_COMPLEX_MUL; +"MONOIDAL_LIFTED",MONOIDAL_LIFTED; +"MONOIDAL_MUL",MONOIDAL_MUL; +"MONOIDAL_REAL_ADD",MONOIDAL_REAL_ADD; +"MONOIDAL_REAL_MUL",MONOIDAL_REAL_MUL; +"MONOIDAL_VECTOR_ADD",MONOIDAL_VECTOR_ADD; +"MONOTONE_BIGGER",MONOTONE_BIGGER; +"MONOTONE_CONVERGENCE_DECREASING",MONOTONE_CONVERGENCE_DECREASING; +"MONOTONE_CONVERGENCE_DECREASING_AE",MONOTONE_CONVERGENCE_DECREASING_AE; +"MONOTONE_CONVERGENCE_INCREASING",MONOTONE_CONVERGENCE_INCREASING; +"MONOTONE_CONVERGENCE_INCREASING_AE",MONOTONE_CONVERGENCE_INCREASING_AE; +"MONOTONE_CONVERGENCE_INTERVAL",MONOTONE_CONVERGENCE_INTERVAL; +"MONOTONE_SUBSEQUENCE",MONOTONE_SUBSEQUENCE; +"MONO_ALL",MONO_ALL; +"MONO_ALL2",MONO_ALL2; +"MONO_AND",MONO_AND; +"MONO_COND",MONO_COND; +"MONO_EXISTS",MONO_EXISTS; +"MONO_FORALL",MONO_FORALL; +"MONO_IMP",MONO_IMP; +"MONO_NOT",MONO_NOT; +"MONO_OR",MONO_OR; +"MONTEL",MONTEL; +"MORERA_LOCAL_TRIANGLE",MORERA_LOCAL_TRIANGLE; +"MORERA_LOCAL_TRIANGLE_GEN",MORERA_LOCAL_TRIANGLE_GEN; +"MORERA_TRIANGLE",MORERA_TRIANGLE; +"MULT",MULT; +"MULTIVECTOR_ADD_COMPONENT",MULTIVECTOR_ADD_COMPONENT; +"MULTIVECTOR_BETA",MULTIVECTOR_BETA; +"MULTIVECTOR_EQ",MULTIVECTOR_EQ; +"MULTIVECTOR_ETA",MULTIVECTOR_ETA; +"MULTIVECTOR_GRADE",MULTIVECTOR_GRADE; +"MULTIVECTOR_IMAGE",MULTIVECTOR_IMAGE; +"MULTIVECTOR_MUL_COMPONENT",MULTIVECTOR_MUL_COMPONENT; +"MULTIVECTOR_UNIQUE",MULTIVECTOR_UNIQUE; +"MULTIVECTOR_VEC_COMPONENT",MULTIVECTOR_VEC_COMPONENT; +"MULTIVECTOR_VSUM",MULTIVECTOR_VSUM; +"MULTIVECTOR_VSUM_COMPONENT",MULTIVECTOR_VSUM_COMPONENT; +"MULT_0",MULT_0; +"MULT_2",MULT_2; +"MULT_AC",MULT_AC; +"MULT_ASSOC",MULT_ASSOC; +"MULT_CLAUSES",MULT_CLAUSES; +"MULT_DIV_LE",MULT_DIV_LE; +"MULT_EQ_0",MULT_EQ_0; +"MULT_EQ_1",MULT_EQ_1; +"MULT_EXP",MULT_EXP; +"MULT_SUC",MULT_SUC; +"MULT_SYM",MULT_SYM; +"MUL_C_UNIV",MUL_C_UNIV; +"MUMFORD_LEMMA",MUMFORD_LEMMA; +"MVT",MVT; +"MVT_GENERAL",MVT_GENERAL; +"MVT_SIMPLE",MVT_SIMPLE; +"MVT_VERY_SIMPLE",MVT_VERY_SIMPLE; +"NADD_ADD",NADD_ADD; +"NADD_ADDITIVE",NADD_ADDITIVE; +"NADD_ADD_ASSOC",NADD_ADD_ASSOC; +"NADD_ADD_LCANCEL",NADD_ADD_LCANCEL; +"NADD_ADD_LID",NADD_ADD_LID; +"NADD_ADD_SYM",NADD_ADD_SYM; +"NADD_ADD_WELLDEF",NADD_ADD_WELLDEF; +"NADD_ALTMUL",NADD_ALTMUL; +"NADD_ARCH",NADD_ARCH; +"NADD_ARCH_LEMMA",NADD_ARCH_LEMMA; +"NADD_ARCH_MULT",NADD_ARCH_MULT; +"NADD_ARCH_ZERO",NADD_ARCH_ZERO; +"NADD_BOUND",NADD_BOUND; +"NADD_CAUCHY",NADD_CAUCHY; +"NADD_COMPLETE",NADD_COMPLETE; +"NADD_DIST",NADD_DIST; +"NADD_DIST_LEMMA",NADD_DIST_LEMMA; +"NADD_EQ_IMP_LE",NADD_EQ_IMP_LE; +"NADD_EQ_REFL",NADD_EQ_REFL; +"NADD_EQ_SYM",NADD_EQ_SYM; +"NADD_EQ_TRANS",NADD_EQ_TRANS; +"NADD_INV",NADD_INV; +"NADD_INV_0",NADD_INV_0; +"NADD_INV_WELLDEF",NADD_INV_WELLDEF; +"NADD_LBOUND",NADD_LBOUND; +"NADD_LDISTRIB",NADD_LDISTRIB; +"NADD_LE_0",NADD_LE_0; +"NADD_LE_ADD",NADD_LE_ADD; +"NADD_LE_ANTISYM",NADD_LE_ANTISYM; +"NADD_LE_EXISTS",NADD_LE_EXISTS; +"NADD_LE_LADD",NADD_LE_LADD; +"NADD_LE_LMUL",NADD_LE_LMUL; +"NADD_LE_RADD",NADD_LE_RADD; +"NADD_LE_REFL",NADD_LE_REFL; +"NADD_LE_RMUL",NADD_LE_RMUL; +"NADD_LE_TOTAL",NADD_LE_TOTAL; +"NADD_LE_TOTAL_LEMMA",NADD_LE_TOTAL_LEMMA; +"NADD_LE_TRANS",NADD_LE_TRANS; +"NADD_LE_WELLDEF",NADD_LE_WELLDEF; +"NADD_LE_WELLDEF_LEMMA",NADD_LE_WELLDEF_LEMMA; +"NADD_MUL",NADD_MUL; +"NADD_MULTIPLICATIVE",NADD_MULTIPLICATIVE; +"NADD_MUL_ASSOC",NADD_MUL_ASSOC; +"NADD_MUL_LID",NADD_MUL_LID; +"NADD_MUL_LINV",NADD_MUL_LINV; +"NADD_MUL_LINV_LEMMA0",NADD_MUL_LINV_LEMMA0; +"NADD_MUL_LINV_LEMMA1",NADD_MUL_LINV_LEMMA1; +"NADD_MUL_LINV_LEMMA2",NADD_MUL_LINV_LEMMA2; +"NADD_MUL_LINV_LEMMA3",NADD_MUL_LINV_LEMMA3; +"NADD_MUL_LINV_LEMMA4",NADD_MUL_LINV_LEMMA4; +"NADD_MUL_LINV_LEMMA5",NADD_MUL_LINV_LEMMA5; +"NADD_MUL_LINV_LEMMA6",NADD_MUL_LINV_LEMMA6; +"NADD_MUL_LINV_LEMMA7",NADD_MUL_LINV_LEMMA7; +"NADD_MUL_LINV_LEMMA7a",NADD_MUL_LINV_LEMMA7a; +"NADD_MUL_LINV_LEMMA8",NADD_MUL_LINV_LEMMA8; +"NADD_MUL_SYM",NADD_MUL_SYM; +"NADD_MUL_WELLDEF",NADD_MUL_WELLDEF; +"NADD_MUL_WELLDEF_LEMMA",NADD_MUL_WELLDEF_LEMMA; +"NADD_NONZERO",NADD_NONZERO; +"NADD_OF_NUM",NADD_OF_NUM; +"NADD_OF_NUM_ADD",NADD_OF_NUM_ADD; +"NADD_OF_NUM_EQ",NADD_OF_NUM_EQ; +"NADD_OF_NUM_LE",NADD_OF_NUM_LE; +"NADD_OF_NUM_MUL",NADD_OF_NUM_MUL; +"NADD_OF_NUM_WELLDEF",NADD_OF_NUM_WELLDEF; +"NADD_RDISTRIB",NADD_RDISTRIB; +"NADD_SUC",NADD_SUC; +"NADD_UBOUND",NADD_UBOUND; +"NEARBY_INVERTIBLE_MATRIX",NEARBY_INVERTIBLE_MATRIX; +"NEGATIONS_BALL",NEGATIONS_BALL; +"NEGATIONS_CBALL",NEGATIONS_CBALL; +"NEGATIONS_SPHERE",NEGATIONS_SPHERE; +"NEGLIGIBLE",NEGLIGIBLE; +"NEGLIGIBLE_AFFINE_HULL",NEGLIGIBLE_AFFINE_HULL; +"NEGLIGIBLE_AFFINE_HULL_1",NEGLIGIBLE_AFFINE_HULL_1; +"NEGLIGIBLE_AFFINE_HULL_2",NEGLIGIBLE_AFFINE_HULL_2; +"NEGLIGIBLE_AFFINE_HULL_3",NEGLIGIBLE_AFFINE_HULL_3; +"NEGLIGIBLE_BOUNDED_SUBSETS",NEGLIGIBLE_BOUNDED_SUBSETS; +"NEGLIGIBLE_CONVEX_FRONTIER",NEGLIGIBLE_CONVEX_FRONTIER; +"NEGLIGIBLE_CONVEX_HULL",NEGLIGIBLE_CONVEX_HULL; +"NEGLIGIBLE_CONVEX_HULL_1",NEGLIGIBLE_CONVEX_HULL_1; +"NEGLIGIBLE_CONVEX_HULL_2",NEGLIGIBLE_CONVEX_HULL_2; +"NEGLIGIBLE_CONVEX_HULL_3",NEGLIGIBLE_CONVEX_HULL_3; +"NEGLIGIBLE_CONVEX_INTERIOR",NEGLIGIBLE_CONVEX_INTERIOR; +"NEGLIGIBLE_COUNTABLE",NEGLIGIBLE_COUNTABLE; +"NEGLIGIBLE_COUNTABLE_UNIONS",NEGLIGIBLE_COUNTABLE_UNIONS; +"NEGLIGIBLE_COUNTABLE_UNIONS_GEN",NEGLIGIBLE_COUNTABLE_UNIONS_GEN; +"NEGLIGIBLE_DELETE",NEGLIGIBLE_DELETE; +"NEGLIGIBLE_DIFF",NEGLIGIBLE_DIFF; +"NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM; +"NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE; +"NEGLIGIBLE_DISJOINT_TRANSLATES",NEGLIGIBLE_DISJOINT_TRANSLATES; +"NEGLIGIBLE_EMPTY",NEGLIGIBLE_EMPTY; +"NEGLIGIBLE_EMPTY_INTERIOR",NEGLIGIBLE_EMPTY_INTERIOR; +"NEGLIGIBLE_EQ_MEASURE_0",NEGLIGIBLE_EQ_MEASURE_0; +"NEGLIGIBLE_FINITE",NEGLIGIBLE_FINITE; +"NEGLIGIBLE_FRONTIER_INTERVAL",NEGLIGIBLE_FRONTIER_INTERVAL; +"NEGLIGIBLE_HYPERPLANE",NEGLIGIBLE_HYPERPLANE; +"NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS; +"NEGLIGIBLE_IFF_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_MEASURABLE_SUBSETS; +"NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL",NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL; +"NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE",NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE; +"NEGLIGIBLE_IMP_MEASURABLE",NEGLIGIBLE_IMP_MEASURABLE; +"NEGLIGIBLE_INSERT",NEGLIGIBLE_INSERT; +"NEGLIGIBLE_INTER",NEGLIGIBLE_INTER; +"NEGLIGIBLE_INTERVAL",NEGLIGIBLE_INTERVAL; +"NEGLIGIBLE_LINEAR_IMAGE",NEGLIGIBLE_LINEAR_IMAGE; +"NEGLIGIBLE_LINEAR_IMAGE_EQ",NEGLIGIBLE_LINEAR_IMAGE_EQ; +"NEGLIGIBLE_LINEAR_IMAGE_GEN",NEGLIGIBLE_LINEAR_IMAGE_GEN; +"NEGLIGIBLE_LINEAR_SINGULAR_IMAGE",NEGLIGIBLE_LINEAR_SINGULAR_IMAGE; +"NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV",NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV; +"NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE",NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE; +"NEGLIGIBLE_LOWDIM",NEGLIGIBLE_LOWDIM; +"NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH",NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH; +"NEGLIGIBLE_ON_COUNTABLE_INTERVALS",NEGLIGIBLE_ON_COUNTABLE_INTERVALS; +"NEGLIGIBLE_ON_INTERVALS",NEGLIGIBLE_ON_INTERVALS; +"NEGLIGIBLE_ON_UNIV",NEGLIGIBLE_ON_UNIV; +"NEGLIGIBLE_OUTER",NEGLIGIBLE_OUTER; +"NEGLIGIBLE_OUTER_LE",NEGLIGIBLE_OUTER_LE; +"NEGLIGIBLE_PCROSS",NEGLIGIBLE_PCROSS; +"NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE",NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE; +"NEGLIGIBLE_SING",NEGLIGIBLE_SING; +"NEGLIGIBLE_SPHERE",NEGLIGIBLE_SPHERE; +"NEGLIGIBLE_STANDARD_HYPERPLANE",NEGLIGIBLE_STANDARD_HYPERPLANE; +"NEGLIGIBLE_SUBSET",NEGLIGIBLE_SUBSET; +"NEGLIGIBLE_SYMDIFF_EQ",NEGLIGIBLE_SYMDIFF_EQ; +"NEGLIGIBLE_TRANSLATION",NEGLIGIBLE_TRANSLATION; +"NEGLIGIBLE_TRANSLATION_EQ",NEGLIGIBLE_TRANSLATION_EQ; +"NEGLIGIBLE_TRANSLATION_REV",NEGLIGIBLE_TRANSLATION_REV; +"NEGLIGIBLE_UNION",NEGLIGIBLE_UNION; +"NEGLIGIBLE_UNIONS",NEGLIGIBLE_UNIONS; +"NEGLIGIBLE_UNION_EQ",NEGLIGIBLE_UNION_EQ; +"NEGLIGIBLE_VALID_PATH_IMAGE",NEGLIGIBLE_VALID_PATH_IMAGE; +"NEIGHBOURHOOD_EXTENSION_INTO_ANR",NEIGHBOURHOOD_EXTENSION_INTO_ANR; +"NET",NET; +"NETLIMIT_AT",NETLIMIT_AT; +"NETLIMIT_ATREAL",NETLIMIT_ATREAL; +"NETLIMIT_WITHIN",NETLIMIT_WITHIN; +"NETLIMIT_WITHINREAL",NETLIMIT_WITHINREAL; +"NETLIMIT_WITHIN_INTERIOR",NETLIMIT_WITHIN_INTERIOR; +"NET_DILEMMA",NET_DILEMMA; +"NEUTRAL_ADD",NEUTRAL_ADD; +"NEUTRAL_AND",NEUTRAL_AND; +"NEUTRAL_COMPLEX_MUL",NEUTRAL_COMPLEX_MUL; +"NEUTRAL_LIFTED",NEUTRAL_LIFTED; +"NEUTRAL_MUL",NEUTRAL_MUL; +"NEUTRAL_OUTER",NEUTRAL_OUTER; +"NEUTRAL_REAL_ADD",NEUTRAL_REAL_ADD; +"NEUTRAL_REAL_MUL",NEUTRAL_REAL_MUL; +"NEUTRAL_VECTOR_ADD",NEUTRAL_VECTOR_ADD; +"NONEMPTY_SIMPLE_PATH_ENDLESS",NONEMPTY_SIMPLE_PATH_ENDLESS; +"NONNEGATIVE_ABSOLUTELY_INTEGRABLE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE; +"NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE; +"NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE",NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE; +"NONSEPARATION_BY_COMPONENT_EQ",NONSEPARATION_BY_COMPONENT_EQ; +"NONTRIVIAL_LIMIT_WITHIN",NONTRIVIAL_LIMIT_WITHIN; +"NON_EXTENSIBLE_BORSUK_MAP",NON_EXTENSIBLE_BORSUK_MAP; +"NORM_0",NORM_0; +"NORM_1",NORM_1; +"NORM_1_POS",NORM_1_POS; +"NORM_ADD_PYTHAGOREAN",NORM_ADD_PYTHAGOREAN; +"NORM_BASIS",NORM_BASIS; +"NORM_BASIS_1",NORM_BASIS_1; +"NORM_BOUND_COMPONENT_LE",NORM_BOUND_COMPONENT_LE; +"NORM_BOUND_COMPONENT_LT",NORM_BOUND_COMPONENT_LT; +"NORM_BOUND_GENERALIZE",NORM_BOUND_GENERALIZE; +"NORM_CAUCHY_SCHWARZ",NORM_CAUCHY_SCHWARZ; +"NORM_CAUCHY_SCHWARZ_ABS",NORM_CAUCHY_SCHWARZ_ABS; +"NORM_CAUCHY_SCHWARZ_ABS_EQ",NORM_CAUCHY_SCHWARZ_ABS_EQ; +"NORM_CAUCHY_SCHWARZ_DIV",NORM_CAUCHY_SCHWARZ_DIV; +"NORM_CAUCHY_SCHWARZ_EQ",NORM_CAUCHY_SCHWARZ_EQ; +"NORM_CAUCHY_SCHWARZ_EQUAL",NORM_CAUCHY_SCHWARZ_EQUAL; +"NORM_CCOS_LE",NORM_CCOS_LE; +"NORM_CCOS_PLUS1_LE",NORM_CCOS_PLUS1_LE; +"NORM_CCOS_POW_2",NORM_CCOS_POW_2; +"NORM_CEXP",NORM_CEXP; +"NORM_CEXP_II",NORM_CEXP_II; +"NORM_CEXP_IMAGINARY",NORM_CEXP_IMAGINARY; +"NORM_COLUMN_LE_ONORM",NORM_COLUMN_LE_ONORM; +"NORM_COSSIN",NORM_COSSIN; +"NORM_CPOW_REAL",NORM_CPOW_REAL; +"NORM_CPOW_REAL_MONO",NORM_CPOW_REAL_MONO; +"NORM_CPRODUCT",NORM_CPRODUCT; +"NORM_CROSS_MULTIPLY",NORM_CROSS_MULTIPLY; +"NORM_CSIN_POW_2",NORM_CSIN_POW_2; +"NORM_EQ",NORM_EQ; +"NORM_EQ_0",NORM_EQ_0; +"NORM_EQ_0_DOT",NORM_EQ_0_DOT; +"NORM_EQ_0_IMP",NORM_EQ_0_IMP; +"NORM_EQ_1",NORM_EQ_1; +"NORM_EQ_SQUARE",NORM_EQ_SQUARE; +"NORM_FSTCART",NORM_FSTCART; +"NORM_GE_SQUARE",NORM_GE_SQUARE; +"NORM_GT_SQUARE",NORM_GT_SQUARE; +"NORM_INCREASES_ONLINE",NORM_INCREASES_ONLINE; +"NORM_LE",NORM_LE; +"NORM_LE_0",NORM_LE_0; +"NORM_LE_COMPONENTWISE",NORM_LE_COMPONENTWISE; +"NORM_LE_INFNORM",NORM_LE_INFNORM; +"NORM_LE_L1",NORM_LE_L1; +"NORM_LE_PASTECART",NORM_LE_PASTECART; +"NORM_LE_SQUARE",NORM_LE_SQUARE; +"NORM_LIFT",NORM_LIFT; +"NORM_LT",NORM_LT; +"NORM_LT_SQUARE",NORM_LT_SQUARE; +"NORM_LT_SQUARE_ALT",NORM_LT_SQUARE_ALT; +"NORM_MUL",NORM_MUL; +"NORM_NEG",NORM_NEG; +"NORM_PASTECART",NORM_PASTECART; +"NORM_PASTECART_0",NORM_PASTECART_0; +"NORM_PASTECART_LE",NORM_PASTECART_LE; +"NORM_POS_LE",NORM_POS_LE; +"NORM_POS_LT",NORM_POS_LT; +"NORM_POW_2",NORM_POW_2; +"NORM_REAL",NORM_REAL; +"NORM_ROTATE2D",NORM_ROTATE2D; +"NORM_SEGMENT_LOWERBOUND",NORM_SEGMENT_LOWERBOUND; +"NORM_SEGMENT_ORTHOGONAL_LOWERBOUND",NORM_SEGMENT_ORTHOGONAL_LOWERBOUND; +"NORM_SNDCART",NORM_SNDCART; +"NORM_SUB",NORM_SUB; +"NORM_SUM_LEMMA",NORM_SUM_LEMMA; +"NORM_TRIANGLE",NORM_TRIANGLE; +"NORM_TRIANGLE_EQ",NORM_TRIANGLE_EQ; +"NORM_TRIANGLE_LE",NORM_TRIANGLE_LE; +"NORM_TRIANGLE_LT",NORM_TRIANGLE_LT; +"NORM_TRIANGLE_SUB",NORM_TRIANGLE_SUB; +"NORM_VSUM_PYTHAGOREAN",NORM_VSUM_PYTHAGOREAN; +"NORM_VSUM_TRIVIAL_LEMMA",NORM_VSUM_TRIVIAL_LEMMA; +"NOT_ABSOLUTE_RETRACT_COBOUNDED",NOT_ABSOLUTE_RETRACT_COBOUNDED; +"NOT_ALL",NOT_ALL; +"NOT_AR_EMPTY",NOT_AR_EMPTY; +"NOT_BOUNDED_UNIV",NOT_BOUNDED_UNIV; +"NOT_CLAUSES",NOT_CLAUSES; +"NOT_CLAUSES_WEAK",NOT_CLAUSES_WEAK; +"NOT_CONS_NIL",NOT_CONS_NIL; +"NOT_DEF",NOT_DEF; +"NOT_EMPTY_INSERT",NOT_EMPTY_INSERT; +"NOT_EQUAL_SETS",NOT_EQUAL_SETS; +"NOT_EVEN",NOT_EVEN; +"NOT_EVENTUALLY",NOT_EVENTUALLY; +"NOT_EX",NOT_EX; +"NOT_EXISTS_THM",NOT_EXISTS_THM; +"NOT_FORALL_THM",NOT_FORALL_THM; +"NOT_IMP",NOT_IMP; +"NOT_INSERT_EMPTY",NOT_INSERT_EMPTY; +"NOT_INTERVAL_UNIV",NOT_INTERVAL_UNIV; +"NOT_IN_EMPTY",NOT_IN_EMPTY; +"NOT_IN_INTERIOR_CONVEX_HULL",NOT_IN_INTERIOR_CONVEX_HULL; +"NOT_IN_INTERIOR_CONVEX_HULL_3",NOT_IN_INTERIOR_CONVEX_HULL_3; +"NOT_IN_PATH_IMAGE_JOIN",NOT_IN_PATH_IMAGE_JOIN; +"NOT_LE",NOT_LE; +"NOT_LT",NOT_LT; +"NOT_NEGLIGIBLE_UNIV",NOT_NEGLIGIBLE_UNIV; +"NOT_ODD",NOT_ODD; +"NOT_ON_PATH_BALL",NOT_ON_PATH_BALL; +"NOT_ON_PATH_CBALL",NOT_ON_PATH_CBALL; +"NOT_OUTSIDE_CONNECTED_COMPONENT_LE",NOT_OUTSIDE_CONNECTED_COMPONENT_LE; +"NOT_OUTSIDE_CONNECTED_COMPONENT_LT",NOT_OUTSIDE_CONNECTED_COMPONENT_LT; +"NOT_PSUBSET_EMPTY",NOT_PSUBSET_EMPTY; +"NOT_SIMPLY_CONNECTED_CIRCLE",NOT_SIMPLY_CONNECTED_CIRCLE; +"NOT_SUC",NOT_SUC; +"NOT_UNIV_PSUBSET",NOT_UNIV_PSUBSET; +"NOWHERE_DENSE",NOWHERE_DENSE; +"NOWHERE_DENSE_ALGEBRAIC_VARIETY",NOWHERE_DENSE_ALGEBRAIC_VARIETY; +"NOWHERE_DENSE_UNION",NOWHERE_DENSE_UNION; +"NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO",NO_BOUNDED_CONNECTED_COMPONENT_IMP_WINDING_NUMBER_ZERO; +"NO_BOUNDED_PATH_COMPONENT_IMP_WINDING_NUMBER_ZERO",NO_BOUNDED_PATH_COMPONENT_IMP_WINDING_NUMBER_ZERO; +"NO_EMBEDDING_SPHERE_LOWDIM",NO_EMBEDDING_SPHERE_LOWDIM; +"NO_ISOLATED_SINGULARITY",NO_ISOLATED_SINGULARITY; +"NO_LIMIT_POINT_IMP_CLOSED",NO_LIMIT_POINT_IMP_CLOSED; +"NO_RETRACTION_CBALL",NO_RETRACTION_CBALL; +"NO_RETRACTION_FRONTIER_BOUNDED",NO_RETRACTION_FRONTIER_BOUNDED; +"NPRODUCT_ADD_SPLIT",NPRODUCT_ADD_SPLIT; +"NPRODUCT_CLAUSES",NPRODUCT_CLAUSES; +"NPRODUCT_CLAUSES_LEFT",NPRODUCT_CLAUSES_LEFT; +"NPRODUCT_CLAUSES_NUMSEG",NPRODUCT_CLAUSES_NUMSEG; +"NPRODUCT_CLAUSES_RIGHT",NPRODUCT_CLAUSES_RIGHT; +"NPRODUCT_CLOSED",NPRODUCT_CLOSED; +"NPRODUCT_CONST",NPRODUCT_CONST; +"NPRODUCT_CONST_NUMSEG",NPRODUCT_CONST_NUMSEG; +"NPRODUCT_CONST_NUMSEG_1",NPRODUCT_CONST_NUMSEG_1; +"NPRODUCT_DELETE",NPRODUCT_DELETE; +"NPRODUCT_EQ",NPRODUCT_EQ; +"NPRODUCT_EQ_0",NPRODUCT_EQ_0; +"NPRODUCT_EQ_0_NUMSEG",NPRODUCT_EQ_0_NUMSEG; +"NPRODUCT_EQ_1",NPRODUCT_EQ_1; +"NPRODUCT_EQ_1_NUMSEG",NPRODUCT_EQ_1_NUMSEG; +"NPRODUCT_EQ_NUMSEG",NPRODUCT_EQ_NUMSEG; +"NPRODUCT_FACT",NPRODUCT_FACT; +"NPRODUCT_IMAGE",NPRODUCT_IMAGE; +"NPRODUCT_LE",NPRODUCT_LE; +"NPRODUCT_LE_NUMSEG",NPRODUCT_LE_NUMSEG; +"NPRODUCT_MUL",NPRODUCT_MUL; +"NPRODUCT_MUL_NUMSEG",NPRODUCT_MUL_NUMSEG; +"NPRODUCT_OFFSET",NPRODUCT_OFFSET; +"NPRODUCT_ONE",NPRODUCT_ONE; +"NPRODUCT_PAIR",NPRODUCT_PAIR; +"NPRODUCT_POS_LT",NPRODUCT_POS_LT; +"NPRODUCT_POS_LT_NUMSEG",NPRODUCT_POS_LT_NUMSEG; +"NPRODUCT_SING",NPRODUCT_SING; +"NPRODUCT_SING_NUMSEG",NPRODUCT_SING_NUMSEG; +"NPRODUCT_SUPERSET",NPRODUCT_SUPERSET; +"NPRODUCT_SUPPORT",NPRODUCT_SUPPORT; +"NPRODUCT_UNION",NPRODUCT_UNION; +"NSUM_0",NSUM_0; +"NSUM_ADD",NSUM_ADD; +"NSUM_ADD_GEN",NSUM_ADD_GEN; +"NSUM_ADD_NUMSEG",NSUM_ADD_NUMSEG; +"NSUM_ADD_SPLIT",NSUM_ADD_SPLIT; +"NSUM_BIJECTION",NSUM_BIJECTION; +"NSUM_BOUND",NSUM_BOUND; +"NSUM_BOUND_GEN",NSUM_BOUND_GEN; +"NSUM_BOUND_LT",NSUM_BOUND_LT; +"NSUM_BOUND_LT_ALL",NSUM_BOUND_LT_ALL; +"NSUM_BOUND_LT_GEN",NSUM_BOUND_LT_GEN; +"NSUM_CASES",NSUM_CASES; +"NSUM_CLAUSES",NSUM_CLAUSES; +"NSUM_CLAUSES_LEFT",NSUM_CLAUSES_LEFT; +"NSUM_CLAUSES_NUMSEG",NSUM_CLAUSES_NUMSEG; +"NSUM_CLAUSES_RIGHT",NSUM_CLAUSES_RIGHT; +"NSUM_CLOSED",NSUM_CLOSED; +"NSUM_CONST",NSUM_CONST; +"NSUM_CONST_NUMSEG",NSUM_CONST_NUMSEG; +"NSUM_DEGENERATE",NSUM_DEGENERATE; +"NSUM_DELETE",NSUM_DELETE; +"NSUM_DELTA",NSUM_DELTA; +"NSUM_DIFF",NSUM_DIFF; +"NSUM_EQ",NSUM_EQ; +"NSUM_EQ_0",NSUM_EQ_0; +"NSUM_EQ_0_IFF",NSUM_EQ_0_IFF; +"NSUM_EQ_0_IFF_NUMSEG",NSUM_EQ_0_IFF_NUMSEG; +"NSUM_EQ_0_NUMSEG",NSUM_EQ_0_NUMSEG; +"NSUM_EQ_GENERAL",NSUM_EQ_GENERAL; +"NSUM_EQ_GENERAL_INVERSES",NSUM_EQ_GENERAL_INVERSES; +"NSUM_EQ_NUMSEG",NSUM_EQ_NUMSEG; +"NSUM_EQ_SUPERSET",NSUM_EQ_SUPERSET; +"NSUM_GROUP",NSUM_GROUP; +"NSUM_IMAGE",NSUM_IMAGE; +"NSUM_IMAGE_GEN",NSUM_IMAGE_GEN; +"NSUM_IMAGE_NONZERO",NSUM_IMAGE_NONZERO; +"NSUM_INCL_EXCL",NSUM_INCL_EXCL; +"NSUM_INJECTION",NSUM_INJECTION; +"NSUM_LE",NSUM_LE; +"NSUM_LE_GEN",NSUM_LE_GEN; +"NSUM_LE_NUMSEG",NSUM_LE_NUMSEG; +"NSUM_LMUL",NSUM_LMUL; +"NSUM_LT",NSUM_LT; +"NSUM_LT_ALL",NSUM_LT_ALL; +"NSUM_MULTICOUNT",NSUM_MULTICOUNT; +"NSUM_MULTICOUNT_GEN",NSUM_MULTICOUNT_GEN; +"NSUM_NSUM_PRODUCT",NSUM_NSUM_PRODUCT; +"NSUM_NSUM_RESTRICT",NSUM_NSUM_RESTRICT; +"NSUM_OFFSET",NSUM_OFFSET; +"NSUM_OFFSET_0",NSUM_OFFSET_0; +"NSUM_PAIR",NSUM_PAIR; +"NSUM_PERMUTE",NSUM_PERMUTE; +"NSUM_PERMUTE_NUMSEG",NSUM_PERMUTE_NUMSEG; +"NSUM_POS_BOUND",NSUM_POS_BOUND; +"NSUM_POS_LT",NSUM_POS_LT; +"NSUM_POS_LT_ALL",NSUM_POS_LT_ALL; +"NSUM_RESTRICT",NSUM_RESTRICT; +"NSUM_RESTRICT_SET",NSUM_RESTRICT_SET; +"NSUM_RMUL",NSUM_RMUL; +"NSUM_SING",NSUM_SING; +"NSUM_SING_NUMSEG",NSUM_SING_NUMSEG; +"NSUM_SUBSET",NSUM_SUBSET; +"NSUM_SUBSET_SIMPLE",NSUM_SUBSET_SIMPLE; +"NSUM_SUPERSET",NSUM_SUPERSET; +"NSUM_SUPPORT",NSUM_SUPPORT; +"NSUM_SWAP",NSUM_SWAP; +"NSUM_SWAP_NUMSEG",NSUM_SWAP_NUMSEG; +"NSUM_TRIV_NUMSEG",NSUM_TRIV_NUMSEG; +"NSUM_UNION",NSUM_UNION; +"NSUM_UNIONS_NONZERO",NSUM_UNIONS_NONZERO; +"NSUM_UNION_EQ",NSUM_UNION_EQ; +"NSUM_UNION_LZERO",NSUM_UNION_LZERO; +"NSUM_UNION_NONZERO",NSUM_UNION_NONZERO; +"NSUM_UNION_RZERO",NSUM_UNION_RZERO; +"NULL",NULL; +"NULLHOMOTOPIC_FROM_CONTRACTIBLE",NULLHOMOTOPIC_FROM_CONTRACTIBLE; +"NULLHOMOTOPIC_FROM_SPHERE_EXTENSION",NULLHOMOTOPIC_FROM_SPHERE_EXTENSION; +"NULLHOMOTOPIC_INTO_ANR_EXTENSION",NULLHOMOTOPIC_INTO_ANR_EXTENSION; +"NULLHOMOTOPIC_INTO_CONTRACTIBLE",NULLHOMOTOPIC_INTO_CONTRACTIBLE; +"NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION",NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION; +"NULLHOMOTOPIC_INTO_SPHERE_EXTENSION",NULLHOMOTOPIC_INTO_SPHERE_EXTENSION; +"NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION",NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION; +"NULLHOMOTOPIC_THROUGH_CONTRACTIBLE",NULLHOMOTOPIC_THROUGH_CONTRACTIBLE; +"NULLSPACE_INTER_ROWSPACE",NULLSPACE_INTER_ROWSPACE; +"NUMERAL",NUMERAL; +"NUMPAIR",NUMPAIR; +"NUMPAIR_DEST",NUMPAIR_DEST; +"NUMPAIR_INJ",NUMPAIR_INJ; +"NUMPAIR_INJ_LEMMA",NUMPAIR_INJ_LEMMA; +"NUMSEG_ADD_SPLIT",NUMSEG_ADD_SPLIT; +"NUMSEG_CLAUSES",NUMSEG_CLAUSES; +"NUMSEG_COMBINE_L",NUMSEG_COMBINE_L; +"NUMSEG_COMBINE_R",NUMSEG_COMBINE_R; +"NUMSEG_DIMINDEX_NONEMPTY",NUMSEG_DIMINDEX_NONEMPTY; +"NUMSEG_EMPTY",NUMSEG_EMPTY; +"NUMSEG_LE",NUMSEG_LE; +"NUMSEG_LREC",NUMSEG_LREC; +"NUMSEG_LT",NUMSEG_LT; +"NUMSEG_OFFSET_IMAGE",NUMSEG_OFFSET_IMAGE; +"NUMSEG_REC",NUMSEG_REC; +"NUMSEG_RREC",NUMSEG_RREC; +"NUMSEG_SING",NUMSEG_SING; +"NUMSUM",NUMSUM; +"NUMSUM_DEST",NUMSUM_DEST; +"NUMSUM_INJ",NUMSUM_INJ; +"NUM_COUNTABLE",NUM_COUNTABLE; +"NUM_GCD",NUM_GCD; +"NUM_OF_INT",NUM_OF_INT; +"NUM_OF_INT_OF_NUM",NUM_OF_INT_OF_NUM; +"NUM_REP_CASES",NUM_REP_CASES; +"NUM_REP_INDUCT",NUM_REP_INDUCT; +"NUM_REP_RULES",NUM_REP_RULES; +"ODD",ODD; +"ODD_ADD",ODD_ADD; +"ODD_DOUBLE",ODD_DOUBLE; +"ODD_EXISTS",ODD_EXISTS; +"ODD_EXP",ODD_EXP; +"ODD_MOD",ODD_MOD; +"ODD_MULT",ODD_MULT; +"ODD_SUB",ODD_SUB; +"OEP",OEP; +"OLDNET",OLDNET; +"ONE",ONE; +"ONE_ONE",ONE_ONE; +"ONORM",ONORM; +"ONORM_COMPOSE",ONORM_COMPOSE; +"ONORM_CONST",ONORM_CONST; +"ONORM_EQ_0",ONORM_EQ_0; +"ONORM_I",ONORM_I; +"ONORM_ID",ONORM_ID; +"ONORM_NEG",ONORM_NEG; +"ONORM_NEG_LEMMA",ONORM_NEG_LEMMA; +"ONORM_POS_LE",ONORM_POS_LE; +"ONORM_POS_LT",ONORM_POS_LT; +"ONORM_TRIANGLE",ONORM_TRIANGLE; +"ONORM_TRIANGLE_LE",ONORM_TRIANGLE_LE; +"ONORM_TRIANGLE_LT",ONORM_TRIANGLE_LT; +"ONTO",ONTO; +"OPEN_AFFINITY",OPEN_AFFINITY; +"OPEN_ARG_GT",OPEN_ARG_GT; +"OPEN_ARG_LTT",OPEN_ARG_LTT; +"OPEN_BALL",OPEN_BALL; +"OPEN_BIJECTIVE_LINEAR_IMAGE_EQ",OPEN_BIJECTIVE_LINEAR_IMAGE_EQ; +"OPEN_CLOSED",OPEN_CLOSED; +"OPEN_CLOSED_INTERVAL_1",OPEN_CLOSED_INTERVAL_1; +"OPEN_CLOSED_INTERVAL_CONVEX",OPEN_CLOSED_INTERVAL_CONVEX; +"OPEN_COMPONENTS",OPEN_COMPONENTS; +"OPEN_CONNECTED_COMPONENT",OPEN_CONNECTED_COMPONENT; +"OPEN_CONTAINS_BALL",OPEN_CONTAINS_BALL; +"OPEN_CONTAINS_BALL_EQ",OPEN_CONTAINS_BALL_EQ; +"OPEN_CONTAINS_CBALL",OPEN_CONTAINS_CBALL; +"OPEN_CONTAINS_CBALL_EQ",OPEN_CONTAINS_CBALL_EQ; +"OPEN_CONTAINS_INTERVAL",OPEN_CONTAINS_INTERVAL; +"OPEN_CONTAINS_OPEN_INTERVAL",OPEN_CONTAINS_OPEN_INTERVAL; +"OPEN_CONVEX_HULL",OPEN_CONVEX_HULL; +"OPEN_COUNTABLE_LIMIT_ELEMENTARY",OPEN_COUNTABLE_LIMIT_ELEMENTARY; +"OPEN_COUNTABLE_UNION_CLOSED_INTERVALS",OPEN_COUNTABLE_UNION_CLOSED_INTERVALS; +"OPEN_COUNTABLE_UNION_OPEN_INTERVALS",OPEN_COUNTABLE_UNION_OPEN_INTERVALS; +"OPEN_DELETE",OPEN_DELETE; +"OPEN_DIFF",OPEN_DIFF; +"OPEN_EMPTY",OPEN_EMPTY; +"OPEN_EXISTS",OPEN_EXISTS; +"OPEN_EXISTS_IN",OPEN_EXISTS_IN; +"OPEN_GENERAL_COMPONENT",OPEN_GENERAL_COMPONENT; +"OPEN_HALFSPACE_COMPONENT_GT",OPEN_HALFSPACE_COMPONENT_GT; +"OPEN_HALFSPACE_COMPONENT_LT",OPEN_HALFSPACE_COMPONENT_LT; +"OPEN_HALFSPACE_GT",OPEN_HALFSPACE_GT; +"OPEN_HALFSPACE_IM_GT",OPEN_HALFSPACE_IM_GT; +"OPEN_HALFSPACE_IM_LT",OPEN_HALFSPACE_IM_LT; +"OPEN_HALFSPACE_LT",OPEN_HALFSPACE_LT; +"OPEN_HALFSPACE_RE_GT",OPEN_HALFSPACE_RE_GT; +"OPEN_HALFSPACE_RE_LT",OPEN_HALFSPACE_RE_LT; +"OPEN_IMP_ANR",OPEN_IMP_ANR; +"OPEN_IMP_ENR",OPEN_IMP_ENR; +"OPEN_IMP_INFINITE",OPEN_IMP_INFINITE; +"OPEN_IMP_LOCALLY_COMPACT",OPEN_IMP_LOCALLY_COMPACT; +"OPEN_IMP_LOCALLY_CONNECTED",OPEN_IMP_LOCALLY_CONNECTED; +"OPEN_IMP_LOCALLY_PATH_CONNECTED",OPEN_IMP_LOCALLY_PATH_CONNECTED; +"OPEN_IN",OPEN_IN; +"OPEN_INSIDE",OPEN_INSIDE; +"OPEN_INTER",OPEN_INTER; +"OPEN_INTERIOR",OPEN_INTERIOR; +"OPEN_INTERS",OPEN_INTERS; +"OPEN_INTERVAL",OPEN_INTERVAL; +"OPEN_INTERVAL_EQ",OPEN_INTERVAL_EQ; +"OPEN_INTERVAL_LEFT",OPEN_INTERVAL_LEFT; +"OPEN_INTERVAL_LEMMA",OPEN_INTERVAL_LEMMA; +"OPEN_INTERVAL_MIDPOINT",OPEN_INTERVAL_MIDPOINT; +"OPEN_INTERVAL_RIGHT",OPEN_INTERVAL_RIGHT; +"OPEN_INTER_CLOSURE_EQ_EMPTY",OPEN_INTER_CLOSURE_EQ_EMPTY; +"OPEN_INTER_CLOSURE_SUBSET",OPEN_INTER_CLOSURE_SUBSET; +"OPEN_IN_CLAUSES",OPEN_IN_CLAUSES; +"OPEN_IN_CLOSED_IN",OPEN_IN_CLOSED_IN; +"OPEN_IN_CLOSED_IN_EQ",OPEN_IN_CLOSED_IN_EQ; +"OPEN_IN_COMPONENTS_LOCALLY_CONNECTED",OPEN_IN_COMPONENTS_LOCALLY_CONNECTED; +"OPEN_IN_CONNECTED_COMPONENT",OPEN_IN_CONNECTED_COMPONENT; +"OPEN_IN_CONNECTED_COMPONENTS",OPEN_IN_CONNECTED_COMPONENTS; +"OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED",OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; +"OPEN_IN_CONTAINS_BALL",OPEN_IN_CONTAINS_BALL; +"OPEN_IN_CONTAINS_CBALL",OPEN_IN_CONTAINS_CBALL; +"OPEN_IN_DELETE",OPEN_IN_DELETE; +"OPEN_IN_DIFF",OPEN_IN_DIFF; +"OPEN_IN_EMPTY",OPEN_IN_EMPTY; +"OPEN_IN_IMP_SUBSET",OPEN_IN_IMP_SUBSET; +"OPEN_IN_INJECTIVE_LINEAR_IMAGE",OPEN_IN_INJECTIVE_LINEAR_IMAGE; +"OPEN_IN_INTER",OPEN_IN_INTER; +"OPEN_IN_INTERS",OPEN_IN_INTERS; +"OPEN_IN_INTER_OPEN",OPEN_IN_INTER_OPEN; +"OPEN_IN_LOCALLY_COMPACT",OPEN_IN_LOCALLY_COMPACT; +"OPEN_IN_OPEN",OPEN_IN_OPEN; +"OPEN_IN_OPEN_EQ",OPEN_IN_OPEN_EQ; +"OPEN_IN_OPEN_INTER",OPEN_IN_OPEN_INTER; +"OPEN_IN_OPEN_TRANS",OPEN_IN_OPEN_TRANS; +"OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; +"OPEN_IN_PCROSS",OPEN_IN_PCROSS; +"OPEN_IN_PCROSS_EQ",OPEN_IN_PCROSS_EQ; +"OPEN_IN_REFL",OPEN_IN_REFL; +"OPEN_IN_RELATIVE_INTERIOR",OPEN_IN_RELATIVE_INTERIOR; +"OPEN_IN_SET_RELATIVE_INTERIOR",OPEN_IN_SET_RELATIVE_INTERIOR; +"OPEN_IN_SING",OPEN_IN_SING; +"OPEN_IN_SUBOPEN",OPEN_IN_SUBOPEN; +"OPEN_IN_SUBSET",OPEN_IN_SUBSET; +"OPEN_IN_SUBSET_RELATIVE_INTERIOR",OPEN_IN_SUBSET_RELATIVE_INTERIOR; +"OPEN_IN_SUBSET_TRANS",OPEN_IN_SUBSET_TRANS; +"OPEN_IN_SUBTOPOLOGY",OPEN_IN_SUBTOPOLOGY; +"OPEN_IN_SUBTOPOLOGY_EMPTY",OPEN_IN_SUBTOPOLOGY_EMPTY; +"OPEN_IN_SUBTOPOLOGY_INTER_SUBSET",OPEN_IN_SUBTOPOLOGY_INTER_SUBSET; +"OPEN_IN_SUBTOPOLOGY_REFL",OPEN_IN_SUBTOPOLOGY_REFL; +"OPEN_IN_SUBTOPOLOGY_UNION",OPEN_IN_SUBTOPOLOGY_UNION; +"OPEN_IN_TOPSPACE",OPEN_IN_TOPSPACE; +"OPEN_IN_TRANS",OPEN_IN_TRANS; +"OPEN_IN_TRANSLATION_EQ",OPEN_IN_TRANSLATION_EQ; +"OPEN_IN_TRANS_EQ",OPEN_IN_TRANS_EQ; +"OPEN_IN_UNION",OPEN_IN_UNION; +"OPEN_IN_UNIONS",OPEN_IN_UNIONS; +"OPEN_LIFT",OPEN_LIFT; +"OPEN_MAPPING_THM",OPEN_MAPPING_THM; +"OPEN_MAP_CLOSED_SUPERSET_PREIMAGE",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE; +"OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ; +"OPEN_MAP_FROM_COMPOSITION_INJECTIVE",OPEN_MAP_FROM_COMPOSITION_INJECTIVE; +"OPEN_MAP_FROM_COMPOSITION_SURJECTIVE",OPEN_MAP_FROM_COMPOSITION_SURJECTIVE; +"OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE",OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE; +"OPEN_MAP_IMP_CLOSED_MAP",OPEN_MAP_IMP_CLOSED_MAP; +"OPEN_MAP_IMP_QUOTIENT_MAP",OPEN_MAP_IMP_QUOTIENT_MAP; +"OPEN_MAP_RESTRICT",OPEN_MAP_RESTRICT; +"OPEN_MEASURABLE_INNER_DIVISION",OPEN_MEASURABLE_INNER_DIVISION; +"OPEN_NEGATIONS",OPEN_NEGATIONS; +"OPEN_NON_GENERAL_COMPONENT",OPEN_NON_GENERAL_COMPONENT; +"OPEN_NON_PATH_COMPONENT",OPEN_NON_PATH_COMPONENT; +"OPEN_NOT_NEGLIGIBLE",OPEN_NOT_NEGLIGIBLE; +"OPEN_OPEN_IN_TRANS",OPEN_OPEN_IN_TRANS; +"OPEN_OPEN_LEFT_PROJECTION",OPEN_OPEN_LEFT_PROJECTION; +"OPEN_OPEN_RIGHT_PROJECTION",OPEN_OPEN_RIGHT_PROJECTION; +"OPEN_OUTSIDE",OPEN_OUTSIDE; +"OPEN_PATH_COMPONENT",OPEN_PATH_COMPONENT; +"OPEN_PATH_CONNECTED_COMPONENT",OPEN_PATH_CONNECTED_COMPONENT; +"OPEN_PCROSS",OPEN_PCROSS; +"OPEN_PCROSS_EQ",OPEN_PCROSS_EQ; +"OPEN_POSITIVE_MULTIPLES",OPEN_POSITIVE_MULTIPLES; +"OPEN_POSITIVE_ORTHANT",OPEN_POSITIVE_ORTHANT; +"OPEN_SCALING",OPEN_SCALING; +"OPEN_SEGMENT_1",OPEN_SEGMENT_1; +"OPEN_SEGMENT_ALT",OPEN_SEGMENT_ALT; +"OPEN_SEGMENT_LINEAR_IMAGE",OPEN_SEGMENT_LINEAR_IMAGE; +"OPEN_SET_COCOUNTABLE_COORDINATES",OPEN_SET_COCOUNTABLE_COORDINATES; +"OPEN_SET_COSMALL_COORDINATES",OPEN_SET_COSMALL_COORDINATES; +"OPEN_SET_IRRATIONAL_COORDINATES",OPEN_SET_IRRATIONAL_COORDINATES; +"OPEN_SET_RATIONAL_COORDINATES",OPEN_SET_RATIONAL_COORDINATES; +"OPEN_SLICE",OPEN_SLICE; +"OPEN_SUBOPEN",OPEN_SUBOPEN; +"OPEN_SUBSET",OPEN_SUBSET; +"OPEN_SUBSET_INTERIOR",OPEN_SUBSET_INTERIOR; +"OPEN_SUMS",OPEN_SUMS; +"OPEN_SURJECTIVE_LINEAR_IMAGE",OPEN_SURJECTIVE_LINEAR_IMAGE; +"OPEN_TRANSLATION",OPEN_TRANSLATION; +"OPEN_TRANSLATION_EQ",OPEN_TRANSLATION_EQ; +"OPEN_UNICOHERENT_UNIV",OPEN_UNICOHERENT_UNIV; +"OPEN_UNION",OPEN_UNION; +"OPEN_UNIONS",OPEN_UNIONS; +"OPEN_UNION_COMPACT_SUBSETS",OPEN_UNION_COMPACT_SUBSETS; +"OPEN_UNIV",OPEN_UNIV; +"OPEN_WINDING_NUMBER_LEVELSETS",OPEN_WINDING_NUMBER_LEVELSETS; +"OPERATIVE_1_LE",OPERATIVE_1_LE; +"OPERATIVE_1_LT",OPERATIVE_1_LT; +"OPERATIVE_APPROXIMABLE",OPERATIVE_APPROXIMABLE; +"OPERATIVE_CONTENT",OPERATIVE_CONTENT; +"OPERATIVE_DIVISION",OPERATIVE_DIVISION; +"OPERATIVE_DIVISION_AND",OPERATIVE_DIVISION_AND; +"OPERATIVE_EMPTY",OPERATIVE_EMPTY; +"OPERATIVE_FUNCTION_ENDPOINT_DIFF",OPERATIVE_FUNCTION_ENDPOINT_DIFF; +"OPERATIVE_INTEGRABLE",OPERATIVE_INTEGRABLE; +"OPERATIVE_INTEGRAL",OPERATIVE_INTEGRAL; +"OPERATIVE_LIFTED_SETVARIATION",OPERATIVE_LIFTED_SETVARIATION; +"OPERATIVE_LIFTED_VECTOR_VARIATION",OPERATIVE_LIFTED_VECTOR_VARIATION; +"OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF",OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF; +"OPERATIVE_TAGGED_DIVISION",OPERATIVE_TAGGED_DIVISION; +"OPERATIVE_TRIVIAL",OPERATIVE_TRIVIAL; +"ORDER_EXISTENCE_CARD",ORDER_EXISTENCE_CARD; +"ORDER_EXISTENCE_FINITE",ORDER_EXISTENCE_FINITE; +"ORDER_EXISTENCE_GEN",ORDER_EXISTENCE_GEN; +"ORDER_EXISTENCE_ITER",ORDER_EXISTENCE_ITER; +"ORDINAL_CHAINED",ORDINAL_CHAINED; +"ORDINAL_CHAINED_LEMMA",ORDINAL_CHAINED_LEMMA; +"ORDINAL_SUC",ORDINAL_SUC; +"ORDINAL_UNION",ORDINAL_UNION; +"ORDINAL_UNION_LEMMA",ORDINAL_UNION_LEMMA; +"ORDINAL_UP",ORDINAL_UP; +"ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG",ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG; +"ORTHOGONAL_0",ORTHOGONAL_0; +"ORTHOGONAL_ANY_CLOSEST_POINT",ORTHOGONAL_ANY_CLOSEST_POINT; +"ORTHOGONAL_BASIS",ORTHOGONAL_BASIS; +"ORTHOGONAL_BASIS_BASIS",ORTHOGONAL_BASIS_BASIS; +"ORTHOGONAL_BASIS_EXISTS",ORTHOGONAL_BASIS_EXISTS; +"ORTHOGONAL_BASIS_SUBSPACE",ORTHOGONAL_BASIS_SUBSPACE; +"ORTHOGONAL_CLAUSES",ORTHOGONAL_CLAUSES; +"ORTHOGONAL_EXTENSION",ORTHOGONAL_EXTENSION; +"ORTHOGONAL_EXTENSION_STRONG",ORTHOGONAL_EXTENSION_STRONG; +"ORTHOGONAL_LINEAR_IMAGE_EQ",ORTHOGONAL_LINEAR_IMAGE_EQ; +"ORTHOGONAL_LNEG",ORTHOGONAL_LNEG; +"ORTHOGONAL_LVSUM",ORTHOGONAL_LVSUM; +"ORTHOGONAL_MATRIX",ORTHOGONAL_MATRIX; +"ORTHOGONAL_MATRIX_2",ORTHOGONAL_MATRIX_2; +"ORTHOGONAL_MATRIX_2_ALT",ORTHOGONAL_MATRIX_2_ALT; +"ORTHOGONAL_MATRIX_ALT",ORTHOGONAL_MATRIX_ALT; +"ORTHOGONAL_MATRIX_EXISTS_BASIS",ORTHOGONAL_MATRIX_EXISTS_BASIS; +"ORTHOGONAL_MATRIX_ID",ORTHOGONAL_MATRIX_ID; +"ORTHOGONAL_MATRIX_INV",ORTHOGONAL_MATRIX_INV; +"ORTHOGONAL_MATRIX_MATRIX",ORTHOGONAL_MATRIX_MATRIX; +"ORTHOGONAL_MATRIX_MUL",ORTHOGONAL_MATRIX_MUL; +"ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN; +"ORTHOGONAL_MATRIX_TRANSFORMATION",ORTHOGONAL_MATRIX_TRANSFORMATION; +"ORTHOGONAL_MATRIX_TRANSP",ORTHOGONAL_MATRIX_TRANSP; +"ORTHOGONAL_MUL",ORTHOGONAL_MUL; +"ORTHOGONAL_NULLSPACE_ROWSPACE",ORTHOGONAL_NULLSPACE_ROWSPACE; +"ORTHOGONAL_REFL",ORTHOGONAL_REFL; +"ORTHOGONAL_RNEG",ORTHOGONAL_RNEG; +"ORTHOGONAL_ROTATION_OR_ROTOINVERSION",ORTHOGONAL_ROTATION_OR_ROTOINVERSION; +"ORTHOGONAL_RVSUM",ORTHOGONAL_RVSUM; +"ORTHOGONAL_SPANNINGSET_SUBSPACE",ORTHOGONAL_SPANNINGSET_SUBSPACE; +"ORTHOGONAL_SUBSPACE_DECOMP",ORTHOGONAL_SUBSPACE_DECOMP; +"ORTHOGONAL_SUBSPACE_DECOMP_EXISTS",ORTHOGONAL_SUBSPACE_DECOMP_EXISTS; +"ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE",ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE; +"ORTHOGONAL_SYM",ORTHOGONAL_SYM; +"ORTHOGONAL_TO_ORTHOGONAL_2D",ORTHOGONAL_TO_ORTHOGONAL_2D; +"ORTHOGONAL_TO_SPAN",ORTHOGONAL_TO_SPAN; +"ORTHOGONAL_TO_SPANS_EQ",ORTHOGONAL_TO_SPANS_EQ; +"ORTHOGONAL_TO_SPAN_EQ",ORTHOGONAL_TO_SPAN_EQ; +"ORTHOGONAL_TO_SUBSPACE_EXISTS",ORTHOGONAL_TO_SUBSPACE_EXISTS; +"ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN",ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN; +"ORTHOGONAL_TO_VECTOR_EXISTS",ORTHOGONAL_TO_VECTOR_EXISTS; +"ORTHOGONAL_TRANSFORMATION",ORTHOGONAL_TRANSFORMATION; +"ORTHOGONAL_TRANSFORMATION_BALL",ORTHOGONAL_TRANSFORMATION_BALL; +"ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS",ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS; +"ORTHOGONAL_TRANSFORMATION_CBALL",ORTHOGONAL_TRANSFORMATION_CBALL; +"ORTHOGONAL_TRANSFORMATION_COMPOSE",ORTHOGONAL_TRANSFORMATION_COMPOSE; +"ORTHOGONAL_TRANSFORMATION_EXISTS",ORTHOGONAL_TRANSFORMATION_EXISTS; +"ORTHOGONAL_TRANSFORMATION_EXISTS_1",ORTHOGONAL_TRANSFORMATION_EXISTS_1; +"ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS",ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS; +"ORTHOGONAL_TRANSFORMATION_I",ORTHOGONAL_TRANSFORMATION_I; +"ORTHOGONAL_TRANSFORMATION_ID",ORTHOGONAL_TRANSFORMATION_ID; +"ORTHOGONAL_TRANSFORMATION_INJECTIVE",ORTHOGONAL_TRANSFORMATION_INJECTIVE; +"ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE; +"ORTHOGONAL_TRANSFORMATION_INVERSE",ORTHOGONAL_TRANSFORMATION_INVERSE; +"ORTHOGONAL_TRANSFORMATION_INVERSE_o",ORTHOGONAL_TRANSFORMATION_INVERSE_o; +"ORTHOGONAL_TRANSFORMATION_ISOMETRY",ORTHOGONAL_TRANSFORMATION_ISOMETRY; +"ORTHOGONAL_TRANSFORMATION_LINEAR",ORTHOGONAL_TRANSFORMATION_LINEAR; +"ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL",ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL; +"ORTHOGONAL_TRANSFORMATION_MATRIX",ORTHOGONAL_TRANSFORMATION_MATRIX; +"ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE; +"ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS; +"ORTHOGONAL_TRANSFORMATION_ROTATE2D",ORTHOGONAL_TRANSFORMATION_ROTATE2D; +"ORTHOGONAL_TRANSFORMATION_SPHERE",ORTHOGONAL_TRANSFORMATION_SPHERE; +"ORTHOGONAL_TRANSFORMATION_SURJECTIVE",ORTHOGONAL_TRANSFORMATION_SURJECTIVE; +"ORTHONORMAL_BASIS_EXPAND",ORTHONORMAL_BASIS_EXPAND; +"ORTHONORMAL_BASIS_SUBSPACE",ORTHONORMAL_BASIS_SUBSPACE; +"ORTHONORMAL_EXTENSION",ORTHONORMAL_EXTENSION; +"OR_CLAUSES",OR_CLAUSES; +"OR_DEF",OR_DEF; +"OR_EXISTS_THM",OR_EXISTS_THM; +"OSTROWSKI_THEOREM",OSTROWSKI_THEOREM; +"OUTER",OUTER; +"OUTERMORPHISM_MBASIS",OUTERMORPHISM_MBASIS; +"OUTERMORPHISM_MBASIS_EMPTY",OUTERMORPHISM_MBASIS_EMPTY; +"OUTER_ACI",OUTER_ACI; +"OUTER_ASSOC",OUTER_ASSOC; +"OUTER_LADD",OUTER_LADD; +"OUTER_LMUL",OUTER_LMUL; +"OUTER_LNEG",OUTER_LNEG; +"OUTER_LZERO",OUTER_LZERO; +"OUTER_MBASIS",OUTER_MBASIS; +"OUTER_MBASIS_LSCALAR",OUTER_MBASIS_LSCALAR; +"OUTER_MBASIS_REFL",OUTER_MBASIS_REFL; +"OUTER_MBASIS_RSCALAR",OUTER_MBASIS_RSCALAR; +"OUTER_MBASIS_SING",OUTER_MBASIS_SING; +"OUTER_MBASIS_SKEWSYM",OUTER_MBASIS_SKEWSYM; +"OUTER_RADD",OUTER_RADD; +"OUTER_RMUL",OUTER_RMUL; +"OUTER_RNEG",OUTER_RNEG; +"OUTER_RZERO",OUTER_RZERO; +"OUTL",OUTL; +"OUTR",OUTR; +"OUTSIDE",OUTSIDE; +"OUTSIDE_BOUNDED_NONEMPTY",OUTSIDE_BOUNDED_NONEMPTY; +"OUTSIDE_COMPACT_IN_OPEN",OUTSIDE_COMPACT_IN_OPEN; +"OUTSIDE_CONNECTED_COMPONENT_LE",OUTSIDE_CONNECTED_COMPONENT_LE; +"OUTSIDE_CONNECTED_COMPONENT_LT",OUTSIDE_CONNECTED_COMPONENT_LT; +"OUTSIDE_CONVEX",OUTSIDE_CONVEX; +"OUTSIDE_EMPTY",OUTSIDE_EMPTY; +"OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE",OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE; +"OUTSIDE_FRONTIER_MISSES_CLOSURE",OUTSIDE_FRONTIER_MISSES_CLOSURE; +"OUTSIDE_INSIDE",OUTSIDE_INSIDE; +"OUTSIDE_IN_COMPONENTS",OUTSIDE_IN_COMPONENTS; +"OUTSIDE_LINEAR_IMAGE",OUTSIDE_LINEAR_IMAGE; +"OUTSIDE_MONO",OUTSIDE_MONO; +"OUTSIDE_NO_OVERLAP",OUTSIDE_NO_OVERLAP; +"OUTSIDE_SAME_COMPONENT",OUTSIDE_SAME_COMPONENT; +"OUTSIDE_SUBSET_CONVEX",OUTSIDE_SUBSET_CONVEX; +"OUTSIDE_TRANSLATION",OUTSIDE_TRANSLATION; +"OUTSIDE_UNION_OUTSIDE_UNION",OUTSIDE_UNION_OUTSIDE_UNION; +"PAIR",PAIR; +"PAIRED_ETA_THM",PAIRED_ETA_THM; +"PAIRED_EXT",PAIRED_EXT; +"PAIRWISE",PAIRWISE; +"PAIRWISE_DISJOINT_COMPONENTS",PAIRWISE_DISJOINT_COMPONENTS; +"PAIRWISE_EMPTY",PAIRWISE_EMPTY; +"PAIRWISE_IMAGE",PAIRWISE_IMAGE; +"PAIRWISE_INSERT",PAIRWISE_INSERT; +"PAIRWISE_MONO",PAIRWISE_MONO; +"PAIRWISE_ORTHOGONAL_IMP_FINITE",PAIRWISE_ORTHOGONAL_IMP_FINITE; +"PAIRWISE_ORTHOGONAL_INDEPENDENT",PAIRWISE_ORTHOGONAL_INDEPENDENT; +"PAIRWISE_SING",PAIRWISE_SING; +"PAIR_EQ",PAIR_EQ; +"PAIR_EXISTS_THM",PAIR_EXISTS_THM; +"PAIR_SURJECTIVE",PAIR_SURJECTIVE; +"PARACOMPACT",PARACOMPACT; +"PARACOMPACT_CLOSED",PARACOMPACT_CLOSED; +"PARACOMPACT_CLOSED_IN",PARACOMPACT_CLOSED_IN; +"PARTIAL_DIVISION_EXTEND",PARTIAL_DIVISION_EXTEND; +"PARTIAL_DIVISION_EXTEND_1",PARTIAL_DIVISION_EXTEND_1; +"PARTIAL_DIVISION_EXTEND_INTERVAL",PARTIAL_DIVISION_EXTEND_INTERVAL; +"PARTIAL_DIVISION_OF_TAGGED_DIVISION",PARTIAL_DIVISION_OF_TAGGED_DIVISION; +"PARTIAL_SUMS_COMPONENT_LE_INFSUM",PARTIAL_SUMS_COMPONENT_LE_INFSUM; +"PARTIAL_SUMS_DROP_LE_INFSUM",PARTIAL_SUMS_DROP_LE_INFSUM; +"PASSOC_DEF",PASSOC_DEF; +"PASTECART_ADD",PASTECART_ADD; +"PASTECART_AS_ORTHOGONAL_SUM",PASTECART_AS_ORTHOGONAL_SUM; +"PASTECART_CMUL",PASTECART_CMUL; +"PASTECART_EQ",PASTECART_EQ; +"PASTECART_EQ_VEC",PASTECART_EQ_VEC; +"PASTECART_FST_SND",PASTECART_FST_SND; +"PASTECART_INJ",PASTECART_INJ; +"PASTECART_IN_INTERIOR_SUBTOPOLOGY",PASTECART_IN_INTERIOR_SUBTOPOLOGY; +"PASTECART_IN_PCROSS",PASTECART_IN_PCROSS; +"PASTECART_NEG",PASTECART_NEG; +"PASTECART_SUB",PASTECART_SUB; +"PASTECART_VEC",PASTECART_VEC; +"PASTECART_VSUM",PASTECART_VSUM; +"PASTING_LEMMA",PASTING_LEMMA; +"PASTING_LEMMA_CLOSED",PASTING_LEMMA_CLOSED; +"PASTING_LEMMA_EXISTS",PASTING_LEMMA_EXISTS; +"PASTING_LEMMA_EXISTS_CLOSED",PASTING_LEMMA_EXISTS_CLOSED; +"PATHFINISH_CIRCLEPATH",PATHFINISH_CIRCLEPATH; +"PATHFINISH_COMPOSE",PATHFINISH_COMPOSE; +"PATHFINISH_IN_PATH_IMAGE",PATHFINISH_IN_PATH_IMAGE; +"PATHFINISH_JOIN",PATHFINISH_JOIN; +"PATHFINISH_LINEAR_IMAGE",PATHFINISH_LINEAR_IMAGE; +"PATHFINISH_LINEPATH",PATHFINISH_LINEPATH; +"PATHFINISH_PARTCIRCLEPATH",PATHFINISH_PARTCIRCLEPATH; +"PATHFINISH_REVERSEPATH",PATHFINISH_REVERSEPATH; +"PATHFINISH_SHIFTPATH",PATHFINISH_SHIFTPATH; +"PATHFINISH_SUBPATH",PATHFINISH_SUBPATH; +"PATHFINISH_TRANSLATION",PATHFINISH_TRANSLATION; +"PATHINTEGRAL_CONVEX_PRIMITIVE",PATHINTEGRAL_CONVEX_PRIMITIVE; +"PATHSTART_CIRCLEPATH",PATHSTART_CIRCLEPATH; +"PATHSTART_COMPOSE",PATHSTART_COMPOSE; +"PATHSTART_IN_PATH_IMAGE",PATHSTART_IN_PATH_IMAGE; +"PATHSTART_JOIN",PATHSTART_JOIN; +"PATHSTART_LINEAR_IMAGE_EQ",PATHSTART_LINEAR_IMAGE_EQ; +"PATHSTART_LINEPATH",PATHSTART_LINEPATH; +"PATHSTART_PARTCIRCLEPATH",PATHSTART_PARTCIRCLEPATH; +"PATHSTART_REVERSEPATH",PATHSTART_REVERSEPATH; +"PATHSTART_SHIFTPATH",PATHSTART_SHIFTPATH; +"PATHSTART_SUBPATH",PATHSTART_SUBPATH; +"PATHSTART_TRANSLATION",PATHSTART_TRANSLATION; +"PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION",PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION; +"PATH_ASSOC",PATH_ASSOC; +"PATH_COMPONENT",PATH_COMPONENT; +"PATH_COMPONENT_DISJOINT",PATH_COMPONENT_DISJOINT; +"PATH_COMPONENT_EMPTY",PATH_COMPONENT_EMPTY; +"PATH_COMPONENT_EQ",PATH_COMPONENT_EQ; +"PATH_COMPONENT_EQ_CONNECTED_COMPONENT",PATH_COMPONENT_EQ_CONNECTED_COMPONENT; +"PATH_COMPONENT_EQ_EMPTY",PATH_COMPONENT_EQ_EMPTY; +"PATH_COMPONENT_EQ_EQ",PATH_COMPONENT_EQ_EQ; +"PATH_COMPONENT_IMP_HOMOTOPIC_POINTS",PATH_COMPONENT_IMP_HOMOTOPIC_POINTS; +"PATH_COMPONENT_IN",PATH_COMPONENT_IN; +"PATH_COMPONENT_INTERMEDIATE_SUBSET",PATH_COMPONENT_INTERMEDIATE_SUBSET; +"PATH_COMPONENT_LINEAR_IMAGE",PATH_COMPONENT_LINEAR_IMAGE; +"PATH_COMPONENT_MAXIMAL",PATH_COMPONENT_MAXIMAL; +"PATH_COMPONENT_MONO",PATH_COMPONENT_MONO; +"PATH_COMPONENT_OF_SUBSET",PATH_COMPONENT_OF_SUBSET; +"PATH_COMPONENT_PATH_COMPONENT",PATH_COMPONENT_PATH_COMPONENT; +"PATH_COMPONENT_PATH_IMAGE_PATHSTART",PATH_COMPONENT_PATH_IMAGE_PATHSTART; +"PATH_COMPONENT_REFL",PATH_COMPONENT_REFL; +"PATH_COMPONENT_REFL_EQ",PATH_COMPONENT_REFL_EQ; +"PATH_COMPONENT_SET",PATH_COMPONENT_SET; +"PATH_COMPONENT_SUBSET",PATH_COMPONENT_SUBSET; +"PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT",PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; +"PATH_COMPONENT_SYM",PATH_COMPONENT_SYM; +"PATH_COMPONENT_SYM_EQ",PATH_COMPONENT_SYM_EQ; +"PATH_COMPONENT_TRANS",PATH_COMPONENT_TRANS; +"PATH_COMPONENT_TRANSLATION",PATH_COMPONENT_TRANSLATION; +"PATH_COMPONENT_UNIQUE",PATH_COMPONENT_UNIQUE; +"PATH_COMPONENT_UNIV",PATH_COMPONENT_UNIV; +"PATH_COMPOSE_JOIN",PATH_COMPOSE_JOIN; +"PATH_COMPOSE_REVERSEPATH",PATH_COMPOSE_REVERSEPATH; +"PATH_CONNECTED_ANNULUS",PATH_CONNECTED_ANNULUS; +"PATH_CONNECTED_ARCWISE",PATH_CONNECTED_ARCWISE; +"PATH_CONNECTED_ARC_COMPLEMENT",PATH_CONNECTED_ARC_COMPLEMENT; +"PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; +"PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX",PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX; +"PATH_CONNECTED_COMPLEMENT_CARD_LT",PATH_CONNECTED_COMPLEMENT_CARD_LT; +"PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; +"PATH_CONNECTED_COMPONENT_SET",PATH_CONNECTED_COMPONENT_SET; +"PATH_CONNECTED_CONTINUOUS_IMAGE",PATH_CONNECTED_CONTINUOUS_IMAGE; +"PATH_CONNECTED_CONVEX_DIFF_CARD_LT",PATH_CONNECTED_CONVEX_DIFF_CARD_LT; +"PATH_CONNECTED_CONVEX_DIFF_COUNTABLE",PATH_CONNECTED_CONVEX_DIFF_COUNTABLE; +"PATH_CONNECTED_DIFF_BALL",PATH_CONNECTED_DIFF_BALL; +"PATH_CONNECTED_EMPTY",PATH_CONNECTED_EMPTY; +"PATH_CONNECTED_EQ_CONNECTED",PATH_CONNECTED_EQ_CONNECTED; +"PATH_CONNECTED_EQ_CONNECTED_LPC",PATH_CONNECTED_EQ_CONNECTED_LPC; +"PATH_CONNECTED_EQ_HOMOTOPIC_POINTS",PATH_CONNECTED_EQ_HOMOTOPIC_POINTS; +"PATH_CONNECTED_IFF_PATH_COMPONENT",PATH_CONNECTED_IFF_PATH_COMPONENT; +"PATH_CONNECTED_IMP_CONNECTED",PATH_CONNECTED_IMP_CONNECTED; +"PATH_CONNECTED_INTERVAL",PATH_CONNECTED_INTERVAL; +"PATH_CONNECTED_LINEAR_IMAGE",PATH_CONNECTED_LINEAR_IMAGE; +"PATH_CONNECTED_LINEAR_IMAGE_EQ",PATH_CONNECTED_LINEAR_IMAGE_EQ; +"PATH_CONNECTED_LINEPATH",PATH_CONNECTED_LINEPATH; +"PATH_CONNECTED_NEGATIONS",PATH_CONNECTED_NEGATIONS; +"PATH_CONNECTED_OPEN_DELETE",PATH_CONNECTED_OPEN_DELETE; +"PATH_CONNECTED_OPEN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_DIFF_CARD_LT; +"PATH_CONNECTED_OPEN_DIFF_COUNTABLE",PATH_CONNECTED_OPEN_DIFF_COUNTABLE; +"PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT; +"PATH_CONNECTED_PATH_COMPONENT",PATH_CONNECTED_PATH_COMPONENT; +"PATH_CONNECTED_PATH_IMAGE",PATH_CONNECTED_PATH_IMAGE; +"PATH_CONNECTED_PCROSS",PATH_CONNECTED_PCROSS; +"PATH_CONNECTED_PCROSS_EQ",PATH_CONNECTED_PCROSS_EQ; +"PATH_CONNECTED_PUNCTURED_BALL",PATH_CONNECTED_PUNCTURED_BALL; +"PATH_CONNECTED_PUNCTURED_CONVEX",PATH_CONNECTED_PUNCTURED_CONVEX; +"PATH_CONNECTED_PUNCTURED_UNIVERSE",PATH_CONNECTED_PUNCTURED_UNIVERSE; +"PATH_CONNECTED_REAL",PATH_CONNECTED_REAL; +"PATH_CONNECTED_SCALING",PATH_CONNECTED_SCALING; +"PATH_CONNECTED_SEGMENT",PATH_CONNECTED_SEGMENT; +"PATH_CONNECTED_SEMIOPEN_SEGMENT",PATH_CONNECTED_SEMIOPEN_SEGMENT; +"PATH_CONNECTED_SING",PATH_CONNECTED_SING; +"PATH_CONNECTED_SPHERE",PATH_CONNECTED_SPHERE; +"PATH_CONNECTED_SPHERE_EQ",PATH_CONNECTED_SPHERE_EQ; +"PATH_CONNECTED_SPHERE_GEN",PATH_CONNECTED_SPHERE_GEN; +"PATH_CONNECTED_SUMS",PATH_CONNECTED_SUMS; +"PATH_CONNECTED_TRANSLATION",PATH_CONNECTED_TRANSLATION; +"PATH_CONNECTED_TRANSLATION_EQ",PATH_CONNECTED_TRANSLATION_EQ; +"PATH_CONNECTED_UNION",PATH_CONNECTED_UNION; +"PATH_CONNECTED_UNIV",PATH_CONNECTED_UNIV; +"PATH_CONTAINS_ARC",PATH_CONTAINS_ARC; +"PATH_CONTINUOUS_IMAGE",PATH_CONTINUOUS_IMAGE; +"PATH_EQ",PATH_EQ; +"PATH_IMAGE_CIRCLEPATH",PATH_IMAGE_CIRCLEPATH; +"PATH_IMAGE_COMPOSE",PATH_IMAGE_COMPOSE; +"PATH_IMAGE_JOIN",PATH_IMAGE_JOIN; +"PATH_IMAGE_JOIN_SUBSET",PATH_IMAGE_JOIN_SUBSET; +"PATH_IMAGE_LINEAR_IMAGE",PATH_IMAGE_LINEAR_IMAGE; +"PATH_IMAGE_LINEPATH",PATH_IMAGE_LINEPATH; +"PATH_IMAGE_NONEMPTY",PATH_IMAGE_NONEMPTY; +"PATH_IMAGE_PARTCIRCLEPATH",PATH_IMAGE_PARTCIRCLEPATH; +"PATH_IMAGE_PARTCIRCLEPATH_SUBSET",PATH_IMAGE_PARTCIRCLEPATH_SUBSET; +"PATH_IMAGE_REVERSEPATH",PATH_IMAGE_REVERSEPATH; +"PATH_IMAGE_SHIFTPATH",PATH_IMAGE_SHIFTPATH; +"PATH_IMAGE_SUBPATH",PATH_IMAGE_SUBPATH; +"PATH_IMAGE_SUBPATH_GEN",PATH_IMAGE_SUBPATH_GEN; +"PATH_IMAGE_SUBPATH_SUBSET",PATH_IMAGE_SUBPATH_SUBSET; +"PATH_IMAGE_SYM",PATH_IMAGE_SYM; +"PATH_IMAGE_TRANSLATION",PATH_IMAGE_TRANSLATION; +"PATH_INTEGRABLE_ADD",PATH_INTEGRABLE_ADD; +"PATH_INTEGRABLE_COMPLEX_DIV",PATH_INTEGRABLE_COMPLEX_DIV; +"PATH_INTEGRABLE_COMPLEX_LMUL",PATH_INTEGRABLE_COMPLEX_LMUL; +"PATH_INTEGRABLE_COMPLEX_RMUL",PATH_INTEGRABLE_COMPLEX_RMUL; +"PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH",PATH_INTEGRABLE_CONTINUOUS_CIRCLEPATH; +"PATH_INTEGRABLE_CONTINUOUS_LINEPATH",PATH_INTEGRABLE_CONTINUOUS_LINEPATH; +"PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH",PATH_INTEGRABLE_CONTINUOUS_PARTCIRCLEPATH; +"PATH_INTEGRABLE_EQ",PATH_INTEGRABLE_EQ; +"PATH_INTEGRABLE_HOLOMORPHIC",PATH_INTEGRABLE_HOLOMORPHIC; +"PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE",PATH_INTEGRABLE_HOLOMORPHIC_SIMPLE; +"PATH_INTEGRABLE_INVERSEDIFF",PATH_INTEGRABLE_INVERSEDIFF; +"PATH_INTEGRABLE_JOIN",PATH_INTEGRABLE_JOIN; +"PATH_INTEGRABLE_NEG",PATH_INTEGRABLE_NEG; +"PATH_INTEGRABLE_ON",PATH_INTEGRABLE_ON; +"PATH_INTEGRABLE_REVERSEPATH",PATH_INTEGRABLE_REVERSEPATH; +"PATH_INTEGRABLE_REVERSEPATH_EQ",PATH_INTEGRABLE_REVERSEPATH_EQ; +"PATH_INTEGRABLE_SUB",PATH_INTEGRABLE_SUB; +"PATH_INTEGRABLE_SUBPATH",PATH_INTEGRABLE_SUBPATH; +"PATH_INTEGRABLE_SUBPATH_REFL",PATH_INTEGRABLE_SUBPATH_REFL; +"PATH_INTEGRABLE_VSUM",PATH_INTEGRABLE_VSUM; +"PATH_INTEGRAL_0",PATH_INTEGRAL_0; +"PATH_INTEGRAL_ADD",PATH_INTEGRAL_ADD; +"PATH_INTEGRAL_BOUND_EXISTS",PATH_INTEGRAL_BOUND_EXISTS; +"PATH_INTEGRAL_BOUND_LINEPATH",PATH_INTEGRAL_BOUND_LINEPATH; +"PATH_INTEGRAL_COMPLEX_DIV",PATH_INTEGRAL_COMPLEX_DIV; +"PATH_INTEGRAL_COMPLEX_LMUL",PATH_INTEGRAL_COMPLEX_LMUL; +"PATH_INTEGRAL_COMPLEX_RMUL",PATH_INTEGRAL_COMPLEX_RMUL; +"PATH_INTEGRAL_CONST_LINEPATH",PATH_INTEGRAL_CONST_LINEPATH; +"PATH_INTEGRAL_EQ",PATH_INTEGRAL_EQ; +"PATH_INTEGRAL_EQ_0",PATH_INTEGRAL_EQ_0; +"PATH_INTEGRAL_INTEGRAL",PATH_INTEGRAL_INTEGRAL; +"PATH_INTEGRAL_JOIN",PATH_INTEGRAL_JOIN; +"PATH_INTEGRAL_LOCAL_PRIMITIVE",PATH_INTEGRAL_LOCAL_PRIMITIVE; +"PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY",PATH_INTEGRAL_LOCAL_PRIMITIVE_ANY; +"PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA",PATH_INTEGRAL_LOCAL_PRIMITIVE_LEMMA; +"PATH_INTEGRAL_MIDPOINT",PATH_INTEGRAL_MIDPOINT; +"PATH_INTEGRAL_NEARBY_ENDS",PATH_INTEGRAL_NEARBY_ENDS; +"PATH_INTEGRAL_NEARBY_LOOP",PATH_INTEGRAL_NEARBY_LOOP; +"PATH_INTEGRAL_NEG",PATH_INTEGRAL_NEG; +"PATH_INTEGRAL_PRIMITIVE",PATH_INTEGRAL_PRIMITIVE; +"PATH_INTEGRAL_PRIMITIVE_LEMMA",PATH_INTEGRAL_PRIMITIVE_LEMMA; +"PATH_INTEGRAL_REVERSEPATH",PATH_INTEGRAL_REVERSEPATH; +"PATH_INTEGRAL_REVERSE_LINEPATH",PATH_INTEGRAL_REVERSE_LINEPATH; +"PATH_INTEGRAL_SHIFTPATH",PATH_INTEGRAL_SHIFTPATH; +"PATH_INTEGRAL_SPLIT",PATH_INTEGRAL_SPLIT; +"PATH_INTEGRAL_SPLIT_LINEPATH",PATH_INTEGRAL_SPLIT_LINEPATH; +"PATH_INTEGRAL_SUB",PATH_INTEGRAL_SUB; +"PATH_INTEGRAL_SUBPATH_COMBINE",PATH_INTEGRAL_SUBPATH_COMBINE; +"PATH_INTEGRAL_SUBPATH_INTEGRAL",PATH_INTEGRAL_SUBPATH_INTEGRAL; +"PATH_INTEGRAL_SUBPATH_REFL",PATH_INTEGRAL_SUBPATH_REFL; +"PATH_INTEGRAL_SWAP",PATH_INTEGRAL_SWAP; +"PATH_INTEGRAL_TRIVIAL",PATH_INTEGRAL_TRIVIAL; +"PATH_INTEGRAL_UNIFORM_LIMIT",PATH_INTEGRAL_UNIFORM_LIMIT; +"PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH",PATH_INTEGRAL_UNIFORM_LIMIT_CIRCLEPATH; +"PATH_INTEGRAL_UNIQUE",PATH_INTEGRAL_UNIQUE; +"PATH_INTEGRAL_VSUM",PATH_INTEGRAL_VSUM; +"PATH_JOIN",PATH_JOIN; +"PATH_JOIN_EQ",PATH_JOIN_EQ; +"PATH_JOIN_IMP",PATH_JOIN_IMP; +"PATH_JOIN_PATH_ENDS",PATH_JOIN_PATH_ENDS; +"PATH_LENGTH_DIFFERENTIABLE",PATH_LENGTH_DIFFERENTIABLE; +"PATH_LENGTH_JOIN",PATH_LENGTH_JOIN; +"PATH_LENGTH_REVERSEPATH",PATH_LENGTH_REVERSEPATH; +"PATH_LENGTH_VALID_PATH",PATH_LENGTH_VALID_PATH; +"PATH_LINEAR_IMAGE_EQ",PATH_LINEAR_IMAGE_EQ; +"PATH_LINEPATH",PATH_LINEPATH; +"PATH_PARTCIRCLEPATH",PATH_PARTCIRCLEPATH; +"PATH_REVERSEPATH",PATH_REVERSEPATH; +"PATH_SHIFTPATH",PATH_SHIFTPATH; +"PATH_SUBPATH",PATH_SUBPATH; +"PATH_SYM",PATH_SYM; +"PATH_TRANSLATION_EQ",PATH_TRANSLATION_EQ; +"PATH_VECTOR_POLYNOMIAL_FUNCTION",PATH_VECTOR_POLYNOMIAL_FUNCTION; +"PCROSS",PCROSS; +"PCROSS_AS_ORTHOGONAL_SUM",PCROSS_AS_ORTHOGONAL_SUM; +"PCROSS_DIFF",PCROSS_DIFF; +"PCROSS_EMPTY",PCROSS_EMPTY; +"PCROSS_EQ",PCROSS_EQ; +"PCROSS_EQ_EMPTY",PCROSS_EQ_EMPTY; +"PCROSS_INTER",PCROSS_INTER; +"PCROSS_INTERVAL",PCROSS_INTERVAL; +"PCROSS_MONO",PCROSS_MONO; +"PCROSS_UNION",PCROSS_UNION; +"PCROSS_UNIONS",PCROSS_UNIONS; +"PCROSS_UNIONS_UNIONS",PCROSS_UNIONS_UNIONS; +"PERMUTATION",PERMUTATION; +"PERMUTATION_BIJECTIVE",PERMUTATION_BIJECTIVE; +"PERMUTATION_COMPOSE",PERMUTATION_COMPOSE; +"PERMUTATION_COMPOSE_EQ",PERMUTATION_COMPOSE_EQ; +"PERMUTATION_COMPOSE_SWAP",PERMUTATION_COMPOSE_SWAP; +"PERMUTATION_FINITE_SUPPORT",PERMUTATION_FINITE_SUPPORT; +"PERMUTATION_I",PERMUTATION_I; +"PERMUTATION_INVERSE",PERMUTATION_INVERSE; +"PERMUTATION_INVERSE_COMPOSE",PERMUTATION_INVERSE_COMPOSE; +"PERMUTATION_INVERSE_WORKS",PERMUTATION_INVERSE_WORKS; +"PERMUTATION_LEMMA",PERMUTATION_LEMMA; +"PERMUTATION_PERMUTES",PERMUTATION_PERMUTES; +"PERMUTATION_SWAP",PERMUTATION_SWAP; +"PERMUTES_BIJECTIONS",PERMUTES_BIJECTIONS; +"PERMUTES_COMPOSE",PERMUTES_COMPOSE; +"PERMUTES_EMPTY",PERMUTES_EMPTY; +"PERMUTES_FINITE_INJECTIVE",PERMUTES_FINITE_INJECTIVE; +"PERMUTES_FINITE_SURJECTIVE",PERMUTES_FINITE_SURJECTIVE; +"PERMUTES_I",PERMUTES_I; +"PERMUTES_IMAGE",PERMUTES_IMAGE; +"PERMUTES_INDUCT",PERMUTES_INDUCT; +"PERMUTES_INJECTIVE",PERMUTES_INJECTIVE; +"PERMUTES_INSERT",PERMUTES_INSERT; +"PERMUTES_INSERT_LEMMA",PERMUTES_INSERT_LEMMA; +"PERMUTES_INVERSE",PERMUTES_INVERSE; +"PERMUTES_INVERSES",PERMUTES_INVERSES; +"PERMUTES_INVERSES_o",PERMUTES_INVERSES_o; +"PERMUTES_INVERSE_EQ",PERMUTES_INVERSE_EQ; +"PERMUTES_INVERSE_INVERSE",PERMUTES_INVERSE_INVERSE; +"PERMUTES_IN_IMAGE",PERMUTES_IN_IMAGE; +"PERMUTES_IN_NUMSEG",PERMUTES_IN_NUMSEG; +"PERMUTES_NUMSET_GE",PERMUTES_NUMSET_GE; +"PERMUTES_NUMSET_LE",PERMUTES_NUMSET_LE; +"PERMUTES_SING",PERMUTES_SING; +"PERMUTES_SUBSET",PERMUTES_SUBSET; +"PERMUTES_SUPERSET",PERMUTES_SUPERSET; +"PERMUTES_SURJECTIVE",PERMUTES_SURJECTIVE; +"PERMUTES_SWAP",PERMUTES_SWAP; +"PERMUTES_UNIV",PERMUTES_UNIV; +"PI2_BOUNDS",PI2_BOUNDS; +"PIECEWISE_DIFFERENTIABLE_ADD",PIECEWISE_DIFFERENTIABLE_ADD; +"PIECEWISE_DIFFERENTIABLE_AFFINE",PIECEWISE_DIFFERENTIABLE_AFFINE; +"PIECEWISE_DIFFERENTIABLE_CASES",PIECEWISE_DIFFERENTIABLE_CASES; +"PIECEWISE_DIFFERENTIABLE_COMPOSE",PIECEWISE_DIFFERENTIABLE_COMPOSE; +"PIECEWISE_DIFFERENTIABLE_NEG",PIECEWISE_DIFFERENTIABLE_NEG; +"PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON",PIECEWISE_DIFFERENTIABLE_ON_IMP_CONTINUOUS_ON; +"PIECEWISE_DIFFERENTIABLE_ON_SUBSET",PIECEWISE_DIFFERENTIABLE_ON_SUBSET; +"PIECEWISE_DIFFERENTIABLE_SUB",PIECEWISE_DIFFERENTIABLE_SUB; +"PI_APPROX_32",PI_APPROX_32; +"PI_NZ",PI_NZ; +"PI_POS",PI_POS; +"PI_POS_LE",PI_POS_LE; +"PI_WORKS",PI_WORKS; +"POINTS_IN_CONVEX_HULL",POINTS_IN_CONVEX_HULL; +"POINTWISE_ANTISYM",POINTWISE_ANTISYM; +"POINTWISE_MAXIMAL",POINTWISE_MAXIMAL; +"POINTWISE_MINIMAL",POINTWISE_MINIMAL; +"POLE_AT_INFINITY",POLE_AT_INFINITY; +"POLE_LEMMA",POLE_LEMMA; +"POLE_LEMMA_OPEN",POLE_LEMMA_OPEN; +"POLE_THEOREM",POLE_THEOREM; +"POLE_THEOREM_0",POLE_THEOREM_0; +"POLE_THEOREM_ANALYTIC",POLE_THEOREM_ANALYTIC; +"POLE_THEOREM_ANALYTIC_0",POLE_THEOREM_ANALYTIC_0; +"POLE_THEOREM_ANALYTIC_OPEN_SUPERSET",POLE_THEOREM_ANALYTIC_OPEN_SUPERSET; +"POLE_THEOREM_ANALYTIC_OPEN_SUPERSET_0",POLE_THEOREM_ANALYTIC_OPEN_SUPERSET_0; +"POLE_THEOREM_OPEN",POLE_THEOREM_OPEN; +"POLE_THEOREM_OPEN_0",POLE_THEOREM_OPEN_0; +"POLYHEDRAL_CONVEX_CONE",POLYHEDRAL_CONVEX_CONE; +"POLYHEDRON_AFFINE_HULL",POLYHEDRON_AFFINE_HULL; +"POLYHEDRON_AS_CONE_PLUS_CONV",POLYHEDRON_AS_CONE_PLUS_CONV; +"POLYHEDRON_CONVEX_CONE_HULL",POLYHEDRON_CONVEX_CONE_HULL; +"POLYHEDRON_CONVEX_HULL",POLYHEDRON_CONVEX_HULL; +"POLYHEDRON_EMPTY",POLYHEDRON_EMPTY; +"POLYHEDRON_EQ_FINITE_EXPOSED_FACES",POLYHEDRON_EQ_FINITE_EXPOSED_FACES; +"POLYHEDRON_EQ_FINITE_FACES",POLYHEDRON_EQ_FINITE_FACES; +"POLYHEDRON_HALFSPACE_GE",POLYHEDRON_HALFSPACE_GE; +"POLYHEDRON_HALFSPACE_LE",POLYHEDRON_HALFSPACE_LE; +"POLYHEDRON_HYPERPLANE",POLYHEDRON_HYPERPLANE; +"POLYHEDRON_IMP_CLOSED",POLYHEDRON_IMP_CLOSED; +"POLYHEDRON_IMP_CONVEX",POLYHEDRON_IMP_CONVEX; +"POLYHEDRON_INTER",POLYHEDRON_INTER; +"POLYHEDRON_INTERS",POLYHEDRON_INTERS; +"POLYHEDRON_INTERVAL",POLYHEDRON_INTERVAL; +"POLYHEDRON_INTER_AFFINE",POLYHEDRON_INTER_AFFINE; +"POLYHEDRON_INTER_AFFINE_MINIMAL",POLYHEDRON_INTER_AFFINE_MINIMAL; +"POLYHEDRON_INTER_AFFINE_PARALLEL",POLYHEDRON_INTER_AFFINE_PARALLEL; +"POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL",POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL; +"POLYHEDRON_INTER_POLYTOPE",POLYHEDRON_INTER_POLYTOPE; +"POLYHEDRON_LINEAR_IMAGE",POLYHEDRON_LINEAR_IMAGE; +"POLYHEDRON_LINEAR_IMAGE_EQ",POLYHEDRON_LINEAR_IMAGE_EQ; +"POLYHEDRON_NEGATIONS",POLYHEDRON_NEGATIONS; +"POLYHEDRON_POLYTOPE_SUMS",POLYHEDRON_POLYTOPE_SUMS; +"POLYHEDRON_POSITIVE_ORTHANT",POLYHEDRON_POSITIVE_ORTHANT; +"POLYHEDRON_RIDGE_TWO_FACETS",POLYHEDRON_RIDGE_TWO_FACETS; +"POLYHEDRON_SUMS",POLYHEDRON_SUMS; +"POLYHEDRON_TRANSLATION_EQ",POLYHEDRON_TRANSLATION_EQ; +"POLYHEDRON_UNIV",POLYHEDRON_UNIV; +"POLYNOMIAL_FUNCTION_ADD",POLYNOMIAL_FUNCTION_ADD; +"POLYNOMIAL_FUNCTION_BERNOULLI",POLYNOMIAL_FUNCTION_BERNOULLI; +"POLYNOMIAL_FUNCTION_CONST",POLYNOMIAL_FUNCTION_CONST; +"POLYNOMIAL_FUNCTION_FINITE_ROOTS",POLYNOMIAL_FUNCTION_FINITE_ROOTS; +"POLYNOMIAL_FUNCTION_I",POLYNOMIAL_FUNCTION_I; +"POLYNOMIAL_FUNCTION_ID",POLYNOMIAL_FUNCTION_ID; +"POLYNOMIAL_FUNCTION_INDUCT",POLYNOMIAL_FUNCTION_INDUCT; +"POLYNOMIAL_FUNCTION_LMUL",POLYNOMIAL_FUNCTION_LMUL; +"POLYNOMIAL_FUNCTION_MUL",POLYNOMIAL_FUNCTION_MUL; +"POLYNOMIAL_FUNCTION_NEG",POLYNOMIAL_FUNCTION_NEG; +"POLYNOMIAL_FUNCTION_POW",POLYNOMIAL_FUNCTION_POW; +"POLYNOMIAL_FUNCTION_RMUL",POLYNOMIAL_FUNCTION_RMUL; +"POLYNOMIAL_FUNCTION_SUB",POLYNOMIAL_FUNCTION_SUB; +"POLYNOMIAL_FUNCTION_SUM",POLYNOMIAL_FUNCTION_SUM; +"POLYNOMIAL_FUNCTION_o",POLYNOMIAL_FUNCTION_o; +"POLYTOPE_CONVEX_HULL",POLYTOPE_CONVEX_HULL; +"POLYTOPE_EMPTY",POLYTOPE_EMPTY; +"POLYTOPE_EQ_BOUNDED_POLYHEDRON",POLYTOPE_EQ_BOUNDED_POLYHEDRON; +"POLYTOPE_FACET_EXISTS",POLYTOPE_FACET_EXISTS; +"POLYTOPE_FACET_LOWER_BOUND",POLYTOPE_FACET_LOWER_BOUND; +"POLYTOPE_IMP_BOUNDED",POLYTOPE_IMP_BOUNDED; +"POLYTOPE_IMP_CLOSED",POLYTOPE_IMP_CLOSED; +"POLYTOPE_IMP_COMPACT",POLYTOPE_IMP_COMPACT; +"POLYTOPE_IMP_CONVEX",POLYTOPE_IMP_CONVEX; +"POLYTOPE_IMP_POLYHEDRON",POLYTOPE_IMP_POLYHEDRON; +"POLYTOPE_INTER",POLYTOPE_INTER; +"POLYTOPE_INTERVAL",POLYTOPE_INTERVAL; +"POLYTOPE_INTER_POLYHEDRON",POLYTOPE_INTER_POLYHEDRON; +"POLYTOPE_LINEAR_IMAGE",POLYTOPE_LINEAR_IMAGE; +"POLYTOPE_LINEAR_IMAGE_EQ",POLYTOPE_LINEAR_IMAGE_EQ; +"POLYTOPE_NEGATIONS",POLYTOPE_NEGATIONS; +"POLYTOPE_PCROSS",POLYTOPE_PCROSS; +"POLYTOPE_PCROSS_EQ",POLYTOPE_PCROSS_EQ; +"POLYTOPE_SCALING",POLYTOPE_SCALING; +"POLYTOPE_SCALING_EQ",POLYTOPE_SCALING_EQ; +"POLYTOPE_SING",POLYTOPE_SING; +"POLYTOPE_SUMS",POLYTOPE_SUMS; +"POLYTOPE_TRANSLATION_EQ",POLYTOPE_TRANSLATION_EQ; +"POLYTOPE_UNION_CONVEX_HULL_FACETS",POLYTOPE_UNION_CONVEX_HULL_FACETS; +"POLYTOPE_VERTEX_LOWER_BOUND",POLYTOPE_VERTEX_LOWER_BOUND; +"POSET_ANTISYM",POSET_ANTISYM; +"POSET_FLEQ",POSET_FLEQ; +"POSET_REFL",POSET_REFL; +"POSET_RESTRICTED_SUBSET",POSET_RESTRICTED_SUBSET; +"POSET_TRANS",POSET_TRANS; +"POWERSET_CLAUSES",POWERSET_CLAUSES; +"POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK",POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK; +"POWER_SERIES_ANALYTIC",POWER_SERIES_ANALYTIC; +"POWER_SERIES_AND_DERIVATIVE",POWER_SERIES_AND_DERIVATIVE; +"POWER_SERIES_AND_DERIVATIVE_0",POWER_SERIES_AND_DERIVATIVE_0; +"POWER_SERIES_CONTINUOUS",POWER_SERIES_CONTINUOUS; +"POWER_SERIES_CONV_IMP_ABSCONV",POWER_SERIES_CONV_IMP_ABSCONV; +"POWER_SERIES_CONV_IMP_ABSCONV_WEAK",POWER_SERIES_CONV_IMP_ABSCONV_WEAK; +"POWER_SERIES_HOLOMORPHIC",POWER_SERIES_HOLOMORPHIC; +"POWER_SERIES_LIMIT_POINT_OF_ZEROS",POWER_SERIES_LIMIT_POINT_OF_ZEROS; +"POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ",POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ; +"POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1",POWER_SERIES_UNIFORM_CONVERGENCE_STOLZ_1; +"POW_2_CSQRT",POW_2_CSQRT; +"POW_2_SQRT",POW_2_SQRT; +"POW_2_SQRT_ABS",POW_2_SQRT_ABS; +"PRE",PRE; +"PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE",PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; +"PRESERVES_NORM_INJECTIVE",PRESERVES_NORM_INJECTIVE; +"PRESERVES_NORM_PRESERVES_DOT",PRESERVES_NORM_PRESERVES_DOT; +"PRE_ELIM_THM",PRE_ELIM_THM; +"PRE_ELIM_THM'",PRE_ELIM_THM'; +"PRODUCT_1",PRODUCT_1; +"PRODUCT_2",PRODUCT_2; +"PRODUCT_3",PRODUCT_3; +"PRODUCT_4",PRODUCT_4; +"PRODUCT_ABS",PRODUCT_ABS; +"PRODUCT_ADD_SPLIT",PRODUCT_ADD_SPLIT; +"PRODUCT_ASSOCIATIVE",PRODUCT_ASSOCIATIVE; +"PRODUCT_CLAUSES",PRODUCT_CLAUSES; +"PRODUCT_CLAUSES_LEFT",PRODUCT_CLAUSES_LEFT; +"PRODUCT_CLAUSES_NUMSEG",PRODUCT_CLAUSES_NUMSEG; +"PRODUCT_CLAUSES_RIGHT",PRODUCT_CLAUSES_RIGHT; +"PRODUCT_CLOSED",PRODUCT_CLOSED; +"PRODUCT_CONST",PRODUCT_CONST; +"PRODUCT_CONST_NUMSEG",PRODUCT_CONST_NUMSEG; +"PRODUCT_CONST_NUMSEG_1",PRODUCT_CONST_NUMSEG_1; +"PRODUCT_DELETE",PRODUCT_DELETE; +"PRODUCT_DIV",PRODUCT_DIV; +"PRODUCT_DIV_NUMSEG",PRODUCT_DIV_NUMSEG; +"PRODUCT_EQ",PRODUCT_EQ; +"PRODUCT_EQ_0",PRODUCT_EQ_0; +"PRODUCT_EQ_0_NUMSEG",PRODUCT_EQ_0_NUMSEG; +"PRODUCT_EQ_1",PRODUCT_EQ_1; +"PRODUCT_EQ_1_NUMSEG",PRODUCT_EQ_1_NUMSEG; +"PRODUCT_EQ_NUMSEG",PRODUCT_EQ_NUMSEG; +"PRODUCT_IMAGE",PRODUCT_IMAGE; +"PRODUCT_INV",PRODUCT_INV; +"PRODUCT_LADD",PRODUCT_LADD; +"PRODUCT_LE",PRODUCT_LE; +"PRODUCT_LE_1",PRODUCT_LE_1; +"PRODUCT_LE_NUMSEG",PRODUCT_LE_NUMSEG; +"PRODUCT_LMUL",PRODUCT_LMUL; +"PRODUCT_LNEG",PRODUCT_LNEG; +"PRODUCT_LZERO",PRODUCT_LZERO; +"PRODUCT_MBASIS",PRODUCT_MBASIS; +"PRODUCT_MBASIS_SING",PRODUCT_MBASIS_SING; +"PRODUCT_MUL",PRODUCT_MUL; +"PRODUCT_MUL_NUMSEG",PRODUCT_MUL_NUMSEG; +"PRODUCT_NEG",PRODUCT_NEG; +"PRODUCT_NEG_NUMSEG",PRODUCT_NEG_NUMSEG; +"PRODUCT_NEG_NUMSEG_1",PRODUCT_NEG_NUMSEG_1; +"PRODUCT_OFFSET",PRODUCT_OFFSET; +"PRODUCT_ONE",PRODUCT_ONE; +"PRODUCT_PAIR",PRODUCT_PAIR; +"PRODUCT_PERMUTE",PRODUCT_PERMUTE; +"PRODUCT_PERMUTE_NUMSEG",PRODUCT_PERMUTE_NUMSEG; +"PRODUCT_POS_LE",PRODUCT_POS_LE; +"PRODUCT_POS_LE_NUMSEG",PRODUCT_POS_LE_NUMSEG; +"PRODUCT_POS_LT",PRODUCT_POS_LT; +"PRODUCT_POS_LT_NUMSEG",PRODUCT_POS_LT_NUMSEG; +"PRODUCT_RADD",PRODUCT_RADD; +"PRODUCT_RMUL",PRODUCT_RMUL; +"PRODUCT_RNEG",PRODUCT_RNEG; +"PRODUCT_RZERO",PRODUCT_RZERO; +"PRODUCT_SING",PRODUCT_SING; +"PRODUCT_SING_NUMSEG",PRODUCT_SING_NUMSEG; +"PRODUCT_SUPERSET",PRODUCT_SUPERSET; +"PRODUCT_SUPPORT",PRODUCT_SUPPORT; +"PRODUCT_UNION",PRODUCT_UNION; +"PROPERTY_EMPTY_INTERVAL",PROPERTY_EMPTY_INTERVAL; +"PROPER_MAP",PROPER_MAP; +"PROPER_MAP_COMPLEX_POLYFUN",PROPER_MAP_COMPLEX_POLYFUN; +"PROPER_MAP_COMPLEX_POLYFUN_EQ",PROPER_MAP_COMPLEX_POLYFUN_EQ; +"PROPER_MAP_COMPLEX_POLYFUN_UNIV",PROPER_MAP_COMPLEX_POLYFUN_UNIV; +"PROPER_MAP_COMPOSE",PROPER_MAP_COMPOSE; +"PROPER_MAP_FROM_COMPACT",PROPER_MAP_FROM_COMPACT; +"PROPER_MAP_FROM_COMPOSITION_LEFT",PROPER_MAP_FROM_COMPOSITION_LEFT; +"PROPER_MAP_FROM_COMPOSITION_RIGHT",PROPER_MAP_FROM_COMPOSITION_RIGHT; +"PROPER_MAP_FSTCART",PROPER_MAP_FSTCART; +"PROPER_MAP_SNDCART",PROPER_MAP_SNDCART; +"PSUBSET",PSUBSET; +"PSUBSET_ALT",PSUBSET_ALT; +"PSUBSET_INSERT_SUBSET",PSUBSET_INSERT_SUBSET; +"PSUBSET_IRREFL",PSUBSET_IRREFL; +"PSUBSET_MEMBER",PSUBSET_MEMBER; +"PSUBSET_SUBSET_TRANS",PSUBSET_SUBSET_TRANS; +"PSUBSET_TRANS",PSUBSET_TRANS; +"PSUBSET_UNIV",PSUBSET_UNIV; +"PUSHIN_DROPOUT",PUSHIN_DROPOUT; +"P_HULL",P_HULL; +"Product_DEF",Product_DEF; +"QUANTIFY_SURJECTION_HIGHER_THM",QUANTIFY_SURJECTION_HIGHER_THM; +"QUANTIFY_SURJECTION_THM",QUANTIFY_SURJECTION_THM; +"QUASICOMPACT_OPEN_CLOSED",QUASICOMPACT_OPEN_CLOSED; +"QUOTIENT_MAP_CLOSED_MAP_EQ",QUOTIENT_MAP_CLOSED_MAP_EQ; +"QUOTIENT_MAP_COMPOSE",QUOTIENT_MAP_COMPOSE; +"QUOTIENT_MAP_FROM_COMPOSITION",QUOTIENT_MAP_FROM_COMPOSITION; +"QUOTIENT_MAP_FROM_SUBSET",QUOTIENT_MAP_FROM_SUBSET; +"QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED",QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED; +"QUOTIENT_MAP_IMP_CONTINUOUS_OPEN",QUOTIENT_MAP_IMP_CONTINUOUS_OPEN; +"QUOTIENT_MAP_OPEN_CLOSED",QUOTIENT_MAP_OPEN_CLOSED; +"QUOTIENT_MAP_OPEN_MAP_EQ",QUOTIENT_MAP_OPEN_MAP_EQ; +"QUOTIENT_MAP_RESTRICT",QUOTIENT_MAP_RESTRICT; +"RADON",RADON; +"RADON_EX_LEMMA",RADON_EX_LEMMA; +"RADON_PARTITION",RADON_PARTITION; +"RADON_S_LEMMA",RADON_S_LEMMA; +"RADON_V_LEMMA",RADON_V_LEMMA; +"RANK_0",RANK_0; +"RANK_BOUND",RANK_BOUND; +"RANK_COFACTOR",RANK_COFACTOR; +"RANK_COFACTOR_EQ_1",RANK_COFACTOR_EQ_1; +"RANK_COFACTOR_EQ_FULL",RANK_COFACTOR_EQ_FULL; +"RANK_DIM_IM",RANK_DIM_IM; +"RANK_EQ_0",RANK_EQ_0; +"RANK_EQ_FULL_DET",RANK_EQ_FULL_DET; +"RANK_GRAM",RANK_GRAM; +"RANK_I",RANK_I; +"RANK_MUL_LE_LEFT",RANK_MUL_LE_LEFT; +"RANK_MUL_LE_RIGHT",RANK_MUL_LE_RIGHT; +"RANK_NULLSPACE",RANK_NULLSPACE; +"RANK_ROW",RANK_ROW; +"RANK_SYLVESTER",RANK_SYLVESTER; +"RANK_TRANSP",RANK_TRANSP; +"RANK_TRIANGLE",RANK_TRIANGLE; +"RATIONAL_ABS",RATIONAL_ABS; +"RATIONAL_ADD",RATIONAL_ADD; +"RATIONAL_ALT",RATIONAL_ALT; +"RATIONAL_APPROXIMATION",RATIONAL_APPROXIMATION; +"RATIONAL_APPROXIMATION_STRADDLE",RATIONAL_APPROXIMATION_STRADDLE; +"RATIONAL_BETWEEN",RATIONAL_BETWEEN; +"RATIONAL_CLOSED",RATIONAL_CLOSED; +"RATIONAL_DIV",RATIONAL_DIV; +"RATIONAL_INTEGER",RATIONAL_INTEGER; +"RATIONAL_INV",RATIONAL_INV; +"RATIONAL_INV_EQ",RATIONAL_INV_EQ; +"RATIONAL_MUL",RATIONAL_MUL; +"RATIONAL_NEG",RATIONAL_NEG; +"RATIONAL_NEG_EQ",RATIONAL_NEG_EQ; +"RATIONAL_NUM",RATIONAL_NUM; +"RATIONAL_POW",RATIONAL_POW; +"RATIONAL_SUB",RATIONAL_SUB; +"RAT_LEMMA1",RAT_LEMMA1; +"RAT_LEMMA2",RAT_LEMMA2; +"RAT_LEMMA3",RAT_LEMMA3; +"RAT_LEMMA4",RAT_LEMMA4; +"RAT_LEMMA5",RAT_LEMMA5; +"RAY_TO_FRONTIER",RAY_TO_FRONTIER; +"RAY_TO_RELATIVE_FRONTIER",RAY_TO_RELATIVE_FRONTIER; +"RE",RE; +"REAL",REAL; +"REALLIM",REALLIM; +"REALLIM_1_OVER_LOG",REALLIM_1_OVER_LOG; +"REALLIM_1_OVER_N",REALLIM_1_OVER_N; +"REALLIM_1_OVER_POW",REALLIM_1_OVER_POW; +"REALLIM_ABS",REALLIM_ABS; +"REALLIM_ADD",REALLIM_ADD; +"REALLIM_AT",REALLIM_AT; +"REALLIM_ATREAL",REALLIM_ATREAL; +"REALLIM_ATREAL_AT",REALLIM_ATREAL_AT; +"REALLIM_ATREAL_ID",REALLIM_ATREAL_ID; +"REALLIM_ATREAL_WITHINREAL",REALLIM_ATREAL_WITHINREAL; +"REALLIM_AT_INFINITY",REALLIM_AT_INFINITY; +"REALLIM_AT_INFINITY_COMPLEX_0",REALLIM_AT_INFINITY_COMPLEX_0; +"REALLIM_AT_NEGINFINITY",REALLIM_AT_NEGINFINITY; +"REALLIM_AT_POSINFINITY",REALLIM_AT_POSINFINITY; +"REALLIM_COMPLEX",REALLIM_COMPLEX; +"REALLIM_COMPOSE_AT",REALLIM_COMPOSE_AT; +"REALLIM_COMPOSE_WITHIN",REALLIM_COMPOSE_WITHIN; +"REALLIM_CONG_AT",REALLIM_CONG_AT; +"REALLIM_CONG_ATREAL",REALLIM_CONG_ATREAL; +"REALLIM_CONG_WITHIN",REALLIM_CONG_WITHIN; +"REALLIM_CONG_WITHINREAL",REALLIM_CONG_WITHINREAL; +"REALLIM_CONST",REALLIM_CONST; +"REALLIM_CONST_EQ",REALLIM_CONST_EQ; +"REALLIM_CONTINUOUS_FUNCTION",REALLIM_CONTINUOUS_FUNCTION; +"REALLIM_DIV",REALLIM_DIV; +"REALLIM_EVENTUALLY",REALLIM_EVENTUALLY; +"REALLIM_IM",REALLIM_IM; +"REALLIM_INV",REALLIM_INV; +"REALLIM_LBOUND",REALLIM_LBOUND; +"REALLIM_LE",REALLIM_LE; +"REALLIM_LMUL",REALLIM_LMUL; +"REALLIM_LMUL_EQ",REALLIM_LMUL_EQ; +"REALLIM_LOG_OVER_N",REALLIM_LOG_OVER_N; +"REALLIM_MAX",REALLIM_MAX; +"REALLIM_MIN",REALLIM_MIN; +"REALLIM_MUL",REALLIM_MUL; +"REALLIM_NEG",REALLIM_NEG; +"REALLIM_NEG_EQ",REALLIM_NEG_EQ; +"REALLIM_NULL",REALLIM_NULL; +"REALLIM_NULL_ABS",REALLIM_NULL_ABS; +"REALLIM_NULL_ADD",REALLIM_NULL_ADD; +"REALLIM_NULL_COMPARISON",REALLIM_NULL_COMPARISON; +"REALLIM_NULL_LMUL",REALLIM_NULL_LMUL; +"REALLIM_NULL_LMUL_EQ",REALLIM_NULL_LMUL_EQ; +"REALLIM_NULL_NEG",REALLIM_NULL_NEG; +"REALLIM_NULL_POW",REALLIM_NULL_POW; +"REALLIM_NULL_POW_EQ",REALLIM_NULL_POW_EQ; +"REALLIM_NULL_RMUL",REALLIM_NULL_RMUL; +"REALLIM_NULL_RMUL_EQ",REALLIM_NULL_RMUL_EQ; +"REALLIM_POSINFINITY_SEQUENTIALLY",REALLIM_POSINFINITY_SEQUENTIALLY; +"REALLIM_POW",REALLIM_POW; +"REALLIM_POWN",REALLIM_POWN; +"REALLIM_RE",REALLIM_RE; +"REALLIM_REAL_CONTINUOUS_FUNCTION",REALLIM_REAL_CONTINUOUS_FUNCTION; +"REALLIM_RMUL",REALLIM_RMUL; +"REALLIM_RMUL_EQ",REALLIM_RMUL_EQ; +"REALLIM_RPOW",REALLIM_RPOW; +"REALLIM_SEQUENTIALLY",REALLIM_SEQUENTIALLY; +"REALLIM_SUB",REALLIM_SUB; +"REALLIM_SUM",REALLIM_SUM; +"REALLIM_TRANSFORM",REALLIM_TRANSFORM; +"REALLIM_TRANSFORM_BOUND",REALLIM_TRANSFORM_BOUND; +"REALLIM_TRANSFORM_EQ",REALLIM_TRANSFORM_EQ; +"REALLIM_TRANSFORM_EVENTUALLY",REALLIM_TRANSFORM_EVENTUALLY; +"REALLIM_TRANSFORM_STRADDLE",REALLIM_TRANSFORM_STRADDLE; +"REALLIM_TRANSFORM_WITHINREAL_SET",REALLIM_TRANSFORM_WITHINREAL_SET; +"REALLIM_TRANSFORM_WITHIN_SET",REALLIM_TRANSFORM_WITHIN_SET; +"REALLIM_UBOUND",REALLIM_UBOUND; +"REALLIM_UNIQUE",REALLIM_UNIQUE; +"REALLIM_WITHIN",REALLIM_WITHIN; +"REALLIM_WITHINREAL",REALLIM_WITHINREAL; +"REALLIM_WITHINREAL_ID",REALLIM_WITHINREAL_ID; +"REALLIM_WITHINREAL_LE",REALLIM_WITHINREAL_LE; +"REALLIM_WITHINREAL_SUBSET",REALLIM_WITHINREAL_SUBSET; +"REALLIM_WITHINREAL_WITHIN",REALLIM_WITHINREAL_WITHIN; +"REALLIM_WITHIN_LE",REALLIM_WITHIN_LE; +"REALLIM_WITHIN_OPEN",REALLIM_WITHIN_OPEN; +"REALLIM_WITHIN_REAL_OPEN",REALLIM_WITHIN_REAL_OPEN; +"REALLIM_WITHIN_SUBSET",REALLIM_WITHIN_SUBSET; +"REALLIM_X_TIMES_LOG",REALLIM_X_TIMES_LOG; +"REALLIM_ZERO_NEGINFINITY",REALLIM_ZERO_NEGINFINITY; +"REALLIM_ZERO_POSINFINITY",REALLIM_ZERO_POSINFINITY; +"REAL_ABEL_LEMMA",REAL_ABEL_LEMMA; +"REAL_ABEL_LIMIT_THEOREM",REAL_ABEL_LIMIT_THEOREM; +"REAL_ABS_0",REAL_ABS_0; +"REAL_ABS_1",REAL_ABS_1; +"REAL_ABS_ABS",REAL_ABS_ABS; +"REAL_ABS_BETWEEN",REAL_ABS_BETWEEN; +"REAL_ABS_BETWEEN1",REAL_ABS_BETWEEN1; +"REAL_ABS_BETWEEN2",REAL_ABS_BETWEEN2; +"REAL_ABS_BOUND",REAL_ABS_BOUND; +"REAL_ABS_BOUNDS",REAL_ABS_BOUNDS; +"REAL_ABS_CASES",REAL_ABS_CASES; +"REAL_ABS_CIRCLE",REAL_ABS_CIRCLE; +"REAL_ABS_DIV",REAL_ABS_DIV; +"REAL_ABS_EXP",REAL_ABS_EXP; +"REAL_ABS_INFNORM",REAL_ABS_INFNORM; +"REAL_ABS_INF_LE",REAL_ABS_INF_LE; +"REAL_ABS_INTEGER_LEMMA",REAL_ABS_INTEGER_LEMMA; +"REAL_ABS_INV",REAL_ABS_INV; +"REAL_ABS_LE",REAL_ABS_LE; +"REAL_ABS_MUL",REAL_ABS_MUL; +"REAL_ABS_NEG",REAL_ABS_NEG; +"REAL_ABS_NORM",REAL_ABS_NORM; +"REAL_ABS_NUM",REAL_ABS_NUM; +"REAL_ABS_NZ",REAL_ABS_NZ; +"REAL_ABS_PI",REAL_ABS_PI; +"REAL_ABS_POS",REAL_ABS_POS; +"REAL_ABS_POW",REAL_ABS_POW; +"REAL_ABS_REFL",REAL_ABS_REFL; +"REAL_ABS_RPOW",REAL_ABS_RPOW; +"REAL_ABS_SGN",REAL_ABS_SGN; +"REAL_ABS_SIGN",REAL_ABS_SIGN; +"REAL_ABS_SIGN2",REAL_ABS_SIGN2; +"REAL_ABS_STILLNZ",REAL_ABS_STILLNZ; +"REAL_ABS_SUB",REAL_ABS_SUB; +"REAL_ABS_SUB_ABS",REAL_ABS_SUB_ABS; +"REAL_ABS_SUB_INFNORM",REAL_ABS_SUB_INFNORM; +"REAL_ABS_SUB_NORM",REAL_ABS_SUB_NORM; +"REAL_ABS_SUP_LE",REAL_ABS_SUP_LE; +"REAL_ABS_TRIANGLE",REAL_ABS_TRIANGLE; +"REAL_ABS_TRIANGLE_LE",REAL_ABS_TRIANGLE_LE; +"REAL_ABS_TRIANGLE_LT",REAL_ABS_TRIANGLE_LT; +"REAL_ABS_ZERO",REAL_ABS_ZERO; +"REAL_ACS",REAL_ACS; +"REAL_ADD",REAL_ADD; +"REAL_ADD2_SUB2",REAL_ADD2_SUB2; +"REAL_ADD_AC",REAL_ADD_AC; +"REAL_ADD_ARG",REAL_ADD_ARG; +"REAL_ADD_ASSOC",REAL_ADD_ASSOC; +"REAL_ADD_COS",REAL_ADD_COS; +"REAL_ADD_LDISTRIB",REAL_ADD_LDISTRIB; +"REAL_ADD_LID",REAL_ADD_LID; +"REAL_ADD_LINV",REAL_ADD_LINV; +"REAL_ADD_RDISTRIB",REAL_ADD_RDISTRIB; +"REAL_ADD_RID",REAL_ADD_RID; +"REAL_ADD_RINV",REAL_ADD_RINV; +"REAL_ADD_SIN",REAL_ADD_SIN; +"REAL_ADD_SUB",REAL_ADD_SUB; +"REAL_ADD_SUB2",REAL_ADD_SUB2; +"REAL_ADD_SYM",REAL_ADD_SYM; +"REAL_ADD_TAN",REAL_ADD_TAN; +"REAL_AFFINITY_EQ",REAL_AFFINITY_EQ; +"REAL_AFFINITY_LE",REAL_AFFINITY_LE; +"REAL_AFFINITY_LT",REAL_AFFINITY_LT; +"REAL_ANTIDERIVATIVE_CONTINUOUS",REAL_ANTIDERIVATIVE_CONTINUOUS; +"REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS; +"REAL_ARCH",REAL_ARCH; +"REAL_ARCH_INV",REAL_ARCH_INV; +"REAL_ARCH_LT",REAL_ARCH_LT; +"REAL_ARCH_POW",REAL_ARCH_POW; +"REAL_ARCH_POW2",REAL_ARCH_POW2; +"REAL_ARCH_POW_INV",REAL_ARCH_POW_INV; +"REAL_ARCH_RDIV_EQ_0",REAL_ARCH_RDIV_EQ_0; +"REAL_ARCH_SIMPLE",REAL_ARCH_SIMPLE; +"REAL_ASN",REAL_ASN; +"REAL_BEPPO_LEVI_DECREASING",REAL_BEPPO_LEVI_DECREASING; +"REAL_BEPPO_LEVI_INCREASING",REAL_BEPPO_LEVI_INCREASING; +"REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING; +"REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING; +"REAL_BINOMIAL_THEOREM",REAL_BINOMIAL_THEOREM; +"REAL_BOUNDED",REAL_BOUNDED; +"REAL_BOUNDED_POS",REAL_BOUNDED_POS; +"REAL_BOUNDED_POS_LT",REAL_BOUNDED_POS_LT; +"REAL_BOUNDED_REAL_INTERVAL",REAL_BOUNDED_REAL_INTERVAL; +"REAL_BOUNDED_SUBSET",REAL_BOUNDED_SUBSET; +"REAL_BOUNDED_UNION",REAL_BOUNDED_UNION; +"REAL_BOUNDS_LE",REAL_BOUNDS_LE; +"REAL_BOUNDS_LT",REAL_BOUNDS_LT; +"REAL_CARD_INTSEG_INT",REAL_CARD_INTSEG_INT; +"REAL_CLOSED",REAL_CLOSED; +"REAL_CLOSED_DIFF",REAL_CLOSED_DIFF; +"REAL_CLOSED_EMPTY",REAL_CLOSED_EMPTY; +"REAL_CLOSED_HALFSPACE_GE",REAL_CLOSED_HALFSPACE_GE; +"REAL_CLOSED_HALFSPACE_LE",REAL_CLOSED_HALFSPACE_LE; +"REAL_CLOSED_IN",REAL_CLOSED_IN; +"REAL_CLOSED_INTER",REAL_CLOSED_INTER; +"REAL_CLOSED_INTERS",REAL_CLOSED_INTERS; +"REAL_CLOSED_OPEN_INTERVAL",REAL_CLOSED_OPEN_INTERVAL; +"REAL_CLOSED_REAL_INTERVAL",REAL_CLOSED_REAL_INTERVAL; +"REAL_CLOSED_UNION",REAL_CLOSED_UNION; +"REAL_CLOSED_UNIONS",REAL_CLOSED_UNIONS; +"REAL_CLOSED_UNIV",REAL_CLOSED_UNIV; +"REAL_CNJ",REAL_CNJ; +"REAL_COMPACT_ATTAINS_INF",REAL_COMPACT_ATTAINS_INF; +"REAL_COMPACT_ATTAINS_SUP",REAL_COMPACT_ATTAINS_SUP; +"REAL_COMPACT_CONTINUOUS_IMAGE",REAL_COMPACT_CONTINUOUS_IMAGE; +"REAL_COMPACT_EQ_BOUNDED_CLOSED",REAL_COMPACT_EQ_BOUNDED_CLOSED; +"REAL_COMPACT_IMP_BOUNDED",REAL_COMPACT_IMP_BOUNDED; +"REAL_COMPACT_IMP_CLOSED",REAL_COMPACT_IMP_CLOSED; +"REAL_COMPACT_INTERVAL",REAL_COMPACT_INTERVAL; +"REAL_COMPACT_UNIFORMLY_CONTINUOUS",REAL_COMPACT_UNIFORMLY_CONTINUOUS; +"REAL_COMPACT_UNION",REAL_COMPACT_UNION; +"REAL_COMPLETE",REAL_COMPLETE; +"REAL_COMPLETE_SOMEPOS",REAL_COMPLETE_SOMEPOS; +"REAL_COMPLEX_CONTINUOUS_ATREAL",REAL_COMPLEX_CONTINUOUS_ATREAL; +"REAL_COMPLEX_CONTINUOUS_WITHINREAL",REAL_COMPLEX_CONTINUOUS_WITHINREAL; +"REAL_COMPLEX_INTEGRAL",REAL_COMPLEX_INTEGRAL; +"REAL_COMPLEX_MEASURABLE_ON",REAL_COMPLEX_MEASURABLE_ON; +"REAL_CONTINUOUS_ABS",REAL_CONTINUOUS_ABS; +"REAL_CONTINUOUS_ADD",REAL_CONTINUOUS_ADD; +"REAL_CONTINUOUS_ADDITIVE_EXTEND",REAL_CONTINUOUS_ADDITIVE_EXTEND; +"REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR",REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR; +"REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL",REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL; +"REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"REAL_CONTINUOUS_AT",REAL_CONTINUOUS_AT; +"REAL_CONTINUOUS_ATREAL",REAL_CONTINUOUS_ATREAL; +"REAL_CONTINUOUS_ATREAL_COMPOSE",REAL_CONTINUOUS_ATREAL_COMPOSE; +"REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE",REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE; +"REAL_CONTINUOUS_ATREAL_WITHINREAL",REAL_CONTINUOUS_ATREAL_WITHINREAL; +"REAL_CONTINUOUS_ATTAINS_INF",REAL_CONTINUOUS_ATTAINS_INF; +"REAL_CONTINUOUS_ATTAINS_SUP",REAL_CONTINUOUS_ATTAINS_SUP; +"REAL_CONTINUOUS_AT_ACS",REAL_CONTINUOUS_AT_ACS; +"REAL_CONTINUOUS_AT_ARG",REAL_CONTINUOUS_AT_ARG; +"REAL_CONTINUOUS_AT_ASN",REAL_CONTINUOUS_AT_ASN; +"REAL_CONTINUOUS_AT_ATN",REAL_CONTINUOUS_AT_ATN; +"REAL_CONTINUOUS_AT_COMPONENT",REAL_CONTINUOUS_AT_COMPONENT; +"REAL_CONTINUOUS_AT_COMPOSE",REAL_CONTINUOUS_AT_COMPOSE; +"REAL_CONTINUOUS_AT_COS",REAL_CONTINUOUS_AT_COS; +"REAL_CONTINUOUS_AT_EXP",REAL_CONTINUOUS_AT_EXP; +"REAL_CONTINUOUS_AT_ID",REAL_CONTINUOUS_AT_ID; +"REAL_CONTINUOUS_AT_LINEAR_IMAGE",REAL_CONTINUOUS_AT_LINEAR_IMAGE; +"REAL_CONTINUOUS_AT_LOG",REAL_CONTINUOUS_AT_LOG; +"REAL_CONTINUOUS_AT_RPOW",REAL_CONTINUOUS_AT_RPOW; +"REAL_CONTINUOUS_AT_SIN",REAL_CONTINUOUS_AT_SIN; +"REAL_CONTINUOUS_AT_SQRT",REAL_CONTINUOUS_AT_SQRT; +"REAL_CONTINUOUS_AT_SQRT_COMPOSE",REAL_CONTINUOUS_AT_SQRT_COMPOSE; +"REAL_CONTINUOUS_AT_TAN",REAL_CONTINUOUS_AT_TAN; +"REAL_CONTINUOUS_AT_TRANSLATION",REAL_CONTINUOUS_AT_TRANSLATION; +"REAL_CONTINUOUS_AT_WITHIN",REAL_CONTINUOUS_AT_WITHIN; +"REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT",REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; +"REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN",REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN; +"REAL_CONTINUOUS_CONST",REAL_CONTINUOUS_CONST; +"REAL_CONTINUOUS_CONTINUOUS",REAL_CONTINUOUS_CONTINUOUS; +"REAL_CONTINUOUS_CONTINUOUS1",REAL_CONTINUOUS_CONTINUOUS1; +"REAL_CONTINUOUS_CONTINUOUS_ATREAL",REAL_CONTINUOUS_CONTINUOUS_ATREAL; +"REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE; +"REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE; +"REAL_CONTINUOUS_CONTINUOUS_WITHINREAL",REAL_CONTINUOUS_CONTINUOUS_WITHINREAL; +"REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE; +"REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE",REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE; +"REAL_CONTINUOUS_DIST_AT",REAL_CONTINUOUS_DIST_AT; +"REAL_CONTINUOUS_DIST_WITHIN",REAL_CONTINUOUS_DIST_WITHIN; +"REAL_CONTINUOUS_DIV",REAL_CONTINUOUS_DIV; +"REAL_CONTINUOUS_DIV_AT",REAL_CONTINUOUS_DIV_AT; +"REAL_CONTINUOUS_DIV_ATREAL",REAL_CONTINUOUS_DIV_ATREAL; +"REAL_CONTINUOUS_DIV_WITHIN",REAL_CONTINUOUS_DIV_WITHIN; +"REAL_CONTINUOUS_DIV_WITHINREAL",REAL_CONTINUOUS_DIV_WITHINREAL; +"REAL_CONTINUOUS_FLOOR",REAL_CONTINUOUS_FLOOR; +"REAL_CONTINUOUS_FRAC",REAL_CONTINUOUS_FRAC; +"REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET",REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; +"REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC",REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC; +"REAL_CONTINUOUS_INV",REAL_CONTINUOUS_INV; +"REAL_CONTINUOUS_INV_AT",REAL_CONTINUOUS_INV_AT; +"REAL_CONTINUOUS_INV_ATREAL",REAL_CONTINUOUS_INV_ATREAL; +"REAL_CONTINUOUS_INV_WITHIN",REAL_CONTINUOUS_INV_WITHIN; +"REAL_CONTINUOUS_INV_WITHINREAL",REAL_CONTINUOUS_INV_WITHINREAL; +"REAL_CONTINUOUS_LMUL",REAL_CONTINUOUS_LMUL; +"REAL_CONTINUOUS_MAX",REAL_CONTINUOUS_MAX; +"REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE",REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE; +"REAL_CONTINUOUS_MIDPOINT_CONVEX",REAL_CONTINUOUS_MIDPOINT_CONVEX; +"REAL_CONTINUOUS_MIN",REAL_CONTINUOUS_MIN; +"REAL_CONTINUOUS_MUL",REAL_CONTINUOUS_MUL; +"REAL_CONTINUOUS_NEG",REAL_CONTINUOUS_NEG; +"REAL_CONTINUOUS_NORM_AT",REAL_CONTINUOUS_NORM_AT; +"REAL_CONTINUOUS_NORM_WITHIN",REAL_CONTINUOUS_NORM_WITHIN; +"REAL_CONTINUOUS_ON",REAL_CONTINUOUS_ON; +"REAL_CONTINUOUS_ON_ABS",REAL_CONTINUOUS_ON_ABS; +"REAL_CONTINUOUS_ON_ACS",REAL_CONTINUOUS_ON_ACS; +"REAL_CONTINUOUS_ON_ADD",REAL_CONTINUOUS_ON_ADD; +"REAL_CONTINUOUS_ON_ASN",REAL_CONTINUOUS_ON_ASN; +"REAL_CONTINUOUS_ON_ATN",REAL_CONTINUOUS_ON_ATN; +"REAL_CONTINUOUS_ON_BERNOULLI",REAL_CONTINUOUS_ON_BERNOULLI; +"REAL_CONTINUOUS_ON_CASES",REAL_CONTINUOUS_ON_CASES; +"REAL_CONTINUOUS_ON_CASES_OPEN",REAL_CONTINUOUS_ON_CASES_OPEN; +"REAL_CONTINUOUS_ON_COMPOSE",REAL_CONTINUOUS_ON_COMPOSE; +"REAL_CONTINUOUS_ON_COMPOSE_FRAC",REAL_CONTINUOUS_ON_COMPOSE_FRAC; +"REAL_CONTINUOUS_ON_CONST",REAL_CONTINUOUS_ON_CONST; +"REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS",REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS; +"REAL_CONTINUOUS_ON_COS",REAL_CONTINUOUS_ON_COS; +"REAL_CONTINUOUS_ON_DIV",REAL_CONTINUOUS_ON_DIV; +"REAL_CONTINUOUS_ON_EQ",REAL_CONTINUOUS_ON_EQ; +"REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN",REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; +"REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT",REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; +"REAL_CONTINUOUS_ON_EXP",REAL_CONTINUOUS_ON_EXP; +"REAL_CONTINUOUS_ON_ID",REAL_CONTINUOUS_ON_ID; +"REAL_CONTINUOUS_ON_INV",REAL_CONTINUOUS_ON_INV; +"REAL_CONTINUOUS_ON_INVERSE",REAL_CONTINUOUS_ON_INVERSE; +"REAL_CONTINUOUS_ON_INVERSE_ALT",REAL_CONTINUOUS_ON_INVERSE_ALT; +"REAL_CONTINUOUS_ON_LMUL",REAL_CONTINUOUS_ON_LMUL; +"REAL_CONTINUOUS_ON_LOG",REAL_CONTINUOUS_ON_LOG; +"REAL_CONTINUOUS_ON_MUL",REAL_CONTINUOUS_ON_MUL; +"REAL_CONTINUOUS_ON_NEG",REAL_CONTINUOUS_ON_NEG; +"REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION",REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION; +"REAL_CONTINUOUS_ON_POW",REAL_CONTINUOUS_ON_POW; +"REAL_CONTINUOUS_ON_RMUL",REAL_CONTINUOUS_ON_RMUL; +"REAL_CONTINUOUS_ON_RPOW",REAL_CONTINUOUS_ON_RPOW; +"REAL_CONTINUOUS_ON_SIN",REAL_CONTINUOUS_ON_SIN; +"REAL_CONTINUOUS_ON_SQRT",REAL_CONTINUOUS_ON_SQRT; +"REAL_CONTINUOUS_ON_SUB",REAL_CONTINUOUS_ON_SUB; +"REAL_CONTINUOUS_ON_SUBSET",REAL_CONTINUOUS_ON_SUBSET; +"REAL_CONTINUOUS_ON_SUM",REAL_CONTINUOUS_ON_SUM; +"REAL_CONTINUOUS_ON_TAN",REAL_CONTINUOUS_ON_TAN; +"REAL_CONTINUOUS_ON_UNION",REAL_CONTINUOUS_ON_UNION; +"REAL_CONTINUOUS_ON_UNION_OPEN",REAL_CONTINUOUS_ON_UNION_OPEN; +"REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_ATREAL",REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_ATREAL; +"REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN",REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN; +"REAL_CONTINUOUS_POW",REAL_CONTINUOUS_POW; +"REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL",REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL; +"REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL",REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL; +"REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION",REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION; +"REAL_CONTINUOUS_RMUL",REAL_CONTINUOUS_RMUL; +"REAL_CONTINUOUS_SUB",REAL_CONTINUOUS_SUB; +"REAL_CONTINUOUS_TRIVIAL_LIMIT",REAL_CONTINUOUS_TRIVIAL_LIMIT; +"REAL_CONTINUOUS_WITHIN",REAL_CONTINUOUS_WITHIN; +"REAL_CONTINUOUS_WITHINREAL",REAL_CONTINUOUS_WITHINREAL; +"REAL_CONTINUOUS_WITHINREAL_COMPOSE",REAL_CONTINUOUS_WITHINREAL_COMPOSE; +"REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE",REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE; +"REAL_CONTINUOUS_WITHINREAL_SUBSET",REAL_CONTINUOUS_WITHINREAL_SUBSET; +"REAL_CONTINUOUS_WITHIN_ACS",REAL_CONTINUOUS_WITHIN_ACS; +"REAL_CONTINUOUS_WITHIN_ACS_STRONG",REAL_CONTINUOUS_WITHIN_ACS_STRONG; +"REAL_CONTINUOUS_WITHIN_ASN",REAL_CONTINUOUS_WITHIN_ASN; +"REAL_CONTINUOUS_WITHIN_ASN_STRONG",REAL_CONTINUOUS_WITHIN_ASN_STRONG; +"REAL_CONTINUOUS_WITHIN_ATN",REAL_CONTINUOUS_WITHIN_ATN; +"REAL_CONTINUOUS_WITHIN_COMPOSE",REAL_CONTINUOUS_WITHIN_COMPOSE; +"REAL_CONTINUOUS_WITHIN_COS",REAL_CONTINUOUS_WITHIN_COS; +"REAL_CONTINUOUS_WITHIN_EXP",REAL_CONTINUOUS_WITHIN_EXP; +"REAL_CONTINUOUS_WITHIN_ID",REAL_CONTINUOUS_WITHIN_ID; +"REAL_CONTINUOUS_WITHIN_LOG",REAL_CONTINUOUS_WITHIN_LOG; +"REAL_CONTINUOUS_WITHIN_RPOW",REAL_CONTINUOUS_WITHIN_RPOW; +"REAL_CONTINUOUS_WITHIN_SIN",REAL_CONTINUOUS_WITHIN_SIN; +"REAL_CONTINUOUS_WITHIN_SQRT",REAL_CONTINUOUS_WITHIN_SQRT; +"REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE",REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE; +"REAL_CONTINUOUS_WITHIN_SQRT_STRONG",REAL_CONTINUOUS_WITHIN_SQRT_STRONG; +"REAL_CONTINUOUS_WITHIN_SUBSET",REAL_CONTINUOUS_WITHIN_SUBSET; +"REAL_CONTINUOUS_WITHIN_TAN",REAL_CONTINUOUS_WITHIN_TAN; +"REAL_CONVERGENT_IMP_BOUNDED",REAL_CONVERGENT_IMP_BOUNDED; +"REAL_CONVEX",REAL_CONVEX; +"REAL_CONVEX_ADD",REAL_CONVEX_ADD; +"REAL_CONVEX_ALT",REAL_CONVEX_ALT; +"REAL_CONVEX_BOUND2_LT",REAL_CONVEX_BOUND2_LT; +"REAL_CONVEX_BOUND_LE",REAL_CONVEX_BOUND_LE; +"REAL_CONVEX_BOUND_LT",REAL_CONVEX_BOUND_LT; +"REAL_CONVEX_COMPOSE",REAL_CONVEX_COMPOSE; +"REAL_CONVEX_CONVEX_COMPOSE",REAL_CONVEX_CONVEX_COMPOSE; +"REAL_CONVEX_DISTANCE",REAL_CONVEX_DISTANCE; +"REAL_CONVEX_LMUL",REAL_CONVEX_LMUL; +"REAL_CONVEX_LOCAL_GLOBAL_MINIMUM",REAL_CONVEX_LOCAL_GLOBAL_MINIMUM; +"REAL_CONVEX_LOWER",REAL_CONVEX_LOWER; +"REAL_CONVEX_ON",REAL_CONVEX_ON; +"REAL_CONVEX_ON_ASYM",REAL_CONVEX_ON_ASYM; +"REAL_CONVEX_ON_CONTINUOUS",REAL_CONVEX_ON_CONTINUOUS; +"REAL_CONVEX_ON_DERIVATIVES",REAL_CONVEX_ON_DERIVATIVES; +"REAL_CONVEX_ON_DERIVATIVES_IMP",REAL_CONVEX_ON_DERIVATIVES_IMP; +"REAL_CONVEX_ON_DERIVATIVE_INCREASING",REAL_CONVEX_ON_DERIVATIVE_INCREASING; +"REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP",REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP; +"REAL_CONVEX_ON_DERIVATIVE_SECANT",REAL_CONVEX_ON_DERIVATIVE_SECANT; +"REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP",REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP; +"REAL_CONVEX_ON_EXP",REAL_CONVEX_ON_EXP; +"REAL_CONVEX_ON_IMP_JENSEN",REAL_CONVEX_ON_IMP_JENSEN; +"REAL_CONVEX_ON_JENSEN",REAL_CONVEX_ON_JENSEN; +"REAL_CONVEX_ON_LEFT_SECANT",REAL_CONVEX_ON_LEFT_SECANT; +"REAL_CONVEX_ON_LEFT_SECANT_MUL",REAL_CONVEX_ON_LEFT_SECANT_MUL; +"REAL_CONVEX_ON_LOG",REAL_CONVEX_ON_LOG; +"REAL_CONVEX_ON_RIGHT_SECANT",REAL_CONVEX_ON_RIGHT_SECANT; +"REAL_CONVEX_ON_RIGHT_SECANT_MUL",REAL_CONVEX_ON_RIGHT_SECANT_MUL; +"REAL_CONVEX_ON_RPOW",REAL_CONVEX_ON_RPOW; +"REAL_CONVEX_ON_SECANT_DERIVATIVE",REAL_CONVEX_ON_SECANT_DERIVATIVE; +"REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP",REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP; +"REAL_CONVEX_ON_SECOND_DERIVATIVE",REAL_CONVEX_ON_SECOND_DERIVATIVE; +"REAL_CONVEX_ON_SUBSET",REAL_CONVEX_ON_SUBSET; +"REAL_CONVEX_RMUL",REAL_CONVEX_RMUL; +"REAL_COS",REAL_COS; +"REAL_CX",REAL_CX; +"REAL_DERIVATIVE_IVT_DECREASING",REAL_DERIVATIVE_IVT_DECREASING; +"REAL_DERIVATIVE_IVT_INCREASING",REAL_DERIVATIVE_IVT_INCREASING; +"REAL_DERIVATIVE_NEG_LEFT_MAXIMUM",REAL_DERIVATIVE_NEG_LEFT_MAXIMUM; +"REAL_DERIVATIVE_NEG_RIGHT_MINIMUM",REAL_DERIVATIVE_NEG_RIGHT_MINIMUM; +"REAL_DERIVATIVE_POS_LEFT_MINIMUM",REAL_DERIVATIVE_POS_LEFT_MINIMUM; +"REAL_DERIVATIVE_POS_RIGHT_MAXIMUM",REAL_DERIVATIVE_POS_RIGHT_MAXIMUM; +"REAL_DERIVATIVE_UNIQUE_ATREAL",REAL_DERIVATIVE_UNIQUE_ATREAL; +"REAL_DERIVATIVE_ZERO_MAXMIN",REAL_DERIVATIVE_ZERO_MAXMIN; +"REAL_DIFFERENTIABLE_ADD",REAL_DIFFERENTIABLE_ADD; +"REAL_DIFFERENTIABLE_AT",REAL_DIFFERENTIABLE_AT; +"REAL_DIFFERENTIABLE_ATREAL_WITHIN",REAL_DIFFERENTIABLE_ATREAL_WITHIN; +"REAL_DIFFERENTIABLE_AT_ACS",REAL_DIFFERENTIABLE_AT_ACS; +"REAL_DIFFERENTIABLE_AT_ASN",REAL_DIFFERENTIABLE_AT_ASN; +"REAL_DIFFERENTIABLE_AT_ATN",REAL_DIFFERENTIABLE_AT_ATN; +"REAL_DIFFERENTIABLE_AT_COS",REAL_DIFFERENTIABLE_AT_COS; +"REAL_DIFFERENTIABLE_AT_EXP",REAL_DIFFERENTIABLE_AT_EXP; +"REAL_DIFFERENTIABLE_AT_LOG",REAL_DIFFERENTIABLE_AT_LOG; +"REAL_DIFFERENTIABLE_AT_RPOW",REAL_DIFFERENTIABLE_AT_RPOW; +"REAL_DIFFERENTIABLE_AT_SIN",REAL_DIFFERENTIABLE_AT_SIN; +"REAL_DIFFERENTIABLE_AT_SQRT",REAL_DIFFERENTIABLE_AT_SQRT; +"REAL_DIFFERENTIABLE_AT_TAN",REAL_DIFFERENTIABLE_AT_TAN; +"REAL_DIFFERENTIABLE_BOUND",REAL_DIFFERENTIABLE_BOUND; +"REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL",REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL; +"REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL",REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL; +"REAL_DIFFERENTIABLE_COMPOSE_ATREAL",REAL_DIFFERENTIABLE_COMPOSE_ATREAL; +"REAL_DIFFERENTIABLE_COMPOSE_WITHIN",REAL_DIFFERENTIABLE_COMPOSE_WITHIN; +"REAL_DIFFERENTIABLE_CONST",REAL_DIFFERENTIABLE_CONST; +"REAL_DIFFERENTIABLE_DIV_ATREAL",REAL_DIFFERENTIABLE_DIV_ATREAL; +"REAL_DIFFERENTIABLE_DIV_WITHIN",REAL_DIFFERENTIABLE_DIV_WITHIN; +"REAL_DIFFERENTIABLE_EQ",REAL_DIFFERENTIABLE_EQ; +"REAL_DIFFERENTIABLE_FRAC",REAL_DIFFERENTIABLE_FRAC; +"REAL_DIFFERENTIABLE_ID",REAL_DIFFERENTIABLE_ID; +"REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL",REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; +"REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL",REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL; +"REAL_DIFFERENTIABLE_INV_ATREAL",REAL_DIFFERENTIABLE_INV_ATREAL; +"REAL_DIFFERENTIABLE_INV_WITHIN",REAL_DIFFERENTIABLE_INV_WITHIN; +"REAL_DIFFERENTIABLE_MUL_ATREAL",REAL_DIFFERENTIABLE_MUL_ATREAL; +"REAL_DIFFERENTIABLE_MUL_WITHIN",REAL_DIFFERENTIABLE_MUL_WITHIN; +"REAL_DIFFERENTIABLE_NEG",REAL_DIFFERENTIABLE_NEG; +"REAL_DIFFERENTIABLE_ON_ADD",REAL_DIFFERENTIABLE_ON_ADD; +"REAL_DIFFERENTIABLE_ON_BERNOULLI",REAL_DIFFERENTIABLE_ON_BERNOULLI; +"REAL_DIFFERENTIABLE_ON_COMPOSE",REAL_DIFFERENTIABLE_ON_COMPOSE; +"REAL_DIFFERENTIABLE_ON_CONST",REAL_DIFFERENTIABLE_ON_CONST; +"REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE",REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; +"REAL_DIFFERENTIABLE_ON_DIV",REAL_DIFFERENTIABLE_ON_DIV; +"REAL_DIFFERENTIABLE_ON_ID",REAL_DIFFERENTIABLE_ON_ID; +"REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL",REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL; +"REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN",REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN; +"REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON",REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; +"REAL_DIFFERENTIABLE_ON_INV",REAL_DIFFERENTIABLE_ON_INV; +"REAL_DIFFERENTIABLE_ON_MUL",REAL_DIFFERENTIABLE_ON_MUL; +"REAL_DIFFERENTIABLE_ON_NEG",REAL_DIFFERENTIABLE_ON_NEG; +"REAL_DIFFERENTIABLE_ON_POLYNOMIAL_FUNCTION",REAL_DIFFERENTIABLE_ON_POLYNOMIAL_FUNCTION; +"REAL_DIFFERENTIABLE_ON_POW",REAL_DIFFERENTIABLE_ON_POW; +"REAL_DIFFERENTIABLE_ON_REAL_OPEN",REAL_DIFFERENTIABLE_ON_REAL_OPEN; +"REAL_DIFFERENTIABLE_ON_SUB",REAL_DIFFERENTIABLE_ON_SUB; +"REAL_DIFFERENTIABLE_ON_SUBSET",REAL_DIFFERENTIABLE_ON_SUBSET; +"REAL_DIFFERENTIABLE_ON_SUM",REAL_DIFFERENTIABLE_ON_SUM; +"REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL",REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL; +"REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN",REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN; +"REAL_DIFFERENTIABLE_POW_ATREAL",REAL_DIFFERENTIABLE_POW_ATREAL; +"REAL_DIFFERENTIABLE_POW_WITHIN",REAL_DIFFERENTIABLE_POW_WITHIN; +"REAL_DIFFERENTIABLE_SUB",REAL_DIFFERENTIABLE_SUB; +"REAL_DIFFERENTIABLE_TRANSFORM",REAL_DIFFERENTIABLE_TRANSFORM; +"REAL_DIFFERENTIABLE_TRANSFORM_ATREAL",REAL_DIFFERENTIABLE_TRANSFORM_ATREAL; +"REAL_DIFFERENTIABLE_TRANSFORM_WITHIN",REAL_DIFFERENTIABLE_TRANSFORM_WITHIN; +"REAL_DIFFERENTIABLE_WITHIN",REAL_DIFFERENTIABLE_WITHIN; +"REAL_DIFFERENTIABLE_WITHIN_ACS",REAL_DIFFERENTIABLE_WITHIN_ACS; +"REAL_DIFFERENTIABLE_WITHIN_ASN",REAL_DIFFERENTIABLE_WITHIN_ASN; +"REAL_DIFFERENTIABLE_WITHIN_ATN",REAL_DIFFERENTIABLE_WITHIN_ATN; +"REAL_DIFFERENTIABLE_WITHIN_COS",REAL_DIFFERENTIABLE_WITHIN_COS; +"REAL_DIFFERENTIABLE_WITHIN_EXP",REAL_DIFFERENTIABLE_WITHIN_EXP; +"REAL_DIFFERENTIABLE_WITHIN_LOG",REAL_DIFFERENTIABLE_WITHIN_LOG; +"REAL_DIFFERENTIABLE_WITHIN_SIN",REAL_DIFFERENTIABLE_WITHIN_SIN; +"REAL_DIFFERENTIABLE_WITHIN_SQRT",REAL_DIFFERENTIABLE_WITHIN_SQRT; +"REAL_DIFFERENTIABLE_WITHIN_SUBSET",REAL_DIFFERENTIABLE_WITHIN_SUBSET; +"REAL_DIFFERENTIABLE_WITHIN_TAN",REAL_DIFFERENTIABLE_WITHIN_TAN; +"REAL_DIFFSQ",REAL_DIFFSQ; +"REAL_DIFF_CHAIN_ATREAL",REAL_DIFF_CHAIN_ATREAL; +"REAL_DIFF_CHAIN_WITHIN",REAL_DIFF_CHAIN_WITHIN; +"REAL_DINI",REAL_DINI; +"REAL_DIV",REAL_DIV; +"REAL_DIV_1",REAL_DIV_1; +"REAL_DIV_EQ_0",REAL_DIV_EQ_0; +"REAL_DIV_LMUL",REAL_DIV_LMUL; +"REAL_DIV_POW2",REAL_DIV_POW2; +"REAL_DIV_POW2_ALT",REAL_DIV_POW2_ALT; +"REAL_DIV_REFL",REAL_DIV_REFL; +"REAL_DIV_RMUL",REAL_DIV_RMUL; +"REAL_DIV_SQRT",REAL_DIV_SQRT; +"REAL_DOMINATED_CONVERGENCE",REAL_DOMINATED_CONVERGENCE; +"REAL_DOWN",REAL_DOWN; +"REAL_DOWN2",REAL_DOWN2; +"REAL_ENTIRE",REAL_ENTIRE; +"REAL_EQ_ADD_LCANCEL",REAL_EQ_ADD_LCANCEL; +"REAL_EQ_ADD_LCANCEL_0",REAL_EQ_ADD_LCANCEL_0; +"REAL_EQ_ADD_RCANCEL",REAL_EQ_ADD_RCANCEL; +"REAL_EQ_ADD_RCANCEL_0",REAL_EQ_ADD_RCANCEL_0; +"REAL_EQ_AFFINITY",REAL_EQ_AFFINITY; +"REAL_EQ_IMP_LE",REAL_EQ_IMP_LE; +"REAL_EQ_INTEGERS",REAL_EQ_INTEGERS; +"REAL_EQ_INTEGERS_IMP",REAL_EQ_INTEGERS_IMP; +"REAL_EQ_INV2",REAL_EQ_INV2; +"REAL_EQ_LCANCEL_IMP",REAL_EQ_LCANCEL_IMP; +"REAL_EQ_LDIV_EQ",REAL_EQ_LDIV_EQ; +"REAL_EQ_MUL_LCANCEL",REAL_EQ_MUL_LCANCEL; +"REAL_EQ_MUL_RCANCEL",REAL_EQ_MUL_RCANCEL; +"REAL_EQ_NEG2",REAL_EQ_NEG2; +"REAL_EQ_RCANCEL_IMP",REAL_EQ_RCANCEL_IMP; +"REAL_EQ_RDIV_EQ",REAL_EQ_RDIV_EQ; +"REAL_EQ_SGN_ABS",REAL_EQ_SGN_ABS; +"REAL_EQ_SQUARE_ABS",REAL_EQ_SQUARE_ABS; +"REAL_EQ_SUB_LADD",REAL_EQ_SUB_LADD; +"REAL_EQ_SUB_RADD",REAL_EQ_SUB_RADD; +"REAL_EULER_MACLAURIN",REAL_EULER_MACLAURIN; +"REAL_EULER_MACLAURIN_ANTIDERIVATIVE",REAL_EULER_MACLAURIN_ANTIDERIVATIVE; +"REAL_EXISTS",REAL_EXISTS; +"REAL_EXP",REAL_EXP; +"REAL_EXP_0",REAL_EXP_0; +"REAL_EXP_ADD",REAL_EXP_ADD; +"REAL_EXP_ADD_MUL",REAL_EXP_ADD_MUL; +"REAL_EXP_BOUND_LEMMA",REAL_EXP_BOUND_LEMMA; +"REAL_EXP_EQ_1",REAL_EXP_EQ_1; +"REAL_EXP_INJ",REAL_EXP_INJ; +"REAL_EXP_LE_X",REAL_EXP_LE_X; +"REAL_EXP_LIMIT_RPOW_LE",REAL_EXP_LIMIT_RPOW_LE; +"REAL_EXP_LIMIT_RPOW_LT",REAL_EXP_LIMIT_RPOW_LT; +"REAL_EXP_LOG",REAL_EXP_LOG; +"REAL_EXP_LT_1",REAL_EXP_LT_1; +"REAL_EXP_MONO_IMP",REAL_EXP_MONO_IMP; +"REAL_EXP_MONO_LE",REAL_EXP_MONO_LE; +"REAL_EXP_MONO_LT",REAL_EXP_MONO_LT; +"REAL_EXP_N",REAL_EXP_N; +"REAL_EXP_NEG",REAL_EXP_NEG; +"REAL_EXP_NEG_MUL",REAL_EXP_NEG_MUL; +"REAL_EXP_NEG_MUL2",REAL_EXP_NEG_MUL2; +"REAL_EXP_NZ",REAL_EXP_NZ; +"REAL_EXP_POS_LE",REAL_EXP_POS_LE; +"REAL_EXP_POS_LT",REAL_EXP_POS_LT; +"REAL_EXP_SUB",REAL_EXP_SUB; +"REAL_EXP_SUM",REAL_EXP_SUM; +"REAL_FLOOR_ADD",REAL_FLOOR_ADD; +"REAL_FLOOR_EQ",REAL_FLOOR_EQ; +"REAL_FLOOR_LE",REAL_FLOOR_LE; +"REAL_FLOOR_LT",REAL_FLOOR_LT; +"REAL_FLOOR_REFL",REAL_FLOOR_REFL; +"REAL_FRAC_ADD",REAL_FRAC_ADD; +"REAL_FRAC_EQ",REAL_FRAC_EQ; +"REAL_FRAC_EQ_0",REAL_FRAC_EQ_0; +"REAL_FRAC_POS_LT",REAL_FRAC_POS_LT; +"REAL_FRAC_ZERO",REAL_FRAC_ZERO; +"REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS; +"REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR; +"REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG; +"REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG; +"REAL_HALF",REAL_HALF; +"REAL_HAUSDIST_LE",REAL_HAUSDIST_LE; +"REAL_HAUSDIST_LE_EQ",REAL_HAUSDIST_LE_EQ; +"REAL_HAUSDIST_LE_SUMS",REAL_HAUSDIST_LE_SUMS; +"REAL_HREAL_LEMMA1",REAL_HREAL_LEMMA1; +"REAL_HREAL_LEMMA2",REAL_HREAL_LEMMA2; +"REAL_IMP_CNJ",REAL_IMP_CNJ; +"REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; +"REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; +"REAL_INFSUM",REAL_INFSUM; +"REAL_INFSUM_0",REAL_INFSUM_0; +"REAL_INFSUM_ADD",REAL_INFSUM_ADD; +"REAL_INFSUM_COMPLEX",REAL_INFSUM_COMPLEX; +"REAL_INFSUM_EQ",REAL_INFSUM_EQ; +"REAL_INFSUM_LMUL",REAL_INFSUM_LMUL; +"REAL_INFSUM_NEG",REAL_INFSUM_NEG; +"REAL_INFSUM_RESTRICT",REAL_INFSUM_RESTRICT; +"REAL_INFSUM_RMUL",REAL_INFSUM_RMUL; +"REAL_INFSUM_SUB",REAL_INFSUM_SUB; +"REAL_INFSUM_UNIQUE",REAL_INFSUM_UNIQUE; +"REAL_INF_ASCLOSE",REAL_INF_ASCLOSE; +"REAL_INF_BOUNDS",REAL_INF_BOUNDS; +"REAL_INF_LE",REAL_INF_LE; +"REAL_INF_LE_FINITE",REAL_INF_LE_FINITE; +"REAL_INF_LT_FINITE",REAL_INF_LT_FINITE; +"REAL_INF_UNIQUE",REAL_INF_UNIQUE; +"REAL_INTEGRABLE_0",REAL_INTEGRABLE_0; +"REAL_INTEGRABLE_ADD",REAL_INTEGRABLE_ADD; +"REAL_INTEGRABLE_AFFINITY",REAL_INTEGRABLE_AFFINITY; +"REAL_INTEGRABLE_BY_PARTS",REAL_INTEGRABLE_BY_PARTS; +"REAL_INTEGRABLE_BY_PARTS_EQ",REAL_INTEGRABLE_BY_PARTS_EQ; +"REAL_INTEGRABLE_COMBINE",REAL_INTEGRABLE_COMBINE; +"REAL_INTEGRABLE_CONST",REAL_INTEGRABLE_CONST; +"REAL_INTEGRABLE_CONTINUOUS",REAL_INTEGRABLE_CONTINUOUS; +"REAL_INTEGRABLE_DECREASING",REAL_INTEGRABLE_DECREASING; +"REAL_INTEGRABLE_DECREASING_PRODUCT",REAL_INTEGRABLE_DECREASING_PRODUCT; +"REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV",REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV; +"REAL_INTEGRABLE_EQ",REAL_INTEGRABLE_EQ; +"REAL_INTEGRABLE_INCREASING",REAL_INTEGRABLE_INCREASING; +"REAL_INTEGRABLE_INCREASING_PRODUCT",REAL_INTEGRABLE_INCREASING_PRODUCT; +"REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV",REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV; +"REAL_INTEGRABLE_INTEGRAL",REAL_INTEGRABLE_INTEGRAL; +"REAL_INTEGRABLE_LINEAR",REAL_INTEGRABLE_LINEAR; +"REAL_INTEGRABLE_LMUL",REAL_INTEGRABLE_LMUL; +"REAL_INTEGRABLE_LMUL_EQ",REAL_INTEGRABLE_LMUL_EQ; +"REAL_INTEGRABLE_NEG",REAL_INTEGRABLE_NEG; +"REAL_INTEGRABLE_ON",REAL_INTEGRABLE_ON; +"REAL_INTEGRABLE_ON_EMPTY",REAL_INTEGRABLE_ON_EMPTY; +"REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS",REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS; +"REAL_INTEGRABLE_ON_NULL",REAL_INTEGRABLE_ON_NULL; +"REAL_INTEGRABLE_ON_OPEN_INTERVAL",REAL_INTEGRABLE_ON_OPEN_INTERVAL; +"REAL_INTEGRABLE_ON_REFL",REAL_INTEGRABLE_ON_REFL; +"REAL_INTEGRABLE_ON_SUBINTERVAL",REAL_INTEGRABLE_ON_SUBINTERVAL; +"REAL_INTEGRABLE_ON_SUPERSET",REAL_INTEGRABLE_ON_SUPERSET; +"REAL_INTEGRABLE_REAL_BOUNDED_VARIATION_PRODUCT",REAL_INTEGRABLE_REAL_BOUNDED_VARIATION_PRODUCT; +"REAL_INTEGRABLE_REFLECT",REAL_INTEGRABLE_REFLECT; +"REAL_INTEGRABLE_REFLECT_GEN",REAL_INTEGRABLE_REFLECT_GEN; +"REAL_INTEGRABLE_RESTRICT_INTER",REAL_INTEGRABLE_RESTRICT_INTER; +"REAL_INTEGRABLE_RESTRICT_UNIV",REAL_INTEGRABLE_RESTRICT_UNIV; +"REAL_INTEGRABLE_RMUL",REAL_INTEGRABLE_RMUL; +"REAL_INTEGRABLE_RMUL_EQ",REAL_INTEGRABLE_RMUL_EQ; +"REAL_INTEGRABLE_SPIKE",REAL_INTEGRABLE_SPIKE; +"REAL_INTEGRABLE_SPIKE_EQ",REAL_INTEGRABLE_SPIKE_EQ; +"REAL_INTEGRABLE_SPIKE_FINITE",REAL_INTEGRABLE_SPIKE_FINITE; +"REAL_INTEGRABLE_SPIKE_INTERIOR",REAL_INTEGRABLE_SPIKE_INTERIOR; +"REAL_INTEGRABLE_SPIKE_SET",REAL_INTEGRABLE_SPIKE_SET; +"REAL_INTEGRABLE_SPIKE_SET_EQ",REAL_INTEGRABLE_SPIKE_SET_EQ; +"REAL_INTEGRABLE_STRADDLE",REAL_INTEGRABLE_STRADDLE; +"REAL_INTEGRABLE_STRETCH",REAL_INTEGRABLE_STRETCH; +"REAL_INTEGRABLE_SUB",REAL_INTEGRABLE_SUB; +"REAL_INTEGRABLE_SUBINTERVAL",REAL_INTEGRABLE_SUBINTERVAL; +"REAL_INTEGRABLE_SUM",REAL_INTEGRABLE_SUM; +"REAL_INTEGRABLE_UNIFORM_LIMIT",REAL_INTEGRABLE_UNIFORM_LIMIT; +"REAL_INTEGRAL",REAL_INTEGRAL; +"REAL_INTEGRAL_0",REAL_INTEGRAL_0; +"REAL_INTEGRAL_ABS_BOUND_INTEGRAL",REAL_INTEGRAL_ABS_BOUND_INTEGRAL; +"REAL_INTEGRAL_ADD",REAL_INTEGRAL_ADD; +"REAL_INTEGRAL_COMBINE",REAL_INTEGRAL_COMBINE; +"REAL_INTEGRAL_CONST",REAL_INTEGRAL_CONST; +"REAL_INTEGRAL_EMPTY",REAL_INTEGRAL_EMPTY; +"REAL_INTEGRAL_EQ",REAL_INTEGRAL_EQ; +"REAL_INTEGRAL_EQ_0",REAL_INTEGRAL_EQ_0; +"REAL_INTEGRAL_EQ_HAS_INTEGRAL",REAL_INTEGRAL_EQ_HAS_INTEGRAL; +"REAL_INTEGRAL_HAS_REAL_DERIVATIVE",REAL_INTEGRAL_HAS_REAL_DERIVATIVE; +"REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE",REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE; +"REAL_INTEGRAL_LBOUND",REAL_INTEGRAL_LBOUND; +"REAL_INTEGRAL_LE",REAL_INTEGRAL_LE; +"REAL_INTEGRAL_LINEAR",REAL_INTEGRAL_LINEAR; +"REAL_INTEGRAL_LMUL",REAL_INTEGRAL_LMUL; +"REAL_INTEGRAL_NEG",REAL_INTEGRAL_NEG; +"REAL_INTEGRAL_NULL",REAL_INTEGRAL_NULL; +"REAL_INTEGRAL_OPEN_INTERVAL",REAL_INTEGRAL_OPEN_INTERVAL; +"REAL_INTEGRAL_POS",REAL_INTEGRAL_POS; +"REAL_INTEGRAL_REAL_MEASURE",REAL_INTEGRAL_REAL_MEASURE; +"REAL_INTEGRAL_REAL_MEASURE_UNIV",REAL_INTEGRAL_REAL_MEASURE_UNIV; +"REAL_INTEGRAL_REFL",REAL_INTEGRAL_REFL; +"REAL_INTEGRAL_REFLECT",REAL_INTEGRAL_REFLECT; +"REAL_INTEGRAL_REFLECT_GEN",REAL_INTEGRAL_REFLECT_GEN; +"REAL_INTEGRAL_RESTRICT",REAL_INTEGRAL_RESTRICT; +"REAL_INTEGRAL_RESTRICT_INTER",REAL_INTEGRAL_RESTRICT_INTER; +"REAL_INTEGRAL_RESTRICT_UNIV",REAL_INTEGRAL_RESTRICT_UNIV; +"REAL_INTEGRAL_RMUL",REAL_INTEGRAL_RMUL; +"REAL_INTEGRAL_SPIKE",REAL_INTEGRAL_SPIKE; +"REAL_INTEGRAL_SPIKE_SET",REAL_INTEGRAL_SPIKE_SET; +"REAL_INTEGRAL_SUB",REAL_INTEGRAL_SUB; +"REAL_INTEGRAL_SUBSET_LE",REAL_INTEGRAL_SUBSET_LE; +"REAL_INTEGRAL_SUBSTITUTION",REAL_INTEGRAL_SUBSTITUTION; +"REAL_INTEGRAL_SUBSTITUTION_SIMPLE",REAL_INTEGRAL_SUBSTITUTION_SIMPLE; +"REAL_INTEGRAL_SUM",REAL_INTEGRAL_SUM; +"REAL_INTEGRAL_UBOUND",REAL_INTEGRAL_UBOUND; +"REAL_INTEGRAL_UNIQUE",REAL_INTEGRAL_UNIQUE; +"REAL_INTEGRATION_BY_PARTS",REAL_INTEGRATION_BY_PARTS; +"REAL_INTEGRATION_BY_PARTS_SIMPLE",REAL_INTEGRATION_BY_PARTS_SIMPLE; +"REAL_INTERVAL_EQ_EMPTY",REAL_INTERVAL_EQ_EMPTY; +"REAL_INTERVAL_INTERVAL",REAL_INTERVAL_INTERVAL; +"REAL_INTERVAL_NE_EMPTY",REAL_INTERVAL_NE_EMPTY; +"REAL_INTERVAL_OPEN_SUBSET_CLOSED",REAL_INTERVAL_OPEN_SUBSET_CLOSED; +"REAL_INTERVAL_SING",REAL_INTERVAL_SING; +"REAL_INTERVAL_TRANSLATION",REAL_INTERVAL_TRANSLATION; +"REAL_INV",REAL_INV; +"REAL_INV_0",REAL_INV_0; +"REAL_INV_1",REAL_INV_1; +"REAL_INV_1_LE",REAL_INV_1_LE; +"REAL_INV_1_LT",REAL_INV_1_LT; +"REAL_INV_DIV",REAL_INV_DIV; +"REAL_INV_EQ",REAL_INV_EQ; +"REAL_INV_EQ_0",REAL_INV_EQ_0; +"REAL_INV_EQ_1",REAL_INV_EQ_1; +"REAL_INV_INV",REAL_INV_INV; +"REAL_INV_LE_1",REAL_INV_LE_1; +"REAL_INV_LT_1",REAL_INV_LT_1; +"REAL_INV_MUL",REAL_INV_MUL; +"REAL_INV_NEG",REAL_INV_NEG; +"REAL_INV_POW",REAL_INV_POW; +"REAL_INV_RPOW",REAL_INV_RPOW; +"REAL_INV_SGN",REAL_INV_SGN; +"REAL_IVT_DECREASING",REAL_IVT_DECREASING; +"REAL_IVT_INCREASING",REAL_IVT_INCREASING; +"REAL_LEBESGUE_MEASURABLE",REAL_LEBESGUE_MEASURABLE; +"REAL_LEBESGUE_MEASURABLE_CLOSED",REAL_LEBESGUE_MEASURABLE_CLOSED; +"REAL_LEBESGUE_MEASURABLE_COMPACT",REAL_LEBESGUE_MEASURABLE_COMPACT; +"REAL_LEBESGUE_MEASURABLE_COMPL",REAL_LEBESGUE_MEASURABLE_COMPL; +"REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS",REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS; +"REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT",REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT; +"REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS",REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; +"REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT",REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; +"REAL_LEBESGUE_MEASURABLE_DIFF",REAL_LEBESGUE_MEASURABLE_DIFF; +"REAL_LEBESGUE_MEASURABLE_EMPTY",REAL_LEBESGUE_MEASURABLE_EMPTY; +"REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE",REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE; +"REAL_LEBESGUE_MEASURABLE_INTER",REAL_LEBESGUE_MEASURABLE_INTER; +"REAL_LEBESGUE_MEASURABLE_INTERS",REAL_LEBESGUE_MEASURABLE_INTERS; +"REAL_LEBESGUE_MEASURABLE_INTERVAL",REAL_LEBESGUE_MEASURABLE_INTERVAL; +"REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS",REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS; +"REAL_LEBESGUE_MEASURABLE_OPEN",REAL_LEBESGUE_MEASURABLE_OPEN; +"REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"REAL_LEBESGUE_MEASURABLE_UNION",REAL_LEBESGUE_MEASURABLE_UNION; +"REAL_LEBESGUE_MEASURABLE_UNIONS",REAL_LEBESGUE_MEASURABLE_UNIONS; +"REAL_LEBESGUE_MEASURABLE_UNIV",REAL_LEBESGUE_MEASURABLE_UNIV; +"REAL_LET_ADD",REAL_LET_ADD; +"REAL_LET_ADD2",REAL_LET_ADD2; +"REAL_LET_ANTISYM",REAL_LET_ANTISYM; +"REAL_LET_BETWEEN",REAL_LET_BETWEEN; +"REAL_LET_TOTAL",REAL_LET_TOTAL; +"REAL_LET_TRANS",REAL_LET_TRANS; +"REAL_LE_01",REAL_LE_01; +"REAL_LE_ABS_SINH",REAL_LE_ABS_SINH; +"REAL_LE_ADD",REAL_LE_ADD; +"REAL_LE_ADD2",REAL_LE_ADD2; +"REAL_LE_ADDL",REAL_LE_ADDL; +"REAL_LE_ADDR",REAL_LE_ADDR; +"REAL_LE_AFFINITY",REAL_LE_AFFINITY; +"REAL_LE_ANTISYM",REAL_LE_ANTISYM; +"REAL_LE_BETWEEN",REAL_LE_BETWEEN; +"REAL_LE_CASES_INTEGERS",REAL_LE_CASES_INTEGERS; +"REAL_LE_DIV",REAL_LE_DIV; +"REAL_LE_DIV2_EQ",REAL_LE_DIV2_EQ; +"REAL_LE_DOUBLE",REAL_LE_DOUBLE; +"REAL_LE_FLOOR",REAL_LE_FLOOR; +"REAL_LE_HAUSDIST",REAL_LE_HAUSDIST; +"REAL_LE_INF",REAL_LE_INF; +"REAL_LE_INF_EQ",REAL_LE_INF_EQ; +"REAL_LE_INF_FINITE",REAL_LE_INF_FINITE; +"REAL_LE_INF_SUBSET",REAL_LE_INF_SUBSET; +"REAL_LE_INTEGERS",REAL_LE_INTEGERS; +"REAL_LE_INV",REAL_LE_INV; +"REAL_LE_INV2",REAL_LE_INV2; +"REAL_LE_INV_EQ",REAL_LE_INV_EQ; +"REAL_LE_LADD",REAL_LE_LADD; +"REAL_LE_LADD_IMP",REAL_LE_LADD_IMP; +"REAL_LE_LCANCEL_IMP",REAL_LE_LCANCEL_IMP; +"REAL_LE_LDIV_EQ",REAL_LE_LDIV_EQ; +"REAL_LE_LINV",REAL_LE_LINV; +"REAL_LE_LMUL",REAL_LE_LMUL; +"REAL_LE_LMUL_EQ",REAL_LE_LMUL_EQ; +"REAL_LE_LNEG",REAL_LE_LNEG; +"REAL_LE_LSQRT",REAL_LE_LSQRT; +"REAL_LE_LT",REAL_LE_LT; +"REAL_LE_MAX",REAL_LE_MAX; +"REAL_LE_MIN",REAL_LE_MIN; +"REAL_LE_MUL",REAL_LE_MUL; +"REAL_LE_MUL2",REAL_LE_MUL2; +"REAL_LE_MUL_EQ",REAL_LE_MUL_EQ; +"REAL_LE_NEG",REAL_LE_NEG; +"REAL_LE_NEG2",REAL_LE_NEG2; +"REAL_LE_NEGL",REAL_LE_NEGL; +"REAL_LE_NEGR",REAL_LE_NEGR; +"REAL_LE_NEGTOTAL",REAL_LE_NEGTOTAL; +"REAL_LE_POW2",REAL_LE_POW2; +"REAL_LE_POW_2",REAL_LE_POW_2; +"REAL_LE_RADD",REAL_LE_RADD; +"REAL_LE_RCANCEL_IMP",REAL_LE_RCANCEL_IMP; +"REAL_LE_RDIV_EQ",REAL_LE_RDIV_EQ; +"REAL_LE_REFL",REAL_LE_REFL; +"REAL_LE_REVERSE_INTEGERS",REAL_LE_REVERSE_INTEGERS; +"REAL_LE_RINV",REAL_LE_RINV; +"REAL_LE_RMUL",REAL_LE_RMUL; +"REAL_LE_RMUL_EQ",REAL_LE_RMUL_EQ; +"REAL_LE_RNEG",REAL_LE_RNEG; +"REAL_LE_ROOT",REAL_LE_ROOT; +"REAL_LE_RSQRT",REAL_LE_RSQRT; +"REAL_LE_SETDIST",REAL_LE_SETDIST; +"REAL_LE_SETDIST_EQ",REAL_LE_SETDIST_EQ; +"REAL_LE_SQUARE",REAL_LE_SQUARE; +"REAL_LE_SQUARE_ABS",REAL_LE_SQUARE_ABS; +"REAL_LE_SUB_LADD",REAL_LE_SUB_LADD; +"REAL_LE_SUB_RADD",REAL_LE_SUB_RADD; +"REAL_LE_SUP",REAL_LE_SUP; +"REAL_LE_SUP_FINITE",REAL_LE_SUP_FINITE; +"REAL_LE_TOTAL",REAL_LE_TOTAL; +"REAL_LE_TRANS",REAL_LE_TRANS; +"REAL_LE_X_SINH",REAL_LE_X_SINH; +"REAL_LIM",REAL_LIM; +"REAL_LIM_SEQUENTIALLY",REAL_LIM_SEQUENTIALLY; +"REAL_LNEG_UNIQ",REAL_LNEG_UNIQ; +"REAL_LOG_CONVEX_ADD",REAL_LOG_CONVEX_ADD; +"REAL_LOG_CONVEX_CONST",REAL_LOG_CONVEX_CONST; +"REAL_LOG_CONVEX_IMP_CONVEX",REAL_LOG_CONVEX_IMP_CONVEX; +"REAL_LOG_CONVEX_IMP_POS",REAL_LOG_CONVEX_IMP_POS; +"REAL_LOG_CONVEX_LIM",REAL_LOG_CONVEX_LIM; +"REAL_LOG_CONVEX_LOG_CONVEX",REAL_LOG_CONVEX_LOG_CONVEX; +"REAL_LOG_CONVEX_MUL",REAL_LOG_CONVEX_MUL; +"REAL_LOG_CONVEX_ON",REAL_LOG_CONVEX_ON; +"REAL_LOG_CONVEX_ON_CONVEX",REAL_LOG_CONVEX_ON_CONVEX; +"REAL_LOG_CONVEX_ON_SUBSET",REAL_LOG_CONVEX_ON_SUBSET; +"REAL_LOG_CONVEX_PRODUCT",REAL_LOG_CONVEX_PRODUCT; +"REAL_LOG_CONVEX_RPOW_RIGHT",REAL_LOG_CONVEX_RPOW_RIGHT; +"REAL_LSQRT_LE",REAL_LSQRT_LE; +"REAL_LTE_ADD",REAL_LTE_ADD; +"REAL_LTE_ADD2",REAL_LTE_ADD2; +"REAL_LTE_ANTISYM",REAL_LTE_ANTISYM; +"REAL_LTE_BETWEEN",REAL_LTE_BETWEEN; +"REAL_LTE_TOTAL",REAL_LTE_TOTAL; +"REAL_LTE_TRANS",REAL_LTE_TRANS; +"REAL_LT_01",REAL_LT_01; +"REAL_LT_ADD",REAL_LT_ADD; +"REAL_LT_ADD1",REAL_LT_ADD1; +"REAL_LT_ADD2",REAL_LT_ADD2; +"REAL_LT_ADDL",REAL_LT_ADDL; +"REAL_LT_ADDNEG",REAL_LT_ADDNEG; +"REAL_LT_ADDNEG2",REAL_LT_ADDNEG2; +"REAL_LT_ADDR",REAL_LT_ADDR; +"REAL_LT_ADD_SUB",REAL_LT_ADD_SUB; +"REAL_LT_AFFINITY",REAL_LT_AFFINITY; +"REAL_LT_ANTISYM",REAL_LT_ANTISYM; +"REAL_LT_BETWEEN",REAL_LT_BETWEEN; +"REAL_LT_DIV",REAL_LT_DIV; +"REAL_LT_DIV2_EQ",REAL_LT_DIV2_EQ; +"REAL_LT_GT",REAL_LT_GT; +"REAL_LT_IMP_LE",REAL_LT_IMP_LE; +"REAL_LT_IMP_NE",REAL_LT_IMP_NE; +"REAL_LT_IMP_NZ",REAL_LT_IMP_NZ; +"REAL_LT_INF_FINITE",REAL_LT_INF_FINITE; +"REAL_LT_INTEGERS",REAL_LT_INTEGERS; +"REAL_LT_INV",REAL_LT_INV; +"REAL_LT_INV2",REAL_LT_INV2; +"REAL_LT_INV_EQ",REAL_LT_INV_EQ; +"REAL_LT_LADD",REAL_LT_LADD; +"REAL_LT_LADD_IMP",REAL_LT_LADD_IMP; +"REAL_LT_LCANCEL_IMP",REAL_LT_LCANCEL_IMP; +"REAL_LT_LDIV_EQ",REAL_LT_LDIV_EQ; +"REAL_LT_LE",REAL_LT_LE; +"REAL_LT_LINV",REAL_LT_LINV; +"REAL_LT_LMUL",REAL_LT_LMUL; +"REAL_LT_LMUL_EQ",REAL_LT_LMUL_EQ; +"REAL_LT_LNEG",REAL_LT_LNEG; +"REAL_LT_LSQRT",REAL_LT_LSQRT; +"REAL_LT_MAX",REAL_LT_MAX; +"REAL_LT_MIN",REAL_LT_MIN; +"REAL_LT_MUL",REAL_LT_MUL; +"REAL_LT_MUL2",REAL_LT_MUL2; +"REAL_LT_MUL_EQ",REAL_LT_MUL_EQ; +"REAL_LT_NEG",REAL_LT_NEG; +"REAL_LT_NEG2",REAL_LT_NEG2; +"REAL_LT_NEGTOTAL",REAL_LT_NEGTOTAL; +"REAL_LT_POW2",REAL_LT_POW2; +"REAL_LT_POW_2",REAL_LT_POW_2; +"REAL_LT_RADD",REAL_LT_RADD; +"REAL_LT_RCANCEL_IMP",REAL_LT_RCANCEL_IMP; +"REAL_LT_RDIV_EQ",REAL_LT_RDIV_EQ; +"REAL_LT_REFL",REAL_LT_REFL; +"REAL_LT_RINV",REAL_LT_RINV; +"REAL_LT_RMUL",REAL_LT_RMUL; +"REAL_LT_RMUL_EQ",REAL_LT_RMUL_EQ; +"REAL_LT_RNEG",REAL_LT_RNEG; +"REAL_LT_RSQRT",REAL_LT_RSQRT; +"REAL_LT_SQUARE",REAL_LT_SQUARE; +"REAL_LT_SQUARE_ABS",REAL_LT_SQUARE_ABS; +"REAL_LT_SUB_LADD",REAL_LT_SUB_LADD; +"REAL_LT_SUB_RADD",REAL_LT_SUB_RADD; +"REAL_LT_SUP_FINITE",REAL_LT_SUP_FINITE; +"REAL_LT_TOTAL",REAL_LT_TOTAL; +"REAL_LT_TRANS",REAL_LT_TRANS; +"REAL_MAX_ACI",REAL_MAX_ACI; +"REAL_MAX_ASSOC",REAL_MAX_ASSOC; +"REAL_MAX_LE",REAL_MAX_LE; +"REAL_MAX_LT",REAL_MAX_LT; +"REAL_MAX_MAX",REAL_MAX_MAX; +"REAL_MAX_MIN",REAL_MAX_MIN; +"REAL_MAX_SUP",REAL_MAX_SUP; +"REAL_MAX_SYM",REAL_MAX_SYM; +"REAL_MEASURABLE",REAL_MEASURABLE; +"REAL_MEASURABLE_ALMOST",REAL_MEASURABLE_ALMOST; +"REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE",REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE; +"REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE",REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; +"REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE",REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE; +"REAL_MEASURABLE_COMPACT",REAL_MEASURABLE_COMPACT; +"REAL_MEASURABLE_COUNTABLE_INTERS",REAL_MEASURABLE_COUNTABLE_INTERS; +"REAL_MEASURABLE_COUNTABLE_UNIONS",REAL_MEASURABLE_COUNTABLE_UNIONS; +"REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED",REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED; +"REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG",REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG; +"REAL_MEASURABLE_DIFF",REAL_MEASURABLE_DIFF; +"REAL_MEASURABLE_EMPTY",REAL_MEASURABLE_EMPTY; +"REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE",REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE; +"REAL_MEASURABLE_INNER_OUTER",REAL_MEASURABLE_INNER_OUTER; +"REAL_MEASURABLE_INTER",REAL_MEASURABLE_INTER; +"REAL_MEASURABLE_MEASURABLE",REAL_MEASURABLE_MEASURABLE; +"REAL_MEASURABLE_NESTED_UNIONS",REAL_MEASURABLE_NESTED_UNIONS; +"REAL_MEASURABLE_ON_0",REAL_MEASURABLE_ON_0; +"REAL_MEASURABLE_ON_ABS",REAL_MEASURABLE_ON_ABS; +"REAL_MEASURABLE_ON_ADD",REAL_MEASURABLE_ON_ADD; +"REAL_MEASURABLE_ON_CASES",REAL_MEASURABLE_ON_CASES; +"REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS; +"REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0; +"REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET; +"REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0; +"REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL",REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL; +"REAL_MEASURABLE_ON_CONST",REAL_MEASURABLE_ON_CONST; +"REAL_MEASURABLE_ON_DECREASING",REAL_MEASURABLE_ON_DECREASING; +"REAL_MEASURABLE_ON_DECREASING_UNIV",REAL_MEASURABLE_ON_DECREASING_UNIV; +"REAL_MEASURABLE_ON_DIV",REAL_MEASURABLE_ON_DIV; +"REAL_MEASURABLE_ON_INCREASING",REAL_MEASURABLE_ON_INCREASING; +"REAL_MEASURABLE_ON_INCREASING_UNIV",REAL_MEASURABLE_ON_INCREASING_UNIV; +"REAL_MEASURABLE_ON_INV",REAL_MEASURABLE_ON_INV; +"REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"REAL_MEASURABLE_ON_LIMIT",REAL_MEASURABLE_ON_LIMIT; +"REAL_MEASURABLE_ON_LMUL",REAL_MEASURABLE_ON_LMUL; +"REAL_MEASURABLE_ON_MAX",REAL_MEASURABLE_ON_MAX; +"REAL_MEASURABLE_ON_MEASURABLE_SUBSET",REAL_MEASURABLE_ON_MEASURABLE_SUBSET; +"REAL_MEASURABLE_ON_MIN",REAL_MEASURABLE_ON_MIN; +"REAL_MEASURABLE_ON_MUL",REAL_MEASURABLE_ON_MUL; +"REAL_MEASURABLE_ON_NEG",REAL_MEASURABLE_ON_NEG; +"REAL_MEASURABLE_ON_NEG_EQ",REAL_MEASURABLE_ON_NEG_EQ; +"REAL_MEASURABLE_ON_PREIMAGE_CLOSED",REAL_MEASURABLE_ON_PREIMAGE_CLOSED; +"REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL",REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; +"REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE; +"REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT; +"REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE; +"REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT",REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT; +"REAL_MEASURABLE_ON_PREIMAGE_OPEN",REAL_MEASURABLE_ON_PREIMAGE_OPEN; +"REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL",REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; +"REAL_MEASURABLE_ON_RESTRICT",REAL_MEASURABLE_ON_RESTRICT; +"REAL_MEASURABLE_ON_RMUL",REAL_MEASURABLE_ON_RMUL; +"REAL_MEASURABLE_ON_RPOW",REAL_MEASURABLE_ON_RPOW; +"REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT",REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT; +"REAL_MEASURABLE_ON_SPIKE_SET",REAL_MEASURABLE_ON_SPIKE_SET; +"REAL_MEASURABLE_ON_SUB",REAL_MEASURABLE_ON_SUB; +"REAL_MEASURABLE_ON_UNIV",REAL_MEASURABLE_ON_UNIV; +"REAL_MEASURABLE_OPEN",REAL_MEASURABLE_OPEN; +"REAL_MEASURABLE_REAL_INTEGRABLE",REAL_MEASURABLE_REAL_INTEGRABLE; +"REAL_MEASURABLE_REAL_INTERVAL",REAL_MEASURABLE_REAL_INTERVAL; +"REAL_MEASURABLE_REAL_MEASURE_EQ_0",REAL_MEASURABLE_REAL_MEASURE_EQ_0; +"REAL_MEASURABLE_REAL_MEASURE_POS_LT",REAL_MEASURABLE_REAL_MEASURE_POS_LT; +"REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF",REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF; +"REAL_MEASURABLE_SCALING",REAL_MEASURABLE_SCALING; +"REAL_MEASURABLE_SCALING_EQ",REAL_MEASURABLE_SCALING_EQ; +"REAL_MEASURABLE_TRANSLATION",REAL_MEASURABLE_TRANSLATION; +"REAL_MEASURABLE_UNION",REAL_MEASURABLE_UNION; +"REAL_MEASURABLE_UNIONS",REAL_MEASURABLE_UNIONS; +"REAL_MEASURE_DIFF_SUBSET",REAL_MEASURE_DIFF_SUBSET; +"REAL_MEASURE_DISJOINT_UNION",REAL_MEASURE_DISJOINT_UNION; +"REAL_MEASURE_DISJOINT_UNIONS",REAL_MEASURE_DISJOINT_UNIONS; +"REAL_MEASURE_DISJOINT_UNIONS_IMAGE",REAL_MEASURE_DISJOINT_UNIONS_IMAGE; +"REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; +"REAL_MEASURE_EMPTY",REAL_MEASURE_EMPTY; +"REAL_MEASURE_EQ_0",REAL_MEASURE_EQ_0; +"REAL_MEASURE_MEASURE",REAL_MEASURE_MEASURE; +"REAL_MEASURE_POS_LE",REAL_MEASURE_POS_LE; +"REAL_MEASURE_REAL_INTEGRAL",REAL_MEASURE_REAL_INTEGRAL; +"REAL_MEASURE_REAL_INTEGRAL_UNIV",REAL_MEASURE_REAL_INTEGRAL_UNIV; +"REAL_MEASURE_REAL_INTERVAL",REAL_MEASURE_REAL_INTERVAL; +"REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF",REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; +"REAL_MEASURE_REAL_NEGLIGIBLE_UNION",REAL_MEASURE_REAL_NEGLIGIBLE_UNION; +"REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS",REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS; +"REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE",REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE; +"REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG",REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG; +"REAL_MEASURE_SCALING",REAL_MEASURE_SCALING; +"REAL_MEASURE_SUBSET",REAL_MEASURE_SUBSET; +"REAL_MEASURE_TRANSLATION",REAL_MEASURE_TRANSLATION; +"REAL_MEASURE_UNION",REAL_MEASURE_UNION; +"REAL_MEASURE_UNIONS_LE",REAL_MEASURE_UNIONS_LE; +"REAL_MEASURE_UNIONS_LE_IMAGE",REAL_MEASURE_UNIONS_LE_IMAGE; +"REAL_MEASURE_UNION_LE",REAL_MEASURE_UNION_LE; +"REAL_MEASURE_UNIQUE",REAL_MEASURE_UNIQUE; +"REAL_MIDPOINT_IN_CONVEX",REAL_MIDPOINT_IN_CONVEX; +"REAL_MIN_ACI",REAL_MIN_ACI; +"REAL_MIN_ASSOC",REAL_MIN_ASSOC; +"REAL_MIN_INF",REAL_MIN_INF; +"REAL_MIN_LE",REAL_MIN_LE; +"REAL_MIN_LT",REAL_MIN_LT; +"REAL_MIN_MAX",REAL_MIN_MAX; +"REAL_MIN_MIN",REAL_MIN_MIN; +"REAL_MIN_SYM",REAL_MIN_SYM; +"REAL_MONOTONE_CONVERGENCE_DECREASING",REAL_MONOTONE_CONVERGENCE_DECREASING; +"REAL_MONOTONE_CONVERGENCE_INCREASING",REAL_MONOTONE_CONVERGENCE_INCREASING; +"REAL_MONOTONE_CONVERGENCE_INCREASING_AE",REAL_MONOTONE_CONVERGENCE_INCREASING_AE; +"REAL_MUL",REAL_MUL; +"REAL_MUL_2",REAL_MUL_2; +"REAL_MUL_AC",REAL_MUL_AC; +"REAL_MUL_ASSOC",REAL_MUL_ASSOC; +"REAL_MUL_CNJ",REAL_MUL_CNJ; +"REAL_MUL_COS_COS",REAL_MUL_COS_COS; +"REAL_MUL_COS_SIN",REAL_MUL_COS_SIN; +"REAL_MUL_CX",REAL_MUL_CX; +"REAL_MUL_LID",REAL_MUL_LID; +"REAL_MUL_LINV",REAL_MUL_LINV; +"REAL_MUL_LINV_UNIQ",REAL_MUL_LINV_UNIQ; +"REAL_MUL_LNEG",REAL_MUL_LNEG; +"REAL_MUL_LZERO",REAL_MUL_LZERO; +"REAL_MUL_POS_LE",REAL_MUL_POS_LE; +"REAL_MUL_POS_LT",REAL_MUL_POS_LT; +"REAL_MUL_RID",REAL_MUL_RID; +"REAL_MUL_RINV",REAL_MUL_RINV; +"REAL_MUL_RINV_UNIQ",REAL_MUL_RINV_UNIQ; +"REAL_MUL_RNEG",REAL_MUL_RNEG; +"REAL_MUL_RZERO",REAL_MUL_RZERO; +"REAL_MUL_SIN_COS",REAL_MUL_SIN_COS; +"REAL_MUL_SIN_SIN",REAL_MUL_SIN_SIN; +"REAL_MUL_SUM",REAL_MUL_SUM; +"REAL_MUL_SUM_NUMSEG",REAL_MUL_SUM_NUMSEG; +"REAL_MUL_SYM",REAL_MUL_SYM; +"REAL_MVT",REAL_MVT; +"REAL_MVT_CAUCHY",REAL_MVT_CAUCHY; +"REAL_MVT_SIMPLE",REAL_MVT_SIMPLE; +"REAL_MVT_VERY_SIMPLE",REAL_MVT_VERY_SIMPLE; +"REAL_NEG",REAL_NEG; +"REAL_NEGLIGIBLE_COUNTABLE",REAL_NEGLIGIBLE_COUNTABLE; +"REAL_NEGLIGIBLE_COUNTABLE_UNIONS",REAL_NEGLIGIBLE_COUNTABLE_UNIONS; +"REAL_NEGLIGIBLE_DIFF",REAL_NEGLIGIBLE_DIFF; +"REAL_NEGLIGIBLE_EMPTY",REAL_NEGLIGIBLE_EMPTY; +"REAL_NEGLIGIBLE_FINITE",REAL_NEGLIGIBLE_FINITE; +"REAL_NEGLIGIBLE_FRONTIER_INTERVAL",REAL_NEGLIGIBLE_FRONTIER_INTERVAL; +"REAL_NEGLIGIBLE_INSERT",REAL_NEGLIGIBLE_INSERT; +"REAL_NEGLIGIBLE_INTER",REAL_NEGLIGIBLE_INTER; +"REAL_NEGLIGIBLE_ON_INTERVALS",REAL_NEGLIGIBLE_ON_INTERVALS; +"REAL_NEGLIGIBLE_OUTER",REAL_NEGLIGIBLE_OUTER; +"REAL_NEGLIGIBLE_OUTER_LE",REAL_NEGLIGIBLE_OUTER_LE; +"REAL_NEGLIGIBLE_REAL_INTERVAL",REAL_NEGLIGIBLE_REAL_INTERVAL; +"REAL_NEGLIGIBLE_SING",REAL_NEGLIGIBLE_SING; +"REAL_NEGLIGIBLE_SUBSET",REAL_NEGLIGIBLE_SUBSET; +"REAL_NEGLIGIBLE_TRANSLATION",REAL_NEGLIGIBLE_TRANSLATION; +"REAL_NEGLIGIBLE_TRANSLATION_EQ",REAL_NEGLIGIBLE_TRANSLATION_EQ; +"REAL_NEGLIGIBLE_TRANSLATION_REV",REAL_NEGLIGIBLE_TRANSLATION_REV; +"REAL_NEGLIGIBLE_UNION",REAL_NEGLIGIBLE_UNION; +"REAL_NEGLIGIBLE_UNIONS",REAL_NEGLIGIBLE_UNIONS; +"REAL_NEGLIGIBLE_UNION_EQ",REAL_NEGLIGIBLE_UNION_EQ; +"REAL_NEGNEG",REAL_NEGNEG; +"REAL_NEG_0",REAL_NEG_0; +"REAL_NEG_ADD",REAL_NEG_ADD; +"REAL_NEG_EQ",REAL_NEG_EQ; +"REAL_NEG_EQ_0",REAL_NEG_EQ_0; +"REAL_NEG_GE0",REAL_NEG_GE0; +"REAL_NEG_GT0",REAL_NEG_GT0; +"REAL_NEG_LE0",REAL_NEG_LE0; +"REAL_NEG_LMUL",REAL_NEG_LMUL; +"REAL_NEG_LT0",REAL_NEG_LT0; +"REAL_NEG_MINUS1",REAL_NEG_MINUS1; +"REAL_NEG_MUL2",REAL_NEG_MUL2; +"REAL_NEG_NEG",REAL_NEG_NEG; +"REAL_NEG_RMUL",REAL_NEG_RMUL; +"REAL_NEG_SUB",REAL_NEG_SUB; +"REAL_NORM",REAL_NORM; +"REAL_NORM_POS",REAL_NORM_POS; +"REAL_NOT_EQ",REAL_NOT_EQ; +"REAL_NOT_LE",REAL_NOT_LE; +"REAL_NOT_LT",REAL_NOT_LT; +"REAL_OF_INT_OF_REAL",REAL_OF_INT_OF_REAL; +"REAL_OF_NUM_ADD",REAL_OF_NUM_ADD; +"REAL_OF_NUM_BINOM",REAL_OF_NUM_BINOM; +"REAL_OF_NUM_EQ",REAL_OF_NUM_EQ; +"REAL_OF_NUM_GE",REAL_OF_NUM_GE; +"REAL_OF_NUM_GT",REAL_OF_NUM_GT; +"REAL_OF_NUM_LE",REAL_OF_NUM_LE; +"REAL_OF_NUM_LT",REAL_OF_NUM_LT; +"REAL_OF_NUM_MAX",REAL_OF_NUM_MAX; +"REAL_OF_NUM_MIN",REAL_OF_NUM_MIN; +"REAL_OF_NUM_MUL",REAL_OF_NUM_MUL; +"REAL_OF_NUM_NPRODUCT",REAL_OF_NUM_NPRODUCT; +"REAL_OF_NUM_POW",REAL_OF_NUM_POW; +"REAL_OF_NUM_SUB",REAL_OF_NUM_SUB; +"REAL_OF_NUM_SUC",REAL_OF_NUM_SUC; +"REAL_OF_NUM_SUM",REAL_OF_NUM_SUM; +"REAL_OF_NUM_SUM_NUMSEG",REAL_OF_NUM_SUM_NUMSEG; +"REAL_OPEN",REAL_OPEN; +"REAL_OPEN_CLOSED_INTERVAL",REAL_OPEN_CLOSED_INTERVAL; +"REAL_OPEN_DIFF",REAL_OPEN_DIFF; +"REAL_OPEN_EMPTY",REAL_OPEN_EMPTY; +"REAL_OPEN_EXISTS_RATIONAL",REAL_OPEN_EXISTS_RATIONAL; +"REAL_OPEN_HALFSPACE_GT",REAL_OPEN_HALFSPACE_GT; +"REAL_OPEN_HALFSPACE_LT",REAL_OPEN_HALFSPACE_LT; +"REAL_OPEN_IN",REAL_OPEN_IN; +"REAL_OPEN_INTER",REAL_OPEN_INTER; +"REAL_OPEN_INTERS",REAL_OPEN_INTERS; +"REAL_OPEN_RATIONAL",REAL_OPEN_RATIONAL; +"REAL_OPEN_REAL_CLOSED",REAL_OPEN_REAL_CLOSED; +"REAL_OPEN_REAL_INTERVAL",REAL_OPEN_REAL_INTERVAL; +"REAL_OPEN_SET_EXISTS_RATIONAL",REAL_OPEN_SET_EXISTS_RATIONAL; +"REAL_OPEN_SET_RATIONAL",REAL_OPEN_SET_RATIONAL; +"REAL_OPEN_SUBREAL_OPEN",REAL_OPEN_SUBREAL_OPEN; +"REAL_OPEN_UNION",REAL_OPEN_UNION; +"REAL_OPEN_UNIONS",REAL_OPEN_UNIONS; +"REAL_OPEN_UNIV",REAL_OPEN_UNIV; +"REAL_PARTIAL_SUMS_LE_INFSUM",REAL_PARTIAL_SUMS_LE_INFSUM; +"REAL_PARTIAL_SUMS_LE_INFSUM_GEN",REAL_PARTIAL_SUMS_LE_INFSUM_GEN; +"REAL_POLYFUN_EQ_0",REAL_POLYFUN_EQ_0; +"REAL_POLYFUN_EQ_CONST",REAL_POLYFUN_EQ_CONST; +"REAL_POLYFUN_FINITE_ROOTS",REAL_POLYFUN_FINITE_ROOTS; +"REAL_POLYFUN_ROOTBOUND",REAL_POLYFUN_ROOTBOUND; +"REAL_POLYNOMIAL_FUNCTION_1",REAL_POLYNOMIAL_FUNCTION_1; +"REAL_POLYNOMIAL_FUNCTION_DROP",REAL_POLYNOMIAL_FUNCTION_DROP; +"REAL_POLY_CLAUSES",REAL_POLY_CLAUSES; +"REAL_POLY_NEG_CLAUSES",REAL_POLY_NEG_CLAUSES; +"REAL_POS",REAL_POS; +"REAL_POS_NZ",REAL_POS_NZ; +"REAL_POW",REAL_POW; +"REAL_POW2_ABS",REAL_POW2_ABS; +"REAL_POWER_SERIES_CONV_IMP_ABSCONV",REAL_POWER_SERIES_CONV_IMP_ABSCONV; +"REAL_POW_1",REAL_POW_1; +"REAL_POW_1_LE",REAL_POW_1_LE; +"REAL_POW_1_LT",REAL_POW_1_LT; +"REAL_POW_2",REAL_POW_2; +"REAL_POW_ADD",REAL_POW_ADD; +"REAL_POW_DIV",REAL_POW_DIV; +"REAL_POW_EQ",REAL_POW_EQ; +"REAL_POW_EQ_0",REAL_POW_EQ_0; +"REAL_POW_EQ_1",REAL_POW_EQ_1; +"REAL_POW_EQ_1_IMP",REAL_POW_EQ_1_IMP; +"REAL_POW_EQ_ABS",REAL_POW_EQ_ABS; +"REAL_POW_EQ_EQ",REAL_POW_EQ_EQ; +"REAL_POW_EQ_ODD",REAL_POW_EQ_ODD; +"REAL_POW_EQ_ODD_EQ",REAL_POW_EQ_ODD_EQ; +"REAL_POW_INV",REAL_POW_INV; +"REAL_POW_LBOUND",REAL_POW_LBOUND; +"REAL_POW_LE",REAL_POW_LE; +"REAL_POW_LE2",REAL_POW_LE2; +"REAL_POW_LE2_ODD",REAL_POW_LE2_ODD; +"REAL_POW_LE2_ODD_EQ",REAL_POW_LE2_ODD_EQ; +"REAL_POW_LE2_REV",REAL_POW_LE2_REV; +"REAL_POW_LE_1",REAL_POW_LE_1; +"REAL_POW_LT",REAL_POW_LT; +"REAL_POW_LT2",REAL_POW_LT2; +"REAL_POW_LT2_ODD",REAL_POW_LT2_ODD; +"REAL_POW_LT2_ODD_EQ",REAL_POW_LT2_ODD_EQ; +"REAL_POW_LT2_REV",REAL_POW_LT2_REV; +"REAL_POW_LT_1",REAL_POW_LT_1; +"REAL_POW_MONO",REAL_POW_MONO; +"REAL_POW_MONO_INV",REAL_POW_MONO_INV; +"REAL_POW_MONO_LT",REAL_POW_MONO_LT; +"REAL_POW_MUL",REAL_POW_MUL; +"REAL_POW_NEG",REAL_POW_NEG; +"REAL_POW_NZ",REAL_POW_NZ; +"REAL_POW_ONE",REAL_POW_ONE; +"REAL_POW_POW",REAL_POW_POW; +"REAL_POW_ROOT",REAL_POW_ROOT; +"REAL_POW_SUB",REAL_POW_SUB; +"REAL_POW_ZERO",REAL_POW_ZERO; +"REAL_RNEG_UNIQ",REAL_RNEG_UNIQ; +"REAL_ROLLE",REAL_ROLLE; +"REAL_ROLLE_SIMPLE",REAL_ROLLE_SIMPLE; +"REAL_ROOT_DIV",REAL_ROOT_DIV; +"REAL_ROOT_INV",REAL_ROOT_INV; +"REAL_ROOT_LE",REAL_ROOT_LE; +"REAL_ROOT_MUL",REAL_ROOT_MUL; +"REAL_ROOT_POW",REAL_ROOT_POW; +"REAL_ROOT_POW_GEN",REAL_ROOT_POW_GEN; +"REAL_ROOT_RPOW",REAL_ROOT_RPOW; +"REAL_RSQRT_LE",REAL_RSQRT_LE; +"REAL_SECOND_MEAN_VALUE_THEOREM",REAL_SECOND_MEAN_VALUE_THEOREM; +"REAL_SECOND_MEAN_VALUE_THEOREM_BONNET",REAL_SECOND_MEAN_VALUE_THEOREM_BONNET; +"REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL; +"REAL_SECOND_MEAN_VALUE_THEOREM_FULL",REAL_SECOND_MEAN_VALUE_THEOREM_FULL; +"REAL_SECOND_MEAN_VALUE_THEOREM_GEN",REAL_SECOND_MEAN_VALUE_THEOREM_GEN; +"REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL",REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL; +"REAL_SEGMENT",REAL_SEGMENT; +"REAL_SEGMENT_INTERVAL",REAL_SEGMENT_INTERVAL; +"REAL_SEGMENT_SEGMENT",REAL_SEGMENT_SEGMENT; +"REAL_SEQ_OFFSET",REAL_SEQ_OFFSET; +"REAL_SEQ_OFFSET_REV",REAL_SEQ_OFFSET_REV; +"REAL_SERIES",REAL_SERIES; +"REAL_SERIES_0",REAL_SERIES_0; +"REAL_SERIES_ABSCONV_IMP_CONV",REAL_SERIES_ABSCONV_IMP_CONV; +"REAL_SERIES_ADD",REAL_SERIES_ADD; +"REAL_SERIES_BOUND",REAL_SERIES_BOUND; +"REAL_SERIES_CAUCHY",REAL_SERIES_CAUCHY; +"REAL_SERIES_CAUCHY_UNIFORM",REAL_SERIES_CAUCHY_UNIFORM; +"REAL_SERIES_COMPARISON",REAL_SERIES_COMPARISON; +"REAL_SERIES_COMPARISON_BOUND",REAL_SERIES_COMPARISON_BOUND; +"REAL_SERIES_COMPARISON_UNIFORM",REAL_SERIES_COMPARISON_UNIFORM; +"REAL_SERIES_DIFFS",REAL_SERIES_DIFFS; +"REAL_SERIES_DIRICHLET",REAL_SERIES_DIRICHLET; +"REAL_SERIES_FINITE",REAL_SERIES_FINITE; +"REAL_SERIES_FINITE_SUPPORT",REAL_SERIES_FINITE_SUPPORT; +"REAL_SERIES_FROM",REAL_SERIES_FROM; +"REAL_SERIES_GOESTOZERO",REAL_SERIES_GOESTOZERO; +"REAL_SERIES_LE",REAL_SERIES_LE; +"REAL_SERIES_LMUL",REAL_SERIES_LMUL; +"REAL_SERIES_NEG",REAL_SERIES_NEG; +"REAL_SERIES_POS",REAL_SERIES_POS; +"REAL_SERIES_RATIO",REAL_SERIES_RATIO; +"REAL_SERIES_RESTRICT",REAL_SERIES_RESTRICT; +"REAL_SERIES_RMUL",REAL_SERIES_RMUL; +"REAL_SERIES_SUB",REAL_SERIES_SUB; +"REAL_SERIES_SUBSET",REAL_SERIES_SUBSET; +"REAL_SERIES_SUM",REAL_SERIES_SUM; +"REAL_SERIES_TERMS_TOZERO",REAL_SERIES_TERMS_TOZERO; +"REAL_SERIES_TRIVIAL",REAL_SERIES_TRIVIAL; +"REAL_SERIES_UNIQUE",REAL_SERIES_UNIQUE; +"REAL_SETDIST_LT_EXISTS",REAL_SETDIST_LT_EXISTS; +"REAL_SGN",REAL_SGN; +"REAL_SGN_0",REAL_SGN_0; +"REAL_SGN_ABS",REAL_SGN_ABS; +"REAL_SGN_CASES",REAL_SGN_CASES; +"REAL_SGN_DIV",REAL_SGN_DIV; +"REAL_SGN_EQ",REAL_SGN_EQ; +"REAL_SGN_IM_COMPLEX_DIV",REAL_SGN_IM_COMPLEX_DIV; +"REAL_SGN_INEQS",REAL_SGN_INEQS; +"REAL_SGN_INV",REAL_SGN_INV; +"REAL_SGN_MUL",REAL_SGN_MUL; +"REAL_SGN_NEG",REAL_SGN_NEG; +"REAL_SGN_POW",REAL_SGN_POW; +"REAL_SGN_POW_2",REAL_SGN_POW_2; +"REAL_SGN_REAL_SGN",REAL_SGN_REAL_SGN; +"REAL_SGN_RE_COMPLEX_DIV",REAL_SGN_RE_COMPLEX_DIV; +"REAL_SGN_SQRT",REAL_SGN_SQRT; +"REAL_SIN",REAL_SIN; +"REAL_SOS_EQ_0",REAL_SOS_EQ_0; +"REAL_SQRT_POW_2",REAL_SQRT_POW_2; +"REAL_STEINHAUS",REAL_STEINHAUS; +"REAL_STONE_WEIERSTRASS",REAL_STONE_WEIERSTRASS; +"REAL_STONE_WEIERSTRASS_ALT",REAL_STONE_WEIERSTRASS_ALT; +"REAL_SUB",REAL_SUB; +"REAL_SUB_0",REAL_SUB_0; +"REAL_SUB_ABS",REAL_SUB_ABS; +"REAL_SUB_ADD",REAL_SUB_ADD; +"REAL_SUB_ADD2",REAL_SUB_ADD2; +"REAL_SUB_ARG",REAL_SUB_ARG; +"REAL_SUB_COS",REAL_SUB_COS; +"REAL_SUB_INV",REAL_SUB_INV; +"REAL_SUB_LDISTRIB",REAL_SUB_LDISTRIB; +"REAL_SUB_LE",REAL_SUB_LE; +"REAL_SUB_LNEG",REAL_SUB_LNEG; +"REAL_SUB_LT",REAL_SUB_LT; +"REAL_SUB_LZERO",REAL_SUB_LZERO; +"REAL_SUB_NEG2",REAL_SUB_NEG2; +"REAL_SUB_POLYFUN",REAL_SUB_POLYFUN; +"REAL_SUB_POLYFUN_ALT",REAL_SUB_POLYFUN_ALT; +"REAL_SUB_POW",REAL_SUB_POW; +"REAL_SUB_POW_L1",REAL_SUB_POW_L1; +"REAL_SUB_POW_R1",REAL_SUB_POW_R1; +"REAL_SUB_RDISTRIB",REAL_SUB_RDISTRIB; +"REAL_SUB_REFL",REAL_SUB_REFL; +"REAL_SUB_RNEG",REAL_SUB_RNEG; +"REAL_SUB_RZERO",REAL_SUB_RZERO; +"REAL_SUB_SIN",REAL_SUB_SIN; +"REAL_SUB_SUB",REAL_SUB_SUB; +"REAL_SUB_SUB2",REAL_SUB_SUB2; +"REAL_SUB_TAN",REAL_SUB_TAN; +"REAL_SUB_TRIANGLE",REAL_SUB_TRIANGLE; +"REAL_SUMMABLE",REAL_SUMMABLE; +"REAL_SUMMABLE_0",REAL_SUMMABLE_0; +"REAL_SUMMABLE_ADD",REAL_SUMMABLE_ADD; +"REAL_SUMMABLE_COMPARISON",REAL_SUMMABLE_COMPARISON; +"REAL_SUMMABLE_COMPLEX",REAL_SUMMABLE_COMPLEX; +"REAL_SUMMABLE_EQ",REAL_SUMMABLE_EQ; +"REAL_SUMMABLE_EQ_COFINITE",REAL_SUMMABLE_EQ_COFINITE; +"REAL_SUMMABLE_EQ_EVENTUALLY",REAL_SUMMABLE_EQ_EVENTUALLY; +"REAL_SUMMABLE_FROM_ELSEWHERE",REAL_SUMMABLE_FROM_ELSEWHERE; +"REAL_SUMMABLE_GP",REAL_SUMMABLE_GP; +"REAL_SUMMABLE_IFF",REAL_SUMMABLE_IFF; +"REAL_SUMMABLE_IFF_COFINITE",REAL_SUMMABLE_IFF_COFINITE; +"REAL_SUMMABLE_IFF_EVENTUALLY",REAL_SUMMABLE_IFF_EVENTUALLY; +"REAL_SUMMABLE_IMP_BOUNDED",REAL_SUMMABLE_IMP_BOUNDED; +"REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED",REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED; +"REAL_SUMMABLE_IMP_TOZERO",REAL_SUMMABLE_IMP_TOZERO; +"REAL_SUMMABLE_LMUL",REAL_SUMMABLE_LMUL; +"REAL_SUMMABLE_NEG",REAL_SUMMABLE_NEG; +"REAL_SUMMABLE_RESTRICT",REAL_SUMMABLE_RESTRICT; +"REAL_SUMMABLE_RMUL",REAL_SUMMABLE_RMUL; +"REAL_SUMMABLE_SUB",REAL_SUMMABLE_SUB; +"REAL_SUMMABLE_SUBSET",REAL_SUMMABLE_SUBSET; +"REAL_SUMMABLE_TRIVIAL",REAL_SUMMABLE_TRIVIAL; +"REAL_SUMMABLE_ZETA_INTEGER",REAL_SUMMABLE_ZETA_INTEGER; +"REAL_SUMS",REAL_SUMS; +"REAL_SUMS_COMPLEX",REAL_SUMS_COMPLEX; +"REAL_SUMS_EQ",REAL_SUMS_EQ; +"REAL_SUMS_FINITE_DIFF",REAL_SUMS_FINITE_DIFF; +"REAL_SUMS_FINITE_UNION",REAL_SUMS_FINITE_UNION; +"REAL_SUMS_GP",REAL_SUMS_GP; +"REAL_SUMS_IFF",REAL_SUMS_IFF; +"REAL_SUMS_IM",REAL_SUMS_IM; +"REAL_SUMS_INFSUM",REAL_SUMS_INFSUM; +"REAL_SUMS_OFFSET",REAL_SUMS_OFFSET; +"REAL_SUMS_OFFSET_REV",REAL_SUMS_OFFSET_REV; +"REAL_SUMS_RE",REAL_SUMS_RE; +"REAL_SUMS_REINDEX",REAL_SUMS_REINDEX; +"REAL_SUMS_SUMMABLE",REAL_SUMS_SUMMABLE; +"REAL_SUM_INTEGRAL_BOUNDS_DECREASING",REAL_SUM_INTEGRAL_BOUNDS_DECREASING; +"REAL_SUM_INTEGRAL_BOUNDS_INCREASING",REAL_SUM_INTEGRAL_BOUNDS_INCREASING; +"REAL_SUM_INTEGRAL_LBOUND_DECREASING",REAL_SUM_INTEGRAL_LBOUND_DECREASING; +"REAL_SUM_INTEGRAL_LBOUND_INCREASING",REAL_SUM_INTEGRAL_LBOUND_INCREASING; +"REAL_SUM_INTEGRAL_UBOUND_DECREASING",REAL_SUM_INTEGRAL_UBOUND_DECREASING; +"REAL_SUM_INTEGRAL_UBOUND_INCREASING",REAL_SUM_INTEGRAL_UBOUND_INCREASING; +"REAL_SUP_ASCLOSE",REAL_SUP_ASCLOSE; +"REAL_SUP_BOUNDS",REAL_SUP_BOUNDS; +"REAL_SUP_EQ_INF",REAL_SUP_EQ_INF; +"REAL_SUP_LE",REAL_SUP_LE; +"REAL_SUP_LE_EQ",REAL_SUP_LE_EQ; +"REAL_SUP_LE_FINITE",REAL_SUP_LE_FINITE; +"REAL_SUP_LE_SUBSET",REAL_SUP_LE_SUBSET; +"REAL_SUP_LT_FINITE",REAL_SUP_LT_FINITE; +"REAL_SUP_UNIQUE",REAL_SUP_UNIQUE; +"REAL_TAN",REAL_TAN; +"REAL_TAYLOR",REAL_TAYLOR; +"REAL_TAYLOR_MVT_NEG",REAL_TAYLOR_MVT_NEG; +"REAL_TAYLOR_MVT_POS",REAL_TAYLOR_MVT_POS; +"REAL_TENDSTO",REAL_TENDSTO; +"REAL_TIETZE_PERIODIC_INTERVAL",REAL_TIETZE_PERIODIC_INTERVAL; +"REAL_TRUNCATE",REAL_TRUNCATE; +"REAL_TRUNCATE_POS",REAL_TRUNCATE_POS; +"REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS",REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS; +"REAL_UNIFORMLY_CONTINUOUS_ON",REAL_UNIFORMLY_CONTINUOUS_ON; +"REAL_UNIFORMLY_CONTINUOUS_ON_ADD",REAL_UNIFORMLY_CONTINUOUS_ON_ADD; +"REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE",REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE; +"REAL_UNIFORMLY_CONTINUOUS_ON_CONST",REAL_UNIFORMLY_CONTINUOUS_ON_CONST; +"REAL_UNIFORMLY_CONTINUOUS_ON_ID",REAL_UNIFORMLY_CONTINUOUS_ON_ID; +"REAL_UNIFORMLY_CONTINUOUS_ON_LMUL",REAL_UNIFORMLY_CONTINUOUS_ON_LMUL; +"REAL_UNIFORMLY_CONTINUOUS_ON_NEG",REAL_UNIFORMLY_CONTINUOUS_ON_NEG; +"REAL_UNIFORMLY_CONTINUOUS_ON_RMUL",REAL_UNIFORMLY_CONTINUOUS_ON_RMUL; +"REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY",REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; +"REAL_UNIFORMLY_CONTINUOUS_ON_SUB",REAL_UNIFORMLY_CONTINUOUS_ON_SUB; +"REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET",REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET; +"REAL_UNIFORMLY_CONTINUOUS_ON_SUM",REAL_UNIFORMLY_CONTINUOUS_ON_SUM; +"REAL_VARIATION_AFFINITY",REAL_VARIATION_AFFINITY; +"REAL_VARIATION_AFFINITY2",REAL_VARIATION_AFFINITY2; +"REAL_VARIATION_COMBINE",REAL_VARIATION_COMBINE; +"REAL_VARIATION_CONTINUOUS",REAL_VARIATION_CONTINUOUS; +"REAL_VARIATION_CONTINUOUS_LEFT",REAL_VARIATION_CONTINUOUS_LEFT; +"REAL_VARIATION_CONTINUOUS_RIGHT",REAL_VARIATION_CONTINUOUS_RIGHT; +"REAL_VARIATION_GE_ABS_FUNCTION",REAL_VARIATION_GE_ABS_FUNCTION; +"REAL_VARIATION_GE_FUNCTION",REAL_VARIATION_GE_FUNCTION; +"REAL_VARIATION_MINUS_FUNCTION_MONOTONE",REAL_VARIATION_MINUS_FUNCTION_MONOTONE; +"REAL_VARIATION_MONOTONE",REAL_VARIATION_MONOTONE; +"REAL_VARIATION_NEG",REAL_VARIATION_NEG; +"REAL_VARIATION_POS_LE",REAL_VARIATION_POS_LE; +"REAL_VARIATION_REFLECT",REAL_VARIATION_REFLECT; +"REAL_VARIATION_REFLECT2",REAL_VARIATION_REFLECT2; +"REAL_VARIATION_REFLECT_INTERVAL",REAL_VARIATION_REFLECT_INTERVAL; +"REAL_VARIATION_TRANSLATION",REAL_VARIATION_TRANSLATION; +"REAL_VARIATION_TRANSLATION2",REAL_VARIATION_TRANSLATION2; +"REAL_VARIATION_TRANSLATION_INTERVAL",REAL_VARIATION_TRANSLATION_INTERVAL; +"REAL_VARIATION_TRIANGLE",REAL_VARIATION_TRIANGLE; +"REAL_VECTOR_POLYNOMIAL_FUNCTION_o",REAL_VECTOR_POLYNOMIAL_FUNCTION_o; +"REAL_VSUM",REAL_VSUM; +"REAL_WLOG_LE",REAL_WLOG_LE; +"REAL_WLOG_LT",REAL_WLOG_LT; +"RECTIFIABLE_PATH_DIFFERENTIABLE",RECTIFIABLE_PATH_DIFFERENTIABLE; +"RECTIFIABLE_PATH_IMP_PATH",RECTIFIABLE_PATH_IMP_PATH; +"RECTIFIABLE_PATH_JOIN",RECTIFIABLE_PATH_JOIN; +"RECTIFIABLE_PATH_JOIN_EQ",RECTIFIABLE_PATH_JOIN_EQ; +"RECTIFIABLE_PATH_JOIN_IMP",RECTIFIABLE_PATH_JOIN_IMP; +"RECTIFIABLE_PATH_LINEPATH",RECTIFIABLE_PATH_LINEPATH; +"RECTIFIABLE_PATH_REVERSEPATH",RECTIFIABLE_PATH_REVERSEPATH; +"RECTIFIABLE_PATH_SUBPATH",RECTIFIABLE_PATH_SUBPATH; +"RECTIFIABLE_VALID_PATH",RECTIFIABLE_VALID_PATH; +"RECURSION_CASEWISE",RECURSION_CASEWISE; +"RECURSION_CASEWISE_PAIRWISE",RECURSION_CASEWISE_PAIRWISE; +"RECURSION_SUPERADMISSIBLE",RECURSION_SUPERADMISSIBLE; +"REDUCED_LABELLING",REDUCED_LABELLING; +"REDUCED_LABELLING_0",REDUCED_LABELLING_0; +"REDUCED_LABELLING_1",REDUCED_LABELLING_1; +"REDUCED_LABELLING_SUC",REDUCED_LABELLING_SUC; +"REDUCED_LABELLING_UNIQUE",REDUCED_LABELLING_UNIQUE; +"REDUCE_LABELLING_0",REDUCE_LABELLING_0; +"REFLECT_ALONG_0",REFLECT_ALONG_0; +"REFLECT_ALONG_1D",REFLECT_ALONG_1D; +"REFLECT_ALONG_ADD",REFLECT_ALONG_ADD; +"REFLECT_ALONG_BASIS",REFLECT_ALONG_BASIS; +"REFLECT_ALONG_EQ_0",REFLECT_ALONG_EQ_0; +"REFLECT_ALONG_EQ_SELF",REFLECT_ALONG_EQ_SELF; +"REFLECT_ALONG_INVOLUTION",REFLECT_ALONG_INVOLUTION; +"REFLECT_ALONG_LINEAR_IMAGE",REFLECT_ALONG_LINEAR_IMAGE; +"REFLECT_ALONG_MUL",REFLECT_ALONG_MUL; +"REFLECT_ALONG_REFL",REFLECT_ALONG_REFL; +"REFLECT_ALONG_SCALE",REFLECT_ALONG_SCALE; +"REFLECT_ALONG_ZERO",REFLECT_ALONG_ZERO; +"REFLECT_INTERVAL",REFLECT_INTERVAL; +"REFLECT_REAL_INTERVAL",REFLECT_REAL_INTERVAL; +"REFL_CLAUSE",REFL_CLAUSE; +"REGULAR_CLOSED_UNION",REGULAR_CLOSED_UNION; +"REGULAR_OPEN_INTER",REGULAR_OPEN_INTER; +"RELATIVE_BOUNDARY_OF_CONVEX_HULL",RELATIVE_BOUNDARY_OF_CONVEX_HULL; +"RELATIVE_BOUNDARY_OF_POLYHEDRON",RELATIVE_BOUNDARY_OF_POLYHEDRON; +"RELATIVE_BOUNDARY_OF_TRIANGLE",RELATIVE_BOUNDARY_OF_TRIANGLE; +"RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL; +"RELATIVE_FRONTIER_BALL",RELATIVE_FRONTIER_BALL; +"RELATIVE_FRONTIER_CBALL",RELATIVE_FRONTIER_CBALL; +"RELATIVE_FRONTIER_CLOSURE",RELATIVE_FRONTIER_CLOSURE; +"RELATIVE_FRONTIER_CONVEX_HULL_CASES",RELATIVE_FRONTIER_CONVEX_HULL_CASES; +"RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT",RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT; +"RELATIVE_FRONTIER_CONVEX_INTER_AFFINE",RELATIVE_FRONTIER_CONVEX_INTER_AFFINE; +"RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX",RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX; +"RELATIVE_FRONTIER_EMPTY",RELATIVE_FRONTIER_EMPTY; +"RELATIVE_FRONTIER_EQ_EMPTY",RELATIVE_FRONTIER_EQ_EMPTY; +"RELATIVE_FRONTIER_FRONTIER",RELATIVE_FRONTIER_FRONTIER; +"RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE",RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE; +"RELATIVE_FRONTIER_NONEMPTY_INTERIOR",RELATIVE_FRONTIER_NONEMPTY_INTERIOR; +"RELATIVE_FRONTIER_NOT_SING",RELATIVE_FRONTIER_NOT_SING; +"RELATIVE_FRONTIER_OF_CONVEX_HULL",RELATIVE_FRONTIER_OF_CONVEX_HULL; +"RELATIVE_FRONTIER_OF_POLYHEDRON",RELATIVE_FRONTIER_OF_POLYHEDRON; +"RELATIVE_FRONTIER_OF_POLYHEDRON_ALT",RELATIVE_FRONTIER_OF_POLYHEDRON_ALT; +"RELATIVE_FRONTIER_OF_TRIANGLE",RELATIVE_FRONTIER_OF_TRIANGLE; +"RELATIVE_FRONTIER_RELATIVE_INTERIOR",RELATIVE_FRONTIER_RELATIVE_INTERIOR; +"RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL; +"RELATIVE_FRONTIER_SING",RELATIVE_FRONTIER_SING; +"RELATIVE_FRONTIER_TRANSLATION",RELATIVE_FRONTIER_TRANSLATION; +"RELATIVE_INTERIOR",RELATIVE_INTERIOR; +"RELATIVE_INTERIOR_AFFINE",RELATIVE_INTERIOR_AFFINE; +"RELATIVE_INTERIOR_BALL",RELATIVE_INTERIOR_BALL; +"RELATIVE_INTERIOR_CBALL",RELATIVE_INTERIOR_CBALL; +"RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY",RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY; +"RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT",RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT; +"RELATIVE_INTERIOR_CONVEX_INTER_AFFINE",RELATIVE_INTERIOR_CONVEX_INTER_AFFINE; +"RELATIVE_INTERIOR_CONVEX_PROLONG",RELATIVE_INTERIOR_CONVEX_PROLONG; +"RELATIVE_INTERIOR_EMPTY",RELATIVE_INTERIOR_EMPTY; +"RELATIVE_INTERIOR_EQ",RELATIVE_INTERIOR_EQ; +"RELATIVE_INTERIOR_EQ_CLOSURE",RELATIVE_INTERIOR_EQ_CLOSURE; +"RELATIVE_INTERIOR_EQ_EMPTY",RELATIVE_INTERIOR_EQ_EMPTY; +"RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE",RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE; +"RELATIVE_INTERIOR_INTERIOR",RELATIVE_INTERIOR_INTERIOR; +"RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX",RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; +"RELATIVE_INTERIOR_MAXIMAL",RELATIVE_INTERIOR_MAXIMAL; +"RELATIVE_INTERIOR_NONEMPTY_INTERIOR",RELATIVE_INTERIOR_NONEMPTY_INTERIOR; +"RELATIVE_INTERIOR_OF_POLYHEDRON",RELATIVE_INTERIOR_OF_POLYHEDRON; +"RELATIVE_INTERIOR_OPEN",RELATIVE_INTERIOR_OPEN; +"RELATIVE_INTERIOR_OPEN_IN",RELATIVE_INTERIOR_OPEN_IN; +"RELATIVE_INTERIOR_PCROSS",RELATIVE_INTERIOR_PCROSS; +"RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT",RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT; +"RELATIVE_INTERIOR_PROLONG",RELATIVE_INTERIOR_PROLONG; +"RELATIVE_INTERIOR_SEGMENT",RELATIVE_INTERIOR_SEGMENT; +"RELATIVE_INTERIOR_SING",RELATIVE_INTERIOR_SING; +"RELATIVE_INTERIOR_SUBSET",RELATIVE_INTERIOR_SUBSET; +"RELATIVE_INTERIOR_TRANSLATION",RELATIVE_INTERIOR_TRANSLATION; +"RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY; +"RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS; +"RELATIVE_INTERIOR_UNIQUE",RELATIVE_INTERIOR_UNIQUE; +"RELATIVE_INTERIOR_UNIV",RELATIVE_INTERIOR_UNIV; +"REPLICATE",REPLICATE; +"REP_ABS_PAIR",REP_ABS_PAIR; +"REST",REST; +"RETRACTION",RETRACTION; +"RETRACTION_ARC",RETRACTION_ARC; +"RETRACTION_IDEMPOTENT",RETRACTION_IDEMPOTENT; +"RETRACTION_IMP_QUOTIENT_MAP",RETRACTION_IMP_QUOTIENT_MAP; +"RETRACTION_REFL",RETRACTION_REFL; +"RETRACTION_SUBSET",RETRACTION_SUBSET; +"RETRACTION_o",RETRACTION_o; +"RETRACT_FIXPOINT_PROPERTY",RETRACT_FIXPOINT_PROPERTY; +"RETRACT_FROM_UNION_AND_INTER",RETRACT_FROM_UNION_AND_INTER; +"RETRACT_OF_BORSUKIAN",RETRACT_OF_BORSUKIAN; +"RETRACT_OF_CLOSED",RETRACT_OF_CLOSED; +"RETRACT_OF_COHOMOTOPICALLY_TRIVIAL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL; +"RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL; +"RETRACT_OF_COMPACT",RETRACT_OF_COMPACT; +"RETRACT_OF_CONNECTED",RETRACT_OF_CONNECTED; +"RETRACT_OF_CONTRACTIBLE",RETRACT_OF_CONTRACTIBLE; +"RETRACT_OF_EMPTY",RETRACT_OF_EMPTY; +"RETRACT_OF_HOMOTOPICALLY_TRIVIAL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL; +"RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL; +"RETRACT_OF_IMP_EXTENSIBLE",RETRACT_OF_IMP_EXTENSIBLE; +"RETRACT_OF_IMP_SUBSET",RETRACT_OF_IMP_SUBSET; +"RETRACT_OF_INJECTIVE_LINEAR_IMAGE",RETRACT_OF_INJECTIVE_LINEAR_IMAGE; +"RETRACT_OF_LINEAR_IMAGE_EQ",RETRACT_OF_LINEAR_IMAGE_EQ; +"RETRACT_OF_LOCALLY_COMPACT",RETRACT_OF_LOCALLY_COMPACT; +"RETRACT_OF_LOCALLY_CONNECTED",RETRACT_OF_LOCALLY_CONNECTED; +"RETRACT_OF_LOCALLY_PATH_CONNECTED",RETRACT_OF_LOCALLY_PATH_CONNECTED; +"RETRACT_OF_PATH_CONNECTED",RETRACT_OF_PATH_CONNECTED; +"RETRACT_OF_PCROSS",RETRACT_OF_PCROSS; +"RETRACT_OF_PCROSS_EQ",RETRACT_OF_PCROSS_EQ; +"RETRACT_OF_REFL",RETRACT_OF_REFL; +"RETRACT_OF_SIMPLY_CONNECTED",RETRACT_OF_SIMPLY_CONNECTED; +"RETRACT_OF_SING",RETRACT_OF_SING; +"RETRACT_OF_SUBSET",RETRACT_OF_SUBSET; +"RETRACT_OF_TRANS",RETRACT_OF_TRANS; +"RETRACT_OF_TRANSLATION",RETRACT_OF_TRANSLATION; +"RETRACT_OF_TRANSLATION_EQ",RETRACT_OF_TRANSLATION_EQ; +"RETRACT_OF_UNIV",RETRACT_OF_UNIV; +"REVERSE",REVERSE; +"REVERSEPATH_JOINPATHS",REVERSEPATH_JOINPATHS; +"REVERSEPATH_LINEAR_IMAGE",REVERSEPATH_LINEAR_IMAGE; +"REVERSEPATH_LINEPATH",REVERSEPATH_LINEPATH; +"REVERSEPATH_REVERSEPATH",REVERSEPATH_REVERSEPATH; +"REVERSEPATH_SUBPATH",REVERSEPATH_SUBPATH; +"REVERSEPATH_TRANSLATION",REVERSEPATH_TRANSLATION; +"REVERSE_APPEND",REVERSE_APPEND; +"REVERSE_REVERSE",REVERSE_REVERSE; +"RE_ADD",RE_ADD; +"RE_CACS",RE_CACS; +"RE_CACS_BOUND",RE_CACS_BOUND; +"RE_CACS_BOUNDS",RE_CACS_BOUNDS; +"RE_CASN",RE_CASN; +"RE_CASN_BOUND",RE_CASN_BOUND; +"RE_CASN_BOUNDS",RE_CASN_BOUNDS; +"RE_CATN_BOUNDS",RE_CATN_BOUNDS; +"RE_CCOS",RE_CCOS; +"RE_CEXP",RE_CEXP; +"RE_CLOG",RE_CLOG; +"RE_CLOG_POS_LE",RE_CLOG_POS_LE; +"RE_CLOG_POS_LT",RE_CLOG_POS_LT; +"RE_CLOG_POS_LT_IMP",RE_CLOG_POS_LT_IMP; +"RE_CMUL",RE_CMUL; +"RE_CNJ",RE_CNJ; +"RE_COMPLEX_DIV_EQ_0",RE_COMPLEX_DIV_EQ_0; +"RE_COMPLEX_DIV_GE_0",RE_COMPLEX_DIV_GE_0; +"RE_COMPLEX_DIV_GT_0",RE_COMPLEX_DIV_GT_0; +"RE_COMPLEX_DIV_LEMMA",RE_COMPLEX_DIV_LEMMA; +"RE_COMPLEX_DIV_LE_0",RE_COMPLEX_DIV_LE_0; +"RE_COMPLEX_DIV_LT_0",RE_COMPLEX_DIV_LT_0; +"RE_CSIN",RE_CSIN; +"RE_CSQRT",RE_CSQRT; +"RE_CX",RE_CX; +"RE_DEF",RE_DEF; +"RE_DIV_CX",RE_DIV_CX; +"RE_II",RE_II; +"RE_LINEPATH_CX",RE_LINEPATH_CX; +"RE_MUL_CX",RE_MUL_CX; +"RE_MUL_II",RE_MUL_II; +"RE_NEG",RE_NEG; +"RE_POS_SEGMENT",RE_POS_SEGMENT; +"RE_POW_2",RE_POW_2; +"RE_SUB",RE_SUB; +"RE_VSUM",RE_VSUM; +"RE_WINDING_NUMBER",RE_WINDING_NUMBER; +"RIEMANN_MAPPING_THEOREM",RIEMANN_MAPPING_THEOREM; +"RIGHT_ADD_DISTRIB",RIGHT_ADD_DISTRIB; +"RIGHT_AND_EXISTS_THM",RIGHT_AND_EXISTS_THM; +"RIGHT_AND_FORALL_THM",RIGHT_AND_FORALL_THM; +"RIGHT_EXISTS_AND_THM",RIGHT_EXISTS_AND_THM; +"RIGHT_EXISTS_IMP_THM",RIGHT_EXISTS_IMP_THM; +"RIGHT_FORALL_IMP_THM",RIGHT_FORALL_IMP_THM; +"RIGHT_FORALL_OR_THM",RIGHT_FORALL_OR_THM; +"RIGHT_IMP_EXISTS_THM",RIGHT_IMP_EXISTS_THM; +"RIGHT_IMP_FORALL_THM",RIGHT_IMP_FORALL_THM; +"RIGHT_INVERSE_LINEAR",RIGHT_INVERSE_LINEAR; +"RIGHT_INVERTIBLE_TRANSP",RIGHT_INVERTIBLE_TRANSP; +"RIGHT_OR_DISTRIB",RIGHT_OR_DISTRIB; +"RIGHT_OR_EXISTS_THM",RIGHT_OR_EXISTS_THM; +"RIGHT_OR_FORALL_THM",RIGHT_OR_FORALL_THM; +"RIGHT_SUB_DISTRIB",RIGHT_SUB_DISTRIB; +"RIGID_TRANSFORMATION_BETWEEN_2",RIGID_TRANSFORMATION_BETWEEN_2; +"RIGID_TRANSFORMATION_BETWEEN_3",RIGID_TRANSFORMATION_BETWEEN_3; +"RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS; +"RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG; +"ROLLE",ROLLE; +"ROOT_0",ROOT_0; +"ROOT_1",ROOT_1; +"ROOT_2",ROOT_2; +"ROOT_EQ_0",ROOT_EQ_0; +"ROOT_EXP_LOG",ROOT_EXP_LOG; +"ROOT_INJ",ROOT_INJ; +"ROOT_LE_0",ROOT_LE_0; +"ROOT_LT_0",ROOT_LT_0; +"ROOT_MONO_LE",ROOT_MONO_LE; +"ROOT_MONO_LE_EQ",ROOT_MONO_LE_EQ; +"ROOT_MONO_LT",ROOT_MONO_LT; +"ROOT_MONO_LT_EQ",ROOT_MONO_LT_EQ; +"ROOT_NEG",ROOT_NEG; +"ROOT_POS_LE",ROOT_POS_LE; +"ROOT_POS_LT",ROOT_POS_LT; +"ROOT_PRODUCT",ROOT_PRODUCT; +"ROOT_UNIQUE",ROOT_UNIQUE; +"ROOT_WORKS",ROOT_WORKS; +"ROTATE2D_0",ROTATE2D_0; +"ROTATE2D_2PI",ROTATE2D_2PI; +"ROTATE2D_ADD",ROTATE2D_ADD; +"ROTATE2D_ADD_VECTORS",ROTATE2D_ADD_VECTORS; +"ROTATE2D_COMPLEX",ROTATE2D_COMPLEX; +"ROTATE2D_EQ",ROTATE2D_EQ; +"ROTATE2D_EQ_0",ROTATE2D_EQ_0; +"ROTATE2D_NPI",ROTATE2D_NPI; +"ROTATE2D_PI",ROTATE2D_PI; +"ROTATE2D_PI2",ROTATE2D_PI2; +"ROTATE2D_POLAR",ROTATE2D_POLAR; +"ROTATE2D_SUB",ROTATE2D_SUB; +"ROTATE2D_SUB_ARG",ROTATE2D_SUB_ARG; +"ROTATE2D_ZERO",ROTATE2D_ZERO; +"ROTATION_EXISTS",ROTATION_EXISTS; +"ROTATION_EXISTS_1",ROTATION_EXISTS_1; +"ROTATION_LOWDIM_HORIZONTAL",ROTATION_LOWDIM_HORIZONTAL; +"ROTATION_MATRIX_2",ROTATION_MATRIX_2; +"ROTATION_MATRIX_EXISTS_BASIS",ROTATION_MATRIX_EXISTS_BASIS; +"ROTATION_MATRIX_ROTATE2D",ROTATION_MATRIX_ROTATE2D; +"ROTATION_MATRIX_ROTATE2D_EQ",ROTATION_MATRIX_ROTATE2D_EQ; +"ROTATION_RIGHTWARD_LINE",ROTATION_RIGHTWARD_LINE; +"ROTATION_ROTATE2D",ROTATION_ROTATE2D; +"ROTATION_ROTATE2D_EXISTS",ROTATION_ROTATE2D_EXISTS; +"ROTATION_ROTATE2D_EXISTS_GEN",ROTATION_ROTATE2D_EXISTS_GEN; +"ROTATION_ROTATE2D_EXISTS_ORTHOGONAL",ROTATION_ROTATE2D_EXISTS_ORTHOGONAL; +"ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED",ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED; +"ROTHE",ROTHE; +"ROTOINVERSION_MATRIX_REFLECT_ALONG",ROTOINVERSION_MATRIX_REFLECT_ALONG; +"ROWS_TRANSP",ROWS_TRANSP; +"ROW_TRANSP",ROW_TRANSP; +"RPOW_0",RPOW_0; +"RPOW_1_LE",RPOW_1_LE; +"RPOW_ADD",RPOW_ADD; +"RPOW_ADD_ALT",RPOW_ADD_ALT; +"RPOW_DIV",RPOW_DIV; +"RPOW_EQ_0",RPOW_EQ_0; +"RPOW_INV",RPOW_INV; +"RPOW_LE2",RPOW_LE2; +"RPOW_LNEG",RPOW_LNEG; +"RPOW_LT2",RPOW_LT2; +"RPOW_MINUS1_QUOTIENT_LE",RPOW_MINUS1_QUOTIENT_LE; +"RPOW_MINUS1_QUOTIENT_LT",RPOW_MINUS1_QUOTIENT_LT; +"RPOW_MONO",RPOW_MONO; +"RPOW_MONO_INV",RPOW_MONO_INV; +"RPOW_MUL",RPOW_MUL; +"RPOW_NEG",RPOW_NEG; +"RPOW_ONE",RPOW_ONE; +"RPOW_POS_LE",RPOW_POS_LE; +"RPOW_POS_LT",RPOW_POS_LT; +"RPOW_POW",RPOW_POW; +"RPOW_PRODUCT",RPOW_PRODUCT; +"RPOW_RPOW",RPOW_RPOW; +"RPOW_SQRT",RPOW_SQRT; +"RPOW_ZERO",RPOW_ZERO; +"RSUM_BOUND",RSUM_BOUND; +"RSUM_COMPONENT_LE",RSUM_COMPONENT_LE; +"RSUM_DIFF_BOUND",RSUM_DIFF_BOUND; +"SAME_DISTANCES_TO_AFFINE_HULL",SAME_DISTANCES_TO_AFFINE_HULL; +"SCALING_LINEAR",SCALING_LINEAR; +"SCHAUDER",SCHAUDER; +"SCHAUDER_GEN",SCHAUDER_GEN; +"SCHAUDER_PROJECTION",SCHAUDER_PROJECTION; +"SCHAUDER_UNIV",SCHAUDER_UNIV; +"SCHOTTKY",SCHOTTKY; +"SCHWARZ_LEMMA",SCHWARZ_LEMMA; +"SCHWARZ_REFLECTION",SCHWARZ_REFLECTION; +"SECOND_CARTAN_THM_DIM_1",SECOND_CARTAN_THM_DIM_1; +"SECOND_MEAN_VALUE_THEOREM",SECOND_MEAN_VALUE_THEOREM; +"SECOND_MEAN_VALUE_THEOREM_BONNET",SECOND_MEAN_VALUE_THEOREM_BONNET; +"SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",SECOND_MEAN_VALUE_THEOREM_BONNET_FULL; +"SECOND_MEAN_VALUE_THEOREM_FULL",SECOND_MEAN_VALUE_THEOREM_FULL; +"SECOND_MEAN_VALUE_THEOREM_GEN",SECOND_MEAN_VALUE_THEOREM_GEN; +"SECOND_MEAN_VALUE_THEOREM_GEN_FULL",SECOND_MEAN_VALUE_THEOREM_GEN_FULL; +"SEGMENTS_SUBSET_CONVEX_HULL",SEGMENTS_SUBSET_CONVEX_HULL; +"SEGMENT_1",SEGMENT_1; +"SEGMENT_AS_BALL",SEGMENT_AS_BALL; +"SEGMENT_BOUND",SEGMENT_BOUND; +"SEGMENT_CLOSED_OPEN",SEGMENT_CLOSED_OPEN; +"SEGMENT_CONVEX_HULL",SEGMENT_CONVEX_HULL; +"SEGMENT_EDGE_OF",SEGMENT_EDGE_OF; +"SEGMENT_EQ",SEGMENT_EQ; +"SEGMENT_EQ_EMPTY",SEGMENT_EQ_EMPTY; +"SEGMENT_EQ_SING",SEGMENT_EQ_SING; +"SEGMENT_FACE_OF",SEGMENT_FACE_OF; +"SEGMENT_FURTHEST_LE",SEGMENT_FURTHEST_LE; +"SEGMENT_HORIZONTAL",SEGMENT_HORIZONTAL; +"SEGMENT_IMAGE_INTERVAL",SEGMENT_IMAGE_INTERVAL; +"SEGMENT_OPEN_SUBSET_CLOSED",SEGMENT_OPEN_SUBSET_CLOSED; +"SEGMENT_REAL_SEGMENT",SEGMENT_REAL_SEGMENT; +"SEGMENT_REFL",SEGMENT_REFL; +"SEGMENT_SCALAR_MULTIPLE",SEGMENT_SCALAR_MULTIPLE; +"SEGMENT_SYM",SEGMENT_SYM; +"SEGMENT_TO_CLOSEST_POINT",SEGMENT_TO_CLOSEST_POINT; +"SEGMENT_TO_POINT_EXISTS",SEGMENT_TO_POINT_EXISTS; +"SEGMENT_TRANSLATION",SEGMENT_TRANSLATION; +"SEGMENT_VERTICAL",SEGMENT_VERTICAL; +"SELECT_AX",SELECT_AX; +"SELECT_REFL",SELECT_REFL; +"SELECT_UNIQUE",SELECT_UNIQUE; +"SELF_ADJOINT_COMPOSE",SELF_ADJOINT_COMPOSE; +"SELF_ADJOINT_HAS_EIGENVECTOR",SELF_ADJOINT_HAS_EIGENVECTOR; +"SELF_ADJOINT_HAS_EIGENVECTOR_BASIS",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS; +"SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE; +"SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE; +"SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS",SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS; +"SEPARABLE",SEPARABLE; +"SEPARATE_CLOSED_COMPACT",SEPARATE_CLOSED_COMPACT; +"SEPARATE_CLOSED_CONES",SEPARATE_CLOSED_CONES; +"SEPARATE_COMPACT_CLOSED",SEPARATE_COMPACT_CLOSED; +"SEPARATE_POINT_CLOSED",SEPARATE_POINT_CLOSED; +"SEPARATING_HYPERPLANE_CLOSED_0",SEPARATING_HYPERPLANE_CLOSED_0; +"SEPARATING_HYPERPLANE_CLOSED_0_INSET",SEPARATING_HYPERPLANE_CLOSED_0_INSET; +"SEPARATING_HYPERPLANE_CLOSED_COMPACT",SEPARATING_HYPERPLANE_CLOSED_COMPACT; +"SEPARATING_HYPERPLANE_CLOSED_POINT",SEPARATING_HYPERPLANE_CLOSED_POINT; +"SEPARATING_HYPERPLANE_CLOSED_POINT_INSET",SEPARATING_HYPERPLANE_CLOSED_POINT_INSET; +"SEPARATING_HYPERPLANE_COMPACT_CLOSED",SEPARATING_HYPERPLANE_COMPACT_CLOSED; +"SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO",SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO; +"SEPARATING_HYPERPLANE_COMPACT_COMPACT",SEPARATING_HYPERPLANE_COMPACT_COMPACT; +"SEPARATING_HYPERPLANE_POLYHEDRA",SEPARATING_HYPERPLANE_POLYHEDRA; +"SEPARATING_HYPERPLANE_RELATIVE_INTERIORS",SEPARATING_HYPERPLANE_RELATIVE_INTERIORS; +"SEPARATING_HYPERPLANE_SETS",SEPARATING_HYPERPLANE_SETS; +"SEPARATING_HYPERPLANE_SET_0",SEPARATING_HYPERPLANE_SET_0; +"SEPARATING_HYPERPLANE_SET_0_INSPAN",SEPARATING_HYPERPLANE_SET_0_INSPAN; +"SEPARATING_HYPERPLANE_SET_POINT_INAFF",SEPARATING_HYPERPLANE_SET_POINT_INAFF; +"SEPARATION_BY_COMPONENT_CLOSED",SEPARATION_BY_COMPONENT_CLOSED; +"SEPARATION_BY_COMPONENT_CLOSED_POINTWISE",SEPARATION_BY_COMPONENT_CLOSED_POINTWISE; +"SEPARATION_BY_COMPONENT_OPEN",SEPARATION_BY_COMPONENT_OPEN; +"SEPARATION_BY_UNION_CLOSED",SEPARATION_BY_UNION_CLOSED; +"SEPARATION_BY_UNION_CLOSED_POINTWISE",SEPARATION_BY_UNION_CLOSED_POINTWISE; +"SEPARATION_BY_UNION_OPEN",SEPARATION_BY_UNION_OPEN; +"SEPARATION_CLOSURES",SEPARATION_CLOSURES; +"SEPARATION_HAUSDORFF",SEPARATION_HAUSDORFF; +"SEPARATION_NORMAL",SEPARATION_NORMAL; +"SEPARATION_NORMAL_COMPACT",SEPARATION_NORMAL_COMPACT; +"SEPARATION_NORMAL_LOCAL",SEPARATION_NORMAL_LOCAL; +"SEPARATION_T0",SEPARATION_T0; +"SEPARATION_T1",SEPARATION_T1; +"SEPARATION_T2",SEPARATION_T2; +"SEQITERATE_CLAUSES",SEQITERATE_CLAUSES; +"SEQITERATE_ITERATE",SEQITERATE_ITERATE; +"SEQUENCE_CAUCHY_WLOG",SEQUENCE_CAUCHY_WLOG; +"SEQUENCE_INFINITE_LEMMA",SEQUENCE_INFINITE_LEMMA; +"SEQUENCE_UNIQUE_LIMPT",SEQUENCE_UNIQUE_LIMPT; +"SEQUENTIALLY",SEQUENTIALLY; +"SEQ_HARMONIC",SEQ_HARMONIC; +"SEQ_MONO_LEMMA",SEQ_MONO_LEMMA; +"SEQ_OFFSET",SEQ_OFFSET; +"SEQ_OFFSET_NEG",SEQ_OFFSET_NEG; +"SEQ_OFFSET_REV",SEQ_OFFSET_REV; +"SERIES_0",SERIES_0; +"SERIES_ABSCONV_IMP_CONV",SERIES_ABSCONV_IMP_CONV; +"SERIES_ADD",SERIES_ADD; +"SERIES_AND_DERIVATIVE_COMPARISON",SERIES_AND_DERIVATIVE_COMPARISON; +"SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX",SERIES_AND_DERIVATIVE_COMPARISON_COMPLEX; +"SERIES_AND_DERIVATIVE_COMPARISON_LOCAL",SERIES_AND_DERIVATIVE_COMPARISON_LOCAL; +"SERIES_BOUND",SERIES_BOUND; +"SERIES_CAUCHY",SERIES_CAUCHY; +"SERIES_CAUCHY_UNIFORM",SERIES_CAUCHY_UNIFORM; +"SERIES_CMUL",SERIES_CMUL; +"SERIES_COMPARISON",SERIES_COMPARISON; +"SERIES_COMPARISON_BOUND",SERIES_COMPARISON_BOUND; +"SERIES_COMPARISON_COMPLEX",SERIES_COMPARISON_COMPLEX; +"SERIES_COMPARISON_UNIFORM",SERIES_COMPARISON_UNIFORM; +"SERIES_COMPARISON_UNIFORM_COMPLEX",SERIES_COMPARISON_UNIFORM_COMPLEX; +"SERIES_COMPLEX_DIV",SERIES_COMPLEX_DIV; +"SERIES_COMPLEX_LMUL",SERIES_COMPLEX_LMUL; +"SERIES_COMPLEX_RMUL",SERIES_COMPLEX_RMUL; +"SERIES_COMPONENT",SERIES_COMPONENT; +"SERIES_CX_LIFT",SERIES_CX_LIFT; +"SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX",SERIES_DIFFERENTIABLE_COMPARISON_COMPLEX; +"SERIES_DIFFS",SERIES_DIFFS; +"SERIES_DIRICHLET",SERIES_DIRICHLET; +"SERIES_DIRICHLET_BILINEAR",SERIES_DIRICHLET_BILINEAR; +"SERIES_DIRICHLET_COMPLEX",SERIES_DIRICHLET_COMPLEX; +"SERIES_DIRICHLET_COMPLEX_EXPLICIT",SERIES_DIRICHLET_COMPLEX_EXPLICIT; +"SERIES_DIRICHLET_COMPLEX_GEN",SERIES_DIRICHLET_COMPLEX_GEN; +"SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT",SERIES_DIRICHLET_COMPLEX_VERY_EXPLICIT; +"SERIES_DROP_LE",SERIES_DROP_LE; +"SERIES_DROP_POS",SERIES_DROP_POS; +"SERIES_FINITE",SERIES_FINITE; +"SERIES_FINITE_SUPPORT",SERIES_FINITE_SUPPORT; +"SERIES_FROM",SERIES_FROM; +"SERIES_GOESTOZERO",SERIES_GOESTOZERO; +"SERIES_INJECTIVE_IMAGE",SERIES_INJECTIVE_IMAGE; +"SERIES_INJECTIVE_IMAGE_STRONG",SERIES_INJECTIVE_IMAGE_STRONG; +"SERIES_LIFT_ABSCONV_IMP_CONV",SERIES_LIFT_ABSCONV_IMP_CONV; +"SERIES_LINEAR",SERIES_LINEAR; +"SERIES_NEG",SERIES_NEG; +"SERIES_RATIO",SERIES_RATIO; +"SERIES_REARRANGE",SERIES_REARRANGE; +"SERIES_REARRANGE_EQ",SERIES_REARRANGE_EQ; +"SERIES_RESTRICT",SERIES_RESTRICT; +"SERIES_SUB",SERIES_SUB; +"SERIES_SUBSET",SERIES_SUBSET; +"SERIES_TERMS_TOZERO",SERIES_TERMS_TOZERO; +"SERIES_TRIVIAL",SERIES_TRIVIAL; +"SERIES_UNIQUE",SERIES_UNIQUE; +"SERIES_VSUM",SERIES_VSUM; +"SETCODE_BOUNDS",SETCODE_BOUNDS; +"SETDIST_BALLS",SETDIST_BALLS; +"SETDIST_CLOSED_COMPACT",SETDIST_CLOSED_COMPACT; +"SETDIST_CLOSEST_POINT",SETDIST_CLOSEST_POINT; +"SETDIST_CLOSURE",SETDIST_CLOSURE; +"SETDIST_COMPACT_CLOSED",SETDIST_COMPACT_CLOSED; +"SETDIST_DIFFERENCES",SETDIST_DIFFERENCES; +"SETDIST_EMPTY",SETDIST_EMPTY; +"SETDIST_EQ_0_BOUNDED",SETDIST_EQ_0_BOUNDED; +"SETDIST_EQ_0_CLOSED",SETDIST_EQ_0_CLOSED; +"SETDIST_EQ_0_CLOSED_COMPACT",SETDIST_EQ_0_CLOSED_COMPACT; +"SETDIST_EQ_0_CLOSED_IN",SETDIST_EQ_0_CLOSED_IN; +"SETDIST_EQ_0_COMPACT_CLOSED",SETDIST_EQ_0_COMPACT_CLOSED; +"SETDIST_EQ_0_SING",SETDIST_EQ_0_SING; +"SETDIST_LE_DIST",SETDIST_LE_DIST; +"SETDIST_LE_HAUSDIST",SETDIST_LE_HAUSDIST; +"SETDIST_LE_SING",SETDIST_LE_SING; +"SETDIST_LINEAR_IMAGE",SETDIST_LINEAR_IMAGE; +"SETDIST_LIPSCHITZ",SETDIST_LIPSCHITZ; +"SETDIST_POS_LE",SETDIST_POS_LE; +"SETDIST_REFL",SETDIST_REFL; +"SETDIST_SINGS",SETDIST_SINGS; +"SETDIST_SING_IN_SET",SETDIST_SING_IN_SET; +"SETDIST_SING_LE_HAUSDIST",SETDIST_SING_LE_HAUSDIST; +"SETDIST_SING_TRIANGLE",SETDIST_SING_TRIANGLE; +"SETDIST_SUBSET_LEFT",SETDIST_SUBSET_LEFT; +"SETDIST_SUBSET_RIGHT",SETDIST_SUBSET_RIGHT; +"SETDIST_SYM",SETDIST_SYM; +"SETDIST_TRANSLATION",SETDIST_TRANSLATION; +"SETDIST_TRIANGLE",SETDIST_TRIANGLE; +"SETDIST_UNIQUE",SETDIST_UNIQUE; +"SETSPEC",SETSPEC; +"SETVARIATION_EQUAL_LEMMA",SETVARIATION_EQUAL_LEMMA; +"SET_CASES",SET_CASES; +"SET_DIFF_FRONTIER",SET_DIFF_FRONTIER; +"SET_OF_LIST_APPEND",SET_OF_LIST_APPEND; +"SET_OF_LIST_EQ_EMPTY",SET_OF_LIST_EQ_EMPTY; +"SET_OF_LIST_MAP",SET_OF_LIST_MAP; +"SET_OF_LIST_OF_SET",SET_OF_LIST_OF_SET; +"SET_PAIR_THM",SET_PAIR_THM; +"SET_PROVE_CASES",SET_PROVE_CASES; +"SET_RECURSION_LEMMA",SET_RECURSION_LEMMA; +"SET_VARIATION",SET_VARIATION; +"SET_VARIATION_0",SET_VARIATION_0; +"SET_VARIATION_ELEMENTARY_LEMMA",SET_VARIATION_ELEMENTARY_LEMMA; +"SET_VARIATION_EQ",SET_VARIATION_EQ; +"SET_VARIATION_GE_FUNCTION",SET_VARIATION_GE_FUNCTION; +"SET_VARIATION_LBOUND",SET_VARIATION_LBOUND; +"SET_VARIATION_LBOUND_ON_INTERVAL",SET_VARIATION_LBOUND_ON_INTERVAL; +"SET_VARIATION_MONOTONE",SET_VARIATION_MONOTONE; +"SET_VARIATION_ON_DIVISION",SET_VARIATION_ON_DIVISION; +"SET_VARIATION_ON_ELEMENTARY",SET_VARIATION_ON_ELEMENTARY; +"SET_VARIATION_ON_INTERVAL",SET_VARIATION_ON_INTERVAL; +"SET_VARIATION_ON_NULL",SET_VARIATION_ON_NULL; +"SET_VARIATION_POS_LE",SET_VARIATION_POS_LE; +"SET_VARIATION_REFLECT2",SET_VARIATION_REFLECT2; +"SET_VARIATION_TRANSLATION2",SET_VARIATION_TRANSLATION2; +"SET_VARIATION_TRIANGLE",SET_VARIATION_TRIANGLE; +"SET_VARIATION_UBOUND",SET_VARIATION_UBOUND; +"SET_VARIATION_UBOUND_ON_INTERVAL",SET_VARIATION_UBOUND_ON_INTERVAL; +"SET_VARIATION_WORKS_ON_INTERVAL",SET_VARIATION_WORKS_ON_INTERVAL; +"SHIFTPATH_LINEAR_IMAGE",SHIFTPATH_LINEAR_IMAGE; +"SHIFTPATH_SHIFTPATH",SHIFTPATH_SHIFTPATH; +"SHIFTPATH_TRANSLATION",SHIFTPATH_TRANSLATION; +"SHIFTPATH_TRIVIAL",SHIFTPATH_TRIVIAL; +"SIGMA_COMPACT",SIGMA_COMPACT; +"SIGN_COMPOSE",SIGN_COMPOSE; +"SIGN_I",SIGN_I; +"SIGN_IDEMPOTENT",SIGN_IDEMPOTENT; +"SIGN_INVERSE",SIGN_INVERSE; +"SIGN_NZ",SIGN_NZ; +"SIGN_SWAP",SIGN_SWAP; +"SIMPLEX",SIMPLEX; +"SIMPLEX_DIM_GE",SIMPLEX_DIM_GE; +"SIMPLEX_EMPTY",SIMPLEX_EMPTY; +"SIMPLEX_EXPLICIT",SIMPLEX_EXPLICIT; +"SIMPLEX_EXTREMAL_LE",SIMPLEX_EXTREMAL_LE; +"SIMPLEX_EXTREMAL_LE_EXISTS",SIMPLEX_EXTREMAL_LE_EXISTS; +"SIMPLEX_EXTREME_POINTS",SIMPLEX_EXTREME_POINTS; +"SIMPLEX_FACE_OF_SIMPLEX",SIMPLEX_FACE_OF_SIMPLEX; +"SIMPLEX_FURTHEST_LE",SIMPLEX_FURTHEST_LE; +"SIMPLEX_FURTHEST_LE_EXISTS",SIMPLEX_FURTHEST_LE_EXISTS; +"SIMPLEX_FURTHEST_LT",SIMPLEX_FURTHEST_LT; +"SIMPLEX_IMP_POLYTOPE",SIMPLEX_IMP_POLYTOPE; +"SIMPLEX_MINUS_1",SIMPLEX_MINUS_1; +"SIMPLEX_TOP_FACE",SIMPLEX_TOP_FACE; +"SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE",SIMPLE_CLOSED_PATH_ABS_WINDING_NUMBER_INSIDE; +"SIMPLE_CLOSED_PATH_NORM_WINDING_NUMBER_INSIDE",SIMPLE_CLOSED_PATH_NORM_WINDING_NUMBER_INSIDE; +"SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES",SIMPLE_CLOSED_PATH_WINDING_NUMBER_CASES; +"SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE",SIMPLE_CLOSED_PATH_WINDING_NUMBER_INSIDE; +"SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS",SIMPLE_CLOSED_PATH_WINDING_NUMBER_POS; +"SIMPLE_IMAGE",SIMPLE_IMAGE; +"SIMPLE_IMAGE_GEN",SIMPLE_IMAGE_GEN; +"SIMPLE_PATH_ASSOC",SIMPLE_PATH_ASSOC; +"SIMPLE_PATH_CASES",SIMPLE_PATH_CASES; +"SIMPLE_PATH_CIRCLEPATH",SIMPLE_PATH_CIRCLEPATH; +"SIMPLE_PATH_ENDLESS",SIMPLE_PATH_ENDLESS; +"SIMPLE_PATH_EQ_ARC",SIMPLE_PATH_EQ_ARC; +"SIMPLE_PATH_IMP_ARC",SIMPLE_PATH_IMP_ARC; +"SIMPLE_PATH_IMP_PATH",SIMPLE_PATH_IMP_PATH; +"SIMPLE_PATH_JOIN_IMP",SIMPLE_PATH_JOIN_IMP; +"SIMPLE_PATH_JOIN_LOOP",SIMPLE_PATH_JOIN_LOOP; +"SIMPLE_PATH_JOIN_LOOP_EQ",SIMPLE_PATH_JOIN_LOOP_EQ; +"SIMPLE_PATH_LINEAR_IMAGE_EQ",SIMPLE_PATH_LINEAR_IMAGE_EQ; +"SIMPLE_PATH_LINEPATH",SIMPLE_PATH_LINEPATH; +"SIMPLE_PATH_LINEPATH_EQ",SIMPLE_PATH_LINEPATH_EQ; +"SIMPLE_PATH_PARTCIRCLEPATH",SIMPLE_PATH_PARTCIRCLEPATH; +"SIMPLE_PATH_REVERSEPATH",SIMPLE_PATH_REVERSEPATH; +"SIMPLE_PATH_SHIFTPATH",SIMPLE_PATH_SHIFTPATH; +"SIMPLE_PATH_SUBPATH",SIMPLE_PATH_SUBPATH; +"SIMPLE_PATH_SUBPATH_EQ",SIMPLE_PATH_SUBPATH_EQ; +"SIMPLE_PATH_SYM",SIMPLE_PATH_SYM; +"SIMPLE_PATH_TRANSLATION_EQ",SIMPLE_PATH_TRANSLATION_EQ; +"SIMPLICIAL_COMPLEX_IMP_TRIANGULATION",SIMPLICIAL_COMPLEX_IMP_TRIANGULATION; +"SIMPLY_CONNECTED_CONVEX_DIFF_FINITE",SIMPLY_CONNECTED_CONVEX_DIFF_FINITE; +"SIMPLY_CONNECTED_EMPTY",SIMPLY_CONNECTED_EMPTY; +"SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC",SIMPLY_CONNECTED_EQ_BIHOLOMORPHIC_TO_DISC; +"SIMPLY_CONNECTED_EQ_BORSUKIAN",SIMPLY_CONNECTED_EQ_BORSUKIAN; +"SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG",SIMPLY_CONNECTED_EQ_CONTINUOUS_LOG; +"SIMPLY_CONNECTED_EQ_CONTINUOUS_SQRT",SIMPLY_CONNECTED_EQ_CONTINUOUS_SQRT; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; +"SIMPLY_CONNECTED_EQ_EMPTY_INSIDE",SIMPLY_CONNECTED_EQ_EMPTY_INSIDE; +"SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES",SIMPLY_CONNECTED_EQ_FRONTIER_PROPERTIES; +"SIMPLY_CONNECTED_EQ_GLOBAL_PRIMITIVE",SIMPLY_CONNECTED_EQ_GLOBAL_PRIMITIVE; +"SIMPLY_CONNECTED_EQ_HOLOMORPHIC_LOG",SIMPLY_CONNECTED_EQ_HOLOMORPHIC_LOG; +"SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT",SIMPLY_CONNECTED_EQ_HOLOMORPHIC_SQRT; +"SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC",SIMPLY_CONNECTED_EQ_HOMEOMORPHIC_TO_DISC; +"SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS",SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS; +"SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS",SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS; +"SIMPLY_CONNECTED_EQ_INJECTIVE_HOLOMORPHIC_SQRT",SIMPLY_CONNECTED_EQ_INJECTIVE_HOLOMORPHIC_SQRT; +"SIMPLY_CONNECTED_EQ_PATH_INTEGRAL_ZERO",SIMPLY_CONNECTED_EQ_PATH_INTEGRAL_ZERO; +"SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS",SIMPLY_CONNECTED_EQ_UNBOUNDED_COMPLEMENT_COMPONENTS; +"SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO",SIMPLY_CONNECTED_EQ_WINDING_NUMBER_ZERO; +"SIMPLY_CONNECTED_IFF_SIMPLE",SIMPLY_CONNECTED_IFF_SIMPLE; +"SIMPLY_CONNECTED_IMP_BORSUKIAN",SIMPLY_CONNECTED_IMP_BORSUKIAN; +"SIMPLY_CONNECTED_IMP_CONNECTED",SIMPLY_CONNECTED_IMP_CONNECTED; +"SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG",SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG; +"SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT",SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT; +"SIMPLY_CONNECTED_IMP_PATH_CONNECTED",SIMPLY_CONNECTED_IMP_PATH_CONNECTED; +"SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO",SIMPLY_CONNECTED_IMP_WINDING_NUMBER_ZERO; +"SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE",SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE; +"SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH",SIMPLY_CONNECTED_INSIDE_SIMPLE_PATH; +"SIMPLY_CONNECTED_INTER",SIMPLY_CONNECTED_INTER; +"SIMPLY_CONNECTED_PCROSS",SIMPLY_CONNECTED_PCROSS; +"SIMPLY_CONNECTED_PCROSS_EQ",SIMPLY_CONNECTED_PCROSS_EQ; +"SIMPLY_CONNECTED_PUNCTURED_CONVEX",SIMPLY_CONNECTED_PUNCTURED_CONVEX; +"SIMPLY_CONNECTED_PUNCTURED_UNIVERSE",SIMPLY_CONNECTED_PUNCTURED_UNIVERSE; +"SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ",SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ; +"SIMPLY_CONNECTED_RETRACTION_GEN",SIMPLY_CONNECTED_RETRACTION_GEN; +"SIMPLY_CONNECTED_SPHERE",SIMPLY_CONNECTED_SPHERE; +"SIMPLY_CONNECTED_SPHERE_EQ",SIMPLY_CONNECTED_SPHERE_EQ; +"SIMPLY_CONNECTED_SPHERE_GEN",SIMPLY_CONNECTED_SPHERE_GEN; +"SIMPLY_CONNECTED_TRANSLATION",SIMPLY_CONNECTED_TRANSLATION; +"SIMPLY_CONNECTED_UNION",SIMPLY_CONNECTED_UNION; +"SINCOS_PRINCIPAL_VALUE",SINCOS_PRINCIPAL_VALUE; +"SINCOS_TOTAL_2PI",SINCOS_TOTAL_2PI; +"SINCOS_TOTAL_PI",SINCOS_TOTAL_PI; +"SINCOS_TOTAL_PI2",SINCOS_TOTAL_PI2; +"SING",SING; +"SING_GSPEC",SING_GSPEC; +"SING_SUBSET",SING_SUBSET; +"SIN_0",SIN_0; +"SIN_ACS",SIN_ACS; +"SIN_ACS_NZ",SIN_ACS_NZ; +"SIN_ADD",SIN_ADD; +"SIN_ASN",SIN_ASN; +"SIN_ATN",SIN_ATN; +"SIN_BOUND",SIN_BOUND; +"SIN_BOUNDS",SIN_BOUNDS; +"SIN_CIRCLE",SIN_CIRCLE; +"SIN_COS",SIN_COS; +"SIN_COS_EQ",SIN_COS_EQ; +"SIN_COS_INJ",SIN_COS_INJ; +"SIN_COS_SQRT",SIN_COS_SQRT; +"SIN_DOUBLE",SIN_DOUBLE; +"SIN_EQ",SIN_EQ; +"SIN_EQ_0",SIN_EQ_0; +"SIN_EQ_0_PI",SIN_EQ_0_PI; +"SIN_EQ_1",SIN_EQ_1; +"SIN_EQ_MINUS1",SIN_EQ_MINUS1; +"SIN_HASZERO",SIN_HASZERO; +"SIN_HASZERO_MINIMAL",SIN_HASZERO_MINIMAL; +"SIN_INJ_PI",SIN_INJ_PI; +"SIN_INTEGER_2PI",SIN_INTEGER_2PI; +"SIN_INTEGER_PI",SIN_INTEGER_PI; +"SIN_MONO_LE",SIN_MONO_LE; +"SIN_MONO_LE_EQ",SIN_MONO_LE_EQ; +"SIN_MONO_LT",SIN_MONO_LT; +"SIN_MONO_LT_EQ",SIN_MONO_LT_EQ; +"SIN_NEARZERO",SIN_NEARZERO; +"SIN_NEG",SIN_NEG; +"SIN_NONTRIVIAL",SIN_NONTRIVIAL; +"SIN_NPI",SIN_NPI; +"SIN_PERIODIC",SIN_PERIODIC; +"SIN_PERIODIC_PI",SIN_PERIODIC_PI; +"SIN_PI",SIN_PI; +"SIN_PI2",SIN_PI2; +"SIN_PI6",SIN_PI6; +"SIN_PI6_STRADDLE",SIN_PI6_STRADDLE; +"SIN_PIMUL_EQ_0",SIN_PIMUL_EQ_0; +"SIN_POS_PI",SIN_POS_PI; +"SIN_POS_PI2",SIN_POS_PI2; +"SIN_POS_PI_LE",SIN_POS_PI_LE; +"SIN_POS_PI_REV",SIN_POS_PI_REV; +"SIN_SUB",SIN_SUB; +"SIN_TAN",SIN_TAN; +"SIN_TOTAL_POS",SIN_TOTAL_POS; +"SIN_ZERO",SIN_ZERO; +"SIN_ZERO_PI",SIN_ZERO_PI; +"SKOLEM_THM",SKOLEM_THM; +"SKOLEM_THM_GEN",SKOLEM_THM_GEN; +"SLICE_BALL",SLICE_BALL; +"SLICE_CBALL",SLICE_CBALL; +"SLICE_DIFF",SLICE_DIFF; +"SLICE_EMPTY",SLICE_EMPTY; +"SLICE_INTER",SLICE_INTER; +"SLICE_INTERVAL",SLICE_INTERVAL; +"SLICE_SUBSET",SLICE_SUBSET; +"SLICE_UNION",SLICE_UNION; +"SLICE_UNIONS",SLICE_UNIONS; +"SLICE_UNIV",SLICE_UNIV; +"SND",SND; +"SNDCART_ADD",SNDCART_ADD; +"SNDCART_CMUL",SNDCART_CMUL; +"SNDCART_NEG",SNDCART_NEG; +"SNDCART_PASTECART",SNDCART_PASTECART; +"SNDCART_SUB",SNDCART_SUB; +"SNDCART_VEC",SNDCART_VEC; +"SNDCART_VSUM",SNDCART_VSUM; +"SND_DEF",SND_DEF; +"SPANNING_SUBSET_INDEPENDENT",SPANNING_SUBSET_INDEPENDENT; +"SPANNING_SURJECTIVE_IMAGE",SPANNING_SURJECTIVE_IMAGE; +"SPANS_IMAGE",SPANS_IMAGE; +"SPAN_0",SPAN_0; +"SPAN_2",SPAN_2; +"SPAN_3",SPAN_3; +"SPAN_ADD",SPAN_ADD; +"SPAN_ADD_EQ",SPAN_ADD_EQ; +"SPAN_BREAKDOWN",SPAN_BREAKDOWN; +"SPAN_BREAKDOWN_EQ",SPAN_BREAKDOWN_EQ; +"SPAN_CARD_GE_DIM",SPAN_CARD_GE_DIM; +"SPAN_CLAUSES",SPAN_CLAUSES; +"SPAN_CONVEX_CONE_ALLSIGNS",SPAN_CONVEX_CONE_ALLSIGNS; +"SPAN_DELETE_0",SPAN_DELETE_0; +"SPAN_EMPTY",SPAN_EMPTY; +"SPAN_EQ",SPAN_EQ; +"SPAN_EQ_DIM",SPAN_EQ_DIM; +"SPAN_EQ_INSERT",SPAN_EQ_INSERT; +"SPAN_EQ_SELF",SPAN_EQ_SELF; +"SPAN_EXPLICIT",SPAN_EXPLICIT; +"SPAN_FINITE",SPAN_FINITE; +"SPAN_IMAGE_SCALE",SPAN_IMAGE_SCALE; +"SPAN_INC",SPAN_INC; +"SPAN_INDUCT",SPAN_INDUCT; +"SPAN_INDUCT_ALT",SPAN_INDUCT_ALT; +"SPAN_INSERT_0",SPAN_INSERT_0; +"SPAN_LINEAR_IMAGE",SPAN_LINEAR_IMAGE; +"SPAN_MBASIS",SPAN_MBASIS; +"SPAN_MONO",SPAN_MONO; +"SPAN_MUL",SPAN_MUL; +"SPAN_MUL_EQ",SPAN_MUL_EQ; +"SPAN_NEG",SPAN_NEG; +"SPAN_NEG_EQ",SPAN_NEG_EQ; +"SPAN_NOT_UNIV_ORTHOGONAL",SPAN_NOT_UNIV_ORTHOGONAL; +"SPAN_NOT_UNIV_SUBSET_HYPERPLANE",SPAN_NOT_UNIV_SUBSET_HYPERPLANE; +"SPAN_OF_SUBSPACE",SPAN_OF_SUBSPACE; +"SPAN_OPEN",SPAN_OPEN; +"SPAN_PCROSS",SPAN_PCROSS; +"SPAN_PCROSS_SUBSET",SPAN_PCROSS_SUBSET; +"SPAN_SING",SPAN_SING; +"SPAN_SPAN",SPAN_SPAN; +"SPAN_SPECIAL_SCALE",SPAN_SPECIAL_SCALE; +"SPAN_STDBASIS",SPAN_STDBASIS; +"SPAN_SUB",SPAN_SUB; +"SPAN_SUBSET_SUBSPACE",SPAN_SUBSET_SUBSPACE; +"SPAN_SUBSPACE",SPAN_SUBSPACE; +"SPAN_SUMS",SPAN_SUMS; +"SPAN_SUPERSET",SPAN_SUPERSET; +"SPAN_TRANS",SPAN_TRANS; +"SPAN_UNION",SPAN_UNION; +"SPAN_UNION_SUBSET",SPAN_UNION_SUBSET; +"SPAN_UNIV",SPAN_UNIV; +"SPAN_VSUM",SPAN_VSUM; +"SPECIAL_HYPERPLANE_SPAN",SPECIAL_HYPERPLANE_SPAN; +"SPHERE_1",SPHERE_1; +"SPHERE_EMPTY",SPHERE_EMPTY; +"SPHERE_EQ_EMPTY",SPHERE_EQ_EMPTY; +"SPHERE_EQ_SING",SPHERE_EQ_SING; +"SPHERE_LINEAR_IMAGE",SPHERE_LINEAR_IMAGE; +"SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; +"SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN; +"SPHERE_SING",SPHERE_SING; +"SPHERE_SUBSET_CBALL",SPHERE_SUBSET_CBALL; +"SPHERE_TRANSLATION",SPHERE_TRANSLATION; +"SPHERE_UNION_BALL",SPHERE_UNION_BALL; +"SPLIT_INSIDE_SIMPLE_CLOSED_CURVE",SPLIT_INSIDE_SIMPLE_CLOSED_CURVE; +"SQNORM_PASTECART",SQNORM_PASTECART; +"SQRT_0",SQRT_0; +"SQRT_1",SQRT_1; +"SQRT_DIV",SQRT_DIV; +"SQRT_EQ_0",SQRT_EQ_0; +"SQRT_EVEN_POW2",SQRT_EVEN_POW2; +"SQRT_INJ",SQRT_INJ; +"SQRT_INV",SQRT_INV; +"SQRT_LE_0",SQRT_LE_0; +"SQRT_LT_0",SQRT_LT_0; +"SQRT_MONO_LE",SQRT_MONO_LE; +"SQRT_MONO_LE_EQ",SQRT_MONO_LE_EQ; +"SQRT_MONO_LT",SQRT_MONO_LT; +"SQRT_MONO_LT_EQ",SQRT_MONO_LT_EQ; +"SQRT_MUL",SQRT_MUL; +"SQRT_NEG",SQRT_NEG; +"SQRT_POS_LE",SQRT_POS_LE; +"SQRT_POS_LT",SQRT_POS_LT; +"SQRT_POW2",SQRT_POW2; +"SQRT_POW_2",SQRT_POW_2; +"SQRT_PRODUCT",SQRT_PRODUCT; +"SQRT_UNIQUE",SQRT_UNIQUE; +"SQRT_UNIQUE_GEN",SQRT_UNIQUE_GEN; +"SQRT_WORKS",SQRT_WORKS; +"SQRT_WORKS_GEN",SQRT_WORKS_GEN; +"SQUARE_BOUND_LEMMA",SQUARE_BOUND_LEMMA; +"SQUARE_CONTINUOUS",SQUARE_CONTINUOUS; +"STARLIKE_CLOSURE",STARLIKE_CLOSURE; +"STARLIKE_COMPACT_PROJECTIVE",STARLIKE_COMPACT_PROJECTIVE; +"STARLIKE_CONVEX_SUBSET",STARLIKE_CONVEX_SUBSET; +"STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS",STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS; +"STARLIKE_IMP_BORSUKIAN",STARLIKE_IMP_BORSUKIAN; +"STARLIKE_IMP_CONNECTED",STARLIKE_IMP_CONNECTED; +"STARLIKE_IMP_CONTRACTIBLE",STARLIKE_IMP_CONTRACTIBLE; +"STARLIKE_IMP_CONTRACTIBLE_GEN",STARLIKE_IMP_CONTRACTIBLE_GEN; +"STARLIKE_IMP_PATH_CONNECTED",STARLIKE_IMP_PATH_CONNECTED; +"STARLIKE_IMP_SIMPLY_CONNECTED",STARLIKE_IMP_SIMPLY_CONNECTED; +"STARLIKE_LINEAR_IMAGE",STARLIKE_LINEAR_IMAGE; +"STARLIKE_LINEAR_IMAGE_EQ",STARLIKE_LINEAR_IMAGE_EQ; +"STARLIKE_NEGLIGIBLE",STARLIKE_NEGLIGIBLE; +"STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE",STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE; +"STARLIKE_NEGLIGIBLE_LEMMA",STARLIKE_NEGLIGIBLE_LEMMA; +"STARLIKE_NEGLIGIBLE_STRONG",STARLIKE_NEGLIGIBLE_STRONG; +"STARLIKE_PCROSS",STARLIKE_PCROSS; +"STARLIKE_PCROSS_EQ",STARLIKE_PCROSS_EQ; +"STARLIKE_TRANSLATION_EQ",STARLIKE_TRANSLATION_EQ; +"STARLIKE_UNIV",STARLIKE_UNIV; +"STD_SIMPLEX",STD_SIMPLEX; +"STEINHAUS",STEINHAUS; +"STEINHAUS_LEBESGUE",STEINHAUS_LEBESGUE; +"STEINHAUS_TRIVIAL",STEINHAUS_TRIVIAL; +"STONE_WEIERSTRASS",STONE_WEIERSTRASS; +"STONE_WEIERSTRASS_ALT",STONE_WEIERSTRASS_ALT; +"STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION",STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION; +"STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION",STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION; +"STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE",STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE; +"STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE",STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE; +"STRETCH_GALOIS",STRETCH_GALOIS; +"SUB",SUB; +"SUBADDITIVE_CONTENT_DIVISION",SUBADDITIVE_CONTENT_DIVISION; +"SUBORDINATE_PARTITION_OF_UNITY",SUBORDINATE_PARTITION_OF_UNITY; +"SUBPATH_LINEAR_IMAGE",SUBPATH_LINEAR_IMAGE; +"SUBPATH_REFL",SUBPATH_REFL; +"SUBPATH_REVERSEPATH",SUBPATH_REVERSEPATH; +"SUBPATH_SCALING_LEMMA",SUBPATH_SCALING_LEMMA; +"SUBPATH_TO_FRONTIER",SUBPATH_TO_FRONTIER; +"SUBPATH_TO_FRONTIER_EXPLICIT",SUBPATH_TO_FRONTIER_EXPLICIT; +"SUBPATH_TO_FRONTIER_STRONG",SUBPATH_TO_FRONTIER_STRONG; +"SUBPATH_TRANSLATION",SUBPATH_TRANSLATION; +"SUBPATH_TRIVIAL",SUBPATH_TRIVIAL; +"SUBSEQUENCE_DIAGONALIZATION_LEMMA",SUBSEQUENCE_DIAGONALIZATION_LEMMA; +"SUBSET",SUBSET; +"SUBSET_ANTISYM",SUBSET_ANTISYM; +"SUBSET_ANTISYM_EQ",SUBSET_ANTISYM_EQ; +"SUBSET_BALL",SUBSET_BALL; +"SUBSET_BALLS",SUBSET_BALLS; +"SUBSET_CARD_EQ",SUBSET_CARD_EQ; +"SUBSET_CBALL",SUBSET_CBALL; +"SUBSET_CLOSURE",SUBSET_CLOSURE; +"SUBSET_CONTINUOUS_IMAGE_SEGMENT_1",SUBSET_CONTINUOUS_IMAGE_SEGMENT_1; +"SUBSET_DELETE",SUBSET_DELETE; +"SUBSET_DIFF",SUBSET_DIFF; +"SUBSET_DROP_IMAGE",SUBSET_DROP_IMAGE; +"SUBSET_EMPTY",SUBSET_EMPTY; +"SUBSET_FACE_OF_SIMPLEX",SUBSET_FACE_OF_SIMPLEX; +"SUBSET_HULL",SUBSET_HULL; +"SUBSET_HYPERPLANES",SUBSET_HYPERPLANES; +"SUBSET_IMAGE",SUBSET_IMAGE; +"SUBSET_INSERT",SUBSET_INSERT; +"SUBSET_INSERT_DELETE",SUBSET_INSERT_DELETE; +"SUBSET_INTER",SUBSET_INTER; +"SUBSET_INTERIOR",SUBSET_INTERIOR; +"SUBSET_INTERS",SUBSET_INTERS; +"SUBSET_INTERVAL",SUBSET_INTERVAL; +"SUBSET_INTERVAL_1",SUBSET_INTERVAL_1; +"SUBSET_INTERVAL_IMP",SUBSET_INTERVAL_IMP; +"SUBSET_INTER_ABSORPTION",SUBSET_INTER_ABSORPTION; +"SUBSET_LE_DIM",SUBSET_LE_DIM; +"SUBSET_LIFT_IMAGE",SUBSET_LIFT_IMAGE; +"SUBSET_NUMSEG",SUBSET_NUMSEG; +"SUBSET_OF_FACE_OF",SUBSET_OF_FACE_OF; +"SUBSET_PATH_IMAGE_JOIN",SUBSET_PATH_IMAGE_JOIN; +"SUBSET_PCROSS",SUBSET_PCROSS; +"SUBSET_PRED",SUBSET_PRED; +"SUBSET_PSUBSET_TRANS",SUBSET_PSUBSET_TRANS; +"SUBSET_REAL_INTERVAL",SUBSET_REAL_INTERVAL; +"SUBSET_REFL",SUBSET_REFL; +"SUBSET_RELATIVE_INTERIOR",SUBSET_RELATIVE_INTERIOR; +"SUBSET_RESTRICT",SUBSET_RESTRICT; +"SUBSET_SECOND_COUNTABLE",SUBSET_SECOND_COUNTABLE; +"SUBSET_SEGMENT",SUBSET_SEGMENT; +"SUBSET_SEGMENT_OPEN_CLOSED",SUBSET_SEGMENT_OPEN_CLOSED; +"SUBSET_SUMS_LCANCEL",SUBSET_SUMS_LCANCEL; +"SUBSET_SUMS_RCANCEL",SUBSET_SUMS_RCANCEL; +"SUBSET_TRANS",SUBSET_TRANS; +"SUBSET_UNION",SUBSET_UNION; +"SUBSET_UNIONS",SUBSET_UNIONS; +"SUBSET_UNION_ABSORPTION",SUBSET_UNION_ABSORPTION; +"SUBSET_UNIV",SUBSET_UNIV; +"SUBSPACE_0",SUBSPACE_0; +"SUBSPACE_ADD",SUBSPACE_ADD; +"SUBSPACE_BOUNDED_EQ_TRIVIAL",SUBSPACE_BOUNDED_EQ_TRIVIAL; +"SUBSPACE_CONVEX_CONE_SYMMETRIC",SUBSPACE_CONVEX_CONE_SYMMETRIC; +"SUBSPACE_HYPERPLANE",SUBSPACE_HYPERPLANE; +"SUBSPACE_IMP_AFFINE",SUBSPACE_IMP_AFFINE; +"SUBSPACE_IMP_CONIC",SUBSPACE_IMP_CONIC; +"SUBSPACE_IMP_CONVEX",SUBSPACE_IMP_CONVEX; +"SUBSPACE_IMP_CONVEX_CONE",SUBSPACE_IMP_CONVEX_CONE; +"SUBSPACE_IMP_NONEMPTY",SUBSPACE_IMP_NONEMPTY; +"SUBSPACE_INTER",SUBSPACE_INTER; +"SUBSPACE_INTERS",SUBSPACE_INTERS; +"SUBSPACE_ISOMORPHISM",SUBSPACE_ISOMORPHISM; +"SUBSPACE_KERNEL",SUBSPACE_KERNEL; +"SUBSPACE_LINEAR_FIXED_POINTS",SUBSPACE_LINEAR_FIXED_POINTS; +"SUBSPACE_LINEAR_IMAGE",SUBSPACE_LINEAR_IMAGE; +"SUBSPACE_LINEAR_IMAGE_EQ",SUBSPACE_LINEAR_IMAGE_EQ; +"SUBSPACE_LINEAR_PREIMAGE",SUBSPACE_LINEAR_PREIMAGE; +"SUBSPACE_MUL",SUBSPACE_MUL; +"SUBSPACE_NEG",SUBSPACE_NEG; +"SUBSPACE_ORTHOGONAL_TO_VECTOR",SUBSPACE_ORTHOGONAL_TO_VECTOR; +"SUBSPACE_ORTHOGONAL_TO_VECTORS",SUBSPACE_ORTHOGONAL_TO_VECTORS; +"SUBSPACE_PCROSS",SUBSPACE_PCROSS; +"SUBSPACE_PCROSS_EQ",SUBSPACE_PCROSS_EQ; +"SUBSPACE_SPAN",SUBSPACE_SPAN; +"SUBSPACE_SPECIAL_HYPERPLANE",SUBSPACE_SPECIAL_HYPERPLANE; +"SUBSPACE_SUB",SUBSPACE_SUB; +"SUBSPACE_SUBSTANDARD",SUBSPACE_SUBSTANDARD; +"SUBSPACE_SUMS",SUBSPACE_SUMS; +"SUBSPACE_TRANSLATION_SELF",SUBSPACE_TRANSLATION_SELF; +"SUBSPACE_TRANSLATION_SELF_EQ",SUBSPACE_TRANSLATION_SELF_EQ; +"SUBSPACE_TRIVIAL",SUBSPACE_TRIVIAL; +"SUBSPACE_UNION_CHAIN",SUBSPACE_UNION_CHAIN; +"SUBSPACE_UNIV",SUBSPACE_UNIV; +"SUBSPACE_VSUM",SUBSPACE_VSUM; +"SUBTOPOLOGY_SUPERSET",SUBTOPOLOGY_SUPERSET; +"SUBTOPOLOGY_TOPSPACE",SUBTOPOLOGY_TOPSPACE; +"SUBTOPOLOGY_UNIV",SUBTOPOLOGY_UNIV; +"SUB_0",SUB_0; +"SUB_ADD",SUB_ADD; +"SUB_ADD_LCANCEL",SUB_ADD_LCANCEL; +"SUB_ADD_RCANCEL",SUB_ADD_RCANCEL; +"SUB_ELIM_THM",SUB_ELIM_THM; +"SUB_ELIM_THM'",SUB_ELIM_THM'; +"SUB_EQ_0",SUB_EQ_0; +"SUB_PRESUC",SUB_PRESUC; +"SUB_REFL",SUB_REFL; +"SUB_SUC",SUB_SUC; +"SUC_DEF",SUC_DEF; +"SUC_INJ",SUC_INJ; +"SUC_SUB1",SUC_SUB1; +"SUMMABLE_0",SUMMABLE_0; +"SUMMABLE_ADD",SUMMABLE_ADD; +"SUMMABLE_BILINEAR_PARTIAL_PRE",SUMMABLE_BILINEAR_PARTIAL_PRE; +"SUMMABLE_CAUCHY",SUMMABLE_CAUCHY; +"SUMMABLE_CMUL",SUMMABLE_CMUL; +"SUMMABLE_COMPARISON",SUMMABLE_COMPARISON; +"SUMMABLE_COMPLEX_DIV",SUMMABLE_COMPLEX_DIV; +"SUMMABLE_COMPLEX_LMUL",SUMMABLE_COMPLEX_LMUL; +"SUMMABLE_COMPLEX_RMUL",SUMMABLE_COMPLEX_RMUL; +"SUMMABLE_COMPONENT",SUMMABLE_COMPONENT; +"SUMMABLE_EQ",SUMMABLE_EQ; +"SUMMABLE_EQ_COFINITE",SUMMABLE_EQ_COFINITE; +"SUMMABLE_EQ_EVENTUALLY",SUMMABLE_EQ_EVENTUALLY; +"SUMMABLE_FROM_ELSEWHERE",SUMMABLE_FROM_ELSEWHERE; +"SUMMABLE_GP",SUMMABLE_GP; +"SUMMABLE_IFF",SUMMABLE_IFF; +"SUMMABLE_IFF_COFINITE",SUMMABLE_IFF_COFINITE; +"SUMMABLE_IFF_EVENTUALLY",SUMMABLE_IFF_EVENTUALLY; +"SUMMABLE_IMP_BOUNDED",SUMMABLE_IMP_BOUNDED; +"SUMMABLE_IMP_SUMS_BOUNDED",SUMMABLE_IMP_SUMS_BOUNDED; +"SUMMABLE_IMP_TOZERO",SUMMABLE_IMP_TOZERO; +"SUMMABLE_LINEAR",SUMMABLE_LINEAR; +"SUMMABLE_NEG",SUMMABLE_NEG; +"SUMMABLE_REARRANGE",SUMMABLE_REARRANGE; +"SUMMABLE_REINDEX",SUMMABLE_REINDEX; +"SUMMABLE_RESTRICT",SUMMABLE_RESTRICT; +"SUMMABLE_SUB",SUMMABLE_SUB; +"SUMMABLE_SUBSET",SUMMABLE_SUBSET; +"SUMMABLE_SUBSET_ABSCONV",SUMMABLE_SUBSET_ABSCONV; +"SUMMABLE_SUBSET_COMPLEX",SUMMABLE_SUBSET_COMPLEX; +"SUMMABLE_TRIVIAL",SUMMABLE_TRIVIAL; +"SUMMABLE_ZETA_INTEGER",SUMMABLE_ZETA_INTEGER; +"SUMS_0",SUMS_0; +"SUMS_ASSOC",SUMS_ASSOC; +"SUMS_CNJ",SUMS_CNJ; +"SUMS_COMPLEX_0",SUMS_COMPLEX_0; +"SUMS_EQ",SUMS_EQ; +"SUMS_FINITE_DIFF",SUMS_FINITE_DIFF; +"SUMS_FINITE_UNION",SUMS_FINITE_UNION; +"SUMS_GP",SUMS_GP; +"SUMS_IFF",SUMS_IFF; +"SUMS_INFSUM",SUMS_INFSUM; +"SUMS_INTERVALS",SUMS_INTERVALS; +"SUMS_LIM",SUMS_LIM; +"SUMS_OFFSET",SUMS_OFFSET; +"SUMS_OFFSET_REV",SUMS_OFFSET_REV; +"SUMS_REINDEX",SUMS_REINDEX; +"SUMS_REINDEX_GEN",SUMS_REINDEX_GEN; +"SUMS_SUMMABLE",SUMS_SUMMABLE; +"SUMS_SYM",SUMS_SYM; +"SUM_0",SUM_0; +"SUM_1",SUM_1; +"SUM_2",SUM_2; +"SUM_3",SUM_3; +"SUM_4",SUM_4; +"SUM_ABS",SUM_ABS; +"SUM_ABS_BOUND",SUM_ABS_BOUND; +"SUM_ABS_LE",SUM_ABS_LE; +"SUM_ABS_NUMSEG",SUM_ABS_NUMSEG; +"SUM_ADD",SUM_ADD; +"SUM_ADD_GEN",SUM_ADD_GEN; +"SUM_ADD_NUMSEG",SUM_ADD_NUMSEG; +"SUM_ADD_SPLIT",SUM_ADD_SPLIT; +"SUM_BERNSTEIN",SUM_BERNSTEIN; +"SUM_BIJECTION",SUM_BIJECTION; +"SUM_BOUND",SUM_BOUND; +"SUM_BOUND_GEN",SUM_BOUND_GEN; +"SUM_BOUND_LT",SUM_BOUND_LT; +"SUM_BOUND_LT_ALL",SUM_BOUND_LT_ALL; +"SUM_BOUND_LT_GEN",SUM_BOUND_LT_GEN; +"SUM_CASES",SUM_CASES; +"SUM_CASES_1",SUM_CASES_1; +"SUM_CLAUSES",SUM_CLAUSES; +"SUM_CLAUSES_LEFT",SUM_CLAUSES_LEFT; +"SUM_CLAUSES_NUMSEG",SUM_CLAUSES_NUMSEG; +"SUM_CLAUSES_RIGHT",SUM_CLAUSES_RIGHT; +"SUM_CLOSED",SUM_CLOSED; +"SUM_COMBINE_L",SUM_COMBINE_L; +"SUM_COMBINE_R",SUM_COMBINE_R; +"SUM_CONST",SUM_CONST; +"SUM_CONST_NUMSEG",SUM_CONST_NUMSEG; +"SUM_CONTENT_AREA_OVER_THIN_DIVISION",SUM_CONTENT_AREA_OVER_THIN_DIVISION; +"SUM_DEGENERATE",SUM_DEGENERATE; +"SUM_DELETE",SUM_DELETE; +"SUM_DELETE_CASES",SUM_DELETE_CASES; +"SUM_DELTA",SUM_DELTA; +"SUM_DIFF",SUM_DIFF; +"SUM_DIFFS",SUM_DIFFS; +"SUM_DIFFS_ALT",SUM_DIFFS_ALT; +"SUM_EQ",SUM_EQ; +"SUM_EQ_0",SUM_EQ_0; +"SUM_EQ_0_NUMSEG",SUM_EQ_0_NUMSEG; +"SUM_EQ_GENERAL",SUM_EQ_GENERAL; +"SUM_EQ_GENERAL_INVERSES",SUM_EQ_GENERAL_INVERSES; +"SUM_EQ_NUMSEG",SUM_EQ_NUMSEG; +"SUM_EQ_SUPERSET",SUM_EQ_SUPERSET; +"SUM_GP",SUM_GP; +"SUM_GP_BASIC",SUM_GP_BASIC; +"SUM_GP_MULTIPLIED",SUM_GP_MULTIPLIED; +"SUM_GP_OFFSET",SUM_GP_OFFSET; +"SUM_GROUP",SUM_GROUP; +"SUM_IMAGE",SUM_IMAGE; +"SUM_IMAGE_GEN",SUM_IMAGE_GEN; +"SUM_IMAGE_LE",SUM_IMAGE_LE; +"SUM_IMAGE_NONZERO",SUM_IMAGE_NONZERO; +"SUM_INCL_EXCL",SUM_INCL_EXCL; +"SUM_INJECTION",SUM_INJECTION; +"SUM_INTEGRAL_BOUNDS_DECREASING",SUM_INTEGRAL_BOUNDS_DECREASING; +"SUM_INTEGRAL_BOUNDS_INCREASING",SUM_INTEGRAL_BOUNDS_INCREASING; +"SUM_INTEGRAL_LBOUND_DECREASING",SUM_INTEGRAL_LBOUND_DECREASING; +"SUM_INTEGRAL_LBOUND_INCREASING",SUM_INTEGRAL_LBOUND_INCREASING; +"SUM_INTEGRAL_UBOUND_DECREASING",SUM_INTEGRAL_UBOUND_DECREASING; +"SUM_INTEGRAL_UBOUND_INCREASING",SUM_INTEGRAL_UBOUND_INCREASING; +"SUM_LE",SUM_LE; +"SUM_LE_INCLUDED",SUM_LE_INCLUDED; +"SUM_LE_NUMSEG",SUM_LE_NUMSEG; +"SUM_LMUL",SUM_LMUL; +"SUM_LT",SUM_LT; +"SUM_LT_ALL",SUM_LT_ALL; +"SUM_MULTICOUNT",SUM_MULTICOUNT; +"SUM_MULTICOUNT_GEN",SUM_MULTICOUNT_GEN; +"SUM_NEG",SUM_NEG; +"SUM_OFFSET",SUM_OFFSET; +"SUM_OFFSET_0",SUM_OFFSET_0; +"SUM_OF_POWERS",SUM_OF_POWERS; +"SUM_OVER_PERMUTATIONS_INSERT",SUM_OVER_PERMUTATIONS_INSERT; +"SUM_OVER_PERMUTATIONS_NUMSEG",SUM_OVER_PERMUTATIONS_NUMSEG; +"SUM_OVER_TAGGED_DIVISION_LEMMA",SUM_OVER_TAGGED_DIVISION_LEMMA; +"SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; +"SUM_PAIR",SUM_PAIR; +"SUM_PARTIAL_PRE",SUM_PARTIAL_PRE; +"SUM_PARTIAL_SUC",SUM_PARTIAL_SUC; +"SUM_PERMUTATIONS_COMPOSE_L",SUM_PERMUTATIONS_COMPOSE_L; +"SUM_PERMUTATIONS_COMPOSE_R",SUM_PERMUTATIONS_COMPOSE_R; +"SUM_PERMUTATIONS_INVERSE",SUM_PERMUTATIONS_INVERSE; +"SUM_PERMUTE",SUM_PERMUTE; +"SUM_PERMUTE_NUMSEG",SUM_PERMUTE_NUMSEG; +"SUM_POS_BOUND",SUM_POS_BOUND; +"SUM_POS_EQ_0",SUM_POS_EQ_0; +"SUM_POS_EQ_0_NUMSEG",SUM_POS_EQ_0_NUMSEG; +"SUM_POS_LE",SUM_POS_LE; +"SUM_POS_LE_NUMSEG",SUM_POS_LE_NUMSEG; +"SUM_POS_LT",SUM_POS_LT; +"SUM_POS_LT_ALL",SUM_POS_LT_ALL; +"SUM_RESTRICT",SUM_RESTRICT; +"SUM_RESTRICT_SET",SUM_RESTRICT_SET; +"SUM_RMUL",SUM_RMUL; +"SUM_SING",SUM_SING; +"SUM_SING_NUMSEG",SUM_SING_NUMSEG; +"SUM_SUB",SUM_SUB; +"SUM_SUBSET",SUM_SUBSET; +"SUM_SUBSET_SIMPLE",SUM_SUBSET_SIMPLE; +"SUM_SUB_NUMSEG",SUM_SUB_NUMSEG; +"SUM_SUM_PRODUCT",SUM_SUM_PRODUCT; +"SUM_SUM_RESTRICT",SUM_SUM_RESTRICT; +"SUM_SUPERSET",SUM_SUPERSET; +"SUM_SUPPORT",SUM_SUPPORT; +"SUM_SWAP",SUM_SWAP; +"SUM_SWAP_NUMSEG",SUM_SWAP_NUMSEG; +"SUM_TRIV_NUMSEG",SUM_TRIV_NUMSEG; +"SUM_UNION",SUM_UNION; +"SUM_UNIONS_NONZERO",SUM_UNIONS_NONZERO; +"SUM_UNION_EQ",SUM_UNION_EQ; +"SUM_UNION_LZERO",SUM_UNION_LZERO; +"SUM_UNION_NONZERO",SUM_UNION_NONZERO; +"SUM_UNION_RZERO",SUM_UNION_RZERO; +"SUM_VSUM",SUM_VSUM; +"SUM_ZERO_EXISTS",SUM_ZERO_EXISTS; +"SUP",SUP; +"SUPERADMISSIBLE_COND",SUPERADMISSIBLE_COND; +"SUPERADMISSIBLE_CONST",SUPERADMISSIBLE_CONST; +"SUPERADMISSIBLE_MATCH_GUARDED_PATTERN",SUPERADMISSIBLE_MATCH_GUARDED_PATTERN; +"SUPERADMISSIBLE_MATCH_SEQPATTERN",SUPERADMISSIBLE_MATCH_SEQPATTERN; +"SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN",SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN; +"SUPERADMISSIBLE_T",SUPERADMISSIBLE_T; +"SUPERADMISSIBLE_TAIL",SUPERADMISSIBLE_TAIL; +"SUPPORTING_HYPERPLANE_CLOSED_POINT",SUPPORTING_HYPERPLANE_CLOSED_POINT; +"SUPPORTING_HYPERPLANE_COMPACT_POINT_INF",SUPPORTING_HYPERPLANE_COMPACT_POINT_INF; +"SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP",SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP; +"SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY",SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY; +"SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER",SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER; +"SUPPORT_CLAUSES",SUPPORT_CLAUSES; +"SUPPORT_DELTA",SUPPORT_DELTA; +"SUPPORT_EMPTY",SUPPORT_EMPTY; +"SUPPORT_SUBSET",SUPPORT_SUBSET; +"SUPPORT_SUPPORT",SUPPORT_SUPPORT; +"SUP_CLOSURE",SUP_CLOSURE; +"SUP_EQ",SUP_EQ; +"SUP_FINITE",SUP_FINITE; +"SUP_FINITE_LEMMA",SUP_FINITE_LEMMA; +"SUP_INSERT",SUP_INSERT; +"SUP_INSERT_FINITE",SUP_INSERT_FINITE; +"SUP_SING",SUP_SING; +"SUP_UNION",SUP_UNION; +"SUP_UNIQUE",SUP_UNIQUE; +"SUP_UNIQUE_FINITE",SUP_UNIQUE_FINITE; +"SURA_BURA",SURA_BURA; +"SURA_BURA_CLOPEN_SUBSET",SURA_BURA_CLOPEN_SUBSET; +"SURA_BURA_COMPACT",SURA_BURA_COMPACT; +"SURJ",SURJ; +"SURJECTIVE_EXISTS_THM",SURJECTIVE_EXISTS_THM; +"SURJECTIVE_FORALL_THM",SURJECTIVE_FORALL_THM; +"SURJECTIVE_IFF_INJECTIVE",SURJECTIVE_IFF_INJECTIVE; +"SURJECTIVE_IFF_INJECTIVE_GEN",SURJECTIVE_IFF_INJECTIVE_GEN; +"SURJECTIVE_IMAGE",SURJECTIVE_IMAGE; +"SURJECTIVE_IMAGE_EQ",SURJECTIVE_IMAGE_EQ; +"SURJECTIVE_IMAGE_THM",SURJECTIVE_IMAGE_THM; +"SURJECTIVE_INVERSE",SURJECTIVE_INVERSE; +"SURJECTIVE_INVERSE_o",SURJECTIVE_INVERSE_o; +"SURJECTIVE_MAP",SURJECTIVE_MAP; +"SURJECTIVE_ON_IMAGE",SURJECTIVE_ON_IMAGE; +"SURJECTIVE_ON_RIGHT_INVERSE",SURJECTIVE_ON_RIGHT_INVERSE; +"SURJECTIVE_RIGHT_INVERSE",SURJECTIVE_RIGHT_INVERSE; +"SURJECTIVE_SCALING",SURJECTIVE_SCALING; +"SUSSMANN_OPEN_MAPPING",SUSSMANN_OPEN_MAPPING; +"SWAPSEQ_COMPOSE",SWAPSEQ_COMPOSE; +"SWAPSEQ_ENDSWAP",SWAPSEQ_ENDSWAP; +"SWAPSEQ_EVEN_EVEN",SWAPSEQ_EVEN_EVEN; +"SWAPSEQ_I",SWAPSEQ_I; +"SWAPSEQ_IDENTITY_EVEN",SWAPSEQ_IDENTITY_EVEN; +"SWAPSEQ_INVERSE",SWAPSEQ_INVERSE; +"SWAPSEQ_INVERSE_EXISTS",SWAPSEQ_INVERSE_EXISTS; +"SWAPSEQ_SWAP",SWAPSEQ_SWAP; +"SWAP_COMMON",SWAP_COMMON; +"SWAP_COMMON'",SWAP_COMMON'; +"SWAP_EXISTS_THM",SWAP_EXISTS_THM; +"SWAP_FORALL_THM",SWAP_FORALL_THM; +"SWAP_GALOIS",SWAP_GALOIS; +"SWAP_GENERAL",SWAP_GENERAL; +"SWAP_IDEMPOTENT",SWAP_IDEMPOTENT; +"SWAP_INDEPENDENT",SWAP_INDEPENDENT; +"SWAP_REFL",SWAP_REFL; +"SWAP_SYM",SWAP_SYM; +"SYLVESTER_DETERMINANT_IDENTITY",SYLVESTER_DETERMINANT_IDENTITY; +"SYMDIFF_PARITY_LEMMA",SYMDIFF_PARITY_LEMMA; +"SYMMETRIC_CLOSURE",SYMMETRIC_CLOSURE; +"SYMMETRIC_INTERIOR",SYMMETRIC_INTERIOR; +"SYMMETRIC_LINEAR_IMAGE",SYMMETRIC_LINEAR_IMAGE; +"SYMMETRIC_MATRIX",SYMMETRIC_MATRIX; +"SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT",SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT; +"SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE",SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE; +"SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE",SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE; +"SYMMETRIC_MATRIX_MUL",SYMMETRIC_MATRIX_MUL; +"SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS",SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS; +"SYMMETRIX_MATRIX_CONJUGATE",SYMMETRIX_MATRIX_CONJUGATE; +"SYMMETRY_LEMMA",SYMMETRY_LEMMA; +"TAGGED_DIVISION_FINER",TAGGED_DIVISION_FINER; +"TAGGED_DIVISION_OF",TAGGED_DIVISION_OF; +"TAGGED_DIVISION_OF_ALT",TAGGED_DIVISION_OF_ALT; +"TAGGED_DIVISION_OF_ANOTHER",TAGGED_DIVISION_OF_ANOTHER; +"TAGGED_DIVISION_OF_EMPTY",TAGGED_DIVISION_OF_EMPTY; +"TAGGED_DIVISION_OF_FINITE",TAGGED_DIVISION_OF_FINITE; +"TAGGED_DIVISION_OF_NONTRIVIAL",TAGGED_DIVISION_OF_NONTRIVIAL; +"TAGGED_DIVISION_OF_SELF",TAGGED_DIVISION_OF_SELF; +"TAGGED_DIVISION_OF_TRIVIAL",TAGGED_DIVISION_OF_TRIVIAL; +"TAGGED_DIVISION_OF_UNION_SELF",TAGGED_DIVISION_OF_UNION_SELF; +"TAGGED_DIVISION_SPLIT_LEFT_INJ",TAGGED_DIVISION_SPLIT_LEFT_INJ; +"TAGGED_DIVISION_SPLIT_RIGHT_INJ",TAGGED_DIVISION_SPLIT_RIGHT_INJ; +"TAGGED_DIVISION_UNION",TAGGED_DIVISION_UNION; +"TAGGED_DIVISION_UNIONS",TAGGED_DIVISION_UNIONS; +"TAGGED_DIVISION_UNIONS_EXISTS",TAGGED_DIVISION_UNIONS_EXISTS; +"TAGGED_DIVISION_UNION_IMAGE_SND",TAGGED_DIVISION_UNION_IMAGE_SND; +"TAGGED_DIVISION_UNION_INTERVAL",TAGGED_DIVISION_UNION_INTERVAL; +"TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND",TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND; +"TAGGED_PARTIAL_DIVISION_COMMON_TAGS",TAGGED_PARTIAL_DIVISION_COMMON_TAGS; +"TAGGED_PARTIAL_DIVISION_OF_SUBSET",TAGGED_PARTIAL_DIVISION_OF_SUBSET; +"TAGGED_PARTIAL_DIVISION_OF_TRIVIAL",TAGGED_PARTIAL_DIVISION_OF_TRIVIAL; +"TAGGED_PARTIAL_DIVISION_OF_UNION_SELF",TAGGED_PARTIAL_DIVISION_OF_UNION_SELF; +"TAGGED_PARTIAL_DIVISION_SUBSET",TAGGED_PARTIAL_DIVISION_SUBSET; +"TAG_IN_INTERVAL",TAG_IN_INTERVAL; +"TAN_0",TAN_0; +"TAN_ABS_GE_X",TAN_ABS_GE_X; +"TAN_ADD",TAN_ADD; +"TAN_ATN",TAN_ATN; +"TAN_BOUND_PI2",TAN_BOUND_PI2; +"TAN_COT",TAN_COT; +"TAN_DOUBLE",TAN_DOUBLE; +"TAN_MONO_LE",TAN_MONO_LE; +"TAN_MONO_LE_EQ",TAN_MONO_LE_EQ; +"TAN_MONO_LT",TAN_MONO_LT; +"TAN_MONO_LT_EQ",TAN_MONO_LT_EQ; +"TAN_NEG",TAN_NEG; +"TAN_NPI",TAN_NPI; +"TAN_PERIODIC_NPI",TAN_PERIODIC_NPI; +"TAN_PERIODIC_PI",TAN_PERIODIC_PI; +"TAN_PI",TAN_PI; +"TAN_PI4",TAN_PI4; +"TAN_POS_PI2",TAN_POS_PI2; +"TAN_POS_PI2_LE",TAN_POS_PI2_LE; +"TAN_SEC",TAN_SEC; +"TAN_SUB",TAN_SUB; +"TAN_TOTAL",TAN_TOTAL; +"TAN_TOTAL_LEMMA",TAN_TOTAL_LEMMA; +"TAN_TOTAL_POS",TAN_TOTAL_POS; +"TARSKI_SET",TARSKI_SET; +"TAYLOR_CATN",TAYLOR_CATN; +"TAYLOR_CCOS",TAYLOR_CCOS; +"TAYLOR_CCOS_RAW",TAYLOR_CCOS_RAW; +"TAYLOR_CEXP",TAYLOR_CEXP; +"TAYLOR_CLOG",TAYLOR_CLOG; +"TAYLOR_CLOG_NEG",TAYLOR_CLOG_NEG; +"TAYLOR_CSIN",TAYLOR_CSIN; +"TAYLOR_CSIN_RAW",TAYLOR_CSIN_RAW; +"TENDSTO_LIM",TENDSTO_LIM; +"TENDSTO_REAL",TENDSTO_REAL; +"TIETZE",TIETZE; +"TIETZE_CLOSED_INTERVAL",TIETZE_CLOSED_INTERVAL; +"TIETZE_CLOSED_INTERVAL_1",TIETZE_CLOSED_INTERVAL_1; +"TIETZE_OPEN_INTERVAL",TIETZE_OPEN_INTERVAL; +"TIETZE_OPEN_INTERVAL_1",TIETZE_OPEN_INTERVAL_1; +"TIETZE_UNBOUNDED",TIETZE_UNBOUNDED; +"TL",TL; +"TOPOLOGICAL_SORT",TOPOLOGICAL_SORT; +"TOPOLOGY_EQ",TOPOLOGY_EQ; +"TOPSPACE_EUCLIDEAN",TOPSPACE_EUCLIDEAN; +"TOPSPACE_EUCLIDEANREAL",TOPSPACE_EUCLIDEANREAL; +"TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY",TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY; +"TOPSPACE_EUCLIDEAN_SUBTOPOLOGY",TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; +"TOPSPACE_SUBTOPOLOGY",TOPSPACE_SUBTOPOLOGY; +"TRACE_0",TRACE_0; +"TRACE_ADD",TRACE_ADD; +"TRACE_CONJUGATE",TRACE_CONJUGATE; +"TRACE_I",TRACE_I; +"TRACE_MUL_SYM",TRACE_MUL_SYM; +"TRACE_SUB",TRACE_SUB; +"TRACE_TRANSP",TRACE_TRANSP; +"TRANSITIVE_STEPWISE_LE",TRANSITIVE_STEPWISE_LE; +"TRANSITIVE_STEPWISE_LE_EQ",TRANSITIVE_STEPWISE_LE_EQ; +"TRANSITIVE_STEPWISE_LT",TRANSITIVE_STEPWISE_LT; +"TRANSITIVE_STEPWISE_LT_EQ",TRANSITIVE_STEPWISE_LT_EQ; +"TRANSLATION_DIFF",TRANSLATION_DIFF; +"TRANSLATION_EQ_IMP",TRANSLATION_EQ_IMP; +"TRANSLATION_GALOIS",TRANSLATION_GALOIS; +"TRANSLATION_UNIV",TRANSLATION_UNIV; +"TRANSP_COLUMNVECTOR",TRANSP_COLUMNVECTOR; +"TRANSP_COMPONENT",TRANSP_COMPONENT; +"TRANSP_DIAGONAL_MATRIX",TRANSP_DIAGONAL_MATRIX; +"TRANSP_EQ",TRANSP_EQ; +"TRANSP_MAT",TRANSP_MAT; +"TRANSP_MATRIX_ADD",TRANSP_MATRIX_ADD; +"TRANSP_MATRIX_CMUL",TRANSP_MATRIX_CMUL; +"TRANSP_MATRIX_NEG",TRANSP_MATRIX_NEG; +"TRANSP_MATRIX_SUB",TRANSP_MATRIX_SUB; +"TRANSP_ROWVECTOR",TRANSP_ROWVECTOR; +"TRANSP_TRANSP",TRANSP_TRANSP; +"TREAL_ADD_ASSOC",TREAL_ADD_ASSOC; +"TREAL_ADD_LDISTRIB",TREAL_ADD_LDISTRIB; +"TREAL_ADD_LID",TREAL_ADD_LID; +"TREAL_ADD_LINV",TREAL_ADD_LINV; +"TREAL_ADD_SYM",TREAL_ADD_SYM; +"TREAL_ADD_SYM_EQ",TREAL_ADD_SYM_EQ; +"TREAL_ADD_WELLDEF",TREAL_ADD_WELLDEF; +"TREAL_ADD_WELLDEFR",TREAL_ADD_WELLDEFR; +"TREAL_EQ_AP",TREAL_EQ_AP; +"TREAL_EQ_IMP_LE",TREAL_EQ_IMP_LE; +"TREAL_EQ_REFL",TREAL_EQ_REFL; +"TREAL_EQ_SYM",TREAL_EQ_SYM; +"TREAL_EQ_TRANS",TREAL_EQ_TRANS; +"TREAL_INV_0",TREAL_INV_0; +"TREAL_INV_WELLDEF",TREAL_INV_WELLDEF; +"TREAL_LE_ANTISYM",TREAL_LE_ANTISYM; +"TREAL_LE_LADD_IMP",TREAL_LE_LADD_IMP; +"TREAL_LE_MUL",TREAL_LE_MUL; +"TREAL_LE_REFL",TREAL_LE_REFL; +"TREAL_LE_TOTAL",TREAL_LE_TOTAL; +"TREAL_LE_TRANS",TREAL_LE_TRANS; +"TREAL_LE_WELLDEF",TREAL_LE_WELLDEF; +"TREAL_MUL_ASSOC",TREAL_MUL_ASSOC; +"TREAL_MUL_LID",TREAL_MUL_LID; +"TREAL_MUL_LINV",TREAL_MUL_LINV; +"TREAL_MUL_SYM",TREAL_MUL_SYM; +"TREAL_MUL_SYM_EQ",TREAL_MUL_SYM_EQ; +"TREAL_MUL_WELLDEF",TREAL_MUL_WELLDEF; +"TREAL_MUL_WELLDEFR",TREAL_MUL_WELLDEFR; +"TREAL_NEG_WELLDEF",TREAL_NEG_WELLDEF; +"TREAL_OF_NUM_ADD",TREAL_OF_NUM_ADD; +"TREAL_OF_NUM_EQ",TREAL_OF_NUM_EQ; +"TREAL_OF_NUM_LE",TREAL_OF_NUM_LE; +"TREAL_OF_NUM_MUL",TREAL_OF_NUM_MUL; +"TREAL_OF_NUM_WELLDEF",TREAL_OF_NUM_WELLDEF; +"TRIANGLE_LEMMA",TRIANGLE_LEMMA; +"TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL",TRIANGLE_LINEAR_HAS_CHAIN_INTEGRAL; +"TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE",TRIANGLE_PATH_INTEGRALS_CONVEX_PRIMITIVE; +"TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE",TRIANGLE_PATH_INTEGRALS_STARLIKE_PRIMITIVE; +"TRIANGLE_POINTS_CLOSER",TRIANGLE_POINTS_CLOSER; +"TRIANGULATION_INTER_SIMPLEX",TRIANGULATION_INTER_SIMPLEX; +"TRIANGULATION_SIMPLICIAL_COMPLEX",TRIANGULATION_SIMPLICIAL_COMPLEX; +"TRIANGULATION_SUBSET",TRIANGULATION_SUBSET; +"TRIANGULATION_UNION",TRIANGULATION_UNION; +"TRIVIAL_LIMIT_AT",TRIVIAL_LIMIT_AT; +"TRIVIAL_LIMIT_ATREAL",TRIVIAL_LIMIT_ATREAL; +"TRIVIAL_LIMIT_AT_INFINITY",TRIVIAL_LIMIT_AT_INFINITY; +"TRIVIAL_LIMIT_AT_NEGINFINITY",TRIVIAL_LIMIT_AT_NEGINFINITY; +"TRIVIAL_LIMIT_AT_POSINFINITY",TRIVIAL_LIMIT_AT_POSINFINITY; +"TRIVIAL_LIMIT_SEQUENTIALLY",TRIVIAL_LIMIT_SEQUENTIALLY; +"TRIVIAL_LIMIT_WITHIN",TRIVIAL_LIMIT_WITHIN; +"TRIVIAL_LIMIT_WITHINREAL_WITHIN",TRIVIAL_LIMIT_WITHINREAL_WITHIN; +"TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX",TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX; +"TRIVIAL_LIMIT_WITHIN_CONVEX",TRIVIAL_LIMIT_WITHIN_CONVEX; +"TRIVIAL_LIMIT_WITHIN_REAL",TRIVIAL_LIMIT_WITHIN_REAL; +"TRIVIAL_LIMIT_WITHIN_REALINTERVAL",TRIVIAL_LIMIT_WITHIN_REALINTERVAL; +"TRIV_AND_EXISTS_THM",TRIV_AND_EXISTS_THM; +"TRIV_EXISTS_AND_THM",TRIV_EXISTS_AND_THM; +"TRIV_EXISTS_IMP_THM",TRIV_EXISTS_IMP_THM; +"TRIV_FORALL_IMP_THM",TRIV_FORALL_IMP_THM; +"TRIV_FORALL_OR_THM",TRIV_FORALL_OR_THM; +"TRIV_OR_FORALL_THM",TRIV_OR_FORALL_THM; +"TRUTH",TRUTH; +"TUBE_LEMMA",TUBE_LEMMA; +"TUBE_LEMMA_GEN",TUBE_LEMMA_GEN; +"TWO",TWO; +"T_DEF",T_DEF; +"UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT",UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT; +"UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY; +"UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS; +"UNBOUNDED_HALFSPACE_COMPONENT_GE",UNBOUNDED_HALFSPACE_COMPONENT_GE; +"UNBOUNDED_HALFSPACE_COMPONENT_GT",UNBOUNDED_HALFSPACE_COMPONENT_GT; +"UNBOUNDED_HALFSPACE_COMPONENT_LE",UNBOUNDED_HALFSPACE_COMPONENT_LE; +"UNBOUNDED_HALFSPACE_COMPONENT_LT",UNBOUNDED_HALFSPACE_COMPONENT_LT; +"UNBOUNDED_INTER_COBOUNDED",UNBOUNDED_INTER_COBOUNDED; +"UNBOUNDED_OUTSIDE",UNBOUNDED_OUTSIDE; +"UNBOUNDED_REAL",UNBOUNDED_REAL; +"UNCOUNTABLE_CONNECTED",UNCOUNTABLE_CONNECTED; +"UNCOUNTABLE_CONTAINS_LIMIT_POINT",UNCOUNTABLE_CONTAINS_LIMIT_POINT; +"UNCOUNTABLE_CONVEX",UNCOUNTABLE_CONVEX; +"UNCOUNTABLE_EUCLIDEAN",UNCOUNTABLE_EUCLIDEAN; +"UNCOUNTABLE_HAS_CONDENSATION_POINT",UNCOUNTABLE_HAS_CONDENSATION_POINT; +"UNCOUNTABLE_INTERVAL",UNCOUNTABLE_INTERVAL; +"UNCOUNTABLE_NONEMPTY_INTERIOR",UNCOUNTABLE_NONEMPTY_INTERIOR; +"UNCOUNTABLE_OPEN",UNCOUNTABLE_OPEN; +"UNCOUNTABLE_PATH_CONNECTED",UNCOUNTABLE_PATH_CONNECTED; +"UNCOUNTABLE_REAL",UNCOUNTABLE_REAL; +"UNCOUNTABLE_SEGMENT",UNCOUNTABLE_SEGMENT; +"UNCURRY_DEF",UNCURRY_DEF; +"UNICOHERENT_INJECTIVE_LINEAR_IMAGE",UNICOHERENT_INJECTIVE_LINEAR_IMAGE; +"UNICOHERENT_MONOTONE_IMAGE_COMPACT",UNICOHERENT_MONOTONE_IMAGE_COMPACT; +"UNICOHERENT_TRANSLATION",UNICOHERENT_TRANSLATION; +"UNICOHERENT_UNIV",UNICOHERENT_UNIV; +"UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT",UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT; +"UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE",UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE; +"UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL",UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL; +"UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS; +"UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; +"UNIFORMLY_CONTINUOUS_ON_ADD",UNIFORMLY_CONTINUOUS_ON_ADD; +"UNIFORMLY_CONTINUOUS_ON_CLOSURE",UNIFORMLY_CONTINUOUS_ON_CLOSURE; +"UNIFORMLY_CONTINUOUS_ON_CMUL",UNIFORMLY_CONTINUOUS_ON_CMUL; +"UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL",UNIFORMLY_CONTINUOUS_ON_COMPLEX_LMUL; +"UNIFORMLY_CONTINUOUS_ON_COMPLEX_MUL",UNIFORMLY_CONTINUOUS_ON_COMPLEX_MUL; +"UNIFORMLY_CONTINUOUS_ON_COMPLEX_RMUL",UNIFORMLY_CONTINUOUS_ON_COMPLEX_RMUL; +"UNIFORMLY_CONTINUOUS_ON_COMPOSE",UNIFORMLY_CONTINUOUS_ON_COMPOSE; +"UNIFORMLY_CONTINUOUS_ON_CONST",UNIFORMLY_CONTINUOUS_ON_CONST; +"UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT",UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT; +"UNIFORMLY_CONTINUOUS_ON_EQ",UNIFORMLY_CONTINUOUS_ON_EQ; +"UNIFORMLY_CONTINUOUS_ON_ID",UNIFORMLY_CONTINUOUS_ON_ID; +"UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST",UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST; +"UNIFORMLY_CONTINUOUS_ON_MUL",UNIFORMLY_CONTINUOUS_ON_MUL; +"UNIFORMLY_CONTINUOUS_ON_NEG",UNIFORMLY_CONTINUOUS_ON_NEG; +"UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY",UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; +"UNIFORMLY_CONTINUOUS_ON_SUB",UNIFORMLY_CONTINUOUS_ON_SUB; +"UNIFORMLY_CONTINUOUS_ON_SUBSET",UNIFORMLY_CONTINUOUS_ON_SUBSET; +"UNIFORMLY_CONTINUOUS_ON_VMUL",UNIFORMLY_CONTINUOUS_ON_VMUL; +"UNIFORMLY_CONTINUOUS_ON_VSUM",UNIFORMLY_CONTINUOUS_ON_VSUM; +"UNIFORMLY_CONVERGENT_EQ_CAUCHY",UNIFORMLY_CONVERGENT_EQ_CAUCHY; +"UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT",UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT; +"UNIFORM_LIM_ADD",UNIFORM_LIM_ADD; +"UNIFORM_LIM_BILINEAR",UNIFORM_LIM_BILINEAR; +"UNIFORM_LIM_COMPLEX_DIV",UNIFORM_LIM_COMPLEX_DIV; +"UNIFORM_LIM_COMPLEX_INV",UNIFORM_LIM_COMPLEX_INV; +"UNIFORM_LIM_COMPLEX_MUL",UNIFORM_LIM_COMPLEX_MUL; +"UNIFORM_LIM_SUB",UNIFORM_LIM_SUB; +"UNION",UNION; +"UNIONS",UNIONS; +"UNIONS_0",UNIONS_0; +"UNIONS_1",UNIONS_1; +"UNIONS_2",UNIONS_2; +"UNIONS_COMPONENTS",UNIONS_COMPONENTS; +"UNIONS_CONNECTED_COMPONENT",UNIONS_CONNECTED_COMPONENT; +"UNIONS_DIFF",UNIONS_DIFF; +"UNIONS_GSPEC",UNIONS_GSPEC; +"UNIONS_IMAGE",UNIONS_IMAGE; +"UNIONS_INSERT",UNIONS_INSERT; +"UNIONS_INTERS",UNIONS_INTERS; +"UNIONS_MAXIMAL_SETS",UNIONS_MAXIMAL_SETS; +"UNIONS_MONO",UNIONS_MONO; +"UNIONS_MONO_IMAGE",UNIONS_MONO_IMAGE; +"UNIONS_PATH_COMPONENT",UNIONS_PATH_COMPONENT; +"UNIONS_PRED",UNIONS_PRED; +"UNIONS_SUBSET",UNIONS_SUBSET; +"UNIONS_UNION",UNIONS_UNION; +"UNION_ACI",UNION_ACI; +"UNION_ASSOC",UNION_ASSOC; +"UNION_COMM",UNION_COMM; +"UNION_EMPTY",UNION_EMPTY; +"UNION_FL",UNION_FL; +"UNION_FRONTIER",UNION_FRONTIER; +"UNION_IDEMPOT",UNION_IDEMPOT; +"UNION_INSEG",UNION_INSEG; +"UNION_INTERIOR_SUBSET",UNION_INTERIOR_SUBSET; +"UNION_LE_ADD_C",UNION_LE_ADD_C; +"UNION_OVER_INTER",UNION_OVER_INTER; +"UNION_SEGMENT",UNION_SEGMENT; +"UNION_SUBSET",UNION_SUBSET; +"UNION_UNIV",UNION_UNIV; +"UNION_WITH_INSIDE",UNION_WITH_INSIDE; +"UNION_WITH_OUTSIDE",UNION_WITH_OUTSIDE; +"UNIQUE_SKOLEM_ALT",UNIQUE_SKOLEM_ALT; +"UNIQUE_SKOLEM_THM",UNIQUE_SKOLEM_THM; +"UNIT_INTERVAL_CONVEX_HULL",UNIT_INTERVAL_CONVEX_HULL; +"UNIT_INTERVAL_NONEMPTY",UNIT_INTERVAL_NONEMPTY; +"UNIV",UNIV; +"UNIV_GSPEC",UNIV_GSPEC; +"UNIV_NOT_EMPTY",UNIV_NOT_EMPTY; +"UNIV_PCROSS_UNIV",UNIV_PCROSS_UNIV; +"UNIV_SECOND_COUNTABLE",UNIV_SECOND_COUNTABLE; +"UNIV_SECOND_COUNTABLE_SEQUENCE",UNIV_SECOND_COUNTABLE_SEQUENCE; +"UNIV_SUBSET",UNIV_SUBSET; +"UNWINDING_2PI",UNWINDING_2PI; +"UNWIND_THM1",UNWIND_THM1; +"UNWIND_THM2",UNWIND_THM2; +"UPPER_BOUND_FINITE_SET",UPPER_BOUND_FINITE_SET; +"UPPER_BOUND_FINITE_SET_REAL",UPPER_BOUND_FINITE_SET_REAL; +"UPPER_HEMICONTINUOUS",UPPER_HEMICONTINUOUS; +"UPPER_LOWER_HEMICONTINUOUS",UPPER_LOWER_HEMICONTINUOUS; +"UPPER_LOWER_HEMICONTINUOUS_EXPLICIT",UPPER_LOWER_HEMICONTINUOUS_EXPLICIT; +"URYSOHN",URYSOHN; +"URYSOHN_LOCAL",URYSOHN_LOCAL; +"URYSOHN_LOCAL_STRONG",URYSOHN_LOCAL_STRONG; +"URYSOHN_STRONG",URYSOHN_STRONG; +"VALID_PATH_CIRCLEPATH",VALID_PATH_CIRCLEPATH; +"VALID_PATH_COMPOSE",VALID_PATH_COMPOSE; +"VALID_PATH_IMP_PATH",VALID_PATH_IMP_PATH; +"VALID_PATH_JOIN",VALID_PATH_JOIN; +"VALID_PATH_JOIN_EQ",VALID_PATH_JOIN_EQ; +"VALID_PATH_LINEPATH",VALID_PATH_LINEPATH; +"VALID_PATH_PARTCIRCLEPATH",VALID_PATH_PARTCIRCLEPATH; +"VALID_PATH_REVERSEPATH",VALID_PATH_REVERSEPATH; +"VALID_PATH_SHIFTPATH",VALID_PATH_SHIFTPATH; +"VALID_PATH_SUBPATH",VALID_PATH_SUBPATH; +"VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION",VALID_PATH_VECTOR_POLYNOMIAL_FUNCTION; +"VARIATION_EQUAL_LEMMA",VARIATION_EQUAL_LEMMA; +"VECTOR_1",VECTOR_1; +"VECTOR_2",VECTOR_2; +"VECTOR_3",VECTOR_3; +"VECTOR_4",VECTOR_4; +"VECTOR_ADD_AC",VECTOR_ADD_AC; +"VECTOR_ADD_ASSOC",VECTOR_ADD_ASSOC; +"VECTOR_ADD_COMPONENT",VECTOR_ADD_COMPONENT; +"VECTOR_ADD_LDISTRIB",VECTOR_ADD_LDISTRIB; +"VECTOR_ADD_LID",VECTOR_ADD_LID; +"VECTOR_ADD_LINV",VECTOR_ADD_LINV; +"VECTOR_ADD_RDISTRIB",VECTOR_ADD_RDISTRIB; +"VECTOR_ADD_RID",VECTOR_ADD_RID; +"VECTOR_ADD_RINV",VECTOR_ADD_RINV; +"VECTOR_ADD_SUB",VECTOR_ADD_SUB; +"VECTOR_ADD_SYM",VECTOR_ADD_SYM; +"VECTOR_AFFINITY_EQ",VECTOR_AFFINITY_EQ; +"VECTOR_CHOOSE_DIST",VECTOR_CHOOSE_DIST; +"VECTOR_CHOOSE_SIZE",VECTOR_CHOOSE_SIZE; +"VECTOR_COMPONENTWISE",VECTOR_COMPONENTWISE; +"VECTOR_DERIVATIVE_AT",VECTOR_DERIVATIVE_AT; +"VECTOR_DERIVATIVE_CIRCLEPATH",VECTOR_DERIVATIVE_CIRCLEPATH; +"VECTOR_DERIVATIVE_CONST_AT",VECTOR_DERIVATIVE_CONST_AT; +"VECTOR_DERIVATIVE_LINEPATH_AT",VECTOR_DERIVATIVE_LINEPATH_AT; +"VECTOR_DERIVATIVE_LINEPATH_WITHIN",VECTOR_DERIVATIVE_LINEPATH_WITHIN; +"VECTOR_DERIVATIVE_PARTCIRCLEPATH",VECTOR_DERIVATIVE_PARTCIRCLEPATH; +"VECTOR_DERIVATIVE_UNIQUE_AT",VECTOR_DERIVATIVE_UNIQUE_AT; +"VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; +"VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL; +"VECTOR_DERIVATIVE_WITHIN_INTERIOR",VECTOR_DERIVATIVE_WITHIN_INTERIOR; +"VECTOR_DERIVATIVE_WORKS",VECTOR_DERIVATIVE_WORKS; +"VECTOR_DIFF_CHAIN_AT",VECTOR_DIFF_CHAIN_AT; +"VECTOR_DIFF_CHAIN_WITHIN",VECTOR_DIFF_CHAIN_WITHIN; +"VECTOR_EQ",VECTOR_EQ; +"VECTOR_EQ_ADDR",VECTOR_EQ_ADDR; +"VECTOR_EQ_AFFINITY",VECTOR_EQ_AFFINITY; +"VECTOR_EQ_DOT_SPAN",VECTOR_EQ_DOT_SPAN; +"VECTOR_EQ_LDOT",VECTOR_EQ_LDOT; +"VECTOR_EQ_NEG2",VECTOR_EQ_NEG2; +"VECTOR_EQ_RDOT",VECTOR_EQ_RDOT; +"VECTOR_EXPAND_1",VECTOR_EXPAND_1; +"VECTOR_EXPAND_2",VECTOR_EXPAND_2; +"VECTOR_EXPAND_3",VECTOR_EXPAND_3; +"VECTOR_EXPAND_4",VECTOR_EXPAND_4; +"VECTOR_IN_ORTHOGONAL_BASIS",VECTOR_IN_ORTHOGONAL_BASIS; +"VECTOR_IN_ORTHOGONAL_SPANNINGSET",VECTOR_IN_ORTHOGONAL_SPANNINGSET; +"VECTOR_IN_ORTHONORMAL_BASIS",VECTOR_IN_ORTHONORMAL_BASIS; +"VECTOR_MATRIX_MUL_TRANSP",VECTOR_MATRIX_MUL_TRANSP; +"VECTOR_MUL_ASSOC",VECTOR_MUL_ASSOC; +"VECTOR_MUL_COMPONENT",VECTOR_MUL_COMPONENT; +"VECTOR_MUL_EQ_0",VECTOR_MUL_EQ_0; +"VECTOR_MUL_LCANCEL",VECTOR_MUL_LCANCEL; +"VECTOR_MUL_LCANCEL_IMP",VECTOR_MUL_LCANCEL_IMP; +"VECTOR_MUL_LID",VECTOR_MUL_LID; +"VECTOR_MUL_LNEG",VECTOR_MUL_LNEG; +"VECTOR_MUL_LZERO",VECTOR_MUL_LZERO; +"VECTOR_MUL_RCANCEL",VECTOR_MUL_RCANCEL; +"VECTOR_MUL_RCANCEL_IMP",VECTOR_MUL_RCANCEL_IMP; +"VECTOR_MUL_RNEG",VECTOR_MUL_RNEG; +"VECTOR_MUL_RZERO",VECTOR_MUL_RZERO; +"VECTOR_NEG_0",VECTOR_NEG_0; +"VECTOR_NEG_COMPONENT",VECTOR_NEG_COMPONENT; +"VECTOR_NEG_EQ_0",VECTOR_NEG_EQ_0; +"VECTOR_NEG_MINUS1",VECTOR_NEG_MINUS1; +"VECTOR_NEG_NEG",VECTOR_NEG_NEG; +"VECTOR_NEG_SUB",VECTOR_NEG_SUB; +"VECTOR_ONE",VECTOR_ONE; +"VECTOR_POLYNOMIAL_FUNCTION_ADD",VECTOR_POLYNOMIAL_FUNCTION_ADD; +"VECTOR_POLYNOMIAL_FUNCTION_CMUL",VECTOR_POLYNOMIAL_FUNCTION_CMUL; +"VECTOR_POLYNOMIAL_FUNCTION_COMPONENT",VECTOR_POLYNOMIAL_FUNCTION_COMPONENT; +"VECTOR_POLYNOMIAL_FUNCTION_CONST",VECTOR_POLYNOMIAL_FUNCTION_CONST; +"VECTOR_POLYNOMIAL_FUNCTION_ID",VECTOR_POLYNOMIAL_FUNCTION_ID; +"VECTOR_POLYNOMIAL_FUNCTION_LIFT",VECTOR_POLYNOMIAL_FUNCTION_LIFT; +"VECTOR_POLYNOMIAL_FUNCTION_MUL",VECTOR_POLYNOMIAL_FUNCTION_MUL; +"VECTOR_POLYNOMIAL_FUNCTION_NEG",VECTOR_POLYNOMIAL_FUNCTION_NEG; +"VECTOR_POLYNOMIAL_FUNCTION_SUB",VECTOR_POLYNOMIAL_FUNCTION_SUB; +"VECTOR_POLYNOMIAL_FUNCTION_VSUM",VECTOR_POLYNOMIAL_FUNCTION_VSUM; +"VECTOR_POLYNOMIAL_FUNCTION_o",VECTOR_POLYNOMIAL_FUNCTION_o; +"VECTOR_SUB",VECTOR_SUB; +"VECTOR_SUB_ADD",VECTOR_SUB_ADD; +"VECTOR_SUB_ADD2",VECTOR_SUB_ADD2; +"VECTOR_SUB_COMPONENT",VECTOR_SUB_COMPONENT; +"VECTOR_SUB_EQ",VECTOR_SUB_EQ; +"VECTOR_SUB_LDISTRIB",VECTOR_SUB_LDISTRIB; +"VECTOR_SUB_LZERO",VECTOR_SUB_LZERO; +"VECTOR_SUB_PROJECT_ORTHOGONAL",VECTOR_SUB_PROJECT_ORTHOGONAL; +"VECTOR_SUB_RADD",VECTOR_SUB_RADD; +"VECTOR_SUB_RDISTRIB",VECTOR_SUB_RDISTRIB; +"VECTOR_SUB_REFL",VECTOR_SUB_REFL; +"VECTOR_SUB_RZERO",VECTOR_SUB_RZERO; +"VECTOR_VARIATION_AFFINITY",VECTOR_VARIATION_AFFINITY; +"VECTOR_VARIATION_AFFINITY2",VECTOR_VARIATION_AFFINITY2; +"VECTOR_VARIATION_COMBINE",VECTOR_VARIATION_COMBINE; +"VECTOR_VARIATION_CONST",VECTOR_VARIATION_CONST; +"VECTOR_VARIATION_CONST_EQ",VECTOR_VARIATION_CONST_EQ; +"VECTOR_VARIATION_CONTINUOUS",VECTOR_VARIATION_CONTINUOUS; +"VECTOR_VARIATION_CONTINUOUS_LEFT",VECTOR_VARIATION_CONTINUOUS_LEFT; +"VECTOR_VARIATION_CONTINUOUS_RIGHT",VECTOR_VARIATION_CONTINUOUS_RIGHT; +"VECTOR_VARIATION_EQ",VECTOR_VARIATION_EQ; +"VECTOR_VARIATION_GE_DROP_FUNCTION",VECTOR_VARIATION_GE_DROP_FUNCTION; +"VECTOR_VARIATION_GE_NORM_FUNCTION",VECTOR_VARIATION_GE_NORM_FUNCTION; +"VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE; +"VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; +"VECTOR_VARIATION_MONOTONE",VECTOR_VARIATION_MONOTONE; +"VECTOR_VARIATION_NEG",VECTOR_VARIATION_NEG; +"VECTOR_VARIATION_ON_DIVISION",VECTOR_VARIATION_ON_DIVISION; +"VECTOR_VARIATION_ON_NULL",VECTOR_VARIATION_ON_NULL; +"VECTOR_VARIATION_POS_LE",VECTOR_VARIATION_POS_LE; +"VECTOR_VARIATION_REFLECT",VECTOR_VARIATION_REFLECT; +"VECTOR_VARIATION_REFLECT2",VECTOR_VARIATION_REFLECT2; +"VECTOR_VARIATION_REFLECT_INTERVAL",VECTOR_VARIATION_REFLECT_INTERVAL; +"VECTOR_VARIATION_TRANSLATION",VECTOR_VARIATION_TRANSLATION; +"VECTOR_VARIATION_TRANSLATION2",VECTOR_VARIATION_TRANSLATION2; +"VECTOR_VARIATION_TRANSLATION_INTERVAL",VECTOR_VARIATION_TRANSLATION_INTERVAL; +"VECTOR_VARIATION_TRIANGLE",VECTOR_VARIATION_TRIANGLE; +"VEC_COMPONENT",VEC_COMPONENT; +"VEC_EQ",VEC_EQ; +"VSUM",VSUM; +"VSUM_0",VSUM_0; +"VSUM_1",VSUM_1; +"VSUM_2",VSUM_2; +"VSUM_3",VSUM_3; +"VSUM_4",VSUM_4; +"VSUM_ADD",VSUM_ADD; +"VSUM_ADD_GEN",VSUM_ADD_GEN; +"VSUM_ADD_NUMSEG",VSUM_ADD_NUMSEG; +"VSUM_ADD_SPLIT",VSUM_ADD_SPLIT; +"VSUM_BIJECTION",VSUM_BIJECTION; +"VSUM_CASES",VSUM_CASES; +"VSUM_CASES_1",VSUM_CASES_1; +"VSUM_CLAUSES",VSUM_CLAUSES; +"VSUM_CLAUSES_LEFT",VSUM_CLAUSES_LEFT; +"VSUM_CLAUSES_NUMSEG",VSUM_CLAUSES_NUMSEG; +"VSUM_CLAUSES_RIGHT",VSUM_CLAUSES_RIGHT; +"VSUM_CMUL_NUMSEG",VSUM_CMUL_NUMSEG; +"VSUM_COMBINE_L",VSUM_COMBINE_L; +"VSUM_COMBINE_R",VSUM_COMBINE_R; +"VSUM_COMPLEX_LMUL",VSUM_COMPLEX_LMUL; +"VSUM_COMPLEX_RMUL",VSUM_COMPLEX_RMUL; +"VSUM_COMPONENT",VSUM_COMPONENT; +"VSUM_CONST",VSUM_CONST; +"VSUM_CONST_NUMSEG",VSUM_CONST_NUMSEG; +"VSUM_CONTENT_NULL",VSUM_CONTENT_NULL; +"VSUM_CX",VSUM_CX; +"VSUM_CX_NUMSEG",VSUM_CX_NUMSEG; +"VSUM_DELETE",VSUM_DELETE; +"VSUM_DELETE_CASES",VSUM_DELETE_CASES; +"VSUM_DELTA",VSUM_DELTA; +"VSUM_DIFF",VSUM_DIFF; +"VSUM_DIFFS",VSUM_DIFFS; +"VSUM_DIFFS_ALT",VSUM_DIFFS_ALT; +"VSUM_DIFF_LEMMA",VSUM_DIFF_LEMMA; +"VSUM_EQ",VSUM_EQ; +"VSUM_EQ_0",VSUM_EQ_0; +"VSUM_EQ_GENERAL",VSUM_EQ_GENERAL; +"VSUM_EQ_GENERAL_INVERSES",VSUM_EQ_GENERAL_INVERSES; +"VSUM_EQ_NUMSEG",VSUM_EQ_NUMSEG; +"VSUM_EQ_SUPERSET",VSUM_EQ_SUPERSET; +"VSUM_GP",VSUM_GP; +"VSUM_GP_BASIC",VSUM_GP_BASIC; +"VSUM_GP_MULTIPLIED",VSUM_GP_MULTIPLIED; +"VSUM_GP_OFFSET",VSUM_GP_OFFSET; +"VSUM_GROUP",VSUM_GROUP; +"VSUM_IMAGE",VSUM_IMAGE; +"VSUM_IMAGE_GEN",VSUM_IMAGE_GEN; +"VSUM_IMAGE_NONZERO",VSUM_IMAGE_NONZERO; +"VSUM_INCL_EXCL",VSUM_INCL_EXCL; +"VSUM_INJECTION",VSUM_INJECTION; +"VSUM_LMUL",VSUM_LMUL; +"VSUM_NEG",VSUM_NEG; +"VSUM_NONZERO_IMAGE_LEMMA",VSUM_NONZERO_IMAGE_LEMMA; +"VSUM_NORM",VSUM_NORM; +"VSUM_NORM_ALLSUBSETS_BOUND",VSUM_NORM_ALLSUBSETS_BOUND; +"VSUM_NORM_BOUND",VSUM_NORM_BOUND; +"VSUM_NORM_LE",VSUM_NORM_LE; +"VSUM_NORM_TRIANGLE",VSUM_NORM_TRIANGLE; +"VSUM_OFFSET",VSUM_OFFSET; +"VSUM_OFFSET_0",VSUM_OFFSET_0; +"VSUM_OVER_TAGGED_DIVISION_LEMMA",VSUM_OVER_TAGGED_DIVISION_LEMMA; +"VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; +"VSUM_PAIR",VSUM_PAIR; +"VSUM_PAIR_0",VSUM_PAIR_0; +"VSUM_PARTIAL_PRE",VSUM_PARTIAL_PRE; +"VSUM_PARTIAL_SUC",VSUM_PARTIAL_SUC; +"VSUM_REAL",VSUM_REAL; +"VSUM_RESTRICT",VSUM_RESTRICT; +"VSUM_RESTRICT_SET",VSUM_RESTRICT_SET; +"VSUM_RMUL",VSUM_RMUL; +"VSUM_SING",VSUM_SING; +"VSUM_SING_NUMSEG",VSUM_SING_NUMSEG; +"VSUM_SUB",VSUM_SUB; +"VSUM_SUB_NUMSEG",VSUM_SUB_NUMSEG; +"VSUM_SUC",VSUM_SUC; +"VSUM_SUPERSET",VSUM_SUPERSET; +"VSUM_SUPPORT",VSUM_SUPPORT; +"VSUM_SWAP",VSUM_SWAP; +"VSUM_SWAP_NUMSEG",VSUM_SWAP_NUMSEG; +"VSUM_TRIV_NUMSEG",VSUM_TRIV_NUMSEG; +"VSUM_UNION",VSUM_UNION; +"VSUM_UNIONS_NONZERO",VSUM_UNIONS_NONZERO; +"VSUM_UNION_LZERO",VSUM_UNION_LZERO; +"VSUM_UNION_NONZERO",VSUM_UNION_NONZERO; +"VSUM_UNION_RZERO",VSUM_UNION_RZERO; +"VSUM_VMUL",VSUM_VMUL; +"VSUM_VSUM_PRODUCT",VSUM_VSUM_PRODUCT; +"WF",WF; +"WF_DCHAIN",WF_DCHAIN; +"WF_EQ",WF_EQ; +"WF_EREC",WF_EREC; +"WF_FALSE",WF_FALSE; +"WF_FINITE",WF_FINITE; +"WF_IND",WF_IND; +"WF_INT_MEASURE",WF_INT_MEASURE; +"WF_INT_MEASURE_2",WF_INT_MEASURE_2; +"WF_LEX",WF_LEX; +"WF_LEX_DEPENDENT",WF_LEX_DEPENDENT; +"WF_MEASURE",WF_MEASURE; +"WF_MEASURE_GEN",WF_MEASURE_GEN; +"WF_POINTWISE",WF_POINTWISE; +"WF_REC",WF_REC; +"WF_REC_CASES",WF_REC_CASES; +"WF_REC_CASES'",WF_REC_CASES'; +"WF_REC_INVARIANT",WF_REC_INVARIANT; +"WF_REC_TAIL",WF_REC_TAIL; +"WF_REC_TAIL_GENERAL",WF_REC_TAIL_GENERAL; +"WF_REC_TAIL_GENERAL'",WF_REC_TAIL_GENERAL'; +"WF_REC_WF",WF_REC_WF; +"WF_REC_num",WF_REC_num; +"WF_REFL",WF_REFL; +"WF_SUBSET",WF_SUBSET; +"WF_UREC",WF_UREC; +"WF_UREC_WF",WF_UREC_WF; +"WF_num",WF_num; +"WINDING_NUMBER",WINDING_NUMBER; +"WINDING_NUMBER_AHLFORS",WINDING_NUMBER_AHLFORS; +"WINDING_NUMBER_AHLFORS_FULL",WINDING_NUMBER_AHLFORS_FULL; +"WINDING_NUMBER_AHLFORS_LEMMA",WINDING_NUMBER_AHLFORS_LEMMA; +"WINDING_NUMBER_AROUND_INSIDE",WINDING_NUMBER_AROUND_INSIDE; +"WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM",WINDING_NUMBER_AS_CONTINUOUS_LOGARITHM; +"WINDING_NUMBER_BIG_MEETS",WINDING_NUMBER_BIG_MEETS; +"WINDING_NUMBER_CIRCLEPATH",WINDING_NUMBER_CIRCLEPATH; +"WINDING_NUMBER_COMPOSE_CEXP",WINDING_NUMBER_COMPOSE_CEXP; +"WINDING_NUMBER_CONSTANT",WINDING_NUMBER_CONSTANT; +"WINDING_NUMBER_EQ",WINDING_NUMBER_EQ; +"WINDING_NUMBER_EQUAL",WINDING_NUMBER_EQUAL; +"WINDING_NUMBER_EQ_1",WINDING_NUMBER_EQ_1; +"WINDING_NUMBER_FROM_INNERPATH",WINDING_NUMBER_FROM_INNERPATH; +"WINDING_NUMBER_HOMOTOPIC_LOOPS",WINDING_NUMBER_HOMOTOPIC_LOOPS; +"WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ",WINDING_NUMBER_HOMOTOPIC_LOOPS_EQ; +"WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ",WINDING_NUMBER_HOMOTOPIC_LOOPS_NULL_EQ; +"WINDING_NUMBER_HOMOTOPIC_PATHS",WINDING_NUMBER_HOMOTOPIC_PATHS; +"WINDING_NUMBER_HOMOTOPIC_PATHS_EQ",WINDING_NUMBER_HOMOTOPIC_PATHS_EQ; +"WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ",WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EQ; +"WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ",WINDING_NUMBER_HOMOTOPIC_PATHS_NULL_EXPLICIT_EQ; +"WINDING_NUMBER_IVT_ABS",WINDING_NUMBER_IVT_ABS; +"WINDING_NUMBER_IVT_NEG",WINDING_NUMBER_IVT_NEG; +"WINDING_NUMBER_IVT_POS",WINDING_NUMBER_IVT_POS; +"WINDING_NUMBER_JOIN",WINDING_NUMBER_JOIN; +"WINDING_NUMBER_JOIN_POS_COMBINED",WINDING_NUMBER_JOIN_POS_COMBINED; +"WINDING_NUMBER_LE_HALF",WINDING_NUMBER_LE_HALF; +"WINDING_NUMBER_LINEPATH_POS_LT",WINDING_NUMBER_LINEPATH_POS_LT; +"WINDING_NUMBER_LOOPS_LINEAR_EQ",WINDING_NUMBER_LOOPS_LINEAR_EQ; +"WINDING_NUMBER_LT_1",WINDING_NUMBER_LT_1; +"WINDING_NUMBER_LT_HALF",WINDING_NUMBER_LT_HALF; +"WINDING_NUMBER_LT_HALF_LINEPATH",WINDING_NUMBER_LT_HALF_LINEPATH; +"WINDING_NUMBER_NEARBY_LOOPS_EQ",WINDING_NUMBER_NEARBY_LOOPS_EQ; +"WINDING_NUMBER_NEARBY_PATHS_EQ",WINDING_NUMBER_NEARBY_PATHS_EQ; +"WINDING_NUMBER_OFFSET",WINDING_NUMBER_OFFSET; +"WINDING_NUMBER_PARTCIRCLEPATH_POS_LT",WINDING_NUMBER_PARTCIRCLEPATH_POS_LT; +"WINDING_NUMBER_PATHS_LINEAR_EQ",WINDING_NUMBER_PATHS_LINEAR_EQ; +"WINDING_NUMBER_POS_LE",WINDING_NUMBER_POS_LE; +"WINDING_NUMBER_POS_LT",WINDING_NUMBER_POS_LT; +"WINDING_NUMBER_POS_LT_LEMMA",WINDING_NUMBER_POS_LT_LEMMA; +"WINDING_NUMBER_POS_MEETS",WINDING_NUMBER_POS_MEETS; +"WINDING_NUMBER_REVERSEPATH",WINDING_NUMBER_REVERSEPATH; +"WINDING_NUMBER_SHIFTPATH",WINDING_NUMBER_SHIFTPATH; +"WINDING_NUMBER_SPLIT_LINEPATH",WINDING_NUMBER_SPLIT_LINEPATH; +"WINDING_NUMBER_STRONG",WINDING_NUMBER_STRONG; +"WINDING_NUMBER_SUBPATH_COMBINE",WINDING_NUMBER_SUBPATH_COMBINE; +"WINDING_NUMBER_SUBPATH_CONTINUOUS",WINDING_NUMBER_SUBPATH_CONTINUOUS; +"WINDING_NUMBER_TRIANGLE",WINDING_NUMBER_TRIANGLE; +"WINDING_NUMBER_TRIVIAL",WINDING_NUMBER_TRIVIAL; +"WINDING_NUMBER_UNIQUE",WINDING_NUMBER_UNIQUE; +"WINDING_NUMBER_UNIQUE_LOOP",WINDING_NUMBER_UNIQUE_LOOP; +"WINDING_NUMBER_VALID_PATH",WINDING_NUMBER_VALID_PATH; +"WINDING_NUMBER_ZERO_ATINFINITY",WINDING_NUMBER_ZERO_ATINFINITY; +"WINDING_NUMBER_ZERO_IN_OUTSIDE",WINDING_NUMBER_ZERO_IN_OUTSIDE; +"WINDING_NUMBER_ZERO_OUTSIDE",WINDING_NUMBER_ZERO_OUTSIDE; +"WINDING_NUMBER_ZERO_POINT",WINDING_NUMBER_ZERO_POINT; +"WITHIN",WITHIN; +"WITHINREAL_UNIV",WITHINREAL_UNIV; +"WITHIN_UNIV",WITHIN_UNIV; +"WITHIN_WITHIN",WITHIN_WITHIN; +"WLOG_LE",WLOG_LE; +"WLOG_LINEAR_INJECTIVE_IMAGE",WLOG_LINEAR_INJECTIVE_IMAGE; +"WLOG_LINEAR_INJECTIVE_IMAGE_2",WLOG_LINEAR_INJECTIVE_IMAGE_2; +"WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT; +"WLOG_LINEAR_INJECTIVE_IMAGE_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_ALT; +"WLOG_LT",WLOG_LT; +"WO",WO; +"WOSET",WOSET; +"WOSET_ANTISYM",WOSET_ANTISYM; +"WOSET_FLEQ",WOSET_FLEQ; +"WOSET_POSET",WOSET_POSET; +"WOSET_REFL",WOSET_REFL; +"WOSET_TOTAL",WOSET_TOTAL; +"WOSET_TOTAL_LE",WOSET_TOTAL_LE; +"WOSET_TOTAL_LT",WOSET_TOTAL_LT; +"WOSET_TRANS",WOSET_TRANS; +"WOSET_TRANS_LE",WOSET_TRANS_LE; +"WOSET_TRANS_LESS",WOSET_TRANS_LESS; +"WOSET_WELL",WOSET_WELL; +"WOSET_WELL_CONTRAPOS",WOSET_WELL_CONTRAPOS; +"YOUNG_INEQUALITY",YOUNG_INEQUALITY; +"ZBOT",ZBOT; +"ZCONSTR",ZCONSTR; +"ZCONSTR_ZBOT",ZCONSTR_ZBOT; +"ZERO_DEF",ZERO_DEF; +"ZIP",ZIP; +"ZIP_DEF",ZIP_DEF; +"ZL",ZL; +"ZL_SUBSETS",ZL_SUBSETS; +"ZL_SUBSETS_UNIONS",ZL_SUBSETS_UNIONS; +"ZL_SUBSETS_UNIONS_NONEMPTY",ZL_SUBSETS_UNIONS_NONEMPTY; +"ZRECSPACE_CASES",ZRECSPACE_CASES; +"ZRECSPACE_INDUCT",ZRECSPACE_INDUCT; +"ZRECSPACE_RULES",ZRECSPACE_RULES; +"_FALSITY_",_FALSITY_; +"_FUNCTION",_FUNCTION; +"_GUARDED_PATTERN",_GUARDED_PATTERN; +"_MATCH",_MATCH; +"_SEQPATTERN",_SEQPATTERN; +"_UNGUARDED_PATTERN",_UNGUARDED_PATTERN; +"absolutely_integrable_on",absolutely_integrable_on; +"absolutely_real_integrable_on",absolutely_real_integrable_on; +"acs",acs; +"add_c",add_c; +"adjoint",adjoint; +"admissible",admissible; +"aff_dim",aff_dim; +"affine",affine; +"affine_dependent",affine_dependent; +"analytic_on",analytic_on; +"arc",arc; +"asn",asn; +"at",at; +"at_infinity",at_infinity; +"at_neginfinity",at_neginfinity; +"at_posinfinity",at_posinfinity; +"atn",atn; +"atreal",atreal; +"ball",ball; +"basis",basis; +"bernoulli",bernoulli; +"bernoulli_number",bernoulli_number; +"bernstein",bernstein; +"between",between; +"bilinear",bilinear; +"binarysum",binarysum; +"binom",binom; +"bitset",bitset; +"bool_INDUCT",bool_INDUCT; +"bool_RECURSION",bool_RECURSION; +"borsukian",borsukian; +"bounded",bounded; +"cacs",cacs; +"cart_tybij",cart_tybij; +"casn",casn; +"catn",catn; +"cauchy",cauchy; +"cball",cball; +"ccos",ccos; +"cexp",cexp; +"chain",chain; +"char_INDUCT",char_INDUCT; +"char_RECURSION",char_RECURSION; +"circlepath",circlepath; +"clog",clog; +"closed",closed; +"closed_in",closed_in; +"closed_interval",closed_interval; +"closed_path",closed_path; +"closed_real_interval",closed_real_interval; +"closed_real_segment",closed_real_segment; +"closed_segment",closed_segment; +"closest_point",closest_point; +"closure",closure; +"cnj",cnj; +"codeset",codeset; +"cofactor",cofactor; +"collinear",collinear; +"column",column; +"columns",columns; +"columnvector",columnvector; +"compact",compact; +"complete",complete; +"complex",complex; +"complex_add",complex_add; +"complex_derivative",complex_derivative; +"complex_differentiable",complex_differentiable; +"complex_div",complex_div; +"complex_integer",complex_integer; +"complex_inv",complex_inv; +"complex_mul",complex_mul; +"complex_neg",complex_neg; +"complex_norm",complex_norm; +"complex_pow",complex_pow; +"complex_sub",complex_sub; +"components",components; +"condensation_point_of",condensation_point_of; +"cong",cong; +"conic",conic; +"connected",connected; +"connected_component",connected_component; +"content",content; +"continuous",continuous; +"continuous_at",continuous_at; +"continuous_atreal",continuous_atreal; +"continuous_on",continuous_on; +"continuous_within",continuous_within; +"continuous_withinreal",continuous_withinreal; +"contractible",contractible; +"convex",convex; +"convex_cone",convex_cone; +"convex_on",convex_on; +"coplanar",coplanar; +"cos",cos; +"covering_space",covering_space; +"cpow",cpow; +"cproduct",cproduct; +"csin",csin; +"csqrt",csqrt; +"ctan",ctan; +"dependent",dependent; +"dest_int_rep",dest_int_rep; +"det",det; +"diagonal_matrix",diagonal_matrix; +"diameter",diameter; +"differentiable",differentiable; +"differentiable_on",differentiable_on; +"dim",dim; +"dimindex",dimindex; +"dist",dist; +"divides",divides; +"division_of",division_of; +"division_points",division_points; +"dot",dot; +"drop",drop; +"dropout",dropout; +"edge_of",edge_of; +"epigraph",epigraph; +"eq_c",eq_c; +"equiintegrable_on",equiintegrable_on; +"euclidean",euclidean; +"euclideanreal",euclideanreal; +"evenperm",evenperm; +"eventually",eventually; +"exp",exp; +"exposed_face_of",exposed_face_of; +"extreme_point_of",extreme_point_of; +"face_of",face_of; +"facet_of",facet_of; +"fine",fine; +"finite_image_tybij",finite_image_tybij; +"finite_index",finite_index; +"finite_sum_tybij",finite_sum_tybij; +"fl",fl; +"frechet_derivative",frechet_derivative; +"from",from; +"frontier",frontier; +"fstcart",fstcart; +"gauge",gauge; +"ge_c",ge_c; +"geom_mul",geom_mul; +"grade",grade; +"gt_c",gt_c; +"has_bounded_real_variation_on",has_bounded_real_variation_on; +"has_bounded_setvariation_on",has_bounded_setvariation_on; +"has_bounded_variation_on",has_bounded_variation_on; +"has_complex_derivative",has_complex_derivative; +"has_derivative",has_derivative; +"has_derivative_at",has_derivative_at; +"has_derivative_within",has_derivative_within; +"has_integral",has_integral; +"has_integral_alt",has_integral_alt; +"has_integral_compact_interval",has_integral_compact_interval; +"has_integral_def",has_integral_def; +"has_measure",has_measure; +"has_path_integral",has_path_integral; +"has_real_derivative",has_real_derivative; +"has_real_integral",has_real_integral; +"has_real_measure",has_real_measure; +"has_vector_derivative",has_vector_derivative; +"hausdist",hausdist; +"higher_complex_derivative",higher_complex_derivative; +"higher_complex_derivative_alt",higher_complex_derivative_alt; +"higher_real_derivative",higher_real_derivative; +"holomorphic_on",holomorphic_on; +"homeomorphic",homeomorphic; +"homeomorphism",homeomorphism; +"homotopic_loops",homotopic_loops; +"homotopic_paths",homotopic_paths; +"homotopic_with",homotopic_with; +"homotopy_equivalent",homotopy_equivalent; +"hreal_add",hreal_add; +"hreal_add_th",hreal_add_th; +"hreal_inv",hreal_inv; +"hreal_inv_th",hreal_inv_th; +"hreal_le",hreal_le; +"hreal_le_th",hreal_le_th; +"hreal_mul",hreal_mul; +"hreal_mul_th",hreal_mul_th; +"hreal_of_num",hreal_of_num; +"hreal_of_num_th",hreal_of_num_th; +"hull",hull; +"ii",ii; +"in_direction",in_direction; +"independent",independent; +"indicator",indicator; +"inf",inf; +"infnorm",infnorm; +"infsum",infsum; +"inner",inner; +"inseg",inseg; +"inside",inside; +"int_abs",int_abs; +"int_abs_th",int_abs_th; +"int_abstr",int_abstr; +"int_add",int_add; +"int_add_th",int_add_th; +"int_congruent",int_congruent; +"int_coprime",int_coprime; +"int_divides",int_divides; +"int_eq",int_eq; +"int_gcd",int_gcd; +"int_ge",int_ge; +"int_gt",int_gt; +"int_le",int_le; +"int_lt",int_lt; +"int_max",int_max; +"int_max_th",int_max_th; +"int_min",int_min; +"int_min_th",int_min_th; +"int_mod",int_mod; +"int_mul",int_mul; +"int_mul_th",int_mul_th; +"int_neg",int_neg; +"int_neg_th",int_neg_th; +"int_of_num",int_of_num; +"int_of_num_th",int_of_num_th; +"int_pow",int_pow; +"int_pow_th",int_pow_th; +"int_rep",int_rep; +"int_sgn",int_sgn; +"int_sgn_th",int_sgn_th; +"int_sub",int_sub; +"int_sub_th",int_sub_th; +"int_tybij",int_tybij; +"integer",integer; +"integrable_on",integrable_on; +"integral",integral; +"interior",interior; +"interval",interval; +"interval_bij",interval_bij; +"interval_lowerbound",interval_lowerbound; +"interval_upperbound",interval_upperbound; +"inverse",inverse; +"invertible",invertible; +"is_int",is_int; +"is_interval",is_interval; +"is_nadd",is_nadd; +"is_nadd_0",is_nadd_0; +"is_realinterval",is_realinterval; +"istopology",istopology; +"iterate",iterate; +"jacobian",jacobian; +"joinpaths",joinpaths; +"kle",kle; +"ksimplex",ksimplex; +"lambda",lambda; +"lambdas",lambdas; +"le_c",le_c; +"lebesgue_measurable",lebesgue_measurable; +"lemma",lemma; +"less",less; +"lift",lift; +"lifted",lifted; +"lim",lim; +"limit_point_of",limit_point_of; +"linear",linear; +"linepath",linepath; +"linseg",linseg; +"list_CASES",list_CASES; +"list_INDUCT",list_INDUCT; +"list_RECURSION",list_RECURSION; +"list_of_set",list_of_set; +"locally",locally; +"log_convex_on",log_convex_on; +"log_def",log_def; +"lt_c",lt_c; +"mat",mat; +"matrix",matrix; +"matrix_add",matrix_add; +"matrix_cmul",matrix_cmul; +"matrix_inv",matrix_inv; +"matrix_mul",matrix_mul; +"matrix_neg",matrix_neg; +"matrix_sub",matrix_sub; +"matrix_vector_mul",matrix_vector_mul; +"mbasis",mbasis; +"measurable",measurable; +"measurable_on",measurable_on; +"measure",measure; +"midpoint",midpoint; +"minimal",minimal; +"mk_pair_def",mk_pair_def; +"moebius_function",moebius_function; +"monoidal",monoidal; +"mul_c",mul_c; +"multivec",multivec; +"multivector",multivector; +"multivector_tybij",multivector_tybij; +"multivector_tybij_th",multivector_tybij_th; +"nadd_abs",nadd_abs; +"nadd_add",nadd_add; +"nadd_eq",nadd_eq; +"nadd_inv",nadd_inv; +"nadd_le",nadd_le; +"nadd_mul",nadd_mul; +"nadd_of_num",nadd_of_num; +"nadd_rep",nadd_rep; +"nadd_rinv",nadd_rinv; +"negligible",negligible; +"net_tybij",net_tybij; +"netlimit",netlimit; +"neutral",neutral; +"nproduct",nproduct; +"nsum",nsum; +"num_Axiom",num_Axiom; +"num_CASES",num_CASES; +"num_FINITE",num_FINITE; +"num_FINITE_AVOID",num_FINITE_AVOID; +"num_INDUCTION",num_INDUCTION; +"num_INFINITE",num_INFINITE; +"num_MAX",num_MAX; +"num_RECURSION",num_RECURSION; +"num_RECURSION_STD",num_RECURSION_STD; +"num_WF",num_WF; +"num_WOP",num_WOP; +"num_congruent",num_congruent; +"num_coprime",num_coprime; +"num_divides",num_divides; +"num_gcd",num_gcd; +"num_mod",num_mod; +"num_of_int",num_of_int; +"numseg",numseg; +"o_ASSOC",o_ASSOC; +"o_DEF",o_DEF; +"o_THM",o_THM; +"one",one; +"one_Axiom",one_Axiom; +"one_DEF",one_DEF; +"one_INDUCT",one_INDUCT; +"one_RECURSION",one_RECURSION; +"one_axiom",one_axiom; +"one_tydef",one_tydef; +"onorm",onorm; +"open_def",open_def; +"open_in",open_in; +"open_interval",open_interval; +"open_real_interval",open_real_interval; +"open_real_segment",open_real_segment; +"open_segment",open_segment; +"operative",operative; +"option_INDUCT",option_INDUCT; +"option_RECURSION",option_RECURSION; +"ordinal",ordinal; +"orthogonal",orthogonal; +"orthogonal_matrix",orthogonal_matrix; +"orthogonal_transformation",orthogonal_transformation; +"outer",outer; +"outermorphism",outermorphism; +"outside",outside; +"pair_INDUCT",pair_INDUCT; +"pair_RECURSION",pair_RECURSION; +"pairwise",pairwise; +"partcirclepath",partcirclepath; +"pastecart",pastecart; +"path",path; +"path_component",path_component; +"path_connected",path_connected; +"path_image",path_image; +"path_integrable_on",path_integrable_on; +"path_integral",path_integral; +"path_length",path_length; +"pathfinish",pathfinish; +"pathstart",pathstart; +"permutation",permutation; +"permutes",permutes; +"pi",pi; +"piecewise_differentiable_on",piecewise_differentiable_on; +"polyhedron",polyhedron; +"polynomial_function",polynomial_function; +"polytope",polytope; +"poset",poset; +"prod_tybij",prod_tybij; +"product",product; +"pushin",pushin; +"rank",rank; +"rational",rational; +"real",real; +"real_INFINITE",real_INFINITE; +"real_abs",real_abs; +"real_add",real_add; +"real_add_th",real_add_th; +"real_bounded",real_bounded; +"real_closed",real_closed; +"real_compact",real_compact; +"real_continuous",real_continuous; +"real_continuous_at",real_continuous_at; +"real_continuous_atreal",real_continuous_atreal; +"real_continuous_on",real_continuous_on; +"real_continuous_within",real_continuous_within; +"real_continuous_withinreal",real_continuous_withinreal; +"real_convex_on",real_convex_on; +"real_derivative",real_derivative; +"real_differentiable",real_differentiable; +"real_differentiable_on",real_differentiable_on; +"real_div",real_div; +"real_ge",real_ge; +"real_gt",real_gt; +"real_infsum",real_infsum; +"real_integrable_on",real_integrable_on; +"real_integral",real_integral; +"real_interval",real_interval; +"real_inv",real_inv; +"real_inv_th",real_inv_th; +"real_le",real_le; +"real_le_th",real_le_th; +"real_lebesgue_measurable",real_lebesgue_measurable; +"real_log_convex_on",real_log_convex_on; +"real_lt",real_lt; +"real_max",real_max; +"real_measurable",real_measurable; +"real_measurable_on",real_measurable_on; +"real_measure",real_measure; +"real_min",real_min; +"real_mod",real_mod; +"real_mul",real_mul; +"real_mul_th",real_mul_th; +"real_neg",real_neg; +"real_neg_th",real_neg_th; +"real_negligible",real_negligible; +"real_of_num",real_of_num; +"real_of_num_th",real_of_num_th; +"real_open",real_open; +"real_polynomial_function_CASES",real_polynomial_function_CASES; +"real_polynomial_function_INDUCT",real_polynomial_function_INDUCT; +"real_polynomial_function_RULES",real_polynomial_function_RULES; +"real_pow",real_pow; +"real_segment",real_segment; +"real_sgn",real_sgn; +"real_sub",real_sub; +"real_summable",real_summable; +"real_sums",real_sums; +"real_uniformly_continuous_on",real_uniformly_continuous_on; +"real_variation",real_variation; +"reallim",reallim; +"rectifiable_path",rectifiable_path; +"reduced",reduced; +"reflect_along",reflect_along; +"relative_frontier",relative_frontier; +"relative_interior",relative_interior; +"retract_of",retract_of; +"retraction",retraction; +"reversepath",reversepath; +"reversion",reversion; +"root",root; +"rotate2d",rotate2d; +"rotation_matrix",rotation_matrix; +"rotoinversion_matrix",rotoinversion_matrix; +"row",row; +"rows",rows; +"rowvector",rowvector; +"rpow",rpow; +"segment",segment; +"seqiterate",seqiterate; +"seqiterate_EXISTS",seqiterate_EXISTS; +"sequentially",sequentially; +"set_of_list",set_of_list; +"set_variation",set_variation; +"setcode",setcode; +"setdist",setdist; +"shiftpath",shiftpath; +"sign",sign; +"simple_path",simple_path; +"simplex",simplex; +"simplicial_complex",simplicial_complex; +"simply_connected",simply_connected; +"sin",sin; +"sindex",sindex; +"slice",slice; +"sndcart",sndcart; +"span",span; +"sphere",sphere; +"sqrt",sqrt; +"starlike",starlike; +"string_INFINITE",string_INFINITE; +"subpath",subpath; +"subspace",subspace; +"subtopology",subtopology; +"sum",sum; +"sum_CASES",sum_CASES; +"sum_DISTINCT",sum_DISTINCT; +"sum_INDUCT",sum_INDUCT; +"sum_INJECTIVE",sum_INJECTIVE; +"sum_RECURSION",sum_RECURSION; +"summable",summable; +"sums",sums; +"sup",sup; +"superadmissible",superadmissible; +"support",support; +"swap",swap; +"swapseq_CASES",swapseq_CASES; +"swapseq_INDUCT",swapseq_INDUCT; +"swapseq_RULES",swapseq_RULES; +"tagged_division_of",tagged_division_of; +"tagged_partial_division_of",tagged_partial_division_of; +"tailadmissible",tailadmissible; +"tan",tan; +"tan_def",tan_def; +"tendsto",tendsto; +"tendsto_real",tendsto_real; +"topology_tybij",topology_tybij; +"topology_tybij_th",topology_tybij_th; +"topspace",topspace; +"toset",toset; +"trace",trace; +"transp",transp; +"treal_add",treal_add; +"treal_eq",treal_eq; +"treal_inv",treal_inv; +"treal_le",treal_le; +"treal_mul",treal_mul; +"treal_neg",treal_neg; +"treal_of_num",treal_of_num; +"triangulation",triangulation; +"trivial_limit",trivial_limit; +"unicoherent",unicoherent; +"uniformly_continuous_on",uniformly_continuous_on; +"unwinding",unwinding; +"valid_path",valid_path; +"vec",vec; +"vector",vector; +"vector_add",vector_add; +"vector_derivative",vector_derivative; +"vector_matrix_mul",vector_matrix_mul; +"vector_mul",vector_mul; +"vector_neg",vector_neg; +"vector_norm",vector_norm; +"vector_polynomial_function",vector_polynomial_function; +"vector_sub",vector_sub; +"vector_variation",vector_variation; +"vsum",vsum; +"winding_number",winding_number; +"within",within; +"woset",woset +];; diff --git a/Multivariate/complexes.ml b/Multivariate/complexes.ml new file mode 100644 index 0000000..608887a --- /dev/null +++ b/Multivariate/complexes.ml @@ -0,0 +1,2036 @@ +(* ========================================================================= *) +(* The type "real^2" regarded as the complex numbers. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "Multivariate/integration.ml";; + +new_type_abbrev("complex",`:real^2`);; + +let prioritize_complex() = + overload_interface("--",`vector_neg:complex->complex`); + overload_interface("+",`vector_add:complex->complex->complex`); + overload_interface("-",`vector_sub:complex->complex->complex`); + overload_interface("*",`complex_mul:complex->complex->complex`); + overload_interface("/",`complex_div:complex->complex->complex`); + overload_interface("pow",`complex_pow:complex->num->complex`); + overload_interface("inv",`complex_inv:complex->complex`);; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* Real and imaginary parts of a number. *) +(* ------------------------------------------------------------------------- *) + +let RE_DEF = new_definition + `Re(z:complex) = z$1`;; + +let IM_DEF = new_definition + `Im(z:complex) = z$2`;; + +(* ------------------------------------------------------------------------- *) +(* Real injection and imaginary unit. *) +(* ------------------------------------------------------------------------- *) + +let complex = new_definition + `complex(x,y) = vector[x;y]:complex`;; + +let CX_DEF = new_definition + `Cx(a) = complex(a,&0)`;; + +let ii = new_definition + `ii = complex(&0,&1)`;; + +(* ------------------------------------------------------------------------- *) +(* Complex multiplication. *) +(* ------------------------------------------------------------------------- *) + +let complex_mul = new_definition + `w * z = complex(Re(w) * Re(z) - Im(w) * Im(z), + Re(w) * Im(z) + Im(w) * Re(z))`;; + +let complex_inv = new_definition + `inv(z) = complex(Re(z) / (Re(z) pow 2 + Im(z) pow 2), + --(Im(z)) / (Re(z) pow 2 + Im(z) pow 2))`;; + +let complex_div = new_definition + `w / z = w * inv(z)`;; + +let complex_pow = define + `(x pow 0 = Cx(&1)) /\ + (!n. x pow (SUC n) = x * x pow n)`;; + +(* ------------------------------------------------------------------------- *) +(* Various handy rewrites. *) +(* ------------------------------------------------------------------------- *) + +let RE = prove + (`(Re(complex(x,y)) = x)`, + REWRITE_TAC[RE_DEF; complex; VECTOR_2]);; + +let IM = prove + (`Im(complex(x,y)) = y`, + REWRITE_TAC[IM_DEF; complex; VECTOR_2]);; + +let COMPLEX_EQ = prove + (`!w z. (w = z) <=> (Re(w) = Re(z)) /\ (Im(w) = Im(z))`, + SIMP_TAC[CART_EQ; FORALL_2; DIMINDEX_2; RE_DEF; IM_DEF]);; + +let COMPLEX = prove + (`!z. complex(Re(z),Im(z)) = z`, + REWRITE_TAC[COMPLEX_EQ; RE; IM]);; + +let COMPLEX_EQ_0 = prove + (`z = Cx(&0) <=> Re(z) pow 2 + Im(z) pow 2 = &0`, + REWRITE_TAC[COMPLEX_EQ; CX_DEF; RE; IM] THEN + EQ_TAC THEN SIMP_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `!x y:real. x + y = &0 ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_ENTIRE]);; + +let FORALL_COMPLEX = prove + (`(!z. P z) <=> (!x y. P(complex(x,y)))`, + MESON_TAC[COMPLEX]);; + +let EXISTS_COMPLEX = prove + (`(?z. P z) <=> (?x y. P(complex(x,y)))`, + MESON_TAC[COMPLEX]);; + +(* ------------------------------------------------------------------------- *) +(* Pseudo-definitions of other general vector concepts over R^2. *) +(* ------------------------------------------------------------------------- *) + +let complex_neg = prove + (`--z = complex(--(Re(z)),--(Im(z)))`, + REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; DIMINDEX_2; ARITH]);; + +let complex_add = prove + (`w + z = complex(Re(w) + Re(z),Im(w) + Im(z))`, + REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; DIMINDEX_2; ARITH]);; + +let complex_sub = VECTOR_ARITH `(w:complex) - z = w + --z`;; + +let complex_norm = prove + (`norm(z) = sqrt(Re(z) pow 2 + Im(z) pow 2)`, + REWRITE_TAC[vector_norm; dot; RE_DEF; IM_DEF; SUM_2; DIMINDEX_2] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let COMPLEX_SQNORM = prove + (`norm(z) pow 2 = Re(z) pow 2 + Im(z) pow 2`, + REWRITE_TAC[NORM_POW_2; dot; RE_DEF; IM_DEF; SUM_2; DIMINDEX_2] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Crude tactic to automate very simple algebraic equivalences. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLE_COMPLEX_ARITH_TAC = + REWRITE_TAC[COMPLEX_EQ; RE; IM; CX_DEF; + complex_add; complex_neg; complex_sub; complex_mul; + complex_inv; complex_div] THEN + CONV_TAC REAL_FIELD;; + +let SIMPLE_COMPLEX_ARITH tm = prove(tm,SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Basic algebraic properties that can be proved automatically by this. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_ADD_SYM = prove + (`!x y. x + y = y + x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_ASSOC = prove + (`!x y z. x + y + z = (x + y) + z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_LID = prove + (`!x. Cx(&0) + x = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_LINV = prove + (`!x. --x + x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_SYM = prove + (`!x y. x * y = y * x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_ASSOC = prove + (`!x y z. x * y * z = (x * y) * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LID = prove + (`!x. Cx(&1) * x = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_LDISTRIB = prove + (`!x y z. x * (y + z) = x * y + x * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_AC = prove + (`(m + n = n + m) /\ ((m + n) + p = m + n + p) /\ (m + n + p = n + m + p)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_AC = prove + (`(m * n = n * m) /\ ((m * n) * p = m * n * p) /\ (m * n * p = n * m * p)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_RID = prove + (`!x. x + Cx(&0) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RID = prove + (`!x. x * Cx(&1) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_RINV = prove + (`!x. x + --x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_RDISTRIB = prove + (`!x y z. (x + y) * z = x * z + y * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_LCANCEL = prove + (`!x y z. (x + y = x + z) <=> (y = z)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_RCANCEL = prove + (`!x y z. (x + z = y + z) <=> (x = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RZERO = prove + (`!x. x * Cx(&0) = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LZERO = prove + (`!x. Cx(&0) * x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_NEG = prove + (`!x. --(--x) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RNEG = prove + (`!x y. x * --y = --(x * y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LNEG = prove + (`!x y. --x * y = --(x * y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_ADD = prove + (`!x y. --(x + y) = --x + --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_0 = prove + (`--Cx(&0) = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_LCANCEL_0 = prove + (`!x y. (x + y = x) <=> (y = Cx(&0))`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_ADD_RCANCEL_0 = prove + (`!x y. (x + y = y) <=> (x = Cx(&0))`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_LNEG_UNIQ = prove + (`!x y. (x + y = Cx(&0)) <=> (x = --y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_RNEG_UNIQ = prove + (`!x y. (x + y = Cx(&0)) <=> (y = --x)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_LMUL = prove + (`!x y. --(x * y) = --x * y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_RMUL = prove + (`!x y. --(x * y) = x * --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_MUL2 = prove + (`!x y. --x * --y = x * y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_ADD = prove + (`!x y. x - y + y = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_ADD2 = prove + (`!x y. y + x - y = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_REFL = prove + (`!x. x - x = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_0 = prove + (`!x y. (x - y = Cx(&0)) <=> (x = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_EQ_0 = prove + (`!x. (--x = Cx(&0)) <=> (x = Cx(&0))`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_SUB = prove + (`!x y. --(x - y) = y - x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_SUB = prove + (`!x y. (x + y) - x = y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_EQ = prove + (`!x y. (--x = y) <=> (x = --y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NEG_MINUS1 = prove + (`!x. --x = --Cx(&1) * x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_SUB = prove + (`!x y. x - y - x = --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD2_SUB2 = prove + (`!a b c d. (a + b) - (c + d) = a - c + b - d`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_LZERO = prove + (`!x. Cx(&0) - x = --x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_RZERO = prove + (`!x. x - Cx(&0) = x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_LNEG = prove + (`!x y. --x - y = --(x + y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_RNEG = prove + (`!x y. x - --y = x + y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_NEG2 = prove + (`!x y. --x - --y = y - x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_TRIANGLE = prove + (`!a b c. a - b + b - c = a - c`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_SUB_LADD = prove + (`!x y z. (x = y - z) <=> (x + z = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_SUB_RADD = prove + (`!x y z. (x - y = z) <=> (x = z + y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_SUB2 = prove + (`!x y. x - (x - y) = y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ADD_SUB2 = prove + (`!x y. x - (x + y) = --y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_DIFFSQ = prove + (`!x y. (x + y) * (x - y) = x * x - y * y`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_EQ_NEG2 = prove + (`!x y. (--x = --y) <=> (x = y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_LDISTRIB = prove + (`!x y z. x * (y - z) = x * y - x * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_SUB_RDISTRIB = prove + (`!x y z. (x - y) * z = x * z - y * z`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_2 = prove + (`!x. Cx(&2) * x = x + x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Sometimes here we need to tweak non-zeroness assertions. *) +(* ------------------------------------------------------------------------- *) + +let II_NZ = prove + (`~(ii = Cx(&0))`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_LINV = prove + (`!z. ~(z = Cx(&0)) ==> (inv(z) * z = Cx(&1))`, + REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_ENTIRE = prove + (`!x y. (x * y = Cx(&0)) <=> (x = Cx(&0)) \/ (y = Cx(&0))`, + REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_MUL_RINV = prove + (`!z. ~(z = Cx(&0)) ==> (z * inv(z) = Cx(&1))`, + REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_DIV_REFL = prove + (`!x. ~(x = Cx(&0)) ==> (x / x = Cx(&1))`, + REWRITE_TAC[COMPLEX_EQ_0] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Homomorphic embedding properties for Cx mapping. *) +(* ------------------------------------------------------------------------- *) + +let CX_INJ = prove + (`!x y. (Cx(x) = Cx(y)) <=> (x = y)`, + REWRITE_TAC[CX_DEF; COMPLEX_EQ; RE; IM]);; + +let CX_NEG = prove + (`!x. Cx(--x) = --(Cx(x))`, + REWRITE_TAC[CX_DEF; complex_neg; RE; IM; REAL_NEG_0]);; + +let CX_ADD = prove + (`!x y. Cx(x + y) = Cx(x) + Cx(y)`, + REWRITE_TAC[CX_DEF; complex_add; RE; IM; REAL_ADD_LID]);; + +let CX_SUB = prove + (`!x y. Cx(x - y) = Cx(x) - Cx(y)`, + REWRITE_TAC[complex_sub; real_sub; CX_ADD; CX_NEG]);; + +let CX_INV = prove + (`!x. Cx(inv x) = inv(Cx x)`, + GEN_TAC THEN REWRITE_TAC[CX_DEF; complex_inv; RE; IM; COMPLEX_EQ] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +let CX_MUL = prove + (`!x y. Cx(x * y) = Cx(x) * Cx(y)`, + REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_ADD_RID]);; + +let CX_POW = prove + (`!x n. Cx(x pow n) = Cx(x) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; real_pow; CX_MUL]);; + +let CX_DIV = prove + (`!x y. Cx(x / y) = Cx(x) / Cx(y)`, + REWRITE_TAC[complex_div; real_div; CX_MUL; CX_INV]);; + +let CX_ABS = prove + (`!x. Cx(abs x) = Cx(norm(Cx(x)))`, + REWRITE_TAC[CX_DEF; complex_norm; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM REAL_POW_2; POW_2_SQRT_ABS]);; + +let COMPLEX_NORM_CX = prove + (`!x. norm(Cx(x)) = abs(x)`, + REWRITE_TAC[GSYM CX_INJ; CX_ABS]);; + +let DIST_CX = prove + (`!x y. dist(Cx x,Cx y) = abs(x - y)`, + REWRITE_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Some "linear" things hold for Re and Im too. *) +(* ------------------------------------------------------------------------- *) + +let RE_CX = prove + (`!x. Re(Cx x) = x`, + REWRITE_TAC[RE; CX_DEF]);; + +let RE_NEG = prove + (`!x. Re(--x) = --Re(x)`, + REWRITE_TAC[complex_neg; RE]);; + +let RE_ADD = prove + (`!x y. Re(x + y) = Re(x) + Re(y)`, + REWRITE_TAC[complex_add; RE]);; + +let RE_SUB = prove + (`!x y. Re(x - y) = Re(x) - Re(y)`, + REWRITE_TAC[complex_sub; real_sub; RE_ADD; RE_NEG]);; + +let IM_CX = prove + (`!x. Im(Cx x) = &0`, + REWRITE_TAC[IM; CX_DEF]);; + +let IM_NEG = prove + (`!x. Im(--x) = --Im(x)`, + REWRITE_TAC[complex_neg; IM]);; + +let IM_ADD = prove + (`!x y. Im(x + y) = Im(x) + Im(y)`, + REWRITE_TAC[complex_add; IM]);; + +let IM_SUB = prove + (`!x y. Im(x - y) = Im(x) - Im(y)`, + REWRITE_TAC[complex_sub; real_sub; IM_ADD; IM_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* An "expansion" theorem into the traditional notation. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_EXPAND = prove + (`!z. z = Cx(Re z) + ii * Cx(Im z)`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_TRAD = prove + (`!x y. complex(x,y) = Cx(x) + ii * Cx(y)`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Real and complex parts of ii and multiples. *) +(* ------------------------------------------------------------------------- *) + +let RE_II = prove + (`Re ii = &0`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let IM_II = prove + (`Im ii = &1`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let RE_MUL_II = prove + (`!z. Re(z * ii) = --(Im z) /\ Re(ii * z) = --(Im z)`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let IM_MUL_II = prove + (`!z. Im(z * ii) = Re z /\ Im(ii * z) = Re z`, + REWRITE_TAC[ii] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_NORM_II = prove + (`norm ii = &1`, + REWRITE_TAC[complex_norm; RE_II; IM_II] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_1]);; + +(* ------------------------------------------------------------------------- *) +(* Limited "multiplicative" theorems for Re and Im. *) +(* ------------------------------------------------------------------------- *) + +let RE_CMUL = prove + (`!a z. Re(a % z) = a * Re z`, + SIMP_TAC[RE_DEF; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH]);; + +let IM_CMUL = prove + (`!a z. Im(a % z) = a * Im z`, + SIMP_TAC[IM_DEF; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH]);; + +let RE_MUL_CX = prove + (`!x z. Re(Cx(x) * z) = x * Re z /\ + Re(z * Cx(x)) = Re z * x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let IM_MUL_CX = prove + (`!x z. Im(Cx(x) * z) = x * Im z /\ + Im(z * Cx(x)) = Im z * x`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let RE_DIV_CX = prove + (`!z x. Re(z / Cx(x)) = Re(z) / x`, + REWRITE_TAC[complex_div; real_div; GSYM CX_INV; RE_MUL_CX]);; + +let IM_DIV_CX = prove + (`!z x. Im(z / Cx(x)) = Im(z) / x`, + REWRITE_TAC[complex_div; real_div; GSYM CX_INV; IM_MUL_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Syntax constructors etc. for complex constants. *) +(* ------------------------------------------------------------------------- *) + +let is_complex_const = + let cx_tm = `Cx` in + fun tm -> + is_comb tm & + let l,r = dest_comb tm in l = cx_tm & is_ratconst r;; + +let dest_complex_const = + let cx_tm = `Cx` in + fun tm -> + let l,r = dest_comb tm in + if l = cx_tm then rat_of_term r + else failwith "dest_complex_const";; + +let mk_complex_const = + let cx_tm = `Cx` in + fun r -> + mk_comb(cx_tm,term_of_rat r);; + +(* ------------------------------------------------------------------------- *) +(* Conversions for arithmetic on complex constants. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_RAT_EQ_CONV = + GEN_REWRITE_CONV I [CX_INJ] THENC REAL_RAT_EQ_CONV;; + +let COMPLEX_RAT_MUL_CONV = + GEN_REWRITE_CONV I [GSYM CX_MUL] THENC RAND_CONV REAL_RAT_MUL_CONV;; + +let COMPLEX_RAT_ADD_CONV = + GEN_REWRITE_CONV I [GSYM CX_ADD] THENC RAND_CONV REAL_RAT_ADD_CONV;; + +let COMPLEX_RAT_POW_CONV = + let x_tm = `x:real` + and n_tm = `n:num` in + let pth = SYM(SPECL [x_tm; n_tm] CX_POW) in + fun tm -> + let lop,r = dest_comb tm in + let op,bod = dest_comb lop in + let th1 = INST [rand bod,x_tm; r,n_tm] pth in + let tm1,tm2 = dest_comb(concl th1) in + if rand tm1 <> tm then failwith "COMPLEX_RAT_POW_CONV" else + let tm3,tm4 = dest_comb tm2 in + TRANS th1 (AP_TERM tm3 (REAL_RAT_REDUCE_CONV tm4));; + +(* ------------------------------------------------------------------------- *) +(* Complex polynomial normalizer. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_POLY_CLAUSES = prove + (`(!x y z. x + (y + z) = (x + y) + z) /\ + (!x y. x + y = y + x) /\ + (!x. Cx(&0) + x = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x y. x * y = y * x) /\ + (!x. Cx(&1) * x = x) /\ + (!x. Cx(&0) * x = Cx(&0)) /\ + (!x y z. x * (y + z) = x * y + x * z) /\ + (!x. x pow 0 = Cx(&1)) /\ + (!x n. x pow (SUC n) = x * x pow n)`, + REWRITE_TAC[complex_pow] THEN SIMPLE_COMPLEX_ARITH_TAC) +and COMPLEX_POLY_NEG_CLAUSES = prove + (`(!x. --x = Cx(-- &1) * x) /\ + (!x y. x - y = x + Cx(-- &1) * y)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_POLY_NEG_CONV,COMPLEX_POLY_ADD_CONV,COMPLEX_POLY_SUB_CONV, + COMPLEX_POLY_MUL_CONV,COMPLEX_POLY_POW_CONV,COMPLEX_POLY_CONV = + SEMIRING_NORMALIZERS_CONV COMPLEX_POLY_CLAUSES COMPLEX_POLY_NEG_CLAUSES + (is_complex_const, + COMPLEX_RAT_ADD_CONV,COMPLEX_RAT_MUL_CONV,COMPLEX_RAT_POW_CONV) + (<);; + +(* ------------------------------------------------------------------------- *) +(* Extend it to handle "inv" and division, by constants after normalization. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_RAT_INV_CONV = + REWR_CONV(GSYM CX_INV) THENC RAND_CONV REAL_RAT_INV_CONV;; + +let COMPLEX_POLY_CONV = + let neg_tm = `(--):complex->complex` + and inv_tm = `inv:complex->complex` + and add_tm = `(+):complex->complex->complex` + and sub_tm = `(-):complex->complex->complex` + and mul_tm = `(*):complex->complex->complex` + and div_tm = `(/):complex->complex->complex` + and pow_tm = `(pow):complex->num->complex` + and div_conv = REWR_CONV complex_div in + let rec COMPLEX_POLY_CONV tm = + if not(is_comb tm) or is_ratconst tm then REFL tm else + let lop,r = dest_comb tm in + if lop = neg_tm then + let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in + TRANS th1 (COMPLEX_POLY_NEG_CONV (rand(concl th1))) + else if lop = inv_tm then + let th1 = AP_TERM lop (COMPLEX_POLY_CONV r) in + TRANS th1 (TRY_CONV COMPLEX_RAT_INV_CONV (rand(concl th1))) + else if not(is_comb lop) then REFL tm else + let op,l = dest_comb lop in + if op = pow_tm then + let th1 = AP_THM (AP_TERM op (COMPLEX_POLY_CONV l)) r in + TRANS th1 (TRY_CONV COMPLEX_POLY_POW_CONV (rand(concl th1))) + else if op = add_tm or op = mul_tm or op = sub_tm then + let th1 = MK_COMB(AP_TERM op (COMPLEX_POLY_CONV l), + COMPLEX_POLY_CONV r) in + let fn = if op = add_tm then COMPLEX_POLY_ADD_CONV + else if op = mul_tm then COMPLEX_POLY_MUL_CONV + else COMPLEX_POLY_SUB_CONV in + TRANS th1 (fn (rand(concl th1))) + else if op = div_tm then + let th1 = div_conv tm in + TRANS th1 (COMPLEX_POLY_CONV (rand(concl th1))) + else REFL tm in + COMPLEX_POLY_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Complex number version of usual ring procedure. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_RING,complex_ideal_cofactors = + let COMPLEX_INTEGRAL = prove + (`(!x. Cx(&0) * x = Cx(&0)) /\ + (!x y z. (x + y = x + z) <=> (y = z)) /\ + (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, + REWRITE_TAC[COMPLEX_ENTIRE; SIMPLE_COMPLEX_ARITH + `(w * y + x * z = w * z + x * y) <=> + (w - x) * (y - z) = Cx(&0)`] THEN + SIMPLE_COMPLEX_ARITH_TAC) + and COMPLEX_RABINOWITSCH = prove + (`!x y:complex. ~(x = y) <=> ?z. (x - y) * z = Cx(&1)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_SUB_0] THEN + MESON_TAC[COMPLEX_MUL_RINV; COMPLEX_MUL_LZERO; + SIMPLE_COMPLEX_ARITH `~(Cx(&1) = Cx(&0))`]) + and COMPLEX_IIII = prove + (`ii * ii + Cx(&1) = Cx(&0)`, + REWRITE_TAC[ii; CX_DEF; complex_mul; complex_add; RE; IM] THEN + AP_TERM_TAC THEN BINOP_TAC THEN REAL_ARITH_TAC) in + let ring,ideal = + RING_AND_IDEAL_CONV + (dest_complex_const,mk_complex_const,COMPLEX_RAT_EQ_CONV, + `(--):complex->complex`,`(+):complex->complex->complex`, + `(-):complex->complex->complex`,`(inv):complex->complex`, + `(*):complex->complex->complex`,`(/):complex->complex->complex`, + `(pow):complex->num->complex`, + COMPLEX_INTEGRAL,COMPLEX_RABINOWITSCH,COMPLEX_POLY_CONV) + and ii_tm = `ii` and iiii_tm = concl COMPLEX_IIII in + (fun tm -> if free_in ii_tm tm then + MP (ring (mk_imp(iiii_tm,tm))) COMPLEX_IIII + else ring tm), + ideal;; + +(* ------------------------------------------------------------------------- *) +(* Most basic properties of inverses. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_INV_0 = prove + (`inv(Cx(&0)) = Cx(&0)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_INV_1 = prove + (`inv(Cx(&1)) = Cx(&1)`, + SIMPLE_COMPLEX_ARITH_TAC);; + +let COMPLEX_INV_MUL = prove + (`!w z. inv(w * z) = inv(w) * inv(z)`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`w = Cx(&0)`; `z = Cx(&0)`] THEN + ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[complex_mul; complex_inv; RE; IM; COMPLEX_EQ; CX_DEF] THEN + REWRITE_TAC[GSYM REAL_SOS_EQ_0] THEN CONV_TAC REAL_FIELD);; + +let COMPLEX_POW_INV = prove + (`!x n. (inv x) pow n = inv(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_INV_1; COMPLEX_INV_MUL]);; + +let COMPLEX_INV_INV = prove + (`!x:complex. inv(inv x) = x`, + GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_INV_0] THEN + POP_ASSUM MP_TAC THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t COMPLEX_MUL_RINV)) + [`x:complex`; `inv(x):complex`] THEN + CONV_TAC COMPLEX_RING);; + +let COMPLEX_INV_DIV = prove + (`!w z:complex. inv(w / z) = z / w`, + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* And also field procedure. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_EQ_MUL_LCANCEL = prove + (`!x y z. (x * y = x * z) <=> (x = Cx(&0)) \/ (y = z)`, + CONV_TAC COMPLEX_RING);; + +let COMPLEX_EQ_MUL_RCANCEL = prove + (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = Cx(&0))`, + CONV_TAC COMPLEX_RING);; + +let COMPLEX_FIELD = + let prenex_conv = + TOP_DEPTH_CONV BETA_CONV THENC + PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; complex_div; + COMPLEX_INV_INV; COMPLEX_INV_MUL; GSYM COMPLEX_POW_INV] THENC + NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC + PRENEX_CONV + and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV + and is_inv = + let inv_tm = `inv:complex->complex` + and is_div = is_binop `(/):complex->complex->complex` in + fun tm -> (is_div tm or (is_comb tm & rator tm = inv_tm)) & + not(is_ratconst(rand tm)) in + let BASIC_COMPLEX_FIELD tm = + let is_freeinv t = is_inv t & free_in t tm in + let itms = setify(map rand (find_terms is_freeinv tm)) in + let hyps = map (fun t -> SPEC t COMPLEX_MUL_RINV) itms in + let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in + let th1 = setup_conv tm' in + let cjs = conjuncts(rand(concl th1)) in + let ths = map COMPLEX_RING cjs in + let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in + rev_itlist (C MP) hyps th2 in + fun tm -> + let th0 = prenex_conv tm in + let tm0 = rand(concl th0) in + let avs,bod = strip_forall tm0 in + let th1 = setup_conv bod in + let ths = map BASIC_COMPLEX_FIELD (conjuncts(rand(concl th1))) in + EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; + +(* ------------------------------------------------------------------------- *) +(* More trivial lemmas. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DIV_1 = prove + (`!z. z / Cx(&1) = z`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIV_LMUL = prove + (`!x y. ~(y = Cx(&0)) ==> y * x / y = x`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIV_RMUL = prove + (`!x y. ~(y = Cx(&0)) ==> x / y * y = x`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_INV_EQ_0 = prove + (`!x. inv x = Cx(&0) <=> x = Cx(&0)`, + GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_INV_0] THEN POP_ASSUM MP_TAC THEN + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_INV_NEG = prove + (`!x:complex. inv(--x) = --(inv x)`, + GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_INV_0; COMPLEX_NEG_0] THEN + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_NEG_INV = prove + (`!x:complex. --(inv x) = inv(--x)`, + REWRITE_TAC[COMPLEX_INV_NEG]);; + +let COMPLEX_INV_EQ_1 = prove + (`!x. inv x = Cx(&1) <=> x = Cx(&1)`, + GEN_TAC THEN ASM_CASES_TAC `x = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_INV_0] THEN POP_ASSUM MP_TAC THEN + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIV_EQ_0 = prove + (`!w z. w / z = Cx(&0) <=> w = Cx(&0) \/ z = Cx(&0)`, + REWRITE_TAC[complex_div; COMPLEX_INV_EQ_0; COMPLEX_ENTIRE]);; + +(* ------------------------------------------------------------------------- *) +(* Powers. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_POW_ADD = prove + (`!x m n. x pow (m + n) = x pow m * x pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; complex_pow; + COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC]);; + +let COMPLEX_POW_POW = prove + (`!x m n. (x pow m) pow n = x pow (m * n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; MULT_CLAUSES; COMPLEX_POW_ADD]);; + +let COMPLEX_POW_1 = prove + (`!x. x pow 1 = x`, + REWRITE_TAC[num_CONV `1`] THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_RID]);; + +let COMPLEX_POW_2 = prove + (`!x. x pow 2 = x * x`, + REWRITE_TAC[num_CONV `2`] THEN REWRITE_TAC[complex_pow; COMPLEX_POW_1]);; + +let COMPLEX_POW_NEG = prove + (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; EVEN] THEN + ASM_CASES_TAC `EVEN n` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG]);; + +let COMPLEX_POW_ONE = prove + (`!n. Cx(&1) pow n = Cx(&1)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID]);; + +let COMPLEX_POW_MUL = prove + (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_AC]);; + +let COMPLEX_POW_DIV = prove + (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`, + REWRITE_TAC[complex_div; COMPLEX_POW_MUL; COMPLEX_POW_INV]);; + +let COMPLEX_POW_II_2 = prove + (`ii pow 2 = --Cx(&1)`, + REWRITE_TAC[ii; COMPLEX_POW_2; complex_mul; CX_DEF; RE; IM; complex_neg] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let COMPLEX_POW_EQ_0 = prove + (`!x n. (x pow n = Cx(&0)) <=> (x = Cx(&0)) /\ ~(n = 0)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[NOT_SUC; complex_pow; COMPLEX_ENTIRE] THENL + [SIMPLE_COMPLEX_ARITH_TAC; CONV_TAC TAUT]);; + +let COMPLEX_POW_ZERO = prove + (`!n. Cx(&0) pow n = if n = 0 then Cx(&1) else Cx(&0)`, + INDUCT_TAC THEN REWRITE_TAC[complex_pow; COMPLEX_MUL_LZERO; NOT_SUC]);; + +let COMPLEX_INV_II = prove + (`inv ii = --ii`, + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIV_POW = prove + (`!x:complex n k:num. + ~(x= Cx(&0)) /\ k <= n /\ ~(k = 0) + ==> x pow (n - k) = x pow n / x pow k`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `x:complex pow (n - k) * x pow k = + x pow n / x pow k * x pow k` (fun th-> ASM_MESON_TAC + [th;COMPLEX_POW_EQ_0;COMPLEX_EQ_MUL_RCANCEL]) + THEN ASM_SIMP_TAC[GSYM COMPLEX_POW_ADD;SUB_ADD] THEN + MP_TAC (MESON [COMPLEX_POW_EQ_0;ASSUME `~(k = 0)`; ASSUME `~(x = Cx(&0))`] + `~(x pow k = Cx(&0))`) THEN ASM_SIMP_TAC[COMPLEX_DIV_RMUL]);; + +let COMPLEX_DIV_POW2 = prove + (`!z m n. ~(z = Cx(&0)) + ==> z pow m / z pow n = + if n <= m then z pow (m - n) else inv(z pow (n - m))`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD + `~(b = Cx(&0)) /\ ~(c = Cx(&0)) + ==> (a / b = inv c <=> a * c = b)`] THEN + ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD + `~(b = Cx(&0)) ==> (a / b = c <=> b * c = a)`] THEN + REWRITE_TAC[GSYM COMPLEX_POW_ADD] THEN AP_TERM_TAC THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Norms (aka "moduli"). *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_VEC_0 = prove + (`vec 0 = Cx(&0)`, + SIMP_TAC[CART_EQ; VEC_COMPONENT; CX_DEF; complex; + DIMINDEX_2; FORALL_2; VECTOR_2]);; + +let COMPLEX_NORM_ZERO = prove + (`!z. (norm z = &0) <=> (z = Cx(&0))`, + REWRITE_TAC[NORM_EQ_0; COMPLEX_VEC_0]);; + +let COMPLEX_NORM_NUM = prove + (`!n. norm(Cx(&n)) = &n`, + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);; + +let COMPLEX_NORM_0 = prove + (`norm(Cx(&0)) = &0`, + MESON_TAC[COMPLEX_NORM_ZERO]);; + +let COMPLEX_NORM_NZ = prove + (`!z. &0 < norm(z) <=> ~(z = Cx(&0))`, + REWRITE_TAC[NORM_POS_LT; COMPLEX_VEC_0]);; + +let COMPLEX_NORM_MUL = prove + (`!w z. norm(w * z) = norm(w) * norm(z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[complex_norm; complex_mul; RE; IM] THEN + SIMP_TAC[GSYM SQRT_MUL; REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let COMPLEX_NORM_POW = prove + (`!z n. norm(z pow n) = norm(z) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; real_pow; COMPLEX_NORM_NUM; COMPLEX_NORM_MUL]);; + +let COMPLEX_NORM_INV = prove + (`!z. norm(inv z) = inv(norm z)`, + GEN_TAC THEN REWRITE_TAC[complex_norm; complex_inv; RE; IM] THEN + REWRITE_TAC[REAL_POW_2; real_div] THEN + REWRITE_TAC[REAL_ARITH `(r * d) * r * d + (--i * d) * --i * d = + (r * r + i * i) * d * d:real`] THEN + ASM_CASES_TAC `Re z * Re z + Im z * Im z = &0` THENL + [ASM_REWRITE_TAC[REAL_INV_0; SQRT_0; REAL_MUL_LZERO]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN + SIMP_TAC[GSYM SQRT_MUL; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LE_ADD; + REAL_LE_SQUARE] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `a * a * b * b:real = (a * b) * (a * b)`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; SQRT_1]);; + +let COMPLEX_NORM_DIV = prove + (`!w z. norm(w / z) = norm(w) / norm(z)`, + REWRITE_TAC[complex_div; real_div; COMPLEX_NORM_INV; COMPLEX_NORM_MUL]);; + +let COMPLEX_NORM_TRIANGLE_SUB = prove + (`!w z. norm(w) <= norm(w + z) + norm(z)`, + MESON_TAC[NORM_TRIANGLE; NORM_NEG; COMPLEX_ADD_ASSOC; + COMPLEX_ADD_RINV; COMPLEX_ADD_RID]);; + +let COMPLEX_NORM_ABS_NORM = prove + (`!w z. abs(norm w - norm z) <= norm(w - z)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `a - b <= x /\ b - a <= x ==> abs(a - b) <= x:real`) THEN + MESON_TAC[COMPLEX_NEG_SUB; NORM_NEG; REAL_LE_SUB_RADD; complex_sub; + COMPLEX_NORM_TRIANGLE_SUB]);; + +let COMPLEX_POW_EQ_1 = prove + (`!z n. z pow n = Cx(&1) ==> norm(z) = &1 \/ n = 0`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN + SIMP_TAC[COMPLEX_NORM_POW; COMPLEX_NORM_CX; REAL_POW_EQ_1; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_ABS_NORM] THEN CONV_TAC TAUT);; + +(* ------------------------------------------------------------------------- *) +(* Complex conjugate. *) +(* ------------------------------------------------------------------------- *) + +let cnj = new_definition + `cnj(z) = complex(Re(z),--(Im(z)))`;; + +(* ------------------------------------------------------------------------- *) +(* Conjugation is an automorphism. *) +(* ------------------------------------------------------------------------- *) + +let CNJ_INJ = prove + (`!w z. (cnj(w) = cnj(z)) <=> (w = z)`, + REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_EQ_NEG2]);; + +let CNJ_CNJ = prove + (`!z. cnj(cnj z) = z`, + REWRITE_TAC[cnj; COMPLEX_EQ; RE; IM; REAL_NEG_NEG]);; + +let CNJ_CX = prove + (`!x. cnj(Cx x) = Cx x`, + REWRITE_TAC[cnj; COMPLEX_EQ; CX_DEF; REAL_NEG_0; RE; IM]);; + +let COMPLEX_NORM_CNJ = prove + (`!z. norm(cnj z) = norm(z)`, + REWRITE_TAC[complex_norm; cnj; REAL_POW_2] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; RE; IM; REAL_NEG_NEG]);; + +let CNJ_NEG = prove + (`!z. cnj(--z) = --(cnj z)`, + REWRITE_TAC[cnj; complex_neg; COMPLEX_EQ; RE; IM]);; + +let CNJ_INV = prove + (`!z. cnj(inv z) = inv(cnj z)`, + REWRITE_TAC[cnj; complex_inv; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[real_div; REAL_NEG_NEG; REAL_POW_2; + REAL_MUL_LNEG; REAL_MUL_RNEG]);; + +let CNJ_ADD = prove + (`!w z. cnj(w + z) = cnj(w) + cnj(z)`, + REWRITE_TAC[cnj; complex_add; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let CNJ_SUB = prove + (`!w z. cnj(w - z) = cnj(w) - cnj(z)`, + REWRITE_TAC[complex_sub; CNJ_ADD; CNJ_NEG]);; + +let CNJ_MUL = prove + (`!w z. cnj(w * z) = cnj(w) * cnj(z)`, + REWRITE_TAC[cnj; complex_mul; COMPLEX_EQ; RE; IM] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let CNJ_DIV = prove + (`!w z. cnj(w / z) = cnj(w) / cnj(z)`, + REWRITE_TAC[complex_div; CNJ_MUL; CNJ_INV]);; + +let CNJ_POW = prove + (`!z n. cnj(z pow n) = cnj(z) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[complex_pow; CNJ_MUL; CNJ_CX]);; + +let RE_CNJ = prove + (`!z. Re(cnj z) = Re z`, + REWRITE_TAC[cnj; RE]);; + +let IM_CNJ = prove + (`!z. Im(cnj z) = --Im z`, + REWRITE_TAC[cnj; IM]);; + +let CNJ_EQ_CX = prove + (`!x z. cnj z = Cx x <=> z = Cx x`, + REWRITE_TAC[COMPLEX_EQ; RE_CNJ; IM_CNJ; RE_CX; IM_CX] THEN + CONV_TAC REAL_RING);; + +let CNJ_EQ_0 = prove + (`!z. cnj z = Cx(&0) <=> z = Cx(&0)`, + REWRITE_TAC[CNJ_EQ_CX]);; + +let COMPLEX_ADD_CNJ = prove + (`(!z. z + cnj z = Cx(&2 * Re z)) /\ (!z. cnj z + z = Cx(&2 * Re z))`, + REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX; RE_ADD; IM_ADD; RE_CNJ; IM_CNJ] THEN + REAL_ARITH_TAC);; + +let CNJ_II = prove + (`cnj ii = --ii`, + REWRITE_TAC[cnj; ii; RE; IM; complex_neg; REAL_NEG_0]);; + +let CX_RE_CNJ = prove + (`!z. Cx(Re z) = (z + cnj z) / Cx(&2)`, + REWRITE_TAC[COMPLEX_EQ; RE_DIV_CX; IM_DIV_CX; RE_CX; IM_CX] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_CNJ; IM_CNJ] THEN REAL_ARITH_TAC);; + +let CX_IM_CNJ = prove + (`!z. Cx(Im z) = --ii * (z - cnj z) / Cx(&2)`, + REWRITE_TAC[COMPLEX_EQ; RE_DIV_CX; IM_DIV_CX; RE_CX; IM_CX; + COMPLEX_MUL_LNEG; RE_NEG; IM_NEG; RE_MUL_II; IM_MUL_II] THEN + REWRITE_TAC[RE_SUB; IM_SUB; RE_CNJ; IM_CNJ] THEN REAL_ARITH_TAC);; + +let FORALL_CNJ = prove + (`(!z. P(cnj z)) <=> (!z. P z)`, + MESON_TAC[CNJ_CNJ]);; + +let EXISTS_CNJ = prove + (`(?z. P(cnj z)) <=> (?z. P z)`, + MESON_TAC[CNJ_CNJ]);; + +(* ------------------------------------------------------------------------- *) +(* Slightly ad hoc theorems relating multiplication, inverse and conjugation *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_NORM_POW_2 = prove + (`!z. Cx(norm z) pow 2 = z * cnj z`, + GEN_TAC THEN REWRITE_TAC [GSYM CX_POW; COMPLEX_SQNORM] THEN + REWRITE_TAC [cnj; complex_mul; CX_DEF; RE; IM; COMPLEX_EQ] THEN + CONV_TAC REAL_RING);; + +let COMPLEX_MUL_CNJ = prove + (`!z. cnj z * z = Cx(norm(z)) pow 2 /\ z * cnj z = Cx(norm(z)) pow 2`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[cnj; complex_mul; RE; IM; GSYM CX_POW; COMPLEX_SQNORM] THEN + REWRITE_TAC[CX_DEF] THEN AP_TERM_TAC THEN BINOP_TAC THEN + CONV_TAC REAL_RING);; + +let COMPLEX_INV_CNJ = prove + (`!z. inv z = cnj z / Cx(norm z) pow 2`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[CNJ_CX; complex_div; COMPLEX_INV_0; COMPLEX_MUL_LZERO]; + MATCH_MP_TAC(COMPLEX_FIELD + `x * y = z /\ ~(x = Cx(&0)) /\ ~(z = Cx(&0)) ==> inv x = y / z`) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_CNJ; GSYM CX_POW; CX_INJ; REAL_POW_EQ_0] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; ARITH]]);; + +let COMPLEX_DIV_CNJ = prove + (`!a b. a / b = (a * cnj b) / Cx(norm b) pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_INV_CNJ] THEN + REWRITE_TAC[complex_div]);; + +let RE_COMPLEX_DIV_EQ_0 = prove + (`!a b. Re(a / b) = &0 <=> Re(a * cnj b) = &0`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN + REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN + REWRITE_TAC[RE_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; + REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN + ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; RE_CX]);; + +let IM_COMPLEX_DIV_EQ_0 = prove + (`!a b. Im(a / b) = &0 <=> Im(a * cnj b) = &0`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN + REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN + REWRITE_TAC[IM_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; + REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN + ASM_CASES_TAC `b = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; IM_CX]);; + +let RE_COMPLEX_DIV_GT_0 = prove + (`!a b. &0 < Re(a / b) <=> &0 < Re(a * cnj b)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN + REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN + REWRITE_TAC[RE_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; + REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN + ASM_CASES_TAC `b = Cx(&0)` THEN + ASM_REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; RE_CX; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `&0 < a * x <=> &0 * x < a * x`] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_INV_EQ; REAL_POW_LT; ARITH; + COMPLEX_NORM_NZ]);; + +let IM_COMPLEX_DIV_GT_0 = prove + (`!a b. &0 < Im(a / b) <=> &0 < Im(a * cnj b)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COMPLEX_DIV_CNJ] THEN + REWRITE_TAC[complex_div; GSYM CX_POW; GSYM CX_INV] THEN + REWRITE_TAC[IM_MUL_CX; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH; + REAL_ENTIRE; COMPLEX_NORM_ZERO] THEN + ASM_CASES_TAC `b = Cx(&0)` THEN + ASM_REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO; IM_CX; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `&0 < a * x <=> &0 * x < a * x`] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_INV_EQ; REAL_POW_LT; ARITH; + COMPLEX_NORM_NZ]);; + +let RE_COMPLEX_DIV_GE_0 = prove + (`!a b. &0 <= Re(a / b) <=> &0 <= Re(a * cnj b)`, + REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN + REWRITE_TAC[RE_COMPLEX_DIV_GT_0; RE_COMPLEX_DIV_EQ_0]);; + +let IM_COMPLEX_DIV_GE_0 = prove + (`!a b. &0 <= Im(a / b) <=> &0 <= Im(a * cnj b)`, + REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN + REWRITE_TAC[IM_COMPLEX_DIV_GT_0; IM_COMPLEX_DIV_EQ_0]);; + +let RE_COMPLEX_DIV_LE_0 = prove + (`!a b. Re(a / b) <= &0 <=> Re(a * cnj b) <= &0`, + REWRITE_TAC[GSYM REAL_NOT_LT; RE_COMPLEX_DIV_GT_0]);; + +let IM_COMPLEX_DIV_LE_0 = prove + (`!a b. Im(a / b) <= &0 <=> Im(a * cnj b) <= &0`, + REWRITE_TAC[GSYM REAL_NOT_LT; IM_COMPLEX_DIV_GT_0]);; + +let RE_COMPLEX_DIV_LT_0 = prove + (`!a b. Re(a / b) < &0 <=> Re(a * cnj b) < &0`, + REWRITE_TAC[GSYM REAL_NOT_LE; RE_COMPLEX_DIV_GE_0]);; + +let IM_COMPLEX_DIV_LT_0 = prove + (`!a b. Im(a / b) < &0 <=> Im(a * cnj b) < &0`, + REWRITE_TAC[GSYM REAL_NOT_LE; IM_COMPLEX_DIV_GE_0]);; + +let IM_COMPLEX_INV_GE_0 = prove + (`!z. &0 <= Im(inv z) <=> Im(z) <= &0`, + GEN_TAC THEN MP_TAC(ISPECL [`Cx(&1)`; `z:complex`] IM_COMPLEX_DIV_GE_0) THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID; IM_CNJ] THEN REAL_ARITH_TAC);; + +let IM_COMPLEX_INV_LE_0 = prove + (`!z. Im(inv z) <= &0 <=> &0 <= Im(z)`, + MESON_TAC[IM_COMPLEX_INV_GE_0; COMPLEX_INV_INV]);; + +let IM_COMPLEX_INV_GT_0 = prove + (`!z. &0 < Im(inv z) <=> Im(z) < &0`, + REWRITE_TAC[REAL_ARITH `&0 < a <=> ~(a <= &0)`; IM_COMPLEX_INV_LE_0] THEN + REAL_ARITH_TAC);; + +let IM_COMPLEX_INV_LT_0 = prove + (`!z. Im(inv z) < &0 <=> &0 < Im(z)`, + REWRITE_TAC[REAL_ARITH `a < &0 <=> ~(&0 <= a)`; IM_COMPLEX_INV_GE_0] THEN + REAL_ARITH_TAC);; + +let IM_COMPLEX_INV_EQ_0 = prove + (`!z. Im(inv z) = &0 <=> Im(z) = &0`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; IM_COMPLEX_INV_LE_0; IM_COMPLEX_INV_GE_0] THEN + REAL_ARITH_TAC);; + +let REAL_SGN_RE_COMPLEX_DIV = prove + (`!w z. real_sgn(Re(w / z)) = real_sgn(Re(w * cnj z))`, + REWRITE_TAC[real_sgn; RE_COMPLEX_DIV_GT_0; RE_COMPLEX_DIV_GE_0; + REAL_ARITH `x < &0 <=> ~(&0 <= x)`]);; + +let REAL_SGN_IM_COMPLEX_DIV = prove + (`!w z. real_sgn(Im(w / z)) = real_sgn(Im(w * cnj z))`, + REWRITE_TAC[real_sgn; IM_COMPLEX_DIV_GT_0; IM_COMPLEX_DIV_GE_0; + REAL_ARITH `x < &0 <=> ~(&0 <= x)`]);; + +(* ------------------------------------------------------------------------- *) +(* Norm versus components for complex numbers. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_NORM_GE_RE_IM = prove + (`!z. abs(Re(z)) <= norm(z) /\ abs(Im(z)) <= norm(z)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN + REWRITE_TAC[complex_norm] THEN + CONJ_TAC THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_ADDL; REAL_POW_2; REAL_LE_SQUARE]);; + +let COMPLEX_NORM_LE_RE_IM = prove + (`!z. norm(z) <= abs(Re z) + abs(Im z)`, + GEN_TAC THEN MP_TAC(ISPEC `z:complex` NORM_LE_L1) THEN + REWRITE_TAC[DIMINDEX_2; SUM_2; RE_DEF; IM_DEF]);; + +let COMPLEX_L1_LE_NORM = prove + (`!z. sqrt(&2) / &2 * (abs(Re z) + abs(Im z)) <= norm z`, + GEN_TAC THEN MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `sqrt(&2)` THEN + SIMP_TAC[REAL_ARITH `x * x / &2 * y = (x pow 2) / &2 * y`; + SQRT_POW_2; REAL_POS; SQRT_POS_LT; REAL_OF_NUM_LT; ARITH] THEN + MP_TAC(ISPEC `z:complex` L1_LE_NORM) THEN + REWRITE_TAC[DIMINDEX_2; SUM_2; RE_DEF; IM_DEF] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Complex square roots. *) +(* ------------------------------------------------------------------------- *) + +let csqrt = new_definition + `csqrt(z) = if Im(z) = &0 then + if &0 <= Re(z) then complex(sqrt(Re(z)),&0) + else complex(&0,sqrt(--Re(z))) + else complex(sqrt((norm(z) + Re(z)) / &2), + (Im(z) / abs(Im(z))) * + sqrt((norm(z) - Re(z)) / &2))`;; + + +let CSQRT = prove + (`!z. csqrt(z) pow 2 = z`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_POW_2; csqrt] THEN COND_CASES_TAC THENL + [COND_CASES_TAC THEN + ASM_REWRITE_TAC[CX_DEF; complex_mul; RE; IM; REAL_MUL_RZERO; REAL_MUL_LZERO; + REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_ADD_LID; COMPLEX_EQ] THEN + REWRITE_TAC[REAL_NEG_EQ; GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`]; + ALL_TAC] THEN + REWRITE_TAC[complex_mul; RE; IM] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(s * s - (i * s') * (i * s') = s * s - (i * i) * (s' * s')) /\ + (s * i * s' + (i * s')* s = &2 * i * s * s')`] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + SUBGOAL_THEN `&0 <= norm(z) + Re(z) /\ &0 <= norm(z) - Re(z)` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; GSYM SQRT_MUL; SQRT_POW_2] THEN + REWRITE_TAC[COMPLEX_EQ; RE; IM] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW2_ABS; + REAL_POW_EQ_0; REAL_DIV_REFL] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `(m + r) - (m - r) = r * &2`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(a * b) * a' * b = (a * a') * (b * b:real)`] THEN + REWRITE_TAC[REAL_DIFFSQ] THEN + REWRITE_TAC[complex_norm; GSYM REAL_POW_2] THEN + SIMP_TAC[SQRT_POW_2; REAL_LE_ADD; + REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_ADD_SUB; GSYM REAL_POW_MUL] THEN + REWRITE_TAC[POW_2_SQRT_ABS] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `&2 * (i * a') * a * h = i * (&2 * h) * a * a'`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LID; GSYM real_div] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ABS_ZERO; REAL_MUL_RID]);; + +let CX_SQRT = prove + (`!x. &0 <= x ==> Cx(sqrt x) = csqrt(Cx x)`, + SIMP_TAC[csqrt; IM_CX; RE_CX; COMPLEX_EQ; RE; IM]);; + +let CSQRT_CX = prove + (`!x. &0 <= x ==> csqrt(Cx x) = Cx(sqrt x)`, + SIMP_TAC[CX_SQRT]);; + +let CSQRT_0 = prove + (`csqrt(Cx(&0)) = Cx(&0)`, + SIMP_TAC[CSQRT_CX; REAL_POS; SQRT_0]);; + +let CSQRT_1 = prove + (`csqrt(Cx(&1)) = Cx(&1)`, + SIMP_TAC[CSQRT_CX; REAL_POS; SQRT_1]);; + +let CSQRT_PRINCIPAL = prove + (`!z. &0 < Re(csqrt(z)) \/ Re(csqrt(z)) = &0 /\ &0 <= Im(csqrt(z))`, + GEN_TAC THEN REWRITE_TAC[csqrt] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[RE; IM]) THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP SQRT_POS_LE) THEN REAL_ARITH_TAC; + DISJ2_TAC THEN REWRITE_TAC[real_ge] THEN MATCH_MP_TAC SQRT_POS_LE THEN + ASM_REAL_ARITH_TAC; + DISJ1_TAC THEN MATCH_MP_TAC SQRT_POS_LT THEN + MATCH_MP_TAC(REAL_ARITH `abs(y) < x ==> &0 < (x + y) / &2`) THEN + REWRITE_TAC[complex_norm] THEN REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN + MATCH_MP_TAC SQRT_MONO_LT THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE; REAL_LT_ADDR] THEN + REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]]);; + +let RE_CSQRT = prove + (`!z. &0 <= Re(csqrt z)`, + MP_TAC CSQRT_PRINCIPAL THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let CSQRT_UNIQUE = prove + (`!s z. s pow 2 = z /\ (&0 < Re s \/ Re s = &0 /\ &0 <= Im s) + ==> csqrt z = s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MP_TAC(SPEC `(s:complex) pow 2` CSQRT) THEN + SIMP_TAC[COMPLEX_RING `a pow 2 = b pow 2 <=> a = b \/ a = --b:complex`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_RING `--z = z <=> z = Cx(&0)`] THEN + FIRST_ASSUM(MP_TAC o AP_TERM `Re`) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `Im`) THEN + REWRITE_TAC[RE_NEG; IM_NEG; COMPLEX_EQ; RE_CX; IM_CX] THEN + MP_TAC(SPEC `(s:complex) pow 2` CSQRT_PRINCIPAL) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let POW_2_CSQRT = prove + (`!z. &0 < Re z \/ Re(z) = &0 /\ &0 <= Im(z) ==> csqrt(z pow 2) = z`, + MESON_TAC[CSQRT_UNIQUE]);; + +let CSQRT_EQ_0 = prove + (`!z. csqrt z = Cx(&0) <=> z = Cx(&0)`, + GEN_TAC THEN MP_TAC (SPEC `z:complex` CSQRT) THEN CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* A few more complex-specific cases of vector notions. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_CMUL = prove + (`!c x. c % x = Cx(c) * x`, + SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; CX_DEF; complex; + complex_mul; DIMINDEX_2; FORALL_2; IM_DEF; RE_DEF; VECTOR_2] THEN + REAL_ARITH_TAC);; + +let LINEAR_COMPLEX_MUL = prove + (`!c. linear (\x. c * x)`, + REWRITE_TAC[linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; + +let BILINEAR_COMPLEX_MUL = prove + (`bilinear( * )`, + REWRITE_TAC[bilinear; linear; COMPLEX_CMUL] THEN CONV_TAC COMPLEX_RING);; + +let LINEAR_CNJ = prove + (`linear cnj`, + REWRITE_TAC[linear; COMPLEX_CMUL; CNJ_ADD; CNJ_MUL; CNJ_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Complex-specific theorems about sums. *) +(* ------------------------------------------------------------------------- *) + +let RE_VSUM = prove + (`!f s. FINITE s ==> Re(vsum s f) = sum s (\x. Re(f x))`, + SIMP_TAC[RE_DEF; VSUM_COMPONENT; DIMINDEX_2; ARITH]);; + +let IM_VSUM = prove + (`!f s. FINITE s ==> Im(vsum s f) = sum s (\x. Im(f x))`, + SIMP_TAC[IM_DEF; VSUM_COMPONENT; DIMINDEX_2; ARITH]);; + +let VSUM_COMPLEX_LMUL = prove + (`!c f s. FINITE(s) ==> vsum s (\x. c * f x) = c * vsum s f`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let VSUM_COMPLEX_RMUL = prove + (`!c f s. FINITE(s) ==> vsum s (\x. f x * c) = vsum s f * c`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[VSUM_COMPLEX_LMUL]);; + +let VSUM_CX = prove + (`!f:A->real s. vsum s (\a. Cx(f a)) = Cx(sum s f)`, + SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[IM_CX; SUM_0; RE_CX; ETA_AX]);; + +let CNJ_VSUM = prove + (`!f s. FINITE s ==> cnj(vsum s f) = vsum s (\x. cnj(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; CNJ_ADD; CNJ_CX; COMPLEX_VEC_0]);; + +let VSUM_CX_NUMSEG = prove + (`!f m n. vsum (m..n) (\a. Cx(f a)) = Cx(sum (m..n) f)`, + SIMP_TAC[VSUM_CX; FINITE_NUMSEG]);; + +let COMPLEX_SUB_POW = prove + (`!x y n. + 1 <= n ==> x pow n - y pow n = + (x - y) * vsum(0..n-1) (\i. x pow i * y pow (n - 1 - i))`, + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + REWRITE_TAC[COMPLEX_RING + `(x - y) * (a * b):complex = (x * a) * b - a * (y * b)`] THEN + SIMP_TAC[GSYM complex_pow; ADD1; ARITH_RULE + `1 <= n /\ x <= n - 1 + ==> n - 1 - x = n - (x + 1) /\ SUC(n - 1 - x) = n - x`] THEN + REWRITE_TAC[VSUM_DIFFS_ALT; LE_0] THEN + SIMP_TAC[SUB_0; SUB_ADD; SUB_REFL; + complex_pow; COMPLEX_MUL_LID; COMPLEX_MUL_RID]);; + +let COMPLEX_SUB_POW_R1 = prove + (`!x n. 1 <= n + ==> x pow n - Cx(&1) = (x - Cx(&1)) * vsum(0..n-1) (\i. x pow i)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`x:complex`; `Cx(&1)`] o + MATCH_MP COMPLEX_SUB_POW) THEN + REWRITE_TAC[COMPLEX_POW_ONE; COMPLEX_MUL_RID]);; + +let COMPLEX_SUB_POW_L1 = prove + (`!x n. 1 <= n + ==> Cx(&1) - x pow n = (Cx(&1) - x) * vsum(0..n-1) (\i. x pow i)`, + ONCE_REWRITE_TAC[GSYM COMPLEX_NEG_SUB] THEN + SIMP_TAC[COMPLEX_SUB_POW_R1] THEN REWRITE_TAC[COMPLEX_MUL_LNEG]);; + +(* ------------------------------------------------------------------------- *) +(* The complex numbers that are real (zero imaginary part). *) +(* ------------------------------------------------------------------------- *) + +let real = new_definition + `real z <=> Im z = &0`;; + +let REAL = prove + (`!z. real z <=> Cx(Re z) = z`, + REWRITE_TAC[COMPLEX_EQ; real; CX_DEF; RE; IM] THEN REAL_ARITH_TAC);; + +let REAL_CNJ = prove + (`!z. real z <=> cnj z = z`, + REWRITE_TAC[real; cnj; COMPLEX_EQ; RE; IM] THEN REAL_ARITH_TAC);; + +let REAL_IMP_CNJ = prove + (`!z. real z ==> cnj z = z`, + REWRITE_TAC[REAL_CNJ]);; + +let REAL_EXISTS = prove + (`!z. real z <=> ?x. z = Cx x`, + MESON_TAC[REAL; real; IM_CX]);; + +let FORALL_REAL = prove + (`(!z. real z ==> P z) <=> (!x. P(Cx x))`, + MESON_TAC[REAL_EXISTS]);; + +let EXISTS_REAL = prove + (`(?z. real z /\ P z) <=> (?x. P(Cx x))`, + MESON_TAC[REAL_EXISTS]);; + +let REAL_CX = prove + (`!x. real(Cx x)`, + REWRITE_TAC[REAL_CNJ; CNJ_CX]);; + +let REAL_MUL_CX = prove + (`!x z. real(Cx x * z) <=> x = &0 \/ real z`, + REWRITE_TAC[real; IM_MUL_CX; REAL_ENTIRE]);; + +let REAL_ADD = prove + (`!w z. real w /\ real z ==> real(w + z)`, + SIMP_TAC[REAL_CNJ; CNJ_ADD]);; + +let REAL_NEG = prove + (`!z. real z ==> real(--z)`, + SIMP_TAC[REAL_CNJ; CNJ_NEG]);; + +let REAL_SUB = prove + (`!w z. real w /\ real z ==> real(w - z)`, + SIMP_TAC[REAL_CNJ; CNJ_SUB]);; + +let REAL_MUL = prove + (`!w z. real w /\ real z ==> real(w * z)`, + SIMP_TAC[REAL_CNJ; CNJ_MUL]);; + +let REAL_POW = prove + (`!z n. real z ==> real(z pow n)`, + SIMP_TAC[REAL_CNJ; CNJ_POW]);; + +let REAL_INV = prove + (`!z. real z ==> real(inv z)`, + SIMP_TAC[REAL_CNJ; CNJ_INV]);; + +let REAL_INV_EQ = prove + (`!z. real(inv z) = real z`, + MESON_TAC[REAL_INV; COMPLEX_INV_INV]);; + +let REAL_DIV = prove + (`!w z. real w /\ real z ==> real(w / z)`, + SIMP_TAC[REAL_CNJ; CNJ_DIV]);; + +let REAL_VSUM = prove + (`!f s. FINITE s /\ (!a. a IN s ==> real(f a)) ==> real(vsum s f)`, + SIMP_TAC[CNJ_VSUM; REAL_CNJ]);; + +let REAL_MUL_CNJ = prove + (`(!z. real(z * cnj z)) /\ (!z. real(cnj z * z))`, + REWRITE_TAC[COMPLEX_MUL_CNJ; GSYM CX_POW; REAL_CX]);; + +let REAL_SEGMENT = prove + (`!a b x. x IN segment[a,b] /\ real a /\ real b ==> real x`, + SIMP_TAC[segment; IN_ELIM_THM; real; COMPLEX_EQ; LEFT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM; IM_ADD; IM_CMUL] THEN + REAL_ARITH_TAC);; + +let IN_SEGMENT_CX = prove + (`!a b x. Cx(x) IN segment[Cx(a),Cx(b)] <=> + a <= x /\ x <= b \/ b <= x /\ x <= a`, + REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THEN + REWRITE_TAC[COMPLEX_CMUL; GSYM CX_ADD; CX_INJ; GSYM CX_MUL] THEN + ASM_CASES_TAC `a:real = b` THENL + [ASM_REWRITE_TAC[REAL_ARITH `(&1 - u) * b + u * b = b`] THEN + ASM_CASES_TAC `x:real = b` THEN ASM_REWRITE_TAC[REAL_LE_ANTISYM] THEN + EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_POS]; + ALL_TAC] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real` + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[REAL_ARITH `a <= (&1 - u) * a + u * b <=> &0 <= u * (b - a)`; + REAL_ARITH `b <= (&1 - u) * a + u * b <=> &0 <= (&1 - u) * (a - b)`; + REAL_ARITH `(&1 - u) * a + u * b <= a <=> &0 <= u * (a - b)`; + REAL_ARITH `(&1 - u) * a + u * b <= b <=> &0 <= (&1 - u) * (b - a)`] THEN + DISJ_CASES_TAC(REAL_ARITH `a <= b \/ b <= a`) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + STRIP_TAC THENL + [SUBGOAL_THEN `&0 < b - a` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + EXISTS_TAC `(x - a:real) / (b - a)`]; + SUBGOAL_THEN `&0 < a - b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + EXISTS_TAC `(a - x:real) / (a - b)`]] THEN + (CONJ_TAC THENL + [ALL_TAC; UNDISCH_TAC `~(a:real = b)` THEN CONV_TAC REAL_FIELD]) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + ASM_REAL_ARITH_TAC);; + +let IN_SEGMENT_CX_GEN = prove + (`!a b x. + x IN segment[Cx a,Cx b] <=> + Im(x) = &0 /\ (a <= Re x /\ Re x <= b \/ b <= Re x /\ Re x <= a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real] THEN + ASM_CASES_TAC `real x` THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o REWRITE_RULE[REAL]) THEN + REWRITE_TAC[IN_SEGMENT_CX; REAL_CX; RE_CX] THEN REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_SEGMENT; REAL_CX]]);; + +let RE_POS_SEGMENT = prove + (`!a b x. x IN segment[a,b] /\ &0 < Re a /\ &0 < Re b ==> &0 < Re x`, + SIMP_TAC[segment; IN_ELIM_THM; real; COMPLEX_EQ; LEFT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM; RE_ADD; RE_CMUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ENTIRE] THEN + ASM_REAL_ARITH_TAC);; + +let CONVEX_REAL = prove + (`convex real`, + REWRITE_TAC[convex; IN; COMPLEX_CMUL] THEN + SIMP_TAC[REAL_ADD; REAL_MUL; REAL_CX]);; + +let IMAGE_CX = prove + (`!s. IMAGE Cx s = {z | real z /\ Re(z) IN s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[RE_CX; REAL]);; + +(* ------------------------------------------------------------------------- *) +(* Useful bound-type theorems for real quantities. *) +(* ------------------------------------------------------------------------- *) + +let REAL_NORM = prove + (`!z. real z ==> norm(z) = abs(Re z)`, + SIMP_TAC[real; complex_norm] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[POW_2_SQRT_ABS; REAL_ADD_RID]);; + +let REAL_NORM_POS = prove + (`!z. real z /\ &0 <= Re z ==> norm(z) = Re(z)`, + SIMP_TAC[REAL_NORM] THEN REAL_ARITH_TAC);; + +let COMPLEX_NORM_VSUM_SUM_RE = prove + (`!f s. FINITE s /\ (!x. x IN s ==> real(f x) /\ &0 <= Re(f x)) + ==> norm(vsum s f) = sum s (\x. Re(f x))`, + SIMP_TAC[GSYM RE_VSUM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_NORM_POS THEN + ASM_SIMP_TAC[REAL_VSUM; RE_VSUM; SUM_POS_LE]);; + +let COMPLEX_NORM_VSUM_BOUND = prove + (`!s f:A->complex g:A->complex. + FINITE s /\ (!x. x IN s ==> real(g x) /\ norm(f x) <= Re(g x)) + ==> norm(vsum s f) <= norm(vsum s g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum s (\x. norm((f:A->complex) x))` THEN + ASM_SIMP_TAC[VSUM_NORM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum s (\x. Re((g:A->complex) x))` THEN + ASM_SIMP_TAC[SUM_LE] THEN + MATCH_MP_TAC(REAL_ARITH `x:real = y ==> y <= x`) THEN + MATCH_MP_TAC COMPLEX_NORM_VSUM_SUM_RE THEN + ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]);; + +let COMPLEX_NORM_VSUM_BOUND_SUBSET = prove + (`!f:A->complex g:A->complex s t. + FINITE s /\ t SUBSET s /\ + (!x. x IN s ==> real(g x) /\ norm(f x) <= Re(g x)) + ==> norm(vsum t f) <= norm(vsum s g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum t (g:A->complex))` THEN CONJ_TAC THENL + [ASM_MESON_TAC[COMPLEX_NORM_VSUM_BOUND; SUBSET; FINITE_SUBSET];ALL_TAC] THEN + SUBGOAL_THEN + `norm(vsum t (g:A->complex)) = sum t (\x. Re(g x)) /\ + norm(vsum s g) = sum s (\x. Re(g x))` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN MATCH_MP_TAC COMPLEX_NORM_VSUM_SUM_RE; + MATCH_MP_TAC SUM_SUBSET THEN REWRITE_TAC[IN_DIFF]] THEN + ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE; FINITE_SUBSET; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Geometric progression. *) +(* ------------------------------------------------------------------------- *) + +let VSUM_GP_BASIC = prove + (`!x n. (Cx(&1) - x) * vsum(0..n) (\i. x pow i) = Cx(&1) - x pow (SUC n)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[complex_pow; COMPLEX_MUL_RID; LE_0] THEN + ASM_REWRITE_TAC[COMPLEX_ADD_LDISTRIB; complex_pow] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let VSUM_GP_MULTIPLIED = prove + (`!x m n. m <= n + ==> ((Cx(&1) - x) * vsum(m..n) (\i. x pow i) = + x pow m - x pow (SUC n))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[VSUM_OFFSET_0; COMPLEX_POW_ADD; FINITE_NUMSEG; + COMPLEX_MUL_ASSOC; VSUM_GP_BASIC; VSUM_COMPLEX_RMUL] THEN + REWRITE_TAC[COMPLEX_SUB_RDISTRIB; GSYM COMPLEX_POW_ADD; COMPLEX_MUL_LID] THEN + ASM_SIMP_TAC[ARITH_RULE `m <= n ==> (SUC(n - m) + m = SUC n)`]);; + +let VSUM_GP = prove + (`!x m n. + vsum(m..n) (\i. x pow i) = + if n < m then Cx(&0) + else if x = Cx(&1) then Cx(&((n + 1) - m)) + else (x pow m - x pow (SUC n)) / (Cx(&1) - x)`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(ARITH_RULE `n < m \/ ~(n < m) /\ m <= n:num`) THEN + ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; COMPLEX_VEC_0] THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_POW_ONE; VSUM_CONST_NUMSEG; COMPLEX_MUL_RID]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(z = Cx(&1)) /\ (Cx(&1) - z) * x = y ==> x = y / (Cx(&1) - z)`) THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_SUB_0; VSUM_GP_MULTIPLIED]);; + +let VSUM_GP_OFFSET = prove + (`!x m n. vsum(m..m+n) (\i. x pow i) = + if x = Cx(&1) then Cx(&n) + Cx(&1) + else x pow m * (Cx(&1) - x pow (SUC n)) / (Cx(&1) - x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[VSUM_GP; ARITH_RULE `~(m + n < m:num)`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[REAL_OF_NUM_ADD; GSYM CX_ADD] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN ARITH_TAC; + REWRITE_TAC[complex_div; complex_pow; COMPLEX_POW_ADD] THEN + SIMPLE_COMPLEX_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Basics about polynomial functions: extremal behaviour and root counts. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_SUB_POLYFUN = prove + (`!a x y n. + 1 <= n + ==> vsum(0..n) (\i. a i * x pow i) - vsum(0..n) (\i. a i * y pow i) = + (x - y) * + vsum(0..n-1) (\j. vsum(j+1..n) (\i. a i * y pow (i - j - 1)) * x pow j)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM VSUM_SUB_NUMSEG; GSYM COMPLEX_SUB_LDISTRIB] THEN + GEN_REWRITE_TAC LAND_CONV [MATCH_MP VSUM_CLAUSES_LEFT (SPEC_ALL LE_0)] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; complex_pow; COMPLEX_MUL_RZERO; + COMPLEX_ADD_LID] THEN + SIMP_TAC[COMPLEX_SUB_POW; ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * x * s:complex = x * a * s`] THEN + SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; GSYM VSUM_COMPLEX_RMUL; FINITE_NUMSEG; + VSUM_VSUM_PRODUCT; FINITE_NUMSEG] THEN + MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC `\(x:num,y:num). (y,x)`) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `a - b - c:num = a - (b + c)`; ADD_SYM] THEN + REWRITE_TAC[COMPLEX_MUL_AC] THEN ARITH_TAC);; + +let COMPLEX_SUB_POLYFUN_ALT = prove + (`!a x y n. + 1 <= n + ==> vsum(0..n) (\i. a i * x pow i) - vsum(0..n) (\i. a i * y pow i) = + (x - y) * + vsum(0..n-1) (\j. vsum(0..n-j-1) (\k. a(j+k+1) * y pow k) * x pow j)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COMPLEX_SUB_POLYFUN] THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN + MAP_EVERY EXISTS_TAC + [`\i. i - (j + 1)`; `\k. j + k + 1`] THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + TRY(BINOP_TAC THEN AP_TERM_TAC) THEN ASM_ARITH_TAC);; + +let COMPLEX_POLYFUN_LINEAR_FACTOR = prove + (`!a c n. ?b. !z. vsum(0..n) (\i. c(i) * z pow i) = + (z - a) * vsum(0..n-1) (\i. b(i) * z pow i) + + vsum(0..n) (\i. c(i) * a pow i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM COMPLEX_EQ_SUB_RADD] THEN + ASM_CASES_TAC `n = 0` THENL + [EXISTS_TAC `\i:num. Cx(&0)` THEN + ASM_SIMP_TAC[VSUM_SING; NUMSEG_SING; complex_pow; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_SUB_REFL; GSYM COMPLEX_VEC_0; VSUM_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]; + ASM_SIMP_TAC[COMPLEX_SUB_POLYFUN; LE_1] THEN + EXISTS_TAC `\j. vsum (j + 1..n) (\i. c i * a pow (i - j - 1))` THEN + REWRITE_TAC[]]);; + +let COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT = prove + (`!a c n. vsum(0..n) (\i. c(i) * a pow i) = Cx(&0) + ==> ?b. !z. vsum(0..n) (\i. c(i) * z pow i) = + (z - a) * vsum(0..n-1) (\i. b(i) * z pow i)`, + MESON_TAC[COMPLEX_POLYFUN_LINEAR_FACTOR; COMPLEX_ADD_RID]);; + +let COMPLEX_POLYFUN_EXTREMAL_LEMMA = prove + (`!c n e. &0 < e + ==> ?M. !z. M <= norm(z) + ==> norm(vsum(0..n) (\i. c(i) * z pow i)) + <= e * norm(z) pow (n + 1)`, + GEN_TAC THEN INDUCT_TAC THEN SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[ADD_CLAUSES; complex_pow; REAL_POW_1; COMPLEX_MUL_RID] THEN + EXISTS_TAC `norm(c 0:complex) / e` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[REAL_MUL_AC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (REAL_ARITH `&0 < &1 / &2`)) THEN + DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN + EXISTS_TAC `max M ((&1 / &2 + norm(c(n+1):complex)) / e)` THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `a + norm(y) <= b ==> norm(x) <= a ==> norm(x + y) <= b`) THEN + SIMP_TAC[ADD1; COMPLEX_NORM_MUL; COMPLEX_NORM_POW; + GSYM REAL_ADD_RDISTRIB; ARITH_RULE `(n + 1) + 1 = 1 + n + 1`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_POW_ADD] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LE; NORM_POS_LE; REAL_POW_1]);; + +let COMPLEX_POLYFUN_EXTREMAL = prove + (`!c n. (!k. k IN 1..n ==> c(k) = Cx(&0)) \/ + !B. eventually (\z. norm(vsum(0..n) (\i. c(i) * z pow i)) >= B) + at_infinity`, + GEN_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[NUMSEG_CLAUSES; ARITH; NOT_IN_EMPTY] THEN + MP_TAC(ARITH_RULE `0 <= n`) THEN SIMP_TAC[GSYM NUMSEG_RREC] THEN + DISCH_THEN(K ALL_TAC) THEN ASM_CASES_TAC `c(n:num) = Cx(&0)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM NUMSEG_RREC; LE_1] THEN + SIMP_TAC[IN_INSERT; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_LID; COND_ID] THEN + ASM_MESON_TAC[]; + DISJ2_TAC THEN MP_TAC(ISPECL + [`c:num->complex`; `n - 1`; `norm(c(n:num):complex) / &2`] + COMPLEX_POLYFUN_EXTREMAL_LEMMA) THEN ASM_SIMP_TAC[SUB_ADD; LE_1] THEN + ASM_SIMP_TAC[COMPLEX_NORM_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + SIMP_TAC[IN_INSERT; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> ~(n <= n - 1)`] THEN + DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN X_GEN_TAC `B:real` THEN + REWRITE_TAC[EVENTUALLY_AT_INFINITY] THEN EXISTS_TAC + `max M (max (&1) ((abs B + &1) / (norm(c(n:num):complex) / &2)))` THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[real_ge; REAL_MAX_LE] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH + `abs b + &1 <= norm(y) - a ==> norm(x) <= a ==> b <= norm(y + x)`) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW] THEN + REWRITE_TAC[REAL_ARITH `c * x - c / &2 * x = x * c / &2`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; COMPLEX_NORM_NZ; REAL_LT_DIV; + REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(z:complex) pow 1` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_POW_1]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_MONO THEN ASM_SIMP_TAC[LE_1]]);; + +let COMPLEX_POLYFUN_ROOTBOUND = prove + (`!n c. ~(!i. i IN 0..n ==> c(i) = Cx(&0)) + ==> FINITE {z | vsum(0..n) (\i. c(i) * z pow i) = Cx(&0)} /\ + CARD {z | vsum(0..n) (\i. c(i) * z pow i) = Cx(&0)} <= n`, + REWRITE_TAC[TAUT `~a ==> b <=> a \/ b`] THEN INDUCT_TAC THEN GEN_TAC THENL + [SIMP_TAC[NUMSEG_SING; VSUM_SING; IN_SING; complex_pow] THEN + ASM_CASES_TAC `c 0 = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RID] THEN + REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES; CARD_CLAUSES; LE_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `{z | vsum(0..SUC n) (\i. c(i) * z pow i) = Cx(&0)} = {}` THEN + ASM_REWRITE_TAC[FINITE_RULES; CARD_CLAUSES; LE_0] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:complex` MP_TAC o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT) THEN + DISCH_THEN(X_CHOOSE_TAC `b:num->complex`) THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_SUB_0; SUC_SUB1; SET_RULE + `{z | z = a \/ P z} = a INSERT {z | P z}`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b:num->complex`) THEN + STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THENL + [DISJ1_TAC; ASM_ARITH_TAC] THEN + MP_TAC(SPECL [`c:num->complex`; `SUC n`] COMPLEX_POLYFUN_EXTREMAL) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN + ASM_SIMP_TAC[SUC_SUB1; COMPLEX_MUL_LZERO] THEN + SIMP_TAC[COMPLEX_POW_ZERO; COND_RAND; COMPLEX_MUL_RZERO] THEN + ASM_SIMP_TAC[VSUM_0; GSYM COMPLEX_VEC_0; VSUM_DELTA; IN_NUMSEG; LE_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO; COMPLEX_NORM_NUM] THEN + REWRITE_TAC[COMPLEX_MUL_RID; real_ge; EVENTUALLY_AT_INFINITY] THEN + REPEAT STRIP_TAC THENL [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM] THEN X_GEN_TAC `b:real` THEN + MP_TAC(SPEC `b:real` (INST_TYPE [`:2`,`:N`] VECTOR_CHOOSE_SIZE)) THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_LE_TOTAL; REAL_LE_TRANS]);; + +let COMPLEX_POLYFUN_FINITE_ROOTS = prove + (`!n c. FINITE {x | vsum(0..n) (\i. c i * x pow i) = Cx(&0)} <=> + ?i. i IN 0..n /\ ~(c i = Cx(&0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `a /\ ~b <=> ~(a ==> b)`] THEN + REWRITE_TAC[GSYM NOT_FORALL_THM] THEN EQ_TAC THEN + SIMP_TAC[COMPLEX_POLYFUN_ROOTBOUND] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[COMPLEX_MUL_LZERO] THEN SIMP_TAC[GSYM COMPLEX_VEC_0; VSUM_0] THEN + REWRITE_TAC[SET_RULE `{x | T} = (:complex)`; GSYM INFINITE; + EUCLIDEAN_SPACE_INFINITE]);; + +let COMPLEX_POLYFUN_EQ_0 = prove + (`!n c. (!z. vsum(0..n) (\i. c i * z pow i) = Cx(&0)) <=> + (!i. i IN 0..n ==> c i = Cx(&0))`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_THEN(MP_TAC o MATCH_MP + COMPLEX_POLYFUN_ROOTBOUND) THEN + ASM_REWRITE_TAC[EUCLIDEAN_SPACE_INFINITE; GSYM INFINITE; DE_MORGAN_THM; + SET_RULE `{x | T} = (:complex)`]; + ASM_SIMP_TAC[IN_NUMSEG; LE_0; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0]]);; + +let COMPLEX_POLYFUN_EQ_CONST = prove + (`!n c k. (!z. vsum(0..n) (\i. c i * z pow i) = k) <=> + c 0 = k /\ (!i. i IN 1..n ==> c i = Cx(&0))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `!x. vsum(0..n) (\i. (if i = 0 then c 0 - k else c i) * x pow i) = + Cx(&0)` THEN + CONJ_TAC THENL + [SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; complex_pow; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_RING `(c - k) + s = Cx(&0) <=> c + s = k`] THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN + REWRITE_TAC[IN_NUMSEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]; + REWRITE_TAC[COMPLEX_POLYFUN_EQ_0; IN_NUMSEG; LE_0] THEN + GEN_REWRITE_TAC LAND_CONV [MESON[] + `(!n. P n) <=> P 0 /\ (!n. ~(n = 0) ==> P n)`] THEN + SIMP_TAC[LE_0; COMPLEX_SUB_0] THEN MESON_TAC[LE_1]]);; + +(* ------------------------------------------------------------------------- *) +(* Complex products. *) +(* ------------------------------------------------------------------------- *) + +let cproduct = new_definition + `cproduct = iterate (( * ):complex->complex->complex)`;; + +let NEUTRAL_COMPLEX_MUL = prove + (`neutral(( * ):complex->complex->complex) = Cx(&1)`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_RID]);; + +let MONOIDAL_COMPLEX_MUL = prove + (`monoidal(( * ):complex->complex->complex)`, + REWRITE_TAC[monoidal; NEUTRAL_COMPLEX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let CPRODUCT_CLAUSES = prove + (`(!f. cproduct {} f = Cx(&1)) /\ + (!x f s. FINITE(s) + ==> (cproduct (x INSERT s) f = + if x IN s then cproduct s f else f(x) * cproduct s f))`, + REWRITE_TAC[cproduct; GSYM NEUTRAL_COMPLEX_MUL] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_COMPLEX_MUL]);; + +let CPRODUCT_EQ_0 = prove + (`!f s. FINITE s ==> (cproduct s f = Cx(&0) <=> ?x. x IN s /\ f(x) = Cx(&0))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_ENTIRE; IN_INSERT; CX_INJ; REAL_OF_NUM_EQ; + ARITH; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +let CPRODUCT_INV = prove + (`!f s. FINITE s ==> cproduct s (\x. inv(f x)) = inv(cproduct s f)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_INV_1; COMPLEX_INV_MUL]);; + +let CPRODUCT_MUL = prove + (`!f g s. FINITE s + ==> cproduct s (\x. f x * g x) = cproduct s f * cproduct s g`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_MUL_AC; COMPLEX_MUL_LID]);; + +let CPRODUCT_EQ_1 = prove + (`!f s. (!x:A. x IN s ==> (f(x) = Cx(&1))) ==> (cproduct s f = Cx(&1))`, + REWRITE_TAC[cproduct; GSYM NEUTRAL_COMPLEX_MUL] THEN + SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_COMPLEX_MUL]);; + +let CPRODUCT_1 = prove + (`!s. cproduct s (\n. Cx(&1)) = Cx(&1)`, + SIMP_TAC[CPRODUCT_EQ_1]);; + +let CPRODUCT_POW = prove + (`!f s n. FINITE s + ==> cproduct s (\x. f x pow n) = (cproduct s f) pow n`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[complex_pow; CPRODUCT_MUL; CPRODUCT_1]);; + +let NORM_CPRODUCT = prove + (`!f s. FINITE s ==> norm(cproduct s f) = product s (\x. norm(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; COMPLEX_NORM_CX; REAL_ABS_NUM; + CPRODUCT_MUL; PRODUCT_CLAUSES; COMPLEX_NORM_MUL]);; + +let CPRODUCT_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> cproduct s f = cproduct s g`, + REWRITE_TAC[cproduct] THEN MATCH_MP_TAC ITERATE_EQ THEN + REWRITE_TAC[MONOIDAL_COMPLEX_MUL]);; + +let CPRODUCT_SING = prove + (`!f x. cproduct {x} f = f(x)`, + SIMP_TAC[CPRODUCT_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; COMPLEX_MUL_RID]);; + +let CPRODUCT_CLAUSES_NUMSEG = prove + (`(!m. cproduct(m..0) f = if m = 0 then f(0) else Cx(&1)) /\ + (!m n. cproduct(m..SUC n) f = if m <= SUC n then cproduct(m..n) f * f(SUC n) + else cproduct(m..n) f)`, + REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[CPRODUCT_SING; CPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; COMPLEX_MUL_AC]);; + +let CPRODUCT_CLAUSES_RIGHT = prove + (`!f m n. 0 < n /\ m <= n ==> cproduct(m..n) f = cproduct(m..n-1) f * (f n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LT_REFL; CPRODUCT_CLAUSES_NUMSEG; SUC_SUB1]);; + +let CPRODUCT_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> cproduct(m..n) f = f m * cproduct(m + 1..n) f`, + SIMP_TAC[GSYM NUMSEG_LREC; CPRODUCT_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ARITH_TAC);; + +let CPRODUCT_IMAGE = prove + (`!f g s. (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y)) + ==> (cproduct (IMAGE f s) g = cproduct s (g o f))`, + REWRITE_TAC[cproduct; GSYM NEUTRAL_COMPLEX_MUL] THEN + MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_COMPLEX_MUL]);; + +let CPRODUCT_OFFSET = prove + (`!f m p. cproduct(m+p..n+p) f = cproduct(m..n) (\i. f(i + p))`, + SIMP_TAC[NUMSEG_OFFSET_IMAGE; CPRODUCT_IMAGE; + EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[o_DEF]);; + +let CPRODUCT_CONST = prove + (`!c s. FINITE s ==> cproduct s (\x. c) = c pow (CARD s)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; CARD_CLAUSES; complex_pow]);; + +let CPRODUCT_CONST_NUMSEG = prove + (`!c m n. cproduct (m..n) (\x. c) = c pow ((n + 1) - m)`, + SIMP_TAC[CPRODUCT_CONST; CARD_NUMSEG; FINITE_NUMSEG]);; + +let CPRODUCT_PAIR = prove + (`!f m n. cproduct(2*m..2*n+1) f = cproduct(m..n) (\i. f(2*i) * f(2*i+1))`, + MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_COMPLEX_MUL) THEN + REWRITE_TAC[cproduct; NEUTRAL_COMPLEX_MUL]);; + +let CNJ_CPRODUCT = prove + (`!f s. FINITE s ==> cnj(cproduct s f) = cproduct s (\i. cnj(f i))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; CNJ_MUL; CNJ_CX]);; + +let CX_PRODUCT = prove + (`!f s. FINITE s ==> Cx(product s f) = cproduct s (\i. Cx(f i))`, + GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CPRODUCT_CLAUSES; PRODUCT_CLAUSES; GSYM CX_MUL]);; + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> cproduct s (\i. f(i)) = cproduct s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> cproduct(a..b) (\i. f(i)) = cproduct(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> cproduct {y | p y} (\i. f(i)) = cproduct {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CPRODUCT_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; diff --git a/Multivariate/convex.ml b/Multivariate/convex.ml new file mode 100644 index 0000000..58e4942 --- /dev/null +++ b/Multivariate/convex.ml @@ -0,0 +1,11827 @@ +(* ========================================================================= *) +(* Convex sets, functions and related things. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* (c) Copyright, Lars Schewe 2007 *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "Multivariate/topology.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some miscelleneous things that are convenient to prove here. *) +(* ------------------------------------------------------------------------- *) + +let TRANSLATION_GALOIS = prove + (`!s t a:real^N. s = IMAGE (\x. a + x) t <=> t = IMAGE (\x. --a + x) s`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^N = x`; + VECTOR_ARITH `a + --a + x:real^N = x`] THEN + REWRITE_TAC[IMAGE_ID]);; + +let TRANSLATION_EQ_IMP = prove + (`!P:(real^N->bool)->bool. + (!a s. P(IMAGE (\x. a + x) s) <=> P s) <=> + (!a s. P s ==> P (IMAGE (\x. a + x) s))`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN + EQ_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`--a:real^N`; `IMAGE (\x:real^N. a + x) s`]) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +let DIM_HYPERPLANE = prove + (`!a:real^N. ~(a = vec 0) ==> dim {x | a dot x = &0} = dimindex(:N) - 1`, + GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN + SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; DOT_BASIS; + DIMINDEX_GE_1; LE_REFL; REAL_ENTIRE; DIM_SPECIAL_HYPERPLANE]);; + +let LOWDIM_EQ_HYPERPLANE = prove + (`!s. dim s = dimindex(:N) - 1 + ==> ?a:real^N. ~(a = vec 0) /\ span s = {x | a dot x = &0}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` LOWDIM_SUBSET_HYPERPLANE) THEN + ASM_SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= a ==> a - 1 < a`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `a:real^N` SUBSPACE_HYPERPLANE) THEN + ONCE_REWRITE_TAC[GSYM SPAN_EQ_SELF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC DIM_EQ_SPAN THEN + ASM_SIMP_TAC[DIM_HYPERPLANE; LE_REFL] THEN + ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC]);; + +let DIM_EQ_HYPERPLANE = prove + (`!s. dim s = dimindex(:N) - 1 <=> + ?a:real^N. ~(a = vec 0) /\ span s = {x | a dot x = &0}`, + MESON_TAC[DIM_HYPERPLANE; LOWDIM_EQ_HYPERPLANE; DIM_SPAN]);; + +(* ------------------------------------------------------------------------- *) +(* Affine set and affine hull. *) +(* ------------------------------------------------------------------------- *) + +let affine = new_definition + `affine s <=> !x y u v. x IN s /\ y IN s /\ (u + v = &1) + ==> (u % x + v % y) IN s`;; + +let AFFINE_ALT = prove + (`affine s <=> !x y u. x IN s /\ y IN s ==> ((&1 - u) % x + u % y) IN s`, + REWRITE_TAC[affine] THEN + MESON_TAC[REAL_ARITH `(u + v = &1) <=> (u = &1 - v)`]);; + +let AFFINE_SCALING = prove + (`!s c. affine s ==> affine (IMAGE (\x. c % x) s)`, + REWRITE_TAC[affine; IN_IMAGE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % c % x + v % c % y = c % (u % x + v % y)`] THEN + ASM_MESON_TAC[]);; + +let AFFINE_SCALING_EQ = prove + (`!s c. ~(c = &0) ==> (affine (IMAGE (\x. c % x) s) <=> affine s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[AFFINE_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c` o MATCH_MP AFFINE_SCALING) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC; + REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]);; + +let AFFINE_NEGATIONS = prove + (`!s. affine s ==> affine (IMAGE (--) s)`, + REWRITE_TAC[affine; IN_IMAGE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % --x + v % --y = --(u % x + v % y)`] THEN + ASM_MESON_TAC[]);; + +let AFFINE_SUMS = prove + (`!s t. affine s /\ affine t ==> affine {x + y | x IN s /\ y IN t}`, + REWRITE_TAC[affine; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % (a + b) + v % (c + d) = (u % a + v % c) + (u % b + v % d)`] THEN + ASM_MESON_TAC[]);; + +let AFFINE_DIFFERENCES = prove + (`!s t. affine s /\ affine t ==> affine {x - y | x IN s /\ y IN t}`, + REWRITE_TAC[affine; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % (a - b) + v % (c - d) = (u % a + v % c) - (u % b + v % d)`] THEN + ASM_MESON_TAC[]);; + +let AFFINE_TRANSLATION_EQ = prove + (`!a:real^N s. affine (IMAGE (\x. a + x) s) <=> affine s`, + REWRITE_TAC[AFFINE_ALT; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH + `(&1 - u) % (a + x) + u % (a + y) = a + z <=> (&1 - u) % x + u % y = z`]);; + +add_translation_invariants [AFFINE_TRANSLATION_EQ];; + +let AFFINE_TRANSLATION = prove + (`!s a:real^N. affine s ==> affine (IMAGE (\x. a + x) s)`, + REWRITE_TAC[AFFINE_TRANSLATION_EQ]);; + +let AFFINE_AFFINITY = prove + (`!s a:real^N c. + affine s ==> affine (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; AFFINE_TRANSLATION; AFFINE_SCALING]);; + +let AFFINE_LINEAR_IMAGE = prove + (`!f s. affine s /\ linear f ==> affine(IMAGE f s)`, + REWRITE_TAC[affine; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_IMAGE; linear] THEN MESON_TAC[]);; + +let AFFINE_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (affine (IMAGE f s) <=> affine s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE AFFINE_LINEAR_IMAGE));; + +add_linear_invariants [AFFINE_LINEAR_IMAGE_EQ];; + +let AFFINE_EMPTY = prove + (`affine {}`, + REWRITE_TAC[affine; NOT_IN_EMPTY]);; + +let AFFINE_SING = prove + (`!x. affine {x}`, + SIMP_TAC[AFFINE_ALT; IN_SING] THEN + REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_SUB_ADD; VECTOR_MUL_LID]);; + +let AFFINE_UNIV = prove + (`affine(UNIV:real^N->bool)`, + REWRITE_TAC[affine; IN_UNIV]);; + +let AFFINE_HYPERPLANE = prove + (`!a b. affine {x | a dot x = b}`, + REWRITE_TAC[affine; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN + CONV_TAC REAL_RING);; + +let AFFINE_STANDARD_HYPERPLANE = prove + (`!a b k. affine {x:real^N | x$k = b}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `b:real`] AFFINE_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let AFFINE_INTERS = prove + (`(!s. s IN f ==> affine s) ==> affine(INTERS f)`, + REWRITE_TAC[affine; IN_INTERS] THEN MESON_TAC[]);; + +let AFFINE_INTER = prove + (`!s t. affine s /\ affine t ==> affine(s INTER t)`, + REWRITE_TAC[affine; IN_INTER] THEN MESON_TAC[]);; + +let AFFINE_AFFINE_HULL = prove + (`!s. affine(affine hull s)`, + SIMP_TAC[P_HULL; AFFINE_INTERS]);; + +let AFFINE_HULL_EQ = prove + (`!s. (affine hull s = s) <=> affine s`, + SIMP_TAC[HULL_EQ; AFFINE_INTERS]);; + +let IS_AFFINE_HULL = prove + (`!s. affine s <=> ?t. s = affine hull t`, + GEN_TAC THEN MATCH_MP_TAC IS_HULL THEN SIMP_TAC[AFFINE_INTERS]);; + +let AFFINE_HULL_UNIV = prove + (`affine hull (:real^N) = (:real^N)`, + REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_UNIV]);; + +let AFFINE_HULLS_EQ = prove + (`!s t. s SUBSET affine hull t /\ t SUBSET affine hull s + ==> affine hull s = affine hull t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULLS_EQ THEN + ASM_SIMP_TAC[AFFINE_INTERS]);; + +let AFFINE_HULL_TRANSLATION = prove + (`!a s. affine hull (IMAGE (\x. a + x) s) = + IMAGE (\x. a + x) (affine hull s)`, + REWRITE_TAC[hull] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [AFFINE_HULL_TRANSLATION];; + +let AFFINE_HULL_LINEAR_IMAGE = prove + (`!f s. linear f + ==> affine hull (IMAGE f s) = IMAGE f (affine hull s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[FUN_IN_IMAGE; HULL_INC] THEN + REWRITE_TAC[affine; IN_ELIM_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN + REWRITE_TAC[IN_IMAGE] THEN + MESON_TAC[REWRITE_RULE[affine] AFFINE_AFFINE_HULL]; + ASM_SIMP_TAC[LINEAR_ADD; LINEAR_CMUL] THEN + MESON_TAC[REWRITE_RULE[affine] AFFINE_AFFINE_HULL]]);; + +add_linear_invariants [AFFINE_HULL_LINEAR_IMAGE];; + +let IN_AFFINE_HULL_LINEAR_IMAGE = prove + (`!f:real^M->real^N s x. + linear f /\ x IN affine hull s ==> (f x) IN affine hull (IMAGE f s)`, + SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN SET_TAC[]);; + +let SAME_DISTANCES_TO_AFFINE_HULL = prove + (`!s a b:real^N. + (!x. x IN s ==> dist(x,a) = dist(x,b)) + ==> (!x. x IN affine hull s ==> dist(x,a) = dist(x,b))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN + ASM_REWRITE_TAC[AFFINE_ALT; IN_ELIM_THM] THEN + REWRITE_TAC[dist; NORM_EQ_SQUARE; NORM_POS_LE; VECTOR_ARITH + `((&1 - u) % x + u % y) - a:real^N = (&1 - u) % (x - a) + u % (y - a)`] THEN + REWRITE_TAC[NORM_POW_2; DOT_LMUL; DOT_RMUL; VECTOR_ARITH + `(x + y) dot (x + y):real^N = (x dot x + y dot y) + &2 * x dot y`] THEN + SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Some convenient lemmas about common affine combinations. *) +(* ------------------------------------------------------------------------- *) + +let IN_AFFINE_ADD_MUL = prove + (`!s a x:real^N d. affine s /\ a IN s /\ (a + x) IN s ==> (a + d % x) IN s`, + REWRITE_TAC[affine] THEN REPEAT STRIP_TAC THEN + SUBST1_TAC(VECTOR_ARITH `a + d % x:real^N = (&1 - d) % a + d % (a + x)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let IN_AFFINE_ADD_MUL_DIFF = prove + (`!s a x y z:real^N. + affine s /\ x IN s /\ y IN s /\ z IN s ==> (x + a % (y - z)) IN s`, + REWRITE_TAC[affine] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[VECTOR_ARITH + `x + a % (y - z):real^N = + &1 / &2 % ((&1 - &2 * a) % x + (&2 * a) % y) + + &1 / &2 % ((&1 + &2 * a) % x + (-- &2 * a) % z)`] THEN + FIRST_ASSUM MATCH_MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let IN_AFFINE_MUL_DIFF_ADD = prove + (`!s a x y z:real^N. + affine s /\ x IN s /\ y IN s /\ z IN s ==> a % (x - y) + z IN s`, + ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF]);; + +let IN_AFFINE_SUB_MUL_DIFF = prove + (`!s a x y z:real^N. + affine s /\ x IN s /\ y IN s /\ z IN s ==> x - a % (y - z) IN s`, + REWRITE_TAC[VECTOR_ARITH `x - a % (y - z):real^N = x + a % (z - y)`] THEN + SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF]);; + +let AFFINE_DIFFS_SUBSPACE = prove + (`!s:real^N->bool a. + affine s /\ a IN s ==> subspace {x - a | x IN s}`, + REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = x - a <=> x = a`; + VECTOR_ARITH `x - a + y - a:real^N = z - a <=> + z = (a + &1 % (x - a)) + &1 % (y - a)`; + VECTOR_ARITH `c % (x - a):real^N = y - a <=> + y = a + c % (x - a)`] THEN + MESON_TAC[IN_AFFINE_ADD_MUL_DIFF]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit formulations for affine combinations. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_VSUM = prove + (`!s k u x:A->real^N. + FINITE k /\ affine s /\ sum k u = &1 /\ (!i. i IN k ==> x i IN s) + ==> vsum k (\i. u i % x i) IN s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN + ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[SUM_CLAUSES] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] AFFINE_DIFFS_SUBSPACE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`{x - a:real^N | x IN s}`; + `(\i. u i % (x i - a)):A->real^N`; + `k:A->bool`] SUBSPACE_VSUM) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSPACE_MUL THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[VSUM_SUB; IN_ELIM_THM; VECTOR_SUB_LDISTRIB; VSUM_RMUL] THEN + REWRITE_TAC[VECTOR_ARITH `x - &1 % a:real^N = y - a <=> x = y`] THEN + ASM_MESON_TAC[]]);; + +let AFFINE_VSUM_STRONG = prove + (`!s k u x:A->real^N. + affine s /\ + sum k u = &1 /\ + (!i. i IN k ==> u i = &0 \/ x i IN s) + ==> vsum k (\i. u i % x i) IN s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum k (\i. u i % (x:A->real^N) i) = + vsum {i | i IN k /\ ~(u i = &0)} (\i. u i % x i)` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + SET_TAC[]; + MATCH_MP_TAC AFFINE_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[SUM_DEGENERATE; REAL_ARITH `~(&1 = &0)`]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM SET_TAC[]; + ASM SET_TAC[]]]);; + +let AFFINE_INDEXED = prove + (`!s:real^N->bool. + affine s <=> + !k u x. (!i:num. 1 <= i /\ i <= k ==> x(i) IN s) /\ + (sum (1..k) u = &1) + ==> vsum (1..k) (\i. u(i) % x(i)) IN s`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_VSUM THEN + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; + DISCH_TAC THEN REWRITE_TAC[affine] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2`) THEN + DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then u else v:real`) THEN + DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then x else y:real^N`) THEN + REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG; VSUM_CLAUSES_NUMSEG; + NUMSEG_SING; VSUM_SING; SUM_SING] THEN REWRITE_TAC[ARITH] THEN + ASM_MESON_TAC[]]);; + +let AFFINE_HULL_INDEXED = prove + (`!s. affine hull s = + {y:real^N | ?k u x. (!i. 1 <= i /\ i <= k ==> x i IN s) /\ + (sum (1..k) u = &1) /\ + (vsum (1..k) (\i. u i % x i) = y)}`, + GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`1`; `\i:num. &1`; `\i:num. x:real^N`] THEN + ASM_SIMP_TAC[FINITE_RULES; IN_SING; SUM_SING; VECTOR_MUL_LID; VSUM_SING; + REAL_POS; NUMSEG_SING]; + ALL_TAC; + REWRITE_TAC[AFFINE_INDEXED; SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MESON_TAC[]] THEN + REWRITE_TAC[affine; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`k1:num`; `u1:num->real`; `x1:num->real^N`; + `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `k1 + k2:num` THEN + EXISTS_TAC `\i:num. if i <= k1 then u * u1(i) else v * u2(i - k1):real` THEN + EXISTS_TAC `\i:num. if i <= k1 then x1(i) else x2(i - k1):real^N` THEN + ASM_SIMP_TAC[NUMSEG_ADD_SPLIT; ARITH_RULE `1 <= x + 1 /\ x < x + 1`; + IN_NUMSEG; SUM_UNION; VSUM_UNION; FINITE_NUMSEG; DISJOINT_NUMSEG; + ARITH_RULE `k1 + 1 <= i ==> ~(i <= k1)`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] NUMSEG_OFFSET_IMAGE] THEN + ASM_SIMP_TAC[SUM_IMAGE; VSUM_IMAGE; EQ_ADD_LCANCEL; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[o_DEF; ADD_SUB2; SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC; + FINITE_NUMSEG; REAL_MUL_RID] THEN + ASM_MESON_TAC[REAL_LE_MUL; ARITH_RULE + `i <= k1 + k2 /\ ~(i <= k1) ==> 1 <= i - k1 /\ i - k1 <= k2`]);; + +let AFFINE = prove + (`!V:real^N->bool. + affine V <=> + !(s:real^N->bool) (u:real^N->real). + FINITE s /\ ~(s = {}) /\ s SUBSET V /\ sum s u = &1 + ==> vsum s (\x. u x % x) IN V`, + GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_VSUM THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[affine] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB;VECTOR_MUL_LID];ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N,y}`) THEN + DISCH_THEN(MP_TAC o SPEC `\w. if w = x:real^N then u else v:real`) THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_RULES; NUMSEG_SING; + VSUM_SING; SUM_SING;SUBSET;IN_INSERT;NOT_IN_EMPTY] THEN + ASM SET_TAC[]]);; + +let AFFINE_EXPLICIT = prove + (`!s:real^N->bool. + affine s <=> + !t u. FINITE t /\ t SUBSET s /\ sum t u = &1 + ==> vsum t (\x. u(x) % x) IN s`, + GEN_TAC THEN REWRITE_TAC[AFFINE] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let AFFINE_HULL_EXPLICIT = prove + (`!(p:real^N -> bool). + affine hull p = + {y | ?s u. FINITE s /\ ~(s = {}) /\ s SUBSET p /\ + sum s u = &1 /\ vsum s (\v. u v % v) = y}`, + GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET;IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`{x:real^N}`;`\v:real^N. &1:real`] THEN + ASM_SIMP_TAC[FINITE_RULES;IN_SING;SUM_SING;VSUM_SING;VECTOR_MUL_LID] THEN + SET_TAC[]; + REWRITE_TAC[affine;IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `(s UNION s'):real^N->bool` THEN + EXISTS_TAC + `\a:real^N. (\b:real^N.if (b IN s) then (u * (u' b)) else &0) a + + (\b:real^N.if (b IN s') then v * (u'' b) else &0) a` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FINITE_UNION]; + ASM SET_TAC[]; + ASM_REWRITE_TAC[UNION_SUBSET]; + ASM_SIMP_TAC[REWRITE_RULE[REAL_ARITH `a + b = c + d <=> c = a + b - d`] + SUM_INCL_EXCL; GSYM SUM_RESTRICT_SET; + SET_RULE `{a | a IN (s:A->bool) /\ a IN s'} = s INTER s'`; + SUM_ADD;SUM_LMUL;REAL_MUL_RID; + FINITE_INTER;INTER_IDEMPOT] THEN + ASM_REWRITE_TAC[SET_RULE `(a INTER b) INTER a = a INTER b`; + SET_RULE `(a INTER b) INTER b = a INTER b`; + REAL_ARITH `(a + b) + (c + d) - (e + b) = (a + d) + c - e`; + REAL_ARITH `a + b - c = a <=> b = c`] THEN + AP_TERM_TAC THEN REWRITE_TAC[INTER_COMM]; + ASM_SIMP_TAC[REWRITE_RULE + [VECTOR_ARITH `(a:real^N) + b = c + d <=> c = a + b - d`] + VSUM_INCL_EXCL;GSYM VSUM_RESTRICT_SET; + SET_RULE `{a | a IN (s:A->bool) /\ a IN s'} = s INTER s'`; + VSUM_ADD;FINITE_INTER;INTER_IDEMPOT;VECTOR_ADD_RDISTRIB; + GSYM VECTOR_MUL_ASSOC;VSUM_LMUL; + MESON[] `(if P then a else b) % (x:real^N) = + (if P then a % x else b % x)`; + VECTOR_MUL_LZERO;GSYM VSUM_RESTRICT_SET] THEN + ASM_REWRITE_TAC[SET_RULE `(a INTER b) INTER a = a INTER b`; + SET_RULE `(a INTER b) INTER b = a INTER b`; + VECTOR_ARITH + `((a:real^N) + b) + (c + d) - (e + b) = (a + d) + c - e`; + VECTOR_ARITH `(a:real^N) + b - c = a <=> b = c`] THEN + AP_TERM_TAC THEN REWRITE_TAC[INTER_COMM]]; + ASM_CASES_TAC `(p:real^N->bool) = {}` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[SUBSET_EMPTY;EMPTY_SUBSET] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[AFFINE; SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + ASM SET_TAC[]]);; + +let AFFINE_HULL_EXPLICIT_ALT = prove + (`!(p:real^N -> bool). + affine hull p = + {y | ?s u. FINITE s /\ s SUBSET p /\ + sum s u = &1 /\ vsum s (\v. u v % v) = y}`, + GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_EXPLICIT] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ]);; + +let AFFINE_HULL_FINITE = prove + (`!s:real^N->bool. + affine hull s = {y | ?u. sum s u = &1 /\ vsum s (\v. u v % v) = y}`, + GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[AFFINE_HULL_EXPLICIT; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:real^N->real`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x:real^N. if x IN t then f x else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]; + X_GEN_TAC `f:real^N->real` THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN STRIP_TAC THEN + EXISTS_TAC `support (+) (f:real^N->real) s` THEN + EXISTS_TAC `f:real^N->real` THEN + MP_TAC(ASSUME `sum s (f:real^N->real) = &1`) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN + REWRITE_TAC[iterate] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NEUTRAL_REAL_ADD; REAL_OF_NUM_EQ; ARITH] THEN + DISCH_THEN(K ALL_TAC) THEN + UNDISCH_TAC `sum s (f:real^N->real) = &1` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM SUM_SUPPORT] THEN + ASM_CASES_TAC `support (+) (f:real^N->real) s = {}` THEN + ASM_SIMP_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN + DISCH_TAC THEN REWRITE_TAC[SUPPORT_SUBSET] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[SUPPORT_SUBSET] THEN + REWRITE_TAC[support; IN_ELIM_THM; NEUTRAL_REAL_ADD] THEN + MESON_TAC[VECTOR_MUL_LZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* Stepping theorems and hence small special cases. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_HULL_EMPTY = prove + (`affine hull {} = {}`, + MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[SUBSET_REFL; AFFINE_EMPTY; EMPTY_SUBSET]);; + +let AFFINE_HULL_EQ_EMPTY = prove + (`!s. (affine hull s = {}) <=> (s = {})`, + GEN_TAC THEN EQ_TAC THEN + MESON_TAC[SUBSET_EMPTY; HULL_SUBSET; AFFINE_HULL_EMPTY]);; + +let AFFINE_HULL_FINITE_STEP_GEN = prove + (`!P:real^N->real->bool. + ((?u. (!x. x IN {} ==> P x (u x)) /\ + sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=> + w = &0 /\ y = vec 0) /\ + (FINITE(s:real^N->bool) /\ + (!y. a IN s /\ P a y ==> P a (y / &2)) /\ + (!x y. a IN s /\ P a x /\ P a y ==> P a (x + y)) + ==> ((?u. (!x. x IN (a INSERT s) ==> P x (u x)) /\ + sum (a INSERT s) u = w /\ + vsum (a INSERT s) (\x. u(x) % x) = y) <=> + ?v u. P a v /\ (!x. x IN s ==> P x (u x)) /\ + sum s u = w - v /\ + vsum s (\x. u(x) % x) = y - v % a))`, + GEN_TAC THEN SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NOT_IN_EMPTY] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN EQ_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN + EXISTS_TAC `(u:real^N->real) a / &2` THEN + EXISTS_TAC `\x:real^N. if x = a then u x / &2 else u x`; + MAP_EVERY X_GEN_TAC [`v:real`; `u:real^N->real`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x:real^N. if x = a then u x + v else u x`] THEN + ASM_SIMP_TAC[] THEN (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[VSUM_CASES; SUM_CASES] THEN + ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; VSUM_DELETE] THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN + REWRITE_TAC[SUM_SING; VSUM_SING] THEN + (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]); + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN + EXISTS_TAC `(u:real^N->real) a` THEN + EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[IN_INSERT] THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]; + MAP_EVERY X_GEN_TAC [`v:real`; `u:real^N->real`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x:real^N. if x = a then v:real else u x` THEN + ASM_SIMP_TAC[IN_INSERT] THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[VSUM_CASES; SUM_CASES] THEN + ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; VSUM_DELETE] THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ x = a} = {}`] THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`] THEN + REWRITE_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]]]);; + +let AFFINE_HULL_FINITE_STEP = prove + (`((?u. sum {} u = w /\ vsum {} (\x. u(x) % x) = y) <=> + w = &0 /\ y = vec 0) /\ + (FINITE(s:real^N->bool) + ==> ((?u. sum (a INSERT s) u = w /\ + vsum (a INSERT s) (\x. u(x) % x) = y) <=> + ?v u. sum s u = w - v /\ + vsum s (\x. u(x) % x) = y - v % a))`, + MATCH_ACCEPT_TAC (REWRITE_RULE[] + (ISPEC `\x:real^N y:real. T` AFFINE_HULL_FINITE_STEP_GEN)));; + +let AFFINE_HULL_2 = prove + (`!a b. affine hull {a,b} = + {u % a + v % b | u + v = &1}`, + SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN + SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; + VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; + +let AFFINE_HULL_2_ALT = prove + (`!a b. affine hull {a,b} = {a + u % (b - a) | u IN (:real)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[AFFINE_HULL_2] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; ARITH_RULE `u + v = &1 <=> v = &1 - u`; + FORALL_UNWIND_THM2; UNWIND_THM2] THEN + CONJ_TAC THEN X_GEN_TAC `u:real` THEN EXISTS_TAC `&1 - u` THEN + VECTOR_ARITH_TAC);; + +let AFFINE_HULL_3 = prove + (`affine hull {a,b,c} = + { u % a + v % b + w % c | u + v + w = &1}`, + SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN + SIMP_TAC[AFFINE_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; + VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some relations between affine hull and subspaces. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_HULL_INSERT_SUBSET_SPAN = prove + (`!a:real^N s. + affine hull (a INSERT s) SUBSET {a + v | v | v IN span {x - a | x IN s}}`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[AFFINE_HULL_EXPLICIT; SPAN_EXPLICIT; IN_ELIM_THM] THEN + REWRITE_TAC[SIMPLE_IMAGE; CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[MESON[] + `(?s u. (?t. P t /\ s = f t) /\ Q s u) <=> + (?t u. P t /\ Q (f t) u)`] THEN + REWRITE_TAC[MESON[] + `(?v. (?s u. P s /\ f s u = v) /\ (x = g a v)) <=> + (?s u. ~(P s ==> ~(g a (f s u) = x)))`] THEN + SIMP_TAC[VSUM_IMAGE; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + REWRITE_TAC[o_DEF] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MAP_EVERY EXISTS_TAC + [`t DELETE (a:real^N)`; `\x. (u:real^N->real)(x + a)`] THEN + ASM_SIMP_TAC[FINITE_DELETE; VECTOR_SUB_ADD; SET_RULE + `t SUBSET (a INSERT s) ==> t DELETE a SUBSET s`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `a + vsum t (\x. u x % (x - a)):real^N` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN SET_TAC[]; + ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; FINITE_DELETE; VSUM_SUB] THEN + ASM_REWRITE_TAC[VSUM_RMUL] THEN + REWRITE_TAC[VECTOR_ARITH `a + x - &1 % a:real^N = x`]]);; + +let AFFINE_HULL_INSERT_SPAN = prove + (`!a:real^N s. + ~(a IN s) + ==> affine hull (a INSERT s) = + {a + v | v | v IN span {x - a | x IN s}}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[AFFINE_HULL_INSERT_SUBSET_SPAN] THEN REWRITE_TAC[SUBSET] THEN + REWRITE_TAC[AFFINE_HULL_EXPLICIT; SPAN_EXPLICIT; IN_ELIM_THM] THEN + REWRITE_TAC[SIMPLE_IMAGE; CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[MESON[] + `(?s u. (?t. P t /\ s = f t) /\ Q s u) <=> + (?t u. P t /\ Q (f t) u)`] THEN + REWRITE_TAC[MESON[] + `(?v. (?s u. P s /\ f s u = v) /\ (x = g a v)) <=> + (?s u. ~(P s ==> ~(g a (f s u) = x)))`] THEN + SIMP_TAC[VSUM_IMAGE; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + REWRITE_TAC[o_DEF] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (SUBST1_TAC o SYM)) THEN + MAP_EVERY EXISTS_TAC + [`(a:real^N) INSERT t`; + `\x. if x = a then &1 - sum t (\x. u(x - a)) + else (u:real^N->real)(x - a)`] THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN + ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_INSERT; NOT_INSERT_EMPTY; + SET_RULE `s SUBSET t ==> (a INSERT s) SUBSET (a INSERT t)`] THEN + SUBGOAL_THEN `!x:real^N. x IN t ==> ~(x = a)` MP_TAC THENL + [ASM SET_TAC[]; SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC)] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; FINITE_DELETE; VSUM_SUB] THEN + ASM_REWRITE_TAC[VSUM_RMUL] THEN VECTOR_ARITH_TAC);; + +let AFFINE_HULL_SPAN = prove + (`!a:real^N s. + a IN s + ==> (affine hull s = + {a + v | v | v IN span {x - a | x | x IN (s DELETE a)}})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `s DELETE (a:real^N)`] + AFFINE_HULL_INSERT_SPAN) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let DIFFS_AFFINE_HULL_SPAN = prove + (`!a:real^N s. + a IN s ==> {x - a | x IN affine hull s} = span {x - a | x IN s}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP AFFINE_HULL_SPAN) THEN + REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID] THEN + SIMP_TAC[IMAGE_DELETE_INJ; + VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + REWRITE_TAC[VECTOR_SUB_REFL; SPAN_DELETE_0]);; + +let AFFINE_HULL_SING = prove + (`!a. affine hull {a} = {a}`, + SIMP_TAC[AFFINE_HULL_INSERT_SPAN; NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x | x | F} = {}`; SPAN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`; VECTOR_ADD_RID]);; + +let AFFINE_HULL_EQ_SING = prove + (`!s a:real^N. affine hull s = {a} <=> s = {a}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_SING] THEN + MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET {a} ==> s = {a}`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[HULL_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Convexity. *) +(* ------------------------------------------------------------------------- *) + +let convex = new_definition + `convex s <=> + !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> (u % x + v % y) IN s`;; + +let CONVEX_ALT = prove + (`convex s <=> !x y u. x IN s /\ y IN s /\ &0 <= u /\ u <= &1 + ==> ((&1 - u) % x + u % y) IN s`, + REWRITE_TAC[convex] THEN + MESON_TAC[REAL_ARITH `&0 <= u /\ &0 <= v /\ (u + v = &1) + ==> v <= &1 /\ (u = &1 - v)`; + REAL_ARITH `u <= &1 ==> &0 <= &1 - u /\ ((&1 - u) + u = &1)`]);; + +let IN_CONVEX_SET = prove + (`!s a b u. + convex s /\ a IN s /\ b IN s /\ &0 <= u /\ u <= &1 + ==> ((&1 - u) % a + u % b) IN s`, + MESON_TAC[CONVEX_ALT]);; + +let MIDPOINT_IN_CONVEX = prove + (`!s x y:real^N. + convex s /\ x IN s /\ y IN s ==> midpoint(x,y) IN s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`; `&1 / &2`] + IN_CONVEX_SET) THEN + ASM_REWRITE_TAC[midpoint] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC VECTOR_ARITH);; + +let CONVEX_CONTAINS_SEGMENT = prove + (`!s. convex s <=> !a b. a IN s /\ b IN s ==> segment[a,b] SUBSET s`, + REWRITE_TAC[CONVEX_ALT; segment; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let CONVEX_CONTAINS_OPEN_SEGMENT = prove + (`!s. convex s <=> !a b. a IN s /\ b IN s ==> segment(a,b) SUBSET s`, + ONCE_REWRITE_TAC[segment] THEN REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN + SET_TAC[]);; + +let CONVEX_CONTAINS_SEGMENT_EQ = prove + (`!s:real^N->bool. + convex s <=> !a b. segment[a,b] SUBSET s <=> a IN s /\ b IN s`, + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET] THEN + MESON_TAC[ENDS_IN_SEGMENT]);; + +let CONVEX_CONTAINS_SEGMENT_IMP = prove + (`!s a b. convex s ==> (segment[a,b] SUBSET s <=> a IN s /\ b IN s)`, + SIMP_TAC[CONVEX_CONTAINS_SEGMENT_EQ]);; + +let CONVEX_EMPTY = prove + (`convex {}`, + REWRITE_TAC[convex; NOT_IN_EMPTY]);; + +let CONVEX_SING = prove + (`!a. convex {a}`, + SIMP_TAC[convex; IN_SING; GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]);; + +let CONVEX_UNIV = prove + (`convex(UNIV:real^N->bool)`, + REWRITE_TAC[convex; IN_UNIV]);; + +let CONVEX_INTERS = prove + (`(!s. s IN f ==> convex s) ==> convex(INTERS f)`, + REWRITE_TAC[convex; IN_INTERS] THEN MESON_TAC[]);; + +let CONVEX_INTER = prove + (`!s t. convex s /\ convex t ==> convex(s INTER t)`, + REWRITE_TAC[convex; IN_INTER] THEN MESON_TAC[]);; + +let CONVEX_HALFSPACE_LE = prove + (`!a b. convex {x | a dot x <= b}`, + REWRITE_TAC[convex; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(u + v) * b` THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_ADD_RDISTRIB; REAL_LE_ADD2; REAL_LE_LMUL]; + ASM_MESON_TAC[REAL_MUL_LID; REAL_LE_REFL]]);; + +let CONVEX_HALFSPACE_COMPONENT_LE = prove + (`!a k. convex {x:real^N | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_LE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CONVEX_HALFSPACE_GE = prove + (`!a b. convex {x:real^N | a dot x >= b}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `{x:real^N | a dot x >= b} = {x | --a dot x <= --b}` + (fun th -> REWRITE_TAC[th; CONVEX_HALFSPACE_LE]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; DOT_LNEG] THEN REAL_ARITH_TAC);; + +let CONVEX_HALFSPACE_COMPONENT_GE = prove + (`!a k. convex {x:real^N | x$k >= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_GE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CONVEX_HYPERPLANE = prove + (`!a b. convex {x:real^N | a dot x = b}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `{x:real^N | a dot x = b} = {x | a dot x <= b} INTER {x | a dot x >= b}` + (fun th -> SIMP_TAC[th; CONVEX_INTER; + CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CONVEX_STANDARD_HYPERPLANE = prove + (`!k a. convex {x:real^N | x$k = a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CONVEX_HALFSPACE_LT = prove + (`!a b. convex {x | a dot x < b}`, + REWRITE_TAC[convex; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN + ASM_REWRITE_TAC[]);; + +let CONVEX_HALFSPACE_COMPONENT_LT = prove + (`!a k. convex {x:real^N | x$k < a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_LT) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CONVEX_HALFSPACE_GT = prove + (`!a b. convex {x | a dot x > b}`, + REWRITE_TAC[REAL_ARITH `ax > b <=> --ax < --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; CONVEX_HALFSPACE_LT]);; + +let CONVEX_HALFSPACE_COMPONENT_GT = prove + (`!a k. convex {x:real^N | x$k > a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CONVEX_HALFSPACE_GT) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CONVEX_POSITIVE_ORTHANT = prove + (`convex {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> &0 <= x$i}`, + SIMP_TAC[convex; IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + REAL_LE_MUL; REAL_LE_ADD]);; + +let LIMPT_OF_CONVEX = prove + (`!s x:real^N. + convex s /\ x IN s ==> (x limit_point_of s <=> ~(s = {x}))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s = {x:real^N}` THEN ASM_REWRITE_TAC[LIMPT_SING] THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ABBREV_TAC `u = min (&1 / &2) (e / &2 / norm(y - x:real^N))` THEN + SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "u" THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; + ALL_TAC] THEN + EXISTS_TAC `(&1 - u) % x + u % y:real^N` THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH + `(&1 - u) % x + u % y:real^N = x <=> u % (y - x) = vec 0`] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH + `((&1 - u) % x + u % y) - x:real^N = u % (y - x)`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < u ==> abs u = u`] THEN + MATCH_MP_TAC(REAL_ARITH `x <= e / &2 /\ &0 < e ==> x < e`) THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let TRIVIAL_LIMIT_WITHIN_CONVEX = prove + (`!s x:real^N. + convex s /\ x IN s ==> (trivial_limit(at x within s) <=> s = {x})`, + SIMP_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_OF_CONVEX]);; + +(* ------------------------------------------------------------------------- *) +(* Some invariance theorems for convex sets. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_TRANSLATION_EQ = prove + (`!a:real^N s. convex (IMAGE (\x. a + x) s) <=> convex s`, + REWRITE_TAC[CONVEX_ALT; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH + `(&1 - u) % (a + x) + u % (a + y) = a + z <=> (&1 - u) % x + u % y = z`]);; + +add_translation_invariants [CONVEX_TRANSLATION_EQ];; + +let CONVEX_TRANSLATION = prove + (`!s a:real^N. convex s ==> convex (IMAGE (\x. a + x) s)`, + REWRITE_TAC[CONVEX_TRANSLATION_EQ]);; + +let CONVEX_LINEAR_IMAGE = prove + (`!f s. convex s /\ linear f ==> convex(IMAGE f s)`, + REWRITE_TAC[convex; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_IMAGE; linear] THEN MESON_TAC[]);; + +let CONVEX_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (convex (IMAGE f s) <=> convex s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONVEX_LINEAR_IMAGE));; + +add_linear_invariants [CONVEX_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Explicit expressions for convexity in terms of arbitrary sums. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_VSUM = prove + (`!s k u x:A->real^N. + FINITE k /\ convex s /\ sum k u = &1 /\ + (!i. i IN k ==> &0 <= u i /\ x i IN s) + ==> vsum k (\i. u i % x i) IN s`, + GEN_TAC THEN ASM_CASES_TAC `convex(s:real^N->bool)` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FORALL_IN_INSERT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN + GEN_REWRITE_TAC (BINOP_CONV o DEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`u:A->real`; `x:A->real^N`] THEN + ASM_CASES_TAC `(u:A->real) i = &1` THENL + [ASM_REWRITE_TAC[REAL_ARITH `&1 + a = &1 <=> a = &0`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `vsum k (\i:A. u i % x(i):real^N) = vec 0` + (fun th -> ASM_SIMP_TAC[th; VECTOR_ADD_RID; VECTOR_MUL_LID]) THEN + MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + REPEAT STRIP_TAC THEN DISJ1_TAC THEN + ASM_MESON_TAC[SUM_POS_EQ_0]; + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\j:A. u(j) / (&1 - u(i))`) THEN + ASM_REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `&0 < &1 - u(i:A)` ASSUME_TAC THENL + [ASM_MESON_TAC[SUM_POS_LE; REAL_ADD_SYM; REAL_ARITH + `&0 <= a /\ &0 <= b /\ b + a = &1 /\ ~(a = &1) ==> &0 < &1 - a`]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_MUL_LID; REAL_EQ_SUB_LADD] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + DISCH_THEN(MP_TAC o SPECL + [`vsum k (\j. (u j / (&1 - u(i:A))) % x(j) :real^N)`; + `x(i:A):real^N`; `&1 - u(i:A)`; `u(i:A):real`]) THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; VSUM_LMUL] THEN + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; REAL_ARITH_TAC] THEN + ASM_MESON_TAC[REAL_ADD_SYM]]);; + +let CONVEX_VSUM_STRONG = prove + (`!s k u x:A->real^N. + convex s /\ + sum k u = &1 /\ + (!i. i IN k ==> &0 <= u i /\ (u i = &0 \/ x i IN s)) + ==> vsum k (\i. u i % x i) IN s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum k (\i. u i % (x:A->real^N) i) = + vsum {i | i IN k /\ ~(u i = &0)} (\i. u i % x i)` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + SET_TAC[]; + MATCH_MP_TAC CONVEX_VSUM THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[SUM_DEGENERATE; REAL_ARITH `~(&1 = &0)`]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN ASM SET_TAC[]; + ASM SET_TAC[]]]);; + +let CONVEX_INDEXED = prove + (`!s:real^N->bool. + convex s <=> + !k u x. (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\ + (sum (1..k) u = &1) + ==> vsum (1..k) (\i. u(i) % x(i)) IN s`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]; + DISCH_TAC THEN REWRITE_TAC[convex] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `2`) THEN + DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then u else v:real`) THEN + DISCH_THEN(MP_TAC o SPEC `\n. if n = 1 then x else y:real^N`) THEN + REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG; VSUM_CLAUSES_NUMSEG; + NUMSEG_SING; VSUM_SING; SUM_SING] THEN REWRITE_TAC[ARITH] THEN + ASM_MESON_TAC[]]);; + +let CONVEX_EXPLICIT = prove + (`!s:real^N->bool. + convex s <=> + !t u. FINITE t /\ t SUBSET s /\ (!x. x IN t ==> &0 <= u x) /\ + sum t u = &1 + ==> vsum t (\x. u(x) % x) IN s`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + DISCH_TAC THEN REWRITE_TAC[convex] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + ASM_CASES_TAC `x:real^N = y` THENL + [ASM_SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]; ALL_TAC] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N,y}`) THEN + DISCH_THEN(MP_TAC o SPEC `\z:real^N. if z = x then u else v:real`) THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_RULES; SUM_CLAUSES; VSUM_CLAUSES; + NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; REAL_ADD_RID; SUBSET] THEN + REWRITE_TAC[VECTOR_ADD_RID] THEN ASM_MESON_TAC[]]);; + +let CONVEX = prove + (`!V:real^N->bool. + convex V <=> + !(s:real^N->bool) (u:real^N->real). + FINITE s /\ ~(s = {}) /\ s SUBSET V /\ + (!x. x IN s ==> &0 <= u x) /\ sum s u = &1 + ==> vsum s (\x. u x % x) IN V`, + GEN_TAC THEN REWRITE_TAC[CONVEX_EXPLICIT] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let CONVEX_FINITE = prove + (`!s:real^N->bool. + FINITE s + ==> (convex s <=> + !u. (!x. x IN s ==> &0 <= u x) /\ + sum s u = &1 + ==> vsum s (\x. u(x) % x) IN s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONVEX_EXPLICIT] THEN + EQ_TAC THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^N. if x IN t then u x else &0`) THEN + ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[COND_ID; SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]);; + +let AFFINE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + affine s /\ affine t ==> affine(s PCROSS t)`, + REWRITE_TAC[affine; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN + SIMP_TAC[PASTECART_IN_PCROSS]);; + +let AFFINE_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + affine(s PCROSS t) <=> s = {} \/ t = {} \/ affine s /\ affine t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; AFFINE_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; AFFINE_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[AFFINE_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] AFFINE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] AFFINE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CONVEX_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + convex s /\ convex t ==> convex(s PCROSS t)`, + REWRITE_TAC[convex; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN + SIMP_TAC[PASTECART_IN_PCROSS]);; + +let CONVEX_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + convex(s PCROSS t) <=> s = {} \/ t = {} \/ convex s /\ convex t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CONVEX_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CONVEX_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[CONVEX_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Conic sets and conic hull. *) +(* ------------------------------------------------------------------------- *) + +let conic = new_definition + `conic s <=> !x c. x IN s /\ &0 <= c ==> (c % x) IN s`;; + +let SUBSPACE_IMP_CONIC = prove + (`!s. subspace s ==> conic s`, + SIMP_TAC[subspace; conic]);; + +let CONIC_EMPTY = prove + (`conic {}`, + REWRITE_TAC[conic; NOT_IN_EMPTY]);; + +let CONIC_UNIV = prove + (`conic (UNIV:real^N->bool)`, + REWRITE_TAC[conic; IN_UNIV]);; + +let CONIC_INTERS = prove + (`(!s. s IN f ==> conic s) ==> conic(INTERS f)`, + REWRITE_TAC[conic; IN_INTERS] THEN MESON_TAC[]);; + +let CONIC_LINEAR_IMAGE = prove + (`!f s. conic s /\ linear f ==> conic(IMAGE f s)`, + REWRITE_TAC[conic; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LINEAR_CMUL]);; + +let CONIC_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (conic (IMAGE f s) <=> conic s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONIC_LINEAR_IMAGE));; + +add_linear_invariants [CONIC_LINEAR_IMAGE_EQ];; + +let CONIC_CONIC_HULL = prove + (`!s. conic(conic hull s)`, + SIMP_TAC[P_HULL; CONIC_INTERS]);; + +let CONIC_HULL_EQ = prove + (`!s. (conic hull s = s) <=> conic s`, + SIMP_TAC[HULL_EQ; CONIC_INTERS]);; + +let CONIC_NEGATIONS = prove + (`!s. conic s ==> conic (IMAGE (--) s)`, + REWRITE_TAC[conic; RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_MUL_RNEG] THEN MESON_TAC[]);; + +let CONIC_SPAN = prove + (`!s. conic(span s)`, + SIMP_TAC[SUBSPACE_IMP_CONIC; SUBSPACE_SPAN]);; + +let CONIC_HULL_EXPLICIT = prove + (`!s:real^N->bool. conic hull s = {c % x | &0 <= c /\ x IN s}`, + GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[conic; SUBSET; RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`&1`; `x:real^N`] THEN + ASM_SIMP_TAC[REAL_POS; VECTOR_MUL_LID]; + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MESON_TAC[REAL_LE_MUL]; + MESON_TAC[]]);; + +let CONIC_HULL_LINEAR_IMAGE = prove + (`!f s. linear f ==> conic hull (IMAGE f s) = IMAGE f (conic hull s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONIC_HULL_EXPLICIT] THEN + REWRITE_TAC[SET_RULE `IMAGE f {c % x | P c x} = {f(c % x) | P c x}`] THEN + REWRITE_TAC[SET_RULE `{c % x | &0 <= c /\ x IN IMAGE f s} = + {c % f(x) | &0 <= c /\ x IN s}`] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]));; + +add_linear_invariants [CONIC_HULL_LINEAR_IMAGE];; + +let CONVEX_CONIC_HULL = prove + (`!s:real^N->bool. convex s ==> convex (conic hull s)`, + REWRITE_TAC[CONIC_HULL_EXPLICIT] THEN + REWRITE_TAC[CONVEX_ALT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM; IMP_IMP] THEN + X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`d:real`; `y:real^N`] THEN STRIP_TAC THEN + X_GEN_TAC `u:real` THEN STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_CASES_TAC `(&1 - u) * c = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + ASM_MESON_TAC[REAL_LE_MUL]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (&1 - u) * c + u * d` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_ADD THEN ASM_REWRITE_TAC[REAL_LT_LE] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `(&1 - u) * c + u * d:real` THEN + EXISTS_TAC `((&1 - u) * c) / ((&1 - u) * c + u * d) % x + + (u * d) / ((&1 - u) * c + u * d) % y:real^N` THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL; REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < u + v ==> u / (u + v) = &1 - (v / (u + v))`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_LE_MUL; REAL_MUL_LID; REAL_LE_ADDL; + REAL_SUB_LE]);; + +let CONIC_HALFSPACE_LE = prove + (`!a. conic {x | a dot x <= &0}`, + REWRITE_TAC[conic; IN_ELIM_THM; DOT_RMUL] THEN + REWRITE_TAC[REAL_ARITH `a <= &0 <=> &0 <= --a`] THEN + SIMP_TAC[GSYM REAL_MUL_RNEG; REAL_LE_MUL]);; + +let CONIC_HALFSPACE_GE = prove + (`!a. conic {x | a dot x >= &0}`, + SIMP_TAC[conic; IN_ELIM_THM; DOT_RMUL; real_ge; REAL_LE_MUL]);; + +let CONIC_HULL_EMPTY = prove + (`conic hull {} = {}`, + MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[SUBSET_REFL; CONIC_EMPTY; EMPTY_SUBSET]);; + +let CONIC_CONTAINS_0 = prove + (`!s:real^N->bool. conic s ==> (vec 0 IN s <=> ~(s = {}))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [conic]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `&0`]) THEN + ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO]);; + +let CONIC_HULL_EQ_EMPTY = prove + (`!s. (conic hull s = {}) <=> (s = {})`, + GEN_TAC THEN EQ_TAC THEN + MESON_TAC[SUBSET_EMPTY; HULL_SUBSET; CONIC_HULL_EMPTY]);; + +let CONIC_SUMS = prove + (`!s t. conic s /\ conic t ==> conic {x + y:real^N | x IN s /\ y IN t}`, + REWRITE_TAC[conic; IN_ELIM_THM] THEN + MESON_TAC[VECTOR_ADD_LDISTRIB]);; + +let CONIC_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + conic s /\ conic t ==> conic(s PCROSS t)`, + REWRITE_TAC[conic; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN + SIMP_TAC[PASTECART_IN_PCROSS]);; + +let CONIC_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + conic(s PCROSS t) <=> s = {} \/ t = {} \/ conic s /\ conic t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CONIC_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CONIC_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[CONIC_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONIC_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONIC_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CONIC_POSITIVE_ORTHANT = prove + (`conic {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, + SIMP_TAC[conic; IN_ELIM_THM; REAL_LE_MUL; VECTOR_MUL_COMPONENT]);; + +let SEPARATE_CLOSED_CONES = prove + (`!c d:real^N->bool. + conic c /\ closed c /\ conic d /\ closed d /\ c INTER d SUBSET {vec 0} + ==> ?e. &0 < e /\ + !x y. x IN c /\ y IN d + ==> dist(x,y) >= e * max (norm x) (norm y)`, + SUBGOAL_THEN + `!c d:real^N->bool. + conic c /\ closed c /\ conic d /\ closed d /\ c INTER d SUBSET {vec 0} + ==> ?e. &0 < e /\ + !x y. x IN c /\ y IN d ==> dist(x,y) + >= e * norm x` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[real_ge] THEN + MP_TAC(ISPECL [`c INTER sphere(vec 0:real^N,&1)`; `d:real^N->bool`] + SEPARATE_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_SPHERE] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `c INTER d SUBSET {a} ==> ~(a IN s) ==> (c INTER s) INTER d = {}`)) THEN + REWRITE_TAC[IN_SPHERE_0; NORM_0] THEN REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[DIST_POS_LE; REAL_MUL_RZERO; NORM_0] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`inv(norm x) % x:real^N`; `inv(norm(x:real^N)) % y:real^N`]) THEN + REWRITE_TAC[dist; NORM_MUL; GSYM VECTOR_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_ARITH `abs x * a = a * abs x`] THEN + REWRITE_TAC[REAL_ABS_INV; GSYM real_div; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_DIV_REFL; NORM_EQ_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE]]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`c:real^N->bool`; `d:real^N->bool`] th) THEN + MP_TAC(SPECL [`d:real^N->bool`; `c:real^N->bool`] th)) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; real_ge] THEN + X_GEN_TAC `d:real` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[real_max] THEN COND_CASES_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `d * norm(y:real^N)` THEN ONCE_REWRITE_TAC[DIST_SYM]; + EXISTS_TAC `e * norm(x:real^N)`] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN NORM_ARITH_TAC]);; + +let CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION = prove + (`!s:real^N->bool v d:real^N->real. + compact s /\ s SUBSET (v DELETE (vec 0)) /\ conic v /\ + (!x k. x IN v DELETE (vec 0) ==> (&0 < k /\ (k % x) IN s <=> d x = k)) + ==> (\x. d x % x) continuous_on (v DELETE (vec 0))`, + let lemma = prove + (`!s:real^N->real^N p srf:real^N->bool pnc. + compact srf /\ srf SUBSET pnc /\ + IMAGE s pnc SUBSET srf /\ (!x. x IN srf ==> s x = x) /\ + p continuous_on pnc /\ + (!x. x IN pnc ==> s(p x) = s x /\ p(s x) = p x) + ==> s continuous_on pnc`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `(s:real^N->real^N) o (p:real^N->real^N)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `IMAGE (p:real^N->real^N) pnc = IMAGE p srf` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]]) in + REWRITE_TAC[conic; IN_DELETE; SUBSET] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`\x:real^N. inv(norm x) % x`; `s:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[IN_DELETE; NORM_EQ_0; SIMP_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; + REWRITE_TAC[IN_UNIV; IN_DELETE]] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `&1`]) THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_LT_01; IN_DELETE] THEN + ASM_MESON_TAC[VECTOR_MUL_LID; SUBSET; IN_DELETE]; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o SPECL + [`inv(norm x) % x:real^N`; `norm x * (d:real^N->real) x`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `(d:real^N->real) x`]) THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE; REAL_LT_MUL; NORM_POS_LT] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_FIELD + `~(n = &0) ==> (n * d) * inv n = d`]; + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `(d:real^N->real) x`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[NORM_MUL; VECTOR_MUL_ASSOC; REAL_INV_MUL] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < x ==> (inv(x) * y) * x = y`]]);; + +(* ------------------------------------------------------------------------- *) +(* Affine dependence and consequential theorems (from Lars Schewe). *) +(* ------------------------------------------------------------------------- *) + +let affine_dependent = new_definition + `affine_dependent (s:real^N -> bool) <=> + ?x. x IN s /\ x IN (affine hull (s DELETE x))`;; + +let AFFINE_DEPENDENT_EXPLICIT = prove + (`!p. affine_dependent (p:real^N -> bool) <=> + (?s u. FINITE s /\ s SUBSET p /\ + sum s u = &0 /\ + (?v. v IN s /\ ~(u v = &0)) /\ + vsum s (\v. u v % v) = (vec 0):real^N)`, + X_GEN_TAC `p:real^N->bool` THEN EQ_TAC THENL + [REWRITE_TAC[affine_dependent;AFFINE_HULL_EXPLICIT; + IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `(x:real^N) INSERT s` THEN + EXISTS_TAC `\v:real^N.if v = x then -- &1 else u v` THEN + ASM_SIMP_TAC[FINITE_INSERT;SUM_CLAUSES;VSUM_CLAUSES;INSERT_SUBSET] THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + COND_CASES_TAC THENL [ASM SET_TAC[];ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CASES; SUM_CLAUSES; SET_RULE + `~((x:real^N) IN s) ==> {v | v IN s /\ v = x} = {} /\ + {v | v IN s /\ ~(v = x)} = s`] THEN + REAL_ARITH_TAC; + SET_TAC[REAL_ARITH `~(-- &1 = &0)`]; + MP_TAC (SET_RULE `s SUBSET p DELETE (x:real^N) ==> ~(x IN s)`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[VECTOR_ARITH + `(-- &1 % (x:real^N)) + a = vec 0 <=> a = x`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum s (\v:real^N. u v % v)` THEN + CONJ_TAC THENL [ + MATCH_MP_TAC VSUM_EQ THEN + ASM_SIMP_TAC[] THEN + ASM SET_TAC[]; + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + REWRITE_TAC[affine_dependent;AFFINE_HULL_EXPLICIT;IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `v:real^N` THEN + CONJ_TAC THENL [ASM SET_TAC[];ALL_TAC] THEN + EXISTS_TAC `s DELETE (v:real^N)` THEN + EXISTS_TAC `\x:real^N. -- (&1 / (u v)) * u x` THEN + ASM_SIMP_TAC[FINITE_DELETE;SUM_DELETE;VSUM_DELETE_CASES] THEN + ASM_SIMP_TAC[SUM_LMUL;GSYM VECTOR_MUL_ASSOC;VSUM_LMUL; + VECTOR_MUL_RZERO;VECTOR_ARITH `vec 0 - -- a % x = a % x:real^N`; + REAL_MUL_RZERO;REAL_ARITH `&0 - -- a * b = a * b`] THEN + ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> &1 / x * x = &1`; + VECTOR_MUL_ASSOC;VECTOR_MUL_LID] THEN + CONJ_TAC THENL [ALL_TAC;ASM SET_TAC[]] THEN + ASM_SIMP_TAC[SET_RULE `v IN s ==> (s DELETE v = {} <=> s = {v})`] THEN + ASM_CASES_TAC `s = {v:real^N}` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIND_ASSUM MP_TAC `sum {v:real^N} u = &0` THEN + REWRITE_TAC[SUM_SING] + THEN ASM_REWRITE_TAC[]);; + +let AFFINE_DEPENDENT_EXPLICIT_FINITE = prove + (`!s. FINITE(s:real^N -> bool) + ==> (affine_dependent s <=> + ?u. sum s u = &0 /\ + (?v. v IN s /\ ~(u v = &0)) /\ + vsum s (\v. u v % v) = vec 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AFFINE_DEPENDENT_EXPLICIT] THEN + EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET_REFL]] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN + ASM SET_TAC[]);; + +let AFFINE_DEPENDENT_TRANSLATION_EQ = prove + (`!a s. affine_dependent (IMAGE (\x. a + x) s) <=> affine_dependent s`, + REWRITE_TAC[affine_dependent] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [AFFINE_DEPENDENT_TRANSLATION_EQ];; + +let AFFINE_DEPENDENT_TRANSLATION = prove + (`!s a. affine_dependent s ==> affine_dependent (IMAGE (\x. a + x) s)`, + REWRITE_TAC[AFFINE_DEPENDENT_TRANSLATION_EQ]);; + +let AFFINE_DEPENDENT_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (affine_dependent(IMAGE f s) <=> affine_dependent s)`, + REWRITE_TAC[affine_dependent] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [AFFINE_DEPENDENT_LINEAR_IMAGE_EQ];; + +let AFFINE_DEPENDENT_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + affine_dependent(s) + ==> affine_dependent(IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[affine_dependent; EXISTS_IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)` + (fun t -> ASM_SIMP_TAC[FUN_IN_IMAGE; AFFINE_HULL_LINEAR_IMAGE; t]) THEN + ASM SET_TAC[]);; + +let AFFINE_DEPENDENT_MONO = prove + (`!s t:real^N->bool. affine_dependent s /\ s SUBSET t ==> affine_dependent t`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[affine_dependent] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HULL_MONO o SPEC `x:real^N` o MATCH_MP + (SET_RULE `!x. s SUBSET t ==> (s DELETE x) SUBSET (t DELETE x)`)) THEN + ASM SET_TAC[]);; + +let AFFINE_INDEPENDENT_EMPTY = prove + (`~(affine_dependent {})`, + REWRITE_TAC[affine_dependent; NOT_IN_EMPTY]);; + +let AFFINE_INDEPENDENT_1 = prove + (`!a:real^N. ~(affine_dependent {a})`, + REWRITE_TAC[affine_dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{a} DELETE a = {}`; AFFINE_HULL_EMPTY; NOT_IN_EMPTY]);; + +let AFFINE_INDEPENDENT_2 = prove + (`!a b:real^N. ~(affine_dependent {a,b})`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL + [ASM_REWRITE_TAC[INSERT_AC; AFFINE_INDEPENDENT_1]; + REWRITE_TAC[affine_dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[SET_RULE + `~(a = b) ==> {a,b} DELETE a = {b} /\ {a,b} DELETE b = {a}`] THEN + ASM_REWRITE_TAC[AFFINE_HULL_SING; IN_SING]]);; + +let AFFINE_INDEPENDENT_SUBSET = prove + (`!s t. ~affine_dependent t /\ s SUBSET t ==> ~affine_dependent s`, + REWRITE_TAC[IMP_CONJ_ALT; CONTRAPOS_THM] THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT; AFFINE_DEPENDENT_MONO]);; + +let AFFINE_INDEPENDENT_DELETE = prove + (`!s a. ~affine_dependent s ==> ~affine_dependent(s DELETE a)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_INDEPENDENT_SUBSET) THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Coplanarity, and collinearity in terms of affine hull. *) +(* ------------------------------------------------------------------------- *) + +let coplanar = new_definition + `coplanar s <=> ?u v w. s SUBSET affine hull {u,v,w}`;; + +let COLLINEAR_AFFINE_HULL = prove + (`!s:real^N->bool. collinear s <=> ?u v. s SUBSET affine hull {u,v}`, + GEN_TAC THEN REWRITE_TAC[collinear; AFFINE_HULL_2] THEN EQ_TAC THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `u + v = &1 <=> &1 - u = v`; UNWIND_THM1] THENL + [X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN EXISTS_TAC `x + u:real^N` THEN X_GEN_TAC `y:real^N` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` SUBST1_TAC) THEN + EXISTS_TAC `&1 + c` THEN VECTOR_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + EXISTS_TAC `b - a:real^N` THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN DISCH_THEN SUBST1_TAC THEN + X_GEN_TAC `s:real` THEN DISCH_THEN SUBST1_TAC THEN + EXISTS_TAC `s - r:real` THEN VECTOR_ARITH_TAC]);; + +let COLLINEAR_IMP_COPLANAR = prove + (`!s. collinear s ==> coplanar s`, + REWRITE_TAC[coplanar; COLLINEAR_AFFINE_HULL] THEN MESON_TAC[INSERT_AC]);; + +let COPLANAR_SMALL = prove + (`!s. FINITE s /\ CARD s <= 3 ==> coplanar s`, + GEN_TAC THEN REWRITE_TAC[ARITH_RULE `s <= 3 <=> s <= 2 \/ s = 3`] THEN + REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_SMALL] THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN REWRITE_TAC[coplanar] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[HULL_INC; SUBSET]);; + +let COPLANAR_EMPTY = prove + (`coplanar {}`, + SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_EMPTY]);; + +let COPLANAR_SING = prove + (`!a. coplanar {a}`, + SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_SING]);; + +let COPLANAR_2 = prove + (`!a b. coplanar {a,b}`, + SIMP_TAC[COLLINEAR_IMP_COPLANAR; COLLINEAR_2]);; + +let COPLANAR_3 = prove + (`!a b c. coplanar {a,b,c}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC COPLANAR_SMALL THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_RULES] THEN ARITH_TAC);; + +let COLLINEAR_AFFINE_HULL_COLLINEAR = prove + (`!s. collinear(affine hull s) <=> collinear s`, + REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + MESON_TAC[HULL_HULL; HULL_MONO; HULL_INC; SUBSET]);; + +let COPLANAR_AFFINE_HULL_COPLANAR = prove + (`!s. coplanar(affine hull s) <=> coplanar s`, + REWRITE_TAC[coplanar] THEN + MESON_TAC[HULL_HULL; HULL_MONO; HULL_INC; SUBSET]);; + +let COPLANAR_TRANSLATION_EQ = prove + (`!a:real^N s. coplanar(IMAGE (\x. a + x) s) <=> coplanar s`, + REWRITE_TAC[coplanar] THEN GEOM_TRANSLATE_TAC[]);; + +let COPLANAR_TRANSLATION = prove + (`!a:real^N s. coplanar s ==> coplanar(IMAGE (\x. a + x) s)`, + REWRITE_TAC[COPLANAR_TRANSLATION_EQ]);; + +add_translation_invariants [COPLANAR_TRANSLATION_EQ];; + +let COPLANAR_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. coplanar s /\ linear f ==> coplanar(IMAGE f s)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[coplanar; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real^M`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(f:real^M->real^N) a`; `(f:real^M->real^N) b`; `(f:real^M->real^N) c`] THEN + REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN + ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE; IMAGE_SUBSET]);; + +let COPLANAR_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (coplanar (IMAGE f s) <=> coplanar s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COPLANAR_LINEAR_IMAGE));; + +add_linear_invariants [COPLANAR_LINEAR_IMAGE_EQ];; + +let COPLANAR_SUBSET = prove + (`!s t. coplanar t /\ s SUBSET t ==> coplanar s`, + REWRITE_TAC[coplanar] THEN SET_TAC[]);; + +let AFFINE_HULL_3_IMP_COLLINEAR = prove + (`!a b c. c IN affine hull {a,b} ==> collinear {a,b,c}`, + ONCE_REWRITE_TAC[GSYM COLLINEAR_AFFINE_HULL_COLLINEAR] THEN + SIMP_TAC[HULL_REDUNDANT_EQ; INSERT_AC] THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2]);; + +let COLLINEAR_3_AFFINE_HULL = prove + (`!a b c:real^N. + ~(a = b) ==> (collinear {a,b,c} <=> c IN affine hull {a,b})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[AFFINE_HULL_3_IMP_COLLINEAR] THEN + REWRITE_TAC[collinear] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(fun th -> MP_TAC(SPECL [`b:real^N`; `a:real^N`] th) THEN + MP_TAC(SPECL [`c:real^N`; `a:real^N`] th)) THEN + REWRITE_TAC[IN_INSERT; AFFINE_HULL_2; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[VECTOR_ARITH `a - b:real^N = c <=> a = b + c`] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `y:real` THEN + ASM_CASES_TAC `y = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`&1 - x / y`; `x / y:real`] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL] THEN VECTOR_ARITH_TAC);; + +let COLLINEAR_3_EQ_AFFINE_DEPENDENT = prove + (`!a b c:real^N. + collinear{a,b,c} <=> + a = b \/ a = c \/ b = c \/ affine_dependent {a,b,c}`, + REPEAT GEN_TAC THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC]) + [`a:real^N = b`; `a:real^N = c`; `b:real^N = c`] THEN + ASM_REWRITE_TAC[affine_dependent] THEN EQ_TAC THENL + [ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN DISCH_TAC THEN + EXISTS_TAC `c:real^N` THEN REWRITE_TAC[IN_INSERT]; + REWRITE_TAC[EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`]; + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {c,a,b}`]; + ALL_TAC] THEN + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);; + +let AFFINE_DEPENDENT_IMP_COLLINEAR_3 = prove + (`!a b c:real^N. affine_dependent {a,b,c} ==> collinear{a,b,c}`, + REPEAT GEN_TAC THEN REWRITE_TAC[affine_dependent] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2; COLLINEAR_AFFINE_HULL] THEN + STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`b:real^N`; `c:real^N`]; + MAP_EVERY EXISTS_TAC [`a:real^N`; `c:real^N`]; + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`]] THEN + SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET; HULL_INC; IN_INSERT] THEN + POP_ASSUM MP_TAC THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> a IN s ==> a IN t`) THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; + +let COLLINEAR_3_IN_AFFINE_HULL = prove + (`!v0 v1 x:real^N. + ~(v1 = v0) + ==> (collinear {v0,v1,x} <=> x IN affine hull {v0,v1})`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `v0:real^N` THEN + REWRITE_TAC[COLLINEAR_LEMMA; AFFINE_HULL_2] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXISTS_TAC [`&1`; `&0`] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + VECTOR_ARITH_TAC; + MESON_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`]]);; + +(* ------------------------------------------------------------------------- *) +(* A general lemma. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_CONNECTED = prove + (`!s:real^N->bool. convex s ==> connected s`, + REWRITE_TAC[CONVEX_ALT; connected; SUBSET; EXTENSION; IN_INTER; + IN_UNION; NOT_IN_EMPTY; NOT_FORALL_THM; NOT_EXISTS_THM] THEN + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + MAP_EVERY (K(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) (1--4) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `x1:real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `x2:real^N` STRIP_ASSUME_TAC)) THEN + MP_TAC(ISPECL [`\u. (&1 - u) % x1 + u % (x2:real^N)`; + `&0`; `&1`; `e1:real^N->bool`; `e2:real^N->bool`] + (REWRITE_RULE[GSYM open_def] CONNECTED_REAL_LEMMA)) THEN + ASM_REWRITE_TAC[NOT_IMP; REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_MUL_LZERO; + REAL_SUB_REFL; VECTOR_ADD_RID; VECTOR_ADD_LID; REAL_POS] THEN + REPEAT(CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[dist] THEN + REWRITE_TAC[NORM_MUL; VECTOR_ARITH + `((&1 - a) % x + a % y) - ((&1 - b) % x + b % y) = (a - b) % (y - x)`] THEN + MP_TAC(ISPEC `(x2 - x1):real^N` NORM_POS_LE) THEN + REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RZERO; REAL_LT_01]] THEN + EXISTS_TAC `e / norm((x2 - x1):real^N)` THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_DIV]);; + +(* ------------------------------------------------------------------------- *) +(* Various topological facts are queued up here, just because they rely on *) +(* CONNECTED_UNIV, which is a trivial consequence of CONVEX_UNIV. It would *) +(* be fairly easy to prove it earlier and move these back to the topology.ml *) +(* file, which is a bit tidier intellectually. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_UNIV = prove + (`connected (UNIV:real^N->bool)`, + SIMP_TAC[CONVEX_CONNECTED; CONVEX_UNIV]);; + +let CONNECTED_COMPONENT_UNIV = prove + (`!x. connected_component(:real^N) x = (:real^N)`, + MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; CONNECTED_UNIV; IN_UNIV]);; + +let CONNECTED_COMPONENT_EQ_UNIV = prove + (`!s x. connected_component s x = (:real^N) <=> s = (:real^N)`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONNECTED_COMPONENT_UNIV] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s = UNIV ==> t = UNIV`) THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; + +let COMPONENTS_UNIV = prove + (`components(:real^N) = {(:real^N)}`, + REWRITE_TAC[COMPONENTS_EQ_SING; CONNECTED_UNIV; UNIV_NOT_EMPTY]);; + +let CLOPEN = prove + (`!s. closed s /\ open s <=> s = {} \/ s = (:real^N)`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[CLOSED_EMPTY; OPEN_EMPTY; CLOSED_UNIV; OPEN_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[CONNECTED_CLOPEN] CONNECTED_UNIV) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN]);; + +let COMPACT_OPEN = prove + (`!s:real^N->bool. compact s /\ open s <=> s = {}`, + MESON_TAC[COMPACT_EMPTY; OPEN_EMPTY; COMPACT_IMP_CLOSED; CLOPEN; + COMPACT_IMP_BOUNDED; NOT_BOUNDED_UNIV]);; + +let FRONTIER_NOT_EMPTY = prove + (`!s. ~(s = {}) /\ ~(s = (:real^N)) ==> ~(frontier s = {})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`] CONNECTED_INTER_FRONTIER) THEN + REWRITE_TAC[CONNECTED_UNIV] THEN ASM SET_TAC[]);; + +let FRONTIER_EQ_EMPTY = prove + (`!s. frontier s = {} <=> s = {} \/ s = (:real^N)`, + MESON_TAC[FRONTIER_NOT_EMPTY; FRONTIER_EMPTY; FRONTIER_UNIV]);; + +let EQ_INTERVAL = prove + (`(!a b c d:real^N. + interval[a,b] = interval[c,d] <=> + interval[a,b] = {} /\ interval[c,d] = {} \/ a = c /\ b = d) /\ + (!a b c d:real^N. + interval[a,b] = interval(c,d) <=> + interval[a,b] = {} /\ interval(c,d) = {}) /\ + (!a b c d:real^N. + interval(a,b) = interval[c,d] <=> + interval(a,b) = {} /\ interval[c,d] = {}) /\ + (!a b c d:real^N. + interval(a,b) = interval(c,d) <=> + interval(a,b) = {} /\ interval(c,d) = {} \/ a = c /\ b = d)`, + REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN + (EQ_TAC THENL [ALL_TAC; STRIP_TAC THEN ASM_REWRITE_TAC[]]) THEN + MATCH_MP_TAC(MESON[] + `(p = {} /\ q = {} ==> r) /\ (~(p = {}) /\ ~(q = {}) ==> p = q ==> r) + ==> p = q ==> r`) THEN + SIMP_TAC[] THENL + [REWRITE_TAC[INTERVAL_NE_EMPTY; CART_EQ] THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + SIMP_TAC[SUBSET_INTERVAL; GSYM REAL_LE_ANTISYM]; + STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN] + `closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(s = t)`) THEN + ASM_REWRITE_TAC[CLOSED_INTERVAL; OPEN_INTERVAL; NOT_INTERVAL_UNIV]; + STRIP_TAC THEN MATCH_MP_TAC(MESON[CLOPEN] + `closed s /\ open t /\ ~(s = {}) /\ ~(s = UNIV) ==> ~(t = s)`) THEN + ASM_REWRITE_TAC[CLOSED_INTERVAL; OPEN_INTERVAL; NOT_INTERVAL_UNIV]; + REWRITE_TAC[INTERVAL_NE_EMPTY; CART_EQ] THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + SIMP_TAC[SUBSET_INTERVAL; GSYM REAL_LE_ANTISYM]]);; + +let CLOSED_INTERVAL_EQ = prove + (`(!a b:real^N. closed(interval[a,b])) /\ + (!a b:real^N. closed(interval(a,b)) <=> interval(a,b) = {})`, + REWRITE_TAC[CLOSED_INTERVAL] THEN + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[CLOSED_EMPTY] THEN + MP_TAC(ISPEC `interval(a:real^N,b)` CLOPEN) THEN + ASM_REWRITE_TAC[OPEN_INTERVAL] THEN + MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; + +let OPEN_INTERVAL_EQ = prove + (`(!a b:real^N. open(interval[a,b]) <=> interval[a,b] = {}) /\ + (!a b:real^N. open(interval(a,b)))`, + REWRITE_TAC[OPEN_INTERVAL] THEN + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[CLOSED_EMPTY] THEN + MP_TAC(ISPEC `interval[a:real^N,b]` CLOPEN) THEN + ASM_REWRITE_TAC[CLOSED_INTERVAL] THEN + MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; + +let COMPACT_INTERVAL_EQ = prove + (`(!a b:real^N. compact(interval[a,b])) /\ + (!a b:real^N. compact(interval(a,b)) <=> interval(a,b) = {})`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL] THEN + REWRITE_TAC[CLOSED_INTERVAL_EQ]);; + +let CONNECTED_CHAIN = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> compact s /\ connected s) /\ + (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) + ==> connected(INTERS f)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; CONNECTED_UNIV] THEN + ABBREV_TAC `c:real^N->bool = INTERS f` THEN + SUBGOAL_THEN `compact(c:real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "c" THEN MATCH_MP_TAC COMPACT_INTERS THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONNECTED_CLOSED_SET; COMPACT_IMP_CLOSED; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N->bool`; `b:real^N->bool`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^N->bool`; `b:real^N->bool`] SEPARATION_NORMAL) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?k:real^N->bool. k IN f` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?n:real^N->bool. open n /\ k SUBSET n` MP_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET_BALL; COMPACT_IMP_BOUNDED; OPEN_BALL]; + REWRITE_TAC[UNIONS_SUBSET] THEN STRIP_TAC] THEN + MP_TAC(ISPEC `k:real^N->bool` COMPACT_IMP_HEINE_BOREL) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o SPEC + `(u UNION v:real^N->bool) INSERT {n DIFF s | s IN f}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[OPEN_UNION; OPEN_DIFF; COMPACT_IMP_CLOSED; NOT_IMP] THEN + CONJ_TAC THENL + [REWRITE_TAC[UNIONS_INSERT] THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[IN_UNION] THEN + ASM_CASES_TAC `(x:real^N) IN c` THENL [ASM SET_TAC[]; DISJ2_TAC] THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM] THEN + UNDISCH_TAC `~((x:real^N) IN c)` THEN + SUBST1_TAC(SYM(ASSUME `INTERS f:real^N->bool = c`)) THEN + REWRITE_TAC[IN_INTERS; NOT_FORALL_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SUBSET_INSERT_DELETE] THEN + SUBGOAL_THEN `FINITE(g DELETE (u UNION v:real^N->bool))` MP_TAC THENL + [ASM_REWRITE_TAC[FINITE_DELETE]; + REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN + REWRITE_TAC[FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j:real^N->bool. j IN f /\ + UNIONS(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `f':(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; EMPTY_SUBSET] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?j:real^N->bool. j IN f' /\ + UNIONS(IMAGE (\s. n DIFF s) f') SUBSET (n DIFF j)` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN + SUBGOAL_THEN + `!s t:real^N->bool. s IN f' /\ t IN f' ==> s SUBSET t \/ t SUBSET s` + MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + UNDISCH_TAC `~(f':(real^N->bool)->bool = {})` THEN + UNDISCH_TAC `FINITE(f':(real^N->bool)->bool)` THEN + SPEC_TAC(`f':(real^N->bool)->bool`,`f':(real^N->bool)->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[] THEN + REWRITE_TAC[EXISTS_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_INSERT] THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY X_GEN_TAC [`i:real^N->bool`; `f:(real^N->bool)->bool`] THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; NOT_IN_EMPTY; + UNIONS_0; UNION_EMPTY; SUBSET_REFL] THEN + DISCH_THEN(fun th -> REPEAT DISCH_TAC THEN MP_TAC th) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(n DIFF j) SUBSET (n DIFF i) \/ + (n DIFF i:real^N->bool) SUBSET (n DIFF j)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `j:real^N->bool` o CONJUNCT2) THEN + ASM SET_TAC[]; + DISJ1_TAC THEN ASM SET_TAC[]; + DISJ2_TAC THEN EXISTS_TAC `j:real^N->bool` THEN ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(j INTER k:real^N->bool) SUBSET (u UNION v)` ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `k SUBSET (u UNION v) UNION (n DIFF j) + ==> (j INTER k) SUBSET (u UNION v)`) THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `UNIONS g :real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `UNIONS((u UNION v:real^N->bool) INSERT (g DELETE (u UNION v)))` THEN + CONJ_TAC THENL [MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[UNIONS_INSERT] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `connected(j INTER k:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; INTER_COMM]; + REWRITE_TAC[connected] THEN + MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +let CONNECTED_CHAIN_GEN = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> closed s /\ connected s) /\ + (?s. s IN f /\ compact s) /\ + (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) + ==> connected(INTERS f)`, + GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `INTERS f = INTERS(IMAGE (\t:real^N->bool. s INTER t) f)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; INTERS_IMAGE] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_CHAIN THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[COMPACT_INTER_CLOSED] THEN + CONJ_TAC THENL [X_GEN_TAC `t:real^N->bool`; ASM SET_TAC[]] THEN + DISCH_TAC THEN + SUBGOAL_THEN `s INTER t:real^N->bool = s \/ s INTER t = t` + (DISJ_CASES_THEN SUBST1_TAC) THEN + ASM SET_TAC[]]);; + +let CONNECTED_NEST = prove + (`!s. (!n. compact(s n) /\ connected(s n)) /\ + (!m n. m <= n ==> s n SUBSET s m) + ==> connected(INTERS {s n | n IN (:num)})`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CHAIN THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; + +let CONNECTED_NEST_GEN = prove + (`!s. (!n. closed(s n) /\ connected(s n)) /\ (?n. compact(s n)) /\ + (!m n. m <= n ==> s n SUBSET s m) + ==> connected(INTERS {s n | n IN (:num)})`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MATCH_MP_TAC CONNECTED_CHAIN_GEN THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM; + EXISTS_IN_GSPEC] THEN + MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; + +let EQ_BALLS = prove + (`(!a a':real^N r r'. + ball(a,r) = ball(a',r') <=> a = a' /\ r = r' \/ r <= &0 /\ r' <= &0) /\ + (!a a':real^N r r'. + ball(a,r) = cball(a',r') <=> r <= &0 /\ r' < &0) /\ + (!a a':real^N r r'. + cball(a,r) = ball(a',r') <=> r < &0 /\ r' <= &0) /\ + (!a a':real^N r r'. + cball(a,r) = cball(a',r') <=> a = a' /\ r = r' \/ r < &0 /\ r' < &0)`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT STRIP_TAC THEN + (EQ_TAC THENL + [ALL_TAC; REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) + THENL + [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN NORM_ARITH_TAC; + ONCE_REWRITE_TAC[EQ_SYM_EQ]; + ALL_TAC; + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN NORM_ARITH_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[CLOPEN; BOUNDED_BALL; NOT_BOUNDED_UNIV] + `s = t ==> closed s /\ open t /\ bounded t ==> s = {} /\ t = {}`)) THEN + REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BOUNDED_BALL; + BALL_EQ_EMPTY; CBALL_EQ_EMPTY] THEN + REAL_ARITH_TAC);; + +let FINITE_CBALL = prove + (`!a:real^N r. FINITE(cball(a,r)) <=> r <= &0`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[CBALL_EMPTY; REAL_LT_IMP_LE; FINITE_EMPTY] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_REWRITE_TAC[CBALL_TRIVIAL; FINITE_SING; REAL_LE_REFL] THEN + EQ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP EMPTY_INTERIOR_FINITE) THEN + REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);; + +let FINITE_BALL = prove + (`!a:real^N r. FINITE(ball(a,r)) <=> r <= &0`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `r <= &0` THEN + ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; FINITE_EMPTY] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + FINITE_IMP_NOT_OPEN)) THEN + REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Minimal continua. *) +(* ------------------------------------------------------------------------- *) + +let MINIMAL_CONTINUUM = prove + (`!t s:real^N->bool. + t SUBSET s /\ compact s /\ connected s + ==> ?u. t SUBSET u /\ u SUBSET s /\ compact u /\ connected u /\ + !v. v SUBSET u /\ t SUBSET v /\ compact v /\ connected v + ==> v = u`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [EXISTS_TAC `{}:real^N->bool` THEN + ASM_MESON_TAC[COMPACT_EMPTY; CONNECTED_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\u:real^N->bool. t SUBSET u /\ connected u`; + `s:real^N->bool`] + BROUWER_REDUCTION_THEOREM) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN GEN_TAC THEN STRIP_TAC THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET_INTERS] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_NEST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SET_RULE `(v SUBSET u /\ p ==> v = u) <=> + (v SUBSET u /\ p ==> ~(v PSUBSET u))`] THEN + GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Convex functions into the reals. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("convex_on",(12,"right"));; + +let convex_on = new_definition + `f convex_on s <=> + !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> f(u % x + v % y) <= u * f(x) + v * f(y)`;; + +let CONVEX_ON_SUBSET = prove + (`!f s t. f convex_on t /\ s SUBSET t ==> f convex_on s`, + REWRITE_TAC[convex_on; SUBSET] THEN MESON_TAC[]);; + +let CONVEX_ON_EQ = prove + (`!f g s. convex s /\ (!x. x IN s ==> f x = g x) /\ f convex_on s + ==> g convex_on s`, + REWRITE_TAC[convex_on; convex] THEN MESON_TAC[]);; + +let CONVEX_ADD = prove + (`!s f g. f convex_on s /\ g convex_on s ==> (\x. f(x) + g(x)) convex_on s`, + REWRITE_TAC[convex_on; AND_FORALL_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL ORELSE GEN_TAC) THEN + MATCH_MP_TAC(TAUT + `(b /\ c ==> d) ==> (a ==> b) /\ (a ==> c) ==> a ==> d`) THEN + REAL_ARITH_TAC);; + +let CONVEX_CMUL = prove + (`!s c f. &0 <= c /\ f convex_on s ==> (\x. c * f(x)) convex_on s`, + SIMP_TAC[convex_on; REAL_LE_LMUL; + REAL_ARITH `u * c * fx + v * c * fy = c * (u * fx + v * fy)`]);; + +let CONVEX_MAX = prove + (`!f g s. f convex_on s /\ g convex_on s + ==> (\x. max (f x) (g x)) convex_on s`, + REWRITE_TAC[convex_on; REAL_MAX_LE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC);; + +let CONVEX_LOWER = prove + (`!f s x y. f convex_on s /\ + x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> f(u % x + v % y) <= max (f(x)) (f(y))`, + REWRITE_TAC[convex_on] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th]) THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_LMUL; REAL_MAX_MAX]);; + +let CONVEX_LOWER_SEGMENT = prove + (`!f s a b x:real^N. + f convex_on s /\ a IN s /\ b IN s /\ x IN segment[a,b] + ==> f(x) <= max (f a) (f b)`, + REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_LOWER THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let CONVEX_LOCAL_GLOBAL_MINIMUM = prove + (`!f s t x:real^N. + f convex_on s /\ x IN t /\ open t /\ t SUBSET s /\ + (!y. y IN t ==> f(x) <= f(y)) + ==> !y. y IN s ==> f(x) <= f(y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < dist(x:real^N,y)` ASSUME_TAC THENL + [ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`&1`; `e / dist(x:real^N,y)`] REAL_DOWN2) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_01]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex_on]) THEN + DISCH_THEN(MP_TAC o + SPECL [`x:real^N`; `y:real^N`; `&1 - u`; `u:real`]) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_SUB_ADD; REAL_SUB_LE; REAL_LT_IMP_LE] THEN + ASM_MESON_TAC[CENTRE_IN_BALL; SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(&1 - u) * f(x) + u * f(x:real^N):real` THEN + ASM_SIMP_TAC[REAL_LT_LADD; REAL_LT_LMUL] THEN + REWRITE_TAC[REAL_ARITH `(&1 - x) * a + x * a = a`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_BALL; dist] THEN + REWRITE_TAC[VECTOR_ARITH `x - ((&1 - u) % x + u % y):real^N = + u % (x - y)`] THEN + REWRITE_TAC[NORM_MUL; GSYM dist] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; + REAL_ARITH `&0 < x /\ x < b ==> abs x < b`]);; + +let CONVEX_DISTANCE = prove + (`!s a. (\x. dist(a,x)) convex_on s`, + REWRITE_TAC[convex_on; dist] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) + [GSYM VECTOR_MUL_LID] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ARITH + `(u + v) % z - (u % x + v % y) = u % (z - x) + v % (z - y)`] THEN + ASM_MESON_TAC[NORM_TRIANGLE; NORM_MUL; REAL_ABS_REFL]);; + +let CONVEX_NORM = prove + (`!s:real^N->bool. norm convex_on s`, + GEN_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] CONVEX_DISTANCE) THEN + REWRITE_TAC[DIST_0; ETA_AX]);; + +let CONVEX_ON_COMPOSE_LINEAR = prove + (`!f g:real^M->real^N s. + f convex_on (IMAGE g s) /\ linear g ==> (f o g) convex_on s`, + REWRITE_TAC[convex_on; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN + ASM_SIMP_TAC[]);; + +let CONVEX_ON_TRANSLATION = prove + (`!f a:real^N. + f convex_on (IMAGE (\x. a + x) s) <=> (\x. f(a + x)) convex_on s`, + REWRITE_TAC[convex_on; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM] THEN + REWRITE_TAC[VECTOR_ARITH + `u % (a + x) + v % (a + y):real^N = (u + v) % a + u % x + v % y`] THEN + SIMP_TAC[VECTOR_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Open and closed balls are convex and hence connected. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_BALL = prove + (`!x:real^N e. convex(ball(x,e))`, + let lemma = REWRITE_RULE[convex_on; IN_UNIV] + (ISPEC `(:real^N)` CONVEX_DISTANCE) in + REWRITE_TAC[convex; IN_BALL] THEN REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) lemma o lhand o snd) THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_CONVEX_BOUND_LT]);; + +let CONNECTED_BALL = prove + (`!x:real^N e. connected(ball(x,e))`, + SIMP_TAC[CONVEX_CONNECTED; CONVEX_BALL]);; + +let CONVEX_CBALL = prove + (`!x:real^N e. convex(cball(x,e))`, + REWRITE_TAC[convex; IN_CBALL; dist] THEN MAP_EVERY X_GEN_TAC + [`x:real^N`; `e:real`; `y:real^N`; `z:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH `a - b = &1 % a - b`] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ARITH + `(a + b) % x - (a % y + b % z) = a % (x - y) + b % (x - z)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(u % (x - y)) + norm(v % (x - z):real^N)` THEN + REWRITE_TAC[NORM_TRIANGLE; NORM_MUL] THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 <= u /\ &0 <= v /\ (u + v = &1) ==> (abs(u) + abs(v) = &1)`]);; + +let CONNECTED_CBALL = prove + (`!x:real^N e. connected(cball(x,e))`, + SIMP_TAC[CONVEX_CONNECTED; CONVEX_CBALL]);; + +let CONVEX_INTERMEDIATE_BALL = prove + (`!a:real^N r t. ball(a,r) SUBSET t /\ t SUBSET cball(a,r) ==> convex t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONVEX_CONTAINS_OPEN_SEGMENT] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN GEN_TAC THEN DISCH_THEN + (MP_TAC o SPEC `a:real^N` o MATCH_MP DIST_DECREASES_OPEN_SEGMENT) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_CBALL] THEN ASM_MESON_TAC[REAL_LTE_TRANS]);; + +let FRONTIER_OF_CONNECTED_COMPONENT_SUBSET = prove + (`!s c x:real^N. frontier(connected_component s x) SUBSET frontier s`, + REPEAT GEN_TAC THEN REWRITE_TAC[frontier; SUBSET; IN_DIFF] THEN + X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `y IN s ==> s SUBSET t ==> y IN t`)) THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `ball(y:real^N,e) SUBSET connected_component s y` + ASSUME_TAC THENL + [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[CONNECTED_BALL; CENTRE_IN_BALL]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSURE_APPROACHABLE]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM IN_BALL)] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[IN_INTERIOR] THEN EXISTS_TAC `e:real` THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; `y:real^N`] + CONNECTED_COMPONENT_OVERLAP) THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + ASM_SIMP_TAC[] THEN ASM SET_TAC[]]]);; + +let FRONTIER_OF_COMPONENTS_SUBSET = prove + (`!s c:real^N->bool. + c IN components s ==> frontier c SUBSET frontier s`, + SIMP_TAC[components; FORALL_IN_GSPEC; + FRONTIER_OF_CONNECTED_COMPONENT_SUBSET]);; + +let FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT = prove + (`!s c. closed s /\ c IN components ((:real^N) DIFF s) + ==> frontier c SUBSET s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN + REWRITE_TAC[FRONTIER_COMPLEMENT] THEN + ASM_MESON_TAC[FRONTIER_SUBSET_EQ; SUBSET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* A couple of lemmas about components (see Newman IV, 3.3 and 3.4). *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_UNION_CLOPEN_IN_COMPLEMENT = prove + (`!s t u:real^N->bool. + connected s /\ connected u /\ s SUBSET u /\ + open_in (subtopology euclidean (u DIFF s)) t /\ + closed_in (subtopology euclidean (u DIFF s)) t + ==> connected (s UNION t)`, + MAP_EVERY X_GEN_TAC + [`c:real^N->bool`; `h:real^N->bool`; `s:real^N->bool`] THEN + STRIP_TAC THEN + REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN + MATCH_MP_TAC(MESON[] + `!Q. (!x y. P x y <=> P y x) /\ + (!x y. P x y ==> Q x \/ Q y) /\ + (!x y. P x y /\ Q x ==> F) + ==> (!x y. ~(P x y))`) THEN + EXISTS_TAC `\x:real^N->bool. c SUBSET x` THEN + CONJ_TAC THENL [MESON_TAC[INTER_COMM; UNION_COMM]; ALL_TAC] THEN + REWRITE_TAC[] THEN CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`h1:real^N->bool`; `h2:real^N->bool`] THENL + [STRIP_TAC THEN UNDISCH_TAC `connected(c:real^N->bool)` THEN + REWRITE_TAC[CONNECTED_CLOSED_IN; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o + SPECL [`c INTER h1:real^N->bool`; `c INTER h2:real^N->bool`]) THEN + MATCH_MP_TAC(TAUT + `(p /\ q) /\ (~r ==> s) ==> ~(p /\ q /\ r) ==> s`) THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL + [UNDISCH_TAC + `closed_in(subtopology euclidean (c UNION h)) (h1:real^N->bool)`; + UNDISCH_TAC + `closed_in(subtopology euclidean (c UNION h)) (h2:real^N->bool)`] THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]; + STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + SUBGOAL_THEN `(h2:real^N->bool) SUBSET h` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `connected(s:real^N->bool)` THEN + REWRITE_TAC[CONNECTED_CLOPEN] THEN + DISCH_THEN(MP_TAC o SPEC `h2:real^N->bool`) THEN REWRITE_TAC[NOT_IMP] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + SUBGOAL_THEN `s:real^N->bool = (s DIFF c) UNION (c UNION h)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_UNION THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(c UNION h) DIFF h2:real^N->bool = h1` + (fun th -> ASM_REWRITE_TAC[th]) THEN ASM SET_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC OPEN_IN_TRANS THEN + EXISTS_TAC `h:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC + `open_in(subtopology euclidean (c UNION h)) (h2:real^N->bool)` THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]]; + MATCH_MP_TAC CLOSED_IN_SUBTOPOLOGY_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_IN_TRANS THEN EXISTS_TAC `h:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC + `closed_in(subtopology euclidean (c UNION h)) (h2:real^N->bool)` THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]]]);; + +let COMPONENT_COMPLEMENT_CONNECTED = prove + (`!s u c:real^N->bool. + connected s /\ connected u /\ s SUBSET u /\ c IN components (u DIFF s) + ==> connected(u DIFF c)`, + MAP_EVERY X_GEN_TAC + [`a:real^N->bool`; `s:real^N->bool`; `c:real^N->bool`] THEN + STRIP_TAC THEN UNDISCH_TAC `connected(a:real^N->bool)` THEN + REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC + [`h3:real^N->bool`; `h4:real^N->bool`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a INTER h3:real^N->bool`; `a INTER h4:real^N->bool`]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + EVERY_ASSUM(fun th -> try + MP_TAC(CONJUNCT1(GEN_REWRITE_RULE I [closed_in] th)) + with Failure _ -> ALL_TAC) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN REPEAT DISCH_TAC THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `closed_in (subtopology euclidean (s DIFF c)) + (h3:real^N->bool)` THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]; + UNDISCH_TAC `closed_in (subtopology euclidean (s DIFF c)) + (h4:real^N->bool)` THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]; + DISCH_TAC THEN + MP_TAC(ISPECL [`s DIFF a:real^N->bool`; `c UNION h3:real^N->bool`; + `c:real^N->bool`] COMPONENTS_MAXIMAL) THEN + ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONNECTED_UNION_CLOPEN_IN_COMPLEMENT THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ASM SET_TAC[]; + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `s DIFF c DIFF h3:real^N->bool = h4` SUBST1_TAC THEN + ASM SET_TAC[]]; + DISCH_TAC THEN + MP_TAC(ISPECL [`s DIFF a:real^N->bool`; `c UNION h4:real^N->bool`; + `c:real^N->bool`] COMPONENTS_MAXIMAL) THEN + ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONNECTED_UNION_CLOPEN_IN_COMPLEMENT THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ASM SET_TAC[]; + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `s DIFF c DIFF h4:real^N->bool = h3` SUBST1_TAC THEN + ASM SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Condition for an open map's image to contain a ball. *) +(* ------------------------------------------------------------------------- *) + +let BALL_SUBSET_OPEN_MAP_IMAGE = prove + (`!f:real^M->real^N s a r. + bounded s /\ f continuous_on closure s /\ open(IMAGE f (interior s)) /\ + a IN s /\ &0 < r /\ (!z. z IN frontier s ==> r <= norm(f z - f a)) + ==> ball(f(a),r) SUBSET IMAGE f s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ball((f:real^M->real^N) a,r)`; + `(:real^N) DIFF IMAGE (f:real^M->real^N) s`] + CONNECTED_INTER_FRONTIER) THEN + REWRITE_TAC[CONNECTED_BALL] THEN MATCH_MP_TAC(SET_RULE + `~(b INTER s = {}) /\ b INTER f = {} ==> + (~(b INTER (UNIV DIFF s) = {}) /\ ~(b DIFF (UNIV DIFF s) = {}) + ==> ~(b INTER f = {})) + ==> b SUBSET s`) THEN + REWRITE_TAC[FRONTIER_COMPLEMENT] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `(f:real^M->real^N) a` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM SET_TAC[]; + REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN t ==> ~(x IN s)`] THEN + REWRITE_TAC[IN_BALL; REAL_NOT_LT]] THEN + MP_TAC(ISPECL[`frontier(IMAGE (f:real^M->real^N) s)`; `(f:real^M->real^N) a`] + DISTANCE_ATTAINS_INF) THEN + REWRITE_TAC[FRONTIER_CLOSED; FRONTIER_EQ_EMPTY] THEN ANTS_TAC THENL + [SIMP_TAC[DE_MORGAN_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV] `bounded s ==> ~(s = UNIV)`) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (closure s)` THEN + SIMP_TAC[IMAGE_SUBSET; CLOSURE_SUBSET] THEN + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE]; + DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC)] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [frontier]) THEN + REWRITE_TAC[IN_DIFF] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[CLOSURE_SEQUENTIAL] THEN + DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + REWRITE_TAC[IN_IMAGE; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:num->real^M` THEN REWRITE_TAC[FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM COMPACT_CLOSURE]) THEN + REWRITE_TAC[compact] THEN + DISCH_THEN(MP_TAC o SPEC `z:num->real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:real^M`; `r:num->num`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `(((\n. (f:real^M->real^N)(z n)) o (r:num->num)) --> w) sequentially` + MP_TAC THENL + [MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM o_ASSOC]] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!n. ((z:num->real^M) o (r:num->num)) n IN s` MP_TAC THENL + [ASM_REWRITE_TAC[o_THM]; + UNDISCH_THEN `((\n. (f:real^M->real^N) ((z:num->real^M) n)) --> w) + sequentially` (K ALL_TAC) THEN + UNDISCH_THEN `!n. (z:num->real^M) n IN s` (K ALL_TAC)] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`(z:num->real^M) o (r:num->num)`, `z:num->real^M`) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `w = (f:real^M->real^N) y` SUBST_ALL_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `(f:real^M->real^N) o (z:num->real^M)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_MESON_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(f y - (f:real^M->real^N) a)` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC; ASM_MESON_TAC[dist; NORM_SUB]] THEN + ASM_REWRITE_TAC[frontier; IN_DIFF] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[interior; IN_ELIM_THM] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (interior s)` THEN + ASM_SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations on sets preserve convexity. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_SCALING = prove + (`!s c. convex s ==> convex (IMAGE (\x. c % x) s)`, + REWRITE_TAC[convex; IN_IMAGE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % c % x + v % c % y = c % (u % x + v % y)`] THEN + ASM_MESON_TAC[]);; + +let CONVEX_SCALING_EQ = prove + (`!s c. ~(c = &0) ==> (convex (IMAGE (\x. c % x) s) <=> convex s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[CONVEX_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c` o MATCH_MP CONVEX_SCALING) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC; + REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]);; + +let CONVEX_NEGATIONS = prove + (`!s. convex s ==> convex (IMAGE (--) s)`, + REWRITE_TAC[convex; IN_IMAGE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % --x + v % --y = --(u % x + v % y)`] THEN + ASM_MESON_TAC[]);; + +let CONVEX_SUMS = prove + (`!s t. convex s /\ convex t ==> convex {x + y | x IN s /\ y IN t}`, + REWRITE_TAC[convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % (a + b) + v % (c + d) = (u % a + v % c) + (u % b + v % d)`] THEN + ASM_MESON_TAC[]);; + +let CONVEX_DIFFERENCES = prove + (`!s t. convex s /\ convex t ==> convex {x - y | x IN s /\ y IN t}`, + REWRITE_TAC[convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `u % (a - b) + v % (c - d) = (u % a + v % c) - (u % b + v % d)`] THEN + ASM_MESON_TAC[]);; + +let CONVEX_AFFINITY = prove + (`!s a:real^N c. + convex s ==> convex (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; CONVEX_TRANSLATION; CONVEX_SCALING]);; + +let CONVEX_LINEAR_PREIMAGE = prove + (`!f:real^M->real^N. + linear f /\ convex s ==> convex {x | f(x) IN s}`, + REWRITE_TAC[CONVEX_ALT; IN_ELIM_THM] THEN + SIMP_TAC[LINEAR_ADD; LINEAR_CMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Some interesting "cancellation" properties for sum-sets. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_SUMS_LCANCEL = prove + (`!s t u:real^N->bool. + ~(s = {}) /\ bounded s /\ closed u /\ convex u /\ + {x + y | x IN s /\ y IN t} SUBSET {x + z | x IN s /\ z IN u} + ==> t SUBSET u`, + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN X_GEN_TAC `b:real^N` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!n. ?w z:real^N. w IN s /\ z IN u /\ (&n + &1) % (b - z) = w - a` + MP_TAC THENL + [INDUCT_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[REAL_ADD_LID; VECTOR_MUL_LID] THEN + REWRITE_TAC[VECTOR_ARITH `b - z:real^N = w - a <=> a + b = w + z`] THEN + MESON_TAC[]; + FIRST_X_ASSUM(X_CHOOSE_THEN `a':real^N` (X_CHOOSE_THEN `c':real^N` + STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a':real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a'':real^N`; `c'':real^N`] THEN STRIP_TAC THEN + EXISTS_TAC `a'':real^N` THEN EXISTS_TAC + `(&1 - &1 / (&n + &2)) % c' + &1 / (&n + &2) % c'':real^N` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONVEX_ALT]) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; + REAL_ARITH `&0 < &n + &2`] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I + [VECTOR_ARITH `a' + b:real^N = a'' + c <=> a'' = (a' + b) - c`]) THEN + REWRITE_TAC[VECTOR_ARITH + `(&n + &1) % (b - c):real^N = (a' + b) - c'' - a <=> + &n % b - (&n + &1) % c = (a' - c'') - a`] THEN + SIMP_TAC[GSYM REAL_OF_NUM_SUC; VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; + REAL_ARITH `(n + &1) + &1 = n + &2`] THEN + REWRITE_TAC[VECTOR_MUL_LID; REAL_FIELD + `(&n + &2) * (&1 - (&1 / (&n + &2))) = &n + &1 /\ + (&n + &2) * &1 / (&n + &2) = &1`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `n % b - (n % c + d):real^N = n % (b - c) - d`] THEN + CONV_TAC VECTOR_ARITH]]; + FIRST_X_ASSUM(K ALL_TAC o check is_forall o concl) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `s:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + DISCH_TAC THEN FIRST_X_ASSUM(fun th -> + ONCE_REWRITE_TAC[GSYM(MATCH_MP CLOSED_APPROACHABLE th)]) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `B:real`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; X_GEN_TAC `n:num`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `abs(&n + &1)` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[dist]] THEN + ASM_REWRITE_TAC[GSYM NORM_MUL] THEN + REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + ASM_MESON_TAC[REAL_LET_TRANS]]);; + +let SUBSET_SUMS_RCANCEL = prove + (`!s t u:real^N->bool. + closed t /\ convex t /\ bounded u /\ ~(u = {}) /\ + {x + z | x IN s /\ z IN u} SUBSET {y + z | y IN t /\ z IN u} + ==> s SUBSET t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_SUMS_LCANCEL THEN + EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SUMS_SYM] THEN ASM_REWRITE_TAC[]);; + +let EQ_SUMS_LCANCEL = prove + (`!s t u. + ~(s = {}) /\ bounded s /\ + closed t /\ convex t /\ closed u /\ convex u /\ + {x + y | x IN s /\ y IN t} = {x + z | x IN s /\ z IN u} + ==> t = u`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; EMPTY_SUBSET] THEN + REWRITE_TAC[SUBSET_EMPTY] THEN MESON_TAC[SUBSET_SUMS_LCANCEL]);; + +let EQ_SUMS_RCANCEL = prove + (`!s t u. + closed s /\ convex s /\ closed t /\ convex t /\ + bounded u /\ ~(u = {}) /\ + {x + z | x IN s /\ z IN u} = {y + z | y IN t /\ z IN u} + ==> s = t`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; EMPTY_SUBSET] THEN + REWRITE_TAC[SUBSET_EMPTY] THEN MESON_TAC[SUBSET_SUMS_RCANCEL]);; + +(* ------------------------------------------------------------------------- *) +(* Convex hull. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_CONVEX_HULL = prove + (`!s. convex(convex hull s)`, + SIMP_TAC[P_HULL; CONVEX_INTERS]);; + +let CONVEX_HULL_EQ = prove + (`!s. (convex hull s = s) <=> convex s`, + SIMP_TAC[HULL_EQ; CONVEX_INTERS]);; + +let CONVEX_HULLS_EQ = prove + (`!s t. s SUBSET convex hull t /\ t SUBSET convex hull s + ==> convex hull s = convex hull t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULLS_EQ THEN + ASM_SIMP_TAC[CONVEX_INTERS]);; + +let IS_CONVEX_HULL = prove + (`!s. convex s <=> ?t. s = convex hull t`, + GEN_TAC THEN MATCH_MP_TAC IS_HULL THEN SIMP_TAC[CONVEX_INTERS]);; + +let MIDPOINTS_IN_CONVEX_HULL = prove + (`!x:real^N s. x IN convex hull s /\ y IN convex hull s + ==> midpoint(x,y) IN convex hull s`, + MESON_TAC[MIDPOINT_IN_CONVEX; CONVEX_CONVEX_HULL]);; + +let CONVEX_HULL_UNIV = prove + (`convex hull (:real^N) = (:real^N)`, + REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_UNIV]);; + +let BOUNDED_CONVEX_HULL = prove + (`!s:real^N->bool. bounded s ==> bounded(convex hull s)`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [bounded] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `cball(vec 0:real^N,B)` THEN + SIMP_TAC[BOUNDED_CBALL; SUBSET_HULL; CONVEX_CBALL] THEN + ASM_REWRITE_TAC[IN_CBALL; SUBSET; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let BOUNDED_CONVEX_HULL_EQ = prove + (`!s. bounded(convex hull s) <=> bounded s`, + MESON_TAC[BOUNDED_CONVEX_HULL; HULL_SUBSET; BOUNDED_SUBSET]);; + +let FINITE_IMP_BOUNDED_CONVEX_HULL = prove + (`!s. FINITE s ==> bounded(convex hull s)`, + SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED]);; + +(* ------------------------------------------------------------------------- *) +(* Stepping theorems for convex hulls of finite sets. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_EMPTY = prove + (`convex hull {} = {}`, + MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[SUBSET_REFL; CONVEX_EMPTY; EMPTY_SUBSET]);; + +let CONVEX_HULL_EQ_EMPTY = prove + (`!s. (convex hull s = {}) <=> (s = {})`, + GEN_TAC THEN EQ_TAC THEN + MESON_TAC[SUBSET_EMPTY; HULL_SUBSET; CONVEX_HULL_EMPTY]);; + +let CONVEX_HULL_SING = prove + (`!a. convex hull {a} = {a}`, + REWRITE_TAC[CONVEX_HULL_EQ; CONVEX_SING]);; + +let CONVEX_HULL_EQ_SING = prove + (`!s a:real^N. convex hull s = {a} <=> s = {a}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CONVEX_HULL_EMPTY] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_SING] THEN + MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET {a} ==> s = {a}`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[HULL_SUBSET]);; + +let CONVEX_HULL_INSERT = prove + (`!s a. ~(s = {}) + ==> (convex hull (a INSERT s) = + {x:real^N | ?u v b. &0 <= u /\ &0 <= v /\ (u + v = &1) /\ + b IN (convex hull s) /\ + (x = u % a + v % b)})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`&1`; `&0`]; + MAP_EVERY EXISTS_TAC [`&0`; `&1`]] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO] THEN + ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; HULL_SUBSET; SUBSET]; + ALL_TAC]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[convex] CONVEX_CONVEX_HULL) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HULL_SUBSET; SUBSET; IN_INSERT; HULL_MONO]] THEN + REWRITE_TAC[convex; IN_ELIM_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`x:real^N`; `y:real^N`; `u:real`; `v:real`; `u1:real`; `v1:real`; + `b1:real^N`; `u2:real`; `v2:real`; `b2:real^N`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`u * u1 + v * u2`; `u * v1 + v * v2`] THEN + REWRITE_TAC[VECTOR_ARITH + `u % (u1 % a + v1 % b1) + v % (u2 % a + v2 % b2) = + (u * u1 + v * u2) % a + (u * v1) % b1 + (v * v2) % b2`] THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_MUL] THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_ARITH + `(u * u1 + v * u2) + (u * v1 + v * v2) = + u * (u1 + v1) + v * (u2 + v2)`] THEN + ASM_CASES_TAC `u * v1 + v * v2 = &0` THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `(a + b = &0) ==> &0 <= a /\ &0 <= b ==> (a = &0) /\ (b = &0)`)) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_ADD_LID; VECTOR_MUL_LZERO; + VECTOR_ADD_RID] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `(u * v1) / (u * v1 + v * v2) % b1 + + (v * v2) / (u * v1 + v * v2) % b2 :real^N` THEN + ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_LMUL] THEN + MATCH_MP_TAC(REWRITE_RULE[convex] CONVEX_CONVEX_HULL) THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_LE_ADD] THEN + ASM_SIMP_TAC[real_div; GSYM REAL_ADD_RDISTRIB; REAL_MUL_RINV]);; + +let CONVEX_HULL_INSERT_ALT = prove + (`!s a:real^N. + convex hull (a INSERT s) = + if s = {} then {a} + else {(&1 - u) % a + u % x | &0 <= u /\ u <= &1 /\ x IN convex hull s}`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[CONVEX_HULL_SING] THEN + ASM_SIMP_TAC[CONVEX_HULL_INSERT] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> b /\ c /\ a /\ d`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; REAL_SUB_LE; + REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit expression for convex hull. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_INDEXED = prove + (`!s. convex hull s = + {y:real^N | ?k u x. (!i. 1 <= i /\ i <= k ==> &0 <= u i /\ x i IN s) /\ + (sum (1..k) u = &1) /\ + (vsum (1..k) (\i. u i % x i) = y)}`, + GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`1`; `\i:num. &1`; `\i:num. x:real^N`] THEN + ASM_SIMP_TAC[FINITE_RULES; IN_SING; SUM_SING; VECTOR_MUL_LID; VSUM_SING; + REAL_POS; NUMSEG_SING]; + ALL_TAC; + REWRITE_TAC[CONVEX_INDEXED; SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MESON_TAC[]] THEN + REWRITE_TAC[convex; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`k1:num`; `u1:num->real`; `x1:num->real^N`; + `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `k1 + k2:num` THEN + EXISTS_TAC `\i:num. if i <= k1 then u * u1(i) else v * u2(i - k1):real` THEN + EXISTS_TAC `\i:num. if i <= k1 then x1(i) else x2(i - k1):real^N` THEN + ASM_SIMP_TAC[NUMSEG_ADD_SPLIT; ARITH_RULE `1 <= x + 1 /\ x < x + 1`; + IN_NUMSEG; SUM_UNION; VSUM_UNION; FINITE_NUMSEG; DISJOINT_NUMSEG; + ARITH_RULE `k1 + 1 <= i ==> ~(i <= k1)`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] NUMSEG_OFFSET_IMAGE] THEN + ASM_SIMP_TAC[SUM_IMAGE; VSUM_IMAGE; EQ_ADD_LCANCEL; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[o_DEF; ADD_SUB2; SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC; + FINITE_NUMSEG; REAL_MUL_RID] THEN + ASM_MESON_TAC[REAL_LE_MUL; ARITH_RULE + `i <= k1 + k2 /\ ~(i <= k1) ==> 1 <= i - k1 /\ i - k1 <= k2`]);; + +(* ------------------------------------------------------------------------- *) +(* Another formulation from Lars Schewe. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_EXPLICIT = prove + (`!p. convex hull p = + {y:real^N | ?s u. FINITE s /\ s SUBSET p /\ + (!x. x IN s ==> &0 <= u x) /\ + sum s u = &1 /\ vsum s (\v. u v % v) = y}`, + REWRITE_TAC[CONVEX_HULL_INDEXED;EXTENSION;IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`IMAGE (x':num->real^N) (1..k)`; + `\v:real^N.sum {i | i IN (1..k) /\ x' i = v} u`] + THEN ASM_SIMP_TAC[FINITE_IMAGE;FINITE_NUMSEG;IN_IMAGE] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM;IN_NUMSEG] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[FINITE_NUMSEG;FINITE_RESTRICT;IN_ELIM_THM;IN_NUMSEG]; + ASM_SIMP_TAC[GSYM SUM_IMAGE_GEN;FINITE_IMAGE;FINITE_NUMSEG]; + FIRST_X_ASSUM (fun th -> REWRITE_TAC[GSYM th]) THEN + ASM_SIMP_TAC[GSYM VSUM_IMAGE_GEN;FINITE_IMAGE; + FINITE_NUMSEG;VSUM_VMUL;FINITE_RESTRICT] THEN + MP_TAC (ISPECL [`x':num->real^N`;`\i:num.u i % (x' i):real^N`;`(1..k)`] + (GSYM VSUM_IMAGE_GEN)) THEN + ASM_SIMP_TAC[FINITE_NUMSEG]];ALL_TAC] THEN + STRIP_ASSUME_TAC (ASM_REWRITE_RULE [ASSUME `FINITE (s:real^N->bool)`] + (ISPEC `s:real^N->bool` FINITE_INDEX_NUMSEG)) THEN + MAP_EVERY EXISTS_TAC [`CARD (s:real^N->bool)`; + `(u:real^N->real) o (f:num->real^N)`; + `(f:num->real^N)`] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[o_DEF] THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM SUBST1_TAC THEN + REWRITE_TAC[IN_IMAGE;IN_NUMSEG] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC (REWRITE_RULE [SUBSET] + (ASSUME `(s:real^N->bool) SUBSET p`)) THEN + FIRST_ASSUM SUBST1_TAC THEN + REWRITE_TAC[IN_IMAGE;IN_NUMSEG] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sum (s:real^N->bool) u` THEN + CONJ_TAC THENL [ALL_TAC;ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [ASSUME `(s:real^N->bool) = IMAGE f (1..CARD s)`] THEN + MATCH_MP_TAC (GSYM SUM_IMAGE) THEN + ASM_MESON_TAC[]; + REWRITE_TAC[MESON [o_THM;FUN_EQ_THM] + `(\i:num. (u o f) i % f i) = (\v:real^N. u v % v) o f`] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum (s:real^N->bool) (\v. u v % v)` THEN + CONJ_TAC THENL [ALL_TAC;ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [ASSUME `(s:real^N->bool) = IMAGE f (1..CARD s)`] THEN + MATCH_MP_TAC (GSYM VSUM_IMAGE) THEN + ASM SET_TAC[FINITE_NUMSEG]]);; + +let CONVEX_HULL_FINITE = prove + (`!s:real^N->bool. + convex hull s = + {y | ?u. (!x. x IN s ==> &0 <= u x) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y}`, + GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `f:real^N->real`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x:real^N. if x IN t then f x else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN + REWRITE_TAC[REAL_LE_REFL; COND_ID]; + X_GEN_TAC `f:real^N->real` THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN STRIP_TAC THEN + EXISTS_TAC `support (+) (f:real^N->real) s` THEN + EXISTS_TAC `f:real^N->real` THEN + MP_TAC(ASSUME `sum s (f:real^N->real) = &1`) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN + REWRITE_TAC[iterate] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NEUTRAL_REAL_ADD; REAL_OF_NUM_EQ; ARITH] THEN + DISCH_THEN(K ALL_TAC) THEN + UNDISCH_TAC `sum s (f:real^N->real) = &1` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM SUM_SUPPORT] THEN + ASM_CASES_TAC `support (+) (f:real^N->real) s = {}` THEN + ASM_SIMP_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH] THEN + DISCH_TAC THEN REWRITE_TAC[SUPPORT_SUBSET] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[support; IN_ELIM_THM]; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[SUPPORT_SUBSET] THEN + REWRITE_TAC[support; IN_ELIM_THM; NEUTRAL_REAL_ADD] THEN + MESON_TAC[VECTOR_MUL_LZERO]]);; + +let CONVEX_HULL_UNION_EXPLICIT = prove + (`!s t:real^N->bool. + convex s /\ convex t + ==> convex hull (s UNION t) = + s UNION t UNION + {(&1 - u) % x + u % y | x IN s /\ y IN t /\ &0 <= u /\ u <= &1}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[CONVEX_HULL_EXPLICIT] THEN GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:real^N`; `u:real^N->bool`; `f:real^N->real`] THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBST1_TAC(SET_RULE `u:real^N->bool = (u INTER s) UNION (u DIFF s)`) THEN + ASM_SIMP_TAC[SUM_UNION; VSUM_UNION; FINITE_INTER; FINITE_DIFF; + SET_RULE `DISJOINT (u INTER s) (u DIFF s)`] THEN + ASM_CASES_TAC `sum (u INTER s) (f:real^N->real) = &0` THENL + [SUBGOAL_THEN `!x. x IN (u INTER s) ==> (f:real^N->real) x = &0` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUM_POS_EQ_0; FINITE_INTER; IN_INTER]; + ASM_SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0] THEN + REWRITE_TAC[VECTOR_ADD_LID; REAL_ADD_LID] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN DISJ1_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN + ASM_SIMP_TAC[FINITE_DIFF; IN_DIFF] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `sum (u DIFF s) (f:real^N->real) = &0` THENL + [SUBGOAL_THEN `!x. x IN (u DIFF s) ==> (f:real^N->real) x = &0` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUM_POS_EQ_0; FINITE_DIFF; IN_DIFF]; + ASM_SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN + ASM_SIMP_TAC[FINITE_INTER; IN_INTER] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN DISJ2_TAC THEN + MAP_EVERY EXISTS_TAC + [`vsum(u INTER s) (\v:real^N. (f v / sum(u INTER s) f) % v)`; + `sum(u DIFF s) (f:real^N->real)`; + `vsum(u DIFF s) (\v:real^N. (f v / sum(u DIFF s) f) % v)`] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN + ASM_SIMP_TAC[INTER_SUBSET; FINITE_INTER; SUM_POS_LE; REAL_LE_DIV; + IN_INTER; real_div; SUM_RMUL; REAL_MUL_RINV]; + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN + ASM_SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; SUM_POS_LE; REAL_LE_DIV; + IN_DIFF; real_div; SUM_RMUL; REAL_MUL_RINV] THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[SUM_POS_LE; IN_DIFF; FINITE_DIFF]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a + b = &1 ==> &0 <= a ==> b <= &1`)) THEN + ASM_SIMP_TAC[SUM_POS_LE; IN_INTER; FINITE_INTER]; + ASM_SIMP_TAC[GSYM VSUM_LMUL; FINITE_INTER; FINITE_DIFF] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_ARITH `a * b / c:real = a / c * b`] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH + `a + b = &1 ==> &1 - b = a`)) THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_MUL_LID]]; + REWRITE_TAC[GSYM UNION_ASSOC] THEN ONCE_REWRITE_TAC[UNION_SUBSET] THEN + REWRITE_TAC[HULL_SUBSET] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real`; `y:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] CONVEX_CONVEX_HULL) THEN + ASM_SIMP_TAC[HULL_INC; IN_UNION]]);; + +let CONVEX_HULL_UNION_NONEMPTY_EXPLICIT = prove + (`!s t:real^N->bool. + convex s /\ ~(s = {}) /\ convex t /\ ~(t = {}) + ==> convex hull (s UNION t) = + {(&1 - u) % x + u % y | x IN s /\ y IN t /\ &0 <= u /\ u <= &1}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_UNION_EXPLICIT] THEN + SIMP_TAC[SET_RULE `s UNION t UNION u = u <=> s SUBSET u /\ t SUBSET u`] THEN + CONJ_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN + DISCH_TAC THENL + [MAP_EVERY EXISTS_TAC [`z:real^N`; `&0`] THEN + REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LID; REAL_POS; VECTOR_MUL_LZERO; + VECTOR_ADD_RID] THEN + ASM SET_TAC[]; + SUBGOAL_THEN `?a:real^N. a IN s` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`&1`; `z:real^N`] THEN + ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN VECTOR_ARITH_TAC]);; + +let CONVEX_HULL_UNION_UNIONS = prove + (`!f s:real^N->bool. + convex(UNIONS f) /\ ~(f = {}) + ==> convex hull (s UNION UNIONS f) = + UNIONS {convex hull (s UNION t) | t IN f}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_SIMP_TAC[UNION_EMPTY; HULL_P; UNIONS_SUBSET] THEN + X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull u:real^N->bool` THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `UNIONS f :real^N->bool = {}` THENL + [ASM_REWRITE_TAC[UNION_EMPTY] THEN + SUBGOAL_THEN `?u:real^N->bool. u IN f` CHOOSE_TAC THENL + [ASM_REWRITE_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull (s UNION u:real^N->bool)` THEN + ASM_SIMP_TAC[HULL_MONO; SUBSET_UNION] THEN ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [HULL_UNION_LEFT] THEN + ASM_SIMP_TAC[CONVEX_HULL_UNION_NONEMPTY_EXPLICIT; CONVEX_HULL_EQ_EMPTY; + CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_UNIONS] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real`; `u:real^N->bool`] THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN + EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] CONVEX_CONVEX_HULL) THEN + ASM_MESON_TAC[HULL_MONO; IN_UNION; SUBSET; HULL_INC]);; + +(* ------------------------------------------------------------------------- *) +(* A stepping theorem for that expansion. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_FINITE_STEP = prove + (`((?u. (!x. x IN {} ==> &0 <= u x) /\ + sum {} u = w /\ + vsum {} (\x. u(x) % x) = y) <=> w = &0 /\ y = vec 0) /\ + (FINITE(s:real^N->bool) + ==> ((?u. (!x. x IN (a INSERT s) ==> &0 <= u x) /\ + sum (a INSERT s) u = w /\ + vsum (a INSERT s) (\x. u(x) % x) = y) <=> + ?v. &0 <= v /\ + ?u. (!x. x IN s ==> &0 <= u x) /\ + sum s u = w - v /\ + vsum s (\x. u(x) % x) = y - v % a))`, + MP_TAC(ISPEC `\x:real^N y:real. &0 <= y` AFFINE_HULL_FINITE_STEP_GEN) THEN + SIMP_TAC[REAL_ARITH `&0 <= x / &2 <=> &0 <= x`; REAL_LE_ADD] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Hence some special cases. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_2 = prove + (`!a b. convex hull {a,b} = + {u % a + v % b | &0 <= u /\ &0 <= v /\ u + v = &1}`, + SIMP_TAC[CONVEX_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN + SIMP_TAC[CONVEX_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; + VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; + +let CONVEX_HULL_2_ALT = prove + (`!a b. convex hull {a,b} = {a + u % (b - a) | &0 <= u /\ u <= &1}`, + ONCE_REWRITE_TAC[SET_RULE `{a,b} = {b,a}`] THEN + REWRITE_TAC[CONVEX_HULL_2; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ADD_ASSOC; CONJ_ASSOC] THEN + REWRITE_TAC[TAUT `(a /\ x + y = &1) /\ b <=> x + y = &1 /\ a /\ b`] THEN + REWRITE_TAC[REAL_ARITH `x + y = &1 <=> y = &1 - x`; UNWIND_THM2] THEN + REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + BINOP_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; + +let CONVEX_HULL_3 = prove + (`convex hull {a,b,c} = + { u % a + v % b + w % c | + &0 <= u /\ &0 <= v /\ &0 <= w /\ u + v + w = &1}`, + SIMP_TAC[CONVEX_HULL_FINITE; FINITE_INSERT; FINITE_RULES] THEN + SIMP_TAC[CONVEX_HULL_FINITE_STEP; FINITE_INSERT; FINITE_RULES] THEN + REWRITE_TAC[REAL_ARITH `x - y = z:real <=> x = y + z`; + VECTOR_ARITH `x - y = z:real^N <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN SET_TAC[]);; + +let CONVEX_HULL_3_ALT = prove + (`!a b c. convex hull {a,b,c} = + {a + u % (b - a) + v % (c - a) | + &0 <= u /\ &0 <= v /\ u + v <= &1}`, + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,c,a}`] THEN + REWRITE_TAC[CONVEX_HULL_3; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ADD_ASSOC; CONJ_ASSOC] THEN + REWRITE_TAC[TAUT `(a /\ x + y = &1) /\ b <=> x + y = &1 /\ a /\ b`] THEN + REWRITE_TAC[REAL_ARITH `x + y = &1 <=> y = &1 - x`; UNWIND_THM2] THEN + REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + BINOP_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; + +let CONVEX_HULL_SUMS = prove + (`!s t:real^N->bool. + convex hull {x + y | x IN s /\ y IN t} = + {x + y | x IN convex hull s /\ y IN convex hull t}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[CONVEX_SUMS; CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[HULL_INC]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CONVEX_HULL_INDEXED] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`k1:num`; `u1:num->real`; `x1:num->real^N`; + `k2:num`; `u2:num->real`; `x2:num->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `x + y:real^N = + vsum(1..k1) (\i. vsum(1..k2) (\j. u1 i % u2 j % (x1 i + x2 j)))` + SUBST1_TAC THENL + [REWRITE_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD_NUMSEG] THEN + ASM_SIMP_TAC[VSUM_LMUL; VSUM_RMUL; VECTOR_MUL_LID]; + REWRITE_TAC[VSUM_LMUL] THEN MATCH_MP_TAC CONVEX_VSUM THEN + ASM_SIMP_TAC[FINITE_NUMSEG; CONVEX_CONVEX_HULL; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN + ASM_SIMP_TAC[FINITE_NUMSEG; CONVEX_CONVEX_HULL; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]]);; + +let AFFINE_HULL_PCROSS,CONVEX_HULL_PCROSS = (CONJ_PAIR o prove) + (`(!s:real^M->bool t:real^N->bool. + affine hull (s PCROSS t) = + (affine hull s) PCROSS (affine hull t)) /\ + (!s:real^M->bool t:real^N->bool. + convex hull (s PCROSS t) = + (convex hull s) PCROSS (convex hull t))`, + let lemma1 = prove + (`!u v x y:real^M z:real^N. + u + v = &1 + ==> pastecart z (u % x + v % y) = + u % pastecart z x + v % pastecart z y /\ + pastecart (u % x + v % y) z = + u % pastecart x z + v % pastecart y z`, + REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL] THEN + SIMP_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]) + and lemma2 = prove + (`INTERS {{x | pastecart x y IN u} | y IN t} = + {x | !y. y IN t ==> pastecart x y IN u}`, + REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM] THEN SET_TAC[]) in + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[AFFINE_PCROSS; AFFINE_AFFINE_HULL; HULL_SUBSET; PCROSS_MONO]; + REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `pastecart (x:real^M) (y:real^N) IN s PCROSS t` MP_TAC + THENL [ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; ALL_TAC] THEN + REWRITE_TAC[HULL_INC]; + ALL_TAC]; + REWRITE_TAC[GSYM lemma2] THEN MATCH_MP_TAC AFFINE_INTERS THEN + REWRITE_TAC[FORALL_IN_GSPEC]] THEN + SIMP_TAC[affine; IN_ELIM_THM; lemma1; + ONCE_REWRITE_RULE[affine] AFFINE_AFFINE_HULL]]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[CONVEX_PCROSS; CONVEX_CONVEX_HULL; HULL_SUBSET; PCROSS_MONO]; + REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `pastecart (x:real^M) (y:real^N) IN s PCROSS t` MP_TAC + THENL [ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; ALL_TAC] THEN + REWRITE_TAC[HULL_INC]; + ALL_TAC]; + REWRITE_TAC[GSYM lemma2] THEN MATCH_MP_TAC CONVEX_INTERS THEN + REWRITE_TAC[FORALL_IN_GSPEC]] THEN + SIMP_TAC[convex; IN_ELIM_THM; lemma1; + ONCE_REWRITE_RULE[convex] CONVEX_CONVEX_HULL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Relations among closure notions and corresponding hulls. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_IMP_AFFINE = prove + (`!s. subspace s ==> affine s`, + REWRITE_TAC[subspace; affine] THEN MESON_TAC[]);; + +let AFFINE_IMP_CONVEX = prove + (`!s. affine s ==> convex s`, + REWRITE_TAC[affine; convex] THEN MESON_TAC[]);; + +let SUBSPACE_IMP_CONVEX = prove + (`!s. subspace s ==> convex s`, + MESON_TAC[SUBSPACE_IMP_AFFINE; AFFINE_IMP_CONVEX]);; + +let AFFINE_HULL_SUBSET_SPAN = prove + (`!s. (affine hull s) SUBSET (span s)`, + GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_ANTIMONO THEN + REWRITE_TAC[SUBSET; IN; SUBSPACE_IMP_AFFINE]);; + +let CONVEX_HULL_SUBSET_SPAN = prove + (`!s. (convex hull s) SUBSET (span s)`, + GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_ANTIMONO THEN + REWRITE_TAC[SUBSET; IN; SUBSPACE_IMP_CONVEX]);; + +let CONVEX_HULL_SUBSET_AFFINE_HULL = prove + (`!s. (convex hull s) SUBSET (affine hull s)`, + GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_ANTIMONO THEN + REWRITE_TAC[SUBSET; IN; AFFINE_IMP_CONVEX]);; + +let COLLINEAR_CONVEX_HULL_COLLINEAR = prove + (`!s:real^N->bool. collinear(convex hull s) <=> collinear s`, + MESON_TAC[COLLINEAR_SUBSET; HULL_SUBSET; SUBSET_TRANS; + COLLINEAR_AFFINE_HULL_COLLINEAR; CONVEX_HULL_SUBSET_AFFINE_HULL]);; + +let AFFINE_SPAN = prove + (`!s. affine(span s)`, + SIMP_TAC[SUBSPACE_IMP_AFFINE; SUBSPACE_SPAN]);; + +let CONVEX_SPAN = prove + (`!s. convex(span s)`, + SIMP_TAC[SUBSPACE_IMP_CONVEX; SUBSPACE_SPAN]);; + +let AFFINE_EQ_SUBSPACE = prove + (`!s:real^N->bool. vec 0 IN s ==> (affine s <=> subspace s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[subspace; affine] THEN + DISCH_TAC THEN MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN + SUBST1_TAC(VECTOR_ARITH `c % x:real^N = c % x + (&1 - c) % vec 0`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH + `x + y:real^N = &2 % (&1 / &2 % x + &1 / &2 % y)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +let AFFINE_IMP_SUBSPACE = prove + (`!s. affine s /\ vec 0 IN s ==> subspace s`, + SIMP_TAC[GSYM AFFINE_EQ_SUBSPACE]);; + +let AFFINE_HULL_EQ_SPAN = prove + (`!s:real^N->bool. (vec 0) IN affine hull s ==> affine hull s = span s`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[AFFINE_HULL_SUBSET_SPAN] THEN + REWRITE_TAC[SUBSET] THEN MATCH_MP_TAC SPAN_INDUCT THEN + ASM_REWRITE_TAC[SUBSET; subspace; IN_ELIM_THM; HULL_INC] THEN + REPEAT STRIP_TAC THENL + [SUBST1_TAC(VECTOR_ARITH + `x + y:real^N = &2 % (&1 / &2 % x + &1 / &2 % y) + --(&1) % vec 0`) THEN + MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + SUBST1_TAC(VECTOR_ARITH + `c % x:real^N = c % x + (&1 - c) % vec 0`) THEN + MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +let CLOSED_AFFINE = prove + (`!s:real^N->bool. affine s ==> closed s`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CLOSED_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + SUBGOAL_THEN `affine (IMAGE (\x:real^N. --a + x) s) + ==> closed (IMAGE (\x:real^N. --a + x) s)` + MP_TAC THENL + [DISCH_THEN(fun th -> MATCH_MP_TAC CLOSED_SUBSPACE THEN MP_TAC th) THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC AFFINE_EQ_SUBSPACE THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[AFFINE_TRANSLATION_EQ; CLOSED_TRANSLATION_EQ]]);; + +let CLOSED_AFFINE_HULL = prove + (`!s. closed(affine hull s)`, + SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL]);; + +let CLOSURE_SUBSET_AFFINE_HULL = prove + (`!s. closure s SUBSET affine hull s`, + GEN_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + REWRITE_TAC[CLOSED_AFFINE_HULL; HULL_SUBSET]);; + +let AFFINE_HULL_CLOSURE = prove + (`!s:real^N->bool. affine hull (closure s) = affine hull s`, + GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]);; + +let AFFINE_HULL_EQ_SPAN_EQ = prove + (`!s:real^N->bool. (affine hull s = span s) <=> (vec 0) IN affine hull s`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPAN_0; AFFINE_HULL_EQ_SPAN]);; + +let AFFINE_DEPENDENT_IMP_DEPENDENT = prove + (`!s. affine_dependent s ==> dependent s`, + REWRITE_TAC[affine_dependent; dependent] THEN + MESON_TAC[SUBSET; AFFINE_HULL_SUBSET_SPAN]);; + +let DEPENDENT_AFFINE_DEPENDENT_CASES = prove + (`!s:real^N->bool. + dependent s <=> affine_dependent s \/ (vec 0) IN affine hull s`, + REWRITE_TAC[DEPENDENT_EXPLICIT; AFFINE_DEPENDENT_EXPLICIT; + AFFINE_HULL_EXPLICIT_ALT; IN_ELIM_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[OR_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN + ASM_CASES_TAC `FINITE(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC)) + THENL + [ASM_CASES_TAC `sum t (u:real^N->real) = &0` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISJ2_TAC THEN EXISTS_TAC `\v:real^N. inv(sum t u) * u v` THEN + ASM_SIMP_TAC[SUM_LMUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[VECTOR_MUL_RZERO; REAL_MUL_LINV]; + EXISTS_TAC `u:real^N->real` THEN ASM_MESON_TAC[]; + EXISTS_TAC `u:real^N->real` THEN + ASM_REWRITE_TAC[SET_RULE + `(?v. v IN t /\ ~p v) <=> ~(!v. v IN t ==> p v)`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x = &1 ==> x = &0 ==> F`)) THEN + ASM_MESON_TAC[SUM_EQ_0]]);; + +let DEPENDENT_IMP_AFFINE_DEPENDENT = prove + (`!a:real^N s. dependent {x - a | x IN s} /\ ~(a IN s) + ==> affine_dependent(a INSERT s)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[DEPENDENT_EXPLICIT; AFFINE_DEPENDENT_EXPLICIT] THEN + REWRITE_TAC[SIMPLE_IMAGE; CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + REWRITE_TAC[TAUT `a /\ x = IMAGE f s /\ b <=> x = IMAGE f s /\ a /\ b`] THEN + REWRITE_TAC[UNWIND_THM2; EXISTS_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` (X_CHOOSE_THEN `t:real^N->bool` + STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN + ASM_SIMP_TAC[VSUM_IMAGE; VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + ASM_SIMP_TAC[o_DEF; VECTOR_SUB_LDISTRIB; VSUM_SUB; VSUM_RMUL] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(a:real^N) INSERT t`; + `\x. if x = a then --sum t (\x. u (x - a)) + else (u:real^N->real) (x - a)`] THEN + ASM_REWRITE_TAC[FINITE_INSERT; SUBSET_REFL] THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x = y ==> --x + y = &0`) THEN + MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[]; + EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC(VECTOR_ARITH + `!s. s - t % a = vec 0 /\ s = u ==> --t % a + u = vec 0`) THEN + EXISTS_TAC `vsum t (\x:real^N. u(x - a) % x)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC VSUM_EQ THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; + +let AFFINE_DEPENDENT_BIGGERSET = prove + (`!s:real^N->bool. + (FINITE s ==> CARD s >= dimindex(:N) + 2) ==> affine_dependent s`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[CARD_CLAUSES; ARITH_RULE `~(0 >= n + 2)`; FINITE_RULES] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `x IN s ==> s = x INSERT (s DELETE x)`)) THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; IN_DELETE] THEN + REWRITE_TAC[ARITH_RULE `SUC x >= n + 2 <=> x > n`] THEN DISCH_TAC THEN + MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN + REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC DEPENDENT_BIGGERSET THEN + REWRITE_TAC[SET_RULE `{x - a:real^N | x | x IN s /\ ~(x = a)} = + IMAGE (\x. x - a) (s DELETE a)`] THEN + ASM_SIMP_TAC[FINITE_IMAGE_INJ_EQ; + VECTOR_ARITH `x - a = y - a <=> x:real^N = y`; + CARD_IMAGE_INJ]);; + +let AFFINE_DEPENDENT_BIGGERSET_GENERAL = prove + (`!s:real^N->bool. (FINITE s ==> CARD s >= dim s + 2) ==> affine_dependent s`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[CARD_CLAUSES; ARITH_RULE `~(0 >= n + 2)`; FINITE_RULES] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `x IN s ==> s = x INSERT (s DELETE x)`)) THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; IN_DELETE] THEN + REWRITE_TAC[ARITH_RULE `SUC x >= n + 2 <=> x > n`] THEN DISCH_TAC THEN + MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN + REWRITE_TAC[IN_DELETE] THEN + MATCH_MP_TAC DEPENDENT_BIGGERSET_GENERAL THEN + REWRITE_TAC[SET_RULE `{x - a:real^N | x | x IN s /\ ~(x = a)} = + IMAGE (\x. x - a) (s DELETE a)`] THEN + ASM_SIMP_TAC[FINITE_IMAGE_INJ_EQ; FINITE_DELETE; + VECTOR_ARITH `x - a = y - a <=> x:real^N = y`; + CARD_IMAGE_INJ] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check(is_imp o concl)) THEN + ASM_REWRITE_TAC[FINITE_DELETE] THEN + MATCH_MP_TAC(ARITH_RULE `c:num <= b ==> (a > b ==> a > c)`) THEN + MATCH_MP_TAC SUBSET_LE_DIM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + SIMP_TAC[SPAN_SUB; SPAN_SUPERSET; IN_INSERT]);; + +let AFFINE_INDEPENDENT_IMP_FINITE = prove + (`!s:real^N->bool. ~(affine_dependent s) ==> FINITE s`, + MESON_TAC[AFFINE_DEPENDENT_BIGGERSET]);; + +let AFFINE_INDEPENDENT_CARD_LE = prove + (`!s:real^N->bool. ~(affine_dependent s) ==> CARD s <= dimindex(:N) + 1`, + REWRITE_TAC[ARITH_RULE `s <= n + 1 <=> ~(n + 2 <= s)`; CONTRAPOS_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_DEPENDENT_BIGGERSET THEN + ASM_REWRITE_TAC[GE]);; + +let AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL = prove + (`!s t:real^N->bool. + ~affine_dependent s /\ t SUBSET s + ==> convex hull t = affine hull t INTER convex hull s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + SUBGOAL_THEN `FINITE(t:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `ct SUBSET a /\ ct SUBSET cs /\ a INTER cs SUBSET ct + ==> ct = a INTER cs`) THEN + ASM_SIMP_TAC[HULL_MONO; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + REWRITE_TAC[SUBSET; IN_INTER; CONVEX_HULL_FINITE; AFFINE_HULL_FINITE] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [AFFINE_DEPENDENT_EXPLICIT]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; + `\x:real^N. if x IN t then v x - u x:real else v x`]) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN REWRITE_TAC[MESON[] + `(if p then a else b) % x = if p then a % x else b % x`] THEN + ASM_SIMP_TAC[VSUM_CASES; SUM_CASES; SET_RULE + `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN + ASM_SIMP_TAC[GSYM DIFF; SUM_DIFF; VSUM_DIFF; VECTOR_SUB_RDISTRIB; + SUM_SUB; VSUM_SUB] THEN + REWRITE_TAC[REAL_ARITH `a - b + b - a = &0`; NOT_EXISTS_THM; + VECTOR_ARITH `a - b + b - a:real^N = vec 0`] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[REAL_SUB_0] THEN ASM SET_TAC[]);; + +let DISJOINT_AFFINE_HULL = prove + (`!s t u:real^N->bool. + ~affine_dependent s /\ t SUBSET s /\ u SUBSET s /\ DISJOINT t u + ==> DISJOINT (affine hull t) (affine hull u)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + SUBGOAL_THEN `FINITE(t:real^N->bool) /\ FINITE (u:real^N->bool)` ASSUME_TAC + THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IN_DISJOINT; AFFINE_HULL_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `a:real^N->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [AFFINE_DEPENDENT_EXPLICIT]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY EXISTS_TAC + [`s:real^N->bool`; + `\x:real^N. if x IN t then a x else if x IN u then --(b x) else &0`] THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN REWRITE_TAC[MESON[] + `(if p then a else b) % x = if p then a % x else b % x`] THEN + ASM_SIMP_TAC[SUM_CASES; SUBSET_REFL; VSUM_CASES; GSYM DIFF; SUM_DIFF; + VSUM_DIFF; SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN + ASM_SIMP_TAC[SUM_0; VSUM_0; VECTOR_MUL_LZERO; SUM_NEG; VSUM_NEG; + VECTOR_MUL_LNEG; SET_RULE `DISJOINT t u ==> ~(x IN t /\ x IN u)`] THEN + REWRITE_TAC[EMPTY_GSPEC; SUM_CLAUSES; VSUM_CLAUSES] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + UNDISCH_TAC `sum t (a:real^N->real) = &1` THEN + ASM_CASES_TAC `!x:real^N. x IN t ==> a x = &0` THEN + ASM_SIMP_TAC[SUM_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +let AFFINE_INDEPENDENT_SPAN_EQ = prove + (`!s. ~(affine_dependent s) /\ CARD s = dimindex(:N) + 1 + ==> affine hull s = (:real^N)`, + MATCH_MP_TAC SET_PROVE_CASES THEN + REWRITE_TAC[CARD_CLAUSES; ARITH_RULE `~(0 = n + 1)`] THEN + SIMP_TAC[IMP_CONJ; AFFINE_INDEPENDENT_IMP_FINITE; MESON[HAS_SIZE] + `FINITE s ==> (CARD s = n <=> s HAS_SIZE n)`] THEN + X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN + SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; IMP_CONJ] THEN + REWRITE_TAC[ARITH_RULE `SUC n = m + 1 <=> n = m`; GSYM UNIV_SUBSET] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV; LE_REFL; independent] THEN + UNDISCH_TAC `~affine_dependent((vec 0:real^N) INSERT s)` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN + ASM_REWRITE_TAC[VECTOR_SUB_RZERO; SET_RULE `{x | x IN s} = s`]);; + +let AFFINE_INDEPENDENT_SPAN_GT = prove + (`!s:real^N->bool. + ~(affine_dependent s) /\ dimindex(:N) < CARD s + ==> affine hull s = (:real^N)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_EQ THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `s:real^N->bool` AFFINE_DEPENDENT_BIGGERSET) THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN ASM_ARITH_TAC);; + +let EMPTY_INTERIOR_AFFINE_HULL = prove + (`!s:real^N->bool. + FINITE s /\ CARD(s) <= dimindex(:N) + ==> interior(affine hull s) = {}`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[AFFINE_HULL_EMPTY; INTERIOR_EMPTY] THEN + SUBGOAL_THEN + `!x s:real^N->bool n. + ~(x IN s) /\ (x INSERT s) HAS_SIZE n /\ n <= dimindex(:N) + ==> interior(affine hull(x INSERT s)) = {}` + (fun th -> MESON_TAC[th; HAS_SIZE; FINITE_INSERT]) THEN + X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN + REWRITE_TAC[HAS_SIZE; FINITE_INSERT; IMP_CONJ] THEN + SIMP_TAC[CARD_CLAUSES] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC EMPTY_INTERIOR_LOWDIM THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN + ASM_SIMP_TAC[DIM_LE_CARD; DIM_SPAN] THEN ASM_ARITH_TAC);; + +let EMPTY_INTERIOR_CONVEX_HULL = prove + (`!s:real^N->bool. + FINITE s /\ CARD(s) <= dimindex(:N) + ==> interior(convex hull s) = {}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN + EXISTS_TAC `interior(affine hull s):real^N->bool` THEN + SIMP_TAC[SUBSET_INTERIOR; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + ASM_SIMP_TAC[EMPTY_INTERIOR_AFFINE_HULL]);; + +let AFFINE_DEPENDENT_CHOOSE = prove + (`!s a:real^N. + ~(affine_dependent s) + ==> (affine_dependent(a INSERT s) <=> ~(a IN s) /\ a IN affine hull s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> a INSERT s = s`] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + EQ_TAC THENL + [UNDISCH_TAC `~(affine_dependent(s:real^N->bool))` THEN + ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE; AFFINE_HULL_FINITE; + FINITE_INSERT; IN_ELIM_THM; SUM_CLAUSES; VSUM_CLAUSES] THEN + DISCH_TAC THEN REWRITE_TAC[EXISTS_IN_INSERT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` MP_TAC) THEN + ASM_CASES_TAC `(u:real^N->real) a = &0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[REAL_ADD_LID; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `u:real^N->real`) THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[REAL_ARITH `ua + sa = &0 <=> sa = --ua`; + VECTOR_ARITH `va + sa:real^N = vec 0 <=> sa = --va`] THEN + STRIP_TAC THEN EXISTS_TAC `(\x. --(inv(u a)) * u x):real^N->real` THEN + ASM_SIMP_TAC[SUM_LMUL; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_MUL_LNEG] THEN + REWRITE_TAC[REAL_ARITH `--a * --b:real = a * b`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]]; + DISCH_TAC THEN REWRITE_TAC[affine_dependent] THEN + EXISTS_TAC `a:real^N` THEN + ASM_SIMP_TAC[IN_INSERT; SET_RULE + `~(a IN s) ==> (a INSERT s) DELETE a = s`]]);; + +let AFFINE_INDEPENDENT_INSERT = prove + (`!s a:real^N. + ~(affine_dependent s) /\ ~(a IN affine hull s) + ==> ~(affine_dependent(a INSERT s))`, + SIMP_TAC[AFFINE_DEPENDENT_CHOOSE]);; + +let AFFINE_HULL_EXPLICIT_UNIQUE = prove + (`!s:real^N->bool u u'. + ~(affine_dependent s) /\ + sum s u = &1 /\ sum s u' = &1 /\ + vsum s (\x. u x % x) = vsum s (\x. u' x % x) + ==> !x. x IN s ==> u x = u' x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP AFFINE_DEPENDENT_EXPLICIT_FINITE) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(\x. u x - u' x):real^N->real`) THEN + ASM_SIMP_TAC[VSUM_SUB; SUM_SUB; REAL_SUB_REFL; VECTOR_SUB_RDISTRIB; + VECTOR_SUB_REFL; VECTOR_SUB_EQ; REAL_SUB_0] THEN + MESON_TAC[]);; + +let INDEPENDENT_IMP_AFFINE_DEPENDENT_0 = prove + (`!s. independent s ==> ~(affine_dependent(vec 0 INSERT s))`, + REWRITE_TAC[independent; DEPENDENT_AFFINE_DEPENDENT_CASES] THEN + SIMP_TAC[DE_MORGAN_THM; AFFINE_INDEPENDENT_INSERT]);; + +let AFFINE_INDEPENDENT_STDBASIS = prove + (`~(affine_dependent + ((vec 0:real^N) INSERT {basis i | 1 <= i /\ i <= dimindex (:N)}))`, + SIMP_TAC[INDEPENDENT_IMP_AFFINE_DEPENDENT_0; INDEPENDENT_STDBASIS]);; + +(* ------------------------------------------------------------------------- *) +(* Nonempty affine sets are translates of (unique) subspaces. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_TRANSLATION_SUBSPACE = prove + (`!t:real^N->bool. + affine t /\ ~(t = {}) <=> ?a s. subspace s /\ t = IMAGE (\x. a + x) s`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY; IMAGE_EQ_EMPTY; + AFFINE_TRANSLATION; SUBSPACE_IMP_AFFINE] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN + ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ; IN_IMAGE] THEN + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let AFFINE_TRANSLATION_UNIQUE_SUBSPACE = prove + (`!t:real^N->bool. + affine t /\ ~(t = {}) <=> + ?!s. ?a. subspace s /\ t = IMAGE (\x. a + x) s`, + GEN_TAC THEN REWRITE_TAC[AFFINE_TRANSLATION_SUBSPACE] THEN + MATCH_MP_TAC(MESON[] + `(!a a' s s'. P s a /\ P s' a' ==> s = s') + ==> ((?a s. P s a) <=> (?!s. ?a. P s a))`) THEN + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_ASSOC] THEN + MATCH_MP_TAC SUBSPACE_TRANSLATION_SELF THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `--a' + a:real^N = --(a' - a)`] THEN + MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `t = IMAGE (\x:real^N. a' + x) s'` THEN + DISCH_THEN(MP_TAC o AP_TERM `\s. (a':real^N) IN s`) THEN + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a:real^N = a + x <=> x = vec 0`] THEN + ASM_SIMP_TAC[UNWIND_THM2; SUBSPACE_0] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a':real^N = a + x <=> x = a' - a`] THEN + REWRITE_TAC[UNWIND_THM2]);; + +let AFFINE_TRANSLATION_SUBSPACE_EXPLICIT = prove + (`!t:real^N->bool a. + affine t /\ a IN t + ==> subspace {x - a | x IN t} /\ + t = IMAGE (\x. a + x) {x - a | x IN t}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFFINE_DIFFS_SUBSPACE] THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN + REWRITE_TAC[o_DEF; VECTOR_SUB_ADD2; IMAGE_ID]);; + +(* ------------------------------------------------------------------------- *) +(* If we take a slice out of a set, we can do it perpendicularly, *) +(* with the normal vector to the slice parallel to the affine hull. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_PARALLEL_SLICE = prove + (`!s a:real^N b. + affine s + ==> s INTER {x | a dot x <= b} = {} \/ s SUBSET {x | a dot x <= b} \/ + ?a' b'. ~(a' = vec 0) /\ + + s INTER {x | a' dot x <= b'} = s INTER {x | a dot x <= b} /\ + s INTER {x | a' dot x = b'} = s INTER {x | a dot x = b} /\ + !w. w IN s ==> (w + a') IN s`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s INTER {x:real^N | a dot x = b} = {}` THENL + [MATCH_MP_TAC(TAUT `~(~p /\ ~q) ==> p \/ q \/ r`) THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?u v:real^N. u IN s /\ v IN s /\ + a dot u <= b /\ ~(a dot v <= b)` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(a:real^N) dot u < b` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM SET_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_INTER; NOT_FORALL_THM; IN_ELIM_THM] THEN + EXISTS_TAC + `u + (b - a dot u) / (a dot v - a dot u) % (v - u):real^N` THEN + ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF] THEN + REWRITE_TAC[DOT_RADD; DOT_RMUL; DOT_RSUB] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN POP_ASSUM MP_TAC THEN + GEN_GEOM_ORIGIN_TAC `z:real^N` ["a"; "a'"; "b'"; "w"] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ADD_RID; FORALL_IN_IMAGE] THEN + REWRITE_TAC[DOT_RADD; REAL_ARITH `a + x <= a <=> x <= &0`] THEN + SUBGOAL_THEN `subspace(s:real^N->bool) /\ span s = s` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_IMP_SUBSPACE; SPAN_EQ_SELF]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; orthogonal] THEN + MAP_EVERY X_GEN_TAC [`a':real^N`; `a'':real^N`] THEN + ASM_CASES_TAC `a':real^N = vec 0` THENL + [ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN + ASM_CASES_TAC `a'':real^N = a` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL]; + ALL_TAC] THEN + STRIP_TAC THEN REPEAT DISJ2_TAC THEN + EXISTS_TAC `a':real^N` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(a':real^N) dot z` THEN + REPEAT(CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> (p x <=> q x)) + ==> s INTER {x | p x} = s INTER {x | q x}`) THEN + ASM_SIMP_TAC[DOT_LADD] THEN REAL_ARITH_TAC; + ALL_TAC]) THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `x + a':real^N` THEN + ASM_SIMP_TAC[SUBSPACE_ADD; VECTOR_ADD_ASSOC]]);; + +(* ------------------------------------------------------------------------- *) +(* Affine dimension. *) +(* ------------------------------------------------------------------------- *) + +let MAXIMAL_AFFINE_INDEPENDENT_SUBSET = prove + (`!s b:real^N->bool. + b SUBSET s /\ ~(affine_dependent b) /\ + (!b'. b SUBSET b' /\ b' SUBSET s /\ ~(affine_dependent b') ==> b' = b) + ==> s SUBSET (affine hull b)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `(!a. a IN t /\ ~(a IN s) ==> F) ==> t SUBSET s`) THEN + X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT b`) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] HULL_INC)) THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_INSERT; INSERT_SUBSET] THEN + ASM SET_TAC[]);; + +let MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE = prove + (`!s b:real^N->bool. + affine s /\ b SUBSET s /\ ~(affine_dependent b) /\ + (!b'. b SUBSET b' /\ b' SUBSET s /\ ~(affine_dependent b') ==> b' = b) + ==> affine hull b = s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ASM_MESON_TAC[HULL_MONO; HULL_P]; + ASM_MESON_TAC[MAXIMAL_AFFINE_INDEPENDENT_SUBSET]]);; + +let EXTEND_TO_AFFINE_BASIS = prove + (`!s u:real^N->bool. + ~(affine_dependent s) /\ s SUBSET u + ==> ?t. ~(affine_dependent t) /\ s SUBSET t /\ t SUBSET u /\ + affine hull t = affine hull u`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\n. ?t:real^N->bool. ~(affine_dependent t) /\ s SUBSET t /\ + t SUBSET u /\ CARD t = n` + num_MAX) THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[SUBSET_REFL; AFFINE_INDEPENDENT_CARD_LE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ASM_MESON_TAC[HULL_MONO; HULL_P]; ALL_TAC] THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN + MATCH_MP_TAC MAXIMAL_AFFINE_INDEPENDENT_SUBSET THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(c:real^N->bool)`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBSET_LE THEN + ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);; + +let AFFINE_BASIS_EXISTS = prove + (`!s:real^N->bool. + ?b. ~(affine_dependent b) /\ b SUBSET s /\ + affine hull b = affine hull s`, + GEN_TAC THEN + MP_TAC(ISPECL [`{}:real^N->bool`; `s:real^N->bool`] + EXTEND_TO_AFFINE_BASIS) THEN + REWRITE_TAC[AFFINE_INDEPENDENT_EMPTY; EMPTY_SUBSET]);; + +let aff_dim = new_definition + `aff_dim s = + @d:int. ?b. affine hull b = affine hull s /\ ~(affine_dependent b) /\ + &(CARD b) = d + &1`;; + +let AFF_DIM = prove + (`!s. ?b. affine hull b = affine hull s /\ + ~(affine_dependent b) /\ + aff_dim s = &(CARD b) - &1`, + GEN_TAC THEN + REWRITE_TAC[aff_dim; INT_ARITH `y:int = x + &1 <=> x = y - &1`] THEN + CONV_TAC SELECT_CONV THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN + MESON_TAC[AFFINE_BASIS_EXISTS]);; + +let AFF_DIM_EMPTY = prove + (`aff_dim {} = -- &1`, + REWRITE_TAC[aff_dim; AFFINE_HULL_EMPTY; AFFINE_HULL_EQ_EMPTY] THEN + REWRITE_TAC[UNWIND_THM2; AFFINE_INDEPENDENT_EMPTY; CARD_CLAUSES] THEN + REWRITE_TAC[INT_ARITH `&0 = d + &1 <=> d:int = -- &1`; SELECT_REFL]);; + +let AFF_DIM_AFFINE_HULL = prove + (`!s. aff_dim(affine hull s) = aff_dim s`, + REWRITE_TAC[aff_dim; HULL_HULL]);; + +let AFF_DIM_TRANSLATION_EQ = prove + (`!a:real^N s. aff_dim (IMAGE (\x. a + x) s) = aff_dim s`, + REWRITE_TAC[aff_dim] THEN GEOM_TRANSLATE_TAC[] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; CARD_IMAGE_INJ; + VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);; + +add_translation_invariants [AFF_DIM_TRANSLATION_EQ];; + +let AFFINE_INDEPENDENT_CARD_DIM_DIFFS = prove + (`!s a:real^N. + ~affine_dependent s /\ a IN s + ==> CARD s = dim {x - a | x IN s} + 1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + MATCH_MP_TAC(ARITH_RULE `~(s = 0) /\ v = s - 1 ==> s = v + 1`) THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `{b - a:real^N |b| b IN (s DELETE a)}` THEN REPEAT CONJ_TAC THENL + [SET_TAC[]; + REWRITE_TAC[SIMPLE_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `x:real^N = a` THENL + [ASM_REWRITE_TAC[VECTOR_SUB_REFL; SPAN_0]; + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]; + UNDISCH_TAC `~affine_dependent(s:real^N->bool)` THEN + REWRITE_TAC[independent; CONTRAPOS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC DEPENDENT_IMP_AFFINE_DEPENDENT THEN + ASM_REWRITE_TAC[IN_DELETE]; + REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + SIMP_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; CARD_DELETE]]);; + +let AFF_DIM_DIM_AFFINE_DIFFS = prove + (`!a:real^N s. affine s /\ a IN s ==> aff_dim s = &(dim {x - a | x IN s})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` AFF_DIM) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN + ASM_CASES_TAC `b:real^N->bool = {}` THENL + [ASM_MESON_TAC[AFFINE_HULL_EQ_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[INT_EQ_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `dim {x - c:real^N | x IN b} + 1` THEN CONJ_TAC THENL + [MATCH_MP_TAC AFFINE_INDEPENDENT_CARD_DIM_DIFFS THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `dim {x - c:real^N | x IN affine hull b} + 1` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[DIFFS_AFFINE_HULL_SPAN; DIM_SPAN]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `affine hull s:real^N->bool = s` SUBST1_TAC THENL + [ASM_MESON_TAC[AFFINE_HULL_EQ]; ALL_TAC] THEN + SUBGOAL_THEN `(c:real^N) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_HULL_EQ; HULL_INC]; ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SIMP_TAC[VECTOR_ARITH `x - c:real^N = y - a <=> y = x + &1 % (a - c)`] THEN + ASM_MESON_TAC[IN_AFFINE_ADD_MUL_DIFF]);; + +let AFF_DIM_DIM_0 = prove + (`!s:real^N->bool. vec 0 IN affine hull s ==> aff_dim s = &(dim s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`vec 0:real^N`; `affine hull s:real^N->bool`] + AFF_DIM_DIM_AFFINE_DIFFS) THEN + ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL; SET_RULE `{x | x IN s} = s`] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; DIM_SPAN]);; + +let AFF_DIM_DIM_SUBSPACE = prove + (`!s:real^N->bool. subspace s ==> aff_dim s = &(dim s)`, + MESON_TAC[AFF_DIM_DIM_0; SUBSPACE_0; HULL_INC]);; + +let AFF_DIM_LINEAR_IMAGE_LE = prove + (`!f:real^M->real^N s. linear f ==> aff_dim(IMAGE f s) <= aff_dim s`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN + MP_TAC(ISPEC `s:real^M->bool` AFFINE_AFFINE_HULL) THEN + SPEC_TAC(`affine hull s:real^M->bool`,`s:real^M->bool`) THEN + GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; AFF_DIM_EMPTY; INT_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN + SUBGOAL_THEN `dim {x - f(a) |x| x IN IMAGE (f:real^M->real^N) s} <= + dim {x - a | x IN s}` + MP_TAC THENL + [REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f (g x) | x IN s}`] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN + MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + BINOP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC AFF_DIM_DIM_AFFINE_DIFFS THEN + ASM_SIMP_TAC[AFFINE_LINEAR_IMAGE; FUN_IN_IMAGE]]);; + +let AFF_DIM_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_dim(IMAGE f s) = aff_dim s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[AFF_DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC + `aff_dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; INT_LE_REFL]; + MATCH_MP_TAC AFF_DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);; + +add_linear_invariants [AFF_DIM_INJECTIVE_LINEAR_IMAGE];; + +let AFF_DIM_AFFINE_INDEPENDENT = prove + (`!b:real^N->bool. + ~(affine_dependent b) ==> aff_dim b = &(CARD b) - &1`, + GEN_TAC THEN ASM_CASES_TAC `b:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[CARD_CLAUSES; AFF_DIM_EMPTY] THEN INT_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`b:real^N->bool`; `a:real^N`] + AFFINE_INDEPENDENT_CARD_DIM_DIFFS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH `(a + b) - b:int = a`] THEN + MP_TAC(ISPECL [`a:real^N`; `affine hull b:real^N->bool`] + AFF_DIM_DIM_AFFINE_DIFFS) THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC; AFF_DIM_AFFINE_HULL] THEN + DISCH_THEN(K ALL_TAC) THEN AP_TERM_TAC THEN + ASM_MESON_TAC[DIFFS_AFFINE_HULL_SPAN; DIM_SPAN]);; + +let AFF_DIM_UNIQUE = prove + (`!s b:real^N->bool. + affine hull b = affine hull s /\ ~(affine_dependent b) + ==> aff_dim s = &(CARD b) - &1`, + MESON_TAC[AFF_DIM_AFFINE_HULL; AFF_DIM_AFFINE_INDEPENDENT]);; + +let AFF_DIM_SING = prove + (`!a:real^N. aff_dim {a} = &0`, + GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&(CARD {a:real^N}) - &1:int` THEN CONJ_TAC THENL + [MATCH_MP_TAC AFF_DIM_AFFINE_INDEPENDENT THEN + REWRITE_TAC[AFFINE_INDEPENDENT_1]; + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; ARITH; NOT_IN_EMPTY; INT_SUB_REFL]]);; + +let AFF_DIM_LE_CARD = prove + (`!s:real^N->bool. FINITE s ==> aff_dim s <= &(CARD s) - &1`, + MATCH_MP_TAC SET_PROVE_CASES THEN + SIMP_TAC[AFF_DIM_EMPTY; CARD_CLAUSES] THEN CONV_TAC INT_REDUCE_CONV THEN + GEOM_ORIGIN_TAC `a:real^N` THEN + SIMP_TAC[AFF_DIM_DIM_0; IN_INSERT; HULL_INC] THEN + SIMP_TAC[CARD_IMAGE_INJ; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + SIMP_TAC[DIM_INSERT_0; INT_LE_SUB_LADD; CARD_CLAUSES; FINITE_INSERT] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE; ADD1; LE_ADD_RCANCEL] THEN + SIMP_TAC[DIM_LE_CARD]);; + +let AFF_DIM_GE = prove + (`!s:real^N->bool. -- &1 <= aff_dim s`, + GEN_TAC THEN MP_TAC(ISPEC `s:real^N->bool` AFF_DIM) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[INT_LE_SUB_LADD; INT_ADD_LINV; INT_POS]);; + +let AFF_DIM_SUBSET = prove + (`!s t:real^N->bool. s SUBSET t ==> aff_dim s <= aff_dim t`, + MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EMPTY] THEN + GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(vec 0:real^N) IN t` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_DIM_0; IN_INSERT; HULL_INC; INT_OF_NUM_LE; DIM_SUBSET]);; + +let AFF_DIM_LE_DIM = prove + (`!s:real^N->bool. aff_dim s <= &(dim s)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE; SUBSPACE_SPAN] THEN + MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[SPAN_INC]);; + +let AFF_DIM_CONVEX_HULL = prove + (`!s:real^N->bool. aff_dim(convex hull s) = aff_dim s`, + GEN_TAC THEN MATCH_MP_TAC(INT_ARITH + `!c:int. c = a /\ a <= b /\ b <= c ==> b = a`) THEN + EXISTS_TAC `aff_dim(affine hull s:real^N->bool)` THEN + SIMP_TAC[AFF_DIM_AFFINE_HULL; AFF_DIM_SUBSET; HULL_SUBSET; + CONVEX_HULL_SUBSET_AFFINE_HULL]);; + +let AFF_DIM_CLOSURE = prove + (`!s:real^N->bool. aff_dim(closure s) = aff_dim s`, + GEN_TAC THEN MATCH_MP_TAC(INT_ARITH + `!h. h = s /\ s <= c /\ c <= h ==> c:int = s`) THEN + EXISTS_TAC `aff_dim(affine hull s:real^N->bool)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[AFF_DIM_AFFINE_HULL]; + MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET]; + MATCH_MP_TAC AFF_DIM_SUBSET THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + REWRITE_TAC[CLOSED_AFFINE_HULL; HULL_SUBSET]]);; + +let AFF_DIM_2 = prove + (`!a b:real^N. aff_dim {a,b} = if a = b then &0 else &1`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[INSERT_AC; AFF_DIM_SING]; ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `&(CARD {a:real^N,b}) - &1:int` THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFFINE_INDEPENDENT_2] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let AFF_DIM_EQ_MINUS1 = prove + (`!s:real^N->bool. aff_dim s = -- &1 <=> s = {}`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[AFF_DIM_EMPTY] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC(INT_ARITH `&0:int <= n ==> ~(n = -- &1)`) THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim {a:real^N}` THEN + ASM_SIMP_TAC[AFF_DIM_SUBSET; SING_SUBSET] THEN + REWRITE_TAC[AFF_DIM_SING; INT_LE_REFL]);; + +let AFF_DIM_POS_LE = prove + (`!s:real^N->bool. &0 <= aff_dim s <=> ~(s = {})`, + GEN_TAC THEN REWRITE_TAC[GSYM AFF_DIM_EQ_MINUS1] THEN + MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_GE) THEN INT_ARITH_TAC);; + +let AFF_DIM_EQ_0 = prove + (`!s:real^N->bool. aff_dim s = &0 <=> ?a. s = {a}`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[AFF_DIM_SING; LEFT_IMP_EXISTS_THM] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN + CONV_TAC INT_REDUCE_CONV THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC(SET_RULE + `(!b. ~(b = a) /\ {a,b} SUBSET s ==> F) ==> a IN s ==> s = {a}`) THEN + X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] AFF_DIM_2) THEN + ASM_SIMP_TAC[] THEN INT_ARITH_TAC);; + +let CONNECTED_IMP_PERFECT_AFF_DIM = prove + (`!s x:real^N. + connected s /\ ~(aff_dim s = &0) /\ x IN s ==> x limit_point_of s`, + REWRITE_TAC[AFF_DIM_EQ_0; CONNECTED_IMP_PERFECT]);; + +let AFF_DIM_UNIV = prove + (`aff_dim(:real^N) = &(dimindex(:N))`, + SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_UNIV; DIM_UNIV]);; + +let AFF_DIM_EQ_AFFINE_HULL = prove + (`!s t:real^N->bool. + s SUBSET t /\ aff_dim t <= aff_dim s + ==> affine hull s = affine hull t`, + MATCH_MP_TAC SET_PROVE_CASES THEN + SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; AFF_DIM_GE; + INT_ARITH `a:int <= x ==> (x <= a <=> x = a)`] THEN + X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN + SIMP_TAC[INSERT_SUBSET; IMP_CONJ; AFF_DIM_DIM_0; IN_INSERT; DIM_EQ_SPAN; + HULL_INC; AFFINE_HULL_EQ_SPAN; INT_OF_NUM_LE]);; + +let AFF_DIM_SUMS_INTER = prove + (`!s t:real^N->bool. + affine s /\ affine t /\ ~(s INTER t = {}) + ==> aff_dim {x + y | x IN s /\ y IN t} = + (aff_dim s + aff_dim t) - aff_dim(s INTER t)`, + REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN X_GEN_TAC `a:real^N` THEN + GEOM_ORIGIN_TAC `a:real^N` THEN + REWRITE_TAC[VECTOR_ARITH `(a + x) + (a + y):real^N = &2 % a + (x + y)`] THEN + ONCE_REWRITE_TAC[SET_RULE `{a + x + y:real^N | x IN s /\ y IN t} = + IMAGE (\x. a + x) {x + y | x IN s /\ y IN t}`] THEN + REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; IN_INTER] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN + STRIP_TAC THEN + SUBGOAL_THEN `(vec 0:real^N) IN {x + y | x IN s /\ y IN t}` ASSUME_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN REPEAT(EXISTS_TAC `vec 0:real^N`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_LID]; + ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; IN_INTER] THEN + REWRITE_TAC[INT_EQ_SUB_LADD; INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN + MATCH_MP_TAC DIM_SUMS_INTER THEN ASM_SIMP_TAC[AFFINE_IMP_SUBSPACE]);; + +let AFF_DIM_PSUBSET = prove + (`!s t. (affine hull s) PSUBSET (affine hull t) ==> aff_dim s < aff_dim t`, + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SIMP_TAC[PSUBSET; AFF_DIM_SUBSET; INT_LT_LE] THEN + MESON_TAC[INT_EQ_IMP_LE; AFF_DIM_EQ_AFFINE_HULL; HULL_HULL]);; + +let AFF_DIM_EQ_FULL = prove + (`!s. aff_dim s = &(dimindex(:N)) <=> affine hull s = (:real^N)`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_UNIV] THEN + MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN + ASM_REWRITE_TAC[SUBSET_UNIV; AFF_DIM_UNIV; INT_LE_REFL]; + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SIMP_TAC[AFF_DIM_UNIV]]);; + +let AFF_DIM_LE_UNIV = prove + (`!s:real^N->bool. aff_dim s <= &(dimindex(:N))`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN + MATCH_MP_TAC AFF_DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; + +let AFFINE_INDEPENDENT_IFF_CARD = prove + (`!s:real^N->bool. + ~affine_dependent s <=> FINITE s /\ aff_dim s = &(CARD s) - &1`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFFINE_INDEPENDENT_IMP_FINITE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN + X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC + (ISPEC `s:real^N->bool` AFFINE_BASIS_EXISTS) THEN + MATCH_MP_TAC(ARITH_RULE `!b:int. a <= b - &1 /\ b < s ==> ~(a = s - &1)`) THEN + EXISTS_TAC `&(CARD(b:real^N->bool)):int` THEN CONJ_TAC THENL + [ASM_MESON_TAC[AFF_DIM_LE_CARD; FINITE_SUBSET; AFF_DIM_AFFINE_HULL]; + REWRITE_TAC[INT_OF_NUM_LT] THEN MATCH_MP_TAC CARD_PSUBSET THEN + ASM_REWRITE_TAC[PSUBSET] THEN ASM_MESON_TAC[]]);; + +let AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR = prove + (`!s t:real^N->bool. + convex s /\ ~(s INTER interior t = {}) + ==> affine hull (s INTER t) = affine hull s`, + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`; `a:real^N`] THEN + GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + SIMP_TAC[SUBSET_HULL; AFFINE_AFFINE_HULL] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SIMP_RULE[SUBSET] INTERIOR_SUBSET)) THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INTER] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_CBALL_0] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_UNIV] THEN + X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_SIMP_TAC[SPAN_SUPERSET; IN_INTER] THEN DISCH_TAC THEN + ABBREV_TAC `k = min (&1 / &2) (e / norm(x:real^N))` THEN + SUBGOAL_THEN `&0 < k /\ k < &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; NORM_POS_LT; REAL_MIN_LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `x:real^N = inv k % k % x` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; + REAL_LT_IMP_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN + REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[VECTOR_ARITH + `k % x:real^N = (&1 - k) % vec 0 + k % x`] THEN + MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + FIRST_X_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "k" THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN + ASM_REAL_ARITH_TAC]);; + +let AFFINE_HULL_CONVEX_INTER_OPEN = prove + (`!s t:real^N->bool. + convex s /\ open t /\ ~(s INTER t = {}) + ==> affine hull (s INTER t) = affine hull s`, + ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; INTERIOR_OPEN]);; + +let AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR = prove + (`!s t:real^N->bool. + affine s /\ ~(s INTER interior t = {}) + ==> affine hull (s INTER t) = s`, + SIMP_TAC[AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; AFFINE_IMP_CONVEX; + HULL_P]);; + +let AFFINE_HULL_AFFINE_INTER_OPEN = prove + (`!s t:real^N->bool. + affine s /\ open t /\ ~(s INTER t = {}) + ==> affine hull (s INTER t) = s`, + SIMP_TAC[AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR; INTERIOR_OPEN]);; + +let CONVEX_AND_AFFINE_INTER_OPEN = prove + (`!s t u:real^N->bool. + convex s /\ affine t /\ open u /\ + s INTER u = t INTER u /\ ~(s INTER u = {}) + ==> affine hull s = t`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MESON[] `!u v. x = u /\ u = v /\ v = y ==> x = y`) THEN + MAP_EVERY EXISTS_TAC + [`affine hull (s INTER u:real^N->bool)`; + `affine hull t:real^N->bool`] THEN + REPEAT CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX] THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[AFFINE_HULL_EQ]]);; + +let AFFINE_HULL_CONVEX_INTER_OPEN_IN = prove + (`!s t:real^N->bool. + convex s /\ open_in (subtopology euclidean (affine hull s)) t /\ + ~(s INTER t = {}) + ==> affine hull (s INTER t) = affine hull s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t INTER u = s INTER u`; + HULL_SUBSET] THEN + MATCH_MP_TAC AFFINE_HULL_CONVEX_INTER_OPEN THEN ASM SET_TAC[]);; + +let AFFINE_HULL_AFFINE_INTER_OPEN_IN = prove + (`!s t:real^N->bool. + affine s /\ open_in (subtopology euclidean s) t /\ ~(s INTER t = {}) + ==> affine hull (s INTER t) = s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`affine hull s:real^N->bool`; `t:real^N->bool`] + AFFINE_HULL_CONVEX_INTER_OPEN_IN) THEN + ASM_SIMP_TAC[HULL_HULL; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; HULL_P]);; + +let AFFINE_HULL_OPEN_IN = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean (affine hull t)) s /\ ~(s = {}) + ==> affine hull s = affine hull t`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC AFFINE_HULL_AFFINE_INTER_OPEN THEN + REWRITE_TAC[AFFINE_AFFINE_HULL] THEN ASM SET_TAC[]);; + +let AFFINE_HULL_OPEN = prove + (`!s. open s /\ ~(s = {}) ==> affine hull s = (:real^N)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBST1_TAC(SET_RULE `s = (:real^N) INTER s`) THEN + ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_OPEN; CONVEX_UNIV] THEN + REWRITE_TAC[AFFINE_HULL_UNIV]);; + +let AFFINE_HULL_NONEMPTY_INTERIOR = prove + (`!s. ~(interior s = {}) ==> affine hull s = (:real^N)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC `affine hull (interior s:real^N->bool)` THEN + SIMP_TAC[HULL_MONO; INTERIOR_SUBSET] THEN + ASM_SIMP_TAC[AFFINE_HULL_OPEN; OPEN_INTERIOR]);; + +let AFF_DIM_OPEN = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> aff_dim s = &(dimindex(:N))`, + SIMP_TAC[AFF_DIM_EQ_FULL; AFFINE_HULL_OPEN]);; + +let AFF_DIM_NONEMPTY_INTERIOR = prove + (`!s:real^N->bool. ~(interior s = {}) ==> aff_dim s = &(dimindex(:N))`, + SIMP_TAC[AFF_DIM_EQ_FULL; AFFINE_HULL_NONEMPTY_INTERIOR]);; + +let SPAN_OPEN = prove + (`!s. open s /\ ~(s = {}) ==> span s = (:real^N)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFFINE_HULL_SUBSET_SPAN]);; + +let DIM_OPEN = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> dim s = dimindex(:N)`, + SIMP_TAC[DIM_EQ_FULL; SPAN_OPEN]);; + +let AFF_DIM_INSERT = prove + (`!a:real^N s. + aff_dim (a INSERT s) = + if a IN affine hull s then aff_dim s else aff_dim s + &1`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN MATCH_MP_TAC SET_PROVE_CASES THEN + SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_SING; AFFINE_HULL_EMPTY; NOT_IN_EMPTY] THEN + CONV_TAC INT_REDUCE_CONV THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`b:real^N`; `s:real^N->bool`; `a:real^N`] THEN + GEOM_ORIGIN_TAC `b:real^N` THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; AFF_DIM_DIM_0; HULL_INC; IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN + DISCH_THEN(K ALL_TAC) THEN + SPEC_TAC(`(vec 0:real^N) INSERT s`,`s:real^N->bool`) THEN + SIMP_TAC[DIM_INSERT; INT_OF_NUM_ADD] THEN MESON_TAC[]);; + +let AFFINE_BOUNDED_EQ_TRIVIAL = prove + (`!s:real^N->bool. + affine s ==> (bounded s <=> s = {} \/ ?a. s = {a})`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN + GEOM_ORIGIN_TAC `b:real^N` THEN SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUBSPACE_BOUNDED_EQ_TRIVIAL] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUBSPACE_0) THEN SET_TAC[]);; + +let AFFINE_BOUNDED_EQ_LOWDIM = prove + (`!s:real^N->bool. + affine s ==> (bounded s <=> aff_dim s <= &0)`, + SIMP_TAC[AFF_DIM_GE; INT_ARITH + `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN + SIMP_TAC[AFF_DIM_EQ_0; AFF_DIM_EQ_MINUS1; AFFINE_BOUNDED_EQ_TRIVIAL]);; + +let COLLINEAR_AFF_DIM = prove + (`!s:real^N->bool. collinear s <=> aff_dim s <= &1`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[COLLINEAR_AFFINE_HULL; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim{u:real^N,v}` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[AFF_DIM_SUBSET; AFF_DIM_AFFINE_HULL]; + MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `&(CARD{u:real^N,v}) - &1:int` THEN + SIMP_TAC[AFF_DIM_LE_CARD; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[INT_ARITH `x - &1:int <= &1 <=> x <= &2`; INT_OF_NUM_LE] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC]; + ONCE_REWRITE_TAC[GSYM COLLINEAR_AFFINE_HULL_COLLINEAR; + GSYM AFF_DIM_AFFINE_HULL] THEN + MP_TAC(ISPEC `s:real^N->bool` AFFINE_BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [AFFINE_INDEPENDENT_IFF_CARD]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; + AFF_DIM_AFFINE_HULL] THEN + REWRITE_TAC[INT_ARITH `x - &1:int <= &1 <=> x <= &2`; INT_OF_NUM_LE] THEN + ASM_SIMP_TAC[COLLINEAR_SMALL]]);; + +let HOMEOMORPHIC_AFFINE_SETS = prove + (`!s:real^M->bool t:real^N->bool. + affine s /\ affine t /\ aff_dim s = aff_dim t ==> s homeomorphic t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN + POP_ASSUM MP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC + [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN + GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN + SIMP_TAC[AFFINE_EQ_SUBSPACE; AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_EQ] THEN + MESON_TAC[HOMEOMORPHIC_SUBSPACES]);; + +let AFF_DIM_OPEN_IN = prove + (`!s t:real^N->bool. + ~(s = {}) /\ open_in (subtopology euclidean t) s /\ affine t + ==> aff_dim s = aff_dim t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + SUBGOAL_THEN `(vec 0:real^N) IN t` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; AFFINE_EQ_SUBSPACE] THEN + DISCH_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[GSYM LE_ANTISYM; DIM_SUBSET] THEN + SUBGOAL_THEN `?e. &0 < e /\ cball(vec 0:real^N,e) INTER t SUBSET s` + MP_TAC THENL + [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o + GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_INTER; IN_CBALL_0] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_BASIS_SUBSPACE) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `IMAGE (\x:real^N. e % x) b`] + INDEPENDENT_CARD_LE_DIM) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[CARD_IMAGE_INJ; VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN + ANTS_TAC THENL [REWRITE_TAC[SUBSET]; MESON_TAC[]] THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_MUL] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC SUBSPACE_MUL] THEN + ASM SET_TAC[]; + MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]]);; + +let DIM_OPEN_IN = prove + (`!s t:real^N->bool. + ~(s = {}) /\ open_in (subtopology euclidean t) s /\ subspace t + ==> dim s = dim t`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[GSYM LE_ANTISYM; DIM_SUBSET] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `aff_dim(s:real^N->bool)` THEN + REWRITE_TAC[AFF_DIM_LE_DIM] THEN ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN + MATCH_MP_TAC INT_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC AFF_DIM_OPEN_IN THEN ASM_SIMP_TAC[SUBSPACE_IMP_AFFINE]);; + +let AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR = prove + (`!s t:real^N->bool. + convex s /\ ~(s INTER interior t = {}) + ==> aff_dim(s INTER t) = aff_dim s`, + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR] THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL]);; + +let AFF_DIM_CONVEX_INTER_OPEN = prove + (`!s t:real^N->bool. + convex s /\ open t /\ ~(s INTER t = {}) + ==> aff_dim(s INTER t) = aff_dim s`, + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFFINE_HULL_CONVEX_INTER_OPEN] THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL]);; + +let AFFINE_HULL_HALFSPACE_LT = prove + (`!a b. affine hull {x | a dot x < b} = + if a = vec 0 /\ b <= &0 then {} else (:real^N)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_EMPTY; HALFSPACE_EQ_EMPTY_LT; + AFFINE_HULL_OPEN; OPEN_HALFSPACE_LT]);; + +let AFFINE_HULL_HALFSPACE_LE = prove + (`!a b. affine hull {x | a dot x <= b} = + if a = vec 0 /\ b < &0 then {} else (:real^N)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[AFFINE_HULL_EMPTY; AFFINE_HULL_UNIV] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[GSYM CLOSURE_HALFSPACE_LT; AFFINE_HULL_CLOSURE] THEN + ASM_REWRITE_TAC[AFFINE_HULL_HALFSPACE_LT]]);; + +let AFFINE_HULL_HALFSPACE_GT = prove + (`!a b. affine hull {x | a dot x > b} = + if a = vec 0 /\ b >= &0 then {} else (:real^N)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_EMPTY; HALFSPACE_EQ_EMPTY_GT; + AFFINE_HULL_OPEN; OPEN_HALFSPACE_GT]);; + +let AFFINE_HULL_HALFSPACE_GE = prove + (`!a b. affine hull {x | a dot x >= b} = + if a = vec 0 /\ b > &0 then {} else (:real^N)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] AFFINE_HULL_HALFSPACE_LE) THEN + SIMP_TAC[real_ge; DOT_LNEG; REAL_LE_NEG2; VECTOR_NEG_EQ_0] THEN + REWRITE_TAC[REAL_ARITH `--b < &0 <=> b > &0`]);; + +let AFF_DIM_HALFSPACE_LT = prove + (`!a:real^N b. + aff_dim {x | a dot x < b} = + if a = vec 0 /\ b <= &0 then --(&1) else &(dimindex(:N))`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SIMP_TAC[AFFINE_HULL_HALFSPACE_LT] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; + +let AFF_DIM_HALFSPACE_LE = prove + (`!a:real^N b. + aff_dim {x | a dot x <= b} = + if a = vec 0 /\ b < &0 then --(&1) else &(dimindex(:N))`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SIMP_TAC[AFFINE_HULL_HALFSPACE_LE] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; + +let AFF_DIM_HALFSPACE_GT = prove + (`!a:real^N b. + aff_dim {x | a dot x > b} = + if a = vec 0 /\ b >= &0 then --(&1) else &(dimindex(:N))`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SIMP_TAC[AFFINE_HULL_HALFSPACE_GT] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; + +let AFF_DIM_HALFSPACE_GE = prove + (`!a:real^N b. + aff_dim {x | a dot x >= b} = + if a = vec 0 /\ b > &0 then --(&1) else &(dimindex(:N))`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SIMP_TAC[AFFINE_HULL_HALFSPACE_GE] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_UNIV]);; + +let CHOOSE_AFFINE_SUBSET = prove + (`!s:real^N->bool d. + affine s /\ --(&1) <= d /\ d <= aff_dim s + ==> ?t. affine t /\ t SUBSET s /\ aff_dim t = d`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `d:int = --(&1)` THENL + [STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET; AFFINE_EMPTY; AFF_DIM_EMPTY]; + ASM_SIMP_TAC[INT_ARITH + `~(d:int = --(&1)) ==> (--(&1) <= d <=> &0 <= d)`] THEN + POP_ASSUM(K ALL_TAC)] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN INT_ARITH_TAC; + POP_ASSUM MP_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN + GEOM_ORIGIN_TAC `a:real^N` THEN + SIMP_TAC[IMP_CONJ; AFF_DIM_DIM_SUBSPACE; AFFINE_EQ_SUBSPACE] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `n:num`] + CHOOSE_SUBSPACE_OF_SUBSPACE) THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[AFF_DIM_DIM_SUBSPACE; SUBSPACE_IMP_AFFINE]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of a rigid transform between congruent sets. *) +(* ------------------------------------------------------------------------- *) + +let RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS = prove + (`!x:A->real^N y:A->real^N s. + (!i j. i IN s /\ j IN s ==> dist(x i,x j) = dist(y i,y j)) + ==> ?a f. orthogonal_transformation f /\ + !i. i IN s ==> y i = a + f(x i)`, + let lemma = prove + (`!x:(real^N)^M y:(real^N)^M. + (!i j. 1 <= i /\ i <= dimindex(:M) /\ + 1 <= j /\ j <= dimindex(:M) + ==> dist(x$i,x$j) = dist(y$i,y$j)) + ==> ?a f. orthogonal_transformation f /\ + !i. 1 <= i /\ i <= dimindex(:M) + ==> y$i = a + f(x$i)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `(X:real^M^N) = lambda i j. (x:real^N^M)$j$i - x$1$i` THEN + ABBREV_TAC `(Y:real^M^N) = lambda i j. (y:real^N^M)$j$i - y$1$i` THEN + SUBGOAL_THEN `transp(X:real^M^N) ** X = transp(Y:real^M^N) ** Y` + ASSUME_TAC THENL + [REWRITE_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN] THEN + MAP_EVERY EXPAND_TAC ["X"; "Y"] THEN + SIMP_TAC[CART_EQ; column; LAMBDA_BETA; dot] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM dot] THEN + REWRITE_TAC[DOT_NORM_SUB; VECTOR_ARITH + `(x - a) - (y - a):real^N = x - y`] THEN + ASM_SIMP_TAC[GSYM dist; DIMINDEX_GE_1; LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `?M:real^N^N. orthogonal_matrix M /\ (Y:real^M^N) = M ** (X:real^M^N)` + (CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL + [ALL_TAC; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [CART_EQ] THEN + MAP_EVERY EXPAND_TAC ["X"; "Y"] THEN + SIMP_TAC[LAMBDA_BETA; matrix_mul] THEN + REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN STRIP_TAC THEN + EXISTS_TAC `(y:real^N^M)$1 - (M:real^N^N) ** (x:real^N^M)$1` THEN + EXISTS_TAC `\x:real^N. (M:real^N^N) ** x` THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; + MATRIX_OF_MATRIX_VECTOR_MUL; MATRIX_VECTOR_MUL_LINEAR] THEN + SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; + VECTOR_ADD_COMPONENT] THEN + ASM_SIMP_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH + `a + y - b:real = a - z + y <=> z = b`] THEN + SIMP_TAC[LAMBDA_BETA]] THEN + MP_TAC(ISPEC `transp(X:real^M^N) ** X` + SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN + REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`P:real^M^M`; `d:num->real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> MP_TAC th THEN ASM_REWRITE_TAC[] THEN MP_TAC th) THEN + REWRITE_TAC[MATRIX_MUL_ASSOC; GSYM MATRIX_TRANSP_MUL] THEN + REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [CART_EQ] THEN + SIMP_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN; LAMBDA_BETA] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\i. column i ((X:real^M^N) ** (P:real^M^M))`; + `\i. column i ((Y:real^M^N) ** (P:real^M^M))`; + `1..dimindex(:M)`] + ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS) THEN + REWRITE_TAC[IN_NUMSEG] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[pairwise; IN_NUMSEG; NORM_EQ; orthogonal]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + EXISTS_TAC `matrix(f:real^N->real^N)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]; ALL_TAC] THEN + SUBGOAL_THEN + `!M:real^M^N. M = M ** (P:real^M^M) ** transp P` + (fun th -> GEN_REWRITE_TAC BINOP_CONV [th]) + THENL + [ASM_MESON_TAC[orthogonal_matrix; MATRIX_MUL_RID]; + REWRITE_TAC[MATRIX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC] THEN + REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN + ASM_SIMP_TAC[MATRIX_EQUAL_COLUMNS] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthogonal_transformation]) THEN + DISCH_THEN(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o CONJUNCT1) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[CART_EQ; matrix_vector_mul; column; LAMBDA_BETA] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [matrix_mul] THEN + ASM_SIMP_TAC[LAMBDA_BETA]) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:A->bool = {}` THENL + [REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `\x:real^N. x`] THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; ORTHOGONAL_TRANSFORMATION_ID]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `m:A`) THEN DISCH_TAC] THEN + SUBGOAL_THEN + `?r. IMAGE r (1..dimindex(:(N,1)finite_sum)) SUBSET s /\ + affine hull (IMAGE (y o r) (1..dimindex(:(N,1)finite_sum))) = + affine hull (IMAGE (y:A->real^N) s)` + MP_TAC THENL + [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + SIMP_TAC[IMAGE_o; TAUT `p /\ q <=> ~(p ==> ~q)`; + HULL_MONO; IMAGE_SUBSET] THEN REWRITE_TAC[NOT_IMP] THEN + MP_TAC(ISPEC `IMAGE (y:A->real^N) s` AFFINE_BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AFFINE_INDEPENDENT_IFF_CARD]) THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `CARD(b:real^N->bool) <= dimindex(:(N,1)finite_sum)` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH + `a:int = c - &1 ==> a + &1 <= n ==> c <= n`)) THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_LE_RADD; AFF_DIM_LE_UNIV]; + ALL_TAC] THEN + UNDISCH_TAC `b SUBSET IMAGE (y:A->real^N) s` THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE] THEN + GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\i. if i <= CARD(b:real^N->bool) then r i else (m:A)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + UNDISCH_THEN `affine hull b:real^N->bool = affine hull IMAGE y (s:A->bool)` + (SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC HULL_MONO THEN + ONCE_ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN EXISTS_TAC `i:num` THEN + ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[LE_TRANS]; + REWRITE_TAC[SUBSET; IN_NUMSEG; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`(lambda i. x(r i:A)):real^N^(N,1)finite_sum`; + `(lambda i. y(r i:A)):real^N^(N,1)finite_sum`] lemma) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `k:A` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!z. z IN + affine hull IMAGE (y o (r:num->A)) (1..dimindex(:(N,1)finite_sum)) + ==> dist(z,y k) = dist(z,a + (f:real^N->real^N)(x k))` + MP_TAC THENL + [MATCH_MP_TAC SAME_DISTANCES_TO_AFFINE_HULL THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `dist(x(r(j:num)),(x:A->real^N) k)` THEN CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[dist] THEN ASM_SIMP_TAC[NORM_ARITH + `(a + x) - (a + y):real^N = x - y`] THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION; LINEAR_SUB]]; + ASM_SIMP_TAC[NORM_ARITH + `a:real^N = b <=> dist(a:real^N,a) = dist(a,b)`] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC HULL_INC THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]]]);; + +let RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG = prove + (`!x:A->real^N y:A->real^N s t. + t SUBSET s /\ affine hull (IMAGE y t) = affine hull (IMAGE y s) /\ + (!i j. i IN s /\ j IN t ==> dist(x i,x j) = dist(y i,y j)) + ==> ?a f. orthogonal_transformation f /\ + !i. i IN s ==> y i = a + f(x i)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`x:A->real^N`; `y:A->real^N`; `t:A->bool`] + RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!z. z IN affine hull (IMAGE (y:A->real^N) t) + ==> dist(z,y i) = dist(z,a + (f:real^N->real^N)(x i))` + MP_TAC THENL + [MATCH_MP_TAC SAME_DISTANCES_TO_AFFINE_HULL THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_NUMSEG] THEN + X_GEN_TAC `j:A` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `dist(a + f(x(j:A):real^N):real^N,a + f(x i))` THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`] THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_ISOMETRY; DIST_SYM]; + ASM_SIMP_TAC[NORM_ARITH + `a:real^N = b <=> dist(a:real^N,a) = dist(a,b)`] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC HULL_INC THEN + REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]]);; + +let RIGID_TRANSFORMATION_BETWEEN_3 = prove + (`!a b c a' b' c':real^N. + dist(a,b) = dist(a',b') /\ + dist(b,c) = dist(b',c') /\ + dist(c,a) = dist(c',a') + ==> ?k f. orthogonal_transformation f /\ + a' = k + f a /\ b' = k + f b /\ c' = k + f c`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`FST:real^N#real^N->real^N`; `SND:real^N#real^N->real^N`; + `{(a:real^N,a':real^N), (b,b'), (c,c')}`] + RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN + REWRITE_TAC[NOT_IN_EMPTY; IMP_IMP] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[DIST_REFL; DIST_SYM]);; + +let RIGID_TRANSFORMATION_BETWEEN_2 = prove + (`!a b a' b':real^N. + dist(a,b) = dist(a',b') + ==> ?k f. orthogonal_transformation f /\ + a' = k + f a /\ b' = k + f b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `a:real^N`; + `a':real^N`; `b':real^N`; `a':real^N`] + RIGID_TRANSFORMATION_BETWEEN_3) THEN + ASM_MESON_TAC[DIST_EQ_0; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Caratheodory's theorem. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_CARATHEODORY_AFF_DIM = prove + (`!p. convex hull p = + {y:real^N | ?s u. FINITE s /\ s SUBSET p /\ + &(CARD s) <= aff_dim p + &1 /\ + (!x. x IN s ==> &0 <= u x) /\ + sum s u = &1 /\ vsum s (\v. u v % v) = y}`, + GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_EXPLICIT] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + MATCH_MP_TAC(TAUT `!q. (p ==> q) /\ (q ==> r) ==> (p ==> r)`) THEN + EXISTS_TAC `?n s u. CARD s = n /\ + FINITE s /\ s SUBSET p /\ + (!x. x IN s ==> &0 <= u x) /\ + sum s u = &1 /\ vsum s (\v. u v % v) = (y:real^N)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC I [GSYM INT_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN REWRITE_TAC[NOT_IMP] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `~(n = 0) ==> n - 1 < n`) THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `aff_dim(p:real^N->bool) + &1 < &0` THEN + REWRITE_TAC[INT_ARITH `p + &1:int < &0 <=> ~(-- &1 <= p)`] THEN + REWRITE_TAC[AFF_DIM_GE]; + ALL_TAC] THEN + MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_AFFINE_INDEPENDENT) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(aff_dim(s:real^N->bool) = &n - &1)` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN + + UNDISCH_TAC `aff_dim(p:real^N->bool) + &1 < &n` THEN + INT_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N->real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?t. (!v:real^N. v IN s ==> u(v) + t * w(v) >= &0) /\ + ?a. a IN s /\ u(a) + t * w(a) = &0` + STRIP_ASSUME_TAC THENL + [ABBREV_TAC + `i = IMAGE (\v. u(v) / --w(v)) {v:real^N | v IN s /\ w v < &0}` THEN + EXISTS_TAC `inf i` THEN MP_TAC(SPEC `i:real->bool` INF_FINITE) THEN + ANTS_TAC THENL + [EXPAND_TAC "i" THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`w:real^N->real`; `s:real^N->bool`] SUM_ZERO_EXISTS) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `t = inf i` THEN + EXPAND_TAC "i" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `a:real^N` + STRIP_ASSUME_TAC) MP_TAC) THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `x < &0 ==> &0 < --x`; real_ge] THEN + REWRITE_TAC[REAL_ARITH `t * --w <= u <=> &0 <= u + t * w`] THEN + STRIP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `(w:real^N->real) x < &0 \/ &0 <= w x`) THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_ADD THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `w < &0 ==> &0 <= --w`) THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `w(a:real^N) < &0` THEN CONV_TAC REAL_FIELD]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`s DELETE (a:real^N)`; `(\v. u(v) + t * w(v)):real^N->real`] THEN + ASM_SIMP_TAC[SUM_DELETE; VSUM_DELETE; CARD_DELETE; FINITE_DELETE] THEN + ASM_SIMP_TAC[SUM_ADD; VECTOR_ADD_RDISTRIB; VSUM_ADD] THEN + ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL; VSUM_LMUL] THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; ASM SET_TAC[real_ge]; REAL_ARITH_TAC; VECTOR_ARITH_TAC]);; + +let CARATHEODORY_AFF_DIM = prove + (`!p. convex hull p = + {x:real^N | ?s. FINITE s /\ s SUBSET p /\ + &(CARD s) <= aff_dim p + &1 /\ + x IN convex hull s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [CONVEX_HULL_CARATHEODORY_AFF_DIM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[HULL_SUBSET; CONVEX_EXPLICIT; CONVEX_CONVEX_HULL]; + MESON_TAC[SUBSET; HULL_MONO]]);; + +let CONVEX_HULL_CARATHEODORY = prove + (`!p. convex hull p = + {y:real^N | ?s u. FINITE s /\ s SUBSET p /\ + CARD(s) <= dimindex(:N) + 1 /\ + (!x. x IN s ==> &0 <= u x) /\ + sum s u = &1 /\ vsum s (\v. u v % v) = y}`, + + GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^N` THEN + EQ_TAC THENL + [REWRITE_TAC[CONVEX_HULL_CARATHEODORY_AFF_DIM; IN_ELIM_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE; GSYM INT_OF_NUM_ADD] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH + `a:int <= x + &1 ==> x <= y ==> a <= y + &1`)) THEN + REWRITE_TAC[AFF_DIM_LE_UNIV]; + REWRITE_TAC[CONVEX_HULL_EXPLICIT; IN_ELIM_THM] THEN MESON_TAC[]]);; + +let CARATHEODORY = prove + (`!p. convex hull p = + {x:real^N | ?s. FINITE s /\ s SUBSET p /\ + CARD(s) <= dimindex(:N) + 1 /\ + x IN convex hull s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [CONVEX_HULL_CARATHEODORY] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[HULL_SUBSET; CONVEX_EXPLICIT; CONVEX_CONVEX_HULL]; + MESON_TAC[SUBSET; HULL_MONO]]);; + +(* ------------------------------------------------------------------------- *) +(* Some results on decomposing convex hulls, e.g. simplicial subdivision. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_HULL_INTER,CONVEX_HULL_INTER = (CONJ_PAIR o prove) + (`(!s t:real^N->bool. + ~(affine_dependent(s UNION t)) + ==> affine hull s INTER affine hull t = affine hull (s INTER t)) /\ + (!s t:real^N->bool. + ~(affine_dependent (s UNION t)) + ==> convex hull s INTER convex hull t = convex hull (s INTER t))`, + CONJ_TAC THEN + (REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + REWRITE_TAC[FINITE_UNION] THEN STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER] THEN + SIMP_TAC[HULL_MONO; INTER_SUBSET] THEN + REWRITE_TAC[SUBSET; AFFINE_HULL_FINITE; CONVEX_HULL_FINITE; + IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [AFFINE_DEPENDENT_EXPLICIT]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(s UNION t):real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + DISCH_THEN(MP_TAC o SPEC + `\x:real^N. (if x IN s then u x else &0) - + (if x IN t then v x else &0)`) THEN + ASM_SIMP_TAC[SUM_SUB; FINITE_UNION; VSUM_SUB; VECTOR_SUB_RDISTRIB] THEN + REWRITE_TAC[MESON[] + `(if p then a else b) % x = (if p then a % x else b % x)`] THEN + ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; VECTOR_MUL_LZERO; FINITE_UNION] THEN + ASM_REWRITE_TAC[SUM_0; VSUM_0; + SET_RULE `{x | x IN (s UNION t) /\ x IN s} = s`; + SET_RULE `{x | x IN (s UNION t) /\ x IN t} = t`] THEN + MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN + REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC EQ_TRANS THENL + [EXISTS_TAC `sum s (u:real^N->real)`; + EXISTS_TAC `vsum s (\x. (u:real^N->real) x % x)`] THEN + (CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM ACCEPT_TAC]) THEN + CONV_TAC SYM_CONV THENL + [MATCH_MP_TAC SUM_EQ_SUPERSET; MATCH_MP_TAC VSUM_EQ_SUPERSET] THEN + ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN ASM SET_TAC[]));; + +let AFFINE_HULL_INTERS = prove + (`!s:(real^N->bool)->bool. + ~(affine_dependent(UNIONS s)) + ==> affine hull (INTERS s) = INTERS {affine hull t | t IN s}`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MP_TAC(MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE th)) THEN + SPEC_TAC(`s:(real^N->bool)->bool`,`s:(real^N->bool)->bool`) THEN + REWRITE_TAC[FINITE_UNIONS; IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; INTERS_0; UNIONS_INSERT; INTERS_INSERT; + SET_RULE `{f x | x IN {}} = {}`; AFFINE_HULL_UNIV] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[FORALL_IN_INSERT] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN + SET_TAC[]; + DISCH_TAC] THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; IN_SING] THEN + REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`; INTERS_1]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rhs o rand) AFFINE_HULL_INTER o lhand o snd) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN + UNDISCH_TAC `~(f:(real^N->bool)->bool = {})` THEN SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[SET_RULE + `{f x | x IN (a INSERT s)} = (f a) INSERT {f x | x IN s}`] THEN + ASM_REWRITE_TAC[INTERS_INSERT]);; + +let CONVEX_HULL_INTERS = prove + (`!s:(real^N->bool)->bool. + ~(affine_dependent(UNIONS s)) + ==> convex hull (INTERS s) = INTERS {convex hull t | t IN s}`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MP_TAC(MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE th)) THEN + SPEC_TAC(`s:(real^N->bool)->bool`,`s:(real^N->bool)->bool`) THEN + REWRITE_TAC[FINITE_UNIONS; IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; INTERS_0; UNIONS_INSERT; INTERS_INSERT; + SET_RULE `{f x | x IN {}} = {}`; CONVEX_HULL_UNIV] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[FORALL_IN_INSERT] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN + SET_TAC[]; + DISCH_TAC] THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; IN_SING] THEN + REWRITE_TAC[SET_RULE `{f x | x = a} = {f a}`; INTERS_1]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rhs o rand) CONVEX_HULL_INTER o lhand o snd) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~affine_dependent((s UNION UNIONS f):real^N->bool)` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO) THEN + UNDISCH_TAC `~(f:(real^N->bool)->bool = {})` THEN SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[SET_RULE + `{f x | x IN (a INSERT s)} = (f a) INSERT {f x | x IN s}`] THEN + ASM_REWRITE_TAC[INTERS_INSERT]);; + +let IN_CONVEX_HULL_EXCHANGE = prove + (`!s a x:real^N. + a IN convex hull s /\ x IN convex hull s + ==> ?b. b IN s /\ x IN convex hull (a INSERT (s DELETE b))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL + [EXISTS_TAC `a:real^N` THEN ASM_SIMP_TAC[INSERT_DELETE]; ALL_TAC] THEN + ASM_CASES_TAC `FINITE(s:real^N->bool) /\ CARD s <= dimindex(:N) + 1` THENL + [ALL_TAC; + UNDISCH_TAC `(x:real^N) IN convex hull s` THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CARATHEODORY] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC `t:real^N->bool = s` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?b:real^N. b IN s /\ ~(b IN t)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(x:real^N) IN convex hull t` THEN + SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]] THEN + MP_TAC(ASSUME `(a:real^N) IN convex hull s`) THEN + MP_TAC(ASSUME `(x:real^N) IN convex hull s`) THEN + REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `v:real^N->real` THEN STRIP_TAC THEN + X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN + ASM_CASES_TAC `?b. b IN s /\ (v:real^N->real) b = &0` THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN + X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `\x:real^N. if x = a then &0 else v x` THEN + ASM_SIMP_TAC[FORALL_IN_INSERT; REAL_LE_REFL] THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_DELETE] THEN + ASM_REWRITE_TAC[IN_DELETE] THEN + ASM_SIMP_TAC[SUM_DELETE; VSUM_DELETE; COND_ID] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; REAL_LE_REFL; COND_ID] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; SUM_0; VSUM_0] THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ ~(x = a)} = s`] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE (\b. (u:real^N->real) b / v b) s` SUP_FINITE) THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_MESON_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[IN_IMAGE] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `b:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!b. b IN s ==> &0 < (v:real^N->real) b` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_LE]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < (u:real^N->real) b /\ &0 < v b` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_LE] THEN + UNDISCH_TAC `!x. x IN s ==> (u:real^N->real) x / v x <= u b / v b` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN + DISCH_TAC THEN UNDISCH_TAC `sum s (u:real^N->real) = &1` THEN + MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x = &1 ==> F`) THEN + ASM_SIMP_TAC[SUM_EQ_0]; + ALL_TAC] THEN + EXISTS_TAC `(\x. if x = a then v b / u b else v x - (v b / u b) * u x): + real^N->real` THEN + ASM_SIMP_TAC[FORALL_IN_INSERT; REAL_LE_DIV; REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_DELETE] THEN + ASM_SIMP_TAC[SUM_DELETE; VSUM_DELETE; IN_DELETE] THEN + ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; FINITE_DELETE] THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {x | x IN s /\ ~(x = a)} = s`; + SET_RULE `~(a IN s) ==> {x | x IN s /\ x = a} = {}`] THEN + REWRITE_TAC[VSUM_CLAUSES; SUM_CLAUSES] THEN + ASM_CASES_TAC `b:real^N = a` THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN + ASM_SIMP_TAC[VECTOR_SUB_RDISTRIB; VSUM_SUB; SUM_SUB] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VECTOR_ADD_LID; REAL_ADD_LID] THEN + ASM_SIMP_TAC[SUM_LMUL; VSUM_LMUL] THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; REAL_ARITH_TAC; VECTOR_ARITH_TAC] THEN + X_GEN_TAC `c:real^N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_CASES_TAC `(u:real^N->real) c = &0` THENL + [ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_LE] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_LE]);; + +let IN_CONVEX_HULL_EXCHANGE_UNIQUE = prove + (`!s t t' a x:real^N. + ~(affine_dependent s) /\ + a IN convex hull s /\ + t SUBSET s /\ t' SUBSET s /\ + x IN convex hull (a INSERT t) /\ + x IN convex hull (a INSERT t') + ==> x IN convex hull (a INSERT (t INTER t'))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE + `a INSERT (s INTER t) = (a INSERT s) INTER (a INSERT t)`] THEN + W(MP_TAC o PART_MATCH (rand o rand) CONVEX_HULL_INTER o rand o snd) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~(affine_dependent(s:real^N->bool))` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] AFFINE_DEPENDENT_MONO); + DISCH_THEN(SUBST1_TAC o SYM)] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC) + MP_TAC) THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN `~((a:real^N) IN t) /\ ~(a IN t')` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `FINITE(t:real^N->bool) /\ FINITE(t':real^N->bool)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN; REAL_LE_ADD; + REAL_ARITH `&0 <= a / &2 <=> &0 <= a`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u':real`; `u:real^N->real`] THEN REPEAT DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`v':real`; `v:real^N->real`] THEN REPEAT DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [AFFINE_DEPENDENT_EXPLICIT]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + DISCH_THEN(MP_TAC o SPEC + `\x:real^N. (if x IN t then u x else &0) - (if x IN t' then v x else &0) + + (u' - v') * b x`) THEN + ASM_SIMP_TAC[SUM_ADD; VSUM_ADD; SUM_LMUL; VSUM_LMUL; VECTOR_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[SUM_SUB; VSUM_SUB; VECTOR_SUB_RDISTRIB] THEN + REWRITE_TAC[MESON[] + `(if p then a else b) % x = (if p then a % x else b % x)`] THEN + ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; VECTOR_MUL_LZERO; SUM_0; VSUM_0] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`] THEN + ASM_SIMP_TAC[SUM_ADD; SUM_LMUL; VSUM_ADD; VSUM_LMUL; VECTOR_ADD_RDISTRIB; + GSYM VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN + REPEAT CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(!x. x IN s ==> (if x IN t then u x else &0) <= + (if x IN t' then v x else &0)) \/ + (!x:real^N. x IN s ==> (if x IN t' then v x else &0) <= + (if x IN t then u x else &0))` + (DISJ_CASES_THEN(LABEL_TAC "*")) THENL + [MP_TAC(REAL_ARITH `&0 <= (u' - v') \/ &0 <= (v' - u')`) THEN + MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= c ==> a - b + c = &0 ==> a <= b`); + MATCH_MP_TAC(REAL_ARITH `&0 <= --c ==> a - b + c = &0 ==> b <= a`)] THEN + ASM_SIMP_TAC[REAL_LE_MUL; GSYM REAL_MUL_LNEG; REAL_NEG_SUB]; + EXISTS_TAC `(\x. if x = a then u' else u x):real^N->real`; + EXISTS_TAC `(\x. if x = a then v' else v x):real^N->real`] THEN + ASM_SIMP_TAC[FORALL_IN_INSERT] THEN + (CONJ_TAC THENL [ASM_MESON_TAC[IN_INTER]; ALL_TAC]) THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_INTER] THEN + ASM_REWRITE_TAC[IN_INTER] THEN + REWRITE_TAC[REAL_ARITH `u' + u = &1 <=> u = &1 - u'`; + VECTOR_ARITH `u' + u:real^N = y <=> u = y - u'`] THEN + (CONJ_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + CONV_TAC SYM_CONV THENL + [MATCH_MP_TAC SUM_EQ_SUPERSET; MATCH_MP_TAC VSUM_EQ_SUPERSET]) THEN + ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET; IN_INTER] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN ASM SET_TAC[]);; + +let CONVEX_HULL_EXCHANGE_UNION = prove + (`!s a:real^N. + a IN convex hull s + ==> convex hull s = + UNIONS {convex hull (a INSERT (s DELETE b)) |b| b IN s}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[IN_CONVEX_HULL_EXCHANGE]; + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_GSPEC; + IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN + ASM_SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET] THEN + MESON_TAC[HULL_INC; SUBSET; IN_DELETE]]);; + +let CONVEX_HULL_EXCHANGE_INTER = prove + (`!s a:real^N t t'. + ~affine_dependent s /\ + a IN convex hull s /\ + t SUBSET s /\ + t' SUBSET s + ==> (convex hull (a INSERT t)) INTER (convex hull (a INSERT t')) = + convex hull (a INSERT (t INTER t'))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_INTER] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC IN_CONVEX_HULL_EXCHANGE_UNIQUE THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Representing affine hull as hyperplane or finite intersection of them. *) +(* ------------------------------------------------------------------------- *) + +let AFF_DIM_EQ_HYPERPLANE = prove + (`!s. aff_dim s = &(dimindex(:N)) - &1 <=> + ?a b. ~(a = vec 0) /\ affine hull s = {x:real^N | a dot x = b}`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[AFF_DIM_EMPTY; INT_ARITH `--a:int = b - a <=> b = &0`] THEN + SIMP_TAC[INT_OF_NUM_EQ; LE_1; DIMINDEX_GE_1; AFFINE_HULL_EMPTY] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(b / (a dot a)) % a:real^N`) THEN + ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:real^N` THEN + GEN_GEOM_ORIGIN_TAC `c:real^N` ["a"] THEN + SIMP_TAC[AFF_DIM_DIM_0; HULL_INC] THEN + SIMP_TAC[INT_OF_NUM_SUB; DIMINDEX_GE_1; INT_OF_NUM_EQ] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; DIM_EQ_HYPERPLANE] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `a:real^N` THEN + REWRITE_TAC[] THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_RADD; REAL_ARITH `a + b:real = c <=> b = c - a`] THEN + EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `(a:real^N) dot c` THEN ASM_REWRITE_TAC[REAL_SUB_REFL]; + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\s. (vec 0:real^N) IN s`) THEN + ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM; DOT_RZERO]]]);; + +let AFF_DIM_HYPERPLANE = prove + (`!a b. ~(a = vec 0) + ==> aff_dim {x:real^N | a dot x = b} = &(dimindex(:N)) - &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AFF_DIM_EQ_HYPERPLANE] THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN + ASM_REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE]);; + +let BOUNDED_HYPERPLANE_EQ_TRIVIAL = prove + (`!a b. bounded {x:real^N | a dot x = b} <=> + if a = vec 0 then ~(b = &0) else dimindex(:N) = 1`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_LZERO] THENL + [ASM_CASES_TAC `b = &0` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; BOUNDED_EMPTY] THEN + REWRITE_TAC[NOT_BOUNDED_UNIV; SET_RULE `{x | T} = UNIV`]; + ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM; AFF_DIM_HYPERPLANE; + AFFINE_HYPERPLANE] THEN + REWRITE_TAC[INT_ARITH `a - &1:int <= &0 <=> a <= &1`; INT_OF_NUM_LE] THEN + MATCH_MP_TAC(ARITH_RULE `1 <= n ==> (n <= 1 <=> n = 1)`) THEN + REWRITE_TAC[DIMINDEX_GE_1]]);; + +let AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES = prove + (`!s:real^N->bool. + ?f. FINITE f /\ + &(CARD f) + aff_dim s = &(dimindex(:N)) /\ + affine hull s = INTERS f /\ + (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x | a dot x = b})`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + MP_TAC(ISPEC `s:real^N->bool` AFFINE_BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL [`b:real^N->bool`; `(:real^N)`] EXTEND_TO_AFFINE_BASIS) THEN + ASM_REWRITE_TAC[SUBSET_UNIV; AFFINE_HULL_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `FINITE(c:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]; ALL_TAC] THEN + REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; CARD_DIFF] THEN + REWRITE_TAC[INT_ARITH `f + b - &1:int = c - &1 <=> f = c - b`] THEN + ASM_SIMP_TAC[INT_OF_NUM_SUB; CARD_SUBSET; GSYM CARD_DIFF; INT_OF_NUM_EQ] THEN + ASM_CASES_TAC `c:real^N->bool = b` THENL + [EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; INTERS_0; + DIFF_EQ_EMPTY] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `{affine hull (c DELETE a) |a| (a:real^N) IN (c DIFF b)}` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DIFF] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_SIMP_TAC[FINITE_DIFF] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~affine_dependent(c:real^N->bool)` THEN + REWRITE_TAC[affine_dependent] THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; + ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + W(MP_TAC o PART_MATCH (rhs o rand) AFFINE_HULL_INTERS o rand o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC AFFINE_INDEPENDENT_SUBSET THEN + EXISTS_TAC `c:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; + IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]; + REWRITE_TAC[GSYM AFF_DIM_EQ_HYPERPLANE] THEN + ASM_SIMP_TAC[IN_DIFF; AFFINE_INDEPENDENT_DELETE; + AFF_DIM_AFFINE_INDEPENDENT; CARD_DELETE] THEN + REWRITE_TAC[GSYM AFF_DIM_UNIV] THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; CARD_DIFF] THEN + REPEAT STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(GSYM INT_OF_NUM_SUB) THEN + MATCH_MP_TAC(ARITH_RULE `~(c = 0) ==> 1 <= c`) THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN ASM SET_TAC[]]);; + +let AFFINE_HYPERPLANE_SUMS_EQ_UNIV = prove + (`!a b s. + affine s /\ + ~(s INTER {v | a dot v = b} = {}) /\ + ~(s DIFF {v | a dot v = b} = {}) + ==> {x + y | x IN s /\ y IN {v | a dot v = b}} = (:real^N)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN X_GEN_TAC `c:real^N` THEN + ONCE_REWRITE_TAC[SET_RULE + `{x + y:real^N | x IN s /\ P y} = + {z | ?x y. x IN s /\ P y /\ z = x + y}`] THEN + GEOM_ORIGIN_TAC `c:real^N` THEN REPEAT GEN_TAC THEN + REWRITE_TAC[DOT_RADD; REAL_ARITH `b dot c + a = d <=> a = d - b dot c`] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM; DOT_RZERO] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE; HULL_INC] THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_ARITH `c + z:real^N = (c + x) + (c + y) <=> + z = c + x + y`] THEN + REWRITE_TAC[SET_RULE + `{z | ?x y. x IN s /\ P y /\ z = c + x + y} = + IMAGE (\x. c + x) {x + y:real^N | x IN s /\ y IN {v | P v}}`] THEN + MATCH_MP_TAC(SET_RULE + `!f. (!x. g(f x) = x) /\ s = UNIV ==> IMAGE g s = UNIV`) THEN + EXISTS_TAC `\x:real^N. x - c` THEN + REWRITE_TAC[VECTOR_ARITH `c + x - c:real^N = x`] THEN + MATCH_MP_TAC(MESON[SPAN_EQ_SELF] `subspace s /\ span s = t ==> s = t`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_HYPERPLANE]; + ALL_TAC] THEN + REWRITE_TAC[GSYM DIM_EQ_FULL] THEN + REWRITE_TAC[GSYM LE_ANTISYM; DIM_SUBSET_UNIV] THEN + MATCH_MP_TAC(ARITH_RULE `m - 1 < n ==> m <= n`) THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `dim {x:real^N | a dot x = &0}` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[DIM_HYPERPLANE; LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC DIM_PSUBSET THEN + ASM_SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL SPAN_EQ_SELF)); + SUBSPACE_SUMS; SUBSPACE_HYPERPLANE] THEN + REWRITE_TAC[PSUBSET; SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN + ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:real^N` THEN SIMP_TAC[IN_DIFF; IN_ELIM_THM] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_REWRITE_TAC[DOT_RZERO; VECTOR_ADD_RID]]);; + +let AFF_DIM_AFFINE_INTER_HYPERPLANE = prove + (`!a b s:real^N->bool. + affine s + ==> aff_dim(s INTER {x | a dot x = b}) = + if s INTER {v | a dot v = b} = {} then -- &1 + else if s SUBSET {v | a dot v = b} then aff_dim s + else aff_dim s - &1`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_REWRITE_TAC[DOT_LZERO] THEN ASM_CASES_TAC `b = &0` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; INTER_EMPTY; AFF_DIM_EMPTY] THEN + SIMP_TAC[SET_RULE `{x | T} = UNIV`; IN_UNIV; INTER_UNIV; SUBSET_UNIV] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY]; + STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN + COND_CASES_TAC THENL [AP_TERM_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `{x:real^N | a dot x = b}`] + AFF_DIM_SUMS_INTER) THEN + ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN + ASM_SIMP_TAC[AFFINE_HYPERPLANE_SUMS_EQ_UNIV; AFF_DIM_UNIV; + SET_RULE `~(s SUBSET t) ==> ~(s DIFF t = {})`] THEN + SPEC_TAC(`aff_dim (s INTER {x:real^N | a dot x = b})`,`i:int`) THEN + INT_ARITH_TAC]);; + +let AFF_DIM_LT_FULL = prove + (`!s. aff_dim s < &(dimindex(:N)) <=> ~(affine hull s = (:real^N))`, + GEN_TAC THEN REWRITE_TAC[GSYM AFF_DIM_EQ_FULL] THEN + MP_TAC(ISPEC `s:real^N->bool` AFF_DIM_LE_UNIV) THEN ARITH_TAC);; + +let AFF_LOWDIM_SUBSET_HYPERPLANE = prove + (`!s:real^N->bool. + aff_dim s < &(dimindex(:N)) + ==> ?a b. ~(a = vec 0) /\ s SUBSET {x | a dot x = b}`, + MATCH_MP_TAC SET_PROVE_CASES THEN CONJ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `basis 1:real^N` THEN + SIMP_TAC[EMPTY_SUBSET; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; + MAP_EVERY X_GEN_TAC [`c:real^N`; `s:real^N->bool`] THEN + CONV_TAC(ONCE_DEPTH_CONV(GEN_ALPHA_CONV `a:real^N`)) THEN + GEN_GEOM_ORIGIN_TAC `c:real^N` ["a"] THEN + SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; IN_INSERT; INT_OF_NUM_LT] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN + STRIP_TAC THEN EXISTS_TAC `(u:real^N) dot c` THEN + ASM_REWRITE_TAC[DOT_RADD; REAL_EQ_ADD_LCANCEL_0] THEN + ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]]);; + +(* ------------------------------------------------------------------------- *) +(* An additional lemma about hyperplanes. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_HYPERPLANES = prove + (`!a b a' b'. + {x | a dot x = b} SUBSET {x | a' dot x = b'} <=> + {x | a dot x = b} = {} \/ {x | a' dot x = b'} = (:real^N) \/ + {x | a dot x = b} = {x | a' dot x = b'}`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `{x:real^N | a dot x = b} = {}` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET] THEN + ASM_CASES_TAC `{x | a' dot x = b'} = (:real^N)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [HYPERPLANE_EQ_EMPTY; HYPERPLANE_EQ_UNIV]) THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + ASM_CASES_TAC `{x:real^N | a dot x = b} SUBSET {x | a' dot x = b'}` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`{x:real^N | a dot x = b}`; `{x:real^N | a' dot x = b'}`] + AFF_DIM_PSUBSET) THEN + ASM_SIMP_TAC[PSUBSET; + REWRITE_RULE[GSYM AFFINE_HULL_EQ] AFFINE_HYPERPLANE] THEN + ASM_CASES_TAC `{x:real^N | a dot x = b} = {x | a' dot x = b'}` THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_CASES_TAC `a':real^N = vec 0` THENL + [ASM_CASES_TAC `b' = &0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_CASES_TAC `b = &0` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_HYPERPLANE; INT_LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Openness and compactness are preserved by convex hull operation. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_CONVEX_HULL = prove + (`!s:real^N->bool. open s ==> open(convex hull s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[CONVEX_HULL_EXPLICIT; OPEN_CONTAINS_CBALL] THEN + REWRITE_TAC[IN_ELIM_THM; SUBSET; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`; `u:real^N->real`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?b. !x:real^N. x IN t ==> &0 < b(x) /\ cball(x,b(x)) SUBSET s` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + ABBREV_TAC `i = IMAGE (b:real^N->real) t` THEN + EXISTS_TAC `inf i` THEN MP_TAC(SPEC `i:real->bool` INF_FINITE) THEN + EXPAND_TAC "i" THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_IMAGE] THEN + ANTS_TAC THENL + [EXPAND_TAC "i" THEN CONJ_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + ASM_MESON_TAC[SUM_CLAUSES; REAL_ARITH `~(&1 = &0)`]; + ALL_TAC] THEN + STRIP_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_CBALL; dist] THEN + DISCH_TAC THEN EXISTS_TAC `IMAGE (\v:real^N. v + (y - a)) t` THEN + EXISTS_TAC `\v. (u:real^N->real)(v - (y - a))` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; SUM_IMAGE; VSUM_IMAGE; + VECTOR_ARITH `v + a:real^N = w + a <=> v = w`] THEN + ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(v + a) - a:real^N = v`] THEN + ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; ETA_AX] THEN + ASM_SIMP_TAC[VSUM_ADD; VSUM_RMUL] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `z + (y - a) IN cball(z:real^N,b z)` + (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN + REWRITE_TAC[IN_CBALL; dist; NORM_ARITH + `norm(z - (z + a - y)) = norm(y - a)`] THEN + ASM_MESON_TAC[REAL_LE_TRANS]);; + +let COMPACT_CONVEX_COMBINATIONS = prove + (`!s t. compact s /\ compact t + ==> compact { (&1 - u) % x + u % y :real^N | + &0 <= u /\ u <= &1 /\ x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{ (&1 - u) % x + u % y :real^N | &0 <= u /\ u <= &1 /\ x IN s /\ y IN t} = + IMAGE (\z. (&1 - drop(fstcart z)) % fstcart(sndcart z) + + drop(fstcart z) % sndcart(sndcart z)) + { pastecart u w | u IN interval[vec 0,vec 1] /\ + w IN { pastecart x y | x IN s /\ y IN t} }` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[COMPACT_PCROSS; GSYM PCROSS; COMPACT_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `z:real^(1,(N,N)finite_sum)finite_sum` THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[PCROSS] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN + CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_SUB) THEN + REWRITE_TAC[CONTINUOUS_CONST] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART; ETA_AX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC LINEAR_COMPOSE THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let COMPACT_CONVEX_HULL = prove + (`!s:real^N->bool. compact s ==> compact(convex hull s)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CARATHEODORY] THEN + SPEC_TAC(`dimindex(:N) + 1`,`n:num`) THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN + CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN + REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{x | F} = {}`; COMPACT_EMPTY]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `w:real^N`) THEN INDUCT_TAC THENL + [SUBGOAL_THEN + `{x:real^N | ?t. FINITE t /\ t SUBSET s /\ CARD t <= 0 /\ + x IN convex hull t} = {}` + (fun th -> REWRITE_TAC[th; COMPACT_EMPTY]) THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; LE; IN_ELIM_THM] THEN + MESON_TAC[CARD_EQ_0; CONVEX_HULL_EMPTY; NOT_IN_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[ARITH_RULE `s <= SUC 0 <=> s = 0 \/ s = 1`] THEN + UNDISCH_TAC `compact(s:real^N->bool)` THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `a /\ b /\ (c \/ d) /\ e <=> + (a /\ c) /\ (b /\ e) \/ (a /\ d) /\ (b /\ e)`] THEN + REWRITE_TAC[GSYM HAS_SIZE; num_CONV `1`; HAS_SIZE_CLAUSES] THEN + REWRITE_TAC[EXISTS_OR_THM; LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + CONV_TAC(TOP_DEPTH_CONV UNWIND_CONV) THEN + REWRITE_TAC[NOT_IN_EMPTY; CONVEX_HULL_EMPTY] THEN + REWRITE_TAC[CONVEX_HULL_SING] THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:real^N | ?t. FINITE t /\ t SUBSET s /\ CARD t <= SUC n /\ + x IN convex hull t} = + { (&1 - u) % x + u % y :real^N | + &0 <= u /\ u <= &1 /\ x IN s /\ + y IN {x | ?t. FINITE t /\ t SUBSET s /\ + CARD t <= n /\ x IN convex hull t}}` + (fun th -> ASM_SIMP_TAC[th; COMPACT_CONVEX_COMBINATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [ALL_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; + LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `c:real`; `v:real^N`; + `t:real^N->bool`] THEN + STRIP_TAC THEN EXISTS_TAC `(u:real^N) INSERT t` THEN + ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET] THEN + ASM_SIMP_TAC[CARD_CLAUSES] THEN CONJ_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC IN_CONVEX_SET THEN + ASM_REWRITE_TAC[CONVEX_CONVEX_HULL] THEN CONJ_TAC THEN + ASM_MESON_TAC[HULL_SUBSET; SUBSET; IN_INSERT; HULL_MONO]] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `CARD(t:real^N->bool) <= n` THENL + [MAP_EVERY EXISTS_TAC [`w:real^N`; `&1`; `x:real^N`] THEN + ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; VECTOR_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(t:real^N->bool) HAS_SIZE (SUC n)` MP_TAC THENL + [ASM_REWRITE_TAC[HAS_SIZE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE_CLAUSES] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `u:real^N->bool` + STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + UNDISCH_TAC `(x:real^N) IN convex hull (a INSERT u)` THEN + RULE_ASSUM_TAC(REWRITE_RULE[FINITE_INSERT]) THEN + ASM_CASES_TAC `(u:real^N->bool) = {}` THENL + [ASM_REWRITE_TAC[CONVEX_HULL_SING; IN_SING] THEN + DISCH_THEN SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `&1`; `a:real^N`] THEN + ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `{a:real^N}` THEN SIMP_TAC[FINITE_RULES] THEN + REWRITE_TAC[CONVEX_HULL_SING; IN_SING] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN + UNDISCH_TAC `~(n = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CONVEX_HULL_INSERT; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `d:real`; `z:real^N`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `d:real`; `z:real^N`] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH + `c + d = &1 ==> c = (&1 - d)`)) THEN + ASM_REWRITE_TAC[REAL_ARITH `d <= &1 <=> &0 <= &1 - d`] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `CARD ((a:real^N) INSERT u) <= SUC n` THEN + ASM_SIMP_TAC[CARD_CLAUSES; LE_SUC]);; + +let FINITE_IMP_COMPACT_CONVEX_HULL = prove + (`!s:real^N->bool. FINITE s ==> compact(convex hull s)`, + SIMP_TAC[FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);; + +let CONVEX_HULL_INTERIOR_SUBSET = prove + (`!s:real^N->bool. convex hull (interior s) SUBSET interior (convex hull s)`, + GEN_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN + SIMP_TAC[OPEN_CONVEX_HULL; OPEN_INTERIOR; HULL_MONO; INTERIOR_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Extremal points of a simplex are some vertices. *) +(* ------------------------------------------------------------------------- *) + +let DIST_INCREASES_ONLINE = prove + (`!a b d. ~(d = vec 0) + ==> dist(a,b + d) > dist(a,b) \/ dist(a,b - d) > dist(a,b)`, + REWRITE_TAC[dist; vector_norm; real_gt; GSYM NORM_POS_LT] THEN + SIMP_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE; SQRT_LT_0] THEN + REWRITE_TAC[DOT_RSUB; DOT_RADD; DOT_LSUB; DOT_LADD] THEN REAL_ARITH_TAC);; + +let NORM_INCREASES_ONLINE = prove + (`!a:real^N d. ~(d = vec 0) + ==> norm(a + d) > norm(a) \/ norm(a - d) > norm(a)`, + MP_TAC(ISPEC `vec 0 :real^N` DIST_INCREASES_ONLINE) THEN + REWRITE_TAC[dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let SIMPLEX_FURTHEST_LT = prove + (`!a:real^N s. + FINITE s + ==> !x. x IN (convex hull s) /\ ~(x IN s) + ==> ?y. y IN (convex hull s) /\ norm(x - a) < norm(y - a)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[CONVEX_HULL_SING; IN_SING] THEN MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONVEX_HULL_INSERT] THEN + STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `v:real`; `b:real^N`] THEN + ASM_CASES_TAC `y:real^N IN (convex hull s)` THENL + [REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`&0`; `&1`; `c:real^N`] THEN + ASM_REWRITE_TAC[REAL_ADD_LID; REAL_POS] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_SIMP_TAC[REAL_ADD_LID; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + ASM_MESON_TAC[VECTOR_MUL_LID]; + ALL_TAC] THEN + ASM_CASES_TAC `v = &0` THENL + [ASM_SIMP_TAC[REAL_ADD_RID; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + ASM_CASES_TAC `u = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN + ASM_CASES_TAC `y = a:real^N` THEN ASM_REWRITE_TAC[IN_INSERT] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_INSERT; DE_MORGAN_THM] THEN STRIP_TAC THEN + MP_TAC(SPECL [`u:real`; `v:real`] REAL_DOWN2) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`a:real^N`; `y:real^N`; `w % (x - b):real^N`] + DIST_INCREASES_ONLINE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `(x - y = vec 0) <=> (x = y)`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `~(y:real^N IN convex hull s)` THEN + ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]; + ALL_TAC] THEN + ASM_REWRITE_TAC[dist; real_gt] THEN + REWRITE_TAC[VECTOR_ARITH + `((u % x + v % b) + w % (x - b) = (u + w) % x + (v - w) % b) /\ + ((u % x + v % b) - w % (x - b) = (u - w) % x + (v + w) % b)`] THEN + STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC + [`(u + w) % x + (v - w) % b:real^N`; `u + w`; `v - w`; `b:real^N`]; + MAP_EVERY EXISTS_TAC + [`(u - w) % x + (v + w) % b:real^N`; `u - w`; `v + w`; `b:real^N`]] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + UNDISCH_TAC `u + v = &1` THEN REAL_ARITH_TAC);; + +let SIMPLEX_FURTHEST_LE = prove + (`!a:real^N s. + FINITE s /\ ~(s = {}) + ==> ?y. y IN s /\ + !x. x IN (convex hull s) ==> norm(x - a) <= norm(y - a)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `convex hull (s:real^N->bool)` DISTANCE_ATTAINS_SUP) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL] THEN + ASM_MESON_TAC[SUBSET_EMPTY; HULL_SUBSET]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN + ASM_MESON_TAC[SIMPLEX_FURTHEST_LT; REAL_NOT_LE]);; + +let SIMPLEX_FURTHEST_LE_EXISTS = prove + (`!a:real^N s. + FINITE s + ==> !x. x IN (convex hull s) + ==> ?y. y IN s /\ norm(x - a) <= norm(y - a)`, + MESON_TAC[NOT_IN_EMPTY; CONVEX_HULL_EMPTY; SIMPLEX_FURTHEST_LE]);; + +let SIMPLEX_EXTREMAL_LE = prove + (`!s:real^N->bool. + FINITE s /\ ~(s = {}) + ==> ?u v. u IN s /\ v IN s /\ + !x y. x IN convex hull s /\ y IN convex hull s + ==> norm(x - y) <= norm(u - v)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `convex hull (s:real^N->bool)` COMPACT_SUP_MAXDISTANCE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMP_COMPACT_CONVEX_HULL] THEN + ASM_MESON_TAC[SUBSET_EMPTY; HULL_SUBSET]; + ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[] THEN ASM_MESON_TAC[SIMPLEX_FURTHEST_LT; REAL_NOT_LE; NORM_SUB]);; + +let SIMPLEX_EXTREMAL_LE_EXISTS = prove + (`!s:real^N->bool x y. FINITE s /\ x IN convex hull s /\ y IN convex hull s + ==> ?u v. u IN s /\ v IN s /\ + norm(x - y) <= norm(u - v)`, + MESON_TAC[NOT_IN_EMPTY; CONVEX_HULL_EMPTY; SIMPLEX_EXTREMAL_LE]);; + +let DIAMETER_CONVEX_HULL = prove + (`!s:real^N->bool. diameter(convex hull s) = diameter s`, + let lemma = prove + (`!a b s. (!x. x IN s ==> dist(a,x) <= b) + ==> (!x. x IN convex hull s ==> dist(a,x) <= b)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HULL_INDUCT THEN ASM_REWRITE_TAC[GSYM cball; CONVEX_CBALL]) in + GEN_TAC THEN REWRITE_TAC[diameter; CONVEX_HULL_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUP_EQ THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `b:real` THEN + EQ_TAC THENL [MESON_TAC[SUBSET; HULL_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `!b. (a ==> b) /\ (b ==> c) ==> a ==> c`) THEN + EXISTS_TAC `!x:real^N y. x IN s /\ y IN convex hull s ==> norm(x - y) <= b` + THEN CONJ_TAC THENL + [MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM dist; lemma]; + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN + ASM_CASES_TAC `(y:real^N) IN convex hull s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); lemma]]);; + +let DIAMETER_SIMPLEX = prove + (`!s:real^N->bool. + ~(s = {}) + ==> diameter(convex hull s) = sup { dist(x,y) | x IN s /\ y IN s}`, + REWRITE_TAC[DIAMETER_CONVEX_HULL] THEN SIMP_TAC[diameter; dist]);; + +(* ------------------------------------------------------------------------- *) +(* Closest point of a convex set is unique, with a continuous projection. *) +(* ------------------------------------------------------------------------- *) + +let CLOSER_POINTS_LEMMA = prove + (`!y:real^N z. + y dot z > &0 + ==> ?u. &0 < u /\ + !v. &0 < v /\ v <= u ==> norm(v % z - y) < norm y`, + REWRITE_TAC[NORM_LT; DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL; + REAL_SUB_LDISTRIB; real_gt] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `(a - b) - (c - d) < d <=> a < b + c`] THEN + STRIP_TAC THEN SUBST1_TAC(VECTOR_ARITH `(z:real^N) dot y = y dot z`) THEN + SIMP_TAC[GSYM REAL_ADD_LDISTRIB; REAL_LT_LMUL_EQ] THEN + EXISTS_TAC `(y dot (z:real^N)) / (z dot z)` THEN + SUBGOAL_THEN `&0 < z dot (z:real^N)` ASSUME_TAC THENL + [ASM_MESON_TAC[DOT_POS_LT; DOT_RZERO; REAL_LT_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LE_RDIV_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < y /\ x <= y ==> x < y + y`; REAL_LT_MUL]);; + +let CLOSER_POINT_LEMMA = prove + (`!x y z. (y - x) dot (z - x) > &0 + ==> ?u. &0 < u /\ u <= &1 /\ dist(x + u % (z - x),y) < dist(x,y)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CLOSER_POINTS_LEMMA) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist; NORM_LT] THEN + REWRITE_TAC[VECTOR_ARITH + `(y - (x + z)) dot (y - (x + z)) = (z - (y - x)) dot (z - (y - x))`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min u (&1)` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LT_01; REAL_LE_REFL]);; + +let ANY_CLOSEST_POINT_DOT = prove + (`!s a x y:real^N. + convex s /\ closed s /\ x IN s /\ y IN s /\ + (!z. z IN s ==> dist(a,x) <= dist(a,z)) + ==> (a - x) dot (y - x) <= &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH `x <= &0 <=> ~(x > &0)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP CLOSER_POINT_LEMMA) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[REAL_NOT_LT] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_ARITH `x + u % (y - x) = (&1 - u) % x + u % y`] THEN + MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]);; + +let ANY_CLOSEST_POINT_UNIQUE = prove + (`!s a x y:real^N. + convex s /\ closed s /\ x IN s /\ y IN s /\ + (!z. z IN s ==> dist(a,x) <= dist(a,z)) /\ + (!z. z IN s ==> dist(a,y) <= dist(a,z)) + ==> x = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM NORM_LE_0; NORM_LE_SQUARE] THEN + SUBGOAL_THEN `(a - x:real^N) dot (y - x) <= &0 /\ (a - y) dot (x - y) <= &0` + MP_TAC THENL [ASM_MESON_TAC[ANY_CLOSEST_POINT_DOT]; ALL_TAC] THEN + REWRITE_TAC[NORM_LT; DOT_LSUB; DOT_RSUB] THEN REAL_ARITH_TAC);; + +let CLOSEST_POINT_UNIQUE = prove + (`!s a x:real^N. + convex s /\ closed s /\ x IN s /\ + (!z. z IN s ==> dist(a,x) <= dist(a,z)) + ==> x = closest_point s a`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `a:real^N`] THEN + ASM_MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; + +let CLOSEST_POINT_DOT = prove + (`!s a x:real^N. + convex s /\ closed s /\ x IN s + ==> (a - closest_point s a) dot (x - closest_point s a) <= &0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_DOT THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; + +let CLOSEST_POINT_LT = prove + (`!s a x. convex s /\ closed s /\ x IN s /\ ~(x = closest_point s a) + ==> dist(a,closest_point s a) < dist(a,x)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[GSYM REAL_NOT_LE; CONTRAPOS_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC CLOSEST_POINT_UNIQUE THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CLOSEST_POINT_LE; REAL_LE_TRANS]);; + +let CLOSEST_POINT_LIPSCHITZ = prove + (`!s x y:real^N. + convex s /\ closed s /\ ~(s = {}) + ==> dist(closest_point s x,closest_point s y) <= dist(x,y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dist; NORM_LE] THEN + SUBGOAL_THEN + `(x - closest_point s x :real^N) dot + (closest_point s y - closest_point s x) <= &0 /\ + (y - closest_point s y) dot + (closest_point s x - closest_point s y) <= &0` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC ANY_CLOSEST_POINT_DOT THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[CLOSEST_POINT_EXISTS]; + MP_TAC(ISPEC `(x - closest_point s x :real^N) - (y - closest_point s y)` + DOT_POS_LE) THEN + REWRITE_TAC[NORM_LT; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC]);; + +let CONTINUOUS_AT_CLOSEST_POINT = prove + (`!s x. convex s /\ closed s /\ ~(s = {}) + ==> (closest_point s) continuous (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at] THEN + ASM_MESON_TAC[CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_CLOSEST_POINT = prove + (`!s t. convex s /\ closed s /\ ~(s = {}) + ==> (closest_point s) continuous_on t`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CLOSEST_POINT]);; + +(* ------------------------------------------------------------------------- *) +(* Relating closest points and orthogonality. *) +(* ------------------------------------------------------------------------- *) + +let ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL = prove + (`!s a b:real^N. + affine s /\ b IN s /\ (!x. x IN s ==> dist(a,b) <= dist(a,x)) + ==> (!x. x IN s ==> orthogonal (x - b) (a - b))`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `b:real^N` THEN + REWRITE_TAC[DIST_0; VECTOR_SUB_RZERO; orthogonal; dist; NORM_LE] THEN + REWRITE_TAC[DOT_LSUB] THEN REWRITE_TAC[DOT_RSUB] THEN + REWRITE_TAC[DOT_SYM; REAL_ARITH `a <= a - y - (y - x) <=> &2 * y <= x`] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_RZERO] THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `vec 0 + --((a dot x) / (x dot x)) % (x - vec 0:real^N)` th) THEN + MP_TAC(SPEC `vec 0 + (a dot x) / (x dot x) % (x - vec 0:real^N)` th)) THEN + ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ADD_LID; DOT_RMUL] THEN + REWRITE_TAC[DOT_LMUL; IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `&2 * x * a <= b * c * z /\ &2 * --x * a <= --b * --c * z + ==> &2 * abs(x * a) <= b * c * z`)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_NOT_LE; REAL_DIV_RMUL; DOT_EQ_0] THEN + MATCH_MP_TAC(REAL_ARITH `~(x = &0) ==> x < &2 * abs x`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM DOT_EQ_0]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let ORTHOGONAL_ANY_CLOSEST_POINT = prove + (`!s a b:real^N. + b IN s /\ (!x. x IN s ==> orthogonal (x - b) (a - b)) + ==> (!x. x IN s ==> dist(a,b) <= dist(a,x))`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `b:real^N` THEN + REWRITE_TAC[dist; NORM_LE; orthogonal; VECTOR_SUB_RZERO] THEN + SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + REWRITE_TAC[DOT_POS_LE; REAL_ARITH `a <= a - &0 - (&0 - x) <=> &0 <= x`]);; + +let CLOSEST_POINT_AFFINE_ORTHOGONAL = prove + (`!s a:real^N x. + affine s /\ ~(s = {}) /\ x IN s + ==> orthogonal (x - closest_point s a) (a - closest_point s a)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSEST_POINT_EXISTS THEN + ASM_SIMP_TAC[CLOSED_AFFINE]);; + +let CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ = prove + (`!s a b:real^N. + affine s /\ b IN s + ==> (closest_point s a = b <=> + !x. x IN s ==> orthogonal (x - b) (a - b))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[CLOSEST_POINT_AFFINE_ORTHOGONAL; MEMBER_NOT_EMPTY]; + DISCH_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CLOSEST_POINT_UNIQUE THEN + ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_IMP_CONVEX] THEN + MATCH_MP_TAC ORTHOGONAL_ANY_CLOSEST_POINT THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Various point-to-set separating/supporting hyperplane theorems. *) +(* ------------------------------------------------------------------------- *) + +let SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP = prove + (`!a c s:real^N->bool. + compact s /\ ~(s = {}) + ==> ?b y. y IN s /\ a dot (y - c) = b /\ + (!x. x IN s ==> a dot (x - c) <= b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. a dot (x - c)`; `s:real^N->bool`] + CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + SUBGOAL_THEN `(\x:real^N. a dot (x - c)) = (\x. a dot x) o (\x. x - c)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_LIFT_DOT; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID]);; + +let SUPPORTING_HYPERPLANE_COMPACT_POINT_INF = prove + (`!a c s:real^N->bool. + compact s /\ ~(s = {}) + ==> ?b y. y IN s /\ a dot (y - c) = b /\ + (!x. x IN s ==> a dot (x - c) >= b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `c:real^N`; `s:real^N->bool`] + SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` + (fun th -> EXISTS_TAC `--b:real` THEN MP_TAC th)) THEN + REWRITE_TAC[DOT_LNEG; REAL_ARITH `x >= -- b <=> --x <= b`] THEN + REWRITE_TAC[REAL_NEG_EQ]);; + +let SUPPORTING_HYPERPLANE_CLOSED_POINT = prove + (`!s z:real^N. convex s /\ closed s /\ ~(s = {}) /\ ~(z IN s) + ==> ?a b y. a dot z < b /\ y IN s /\ (a dot y = b) /\ + (!x. x IN s ==> a dot x >= b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`] DISTANCE_ATTAINS_INF) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `y - z:real^N` THEN EXISTS_TAC `(y - z:real^N) dot y` THEN + EXISTS_TAC `y:real^N` THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ASM_REWRITE_TAC[GSYM DOT_RSUB; DOT_POS_LT; VECTOR_SUB_EQ] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN SUBGOAL_THEN + `!u. &0 <= u /\ u <= &1 ==> dist(z:real^N,y) <= dist(z,(&1 - u) % y + u % x)` + MP_TAC THENL [ASM_MESON_TAC[CONVEX_ALT]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[real_ge; REAL_NOT_LE; NOT_FORALL_THM; NOT_IMP] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `x < y <=> y - x > &0`] THEN + REWRITE_TAC[VECTOR_ARITH + `(a - b) dot x - (a - b) dot y = (b - a) dot (y - x)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP CLOSER_POINT_LEMMA) THEN + REWRITE_TAC[VECTOR_ARITH `y + u % (x - y) = (&1 - u) % y + u % x`] THEN + MESON_TAC[REAL_LT_IMP_LE]);; + +let SEPARATING_HYPERPLANE_CLOSED_POINT_INSET = prove + (`!s z:real^N. convex s /\ closed s /\ ~(s = {}) /\ ~(z IN s) + ==> ?a b. a IN s /\ + (a - z) dot z < b /\ + (!x. x IN s ==> (a - z) dot x > b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `z:real^N`] DISTANCE_ATTAINS_INF) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(y - z:real^N) dot z + norm(y - z) pow 2 / &2` THEN + SUBGOAL_THEN `&0 < norm(y - z:real^N)` ASSUME_TAC THENL + [ASM_MESON_TAC[NORM_POS_LT; VECTOR_SUB_EQ]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_ADDR; REAL_LT_DIV; REAL_POW_LT; + REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[NORM_POW_2; REAL_ARITH `a > b + c <=> c < a - b`] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[VECTOR_ARITH + `((y - z) dot x - (y - z) dot z) * &2 - (y - z) dot (y - z) = + &2 * ((y - z) dot (x - y)) + (y - z) dot (y - z)`] THEN + MATCH_MP_TAC(REAL_ARITH `~(--x > &0) /\ &0 < y ==> &0 < &2 * x + y`) THEN + ASM_SIMP_TAC[GSYM NORM_POW_2; REAL_POW_LT] THEN + REWRITE_TAC[GSYM DOT_LNEG; VECTOR_NEG_SUB] THEN + DISCH_THEN(MP_TAC o MATCH_MP CLOSER_POINT_LEMMA) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[REAL_NOT_LT] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_ARITH `y + u % (x - y) = (&1 - u) % y + u % x`] THEN + ASM_MESON_TAC[CONVEX_ALT; REAL_LT_IMP_LE]);; + +let SEPARATING_HYPERPLANE_CLOSED_0_INSET = prove + (`!s:real^N->bool. + convex s /\ closed s /\ ~(s = {}) /\ ~(vec 0 IN s) + ==> ?a b. a IN s /\ ~(a = vec 0) /\ &0 < b /\ + (!x. x IN s ==> a dot x > b)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SEPARATING_HYPERPLANE_CLOSED_POINT_INSET) THEN + REWRITE_TAC[DOT_RZERO; real_gt] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[VECTOR_SUB_RZERO] THEN ASM_MESON_TAC[]);; + +let SEPARATING_HYPERPLANE_CLOSED_POINT = prove + (`!s z:real^N. convex s /\ closed s /\ ~(z IN s) + ==> ?a b. a dot z < b /\ (!x. x IN s ==> a dot x > b)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`--z:real^N`; `&1`] THEN + SIMP_TAC[DOT_LNEG; REAL_ARITH `&0 <= x ==> --x < &1`; DOT_POS_LE] THEN + ASM_MESON_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + ASM_MESON_TAC[SEPARATING_HYPERPLANE_CLOSED_POINT_INSET]);; + +let SEPARATING_HYPERPLANE_CLOSED_0 = prove + (`!s:real^N->bool. + convex s /\ closed s /\ ~(vec 0 IN s) + ==> ?a b. ~(a = vec 0) /\ &0 < b /\ (!x. x IN s ==> a dot x > b)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `basis 1:real^N` THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01; GSYM NORM_POS_LT] THEN + ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_LT_01]; + FIRST_X_ASSUM(MP_TAC o MATCH_MP SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + REWRITE_TAC[DOT_RZERO; real_gt] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; DOT_LZERO; REAL_LT_ANTISYM]]);; + +(* ------------------------------------------------------------------------- *) +(* Now set-to-set for closed/compact sets. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATING_HYPERPLANE_CLOSED_COMPACT = prove + (`!s t. convex s /\ closed s /\ + convex t /\ compact t /\ ~(t = {}) /\ DISJOINT s t + ==> ?a:real^N b. (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?z:real^N. norm(z) = b + &1` CHOOSE_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE; REAL_ARITH `&0 < b ==> &0 <= b + &1`]; + ALL_TAC] THEN + MP_TAC(SPECL [`t:real^N->bool`; `z:real^N`] + SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN + ASM_MESON_TAC[REAL_ARITH `~(b + &1 <= b)`]; + ALL_TAC] THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0 :real^N`] + SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; CONVEX_DIFFERENCES] THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[DISJOINT; NOT_IN_EMPTY; IN_INTER; EXTENSION]; + ALL_TAC] THEN + SIMP_TAC[DOT_RZERO; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; DOT_RSUB] THEN + REWRITE_TAC[real_gt; REAL_LT_SUB_LADD] THEN DISCH_TAC THEN + EXISTS_TAC `--a:real^N` THEN + MP_TAC(SPEC `IMAGE (\x:real^N. a dot x) t` SUP) THEN + ABBREV_TAC `k = sup (IMAGE (\x:real^N. a dot x) t)` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `b + x < y ==> x <= y - b`; MEMBER_NOT_EMPTY]; + ALL_TAC] THEN + STRIP_TAC THEN EXISTS_TAC `--(k + b / &2)` THEN + REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + REAL_ARITH `&0 < b /\ x <= k ==> x < k + b`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k - b / &2`) THEN + ASM_SIMP_TAC[REAL_ARITH `k <= k - b2 <=> ~(&0 < b2)`; REAL_LT_DIV; + REAL_OF_NUM_LT; ARITH; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN + X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REAL_ARITH + `!b. (b2 + b2 = b) /\ b + ay < ax ==> ~(ay <= k - b2) ==> k + b2 < ax`) THEN + ASM_MESON_TAC[REAL_HALF]);; + +let SEPARATING_HYPERPLANE_COMPACT_CLOSED = prove + (`!s t. convex s /\ compact s /\ ~(s = {}) /\ + convex t /\ closed t /\ DISJOINT s t + ==> ?a:real^N b. (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`] + SEPARATING_HYPERPLANE_CLOSED_COMPACT) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DISJOINT_SYM]; ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real` + STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`--a:real^N`; `--b:real`] THEN + ASM_REWRITE_TAC[REAL_LT_NEG2; DOT_LNEG]);; + +let SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO = prove + (`!s t:real^N->bool. + convex s /\ compact s /\ ~(s = {}) /\ + convex t /\ closed t /\ DISJOINT s t + ==> ?a b. ~(a = vec 0) /\ + (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN + EXISTS_TAC `basis 1:real^N` THEN + SUBGOAL_THEN + `bounded(IMAGE (\x:real^N. lift(basis 1 dot x)) s)` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DOT]; + REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE; NORM_LIFT] THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN + MESON_TAC[REAL_ARITH `abs x < b ==> x < b`]]; + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + SEPARATING_HYPERPLANE_COMPACT_CLOSED) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DOT_LZERO; real_gt] THEN + ASM_MESON_TAC[REAL_LT_ANTISYM; MEMBER_NOT_EMPTY]]);; + +let SEPARATING_HYPERPLANE_COMPACT_COMPACT = prove + (`!s t:real^N->bool. + convex s /\ compact s /\ convex t /\ compact t /\ DISJOINT s t + ==> ?a b. ~(a = vec 0) /\ + (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN + EXISTS_TAC `--basis 1:real^N` THEN + SUBGOAL_THEN + `bounded(IMAGE (\x:real^N. lift(basis 1 dot x)) t)` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DOT]; + REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE; NORM_LIFT] THEN + SIMP_TAC[VECTOR_NEG_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--b:real` THEN REWRITE_TAC[DOT_LNEG] THEN + REWRITE_TAC[REAL_ARITH `--x > --y <=> x < y`] THEN + ASM_MESON_TAC[REAL_ARITH `abs x < b ==> x < b`]]; + STRIP_TAC THEN + MATCH_MP_TAC SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* General case without assuming closure and getting non-strict separation. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATING_HYPERPLANE_SET_0_INSPAN = prove + (`!s:real^N->bool. + convex s /\ ~(s = {}) /\ ~(vec 0 IN s) + ==> ?a b. a IN span s /\ ~(a = vec 0) /\ + !x. x IN s ==> &0 <= a dot x`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `k = \c:real^N. {x | &0 <= c dot x}` THEN + SUBGOAL_THEN + `~((span s INTER frontier(cball(vec 0:real^N,&1))) INTER + (INTERS (IMAGE k (s:real^N->bool))) = {})` + MP_TAC THENL + [ALL_TAC; + SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_INTERS; NOT_FORALL_THM; + FORALL_IN_IMAGE; FRONTIER_CBALL; REAL_LT_01] THEN + EXPAND_TAC "k" THEN REWRITE_TAC[IN_SPHERE_0; IN_ELIM_THM; NORM_NEG] THEN + MESON_TAC[NORM_EQ_0; REAL_ARITH `~(&1 = &0)`; DOT_SYM]] THEN + MATCH_MP_TAC COMPACT_IMP_FIP THEN + SIMP_TAC[COMPACT_CBALL; COMPACT_FRONTIER; FORALL_IN_IMAGE; + CLOSED_INTER_COMPACT; CLOSED_SPAN] THEN + CONJ_TAC THENL + [EXPAND_TAC "k" THEN REWRITE_TAC[GSYM real_ge; CLOSED_HALFSPACE_GE]; + ALL_TAC] THEN + REWRITE_TAC[FINITE_SUBSET_IMAGE] THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` MP_TAC) THEN + ASM_CASES_TAC `c:real^N->bool = {}` THENL + [ASM_SIMP_TAC[INTERS_0; INTER_UNIV; IMAGE_CLAUSES] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + SUBGOAL_THEN `~(a:real^N = vec 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `inv(norm a) % a:real^N` THEN + ASM_SIMP_TAC[IN_INTER; FRONTIER_CBALL; SPAN_CLAUSES; IN_SPHERE_0] THEN + REWRITE_TAC[DIST_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; + ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `convex hull (c:real^N->bool)` + SEPARATING_HYPERPLANE_CLOSED_0_INSET) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN + ASM_MESON_TAC[CONVEX_CONVEX_HULL; SUBSET; SUBSET_HULL; HULL_SUBSET; + FINITE_IMP_COMPACT_CONVEX_HULL; COMPACT_IMP_CLOSED]; + ALL_TAC] THEN + REWRITE_TAC[DOT_RZERO; real_gt] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real` + STRIP_ASSUME_TAC)) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_INTERS; FORALL_IN_IMAGE] THEN + EXPAND_TAC "k" THEN SIMP_TAC[IN_ELIM_THM; FRONTIER_CBALL; REAL_LT_01] THEN + REWRITE_TAC[dist; VECTOR_SUB_LZERO; NORM_NEG] THEN + EXISTS_TAC `inv(norm(a)) % a:real^N` THEN REWRITE_TAC[DOT_RMUL] THEN + SUBGOAL_THEN `(a:real^N) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; HULL_MINIMAL]; ASM_SIMP_TAC[SPAN_CLAUSES]] THEN + REWRITE_TAC[IN_SPHERE_0; VECTOR_SUB_LZERO; NORM_NEG; NORM_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_EQ_LDIV_EQ; NORM_POS_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS; HULL_SUBSET; SUBSET; DOT_SYM]);; + +let SEPARATING_HYPERPLANE_SET_POINT_INAFF = prove + (`!s z:real^N. + convex s /\ ~(s = {}) /\ ~(z IN s) + ==> ?a b. (z + a) IN affine hull (z INSERT s) /\ ~(a = vec 0) /\ + a dot z <= b /\ (!x. x IN s ==> a dot x >= b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. --z + x) s` + SEPARATING_HYPERPLANE_SET_0_INSPAN) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; CONVEX_TRANSLATION; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --z + x <=> x = z`] THEN + ASM_SIMP_TAC[UNWIND_THM2; AFFINE_HULL_INSERT_SPAN; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE; VECTOR_ARITH `--x + y:real^N = y - x`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `(a:real^N) dot z` THEN REWRITE_TAC[REAL_LE_REFL] THEN + ASM_REWRITE_TAC[REAL_ARITH `x >= y <=> &0 <= x - y`; GSYM DOT_RSUB]);; + +let SEPARATING_HYPERPLANE_SET_0 = prove + (`!s:real^N->bool. + convex s /\ ~(vec 0 IN s) + ==> ?a b. ~(a = vec 0) /\ !x. x IN s ==> &0 <= a dot x`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + MESON_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; + ASM_MESON_TAC[SEPARATING_HYPERPLANE_SET_0_INSPAN]]);; + +let SEPARATING_HYPERPLANE_SETS = prove + (`!s t. convex s /\ convex t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t + ==> ?a:real^N b. ~(a = vec 0) /\ + (!x. x IN s ==> a dot x <= b) /\ + (!x. x IN t ==> a dot x >= b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{y - x:real^N | y IN t /\ x IN s}` + SEPARATING_HYPERPLANE_SET_0) THEN + ASM_SIMP_TAC[CONVEX_DIFFERENCES] THEN ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[DISJOINT; NOT_IN_EMPTY; IN_INTER; EXTENSION]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; DOT_RSUB; REAL_SUB_LE] THEN + DISCH_TAC THEN + MP_TAC(SPEC `IMAGE (\x:real^N. a dot x) s` SUP) THEN + ABBREV_TAC `k = sup (IMAGE (\x:real^N. a dot x) s)` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; real_ge] THEN ANTS_TAC THENL + [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More convexity generalities. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_CLOSURE = prove + (`!s:real^N->bool. convex s ==> convex(closure s)`, + REWRITE_TAC[convex; CLOSURE_SEQUENTIAL] THEN + GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num->real^N`) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:num->real^N`) MP_TAC) THEN + STRIP_TAC THEN EXISTS_TAC `\n:num. u % a(n) + v % b(n) :real^N` THEN + ASM_SIMP_TAC[LIM_ADD; LIM_CMUL]);; + +let CONVEX_INTERIOR = prove + (`!s:real^N->bool. convex s ==> convex(interior s)`, + REWRITE_TAC[CONVEX_ALT; IN_INTERIOR; SUBSET; IN_BALL; dist] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `e:real`) STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN + SUBST1_TAC(VECTOR_ARITH `z:real^N = + (&1 - u) % (z - u % (y - x)) + u % (z + (&1 - u) % (y - x))`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[VECTOR_ARITH `x - (z - u % (y - x)) = + ((&1 - u) % x + u % y) - z:real^N`; + VECTOR_ARITH `y - (z + (&1 - u) % (y - x)) = + ((&1 - u) % x + u % y) - z:real^N`]);; + +let CONVEX_ON_SETDIST = prove + (`!s t:real^N->bool. convex t ==> (\x. setdist ({x},t)) convex_on s`, + SUBGOAL_THEN + `!s t:real^N->bool. convex t /\ closed t + ==> (\x. setdist ({x},t)) convex_on s` + MP_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPECL [`s:real^N->bool`; `closure t:real^N->bool`]) THEN + ASM_SIMP_TAC[CLOSED_CLOSURE; SETDIST_CLOSURE; CONVEX_CLOSURE]] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[convex_on] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[SETDIST_EMPTY; REAL_MUL_RZERO; REAL_ADD_RID; REAL_LE_REFL] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN + MP_TAC(ISPECL [`{y:real^N}`; `t:real^N->bool`] SETDIST_COMPACT_CLOSED) THEN + ASM_REWRITE_TAC[NOT_INSERT_EMPTY; COMPACT_SING; UNWIND_THM2; SETDIST_CLOSURE; + CLOSURE_EQ_EMPTY; RIGHT_EXISTS_AND_THM; IN_SING] THEN + DISCH_THEN(X_CHOOSE_THEN `y':real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + DISCH_THEN(X_CHOOSE_THEN `x':real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `dist(u % x + v % y:real^N,u % x' + v % y')` THEN CONJ_TAC THENL + [MATCH_MP_TAC SETDIST_LE_DIST THEN REWRITE_TAC[IN_SING] THEN + ASM_MESON_TAC[convex]; + REWRITE_TAC[dist] THEN MATCH_MP_TAC(NORM_ARITH + `norm(a - a':real^N) + norm(b - b') <= r + ==> norm((a + b) - (a' + b')) <= r`) THEN + ASM_REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL; dist] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Moving and scaling convex hulls. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_TRANSLATION = prove + (`!a:real^N s. + convex hull (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (convex hull s)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HULL_IMAGE THEN + REWRITE_TAC[CONVEX_TRANSLATION_EQ; CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN + VECTOR_ARITH_TAC);; + +add_translation_invariants [CONVEX_HULL_TRANSLATION];; + +let CONVEX_HULL_SCALING = prove + (`!s:real^N->bool c. + convex hull (IMAGE (\x. c % x) s) = IMAGE (\x. c % x) (convex hull s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL + [ASM_SIMP_TAC[IMAGE_CONST; VECTOR_MUL_LZERO; CONVEX_HULL_EQ_EMPTY] THEN + COND_CASES_TAC THEN REWRITE_TAC[CONVEX_HULL_EMPTY; CONVEX_HULL_SING]; + ALL_TAC] THEN + MATCH_MP_TAC HULL_IMAGE THEN + ASM_SIMP_TAC[CONVEX_SCALING_EQ; CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[VECTOR_ARITH `c % x = c % y <=> c % (x - y) = vec 0`] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + X_GEN_TAC `x:real^N` THEN EXISTS_TAC `inv c % x:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]);; + +let CONVEX_HULL_AFFINITY = prove + (`!s a:real^N c. + convex hull (IMAGE (\x. a + c % x) s) = + IMAGE (\x. a + c % x) (convex hull s)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; CONVEX_HULL_TRANSLATION; CONVEX_HULL_SCALING]);; + +(* ------------------------------------------------------------------------- *) +(* Convex set as intersection of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HALFSPACE_INTERSECTION = prove + (`!s. closed(s:real^N->bool) /\ convex s + ==> s = INTERS {h | s SUBSET h /\ ?a b. h = {x | a dot x <= b}}`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[MESON[] `(!t. (P t /\ ?a b. t = x a b) ==> Q t) <=> + (!a b. P(x a b) ==> Q(x a b))`] THEN + EQ_TAC THENL [SET_TAC[]; ALL_TAC] THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] + SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`--a:real^N`; `--b:real`]) THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; DOT_LNEG; NOT_IMP] THEN + ASM_SIMP_TAC[REAL_LE_NEG2; REAL_LT_NEG2; REAL_NOT_LE; + REAL_ARITH `a > b ==> b <= a`]);; + +(* ------------------------------------------------------------------------- *) +(* Radon's theorem (from Lars Schewe). *) +(* ------------------------------------------------------------------------- *) + +let RADON_EX_LEMMA = prove + (`!(c:real^N->bool). + FINITE c /\ affine_dependent c + ==> (?u. sum c u = &0 /\ (?v. v IN c /\ ~(u v = &0)) /\ + vsum c (\v. u v % v) = (vec 0):real^N)`, + REWRITE_TAC[AFFINE_DEPENDENT_EXPLICIT] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `\v:real^N. if v IN s then u v else &0` THEN + ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[COND_RAND;COND_RATOR; + VECTOR_MUL_LZERO;GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE `s SUBSET c ==> {x | x IN c /\ x IN s} = s`] THEN + EXISTS_TAC `v:real^N` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let RADON_S_LEMMA = prove + (`!(s:A->bool) f. + FINITE s /\ sum s f = &0 + ==> sum {x | x IN s /\ &0 < f x} f = + -- sum {x | x IN s /\ f x < &0} f`, + REWRITE_TAC[REAL_ARITH `a = --b <=> a + b = &0`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[FINITE_RESTRICT;GSYM SUM_UNION; + REWRITE_RULE [REAL_ARITH `&0 < f x ==> ~(f x < &0)`] + (SET_RULE `(!x:A. &0 < f x ==> ~(f x < &0)) + ==> DISJOINT {x | x IN s /\ &0 < f x} + {x | x IN s /\ f x < &0}`)] THEN + MATCH_MP_TAC (REAL_ARITH `!a b.a = &0 /\ a + b = &0 ==> b = &0`) THEN + EXISTS_TAC `sum {x:A | x IN s /\ f x = &0} f` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SUM_RESTRICT_SET] THEN REWRITE_TAC[COND_ID;SUM_0]; + ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT {x:A | x IN s /\ f x = &0} + ({x | x IN s /\ &0 < f x} UNION + {x | x IN s /\ f x < &0})` ASSUME_TAC THENL + [REWRITE_TAC[DISJOINT;UNION;INTER;IN_ELIM_THM;EXTENSION;NOT_IN_EMPTY] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_UNION;FINITE_RESTRICT;GSYM SUM_UNION] THEN + FIRST_X_ASSUM (SUBST1_TAC o GSYM) THEN + MATCH_MP_TAC (MESON[] `a = b ==> sum a f = sum b f`) THEN + REWRITE_TAC[EXTENSION;IN_ELIM_THM;UNION] THEN + MESON_TAC[REAL_LT_TOTAL]);; + +let RADON_V_LEMMA = prove + (`!(s:A->bool) f g. + FINITE s /\ vsum s f = vec 0 /\ (!x. g x = &0 ==> f x = vec 0) + ==> (vsum {x | x IN s /\ &0 < g x} f) :real^N = + -- vsum {x | x IN s /\ g x < &0} f`, + REWRITE_TAC[VECTOR_ARITH `a:real^N = --b <=> a + b = vec 0`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[FINITE_RESTRICT;GSYM VSUM_UNION; + REWRITE_RULE [REAL_ARITH `&0 < f x ==> ~(f x < &0)`] + (SET_RULE `(!x:A. &0 < f x ==> ~(f x < &0)) + ==> DISJOINT {x | x IN s /\ &0 < f x} + {x | x IN s /\ f x < &0}`)] THEN + MATCH_MP_TAC (VECTOR_ARITH + `!a b. (a:real^N) = vec 0 /\ a + b = vec 0 ==> b = vec 0`) THEN + EXISTS_TAC `(vsum {x:A | x IN s /\ g x = &0} f):real^N` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[VSUM_RESTRICT_SET;COND_ID;VSUM_0];ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT {x:A | x IN s /\ g x = &0} + ({x | x IN s /\ &0 < g x} UNION + {x | x IN s /\ g x < &0})` ASSUME_TAC THENL + [REWRITE_TAC[DISJOINT;UNION;INTER;IN_ELIM_THM;EXTENSION;NOT_IN_EMPTY] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_UNION;FINITE_RESTRICT;GSYM VSUM_UNION] THEN + FIRST_X_ASSUM (SUBST1_TAC o GSYM) THEN + MATCH_MP_TAC (MESON[] `a = b ==> vsum a f = vsum b f`) THEN + REWRITE_TAC[EXTENSION;IN_ELIM_THM;UNION] THEN + MESON_TAC[REAL_LT_TOTAL]);; + +let RADON_PARTITION = prove + (`!(c:real^N->bool). + FINITE c /\ affine_dependent c + ==> ?(m:real^N->bool) (p:real^N->bool). + (DISJOINT m p) /\ + (m UNION p = c) /\ + ~(DISJOINT (convex hull m) (convex hull p))`, + REPEAT STRIP_TAC THEN + MP_TAC (ISPEC `c:real^N->bool` RADON_EX_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`{v:real^N | v IN c /\ u v <= &0}`; + `{v:real^N | v IN c /\ u v > &0}`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[DISJOINT;INTER; + IN_ELIM_THM;REAL_ARITH `x <= &0 <=> ~(x > &0)`] THEN + SET_TAC[]; + REWRITE_TAC[UNION;IN_ELIM_THM;REAL_ARITH `x <= &0 <=> ~(x > &0)`] THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(sum {x:real^N | x IN c /\ u x > &0} u = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC (REAL_ARITH `a > &0 ==> ~(a = &0)`) THEN + REWRITE_TAC[REAL_ARITH `a > &0 <=> &0 < a`] THEN + MATCH_MP_TAC (REWRITE_RULE[SUM_0] (ISPEC `\x. &0` SUM_LT_ALL)) THEN + ASM_SIMP_TAC[FINITE_RESTRICT;IN_ELIM_THM;EXTENSION;NOT_IN_EMPTY] THEN + REWRITE_TAC[MESON[]`~(!x. ~(P x /\ Q x)) = ?x. P x /\ Q x`] THEN + ASM_CASES_TAC `&0 < u (v:real^N)` THENL + [ASM SET_TAC[];ALL_TAC] THEN + POP_ASSUM MP_TAC THEN POP_ASSUM (K ALL_TAC) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IMP_IMP;REAL_ARITH `~(a = &0) /\ ~(&0 < a) <=> a < &0`] THEN + DISCH_TAC THEN + REWRITE_TAC[MESON[REAL_NOT_LT] + `(?x:real^N. P x /\ &0 < u x) <=> (!x. P x ==> u x <= &0) ==> F`] THEN + DISCH_TAC THEN + MP_TAC (ISPECL [`u:real^N->real`;`\x:real^N. &0`;`c:real^N->bool`] + SUM_LT) THEN + ASM_REWRITE_TAC[SUM_0;REAL_ARITH `~(&0 < &0)`] THEN + ASM_MESON_TAC[];ALL_TAC] THEN + REWRITE_TAC[SET_RULE `~DISJOINT a b <=> ?y. y IN a /\ y IN b`] THEN + EXISTS_TAC `&1 / (sum {x:real^N | x IN c /\ u x > &0} u) % + vsum {x:real^N | x IN c /\ u x > &0} (\x. u x % x)` THEN + REWRITE_TAC[CONVEX_HULL_EXPLICIT;IN_ELIM_THM] THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`{v:real^N | v IN c /\ u v < &0}`; + `\y:real^N. + &1 / (sum {x:real^N | x IN c /\ u x > &0} u) * + (--(u y))`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT;SUBSET;IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [ALL_TAC; + ASM_REWRITE_TAC[REAL_NEG_GE0;REAL_LE_LT]] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + REWRITE_TAC[REAL_LE_01] THEN + MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[FINITE_RESTRICT;IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[FINITE_RESTRICT;SUM_LMUL] THEN + MATCH_MP_TAC (REAL_FIELD `!a. ~(a = &0) /\ a * b = a * c ==> b = c`) THEN + EXISTS_TAC `sum {x:real^N | x IN c /\ u x > &0} u` THEN + REWRITE_TAC[SUM_LMUL] THEN + ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> a * &1 / a * b = b`] THEN + REWRITE_TAC[SUM_NEG;REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `a > &0 <=> &0 < a`] THEN + MATCH_MP_TAC (GSYM RADON_S_LEMMA) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC;VSUM_LMUL;VECTOR_MUL_LCANCEL] THEN + REWRITE_TAC[VECTOR_MUL_LNEG;VSUM_NEG] THEN + DISJ2_TAC THEN + MATCH_MP_TAC (REWRITE_RULE[REAL_ARITH `&0 < a <=> a > &0`] + (GSYM RADON_V_LEMMA)) THEN + ASM_REWRITE_TAC[] THEN + MESON_TAC[VECTOR_MUL_LZERO];ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`{v:real^N | v IN c /\ u v > &0}`; + `\y:real^N. + &1 / (sum {x:real^N | x IN c /\ u x > &0} u) * + (u y)`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT;SUBSET;IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [ALL_TAC; + ASM_SIMP_TAC[REAL_ARITH `a > &0 ==> &0 <= a`]] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + REWRITE_TAC[REAL_LE_01] THEN + MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[FINITE_RESTRICT;IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[FINITE_RESTRICT;SUM_LMUL] THEN + MATCH_MP_TAC (REAL_FIELD `!a. ~(a = &0) /\ a * b = a * c ==> b = c`) THEN + EXISTS_TAC `sum {x:real^N | x IN c /\ u x > &0} u` THEN + REWRITE_TAC[SUM_LMUL] THEN + ASM_SIMP_TAC[REAL_FIELD `~(a = &0) ==> a * &1 / a * b = b`] THEN + REWRITE_TAC[SUM_NEG;REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `a > &0 <=> &0 < a`] THEN + MATCH_MP_TAC (GSYM RADON_S_LEMMA) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC;VSUM_LMUL;VECTOR_MUL_LCANCEL] THEN + REWRITE_TAC[VECTOR_MUL_LNEG;VSUM_NEG] THEN + DISJ2_TAC THEN + MATCH_MP_TAC (REWRITE_RULE[REAL_ARITH `&0 < a <=> a > &0`] + (GSYM RADON_V_LEMMA)) THEN + ASM_REWRITE_TAC[] THEN + MESON_TAC[VECTOR_MUL_LZERO]);; + +let RADON = prove + (`!(c:real^N->bool). + affine_dependent c + ==> ?(m:real^N->bool) (p:real^N->bool). + m SUBSET c /\ + p SUBSET c /\ + DISJOINT m p /\ + ~(DISJOINT (convex hull m) (convex hull p))`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPEC `c:real^N->bool` AFFINE_DEPENDENT_EXPLICIT) THEN + ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN MP_TAC + (ISPEC `s:real^N->bool` RADON_PARTITION) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT] THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`;`u:real^N->real`] THEN + ASM SET_TAC[];ALL_TAC] THEN + DISCH_THEN STRIP_ASSUME_TAC THEN + MAP_EVERY EXISTS_TAC [`m:real^N->bool`;`p:real^N->bool`] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Helly's theorem. *) +(* ------------------------------------------------------------------------- *) + +let HELLY_INDUCT = prove + (`!n f. f HAS_SIZE n /\ n >= dimindex(:N) + 1 /\ + (!s:real^N->bool. s IN f ==> convex s) /\ + (!t. t SUBSET f /\ CARD(t) = dimindex(:N) + 1 + ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(0 >= n + 1)`] THEN GEN_TAC THEN + POP_ASSUM(LABEL_TAC "*") THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_SIZE_SUC]) THEN + STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `SUC n >= m + 1 ==> m = n \/ n >= m + 1`)) + THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[CARD_CLAUSES; SUBSET_REFL] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?X. !s:real^N->bool. s IN f ==> X(s) IN INTERS (f DELETE s)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM; MEMBER_NOT_EMPTY; RIGHT_EXISTS_IMP_THM] THEN + GEN_TAC THEN STRIP_TAC THEN REMOVE_THEN "*" MATCH_MP_TAC THEN + ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC + `?s t:real^N->bool. s IN f /\ t IN f /\ ~(s = t) /\ X s:real^N = X t` + THENL + [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `(X:(real^N->bool)->real^N) t` THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC ONCE_DEPTH_CONV + [MATCH_MP + (SET_RULE`~(s = t) + ==> INTERS f = INTERS(f DELETE s) INTER INTERS(f DELETE t)`) + th]) THEN + REWRITE_TAC[IN_INTER] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE (X:(real^N->bool)->real^N) f` RADON_PARTITION) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE] THEN + MATCH_MP_TAC AFFINE_DEPENDENT_BIGGERSET THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + MATCH_MP_TAC(ARITH_RULE + `!f n. n >= d + 1 /\ f = SUC n /\ c = f ==> c >= d + 2`) THEN + MAP_EVERY EXISTS_TAC [`CARD(f:(real^N->bool)->bool)`; `n:num`] THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE + `P /\ m UNION p = s /\ Q <=> + m SUBSET s /\ p SUBSET s /\ m UNION p = s /\ P /\ Q`] THEN + REWRITE_TAC[SUBSET_IMAGE; DISJOINT] THEN + REWRITE_TAC[MESON[] + `(?m p. (?u. P u /\ m = t u) /\ (?u. P u /\ p = t u) /\ Q m p) ==> r <=> + (!u v. P u /\ P v /\ Q (t u) (t v) ==> r)`] THEN + MAP_EVERY X_GEN_TAC [`g:(real^N->bool)->bool`; `h:(real^N->bool)->bool`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN `(f:(real^N->bool)->bool) = h UNION g` SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[UNION_SUBSET] THEN + REWRITE_TAC[SUBSET; IN_UNION] THEN X_GEN_TAC `s:real^N->bool` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o ISPEC `X:(real^N->bool)->real^N` o + MATCH_MP FUN_IN_IMAGE) THEN + FIRST_X_ASSUM(fun th -> + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN + ONCE_REWRITE_TAC[DISJ_SYM] THEN REWRITE_TAC[IN_UNION; IN_IMAGE] THEN + MATCH_MP_TAC MONO_OR THEN ASM_MESON_TAC[SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `g SUBSET INTERS g' /\ h SUBSET INTERS h' + ==> ~(g INTER h = {}) ==> ~(INTERS(g' UNION h') = {})`) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE + `IMAGE X s INTER IMAGE X t = {} ==> s INTER t = {}`)) THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN + (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET; CONVEX_INTERS]]) THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; + +let HELLY = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ CARD(f) >= dimindex(:N) + 1 /\ + (!s. s IN f ==> convex s) /\ + (!t. t SUBSET f /\ CARD(t) = dimindex(:N) + 1 ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC HELLY_INDUCT THEN + ASM_REWRITE_TAC[HAS_SIZE] THEN ASM_MESON_TAC[]);; + +let HELLY_ALT = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ + (!s. s IN f ==> convex s) /\ + (!t. t SUBSET f /\ CARD(t) <= dimindex(:N) + 1 ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `CARD(f:(real^N->bool)->bool) < dimindex(:N) + 1` THEN + ASM_SIMP_TAC[SUBSET_REFL; LT_IMP_LE] THEN MATCH_MP_TAC HELLY THEN + ASM_SIMP_TAC[GE; GSYM NOT_LT] THEN ASM_MESON_TAC[LE_REFL]);; + +let HELLY_CLOSED_ALT = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> convex s /\ closed s) /\ (?s. s IN f /\ bounded s) /\ + (!t. t SUBSET f /\ FINITE t /\ CARD(t) <= dimindex(:N) + 1 + ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC CLOSED_FIP THEN ASM_SIMP_TAC[] THEN + X_GEN_TAC `g:(real^N->bool)->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC HELLY_ALT THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM SET_TAC[]; + ASM_MESON_TAC[SUBSET_TRANS; FINITE_SUBSET]]);; + +let HELLY_COMPACT_ALT = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> convex s /\ compact s) /\ + (!t. t SUBSET f /\ FINITE t /\ CARD(t) <= dimindex(:N) + 1 + ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; UNIV_NOT_EMPTY] THEN + MATCH_MP_TAC HELLY_CLOSED_ALT THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPACT_IMP_BOUNDED]);; + +let HELLY_CLOSED = prove + (`!f:(real^N->bool)->bool. + (FINITE f ==> CARD f >= dimindex (:N) + 1) /\ + (!s. s IN f ==> convex s /\ closed s) /\ (?s. s IN f /\ bounded s) /\ + (!t. t SUBSET f /\ FINITE t /\ CARD(t) = dimindex(:N) + 1 + ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN REWRITE_TAC[GE] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC HELLY_CLOSED_ALT THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `g:(real^N->bool)->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`dimindex(:N) + 1`; `g:(real^N->bool)->bool`; + `f:(real^N->bool)->bool`] CHOOSE_SUBSET_BETWEEN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN + EXISTS_TAC `INTERS h: real^N->bool` THEN + CONJ_TAC THENL [ASM SET_TAC[]; FIRST_X_ASSUM MATCH_MP_TAC] THEN + ASM_MESON_TAC[HAS_SIZE]);; + +let HELLY_COMPACT = prove + (`!f:(real^N->bool)->bool. + (FINITE f ==> CARD f >= dimindex (:N) + 1) /\ + (!s. s IN f ==> convex s /\ compact s) /\ + (!t. t SUBSET f /\ FINITE t /\ CARD(t) = dimindex(:N) + 1 + ==> ~(INTERS t = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; UNIV_NOT_EMPTY] THEN + MATCH_MP_TAC HELLY_CLOSED THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPACT_IMP_BOUNDED]);; + +(* ------------------------------------------------------------------------- *) +(* Kirchberger's theorem *) +(* ------------------------------------------------------------------------- *) + +let KIRCHBERGER = prove + (`!s t:real^N->bool. + compact s /\ compact t /\ + (!s' t'. s' SUBSET s /\ t' SUBSET t /\ FINITE s' /\ FINITE t' /\ + CARD(s') + CARD(t') <= dimindex(:N) + 2 + ==> ?a b. (!x. x IN s' ==> a dot x < b) /\ + (!x. x IN t' ==> a dot x > b)) + ==> ?a b. ~(a = vec 0) /\ + (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + let lemma = prove + (`(!x. x IN convex hull s ==> a dot x < b) /\ + (!x. x IN convex hull t ==> a dot x > b) <=> + (!x. x IN s ==> a dot x < b) /\ (!x. x IN t ==> a dot x > b)`, + REWRITE_TAC[SET_RULE `(!x. x IN s ==> P x) <=> s SUBSET {x | P x}`] THEN + SIMP_TAC[SUBSET_HULL; CONVEX_HALFSPACE_LT; CONVEX_HALFSPACE_GT]) + and KIRCH_LEMMA = prove + (`!s t:real^N->bool. + FINITE s /\ FINITE t /\ + (!s' t'. s' SUBSET s /\ t' SUBSET t /\ + CARD(s') + CARD(t') <= dimindex(:N) + 2 + ==> ?a b. (!x. x IN s' ==> a dot x < b) /\ + (!x. x IN t' ==> a dot x > b)) + ==> ?a b. (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`IMAGE (\r. {z:real^(N,1)finite_sum | + fstcart z dot r < drop(sndcart z)}) s UNION + IMAGE (\r. {z:real^(N,1)finite_sum | + fstcart z dot r > drop(sndcart z)}) t`] + HELLY_ALT) THEN + REWRITE_TAC[FORALL_SUBSET_UNION; IN_UNION; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_SUBSET_IMAGE] THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE; INTERS_UNION] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_INTER; + EXISTS_PASTECART; IN_ELIM_PASTECART_THM; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM; FORALL_IN_IMAGE; RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; GSYM EXISTS_DROP] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`; GSYM DOT_RNEG] THEN + REWRITE_TAC[convex; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + SIMP_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; IN_ELIM_PASTECART_THM] THEN + SIMP_TAC[DOT_LADD; DOT_LMUL; DROP_ADD; DROP_CMUL; GSYM FORALL_DROP] THEN + REWRITE_TAC[REAL_ARITH `--(a * x + b * y):real = a * --x + b * --y`] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `u + v = &1 + ==> &0 <= u /\ &0 <= v + ==> u = &0 /\ v = &1 \/ u = &1 /\ v = &0 \/ &0 < u /\ &0 < v`)) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; + REAL_ADD_LID; REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN ASM_SIMP_TAC[REAL_LT_LMUL_EQ]; + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; + ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `FINITE(u:real^N->bool) /\ FINITE(v:real^N->bool)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CARD_UNION o lhand o lhand o snd) THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `IMAGE f s INTER IMAGE g t = {} <=> + !x y. x IN s /\ y IN t ==> ~(f x = g y)`] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN + REWRITE_TAC[GSYM FORALL_DROP; DOT_LZERO] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(ARITH_RULE + `a = a' /\ b = b' ==> a + b <= n + 2 ==> a' + b' <= n + 2`) THEN + CONJ_TAC THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN + ASM_REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + SIMP_TAC[GSYM FORALL_DROP; real_gt; VECTOR_EQ_LDOT; + MESON[REAL_LT_TOTAL; REAL_LT_REFL] + `((!y:real. a < y <=> b < y) <=> a = b) /\ + ((!y:real. y < a <=> y < b) <=> a = b)`]]) in + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM lemma] THEN + MATCH_MP_TAC SEPARATING_HYPERPLANE_COMPACT_COMPACT THEN + ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL; + CONVEX_HULL_EQ_EMPTY] THEN + SUBGOAL_THEN + `!s' t'. (s':real^N->bool) SUBSET s /\ t' SUBSET t /\ + FINITE s' /\ CARD(s') <= dimindex(:N) + 1 /\ + FINITE t' /\ CARD(t') <= dimindex(:N) + 1 + ==> DISJOINT (convex hull s') (convex hull t')` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s':real^N->bool`; `t':real^N->bool`] KIRCH_LEMMA) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; FINITE_SUBSET]; + ONCE_REWRITE_TAC[GSYM lemma] THEN SET_TAC[REAL_LT_ANTISYM; real_gt]]; + POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN + X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[CARATHEODORY] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s':real^N->bool`; `t':real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Convex hull is "preserved" by a linear function. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_HULL_LINEAR_IMAGE = prove + (`!f s. linear f ==> convex hull (IMAGE f s) = IMAGE f (convex hull s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_INDUCT THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC[FUN_IN_IMAGE; HULL_INC] THEN + REWRITE_TAC[convex; IN_ELIM_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN + REWRITE_TAC[IN_IMAGE] THEN + MESON_TAC[REWRITE_RULE[convex] CONVEX_CONVEX_HULL]; + ASM_SIMP_TAC[LINEAR_ADD; LINEAR_CMUL] THEN + MESON_TAC[REWRITE_RULE[convex] CONVEX_CONVEX_HULL]]);; + +add_linear_invariants [CONVEX_HULL_LINEAR_IMAGE];; + +let IN_CONVEX_HULL_LINEAR_IMAGE = prove + (`!f:real^M->real^N s x. + linear f /\ x IN convex hull s ==> (f x) IN convex hull (IMAGE f s)`, + SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Convexity of general and special intervals. *) +(* ------------------------------------------------------------------------- *) + +let IS_INTERVAL_CONVEX = prove + (`!s:real^N->bool. is_interval s ==> convex s`, + REWRITE_TAC[is_interval; convex] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`x:real^N`; `y:real^N`] THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + GEN_TAC THEN STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`(x:real^N)$i`; `(y:real^N)$i`] REAL_LE_TOTAL) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 * a <= b /\ b <= &1 * c ==> a <= b /\ b <= c`) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[GSYM VECTOR_MUL_COMPONENT; + VECTOR_ADD_RDISTRIB; VECTOR_ADD_COMPONENT] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_LE_LMUL; + REAL_LE_LADD; REAL_LE_RADD]);; + +let IS_INTERVAL_CONNECTED = prove + (`!s:real^N->bool. is_interval s ==> connected s`, + MESON_TAC[IS_INTERVAL_CONVEX; CONVEX_CONNECTED]);; + +let IS_INTERVAL_CONNECTED_1 = prove + (`!s:real^1->bool. is_interval s <=> connected s`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_CONNECTED] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[IS_INTERVAL_1; connected; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; + NOT_IMP; FORALL_LIFT; LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `x:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`{z:real^1 | basis 1 dot z < x}`; `{z:real^1 | basis 1 dot z > x}`] THEN + REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN + SIMP_TAC[SUBSET; EXTENSION; IN_UNION; IN_INTER; GSYM drop; NOT_FORALL_THM; + real_gt; NOT_IN_EMPTY; IN_ELIM_THM; DOT_BASIS; DIMINDEX_1; ARITH] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LT_TOTAL; LIFT_DROP]; + REAL_ARITH_TAC; + EXISTS_TAC `lift a`; + EXISTS_TAC `lift b`] THEN + ASM_REWRITE_TAC[REAL_LT_LE; LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let CONVEX_INTERVAL = prove + (`!a b:real^N. convex(interval [a,b]) /\ convex(interval (a,b))`, + SIMP_TAC[IS_INTERVAL_CONVEX; IS_INTERVAL_INTERVAL]);; + +let CONNECTED_INTERVAL = prove + (`(!a b:real^N. connected(interval[a,b])) /\ + (!a b:real^N. connected(interval(a,b)))`, + SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);; + +let CONVEX_CONNECTED_COLLINEAR = prove + (`!s:real^N->bool. collinear s ==> (convex s <=> connected s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[CONVEX_CONNECTED] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COLLINEAR_AFFINE_HULL]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + GEOM_ORIGIN_TAC `u:real^N` THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v:real^N` THEN + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + REWRITE_TAC[SPAN_SPECIAL_SCALE] THEN COND_CASES_TAC THENL + [REWRITE_TAC[SPAN_EMPTY; SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_EMPTY; CONVEX_SING]; + DISCH_TAC THEN + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; connected; NOT_EXISTS_THM] THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; SING_SUBSET] THEN + REWRITE_TAC[SUBSET; IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `u:real`] THEN + MAP_EVERY ASM_CASES_TAC [`u = &0`; `u = &1`] THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_REFL; + REAL_SUB_RZERO; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`{y:real^N | basis 1 dot y < basis 1 dot (x:real^N)}`; + `{y:real^N | basis 1 dot y > basis 1 dot (x:real^N)}`]) THEN + REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN + MATCH_MP_TAC(TAUT `q /\ r /\ (~p ==> s) ==> ~(p /\ q /\ r) ==> s`) THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REWRITE_TAC[CONJ_ASSOC; REAL_ARITH `~(x:real < a /\ x > a)`]; + ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[GSYM DOT_RSUB; SET_RULE + `~(s SUBSET {x | P x} UNION {x | Q x}) <=> + ?x. x IN s /\ ~(P x \/ Q x)`] THEN + SUBGOAL_THEN + `!p q:real^N. p IN span {basis 1} /\ q IN span {basis 1} /\ + basis 1 dot p = basis 1 dot q + ==> p = q` + ASSUME_TAC THENL + [SIMP_TAC[SPAN_SING; IMP_CONJ; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + SIMP_TAC[DOT_RMUL; BASIS_NONZERO; DOT_BASIS_BASIS; DIMINDEX_GE_1; + LE_REFL; REAL_MUL_RID]; + ALL_TAC] THEN + SUBGOAL_THEN `(x:real^N) IN span {basis 1}` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC SPAN_MUL THEN ASM SET_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `(a:real^N) IN s \/ b IN s ==> ~(s = {})`) THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; DOT_RADD; DOT_RMUL; + VECTOR_ARITH `((&1 - u) % a + u % b) - b:real^N = (u - &1) % (b - a)`; + VECTOR_ARITH `((&1 - u) % a + u % b) - a:real^N = u % (b - a)`; + VECTOR_ARITH `b - ((&1 - u) % a + u % b):real^N = (u - &1) % (a - b)`; + VECTOR_ARITH `a - ((&1 - u) % a + u % b):real^N = u % (a - b)`] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 < x ==> &0 < u * x) /\ (&0 < --x ==> &0 < (&1 - u) * --x) /\ + ~(x = &0) + ==> &0 < u * x \/ &0 < (u - &1) * x`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_SUB_LT] THEN + REWRITE_TAC[DOT_RSUB; REAL_SUB_0]; + REWRITE_TAC[DOT_RSUB; REAL_ARITH + `~(&0 < x - y \/ &0 < y - x) <=> y = x`]] THEN + ASM SET_TAC[]]);; + +let CONVEX_EQ_CONVEX_LINE_INTERSECTION = prove + (`!s:real^N->bool. convex s <=> !a b. convex(s INTER affine hull {a,b})`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a:real^N`; `b:real^N`; `a:real^N`; `b:real^N`]) THEN + ASM_SIMP_TAC[IN_INTER; HULL_INC; IN_INSERT] THEN SET_TAC[]);; + +let CONVEX_EQ_CONNECTED_LINE_INTERSECTION = prove + (`!s:real^N->bool. convex s <=> !a b. connected(s INTER affine hull {a,b})`, + GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [CONVEX_EQ_CONVEX_LINE_INTERSECTION] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + MATCH_MP_TAC CONVEX_CONNECTED_COLLINEAR THEN + MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `affine hull {a:real^N,b}` THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2] THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* On real^1, is_interval, convex and connected are all equivalent. *) +(* ------------------------------------------------------------------------- *) + +let IS_INTERVAL_CONVEX_1 = prove + (`!s:real^1->bool. is_interval s <=> convex s`, + MESON_TAC[IS_INTERVAL_CONVEX; CONVEX_CONNECTED; IS_INTERVAL_CONNECTED_1]);; + +let CONVEX_CONNECTED_1 = prove + (`!s:real^1->bool. convex s <=> connected s`, + REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; GSYM IS_INTERVAL_CONNECTED_1]);; + +let CONNECTED_CONVEX_1 = prove + (`!s:real^1->bool. connected s <=> convex s`, + REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; GSYM IS_INTERVAL_CONNECTED_1]);; + +let CONNECTED_COMPACT_INTERVAL_1 = prove + (`!s:real^1->bool. connected s /\ compact s <=> ?a b. s = interval[a,b]`, + REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_COMPACT]);; + +let CONVEX_CONNECTED_1_GEN = prove + (`!s:real^N->bool. + dimindex(:N) = 1 ==> (convex s <=> connected s)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[GSYM DIMINDEX_1] THEN + DISCH_THEN(ACCEPT_TAC o C GEOM_EQUAL_DIMENSION_RULE CONVEX_CONNECTED_1));; + +let CONNECTED_CONVEX_1_GEN = prove + (`!s:real^N->bool. + dimindex(:N) = 1 ==> (convex s <=> connected s)`, + SIMP_TAC[CONVEX_CONNECTED_1_GEN]);; + +(* ------------------------------------------------------------------------- *) +(* Jung's theorem. *) +(* Proof taken from http://cstheory.wordpress.com/2010/08/07/jungs-theorem/ *) +(* ------------------------------------------------------------------------- *) + +let JUNG = prove + (`!s:real^N->bool r. + bounded s /\ + sqrt(&(dimindex(:N)) / &(2 * dimindex(:N) + 2)) * diameter s <= r + ==> ?a. s SUBSET cball(a,r)`, + let lemma = prove + (`&0 < x /\ x <= y ==> (x - &1) / x <= (y - &1) / y`, + SIMP_TAC[REAL_LE_LDIV_EQ] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x / y * z:real = (x * z) / y`] THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LE_RDIV_EQ]] THEN + ASM_REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= r` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LE_TRANS)) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[DIAMETER_POS_LE] THEN + SIMP_TAC[SQRT_POS_LE; REAL_LE_DIV; REAL_POS]; + ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. cball(x,r)) s` HELLY_COMPACT_ALT) THEN + REWRITE_TAC[FORALL_IN_IMAGE; COMPACT_CBALL; CONVEX_CBALL] THEN + REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[INTERS_IMAGE; GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_ELIM_THM] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[DIST_SYM]] THEN + X_GEN_TAC `t:real^N->bool` THEN REWRITE_TAC[GSYM SUBSET] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[CARD_IMAGE_INJ; EQ_BALLS; GSYM REAL_NOT_LE] THEN + UNDISCH_TAC `FINITE(t:real^N->bool)` THEN + SUBGOAL_THEN `bounded(t:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET]; ALL_TAC] THEN + UNDISCH_TAC `&0 <= r` THEN + SUBGOAL_THEN + `sqrt(&(dimindex(:N)) / &(2 * dimindex(:N) + 2)) * + diameter(t:real^N->bool) <= r` + MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LE_TRANS)) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[DIAMETER_SUBSET; SQRT_POS_LE; REAL_POS; REAL_LE_DIV]; + POP_ASSUM_LIST(K ALL_TAC) THEN + SPEC_TAC(`t:real^N->bool`,`s:real^N->bool`) THEN + REPEAT STRIP_TAC] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + MP_TAC(ISPEC `{d | &0 <= d /\ ?a:real^N. s SUBSET cball(a,d)}` INF) THEN + ABBREV_TAC `d = inf {d | &0 <= d /\ ?a:real^N. s SUBSET cball(a,d)}` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + ASM_MESON_TAC[BOUNDED_SUBSET_CBALL; REAL_LT_IMP_LE]; + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "P") (LABEL_TAC "M"))] THEN + SUBGOAL_THEN `&0 <= d` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN `?a:real^N. s SUBSET cball(a,d)` MP_TAC THENL + [SUBGOAL_THEN + `!n. ?a:real^N. s SUBSET cball(a,d + inv(&n + &1))` + MP_TAC THENL + [X_GEN_TAC `n:num` THEN + REMOVE_THEN "M" (MP_TAC o SPEC `d + inv(&n + &1)`) THEN + REWRITE_TAC[REAL_ARITH `d + i <= d <=> ~(&0 < i)`] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN + MESON_TAC[SUBSET_CBALL; REAL_LT_IMP_LE; SUBSET_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN + X_GEN_TAC `aa:num->real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `?t. compact t /\ !n. (aa:num->real^N) n IN t` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o + MATCH_MP BOUNDED_SUBSET_CBALL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_CBALL_0] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + EXISTS_TAC `cball(vec 0:real^N,B + d + &1)` THEN + REWRITE_TAC[COMPACT_CBALL; IN_CBALL_0] THEN X_GEN_TAC `n:num` THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_CBALL]) THEN + MATCH_MP_TAC(NORM_ARITH + `(?x:real^N. norm(x) <= B /\ dist(a,x) <= d) ==> norm(a) <= B + d`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `d + inv(&n + &1)` THEN + ASM_SIMP_TAC[REAL_LE_LADD] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[compact; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `aa:num->real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SUBSET; IN_CBALL] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(SPEC `(dist(a:real^N,x) - d) / &2` REAL_ARCH_INV) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `(dist(a:real^N,x) - d) / &2`) THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_HALF; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPECL [`(r:num->num)(N1 + N2)`; `x:real^N`]) THEN + ASM_REWRITE_TAC[IN_CBALL; REAL_NOT_LE] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2:num`) THEN + ASM_REWRITE_TAC[LE_ADD] THEN + SUBGOAL_THEN `inv(&(r (N1 + N2:num)) + &1) < (dist(a:real^N,x) - d) / &2` + MP_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N2)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_INV_EQ]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(ARITH_RULE + `N1 + N2 <= r(N1 + N2) ==> N2 <= r(N1 + N2) + 1`) THEN + ASM_MESON_TAC[MONOTONE_BIGGER]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[GSYM IN_CBALL; GSYM SUBSET] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN + MATCH_MP_TAC SUBSET_CBALL THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a * s <= r ==> d <= a * s ==> d <= r`)) THEN + UNDISCH_THEN `&0 <= r` (K ALL_TAC) THEN REMOVE_THEN "M" (K ALL_TAC) THEN + FIRST_X_ASSUM(K ALL_TAC o SYM) THEN REMOVE_THEN "P" MP_TAC THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + ABBREV_TAC `n = CARD(s:real^N->bool)` THEN + SUBGOAL_THEN `(s:real^N->bool) HAS_SIZE n` MP_TAC THENL + [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN + UNDISCH_THEN `CARD(s:real^N->bool) = n` (K ALL_TAC) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`d:real`,`r:real`) THEN GEN_TAC THEN + GEOM_ORIGIN_TAC `a:real^N` THEN SIMP_TAC[HAS_SIZE] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ABBREV_TAC `t = {x:real^N | x IN s /\ norm(x) = r}` THEN + SUBGOAL_THEN `FINITE(t:real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "t" THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN + SUBGOAL_THEN `(vec 0:real^N) IN convex hull t` MP_TAC THENL + [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + MP_TAC(ISPEC `convex hull t:real^N->bool` + SEPARATING_HYPERPLANE_CLOSED_0) THEN + ASM_SIMP_TAC[CONVEX_CONVEX_HULL; NOT_IMP; COMPACT_CONVEX_HULL; + FINITE_IMP_COMPACT; COMPACT_IMP_CLOSED] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN + X_GEN_TAC `v:real^N` THEN + ABBREV_TAC `k = CARD(s:real^N->bool)` THEN + SUBGOAL_THEN `(s:real^N->bool) HAS_SIZE k` MP_TAC THENL + [ASM_REWRITE_TAC[HAS_SIZE]; ALL_TAC] THEN + UNDISCH_THEN `CARD(s:real^N->bool) = k` (K ALL_TAC) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v:real^N` THEN X_GEN_TAC `m:real` THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; REAL_LT_IMP_NZ] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[HAS_SIZE] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[DOT_LMUL; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[real_gt; GSYM REAL_LT_LDIV_EQ] THEN + SUBGOAL_THEN `&0 < b / m` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV]; + UNDISCH_THEN `&0 < b` (K ALL_TAC) THEN + SPEC_TAC(`b / m:real`,`b:real`)] THEN + X_GEN_TAC `b:real` THEN DISCH_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `!x:real^N e. &0 < e /\ e < b /\ x IN t ==> norm(x - e % basis 1) < r` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `r = norm(x:real^N)` SUBST1_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[NORM_LT; dot]] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL; + ARITH_RULE `2 <= n ==> 1 <= n /\ ~(n = 1)`; ARITH] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_LT_RADD] THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LT_SQUARE_ABS] THEN + MATCH_MP_TAC(REAL_ARITH + `!b. &0 < e /\ e < b /\ b < x ==> abs(x - e * &1) < abs x`) THEN + EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HULL_INC]; + ALL_TAC] THEN + SUBGOAL_THEN + `?d. &0 < d /\ + !x:real^N a. x IN (s DIFF t) /\ norm(a) < d ==> norm(x - a) < r` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `s DIFF t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + EXISTS_TAC `inf (IMAGE (\x:real^N. r - norm x) (s DIFF t))` THEN + SUBGOAL_THEN `FINITE(s DIFF t:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_DIFF]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN SIMP_TAC + [NORM_ARITH `norm a < r - norm x ==> norm(x - a:real^N) < r`] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM; REAL_SUB_LT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_CBALL_0]) THEN + ASM_MESON_TAC[REAL_LT_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a. !x. x IN s ==> norm(x - a:real^N) < r` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `min (b / &2) (d / &2) % basis 1:real^N` THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^N) IN t` THENL + [MATCH_MP_TAC(ASSUME + `!x:real^N e. &0 < e /\ e < b /\ x IN t + ==> norm (x - e % basis 1) < r`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(ASSUME + `!x:real^N a. x IN s DIFF t /\ norm a < d ==> norm (x - a) < r`) THEN + ASM_SIMP_TAC[IN_DIFF; NORM_MUL; LE_REFL; NORM_BASIS; + DIMINDEX_GE_1] THEN + ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL + [ASM_MESON_TAC[MEMBER_NOT_EMPTY; NORM_ARITH + `norm(x:real^N) < r ==> &0 < r`]; + ALL_TAC] THEN + UNDISCH_THEN + `!x a:real^N. &0 <= x /\ s SUBSET cball (a,x) ==> r <= x` (MP_TAC o + SPECL [`max (&0) (r - inf (IMAGE (\x:real^N. r - norm(x - a)) s))`; + `a:real^N`]) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> (r <= max (&0) a <=> r <= a)`] THEN + REWRITE_TAC[SUBSET; IN_CBALL; REAL_ARITH `a <= max a b`] THEN + REWRITE_TAC[NOT_IMP; REAL_ARITH `~(r <= r - x) <=> &0 < x`] THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; REAL_SUB_LT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `d <= b ==> d <= max a b`) THEN + ONCE_REWRITE_TAC[REAL_ARITH `a <= b - c <=> c <= b - a`] THEN + ASM_SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN + ASM_MESON_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN + REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real^N->real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt((&(dimindex (:N)) / &(2 * dimindex (:N) + 2)) * + diameter(s:real^N->bool) pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RSQRT; + ASM_SIMP_TAC[SQRT_MUL; DIAMETER_POS_LE; REAL_POW_LE; REAL_LE_DIV; + REAL_POS; POW_2_SQRT; REAL_LE_REFL]] THEN + + SUBGOAL_THEN + `sum t (\y:real^N. &2 * r pow 2) <= + sum t (\y. (&1 - l y) * diameter(s:real^N->bool) pow 2)` + MP_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (t DELETE x) (\x:real^N. l(x)) * + diameter(s:real^N->bool) pow 2` THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[SUM_DELETE; ETA_AX; REAL_LE_REFL]] THEN + REWRITE_TAC[GSYM SUM_RMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (t DELETE x) (\y:real^N. l y * norm(y - x) pow 2)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum t (\y:real^N. l y * norm (y - x) pow 2)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_REWRITE_TAC[FINITE_DELETE] THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[IN_DELETE]] THEN + SIMP_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN + REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN REAL_ARITH_TAC] THEN + REWRITE_TAC[NORM_POW_2; VECTOR_ARITH + `(y - x:real^N) dot (y - x) = (x dot x + y dot y) - &2 * x dot y`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum t (\y:real^N. l y * (&2 * r pow 2 - &2 * (x dot y)))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + UNDISCH_TAC `(x:real^N) IN t` THEN EXPAND_TAC "t" THEN + REWRITE_TAC[IN_DELETE; IN_ELIM_THM] THEN + SIMP_TAC[NORM_EQ_SQUARE; NORM_POW_2] THEN REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_ARITH `x * (&2 * y - &2 * z) = &2 * (x * y - x * z)`] THEN + REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[SUM_SUB; FINITE_DELETE; SUM_RMUL] THEN + REWRITE_TAC[GSYM DOT_RMUL] THEN + ASM_SIMP_TAC[GSYM DOT_RSUM; DOT_RZERO] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[SUM_CONST; SUM_RMUL; SUM_SUB] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; MULT_CLAUSES] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + SUBGOAL_THEN `&0 < &(CARD(t:real^N->bool) * 2)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT; ARITH_RULE `0 < n * 2 <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[CARD_EQ_0]; + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_ARITH `(a * b) / c:real = a / c * b`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + REWRITE_TAC[ARITH_RULE `2 * n + 2 = (n + 1) * 2`; GSYM REAL_OF_NUM_MUL; + real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[GSYM real_div] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SUBGOAL_THEN `&(dimindex(:N)) = &(dimindex(:N) + 1) - &1` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + MATCH_MP_TAC lemma THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; CARD_EQ_0; + ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN + ASM SET_TAC[]]]]);; + +(* ------------------------------------------------------------------------- *) +(* The Dugundji extension theorem, and Tietze variants as corollaries. *) +(* ------------------------------------------------------------------------- *) + +let DUGUNDJI = prove + (`!f:real^M->real^N c u s. + convex c /\ ~(c = {}) /\ + closed_in (subtopology euclidean u) s /\ + f continuous_on s /\ IMAGE f s SUBSET c + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ + !x. x IN s ==> g x = f x`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + EXISTS_TAC `(\x. y):real^M->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`u DIFF s:real^M->bool`; + `{ ball(x:real^M,setdist({x},s) / &2) |x| x IN u DIFF s}`] + PARACOMPACT) THEN + REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; OPEN_BALL] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_DIFF; IN_ELIM_THM; UNIONS_GSPEC] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN EXISTS_TAC `x:real^M` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(x = &0) ==> &0 < x / &2`) THEN + ASM_MESON_TAC[SETDIST_POS_LE; SETDIST_EQ_0_CLOSED_IN]; + DISCH_THEN(X_CHOOSE_THEN `c:(real^M->bool)->bool` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `!t. t IN c + ==> ?v a:real^M. v IN u /\ ~(v IN s) /\ a IN s /\ + t SUBSET ball(v,setdist({v},s) / &2) /\ + dist(v,a) <= &2 * setdist({v},s)` + MP_TAC THENL + [X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M` THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL[`{v:real^M}`; `s:real^M->bool`; `&2 * setdist({v:real^M},s)`] + REAL_SETDIST_LT_EXISTS) THEN + ASM_SIMP_TAC[NOT_INSERT_EMPTY; SETDIST_POS_LE; REAL_ARITH + `&0 <= x ==> (x < &2 * x <=> ~(x = &0))`] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; IN_SING; SETDIST_EQ_0_CLOSED_IN]; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`vv:(real^M->bool)->real^M`; `aa:(real^M->bool)->real^M`] THEN + STRIP_TAC] THEN + SUBGOAL_THEN + `!t v:real^M. t IN c /\ v IN t ==> setdist({vv t},s) <= &2 * setdist({v},s)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN + ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o el 3 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPEC `v:real^M`) THEN ASM_REWRITE_TAC[IN_BALL] THEN + MP_TAC(ISPECL [`s:real^M->bool`; `(vv:(real^M->bool)->real^M) t`; + `v:real^M`] SETDIST_SING_TRIANGLE) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!t v a:real^M. t IN c /\ v IN t /\ a IN s + ==> dist(a,aa t) <= &6 * dist(a,v)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^M->bool`; `v:real^M`]) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o funpow 3 CONJUNCT2) THEN + REWRITE_TAC[IMP_CONJ; SUBSET; IN_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `v:real^M`) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`{v:real^M}`; `s:real^M->bool`; `v:real^M`; `a:real^M`] + SETDIST_LE_DIST) THEN + ASM_REWRITE_TAC[IN_SING] THEN CONV_TAC NORM_ARITH; + ALL_TAC] THEN + MP_TAC(ISPECL [`c:(real^M->bool)->bool`; `u DIFF s:real^M->bool`] + SUBORDINATE_PARTITION_OF_UNITY) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h:(real^M->bool)->real^M->real` THEN STRIP_TAC THEN + EXISTS_TAC + `\x. if x IN s then (f:real^M->real^N) x + else vsum c (\t:real^M->bool. h t x % f(aa t))` THEN + SIMP_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONVEX_VSUM_STRONG THEN ASM SET_TAC[]] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `(a:real^M) IN s` THENL + [ALL_TAC; + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN + MAP_EVERY EXISTS_TAC + [`\x:real^M. + vsum c (\t:real^M->bool. h t x % (f:real^M->real^N) (aa t))`; + `u DIFF s:real^M->bool`] THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; IN_DIFF] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN + ASM_REWRITE_TAC[IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real^M->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN MAP_EVERY EXISTS_TAC + [`\x. vsum {u | u IN c /\ ~(!x:real^M. x IN n ==> h u x = &0)} + (\t:real^M->bool. h t x % (f:real^M->real^N) (aa t))`; + `(u DIFF s) INTER n:real^M->bool`] THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; OPEN_IN_INTER_OPEN; + IN_INTER; IN_DIFF] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_VSUM THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_VMUL THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT1) THEN + ASM_REWRITE_TAC[IN_DIFF; ETA_AX] THEN + REWRITE_TAC[CONTINUOUS_WITHIN] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN + SUBGOAL_THEN `open_in (subtopology euclidean u) (u DIFF s:real^M->bool)` + MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_AT; OPEN_IN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN + ASM_REWRITE_TAC[IN_DIFF] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_INTER; IN_DIFF] THEN + MESON_TAC[DIST_SYM]]] THEN + ASM_REWRITE_TAC[CONTINUOUS_WITHIN_OPEN] THEN + X_GEN_TAC `w:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[continuous_within] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(a:real^M,d / &6)` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &6 <=> &0 < e`] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + COND_CASES_TAC THENL + [REWRITE_TAC[IN_BALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONVEX_VSUM_STRONG THEN + ASM_SIMP_TAC[CONVEX_BALL; IN_DIFF] THEN + X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^M) IN t` THENL [DISJ2_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[IN_BALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `dist(a:real^M,v) < d / &6 + ==> dist(a,a') <= &6 * dist(a,v) ==> dist(a',a) < d`)) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let TIETZE = prove + (`!f:real^M->real^N u s B. + &0 <= B /\ + closed_in (subtopology euclidean u) s /\ + f continuous_on s /\ + (!x. x IN s ==> norm(f x) <= B) + ==> ?g. g continuous_on u /\ + (!x. x IN s ==> g x = f x) /\ + (!x. x IN u ==> norm(g x) <= B)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `cball(vec 0:real^N,B)`; `u:real^M->bool`; + `s:real^M->bool`] DUGUNDJI) THEN + ASM_REWRITE_TAC[CONVEX_CBALL; CBALL_EQ_EMPTY; REAL_NOT_LT] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_CBALL_0] THEN + MESON_TAC[]);; + +let TIETZE_CLOSED_INTERVAL = prove + (`!f:real^M->real^N u s a b. + ~(interval[a,b] = {}) /\ + closed_in (subtopology euclidean u) s /\ + f continuous_on s /\ + (!x. x IN s ==> f x IN interval[a,b]) + ==> ?g. g continuous_on u /\ + (!x. x IN s ==> g x = f x) /\ + (!x. x IN u ==> g(x) IN interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `interval[a:real^N,b]`; `u:real^M->bool`; + `s:real^M->bool`] DUGUNDJI) THEN + ASM_REWRITE_TAC[CONVEX_INTERVAL; SUBSET; FORALL_IN_IMAGE] THEN + MESON_TAC[]);; + +let TIETZE_CLOSED_INTERVAL_1 = prove + (`!f:real^N->real^1 u s a b. + drop a <= drop b /\ + closed_in (subtopology euclidean u) s /\ + f continuous_on s /\ + (!x. x IN s ==> f x IN interval[a,b]) + ==> ?g. g continuous_on u /\ + (!x. x IN s ==> g x = f x) /\ + (!x. x IN u ==> g(x) IN interval[a,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TIETZE_CLOSED_INTERVAL THEN + ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1]);; + +let TIETZE_OPEN_INTERVAL = prove + (`!f:real^M->real^N u s a b. + ~(interval(a,b) = {}) /\ + closed_in (subtopology euclidean u) s /\ + f continuous_on s /\ + (!x. x IN s ==> f x IN interval(a,b)) + ==> ?g. g continuous_on u /\ + (!x. x IN s ==> g x = f x) /\ + (!x. x IN u ==> g(x) IN interval(a,b))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `interval(a:real^N,b)`; `u:real^M->bool`; + `s:real^M->bool`] DUGUNDJI) THEN + ASM_REWRITE_TAC[CONVEX_INTERVAL; SUBSET; FORALL_IN_IMAGE] THEN + MESON_TAC[]);; + +let TIETZE_OPEN_INTERVAL_1 = prove + (`!f:real^N->real^1 u s a b. + drop a < drop b /\ + closed_in (subtopology euclidean u) s /\ + f continuous_on s /\ + (!x. x IN s ==> f x IN interval(a,b)) + ==> ?g. g continuous_on u /\ + (!x. x IN s ==> g x = f x) /\ + (!x. x IN u ==> g(x) IN interval(a,b))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TIETZE_OPEN_INTERVAL THEN + ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1]);; + +let TIETZE_UNBOUNDED = prove + (`!f:real^M->real^N u s. + closed_in (subtopology euclidean u) s /\ f continuous_on s + ==> ?g. g continuous_on u /\ + (!x. x IN s ==> g x = f x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^N)`; `u:real^M->bool`; + `s:real^M->bool`] DUGUNDJI) THEN + ASM_REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Convex cones and corresponding hulls. *) +(* ------------------------------------------------------------------------- *) + +let convex_cone = new_definition + `convex_cone s <=> ~(s = {}) /\ convex s /\ conic s`;; + +let CONVEX_CONE = prove + (`!s:real^N->bool. + convex_cone s <=> + vec 0 IN s /\ + (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\ + (!x c. x IN s /\ &0 <= c ==> (c % x) IN s)`, + GEN_TAC THEN REWRITE_TAC[convex_cone; GSYM conic] THEN + ASM_CASES_TAC `conic(s:real^N->bool)` THEN + ASM_SIMP_TAC[CONIC_CONTAINS_0] THEN AP_TERM_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[conic]) THEN + REWRITE_TAC[convex] THEN EQ_TAC THEN + ASM_SIMP_TAC[REAL_SUB_LE] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`&2 % (x:real^N)`; `&2 % (y:real^N)`; `&1 / &2`; `&1 / &2`]) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[VECTOR_MUL_LID; REAL_POS]);; + +let CONVEX_CONE_ADD = prove + (`!s x y. convex_cone s /\ x IN s /\ y IN s ==> (x + y) IN s`, + MESON_TAC[CONVEX_CONE]);; + +let CONVEX_CONE_MUL = prove + (`!s c x. convex_cone s /\ &0 <= c /\ x IN s ==> (c % x) IN s`, + MESON_TAC[CONVEX_CONE]);; + +let CONVEX_CONE_NONEMPTY = prove + (`!s. convex_cone s ==> ~(s = {})`, + MESON_TAC[CONVEX_CONE; MEMBER_NOT_EMPTY]);; + +let CONVEX_CONE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + convex_cone s /\ linear f ==> convex_cone(IMAGE f s)`, + SIMP_TAC[convex_cone; CONVEX_LINEAR_IMAGE; IMAGE_EQ_EMPTY; + CONIC_LINEAR_IMAGE]);; + +let CONVEX_CONE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (convex_cone(IMAGE f s) <=> convex_cone s)`, + REWRITE_TAC[convex_cone] THEN + MESON_TAC[IMAGE_EQ_EMPTY; CONVEX_LINEAR_IMAGE_EQ; CONIC_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [CONVEX_CONE_LINEAR_IMAGE_EQ];; + +let CONVEX_CONE_HALFSPACE_GE = prove + (`!a. convex_cone {x | a dot x >= &0}`, + SIMP_TAC[CONVEX_CONE; real_ge; IN_ELIM_THM; DOT_RZERO; DOT_RADD; DOT_RMUL; + REAL_LE_ADD; REAL_LE_MUL; REAL_LE_REFL]);; + +let CONVEX_CONE_HALFSPACE_LE = prove + (`!a. convex_cone {x | a dot x <= &0}`, + REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; GSYM DOT_LNEG] THEN + REWRITE_TAC[GSYM real_ge; CONVEX_CONE_HALFSPACE_GE]);; + +let CONVEX_CONE_CONTAINS_0 = prove + (`!s:real^N->bool. convex_cone s ==> vec 0 IN s`, + SIMP_TAC[CONVEX_CONE]);; + +let CONVEX_CONE_INTERS = prove + (`!f. (!s:real^N->bool. s IN f ==> convex_cone s) ==> convex_cone(INTERS f)`, + SIMP_TAC[convex_cone; CONIC_INTERS; CONVEX_INTERS] THEN + REWRITE_TAC[GSYM convex_cone] THEN GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN + ASM_SIMP_TAC[IN_INTERS; CONVEX_CONE_CONTAINS_0]);; + +let CONVEX_CONE_CONVEX_CONE_HULL = prove + (`!s. convex_cone(convex_cone hull s)`, + SIMP_TAC[P_HULL; CONVEX_CONE_INTERS]);; + +let CONVEX_CONVEX_CONE_HULL = prove + (`!s. convex(convex_cone hull s)`, + MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; convex_cone]);; + +let CONIC_CONVEX_CONE_HULL = prove + (`!s. conic(convex_cone hull s)`, + MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; convex_cone]);; + +let CONVEX_CONE_HULL_NONEMPTY = prove + (`!s. ~(convex_cone hull s = {})`, + MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; convex_cone]);; + +let CONVEX_CONE_HULL_CONTAINS_0 = prove + (`!s. vec 0 IN convex_cone hull s`, + MESON_TAC[CONVEX_CONE_CONVEX_CONE_HULL; CONVEX_CONE]);; + +let CONVEX_CONE_HULL_ADD = prove + (`!s x y:real^N. + x IN convex_cone hull s /\ y IN convex_cone hull s + ==> x + y IN convex_cone hull s`, + MESON_TAC[CONVEX_CONE; CONVEX_CONE_CONVEX_CONE_HULL]);; + +let CONVEX_CONE_HULL_MUL = prove + (`!s c x:real^N. + &0 <= c /\ x IN convex_cone hull s + ==> (c % x) IN convex_cone hull s`, + MESON_TAC[CONVEX_CONE; CONVEX_CONE_CONVEX_CONE_HULL]);; + +let CONVEX_CONE_SUMS = prove + (`!s t. convex_cone s /\ convex_cone t + ==> convex_cone {x + y:real^N | x IN s /\ y IN t}`, + SIMP_TAC[convex_cone; CONIC_SUMS; CONVEX_SUMS] THEN SET_TAC[]);; + +let CONVEX_CONE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + convex_cone s /\ convex_cone t ==> convex_cone(s PCROSS t)`, + SIMP_TAC[convex_cone; CONVEX_PCROSS; CONIC_PCROSS; PCROSS_EQ_EMPTY]);; + +let CONVEX_CONE_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + convex_cone(s PCROSS t) <=> convex_cone s /\ convex_cone t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_REWRITE_TAC[PCROSS_EMPTY; convex_cone]; ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[PCROSS_EMPTY; convex_cone]; ALL_TAC] THEN + EQ_TAC THEN REWRITE_TAC[CONVEX_CONE_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_CONE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] CONVEX_CONE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CONVEX_CONE_HULL_UNION = prove + (`!s t. convex_cone hull(s UNION t) = + {x + y:real^N | x IN convex_cone hull s /\ y IN convex_cone hull t}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[CONVEX_CONE_SUMS; CONVEX_CONE_CONVEX_CONE_HULL] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_SIMP_TAC[HULL_INC; CONVEX_CONE_HULL_CONTAINS_0; VECTOR_ADD_RID]; + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN + ASM_SIMP_TAC[HULL_INC; CONVEX_CONE_HULL_CONTAINS_0; VECTOR_ADD_LID]]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_CONE_HULL_ADD THEN + ASM_MESON_TAC[HULL_MONO; SUBSET_UNION; SUBSET]]);; + +let CONVEX_CONE_SING = prove + (`convex_cone {vec 0}`, + SIMP_TAC[CONVEX_CONE; IN_SING; VECTOR_ADD_LID; VECTOR_MUL_RZERO]);; + +let CONVEX_HULL_SUBSET_CONVEX_CONE_HULL = prove + (`!s. convex hull s SUBSET convex_cone hull s`, + GEN_TAC THEN MATCH_MP_TAC HULL_ANTIMONO THEN + SIMP_TAC[convex_cone; SUBSET; IN]);; + +let CONIC_HULL_SUBSET_CONVEX_CONE_HULL = prove + (`!s. conic hull s SUBSET convex_cone hull s`, + GEN_TAC THEN MATCH_MP_TAC HULL_ANTIMONO THEN + SIMP_TAC[convex_cone; SUBSET; IN]);; + +let CONVEX_CONE_HULL_SEPARATE_NONEMPTY = prove + (`!s:real^N->bool. + ~(s = {}) + ==> convex_cone hull s = conic hull (convex hull s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONIC_CONVEX_CONE_HULL; CONVEX_HULL_SUBSET_CONVEX_CONE_HULL] THEN + ASM_SIMP_TAC[CONVEX_CONIC_HULL; CONVEX_CONVEX_HULL; CONIC_CONIC_HULL; + convex_cone; CONIC_HULL_EQ_EMPTY; CONVEX_HULL_EQ_EMPTY] THEN + ASM_MESON_TAC[HULL_SUBSET; SUBSET_REFL; SUBSET_TRANS]);; + +let CONVEX_CONE_HULL_EMPTY = prove + (`convex_cone hull {} = {vec 0}`, + MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[CONVEX_CONE_CONTAINS_0; EMPTY_SUBSET; CONVEX_CONE_SING; + SET_RULE `{a} SUBSET s <=> a IN s`; CONVEX_CONE_CONTAINS_0]);; + +let CONVEX_CONE_HULL_SEPARATE = prove + (`!s:real^N->bool. + convex_cone hull s = vec 0 INSERT conic hull (convex hull s)`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[CONVEX_CONE_HULL_EMPTY; CONVEX_HULL_EMPTY; CONIC_HULL_EMPTY] THEN + ASM_SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY] THEN + MATCH_MP_TAC(SET_RULE `a IN s ==> s = a INSERT s`) THEN + ASM_SIMP_TAC[CONIC_CONTAINS_0; CONIC_CONIC_HULL] THEN + ASM_REWRITE_TAC[CONIC_HULL_EQ_EMPTY; CONVEX_HULL_EQ_EMPTY]);; + +let CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY = prove + (`!s:real^N->bool. + ~(s = {}) + ==> convex_cone hull s = {c % x | &0 <= c /\ x IN convex hull s}`, + SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY; CONIC_HULL_EXPLICIT]);; + +let CONVEX_CONE_HULL_CONVEX_HULL = prove + (`!s:real^N->bool. + convex_cone hull s = + vec 0 INSERT {c % x | &0 <= c /\ x IN convex hull s}`, + REWRITE_TAC[CONVEX_CONE_HULL_SEPARATE; CONIC_HULL_EXPLICIT]);; + +let CONVEX_CONE_HULL_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f + ==> convex_cone hull (IMAGE f s) = IMAGE f (convex_cone hull s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^M-> bool = {}` THEN + ASM_SIMP_TAC[CONVEX_CONE_HULL_SEPARATE_NONEMPTY; IMAGE_EQ_EMPTY; + CONVEX_HULL_LINEAR_IMAGE; CONIC_HULL_LINEAR_IMAGE] THEN + REWRITE_TAC[IMAGE_CLAUSES; CONVEX_CONE_HULL_EMPTY] THEN + MATCH_MP_TAC(SET_RULE `f x = y ==> {y} = {f x}`) THEN + ASM_MESON_TAC[LINEAR_0]);; + +add_linear_invariants [CONVEX_CONE_HULL_LINEAR_IMAGE];; + +let SUBSPACE_IMP_CONVEX_CONE = prove + (`!s. subspace s ==> convex_cone s`, + SIMP_TAC[subspace; CONVEX_CONE]);; + +let CONVEX_CONE_SPAN = prove + (`!s. convex_cone(span s)`, + SIMP_TAC[convex_cone; CONVEX_SPAN; CONIC_SPAN; GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[SPAN_0]);; + +let CONVEX_CONE_NEGATIONS = prove + (`!s. convex_cone s ==> convex_cone (IMAGE (--) s)`, + SIMP_TAC[convex_cone; IMAGE_EQ_EMPTY; CONIC_NEGATIONS; CONVEX_NEGATIONS]);; + +let SUBSPACE_CONVEX_CONE_SYMMETRIC = prove + (`!s:real^N->bool. + subspace s <=> convex_cone s /\ (!x. x IN s ==> --x IN s)`, + GEN_TAC THEN REWRITE_TAC[subspace; CONVEX_CONE] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THENL + [ASM_MESON_TAC[VECTOR_ARITH `--x:real^N = -- &1 % x`]; + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN DISCH_TAC THEN + DISJ_CASES_TAC(SPEC `c:real` REAL_LE_NEGTOTAL) THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[VECTOR_ARITH `c % x:real^N = --(--c % x)`]]);; + +let SPAN_CONVEX_CONE_ALLSIGNS = prove + (`!s:real^N->bool. span s = convex_cone hull (s UNION IMAGE (--) s)`, + GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN CONJ_TAC THENL + [MESON_TAC[HULL_SUBSET; SUBSET_UNION; SUBSET_TRANS]; ALL_TAC] THEN + REWRITE_TAC[SUBSPACE_CONVEX_CONE_SYMMETRIC; + CONVEX_CONE_CONVEX_CONE_HULL] THEN + MATCH_MP_TAC HULL_INDUCT THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION; IN_IMAGE] THEN + DISCH_TAC THEN MATCH_MP_TAC HULL_INC THEN + REWRITE_TAC[IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]; + SUBGOAL_THEN `!s. {x:real^N | (--x) IN s} = IMAGE (--) s` + (fun th -> SIMP_TAC[th; CONVEX_CONE_NEGATIONS; + CONVEX_CONE_CONVEX_CONE_HULL]) THEN + GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[VECTOR_NEG_NEG]]; + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONE_SPAN] THEN + REWRITE_TAC[UNION_SUBSET; SPAN_INC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + MESON_TAC[SPAN_SUPERSET; SPAN_NEG]]);; + +(* ------------------------------------------------------------------------- *) +(* Epigraphs of convex functions. *) +(* ------------------------------------------------------------------------- *) + +let epigraph = new_definition + `epigraph s (f:real^N->real) = + {xy:real^((N,1)finite_sum) | + fstcart xy IN s /\ f(fstcart xy) <= drop(sndcart xy)}`;; + +let IN_EPIGRAPH = prove + (`!x y. (pastecart x (lift y)) IN epigraph s f <=> x IN s /\ f(x) <= y`, + REWRITE_TAC[epigraph; IN_ELIM_THM; FSTCART_PASTECART; SNDCART_PASTECART; + LIFT_DROP]);; + +let CONVEX_EPIGRAPH = prove + (`!f s. f convex_on s /\ convex s <=> convex(epigraph s f)`, + REWRITE_TAC[convex; convex_on; IN_ELIM_THM; SNDCART_ADD; SNDCART_CMUL; + epigraph; FSTCART_ADD; FSTCART_CMUL; FORALL_PASTECART; FSTCART_PASTECART; + SNDCART_PASTECART] THEN + REWRITE_TAC[GSYM FORALL_DROP; DROP_ADD; DROP_CMUL] THEN + MESON_TAC[REAL_LE_REFL; REAL_LE_ADD2; REAL_LE_LMUL; REAL_LE_TRANS]);; + +let CONVEX_EPIGRAPH_CONVEX = prove + (`!f s. convex s ==> (f convex_on s <=> convex(epigraph s f))`, + REWRITE_TAC[GSYM CONVEX_EPIGRAPH] THEN CONV_TAC TAUT);; + +let CONVEX_ON_EPIGRAPH_SLICE_LE = prove + (`!f:real^N->real s a. + f convex_on s /\ convex s ==> convex {x | x IN s /\ f(x) <= a}`, + SIMP_TAC[convex_on; convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REWRITE_TAC[]);; + +let CONVEX_ON_EPIGRAPH_SLICE_LT = prove + (`!f:real^N->real s a. + f convex_on s /\ convex s ==> convex {x | x IN s /\ f(x) < a}`, + SIMP_TAC[convex_on; convex; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LT THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Use this to derive general bound property of convex function. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_OF_PASTECART = prove + (`(!p. P (fstcart o p) (sndcart o p)) <=> (!x:A->B^M y:A->B^N. P x y)`, + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\a:A. pastecart (x a :B^M) (y a :B^N)`) THEN + REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);; + +let FORALL_OF_DROP = prove + (`(!v. P (drop o v)) <=> (!x:A->real. P x)`, + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\a:A. lift(x a)`) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);; + +let CONVEX_ON_JENSEN = prove + (`!f:real^N->real s. + convex s + ==> (f convex_on s <=> + !k u x. + (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\ + (sum (1..k) u = &1) + ==> f(vsum (1..k) (\i. u(i) % x(i))) + <= sum (1..k) (\i. u(i) * f(x(i))))`, + let lemma = prove + (`(!x. P x ==> (Q x = R x)) ==> (!x. P x) ==> ((!x. Q x) <=> (!x. R x))`, + MESON_TAC[]) in + REPEAT STRIP_TAC THEN FIRST_ASSUM + (fun th -> REWRITE_TAC[MATCH_MP CONVEX_EPIGRAPH_CONVEX th]) THEN + REWRITE_TAC[CONVEX_INDEXED; epigraph] THEN + SIMP_TAC[IN_ELIM_THM; SNDCART_ADD; SNDCART_CMUL; FINITE_NUMSEG; + FSTCART_ADD; FSTCART_CMUL; FORALL_PASTECART; DROP_CMUL; + FSTCART_PASTECART; SNDCART_PASTECART; + FSTCART_VSUM; SNDCART_VSUM; DROP_VSUM; o_DEF] THEN + REWRITE_TAC[GSYM(ISPEC `fstcart` o_THM); GSYM(ISPEC `sndcart` o_THM)] THEN + REWRITE_TAC[GSYM(ISPEC `drop` o_THM)] THEN + REWRITE_TAC[FORALL_OF_PASTECART; FORALL_OF_DROP] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_INDEXED]) THEN + REPEAT(MATCH_MP_TAC lemma THEN GEN_TAC) THEN SIMP_TAC[] THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN DISCH_THEN(K ALL_TAC) THEN + EQ_TAC THEN SIMP_TAC[REAL_LE_REFL] THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LE_LMUL]);; + +let CONVEX_ON_IMP_JENSEN = prove + (`!f:real^N->real s k:A->bool u x. + f convex_on s /\ convex s /\ FINITE k /\ + (!i. i IN k ==> &0 <= u i /\ x i IN s) /\ sum k u = &1 + ==> f(vsum k (\i. u i % x i)) <= sum k (\i. u i * f(x i))`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ABBREV_TAC `n = CARD(k:A->bool)` THEN + REWRITE_TAC[INJECTIVE_ON_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->A` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + ASM_SIMP_TAC[VSUM_IMAGE; SUM_IMAGE; FINITE_NUMSEG; IMP_CONJ; o_DEF] THEN + DISCH_TAC THEN MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] + CONVEX_ON_JENSEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Another intermediate value theorem formulation. *) +(* ------------------------------------------------------------------------- *) + +let IVT_INCREASING_COMPONENT_ON_1 = prove + (`!f:real^1->real^N a b y k. + drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ + f continuous_on interval[a,b] /\ + f(a)$k <= y /\ y <= f(b)$k + ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE (f:real^1->real^N) (interval[a,b])`] + CONNECTED_IVT_COMPONENT) THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN + ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONVEX_CONNECTED; + CONVEX_INTERVAL] THEN + EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN + EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]);; + +let IVT_INCREASING_COMPONENT_1 = prove + (`!f:real^1->real^N a b y k. + drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> f continuous at x) /\ + f(a)$k <= y /\ y <= f(b)$k + ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN + ASM_SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let IVT_DECREASING_COMPONENT_ON_1 = prove + (`!f:real^1->real^N a b y k. + drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ + f continuous_on interval[a,b] /\ + f(b)$k <= y /\ y <= f(a)$k + ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN + ASM_SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN + MATCH_MP_TAC IVT_INCREASING_COMPONENT_ON_1 THEN + ASM_SIMP_TAC[VECTOR_NEG_COMPONENT; CONTINUOUS_ON_NEG; REAL_LE_NEG2]);; + +let IVT_DECREASING_COMPONENT_1 = prove + (`!f:real^1->real^N a b y k. + drop a <= drop b /\ 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> f continuous at x) /\ + f(b)$k <= y /\ y <= f(a)$k + ==> ?x. x IN interval[a,b] /\ f(x)$k = y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_DECREASING_COMPONENT_ON_1 THEN + ASM_SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +(* ------------------------------------------------------------------------- *) +(* A bound within a convex hull, and so an interval. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_ON_CONVEX_HULL_BOUND = prove + (`!f s b. f convex_on (convex hull s) /\ + (!x:real^N. x IN s ==> f(x) <= b) + ==> !x. x IN convex hull s ==> f(x) <= b`, + REPEAT GEN_TAC THEN SIMP_TAC[CONVEX_ON_JENSEN; CONVEX_CONVEX_HULL] THEN + STRIP_TAC THEN GEN_TAC THEN REWRITE_TAC[CONVEX_HULL_INDEXED] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `u:num->real`; `v:num->real^N`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..k) (\i. u i * f(v i :real^N))` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; HULL_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum(1..k) (\i. u i * b)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LE_LMUL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SUM_LMUL] THEN + ASM_MESON_TAC[REAL_LE_REFL; REAL_MUL_RID]);; + +let UNIT_INTERVAL_CONVEX_HULL = prove + (`interval [vec 0,vec 1:real^N] = + convex hull + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> ((x$i = &0) \/ (x$i = &1))}`, + let lemma = prove + (`FINITE {i | 1 <= i /\ i <= n /\ P(i)} /\ + CARD {i | 1 <= i /\ i <= n /\ P(i)} <= n`, + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `1..n`; + GEN_REWRITE_TAC RAND_CONV [ARITH_RULE `x = (x + 1) - 1`] THEN + REWRITE_TAC[GSYM CARD_NUMSEG] THEN MATCH_MP_TAC CARD_SUBSET] THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; SUBSET; IN_ELIM_THM]) in + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_INTERVAL; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN + SIMP_TAC[VEC_COMPONENT] THEN MESON_TAC[REAL_LE_REFL; REAL_POS]] THEN + SUBGOAL_THEN + `!n x:real^N. + x IN interval[vec 0,vec 1] /\ + n <= dimindex(:N) /\ + CARD {i | 1 <= i /\ i <= dimindex(:N) /\ ~(x$i = &0)} <= n + ==> x IN convex hull + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> ((x$i = &0) \/ (x$i = &1))}` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `dimindex(:N)` THEN + ASM_REWRITE_TAC[LE_REFL; lemma]] THEN + INDUCT_TAC THEN X_GEN_TAC `x:real^N` THENL + [SIMP_TAC[LE; lemma; CARD_EQ_0] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; BETA_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN STRIP_TAC THEN + SUBGOAL_THEN `x = vec 0:real^N` SUBST1_TAC THENL + [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + SIMP_TAC[IN_ELIM_THM; VEC_COMPONENT]; + ALL_TAC] THEN + ASM_CASES_TAC + `{i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)} = {}` + THENL + [DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; BETA_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN STRIP_TAC THEN + SUBGOAL_THEN `x = vec 0:real^N` SUBST1_TAC THENL + [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + SIMP_TAC[IN_ELIM_THM; VEC_COMPONENT]; + ALL_TAC] THEN + MP_TAC(ISPEC + `IMAGE (\i. x$i) + {i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)}` + INF_FINITE) THEN + ABBREV_TAC `xi = inf + (IMAGE (\i. x$i) + {i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)})` THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; lemma] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= (x:real^N)$i /\ x$i <= &1` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `x:real^N IN interval [vec 0,vec 1]` THEN + ASM_SIMP_TAC[IN_INTERVAL; VEC_COMPONENT]; + ALL_TAC] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `x <= &1 ==> (x = &1) \/ x < &1`)) + THENL + [SUBGOAL_THEN + `x = lambda i. if (x:real^N)$i = &0 then &0 else &1` + SUBST1_TAC THENL + [UNDISCH_TAC `x:real^N IN interval [vec 0,vec 1]` THEN + ASM_SIMP_TAC[CART_EQ; IN_INTERVAL; VEC_COMPONENT; LAMBDA_BETA] THEN + ASM_MESON_TAC[REAL_LE_ANTISYM]; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `x:real^N = + x$i % (lambda j. if x$j = &0 then &0 else &1) + + (&1 - x$i) % + (lambda j. if x$j = &0 then &0 else (x$j - x$i) / (&1 - x$i))` + SUBST1_TAC THENL + [SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA; VEC_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; ARITH_RULE `x < &1 ==> ~(&1 - x = &0)`] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[convex] CONVEX_CONVEX_HULL) THEN + ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> &0 <= &1 - x`; + REAL_ARITH `x + &1 - x = &1`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] HULL_SUBSET) THEN + SIMP_TAC[LAMBDA_BETA; IN_ELIM_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `SUC k <= n ==> k <= n`] THEN CONJ_TAC THENL + [SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN + GEN_TAC THEN STRIP_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; + REAL_ARITH `x < &1 ==> &0 < &1 - x`] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_LE; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_ARITH `a - b <= &1 - b <=> a <= &1`] THEN + UNDISCH_TAC `x:real^N IN interval [vec 0,vec 1]` THEN + ASM_SIMP_TAC[CART_EQ; IN_INTERVAL; VEC_COMPONENT; LAMBDA_BETA]; + ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC + `CARD({i | 1 <= i /\ i <= dimindex(:N) /\ ~((x:real^N)$i = &0)} + DELETE i)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[lemma; FINITE_DELETE] THEN + REWRITE_TAC[SUBSET; IN_DELETE; IN_ELIM_THM] THEN + GEN_TAC THEN REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTRAPOS_THM] THEN + SIMP_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO]; + SIMP_TAC[lemma; CARD_DELETE] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `x <= SUC n ==> x - 1 <= n`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Some convexity-related properties of Hausdorff distance *) +(* ------------------------------------------------------------------------- *) + +let HAUSDIST_CONVEX_HULLS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t + ==> hausdist(convex hull s,convex hull t) <= hausdist(s,t)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_MESON_TAC[HAUSDIST_EMPTY; CONVEX_HULL_EMPTY; REAL_LE_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_MESON_TAC[HAUSDIST_EMPTY; CONVEX_HULL_EMPTY; REAL_LE_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN + CONJ_TAC THEN MATCH_MP_TAC CONVEX_ON_CONVEX_HULL_BOUND THEN + CONJ_TAC THEN SIMP_TAC[CONVEX_ON_SETDIST; CONVEX_CONVEX_HULL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN + ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; CONJ_ASSOC] THEN + (CONJ_TAC THENL + [CONJ_TAC; ASM_MESON_TAC[SETDIST_SUBSET_RIGHT; HULL_SUBSET]]) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_SUMS = prove + (`!s t:real^N->bool u. + bounded s /\ bounded t /\ convex s /\ convex t /\ bounded u /\ + ~(s = {}) /\ ~(t = {}) /\ ~(u = {}) + ==> hausdist({x + e | x IN s /\ e IN u}, + {y + e | y IN t /\ e IN u}) = + hausdist(s,t)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] + `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN + SIMP_TAC[CLOSURE_SUMS] THEN + SIMP_TAC[CLOSURE_CLOSED; CLOSED_CBALL; GSYM COMPACT_CLOSURE] THEN + ONCE_REWRITE_TAC[GSYM CLOSURE_EQ_EMPTY] THEN + ASM_CASES_TAC + `convex(closure s:real^N->bool) /\ convex(closure t:real^N->bool)` + THENL [POP_ASSUM MP_TAC; ASM_MESON_TAC[CONVEX_CLOSURE]] THEN + ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `convex(t:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + SPEC_TAC(`closure u:real^N->bool`,`u:real^N->bool`) THEN + SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN + SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_HAUSDIST_LE_SUMS THEN + MAP_EVERY ABBREV_TAC + [`a = hausdist(s:real^N->bool,t)`; + `b = hausdist({x + e:real^N | x IN s /\ e IN u}, + {y + e | y IN t /\ e IN u})`] THEN + ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; SET_RULE + `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] + THENL + [REWRITE_TAC[SUMS_ASSOC] THEN + GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [SUMS_SYM] THEN + REWRITE_TAC[GSYM SUMS_ASSOC] THEN CONJ_TAC THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' + ==> {f x y | x IN s /\ y IN t} SUBSET {f x y | x IN s' /\ y IN t}`) THEN + EXPAND_TAC "a" THENL + [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN + MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]; + CONJ_TAC THEN MATCH_MP_TAC SUBSET_SUMS_RCANCEL THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL; COMPACT_IMP_CLOSED; + CONVEX_CBALL; COMPACT_IMP_BOUNDED; CONVEX_SUMS; REAL_NOT_LT] THEN + REWRITE_TAC[SUMS_ASSOC] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN + REWRITE_TAC[GSYM SUMS_ASSOC] THEN + EXPAND_TAC "b" THENL + [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN + MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN + ASM_SIMP_TAC[BOUNDED_SUMS; COMPACT_SUMS; COMPACT_CBALL; + COMPACT_IMP_BOUNDED; CBALL_EQ_EMPTY; REAL_NOT_LT; SET_RULE + `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`]]);; + +(* ------------------------------------------------------------------------- *) +(* Representation of any interval as a finite convex hull. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_INTERVAL_AS_CONVEX_HULL = prove + (`!a b:real^N. ?s. FINITE s /\ interval[a,b] = convex hull s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM_MESON_TAC[CONVEX_HULL_EMPTY; FINITE_EMPTY]; ALL_TAC] THEN + ASM_SIMP_TAC[CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL] THEN + SUBGOAL_THEN + `?s:real^N->bool. FINITE s /\ interval[vec 0,vec 1] = convex hull s` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC + `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> ((x$i = &0) \/ (x$i = &1))}` THEN + REWRITE_TAC[UNIT_INTERVAL_CONVEX_HULL] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC + `IMAGE (\s. (lambda i. if i IN s then &1 else &0):real^N) + {t | t SUBSET (1..dimindex(:N))}` THEN + ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC + `{i | 1 <= i /\ i <= dimindex(:N) /\ ((x:real^N)$i = &1)}` THEN + SIMP_TAC[CART_EQ; IN_ELIM_THM; IN_NUMSEG; LAMBDA_BETA] THEN + ASM_MESON_TAC[]; + EXISTS_TAC `IMAGE (\x:real^N. a + x) + (IMAGE (\x. (lambda i. ((b:real^N)$i - a$i) * x$i)) + (s:real^N->bool))` THEN + ASM_SIMP_TAC[FINITE_IMAGE; CONVEX_HULL_TRANSLATION] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(GSYM CONVEX_HULL_LINEAR_IMAGE) THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Bounded convex function on open set is continuous. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_ON_BOUNDED_CONTINUOUS = prove + (`!f:real^N->real s b. + open s /\ f convex_on s /\ (!x. x IN s ==> abs(f x) <= b) + ==> (lift o f) continuous_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN + ABBREV_TAC `B = abs(b) + &1` THEN + SUBGOAL_THEN `&0 < B /\ !x:real^N. x IN s ==> abs(f x) <= B` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "B" THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[REAL_ARITH `x <= b ==> x <= abs b + &1`]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(x - y) < e <=> x - y < e /\ y - x < e`] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[SUBSET; IN_CBALL] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (k / &2) (e / (&2 * B) * k)` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_LT_MUL; + REAL_OF_NUM_LT; ARITH] THEN + X_GEN_TAC `y:real^N` THEN + ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN + STRIP_TAC THEN + ABBREV_TAC `t = k / norm(y - x:real^N)` THEN + SUBGOAL_THEN `&2 < t` ASSUME_TAC THENL + [EXPAND_TAC "t" THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH + `&2 < t ==> &0 < t /\ ~(t = &0) /\ &0 < t - &1 /\ + &0 < &1 + t /\ ~(&1 + t = &0)`)) THEN + SUBGOAL_THEN `y:real^N IN s` ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[dist] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < k / &2 ==> k / &2 <= k ==> x <= k`)) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < k` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [ABBREV_TAC `w:real^N = x + t % (y - x)` THEN + SUBGOAL_THEN `w:real^N IN s` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "w" THEN + REWRITE_TAC[dist; VECTOR_ARITH `x - (x + t) = --t:real^N`] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[NORM_NEG; NORM_MUL; REAL_ABS_DIV] THEN + REWRITE_TAC[REAL_ABS_NORM; real_div; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_MUL_RID; REAL_ARITH `&0 < x ==> abs(x) <= x`]; + ALL_TAC] THEN + SUBGOAL_THEN `(&1 / t) % w + (t - &1) / t % x = y:real^N` ASSUME_TAC THENL + [EXPAND_TAC "w" THEN + REWRITE_TAC[VECTOR_ARITH + `b % (x + c % (y - x)) + a % x = + (a + b - b * c) % x + (b * c) % y`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_MUL_LID] THEN + ASM_SIMP_TAC[real_div; REAL_MUL_RINV; REAL_SUB_REFL; + VECTOR_MUL_LZERO; VECTOR_ADD_LID; + REAL_ARITH `(a - &1) * b + &1 * b - &1 = a * b - &1`]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex_on]) THEN + DISCH_THEN(MP_TAC o SPECL + [`w:real^N`; `x:real^N`; `&1 / t`; `(t - &1) / t`]) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_01] THEN + REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_SUB_ADD2; REAL_MUL_RINV] THEN + MATCH_MP_TAC(REAL_ARITH + `a * fw + (b - &1) * fx < e + ==> fy <= a * fw + b * fx ==> fy - fx < e`) THEN + ASM_SIMP_TAC[real_div; REAL_SUB_RDISTRIB; REAL_MUL_RINV; REAL_MUL_LID; + REAL_ARITH `a * x + y - a * y - y = a * (x - y)`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `!b. abs(x) <= b /\ abs(y) <= b /\ &2 * b < z ==> x - y < z`) THEN + EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[] THEN EXPAND_TAC "t" THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; REAL_ARITH `(a * b) * inv c = (b * inv c) * a`] THEN + ASM_REWRITE_TAC[GSYM real_div]; + + ABBREV_TAC `w:real^N = x - t % (y - x)` THEN + SUBGOAL_THEN `w:real^N IN s` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN EXPAND_TAC "w" THEN + REWRITE_TAC[dist; VECTOR_ARITH `x - (x - t) = t:real^N`] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN + REWRITE_TAC[REAL_ABS_NORM; real_div; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_MUL_RID; REAL_ARITH `&0 < x ==> abs(x) <= x`]; + ALL_TAC] THEN + SUBGOAL_THEN `(&1 / (&1 + t)) % w + t / (&1 + t) % y = x:real^N` + ASSUME_TAC THENL + [EXPAND_TAC "w" THEN + REWRITE_TAC[VECTOR_ARITH + `b % (x - c % (y - x)) + a % y = + (b * (&1 + c)) % x + (a - b * c) % y`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_MUL_LID] THEN + REWRITE_TAC[real_div; REAL_MUL_AC; REAL_MUL_LID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_RID]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex_on]) THEN + DISCH_THEN(MP_TAC o SPECL + [`w:real^N`; `y:real^N`; `&1 / (&1 + t)`; `t / (&1 + t)`]) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_01] THEN + REWRITE_TAC[real_div; GSYM REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_SUB_ADD2; REAL_MUL_RINV] THEN + MATCH_MP_TAC(REAL_ARITH + `a * fw + (b - &1) * fx < e + ==> fy <= a * fw + b * fx ==> fy - fx < e`) THEN + SUBGOAL_THEN `t * inv(&1 + t) - &1 = --(inv(&1 + t))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ARITH `(a * b - &1 = --b) <=> ((&1 + a) * b = &1)`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `(&1 * a) * x + --a * y = a * (x - y)`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `!b. abs(x) <= b /\ abs(y) <= b /\ &2 * b < z ==> x - y < z`) THEN + EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x < e * k ==> x < e * (&1 + k)`) THEN + EXPAND_TAC "t" THEN REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; REAL_ARITH `(a * b) * inv c = (b * inv c) * a`] THEN + ASM_REWRITE_TAC[GSYM real_div]]);; + +(* ------------------------------------------------------------------------- *) +(* Upper bound on a ball implies upper and lower bounds. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_BOUNDS_LEMMA = prove + (`!f x:real^N e. + f convex_on cball(x,e) /\ + (!y. y IN cball(x,e) ==> f(y) <= b) + ==> !y. y IN cball(x,e) ==> abs(f(y)) <= b + &2 * abs(f(x))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL + [ALL_TAC; + REWRITE_TAC[IN_CBALL] THEN ASM_MESON_TAC[DIST_POS_LE; REAL_LE_TRANS]] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [convex_on]) THEN + DISCH_THEN(MP_TAC o SPECL + [`y:real^N`; `&2 % x - y:real^N`; `&1 / &2`; `&1 / &2`]) THEN + REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB; GSYM REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[VECTOR_ARITH `y + x - y = x:real^N`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ABBREV_TAC `z = &2 % x - y:real^N` THEN + SUBGOAL_THEN `z:real^N IN cball(x,e)` ASSUME_TAC THENL + [UNDISCH_TAC `y:real^N IN cball(x,e)` THEN + EXPAND_TAC "z" THEN REWRITE_TAC[dist; IN_CBALL] THEN + REWRITE_TAC[VECTOR_ARITH `x - (&2 % x - y) = y - x`] THEN + REWRITE_TAC[NORM_SUB]; + ALL_TAC] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + FIRST_X_ASSUM(fun th -> + MAP_EVERY (MP_TAC o C SPEC th) [`y:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[CENTRE_IN_CBALL] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence a convex function on an open set is continuous. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_ON_CONTINUOUS = prove + (`!f s:real^N->bool. open s /\ f convex_on s ==> lift o f continuous_on s`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `d = e / &(dimindex(:N))` THEN + SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_DIV THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; DIMINDEX_GE_1; + ARITH_RULE `0 < d <=> 1 <= d`]; + ALL_TAC] THEN + SUBGOAL_THEN + `?b. !y:real^N. y IN interval[(x - lambda i. d),(x + lambda i. d)] + ==> f(y) <= b` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`x - (lambda i. d):real^N`; `x + (lambda i. d):real^N`] + CLOSED_INTERVAL_AS_CONVEX_HULL) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `c = {}:real^N->bool` THEN + ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN + MP_TAC(ISPEC `IMAGE (f:real^N->real) c` SUP_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + ABBREV_TAC `k = sup(IMAGE (f:real^N->real) c)` THEN + STRIP_TAC THEN EXISTS_TAC `k:real` THEN + MATCH_MP_TAC CONVEX_ON_CONVEX_HULL_BOUND THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_ON_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `cball (x:real^N,e)` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + X_GEN_TAC `z:real^N` THEN + REWRITE_TAC[REAL_ARITH `x - d <= z /\ z <= x + d <=> abs(x - z) <= d`] THEN + DISCH_TAC THEN REWRITE_TAC[dist] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum(1..dimindex(:N)) (\i. abs((x - z:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN + MATCH_MP_TAC SUM_BOUND_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; CARD_NUMSEG] THEN + ASM_SIMP_TAC[IN_NUMSEG; NOT_LT; DIMINDEX_GE_1; ADD_SUB; + VECTOR_SUB_COMPONENT]; + ALL_TAC] THEN + SUBGOAL_THEN `cball(x:real^N,d) SUBSET cball(x,e)` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_CBALL] THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `d <= e ==> x <= d ==> x <= e`) THEN + EXPAND_TAC "d" THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; + ARITH_RULE `0 < x <=> 1 <= x`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LE; DIMINDEX_GE_1]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y:real^N. y IN cball(x,d) ==> abs(f(y)) <= b + &2 * abs(f(x))` + ASSUME_TAC THENL + [MATCH_MP_TAC CONVEX_BOUNDS_LEMMA THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONVEX_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `y:real^N IN cball(x,d)` THEN REWRITE_TAC[IN_CBALL] THEN + REWRITE_TAC[IN_INTERVAL; IN_CBALL; dist] THEN DISCH_TAC THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `x - d <= z /\ z <= x + d <=> abs(x - z) <= d`] THEN + SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x - y:real^N)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]; + ALL_TAC] THEN + SUBGOAL_THEN `(lift o f) continuous_on (ball(x:real^N,d))` MP_TAC THENL + [MATCH_MP_TAC CONVEX_ON_BOUNDED_CONTINUOUS THEN REWRITE_TAC[OPEN_BALL] THEN + EXISTS_TAC `b + &2 * abs(f(x:real^N))` THEN + ASM_MESON_TAC[SUBSET; CONVEX_ON_SUBSET; SUBSET_TRANS; BALL_SUBSET_CBALL]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_BALL; CENTRE_IN_BALL]);; + +(* ------------------------------------------------------------------------- *) +(* Characterizations of convex functions in terms of sequents. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_ON_LEFT_SECANT_MUL,CONVEX_ON_RIGHT_SECANT_MUL = (CONJ_PAIR o prove) + (`(!f s:real^N->bool. + f convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN segment[a,b] + ==> (f x - f a) * norm(b - a) <= (f b - f a) * norm(x - a)) /\ + (!f s:real^N->bool. + f convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN segment[a,b] + ==> (f b - f a) * norm(b - x) <= (f b - f x) * norm(b - a))`, + CONJ_TAC THEN + REPEAT GEN_TAC THEN REWRITE_TAC[convex_on] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `a:real^N` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `b:real^N` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN + REWRITE_TAC[TAUT `a /\ x = y <=> x = y /\ a`; + TAUT `a /\ x = y /\ b <=> x = y /\ a /\ b`] THEN + REWRITE_TAC[REAL_ARITH `v + u = &1 <=> v = &1 - u`] THEN + REWRITE_TAC[FORALL_UNWIND_THM2; IMP_CONJ] THEN + REWRITE_TAC[REAL_SUB_LE] THEN + ASM_CASES_TAC `&0 <= u` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `u <= &1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH `((&1 - u) % a + u % b) - a:real^N = u % (b - a)`; + VECTOR_ARITH `b - ((&1 - u) % a + u % b):real^N = (&1 - u) % (b - a)`] THEN + REWRITE_TAC[NORM_MUL; REAL_MUL_ASSOC] THEN + (ASM_CASES_TAC `b:real^N = a` THENL + [ASM_REWRITE_TAC[VECTOR_SUB_REFL; REAL_SUB_REFL; + VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 <= u /\ u <= &1 ==> abs u = u /\ abs(&1 - u) = &1 - u`] THEN + REAL_ARITH_TAC]));; + +let CONVEX_ON_LEFT_SECANT,CONVEX_ON_RIGHT_SECANT = (CONJ_PAIR o prove) + (`(!f s:real^N->bool. + f convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN segment(a,b) + ==> (f x - f a) / norm(x - a) <= (f b - f a) / norm(b - a)) /\ + (!f s:real^N->bool. + f convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN segment(a,b) + ==> (f b - f a) / norm(b - a) <= (f b - f x) / norm(b - x))`, + CONJ_TAC THEN REPEAT GEN_TAC THENL + [REWRITE_TAC[CONVEX_ON_LEFT_SECANT_MUL]; + REWRITE_TAC[CONVEX_ON_RIGHT_SECANT_MUL]] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `a:real^N` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `b:real^N` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY; REAL_SUB_REFL; VECTOR_SUB_REFL; + NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_REFL] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[] THEN + REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + MAP_EVERY ASM_CASES_TAC [`x:real^N = a`; `x:real^N = b`] THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_SUB_REFL; VECTOR_SUB_REFL; NORM_0; + REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; + VECTOR_SUB_EQ] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Starlike sets and more stuff about line segments. *) +(* ------------------------------------------------------------------------- *) + +let starlike = new_definition + `starlike s <=> ?a. a IN s /\ !x. x IN s ==> segment[a,x] SUBSET s`;; + +let CONVEX_IMP_STARLIKE = prove + (`!s. convex s /\ ~(s = {}) ==> starlike s`, + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; starlike; GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[]);; + +let SEGMENT_CONVEX_HULL = prove + (`!a b. segment[a,b] = convex hull {a,b}`, + REPEAT GEN_TAC THEN + SIMP_TAC[CONVEX_HULL_INSERT; CONVEX_HULL_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + REWRITE_TAC[segment; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[REAL_LE_SUB_LADD; REAL_ADD_LID] THEN MESON_TAC[]);; + +let SEGMENT_FURTHEST_LE = prove + (`!a b x y:real^N. + x IN segment[a,b] ==> norm(y - x) <= norm(y - a) \/ + norm(y - x) <= norm(y - b)`, + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`y:real^N`; `{a:real^N,b}`] SIMPLEX_FURTHEST_LE) THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_MESON_TAC[NORM_SUB]);; + +let SEGMENT_BOUND = prove + (`!a b x:real^N. + x IN segment[a,b] ==> norm(x - a) <= norm(b - a) /\ + norm(x - b) <= norm(b - a)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real^N`; `b:real^N`; `x:real^N`] SEGMENT_FURTHEST_LE) THENL + [DISCH_THEN(MP_TAC o SPEC `a:real^N`); + DISCH_THEN(MP_TAC o SPEC `b:real^N`)] THEN + REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_LE_TRANS; NORM_SUB]);; + +let BETWEEN_IN_CONVEX_HULL = prove + (`!x a b:real^N. between x (a,b) <=> x IN convex hull {a,b}`, + REWRITE_TAC[BETWEEN_IN_SEGMENT; SEGMENT_CONVEX_HULL]);; + +let STARLIKE_LINEAR_IMAGE = prove + (`!f s. starlike s /\ linear f ==> starlike(IMAGE f s)`, + REWRITE_TAC[starlike; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + SIMP_TAC[CLOSED_SEGMENT_LINEAR_IMAGE] THEN SET_TAC[]);; + +let STARLIKE_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (starlike (IMAGE f s) <=> starlike s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE STARLIKE_LINEAR_IMAGE));; + +add_linear_invariants [STARLIKE_LINEAR_IMAGE_EQ];; + +let STARLIKE_TRANSLATION_EQ = prove + (`!a s. starlike (IMAGE (\x. a + x) s) <=> starlike s`, + REWRITE_TAC[starlike] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [STARLIKE_TRANSLATION_EQ];; + +let BETWEEN_LINEAR_IMAGE_EQ = prove + (`!f x y z. linear f /\ (!x y. f x = f y ==> x = y) + ==> (between (f x) (f y,f z) <=> between x (y,z))`, + SIMP_TAC[BETWEEN_IN_SEGMENT; CLOSED_SEGMENT_LINEAR_IMAGE] THEN SET_TAC[]);; + +add_linear_invariants [BETWEEN_LINEAR_IMAGE_EQ];; + +let BETWEEN_TRANSLATION = prove + (`!a x y. between (a + x) (a + y,a + z) <=> between x (y,z)`, + REWRITE_TAC[between] THEN NORM_ARITH_TAC);; + +add_translation_invariants [STARLIKE_TRANSLATION_EQ];; + +let STARLIKE_CLOSURE = prove + (`!s:real^N->bool. starlike s ==> starlike(closure s)`, + GEN_TAC THEN REWRITE_TAC[starlike; SUBSET; segment; FORALL_IN_GSPEC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + DISCH_TAC THEN X_GEN_TAC `u:real` THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(&1 - u) % a + u % y:real^N` THEN + ASM_SIMP_TAC[dist; NORM_MUL; VECTOR_ARITH + `(v % a + u % y) - (v % a + u % z):real^N = u % (y - z)`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LET_TRANS)) THEN + REWRITE_TAC[dist; REAL_ARITH `u * n <= n <=> &0 <= n * (&1 - u)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REAL_ARITH_TAC);; + +let STARLIKE_UNIV = prove + (`starlike(:real^N)`, + MESON_TAC[CONVEX_IMP_STARLIKE; CONVEX_UNIV; + BOUNDED_EMPTY; NOT_BOUNDED_UNIV]);; + +let STARLIKE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + starlike s /\ starlike t ==> starlike(s PCROSS t)`, + SIMP_TAC[starlike; EXISTS_IN_PCROSS; SUBSET; IN_SEGMENT] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[FORALL_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_UNWIND_THM2; IMP_IMP] THEN + REWRITE_TAC[GSYM PASTECART_CMUL; PASTECART_ADD] THEN + REWRITE_TAC[PASTECART_IN_PCROSS] THEN MESON_TAC[]);; + +let STARLIKE_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + starlike(s PCROSS t) <=> starlike s /\ starlike t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_REWRITE_TAC[PCROSS_EMPTY] THEN MESON_TAC[starlike; NOT_IN_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[PCROSS_EMPTY] THEN MESON_TAC[starlike; NOT_IN_EMPTY]; + ALL_TAC] THEN + EQ_TAC THEN REWRITE_TAC[STARLIKE_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] STARLIKE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] STARLIKE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let BETWEEN_DIST_LT = prove + (`!r a b c:real^N. + dist(c,a) < r /\ dist(c,b) < r /\ between x (a,b) ==> dist(c,x) < r`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `convex hull {a,b} SUBSET ball(c:real^N,r)` MP_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[CONVEX_BALL; INSERT_SUBSET; EMPTY_SUBSET; IN_BALL]; + ASM_SIMP_TAC[SUBSET; GSYM BETWEEN_IN_CONVEX_HULL; IN_BALL]]);; + +let BETWEEN_DIST_LE = prove + (`!r a b c:real^N. + dist(c,a) <= r /\ dist(c,b) <= r /\ between x (a,b) ==> dist(c,x) <= r`, + + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `convex hull {a,b} SUBSET cball(c:real^N,r)` MP_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[CONVEX_CBALL; INSERT_SUBSET; EMPTY_SUBSET; IN_CBALL]; + ASM_SIMP_TAC[SUBSET; GSYM BETWEEN_IN_CONVEX_HULL; IN_CBALL]]);; + +let BETWEEN_NORM_LT = prove + (`!r a b x:real^N. + norm a < r /\ norm b < r /\ between x (a,b) ==> norm x < r`, + REWRITE_TAC[GSYM(CONJUNCT2(SPEC_ALL DIST_0)); BETWEEN_DIST_LT]);; + +let BETWEEN_NORM_LE = prove + (`!r a b x:real^N. + norm a <= r /\ norm b <= r /\ between x (a,b) ==> norm x <= r`, + REWRITE_TAC[GSYM(CONJUNCT2(SPEC_ALL DIST_0)); BETWEEN_DIST_LE]);; + +let UNION_SEGMENT = prove + (`!a b c:real^N. + b IN segment[a,c] + ==> segment[a,b] UNION segment[b,c] = segment[a,c]`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL + [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; UNION_IDEMPOT]; + ONCE_REWRITE_TAC[UNION_COMM] THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_HULL_EXCHANGE_UNION) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[IMAGE_CLAUSES; UNIONS_2] THEN + BINOP_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Shrinking towards the interior of a convex set. *) +(* ------------------------------------------------------------------------- *) + +let IN_INTERIOR_CONVEX_SHRINK = prove + (`!s e x c:real^N. + convex s /\ c IN interior s /\ + x IN s /\ &0 < e /\ e <= &1 + ==> x - e % (x - c) IN interior s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + REWRITE_TAC[IN_INTERIOR; SUBSET; IN_BALL; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e * d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y':real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / e) % y' - ((&1 - e) / e) % x:real^N`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `norm (x - e % (x - c) - y':real^N) < e * d` THEN + SUBGOAL_THEN `x - e % (x - c) - y':real^N = + e % (c - (&1 / e % y' - (&1 - e) / e % x))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; + REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; + ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL_EQ; real_abs; REAL_LT_IMP_LE]]; + DISCH_TAC THEN + SUBGOAL_THEN `y' = (&1 - (&1 - e)) % (&1 / e % y' - (&1 - e) / e % x) + + (&1 - e) % x:real^N` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `&1 - (&1 - e) = e`; VECTOR_SUB_LDISTRIB; + VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + VECTOR_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; + +let IN_INTERIOR_CLOSURE_CONVEX_SHRINK = prove + (`!s e x c:real^N. + convex s /\ c IN interior s /\ + x IN closure s /\ &0 < e /\ e <= &1 + ==> x - e % (x - c) IN interior s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ norm(y - x) * (&1 - e) < e * d` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `(x:real^N) IN s` THENL + [EXISTS_TAC `x:real^N` THEN + ASM_SIMP_TAC[REAL_LT_MUL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [closure]) THEN + ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM; LIMPT_APPROACHABLE; dist] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `e <= &1 ==> e = &1 \/ e < &1`)) THEN + ASM_SIMP_TAC[REAL_SUB_REFL; GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THENL + [DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_01]; + DISCH_THEN(MP_TAC o SPEC `(e * d) / (&1 - e)`)] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT; REAL_MUL_LZERO; REAL_LT_MUL; + REAL_MUL_LID] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `z:real^N = c + ((&1 - e) / e) % (x - y)` THEN + SUBGOAL_THEN `x - e % (x - c):real^N = y - e % (y - z)` SUBST1_TAC THENL + [EXPAND_TAC "z" THEN + REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC IN_INTERIOR_CONVEX_SHRINK THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o + MATCH_MP SUBSET_INTERIOR) THEN + SIMP_TAC[INTERIOR_OPEN; OPEN_BALL] THEN + REWRITE_TAC[IN_BALL; dist] THEN EXPAND_TAC "z" THEN + REWRITE_TAC[NORM_ARITH `norm(c - (c + x)) = norm(x)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ] THEN + ASM_MESON_TAC[REAL_MUL_SYM; NORM_SUB]);; + +let IN_INTERIOR_CLOSURE_CONVEX_SEGMENT = prove + (`!s a b:real^N. + convex s /\ a IN interior s /\ b IN closure s + ==> segment(a,b) SUBSET interior s`, + REWRITE_TAC[SUBSET; IN_SEGMENT] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % a + u % b:real^N = b - (&1 - u) % (b - a)`] THEN + MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Relative interior of a set. *) +(* ------------------------------------------------------------------------- *) + +let relative_interior = new_definition + `relative_interior s = + {x | ?t. open_in (subtopology euclidean (affine hull s)) t /\ + x IN t /\ t SUBSET s}`;; + +let relative_frontier = new_definition + `relative_frontier s = closure s DIFF relative_interior s`;; + +let RELATIVE_INTERIOR = prove + (`!s. relative_interior s = + {x | x IN s /\ + ?t. open t /\ x IN t /\ t INTER (affine hull s) SUBSET s}`, + REWRITE_TAC[EXTENSION; relative_interior; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> b /\ a /\ c /\ d`] THEN + REWRITE_TAC[UNWIND_THM2; SUBSET; IN_INTER; RIGHT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN ABS_TAC THEN MESON_TAC[HULL_INC]);; + +let RELATIVE_INTERIOR_EQ = prove + (`!s. relative_interior s = s <=> + open_in(subtopology euclidean (affine hull s)) s`, + GEN_TAC THEN REWRITE_TAC[EXTENSION; relative_interior; IN_ELIM_THM] THEN + GEN_REWRITE_TAC RAND_CONV [OPEN_IN_SUBOPEN] THEN MESON_TAC[SUBSET]);; + +let RELATIVE_INTERIOR_OPEN_IN = prove + (`!s. open_in(subtopology euclidean (affine hull s)) s + ==> relative_interior s = s`, + REWRITE_TAC[RELATIVE_INTERIOR_EQ]);; + +let RELATIVE_INTERIOR_EMPTY = prove + (`relative_interior {} = {}`, + SIMP_TAC[RELATIVE_INTERIOR_OPEN_IN; OPEN_IN_EMPTY]);; + +let RELATIVE_FRONTIER_EMPTY = prove + (`relative_frontier {} = {}`, + REWRITE_TAC[relative_frontier; CLOSURE_EMPTY; EMPTY_DIFF]);; + +let RELATIVE_INTERIOR_AFFINE = prove + (`!s:real^N->bool. affine s ==> relative_interior s = s`, + SIMP_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_SUBTOPOLOGY_REFL; HULL_P] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; + +let RELATIVE_INTERIOR_UNIV = prove + (`!s. relative_interior(affine hull s) = affine hull s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_OPEN_IN THEN + REWRITE_TAC[HULL_HULL; OPEN_IN_SUBTOPOLOGY_REFL] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; + +let OPEN_IN_RELATIVE_INTERIOR = prove + (`!s. open_in (subtopology euclidean (affine hull s)) + (relative_interior s)`, + GEN_TAC THEN REWRITE_TAC[relative_interior] THEN + GEN_REWRITE_TAC I [OPEN_IN_SUBOPEN] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let RELATIVE_INTERIOR_SUBSET = prove + (`!s. (relative_interior s) SUBSET s`, + REWRITE_TAC[SUBSET; relative_interior; IN_ELIM_THM] THEN MESON_TAC[]);; + +let OPEN_IN_SET_RELATIVE_INTERIOR = prove + (`!s:real^N->bool. open_in (subtopology euclidean s) (relative_interior s)`, + GEN_TAC THEN MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; RELATIVE_INTERIOR_SUBSET; + HULL_SUBSET]);; + +let SUBSET_RELATIVE_INTERIOR = prove + (`!s t. s SUBSET t /\ affine hull s = affine hull t + ==> (relative_interior s) SUBSET (relative_interior t)`, + REWRITE_TAC[relative_interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let RELATIVE_INTERIOR_MAXIMAL = prove + (`!s t. t SUBSET s /\ + open_in(subtopology euclidean (affine hull s)) t + ==> t SUBSET (relative_interior s)`, + REWRITE_TAC[relative_interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let RELATIVE_INTERIOR_UNIQUE = prove + (`!s t. t SUBSET s /\ + open_in(subtopology euclidean (affine hull s)) t /\ + (!t'. t' SUBSET s /\ + open_in(subtopology euclidean (affine hull s)) t' + ==> t' SUBSET t) + ==> (relative_interior s = t)`, + MESON_TAC[SUBSET_ANTISYM; RELATIVE_INTERIOR_MAXIMAL; RELATIVE_INTERIOR_SUBSET; + OPEN_IN_RELATIVE_INTERIOR]);; + +let IN_RELATIVE_INTERIOR = prove + (`!x:real^N s. + x IN relative_interior s <=> + x IN s /\ ?e. &0 < e /\ (ball(x,e) INTER (affine hull s)) SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[relative_interior; IN_ELIM_THM] THEN + REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> b /\ a /\ c /\ d`] THEN + REWRITE_TAC[UNWIND_THM2; SUBSET; IN_INTER] THEN EQ_TAC THENL + [ASM_MESON_TAC[SUBSET; OPEN_CONTAINS_BALL]; + STRIP_TAC THEN EXISTS_TAC `ball(x:real^N,e)` THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; HULL_INC]]);; + +let IN_RELATIVE_INTERIOR_CBALL = prove + (`!x:real^N s. + x IN relative_interior s <=> + x IN s /\ ?e. &0 < e /\ (cball(x,e) INTER affine hull s) SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN + AP_TERM_TAC THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(x:real^N,e) INTER affine hull s` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; IN_CBALL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`]; + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `cball(x:real^N,e) INTER affine hull s` THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_BALL; IN_CBALL; REAL_LT_IMP_LE]]);; + +let OPEN_IN_SUBSET_RELATIVE_INTERIOR = prove + (`!s t. open_in(subtopology euclidean (affine hull t)) s + ==> (s SUBSET relative_interior t <=> s SUBSET t)`, + MESON_TAC[RELATIVE_INTERIOR_MAXIMAL; RELATIVE_INTERIOR_SUBSET; + SUBSET_TRANS]);; + +let RELATIVE_INTERIOR_TRANSLATION = prove + (`!a:real^N s. + relative_interior (IMAGE (\x. a + x) s) = + IMAGE (\x. a + x) (relative_interior s)`, + REWRITE_TAC[relative_interior; OPEN_IN_OPEN] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [RELATIVE_INTERIOR_TRANSLATION];; + +let RELATIVE_FRONTIER_TRANSLATION = prove + (`!a:real^N s. + relative_frontier (IMAGE (\x. a + x) s) = + IMAGE (\x. a + x) (relative_frontier s)`, + REWRITE_TAC[relative_frontier] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [RELATIVE_FRONTIER_TRANSLATION];; + +let RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> relative_interior(IMAGE f s) = IMAGE f (relative_interior s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[relative_interior; AFFINE_HULL_LINEAR_IMAGE] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> c /\ a /\ b`] THEN + REWRITE_TAC[EXISTS_SUBSET_IMAGE] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_INJECTIVE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +add_linear_invariants [RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE];; + +let RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> relative_frontier(IMAGE f s) = IMAGE f (relative_frontier s)`, + REWRITE_TAC[relative_frontier] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE];; + +let RELATIVE_INTERIOR_EQ_EMPTY = prove + (`!s:real^N->bool. + convex s ==> (relative_interior s = {} <=> s = {})`, + SUBGOAL_THEN + `!s:real^N->bool. + vec 0 IN s /\ convex s ==> ~(relative_interior s = {})` + ASSUME_TAC THENL + [ALL_TAC; + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN + REWRITE_TAC[CONVEX_TRANSLATION_EQ; RELATIVE_INTERIOR_TRANSLATION] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; IN_IMAGE] THEN + DISCH_THEN MATCH_MP_TAC THEN EXISTS_TAC `a:real^N` THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC] THEN + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_RELATIVE_INTERIOR] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC + (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN + SUBGOAL_THEN `span(s:real^N->bool) = span b` SUBST_ALL_TAC THENL + [ASM_SIMP_TAC[SPAN_EQ] THEN ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ABBREV_TAC `n = dim(s:real^N->bool)` THEN + SUBGOAL_THEN + `!c. (!v. v IN b ==> &0 <= c(v)) /\ sum b c <= &1 + ==> vsum b (\v:real^N. c(v) % v) IN s` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN SUBGOAL_THEN + `vsum (vec 0 INSERT b :real^N->bool) + (\v. (if v = vec 0 then &1 - sum b c else c v) % v) IN s` + MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_EXPLICIT]) THEN + ASM_SIMP_TAC[INSERT_SUBSET; FINITE_INSERT; SUM_CLAUSES; + INDEPENDENT_NONZERO; IN_INSERT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_SUB_LE]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&1 - x + y = &1 <=> x = y`] THEN + MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[INDEPENDENT_NONZERO]; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[VSUM_CLAUSES; INDEPENDENT_NONZERO] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[INDEPENDENT_NONZERO]]; + ALL_TAC] THEN + ABBREV_TAC `a:real^N = vsum b (\v. inv(&2 * &n + &1) % v)` THEN + EXISTS_TAC `a:real^N` THEN CONJ_TAC THENL + [EXPAND_TAC "a" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[SUM_CONST; REAL_LE_INV_EQ; REAL_ARITH `&0 < &2 * &n + &1`; + GSYM real_div; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`b:real^N->bool`; `inv(&2 * &n + &1)`] + BASIS_COORDINATES_CONTINUOUS) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_SIMP_TAC[SUBSET; IN_INTER; IMP_CONJ_ALT] THEN + ASM_SIMP_TAC[SPAN_FINITE; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + GEN_TAC THEN X_GEN_TAC `u:real^N->real` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_BALL; dist] THEN + EXPAND_TAC "a" THEN ASM_SIMP_TAC[GSYM VSUM_SUB] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REWRITE_TAC[REAL_ARITH `abs(x - y) < x <=> &0 < y /\ abs(y) < &2 * x`] THEN + SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(CARD(b:real^N->bool)) * &2 * inv(&2 * &n + &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_BOUND THEN + ASM_SIMP_TAC[REAL_ARITH `abs x < a ==> x <= a`]; + ASM_REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &2 * &n + &1`] THEN + REAL_ARITH_TAC]);; + +let RELATIVE_INTERIOR_INTERIOR = prove + (`!s. affine hull s = (:real^N) + ==> relative_interior s = interior s`, + SIMP_TAC[relative_interior; interior; SUBTOPOLOGY_UNIV; OPEN_IN]);; + +let RELATIVE_INTERIOR_OPEN = prove + (`!s:real^N->bool. open s ==> relative_interior s = s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY] THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_OPEN; INTERIOR_EQ]);; + +let RELATIVE_INTERIOR_NONEMPTY_INTERIOR = prove + (`!s. ~(interior s = {}) ==> relative_interior s = interior s`, + MESON_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_NONEMPTY_INTERIOR]);; + +let RELATIVE_FRONTIER_NONEMPTY_INTERIOR = prove + (`!s. ~(interior s = {}) ==> relative_frontier s = frontier s`, + SIMP_TAC[relative_frontier; frontier; RELATIVE_INTERIOR_NONEMPTY_INTERIOR]);; + +let RELATIVE_FRONTIER_FRONTIER = prove + (`!s. affine hull s = (:real^N) ==> relative_frontier s = frontier s`, + SIMP_TAC[relative_frontier; frontier; RELATIVE_INTERIOR_INTERIOR]);; + +let AFFINE_HULL_CONVEX_HULL = prove + (`!s. affine hull (convex hull s) = affine hull s`, + GEN_TAC THEN MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[AFFINE_AFFINE_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_MESON_TAC[SUBSET_TRANS; HULL_SUBSET]);; + +let INTERIOR_SIMPLEX_NONEMPTY = prove + (`!s:real^N->bool. + independent s /\ s HAS_SIZE (dimindex(:N)) + ==> ?a. a IN interior(convex hull (vec 0 INSERT s))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `convex hull (vec 0 INSERT s):real^N->bool` + RELATIVE_INTERIOR_EQ_EMPTY) THEN + ASM_SIMP_TAC[AFFINE_HULL_CONVEX_HULL] THEN + REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; CONVEX_CONVEX_HULL; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; HULL_INC] THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC `span s:real^N->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_MONO THEN MATCH_MP_TAC(SET_RULE + `(a INSERT s) SUBSET P hull (a INSERT s) + ==> s SUBSET P hull (a INSERT s)`) THEN REWRITE_TAC[HULL_SUBSET]; + MATCH_MP_TAC(SET_RULE `UNIV SUBSET s ==> s = UNIV`) THEN + MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV] THEN + ASM_MESON_TAC[LE_REFL;HAS_SIZE]]);; + +let INTERIOR_SUBSET_RELATIVE_INTERIOR = prove + (`!s. interior s SUBSET relative_interior s`, + REWRITE_TAC[SUBSET; IN_INTERIOR; IN_RELATIVE_INTERIOR; IN_INTER] THEN + MESON_TAC[CENTRE_IN_BALL]);; + +let CONVEX_RELATIVE_INTERIOR = prove + (`!s:real^N->bool. convex s ==> convex(relative_interior s)`, + REWRITE_TAC[CONVEX_ALT; IN_RELATIVE_INTERIOR; IN_INTER; + SUBSET; IN_BALL; dist] THEN + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[TAUT `(a /\ b) /\ (c /\ d) /\ e ==> f <=> + a /\ c /\ e ==> b /\ d ==> f`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(MESON[] `(!d e. P d /\ Q e ==> R(min d e)) + ==> (?e. P e) /\ (?e. Q e) ==> (?e. R e)`) THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN + SUBST1_TAC(VECTOR_ARITH `z:real^N = + (&1 - u) % (z - u % (y - x)) + u % (z + (&1 - u) % (y - x))`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `norm x < e ==> norm x = y ==> y < e`)) THEN + AP_TERM_TAC THEN VECTOR_ARITH_TAC; + REWRITE_TAC[VECTOR_ARITH `a - b % c:real^N = a + --b % c`] THEN + MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]]));; + +let IN_RELATIVE_INTERIOR_CONVEX_SHRINK = prove + (`!s e x c:real^N. + convex s /\ c IN relative_interior s /\ + x IN s /\ &0 < e /\ e <= &1 + ==> x - e % (x - c) IN relative_interior s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN + REWRITE_TAC[IN_RELATIVE_INTERIOR; SUBSET; IN_INTER; IN_BALL; dist] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `x - e % (x - c):real^N = (&1 - e) % x + e % c`] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `e * d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y':real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(&1 / e) % y' - ((&1 - e) / e) % x:real^N`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [UNDISCH_TAC `norm (x - e % (x - c) - y':real^N) < e * d` THEN + SUBGOAL_THEN `x - e % (x - c) - y':real^N = + e % (c - (&1 / e % y' - (&1 - e) / e % x))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; + REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC; + ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL_EQ; real_abs; REAL_LT_IMP_LE]]; + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `a % y - (b - c) % x:real^N = + (c - b) % x + a % y`] THEN + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + ASM_SIMP_TAC[HULL_INC]]; + DISCH_TAC THEN + SUBGOAL_THEN `y' = (&1 - (&1 - e)) % (&1 / e % y' - (&1 - e) / e % x) + + (&1 - e) % x:real^N` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `&1 - (&1 - e) = e`; VECTOR_SUB_LDISTRIB; + VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + VECTOR_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; + +let IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK = prove + (`!s e x c:real^N. + convex s /\ c IN relative_interior s /\ + x IN closure s /\ &0 < e /\ e <= &1 + ==> x - e % (x - c) IN relative_interior s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ norm(y - x) * (&1 - e) < e * d` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `(x:real^N) IN s` THENL + [EXISTS_TAC `x:real^N` THEN + ASM_SIMP_TAC[REAL_LT_MUL; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [closure]) THEN + ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM; LIMPT_APPROACHABLE; dist] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `e <= &1 ==> e = &1 \/ e < &1`)) THEN + ASM_SIMP_TAC[REAL_SUB_REFL; GSYM REAL_LT_RDIV_EQ; REAL_SUB_LT] THENL + [DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_01]; + DISCH_THEN(MP_TAC o SPEC `(e * d) / (&1 - e)`)] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT; REAL_MUL_LZERO; REAL_LT_MUL; + REAL_MUL_LID] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `z:real^N = c + ((&1 - e) / e) % (x - y)` THEN + SUBGOAL_THEN `x - e % (x - c):real^N = y - e % (y - z)` SUBST1_TAC THENL + [EXPAND_TAC "z" THEN + REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CONVEX_SHRINK THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `dist(c:real^N,z) < d` ASSUME_TAC THENL + [EXPAND_TAC "z" THEN + REWRITE_TAC[NORM_ARITH `dist(c:real^N,c + x) = norm x`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + REWRITE_TAC[REAL_ARITH `a / b * c:real = (c * a) / b`] THEN + ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LT_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(z:real^N) IN affine hull s` ASSUME_TAC THENL + [EXPAND_TAC "z" THEN MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC] THEN + MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t = s ==> x IN s`) THEN + EXISTS_TAC `closure(affine hull s):real^N->bool` THEN + SIMP_TAC[CLOSURE_EQ; CLOSED_AFFINE_HULL] THEN + ASM_MESON_TAC[SUBSET_CLOSURE; HULL_INC; SUBSET]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_BALL; IN_INTER; SUBSET]; ALL_TAC] THEN + EXISTS_TAC `d - dist(c:real^N,z)` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_INTER] THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + UNDISCH_TAC `dist(c:real^N,z) < d` THEN REWRITE_TAC[IN_BALL] THEN + NORM_ARITH_TAC);; + +let IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT = prove + (`!s a b:real^N. + convex s /\ a IN relative_interior s /\ b IN closure s + ==> segment(a,b) SUBSET relative_interior s`, + REWRITE_TAC[SUBSET; IN_SEGMENT] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % a + u % b:real^N = b - (&1 - u) % (b - a)`] THEN + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let CONVEX_OPEN_SEGMENT_CASES = prove + (`!s a b:real^N. + convex s /\ a IN closure s /\ b IN closure s + ==> segment(a,b) SUBSET relative_frontier s \/ + segment(a,b) SUBSET relative_interior s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[relative_frontier] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET c /\ (!a. a IN i /\ a IN s ==> s SUBSET i) + ==> s SUBSET c DIFF i \/ s SUBSET i`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_OPEN_SEGMENT; CONVEX_CLOSURE]; + X_GEN_TAC `c:real^N` THEN ONCE_REWRITE_TAC[segment]] THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; DE_MORGAN_THM; NOT_IN_EMPTY] THEN + STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNION_SEGMENT) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N`] + IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `b:real^N` th) THEN MP_TAC(SPEC `a:real^N` th)) THEN + ASM_REWRITE_TAC[SEGMENT_SYM; CONJUNCT2 segment] THEN ASM SET_TAC[]);; + +let RELATIVE_INTERIOR_SING = prove + (`!a. relative_interior {a} = {a}`, + GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `s SUBSET {a} /\ ~(s = {}) ==> s = {a}`) THEN + SIMP_TAC[RELATIVE_INTERIOR_SUBSET; RELATIVE_INTERIOR_EQ_EMPTY; + CONVEX_SING] THEN + SET_TAC[]);; + +let RELATIVE_FRONTIER_SING = prove + (`!a:real^N. relative_frontier {a} = {}`, + REWRITE_TAC[relative_frontier; RELATIVE_INTERIOR_SING; CLOSURE_SING] THEN + SET_TAC[]);; + +let RELATIVE_INTERIOR_CBALL = prove + (`!a r. relative_interior(cball(a,r)) = if r = &0 then {a} else ball(a,r)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[REAL_LT_IMP_NE; CBALL_EMPTY; BALL_EMPTY; + RELATIVE_INTERIOR_EMPTY; REAL_LT_IMP_LE] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[CBALL_SING; RELATIVE_INTERIOR_SING] THEN + REWRITE_TAC[GSYM INTERIOR_CBALL] THEN + MATCH_MP_TAC RELATIVE_INTERIOR_NONEMPTY_INTERIOR THEN + ASM_REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC);; + +let RELATIVE_INTERIOR_BALL = prove + (`!a r. relative_interior(ball(a,r)) = ball(a,r)`, + SIMP_TAC[RELATIVE_INTERIOR_OPEN; OPEN_BALL]);; + +let RELATIVE_FRONTIER_CBALL = prove + (`!a:real^N r. relative_frontier(cball(a,r)) = + if r = &0 then {} else sphere(a,r)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[CBALL_SING; RELATIVE_FRONTIER_SING] THEN + ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[CBALL_EMPTY; SPHERE_EMPTY; RELATIVE_FRONTIER_EMPTY] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR; INTERIOR_CBALL; + BALL_EQ_EMPTY; GSYM REAL_NOT_LT; FRONTIER_CBALL]);; + +let RELATIVE_FRONTIER_BALL = prove + (`!a:real^N r. relative_frontier(ball(a,r)) = + if r = &0 then {} else sphere(a,r)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; RELATIVE_FRONTIER_EMPTY] THEN + ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; SPHERE_EMPTY; + RELATIVE_FRONTIER_EMPTY] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR; INTERIOR_OPEN; OPEN_BALL; + BALL_EQ_EMPTY; GSYM REAL_NOT_LT; FRONTIER_BALL]);; + +let STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS = prove + (`!s t:real^N->bool. + convex s /\ ~(s = {}) /\ + relative_interior s SUBSET t /\ t SUBSET closure s + ==> starlike t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; REWRITE_TAC[starlike]] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `a:real^N` THEN + REPEAT STRIP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `a IN s /\ b IN s /\ segment[a,b] DIFF {a,b} SUBSET s + ==> segment[a:real^N,b] SUBSET s`) THEN + ASM_REWRITE_TAC[GSYM open_segment] THEN + ASM_MESON_TAC[IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; SUBSET]);; + +let RELATIVE_INTERIOR_PROLONG = prove + (`!s x y:real^N. + x IN relative_interior s /\ y IN s + ==> ?t. &1 < t /\ (y + t % (x - y)) IN s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` + STRIP_ASSUME_TAC)) THEN + ASM_CASES_TAC `y:real^N = x` THENL + [ASM_REWRITE_TAC[VECTOR_ARITH `y + t % (x - x):real^N = y`] THEN + EXISTS_TAC `&2` THEN CONV_TAC REAL_RAT_REDUCE_CONV; + EXISTS_TAC `&1 + e / norm(x - y:real^N)` THEN + ASM_SIMP_TAC[REAL_LT_ADDR; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN + REWRITE_TAC[VECTOR_ARITH + `y + (&1 + e) % (x - y):real^N = x + e % (x - y)`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; IN_INTER; IN_AFFINE_ADD_MUL_DIFF; + HULL_INC; IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let RELATIVE_INTERIOR_CONVEX_PROLONG = prove + (`!s. convex s + ==> relative_interior s = + {x:real^N | x IN s /\ + !y. y IN s ==> ?t. &1 < t /\ (y + t % (x - y)) IN s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [SIMP_TAC[RELATIVE_INTERIOR_PROLONG] THEN + MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; + STRIP_TAC THEN + SUBGOAL_THEN `?y:real^N. y IN relative_interior s` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[MEMBER_NOT_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN + ASM_CASES_TAC `y:real^N = x` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `y:real^N`; `y + t % (x - y):real^N`] + IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_SEGMENT; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `y:real^N = y + x <=> x = vec 0`; + VECTOR_ARITH `(&1 - u) % y + u % (y + t % (x - y)):real^N = + y + t % u % (x - y)`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `inv t:real` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_INV_EQ; + REAL_INV_LT_1; REAL_LT_IMP_NZ; REAL_ARITH `&1 < x ==> &0 < x`] THEN + VECTOR_ARITH_TAC]);; + +let RELATIVE_INTERIOR_EQ_CLOSURE = prove + (`!s:real^N->bool. + relative_interior s = closure s <=> affine s`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[RELATIVE_INTERIOR_EMPTY; CLOSURE_EMPTY; AFFINE_EMPTY] THEN + EQ_TAC THEN + SIMP_TAC[RELATIVE_INTERIOR_AFFINE; CLOSURE_CLOSED; CLOSED_AFFINE] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `relative_interior s = closure s + ==> relative_interior s SUBSET s /\ s SUBSET closure s + ==> relative_interior s = s /\ closure s = s`)) THEN + REWRITE_TAC[RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET] THEN + REWRITE_TAC[RELATIVE_INTERIOR_EQ; CLOSURE_EQ; GSYM AFFINE_HULL_EQ] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(s = {}) ==> s = {} \/ s = a ==> a = s`)) THEN + MP_TAC(ISPEC `affine hull s:real^N->bool` CONNECTED_CLOPEN) THEN + SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED; AFFINE_AFFINE_HULL] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[HULL_SUBSET]);; + +let RAY_TO_RELATIVE_FRONTIER = prove + (`!s a l:real^N. + bounded s /\ a IN relative_interior s /\ + (a + l) IN affine hull s /\ ~(l = vec 0) + ==> ?d. &0 < d /\ + (a + d % l) IN relative_frontier s /\ + !e. &0 <= e /\ e < d ==> (a + e % l) IN relative_interior s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[relative_frontier] THEN + MP_TAC(ISPEC + `{d | &0 < d /\ ~((a + d % l:real^N) IN relative_interior(s))}` INF) THEN + ABBREV_TAC + `d = inf {d | &0 < d /\ ~((a + d % l:real^N) IN relative_interior(s))}` THEN + SUBGOAL_THEN + `?e. &0 < e /\ !d. &0 <= d /\ d < e + ==> (a + d % l:real^N) IN relative_interior s` + (X_CHOOSE_THEN `k:real` (LABEL_TAC "0")) + THENL + [MP_TAC(ISPEC `s:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN + REWRITE_TAC[open_in; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / norm(l:real^N)` THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT] THEN X_GEN_TAC `x:real` THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN + ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN + ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; + REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a) = norm x`] THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o + MATCH_MP BOUNDED_SUBSET_BALL) THEN + REWRITE_TAC[SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B / norm(l:real^N)` THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [GSYM CONTRAPOS_THM]) THEN + REWRITE_TAC[REAL_NOT_LT] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; + REAL_DIV_RMUL; NORM_EQ_0] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "1") (LABEL_TAC "2")) THEN + EXISTS_TAC `d:real` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `k:real` THEN + ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_LT] THEN + ASM_MESON_TAC[VECTOR_ARITH `a + &0 % l:real^N = a`; + REAL_NOT_LT; REAL_LT_IMP_LE]; + DISCH_TAC] THEN + REWRITE_TAC[IN_DIFF] THEN CONJ_TAC THENL + [REWRITE_TAC[CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXISTS_TAC `a + (d - min d (x / &2 / norm(l:real^N))) % l` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < d ==> d - min d x < d`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT]; + REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = norm(x - y)`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < y /\ &0 < d ==> abs((d - min d x) - d) < y`) THEN + REWRITE_TAC[REAL_ARITH `x / &2 / y < x / y <=> &0 < x / y`] THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT]]; + DISCH_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` OPEN_IN_RELATIVE_INTERIOR) THEN + REWRITE_TAC[open_in; GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a + d % l:real^N` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "3"))) THEN + REMOVE_THEN "2" (MP_TAC o SPEC `d + e / norm(l:real^N)`) THEN + ASM_SIMP_TAC[NOT_IMP; REAL_ARITH `~(d + l <= d) <=> &0 < l`; + REAL_LT_DIV; NORM_POS_LT] THEN + X_GEN_TAC `x:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + ASM_CASES_TAC `x < d` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REMOVE_THEN "3" MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN + ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN + ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; + REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = norm(x - y)`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT] THEN + ASM_REAL_ARITH_TAC]]]);; + +let RAY_TO_FRONTIER = prove + (`!s a l:real^N. + bounded s /\ a IN interior s /\ ~(l = vec 0) + ==> ?d. &0 < d /\ (a + d % l) IN frontier s /\ + !e. &0 <= e /\ e < d ==> (a + e % l) IN interior s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN + SUBGOAL_THEN `interior s:real^N->bool = relative_interior s` SUBST1_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM relative_frontier] THEN + MATCH_MP_TAC RAY_TO_RELATIVE_FRONTIER THEN ASM_REWRITE_TAC[]] THEN + ASM_MESON_TAC[NOT_IN_EMPTY; RELATIVE_INTERIOR_NONEMPTY_INTERIOR; IN_UNIV; + AFFINE_HULL_NONEMPTY_INTERIOR]);; + +let RELATIVE_FRONTIER_NOT_SING = prove + (`!s a:real^N. bounded s ==> ~(relative_frontier s = {a})`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[RELATIVE_FRONTIER_EMPTY; NOT_INSERT_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN + ASM_CASES_TAC `s = {z:real^N}` THEN + ASM_REWRITE_TAC[RELATIVE_FRONTIER_SING; NOT_INSERT_EMPTY] THEN + SUBGOAL_THEN `?w:real^N. w IN s /\ ~(w = z)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN + SUBGOAL_THEN + `~((w:real^N) IN relative_frontier s /\ z IN relative_frontier s)` + MP_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN + MAP_EVERY UNDISCH_TAC + [`relative_frontier s = {a:real^N}`; `bounded(s:real^N->bool)`; + `~(w:real^N = z)`; `(z:real^N) IN s`; `(w:real^N) IN s`; + `~((w:real^N) IN relative_frontier s /\ z IN relative_frontier s)`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[DE_MORGAN_THM] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`z:real^N`; `w:real^N`] THEN + MATCH_MP_TAC(MESON[] + `(!w z. Q w z <=> Q z w) /\ (!w z. P z ==> Q w z) + ==> !w z. P w \/ P z ==> Q w z`) THEN + CONJ_TAC THENL [MESON_TAC[]; REPEAT GEN_TAC] THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + REWRITE_TAC[relative_frontier; IN_DIFF] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; CLOSURE_SUBSET]; DISCH_TAC] THEN + MP_TAC(GEN `d:real` + (ISPECL [`s:real^N->bool`; `z:real^N`; `d % (w - z):real^N`] + RAY_TO_RELATIVE_FRONTIER)) THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL; + HULL_INC; VECTOR_MUL_EQ_0] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `--(&1)` th)) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[IN_SING] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (STRIP_ASSUME_TAC o GSYM)) THEN + ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_MUL_ASSOC; VECTOR_SUB_EQ; + VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + ASM_REAL_ARITH_TAC);; + +let RELATIVE_INTERIOR_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + relative_interior(s PCROSS t) = + relative_interior s PCROSS relative_interior t`, + REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC + [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; RELATIVE_INTERIOR_EMPTY] THEN + REWRITE_TAC[relative_interior; AFFINE_HULL_PCROSS] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; + PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THENL + [ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool` + (CONJUNCTS_THEN ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (funpow 3 rand) SUBSET_PCROSS o snd) THEN + ASM SET_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `w:real^N->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(v:real^M->bool) PCROSS (w:real^N->bool)` THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS; SUBSET_PCROSS; OPEN_IN_PCROSS]]);; + +let RELATIVE_FRONTIER_EQ_EMPTY = prove + (`!s:real^N->bool. relative_frontier s = {} <=> affine s`, + GEN_TAC THEN REWRITE_TAC[relative_frontier] THEN + REWRITE_TAC[GSYM RELATIVE_INTERIOR_EQ_CLOSURE] THEN + MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; + +let DIAMETER_BOUNDED_BOUND_LT = prove + (`!s x y:real^N. + bounded s /\ x IN relative_interior s /\ y IN closure s /\ + ~(diameter s = &0) + ==> norm(x - y) < diameter s`, + let lemma = prove + (`!s x y:real^N. + bounded s /\ x IN relative_interior s /\ y IN s /\ + ~(diameter s = &0) + ==> norm(x - y) < diameter s`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `e:real` + STRIP_ASSUME_TAC)) THEN + ASM_SIMP_TAC[REAL_LT_LE; DIAMETER_BOUNDED_BOUND] THEN + ASM_CASES_TAC `y:real^N = x` THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `x + e / norm(x - y) % (x - y):real^N`) THEN + REWRITE_TAC[NOT_IMP; IN_INTER] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(x:real^M,x + y) = norm y`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; + NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_SIMP_TAC[HULL_INC; AFFINE_AFFINE_HULL]; + DISCH_TAC THEN MP_TAC(ISPECL + [`s:real^N->bool`; `x + e / norm(x - y) % (x - y):real^N`; `y:real^N`] + DIAMETER_BOUNDED_BOUND) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ARITH + `(x + e % (x - y)) - y:real^N = (&1 + e) % (x - y)`] THEN + SIMP_TAC[NORM_MUL; REAL_ARITH `~(a * n <= n) <=> &0 < n * (a - &1)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e ==> &0 < abs(&1 + e) - &1`) THEN + MATCH_MP_TAC REAL_LT_DIV THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`closure s:real^N->bool`; `x:real^N`; `y:real^N`] + lemma) THEN + ASM_SIMP_TAC[DIAMETER_CLOSURE; BOUNDED_CLOSURE] THEN + DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR THEN + REWRITE_TAC[CLOSURE_SUBSET; AFFINE_HULL_CLOSURE]);; + +let DIAMETER_ATTAINED_RELATIVE_FRONTIER = prove + (`!s:real^N->bool. + bounded s /\ ~(diameter s = &0) + ==> ?x y. x IN relative_frontier s /\ + y IN relative_frontier s /\ + norm(x - y) = diameter s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[DIAMETER_EMPTY; relative_frontier] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_COMPACT_ATTAINED) THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; CLOSURE_EQ_EMPTY; DIAMETER_CLOSURE] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` DIAMETER_BOUNDED_BOUND_LT) THENL + [DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`]); + DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `x:real^N`])] THEN + ASM_MESON_TAC[REAL_LT_REFL; NORM_SUB]);; + +let DIAMETER_RELATIVE_FRONTIER = prove + (`!s:real^N->bool. + bounded s /\ ~(?a. s = {a}) + ==> diameter(relative_frontier s) = diameter s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[RELATIVE_FRONTIER_EMPTY] THEN + REWRITE_TAC[relative_frontier] THEN + ASM_SIMP_TAC[GSYM DIAMETER_CLOSURE; GSYM REAL_LE_ANTISYM] THEN + ASM_SIMP_TAC[SUBSET_DIFF; DIAMETER_SUBSET; BOUNDED_CLOSURE] THEN + ASM_SIMP_TAC[DIAMETER_CLOSURE] THEN + MP_TAC(ISPEC `s:real^N->bool` DIAMETER_ATTAINED_RELATIVE_FRONTIER) THEN + ASM_SIMP_TAC[DIAMETER_EQ_0; relative_frontier] THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN + ASM_SIMP_TAC[BOUNDED_CLOSURE; BOUNDED_DIFF]);; + +let DIAMETER_ATTAINED_FRONTIER = prove + (`!s:real^N->bool. + bounded s /\ ~(diameter s = &0) + ==> ?x y. x IN frontier s /\ y IN frontier s /\ + norm(x - y) = diameter s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP DIAMETER_ATTAINED_RELATIVE_FRONTIER) THEN + REWRITE_TAC[frontier; relative_frontier; IN_DIFF] THEN + MESON_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET_RELATIVE_INTERIOR]);; + +let DIAMETER_FRONTIER = prove + (`!s:real^N->bool. bounded s ==> diameter(frontier s) = diameter s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `?a:real^N. s = {a}` THENL + [ASM_MESON_TAC[FRONTIER_SING]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `!r. r <= f /\ f <= s /\ r = s ==> f = s`) THEN + EXISTS_TAC `diameter(closure s DIFF relative_interior s:real^N->bool)` THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM DIAMETER_CLOSURE] THEN MATCH_MP_TAC DIAMETER_SUBSET THEN + ASM_SIMP_TAC[BOUNDED_FRONTIER] THEN REWRITE_TAC[frontier] THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN + SET_TAC[]; + ASM_SIMP_TAC[GSYM DIAMETER_CLOSURE] THEN MATCH_MP_TAC DIAMETER_SUBSET THEN + ASM_SIMP_TAC[BOUNDED_CLOSURE; frontier; SUBSET_DIFF]; + ASM_SIMP_TAC[DIAMETER_RELATIVE_FRONTIER; GSYM relative_frontier]]);; + +let DIAMETER_SPHERE = prove + (`!a:real^N r. diameter(sphere(a,r)) = if r < &0 then &0 else &2 * r`, + REWRITE_TAC[GSYM FRONTIER_CBALL] THEN + ASM_SIMP_TAC[DIAMETER_FRONTIER; BOUNDED_CBALL; DIAMETER_CBALL]);; + +let CLOSEST_POINT_IN_RELATIVE_INTERIOR = prove + (`!s x:real^N. + closed s /\ ~(s = {}) /\ x IN affine hull s + ==> ((closest_point s x) IN relative_interior s <=> + x IN relative_interior s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN + ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN + MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; + `closest_point s x - + (min (&1) (e / norm(closest_point s x - x))) % + (closest_point s x - x):real^N`] + CLOSEST_POINT_LE) THEN + ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH + `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_CBALL; IN_INTER] THEN CONJ_TAC THENL + [REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE]; + MATCH_MP_TAC IN_AFFINE_SUB_MUL_DIFF THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC]]; + REWRITE_TAC[NORM_MUL; REAL_ARITH + `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN + REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; + +let CLOSEST_POINT_IN_RELATIVE_FRONTIER = prove + (`!s x:real^N. + closed s /\ ~(s = {}) /\ x IN affine hull s DIFF relative_interior s + ==> closest_point s x IN relative_frontier s`, + SIMP_TAC[relative_frontier; IN_DIFF; CLOSEST_POINT_IN_RELATIVE_INTERIOR] THEN + MESON_TAC[CLOSURE_SUBSET; CLOSEST_POINT_IN_SET; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Interior, relative interior and closure interrelations. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_CLOSURE_INTERIOR = prove + (`!s:real^N->bool. + convex s /\ ~(interior s = {}) + ==> closure(interior s) = closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET_CLOSURE; INTERIOR_SUBSET] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL + [ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `b - min (e / &2 / norm(b - a)) (&1) % (b - a):real^N` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LE_REFL; REAL_LT_01]; + REWRITE_TAC[VECTOR_ARITH `b - x:real^N = b <=> x = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min x (&1) = &0)`); + REWRITE_TAC[NORM_ARITH `dist(b - x:real^N,b) = norm x`] THEN + REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / &2 / norm(b - a:real^N) * norm(b - a)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> abs(min x (&1)) <= x`); + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POS_LT; REAL_LT_IMP_NZ; + VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_OF_NUM_LT; + VECTOR_SUB_EQ; ARITH]);; + +let EMPTY_INTERIOR_SUBSET_HYPERPLANE = prove + (`!s. convex s /\ interior s = {} + ==> ?a:real^N b. ~(a = vec 0) /\ s SUBSET {x | a dot x = b}`, + let lemma = prove + (`!s. convex s /\ (vec 0) IN s /\ interior s = {} + ==> ?a:real^N b. ~(a = vec 0) /\ s SUBSET {x | a dot x = b}`, + GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` MP_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; MEMBER_NOT_EMPTY]; ALL_TAC] THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + ONCE_REWRITE_TAC[GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN + REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; GSYM NOT_LT] THEN + DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN EXISTS_TAC `&0` THEN + ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC]) in + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_MESON_TAC[EMPTY_SUBSET; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]; + ALL_TAC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. --a + x) s` lemma) THEN + ASM_REWRITE_TAC[CONVEX_TRANSLATION_EQ; INTERIOR_TRANSLATION; + IMAGE_EQ_EMPTY; IN_IMAGE; UNWIND_THM2; + VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; DOT_RADD] THEN + MESON_TAC[REAL_ARITH `a + x:real = b <=> x = b - a`]);; + +let CONVEX_INTERIOR_CLOSURE = prove + (`!s:real^N->bool. convex s ==> interior(closure s) = interior s`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interior(s:real^N->bool) = {}` THENL + [MP_TAC(ISPEC `s:real^N->bool` EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN + EXISTS_TAC `interior {x:real^N | a dot x = b}` THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[INTERIOR_HYPERPLANE]] THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_REWRITE_TAC[CLOSED_HYPERPLANE]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET_INTERIOR; CLOSURE_SUBSET] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN + MP_TAC(ASSUME `(b:real^N) IN interior(closure s)`) THEN + GEN_REWRITE_TAC LAND_CONV [IN_INTERIOR_CBALL] THEN + REWRITE_TAC[SUBSET; IN_CBALL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `b + e / norm(b - a) % (b - a):real^N`) THEN + ASM_SIMP_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`; NORM_MUL; + REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ; + REAL_ARITH `&0 < e ==> abs e <= e`] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `b = (b + e / norm(b - a) % (b - a)) - + e / norm(b - a) / (&1 + e / norm(b - a)) % + ((b + e / norm(b - a) % (b - a)) - a):real^N` + SUBST1_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `b = (b + e % (b - a)) - d % ((b + e % (b - a)) - a) <=> + (e - d * (&1 + e)) % (b - a) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0]; + MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_DIV; NORM_POS_LT; + VECTOR_SUB_EQ; REAL_ARITH `&0 < x ==> &0 < &1 + x`; + REAL_ARITH `&0 < x ==> ~(&1 + x = &0)`; + REAL_MUL_LID; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; + REAL_LT_IMP_NZ; REAL_LE_ADDL; NORM_POS_LE; REAL_SUB_REFL]);; + +let FRONTIER_CLOSURE_CONVEX = prove + (`!s:real^N->bool. convex s ==> frontier(closure s) = frontier s`, + SIMP_TAC[frontier; CLOSURE_CLOSURE; CONVEX_INTERIOR_CLOSURE]);; + +let CONVEX_CLOSURE_RELATIVE_INTERIOR = prove + (`!s:real^N->bool. + convex s ==> closure(relative_interior s) = closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET_CLOSURE; RELATIVE_INTERIOR_SUBSET] THEN + ASM_CASES_TAC `relative_interior(s:real^N->bool) = {}` THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; SUBSET_REFL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL + [ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `b - min (e / &2 / norm(b - a)) (&1) % (b - a):real^N` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LE_REFL; REAL_LT_01]; + REWRITE_TAC[VECTOR_ARITH `b - x:real^N = b <=> x = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(min x (&1) = &0)`); + REWRITE_TAC[NORM_ARITH `dist(b - x:real^N,b) = norm x`] THEN + REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / &2 / norm(b - a:real^N) * norm(b - a)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> abs(min x (&1)) <= x`); + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POS_LT; REAL_LT_IMP_NZ; + VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_OF_NUM_LT; + VECTOR_SUB_EQ; ARITH]);; + +let AFFINE_HULL_RELATIVE_INTERIOR = prove + (`!s. convex s + ==> affine hull (relative_interior s) = affine hull s`, + MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; AFFINE_HULL_CLOSURE]);; + +let CONVEX_RELATIVE_INTERIOR_CLOSURE = prove + (`!s:real^N->bool. + convex s ==> relative_interior(closure s) = relative_interior s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CLOSURE_EMPTY; RELATIVE_INTERIOR_EMPTY] THEN + SUBGOAL_THEN `?a:real^N. a IN relative_interior s` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[MEMBER_NOT_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[IN_RELATIVE_INTERIOR; AFFINE_HULL_CLOSURE; SUBSET] THEN + MESON_TAC[CLOSURE_SUBSET; SUBSET]] THEN + X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN + MP_TAC(ASSUME `(b:real^N) IN relative_interior(closure s)`) THEN + GEN_REWRITE_TAC LAND_CONV [IN_RELATIVE_INTERIOR_CBALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_INTER; LEFT_IMP_EXISTS_THM; + AFFINE_HULL_CLOSURE] THEN + X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `b:real^N = a` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `b + e / norm(b - a) % (b - a):real^N`) THEN + ASM_SIMP_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`; NORM_MUL; + REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ; + REAL_ARITH `&0 < e ==> abs e <= e`] THEN + ANTS_TAC THENL + [MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_MESON_TAC[SUBSET; AFFINE_AFFINE_HULL; RELATIVE_INTERIOR_SUBSET; + CLOSURE_SUBSET_AFFINE_HULL; HULL_INC]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `b = (b + e / norm(b - a) % (b - a)) - + e / norm(b - a) / (&1 + e / norm(b - a)) % + ((b + e / norm(b - a) % (b - a)) - a):real^N` + SUBST1_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `b = (b + e % (b - a)) - d % ((b + e % (b - a)) - a) <=> + (e - d * (&1 + e)) % (b - a) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0]; + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_DIV; NORM_POS_LT; + VECTOR_SUB_EQ; REAL_ARITH `&0 < x ==> &0 < &1 + x`; + REAL_ARITH `&0 < x ==> ~(&1 + x = &0)`; + REAL_MUL_LID; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; + REAL_LT_IMP_NZ; REAL_LE_ADDL; NORM_POS_LE; REAL_SUB_REFL]);; + +let RELATIVE_FRONTIER_CLOSURE = prove + (`!s. convex s ==> relative_frontier(closure s) = relative_frontier s`, + SIMP_TAC[relative_frontier; CLOSURE_CLOSURE; + CONVEX_RELATIVE_INTERIOR_CLOSURE]);; + +let RELATIVE_FRONTIER_RELATIVE_INTERIOR = prove + (`!s:real^N->bool. + convex s + ==> relative_frontier(relative_interior s) = relative_frontier s`, + ASM_MESON_TAC[RELATIVE_FRONTIER_CLOSURE; CONVEX_CLOSURE_RELATIVE_INTERIOR; + CONVEX_RELATIVE_INTERIOR]);; + +let CONNECTED_INTER_RELATIVE_FRONTIER = prove + (`!s t:real^N->bool. + connected s /\ s SUBSET affine hull t /\ + ~(s INTER t = {}) /\ ~(s DIFF t = {}) + ==> ~(s INTER relative_frontier t = {})`, + REWRITE_TAC[relative_frontier] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`s INTER relative_interior t:real^N->bool`; + `s DIFF closure t:real^N->bool`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN + EXISTS_TAC `affine hull t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_INTER THEN + REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; OPEN_IN_SUBTOPOLOGY_REFL] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]; + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]; + ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `i SUBSET t /\ t SUBSET c ==> (s INTER i) INTER (s DIFF c) = {}`) THEN + REWRITE_TAC[RELATIVE_INTERIOR_SUBSET; CLOSURE_SUBSET]; + MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN + ASM SET_TAC[]]);; + +let CLOSED_RELATIVE_FRONTIER = prove + (`!s:real^N->bool. closed(relative_frontier s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[relative_frontier] THEN + MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + REWRITE_TAC[CLOSED_AFFINE_HULL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN + REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_CLOSURE] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN + SIMP_TAC[SUBSET_CLOSURE; HULL_SUBSET; CLOSURE_EQ; CLOSED_AFFINE_HULL]);; + +let CLOSED_RELATIVE_BOUNDARY = prove + (`!s. closed s ==> closed(s DIFF relative_interior s)`, + MESON_TAC[CLOSED_RELATIVE_FRONTIER; relative_frontier; CLOSURE_CLOSED]);; + +let COMPACT_RELATIVE_BOUNDARY = prove + (`!s. compact s ==> compact(s DIFF relative_interior s)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_RELATIVE_BOUNDARY; + BOUNDED_DIFF]);; + +let BOUNDED_RELATIVE_FRONTIER = prove + (`!s:real^N->bool. bounded s ==> bounded(relative_frontier s)`, + REWRITE_TAC[relative_frontier] THEN + MESON_TAC[BOUNDED_CLOSURE; BOUNDED_SUBSET; SUBSET_DIFF]);; + +let COMPACT_RELATIVE_FRONTIER_BOUNDED = prove + (`!s:real^N->bool. bounded s ==> compact(relative_frontier s)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_RELATIVE_FRONTIER; + BOUNDED_RELATIVE_FRONTIER]);; + +let COMPACT_RELATIVE_FRONTIER = prove + (`!s:real^N->bool. compact s ==> compact(relative_frontier s)`, + SIMP_TAC[COMPACT_RELATIVE_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);; + +let CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE = prove + (`!s t. convex s /\ convex t + ==> (relative_interior s = relative_interior t <=> + closure s = closure t)`, + MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; + CONVEX_RELATIVE_INTERIOR_CLOSURE]);; + +let CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE = prove + (`!s t. convex s /\ convex t + ==> (relative_interior s = relative_interior t <=> + relative_interior s SUBSET t /\ t SUBSET closure s)`, + MESON_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR; + CONVEX_RELATIVE_INTERIOR_CLOSURE; SUBSET_CLOSURE; + SUBSET_ANTISYM; RELATIVE_INTERIOR_SUBSET; + CLOSURE_SUBSET; CLOSURE_CLOSURE]);; + +let RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX = prove + (`!f:real^M->real^N s. + linear f /\ convex s + ==> relative_interior(IMAGE f s) = IMAGE f (relative_interior s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [SUBGOAL_THEN + `relative_interior (IMAGE f (relative_interior s)) = + relative_interior (IMAGE (f:real^M->real^N) s)` + (fun th -> REWRITE_TAC[SYM th; RELATIVE_INTERIOR_SUBSET]) THEN + ASM_SIMP_TAC[CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE; + CONVEX_RELATIVE_INTERIOR; CONVEX_LINEAR_IMAGE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (relative_interior s)` THEN + SIMP_TAC[RELATIVE_INTERIOR_SUBSET; IMAGE_SUBSET]; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `IMAGE (f:real^M->real^N) (closure(relative_interior s))` THEN + ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN + ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET]]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN + DISCH_TAC THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_CONVEX_PROLONG; CONVEX_LINEAR_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [MATCH_MP_TAC FUN_IN_IMAGE THEN + ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; + ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^M->bool`; `z:real^M`; `x:real^M`] + RELATIVE_INTERIOR_PROLONG) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP FUN_IN_IMAGE) THEN + ASM_MESON_TAC[LINEAR_ADD; LINEAR_SUB; LINEAR_CMUL]]);; + +let CLOSURE_INTERS_CONVEX = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> convex s) /\ + ~(INTERS(IMAGE relative_interior f) = {}) + ==> closure(INTERS f) = INTERS(IMAGE closure f)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_INTERS_SUBSET] THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE] THEN + X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[CLOSURE_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `b:real^N = a` THENL + [EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[DIST_REFL; IN_INTERS] THEN + ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]; + ALL_TAC] THEN + EXISTS_TAC `b - min (&1 / &2) (e / &2 / norm(b - a)) % (b - a):real^N` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[NORM_ARITH `dist(b - a:real^N,b) = norm a`; NORM_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < a /\ &0 < x /\ x < y ==> abs(min a x) < y`) THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_HALF; REAL_LT_DIV; NORM_POS_LT; + VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[IN_INTERS] THEN X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC + (MESON[RELATIVE_INTERIOR_SUBSET; SUBSET] + `!x. x IN relative_interior s ==> x IN s`) THEN + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_HALF; REAL_LT_DIV; NORM_POS_LT; + VECTOR_SUB_EQ] THEN + REAL_ARITH_TAC);; + +let CLOSURE_INTERS_CONVEX_OPEN = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> convex s /\ open s) + ==> closure(INTERS f) = + if INTERS f = {} then {} + else INTERS(IMAGE closure f)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CLOSURE_EMPTY] THEN + MATCH_MP_TAC CLOSURE_INTERS_CONVEX THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(s = {}) ==> s = t ==> ~(t = {})`)) THEN + AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = x) ==> s = IMAGE f s`) THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_OPEN; INTERIOR_EQ]);; + +let CLOSURE_INTER_CONVEX = prove + (`!s t:real^N->bool. + convex s /\ convex t /\ + ~(relative_interior s INTER relative_interior t = {}) + ==> closure(s INTER t) = closure(s) INTER closure(t)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{s:real^N->bool,t}` CLOSURE_INTERS_CONVEX) THEN + ASM_SIMP_TAC[IMAGE_CLAUSES; INTERS_2] THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; + +let CLOSURE_INTER_CONVEX_OPEN = prove + (`!s t. convex s /\ open s /\ convex t /\ open t + ==> closure(s INTER t) = + if s INTER t = {} then {} else closure(s) INTER closure(t)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[CLOSURE_EMPTY] THEN + MATCH_MP_TAC CLOSURE_INTER_CONVEX THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_OPEN]);; + +let CLOSURE_CONVEX_INTER_SUPERSET = prove + (`!s t:real^N->bool. + convex s /\ ~(interior s = {}) /\ interior s SUBSET closure t + ==> closure(s INTER t) = closure s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET; SUBSET_INTER] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `closure(interior s):real^N->bool` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[CONVEX_CLOSURE_INTERIOR; SUBSET_REFL]; + ASM_SIMP_TAC[GSYM CLOSURE_OPEN_INTER_SUPERSET; OPEN_INTERIOR] THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN SET_TAC[]]);; + +let CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET = prove + (`!s:real^N->bool. + convex s /\ ~(interior s = {}) + ==> closure(s INTER + { inv(&2 pow n) % x | n,x | + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = + closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_CONVEX_INTER_SUPERSET THEN + ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; + +let CLOSURE_RATIONALS_IN_CONVEX_SET = prove + (`!s:real^N->bool. + convex s /\ ~(interior s = {}) + ==> closure(s INTER + { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }) = + closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_CONVEX_INTER_SUPERSET THEN + ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; SUBSET_UNIV]);; + +let RELATIVE_INTERIOR_CONVEX_INTER_AFFINE = prove + (`!s t:real^N->bool. + convex s /\ affine t /\ ~(interior s INTER t = {}) + ==> relative_interior(s INTER t) = interior s INTER t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN + GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[IN_INTER] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `(vec 0:real^N) IN t` THEN + ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN + MP_TAC(ISPECL [`t:real^N->bool`; `s:real^N->bool`] + (ONCE_REWRITE_RULE[INTER_COMM] + AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN + ASM_SIMP_TAC[SUBSPACE_IMP_AFFINE; IN_RELATIVE_INTERIOR_CBALL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTER; IN_INTERIOR_CBALL]] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_INTER] THEN + ASM_CASES_TAC `(x:real^N) IN s` THENL + [ASM_REWRITE_TAC[]; ASM_MESON_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]] THEN + EQ_TAC THENL [REWRITE_TAC[IN_CBALL]; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN + ASM_REWRITE_TAC[SUBSET; IN_CBALL]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `vec 0:real^N`; `(&1 + e / norm x) % x:real^N`] + IN_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[SUBSPACE_MUL] THEN + REWRITE_TAC[VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID; + NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; + REAL_DIV_RMUL; NORM_EQ_0] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; IN_INTERIOR_CBALL; IN_CBALL] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_SEGMENT] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + EXISTS_TAC `inv(&1 + e / norm(x:real^N))` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_DIV; NORM_POS_LT; VECTOR_MUL_LID; + REAL_LT_INV_EQ; REAL_MUL_LINV; REAL_INV_LT_1; REAL_ARITH + `&0 < x ==> &1 < &1 + x /\ &0 < &1 + x /\ ~(&1 + x = &0)`]]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphism of all convex compact sets with same affine dimension, and *) +(* in particular all those with nonempty interior. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_FRONTIER_LINE_LEMMA = prove + (`!s x. compact s /\ (vec 0 IN s) /\ ~(x = vec 0 :real^N) + ==> ?u. &0 <= u /\ (u % x) IN frontier s /\ + !v. u < v ==> ~((v % x) IN s)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`{y:real^N | ?u. &0 <= u /\ u <= b / norm(x) /\ (y = u % x)} INTER s`; + `vec 0:real^N`] + DISTANCE_ATTAINS_SUP) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + EXISTS_TAC `&0` THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL; REAL_LT_IMP_LE; + REAL_LT_DIV; NORM_POS_LT]] THEN + MATCH_MP_TAC COMPACT_INTER THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{y:real^N | ?u. &0 <= u /\ u <= b / norm(x) /\ (y = u % x)} = + IMAGE (\u. drop u % x) (interval [vec 0,lambda i. b / norm(x:real^N)])` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_INTERVAL] THEN + SIMP_TAC[LAMBDA_BETA] THEN + SIMP_TAC[DIMINDEX_1; ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN + REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL; DROP_VEC] THEN + REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]; + ALL_TAC] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> c /\ a /\ b /\ d`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC (BINDER_CONV o ONCE_DEPTH_CONV) [SWAP_FORALL_THM] THEN + SIMP_TAC[IMP_CONJ] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[IMP_IMP] THEN REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real` THEN + REWRITE_TAC[dist; VECTOR_SUB_LZERO; NORM_NEG; NORM_MUL] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[real_abs] THEN REPEAT STRIP_TAC THENL + [REWRITE_TAC[FRONTIER_STRADDLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + CONJ_TAC THENL + [EXISTS_TAC `u % x :real^N` THEN ASM_REWRITE_TAC[DIST_REFL]; + ALL_TAC] THEN + EXISTS_TAC `(u + (e / &2) / norm(x)) % x :real^N` THEN + REWRITE_TAC[dist; VECTOR_ARITH `u % x - (u + a) % x = --(a % x)`] THEN + ASM_SIMP_TAC[NORM_NEG; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_EQ_0; + REAL_DIV_RMUL; REAL_ABS_NUM; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; + ARITH; REAL_ARITH `abs e < e * &2 <=> &0 < e`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u + (e / &2) / norm(x:real^N)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ &0 <= u /\ u + e <= b + ==> ~(&0 <= u + e /\ u + e <= b ==> u + e <= u)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_POS_LT] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(u + (e / &2) / norm(x:real^N)) % x`) THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `v:real`) THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LET_TRANS; REAL_LT_IMP_LE]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `v % x:real^N`) THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN + REAL_ARITH_TAC);; + +let STARLIKE_COMPACT_PROJECTIVE = prove + (`!s:real^N->bool a. + compact s /\ a IN relative_interior s /\ + (!x. x IN s ==> segment(a,x) SUBSET relative_interior s) + ==> s DIFF relative_interior s homeomorphic + sphere(a,&1) INTER affine hull s /\ + s homeomorphic cball(a,&1) INTER affine hull s`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN + REWRITE_TAC[SUBSET; IMP_IMP; RIGHT_IMP_FORALL_THM] THEN + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^N u. x IN s /\ &0 <= u /\ u < &1 + ==> (u % x) IN relative_interior s` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH `&0 <= u <=> u = &0 \/ &0 < u`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(K ALL_TAC o SPECL [`x:real^N`; `x:real^N`])] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + RELATIVE_INTERIOR_SUBSET)) THEN + ABBREV_TAC `proj = \x:real^N. inv(norm(x)) % x` THEN + SUBGOAL_THEN + `!x:real^N y. (proj(x) = proj(y):real^N) /\ (norm x = norm y) <=> (x = y)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN + ASM_SIMP_TAC[NORM_EQ_0; NORM_0] THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [ASM_MESON_TAC[NORM_EQ_0]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + EXPAND_TAC "proj" THEN REWRITE_TAC[] THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `a % x = a % y <=> a % (x - y):real^N = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ]; + ALL_TAC] THEN + SUBGOAL_THEN + `(!x. x IN affine hull s ==> proj x IN affine hull s) /\ + (!x. ~(x = vec 0) ==> norm(proj x) = &1) /\ + (!x:real^N. proj x = vec 0 <=> x = vec 0)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "proj" THEN REWRITE_TAC[NORM_MUL; VECTOR_MUL_EQ_0] THEN + REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0; REAL_ABS_INV; REAL_ABS_NORM] THEN + SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN + MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; VECTOR_ADD_LID; HULL_INC]; + ALL_TAC] THEN + SUBGOAL_THEN `(proj:real^N->real^N) continuous_on (UNIV DELETE vec 0)` + ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[IN_DELETE; IN_UNIV] THEN EXPAND_TAC "proj" THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + ASM_SIMP_TAC[CONTINUOUS_AT_ID] THEN + REWRITE_TAC[GSYM(ISPEC `lift` o_DEF); + GSYM(ISPEC `inv:real->real` o_DEF)] THEN + MATCH_MP_TAC CONTINUOUS_AT_INV THEN + ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CONTINUOUS_AT_LIFT_NORM]; + ALL_TAC] THEN + ABBREV_TAC `usph = {x:real^N | x IN affine hull s /\ norm x = &1}` THEN + SUBGOAL_THEN ` sphere(vec 0:real^N,&1) INTER affine hull s = usph` + SUBST1_TAC THENL + [EXPAND_TAC "usph" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_SPHERE_0] THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN affine hull s /\ ~(x = vec 0) + ==> (proj:real^N->real^N) x IN usph` + ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?surf. homeomorphism (s DIFF relative_interior s,usph) + (proj:real^N->real^N,surf)` + MP_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN + ASM_SIMP_TAC[COMPACT_RELATIVE_BOUNDARY] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN + EXPAND_TAC "usph" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[HULL_INC]; + MAP_EVERY EXPAND_TAC ["proj"; "usph"] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`; `x:real^N`] + RAY_TO_RELATIVE_FRONTIER) THEN + REWRITE_TAC[relative_frontier] THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; CLOSURE_CLOSED; COMPACT_IMP_CLOSED; + VECTOR_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXPAND_TAC "proj" THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `d % x:real^N` THEN ASM_REWRITE_TAC[NORM_MUL] THEN + ASM_SIMP_TAC[REAL_MUL_RID; real_abs; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; + VECTOR_MUL_LID]]; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `y:real^N = vec 0` THENL [ASM SET_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `(proj:real^N->real^N) x = proj y` THEN + EXPAND_TAC "proj" THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH + `norm(x:real^N) = norm(y:real^N) \/ + norm x < norm y \/ norm y < norm x`) + THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_INV_EQ_0; NORM_EQ_0]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`y:real^N`; `norm(x:real^N) / norm(y:real^N)`]); + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`x:real^N`; `norm(y:real^N) / norm(x:real^N)`])] THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_LDIV_EQ; NORM_POS_LT; + REAL_MUL_LID] THEN + ASM_REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM); ALL_TAC] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID]]; + DISCH_THEN(fun th -> + CONJ_TAC THENL + [MESON_TAC[homeomorphic; th]; + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + SIMP_TAC[COMPACT_INTER_CLOSED; CLOSED_AFFINE_HULL; COMPACT_CBALL] THEN + MP_TAC th]) THEN + REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `surf:real^N->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^N. norm(x) % (surf:real^N->real^N)(proj(x))` THEN + REWRITE_TAC[]] THEN + UNDISCH_THEN + `(proj:real^N->real^N) continuous_on s DIFF relative_interior s` + (K ALL_TAC) THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + ASM_CASES_TAC `x = vec 0:real^N` THENL + [ASM_REWRITE_TAC[CONTINUOUS_WITHIN; VECTOR_MUL_LZERO; NORM_0] THEN + MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[LIM_WITHIN; o_THM; DIST_0; NORM_LIFT; REAL_ABS_NORM] THEN + MESON_TAC[]; + REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; IN_INTER; DIST_0; NORM_POS_LT] THEN + ASM SET_TAC[]]; + MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + REWRITE_TAC[INTER_SUBSET] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; CONTINUOUS_WITHIN_ID; o_DEF] THEN + SUBGOAL_THEN + `((surf:real^N->real^N) o (proj:real^N->real^N)) continuous_on + (affine hull s DELETE vec 0)` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; IN_DELETE; IN_UNIV; FORALL_IN_IMAGE] THEN + EXPAND_TAC "usph" THEN ASM_SIMP_TAC[IN_ELIM_THM]; + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[IN_DELETE] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; o_DEF] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_SET THEN + REWRITE_TAC[EVENTUALLY_AT] THEN EXISTS_TAC `norm(x:real^N)` THEN + ASM_REWRITE_TAC[IN_DELETE; IN_INTER; IN_CBALL; NORM_POS_LT] THEN + X_GEN_TAC `y:real^N` THEN + ASM_CASES_TAC `(y:real^N) IN affine hull s` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NORM_ARITH]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a x. &0 < a ==> (proj:real^N->real^N)(a % x) = proj x` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "proj" THEN + REWRITE_TAC[NORM_MUL; REAL_INV_MUL; VECTOR_MUL_ASSOC] THEN + SIMP_TAC[REAL_FIELD `&0 < a ==> (inv(a) * x) * a = x`; real_abs; + REAL_LT_IMP_LE]; + ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + ASM_CASES_TAC `y:real^N = vec 0` THENL + [ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_EQ_0; NORM_0; NORM_EQ_0] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_EQ_0; NORM_0; NORM_EQ_0] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_INTER; IN_CBALL_0] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> MP_TAC th THEN + MP_TAC(AP_TERM `proj:real^N->real^N` th)) THEN + ASM_SIMP_TAC[NORM_POS_LT; VECTOR_MUL_RCANCEL] THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN + X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; VECTOR_MUL_LZERO; IN_INTER] THEN + REWRITE_TAC[IN_CBALL_0; REAL_LE_LT] THEN STRIP_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN + ASM SET_TAC[]; + ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_CBALL_0; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [EXISTS_TAC `vec 0:real^N` THEN + ASM_SIMP_TAC[NORM_0; VECTOR_MUL_LZERO; HULL_INC; REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN usph ==> ~((surf:real^N->real^N) x = vec 0)` + ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `inv(norm(surf(proj x:real^N):real^N)) % x:real^N` THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [NORM_POS_LT; REAL_LT_INV_EQ; HULL_INC; REAL_LT_MUL; NORM_MUL; + REAL_ABS_INV; REAL_ABS_NORM] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `~(y = &0) ==> x = (inv y * x) * y`) THEN + ASM_SIMP_TAC[NORM_EQ_0; HULL_INC]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [GSYM real_div; REAL_LE_LDIV_EQ; NORM_POS_LT; HULL_INC; REAL_MUL_LID] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`x:real^N`; `norm(surf(proj x:real^N):real^N) / norm(x:real^N)`]) THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_LDIV_EQ; NORM_POS_LT] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + SUBGOAL_THEN + `norm(surf(proj x)) / norm x % x:real^N = surf(proj x:real^N)` + SUBST1_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [NORM_POS_LT; REAL_LT_INV_EQ; HULL_INC; REAL_LT_MUL; NORM_MUL; + REAL_ABS_INV; REAL_ABS_NORM; REAL_ABS_DIV; REAL_LT_DIV; + REAL_DIV_RMUL; NORM_EQ_0]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE f s SUBSET t DIFF u ==> x IN s ==> ~(f x IN u)`)) THEN + ASM_SIMP_TAC[HULL_INC]]; + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN + MATCH_MP_TAC IN_AFFINE_ADD_MUL THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; VECTOR_ADD_LID; HULL_INC]]);; + +let HOMEOMORPHIC_CONVEX_COMPACT_SETS, + HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS = (CONJ_PAIR o prove) + (`(!s:real^M->bool t:real^N->bool. + convex s /\ compact s /\ convex t /\ compact t /\ aff_dim s = aff_dim t + ==> s homeomorphic t) /\ + (!s:real^M->bool t:real^N->bool. + convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s = aff_dim t + ==> relative_frontier s homeomorphic relative_frontier t)`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool. + convex s /\ compact s /\ convex t /\ compact t /\ + aff_dim s = aff_dim t + ==> (s DIFF relative_interior s) homeomorphic + (t DIFF relative_interior t) /\ + s homeomorphic t`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THENL + [UNDISCH_TAC `relative_interior t:real^N->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; + EMPTY_DIFF; HOMEOMORPHIC_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY]; + FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` MP_TAC o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_CASES_TAC `relative_interior s:real^M->bool = {}` THENL + [UNDISCH_TAC `relative_interior s:real^M->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; + EMPTY_DIFF; HOMEOMORPHIC_EMPTY; RELATIVE_INTERIOR_EQ_EMPTY]; + FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + GEOM_ORIGIN_TAC `b:real^N` THEN REPEAT GEN_TAC THEN + GEOM_ORIGIN_TAC `a:real^M` THEN REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^M->bool`; `vec 0:real^M`] + STARLIKE_COMPACT_PROJECTIVE) THEN + MP_TAC(ISPECL [`t:real^N->bool`; `vec 0:real^N`] + STARLIKE_COMPACT_PROJECTIVE) THEN + ASM_SIMP_TAC[IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; + REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC MONO_AND THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + DISCH_THEN(fun th -> + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN + MP_TAC(ONCE_REWRITE_RULE[HOMEOMORPHIC_SYM] th)) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_TRANS) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + RELATIVE_INTERIOR_SUBSET))) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; AFF_DIM_DIM_0] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`span s:real^M->bool`; `span t:real^N->bool`] + ISOMETRIES_SUBSPACES) THEN + ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; homeomorphic; HOMEOMORPHISM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0; IN_SPHERE_0] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]) in + SIMP_TAC[lemma; relative_frontier] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`closure s:real^M->bool`; `closure t:real^N->bool`] lemma) THEN + ASM_SIMP_TAC[CONVEX_CLOSURE; COMPACT_CLOSURE; AFF_DIM_CLOSURE] THEN + ASM_SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE]);; + +let HOMEOMORPHIC_CONVEX_COMPACT = prove + (`!s:real^N->bool t:real^N->bool. + convex s /\ compact s /\ ~(interior s = {}) /\ + convex t /\ compact t /\ ~(interior t = {}) + ==> s homeomorphic t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT_SETS THEN + ASM_SIMP_TAC[AFF_DIM_NONEMPTY_INTERIOR]);; + +let HOMEOMORPHIC_CONVEX_COMPACT_CBALL = prove + (`!s:real^N->bool b:real^N e. + convex s /\ compact s /\ ~(interior s = {}) /\ &0 < e + ==> s homeomorphic cball(b,e)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN + ASM_REWRITE_TAC[COMPACT_CBALL; INTERIOR_CBALL; CONVEX_CBALL] THEN + ASM_REWRITE_TAC[BALL_EQ_EMPTY; REAL_NOT_LE]);; + +let HOMEOMORPHIC_CLOSED_INTERVALS = prove + (`!a b:real^N c d:real^N. + ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) + ==> interval[a,b] homeomorphic interval[c,d]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN + REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL] THEN + ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL]);; + +(* ------------------------------------------------------------------------- *) +(* More about affine dimension of special sets. *) +(* ------------------------------------------------------------------------- *) + +let AFF_DIM_NONEMPTY_INTERIOR_EQ = prove + (`!s:real^N->bool. + convex s ==> (aff_dim s = &(dimindex (:N)) <=> ~(interior s = {}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[AFF_DIM_NONEMPTY_INTERIOR] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` EMPTY_INTERIOR_SUBSET_HYPERPLANE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP AFF_DIM_SUBSET) THEN + ASM_SIMP_TAC[AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);; + +let AFF_DIM_BALL = prove + (`!a:real^N r. + aff_dim(ball(a,r)) = if &0 < r then &(dimindex(:N)) else --(&1)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [MATCH_MP_TAC AFF_DIM_OPEN THEN + ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT; GSYM BALL_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY]]);; + +let AFF_DIM_CBALL = prove + (`!a:real^N r. + aff_dim(cball(a,r)) = + if &0 < r then &(dimindex(:N)) + else if r = &0 then &0 else --(&1)`, + REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THENL + [MATCH_MP_TAC AFF_DIM_NONEMPTY_INTERIOR THEN + ASM_REWRITE_TAC[INTERIOR_CBALL; BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[CBALL_SING; AFF_DIM_SING]; + MATCH_MP_TAC(MESON[AFF_DIM_EMPTY] `s = {} ==> aff_dim s = --(&1)`) THEN + REWRITE_TAC[CBALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC]);; + +let AFF_DIM_INTERVAL = prove + (`(!a b:real^N. + aff_dim(interval[a,b]) = + if interval[a,b] = {} then --(&1) + else &(CARD {i | 1 <= i /\ i <= dimindex(:N) /\ a$i < b$i})) /\ + (!a b:real^N. + aff_dim(interval(a,b)) = + if interval(a,b) = {} then --(&1) + else &(dimindex(:N)))`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_OPEN; OPEN_INTERVAL] THEN + POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LT_LADD] THEN + ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; ENDS_IN_INTERVAL] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC + `{basis i:real^N | 1 <= i /\ i <= dimindex(:N) /\ &0 < (b:real^N)$i}` THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY; VEC_COMPONENT]) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `basis i:real^N = inv(b$i) % (b:real^N)$i % basis i` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_MUL_LID]; + MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN + SIMP_TAC[IN_INTERVAL; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[VEC_COMPONENT] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL]]; + MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN + REWRITE_TAC[SUBSPACE_SPAN; SUBSET; IN_INTERVAL; VEC_COMPONENT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ASM_CASES_TAC `&0 < (b:real^N)$i` THENL + [MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; + SUBGOAL_THEN `(x:real^N)$i = &0` + (fun th -> REWRITE_TAC[th; VECTOR_MUL_LZERO; SPAN_0]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + REWRITE_TAC[SET_RULE `~(a IN {f x | P x}) <=> !x. P x ==> ~(f x = a)`] THEN + SIMP_TAC[BASIS_NONZERO; pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_IN_GSPEC; BASIS_INJ_EQ; ORTHOGONAL_BASIS_BASIS]; + GEN_REWRITE_TAC LAND_CONV [SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; BASIS_INJ_EQ; + HAS_SIZE] THEN + SIMP_TAC[CONJ_ASSOC; GSYM IN_NUMSEG; FINITE_RESTRICT; FINITE_NUMSEG]]);; + +(* ------------------------------------------------------------------------- *) +(* Deducing convexity from midpoint convexity in common cases. *) +(* ------------------------------------------------------------------------- *) + +let MIDPOINT_CONVEX_DYADIC_RATIONALS = prove + (`!f:real^N->real s. + (!x y. x IN s /\ y IN s + ==> midpoint(x,y) IN s /\ + f(midpoint(x,y)) <= (f(x) + f(y)) / &2) + ==> !n m p x y. + x IN s /\ y IN s /\ m + p = 2 EXP n + ==> (&m / &2 pow n % x + &p / &2 pow n % y) IN s /\ + f(&m / &2 pow n % x + &p / &2 pow n % y) + <= &m / &2 pow n * f x + &p / &2 pow n * f y`, + REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE + `m + p = 2 EXP 0 <=> m = 0 /\ p = 1 \/ m = 1 /\ p = 0`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO; + VECTOR_ADD_LID; VECTOR_ADD_RID] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ADD_SYM; REAL_ADD_SYM; ADD_SYM] THEN MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `p:num`] THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN REWRITE_TAC[EXP; real_pow] THEN STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x * inv(&2) * y = inv(&2) * x * y`] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC; GSYM VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM VECTOR_ADD_LDISTRIB] THEN + SUBGOAL_THEN `2 EXP n <= p` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&p * inv(&2 pow n) = &(p - 2 EXP n) * inv(&2 pow n) + &1` + SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_SUB_RDISTRIB; REAL_MUL_RINV; REAL_LT_IMP_NZ; + REAL_LT_POW2] THEN REAL_ARITH_TAC; + REWRITE_TAC[VECTOR_ADD_RDISTRIB; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_LID] THEN + REWRITE_TAC[VECTOR_ADD_ASSOC; REAL_ADD_ASSOC] THEN + REWRITE_TAC[GSYM midpoint; GSYM real_div] THEN FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o lhand o snd)) THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o funpow 3 lhand o snd)) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[] THEN REAL_ARITH_TAC]]]);; + +let CONTINUOUS_MIDPOINT_CONVEX = prove + (`!f:real^N->real s. + (lift o f) continuous_on s /\ convex s /\ + (!x y. x IN s /\ y IN s ==> f(midpoint(x,y)) <= (f(x) + f(y)) / &2) + ==> f convex_on s`, + REWRITE_TAC[midpoint] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[convex_on] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `u + v = &1 <=> v = &1 - u`; IMP_CONJ] THEN + REWRITE_TAC[FORALL_UNWIND_THM2; REAL_SUB_LE] THEN + REWRITE_TAC[FORALL_DROP; GSYM DROP_VEC; IMP_IMP; GSYM IN_INTERVAL_1] THEN + MP_TAC(ISPEC `interval[vec 0:real^1,vec 1]` + CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN + SIMP_TAC[CONVEX_INTERVAL; INTERIOR_CLOSED_INTERVAL; + CLOSURE_CLOSED; CLOSED_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop] THEN + DISCH_THEN(fun th -> SUBST1_TAC(SYM th) THEN ASSUME_TAC th) THEN + ONCE_REWRITE_TAC[REAL_ARITH `a <= b <=> a - b <= &0`] THEN + MATCH_MP_TAC CONTINUOUS_LE_ON_CLOSURE THEN + REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; GSYM FORALL_DROP; DROP_VEC] THEN + CONJ_TAC THENL + [REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_ADD; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [REPLICATE_TAC 2 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP; + DROP_VEC] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; + LIFT_SUB; CONTINUOUS_ON_SUB]; + MAP_EVERY X_GEN_TAC [`n:num`; `i:real`] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LT_POW2] THEN + ASM_CASES_TAC `&0 <= i` THEN ASM_SIMP_TAC[INTEGER_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN + GEN_REWRITE_TAC (LAND_CONV o DEPTH_CONV) + [REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^N->real`; `s:real^N->bool`] + MIDPOINT_CONVEX_DYADIC_RATIONALS) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[midpoint] THEN REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPECL + [`n:num`; `m:num`; `2 EXP n - m`; `x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT2)] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_POW] THEN + ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD + `&0 < y ==> (y - x) / y = &1 - x / y`] THEN + REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Slightly shaper separating/supporting hyperplane results. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATING_HYPERPLANE_RELATIVE_INTERIORS = prove + (`!s t. convex s /\ convex t /\ + ~(s = {} /\ t = (:real^N) \/ s = (:real^N) /\ t = {}) /\ + DISJOINT (relative_interior s) (relative_interior t) + ==> ?a b. ~(a = vec 0) /\ + (!x. x IN s ==> a dot x <= b) /\ + (!x. x IN t ==> a dot x >= b)`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIV_NOT_EMPTY; CONVEX_EMPTY; + RELATIVE_INTERIOR_EMPTY] THEN + STRIP_TAC THENL + [EXISTS_TAC `basis 1:real^N` THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; + FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^N` o MATCH_MP (SET_RULE + `~(s = UNIV) ==> ?a. ~(a IN s)`)) THEN + MP_TAC(ISPECL [`t:real^N->bool`; `x:real^N`] + SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN + ASM_MESON_TAC[]; + FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^N` o MATCH_MP (SET_RULE + `~(s = UNIV) ==> ?a. ~(a IN s)`)) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] + SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; real_ge] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`--a:real^N`; `--b:real`] THEN + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; REAL_LE_NEG2]; + MP_TAC(ISPECL [`relative_interior s:real^N->bool`; + `relative_interior t:real^N->bool`] + SEPARATING_HYPERPLANE_SETS) THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; CONVEX_RELATIVE_INTERIOR] THEN + SIMP_TAC[real_ge] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `b:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC + (MESON[CONVEX_CLOSURE_RELATIVE_INTERIOR; CLOSURE_SUBSET; SUBSET] + `convex s /\ (!x. x IN closure(relative_interior s) ==> P x) + ==> !x. x IN s ==> P x`) THEN + ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC CONTINUOUS_LE_ON_CLOSURE; + MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE] THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT]]);; + +let SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY = prove + (`!s x:real^N. + convex s /\ x IN s /\ ~(x IN relative_interior s) + ==> ?a. ~(a = vec 0) /\ + (!y. y IN s ==> a dot x <= a dot y) /\ + (!y. y IN relative_interior s ==> a dot x < a dot y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`relative_interior s:real^N->bool`; `x:real^N`] + SEPARATING_HYPERPLANE_SET_POINT_INAFF) THEN + ASM_SIMP_TAC[CONVEX_SING; CONVEX_RELATIVE_INTERIOR; + RELATIVE_INTERIOR_EQ_EMPTY; real_ge] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`lift o (\x:real^N. a dot x)`; + `relative_interior s:real^N->bool`; + `y:real^N`; `(a:real^N) dot x`; `1`] + CONTINUOUS_ON_CLOSURE_COMPONENT_GE) THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT; GSYM drop; o_THM; LIFT_DROP] THEN + ASM_SIMP_TAC[CONVEX_CLOSURE_RELATIVE_INTERIOR] THEN + ASM_MESON_TAC[CLOSURE_SUBSET; REAL_LE_TRANS; SUBSET]; + DISCH_TAC] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_LT_LE] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + DISCH_TAC THEN UNDISCH_TAC `(y:real^N) IN relative_interior s` THEN + REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_INTER; IN_CBALL] THEN + X_GEN_TAC `e:real` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `y + --(e / norm(a)) % ((x + a) - x):real^N`) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[NORM_ARITH `dist(y:real^N,y + e) = norm e`; VECTOR_ADD_SUB] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; HULL_INC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MATCH_MP_TAC HULL_MONO THEN + ASM_REWRITE_TAC[INSERT_SUBSET; RELATIVE_INTERIOR_SUBSET]; + REWRITE_TAC[VECTOR_ADD_SUB] THEN DISCH_TAC THEN + UNDISCH_TAC `!y:real^N. y IN s ==> a dot x <= a dot y` THEN + DISCH_THEN(MP_TAC o SPEC `y + --(e / norm(a)) % a:real^N`) THEN + ASM_REWRITE_TAC[DOT_RMUL; DOT_RNEG; DOT_RADD] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x * y ==> ~(a <= a + --x * y)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]]);; + +let SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER = prove + (`!s x:real^N. + convex s /\ x IN closure s /\ ~(x IN relative_interior s) + ==> ?a. ~(a = vec 0) /\ + (!y. y IN closure s ==> a dot x <= a dot y) /\ + (!y. y IN relative_interior s ==> a dot x < a dot y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`closure s:real^N->bool`; `x:real^N`] + SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY) THEN + ASM_SIMP_TAC[CONVEX_CLOSURE; CONVEX_RELATIVE_INTERIOR_CLOSURE]);; + +(* ------------------------------------------------------------------------- *) +(* Containment of rays in unbounded convex sets. *) +(* ------------------------------------------------------------------------- *) + +let UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY = prove + (`!s a:real^N. + convex s /\ ~bounded s /\ closed s /\ a IN s + ==> ?l. ~(l = vec 0) /\ !t. &0 <= t ==> (a + t % l) IN s`, + GEN_GEOM_ORIGIN_TAC `a:real^N` ["l"] THEN + REWRITE_TAC[VECTOR_ADD_LID] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [BOUNDED_POS]) THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&n + &1:real`) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[REAL_NOT_LE; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:num->real^N` THEN REWRITE_TAC[FORALL_AND_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN `!n. ~((x:num->real^N) n = vec 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[NORM_ARITH `~(&n + &1 < norm(vec 0:real^N))`]; ALL_TAC] THEN + MP_TAC(ISPEC `sphere(vec 0:real^N,&1)` compact) THEN + REWRITE_TAC[COMPACT_SPHERE] THEN + DISCH_THEN(MP_TAC o SPEC `\n. inv(norm(x n)) % (x:num->real^N) n`) THEN + ASM_SIMP_TAC[IN_SPHERE_0; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; + REAL_MUL_LINV; NORM_EQ_0; o_DEF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN CONJ_TAC THENL + [ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; ALL_TAC] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CLOSED_CONTAINS_SEQUENTIAL_LIMIT THEN + SUBGOAL_THEN + `?N:num. !n. N <= n ==> t / norm(x n:real^N) <= &1` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; NORM_POS_LT] THEN + MP_TAC(SPEC `t:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; REAL_MUL_LID] THEN + ASM_MESON_TAC[REAL_ARITH `t <= m /\ m <= n /\ n + &1 < x ==> t <= x`]; + EXISTS_TAC `\n:num. t / norm((x:num->real^N)(r(N + n))) % x(r(N + n))` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `N + n:num` o MATCH_MP MONOTONE_BIGGER) THEN + ARITH_TAC; + REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC LIM_CMUL THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + FIRST_ASSUM(MP_TAC o SPEC `N:num` o MATCH_MP SEQ_OFFSET) THEN + ASM_REWRITE_TAC[]]]);; + +let CONVEX_CLOSED_CONTAINS_SAME_RAY = prove + (`!s a b l:real^N. + convex s /\ closed s /\ b IN s /\ (!t. &0 <= t ==> (a + t % l) IN s) + ==> !t. &0 <= t ==> (b + t % l) IN s`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&0`) THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_IN_CLOSED_SET) THEN + EXISTS_TAC `\n. (&1 - t / (&n + &1)) % b + + t / (&n + &1) % (a + (&n + &1) % l):real^N` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `t:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_ARITH `&0 <= &n + &1`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % b + u % c:real^N = b + u % (c - b)`] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_SUB_LDISTRIB] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD `t / (&n + &1) * (&n + &1) = t`] THEN + SIMP_TAC[VECTOR_ARITH `(v % a + b) - v % c:real^N = b + v % (a - c)`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[real_div; VECTOR_ARITH `(x * y) % a:real^N = y % x % a`] THEN + MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN + EXISTS_TAC `norm(t % (a - b):real^N)` THEN + REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE; o_DEF] THEN + MP_TAC(MATCH_MP SEQ_OFFSET SEQ_HARMONIC) THEN + SIMP_TAC[REAL_OF_NUM_ADD]]);; + +let UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS = prove + (`!s:real^N->bool. + convex s /\ ~bounded s /\ closed s + ==> ?l. ~(l = vec 0) /\ !a t. a IN s /\ &0 <= t ==> (a + t % l) IN s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY; + CONVEX_CLOSED_CONTAINS_SAME_RAY]);; + +let RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY = prove + (`!s a:real^N. + convex s /\ ~bounded s /\ a IN relative_interior s + ==> ?l. ~(l = vec 0) /\ + !t. &0 <= t ==> (a + t % l) IN relative_interior s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`closure s:real^N->bool`; `a:real^N`] + UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY) THEN + ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE] THEN ANTS_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET; SUBSET; CLOSURE_SUBSET; + RELATIVE_INTERIOR_SUBSET]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `a + t % l:real^N = + (a + (&2 * t) % l) - inv(&2) % ((a + (&2 * t) % l) - a)`] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +let RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY = prove + (`!s a b l:real^N. + convex s /\ b IN relative_interior s /\ + (!t. &0 <= t ==> (a + t % l) IN relative_interior s) + ==> !t. &0 <= t ==> (b + t % l) IN relative_interior s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`closure s:real^N->bool`; `a:real^N`; `b:real^N`; `l:real^N`] + CONVEX_CLOSED_CONTAINS_SAME_RAY) THEN + ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE] THEN ANTS_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET; SUBSET; CLOSURE_SUBSET; + RELATIVE_INTERIOR_SUBSET]; + DISCH_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `a + t % l:real^N = + (a + (&2 * t) % l) - inv(&2) % ((a + (&2 * t) % l) - a)`] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +let RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS = prove + (`!s:real^N->bool. + convex s /\ ~bounded s + ==> ?l. ~(l = vec 0) /\ + !a t. a IN relative_interior s /\ &0 <= t + ==> (a + t % l) IN relative_interior s`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `relative_interior s:real^N->bool = {}` THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; BOUNDED_EMPTY]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY; + RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit formulas for interior and relative interior of convex hull. *) +(* ------------------------------------------------------------------------- *) + +let EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL = prove + (`!s. FINITE s + ==> {y:real^N | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y} + SUBSET relative_interior(convex hull s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[EMPTY_GSPEC; EMPTY_SUBSET] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN + REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN CONJ_TAC THENL + [REWRITE_TAC[CONVEX_HULL_FINITE; SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + REWRITE_TAC[open_in; IN_ELIM_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[AFFINE_HULL_FINITE; SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `e = inf (IMAGE (\x:real^N. min (&1 - u x) (u x)) s)` THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [EXPAND_TAC "e" THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FORALL_IN_IMAGE]; + ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE (\z:real^N. z - y) (affine hull s)` BASIS_EXISTS) THEN + REWRITE_TAC[SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` + (CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) + MP_TAC)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; HAS_SIZE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `compo:real^N->real^N->real`) THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN + SUBGOAL_THEN + `!i. i IN b ==> ?u. sum s u = &0 /\ vsum s (\x:real^N. u x % x) = i` + MP_TAC THENL + [EXPAND_TAC "b" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `(x:real^N) IN affine hull s` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[AFFINE_HULL_FINITE; IN_ELIM_THM]] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\x. v x - u x):real^N->real` THEN + ASM_SIMP_TAC[SUM_SUB; VSUM_SUB; VECTOR_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_SUB_REFL; VECTOR_SUB_RZERO]; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM; + TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N->real^N->real` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `e / B / + (&1 + sum (b:real^N->bool) + (\i. abs(sup(IMAGE (abs o w i) (s:real^N->bool)))))` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; + SUM_POS_LE; REAL_ABS_POS] THEN + X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN + EXISTS_TAC + `\x:real^N. u x + sum (b:real^N->bool) + (\i. compo (z:real^N) i * w i x)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[SUM_ADD; REAL_ARITH `&1 + x = &1 <=> x = &0`] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_EQ_0 THEN + ASM_SIMP_TAC[SUM_LMUL; ETA_AX; REAL_MUL_RZERO; SUM_0]; + ASM_SIMP_TAC[VSUM_ADD; VECTOR_ADD_RDISTRIB] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `y + w:real^N = z <=> w = z - y`] THEN + ASM_SIMP_TAC[GSYM VSUM_LMUL; GSYM VSUM_RMUL; GSYM VECTOR_MUL_ASSOC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[VSUM_LMUL] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum b (\v:real^N. compo (z:real^N) v % v)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[]] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) < min u (&1 - u) ==> &0 < u + x /\ u + x < &1`) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `B * norm(z - y:real^N) * sum (b:real^N->bool) + (\i. abs(sup(IMAGE (abs o w i) (s:real^N->bool))))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_ABS_LE THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_ASSOC] THEN + X_GEN_TAC `i:real^N` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`(compo:real^N->real^N->real) z`; + `i:real^N`]) THEN + ASM_SIMP_TAC[]; + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN + ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; o_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x * (&1 + e) < d ==> x * e < d`) THEN + REWRITE_TAC[NORM_POS_LE] THEN + ASM_SIMP_TAC[NORM_POS_LE; GSYM REAL_LT_RDIV_EQ; + REAL_ARITH `&0 <= x ==> &0 < &1 + x`; + SUM_POS_LE; REAL_ABS_POS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `dist(z:real^N,y) < k ==> k <= d ==> norm(z - y) < d`)) THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; + SUM_POS_LE; REAL_ABS_POS] THEN + EXPAND_TAC "e" THEN + ASM_SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL = prove + (`!s. FINITE s + ==> {y:real^N | ?u. (!x. x IN s ==> &0 < u x) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y} + SUBSET relative_interior(convex hull s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[EMPTY_GSPEC; EMPTY_SUBSET] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `s = {a:real^N}` THENL + [ASM_REWRITE_TAC[SUM_SING; VSUM_SING; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[RELATIVE_INTERIOR_SING; CONVEX_HULL_SING] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING] THEN + MESON_TAC[VECTOR_MUL_LID]; + FIRST_ASSUM(MP_TAC o MATCH_MP + EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `w:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->real` THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `sum {x,y} u <= sum s (u:real^N->real)` MP_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; REAL_LT_IMP_LE; IN_DIFF] THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < y ==> x + y + &0 <= &1 ==> x < &1`) THEN + ASM_SIMP_TAC[]]]);; + +let RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT = prove + (`!s. ~(affine_dependent s) + ==> relative_interior(convex hull s) = + {y:real^N | ?u. (!x. x IN s ==> &0 < u x) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL] THEN + ASM_CASES_TAC `?a:real^N. s = {a}` THENL + [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN + ASM_REWRITE_TAC[SUM_SING; VSUM_SING; CONVEX_HULL_SING; + RELATIVE_INTERIOR_SING] THEN + REWRITE_TAC[IN_ELIM_THM; SUBSET; IN_SING] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^N. &1` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_LT_01]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `relative_interior s SUBSET s /\ + (!x. x IN s /\ ~(x IN t) ==> ~(x IN relative_interior s)) + ==> relative_interior s SUBSET t`) THEN + REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN + REWRITE_TAC[AFFINE_HULL_CONVEX_HULL; IN_ELIM_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) + (MP_TAC o SPEC `u:real^N->real`)) THEN + ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_RELATIVE_INTERIOR; DE_MORGAN_THM; + SUBSET; IN_ELIM_THM; IN_BALL; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN DISJ2_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN + SUBGOAL_THEN `(u:real^N->real) a = &0` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`]; ALL_TAC] THEN + SUBGOAL_THEN `?b:real^N. b IN s /\ ~(b = a)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[];ALL_TAC] THEN + SUBGOAL_THEN `?d. &0 < d /\ norm(d % (a - b):real^N) < e` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `e / &2 / norm(a - b:real^N)` THEN + ASM_SIMP_TAC[NORM_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; NORM_POS_LT; + REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM; + REAL_DIV_RMUL; REAL_LT_IMP_NZ; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y - d % (a - b):real^N`) THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - b) = norm b`] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [MATCH_MP_TAC IN_AFFINE_SUB_MUL_DIFF THEN + ASM_SIMP_TAC[HULL_INC; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[AFFINE_HULL_FINITE; IN_ELIM_THM] THEN + EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `~(affine_dependent(s:real^N->bool))` THEN + ASM_SIMP_TAC[AFFINE_DEPENDENT_EXPLICIT_FINITE] THEN + EXISTS_TAC `\x:real^N. (v x - u x) - + (if x = a then --d else if x = b then d else &0)` THEN + REWRITE_TAC[VECTOR_SUB_RDISTRIB; MESON[] + `(if p then a else b) % x = (if p then a % x else b % x)`] THEN + ASM_SIMP_TAC[SUM_SUB; VSUM_SUB] THEN + ASM_SIMP_TAC[VSUM_CASES; SUM_CASES; FINITE_RESTRICT; IN_ELIM_THM] THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`; + SET_RULE `b IN s /\ ~(b = a) + ==> {x | (x IN s /\ ~(x = a)) /\ x = b} = {b}`] THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; SUM_0; VSUM_0; SUM_SING; VSUM_SING] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +let EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL = prove + (`!s. FINITE s /\ affine hull s = (:real^N) + ==> {y | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y} + SUBSET interior(convex hull s)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL) THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_CONVEX_HULL]);; + +let EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL = prove + (`!s. FINITE s /\ affine hull s = (:real^N) + ==> {y | ?u. (!x. x IN s ==> &0 < u x) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y} + SUBSET interior(convex hull s)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL) THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_INTERIOR; AFFINE_HULL_CONVEX_HULL]);; + +let INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL = prove + (`!s:real^N->bool. + ~(affine_dependent s) + ==> interior(convex hull s) = + if CARD(s) <= dimindex(:N) then {} + else {y | ?u. (!x. x IN s ==> &0 < u x) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[EMPTY_INTERIOR_CONVEX_HULL] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `relative_interior(convex hull s):real^N->bool` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN + REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN + MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT]]);; + +let INTERIOR_CONVEX_HULL_EXPLICIT = prove + (`!s:real^N->bool. + ~(affine_dependent s) + ==> interior(convex hull s) = + if CARD(s) <= dimindex(:N) then {} + else {y | ?u. (!x. x IN s ==> &0 < u x /\ u x < &1) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y}`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `v:real^N` THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real^N->real` THEN + EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` CHOOSE_SUBSET) THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN + DISCH_THEN(MP_TAC o SPEC `2`) THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `~(c <= n) ==> 1 <= n ==> 2 <= c`)) THEN + REWRITE_TAC[DIMINDEX_GE_1]; + ALL_TAC] THEN + CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` (CONJUNCTS_THEN2 ASSUME_TAC + MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real^N` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `sum {x,y} u <= sum s (u:real^N->real)` MP_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; REAL_LT_IMP_LE; IN_DIFF] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < y ==> x + y + &0 <= &1 ==> x < &1`) THEN + ASM_SIMP_TAC[]);; + +let INTERIOR_CONVEX_HULL_3_MINIMAL = prove + (`!a b c:real^2. + ~collinear{a,b,c} + ==> interior(convex hull {a,b,c}) = + {v | ?x y z. &0 < x /\ + &0 < y /\ + &0 < z /\ + x + y + z = &1 /\ + x % a + y % b + z % c = v}`, + REWRITE_TAC[COLLINEAR_3_EQ_AFFINE_DEPENDENT; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + CONV_TAC(LAND_CONV(RATOR_CONV(LAND_CONV(ONCE_DEPTH_CONV(REWRITE_CONV + [IN_INSERT; NOT_IN_EMPTY]))))) THEN + ASM_REWRITE_TAC[DIMINDEX_2; ARITH] THEN + SIMP_TAC[FINITE_INSERT; FINITE_UNION; FINITE_EMPTY; RIGHT_EXISTS_AND_THM; + AFFINE_HULL_FINITE_STEP_GEN; REAL_LT_ADD; REAL_HALF] THEN + REWRITE_TAC[REAL_ARITH `&1 - a - b - c = &0 <=> a + b + c = &1`; + VECTOR_ARITH `y - a - b - c:real^N = vec 0 <=> a + b + c = y`]);; + +let INTERIOR_CONVEX_HULL_3 = prove + (`!a b c:real^2. + ~collinear{a,b,c} + ==> interior(convex hull {a,b,c}) = + {v | ?x y z. &0 < x /\ x < &1 /\ + &0 < y /\ y < &1 /\ + &0 < z /\ z < &1 /\ + x + y + z = &1 /\ + x % a + y % b + z % c = v}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_3_MINIMAL] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Similar results for closure and (relative or absolute) frontier. *) +(* ------------------------------------------------------------------------- *) + +let CLOSURE_CONVEX_HULL = prove + (`!s. compact s ==> closure(convex hull s) = convex hull s`, + SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL]);; + +let RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT = prove + (`!s:real^N->bool. + ~(affine_dependent s) + ==> relative_frontier(convex hull s) = + {y | ?u. (!x. x IN s ==> &0 <= u x) /\ + (?x. x IN s /\ u x = &0) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[relative_frontier; UNIONS_GSPEC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + ASM_SIMP_TAC[CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN + ASM_SIMP_TAC[CONVEX_HULL_FINITE; RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `u:real^N->real`) THEN + ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (~(&0 < x) <=> x = &0)`] THEN + DISCH_TAC THEN EXISTS_TAC `u:real^N->real` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN + CONJ_TAC THENL + [EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [AFFINE_DEPENDENT_EXPLICIT]) THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`s:real^N->bool`; `(\x. u x - v x):real^N->real`] THEN + ASM_SIMP_TAC[SUBSET_REFL; VECTOR_SUB_RDISTRIB; SUM_SUB; VSUM_SUB] THEN + REWRITE_TAC[REAL_SUB_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[REAL_LT_REFL]]);; + +let FRONTIER_CONVEX_HULL_EXPLICIT = prove + (`!s:real^N->bool. + ~(affine_dependent s) + ==> frontier(convex hull s) = + {y | ?u. (!x. x IN s ==> &0 <= u x) /\ + (dimindex(:N) < CARD s ==> ?x. x IN s /\ u x = &0) /\ + sum s u = &1 /\ + vsum s (\x. u x % x) = y}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + DISJ_CASES_TAC + (ARITH_RULE `CARD(s:real^N->bool) <= dimindex(:N) \/ + dimindex(:N) < CARD(s:real^N->bool)`) + THENL + [ASM_SIMP_TAC[GSYM NOT_LE; INTERIOR_CONVEX_HULL_EXPLICIT] THEN + ASM_SIMP_TAC[CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT; DIFF_EMPTY] THEN + REWRITE_TAC[CONVEX_HULL_FINITE]; + ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT] THEN + REWRITE_TAC[relative_frontier] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_SPAN_GT; HULL_MONO; HULL_SUBSET]]);; + +let RELATIVE_FRONTIER_CONVEX_HULL_CASES = prove + (`!s:real^N->bool. + ~(affine_dependent s) + ==> relative_frontier(convex hull s) = + UNIONS { convex hull (s DELETE a) |a| a IN s }`, + REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_GSPEC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + ASM_SIMP_TAC[RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; CONVEX_HULL_FINITE] THEN + X_GEN_TAC `y:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `u:real^N->real` THEN + ASM_SIMP_TAC[IN_DELETE; SUM_DELETE; VSUM_DELETE; REAL_SUB_RZERO] THEN + VECTOR_ARITH_TAC; + REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC))) THEN + EXISTS_TAC `(\x. if x = a then &0 else u x):real^N->real` THEN + ASM_SIMP_TAC[COND_RAND; COND_RATOR; REAL_LE_REFL; COND_ID] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CASES; VSUM_CASES; VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[GSYM DELETE; SUM_0; VSUM_0; REAL_ADD_LID; VECTOR_ADD_LID]]);; + +let FRONTIER_CONVEX_HULL_CASES = prove + (`!s:real^N->bool. + ~(affine_dependent s) + ==> frontier(convex hull s) = + if CARD(s) <= dimindex(:N) then convex hull s + else UNIONS { convex hull (s DELETE a) |a| a IN s }`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + ASM_SIMP_TAC[frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT; DIFF_EMPTY]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_CONVEX_HULL_CASES] THEN + ASM_SIMP_TAC[relative_frontier; frontier; + CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE]) THEN + MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_SPAN_GT; HULL_MONO; HULL_SUBSET]);; + +let IN_FRONTIER_CONVEX_HULL = prove + (`!s x:real^N. + FINITE s /\ CARD s <= dimindex(:N) + 1 /\ x IN s + ==> x IN frontier(convex hull s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [affine_dependent]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN + ASM_SIMP_TAC[HULL_INC; IN_DIFF] THEN MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ t = {} ==> ~(x IN s)`) THEN + EXISTS_TAC `interior(affine hull s):real^N->bool` THEN + SIMP_TAC[SUBSET_INTERIOR; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[HULL_REDUNDANT] THEN + MATCH_MP_TAC EMPTY_INTERIOR_AFFINE_HULL THEN + ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[FRONTIER_CONVEX_HULL_CASES] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[HULL_INC] THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ ~(y = x)` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> ~(s = {x}) ==> ?y. y IN s /\ ~(y = x)`)) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[NOT_LT; NOT_IN_EMPTY; ARITH_SUC; DIMINDEX_GE_1]; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]]]);; + +let NOT_IN_INTERIOR_CONVEX_HULL = prove + (`!s x:real^N. + FINITE s /\ CARD s <= dimindex(:N) + 1 /\ x IN s + ==> ~(x IN interior(convex hull s))`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP IN_FRONTIER_CONVEX_HULL) THEN + SIMP_TAC[frontier; IN_DIFF]);; + +let INTERIOR_CONVEX_HULL_EQ_EMPTY = prove + (`!s:real^N->bool. + s HAS_SIZE (dimindex(:N) + 1) + ==> (interior(convex hull s) = {} <=> affine_dependent s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN + ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL + [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [affine_dependent]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[frontier; CLOSURE_CONVEX_HULL; FINITE_IMP_COMPACT] THEN + ASM_SIMP_TAC[HULL_INC; IN_DIFF] THEN MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN + EXISTS_TAC `interior(affine hull s):real^N->bool` THEN + SIMP_TAC[SUBSET_INTERIOR; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + SUBGOAL_THEN `s = (a:real^N) INSERT (s DELETE a)` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[HULL_REDUNDANT] THEN + MATCH_MP_TAC EMPTY_INTERIOR_AFFINE_HULL THEN + ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; ARITH_RULE `~(n + 1 <= n)`] THEN + EXISTS_TAC `vsum s (\x:real^N. inv(&(dimindex(:N)) + &1) % x)` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `\x:real^N. inv(&(dimindex(:N)) + &1)` THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + ASM_SIMP_TAC[SUM_CONST; GSYM REAL_OF_NUM_ADD] THEN + CONV_TAC REAL_FIELD]);; + +(* ------------------------------------------------------------------------- *) +(* Similar things in special case (could use above as lemmas here instead). *) +(* ------------------------------------------------------------------------- *) + +let SIMPLEX_EXPLICIT = prove + (`!s:real^N->bool. + FINITE s /\ ~(vec 0 IN s) + ==> convex hull (vec 0 INSERT s) = + { y | ?u. (!x. x IN s ==> &0 <= u x) /\ + sum s u <= &1 /\ + vsum s (\x. u x % x) = y}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_FINITE; FINITE_INSERT] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; IN_INSERT] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `u:real^N->real` THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N`) THEN REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + EXISTS_TAC `\x:real^N. if x = vec 0 then &1 - sum (s:real^N->bool) u + else u(x)` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[REAL_SUB_LE]; + MATCH_MP_TAC(REAL_ARITH `s = t ==> &1 - s + t = &1`) THEN + MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[]]]);; + +let STD_SIMPLEX = prove + (`convex hull (vec 0 INSERT { basis i | 1 <= i /\ i <= dimindex(:N)}) = + {x:real^N | (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i) /\ + sum (1..dimindex(:N)) (\i. x$i) <= &1 }`, + W(MP_TAC o PART_MATCH (lhs o rand) SIMPLEX_EXPLICIT o lhs o snd) THEN ANTS_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE; GSYM IN_NUMSEG] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IN_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG] THEN MESON_TAC[BASIS_NONZERO]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[EXTENSION] THEN + ONCE_REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[SIMPLE_IMAGE; GSYM IN_NUMSEG] THEN + SUBGOAL_THEN `!u. sum (IMAGE (basis:num->real^N) (1..dimindex(:N))) u = + sum (1..dimindex(:N)) (u o basis)` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[IN_NUMSEG] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; BASIS_INJ]; + ALL_TAC] THEN + SUBGOAL_THEN `!u. vsum (IMAGE (basis:num->real^N) (1..dimindex(:N))) u = + vsum (1..dimindex(:N)) ((u:real^N->real^N) o basis)` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC VSUM_IMAGE THEN REWRITE_TAC[IN_NUMSEG] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; BASIS_INJ; FINITE_NUMSEG]; + ALL_TAC] THEN + REWRITE_TAC[o_DEF; BASIS_EXPANSION_UNIQUE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x <= &1 ==> x = y ==> y <= &1`)) THEN + MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_NUMSEG]; + STRIP_TAC THEN EXISTS_TAC `\y:real^N. y dot x` THEN + ASM_SIMP_TAC[DOT_BASIS]]);; + +let INTERIOR_STD_SIMPLEX = prove + (`interior + (convex hull (vec 0 INSERT { basis i | 1 <= i /\ i <= dimindex(:N)})) = + {x:real^N | (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 < x$i) /\ + sum (1..dimindex(:N)) (\i. x$i) < &1 }`, + REWRITE_TAC[EXTENSION; IN_INTERIOR; IN_ELIM_THM; STD_SIMPLEX] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[DIST_REFL] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN + CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x - (e / &2) % basis k:real^N`) THEN + REWRITE_TAC[NORM_ARITH `dist(x,x - e) = norm(e)`; NORM_MUL] THEN + ASM_SIMP_TAC[NORM_BASIS; REAL_ARITH `&0 < e ==> abs(e / &2) * &1 < e`; + VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + DISCH_THEN(MP_TAC o SPEC `k:num` o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[BASIS_COMPONENT] THEN UNDISCH_TAC `&0 < e` THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `x + (e / &2) % basis 1:real^N`) THEN + REWRITE_TAC[NORM_ARITH `dist(x,x + e) = norm(e)`; NORM_MUL] THEN + ASM_SIMP_TAC[NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> abs(e / &2) * &1 < e`] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC(REAL_ARITH `x < y ==> y <= &1 ==> ~(x = &1)`) THEN + MATCH_MP_TAC SUM_LT THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> ~(a /\ b ==> ~c)`] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT] THEN + CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC; + EXISTS_TAC `1` THEN REWRITE_TAC[LE_REFL; DIMINDEX_GE_1]] THEN + ASM_REAL_ARITH_TAC]; + STRIP_TAC THEN + EXISTS_TAC + `min (inf(IMAGE (\i. (x:real^N)$i) (1..dimindex(:N)))) + ((&1 - sum (1..dimindex(:N)) (\i. x$i)) / &(dimindex(:N)))` THEN + ASM_SIMP_TAC[REAL_LT_MIN] THEN + SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; + ARITH_RULE `0 < x <=> 1 <= x`; DIMINDEX_GE_1] THEN + ASM_REWRITE_TAC[IN_NUMSEG; REAL_MUL_LZERO; REAL_SUB_LT] THEN + REPEAT(POP_ASSUM(K ALL_TAC)) THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `abs(xk - yk) <= d ==> d < xk ==> &0 <= yk`); + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) + [GSYM CARD_NUMSEG_1] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REAL_ARITH + `s2 <= s0 + s1 ==> s0 < &1 - s1 ==> s2 <= &1`) THEN + REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs(y - x) <= z ==> x <= z + y`)] THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist; COMPONENT_LE_NORM]]);; diff --git a/Multivariate/cross.ml b/Multivariate/cross.ml new file mode 100644 index 0000000..e7538b9 --- /dev/null +++ b/Multivariate/cross.ml @@ -0,0 +1,279 @@ +(* ========================================================================= *) +(* Cross products in real^3. *) +(* ========================================================================= *) + +needs "Multivariate/topology.ml";; + +prioritize_vector();; + +(* ------------------------------------------------------------------------- *) +(* The definition. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("cross",(20,"right"));; + +let cross = new_definition + `(a:real^3) cross (b:real^3) = + vector [a$2 * b$3 - a$3 * b$2; + a$3 * b$1 - a$1 * b$3; + a$1 * b$2 - a$2 * b$1] :real^3`;; + +(* ------------------------------------------------------------------------- *) +(* Some simple automation. *) +(* ------------------------------------------------------------------------- *) + +let VEC3_TAC = + SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_3; SUM_3; DIMINDEX_3; VECTOR_3; + vector_add; vec; dot; cross; orthogonal; basis; DET_3; + vector_neg; vector_sub; vector_mul; ARITH] THEN + CONV_TAC REAL_RING;; + +let VEC3_RULE tm = prove(tm,VEC3_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Basic lemmas. *) +(* ------------------------------------------------------------------------- *) + +let ORTHOGONAL_CROSS = prove + (`!x y. orthogonal (x cross y) x /\ orthogonal (x cross y) y /\ + orthogonal x (x cross y) /\ orthogonal y (x cross y)`, + VEC3_TAC);; + +let CROSS_LZERO = prove + (`!x. (vec 0) cross x = vec 0`, + VEC3_TAC);; + +let CROSS_RZERO = prove + (`!x. x cross (vec 0) = vec 0`, + VEC3_TAC);; + +let CROSS_SKEW = prove + (`!x y. (x cross y) = --(y cross x)`, + VEC3_TAC);; + +let CROSS_REFL = prove + (`!x. x cross x = vec 0`, + VEC3_TAC);; + +let CROSS_LADD = prove + (`!x y z. (x + y) cross z = (x cross z) + (y cross z)`, + VEC3_TAC);; + +let CROSS_RADD = prove + (`!x y z. x cross (y + z) = (x cross y) + (x cross z)`, + VEC3_TAC);; + +let CROSS_LMUL = prove + (`!c x y. (c % x) cross y = c % (x cross y)`, + VEC3_TAC);; + +let CROSS_RMUL = prove + (`!c x y. x cross (c % y) = c % (x cross y)`, + VEC3_TAC);; + +let CROSS_LNEG = prove + (`!x y. (--x) cross y = --(x cross y)`, + VEC3_TAC);; + +let CROSS_RNEG = prove + (`!x y. x cross (--y) = --(x cross y)`, + VEC3_TAC);; + +let CROSS_LSUB = prove + (`!x y z. (x - y) cross z = x cross z - y cross z`, + VEC3_TAC);; + +let CROSS_RSUB = prove + (`!x y z. x cross (y - z) = x cross y - x cross z`, + VEC3_TAC);; + +let CROSS_JACOBI = prove + (`!x y z. + x cross (y cross z) + y cross (z cross x) + z cross (x cross y) = vec 0`, + VEC3_TAC);; + +let CROSS_LAGRANGE = prove + (`!x y z. x cross (y cross z) = (x dot z) % y - (x dot y) % z`, + VEC3_TAC);; + +let CROSS_TRIPLE = prove + (`!x y z. (x cross y) dot z = (y cross z) dot x`, + VEC3_TAC);; + +let DOT_CROSS_SELF = prove + (`(!x y. x dot (x cross y) = &0) /\ + (!x y. x dot (y cross x) = &0) /\ + (!x y. (x cross y) dot y = &0) /\ + (!x y. (y cross x) dot y = &0)`, + VEC3_TAC);; + +let CROSS_COMPONENTS = prove + (`!x y. (x cross y)$1 = x$2 * y$3 - y$2 * x$3 /\ + (x cross y)$2 = x$3 * y$1 - y$3 * x$1 /\ + (x cross y)$3 = x$1 * y$2 - y$1 * x$2`, + VEC3_TAC);; + +let CROSS_BASIS = prove + (`(basis 1) cross (basis 2) = basis 3 /\ + (basis 2) cross (basis 1) = --(basis 3) /\ + (basis 2) cross (basis 3) = basis 1 /\ + (basis 3) cross (basis 2) = --(basis 1) /\ + (basis 3) cross (basis 1) = basis 2 /\ + (basis 1) cross (basis 3) = --(basis 2)`, + VEC3_TAC);; + +let CROSS_BASIS_NONZERO = prove + (`!u. ~(u = vec 0) + ==> ~(u cross basis 1 = vec 0) \/ + ~(u cross basis 2 = vec 0) \/ + ~(u cross basis 3 = vec 0)`, + VEC3_TAC);; + +let CROSS_DOT_CANCEL = prove + (`!x y z. + x dot y = x dot z /\ x cross y = x cross z /\ ~(x = vec 0) ==> y = z`, + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN REWRITE_TAC[GSYM DOT_EQ_0] THEN + VEC3_TAC);; + +let NORM_CROSS_DOT = prove + (`!x y. norm(x cross y) pow 2 + (x dot y) pow 2 = (norm(x) * norm y) pow 2`, + REWRITE_TAC[REAL_POW_MUL; NORM_POW_2] THEN VEC3_TAC);; + +let DOT_CROSS_DET = prove + (`!x y z. x dot (y cross z) = det(vector[x;y;z]:real^3^3)`, + VEC3_TAC);; + +let CROSS_CROSS_DET = prove + (`!w x y z. (w cross x) cross (y cross z) = + det(vector[w;x;z]:real^3^3) % y - + det(vector[w;x;y]:real^3^3) % z`, + VEC3_TAC);; + +let DOT_CROSS = prove + (`!w x y z. (w cross x) dot (y cross z) = + (w dot y) * (x dot z) - (w dot z) * (x dot y)`, + VEC3_TAC);; + +let NORM_CROSS = prove + (`!x y. norm(x cross y) pow 2 = + norm(x) pow 2 * norm(y) pow 2 - (x dot y) pow 2`, + REWRITE_TAC[NORM_POW_2] THEN VEC3_TAC);; + +let CROSS_EQ_0 = prove + (`!x y. x cross y = vec 0 <=> collinear{vec 0,x,y}`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_EQ_0] THEN + ONCE_REWRITE_TAC[REAL_RING `x = &0 <=> x pow 2 = &0`] THEN + REWRITE_TAC[NORM_CROSS; REAL_SUB_0; GSYM REAL_POW_MUL] THEN + REWRITE_TAC[GSYM REAL_EQ_SQUARE_ABS; GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN + SIMP_TAC[real_abs; REAL_LE_MUL; NORM_POS_LE; EQ_SYM_EQ]);; + +let CROSS_0 = prove + (`(!x. vec 0 cross x = vec 0) /\ + (!x. x cross vec 0 = vec 0)`, + VEC3_TAC);; + +let CROSS_EQ_SELF = prove + (`(!x y. x cross y = x <=> x = vec 0) /\ + (!x y. x cross y = y <=> y = vec 0)`, + MESON_TAC[ORTHOGONAL_CROSS; CROSS_0; ORTHOGONAL_REFL]);; + +let NORM_AND_CROSS_EQ_0 = prove + (`!x y. x dot y = &0 /\ x cross y = vec 0 <=> x = vec 0 \/ y = vec 0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^3 = vec 0` THEN + ASM_REWRITE_TAC[CROSS_0; DOT_LZERO] THEN ASM_CASES_TAC `y:real^3 = vec 0` THEN + ASM_REWRITE_TAC[CROSS_0; DOT_RZERO] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[GSYM DOT_EQ_0; DOT_CROSS; REAL_MUL_LZERO] THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; REAL_ENTIRE; DOT_EQ_0]);; + +let BILINEAR_CROSS = prove + (`bilinear(cross)`, + REWRITE_TAC[linear; bilinear; CROSS_LADD; CROSS_RADD; + CROSS_LMUL; CROSS_RMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation by rotation, or other orthogonal transformation up to sign. *) +(* ------------------------------------------------------------------------- *) + +let CROSS_MATRIX_MUL = prove + (`!A x y. transp A ** ((A ** x) cross (A ** y)) = det A % (x cross y)`, + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; SUM_3; matrix_vector_mul; + CROSS_COMPONENTS; LAMBDA_BETA; ARITH; transp; DET_3; + VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC);; + +let CROSS_ORTHOGONAL_MATRIX = prove + (`!A x y. orthogonal_matrix A + ==> (A ** x) cross (A ** y) = det A % (A ** (x cross y))`, + MP_TAC CROSS_MATRIX_MUL THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[orthogonal_matrix] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o AP_TERM `matrix_vector_mul (A:real^3^3)`) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL]);; + +let CROSS_ROTATION_MATRIX = prove + (`!A x y. rotation_matrix A + ==> (A ** x) cross (A ** y) = A ** (x cross y)`, + SIMP_TAC[rotation_matrix; CROSS_ORTHOGONAL_MATRIX; VECTOR_MUL_LID]);; + +let CROSS_ROTOINVERSION_MATRIX = prove + (`!A x y. rotoinversion_matrix A + ==> (A ** x) cross (A ** y) = --(A ** (x cross y))`, + SIMP_TAC[rotoinversion_matrix; CROSS_ORTHOGONAL_MATRIX; VECTOR_MUL_LID; + VECTOR_MUL_LNEG]);; + +let CROSS_ORTHOGONAL_TRANSFORMATION = prove + (`!f x y. + orthogonal_transformation f + ==> (f x) cross (f y) = det(matrix f) % f(x cross y)`, + GEN_TAC THEN + MP_TAC(ISPEC `matrix(f:real^3->real^3)` CROSS_ORTHOGONAL_MATRIX) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; + ORTHOGONAL_TRANSFORMATION_LINEAR]; + ASM_SIMP_TAC[MATRIX_WORKS; ORTHOGONAL_TRANSFORMATION_LINEAR]]);; + +let CROSS_LINEAR_IMAGE = prove + (`!f x y. linear f /\ (!x. norm(f x) = norm x) /\ det(matrix f) = &1 + ==> (f x) cross (f y) = f(x cross y)`, + SIMP_TAC[ORTHOGONAL_TRANSFORMATION; CONJ_ASSOC; VECTOR_MUL_LID; + CROSS_ORTHOGONAL_TRANSFORMATION]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_CROSS = prove + (`!net:(A)net f g. + f continuous net /\ g continuous net + ==> (\x. (f x) cross (g x)) continuous net`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_COMPONENTWISE_LIFT] THEN + REWRITE_TAC[cross; VECTOR_3; DIMINDEX_3; FORALL_3; LIFT_SUB] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN + REWRITE_TAC[LIFT_CMUL] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + ASM_SIMP_TAC[o_DEF; CONTINUOUS_LIFT_COMPONENT_COMPOSE]);; + +let CONTINUOUS_ON_CROSS = prove + (`!f:real^N->real^3 g s. + f continuous_on s /\ g continuous_on s + ==> (\x. (f x) cross (g x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CROSS]);; + +(* ------------------------------------------------------------------------- *) +(* Prove a weaker variant for more convenient interface with functions *) +(* intended to work in 1 dimension. *) +(* ------------------------------------------------------------------------- *) + +let CROSS_LINEAR_IMAGE_WEAK = prove + (`!f x y. linear f /\ (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:3) ==> det(matrix f) = &1) + ==> (f x) cross (f y) = f(x cross y)`, + REWRITE_TAC[DIMINDEX_3; ARITH] THEN + SIMP_TAC[ORTHOGONAL_TRANSFORMATION; CONJ_ASSOC; VECTOR_MUL_LID; + CROSS_ORTHOGONAL_TRANSFORMATION]);; + +add_linear_invariants [CROSS_LINEAR_IMAGE_WEAK];; diff --git a/Multivariate/derivatives.ml b/Multivariate/derivatives.ml new file mode 100644 index 0000000..e3c4ab4 --- /dev/null +++ b/Multivariate/derivatives.ml @@ -0,0 +1,2732 @@ +(* ========================================================================= *) +(* Multivariate calculus in Euclidean space. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Multivariate/dimension.ml";; + +(* ------------------------------------------------------------------------- *) +(* Derivatives. The definition is slightly tricky since we make it work over *) +(* nets of a particular form. This lets us prove theorems generally and use *) +(* "at a" or "at a within s" for restriction to a set (1-sided on R etc.) *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("has_derivative",(12,"right"));; + +let has_derivative = new_definition + `(f has_derivative f') net <=> + linear f' /\ + ((\y. inv(norm(y - netlimit net)) % + (f(y) - + (f(netlimit net) + f'(y - netlimit net)))) --> vec 0) net`;; + +(* ------------------------------------------------------------------------- *) +(* These are the only cases we'll care about, probably. *) +(* ------------------------------------------------------------------------- *) + +let has_derivative_within = prove + (`!f:real^M->real^N f' x s. + (f has_derivative f') (at x within s) <=> + linear f' /\ + ((\y. inv(norm(y - x)) % (f(y) - (f(x) + f'(y - x)))) --> vec 0) + (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative] THEN AP_TERM_TAC THEN + ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL + [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; + +let has_derivative_at = prove + (`!f:real^M->real^N f' x. + (f has_derivative f') (at x) <=> + linear f' /\ + ((\y. inv(norm(y - x)) % (f(y) - (f(x) + f'(y - x)))) --> vec 0) + (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[has_derivative_within]);; + +(* ------------------------------------------------------------------------- *) +(* More explicit epsilon-delta forms. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_WITHIN = prove + (`(f has_derivative f')(at x within s) <=> + linear f' /\ + !e. &0 < e + ==> ?d. &0 < d /\ + !x'. x' IN s /\ + &0 < norm(x' - x) /\ norm(x' - x) < d + ==> norm(f(x') - f(x) - f'(x' - x)) / + norm(x' - x) < e`, + SIMP_TAC[has_derivative_within; LIM_WITHIN] THEN AP_TERM_TAC THEN + REWRITE_TAC[dist; VECTOR_ARITH `(x' - (x + d)) = x' - x - d:real^N`] THEN + REWRITE_TAC[real_div; VECTOR_SUB_RZERO; NORM_MUL] THEN + REWRITE_TAC[REAL_MUL_AC; REAL_ABS_INV; REAL_ABS_NORM]);; + +let HAS_DERIVATIVE_AT = prove + (`(f has_derivative f')(at x) <=> + linear f' /\ + !e. &0 < e + ==> ?d. &0 < d /\ + !x'. &0 < norm(x' - x) /\ norm(x' - x) < d + ==> norm(f(x') - f(x) - f'(x' - x)) / + norm(x' - x) < e`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_DERIVATIVE_WITHIN; IN_UNIV]);; + +let HAS_DERIVATIVE_AT_WITHIN = prove + (`!f x s. (f has_derivative f') (at x) + ==> (f has_derivative f') (at x within s)`, + REWRITE_TAC[HAS_DERIVATIVE_WITHIN; HAS_DERIVATIVE_AT] THEN MESON_TAC[]);; + +let HAS_DERIVATIVE_WITHIN_OPEN = prove + (`!f f' a s. + a IN s /\ open s + ==> ((f has_derivative f') (at a within s) <=> + (f has_derivative f') (at a))`, + SIMP_TAC[has_derivative_within; has_derivative_at; LIM_WITHIN_OPEN]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_LINEAR = prove + (`!f net. linear f ==> (f has_derivative f) net`, + REWRITE_TAC[has_derivative; linear] THEN + SIMP_TAC[VECTOR_ARITH `x - y = x + --(&1) % y`] THEN + REWRITE_TAC[VECTOR_ARITH `x + --(&1) % (y + x + --(&1) % y) = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; LIM_CONST]);; + +let HAS_DERIVATIVE_ID = prove + (`!net. ((\x. x) has_derivative (\h. h)) net`, + SIMP_TAC[HAS_DERIVATIVE_LINEAR; LINEAR_ID]);; + +let HAS_DERIVATIVE_CONST = prove + (`!c net. ((\x. c) has_derivative (\h. vec 0)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative; linear] THEN + REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_REFL; VECTOR_MUL_RZERO; LIM_CONST]);; + +let HAS_DERIVATIVE_LIFT_COMPONENT = prove + (`!net:(real^N)net. ((\x. lift(x$i)) has_derivative (\x. lift(x$i))) net`, + GEN_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[linear; VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; + +let HAS_DERIVATIVE_CMUL = prove + (`!f f' net c. (f has_derivative f') net + ==> ((\x. c % f(x)) has_derivative (\h. c % f'(h))) net`, + REPEAT GEN_TAC THEN SIMP_TAC[has_derivative; LINEAR_COMPOSE_CMUL] THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP LIM_CMUL o CONJUNCT2) THEN + REWRITE_TAC[VECTOR_MUL_RZERO] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC);; + +let HAS_DERIVATIVE_CMUL_EQ = prove + (`!f f' net c. + ~(c = &0) + ==> (((\x. c % f(x)) has_derivative (\h. c % f'(h))) net <=> + (f has_derivative f') net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_CMUL) THENL + [DISCH_THEN(MP_TAC o SPEC `inv(c):real`); + DISCH_THEN(MP_TAC o SPEC `c:real`)] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; + +let HAS_DERIVATIVE_NEG = prove + (`!f f' net. (f has_derivative f') net + ==> ((\x. --(f(x))) has_derivative (\h. --(f'(h)))) net`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN + SIMP_TAC[HAS_DERIVATIVE_CMUL]);; + +let HAS_DERIVATIVE_NEG_EQ = prove + (`!f f' net. ((\x. --(f(x))) has_derivative (\h. --(f'(h)))) net <=> + (f has_derivative f') net`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_NEG) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let HAS_DERIVATIVE_ADD = prove + (`!f f' g g' net. + (f has_derivative f') net /\ (g has_derivative g') net + ==> ((\x. f(x) + g(x)) has_derivative (\h. f'(h) + g'(h))) net`, + REPEAT GEN_TAC THEN SIMP_TAC[has_derivative; LINEAR_COMPOSE_ADD] THEN + DISCH_THEN(MP_TAC o MATCH_MP (TAUT `(a /\ b) /\ (c /\ d) ==> b /\ d`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN REWRITE_TAC[VECTOR_ADD_LID] THEN + MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC);; + +let HAS_DERIVATIVE_SUB = prove + (`!f f' g g' net. + (f has_derivative f') net /\ (g has_derivative g') net + ==> ((\x. f(x) - g(x)) has_derivative (\h. f'(h) - g'(h))) net`, + SIMP_TAC[VECTOR_SUB; HAS_DERIVATIVE_ADD; HAS_DERIVATIVE_NEG]);; + +let HAS_DERIVATIVE_VSUM = prove + (`!f net s. + FINITE s /\ + (!a. a IN s ==> ((f a) has_derivative (f' a)) net) + ==> ((\x. vsum s (\a. f a x)) has_derivative (\h. vsum s (\a. f' a h))) + net`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; HAS_DERIVATIVE_CONST] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN + REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[IN_INSERT]);; + +let HAS_DERIVATIVE_VSUM_NUMSEG = prove + (`!f net m n. + (!i. m <= i /\ i <= n ==> ((f i) has_derivative (f' i)) net) + ==> ((\x. vsum (m..n) (\i. f i x)) has_derivative + (\h. vsum (m..n) (\i. f' i h))) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_VSUM THEN + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG]);; + +let HAS_DERIVATIVE_COMPONENTWISE_WITHIN = prove + (`!f:real^M->real^N f' a s. + (f has_derivative f') (at a within s) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> ((\x. lift(f(x)$i)) has_derivative (\x. lift(f'(x)$i))) + (at a within s)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_derivative_within] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [LINEAR_COMPONENTWISE; LIM_COMPONENTWISE_LIFT] THEN + SIMP_TAC[AND_FORALL_THM; TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + REWRITE_TAC[GSYM LIFT_ADD; GSYM LIFT_CMUL; GSYM LIFT_SUB] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + VECTOR_SUB_COMPONENT; LIFT_NUM]);; + +let HAS_DERIVATIVE_COMPONENTWISE_AT = prove + (`!f:real^M->real^N f' a. + (f has_derivative f') (at a) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> ((\x. lift(f(x)$i)) has_derivative (\x. lift(f'(x)$i))) (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MATCH_ACCEPT_TAC HAS_DERIVATIVE_COMPONENTWISE_WITHIN);; + +(* ------------------------------------------------------------------------- *) +(* Somewhat different results for derivative of scalar multiplier. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_VMUL_COMPONENT = prove + (`!c:real^M->real^N c' k v:real^P. + 1 <= k /\ k <= dimindex(:N) /\ (c has_derivative c') net + ==> ((\x. c(x)$k % v) has_derivative (\x. c'(x)$k % v)) net`, + SIMP_TAC[has_derivative; LINEAR_VMUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; GSYM VECTOR_SUB_RDISTRIB] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0 = &0 % (v:real^P)`) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN MATCH_MP_TAC LIM_VMUL THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM VECTOR_ADD_COMPONENT] THEN + ASM_SIMP_TAC[GSYM VECTOR_MUL_COMPONENT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM]) THEN REWRITE_TAC[LIM] THEN + REWRITE_TAC[dist; LIFT_NUM; VECTOR_SUB_RZERO; o_THM; NORM_LIFT] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ABS_MUL; NORM_MUL] THEN + ASM_MESON_TAC[REAL_LET_TRANS; COMPONENT_LE_NORM; + REAL_LE_LMUL; REAL_ABS_POS]);; + +let HAS_DERIVATIVE_VMUL_DROP = prove + (`!c c' v. (c has_derivative c') net + ==> ((\x. drop(c(x)) % v) has_derivative (\x. drop(c'(x)) % v)) net`, + SIMP_TAC[drop; LE_REFL; DIMINDEX_1; HAS_DERIVATIVE_VMUL_COMPONENT]);; + +let HAS_DERIVATIVE_LIFT_DOT = prove + (`!f:real^M->real^N f'. + (f has_derivative f') net + ==> ((\x. lift(v dot f(x))) has_derivative (\t. lift(v dot (f' t)))) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative] THEN + REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_ADD; GSYM LIFT_CMUL] THEN + REWRITE_TAC[GSYM DOT_RADD; GSYM DOT_RSUB; GSYM DOT_RMUL] THEN + SUBGOAL_THEN + `(\t. lift (v dot (f':real^M->real^N) t)) = (\y. lift(v dot y)) o f'` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + SIMP_TAC[LINEAR_COMPOSE; LINEAR_LIFT_DOT] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_LIFT_DOT o CONJUNCT2) THEN + SIMP_TAC[o_DEF; DOT_RZERO; LIFT_NUM]);; + +(* ------------------------------------------------------------------------- *) +(* Limit transformation for derivatives. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_TRANSFORM_WITHIN = prove + (`!f f' g x s d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ + (f has_derivative f') (at x within s) + ==> (g has_derivative f') (at x within s)`, + REPEAT GEN_TAC THEN SIMP_TAC[has_derivative_within; IMP_CONJ] THEN + REPLICATE_TAC 4 DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + LIM_TRANSFORM_WITHIN) THEN + EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[DIST_REFL]);; + +let HAS_DERIVATIVE_TRANSFORM_AT = prove + (`!f f' g x d. + &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ + (f has_derivative f') (at x) + ==> (g has_derivative f') (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MESON_TAC[HAS_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);; + +let HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove + (`!f g:real^M->real^N s x. + open s /\ x IN s /\ + (!y. y IN s ==> f y = g y) /\ + (f has_derivative f') (at x) + ==> (g has_derivative f') (at x)`, + REPEAT GEN_TAC THEN SIMP_TAC[has_derivative_at; IMP_CONJ] THEN + REPLICATE_TAC 4 DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE + [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] + LIM_TRANSFORM_WITHIN_OPEN) THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiability. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("differentiable",(12,"right"));; +parse_as_infix ("differentiable_on",(12,"right"));; + +let differentiable = new_definition + `f differentiable net <=> ?f'. (f has_derivative f') net`;; + +let differentiable_on = new_definition + `f differentiable_on s <=> !x. x IN s ==> f differentiable (at x within s)`;; + +let HAS_DERIVATIVE_IMP_DIFFERENTIABLE = prove + (`!f f' net. (f has_derivative f') net ==> f differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[]);; + +let DIFFERENTIABLE_AT_WITHIN = prove + (`!f s x. f differentiable (at x) + ==> f differentiable (at x within s)`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_AT_WITHIN]);; + +let DIFFERENTIABLE_WITHIN_OPEN = prove + (`!f a s. + a IN s /\ open s + ==> (f differentiable (at a within s) <=> (f differentiable (at a)))`, + SIMP_TAC[differentiable; HAS_DERIVATIVE_WITHIN_OPEN]);; + +let DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON = prove + (`!f s. (!x. x IN s ==> f differentiable at x) ==> f differentiable_on s`, + REWRITE_TAC[differentiable_on] THEN MESON_TAC[DIFFERENTIABLE_AT_WITHIN]);; + +let DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT = prove + (`!f s. open s ==> (f differentiable_on s <=> + !x. x IN s ==> f differentiable at x)`, + SIMP_TAC[differentiable_on; DIFFERENTIABLE_WITHIN_OPEN]);; + +let DIFFERENTIABLE_TRANSFORM_WITHIN = prove + (`!f g x s d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ + f differentiable (at x within s) + ==> g differentiable (at x within s)`, + REWRITE_TAC[differentiable] THEN + MESON_TAC[HAS_DERIVATIVE_TRANSFORM_WITHIN]);; + +let DIFFERENTIABLE_TRANSFORM_AT = prove + (`!f g x d. + &0 < d /\ + (!x'. dist (x',x) < d ==> f x' = g x') /\ + f differentiable at x + ==> g differentiable at x`, + REWRITE_TAC[differentiable] THEN + MESON_TAC[HAS_DERIVATIVE_TRANSFORM_AT]);; + +(* ------------------------------------------------------------------------- *) +(* Frechet derivative and Jacobian matrix. *) +(* ------------------------------------------------------------------------- *) + +let frechet_derivative = new_definition + `frechet_derivative f net = @f'. (f has_derivative f') net`;; + +let FRECHET_DERIVATIVE_WORKS = prove + (`!f net. f differentiable net <=> + (f has_derivative (frechet_derivative f net)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[frechet_derivative] THEN + CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[differentiable]);; + +let LINEAR_FRECHET_DERIVATIVE = prove + (`!f net. f differentiable net ==> linear(frechet_derivative f net)`, + SIMP_TAC[FRECHET_DERIVATIVE_WORKS; has_derivative]);; + +let jacobian = new_definition + `jacobian f net = matrix(frechet_derivative f net)`;; + +let JACOBIAN_WORKS = prove + (`!f net. f differentiable net <=> + (f has_derivative (\h. jacobian f net ** h)) net`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[differentiable]] THEN + REWRITE_TAC[FRECHET_DERIVATIVE_WORKS] THEN + SIMP_TAC[jacobian; MATRIX_WORKS; has_derivative] THEN SIMP_TAC[ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiability implies continuity. *) +(* ------------------------------------------------------------------------- *) + +let LIM_MUL_NORM_WITHIN = prove + (`!f a s. (f --> vec 0) (at a within s) + ==> ((\x. norm(x - a) % f(x)) --> vec 0) (at a within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_MUL; REAL_ABS_NORM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_LT_MUL2; NORM_POS_LE]);; + +let DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN = prove + (`!f:real^M->real^N s. + f differentiable (at x within s) ==> f continuous (at x within s)`, + REWRITE_TAC[differentiable; has_derivative_within; CONTINUOUS_WITHIN] THEN + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` MP_TAC) THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP LIM_MUL_NORM_WITHIN) THEN + SUBGOAL_THEN + `((f':real^M->real^N) o (\y. y - x)) continuous (at x within s)` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_CONST; CONTINUOUS_WITHIN_ID]; + ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; o_DEF] THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; IMP_IMP; IN_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + SIMP_TAC[LIM_WITHIN; GSYM DIST_NZ; REAL_MUL_RINV; NORM_EQ_0; + VECTOR_ARITH `(x - y = vec 0) <=> (x = y)`; + VECTOR_MUL_LID; VECTOR_SUB_REFL] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_ARITH `(a + b - (c + a)) - (vec 0 + vec 0) = b - c`]);; + +let DIFFERENTIABLE_IMP_CONTINUOUS_AT = prove + (`!f:real^M->real^N x. f differentiable (at x) ==> f continuous (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; + +let DIFFERENTIABLE_IMP_CONTINUOUS_ON = prove + (`!f:real^M->real^N s. f differentiable_on s ==> f continuous_on s`, + SIMP_TAC[differentiable_on; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]);; + +let HAS_DERIVATIVE_WITHIN_SUBSET = prove + (`!f s t x. (f has_derivative f') (at x within s) /\ t SUBSET s + ==> (f has_derivative f') (at x within t)`, + REWRITE_TAC[has_derivative_within] THEN MESON_TAC[LIM_WITHIN_SUBSET]);; + +let DIFFERENTIABLE_WITHIN_SUBSET = prove + (`!f:real^M->real^N s t. + f differentiable (at x within t) /\ s SUBSET t + ==> f differentiable (at x within s)`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_WITHIN_SUBSET]);; + +let DIFFERENTIABLE_ON_SUBSET = prove + (`!f:real^M->real^N s t. + f differentiable_on t /\ s SUBSET t ==> f differentiable_on s`, + REWRITE_TAC[differentiable_on] THEN + MESON_TAC[SUBSET; DIFFERENTIABLE_WITHIN_SUBSET]);; + +let DIFFERENTIABLE_ON_EMPTY = prove + (`!f. f differentiable_on {}`, + REWRITE_TAC[differentiable_on; NOT_IN_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Several results are easier using a "multiplied-out" variant. *) +(* (I got this idea from Dieudonne's proof of the chain rule). *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_WITHIN_ALT = prove + (`!f:real^M->real^N f' s x. + (f has_derivative f') (at x within s) <=> + linear f' /\ + !e. &0 < e + ==> ?d. &0 < d /\ + !y. y IN s /\ norm(y - x) < d + ==> norm(f(y) - f(x) - f'(y - x)) <= + e * norm(y - x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative_within; LIM_WITHIN] THEN + ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN + ASM_CASES_TAC `linear(f':real^M->real^N)` THEN + ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ] THEN + REWRITE_TAC[VECTOR_ARITH `a - (b + c) = a - b - c :real^M`] THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `&0 < norm(y - x :real^M)` THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [NORM_POS_LT]) THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; + VECTOR_ARITH `vec 0 - x = --x`; NORM_NEG] THEN + ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL]; + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / &2 * norm(y - x :real^M)` THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC]);; + +let HAS_DERIVATIVE_AT_ALT = prove + (`!f:real^M->real^N f' x. + (f has_derivative f') (at x) <=> + linear f' /\ + !e. &0 < e + ==> ?d. &0 < d /\ + !y. norm(y - x) < d + ==> norm(f(y) - f(x) - f'(y - x)) <= e * norm(y - x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* The chain rule. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_CHAIN_WITHIN = prove + (`!f:real^M->real^N g:real^N->real^P f' g' x s. + (f has_derivative f') (at x within s) /\ + (g has_derivative g') (at (f x) within (IMAGE f s)) + ==> ((g o f) has_derivative (g' o f'))(at x within s)`, + REPEAT GEN_TAC THEN SIMP_TAC[HAS_DERIVATIVE_WITHIN_ALT; LINEAR_COMPOSE] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B1:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN + DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC th) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> ASSUME_TAC th THEN X_CHOOSE_TAC `B2:real` (MATCH_MP + LINEAR_BOUNDED_POS th)) MP_TAC) THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN MP_TAC(SPEC `e / &2 / B2` th)) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / (&1 + B1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; REAL_LT_ADD] THEN + DISCH_THEN(X_CHOOSE_THEN `de:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT_01; REAL_MUL_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d0:real`; `de / (B1 + &1)`] REAL_DOWN2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_LT_01] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN + DISCH_TAC THEN UNDISCH_TAC + `!y. y IN s /\ norm(y - x) < d2 + ==> norm ((f:real^M->real^N) y - f x - f'(y - x)) <= norm(y - x)` THEN + DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_TRANS]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_TRANS]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) y`) THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[IN_IMAGE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `norm(f'(y - x)) + norm((f:real^M->real^N) y - f x - f'(y - x))` THEN + REWRITE_TAC[NORM_TRIANGLE_SUB] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B1 * norm(y - x) + norm(y - x :real^M)` THEN + ASM_SIMP_TAC[REAL_LE_ADD2] THEN + REWRITE_TAC[REAL_ARITH `a * x + x = x * (a + &1)`] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_ADD; REAL_LT_01] THEN + ASM_MESON_TAC[REAL_LT_TRANS]; + DISCH_TAC] THEN + REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm((g:real^N->real^P)(f(y:real^M)) - g(f x) - g'(f y - f x)) + + norm((g(f y) - g(f x) - g'(f'(y - x))) - + (g(f y) - g(f x) - g'(f y - f x)))` THEN + REWRITE_TAC[NORM_TRIANGLE_SUB] THEN + REWRITE_TAC[VECTOR_ARITH `(a - b - c1) - (a - b - c2) = c2 - c1:real^M`] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= d ==> b <= ee - d ==> a + b <= ee`)) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B2 * norm((f:real^M->real^N) y - f x - f'(y - x))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B2 * e / &2 / B2 * norm(y - x :real^M)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `b * ((e * h) * b') * x <= e * x - d <=> + d <= e * (&1 - h * b' * b) * x`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_ADD; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `norm(f'(y - x)) + norm((f:real^M->real^N) y - f x - f'(y - x))` THEN + REWRITE_TAC[NORM_TRIANGLE_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `u <= x * b /\ v <= b ==> u + v <= b * (&1 + x)`) THEN + ASM_REWRITE_TAC[]);; + +let DIFF_CHAIN_AT = prove + (`!f:real^M->real^N g:real^N->real^P f' g' x. + (f has_derivative f') (at x) /\ + (g has_derivative g') (at (f x)) + ==> ((g o f) has_derivative (g' o f')) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + ASM_MESON_TAC[DIFF_CHAIN_WITHIN; LIM_WITHIN_SUBSET; SUBSET_UNIV; + HAS_DERIVATIVE_WITHIN_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Composition rules stated just for differentiability. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_LINEAR = prove + (`!net f:real^M->real^N. linear f ==> f differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_LINEAR]);; + +let DIFFERENTIABLE_CONST = prove + (`!c net. (\z. c) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_CONST]);; + +let DIFFERENTIABLE_ID = prove + (`!net. (\z. z) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_ID]);; + +let DIFFERENTIABLE_LIFT_COMPONENT = prove + (`!net:(real^N)net. (\x. lift(x$i)) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_LIFT_COMPONENT]);; + +let DIFFERENTIABLE_CMUL = prove + (`!net f c. f differentiable net ==> (\x. c % f(x)) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_CMUL]);; + +let DIFFERENTIABLE_NEG = prove + (`!f net. f differentiable net ==> (\z. --(f z)) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_NEG]);; + +let DIFFERENTIABLE_ADD = prove + (`!f g net. + f differentiable net /\ + g differentiable net + ==> (\z. f z + g z) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_ADD]);; + +let DIFFERENTIABLE_SUB = prove + (`!f g net. + f differentiable net /\ + g differentiable net + ==> (\z. f z - g z) differentiable net`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_SUB]);; + +let DIFFERENTIABLE_VSUM = prove + (`!f net s. + FINITE s /\ + (!a. a IN s ==> (f a) differentiable net) + ==> (\x. vsum s (\a. f a x)) differentiable net`, + REPEAT GEN_TAC THEN REWRITE_TAC[differentiable] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; SKOLEM_THM; RIGHT_AND_EXISTS_THM] THEN + DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP HAS_DERIVATIVE_VSUM)) THEN + MESON_TAC[]);; + +let DIFFERENTIABLE_VSUM_NUMSEG = prove + (`!f net m n. + FINITE s /\ + (!i. m <= i /\ i <= n ==> (f i) differentiable net) + ==> (\x. vsum (m..n) (\a. f a x)) differentiable net`, + SIMP_TAC[DIFFERENTIABLE_VSUM; FINITE_NUMSEG; IN_NUMSEG]);; + +let DIFFERENTIABLE_CHAIN_AT = prove + (`!f g x. + f differentiable (at x) /\ + g differentiable (at(f x)) + ==> (g o f) differentiable (at x)`, + REWRITE_TAC[differentiable] THEN MESON_TAC[DIFF_CHAIN_AT]);; + +let DIFFERENTIABLE_CHAIN_WITHIN = prove + (`!f g x s. + f differentiable (at x within s) /\ + g differentiable (at(f x) within IMAGE f s) + ==> (g o f) differentiable (at x within s)`, + REWRITE_TAC[differentiable] THEN MESON_TAC[DIFF_CHAIN_WITHIN]);; + +let DIFFERENTIABLE_COMPONENTWISE_WITHIN = prove + (`!f:real^M->real^N a s. + f differentiable (at a within s) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift(f(x)$i)) differentiable (at a within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[differentiable] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [HAS_DERIVATIVE_COMPONENTWISE_WITHIN] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `g':real^M->real^N`) THEN + EXISTS_TAC `\i x. lift((g':real^M->real^N) x$i)` THEN ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_TAC `g':num->real^M->real^1`) THEN + EXISTS_TAC `(\x. lambda i. drop((g':num->real^M->real^1) i x)) + :real^M->real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]);; + +let DIFFERENTIABLE_COMPONENTWISE_AT = prove + (`!f:real^M->real^N a. + f differentiable (at a) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift(f(x)$i)) differentiable (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MATCH_ACCEPT_TAC DIFFERENTIABLE_COMPONENTWISE_WITHIN);; + +(* ------------------------------------------------------------------------- *) +(* Similarly for "differentiable_on". *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_ON_LINEAR = prove + (`!f:real^M->real^N s. linear f ==> f differentiable_on s`, + SIMP_TAC[differentiable_on; DIFFERENTIABLE_LINEAR]);; + +let DIFFERENTIABLE_ON_CONST = prove + (`!s c. (\z. c) differentiable_on s`, + REWRITE_TAC[differentiable_on; DIFFERENTIABLE_CONST]);; + +let DIFFERENTIABLE_ON_ID = prove + (`!s. (\z. z) differentiable_on s`, + REWRITE_TAC[differentiable_on; DIFFERENTIABLE_ID]);; + +let DIFFERENTIABLE_ON_COMPOSE = prove + (`!f g s. f differentiable_on s /\ g differentiable_on (IMAGE f s) + ==> (g o f) differentiable_on s`, + SIMP_TAC[differentiable_on; FORALL_IN_IMAGE] THEN + MESON_TAC[DIFFERENTIABLE_CHAIN_WITHIN]);; + +let DIFFERENTIABLE_ON_NEG = prove + (`!f s. f differentiable_on s ==> (\z. --(f z)) differentiable_on s`, + SIMP_TAC[differentiable_on; DIFFERENTIABLE_NEG]);; + +let DIFFERENTIABLE_ON_ADD = prove + (`!f g s. + f differentiable_on s /\ g differentiable_on s + ==> (\z. f z + g z) differentiable_on s`, + SIMP_TAC[differentiable_on; DIFFERENTIABLE_ADD]);; + +let DIFFERENTIABLE_ON_SUB = prove + (`!f g s. + f differentiable_on s /\ g differentiable_on s + ==> (\z. f z - g z) differentiable_on s`, + SIMP_TAC[differentiable_on; DIFFERENTIABLE_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* Uniqueness of derivative. *) +(* *) +(* The general result is a bit messy because we need approachability of the *) +(* limit point from any direction. But OK for nontrivial intervals etc. *) +(* ------------------------------------------------------------------------- *) + +let FRECHET_DERIVATIVE_UNIQUE_WITHIN = prove + (`!f:real^M->real^N f' f'' x s. + (f has_derivative f') (at x within s) /\ + (f has_derivative f'') (at x within s) /\ + (!i e. 1 <= i /\ i <= dimindex(:M) /\ &0 < e + ==> ?d. &0 < abs(d) /\ abs(d) < e /\ (x + d % basis i) IN s) + ==> f' = f''`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_derivative] THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(x:real^M) limit_point_of s` ASSUME_TAC THENL + [REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`1`; `e:real`]) THEN + ASM_REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(x:real^M) + d % basis 1` THEN + ASM_REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL; + VECTOR_MUL_EQ_0; REAL_MUL_RID; DE_MORGAN_THM; REAL_ABS_NZ; + BASIS_NONZERO]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + SUBGOAL_THEN `netlimit(at x within s) = x:real^M` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[NETLIMIT_WITHIN; TRIVIAL_LIMIT_WITHIN]; ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN + REWRITE_TAC[VECTOR_ARITH + `fx - (fa + f'') - (fx - (fa + f')):real^M = f' - f''`] THEN + DISCH_TAC THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + GEN_REWRITE_TAC I [TAUT `p = ~ ~p`] THEN + PURE_REWRITE_TAC[GSYM NORM_POS_LT] THEN DISCH_TAC THEN ABBREV_TAC + `e = norm((f':real^M->real^N) (basis i) - f''(basis i :real^M))` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `d:real`]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^M) + c % basis i`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL] THEN + ASM_SIMP_TAC[NORM_BASIS; REAL_MUL_RID] THEN + ASM_SIMP_TAC[LINEAR_CMUL; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_ABS] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_LT_REFL]);; + +let FRECHET_DERIVATIVE_UNIQUE_AT = prove + (`!f:real^M->real^N f' f'' x. + (f has_derivative f') (at x) /\ (f has_derivative f'') (at x) + ==> f' = f''`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_WITHIN THEN + MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `x:real^M`; `(:real^M)`] THEN + ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV] THEN + MESON_TAC[REAL_ARITH `&0 < e ==> &0 < abs(e / &2) /\ abs(e / &2) < e`]);; + +let HAS_FRECHET_DERIVATIVE_UNIQUE_AT = prove + (`!f:real^M->real^N f' x. + (f has_derivative f') (at x) + ==> frechet_derivative f (at x) = f'`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_AT THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `x:real^M`] THEN + ASM_REWRITE_TAC[frechet_derivative] THEN CONV_TAC SELECT_CONV THEN + ASM_MESON_TAC[]);; + +let FRECHET_DERIVATIVE_CONST_AT = prove + (`!c:real^N a:real^M. frechet_derivative (\x. c) (at a) = \h. vec 0`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_FRECHET_DERIVATIVE_UNIQUE_AT THEN + REWRITE_TAC[HAS_DERIVATIVE_CONST]);; + +let FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL = prove + (`!f:real^M->real^N f' f'' x a b. + (!i. 1 <= i /\ i <= dimindex(:M) ==> a$i < b$i) /\ + x IN interval[a,b] /\ + (f has_derivative f') (at x within interval[a,b]) /\ + (f has_derivative f'') (at x within interval[a,b]) + ==> f' = f''`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_WITHIN THEN + MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `x:real^M`; `interval[a:real^M,b]`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `e:real`] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[] `(?a. P a \/ P(--a)) ==> (?a:real. P a)`) THEN + EXISTS_TAC `(min ((b:real^M)$i - (a:real^M)$i) e) / &2` THEN + REWRITE_TAC[REAL_ABS_NEG; GSYM LEFT_OR_DISTRIB] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [UNDISCH_TAC `&0 < e` THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN REWRITE_TAC[IN_INTERVAL] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT] THEN + SUBGOAL_THEN + `!P. (!j. 1 <= j /\ j <= dimindex(:M) ==> P j) <=> + P i /\ + (!j. 1 <= j /\ j <= dimindex(:M) /\ ~(j = i) ==> P j)` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + UNDISCH_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL = prove + (`!f:real^M->real^N f' f'' x a b. + x IN interval(a,b) /\ + (f has_derivative f') (at x within interval(a,b)) /\ + (f has_derivative f'') (at x within interval(a,b)) + ==> f' = f''`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRECHET_DERIVATIVE_UNIQUE_WITHIN THEN + MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `x:real^M`; `interval(a:real^M,b)`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `e:real`] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[] `(?a. P a \/ P(--a)) ==> (?a:real. P a)`) THEN + EXISTS_TAC `(min ((b:real^M)$i - (a:real^M)$i) e) / &3` THEN + REWRITE_TAC[REAL_ABS_NEG; GSYM LEFT_OR_DISTRIB] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [UNDISCH_TAC `&0 < e` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `(x:real^M) IN interval(a,b)` THEN REWRITE_TAC[IN_INTERVAL] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT] THEN + SUBGOAL_THEN + `!P. (!j. 1 <= j /\ j <= dimindex(:M) ==> P j) <=> + P i /\ + (!j. 1 <= j /\ j <= dimindex(:M) /\ ~(j = i) ==> P j)` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_MUL_RID] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + UNDISCH_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let FRECHET_DERIVATIVE_AT = prove + (`!f:real^M->real^N f' x. + (f has_derivative f') (at x) ==> (f' = frechet_derivative f (at x))`, + MESON_TAC[has_derivative; FRECHET_DERIVATIVE_WORKS; + differentiable; FRECHET_DERIVATIVE_UNIQUE_AT]);; + +let FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL = prove + (`!f:real^M->real^N f' x a b. + (!i. 1 <= i /\ i <= dimindex(:M) ==> a$i < b$i) /\ + x IN interval[a,b] /\ + (f has_derivative f') (at x within interval[a,b]) + ==> frechet_derivative f (at x within interval[a,b]) = f'`, + ASM_MESON_TAC[has_derivative; FRECHET_DERIVATIVE_WORKS; + differentiable; FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL]);; + +(* ------------------------------------------------------------------------- *) +(* Component of the differential must be zero if it exists at a local *) +(* maximum or minimum for that corresponding component. Start with slightly *) +(* sharper forms that fix the sign of the derivative on the boundary. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM = prove + (`!f:real^M->real^N f' x s k e. + 1 <= k /\ k <= dimindex(:N) /\ + x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ + &0 < e /\ (!w. w IN s INTER ball(x,e) ==> (f x)$k <= (f w)$k) + ==> !y. y IN s ==> &0 <= (f'(y - x))$k`, + REWRITE_TAC[has_derivative_within] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `y:real^M = x` THENL + [ASM_MESON_TAC[VECTOR_SUB_REFL; LINEAR_0; VEC_COMPONENT; REAL_LE_REFL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN + DISCH_THEN(MP_TAC o SPEC + `--((f':real^M->real^N)(y - x)$k) / norm(y - x)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; + NOT_EXISTS_THM; REAL_ARITH `&0 < --x <=> x < &0`] THEN + X_GEN_TAC `d:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ABBREV_TAC `de = min (&1) ((min d e) / &2 / norm(y - x:real^M))` THEN + DISCH_THEN(MP_TAC o SPEC `x + de % (y - x):real^M`) THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; NOT_IMP; GSYM CONJ_ASSOC] THEN + SUBGOAL_THEN `norm(de % (y - x):real^M) < min d e` MP_TAC THENL + [ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; + NORM_POS_LT; VECTOR_SUB_EQ] THEN + EXPAND_TAC "de" THEN MATCH_MP_TAC(REAL_ARITH + `&0 < de / x ==> abs(min (&1) (de / &2 / x)) < de / x`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]; + REWRITE_TAC[REAL_LT_MIN] THEN STRIP_TAC] THEN + SUBGOAL_THEN `&0 < de /\ de <= &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "de" THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_01; REAL_HALF; REAL_LT_DIV; + NORM_POS_LT; VECTOR_SUB_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `x + a % (y - x):real^N = (&1 - a) % x + a % y`] THEN + MATCH_MP_TAC IN_CONVEX_SET THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + DISCH_TAC] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[NORM_MUL] THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_ARITH `&0 < x ==> &0 < abs x`; + NORM_POS_LT; VECTOR_SUB_EQ; VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC(NORM_ARITH + `abs(y$k) <= norm(y) /\ ~(abs(y$k) < e) ==> ~(norm y < e)`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_MUL; REAL_ABS_NORM; REAL_ABS_ABS] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_INV_MUL; REAL_ARITH + `d <= (a * inv b) * c <=> d <= (c * a) / b`] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; VECTOR_SUB_COMPONENT; + VECTOR_ADD_COMPONENT; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN + MATCH_MP_TAC(REAL_ARITH + `fx <= fy /\ a = --b /\ b < &0 ==> a <= abs(fy - (fx + b))`) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN + ASM_SIMP_TAC[real_abs; VECTOR_MUL_COMPONENT; REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x * y < &0 <=> &0 < x * --y`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_REWRITE_TAC[IN_INTER; IN_BALL; NORM_ARITH + `dist(x:real^M,x + e) = norm e`]);; + +let DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM = prove + (`!f:real^M->real^N f' x s k e. + 1 <= k /\ k <= dimindex(:N) /\ + x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ + &0 < e /\ (!w. w IN s INTER ball(x,e) ==> (f w)$k <= (f x)$k) + ==> !y. y IN s ==> (f'(y - x))$k <= &0`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. --((f:real^M->real^N) x)`; `\x. --((f':real^M->real^N) x)`; + `x:real^M`; `s:real^M->bool`; `k:num`; `e:real`] + DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM) THEN + ASM_SIMP_TAC[HAS_DERIVATIVE_NEG] THEN + ASM_SIMP_TAC[REAL_LE_NEG2; VECTOR_NEG_COMPONENT; REAL_NEG_GE0]);; + +let DROP_DIFFERENTIAL_POS_AT_MINIMUM = prove + (`!f:real^N->real^1 f' x s e. + x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ + &0 < e /\ (!w. w IN s INTER ball(x,e) ==> drop(f x) <= drop(f w)) + ==> !y. y IN s ==> &0 <= drop(f'(y - x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[drop] THEN STRIP_TAC THEN + MATCH_MP_TAC DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM THEN + MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `e:real`] THEN + ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; + +let DROP_DIFFERENTIAL_NEG_AT_MAXIMUM = prove + (`!f:real^N->real^1 f' x s e. + x IN s /\ convex s /\ (f has_derivative f') (at x within s) /\ + &0 < e /\ (!w. w IN s INTER ball(x,e) ==> drop(f w) <= drop(f x)) + ==> !y. y IN s ==> drop(f'(y - x)) <= &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[drop] THEN STRIP_TAC THEN + MATCH_MP_TAC DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM THEN + MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `e:real`] THEN + ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; + +let DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN = prove + (`!f:real^M->real^N f' x s k. + 1 <= k /\ k <= dimindex(:N) /\ + x IN s /\ open s /\ (f has_derivative f') (at x) /\ + ((!w. w IN s ==> (f w)$k <= (f x)$k) \/ + (!w. w IN s ==> (f x)$k <= (f w)$k)) + ==> !h. (f' h)$k = &0`, + REPEAT GEN_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MP_TAC(ISPECL [`f:real^M->real^N`; `f':real^M->real^N`; + `x:real^M`; `cball(x:real^M,e)`; `k:num`; `e:real`] + DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM); + MP_TAC(ISPECL [`f:real^M->real^N`; `f':real^M->real^N`; + `x:real^M`; `cball(x:real^M,e)`; `k:num`; `e:real`] + DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM)] THEN + ASM_SIMP_TAC[HAS_DERIVATIVE_AT_WITHIN; CENTRE_IN_CBALL; + CONVEX_CBALL; REAL_LT_IMP_LE; IN_INTER] THEN + DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `h:real^M` THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [has_derivative_at]) THEN + (ASM_CASES_TAC `h:real^M = vec 0` THENL + [ASM_MESON_TAC[LINEAR_0; VEC_COMPONENT]; ALL_TAC]) THEN + REMOVE_THEN "*" (fun th -> + MP_TAC(SPEC `x + e / norm h % h:real^M` th) THEN + MP_TAC(SPEC `x - e / norm h % h:real^M` th)) THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH + `dist(x:real^N,x - e) = norm e /\ dist(x:real^N,x + e) = norm e`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[real_abs; REAL_DIV_RMUL; NORM_EQ_0; REAL_LT_IMP_LE; + REAL_LE_REFL] THEN + REWRITE_TAC[VECTOR_ARITH `x - e - x:real^N = --e /\ (x + e) - x = e`] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_NEG th]) THEN + REWRITE_TAC[IMP_IMP; REAL_ARITH `&0 <= --x /\ &0 <= x <=> x = &0`; + VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= &0 /\ x <= &0 <=> x = &0`] THEN + DISCH_THEN(MP_TAC o AP_TERM `(*) (norm(h:real^M) / e)`) THEN + REWRITE_TAC[GSYM VECTOR_MUL_COMPONENT] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN + REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`; + NORM_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_LID]);; + +let DIFFERENTIAL_ZERO_MAXMIN_COMPONENT = prove + (`!f:real^M->real^N x e k. + 1 <= k /\ k <= dimindex(:N) /\ &0 < e /\ + ((!y. y IN ball(x,e) ==> (f y)$k <= (f x)$k) \/ + (!y. y IN ball(x,e) ==> (f x)$k <= (f y)$k)) /\ + f differentiable (at x) + ==> (jacobian f (at x) $ k = vec 0)`, + REWRITE_TAC[JACOBIAN_WORKS] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `\h. jacobian (f:real^M->real^N) (at x) ** h`; + `x:real^M`; `ball(x:real^M,e)`; `k:num`] + DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; OPEN_BALL] THEN + ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; FORALL_DOT_EQ_0]);; + +let DIFFERENTIAL_ZERO_MAXMIN = prove + (`!f:real^N->real^1 f' x s. + x IN s /\ open s /\ (f has_derivative f') (at x) /\ + ((!y. y IN s ==> drop(f y) <= drop(f x)) \/ + (!y. y IN s ==> drop(f x) <= drop(f y))) + ==> (f' = \v. vec 0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^1`; `f':real^N->real^1`; + `x:real^N`; `s:real^N->bool`; `1:num`] + DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN) THEN + ASM_REWRITE_TAC[GSYM drop; DIMINDEX_1; LE_REFL] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; FUN_EQ_THM; LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* The traditional Rolle theorem in one dimension. *) +(* ------------------------------------------------------------------------- *) + +let ROLLE = prove + (`!f:real^1->real^1 f' a b. + drop a < drop b /\ (f a = f b) /\ + f continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) ==> (f has_derivative f'(x)) (at x)) + ==> ?x. x IN interval(a,b) /\ (f'(x) = \v. vec 0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] + CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN + ASM_SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN + ANTS_TAC THENL [ASM_MESON_TAC[REAL_LT_REFL]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `c:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIFFERENTIAL_ZERO_MAXMIN THEN MAP_EVERY EXISTS_TAC + [`f:real^1->real^1`; `c:real^1`; `interval(a:real^1,b)`] THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET; OPEN_INTERVAL]);; + +(* ------------------------------------------------------------------------- *) +(* One-dimensional mean value theorem. *) +(* ------------------------------------------------------------------------- *) + +let MVT = prove + (`!f:real^1->real^1 f' a b. + drop a < drop b /\ + f continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) ==> (f has_derivative f'(x)) (at x)) + ==> ?x. x IN interval(a,b) /\ (f(b) - f(a) = f'(x) (b - a))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x. f(x) - (drop(f b - f a) / drop(b - a)) % x`; + `\k:real^1 x:real^1. + f'(k)(x) - (drop(f b - f a) / drop(b - a)) % x`; + `a:real^1`; `b:real^1`] + ROLLE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN + CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `(fa - k % a = fb - k % b) <=> (fb - fa = k % (b - a))`]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN + ASM_SIMP_TAC[HAS_DERIVATIVE_CMUL; HAS_DERIVATIVE_ID; ETA_AX]]; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real^1` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b - a:real^1`))] THEN + SIMP_TAC[VECTOR_SUB_EQ; GSYM DROP_EQ; DROP_SUB; DROP_CMUL] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_SUB_LT; REAL_LT_IMP_NZ]);; + +let MVT_SIMPLE = prove + (`!f:real^1->real^1 f' a b. + drop a < drop b /\ + (!x. x IN interval[a,b] + ==> (f has_derivative f'(x)) (at x within interval[a,b])) + ==> ?x. x IN interval(a,b) /\ (f(b) - f(a) = f'(x) (b - a))`, + MP_TAC MVT THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN + ASM_MESON_TAC[differentiable_on; differentiable]; + ASM_MESON_TAC[HAS_DERIVATIVE_WITHIN_OPEN; OPEN_INTERVAL; + HAS_DERIVATIVE_WITHIN_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED; + SUBSET]]);; + +let MVT_VERY_SIMPLE = prove + (`!f:real^1->real^1 f' a b. + drop a <= drop b /\ + (!x. x IN interval[a,b] + ==> (f has_derivative f'(x)) (at x within interval[a,b])) + ==> ?x. x IN interval[a,b] /\ (f(b) - f(a) = f'(x) (b - a))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^1 = a` THENL + [ASM_REWRITE_TAC[VECTOR_SUB_REFL] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^1`) THEN + REWRITE_TAC[INTERVAL_SING; IN_SING; has_derivative; UNWIND_THM2] THEN + MESON_TAC[LINEAR_0]; + ASM_REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN + DISCH_THEN(MP_TAC o MATCH_MP MVT_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* A nice generalization (see Havin's proof of 5.19 from Rudin's book). *) +(* ------------------------------------------------------------------------- *) + +let MVT_GENERAL = prove + (`!f:real^1->real^N f' a b. + drop a < drop b /\ + f continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) ==> (f has_derivative f'(x)) (at x)) + ==> ?x. x IN interval(a,b) /\ + norm(f(b) - f(a)) <= norm(f'(x) (b - a))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`(lift o (\y. (f(b) - f(a)) dot y)) o (f:real^1->real^N)`; + `\x t. lift((f(b:real^1) - f(a)) dot + ((f':real^1->real^1->real^N) x t))`; + `a:real^1`; `b:real^1`] MVT) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT; CONTINUOUS_ON_COMPOSE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC HAS_DERIVATIVE_LIFT_DOT THEN ASM_SIMP_TAC[ETA_AX]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^1` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; LIFT_EQ] THEN + DISCH_TAC THEN ASM_CASES_TAC `(f:real^1->real^N) b = f a` THENL + [ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; NORM_POS_LE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `norm((f:real^1->real^N) b - f a)` THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ; GSYM REAL_POW_2] THEN + ASM_REWRITE_TAC[NORM_POW_2; NORM_CAUCHY_SCHWARZ]);; + +(* ------------------------------------------------------------------------- *) +(* Still more general bound theorem. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_BOUND = prove + (`!f:real^M->real^N f' s B. + convex s /\ + (!x. x IN s ==> (f has_derivative f'(x)) (at x within s)) /\ + (!x. x IN s ==> onorm(f'(x)) <= B) + ==> !x y. x IN s /\ y IN s ==> norm(f(x) - f(y)) <= B * norm(x - y)`, + ONCE_REWRITE_TAC[NORM_SUB] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x y. x IN s ==> norm((f':real^M->real^M->real^N)(x) y) <= B * norm(y)` + ASSUME_TAC THENL + [ASM_MESON_TAC[ONORM; has_derivative; REAL_LE_TRANS; NORM_POS_LE; + REAL_LE_RMUL]; ALL_TAC] THEN + SUBGOAL_THEN + `!u. u IN interval[vec 0,vec 1] ==> (x + drop u % (y - x) :real^M) IN s` + ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL; FORALL_DIMINDEX_1; drop] THEN + SIMP_TAC[VEC_COMPONENT; LE_REFL; DIMINDEX_1] THEN + REWRITE_TAC[VECTOR_ARITH `x + u % (y - x) = (&1 - u) % x + u % y`] THEN + ASM_MESON_TAC[CONVEX_ALT]; + ALL_TAC] THEN + SUBGOAL_THEN + `!u. u IN interval(vec 0,vec 1) ==> (x + drop u % (y - x) :real^M) IN s` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN + MP_TAC(SPECL + [`(f:real^M->real^N) o (\u. x + drop u % (y - x))`; + `\u. (f':real^M->real^M->real^N) (x + drop u % (y - x)) o + (\u. vec 0 + drop u % (y - x))`; + `vec 0:real^1`; `vec 1:real^1`] MVT_GENERAL) THEN + REWRITE_TAC[o_THM; DROP_VEC; VECTOR_ARITH `x + &1 % (y - x) = y`; + VECTOR_MUL_LZERO; VECTOR_SUB_RZERO; VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN ANTS_TAC THENL + [ALL_TAC; ASM_MESON_TAC[VECTOR_ADD_LID; REAL_LE_TRANS]] THEN + REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_VMUL; + o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; differentiable; + CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; + ALL_TAC] THEN + X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `a IN interval(vec 0:real^1,vec 1) /\ + open(interval(vec 0:real^1,vec 1))` + MP_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL]; ALL_TAC] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM(MATCH_MP + HAS_DERIVATIVE_WITHIN_OPEN th)]) THEN + MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN + ASM_SIMP_TAC[HAS_DERIVATIVE_ADD; HAS_DERIVATIVE_CONST; + HAS_DERIVATIVE_VMUL_DROP; HAS_DERIVATIVE_ID] THEN + MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:real^M->bool` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* In particular. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_ZERO_CONSTANT = prove + (`!f:real^M->real^N s. + convex s /\ + (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x within s)) + ==> ?c. !x. x IN s ==> f(x) = c`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(\x h. vec 0):real^M->real^M->real^N`; + `s:real^M->bool`; `&0`] DIFFERENTIABLE_BOUND) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; ONORM_CONST; NORM_0; REAL_LE_REFL] THEN + SIMP_TAC[NORM_LE_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);; + +let HAS_DERIVATIVE_ZERO_UNIQUE = prove + (`!f s a c. convex s /\ a IN s /\ f a = c /\ + (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x within s)) + ==> !x. x IN s ==> f x = c`, + MESON_TAC[HAS_DERIVATIVE_ZERO_CONSTANT]);; + +let HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT = prove + (`!f:real^M->real^N s. + open s /\ connected s /\ + (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x)) + ==> ?c. !x. x IN s ==> f(x) = c`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN + DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = f a}`) THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL + [SIMP_TAC[open_in; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + REWRITE_TAC[SUBSET; IN_BALL] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `ball(x:real^M,e)`] + HAS_DERIVATIVE_ZERO_CONSTANT) THEN + REWRITE_TAC[IN_BALL; CONVEX_BALL] THEN + ASM_MESON_TAC[HAS_DERIVATIVE_AT_WITHIN; DIST_SYM; DIST_REFL]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN + MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT] THEN + ASM_MESON_TAC[differentiable]]);; + +let HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE = prove + (`!f s a c. open s /\ connected s /\ a IN s /\ f a = c /\ + (!x. x IN s ==> (f has_derivative (\h. vec 0)) (at x)) + ==> !x. x IN s ==> f x = c`, + MESON_TAC[HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiability of inverse function (most basic form). *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE_BASIC = prove + (`!f:real^M->real^N g f' g' t y. + (f has_derivative f') (at (g y)) /\ linear g' /\ (g' o f' = I) /\ + g continuous (at y) /\ + open t /\ y IN t /\ (!z. z IN t ==> (f(g(z)) = z)) + ==> (g has_derivative g') (at y)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `C:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN + SUBGOAL_THEN + `!e. &0 < e ==> ?d. &0 < d /\ + !z. norm(z - y) < d + ==> norm((g:real^N->real^M)(z) - g(y) - g'(z - y)) + <= e * norm(g(z) - g(y))` + ASSUME_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_DERIVATIVE_AT_ALT]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / C`)) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + DISCH_THEN(X_CHOOSE_THEN `d0:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(ASSUME_TAC o GEN `z:real^N` o SPEC `(g:real^N->real^M) z`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_at]) THEN + DISCH_THEN(MP_TAC o SPEC `d0:real`) THEN ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N` o + GEN_REWRITE_RULE I [open_def]) THEN + ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C * (e / C) * norm((g:real^N->real^M) z - g y)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_LE_RMUL; REAL_DIV_LMUL; + REAL_EQ_IMP_LE; REAL_LT_IMP_NZ; NORM_POS_LE]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C * norm(f((g:real^N->real^M) z) - y - f'(g z - g y))` THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_TRANS; REAL_LE_LMUL_EQ]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `norm(g'(f((g:real^N->real^M) z) - y - f'(g z - g y)):real^M)` THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[LINEAR_SUB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM NORM_NEG] THEN + REWRITE_TAC[VECTOR_ARITH + `--(gz:real^N - gy - (z - y)) = z - y - (gz - gy)`] THEN + ASM_MESON_TAC[REAL_LE_REFL; REAL_LT_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `?B d. &0 < B /\ &0 < d /\ + !z. norm(z - y) < d + ==> norm((g:real^N->real^M)(z) - g(y)) <= B * norm(z - y)` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `&2 * C` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `z:real^N` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `norm(dg) <= norm(dg') + norm(dg - dg') /\ + ((&2 * (&1 - h)) * norm(dg) = &1 * norm(dg)) /\ + norm(dg') <= c * norm(d) + ==> norm(dg - dg') <= h * norm(dg) + ==> norm(dg) <= (&2 * c) * norm(d)`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[NORM_TRIANGLE_SUB]; + ALL_TAC] THEN + REWRITE_TAC[HAS_DERIVATIVE_AT_ALT] THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + DISCH_THEN(X_CHOOSE_THEN `d':real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d:real`; `d':real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e / B * norm ((g:real^N->real^M) z - g y)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + ASM_MESON_TAC[REAL_MUL_SYM; REAL_LT_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Simply rewrite that based on the domain point x. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE_BASIC_X = prove + (`!f:real^M->real^N g f' g' t x. + (f has_derivative f') (at x) /\ linear g' /\ (g' o f' = I) /\ + g continuous (at (f(x))) /\ (g(f(x)) = x) /\ + open t /\ f(x) IN t /\ (!y. y IN t ==> (f(g(y)) = y)) + ==> (g has_derivative g') (at (f(x)))`, + MESON_TAC[HAS_DERIVATIVE_INVERSE_BASIC]);; + +(* ------------------------------------------------------------------------- *) +(* This is the version in Dieudonne', assuming continuity of f and g. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE_DIEUDONNE = prove + (`!f:real^M->real^N g s. + open s /\ open (IMAGE f s) /\ + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + (!x. x IN s ==> (g(f(x)) = x)) + ==> !f' g' x. x IN s /\ (f has_derivative f') (at x) /\ + linear g' /\ (g' o f' = I) + ==> (g has_derivative g') (at (f(x)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC_X THEN + EXISTS_TAC `f':real^M->real^N` THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; IN_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Here's the simplest way of not assuming much about g. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE = prove + (`!f:real^M->real^N g f' g' s x. + compact s /\ x IN s /\ f(x) IN interior(IMAGE f s) /\ + f continuous_on s /\ (!x. x IN s ==> (g(f(x)) = x)) /\ + (f has_derivative f') (at x) /\ linear g' /\ (g' o f' = I) + ==> (g has_derivative g') (at (f(x)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC_X THEN + EXISTS_TAC `f':real^M->real^N` THEN + EXISTS_TAC `interior(IMAGE (f:real^M->real^N) s)` THEN + ASM_MESON_TAC[CONTINUOUS_ON_INTERIOR; CONTINUOUS_ON_INVERSE; + OPEN_INTERIOR; IN_IMAGE; INTERIOR_SUBSET; SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Proving surjectivity via Brouwer fixpoint theorem. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_SURJECTIVE = prove + (`!f:real^N->real^N s t. + compact t /\ convex t /\ ~(t = {}) /\ f continuous_on t /\ + (!x y. x IN s /\ y IN t ==> x + (y - f(y)) IN t) + ==> !x. x IN s ==> ?y. y IN t /\ (f(y) = x)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `((f:real^N->real^N)(y) = x) <=> (x + (y - f(y)) = y)`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB; + BROUWER; SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_ID]);; + +let BROUWER_SURJECTIVE_CBALL = prove + (`!f:real^N->real^N s a e. + &0 < e /\ + f continuous_on cball(a,e) /\ + (!x y. x IN s /\ y IN cball(a,e) ==> x + (y - f(y)) IN cball(a,e)) + ==> !x. x IN s ==> ?y. y IN cball(a,e) /\ (f(y) = x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC BROUWER_SURJECTIVE THEN + ASM_REWRITE_TAC[COMPACT_CBALL; CONVEX_CBALL] THEN + ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LT_IMP_LE; REAL_NOT_LT]);; + +(* ------------------------------------------------------------------------- *) +(* See Sussmann: "Multidifferential calculus", Theorem 2.1.1 *) +(* ------------------------------------------------------------------------- *) + +let SUSSMANN_OPEN_MAPPING = prove + (`!f:real^M->real^N f' g' s x. + open s /\ f continuous_on s /\ + x IN s /\ (f has_derivative f') (at x) /\ linear g' /\ (f' o g' = I) + ==> !t. t SUBSET s /\ x IN interior(t) + ==> f(x) IN interior(IMAGE f t)`, + REWRITE_TAC[HAS_DERIVATIVE_AT_ALT] THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP LINEAR_BOUNDED_POS (ASSUME `linear(g':real^N->real^M)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1 / (&2 * B)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `e0:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN + DISCH_THEN(X_CHOOSE_THEN `e1:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`e0 / B`; `e1 / B`] REAL_DOWN2) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\y. (f:real^M->real^N)(x + g'(y - f(x)))`; + `cball((f:real^M->real^N) x,e / &2)`; `(f:real^M->real^N) x`; `e:real`] + BROUWER_SURJECTIVE_CBALL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(x:real^M,e1)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_CBALL; dist] THEN + REWRITE_TAC[VECTOR_ARITH `x - (x + y) = --y:real^N`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [NORM_SUB] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B * norm(y - (f:real^M->real^N) x)` THEN + ASM_REWRITE_TAC[NORM_NEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + g'(z - (f:real^M->real^N) x)`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_SUB] THEN ANTS_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * norm(z - (f:real^M->real^N) x)` THEN + ASM_REWRITE_TAC[NORM_NEG] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + ASM_MESON_TAC[IN_CBALL; dist; NORM_SUB; REAL_LET_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH `a - b - (c - b) = a - c:real^N`] THEN + DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `f0 - (y + z - f1) = (f1 - z) + (f0 - y):real^N`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `norm(f(x + g'(z - (f:real^M->real^N) x)) - z) + norm(f x - y)` THEN + REWRITE_TAC[NORM_TRIANGLE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x <= a ==> y <= b - a ==> x + y <= b`)) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `e / &2` THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_CBALL; dist]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `e / &2 <= e - x <=> x <= e / &2`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[REAL_ARITH `(&1 / &2 * b) * x <= e * &1 / &2 <=> x * b <= e`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B * norm(z - (f:real^M->real^N) x)` THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LE_LMUL_EQ; REAL_MUL_SYM; IN_CBALL; dist; DIST_SYM]; + ALL_TAC] THEN + REWRITE_TAC[IN_INTERIOR] THEN + DISCH_THEN(fun th -> EXISTS_TAC `e / &2` THEN MP_TAC th) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; SUBSET] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `x + g'(z - (f:real^M->real^N) x)` THEN REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[IN_CBALL; dist; VECTOR_ARITH `x - (x + y) = --y:real^N`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B * norm(z - (f:real^M->real^N) x)` THEN + ASM_REWRITE_TAC[NORM_NEG] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + ASM_MESON_TAC[IN_CBALL; dist; NORM_SUB; REAL_LT_IMP_LE; REAL_LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the following eccentric variant of the inverse function theorem. *) +(* This has no continuity assumptions, but we do need the inverse function. *) +(* We could put f' o g = I but this happens to fit with the minimal linear *) +(* algebra theory I've set up so far. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE_STRONG = prove + (`!f:real^N->real^N g f' g' s x. + open s /\ x IN s /\ f continuous_on s /\ + (!x. x IN s ==> (g(f(x)) = x)) /\ + (f has_derivative f') (at x) /\ (f' o g' = I) + ==> (g has_derivative g') (at (f(x)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC_X THEN + SUBGOAL_THEN `linear (g':real^N->real^N) /\ (g' o f' = I)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[has_derivative; RIGHT_INVERSE_LINEAR; LINEAR_INVERSE_LEFT]; + ALL_TAC] THEN + EXISTS_TAC `f':real^N->real^N` THEN + EXISTS_TAC `interior (IMAGE (f:real^N->real^N) s)` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[]; + REWRITE_TAC[OPEN_INTERIOR]; + ASM_MESON_TAC[INTERIOR_OPEN; SUSSMANN_OPEN_MAPPING; LINEAR_INVERSE_LEFT; + SUBSET_REFL; has_derivative]; + ASM_MESON_TAC[IN_IMAGE; SUBSET; INTERIOR_SUBSET]] THEN + REWRITE_TAC[continuous_at] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!t. t SUBSET s /\ x IN interior(t) + ==> (f:real^N->real^N)(x) IN interior(IMAGE f t)` + MP_TAC THENL + [ASM_MESON_TAC[SUSSMANN_OPEN_MAPPING; LINEAR_INVERSE_LEFT; has_derivative]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e) INTER s`) THEN ANTS_TAC THENL + [ASM_SIMP_TAC[IN_INTER; OPEN_BALL; INTERIOR_OPEN; OPEN_INTER; + INTER_SUBSET; CENTRE_IN_BALL]; + ALL_TAC] THEN + REWRITE_TAC[IN_INTERIOR] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_IMAGE; IN_INTER] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC MONO_IMP THEN + ASM_MESON_TAC[DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* A rewrite based on the other domain. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE_STRONG_X = prove + (`!f:real^N->real^N g f' g' s y. + open s /\ (g y) IN s /\ f continuous_on s /\ + (!x. x IN s ==> (g(f(x)) = x)) /\ + (f has_derivative f') (at (g y)) /\ (f' o g' = I) /\ + f(g y) = y + ==> (g has_derivative g') (at y)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN + MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN + MAP_EVERY EXISTS_TAC [`f':real^N->real^N`; `s:real^N->bool`] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* On a region. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_INVERSE_ON = prove + (`!f:real^N->real^N s. + open s /\ + (!x. x IN s ==> (f has_derivative f'(x)) (at x) /\ (g(f(x)) = x) /\ + (f'(x) o g'(x) = I)) + ==> !x. x IN s ==> (g has_derivative g'(x)) (at (f(x)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN + EXISTS_TAC `(f':real^N->real^N->real^N) x` THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; + DIFFERENTIABLE_IMP_CONTINUOUS_AT; differentiable]);; + +(* ------------------------------------------------------------------------- *) +(* Invertible derivative continous at a point implies local injectivity. *) +(* It's only for this we need continuity of the derivative, except of course *) +(* if we want the fact that the inverse derivative is also continuous. So if *) +(* we know for some other reason that the inverse function exists, it's OK. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_LOCALLY_INJECTIVE = prove + (`!f:real^M->real^N f' g' s a. + a IN s /\ open s /\ linear g' /\ (g' o f'(a) = I) /\ + (!x. x IN s ==> (f has_derivative f'(x)) (at x)) /\ + (!e. &0 < e + ==> ?d. &0 < d /\ + !x. dist(a,x) < d ==> onorm(\v. f'(x) v - f'(a) v) < e) + ==> ?t. a IN t /\ open t /\ + !x x'. x IN t /\ x' IN t /\ (f x' = f x) ==> (x' = x)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < onorm(g':real^N->real^M)` ASSUME_TAC THENL + [ASM_SIMP_TAC[ONORM_POS_LT] THEN ASM_MESON_TAC[VEC_EQ; ARITH_EQ]; + ALL_TAC] THEN + ABBREV_TAC `k = &1 / onorm(g':real^N->real^M) / &2` THEN + SUBGOAL_THEN + `?d. &0 < d /\ ball(a,d) SUBSET s /\ + !x. x IN ball(a,d) + ==> onorm(\v. (f':real^M->real^M->real^N)(x) v - f'(a) v) < k` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `k:real`) THEN EXPAND_TAC "k" THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_BALL] THEN DISCH_THEN(X_CHOOSE_TAC `d2:real`) THEN + EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN; IN_BALL] THEN + ASM_MESON_TAC[REAL_LT_TRANS]; + ALL_TAC] THEN + EXISTS_TAC `ball(a:real^M,d)` THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `x':real^M`] THEN STRIP_TAC THEN + ABBREV_TAC `ph = \w. w - g'(f(w) - (f:real^M->real^N)(x))` THEN + SUBGOAL_THEN `norm((ph:real^M->real^M) x' - ph x) <= norm(x' - x) / &2` + MP_TAC THENL + [ALL_TAC; + EXPAND_TAC "ph" THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; GSYM NORM_LE_0] THEN REAL_ARITH_TAC] THEN + SUBGOAL_THEN + `!u v:real^M. u IN ball(a,d) /\ v IN ball(a,d) + ==> norm(ph u - ph v :real^M) <= norm(u - v) / &2` + (fun th -> ASM_SIMP_TAC[th]) THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC DIFFERENTIABLE_BOUND THEN + REWRITE_TAC[CONVEX_BALL; OPEN_BALL] THEN + EXISTS_TAC `\x v. v - g'((f':real^M->real^M->real^N) x v)` THEN + CONJ_TAC THEN X_GEN_TAC `u:real^M` THEN DISCH_TAC THEN REWRITE_TAC[] THENL + [EXPAND_TAC "ph" THEN + MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_DERIVATIVE_ID] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN + GEN_REWRITE_TAC (RATOR_CONV o BINDER_CONV) [GSYM VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN REWRITE_TAC[HAS_DERIVATIVE_CONST] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN + ONCE_REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[HAS_DERIVATIVE_LINEAR; SUBSET; HAS_DERIVATIVE_AT_WITHIN]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\w. w - g'((f':real^M->real^M->real^N) u w)) = + g' o (\w. f' a w - f' u w)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[LINEAR_SUB]; + ALL_TAC] THEN + SUBGOAL_THEN `linear(\w. f' a w - (f':real^M->real^M->real^N) u w)` + ASSUME_TAC THENL + [MATCH_MP_TAC LINEAR_COMPOSE_SUB THEN ONCE_REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[has_derivative; SUBSET; CENTRE_IN_BALL]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `onorm(g':real^N->real^M) * + onorm(\w. f' a w - (f':real^M->real^M->real^N) u w)` THEN + ASM_SIMP_TAC[ONORM_COMPOSE] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_ARITH `inv(&2) * x = (&1 * x) * inv(&2)`] THEN + ASM_REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `onorm(\w. (f':real^M->real^M->real^N) a w - f' u w) = + onorm(\w. f' u w - f' a w)` + (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE]) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_NEG_SUB] THEN + MATCH_MP_TAC ONORM_NEG THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN + ASM_SIMP_TAC[LINEAR_COMPOSE_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* More conventional "C1" version of inverse function theorem. *) +(* ------------------------------------------------------------------------- *) + +let INVERSE_FUNCTION_C1 = prove + (`!f:real^N->real^N f' a s. + a IN s /\ open s /\ + (!x. x IN s ==> (f has_derivative f'(x)) (at x)) /\ + (!e. &0 < e + ==> ?d. &0 < d /\ + !x. dist(a,x) < d ==> onorm(\v. f'(x) v - f'(a) v) < e) /\ + ~(det(matrix(f' a)) = &0) + ==> ?t u g. open t /\ a IN t /\ open u /\ f(a) IN u /\ + (!x. x IN t ==> g(f(x)) = x) /\ + (!y. y IN u ==> f(g(y)) = y) /\ + g differentiable_on u`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^N. lift(det(matrix(f' x:real^N->real^N)))) continuous at a` + ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + REWRITE_TAC[GSYM MATRIX_SUB_COMPONENT] THEN + W(MP_TAC o PART_MATCH lhand MATRIX_COMPONENT_LE_ONORM o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB] THEN BINOP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM] MATRIX_WORKS) THEN + RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?u. a IN u /\ open u /\ + !x:real^N. x IN u ==> ~(det(matrix(f' x:real^N->real^N)) = &0)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_at]) THEN + DISCH_THEN(MP_TAC o SPEC + `abs(det(matrix((f':real^N->real^N->real^N) a)))`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < abs x <=> ~(x = &0)`] THEN + REWRITE_TAC[DIST_LIFT; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real` THEN STRIP_TAC THEN + EXISTS_TAC `ball(a:real^N,d)` THEN + ASM_REWRITE_TAC[DIST_REFL; OPEN_BALL; IN_BALL] THEN + ASM_MESON_TAC[DIST_SYM; REAL_ARITH `abs(x - y) < abs y ==> ~(x = &0)`]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INVERTIBLE_DET_NZ]) THEN + SUBGOAL_THEN `!x. x IN s ==> linear((f':real^N->real^N->real^N) x)` + ASSUME_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN + ASM_SIMP_TAC[MATRIX_INVERTIBLE] THEN + DISCH_THEN(X_CHOOSE_THEN `g'a:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `f':real^N->real^N->real^N`; + `g'a:real^N->real^N`; `s:real^N->bool`; `a:real^N`] + HAS_DERIVATIVE_LOCALLY_INJECTIVE) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `t:real^N->bool`] + INJECTIVE_ON_LEFT_INVERSE) THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x. x IN s INTER u + ==> ?g. linear g /\ (f':real^N->real^N->real^N) x o g = I /\ + g o f' x = I` + MP_TAC THENL + [ASM_SIMP_TAC[IN_INTER; GSYM MATRIX_INVERTIBLE; INVERTIBLE_DET_NZ]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `g':real^N->real^N->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `interior (IMAGE (f:real^N->real^N) (s INTER t INTER u))` THEN + SIMP_TAC[OPEN_INTERIOR; DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real^N->real^N`; `(f':real^N->real^N->real^N) a`; + `g'a:real^N->real^N`; `s INTER t INTER u:real^N->bool`; + `a:real^N`] + SUSSMANN_OPEN_MAPPING) THEN + ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN ANTS_TAC THENL + [ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_AT; + CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_INTER; + differentiable; SUBSET; IN_INTER]; + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_INTER; IN_INTER]]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[MESON[SUBSET; INTERIOR_SUBSET] + `(!x. x IN interior s ==> P x) <=> + (!x. x IN s ==> x IN interior s ==> P x)`] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_INTER]; ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[differentiable] THEN + EXISTS_TAC `(g':real^N->real^N->real^N) x` THEN + MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_STRONG THEN + EXISTS_TAC `(f':real^N->real^N->real^N) x` THEN + EXISTS_TAC `s INTER t INTER u:real^N->bool` THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN + ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN + ASM_MESON_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_AT; + CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_INTER; + differentiable; SUBSET; IN_INTER]);; + +(* ------------------------------------------------------------------------- *) +(* Uniformly convergent sequence of derivatives. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ = prove + (`!s f:num->real^M->real^N f' g'. + convex s /\ + (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ + (!e. &0 < e + ==> ?N. !n x h. n >= N /\ x IN s + ==> norm(f' n x h - g' x h) <= e * norm(h)) + ==> !e. &0 < e + ==> ?N. !m n x y. m >= N /\ n >= N /\ x IN s /\ y IN s + ==> norm((f m x - f n x) - (f m y - f n y)) + <= e * norm(x - y)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + ASM_CASES_TAC `m:num >= N` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n:num >= N` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIFFERENTIABLE_BOUND THEN + EXISTS_TAC `\x h. (f':num->real^M->real^M->real^N) m x h - f' n x h` THEN + ASM_SIMP_TAC[HAS_DERIVATIVE_SUB; ETA_AX] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!h. norm((f':num->real^M->real^M->real^N) m x h - f' n x h) <= e * norm(h)` + MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[HAS_DERIVATIVE_WITHIN_ALT]) THEN + ASM_SIMP_TAC[ONORM; LINEAR_COMPOSE_SUB; ETA_AX] THEN + X_GEN_TAC `h:real^M` THEN SUBST1_TAC(VECTOR_ARITH + `(f':num->real^M->real^M->real^N) m x h - f' n x h = + (f' m x h - g' x h) + --(f' n x h - g' x h)`) THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN + ASM_SIMP_TAC[NORM_NEG; REAL_ARITH + `a <= e / &2 * h /\ b <= e / &2 * h ==> a + b <= e * h`]);; + +let HAS_DERIVATIVE_SEQUENCE = prove + (`!s f:num->real^M->real^N f' g'. + convex s /\ + (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ + (!e. &0 < e + ==> ?N. !n x h. n >= N /\ x IN s + ==> norm(f' n x h - g' x h) <= e * norm(h)) /\ + (?x l. x IN s /\ ((\n. f n x) --> l) sequentially) + ==> ?g. !x. x IN s + ==> ((\n. f n x) --> g x) sequentially /\ + (g has_derivative g'(x)) (at x within s)`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "O") MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x0:real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_TAC "A" + `!e. &0 < e + ==> ?N. !m n x y. m >= N /\ n >= N /\ x IN s /\ y IN s + ==> norm(((f:num->real^M->real^N) m x - f n x) - + (f m y - f n y)) + <= e * norm(x - y)` + [MATCH_MP_TAC HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]] THEN + SUBGOAL_THEN + `?g:real^M->real^N. !x. x IN s ==> ((\n. f n x) --> g x) sequentially` + MP_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + GEN_REWRITE_TAC I [CONVERGENT_EQ_CAUCHY] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN + REWRITE_TAC[cauchy; dist] THEN DISCH_THEN(LABEL_TAC "B") THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^M = x0` THEN ASM_SIMP_TAC[] THEN + REMOVE_THEN "B" (MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "A" (MP_TAC o SPEC `e / &2 / norm(x - x0:real^M)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_HALF; VECTOR_SUB_EQ] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN (STRIP_ASSUME_TAC o MATCH_MP + (ARITH_RULE `m >= N1 + N2:num ==> m >= N1 /\ m >= N2`))) THEN + SUBST1_TAC(VECTOR_ARITH + `(f:num->real^M->real^N) m x - f n x = + (f m x - f n x - (f m x0 - f n x0)) + (f m x0 - f n x0)`) THEN + MATCH_MP_TAC NORM_TRIANGLE_LT THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`m:num`; `n:num`; `x:real^M`; `x0:real^M`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN + DISCH_THEN(LABEL_TAC "B") THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN + SUBGOAL_TAC "C" + `!e. &0 < e + ==> ?N. !n x y. n >= N /\ x IN s /\ y IN s + ==> norm(((f:num->real^M->real^N) n x - f n y) - + (g x - g y)) + <= e * norm(x - y)` + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "A" (MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN `m:num` o SPECL + [`m:num`; `u:real^M`; `v:real^M`]) THEN + DISCH_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC + `\m. ((f:num->real^M->real^N) n u - f n v) - (f m u - f m v)` THEN + REWRITE_TAC[eventually; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_SIMP_TAC[SEQUENTIALLY; LIM_SUB; LIM_CONST] THEN EXISTS_TAC `N:num` THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `(x - y) - (u - v) = (x - u) - (y - v):real^N`] THEN + ASM_MESON_TAC[GE_REFL]] THEN + CONJ_TAC THENL + [SUBGOAL_TAC "D" + `!u. ((\n. (f':num->real^M->real^M->real^N) n x u) --> g' x u) sequentially` + [REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `u = vec 0:real^M` THENL + [REMOVE_THEN "O" (MP_TAC o SPEC `e:real`); + REMOVE_THEN "O" (MP_TAC o SPEC `e / &2 / norm(u:real^M)`)] THEN + ASM_SIMP_TAC[NORM_POS_LT; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `u:real^M`]) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[GE; NORM_0; REAL_MUL_RZERO; NORM_LE_0] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC] THEN + REWRITE_TAC[linear] THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`]; + MAP_EVERY X_GEN_TAC [`c:real`; `u:real^M`]] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THENL + [EXISTS_TAC + `\n. (f':num->real^M->real^M->real^N) n x (u + v) - + (f' n x u + f' n x v)`; + EXISTS_TAC + `\n. (f':num->real^M->real^M->real^N) n x (c % u) - + c % f' n x u`] THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUB; LIM_ADD; LIM_CMUL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[has_derivative_within; linear]) THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; LIM_CONST]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MAP_EVERY (fun s -> REMOVE_THEN s (MP_TAC o SPEC `e / &3`)) ["C"; "O"] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "C")) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "A")) THEN + REMOVE_THEN "C" (MP_TAC o GEN `y:real^M` o + SPECL [`N1 + N2:num`; `x:real^M`; `y - x:real^M`]) THEN + REMOVE_THEN "A" (MP_TAC o GEN `y:real^M` o + SPECL [`N1 + N2:num`; `y:real^M`; `x:real^M`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`N1 + N2:num`; `x:real^M`]) THEN + ASM_REWRITE_TAC[ARITH_RULE `m + n >= m:num /\ m + n >= n`] THEN + REWRITE_TAC[HAS_DERIVATIVE_WITHIN_ALT] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3` o CONJUNCT2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(LABEL_TAC "D1") THEN DISCH_THEN(LABEL_TAC "D2") THEN + EXISTS_TAC `d1:real` THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^M` THEN + DISCH_TAC THEN REMOVE_THEN "D2" (MP_TAC o SPEC `y:real^M`) THEN + REMOVE_THEN "D1" (MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_TRANS; NORM_SUB]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_TRANS; NORM_SUB]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `d <= a + b + c + ==> a <= e / &3 * n ==> b <= e / &3 * n ==> c <= e / &3 * n + ==> d <= e * n`) THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV o LAND_CONV) [NORM_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `(norm(x + y + z) = norm(a)) /\ + norm(x + y + z) <= norm(x) + norm(y + z) /\ + norm(y + z) <= norm(y) + norm(z) + ==> norm(a) <= norm(x) + norm(y) + norm(z)`) THEN + REWRITE_TAC[NORM_TRIANGLE] THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Can choose to line up antiderivatives if we want. *) +(* ------------------------------------------------------------------------- *) + +let HAS_ANTIDERIVATIVE_SEQUENCE = prove + (`!s f:num->real^M->real^N f' g'. + convex s /\ + (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ + (!e. &0 < e + ==> ?N. !n x h. n >= N /\ x IN s + ==> norm(f' n x h - g' x h) <= e * norm(h)) + ==> ?g. !x. x IN s ==> (g has_derivative g'(x)) (at x within s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(s:real^M->bool) = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^M`) THEN + MP_TAC(ISPECL + [`s:real^M->bool`; + `\n x. (f:num->real^M->real^N) n x + (f 0 a - f n a)`; + `f':num->real^M->real^M->real^N`; + `g':real^M->real^M->real^N`] + HAS_DERIVATIVE_SEQUENCE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(f':num->real^M->real^M->real^N) n x = + \h. f' n x h + vec 0` + SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN + ASM_SIMP_TAC[HAS_DERIVATIVE_CONST; ETA_AX]; + MAP_EVERY EXISTS_TAC [`a:real^M`; `f 0 (a:real^M) :real^N`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + b - a = b:real^N`; LIM_CONST]]);; + +let HAS_ANTIDERIVATIVE_LIMIT = prove + (`!s g':real^M->real^M->real^N. + convex s /\ + (!e. &0 < e + ==> ?f f'. !x. x IN s + ==> (f has_derivative (f' x)) (at x within s) /\ + (!h. norm(f' x h - g' x h) <= e * norm(h))) + ==> ?g. !x. x IN s ==> (g has_derivative g'(x)) (at x within s)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[SKOLEM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_ANTIDERIVATIVE_SEQUENCE THEN + UNDISCH_TAC `convex(s:real^M->bool)` THEN SIMP_TAC[] THEN + DISCH_THEN(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:num->real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':num->real^M->real^M->real^N` THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `h:real^M`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&n + &1) * norm(h:real^M)` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&N)` THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Differentiation of a series. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_SERIES = prove + (`!s f:num->real^M->real^N f' g' k. + convex s /\ + (!n x. x IN s ==> ((f n) has_derivative (f' n x)) (at x within s)) /\ + (!e. &0 < e + ==> ?N. !n x h. n >= N /\ x IN s + ==> norm(vsum(k INTER (0..n)) (\i. f' i x h) - + g' x h) <= e * norm(h)) /\ + (?x l. x IN s /\ ((\n. f n x) sums l) k) + ==> ?g. !x. x IN s ==> ((\n. f n x) sums (g x)) k /\ + (g has_derivative g'(x)) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC HAS_DERIVATIVE_SEQUENCE THEN EXISTS_TAC + `\n:num x:real^M h:real^M. vsum(k INTER (0..n)) (\n. f' n x h):real^N` THEN + ASM_SIMP_TAC[ETA_AX; FINITE_INTER_NUMSEG; HAS_DERIVATIVE_VSUM]);; + +(* ------------------------------------------------------------------------- *) +(* Derivative with composed bilinear function. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_BILINEAR_WITHIN = prove + (`!h:real^M->real^N->real^P f g f' g' x:real^Q s. + (f has_derivative f') (at x within s) /\ + (g has_derivative g') (at x within s) /\ + bilinear h + ==> ((\x. h (f x) (g x)) has_derivative + (\d. h (f x) (g' d) + h (f' d) (g x))) (at x within s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_TAC "contg" `((g:real^Q->real^N) --> g(x)) (at x within s)` + [REWRITE_TAC[GSYM CONTINUOUS_WITHIN] THEN + ASM_MESON_TAC[differentiable; DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN]] THEN + UNDISCH_TAC `((f:real^Q->real^M) has_derivative f') (at x within s)` THEN + REWRITE_TAC[has_derivative_within] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "df")) THEN + SUBGOAL_TAC "contf" + `((\y. (f:real^Q->real^M)(x) + f'(y - x)) --> f(x)) (at x within s)` + [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN + SUBGOAL_THEN `vec 0 = (f':real^Q->real^M)(x - x)` SUBST1_TAC THENL + [ASM_MESON_TAC[LINEAR_0; VECTOR_SUB_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[LIM_LINEAR; LIM_SUB; LIM_CONST; LIM_WITHIN_ID]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_derivative_within]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "dg")) THEN + CONJ_TAC THENL + [FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [bilinear]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[linear]) THEN ASM_REWRITE_TAC[linear] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`at (x:real^Q) within s`; `h:real^M->real^N->real^P`] + LIM_BILINEAR) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + REMOVE_THEN "contg" MP_TAC THEN REMOVE_THEN "df" MP_TAC THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + REMOVE_THEN "dg" MP_TAC THEN REMOVE_THEN "contf" MP_TAC THEN + ONCE_REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + SUBGOAL_THEN + `((\y:real^Q. inv(norm(y - x)) % + (h:real^M->real^N->real^P) (f'(y - x)) (g'(y - x))) + --> vec 0) (at x within s)` + MP_TAC THENL + [FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP + BILINEAR_BOUNDED_POS) THEN + X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC + (MATCH_MP LINEAR_BOUNDED_POS (ASSUME `linear (f':real^Q->real^M)`)) THEN + X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC + (MATCH_MP LINEAR_BOUNDED_POS (ASSUME `linear (g':real^Q->real^N)`)) THEN + REWRITE_TAC[LIM_WITHIN; dist; VECTOR_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `e / (B * C * D)` THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_MUL; REAL_LT_MUL] THEN + X_GEN_TAC `x':real^Q` THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ABS_INV] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `inv(norm(x' - x :real^Q)) * + B * (C * norm(x' - x)) * (D * norm(x' - x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE] THEN + ASM_MESON_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE; REAL_LE_MUL2; NORM_POS_LE; + REAL_LE_TRANS]; + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `i * b * (c * x) * (d * x) = (i * x) * x * (b * c * d)`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_MUL]]; + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + REWRITE_TAC (map (C MATCH_MP (ASSUME `bilinear(h:real^M->real^N->real^P)`)) + [BILINEAR_RZERO; BILINEAR_LZERO; BILINEAR_LADD; BILINEAR_RADD; + BILINEAR_LMUL; BILINEAR_RMUL; BILINEAR_LSUB; BILINEAR_RSUB]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC]);; + +let HAS_DERIVATIVE_BILINEAR_AT = prove + (`!h:real^M->real^N->real^P f g f' g' x:real^Q. + (f has_derivative f') (at x) /\ + (g has_derivative g') (at x) /\ + bilinear h + ==> ((\x. h (f x) (g x)) has_derivative + (\d. h (f x) (g' d) + h (f' d) (g x))) (at x)`, + REWRITE_TAC[has_derivative_at] THEN + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[GSYM has_derivative_within; HAS_DERIVATIVE_BILINEAR_WITHIN]);; + +let BILINEAR_DIFFERENTIABLE_AT_COMPOSE = prove + (`!f:real^M->real^N g:real^M->real^P h:real^N->real^P->real^Q a. + f differentiable at a /\ g differentiable at a /\ bilinear h + ==> (\x. h (f x) (g x)) differentiable at a`, + REPEAT GEN_TAC THEN REWRITE_TAC[FRECHET_DERIVATIVE_WORKS] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_AT) THEN + REWRITE_TAC[GSYM FRECHET_DERIVATIVE_WORKS; differentiable] THEN + MESON_TAC[]);; + +let BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE = prove + (`!f:real^M->real^N g:real^M->real^P h:real^N->real^P->real^Q x s. + f differentiable at x within s /\ g differentiable at x within s /\ + bilinear h + ==> (\x. h (f x) (g x)) differentiable at x within s`, + REPEAT GEN_TAC THEN REWRITE_TAC[FRECHET_DERIVATIVE_WORKS] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_WITHIN) THEN + REWRITE_TAC[GSYM FRECHET_DERIVATIVE_WORKS; differentiable] THEN + MESON_TAC[]);; + +let BILINEAR_DIFFERENTIABLE_ON_COMPOSE = prove + (`!f:real^M->real^N g:real^M->real^P h:real^N->real^P->real^Q s. + f differentiable_on s /\ g differentiable_on s /\ bilinear h + ==> (\x. h (f x) (g x)) differentiable_on s`, + REWRITE_TAC[differentiable_on] THEN + MESON_TAC[BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE]);; + +let DIFFERENTIABLE_AT_LIFT_DOT2 = prove + (`!f:real^M->real^N g x. + f differentiable at x /\ g differentiable at x + ==> (\x. lift(f x dot g x)) differentiable at x`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_DIFFERENTIABLE_AT_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +let DIFFERENTIABLE_WITHIN_LIFT_DOT2 = prove + (`!f:real^M->real^N g x s. + f differentiable (at x within s) /\ g differentiable (at x within s) + ==> (\x. lift(f x dot g x)) differentiable (at x within s)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +let DIFFERENTIABLE_ON_LIFT_DOT2 = prove + (`!f:real^M->real^N g s. + f differentiable_on s /\ g differentiable_on s + ==> (\x. lift(f x dot g x)) differentiable_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_DIFFERENTIABLE_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +let HAS_DERIVATIVE_MUL_WITHIN = prove + (`!f f' g:real^M->real^N g' a s. + ((lift o f) has_derivative (lift o f')) (at a within s) /\ + (g has_derivative g') (at a within s) + ==> ((\x. f x % g x) has_derivative + (\h. f a % g' h + f' h % g a)) (at a within s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[BILINEAR_DROP_MUL] + (ISPEC `\x y:real^M. drop x % y` HAS_DERIVATIVE_BILINEAR_WITHIN))) THEN + REWRITE_TAC[o_DEF; DROP_CMUL; LIFT_DROP]);; + +let HAS_DERIVATIVE_MUL_AT = prove + (`!f f' g:real^M->real^N g' a. + ((lift o f) has_derivative (lift o f')) (at a) /\ + (g has_derivative g') (at a) + ==> ((\x. f x % g x) has_derivative + (\h. f a % g' h + f' h % g a)) (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_DERIVATIVE_MUL_WITHIN]);; + +let HAS_DERIVATIVE_SQNORM_AT = prove + (`!a:real^N. + ((\x. lift(norm x pow 2)) has_derivative (\x. &2 % lift(a dot x))) (at a)`, + GEN_TAC THEN MP_TAC(ISPECL + [`\x y:real^N. lift(x dot y)`; + `\x:real^N. x`; `\x:real^N. x`; `\x:real^N. x`; `\x:real^N. x`; + `a:real^N`] HAS_DERIVATIVE_BILINEAR_AT) THEN + REWRITE_TAC[HAS_DERIVATIVE_ID; BILINEAR_DOT; NORM_POW_2] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; DOT_SYM] THEN VECTOR_ARITH_TAC);; + +let DIFFERENTIABLE_MUL_WITHIN = prove + (`!f g:real^M->real^N a s. + (lift o f) differentiable (at a within s) /\ + g differentiable (at a within s) + ==> (\x. f x % g x) differentiable (at a within s)`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`lift o (f:real^M->real)`; `g:real^M->real^N`; `\x y:real^N. drop x % y`; + `a:real^M`; `s:real^M->bool`] BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; BILINEAR_DROP_MUL]);; + +let DIFFERENTIABLE_MUL_AT = prove + (`!f g:real^M->real^N a. + (lift o f) differentiable (at a) /\ g differentiable (at a) + ==> (\x. f x % g x) differentiable (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[DIFFERENTIABLE_MUL_WITHIN]);; + +let DIFFERENTIABLE_SQNORM_AT = prove + (`!a:real^N. (\x. lift(norm x pow 2)) differentiable (at a)`, + REWRITE_TAC[differentiable] THEN MESON_TAC[HAS_DERIVATIVE_SQNORM_AT]);; + +let DIFFERENTIABLE_ON_MUL = prove + (`!f g:real^M->real^N s. + (lift o f) differentiable_on s /\ g differentiable_on s + ==> (\x. f x % g x) differentiable_on s`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`lift o (f:real^M->real)`; `g:real^M->real^N`; `\x y:real^N. drop x % y`; + `s:real^M->bool`] BILINEAR_DIFFERENTIABLE_ON_COMPOSE) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; BILINEAR_DROP_MUL]);; + +let DIFFERENTIABLE_ON_SQNORM = prove + (`!s:real^N->bool. (\x. lift(norm x pow 2)) differentiable_on s`, + SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; + DIFFERENTIABLE_SQNORM_AT]);; + +(* ------------------------------------------------------------------------- *) +(* Considering derivative R(^1)->R^n as a vector. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("has_vector_derivative",(12,"right"));; + +let has_vector_derivative = new_definition + `(f has_vector_derivative f') net <=> + (f has_derivative (\x. drop(x) % f')) net`;; + +let vector_derivative = new_definition + `vector_derivative (f:real^1->real^N) net = + @f'. (f has_vector_derivative f') net`;; + +let VECTOR_DERIVATIVE_WORKS = prove + (`!net f:real^1->real^N. + f differentiable net <=> + (f has_vector_derivative (vector_derivative f net)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_derivative] THEN + CONV_TAC(RAND_CONV SELECT_CONV) THEN + SIMP_TAC[FRECHET_DERIVATIVE_WORKS; has_vector_derivative] THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[FRECHET_DERIVATIVE_WORKS; differentiable]] THEN + DISCH_TAC THEN EXISTS_TAC `column 1 (jacobian (f:real^1->real^N) net)` THEN + FIRST_ASSUM MP_TAC THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[jacobian] THEN + MATCH_MP_TAC LINEAR_FROM_REALS THEN + RULE_ASSUM_TAC(REWRITE_RULE[has_derivative]) THEN ASM_REWRITE_TAC[]);; + +let VECTOR_DERIVATIVE_UNIQUE_AT = prove + (`!f:real^1->real^N x f' f''. + (f has_vector_derivative f') (at x) /\ + (f has_vector_derivative f'') (at x) + ==> f' = f''`, + REWRITE_TAC[has_vector_derivative; drop] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^N`; + `\x. drop x % (f':real^N)`; `\x. drop x % (f'':real^N)`; + `x:real^1`] FRECHET_DERIVATIVE_UNIQUE_AT) THEN + ASM_SIMP_TAC[DIMINDEX_1; LE_ANTISYM; drop] THEN + REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN + SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH; VECTOR_MUL_LID]);; + +let HAS_VECTOR_DERIVATIVE_UNIQUE_AT = prove + (`!f:real^1->real^N f' x. + (f has_vector_derivative f') (at x) + ==> vector_derivative f (at x) = f'`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT THEN + MAP_EVERY EXISTS_TAC [`f:real^1->real^N`; `x:real^1`] THEN + ASM_REWRITE_TAC[vector_derivative] THEN CONV_TAC SELECT_CONV THEN + ASM_MESON_TAC[]);; + +let VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL = prove + (`!f:real^1->real^N a b x f' f''. + drop a < drop b /\ + x IN interval [a,b] /\ + (f has_vector_derivative f') (at x within interval [a,b]) /\ + (f has_vector_derivative f'') (at x within interval [a,b]) + ==> f' = f''`, + REWRITE_TAC[has_vector_derivative; drop] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^N`; + `\x. drop x % (f':real^N)`; `\x. drop x % (f'':real^N)`; + `x:real^1`; `a:real^1`; `b:real^1`] + FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL) THEN + ASM_SIMP_TAC[DIMINDEX_1; LE_ANTISYM; drop] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[FUN_EQ_THM] THEN + DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN + SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH; VECTOR_MUL_LID]);; + +let VECTOR_DERIVATIVE_AT = prove + (`(f has_vector_derivative f') (at x) ==> vector_derivative f (at x) = f'`, + ASM_MESON_TAC[VECTOR_DERIVATIVE_UNIQUE_AT; + VECTOR_DERIVATIVE_WORKS; differentiable; has_vector_derivative]);; + +let VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL = prove + (`!f:real^1->real^N f' x a b. + drop a < drop b /\ x IN interval[a,b] /\ + (f has_vector_derivative f') (at x within interval [a,b]) + ==> vector_derivative f (at x within interval [a,b]) = f'`, + ASM_MESON_TAC[VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; + VECTOR_DERIVATIVE_WORKS; differentiable; has_vector_derivative]);; + +let HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET = prove + (`!f s t x. (f has_vector_derivative f') (at x within s) /\ t SUBSET s + ==> (f has_vector_derivative f') (at x within t)`, + REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN_SUBSET]);; + +let HAS_VECTOR_DERIVATIVE_CONST = prove + (`!c net. ((\x. c) has_vector_derivative vec 0) net`, + REWRITE_TAC[has_vector_derivative] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; HAS_DERIVATIVE_CONST]);; + +let VECTOR_DERIVATIVE_CONST_AT = prove + (`!c:real^N a. vector_derivative (\x. c) (at a) = vec 0`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_UNIQUE_AT THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]);; + +let HAS_VECTOR_DERIVATIVE_ID = prove + (`!net. ((\x. x) has_vector_derivative (vec 1)) net`, + REWRITE_TAC[has_vector_derivative] THEN + SUBGOAL_THEN `(\x. drop x % vec 1) = (\x. x)` + (fun th -> REWRITE_TAC[HAS_DERIVATIVE_ID; th]) THEN + REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN + REAL_ARITH_TAC);; + +let HAS_VECTOR_DERIVATIVE_CMUL = prove + (`!f f' net c. (f has_vector_derivative f') net + ==> ((\x. c % f(x)) has_vector_derivative (c % f')) net`, + SIMP_TAC[has_vector_derivative] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x = b % a % x`] THEN + SIMP_TAC[HAS_DERIVATIVE_CMUL]);; + +let HAS_VECTOR_DERIVATIVE_CMUL_EQ = prove + (`!f f' net c. + ~(c = &0) + ==> (((\x. c % f(x)) has_vector_derivative (c % f')) net <=> + (f has_vector_derivative f') net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_VECTOR_DERIVATIVE_CMUL) THENL + [DISCH_THEN(MP_TAC o SPEC `inv(c):real`); + DISCH_THEN(MP_TAC o SPEC `c:real`)] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; + +let HAS_VECTOR_DERIVATIVE_NEG = prove + (`!f f' net. (f has_vector_derivative f') net + ==> ((\x. --(f(x))) has_vector_derivative (--f')) net`, + SIMP_TAC[has_vector_derivative; VECTOR_MUL_RNEG; HAS_DERIVATIVE_NEG]);; + +let HAS_VECTOR_DERIVATIVE_NEG_EQ = prove + (`!f f' net. ((\x. --(f(x))) has_vector_derivative --f') net <=> + (f has_vector_derivative f') net`, + SIMP_TAC[has_vector_derivative; HAS_DERIVATIVE_NEG_EQ; VECTOR_MUL_RNEG]);; + +let HAS_VECTOR_DERIVATIVE_ADD = prove + (`!f f' g g' net. + (f has_vector_derivative f') net /\ (g has_vector_derivative g') net + ==> ((\x. f(x) + g(x)) has_vector_derivative (f' + g')) net`, + SIMP_TAC[has_vector_derivative; VECTOR_ADD_LDISTRIB; HAS_DERIVATIVE_ADD]);; + +let HAS_VECTOR_DERIVATIVE_SUB = prove + (`!f f' g g' net. + (f has_vector_derivative f') net /\ (g has_vector_derivative g') net + ==> ((\x. f(x) - g(x)) has_vector_derivative (f' - g')) net`, + SIMP_TAC[has_vector_derivative; VECTOR_SUB_LDISTRIB; HAS_DERIVATIVE_SUB]);; + +let HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN = prove + (`!h:real^M->real^N->real^P f g f' g' x s. + (f has_vector_derivative f') (at x within s) /\ + (g has_vector_derivative g') (at x within s) /\ + bilinear h + ==> ((\x. h (f x) (g x)) has_vector_derivative + (h (f x) g' + h f' (g x))) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_WITHIN) THEN + RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN + ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB]);; + +let HAS_VECTOR_DERIVATIVE_BILINEAR_AT = prove + (`!h:real^M->real^N->real^P f g f' g' x. + (f has_vector_derivative f') (at x) /\ + (g has_vector_derivative g') (at x) /\ + bilinear h + ==> ((\x. h (f x) (g x)) has_vector_derivative + (h (f x) g' + h f' (g x))) (at x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_DERIVATIVE_BILINEAR_AT) THEN + RULE_ASSUM_TAC(REWRITE_RULE[bilinear; linear]) THEN + ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB]);; + +let HAS_VECTOR_DERIVATIVE_AT_WITHIN = prove + (`!f x s. (f has_vector_derivative f') (at x) + ==> (f has_vector_derivative f') (at x within s)`, + SIMP_TAC[has_vector_derivative; HAS_DERIVATIVE_AT_WITHIN]);; + +let HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN = prove + (`!f f' g x s d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ dist (x',x) < d ==> f x' = g x') /\ + (f has_vector_derivative f') (at x within s) + ==> (g has_vector_derivative f') (at x within s)`, + REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_TRANSFORM_WITHIN]);; + +let HAS_VECTOR_DERIVATIVE_TRANSFORM_AT = prove + (`!f f' g x d. + &0 < d /\ (!x'. dist (x',x) < d ==> f x' = g x') /\ + (f has_vector_derivative f') (at x) + ==> (g has_vector_derivative f') (at x)`, + REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_TRANSFORM_AT]);; + +let HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN = prove + (`!f g s x. + open s /\ x IN s /\ + (!y. y IN s ==> f y = g y) /\ + (f has_vector_derivative f') (at x) + ==> (g has_vector_derivative f') (at x)`, + REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN]);; + +let VECTOR_DIFF_CHAIN_AT = prove + (`!f g f' g' x. + (f has_vector_derivative f') (at x) /\ + (g has_vector_derivative g') (at (f x)) + ==> ((g o f) has_vector_derivative (drop f' % g')) (at x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_AT) THEN + REWRITE_TAC[o_DEF; DROP_CMUL; GSYM VECTOR_MUL_ASSOC]);; + +let VECTOR_DIFF_CHAIN_WITHIN = prove + (`!f g f' g' s x. + (f has_vector_derivative f') (at x within s) /\ + (g has_vector_derivative g') (at (f x) within IMAGE f s) + ==> ((g o f) has_vector_derivative (drop f' % g')) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_CHAIN_WITHIN) THEN + REWRITE_TAC[o_DEF; DROP_CMUL; GSYM VECTOR_MUL_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Various versions of Kachurovskii's theorem. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_ON_DERIVATIVE_SECANT_IMP = prove + (`!f f' s x y:real^N. + f convex_on s /\ segment[x,y] SUBSET s /\ + ((lift o f) has_derivative (lift o f')) (at x within s) + ==> f'(y - x) <= f y - f x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(x:real^N) IN s /\ (y:real^N) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_derivative_within]) THEN + REWRITE_TAC[LIM_WITHIN; DIST_0; o_THM] THEN + REWRITE_TAC[GSYM LIFT_ADD; GSYM LIFT_SUB; GSYM LIFT_CMUL; NORM_LIFT] THEN + STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_0) THEN + REWRITE_TAC[o_THM; VECTOR_SUB_REFL; GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_SUB_REFL; REAL_LE_REFL; VECTOR_SUB_REFL]; + ALL_TAC] THEN + ABBREV_TAC `e = (f':real^N->real)(y - x) - (f y - f x)` THEN + ASM_CASES_TAC `&0 < e` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / norm(y - x:real^N)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ABBREV_TAC `u = min (&1 / &2) (d / &2 / norm (y - x:real^N))` THEN + SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "u" THEN REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_HALF; VECTOR_SUB_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + ABBREV_TAC `z:real^N = (&1 - u) % x + u % y` THEN + SUBGOAL_THEN `(z:real^N) IN segment(x,y)` MP_TAC THENL + [ASM_MESON_TAC[IN_SEGMENT]; ALL_TAC] THEN + SIMP_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `z:real^N`) THEN + SUBGOAL_THEN `(z:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[DIST_POS_LT] THEN + EXPAND_TAC "z" THEN REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH + `((&1 - u) % x + u % y) - x:real^N = u % (y - x)`] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ON_LEFT_SECANT]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[open_segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + SIMP_TAC[REAL_ARITH `inv y * (z - (x + d)):real = (z - x) / y - d / y`] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `z <= y / n /\ abs(z - d) < e / n ==> d <= (y + e) / n`)) THEN + SUBGOAL_THEN + `(f':real^N->real)(z - x) / norm(z - x) = f'(y - x) / norm(y - x)` + SUBST1_TAC THENL + [EXPAND_TAC "z" THEN + REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % x + u % y) - x:real^N = u % (y - x)`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_CMUL) THEN + DISCH_THEN(MP_TAC o SPECL [`u:real`; `y - x:real^N`]) THEN + ASM_REWRITE_TAC[GSYM LIFT_CMUL; o_THM; LIFT_EQ] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_MUL] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_DIV_LMUL THEN + ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let CONVEX_ON_SECANT_DERIVATIVE_IMP = prove + (`!f f' s x y:real^N. + f convex_on s /\ segment[x,y] SUBSET s /\ + ((lift o f) has_derivative (lift o f')) (at y within s) + ==> f y - f x <= f'(y - x)`, + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real^N->real`; `f':real^N->real`; `s:real^N->bool`; + `y:real^N`; `x:real^N`] CONVEX_ON_DERIVATIVE_SECANT_IMP) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + MATCH_MP_TAC(REAL_ARITH + `f' = --f'' ==> f' <= x - y ==> y - x <= f''`) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN + GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN + SPEC_TAC(`y - x:real^N`,`z:real^N`) THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN + REWRITE_TAC[GSYM o_DEF] THEN ASM_MESON_TAC[has_derivative]);; + +let CONVEX_ON_DERIVATIVES_IMP = prove + (`!f f'x f'y s x y:real^N. + f convex_on s /\ segment[x,y] SUBSET s /\ + ((lift o f) has_derivative (lift o f'x)) (at x within s) /\ + ((lift o f) has_derivative (lift o f'y)) (at y within s) + ==> f'x(y - x) <= f'y(y - x)`, + ASM_MESON_TAC[CONVEX_ON_DERIVATIVE_SECANT_IMP; + CONVEX_ON_SECANT_DERIVATIVE_IMP; + SEGMENT_SYM; REAL_LE_TRANS]);; + +let CONVEX_ON_DERIVATIVE_SECANT,CONVEX_ON_DERIVATIVES = + (CONJ_PAIR o prove) + (`(!f f' s:real^N->bool. + convex s /\ + (!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x))) + (at x within s)) + ==> (f convex_on s <=> + !x y. x IN s /\ y IN s ==> f'(x)(y - x) <= f y - f x)) /\ + (!f f' s:real^N->bool. + convex s /\ + (!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x))) + (at x within s)) + ==> (f convex_on s <=> + !x y. x IN s /\ y IN s ==> f'(x)(y - x) <= f'(y)(y - x)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT + `(a ==> b) /\ (b ==> c) /\ (c ==> a) ==> (a <=> b) /\ (a <=> c)`) THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_ON_DERIVATIVE_SECANT_IMP THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[ETA_AX] THEN + ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT]; + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(ISPECL [`x:real^N`; `y:real^N`] th) THEN + MP_TAC(ISPECL [`y:real^N`; `x:real^N`] th)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `f''' = --f'' ==> f''' <= x - y ==> f' <= y - x ==> f' <= f''`) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN + GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN + SPEC_TAC(`y - x:real^N`,`z:real^N`) THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN + REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[GSYM I_DEF; I_O_ID] THEN + ASM_MESON_TAC[has_derivative]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[convex_on] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN + REWRITE_TAC[IMP_CONJ; REAL_ARITH `u + v = &1 <=> u = &1 - v`] THEN + REWRITE_TAC[FORALL_UNWIND_THM2; REAL_SUB_LE] THEN X_GEN_TAC `u:real` THEN + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `u = &0` THEN + ASM_SIMP_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_LE_REFL; + REAL_MUL_LZERO; REAL_MUL_LID; VECTOR_ADD_RID; REAL_ADD_RID] THEN + ASM_CASES_TAC `u = &1` THEN + ASM_SIMP_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_LE_REFL; + REAL_MUL_LZERO; REAL_MUL_LID; VECTOR_ADD_LID; REAL_ADD_LID] THEN + SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE]; ALL_TAC] THEN + MP_TAC(ISPECL + [`lift o (f:real^N->real) o (\u. (&1 - drop u) % a + drop u % b)`; + `\x:real^1. lift o f'((&1 - drop x) % a + drop x % b) o + (\u. --(drop u) % a + drop u % b:real^N)`] MVT_VERY_SIMPLE) THEN + DISCH_THEN(fun th -> + MP_TAC(ISPECL [`vec 0:real^1`; `lift u`] th) THEN + MP_TAC(ISPECL [`lift u`; `vec 1:real^1`] th)) THEN + ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN + ASM_SIMP_TAC[DROP_VEC; VECTOR_MUL_LZERO; REAL_SUB_RZERO; REAL_LT_IMP_LE; + VECTOR_ADD_RID; VECTOR_MUL_LID; VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC(TAUT + `(a1 /\ a2) /\ (b1 ==> b2 ==> c) ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN + (REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[VECTOR_ARITH `(&1 - a) % x:real^N = x + --a % x`; + VECTOR_ARITH `--u % a:real^N = vec 0 + --u % a`] THEN + MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_DERIVATIVE_CONST]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN DISCH_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; LIFT_DROP; DROP_VEC]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]); + REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN + REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ] THEN + REWRITE_TAC[DROP_SUB; DROP_VEC; LIFT_DROP] THEN + REWRITE_TAC[VECTOR_ARITH `--u % a + u % b:real^N = u % (b - a)`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`w:real`; `v:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> b ==> a ==> c ==> d`] THEN + STRIP_TAC THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o AP_TERM `(*) (u:real)`) + (MP_TAC o AP_TERM `(*) (&1 - u:real)`)) THEN + MATCH_MP_TAC(REAL_ARITH + `f1 <= f2 /\ (xa <= xb ==> a <= b) + ==> xa = f1 ==> xb = f2 ==> a <= b`) THEN + CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + SUBGOAL_THEN + `((&1 - v) % a + v % b:real^N) IN s /\ + ((&1 - w) % a + w % b:real^N) IN s` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `linear(lift o (f'((&1 - v) % a + v % b:real^N):real^N->real)) /\ + linear(lift o (f'((&1 - w) % a + w % b:real^N):real^N->real))` + MP_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LINEAR_CMUL)) THEN + ASM_REWRITE_TAC[o_THM; GSYM LIFT_NEG; GSYM LIFT_CMUL; LIFT_EQ] THEN + REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(&1 - u) * u * x = u * (&1 - u) * x`] THEN + REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(&1 - v) % a + v % b:real^N`; `(&1 - w) % a + w % b:real^N`]) THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `((&1 - v) % a + v % b) - ((&1 - w) % a + w % b):real^N = + (v - w) % (b - a)`] THEN + ASM_CASES_TAC `v:real = w` THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN + SUBGOAL_THEN `&0 < w - v` (fun th -> SIMP_TAC[th; REAL_LE_LMUL_EQ]) THEN + ASM_REAL_ARITH_TAC]);; + +let CONVEX_ON_SECANT_DERIVATIVE = prove + (`!f f' s:real^N->bool. + convex s /\ + (!x. x IN s ==> ((lift o f) has_derivative (lift o f'(x))) + (at x within s)) + ==> (f convex_on s <=> + !x y. x IN s /\ y IN s ==> f y - f x <= f'(y)(y - x))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT) THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[] THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(y:real^N) IN s`] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `f' = --f'' ==> (f' <= y - x <=> x - y <= f'')`) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_NEG_SUB] THEN + GEN_REWRITE_TAC I [GSYM LIFT_EQ] THEN REWRITE_TAC[LIFT_NEG] THEN + SPEC_TAC(`x - y:real^N`,`z:real^N`) THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_FORALL_IMP_THM] LINEAR_NEG) THEN + REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[GSYM I_DEF; I_O_ID] THEN ASM_MESON_TAC[has_derivative]);; diff --git a/Multivariate/determinants.ml b/Multivariate/determinants.ml new file mode 100644 index 0000000..84950de --- /dev/null +++ b/Multivariate/determinants.ml @@ -0,0 +1,3141 @@ +(* ========================================================================= *) +(* Determinant and trace of a square matrix. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Multivariate/vectors.ml";; +needs "Library/permutations.ml";; +needs "Library/floor.ml";; +needs "Library/products.ml";; + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Trace of a matrix (this is relatively easy). *) +(* ------------------------------------------------------------------------- *) + +let trace = new_definition + `(trace:real^N^N->real) A = sum(1..dimindex(:N)) (\i. A$i$i)`;; + +let TRACE_0 = prove + (`trace(mat 0) = &0`, + SIMP_TAC[trace; mat; LAMBDA_BETA; SUM_0]);; + +let TRACE_I = prove + (`trace(mat 1 :real^N^N) = &(dimindex(:N))`, + SIMP_TAC[trace; mat; LAMBDA_BETA; SUM_CONST_NUMSEG; REAL_MUL_RID] THEN + AP_TERM_TAC THEN ARITH_TAC);; + +let TRACE_ADD = prove + (`!A B:real^N^N. trace(A + B) = trace(A) + trace(B)`, + SIMP_TAC[trace; matrix_add; SUM_ADD_NUMSEG; LAMBDA_BETA]);; + +let TRACE_SUB = prove + (`!A B:real^N^N. trace(A - B) = trace(A) - trace(B)`, + SIMP_TAC[trace; matrix_sub; SUM_SUB_NUMSEG; LAMBDA_BETA]);; + +let TRACE_MUL_SYM = prove + (`!A B:real^N^N. trace(A ** B) = trace(B ** A)`, + REPEAT GEN_TAC THEN SIMP_TAC[trace; matrix_mul; LAMBDA_BETA] THEN + GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_SYM]);; + +let TRACE_TRANSP = prove + (`!A:real^N^N. trace(transp A) = trace A`, + SIMP_TAC[trace; transp; LAMBDA_BETA]);; + +let TRACE_CONJUGATE = prove + (`!A:real^N^N U:real^N^N. + invertible U ==> trace(matrix_inv U ** A ** U) = trace A`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[TRACE_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_INV; MATRIX_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of determinant. *) +(* ------------------------------------------------------------------------- *) + +let det = new_definition + `det(A:real^N^N) = + sum { p | p permutes 1..dimindex(:N) } + (\p. sign(p) * product (1..dimindex(:N)) (\i. A$i$(p i)))`;; + +(* ------------------------------------------------------------------------- *) +(* A few general lemmas we need below. *) +(* ------------------------------------------------------------------------- *) + +let IN_DIMINDEX_SWAP = prove + (`!m n j. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> 1 <= swap(m,n) j /\ swap(m,n) j <= dimindex(:N)`, + REWRITE_TAC[swap] THEN ARITH_TAC);; + +let LAMBDA_BETA_PERM = prove + (`!p i. p permutes 1..dimindex(:N) /\ 1 <= i /\ i <= dimindex(:N) + ==> ((lambda) g :A^N) $ p(i) = g(p i)`, + ASM_MESON_TAC[LAMBDA_BETA; PERMUTES_IN_IMAGE; IN_NUMSEG]);; + +let PRODUCT_PERMUTE = prove + (`!f p s. p permutes s ==> product s f = product s (f o p)`, + REWRITE_TAC[product] THEN MATCH_MP_TAC ITERATE_PERMUTE THEN + REWRITE_TAC[MONOIDAL_REAL_MUL]);; + +let PRODUCT_PERMUTE_NUMSEG = prove + (`!f p m n. p permutes m..n ==> product(m..n) f = product(m..n) (f o p)`, + MESON_TAC[PRODUCT_PERMUTE; FINITE_NUMSEG]);; + +let REAL_MUL_SUM = prove + (`!s t f g. + FINITE s /\ FINITE t + ==> sum s f * sum t g = sum s (\i. sum t (\j. f(i) * g(j)))`, + SIMP_TAC[SUM_LMUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[SUM_LMUL]);; + +let REAL_MUL_SUM_NUMSEG = prove + (`!m n p q. sum(m..n) f * sum(p..q) g = + sum(m..n) (\i. sum(p..q) (\j. f(i) * g(j)))`, + SIMP_TAC[REAL_MUL_SUM; FINITE_NUMSEG]);; + +(* ------------------------------------------------------------------------- *) +(* Basic determinant properties. *) +(* ------------------------------------------------------------------------- *) + +let DET_CMUL = prove + (`!A:real^N^N c. det(c %% A) = c pow dimindex(:N) * det A`, + REPEAT GEN_TAC THEN + SIMP_TAC[det; MATRIX_CMUL_COMPONENT; PRODUCT_MUL; FINITE_NUMSEG] THEN + SIMP_TAC[PRODUCT_CONST_NUMSEG_1; GSYM SUM_LMUL] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let DET_NEG = prove + (`!A:real^N^N. det(--A) = --(&1) pow dimindex(:N) * det A`, + REWRITE_TAC[MATRIX_NEG_MINUS1; DET_CMUL]);; + +let DET_TRANSP = prove + (`!A:real^N^N. det(transp A) = det A`, + GEN_TAC THEN REWRITE_TAC[det] THEN + GEN_REWRITE_TAC LAND_CONV [SUM_PERMUTATIONS_INVERSE] THEN + MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `p:num->num` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN BINOP_TAC THENL + [ASM_MESON_TAC[SIGN_INVERSE; PERMUTATION_PERMUTES; FINITE_NUMSEG]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM(MATCH_MP PERMUTES_IMAGE th)]) THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `product(1..dimindex(:N)) + ((\i. (transp A:real^N^N)$i$inverse p(i)) o p)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PRODUCT_IMAGE THEN + ASM_MESON_TAC[FINITE_NUMSEG; PERMUTES_INJECTIVE; PERMUTES_INVERSE]; + MATCH_MP_TAC PRODUCT_EQ THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + SIMP_TAC[transp; LAMBDA_BETA; o_THM] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_INVERSES_o) THEN + SIMP_TAC[FUN_EQ_THM; I_THM; o_THM] THEN STRIP_TAC THEN + ASM_SIMP_TAC[PERMUTES_IN_NUMSEG; LAMBDA_BETA_PERM; LAMBDA_BETA]]);; + +let DET_LOWERTRIANGULAR = prove + (`!A:real^N^N. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ i < j ==> A$i$j = &0) + ==> det(A) = product(1..dimindex(:N)) (\i. A$i$i)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {I} + (\p. sign p * product(1..dimindex(:N)) (\i. (A:real^N^N)$i$p(i)))` THEN + CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUM_SING; SIGN_I; REAL_MUL_LID; I_THM]] THEN + MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[IN_SING; FINITE_RULES; SUBSET; IN_ELIM_THM; PERMUTES_I] THEN + X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_ENTIRE; SIGN_NZ] THEN + MP_TAC(SPECL [`p:num->num`; `1..dimindex(:N)`] PERMUTES_NUMSET_LE) THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; NOT_LT]);; + +let DET_UPPERTRIANGULAR = prove + (`!A:real^N^N. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ j < i ==> A$i$j = &0) + ==> det(A) = product(1..dimindex(:N)) (\i. A$i$i)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {I} + (\p. sign p * product(1..dimindex(:N)) (\i. (A:real^N^N)$i$p(i)))` THEN + CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUM_SING; SIGN_I; REAL_MUL_LID; I_THM]] THEN + MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[IN_SING; FINITE_RULES; SUBSET; IN_ELIM_THM; PERMUTES_I] THEN + X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_ENTIRE; SIGN_NZ] THEN + MP_TAC(SPECL [`p:num->num`; `1..dimindex(:N)`] PERMUTES_NUMSET_GE) THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; NOT_LT]);; + +let DET_DIAGONAL = prove + (`!A:real^N^N. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) ==> A$i$j = &0) + ==> det(A) = product(1..dimindex(:N)) (\i. A$i$i)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DET_LOWERTRIANGULAR THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[LT_REFL]);; + +let DET_I = prove + (`det(mat 1 :real^N^N) = &1`, + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `product(1..dimindex(:N)) (\i. (mat 1:real^N^N)$i$i)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DET_LOWERTRIANGULAR; + MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG] THEN + SIMP_TAC[mat; LAMBDA_BETA] THEN MESON_TAC[LT_REFL]);; + +let DET_0 = prove + (`det(mat 0 :real^N^N) = &0`, + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `product(1..dimindex(:N)) (\i. (mat 0:real^N^N)$i$i)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DET_LOWERTRIANGULAR; + REWRITE_TAC[PRODUCT_EQ_0_NUMSEG] THEN EXISTS_TAC `1`] THEN + SIMP_TAC[mat; LAMBDA_BETA; COND_ID; DIMINDEX_GE_1; LE_REFL]);; + +let DET_PERMUTE_ROWS = prove + (`!A:real^N^N p. + p permutes 1..dimindex(:N) + ==> det(lambda i. A$p(i)) = sign(p) * det(A)`, + REWRITE_TAC[det] THEN SIMP_TAC[LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[GSYM SUM_LMUL; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV + [MATCH_MP SUM_PERMUTATIONS_COMPOSE_R th]) THEN + MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN X_GEN_TAC `q:num->num` THEN + REWRITE_TAC[IN_ELIM_THM; REAL_MUL_ASSOC] THEN DISCH_TAC THEN BINOP_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_MESON_TAC[SIGN_COMPOSE; PERMUTATION_PERMUTES; FINITE_NUMSEG]; + ALL_TAC] THEN + MP_TAC(MATCH_MP PERMUTES_INVERSE (ASSUME `p permutes 1..dimindex(:N)`)) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV + [MATCH_MP PRODUCT_PERMUTE_NUMSEG th]) THEN + MATCH_MP_TAC PRODUCT_EQ THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + ASM_MESON_TAC[PERMUTES_INVERSES]);; + +let DET_PERMUTE_COLUMNS = prove + (`!A:real^N^N p. + p permutes 1..dimindex(:N) + ==> det((lambda i j. A$i$p(j)):real^N^N) = sign(p) * det(A)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM DET_TRANSP] THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC + [GSYM(MATCH_MP DET_PERMUTE_ROWS th)]) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; LAMBDA_BETA_PERM]);; + +let DET_IDENTICAL_ROWS = prove + (`!A:real^N^N i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) /\ + row i A = row j A + ==> det A = &0`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`A:real^N^N`; `swap(i:num,j:num)`] DET_PERMUTE_ROWS) THEN + ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; SIGN_SWAP] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> b = -- &1 * a ==> a = &0`) THEN + AP_TERM_TAC THEN FIRST_X_ASSUM(MP_TAC o SYM) THEN + SIMP_TAC[row; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[swap] THEN ASM_MESON_TAC[]);; + +let DET_IDENTICAL_COLUMNS = prove + (`!A:real^N^N i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) /\ + column i A = column j A + ==> det A = &0`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DET_TRANSP] THEN + MATCH_MP_TAC DET_IDENTICAL_ROWS THEN ASM_MESON_TAC[ROW_TRANSP]);; + +let DET_ZERO_ROW = prove + (`!A:real^N^N i. + 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> det A = &0`, + SIMP_TAC[det; row; CART_EQ; LAMBDA_BETA; VEC_COMPONENT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN + REWRITE_TAC[IN_ELIM_THM; REAL_ENTIRE; SIGN_NZ] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]);; + +let DET_ZERO_COLUMN = prove + (`!A:real^N^N i. + 1 <= i /\ i <= dimindex(:N) /\ column i A = vec 0 ==> det A = &0`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DET_TRANSP] THEN + MATCH_MP_TAC DET_ZERO_ROW THEN ASM_MESON_TAC[ROW_TRANSP]);; + +let DET_ROW_ADD = prove + (`!a b c k. + 1 <= k /\ k <= dimindex(:N) + ==> det((lambda i. if i = k then a + b else c i):real^N^N) = + det((lambda i. if i = k then a else c i):real^N^N) + + det((lambda i. if i = k then b else c i):real^N^N)`, + SIMP_TAC[det; LAMBDA_BETA; GSYM SUM_ADD; + FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` + SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN + MATCH_MP_TAC(REAL_RING + `c = a + b /\ y = x:real /\ z = x ==> c * x = a * y + b * z`) THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN + CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_DELETE; FINITE_DELETE; FINITE_NUMSEG]);; + +let DET_ROW_MUL = prove + (`!a b c k. + 1 <= k /\ k <= dimindex(:N) + ==> det((lambda i. if i = k then c % a else b i):real^N^N) = + c * det((lambda i. if i = k then a else b i):real^N^N)`, + SIMP_TAC[det; LAMBDA_BETA; GSYM SUM_LMUL; + FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` + SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN + MATCH_MP_TAC(REAL_RING + `cp = c * p /\ p1 = p2:real ==> s * cp * p1 = c * s * p * p2`) THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT] THEN MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_DELETE; FINITE_DELETE; FINITE_NUMSEG]);; + +let DET_ROW_OPERATION = prove + (`!A:real^N^N i. + 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> det(lambda k. if k = i then row i A + c % row j A else row k A) = + det A`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DET_ROW_ADD; DET_ROW_MUL] THEN + MATCH_MP_TAC(REAL_RING `a = b /\ d = &0 ==> a + c * d = b`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ]; + MATCH_MP_TAC DET_IDENTICAL_ROWS THEN + MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ]]);; + +let DET_ROW_SPAN = prove + (`!A:real^N^N i x. + 1 <= i /\ i <= dimindex(:N) /\ + x IN span {row j A | 1 <= j /\ j <= dimindex(:N) /\ ~(j = i)} + ==> det(lambda k. if k = i then row i A + x else row k A) = + det A`, + GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN + MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL + [AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_RID] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[row; LAMBDA_BETA]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `j:num`) (SUBST_ALL_TAC o SYM)) THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `a + c % x + y:real^N = (a + y) + c % x`] THEN + ABBREV_TAC `z = row i (A:real^N^N) + y` THEN + ASM_SIMP_TAC[DET_ROW_MUL; DET_ROW_ADD] THEN + MATCH_MP_TAC(REAL_RING `d = &0 ==> a + c * d = a`) THEN + MATCH_MP_TAC DET_IDENTICAL_ROWS THEN + MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* May as well do this, though it's a bit unsatisfactory since it ignores *) +(* exact duplicates by considering the rows/columns as a set. *) +(* ------------------------------------------------------------------------- *) + +let DET_DEPENDENT_ROWS = prove + (`!A:real^N^N. dependent(rows A) ==> det A = &0`, + GEN_TAC THEN + REWRITE_TAC[dependent; rows; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_CASES_TAC + `?i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) /\ + row i (A:real^N^N) = row j A` + THENL [ASM_MESON_TAC[DET_IDENTICAL_ROWS]; ALL_TAC] THEN + MP_TAC(SPECL [`A:real^N^N`; `i:num`; `--(row i (A:real^N^N))`] + DET_ROW_SPAN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_NEG THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN]) THEN + MATCH_MP_TAC(TAUT `a = b ==> a ==> b`) THEN + REWRITE_TAC[IN] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_DELETE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DET_ZERO_ROW THEN + EXISTS_TAC `i:num` THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ; VECTOR_ADD_COMPONENT; + VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN + REAL_ARITH_TAC]);; + +let DET_DEPENDENT_COLUMNS = prove + (`!A:real^N^N. dependent(columns A) ==> det A = &0`, + MESON_TAC[DET_DEPENDENT_ROWS; ROWS_TRANSP; DET_TRANSP]);; + +(* ------------------------------------------------------------------------- *) +(* Multilinearity and the multiplication formula. *) +(* ------------------------------------------------------------------------- *) + +let DET_LINEAR_ROW_VSUM = prove + (`!a c s k. + FINITE s /\ 1 <= k /\ k <= dimindex(:N) + ==> det((lambda i. if i = k then vsum s a else c i):real^N^N) = + sum s + (\j. det((lambda i. if i = k then a(j) else c i):real^N^N))`, + GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DET_ROW_ADD] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DET_ZERO_ROW THEN EXISTS_TAC `k:num` THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);; + +let BOUNDED_FUNCTIONS_BIJECTIONS_1 = prove + (`!p. p IN {(y,g) | y IN s /\ + g IN {f | (!i. 1 <= i /\ i <= k ==> f i IN s) /\ + (!i. ~(1 <= i /\ i <= k) ==> f i = i)}} + ==> (\(y,g) i. if i = SUC k then y else g(i)) p IN + {f | (!i. 1 <= i /\ i <= SUC k ==> f i IN s) /\ + (!i. ~(1 <= i /\ i <= SUC k) ==> f i = i)} /\ + (\h. h(SUC k),(\i. if i = SUC k then i else h(i))) + ((\(y,g) i. if i = SUC k then y else g(i)) p) = p`, + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`y:num`; `h:num->num`] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[LE]; + ASM_MESON_TAC[LE; ARITH_RULE `~(1 <= i /\ i <= SUC k) ==> ~(i = SUC k)`]; + REWRITE_TAC[PAIR_EQ; FUN_EQ_THM] THEN + ASM_MESON_TAC[ARITH_RULE `~(SUC k <= k)`]]);; + +let BOUNDED_FUNCTIONS_BIJECTIONS_2 = prove + (`!h. h IN {f | (!i. 1 <= i /\ i <= SUC k ==> f i IN s) /\ + (!i. ~(1 <= i /\ i <= SUC k) ==> f i = i)} + ==> (\h. h(SUC k),(\i. if i = SUC k then i else h(i))) h IN + {(y,g) | y IN s /\ + g IN {f | (!i. 1 <= i /\ i <= k ==> f i IN s) /\ + (!i. ~(1 <= i /\ i <= k) ==> f i = i)}} /\ + (\(y,g) i. if i = SUC k then y else g(i)) + ((\h. h(SUC k),(\i. if i = SUC k then i else h(i))) h) = h`, + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + CONV_TAC(REDEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `h:num->num` THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + ASM_MESON_TAC[ARITH_RULE `i <= k ==> i <= SUC k /\ ~(i = SUC k)`]; + ASM_MESON_TAC[ARITH_RULE `i <= SUC k /\ ~(i = SUC k) ==> i <= k`]; + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[LE_REFL]]);; + +let FINITE_BOUNDED_FUNCTIONS = prove + (`!s k. FINITE s + ==> FINITE {f | (!i. 1 <= i /\ i <= k ==> f(i) IN s) /\ + (!i. ~(1 <= i /\ i <= k) ==> f(i) = i)}`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN + SIMP_TAC[GSYM FUN_EQ_THM; SET_RULE `{x | x = y} = {y}`; FINITE_RULES]; + ALL_TAC] THEN + UNDISCH_TAC `FINITE(s:num->bool)` THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP FINITE_PRODUCT) THEN + DISCH_THEN(MP_TAC o ISPEC `\(y:num,g) i. if i = SUC k then y else g(i)` o + MATCH_MP FINITE_IMAGE) THEN + MATCH_MP_TAC(TAUT `a = b ==> a ==> b`) THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + X_GEN_TAC `h:num->num` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_SIMP_TAC[BOUNDED_FUNCTIONS_BIJECTIONS_1]; ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC + `(\h. h(SUC k),(\i. if i = SUC k then i else h(i))) h` THEN + PURE_ONCE_REWRITE_TAC[CONJ_SYM] THEN CONV_TAC (RAND_CONV SYM_CONV) THEN + MATCH_MP_TAC BOUNDED_FUNCTIONS_BIJECTIONS_2 THEN ASM_REWRITE_TAC[]);; + +let DET_LINEAR_ROWS_VSUM_LEMMA = prove + (`!s k a c. + FINITE s /\ k <= dimindex(:N) + ==> det((lambda i. if i <= k then vsum s (a i) else c i):real^N^N) = + sum {f | (!i. 1 <= i /\ i <= k ==> f(i) IN s) /\ + !i. ~(1 <= i /\ i <= k) ==> f(i) = i} + (\f. det((lambda i. if i <= k then a i (f i) else c i) + :real^N^N))`, + let lemma = prove + (`(lambda i. if i <= 0 then x(i) else y(i)) = (lambda i. y i)`, + SIMP_TAC[CART_EQ; ARITH; LAMBDA_BETA; ARITH_RULE + `1 <= k ==> ~(k <= 0)`]) in + ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THENL + [REWRITE_TAC[lemma; LE_0] THEN GEN_TAC THEN + REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN + REWRITE_TAC[GSYM FUN_EQ_THM; SET_RULE `{x | x = y} = {y}`] THEN + REWRITE_TAC[SUM_SING]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC k <= n ==> k <= n`] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LE] THEN + REWRITE_TAC[TAUT + `(if a \/ b then c else d) = (if a then c else if b then c else d)`] THEN + ASM_SIMP_TAC[DET_LINEAR_ROW_VSUM; ARITH_RULE `1 <= SUC k`] THEN + ONCE_REWRITE_TAC[TAUT + `(if a then b else if c then d else e) = + (if c then (if a then b else d) else (if a then b else e))`] THEN + ASM_SIMP_TAC[ARITH_RULE `i <= k ==> ~(i = SUC k)`] THEN + ASM_SIMP_TAC[SUM_SUM_PRODUCT; FINITE_BOUNDED_FUNCTIONS] THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + EXISTS_TAC `\(y:num,g) i. if i = SUC k then y else g(i)` THEN + EXISTS_TAC `\h. h(SUC k),(\i. if i = SUC k then i else h(i))` THEN + CONJ_TAC THENL [ACCEPT_TAC BOUNDED_FUNCTIONS_BIJECTIONS_2; ALL_TAC] THEN + X_GEN_TAC `p:num#(num->num)` THEN + DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP BOUNDED_FUNCTIONS_BIJECTIONS_1) THEN + ASM_REWRITE_TAC[] THEN + SPEC_TAC(`p:num#(num->num)`,`q:num#(num->num)`) THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + MAP_EVERY X_GEN_TAC [`y:num`; `g:num->num`] THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_MESON_TAC[LE; ARITH_RULE `~(SUC k <= k)`]);; + +let DET_LINEAR_ROWS_VSUM = prove + (`!s a. + FINITE s + ==> det((lambda i. vsum s (a i)):real^N^N) = + sum {f | (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) IN s) /\ + !i. ~(1 <= i /\ i <= dimindex(:N)) ==> f(i) = i} + (\f. det((lambda i. a i (f i)):real^N^N))`, + let lemma = prove + (`(lambda i. if i <= dimindex(:N) then x(i) else y(i)):real^N^N = + (lambda i. x(i))`, + SIMP_TAC[CART_EQ; LAMBDA_BETA]) in + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:num->bool`; `dimindex(:N)`] DET_LINEAR_ROWS_VSUM_LEMMA) THEN + ASM_REWRITE_TAC[LE_REFL; lemma] THEN SIMP_TAC[]);; + +let MATRIX_MUL_VSUM_ALT = prove + (`!A:real^N^N B:real^N^N. A ** B = + lambda i. vsum (1..dimindex(:N)) (\k. A$i$k % B$k)`, + SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; + VSUM_COMPONENT]);; + +let DET_ROWS_MUL = prove + (`!a c. det((lambda i. c(i) % a(i)):real^N^N) = + product(1..dimindex(:N)) (\i. c(i)) * + det((lambda i. a(i)):real^N^N)`, + REPEAT GEN_TAC THEN SIMP_TAC[det; LAMBDA_BETA] THEN + SIMP_TAC[GSYM SUM_LMUL; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_RING `b = c * d ==> s * b = c * s * d`) THEN + SIMP_TAC[GSYM PRODUCT_MUL_NUMSEG] THEN + MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; VECTOR_MUL_COMPONENT]);; + +let DET_MUL = prove + (`!A B:real^N^N. det(A ** B) = det(A) * det(B)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_MUL_VSUM_ALT] THEN + SIMP_TAC[DET_LINEAR_ROWS_VSUM; FINITE_NUMSEG] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {p | p permutes 1..dimindex(:N)} + (\f. det (lambda i. (A:real^N^N)$i$f i % (B:real^N^N)$f i))` THEN + CONJ_TAC THENL + [REWRITE_TAC[DET_ROWS_MUL] THEN + MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL + [MESON_TAC[permutes; IN_NUMSEG]; ALL_TAC] THEN + X_GEN_TAC `f:num->num` THEN REWRITE_TAC[permutes; IN_NUMSEG] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + MATCH_MP_TAC DET_IDENTICAL_ROWS THEN + MP_TAC(ISPECL [`1..dimindex(:N)`; `f:num->num`] + SURJECTIVE_IFF_INJECTIVE) THEN + ASM_REWRITE_TAC[SUBSET; IN_NUMSEG; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(TAUT `(~b ==> c) /\ (b ==> ~a) ==> (a <=> b) ==> c`) THEN + CONJ_TAC THENL + [REWRITE_TAC[NOT_FORALL_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; row; NOT_IMP]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x y. (f:num->num)(x) = f(y) ==> x = y` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + ASM_CASES_TAC `1 <= x /\ x <= dimindex(:N)` THEN + ASM_CASES_TAC `1 <= y /\ y <= dimindex(:N)` THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SIMP_TAC[det; REAL_MUL_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV + [MATCH_MP SUM_PERMUTATIONS_COMPOSE_R (MATCH_MP PERMUTES_INVERSE th)]) THEN + MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + X_GEN_TAC `q:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN ONCE_REWRITE_TAC[AC REAL_MUL_AC + `(p * x) * (q * y) = (p * q) * (x * y)`] THEN + BINOP_TAC THENL + [SUBGOAL_THEN `sign(q o inverse p) = sign(p:num->num) * sign(q:num->num)` + (fun t -> SIMP_TAC[REAL_MUL_ASSOC; SIGN_IDEMPOTENT; REAL_MUL_LID; t]) THEN + ASM_MESON_TAC[SIGN_COMPOSE; PERMUTES_INVERSE; PERMUTATION_PERMUTES; + FINITE_NUMSEG; SIGN_INVERSE; REAL_MUL_SYM]; + ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [MATCH_MP PRODUCT_PERMUTE_NUMSEG (ASSUME `p permutes 1..dimindex(:N)`)] THEN + SIMP_TAC[GSYM PRODUCT_MUL; FINITE_NUMSEG] THEN + MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + ASM_SIMP_TAC[LAMBDA_BETA; LAMBDA_BETA_PERM; o_THM] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(A:real^N^N)$i$p(i) * (B:real^N^N)$p(i)$q(i)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[VECTOR_MUL_COMPONENT; PERMUTES_IN_IMAGE; IN_NUMSEG]; + ASM_MESON_TAC[PERMUTES_INVERSES]]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to invertibility. *) +(* ------------------------------------------------------------------------- *) + +let INVERTIBLE_DET_NZ = prove + (`!A:real^N^N. invertible(A) <=> ~(det A = &0)`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[INVERTIBLE_RIGHT_INVERSE; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `det:real^N^N->real`) THEN + REWRITE_TAC[DET_MUL; DET_I] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[INVERTIBLE_RIGHT_INVERSE] THEN + REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:num->real`; `i:num`] THEN STRIP_TAC THEN + MP_TAC(SPECL [`A:real^N^N`; `i:num`; `--(row i (A:real^N^N))`] + DET_ROW_SPAN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `--(row i (A:real^N^N)) = + vsum ((1..dimindex(:N)) DELETE i) (\j. inv(c i) % c j % row j A)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VSUM_DELETE_CASES; FINITE_NUMSEG; IN_NUMSEG; VSUM_LMUL] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SPAN_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; FINITE_DELETE; IN_DELETE] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN REPEAT(MATCH_MP_TAC SPAN_MUL) THEN + MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC DET_ZERO_ROW THEN + EXISTS_TAC `i:num` THEN + ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; + VECTOR_ARITH `x + --x:real^N = vec 0`]);; + +let DET_EQ_0 = prove + (`!A:real^N^N. det(A) = &0 <=> ~invertible(A)`, + REWRITE_TAC[INVERTIBLE_DET_NZ]);; + +let MATRIX_MUL_LINV = prove + (`!A:real^N^N. ~(det A = &0) ==> matrix_inv A ** A = mat 1`, + SIMP_TAC[MATRIX_INV; DET_EQ_0]);; + +let MATRIX_MUL_RINV = prove + (`!A:real^N^N. ~(det A = &0) ==> A ** matrix_inv A = mat 1`, + SIMP_TAC[MATRIX_INV; DET_EQ_0]);; + +let DET_MATRIX_EQ_0 = prove + (`!f:real^N->real^N. + linear f + ==> (det(matrix f) = &0 <=> + ~(?g. linear g /\ f o g = I /\ g o f = I))`, + SIMP_TAC[DET_EQ_0; MATRIX_INVERTIBLE]);; + +let DET_MATRIX_EQ_0_LEFT = prove + (`!f:real^N->real^N. + linear f + ==> (det(matrix f) = &0 <=> + ~(?g. linear g /\ g o f = I))`, + SIMP_TAC[DET_MATRIX_EQ_0] THEN MESON_TAC[LINEAR_INVERSE_LEFT]);; + +let DET_MATRIX_EQ_0_RIGHT = prove + (`!f:real^N->real^N. + linear f + ==> (det(matrix f) = &0 <=> + ~(?g. linear g /\ f o g = I))`, + SIMP_TAC[DET_MATRIX_EQ_0] THEN MESON_TAC[LINEAR_INVERSE_LEFT]);; + +let DET_EQ_0_RANK = prove + (`!A:real^N^N. det A = &0 <=> rank A < dimindex(:N)`, + REWRITE_TAC[DET_EQ_0; INVERTIBLE_LEFT_INVERSE; GSYM FULL_RANK_INJECTIVE; + MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN + GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN + ARITH_TAC);; + +let RANK_EQ_FULL_DET = prove + (`!A:real^N^N. rank A = dimindex(:N) <=> ~(det A = &0)`, + GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN + SIMP_TAC[DET_EQ_0_RANK; NOT_LT; GSYM LE_ANTISYM; ARITH_RULE `MIN n n = n`]);; + +let HOMOGENEOUS_LINEAR_EQUATIONS_DET = prove + (`!A:real^N^N. (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> det A = &0`, + GEN_TAC THEN + REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ; DET_EQ_0_RANK] THEN + MATCH_MP_TAC(ARITH_RULE `r <= MIN N N ==> (~(r = N) <=> r < N)`) THEN + REWRITE_TAC[RANK_BOUND]);; + +let INVERTIBLE_MATRIX_MUL = prove + (`!A:real^N^N B:real^N^N. + invertible(A ** B) <=> invertible A /\ invertible B`, + REWRITE_TAC[INVERTIBLE_DET_NZ; DET_MUL; DE_MORGAN_THM; REAL_ENTIRE]);; + +let MATRIX_INV_MUL = prove + (`!A:real^N^N B:real^N^N. + invertible A /\ invertible B + ==> matrix_inv(A ** B) = matrix_inv B ** matrix_inv A`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN + ONCE_REWRITE_TAC[MATRIX_MUL_ASSOC] THEN + GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV o LAND_CONV) + [GSYM MATRIX_MUL_ASSOC] THEN + ASM_SIMP_TAC[MATRIX_MUL_LINV; DET_EQ_0; MATRIX_MUL_RID; MATRIX_MUL_RINV]);; + +(* ------------------------------------------------------------------------- *) +(* Cramer's rule. *) +(* ------------------------------------------------------------------------- *) + +let CRAMER_LEMMA_TRANSP = prove + (`!A:real^N^N x:real^N. + 1 <= k /\ k <= dimindex(:N) + ==> det((lambda i. if i = k + then vsum(1..dimindex(:N)) (\i. x$i % row i A) + else row i A):real^N^N) = + x$k * det A`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` + SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; FINITE_DELETE; IN_DELETE] THEN + REWRITE_TAC[VECTOR_ARITH + `(x:real^N)$k % row k (A:real^N^N) + s = + (x$k - &1) % row k A + row k A + s`] THEN + W(MP_TAC o PART_MATCH (lhs o rand) DET_ROW_ADD o lhand o snd) THEN + ASM_SIMP_TAC[DET_ROW_MUL] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC(REAL_RING `d = d' /\ e = d' ==> (c - &1) * d + e = c * d'`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; row]; + MATCH_MP_TAC DET_ROW_SPAN THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; FINITE_DELETE; IN_DELETE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; + +let CRAMER_LEMMA = prove + (`!A:real^N^N x:real^N. + 1 <= k /\ k <= dimindex(:N) + ==> det((lambda i j. if j = k then (A**x)$i else A$i$j):real^N^N) = + x$k * det(A)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[MATRIX_MUL_VSUM] THEN + FIRST_ASSUM(MP_TAC o SYM o SPECL [`transp(A:real^N^N)`; `x:real^N`] o + MATCH_MP CRAMER_LEMMA_TRANSP) THEN + REWRITE_TAC[DET_TRANSP] THEN DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM DET_TRANSP] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; MATRIX_MUL_VSUM; row; column; + COND_COMPONENT; VECTOR_MUL_COMPONENT; VSUM_COMPONENT]);; + +let CRAMER = prove + (`!A:real^N^N x b. + ~(det(A) = &0) + ==> (A ** x = b <=> + x = lambda k. + det((lambda i j. if j = k then b$i else A$i$j):real^N^N) / + det(A))`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(MESON[] + `(?x. p(x)) /\ (!x. p(x) ==> x = a) ==> !x. p(x) <=> x = a`) THEN + CONJ_TAC THENL + [MP_TAC(SPEC `A:real^N^N` INVERTIBLE_DET_NZ) THEN + ASM_MESON_TAC[invertible; MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; + GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[CART_EQ; CRAMER_LEMMA; LAMBDA_BETA; REAL_FIELD + `~(z = &0) ==> (x = y / z <=> x * z = y)`]]);; + +(* ------------------------------------------------------------------------- *) +(* Variants of Cramer's rule for matrix-matrix multiplication. *) +(* ------------------------------------------------------------------------- *) + +let CRAMER_MATRIX_LEFT = prove + (`!A:real^N^N X:real^N^N B:real^N^N. + ~(det A = &0) + ==> (X ** A = B <=> + X = lambda k l. + det((lambda i j. if j = l then B$k$i else A$j$i):real^N^N) / + det A)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CART_EQ] THEN + ASM_SIMP_TAC[MATRIX_MUL_COMPONENT; CRAMER; DET_TRANSP] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC) THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; transp]);; + +let CRAMER_MATRIX_RIGHT = prove + (`!A:real^N^N X:real^N^N B:real^N^N. + ~(det A = &0) + ==> (A ** X = B <=> + X = lambda k l. + det((lambda i j. if j = k then B$i$l else A$i$j):real^N^N) / + det A)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM TRANSP_EQ] THEN + REWRITE_TAC[MATRIX_TRANSP_MUL] THEN + ASM_SIMP_TAC[CRAMER_MATRIX_LEFT; DET_TRANSP] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM TRANSP_EQ] THEN + REWRITE_TAC[TRANSP_TRANSP] THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; transp] THEN + REPEAT(GEN_TAC THEN STRIP_TAC) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; transp]);; + +let CRAMER_MATRIX_RIGHT_INVERSE = prove + (`!A:real^N^N A':real^N^N. + A ** A' = mat 1 <=> + ~(det A = &0) /\ + A' = lambda k l. + det((lambda i j. if j = k then if i = l then &1 else &0 + else A$i$j):real^N^N) / + det A`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `det(A:real^N^N) = &0` THENL + [ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `det:real^N^N->real`) THEN + ASM_REWRITE_TAC[DET_MUL; DET_I] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[CRAMER_MATRIX_RIGHT] THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPEAT(GEN_TAC THEN STRIP_TAC) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; mat]]);; + +let CRAMER_MATRIX_LEFT_INVERSE = prove + (`!A:real^N^N A':real^N^N. + A' ** A = mat 1 <=> + ~(det A = &0) /\ + A' = lambda k l. + det((lambda i j. if j = l then if i = k then &1 else &0 + else A$j$i):real^N^N) / + det A`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `det(A:real^N^N) = &0` THENL + [ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `det:real^N^N->real`) THEN + ASM_REWRITE_TAC[DET_MUL; DET_I] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[CRAMER_MATRIX_LEFT] THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPEAT(GEN_TAC THEN STRIP_TAC) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; mat] THEN MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Cofactors and their relationship to inverse matrices. *) +(* ------------------------------------------------------------------------- *) + +let cofactor = new_definition + `(cofactor:real^N^N->real^N^N) A = + lambda i j. det((lambda k l. if k = i /\ l = j then &1 + else if k = i \/ l = j then &0 + else A$k$l):real^N^N)`;; + +let COFACTOR_TRANSP = prove + (`!A:real^N^N. cofactor(transp A) = transp(cofactor A)`, + SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA; transp] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN + AP_TERM_TAC THEN SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA; transp] THEN + MESON_TAC[]);; + +let COFACTOR_COLUMN = prove + (`!A:real^N^N. + cofactor A = + lambda i j. det((lambda k l. if l = j then if k = i then &1 else &0 + else A$k$l):real^N^N)`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN + SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + REWRITE_TAC[det] THEN MATCH_MP_TAC SUM_EQ THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN GEN_TAC THEN + DISCH_TAC THEN AP_TERM_TAC THEN + ASM_CASES_TAC `(p:num->num) i = j` THENL + [MATCH_MP_TAC PRODUCT_EQ THEN + X_GEN_TAC `k:num` THEN SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; + SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN STRIP_TAC] THEN + ASM_CASES_TAC `(p:num->num) k = j` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `s = &0 /\ t = &0 ==> s = t`) THEN + ASM_SIMP_TAC[PRODUCT_EQ_0; FINITE_NUMSEG] THEN CONJ_TAC THEN + EXISTS_TAC `inverse (p:num->num) j` THEN + ASM_SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN + (SUBGOAL_THEN `inverse(p:num->num) j IN 1..dimindex(:N)` MP_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; PERMUTES_INVERSE; IN_NUMSEG]; + SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN STRIP_TAC] THEN + SUBGOAL_THEN `(p:num->num)(inverse p j) = j` SUBST1_TAC THENL + [ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]; + ASM_SIMP_TAC[LAMBDA_BETA] THEN + ASM_MESON_TAC[PERMUTES_INVERSE_EQ]])]);; + +let COFACTOR_ROW = prove + (`!A:real^N^N. + cofactor A = + lambda i j. det((lambda k l. if k = i then if l = j then &1 else &0 + else A$k$l):real^N^N)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM TRANSP_EQ] THEN + REWRITE_TAC[GSYM COFACTOR_TRANSP] THEN + SIMP_TAC[COFACTOR_COLUMN; CART_EQ; LAMBDA_BETA; transp] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN + AP_TERM_TAC THEN SIMP_TAC[cofactor; CART_EQ; LAMBDA_BETA; transp]);; + +let MATRIX_RIGHT_INVERSE_COFACTOR = prove + (`!A:real^N^N A':real^N^N. + A ** A' = mat 1 <=> + ~(det A = &0) /\ A' = inv(det A) %% transp(cofactor A)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CRAMER_MATRIX_RIGHT_INVERSE] THEN + ASM_CASES_TAC `det(A:real^N^N) = &0` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA; MATRIX_CMUL_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + X_GEN_TAC `l:num` THEN STRIP_TAC THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[transp; COFACTOR_COLUMN; LAMBDA_BETA] THEN + AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);; + +let MATRIX_LEFT_INVERSE_COFACTOR = prove + (`!A:real^N^N A':real^N^N. + A' ** A = mat 1 <=> + ~(det A = &0) /\ A' = inv(det A) %% transp(cofactor A)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[MATRIX_LEFT_RIGHT_INVERSE] THEN + REWRITE_TAC[MATRIX_RIGHT_INVERSE_COFACTOR]);; + +let MATRIX_INV_COFACTOR = prove + (`!A. ~(det A = &0) ==> matrix_inv A = inv(det A) %% transp(cofactor A)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP MATRIX_MUL_LINV) THEN + SIMP_TAC[MATRIX_LEFT_INVERSE_COFACTOR]);; + +let COFACTOR_MATRIX_INV = prove + (`!A:real^N^N. ~(det A = &0) ==> cofactor A = det(A) %% transp(matrix_inv A)`, + SIMP_TAC[MATRIX_INV_COFACTOR; TRANSP_MATRIX_CMUL; TRANSP_TRANSP] THEN + SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_RINV; MATRIX_CMUL_LID]);; + +let COFACTOR_I = prove + (`cofactor(mat 1:real^N^N) = mat 1`, + SIMP_TAC[COFACTOR_MATRIX_INV; DET_I; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[MATRIX_INV_I; MATRIX_CMUL_LID; TRANSP_MAT]);; + +let DET_COFACTOR_EXPANSION = prove + (`!A:real^N^N i. + 1 <= i /\ i <= dimindex(:N) + ==> det A = sum (1..dimindex(:N)) + (\j. A$i$j * (cofactor A)$i$j)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COFACTOR_COLUMN; LAMBDA_BETA; det] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o rand o snd) THEN + ANTS_TAC THENL [SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * s * p:real = s * a * p`] THEN + REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum (1..dimindex (:N)) + (\j. (A:real^N^N)$i$j * + product + (inverse p j INSERT ((1..dimindex(:N)) DELETE (inverse p j))) + (\k. if k = inverse p j then if k = i then &1 else &0 + else A$k$(p k)))` THEN + CONJ_TAC THENL + [SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_PERMUTATIONS; + FINITE_NUMSEG; IN_DELETE] THEN + SUBGOAL_THEN `!j. inverse (p:num->num) j = i <=> j = p i` + (fun th -> REWRITE_TAC[th]) + THENL [ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `x * (if p then &1 else &0) * y = if p then x * y else &0`] THEN + SIMP_TAC[SUM_DELTA] THEN COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]] THEN + SUBGOAL_THEN + `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [ASM_SIMP_TAC[IN_NUMSEG; SET_RULE `s = x INSERT (s DELETE x) <=> x IN s`]; + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(MESON[PRODUCT_EQ] + `s = t /\ (!x. x IN t ==> f x = g x) ==> product s f = product t g`) THEN + SIMP_TAC[IN_DELETE] THEN ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]]; + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC(MESON[PRODUCT_EQ] + `s = t /\ (!x. x IN t ==> f x = g x) ==> product s f = product t g`) THEN + CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `x INSERT (s DELETE x) = s <=> x IN s`] THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; PERMUTES_INVERSE]; + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:num->num) k IN 1..dimindex(:N)` MP_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN + SIMP_TAC[LAMBDA_BETA; IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; IN_NUMSEG]]]);; + +let MATRIX_MUL_RIGHT_COFACTOR = prove + (`!A:real^N^N. A ** transp(cofactor A) = det(A) %% mat 1`, + GEN_TAC THEN + SIMP_TAC[CART_EQ; MATRIX_CMUL_COMPONENT; mat; + matrix_mul; LAMBDA_BETA; transp] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `i':num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[GSYM DET_COFACTOR_EXPANSION; REAL_MUL_RID] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `det((lambda k l. if k = i' then (A:real^N^N)$i$l + else A$k$l):real^N^N)` THEN + CONJ_TAC THENL + [MP_TAC(GEN `A:real^N^N` + (ISPECL [`A:real^N^N`; `i':num`] DET_COFACTOR_EXPANSION)) THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `j:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]; + REWRITE_TAC[REAL_MUL_RZERO] THEN MATCH_MP_TAC DET_IDENTICAL_ROWS THEN + MAP_EVERY EXISTS_TAC [`i:num`;` i':num`] THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row]]);; + +let MATRIX_MUL_LEFT_COFACTOR = prove + (`!A:real^N^N. transp(cofactor A) ** A = det(A) %% mat 1`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM TRANSP_EQ] THEN + REWRITE_TAC[MATRIX_TRANSP_MUL] THEN + ONCE_REWRITE_TAC[GSYM COFACTOR_TRANSP] THEN + REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; TRANSP_MATRIX_CMUL] THEN + REWRITE_TAC[DET_TRANSP; TRANSP_MAT]);; + +let COFACTOR_CMUL = prove + (`!A:real^N^N c. cofactor(c %% A) = c pow (dimindex(:N) - 1) %% cofactor A`, + REPEAT GEN_TAC THEN + SIMP_TAC[CART_EQ; cofactor; LAMBDA_BETA; MATRIX_CMUL_COMPONENT] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + REWRITE_TAC[det; GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = b * a * c`] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN + `1..dimindex (:N) = i INSERT ((1..dimindex (:N)) DELETE i)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_NUMSEG; IN_DELETE] THEN ASM_ARITH_TAC; + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE]] THEN + SUBGOAL_THEN + `1 <= (p:num->num) i /\ p i <= dimindex(:N)` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[LAMBDA_BETA]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + SUBGOAL_THEN + `dimindex(:N) - 1 = CARD((1..dimindex(:N)) DELETE i)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[CARD_DELETE; FINITE_NUMSEG; IN_NUMSEG; CARD_NUMSEG_1]; + ASM_SIMP_TAC[REAL_MUL_LID; GSYM PRODUCT_CONST; FINITE_NUMSEG; + FINITE_DELETE; GSYM PRODUCT_MUL]] THEN + MATCH_MP_TAC PRODUCT_EQ THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN STRIP_TAC THEN + SUBGOAL_THEN + `1 <= (p:num->num) k /\ p k <= dimindex(:N)` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]);; + +let COFACTOR_0 = prove + (`cofactor(mat 0:real^N^N) = if dimindex(:N) = 1 then mat 1 else mat 0`, + MP_TAC(ISPECL [`mat 1:real^N^N`; `&0`] COFACTOR_CMUL) THEN + REWRITE_TAC[MATRIX_CMUL_LZERO; COFACTOR_I; REAL_POW_ZERO] THEN + DISCH_THEN SUBST1_TAC THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN + COND_CASES_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; MATRIX_CMUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit formulas for low dimensions. *) +(* ------------------------------------------------------------------------- *) + +let PRODUCT_1 = prove + (`product(1..1) f = f(1)`, + REWRITE_TAC[PRODUCT_SING_NUMSEG]);; + +let PRODUCT_2 = prove + (`!t. product(1..2) t = t(1) * t(2)`, + REWRITE_TAC[num_CONV `2`; PRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[PRODUCT_SING_NUMSEG; ARITH; REAL_MUL_ASSOC]);; + +let PRODUCT_3 = prove + (`!t. product(1..3) t = t(1) * t(2) * t(3)`, + REWRITE_TAC[num_CONV `3`; num_CONV `2`; PRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[PRODUCT_SING_NUMSEG; ARITH; REAL_MUL_ASSOC]);; + +let PRODUCT_4 = prove + (`!t. product(1..4) t = t(1) * t(2) * t(3) * t(4)`, + REWRITE_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; + PRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[PRODUCT_SING_NUMSEG; ARITH; REAL_MUL_ASSOC]);; + +let DET_1 = prove + (`!A:real^1^1. det A = A$1$1`, + REWRITE_TAC[det; DIMINDEX_1; PERMUTES_SING; NUMSEG_SING] THEN + REWRITE_TAC[SUM_SING; SET_RULE `{x | x = a} = {a}`; PRODUCT_SING] THEN + REWRITE_TAC[SIGN_I; I_THM] THEN REAL_ARITH_TAC);; + +let DET_2 = prove + (`!A:real^2^2. det A = A$1$1 * A$2$2 - A$1$2 * A$2$1`, + GEN_TAC THEN REWRITE_TAC[det; DIMINDEX_2] THEN + CONV_TAC(LAND_CONV(RATOR_CONV(ONCE_DEPTH_CONV NUMSEG_CONV))) THEN + SIMP_TAC[SUM_OVER_PERMUTATIONS_INSERT; FINITE_INSERT; FINITE_EMPTY; + ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[PERMUTES_EMPTY; SUM_SING; SET_RULE `{x | x = a} = {a}`] THEN + REWRITE_TAC[SWAP_REFL; I_O_ID] THEN + REWRITE_TAC[GSYM(NUMSEG_CONV `1..2`); SUM_2] THEN + SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; + ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN + SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP] THEN + REWRITE_TAC[SIGN_SWAP; ARITH] THEN REWRITE_TAC[PRODUCT_2] THEN + REWRITE_TAC[o_THM; swap; ARITH] THEN REAL_ARITH_TAC);; + +let DET_3 = prove + (`!A:real^3^3. + det(A) = A$1$1 * A$2$2 * A$3$3 + + A$1$2 * A$2$3 * A$3$1 + + A$1$3 * A$2$1 * A$3$2 - + A$1$1 * A$2$3 * A$3$2 - + A$1$2 * A$2$1 * A$3$3 - + A$1$3 * A$2$2 * A$3$1`, + GEN_TAC THEN REWRITE_TAC[det; DIMINDEX_3] THEN + CONV_TAC(LAND_CONV(RATOR_CONV(ONCE_DEPTH_CONV NUMSEG_CONV))) THEN + SIMP_TAC[SUM_OVER_PERMUTATIONS_INSERT; FINITE_INSERT; FINITE_EMPTY; + ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[PERMUTES_EMPTY; SUM_SING; SET_RULE `{x | x = a} = {a}`] THEN + REWRITE_TAC[SWAP_REFL; I_O_ID] THEN + REWRITE_TAC[GSYM(NUMSEG_CONV `1..3`); SUM_3] THEN + SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY; + ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN + SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP] THEN + REWRITE_TAC[SIGN_SWAP; ARITH] THEN REWRITE_TAC[PRODUCT_3] THEN + REWRITE_TAC[o_THM; swap; ARITH] THEN REAL_ARITH_TAC);; + +let DET_4 = prove + (`!A:real^4^4. + det(A) = A$1$1 * A$2$2 * A$3$3 * A$4$4 + + A$1$1 * A$2$3 * A$3$4 * A$4$2 + + A$1$1 * A$2$4 * A$3$2 * A$4$3 + + A$1$2 * A$2$1 * A$3$4 * A$4$3 + + A$1$2 * A$2$3 * A$3$1 * A$4$4 + + A$1$2 * A$2$4 * A$3$3 * A$4$1 + + A$1$3 * A$2$1 * A$3$2 * A$4$4 + + A$1$3 * A$2$2 * A$3$4 * A$4$1 + + A$1$3 * A$2$4 * A$3$1 * A$4$2 + + A$1$4 * A$2$1 * A$3$3 * A$4$2 + + A$1$4 * A$2$2 * A$3$1 * A$4$3 + + A$1$4 * A$2$3 * A$3$2 * A$4$1 - + A$1$1 * A$2$2 * A$3$4 * A$4$3 - + A$1$1 * A$2$3 * A$3$2 * A$4$4 - + A$1$1 * A$2$4 * A$3$3 * A$4$2 - + A$1$2 * A$2$1 * A$3$3 * A$4$4 - + A$1$2 * A$2$3 * A$3$4 * A$4$1 - + A$1$2 * A$2$4 * A$3$1 * A$4$3 - + A$1$3 * A$2$1 * A$3$4 * A$4$2 - + A$1$3 * A$2$2 * A$3$1 * A$4$4 - + A$1$3 * A$2$4 * A$3$2 * A$4$1 - + A$1$4 * A$2$1 * A$3$2 * A$4$3 - + A$1$4 * A$2$2 * A$3$3 * A$4$1 - + A$1$4 * A$2$3 * A$3$1 * A$4$2`, + let lemma = prove + (`(sum {3,4} f = f 3 + f 4) /\ + (sum {2,3,4} f = f 2 + f 3 + f 4)`, + SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC) in + GEN_TAC THEN REWRITE_TAC[det; DIMINDEX_4] THEN + CONV_TAC(LAND_CONV(RATOR_CONV(ONCE_DEPTH_CONV NUMSEG_CONV))) THEN + SIMP_TAC[SUM_OVER_PERMUTATIONS_INSERT; FINITE_INSERT; FINITE_EMPTY; + ARITH_EQ; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[PERMUTES_EMPTY; SUM_SING; SET_RULE `{x | x = a} = {a}`] THEN + REWRITE_TAC[SWAP_REFL; I_O_ID] THEN + REWRITE_TAC[GSYM(NUMSEG_CONV `1..4`); SUM_4; lemma] THEN + SIMP_TAC[SIGN_COMPOSE; PERMUTATION_SWAP; PERMUTATION_COMPOSE] THEN + REWRITE_TAC[SIGN_SWAP; ARITH] THEN REWRITE_TAC[PRODUCT_4] THEN + REWRITE_TAC[o_THM; swap; ARITH] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existence of the characteristic polynomial. *) +(* ------------------------------------------------------------------------- *) + +let CHARACTERISTIC_POLYNOMIAL = prove + (`!A:real^N^N. + ?a. a(dimindex(:N)) = &1 /\ + !x. det(x %% mat 1 - A) = + sum (0..dimindex(:N)) (\i. a i * x pow i)`, + GEN_TAC THEN REWRITE_TAC[det] THEN + SUBGOAL_THEN + `!p n. IMAGE p (1..dimindex(:N)) SUBSET 1..dimindex(:N) /\ + n <= dimindex(:N) + ==> ?a. a n = (if !i. 1 <= i /\ i <= n ==> p i = i then &1 else &0) /\ + !x. product (1..n) (\i. (x %% mat 1 - A:real^N^N)$i$p i) = + sum (0..n) (\i. a i * x pow i)` + MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[LE_0; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THENL + [EXISTS_TAC `\i. if i = 0 then &1 else &0` THEN + SIMP_TAC[real_pow; REAL_MUL_LID; ARITH_RULE `1 <= i ==> ~(i <= 0)`; + SUM_CLAUSES_NUMSEG]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= N ==> n <= N`] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MATRIX_SUB_COMPONENT; MATRIX_CMUL_COMPONENT] THEN + ASSUME_TAC(ARITH_RULE `1 <= SUC n`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_SIMP_TAC[MAT_COMPONENT] THEN + ASM_CASES_TAC `p(SUC n) = SUC n` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + EXISTS_TAC `\i. if i <= n + then --((A:real^N^N)$(SUC n)$(p(SUC n))) * a i + else &0` THEN + SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH_RULE `~(SUC n <= n)`] THEN + CONJ_TAC THENL + [COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM SUM_RMUL] THEN + GEN_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC]] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM SUM_RMUL] THEN EXISTS_TAC + `\i. (if i = 0 then &0 else a(i - 1)) - + (if i = SUC n then &0 else (A:real^N^N)$(SUC n)$(SUC n) * a i)` THEN + ASM_REWRITE_TAC[NOT_SUC; LE; SUC_SUB1; REAL_SUB_RZERO] THEN + CONJ_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG] THEN + GEN_TAC THEN BINOP_TAC THENL + [SIMP_TAC[SUM_CLAUSES_LEFT; ARITH_RULE `0 <= SUC n`] THEN + REWRITE_TAC[ADD1; SUM_OFFSET; ARITH_RULE `~(i + 1 = 0)`; ADD_SUB] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_POW_ADD; REAL_POW_1; REAL_ADD_LID]; + SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_MUL_LZERO; REAL_ADD_RID] THEN + SIMP_TAC[ARITH_RULE `i <= n ==> ~(i = SUC n)`]] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN REWRITE_TAC[REAL_ADD_LID; REAL_MUL_AC]]; + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:(num->num)->num->real` THEN DISCH_TAC] THEN + EXISTS_TAC + `\i:num. sum {p | p permutes 1..dimindex(:N)} (\p. sign p * a p i)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MP_TAC(ISPECL + [`\p:num->num. sign p * a p (dimindex(:N))`; + `{p | p permutes 1..dimindex(:N)}`; + `I:num->num`] SUM_DELETE) THEN + SIMP_TAC[IN_ELIM_THM; PERMUTES_I; FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REAL_ARITH `k = &1 /\ s' = &0 ==> s' = s - k ==> s = &1`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `I:num->num`) THEN + SIMP_TAC[IMAGE_I; SUBSET_REFL; SIGN_I; I_THM; REAL_MUL_LID]; + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `p:num->num` THEN + REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num->num`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[PERMUTES_IMAGE; SUBSET_REFL]; ALL_TAC] THEN + COND_CASES_TAC THEN SIMP_TAC[REAL_MUL_RZERO] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [permutes]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [FUN_EQ_THM]) THEN + REWRITE_TAC[IN_NUMSEG; I_THM] THEN ASM_MESON_TAC[]]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[GSYM SUM_RMUL] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o rand o snd) THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `p:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num->num`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[PERMUTES_IMAGE; SUBSET_REFL]; SIMP_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Grassmann-Plucker relations for n = 2, n = 3 and n = 4. *) +(* I have a proof of the general n case but the proof is a bit long and the *) +(* result doesn't seem generally useful enough to go in the main theories. *) +(* ------------------------------------------------------------------------- *) + +let GRASSMANN_PLUCKER_2 = prove + (`!x1 x2 y1 y2:real^2. + det(vector[x1;x2]) * det(vector[y1;y2]) = + det(vector[y1;x2]) * det(vector[x1;y2]) + + det(vector[y2;x2]) * det(vector[y1;x1])`, + REWRITE_TAC[DET_2; VECTOR_2] THEN REAL_ARITH_TAC);; + +let GRASSMANN_PLUCKER_3 = prove + (`!x1 x2 x3 y1 y2 y3:real^3. + det(vector[x1;x2;x3]) * det(vector[y1;y2;y3]) = + det(vector[y1;x2;x3]) * det(vector[x1;y2;y3]) + + det(vector[y2;x2;x3]) * det(vector[y1;x1;y3]) + + det(vector[y3;x2;x3]) * det(vector[y1;y2;x1])`, + REWRITE_TAC[DET_3; VECTOR_3] THEN REAL_ARITH_TAC);; + +let GRASSMANN_PLUCKER_4 = prove + (`!x1 x2 x3 x4:real^4 y1 y2 y3 y4:real^4. + det(vector[x1;x2;x3;x4]) * det(vector[y1;y2;y3;y4]) = + det(vector[y1;x2;x3;x4]) * det(vector[x1;y2;y3;y4]) + + det(vector[y2;x2;x3;x4]) * det(vector[y1;x1;y3;y4]) + + det(vector[y3;x2;x3;x4]) * det(vector[y1;y2;x1;y4]) + + det(vector[y4;x2;x3;x4]) * det(vector[y1;y2;y3;x1])`, + REWRITE_TAC[DET_4; VECTOR_4] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Determinants of integer matrices. *) +(* ------------------------------------------------------------------------- *) + +let INTEGER_PRODUCT = prove + (`!f s. (!x. x IN s ==> integer(f x)) ==> integer(product s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_CLOSED THEN + ASM_REWRITE_TAC[INTEGER_CLOSED]);; + +let INTEGER_SIGN = prove + (`!p. integer(sign p)`, + SIMP_TAC[sign; COND_RAND; INTEGER_CLOSED; COND_ID]);; + +let INTEGER_DET = prove + (`!M:real^N^N. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> integer(M$i$j)) + ==> integer(det M)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN + MATCH_MP_TAC INTEGER_SUM THEN X_GEN_TAC `p:num->num` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[INTEGER_SIGN] THEN + MATCH_MP_TAC INTEGER_PRODUCT THEN REWRITE_TAC[IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[IN_NUMSEG; permutes]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonal matrices (for arbitrary rectangular matrix, not just square). *) +(* ------------------------------------------------------------------------- *) + +let diagonal_matrix = new_definition + `diagonal_matrix(A:real^N^M) <=> + !i j. 1 <= i /\ i <= dimindex(:M) /\ + 1 <= j /\ j <= dimindex(:N) /\ + ~(i = j) + ==> A$i$j = &0`;; + +let TRANSP_DIAGONAL_MATRIX = prove + (`!A:real^N^N. diagonal_matrix A ==> transp A = A`, + GEN_TAC THEN REWRITE_TAC[diagonal_matrix; CART_EQ; TRANSP_COMPONENT] THEN + STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN X_GEN_TAC `j:num` THEN + STRIP_TAC THEN ASM_CASES_TAC `i:num = j` THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Orthogonality of a transformation and matrix. *) +(* ------------------------------------------------------------------------- *) + +let orthogonal_transformation = new_definition + `orthogonal_transformation(f:real^N->real^N) <=> + linear f /\ !v w. f(v) dot f(w) = v dot w`;; + +let ORTHOGONAL_TRANSFORMATION = prove + (`!f. orthogonal_transformation f <=> linear f /\ !v. norm(f v) = norm(v)`, + GEN_TAC THEN REWRITE_TAC[orthogonal_transformation] THEN EQ_TAC THENL + [MESON_TAC[vector_norm]; SIMP_TAC[DOT_NORM] THEN MESON_TAC[LINEAR_ADD]]);; + +let ORTHOGONAL_TRANSFORMATION_COMPOSE = prove + (`!f g. orthogonal_transformation f /\ orthogonal_transformation g + ==> orthogonal_transformation(f o g)`, + SIMP_TAC[orthogonal_transformation; LINEAR_COMPOSE; o_THM]);; + +let orthogonal_matrix = new_definition + `orthogonal_matrix(Q:real^N^N) <=> + transp(Q) ** Q = mat 1 /\ Q ** transp(Q) = mat 1`;; + +let ORTHOGONAL_MATRIX = prove + (`orthogonal_matrix(Q:real^N^N) <=> transp(Q) ** Q = mat 1`, + MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE; orthogonal_matrix]);; + +let ORTHOGONAL_MATRIX_ALT = prove + (`!A:real^N^N. orthogonal_matrix A <=> A ** transp A = mat 1`, + MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE; orthogonal_matrix]);; + +let ORTHOGONAL_MATRIX_ID = prove + (`orthogonal_matrix(mat 1)`, + REWRITE_TAC[orthogonal_matrix; TRANSP_MAT; MATRIX_MUL_LID]);; + +let ORTHOGONAL_MATRIX_MUL = prove + (`!A B. orthogonal_matrix A /\ orthogonal_matrix B + ==> orthogonal_matrix(A ** B)`, + REWRITE_TAC[orthogonal_matrix; MATRIX_TRANSP_MUL] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [MATRIX_MUL_ASSOC] THEN + ASM_REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID]);; + +let ORTHOGONAL_TRANSFORMATION_MATRIX = prove + (`!f:real^N->real^N. + orthogonal_transformation f <=> linear f /\ orthogonal_matrix(matrix f)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[orthogonal_transformation; ORTHOGONAL_MATRIX] THEN + STRIP_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`basis i:real^N`; `basis j:real^N`]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN + REWRITE_TAC[DOT_MATRIX_VECTOR_MUL] THEN + ABBREV_TAC `A = transp (matrix f) ** matrix(f:real^N->real^N)` THEN + ASM_SIMP_TAC[matrix_mul; columnvector; rowvector; basis; LAMBDA_BETA; + SUM_DELTA; DIMINDEX_1; LE_REFL; dot; IN_NUMSEG; mat; + MESON[REAL_MUL_LID; REAL_MUL_LZERO; REAL_MUL_RID; REAL_MUL_RZERO] + `(if b then &1 else &0) * x = (if b then x else &0) /\ + x * (if b then &1 else &0) = (if b then x else &0)`]; + REWRITE_TAC[orthogonal_matrix; ORTHOGONAL_TRANSFORMATION; NORM_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN + ASM_REWRITE_TAC[DOT_MATRIX_VECTOR_MUL] THEN + SIMP_TAC[DOT_MATRIX_PRODUCT; MATRIX_MUL_LID]]);; + +let ORTHOGONAL_MATRIX_TRANSFORMATION = prove + (`!A:real^N^N. orthogonal_matrix A <=> orthogonal_transformation(\x. A ** x)`, + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_VECTOR_MUL_LINEAR] THEN + REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]);; + +let ORTHOGONAL_MATRIX_MATRIX = prove + (`!f:real^N->real^N. + orthogonal_transformation f ==> orthogonal_matrix(matrix f)`, + SIMP_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]);; + +let DET_ORTHOGONAL_MATRIX = prove + (`!Q. orthogonal_matrix Q ==> det(Q) = &1 \/ det(Q) = -- &1`, + GEN_TAC THEN REWRITE_TAC[REAL_RING `x = &1 \/ x = -- &1 <=> x * x = &1`] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN + SIMP_TAC[GSYM DET_MUL; orthogonal_matrix; DET_I]);; + +let ORTHOGONAL_MATRIX_TRANSP = prove + (`!A:real^N^N. orthogonal_matrix(transp A) <=> orthogonal_matrix A`, + REWRITE_TAC[orthogonal_matrix; TRANSP_TRANSP; CONJ_ACI]);; + +let MATRIX_MUL_LTRANSP_DOT_COLUMN = prove + (`!A:real^N^M. transp A ** A = (lambda i j. (column i A) dot (column j A))`, + SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; transp; dot; column]);; + +let MATRIX_MUL_RTRANSP_DOT_ROW = prove + (`!A:real^N^M. A ** transp A = (lambda i j. (row i A) dot (row j A))`, + SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; transp; dot; row]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> orthogonal (column i A) (column j A))`, + REWRITE_TAC[ORTHOGONAL_MATRIX] THEN + SIMP_TAC[MATRIX_MUL_LTRANSP_DOT_COLUMN; CART_EQ; mat; LAMBDA_BETA] THEN + REWRITE_TAC[orthogonal; NORM_EQ_1] THEN MESON_TAC[]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> orthogonal (row i A) (row j A))`, + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN + SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS; COLUMN_TRANSP]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ + pairwise (\i j. orthogonal (row i A) (row j A)) (1..dimindex(:N))`, + REPEAT GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ALT] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; pairwise; MAT_COMPONENT] THEN + SIMP_TAC[MATRIX_MUL_RTRANSP_DOT_ROW; IN_NUMSEG; LAMBDA_BETA] THEN + REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[orthogonal] THEN + MESON_TAC[]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + CARD(rows A) = dimindex(:N) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ + pairwise orthogonal (rows A)`, + REWRITE_TAC[rows; ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[PAIRWISE_IMAGE; GSYM numseg] THEN + MATCH_MP_TAC(TAUT `(p ==> (q <=> r /\ s)) ==> (p /\ q <=> r /\ p /\ s)`) THEN + DISCH_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) + [GSYM CARD_NUMSEG_1] THEN + SIMP_TAC[CARD_IMAGE_EQ_INJ; FINITE_NUMSEG] THEN + REWRITE_TAC[pairwise; IN_NUMSEG] THEN + ASM_MESON_TAC[ORTHOGONAL_REFL; NORM_ARITH `~(norm(vec 0:real^N) = &1)`]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + span(rows A) = (:real^N) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(row i A) = &1) /\ + pairwise orthogonal (rows A)`, + GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(SET_RULE `UNIV SUBSET s ==> s = UNIV`) THEN + MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + ASM_REWRITE_TAC[DIM_UNIV; SUBSET_UNIV; LE_REFL]; + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM DIM_UNIV] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[DIM_SPAN] THEN + MATCH_MP_TAC DIM_EQ_CARD] THEN + MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + ASM_REWRITE_TAC[rows; IN_ELIM_THM] THEN + ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ + pairwise (\i j. orthogonal (column i A) (column j A)) (1..dimindex(:N))`, + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN + REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED] THEN + SIMP_TAC[ROW_TRANSP; ROWS_TRANSP; pairwise; IN_NUMSEG]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + CARD(columns A) = dimindex(:N) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ + pairwise orthogonal (columns A)`, + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN + REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE] THEN + SIMP_TAC[ROW_TRANSP; ROWS_TRANSP]);; + +let ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN = prove + (`!A:real^N^N. + orthogonal_matrix A <=> + span(columns A) = (:real^N) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(column i A) = &1) /\ + pairwise orthogonal (columns A)`, + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_MATRIX_TRANSP] THEN + REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN] THEN + SIMP_TAC[ROW_TRANSP; ROWS_TRANSP]);; + +let ORTHOGONAL_MATRIX_2 = prove + (`!A:real^2^2. orthogonal_matrix A <=> + A$1$1 pow 2 + A$2$1 pow 2 = &1 /\ + A$1$2 pow 2 + A$2$2 pow 2 = &1 /\ + A$1$1 * A$1$2 + A$2$1 * A$2$2 = &0`, + SIMP_TAC[orthogonal_matrix; CART_EQ; matrix_mul; LAMBDA_BETA; + TRANSP_COMPONENT; MAT_COMPONENT] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; SUM_2] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING);; + +let ORTHOGONAL_MATRIX_2_ALT = prove + (`!A:real^2^2. orthogonal_matrix A <=> + A$1$1 pow 2 + A$2$1 pow 2 = &1 /\ + (A$1$1 = A$2$2 /\ A$1$2 = --(A$2$1) \/ + A$1$1 = --(A$2$2) /\ A$1$2 = A$2$1)`, + REWRITE_TAC[ORTHOGONAL_MATRIX_2] THEN CONV_TAC REAL_RING);; + +let ORTHOGONAL_MATRIX_INV = prove + (`!A:real^N^N. orthogonal_matrix A ==> matrix_inv A = transp A`, + MESON_TAC[orthogonal_matrix; MATRIX_INV_UNIQUE]);; + +let ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS = prove + (`!f:real^N->real^N v w a b. + orthogonal_transformation f /\ f v = a % v /\ f w = b % w /\ ~(a = b) + ==> orthogonal v w`, + REWRITE_TAC[orthogonal_transformation] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`v:real^N`; `v:real^N`] th) THEN + MP_TAC(SPECL [`v:real^N`; `w:real^N`] th) THEN + MP_TAC(SPECL [`w:real^N`; `w:real^N`] th)) THEN + ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; orthogonal] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_RING `x * y = y <=> x = &1 \/ y = &0`] THEN + REWRITE_TAC[DOT_EQ_0] THEN + ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THEN + ASM_CASES_TAC `w:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN + ASM_CASES_TAC `(v:real^N) dot w = &0` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(a:real = b)` THEN CONV_TAC REAL_RING);; + +let ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS = prove + (`!A:real^N^N v w a b. + orthogonal_matrix A /\ A ** v = a % v /\ A ** w = b % w /\ ~(a = b) + ==> orthogonal v w`, + REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSFORMATION; + ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS]);; + +(* ------------------------------------------------------------------------- *) +(* Linearity of scaling, and hence isometry, that preserves origin. *) +(* ------------------------------------------------------------------------- *) + +let SCALING_LINEAR = prove + (`!f:real^M->real^N c. + (f(vec 0) = vec 0) /\ (!x y. dist(f x,f y) = c * dist(x,y)) + ==> linear(f)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!v w. ((f:real^M->real^N) v) dot (f w) = c pow 2 * (v dot w)` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN `v:real^M` o + SPECL [`v:real^M`; `vec 0 :real^M`]) THEN + REWRITE_TAC[dist] THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[DOT_NORM_NEG; GSYM dist] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[linear; VECTOR_EQ] THEN + ASM_REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN + REAL_ARITH_TAC);; + +let ISOMETRY_LINEAR = prove + (`!f:real^M->real^N. + (f(vec 0) = vec 0) /\ (!x y. dist(f x,f y) = dist(x,y)) + ==> linear(f)`, + MESON_TAC[SCALING_LINEAR; REAL_MUL_LID]);; + +let ISOMETRY_IMP_AFFINITY = prove + (`!f:real^M->real^N. + (!x y. dist(f x,f y) = dist(x,y)) + ==> ?h. linear h /\ !x. f(x) = f(vec 0) + h(x)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. (f:real^M->real^N) x - f(vec 0)` THEN + REWRITE_TAC[VECTOR_ARITH `a + (x - a):real^N = x`] THEN + MATCH_MP_TAC ISOMETRY_LINEAR THEN REWRITE_TAC[VECTOR_SUB_REFL] THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(x - a:real^N,y - a) = dist(x,y)`]);; + +(* ------------------------------------------------------------------------- *) +(* Hence another formulation of orthogonal transformation. *) +(* ------------------------------------------------------------------------- *) + +let ORTHOGONAL_TRANSFORMATION_ISOMETRY = prove + (`!f:real^N->real^N. + orthogonal_transformation f <=> + (f(vec 0) = vec 0) /\ (!x y. dist(f x,f y) = dist(x,y))`, + GEN_TAC THEN REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN EQ_TAC THENL + [MESON_TAC[LINEAR_0; LINEAR_SUB; dist]; STRIP_TAC] THEN + ASM_SIMP_TAC[ISOMETRY_LINEAR] THEN X_GEN_TAC `x:real^N` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `vec 0:real^N`]) THEN + ASM_REWRITE_TAC[dist; VECTOR_SUB_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Can extend an isometry from unit sphere. *) +(* ------------------------------------------------------------------------- *) + +let ISOMETRY_SPHERE_EXTEND = prove + (`!f:real^N->real^N. + (!x. norm(x) = &1 ==> norm(f x) = &1) /\ + (!x y. norm(x) = &1 /\ norm(y) = &1 ==> dist(f x,f y) = dist(x,y)) + ==> ?g. orthogonal_transformation g /\ + (!x. norm(x) = &1 ==> g(x) = f(x))`, + let lemma = prove + (`!x:real^N y:real^N x':real^N y':real^N x0 y0 x0' y0'. + x = norm(x) % x0 /\ y = norm(y) % y0 /\ + x' = norm(x) % x0' /\ y' = norm(y) % y0' /\ + norm(x0) = &1 /\ norm(x0') = &1 /\ norm(y0) = &1 /\ norm(y0') = &1 /\ + norm(x0' - y0') = norm(x0 - y0) + ==> norm(x' - y') = norm(x - y)`, + REPEAT GEN_TAC THEN + MAP_EVERY ABBREV_TAC [`a = norm(x:real^N)`; `b = norm(y:real^N)`] THEN + REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[NORM_EQ; NORM_EQ_1] THEN + REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_LMUL; DOT_RMUL] THEN + REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING) in + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. if x = vec 0 then vec 0 + else norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ISOMETRY] THEN + SIMP_TAC[VECTOR_MUL_LID; REAL_INV_1] THEN CONJ_TAC THENL + [ALL_TAC; MESON_TAC[NORM_0; REAL_ARITH `~(&1 = &0)`]] THEN + REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[dist; VECTOR_SUB_LZERO; VECTOR_SUB_RZERO; NORM_NEG; NORM_MUL; + REAL_ABS_NORM] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; NORM_POS_LT] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; NORM_EQ_0] THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0] THEN + MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC + [`inv(norm x) % x:real^N`; `inv(norm y) % y:real^N`; + `(f:real^N->real^N) (inv (norm x) % x)`; + `(f:real^N->real^N) (inv (norm y) % y)`] THEN + REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0] THEN + ASM_REWRITE_TAC[GSYM dist; VECTOR_MUL_LID] THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV; NORM_EQ_0]);; + +let ORTHOGONAL_TRANSFORMATION_LINEAR = prove + (`!f:real^N->real^N. orthogonal_transformation f ==> linear f`, + SIMP_TAC[orthogonal_transformation]);; + +let ORTHOGONAL_TRANSFORMATION_INJECTIVE = prove + (`!f:real^N->real^N. + orthogonal_transformation f ==> !x y. f x = f y ==> x = y`, + SIMP_TAC[LINEAR_INJECTIVE_0; ORTHOGONAL_TRANSFORMATION; GSYM NORM_EQ_0]);; + +let ORTHOGONAL_TRANSFORMATION_SURJECTIVE = prove + (`!f:real^N->real^N. + orthogonal_transformation f ==> !y. ?x. f x = y`, + MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE; + ORTHOGONAL_TRANSFORMATION_INJECTIVE; orthogonal_transformation]);; + +let ORTHOGONAL_TRANSFORMATION_INVERSE_o = prove + (`!f:real^N->real^N. + orthogonal_transformation f + ==> ?g. orthogonal_transformation g /\ g o f = I /\ f o g = I`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INJECTIVE) THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g:real^N->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `g:real^N->real^N`] + LINEAR_INVERSE_LEFT) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN X_GEN_TAC `v:real^N` THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `norm((f:real^N->real^N)((g:real^N->real^N) v))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN + ASM_REWRITE_TAC[]);; + +let ORTHOGONAL_TRANSFORMATION_INVERSE = prove + (`!f:real^N->real^N. + orthogonal_transformation f + ==> ?g. orthogonal_transformation g /\ + (!x. g(f x) = x) /\ (!y. f(g y) = y)`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; + +let ORTHOGONAL_TRANSFORMATION_ID = prove + (`orthogonal_transformation(\x. x)`, + REWRITE_TAC[orthogonal_transformation; LINEAR_ID]);; + +let ORTHOGONAL_TRANSFORMATION_I = prove + (`orthogonal_transformation I`, + REWRITE_TAC[I_DEF; ORTHOGONAL_TRANSFORMATION_ID]);; + +(* ------------------------------------------------------------------------- *) +(* We can find an orthogonal matrix taking any unit vector to any other. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_INDEX_NUMSEG_SPECIAL = prove + (`!s a:A. + FINITE s /\ a IN s + ==> ?f. (!i j. i IN 1..CARD s /\ j IN 1..CARD s /\ f i = f j + ==> i = j) /\ + s = IMAGE f (1..CARD s) /\ + f 1 = a`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?k. k IN 1..CARD(s:A->bool) /\ (a:A) = f k` + STRIP_ASSUME_TAC THENL[ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `(f:num->A) o swap(1,k)` THEN + SUBGOAL_THEN `1 IN 1..CARD(s:A->bool)` ASSUME_TAC THENL + [REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= x <=> ~(x = 0)`] THEN + ASM_SIMP_TAC[CARD_EQ_0; ARITH_EQ] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[o_THM; swap] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + UNDISCH_THEN `s = IMAGE (f:num->A) (1..CARD(s:A->bool))` + (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; o_THM] THEN + X_GEN_TAC `b:A` THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `swap(1,k) i` THEN + REWRITE_TAC[swap] THEN ASM_MESON_TAC[swap]);; + +let ORTHOGONAL_MATRIX_EXISTS_BASIS = prove + (`!a:real^N. + norm(a) = &1 + ==> ?A. orthogonal_matrix A /\ A**(basis 1) = a`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHONORMAL_BASIS) THEN + REWRITE_TAC[HAS_SIZE] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + FINITE_INDEX_NUMSEG_SPECIAL) THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN + REWRITE_TAC[TAUT `a /\ b ==> c <=> c \/ ~a \/ ~b`] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` + (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 (ASSUME_TAC o SYM) + ASSUME_TAC))) THEN + EXISTS_TAC `(lambda i j. ((f j):real^N)$i):real^N^N` THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_vector_mul; BASIS_COMPONENT; + IN_NUMSEG] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN + ASM_REWRITE_TAC[IN_NUMSEG; REAL_MUL_RID; LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS] THEN + SIMP_TAC[column; LAMBDA_BETA] THEN CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `norm((f:num->real^N) i)` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]; + ASM_MESON_TAC[IN_IMAGE; IN_NUMSEG]]; + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `orthogonal ((f:num->real^N) i) (f j)` MP_TAC THENL + [ASM_MESON_TAC[pairwise; IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]]);; + +let ORTHOGONAL_TRANSFORMATION_EXISTS_1 = prove + (`!a b:real^N. + norm(a) = &1 /\ norm(b) = &1 + ==> ?f. orthogonal_transformation f /\ f a = b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `b:real^N` ORTHOGONAL_MATRIX_EXISTS_BASIS) THEN + MP_TAC(ISPEC `a:real^N` ORTHOGONAL_MATRIX_EXISTS_BASIS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` (STRIP_ASSUME_TAC o GSYM)) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` (STRIP_ASSUME_TAC o GSYM)) THEN + EXISTS_TAC `\x:real^N. ((B:real^N^N) ** transp(A:real^N^N)) ** x` THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_VECTOR_MUL_LINEAR; + MATRIX_OF_MATRIX_VECTOR_MUL] THEN + ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP] THEN + REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN AP_TERM_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_MATRIX]) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]);; + +let ORTHOGONAL_TRANSFORMATION_EXISTS = prove + (`!a b:real^N. + norm(a) = norm(b) ==> ?f. orthogonal_transformation f /\ f a = b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = vec 0` THEN + ASM_SIMP_TAC[NORM_0; NORM_EQ_0] THENL + [MESON_TAC[ORTHOGONAL_TRANSFORMATION_ID]; ALL_TAC] THEN + ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_MESON_TAC[NORM_0; NORM_EQ_0]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`inv(norm a) % a:real^N`; `inv(norm b) % b:real^N`] + ORTHOGONAL_TRANSFORMATION_EXISTS_1) THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[NORM_EQ_0; REAL_MUL_LINV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL o + MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `a % x:real^N = a % y <=> a % (x - y) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Or indeed, taking any subspace to another of suitable dimension. *) +(* ------------------------------------------------------------------------- *) + +let ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE = prove + (`!s t:real^N->bool. + subspace s /\ subspace t /\ dim s <= dim t + ==> ?f. orthogonal_transformation f /\ IMAGE f s SUBSET t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN + MP_TAC(ISPEC `s:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN + ASM_REWRITE_TAC[HAS_SIZE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`c:real^N->bool`; `(:real^N)`] ORTHONORMAL_EXTENSION) THEN + MP_TAC(ISPECL [`b:real^N->bool`; `(:real^N)`] ORTHONORMAL_EXTENSION) THEN + ASM_REWRITE_TAC[UNION_UNIV; SPAN_UNIV; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b':real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `independent(b UNION b':real^N->bool) /\ + independent(c UNION c':real^N->bool)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + ASM_REWRITE_TAC[IN_UNION] THEN + ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; + ALL_TAC] THEN + SUBGOAL_THEN `FINITE(b UNION b':real^N->bool) /\ + FINITE(c UNION c':real^N->bool)` + MP_TAC THENL + [ASM_SIMP_TAC[PAIRWISE_ORTHOGONAL_IMP_FINITE]; + REWRITE_TAC[FINITE_UNION] THEN STRIP_TAC] THEN + SUBGOAL_THEN + `?f:real^N->real^N. + (!x y. x IN b UNION b' /\ y IN b UNION b' ==> (f x = f y <=> x = y)) /\ + IMAGE f b SUBSET c /\ + IMAGE f (b UNION b') SUBSET c UNION c'` + (X_CHOOSE_THEN `fb:real^N->real^N` STRIP_ASSUME_TAC) + THENL + [MP_TAC(ISPECL [`b:real^N->bool`; `c:real^N->bool`] + CARD_LE_INJ) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN + X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`b':real^N->bool`; + `(c UNION c') DIFF IMAGE (f:real^N->real^N) b`] + CARD_LE_INJ) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_UNION; FINITE_DIFF] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CARD_DIFF o rand o snd) THEN + ASM_REWRITE_TAC[FINITE_UNION] THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `a + b:num = c ==> a <= c - b`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o + rand o lhs o snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (rhs o rand) CARD_UNION o lhs o snd) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNION_COMM] THEN + MATCH_MP_TAC(MESON[LE_ANTISYM] + `(FINITE s /\ CARD s <= CARD t) /\ + (FINITE t /\ CARD t <= CARD s) ==> CARD s = CARD t`) THEN + CONJ_TAC THEN MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN + ASM_REWRITE_TAC[FINITE_UNION; SUBSET_UNIV]; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. if x IN b then (f:real^N->real^N) x else g x` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`fb:real^N->real^N`; `b UNION b':real^N->bool`] + LINEAR_INDEPENDENT_EXTEND) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION]; + REWRITE_TAC[SYM(ASSUME `span b:real^N->bool = s`)] THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN + REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN + MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]] THEN + SUBGOAL_THEN + `!v. v IN UNIV ==> norm((f:real^N->real^N) v) = norm v` + (fun th -> ASM_MESON_TAC[th; IN_UNIV]) THEN + UNDISCH_THEN `span (b UNION b') = (:real^N)` (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[SPAN_FINITE; FINITE_UNION; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:real^N`; `u:real^N->real`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM; FINITE_UNION] THEN + REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN + ASM_SIMP_TAC[LINEAR_CMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o rand o snd) THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES; FINITE_UNION] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN + REPEAT DISJ2_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; + REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL] THEN + MATCH_MP_TAC SUM_EQ THEN ASM SET_TAC[]]);; + +let ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE = prove + (`!s t:real^N->bool. + subspace s /\ subspace t /\ dim s = dim t + ==> ?f. orthogonal_transformation f /\ IMAGE f s = t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE) THEN + ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `span(IMAGE (f:real^N->real^N) s) = span t` MP_TAC THENL + [MATCH_MP_TAC DIM_EQ_SPAN THEN ASM_REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhs o rand) DIM_INJECTIVE_LINEAR_IMAGE o + rand o snd) THEN + ASM_MESON_TAC[LE_REFL; orthogonal_transformation; + ORTHOGONAL_TRANSFORMATION_INJECTIVE]; + ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE]]);; + +(* ------------------------------------------------------------------------- *) +(* Rotation, reflection, rotoinversion. *) +(* ------------------------------------------------------------------------- *) + +let rotation_matrix = new_definition + `rotation_matrix Q <=> orthogonal_matrix Q /\ det(Q) = &1`;; + +let rotoinversion_matrix = new_definition + `rotoinversion_matrix Q <=> orthogonal_matrix Q /\ det(Q) = -- &1`;; + +let ORTHOGONAL_ROTATION_OR_ROTOINVERSION = prove + (`!Q. orthogonal_matrix Q <=> rotation_matrix Q \/ rotoinversion_matrix Q`, + MESON_TAC[rotation_matrix; rotoinversion_matrix; DET_ORTHOGONAL_MATRIX]);; + +let ROTATION_MATRIX_2 = prove + (`!A:real^2^2. rotation_matrix A <=> + A$1$1 pow 2 + A$2$1 pow 2 = &1 /\ + A$1$1 = A$2$2 /\ A$1$2 = --(A$2$1)`, + REWRITE_TAC[rotation_matrix; ORTHOGONAL_MATRIX_2; DET_2] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Slightly stronger results giving rotation, but only in >= 2 dimensions. *) +(* ------------------------------------------------------------------------- *) + +let ROTATION_MATRIX_EXISTS_BASIS = prove + (`!a:real^N. + 2 <= dimindex(:N) /\ norm(a) = &1 + ==> ?A. rotation_matrix A /\ A**(basis 1) = a`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `A:real^N^N` STRIP_ASSUME_TAC o + MATCH_MP ORTHOGONAL_MATRIX_EXISTS_BASIS) THEN + FIRST_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I + [ORTHOGONAL_ROTATION_OR_ROTOINVERSION]) + THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `transp(lambda i. if i = dimindex(:N) then -- &1 % transp A$i + else (transp A:real^N^N)$i):real^N^N` THEN + REWRITE_TAC[rotation_matrix; DET_TRANSP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[ORTHOGONAL_MATRIX_TRANSP]; + SIMP_TAC[DET_ROW_MUL; DIMINDEX_GE_1; LE_REFL] THEN + MATCH_MP_TAC(REAL_ARITH `x = -- &1 ==> -- &1 * x = &1`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [rotoinversion_matrix]) THEN + DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM DET_TRANSP] THEN + AP_TERM_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; CART_EQ; transp; + BASIS_COMPONENT] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `x * (if p then &1 else &0) = if p then x else &0`] THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> ~(1 = n)`; LAMBDA_BETA]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [GSYM ORTHOGONAL_MATRIX_TRANSP]) THEN + SPEC_TAC(`transp(A:real^N^N)`,`B:real^N^N`) THEN GEN_TAC THEN + SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) + ==> row i ((lambda i. if i = dimindex(:N) then -- &1 % B$i + else (B:real^N^N)$i):real^N^N) = + if i = dimindex(:N) then --(row i B) else row i B` + ASSUME_TAC THENL + [SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA; VECTOR_MUL_LID; VECTOR_MUL_LNEG]; + ASM_SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS] THEN + ASM_MESON_TAC[ORTHOGONAL_LNEG; ORTHOGONAL_RNEG; NORM_NEG]]);; + +let ROTATION_EXISTS_1 = prove + (`!a b:real^N. + 2 <= dimindex(:N) /\ norm(a) = &1 /\ norm(b) = &1 + ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ f a = b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `b:real^N` ROTATION_MATRIX_EXISTS_BASIS) THEN + MP_TAC(ISPEC `a:real^N` ROTATION_MATRIX_EXISTS_BASIS) THEN + ASM_REWRITE_TAC[rotation_matrix] THEN + DISCH_THEN(X_CHOOSE_THEN `A:real^N^N` + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o SYM))) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC (ASSUME_TAC o SYM))) THEN + EXISTS_TAC `\x:real^N. ((B:real^N^N) ** transp(A:real^N^N)) ** x` THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; MATRIX_VECTOR_MUL_LINEAR; + MATRIX_OF_MATRIX_VECTOR_MUL; DET_MUL; DET_TRANSP] THEN + ASM_SIMP_TAC[ORTHOGONAL_MATRIX_MUL; ORTHOGONAL_MATRIX_TRANSP] THEN + REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC; REAL_MUL_LID] THEN AP_TERM_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_MATRIX]) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]);; + +let ROTATION_EXISTS = prove + (`!a b:real^N. + 2 <= dimindex(:N) /\ norm(a) = norm(b) + ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ f a = b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = vec 0` THEN + ASM_SIMP_TAC[NORM_0; NORM_EQ_0] THENL + [MESON_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I]; ALL_TAC] THEN + ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I; NORM_0; + NORM_EQ_0]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`inv(norm a) % a:real^N`; `inv(norm b) % b:real^N`] + ROTATION_EXISTS_1) THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[NORM_EQ_0; REAL_MUL_LINV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL o + MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `a % x:real^N = a % y <=> a % (x - y) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ]);; + +let ROTATION_RIGHTWARD_LINE = prove + (`!a:real^N k. + 1 <= k /\ k <= dimindex(:N) + ==> ?b f. orthogonal_transformation f /\ + (2 <= dimindex(:N) ==> det(matrix f) = &1) /\ + f(b % basis k) = a /\ + &0 <= b`, + REPEAT STRIP_TAC THEN EXISTS_TAC `norm(a:real^N)` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT; LE_REFL; DIMINDEX_GE_1; + REAL_MUL_RID; NORM_POS_LE; LT_IMP_LE; LTE_ANTISYM] THEN + REWRITE_TAC[ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`; DIMINDEX_GE_1] THEN + ASM_CASES_TAC `dimindex(:N) = 1` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC ORTHOGONAL_TRANSFORMATION_EXISTS; + MATCH_MP_TAC ROTATION_EXISTS] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID] THEN + MATCH_MP_TAC(ARITH_RULE `~(n = 1) /\ 1 <= n ==> 2 <= n`) THEN + ASM_REWRITE_TAC[DIMINDEX_GE_1]);; + +(* ------------------------------------------------------------------------- *) +(* In 3 dimensions, a rotation is indeed about an "axis". *) +(* ------------------------------------------------------------------------- *) + +let EULER_ROTATION_THEOREM = prove + (`!A:real^3^3. rotation_matrix A ==> ?v:real^3. ~(v = vec 0) /\ A ** v = v`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `A - mat 1:real^3^3` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_SUB_RDISTRIB; + VECTOR_SUB_EQ; MATRIX_VECTOR_MUL_LID] THEN + DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[rotation_matrix; orthogonal_matrix; DET_3] THEN + SIMP_TAC[CART_EQ; FORALL_3; MAT_COMPONENT; DIMINDEX_3; LAMBDA_BETA; ARITH; + MATRIX_SUB_COMPONENT; MAT_COMPONENT; SUM_3; + matrix_mul; transp; matrix_vector_mul] THEN + CONV_TAC REAL_RING);; + +let EULER_ROTOINVERSION_THEOREM = prove + (`!A:real^3^3. + rotoinversion_matrix A ==> ?v:real^3. ~(v = vec 0) /\ A ** v = --v`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = --v <=> a + v = vec 0`] THEN + MP_TAC(ISPEC `A + mat 1:real^3^3` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_ADD_RDISTRIB; MATRIX_VECTOR_MUL_LID] THEN + DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[rotoinversion_matrix; orthogonal_matrix; DET_3] THEN + SIMP_TAC[CART_EQ; FORALL_3; MAT_COMPONENT; DIMINDEX_3; LAMBDA_BETA; ARITH; + MATRIX_ADD_COMPONENT; MAT_COMPONENT; SUM_3; + matrix_mul; transp; matrix_vector_mul] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* We can always rotate so that a hyperplane is "horizontal". *) +(* ------------------------------------------------------------------------- *) + +let ROTATION_LOWDIM_HORIZONTAL = prove + (`!s:real^N->bool. + dim s < dimindex(:N) + ==> ?f. orthogonal_transformation f /\ det(matrix f) = &1 /\ + (IMAGE f s) SUBSET {z | z$(dimindex(:N)) = &0}`, + GEN_TAC THEN ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[DIM_EQ_0]) THEN DISCH_TAC THEN + EXISTS_TAC `\x:real^N. x` THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID; MATRIX_ID; DET_I] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET {a} ==> a IN t ==> IMAGE (\x. x) s SUBSET t`)) THEN + SIMP_TAC[IN_ELIM_THM; VEC_COMPONENT; LE_REFL; DIMINDEX_GE_1]; + DISCH_TAC] THEN + SUBGOAL_THEN `2 <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC o MATCH_MP + LOWDIM_SUBSET_HYPERPLANE) THEN + MP_TAC(ISPECL [`a:real^N`; `norm(a:real^N) % basis(dimindex(:N)):real^N`] + ROTATION_EXISTS) THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:real^N->real^N) x dot (f a) = &0` MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM]; + ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; DOT_RMUL] THEN + ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0]]);; + +let ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL = prove + (`!s:real^N->bool. + dim s < dimindex(:N) + ==> ?f. orthogonal_transformation f /\ + (IMAGE f s) SUBSET {z | z$(dimindex(:N)) = &0}`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ROTATION_LOWDIM_HORIZONTAL) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);; + +let ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS = prove + (`!v:num->real^N w k. + pairwise (\i j. orthogonal (v i) (v j)) k /\ + pairwise (\i j. orthogonal (w i) (w j)) k /\ + (!i. i IN k ==> norm(v i) = norm(w i)) + ==> ?f. orthogonal_transformation f /\ + (!i. i IN k ==> f(v i) = w i)`, + let lemma1 = prove + (`!v:num->real^N n. + pairwise (\i j. orthogonal (v i) (v j)) (1..n) /\ + (!i. 1 <= i /\ i <= n ==> norm(v i) = &1) + ==> ?f. orthogonal_transformation f /\ + (!i. 1 <= i /\ i <= n ==> f(basis i) = v i)`, + REWRITE_TAC[pairwise; IN_NUMSEG; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `pairwise orthogonal (IMAGE (v:num->real^N) (1..n))` + ASSUME_TAC THENL + [REWRITE_TAC[PAIRWISE_IMAGE] THEN ASM_SIMP_TAC[pairwise; IN_NUMSEG]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + PAIRWISE_ORTHOGONAL_INDEPENDENT)) THEN + REWRITE_TAC[SET_RULE + `~(a IN IMAGE f s) <=> !x. x IN s ==> ~(f x = a)`] THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_NUMSEG] THEN + ASM_MESON_TAC[NORM_0; REAL_ARITH `~(&1 = &0)`]; + DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP INDEPENDENT_BOUND)] THEN + SUBGOAL_THEN + `!i j. 1 <= i /\ i <= n /\ 1 <= j /\ j <= n /\ ~(i = j) + ==> ~(v i:real^N = v j)` + ASSUME_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_REFL; NORM_0; REAL_ARITH `~(&1 = &0)`]; + ALL_TAC] THEN + SUBGOAL_THEN `CARD(IMAGE (v:num->real^N) (1..n)) = n` ASSUME_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o lhs o snd) THEN + ASM_REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN + SUBGOAL_THEN + `?w:num->real^N. + pairwise (\i j. orthogonal (w i) (w j)) (1..dimindex(:N)) /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> norm(w i) = &1) /\ + (!i. 1 <= i /\ i <= n ==> w i = v i)` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC + `(\x. vsum(1..dimindex(:N)) (\i. x$i % w i)):real^N->real^N` THEN + SIMP_TAC[BASIS_COMPONENT; IN_NUMSEG; COND_RATOR; COND_RAND] THEN + REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_LZERO; VSUM_DELTA] THEN + ASM_SIMP_TAC[IN_NUMSEG] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[LE_TRANS]] THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REWRITE_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[matrix; column; ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS] THEN + SIMP_TAC[LAMBDA_BETA; LAMBDA_ETA; BASIS_COMPONENT; IN_NUMSEG] THEN + SIMP_TAC[COND_RATOR; COND_RAND; VECTOR_MUL_LZERO; VSUM_DELTA] THEN + SIMP_TAC[IN_NUMSEG; orthogonal; dot; LAMBDA_BETA; NORM_EQ_SQUARE] THEN + REWRITE_TAC[VECTOR_MUL_LID; GSYM dot; GSYM NORM_EQ_SQUARE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise; IN_NUMSEG; orthogonal]) THEN + ASM_SIMP_TAC[]] THEN + FIRST_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] ORTHONORMAL_EXTENSION)) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; UNION_UNIV; SPAN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`n+1..dimindex(:N)`; `t:real^N->bool`] + CARD_EQ_BIJECTION) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG] THEN + MP_TAC(ISPECL [`(:real^N)`; `IMAGE v (1..n) UNION t:real^N->bool`] + BASIS_CARD_EQ_DIM) THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN ANTS_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + ASM_REWRITE_TAC[IN_UNION; DE_MORGAN_THM; IN_NUMSEG] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; SET_RULE + `~(x IN s) <=> !y. y IN s ==> ~(y = x)`] THEN + ASM_MESON_TAC[NORM_0; REAL_ARITH `~(&1 = &0)`]; + ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_UNION; IMP_CONJ; FINITE_IMAGE; CARD_UNION; + SET_RULE `t INTER s = {} <=> DISJOINT s t`] THEN + DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[CARD_NUMSEG; DIM_UNIV] THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CONJ_ASSOC; SET_RULE + `(!x. x IN s ==> f x IN t) /\ (!y. y IN t ==> ?x. x IN s /\ f x = y) <=> + t = IMAGE f s`] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM; IN_NUMSEG] THEN + X_GEN_TAC `w:num->real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN + REWRITE_TAC[ARITH_RULE `n + 1 <= x <=> n < x`; CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ ~r ==> ~q`] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN STRIP_TAC THEN + REWRITE_TAC[TAUT `p /\ ~r ==> ~q <=> p /\ q ==> r`] THEN + EXISTS_TAC `\i. if i <= n then (v:num->real^N) i else w i` THEN + SIMP_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_NUMSEG]) THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[ARITH_RULE `~(i <= n) ==> n + 1 <= i`]] THEN + REWRITE_TAC[pairwise] THEN MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [MESON_TAC[ORTHOGONAL_SYM]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN + ASM_CASES_TAC `j:num <= n` THEN ASM_REWRITE_TAC[IN_NUMSEG] THENL + [COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `i:num <= n` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + UNDISCH_TAC + `pairwise orthogonal + (IMAGE (v:num->real^N) (1..n) UNION IMAGE w (n+1..dimindex (:N)))` THEN + REWRITE_TAC[pairwise] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(w:num->real^N) j`) THENL + [DISCH_THEN(MP_TAC o SPEC `(v:num->real^N) i`); + DISCH_THEN(MP_TAC o SPEC `(w:num->real^N) i`)] THEN + ASM_REWRITE_TAC[IN_UNION; IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN MATCH_MP_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `~(x <= n) ==> n + 1 <= x`]; ALL_TAC]; + ASM_MESON_TAC[ARITH_RULE `~(x <= n) ==> n + 1 <= x /\ n < x`]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DISJOINT]) THEN + REWRITE_TAC[SET_RULE `IMAGE w t INTER IMAGE v s = {} <=> + !i j. i IN s /\ j IN t ==> ~(v i = w j)`] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN + ASM_ARITH_TAC) in + let lemma2 = prove + (`!v:num->real^N w k. + pairwise (\i j. orthogonal (v i) (v j)) k /\ + pairwise (\i j. orthogonal (w i) (w j)) k /\ + (!i. i IN k ==> norm(v i) = norm(w i)) /\ + (!i. i IN k ==> ~(v i = vec 0) /\ ~(w i = vec 0)) + ==> ?f. orthogonal_transformation f /\ + (!i. i IN k ==> f(v i) = w i)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `FINITE(k:num->bool)` MP_TAC THENL + [SUBGOAL_THEN `pairwise orthogonal (IMAGE (v:num->real^N) k)` + ASSUME_TAC THENL + [REWRITE_TAC[PAIRWISE_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN ASM_SIMP_TAC[pairwise]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + PAIRWISE_ORTHOGONAL_INDEPENDENT)) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_MESON_TAC[ORTHOGONAL_REFL]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> p /\ q /\ ~s ==> ~r`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num->num` MP_TAC) THEN + REWRITE_TAC[IN_NUMSEG] THEN GEN_REWRITE_TAC I [IMP_CONJ] THEN + DISCH_THEN(fun th -> DISCH_THEN SUBST_ALL_TAC THEN ASSUME_TAC th) THEN + RULE_ASSUM_TAC(REWRITE_RULE + [PAIRWISE_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]) THEN + MP_TAC(ISPECL + [`\i. inv(norm(w(n i))) % (w:num->real^N) ((n:num->num) i)`; + `CARD(k:num->bool)`] lemma1) THEN + MP_TAC(ISPECL + [`\i. inv(norm(v(n i))) % (v:num->real^N) ((n:num->num) i)`; + `CARD(k:num->bool)`] lemma1) THEN + ASM_SIMP_TAC[NORM_MUL; REAL_MUL_LINV; NORM_EQ_0; REAL_ABS_INV; + REAL_ABS_NORM; pairwise; orthogonal; IN_NUMSEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal; IN_NUMSEG]) THEN + ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; REAL_ENTIRE; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `f:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:real^N->real^N) o (f':real^N->real^N)` THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `(g:real^N->real^N) (norm((w:num->real^N)(n(i:num))) % basis i)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `(!x. f'(f x) = x) ==> f x = y ==> f' y = x`)); + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN + ASM_SIMP_TAC[LINEAR_CMUL; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID]) in + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`v:num->real^N`; `w:num->real^N`; + `{i | i IN k /\ ~((v:num->real^N) i = vec 0)}`] lemma2) THEN + ASM_SIMP_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[NORM_EQ_0]] THEN + CONJ_TAC THEN MATCH_MP_TAC PAIRWISE_MONO THEN EXISTS_TAC `k:num->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[orthogonal_transformation] THEN + GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(v:num->real^N) i = vec 0` THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[LINEAR_0; NORM_EQ_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Reflection of a vector about 0 along a line. *) +(* ------------------------------------------------------------------------- *) + +let reflect_along = new_definition + `reflect_along v (x:real^N) = x - (&2 * (x dot v) / (v dot v)) % v`;; + +let REFLECT_ALONG_ADD = prove + (`!v x y:real^N. + reflect_along v (x + y) = reflect_along v x + reflect_along v y`, + REPEAT GEN_TAC THEN + REWRITE_TAC[reflect_along; VECTOR_ARITH + `x - a % v + y - b % v:real^N = (x + y) - (a + b) % v`] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[DOT_LADD] THEN REAL_ARITH_TAC);; + +let REFLECT_ALONG_MUL = prove + (`!v a x:real^N. reflect_along v (a % x) = a % reflect_along v x`, + REWRITE_TAC[reflect_along; DOT_LMUL; REAL_ARITH + `&2 * (a * x) / y = a * &2 * x / y`] THEN + REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC]);; + +let LINEAR_REFLECT_ALONG = prove + (`!v:real^N. linear(reflect_along v)`, + REWRITE_TAC[linear; REFLECT_ALONG_ADD; REFLECT_ALONG_MUL]);; + +let REFLECT_ALONG_0 = prove + (`!v:real^N. reflect_along v (vec 0) = vec 0`, + REWRITE_TAC[MATCH_MP LINEAR_0 (SPEC_ALL LINEAR_REFLECT_ALONG)]);; + +let REFLECT_ALONG_REFL = prove + (`!v:real^N. reflect_along v v = --v`, + GEN_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THEN + ASM_REWRITE_TAC[VECTOR_NEG_0; REFLECT_ALONG_0] THEN + REWRITE_TAC[reflect_along] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; DOT_EQ_0] THEN VECTOR_ARITH_TAC);; + +let REFLECT_ALONG_INVOLUTION = prove + (`!v x:real^N. reflect_along v (reflect_along v x) = x`, + REWRITE_TAC[reflect_along; DOT_LSUB; VECTOR_MUL_EQ_0; VECTOR_ARITH + `x - a % v - b % v:real^N = x <=> (a + b) % v = vec 0`] THEN + REWRITE_TAC[DOT_LMUL; GSYM DOT_EQ_0] THEN CONV_TAC REAL_FIELD);; + +let REFLECT_ALONG_EQ_0 = prove + (`!v x:real^N. reflect_along v x = vec 0 <=> x = vec 0`, + MESON_TAC[REFLECT_ALONG_0; REFLECT_ALONG_INVOLUTION]);; + +let ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG = prove + (`!v:real^N. orthogonal_transformation(reflect_along v)`, + GEN_TAC THEN ASM_CASES_TAC `v:real^N = vec 0` THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN + ASM_REWRITE_TAC[reflect_along; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO; + ORTHOGONAL_TRANSFORMATION_ID]; + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN + REWRITE_TAC[LINEAR_REFLECT_ALONG; NORM_EQ] THEN + REWRITE_TAC[reflect_along; VECTOR_ARITH + `(a - b:real^N) dot (a - b) = (a dot a + b dot b) - &2 * a dot b`] THEN + REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN X_GEN_TAC `w:real^N` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DOT_EQ_0]) THEN + CONV_TAC REAL_FIELD]);; + +let REFLECT_ALONG_EQ_SELF = prove + (`!v x:real^N. reflect_along v x = x <=> orthogonal v x`, + REPEAT GEN_TAC THEN REWRITE_TAC[reflect_along; orthogonal] THEN + REWRITE_TAC[VECTOR_ARITH `x - a:real^N = x <=> a = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_SIMP_TAC[DOT_LZERO; DOT_SYM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DOT_EQ_0]) THEN + CONV_TAC REAL_FIELD);; + +let REFLECT_ALONG_ZERO = prove + (`!x:real^N. reflect_along (vec 0) = I`, + REWRITE_TAC[FUN_EQ_THM; I_THM; REFLECT_ALONG_EQ_SELF; ORTHOGONAL_0]);; + +let REFLECT_ALONG_LINEAR_IMAGE = prove + (`!f:real^M->real^N v x. + linear f /\ (!x. norm(f x) = norm x) + ==> reflect_along (f v) (f x) = f(reflect_along v x)`, + REWRITE_TAC[reflect_along] THEN + SIMP_TAC[PRESERVES_NORM_PRESERVES_DOT; LINEAR_SUB; LINEAR_CMUL]);; + +add_linear_invariants [REFLECT_ALONG_LINEAR_IMAGE];; + +let REFLECT_ALONG_SCALE = prove + (`!c v x:real^N. ~(c = &0) ==> reflect_along (c % v) x = reflect_along v x`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `v:real^N = vec 0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; REFLECT_ALONG_ZERO] THEN + REWRITE_TAC[reflect_along; VECTOR_MUL_ASSOC] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[DOT_RMUL] THEN REWRITE_TAC[DOT_LMUL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DOT_EQ_0]) THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +let REFLECT_ALONG_1D = prove + (`!v x:real^N. + dimindex(:N) = 1 ==> reflect_along v x = if v = vec 0 then x else --x`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[reflect_along; dot; SUM_1; CART_EQ; FORALL_1] THEN + REWRITE_TAC[VEC_COMPONENT; COND_RATOR; COND_RAND] THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; REAL_MUL_RZERO] THEN + CONV_TAC REAL_FIELD);; + +let REFLECT_ALONG_BASIS = prove + (`!x:real^N k. + 1 <= k /\ k <= dimindex(:N) + ==> reflect_along (basis k) x = x - (&2 * x$k) % basis k`, + SIMP_TAC[reflect_along; DOT_BASIS; BASIS_COMPONENT; REAL_DIV_1]);; + +let MATRIX_REFLECT_ALONG_BASIS = prove + (`!k. 1 <= k /\ k <= dimindex(:N) + ==> matrix(reflect_along (basis k)):real^N^N = + lambda i j. if i = k /\ j = k then --(&1) + else if i = j then &1 + else &0`, + SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix; REFLECT_ALONG_BASIS; + VECTOR_SUB_COMPONENT; BASIS_COMPONENT; VECTOR_MUL_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC);; + +let ROTOINVERSION_MATRIX_REFLECT_ALONG = prove + (`!v:real^N. ~(v = vec 0) ==> rotoinversion_matrix(matrix(reflect_along v))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rotoinversion_matrix] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX; + ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG]; + ALL_TAC] THEN + ABBREV_TAC `w:real^N = inv(norm v) % v` THEN + SUBGOAL_THEN `reflect_along (v:real^N) = reflect_along w` SUBST1_TAC THENL + [EXPAND_TAC "w" THEN REWRITE_TAC[FUN_EQ_THM] THEN + ASM_SIMP_TAC[REFLECT_ALONG_SCALE; REAL_INV_EQ_0; NORM_EQ_0]; + SUBGOAL_THEN `norm(w:real^N) = &1` MP_TAC THENL + [EXPAND_TAC "w" THEN SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[NORM_EQ_0]; + POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`w:real^N`,`v:real^N`)]] THEN + X_GEN_TAC `v:real^N` THEN ASM_CASES_TAC `v:real^N = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`v:real^N`; `basis 1:real^N`] + ORTHOGONAL_TRANSFORMATION_EXISTS) THEN + ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `matrix(reflect_along v) = + transp(matrix(f:real^N->real^N)) ** matrix(reflect_along (f v)) ** matrix f` + SUBST1_TAC THENL + [UNDISCH_THEN `(f:real^N->real^N) v = basis 1` (K ALL_TAC) THEN + REWRITE_TAC[MATRIX_EQ; GSYM MATRIX_VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[MATRIX_WORKS; LINEAR_REFLECT_ALONG; + ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(transp(matrix(f:real^N->real^N)) ** matrix f) ** + (reflect_along v x:real^N)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_MATRIX; MATRIX_VECTOR_MUL_LID; + ORTHOGONAL_TRANSFORMATION_MATRIX]; + REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[MATRIX_WORKS; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REFLECT_ALONG_LINEAR_IMAGE THEN + ASM_REWRITE_TAC[GSYM ORTHOGONAL_TRANSFORMATION]]; + ASM_REWRITE_TAC[DET_MUL; DET_TRANSP] THEN + MATCH_MP_TAC(REAL_RING + `(x = &1 \/ x = -- &1) /\ y = a ==> x * y * x = a`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[DET_ORTHOGONAL_MATRIX; ORTHOGONAL_TRANSFORMATION_MATRIX]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhand o snd) THEN + SIMP_TAC[MATRIX_REFLECT_ALONG_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + SIMP_TAC[LAMBDA_BETA; ARITH_RULE + `j < i ==> ~(i = j) /\ ~(i = 1 /\ j = 1)`] THEN + DISCH_THEN(K ALL_TAC) THEN + SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1] THEN + MATCH_MP_TAC(REAL_RING `x = &1 ==> a * x = a`) THEN + MATCH_MP_TAC PRODUCT_EQ_1 THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let DET_MATRIX_REFLECT_ALONG = prove + (`!v:real^N. det(matrix(reflect_along v)) = + if v = vec 0 then &1 else --(&1)`, + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REFLECT_ALONG_ZERO] THEN + REWRITE_TAC[MATRIX_I; DET_I] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ROTOINVERSION_MATRIX_REFLECT_ALONG) THEN + SIMP_TAC[rotoinversion_matrix]);; + +(* ------------------------------------------------------------------------- *) +(* All orthogonal transformations are a composition of reflections. *) +(* ------------------------------------------------------------------------- *) + +let ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS = prove + (`!f:real^N->real^N n. + orthogonal_transformation f /\ + dimindex(:N) <= dim {x | f x = x} + n + ==> ?l. LENGTH l <= n /\ ALL (\v. ~(v = vec 0)) l /\ + f = ITLIST (\v h. reflect_along v o h) l I`, + ONCE_REWRITE_TAC[GSYM SWAP_FORALL_THM] THEN INDUCT_TAC THENL + [REWRITE_TAC[CONJUNCT1 LE; LENGTH_EQ_NIL; ADD_CLAUSES; UNWIND_THM2] THEN + SIMP_TAC[DIM_SUBSET_UNIV; ARITH_RULE `a:num <= b ==> (b <= a <=> a = b)`; + ITLIST; DIM_EQ_FULL; orthogonal_transformation] THEN + SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_LINEAR_FIXED_POINTS; IMP_CONJ] THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_ELIM_THM] THEN + SIMP_TAC[FUN_EQ_THM; I_THM; ALL]; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `!x:real^N. f x = x` THENL + [EXISTS_TAC `[]:(real^N) list` THEN + ASM_REWRITE_TAC[ITLIST; FUN_EQ_THM; I_THM; ALL; LENGTH; LE_0]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM])] THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + ABBREV_TAC `v:real^N = inv(&2) % (f a - a)` THEN FIRST_X_ASSUM + (MP_TAC o SPEC `reflect_along v o (f:real^N->real^N)`) THEN + ASM_SIMP_TAC[ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG; + ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `a <= d + SUC n ==> d < d' ==> a <= d' + n`)) THEN + MATCH_MP_TAC DIM_PSUBSET THEN REWRITE_TAC[PSUBSET_ALT] THEN + SUBGOAL_THEN + `!y:real^N. dist(y,f a) = dist(y,a) ==> reflect_along v y = y` + ASSUME_TAC THENL + [REWRITE_TAC[dist; NORM_EQ_SQUARE; NORM_POS_LE; NORM_POW_2] THEN + REWRITE_TAC[VECTOR_ARITH + `(y - b:real^N) dot (y - b) = + (y dot y + b dot b) - &2 * y dot b`] THEN + REWRITE_TAC[REAL_ARITH `(y + aa) - &2 * a = (y + bb) - &2 * b <=> + a - b = inv(&2) * (aa - bb)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthogonal_transformation]) THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN + EXPAND_TAC "v" THEN REWRITE_TAC[GSYM DOT_RSUB; reflect_along] THEN + SIMP_TAC[DOT_RMUL; real_div; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SPAN_MONO THEN SIMP_TAC[SUBSET; IN_ELIM_THM; o_THM] THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_ISOMETRY]; + ALL_TAC] THEN + EXISTS_TAC `a:real^N` THEN + ASM_SIMP_TAC[SUBSPACE_LINEAR_FIXED_POINTS; SPAN_OF_SUBSPACE; + ORTHOGONAL_TRANSFORMATION_LINEAR; IN_ELIM_THM] THEN + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM; o_THM] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `reflect_along (v:real^N) (midpoint(f a,a) + v)` THEN + CONJ_TAC THENL + [AP_TERM_TAC; + REWRITE_TAC[REFLECT_ALONG_ADD] THEN + ASM_SIMP_TAC[DIST_MIDPOINT; REFLECT_ALONG_REFL]] THEN + EXPAND_TAC "v" THEN REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `l:(real^N)list` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `CONS (v:real^N) l` THEN + ASM_REWRITE_TAC[ALL; LENGTH; LE_SUC; VECTOR_SUB_EQ; ITLIST] THEN + EXPAND_TAC "v" THEN ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM + `(o)(reflect_along (v:real^N)):(real^N->real^N)->(real^N->real^N)`) THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; REFLECT_ALONG_INVOLUTION]]]);; + +(* ------------------------------------------------------------------------- *) +(* Extract scaling, translation and linear invariance theorems. *) +(* For the linear case, chain through some basic consequences automatically, *) +(* e.g. norm-preserving and linear implies injective. *) +(* ------------------------------------------------------------------------- *) + +let SCALING_THEOREMS v = + let th1 = UNDISCH(snd(EQ_IMP_RULE(ISPEC v NORM_POS_LT))) in + let t = rand(concl th1) in + end_itlist CONJ (map (C MP th1 o SPEC t) (!scaling_theorems));; + +let TRANSLATION_INVARIANTS x = + end_itlist CONJ (mapfilter (ISPEC x) (!invariant_under_translation));; + +let USABLE_CONCLUSION f ths th = + let ith = PURE_REWRITE_RULE[RIGHT_FORALL_IMP_THM] (ISPEC f th) in + let bod = concl ith in + let cjs = conjuncts(fst(dest_imp bod)) in + let ths = map (fun t -> find(fun th -> aconv (concl th) t) ths) cjs in + GEN_ALL(MP ith (end_itlist CONJ ths));; + +let LINEAR_INVARIANTS = + let sths = (CONJUNCTS o prove) + (`(!f:real^M->real^N. + linear f /\ (!x. norm(f x) = norm x) + ==> (!x y. f x = f y ==> x = y)) /\ + (!f:real^N->real^N. + linear f /\ (!x. norm(f x) = norm x) ==> (!y. ?x. f x = y)) /\ + (!f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) + ==> (!y. ?x. f x = y)) /\ + (!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) + ==> (!x y. f x = f y ==> x = y))`, + CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + SIMP_TAC[GSYM LINEAR_SUB; GSYM NORM_EQ_0]; + MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; + ORTHOGONAL_TRANSFORMATION_INJECTIVE; ORTHOGONAL_TRANSFORMATION; + LINEAR_SURJECTIVE_IFF_INJECTIVE]]) in + fun f ths -> + let ths' = ths @ mapfilter (USABLE_CONCLUSION f ths) sths in + end_itlist CONJ + (mapfilter (USABLE_CONCLUSION f ths') (!invariant_under_linear));; + +(* ------------------------------------------------------------------------- *) +(* Tactic to pick WLOG a particular point as the origin. The conversion form *) +(* assumes it's the outermost universal variable; the tactic is more general *) +(* and allows any free or outer universally quantified variable. The list *) +(* "avoid" is the points not to translate. There is also a tactic to help in *) +(* proving new translation theorems, which uses similar machinery. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_ORIGIN_CONV,GEOM_TRANSLATE_CONV = + let pth = prove + (`!a:real^N. a = a + vec 0 /\ + {} = IMAGE (\x. a + x) {} /\ + {} = IMAGE (IMAGE (\x. a + x)) {} /\ + (:real^N) = IMAGE (\x. a + x) (:real^N) /\ + (:real^N->bool) = IMAGE (IMAGE (\x. a + x)) (:real^N->bool) /\ + [] = MAP (\x. a + x) []`, + REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; MAP] THEN + REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN + REWRITE_TAC[SURJECTIVE_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `a + y:real^N = x <=> y = x - a`; EXISTS_REFL]) + and qth = prove + (`!a:real^N. + ((!P. (!x. P x) <=> (!x. P (a + x))) /\ + (!P. (?x. P x) <=> (?x. P (a + x))) /\ + (!Q. (!s. Q s) <=> (!s. Q(IMAGE (\x. a + x) s))) /\ + (!Q. (?s. Q s) <=> (?s. Q(IMAGE (\x. a + x) s))) /\ + (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE (\x. a + x)) s))) /\ + (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE (\x. a + x)) s))) /\ + (!P. (!g:real^1->real^N. P g) <=> (!g. P ((\x. a + x) o g))) /\ + (!P. (?g:real^1->real^N. P g) <=> (?g. P ((\x. a + x) o g))) /\ + (!P. (!g:num->real^N. P g) <=> (!g. P ((\x. a + x) o g))) /\ + (!P. (?g:num->real^N. P g) <=> (?g. P ((\x. a + x) o g))) /\ + (!Q. (!l. Q l) <=> (!l. Q(MAP (\x. a + x) l))) /\ + (!Q. (?l. Q l) <=> (?l. Q(MAP (\x. a + x) l)))) /\ + ((!P. {x | P x} = IMAGE (\x. a + x) {x | P(a + x)}) /\ + (!Q. {s | Q s} = + IMAGE (IMAGE (\x. a + x)) {s | Q(IMAGE (\x. a + x) s)}) /\ + (!R. {l | R l} = IMAGE (MAP (\x. a + x)) {l | R(MAP (\x. a + x) l)}))`, + GEN_TAC THEN MATCH_MP_TAC QUANTIFY_SURJECTION_HIGHER_THM THEN + X_GEN_TAC `y:real^N` THEN EXISTS_TAC `y - a:real^N` THEN + VECTOR_ARITH_TAC) in + let GEOM_ORIGIN_CONV avoid tm = + let x,tm0 = dest_forall tm in + let th0 = ISPEC x pth in + let x' = genvar(type_of x) in + let ith = ISPEC x' qth in + let th1 = PARTIAL_EXPAND_QUANTS_CONV avoid (ASSUME(concl ith)) tm0 in + let th2 = CONV_RULE(RAND_CONV(SUBS_CONV(CONJUNCTS th0))) th1 in + let th3 = INST[x,x'] (PROVE_HYP ith th2) in + let ths = TRANSLATION_INVARIANTS x in + let thr = REFL x in + let th4 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) + [BETA_THM;ADD_ASSUM(concl thr) ths] th3 in + let th5 = MK_FORALL x (PROVE_HYP thr th4) in + GEN_REWRITE_RULE (RAND_CONV o TRY_CONV) [FORALL_SIMP] th5 + and GEOM_TRANSLATE_CONV avoid a tm = + let cth = CONJUNCT2(ISPEC a pth) + and vth = ISPEC a qth in + let th1 = PARTIAL_EXPAND_QUANTS_CONV avoid (ASSUME(concl vth)) tm in + let th2 = CONV_RULE(RAND_CONV(SUBS_CONV(CONJUNCTS cth))) th1 in + let th3 = PROVE_HYP vth th2 in + let ths = TRANSLATION_INVARIANTS a in + let thr = REFL a in + let th4 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) + [BETA_THM;ADD_ASSUM(concl thr) ths] th3 in + PROVE_HYP thr th4 in + GEOM_ORIGIN_CONV,GEOM_TRANSLATE_CONV;; + +let GEN_GEOM_ORIGIN_TAC x avoid (asl,w as gl) = + let avs,bod = strip_forall w + and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in + (MAP_EVERY X_GEN_TAC avs THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [x])) THEN + SPEC_TAC(x,x) THEN CONV_TAC(GEOM_ORIGIN_CONV avoid)) gl;; + +let GEOM_ORIGIN_TAC x = GEN_GEOM_ORIGIN_TAC x [];; + +let GEOM_TRANSLATE_TAC avoid (asl,w) = + let a,bod = dest_forall w in + let n = length(fst(strip_forall bod)) in + (X_GEN_TAC a THEN + CONV_TAC(funpow n BINDER_CONV (LAND_CONV(GEOM_TRANSLATE_CONV avoid a))) THEN + REWRITE_TAC[]) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Rename existential variables in conclusion to fresh genvars. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_GENVAR_RULE = + let rec rule vs th = + match vs with + [] -> th + | v::ovs -> let x,bod = dest_exists(concl th) in + let th1 = rule ovs (ASSUME bod) in + let th2 = SIMPLE_CHOOSE x (SIMPLE_EXISTS x th1) in + PROVE_HYP th (CONV_RULE (GEN_ALPHA_CONV v) th2) in + fun th -> rule (map (genvar o type_of) (fst(strip_exists(concl th)))) th;; + +(* ------------------------------------------------------------------------- *) +(* Rotate so that WLOG some point is a +ve multiple of basis vector k. *) +(* For general N, it's better to use k = 1 so the side-condition can be *) +(* discharged. For dimensions 1, 2 and 3 anything will work automatically. *) +(* Could generalize by asking the user to prove theorem 1 <= k <= N. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_BASIS_MULTIPLE_RULE = + let pth = prove + (`!f. orthogonal_transformation (f:real^N->real^N) + ==> (vec 0 = f(vec 0) /\ + {} = IMAGE f {} /\ + {} = IMAGE (IMAGE f) {} /\ + (:real^N) = IMAGE f (:real^N) /\ + (:real^N->bool) = IMAGE (IMAGE f) (:real^N->bool) /\ + [] = MAP f []) /\ + ((!P. (!x. P x) <=> (!x. P (f x))) /\ + (!P. (?x. P x) <=> (?x. P (f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE f s))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE f s))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE (IMAGE f) s))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE (IMAGE f) s))) /\ + (!P. (!g:real^1->real^N. P g) <=> (!g. P (f o g))) /\ + (!P. (?g:real^1->real^N. P g) <=> (?g. P (f o g))) /\ + (!P. (!g:num->real^N. P g) <=> (!g. P (f o g))) /\ + (!P. (?g:num->real^N. P g) <=> (?g. P (f o g))) /\ + (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\ + (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\ + ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\ + (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\ + (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o + MATCH_MP ORTHOGONAL_TRANSFORMATION_SURJECTIVE) THEN + CONJ_TAC THENL + [REWRITE_TAC[IMAGE_CLAUSES; MAP] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + CONJ_TAC THENL [ASM_MESON_TAC[LINEAR_0]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN + ASM_REWRITE_TAC[SURJECTIVE_IMAGE]; + MATCH_MP_TAC QUANTIFY_SURJECTION_HIGHER_THM THEN ASM_REWRITE_TAC[]]) + and oth = prove + (`!f:real^N->real^N. + orthogonal_transformation f /\ + (2 <= dimindex(:N) ==> det(matrix f) = &1) + ==> linear f /\ + (!x y. f x = f y ==> x = y) /\ + (!y. ?x. f x = y) /\ + (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:N) ==> det(matrix f) = &1)`, + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) + and arithconv = REWRITE_CONV[DIMINDEX_1; DIMINDEX_2; DIMINDEX_3; + ARITH_RULE `1 <= 1`; DIMINDEX_GE_1] THENC + NUM_REDUCE_CONV in + fun k tm -> + let x,bod = dest_forall tm in + let th0 = ISPECL [x; mk_small_numeral k] ROTATION_RIGHTWARD_LINE in + let th1 = EXISTS_GENVAR_RULE + (MP th0 (EQT_ELIM(arithconv(lhand(concl th0))))) in + let [a;f],tm1 = strip_exists(concl th1) in + let th_orth,th2 = CONJ_PAIR(ASSUME tm1) in + let th_det,th2a = CONJ_PAIR th2 in + let th_works,th_zero = CONJ_PAIR th2a in + let thc,thq = CONJ_PAIR(PROVE_HYP th2 (UNDISCH(ISPEC f pth))) in + let th3 = CONV_RULE(RAND_CONV(SUBS_CONV(GSYM th_works::CONJUNCTS thc))) + (EXPAND_QUANTS_CONV(ASSUME(concl thq)) bod) in + let th4 = PROVE_HYP thq th3 in + let thps = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in + let th5 = LINEAR_INVARIANTS f thps in + let th6 = PROVE_HYP th_orth + (GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM; th5] th4) in + let ntm = mk_forall(a,mk_imp(concl th_zero,rand(concl th6))) in + let th7 = MP(SPEC a (ASSUME ntm)) th_zero in + let th8 = DISCH ntm (EQ_MP (SYM th6) th7) in + if intersect (frees(concl th8)) [a;f] = [] then + let th9 = PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th8) in + let th10 = DISCH ntm (GEN x (UNDISCH th9)) in + let a' = variant (frees(concl th10)) + (mk_var(fst(dest_var x),snd(dest_var a))) in + CONV_RULE(LAND_CONV (GEN_ALPHA_CONV a')) th10 + else + let mtm = list_mk_forall([a;f],mk_imp(hd(hyp th8),rand(concl th6))) in + let th9 = EQ_MP (SYM th6) (UNDISCH(SPECL [a;f] (ASSUME mtm))) in + let th10 = itlist SIMPLE_CHOOSE [a;f] (DISCH mtm th9) in + let th11 = GEN x (PROVE_HYP th1 th10) in + MATCH_MP MONO_FORALL th11;; + +let GEOM_BASIS_MULTIPLE_TAC k l (asl,w as gl) = + let avs,bod = strip_forall w + and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in + (MAP_EVERY X_GEN_TAC avs THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [l])) THEN + SPEC_TAC(l,l) THEN + W(MATCH_MP_TAC o GEOM_BASIS_MULTIPLE_RULE k o snd)) gl;; + +(* ------------------------------------------------------------------------- *) +(* Create invariance theorems automatically, in simple cases. If there are *) +(* any nested quantifiers, this will need surjectivity. It's often possible *) +(* to prove a stronger theorem by more delicate manual reasoning, so this *) +(* isn't used nearly as often as GEOM_TRANSLATE_CONV / GEOM_TRANSLATE_TAC. *) +(* As a small step, some ad-hoc rewrites analogous to FORALL_IN_IMAGE are *) +(* tried if the first step doesn't finish the goal, but it's very ad hoc. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_TRANSFORM_TAC = + let cth0 = prove + (`!f:real^M->real^N. + linear f + ==> vec 0 = f(vec 0) /\ + {} = IMAGE f {} /\ + {} = IMAGE (IMAGE f) {}`, + REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_0]) + and cth1 = prove + (`!f:real^M->real^N. + (!y. ?x. f x = y) + ==> (:real^N) = IMAGE f (:real^M) /\ + (:real^N->bool) = IMAGE (IMAGE f) (:real^M->bool)`, + REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN + REWRITE_TAC[SURJECTIVE_IMAGE]) + and sths = (CONJUNCTS o prove) + (`(!f:real^M->real^N. + linear f /\ (!x. norm(f x) = norm x) + ==> (!x y. f x = f y ==> x = y)) /\ + (!f:real^N->real^N. + linear f /\ (!x. norm(f x) = norm x) ==> (!y. ?x. f x = y)) /\ + (!f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) + ==> (!y. ?x. f x = y)) /\ + (!f:real^N->real^N. linear f /\ (!y. ?x. f x = y) + ==> (!x y. f x = f y ==> x = y))`, + CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + SIMP_TAC[GSYM LINEAR_SUB; GSYM NORM_EQ_0]; + MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; + ORTHOGONAL_TRANSFORMATION_INJECTIVE; ORTHOGONAL_TRANSFORMATION; + LINEAR_SURJECTIVE_IFF_INJECTIVE]]) + and aths = (CONJUNCTS o prove) + (`(!f s P. (!y. y IN IMAGE f s ==> P y) <=> (!x. x IN s ==> P(f x))) /\ + (!f s P. (!u. u IN IMAGE (IMAGE f) s ==> P u) <=> + (!t. t IN s ==> P(IMAGE f t))) /\ + (!f s P. (?y. y IN IMAGE f s /\ P y) <=> (?x. x IN s /\ P(f x))) /\ + (!f s P. (?u. u IN IMAGE (IMAGE f) s /\ P u) <=> + (?t. t IN s /\ P(IMAGE f t)))`, + SET_TAC[]) in + fun avoid (asl,w as gl) -> + let f,wff = dest_forall w in + let vs,bod = strip_forall wff in + let ant,cons = dest_imp bod in + let hths = CONJUNCTS(ASSUME ant) in + let fths = hths @ mapfilter (USABLE_CONCLUSION f hths) sths in + let cths = mapfilter (USABLE_CONCLUSION f fths) [cth0; cth1] + and vconv = + try let vth = USABLE_CONCLUSION f fths QUANTIFY_SURJECTION_HIGHER_THM in + PROVE_HYP vth o PARTIAL_EXPAND_QUANTS_CONV avoid (ASSUME(concl vth)) + with Failure _ -> ALL_CONV + and bths = LINEAR_INVARIANTS f fths in + (MAP_EVERY X_GEN_TAC (f::vs) THEN DISCH_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) cths THEN + CONV_TAC(LAND_CONV vconv) THEN + GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [bths] THEN + REWRITE_TAC[] THEN + REWRITE_TAC(mapfilter (ADD_ASSUM ant o ISPEC f) aths) THEN + GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [bths] THEN + REWRITE_TAC[]) gl;; + +(* ------------------------------------------------------------------------- *) +(* Scale so that a chosen vector has size 1. Generates a conjunction of *) +(* two formulas, one for the zero case (which one hopes is trivial) and *) +(* one just like the original goal but with a norm(...) = 1 assumption. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_NORMALIZE_RULE = + let pth = prove + (`!a:real^N. ~(a = vec 0) + ==> vec 0 = norm(a) % vec 0 /\ + a = norm(a) % inv(norm a) % a /\ + {} = IMAGE (\x. norm(a) % x) {} /\ + {} = IMAGE (IMAGE (\x. norm(a) % x)) {} /\ + (:real^N) = IMAGE (\x. norm(a) % x) (:real^N) /\ + (:real^N->bool) = + IMAGE (IMAGE (\x. norm(a) % x)) (:real^N->bool) /\ + [] = MAP (\x. norm(a) % x) []`, + REWRITE_TAC[IMAGE_CLAUSES; VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO; MAP] THEN + SIMP_TAC[NORM_EQ_0; REAL_MUL_RINV; VECTOR_MUL_LID] THEN + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> !y. ?x. f x = y`] THEN + ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN + X_GEN_TAC `y:real^N` THEN EXISTS_TAC `inv(norm(a:real^N)) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; NORM_EQ_0; REAL_MUL_RINV; VECTOR_MUL_LID]) + and qth = prove + (`!a:real^N. + ~(a = vec 0) + ==> ((!P. (!r:real. P r) <=> (!r. P(norm a * r))) /\ + (!P. (?r:real. P r) <=> (?r. P(norm a * r))) /\ + (!P. (!x:real^N. P x) <=> (!x. P (norm(a) % x))) /\ + (!P. (?x:real^N. P x) <=> (?x. P (norm(a) % x))) /\ + (!Q. (!s:real^N->bool. Q s) <=> + (!s. Q(IMAGE (\x. norm(a) % x) s))) /\ + (!Q. (?s:real^N->bool. Q s) <=> + (?s. Q(IMAGE (\x. norm(a) % x) s))) /\ + (!Q. (!s:(real^N->bool)->bool. Q s) <=> + (!s. Q(IMAGE (IMAGE (\x. norm(a) % x)) s))) /\ + (!Q. (?s:(real^N->bool)->bool. Q s) <=> + (?s. Q(IMAGE (IMAGE (\x. norm(a) % x)) s))) /\ + (!P. (!g:real^1->real^N. P g) <=> + (!g. P ((\x. norm(a) % x) o g))) /\ + (!P. (?g:real^1->real^N. P g) <=> + (?g. P ((\x. norm(a) % x) o g))) /\ + (!P. (!g:num->real^N. P g) <=> + (!g. P ((\x. norm(a) % x) o g))) /\ + (!P. (?g:num->real^N. P g) <=> + (?g. P ((\x. norm(a) % x) o g))) /\ + (!Q. (!l. Q l) <=> (!l. Q(MAP (\x:real^N. norm(a) % x) l))) /\ + (!Q. (?l. Q l) <=> (?l. Q(MAP (\x:real^N. norm(a) % x) l)))) /\ + ((!P. {x:real^N | P x} = + IMAGE (\x. norm(a) % x) {x | P(norm(a) % x)}) /\ + (!Q. {s:real^N->bool | Q s} = + IMAGE (IMAGE (\x. norm(a) % x)) + {s | Q(IMAGE (\x. norm(a) % x) s)}) /\ + (!R. {l:(real^N)list | R l} = + IMAGE (MAP (\x:real^N. norm(a) % x)) + {l | R(MAP (\x:real^N. norm(a) % x) l)}))`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT + `(a /\ b) /\ c /\ d ==> (a /\ b /\ c) /\ d`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[NORM_EQ_0; REAL_FIELD `~(x = &0) ==> x * inv x * a = a`]; + MP_TAC(ISPEC `\x:real^N. norm(a:real^N) % x` + (INST_TYPE [`:real^1`,`:C`] QUANTIFY_SURJECTION_HIGHER_THM)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[SURJECTIVE_SCALING; NORM_EQ_0]]) + and lth = prove + (`(!b:real^N. ~(b = vec 0) ==> (P(b) <=> Q(inv(norm b) % b))) + ==> P(vec 0) /\ (!b. norm(b) = &1 ==> Q b) ==> (!b. P b)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `b:real^N = vec 0` THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; + REAL_MUL_LINV; NORM_EQ_0]) in + fun avoid tm -> + let x,tm0 = dest_forall tm in + let cth = UNDISCH(ISPEC x pth) + and vth = UNDISCH(ISPEC x qth) in + let th1 = ONCE_REWRITE_CONV[cth] tm0 in + let th2 = CONV_RULE (RAND_CONV + (PARTIAL_EXPAND_QUANTS_CONV avoid vth)) th1 in + let th3 = SCALING_THEOREMS x in + let th3' = (end_itlist CONJ (map + (fun th -> let avs,_ = strip_forall(concl th) in + let gvs = map (genvar o type_of) avs in + GENL gvs (SPECL gvs th)) + (CONJUNCTS th3))) in + let th4 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) + [BETA_THM; th3'] th2 in + MATCH_MP lth (GEN x (DISCH_ALL th4));; + +let GEN_GEOM_NORMALIZE_TAC x avoid (asl,w as gl) = + let avs,bod = strip_forall w + and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in + (MAP_EVERY X_GEN_TAC avs THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [x])) THEN + SPEC_TAC(x,x) THEN + W(MATCH_MP_TAC o GEOM_NORMALIZE_RULE avoid o snd)) gl;; + +let GEOM_NORMALIZE_TAC x = GEN_GEOM_NORMALIZE_TAC x [];; + +(* ------------------------------------------------------------------------- *) +(* Add invariance theorems for collinearity. *) +(* ------------------------------------------------------------------------- *) + +let COLLINEAR_TRANSLATION_EQ = prove + (`!a s. collinear (IMAGE (\x. a + x) s) <=> collinear s`, + REWRITE_TAC[collinear] THEN GEOM_TRANSLATE_TAC["u"]);; + +add_translation_invariants [COLLINEAR_TRANSLATION_EQ];; + +let COLLINEAR_TRANSLATION = prove + (`!s a. collinear s ==> collinear (IMAGE (\x. a + x) s)`, + REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);; + +let COLLINEAR_LINEAR_IMAGE = prove + (`!f s. collinear s /\ linear f ==> collinear(IMAGE f s)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[collinear; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[LINEAR_SUB; LINEAR_CMUL]);; + +let COLLINEAR_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (collinear (IMAGE f s) <=> collinear s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COLLINEAR_LINEAR_IMAGE));; + +add_linear_invariants [COLLINEAR_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Take a theorem "th" with outer universal quantifiers involving real^N *) +(* and a theorem "dth" asserting |- dimindex(:M) <= dimindex(:N) and *) +(* return a theorem replacing type :N by :M in th. Neither N or M need be a *) +(* type variable. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_DROP_DIMENSION_RULE = + let oth = prove + (`!f:real^M->real^N. + linear f /\ (!x. norm(f x) = norm x) + ==> linear f /\ + (!x y. f x = f y ==> x = y) /\ + (!x. norm(f x) = norm x)`, + MESON_TAC[PRESERVES_NORM_INJECTIVE]) + and cth = prove + (`linear(f:real^M->real^N) + ==> vec 0 = f(vec 0) /\ + {} = IMAGE f {} /\ + {} = IMAGE (IMAGE f) {} /\ + [] = MAP f []`, + REWRITE_TAC[IMAGE_CLAUSES; MAP; GSYM LINEAR_0]) in + fun dth th -> + let ath = GEN_ALL th + and eth = MATCH_MP ISOMETRY_UNIV_UNIV dth + and avoid = variables(concl th) in + let f,bod = dest_exists(concl eth) in + let fimage = list_mk_icomb "IMAGE" [f] + and fmap = list_mk_icomb "MAP" [f] + and fcompose = list_mk_icomb "o" [f] in + let fimage2 = list_mk_icomb "IMAGE" [fimage] in + let lin,iso = CONJ_PAIR(ASSUME bod) in + let olduniv = rand(rand(concl dth)) + and newuniv = rand(lhand(concl dth)) in + let oldty = fst(dest_fun_ty(type_of olduniv)) + and newty = fst(dest_fun_ty(type_of newuniv)) in + let newvar v = + let n,t = dest_var v in + variant avoid (mk_var(n,tysubst[newty,oldty] t)) in + let newterm v = + try let v' = newvar v in + tryfind (fun f -> mk_comb(f,v')) [f;fimage;fmap;fcompose;fimage2] + with Failure _ -> v in + let specrule th = + let v = fst(dest_forall(concl th)) in SPEC (newterm v) th in + let sth = SUBS(CONJUNCTS(MATCH_MP cth lin)) ath in + let fth = SUBS[SYM(MATCH_MP LINEAR_0 lin)] (repeat specrule sth) in + let thps = CONJUNCTS(MATCH_MP oth (ASSUME bod)) in + let th5 = LINEAR_INVARIANTS f thps in + let th6 = GEN_REWRITE_RULE REDEPTH_CONV [th5] fth in + let th7 = PROVE_HYP eth (SIMPLE_CHOOSE f th6) in + GENL (map newvar (fst(strip_forall(concl ath)))) th7;; + +(* ------------------------------------------------------------------------- *) +(* Transfer theorems automatically between same-dimension spaces. *) +(* Given dth = A |- dimindex(:M) = dimindex(:N) *) +(* and a theorem th involving variables of type real^N *) +(* returns a corresponding theorem mapped to type real^M with assumptions A. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_EQUAL_DIMENSION_RULE = + let bth = prove + (`dimindex(:M) = dimindex(:N) + ==> ?f:real^M->real^N. + (linear f /\ (!y. ?x. f x = y)) /\ + (!x. norm(f x) = norm x)`, + REWRITE_TAC[SET_RULE `(!y. ?x. f x = y) <=> IMAGE f UNIV = UNIV`] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC ISOMETRY_UNIV_SUBSPACE THEN + REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV] THEN FIRST_ASSUM ACCEPT_TAC) + and pth = prove + (`!f:real^M->real^N. + linear f /\ (!y. ?x. f x = y) + ==> (vec 0 = f(vec 0) /\ + {} = IMAGE f {} /\ + {} = IMAGE (IMAGE f) {} /\ + (:real^N) = IMAGE f (:real^M) /\ + (:real^N->bool) = IMAGE (IMAGE f) (:real^M->bool) /\ + [] = MAP f []) /\ + ((!P. (!x. P x) <=> (!x. P (f x))) /\ + (!P. (?x. P x) <=> (?x. P (f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE f s))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE f s))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE (IMAGE f) s))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE (IMAGE f) s))) /\ + (!P. (!g:real^1->real^N. P g) <=> (!g. P (f o g))) /\ + (!P. (?g:real^1->real^N. P g) <=> (?g. P (f o g))) /\ + (!P. (!g:num->real^N. P g) <=> (!g. P (f o g))) /\ + (!P. (?g:num->real^N. P g) <=> (?g. P (f o g))) /\ + (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\ + (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\ + ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\ + (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\ + (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`, + GEN_TAC THEN + SIMP_TAC[SET_RULE `UNIV = IMAGE f UNIV <=> (!y. ?x. f x = y)`; + SURJECTIVE_IMAGE] THEN + MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[QUANTIFY_SURJECTION_HIGHER_THM] THEN + REWRITE_TAC[IMAGE_CLAUSES; MAP] THEN MESON_TAC[LINEAR_0]) in + fun dth th -> + let eth = EXISTS_GENVAR_RULE (MATCH_MP bth dth) in + let f,bod = dest_exists(concl eth) in + let lsth,neth = CONJ_PAIR(ASSUME bod) in + let cth,qth = CONJ_PAIR(MATCH_MP pth lsth) in + let th1 = CONV_RULE + (EXPAND_QUANTS_CONV qth THENC SUBS_CONV(CONJUNCTS cth)) th in + let ith = LINEAR_INVARIANTS f (neth::CONJUNCTS lsth) in + let th2 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [BETA_THM;ith] th1 in + let th3 = GEN f (DISCH bod th2) in + MP (CONV_RULE (REWR_CONV LEFT_FORALL_IMP_THM) th3) eth;; diff --git a/Multivariate/dimension.ml b/Multivariate/dimension.ml new file mode 100644 index 0000000..c6fc727 --- /dev/null +++ b/Multivariate/dimension.ml @@ -0,0 +1,6794 @@ +(* ========================================================================= *) +(* Results connected with topological dimension. *) +(* *) +(* At the moment this is just Brouwer's fixpoint theorem. The proof is from *) +(* Kuhn: "some combinatorial lemmas in topology", IBM J. v4. (1960) p. 518 *) +(* See "http://www.research.ibm.com/journal/rd/045/ibmrd0405K.pdf". *) +(* *) +(* The script below is quite messy, but at least we avoid formalizing any *) +(* topological machinery; we don't even use barycentric subdivision; this is *) +(* the big advantage of Kuhn's proof over the usual Sperner's lemma one. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Multivariate/polytope.ml";; + +let BROUWER_COMPACTNESS_LEMMA = prove + (`!f:real^M->real^N s. + compact s /\ f continuous_on s /\ ~(?x. x IN s /\ (f x = vec 0)) + ==> ?d. &0 < d /\ !x. x IN s ==> d <= norm(f x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`norm o (f:real^M->real^N)`; `s:real^M->bool`] + CONTINUOUS_ATTAINS_INF) THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL + [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_ASSOC; CONTINUOUS_ON_LIFT_NORM] THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[NORM_POS_LT]);; + +let KUHN_LABELLING_LEMMA = prove + (`!f:real^N->real^N P Q. + (!x. P x ==> P (f x)) + ==> (!x. P x ==> (!i. Q i ==> &0 <= x$i /\ x$i <= &1)) + ==> ?l. (!x i. l x i <= 1) /\ + (!x i. P x /\ Q i /\ (x$i = &0) ==> (l x i = 0)) /\ + (!x i. P x /\ Q i /\ (x$i = &1) ==> (l x i = 1)) /\ + (!x i. P x /\ Q i /\ (l x i = 0) ==> x$i <= f(x)$i) /\ + (!x i. P x /\ Q i /\ (l x i = 1) ==> f(x)$i <= x$i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM; GSYM SKOLEM_THM] THEN + REWRITE_TAC[ARITH_RULE `n <= 1 <=> (n = 0) \/ (n = 1)`; + RIGHT_OR_DISTRIB; EXISTS_OR_THM; UNWIND_THM2; ARITH_EQ] THEN + MESON_TAC[REAL_ARITH + `!x y. &0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 + ==> ~(x = &1) /\ x <= y \/ ~(x = &0) /\ y <= x`]);; + +(* ------------------------------------------------------------------------- *) +(* The key "counting" observation, somewhat abstracted. *) +(* ------------------------------------------------------------------------- *) + +let KUHN_COUNTING_LEMMA = prove + (`!face:F->S->bool faces simplices comp comp' bnd. + FINITE faces /\ FINITE simplices /\ + (!f. f IN faces /\ bnd f + ==> (CARD {s | s IN simplices /\ face f s} = 1)) /\ + (!f. f IN faces /\ ~bnd f + ==> (CARD {s | s IN simplices /\ face f s} = 2)) /\ + (!s. s IN simplices /\ comp s + ==> (CARD {f | f IN faces /\ face f s /\ comp' f} = 1)) /\ + (!s. s IN simplices /\ ~comp s + ==> (CARD {f | f IN faces /\ face f s /\ comp' f} = 0) \/ + (CARD {f | f IN faces /\ face f s /\ comp' f} = 2)) + ==> ODD(CARD {f | f IN faces /\ comp' f /\ bnd f}) + ==> ODD(CARD {s | s IN simplices /\ comp s})`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum simplices + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) = + sum simplices + (\s. &(CARD {f | f IN {f | f IN faces /\ comp' f /\ bnd f} /\ + face f s})) + + sum simplices + (\s. &(CARD {f | f IN {f | f IN faces /\ comp' f /\ ~(bnd f)} /\ + face f s}))` + MP_TAC THENL + [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_EQ THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNION; NOT_IN_EMPTY] THEN + CONJ_TAC THEN GEN_TAC THEN CONV_TAC TAUT; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\s f. (face:F->S->bool) f s`; `simplices:S->bool`; + `{f:F | f IN faces /\ comp' f /\ bnd f}`; `1`] SUM_MULTICOUNT) THEN + MP_TAC(ISPECL + [`\s f. (face:F->S->bool) f s`; `simplices:S->bool`; + `{f:F | f IN faces /\ comp' f /\ ~(bnd f)}`; `2`] SUM_MULTICOUNT) THEN + REWRITE_TAC[] THEN + REPEAT(ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_RESTRICT] THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + SIMP_TAC[IN_ELIM_THM]; + DISCH_THEN SUBST1_TAC]) THEN + SUBGOAL_THEN + `sum simplices + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) = + sum {s | s IN simplices /\ comp s} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) + + sum {s | s IN simplices /\ ~(comp s)} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f}))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTER; IN_UNION] THEN + CONJ_TAC THEN GEN_TAC THEN CONV_TAC TAUT; + ALL_TAC] THEN + SUBGOAL_THEN + `sum {s | s IN simplices /\ comp s} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) = + sum {s | s IN simplices /\ comp s} (\s. &1)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + GEN_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + SIMP_TAC[IN_ELIM_THM]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum {s | s IN simplices /\ ~(comp s)} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) = + sum {s | s IN simplices /\ ~(comp s) /\ + (CARD {f | f IN faces /\ face f s /\ comp' f} = 0)} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) + + sum {s | s IN simplices /\ ~(comp s) /\ + (CARD {f | f IN faces /\ face f s /\ comp' f} = 2)} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f}))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_UNION_EQ THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION] THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[ARITH_RULE `~(2 = 0)`]; + ALL_TAC] THEN + X_GEN_TAC `s:S` THEN UNDISCH_TAC + `!s:S. s IN simplices /\ ~comp s + ==> (CARD {f:F | f IN faces /\ face f s /\ comp' f} = 0) \/ + (CARD {f | f IN faces /\ face f s /\ comp' f} = 2)` THEN + DISCH_THEN(MP_TAC o SPEC `s:S`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONV_TAC TAUT; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. sum {s | s IN simplices /\ ~(comp s) /\ + (CARD {f | f IN faces /\ face f s /\ comp' f} = n)} + (\s:S. &(CARD {f:F | f IN faces /\ face f s /\ comp' f})) = + sum {s | s IN simplices /\ ~(comp s) /\ + (CARD {f | f IN faces /\ face f s /\ comp' f} = n)} + (\s:S. &n)` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + SIMP_TAC[IN_ELIM_THM]; + ALL_TAC] THEN + REWRITE_TAC[SUM_0] THEN ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(MP_TAC o AP_TERM `ODD`) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH_ODD; ODD]);; + +(* ------------------------------------------------------------------------- *) +(* The odd/even result for faces of complete vertices, generalized. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_1_EXISTS = prove + (`!s. s HAS_SIZE 1 <=> ?!x. x IN s`, + REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[EXTENSION; IN_SING] THEN MESON_TAC[]);; + +let HAS_SIZE_2_EXISTS = prove + (`!s. s HAS_SIZE 2 <=> ?x y. ~(x = y) /\ !z. z IN s <=> (z = x) \/ (z = y)`, + REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let IMAGE_LEMMA_0 = prove + (`!f:A->B s n. + {a | a IN s /\ (IMAGE f (s DELETE a) = t DELETE b)} HAS_SIZE n + ==> {s' | ?a. a IN s /\ (s' = s DELETE a) /\ (IMAGE f s' = t DELETE b)} + HAS_SIZE n`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{s' | ?a. a IN s /\ (s' = s DELETE a) /\ (IMAGE f s' = t DELETE b)} = + IMAGE (\a. s DELETE a) + {a | a IN s /\ (IMAGE (f:A->B) (s DELETE a) = t DELETE b)}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DELETE] THEN MESON_TAC[]]);; + +let IMAGE_LEMMA_1 = prove + (`!f:A->B s t b. + FINITE s /\ FINITE t /\ (CARD s = CARD t) /\ + (IMAGE f s = t) /\ b IN t + ==> (CARD {s' | ?a. a IN s /\ (s' = s DELETE a) /\ + (IMAGE f s' = t DELETE b)} = 1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_CARD THEN + MATCH_MP_TAC IMAGE_LEMMA_0 THEN REWRITE_TAC[HAS_SIZE_1_EXISTS] THEN + SUBGOAL_THEN `!x y. x IN s /\ y IN s /\ ((f:A->B) x = f y) ==> (x = y)` + ASSUME_TAC THENL [ASM_MESON_TAC[IMAGE_IMP_INJECTIVE_GEN]; ALL_TAC] THEN + REWRITE_TAC[EXISTS_UNIQUE_THM; IN_ELIM_THM] THEN CONJ_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[IN_IMAGE] THENL + [DISCH_THEN(fun th -> MP_TAC(SPEC `b:B` th) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN ASM_MESON_TAC[]]);; + +let IMAGE_LEMMA_2 = prove + (`!f:A->B s t b. + FINITE s /\ FINITE t /\ (CARD s = CARD t) /\ + (IMAGE f s) SUBSET t /\ ~(IMAGE f s = t) /\ b IN t + ==> (CARD {s' | ?a. a IN s /\ (s' = s DELETE a) /\ + (IMAGE f s' = t DELETE b)} = 0) \/ + (CARD {s' | ?a. a IN s /\ (s' = s DELETE a) /\ + (IMAGE f s' = t DELETE b)} = 2)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC + `{a | a IN s /\ (IMAGE (f:A->B) (s DELETE a) = t DELETE b)} = {}` + THENL [DISJ1_TAC; DISJ2_TAC] THEN MATCH_MP_TAC HAS_SIZE_CARD THEN + MATCH_MP_TAC IMAGE_LEMMA_0 THEN + ASM_REWRITE_TAC[HAS_SIZE_0; HAS_SIZE_2_EXISTS] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a1:A` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `(f:A->B) a1 IN (t DELETE b)` ASSUME_TAC THENL + [REWRITE_TAC[IN_DELETE] THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE; INSERT_DELETE; IMAGE_CLAUSES]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `(f:A->B) a1`) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a2:A` THEN + REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x y. x IN (s DELETE a1) /\ y IN (s DELETE a1) /\ ((f:A->B) x = f y) + ==> (x = y)` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_IMP_INJECTIVE_GEN THEN EXISTS_TAC `t DELETE (b:B)` THEN + ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE]; + REWRITE_TAC[IN_DELETE] THEN DISCH_TAC] THEN + X_GEN_TAC `a:A` THEN ASM_CASES_TAC `a:A = a1` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(a:A) IN s` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `(f:A->B) a = f a1` THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[IN_DELETE]] THEN + FIRST_X_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM t]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `(f:A->B) a`); ALL_TAC] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combine this with the basic counting lemma. *) +(* ------------------------------------------------------------------------- *) + +let KUHN_COMPLETE_LEMMA = prove + (`!face:(A->bool)->(A->bool)->bool simplices rl bnd n. + FINITE simplices /\ + (!f s. face f s <=> ?a. a IN s /\ (f = s DELETE a)) /\ + (!s. s IN simplices ==> s HAS_SIZE (n + 2) /\ + (IMAGE rl s) SUBSET 0..n+1) /\ + (!f. f IN {f | ?s. s IN simplices /\ face f s} /\ bnd f + ==> (CARD {s | s IN simplices /\ face f s} = 1)) /\ + (!f. f IN {f | ?s. s IN simplices /\ face f s} /\ ~bnd f + ==> (CARD {s | s IN simplices /\ face f s} = 2)) + ==> ODD(CARD {f | f IN {f | ?s. s IN simplices /\ face f s} /\ + (IMAGE rl f = 0..n) /\ bnd f}) + ==> ODD(CARD {s | s IN simplices /\ (IMAGE rl s = 0..n+1)})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!P f:A->bool s. + s IN simplices + ==> (f IN {f | ?s. s IN simplices /\ (?a. a IN s /\ (f = s DELETE a))} /\ + (?a. a IN s /\ (f = s DELETE a)) /\ P f <=> + (?a. a IN s /\ (f = s DELETE a) /\ P f))` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `0..n = (0..n+1) DELETE (n+1)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_DELETE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC KUHN_COUNTING_LEMMA THEN + EXISTS_TAC `face:(A->bool)->(A->bool)->bool` THEN + REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN + ASM_SIMP_TAC[] THENL + [SUBGOAL_THEN + `{f:A->bool | ?s. s IN simplices /\ (?a. a IN s /\ (f = s DELETE a))} = + UNIONS (IMAGE (\s. {f | ?a. a IN s /\ (f = s DELETE a)}) simplices)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; UNIONS_IMAGE; IN_ELIM_THM]; ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `s:A->bool` THEN + DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{t:A->bool | t SUBSET s}` THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_POWERSET THEN ASM_MESON_TAC[HAS_SIZE]; + SIMP_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM; IN_DELETE]]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_LEMMA_1; + REPEAT STRIP_TAC THEN MATCH_MP_TAC IMAGE_LEMMA_2] THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LE_REFL] THEN + REWRITE_TAC[CARD_NUMSEG; ARITH_RULE `((n + 1) + 1) - 0 = n + 2`] THEN + ASM_MESON_TAC[HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* We use the following notion of ordering rather than pointwise indexing. *) +(* ------------------------------------------------------------------------- *) + +let kle = new_definition + `kle n x y <=> ?k. k SUBSET 1..n /\ + (!j. y(j) = x(j) + (if j IN k then 1 else 0))`;; + +let KLE_REFL = prove + (`!n x. kle n x x`, + REPEAT GEN_TAC THEN REWRITE_TAC[kle] THEN EXISTS_TAC `{}:num->bool` THEN + REWRITE_TAC[ADD_CLAUSES; NOT_IN_EMPTY; EMPTY_SUBSET]);; + +let KLE_ANTISYM = prove + (`!n x y. kle n x y /\ kle n y x <=> (x = y)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [REWRITE_TAC[kle]; MESON_TAC[KLE_REFL]] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[FUN_EQ_THM] THEN + MESON_TAC[ARITH_RULE `(x = (x + a) + b) ==> (x = x + a:num)`]);; + +let POINTWISE_MINIMAL,POINTWISE_MAXIMAL = (CONJ_PAIR o prove) + (`(!s:(num->num)->bool. + FINITE s + ==> ~(s = {}) /\ + (!x y. x IN s /\ y IN s + ==> (!j. x(j) <= y(j)) \/ (!j. y(j) <= x(j))) + ==> ?a. a IN s /\ !x. x IN s ==> !j. a(j) <= x(j)) /\ + (!s:(num->num)->bool. + FINITE s + ==> ~(s = {}) /\ + (!x y. x IN s /\ y IN s + ==> (!j. x(j) <= y(j)) \/ (!j. y(j) <= x(j))) + ==> ?a. a IN s /\ !x. x IN s ==> !j. x(j) <= a(j))`, + CONJ_TAC THEN + (MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_INSERT_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:num->num`; `s:(num->num)->bool`] THEN + ASM_CASES_TAC `s:(num->num)->bool = {}` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[IN_SING] THEN MESON_TAC[LE_REFL]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ANTS_TAC THENL [ASM_MESON_TAC[IN_INSERT]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num->num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:num->num`; `b:num->num`]) THEN + ASM_REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[LE_CASES; LE_TRANS]));; + +let KLE_IMP_POINTWISE = prove + (`!n x y. kle n x y ==> !j. x(j) <= y(j)`, + REWRITE_TAC[kle] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LE_ADD]);; + +let POINTWISE_ANTISYM = prove + (`!x y:num->num. (!j. x(j) <= y(j)) /\ (!j. y(j) <= x(j)) <=> (x = y)`, + REWRITE_TAC[AND_FORALL_THM; FUN_EQ_THM; LE_ANTISYM]);; + +let KLE_TRANS = prove + (`!x y z n. kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) + ==> kle n x z`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `x:num->num = z` (fun th -> REWRITE_TAC[KLE_REFL; th]) THEN + REWRITE_TAC[FUN_EQ_THM; GSYM LE_ANTISYM; FORALL_AND_THM] THEN + ASM_MESON_TAC[KLE_IMP_POINTWISE; LE_TRANS]);; + +let KLE_STRICT = prove + (`!n x y. kle n x y /\ ~(x = y) + ==> (!j. x(j) <= y(j)) /\ (?k. 1 <= k /\ k <= n /\ x(k) < y(k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[kle] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num->bool` MP_TAC) THEN + ASM_CASES_TAC `k:num->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; ADD_CLAUSES; GSYM FUN_EQ_THM; ETA_AX]; + STRIP_TAC THEN ASM_REWRITE_TAC[LE_ADD] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `n < n + 1`] THEN + ASM_MESON_TAC[SUBSET; IN_NUMSEG]]);; + +let KLE_MINIMAL = prove + (`!s n. FINITE s /\ ~(s = {}) /\ + (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x) + ==> ?a. a IN s /\ !x. x IN s ==> kle n a x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?a:num->num. a IN s /\ !x. x IN s ==> !j. a(j) <= x(j)` + MP_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] POINTWISE_MINIMAL); ALL_TAC] THEN + ASM_MESON_TAC[POINTWISE_ANTISYM; KLE_IMP_POINTWISE]);; + +let KLE_MAXIMAL = prove + (`!s n. FINITE s /\ ~(s = {}) /\ + (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x) + ==> ?a. a IN s /\ !x. x IN s ==> kle n x a`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?a:num->num. a IN s /\ !x. x IN s ==> !j. x(j) <= a(j)` + MP_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] POINTWISE_MAXIMAL); ALL_TAC] THEN + ASM_MESON_TAC[POINTWISE_ANTISYM; KLE_IMP_POINTWISE]);; + +let KLE_STRICT_SET = prove + (`!n x y. kle n x y /\ ~(x = y) ==> 1 <= CARD {k | k IN 1..n /\ x(k) < y(k)}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP KLE_STRICT) THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC o CONJUNCT2) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD {i:num}` THEN CONJ_TAC THENL + [SIMP_TAC[CARD_CLAUSES; FINITE_RULES; ARITH; NOT_IN_EMPTY]; + MATCH_MP_TAC CARD_SUBSET THEN SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN + SIMP_TAC[IN_ELIM_THM; IN_NUMSEG; SUBSET; IN_SING] THEN ASM_MESON_TAC[]]);; + +let KLE_RANGE_COMBINE = prove + (`!n x y m1 m2. + kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) /\ + m1 <= CARD {k | k IN 1..n /\ x(k) < y(k)} /\ + m2 <= CARD {k | k IN 1..n /\ y(k) < z(k)} + ==> kle n x z /\ m1 + m2 <= CARD {k | k IN 1..n /\ x(k) < z(k)}`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[KLE_TRANS]; DISCH_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD {k | k IN 1..n /\ x(k):num < y(k)} + + CARD {k | k IN 1..n /\ y(k) < z(k)}` THEN + ASM_SIMP_TAC[LE_ADD2] THEN MATCH_MP_TAC EQ_IMP_LE THEN + MATCH_MP_TAC CARD_UNION_EQ THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_UNION; NOT_IN_EMPTY] THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[KLE_IMP_POINTWISE; ARITH_RULE + `x <= y:num /\ y <= z ==> (x < y \/ y < z <=> x < z)`]] THEN + X_GEN_TAC `i:num` THEN UNDISCH_TAC `kle n x z` THEN + REWRITE_TAC[kle] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i IN 1..n` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE `d <= 1 ==> ~(a < x /\ x < a + d)`) THEN + COND_CASES_TAC THEN REWRITE_TAC[ARITH]);; + +let KLE_RANGE_COMBINE_L = prove + (`!n x y m. + kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) /\ + m <= CARD {k | k IN 1..n /\ y(k) < z(k)} + ==> kle n x z /\ m <= CARD {k | k IN 1..n /\ x(k) < z(k)}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:num->num = y` THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `kle n x z /\ 1 + m <= CARD {k | k IN 1 .. n /\ x k < z k}` + (fun th -> MESON_TAC[th; ARITH_RULE `1 + m <= x ==> m <= x`]) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `y:num->num` THEN + ASM_SIMP_TAC[KLE_STRICT_SET]);; + +let KLE_RANGE_COMBINE_R = prove + (`!n x y m. + kle n x y /\ kle n y z /\ (kle n x z \/ kle n z x) /\ + m <= CARD {k | k IN 1..n /\ x(k) < y(k)} + ==> kle n x z /\ m <= CARD {k | k IN 1..n /\ x(k) < z(k)}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `y:num->num = z` THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `kle n x z /\ m + 1 <= CARD {k | k IN 1 .. n /\ x k < z k}` + (fun th -> MESON_TAC[th; ARITH_RULE `m + 1 <= x ==> m <= x`]) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `y:num->num` THEN + ASM_SIMP_TAC[KLE_STRICT_SET]);; + +let KLE_RANGE_INDUCT = prove + (`!n m s. s HAS_SIZE (SUC m) + ==> (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x) + ==> ?x y. x IN s /\ y IN s /\ kle n x y /\ + m <= CARD {k | k IN 1..n /\ x(k) < y(k)}`, + GEN_TAC THEN INDUCT_TAC THENL + [GEN_TAC THEN REWRITE_TAC[ARITH; LE_0] THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN MESON_TAC[IN_SING; KLE_REFL]; + ALL_TAC] THEN + X_GEN_TAC `s:(num->num)->bool` THEN + ONCE_REWRITE_TAC[HAS_SIZE_SUC] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:(num->num)->bool`; `n:num`] KLE_MINIMAL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE_SUC; HAS_SIZE]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->num` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:num->num)`) THEN + REPEAT(ANTS_TAC THENL [ASM_MESON_TAC[IN_DELETE]; ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->num` MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN + REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `SUC m = 1 + m`] THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `x:num->num` THEN + ASM_SIMP_TAC[KLE_STRICT_SET]);; + +let KLE_SUC = prove + (`!n x y. kle n x y ==> kle (n + 1) x y`, + REPEAT GEN_TAC THEN REWRITE_TAC[kle] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_NUMSEG] THEN + MESON_TAC[ARITH_RULE `k <= n ==> k <= n + 1`]);; + +let KLE_TRANS_1 = prove + (`!n x y. kle n x y ==> !j. x j <= y j /\ y j <= x j + 1`, + SIMP_TAC[kle; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ARITH_TAC);; + +let KLE_TRANS_2 = prove + (`!a b c. kle n a b /\ kle n b c /\ (!j. c j <= a j + 1) + ==> kle n a c`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[kle] THEN + DISCH_THEN(X_CHOOSE_THEN `kk1:num->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `kk2:num->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + EXISTS_TAC `(kk1:num->bool) UNION kk2` THEN MP_TAC th) THEN + ASM_REWRITE_TAC[UNION_SUBSET; IN_UNION] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `(i:num) IN kk1` THEN ASM_CASES_TAC `(i:num) IN kk2` THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let KLE_BETWEEN_R = prove + (`!a b c x. kle n a b /\ kle n b c /\ kle n a x /\ kle n c x + ==> kle n b x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC KLE_TRANS_2 THEN + EXISTS_TAC `c:num->num` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[KLE_TRANS_1; ARITH_RULE + `x <= c + 1 /\ c <= b ==> x <= b + 1`]);; + +let KLE_BETWEEN_L = prove + (`!a b c x. kle n a b /\ kle n b c /\ kle n x a /\ kle n x c + ==> kle n x b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC KLE_TRANS_2 THEN + EXISTS_TAC `a:num->num` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[KLE_TRANS_1; ARITH_RULE + `c <= x + 1 /\ b <= c ==> b <= x + 1`]);; + +let KLE_ADJACENT = prove + (`!a b x k. + 1 <= k /\ k <= n /\ (!j. b(j) = if j = k then a(j) + 1 else a(j)) /\ + kle n a x /\ kle n x b + ==> (x = a) \/ (x = b)`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; IMP_IMP; AND_FORALL_THM] THEN + ASM_CASES_TAC `(x:num->num) k = a k` THENL + [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th); + DISCH_THEN(fun th -> DISJ2_TAC THEN MP_TAC th)] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_ANTISYM] THEN + ASM_MESON_TAC[ARITH_RULE + `a <= x /\ x <= a + 1 /\ ~(x = a) ==> (x = a + 1)`]);; + +(* ------------------------------------------------------------------------- *) +(* Kuhn's notion of a simplex (my reformulation to avoid so much indexing). *) +(* ------------------------------------------------------------------------- *) + +let ksimplex = new_definition + `ksimplex p n s <=> + s HAS_SIZE (n + 1) /\ + (!x j. x IN s ==> x(j) <= p) /\ + (!x j. x IN s /\ ~(1 <= j /\ j <= n) ==> (x j = p)) /\ + (!x y. x IN s /\ y IN s ==> kle n x y \/ kle n y x)`;; + +let KSIMPLEX_EXTREMA = prove + (`!p n s. + ksimplex p n s + ==> ?a b. a IN s /\ b IN s /\ + (!x. x IN s ==> kle n a x /\ kle n x b) /\ + (!i. b(i) = if 1 <= i /\ i <= n then a(i) + 1 else a(i))`, + REPEAT GEN_TAC THEN REWRITE_TAC[ksimplex] THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; GSYM FUN_EQ_THM] THEN + REWRITE_TAC[ADD_CLAUSES; ETA_AX] THEN + CONV_TAC(LAND_CONV(LAND_CONV HAS_SIZE_CONV)) THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[IN_SING] THEN MESON_TAC[KLE_REFL]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:(num->num)->bool`; `n:num`] KLE_MINIMAL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE; HAS_SIZE_SUC; ADD1]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->num` THEN STRIP_TAC THEN + MP_TAC(SPECL [`s:(num->num)->bool`; `n:num`] KLE_MAXIMAL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE; HAS_SIZE_SUC; ADD1]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[] THEN + MP_TAC(SPECL [`n:num`; `n:num`; `s:(num->num)->bool`] KLE_RANGE_INDUCT) THEN + ASM_REWRITE_TAC[ADD1] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num->num` (X_CHOOSE_THEN `d:num->num` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `{k | k IN 1 .. n /\ a k :num < b k} = 1..n` MP_TAC THENL + [MATCH_MP_TAC CARD_SUBSET_LE THEN + ASM_REWRITE_TAC[CARD_NUMSEG; ADD_SUB; FINITE_NUMSEG; SUBSET_RESTRICT] THEN + SUBGOAL_THEN `kle n a b /\ n <= CARD {k | k IN 1..n /\ a(k) < b(k)}` + (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE_L THEN EXISTS_TAC `c:num->num` THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `kle n c b /\ n <= CARD {k | k IN 1 .. n /\ c k < b k}` + (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE_R THEN EXISTS_TAC `d:num->num` THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `kle n a b` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [kle]) THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN + ASM_MESON_TAC[SUBSET; IN_NUMSEG]);; + +let KSIMPLEX_EXTREMA_STRONG = prove + (`!p n s. + ksimplex p n s /\ ~(n = 0) + ==> ?a b. a IN s /\ b IN s /\ ~(a = b) /\ + (!x. x IN s ==> kle n a x /\ kle n x b) /\ + (!i. b(i) = if 1 <= i /\ i <= n then a(i) + 1 else a(i))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP KSIMPLEX_EXTREMA) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `1`) THEN + ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN ARITH_TAC);; + +let KSIMPLEX_SUCCESSOR = prove + (`!a p n s. + ksimplex p n s /\ a IN s + ==> (!x. x IN s ==> kle n x a) \/ + (?y. y IN s /\ ?k. 1 <= k /\ k <= n /\ + !j. y(j) = if j = k then a(j) + 1 else a(j))`, + REWRITE_TAC[ksimplex] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[TAUT `a \/ b <=> ~a ==> b`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_TAC THEN + MP_TAC(SPECL [`{x | x IN s /\ ~kle n x a}`; `n:num`] KLE_MINIMAL) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `1 <= CARD {k | k IN 1..n /\ a(k):num < b(k)}` MP_TAC THENL + [MATCH_MP_TAC KLE_STRICT_SET THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (ARITH_RULE + `1 <= n ==> (n = 1) \/ 2 <= n`)) + THENL + [DISCH_TAC THEN + MP_TAC(HAS_SIZE_CONV `{k | k IN 1 .. n /\ a k :num < b k} HAS_SIZE 1`) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_NUMSEG] THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + SUBGOAL_THEN `kle n a b` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [kle]) THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN + ASM_MESON_TAC[SUBSET; IN_NUMSEG; ARITH_RULE `~(a + 1 = a)`; + ARITH_RULE `a < a + 1`]; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ ~(kle n x a)})`; + `{x | x IN s /\ ~(kle n x a)}`] KLE_RANGE_INDUCT) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY; + ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN + REPEAT(ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num->num` + (X_CHOOSE_THEN `d:num->num` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 + (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN + DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ kle n x a})`; + `{x | x IN s /\ kle n x a}`] KLE_RANGE_INDUCT) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY; + ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN + REPEAT(ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[KLE_REFL]; ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `e:num->num` + (X_CHOOSE_THEN `f:num->num` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 + (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `kle n e d /\ n + 1 <= CARD {k | k IN 1..n /\ e(k) < d(k)}` + MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[ARITH_RULE `~(n + 1 <= x) <=> x <= n`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(1..n)` THEN + SIMP_TAC[CARD_SUBSET; SUBSET_RESTRICT; FINITE_RESTRICT; FINITE_NUMSEG] THEN + REWRITE_TAC[CARD_NUMSEG; ADD_SUB; LE_REFL]] THEN + SUBGOAL_THEN + `(CARD {x | x IN s /\ kle n x a} - 1) + + 2 + (CARD {x | x IN s /\ ~kle n x a} - 1) = n + 1` + (SUBST1_TAC o SYM) + THENL + [MATCH_MP_TAC(ARITH_RULE + `~(a = 0) /\ ~(b = 0) /\ (a + b = n + 1) + ==> ((a - 1) + 2 + (b - 1) = n + 1)`) THEN + ASM_SIMP_TAC[CARD_EQ_0; FINITE_RESTRICT; GSYM MEMBER_NOT_EMPTY] THEN + REPEAT (CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o CONJUNCT2) THEN + MATCH_MP_TAC CARD_UNION_EQ THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `a:num->num` THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN CONJ_TAC THENL + [W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n e a`,w)) + (fun th -> REWRITE_TAC[th])) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE_R THEN EXISTS_TAC `f:num->num` THEN + ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`]; + ALL_TAC] THEN + W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n a d`,w)) + (fun th -> REWRITE_TAC[th])) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `b:num->num` THEN + ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n b d`,w)) + (fun th -> REWRITE_TAC[th])) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE_L THEN EXISTS_TAC `c:num->num` THEN + ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN ASM_MESON_TAC[KLE_TRANS]);; + +let KSIMPLEX_PREDECESSOR = prove + (`!a p n s. + ksimplex p n s /\ a IN s + ==> (!x. x IN s ==> kle n a x) \/ + (?y. y IN s /\ ?k. 1 <= k /\ k <= n /\ + !j. a(j) = if j = k then y(j) + 1 else y(j))`, + REWRITE_TAC[ksimplex] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[TAUT `a \/ b <=> ~a ==> b`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN DISCH_TAC THEN + MP_TAC(SPECL [`{x | x IN s /\ ~kle n a x}`; `n:num`] KLE_MAXIMAL) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `1 <= CARD {k | k IN 1..n /\ b(k):num < a(k)}` MP_TAC THENL + [MATCH_MP_TAC KLE_STRICT_SET THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (ARITH_RULE + `1 <= n ==> (n = 1) \/ 2 <= n`)) + THENL + [DISCH_TAC THEN + MP_TAC(HAS_SIZE_CONV `{k | k IN 1 .. n /\ b k :num < a k} HAS_SIZE 1`) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; FINITE_NUMSEG] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_NUMSEG] THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + SUBGOAL_THEN `kle n b a` MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [kle]) THEN + ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_REFL] THEN + ASM_MESON_TAC[SUBSET; IN_NUMSEG; ARITH_RULE `~(a + 1 = a)`; + ARITH_RULE `a < a + 1`]; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ ~(kle n a x)})`; + `{x | x IN s /\ ~(kle n a x)}`] KLE_RANGE_INDUCT) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY; + ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN + REPEAT(ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->num` + (X_CHOOSE_THEN `c:num->num` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 + (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN + DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `PRE(CARD {x | x IN s /\ kle n a x})`; + `{x | x IN s /\ kle n a x}`] KLE_RANGE_INDUCT) THEN + ASM_SIMP_TAC[HAS_SIZE; FINITE_RESTRICT; CARD_EQ_0; GSYM MEMBER_NOT_EMPTY; + ARITH_RULE `(n = SUC(PRE n)) <=> ~(n = 0)`] THEN + REPEAT(ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[KLE_REFL]; ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->num` + (X_CHOOSE_THEN `e:num->num` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 + (STRIP_ASSUME_TAC o REWRITE_RULE[IN_ELIM_THM]) MP_TAC)) THEN + DISCH_TAC THEN + SUBGOAL_THEN `kle n d e /\ n + 1 <= CARD {k | k IN 1..n /\ d(k) < e(k)}` + MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[ARITH_RULE `~(n + 1 <= x) <=> x <= n`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(1..n)` THEN + SIMP_TAC[CARD_SUBSET; SUBSET_RESTRICT; FINITE_RESTRICT; FINITE_NUMSEG] THEN + REWRITE_TAC[CARD_NUMSEG; ADD_SUB; LE_REFL]] THEN + SUBGOAL_THEN + `((CARD {x | x IN s /\ ~kle n a x} - 1) + 2) + + (CARD {x | x IN s /\ kle n a x} - 1) = n + 1` + (SUBST1_TAC o SYM) + THENL + [MATCH_MP_TAC(ARITH_RULE + `~(a = 0) /\ ~(b = 0) /\ (a + b = n + 1) + ==> (((b - 1) + 2) + (a - 1) = n + 1)`) THEN + ASM_SIMP_TAC[CARD_EQ_0; FINITE_RESTRICT; GSYM MEMBER_NOT_EMPTY] THEN + REPEAT (CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o CONJUNCT2) THEN + MATCH_MP_TAC CARD_UNION_EQ THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `a:num->num` THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN CONJ_TAC THENL + [ALL_TAC; + W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n a e`,w)) + (fun th -> REWRITE_TAC[th])) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE_L THEN EXISTS_TAC `f:num->num` THEN + ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`]] THEN + W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n d a`,w)) + (fun th -> REWRITE_TAC[th])) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE THEN EXISTS_TAC `b:num->num` THEN + ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_TRANS]; ALL_TAC] THEN + W(fun(asl,w) -> SUBGOAL_THEN(mk_conj(`kle n d b`,w)) + (fun th -> REWRITE_TAC[th])) THEN + MATCH_MP_TAC KLE_RANGE_COMBINE_R THEN EXISTS_TAC `c:num->num` THEN + ASM_REWRITE_TAC[ARITH_RULE `k - 1 = PRE k`] THEN ASM_MESON_TAC[KLE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* The lemmas about simplices that we need. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_SIMPLICES = prove + (`!p n. FINITE {s | ksimplex p n s}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{s | s SUBSET {f | (!i. i IN 1..n ==> f(i) IN 0..p) /\ + (!i. ~(i IN 1..n) ==> (f(i) = p))}}` THEN + ASM_SIMP_TAC[FINITE_POWERSET; FINITE_FUNSPACE; FINITE_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; ksimplex] THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_0]);; + +let SIMPLEX_TOP_FACE = prove + (`0 < p /\ + (!x. x IN f ==> (x(n + 1) = p)) + ==> ((?s a. ksimplex p (n + 1) s /\ a IN s /\ (f = s DELETE a)) <=> + ksimplex p n f)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[ksimplex; LEFT_IMP_EXISTS_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_DELETE] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `(s:(num->num)->bool) HAS_SIZE ((n + 1) + 1)` THEN + SIMP_TAC[HAS_SIZE; CARD_DELETE; FINITE_DELETE] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ARITH_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN X_GEN_TAC `j:num` THEN + ONCE_REWRITE_TAC[ARITH_RULE + `(1 <= j /\ j <= n) <=> (1 <= j /\ j <= n + 1) /\ ~(j = (n + 1))`] THEN + ASM_MESON_TAC[IN_DELETE]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `kle (n + 1) x y \/ kle (n + 1) y x` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN + (REWRITE_TAC[kle] THEN + MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[GSYM ADD1; NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`] THEN + X_GEN_TAC `k:num->bool` THEN SIMP_TAC[] THEN + REWRITE_TAC[SUBSET; IN_INSERT] THEN + ASM_CASES_TAC `(SUC n) IN k` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + DISCH_THEN(MP_TAC o SPEC `n + 1` o CONJUNCT2) THEN + ASM_REWRITE_TAC[GSYM ADD1] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC(ARITH_RULE `(x = p) /\ (y = p) ==> ~(x = SUC y)`) THEN + CONJ_TAC THEN ASM_MESON_TAC[ADD1; IN_DELETE])]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP KSIMPLEX_EXTREMA) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->num` (X_CHOOSE_THEN `b:num->num` + STRIP_ASSUME_TAC)) THEN + ABBREV_TAC `c = \i. if i = (n + 1) then p - 1 else a(i)` THEN + MAP_EVERY EXISTS_TAC [`(c:num->num) INSERT f`; `c:num->num`] THEN + REWRITE_TAC[IN_INSERT; DELETE_INSERT] THEN + SUBGOAL_THEN `~((c:num->num) IN f)` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `!x:num->num. x IN f ==> (x (n + 1) = p)` THEN + DISCH_THEN(MP_TAC o SPEC `c:num->num`) THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "c" THEN REWRITE_TAC[] THEN UNDISCH_TAC `0 < p` THEN ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; UNDISCH_TAC `~((c:num->num) IN f)` THEN SET_TAC[]] THEN + UNDISCH_TAC `ksimplex p n f` THEN REWRITE_TAC[ksimplex] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN ASM_REWRITE_TAC[ADD1]; + EXPAND_TAC "c" THEN REWRITE_TAC[IN_INSERT] THEN + SIMP_TAC[TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + ASM_MESON_TAC[ARITH_RULE `p - 1 <= p`]; + EXPAND_TAC "c" THEN REWRITE_TAC[IN_INSERT; TAUT + `(a \/ b) /\ c ==> d <=> (a /\ c ==> d) /\ (b /\ c ==> d)`] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN CONJ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC MP_TAC); ALL_TAC] THEN + ASM_MESON_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`; + ARITH_RULE `j <= n ==> j <= n + 1`]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[IN_INSERT] THEN + SUBGOAL_THEN `!x. x IN f ==> kle (n + 1) c x` + (fun th -> ASM_MESON_TAC[th; KLE_SUC; KLE_REFL]) THEN + X_GEN_TAC `x:num->num` THEN DISCH_TAC THEN + SUBGOAL_THEN `kle (n + 1) a x` MP_TAC THENL + [ASM_MESON_TAC[KLE_SUC]; ALL_TAC] THEN + EXPAND_TAC "c" THEN REWRITE_TAC[kle] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(n + 1) INSERT k` THEN + ASM_REWRITE_TAC[INSERT_SUBSET; IN_NUMSEG] THEN + ASM_REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`] THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_INSERT] THEN + ASM_CASES_TAC `j = n + 1` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(n + 1 IN k)` + (fun th -> ASM_MESON_TAC[th; ARITH_RULE `0 < p ==> (p = (p - 1) + 1)`]) THEN + DISCH_TAC THEN UNDISCH_TAC `!x:num->num. x IN f ==> (x (n + 1) = p)` THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `x:num->num` th) THEN + MP_TAC(SPEC `a:num->num` th)) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[ARITH_RULE `~(p + 1 = p)`]);; + +let KSIMPLEX_FIX_PLANE = prove + (`!p q n j s a a0 a1. + ksimplex p n s /\ a IN s /\ + 1 <= j /\ j <= n /\ (!x. x IN (s DELETE a) ==> (x j = q)) /\ + a0 IN s /\ a1 IN s /\ + (!i. a1 i = (if 1 <= i /\ i <= n then a0 i + 1 else a0 i)) + ==> (a = a0) \/ (a = a1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~a /\ ~b ==> F) ==> a \/ b`) THEN STRIP_TAC THEN + UNDISCH_TAC `!x:num->num. x IN s DELETE a ==> (x j = q)` THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `a0:num->num` th) THEN MP_TAC(SPEC `a1:num->num` th)) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN ARITH_TAC);; + +let KSIMPLEX_FIX_PLANE_0 = prove + (`!p n j s a a0 a1. + ksimplex p n s /\ a IN s /\ + 1 <= j /\ j <= n /\ (!x. x IN (s DELETE a) ==> (x j = 0)) /\ + a0 IN s /\ a1 IN s /\ + (!i. a1 i = (if 1 <= i /\ i <= n then a0 i + 1 else a0 i)) + ==> (a = a1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(a = a0) \/ (a = a1:num->num)` MP_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN + MAP_EVERY EXISTS_TAC + [`p:num`; `0`; `n:num`; `j:num`; `s:(num->num)->bool`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `a0:num->num = a1` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~a ==> (a \/ b ==> b)`) THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a1:num->num`) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN ARITH_TAC);; + +let KSIMPLEX_FIX_PLANE_P = prove + (`!p n j s a a0 a1. + ksimplex p n s /\ a IN s /\ + 1 <= j /\ j <= n /\ (!x. x IN (s DELETE a) ==> (x j = p)) /\ + a0 IN s /\ a1 IN s /\ + (!i. a1 i = (if 1 <= i /\ i <= n then a0 i + 1 else a0 i)) + ==> (a = a0)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(a = a0) \/ (a = a1:num->num)` MP_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN + MAP_EVERY EXISTS_TAC + [`p:num`; `p:num`; `n:num`; `j:num`; `s:(num->num)->bool`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `a0:num->num = a1` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~b ==> (a \/ b ==> a)`) THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a0:num->num`) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ksimplex]) THEN + DISCH_THEN(MP_TAC o SPEC `a1:num->num` o CONJUNCT1 o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let KSIMPLEX_REPLACE_0 = prove + (`ksimplex p n s /\ a IN s /\ ~(n = 0) /\ + (?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = 0)) + ==> (CARD + {s' | ksimplex p n s' /\ ?b. b IN s' /\ (s' DELETE b = s DELETE a)} = + 1)`, + let lemma = prove + (`!a a'. (s' DELETE a' = s DELETE a) /\ (a' = a) /\ a' IN s' /\ a IN s + ==> (s' = s)`, + SET_TAC[]) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_CARD THEN + REWRITE_TAC[HAS_SIZE_1_EXISTS] THEN REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `!s' a'. ksimplex p n s' /\ a' IN s' /\ (s' DELETE a' = s DELETE a) + ==> (s' = s)` + (fun th -> ASM_MESON_TAC[th]) THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a0:num->num` (X_CHOOSE_THEN `a1:num->num` + STRIP_ASSUME_TAC)) THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b0:num->num` (X_CHOOSE_THEN `b1:num->num` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `a:num->num = a1` SUBST_ALL_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_0 THEN MAP_EVERY EXISTS_TAC + [`p:num`; `n:num`; `j:num`; `s:(num->num)->bool`; `a0:num->num`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `a':num->num = b1` SUBST_ALL_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_0 THEN MAP_EVERY EXISTS_TAC + [`p:num`; `n:num`; `j:num`; `s':(num->num)->bool`; `b0:num->num`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a1:num->num`; `b1:num->num`] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `b0:num->num = a0` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM KLE_ANTISYM] THEN ASM_MESON_TAC[IN_DELETE]; + ASM_REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]]);; + +let KSIMPLEX_REPLACE_1 = prove + (`ksimplex p n s /\ a IN s /\ ~(n = 0) /\ + (?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = p)) + ==> (CARD + {s' | ksimplex p n s' /\ ?b. b IN s' /\ (s' DELETE b = s DELETE a)} = + 1)`, + let lemma = prove + (`!a a'. (s' DELETE a' = s DELETE a) /\ (a' = a) /\ a' IN s' /\ a IN s + ==> (s' = s)`, + SET_TAC[]) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_SIZE_CARD THEN + REWRITE_TAC[HAS_SIZE_1_EXISTS] THEN REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `!s' a'. ksimplex p n s' /\ a' IN s' /\ (s' DELETE a' = s DELETE a) + ==> (s' = s)` + (fun th -> ASM_MESON_TAC[th]) THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a0:num->num` (X_CHOOSE_THEN `a1:num->num` + STRIP_ASSUME_TAC)) THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b0:num->num` (X_CHOOSE_THEN `b1:num->num` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `a:num->num = a0` SUBST_ALL_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_P THEN MAP_EVERY EXISTS_TAC + [`p:num`; `n:num`; `j:num`; `s:(num->num)->bool`; `a1:num->num`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `a':num->num = b0` SUBST_ALL_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE_P THEN MAP_EVERY EXISTS_TAC + [`p:num`; `n:num`; `j:num`; `s':(num->num)->bool`; `b1:num->num`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a0:num->num`; `b0:num->num`] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `b1:num->num = a1` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM KLE_ANTISYM] THEN ASM_MESON_TAC[IN_DELETE]; + ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[EQ_ADD_RCANCEL]]);; + +let KSIMPLEX_REPLACE_2 = prove + (`ksimplex p n s /\ a IN s /\ ~(n = 0) /\ + ~(?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = 0)) /\ + ~(?j. 1 <= j /\ j <= n /\ !x. x IN (s DELETE a) ==> (x j = p)) + ==> (CARD + {s' | ksimplex p n s' /\ ?b. b IN s' /\ (s' DELETE b = s DELETE a)} = + 2)`, + let lemma = prove + (`!a a'. (s' DELETE a' = s DELETE a) /\ (a' = a) /\ a' IN s' /\ a IN s + ==> (s' = s)`, + SET_TAC[]) + and lemma_1 = prove + (`a IN s /\ ~(b = a) ==> ~(s = b INSERT (s DELETE a))`, + SET_TAC[]) in + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a0:num->num` (X_CHOOSE_THEN `a1:num->num` + STRIP_ASSUME_TAC)) THEN + ASM_CASES_TAC `a:num->num = a0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(SPECL [`a0:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_SUCCESSOR) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `a1:num->num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP KLE_IMP_POINTWISE) THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; ARITH] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `a2:num->num` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `a3 = \j:num. if j = k then a1 j + 1 else a1 j` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + MATCH_MP_TAC HAS_SIZE_CARD THEN CONV_TAC HAS_SIZE_CONV THEN + MAP_EVERY EXISTS_TAC + [`s:(num->num)->bool`; `a3 INSERT (s DELETE (a0:num->num))`] THEN + SUBGOAL_THEN `~((a3:num->num) IN s)` ASSUME_TAC THENL + [DISCH_TAC THEN SUBGOAL_THEN `kle n a3 a1` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `k:num` o MATCH_MP KLE_IMP_POINTWISE) THEN + ASM_REWRITE_TAC[LE_REFL] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(a3:num->num = a0) /\ ~(a3 = a1)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(a2:num->num = a0)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[ARITH_RULE `~(x + 1 = x)`]; + ALL_TAC] THEN + CONJ_TAC THENL [MATCH_MP_TAC lemma_1 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x. x IN (s DELETE a0) ==> kle n a2 x` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN + SUBGOAL_THEN `kle n a2 x \/ kle n x a2` MP_TAC THENL + [ASM_MESON_TAC[ksimplex]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> b \/ a ==> b`) THEN + DISCH_TAC THEN SUBGOAL_THEN `kle n a0 x` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(x:num->num = a0) \/ (x = a2)` + (fun th -> ASM_MESON_TAC[KLE_REFL; th]) THEN + MATCH_MP_TAC KLE_ADJACENT THEN + EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ksimplex p n (a3 INSERT (s DELETE a0))` ASSUME_TAC THENL + [MP_TAC(ASSUME `ksimplex p n s`) THEN REWRITE_TAC[ksimplex] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES; + CARD_DELETE] THEN + ASM_REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + SUBGOAL_THEN `!j. (a3:num->num) j <= p` + (fun th -> ASM_MESON_TAC[th]) THEN + X_GEN_TAC `j:num` THEN ONCE_ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + UNDISCH_TAC + `~(?j. 1 <= j /\ j <= n /\ + (!x. x IN s DELETE a0 ==> (x j = (p:num))))` THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + REWRITE_TAC[ASSUME `1 <= k`; ASSUME `k:num <= n`; NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a4:num->num` MP_TAC) THEN + REWRITE_TAC[IN_DELETE; NOT_IMP] THEN STRIP_TAC THEN + UNDISCH_TAC `!x. x IN s DELETE a0 ==> kle n a2 x` THEN + DISCH_THEN(MP_TAC o SPEC `a4:num->num`) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(MP_TAC o MATCH_MP KLE_IMP_POINTWISE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~((a4:num->num) k = p)` THEN + SUBGOAL_THEN `(a4:num->num) k <= p` MP_TAC THENL + [ASM_MESON_TAC[ksimplex]; ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + ONCE_ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + SUBGOAL_THEN `!x. x IN s /\ ~(x = a0) ==> kle n x a3` + (fun th -> ASM_MESON_TAC[th; KLE_REFL]) THEN + X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN + SUBGOAL_THEN `kle n a2 x /\ kle n x a1` MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN + REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(MP_TAC o SPEC `k:num` o MATCH_MP KLE_IMP_POINTWISE) THEN + DISCH_TAC THEN REWRITE_TAC[kle] THEN + DISCH_THEN(X_CHOOSE_THEN `kk:num->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(k:num) INSERT kk` THEN + REWRITE_TAC[INSERT_SUBSET; IN_NUMSEG] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `j:num` THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `j:num = k` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `a2 <= x ==> !a0. x <= a1 /\ (a1 = a0 + 1) /\ (a2 = a0 + 1) + ==> (a1 + 1 = x + 1)`)) THEN + EXISTS_TAC `(a0:num->num) k` THEN + ASM_MESON_TAC[KLE_IMP_POINTWISE]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + X_GEN_TAC `s':(num->num)->bool` THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `a3:num->num` THEN + REWRITE_TAC[IN_INSERT; DELETE_INSERT] THEN + UNDISCH_TAC `~((a3:num->num) IN s)` THEN SET_TAC[]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a':num->num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a_min:num->num` (X_CHOOSE_THEN `a_max:num->num` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `(a':num->num = a_min) \/ (a' = a_max)` MP_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN MAP_EVERY EXISTS_TAC + [`p:num`; `(a2:num->num) k`; `n:num`; + `k:num`; `s':(num->num)->bool`] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN + X_GEN_TAC `x:num->num` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `kle n a2 x /\ kle n x a1` MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `k:num` o MATCH_MP + KLE_IMP_POINTWISE)) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [DISJ1_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a0:num->num`; `a_min:num->num`] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `a_max:num->num = a1` MP_TAC THENL + [SUBGOAL_THEN `a1:num->num IN (s' DELETE a_min) /\ + a_max:num->num IN (s DELETE a0)` + MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[EQ_ADD_RCANCEL]; + DISJ2_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a3:num->num`; `a_max:num->num`] THEN + ASM_REWRITE_TAC[IN_INSERT] THEN CONJ_TAC THENL + [UNDISCH_TAC `~(a3:num->num IN s)` THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `a_min:num->num = a2` MP_TAC THENL + [SUBGOAL_THEN `a2:num->num IN (s' DELETE a_max) /\ + a_min:num->num IN (s DELETE a0)` + MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[EQ_ADD_RCANCEL]]; + ALL_TAC] THEN + ASM_CASES_TAC `a:num->num = a1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(SPECL [`a1:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_PREDECESSOR) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `a0:num->num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP KLE_IMP_POINTWISE) THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; ARITH] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `a2:num->num` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!x. x IN (s DELETE a1) ==> kle n x a2` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN + SUBGOAL_THEN `kle n a2 x \/ kle n x a2` MP_TAC THENL + [ASM_MESON_TAC[ksimplex]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(~b ==> ~a) ==> a \/ b ==> b`) THEN + DISCH_TAC THEN SUBGOAL_THEN `kle n x a1` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(x:num->num = a2) \/ (x = a1)` + (fun th -> ASM_MESON_TAC[KLE_REFL; th]) THEN + MATCH_MP_TAC KLE_ADJACENT THEN EXISTS_TAC `k:num` THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(a2:num->num = a1)` ASSUME_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[ARITH_RULE `~(x + 1 = x)`]; + ALL_TAC] THEN + ABBREV_TAC `a3 = \j:num. if j = k then a0 j - 1 else a0 j` THEN + SUBGOAL_THEN `!j:num. a0(j) = if j = k then a3(j) + 1 else a3 j` + ASSUME_TAC THENL + [X_GEN_TAC `j:num` THEN EXPAND_TAC "a3" THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + REWRITE_TAC[ARITH_RULE `(a = a - 1 + 1) <=> ~(a = 0)`] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `(0 + 1 = x + 1) <=> (x = 0)`] THEN DISCH_TAC THEN + UNDISCH_TAC + `~(?j. 1 <= j /\ j <= n /\ (!x. x IN s DELETE a1 ==> (x j = 0)))` THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN EXISTS_TAC `k:num` THEN + ASM_MESON_TAC[KLE_IMP_POINTWISE; LE]; + ALL_TAC] THEN + SUBGOAL_THEN `~(kle n a0 a3)` ASSUME_TAC THENL + [ASM_MESON_TAC[KLE_IMP_POINTWISE; ARITH_RULE `~(a + 1 <= a)`]; + ALL_TAC] THEN + SUBGOAL_THEN `~(a3:num->num IN s)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `kle n a3 a2` ASSUME_TAC THENL + [SUBGOAL_THEN `kle n a0 a1` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[kle] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + ONCE_REWRITE_TAC[ + ASSUME `!j:num. a0 j = (if j = k then a3 j + 1 else a3 j)`; + ASSUME `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)`] THEN + REPEAT(COND_CASES_TAC THEN REWRITE_TAC[]) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `kle n a3 a0` ASSUME_TAC THENL + [REWRITE_TAC[kle] THEN EXISTS_TAC `{k:num}` THEN + ASM_REWRITE_TAC[SUBSET; IN_SING; IN_NUMSEG] THEN + ASM_MESON_TAC[ADD_CLAUSES]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_CARD THEN CONV_TAC HAS_SIZE_CONV THEN + MAP_EVERY EXISTS_TAC + [`s:(num->num)->bool`; `a3 INSERT (s DELETE (a1:num->num))`] THEN + SUBGOAL_THEN `~(a3:num->num = a1) /\ ~(a3 = a0)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [MATCH_MP_TAC lemma_1 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ksimplex p n (a3 INSERT (s DELETE a1))` ASSUME_TAC THENL + [MP_TAC(ASSUME `ksimplex p n s`) THEN REWRITE_TAC[ksimplex] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES; + CARD_DELETE] THEN + ASM_REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + SUBGOAL_THEN `!j. (a3:num->num) j <= p` + (fun th -> ASM_MESON_TAC[th]) THEN + X_GEN_TAC `j:num` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a0:num->num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + EXPAND_TAC "a3" THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + SUBGOAL_THEN `!x. x IN s /\ ~(x = a1) ==> kle n a3 x` + (fun th -> ASM_MESON_TAC[th; KLE_REFL]) THEN + X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN + MATCH_MP_TAC KLE_BETWEEN_L THEN + MAP_EVERY EXISTS_TAC [`a0:num->num`; `a2:num->num`] THEN + ASM_MESON_TAC[IN_DELETE]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + X_GEN_TAC `s':(num->num)->bool` THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `a3:num->num` THEN + REWRITE_TAC[IN_INSERT; DELETE_INSERT] THEN + UNDISCH_TAC `~((a3:num->num) IN s)` THEN SET_TAC[]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a':num->num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s':(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a_min:num->num` (X_CHOOSE_THEN `a_max:num->num` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `(a':num->num = a_min) \/ (a' = a_max)` MP_TAC THENL + [MATCH_MP_TAC KSIMPLEX_FIX_PLANE THEN MAP_EVERY EXISTS_TAC + [`p:num`; `(a2:num->num) k`; `n:num`; + `k:num`; `s':(num->num)->bool`] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN + X_GEN_TAC `x:num->num` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `kle n a0 x /\ kle n x a2` MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `k:num` o MATCH_MP + KLE_IMP_POINTWISE)) THEN + SUBGOAL_THEN `(a2:num->num) k <= a0 k` + (fun th -> MP_TAC th THEN ARITH_TAC) THEN + UNDISCH_TAC `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [DISJ2_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a3:num->num`; `a_min:num->num`] THEN + ASM_REWRITE_TAC[IN_INSERT] THEN CONJ_TAC THENL + [UNDISCH_TAC `~(a3:num->num IN s)` THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `a_max:num->num = a2` MP_TAC THENL + [SUBGOAL_THEN `a2:num->num IN (s' DELETE a_min) /\ + a_max:num->num IN (s DELETE a1)` + MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!j. a2 j = if 1 <= j /\ j <= n then a3 j + 1 else a3 j` + (fun th -> ASM_REWRITE_TAC[th; FUN_EQ_THM]) + THENL + [ALL_TAC; + MATCH_MP_TAC MONO_FORALL THEN MESON_TAC[EQ_ADD_RCANCEL]] THEN + UNDISCH_TAC `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[EQ_ADD_RCANCEL]; + DISJ1_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a1:num->num`; `a_max:num->num`] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_ASSUM ACCEPT_TAC) THEN + SUBGOAL_THEN `a_min:num->num = a0` MP_TAC THENL + [SUBGOAL_THEN `a0:num->num IN (s' DELETE a_max) /\ + a_min:num->num IN (s DELETE a1)` + MP_TAC THENL + [ASM_MESON_TAC[IN_DELETE]; ASM_MESON_TAC[KLE_ANTISYM; IN_DELETE]]; + ALL_TAC] THEN + UNDISCH_THEN `!j:num. a1 j = (if j = k then a2 j + 1 else a2 j)` + (K ALL_TAC) THEN + ASM_REWRITE_TAC[FUN_EQ_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[EQ_ADD_RCANCEL]]; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_PREDECESSOR) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[KLE_ANTISYM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:num->num` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`a:num->num`; `p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_SUCCESSOR) THEN + REWRITE_TAC[ASSUME `ksimplex p n s`; ASSUME `a:num->num IN s`] THEN + MATCH_MP_TAC(TAUT `~a /\ (b ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[KLE_ANTISYM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->num` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `a' = \j:num. if j = l then u(j) + 1 else u(j)` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN `~(k:num = l)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `!j:num. v j = (if j = l then a j + 1 else a j)` THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ksimplex]) THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`u:num->num`; `v:num->num`]) THEN + ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[kle] THEN + DISCH_THEN(DISJ_CASES_THEN (CHOOSE_THEN (MP_TAC o SPEC `l:num` o + CONJUNCT2))) THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(a':num->num = a)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~((a':num->num) IN s)` ASSUME_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ksimplex]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:num->num`; `a':num->num`] o + last o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN (MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THENL + [DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN + ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `kle n u a /\ kle n u a' /\ kle n a v /\ kle n a' v` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[kle] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `{k:num}`; + EXISTS_TAC `{l:num}`; + EXISTS_TAC `{l:num}`; + EXISTS_TAC `{k:num}`] THEN + ASM_REWRITE_TAC[IN_SING; SUBSET; IN_NUMSEG] THEN + ASM_MESON_TAC[ADD_CLAUSES]; + ALL_TAC] THEN + SUBGOAL_THEN `!x. kle n u x /\ kle n x v + ==> ((x = u) \/ (x = a) \/ (x = a') \/ (x = v))` + ASSUME_TAC THENL + [X_GEN_TAC `x:num->num` THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; IMP_IMP; AND_FORALL_THM] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + ASM_CASES_TAC `(x:num->num) k = u k` THEN + ASM_CASES_TAC `(x:num->num) l = u l` THENL + [DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th); + DISCH_THEN(fun th -> DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + MP_TAC th); + DISCH_THEN(fun th -> DISJ2_TAC THEN DISJ1_TAC THEN MP_TAC th); + DISCH_THEN(fun th -> REPEAT DISJ2_TAC THEN MP_TAC th)] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[LE_ANTISYM; + ARITH_RULE `x <= u + 1 /\ u <= x <=> (x = u) \/ (x = u + 1)`]); + ALL_TAC] THEN + SUBGOAL_THEN `kle n u v` ASSUME_TAC THENL + [ASM_MESON_TAC[KLE_TRANS; ksimplex]; ALL_TAC] THEN + SUBGOAL_THEN `ksimplex p n (a' INSERT (s DELETE a))` ASSUME_TAC THENL + [MP_TAC(ASSUME `ksimplex p n s`) THEN REWRITE_TAC[ksimplex] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SIMP_TAC[HAS_SIZE; FINITE_INSERT; FINITE_DELETE; CARD_CLAUSES; + CARD_DELETE; IN_DELETE] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> X_GEN_TAC `j:num` THEN MP_TAC th) THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `v:num->num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + REWRITE_TAC[TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c`] THEN + SIMP_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[EXISTS_REFL; LEFT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + SUBGOAL_THEN + `!x. x IN s /\ kle n v x ==> kle n a' x` + ASSUME_TAC THENL + [X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN + MATCH_MP_TAC KLE_BETWEEN_R THEN + MAP_EVERY EXISTS_TAC [`u:num->num`; `v:num->num`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ksimplex; KLE_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN s /\ kle n x u ==> kle n x a'` + ASSUME_TAC THENL + [X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN + MATCH_MP_TAC KLE_BETWEEN_L THEN + MAP_EVERY EXISTS_TAC [`u:num->num`; `v:num->num`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ksimplex; KLE_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN s /\ ~(x = a) ==> kle n a' x \/ kle n x a'` + (fun th -> MESON_TAC[th; KLE_REFL; ASSUME `(a:num->num) IN s`]) THEN + X_GEN_TAC `x:num->num` THEN STRIP_TAC THEN + ASM_CASES_TAC `kle n v x` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `kle n x u` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(x:num->num = u) \/ (x = a) \/ (x = a') \/ (x = v)` + (fun th -> ASM_MESON_TAC[th; KLE_REFL]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ksimplex]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_CARD THEN CONV_TAC HAS_SIZE_CONV THEN + MAP_EVERY EXISTS_TAC + [`s:(num->num)->bool`; `a' INSERT (s DELETE (a:num->num))`] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DELETE; IN_INSERT] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `s':(num->num)->bool` THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN EQ_TAC THENL + [ALL_TAC; + DISCH_THEN(DISJ_CASES_THEN SUBST1_TAC) THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `a':num->num` THEN + REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE] THEN ASM_MESON_TAC[]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a'':num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(a:num->num) IN s' \/ a' IN s'` MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN DISCH_TAC THEN + MP_TAC(ASSUME `s' DELETE a'' = s DELETE (a:num->num)`) THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC th) THENL + [DISCH_THEN(MP_TAC o SPEC `a:num->num`); + DISCH_THEN(MP_TAC o SPEC `a':num->num`)] THEN + REWRITE_TAC[IN_DELETE] THEN ASM_REWRITE_TAC[IN_INSERT; IN_DELETE] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `~(u:num->num = v)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(kle n v u)` ASSUME_TAC THENL + [ASM_MESON_TAC[KLE_ANTISYM]; ALL_TAC] THEN + SUBGOAL_THEN `~(u:num->num = a)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(v:num->num = a)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM] THEN DISCH_THEN(MP_TAC o SPEC `l:num`) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `u:num->num IN s' /\ v IN s'` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[EXTENSION; IN_DELETE]; ALL_TAC] THEN + ASM_CASES_TAC + `!x. x IN s' ==> kle n x u \/ kle n v x` + THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + DISCH_THEN(X_CHOOSE_THEN `w:num->num` MP_TAC) THEN + REWRITE_TAC[NOT_IMP; DE_MORGAN_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `(w:num->num = u) \/ (w = a) \/ (w = a') \/ (w = v)` + (fun th -> ASM_MESON_TAC[KLE_REFL; th]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[ksimplex]] THEN + MP_TAC(SPECL [`u:num->num`; `p:num`; `n:num`; `s':(num->num)->bool`] + KSIMPLEX_SUCCESSOR) THEN + ANTS_TAC THENL [ASM_MESON_TAC[EXTENSION; IN_DELETE]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN2 (MP_TAC o SPEC `v:num->num`) MP_TAC) THENL + [ASM_MESON_TAC[EXTENSION; IN_DELETE]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + UNDISCH_TAC `!x. x IN s' ==> kle n x u \/ kle n v x` THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `w:num->num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN(MP_TAC o MATCH_MP KLE_IMP_POINTWISE)) THEN + ASM_REWRITE_TAC[] THENL + [MESON_TAC[ARITH_RULE `~(i + 1 <= i)`]; ALL_TAC] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `k:num` th) THEN + MP_TAC(SPEC `l:num` th)) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN TRY ARITH_TAC THEN + UNDISCH_TAC `~(k:num = l)` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence another step towards concreteness. *) +(* ------------------------------------------------------------------------- *) + +let KUHN_SIMPLEX_LEMMA = prove + (`!p n. (!s. ksimplex p (n + 1) s ==> (IMAGE rl s SUBSET 0..n+1)) /\ + ODD(CARD{f | (?s a. ksimplex p (n + 1) s /\ + a IN s /\ + (f = s DELETE a)) /\ + (IMAGE rl f = 0 .. n) /\ + ((?j. 1 <= j /\ j <= n + 1 /\ + !x. x IN f ==> (x j = 0)) \/ + (?j. 1 <= j /\ j <= n + 1 /\ + !x. x IN f ==> (x j = p)))}) + ==> ODD(CARD {s | s IN {s | ksimplex p (n + 1) s} /\ + (IMAGE rl s = 0..n+1)})`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `ODD(CARD {f | f IN {f | ?s. s IN {s | ksimplex p (n + 1) s} /\ + (?a. a IN s /\ (f = s DELETE a))} /\ + (IMAGE rl f = 0..n) /\ + ((?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = 0)) \/ + (?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = p)))})` + MP_TAC THENL + [ASM_REWRITE_TAC[IN_ELIM_THM; RIGHT_AND_EXISTS_THM]; ALL_TAC] THEN + MATCH_MP_TAC KUHN_COMPLETE_LEMMA THEN REWRITE_TAC[FINITE_SIMPLICES] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[ksimplex; ARITH_RULE `(n + 1) + 1 = n + 2`]; + ASM_SIMP_TAC[]; + MATCH_MP_TAC KSIMPLEX_REPLACE_0; + MATCH_MP_TAC KSIMPLEX_REPLACE_1; + MATCH_MP_TAC KSIMPLEX_REPLACE_2] THEN + ASM_MESON_TAC[ARITH_RULE `~(n + 1 = 0)`]);; + +(* ------------------------------------------------------------------------- *) +(* Reduced labelling. *) +(* ------------------------------------------------------------------------- *) + +let reduced = new_definition + `reduced label n (x:num->num) = + @k. k <= n /\ + (!i. 1 <= i /\ i < k + 1 ==> (label x i = 0)) /\ + ((k = n) \/ ~(label x (k + 1) = 0))`;; + +let REDUCED_LABELLING = prove + (`!label x n. + reduced label n x <= n /\ + (!i. 1 <= i /\ i < reduced label n x + 1 ==> (label x i = 0)) /\ + ((reduced label n x = n) \/ ~(label x (reduced label n x + 1) = 0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[reduced] THEN CONV_TAC SELECT_CONV THEN + MP_TAC(SPEC `\j. j <= n /\ ~(label (x:num->num) (j + 1) = 0) \/ (n = j)` + num_WOP) THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ (b ==> c) ==> (a <=> b) ==> c`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + ASM_CASES_TAC `k = n:num` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[LE_REFL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN + SIMP_TAC[LT_IMP_LE] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i < n + 1 ==> i - 1 < n`] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i < n + 1 ==> ~(n = i - 1)`] THEN + ASM_SIMP_TAC[SUB_ADD] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + ARITH_TAC);; + +let REDUCED_LABELLING_UNIQUE = prove + (`!label x n. + r <= n /\ + (!i. 1 <= i /\ i < r + 1 ==> (label x i = 0)) /\ + ((r = n) \/ ~(label x (r + 1) = 0)) + ==> (reduced label n x = r)`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC(SPECL + [`label:(num->num)->(num->num)`; `x:num->num`; `n:num`] + REDUCED_LABELLING) THEN + MATCH_MP_TAC(ARITH_RULE `~(a < b) /\ ~(b < a:num) ==> (a = b)`) THEN + ASM_MESON_TAC[ARITH_RULE `s < r:num /\ r <= n ==> ~(s = n)`; + ARITH_RULE `s < r ==> 1 <= s + 1 /\ s + 1 < r + 1`]);; + +let REDUCED_LABELLING_0 = prove + (`!label n x j. + 1 <= j /\ j <= n /\ (label x j = 0) + ==> ~(reduced label n x = j - 1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`label:(num->num)->num->num`; `x:num->num`; `n:num`] + REDUCED_LABELLING) THEN + ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `1 <= j /\ j <= n ==> ~(j - 1 = n)`]);; + +let REDUCED_LABELLING_1 = prove + (`!label n x j. + 1 <= j /\ j <= n /\ ~(label x j = 0) + ==> reduced label n x < j`, + REWRITE_TAC[GSYM NOT_LE] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`label:(num->num)->num->num`; `x:num->num`; `n:num`] + REDUCED_LABELLING) THEN + DISCH_THEN(MP_TAC o SPEC `j:num` o CONJUNCT1 o CONJUNCT2) THEN + ASM_REWRITE_TAC[ARITH_RULE `y < x + 1 <=> (y <= x)`]);; + +let REDUCED_LABELLING_SUC = prove + (`!lab n x. + ~(reduced lab (n + 1) x = n + 1) + ==> (reduced lab (n + 1) x = reduced lab n x)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REDUCED_LABELLING_UNIQUE THEN + ASM_MESON_TAC[REDUCED_LABELLING; ARITH_RULE + `x <= n + 1 /\ ~(x = n + 1) ==> x <= n`]);; + +let COMPLETE_FACE_TOP = prove + (`!lab f n. + (!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = 0) + ==> (lab x j = 0)) /\ + (!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = p) + ==> (lab x j = 1)) + ==> ((IMAGE (reduced lab (n + 1)) f = 0..n) /\ + ((?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = 0)) \/ + (?j. 1 <= j /\ j <= n + 1 /\ !x. x IN f ==> (x j = p))) <=> + (IMAGE (reduced lab (n + 1)) f = 0..n) /\ + (!x. x IN f ==> (x (n + 1) = p)))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[ARITH_RULE `1 <= n + 1`; LE_REFL]] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THENL + [DISCH_THEN(MP_TAC o SPEC `j - 1`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[IN_IMAGE; IN_NUMSEG; LE_0; NOT_EXISTS_THM; + ARITH_RULE `j <= n + 1 ==> j - 1 <= n`] THEN + ASM_MESON_TAC[REDUCED_LABELLING_0]; + DISCH_THEN(MP_TAC o SPEC `j:num`) THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0; NOT_LE] THEN + ASM_SIMP_TAC[ARITH_RULE `j <= n + 1 ==> ((j <= n) <=> ~(j = n + 1))`] THEN + ASM_MESON_TAC[REDUCED_LABELLING_1; ARITH_RULE `~(1 = 0)`; LT_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get just about the nice induction. *) +(* ------------------------------------------------------------------------- *) + +let KUHN_INDUCTION = prove + (`!p n. 0 < p /\ + (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n + 1 /\ (x j = 0) + ==> (lab x j = 0)) /\ + (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n + 1 /\ (x j = p) + ==> (lab x j = 1)) + ==> ODD(CARD {f | ksimplex p n f /\ + (IMAGE (reduced lab n) f = 0..n)}) + ==> ODD(CARD {s | ksimplex p (n + 1) s /\ + (IMAGE (reduced lab (n + 1)) s = 0..n+1)})`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IN_ELIM_THM] KUHN_SIMPLEX_LEMMA) THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG; LE_0] THEN + MESON_TAC[ARITH_RULE `x <= n ==> x <= n + 1`; REDUCED_LABELLING]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC) THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `f:(num->num)->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC + `(!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = 0) ==> (lab x j = 0)) /\ + (!x j. x IN f /\ 1 <= j /\ j <= n + 1 /\ (x j = p) ==> (lab x j = 1))` + THENL + [ALL_TAC; + MATCH_MP_TAC(TAUT `~a /\ ~b ==> (a /\ c <=> b /\ d)`) THEN + CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[CONTRAPOS_THM] THEN REWRITE_TAC[ksimplex] THEN + ASM_MESON_TAC[IN_DELETE]] THEN + ASM_SIMP_TAC[COMPLETE_FACE_TOP] THEN + ASM_CASES_TAC `!x. x IN f ==> (x(n + 1):num = p)` THENL + [ALL_TAC; + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[ksimplex] THEN + ASM_MESON_TAC[ARITH_RULE `~(n + 1 <= n)`]] THEN + ASM_SIMP_TAC[SIMPLEX_TOP_FACE] THEN + ASM_CASES_TAC `ksimplex p n f` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `x:num->num` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(x:num->num) IN f` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REDUCED_LABELLING_SUC THEN + MATCH_MP_TAC(ARITH_RULE `a:num < b ==> ~(a = b)`) THEN + MATCH_MP_TAC REDUCED_LABELLING_1 THEN + REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`] THEN + MATCH_MP_TAC(ARITH_RULE `(n = 1) ==> ~(n = 0)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[LE_REFL; ARITH_RULE `1 <= n + 1`] THEN + ASM_MESON_TAC[ksimplex]);; + +(* ------------------------------------------------------------------------- *) +(* And so we get the final combinatorial result. *) +(* ------------------------------------------------------------------------- *) + +let KSIMPLEX_0 = prove + (`ksimplex p 0 s <=> (s = {(\x. p)})`, + REWRITE_TAC[ksimplex; ADD_CLAUSES] THEN + CONV_TAC(LAND_CONV(LAND_CONV HAS_SIZE_CONV)) THEN + REWRITE_TAC[ARITH_RULE `1 <= j /\ j <= 0 <=> F`] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[IN_SING] THEN + SIMP_TAC[RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[KLE_REFL] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[AND_FORALL_THM; ARITH_RULE + `x <= y:num /\ (x = y) <=> (x = y)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + REWRITE_TAC[GSYM FUN_EQ_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[UNWIND_THM2]);; + +let REDUCE_LABELLING_0 = prove + (`!lab x. reduced lab 0 x = 0`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REDUCED_LABELLING_UNIQUE THEN + REWRITE_TAC[LE_REFL] THEN ARITH_TAC);; + +let KUHN_COMBINATORIAL = prove + (`!lab p n. + 0 < p /\ + (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n /\ (x j = 0) + ==> (lab x j = 0)) /\ + (!x j. (!j. x(j) <= p) /\ 1 <= j /\ j <= n /\ (x j = p) + ==> (lab x j = 1)) + ==> ODD(CARD {s | ksimplex p n s /\ + (IMAGE (reduced lab n) s = 0..n)})`, + GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `{s | ksimplex p 0 s /\ (IMAGE (reduced lab 0) s = 0 .. 0)} = + {{(\x. p)}}` + (fun th -> SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; + FINITE_RULES; th; ARITH]) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; KSIMPLEX_0; IN_SING] THEN + GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN + DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[NUMSEG_SING; EXTENSION; IN_SING; IN_IMAGE] THEN + REWRITE_TAC[REDUCE_LABELLING_0] THEN MESON_TAC[]; + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `j <= n ==> j <= SUC n`]; + ALL_TAC] THEN + REWRITE_TAC[ADD1] THEN MATCH_MP_TAC KUHN_INDUCTION THEN + ASM_REWRITE_TAC[GSYM ADD1]]);; + +let KUHN_LEMMA = prove + (`!n p label. + 0 < p /\ 0 < n /\ + (!x. (!i. 1 <= i /\ i <= n ==> x(i) <= p) + ==> !i. 1 <= i /\ i <= n ==> (label x i = 0) \/ (label x i = 1)) /\ + (!x. (!i. 1 <= i /\ i <= n ==> x(i) <= p) + ==> !i. 1 <= i /\ i <= n /\ (x i = 0) ==> (label x i = 0)) /\ + (!x. (!i. 1 <= i /\ i <= n ==> x(i) <= p) + ==> !i. 1 <= i /\ i <= n /\ (x i = p) ==> (label x i = 1)) + ==> ?q. (!i. 1 <= i /\ i <= n ==> q(i) < p) /\ + (!i. 1 <= i /\ i <= n + ==> ?r s. (!j. 1 <= j /\ j <= n + ==> q(j) <= r(j) /\ r(j) <= q(j) + 1) /\ + (!j. 1 <= j /\ j <= n + ==> q(j) <= s(j) /\ s(j) <= q(j) + 1) /\ + ~(label r i = label s i))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`label:(num->num)->num->num`; `p:num`; `n:num`] + KUHN_COMBINATORIAL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC + `{s | ksimplex p n s /\ (IMAGE (reduced label n) s = 0 .. n)} = {}` + THENL [ASM_REWRITE_TAC[CARD_CLAUSES; ARITH]; ALL_TAC] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `s:(num->num)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`p:num`; `n:num`; `s:(num->num)->bool`] + KSIMPLEX_EXTREMA_STRONG) THEN + ASM_REWRITE_TAC[GSYM LT_NZ] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:num->num` THEN + DISCH_THEN(X_CHOOSE_THEN `b:num->num` STRIP_ASSUME_TAC) THEN + CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `x + 1 <= y ==> x < y`) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(b:num->num) i` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[LE_REFL]; ALL_TAC] THEN + ASM_MESON_TAC[ksimplex]; + ALL_TAC] THEN + UNDISCH_TAC `IMAGE (reduced label n) s = 0 .. n` THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `i - 1` th) THEN MP_TAC(SPEC `i:num` th)) THEN + ASM_REWRITE_TAC[IN_NUMSEG; LE_0] THEN + DISCH_THEN(X_CHOOSE_THEN `u:num->num` (STRIP_ASSUME_TAC o GSYM)) THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> i - 1 <= n`] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->num` (STRIP_ASSUME_TAC o GSYM)) THEN + MAP_EVERY EXISTS_TAC [`u:num->num`; `v:num->num`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[KLE_IMP_POINTWISE]; ALL_TAC] THEN + MP_TAC(SPECL [`label:(num->num)->num->num`; `u:num->num`; `n:num`] + REDUCED_LABELLING) THEN + MP_TAC(SPECL [`label:(num->num)->num->num`; `v:num->num`; `n:num`] + REDUCED_LABELLING) THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n ==> ~(i - 1 = n)`] THEN + ASM_SIMP_TAC[SUB_ADD] THEN ASM_MESON_TAC[ARITH_RULE `i < i + 1`]);; + +(* ------------------------------------------------------------------------- *) +(* The main result for the unit cube. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_CUBE = prove + (`!f:real^N->real^N. + f continuous_on (interval [vec 0,vec 1]) /\ + IMAGE f (interval [vec 0,vec 1]) SUBSET (interval [vec 0,vec 1]) + ==> ?x. x IN interval[vec 0,vec 1] /\ (f x = x)`, + REPEAT STRIP_TAC THEN ABBREV_TAC `n = dimindex(:N)` THEN + SUBGOAL_THEN `1 <= n /\ 0 < n /\ ~(n = 0)` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "n" THEN REWRITE_TAC[DIMINDEX_NONZERO; DIMINDEX_GE_1] THEN + ASM_MESON_TAC[LT_NZ; DIMINDEX_NONZERO]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN + PURE_REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + DISCH_TAC THEN SUBGOAL_THEN + `?d. &0 < d /\ !x:real^N. x IN interval[vec 0,vec 1] ==> d <= norm(f x - x)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC BROUWER_COMPACTNESS_LEMMA THEN + ASM_SIMP_TAC[COMPACT_INTERVAL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + ASM_MESON_TAC[VECTOR_SUB_EQ]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + FREEZE_THEN(fun th -> DISCH_THEN(MP_TAC o MATCH_MP th)) + (SPEC `f:real^N->real^N` KUHN_LABELLING_LEMMA) THEN + DISCH_THEN(MP_TAC o SPEC `\i. 1 <= i /\ i <= n`) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[IN_INTERVAL; VEC_COMPONENT]; ALL_TAC] THEN + REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `label:real^N->num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!x y i. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\ + 1 <= i /\ i <= n /\ ~(label (x:real^N) i :num = label y i) + ==> abs((f(x) - x)$i) <= norm(f(y) - f(x)) + norm(y - x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(((f:real^N->real^N)(y) - f(x))$i) + abs((y - x)$i)` THEN + ASM_SIMP_TAC[REAL_LE_ADD2; COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REAL_ARITH + `!x y fx fy d. (x <= fx /\ fy <= y \/ fx <= x /\ y <= fy) + ==> abs(fx - x) <= abs(fy - fx) + abs(y - x)`) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `~(a = b) + ==> a <= 1 /\ b <= 1 ==> (a = 0) /\ (b = 1) \/ (a = 1) /\ (b = 0)`)) THEN + ASM_SIMP_TAC[] THEN STRIP_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !x y z i. x IN interval[vec 0,vec 1] /\ + y IN interval[vec 0,vec 1] /\ + z IN interval[vec 0,vec 1] /\ + 1 <= i /\ i <= n /\ + norm(x - z) < e /\ norm(y - z) < e /\ + ~(label (x:real^N) i :num = label y i) + ==> abs((f(z) - z)$i) < d / &n` + MP_TAC THENL + [SUBGOAL_THEN + `(f:real^N->real^N) uniformly_continuous_on interval[vec 0,vec 1]` + MP_TAC THENL + [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `d / &n / &8`) THEN + SUBGOAL_THEN `&0 < d / &n / &8` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LT_MULT; ARITH]; + ALL_TAC] THEN + ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (e / &2) (d / &n / &8)` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_LT_MIN; REAL_HALF] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `z:real^N`; `i:num`] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REAL_ARITH + `!x fx n1 n2 n3 n4 d4. + abs(fx - x) <= n1 + n2 /\ + abs(fx - fz) <= n3 /\ abs(x - z) <= n4 /\ + n1 < d4 /\ n2 < &2 * d4 /\ n3 < d4 /\ n4 < d4 /\ (&8 * d4 = d) + ==> abs(fz - z) < d`) THEN + MAP_EVERY EXISTS_TAC + [`(x:real^N)$i`; `(f:real^N->real^N)(x)$i`; + `norm((f:real^N->real^N) y - f x)`; `norm(y - x:real^N)`; + `norm((f:real^N->real^N) x - f z)`; + `norm(x - z:real^N)`; `d / &n / &8`] THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm(x - z:real^N) + norm(y - z)` THEN + ASM_SIMP_TAC[REAL_ARITH `a < e / &2 /\ b < e / &2 /\ + (&2 * (e / &2) = e) ==> a + b < e`; + REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE; DIST_SYM]; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm(x - z:real^N) + norm(y - z)` THEN + ASM_SIMP_TAC[REAL_ARITH `a < e /\ b < e ==> a + b < &2 * e`] THEN + REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE; DIST_SYM]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `a < e / &2 /\ &0 < e /\ (&2 * (e / &2) = e) ==> a < e`) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; ARITH_EQ]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + X_CHOOSE_THEN `p:num` MP_TAC (SPEC `&1 + &n / e` REAL_ARCH_SIMPLE) THEN + DISJ_CASES_TAC(ARITH_RULE `(p = 0) \/ 0 < p`) THENL + [DISCH_THEN(fun th -> DISCH_THEN(K ALL_TAC) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LT_REFL; REAL_NOT_LE] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; + REAL_ARITH `&0 < x ==> &0 < &1 + x`]; + ALL_TAC] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[NOT_FORALL_THM] THEN + MP_TAC(SPECL [`n:num`; `p:num`; + `\v:(num->num). label((lambda i. &(v i) / &p):real^N):num->num`] + KUHN_LEMMA) THEN + ASM_REWRITE_TAC[ARITH_RULE `(x = 0) \/ (x = 1) <=> x <= 1`] THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; IN_INTERVAL; VEC_COMPONENT] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_MUL_LZERO; REAL_MUL_LID; + REAL_LT_IMP_NZ; REAL_OF_NUM_LT] THEN + ASM_REWRITE_TAC[LE_0; REAL_OF_NUM_LE] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC BINDER_CONV [SWAP_EXISTS_THM] THEN + GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN + ABBREV_TAC `z:real^N = lambda i. &(q i) / &p` THEN EXISTS_TAC `z:real^N` THEN + REWRITE_TAC[TAUT `~(a ==> b) <=> ~b /\ a`] THEN + GEN_REWRITE_TAC BINDER_CONV [SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + SUBGOAL_THEN `z:real^N IN interval[vec 0,vec 1]` ASSUME_TAC THENL + [EXPAND_TAC "z" THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[LE_0; LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= n /\ d / &n <= abs((f z - z:real^N)$i)` + MP_TAC THENL + [SUBGOAL_THEN `d <= norm(f z - z:real^N)` MP_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `sum(1..dimindex(:N)) (\i. abs((f z - z:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; NUMSEG_EMPTY; CARD_NUMSEG] THEN + ASM_REWRITE_TAC[NOT_LT; ADD_SUB]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` (X_CHOOSE_THEN `s:num->num` + STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(lambda i. &(r i) / &p) :real^N` THEN + EXISTS_TAC `(lambda i. &(s i) / &p) :real^N` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_MESON_TAC[LE_0; ARITH_RULE `r <= q + 1 /\ q < p ==> r <= p`]; + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_MESON_TAC[LE_0; ARITH_RULE `r <= q + 1 /\ q < p ==> r <= p`]; + ALL_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`) + (SPEC_ALL NORM_LE_L1)) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; NUMSEG_EMPTY; CARD_NUMSEG] THEN + ASM_REWRITE_TAC[NOT_LT; ADD_SUB] THEN EXPAND_TAC "z" THEN + EXPAND_TAC "n" THEN SIMP_TAC[VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + ASM_REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[GSYM real_div; REAL_ABS_DIV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&1` THEN + ASM_SIMP_TAC[REAL_ARITH `q <= r /\ r <= q + &1 ==> abs(r - q) <= &1`; + REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + REWRITE_TAC[REAL_INV_DIV; REAL_INV_MUL] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; + REAL_OF_NUM_LT; ARITH] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_INV_1; REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_ARITH `&1 + x <= y ==> x < y`]);; + +(* ------------------------------------------------------------------------- *) +(* Retractions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("retract_of",(12,"right"));; + +let retraction = new_definition + `retraction (s,t) (r:real^N->real^N) <=> + t SUBSET s /\ r continuous_on s /\ (IMAGE r s SUBSET t) /\ + (!x. x IN t ==> (r x = x))`;; + +let retract_of = new_definition + `t retract_of s <=> ?r. retraction (s,t) r`;; + +let RETRACTION = prove + (`!s t r. retraction (s,t) r <=> + t SUBSET s /\ + r continuous_on s /\ + IMAGE r s = t /\ + (!x. x IN t ==> r x = x)`, + REWRITE_TAC[retraction] THEN SET_TAC[]);; + +let RETRACT_OF_IMP_EXTENSIBLE = prove + (`!f:real^M->real^N u s t. + s retract_of t /\ f continuous_on s /\ IMAGE f s SUBSET u + ==> ?g. g continuous_on t /\ IMAGE g t SUBSET u /\ + (!x. x IN s ==> g x = f x)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[RETRACTION; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN + EXISTS_TAC `(f:real^M->real^N) o (r:real^M->real^M)` THEN + REWRITE_TAC[IMAGE_o; o_THM] THEN + CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN + ASM_MESON_TAC[]);; + +let RETRACTION_IDEMPOTENT = prove + (`!r s t. retraction (s,t) r ==> !x. x IN s ==> (r(r(x)) = r(x))`, + REWRITE_TAC[retraction; SUBSET; FORALL_IN_IMAGE] THEN MESON_TAC[]);; + +let IDEMPOTENT_IMP_RETRACTION = prove + (`!f:real^N->real^N s. + f continuous_on s /\ IMAGE f s SUBSET s /\ + (!x. x IN s ==> f(f x) = f x) + ==> retraction (s,IMAGE f s) f`, + REWRITE_TAC[retraction] THEN SET_TAC[]);; + +let RETRACTION_SUBSET = prove + (`!r s s' t. retraction (s,t) r /\ t SUBSET s' /\ s' SUBSET s + ==> retraction (s',t) r`, + SIMP_TAC[retraction] THEN + MESON_TAC[IMAGE_SUBSET; SUBSET_TRANS; CONTINUOUS_ON_SUBSET]);; + +let RETRACT_OF_SUBSET = prove + (`!s s' t. t retract_of s /\ t SUBSET s' /\ s' SUBSET s + ==> t retract_of s'`, + REPEAT GEN_TAC THEN + REWRITE_TAC[retract_of; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[RETRACTION_SUBSET]);; + +let RETRACT_OF_TRANSLATION = prove + (`!a t s:real^N->bool. + t retract_of s + ==> (IMAGE (\x. a + x) t) retract_of (IMAGE (\x. a + x) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\x:real^N. a + x) o r o (\x:real^N. --a + x)` THEN + ASM_SIMP_TAC[IMAGE_SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; + IMAGE_ID]; + REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [GSYM IMAGE_o] THEN + ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; IMAGE_ID]; + ASM_SIMP_TAC[o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`]]);; + +let RETRACT_OF_TRANSLATION_EQ = prove + (`!a t s:real^N->bool. + (IMAGE (\x. a + x) t) retract_of (IMAGE (\x. a + x) s) <=> + t retract_of s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[RETRACT_OF_TRANSLATION] THEN + DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP RETRACT_OF_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [RETRACT_OF_TRANSLATION_EQ];; + +let RETRACT_OF_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) /\ t retract_of s + ==> (IMAGE f t) retract_of (IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[retract_of; retraction] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:real^M->real^N) o r o (g:real^N->real^M)` THEN + UNDISCH_THEN `!x y. (f:real^M->real^N) x = f y ==> x = y` (K ALL_TAC) THEN + ASM_SIMP_TAC[IMAGE_SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]; + REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [GSYM IMAGE_o] THEN + ASM_REWRITE_TAC[o_DEF; IMAGE_ID]; + ASM_SIMP_TAC[o_DEF]]);; + +let RETRACT_OF_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> ((IMAGE f t) retract_of (IMAGE f s) <=> t retract_of s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL + [DISCH_TAC; ASM_MESON_TAC[RETRACT_OF_INJECTIVE_LINEAR_IMAGE]] THEN + FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN + SUBGOAL_THEN + `!s. s = IMAGE (h:real^N->real^M) (IMAGE (f:real^M->real^N) s)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC RETRACT_OF_INJECTIVE_LINEAR_IMAGE THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +add_linear_invariants [RETRACT_OF_LINEAR_IMAGE_EQ];; + +let RETRACTION_REFL = prove + (`!s. retraction (s,s) (\x. x)`, + REWRITE_TAC[retraction; IMAGE_ID; SUBSET_REFL; CONTINUOUS_ON_ID]);; + +let RETRACT_OF_REFL = prove + (`!s. s retract_of s`, + REWRITE_TAC[retract_of] THEN MESON_TAC[RETRACTION_REFL]);; + +let RETRACT_OF_IMP_SUBSET = prove + (`!s t. s retract_of t ==> s SUBSET t`, + SIMP_TAC[retract_of; retraction] THEN MESON_TAC[]);; + +let RETRACT_OF_EMPTY = prove + (`(!s:real^N->bool. {} retract_of s <=> s = {}) /\ + (!s:real^N->bool. s retract_of {} <=> s = {})`, + REWRITE_TAC[retract_of; retraction; SUBSET_EMPTY; IMAGE_CLAUSES] THEN + CONJ_TAC THEN X_GEN_TAC `s:real^N->bool` THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_EQ_EMPTY; CONTINUOUS_ON_EMPTY; + SUBSET_REFL]);; + +let RETRACT_OF_SING = prove + (`!s x:real^N. {x} retract_of s <=> x IN s`, + REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; RETRACTION] THEN EQ_TAC THENL + [SET_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC `(\y. x):real^N->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);; + +let RETRACTION_o = prove + (`!f g s t u:real^N->bool. + retraction (s,t) f /\ retraction (t,u) g + ==> retraction (s,u) (g o f)`, + REPEAT GEN_TAC THEN REWRITE_TAC[retraction] THEN REPEAT STRIP_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; + +let RETRACT_OF_TRANS = prove + (`!s t u:real^N->bool. + s retract_of t /\ t retract_of u ==> s retract_of u`, + REWRITE_TAC[retract_of] THEN MESON_TAC[RETRACTION_o]);; + +let CLOSED_IN_RETRACT = prove + (`!s t:real^N->bool. + s retract_of t ==> closed_in (subtopology euclidean t) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `s = {x:real^N | x IN t /\ lift(norm(r x - x)) = vec 0}` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP; NORM_EQ_0] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN ASM_SIMP_TAC[CONTINUOUS_ON_ID]]);; + +let RETRACT_OF_CONTRACTIBLE = prove + (`!s t:real^N->bool. contractible t /\ s retract_of t ==> contractible s`, + REPEAT GEN_TAC THEN REWRITE_TAC[contractible; retract_of] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `r:real^N->real^N`)) THEN + SIMP_TAC[HOMOTOPIC_WITH; PCROSS; LEFT_IMP_EXISTS_THM] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [retraction]) THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `h:real^(1,N)finite_sum->real^N`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(r:real^N->real^N) a`; + `(r:real^N->real^N) o (h:real^(1,N)finite_sum->real^N)`] THEN + ASM_SIMP_TAC[o_THM; IMAGE_o; SUBSET] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let RETRACT_OF_COMPACT = prove + (`!s t:real^N->bool. compact t /\ s retract_of t ==> compact s`, + REWRITE_TAC[retract_of; RETRACTION] THEN + MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);; + +let RETRACT_OF_CLOSED = prove + (`!s t. closed t /\ s retract_of t ==> closed s`, + MESON_TAC[CLOSED_IN_CLOSED_EQ; CLOSED_IN_RETRACT]);; + +let RETRACT_OF_CONNECTED = prove + (`!s t:real^N->bool. connected t /\ s retract_of t ==> connected s`, + REWRITE_TAC[retract_of; RETRACTION] THEN + MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);; + +let RETRACT_OF_PATH_CONNECTED = prove + (`!s t:real^N->bool. path_connected t /\ s retract_of t ==> path_connected s`, + REWRITE_TAC[retract_of; RETRACTION] THEN + MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);; + +let RETRACT_OF_SIMPLY_CONNECTED = prove + (`!s t:real^N->bool. + simply_connected t /\ s retract_of t ==> simply_connected s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN + ASM_REWRITE_TAC[IMAGE_ID; CONTINUOUS_ON_ID]);; + +let RETRACT_OF_HOMOTOPICALLY_TRIVIAL = prove + (`!s t:real^N->bool u:real^M->bool. + t retract_of s /\ + (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ + g continuous_on u /\ IMAGE g u SUBSET s + ==> homotopic_with (\x. T) (u,s) f g) + ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ + g continuous_on u /\ IMAGE g u SUBSET t + ==> homotopic_with (\x. T) (u,t) f g)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ T /\ r /\ s /\ T`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; + +let RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL = prove + (`!s t:real^N->bool u:real^M->bool. + t retract_of s /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET s + ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) + ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t + ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; + +let RETRACT_OF_COHOMOTOPICALLY_TRIVIAL = prove + (`!s t:real^N->bool u:real^M->bool. + t retract_of s /\ + (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ + g continuous_on s /\ IMAGE g s SUBSET u + ==> homotopic_with (\x. T) (s,u) f g) + ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ + g continuous_on t /\ IMAGE g t SUBSET u + ==> homotopic_with (\x. T) (t,u) f g)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> p /\ q /\ T /\ r /\ s /\ T`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; + +let RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL = prove + (`!s t:real^N->bool u:real^M->bool. + t retract_of s /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET u + ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) + ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u + ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; + +let RETRACTION_IMP_QUOTIENT_MAP = prove + (`!r s t:real^N->bool. + retraction (s,t) r + ==> !u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ r x IN u} <=> + open_in (subtopology euclidean t) u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `\x:real^N. x` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; SUBSET_REFL; IMAGE_ID]);; + +let RETRACT_OF_LOCALLY_CONNECTED = prove + (`!s t:real^N->bool. + s retract_of t /\ locally connected t ==> locally connected s`, + REPEAT GEN_TAC THEN REWRITE_TAC[retract_of] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o el 2 o CONJUNCTS o GEN_REWRITE_RULE I + [RETRACTION]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN + MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN + ASM_MESON_TAC[RETRACTION]);; + +let RETRACT_OF_LOCALLY_PATH_CONNECTED = prove + (`!s t:real^N->bool. + s retract_of t /\ locally path_connected t + ==> locally path_connected s`, + REPEAT GEN_TAC THEN REWRITE_TAC[retract_of] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o el 2 o CONJUNCTS o GEN_REWRITE_RULE I + [RETRACTION]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN + MATCH_MP_TAC RETRACTION_IMP_QUOTIENT_MAP THEN + ASM_MESON_TAC[RETRACTION]);; + +let RETRACT_OF_LOCALLY_COMPACT = prove + (`!s t:real^N->bool. + locally compact s /\ t retract_of s ==> locally compact t`, + MESON_TAC[CLOSED_IN_RETRACT; LOCALLY_COMPACT_CLOSED_IN]);; + +let RETRACT_OF_PCROSS = prove + (`!s:real^M->bool s' t:real^N->bool t'. + s retract_of s' /\ t retract_of t' + ==> (s PCROSS t) retract_of (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + REWRITE_TAC[retract_of; retraction; SUBSET; FORALL_IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `f:real^M->real^M` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\z. pastecart ((f:real^M->real^M) (fstcart z)) + ((g:real^N->real^N) (sndcart z))` THEN + REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; + +let RETRACT_OF_PCROSS_EQ = prove + (`!s s':real^M->bool t t':real^N->bool. + s PCROSS t retract_of s' PCROSS t' <=> + (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ + s retract_of s' /\ t retract_of t'`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`s:real^M->bool = {}`; + `s':real^M->bool = {}`; + `t:real^N->bool = {}`; + `t':real^N->bool = {}`] THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; RETRACT_OF_EMPTY; PCROSS_EQ_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[RETRACT_OF_PCROSS] THEN + REWRITE_TAC[retract_of; retraction; SUBSET; FORALL_IN_PCROSS; + FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^(M,N)finite_sum->real^(M,N)finite_sum` + STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `?b:real^N. b IN t` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `\x. fstcart((r:real^(M,N)finite_sum->real^(M,N)finite_sum) + (pastecart x b))` THEN + ASM_SIMP_TAC[FSTCART_PASTECART] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS; MEMBER_NOT_EMPTY]]; + SUBGOAL_THEN `?a:real^M. a IN s` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `\x. sndcart((r:real^(M,N)finite_sum->real^(M,N)finite_sum) + (pastecart a x))` THEN + ASM_SIMP_TAC[SNDCART_PASTECART] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS; + MEMBER_NOT_EMPTY]]]);; + +let HOMOTOPIC_INTO_RETRACT = prove + (`!f:real^M->real^N g s t u. + IMAGE f s SUBSET t /\ IMAGE g s SUBSET t /\ t retract_of u /\ + homotopic_with (\x. T) (s,u) f g + ==> homotopic_with (\x. T) (s,t) f g`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h:real^(1,M)finite_sum->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `(r:real^N->real^N) o (h:real^(1,M)finite_sum->real^N)` THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN + CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Absolute retracts (AR), absolute neighbourhood retracts (ANR) and also *) +(* Euclidean neighbourhood retracts (ENR). We define AR and ANR by *) +(* specializing the standard definitions for a set in R^n to embedding in *) +(* spaces inside R^{n+1}. This turns out to be sufficient (since any set in *) +(* R^n can be embedded as a closed subset of a convex subset of R^{n+1}) to *) +(* derive the usual definitions, but we need to split them into two *) +(* implications because of the lack of type quantifiers. Then ENR turns out *) +(* to be equivalent to ANR plus local compactness. *) +(* ------------------------------------------------------------------------- *) + +let AR = new_definition + `AR(s:real^N->bool) <=> + !u s':real^(N,1)finite_sum->bool. + s homeomorphic s' /\ closed_in (subtopology euclidean u) s' + ==> s' retract_of u`;; + +let ANR = new_definition + `ANR(s:real^N->bool) <=> + !u s':real^(N,1)finite_sum->bool. + s homeomorphic s' /\ closed_in (subtopology euclidean u) s' + ==> ?t. open_in (subtopology euclidean u) t /\ + s' retract_of t`;; + +let ENR = new_definition + `ENR s <=> ?u. open u /\ s retract_of u`;; + +(* ------------------------------------------------------------------------- *) +(* First, show that we do indeed get the "usual" properties of ARs and ANRs. *) +(* ------------------------------------------------------------------------- *) + +let AR_IMP_ABSOLUTE_EXTENSOR = prove + (`!f:real^M->real^N u t s. + AR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\ + !x. x IN t ==> g x = f x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c s':real^(N,1)finite_sum->bool. + convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ + (s:real^N->bool) homeomorphic s'` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AR]) THEN + DISCH_THEN(MP_TAC o SPECL + [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`(g:real^N->real^(N,1)finite_sum) o (f:real^M->real^N)`; + `c:real^(N,1)finite_sum->bool`; `u:real^M->bool`; `t:real^M->bool`] + DUGUNDJI) THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^(N,1)finite_sum` + STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^(N,1)finite_sum->real^(N,1)finite_sum` THEN + STRIP_TAC THEN + EXISTS_TAC `(h:real^(N,1)finite_sum->real^N) o r o + (f':real^M->real^(N,1)finite_sum)` THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; + +let AR_IMP_ABSOLUTE_RETRACT = prove + (`!s:real^N->bool u s':real^M->bool. + AR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' + ==> s' retract_of u`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^N->real^M`; `h:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^M->real^N`; `u:real^M->bool`; `s':real^M->bool`; + `s:real^N->bool`] AR_IMP_ABSOLUTE_EXTENSOR) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `(g:real^N->real^M) o (h':real^M->real^N)` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; + +let AR_IMP_ABSOLUTE_RETRACT_UNIV = prove + (`!s:real^N->bool s':real^M->bool. + AR s /\ s homeomorphic s' /\ closed s' ==> s' retract_of (:real^M)`, + MESON_TAC[AR_IMP_ABSOLUTE_RETRACT; + TOPSPACE_EUCLIDEAN; SUBTOPOLOGY_UNIV; OPEN_IN; CLOSED_IN]);; + +let ABSOLUTE_EXTENSOR_IMP_AR = prove + (`!s:real^N->bool. + (!f:real^(N,1)finite_sum->real^N u t. + f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\ + !x. x IN t ==> g x = f x) + ==> AR s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN MAP_EVERY X_GEN_TAC + [`u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL + [`h:real^(N,1)finite_sum->real^N`; + `u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(X_CHOOSE_THEN + `h':real^(N,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `(g:real^N->real^(N,1)finite_sum) o + (h':real^(N,1)finite_sum->real^N)` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; + +let AR_EQ_ABSOLUTE_EXTENSOR = prove + (`!s:real^N->bool. + AR s <=> + (!f:real^(N,1)finite_sum->real^N u t. + f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET s /\ + !x. x IN t ==> g x = f x)`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[AR_IMP_ABSOLUTE_EXTENSOR; ABSOLUTE_EXTENSOR_IMP_AR]);; + +let AR_IMP_RETRACT = prove + (`!s u:real^N->bool. + AR s /\ closed_in (subtopology euclidean u) s ==> s retract_of u`, + MESON_TAC[AR_IMP_ABSOLUTE_RETRACT; HOMEOMORPHIC_REFL]);; + +let HOMEOMORPHIC_ARNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> (AR s <=> AR t)`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ AR t ==> AR s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] + AR_IMP_ABSOLUTE_RETRACT)) THEN + ASM_REWRITE_TAC[] THEN + TRANS_TAC HOMEOMORPHIC_TRANS `s:real^M->bool` THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THENL + [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]; ALL_TAC] THEN + ASM_MESON_TAC[lemma]);; + +let AR_TRANSLATION = prove + (`!a:real^N s. AR(IMAGE (\x. a + x) s) <=> AR s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; + +add_translation_invariants [AR_TRANSLATION];; + +let AR_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (AR(IMAGE f s) <=> AR s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);; + +add_linear_invariants [AR_LINEAR_IMAGE_EQ];; + +let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR = prove + (`!f:real^M->real^N u t s. + ANR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ + g continuous_on v /\ IMAGE g v SUBSET s /\ + !x. x IN t ==> g x = f x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c s':real^(N,1)finite_sum->bool. + convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ + (s:real^N->bool) homeomorphic s'` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN + DISCH_THEN(MP_TAC o SPECL + [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN + `d:real^(N,1)finite_sum->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`(g:real^N->real^(N,1)finite_sum) o (f:real^M->real^N)`; + `c:real^(N,1)finite_sum->bool`; `u:real^M->bool`; `t:real^M->bool`] + DUGUNDJI) THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^(N,1)finite_sum` + STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^(N,1)finite_sum->real^(N,1)finite_sum` THEN + STRIP_TAC THEN + EXISTS_TAC `{x | x IN u /\ (f':real^M->real^(N,1)finite_sum) x IN d}` THEN + EXISTS_TAC `(h:real^(N,1)finite_sum->real^N) o r o + (f':real^M->real^(N,1)finite_sum)` THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL + [REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[]; + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT = prove + (`!s:real^N->bool u s':real^M->bool. + ANR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' + ==> ?v. open_in (subtopology euclidean u) v /\ + s' retract_of v`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^N->real^M`; `h:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^M->real^N`; `u:real^M->bool`; `s':real^M->bool`; + `s:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `h':real^M->real^N` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `(g:real^N->real^M) o (h':real^M->real^N)` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; + +let ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV = prove + (`!s:real^N->bool s':real^M->bool. + ANR s /\ s homeomorphic s' /\ closed s' ==> ?v. open v /\ s' retract_of v`, + MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; + TOPSPACE_EUCLIDEAN; SUBTOPOLOGY_UNIV; OPEN_IN; CLOSED_IN]);; + +let ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR = prove + (`!s:real^N->bool. + (!f:real^(N,1)finite_sum->real^N u t. + f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ + g continuous_on v /\ IMAGE g v SUBSET s /\ + !x. x IN t ==> g x = f x) + ==> ANR s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN MAP_EVERY X_GEN_TAC + [`u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`g:real^N->real^(N,1)finite_sum`; `h:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL + [`h:real^(N,1)finite_sum->real^N`; + `u:real^(N,1)finite_sum->bool`; `t:real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^(N,1)finite_sum->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `h':real^(N,1)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `(g:real^N->real^(N,1)finite_sum) o + (h':real^(N,1)finite_sum->real^N)` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; + +let ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR = prove + (`!s:real^N->bool. + ANR s <=> + (!f:real^(N,1)finite_sum->real^N u t. + f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ + g continuous_on v /\ IMAGE g v SUBSET s /\ + !x. x IN t ==> g x = f x)`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; + ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR]);; + +let ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT = prove + (`!s:real^N->bool u s':real^M->bool. + ANR s /\ s homeomorphic s' /\ closed_in (subtopology euclidean u) s' + ==> ?v w. open_in (subtopology euclidean u) v /\ + closed_in (subtopology euclidean u) w /\ + s' SUBSET v /\ v SUBSET w /\ s' retract_of w`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?z. open_in (subtopology euclidean u) z /\ + (s':real^M->bool) retract_of z` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`s':real^M->bool`; `u DIFF z:real^M->bool`; `u:real^M->bool`] + SEPARATION_NORMAL_LOCAL) THEN + ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_DIFF] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `v:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u DIFF w:real^M->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] RETRACT_OF_SUBSET)) THEN + ASM SET_TAC[]);; + +let ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR = prove + (`!f:real^M->real^N u t s. + ANR s /\ f continuous_on t /\ IMAGE f t SUBSET s /\ + closed_in (subtopology euclidean u) t + ==> ?v w g. open_in (subtopology euclidean u) v /\ + closed_in (subtopology euclidean u) w /\ + t SUBSET v /\ v SUBSET w /\ + g continuous_on w /\ IMAGE g w SUBSET s /\ + !x. x IN t ==> g x = f x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?v g. t SUBSET v /\ open_in (subtopology euclidean u) v /\ + g continuous_on v /\ IMAGE g v SUBSET s /\ + !x. x IN t ==> g x = (f:real^M->real^N) x` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`t:real^M->bool`; `u DIFF v:real^M->bool`; `u:real^M->bool`] + SEPARATION_NORMAL_LOCAL) THEN + ASM_SIMP_TAC[CLOSED_IN_INTER; CLOSED_IN_REFL; CLOSED_IN_DIFF] THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `w:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u DIFF z:real^M->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + EXISTS_TAC `g:real^M->real^N` THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]);; + +let ANR_IMP_NEIGHBOURHOOD_RETRACT = prove + (`!s:real^N->bool u. + ANR s /\ closed_in (subtopology euclidean u) s + ==> ?v. open_in (subtopology euclidean u) v /\ + s retract_of v`, + MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL]);; + +let ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT = prove + (`!s:real^N->bool u. + ANR s /\ closed_in (subtopology euclidean u) s + ==> ?v w. open_in (subtopology euclidean u) v /\ + closed_in (subtopology euclidean u) w /\ + s SUBSET v /\ v SUBSET w /\ s retract_of w`, + MESON_TAC[ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT; + HOMEOMORPHIC_REFL]);; + +let HOMEOMORPHIC_ANRNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> (ANR s <=> ANR t)`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ ANR t ==> ANR s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] + ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT)) THEN + ASM_REWRITE_TAC[] THEN + TRANS_TAC HOMEOMORPHIC_TRANS `s:real^M->bool` THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THENL + [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]; ALL_TAC] THEN + ASM_MESON_TAC[lemma]);; + +let ANR_TRANSLATION = prove + (`!a:real^N s. ANR(IMAGE (\x. a + x) s) <=> ANR s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; + +add_translation_invariants [ANR_TRANSLATION];; + +let ANR_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (ANR(IMAGE f s) <=> ANR s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);; + +add_linear_invariants [ANR_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Analogous properties of ENRs. *) +(* ------------------------------------------------------------------------- *) + +let ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT = prove + (`!s:real^M->bool s':real^N->bool u. + ENR s /\ s homeomorphic s' /\ s' SUBSET u + ==> ?t'. open_in (subtopology euclidean u) t' /\ s' retract_of t'`, + REWRITE_TAC[ENR; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`X:real^M->bool`; `Y:real^N->bool`; + `K:real^N->bool`; `U:real^M->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `locally compact (Y:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[RETRACT_OF_LOCALLY_COMPACT; + OPEN_IMP_LOCALLY_COMPACT; HOMEOMORPHIC_LOCAL_COMPACTNESS]; + ALL_TAC] THEN + SUBGOAL_THEN + `?W:real^N->bool. + open_in (subtopology euclidean K) W /\ + closed_in (subtopology euclidean W) Y` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(X_CHOOSE_THEN `W:real^N->bool` STRIP_ASSUME_TAC o + MATCH_MP LOCALLY_COMPACT_CLOSED_IN_OPEN) THEN + EXISTS_TAC `K INTER W:real^N->bool` THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; CLOSED_IN_CLOSED] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`f:real^M->real^N`; `g:real^N->real^M`] THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `W:real^N->bool`; `Y:real^N->bool`] + TIETZE_UNBOUNDED) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{x | x IN W /\ (h:real^N->real^M) x IN U}` THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `W:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `(:real^M)` THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSET_UNIV]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; retract_of; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN + EXISTS_TAC `(f:real^M->real^N) o r o (h:real^N->real^M)` THEN + SUBGOAL_THEN + `(W:real^N->bool) SUBSET K /\ Y SUBSET W` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_o; o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]);; + +let ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV = prove + (`!s:real^M->bool s':real^N->bool. + ENR s /\ s homeomorphic s' ==> ?t'. open t' /\ s' retract_of t'`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + MATCH_MP_TAC ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT THEN + ASM_MESON_TAC[SUBSET_UNIV]);; + +let HOMEOMORPHIC_ENRNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> (ENR s <=> ENR t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + REWRITE_TAC[ENR] THENL + [MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] + ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV); + MP_TAC(ISPECL [`t:real^N->bool`; `s:real^M->bool`] + ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV)] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; + +let ENR_TRANSLATION = prove + (`!a:real^N s. ENR(IMAGE (\x. a + x) s) <=> ENR s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; + +add_translation_invariants [ENR_TRANSLATION];; + +let ENR_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (ENR(IMAGE f s) <=> ENR s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_ENRNESS THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF]);; + +add_linear_invariants [ENR_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Some relations among the concepts. We also relate AR to being a retract *) +(* of UNIV, which is often a more convenient proxy in the closed case. *) +(* ------------------------------------------------------------------------- *) + +let AR_IMP_ANR = prove + (`!s:real^N->bool. AR s ==> ANR s`, + REWRITE_TAC[AR; ANR] THEN MESON_TAC[OPEN_IN_REFL; CLOSED_IN_IMP_SUBSET]);; + +let ENR_IMP_ANR = prove + (`!s:real^N->bool. ENR s ==> ANR s`, + REWRITE_TAC[ANR] THEN + MESON_TAC[ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; CLOSED_IN_IMP_SUBSET]);; + +let ENR_ANR = prove + (`!s:real^N->bool. ENR s <=> ANR s /\ locally compact s`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[ENR_IMP_ANR] THENL + [ASM_MESON_TAC[ENR; RETRACT_OF_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT]; + SUBGOAL_THEN + `?t. closed t /\ + (s:real^N->bool) homeomorphic (t:real^(N,1)finite_sum->bool)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED THEN + ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN + DISCH_THEN(MP_TAC o SPECL + [`(:real^(N,1)finite_sum)`; `t:real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; GSYM OPEN_IN] THEN + REWRITE_TAC[GSYM ENR] THEN ASM_MESON_TAC[HOMEOMORPHIC_ENRNESS]]]);; + +let AR_ANR = prove + (`!s:real^N->bool. AR s <=> ANR s /\ contractible s /\ ~(s = {})`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[AR_IMP_ANR] THENL + [CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[AR; HOMEOMORPHIC_EMPTY; RETRACT_OF_EMPTY; + FORALL_UNWIND_THM2; CLOSED_IN_EMPTY; UNIV_NOT_EMPTY]] THEN + SUBGOAL_THEN + `?c s':real^(N,1)finite_sum->bool. + convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ + (s:real^N->bool) homeomorphic s'` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [AR]) THEN + DISCH_THEN(MP_TAC o SPECL + [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM; HOMEOMORPHIC_CONTRACTIBLE; + RETRACT_OF_CONTRACTIBLE; CONVEX_IMP_CONTRACTIBLE]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; homotopic_with] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `h:real^(1,N)finite_sum->real^N`] THEN + STRIP_TAC THEN REWRITE_TAC[AR_EQ_ABSOLUTE_EXTENSOR] THEN + MAP_EVERY X_GEN_TAC + [`f:real^(N,1)finite_sum->real^N`; `w:real^(N,1)finite_sum->bool`; + `t:real^(N,1)finite_sum->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o ISPECL + [`f:real^(N,1)finite_sum->real^N`; `w:real^(N,1)finite_sum->bool`; + `t:real^(N,1)finite_sum->bool`] o + REWRITE_RULE[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`u:real^(N,1)finite_sum->bool`; `g:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`t:real^(N,1)finite_sum->bool`; `w DIFF u:real^(N,1)finite_sum->bool`; + `w:real^(N,1)finite_sum->bool`] SEPARATION_NORMAL_LOCAL) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC + [`v:real^(N,1)finite_sum->bool`; `v':real^(N,1)finite_sum->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`t:real^(N,1)finite_sum->bool`; `w DIFF v:real^(N,1)finite_sum->bool`; + `w:real^(N,1)finite_sum->bool`; `vec 0:real^1`; `vec 1:real^1`] + URYSOHN_LOCAL) THEN + ASM_SIMP_TAC[SEGMENT_1; CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + REWRITE_TAC[DROP_VEC; REAL_POS] THEN + X_GEN_TAC `e:real^(N,1)finite_sum->real^1` THEN STRIP_TAC THEN + EXISTS_TAC + `\x. if (x:real^(N,1)finite_sum) IN w DIFF v then a + else (h:real^(1,N)finite_sum->real^N) (pastecart (e x) (g x))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [SUBGOAL_THEN `w:real^(N,1)finite_sum->bool = (w DIFF v) UNION (w DIFF v')` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC RAND_CONV [th] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + REWRITE_TAC[GSYM th]) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL; CONTINUOUS_ON_CONST] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN RULE_ASSUM_TAC + (REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF] THEN + COND_CASES_TAC THEN ASM SET_TAC[]]);; + +let ANR_RETRACT_OF_ANR = prove + (`!s t:real^N->bool. ANR t /\ s retract_of t ==> ANR s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^(N,1)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(r:real^N->real^N) o (g:real^(N,1)finite_sum->real^N)` THEN + ASM_SIMP_TAC[IMAGE_o; o_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]);; + +let AR_RETRACT_OF_AR = prove + (`!s t:real^N->bool. AR t /\ s retract_of t ==> AR s`, + REWRITE_TAC[AR_ANR] THEN + MESON_TAC[ANR_RETRACT_OF_ANR; RETRACT_OF_CONTRACTIBLE; RETRACT_OF_EMPTY]);; + +let ENR_RETRACT_OF_ENR = prove + (`!s t:real^N->bool. ENR t /\ s retract_of t ==> ENR s`, + REWRITE_TAC[ENR] THEN MESON_TAC[RETRACT_OF_TRANS]);; + +let RETRACT_OF_UNIV = prove + (`!s:real^N->bool. s retract_of (:real^N) <=> AR s /\ closed s`, + GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC AR_RETRACT_OF_AR THEN EXISTS_TAC `(:real^N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ABSOLUTE_EXTENSOR_IMP_AR THEN + MESON_TAC[DUGUNDJI; CONVEX_UNIV; UNIV_NOT_EMPTY]; + MATCH_MP_TAC RETRACT_OF_CLOSED THEN ASM_MESON_TAC[CLOSED_UNIV]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + AR_IMP_ABSOLUTE_RETRACT)) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; HOMEOMORPHIC_REFL]]);; + +let COMPACT_AR = prove + (`!s. compact s /\ AR s <=> compact s /\ s retract_of (:real^N)`, + REWRITE_TAC[RETRACT_OF_UNIV] THEN MESON_TAC[COMPACT_IMP_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* More properties of ARs, ANRs and ENRs. *) +(* ------------------------------------------------------------------------- *) + +let NOT_AR_EMPTY = prove + (`~(AR({}:real^N->bool))`, + REWRITE_TAC[AR_ANR]);; + +let ENR_EMPTY = prove + (`ENR {}`, + REWRITE_TAC[ENR; RETRACT_OF_EMPTY] THEN MESON_TAC[OPEN_EMPTY]);; + +let ANR_EMPTY = prove + (`ANR {}`, + SIMP_TAC[ENR_EMPTY; ENR_IMP_ANR]);; + +let CONVEX_IMP_AR = prove + (`!s:real^N->bool. convex s /\ ~(s = {}) ==> AR s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTE_EXTENSOR_IMP_AR THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DUGUNDJI THEN + ASM_REWRITE_TAC[]);; + +let CONVEX_IMP_ANR = prove + (`!s:real^N->bool. convex s ==> ANR s`, + MESON_TAC[ANR_EMPTY; CONVEX_IMP_AR; AR_IMP_ANR]);; + +let ENR_CONVEX_CLOSED = prove + (`!s:real^N->bool. closed s /\ convex s ==> ENR s`, + MESON_TAC[CONVEX_IMP_ANR; ENR_ANR; CLOSED_IMP_LOCALLY_COMPACT]);; + +let AR_UNIV = prove + (`AR(:real^N)`, + MESON_TAC[CONVEX_IMP_AR; CONVEX_UNIV; UNIV_NOT_EMPTY]);; + +let ANR_UNIV = prove + (`ANR(:real^N)`, + MESON_TAC[CONVEX_IMP_ANR; CONVEX_UNIV]);; + +let ENR_UNIV = prove + (`ENR(:real^N)`, + MESON_TAC[ENR_CONVEX_CLOSED; CONVEX_UNIV; CLOSED_UNIV]);; + +let AR_SING = prove + (`!a:real^N. AR {a}`, + SIMP_TAC[CONVEX_IMP_AR; CONVEX_SING; NOT_INSERT_EMPTY]);; + +let ANR_SING = prove + (`!a:real^N. ANR {a}`, + SIMP_TAC[AR_IMP_ANR; AR_SING]);; + +let ENR_SING = prove + (`!a:real^N. ENR {a}`, + SIMP_TAC[ENR_ANR; ANR_SING; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_SING]);; + +let ANR_OPEN_IN = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean t) s /\ ANR t ==> ANR s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^(N,1)finite_sum->real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^(N,1)finite_sum->bool` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{x | x IN w /\ (g:real^(N,1)finite_sum->real^N) x IN s}` THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_TRANS THEN + EXISTS_TAC `w:real^(N,1)finite_sum->bool` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM_MESON_TAC[]; + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);; + +let ENR_OPEN_IN = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean t) s /\ ENR t ==> ENR s`, + REWRITE_TAC[ENR_ANR] THEN MESON_TAC[ANR_OPEN_IN; LOCALLY_OPEN_SUBSET]);; + +let ANR_NEIGHBORHOOD_RETRACT = prove + (`!s t u:real^N->bool. + s retract_of t /\ open_in (subtopology euclidean u) t /\ ANR u + ==> ANR s`, + MESON_TAC[ANR_OPEN_IN; ANR_RETRACT_OF_ANR]);; + +let ENR_NEIGHBORHOOD_RETRACT = prove + (`!s t u:real^N->bool. + s retract_of t /\ open_in (subtopology euclidean u) t /\ ENR u + ==> ENR s`, + MESON_TAC[ENR_OPEN_IN; ENR_RETRACT_OF_ENR]);; + +let ANR_RELATIVE_INTERIOR = prove + (`!s. ANR(s) ==> ANR(relative_interior s)`, + MESON_TAC[OPEN_IN_SET_RELATIVE_INTERIOR; ANR_OPEN_IN]);; + +let ANR_DELETE = prove + (`!s a:real^N. ANR(s) ==> ANR(s DELETE a)`, + MESON_TAC[ANR_OPEN_IN; OPEN_IN_DELETE; OPEN_IN_REFL]);; + +let ENR_RELATIVE_INTERIOR = prove + (`!s. ENR(s) ==> ENR(relative_interior s)`, + MESON_TAC[OPEN_IN_SET_RELATIVE_INTERIOR; ENR_OPEN_IN]);; + +let ENR_DELETE = prove + (`!s a:real^N. ENR(s) ==> ENR(s DELETE a)`, + MESON_TAC[ENR_OPEN_IN; OPEN_IN_DELETE; OPEN_IN_REFL]);; + +let OPEN_IMP_ENR = prove + (`!s:real^N->bool. open s ==> ENR s`, + REWRITE_TAC[OPEN_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + MESON_TAC[ENR_UNIV; ENR_OPEN_IN]);; + +let OPEN_IMP_ANR = prove + (`!s:real^N->bool. open s ==> ANR s`, + SIMP_TAC[OPEN_IMP_ENR; ENR_IMP_ANR]);; + +let ANR_BALL = prove + (`!a:real^N r. ANR(ball(a,r))`, + MESON_TAC[CONVEX_IMP_ANR; CONVEX_BALL]);; + +let ENR_BALL = prove + (`!a:real^N r. ENR(ball(a,r))`, + SIMP_TAC[ENR_ANR; ANR_BALL; OPEN_IMP_LOCALLY_COMPACT; OPEN_BALL]);; + +let AR_BALL = prove + (`!a:real^N r. AR(ball(a,r)) <=> &0 < r`, + SIMP_TAC[AR_ANR; BALL_EQ_EMPTY; ANR_BALL; CONVEX_BALL; + CONVEX_IMP_CONTRACTIBLE; REAL_NOT_LE]);; + +let ANR_CBALL = prove + (`!a:real^N r. ANR(cball(a,r))`, + MESON_TAC[CONVEX_IMP_ANR; CONVEX_CBALL]);; + +let ENR_CBALL = prove + (`!a:real^N r. ENR(cball(a,r))`, + SIMP_TAC[ENR_ANR; ANR_CBALL; CLOSED_IMP_LOCALLY_COMPACT; CLOSED_CBALL]);; + +let AR_CBALL = prove + (`!a:real^N r. AR(cball(a,r)) <=> &0 <= r`, + SIMP_TAC[AR_ANR; CBALL_EQ_EMPTY; ANR_CBALL; CONVEX_CBALL; + CONVEX_IMP_CONTRACTIBLE; REAL_NOT_LT]);; + +let ANR_INTERVAL = prove + (`(!a b:real^N. ANR(interval[a,b])) /\ (!a b:real^N. ANR(interval(a,b)))`, + SIMP_TAC[CONVEX_IMP_ANR; CONVEX_INTERVAL; CLOSED_INTERVAL; + OPEN_IMP_ANR; OPEN_INTERVAL]);; + +let ENR_INTERVAL = prove + (`(!a b:real^N. ENR(interval[a,b])) /\ (!a b:real^N. ENR(interval(a,b)))`, + SIMP_TAC[ENR_CONVEX_CLOSED; CONVEX_INTERVAL; CLOSED_INTERVAL; + OPEN_IMP_ENR; OPEN_INTERVAL]);; + +let AR_INTERVAL = prove + (`(!a b:real^N. AR(interval[a,b]) <=> ~(interval[a,b] = {})) /\ + (!a b:real^N. AR(interval(a,b)) <=> ~(interval(a,b) = {}))`, + SIMP_TAC[AR_ANR; ANR_INTERVAL; CONVEX_IMP_CONTRACTIBLE; CONVEX_INTERVAL]);; + +let ANR_INTERIOR = prove + (`!s. ANR(interior s)`, + SIMP_TAC[OPEN_INTERIOR; OPEN_IMP_ANR]);; + +let ENR_INTERIOR = prove + (`!s. ENR(interior s)`, + SIMP_TAC[OPEN_INTERIOR; OPEN_IMP_ENR]);; + +let AR_IMP_CONTRACTIBLE = prove + (`!s:real^N->bool. AR s ==> contractible s`, + SIMP_TAC[AR_ANR]);; + +let ENR_IMP_LOCALLY_COMPACT = prove + (`!s:real^N->bool. ENR s ==> locally compact s`, + SIMP_TAC[ENR_ANR]);; + +let ANR_IMP_LOCALLY_PATH_CONNECTED = prove + (`!s:real^N->bool. ANR s ==> locally path_connected s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c s':real^(N,1)finite_sum->bool. + convex c /\ ~(c = {}) /\ closed_in (subtopology euclidean c) s' /\ + (s:real^N->bool) homeomorphic s'` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC HOMEOMORPHIC_CLOSED_IN_CONVEX THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_ARITH `x:int < y + &1 <=> x <= y`; AFF_DIM_LE_UNIV]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANR]) THEN + DISCH_THEN(MP_TAC o SPECL + [`c:real^(N,1)finite_sum->bool`; `s':real^(N,1)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM; HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS; + RETRACT_OF_LOCALLY_PATH_CONNECTED; + CONVEX_IMP_LOCALLY_PATH_CONNECTED; + LOCALLY_OPEN_SUBSET]);; + +let ANR_IMP_LOCALLY_CONNECTED = prove + (`!s:real^N->bool. ANR s ==> locally connected s`, + SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; + LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; + +let AR_IMP_LOCALLY_PATH_CONNECTED = prove + (`!s:real^N->bool. AR s ==> locally path_connected s`, + SIMP_TAC[AR_IMP_ANR; ANR_IMP_LOCALLY_PATH_CONNECTED]);; + +let AR_IMP_LOCALLY_CONNECTED = prove + (`!s:real^N->bool. AR s ==> locally connected s`, + SIMP_TAC[AR_IMP_LOCALLY_PATH_CONNECTED; + LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; + +let ENR_IMP_LOCALLY_PATH_CONNECTED = prove + (`!s:real^N->bool. ENR s ==> locally path_connected s`, + SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; ENR_IMP_ANR]);; + +let ENR_IMP_LOCALLY_CONNECTED = prove + (`!s:real^N->bool. ENR s ==> locally connected s`, + SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; ENR_IMP_ANR]);; + +let COUNTABLE_ANR_COMPONENTS = prove + (`!s:real^N->bool. ANR s ==> COUNTABLE(components s)`, + SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; COUNTABLE_COMPONENTS]);; + +let COUNTABLE_ANR_CONNECTED_COMPONENTS = prove + (`!s:real^N->bool t. + ANR s ==> COUNTABLE {connected_component s x | x IN t}`, + SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED; COUNTABLE_CONNECTED_COMPONENTS]);; + +let COUNTABLE_ANR_PATH_COMPONENTS = prove + (`!s:real^N->bool t. + ANR s ==> COUNTABLE {path_component s x | x IN t}`, + SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED; COUNTABLE_PATH_COMPONENTS]);; + +let FINITE_ANR_COMPONENTS = prove + (`!s:real^N->bool. ANR s /\ compact s ==> FINITE(components s)`, + SIMP_TAC[FINITE_COMPONENTS; ANR_IMP_LOCALLY_CONNECTED]);; + +let FINITE_ENR_COMPONENTS = prove + (`!s:real^N->bool. ENR s /\ compact s ==> FINITE(components s)`, + SIMP_TAC[FINITE_COMPONENTS; ENR_IMP_LOCALLY_CONNECTED]);; + +let ANR_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. ANR s /\ ANR t ==> ANR(s PCROSS t)`, + REPEAT STRIP_TAC THEN SIMP_TAC[ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR] THEN + MAP_EVERY X_GEN_TAC + [`f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum`; + `u:real^((M,N)finite_sum,1)finite_sum->bool`; + `c:real^((M,N)finite_sum,1)finite_sum->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`fstcart o (f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum)`; + `u:real^((M,N)finite_sum,1)finite_sum->bool`; + `c:real^((M,N)finite_sum,1)finite_sum->bool`; + `s:real^M->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + MP_TAC(ISPECL + [`sndcart o (f:real^((M,N)finite_sum,1)finite_sum->real^(M,N)finite_sum)`; + `u:real^((M,N)finite_sum,1)finite_sum->bool`; + `c:real^((M,N)finite_sum,1)finite_sum->bool`; + `t:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART; IMAGE_o] THEN + RULE_ASSUM_TAC + (REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; PCROSS; IN_ELIM_THM]) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [ASM_MESON_TAC[SNDCART_PASTECART]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC + [`w2:real^((M,N)finite_sum,1)finite_sum->bool`; + `h:real^((M,N)finite_sum,1)finite_sum->real^N`] THEN + STRIP_TAC THEN ANTS_TAC THENL + [ASM_MESON_TAC[FSTCART_PASTECART]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC + [`w1:real^((M,N)finite_sum,1)finite_sum->bool`; + `g:real^((M,N)finite_sum,1)finite_sum->real^M`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`w1 INTER w2:real^((M,N)finite_sum,1)finite_sum->bool`; + `\x:real^((M,N)finite_sum,1)finite_sum. + pastecart (g x:real^M) (h x:real^N)`] THEN + ASM_SIMP_TAC[OPEN_IN_INTER; IN_INTER; o_DEF; PASTECART_IN_PCROSS; + PASTECART_FST_SND] THEN + MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);; + +let ANR_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + ANR(s PCROSS t) <=> s = {} \/ t = {} \/ ANR s /\ ANR t`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; ANR_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; ANR_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[ANR_PCROSS] THEN REPEAT STRIP_TAC THENL + [UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `ANR ((s:real^M->bool) PCROSS {b:real^N})` MP_TAC THENL + [ALL_TAC; MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_ANRNESS]]; + UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN `ANR ({a:real^M} PCROSS (t:real^N->bool))` MP_TAC THENL + [ALL_TAC; MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_ANRNESS]]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + ANR_RETRACT_OF_ANR)) THEN + REWRITE_TAC[retract_of; retraction] THENL + [EXISTS_TAC`\x:real^(M,N)finite_sum. pastecart (fstcart x) (b:real^N)`; + EXISTS_TAC`\x:real^(M,N)finite_sum. pastecart (a:real^M) (sndcart x)`] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE; IN_SING; + FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS; + CONTINUOUS_ON_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART; + LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST]);; + +let AR_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. AR s /\ AR t ==> AR(s PCROSS t)`, + SIMP_TAC[AR_ANR; ANR_PCROSS; CONTRACTIBLE_PCROSS; PCROSS_EQ_EMPTY]);; + +let ENR_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. ENR s /\ ENR t ==> ENR(s PCROSS t)`, + SIMP_TAC[ENR_ANR; ANR_PCROSS; LOCALLY_COMPACT_PCROSS]);; + +let ENR_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + ENR(s PCROSS t) <=> s = {} \/ t = {} \/ ENR s /\ ENR t`, + REWRITE_TAC[ENR_ANR; ANR_PCROSS_EQ; LOCALLY_COMPACT_PCROSS_EQ] THEN + CONV_TAC TAUT);; + +let AR_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + AR(s PCROSS t) <=> AR s /\ AR t /\ ~(s = {}) /\ ~(t = {})`, + SIMP_TAC[AR_ANR; ANR_PCROSS_EQ; CONTRACTIBLE_PCROSS_EQ; PCROSS_EQ_EMPTY] THEN + CONV_TAC TAUT);; + +let AR_CLOSED_UNION_LOCAL = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + AR(s) /\ AR(t) /\ AR(s INTER t) + ==> AR(s UNION t)`, + let lemma = prove + (`!s t u:real^N->bool. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + AR s /\ AR t /\ AR(s INTER t) + ==> (s UNION t) retract_of u`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL + [ASM_MESON_TAC[NOT_AR_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ t SUBSET u` STRIP_ASSUME_TAC + THENL [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`s' = {x:real^N | x IN u /\ setdist({x},s) <= setdist({x},t)}`; + `t' = {x:real^N | x IN u /\ setdist({x},t) <= setdist({x},s)}`; + `w = {x:real^N | x IN u /\ setdist({x},s) = setdist({x},t)}`] THEN + SUBGOAL_THEN `closed_in (subtopology euclidean u) (s':real^N->bool) /\ + closed_in (subtopology euclidean u) (t':real^N->bool)` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN REWRITE_TAC[SET_RULE + `a <= drop(lift x) <=> lift x IN {x | a <= drop x}`] THEN + REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + SIMP_TAC[CLOSED_SING; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST; + drop; CLOSED_HALFSPACE_COMPONENT_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; + ALL_TAC] THEN + SUBGOAL_THEN + `(s:real^N->bool) SUBSET s' /\ (t:real^N->bool) SUBSET t'` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; SETDIST_POS_LE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(s INTER t:real^N->bool) retract_of w` MP_TAC THENL + [MATCH_MP_TAC AR_IMP_ABSOLUTE_RETRACT THEN + EXISTS_TAC `s INTER t:real^N->bool` THEN + ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_INTER] THEN + CONJ_TAC THENL [EXPAND_TAC "w"; ASM SET_TAC[]] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; SETDIST_SING_IN_SET] THEN + ASM SET_TAC[]; + GEN_REWRITE_TAC LAND_CONV [retract_of] THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r0:real^N->real^N` THEN STRIP_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN w ==> (x IN s <=> x IN t)` + ASSUME_TAC THENL + [EXPAND_TAC "w" THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN + DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&0 = setdist p <=> setdist p = &0`] THEN + MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ (p <=> s = {} \/ x IN s) ==> p ==> x IN s`) THEN + (CONJ_TAC THENL + [ASM SET_TAC[]; MATCH_MP_TAC SETDIST_EQ_0_CLOSED_IN]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `s' INTER t':real^N->bool = w` ASSUME_TAC THENL + [ASM SET_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean u) (w:real^N->bool)` + ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_INTER]; ALL_TAC] THEN + ABBREV_TAC `r = \x:real^N. if x IN w then r0 x else x` THEN + SUBGOAL_THEN + `IMAGE (r:real^N->real^N) (w UNION s) SUBSET s /\ + IMAGE (r:real^N->real^N) (w UNION t) SUBSET t` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "r" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(r:real^N->real^N) continuous_on (w UNION s UNION t)` + ASSUME_TAC THENL + [EXPAND_TAC "r" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?g:real^N->real^N. + g continuous_on u /\ + IMAGE g u SUBSET s /\ + !x. x IN w UNION s ==> g x = r x` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC AR_IMP_ABSOLUTE_EXTENSOR THEN + ASM_SIMP_TAC[CLOSED_IN_UNION] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; IN_UNION]; + ALL_TAC] THEN + SUBGOAL_THEN + `?h:real^N->real^N. + h continuous_on u /\ + IMAGE h u SUBSET t /\ + !x. x IN w UNION t ==> h x = r x` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC AR_IMP_ABSOLUTE_EXTENSOR THEN + ASM_SIMP_TAC[CLOSED_IN_UNION] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; IN_UNION]; + ALL_TAC] THEN + REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `\x. if x IN s' then (g:real^N->real^N) x else h x` THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNION] THEN ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION] THEN + STRIP_TAC THEN ASM_SIMP_TAC[IN_UNION; COND_ID] THENL + [COND_CASES_TAC THENL [EXPAND_TAC "r"; ASM SET_TAC[]]; + COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + TRANS_TAC EQ_TRANS `(r:real^N->real^N) x` THEN + CONJ_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "r"]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]] THEN + SUBGOAL_THEN + `u:real^N->bool = s' UNION t'` + (fun th -> ONCE_REWRITE_TAC[th] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + REWRITE_TAC[GSYM th]) + THENL [ASM SET_TAC[REAL_LE_TOTAL]; ASM_SIMP_TAC[]] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]) THEN + REWRITE_TAC[TAUT `p /\ ~p \/ q /\ p <=> p /\ q`] THEN + ASM_SIMP_TAC[GSYM IN_INTER; IN_UNION]) in + REPEAT STRIP_TAC THEN REWRITE_TAC[AR] THEN MAP_EVERY X_GEN_TAC + [`u:real^(N,1)finite_sum->bool`; `c:real^(N,1)finite_sum->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean u) + {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} /\ + closed_in (subtopology euclidean u) + {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t}` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN + EXISTS_TAC `c:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} UNION + {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t} = c` + (fun th -> SUBST1_TAC(SYM th)) THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `AR(s:real^N->bool)`; + UNDISCH_TAC `AR(t:real^N->bool)`; + UNDISCH_TAC `AR(s INTER t:real^N->bool)`] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMEOMORPHIC_ARNESS THEN + REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC + [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]);; + +let ANR_CLOSED_UNION_LOCAL = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + ANR(s) /\ ANR(t) /\ ANR(s INTER t) + ==> ANR(s UNION t)`, + let lemma = prove + (`!s t u:real^N->bool. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + ANR s /\ ANR t /\ ANR(s INTER t) + ==> ?v. open_in (subtopology euclidean u) v /\ + (s UNION t) retract_of v`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY] THENL + [ASM_MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[UNION_EMPTY] THENL + [ASM_MESON_TAC[ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; HOMEOMORPHIC_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `(s:real^N->bool) SUBSET u /\ t SUBSET u` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`s' = {x:real^N | x IN u /\ setdist({x},s) <= setdist({x},t)}`; + `t' = {x:real^N | x IN u /\ setdist({x},t) <= setdist({x},s)}`; + `w = {x:real^N | x IN u /\ setdist({x},s) = setdist({x},t)}`] THEN + SUBGOAL_THEN `closed_in (subtopology euclidean u) (s':real^N->bool) /\ + closed_in (subtopology euclidean u) (t':real^N->bool)` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + ONCE_REWRITE_TAC[GSYM LIFT_DROP] THEN REWRITE_TAC[SET_RULE + `a <= drop(lift x) <=> lift x IN {x | a <= drop x}`] THEN + REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + SIMP_TAC[CLOSED_SING; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST; + drop; CLOSED_HALFSPACE_COMPONENT_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; + ALL_TAC] THEN + SUBGOAL_THEN + `(s:real^N->bool) SUBSET s' /\ (t:real^N->bool) SUBSET t'` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["s'"; "t'"] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; SETDIST_POS_LE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `s' UNION t':real^N->bool = u` ASSUME_TAC THENL + [ASM SET_TAC[REAL_LE_TOTAL]; ALL_TAC] THEN + SUBGOAL_THEN `w SUBSET s' /\ (w:real^N->bool) SUBSET t'` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[REAL_LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `?w' w0. open_in (subtopology euclidean w) w' /\ + closed_in (subtopology euclidean w) w0 /\ + s INTER t SUBSET w' /\ w' SUBSET w0 /\ + (s INTER t:real^N->bool) retract_of w0` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_INTER] THEN + CONJ_TAC THENL [EXPAND_TAC "w"; ASM SET_TAC[]] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; SETDIST_SING_IN_SET] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `closed_in (subtopology euclidean u) (w:real^N->bool)` + ASSUME_TAC THENL + [SUBGOAL_THEN `w = s' INTER t':real^N->bool` SUBST1_TAC THENL + [ASM SET_TAC[REAL_LE_ANTISYM]; ASM_SIMP_TAC[CLOSED_IN_INTER]]; + ALL_TAC] THEN + SUBGOAL_THEN `closed_in (subtopology euclidean u) (w0:real^N->bool)` + ASSUME_TAC THENL [ASM_MESON_TAC[CLOSED_IN_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN + `?u0. open_in (subtopology euclidean u) (u0:real^N->bool) /\ + s INTER t SUBSET u0 /\ + u0 INTER w SUBSET w0` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `z:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + EXISTS_TAC `u INTER z:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r0:real^N->real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `w0 SUBSET (w:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN w ==> (x IN s <=> x IN t)` + ASSUME_TAC THENL + [EXPAND_TAC "w" THEN REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN + DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&0 = setdist p <=> setdist p = &0`] THEN + MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ (p <=> s = {} \/ x IN s) ==> p ==> x IN s`) THEN + (CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC SETDIST_EQ_0_CLOSED_IN]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `r = \x:real^N. if x IN w0 then r0 x else x` THEN + SUBGOAL_THEN + `IMAGE (r:real^N->real^N) (w0 UNION s) SUBSET s /\ + IMAGE (r:real^N->real^N) (w0 UNION t) SUBSET t` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "r" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(r:real^N->real^N) continuous_on (w0 UNION s UNION t)` + ASSUME_TAC THENL + [EXPAND_TAC "r" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_UNION] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`r:real^N->real^N`; + `s':real^N->bool`; + `w0 UNION s:real^N->bool`; + `s:real^N->bool`] + ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN + ASM SET_TAC[]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`w1:real^N->bool`; `g:real^N->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`r:real^N->real^N`; + `t':real^N->bool`; + `w0 UNION t:real^N->bool`; + `t:real^N->bool`] + ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^N->bool` THEN ASM_SIMP_TAC[CLOSED_IN_UNION] THEN + ASM SET_TAC[]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`w2:real^N->bool`; `h:real^N->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `s' INTER t':real^N->bool = w` ASSUME_TAC THENL + [ASM SET_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN + EXISTS_TAC + `(w1 DIFF (w DIFF u0)) UNION (w2 DIFF (w DIFF u0)):real^N->bool` THEN + CONJ_TAC THENL + [UNDISCH_TAC `open_in (subtopology euclidean t') (w2:real^N->bool)` THEN + UNDISCH_TAC `open_in (subtopology euclidean s') (w1:real^N->bool)` THEN + REWRITE_TAC[OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `o1:real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `o2:real^N->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM OPEN_IN_OPEN] THEN + SUBGOAL_THEN + `s' INTER o1 DIFF (w DIFF u0) UNION t' INTER o2 DIFF (w DIFF u0) + :real^N->bool = + ((u DIFF t') INTER o1 UNION (u DIFF s') INTER o2 UNION + u INTER o1 INTER o2) DIFF (w DIFF u0)` + SUBST1_TAC THENL + [REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[CLOSED_IN_DIFF] THEN + REPEAT(MATCH_MP_TAC OPEN_IN_UNION THEN CONJ_TAC) THEN + MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL; OPEN_INTER]; + ALL_TAC] THEN + REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `\x. if x IN s' then g x else (h:real^N->real^N) x` THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ALL_TAC; + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_UNION] THEN + STRIP_TAC THEN ASM_SIMP_TAC[IN_UNION; COND_ID] THENL + [COND_CASES_TAC THENL [EXPAND_TAC "r"; ASM SET_TAC[]]; + COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + TRANS_TAC EQ_TRANS `(r:real^N->real^N) x` THEN + CONJ_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "r"]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `closed_in (subtopology euclidean u) (s':real^N->bool)` THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + UNDISCH_TAC `closed_in (subtopology euclidean u) (t':real^N->bool)` THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]]) in + REPEAT STRIP_TAC THEN REWRITE_TAC[ANR] THEN MAP_EVERY X_GEN_TAC + [`u:real^(N,1)finite_sum->bool`; `c:real^(N,1)finite_sum->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean u) + {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} /\ + closed_in (subtopology euclidean u) + {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t}` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_TRANS THEN + EXISTS_TAC `c:real^(N,1)finite_sum->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN s} UNION + {x | x IN c /\ (g:real^(N,1)finite_sum->real^N) x IN t} = c` + (fun th -> SUBST1_TAC(SYM th)) THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `ANR(s:real^N->bool)`; + UNDISCH_TAC `ANR(t:real^N->bool)`; + UNDISCH_TAC `ANR(s INTER t:real^N->bool)`] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HOMEOMORPHIC_ANRNESS THEN + REWRITE_TAC[homeomorphic; homeomorphism] THEN MAP_EVERY EXISTS_TAC + [`f:real^N->real^(N,1)finite_sum`; `g:real^(N,1)finite_sum->real^N`] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]);; + +let AR_CLOSED_UNION = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ AR(s) /\ AR(t) /\ AR(s INTER t) + ==> AR(s UNION t)`, + MESON_TAC[AR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);; + +let ANR_CLOSED_UNION = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ ANR(s) /\ ANR(t) /\ ANR(s INTER t) + ==> ANR(s UNION t)`, + MESON_TAC[ANR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);; + +let ENR_CLOSED_UNION_LOCAL = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + ENR(s) /\ ENR(t) /\ ENR(s INTER t) + ==> ENR(s UNION t)`, + SIMP_TAC[ENR_ANR; ANR_CLOSED_UNION_LOCAL; LOCALLY_COMPACT_CLOSED_UNION]);; + +let ENR_CLOSED_UNION = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ ENR(s) /\ ENR(t) /\ ENR(s INTER t) + ==> ENR(s UNION t)`, + MESON_TAC[ENR_CLOSED_UNION_LOCAL; CLOSED_SUBSET; SUBSET_UNION]);; + +let ABSOLUTE_RETRACT_UNION = prove + (`!s t. s retract_of (:real^N) /\ + t retract_of (:real^N) /\ + (s INTER t) retract_of (:real^N) + ==> (s UNION t) retract_of (:real^N)`, + SIMP_TAC[RETRACT_OF_UNIV; AR_CLOSED_UNION; CLOSED_UNION]);; + +let RETRACT_FROM_UNION_AND_INTER = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + (s UNION t) retract_of u /\ (s INTER t) retract_of t + ==> s retract_of u`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC `(s UNION t) retract_of (u:real^N->bool)` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] RETRACT_OF_TRANS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; retract_of] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^N. if x IN s then x else r x` THEN + SIMP_TAC[] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN ASM SET_TAC[]);; + +let AR_FROM_UNION_AND_INTER_LOCAL = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + AR(s UNION t) /\ AR(s INTER t) + ==> AR(s) /\ AR(t)`, + SUBGOAL_THEN + `!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + AR(s UNION t) /\ AR(s INTER t) + ==> AR(s)` + MP_TAC THENL [ALL_TAC; MESON_TAC[UNION_COMM; INTER_COMM]] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_RETRACT_OF_AR THEN + EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC RETRACT_FROM_UNION_AND_INTER THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[RETRACT_OF_REFL] THEN + MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `s UNION t:real^N->bool` THEN + REWRITE_TAC[INTER_SUBSET; SUBSET_UNION] THEN + MATCH_MP_TAC AR_IMP_RETRACT THEN ASM_SIMP_TAC[CLOSED_IN_INTER]);; + +let AR_FROM_UNION_AND_INTER = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ AR(s UNION t) /\ AR(s INTER t) + ==> AR(s) /\ AR(t)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC AR_FROM_UNION_AND_INTER_LOCAL THEN + ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);; + +let ANR_FROM_UNION_AND_INTER_LOCAL = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + ANR(s UNION t) /\ ANR(s INTER t) + ==> ANR(s) /\ ANR(t)`, + SUBGOAL_THEN + `!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + ANR(s UNION t) /\ ANR(s INTER t) + ==> ANR(s)` + MP_TAC THENL [ALL_TAC; MESON_TAC[UNION_COMM; INTER_COMM]] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ANR_NEIGHBORHOOD_RETRACT THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `s UNION t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s INTER t:real^N->bool`; `s UNION t:real^N->bool`] + ANR_IMP_NEIGHBOURHOOD_RETRACT) THEN + ASM_SIMP_TAC[CLOSED_IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + EXISTS_TAC `s UNION u:real^N->bool` THEN CONJ_TAC THENL + [ALL_TAC; + SUBGOAL_THEN + `s UNION u:real^N->bool = + ((s UNION t) DIFF t) UNION u` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[OPEN_IN_UNION; OPEN_IN_DIFF; OPEN_IN_REFL]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retract_of; retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^N. if x IN s then x else r x` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + SUBGOAL_THEN `s UNION u:real^N->bool = s UNION (u INTER t)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]] THEN + CONJ_TAC THENL + [UNDISCH_TAC + `closed_in(subtopology euclidean (s UNION t)) (s:real^N->bool)`; + UNDISCH_TAC + `closed_in(subtopology euclidean (s UNION t)) (t:real^N->bool)`] THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]);; + +let ANR_FROM_UNION_AND_INTER = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ ANR(s UNION t) /\ ANR(s INTER t) + ==> ANR(s) /\ ANR(t)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC ANR_FROM_UNION_AND_INTER_LOCAL THEN + ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);; + +let ANR_FINITE_UNIONS_CONVEX_CLOSED = prove + (`!t:(real^N->bool)->bool. + FINITE t /\ (!c. c IN t ==> closed c /\ convex c) ==> ANR(UNIONS t)`, + GEN_TAC THEN WF_INDUCT_TAC `CARD(t:(real^N->bool)->bool)` THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[TAUT `p ==> q /\ r ==> s <=> q ==> p ==> r ==> s`] THEN + SPEC_TAC(`t:(real^N->bool)->bool`,`t:(real^N->bool)->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; FORALL_IN_INSERT] THEN + REWRITE_TAC[ANR_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `t:(real^N->bool)->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ANR_CLOSED_UNION THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN + ASM_SIMP_TAC[CONVEX_IMP_ANR] THEN REWRITE_TAC[INTER_UNIONS] THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN + REWRITE_TAC[FORALL_IN_GSPEC; LT_SUC_LE; LE_REFL] THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; CLOSED_INTER; CONVEX_INTER] THEN + ASM_SIMP_TAC[CARD_IMAGE_LE]);; + +let FINITE_IMP_ANR = prove + (`!s:real^N->bool. FINITE s ==> ANR s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `s = UNIONS {{a:real^N} | a IN s}` SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]; + MATCH_MP_TAC ANR_FINITE_UNIONS_CONVEX_CLOSED THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; SIMPLE_IMAGE; FINITE_IMAGE] THEN + REWRITE_TAC[CLOSED_SING; CONVEX_SING]]);; + +let ANR_INSERT = prove + (`!s a:real^N. closed s /\ ANR s ==> ANR(a INSERT s)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + MATCH_MP_TAC ANR_CLOSED_UNION THEN + ASM_MESON_TAC[CLOSED_SING; ANR_SING; ANR_EMPTY; + SET_RULE `{a} INTER s = {a} \/ {a} INTER s = {}`]);; + +let ANR_TRIANGULATION = prove + (`!tr. triangulation tr ==> ANR(UNIONS tr)`, + REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ANR_FINITE_UNIONS_CONVEX_CLOSED THEN + ASM_MESON_TAC[CLOSED_SIMPLEX; CONVEX_SIMPLEX]);; + +let ANR_SIMPLICIAL_COMPLEX = prove + (`!c. simplicial_complex c ==> ANR(UNIONS c)`, + MESON_TAC[ANR_TRIANGULATION; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);; + +let ANR_PATH_COMPONENT_ANR = prove + (`!s x:real^N. ANR(s) ==> ANR(path_component s x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + ANR_OPEN_IN)) THEN + MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN + ASM_SIMP_TAC[ANR_IMP_LOCALLY_PATH_CONNECTED]);; + +let ANR_CONNECTED_COMPONENT_ANR = prove + (`!s x:real^N. ANR(s) ==> ANR(connected_component s x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + ANR_OPEN_IN)) THEN + MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN + ASM_SIMP_TAC[ANR_IMP_LOCALLY_CONNECTED]);; + +let ANR_COMPONENT_ANR = prove + (`!s:real^N->bool. + ANR s /\ c IN components s ==> ANR c`, + REWRITE_TAC[IN_COMPONENTS] THEN MESON_TAC[ANR_CONNECTED_COMPONENT_ANR]);; + +(* ------------------------------------------------------------------------- *) +(* Original ANR material, now for ENRs. Eventually more of this will be *) +(* updated and generalized for AR and ANR as well. *) +(* ------------------------------------------------------------------------- *) + +let ENR_BOUNDED = prove + (`!s:real^N->bool. + bounded s + ==> (ENR s <=> ?u. open u /\ bounded u /\ s retract_of u)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ENR] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(vec 0:real^N,r) INTER u` THEN + ASM_SIMP_TAC[BOUNDED_INTER; OPEN_INTER; OPEN_BALL; BOUNDED_BALL] THEN + MATCH_MP_TAC RETRACT_OF_SUBSET THEN EXISTS_TAC `u:real^N->bool` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + ASM SET_TAC[]);; + +let ABSOLUTE_RETRACT_IMP_AR_GEN = prove + (`!s:real^M->bool s':real^N->bool t u. + s retract_of t /\ convex t /\ ~(t = {}) /\ + s homeomorphic s' /\ closed_in (subtopology euclidean u) s' + ==> s' retract_of u`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`s:real^M->bool`; `t:real^M->bool`] + AR_RETRACT_OF_AR) THEN ASM_SIMP_TAC[CONVEX_IMP_AR] THEN + ASM_MESON_TAC[AR_IMP_ABSOLUTE_RETRACT]);; + +let ABSOLUTE_RETRACT_IMP_AR = prove + (`!s s'. s retract_of (:real^M) /\ s homeomorphic s' /\ closed s' + ==> s' retract_of (:real^N)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTE_RETRACT_IMP_AR_GEN THEN + MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `(:real^M)`] THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + REWRITE_TAC[CONVEX_UNIV; CLOSED_UNIV; UNIV_NOT_EMPTY]);; + +let HOMEOMORPHIC_COMPACT_ARNESS = prove + (`!s s'. s homeomorphic s' + ==> (compact s /\ s retract_of (:real^M) <=> + compact s' /\ s' retract_of (:real^N))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `compact(s:real^M->bool) /\ compact(s':real^N->bool)` THENL + [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS]] THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTE_RETRACT_IMP_AR) THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM; COMPACT_IMP_CLOSED]);; + +let EXTENSION_INTO_AR_LOCAL = prove + (`!f:real^M->real^N c s t. + f continuous_on c /\ IMAGE f c SUBSET t /\ t retract_of (:real^N) /\ + closed_in (subtopology euclidean s) c + ==> ?g. g continuous_on s /\ IMAGE g (:real^M) SUBSET t /\ + !x. x IN c ==> g x = f x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`] + TIETZE_UNBOUNDED) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(r:real^N->real^N) o (g:real^M->real^N)` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; + +let EXTENSION_INTO_AR = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ t retract_of (:real^N) /\ + closed s + ==> ?g. g continuous_on (:real^M) /\ IMAGE g (:real^M) SUBSET t /\ + !x. x IN s ==> g x = f x`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`; `t:real^N->bool`] + EXTENSION_INTO_AR_LOCAL) THEN + REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV]);; + +let NEIGHBOURHOOD_EXTENSION_INTO_ANR = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ ANR t /\ closed s + ==> ?v g. s SUBSET v /\ open v /\ g continuous_on v /\ + IMAGE g v SUBSET t /\ !x. x IN s ==> g x = f x`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `(:real^M)`; `s:real^M->bool`; `t:real^N->bool`] + ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + REWRITE_TAC[GSYM OPEN_IN; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN + CONV_TAC TAUT);; + +let EXTENSION_FROM_COMPONENT = prove + (`!f:real^M->real^N s c u. + (locally connected s \/ compact s /\ ANR u) /\ + c IN components s /\ + f continuous_on c /\ IMAGE f c SUBSET u + ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ + !x. x IN c ==> g x = f x`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN + `?t g. open_in (subtopology euclidean s) t /\ + closed_in (subtopology euclidean s) t /\ + c SUBSET t /\ + (g:real^M->real^N) continuous_on t /\ IMAGE g t SUBSET u /\ + !x. x IN c ==> g x = f x` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [MAP_EVERY EXISTS_TAC [`c:real^M->bool`; `f:real^M->real^N`] THEN + ASM_SIMP_TAC[SUBSET_REFL; CLOSED_IN_COMPONENT; + OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `c:real^M->bool`; + `u:real^N->bool`] + ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + ASM_SIMP_TAC[CLOSED_IN_COMPONENT; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `v:real^M->bool`] + SURA_BURA_CLOPEN_SUBSET) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN + EXISTS_TAC `g:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_SUBSET THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM SET_TAC[]; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM SET_TAC[]]]; + MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`; + `t:real^M->bool`; `u:real^N->bool`] + EXTENSION_FROM_CLOPEN) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + ASM SET_TAC[]]);; + +let ABSOLUTE_RETRACT_FROM_UNION_AND_INTER = prove + (`!s t. (s UNION t) retract_of (:real^N) /\ + (s INTER t) retract_of (:real^N) /\ + closed s /\ closed t + ==> s retract_of (:real^N)`, + MESON_TAC[RETRACT_OF_UNIV; AR_FROM_UNION_AND_INTER]);; + +let COUNTABLE_ENR_COMPONENTS = prove + (`!s:real^N->bool. ENR s ==> COUNTABLE(components s)`, + SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_COMPONENTS]);; + +let COUNTABLE_ENR_CONNECTED_COMPONENTS = prove + (`!s:real^N->bool t. + ENR s ==> COUNTABLE {connected_component s x | x | x IN t}`, + SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_CONNECTED_COMPONENTS]);; + +let COUNTABLE_ENR_PATH_COMPONENTS = prove + (`!s:real^N->bool. + ENR s ==> COUNTABLE {path_component s x | x | x IN s}`, + SIMP_TAC[ENR_IMP_ANR; COUNTABLE_ANR_PATH_COMPONENTS]);; + +let ENR_FROM_UNION_AND_INTER_GEN = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + ENR(s UNION t) /\ ENR(s INTER t) + ==> ENR s`, + REWRITE_TAC[ENR_ANR] THEN + MESON_TAC[LOCALLY_COMPACT_CLOSED_IN; ANR_FROM_UNION_AND_INTER_LOCAL]);; + +let ENR_FROM_UNION_AND_INTER = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ ENR(s UNION t) /\ ENR(s INTER t) + ==> ENR s`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC ENR_FROM_UNION_AND_INTER_GEN THEN + ASM_MESON_TAC[CLOSED_SUBSET; SUBSET_UNION]);; + +let ENR_FINITE_UNIONS_CONVEX_CLOSED = prove + (`!t:(real^N->bool)->bool. + FINITE t /\ (!c. c IN t ==> closed c /\ convex c) ==> ENR(UNIONS t)`, + SIMP_TAC[ENR_ANR; ANR_FINITE_UNIONS_CONVEX_CLOSED] THEN + SIMP_TAC[CLOSED_IMP_LOCALLY_COMPACT; CLOSED_UNIONS]);; + +let FINITE_IMP_ENR = prove + (`!s:real^N->bool. FINITE s ==> ENR s`, + SIMP_TAC[FINITE_IMP_ANR; FINITE_IMP_CLOSED; ENR_ANR; + CLOSED_IMP_LOCALLY_COMPACT]);; + +let ENR_INSERT = prove + (`!s a:real^N. closed s /\ ENR s ==> ENR(a INSERT s)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + MATCH_MP_TAC ENR_CLOSED_UNION THEN + ASM_MESON_TAC[CLOSED_SING; ENR_SING; ENR_EMPTY; + SET_RULE `{a} INTER s = {a} \/ {a} INTER s = {}`]);; + +let ENR_TRIANGULATION = prove + (`!tr. triangulation tr ==> ENR(UNIONS tr)`, + REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ENR_FINITE_UNIONS_CONVEX_CLOSED THEN + ASM_MESON_TAC[CLOSED_SIMPLEX; CONVEX_SIMPLEX]);; + +let ENR_SIMPLICIAL_COMPLEX = prove + (`!c. simplicial_complex c ==> ENR(UNIONS c)`, + MESON_TAC[ENR_TRIANGULATION; SIMPLICIAL_COMPLEX_IMP_TRIANGULATION]);; + +let ENR_PATH_COMPONENT_ENR = prove + (`!s x:real^N. ENR(s) ==> ENR(path_component s x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + ENR_OPEN_IN)) THEN + MATCH_MP_TAC OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED THEN + MATCH_MP_TAC RETRACT_OF_LOCALLY_PATH_CONNECTED THEN + ASM_MESON_TAC[ENR; OPEN_IMP_LOCALLY_PATH_CONNECTED]);; + +let ENR_CONNECTED_COMPONENT_ENR = prove + (`!s x:real^N. ENR(s) ==> ENR(connected_component s x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + ENR_OPEN_IN)) THEN + MATCH_MP_TAC OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED THEN + MATCH_MP_TAC RETRACT_OF_LOCALLY_CONNECTED THEN + ASM_MESON_TAC[ENR; OPEN_IMP_LOCALLY_CONNECTED]);; + +let ENR_COMPONENT_ENR = prove + (`!s:real^N->bool. + ENR s /\ c IN components s ==> ENR c`, + REWRITE_TAC[IN_COMPONENTS] THEN MESON_TAC[ENR_CONNECTED_COMPONENT_ENR]);; + +let ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT = prove + (`!s:real^N->bool t u:real^M->bool. + s homeomorphic u /\ ~(s = {}) /\ s SUBSET t /\ convex u /\ compact u + ==> s retract_of t`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`u:real^M->bool`; `t:real^N->bool`; `s:real^N->bool`] + AR_IMP_ABSOLUTE_RETRACT) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[CONVEX_IMP_AR; HOMEOMORPHIC_EMPTY; HOMEOMORPHIC_SYM; + CLOSED_SUBSET; COMPACT_IMP_CLOSED; HOMEOMORPHIC_COMPACTNESS]);; + +let ABSOLUTE_RETRACT_PATH_IMAGE_ARC = prove + (`!g s:real^N->bool. + arc g /\ path_image g SUBSET s ==> (path_image g) retract_of s`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPECL [`path_image g:real^N->bool`; `s:real^N->bool`; + `interval[vec 0:real^1,vec 1:real^1]`] + ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN + REWRITE_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL] THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + EXISTS_TAC `g:real^1->real^N` THEN + RULE_ASSUM_TAC(REWRITE_RULE[arc; path; path_image]) THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL; path_image]);; + +let RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX = prove + (`!s t a:real^N. + convex s /\ convex t /\ bounded s /\ a IN relative_interior s /\ + relative_frontier s SUBSET t /\ t SUBSET affine hull s + ==> ?r. homotopic_with (\x. T) (t DELETE a,t DELETE a) (\x. x) r /\ + retraction (t DELETE a,relative_frontier s) r`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + RAY_TO_RELATIVE_FRONTIER) THEN + ASM_SIMP_TAC[relative_frontier; VECTOR_ADD_LID] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM; retraction] THEN + X_GEN_TAC `dd:real^N->real` THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^N. a + dd(x - a) % (x - a)` THEN + SUBGOAL_THEN + `((\x:real^N. a + dd x % x) o (\x. x - a)) continuous_on t DELETE a` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `affine hull s DELETE (a:real^N)` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + SIMP_TAC[VECTOR_ARITH `x - a:real^N = y - a <=> x = y`; VECTOR_SUB_REFL; + SET_RULE `(!x y. f x = f y <=> x = y) + ==> IMAGE f (s DELETE a) = IMAGE f s DELETE f a`] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION THEN + EXISTS_TAC `relative_frontier (IMAGE (\x:real^N. x - a) s)` THEN + ASM_SIMP_TAC[COMPACT_RELATIVE_FRONTIER_BOUNDED; + VECTOR_ARITH `x - a:real^N = --a + x`; + RELATIVE_FRONTIER_TRANSLATION; COMPACT_TRANSLATION_EQ] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ ~(a IN IMAGE f s) + ==> IMAGE f s SUBSET IMAGE f t DELETE a`) THEN + REWRITE_TAC[IN_IMAGE; UNWIND_THM2; + VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + ASM_REWRITE_TAC[relative_frontier; IN_DIFF] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN + REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]; + MATCH_MP_TAC SUBSPACE_IMP_CONIC THEN + MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN + SIMP_TAC[AFFINE_TRANSLATION; AFFINE_AFFINE_HULL; IN_IMAGE] THEN + REWRITE_TAC[UNWIND_THM2; + VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IN_DELETE; IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`] THEN + MAP_EVERY X_GEN_TAC [`k:real`; `x:real^N`] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE; UNWIND_THM2; relative_frontier; VECTOR_ARITH + `y:real^N = --a + x <=> x = a + y`] THEN + EQ_TAC THENL + [STRIP_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; + VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]] THEN + MATCH_MP_TAC(REAL_ARITH `~(a < b) /\ ~(b < a) ==> a = b`) THEN + CONJ_TAC THEN DISCH_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN c DIFF i ==> x IN i ==> F`)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; VECTOR_ARITH `a + --a + x:real^N = x`; + VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `a + k % (--a + x):real^N`] + IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_DIFF]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_SEGMENT; NOT_FORALL_THM] THEN + EXISTS_TAC `a + dd(--a + x) % (--a + x):real^N` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a:real^N = a + k % (--a + x) <=> + k % (x - a) = vec 0`] THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [EXISTS_TAC `(dd:real^N->real) (--a + x) / k` THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID] THEN + REWRITE_TAC[VECTOR_ARITH `a + b:real^N = (&1 - u) % a + u % c <=> + b = u % (c - a)`] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_SUB; REAL_DIV_RMUL; + REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SET_RULE + `a IN closure s /\ ~(a IN relative_interior s) + ==> ~(a IN relative_interior s)`)] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; + VECTOR_ARITH `--a + x:real^N = vec 0 <=> x = a`]]; + REWRITE_TAC[o_DEF] THEN STRIP_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC; IN_DELETE] THEN + REPEAT(GEN_TAC THEN STRIP_TAC) THEN CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [convex]) THEN + ASM_REWRITE_TAC[REAL_ARITH `&1 - u + u = &1`; REAL_SUB_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[relative_frontier] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + x - a:real^N = x`; VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[HULL_SUBSET; RELATIVE_INTERIOR_SUBSET; SUBSET]; + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH + `(&1 - u) % x + u % (a + d % (x - a)):real^N = a <=> + (&1 - u + u * d) % (x - a) = vec 0`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &0 <= u /\ u <= &1 /\ ~(x = &0 /\ u = &1) + ==> ~(&1 - u + x = &0)`) THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_ARITH + `(u = &0 \/ d = &0) /\ u = &1 <=> d = &0 /\ u = &1`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE; + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0 /\ u = &1)`)] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN + ASM SET_TAC[]]; + RULE_ASSUM_TAC(REWRITE_RULE[relative_frontier]) THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SET_RULE + `!s t. s SUBSET t /\ IMAGE f (t DELETE a) SUBSET u + ==> IMAGE f (s DELETE a) SUBSET u`) THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `dd(x - a:real^N) = &1` + (fun th -> REWRITE_TAC[th] THEN CONV_TAC VECTOR_ARITH) THEN + MATCH_MP_TAC(REAL_ARITH `~(d < &1) /\ ~(&1 < d) ==> d = &1`) THEN + CONJ_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT) + THENL + [DISCH_THEN(MP_TAC o SPEC `x:real^N`); + DISCH_THEN(MP_TAC o SPEC `a + dd(x - a) % (x - a):real^N`)] THEN + ASM_REWRITE_TAC[SUBSET; NOT_IMP; IN_SEGMENT; NOT_FORALL_THM] THENL + [EXISTS_TAC `a + dd(x - a) % (x - a):real^N` THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH + `a + d % (x - a):real^N = (&1 - u) % a + u % x <=> + (u - d) % (x - a) = vec 0`] THEN + CONJ_TAC THENL + [EXISTS_TAC `(dd:real^N->real)(x - a)` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SET_RULE + `x IN closure s DIFF relative_interior s + ==> ~(x IN relative_interior s)`)] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN + ASM_MESON_TAC[CLOSURE_SUBSET_AFFINE_HULL; SUBSET]; + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `x IN closure s DIFF relative_interior s + ==> x IN closure s`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_ARITH `a + x - a:real^N = x`] THEN + ASM_MESON_TAC[CLOSURE_SUBSET_AFFINE_HULL; SUBSET]; + EXISTS_TAC `x:real^N` THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; VECTOR_MUL_EQ_0; + VECTOR_ARITH `a = a + d <=> d:real^N = vec 0`; + VECTOR_ARITH `x:real^N = (&1 - u) % a + u % (a + d % (x - a)) <=> + (u * d - &1) % (x - a) = vec 0`] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + EXISTS_TAC `inv((dd:real^N->real)(x - a))` THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_SUB_REFL; REAL_LT_INV_EQ] THEN + ASM_SIMP_TAC[REAL_INV_LT_1] THEN ASM_REAL_ARITH_TAC]]]);; + +let RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL = prove + (`!s a:real^N. + convex s /\ bounded s /\ a IN relative_interior s + ==> relative_frontier s retract_of (affine hull s DELETE a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `affine hull s:real^N->bool`; `a:real^N`] + RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX) THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; SUBSET_REFL] THEN + REWRITE_TAC[retract_of] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[relative_frontier] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN + REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]);; + +let RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL = prove + (`!s a:real^N. + convex s /\ compact s /\ a IN relative_interior s + ==> (s DIFF relative_interior s) retract_of + (affine hull s DELETE a)`, + MP_TAC RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[relative_frontier; COMPACT_IMP_BOUNDED; COMPACT_IMP_CLOSED; + CLOSURE_CLOSED]);; + +let PATH_CONNECTED_SPHERE_GEN = prove + (`!s:real^N->bool. + convex s /\ bounded s /\ ~(aff_dim s = &1) + ==> path_connected(relative_frontier s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `relative_interior s:real^N->bool = {}` THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY; PATH_CONNECTED_EMPTY; + RELATIVE_FRONTIER_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC RETRACT_OF_PATH_CONNECTED THEN + EXISTS_TAC `affine hull s DELETE (a:real^N)` THEN + ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; AFFINE_AFFINE_HULL; + AFFINE_IMP_CONVEX; AFF_DIM_AFFINE_HULL; + RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL]]);; + +let CONNECTED_SPHERE_GEN = prove + (`!s:real^N->bool. + convex s /\ bounded s /\ ~(aff_dim s = &1) + ==> connected(relative_frontier s)`, + SIMP_TAC[PATH_CONNECTED_SPHERE_GEN; PATH_CONNECTED_IMP_CONNECTED]);; + +let ENR_RELATIVE_FRONTIER_CONVEX = prove + (`!s:real^N->bool. bounded s /\ convex s ==> ENR(relative_frontier s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[ENR; RELATIVE_FRONTIER_EMPTY] THENL + [ASM_MESON_TAC[RETRACT_OF_REFL; OPEN_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `{x | x IN (:real^N) /\ + closest_point (affine hull s) x IN + ((:real^N) DELETE a)}` THEN + CONJ_TAC THENL + [REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `(:real^N)` THEN + SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL; SUBSET_UNIV; ETA_AX]; + MATCH_MP_TAC RETRACT_OF_TRANS THEN + EXISTS_TAC `(affine hull s) DELETE (a:real^N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `closest_point (affine hull s:real^N->bool)` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_UNIV; CLOSEST_POINT_SELF; + CLOSEST_POINT_IN_SET; AFFINE_HULL_EQ_EMPTY; + CLOSED_AFFINE_HULL]]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; + CLOSED_AFFINE_HULL; AFFINE_HULL_EQ_EMPTY]);; + +let ANR_RELATIVE_FRONTIER_CONVEX = prove + (`!s:real^N->bool. bounded s /\ convex s ==> ANR(relative_frontier s)`, + SIMP_TAC[ENR_IMP_ANR; ENR_RELATIVE_FRONTIER_CONVEX]);; + +let FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE = prove + (`!s a. convex s /\ bounded s /\ a IN interior s + ==> (frontier s) retract_of ((:real^N) DELETE a)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE + `a IN s ==> ~(s = {})`)) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN + ASM_SIMP_TAC[RELATIVE_FRONTIER_NONEMPTY_INTERIOR; + RELATIVE_INTERIOR_NONEMPTY_INTERIOR; + AFFINE_HULL_NONEMPTY_INTERIOR]);; + +let SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN = prove + (`!a r b:real^N. + b IN ball(a,r) ==> sphere(a,r) retract_of ((:real^N) DELETE b)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FRONTIER_CBALL] THEN + MATCH_MP_TAC FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; INTERIOR_CBALL]);; + +let SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE = prove + (`!a r. &0 < r ==> sphere(a,r) retract_of ((:real^N) DELETE a)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL]);; + +let ENR_SPHERE = prove + (`!a:real^N r. ENR(sphere(a,r))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < r` THENL + [REWRITE_TAC[ENR] THEN EXISTS_TAC `(:real^N) DELETE a` THEN + ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; + OPEN_DELETE; OPEN_UNIV]; + ASM_MESON_TAC[FINITE_IMP_ENR; REAL_NOT_LE; FINITE_SPHERE]]);; + +let ANR_SPHERE = prove + (`!a:real^N r. ANR(sphere(a,r))`, + SIMP_TAC[ENR_SPHERE; ENR_IMP_ANR]);; + +let LOCALLY_PATH_CONNECTED_SPHERE_GEN = prove + (`!s:real^N->bool. + bounded s /\ convex s ==> locally path_connected (relative_frontier s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `relative_interior(s:real^N->bool) = {}` THENL + [UNDISCH_TAC `relative_interior(s:real^N->bool) = {}` THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN + REWRITE_TAC[LOCALLY_EMPTY; RELATIVE_FRONTIER_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + MATCH_MP_TAC RETRACT_OF_LOCALLY_PATH_CONNECTED THEN + EXISTS_TAC `(affine hull s) DELETE (a:real^N)` THEN + ASM_SIMP_TAC[RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL] THEN + MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN + SIMP_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; AFFINE_IMP_CONVEX; + AFFINE_AFFINE_HULL]]);; + +let LOCALLY_CONNECTED_SPHERE_GEN = prove + (`!s:real^N->bool. + bounded s /\ convex s ==> locally connected (relative_frontier s)`, + SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN; + LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; + +let LOCALLY_PATH_CONNECTED_SPHERE = prove + (`!a:real^N r. locally path_connected (sphere(a,r))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `cball(a:real^N,r)` LOCALLY_PATH_CONNECTED_SPHERE_GEN) THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[SPHERE_SING; LOCALLY_SING; PATH_CONNECTED_SING; + BOUNDED_CBALL; CONVEX_CBALL]);; + +let LOCALLY_CONNECTED_SPHERE = prove + (`!a:real^N r. locally connected(sphere(a,r))`, + SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE; + LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; + +let ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE = prove + (`!s:real^N->bool t. + convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t + ==> ?r. retraction (t,s) r /\ + !x. x IN (affine hull s) DIFF (relative_interior s) + ==> r(x) IN relative_frontier s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[retraction] THEN + EXISTS_TAC `closest_point(s:real^N->bool)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; CLOSEST_POINT_SELF] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_IN_SET] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN + ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET]);; + +let ABSOLUTE_RETRACTION_CONVEX_CLOSED = prove + (`!s:real^N->bool t. + convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t + ==> ?r. retraction (t,s) r /\ + (!x. ~(x IN s) ==> r(x) IN frontier s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[retraction] THEN + EXISTS_TAC `closest_point(s:real^N->bool)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; CLOSEST_POINT_SELF] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; CLOSEST_POINT_IN_SET] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSEST_POINT_IN_FRONTIER THEN + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]);; + +let ABSOLUTE_RETRACT_CONVEX_CLOSED = prove + (`!s:real^N->bool t. + convex s /\ closed s /\ ~(s = {}) /\ s SUBSET t + ==> s retract_of t`, + REWRITE_TAC[retract_of] THEN MESON_TAC[ABSOLUTE_RETRACTION_CONVEX_CLOSED]);; + +let ABSOLUTE_RETRACT_CONVEX = prove + (`!s u:real^N->bool. + convex s /\ ~(s = {}) /\ closed_in (subtopology euclidean u) s + ==> s retract_of u`, + REPEAT STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN + MP_TAC(ISPECL [`\x:real^N. x`; `s:real^N->bool`; `u:real^N->bool`; + `s:real^N->bool`] DUGUNDJI) THEN + ASM_MESON_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL; + CLOSED_IN_IMP_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Borsuk homotopy extension thorem. It's only this late so we can use the *) +(* concept of retraction, saying that the domain sets or range set are ENRs. *) +(* ------------------------------------------------------------------------- *) + +let BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC = prove + (`!f:real^M->real^N g s t u. + closed_in (subtopology euclidean t) s /\ + (ANR s /\ ANR t \/ ANR u) /\ + f continuous_on t /\ IMAGE f t SUBSET u /\ + homotopic_with (\x. T) (s,u) f g + ==> ?g'. homotopic_with (\x. T) (t,u) f g' /\ + g' continuous_on t /\ IMAGE g' t SUBSET u /\ + !x. x IN s ==> g'(x) = g(x)`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + MAP_EVERY ABBREV_TAC + [`h' = \z. if sndcart z IN s then (h:real^(1,M)finite_sum->real^N) z + else f(sndcart z)`; + `B:real^(1,M)finite_sum->bool = + {vec 0} PCROSS t UNION interval[vec 0,vec 1] PCROSS s`] THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean (interval[vec 0:real^1,vec 1] PCROSS t)) + ({vec 0} PCROSS (t:real^M->bool)) /\ + closed_in (subtopology euclidean (interval[vec 0:real^1,vec 1] PCROSS t)) + (interval[vec 0,vec 1] PCROSS s)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN + ASM_REWRITE_TAC[CLOSED_IN_SING; CLOSED_IN_REFL; ENDS_IN_UNIT_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN `(h':real^(1,M)finite_sum->real^N) continuous_on B` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["h'"; "B"] THEN ONCE_REWRITE_TAC[UNION_COMM] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN + ASM_REWRITE_TAC[SING_SUBSET; SUBSET_REFL; ENDS_IN_UNIT_INTERVAL]; + ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING; + SNDCART_PASTECART; TAUT `(p /\ q) /\ ~q <=> F`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON; + IMAGE_SNDCART_PCROSS; NOT_INSERT_EMPTY]]; + ALL_TAC] THEN + SUBGOAL_THEN `IMAGE (h':real^(1,M)finite_sum->real^N) B SUBSET u` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["h'"; "B"] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; + SNDCART_PASTECART; PASTECART_IN_PCROSS; IN_UNION; IN_SING] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[COND_ID] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o SIMP_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `?V k:real^(1,M)finite_sum->real^N. + B SUBSET V /\ + open_in (subtopology euclidean (interval [vec 0,vec 1] PCROSS t)) V /\ + k continuous_on V /\ + IMAGE k V SUBSET u /\ + (!x. x IN B ==> k x = h' x)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [SUBGOAL_THEN `ANR(B:real^(1,M)finite_sum->bool)` MP_TAC THENL + [EXPAND_TAC "B" THEN MATCH_MP_TAC ANR_CLOSED_UNION_LOCAL THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_IN_SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN + ASM_REWRITE_TAC[SING_SUBSET; SUBSET_REFL; ENDS_IN_UNIT_INTERVAL]; + ASM_SIMP_TAC[INTER_PCROSS; SET_RULE `s SUBSET t ==> t INTER s = s`; + ENDS_IN_UNIT_INTERVAL; + SET_RULE `a IN s ==> {a} INTER s = {a}`] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC ANR_PCROSS THEN + ASM_REWRITE_TAC[ANR_INTERVAL; ANR_SING]]; + DISCH_THEN(MP_TAC o SPEC + `interval[vec 0:real^1,vec 1] PCROSS (t:real^M->bool)` o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] + ANR_IMP_NEIGHBOURHOOD_RETRACT)) THEN + ANTS_TAC THENL + [EXPAND_TAC "B" THEN MATCH_MP_TAC CLOSED_IN_UNION THEN + CONJ_TAC THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL; CLOSED_IN_SING; + ENDS_IN_UNIT_INTERVAL]; + MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `V:real^(1,M)finite_sum->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^(1,M)finite_sum->real^(1,M)finite_sum` THEN + STRIP_TAC THEN + EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) o + (r:real^(1,M)finite_sum->real^(1,M)finite_sum)` THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; + MATCH_MP_TAC ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR THEN + ASM_SIMP_TAC[] THEN EXPAND_TAC "B" THEN + ASM_SIMP_TAC[CLOSED_IN_UNION]]; + ABBREV_TAC `s' = {x | ?u. u IN interval[vec 0,vec 1] /\ + pastecart (u:real^1) (x:real^M) IN + interval [vec 0,vec 1] PCROSS t DIFF V}` THEN + SUBGOAL_THEN `closed_in (subtopology euclidean t) (s':real^M->bool)` + ASSUME_TAC THENL + [EXPAND_TAC "s'" THEN MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN MATCH_MP_TAC CLOSED_IN_DIFF THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^M->bool`; `s':real^M->bool`; `t:real^M->bool`; + `vec 1:real^1`; `vec 0:real^1`] URYSOHN_LOCAL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXPAND_TAC "s'" THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_DIFF; PASTECART_IN_PCROSS] THEN + X_GEN_TAC `x:real^M` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + REWRITE_TAC[SEGMENT_1; DROP_VEC; REAL_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M->real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(\x. (k:real^(1,M)finite_sum->real^N) (pastecart (a x) x))` THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[HOMOTOPIC_WITH] THEN + EXISTS_TAC `(k:real^(1,M)finite_sum->real^N) o + (\z. pastecart (drop(fstcart z) % a(sndcart z)) (sndcart z))` THEN + REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; + ETA_AX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + ASM_SIMP_TAC[IMAGE_SNDCART_PCROSS; UNIT_INTERVAL_NONEMPTY]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))]; + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `IMAGE k t SUBSET u + ==> s SUBSET t ==> IMAGE k s SUBSET u`)); + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN `pastecart (vec 0:real^1) (x:real^M) IN B` MP_TAC THENL + [EXPAND_TAC "B" THEN + ASM_REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_SING]; + DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `(h':real^(1,M)finite_sum->real^N) (pastecart (vec 0) x)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; EXPAND_TAC "h'"] THEN + ASM_REWRITE_TAC[SNDCART_PASTECART; COND_ID]]] THEN + (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`p:real^1`; `x:real^M`] THEN STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_CASES_TAC `(x:real^M) IN s'` THENL + [ASM_SIMP_TAC[VECTOR_MUL_RZERO] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN + ASM_REWRITE_TAC[IN_SING]; + UNDISCH_TAC `~((x:real^M) IN s')` THEN + EXPAND_TAC "s'" THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `drop p % (a:real^M->real^1) x`) THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IN_DIFF] THEN + ASM_REWRITE_TAC[CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_LMUL; REAL_ARITH + `p * a <= p * &1 /\ p <= &1 ==> p * a <= &1`]]); + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]); + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(h':real^(1,M)finite_sum->real^N) (pastecart (vec 1) x)` THEN + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC; EXPAND_TAC "h'"] THEN + ASM_REWRITE_TAC[SNDCART_PASTECART] THEN + EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]] THEN + (ASM_CASES_TAC `(x:real^M) IN s'` THEN ASM_SIMP_TAC[] THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + EXPAND_TAC "B" THEN REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]; + UNDISCH_TAC `~((x:real^M) IN s')` THEN EXPAND_TAC "s'" THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(a:real^M->real^1) x`) THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_DIFF] THEN ASM SET_TAC[]])]);; + +let BORSUK_HOMOTOPY_EXTENSION = prove + (`!f:real^M->real^N g s t u. + closed_in (subtopology euclidean t) s /\ + (ANR s /\ ANR t \/ ANR u) /\ + f continuous_on t /\ IMAGE f t SUBSET u /\ + homotopic_with (\x. T) (s,u) f g + ==> ?g'. g' continuous_on t /\ IMAGE g' t SUBSET u /\ + !x. x IN s ==> g'(x) = g(x)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC) THEN + MESON_TAC[]);; + +let NULLHOMOTOPIC_INTO_ANR_EXTENSION = prove + (`!f:real^M->real^N s t. + closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET t /\ ANR t + ==> ((?c. homotopic_with (\x. T) (s,t) f (\x. c)) <=> + (?g. g continuous_on (:real^M) /\ + IMAGE g (:real^M) SUBSET t /\ + !x. x IN s ==> g x = f x))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + EXISTS_TAC `(\x. c):real^M->real^N` THEN + ASM_REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + ASM SET_TAC[]; + MP_TAC(ISPECL [`g:real^M->real^N`; `(:real^M)`; `t:real^N->bool`] + NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN + ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN + MAP_EVERY EXISTS_TAC [`g:real^M->real^N`; `(\x. c):real^M->real^N`] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_SUBSET_LEFT THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]);; + +let NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION = prove + (`!f:real^M->real^N s t. + closed s /\ f continuous_on s /\ ~(s = {}) /\ + IMAGE f s SUBSET relative_frontier t /\ convex t /\ bounded t + ==> ((?c. homotopic_with (\x. T) (s,relative_frontier t) f (\x. c)) <=> + (?g. g continuous_on (:real^M) /\ + IMAGE g (:real^M) SUBSET relative_frontier t /\ + !x. x IN s ==> g x = f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NULLHOMOTOPIC_INTO_ANR_EXTENSION THEN + MP_TAC(ISPEC `t:real^N->bool` ANR_RELATIVE_FRONTIER_CONVEX) THEN + ASM_REWRITE_TAC[]);; + +let NULLHOMOTOPIC_INTO_SPHERE_EXTENSION = prove + (`!f:real^M->real^N s a r. + closed s /\ f continuous_on s /\ ~(s = {}) /\ IMAGE f s SUBSET sphere(a,r) + ==> ((?c. homotopic_with (\x. T) (s,sphere(a,r)) f (\x. c)) <=> + (?g. g continuous_on (:real^M) /\ + IMAGE g (:real^M) SUBSET sphere(a,r) /\ + !x. x IN s ==> g x = f x))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL + [EXISTS_TAC `a:real^N` THEN SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. (a:real^N)`; + EXISTS_TAC `(\x. a):real^M->real^N`] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN STRIP_TAC THEN + MATCH_MP_TAC NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL]]);; + +let ABSOLUTE_RETRACT_CONTRACTIBLE_ANR = prove + (`!s u:real^N->bool. + closed_in (subtopology euclidean u) s /\ + contractible s /\ ~(s = {}) /\ ANR s + ==> s retract_of u`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC AR_IMP_RETRACT THEN + ASM_SIMP_TAC[AR_ANR]);; + +(* ------------------------------------------------------------------------- *) +(* More homotopy extension results and relations to components. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_ON_COMPONENTS = prove + (`!s t f g:real^M->real^N. + locally connected s /\ + (!c. c IN components s ==> homotopic_with (\x. T) (c,t) f g) + ==> homotopic_with (\x. T) (s,t) f g`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN + MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN + X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN + ASM_SIMP_TAC[GSYM UNIONS_COMPONENTS] THEN + ASM_MESON_TAC[CLOSED_IN_COMPONENT; OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);; + +let INESSENTIAL_ON_COMPONENTS = prove + (`!f:real^M->real^N s t. + locally connected s /\ path_connected t /\ + (!c. c IN components s ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a)) + ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `components(s:real^M->bool) = {}` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[COMPONENTS_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN `?a:real^N. a IN t` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^M->bool`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_ON_COMPONENTS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN FIRST_X_ASSUM + (MATCH_MP_TAC o REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN ASM SET_TAC[]);; + +let HOMOTOPIC_NEIGHBOURHOOD_EXTENSION = prove + (`!f g:real^M->real^N s t u. + f continuous_on s /\ IMAGE f s SUBSET u /\ + g continuous_on s /\ IMAGE g s SUBSET u /\ + closed_in (subtopology euclidean s) t /\ ANR u /\ + homotopic_with (\x. T) (t,u) f g + ==> ?v. t SUBSET v /\ + open_in (subtopology euclidean s) v /\ + homotopic_with (\x. T) (v,u) f g`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + ABBREV_TAC + `h' = \z. if fstcart z IN {vec 0} then f(sndcart z) + else if fstcart z IN {vec 1} then g(sndcart z) + else (h:real^(1,M)finite_sum->real^N) z` THEN + MP_TAC(ISPECL + [`h':real^(1,M)finite_sum->real^N`; + `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)`; + `{vec 0:real^1,vec 1} PCROSS (s:real^M->bool) UNION + interval[vec 0,vec 1] PCROSS t`; + `u:real^N->bool`] ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR) THEN + ASM_SIMP_TAC[ENR_IMP_ANR] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN + REWRITE_TAC[PCROSS_UNION; UNION_ASSOC] THEN EXPAND_TAC "h'" THEN + REPLICATE_TAC 2 (MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + REPLICATE_TAC 2 (CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1] PCROSS (s:real^M->bool)` THEN + REWRITE_TAC[SET_RULE `t UNION u SUBSET s UNION t UNION u`] THEN + REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; SUBSET_PCROSS] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + TRY(MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC) THEN + MATCH_MP_TAC CLOSED_IN_PCROSS THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL] THEN MATCH_MP_TAC CLOSED_SUBSET THEN + REWRITE_TAC[SING_SUBSET; ENDS_IN_UNIT_INTERVAL; CLOSED_SING]; + ALL_TAC]) THEN + REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + ASM_REWRITE_TAC[IMAGE_SNDCART_PCROSS; NOT_INSERT_EMPTY]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[FSTCART_PASTECART; IN_SING; SNDCART_PASTECART] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^M`] THEN + ASM_CASES_TAC `x:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VEC_EQ; ARITH_EQ; ENDS_IN_UNIT_INTERVAL] THEN + ASM_CASES_TAC `x:real^1 = vec 1` THEN ASM_REWRITE_TAC[]]); + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN + REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_SING; NOT_IN_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^M`] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + EXPAND_TAC "h'" THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN + REPEAT(COND_CASES_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]]) THEN + STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE f s SUBSET u ==> b IN s ==> f b IN u`)) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; + MATCH_MP_TAC CLOSED_IN_UNION THEN CONJ_TAC THEN + MATCH_MP_TAC CLOSED_IN_PCROSS THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN + SIMP_TAC[CLOSED_INSERT; CLOSED_EMPTY]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`w:real^(1,M)finite_sum->bool`; `k:real^(1,M)finite_sum->real^N`] THEN + STRIP_TAC] THEN + MP_TAC(ISPECL [`interval[vec 0:real^1,vec 1]`; + `t:real^M->bool`; `s:real^M->bool`; + `w:real^(1,M)finite_sum->bool`] + TUBE_LEMMA_GEN) THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `t':real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[HOMOTOPIC_WITH] THEN + EXISTS_TAC `k:real^(1,M)finite_sum->real^N` THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + CONJ_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhs o snd o dest_imp) th o lhs o snd)) THEN + REWRITE_TAC[IN_UNION; PASTECART_IN_PCROSS; IN_INSERT] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN + EXPAND_TAC "h'" THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SING] THEN + REWRITE_TAC[VEC_EQ; ARITH_EQ]);; + +let HOMOTOPIC_ON_COMPONENTS_EQ = prove + (`!s t f g:real^M->real^N. + (locally connected s \/ compact s /\ ANR t) + ==> (homotopic_with (\x. T) (s,t) f g <=> + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on s /\ IMAGE g s SUBSET t /\ + !c. c IN components s ==> homotopic_with (\x. T) (c,t) f g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> (q <=> s)) ==> (q <=> r /\ s)`) THEN + CONJ_TAC THENL + [MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET]; + ALL_TAC] THEN + STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT; IN_COMPONENTS_SUBSET]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!c. c IN components s + ==> ?u. c SUBSET u /\ + closed_in (subtopology euclidean s) u /\ + open_in (subtopology euclidean s) u /\ + homotopic_with (\x. T) (u,t) (f:real^M->real^N) g` + MP_TAC THENL + [X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [EXISTS_TAC `c:real^M->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_COMPONENT; SUBSET_REFL; + OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]; + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `g:real^M->real^N`; + `s:real^M->bool`; `c:real^M->bool`; `t:real^N->bool`] + HOMOTOPIC_NEIGHBOURHOOD_EXTENSION) THEN + ASM_SIMP_TAC[CLOSED_IN_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + MP_TAC(ISPECL [`s:real^M->bool`; `c:real^M->bool`; `v:real^M->bool`] + SURA_BURA_CLOPEN_SUBSET) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[COMPACT_COMPONENTS]; ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_SUBSET THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED; OPEN_IN_IMP_SUBSET]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM SET_TAC[]]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN + SUBGOAL_THEN + `s = UNIONS (IMAGE k (components(s:real^M->bool)))` + (fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) + THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [UNIONS_COMPONENTS] THEN + MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]]; + MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]]]);; + +let INESSENTIAL_ON_COMPONENTS_EQ = prove + (`!s t f:real^M->real^N. + (locally connected s \/ compact s /\ ANR t) /\ + path_connected t + ==> ((?a. homotopic_with (\x. T) (s,t) f (\x. a)) <=> + f continuous_on s /\ IMAGE f s SUBSET t /\ + !c. c IN components s + ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC(TAUT `(q ==> r) /\ (r ==> (q <=> s)) ==> (q <=> r /\ s)`) THEN + CONJ_TAC THENL + [MESON_TAC[HOMOTOPIC_WITH_IMP_CONTINUOUS; HOMOTOPIC_WITH_IMP_SUBSET]; + STRIP_TAC] THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP HOMOTOPIC_ON_COMPONENTS_EQ th]) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_SIMP_TAC[COMPONENTS_EMPTY; IMAGE_CLAUSES; NOT_IN_EMPTY; + EMPTY_SUBSET] THEN + DISCH_TAC THEN + SUBGOAL_THEN `?c:real^M->bool. c IN components s` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[MEMBER_NOT_EMPTY; COMPONENTS_EQ_EMPTY]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `a:real^N` THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `d:real^M->bool`] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `d:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN + MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY)) THEN + ASM SET_TAC[]);; + +let COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS = prove + (`!s:real^M->bool t:real^N->bool. + (locally connected s \/ compact s /\ ANR t) + ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on s /\ IMAGE g s SUBSET t + ==> homotopic_with (\x. T) (s,t) f g) <=> + (!c. c IN components s + ==> (!f g. f continuous_on c /\ IMAGE f c SUBSET t /\ + g continuous_on c /\ IMAGE g c SUBSET t + ==> homotopic_with (\x. T) (c,t) f g)))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`g:real^M->real^N`; `s:real^M->bool`; + `c:real^M->bool`; `t:real^N->bool`] + EXTENSION_FROM_COMPONENT) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; + `c:real^M->bool`; `t:real^N->bool`] + EXTENSION_FROM_COMPONENT) THEN + ANTS_TAC THENL [ASM_MESON_TAC[ENR_IMP_ANR]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN + ANTS_TAC THENL [ASM_MESON_TAC[ENR_IMP_ANR]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g':real^M->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f':real^M->real^N`; `g':real^M->real^N`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `c:real^M->bool` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN + ASM_SIMP_TAC[IN_COMPONENTS_SUBSET] THEN MATCH_MP_TAC + (ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + ASM_SIMP_TAC[]; + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP HOMOTOPIC_ON_COMPONENTS_EQ th]) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + REPEAT CONJ_TAC THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]]);; + +let COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL = prove + (`!s:real^M->bool t:real^N->bool. + (locally connected s \/ compact s /\ ANR t) /\ path_connected t + ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET t + ==> ?a. homotopic_with (\x. T) (s,t) f (\x. a)) <=> + (!c. c IN components s + ==> (!f. f continuous_on c /\ IMAGE f c SUBSET t + ==> ?a. homotopic_with (\x. T) (c,t) f (\x. a))))`, + REPEAT GEN_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS) THEN + ASM_SIMP_TAC[HOMOTOPIC_TRIVIALITY]);; + +(* ------------------------------------------------------------------------- *) +(* A few simple lemmas about deformation retracts. *) +(* ------------------------------------------------------------------------- *) + +let DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT = prove + (`!s t:real^N->bool. + (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r) + ==> s homotopy_equivalent t`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[retraction] THEN STRIP_TAC THEN + EXISTS_TAC `I:real^N->real^N` THEN REWRITE_TAC[I_O_ID] THEN + ASM_REWRITE_TAC[I_DEF; CONTINUOUS_ON_ID; IMAGE_ID] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOMOTOPIC_WITH_SYM]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; + +let DEFORMATION_RETRACT = prove + (`!s t:real^N->bool. + (?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,t) r) <=> + t retract_of s /\ + ?f. homotopic_with (\x. T) (s,s) (\x. x) f /\ IMAGE f s SUBSET t`, + REPEAT GEN_TAC THEN REWRITE_TAC[retract_of; retraction] THEN EQ_TAC THENL + [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `r:real^N->real^N` THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `r:real^N->real^N` THEN ASM_REWRITE_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) MP_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN + STRIP_TAC THEN EXISTS_TAC `r:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN + TRANS_TAC HOMOTOPIC_WITH_TRANS `f:real^N->real^N` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN + MAP_EVERY EXISTS_TAC + [`(r:real^N->real^N) o (f:real^N->real^N)`; + `(r:real^N->real^N) o (\x. x)`] THEN + ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOMOTOPIC_WITH_SYM]; ASM SET_TAC[]]]);; + +let DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING = prove + (`!s a:real^N. + contractible s /\ a IN s + ==> ?r. homotopic_with (\x. T) (s,s) (\x. x) r /\ retraction(s,{a}) r`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[DEFORMATION_RETRACT; RETRACT_OF_SING] THEN + EXISTS_TAC `(\x. a):real^N->real^N` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP CONTRACTIBLE_IMP_PATH_CONNECTED) THEN + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + ASM SET_TAC[]);; + +let HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX = prove + (`!s t a:real^N. + convex s /\ bounded s /\ a IN relative_interior s /\ + convex t /\ relative_frontier s SUBSET t /\ t SUBSET affine hull s + ==> (relative_frontier s) homotopy_equivalent (t DELETE a)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN + MATCH_MP_TAC DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT THEN ASM_SIMP_TAC + [RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX]);; + +let HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL = prove + (`!s a:real^N. + convex s /\ bounded s /\ a IN relative_interior s + ==> (relative_frontier s) homotopy_equivalent (affine hull s DELETE a)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; SUBSET_REFL] THEN + REWRITE_TAC[relative_frontier] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s DIFF t SUBSET u`) THEN + REWRITE_TAC[CLOSURE_SUBSET_AFFINE_HULL]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of fixpoints under (more general notion of) retraction. *) +(* ------------------------------------------------------------------------- *) + +let INVERTIBLE_FIXPOINT_PROPERTY = prove + (`!s:real^M->bool t:real^N->bool i r. + i continuous_on t /\ IMAGE i t SUBSET s /\ + r continuous_on s /\ IMAGE r s SUBSET t /\ + (!y. y IN t ==> (r(i(y)) = y)) + ==> (!f. f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ (f x = x)) + ==> !g. g continuous_on t /\ IMAGE g t SUBSET t + ==> ?y. y IN t /\ (g y = y)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(i:real^N->real^M) o (g:real^N->real^N) o (r:real^M->real^N)`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONTINUOUS_ON_COMPOSE; IMAGE_SUBSET; + SUBSET_TRANS; IMAGE_o]; + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]]);; + +let HOMEOMORPHIC_FIXPOINT_PROPERTY = prove + (`!s t. s homeomorphic t + ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ (f x = x)) <=> + (!g. g continuous_on t /\ IMAGE g t SUBSET t + ==> ?y. y IN t /\ (g y = y)))`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN REPEAT STRIP_TAC THEN + EQ_TAC THEN MATCH_MP_TAC INVERTIBLE_FIXPOINT_PROPERTY THEN + ASM_MESON_TAC[SUBSET_REFL]);; + +let RETRACT_FIXPOINT_PROPERTY = prove + (`!s t:real^N->bool. + t retract_of s /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ (f x = x)) + ==> !g. g continuous_on t /\ IMAGE g t SUBSET t + ==> ?y. y IN t /\ (g y = y)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC INVERTIBLE_FIXPOINT_PROPERTY THEN + EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[retract_of] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[retraction] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* So the Brouwer theorem for any set with nonempty interior. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_WEAK = prove + (`!f:real^N->real^N s. + compact s /\ convex s /\ ~(interior s = {}) /\ + f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ f x = x`, + GEN_TAC THEN ONCE_REWRITE_TAC + [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] THEN + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`interval[vec 0:real^N,vec 1]`; `s:real^N->bool`] + HOMEOMORPHIC_CONVEX_COMPACT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL] THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_EQ_EMPTY] THEN + MESON_TAC[VEC_COMPONENT; REAL_ARITH `~(&1 <= &0)`]; + DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_FIXPOINT_PROPERTY) THEN + REWRITE_TAC[BROUWER_CUBE] THEN SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* And in particular for a closed ball. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_BALL = prove + (`!f:real^N->real^N a e. + &0 < e /\ + f continuous_on cball(a,e) /\ IMAGE f (cball(a,e)) SUBSET (cball(a,e)) + ==> ?x. x IN cball(a,e) /\ (f x = x)`, + ASM_SIMP_TAC[BROUWER_WEAK; CONVEX_CBALL; COMPACT_CBALL; INTERIOR_CBALL; + REAL_LT_IMP_LE; REAL_NOT_LE; BALL_EQ_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Still more general form; could derive this directly without using the *) +(* rather involved HOMEOMORPHIC_CONVEX_COMPACT theorem, just using *) +(* a scaling and translation to put the set inside the unit cube. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER = prove + (`!f:real^N->real^N s. + compact s /\ convex s /\ ~(s = {}) /\ + f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ f x = x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?e. &0 < e /\ s SUBSET cball(vec 0:real^N,e)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_CBALL; NORM_ARITH `dist(vec 0,x) = norm(x)`] THEN + ASM_MESON_TAC[BOUNDED_POS; COMPACT_IMP_BOUNDED]; + ALL_TAC] THEN + SUBGOAL_THEN + `?x:real^N. x IN cball(vec 0,e) /\ (f o closest_point s) x = x` + MP_TAC THENL + [MATCH_MP_TAC BROUWER_BALL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CLOSEST_POINT; COMPACT_IMP_CLOSED] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET])) THEN + REWRITE_TAC[o_THM; IN_IMAGE] THEN + EXISTS_TAC `closest_point s x:real^N` THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSEST_POINT_IN_SET]] THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSEST_POINT_IN_SET]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[o_THM] THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_MESON_TAC[CLOSEST_POINT_SELF; + CLOSEST_POINT_IN_SET; COMPACT_IMP_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* So we get the no-retraction theorem, first for a ball, then more general. *) +(* ------------------------------------------------------------------------- *) + +let NO_RETRACTION_CBALL = prove + (`!a:real^N e. &0 < e ==> ~(sphere(a,e) retract_of cball(a,e))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + RETRACT_FIXPOINT_PROPERTY)) THEN + ASM_SIMP_TAC[BROUWER_BALL] THEN REWRITE_TAC[NOT_FORALL_THM] THEN + EXISTS_TAC `\x:real^N. &2 % a - x` THEN REWRITE_TAC[NOT_IMP] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE] THEN + SIMP_TAC[dist; VECTOR_ARITH `a - (&2 % a - x) = --(a - x)`; NORM_NEG] THEN + REWRITE_TAC[VECTOR_ARITH `(&2 % a - y = y) <=> (a - y = vec 0)`] THEN + ASM_MESON_TAC[NORM_0; REAL_LT_REFL]);; + +let FRONTIER_SUBSET_RETRACTION = prove + (`!s:real^N->bool t r. + bounded s /\ + frontier s SUBSET t /\ + r continuous_on (closure s) /\ + IMAGE r s SUBSET t /\ + (!x. x IN t ==> r x = x) + ==> s SUBSET t`, + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[SET_RULE `~(s SUBSET t) <=> ?x. x IN s /\ ~(x IN t)`] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + REPLICATE_TAC 3 GEN_TAC THEN X_GEN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + ABBREV_TAC `q = \z:real^N. if z IN closure s then r(z) else z` THEN + SUBGOAL_THEN + `(q:real^N->real^N) continuous_on + closure(s) UNION closure((:real^N) DIFF s)` + MP_TAC THENL + [EXPAND_TAC "q" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `z:real^N` THEN + REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; frontier; IN_DIFF]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `closure(s) UNION closure((:real^N) DIFF s) = (:real^N)` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV + ==> closure s UNION closure t = UNIV`) THEN + REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[]; + DISCH_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o SPEC `a:real^N` o + MATCH_MP BOUNDED_SUBSET_BALL o MATCH_MP BOUNDED_CLOSURE) THEN + SUBGOAL_THEN `!x. ~((q:real^N->real^N) x = a)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "q" THEN COND_CASES_TAC THENL + [ASM_CASES_TAC `(x:real^N) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(x:real^N) IN t` (fun th -> ASM_MESON_TAC[th]) THEN + UNDISCH_TAC `frontier(s:real^N->bool) SUBSET t` THEN + REWRITE_TAC[SUBSET; frontier; IN_DIFF] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET]; + ASM_MESON_TAC[SUBSET; INTERIOR_SUBSET; CLOSURE_SUBSET]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`a:real^N`; `B:real`] NO_RETRACTION_CBALL) THEN + ASM_REWRITE_TAC[retract_of; GSYM FRONTIER_CBALL] THEN + EXISTS_TAC `(\y. a + B / norm(y - a) % (y - a)) o (q:real^N->real^N)` THEN + REWRITE_TAC[retraction; FRONTIER_SUBSET_EQ; CLOSED_CBALL] THEN + REWRITE_TAC[FRONTIER_CBALL; SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_SPHERE; DIST_0] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; NORM_EQ_0; VECTOR_SUB_EQ] THEN + SUBGOAL_THEN `(\x:real^N. lift(norm(x - a))) = (lift o norm) o (\x. x - a)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM]; + REWRITE_TAC[o_THM; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; + NORM_ARITH `dist(a,a + b) = norm b`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN + EXPAND_TAC "q" THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_BALL]) THEN + ASM_MESON_TAC[REAL_LT_REFL]; + REWRITE_TAC[NORM_ARITH `norm(x - a) = dist(a,x)`] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN + VECTOR_ARITH_TAC]]);; + +let NO_RETRACTION_FRONTIER_BOUNDED = prove + (`!s:real^N->bool. + bounded s /\ ~(interior s = {}) ==> ~((frontier s) retract_of s)`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[retract_of; retraction] THEN + REWRITE_TAC[FRONTIER_SUBSET_EQ] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `frontier s:real^N->bool`; + `r:real^N->real^N`] FRONTIER_SUBSET_RETRACTION) THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; SUBSET_REFL] THEN REWRITE_TAC[frontier] THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN ASM SET_TAC[]);; + +let COMPACT_SUBSET_FRONTIER_RETRACTION = prove + (`!f:real^N->real^N s. + compact s /\ f continuous_on s /\ (!x. x IN frontier s ==> f x = x) + ==> s SUBSET IMAGE f s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s UNION (IMAGE f s):real^N->bool`; `vec 0:real^N`] + BOUNDED_SUBSET_BALL) THEN + ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; + COMPACT_CONTINUOUS_IMAGE; UNION_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `g = \x:real^N. if x IN s then f(x) else x` THEN + SUBGOAL_THEN `(g:real^N->real^N) continuous_on (:real^N)` ASSUME_TAC THENL + [SUBGOAL_THEN `(:real^N) = s UNION closure((:real^N) DIFF s)` SUBST1_TAC + THENL + [MATCH_MP_TAC(SET_RULE `UNIV DIFF s SUBSET t ==> UNIV = s UNION t`) THEN + REWRITE_TAC[CLOSURE_SUBSET]; + ALL_TAC] THEN + EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + ASM_SIMP_TAC[CLOSED_CLOSURE; CONTINUOUS_ON_ID; COMPACT_IMP_CLOSED] THEN + REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[frontier; IN_DIFF] THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `p:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?h:real^N->real^N. + retraction (UNIV DELETE p,sphere(vec 0,r)) h` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM retract_of] THEN + MATCH_MP_TAC SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`vec 0:real^N`; `r:real`] NO_RETRACTION_CBALL) THEN + ASM_REWRITE_TAC[retract_of; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(h:real^N->real^N) o (g:real^N->real^N)`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[retraction] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retraction]) THEN + SIMP_TAC[SUBSET; IN_SPHERE; IN_CBALL; REAL_EQ_IMP_LE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; o_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN cball (vec 0,r) ==> ~((g:real^N->real^N) x = p)` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN + COND_CASES_TAC THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE]; + SUBGOAL_THEN `(g:real^N->real^N) x = x` (fun th -> ASM_SIMP_TAC[th]) THEN + EXPAND_TAC "g" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[IN_BALL; REAL_LT_REFL; SUBSET]]);; + +let NOT_ABSOLUTE_RETRACT_COBOUNDED = prove + (`!s. bounded s /\ ((:real^N) DIFF s) retract_of (:real^N) ==> s = {}`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE `(!x. x IN s ==> F) ==> s = {}`) THEN + X_GEN_TAC `a:real^N` THEN POP_ASSUM MP_TAC THEN + GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^N` o + MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN + EXISTS_TAC `(:real^N)` THEN SIMP_TAC[SUBSET_UNIV; SPHERE_SUBSET_CBALL] THEN + MATCH_MP_TAC RETRACT_OF_TRANS THEN EXISTS_TAC `(:real^N) DIFF s` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RETRACT_OF_SUBSET THEN + EXISTS_TAC `(:real^N) DELETE (vec 0)` THEN + ASM_SIMP_TAC[SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_SPHERE; IN_DIFF; IN_UNIV] THEN + MESON_TAC[REAL_LT_REFL]);; + +let CONTRACTIBLE_SPHERE = prove + (`!a:real^N r. contractible(sphere(a,r)) <=> r <= &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[contractible; GSYM REAL_NOT_LT] THEN + REWRITE_TAC[NULLHOMOTOPIC_FROM_SPHERE_EXTENSION] THEN + ASM_CASES_TAC `&0 < r` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(MP_TAC o ISPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN + SIMP_TAC[retract_of; retraction; SPHERE_SUBSET_CBALL]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN + EXISTS_TAC `\x:real^N. x` THEN REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID] THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_ELIM_THM] THEN + POP_ASSUM MP_TAC THEN NORM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Some more theorems about connectivity of retract complements. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS = prove + (`!s t c. closed s /\ s retract_of t /\ + c IN components((:real^N) DIFF s) /\ bounded c + ==> ~(c SUBSET t)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + SUBGOAL_THEN `frontier(c:real^N->bool) SUBSET s` ASSUME_TAC THENL + [TRANS_TAC SUBSET_TRANS `frontier((:real^N) DIFF s)` THEN + ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_SUBSET] THEN + REWRITE_TAC[FRONTIER_COMPLEMENT] THEN + ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `closure(c:real^N->bool) SUBSET t` ASSUME_TAC THENL + [REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL + [MATCH_MP_TAC FRONTIER_SUBSET_RETRACTION THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + ASM SET_TAC[]]);; + +let COMPONENT_RETRACT_COMPLEMENT_MEETS = prove + (`!s t c. closed s /\ s retract_of t /\ bounded t /\ + c IN components((:real^N) DIFF s) + ==> ~(c SUBSET t)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + ASM_CASES_TAC `bounded(c:real^N->bool)` THENL + [ASM_MESON_TAC[BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS]; + ASM_MESON_TAC[BOUNDED_SUBSET]]);; + +let FINITE_COMPLEMENT_ENR_COMPONENTS = prove + (`!s. compact s /\ ENR s ==> FINITE(components((:real^N) DIFF s))`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_SIMP_TAC[DIFF_EMPTY] THEN + MESON_TAC[COMPONENTS_EQ_SING; CONNECTED_UNIV; UNIV_NOT_EMPTY; FINITE_SING]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[ENR_BOUNDED; COMPACT_IMP_BOUNDED] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!c. c IN components((:real^N) DIFF s) ==> ~(c SUBSET u)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC COMPONENT_RETRACT_COMPLEMENT_MEETS THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED]; + ALL_TAC] THEN + MP_TAC(ISPECL [`u:real^N->bool`; `vec 0:real^N`] + BOUNDED_SUBSET_CBALL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `cball(vec 0:real^N,r) DIFF u` COMPACT_EQ_HEINE_BOREL) THEN + ASM_SIMP_TAC[COMPACT_DIFF; COMPACT_CBALL] THEN + DISCH_THEN(MP_TAC o SPEC `components((:real^N) DIFF s)`) THEN + REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_MESON_TAC[OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED]; + DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `components((:real^N) DIFF s) = cs` + (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `c:real^N->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN `~(c INTER (cball(vec 0:real^N,r) DIFF u) = {})` MP_TAC THENL + [SUBGOAL_THEN `~(c INTER frontier(u:real^N->bool) = {})` MP_TAC THENL + [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN + ASM_SIMP_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + W(MP_TAC o PART_MATCH (rand o rand) + OPEN_INTER_CLOSURE_EQ_EMPTY o rand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[CLOSURE_UNION_FRONTIER] THEN + MATCH_MP_TAC(SET_RULE + `~(t = {}) /\ t SUBSET u + ==> ~(u INTER (s UNION t) = {})`) THEN + ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + TRANS_TAC SUBSET_TRANS `frontier((:real^N) DIFF s)` THEN + ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_SUBSET] THEN + REWRITE_TAC[FRONTIER_COMPLEMENT] THEN + ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; COMPACT_IMP_CLOSED] THEN + ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE `s SUBSET t + ==> ~(c INTER s = {}) ==> ~(c INTER t = {})`) THEN + ASM_SIMP_TAC[frontier; INTERIOR_OPEN] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[CLOSED_CBALL]]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:real^N) IN UNIONS cs` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^N) DIFF s`; `c:real^N->bool`; `c':real^N->bool`] + COMPONENTS_NONOVERLAP) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `c:real^N->bool = c'` THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]);; + +let FINITE_COMPLEMENT_ANR_COMPONENTS = prove + (`!s. compact s /\ ANR s ==> FINITE(components((:real^N) DIFF s))`, + MESON_TAC[FINITE_COMPLEMENT_ENR_COMPONENTS; ENR_ANR; + COMPACT_IMP_CLOSED; CLOSED_IMP_LOCALLY_COMPACT]);; + +let CARD_LE_RETRACT_COMPLEMENT_COMPONENTS = prove + (`!s t. compact s /\ s retract_of t /\ bounded t + ==> components((:real^N) DIFF s) <=_c components((:real^N) DIFF t)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RETRACT_OF_IMP_SUBSET) THEN + MATCH_MP_TAC(ISPEC `SUBSET` CARD_LE_RELATIONAL_FULL) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC + [`d:real^N->bool`; `c:real^N->bool`; `c':real^N->bool`] THEN + STRIP_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ) THEN + ASM_SIMP_TAC[] THEN + ASM_CASES_TAC `d:real^N->bool = {}` THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN + X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `~((u:real^N->bool) SUBSET t)` MP_TAC THENL + [MATCH_MP_TAC COMPONENT_RETRACT_COMPLEMENT_MEETS THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED]; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `~(s SUBSET t) <=> ?p. p IN s /\ ~(p IN t)`] THEN + REWRITE_TAC[components; EXISTS_IN_GSPEC; IN_UNIV; IN_DIFF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `u = connected_component ((:real^N) DIFF s) p` + SUBST_ALL_TAC THENL + [MP_TAC(ISPECL [`(:real^N) DIFF s`; `u:real^N->bool`] + COMPONENTS_EQ) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC `p:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `p:real^N` THEN + ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]]);; + +let CONNECTED_RETRACT_COMPLEMENT = prove + (`!s t. compact s /\ s retract_of t /\ bounded t /\ + connected((:real^N) DIFF t) + ==> connected((:real^N) DIFF s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_TAC `u:real^N->bool`) THEN + SUBGOAL_THEN `FINITE(components((:real^N) DIFF t))` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET; FINITE_SING]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + CARD_LE_RETRACT_COMPLEMENT_COMPONENTS) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `FINITE(components((:real^N) DIFF s)) /\ + CARD(components((:real^N) DIFF s)) <= CARD(components((:real^N) DIFF t))` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[CARD_LE_CARD_IMP; CARD_LE_FINITE]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN + REWRITE_TAC[EXISTS_OR_THM] THEN + REWRITE_TAC[GSYM HAS_SIZE_0; GSYM(HAS_SIZE_CONV `s HAS_SIZE 1`)] THEN + ASM_REWRITE_TAC[HAS_SIZE; ARITH_RULE `n = 0 \/ n = 1 <=> n <= 1`] THEN + TRANS_TAC LE_TRANS `CARD{u:real^N->bool}` THEN CONJ_TAC THENL + [TRANS_TAC LE_TRANS `CARD(components((:real^N) DIFF t))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN + ASM_REWRITE_TAC[FINITE_SING]; + SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* We also get fixpoint properties for suitable ANRs. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_INESSENTIAL_ANR = prove + (`!f:real^N->real^N s. + compact s /\ ~(s = {}) /\ ANR s /\ + f continuous_on s /\ IMAGE f s SUBSET s /\ + (?a. homotopic_with (\x. T) (s,s) f (\x. a)) + ==> ?x. x IN s /\ f x = x`, + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `r:real` o SPEC `vec 0:real^N` o + MATCH_MP BOUNDED_SUBSET_CBALL o MATCH_MP COMPACT_IMP_BOUNDED) THEN + MP_TAC(ISPECL + [`(\x. a):real^N->real^N`; `f:real^N->real^N`; + `s:real^N->bool`; `cball(vec 0:real^N,r)`; `s:real^N->bool`] + BORSUK_HOMOTOPY_EXTENSION) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SUBSET; + CONTINUOUS_ON_CONST; CLOSED_CBALL] THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^N->real^N`; `cball(vec 0:real^N,r)`] + BROUWER) THEN + ASM_SIMP_TAC[COMPACT_CBALL; CONVEX_CBALL; CBALL_EQ_EMPTY] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN ASM SET_TAC[]);; + +let BROUWER_CONTRACTIBLE_ANR = prove + (`!f:real^N->real^N s. + compact s /\ contractible s /\ ~(s = {}) /\ ANR s /\ + f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ f x = x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_INESSENTIAL_ANR THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);; + +let FIXED_POINT_INESSENTIAL_SPHERE_MAP = prove + (`!f a:real^N r c. + &0 < r /\ homotopic_with (\x. T) (sphere(a,r),sphere(a,r)) f (\x. c) + ==> ?x. x IN sphere(a,r) /\ f x = x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_INESSENTIAL_ANR THEN + REWRITE_TAC[ANR_SPHERE] THEN + ASM_SIMP_TAC[SPHERE_EQ_EMPTY; COMPACT_SPHERE; OPEN_DELETE; OPEN_UNIV] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + ASM_SIMP_TAC[REAL_NOT_LT; REAL_LT_IMP_LE] THEN ASM_MESON_TAC[]);; + +let BROUWER_AR = prove + (`!f s:real^N->bool. + compact s /\ AR s /\ f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ f x = x`, + REWRITE_TAC[AR_ANR] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_CONTRACTIBLE_ANR THEN + ASM_REWRITE_TAC[]);; + +let BROUWER_ABSOLUTE_RETRACT = prove + (`!f s. compact s /\ s retract_of (:real^N) /\ + f continuous_on s /\ IMAGE f s SUBSET s + ==> ?x. x IN s /\ f x = x`, + REWRITE_TAC[RETRACT_OF_UNIV; AR_ANR] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BROUWER_CONTRACTIBLE_ANR THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* This interresting lemma is no longer used for Schauder but we keep it. *) +(* ------------------------------------------------------------------------- *) + +let SCHAUDER_PROJECTION = prove + (`!s:real^N->bool e. + compact s /\ &0 < e + ==> ?t f. FINITE t /\ t SUBSET s /\ + f continuous_on s /\ IMAGE f s SUBSET (convex hull t) /\ + (!x. x IN s ==> norm(f x - x) < e)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o SPEC `e:real` o MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `g = \p x:real^N. max (&0) (e - norm(x - p))` THEN + SUBGOAL_THEN + `!x. x IN s ==> &0 < sum t (\p. (g:real^N->real^N->real) p x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LT THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN + REWRITE_TAC[REAL_ARITH `&0 <= max (&0) b`] THEN + REWRITE_TAC[REAL_ARITH `&0 < max (&0) b <=> &0 < b`; REAL_SUB_LT] THEN + UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^N. ball(x,e)) t)` THEN + REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_BALL; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[dist; NORM_SUB]; + ALL_TAC] THEN + EXISTS_TAC + `(\x. inv(sum t (\p. g p x)) % vsum t (\p. g p x % p)):real^N->real^N` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; LIFT_SUM; o_DEF]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_VSUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THENL + [ALL_TAC; MATCH_MP_TAC CONTINUOUS_ON_MUL] THEN + REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN + EXPAND_TAC "g" THEN + (SUBGOAL_THEN + `(\x. lift (max (&0) (e - norm (x - y:real^N)))) = + (\x. (lambda i. max (lift(&0)$i) (lift(e - norm (x - y))$i)))` + SUBST1_TAC THENL + [SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]; + MATCH_MP_TAC CONTINUOUS_ON_MAX] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_SUB] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] (GSYM dist)] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]); + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; GSYM VSUM_LMUL; VECTOR_MUL_ASSOC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC CONVEX_VSUM THEN + ASM_SIMP_TAC[HULL_INC; CONVEX_CONVEX_HULL; SUM_LMUL] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + EXPAND_TAC "g" THEN REAL_ARITH_TAC; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + REWRITE_TAC[REWRITE_RULE[dist] (GSYM IN_BALL)] THEN + REWRITE_TAC[GSYM VSUM_LMUL; VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC CONVEX_VSUM_STRONG THEN + ASM_REWRITE_TAC[CONVEX_BALL; SUM_LMUL; REAL_ENTIRE] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_LT_INV_EQ; + REAL_LE_MUL_EQ] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN REWRITE_TAC[IN_BALL; dist; NORM_SUB] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Some other related fixed-point theorems. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_FACTOR_THROUGH_AR = prove + (`!f:real^M->real^N g:real^N->real^M s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + compact s /\ AR t + ==> ?x. x IN s /\ g(f x) = x`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [COMPACT_EQ_BOUNDED_CLOSED]) THEN + FIRST_ASSUM(MP_TAC o SPEC `a:real^M` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`; + `s:real^M->bool`; `t:real^N->bool`] + AR_IMP_ABSOLUTE_EXTENSOR) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(g:real^N->real^M) o (h:real^M->real^N)`; + `a:real^M`; `r:real`] BROUWER_BALL) THEN + ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV; IMAGE_SUBSET]);; + +let BROUWER_ABSOLUTE_RETRACT_GEN = prove + (`!f s:real^N->bool. + s retract_of (:real^N) /\ + f continuous_on s /\ IMAGE f s SUBSET s /\ bounded(IMAGE f s) + ==> ?x. x IN s /\ f x = x`, + REWRITE_TAC[RETRACT_OF_UNIV] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. x`; `f:real^N->real^N`; + `closure(IMAGE (f:real^N->real^N) s)`; `s:real^N->bool`] + BROUWER_FACTOR_THROUGH_AR) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; COMPACT_CLOSURE; IMAGE_ID] THEN + REWRITE_TAC[CLOSURE_SUBSET] THEN + MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ p ==> (p ==> q) ==> r`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC CLOSURE_MINIMAL] THEN + ASM_MESON_TAC[RETRACT_OF_CLOSED; CLOSED_UNIV]);; + +let SCHAUDER_GEN = prove + (`!f s t:real^N->bool. + AR s /\ f continuous_on s /\ IMAGE f s SUBSET t /\ t SUBSET s /\ compact t + ==> ?x. x IN t /\ f x = x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. x`; `f:real^N->real^N`; + `t:real^N->bool`; `s:real^N->bool`] + BROUWER_FACTOR_THROUGH_AR) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; + +let SCHAUDER = prove + (`!f s t:real^N->bool. + convex s /\ ~(s = {}) /\ t SUBSET s /\ compact t /\ + f continuous_on s /\ IMAGE f s SUBSET t + ==> ?x. x IN s /\ f x = x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`; `t:real^N->bool`] + SCHAUDER_GEN) THEN + ASM_SIMP_TAC[CONVEX_IMP_AR] THEN ASM SET_TAC[]);; + +let SCHAUDER_UNIV = prove + (`!f:real^N->real^N. + f continuous_on (:real^N) /\ bounded (IMAGE f (:real^N)) + ==> ?x. f x = x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`; + `closure(IMAGE (f:real^N->real^N) (:real^N))`] SCHAUDER) THEN + ASM_REWRITE_TAC[UNIV_NOT_EMPTY; CONVEX_UNIV; COMPACT_CLOSURE; IN_UNIV] THEN + REWRITE_TAC[SUBSET_UNIV; CLOSURE_SUBSET]);; + +let ROTHE = prove + (`!f s:real^N->bool. + closed s /\ convex s /\ ~(s = {}) /\ + f continuous_on s /\ bounded(IMAGE f s) /\ + IMAGE f (frontier s) SUBSET s + ==> ?x. x IN s /\ f x = x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] + ABSOLUTE_RETRACTION_CONVEX_CLOSED) THEN + ASM_REWRITE_TAC[retraction; SUBSET_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`(r:real^N->real^N) o (f:real^N->real^N)`; `s:real^N->bool`; + `IMAGE (r:real^N->real^N) (closure(IMAGE (f:real^N->real^N) s))`] + SCHAUDER) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET; IMAGE_o] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[o_THM] THEN STRIP_TAC THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Bijections between intervals. *) +(* ------------------------------------------------------------------------- *) + +let interval_bij = new_definition + `interval_bij (a:real^N,b:real^N) (u:real^N,v:real^N) (x:real^N) = + (lambda i. u$i + (x$i - a$i) / (b$i - a$i) * (v$i - u$i)):real^N`;; + +let INTERVAL_BIJ_AFFINE = prove + (`interval_bij (a,b) (u,v) = + \x. (lambda i. (v$i - u$i) / (b$i - a$i) * x$i) + + (lambda i. u$i - (v$i - u$i) / (b$i - a$i) * a$i)`, + SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA; + interval_bij] THEN + REAL_ARITH_TAC);; + +let CONTINUOUS_INTERVAL_BIJ = prove + (`!a b u v x. (interval_bij (a:real^N,b:real^N) (u:real^N,v:real^N)) + continuous at x`, + REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_BIJ_AFFINE] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC);; + +let CONTINUOUS_ON_INTERVAL_BIJ = prove + (`!a b u v s. interval_bij (a,b) (u,v) continuous_on s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[CONTINUOUS_INTERVAL_BIJ]);; + +let IN_INTERVAL_INTERVAL_BIJ = prove + (`!a b u v x:real^N. + x IN interval[a,b] /\ ~(interval[u,v] = {}) + ==> (interval_bij (a,b) (u,v) x) IN interval[u,v]`, + SIMP_TAC[IN_INTERVAL; interval_bij; LAMBDA_BETA; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[REAL_ARITH `u <= u + x <=> &0 <= x`; + REAL_ARITH `u + x <= v <=> x <= &1 * (v - u)`] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC REAL_LE_DIV) THEN + ASM_SIMP_TAC[REAL_SUB_LE] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN + SUBGOAL_THEN `(a:real^N)$i <= (b:real^N)$i` MP_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN STRIP_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= x /\ x <= b ==> x - a <= &1 * (b - a)`]; + ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_INV_0] THEN + REAL_ARITH_TAC]]);; + +let INTERVAL_BIJ_BIJ = prove + (`!a b u v x:real^N. + (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i /\ u$i < v$i) + ==> interval_bij (a,b) (u,v) (interval_bij (u,v) (a,b) x) = x`, + SIMP_TAC[interval_bij; CART_EQ; LAMBDA_BETA; REAL_ADD_SUB] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Fashoda meet theorem. *) +(* ------------------------------------------------------------------------- *) + +let INFNORM_2 = prove + (`infnorm (x:real^2) = max (abs(x$1)) (abs(x$2))`, + REWRITE_TAC[infnorm; INFNORM_SET_IMAGE; NUMSEG_CONV `1..2`; DIMINDEX_2] THEN + REWRITE_TAC[IMAGE_CLAUSES; GSYM REAL_MAX_SUP]);; + +let INFNORM_EQ_1_2 = prove + (`infnorm (x:real^2) = &1 <=> + abs(x$1) <= &1 /\ abs(x$2) <= &1 /\ + (x$1 = -- &1 \/ x$1 = &1 \/ x$2 = -- &1 \/ x$2 = &1)`, + REWRITE_TAC[INFNORM_2] THEN REAL_ARITH_TAC);; + +let INFNORM_EQ_1_IMP = prove + (`infnorm (x:real^2) = &1 ==> abs(x$1) <= &1 /\ abs(x$2) <= &1`, + SIMP_TAC[INFNORM_EQ_1_2]);; + +let FASHODA_UNIT = prove + (`!f:real^1->real^2 g:real^1->real^2. + IMAGE f (interval[--vec 1,vec 1]) SUBSET interval[--vec 1,vec 1] /\ + IMAGE g (interval[--vec 1,vec 1]) SUBSET interval[--vec 1,vec 1] /\ + f continuous_on interval[--vec 1,vec 1] /\ + g continuous_on interval[--vec 1,vec 1] /\ + f(--vec 1)$1 = -- &1 /\ f(vec 1)$1 = &1 /\ + g(--vec 1)$2 = -- &1 /\ g(vec 1)$2 = &1 + ==> ?s t. s IN interval[--vec 1,vec 1] /\ + t IN interval[--vec 1,vec 1] /\ + f(s) = g(t)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[NOT_EXISTS_THM]) THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN DISCH_TAC THEN + ABBREV_TAC `sqprojection = \z:real^2. inv(infnorm z) % z` THEN + ABBREV_TAC `(negatex:real^2->real^2) = \x. vector[--(x$1); x$2]` THEN + SUBGOAL_THEN `!z:real^2. infnorm(negatex z:real^2) = infnorm z` ASSUME_TAC + THENL + [EXPAND_TAC "negatex" THEN SIMP_TAC[VECTOR_2; INFNORM_2] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!z. ~(z = vec 0) ==> infnorm((sqprojection:real^2->real^2) z) = &1` + ASSUME_TAC THENL + [EXPAND_TAC "sqprojection" THEN + REWRITE_TAC[INFNORM_MUL; REAL_ABS_INFNORM; REAL_ABS_INV] THEN + SIMP_TAC[REAL_MUL_LINV; INFNORM_EQ_0]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(\w. (negatex:real^2->real^2) + (sqprojection(f(lift(w$1)) - g(lift(w$2)):real^2))) + :real^2->real^2`; + `interval[--vec 1,vec 1]:real^2->bool`] + BROUWER_WEAK) THEN + REWRITE_TAC[NOT_IMP; COMPACT_INTERVAL; CONVEX_INTERVAL] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; INTERVAL_NE_EMPTY] THEN + SIMP_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN EXPAND_TAC "negatex" THEN + SIMP_TAC[linear; VECTOR_2; CART_EQ; FORALL_2; DIMINDEX_2; + VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT; + VECTOR_ADD_COMPONENT; ARITH] THEN + REAL_ARITH_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; DIMINDEX_2; ARITH] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[--vec 1:real^1,vec 1]`; + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + EXPAND_TAC "sqprojection" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_AT_INV THEN + REWRITE_TAC[CONTINUOUS_AT_LIFT_INFNORM; INFNORM_EQ_0; VECTOR_SUB_EQ] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; + VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^2` THEN STRIP_TAC THEN + SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; REAL_BOUNDS_LE; + VECTOR_NEG_COMPONENT; VEC_COMPONENT; ARITH] THEN + MATCH_MP_TAC INFNORM_EQ_1_IMP THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; + VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^2` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `infnorm(x:real^2) = &1` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [SYM th]) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN + SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; + VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP]; + ALL_TAC] THEN + SUBGOAL_THEN + `(!x i. 1 <= i /\ i <= 2 /\ ~(x = vec 0) + ==> (&0 < ((sqprojection:real^2->real^2) x)$i <=> &0 < x$i)) /\ + (!x i. 1 <= i /\ i <= 2 /\ ~(x = vec 0) + ==> ((sqprojection x)$i < &0 <=> x$i < &0))` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "sqprojection" THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; INFNORM_POS_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO]; + ALL_TAC] THEN + REWRITE_TAC[INFNORM_EQ_1_2; CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC + (REPEAT_TCL DISJ_CASES_THEN (fun th -> ASSUME_TAC th THEN MP_TAC th))) THEN + MAP_EVERY EXPAND_TAC ["x"; "negatex"] THEN REWRITE_TAC[VECTOR_2] THENL + [DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--x = -- &1 ==> &0 < x`)); + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `--x = &1 ==> x < &0`)); + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = -- &1 ==> x < &0`)); + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x = &1 ==> &0 < x`))] THEN + W(fun (_,w) -> FIRST_X_ASSUM(fun th -> + MP_TAC(PART_MATCH (lhs o rand) th (lhand w)))) THEN + (ANTS_TAC THENL + [REWRITE_TAC[VECTOR_SUB_EQ; ARITH] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; + VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP] THEN + REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC]) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH; + LIFT_NEG; LIFT_NUM] + THENL + [MATCH_MP_TAC(REAL_ARITH + `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&0 < -- &1 - x$1)`); + MATCH_MP_TAC(REAL_ARITH + `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&1 - x$1 < &0)`); + MATCH_MP_TAC(REAL_ARITH + `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(x$2 - -- &1 < &0)`); + MATCH_MP_TAC(REAL_ARITH + `abs(x$1) <= &1 /\ abs(x$2) <= &1 ==> ~(&0 < x$2 - &1)`)] THEN + (SUBGOAL_THEN `!z:real^2. abs(z$1) <= &1 /\ abs(z$2) <= &1 <=> + z IN interval[--vec 1,vec 1]` + (fun th -> REWRITE_TAC[th]) THENL + [SIMP_TAC[IN_INTERVAL; DIMINDEX_2; FORALL_2; VEC_COMPONENT; ARITH; + VECTOR_NEG_COMPONENT; DROP_NEG; DROP_VEC; LIFT_DROP] THEN + REAL_ARITH_TAC; + ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE f s SUBSET t ==> x IN s ==> f x IN t`)) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; LIFT_DROP] THEN + ASM_REWRITE_TAC[REAL_BOUNDS_LE]);; + +let FASHODA_UNIT_PATH = prove + (`!f:real^1->real^2 g:real^1->real^2. + path f /\ path g /\ + path_image f SUBSET interval[--vec 1,vec 1] /\ + path_image g SUBSET interval[--vec 1,vec 1] /\ + (pathstart f)$1 = -- &1 /\ (pathfinish f)$1 = &1 /\ + (pathstart g)$2 = -- &1 /\ (pathfinish g)$2 = &1 + ==> ?z. z IN path_image f /\ z IN path_image g`, + SIMP_TAC[path; path_image; pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC `iscale = \z:real^1. inv(&2) % (z + vec 1)` THEN + MP_TAC(ISPECL + [`(f:real^1->real^2) o (iscale:real^1->real^1)`; + `(g:real^1->real^2) o (iscale:real^1->real^1)`] + FASHODA_UNIT) THEN + SUBGOAL_THEN + `IMAGE (iscale:real^1->real^1) (interval[--vec 1,vec 1]) + SUBSET interval[vec 0,vec 1]` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN EXPAND_TAC "iscale" THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; DROP_CMUL; DROP_ADD] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(iscale:real^1->real^1) continuous_on interval [--vec 1,vec 1]` + ASSUME_TAC THENL + [EXPAND_TAC "iscale" THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_ADD; + CONTINUOUS_ON_CONST]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL + [REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REPLICATE_TAC 2 (CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + ALL_TAC]) THEN + EXPAND_TAC "iscale" THEN REWRITE_TAC[o_THM] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `inv(&2) % (--x + x) = vec 0`; + VECTOR_ARITH `inv(&2) % (x + x) = x`]; + REWRITE_TAC[o_THM; LEFT_IMP_EXISTS_THM; IN_IMAGE] THEN ASM SET_TAC[]]);; + +let FASHODA = prove + (`!f g a b:real^2. + path f /\ path g /\ + path_image f SUBSET interval[a,b] /\ + path_image g SUBSET interval[a,b] /\ + (pathstart f)$1 = a$1 /\ (pathfinish f)$1 = b$1 /\ + (pathstart g)$2 = a$2 /\ (pathfinish g)$2 = b$2 + ==> ?z. z IN path_image f /\ z IN path_image g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(interval[a:real^2,b] = {})` MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN + REWRITE_TAC[PATH_IMAGE_NONEMPTY]; + ALL_TAC] THEN + REWRITE_TAC[INTERVAL_NE_EMPTY; DIMINDEX_2; FORALL_2] THEN STRIP_TAC THEN + MP_TAC(ASSUME `(a:real^2)$1 <= (b:real^2)$1`) THEN + REWRITE_TAC[REAL_ARITH `a <= b <=> b = a \/ a < b`] THEN STRIP_TAC THENL + [SUBGOAL_THEN + `?z:real^2. z IN path_image g /\ z$2 = (pathstart f:real^2)$2` + MP_TAC THENL + [MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN + MAP_EVERY EXISTS_TAC [`pathstart(g:real^1->real^2)`; + `pathfinish(g:real^1->real^2)`] THEN + ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; REAL_LE_REFL; + PATHFINISH_IN_PATH_IMAGE; DIMINDEX_2; ARITH] THEN + UNDISCH_TAC `path_image f SUBSET interval[a:real^2,b]` THEN + REWRITE_TAC[SUBSET; path_image; IN_INTERVAL_1; FORALL_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN SIMP_TAC[pathstart] THEN + SIMP_TAC[DROP_VEC; REAL_POS; IN_INTERVAL; FORALL_2; DIMINDEX_2]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[path_image; IN_IMAGE] THEN + EXISTS_TAC `vec 0:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN + ASM_REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; pathstart] THEN + SUBGOAL_THEN + `(z:real^2) IN interval[a,b] /\ f(vec 0:real^1) IN interval[a,b]` + MP_TAC THENL + [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE; PATHSTART_IN_PATH_IMAGE; + pathstart]; + ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ASSUME `(a:real^2)$2 <= (b:real^2)$2`) THEN + REWRITE_TAC[REAL_ARITH `a <= b <=> b = a \/ a < b`] THEN STRIP_TAC THENL + [SUBGOAL_THEN + `?z:real^2. z IN path_image f /\ z$1 = (pathstart g:real^2)$1` + MP_TAC THENL + [MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN + MAP_EVERY EXISTS_TAC [`pathstart(f:real^1->real^2)`; + `pathfinish(f:real^1->real^2)`] THEN + ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; REAL_LE_REFL; + PATHFINISH_IN_PATH_IMAGE; DIMINDEX_2; ARITH] THEN + UNDISCH_TAC `path_image g SUBSET interval[a:real^2,b]` THEN + REWRITE_TAC[SUBSET; path_image; IN_INTERVAL_1; FORALL_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN SIMP_TAC[pathstart] THEN + SIMP_TAC[DROP_VEC; REAL_POS; IN_INTERVAL; FORALL_2; DIMINDEX_2]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[path_image; IN_IMAGE] THEN + EXISTS_TAC `vec 0:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN + ASM_REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2; pathstart] THEN + SUBGOAL_THEN + `(z:real^2) IN interval[a,b] /\ g(vec 0:real^1) IN interval[a,b]` + MP_TAC THENL + [ASM_MESON_TAC[SUBSET; path_image; IN_IMAGE; PATHSTART_IN_PATH_IMAGE; + pathstart]; + ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`interval_bij (a,b) (--vec 1,vec 1) o (f:real^1->real^2)`; + `interval_bij (a,b) (--vec 1,vec 1) o (g:real^1->real^2)`] + FASHODA_UNIT_PATH) THEN + RULE_ASSUM_TAC(REWRITE_RULE[path; path_image; pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish; o_THM] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_INTERVAL_BIJ] THEN + REWRITE_TAC[IMAGE_o] THEN REPLICATE_TAC 2 (CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_INTERVAL_INTERVAL_BIJ THEN + SIMP_TAC[INTERVAL_NE_EMPTY; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM SET_TAC[]; + ALL_TAC]) THEN + ASM_SIMP_TAC[interval_bij; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN + REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO] THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^2` + (fun th -> EXISTS_TAC `interval_bij (--vec 1,vec 1) (a,b) (z:real^2)` THEN + MP_TAC th)) THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN REWRITE_TAC[IMAGE_o] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> g(f(x)) = x) ==> x IN IMAGE f s ==> g x IN s`) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERVAL_BIJ_BIJ THEN + ASM_SIMP_TAC[FORALL_2; DIMINDEX_2; VECTOR_NEG_COMPONENT; VEC_COMPONENT; + ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Some slightly ad hoc lemmas I use below *) +(* ------------------------------------------------------------------------- *) + +let SEGMENT_VERTICAL = prove + (`!a:real^2 b:real^2 x:real^2. + a$1 = b$1 + ==> (x IN segment[a,b] <=> + x$1 = a$1 /\ x$1 = b$1 /\ + (a$2 <= x$2 /\ x$2 <= b$2 \/ b$2 <= x$2 /\ x$2 <= a$2))`, + GEOM_ORIGIN_TAC `a:real^2` THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LE_LADD; + REAL_EQ_ADD_LCANCEL] THEN + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + SUBST1_TAC(SYM(ISPEC `b:real^2` BASIS_EXPANSION)) THEN + ASM_REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^2 = &0 % basis 2`) THEN + REWRITE_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM; CART_EQ] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH; + REAL_MUL_RZERO; REAL_MUL_RID] THEN MESON_TAC[]);; + +let SEGMENT_HORIZONTAL = prove + (`!a:real^2 b:real^2 x:real^2. + a$2 = b$2 + ==> (x IN segment[a,b] <=> + x$2 = a$2 /\ x$2 = b$2 /\ + (a$1 <= x$1 /\ x$1 <= b$1 \/ b$1 <= x$1 /\ x$1 <= a$1))`, + GEOM_ORIGIN_TAC `a:real^2` THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VEC_COMPONENT; REAL_LE_LADD; + REAL_EQ_ADD_LCANCEL] THEN + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + SUBST1_TAC(SYM(ISPEC `b:real^2` BASIS_EXPANSION)) THEN + ASM_REWRITE_TAC[DIMINDEX_2; VSUM_2; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^2 = &0 % basis 1`) THEN + REWRITE_TAC[SEGMENT_SCALAR_MULTIPLE; IN_ELIM_THM; CART_EQ] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_2; ARITH; + REAL_MUL_RZERO; REAL_MUL_RID] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Useful Fashoda corollary pointed out to me by Tom Hales. *) +(* ------------------------------------------------------------------------- *) + +let FASHODA_INTERLACE = prove + (`!f g a b:real^2. + path f /\ path g /\ + path_image f SUBSET interval[a,b] /\ + path_image g SUBSET interval[a,b] /\ + (pathstart f)$2 = a$2 /\ (pathfinish f)$2 = a$2 /\ + (pathstart g)$2 = a$2 /\ (pathfinish g)$2 = a$2 /\ + (pathstart f)$1 < (pathstart g)$1 /\ + (pathstart g)$1 < (pathfinish f)$1 /\ + (pathfinish f)$1 < (pathfinish g)$1 + ==> ?z. z IN path_image f /\ z IN path_image g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(interval[a:real^2,b] = {})` MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN + REWRITE_TAC[PATH_IMAGE_NONEMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN + `pathstart (f:real^1->real^2) IN interval[a,b] /\ + pathfinish f IN interval[a,b] /\ + pathstart g IN interval[a,b] /\ + pathfinish g IN interval[a,b]` + MP_TAC THENL + [ASM_MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL + [`linepath(vector[a$1 - &2;a$2 - &2],vector[(pathstart f)$1;a$2 - &2]) ++ + linepath(vector[(pathstart f)$1;(a:real^2)$2 - &2],pathstart f) ++ + (f:real^1->real^2) ++ + linepath(pathfinish f,vector[(pathfinish f)$1;a$2 - &2]) ++ + linepath(vector[(pathfinish f)$1;a$2 - &2], + vector[(b:real^2)$1 + &2;a$2 - &2])`; + `linepath(vector[(pathstart g)$1; (pathstart g)$2 - &3],pathstart g) ++ + (g:real^1->real^2) ++ + linepath(pathfinish g,vector[(pathfinish g)$1;(a:real^2)$2 - &1]) ++ + linepath(vector[(pathfinish g)$1;a$2 - &1],vector[b$1 + &1;a$2 - &1]) ++ + linepath(vector[b$1 + &1;a$2 - &1],vector[(b:real^2)$1 + &1;b$2 + &3])`; + `vector[(a:real^2)$1 - &2; a$2 - &3]:real^2`; + `vector[(b:real^2)$1 + &2; b$2 + &3]:real^2`] + FASHODA) THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_IMAGE_JOIN; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN + REWRITE_TAC[VECTOR_2] THEN ANTS_TAC THENL + [CONJ_TAC THEN + REPEAT(MATCH_MP_TAC + (SET_RULE `s SUBSET u /\ t SUBSET u ==> (s UNION t) SUBSET u`) THEN + CONJ_TAC) THEN + TRY(REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + MATCH_MP_TAC(REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] + (CONJUNCT1 (SPEC_ALL CONVEX_INTERVAL))) THEN + ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2; VECTOR_2] THEN + ASM_REAL_ARITH_TAC) THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `interval[a:real^2,b:real^2]` THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + REWRITE_TAC[SUBSET_INTERVAL; FORALL_2; DIMINDEX_2; VECTOR_2] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^2` THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + SUBGOAL_THEN + `!f s:real^2->bool. path_image f UNION s = + path_image f UNION (s DIFF {pathstart f,pathfinish f})` + (fun th -> ONCE_REWRITE_TAC[th] THEN + REWRITE_TAC[GSYM UNION_ASSOC] THEN + ONCE_REWRITE_TAC[SET_RULE `(s UNION t) UNION u = + u UNION t UNION s`] THEN + ONCE_REWRITE_TAC[th]) + THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + REWRITE_TAC[IN_UNION; IN_DIFF; GSYM DISJ_ASSOC; LEFT_OR_DISTRIB; + RIGHT_OR_DISTRIB; GSYM CONJ_ASSOC; + SET_RULE `~(z IN {x,y}) <=> ~(z = x) /\ ~(z = y)`] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THEN + ASM_SIMP_TAC[SEGMENT_VERTICAL; SEGMENT_HORIZONTAL; VECTOR_2] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `path_image (f:real^1->real^2) SUBSET interval [a,b]` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN + UNDISCH_TAC `path_image (g:real^1->real^2) SUBSET interval [a,b]` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN + ASM_REWRITE_TAC[IN_INTERVAL; FORALL_2; DIMINDEX_2] THEN + REPEAT(DISCH_THEN(fun th -> if is_imp(concl th) then ALL_TAC else + ASSUME_TAC th)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN TRY REAL_ARITH_TAC THEN + REWRITE_TAC[CART_EQ; FORALL_2; DIMINDEX_2] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Complement in dimension N >= 2 of set homeomorphic to any interval in *) +(* any dimension is (path-)connected. This naively generalizes the argument *) +(* in Ryuji Maehara's paper "The Jordan curve theorem via the Brouwer *) +(* fixed point theorem", American Mathematical Monthly 1984. *) +(* ------------------------------------------------------------------------- *) + +let UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT = prove + (`!s c. compact s /\ AR s /\ c IN components((:real^N) DIFF s) + ==> ~bounded c`, + REWRITE_TAC[CONJ_ASSOC; COMPACT_AR] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN + GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `open((:real^N) DIFF s)` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + REWRITE_TAC[retraction; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real^N->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`connected_component ((:real^N) DIFF s) y`; + `s:real^N->bool`; + `r:real^N->real^N`] + FRONTIER_SUBSET_RETRACTION) THEN + ASM_SIMP_TAC[NOT_IMP; INTERIOR_OPEN; OPEN_CONNECTED_COMPONENT] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[frontier] THEN + ASM_SIMP_TAC[INTERIOR_OPEN; OPEN_CONNECTED_COMPONENT] THEN + REWRITE_TAC[SUBSET; IN_DIFF] THEN X_GEN_TAC `z:real^N` THEN + ASM_CASES_TAC `(z:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[IN_CLOSURE_CONNECTED_COMPONENT; IN_UNIV; IN_DIFF] THEN + CONV_TAC TAUT; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `~(c = {}) /\ c SUBSET (:real^N) DIFF s ==> ~(c SUBSET s)`) THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_EQ_EMPTY] THEN + ASM_REWRITE_TAC[IN_UNIV; IN_DIFF]]);; + +let CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT = prove + (`!s. 2 <= dimindex(:N) /\ compact s /\ AR s + ==> connected((:real^N) DIFF s)`, + REWRITE_TAC[COMPACT_AR] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN + ASM_SIMP_TAC[SET_RULE`UNIV DIFF (UNIV DIFF s) = s`; COMPACT_IMP_BOUNDED] THEN + CONJ_TAC THEN + MATCH_MP_TAC UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT THEN + EXISTS_TAC `s:real^N->bool` THEN REWRITE_TAC[CONJ_ASSOC; COMPACT_AR] THEN + ASM_REWRITE_TAC[IN_COMPONENTS] THEN ASM_MESON_TAC[]);; + +let PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT = prove + (`!s:real^N->bool. + 2 <= dimindex(:N) /\ compact s /\ AR s + ==> path_connected((:real^N) DIFF s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT) THEN + MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PATH_CONNECTED_EQ_CONNECTED THEN + REWRITE_TAC[GSYM closed] THEN + ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_INTERVAL; + COMPACT_IMP_CLOSED]);; + +let CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT = prove + (`!s:real^N->bool t:real^M->bool. + 2 <= dimindex(:N) /\ s homeomorphic t /\ convex t /\ compact t + ==> connected((:real^N) DIFF s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[DIFF_EMPTY; CONNECTED_UNIV] THEN + MATCH_MP_TAC CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_ARNESS) THEN + ASM_MESON_TAC[CONVEX_IMP_AR; HOMEOMORPHIC_EMPTY]);; + +let PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT = prove + (`!s:real^N->bool t:real^M->bool. + 2 <= dimindex(:N) /\ s homeomorphic t /\ convex t /\ compact t + ==> path_connected((:real^N) DIFF s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN + MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PATH_CONNECTED_EQ_CONNECTED THEN + REWRITE_TAC[GSYM closed] THEN + ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_INTERVAL; + COMPACT_IMP_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, apply all these to the special case of an arc. *) +(* ------------------------------------------------------------------------- *) + +let RETRACTION_ARC = prove + (`!p. arc p + ==> ?f. f continuous_on (:real^N) /\ + IMAGE f (:real^N) SUBSET path_image p /\ + (!x. x IN path_image p ==> f x = x)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(:real^N)` o MATCH_MP (REWRITE_RULE[IMP_CONJ] + ABSOLUTE_RETRACT_PATH_IMAGE_ARC)) THEN + REWRITE_TAC[SUBSET_UNIV; retract_of; retraction]);; + +let PATH_CONNECTED_ARC_COMPLEMENT = prove + (`!p. 2 <= dimindex(:N) /\ arc p + ==> path_connected((:real^N) DIFF path_image p)`, + REWRITE_TAC[arc; path] THEN REPEAT STRIP_TAC THEN SIMP_TAC[path_image] THEN + MP_TAC(ISPECL [`path_image p:real^N->bool`; `interval[vec 0:real^1,vec 1]`] + PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN + ASM_REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; path_image] THEN + DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + EXISTS_TAC `p:real^1->real^N` THEN ASM_REWRITE_TAC[COMPACT_INTERVAL]);; + +let CONNECTED_ARC_COMPLEMENT = prove + (`!p. 2 <= dimindex(:N) /\ arc p + ==> connected((:real^N) DIFF path_image p)`, + SIMP_TAC[PATH_CONNECTED_ARC_COMPLEMENT; PATH_CONNECTED_IMP_CONNECTED]);; + +let INSIDE_ARC_EMPTY = prove + (`!p:real^1->real^N. arc p ==> inside(path_image p) = {}`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [MATCH_MP_TAC INSIDE_CONVEX THEN + ASM_SIMP_TAC[CONVEX_CONNECTED_1_GEN; CONNECTED_PATH_IMAGE; ARC_IMP_PATH]; + MATCH_MP_TAC INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY THEN + ASM_SIMP_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH] THEN + MATCH_MP_TAC CONNECTED_ARC_COMPLEMENT THEN + ASM_REWRITE_TAC[ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`] THEN + REWRITE_TAC[DIMINDEX_GE_1]]);; + +let INSIDE_SIMPLE_CURVE_IMP_CLOSED = prove + (`!g x:real^N. + simple_path g /\ x IN inside(path_image g) + ==> pathfinish g = pathstart g`, + MESON_TAC[ARC_SIMPLE_PATH; INSIDE_ARC_EMPTY; NOT_IN_EMPTY]);; diff --git a/Multivariate/flyspeck.ml b/Multivariate/flyspeck.ml new file mode 100644 index 0000000..d246999 --- /dev/null +++ b/Multivariate/flyspeck.ml @@ -0,0 +1,7091 @@ +(* ========================================================================= *) +(* Results intended for Flyspeck. *) +(* ========================================================================= *) + +needs "Multivariate/polytope.ml";; +needs "Multivariate/realanalysis.ml";; +needs "Multivariate/geom.ml";; +needs "Multivariate/cross.ml";; + +prioritize_vector();; + +(* ------------------------------------------------------------------------- *) +(* Not really Flyspeck-specific but needs both angles and cross products. *) +(* ------------------------------------------------------------------------- *) + +let NORM_CROSS = prove + (`!x y. norm(x cross y) = norm(x) * norm(y) * sin(vector_angle x y)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN + SIMP_TAC[NORM_POS_LE; SIN_VECTOR_ANGLE_POS; REAL_LE_MUL; ARITH_EQ] THEN + MP_TAC(SPECL [`x:real^3`; `y:real^3`] NORM_CROSS_DOT) THEN + REWRITE_TAC[VECTOR_ANGLE] THEN + MP_TAC(SPEC `vector_angle (x:real^3) y` SIN_CIRCLE) THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Other miscelleneous lemmas. *) +(* ------------------------------------------------------------------------- *) + +let COPLANAR_INSERT_0_NEG = prove + (`coplanar(vec 0 INSERT --x INSERT s) <=> coplanar(vec 0 INSERT x INSERT s)`, + REWRITE_TAC[coplanar; INSERT_SUBSET] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a ==> ~(b /\ c))`] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_NEG_EQ]);; + +let COPLANAR_IMP_NEGLIGIBLE = prove + (`!s:real^3->bool. coplanar s ==> negligible s`, + REWRITE_TAC[coplanar] THEN + MESON_TAC[NEGLIGIBLE_AFFINE_HULL_3; NEGLIGIBLE_SUBSET]);; + +let NOT_COPLANAR_0_4_IMP_INDEPENDENT = prove + (`!v1 v2 v3:real^N. ~coplanar {vec 0,v1,v2,v3} ==> independent {v1,v2,v3}`, + REPEAT GEN_TAC THEN REWRITE_TAC[independent; CONTRAPOS_THM] THEN + REWRITE_TAC[dependent] THEN + SUBGOAL_THEN + `!v1 v2 v3:real^N. v1 IN span {v2,v3} ==> coplanar{vec 0,v1,v2,v3}` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `v2:real^N`; `v3:real^N`] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`v1:real^N`,`v1:real^N`) THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`v1:real^N`; `v2:real^N`; `v3:real^N`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`v2:real^N`; `v3:real^N`; `v1:real^N`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`v3:real^N`; `v1:real^N`; `v2:real^N`])] + THEN REWRITE_TAC[INSERT_AC] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `a IN s ==> s SUBSET t ==> a IN t`)) THEN + MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]]);; + +let NOT_COPLANAR_NOT_COLLINEAR = prove + (`!v1 v2 v3 w:real^N. ~coplanar {v1, v2, v3, w} ==> ~collinear {v1, v2, v3}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar; CONTRAPOS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN + EXISTS_TAC `w:real^N` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN + REPEAT CONJ_TAC THEN + MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN + EXISTS_TAC `affine hull {x:real^N,y}` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some special scaling theorems. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_AFFINE_HULL_SPECIAL_SCALE = prove + (`!a x s t. + ~(a = &0) + ==> (vec 0 INSERT (a % x) INSERT s SUBSET affine hull t <=> + vec 0 INSERT x INSERT s SUBSET affine hull t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[INSERT_SUBSET] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; SPAN_MUL_EQ]);; + +let COLLINEAR_SPECIAL_SCALE = prove + (`!a x y. ~(a = &0) ==> (collinear {vec 0,a % x,y} <=> collinear{vec 0,x,y})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + ASM_SIMP_TAC[SUBSET_AFFINE_HULL_SPECIAL_SCALE]);; + +let COLLINEAR_SCALE_ALL = prove + (`!a b v w. ~(a = &0) /\ ~(b = &0) + ==> (collinear {vec 0,a % v,b % w} <=> collinear {vec 0,v,w})`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN + ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE]);; + +let COPLANAR_SPECIAL_SCALE = prove + (`!a x y z. + ~(a = &0) ==> (coplanar {vec 0,a % x,y,z} <=> coplanar {vec 0,x,y,z})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[coplanar] THEN + ASM_SIMP_TAC[SUBSET_AFFINE_HULL_SPECIAL_SCALE]);; + +let COPLANAR_SCALE_ALL = prove + (`!a b c x y z. + ~(a = &0) /\ ~(b = &0) /\ ~(c = &0) + ==> (coplanar {vec 0,a % x,b % y,c % z} <=> coplanar {vec 0,x,y,z})`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,c,d,b}`] THEN + ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,c,d,b}`] THEN + ASM_SIMP_TAC[COPLANAR_SPECIAL_SCALE]);; + +(* ------------------------------------------------------------------------- *) +(* Specialized lemmas about "dropout". *) +(* ------------------------------------------------------------------------- *) + +let DROPOUT_BASIS_3 = prove + (`(dropout 3:real^3->real^2) (basis 1) = basis 1 /\ + (dropout 3:real^3->real^2) (basis 2) = basis 2 /\ + (dropout 3:real^3->real^2) (basis 3) = vec 0`, + SIMP_TAC[LAMBDA_BETA; dropout; basis; CART_EQ; DIMINDEX_2; DIMINDEX_3; ARITH; + VEC_COMPONENT; LT_IMP_LE; ARITH_RULE `i <= 2 ==> i + 1 <= 3`; + ARITH_RULE `1 <= i + 1`] THEN + ARITH_TAC);; + +let COLLINEAR_BASIS_3 = prove + (`collinear {vec 0,basis 3,x} <=> (dropout 3:real^3->real^2) x = vec 0`, + SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; + dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; + COLLINEAR_LEMMA] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN REAL_ARITH_TAC);; + +let OPEN_DROPOUT_3 = prove + (`!P. open {x | P x} ==> open {x | P((dropout 3:real^3->real^2) x)}`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`dropout 3:real^3->real^2`; `{x:real^2 | P x}`] + CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + SIMP_TAC[LINEAR_DROPOUT; DIMINDEX_2; DIMINDEX_3; ARITH]);; + +let SLICE_DROPOUT_3 = prove + (`!P t. slice 3 t {x | P((dropout 3:real^3->real^2) x)} = {x | P x}`, + REPEAT GEN_TAC THEN REWRITE_TAC[slice] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `y:real^2` THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC `(pushin 3 t:real^2->real^3) y` THEN + ASM_SIMP_TAC[DIMINDEX_2; DIMINDEX_3; DROPOUT_PUSHIN; ARITH] THEN + SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL; DIMINDEX_3; ARITH]);; + +let NOT_COPLANAR_IMP_NOT_COLLINEAR_DROPOUT_3 = prove + (`!x y:real^3. + ~coplanar {vec 0,basis 3, x, y} + ==> ~collinear {vec 0,dropout 3 x:real^2,dropout 3 y}`, + REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar] THEN + REWRITE_TAC[CONTRAPOS_THM; INSERT_SUBSET; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^2`; `v:real^2`] THEN + REWRITE_TAC[EMPTY_SUBSET] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [AFFINE_HULL_2]) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real`;`b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `?r s. a * r + b * s = -- &1` STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `a = &0` THENL + [UNDISCH_TAC `a + b = &1` THEN + ASM_SIMP_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_LID; EXISTS_REFL]; + ASM_SIMP_TAC[REAL_FIELD + `~(a = &0) ==> (a * r + x = y <=> r = (y - x) / a)`] THEN + MESON_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `vector[(u:real^2)$1; u$2; r]:real^3` THEN + EXISTS_TAC `vector[(v:real^2)$1; v$2; s]:real^3` THEN + EXISTS_TAC `basis 3:real^3` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY EXISTS_TAC [`a / &2`;`b / &2`; `&1 / &2`] THEN + ASM_REWRITE_TAC[REAL_ARITH + `a / &2 + b / &2 + &1 / &2 = &1 <=> a + b = &1`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; + VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_3; BASIS_COMPONENT; ARITH] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN DISCH_TAC THEN + SIMP_TAC[SPAN_SUPERSET; IN_INSERT] THEN + SUBGOAL_THEN + `!x. (dropout 3:real^3->real^2) x IN span {u,v} + ==> x IN span {vector [u$1; u$2; r], vector [v$1; v$2; s], basis 3}` + (fun th -> ASM_MESON_TAC[th]) THEN + GEN_TAC THEN REWRITE_TAC[SPAN_2; SPAN_3] THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV; CART_EQ; DIMINDEX_2; DIMINDEX_3; + FORALL_2; FORALL_3; dropout; VECTOR_ADD_COMPONENT; LAMBDA_BETA; + VECTOR_MUL_COMPONENT; VECTOR_3; BASIS_COMPONENT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH `x = a + b + c * &1 <=> c = x - a - b`] THEN + REWRITE_TAC[EXISTS_REFL]);; + +let SLICE_312 = prove + (`!s:real^3->bool. slice 1 t s = {y:real^2 | vector[t;y$1;y$2] IN s}`, + SIMP_TAC[EXTENSION; IN_SLICE; DIMINDEX_2; DIMINDEX_3; ARITH] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; pushin; LAMBDA_BETA; FORALL_3; DIMINDEX_3; ARITH; + VECTOR_3]);; + +let SLICE_123 = prove + (`!s:real^3->bool. slice 3 t s = {y:real^2 | vector[y$1;y$2;t] IN s}`, + SIMP_TAC[EXTENSION; IN_SLICE; DIMINDEX_2; DIMINDEX_3; ARITH] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; pushin; LAMBDA_BETA; FORALL_3; DIMINDEX_3; ARITH; + VECTOR_3]);; + +(* ------------------------------------------------------------------------- *) +(* "Padding" injection from real^2 -> real^3 with zero last coordinate. *) +(* ------------------------------------------------------------------------- *) + +let pad2d3d = new_definition + `(pad2d3d:real^2->real^3) x = lambda i. if i < 3 then x$i else &0`;; + +let FORALL_PAD2D3D_THM = prove + (`!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))`, + GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[pad2d3d] THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; LT_REFL]; + FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (y:real^3)$i):real^2`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; pad2d3d; DIMINDEX_3; ARITH; LAMBDA_BETA; DIMINDEX_2; + ARITH_RULE `i < 3 <=> i <= 2`] THEN + REWRITE_TAC[ARITH_RULE `i <= 3 <=> i <= 2 \/ i = 3`] THEN + ASM_MESON_TAC[]]);; + +let QUANTIFY_PAD2D3D_THM = prove + (`(!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))) /\ + (!P. (?y:real^3. y$3 = &0 /\ P y) <=> (?x. P(pad2d3d x)))`, + REWRITE_TAC[MESON[] `(?y. P y) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[GSYM FORALL_PAD2D3D_THM] THEN MESON_TAC[]);; + +let LINEAR_PAD2D3D = prove + (`linear pad2d3d`, + REWRITE_TAC[linear; pad2d3d] THEN + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH; + ARITH_RULE `i < 3 ==> i <= 2`] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REAL_ARITH_TAC);; + +let INJECTIVE_PAD2D3D = prove + (`!x y. pad2d3d x = pad2d3d y ==> x = y`, + SIMP_TAC[CART_EQ; pad2d3d; LAMBDA_BETA; DIMINDEX_3; DIMINDEX_2] THEN + REWRITE_TAC[ARITH_RULE `i < 3 <=> i <= 2`] THEN + MESON_TAC[ARITH_RULE `i <= 2 ==> i <= 3`]);; + +let NORM_PAD2D3D = prove + (`!x. norm(pad2d3d x) = norm x`, + SIMP_TAC[NORM_EQ; DOT_2; DOT_3; pad2d3d; LAMBDA_BETA; + DIMINDEX_2; DIMINDEX_3; ARITH] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Apply 3D->2D conversion to a goal. Take care to preserve variable names. *) +(* ------------------------------------------------------------------------- *) + +let PAD2D3D_QUANTIFY_CONV = + let gv = genvar `:real^2` in + let pth = CONV_RULE (BINOP_CONV(BINDER_CONV(RAND_CONV(GEN_ALPHA_CONV gv)))) + QUANTIFY_PAD2D3D_THM in + let conv1 = GEN_REWRITE_CONV I [pth] + and dest_quant tm = try dest_forall tm with Failure _ -> dest_exists tm in + fun tm -> + let th = conv1 tm in + let name = fst(dest_var(fst(dest_quant tm))) in + let ty = snd(dest_var(fst(dest_quant(rand(concl th))))) in + CONV_RULE(RAND_CONV(GEN_ALPHA_CONV(mk_var(name,ty)))) th;; + +let PAD2D3D_TAC = + let pad2d3d_tm = `pad2d3d` + and pths = [LINEAR_PAD2D3D; INJECTIVE_PAD2D3D; NORM_PAD2D3D] + and cth = prove + (`{} = IMAGE pad2d3d {} /\ + vec 0 = pad2d3d(vec 0)`, + REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_PAD2D3D; LINEAR_0]) in + let lasttac = + GEN_REWRITE_TAC REDEPTH_CONV [LINEAR_INVARIANTS pad2d3d_tm pths] in + fun gl -> (GEN_REWRITE_TAC ONCE_DEPTH_CONV [cth] THEN + CONV_TAC(DEPTH_CONV PAD2D3D_QUANTIFY_CONV) THEN + lasttac) gl;; + +(* ------------------------------------------------------------------------- *) +(* The notion of a plane, and using it to characterize coplanarity. *) +(* ------------------------------------------------------------------------- *) + +let plane = new_definition + `plane x = (?u v w. ~(collinear {u,v,w}) /\ x = affine hull {u,v,w})`;; + +let PLANE_TRANSLATION_EQ = prove + (`!a:real^N s. plane(IMAGE (\x. a + x) s) <=> plane s`, + REWRITE_TAC[plane] THEN GEOM_TRANSLATE_TAC[]);; + +let PLANE_TRANSLATION = prove + (`!a:real^N s. plane s ==> plane(IMAGE (\x. a + x) s)`, + REWRITE_TAC[PLANE_TRANSLATION_EQ]);; + +add_translation_invariants [PLANE_TRANSLATION_EQ];; + +let PLANE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N p. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (plane(IMAGE f p) <=> plane p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[plane] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `?u. u IN IMAGE f (:real^M) /\ + ?v. v IN IMAGE f (:real^M) /\ + ?w. w IN IMAGE (f:real^M->real^N) (:real^M) /\ + ~collinear {u, v, w} /\ IMAGE f p = affine hull {u, v, w}` THEN + CONJ_TAC THENL + [REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN_IMAGE; IN_UNIV] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{u,v,w} SUBSET IMAGE (f:real^M->real^N) p` MP_TAC THENL + [ASM_REWRITE_TAC[HULL_SUBSET]; SET_TAC[]]; + REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN + ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL + [ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ]; ASM SET_TAC[]]]);; + +let PLANE_LINEAR_IMAGE = prove + (`!f:real^M->real^N p. + linear f /\ plane p /\ (!x y. f x = f y ==> x = y) + ==> plane(IMAGE f p)`, + MESON_TAC[PLANE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [PLANE_LINEAR_IMAGE_EQ];; + +let AFFINE_PLANE = prove + (`!p. plane p ==> affine p`, + SIMP_TAC[plane; LEFT_IMP_EXISTS_THM; AFFINE_AFFINE_HULL]);; + +let ROTATION_PLANE_HORIZONTAL = prove + (`!s. plane s + ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ + IMAGE f (IMAGE (\x. a + x) s) = {z:real^3 | z$3 = &0}`, + let lemma = prove + (`span {z:real^3 | z$3 = &0} = {z:real^3 | z$3 = &0}`, + REWRITE_TAC[SPAN_EQ_SELF; subspace; IN_ELIM_THM] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; + ALL_TAC]) + [`a:real^3 = b`; `a:real^3 = c`; `b:real^3 = c`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN + ASM_SIMP_TAC[AFFINE_HULL_INSERT_SPAN; IN_INSERT; NOT_IN_EMPTY] THEN + EXISTS_TAC `--a:real^3` THEN + REWRITE_TAC[SET_RULE `IMAGE (\x:real^3. --a + x) {a + x | x | x IN s} = + IMAGE (\x. --a + a + x) s`] THEN + REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^3 = x`; IMAGE_ID] THEN + REWRITE_TAC[SET_RULE `{x - a:real^x | x = b \/ x = c} = {b - a,c - a}`] THEN + MP_TAC(ISPEC `span{b - a:real^3,c - a}` + ROTATION_LOWDIM_HORIZONTAL) THEN + REWRITE_TAC[DIMINDEX_3] THEN ANTS_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD{b - a:real^3,c - a}` THEN + SIMP_TAC[DIM_SPAN; DIM_LE_CARD; FINITE_RULES] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^3->real^3` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM lemma] THEN + MATCH_MP_TAC DIM_EQ_SPAN THEN CONJ_TAC THENL + [ASM_MESON_TAC[IMAGE_SUBSET; SPAN_INC; SUBSET_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`{z:real^3 | z$3 = &0}`; `(:real^3)`] DIM_EQ_SPAN) THEN + REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3; lemma] THEN + MATCH_MP_TAC(TAUT `~r /\ (~p ==> q) ==> (q ==> r) ==> p`) THEN + REWRITE_TAC[ARITH_RULE `~(x <= 2) <=> 3 <= x`] THEN + REWRITE_TAC[EXTENSION; SPAN_UNIV; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `vector[&0;&0;&1]:real^3`) THEN + REWRITE_TAC[IN_UNIV; VECTOR_3] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim {b - a:real^3,c - a}` THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[LE_REFL; DIM_INJECTIVE_LINEAR_IMAGE; + ORTHOGONAL_TRANSFORMATION_INJECTIVE]] THEN + MP_TAC(ISPEC `{b - a:real^3,c - a}` INDEPENDENT_BOUND_GENERAL) THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`; ARITH] THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) + [SET_RULE `{a,b,c} = {b,a,c}`]) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[independent; CONTRAPOS_THM; dependent] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN + ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {a,b} DELETE b = {a}`; + SET_RULE `~(a = b) ==> {a,b} DELETE a = {b}`; + VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`] THEN + REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN + ONCE_REWRITE_TAC[VECTOR_SUB_EQ] THEN MESON_TAC[COLLINEAR_LEMMA; INSERT_AC]);; + +let ROTATION_HORIZONTAL_PLANE = prove + (`!p. plane p + ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ + IMAGE (\x. a + x) (IMAGE f {z:real^3 | z$3 = &0}) = p`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP ROTATION_PLANE_HORIZONTAL) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^3` + (X_CHOOSE_THEN `f:real^3->real^3` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(X_CHOOSE_THEN `g:real^3->real^3` STRIP_ASSUME_TAC o MATCH_MP + ORTHOGONAL_TRANSFORMATION_INVERSE) THEN + MAP_EVERY EXISTS_TAC [`--a:real^3`; `g:real^3->real^3`] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^3 = x`] THEN + MATCH_MP_TAC(REAL_RING `!f. f * g = &1 /\ f = &1 ==> g = &1`) THEN + EXISTS_TAC `det(matrix(f:real^3->real^3))` THEN + REWRITE_TAC[GSYM DET_MUL] THEN + ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + ASM_REWRITE_TAC[o_DEF; MATRIX_ID; DET_I]);; + +let COPLANAR = prove + (`2 <= dimindex(:N) + ==> !s:real^N->bool. coplanar s <=> ?x. plane x /\ s SUBSET x`, + DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[coplanar; plane] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[MESON[] + `(?x u v w. p x u v w) <=> (?u v w x. p x u v w)`] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + EQ_TAC THENL [MESON_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`; `w:real^N`] THEN DISCH_TAC THEN + SUBGOAL_THEN + `s SUBSET {u + x:real^N | x | x IN span {y - u | y IN {v,w}}}` + MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + REWRITE_TAC[AFFINE_HULL_INSERT_SUBSET_SPAN]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + DISCH_THEN(MP_TAC o ISPEC `\x:real^N. x - u` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID; SIMPLE_IMAGE] THEN + REWRITE_TAC[IMAGE_CLAUSES] THEN + MP_TAC(ISPECL [`{v - u:real^N,w - u}`; `2`] LOWDIM_EXPAND_BASIS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD{v - u:real^N,w - u}` THEN + SIMP_TAC[DIM_LE_CARD; FINITE_INSERT; FINITE_RULES] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` + (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + UNDISCH_TAC `span {v - u, w - u} SUBSET span {a:real^N, b}` THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP SUBSET_TRANS) THEN + MAP_EVERY EXISTS_TAC [`u:real^N`; `u + a:real^N`; `u + b:real^N`] THEN + CONJ_TAC THENL + [REWRITE_TAC[COLLINEAR_3; COLLINEAR_LEMMA; + VECTOR_ARITH `--x = vec 0 <=> x = vec 0`; + VECTOR_ARITH `u - (u + a):real^N = --a`; + VECTOR_ARITH `(u + b) - (u + a):real^N = b - a`] THEN + REWRITE_TAC[DE_MORGAN_THM; VECTOR_SUB_EQ; + VECTOR_ARITH `b - a = c % -- a <=> (c - &1) % a + &1 % b = vec 0`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_INSERT; INDEPENDENT_NONZERO]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN + REWRITE_TAC[DEPENDENT_EXPLICIT] THEN + MAP_EVERY EXISTS_TAC [`{a:real^N,b}`; + `\x:real^N. if x = a then u - &1 else &1`] THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES; SUBSET_REFL] THEN + CONJ_TAC THENL + [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[IN_INSERT] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_RULES] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; VECTOR_ADD_RID]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN + ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. u + x` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + ONCE_REWRITE_RULE[VECTOR_ADD_SYM] VECTOR_SUB_ADD] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; VECTOR_ADD_SUB] THEN + SET_TAC[]);; + +let COPLANAR_DET_EQ_0 = prove + (`!v0 v1 (v2: real^3) v3. + coplanar {v0,v1,v2,v3} <=> + det(vector[v1 - v0; v2 - v0; v3 - v0]) = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[DET_EQ_0_RANK; RANK_ROW] THEN + REWRITE_TAC[rows; row; LAMBDA_ETA] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[GSYM numseg; DIMINDEX_3] THEN + CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + SIMP_TAC[IMAGE_CLAUSES; coplanar; VECTOR_3] THEN EQ_TAC THENL + [REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN + W(MP_TAC o PART_MATCH lhand AFFINE_HULL_INSERT_SUBSET_SPAN o + rand o lhand o snd) THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUBSET_TRANS) THEN + DISCH_THEN(MP_TAC o ISPEC `\x:real^3. x - a` o MATCH_MP IMAGE_SUBSET) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID; + SIMPLE_IMAGE] THEN + REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM DIM_SPAN] THEN MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD {b - a:real^3,c - a}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SPAN_CARD_GE_DIM; + SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC] THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN + MATCH_MP_TAC SPAN_MONO THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + MP_TAC(VECTOR_ARITH `!x y:real^3. x - y = (x - a) - (y - a)`) THEN + DISCH_THEN(fun th -> REPEAT CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [th]) THEN + MATCH_MP_TAC SPAN_SUB THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN + MP_TAC(ISPECL [`{v1 - v0,v2 - v0,v3 - v0}:real^3->bool`; `2`] + LOWDIM_EXPAND_BASIS) THEN + ASM_REWRITE_TAC[ARITH_RULE `n <= 2 <=> n < 3`; DIMINDEX_3; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^3->bool` + (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + SIMP_TAC[COPLANAR; DIMINDEX_3; ARITH; plane] THEN + MAP_EVERY EXISTS_TAC [`v0:real^3`; `v0 + a:real^3`; `v0 + b:real^3`] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFFINE_HULL_INSERT_SPAN o + rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[VECTOR_ARITH `u = u + a <=> a = vec 0`] THEN + ASM_MESON_TAC[INDEPENDENT_NONZERO; IN_INSERT]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; IMAGE_ID; VECTOR_ADD_SUB] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `IMAGE (\v:real^3. v0 + v) (span{v1 - v0, v2 - v0, v3 - v0})` THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_IMAGE] THEN CONJ_TAC THENL + [EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[SPAN_0] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[VECTOR_ARITH `v1:real^N = v0 + x <=> x = v1 - v0`] THEN + REWRITE_TAC[UNWIND_THM2] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_INSERT]]]);; + +let COPLANAR_CROSS_DOT = prove + (`!v w x y. coplanar {v,w,x,y} <=> ((w - v) cross (x - v)) dot (y - v) = &0`, + REWRITE_TAC[COPLANAR_DET_EQ_0; GSYM DOT_CROSS_DET] THEN + MESON_TAC[CROSS_TRIPLE; DOT_SYM]);; + +let PLANE_AFFINE_HULL_3 = prove + (`!a b c:real^N. plane(affine hull {a,b,c}) <=> ~collinear{a,b,c}`, + REWRITE_TAC[plane] THEN MESON_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR]);; + +let AFFINE_HULL_3_GENERATED = prove + (`!s u v w:real^N. + s SUBSET affine hull {u,v,w} /\ ~collinear s + ==> affine hull {u,v,w} = affine hull s`, + REWRITE_TAC[COLLINEAR_AFF_DIM; INT_NOT_LE] THEN REPEAT STRIP_TAC THEN + CONV_TAC SYM_CONV THEN + GEN_REWRITE_TAC RAND_CONV [GSYM HULL_HULL] THEN + MATCH_MP_TAC AFF_DIM_EQ_AFFINE_HULL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&2:int` THEN + CONJ_TAC THENL [ALL_TAC; ASM_INT_ARITH_TAC] THEN + REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) AFF_DIM_LE_CARD o lhand o snd) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INT_LE_TRANS) THEN + REWRITE_TAC[INT_LE_SUB_RADD; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Additional WLOG tactic to rotate any plane p to {z | z$3 = &0}. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_HORIZONTAL_PLANE_RULE = + let ifn = MATCH_MP + (TAUT `(p ==> (x <=> x')) /\ (~p ==> (x <=> T)) ==> (x' ==> x)`) + and pth = prove + (`!a f. orthogonal_transformation (f:real^N->real^N) + ==> ((!P. (!x. P x) <=> (!x. P (a + f x))) /\ + (!P. (?x. P x) <=> (?x. P (a + f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE (\x. a + x) (IMAGE f s)))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE (\x. a + x) (IMAGE f s))))) /\ + (!P. {x | P x} = + IMAGE (\x. a + x) (IMAGE f {x | P(a + f x)}))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `(\x. a + x) o (f:real^N->real^N)` + QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[o_THM; IMAGE_o] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; + VECTOR_ARITH `a + (x - a:real^N) = x`]) + and cth = prove + (`!a f. {} = IMAGE (\x:real^3. a + x) (IMAGE f {})`, + REWRITE_TAC[IMAGE_CLAUSES]) + and oth = prove + (`!f:real^3->real^3. + orthogonal_transformation f /\ det(matrix f) = &1 + ==> linear f /\ + (!x y. f x = f y ==> x = y) /\ + (!y. ?x. f x = y) /\ + (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:3) ==> det(matrix f) = &1)`, + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) + and fth = MESON[] + `(!a f. q a f ==> (p <=> p' a f)) + ==> ((?a f. q a f) ==> (p <=> !a f. q a f ==> p' a f))` in + fun tm -> + let x,bod = dest_forall tm in + let th1 = EXISTS_GENVAR_RULE + (UNDISCH(ISPEC x ROTATION_HORIZONTAL_PLANE)) in + let [a;f],tm1 = strip_exists(concl th1) in + let [th_orth;th_det;th_im] = CONJUNCTS(ASSUME tm1) in + let th2 = PROVE_HYP th_orth (UNDISCH(ISPECL [a;f] pth)) in + let th3 = (EXPAND_QUANTS_CONV(ASSUME(concl th2)) THENC + SUBS_CONV[GSYM th_im; ISPECL [a;f] cth]) bod in + let th4 = PROVE_HYP th2 th3 in + let th5 = TRANSLATION_INVARIANTS a in + let th6 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) + [ASSUME(concl th5)] th4 in + let th7 = PROVE_HYP th5 th6 in + let th8s = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in + let th9 = LINEAR_INVARIANTS f th8s in + let th10 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th9] th7 in + let th11 = if intersect (frees(concl th10)) [a;f] = [] + then PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th10) + else MP (MATCH_MP fth (GENL [a;f] (DISCH_ALL th10))) th1 in + let th12 = REWRITE_CONV[ASSUME(mk_neg(hd(hyp th11)))] bod in + let th13 = ifn(CONJ (DISCH_ALL th11) (DISCH_ALL th12)) in + let th14 = MATCH_MP MONO_FORALL (GEN x th13) in + GEN_REWRITE_RULE (TRY_CONV o LAND_CONV) [FORALL_SIMP] th14;; + +let GEOM_HORIZONTAL_PLANE_TAC p = + W(fun (asl,w) -> + let avs,bod = strip_forall w + and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in + let avs,bod = strip_forall w in + MAP_EVERY X_GEN_TAC avs THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [p])) THEN + SPEC_TAC(p,p) THEN + W(MATCH_MP_TAC o GEOM_HORIZONTAL_PLANE_RULE o snd));; + +(* ------------------------------------------------------------------------- *) +(* Affsign and its special cases, with invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let lin_combo = new_definition + `lin_combo V f = vsum V (\v. f v % (v:real^N))`;; + +let affsign = new_definition + `affsign sgn s t (v:real^A) <=> + (?f. (v = lin_combo (s UNION t) f) /\ + (!w. t w ==> sgn (f w)) /\ + (sum (s UNION t) f = &1))`;; + +let sgn_gt = new_definition `sgn_gt = (\t. (&0 < t))`;; +let sgn_ge = new_definition `sgn_ge = (\t. (&0 <= t))`;; +let sgn_lt = new_definition `sgn_lt = (\t. (t < &0))`;; +let sgn_le = new_definition `sgn_le = (\t. (t <= &0))`;; + +let aff_gt_def = new_definition `aff_gt = affsign sgn_gt`;; +let aff_ge_def = new_definition `aff_ge = affsign sgn_ge`;; +let aff_lt_def = new_definition `aff_lt = affsign sgn_lt`;; +let aff_le_def = new_definition `aff_le = affsign sgn_le`;; + +let AFFSIGN = prove + (`affsign sgn s t = + {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\ + (!w. w IN t ==> sgn(f w)) /\ + sum (s UNION t) f = &1}`, + REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN + REWRITE_TAC[IN]);; + +let AFFSIGN_ALT = prove + (`affsign sgn s t = + {y | ?f. (!w. w IN (s UNION t) ==> w IN t ==> sgn(f w)) /\ + sum (s UNION t) f = &1 /\ + vsum (s UNION t) (\v. f v % v) = y}`, + REWRITE_TAC[SET_RULE `(w IN (s UNION t) ==> w IN t ==> P w) <=> + (w IN t ==> P w)`] THEN + REWRITE_TAC[AFFSIGN; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; + +let IN_AFFSIGN = prove + (`y IN affsign sgn s t <=> + ?u. (!x. x IN t ==> sgn(u x)) /\ + sum (s UNION t) u = &1 /\ + vsum (s UNION t) (\x. u(x) % x) = y`, + REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);; + +let AFFSIGN_DISJOINT_DIFF = prove + (`!s t. affsign sgn s t = affsign sgn (s DIFF t) t`, + REWRITE_TAC[AFFSIGN; SET_RULE `(s DIFF t) UNION t = s UNION t`]);; + +let AFF_GE_DISJOINT_DIFF = prove + (`!s t. aff_ge s t = aff_ge (s DIFF t) t`, + REWRITE_TAC[aff_ge_def] THEN MATCH_ACCEPT_TAC AFFSIGN_DISJOINT_DIFF);; + +let AFFSIGN_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N sgn s t v. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (affsign sgn (IMAGE f s) (IMAGE f t) = + IMAGE f (affsign sgn s t))`, + let lemma0 = prove + (`vsum s (\x. u x % x) = vsum {x | x IN s /\ ~(u x = &0)} (\x. u x % x)`, + MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN + SIMP_TAC[o_THM; VECTOR_MUL_LZERO]) in + let lemma1 = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (sum(IMAGE f s) u = &1 /\ vsum(IMAGE f s) (\x. u x % x) = y <=> + sum s (u o f) = &1 /\ f(vsum s (\x. (u o f) x % x)) = y)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o funpow 3 lhand o snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC(MESON[] `(p ==> z = x) ==> (p /\ x = y <=> p /\ z = y)`) THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[lemma0] THEN + SUBGOAL_THEN + `{y | y IN IMAGE (f:real^M->real^N) s /\ ~(u y = &0)} = + IMAGE f {x | x IN s /\ ~(u(f x) = &0)}` + SUBST1_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN + SUBGOAL_THEN `FINITE {x | x IN s /\ ~(u((f:real^M->real^N) x) = &0)}` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE + (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD; o_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; GSYM LINEAR_CMUL]]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_AFFSIGN] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_AFFSIGN] THEN + REWRITE_TAC[GSYM IMAGE_UNION] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma1 th]) THEN + X_GEN_TAC `y:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `vsum (s UNION t) (\x. (u o (f:real^M->real^N)) x % x)` THEN + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(u:real^N->real) o (f:real^M->real^N)` THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_THM]; + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^M` + (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN + ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; + +let AFF_GE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_ge (IMAGE f s) (IMAGE f t) = IMAGE f (aff_ge s t)`, + REWRITE_TAC[aff_ge_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +let AFF_GT_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_gt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_gt s t)`, + REWRITE_TAC[aff_gt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +let AFF_LE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_le (IMAGE f s) (IMAGE f t) = IMAGE f (aff_le s t)`, + REWRITE_TAC[aff_le_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +let AFF_LT_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_lt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_lt s t)`, + REWRITE_TAC[aff_lt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +add_linear_invariants + [AFFSIGN_INJECTIVE_LINEAR_IMAGE; + AFF_GE_INJECTIVE_LINEAR_IMAGE; + AFF_GT_INJECTIVE_LINEAR_IMAGE; + AFF_LE_INJECTIVE_LINEAR_IMAGE; + AFF_LT_INJECTIVE_LINEAR_IMAGE];; + +let IN_AFFSIGN_TRANSLATION = prove + (`!sgn s t a v:real^N. + affsign sgn s t v + ==> affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) (a + v)`, + REPEAT GEN_TAC THEN REWRITE_TAC[affsign; lin_combo] THEN + ONCE_REWRITE_TAC[SET_RULE `(!x. s x ==> p x) <=> (!x. x IN s ==> p x)`] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` + (CONJUNCTS_THEN2 SUBST_ALL_TAC STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\x. (f:real^N->real)(x - a)` THEN + ASM_REWRITE_TAC[GSYM IMAGE_UNION] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[FORALL_IN_IMAGE; ETA_AX; + VECTOR_ARITH `(a + x) - a:real^N = x`]; + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN + SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + ASM_REWRITE_TAC[o_DEF; VECTOR_ADD_SUB; ETA_AX]] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `a + vsum {x | x IN s UNION t /\ ~(f x = &0)} (\v:real^N. f v % v)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum (IMAGE (\x:real^N. a + x) + {x | x IN s UNION t /\ ~(f x = &0)}) + (\v. f(v - a) % v)` THEN + CONJ_TAC THENL + [ALL_TAC; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; VECTOR_MUL_EQ_0] THEN + REWRITE_TAC[VECTOR_ADD_SUB] THEN SET_TAC[]] THEN + SUBGOAL_THEN `FINITE {x:real^N | x IN s UNION t /\ ~(f x = &0)}` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE + (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rhs o snd) THEN + ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[o_DEF; VECTOR_ADD_SUB] THEN + ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_RMUL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]);; + +let AFFSIGN_TRANSLATION = prove + (`!a:real^N sgn s t. + affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (affsign sgn s t)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN] THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `--a:real^N` o + MATCH_MP IN_AFFSIGN_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; + IMAGE_ID] THEN + DISCH_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `--a + x:real^N` THEN ASM_REWRITE_TAC[IN] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN REWRITE_TAC[IN] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN + REWRITE_TAC[]]);; + +let AFF_GE_TRANSLATION = prove + (`!a:real^N s t. + aff_ge (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_ge s t)`, + REWRITE_TAC[aff_ge_def; AFFSIGN_TRANSLATION]);; + +let AFF_GT_TRANSLATION = prove + (`!a:real^N s t. + aff_gt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_gt s t)`, + REWRITE_TAC[aff_gt_def; AFFSIGN_TRANSLATION]);; + +let AFF_LE_TRANSLATION = prove + (`!a:real^N s t. + aff_le (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_le s t)`, + REWRITE_TAC[aff_le_def; AFFSIGN_TRANSLATION]);; + +let AFF_LT_TRANSLATION = prove + (`!a:real^N s t. + aff_lt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_lt s t)`, + REWRITE_TAC[aff_lt_def; AFFSIGN_TRANSLATION]);; + +add_translation_invariants + [AFFSIGN_TRANSLATION; + AFF_GE_TRANSLATION; + AFF_GT_TRANSLATION; + AFF_LE_TRANSLATION; + AFF_LT_TRANSLATION];; + +(* ------------------------------------------------------------------------- *) +(* Automate special cases of affsign. *) +(* ------------------------------------------------------------------------- *) + +let AFF_TAC = + REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[aff_ge_def; aff_gt_def; aff_le_def; aff_lt_def; + sgn_ge; sgn_gt; sgn_le; sgn_lt; AFFSIGN_ALT] THEN + REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN + REWRITE_TAC[UNION_EMPTY] THEN + SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + FINITE_EMPTY; RIGHT_EXISTS_AND_THM; REAL_LT_ADD; + REAL_LE_ADD; REAL_ARITH `&0 <= a / &2 <=> &0 <= a`; + REAL_ARITH `&0 < a / &2 <=> &0 < a`; + REAL_ARITH `a / &2 <= &0 <=> a <= &0`; + REAL_ARITH `a / &2 < &0 <=> a < &0`; + REAL_ARITH `a < &0 /\ b < &0 ==> a + b < &0`; + REAL_ARITH `a < &0 /\ b <= &0 ==> a + b <= &0`] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; real_ge] THEN + REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`; + VECTOR_ARITH `x - y:real^N = z <=> x = y + z`] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; REAL_ADD_RID; VECTOR_ADD_RID] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&1 = x <=> x = &1`] THEN + REWRITE_TAC[] THEN SET_TAC[];; + +let AFF_GE_1_1 = prove + (`!x v w. + DISJOINT {x} {v} + ==> aff_ge {x} {v} = + {y | ?t1 t2. + &0 <= t2 /\ + t1 + t2 = &1 /\ + y = t1 % x + t2 % v }`, + AFF_TAC);; + +let AFF_GE_1_2 = prove + (`!x v w. + DISJOINT {x} {v,w} + ==> aff_ge {x} {v,w} = + {y | ?t1 t2 t3. + + &0 <= t2 /\ &0 <= t3 /\ + + t1 + t2 + t3 = &1 /\ + y = t1 % x + t2 % v + t3 % w}`, + AFF_TAC);; + +let AFF_GE_2_1 = prove + (`!x v w. + DISJOINT {x,v} {w} + ==> aff_ge {x,v} {w} = + {y | ?t1 t2 t3. + &0 <= t3 /\ + t1 + t2 + t3 = &1 /\ + y = t1 % x + t2 % v + t3 % w}`, + AFF_TAC);; + +let AFF_GT_1_1 = prove + (`!x v w. + DISJOINT {x} {v} + ==> aff_gt {x} {v} = + {y | ?t1 t2. + &0 < t2 /\ + t1 + t2 = &1 /\ + y = t1 % x + t2 % v}`, + AFF_TAC);; + +let AFF_GT_1_2 = prove + (`!x v w. + DISJOINT {x} {v,w} + ==> aff_gt {x} {v,w} = + {y | ?t1 t2 t3. + &0 < t2 /\ &0 < t3 /\ + t1 + t2 + t3 = &1 /\ + y = t1 % x + t2 % v + t3 % w}`, + AFF_TAC);; + +let AFF_GT_2_1 = prove + (`!x v w. + DISJOINT {x,v} {w} + ==> aff_gt {x,v} {w} = + {y | ?t1 t2 t3. + &0 < t3 /\ + t1 + t2 + t3 = &1 /\ + y = t1 % x + t2 % v + t3 % w}`, + AFF_TAC);; + +let AFF_GT_3_1 = prove + (`!v w x y. + DISJOINT {v,w,x} {y} + ==> aff_gt {v,w,x} {y} = + {z | ?t1 t2 t3 t4. + &0 < t4 /\ + t1 + t2 + t3 + t4 = &1 /\ + z = t1 % v + t2 % w + t3 % x + t4 % y}`, + AFF_TAC);; + +let AFF_LT_1_1 = prove + (`!x v. + DISJOINT {x} {v} + ==> aff_lt {x} {v} = + {y | ?t1 t2. + t2 < &0 /\ + t1 + t2 = &1 /\ + y = t1 % x + t2 % v}`, + AFF_TAC);; + +let AFF_LT_2_1 = prove + (`!x v w. + DISJOINT {x,v} {w} + ==> aff_lt {x,v} {w} = + {y | ?t1 t2 t3. + t3 < &0 /\ + t1 + t2 + t3 = &1 /\ + y = t1 % x + t2 % v + t3 % w}`, + AFF_TAC);; + +let AFF_GE_1_2_0 = prove + (`!v w. + ~(v = vec 0) /\ ~(w = vec 0) + ==> aff_ge {vec 0} {v,w} = {a % v + b % w | &0 <= a /\ &0 <= b}`, + SIMP_TAC[AFF_GE_1_2; + SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c. P b c /\ Q b c /\ R a b c /\ S b c) <=> + (?b c. P b c /\ Q b c /\ S b c /\ ?a. R a b c)`] THEN + REWRITE_TAC[REAL_ARITH `t + s:real = &1 <=> t = &1 - s`; EXISTS_REFL] THEN + SET_TAC[]);; + +let AFF_GE_1_1_0 = prove + (`!v. ~(v = vec 0) ==> aff_ge {vec 0} {v} = {a % v | &0 <= a}`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SET_RULE `{a} = {a,a}`] THEN + ASM_SIMP_TAC[AFF_GE_1_2_0; GSYM VECTOR_ADD_RDISTRIB] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[REAL_LE_ADD; REAL_ARITH + `&0 <= a ==> &0 <= a / &2 /\ a / &2 + a / &2 = a`]);; + +let AFF_GE_2_1_0 = prove + (`!v w. DISJOINT {vec 0, v} {w} + ==> aff_ge {vec 0, v} {w} = {s % v + t % w |s,t| &0 <= t}`, + SIMP_TAC[AFF_GE_2_1; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN + REWRITE_TAC[REAL_ARITH `t + u = &1 <=> t = &1 - u`; UNWIND_THM2] THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of affsign variants. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_AFFSIGN = prove + (`!sgn. (!x y u. sgn(x) /\ sgn(y) /\ &0 <= u /\ u <= &1 + ==> sgn((&1 - u) * x + u * y)) + ==> !s t:real^N->bool. convex(affsign sgn s t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; CONVEX_ALT] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + X_GEN_TAC `f:real^N->real` THEN STRIP_TAC THEN + X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^N. (&1 - u) * f x + u * g x` THEN + ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN REPEAT CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_ADD_GEN o lhand o snd) THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN + DISCH_THEN MATCH_MP_TAC; + ASM_MESON_TAC[]; + W(MP_TAC o PART_MATCH (lhs o rand) SUM_ADD_GEN o lhand o snd) THEN + ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC] THEN + (CONJ_TAC THENL + [MP_TAC(ASSUME `sum (s UNION t:real^N->bool) f = &1`); + MP_TAC(ASSUME `sum (s UNION t:real^N->bool) g = &1`)]) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sum] THEN + ONCE_REWRITE_TAC[iterate] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN + DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[CONTRAPOS_THM] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; REAL_MUL_RZERO]);; + +let CONVEX_AFF_GE = prove + (`!s t. convex(aff_ge s t)`, + REWRITE_TAC[aff_ge_def; sgn_ge] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_SUB_LE]);; + +let CONVEX_AFF_LE = prove + (`!s t. convex(aff_le s t)`, + REWRITE_TAC[aff_le_def; sgn_le] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN + REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; REAL_NEG_ADD; GSYM + REAL_MUL_RNEG] THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_SUB_LE]);; + +let CONVEX_AFF_GT = prove + (`!s t. convex(aff_gt s t)`, + REWRITE_TAC[aff_gt_def; sgn_gt] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`; + REAL_ARITH `x <= &1 <=> x = &1 \/ x < &1`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL; REAL_SUB_LT]);; + +let CONVEX_AFF_LT = prove + (`!s t. convex(aff_lt s t)`, + REWRITE_TAC[aff_lt_def; sgn_lt] THEN MATCH_MP_TAC CONVEX_AFFSIGN THEN + REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; REAL_NEG_ADD; GSYM + REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`; + REAL_ARITH `x <= &1 <=> x = &1 \/ x < &1`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_MUL; REAL_SUB_LT]);; + +let AFFSIGN_SUBSET_AFFINE_HULL = prove + (`!sgn s t. (affsign sgn s t) SUBSET (affine hull (s UNION t))`, + REWRITE_TAC[AFFINE_HULL_FINITE; AFFSIGN] THEN SET_TAC[]);; + +let AFF_GE_SUBSET_AFFINE_HULL = prove + (`!s t. (aff_ge s t) SUBSET (affine hull (s UNION t))`, + REWRITE_TAC[aff_ge_def; AFFSIGN_SUBSET_AFFINE_HULL]);; + +let AFF_LE_SUBSET_AFFINE_HULL = prove + (`!s t. (aff_le s t) SUBSET (affine hull (s UNION t))`, + REWRITE_TAC[aff_le_def; AFFSIGN_SUBSET_AFFINE_HULL]);; + +let AFF_GT_SUBSET_AFFINE_HULL = prove + (`!s t. (aff_gt s t) SUBSET (affine hull (s UNION t))`, + REWRITE_TAC[aff_gt_def; AFFSIGN_SUBSET_AFFINE_HULL]);; + +let AFF_LT_SUBSET_AFFINE_HULL = prove + (`!s t. (aff_lt s t) SUBSET (affine hull (s UNION t))`, + REWRITE_TAC[aff_lt_def; AFFSIGN_SUBSET_AFFINE_HULL]);; + +let AFFSIGN_EQ_AFFINE_HULL = prove + (`!sgn s t. affsign sgn s {} = affine hull s`, + REWRITE_TAC[AFFSIGN; AFFINE_HULL_FINITE] THEN + REWRITE_TAC[UNION_EMPTY; NOT_IN_EMPTY] THEN SET_TAC[]);; + +let AFF_GE_EQ_AFFINE_HULL = prove + (`!s t. aff_ge s {} = affine hull s`, + REWRITE_TAC[aff_ge_def; AFFSIGN_EQ_AFFINE_HULL]);; + +let AFF_LE_EQ_AFFINE_HULL = prove + (`!s t. aff_le s {} = affine hull s`, + REWRITE_TAC[aff_le_def; AFFSIGN_EQ_AFFINE_HULL]);; + +let AFF_GT_EQ_AFFINE_HULL = prove + (`!s t. aff_gt s {} = affine hull s`, + REWRITE_TAC[aff_gt_def; AFFSIGN_EQ_AFFINE_HULL]);; + +let AFF_LT_EQ_AFFINE_HULL = prove + (`!s t. aff_lt s {} = affine hull s`, + REWRITE_TAC[aff_lt_def; AFFSIGN_EQ_AFFINE_HULL]);; + +let AFFSIGN_SUBSET_AFFSIGN = prove + (`!sgn1 sgn2 s t. + (!x. sgn1 x ==> sgn2 x) ==> affsign sgn1 s t SUBSET affsign sgn2 s t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; + +let AFF_GT_SUBSET_AFF_GE = prove + (`!s t. aff_gt s t SUBSET aff_ge s t`, + REPEAT GEN_TAC THEN REWRITE_TAC[aff_gt_def; aff_ge_def] THEN + MATCH_MP_TAC AFFSIGN_SUBSET_AFFSIGN THEN + SIMP_TAC[sgn_gt; sgn_ge; REAL_LT_IMP_LE]);; + +let AFFSIGN_MONO_LEFT = prove + (`!sgn s s' t:real^N->bool. + s SUBSET s' ==> affsign sgn s t SUBSET affsign sgn s' t`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^N. if x IN s UNION t then u x else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE + `s SUBSET s' ==> {x | x IN s' UNION t /\ x IN s UNION t} = s UNION t`] THEN + ASM SET_TAC[]);; + +let AFFSIGN_MONO_SHUFFLE = prove + (`!sgn s t s' t'. + s' UNION t' = s UNION t /\ t' SUBSET t + ==> affsign sgn s t SUBSET affsign sgn s' t'`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let AFF_GT_MONO_LEFT = prove + (`!s s' t. s SUBSET s' ==> aff_gt s t SUBSET aff_gt s' t`, + REWRITE_TAC[aff_gt_def; AFFSIGN_MONO_LEFT]);; + +let AFF_GE_MONO_LEFT = prove + (`!s s' t. s SUBSET s' ==> aff_ge s t SUBSET aff_ge s' t`, + REWRITE_TAC[aff_ge_def; AFFSIGN_MONO_LEFT]);; + +let AFF_LT_MONO_LEFT = prove + (`!s s' t. s SUBSET s' ==> aff_lt s t SUBSET aff_lt s' t`, + REWRITE_TAC[aff_lt_def; AFFSIGN_MONO_LEFT]);; + +let AFF_LE_MONO_LEFT = prove + (`!s s' t. s SUBSET s' ==> aff_le s t SUBSET aff_le s' t`, + REWRITE_TAC[aff_le_def; AFFSIGN_MONO_LEFT]);; + +let AFFSIGN_MONO_RIGHT = prove + (`!sgn s t t':real^N->bool. + sgn(&0) /\ t SUBSET t' /\ DISJOINT s t' + ==> affsign sgn s t SUBSET affsign sgn s t'`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[AFFSIGN; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^N. if x IN s UNION t then u x else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE + `t SUBSET t' ==> {x | x IN s UNION t' /\ x IN s UNION t} = s UNION t`] THEN + ASM SET_TAC[]);; + +let AFF_GE_MONO_RIGHT = prove + (`!s t t'. t SUBSET t' /\ DISJOINT s t' ==> aff_ge s t SUBSET aff_ge s t'`, + SIMP_TAC[aff_ge_def; AFFSIGN_MONO_RIGHT; sgn_ge; REAL_POS]);; + +let AFF_LE_MONO_RIGHT = prove + (`!s t t'. t SUBSET t' /\ DISJOINT s t' ==> aff_le s t SUBSET aff_le s t'`, + SIMP_TAC[aff_le_def; AFFSIGN_MONO_RIGHT; sgn_le; REAL_LE_REFL]);; + +let AFFINE_HULL_SUBSET_AFFSIGN = prove + (`!sgn s t:real^N->bool. + sgn(&0) /\ DISJOINT s t + ==> affine hull s SUBSET affsign sgn s t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `affsign sgn (s:real^N->bool) {}` THEN CONJ_TAC THENL + [REWRITE_TAC[AFFSIGN_EQ_AFFINE_HULL; SUBSET_REFL]; + MATCH_MP_TAC AFFSIGN_MONO_RIGHT THEN ASM SET_TAC[]]);; + +let AFFINE_HULL_SUBSET_AFF_GE = prove + (`!s t. DISJOINT s t ==> affine hull s SUBSET aff_ge s t`, + SIMP_TAC[aff_ge_def; sgn_ge; REAL_LE_REFL; AFFINE_HULL_SUBSET_AFFSIGN]);; + +let AFF_GE_AFF_GT_DECOMP = prove + (`!s:real^N->bool. + FINITE s /\ FINITE t /\ DISJOINT s t + ==> aff_ge s t = aff_gt s t UNION + UNIONS {aff_ge s (t DELETE a) | a | a IN t}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `t' SUBSET t /\ (!a. a IN s ==> f(a) SUBSET t) /\ + (!y. y IN t ==> y IN t' \/ ?a. a IN s /\ y IN f(a)) + ==> t = t' UNION UNIONS {f a | a IN s}`) THEN + REWRITE_TAC[AFF_GT_SUBSET_AFF_GE] THEN + ASM_SIMP_TAC[DELETE_SUBSET; AFF_GE_MONO_RIGHT] THEN + REWRITE_TAC[aff_ge_def; aff_gt_def; AFFSIGN; sgn_ge; sgn_gt] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `!x:real^N. x IN t ==> &0 < u x` THENL + [DISJ1_TAC THEN EXISTS_TAC `u:real^N->real` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&0 < x <=> ~(x = &0))`] THEN + REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `u:real^N->real` THEN + ASM_SIMP_TAC[SET_RULE + `a IN t /\ DISJOINT s t + ==> s UNION (t DELETE a) = (s UNION t) DELETE a`] THEN + ASM_SIMP_TAC[IN_DELETE; SUM_DELETE; VSUM_DELETE; REAL_SUB_RZERO; + FINITE_UNION; IN_UNION] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]);; + +let AFFSIGN_SPECIAL_SCALE = prove + (`!sgn s t a v. + FINITE s /\ FINITE t /\ + ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ + (!x. sgn x ==> sgn(x / &2)) /\ + (!x y. sgn x /\ sgn y ==> sgn(x + y)) /\ + &0 < a + ==> affsign sgn (vec 0 INSERT (a % v) INSERT s) t = + affsign sgn (vec 0 INSERT v INSERT s) t`, + REWRITE_TAC[EXTENSION] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[AFFSIGN_ALT; IN_ELIM_THM; INSERT_UNION_EQ] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + GEN_REWRITE_TAC BINOP_CONV [SWAP_EXISTS_THM] THEN + GEN_REWRITE_TAC (BINOP_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[REAL_ARITH `x = &1 - v - v' <=> v = &1 - (x + v')`] THEN + REWRITE_TAC[EXISTS_REFL] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL] + `!a. &0 < a ==> (!y. ?x. a * x = y)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN + DISCH_THEN(CONV_TAC o RAND_CONV o EXPAND_QUANTS_CONV) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM]);; + +let AFF_GE_SPECIAL_SCALE = prove + (`!s t a v. + FINITE s /\ FINITE t /\ + ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ + &0 < a + ==> aff_ge (vec 0 INSERT (a % v) INSERT s) t = + aff_ge (vec 0 INSERT v INSERT s) t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN + MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN + ASM_REWRITE_TAC[sgn_ge] THEN REAL_ARITH_TAC);; + +let AFF_LE_SPECIAL_SCALE = prove + (`!s t a v. + FINITE s /\ FINITE t /\ + ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ + &0 < a + ==> aff_le (vec 0 INSERT (a % v) INSERT s) t = + aff_le (vec 0 INSERT v INSERT s) t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aff_le_def] THEN + MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN + ASM_REWRITE_TAC[sgn_le] THEN REAL_ARITH_TAC);; + +let AFF_GT_SPECIAL_SCALE = prove + (`!s t a v. + FINITE s /\ FINITE t /\ + ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ + &0 < a + ==> aff_gt (vec 0 INSERT (a % v) INSERT s) t = + aff_gt (vec 0 INSERT v INSERT s) t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aff_gt_def] THEN + MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN + ASM_REWRITE_TAC[sgn_gt] THEN REAL_ARITH_TAC);; + +let AFF_LT_SPECIAL_SCALE = prove + (`!s t a v. + FINITE s /\ FINITE t /\ + ~(vec 0 IN t) /\ ~(v IN t) /\ ~((a % v) IN t) /\ + &0 < a + ==> aff_lt (vec 0 INSERT (a % v) INSERT s) t = + aff_lt (vec 0 INSERT v INSERT s) t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aff_lt_def] THEN + MATCH_MP_TAC AFFSIGN_SPECIAL_SCALE THEN + ASM_REWRITE_TAC[sgn_lt] THEN REAL_ARITH_TAC);; + +let AFF_GE_SCALE_LEMMA = prove + (`!a u v:real^N. + &0 < a /\ ~(v = vec 0) + ==> aff_ge {vec 0} {a % u,v} = aff_ge {vec 0} {u,v}`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `u:real^N = vec 0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + ASM_SIMP_TAC[AFF_GE_1_2_0; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; + SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_GSPEC] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL + [EXISTS_TAC `a * b:real`; EXISTS_TAC `b / a:real`] THEN + EXISTS_TAC `c:real` THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_MUL; REAL_LT_IMP_LE] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + REPLICATE_TAC 2 (AP_THM_TAC THEN AP_TERM_TAC) THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD);; + +let AFFSIGN_0 = prove + (`!sgn s t. + FINITE s /\ FINITE t /\ (vec 0) IN (s DIFF t) + ==> affsign sgn s t = + { vsum (s UNION t) (\v. f v % v) |f| + !x:real^N. x IN t ==> sgn(f x)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[AFFSIGN] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `x IN s DIFF t ==> s UNION t = x INSERT ((s UNION t) DELETE x)`)) THEN + ASM_SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; FINITE_UNION; FINITE_DELETE] THEN + REWRITE_TAC[IN_DELETE; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`y:real^N`; `f:real^N->real`] THEN + STRIP_TAC THEN EXISTS_TAC `f:real^N->real` THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN + EXISTS_TAC + `\x:real^N. if x = vec 0 + then &1 - sum ((s UNION t) DELETE vec 0) (\x. f x) + else f x` THEN + MP_TAC(SET_RULE + `!x:real^N. x IN (s UNION t) DELETE vec 0 ==> ~(x = vec 0)`) THEN + SIMP_TAC[ETA_AX; REAL_SUB_ADD] THEN DISCH_THEN(K ALL_TAC) THEN + ASM SET_TAC[]]);; + +let AFF_GE_0_AFFINE_MULTIPLE_CONVEX = prove + (`!s t:real^N->bool. + FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) /\ ~(t = {}) + ==> aff_ge s t = + {x + c % y | x IN affine hull (s DIFF t) /\ + y IN convex hull t /\ &0 <= c}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[aff_ge_def; AFFSIGN_0; sgn_ge] THEN + ONCE_REWRITE_TAC[SET_RULE `s UNION t = (s DIFF t) UNION t`] THEN + ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; + SET_RULE `DISJOINT (s DIFF t) t`] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + ASM_SIMP_TAC[SPAN_FINITE; FINITE_DIFF; CONVEX_HULL_FINITE] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN + EXISTS_TAC `vsum (s DIFF t) (\x:real^N. f x % x)` THEN + ASM_CASES_TAC `sum t (f:real^N->real) = &0` THENL + [MP_TAC(ISPECL [`f:real^N->real`; `t:real^N->bool`] SUM_POS_EQ_0) THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; REAL_MUL_LZERO; VSUM_0] THEN + DISCH_TAC THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_REFL] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [EXISTS_TAC `f:real^N->real` THEN REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM EXISTS_REFL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + EXISTS_TAC `\x:real^N. if x = a then &1 else &0` THEN + ASM_REWRITE_TAC[SUM_DELTA] THEN MESON_TAC[REAL_POS]; + EXISTS_TAC `sum t (f:real^N->real)` THEN + EXISTS_TAC `inv(sum t (f:real^N->real)) % vsum t (\v. f v % v)` THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `f:real^N->real` THEN REWRITE_TAC[]; + EXISTS_TAC `\x:real^N. f x / sum t (f:real^N->real)` THEN + ASM_SIMP_TAC[REAL_LE_DIV; SUM_POS_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`] THEN + ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; SUM_LMUL; VSUM_LMUL] THEN + ASM_SIMP_TAC[REAL_MUL_LINV]; + ASM_SIMP_TAC[SUM_POS_LE]; + AP_TERM_TAC THEN ASM_CASES_TAC `sum t (f:real^N->real) = &0` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]; + MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`; `y:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->real` (SUBST1_TAC o SYM)) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `v:real^N->real`MP_TAC) ASSUME_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + EXISTS_TAC `(\x. if x IN t then c * v x else u x):real^N->real` THEN + ASM_SIMP_TAC[REAL_LE_MUL; VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + SIMP_TAC[IN_DIFF]]);; + +let AFF_GE_0_MULTIPLE_AFFINE_CONVEX = prove + (`!s t:real^N->bool. + FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) /\ ~(t = {}) + ==> aff_ge s t = + affine hull (s DIFF t) UNION + {c % (x + y) | x IN affine hull (s DIFF t) /\ + y IN convex hull t /\ &0 <= c}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; + AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN ASM_CASES_TAC `c = &0` THENL + [DISJ1_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID]; + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC + [`c:real`; `inv(c) % x:real^N`; `y:real^N`] THEN + ASM_SIMP_TAC[SPAN_MUL; VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; + REAL_MUL_RINV; VECTOR_MUL_LID]]; + REWRITE_TAC[aff_ge_def] THEN ONCE_REWRITE_TAC[AFFSIGN_DISJOINT_DIFF] THEN + REWRITE_TAC[GSYM aff_ge_def] THEN + MATCH_MP_TAC AFFINE_HULL_SUBSET_AFF_GE THEN SET_TAC[]; + ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; + AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC + [`c % x:real^N`; `c:real`; `y:real^N`] THEN + ASM_SIMP_TAC[SPAN_MUL; VECTOR_ADD_LDISTRIB]]);; + +let AFF_GE_0_AFFINE_CONVEX_CONE = prove + (`!s t:real^N->bool. + FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) + ==> aff_ge s t = + {x + y | x IN affine hull (s DIFF t) /\ + y IN convex_cone hull t}`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; CONVEX_CONE_HULL_EMPTY] THEN + REWRITE_TAC[IN_SING; DIFF_EMPTY] THEN + REWRITE_TAC[SET_RULE `{x + y:real^N | P x /\ y = a} = {x + a | P x}`] THEN + REWRITE_TAC[VECTOR_ADD_RID] THEN SET_TAC[]; + ASM_SIMP_TAC[CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; + AFF_GE_0_AFFINE_MULTIPLE_CONVEX] THEN + SET_TAC[]]);; + +let AFF_GE_0_N = prove + (`!s:real^N->bool. + FINITE s /\ ~(vec 0 IN s) + ==> aff_ge {vec 0} s = + {y | ?u. (!x. x IN s ==> &0 <= u x) /\ + y = vsum s (\x. u x % x)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN + ASM_SIMP_TAC[AFFSIGN_0; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; + FINITE_INSERT; FINITE_EMPTY] THEN + ASM_SIMP_TAC[EXTENSION; sgn_ge; IN_ELIM_THM; INSERT_UNION; UNION_EMPTY] THEN + ASM_SIMP_TAC[VSUM_CLAUSES; VECTOR_MUL_RZERO; VECTOR_ADD_LID]);; + +let AFF_GE_0_CONVEX_HULL = prove + (`!s:real^N->bool. + FINITE s /\ ~(s = {}) /\ ~(vec 0 IN s) + ==> aff_ge {vec 0} s = {t % y | &0 <= t /\ y IN convex hull s}`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[AFF_GE_0_AFFINE_MULTIPLE_CONVEX; IN_DIFF; + FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> {a} DIFF s = {a}`] THEN + REWRITE_TAC[AFFINE_HULL_SING; IN_SING] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_LID]);; + +let AFF_GE_0_CONVEX_HULL_ALT = prove + (`!s:real^N->bool. + FINITE s /\ ~(vec 0 IN s) + ==> aff_ge {vec 0} s = + vec 0 INSERT {t % y | &0 < t /\ y IN convex hull s}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; CONVEX_HULL_EMPTY] THEN + REWRITE_TAC[AFFINE_HULL_SING; NOT_IN_EMPTY] THEN SET_TAC[]; + ASM_SIMP_TAC[AFF_GE_0_CONVEX_HULL; EXTENSION; IN_ELIM_THM; IN_INSERT] THEN + X_GEN_TAC `y:real^N` THEN ASM_CASES_TAC `y:real^N = vec 0` THEN + ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LZERO] THEN + ASM_REWRITE_TAC[MEMBER_NOT_EMPTY; CONVEX_HULL_EQ_EMPTY]; + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `t = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LT_REFL] THEN + ASM_REWRITE_TAC[REAL_LT_LE]]]);; + +let AFF_GE_0_CONVEX_CONE_NEGATIONS = prove + (`!s t:real^N->bool. + FINITE s /\ FINITE t /\ vec 0 IN (s DIFF t) + ==> aff_ge s t = + convex_cone hull (s UNION t UNION IMAGE (--) (s DIFF t))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_AFFINE_CONVEX_CONE] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + REWRITE_TAC[SPAN_CONVEX_CONE_ALLSIGNS; GSYM CONVEX_CONE_HULL_UNION] THEN + AP_TERM_TAC THEN SET_TAC[]);; + +let CONVEX_HULL_AFF_GE = prove + (`!s. convex hull s = aff_ge {} s`, + SIMP_TAC[aff_ge_def; AFFSIGN; CONVEX_HULL_FINITE; sgn_ge; UNION_EMPTY] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; + +let POLYHEDRON_AFF_GE = prove + (`!s t:real^N->bool. FINITE s /\ FINITE t ==> polyhedron(aff_ge s t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aff_ge_def] THEN + ONCE_REWRITE_TAC[AFFSIGN_DISJOINT_DIFF] THEN + REWRITE_TAC[GSYM aff_ge_def] THEN + SUBGOAL_THEN `FINITE(s DIFF t) /\ FINITE(t:real^N->bool) /\ + DISJOINT (s DIFF t) t` + MP_TAC THENL [ASM_SIMP_TAC[FINITE_DIFF] THEN ASM SET_TAC[]; ALL_TAC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + SPEC_TAC(`s DIFF t:real^N->bool`,`s:real^N->bool`) THEN + MATCH_MP_TAC SET_PROVE_CASES THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CONVEX_HULL_AFF_GE] THEN + MATCH_MP_TAC POLYTOPE_IMP_POLYHEDRON THEN REWRITE_TAC[polytope] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`] THEN + GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(vec 0:real^N) IN ((vec 0 INSERT s) DIFF t)` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[AFF_GE_0_CONVEX_CONE_NEGATIONS; FINITE_INSERT] THEN + MATCH_MP_TAC POLYHEDRON_CONVEX_CONE_HULL THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; FINITE_DIFF; FINITE_IMAGE]);; + +let CLOSED_AFF_GE = prove + (`!s t:real^N->bool. FINITE s /\ FINITE t ==> closed(aff_ge s t)`, + SIMP_TAC[POLYHEDRON_AFF_GE; POLYHEDRON_IMP_CLOSED]);; + +let CONIC_AFF_GE_0 = prove + (`!s:real^N->bool. FINITE s /\ ~(vec 0 IN s) ==> conic(aff_ge {vec 0} s)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AFF_GE_0_N; conic] THEN + REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN X_GEN_TAC `c:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\v. c * (u:real^N->real) v` THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN + ASM_MESON_TAC[REAL_LE_MUL]);; + +let ANGLES_ADD_AFF_GE = prove + (`!u v w x:real^N. + ~(v = u) /\ ~(w = u) /\ ~(x = u) /\ x IN aff_ge {u} {v,w} + ==> angle(v,u,x) + angle(x,u,w) = angle(v,u,w)`, + GEOM_ORIGIN_TAC `u:real^N` THEN REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[AFF_GE_1_2_0] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `a = &0 /\ b = &0 \/ &0 < a + b` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]; + ALL_TAC] THEN + DISCH_TAC THEN MP_TAC(ISPECL + [`v:real^N`; `w:real^N`; `inv(a + b) % x:real^N`; `vec 0:real^N`] + ANGLES_ADD_BETWEEN) THEN + ASM_REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN + ASM_SIMP_TAC[VECTOR_ANGLE_RMUL; VECTOR_ANGLE_LMUL; + REAL_INV_EQ_0; REAL_LE_INV_EQ; REAL_LT_IMP_NZ; REAL_LT_IMP_LE] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[BETWEEN_IN_SEGMENT; CONVEX_HULL_2; SEGMENT_CONVEX_HULL] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`a / (a + b):real`; `b / (a + b):real`] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; VECTOR_ADD_LDISTRIB] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; real_div; REAL_MUL_AC] THEN + UNDISCH_TAC `&0 < a + b` THEN CONV_TAC REAL_FIELD);; + +let AFF_GE_2_1_0_DROPOUT_3 = prove + (`!w z:real^3. + ~collinear{vec 0,basis 3,z} + ==> (w IN aff_ge {vec 0,basis 3} {z} <=> + (dropout 3 w) IN aff_ge {vec 0:real^2} {dropout 3 z})`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `z:real^3 = vec 0` THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN + ASM_CASES_TAC `z:real^3 = basis 3` THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN + REWRITE_TAC[COLLINEAR_BASIS_3] THEN DISCH_TAC THEN + ASM_SIMP_TAC[AFF_GE_2_1_0; SET_RULE `DISJOINT s {a} <=> ~(a IN s)`; + IN_INSERT; NOT_IN_EMPTY; AFF_GE_1_1_0] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC(MESON[] + `(!t. ((?s. P s t) <=> Q t)) ==> ((?s t. P s t) <=> (?t. Q t))`) THEN + X_GEN_TAC `t:real` THEN EQ_TAC THENL + [STRIP_TAC THEN + ASM_REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN + VECTOR_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `(w:real^3)$3 - t * (z:real^3)$3` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + ASM_REWRITE_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH; BASIS_COMPONENT; + DIMINDEX_3] THEN + CONV_TAC REAL_RING]);; + +let AFF_GE_2_1_0_SEMIALGEBRAIC = prove + (`!x y z:real^3. + ~collinear {vec 0,x,y} /\ ~collinear {vec 0,x,z} + ==> (z IN aff_ge {vec 0,x} {y} <=> + (x cross y) cross x cross z = vec 0 /\ + &0 <= (x cross z) dot (x cross y))`, + let lemma0 = prove + (`~(y = vec 0) ==> ((?s. x = s % y) <=> y cross x = vec 0)`, + REWRITE_TAC[CROSS_EQ_0] THEN SIMP_TAC[COLLINEAR_LEMMA_ALT]) + and lemma1 = prove + (`!x y:real^N. + ~(y = vec 0) + ==> ((?t. &0 <= t /\ x = t % y) <=> + (?t. x = t % y) /\ &0 <= x dot y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + ASM_CASES_TAC `x:real^N = t % y` THEN + ASM_SIMP_TAC[DOT_LMUL; REAL_LE_MUL_EQ; DOT_POS_LT]) in + REPEAT GEN_TAC THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC]) + [`x:real^3 = vec 0`; `y:real^3 = vec 0`; `y:real^3 = x`] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[AFF_GE_2_1_0; IN_ELIM_THM; SET_RULE + `DISJOINT {a,b} {c} <=> ~(a = c) /\ ~(b = c)`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; VECTOR_ARITH + `a:real^N = b + c <=> a - c = b`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CROSS_EQ_0]) THEN + ASM_SIMP_TAC[lemma0; lemma1; CROSS_RMUL; CROSS_RSUB; VECTOR_SUB_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of aff_ge {x} {y}, i.e. rays or half-lines. *) +(* ------------------------------------------------------------------------- *) + +let HALFLINE_REFL = prove + (`!x. aff_ge {x} {x} = {x}`, + ONCE_REWRITE_TAC[AFF_GE_DISJOINT_DIFF] THEN + ASM_REWRITE_TAC[DIFF_EQ_EMPTY; GSYM CONVEX_HULL_AFF_GE; CONVEX_HULL_SING]);; + +let HALFLINE_EXPLICIT = prove + (`!x y:real^N. + aff_ge {x} {y} = + {z | ?t1 t2. &0 <= t2 /\ t1 + t2 = &1 /\ z = t1 % x + t2 % y}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real^N = y` THENL + [ASM_REWRITE_TAC[HALFLINE_REFL]; AFF_TAC] THEN + REWRITE_TAC[REAL_ARITH `x + y = &1 <=> x = &1 - y`] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - x) % v + x % v:real^N = v`; + MESON[] `(?x y. P y /\ x = f y /\ Q x y) <=> (?y. P y /\ Q (f y) y)`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_SING; EXTENSION] THEN MESON_TAC[REAL_POS]);; + +let HALFLINE = prove + (`!x y:real^N. + aff_ge {x} {y} = + {z | ?t. &0 <= t /\ z = (&1 - t) % x + t % y}`, + REWRITE_TAC[HALFLINE_EXPLICIT; REAL_ARITH `x + y = &1 <=> x = &1 - y`] THEN + SET_TAC[]);; + +let CLOSED_HALFLINE = prove + (`!x y. closed(aff_ge {x} {y})`, + SIMP_TAC[CLOSED_AFF_GE; FINITE_SING]);; + +let SEGMENT_SUBSET_HALFLINE = prove + (`!x y. segment[x,y] SUBSET aff_ge {x} {y}`, + REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_2; HALFLINE_EXPLICIT] THEN + SET_TAC[]);; + +let ENDS_IN_HALFLINE = prove + (`(!x y. x IN aff_ge {x} {y}) /\ (!x y. y IN aff_ge {x} {y})`, + MESON_TAC[SEGMENT_SUBSET_HALFLINE; SUBSET; ENDS_IN_SEGMENT]);; + +let HALFLINE_SUBSET_AFFINE_HULL = prove + (`!x y. aff_ge {x} {y} SUBSET affine hull {x,y}`, + REWRITE_TAC[AFF_GE_SUBSET_AFFINE_HULL; SET_RULE `{x,y} = {x} UNION {y}`]);; + +let HALFLINE_INTER_COMPACT_SEGMENT = prove + (`!s a b:real^N. + compact s /\ convex s /\ a IN s + ==> ?c. aff_ge {a} {b} INTER s = segment[a,c]`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL + [EXISTS_TAC `a:real^N` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; HALFLINE_REFL] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?u v:real^N. aff_ge {a} {b} INTER s = segment[u,v]` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COMPACT_CONVEX_COLLINEAR_SEGMENT THEN + ASM_SIMP_TAC[CLOSED_INTER_COMPACT; CLOSED_AFF_GE; FINITE_SING] THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_AFF_GE] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + ASM_MESON_TAC[ENDS_IN_HALFLINE]; + MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `affine hull {a:real^N,b}` THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL_COLLINEAR; COLLINEAR_2] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> (s INTER t) SUBSET u`) THEN + REWRITE_TAC[HALFLINE_SUBSET_AFFINE_HULL]]; + ASM_CASES_TAC `u:real^N = a` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `v:real^N = a` THENL + [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN + SUBGOAL_THEN `u IN aff_ge {a:real^N} {b} /\ v IN aff_ge {a} {b}` + MP_TAC THENL [ASM_MESON_TAC[IN_INTER; ENDS_IN_SEGMENT]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [HALFLINE; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s:real` MP_TAC) (X_CHOOSE_THEN `t:real` MP_TAC)) THEN + MAP_EVERY ASM_CASES_TAC [`s = &0`; `t = &0`] THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LID; VECTOR_MUL_LZERO; + VECTOR_ADD_RID] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(a:real^N) IN segment[u,v]` MP_TAC THENL + [ASM_MESON_TAC[IN_INTER; ENDS_IN_HALFLINE]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `u:real` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[VECTOR_ARITH + `a = (&1 - u) % ((&1 - s) % a + s % b) + u % ((&1 - t) % a + t % b) <=> + ((&1 - u) * s + u * t) % (b - a):real^N = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE; REAL_ARITH + `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Definition and properties of conv0. *) +(* ------------------------------------------------------------------------- *) + +let conv0 = new_definition `conv0 S:real^A->bool = affsign sgn_gt {} S`;; + +let CONV0_INJECTIVE_LINEAR_IMAGE = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> conv0(IMAGE f s) = IMAGE f (conv0 s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP AFFSIGN_INJECTIVE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[conv0; IMAGE_CLAUSES]);; + +add_linear_invariants [CONV0_INJECTIVE_LINEAR_IMAGE];; + +let CONV0_TRANSLATION = prove + (`!a s. conv0(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (conv0 s)`, + REWRITE_TAC[conv0; GSYM AFFSIGN_TRANSLATION; IMAGE_CLAUSES]);; + +add_translation_invariants [CONV0_TRANSLATION];; + +let CONV0_SUBSET_CONVEX_HULL = prove + (`!s. conv0 s SUBSET convex hull s`, + REWRITE_TAC[conv0; AFFSIGN; sgn_gt; CONVEX_HULL_FINITE; UNION_EMPTY] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN + MESON_TAC[REAL_LT_IMP_LE]);; + +let CONV0_AFF_GT = prove + (`!s. conv0 s = aff_gt {} s`, + REWRITE_TAC[conv0; aff_gt_def]);; + +let CONVEX_HULL_CONV0_DECOMP = prove + (`!s:real^N->bool. + FINITE s + ==> convex hull s = conv0 s UNION + UNIONS {convex hull (s DELETE a) | a | a IN s}`, + REWRITE_TAC[CONV0_AFF_GT; CONVEX_HULL_AFF_GE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC AFF_GE_AFF_GT_DECOMP THEN + ASM_REWRITE_TAC[FINITE_EMPTY] THEN SET_TAC[]);; + +let CONVEX_CONV0 = prove + (`!s. convex(conv0 s)`, + REWRITE_TAC[CONV0_AFF_GT; CONVEX_AFF_GT]);; + +let BOUNDED_CONV0 = prove + (`!s:real^N->bool. bounded s ==> bounded(conv0 s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `convex hull s:real^N->bool` THEN + ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; CONV0_SUBSET_CONVEX_HULL]);; + +let MEASURABLE_CONV0 = prove + (`!s. bounded s ==> measurable(conv0 s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN + ASM_SIMP_TAC[CONVEX_CONV0; BOUNDED_CONV0]);; + +let NEGLIGIBLE_CONVEX_HULL_DIFF_CONV0 = prove + (`!s:real^N->bool. + FINITE s /\ CARD s <= dimindex(:N) + 1 + ==> negligible(convex hull s DIFF conv0 s)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONVEX_HULL_CONV0_DECOMP] THEN + REWRITE_TAC[SET_RULE `(s UNION t) DIFF s = t DIFF s`] THEN + MATCH_MP_TAC NEGLIGIBLE_DIFF THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN + ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE] THEN ASM_ARITH_TAC);; + +let MEASURE_CONV0_CONVEX_HULL = prove + (`!s:real^N->bool. + FINITE s /\ CARD s <= dimindex(:N) + 1 + ==> measure(conv0 s) = measure(convex hull s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + ASM_SIMP_TAC[MEASURABLE_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN + MATCH_MP_TAC NEGLIGIBLE_UNION THEN + ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_HULL_DIFF_CONV0] THEN + ASM_SIMP_TAC[CONV0_SUBSET_CONVEX_HULL; NEGLIGIBLE_EMPTY; + SET_RULE `s SUBSET t ==> s DIFF t = {}`]);; + +(* ------------------------------------------------------------------------- *) +(* Orthonormal triples of vectors in 3D. *) +(* ------------------------------------------------------------------------- *) + +let orthonormal = new_definition + `orthonormal e1 e2 e3 <=> + e1 dot e1 = &1 /\ e2 dot e2 = &1 /\ e3 dot e3 = &1 /\ + e1 dot e2 = &0 /\ e1 dot e3 = &0 /\ e2 dot e3 = &0 /\ + &0 < (e1 cross e2) dot e3`;; + +let ORTHONORMAL_LINEAR_IMAGE = prove + (`!f. linear(f) /\ (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:3) ==> det(matrix f) = &1) + ==> !e1 e2 e3. orthonormal (f e1) (f e2) (f e3) <=> + orthonormal e1 e2 e3`, + SIMP_TAC[DIMINDEX_3; ARITH; CONJ_ASSOC; GSYM ORTHOGONAL_TRANSFORMATION] THEN + SIMP_TAC[orthonormal; CROSS_ORTHOGONAL_TRANSFORMATION] THEN + SIMP_TAC[orthogonal_transformation; VECTOR_MUL_LID]);; + +add_linear_invariants [ORTHONORMAL_LINEAR_IMAGE];; + +let ORTHONORMAL_PERMUTE = prove + (`!e1 e2 e3. orthonormal e1 e2 e3 ==> orthonormal e2 e3 e1`, + REWRITE_TAC[orthonormal] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM CROSS_TRIPLE] THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[]);; + +let ORTHONORMAL_CROSS = prove + (`!e1 e2 e3. + orthonormal e1 e2 e3 + ==> e2 cross e3 = e1 /\ e3 cross e1 = e2 /\ e1 cross e2 = e3`, + SUBGOAL_THEN + `!e1 e2 e3. orthonormal e1 e2 e3 ==> e3 cross e1 = e2` + (fun th -> MESON_TAC[th; ORTHONORMAL_PERMUTE]) THEN + GEOM_BASIS_MULTIPLE_TAC 1 `e1:real^3` THEN X_GEN_TAC `k:real` THEN + REWRITE_TAC[orthonormal; DOT_LMUL; DOT_RMUL] THEN + SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_RING `k * k = &1 <=> k = &1 \/ k = -- &1`] THEN + ASM_CASES_TAC `k = -- &1` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `k = &1` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; REAL_MUL_LID; REAL_MUL_RID] THEN + SIMP_TAC[cross; DOT_3; VECTOR_3; CART_EQ; FORALL_3; DIMINDEX_3; + BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_POS] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_ADD_RID; + REAL_MUL_LID] THEN + REPEAT GEN_TAC THEN + ASM_CASES_TAC `(e2:real^3)$1 = &0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(e3:real^3)$1 = &0` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_ARITH + `(u = &1 /\ v = &1 /\ w = &0 ==> a = b /\ --c = d \/ a = --b /\ c = d) /\ + (a = --b /\ c = d ==> x <= &0) + ==> (u = &1 /\ v = &1 /\ w = &0 /\ &0 < x + ==> a:real = b /\ --c:real = d)`) THEN + CONJ_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x * x /\ &0 <= y * y ==> --x * x + y * -- y <= &0`) THEN + REWRITE_TAC[REAL_LE_SQUARE]);; + +let ORTHONORMAL_IMP_NONZERO = prove + (`!e1 e2 e3. orthonormal e1 e2 e3 + ==> ~(e1 = vec 0) /\ ~(e2 = vec 0) /\ ~(e3 = vec 0)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);; + +let ORTHONORMAL_IMP_DISTINCT = prove + (`!e1 e2 e3. orthonormal e1 e2 e3 ==> ~(e1 = e2) /\ ~(e1 = e3) /\ ~(e2 = e3)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[orthonormal; DOT_LZERO] THEN REAL_ARITH_TAC);; + +let ORTHONORMAL_IMP_INDEPENDENT = prove + (`!e1 e2 e3. orthonormal e1 e2 e3 ==> independent {e1,e2,e3}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[ORTHONORMAL_IMP_NONZERO]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN + REWRITE_TAC[pairwise; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[orthogonal] THEN + ASM_MESON_TAC[DOT_SYM]);; + +let ORTHONORMAL_IMP_SPANNING = prove + (`!e1 e2 e3. orthonormal e1 e2 e3 ==> span {e1,e2,e3} = (:real^3)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^3)`; `{e1:real^3,e2,e3}`] CARD_EQ_DIM) THEN + ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT; SUBSET_UNIV] THEN + REWRITE_TAC[DIM_UNIV; DIMINDEX_3; HAS_SIZE; FINITE_INSERT; FINITE_EMPTY] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHONORMAL_IMP_DISTINCT) THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; ARITH] THEN SET_TAC[]);; + +let ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0 = prove + (`!e1 e2 e3 t1 t2 t3. + orthonormal e1 e2 e3 + ==> (t1 % e1 + t2 % e2 + t3 % e3 = vec 0 <=> + t1 = &0 /\ t2 = &0 /\ t3 = &0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_3 THEN + ASM_MESON_TAC[ORTHONORMAL_IMP_INDEPENDENT; ORTHONORMAL_IMP_DISTINCT]);; + +let ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT = prove + (`!e1 e2 e3 s1 s2 s3 t1 t2 t3. + orthonormal e1 e2 e3 + ==> (s1 % e1 + s2 % e2 + s3 % e3 = t1 % e1 + t2 % e2 + t3 % e3 <=> + s1 = t1 /\ s2 = t2 /\ s3 = t3)`, + SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0; REAL_SUB_0; VECTOR_ARITH + `a % x + b % y + c % z:real^3 = a' % x + b' % y + c' % z <=> + (a - a') % x + (b - b') % y + (c - c') % z = vec 0`]);; + +(* ------------------------------------------------------------------------- *) +(* Flyspeck arcV is the same as angle even in degenerate cases. *) +(* ------------------------------------------------------------------------- *) + +let arcV = new_definition + `arcV u v w = acs (( (v - u) dot (w - u))/((norm (v-u)) * (norm (w-u))))`;; + +let ARCV_ANGLE = prove + (`!u v w:real^N. arcV u v w = angle(v,u,w)`, + REPEAT GEN_TAC THEN REWRITE_TAC[arcV; angle; vector_angle] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_CASES_TAC `v:real^N = u` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; DOT_LZERO] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; ACS_0] THEN + ASM_CASES_TAC `w:real^N = u` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; DOT_RZERO] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; ACS_0]);; + +let ARCV_LINEAR_IMAGE_EQ = prove + (`!f a b c. + linear f /\ (!x. norm(f x) = norm x) + ==> arcV (f a) (f b) (f c) = arcV a b c`, + REWRITE_TAC[ARCV_ANGLE; ANGLE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [ARCV_LINEAR_IMAGE_EQ];; + +let ARCV_TRANSLATION_EQ = prove + (`!a b c d. arcV (a + b) (a + c) (a + d) = arcV b c d`, + REWRITE_TAC[ARCV_ANGLE; ANGLE_TRANSLATION_EQ]);; + +add_translation_invariants [ARCV_TRANSLATION_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Azimuth angle. *) +(* ------------------------------------------------------------------------- *) + +let AZIM_EXISTS = prove + (`!v w w1 w2. + ?theta. &0 <= theta /\ theta < &2 * pi /\ + ?h1 h2. + !e1 e2 e3. + orthonormal e1 e2 e3 /\ + dist(w,v) % e3 = w - v /\ + ~(w = v) + ==> ?psi r1 r2. + w1 - v = (r1 * cos psi) % e1 + + (r1 * sin psi) % e2 + + h1 % (w - v) /\ + w2 - v = (r2 * cos (psi + theta)) % e1 + + (r2 * sin (psi + theta)) % e2 + + h2 % (w - v) /\ + (~collinear {v, w, w1} ==> &0 < r1) /\ + (~collinear {v, w, w2} ==> &0 < r2)`, + let lemma = prove + (`cos(p) % e + sin(p) % rotate2d (pi / &2) e = rotate2d p e`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + FORALL_2; rotate2d; LAMBDA_BETA; DIMINDEX_2; ARITH; VECTOR_2] THEN + REWRITE_TAC[SIN_PI2; COS_PI2] THEN REAL_ARITH_TAC) in + GEN_GEOM_ORIGIN_TAC `v:real^3` ["e1"; "e2"; "e3"] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN + EXISTS_TAC `(w dot (w1:real^3)) / (w dot w)` THEN + GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN + EXISTS_TAC `(w dot (w2:real^3)) / (w dot w)` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV + [REAL_ARITH `&0 <= w <=> w = &0 \/ &0 < w`] THEN + STRIP_TAC THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; NORM_0] THEN + EXISTS_TAC `&0` THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[DOT_LMUL; NORM_MUL; DIMINDEX_3; ARITH; DOT_RMUL; DOT_BASIS; + VECTOR_MUL_COMPONENT; NORM_BASIS; BASIS_COMPONENT] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < w ==> (w * x) / (w * w) * w = x`; + REAL_ARITH `&0 < w ==> abs w = w`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `a % x:real^3 = a % y <=> a % (x - y) = vec 0`] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO; + DIMINDEX_3; ARITH; VECTOR_SUB_EQ] THEN + REWRITE_TAC[MESON[] `(!e3. p e3 /\ e3 = a ==> q e3) <=> p a ==> q a`] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^3 = a + b + c <=> x - c = a + b`] THEN + REPEAT GEN_TAC THEN + ABBREV_TAC `v1:real^3 = w1 - (w1$3) % basis 3` THEN + ABBREV_TAC `v2:real^3 = w2 - (w2$3) % basis 3` THEN + SUBGOAL_THEN + `(collinear{vec 0, w % basis 3, w1} <=> + w1 - w1$3 % basis 3:real^3 = vec 0) /\ + (collinear{vec 0, w % basis 3, w2} <=> + w2 - w2$3 % basis 3:real^3 = vec 0)` + (fun th -> REWRITE_TAC[th]) + THENL + [ASM_SIMP_TAC[COLLINEAR_LEMMA; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; + BASIS_NONZERO; DIMINDEX_3; ARITH] THEN + MAP_EVERY EXPAND_TAC ["v1"; "v2"] THEN + SIMP_TAC[CART_EQ; VEC_COMPONENT; VECTOR_ADD_COMPONENT; FORALL_3; + VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3; ARITH; + VECTOR_SUB_COMPONENT; REAL_MUL_RZERO; REAL_MUL_RID; + REAL_SUB_RZERO] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + CONV_TAC(BINOP_CONV(BINOP_CONV(ONCE_DEPTH_CONV SYM_CONV))) THEN + ASM_SIMP_TAC[GSYM REAL_EQ_RDIV_EQ; EXISTS_REFL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(v1:real^3)$3 = &0 /\ (v2:real^3)$3 = &0` MP_TAC THENL + [MAP_EVERY EXPAND_TAC ["v1"; "v2"] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_EQ] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v2:real^3`; `v1:real^3`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[orthonormal] THEN + SIMP_TAC[DOT_BASIS; BASIS_COMPONENT; DIMINDEX_3; ARITH] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d /\ e /\ f <=> + d /\ e /\ a /\ b /\ c /\ f`] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + PAD2D3D_TAC THEN REPEAT STRIP_TAC THEN + SIMP_TAC[cross; VECTOR_3; pad2d3d; LAMBDA_BETA; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + ASM_CASES_TAC `v1:real^2 = vec 0` THEN ASM_REWRITE_TAC[NORM_POS_LT] THENL + [MP_TAC(ISPECL [`basis 1:real^2`; `v2:real^2`] + ROTATION_ROTATE2D_EXISTS_GEN) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`e1:real^2`; `basis 1:real^2`] + ROTATION_ROTATE2D_EXISTS_GEN) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`&0`; `norm(v2:real^2)`] THEN + ASM_REWRITE_TAC[NORM_POS_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + SUBGOAL_THEN `norm(e1:real^2) = &1 /\ norm(e2:real^2) = &1` + STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[NORM_EQ_1]; ALL_TAC] THEN + SUBGOAL_THEN `e2 = rotate2d (pi / &2) e1` SUBST1_TAC THENL + [MATCH_MP_TAC ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED THEN + ASM_REWRITE_TAC[NORM_EQ_1; orthogonal]; + ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB] THEN + REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[ROTATE2D_ADD] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN + MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN + EXISTS_TAC `norm(basis 1:real^2)` THEN + ASM_SIMP_TAC[NORM_EQ_0; BASIS_NONZERO; DIMINDEX_2; ARITH] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x:real^2 = b % a % x`] THEN + AP_TERM_TAC THEN + SIMP_TAC[GSYM(MATCH_MP LINEAR_CMUL (SPEC_ALL LINEAR_ROTATE2D))] THEN + AP_TERM_TAC THEN + ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D; VECTOR_MUL_LID]; + MP_TAC(ISPECL [`v1:real^2`; `v2:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`e1:real^2`; `v1:real^2`] ROTATION_ROTATE2D_EXISTS_GEN) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`norm(v1:real^2)`; `norm(v2:real^2)`] THEN + ASM_REWRITE_TAC[NORM_POS_LT] THEN + SUBGOAL_THEN `norm(e1:real^2) = &1 /\ norm(e2:real^2) = &1` + STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[NORM_EQ_1]; ALL_TAC] THEN + SUBGOAL_THEN `e2 = rotate2d (pi / &2) e1` SUBST1_TAC THENL + [MATCH_MP_TAC ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED THEN + ASM_REWRITE_TAC[NORM_EQ_1; orthogonal]; + ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB] THEN + REWRITE_TAC[lemma] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[ROTATE2D_ADD] THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN + MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(v1:real^2)` THEN + ASM_REWRITE_TAC[NORM_EQ_0] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `a % b % x:real^2 = b % a % x`] THEN + AP_TERM_TAC THEN + SIMP_TAC[GSYM(MATCH_MP LINEAR_CMUL (SPEC_ALL LINEAR_ROTATE2D))] THEN + AP_TERM_TAC THEN + ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D; VECTOR_MUL_LID]]);; + +let azim_spec = + (REWRITE_RULE[SKOLEM_THM] + (REWRITE_RULE[RIGHT_EXISTS_IMP_THM] AZIM_EXISTS));; + +let azim_def = new_definition + `azim v w w1 w2 = + if collinear {v,w,w1} \/ collinear {v,w,w2} then &0 + else @theta. &0 <= theta /\ theta < &2 * pi /\ + ?h1 h2. + !e1 e2 e3. + orthonormal e1 e2 e3 /\ + dist(w,v) % e3 = w - v /\ + ~(w = v) + ==> ?psi r1 r2. + w1 - v = (r1 * cos psi) % e1 + + (r1 * sin psi) % e2 + + h1 % (w - v) /\ + w2 - v = (r2 * cos (psi + theta)) % e1 + + (r2 * sin (psi + theta)) % e2 + + h2 % (w - v) /\ + &0 < r1 /\ &0 < r2`;; + +let azim = prove + (`!v w w1 w2:real^3. + &0 <= azim v w w1 w2 /\ azim v w w1 w2 < &2 * pi /\ + ?h1 h2. + !e1 e2 e3. + orthonormal e1 e2 e3 /\ + dist(w,v) % e3 = w - v /\ + ~(w = v) + ==> ?psi r1 r2. + w1 - v = (r1 * cos psi) % e1 + + (r1 * sin psi) % e2 + + h1 % (w - v) /\ + w2 - v = (r2 * cos (psi + azim v w w1 w2)) % e1 + + (r2 * sin (psi + azim v w w1 w2)) % e2 + + h2 % (w - v) /\ + (~collinear {v, w, w1} ==> &0 < r1) /\ + (~collinear {v, w, w2} ==> &0 < r2)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[azim_def] THEN + COND_CASES_TAC THENL + [ALL_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC SELECT_CONV THEN + MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] + AZIM_EXISTS) THEN + ASM_REWRITE_TAC[]] THEN + SIMP_TAC[PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; REAL_LE_REFL] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w2:real^3`; `w1:real^3`] + AZIM_EXISTS) THEN + DISCH_THEN(CHOOSE_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h2:real`; `h1:real`] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`h1:real`; `h2:real`] THEN + MAP_EVERY X_GEN_TAC [`e1:real^3`; `e2:real^3`; `e3:real^3`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `psi:real` THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_RID] THEN + MAP_EVERY X_GEN_TAC [`r2:real`; `r1:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`&0`; `r2:real`]; + MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] + AZIM_EXISTS) THEN + DISCH_THEN(CHOOSE_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`h1:real`; `h2:real`] THEN + MAP_EVERY X_GEN_TAC [`e1:real^3`; `e2:real^3`; `e3:real^3`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `psi:real` THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_ADD_RID] THEN + MAP_EVERY X_GEN_TAC [`r1:real`; `r2:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`r1:real`; `&0`]] THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [SET_RULE `{v,w,x} = {w,v,x}`]) THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[orthonormal]) THEN + ASM_REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `(r * c) * (r * c):real = r pow 2 * c pow 2`] THEN + REWRITE_TAC[REAL_ARITH `r * c + r * s + f:real = r * (s + c) + f`] THEN + REWRITE_TAC[SIN_CIRCLE] THEN REWRITE_TAC[REAL_RING + `(d * h * d) pow 2 = (d * d) * (r * &1 + h * d * h * d) <=> + d = &0 \/ r = &0`] THEN + ASM_REWRITE_TAC[DIST_EQ_0; REAL_POW_EQ_0; ARITH] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO]);; + +let AZIM_UNIQUE = prove + (`!v w w1 w2 h1 h2 r1 r2 e1 e2 e3 psi theta. + &0 <= theta /\ + theta < &2 * pi /\ + orthonormal e1 e2 e3 /\ + dist(w,v) % e3 = w - v /\ + ~(w = v) /\ + &0 < r1 /\ &0 < r2 /\ + w1 - v = (r1 * cos psi) % e1 + + (r1 * sin psi) % e2 + + h1 % (w - v) /\ + w2 - v = (r2 * cos (psi + theta)) % e1 + + (r2 * sin (psi + theta)) % e2 + + h2 % (w - v) + ==> azim v w w1 w2 = theta`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~collinear{v:real^3,w,w2} /\ ~collinear {v,w,w1}` + STRIP_ASSUME_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {b,a,c}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN + UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH + `a + b + c % x:real^N = d % x <=> a + b + (c - d) % x = vec 0`] THEN + ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT_0] THEN + ASM_SIMP_TAC[CONJ_ASSOC; REAL_LT_IMP_NZ; SIN_CIRCLE; REAL_RING + `s pow 2 + c pow 2 = &1 ==> (r * c = &0 /\ r * s = &0 <=> r = &0)`]; + ALL_TAC] THEN + SUBGOAL_THEN `(azim v w w1 w2 - theta) / (&2 * pi) = &0` MP_TAC THENL + [ALL_TAC; MP_TAC PI_POS THEN CONV_TAC REAL_FIELD] THEN + MATCH_MP_TAC REAL_EQ_INTEGERS_IMP THEN + ASM_SIMP_TAC[REAL_SUB_RZERO; REAL_ABS_DIV; REAL_ABS_MUL; REAL_ABS_NUM; + REAL_ABS_PI; REAL_LT_LDIV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH; + PI_POS; INTEGER_CLOSED; REAL_MUL_LID] THEN + MP_TAC(ISPECL [`v:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] azim) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 <= x /\ x < k /\ &0 <= y /\ y < k ==> abs(x - y) < k`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k1:real`; `k2:real`] THEN + DISCH_THEN(MP_TAC o SPECL [`e1:real^3`; `e2:real^3`; `e3:real^3`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`phi:real`; `s1:real`; `s2:real`] THEN + UNDISCH_THEN `dist(w:real^3,v) % e3 = w - v` (SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[ORTHONORMAL_IMP_INDEPENDENT_EXPLICIT] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> (c /\ d) /\ a /\ b`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o MATCH_MP (REAL_FIELD + `r * c = r' * c' /\ r * s = r' * s' /\ u:real = v + ==> s pow 2 + c pow 2 = &1 /\ s' pow 2 + c' pow 2 = &1 /\ + &0 < r /\ (r pow 2 = r' pow 2 ==> r = r') + ==> s = s' /\ c = c'`))) THEN + ASM_REWRITE_TAC[SIN_CIRCLE; GSYM REAL_EQ_SQUARE_ABS] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 < x /\ &0 < y ==> (abs x = abs y <=> x = y)`] THEN + REWRITE_TAC[SIN_COS_EQ] THEN + REWRITE_TAC[REAL_ARITH + `psi + theta = (phi + az) + x:real <=> psi = phi + x + (az - theta)`] THEN + DISCH_THEN(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[REAL_ARITH + `&2 * m * pi + x = &2 * n * pi <=> x = (n - m) * &2 * pi`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[PI_POS; REAL_FIELD `&0 < pi ==> (x * &2 * pi) / (&2 * pi) = x`; + INTEGER_CLOSED]);; + +let AZIM_TRANSLATION = prove + (`!a v w w1 w2. azim (a + v) (a + w) (a + w1) (a + w2) = azim v w w1 w2`, + REPEAT GEN_TAC THEN REWRITE_TAC[azim_def] THEN + REWRITE_TAC[VECTOR_ARITH `(a + w) - (a + v):real^3 = w - v`; + VECTOR_ARITH `a + w:real^3 = a + v <=> w = v`; + NORM_ARITH `dist(a + v,a + w) = dist(v,w)`] THEN + REWRITE_TAC[SET_RULE + `{a + x,a + y,a + z} = IMAGE (\x:real^3. a + x) {x,y,z}`] THEN + REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);; + +add_translation_invariants [AZIM_TRANSLATION];; + +let AZIM_LINEAR_IMAGE = prove + (`!f. linear f /\ (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:3) ==> det(matrix f) = &1) + ==> !v w w1 w2. azim (f v) (f w) (f w1) (f w2) = azim v w w1 w2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[azim_def] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB; dist] THEN + MP_TAC(ISPEC `f:real^3->real^3` QUANTIFY_SURJECTION_THM) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION; + ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; + ALL_TAC] THEN + DISCH_THEN(CONV_TAC o LAND_CONV o EXPAND_QUANTS_CONV) THEN + ASM_SIMP_TAC[ORTHONORMAL_LINEAR_IMAGE] THEN + ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_ADD] THEN + SUBGOAL_THEN `!x y. (f:real^3->real^3) x = f y <=> x = y` ASSUME_TAC THENL + [ASM_MESON_TAC[PRESERVES_NORM_INJECTIVE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SET_RULE `{f x,f y,f z} = IMAGE f {x,y,z}`] THEN + ASM_SIMP_TAC[COLLINEAR_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [AZIM_LINEAR_IMAGE];; + +let AZIM_DEGENERATE = prove + (`(!v w w1 w2. v = w ==> azim v w w1 w2 = &0) /\ + (!v w w1 w2. collinear{v,w,w1} ==> azim v w w1 w2 = &0) /\ + (!v w w1 w2. collinear{v,w,w2} ==> azim v w w1 w2 = &0)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[azim_def] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]);; + +let AZIM_REFL_ALT = prove + (`!v x y. azim v v x y = &0`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(last(CONJUNCTS AZIM_DEGENERATE)) THEN + REWRITE_TAC[COLLINEAR_2; INSERT_AC]);; + +let AZIM_SPECIAL_SCALE = prove + (`!a v w1 w2. + &0 < a + ==> azim (vec 0) (a % v) w1 w2 = azim (vec 0) v w1 w2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[azim_def] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL] + `!a. &0 < a ==> (!y. ?x. a * x = y)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN + DISCH_THEN(CONV_TAC o RAND_CONV o + PARTIAL_EXPAND_QUANTS_CONV ["psi"; "r1"; "r2"]) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < a ==> abs a = a`] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[VECTOR_ARITH `a % x:real^3 = a % y <=> a % (x - y) = vec 0`] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_MUL_EQ_0] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ]);; + +let AZIM_SCALE_ALL = prove + (`!a v w1 w2. + &0 < a /\ &0 < b /\ &0 < c + ==> azim (vec 0) (a % v) (b % w1) (c % w2) = azim (vec 0) v w1 w2`, + let lemma = MESON[REAL_LT_IMP_NZ; REAL_DIV_LMUL] + `!a. &0 < a ==> (!y. ?x. a * x = y)` in + let SCALE_QUANT_TAC side asm avoid = + MP_TAC(MATCH_MP lemma (ASSUME asm)) THEN + DISCH_THEN(MP_TAC o MATCH_MP QUANTIFY_SURJECTION_THM) THEN + DISCH_THEN(CONV_TAC o side o PARTIAL_EXPAND_QUANTS_CONV avoid) in + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[azim_def; COLLINEAR_SCALE_ALL; REAL_LT_IMP_NZ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN + ASM_SIMP_TAC[DIST_0; NORM_MUL; GSYM VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; VECTOR_MUL_LCANCEL] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN + SCALE_QUANT_TAC RAND_CONV `&0 < a` ["psi"; "r1"; "r2"] THEN + SCALE_QUANT_TAC LAND_CONV `&0 < b` ["psi"; "h2"; "r2"] THEN + SCALE_QUANT_TAC LAND_CONV `&0 < c` ["psi"; "h1"; "r1"] THEN + ASM_SIMP_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; + VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; REAL_LT_MUL_EQ] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_AC]);; + +let AZIM_ARG = prove + (`!x y:real^3. azim (vec 0) (basis 3) x y = Arg(dropout 3 y / dropout 3 x)`, + let lemma = prove + (`(r * cos t) % basis 1 + (r * sin t) % basis 2 = Cx r * cexp(ii * Cx t)`, + REWRITE_TAC[CEXP_EULER; COMPLEX_BASIS; GSYM CX_SIN; GSYM CX_COS; + COMPLEX_CMUL; CX_MUL] THEN + CONV_TAC COMPLEX_RING) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `collinear {vec 0:real^3,basis 3,x}` THENL + [ASM_SIMP_TAC[AZIM_DEGENERATE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_INV_0; + COMPLEX_MUL_RZERO; ARG_0]; + ALL_TAC] THEN + ASM_CASES_TAC `collinear {vec 0:real^3,basis 3,y}` THENL + [ASM_SIMP_TAC[AZIM_DEGENERATE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + ASM_REWRITE_TAC[COMPLEX_VEC_0; complex_div; COMPLEX_MUL_LZERO; ARG_0]; + ALL_TAC] THEN + MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `x:real^3`; `y:real^3`] + azim) THEN + ABBREV_TAC `a = azim (vec 0) (basis 3) x (y:real^3)` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_SUB_RZERO; DIST_0] THEN + MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN + DISCH_THEN(MP_TAC o SPECL + [`basis 1:real^3`; `basis 2:real^3`; `basis 3:real^3`]) THEN + SIMP_TAC[orthonormal; DOT_BASIS_BASIS; CROSS_BASIS; DIMINDEX_3; NORM_BASIS; + ARITH; VECTOR_MUL_LID; BASIS_NONZERO; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`psi:real`; `r1:real`; `r2:real`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; lemma] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `(a * b) * (c * d):complex = (a * c) * b * d`] THEN + REWRITE_TAC[GSYM complex_div; GSYM CX_DIV; GSYM CEXP_SUB] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC ARG_UNIQUE THEN + EXISTS_TAC `r2 / r1:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CX_ADD] THEN + CONV_TAC COMPLEX_RING);; + +let REAL_CONTINUOUS_AT_AZIM_SHARP = prove + (`!v w w1 w2. + ~collinear{v,w,w1} /\ ~(w2 IN aff_ge {v,w} {w1}) + ==> (azim v w w1) real_continuous at w2`, + GEOM_ORIGIN_TAC `v:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LT; COLLINEAR_SPECIAL_SCALE] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_SPECIAL_SCALE o + rand o rand o lhand o snd) THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_SING] THEN ANTS_TAC THENL + [POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; + ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; + ASM_SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN + MESON_TAC[]]; + DISCH_THEN SUBST1_TAC THEN DISCH_TAC] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] + REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE) THEN + CONJ_TAC THENL + [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_CONST; ETA_AX] THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_DROPOUT; DIMINDEX_3; DIMINDEX_2; + ARITH]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_ARG THEN + MP_TAC(ISPECL [`w2:real^3`; `w1:real^3`] AFF_GE_2_1_0_DROPOUT_3) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:real^2`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:real^2`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN + X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN X_GEN_TAC `z:complex` THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[CONTRAPOS_THM; COMPLEX_BASIS; COMPLEX_CMUL] THEN + REWRITE_TAC[COMPLEX_MUL_RID; RE_DIV_CX; IM_DIV_CX; real] THEN + ASM_SIMP_TAC[REAL_DIV_EQ_0; REAL_LE_RDIV_EQ; REAL_MUL_LZERO] THEN + STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_1_1_0 o rand o snd) THEN + ASM_REWRITE_TAC[COMPLEX_VEC_0; CX_INJ] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `Re z / w` THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; COMPLEX_EQ] THEN + ASM_SIMP_TAC[COMPLEX_CMUL; CX_DIV; COMPLEX_DIV_RMUL; CX_INJ] THEN + REWRITE_TAC[RE_CX; IM_CX]);; + +let REAL_CONTINUOUS_AT_AZIM = prove + (`!v w w1 w2. ~coplanar{v,w,w1,w2} ==> (azim v w w1) real_continuous at w2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_AZIM_SHARP THEN + CONJ_TAC THENL + [ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR; INSERT_AC]; + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + AFF_GE_SUBSET_AFFINE_HULL)) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[coplanar; CONTRAPOS_THM] THEN + REWRITE_TAC[SET_RULE `{a,b} UNION {c} = {a,b,c}`] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC + [`v:real^3`; `w:real^3`; `w1:real^3`] THEN + SIMP_TAC[SET_RULE `{a,b,c,d} SUBSET s <=> {a,b,c} SUBSET s /\ d IN s`] THEN + ASM_REWRITE_TAC[HULL_SUBSET]]);; + +let AZIM_REFL = prove + (`!v0 v1 w. azim v0 v1 w w = &0`, + GEOM_ORIGIN_TAC `v0:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; AZIM_DEGENERATE] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG; ARG_EQ_0] THEN + X_GEN_TAC `w:real^3` THEN + ASM_CASES_TAC `(dropout 3 :real^3->real^2) w = Cx(&0)` THEN + ASM_SIMP_TAC[COMPLEX_DIV_REFL; REAL_CX; RE_CX; REAL_POS] THEN + ASM_SIMP_TAC[complex_div; COMPLEX_MUL_LZERO; REAL_CX; RE_CX; REAL_POS]);; + +let AZIM_EQ = prove + (`!v0 v1 w x y. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} /\ ~collinear{v0,v1,y} + ==> (azim v0 v1 w x = azim v0 v1 w y <=> y IN aff_gt {v0,v1} {x})`, + GEOM_ORIGIN_TAC `v0:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; REAL_LT_IMP_NZ; COLLINEAR_SPECIAL_SCALE] THEN + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o + rand o rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN + REPEAT CONJ_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + TRY(RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN + FIRST_X_ASSUM CONTR_TAC) THEN + UNDISCH_TAC `~collinear {vec 0:real^3, basis 3, v1 % basis 3}` THEN + REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[AZIM_ARG] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN + W(MP_TAC o PART_MATCH (lhs o rand) ARG_EQ o lhand o snd) THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + ASM_REWRITE_TAC[complex_div; COMPLEX_ENTIRE; COMPLEX_INV_EQ_0] THEN + ASM_REWRITE_TAC[GSYM complex_div; GSYM COMPLEX_VEC_0] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[GSYM COMPLEX_VEC_0; COMPLEX_FIELD + `~(w = Cx(&0)) ==> (y / w = x * u / w <=> y = x * u)`] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN + ASM_MESON_TAC[DROPOUT_BASIS_3; DROPOUT_0]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c. p c /\ q a b c /\ r b c) <=> + (?c. p c /\ ?b. r b c /\ ?a. q a b c)`] THEN + SIMP_TAC[REAL_ARITH `a + b + c = &1 <=> a = &1 - b - c`; EXISTS_REFL] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM COMPLEX_CMUL] THEN + SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; + dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; + VECTOR_ADD_COMPONENT; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[REAL_ARITH `y:real = t + z <=> t = y - z`; EXISTS_REFL]);; + +let AZIM_EQ_ALT = prove + (`!v0 v1 w x y. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} /\ ~collinear{v0,v1,y} + ==> (azim v0 v1 w x = azim v0 v1 w y <=> x IN aff_gt {v0,v1} {y})`, + ASM_SIMP_TAC[GSYM AZIM_EQ] THEN MESON_TAC[]);; + +let AZIM_EQ_0 = prove + (`!v0 v1 w x. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} + ==> (azim v0 v1 w x = &0 <=> w IN aff_gt {v0,v1} {x})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `azim v0 v1 w x = azim v0 v1 w w` THEN CONJ_TAC THENL + [REWRITE_TAC[AZIM_REFL]; + ASM_SIMP_TAC[AZIM_EQ]]);; + +let AZIM_EQ_0_ALT = prove + (`!v0 v1 w x. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} + ==> (azim v0 v1 w x = &0 <=> x IN aff_gt {v0,v1} {w})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `azim v0 v1 w x = azim v0 v1 w w` THEN CONJ_TAC THENL + [REWRITE_TAC[AZIM_REFL]; + ASM_SIMP_TAC[AZIM_EQ_ALT]]);; + +let AZIM_EQ_0_GE = prove + (`!v0 v1 w x. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} + ==> (azim v0 v1 w x = &0 <=> w IN aff_ge {v0,v1} {x})`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `v1:real^3 = v0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; STRIP_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o + rand o rand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; DISJOINT_INSERT; DISJOINT_EMPTY] THEN + REWRITE_TAC[IN_SING] THEN + CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_2; INSERT_AC]) THEN + FIRST_ASSUM CONTR_TAC; + DISCH_THEN SUBST1_TAC] THEN + ASM_SIMP_TAC[AZIM_EQ_0] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_1] THEN + REWRITE_TAC[SET_RULE `{x} DELETE x = {}`] THEN + REWRITE_TAC[AFF_GE_EQ_AFFINE_HULL; IN_UNION] THEN + ASM_SIMP_TAC[GSYM COLLINEAR_3_AFFINE_HULL]);; + +let AZIM_COMPL_EQ_0 = prove + (`!z w w1 w2. + ~collinear {z,w,w1} /\ ~collinear {z,w,w2} /\ azim z w w1 w2 = &0 + ==> azim z w w2 w1 = &0`, + REWRITE_TAC[IMP_CONJ] THEN + GEOM_ORIGIN_TAC `z:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; AZIM_ARG] THEN + REWRITE_TAC[ARG_EQ_0; real; IM_COMPLEX_DIV_EQ_0; RE_COMPLEX_DIV_GE_0] THEN + REWRITE_TAC[complex_mul; RE; IM; cnj] THEN REAL_ARITH_TAC);; + +let AZIM_COMPL = prove + (`!z w w1 w2. + ~collinear {z,w,w1} /\ ~collinear {z,w,w2} + ==> azim z w w2 w1 = if azim z w w1 w2 = &0 then &0 + else &2 * pi - azim z w w1 w2`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_MESON_TAC[AZIM_COMPL_EQ_0]; ALL_TAC] THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN MP_TAC th) THEN + GEOM_ORIGIN_TAC `z:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; AZIM_ARG] THEN + REWRITE_TAC[COLLINEAR_BASIS_3] THEN REWRITE_TAC[ARG_EQ_0] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(dropout 3:real^3->real^2) w2 / + (dropout 3:real^3->real^2) w1` ARG_INV) THEN + ASM_REWRITE_TAC[COMPLEX_INV_DIV]);; + +let AZIM_EQ_PI_SYM = prove + (`!z w w1 w2. + ~collinear {z, w, w1} /\ ~collinear {z, w, w2} + ==> (azim z w w1 w2 = pi <=> azim z w w2 w1 = pi)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o rand o snd) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let AZIM_EQ_0_SYM = prove + (`!z w w1 w2. + ~collinear {z, w, w1} /\ ~collinear {z, w, w2} + ==> (azim z w w1 w2 = &0 <=> azim z w w2 w1 = &0)`, + MESON_TAC[AZIM_COMPL_EQ_0]);; + +let AZIM_EQ_0_GE_ALT = prove + (`!v0 v1 w x. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} + ==> (azim v0 v1 w x = &0 <=> x IN aff_ge {v0,v1} {w})`, + ASM_MESON_TAC[AZIM_EQ_0_SYM; AZIM_EQ_0_GE]);; + +let AZIM_EQ_PI = prove + (`!v0 v1 w x. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} + ==> (azim v0 v1 w x = pi <=> w IN aff_lt {v0,v1} {x})`, + GEOM_ORIGIN_TAC `v0:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; REAL_LT_IMP_NZ; + COLLINEAR_SPECIAL_SCALE] THEN + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_SPECIAL_SCALE o + rand o rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY] THEN + REPEAT CONJ_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + TRY(RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COLLINEAR_2]) THEN + FIRST_X_ASSUM CONTR_TAC) THEN + UNDISCH_TAC `~collinear {vec 0:real^3, basis 3, v1 % basis 3}` THEN + REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[AZIM_ARG] THEN CONV_TAC(LAND_CONV SYM_CONV) THEN + CONV_TAC(LAND_CONV SYM_CONV) THEN REWRITE_TAC[ARG_EQ_PI] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `(dropout 3 (w:real^3)) IN aff_lt {vec 0:real^2} {dropout 3 (x:real^3)}` THEN + CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN + SPEC_TAC(`(dropout 3:real^3->real^2) x`,`y:complex`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w`,`v:complex`) THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v:complex` THEN + X_GEN_TAC `v:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `v = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN + REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO] THEN + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_1_1 o rand o rand o snd) THEN + ASM_REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; IN_SING] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_CMUL; IN_ELIM_THM; COMPLEX_MUL_RZERO] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; COMPLEX_ADD_LID] THEN + EQ_TAC THENL + [REWRITE_TAC[GSYM real; REAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) ASSUME_TAC) THEN + EXISTS_TAC `v / Re y` THEN REWRITE_TAC[GSYM CX_MUL; CX_INJ] THEN + CONJ_TAC THENL + [ALL_TAC; REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]; + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[CX_INJ; REAL_ARITH `x < &0 ==> ~(x = &0)`; COMPLEX_FIELD + `~(t = Cx(&0)) ==> (v = t * y <=> y = v / t)`] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM CX_DIV] THEN + REWRITE_TAC[RE_CX; IM_CX]] THEN + REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + ASM_REAL_ARITH_TAC; + W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_2_1 o rand o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN + CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_2; INSERT_AC]) THEN + FIRST_ASSUM CONTR_TAC; + DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_LT_1_1 o rand o lhand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT {a} {x} <=> ~(x = a)`] THEN + ASM_MESON_TAC[COLLINEAR_BASIS_3]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[REAL_ARITH `s + t = &1 <=> s = &1- t`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; RIGHT_EXISTS_AND_THM] THEN X_GEN_TAC `t:real` THEN + AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; + dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; + VECTOR_ADD_COMPONENT; REAL_ADD_LID; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[REAL_ARITH `x:real = t + y <=> t = x - y`] THEN + REWRITE_TAC[EXISTS_REFL]]);; + +let AZIM_EQ_PI_ALT = prove + (`!v0 v1 w x. + ~collinear{v0,v1,w} /\ ~collinear{v0,v1,x} + ==> (azim v0 v1 w x = pi <=> x IN aff_lt {v0,v1} {w})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP AZIM_EQ_PI_SYM) THEN + ASM_SIMP_TAC[AZIM_EQ_PI]);; + +let AZIM_EQ_0_PI_IMP_COPLANAR = prove + (`!v0 v1 w1 w2. + azim v0 v1 w1 w2 = &0 \/ azim v0 v1 w1 w2 = pi + ==> coplanar {v0,v1,w1,w2}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w1}` THENL + [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`] + NOT_COPLANAR_NOT_COLLINEAR) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC TAUT; + POP_ASSUM MP_TAC] THEN + ASM_CASES_TAC `collinear {v0:real^3,v1,w2}` THENL + [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w2:real^3`; `w1:real^3`] + NOT_COPLANAR_NOT_COLLINEAR) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[INSERT_AC] THEN CONV_TAC TAUT; + POP_ASSUM MP_TAC] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) + [`w2:real^3`; `w1:real^3`; `v1:real^3`; `v0:real^3`] THEN + GEOM_ORIGIN_TAC `v0:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + SIMP_TAC[AZIM_SPECIAL_SCALE] THEN + ASM_SIMP_TAC[AZIM_ARG; COLLINEAR_SPECIAL_SCALE] THEN + REWRITE_TAC[COLLINEAR_BASIS_3; ARG_EQ_0_PI] THEN + REWRITE_TAC[real; IM_COMPLEX_DIV_EQ_0] THEN + REWRITE_TAC[complex_mul; cnj; IM; RE] THEN + REWRITE_TAC[REAL_ARITH `x * --y + a * b = &0 <=> x * y = a * b`] THEN + REWRITE_TAC[RE_DEF; IM_DEF] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN DISCH_TAC THEN + SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_3; ARITH; DIMINDEX_2] THEN + DISCH_TAC THEN REWRITE_TAC[coplanar] THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^3`; `w % basis 3:real^3`; `w1:real^3`] THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = d INSERT {a,b,c}`] THEN + ONCE_REWRITE_TAC[INSERT_SUBSET] THEN REWRITE_TAC[HULL_SUBSET] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; HULL_INC] THEN + REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; FORALL_3; dropout; LAMBDA_BETA; + DIMINDEX_2; DIMINDEX_3; ARITH; VEC_COMPONENT; ARITH; + VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + ASM_SIMP_TAC[EXISTS_REFL; REAL_FIELD + `&0 < w ==> (x - k * w * &1 - y = &0 <=> k = (x - y) / w)`] THEN + SUBGOAL_THEN `~((w1:real^3)$2 = &0) \/ ~((w2:real^3)$1 = &0)` + STRIP_ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_RING; + EXISTS_TAC `(w2:real^3)$2 / (w1:real^3)$2` THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + EXISTS_TAC `(w2:real^3)$1 / (w1:real^3)$1` THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; + +let AZIM_SAME_WITHIN_AFF_GE = prove + (`!a u v w z. + v IN aff_ge {a} {u,w} /\ ~collinear{a,u,v} /\ ~collinear{a,u,w} + ==> azim a u v z = azim a u w z`, + GEOM_ORIGIN_TAC `a:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `u:real^3` THEN + X_GEN_TAC `u:real` THEN ASM_CASES_TAC `u = &0` THEN + ASM_SIMP_TAC[AZIM_DEGENERATE; VECTOR_MUL_LZERO; REAL_LE_LT] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `w:real^3 = vec 0` THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN + ASM_SIMP_TAC[AFF_GE_SCALE_LEMMA] THEN + REWRITE_TAC[COLLINEAR_BASIS_3; AZIM_ARG] THEN + ASM_SIMP_TAC[AFF_GE_1_2_0; BASIS_NONZERO; ARITH; DIMINDEX_3; + SET_RULE `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `dropout 3:real^3->real^2`) THEN + REWRITE_TAC[DROPOUT_ADD; DROPOUT_MUL; DROPOUT_BASIS_3] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + DISCH_THEN SUBST1_TAC THEN REPEAT DISCH_TAC THEN + REWRITE_TAC[COMPLEX_CMUL] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM CX_INV] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c:complex = b * a * c`] THEN + MATCH_MP_TAC ARG_MUL_CX THEN REWRITE_TAC[REAL_LT_INV_EQ] THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN ASM_MESON_TAC[VECTOR_MUL_LZERO]);; + +let AZIM_SAME_WITHIN_AFF_GE_ALT = prove + (`!a u v w z. + v IN aff_ge {a} {u,w} /\ ~collinear{a,u,v} /\ ~collinear{a,u,w} + ==> azim a u z v = azim a u z w`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AZIM_SAME_WITHIN_AFF_GE) THEN + ASM_CASES_TAC `collinear {a:real^3,u,z}` THEN + ASM_SIMP_TAC[AZIM_DEGENERATE] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o rand o snd) THEN + ASM_SIMP_TAC[]);; + +let COLLINEAR_WITHIN_AFF_GE_COLLINEAR = prove + (`!a u v w:real^N. + v IN aff_ge {a} {u,w} /\ collinear{a,u,w} ==> collinear{a,v,w}`, + GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `w:real^N = vec 0` THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; ALL_TAC] THEN + ASM_CASES_TAC `u:real^N = vec 0` THENL + [ONCE_REWRITE_TAC[AFF_GE_DISJOINT_DIFF] THEN + ASM_REWRITE_TAC[SET_RULE `{a} DIFF {a,b} = {}`] THEN + REWRITE_TAC[GSYM CONVEX_HULL_AFF_GE] THEN + ONCE_REWRITE_TAC[SET_RULE `{z,v,w} = {z,w,v}`] THEN + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN + MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; + ONCE_REWRITE_TAC[SET_RULE `{z,v,w} = {z,w,v}`] THEN + ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `a:real`)) THEN + ASM_SIMP_TAC[AFF_GE_1_2_0; SET_RULE + `DISJOINT {a} {b,c} <=> ~(b = a) /\ ~(c = a)`] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_ASSOC] THEN + MESON_TAC[]]);; + +let AZIM_EQ_IMP = prove + (`!v0 v1 w x y. + ~collinear {v0, v1, w} /\ + ~collinear {v0, v1, y} /\ + x IN aff_gt {v0, v1} {y} + ==> azim v0 v1 w x = azim v0 v1 w y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `collinear {v0:real^3,v1,x}` THENL + [ALL_TAC; ASM_SIMP_TAC[AZIM_EQ_ALT]] THEN + UNDISCH_TAC `collinear {v0:real^3,v1,x}` THEN + MATCH_MP_TAC(TAUT + `(s /\ p ==> r) ==> p ==> ~q /\ ~r /\ s ==> t`) THEN + ASM_SIMP_TAC[COLLINEAR_3_IN_AFFINE_HULL] THEN + ASM_CASES_TAC `y:real^3 = v0` THEN + ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN + ASM_CASES_TAC `y:real^3 = v1` THEN + ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN + ASM_SIMP_TAC[AFF_GT_2_1; SET_RULE + `DISJOINT {a,b} {c} <=> ~(c = a) /\ ~(c = b)`] THEN + REWRITE_TAC[AFFINE_HULL_2; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`t1:real`; `t2:real`; `t3:real`; `s1:real`; `s2:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv t3) :real^3->real^3`) THEN + ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV; + REAL_LT_IMP_NZ; VECTOR_ARITH + `x:real^N = y + z + &1 % w <=> w = x - (y + z)`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `inv t3 * s1 - inv t3 * t1:real` THEN + EXISTS_TAC `inv t3 * s2 - inv t3 * t2:real` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_FIELD + `&0 < t ==> (inv t * a - inv t * b + inv t * c - inv t * d = &1 <=> + (a + c) - (b + d) = t)`] THEN + ASM_REAL_ARITH_TAC; + VECTOR_ARITH_TAC]);; + +let AZIM_EQ_0_GE_IMP = prove + (`!v0 v1 w x. x IN aff_ge {v0, v1} {w} ==> azim v0 v1 w x = &0`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `collinear {v0:real^3,v1,w}` THEN + ASM_SIMP_TAC[AZIM_DEGENERATE] THEN + ASM_CASES_TAC `collinear {v0:real^3,v1,x}` THEN + ASM_SIMP_TAC[AZIM_DEGENERATE] THEN ASM_MESON_TAC[AZIM_EQ_0_GE_ALT]);; + +let REAL_SGN_SIN_AZIM = prove + (`!v w x y. real_sgn(sin(azim v w x y)) = + real_sgn(((w - v) cross (x - v)) dot (y - v))`, + GEOM_ORIGIN_TAC `v:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; CROSS_LZERO; DOT_LZERO; REAL_SGN_0; + AZIM_REFL_ALT; SIN_0] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; CROSS_LMUL; DOT_LMUL] THEN + REWRITE_TAC[REAL_SGN_MUL] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; AZIM_ARG] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `real_sgn(Im(dropout 3 (y:real^3) / dropout 3 (x:real^3)))` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_SGN_IM_COMPLEX_DIV] THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; cross; VECTOR_3; DOT_3; dropout; + LAMBDA_BETA; ARITH; cnj; complex_mul; RE_DEF; IM_DEF; DIMINDEX_2; + complex; VECTOR_2; BASIS_COMPONENT] THEN REAL_ARITH_TAC] THEN + + SPEC_TAC(`(dropout 3:real^3->real^2) x`,`z:complex`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) y`,`w:complex`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `z:complex` THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_MUL_RID] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN X_GEN_TAC `z:complex` THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[complex_div; COMPLEX_INV_0; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[ARG_0; SIN_0; IM_CX; REAL_SGN_0]; + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]] THEN + ASM_SIMP_TAC[ARG_DIV_CX; IM_DIV_CX; REAL_SGN_DIV] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [real_sgn] THEN + ASM_REWRITE_TAC[REAL_DIV_1] THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[IM_CX; ARG_0; SIN_0] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN + REWRITE_TAC[IM_MUL_CX; REAL_SGN_MUL] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; REAL_MUL_LID] THEN + REWRITE_TAC[IM_CEXP; RE_MUL_II; IM_MUL_II; RE_CX; REAL_SGN_MUL] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [real_sgn] THEN + REWRITE_TAC[REAL_EXP_POS_LT; REAL_MUL_LID]);; + +let AZIM_IN_UPPER_HALFSPACE = prove + (`!v w x y. azim v w x y <= pi <=> + &0 <= ((w - v) cross (x - v)) dot (y - v)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&0 <= sin(azim v w x y)` THEN CONJ_TAC THENL + [EQ_TAC THEN SIMP_TAC[SIN_POS_PI_LE; azim] THEN + MP_TAC(ISPEC `azim v w x y - pi` SIN_POS_PI) THEN + REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI; azim; + REAL_ARITH `x - pi < pi <=> x < &2 * pi`] THEN + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[GSYM REAL_SGN_INEQS] THEN + REWRITE_TAC[REAL_SGN_SIN_AZIM]]);; + +(* ------------------------------------------------------------------------- *) +(* Dihedral angle and relation to azimuth angle. *) +(* ------------------------------------------------------------------------- *) + +let dihV = new_definition + `dihV w0 w1 w2 w3 = + let va = w2 - w0 in + let vb = w3 - w0 in + let vc = w1 - w0 in + let vap = ( vc dot vc) % va - ( va dot vc) % vc in + let vbp = ( vc dot vc) % vb - ( vb dot vc) % vc in + arcV (vec 0) vap vbp`;; + +let DIHV = prove + (`dihV (w0:real^N) w1 w2 w3 = + let va = w2 - w0 in + let vb = w3 - w0 in + let vc = w1 - w0 in + let vap = (vc dot vc) % va - (va dot vc) % vc in + let vbp = (vc dot vc) % vb - (vb dot vc) % vc in + angle(vap,vec 0,vbp)`, + REWRITE_TAC[dihV; ARCV_ANGLE]);; + +let DIHV_TRANSLATION_EQ = prove + (`!a w0 w1 w2 w3:real^N. + dihV (a + w0) (a + w1) (a + w2) (a + w3) = dihV w0 w1 w2 w3`, + REWRITE_TAC[DIHV; VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; + +add_translation_invariants [DIHV_TRANSLATION_EQ];; + +let DIHV_LINEAR_IMAGE = prove + (`!f:real^M->real^N w0 w1 w2 w3. + linear f /\ (!x. norm(f x) = norm x) + ==> dihV (f w0) (f w1) (f w2) (f w3) = dihV w0 w1 w2 w3`, + REPEAT STRIP_TAC THEN REWRITE_TAC[DIHV] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + ASM_SIMP_TAC[PRESERVES_NORM_PRESERVES_DOT] THEN + ASM_SIMP_TAC[GSYM LINEAR_CMUL; GSYM LINEAR_SUB] THEN + REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN + ASM_SIMP_TAC[VECTOR_ANGLE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [DIHV_LINEAR_IMAGE];; + +let DIHV_SPECIAL_SCALE = prove + (`!a v w1 w2:real^N. + ~(a = &0) + ==> dihV (vec 0) (a % v) w1 w2 = dihV (vec 0) v w1 w2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[DIHV; VECTOR_SUB_RZERO] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[DOT_LMUL; DOT_RMUL; GSYM VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[VECTOR_ARITH `a % a % x - a % b % a % y:real^N = + (a * a) % (x - b % y)`] THEN + REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN + ASM_REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);; + +let DIHV_RANGE = prove + (`!w0 w1 w2 w3. &0 <= dihV w0 w1 w2 w3 /\ dihV w0 w1 w2 w3 <= pi`, + REWRITE_TAC[DIHV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[ANGLE_RANGE]);; + +let COS_AZIM_DIHV = prove + (`!v w v1 v2:real^3. + ~collinear {v,w,v1} /\ ~collinear {v,w,v2} + ==> cos(azim v w v1 v2) = cos(dihV v w v1 v2)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `w:real^3 = v` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; POP_ASSUM MP_TAC] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + GEOM_ORIGIN_TAC `v:real^3` THEN GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; DIHV_SPECIAL_SCALE; REAL_LT_IMP_NZ; + COLLINEAR_SPECIAL_SCALE; COLLINEAR_BASIS_3] THEN + DISCH_TAC THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY X_GEN_TAC [`w1:real^3`; `w2:real^3`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN + REWRITE_TAC[DIHV; VECTOR_SUB_RZERO] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH] THEN + SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH; VECTOR_MUL_LID] THEN + MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`] + azim) THEN + ABBREV_TAC `a = azim (vec 0) (basis 3) w1 (w2:real^3)` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_SUB_RZERO; DIST_0] THEN + MAP_EVERY X_GEN_TAC [`h1:real`; `h2:real`] THEN + DISCH_THEN(MP_TAC o SPECL + [`basis 1:real^3`; `basis 2:real^3`; `basis 3:real^3`]) THEN + SIMP_TAC[orthonormal; DOT_BASIS_BASIS; CROSS_BASIS; DIMINDEX_3; NORM_BASIS; + ARITH; VECTOR_MUL_LID; BASIS_NONZERO; REAL_LT_01; LEFT_IMP_EXISTS_THM] THEN + ASM_REWRITE_TAC[COLLINEAR_BASIS_3] THEN + MAP_EVERY X_GEN_TAC [`psi:real`; `r1:real`; `r2:real`] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LID] THEN + REWRITE_TAC[VECTOR_ARITH `(a + b + c) - c:real^N = a + b`] THEN + REWRITE_TAC[COS_ANGLE; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[vector_norm; GSYM DOT_EQ_0; DIMINDEX_3; FORALL_3; DOT_3] THEN + REWRITE_TAC[VEC_COMPONENT; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT; DIMINDEX_3; ARITH; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ADD_LID; REAL_ADD_RID; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_ARITH `(r * c) * (r * c) + (r * s) * (r * s):real = + r pow 2 * (s pow 2 + c pow 2)`] THEN + ASM_SIMP_TAC[SIN_CIRCLE; REAL_MUL_RID; REAL_POW_EQ_0; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `(r1 * c1) * (r2 * c2) + (r1 * s1) * (r2 * s2):real = + (r1 * r2) * (c1 * c2 + s1 * s2)`] THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < r1 /\ &0 < r2 ==> ((r1 * r2) * x) / (r1 * r2) = x`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a:real = b + c * d <=> b - --c * d = a`] THEN + GEN_REWRITE_TAC (funpow 3 LAND_CONV) [GSYM COS_NEG] THEN + REWRITE_TAC[GSYM SIN_NEG; GSYM COS_ADD] THEN AP_TERM_TAC THEN + REAL_ARITH_TAC);; + +let AZIM_DIHV_SAME = prove + (`!v w v1 v2:real^3. + ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\ + azim v w v1 v2 < pi + ==> azim v w v1 v2 = dihV v w v1 v2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_INJ_PI THEN + ASM_SIMP_TAC[COS_AZIM_DIHV; azim; REAL_LT_IMP_LE; DIHV_RANGE]);; + +let AZIM_DIHV_COMPL = prove + (`!v w v1 v2:real^3. + ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\ + pi <= azim v w v1 v2 + ==> azim v w v1 v2 = &2 * pi - dihV v w v1 v2`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x = &2 * pi - y <=> y = &2 * pi - x`] THEN + MATCH_MP_TAC COS_INJ_PI THEN + REWRITE_TAC[COS_SUB; SIN_NPI; COS_NPI; REAL_MUL_LZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[COS_AZIM_DIHV; REAL_ADD_RID; REAL_MUL_LID] THEN + ASM_REWRITE_TAC[DIHV_RANGE] THEN MATCH_MP_TAC(REAL_ARITH + `p <= x /\ x < &2 * p ==> &0 <= &2 * p - x /\ &2 * p - x <= p`) THEN + ASM_SIMP_TAC[azim]);; + +let AZIM_DIVH = prove + (`!v w v1 v2:real^3. + ~collinear {v,w,v1} /\ ~collinear {v,w,v2} + ==> azim v w v1 v2 = if azim v w v1 v2 < pi then dihV v w v1 v2 + else &2 * pi - dihV v w v1 v2`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN + ASM_SIMP_TAC[AZIM_DIHV_SAME; AZIM_DIHV_COMPL]);; + +let AZIM_DIHV_EQ_0 = prove + (`!v0 v1 w1 w2. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> (azim v0 v1 w1 w2 = &0 <=> dihV v0 v1 w1 w2 = &0)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhs o snd) THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a:real = p - b <=> b = p - a`] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_ARITH `&2 * p - (&2 * p - a) = &0 <=> a = &0`] THEN + MATCH_MP_TAC(REAL_ARITH + `a < &2 * pi /\ ~(a < pi) ==> (a = &0 <=> &2 * pi - a = &0)`) THEN + ASM_REWRITE_TAC[azim]);; + +let AZIM_DIHV_EQ_PI = prove + (`!v0 v1 w1 w2. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> (azim v0 v1 w1 w2 = pi <=> dihV v0 v1 w1 w2 = pi)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhs o snd) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let AZIM_EQ_0_PI_EQ_COPLANAR = prove + (`!v0 v1 w1 w2. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> (azim v0 v1 w1 w2 = &0 \/ azim v0 v1 w1 w2 = pi <=> + coplanar {v0,v1,w1,w2})`, + REWRITE_TAC[TAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN + REWRITE_TAC[AZIM_EQ_0_PI_IMP_COPLANAR] THEN + SIMP_TAC[GSYM IMP_CONJ_ALT; COPLANAR; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`v0:real^3`; `v1:real^3`; `v2:real^3`; `v3:real^3`; `p:real^3->bool`] THEN + GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN + REWRITE_TAC[INSERT_SUBSET; IN_ELIM_THM; IMP_CONJ; RIGHT_FORALL_IMP_THM; + EMPTY_SUBSET] THEN + SIMP_TAC[AZIM_DIHV_EQ_0; AZIM_DIHV_EQ_PI] THEN + REWRITE_TAC[DIHV] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + DISCH_THEN(K ALL_TAC) THEN PAD2D3D_TAC THEN + REWRITE_TAC[angle; VECTOR_SUB_RZERO] THEN + GEOM_ORIGIN_TAC `v0:real^2` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) COLLINEAR_VECTOR_ANGLE o snd) THEN + ANTS_TAC THENL + [REPEAT(POP_ASSUM MP_TAC); DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN + REWRITE_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; VEC_COMPONENT; + VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + CONV_TAC REAL_RING);; + +let DIHV_EQ_0_PI_EQ_COPLANAR = prove + (`!v0 v1 w1 w2:real^3. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> (dihV v0 v1 w1 w2 = &0 \/ dihV v0 v1 w1 w2 = pi <=> + coplanar {v0,v1,w1,w2})`, + SIMP_TAC[GSYM AZIM_DIHV_EQ_0; GSYM AZIM_DIHV_EQ_PI; + AZIM_EQ_0_PI_EQ_COPLANAR]);; + +let DIHV_SYM = prove + (`!v0 v1 v2 v3:real^N. + dihV v0 v1 v3 v2 = dihV v0 v1 v2 v3`, + REPEAT GEN_TAC THEN REWRITE_TAC[DIHV] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[DOT_SYM; ANGLE_SYM]);; + +let DIHV_NEG = prove + (`!v0 v1 v2 v3. dihV (--v0) (--v1) (--v2) (--v3) = dihV v0 v1 v2 v3`, + REWRITE_TAC[DIHV; VECTOR_ARITH `--a - --b:real^N = --(a - b)`] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[DOT_RNEG; DOT_LNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[VECTOR_MUL_RNEG] THEN + REWRITE_TAC[angle; VECTOR_ARITH `--a - --b:real^N = --(a - b)`] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ANGLE_NEG2]);; + +let DIHV_NEG_0 = prove + (`!v1 v2 v3. dihV (vec 0) (--v1) (--v2) (--v3) = dihV (vec 0) v1 v2 v3`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM DIHV_NEG] THEN + REWRITE_TAC[VECTOR_NEG_0]);; + +let DIHV_ARCV = prove + (`!e u v w:real^N. + orthogonal (e - u) (v - u) /\ orthogonal (e - u) (w - u) /\ ~(e = u) + ==> dihV u e v w = arcV u v w`, + GEOM_ORIGIN_TAC `u:real^N` THEN + REWRITE_TAC[dihV; orthogonal; VECTOR_SUB_RZERO] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + SIMP_TAC[DOT_SYM; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_ANGLE_LMUL; VECTOR_ANGLE_RMUL] THEN + SIMP_TAC[DOT_POS_LE; DOT_EQ_0]);; + +let AZIM_DIHV_SAME_STRONG = prove + (`!v w v1 v2:real^3. + ~collinear {v,w,v1} /\ ~collinear {v,w,v2} /\ + azim v w v1 v2 <= pi + ==> azim v w v1 v2 = dihV v w v1 v2`, + REWRITE_TAC[REAL_LE_LT] THEN + MESON_TAC[AZIM_DIHV_SAME; AZIM_DIHV_EQ_PI]);; + +let AZIM_ARCV = prove + (`!e u v w:real^3. + orthogonal (e - u) (v - u) /\ orthogonal (e - u) (w - u) /\ + ~collinear{u,e,v} /\ ~collinear{u,e,w} /\ + azim u e v w <= pi + ==> azim u e v w = arcV u v w`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^3 = e` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + STRIP_TAC THEN ASM_SIMP_TAC[GSYM DIHV_ARCV] THEN + MATCH_MP_TAC AZIM_DIHV_SAME_STRONG THEN ASM_REWRITE_TAC[]);; + +let COLLINEAR_AZIM_0_OR_PI = prove + (`!u e v w. collinear {u,v,w} ==> azim u e v w = &0 \/ azim u e v w = pi`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `collinear{u:real^3,e,v}` THEN + ASM_SIMP_TAC[AZIM_DEGENERATE] THEN + ASM_CASES_TAC `collinear{u:real^3,e,w}` THEN + ASM_SIMP_TAC[AZIM_DEGENERATE] THEN + ASM_SIMP_TAC[AZIM_EQ_0_PI_EQ_COPLANAR] THEN + ONCE_REWRITE_TAC[SET_RULE `{u,e,v,w} = {u,v,w,e}`] THEN + ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR]);; + +let REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE = prove + (`!f:real^M->real^N g h k x s. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + f continuous (at x within s) /\ g continuous (at x within s) /\ + h continuous (at x within s) /\ k continuous (at x within s) + ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (at x within s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dihV] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[ARCV_ANGLE; angle; REAL_CONTINUOUS_CONTINUOUS; o_DEF] THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC CONTINUOUS_WITHIN_CX_VECTOR_ANGLE_COMPOSE THEN + ASM_REWRITE_TAC[VECTOR_SUB_EQ; GSYM COLLINEAR_3_DOT_MULTIPLES] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN + ASM_SIMP_TAC[CONTINUOUS_LIFT_DOT2; o_DEF; CONTINUOUS_SUB]);; + +let REAL_CONTINUOUS_AT_DIHV_COMPOSE = prove + (`!f:real^M->real^N g h k x. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + f continuous (at x) /\ g continuous (at x) /\ + h continuous (at x) /\ k continuous (at x) + ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE]);; + +let REAL_CONTINUOUS_WITHINREAL_DIHV_COMPOSE = prove + (`!f:real->real^N g h k x s. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + f continuous (atreal x within s) /\ g continuous (atreal x within s) /\ + h continuous (atreal x within s) /\ k continuous (atreal x within s) + ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous + (atreal x within s)`, + REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL; + REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL] THEN + SIMP_TAC[o_DEF; REAL_CONTINUOUS_WITHIN_DIHV_COMPOSE; LIFT_DROP]);; + +let REAL_CONTINUOUS_ATREAL_DIHV_COMPOSE = prove + (`!f:real->real^N g h k x. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + f continuous (atreal x) /\ g continuous (atreal x) /\ + h continuous (atreal x) /\ k continuous (atreal x) + ==> (\x. dihV (f x) (g x) (h x) (k x)) real_continuous (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL_DIHV_COMPOSE]);; + +let REAL_CONTINUOUS_AT_DIHV = prove + (`!v w w1 w2:real^N. + ~collinear {v, w, w2} ==> dihV v w w1 real_continuous at w2`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[dihV] THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN + SIMP_TAC[CONTINUOUS_CONST; o_DEF; CONTINUOUS_SUB; CONTINUOUS_AT_ID; + CONTINUOUS_LIFT_DOT2]; + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[ARCV_ANGLE; angle] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; ETA_AX] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_VECTOR_ANGLE THEN + POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `v:real^N` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; CONTRAPOS_THM; VECTOR_SUB_EQ] THEN + MAP_EVERY X_GEN_TAC [`z:real^N`; `w:real^N`] THEN + ASM_CASES_TAC `w:real^N = vec 0` THEN + ASM_REWRITE_TAC[COLLINEAR_LEMMA_ALT] THEN DISCH_THEN(MP_TAC o AP_TERM + `(%) (inv((w:real^N) dot w)):real^N->real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; DOT_EQ_0] THEN + MESON_TAC[VECTOR_MUL_LID]]);; + +let REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE = prove + (`!f:real^M->real^3 g h k x s. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + ~(k x IN aff_ge {f x,g x} {h x}) /\ + f continuous (at x within s) /\ g continuous (at x within s) /\ + h continuous (at x within s) /\ k continuous (at x within s) + ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (at x within s)`, + let lemma = prove + (`!s t u f:real^M->real^N g h. + (closed s /\ closed t) /\ s UNION t = UNIV /\ + (g continuous_on (u INTER s) /\ h continuous_on (u INTER t)) /\ + (!x. x IN u INTER s ==> g x = f x) /\ + (!x. x IN u INTER t ==> h x = f x) + ==> f continuous_on u`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `u:real^M->bool = (u INTER s) UNION (u INTER t)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `s:real^M->bool` THEN ASM SET_TAC[]; + EXISTS_TAC `t:real^M->bool` THEN ASM SET_TAC[]; + ASM_MESON_TAC[CONTINUOUS_ON_EQ]; + ASM_MESON_TAC[CONTINUOUS_ON_EQ]]) in + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; o_DEF] THEN + SUBGOAL_THEN + `(\x:real^M. Cx(azim (f x) (g x) (h x) (k x))) = + (\z. Cx(azim (vec 0) (fstcart z) + (fstcart(sndcart z)) (sndcart(sndcart z)))) o + (\x. pastecart (g x - f x) (pastecart (h x - f x) (k x - f x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + X_GEN_TAC `y:real^M` THEN + SUBST1_TAC(VECTOR_ARITH `vec 0 = (f:real^M->real^3) y - f y`) THEN + SIMP_TAC[ONCE_REWRITE_RULE[VECTOR_ADD_SYM] AZIM_TRANSLATION; VECTOR_SUB]; + MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_PASTECART; CONTINUOUS_SUB]] THEN + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + SUBGOAL_THEN + `!z. ~collinear {vec 0,fstcart z,fstcart(sndcart z)} /\ + ~collinear {vec 0,fstcart z,sndcart(sndcart z)} /\ + ~(sndcart(sndcart z) IN aff_ge {vec 0,fstcart z} {fstcart(sndcart z)}) + ==> (\z. Cx(azim (vec 0) (fstcart z) (fstcart(sndcart z)) + (sndcart(sndcart z)))) + continuous (at z)` + MATCH_MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; GSYM COLLINEAR_3] THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[INSERT_AC]; ALL_TAC]) THEN + SUBST1_TAC(VECTOR_ARITH `vec 0 = (f:real^M->real^3) x - f x`) THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN + REWRITE_TAC[GSYM IMAGE_UNION; SET_RULE + `{a - b:real^3} = IMAGE (\x. x - b) {a}`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[VECTOR_ADD_SYM] AFF_GE_TRANSLATION; + VECTOR_SUB] THEN + ASM_REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `a + x:real^3 = b + x <=> a = b`; + UNWIND_THM1; SET_RULE `{a} UNION {b} = {a,b}`]] THEN + ONCE_REWRITE_TAC[SET_RULE + `(!x. ~P x /\ ~Q x /\ ~R x ==> J x) <=> + (!x. x IN UNIV DIFF (({x | P x} UNION {x | Q x}) UNION {x | R x}) + ==> J x)`] THEN + MATCH_MP_TAC(MESON[CONTINUOUS_ON_EQ_CONTINUOUS_AT] + `open s /\ f continuous_on s ==> !z. z IN s ==> f continuous at z`) THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM closed] THEN + MATCH_MP_TAC(MESON[] + `!t'. s UNION t = s UNION t' /\ closed(s UNION t') + ==> closed(s UNION t)`) THEN + EXISTS_TAC + `{z | (fstcart z cross fstcart(sndcart z)) cross + fstcart z cross sndcart(sndcart z) = vec 0 /\ + &0 <= (fstcart z cross sndcart(sndcart z)) dot + (fstcart z cross fstcart(sndcart z))}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. ~(x IN s) ==> (x IN t <=> x IN t')) + ==> s UNION t = s UNION t'`) THEN + REWRITE_TAC[AFF_GE_2_1_0_SEMIALGEBRAIC; IN_UNION; IN_ELIM_THM; + DE_MORGAN_THM]; + ALL_TAC] THEN + MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + SIMP_TAC[SET_RULE `{x | f x = a} = {x | x IN UNIV /\ f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + SIMP_TAC[CLOSED_UNIV; CLOSED_SING; LIFT_SUB; REAL_POW_2; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN CONJ_TAC; + ONCE_REWRITE_TAC[MESON[LIFT_DROP; real_ge] + `&0 <= x <=> drop(lift x) >= &0`] THEN + REWRITE_TAC[SET_RULE + `{z | f z = vec 0 /\ drop(g z) >= &0} = + {z | z IN UNIV /\ f z IN {vec 0}} INTER + {z | z IN UNIV /\ g z IN {k | drop(k) >= &0}}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + REWRITE_TAC[CLOSED_SING; drop; CLOSED_UNIV; + CLOSED_HALFSPACE_COMPONENT_GE] THEN + REPEAT((MATCH_MP_TAC CONTINUOUS_ON_CROSS ORELSE + MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2) THEN CONJ_TAC)] THEN + TRY(GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF]) THEN + SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART]; + MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC + [`{z | z IN UNIV /\ lift((fstcart z cross (fstcart(sndcart z))) dot + (sndcart(sndcart z))) IN {x | x$1 >= &0}}`; + `{z | z IN UNIV /\ lift((fstcart z cross (fstcart(sndcart z))) dot + (sndcart(sndcart z))) IN {x | x$1 <= &0}}`; + `\z. Cx(dihV (vec 0:real^3) (fstcart z) + (fstcart(sndcart z)) (sndcart(sndcart z)))`; + `\z. Cx(&2 * pi - dihV (vec 0:real^3) (fstcart z) + (fstcart(sndcart z)) (sndcart(sndcart z)))`] THEN + CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + REWRITE_TAC[CLOSED_UNIV; CLOSED_HALFSPACE_COMPONENT_GE; + CLOSED_HALFSPACE_COMPONENT_LE] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN + (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_CROSS; ALL_TAC]) THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[FORALL_PASTECART; IN_DIFF; IN_UNIV; IN_UNION; IN_INTER; + FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; DE_MORGAN_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CX_SUB] THEN + TRY(MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST]) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_DIHV_COMPOSE THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; + CONTINUOUS_CONST] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + SIMP_TAC[CONTINUOUS_AT_COMPOSE; LINEAR_CONTINUOUS_AT; + LINEAR_FSTCART; LINEAR_SNDCART]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_PASTECART; IN_DIFF; IN_UNIV; IN_UNION; IN_INTER; CX_INJ; + FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM; DE_MORGAN_THM] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM drop; LIFT_DROP; real_ge] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM AZIM_DIHV_SAME_STRONG) THEN + ASM_REWRITE_TAC[AZIM_IN_UPPER_HALFSPACE; VECTOR_SUB_RZERO]; + REWRITE_TAC[GSYM drop; LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`x:real^3`; `y:real^3`; `z:real^3`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM AZIM_DIHV_COMPL) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `(x <= pi ==> x = pi) ==> pi <= x`) THEN + ASM_REWRITE_TAC[AZIM_IN_UPPER_HALFSPACE; VECTOR_SUB_RZERO] THEN + ASM_SIMP_TAC[REAL_ARITH `x <= &0 ==> (&0 <= x <=> x = &0)`] THEN + REWRITE_TAC[REWRITE_RULE[VECTOR_SUB_RZERO] + (SPEC `vec 0:real^3` (GSYM COPLANAR_CROSS_DOT))] THEN + ASM_SIMP_TAC[GSYM AZIM_EQ_0_PI_EQ_COPLANAR; AZIM_EQ_0_GE_ALT]]]);; + +let REAL_CONTINUOUS_AT_AZIM_COMPOSE = prove + (`!f:real^M->real^3 g h k x. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + ~(k x IN aff_ge {f x,g x} {h x}) /\ + f continuous (at x) /\ g continuous (at x) /\ + h continuous (at x) /\ k continuous (at x) + ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE]);; + +let REAL_CONTINUOUS_WITHINREAL_AZIM_COMPOSE = prove + (`!f:real->real^3 g h k x s. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + ~(k x IN aff_ge {f x,g x} {h x}) /\ + f continuous (atreal x within s) /\ g continuous (atreal x within s) /\ + h continuous (atreal x within s) /\ k continuous (atreal x within s) + ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous + (atreal x within s)`, + REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL; + REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL] THEN + SIMP_TAC[o_DEF; REAL_CONTINUOUS_WITHIN_AZIM_COMPOSE; LIFT_DROP]);; + +let REAL_CONTINUOUS_ATREAL_AZIM_COMPOSE = prove + (`!f:real->real^3 g h k x. + ~collinear {f x,g x,h x} /\ ~collinear {f x,g x,k x} /\ + ~(k x IN aff_ge {f x,g x} {h x}) /\ + f continuous (atreal x) /\ g continuous (atreal x) /\ + h continuous (atreal x) /\ k continuous (atreal x) + ==> (\x. azim (f x) (g x) (h x) (k x)) real_continuous (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL_AZIM_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Can consider angle as defined by arcV a zenith angle. *) +(* ------------------------------------------------------------------------- *) + +let ZENITH_EXISTS = prove + (`!u v w:real^3. + ~(u = v) /\ ~(w = v) + ==> (?u' r phi e3. + phi = arcV v u w /\ + r = dist(u,v) /\ + dist(w,v) % e3 = w - v /\ + u' dot e3 = &0 /\ + u = v + u' + (r * cos phi) % e3)`, + ONCE_REWRITE_TAC[VECTOR_ARITH + `u:real^3 = v + u' + x <=> u - v = u' + x`] THEN + GEN_GEOM_ORIGIN_TAC `v:real^3` ["u'"; "e3"] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `u:real^3 = u' + x <=> u - u' = x`] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_3; ARITH] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> abs w * &1 = w`] THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`u:real^3`; `w % basis 3:real^3`] VECTOR_ANGLE) THEN + REWRITE_TAC[DOT_RMUL; NORM_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 < w ==> n * ((abs w) * x) * y = w * n * x * y`] THEN + ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN + SIMP_TAC[NORM_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ARITH `u - u':real^3 = x <=> u' = u - x`] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN + SIMP_TAC[DOT_BASIS_BASIS; DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Spherical coordinates. *) +(* ------------------------------------------------------------------------- *) + +let SPHERICAL_COORDINATES = prove + (`!u v w u' e1 e2 e3 r phi theta. + ~collinear {v, w, u} /\ + ~collinear {v, w, u'} /\ + orthonormal e1 e2 e3 /\ + dist(w,v) % e3 = w - v /\ + (v + e1) IN aff_gt {v, w} {u} /\ + r = dist(v,u') /\ + phi = arcV v u' w /\ + theta = azim v w u u' + ==> u' = v + (r * cos theta * sin phi) % e1 + + (r * sin theta * sin phi) % e2 + + (r * cos phi) % e3`, + ONCE_REWRITE_TAC[VECTOR_ARITH + `u':real^3 = u + v + w <=> u' - u = v + w`] THEN + GEN_GEOM_ORIGIN_TAC `v:real^3` ["e1"; "e2"; "e3"] THEN + REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ADD_LID] THEN + REWRITE_TAC[TRANSLATION_INVARIANTS `v:real^3`] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC + [`u:real^3`; `v:real^3`; `e1:real^3`; `e2:real^3`; `e3:real^3`; + `r:real`; `phi:real`; `theta:real`] THEN + ASM_CASES_TAC `u:real^3 = w % basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `v:real^3 = w % basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o GSYM) THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_3; ARITH] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < w ==> abs w * &1 = w`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN + ASM_CASES_TAC `e3:real^3 = basis 3` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARCV_ANGLE; angle; VECTOR_SUB_RZERO] THEN + ASM_SIMP_TAC[VECTOR_ANGLE_RMUL; REAL_LT_IMP_LE] THEN + ASM_CASES_TAC `u:real^3 = vec 0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `v:real^3 = vec 0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `u:real^3 = basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `v:real^3 = basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`v:real^3`; `basis 3:real^3`] VECTOR_ANGLE) THEN + ASM_SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN + DISCH_TAC THEN + MP_TAC(ISPECL + [`vec 0:real^3`; `w % basis 3:real^3`; `u:real^3`; `e1:real^3`] + AZIM_EQ_0_ALT) THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN + ANTS_TAC THENL + [SIMP_TAC[COLLINEAR_LEMMA; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN + STRIP_TAC THEN UNDISCH_TAC `orthonormal e1 e2 (basis 3)` THEN + ASM_REWRITE_TAC[orthonormal; DOT_LZERO; REAL_OF_NUM_EQ; ARITH_EQ] THEN + ASM_CASES_TAC `c = &0` THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; CROSS_LZERO; DOT_LZERO; REAL_LT_REFL; + DOT_LMUL; DOT_BASIS_BASIS; DIMINDEX_3; ARITH; REAL_MUL_RID]; + DISCH_TAC] THEN + SUBGOAL_THEN + `dropout 3 (v:real^3):real^2 = + norm(dropout 3 (v:real^3):real^2) % + (cos theta % (dropout 3 (e1:real^3)) + + sin theta % (dropout 3 (e2:real^3)))` + MP_TAC THENL + [ALL_TAC; + SUBGOAL_THEN `norm((dropout 3:real^3->real^2) v) = r * sin phi` + SUBST1_TAC THENL + [REWRITE_TAC[NORM_EQ_SQUARE] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_MUL; NORM_POS_LE; SIN_VECTOR_ANGLE_POS]; + ALL_TAC] THEN + UNDISCH_TAC `(v:real^3)$3 = r * cos phi` THEN + MATCH_MP_TAC(REAL_RING + `x + a pow 2 = y + b pow 2 ==> a:real = b ==> x = y`) THEN + REWRITE_TAC[REAL_POW_MUL; GSYM REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[SIN_CIRCLE; REAL_MUL_RID] THEN + UNDISCH_THEN `norm(v:real^3) = r` (SUBST1_TAC o SYM) THEN + REWRITE_TAC[NORM_POW_2; DOT_2; DOT_3] THEN + SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; DIMINDEX_2; FORALL_3; FORALL_2] THEN + SIMP_TAC[dropout; LAMBDA_BETA; DIMINDEX_2; ARITH; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_3] THEN + REPEAT STRIP_TAC THEN TRY REAL_ARITH_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthonormal]) THEN + SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH] THEN CONV_TAC REAL_RING] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE LAND_CONV [AZIM_ARG])) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3])) THEN + SUBGOAL_THEN `norm((dropout 3:real^3->real^2) e1) = &1 /\ + norm((dropout 3:real^3->real^2) e2) = &1 /\ + dropout 3 (e2:real^3) / dropout 3 (e1:real^3) = ii` + MP_TAC THENL + [MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + CONJ_TAC THENL + [REWRITE_TAC[NORM_EQ_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [orthonormal]) THEN + SIMP_TAC[DOT_BASIS; DIMINDEX_3; ARITH; dropout; LAMBDA_BETA; + DOT_2; DIMINDEX_2; DOT_3] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + ASM_CASES_TAC `dropout 3 (e1:real^3) = Cx(&0)` THEN + ASM_SIMP_TAC[COMPLEX_NORM_CX; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = Cx(&0)) ==> (y / x = ii <=> y = ii * x)`] THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_CROSS) THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; + cross; VECTOR_3; BASIS_COMPONENT; ARITH; dropout; LAMBDA_BETA; + complex_mul; ii; complex; RE_DEF; IM_DEF; VECTOR_2] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + SPEC_TAC(`(dropout 3:real^3->real^2) e2`,`d2:real^2`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) e1`,`d1:real^2`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) v`,`z:real^2`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) u`,`w:real^2`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + GEOM_BASIS_MULTIPLE_TAC 1 `w:real^2` THEN + X_GEN_TAC `k:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `k = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `d1 = Cx(&1)` THENL + [ASM_SIMP_TAC[COMPLEX_DIV_1; COMPLEX_MUL_LID] THEN + REPEAT STRIP_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN + ASM_REWRITE_TAC[CEXP_EULER; CX_SIN; CX_COS; COMPLEX_MUL_RID] THEN + CONV_TAC COMPLEX_RING; + ASM_REWRITE_TAC[ARG_EQ_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COMPLEX_EQ]) THEN + REWRITE_TAC[RE_CX; IM_CX;real] THEN + ASM_CASES_TAC `Im d1 = &0` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_NORM; real] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of a wedge and invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let wedge = new_definition + `wedge v0 v1 w1 w2 = {y | ~collinear {v0,v1,y} /\ + &0 < azim v0 v1 w1 y /\ + azim v0 v1 w1 y < azim v0 v1 w1 w2}`;; + +let WEDGE_ALT = prove + (`!v0 v1 w1 w2. + ~(v0 = v1) + ==> wedge v0 v1 w1 w2 = {y | ~(y IN affine hull {v0,v1}) /\ + &0 < azim v0 v1 w1 y /\ + azim v0 v1 w1 y < azim v0 v1 w1 w2}`, + SIMP_TAC[wedge; COLLINEAR_3_AFFINE_HULL]);; + +let WEDGE_TRANSLATION = prove + (`!a v w w1 w2. wedge (a + v) (a + w) (a + w1) (a + w2) = + IMAGE (\x. a + x) (wedge v w w1 w2)`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL + [MESON_TAC[VECTOR_ARITH `a + (x - a):real^3 = x`]; ALL_TAC] THEN + REWRITE_TAC[wedge; IN_ELIM_THM; AZIM_TRANSLATION] THEN + REWRITE_TAC[SET_RULE + `{a + x,a + y,a + z} = IMAGE (\x:real^N. a + x) {x,y,z}`] THEN + REWRITE_TAC[COLLINEAR_TRANSLATION_EQ]);; + +add_translation_invariants [WEDGE_TRANSLATION];; + +let WEDGE_LINEAR_IMAGE = prove + (`!f. linear f /\ (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:3) ==> det(matrix f) = &1) + ==> !v w w1 w2. wedge (f v) (f w) (f w1) (f w2) = + IMAGE f (wedge v w w1 w2)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; + ORTHOGONAL_TRANSFORMATION]; + ALL_TAC] THEN + X_GEN_TAC `y:real^3` THEN REWRITE_TAC[wedge; IN_ELIM_THM] THEN + BINOP_TAC THEN ASM_SIMP_TAC[AZIM_LINEAR_IMAGE] THEN + SUBST1_TAC(SET_RULE `{f v,f w,f y} = IMAGE (f:real^3->real^3) {v,w,y}`) THEN + ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ; PRESERVES_NORM_INJECTIVE]);; + +add_linear_invariants [WEDGE_LINEAR_IMAGE];; + +let WEDGE_SPECIAL_SCALE = prove + (`!a v w1 w2. + &0 < a /\ + ~collinear{vec 0,a % v,w1} /\ + ~collinear{vec 0,a % v,w2} + ==> wedge (vec 0) (a % v) w1 w2 = wedge (vec 0) v w1 w2`, + SIMP_TAC[wedge; AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; + REAL_LT_IMP_NZ]);; + +let WEDGE_DEGENERATE = prove + (`(!z w w1 w2. z = w ==> wedge z w w1 w2 = {}) /\ + (!z w w1 w2. collinear{z,w,w1} ==> wedge z w w1 w2 = {}) /\ + (!z w w1 w2. collinear{z,w,w2} ==> wedge z w w1 w2 = {})`, + REWRITE_TAC[wedge] THEN SIMP_TAC[AZIM_DEGENERATE] THEN + REWRITE_TAC[REAL_LT_REFL; REAL_LT_ANTISYM; EMPTY_GSPEC]);; + +(* ------------------------------------------------------------------------- *) +(* Basic relation between wedge and aff, so Tarski-type characterization. *) +(* ------------------------------------------------------------------------- *) + +let AFF_GT_LEMMA = prove + (`!v1 v2:real^N. + &0 < t1 /\ ~(v2 = vec 0) + ==> aff_gt {vec 0} {t1 % basis 1, v2} = + {a % basis 1 + b % v2 | &0 < a /\ &0 < b}`, + REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE `{a} UNION {b,c} = {a,b,c}`] THEN + REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_INSERT; VECTOR_ARITH `vec 0 = a % x <=> a % x = vec 0`] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; BASIS_NONZERO; + DIMINDEX_GE_1; LE_REFL] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `&1 - v - v' - v'' = &0 <=> v = &1 - v' - v''`] THEN + ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `b:real` THEN + REWRITE_TAC[VECTOR_ARITH `y - a - b:real^N = vec 0 <=> y = a + b`] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `a * t1:real`; EXISTS_TAC `a / t1:real`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]);; + +let WEDGE_LUNE_GT = prove + (`!v0 v1 w1 w2. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} /\ + &0 < azim v0 v1 w1 w2 /\ azim v0 v1 w1 w2 < pi + ==> wedge v0 v1 w1 w2 = aff_gt {v0,v1} {w1,w2}`, + let lemma = prove + (`!a x:real^3. (?a. x = a % basis 3) <=> dropout 3 x:real^2 = vec 0`, + SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; + dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1] THEN + MESON_TAC[]) in + REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `v0:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`w1:real^3`; `w2:real^3`] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN + ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN STRIP_TAC THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o snd) THEN + SUBGOAL_THEN + `~(w1:real^3 = vec 0) /\ ~(w2:real^3 = vec 0) /\ + ~(w1 = basis 3) /\ ~(w2 = basis 3)` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN + ASM_REWRITE_TAC[DROPOUT_BASIS_3; DROPOUT_0; DROPOUT_MUL; VECTOR_MUL_RZERO]; + ALL_TAC] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(DISJ_CASES_THEN (SUBST_ALL_TAC o SYM)) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_neg o concl))) THEN + ASM_REWRITE_TAC[DROPOUT_BASIS_3; DROPOUT_0; DROPOUT_MUL; VECTOR_MUL_RZERO]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE `{a,b} UNION {c,d} = {a,b,d,c}`] THEN + REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `{y | (dropout 3:real^3->real^2) y IN + aff_gt {vec 0} + {dropout 3 (w1:real^3),dropout 3 (w2:real^3)}}` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE `{a} UNION {b,c} = {a,b,c}`] THEN + REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[REAL_EQ_SUB_RADD; RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `&1 = x + v <=> v = &1 - x`] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ d /\ a /\ b`] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c d. P a b c d) <=> (?b c d a. P a b c d)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[VECTOR_ARITH + `y - a - b - c:real^N = vec 0 <=> y - b - c = a`] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; lemma] THEN + REWRITE_TAC[DROPOUT_SUB; DROPOUT_MUL] THEN + REWRITE_TAC[VECTOR_ARITH `y - a - b:real^2 = vec 0 <=> y = a + b`] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]] THEN + MATCH_MP_TAC(SET_RULE + `{x | P x} = s ==> {y | P(dropout 3 y)} = {y | dropout 3 y IN s}`) THEN + MP_TAC(CONJ (ASSUME `~((dropout 3:real^3->real^2) w1 = vec 0)`) + (ASSUME `~((dropout 3:real^3->real^2) w2 = vec 0)`)) THEN + UNDISCH_TAC `Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) < pi` THEN + UNDISCH_TAC `&0 < Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:complex`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:complex`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN + X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + SIMP_TAC[AFF_GT_LEMMA] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + ASM_SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID; CX_INJ] THEN DISCH_TAC THEN + POP_ASSUM_LIST(K ALL_TAC) THEN X_GEN_TAC `z:complex` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + MP_TAC(SPECL [`\t. Arg(Cx t + Cx(&1 - t) * z)`; + `&0`; `&1`; `Arg w`] REAL_IVT_DECREASING) THEN + REWRITE_TAC[REAL_POS; REAL_SUB_REFL; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO; COMPLEX_ADD_LID; COMPLEX_MUL_LID] THEN + ASM_SIMP_TAC[COMPLEX_ADD_RID; ARG_NUM; REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; IN_REAL_INTERVAL] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC CONTINUOUS_WITHINREAL_COMPOSE THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [SYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN + REWRITE_TAC[I_DEF; REAL_CONTINUOUS_WITHIN_ID]; + MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_CONST] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS] THEN + SIMP_TAC[REAL_CONTINUOUS_SUB; REAL_CONTINUOUS_CONST; + REAL_CONTINUOUS_WITHIN_ID]]; + MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN + EXISTS_TAC `{z | &0 <= Im z}` THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_UPPERHALF_ARG THEN + ASM_CASES_TAC `t = &1` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL] THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN + REWRITE_TAC[IM_ADD; IM_CX; IM_MUL_CX; REAL_ADD_LID; REAL_ENTIRE] THEN + ASM_REWRITE_TAC[REAL_SUB_0] THEN + ASM_MESON_TAC[ARG_LT_PI; REAL_LT_IMP_NZ; REAL_LT_TRANS]; + REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_REAL_INTERVAL] THEN + REWRITE_TAC[IN_ELIM_THM; IM_ADD; IM_CX; IM_MUL_CX] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_LID] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[GSYM ARG_LE_PI] THEN + ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` MP_TAC) THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[REAL_SUB_RZERO; COMPLEX_ADD_LID; COMPLEX_MUL_LID] THEN + ASM_MESON_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `t = &1` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_ADD_RID; ARG_NUM] THEN ASM_MESON_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_LE_LT] THEN + ASM_REWRITE_TAC[] THEN ABBREV_TAC `u = Cx t + Cx(&1 - t) * z` THEN + ASM_CASES_TAC `u = Cx(&0)` THENL + [ASM_MESON_TAC[ARG_0; REAL_LT_REFL]; ALL_TAC] THEN + STRIP_TAC THEN + EXISTS_TAC `norm(w:complex) / norm(u:complex) * t` THEN + EXISTS_TAC `norm(w:complex) / norm(u:complex) * (&1 - t)` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; COMPLEX_NORM_NZ; REAL_SUB_LT] THEN + SIMP_TAC[CX_MUL; GSYM COMPLEX_MUL_ASSOC; GSYM COMPLEX_ADD_LDISTRIB] THEN + ASM_REWRITE_TAC[CX_DIV] THEN + ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD + `~(nu = Cx(&0)) ==> (w = nw / nu * u <=> nu * w = nw * u)`] THEN + GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV) [ARG] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_AC]]; + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `Cx a + Cx b * z = complex(a + b * Re z,b * Im z)` + SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_EQ; RE; IM; RE_ADD; IM_ADD; RE_CX; IM_CX; + RE_MUL_CX; IM_MUL_CX] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_EQ; IM; IM_CX] THEN + SUBGOAL_THEN `&0 < Im z` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM ARG_LT_PI]; ALL_TAC] THEN + ASM_SIMP_TAC[ARG_ATAN_UPPERHALF; REAL_LT_MUL; REAL_LT_IMP_NZ; IM] THEN + REWRITE_TAC[RE; REAL_SUB_LT; ATN_BOUNDS] THEN + REWRITE_TAC[REAL_ARITH `pi / &2 - x < pi / &2 - y <=> y < x`] THEN + REWRITE_TAC[ATN_MONO_LT_EQ] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_MUL] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < z ==> w / z * b * z = b * w`] THEN + ASM_REAL_ARITH_TAC]);; + +let WEDGE_LUNE_GE = prove + (`!v0 v1 w1 w2. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} /\ + &0 < azim v0 v1 w1 w2 /\ azim v0 v1 w1 w2 < pi + ==> {x | &0 <= azim v0 v1 w1 x /\ + azim v0 v1 w1 x <= azim v0 v1 w1 w2} = + aff_ge {v0,v1} {w1,w2}`, + REPEAT GEN_TAC THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC] THEN NO_TAC; ALL_TAC]) + [`v1:real^3 = v0`; `w1:real^3 = v0`; `w2:real^3 = v0`; + `w1:real^3 = v1`; `w2:real^3 = v1`] THEN + ASM_CASES_TAC `w1:real^3 = w2` THEN + ASM_REWRITE_TAC[AZIM_REFL; REAL_LT_REFL] THEN + STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH + `&0 < a + ==> (&0 <= x /\ x <= a <=> x = &0 \/ x = a \/ &0 < x /\ x < a)`] THEN + MATCH_MP_TAC(SET_RULE + `!c. c SUBSET {x | p x} /\ c SUBSET s /\ + ({x | ~(~c x ==> ~p x)} UNION {x | ~(~c x ==> ~q x)} UNION + ({x | ~c x /\ r x} DIFF c) = s DIFF c) + ==> {x | p x \/ q x \/ r x} = s`) THEN + EXISTS_TAC `{x:real^3 | collinear {v0,v1,x}}` THEN + ASM_SIMP_TAC[IN_ELIM_THM; AZIM_EQ_ALT; AZIM_EQ_0_ALT; + GSYM wedge; WEDGE_LUNE_GT] THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; AZIM_DEGENERATE]; + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN + REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN + MATCH_MP_TAC AFFINE_HULL_SUBSET_AFF_GE THEN + ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; + ALL_TAC] THEN + REWRITE_TAC[NOT_IMP] THEN MATCH_MP_TAC(SET_RULE + `(!x. ~c x ==> (p x \/ q x \/ x IN t <=> x IN e)) + ==> {x | ~c x /\ p x} UNION {x | ~c x /\ q x} UNION (t DIFF {x | c x}) = + e DIFF {x | c x}`) THEN + X_GEN_TAC `y:real^3` THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o + rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[IN_UNION] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_2] THEN + ASM_SIMP_TAC[SET_RULE `~(w1 = w2) ==> {w1,w2} DELETE w1 = {w2}`; + SET_RULE `~(w1 = w2) ==> {w1,w2} DELETE w2 = {w1}`] THEN + REWRITE_TAC[IN_UNION; DISJ_ACI] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o lhand o + rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; + DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GE_AFF_GT_DECOMP o rand o lhand o + rand o rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[DISJOINT_INSERT; IN_INSERT; NOT_IN_EMPTY; DISJOINT_EMPTY]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[IN_UNION] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMAGE_CLAUSES; UNIONS_1] THEN + REWRITE_TAC[SET_RULE `{a} DELETE a = {}`; AFF_GE_EQ_AFFINE_HULL] THEN + ASM_MESON_TAC[COLLINEAR_3_AFFINE_HULL]);; + +let WEDGE_LUNE = prove + (`!v0 v1 w1 w2. + ~coplanar{v0,v1,w1,w2} /\ azim v0 v1 w1 w2 < pi + ==> wedge v0 v1 w1 w2 = aff_gt {v0,v1} {w1,w2}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WEDGE_LUNE_GT THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`] + NOT_COPLANAR_NOT_COLLINEAR) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w2:real^3`; `w1:real^3`] + NOT_COPLANAR_NOT_COLLINEAR) THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c,d} = {a,b,d,c}`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[azim; REAL_LT_LE] THEN + ASM_MESON_TAC[AZIM_EQ_0_PI_IMP_COPLANAR]]);; + +let WEDGE = prove + (`wedge v1 v2 w1 w2 = + if collinear{v1,v2,w1} \/ collinear{v1,v2,w2} then {} + else + let z = v2 - v1 in + let u1 = w1 - v1 in + let u2 = w2 - v1 in + let n = z cross u1 in + let d = n dot u2 in + if w2 IN (aff_ge {v1,v2} {w1}) then {} + else if w2 IN (aff_lt {v1,v2} {w1}) then aff_gt {v1,v2,w1} {v1 + n} + else if d > &0 then aff_gt {v1,v2} {w1,w2} + else (:real^3) DIFF aff_ge {v1,v2} {w1,w2}`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [FIRST_X_ASSUM DISJ_CASES_TAC THEN + ASM_SIMP_TAC[WEDGE_DEGENERATE]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC] THEN + ASM_SIMP_TAC[GSYM AZIM_EQ_0_GE_ALT] THEN + ASM_CASES_TAC `azim v1 v2 w1 w2 = &0` THENL + [ASM_REWRITE_TAC[wedge] THEN + ASM_REWRITE_TAC[REAL_LT_ANTISYM; LET_DEF; LET_END_DEF; EMPTY_GSPEC]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM AZIM_EQ_PI_ALT] THEN + ASM_CASES_TAC `azim v1 v2 w1 w2 = pi` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + GEOM_ORIGIN_TAC `v1:real^3` THEN + REWRITE_TAC[VECTOR_ADD_RID; TRANSLATION_INVARIANTS `v1:real^3`] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v2:real^3` THEN + X_GEN_TAC `v2:real` THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + (STRIP_TAC THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC]) THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ; + WEDGE_SPECIAL_SCALE] THEN + (REPEAT GEN_TAC THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC] THEN NO_TAC; ALL_TAC]) + [`w1:real^3 = vec 0`; `w2:real^3 = vec 0`; `w1:real^3 = basis 3`; + `w2:real^3 = basis 3`] THEN + ASM_CASES_TAC `w1:real^3 = v2 % basis 3` THENL + [ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `w2:real^3 = v2 % basis 3` THENL + [ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[]; ALL_TAC]) + THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real^3` THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `(dropout 3 (y:real^3)) IN + aff_gt {vec 0:real^2,dropout 3 (w1:real^3)} + {rotate2d (pi / &2) (dropout 3 (w1:real^3))}` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [AZIM_ARG]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o LAND_CONV) + [AZIM_ARG]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [COLLINEAR_BASIS_3])) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[wedge; IN_ELIM_THM; AZIM_ARG; COLLINEAR_BASIS_3] THEN + SPEC_TAC(`(dropout 3:real^3->real^2) y`,`x:real^2`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:real^2`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:real^2`) THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN + X_GEN_TAC `v:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `v = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN + REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EQ_LDIV_EQ; REAL_MUL_LZERO] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[ARG_LT_PI; ROTATE2D_PI2] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o rand o snd) THEN + ASM_REWRITE_TAC[DISJOINT_INSERT; DISJOINT_EMPTY; IN_SING] THEN + ANTS_TAC THENL + [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ] THEN + DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN + REWRITE_TAC[RE_MUL_II; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[COMPLEX_CMUL; IN_ELIM_THM; COMPLEX_MUL_RZERO] THEN + ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?b c a. P a b c)`] THEN + REWRITE_TAC[REAL_ARITH `t1 + t2 = &1 <=> t1 = &1 - t2`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; COMPLEX_ADD_LID] THEN + EQ_TAC THENL + [DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`Re x / v`; `Im x / v`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_EQ; IM_ADD; RE_ADD] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_II; IM_II] THEN + UNDISCH_TAC `~(v = &0)` THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real`; `t:real`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX; RE_II; IM_II] THEN + ASM_SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_LID; REAL_LT_MUL; REAL_ADD_LID; + REAL_MUL_LZERO] THEN + MAP_EVERY UNDISCH_TAC [`&0 < v`; `&0 < t`] THEN + CONV_TAC REAL_FIELD]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_3_1 o rand o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE + `DISJOINT {a,b,c} {x} <=> ~(x = a) /\ ~(x = b) /\ ~(x = c)`] THEN + ASM_SIMP_TAC[CROSS_EQ_0; CROSS_EQ_SELF; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; + REAL_LT_IMP_NZ; BASIS_NONZERO; DIMINDEX_3; + ARITH; COLLINEAR_SPECIAL_SCALE]; + DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_2_1 o rand o lhand o snd) THEN + REWRITE_TAC[ROTATE2D_PI2] THEN ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT {a,b} {x} <=> ~(x = a) /\ ~(x = b)`] THEN + REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_RING `ii * x = x <=> x = Cx(&0)`; + COMPLEX_VEC_0; II_NZ] THEN + ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; GSYM COLLINEAR_BASIS_3]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c d. P a b c d) <=> (?d c b a. P a b c d)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `s + t = &1 <=> s = &1 - t`] THEN + REWRITE_TAC[UNWIND_THM2; RIGHT_EXISTS_AND_THM] THEN + ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN + REWRITE_TAC[UNWIND_THM2; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + SIMP_TAC[CART_EQ; FORALL_2; FORALL_3; DIMINDEX_2; DIMINDEX_3; + dropout; LAMBDA_BETA; BASIS_COMPONENT; ARITH; REAL_MUL_RID; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RZERO; UNWIND_THM1; + VECTOR_ADD_COMPONENT; cross; VECTOR_3; + REWRITE_RULE[RE_DEF; IM_DEF] RE_MUL_II; + REWRITE_RULE[RE_DEF; IM_DEF] IM_MUL_II; + REAL_ADD_LID; REAL_MUL_LZERO; REAL_SUB_REFL; REAL_ADD_RID; + REAL_SUB_LZERO; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `s:real` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + ASM_SIMP_TAC[EXISTS_REFL; REAL_FIELD + `&0 < v ==> (x = a * v + b <=> a = (x - b) / v)`] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_ASSOC] THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `t / v2:real`; EXISTS_TAC `t * v2:real`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_DIV; REAL_LT_IMP_NZ; REAL_LT_MUL]; + ALL_TAC] THEN + REWRITE_TAC[CROSS_LMUL] THEN + SIMP_TAC[cross; BASIS_COMPONENT; DIMINDEX_3; ARITH; DOT_3; VECTOR_3; + VECTOR_MUL_COMPONENT; REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_NEG_0; + REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LID; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH + `(v * --x2) * y1 + (v * x1) * y2 > &0 <=> &0 < v * (x1 * y2 - x2 * y1)`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_SUB_LT] THEN + REWRITE_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN STRIP_TAC THEN + SUBGOAL_THEN + `w1$2 * w2$1 < w1$1 * w2$2 <=> + Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) < pi` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&0 < Im(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN + CONJ_TAC THENL + [REWRITE_TAC[IM_COMPLEX_DIV_GT_0] THEN + REWRITE_TAC[complex_mul; cnj; RE_DEF; IM_DEF; complex] THEN + SIMP_TAC[dropout; VECTOR_2; LAMBDA_BETA; DIMINDEX_3; ARITH; + DIMINDEX_2] THEN + REAL_ARITH_TAC; + REWRITE_TAC[GSYM ARG_LT_PI] THEN ASM_MESON_TAC[ARG_LT_NZ]]; + ALL_TAC] THEN + COND_CASES_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SPECIAL_SCALE o rand o snd) THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC WEDGE_LUNE THEN + ASM_SIMP_TAC[GSYM AZIM_EQ_0_PI_EQ_COPLANAR; COLLINEAR_BASIS_3] THEN + ASM_REWRITE_TAC[AZIM_ARG]; + ALL_TAC] THEN + REWRITE_TAC[wedge] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [SET_RULE `{a,b} = {b,a}`] THEN + W(MP_TAC o PART_MATCH (rand o rand) WEDGE_LUNE_GE o rand o rand o snd) THEN + ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; REAL_LT_IMP_NZ; AZIM_SPECIAL_SCALE] THEN + ASM_REWRITE_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[ARG_LT_NZ] THEN + ONCE_REWRITE_TAC[GSYM ARG_INV_EQ_0] THEN + ASM_REWRITE_TAC[COMPLEX_INV_DIV] THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + ASM_SIMP_TAC[ARG_INV; GSYM ARG_EQ_0] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM; ARG] THEN + REWRITE_TAC[REAL_NOT_LE] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`w:complex`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`z:complex`) THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `x3:real^3` THEN + SPEC_TAC(`(dropout 3:real^3->real^2) x3`,`x:complex`) THEN + GEN_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN + ASM_CASES_TAC `x = Cx(&0)` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; REAL_NOT_LT; ARG; ARG_0]; + ALL_TAC] THEN + ASM_REWRITE_TAC[ARG_LT_NZ] THEN + MAP_EVERY UNDISCH_TAC + [`~(Arg (z / w) < pi)`; + `~(Arg (z / w) = pi)`; + `~(Arg (z / w) = &0)`; + `~(x = Cx (&0))`; + `~(w = Cx (&0))`; + `~(z = Cx (&0))`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN + REWRITE_TAC[real; RE_DIV_CX; IM_DIV_CX; CX_INJ] THEN + SIMP_TAC[complex_div; ARG_MUL_CX] THEN + SIMP_TAC[ARG_INV; GSYM ARG_EQ_0; ARG_INV_EQ_0] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[GSYM complex_div] THEN + ASM_CASES_TAC `Arg x = &0` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ARG_EQ_0]) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[REAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[complex_div; CX_INJ] THEN + ASM_SIMP_TAC[ARG_MUL_CX; REAL_LT_LE] THEN + ASM_SIMP_TAC[ARG_INV; GSYM ARG_EQ_0]; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + SIMP_TAC[PI_POS; REAL_ARITH + `&0 < pi ==> (~(z = &0) /\ ~(z = pi) /\ ~(z < pi) <=> pi < z)`] THEN + STRIP_TAC THEN REWRITE_TAC[REAL_LT_SUB_RADD] THEN + DISJ_CASES_TAC(REAL_ARITH `Arg z <= Arg x \/ Arg x < Arg z`) THENL + [ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ASM_SIMP_TAC[GSYM ARG_LE_DIV_SUM] THEN + SIMP_TAC[ARG; REAL_LT_IMP_LE]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`x:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ ~(x = &0) /\ y = k - z ==> k < y + x + z`) THEN + ASM_REWRITE_TAC[ARG] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM COMPLEX_INV_DIV] THEN + MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[REAL] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ABBREV_TAC `t = Re(z / x)` THEN UNDISCH_TAC `Arg x < Arg z` THEN + UNDISCH_TAC `z / x = Cx t` THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(x = Cx(&0)) ==> (z / x = t <=> z = t * x)`] THEN + ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO] THEN + ASM_SIMP_TAC[ARG_MUL_CX; REAL_LT_LE]);; + +let OPEN_WEDGE = prove + (`!z:real^3 w w1 w2. open(wedge z w w1 w2)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `z:real^3 = w \/ collinear{z,w,w1} \/ collinear{z,w,w2}` THENL + [FIRST_X_ASSUM STRIP_ASSUME_TAC THEN + ASM_SIMP_TAC[WEDGE_DEGENERATE; OPEN_EMPTY]; + FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM]] THEN + REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `z:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN + ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN + MATCH_MP_TAC OPEN_DROPOUT_3 THEN + UNDISCH_TAC `~((dropout 3:real^3->real^2) w1 = vec 0)` THEN + UNDISCH_TAC `~((dropout 3:real^3->real^2) w2 = vec 0)` THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w2`,`v2:complex`) THEN + SPEC_TAC(`(dropout 3:real^3->real^2) w1`,`v1:complex`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN + X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE `{x | ~(x = a) /\ P x} = {x | P x} DIFF {a}`] THEN + MATCH_MP_TAC OPEN_DIFF THEN REWRITE_TAC[CLOSED_SING] THEN + MATCH_MP_TAC OPEN_ARG_LTT THEN + SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL; ARG]);; + +let ARG_EQ_SUBSET_HALFLINE = prove + (`!a. ?b. ~(b = vec 0) /\ {z | Arg z = a} SUBSET aff_ge {vec 0} {b}`, + GEN_TAC THEN ASM_CASES_TAC `{z | Arg z = a} SUBSET {vec 0}` THENL + [EXISTS_TAC `basis 1:real^2` THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_2; ARITH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN SIMP_TAC[SUBSET; IN_SING; ENDS_IN_HALFLINE]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s SUBSET {a}) ==> ?z. ~(a = z) /\ z IN s`)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:complex` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:complex` THEN + ASM_CASES_TAC `x:complex = vec 0` THEN ASM_REWRITE_TAC[ENDS_IN_HALFLINE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COMPLEX_VEC_0]) THEN ASM_SIMP_TAC[ARG_EQ] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[GSYM COMPLEX_CMUL] THEN + REWRITE_TAC[HALFLINE_EXPLICIT; IN_ELIM_THM; VECTOR_MUL_RZERO] THEN + MAP_EVERY EXISTS_TAC [`&1 - u`; `u:real`] THEN + ASM_SIMP_TAC[VECTOR_ADD_LID; REAL_LT_IMP_LE] THEN ASM_REAL_ARITH_TAC);; + +let ARG_DIV_EQ_SUBSET_HALFLINE = prove + (`!w a. ~(w = vec 0) + ==> ?b. ~(b = vec 0) /\ + {z | Arg(z / w) = a} SUBSET aff_ge {vec 0} {b}`, + REPEAT GEN_TAC THEN GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN + X_GEN_TAC `w:real` THEN ASM_CASES_TAC `w = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; REAL_LE_LT] THEN DISCH_TAC THEN + X_GEN_TAC `a:real` THEN DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[ARG_DIV_CX; COMPLEX_CMUL; COMPLEX_BASIS; GSYM CX_MUL; + REAL_MUL_RID; ARG_EQ_SUBSET_HALFLINE]);; + +let COPLANAR_AZIM_EQ = prove + (`!v0 v1 w1 a. + (collinear{v0,v1,w1} ==> ~(a = &0)) + ==> coplanar {z | azim v0 v1 w1 z = a}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `collinear{v0:real^3,v1,w1}` THENL + [ASM_SIMP_TAC[azim_def; EMPTY_GSPEC; COPLANAR_EMPTY]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN + GEOM_ORIGIN_TAC `v0:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + X_GEN_TAC `v1:real` THEN ASM_CASES_TAC `v1 = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LT; COLLINEAR_SPECIAL_SCALE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [COLLINEAR_BASIS_3]) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_THEN(X_CHOOSE_THEN `b:real^2` + STRIP_ASSUME_TAC o SPEC `a:real` o MATCH_MP ARG_DIV_EQ_SUBSET_HALFLINE) THEN + REWRITE_TAC[coplanar] THEN MAP_EVERY EXISTS_TAC + [`vec 0:real^3`; `pushin 3 (&0) (b:real^2):real^3`; `basis 3:real^3`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[AFFINE_HULL_3; HALFLINE; SUBSET; IN_ELIM_THM] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^3` THEN DISCH_TAC THEN + MP_TAC(SPEC `(dropout 3:real^3->real^2) x` th)) THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`&1 - v - (x:real^3)$3`; `v:real`; `(x:real^3)$3`] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; DIMINDEX_3; FORALL_2; FORALL_3; LAMBDA_BETA; + dropout; pushin; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; ARITH; + BASIS_COMPONENT] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Volume of a tetrahedron defined by conv0. *) +(* ------------------------------------------------------------------------- *) + +let delta_x = new_definition + `delta_x x1 x2 x3 x4 x5 x6 = + x1*x4*(--x1 + x2 + x3 -x4 + x5 + x6) + + x2*x5*(x1 - x2 + x3 + x4 -x5 + x6) + + x3*x6*(x1 + x2 - x3 + x4 + x5 - x6) + -x2*x3*x4 - x1*x3*x5 - x1*x2*x6 -x4*x5*x6:real`;; + +let VOLUME_OF_CLOSED_TETRAHEDRON = prove + (`!x1 x2 x3 x4:real^3. + measure(convex hull {x1,x2,x3,x4}) = + sqrt(delta_x (dist(x1,x2) pow 2) (dist(x1,x3) pow 2) (dist(x1,x4) pow 2) + (dist(x3,x4) pow 2) (dist(x2,x4) pow 2) (dist(x2,x3) pow 2)) + / &12`, + REPEAT GEN_TAC THEN REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + REWRITE_TAC[MEASURE_TETRAHEDRON] THEN + REWRITE_TAC[REAL_ARITH `x / &6 = y / &12 <=> y = &2 * x`] THEN + MATCH_MP_TAC SQRT_UNIQUE THEN + SIMP_TAC[REAL_LE_MUL; REAL_ABS_POS; REAL_POS] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_POW2_ABS; delta_x] THEN + REWRITE_TAC[dist; NORM_POW_2] THEN + SIMP_TAC[DOT_3; VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH] THEN + CONV_TAC REAL_RING);; + +let VOLUME_OF_TETRAHEDRON = prove + (`!v1 v2 v3 v4:real^3. + measure(conv0 {v1,v2,v3,v4}) = + let x12 = dist(v1,v2) pow 2 in + let x13 = dist(v1,v3) pow 2 in + let x14 = dist(v1,v4) pow 2 in + let x23 = dist(v2,v3) pow 2 in + let x24 = dist(v2,v4) pow 2 in + let x34 = dist(v3,v4) pow 2 in + sqrt(delta_x x12 x13 x14 x34 x24 x23)/(&12)`, + REPEAT GEN_TAC THEN CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + ASM_SIMP_TAC[GSYM VOLUME_OF_CLOSED_TETRAHEDRON] THEN + MATCH_MP_TAC MEASURE_CONV0_CONVEX_HULL THEN + SIMP_TAC[DIMINDEX_3; FINITE_INSERT; FINITE_EMPTY; CARD_CLAUSES] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Circle area. Should maybe extend WLOG tactics for such scaling. *) +(* ------------------------------------------------------------------------- *) + +let AREA_UNIT_CBALL = prove + (`measure(cball(vec 0:real^2,&1)) = pi`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE[`:1`,`:M`; `:2`,`:N`] FUBINI_SIMPLE_COMPACT) THEN + EXISTS_TAC `1` THEN + SIMP_TAC[DIMINDEX_1; DIMINDEX_2; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN + REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN + SUBGOAL_THEN `!t. abs(t) <= &1 <=> t IN real_interval[-- &1,&1]` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; BALL_1] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. &2 * sqrt(&1 - t pow 2)` THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN SIMP_TAC[IN_REAL_INTERVAL; MEASURE_INTERVAL] THEN + REWRITE_TAC[REAL_BOUNDS_LE; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN + DISCH_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) CONTENT_1 o rand o snd) THEN + REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[REAL_POW_ONE] THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> --x <= x`) THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; + REAL_ABS_NUM]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x. asn(x) + x * sqrt(&1 - x pow 2)`; + `\x. &2 * sqrt(&1 - x pow 2)`; + `-- &1`; `&1`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN + REWRITE_TAC[ASN_1; ASN_NEG_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SQRT_0; REAL_MUL_RZERO; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH `x / &2 - --(x / &2) = x`] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + SIMP_TAC[REAL_CONTINUOUS_ON_ASN; IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_POW; + REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SQRT THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - x <=> x <= &1 pow 2`] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM] THEN + REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LT] THEN REPEAT STRIP_TAC THEN + REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LID; REAL_POW_1; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_SUB_LZERO; REAL_MUL_RNEG; REAL_INV_MUL] THEN + ASM_REWRITE_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1] THEN + MATCH_MP_TAC(REAL_FIELD + `s pow 2 = &1 - x pow 2 /\ x pow 2 < &1 + ==> (inv s + x * --(&2 * x) * inv (&2) * inv s + s) = &2 * s`) THEN + ASM_SIMP_TAC[ABS_SQUARE_LT_1; SQRT_POW_2; REAL_SUB_LE; REAL_LT_IMP_LE]]);; + +let AREA_CBALL = prove + (`!z:real^2 r. &0 <= r ==> measure(cball(z,r)) = pi * r pow 2`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `r = &0` THENL + [ASM_SIMP_TAC[CBALL_SING; REAL_POW_2; REAL_MUL_RZERO] THEN + MATCH_MP_TAC MEASURE_UNIQUE THEN + REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_SING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`cball(vec 0:real^2,&1)`; `r:real`; `z:real^2`; `pi`] + HAS_MEASURE_AFFINITY) THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_CBALL; + AREA_UNIT_CBALL] THEN + ASM_REWRITE_TAC[real_abs; DIMINDEX_2] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_MUL_SYM] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_CBALL_0; IN_IMAGE] THEN REWRITE_TAC[IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH `dist(z,a + z) = norm a`; NORM_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `abs r * x <= r <=> abs r * x <= r * &1`] THEN + ASM_SIMP_TAC[real_abs; REAL_LE_LMUL; dist] THEN X_GEN_TAC `w:real^2` THEN + DISCH_TAC THEN EXISTS_TAC `inv(r) % (w - z):real^2` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV] THEN + CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN ASM_REWRITE_TAC[real_abs] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[]);; + +let AREA_BALL = prove + (`!z:real^2 r. &0 <= r ==> measure(ball(z,r)) = pi * r pow 2`, + SIMP_TAC[GSYM INTERIOR_CBALL; GSYM AREA_CBALL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN + SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; + +(* ------------------------------------------------------------------------- *) +(* Volume of a ball. *) +(* ------------------------------------------------------------------------- *) + +let VOLUME_CBALL = prove + (`!z:real^3 r. &0 <= r ==> measure(cball(z,r)) = &4 / &3 * pi * r pow 3`, + GEOM_ORIGIN_TAC `z:real^3` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_COMPACT) THEN + EXISTS_TAC `1` THEN + SIMP_TAC[DIMINDEX_2; DIMINDEX_3; ARITH; COMPACT_CBALL; SLICE_CBALL] THEN + REWRITE_TAC[VEC_COMPONENT; DROPOUT_0; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN + SUBGOAL_THEN `!t. abs(t) <= r <=> t IN real_interval[--r,r]` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN + SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; + SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\t. pi * (r pow 2 * t - &1 / &3 * t pow 3)`; + `\t. pi * (r pow 2 - t pow 2)`; + `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC REAL_RING]);; + +let VOLUME_BALL = prove + (`!z:real^3 r. &0 <= r ==> measure(ball(z,r)) = &4 / &3 * pi * r pow 3`, + SIMP_TAC[GSYM INTERIOR_CBALL; GSYM VOLUME_CBALL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_INTERIOR THEN + SIMP_TAC[BOUNDED_CBALL; NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; + +(* ------------------------------------------------------------------------- *) +(* Frustum. *) +(* ------------------------------------------------------------------------- *) + +let rconesgn = new_definition + `rconesgn sgn v w h = + {x:real^A | sgn ((x-v) dot (w-v)) (dist(x,v)*dist(w,v)*h)}`;; + +let rcone_gt = new_definition `rcone_gt = rconesgn ( > )`;; + +let rcone_ge = new_definition `rcone_ge = rconesgn ( >= )`;; + +let rcone_eq = new_definition `rcone_eq = rconesgn ( = )`;; + +let frustum = new_definition + `frustum v0 v1 h1 h2 a = + { y:real^N | rcone_gt v0 v1 a y /\ + let d = (y - v0) dot (v1 - v0) in + let n = norm(v1 - v0) in + (h1*n < d /\ d < h2*n)}`;; + +let frustt = new_definition `frustt v0 v1 h a = frustum v0 v1 (&0) h a`;; + +let FRUSTUM_DEGENERATE = prove + (`!v0 h1 h2 a. frustum v0 v0 h1 h2 a = {}`, + REWRITE_TAC[frustum; VECTOR_SUB_REFL; NORM_0; DOT_RZERO] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LT_REFL] THEN SET_TAC[]);; + +let CONVEX_RCONE_GT = prove + (`!v0 v1:real^N a. &0 <= a ==> convex(rcone_gt v0 v1 a)`, + REWRITE_TAC[rcone_gt; rconesgn] THEN + GEOM_ORIGIN_TAC `v0:real^N` THEN REPEAT GEN_TAC THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + REWRITE_TAC[CONVEX_ALT; IN_ELIM_THM; real_gt; DOT_LADD; DOT_LMUL] THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `t:real`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(&1 - t) * norm(x:real^N) * norm v1 * a + + t * norm(y:real^N) * norm(v1:real^N) * a` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) = a /\ norm(y) = b ==> norm(x + y) <= a + b`) THEN + REWRITE_TAC[NORM_MUL] THEN CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_CONVEX_BOUND2_LT THEN ASM_REAL_ARITH_TAC]);; + +let OPEN_RCONE_GT = prove + (`!v0 v1:real^N a. open(rcone_gt v0 v1 a)`, + REWRITE_TAC[rcone_gt; rconesgn] THEN + GEOM_ORIGIN_TAC `v0:real^N` THEN REPEAT GEN_TAC THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + MP_TAC(ISPECL [`\x:real^N. lift(x dot v1 - norm x * norm v1 * a)`; + `{x:real^1 | x$1 > &0}`] + CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT] THEN REWRITE_TAC[GSYM drop] THEN + REWRITE_TAC[IN_ELIM_THM; real_gt; REAL_SUB_LT; LIFT_DROP] THEN + DISCH_THEN MATCH_MP_TAC THEN GEN_TAC THEN REWRITE_TAC[LIFT_SUB] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_DOT] THEN + MATCH_MP_TAC CONTINUOUS_CMUL THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]);; + +let RCONE_GT_NEG = prove + (`!v0 v1:real^N a. + rcone_gt v0 v1 (--a) = + IMAGE (\x. &2 % v0 - x) ((:real^N) DIFF rcone_ge v0 v1 a)`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [MESON_TAC[VECTOR_ARITH `a - (a - b):real^N = b`]; + REWRITE_TAC[rcone_gt; rconesgn; rcone_ge; + IN_ELIM_THM; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[NORM_ARITH `dist(&2 % x - y,x) = dist(y,x)`] THEN + REWRITE_TAC[VECTOR_ARITH `&2 % v - x - v:real^N = --(x - v)`] THEN + REWRITE_TAC[DOT_LNEG] THEN REAL_ARITH_TAC]);; + +let VOLUME_FRUSTT_STRONG = prove + (`!v0 v1:real^3 h a. + &0 < a + ==> bounded(frustt v0 v1 h a) /\ + convex(frustt v0 v1 h a) /\ + measurable(frustt v0 v1 h a) /\ + measure(frustt v0 v1 h a) = + if v1 = v0 \/ &1 <= a \/ h < &0 then &0 + else pi * ((h / a) pow 2 - h pow 2) * h / &3`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[frustt; frustum; rcone_gt; rconesgn; IN_ELIM_THM] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v1:real^3` THEN + X_GEN_TAC `b:real` THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `&0 <= x ==> x = &0 \/ &0 < x`)) THEN + ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL; + MEASURABLE_EMPTY; MEASURE_EMPTY; EMPTY_GSPEC; VECTOR_MUL_LZERO; + BOUNDED_EMPTY; CONVEX_EMPTY] THEN + ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `!y:real^3. ~(norm(y) * norm(b % basis 1:real^3) * a + < y dot (b % basis 1))` + (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURABLE_EMPTY; + BOUNDED_EMPTY; CONVEX_EMPTY; MEASURE_EMPTY]) THEN + REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; + DIMINDEX_3; ARITH] THEN + REWRITE_TAC[REAL_ARITH + `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DOT_BASIS; DOT_RMUL; DIMINDEX_3; ARITH] THEN + ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; + REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[REAL_ARITH `(&0 * x < y /\ u < v) /\ &0 < y /\ y < h <=> + &0 < y /\ y < h /\ u < v`] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `ball(vec 0:real^3,h / a)` THEN + REWRITE_TAC[BOUNDED_BALL; IN_BALL_0; SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + X_GEN_TAC `x:real^3` THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] REAL_LTE_TRANS)) THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[SET_RULE `{x | P x /\ Q x /\ R x} = + {x | Q x} INTER {x | P x /\ R x}`] THEN + REWRITE_TAC[REAL_ARITH `&0 < y <=> y > &0`] THEN + MATCH_MP_TAC CONVEX_INTER THEN + REWRITE_TAC[CONVEX_HALFSPACE_COMPONENT_LT] THEN + MP_TAC(ISPECL [`vec 0:real^3`; `basis 1:real^3`; `a:real`] + CONVEX_RCONE_GT) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; rcone_gt; rconesgn] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[real_gt; REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO]; + ALL_TAC] THEN + STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_CONVEX_STRONG) THEN + EXISTS_TAC `1` THEN REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[SLICE_312; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; + VECTOR_3; DOT_3; GSYM DOT_2] THEN + SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN + ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. if &0 < t /\ t < h then pi * (inv(a pow 2) - &1) * t pow 2 + else &0` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; CONJ_ASSOC; + MEASURE_EMPTY; MEASURABLE_EMPTY] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `measure(ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t))` THEN + CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; SQRT_POS_LT; REAL_LT_MUL] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL]; + AP_TERM_TAC THEN REWRITE_TAC[IN_BALL_0; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE; REAL_LT_MUL; + REAL_POW_MUL; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN + COND_CASES_TAC THENL + [ASM_MESON_TAC[REAL_INTERVAL_EQ_EMPTY; HAS_REAL_INTEGRAL_EMPTY]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN + MP_TAC(ISPECL + [`\t. pi / &3 * (inv (a pow 2) - &1) * t pow 3`; + `\t. pi * (inv (a pow 2) - &1) * t pow 2`; + `&0`; `h:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]);; + +let VOLUME_FRUSTT = prove + (`!v0 v1:real^3 h a. + &0 < a + ==> measurable(frustt v0 v1 h a) /\ + measure(frustt v0 v1 h a) = + if v1 = v0 \/ &1 <= a \/ h < &0 then &0 + else pi * ((h / a) pow 2 - h pow 2) * h / &3`, + SIMP_TAC[VOLUME_FRUSTT_STRONG]);; + +(* ------------------------------------------------------------------------- *) +(* Ellipsoid. *) +(* ------------------------------------------------------------------------- *) + +let scale = new_definition + `scale (t:real^3) (u:real^3):real^3 = + vector[t$1 * u$1; t$2 * u$2; t$3 * u$3]`;; + +let normball = new_definition `normball x r = { y:real^A | dist(y,x) < r}`;; + +let ellipsoid = new_definition + `ellipsoid t r = IMAGE (scale t) (normball(vec 0) r)`;; + +let NORMBALL_BALL = prove + (`!z r. normball z r = ball(z,r)`, + REWRITE_TAC[normball; ball; DIST_SYM]);; + +let MEASURE_SCALE = prove + (`!s. measurable s + ==> measurable(IMAGE (scale t) s) /\ + measure(IMAGE (scale t) s) = abs(t$1 * t$2 * t$3) * measure s`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURE] THEN + DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i` o + MATCH_MP HAS_MEASURE_STRETCH) THEN + REWRITE_TAC[DIMINDEX_3; PRODUCT_3] THEN + SUBGOAL_THEN `(\x:real^3. (lambda k. t$k * x$k):real^3) = scale t` + SUBST1_TAC THENL + [SIMP_TAC[CART_EQ; FUN_EQ_THM; scale; LAMBDA_BETA; DIMINDEX_3; + VECTOR_3; ARITH; FORALL_3]; + MESON_TAC[measurable; MEASURE_UNIQUE]]);; + +let MEASURE_ELLIPSOID = prove + (`!t r. &0 <= r + ==> measurable(ellipsoid t r) /\ + measure(ellipsoid t r) = + abs(t$1 * t$2 * t$3) * &4 / &3 * pi * r pow 3`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM o + SPEC `vec 0:real^3` o MATCH_MP VOLUME_BALL) THEN + REWRITE_TAC[normball; ellipsoid] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[GSYM ball] THEN MATCH_MP_TAC MEASURE_SCALE THEN + REWRITE_TAC[MEASURABLE_BALL]);; + +let MEASURABLE_ELLIPSOID = prove + (`!t r. measurable(ellipsoid t r)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `&0 <= r` THEN ASM_SIMP_TAC[MEASURE_ELLIPSOID] THEN + REWRITE_TAC[ellipsoid; NORMBALL_BALL; IMAGE; IN_BALL_0] THEN + ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(norm(x:real^3) < r)`] THEN + REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Conic cap. *) +(* ------------------------------------------------------------------------- *) + +let conic_cap = new_definition + `conic_cap v0 v1 r a = normball v0 r INTER rcone_gt v0 v1 a`;; + +let CONIC_CAP_DEGENERATE = prove + (`!v0 r a. conic_cap v0 v0 r a = {}`, + REWRITE_TAC[conic_cap; rcone_gt; rconesgn; VECTOR_SUB_REFL] THEN + REWRITE_TAC[DIST_REFL; DOT_RZERO; REAL_MUL_RZERO; REAL_MUL_LZERO] THEN + REWRITE_TAC[real_gt; REAL_LT_REFL] THEN SET_TAC[]);; + +let BOUNDED_CONIC_CAP = prove + (`!v0 v1:real^3 r a. bounded(conic_cap v0 v1 r a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(v0:real^3,r)` THEN + REWRITE_TAC[BOUNDED_BALL] THEN SET_TAC[]);; + +let MEASURABLE_CONIC_CAP = prove + (`!v0 v1:real^3 r a. measurable(conic_cap v0 v1 r a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN + MATCH_MP_TAC MEASURABLE_OPEN THEN + SIMP_TAC[OPEN_INTER; OPEN_RCONE_GT; OPEN_BALL] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(v0:real^3,r)` THEN + REWRITE_TAC[BOUNDED_BALL] THEN SET_TAC[]);; + +let VOLUME_CONIC_CAP_STRONG = prove + (`!v0 v1:real^3 r a. + &0 < a + ==> bounded(conic_cap v0 v1 r a) /\ + convex(conic_cap v0 v1 r a) /\ + measurable(conic_cap v0 v1 r a) /\ + measure(conic_cap v0 v1 r a) = + if v1 = v0 \/ &1 <= a \/ r < &0 then &0 + else &2 / &3 * pi * (&1 - a) * r pow 3`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[conic_cap; rcone_gt; rconesgn; IN_ELIM_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] normball; GSYM ball] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN GEOM_ORIGIN_TAC `v0:real^3` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `v1:real^3` THEN + X_GEN_TAC `b:real` THEN REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `&0 <= x ==> x = &0 \/ &0 < x`)) + THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; GSYM REAL_NOT_LE; DOT_RZERO] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; NORM_POS_LE] THEN + REWRITE_TAC[EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; MEASURABLE_EMPTY; + CONVEX_EMPTY; BOUNDED_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `!y:real^3. ~(norm(y) * norm(b % basis 1:real^3) * a + < y dot (b % basis 1))` + (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; + MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]) THEN + REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; + DIMINDEX_3; ARITH] THEN + REWRITE_TAC[REAL_ARITH + `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_NORM; DOT_BASIS; + DIMINDEX_3; ARITH; NORM_BASIS] THEN + ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[INTER; REAL_MUL_LZERO; IN_BALL_0; IN_ELIM_THM] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; + REAL_LT_IMP_NZ] THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x < r)`] THEN + REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY; + BOUNDED_EMPTY; CONVEX_EMPTY]; + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_NOT_LT])] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c /\ d) ==> a /\ b /\ c /\ d`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `ball(vec 0:real^3,r)` THEN + SIMP_TAC[BOUNDED_BALL; IN_BALL_0; SUBSET; IN_ELIM_THM]; + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + MATCH_MP_TAC CONVEX_INTER THEN + REWRITE_TAC[GSYM IN_BALL_0; CONVEX_BALL; SIMPLE_IMAGE; IMAGE_ID] THEN + MP_TAC(ISPECL [`vec 0:real^3`; `basis 1:real^3`; `a:real`] + CONVEX_RCONE_GT) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; rcone_gt; rconesgn] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0] THEN + SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[real_gt; REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO]; + STRIP_TAC] THEN + MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_CONVEX_STRONG) THEN + EXISTS_TAC `1` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN + SIMP_TAC[SLICE_312; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; + VECTOR_3; DOT_3; GSYM DOT_2] THEN + SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN + ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. if &0 < t /\ t < r + then measure + {y:real^2 | norm(vector[t; y$1; y$2]:real^3) pow 2 + < r pow 2 /\ + (t * t + y dot y) * a pow 2 < t pow 2} + else &0` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `&0 < t` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY] THEN + ASM_CASES_TAC `t:real < r` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[NORM_LT_SQUARE] THEN + SUBGOAL_THEN `&0 < r` (fun th -> REWRITE_TAC[th; NORM_POW_2]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!y. ~(norm(vector[t; (y:real^2)$1; y$2]:real^3) < r)` + (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURE_EMPTY; + MEASURABLE_EMPTY]) THEN + ASM_REWRITE_TAC[NORM_LT_SQUARE; DOT_3; VECTOR_3] THEN + GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b /\ c <= d + ==> ~(&0 < r /\ d + a + b < c)`) THEN + REWRITE_TAC[REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN + REWRITE_TAC[NORM_POW_2; DOT_3; VECTOR_3; DOT_2] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `pi * &2 / &3 * (&1 - a) * r pow 3 = + pi / &3 * (inv (a pow 2) - &1) * (a * r) pow 3 + + (pi * &2 / &3 * (&1 - a) * r pow 3 - + pi / &3 * (inv (a pow 2) - &1) * (a * r) pow 3)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN + EXISTS_TAC `a * r:real` THEN + REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC + `\t. measure(ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t))` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE_ALT] THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; SQRT_POW_2; REAL_LT_IMP_LE; + REAL_POW_MUL] THEN + REWRITE_TAC[REAL_ARITH `x < (a - &1) * t <=> t + x < t * a`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + X_GEN_TAC `x:real^2` THEN REWRITE_TAC[DOT_2] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + MATCH_MP_TAC(REAL_ARITH `b <= a ==> (x < b <=> x < a /\ x < b)`) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; GSYM REAL_POW_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. pi * (inv(a pow 2) - &1) * t pow 2` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN + ASM_SIMP_TAC[REAL_POW_MUL; REAL_LT_IMP_LE; SQRT_POS_LT; REAL_LE_MUL; + SQRT_POW_2]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\t. pi / &3 * (inv (a pow 2) - &1) * t pow 3`; + `\t. pi * (inv (a pow 2) - &1) * t pow 2`; + `&0`; `a * r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC + `\t. measure(ball(vec 0:real^2,sqrt(r pow 2 - t pow 2)))` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[IN_BALL_0; NORM_LT_SQUARE_ALT] THEN + SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE2] THEN + X_GEN_TAC `x:real^2` THEN REWRITE_TAC[DOT_2] THEN + REWRITE_TAC[REAL_ARITH `x < r - t <=> t + x < r`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LT_RDIV_EQ; REAL_POW_LT] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> (x < a <=> x < a /\ x < b)`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT; GSYM REAL_POW_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_POW_LE2; REAL_LE_MUL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. pi * (r pow 2 - t pow 2)` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AREA_BALL o rand o snd) THEN + SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_SUB_LE; REAL_POW_LE2]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\t. pi * (r pow 2 * t - t pow 3 / &3)`; + `\t. pi * (r pow 2 - t pow 2)`; + `a * r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]);; + +let VOLUME_CONIC_CAP = prove + (`!v0 v1:real^3 r a. + &0 < a + ==> measurable(conic_cap v0 v1 r a) /\ measure(conic_cap v0 v1 r a) = + if v1 = v0 \/ &1 <= a \/ r < &0 then &0 + else &2 / &3 * pi * (&1 - a) * r pow 3`, + SIMP_TAC[VOLUME_CONIC_CAP_STRONG]);; + +(* ------------------------------------------------------------------------- *) +(* Negligibility of a circular cone. *) +(* This isn't exactly using the Flyspeck definition of "cone" but we use it *) +(* to get that later on. Could now simplify this using WLOG tactics. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL = prove + (`!c:real^N k. ~(c = vec 0) /\ ~(k = &0) /\ ~(k = pi) + ==> negligible {x | vector_angle c x = k}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `(vec 0:real^N) INSERT + UNIONS { {x | x IN ((:real^N) DIFF ball(vec 0,inv(&n + &1))) /\ + Cx(vector_angle c x) = Cx k} | + n IN (:num) }` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; IN_INSERT; IN_UNIONS; IN_ELIM_THM; CX_INJ] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_UNIV] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; IN_DIFF; IN_UNIV] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MP_TAC(SPEC `norm(x:real^N)` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[NORM_POS_LT; IN_BALL_0; REAL_NOT_LT; REAL_LT_INV_EQ] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&n)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[NEGLIGIBLE_INSERT] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN EXISTS_TAC `c:real^N` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN + SIMP_TAC[CLOSED_DIFF; CLOSED_UNIV; OPEN_BALL] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_CX_VECTOR_ANGLE) THEN + REWRITE_TAC[IN_DIFF; IN_BALL_0; NORM_0; IN_UNIV] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `x:real^N`] THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV; IN_DIFF; IN_BALL_0; REAL_NOT_LT; CX_INJ] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN ASM_CASES_TAC `(c + x:real^N) = vec 0` THENL + [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_INV_EQ; NORM_0] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `c + a % x:real^N = vec 0` THENL + [ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_LT_INV_EQ; NORM_0] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ANGLE_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `a = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_ANGLE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[TAUT `~a \/ ~b <=> a ==> ~b`] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`vec 0:real^N`; `c:real^N`; `c + a % x:real^N`; + `vec 0:real^N`; `c:real^N`; `c + x:real^N`] + CONGRUENT_TRIANGLES_ASA_FULL) THEN + REWRITE_TAC[angle; VECTOR_ADD_SUB] THEN ASM_SIMP_TAC[VECTOR_SUB_RZERO] THEN + REWRITE_TAC[NORM_ARITH `dist(x,x + a) = norm(a)`; NORM_MUL] THEN + REWRITE_TAC[REAL_FIELD `a * x = x <=> a = &1 \/ x = &0`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= a /\ a < &1 ==> ~(abs a = &1)`] THEN + ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_ANGLE_RMUL; COLLINEAR_LEMMA] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; + VECTOR_MUL_LID; REAL_MUL_LINV] THEN + REWRITE_TAC[VECTOR_ARITH `a % c + x = b % c <=> x = (b - a) % c`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH `c + a % c = (a + &1) % c`]) THEN + UNDISCH_TAC `vector_angle c ((inv a * u - inv a + &1) % c:real^N) = k` THEN + RULE_ASSUM_TAC(REWRITE_RULE + [VECTOR_ANGLE_RMUL; VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN + ASM_REWRITE_TAC[VECTOR_ANGLE_RMUL; VECTOR_ANGLE_REFL] THEN + ASM_REAL_ARITH_TAC);; + +let NEGLIGIBLE_CIRCULAR_CONE_0 = prove + (`!c:real^N k. 2 <= dimindex(:N) /\ ~(c = vec 0) + ==> negligible {x | vector_angle c x = k}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `orthogonal (basis 1:real^N) (basis 2)` ASSUME_TAC THENL + [ASM_SIMP_TAC[ORTHOGONAL_BASIS_BASIS; ARITH; + ARITH_RULE `2 <= d ==> 1 <= d`]; + ALL_TAC] THEN + ASM_CASES_TAC `k = &0 \/ k = pi` THENL + [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL]] THEN + SUBGOAL_THEN + `?b:real^N. ~(b = vec 0) /\ + ~(vector_angle c b = &0) /\ + ~(vector_angle c b = pi)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(MESON[] `!a b. P a \/ P b ==> ?x. P x`) THEN + MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `basis 2:real^N`] THEN + REWRITE_TAC[BASIS_EQ_0] THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= d ==> 1 <= d`; IN_NUMSEG; ARITH] THEN + REWRITE_TAC[GSYM DE_MORGAN_THM] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `basis 1:real^N` o + MATCH_MP VECTOR_ANGLE_EQ_0_LEFT)) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `basis 1:real^N` o + MATCH_MP VECTOR_ANGLE_EQ_PI_LEFT)) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_ANGLE_REFL; BASIS_EQ_0] THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= d ==> 1 <= d`; IN_NUMSEG; ARITH] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ORTHOGONAL_VECTOR_ANGLE]) THEN + REWRITE_TAC[VECTOR_ANGLE_SYM] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `k = &0 \/ k = pi` THENL + [ALL_TAC; ASM_MESON_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL]] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + FIRST_X_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [EXISTS_TAC `{x:real^N | vector_angle b x = vector_angle c b}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + MESON_TAC[VECTOR_ANGLE_EQ_0_RIGHT; VECTOR_ANGLE_SYM]; + EXISTS_TAC `{x:real^N | vector_angle b x = pi - vector_angle c b}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0_NONPARALLEL; + REAL_SUB_0; REAL_ARITH `p - x = p <=> x = &0`] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + MESON_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; VECTOR_ANGLE_SYM]]);; + +let NEGLIGIBLE_CIRCULAR_CONE = prove + (`!a:real^N c k. + 2 <= dimindex(:N) /\ ~(c = vec 0) + ==> negligible(a INSERT {x | vector_angle c (x - a) = k})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_INSERT] THEN + MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN EXISTS_TAC `--a:real^N` THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | vector_angle c x = k}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_CIRCULAR_CONE_0] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `--a + x:real^N = x - a`]);; + +let NEGLIGIBLE_RCONE_EQ = prove + (`!w z:real^3 h. ~(w = z) ==> negligible(rcone_eq z w h)`, + REWRITE_TAC[rcone_eq; rconesgn] THEN GEOM_ORIGIN_TAC `z:real^3` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_0; VECTOR_SUB_RZERO] THEN + ASM_CASES_TAC `abs(h) <= &1` THENL + [MP_TAC(ISPECL [`w:real^3`; `acs h`] NEGLIGIBLE_CIRCULAR_CONE_0) THEN + ASM_REWRITE_TAC[DIMINDEX_3; ARITH] THEN + REWRITE_TAC[GSYM HAS_MEASURE_0] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_MEASURE_NEGLIGIBLE_SYMDIFF) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{vec 0:real^3}` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN MATCH_MP_TAC(SET_RULE + `(!x. ~(x = a) ==> (x IN s <=> x IN t)) + ==> (s DIFF t) UNION (t DIFF s) SUBSET {a}`) THEN + X_GEN_TAC `x:real^3` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[vector_angle] THEN ASM_SIMP_TAC[NORM_EQ_0; REAL_FIELD + `~(x = &0) /\ ~(w = &0) ==> (a = x * w * b <=> a / (w * x) = b)`] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [DOT_SYM] THEN + MATCH_MP_TAC ACS_INJ THEN ASM_REWRITE_TAC[NORM_CAUCHY_SCHWARZ_DIV]; + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{vec 0}:real^3->bool` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN + REWRITE_TAC[SET_RULE `{x | P x} SUBSET {a} <=> !x. ~(x = a) ==> ~P x`] THEN + X_GEN_TAC `x:real^3` THEN REPEAT DISCH_TAC THEN + MP_TAC(ISPECL [`x:real^3`; `w:real^3`] NORM_CAUCHY_SCHWARZ_ABS) THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; REAL_ARITH + `~(x * w * h <= x * w) <=> &0 < x * w * (h - &1)`] THEN + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[NORM_POS_LT]) THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Area of sector of a circle delimited by Arg values. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_ARG_EQ = prove + (`!t. negligible {z | Arg z = t}`, + GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{z | cexp(ii * Cx(pi / &2 + t)) dot z = &0}` THEN + SIMP_TAC[NEGLIGIBLE_HYPERPLANE; COMPLEX_VEC_0; CEXP_NZ] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:complex` THEN + DISCH_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM COMPLEX_CMUL; DOT_RMUL; REAL_ENTIRE] THEN + DISJ2_TAC THEN REWRITE_TAC[CEXP_EULER] THEN + REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; RE_ADD; IM_ADD; + RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + REWRITE_TAC[SIN_ADD; COS_ADD; SIN_PI2; COS_PI2] THEN + REAL_ARITH_TAC);; + +let MEASURABLE_CLOSED_SECTOR_LE = prove + (`!r t. measurable {z | norm(z) <= r /\ Arg z <= t}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN + REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = {z | P z} INTER {z | Q z}`] THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN REWRITE_TAC[CLOSED_ARG_LE] THEN + REWRITE_TAC[NORM_ARITH `norm z = dist(vec 0,z)`; GSYM cball] THEN + REWRITE_TAC[COMPACT_CBALL]);; + +let MEASURABLE_CLOSED_SECTOR_LT = prove + (`!r t. measurable {z | norm(z) <= r /\ Arg z < t}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF THEN + EXISTS_TAC `{z | norm(z) <= r /\ Arg z <= t}` THEN + REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{z | Arg z = t}` THEN + REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let MEASURABLE_CLOSED_SECTOR_LTE = prove + (`!r s t. measurable {z | norm(z) <= r /\ s < Arg z /\ Arg z <= t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE + `{z | P z /\ Q z /\ R z} = {z | P z /\ R z} DIFF {z | P z /\ ~Q z}`] THEN + SIMP_TAC[MEASURABLE_DIFF; REAL_NOT_LT; MEASURABLE_CLOSED_SECTOR_LE]);; + +let MEASURE_CLOSED_SECTOR_LE = prove + (`!t r. &0 <= r /\ &0 <= t /\ t <= &2 * pi + ==> measure {x:real^2 | norm(x) <= r /\ Arg(x) <= t} = + t * r pow 2 / &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\t. measure {z:real^2 | norm(z) <= r /\ Arg(z) <= t}`; + `&2 * pi`] REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL) THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPECL [`t / (&2 * pi)`; `&2 * pi`]) THEN + MP_TAC(SPECL [`vec 0:real^2`; `r:real`] AREA_CBALL) THEN + ASM_REWRITE_TAC[cball; NORM_ARITH `dist(vec 0,z) = norm z`] THEN + SIMP_TAC[ARG; REAL_LT_IMP_LE] THEN DISCH_THEN(K ALL_TAC) THEN + SIMP_TAC[PI_POS; REAL_FIELD `&0 < p ==> t / (&2 * p) * p * r = t * r / &2`; + REAL_FIELD `&0 < p ==> t / (&2 * p) * &2 * p = t`] THEN + DISCH_THEN MATCH_MP_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REALLIM_TRANSFORM_BOUND THEN + EXISTS_TAC `\t. r pow 2 * sin(t)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `pi / &2` THEN + SIMP_TAC[PI_POS; REAL_LT_DIV; IN_ELIM_THM; REAL_OF_NUM_LT; ARITH] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[real_abs; MEASURE_POS_LE; MEASURABLE_CLOSED_SECTOR_LE] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(interval[vec 0,complex(r,r * sin x)])` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; VEC_COMPONENT] THEN + REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE] THEN + SUBST1_TAC(last(CONJUNCTS(SPEC `z:complex` ARG))) THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; CEXP_EULER] THEN + REWRITE_TAC[RE_ADD; GSYM CX_COS; GSYM CX_SIN; RE_CX; IM_CX; + RE_MUL_II; IM_MUL_II; IM_ADD] THEN + REWRITE_TAC[REAL_NEG_0; REAL_ADD_LID; REAL_ADD_RID] THEN + SUBGOAL_THEN `&0 <= Arg z /\ Arg z < pi / &2 /\ Arg z <= pi / &2` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[ARG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC COS_POS_PI_LE THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c * &1 ==> a * b <= c`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS; COS_BOUND]; + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC SIN_MONO_LE THEN ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[FORALL_2; PRODUCT_2; DIMINDEX_2; VEC_COMPONENT] THEN + REWRITE_TAC[GSYM IM_DEF; GSYM RE_DEF; IM; RE] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_POW_2; REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `&0 <= sin x` (fun th -> + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_REFL; REAL_LE_MUL; th]) THEN + MATCH_MP_TAC SIN_POS_PI_LE THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN + SUBGOAL_THEN `(\t. r pow 2 * sin t) real_continuous atreal (&0)` + MP_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN + REWRITE_TAC[ETA_AX; REAL_CONTINUOUS_AT_SIN]; + REWRITE_TAC[REAL_CONTINUOUS_ATREAL; SIN_0; REAL_MUL_RZERO]]]; + ASM_SIMP_TAC[REAL_ARITH + `&0 <= x /\ &0 <= y + ==> (norm z <= r /\ Arg z <= x + y <=> + norm z <= r /\ Arg z <= x \/ + norm z <= r /\ x < Arg z /\ Arg z <= x + y)`] THEN + REWRITE_TAC[SET_RULE `{z | Q z \/ R z} = {z | Q z} UNION {z | R z}`] THEN + SIMP_TAC[MEASURE_UNION; MEASURABLE_CLOSED_SECTOR_LE; + MEASURABLE_CLOSED_SECTOR_LTE] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; SET_RULE + `{z | P z /\ Q z} INTER {z | P z /\ ~Q z /\ R z} = {}`] THEN + REWRITE_TAC[MEASURE_EMPTY; REAL_SUB_RZERO; REAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `measure {z | norm z <= r /\ x < Arg z /\ Arg z < x + y}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LTE] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{z | Arg z = x + y}` THEN + REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `measure {z | norm z <= r /\ &0 < Arg z /\ Arg z < y}` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + REWRITE_TAC[MEASURABLE_CLOSED_SECTOR_LE] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{z | Arg z = &0} UNION {z | Arg z = y}` THEN + REWRITE_TAC[NEGLIGIBLE_ARG_EQ; NEGLIGIBLE_UNION_EQ] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN + MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `measure (IMAGE (rotate2d x) + {z | norm z <= r /\ &0 < Arg z /\ Arg z < y})` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[MEASURE_ORTHOGONAL_IMAGE_EQ; + ORTHOGONAL_TRANSFORMATION_ROTATE2D]] THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL + [ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; + ORTHOGONAL_TRANSFORMATION_ROTATE2D]; ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[Arg_DEF; ROTATE2D_0] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[NORM_ROTATE2D] THEN AP_TERM_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `z = rotate2d (--x) (rotate2d x z)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM ROTATE2D_ADD; REAL_ADD_LINV; ROTATE2D_ZERO]; + ALL_TAC] THEN + MP_TAC(ISPECL [`--x:real`; `rotate2d x z`] ARG_ROTATE2D) THEN + ASM_REWRITE_TAC[ROTATE2D_EQ_0] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN + MP_TAC(ISPECL [`x:real`; `z:complex`] ARG_ROTATE2D) THEN + ASM_REWRITE_TAC[ROTATE2D_EQ_0] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + ASM_REAL_ARITH_TAC]]);; + +let HAS_MEASURE_OPEN_SECTOR_LT = prove + (`!t r. &0 <= t /\ t <= &2 * pi + ==> {x:real^2 | norm(x) < r /\ &0 < Arg x /\ Arg x < t} + has_measure (if &0 <= r then t * r pow 2 / &2 else &0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_ARITH `~(&0 <= r) ==> ~(norm x < r)`; + EMPTY_GSPEC; HAS_MEASURE_EMPTY] THEN + MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_SYMDIFF THEN + EXISTS_TAC `{x | norm x <= r /\ Arg x <= t}` THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN + ASM_SIMP_TAC[MEASURE_CLOSED_SECTOR_LE; MEASURABLE_CLOSED_SECTOR_LE] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x | dist(vec 0,x) = r} UNION + {z | Arg z = &0} UNION {z | Arg z = t}` THEN + REWRITE_TAC[NEGLIGIBLE_ARG_EQ; REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE; + NEGLIGIBLE_UNION_EQ] THEN + REWRITE_TAC[DIST_0; SUBSET; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN + MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let MEASURE_OPEN_SECTOR_LT = prove + (`!t r. &0 <= t /\ t <= &2 * pi + ==> measure {x:real^2 | norm(x) < r /\ &0 < Arg x /\ Arg x < t} = + if &0 <= r then t * r pow 2 / &2 else &0`, + SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_OPEN_SECTOR_LT]);; + +let HAS_MEASURE_OPEN_SECTOR_LT_GEN = prove + (`!w z. + ~(w = vec 0) + ==> {x | norm(x) < r /\ &0 < Arg(x / w) /\ Arg(x / w) < Arg(z / w)} + has_measure (if &0 <= r then Arg(z / w) * r pow 2 / &2 else &0)`, + GEOM_BASIS_MULTIPLE_TAC 1 `w:complex` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID] THEN ASM_REWRITE_TAC[CX_INJ] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_OPEN_SECTOR_LT THEN + SIMP_TAC[ARG; REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence volume of a wedge of a ball. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_BALL_WEDGE = prove + (`!z:real^3 w w1 w2. measurable(ball(z,r) INTER wedge z w w1 w2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_OPEN THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_INTER THEN REWRITE_TAC[BOUNDED_BALL]; + MATCH_MP_TAC OPEN_INTER THEN REWRITE_TAC[OPEN_BALL] THEN + ASM_SIMP_TAC[OPEN_WEDGE]]);; + +let VOLUME_BALL_WEDGE = prove + (`!z:real^3 w r w1 w2. + &0 <= r ==> measure(ball(z,r) INTER wedge z w w1 w2) = + azim z w w1 w2 * &2 * r pow 3 / &3`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `z:real^3 = w \/ collinear{z,w,w1} \/ collinear{z,w,w2}` THENL + [FIRST_X_ASSUM STRIP_ASSUME_TAC THEN + ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE; INTER_EMPTY; REAL_MUL_LZERO; + MEASURE_EMPTY]; + FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; DE_MORGAN_THM]] THEN + REWRITE_TAC[wedge] THEN GEOM_ORIGIN_TAC `z:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; COLLINEAR_SPECIAL_SCALE] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE[`:2`,`:M`; `:3`,`:N`] FUBINI_SIMPLE_OPEN) THEN + EXISTS_TAC `3` THEN REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_BALL]; + REWRITE_TAC[GSYM wedge] THEN MATCH_MP_TAC OPEN_INTER THEN + ASM_REWRITE_TAC[OPEN_BALL; OPEN_WEDGE]; + SIMP_TAC[SLICE_INTER; DIMINDEX_2; DIMINDEX_3; ARITH; SLICE_BALL]] THEN + ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN + ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN + MAP_EVERY ABBREV_TAC + [`v1:real^2 = dropout 3 (w1:real^3)`; + `v2:real^2 = dropout 3 (w2:real^3)`] THEN + REWRITE_TAC[SLICE_DROPOUT_3; VEC_COMPONENT; REAL_SUB_RZERO] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[INTER_EMPTY] THEN REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[MEASURE_EMPTY] THEN + MAP_EVERY UNDISCH_TAC + [`~(v1:complex = vec 0)`; `~(v2:complex = vec 0)`] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v2:complex`; `v1:complex`] THEN + UNDISCH_TAC `&0 <= r` THEN SPEC_TAC(`r:real`,`r:real`) THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEOM_BASIS_MULTIPLE_TAC 1 `v1:complex` THEN + X_GEN_TAC `v1:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `v1 = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_BASIS; COMPLEX_VEC_0] THEN + SIMP_TAC[ARG_DIV_CX; COMPLEX_MUL_RID; CX_INJ] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!t z. ~(z = Cx(&0)) /\ &0 < Arg z /\ Arg z < t <=> + &0 < Arg z /\ Arg z < t` + (fun th -> REWRITE_TAC[th]) + THENL [MESON_TAC[ARG_0; REAL_LT_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[MEASURE_OPEN_SECTOR_LT; REAL_LE_REFL; ARG; REAL_LT_IMP_LE] THEN + SUBGOAL_THEN `!t. abs(t) < r <=> t IN real_interval(--r,r)` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\t. Arg v2 * (r pow 2 - t pow 2) / &2` THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL; REAL_BOUNDS_LE] THEN + SIMP_TAC[AREA_CBALL; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; + SQRT_POW_2; REAL_ARITH `abs x <= r ==> abs x <= abs r`]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\t. Arg v2 * (r pow 2 * t - &1 / &3 * t pow 3) / &2`; + `\t. Arg v2 * (r pow 2 - t pow 2) / &2`; + `--r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Hence volume of lune. *) +(* ------------------------------------------------------------------------- *) + +let HAS_MEASURE_LUNE = prove + (`!z:real^3 w r w1 w2. + &0 <= r /\ ~(w = z) /\ + ~collinear {z,w,w1} /\ ~collinear {z,w,w2} /\ ~(dihV z w w1 w2 = pi) + ==> (ball(z,r) INTER aff_gt {z,w} {w1,w2}) + has_measure (dihV z w w1 w2 * &2 * r pow 3 / &3)`, + GEOM_ORIGIN_TAC `z:real^3` THEN + GEOM_BASIS_MULTIPLE_TAC 3 `w:real^3` THEN + X_GEN_TAC `w:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `w = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_SIMP_TAC[DIHV_SPECIAL_SCALE] THEN + MP_TAC(ISPECL [`{}:real^3->bool`; `{w1:real^3,w2:real^3}`; + `w:real`; `basis 3:real^3`] AFF_GT_SPECIAL_SCALE) THEN + ASM_CASES_TAC `w1:real^3 = vec 0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `w2:real^3 = vec 0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `w1:real^3 = w % basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `w2:real^3 = w % basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN + ASM_CASES_TAC `w1:real^3 = basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_CASES_TAC `w2:real^3 = basis 3` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN STRIP_TAC THEN + ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 = &0` THENL + [MP_TAC(ASSUME `azim (vec 0) (basis 3) w1 w2 = &0`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) AZIM_DIVH o lhs o lhand o snd) THEN + ASM_REWRITE_TAC[PI_POS] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_MUL_LZERO; HAS_MEASURE_0] THEN + MATCH_MP_TAC COPLANAR_IMP_NEGLIGIBLE THEN + MATCH_MP_TAC COPLANAR_SUBSET THEN + EXISTS_TAC `affine hull {vec 0:real^3,basis 3,w1,w2}` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[COPLANAR_AFFINE_HULL_COPLANAR; AZIM_EQ_0_PI_IMP_COPLANAR]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `t SUBSET u ==> (s INTER t) SUBSET u`) THEN + SIMP_TAC[aff_gt_def; AFFSIGN; sgn_gt; AFFINE_HULL_FINITE; + FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[SET_RULE `{a,b} UNION {c,d} = {a,b,c,d}`] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < azim (vec 0) (basis 3) w1 w2` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE; azim]; ALL_TAC] THEN + ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 < pi` THENL + [ASM_SIMP_TAC[GSYM AZIM_DIHV_SAME; GSYM WEDGE_LUNE_GT] THEN + ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_BALL_WEDGE; + VOLUME_BALL_WEDGE]; + ALL_TAC] THEN + ASM_CASES_TAC `azim (vec 0) (basis 3) w1 w2 = pi` THENL + [MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`] + AZIM_DIVH) THEN + ASM_REWRITE_TAC[REAL_LT_REFL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `dihV (vec 0) (basis 3) w1 w2 = azim (vec 0) (basis 3) w2 w1` + SUBST1_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o rand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x:real = y - z <=> z = y - x`] THEN + MATCH_MP_TAC AZIM_DIHV_COMPL THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LT]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < azim (vec 0) (basis 3) w2 w1 /\ + azim (vec 0) (basis 3) w2 w1 < pi` + ASSUME_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) AZIM_COMPL o lhand o rand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`] + azim) THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBST1_TAC(SET_RULE `{w1:real^3,w2} = {w2,w1}`) THEN + ASM_SIMP_TAC[GSYM AZIM_DIHV_SAME; GSYM WEDGE_LUNE_GT] THEN + ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_BALL_WEDGE; + VOLUME_BALL_WEDGE]);; + +let HAS_MEASURE_LUNE_SIMPLE = prove + (`!z:real^3 w r w1 w2. + &0 <= r /\ ~coplanar{z,w,w1,w2} + ==> (ball(z,r) INTER aff_gt {z,w} {w1,w2}) + has_measure (dihV z w w1 w2 * &2 * r pow 3 / &3)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `w:real^3 = z` THENL + [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_LUNE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR; INSERT_AC]; ALL_TAC]) THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`z:real^3`; `w:real^3`; `w1:real^3`; `w2:real^3`] + AZIM_DIVH) THEN + ASM_REWRITE_TAC[REAL_ARITH `&2 * pi - pi = pi`; COND_ID] THEN + ASM_MESON_TAC[AZIM_EQ_0_PI_IMP_COPLANAR]);; + +(* ------------------------------------------------------------------------- *) +(* Now the volume of a solid triangle. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_BALL_AFF_GT = prove + (`!z r s t. measurable(ball(z,r) INTER aff_gt s t)`, + MESON_TAC[MEASURABLE_CONVEX; CONVEX_INTER; CONVEX_AFF_GT; CONVEX_BALL; + BOUNDED_INTER; BOUNDED_BALL]);; + +let AFF_GT_SHUFFLE = prove + (`!s t v:real^N. + FINITE s /\ FINITE t /\ + vec 0 IN s /\ ~(vec 0 IN t) /\ + ~(v IN s) /\ ~(--v IN s) /\ ~(v IN t) + ==> aff_gt (v INSERT s) t = + aff_gt s (v INSERT t) UNION + aff_gt s (--v INSERT t) UNION + aff_gt s t`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[aff_gt_def; AFFSIGN_ALT; sgn_gt] THEN + REWRITE_TAC[SET_RULE `(v INSERT s) UNION t = v INSERT (s UNION t)`; + SET_RULE `s UNION (v INSERT t) = v INSERT (s UNION t)`] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN + REWRITE_TAC[IN_INSERT] THEN + ASM_SIMP_TAC[SET_RULE + `~(a IN s) + ==> ((w IN s UNION t ==> w = a \/ w IN t ==> P w) <=> + (w IN t ==> P w))`] THEN + REWRITE_TAC[SET_RULE `x IN (s UNION t) + ==> x IN t ==> P x <=> x IN t ==> P x`] THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `v:real` ASSUME_TAC) THEN + ASM_CASES_TAC `&0 < v` THENL + [DISJ1_TAC THEN EXISTS_TAC `v:real` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC] THEN + ASM_CASES_TAC `v = &0` THENL + [DISJ2_TAC THEN + FIRST_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]; + DISJ1_TAC] THEN + EXISTS_TAC `--v:real` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^N. if x = vec 0 then f(x) + &2 * v else f(x)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; + ASM_SIMP_TAC[SUM_CASES_1; FINITE_UNION; IN_UNION] THEN REAL_ARITH_TAC; + REWRITE_TAC[VECTOR_ARITH `--a % --x:real^N = a % x`] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO]]; + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [DISCH_THEN(X_CHOOSE_THEN `a:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--a:real` THEN + EXISTS_TAC `\x:real^N. if x = vec 0 then &2 * a + f(vec 0) else f x` THEN + ASM_SIMP_TAC[SUM_CASES_1; FINITE_UNION; IN_UNION] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `y - --a % v:real^N = y - a % --v`] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC VSUM_EQ THEN REPEAT GEN_TAC THEN REWRITE_TAC[] THEN + DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO]; + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + VECTOR_ARITH_TAC]]);; + +let MEASURE_BALL_AFF_GT_SHUFFLE_LEMMA = prove + (`!r s t v:real^N. + &0 <= r /\ + independent(v INSERT((s DELETE vec 0) UNION t)) /\ + FINITE s /\ FINITE t /\ CARD(s UNION t) <= dimindex(:N) /\ + vec 0 IN s /\ ~(vec 0 IN t) /\ + ~(v IN s) /\ ~(--v IN s) /\ ~(v IN t) + ==> measure(ball(vec 0,r) INTER aff_gt (v INSERT s) t) = + measure(ball(vec 0,r) INTER aff_gt s (v INSERT t)) + + measure(ball(vec 0,r) INTER aff_gt s (--v INSERT t))`, + let lemma = prove + (`!s t u:real^N->bool. + measurable s /\ measurable t /\ s INTER t = {} /\ negligible u + ==> measure(s UNION t UNION u) = measure s + measure t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[UNION_ASSOC] THEN + ASM_SIMP_TAC[GSYM MEASURE_DISJOINT_UNION; DISJOINT] THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + ASM_SIMP_TAC[MEASURABLE_UNION] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] NEGLIGIBLE_SUBSET)) THEN SET_TAC[]) in + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_GT_SHUFFLE o + rand o rand o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[UNION_OVER_INTER] THEN MATCH_MP_TAC lemma THEN + ASM_REWRITE_TAC[MEASURABLE_BALL_AFF_GT] THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `t INTER u = {} ==> (s INTER t) INTER (s INTER u) = {}`) THEN + REWRITE_TAC[aff_gt_def; AFFSIGN_ALT; sgn_gt] THEN + REWRITE_TAC[SET_RULE `(v INSERT s) UNION t = v INSERT (s UNION t)`; + SET_RULE `s UNION (v INSERT t) = v INSERT (s UNION t)`] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM; REAL_LT_ADD; + REAL_HALF; FINITE_EMPTY] THEN + REWRITE_TAC[IN_INSERT] THEN + ASM_SIMP_TAC[SET_RULE + `~(a IN s) ==> ((w IN s UNION t ==> w = a \/ w IN t ==> P w) <=> + (w IN t ==> P w))`] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `a:real` + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `f:real^N->real` STRIP_ASSUME_TAC))) + (X_CHOOSE_THEN `b:real` + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC)))) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_DELETE; FINITE_UNION] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC + `\x. if x = v then a + b else (f:real^N->real) x - g x`) THEN + ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_UNION] THEN + ASM_REWRITE_TAC[IN_DELETE; IN_UNION] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `v:real^N`) THEN + REWRITE_TAC[IN_INSERT] THEN ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[SET_RULE + `~(a IN t) ==> (s DELETE a) UNION t = (s UNION t) DELETE a`] THEN + ASM_SIMP_TAC[VSUM_DELETE_CASES; FINITE_UNION; IN_UNION] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + SUBGOAL_THEN + `!x:real^N. (if x = v then a + b else f x - g x) % x = + (if x = v then a else f x) % x - + (if x = v then --b else g x) % x` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ASM_SIMP_TAC[VSUM_SUB; FINITE_UNION]] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(a + b) % v + (y - a % v) - (y - b % --v):real^N` THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + AP_TERM_TAC THEN BINOP_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC VSUM_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_UNION]; + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `aff_gt s t :real^N->bool` THEN + REWRITE_TAC[INTER_SUBSET] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `affine hull (s UNION t:real^N->bool)` THEN + REWRITE_TAC[AFF_GT_SUBSET_AFFINE_HULL] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_UNION; HULL_INC] THEN + ONCE_REWRITE_TAC[GSYM SPAN_DELETE_0] THEN + MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD((s UNION t) DELETE (vec 0:real^N))` THEN + ASM_SIMP_TAC[DIM_LE_CARD; FINITE_DELETE; FINITE_UNION; DIM_SPAN] THEN + ASM_SIMP_TAC[CARD_DELETE; IN_UNION; FINITE_UNION] THEN + MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n ==> x - 1 < n`) THEN + ASM_REWRITE_TAC[DIMINDEX_GE_1]]);; + +let MEASURE_BALL_AFF_GT_SHUFFLE = prove + (`!r s t v:real^N. + &0 <= r /\ ~(v IN (s UNION t)) /\ + independent(v INSERT (s UNION t)) + ==> measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT v INSERT s) t) = + measure(ball(vec 0,r) INTER aff_gt (vec 0 INSERT s) (v INSERT t)) + + measure(ball(vec 0,r) INTER + aff_gt (vec 0 INSERT s) (--v INSERT t))`, + REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:real`; `(vec 0:real^N) INSERT s`; + `t:real^N->bool`; `v:real^N`] + MEASURE_BALL_AFF_GT_SHUFFLE_LEMMA) THEN + ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[INSERT_AC]] THEN + ASM_REWRITE_TAC[IN_INSERT; FINITE_INSERT] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN + REWRITE_TAC[IN_INSERT; IN_UNION; DE_MORGAN_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INDEPENDENT_BOUND) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_UNION] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_UNION; IN_UNION; FINITE_INSERT] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] INDEPENDENT_MONO)) THEN + SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN + REWRITE_TAC[dependent; CONTRAPOS_THM] THEN DISCH_TAC THEN + EXISTS_TAC `v:real^N` THEN REWRITE_TAC[IN_INSERT] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_NEG] THEN + MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_SUPERSET THEN + ASM_REWRITE_TAC[IN_DELETE; VECTOR_ARITH `--v:real^N = v <=> v = vec 0`; + IN_INSERT; IN_UNION]]);; + +let MEASURE_LUNE_DECOMPOSITION = prove + (`!v1 v2 v3:real^3. + &0 <= r /\ ~coplanar {vec 0, v1, v2, v3} + ==> measure(ball(vec 0,r) INTER aff_gt {vec 0} {v1,v2,v3}) + + measure(ball(vec 0,r) INTER aff_gt {vec 0} {--v1,v2,v3}) = + dihV (vec 0) v1 v2 v3 * &2 * r pow 3 / &3`, + let rec distinctpairs l = + match l with + x::t -> itlist (fun y a -> (x,y) :: a) t (distinctpairs t) + | [] -> [] in + REPEAT GEN_TAC THEN MAP_EVERY + (fun t -> ASM_CASES_TAC t THENL + [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC]) + (map mk_eq (distinctpairs + [`v3:real^3`; `v2:real^3`; `v1:real^3`; `vec 0:real^3`])) THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_LUNE_SIMPLE)] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_BALL_AFF_GT_SHUFFLE THEN + ASM_REWRITE_TAC[UNION_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[NOT_COPLANAR_0_4_IMP_INDEPENDENT]);; + +let SOLID_TRIANGLE_CONGRUENT_NEG = prove + (`!r v1 v2 v3:real^N. + measure(ball(vec 0,r) INTER aff_gt {vec 0} {--v1, --v2, --v3}) = + measure(ball(vec 0,r) INTER aff_gt {vec 0} {v1, v2, v3})`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `ball(vec 0:real^N,r) INTER aff_gt {vec 0} {--v1, --v2, --v3} = + IMAGE (--) + (ball(vec 0,r) INTER aff_gt {vec 0} {v1, v2, v3})` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MEASURE_ORTHOGONAL_IMAGE_EQ THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; linear; NORM_NEG] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + CONJ_TAC THENL [MESON_TAC[VECTOR_NEG_NEG]; ALL_TAC] THEN + REWRITE_TAC[IN_INTER; IN_BALL_0; NORM_NEG] THEN + REWRITE_TAC[AFFSIGN_ALT; aff_gt_def; sgn_gt; IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE `{a} UNION {b,c,d} = {a,b,d,c}`] THEN + REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_UNION; AFFINE_HULL_FINITE_STEP_GEN; + RIGHT_EXISTS_AND_THM; REAL_LT_ADD; REAL_HALF; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = --x <=> vec 0 = x`] THEN + REWRITE_TAC[VECTOR_ARITH `--x - a % --w:real^N = --(x - a % w)`] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0]);; + +let VOLUME_SOLID_TRIANGLE = prove + (`!r v0 v1 v2 v3:real^3. + &0 < r /\ ~coplanar{v0, v1, v2, v3} + ==> measure(ball(v0,r) INTER aff_gt {v0} {v1,v2,v3}) = + let a123 = dihV v0 v1 v2 v3 in + let a231 = dihV v0 v2 v3 v1 in + let a312 = dihV v0 v3 v1 v2 in + (a123 + a231 + a312 - pi) * r pow 3 / &3`, + let tac convl = + W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_BALL_AFF_GT_SHUFFLE o + convl o lhand o lhand o snd) THEN + ASM_REWRITE_TAC[UNION_EMPTY; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `(a INSERT s) UNION t = a INSERT (s UNION t)`] THEN + ASM_SIMP_TAC[UNION_EMPTY; REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [DISCH_THEN(STRIP_THM_THEN SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[COPLANAR_3]) THEN + FIRST_ASSUM CONTR_TAC; + MATCH_MP_TAC NOT_COPLANAR_0_4_IMP_INDEPENDENT THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN + ASM_REWRITE_TAC[INSERT_AC]]; + DISCH_THEN SUBST1_TAC] in + GEN_TAC THEN GEOM_ORIGIN_TAC `v0:real^3` THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `measure(ball(vec 0:real^3,r) INTER aff_gt {vec 0,v1,v2,v3} {}) = + &4 / &3 * pi * r pow 3` + MP_TAC THENL + [MP_TAC(SPECL [`vec 0:real^3`; `r:real`] VOLUME_BALL) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE `t = UNIV ==> s INTER t = s`) THEN + REWRITE_TAC[AFF_GT_EQ_AFFINE_HULL] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN + REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV SUBSET s`] THEN + MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + ASM_SIMP_TAC[DIM_UNIV; DIMINDEX_3; SUBSET_UNIV] THEN + ASM_SIMP_TAC[NOT_COPLANAR_0_4_IMP_INDEPENDENT] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC; COPLANAR_3]) THEN + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]]) + [`v3:real^3 = v2`; `v3:real^3 = v1`; `v2:real^3 = v1`] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN + `~(coplanar {vec 0:real^3,v1,v2,v3}) /\ + ~(coplanar {vec 0,--v1,v2,v3}) /\ + ~(coplanar {vec 0,v1,--v2,v3}) /\ + ~(coplanar {vec 0,--v1,--v2,v3}) /\ + ~(coplanar {vec 0,--v1,--v2,v3}) /\ + ~(coplanar {vec 0,--v1,v2,--v3}) /\ + ~(coplanar {vec 0,v1,--v2,--v3}) /\ + ~(coplanar {vec 0,--v1,--v2,--v3}) /\ + ~(coplanar {vec 0,--v1,--v2,--v3})` + STRIP_ASSUME_TAC THENL + [REPLICATE_TAC 3 + (REWRITE_TAC[COPLANAR_INSERT_0_NEG] THEN + ONCE_REWRITE_TAC[SET_RULE `{vec 0,a,b,c} = {vec 0,b,c,a}`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY tac + [I; lhand; rand; + lhand o lhand; rand o lhand; lhand o rand; rand o rand] THEN + MP_TAC(ISPECL [`v1:real^3`; `v2:real^3`; `v3:real^3`] + MEASURE_LUNE_DECOMPOSITION) THEN + MP_TAC(ISPECL [`v2:real^3`; `v3:real^3`; `v1:real^3`] + MEASURE_LUNE_DECOMPOSITION) THEN + MP_TAC(ISPECL [`v3:real^3`; `v1:real^3`; `v2:real^3`] + MEASURE_LUNE_DECOMPOSITION) THEN + MP_TAC(ISPECL [`--v1:real^3`; `--v2:real^3`; `--v3:real^3`] + MEASURE_LUNE_DECOMPOSITION) THEN + MP_TAC(ISPECL [`--v2:real^3`; `--v3:real^3`; `--v1:real^3`] + MEASURE_LUNE_DECOMPOSITION) THEN + MP_TAC(ISPECL [`--v3:real^3`; `--v1:real^3`; `--v2:real^3`] + MEASURE_LUNE_DECOMPOSITION) THEN + ASM_REWRITE_TAC[VECTOR_NEG_NEG] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; INSERT_AC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_AC]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DIHV_NEG_0] THEN + REWRITE_TAC[SOLID_TRIANGLE_CONGRUENT_NEG] THEN + REWRITE_TAC[INSERT_AC] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Volume of wedge of a frustum. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_BOUNDED_INTER_OPEN = prove + (`!s t:real^N->bool. + measurable s /\ bounded s /\ open t ==> measurable(s INTER t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE + `s SUBSET i ==> s INTER t = s INTER (t INTER i)`)) THEN + MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_OPEN THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; BOUNDED_INTER; BOUNDED_INTERVAL]);; + +let SLICE_SPECIAL_WEDGE = prove + (`!w1 w2. + ~collinear {vec 0, basis 3, w1} /\ ~collinear {vec 0, basis 3, w2} + ==> slice 3 t (wedge (vec 0) (basis 3) w1 w2) = + {z | &0 < Arg(z / dropout 3 w1) /\ + Arg(z / dropout 3 w1) < Arg(dropout 3 w2 / dropout 3 w1)}`, + REWRITE_TAC[wedge] THEN + ONCE_REWRITE_TAC[TAUT `~a /\ b /\ c <=> ~(~a ==> ~(b /\ c))`] THEN + ASM_SIMP_TAC[AZIM_ARG] THEN REWRITE_TAC[COLLINEAR_BASIS_3] THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; DROPOUT_0] THEN + MAP_EVERY ABBREV_TAC + [`v1:real^2 = dropout 3 (w1:real^3)`; + `v2:real^2 = dropout 3 (w2:real^3)`] THEN + REWRITE_TAC[SLICE_DROPOUT_3; VEC_COMPONENT; REAL_SUB_RZERO] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; COMPLEX_VEC_0] THEN + X_GEN_TAC `w:complex` THEN + ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[complex_div; COMPLEX_MUL_LZERO; ARG_0; REAL_LT_REFL]);; + +let VOLUME_FRUSTT_WEDGE = prove + (`!v0 v1:real^3 w1 w2 h a. + &0 < a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> bounded(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) /\ + measurable(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) /\ + measure(frustt v0 v1 h a INTER wedge v0 v1 w1 w2) = + if &1 <= a \/ h < &0 then &0 + else azim v0 v1 w1 w2 * ((h / a) pow 2 - h pow 2) * h / &6`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL + [ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2]; STRIP_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[VOLUME_FRUSTT_STRONG]; + MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN + ASM_SIMP_TAC[VOLUME_FRUSTT_STRONG; OPEN_WEDGE]; + ALL_TAC] THEN + REWRITE_TAC[frustt; frustum; rcone_gt; rconesgn; IN_ELIM_THM] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + GEOM_ORIGIN_TAC `v0:real^3` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + X_GEN_TAC `b:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE; WEDGE_SPECIAL_SCALE] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `!y:real^3. ~(norm(y) * norm(b % basis 3:real^3) * a + < y dot (b % basis 3))` + (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; MEASURABLE_EMPTY; + INTER_EMPTY; MEASURE_EMPTY]) THEN + REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; + DIMINDEX_3; ARITH] THEN + REWRITE_TAC[REAL_ARITH + `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DOT_BASIS; DOT_RMUL; DIMINDEX_3; ARITH] THEN + ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; + REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[REAL_ARITH `(&0 * x < y /\ u < v) /\ &0 < y /\ y < h <=> + &0 < y /\ y < h /\ u < v`] THEN + DISCH_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_ALT) THEN + EXISTS_TAC `3` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN + ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; SLICE_INTER; DIMINDEX_2; + DIMINDEX_3; ARITH] THEN + SUBGOAL_THEN + `!t. slice 3 t {y:real^3 | norm y * a < y$3 /\ &0 < y$3 /\ y$3 < h} = + if t < h + then ball(vec 0:real^2,sqrt(inv(a pow 2) - &1) * t) + else {}` + (fun th -> ASM_SIMP_TAC[th; SLICE_SPECIAL_WEDGE]) + THENL + [REWRITE_TAC[EXTENSION] THEN + MAP_EVERY X_GEN_TAC [`t:real`; `z:real^2`] THEN + SIMP_TAC[SLICE_123; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; + VECTOR_3; DOT_3; GSYM DOT_2] THEN + ASM_CASES_TAC `t < h` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_BALL_0; IN_DELETE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= a /\ (a < t <=> u < v) ==> (a < t /\ &0 < t <=> u < v)`) THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN + SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN + ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_MUL; SQRT_POS_LT; REAL_POW_MUL; SQRT_POW_2; + REAL_LT_IMP_LE; REAL_LT_MUL_EQ] THEN + ASM_SIMP_TAC[real_div; REAL_LT_MUL_EQ; REAL_LT_INV_EQ] THEN + ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DOT_3; DOT_2; VECTOR_3; REAL_INV_POW] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN + GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o LAND_CONV o TOP_DEPTH_CONV) + [COND_RATOR; COND_RAND] THEN + REWRITE_TAC[INTER_EMPTY; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN + REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_OPEN_SECTOR_LT_GEN] THEN + REWRITE_TAC[COND_ID] THEN + SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN + ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; SQRT_POS_LT] THEN + ASM_SIMP_TAC[AZIM_SPECIAL_SCALE; AZIM_ARG; COLLINEAR_BASIS_3] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC + `\t. if &0 < t /\ t < h + then Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3)) / &2 * + (inv(a pow 2) - &1) * t pow 2 + else &0` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `t < h` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `&0 <= t <=> t = &0 \/ &0 < t`] THEN + ASM_CASES_TAC `t = &0` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_RZERO; SQRT_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_RZERO] THEN + ASM_SIMP_TAC[REAL_POW_MUL; SQRT_POW_2; REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN + COND_CASES_TAC THENL + [ASM_MESON_TAC[REAL_INTERVAL_EQ_EMPTY; HAS_REAL_INTEGRAL_EMPTY]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT])] THEN + ABBREV_TAC `g = Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN + MP_TAC(ISPECL + [`\t. g / &6 * (inv (a pow 2) - &1) * t pow 3`; + `\t. g / &2 * (inv (a pow 2) - &1) * t pow 2`; + `&0`; `h:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]);; + +(* ------------------------------------------------------------------------- *) +(* Wedge of a conic cap. *) +(* ------------------------------------------------------------------------- *) + +let VOLUME_CONIC_CAP_WEDGE_WEAK = prove + (`!v0 v1:real^3 w1 w2 r a. + &0 < a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ + measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ + measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) = + if &1 <= a \/ r < &0 then &0 + else azim v0 v1 w1 w2 / &3 * (&1 - a) * r pow 3`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `v1:real^3 = v0` THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; STRIP_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[VOLUME_CONIC_CAP_STRONG]; + MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN + ASM_SIMP_TAC[VOLUME_CONIC_CAP_STRONG; OPEN_WEDGE]; + ALL_TAC] THEN + REWRITE_TAC[conic_cap; rcone_gt; rconesgn; IN_ELIM_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] normball; GSYM ball] THEN + CONV_TAC(TOP_DEPTH_CONV let_CONV) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + GEOM_ORIGIN_TAC `v0:real^3` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; REAL_MUL_LZERO; DIST_0; real_gt] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + X_GEN_TAC `b:real` THEN + ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + SIMP_TAC[COLLINEAR_SPECIAL_SCALE; WEDGE_SPECIAL_SCALE] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `&1 <= a` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `!y:real^3. ~(norm(y) * norm(b % basis 3:real^3) * a + < y dot (b % basis 3))` + (fun th -> REWRITE_TAC[th; EMPTY_GSPEC; INTER_EMPTY; MEASURE_EMPTY; + MEASURABLE_EMPTY; BOUNDED_EMPTY; CONVEX_EMPTY]) THEN + REWRITE_TAC[REAL_NOT_LT] THEN X_GEN_TAC `y:real^3` THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_MUL; DOT_BASIS; NORM_BASIS; + DIMINDEX_3; ARITH] THEN + REWRITE_TAC[REAL_ARITH + `b * y <= n * (b * &1) * a <=> b * &1 * y <= b * a * n`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_POS; REAL_ABS_POS; COMPONENT_LE_NORM; DIMINDEX_3; ARITH]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + SIMP_TAC[DOT_RMUL; NORM_MUL; REAL_ABS_NORM; DOT_BASIS; + DIMINDEX_3; ARITH; NORM_BASIS] THEN + ONCE_REWRITE_TAC[REAL_ARITH `n * x * a:real = x * n * a`] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_MUL_RID; REAL_LT_LMUL_EQ; REAL_LT_MUL_EQ; NORM_POS_LT] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_LT_SQUARE] THEN + ASM_SIMP_TAC[REAL_POW_DIV; REAL_POW_LT; REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[INTER; REAL_MUL_LZERO; IN_BALL_0; IN_ELIM_THM] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_3; ARITH; + REAL_LT_IMP_NZ] THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x < r)`] THEN + REWRITE_TAC[EMPTY_GSPEC; MEASURE_EMPTY; MEASURABLE_EMPTY; + BOUNDED_EMPTY; CONVEX_EMPTY]; + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[REAL_NOT_LT])] THEN + STRIP_TAC THEN MATCH_MP_TAC(INST_TYPE [`:2`,`:M`] FUBINI_SIMPLE_ALT) THEN + EXISTS_TAC `3` THEN ASM_REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; ARITH] THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE; AZIM_SPECIAL_SCALE] THEN + ONCE_REWRITE_TAC[SET_RULE `{x | P x /\ x IN s} = {x | P x} INTER s`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; SLICE_INTER; DIMINDEX_2; + DIMINDEX_3; ARITH] THEN + RULE_ASSUM_TAC + (REWRITE_RULE[MATCH_MP COLLINEAR_SPECIAL_SCALE (ASSUME `~(b = &0)`)]) THEN + SUBGOAL_THEN `&0 < inv(a pow 2) - &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_INV_1_LT THEN + ASM_SIMP_TAC[REAL_POW_1_LT; REAL_LT_IMP_LE; ARITH; REAL_POW_LT]; + ALL_TAC] THEN + SUBGOAL_THEN + `!t. slice 3 t {y:real^3 | norm y < r /\ norm y * a < y$3} = + if &0 < t /\ t < r + then ball(vec 0:real^2,min (sqrt(r pow 2 - t pow 2)) + (t * sqrt(inv(a pow 2) - &1))) + else {}` + (fun th -> ASM_SIMP_TAC[th; SLICE_SPECIAL_WEDGE]) + THENL + [REWRITE_TAC[EXTENSION] THEN + MAP_EVERY X_GEN_TAC [`t:real`; `z:real^2`] THEN + SIMP_TAC[SLICE_123; DIMINDEX_2; DIMINDEX_3; ARITH; IN_ELIM_THM; + VECTOR_3; DOT_3; GSYM DOT_2] THEN + ASM_CASES_TAC `&0 < t` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `~(&0 < t) ==> &0 <= a ==> ~(a < t)`)) THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; REAL_LT_IMP_LE]] THEN + ASM_CASES_TAC `t < r` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + REWRITE_TAC[NOT_IN_EMPTY; DE_MORGAN_THM] THEN DISJ1_TAC THEN + REWRITE_TAC[NORM_LT_SQUARE; DE_MORGAN_THM] THEN DISJ2_TAC THEN + REWRITE_TAC[DOT_3; VECTOR_3] THEN + MATCH_MP_TAC(REAL_ARITH + `r <= t /\ &0 <= a /\ &0 <= b ==> ~(a + b + t < r)`) THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_POW_2] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[IN_BALL_0; REAL_LT_MIN] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN REWRITE_TAC[NORM_LT_SQUARE] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `t pow 2 < r pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT2 THEN REWRITE_TAC[ARITH] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_DIV; SQRT_POS_LT; REAL_LT_MUL; REAL_SUB_LT; + SQRT_POW_2; REAL_LT_IMP_LE; REAL_POW_MUL] THEN + REWRITE_TAC[DOT_2; DOT_3; VECTOR_3] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + b + c < d <=> a + b < d - c`] THEN + BINOP_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RATOR; COND_RAND] THEN + GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV o LAND_CONV o TOP_DEPTH_CONV) + [COND_RATOR; COND_RAND] THEN + REWRITE_TAC[INTER_EMPTY; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN + REWRITE_TAC[INTER; IN_BALL_0; IN_ELIM_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[COLLINEAR_BASIS_3]) THEN + ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_OPEN_SECTOR_LT_GEN] THEN + REWRITE_TAC[COND_ID] THEN + ASM_SIMP_TAC[REAL_LE_MIN; SQRT_POS_LE; REAL_LT_IMP_LE; REAL_LE_MUL; + REAL_POW_LE2; ARITH; REAL_SUB_LE; REAL_LT_MUL; SQRT_POS_LT] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL; HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_OPEN_INTERVAL] THEN + REWRITE_TAC[NORM_POW_2; DOT_3; VECTOR_3; DOT_2] THEN + ASM_SIMP_TAC[AZIM_ARG; COLLINEAR_BASIS_3] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(&1 - a) * az / &3 * r pow 3 = + az / &6 * (inv (a pow 2) - &1) * (a * r) pow 3 + + (az * &1 / &3 * (&1 - a) * r pow 3 - + az / &6 * (inv (a pow 2) - &1) * (a * r) pow 3)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN + EXISTS_TAC `a * r:real` THEN + REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_LT_IMP_LE] THEN + ABBREV_TAC `k = Arg(dropout 3 (w2:real^3) / dropout 3 (w1:real^3))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC + `\t. k * t pow 2 * (inv(a pow 2) - &1) / &2` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `t pow 2 * (inv(a pow 2) - &1) <= r pow 2 - t pow 2` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH `t * (a - &1) <= r - t <=> t * a <= r`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_POW_LT] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `t * sqrt(inv(a pow 2) - &1) <= sqrt(r pow 2 - t pow 2)` + (fun th -> SIMP_TAC[th; REAL_ARITH `a <= b ==> min b a = a`]) + THENL + [MATCH_MP_TAC REAL_POW_LE2_REV THEN EXISTS_TAC `2` THEN + REWRITE_TAC[ARITH] THEN + SUBGOAL_THEN `&0 <= r pow 2 - t pow 2` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= x ==> &0 <= a ==> &0 <= x`)) THEN + ASM_SIMP_TAC[REAL_POW_2; REAL_LE_MUL; REAL_LE_SQUARE; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[SQRT_POS_LE; REAL_POW_MUL; SQRT_POW_2; + REAL_LT_IMP_LE]]; + ASM_SIMP_TAC[REAL_POW_MUL; SQRT_POW_2; SQRT_POW_2; REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC]; + MP_TAC(ISPECL + [`\t. k / &6 * (inv (a pow 2) - &1) * t pow 3`; + `\t. k * t pow 2 * (inv (a pow 2) - &1) / &2`; + `&0`; `a * r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN EXISTS_TAC + `\t:real. k * (r pow 2 - t pow 2) / &2` THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `&0 <= t` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * r:real` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `a <= b /\ a pow 2 = x ==> x / &2 = (min a b pow 2) / &2`) THEN + SUBGOAL_THEN `&0 <= r pow 2 - t pow 2` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_SUB_LE] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2_REV THEN + EXISTS_TAC `2` THEN REWRITE_TAC[ARITH] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_POW_MUL; REAL_LE_MUL; SQRT_POS_LT; + REAL_LT_MUL; REAL_LT_IMP_LE; SQRT_POS_LE] THEN + REWRITE_TAC[REAL_ARITH `r - t <= t * (a - &1) <=> r <= t * a`] THEN + REWRITE_TAC[REAL_INV_POW; GSYM REAL_POW_MUL] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN + ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL + [`\t. k / &2 * (r pow 2 * t - t pow 3 / &3)`; + `\t. k * (r pow 2 - t pow 2) / &2`; + `a * r:real`; `r:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `a * r <= r <=> &0 <= r * (&1 - a)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RING; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD]]]);; + +let BOUNDED_CONIC_CAP_WEDGE = prove + (`!v0 v1:real^3 w1 w2 r a. + bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `conic_cap (v0:real^3) v1 r a` THEN + REWRITE_TAC[BOUNDED_CONIC_CAP] THEN SET_TAC[]);; + +let MEASURABLE_CONIC_CAP_WEDGE = prove + (`!v0 v1:real^3 w1 w2 r a. + measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN + REWRITE_TAC[BOUNDED_CONIC_CAP; MEASURABLE_CONIC_CAP; OPEN_WEDGE]);; + +let VOLUME_CONIC_CAP_COMPL = prove + (`!v0 v1:real^3 w1 w2 r a. + &0 <= r + ==> measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) + + measure(conic_cap v0 v1 r (--a) INTER wedge v0 v1 w1 w2) = + azim v0 v1 w1 w2 * &2 * r pow 3 / &3`, + let lemma = prove + (`!f:real^N->real^N s t t' u. + measurable(s) /\ measurable(t) /\ measurable(u) /\ + orthogonal_transformation f /\ + s SUBSET u /\ t' SUBSET u /\ s INTER t' = {} /\ + negligible(u DIFF (s UNION t')) /\ + ((!y. ?x. f x = y) ==> IMAGE f t = t') + ==> measure s + measure t = measure u`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `orthogonal_transformation(f:real^N->real^N)` THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `measure(s:real^N->bool) + measure(t':real^N->bool)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_ORTHOGONAL_IMAGE_EQ]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_DISJOINT_UNION o + lhand o snd) THEN + ASM_REWRITE_TAC[DISJOINT] THEN ANTS_TAC THENL + [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE; ORTHOGONAL_TRANSFORMATION_LINEAR]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in + REWRITE_TAC[conic_cap; rcone_gt; NORMBALL_BALL; rconesgn] THEN + GEOM_ORIGIN_TAC `v0:real^3` THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0; real_gt] THEN + GEOM_BASIS_MULTIPLE_TAC 3 `v1:real^3` THEN + X_GEN_TAC `v1:real` THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_LZERO; WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN + REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM VOLUME_BALL_WEDGE] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `collinear {vec 0:real^3,v1 % basis 3,w1}` THENL + [ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN + REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM VOLUME_BALL_WEDGE] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `collinear {vec 0:real^3,v1 % basis 3,w2}` THENL + [ASM_SIMP_TAC[WEDGE_DEGENERATE; AZIM_DEGENERATE] THEN + REWRITE_TAC[INTER_EMPTY; MEASURE_EMPTY] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[WEDGE_SPECIAL_SCALE] THEN + MAP_EVERY UNDISCH_TAC + [`~collinear{vec 0:real^3,v1 % basis 3,w1}`; + `~collinear{vec 0:real^3,v1 % basis 3,w2}`] THEN + ASM_SIMP_TAC[COLLINEAR_SPECIAL_SCALE] THEN REPEAT DISCH_TAC THEN + REWRITE_TAC[NORM_MUL; DOT_RMUL] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH + `&0 < v1 ==> n * (abs v1 * y) * a = v1 * n * y * a`] THEN + MATCH_MP_TAC lemma THEN + MP_TAC(ISPECL + [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`; + `r:real`; `a:real`] MEASURABLE_CONIC_CAP_WEDGE) THEN + MP_TAC(ISPECL + [`vec 0:real^3`; `basis 3:real^3`; `w1:real^3`; `w2:real^3`; + `r:real`; `--a:real`] MEASURABLE_CONIC_CAP_WEDGE) THEN + REWRITE_TAC[conic_cap; rcone_gt; NORMBALL_BALL; rconesgn] THEN + REWRITE_TAC[VECTOR_SUB_RZERO; DIST_0; real_gt] THEN + REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[MEASURABLE_BALL_WEDGE] THEN + SIMP_TAC[NORM_BASIS; DOT_BASIS; DIMINDEX_3; ARITH; REAL_MUL_LID] THEN + EXISTS_TAC `(\x. vector[x$1; x$2; --(x$3)]):real^3->real^3` THEN + EXISTS_TAC `(ball(vec 0,r) INTER {x | norm x * a > x$3}) INTER + wedge (vec 0:real^3) (basis 3) w1 w2` THEN + CONJ_TAC THENL + [REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; linear] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3; vector_norm; DOT_3; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE AP_TERM_TAC) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_ELIM_THM; real_gt] THEN + MESON_TAC[REAL_LT_ANTISYM]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `rcone_eq (vec 0:real^3) (basis 3) a` THEN + SIMP_TAC[NEGLIGIBLE_RCONE_EQ; BASIS_NONZERO; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[SUBSET; rcone_eq; rconesgn; VECTOR_SUB_RZERO; DIST_0] THEN + SIMP_TAC[DOT_BASIS; NORM_BASIS; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_INTER; IN_UNION] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTER; IN_BALL_0; IN_ELIM_THM; VECTOR_3] THEN + X_GEN_TAC `x:real^3` THEN + SUBGOAL_THEN `norm(vector [x$1; x$2; --(x$3)]:real^3) = norm(x:real^3)` + SUBST1_TAC THENL + [REWRITE_TAC[NORM_EQ; DOT_3; VECTOR_3] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `n * a > --x <=> n * --a < x`] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> b')) ==> (a /\ b <=> a /\ b')`) THEN + STRIP_TAC THEN + REWRITE_TAC[COLLINEAR_BASIS_3; wedge; AZIM_ARG] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN `(dropout 3 :real^3->real^2) (vector [x$1; x$2; --(x$3)]) = + (dropout 3 :real^3->real^2) x` + (fun th -> REWRITE_TAC[th]) THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; dropout; LAMBDA_BETA; ARITH; + VECTOR_3]);; + +let VOLUME_CONIC_CAP_WEDGE_MEDIUM = prove + (`!v0 v1:real^3 w1 w2 r a. + &0 <= a /\ ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ + measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ + measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) = + if &1 < abs a \/ r < &0 then &0 + else azim v0 v1 w1 w2 / &3 * (&1 - a) * r pow 3`, + REWRITE_TAC[BOUNDED_CONIC_CAP_WEDGE; MEASURABLE_CONIC_CAP_WEDGE] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `&0 <= a ==> &0 < a \/ a = &0`)) + THENL + [ASM_SIMP_TAC[VOLUME_CONIC_CAP_WEDGE_WEAK] THEN + REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `a = &1` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + COND_CASES_TAC THENL + [REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN + SUBGOAL_THEN `ball(v0:real^3,r) = {}` + (fun th -> SIMP_TAC[th; INTER_EMPTY; MEASURE_EMPTY]) THEN + REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`; + `r:real`; `&0`] VOLUME_CONIC_CAP_COMPL) THEN + REWRITE_TAC[REAL_NEG_0] THEN ASM_REAL_ARITH_TAC]);; + +let VOLUME_CONIC_CAP_WEDGE = prove + (`!v0 v1:real^3 w1 w2 r a. + ~collinear {v0,v1,w1} /\ ~collinear {v0,v1,w2} + ==> bounded(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ + measurable(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) /\ + measure(conic_cap v0 v1 r a INTER wedge v0 v1 w1 w2) = + if &1 < a \/ r < &0 then &0 + else azim v0 v1 w1 w2 / &3 * (&1 - max a (-- &1)) * r pow 3`, + REWRITE_TAC[BOUNDED_CONIC_CAP_WEDGE; MEASURABLE_CONIC_CAP_WEDGE] THEN + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `&0 <= a` THEN + ASM_SIMP_TAC[VOLUME_CONIC_CAP_WEDGE_MEDIUM; + REAL_ARITH `&0 <= a ==> abs a = a /\ max a (-- &1) = a`] THEN + MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`; + `r:real`; `--a:real`] VOLUME_CONIC_CAP_WEDGE_MEDIUM) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`v0:real^3`; `v1:real^3`; `w1:real^3`; `w2:real^3`; + `r:real`; `a:real`] VOLUME_CONIC_CAP_COMPL) THEN + ASM_CASES_TAC `r < &0` THENL + [REWRITE_TAC[conic_cap; NORMBALL_BALL] THEN + SUBGOAL_THEN `ball(v0:real^3,r) = {}` + (fun th -> SIMP_TAC[th; INTER_EMPTY; MEASURE_EMPTY]) THEN + REWRITE_TAC[BALL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LT; REAL_ABS_NEG] THEN + ASM_SIMP_TAC[REAL_ARITH `~(&0 <= a) ==> ~(&1 < a) /\ abs a = --a`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[REAL_ARITH `&1 < --a ==> max a (-- &1) = -- &1`] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ARITH `~(&1 < --a) ==> max a (-- &1) = a`] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Precise formulation of Flyspeck volume properties. *) +(* ------------------------------------------------------------------------- *) + +(*** Might be preferable to switch + *** + *** normball z r -> ball(z,r) + *** rect a b -> interval(a,b) + *** + *** to fit existing libraries. But I left this alone for now, + *** to be absolutely sure I didn't introduce new errors. + *** I also maintain + *** + *** NULLSET -> negligible + *** vol -> measure + *** + *** as interface maps for the real^3 case. + ***) + +let cone = new_definition `cone v S:real^A->bool = affsign sgn_ge {v} S`;; + +(*** JRH: should we exclude v for S = {}? Make it always open ***) + +let cone0 = new_definition `cone0 v S:real^A->bool = affsign sgn_gt {v} S`;; + +(*** JRH changed from cone to cone0 ***) + +let solid_triangle = new_definition + `solid_triangle v0 S r = normball v0 r INTER cone0 v0 S`;; + +let rect = new_definition + `rect (a:real^3) (b:real^3) = + {(v:real^3) | !i. (a$i < v$i /\ v$i < b$i )}`;; + +let RECT_INTERVAL = prove + (`!a b. rect a b = interval(a,b)`, + REWRITE_TAC[rect; EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN + MESON_TAC[FINITE_INDEX_INRANGE]);; + +let RCONE_GE_GT = prove + (`rcone_ge z w h = + rcone_gt z w h UNION + { x | (x - z) dot (w - z) = norm(x - z) * norm(w - z) * h}`, + REWRITE_TAC[rcone_ge; rcone_gt; rconesgn] THEN + REWRITE_TAC[dist; EXTENSION; IN_UNION; NORM_SUB; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let RCONE_GT_GE = prove + (`rcone_gt z w h = + rcone_ge z w h DIFF + { x | (x - z) dot (w - z) = norm(x - z) * norm(w - z) * h}`, + REWRITE_TAC[rcone_ge; rcone_gt; rconesgn] THEN + REWRITE_TAC[dist; EXTENSION; IN_DIFF; NORM_SUB; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +override_interface("NULLSET",`negligible:(real^3->bool)->bool`);; +override_interface("vol",`measure:(real^3->bool)->real`);; + +let is_sphere= new_definition + `is_sphere x=(?(v:real^3)(r:real). (r> &0)/\ (x={w:real^3 | norm (w-v)= r}))`;; + +let c_cone = new_definition + `c_cone (v,w:real^3, r:real)= + {x:real^3 | ((x-v) dot w = norm (x-v)* norm w* r)}`;; + +(*** JRH added the condition ~(w = 0), or the cone is all of space ***) + +let circular_cone =new_definition + `circular_cone (V:real^3-> bool)= + (? (v,w:real^3)(r:real). ~(w = vec 0) /\ V = c_cone (v,w,r))`;; + +let NULLSET_RULES = prove + (`(!P. ((plane P)\/ (is_sphere P) \/ (circular_cone P)) ==> NULLSET P) /\ + (!(s:real^3->bool) t. (NULLSET s /\ NULLSET t) ==> NULLSET (s UNION t))`, + SIMP_TAC[NEGLIGIBLE_UNION] THEN + X_GEN_TAC `s:real^3->bool` THEN STRIP_TAC THENL + [MATCH_MP_TAC COPLANAR_IMP_NEGLIGIBLE THEN + SIMP_TAC[COPLANAR; DIMINDEX_3; ARITH] THEN ASM_MESON_TAC[SUBSET_REFL]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [is_sphere]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[GSYM dist] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [circular_cone]) THEN + REWRITE_TAC[EXISTS_PAIRED_THM; c_cone] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`w + v:real^3`; `v:real^3`; `r:real`] + NEGLIGIBLE_RCONE_EQ) THEN + ASM_REWRITE_TAC[rcone_eq; rconesgn] THEN + REWRITE_TAC[dist; VECTOR_ARITH `(w + v) - v:real^N = w`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `w + v:real^N = v <=> w = vec 0`]]);; + +(*** JRH added &0 < a for frustum; otherwise it's in general unbounded ***) + +let primitive = new_definition `primitive (C:real^3->bool) = + ((?v0 v1 v2 v3 r. (C = solid_triangle v0 {v1,v2,v3} r)) \/ + (?v0 v1 v2 v3. (C = conv0 {v0,v1,v2,v3})) \/ + (?v0 v1 v2 v3 h a. &0 < a /\ + (C = frustt v0 v1 h a INTER wedge v0 v1 v2 v3)) \/ + (?v0 v1 v2 v3 r c. (C = conic_cap v0 v1 r c INTER wedge v0 v1 v2 v3)) \/ + (?a b. (C = rect a b)) \/ + (?t r. (C = ellipsoid t r)) \/ + (?v0 v1 v2 v3 r. (C = normball v0 r INTER wedge v0 v1 v2 v3)))`;; + +let MEASURABLE_RULES = prove + (`(!C. primitive C ==> measurable C) /\ + (!Z. NULLSET Z ==> measurable Z) /\ + (!X t. measurable X ==> (measurable (IMAGE (scale t) X))) /\ + (!X v. measurable X ==> (measurable (IMAGE ((+) v) X))) /\ + (!(s:real^3->bool) t. (measurable s /\ measurable t) + ==> measurable (s UNION t)) /\ + (!(s:real^3->bool) t. (measurable s /\ measurable t) + ==> measurable (s INTER t)) /\ + (!(s:real^3->bool) t. (measurable s /\ measurable t) + ==> measurable (s DIFF t))`, + SIMP_TAC[MEASURABLE_UNION; MEASURABLE_INTER; MEASURABLE_DIFF] THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] MEASURABLE_TRANSLATION] THEN + SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN + CONJ_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC [`X:real^3->bool`; `t:real^3`] THEN + REWRITE_TAC[HAS_MEASURE_MEASURE] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_STRETCH) THEN + DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i`) THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; scale; CART_EQ; LAMBDA_BETA; + DIMINDEX_3; VECTOR_3; FORALL_3]] THEN + X_GEN_TAC `C:real^3->bool` THEN REWRITE_TAC[primitive] THEN + REWRITE_TAC[NORMBALL_BALL; RECT_INTERVAL] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN MP_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[solid_triangle; NORMBALL_BALL; cone0; GSYM aff_gt_def] THEN + REWRITE_TAC[MEASURABLE_BALL_AFF_GT]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_CONV0 THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]; + MAP_EVERY X_GEN_TAC + [`v0:real^3`; `v1:real^3`; `v2:real^3`; `v3:real^3`; + `h:real`; `a:real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN + ASM_CASES_TAC `collinear {v0:real^3, v1, v2}` THENL + [ASM_SIMP_TAC[WEDGE_DEGENERATE; INTER_EMPTY; MEASURABLE_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `collinear {v0:real^3, v1, v3}` THENL + [ASM_SIMP_TAC[WEDGE_DEGENERATE; INTER_EMPTY; MEASURABLE_EMPTY]; + ALL_TAC] THEN + ASM_SIMP_TAC[VOLUME_FRUSTT_WEDGE]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_INTER_OPEN THEN + REWRITE_TAC[MEASURABLE_CONIC_CAP; BOUNDED_CONIC_CAP; OPEN_WEDGE]; + SIMP_TAC[MEASURABLE_INTERVAL]; + SIMP_TAC[MEASURABLE_ELLIPSOID]; + SIMP_TAC[MEASURABLE_BALL_WEDGE]]);; + +let vol_solid_triangle = new_definition `vol_solid_triangle v0 v1 v2 v3 r = + let a123 = dihV v0 v1 v2 v3 in + let a231 = dihV v0 v2 v3 v1 in + let a312 = dihV v0 v3 v1 v2 in + (a123 + a231 + a312 - pi)*(r pow 3)/(&3)`;; + +let vol_frustt_wedge = new_definition `vol_frustt_wedge v0 v1 v2 v3 h a = + (azim v0 v1 v2 v3)*(h pow 3)*(&1/(a*a) - &1)/(&6)`;; + +let vol_conic_cap_wedge = new_definition `vol_conic_cap_wedge v0 v1 v2 v3 r c = + (azim v0 v1 v2 v3)*(&1 - c)*(r pow 3)/(&3)`;; + +(*** JRH corrected delta_x x12 x13 x14 x34 x24 x34 ***) +(*** to delta_x x12 x13 x14 x34 x24 x23 ***) + +let vol_conv = new_definition `vol_conv v1 v2 v3 v4 = + let x12 = dist(v1,v2) pow 2 in + let x13 = dist(v1,v3) pow 2 in + let x14 = dist(v1,v4) pow 2 in + let x23 = dist(v2,v3) pow 2 in + let x24 = dist(v2,v4) pow 2 in + let x34 = dist(v3,v4) pow 2 in + sqrt(delta_x x12 x13 x14 x34 x24 x23)/(&12)`;; + +let vol_rect = new_definition `vol_rect a b = + if (a$1 < b$1) /\ (a$2 < b$2) /\ (a$3 < b$3) then + (b$3-a$3)*(b$2-a$2)*(b$1-a$1) else &0`;; + +let vol_ball_wedge = new_definition `vol_ball_wedge v0 v1 v2 v3 r = + (azim v0 v1 v2 v3)*(&2)*(r pow 3)/(&3)`;; + +let SDIFF = new_definition `SDIFF X Y = (X DIFF Y) UNION (Y DIFF X)`;; + +(*** JRH added the hypothesis "measurable" to the first one ***) +(*** Could change the definition to make this hold anyway ***) + +(*** JRH changed solid triangle hypothesis to ~coplanar{...} ***) +(*** since the current condition is not enough in general ***) + +let volume_props = prove + (`(!C. measurable C ==> vol C >= &0) /\ + (!Z. NULLSET Z ==> (vol Z = &0)) /\ + (!X Y. measurable X /\ measurable Y /\ NULLSET (SDIFF X Y) + ==> (vol X = vol Y)) /\ + (!X t. (measurable X) /\ (measurable (IMAGE (scale t) X)) + ==> (vol (IMAGE (scale t) X) = abs(t$1 * t$2 * t$3)*vol(X))) /\ + (!X v. measurable X ==> (vol (IMAGE ((+) v) X) = vol X)) /\ + (!v0 v1 v2 v3 r. (r > &0) /\ ~coplanar{v0,v1,v2,v3} + ==> vol (solid_triangle v0 {v1,v2,v3} r) = + vol_solid_triangle v0 v1 v2 v3 r) /\ + (!v0 v1 v2 v3. vol(conv0 {v0,v1,v2,v3}) = vol_conv v0 v1 v2 v3) /\ + (!v0 v1 v2 v3 h a. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\ + (h >= &0) /\ (a > &0) /\ (a <= &1) + ==> vol(frustt v0 v1 h a INTER wedge v0 v1 v2 v3) = + vol_frustt_wedge v0 v1 v2 v3 h a) /\ + (!v0 v1 v2 v3 r c. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\ + (r >= &0) /\ (c >= -- (&1)) /\ (c <= &1) + ==> (vol(conic_cap v0 v1 r c INTER wedge v0 v1 v2 v3) = + vol_conic_cap_wedge v0 v1 v2 v3 r c)) /\ + (!(a:real^3) (b:real^3). vol(rect a b) = vol_rect a b) /\ + (!v0 v1 v2 v3 r. ~(collinear {v0,v1,v2}) /\ ~(collinear {v0,v1,v3}) /\ + (r >= &0) + ==> (vol(normball v0 r INTER wedge v0 v1 v2 v3) = + vol_ball_wedge v0 v1 v2 v3 r))`, + SIMP_TAC[MEASURE_POS_LE; real_ge; real_gt] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE]; + MAP_EVERY X_GEN_TAC [`s:real^3->bool`; `t:real^3->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REWRITE_TAC[SDIFF] THEN SET_TAC[]; + MAP_EVERY X_GEN_TAC [`X:real^3->bool`; `t:real^3`] THEN + REWRITE_TAC[HAS_MEASURE_MEASURE] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_STRETCH o CONJUNCT1) THEN + DISCH_THEN(MP_TAC o SPEC `\i. (t:real^3)$i`) THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[DIMINDEX_3; PRODUCT_3] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; scale; CART_EQ; LAMBDA_BETA; + DIMINDEX_3; VECTOR_3; FORALL_3]; + REWRITE_TAC[REWRITE_RULE[ETA_AX] MEASURE_TRANSLATION]; + REPEAT STRIP_TAC THEN + REWRITE_TAC[solid_triangle; vol_solid_triangle; NORMBALL_BALL] THEN + REWRITE_TAC[cone0; GSYM aff_gt_def] THEN + MATCH_MP_TAC VOLUME_SOLID_TRIANGLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[vol_conv; VOLUME_OF_TETRAHEDRON]; + SIMP_TAC[VOLUME_FRUSTT_WEDGE; vol_frustt_wedge] THEN + SIMP_TAC[REAL_ARITH `&0 <= h ==> ~(h < &0)`] THEN + SIMP_TAC[REAL_ARITH `a <= &1 ==> (&1 <= a <=> a = &1)`] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + SIMP_TAC[VOLUME_CONIC_CAP_WEDGE; vol_conic_cap_wedge] THEN + SIMP_TAC[REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN + SIMP_TAC[REAL_ARITH `c <= &1 ==> ~(&1 < c)`] THEN + ASM_SIMP_TAC[REAL_ARITH `-- &1 <= c ==> max c (-- &1) = c`] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[vol_rect; RECT_INTERVAL; MEASURE_INTERVAL] THEN + REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[DIMINDEX_3; FORALL_3; PRODUCT_3] THEN + MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`] THEN + REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `(a:real^3)$1 = (b:real^3)$1` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_SUB_REFL; COND_ID] THEN + ASM_CASES_TAC `(a:real^3)$2 = (b:real^3)$2` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_SUB_REFL; COND_ID] THEN + ASM_CASES_TAC `(a:real^3)$3 = (b:real^3)$3` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_SUB_REFL; COND_ID] THEN + REWRITE_TAC[REAL_MUL_AC]; + SIMP_TAC[VOLUME_BALL_WEDGE; NORMBALL_BALL; vol_ball_wedge]]);; + +(* ------------------------------------------------------------------------- *) +(* Additional results on polyhedra and relation to fans. *) +(* ------------------------------------------------------------------------- *) + +let POLYHEDRON_COLLINEAR_FACES_STRONG = prove + (`!P:real^N->bool f f' p q s t. + polyhedron P /\ vec 0 IN relative_interior P /\ + f face_of P /\ ~(f = P) /\ f' face_of P /\ ~(f' = P) /\ + p IN f /\ q IN f' /\ s > &0 /\ t > &0 /\ s % p = t % q + ==> s = t`, + ONCE_REWRITE_TAC[MESON[] + `(!P f f' p q s t. Q P f f' p q s t) <=> + (!s t P f f' p q. Q P f f' p q s t)`] THEN + MATCH_MP_TAC REAL_WLOG_LT THEN + REWRITE_TAC[real_gt] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `F ==> p`) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv s):real^N->real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[VECTOR_MUL_LID; GSYM real_div] THEN + ABBREV_TAC `u:real = t / s` THEN + SUBGOAL_THEN `&0 < u /\ &1 < u` MP_TAC THENL + [EXPAND_TAC "u" THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID]; + ALL_TAC] THEN + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) + [`s < t`; `&0 < s`; `&0 < t`; `t:real / s = u`] THEN + SPEC_TAC(`u:real`,`t:real`) THEN GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + SUBGOAL_THEN `?g:real^N->bool. g facet_of P /\ f' SUBSET g` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC FACE_OF_POLYHEDRON_SUBSET_FACET THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~((vec 0:real^N) IN g)` ASSUME_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPECL [`P:real^N->bool`; `g:real^N->bool`; `P:real^N->bool`] + SUBSET_OF_FACE_OF) THEN + ASM_REWRITE_TAC[SUBSET_REFL; NOT_IMP] THEN CONJ_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[facet_of]; ASM SET_TAC[]]; + ASM_MESON_TAC[facet_of; FACET_OF_REFL; + SUBSET_ANTISYM; FACE_OF_IMP_SUBSET]]; + ALL_TAC] THEN + SUBGOAL_THEN `(g:real^N->bool) face_of P` MP_TAC THENL + [ASM_MESON_TAC[facet_of]; ALL_TAC] THEN + REWRITE_TAC[face_of] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `t % q:real^N`; `q:real^N`]) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; + ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; + ASM_MESON_TAC[FACE_OF_IMP_SUBSET; SUBSET]; + ALL_TAC] THEN + EXPAND_TAC "p" THEN REWRITE_TAC[IN_SEGMENT] THEN CONJ_TAC THENL + [CONV_TAC(RAND_CONV SYM_CONV) THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ] THEN ASM SET_TAC[]; + EXISTS_TAC `inv t:real` THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_INV_LT_1] THEN + EXPAND_TAC "p" THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN VECTOR_ARITH_TAC]);; + +let POLYHEDRON_COLLINEAR_FACES = prove + (`!P:real^N->bool f f' p q s t. + polyhedron P /\ vec 0 IN interior P /\ + f face_of P /\ ~(f = P) /\ f' face_of P /\ ~(f' = P) /\ + p IN f /\ q IN f' /\ s > &0 /\ t > &0 /\ s % p = t % q + ==> s = t`, + MESON_TAC[POLYHEDRON_COLLINEAR_FACES_STRONG; + INTERIOR_SUBSET_RELATIVE_INTERIOR; SUBSET]);; + +let vertices = new_definition + `vertices s = {x:real^N | x extreme_point_of s}`;; + +let edges = new_definition + `edges s = {{v,w} | segment[v,w] edge_of s}`;; + +let VERTICES_TRANSLATION = prove + (`!a s. vertices (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (vertices s)`, + REWRITE_TAC[vertices] THEN GEOM_TRANSLATE_TAC[]);; + +let VERTICES_LINEAR_IMAGE = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> vertices(IMAGE f s) = IMAGE f (vertices s)`, + REWRITE_TAC[vertices; EXTREME_POINTS_OF_LINEAR_IMAGE]);; + +let EDGES_TRANSLATION = prove + (`!a s. edges (IMAGE (\x. a + x) s) = IMAGE (IMAGE (\x. a + x)) (edges s)`, + REWRITE_TAC[edges] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);; + +let EDGES_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> edges(IMAGE f s) = IMAGE (IMAGE f) (edges s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[edges] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN + SUBGOAL_THEN `?v w. x = (f:real^M->real^N) v /\ y = f w` MP_TAC THENL + [ASM_MESON_TAC[ENDS_IN_SEGMENT; EDGE_OF_IMP_SUBSET; SUBSET; IN_IMAGE]; + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC)]; + MAP_EVERY X_GEN_TAC [`v:real^M`; `w:real^M`] THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`(f:real^M->real^N) v`; `(f:real^M->real^N) w`]] THEN + REWRITE_TAC[IMAGE_CLAUSES] THEN + ASM_MESON_TAC[EDGE_OF_LINEAR_IMAGE; CLOSED_SEGMENT_LINEAR_IMAGE]);; + +add_translation_invariants [VERTICES_TRANSLATION; EDGES_TRANSLATION];; +add_linear_invariants [VERTICES_LINEAR_IMAGE; EDGES_LINEAR_IMAGE];; + +(*** Correspondence with Flypaper: + +Definition 4.5: IS_AFFINE_HULL + affine / hull + aff_dim + AFF_DIM_EMPTY + +Definition 4.6 : IN_INTERIOR + IN_RELATIVE_INTERIOR + CLOSURE_APPROACHABLE + (Don't have definition of relative boundary, but several + theorems use closure s DIFF relative_interior s.) + +Definition 4.7: face_of + extreme_point_of (presumably it's meant to be the point not + the singleton set, which the definition literally gives) + facet_of + edge_of + (Don't have a definition of "proper"; I just use + ~(f = {}) and/or ~(f = P) as needed.) + +Lemma 4.18: KREIN_MILMAN_MINKOWSKI + +Definition 4.8: polyhedron + vertices + +Lemma 4.19: AFFINE_IMP_POLYHEDRON + +Lemma 4.20 (i): FACET_OF_POLYHEDRON_EXPLICIT + +Lemma 4.20 (ii): Direct consequence of RELATIVE_INTERIOR_POLYHEDRON + +Lemma 4.20 (iii): FACE_OF_POLYHEDRON_EXPLICIT / FACE_OF_POLYHEDRON + +Lemma 4.20 (iv): FACE_OF_TRANS + +Lemma 4.20 (v): EXTREME_POINT_OF_FACE + +Lemma 4.20 (vi): FACE_OF_EQ + +Corr. 4.7: FACE_OF_POLYHEDRON_POLYHEDRON + +Lemma 4.21: POLYHEDRON_COLLINEAR_FACES + +Def 4.9: vertices + edges + +****) + +(* ------------------------------------------------------------------------- *) +(* Temporary backwards-compatible fix for introduction of "sphere" and *) +(* "relative_frontier". *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_SPHERE = + REWRITE_RULE[sphere; NORM_ARITH `dist(a:real^N,b) = norm(b - a)`] + COMPACT_SPHERE;; + +let FRONTIER_CBALL = REWRITE_RULE[sphere] FRONTIER_CBALL;; + +let NEGLIGIBLE_SPHERE = REWRITE_RULE[sphere] NEGLIGIBLE_SPHERE;; + +let RELATIVE_FRONTIER_OF_POLYHEDRON = RELATIVE_BOUNDARY_OF_POLYHEDRON;; + +(* ------------------------------------------------------------------------- *) +(* Also, the finiteness hypothesis was removed from this theorem. *) +(* Put back the old version since that might break some proofs. *) +(* ------------------------------------------------------------------------- *) + +let SUM_POS_LE = prove + (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f(x)) ==> &0 <= sum s f`, + REWRITE_TAC[REWRITE_RULE[SUM_0] (ISPEC `\x. &0` SUM_LE)]);; + +(* ------------------------------------------------------------------------- *) +(* Also, the definition of sqrt was totalized, so keep old theorems *) +(* that have more hypotheses than the curren ones. *) +(* ------------------------------------------------------------------------- *) + +let SQRT_MUL = prove + (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x * y) = sqrt x * sqrt y`, + MESON_TAC[SQRT_MUL]);; + +let SQRT_INV = prove + (`!x. &0 <= x ==> (sqrt (inv x) = inv(sqrt x))`, + MESON_TAC[SQRT_INV]);; + +let SQRT_DIV = prove + (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x / y) = sqrt x / sqrt y`, + MESON_TAC[SQRT_DIV]);; + +let SQRT_LT_0 = prove + (`!x. &0 <= x ==> (&0 < sqrt x <=> &0 < x)`, + MESON_TAC[SQRT_LT_0]);; + +let SQRT_EQ_0 = prove + (`!x. &0 <= x ==> ((sqrt x = &0) <=> (x = &0))`, + MESON_TAC[SQRT_EQ_0]);; + +let SQRT_MONO_LT = prove + (`!x y. &0 <= x /\ x < y ==> sqrt(x) < sqrt(y)`, + MESON_TAC[SQRT_MONO_LT]);; + +let SQRT_MONO_LE = prove + (`!x y. &0 <= x /\ x <= y ==> sqrt(x) <= sqrt(y)`, + MESON_TAC[SQRT_MONO_LE]);; + +let SQRT_MONO_LT_EQ = prove + (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) < sqrt(y) <=> x < y)`, + MESON_TAC[SQRT_MONO_LT_EQ]);; + +let SQRT_MONO_LE_EQ = prove + (`!x y. &0 <= x /\ &0 <= y ==> (sqrt(x) <= sqrt(y) <=> x <= y)`, + MESON_TAC[SQRT_MONO_LE_EQ]);; + +let SQRT_INJ = prove + (`!x y. &0 <= x /\ &0 <= y ==> ((sqrt(x) = sqrt(y)) <=> (x = y))`, + MESON_TAC[SQRT_INJ]);; + +let REAL_LE_LSQRT = prove + (`!x y. &0 <= x /\ &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, + MESON_TAC[REAL_LE_LSQRT]);; + +let REAL_LT_LSQRT = prove + (`!x y. &0 <= x /\ &0 <= y /\ x < y pow 2 ==> sqrt x < y`, + MESON_TAC[REAL_LT_LSQRT]);; + +(* ------------------------------------------------------------------------- *) +(* Fix the congruence rules as expected in Flyspeck. *) +(* Should exclude 6 recent mixed real/vector limit results. *) +(* ------------------------------------------------------------------------- *) + +let bcs = + [`(p <=> p') ==> (p' ==> (q <=> q')) ==> (p ==> q <=> p' ==> q')`; + `(g <=> g') + ==> (g' ==> t = t') + ==> (~g' ==> e = e') + ==> (if g then t else e) = (if g' then t' else e')`; + `(!x. p x ==> f x = g x) ==> nsum {y | p y} (\i. f i) = nsum {y | p y} g`; + `(!i. a <= i /\ i <= b ==> f i = g i) + ==> nsum (a..b) (\i. f i) = nsum (a..b) g`; + `(!x. x IN s ==> f x = g x) ==> nsum s (\i. f i) = nsum s g`; + `(!x. p x ==> f x = g x) ==> sum {y | p y} (\i. f i) = sum {y | p y} g`; + `(!i. a <= i /\ i <= b ==> f i = g i) + ==> sum (a..b) (\i. f i) = sum (a..b) g`; + `(!x. x IN s ==> f x = g x) ==> sum s (\i. f i) = sum s g`; + `(!x. p x ==> f x = g x) ==> vsum {y | p y} (\i. f i) = vsum {y | p y} g`; + `(!i. a <= i /\ i <= b ==> f i = g i) + ==> vsum (a..b) (\i. f i) = vsum (a..b) g`; + `(!x. x IN s ==> f x = g x) ==> vsum s (\i. f i) = vsum s g`; + `(!x. p x ==> f x = g x) + ==> product {y | p y} (\i. f i) = product {y | p y} g`; + `(!i. a <= i /\ i <= b ==> f i = g i) + ==> product (a..b) (\i. f i) = product (a..b) g`; + `(!x. x IN s ==> f x = g x) ==> product s (\i. f i) = product s g`; + `(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (at a) <=> (g --> l) (at a))`; + `(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (at a within s) <=> (g --> l) (at a within s))`] +and equiv t1 t2 = can (term_match [] t1) t2 & can (term_match [] t2) t1 in +let congs' = + filter (fun th -> exists (equiv (concl th)) bcs) (basic_congs()) in +set_basic_congs congs';; diff --git a/Multivariate/gamma.ml b/Multivariate/gamma.ml new file mode 100644 index 0000000..b6be02f --- /dev/null +++ b/Multivariate/gamma.ml @@ -0,0 +1,3760 @@ +(* ========================================================================= *) +(* The real and complex gamma functions and Euler-Mascheroni constant. *) +(* ========================================================================= *) + +needs "Multivariate/cauchy.ml";; + +(* ------------------------------------------------------------------------- *) +(* Euler-Macheroni constant. *) +(* ------------------------------------------------------------------------- *) + +let euler_mascheroni = new_definition + `euler_mascheroni = + reallim sequentially (\n. sum(1..n) (\k. inv(&k)) - log(&n))`;; + +let EULER_MASCHERONI = prove + (`((\n. sum(1..n) (\k. inv(&k)) - log(&n)) ---> euler_mascheroni) + sequentially`, + REWRITE_TAC[euler_mascheroni; reallim] THEN CONV_TAC SELECT_CONV THEN + SUBGOAL_THEN + `real_summable (from 1) (\k. inv(&k) + (log(&k) - log(&(k + 1))))` + MP_TAC THENL + [MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN + EXISTS_TAC `\k. &2 / &k pow 2` THEN CONJ_TAC THENL + [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_SUMMABLE_LMUL THEN + MATCH_MP_TAC REAL_SUMMABLE_ZETA_INTEGER THEN REWRITE_TAC[LE_REFL]; + EXISTS_TAC `2` THEN REWRITE_TAC[GE; IN_FROM] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + (b - c):real = a - (c - b)`] THEN + ASM_SIMP_TAC[GSYM LOG_DIV; REAL_OF_NUM_LT; LE_1; + ARITH_RULE `0 < n + 1`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; REAL_FIELD + `&0 < n ==> (n + &1) / n = &1 + inv(n)`] THEN + MP_TAC(ISPECL [`1`; `Cx(inv(&n))`] TAYLOR_CLOG)]; + REWRITE_TAC[real_summable; real_sums; FROM_INTER_NUMSEG] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM) THEN + REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ARITH + `(x + y) - (x - z):real = y + z`] THEN + REWRITE_TAC[SUM_DIFFS; LOG_1; COND_RAND; COND_RATOR] THEN + REWRITE_TAC[REAL_ARITH `&0 - x + y = --(x - y)`] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. &2 / &n` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN + ASM_SIMP_TAC[REAL_ABS_NEG; GSYM LOG_DIV; REAL_OF_NUM_LT; LE_1; + ARITH_RULE `0 < n + 1`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; REAL_FIELD + `&0 < n ==> (n + &1) / n = &1 + inv(n)`] THEN + MP_TAC(ISPECL [`0`; `Cx(inv(&n))`] TAYLOR_CLOG); + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[REALLIM_1_OVER_N]]] THEN + REWRITE_TAC[GSYM CX_ADD; VSUM_SING_NUMSEG; COMPLEX_NORM_CX] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM; COMPLEX_DIV_1] THEN + ASM_SIMP_TAC[COMPLEX_POW_1; REAL_INV_LT_1; REAL_OF_NUM_LT; + ARITH_RULE `1 < n <=> 2 <= n`] THEN + REWRITE_TAC[COMPLEX_POW_2; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN + ASM_SIMP_TAC[COMPLEX_NEG_NEG; GSYM CX_LOG; REAL_LT_ADD; REAL_OF_NUM_LT; + LE_1; ARITH; REAL_LT_INV_EQ; GSYM CX_SUB] THEN + REWRITE_TAC[REAL_POW_1; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN REWRITE_TAC[REAL_ABS_SUB] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[real_div; REAL_POW_INV] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - &1 / n <=> inv(n) <= inv(&2)`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Simple-minded estimation of gamma using Euler-Maclaurin summation. *) +(* ------------------------------------------------------------------------- *) + +let LOG2_APPROX_40 = prove + (`abs(log(&2) - &381061692393 / &549755813888) <= inv(&2 pow 40)`, + MP_TAC(SPECL [`41`; `Cx(--inv(&2))`] TAYLOR_CLOG) THEN + SIMP_TAC[GSYM CX_DIV; GSYM CX_POW; GSYM CX_NEG; GSYM CX_ADD; GSYM CX_MUL; + VSUM_CX; COMPLEX_NORM_CX; GSYM CX_LOG; GSYM CX_SUB; + REAL_ARITH `&0 < &1 + --inv(&2)`] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `a * b / c:real = a / c * b`] THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + SIMP_TAC[LOG_INV; REAL_ARITH `&0 < &2`] THEN REAL_ARITH_TAC);; + +let EULER_MASCHERONI_APPROX_32 = prove + (`abs(euler_mascheroni - &2479122403 / &4294967296) <= inv(&2 pow 32)`, + let lemma1 = prove + (`!m n. 1 <= m /\ m <= n + ==> abs((sum (1..n) (\k. inv(&k)) - log(&n)) - + ((sum (1..m - 1) (\k. inv(&k)) - log(&m)) + + (inv(&m) + inv(&n)) / &2 + + &1 / &12 * (inv(&m pow 2) - inv(&n pow 2)) + + -- &1 / &120 * (inv(&m pow 4) - inv(&n pow 4)))) + <= inv(&60 * &m pow 5)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\k. inv(&k)`; `1:num`; `m - 1`; `n:num`] SUM_COMBINE_R) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= m ==> m - 1 + 1 = m`] THEN + MP_TAC(ISPECL + [`\n x. --(&1) pow n * &(FACT n) / x pow (n + 1)`; + `m:num`; `n:num`; `2`] REAL_EULER_MACLAURIN) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT + STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; ADD_SUB; REAL_MUL_RID; REAL_SUB_LZERO] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_POW_EQ_0; + REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_CASES_TAC `x = &0` THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM real_div; REAL_POW_POW] THEN + ASM_SIMP_TAC[REAL_DIV_POW2_ALT; ARITH_RULE `~((k + 1) * 2 < k)`] THEN + REWRITE_TAC[ARITH_RULE `(k + 1) * 2 - k = SUC(SUC k)`; + ARITH_RULE `(k + 1) + 1 = SUC(SUC k)`] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_MUL_RID] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[real_div] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM ADD1; FACT; REAL_OF_NUM_MUL; MULT_AC]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[real_div; REAL_MUL_LID; real_pow] THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV BERNOULLI_CONV) THEN + REWRITE_TAC[GSYM(BERNOULLI_CONV `bernoulli 5 x`)] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID; REAL_POW_1] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN DISCH_THEN SUBST1_TAC] THEN + MP_TAC(ISPECL [`\x. log x`; `\x:real. inv x`; `&m`; `&n`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL; GSYM REAL_OF_NUM_ADD] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE)] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `&1 / &120 * + abs(real_integral (real_interval[&m,&n]) + (\x. bernoulli 5 (frac x) * + --(&120 * inv(x pow 6))))` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `b * --(n * inv x):real = --n * b / x`] THEN + SUBGOAL_THEN + `(\x. bernoulli 5 (frac x) / x pow 6) + real_measurable_on real_interval[&m,&n]` + ASSUME_TAC THENL + [MATCH_MP_TAC + REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `integer` THEN + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN + SIMP_TAC[REAL_NEGLIGIBLE_COUNTABLE; COUNTABLE_INTEGER] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN REWRITE_TAC[IN] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC THEN ASM_REWRITE_TAC[REAL_POW_EQ_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x. inv(-- &60 * x pow 5)`; `\x. inv(&12 * x pow 6)`; + `&m`; `&n`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN `~(x = &0)` MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]; + REWRITE_TAC[REAL_INV_MUL; REAL_ARITH + `inv(-- &60) * x - inv(-- &60) * y = (y - x) / &60`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN DISCH_TAC] THEN + SUBGOAL_THEN + `!x. x IN real_interval[&m,&n] + ==> abs(bernoulli 5 (frac x) / x pow 6) <= inv(&12 * x pow 6)` + ASSUME_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_INV_MUL; real_div; REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`5`; `frac x`] BERNOULLI_BOUND) THEN + SIMP_TAC[IN_REAL_INTERVAL; FLOOR_FRAC; REAL_LT_IMP_LE] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[BERNOULLI_CONV `bernoulli 4 (&0)`] THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x. bernoulli 5 (frac x) / x pow 6) + real_integrable_on real_interval[&m,&n]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x:real. inv(&12 * x pow 6)` THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN + ASM_MESON_TAC[real_integrable_on]; + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; REAL_ABS_MUL; REAL_MUL_ASSOC]] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_MUL_LID] THEN + TRANS_TAC REAL_LE_TRANS + `real_integral (real_interval [&m,&n]) (\x. inv(&12 * x pow 6))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[real_integrable_on]; + FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[REAL_INV_MUL] THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH + `(x - y) / &60 <= inv(&60) * x <=> &0 <= y`] THEN + SIMP_TAC[REAL_POW_LE; REAL_POS]]) + and lemma2 = prove + (`!f g l m d e k. + (f ---> l) sequentially + ==> (g ---> m) sequentially /\ + eventually (\n. abs(f n - g n) <= d) sequentially /\ + abs(m - k) <= e - d + ==> abs(l - k) <= e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `abs(l - m) <= d ==> abs (m - k) <= e - d ==> abs (l - k) <= e`) THEN + REWRITE_TAC[REAL_ABS_BOUNDS] THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` REALLIM_LBOUND); + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND)] THEN + EXISTS_TAC `(\n. f n - g n):num->real` THEN + ASM_SIMP_TAC[REALLIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + EVENTUALLY_MONO)) THEN + REAL_ARITH_TAC) in + MATCH_MP_TAC(MATCH_MP lemma2 EULER_MASCHERONI) THEN + MATCH_MP_TAC(MESON[] + `(?a b c m:num. P (a m) (b m) (c m)) ==> ?a b c. P a b c`) THEN + EXISTS_TAC + `\m n. (sum(1..m - 1) (\k. inv(&k)) - log(&m)) + + (inv(&m) + inv(&n)) / &2 + + &1 / &12 * (inv(&m pow 2) - inv(&n pow 2)) + + -- &1 / &120 * (inv(&m pow 4) - inv(&n pow 4))` THEN + EXISTS_TAC + `\m. (sum(1..m - 1) (\k. inv(&k)) - log(&m)) + + inv(&m) / &2 + + &1 / &12 * inv(&m pow 2) + + -- &1 / &120 * inv(&m pow 4)` THEN + EXISTS_TAC `\m. inv (&60 * &m pow 5)` THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(MESON[] `(!n. P n) /\ (?n. Q n) ==> (?n. P n /\ Q n)`) THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN + REPEAT(MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC) THEN + REWRITE_TAC[REALLIM_CONST] THEN + REWRITE_TAC[REAL_ARITH `x / &2 = inv(&2) * x`] THEN + MATCH_MP_TAC REALLIM_LMUL THEN REWRITE_TAC[real_sub] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN + REWRITE_TAC[REALLIM_NULL_NEG] THEN + REWRITE_TAC[REALLIM_1_OVER_N] THEN + MATCH_MP_TAC REALLIM_1_OVER_POW THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MATCH_MP_TAC(MESON[] `(?a. P a a /\ Q a) ==> ?a. (?b. P a b) /\ Q a`) THEN + EXISTS_TAC `64` THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `log(&64) = &6 * log(&2)` SUBST1_TAC THENL + [SIMP_TAC[GSYM LOG_POW; REAL_ARITH `&0 < &2`] THEN + AP_TERM_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV; + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_SUM_CONV) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MP_TAC LOG2_APPROX_40 THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Start with the log-gamma function. It's otherwise quite tedious to repeat *) +(* essentially the same argument when we want the logarithm of the gamma *) +(* function, since we can't just take the usual principal value of log. *) +(* ------------------------------------------------------------------------- *) + +let lgamma = new_definition + `lgamma z = lim sequentially + (\n. z * clog(Cx(&n)) - clog z - + vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m))))`;; + +let LGAMMA,COMPLEX_DIFFERENTIABLE_AT_LGAMMA = (CONJ_PAIR o prove) + (`(!z. (!n. ~(z + Cx(&n) = Cx(&0))) + ==> ((\n. z * clog(Cx(&n)) - clog z - + vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m)))) + --> lgamma(z)) sequentially) /\ + (!z. (Im z = &0 ==> &0 < Re z) ==> lgamma complex_differentiable at z)`, + SUBGOAL_THEN `open {z | !n. ~(z + Cx(&n) = Cx(&0))}` ASSUME_TAC THENL + [REWRITE_TAC[SET_RULE `{z | !n. P n z} = UNIV DIFF {z | ?n. ~P n z}`] THEN + REWRITE_TAC[GSYM closed] THEN MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IMP_CONJ] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[COMPLEX_RING `x + y = Cx(&0) <=> x = --y`] THEN + REWRITE_TAC[COMPLEX_RING `--x - --y:complex = y - x`] THEN + REWRITE_TAC[COMPLEX_EQ_NEG2; CX_INJ; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + SIMP_TAC[GSYM REAL_EQ_INTEGERS; INTEGER_CLOSED]; + ALL_TAC] THEN + SUBGOAL_THEN + `!y. (!n. ~(y + Cx(&n) = Cx(&0))) + ==> ?d l. &0 < d /\ + !e. &0 < e + ==> ?N. !n z. N <= n /\ z IN cball(y,d) + ==> dist(z * clog(Cx(&n)) - + vsum(1..n) + (\m. clog((Cx(&m) + z) / Cx(&m))), + l z) < e` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + REWRITE_TAC[OPEN_CONTAINS_CBALL] THEN + DISCH_THEN(MP_TAC o SPEC `y:complex`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `summable (from 1) + (\m. Cx(&2 * ((norm(y:complex) + d) + + (norm(y) + d) pow 2)) / Cx(&m) pow 2)` + MP_TAC THENL + [REWRITE_TAC[complex_div; COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC SUMMABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SUMMABLE_ZETA_INTEGER THEN REWRITE_TAC[LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[summable; SERIES_CAUCHY; GE] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (LABEL_TAC "M")) THEN + MP_TAC(SPEC `&2 * (norm(y:complex) + d) + &1` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "N")) THEN + EXISTS_TAC `MAX (MAX 1 2) (MAX M N)` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `z:complex`] THEN + REWRITE_TAC[GE; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m + 1`; `n:num`]) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[FROM_INTER_NUMSEG_MAX; ARITH_RULE `MAX 1 (m + 1) = m + 1`] THEN + REWRITE_TAC[dist] THEN + SUBGOAL_THEN + `!n. 1 <= n + ==> z * clog(Cx(&n)) - vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m))) = + vsum(1..n) (\m. z * (clog(Cx(&(m + 1) - &1)) - + clog(Cx(&m - &1))) - + clog((Cx(&m) + z) / Cx(&m))) + + z * clog(Cx(&0))` + (fun th -> ASM_SIMP_TAC[th]) + THENL + [REWRITE_TAC[VSUM_SUB_NUMSEG] THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG; VSUM_DIFFS_ALT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`; + REAL_SUB_REFL] THEN + REPEAT STRIP_TAC THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + SUBGOAL_THEN `1 <= m + 1 /\ m <= n` MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP VSUM_COMBINE_R th)])] THEN + REWRITE_TAC[COMPLEX_RING `(x + a) - ((x + y) + a):complex = --y`] THEN + REWRITE_TAC[NORM_NEG] THEN MATCH_MP_TAC COMPLEX_NORM_VSUM_BOUND THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; REAL_CX; RE_CX] THEN + REWRITE_TAC[COMPLEX_RING `z * (a - b) - c:complex = --(z * (b - a) + c)`; + NORM_NEG; GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN + SUBGOAL_THEN `1 <= k /\ 1 < k /\ 2 <= k` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `clog(Cx(&k - &1)) - clog(Cx(&k)) = clog(Cx(&1) - inv(Cx(&k)))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LE; REAL_SUB_LT; REAL_INV_LT_1; + REAL_ARITH `&2 <= x ==> &0 < x /\ &1 < x /\ &0 < x - &1`; + GSYM CX_SUB; GSYM CX_INV; GSYM LOG_DIV] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `2 <= k` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + MP_TAC(ISPECL [`1`; `z / Cx(&k)`] TAYLOR_CLOG) THEN + MP_TAC(ISPECL [`1`; `--inv(Cx(&k))`] TAYLOR_CLOG) THEN + REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[GSYM VECTOR_SUB; NORM_NEG] THEN + REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN + REWRITE_TAC[COMPLEX_POW_NEG; ARITH; REAL_ABS_NUM; COMPLEX_POW_ONE] THEN + ASM_SIMP_TAC[REAL_INV_LT_1; REAL_OF_NUM_LT; COMPLEX_DIV_1] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1; COMPLEX_POW_1] THEN + REWRITE_TAC[REAL_MUL_LID; COMPLEX_MUL_LID] THEN + DISCH_THEN(MP_TAC o SPEC `norm(z:complex)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_LMUL)) THEN + REWRITE_TAC[NORM_POS_LE; GSYM COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN `norm(z:complex) < &k` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN + CONV_TAC NORM_ARITH; + ASM_REWRITE_TAC[COMPLEX_SUB_LDISTRIB]] THEN + ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_FIELD + `~(k = Cx(&0)) ==> (k + z) / k = Cx(&1) + z / k`] THEN + MATCH_MP_TAC(NORM_ARITH + `x' = --y' /\ d + e <= f + ==> norm(x - x') <= d ==> norm(y - y') <= e + ==> norm(x + y) <= f`) THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[REAL_POW_DIV; REAL_POW_INV; REAL_ARITH + `n * inv k / d + n pow 2 / k / e <= (&2 * (x + x pow 2)) / k <=> + (n * (&1 / d + n / e)) / k <= (x * (&2 + &2 * x)) / k`] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1; REAL_POW_LT] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN `norm(z:complex) <= norm(y:complex) + d` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN + CONV_TAC NORM_ARITH; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN + CONV_TAC NORM_ARITH; + MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_DIV THEN + REWRITE_TAC[REAL_SUB_LE; NORM_POS_LE; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1]; + REWRITE_TAC[REAL_ARITH `&2 + &2 * x = &1 * &2 + x * &2`] THEN + ONCE_REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[NORM_POS_LE; REAL_POS; REAL_LE_REFL; REAL_LE_INV_EQ] THEN + REWRITE_TAC[REAL_SUB_LE] THEN + REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN + TRY(CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE + [GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_ADD]) THEN + ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - x <=> x <= &1 / &2`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_CBALL]) THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN + CONV_TAC NORM_ARITH; + GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`dd:complex->real`; `ll:complex->complex->complex`] THEN + DISCH_THEN(LABEL_TAC "*")] THEN + SUBGOAL_THEN + `!z. (!n. ~(z + Cx(&n) = Cx(&0))) + ==> ((\n. z * clog(Cx(&n)) - + vsum (1..n) (\m. clog((Cx(&m) + z) / Cx(&m)))) --> ll z z) + sequentially` + ASSUME_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[LIM_SEQUENTIALLY; GSYM SKOLEM_THM] THEN + MESON_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[lgamma; lim] THEN CONV_TAC SELECT_CONV THEN + EXISTS_TAC `(ll:complex->complex->complex) z z - clog z` THEN + ONCE_REWRITE_TAC[COMPLEX_RING `w - z - v:complex = (w - v) - z`] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN ASM_MESON_TAC[]; + DISCH_TAC] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `!n. ~(z + Cx(&n) = Cx(&0))` ASSUME_TAC THENL + [GEN_TAC THEN + REWRITE_TAC[COMPLEX_RING `z + x = Cx(&0) <=> z = --x`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + REWRITE_TAC[IM_NEG; RE_NEG; IM_CX; RE_CX] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\z. (ll:complex->complex->complex) z z - clog z` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; SUBSET; IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + EXISTS_TAC `\n. w * clog(Cx(&n)) - clog w - + vsum(1..n) (\m. clog((Cx(&m) + w) / Cx(&m)))` THEN + ASM_SIMP_TAC[] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `w - z - v:complex = (w - v) - z`] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_SUB THEN + ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_CLOG] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `(ll:complex->complex->complex) z` THEN + EXISTS_TAC `min e (dd(z:complex))` THEN + ASM_SIMP_TAC[REAL_LT_MIN] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n. w * clog(Cx(&n)) - + vsum(1..n) (\m. clog((Cx(&m) + w) / Cx(&m)))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SEQUENTIALLY] THEN + CONJ_TAC THEN X_GEN_TAC `r:real` THEN STRIP_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `z:complex`); + REMOVE_THEN "*" (MP_TAC o SPEC `w:complex`)] THEN + ASM_SIMP_TAC[] THEN + REWRITE_TAC[GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `r:real`)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[IN_CBALL; REAL_LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `open {z | Im z = &0 ==> &0 < Re z}` MP_TAC THENL + [SUBGOAL_THEN + `{z | Im z = &0 ==> &0 < Re z} = + (:complex) DIFF ({z | Im z = &0} INTER {z | Re z <= &0})` + (fun th -> SIMP_TAC[th; CLOSED_HALFSPACE_RE_LE; GSYM closed; + CLOSED_HALFSPACE_IM_EQ; CLOSED_INTER]) THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_DIFF; IN_INTER; EXTENSION] THEN + REAL_ARITH_TAC; + REWRITE_TAC[OPEN_CONTAINS_CBALL; IN_ELIM_THM; SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `(ll:complex->complex->complex) z continuous_on cball(z,min r (dd z)) /\ + ll z holomorphic_on ball(z,min r (dd z))` + MP_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` HOLOMORPHIC_UNIFORM_LIMIT) THEN + EXISTS_TAC `\n z. z * clog(Cx(&n)) - + vsum(1..n) (\m. clog((Cx(&m) + z) / Cx(&m)))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + REWRITE_TAC[CBALL_MIN_INTER; IN_INTER] THEN + CONJ_TAC THENL [ALL_TAC; SIMP_TAC[GSYM dist] THEN ASM_MESON_TAC[]] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(MESON[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; + HOLOMORPHIC_ON_SUBSET] + `t SUBSET s /\ f holomorphic_on s + ==> f continuous_on s /\ f holomorphic_on t`) THEN + REWRITE_TAC[BALL_SUBSET_CBALL; GSYM CBALL_MIN_INTER] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_SUB THEN + SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_CONST] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_ID; + HOLOMORPHIC_ON_CONST; complex_div; HOLOMORPHIC_ON_MUL] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_CLOG THEN + REWRITE_TAC[FORALL_IN_IMAGE; GSYM complex_div; IMP_CONJ] THEN + ASM_SIMP_TAC[RE_DIV_CX; IM_DIV_CX; REAL_DIV_EQ_0; RE_ADD; IM_ADD] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[IM_CX; RE_CX; REAL_ADD_LID] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_DIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < &m + x`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[CBALL_MIN_INTER; IN_INTER]) THEN + ASM_MESON_TAC[]; + SIMP_TAC[HOLOMORPHIC_ON_OPEN; OPEN_BALL; complex_differentiable] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; REAL_LT_MIN]]);; + +let LGAMMA_ALT = prove + (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) + ==> ((\n. (z * clog(Cx(&n)) + clog(Cx(&(FACT n)))) - + vsum(0..n) (\m. clog(Cx(&m) + z))) + --> lgamma(z)) sequentially`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LGAMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SIMP_TAC[VECTOR_SUB_EQ; VSUM_CLAUSES_LEFT; LE_0; COMPLEX_ADD_LID] THEN + MATCH_MP_TAC(COMPLEX_RING + `a:complex = d - c ==> x - y - a = (x + c) - (y + d)`) THEN + REWRITE_TAC[GSYM NPRODUCT_FACT; ADD_CLAUSES] THEN + SIMP_TAC[REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; GSYM CX_LOG; LOG_PRODUCT; + PRODUCT_POS_LT; IN_NUMSEG; REAL_OF_NUM_LT; LE_1; GSYM VSUM_CX] THEN + REWRITE_TAC[GSYM VSUM_SUB_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + REWRITE_TAC[complex_div] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + ASM_SIMP_TAC[CLOG_MUL_CX; REAL_LT_INV_EQ; REAL_OF_NUM_LT; LE_1; + GSYM CX_INV; LOG_INV; CX_NEG; GSYM complex_sub]);; + +let LGAMMA_ALT2 = prove + (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) + ==> ((\n. vsum(1..n) (\m. z * clog(Cx(&1) + Cx(&1) / Cx(&m)) - + clog(Cx(&1) + z / Cx(&m))) - + clog(z)) + --> lgamma(z)) sequentially`, + REPEAT STRIP_TAC THEN + SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; + COMPLEX_FIELD `~(m = Cx(&0)) ==> Cx(&1) + z / m = (z + m) / m`] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_DIV] THEN + SIMP_TAC[GSYM CX_LOG; LOG_DIV; REAL_LT_DIV; REAL_ARITH `&0 < &1 + &m`; + REAL_OF_NUM_LT; LE_1] THEN + SIMP_TAC[VSUM_SUB_NUMSEG; VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + REWRITE_TAC[CX_SUB; REAL_OF_NUM_ADD; ARITH_RULE `1 + m = m + 1`] THEN + REWRITE_TAC[VSUM_DIFFS_ALT; LOG_1; COMPLEX_SUB_RZERO] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LGAMMA) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + LIM_SUBSEQUENCE)) THEN + DISCH_THEN(MP_TAC o SPEC `\r. r + 1`) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. --clog((Cx(&(n + 1)) + z) / Cx(&(n + 1)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM ADD1; VSUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + REWRITE_TAC[COMPLEX_RING `Cx(&n) + z = z + Cx(&n)`] THEN + SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_0] THEN + CONV_TAC COMPLEX_RING; + REWRITE_TAC[COMPLEX_VEC_0] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_NEG THEN + SIMP_TAC[REAL_OF_NUM_EQ; CX_INJ; ARITH_EQ; ADD_EQ_0; + COMPLEX_FIELD `~(y = Cx(&0)) ==> (y + z) / y = Cx(&1) + z / y`] THEN + SUBGOAL_THEN `Cx(&0) = clog (Cx (&1) + Cx(&0))` SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_ADD_RID; CLOG_1]; ALL_TAC] THEN + MP_TAC(ISPECL [`\z. clog(Cx(&1) + z)`; `sequentially`] + LIM_CONTINUOUS_FUNCTION) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + COMPLEX_DIFFERENTIABLE_TAC THEN REWRITE_TAC[RE_ADD; RE_CX] THEN + REWRITE_TAC[REAL_ADD_RID; REAL_LT_01]; + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] + (ISPECL [`f:num->complex`; `\n. n + 1`] LIM_SUBSEQUENCE)) THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM CX_INV; REWRITE_RULE[o_DEF] (GSYM REALLIM_COMPLEX)] THEN + REWRITE_TAC[REALLIM_1_OVER_N]]]);; + +(* ------------------------------------------------------------------------- *) +(* The complex gamma function (defined using the Gauss/Euler product). *) +(* Note that this totalizes it with the value zero at the poles. *) +(* ------------------------------------------------------------------------- *) + +let cgamma = new_definition + `cgamma(z) = lim sequentially (\n. (Cx(&n) cpow z * Cx(&(FACT n))) / + cproduct(0..n) (\m. z + Cx(&m)))`;; + +let [CGAMMA;CGAMMA_EQ_0;CGAMMA_LGAMMA] = (CONJUNCTS o prove) + (`(!z. ((\n. (Cx(&n) cpow z * Cx(&(FACT n))) / cproduct(0..n) (\m. z + Cx(&m))) + --> cgamma(z)) sequentially) /\ + (!z. cgamma(z) = Cx(&0) <=> ?n. z + Cx(&n) = Cx(&0)) /\ + (!z. cgamma(z) = if ?n. z + Cx(&n) = Cx(&0) then Cx(&0) + else cexp(lgamma z))`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `y:complex` THEN + ASM_CASES_TAC `?n. y + Cx(&n) = Cx(&0)` THENL + [ASM_REWRITE_TAC[GSYM NOT_EXISTS_THM] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `N:num`) THEN + REWRITE_TAC[cgamma; lim] THEN MATCH_MP_TAC(MESON[LIM_UNIQUE] + `~trivial_limit net /\ (f --> a) net + ==> (f --> @a. (f --> a) net) net /\ (@a. (f --> a) net) = a`) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN + DISCH_TAC THEN + SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_DIV_EQ_0; CPRODUCT_EQ_0; FINITE_NUMSEG; + IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LE_REFL]; + ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN + SUBGOAL_THEN + `((\n. (Cx(&n) cpow y * Cx(&(FACT n))) / cproduct(0..n) (\m. y + Cx(&m))) + --> cexp(lgamma y)) sequentially` + ASSUME_TAC THENL + [MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. cexp(y * clog(Cx(&n)) - clog y - + vsum(1..n) (\m. clog((Cx(&m) + y) / Cx(&m))))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[CEXP_SUB; cpow; CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM NPRODUCT_FACT; REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG] THEN + SIMP_TAC[CX_PRODUCT; FINITE_NUMSEG; GSYM CPRODUCT_INV] THEN + SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0] THEN + GEN_REWRITE_TAC RAND_CONV [COMPLEX_RING + `a * b * c:complex = b * a * c`] THEN + REWRITE_TAC[COMPLEX_ADD_RID] THEN BINOP_TAC THENL + [ASM_MESON_TAC[COMPLEX_ADD_RID; CEXP_CLOG]; ALL_TAC] THEN + SIMP_TAC[ADD_CLAUSES; GSYM CPRODUCT_MUL; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM CEXP_NEG; GSYM VSUM_NEG] THEN + SIMP_TAC[CEXP_VSUM; FINITE_NUMSEG] THEN MATCH_MP_TAC CPRODUCT_EQ THEN + REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + REWRITE_TAC[CEXP_NEG] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM COMPLEX_INV_INV] THEN + REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [COMPLEX_MUL_SYM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [COMPLEX_ADD_SYM] THEN + MATCH_MP_TAC CEXP_CLOG THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_INV_EQ_0] THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC; + MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN + ASM_SIMP_TAC[LGAMMA; CONTINUOUS_AT_CEXP]]; + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[cgamma; lim] THEN CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + ASM_MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]; + SIMP_TAC[CEXP_NZ]]]);; + +let CGAMMA_RECURRENCE_ALT = prove + (`!z. cgamma(z) = cgamma(z + Cx(&1)) / z`, + GEN_TAC THEN ASM_CASES_TAC `?n. z + Cx(&n) = Cx(&0)` THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[GSYM CGAMMA_EQ_0] th]) THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[COMPLEX_DIV_EQ_0] THEN + ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (is_exists o concl)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[COMPLEX_ADD_RID; CGAMMA_EQ_0] THEN + REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN + MESON_TAC[ADD1; ADD_SYM]; + RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM])] THEN + SUBGOAL_THEN `!n. ~((z + Cx(&1)) + Cx(&n) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_ADD_LID]; ALL_TAC] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `(a * b) / c = Cx(&1) /\ ~(a = Cx(&0)) /\ ~(c = Cx(&0)) ==> b = c / a`) THEN + ASM_REWRITE_TAC[CGAMMA_EQ_0] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC + `\n. (z * (Cx(&(n + 1)) cpow z * Cx(&(FACT(n + 1)))) / + cproduct(0..n+1) (\m. z + Cx(&m))) / + ((Cx(&n) cpow (z + Cx(&1)) * Cx(&(FACT n))) / + cproduct(0..n) (\m. (z + Cx(&1)) + Cx(&m)))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MATCH_MP_TAC LIM_COMPLEX_DIV THEN + ASM_REWRITE_TAC[CGAMMA; CGAMMA_EQ_0] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MP_TAC(SPEC `z:complex` CGAMMA) THEN + DISCH_THEN(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[ARITH_RULE `1 + n = n + 1`] THEN + SIMP_TAC[SYM(ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET)] THEN + SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN + REWRITE_TAC[GSYM ADD1; FACT; CX_MUL; COMPLEX_MUL_ASSOC; GSYM REAL_OF_NUM_MUL; + ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] (GSYM CPOW_SUC)] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN + REWRITE_TAC[COMPLEX_ADD_RID; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_RING + `a * b * c * d * e * f * g * h:complex = + (a * d) * (c * g) * (h * e) * (b * f)`] THEN + ASM_SIMP_TAC[GSYM complex_div; COMPLEX_DIV_REFL; CX_INJ; + REAL_OF_NUM_EQ; FACT_NZ; COMPLEX_MUL_LID] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_LID] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC COMPLEX_DIV_REFL THEN + SIMP_TAC[CPRODUCT_EQ_0; FINITE_NUMSEG] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. cexp((z + Cx(&1)) * clog(Cx(&1) + inv(Cx(&n))))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; NOT_SUC; LE_1] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CEXP_SUB] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_FIELD + `~(n = Cx(&0)) ==> Cx(&1) + inv n = (n + Cx(&1)) / n`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM CX_ADD] THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; GSYM CX_DIV; GSYM CX_LOG; LE_1; LOG_DIV; + REAL_OF_NUM_LT; REAL_LT_DIV; ARITH_RULE `0 < n + 1`] THEN + REWRITE_TAC[CX_SUB]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CEXP_0] THEN + MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN + REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(&2) * inv(Cx(&n))` THEN + SIMP_TAC[LIM_INV_N; LIM_NULL_COMPLEX_LMUL] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN + REWRITE_TAC[GE; IN_FROM] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`0`; `Cx(inv(&n))`] TAYLOR_CLOG) THEN + SIMP_TAC[VSUM_CLAUSES_NUMSEG; ARITH; VECTOR_SUB_RZERO] THEN + REWRITE_TAC[REAL_POW_1; GSYM CX_ADD; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN ANTS_TAC THENL + [MATCH_MP_TAC REAL_INV_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + REWRITE_TAC[CX_ADD; CX_INV]] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[real_div; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_INV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 <= &1 - x <=> x <= inv(&2)`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC);; + +let CGAMMA_1 = prove + (`cgamma(Cx(&1)) = Cx(&1)`, + MP_TAC(SPEC `Cx(&1)` CGAMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; TRIVIAL_LIMIT_SEQUENTIALLY] + (ISPEC `sequentially` LIM_UNIQUE)) THEN + REWRITE_TAC[GSYM CX_ADD; REAL_OF_NUM_ADD; ARITH_RULE `1 + n = n + 1`] THEN + SIMP_TAC[SYM(ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET)] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. Cx(&n / (&n + &1))` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[CX_DIV] THEN + ASM_SIMP_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; LE_1; COMPLEX_POW_1] THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC [GSYM COMPLEX_INV_INV] THEN + AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_INV_INV; COMPLEX_INV_MUL] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `a * b = c /\ ~(b = Cx(&0)) ==> a = inv b * c`) THEN + REWRITE_TAC[GSYM CX_MUL; CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN + REWRITE_TAC[REAL_OF_NUM_SUC; REAL_OF_NUM_MUL; GSYM(CONJUNCT2 FACT)] THEN + REWRITE_TAC[ADD_CLAUSES; ADD1] THEN SPEC_TAC(`n + 1`,`m:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[FACT; CPRODUCT_CLAUSES_NUMSEG; ARITH] THEN + ASM_REWRITE_TAC[CX_MUL; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`; COMPLEX_MUL_SYM]; + ALL_TAC] THEN + SIMP_TAC[REAL_FIELD `&n / (&n + &1) = &1 - inv(&n + &1)`] THEN + SUBST1_TAC(COMPLEX_RING `Cx(&1) = Cx(&1) - Cx(&0)`) THEN + REWRITE_TAC[CX_SUB] THEN MATCH_MP_TAC LIM_SUB THEN + REWRITE_TAC[LIM_CONST; REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(ISPECL [`f:num->complex`; `l:complex`; `1`] SEQ_OFFSET) THEN + REWRITE_TAC[CX_INV; LIM_INV_N]);; + +let CGAMMA_RECURRENCE = prove + (`!z. cgamma(z + Cx(&1)) = if z = Cx(&0) then Cx(&1) else z * cgamma(z)`, + GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[COMPLEX_ADD_LID; CGAMMA_1] THEN + MATCH_MP_TAC(COMPLEX_FIELD `a = b / c /\ ~(c = Cx(&0)) ==> b = c * a`) THEN + ASM_MESON_TAC[CGAMMA_RECURRENCE_ALT]);; + +let CGAMMA_FACT = prove + (`!n. cgamma(Cx(&(n + 1))) = Cx(&(FACT n))`, + INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; CGAMMA_1] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REWRITE_TAC[CX_ADD] THEN + REWRITE_TAC[CGAMMA_RECURRENCE; CX_INJ; REAL_OF_NUM_EQ; ADD_EQ_0; ARITH] THEN + ASM_REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_MUL; CX_MUL]);; + +let CGAMMA_POLES = prove + (`!n. cgamma(--(Cx(&n))) = Cx(&0)`, + REWRITE_TAC[CGAMMA_EQ_0] THEN MESON_TAC[COMPLEX_ADD_LINV]);; + +let COMPLEX_DIFFERENTIABLE_AT_CGAMMA = prove + (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> cgamma complex_differentiable at z`, + let lemma = prove + (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) /\ + cgamma complex_differentiable at (z + Cx(&1)) + ==> cgamma complex_differentiable at z`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`\z. cgamma(z + Cx(&1)) / z`; `&1`] THEN + REWRITE_TAC[REAL_LT_01] THEN + CONJ_TAC THENL [REWRITE_TAC[GSYM CGAMMA_RECURRENCE_ALT]; ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_DIV_AT THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_ID] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[COMPLEX_ADD_RID]] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN + ASM_REWRITE_TAC[] THEN COMPLEX_DIFFERENTIABLE_TAC) in + REPEAT STRIP_TAC THEN MP_TAC(SPEC `abs(Re z) + &1` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + SUBGOAL_THEN + `!n. n <= N ==> cgamma complex_differentiable (at (z + Cx(&N) - Cx(&n)))` + MP_TAC THENL + [ALL_TAC; MESON_TAC[LE_REFL; COMPLEX_SUB_REFL; COMPLEX_ADD_RID]] THEN + INDUCT_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\z. cexp(lgamma z)` THEN + SUBGOAL_THEN `open {z | !n. ~(z + Cx(&n) = Cx(&0))}` MP_TAC THENL + [REWRITE_TAC[SET_RULE `{z | !n. P n z} = UNIV DIFF {z | ?n. ~P n z}`] THEN + REWRITE_TAC[GSYM closed] THEN MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IMP_CONJ] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[COMPLEX_RING `x + y = Cx(&0) <=> x = --y`] THEN + REWRITE_TAC[COMPLEX_RING `--x - --y:complex = y - x`] THEN + REWRITE_TAC[COMPLEX_EQ_NEG2; CX_INJ; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + SIMP_TAC[GSYM REAL_EQ_INTEGERS; INTEGER_CLOSED]; + REWRITE_TAC[open_def; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w - Cx(&N)`) THEN + ASM_SIMP_TAC[dist; COMPLEX_RING `w - n - z:complex = w - (z + n)`] THEN + REWRITE_TAC[CGAMMA_LGAMMA] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `n:num`) THEN + DISCH_THEN(MP_TAC o SPEC `n + N:num`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD] THEN + ASM_REWRITE_TAC[COMPLEX_RING `w - N + n + N:complex = w + n`]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_AT_CEXP] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_LGAMMA THEN + REWRITE_TAC[RE_ADD; RE_CX] THEN ASM_REAL_ARITH_TAC]]; + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; CX_ADD] THEN + MATCH_MP_TAC lemma THEN + REWRITE_TAC[COMPLEX_RING `(z + N - (n + w)) + w:complex = z + N - n`] THEN + CONJ_TAC THENL + [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN + X_GEN_TAC `m:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(N + m) - (n + 1)`) THEN + SUBGOAL_THEN `n + 1 <= N + m` + (fun th -> SIMP_TAC[th; GSYM REAL_OF_NUM_SUB]) + THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; CX_SUB] THEN + CONV_TAC COMPLEX_RING]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CGAMMA = prove + (`!z s. (!n. ~(z + Cx(&n) = Cx(&0))) + ==> cgamma complex_differentiable at z within s`, + SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CGAMMA]);; + +let HOLOMORPHIC_ON_CGAMMA = prove + (`!s. s SUBSET {z | !n. ~(z + Cx(&n) = Cx(&0))} + ==> cgamma holomorphic_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_WITHIN_CGAMMA THEN + ASM SET_TAC[]);; + +let CONTINUOUS_AT_CGAMMA = prove + (`!z. (!n. ~(z + Cx(&n) = Cx(&0))) ==> cgamma continuous at z`, + SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; + COMPLEX_DIFFERENTIABLE_AT_CGAMMA]);; + +let CONTINUOUS_WITHIN_CGAMMA = prove + (`!z s. (!n. ~(z + Cx(&n) = Cx(&0))) + ==> cgamma continuous at z within s`, + SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; + COMPLEX_DIFFERENTIABLE_WITHIN_CGAMMA]);; + +let CONTINUOUS_ON_CGAMMA = prove + (`!s. s SUBSET {z | !n. ~(z + Cx(&n) = Cx(&0))} + ==> cgamma continuous_on s`, + SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_CGAMMA]);; + +let CGAMMA_SIMPLE_POLES = prove + (`!n. ((\z. (z + Cx(&n)) * cgamma z) --> --Cx(&1) pow n / Cx(&(FACT n))) + (at(--Cx(&n)))`, + INDUCT_TAC THENL + [REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_NEG_0; FACT; complex_pow; + COMPLEX_DIV_1] THEN + ONCE_REWRITE_TAC[CGAMMA_RECURRENCE_ALT] THEN + MATCH_MP_TAC LIM_TRANSFORM_AWAY_AT THEN + MAP_EVERY EXISTS_TAC [`\z. cgamma(z + Cx(&1))`; `Cx(&1)`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN + SUBGOAL_THEN `(\z. cgamma (z + Cx(&1))) continuous at (Cx(&0))` + MP_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + CONJ_TAC THENL [CONTINUOUS_TAC; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_CGAMMA THEN + REWRITE_TAC[GSYM CX_ADD; CX_INJ] THEN REAL_ARITH_TAC; + REWRITE_TAC[CONTINUOUS_AT; COMPLEX_ADD_LID; CGAMMA_1]]; + REWRITE_TAC[FACT; CX_MUL; GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[CGAMMA_RECURRENCE_ALT] THEN + REWRITE_TAC[complex_div; complex_pow; COMPLEX_INV_MUL] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `(--Cx(&1) * p) * is * i = (p * i) * --is`] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o + ISPECL [`at (--Cx(&(SUC n)))`; `\z. z + Cx(&1)`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] LIM_COMPOSE_AT))) THEN + REWRITE_TAC[o_DEF; GSYM REAL_OF_NUM_SUC; CX_ADD] THEN + REWRITE_TAC[COMPLEX_RING `(z + Cx(&1)) + w = z + (w + Cx(&1))`] THEN + REWRITE_TAC[GSYM complex_div] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [LIM_TAC THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[EVENTUALLY_AT; GSYM DIST_NZ] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + CONV_TAC COMPLEX_RING]; + REWRITE_TAC[COMPLEX_NEG_INV; GSYM CONTINUOUS_AT] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_AT THEN + REWRITE_TAC[GSYM CX_NEG; CX_INJ; GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[CONTINUOUS_AT_ID] THEN REAL_ARITH_TAC]]);; + +let CNJ_CGAMMA = prove + (`!z. cnj(cgamma z) = cgamma(cnj z)`, + GEN_TAC THEN MP_TAC(SPEC `cnj z` CGAMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + LIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + GEN_REWRITE_TAC I [GSYM LIM_CNJ] THEN REWRITE_TAC[CNJ_CNJ] THEN + MP_TAC(SPEC `z:complex` CGAMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + SIMP_TAC[CNJ_DIV; CNJ_MUL; CNJ_CX; CNJ_CPRODUCT; FINITE_NUMSEG] THEN + REWRITE_TAC[CNJ_ADD; CNJ_CNJ; CNJ_CX] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[cpow; CNJ_EQ_0] THEN + DISCH_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[CNJ_CX; CNJ_CEXP] THEN + REWRITE_TAC[CNJ_MUL; CNJ_CNJ] THEN + ASM_SIMP_TAC[CNJ_CLOG; RE_CX; REAL_OF_NUM_LT; LE_1; CNJ_CX]);; + +let REAL_GAMMA = prove + (`!z. real z ==> real(cgamma z)`, + SIMP_TAC[REAL_CNJ; CNJ_CGAMMA]);; + +let RE_POS_CGAMMA_REAL = prove + (`!z. real z /\ &0 <= Re z ==> &0 <= Re(cgamma z)`, + REWRITE_TAC[REAL_EXISTS; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + GEN_TAC THEN X_GEN_TAC `x:real` THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[RE_CX] THEN DISCH_TAC THEN MP_TAC(SPEC `Cx x` CGAMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> p /\ r ==> q ==> s`] + LIM_RE_LBOUND) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; LE_1; GSYM CX_LOG; GSYM CX_INV; + REAL_OF_NUM_LT; GSYM CX_MUL; GSYM CX_EXP; RE_MUL_CX; RE_CX; + complex_div; GSYM CX_ADD; GSYM CX_PRODUCT; FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_LE_MUL; REAL_EXP_POS_LE; REAL_POS; REAL_LE_INV_EQ] THEN + MATCH_MP_TAC PRODUCT_POS_LE_NUMSEG THEN ASM_REAL_ARITH_TAC);; + +let CGAMMA_LEGENDRE_ALT = prove + (`!z. cgamma(z) * cgamma(z + Cx(&1) / Cx(&2)) = + Cx(&2) cpow (Cx(&1) - Cx(&2) * z) * + cgamma(Cx(&1) / Cx(&2)) * cgamma(Cx(&2) * z)`, + REWRITE_TAC[GSYM CX_DIV] THEN + SUBGOAL_THEN + `?f. !z. (!n. ~(Cx(&2) * z + Cx(&n) = Cx(&0))) + ==> (f --> (cgamma(z) * cgamma(z + Cx(&1 / &2))) / + (Cx(&2) cpow (Cx(&1) - Cx(&2) * z) * cgamma(Cx(&2) * z))) + sequentially` + CHOOSE_TAC THENL + [EXISTS_TAC + `\n. (Cx(&n) cpow Cx(&1 / &2) * inv (Cx(&2))) * + (Cx(&(FACT n)) pow 2 * inv (Cx(&(FACT (2 * n))))) * + Cx(&4) pow (n + 1) * + inv(Cx(&(2 * n + 1)))` THEN + REPEAT STRIP_TAC THEN MP_TAC(SPEC `Cx(&2) * z` CGAMMA) THEN + DISCH_THEN(MP_TAC o SPEC `\n. 2 * n` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE)) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&2) cpow (Cx(&1) - Cx(&2) * z)` o + MATCH_MP LIM_COMPLEX_LMUL) THEN + MP_TAC(CONJ (SPEC `z:complex` CGAMMA) (SPEC `z + Cx(&1 / &2)` CGAMMA)) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] LIM_COMPLEX_DIV))) THEN + ASM_REWRITE_TAC[COMPLEX_ENTIRE; CPOW_EQ_0; CGAMMA_EQ_0] THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN + SUBGOAL_THEN `((\n. (Cx(&2) * z + Cx(&(2 * n + 1))) / Cx(&(2 * n + 1))) + --> Cx(&1)) sequentially` + MP_TAC THENL + [SIMP_TAC[complex_div; COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; + COMPLEX_ADD_RDISTRIB; ARITH_RULE `~(2 * n + 1 = 0)`] THEN + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN + REWRITE_TAC[COMPLEX_RING `(a + b) - b:complex = a`] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + MP_TAC(SPEC `\n. 2 * n + 1` + (MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LIM_SUBSEQUENCE) LIM_INV_N)) THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC; + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL)] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[CPOW_ADD; complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; CX_MUL] THEN + SIMP_TAC[CPOW_MUL_REAL; REAL_CX; RE_CX; REAL_POS] THEN + REWRITE_TAC[CPOW_SUB; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN + SIMP_TAC[COMPLEX_POW_1; complex_div; COMPLEX_INV_INV; COMPLEX_INV_MUL] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING + `x * y * a * b * c * d * e * f * g * h * i * j * k * l * m:complex = + (x * y) * (e * h) * ((a * d) * k) * + ((b * f) * l) * (i * j) * (m * c * g)`] THEN + REWRITE_TAC[GSYM COMPLEX_POW_2; COMPLEX_MUL_2; CPOW_ADD] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV; COMPLEX_POW_EQ_0; CPOW_EQ_0; + CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; LE_1; COMPLEX_MUL_LID] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_2; GSYM COMPLEX_INV_MUL] THEN + SIMP_TAC[GSYM CPRODUCT_MUL; FINITE_NUMSEG] THEN + REWRITE_TAC[COMPLEX_RING + `(z + m) * ((z + Cx(&1 / &2)) + m) = + inv(Cx(&4)) * + (Cx(&2) * z + Cx(&2) * m) * (Cx(&2) * z + Cx(&2) * m + Cx(&1))`] THEN + SIMP_TAC[CPRODUCT_MUL; FINITE_NUMSEG; CPRODUCT_CONST_NUMSEG] THEN + SIMP_TAC[GSYM CPRODUCT_MUL; SUB_0; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL; + REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[GSYM CPRODUCT_PAIR] THEN + SIMP_TAC[GSYM ADD1; CPRODUCT_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ADD1] THEN CONV_TAC NUM_REDUCE_CONV THEN + SIMP_TAC[LE_0; COMPLEX_INV_MUL; COMPLEX_INV_INV; GSYM COMPLEX_POW_INV] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `x * a * b * c * d * e * f:complex = (c * e) * a * b * d * f * x`] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV; CPRODUCT_EQ_0; FINITE_NUMSEG] THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[GSYM COMPLEX_MUL_ASSOC; COMPLEX_MUL_LINV] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN + ASM_CASES_TAC `!n. ~(Cx(&2) * z + Cx(&n) = Cx(&0))` THENL + [FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `z:complex` th) THEN MP_TAC(SPEC `Cx(&1 / &2)` th)) THEN + ASM_REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL; GSYM CX_SUB; CX_INJ] THEN + ANTS_TAC THENL [REAL_ARITH_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN + REWRITE_TAC[CGAMMA_1; CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[complex_pow; COMPLEX_MUL_RID; COMPLEX_DIV_1; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + LIM_UNIQUE)) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN MATCH_MP_TAC(COMPLEX_FIELD + `~(p = Cx(&0)) /\ ~(z2 = Cx(&0)) + ==> a = (z * z') / (p * z2) ==> z * z' = p * a * z2`) THEN + ASM_REWRITE_TAC[CGAMMA_EQ_0; CPOW_EQ_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ]; + MATCH_MP_TAC(COMPLEX_RING + `z = Cx(&0) /\ ((w = Cx(&0)) \/ (y = Cx(&0))) + ==> w * y = p * q * z`) THEN + REWRITE_TAC[CGAMMA_EQ_0] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[OR_EXISTS_THM; GSYM COMPLEX_ADD_ASSOC] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `z + n = Cx(&0) <=> Cx(&2) * z + Cx(&2) * n = Cx(&0)`] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_MUL] THEN + REWRITE_TAC[REAL_ARITH `&2 * (&1 / &2 + n) = &2 * n + &1`] THEN + REWRITE_TAC[REAL_OF_NUM_SUC; REAL_OF_NUM_MUL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + MP_TAC(SPEC `n:num` EVEN_OR_ODD) THEN + MESON_TAC[ODD_EXISTS; EVEN_EXISTS]]);; + +let CGAMMA_REFLECTION = prove + (`!z. cgamma(z) * cgamma(Cx(&1) - z) = Cx pi / csin(Cx pi * z)`, + let lemma = prove + (`!w z. (?n. integer n /\ w = Cx n) /\ (?n. integer n /\ z = Cx n) /\ + dist(w,z) < &1 + ==> w = z`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[DIST_CX] THEN ASM_MESON_TAC[REAL_EQ_INTEGERS_IMP]) in + ABBREV_TAC + `g = \z. if ?n. integer n /\ z = Cx n then Cx pi + else cgamma(z) * cgamma(Cx(&1) - z) * csin(Cx pi * z)` THEN + SUBGOAL_THEN `!z. g(z + Cx(&1)):complex = g(z)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "g" THEN + MATCH_MP_TAC(MESON[] `(p <=> p') /\ a = a' /\ b = b' + ==> (if p then a else b) = (if p' then a' else b')`) THEN + REWRITE_TAC[COMPLEX_RING `z + Cx(&1) = w <=> z = w - Cx(&1)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM CX_SUB] THEN + MESON_TAC[INTEGER_CLOSED; REAL_ARITH `(n + &1) - &1 = n`]; + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [CGAMMA_RECURRENCE_ALT] THEN + REWRITE_TAC[COMPLEX_RING `a - (z + a):complex = --z`] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) + [CGAMMA_RECURRENCE_ALT] THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB; COMPLEX_MUL_RID; CSIN_ADD] THEN + REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN + REWRITE_TAC[COMPLEX_RING `--z + Cx(&1) = Cx(&1) - z`] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_NEG; COMPLEX_MUL_AC; + CX_NEG; COMPLEX_MUL_LID; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[COMPLEX_MUL_AC]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n z. integer n ==> g(z + Cx n):complex = g z` ASSUME_TAC THENL + [SUBGOAL_THEN `!n z. g(z + Cx(&n)):complex = g z` ASSUME_TAC THENL + [INDUCT_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; COMPLEX_ADD_RID] THEN + ASM_REWRITE_TAC[CX_ADD; COMPLEX_ADD_ASSOC]; + REWRITE_TAC[integer] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP + (REAL_ARITH `abs x = a ==> x = a \/ x = --a`)) THEN + ASM_REWRITE_TAC[CX_NEG; GSYM complex_sub] THEN + ASM_MESON_TAC[COMPLEX_RING `(z - w) + w:complex = z`]]; + ALL_TAC] THEN + SUBGOAL_THEN `!z. ~(?n. integer n /\ z = Cx n) + ==> g complex_differentiable (at z)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `\z. cgamma z * cgamma(Cx(&1) - z) * csin(Cx pi * z)` THEN + SUBGOAL_THEN `closed {z | ?n. integer n /\ z = Cx n}` MP_TAC THENL + [MATCH_MP_TAC DISCRETE_IMP_CLOSED THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN MESON_TAC[lemma; dist]; + REWRITE_TAC[closed; OPEN_CONTAINS_BALL; IN_UNIV; IN_DIFF]] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[] THEN + REPEAT(MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_MUL_AT THEN CONJ_TAC) THENL + [ALL_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN + CONJ_TAC; + ALL_TAC] THEN + (MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_CGAMMA ORELSE + COMPLEX_DIFFERENTIABLE_TAC) THEN + REWRITE_TAC[COMPLEX_RING `z + a:complex = b <=> z = b - a`; + COMPLEX_RING `Cx(&1) - z = a - b <=> z = b - a + Cx(&1)`] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB] THEN ASM_MESON_TAC[INTEGER_CLOSED]; + ALL_TAC] THEN + SUBGOAL_THEN `g complex_differentiable at (Cx(&0))` ASSUME_TAC THENL + [MATCH_MP_TAC HOLOMORPHIC_ON_IMP_DIFFERENTIABLE_AT THEN + EXISTS_TAC `ball(Cx(&0),&1)` THEN + REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN + MATCH_MP_TAC NO_ISOLATED_SINGULARITY THEN EXISTS_TAC `{Cx(&0)}` THEN + REWRITE_TAC[OPEN_BALL; FINITE_SING] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; IN_DIFF; IN_SING] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN + STRIP_TAC THEN MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~(z = Cx(&0))` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN + ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN + MESON_TAC[INTEGER_CLOSED]] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN + DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + ASM_CASES_TAC `z = Cx(&0)` THENL + [ALL_TAC; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN UNDISCH_TAC `~(z = Cx(&0))` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN + ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN + MESON_TAC[INTEGER_CLOSED]] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[CONTINUOUS_AT] THEN + EXPAND_TAC "g" THEN + REWRITE_TAC[MESON[INTEGER_CLOSED] `?n. integer n /\ Cx(&0) = Cx(n)`] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\z. Cx pi * (z * cgamma(z)) * cgamma(Cx(&1) - z) * + csin(Cx pi * z) / (Cx pi * z)` THEN + EXISTS_TAC `ball(Cx(&0),&1)` THEN + REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN CONJ_TAC THENL + [X_GEN_TAC `w:complex` THEN REWRITE_TAC[COMPLEX_IN_BALL_0] THEN + STRIP_TAC THEN COND_CASES_TAC THENL + [UNDISCH_TAC `~(w = Cx(&0))` THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN MATCH_MP_TAC lemma THEN + ASM_REWRITE_TAC[dist; COMPLEX_SUB_RZERO] THEN + MESON_TAC[INTEGER_CLOSED]; + UNDISCH_TAC `~(w = Cx(&0))` THEN MP_TAC PI_NZ THEN + REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD]; + GEN_REWRITE_TAC LAND_CONV [COMPLEX_RING + `p = p * Cx(&1) * Cx(&1) * Cx(&1)`] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN MATCH_MP_TAC LIM_COMPLEX_MUL THEN + CONJ_TAC THENL + [MP_TAC(SPEC `0` CGAMMA_SIMPLE_POLES) THEN + REWRITE_TAC[FACT; COMPLEX_DIV_1; complex_pow; COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_NEG_0]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [SUBGOAL_THEN `(cgamma o (\z. Cx(&1) - z)) continuous (at (Cx(&0)))` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + CONJ_TAC THENL [CONTINUOUS_TAC; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_CGAMMA THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; CX_INJ] THEN + REAL_ARITH_TAC; + REWRITE_TAC[CONTINUOUS_AT; o_DEF; COMPLEX_SUB_RZERO; CGAMMA_1]]; + SUBGOAL_THEN + `(\z. csin(Cx pi * z) / (Cx pi * z)) = + (\z. csin z / z) o (\w. Cx pi * w)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPOSE_AT THEN + EXISTS_TAC `Cx(&0)` THEN REWRITE_TAC[LIM_CSIN_OVER_X] THEN + SIMP_TAC[EVENTUALLY_AT; COMPLEX_ENTIRE; CX_INJ; PI_NZ; + GSYM DIST_NZ] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_01]] THEN + LIM_TAC THEN CONV_TAC COMPLEX_RING]]; + ALL_TAC] THEN + SUBGOAL_THEN `g holomorphic_on (:complex)` ASSUME_TAC THENL + [REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE; WITHIN_UNIV; IN_UNIV] THEN + X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `?n. integer n /\ z = Cx n` THEN + ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_TRANSFORM_AT THEN + EXISTS_TAC `(g:complex->complex) o (\z. z - Cx n)` THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [REWRITE_TAC[o_THM] THEN + ASM_MESON_TAC[COMPLEX_RING `(z - w) + w:complex = z`]; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN + ASM_REWRITE_TAC[COMPLEX_SUB_REFL] THEN + COMPLEX_DIFFERENTIABLE_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!z. g(z / Cx(&2)) * g((z + Cx(&1)) / Cx(&2)) = + cgamma(Cx(&1 / &2)) pow 2 * g(z)` + ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `!s. s = UNIV /\ (!x. x IN s ==> P x) ==> !x. P x`) THEN + EXISTS_TAC `closure {z | !n. ~(integer n /\ z = Cx n)}` THEN + CONJ_TAC THENL + [REWRITE_TAC[CLOSURE_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE `s = {} ==> t DIFF s = t`) THEN + MATCH_MP_TAC COUNTABLE_EMPTY_INTERIOR THEN + MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[GSYM REAL_NOT_LT; GSYM dist; REAL_LT_01] THEN + ASM_MESON_TAC[lemma]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN REWRITE_TAC[GSYM IN_SING] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE THEN REWRITE_TAC[CLOSED_SING] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + TRY(GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOLOMORPHIC_ON_IMP_CONTINUOUS_ON) THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[IN_UNIV; WITHIN_UNIV] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN + CONJ_TAC THEN CONTINUOUS_TAC; + ALL_TAC] THEN + X_GEN_TAC `z:complex` THEN + REWRITE_TAC[IN_ELIM_THM; IN_SING; COMPLEX_SUB_0] THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_RING `z / Cx(&2) = w <=> z = Cx(&2) * w`] THEN + REWRITE_TAC[COMPLEX_RING `z + Cx(&1) = w <=> z = w - Cx(&1)`] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB] THEN + REPEAT(COND_CASES_TAC THENL [ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC]) THEN + REWRITE_TAC[COMPLEX_RING + `(a * b * c) * (d * e * f):complex = + (a * d) * (e * b) * (c * f)`] THEN + REWRITE_TAC[COMPLEX_RING + `Cx(&1) - (z + Cx(&1)) / Cx(&2) = (Cx(&1) - z) / Cx(&2)`] THEN + REWRITE_TAC[COMPLEX_RING + `(z + Cx(&1)) / Cx(&2) = z / Cx(&2) + Cx(&1) / Cx(&2) /\ + Cx(&1) - z / Cx(&2) = ((Cx(&1) - z) / Cx(&2)) + Cx(&1) / Cx(&2)`] THEN + REWRITE_TAC[CGAMMA_LEGENDRE_ALT] THEN + MP_TAC(ISPEC `Cx(&1 / &2) * z * Cx pi` CSIN_DOUBLE) THEN + MP_TAC(SPECL [`Cx(&2)`; `z:complex`; `--z:complex`] CPOW_ADD) THEN + REWRITE_TAC[COMPLEX_ADD_RINV] THEN + CONV_TAC(DEPTH_BINOP_CONV `==>` + (BINOP_CONV(DEPTH_BINOP_CONV `complex_mul` + (RAND_CONV COMPLEX_POLY_CONV)))) THEN + REWRITE_TAC[CPOW_ADD; CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN + REWRITE_TAC[CPOW_N; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; CSIN_ADD] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2; + REAL_ARITH `&1 / &2 * x = x / &2`] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `?h. h holomorphic_on (:complex) /\ + !z. z IN (:complex) ==> g z = cexp(h z)` + MP_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN + ASM_REWRITE_TAC[CONTRACTIBLE_UNIV; IN_UNIV] THEN + X_GEN_TAC `z:complex` THEN EXPAND_TAC "g" THEN + COND_CASES_TAC THEN REWRITE_TAC[CX_INJ; PI_NZ] THEN + REWRITE_TAC[CGAMMA_EQ_0; CSIN_EQ_0; COMPLEX_ENTIRE] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] CX_MUL] THEN + REWRITE_TAC[COMPLEX_RING `a - z + b = Cx(&0) <=> z = a + b`] THEN + REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL; CX_INJ; PI_NZ] THEN + REWRITE_TAC[COMPLEX_RING `z + a = Cx(&0) <=> z = --a`] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG] THEN ASM_MESON_TAC[INTEGER_CLOSED]; + REWRITE_TAC[IN_UNIV] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN + MP_TAC(ISPECL [`h:complex->complex`; `(:complex)`] + HOLOMORPHIC_ON_OPEN) THEN + ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h':complex->complex` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!z. (h'(z / Cx(&2)) + h'((z + Cx(&1)) / Cx(&2))) / Cx(&2) = h'(z)` + ASSUME_TAC THENL + [X_GEN_TAC `z:complex` THEN MATCH_MP_TAC + (COMPLEX_RING `!a. ~(a = Cx(&0)) /\ a * x = a * y ==> x = y`) THEN + EXISTS_TAC `g(z / Cx(&2)) * g((z + Cx(&1)) / Cx(&2))` THEN + REWRITE_TAC[COMPLEX_ENTIRE] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CEXP_NZ]; ALL_TAC] THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN + EXISTS_TAC `\z. g (z / Cx(&2)) * g ((z + Cx(&1)) / Cx(&2)):complex` THEN + EXISTS_TAC `z:complex` THEN CONJ_TAC THENL + [REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM]) THEN + REWRITE_TAC[] THEN + ASM GEN_COMPLEX_DIFF_TAC [] THEN + (CONJ_TAC THENL [ASM_REWRITE_TAC[]; CONV_TAC COMPLEX_RING]); + ALL_TAC] THEN + MP_TAC(ISPECL [`h:complex->complex`; `h':complex->complex`; `(:complex)`] + HOLOMORPHIC_DERIVATIVE) THEN + ASM_REWRITE_TAC[OPEN_UNIV] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`h':complex->complex`; `(:complex)`] + HOLOMORPHIC_ON_OPEN) THEN + ASM_REWRITE_TAC[OPEN_UNIV; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h'':complex->complex` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!z. (h''(z / Cx(&2)) + h''((z + Cx(&1)) / Cx(&2))) / Cx(&4) = h''(z)` + ASSUME_TAC THENL + [X_GEN_TAC `z:complex` THEN + MATCH_MP_TAC COMPLEX_DERIVATIVE_UNIQUE_AT THEN + EXISTS_TAC `\z. (h'(z / Cx(&2)) + h'((z + Cx(&1)) / Cx(&2))) / Cx(&2)` THEN + EXISTS_TAC `z:complex` THEN CONJ_TAC THENL + [REWRITE_TAC[]; ASM_REWRITE_TAC[]] THEN + ASM GEN_COMPLEX_DIFF_TAC [] THEN + (CONJ_TAC THENL [ASM_REWRITE_TAC[ETA_AX]; CONV_TAC COMPLEX_RING]); + ALL_TAC] THEN + MP_TAC(ISPECL [`h':complex->complex`; `h'':complex->complex`; `(:complex)`] + HOLOMORPHIC_DERIVATIVE) THEN + ASM_REWRITE_TAC[OPEN_UNIV] THEN DISCH_TAC THEN + SUBGOAL_THEN `!z. z IN (:complex) ==> h''(z) = Cx(&0)` MP_TAC THENL + [MATCH_MP_TAC ANALYTIC_CONTINUATION THEN + EXISTS_TAC `cball(Cx(&0),&1)` THEN EXISTS_TAC `Cx(&0)` THEN + ASM_REWRITE_TAC[CONNECTED_UNIV; SUBSET_UNIV; IN_UNIV] THEN + SIMP_TAC[INTERIOR_LIMIT_POINT; INTERIOR_CBALL; CENTRE_IN_BALL; + OPEN_UNIV; REAL_LT_01] THEN + MP_TAC(ISPECL [`\z. norm((h'':complex->complex) z)`; `cball(Cx(&0),&1)`] + CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[COMPLEX_IN_CBALL_0; COMPACT_CBALL; CBALL_EQ_EMPTY] THEN + REWRITE_TAC[o_DEF] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN ANTS_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + ASM_MESON_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET; + SUBSET_UNIV]; + DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC(NORM_ARITH + `!w:complex. norm(w) <= norm(w) / &2 /\ norm(z) <= norm(w) + ==> z = vec 0`) THEN + EXISTS_TAC `(h'':complex->complex) w` THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(fun th -> + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(a) <= e /\ norm(b) <= e ==> norm(a + b) / &4 <= e / &2`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + UNDISCH_TAC `norm(w:complex) <= &1` THEN + MP_TAC(SPEC `&1` COMPLEX_NORM_CX) THEN CONV_TAC NORM_ARITH]; + REWRITE_TAC[IN_UNIV] THEN DISCH_TAC] THEN + MP_TAC(ISPECL [`h':complex->complex`; `(:complex)`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN + REWRITE_TAC[CONVEX_UNIV; IN_UNIV] THEN ANTS_TAC THENL + [ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN + MP_TAC(ISPECL [`\z. (h:complex->complex) z - a * z`; `(:complex)`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN + REWRITE_TAC[CONVEX_UNIV; IN_UNIV] THEN ANTS_TAC THENL + [GEN_TAC THEN ASM GEN_COMPLEX_DIFF_TAC[] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN + DISCH_THEN(X_CHOOSE_TAC `b:complex`)] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`&1`; `Cx(&0)`]) THEN + MP_TAC(ASSUME `!z:complex. cexp (h z) = g z`) THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[ ASSUME`!x. (h:complex->complex) x = a * x + b`] THEN + REWRITE_TAC[INTEGER_CLOSED; COMPLEX_ADD_LID; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[CEXP_ADD; COMPLEX_MUL_RID] THEN + REWRITE_TAC[COMPLEX_RING `a * b = b <=> a = Cx(&1) \/ b = Cx(&0)`] THEN + REWRITE_TAC[CEXP_NZ; CEXP_EQ_1] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC)) THEN + UNDISCH_TAC `!z:complex. cexp(h z) = g z` THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `n = &0` THENL + [SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX)) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; GSYM CX_DEF] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_LID] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN X_GEN_TAC `z:complex` THEN + ASM_CASES_TAC `?n. integer n /\ z = Cx n` THENL + [REWRITE_TAC[complex_div] THEN + MATCH_MP_TAC(COMPLEX_RING + `z = Cx(&0) /\ ((w = Cx(&0)) \/ (y = Cx(&0))) + ==> w * y = p * z`) THEN + REWRITE_TAC[CGAMMA_EQ_0; CSIN_EQ_0; COMPLEX_INV_EQ_0] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_MUL_SYM; CX_MUL]; ALL_TAC] THEN + REWRITE_TAC[OR_EXISTS_THM; GSYM COMPLEX_ADD_ASSOC] THEN + REWRITE_TAC[COMPLEX_RING `c - z + n = Cx(&0) <=> z = n + c`] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:real` + (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN + REWRITE_TAC[integer] THEN DISCH_THEN(X_CHOOSE_THEN `p:num` + (MP_TAC o MATCH_MP (REAL_ARITH `abs x = n ==> x = n \/ x = --n`))) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[GSYM CX_ADD; CX_INJ; REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; + REAL_ARITH `--p + n = &0 <=> p = n`] THEN + REWRITE_TAC[EXISTS_OR_THM; GSYM EXISTS_REFL] THEN + REWRITE_TAC[ADD_EQ_0; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN + MESON_TAC[num_CASES; ADD1]; + SUBGOAL_THEN `(g:complex->complex) z = g(Cx(&0))` MP_TAC THENL + [ASM_REWRITE_TAC[]; EXPAND_TAC "g"] THEN + ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[INTEGER_CLOSED]] THEN + MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD]; + DISCH_THEN(fun th -> + MP_TAC(SPEC `Cx(inv(&4 * n))` th) THEN MP_TAC(SPEC `Cx(&0)` th)) THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_LID] THEN + SUBGOAL_THEN `g(Cx(&0)) = Cx pi` SUBST1_TAC THENL + [ASM_MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN + REWRITE_TAC[CEXP_ADD] THEN DISCH_THEN SUBST1_TAC THEN + SUBST1_TAC(SYM(SPEC `a:complex` COMPLEX)) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (funpow 3 LAND_CONV o RAND_CONV) [complex_mul] THEN + REWRITE_TAC[RE; IM; REAL_MUL_LZERO; IM_CX; RE_CX] THEN + REWRITE_TAC[CEXP_COMPLEX; REAL_ADD_LID] THEN ASM_SIMP_TAC[REAL_FIELD + `~(n = &0) ==> (&2 * n * pi) * inv(&4 * n) = pi / &2`] THEN + REWRITE_TAC[SIN_PI2; COS_PI2; GSYM ii] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_REFL; REAL_EXP_0] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN EXPAND_TAC "g" THEN + ASM_SIMP_TAC[CX_INJ; REAL_FIELD + `~(n = &0) ==> (inv(&4 * n) = m <=> &4 * m * n = &1)`] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `m:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `abs`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + REPEAT(FIRST_X_ASSUM(CHOOSE_TAC o GEN_REWRITE_RULE I [integer])) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; MULT_EQ_1] THEN + CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(MESON[] `real y /\ ~real x ==> ~(x = y)`) THEN + SIMP_TAC[GSYM CX_SUB; GSYM CX_MUL; REAL_CX; REAL_SIN; REAL_GAMMA; + REAL_MUL; ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] REAL_MUL_CX] THEN + REWRITE_TAC[PI_NZ; real; IM_II] THEN ARITH_TAC]]);; + +let CGAMMA_HALF = prove + (`cgamma(Cx(&1) / Cx(&2)) = Cx(sqrt pi)`, + MP_TAC(SPEC `Cx(&1) / Cx(&2)` CGAMMA_REFLECTION) THEN + REWRITE_TAC[COMPLEX_RING `Cx(&1) - Cx(&1) / Cx(&2) = Cx(&1) / Cx(&2)`] THEN + REWRITE_TAC[GSYM CX_DIV; GSYM CX_MUL; GSYM CX_SIN] THEN + REWRITE_TAC[REAL_ARITH `x * &1 / &2 = x / &2`; SIN_PI2; REAL_DIV_1] THEN + SUBGOAL_THEN `Cx pi = Cx(sqrt pi) pow 2` SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_POW] THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[SQRT_POW2; PI_POS_LE]; + REWRITE_TAC[COMPLEX_RING + `a * a:complex = b pow 2 <=> a = b \/ a = --b`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `Cx(&1 / &2)` RE_POS_CGAMMA_REAL) THEN + ASM_REWRITE_TAC[REAL_CX; RE_CX; RE_NEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + REWRITE_TAC[REAL_ARITH `~(&0 <= --x) <=> &0 < x`] THEN + MATCH_MP_TAC SQRT_POS_LT THEN REWRITE_TAC[PI_POS]]);; + +let CGAMMA_LEGENDRE = prove + (`!z. cgamma(z) * cgamma(z + Cx(&1) / Cx(&2)) = + Cx(&2) cpow (Cx(&1) - Cx(&2) * z) * Cx(sqrt pi) * cgamma(Cx(&2) * z)`, + REWRITE_TAC[CGAMMA_LEGENDRE_ALT; CGAMMA_HALF]);; + +(* ------------------------------------------------------------------------- *) +(* Thw Weierstrass product definition. *) +(* ------------------------------------------------------------------------- *) + +let CGAMMA_WEIERSTRASS = prove + (`!z. ((\n. cexp(--(Cx euler_mascheroni) * z) / z * + cproduct(1..n) (\k. cexp(z / Cx(&k)) / (Cx(&1) + z / Cx(&k)))) + --> cgamma z) sequentially`, + GEN_TAC THEN SIMP_TAC[complex_div; CPRODUCT_MUL; FINITE_NUMSEG] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. (cexp(--Cx euler_mascheroni * z) * + cproduct(1..n) (\k. cexp(z * inv(Cx(&k)))) * + cexp(--Cx(log(&n)) * z)) * + (Cx(&n) cpow z / z * + cproduct (1..n) (\k. inv(Cx(&1) + z * inv(Cx(&k)))))` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN CONJ_TAC THENL + [EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN + MATCH_MP_TAC(COMPLEX_RING + `c * c' = Cx(&1) ==> (a * b * c) * (c' * d) * e = ((a * d) * b * e)`) THEN + ASM_SIMP_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; LE_1; GSYM CEXP_ADD] THEN + REWRITE_TAC[GSYM CEXP_0] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LE_1] THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_MUL_LID] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [SIMP_TAC[GSYM CEXP_VSUM; FINITE_NUMSEG; GSYM CEXP_ADD] THEN + REWRITE_TAC[GSYM CEXP_0] THEN + MATCH_MP_TAC(ISPEC `cexp` LIM_CONTINUOUS_FUNCTION) THEN + SIMP_TAC[CONTINUOUS_AT_CEXP; VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + REWRITE_TAC[COMPLEX_RING + `--w * z + z * x + --y * z:complex = z * ((x - y) - w)`] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + REWRITE_TAC[GSYM LIM_NULL_COMPLEX] THEN + REWRITE_TAC[GSYM CX_INV; VSUM_CX] THEN + REWRITE_TAC[GSYM CX_SUB; REWRITE_RULE[o_DEF] (GSYM REALLIM_COMPLEX)] THEN + REWRITE_TAC[EULER_MASCHERONI]; + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC + `\n. (Cx(&n) cpow z * Cx(&(FACT n))) / + cproduct(0..n) (\m. z + Cx(&m))` THEN + REWRITE_TAC[CGAMMA] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[COMPLEX_ADD_RID; ADD_CLAUSES] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; GSYM COMPLEX_MUL_ASSOC] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV + [COMPLEX_RING `a * b * c:complex = b * a * c`] THEN + AP_TERM_TAC THEN SIMP_TAC[CPRODUCT_INV; FINITE_NUMSEG] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM COMPLEX_INV_INV] THEN + REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(z = Cx(&0)) /\ z * x = y ==> inv z * y = x`) THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN + CONV_TAC SYM_CONV THEN SPEC_TAC(`n:num`,`p:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[FACT; CPRODUCT_CLAUSES_NUMSEG; ARITH] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`; COMPLEX_MUL_LID] THEN + ASM_REWRITE_TAC[CX_MUL; GSYM REAL_OF_NUM_MUL] THEN + MATCH_MP_TAC(COMPLEX_RING + `d * e:complex = c ==> (a * b) * c = (d * a) * b * e`) THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(p = Cx(&0)) ==> p * (Cx(&1) + z * inv p) = z + p`) THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; NOT_SUC]]);; + +(* ------------------------------------------------------------------------- *) +(* Sometimes the reciprocal function is convenient, since it's entire. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA = prove + (`!z. (inv o cgamma) complex_differentiable (at z)`, + GEN_TAC THEN ASM_CASES_TAC `!n. ~(z + Cx(&n) = Cx(&0))` THENL + [MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_COMPOSE_AT THEN + ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_CGAMMA] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_INV_AT THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_ID; CGAMMA_EQ_0] THEN + ASM_MESON_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[COMPLEX_RING `z + w = Cx(&0) <=> z = --w`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + REWRITE_TAC[complex_differentiable; HAS_COMPLEX_DERIVATIVE_AT] THEN + REWRITE_TAC[o_DEF; CGAMMA_POLES; COMPLEX_INV_0; complex_div; + COMPLEX_MUL_LZERO; COMPLEX_SUB_RZERO] THEN + SIMP_TAC[GSYM COMPLEX_INV_MUL; COMPLEX_RING `x - --z:complex = x + z`] THEN + EXISTS_TAC `inv(--Cx(&1) pow n / Cx(&(FACT n)))` THEN + MATCH_MP_TAC LIM_COMPLEX_INV THEN + REWRITE_TAC[COMPLEX_DIV_EQ_0; COMPLEX_POW_EQ_0; CX_INJ] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + REWRITE_TAC[CGAMMA_SIMPLE_POLES] THEN CONV_TAC COMPLEX_RING]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_RECIP_CGAMMA = prove + (`!z s. (inv o cgamma) complex_differentiable at z within s`, + SIMP_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA]);; + +let HOLOMORPHIC_ON_RECIP_CGAMMA = prove + (`!s. (inv o cgamma) holomorphic_on s`, + REWRITE_TAC[HOLOMORPHIC_ON_DIFFERENTIABLE] THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_WITHIN_RECIP_CGAMMA]);; + +let CONTINUOUS_AT_RECIP_CGAMMA = prove + (`!z. (inv o cgamma) continuous at z`, + SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT; + COMPLEX_DIFFERENTIABLE_AT_RECIP_CGAMMA]);; + +let CONTINUOUS_WITHIN_RECIP_CGAMMA = prove + (`!z s. (inv o cgamma) continuous at z within s`, + SIMP_TAC[COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; + COMPLEX_DIFFERENTIABLE_WITHIN_RECIP_CGAMMA]);; + +let CONTINUOUS_ON_RECIP_CGAMMA = prove + (`!s. (inv o cgamma) continuous_on s`, + SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON; HOLOMORPHIC_ON_RECIP_CGAMMA]);; + +let RECIP_CGAMMA = prove + (`!z. ((\n. cproduct(0..n) (\m. z + Cx(&m)) / + (Cx(&n) cpow z * Cx(&(FACT n)))) --> inv(cgamma z)) + sequentially`, + GEN_TAC THEN ASM_CASES_TAC `!n. ~(z + Cx(&n) = Cx(&0))` THENL + [ONCE_REWRITE_TAC[GSYM COMPLEX_INV_INV] THEN + MATCH_MP_TAC LIM_COMPLEX_INV THEN + REWRITE_TAC[COMPLEX_INV_INV; CGAMMA; COMPLEX_INV_DIV; CGAMMA_EQ_0] THEN + ASM_MESON_TAC[]; + SUBGOAL_THEN `cgamma z = Cx(&0)` SUBST1_TAC THENL + [ASM_MESON_TAC[CGAMMA_EQ_0]; REWRITE_TAC[COMPLEX_INV_0]] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; COMPLEX_DIV_EQ_0; COMPLEX_ENTIRE] THEN + SIMP_TAC[CPRODUCT_EQ_0; IN_NUMSEG; FINITE_NUMSEG; LE_0] THEN + ASM_MESON_TAC[]]);; + +let RECIP_CGAMMA_WEIERSTRASS = prove + (`!n. ((\n. (z * cexp(Cx euler_mascheroni * z) * + cproduct(1..n) (\k. (Cx(&1) + z / Cx(&k)) / cexp(z / Cx(&k))))) + --> inv(cgamma z)) sequentially`, + GEN_TAC THEN ASM_CASES_TAC `?n. z + Cx(&n) = Cx(&0)` THENL + [FIRST_X_ASSUM(X_CHOOSE_TAC `N:num`) THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN + DISCH_TAC THEN SUBGOAL_THEN `cgamma(z) = Cx(&0)` SUBST1_TAC THENL + [ASM_MESON_TAC[CGAMMA_EQ_0]; REWRITE_TAC[COMPLEX_INV_0]] THEN + REWRITE_TAC[COMPLEX_ENTIRE; COMPLEX_DIV_EQ_0] THEN + ASM_CASES_TAC `N = 0` THENL [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN + REPEAT DISJ2_TAC THEN + SIMP_TAC[CPRODUCT_EQ_0; FINITE_NUMSEG; IN_NUMSEG] THEN + EXISTS_TAC `N:num` THEN ASM_SIMP_TAC[LE_1; COMPLEX_DIV_EQ_0] THEN + DISJ1_TAC THEN MATCH_MP_TAC(COMPLEX_FIELD + `x + n = Cx(&0) /\ ~(n = Cx(&0)) ==> Cx(&1) + x / n = Cx(&0)`) THEN + ASM_REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ]; + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) + [GSYM COMPLEX_INV_INV] THEN + MATCH_MP_TAC LIM_COMPLEX_INV THEN + ASM_REWRITE_TAC[CGAMMA_EQ_0] THEN + SIMP_TAC[COMPLEX_INV_MUL; GSYM CEXP_NEG; GSYM CPRODUCT_INV; + FINITE_NUMSEG; GSYM COMPLEX_MUL_LNEG; COMPLEX_INV_DIV] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `inv z * a * b:complex = a / z * b`] THEN + REWRITE_TAC[CGAMMA_WEIERSTRASS]]);; + +(* ------------------------------------------------------------------------- *) +(* The real gamma function. *) +(* ------------------------------------------------------------------------- *) + +let gamma = new_definition + `gamma(x) = Re(cgamma(Cx x))`;; + +let CX_GAMMA = prove + (`!x. Cx(gamma x) = cgamma(Cx x)`, + REWRITE_TAC[gamma] THEN MESON_TAC[REAL; REAL_CX; REAL_GAMMA]);; + +let GAMMA = prove + (`!x. ((\n. (&n rpow x * &(FACT n)) / product(0..n) (\m. x + &m)) + ---> gamma(x)) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_GAMMA; CX_DIV] THEN + X_GEN_TAC `x:real` THEN MP_TAC(SPEC `Cx x` CGAMMA) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[CX_MUL; CX_PRODUCT; FINITE_NUMSEG; CX_ADD; cpow; rpow; + CX_INJ; REAL_OF_NUM_EQ; REAL_OF_NUM_LT; LE_1; CX_LOG; CX_EXP]);; + +let GAMMA_EQ_0 = prove + (`!x. gamma(x) = &0 <=> ?n. x + &n = &0`, + REWRITE_TAC[GSYM CX_INJ; CX_ADD; CX_GAMMA; CGAMMA_EQ_0]);; + +let REAL_DIFFERENTIABLE_AT_GAMMA = prove + (`!x. (!n. ~(x + &n = &0)) ==> gamma real_differentiable atreal x`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `Cx x` COMPLEX_DIFFERENTIABLE_AT_CGAMMA) THEN + ASM_REWRITE_TAC[GSYM CX_ADD; CX_INJ; complex_differentiable] THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; real_differentiable] THEN + REWRITE_TAC[GSYM CX_GAMMA; HAS_REAL_DERIVATIVE_ATREAL] THEN + REWRITE_TAC[REALLIM_COMPLEX; o_DEF] THEN + DISCH_THEN(X_CHOOSE_TAC `f':complex`) THEN + SUBGOAL_THEN `real f'` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `at (Cx x) within real` REAL_LIM) THEN + EXISTS_TAC `\z. (cgamma z - Cx(gamma x)) / (z - Cx x)` THEN + ASM_SIMP_TAC[LIM_AT_WITHIN] THEN REWRITE_TAC[WITHIN; AT] THEN + SIMP_TAC[TRIVIAL_LIMIT_WITHIN_CONVEX; CONVEX_REAL] THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN_REAL; REAL_CX] THEN + REWRITE_TAC[SET_RULE `p /\ x IN real <=> real x /\ p`] THEN + SIMP_TAC[REAL_EXISTS; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[GSYM REAL_EXISTS; GSYM CX_SUB; GSYM CX_DIV; + GSYM CX_GAMMA; REAL_CX] THEN + REPEAT(EXISTS_TAC `Cx(x + &1)`) THEN + REWRITE_TAC[REAL_LE_REFL; REAL_CX; DIST_CX] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `f':real` SUBST_ALL_TAC) THEN + EXISTS_TAC `f':real` THEN REWRITE_TAC[LIM_ATREAL_ATCOMPLEX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT]) THEN + REWRITE_TAC[LIM_WITHIN; o_DEF; CX_SUB; CX_DIV; CX_GAMMA] THEN + SIMP_TAC[IMP_CONJ; IN; REAL_EXISTS; LEFT_IMP_EXISTS_THM; RE_CX] THEN + MESON_TAC[]]);; + +let REAL_DIFFERENTIABLE_WITHIN_GAMMA = prove + (`!x s. (!n. ~(x + &n = &0)) ==> gamma real_differentiable atreal x within s`, + SIMP_TAC[REAL_DIFFERENTIABLE_AT_GAMMA; + REAL_DIFFERENTIABLE_ATREAL_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_GAMMA = prove + (`!s. s SUBSET {x | !n. ~(x + &n = &0)} ==> gamma real_differentiable_on s`, + SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_WITHIN_GAMMA]);; + +let REAL_CONTINUOUS_ATREAL_GAMMA = prove + (`!x. (!n. ~(x + &n = &0)) ==> gamma real_continuous atreal x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_ATREAL] THEN + REWRITE_TAC[o_DEF; CX_GAMMA] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_WITHIN; REWRITE_RULE[o_DEF] LINEAR_CX_RE] THEN + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_AT_CGAMMA THEN + ASM_REWRITE_TAC[GSYM CX_ADD; RE_CX; CX_INJ]);; + +let REAL_CONTINUOUS_WITHIN_GAMMA = prove + (`!x s. (!n. ~(x + &n = &0)) ==> gamma real_continuous atreal x within s`, + SIMP_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; REAL_CONTINUOUS_ATREAL_GAMMA]);; + +let REAL_CONTINUOUS_ON_GAMMA = prove + (`!s. s SUBSET {x | !n. ~(x + &n = &0)} ==> gamma real_continuous_on s`, + SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_GAMMA]);; + +let GAMMA_RECURRENCE_ALT = prove + (`!x. gamma(x) = gamma(x + &1) / x`, + REWRITE_TAC[GSYM CX_INJ; CX_DIV; CX_GAMMA; CX_ADD] THEN + REWRITE_TAC[GSYM CGAMMA_RECURRENCE_ALT]);; + +let GAMMA_1 = prove + (`gamma(&1) = &1`, + REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CGAMMA_1]);; + +let GAMMA_RECURRENCE = prove + (`!x. gamma(x + &1) = if x = &0 then &1 else x * gamma(x)`, + REWRITE_TAC[GSYM CX_INJ; CX_GAMMA] THEN + GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [COND_RAND] THEN + REWRITE_TAC[CX_MUL; CX_GAMMA; CX_ADD; GSYM CGAMMA_RECURRENCE]);; + +let GAMMA_FACT = prove + (`!n. gamma(&(n + 1)) = &(FACT n)`, + REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CGAMMA_FACT]);; + +let GAMMA_POLES = prove + (`!n. gamma(--(&n)) = &0`, + REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CGAMMA_POLES; CX_NEG]);; + +let GAMMA_SIMPLE_POLES = prove + (`!n. ((\x. (x + &n) * gamma x) ---> -- &1 pow n / &(FACT n)) + (atreal(-- &n))`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; LIM_ATREAL_ATCOMPLEX] THEN + GEN_TAC THEN + REWRITE_TAC[CX_MUL; CX_ADD; CX_GAMMA; CX_DIV; CX_POW; CX_NEG] THEN + SUBGOAL_THEN + `(\z. (Cx(Re z) + Cx(&n)) * cgamma(Cx(Re z))) = + (\z. (z + Cx(&n)) * cgamma z) o (Cx o Re)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPOSE_WITHIN THEN + MAP_EVERY EXISTS_TAC [`(:complex)`; `--Cx(&n)`] THEN + REWRITE_TAC[CGAMMA_SIMPLE_POLES; WITHIN_UNIV] THEN + REWRITE_TAC[EVENTUALLY_WITHIN; o_DEF; IN_UNIV; GSYM DIST_NZ] THEN + REWRITE_TAC[real; IN; GSYM CX_NEG; CX_INJ] THEN + REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_01]] THEN + MATCH_MP_TAC LIM_AT_WITHIN THEN LIM_TAC THEN REWRITE_TAC[RE_CX] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] LINEAR_CX_RE]);; + +let GAMMA_POS_LE = prove + (`!x. &0 <= x ==> &0 <= gamma x`, + SIMP_TAC[gamma; RE_POS_CGAMMA_REAL; RE_CX; REAL_CX]);; + +let GAMMA_POS_LT = prove + (`!x. &0 < x ==> &0 < gamma x`, + SIMP_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`; GAMMA_POS_LE] THEN + REWRITE_TAC[GAMMA_EQ_0] THEN REAL_ARITH_TAC);; + +let GAMMA_LEGENDRE_ALT = prove + (`!x. gamma(x) * gamma(x + &1 / &2) = + &2 rpow (&1 - &2 * x) * gamma(&1 / &2) * gamma(&2 * x)`, + REWRITE_TAC[GSYM CX_INJ; CX_GAMMA; CX_ADD; + CX_DIV; CGAMMA_LEGENDRE_ALT; CX_MUL] THEN + REWRITE_TAC[cpow; rpow; CX_INJ; REAL_OF_NUM_LT; REAL_OF_NUM_EQ; ARITH] THEN + SIMP_TAC[CX_MUL; CX_EXP; CX_SUB; CX_LOG; REAL_OF_NUM_LT; ARITH]);; + +let GAMMA_REFLECTION = prove + (`!x. gamma(x) * gamma(&1 - x) = pi / sin(pi * x)`, + SIMP_TAC[GSYM CX_INJ; CX_MUL; CX_DIV; CX_GAMMA; CX_SIN; CX_SUB] THEN + REWRITE_TAC[CGAMMA_REFLECTION]);; + +let GAMMA_HALF = prove + (`gamma(&1 / &2) = sqrt pi`, + REWRITE_TAC[GSYM CX_INJ; CX_DIV; CX_GAMMA; CGAMMA_HALF]);; + +let GAMMA_LEGENDRE = prove + (`!x. gamma(x) * gamma(x + &1 / &2) = + &2 rpow (&1 - &2 * x) * sqrt pi * gamma(&2 * x)`, + REWRITE_TAC[GAMMA_LEGENDRE_ALT; GAMMA_HALF]);; + +let GAMMA_WEIERSTRASS = prove + (`!x. ((\n. exp(--(euler_mascheroni) * x) / x * + product(1..n) (\k. exp(x / &k) / (&1 + x / &k))) + ---> gamma x) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_GAMMA; CX_DIV] THEN + X_GEN_TAC `x:real` THEN MP_TAC(SPEC `Cx x` CGAMMA_WEIERSTRASS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[CX_MUL; CX_DIV; CX_EXP; CX_NEG; CX_PRODUCT; FINITE_NUMSEG; + CX_ADD]);; + +(* ------------------------------------------------------------------------- *) +(* Characterization of the real gamma function using log-convexity. *) +(* ------------------------------------------------------------------------- *) + +let REAL_LOG_CONVEX_GAMMA = prove + (`!s. (!x. x IN s ==> &0 < x) ==> gamma real_log_convex_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LOG_CONVEX_ON_SUBSET THEN + EXISTS_TAC `{x | &0 < x}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN POP_ASSUM(K ALL_TAC) THEN + MATCH_MP_TAC(ISPEC `sequentially` REAL_LOG_CONVEX_LIM) THEN + EXISTS_TAC `\n x. (&n rpow x * &(FACT n)) / product(0..n) (\m. x + &m)` THEN + REWRITE_TAC[GAMMA; TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REPEAT(MATCH_MP_TAC REAL_LOG_CONVEX_MUL THEN CONJ_TAC) THEN + SIMP_TAC[REAL_LOG_CONVEX_CONST; REAL_POS] THEN + ASM_SIMP_TAC[REAL_LOG_CONVEX_RPOW_RIGHT; REAL_OF_NUM_LT; LE_1] THEN + SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_LOG_CONVEX_PRODUCT THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN + MATCH_MP_TAC MIDPOINT_REAL_LOG_CONVEX THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_INV_EQ; REAL_LTE_ADD; REAL_POS] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_INV_MUL; REAL_POW_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LTE_ADD; REAL_POS] THEN + REWRITE_TAC[REAL_LE_POW_2; REAL_ARITH + `(x + &k) * (y + &k) <= ((x + y) / &2 + &k) pow 2 <=> + &0 <= (x - y) pow 2`]]);; + +let GAMMA_REAL_LOG_CONVEX_UNIQUE = prove + (`!f:real->real. + f(&1) = &1 /\ (!x. &0 < x ==> f(x + &1) = x * f(x)) /\ + (!x. &0 < x ==> &0 < f x) /\ f real_log_convex_on {x | &0 < x} + ==> !x. &0 < x ==> f x = gamma x`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!x. &0 < x /\ x <= &1 ==> f x = gamma x` ASSUME_TAC THENL + [ALL_TAC; + SUBGOAL_THEN + `!y. &0 < y /\ y <= &1 ==> !n. f(&n + y) = gamma(&n + y)` + ASSUME_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN + INDUCT_TAC THEN ASM_SIMP_TAC[REAL_ADD_LID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[REAL_ARITH `(n + &1) + x = (n + x) + &1`] THEN + ASM_SIMP_TAC[GAMMA_RECURRENCE; REAL_LET_ADD; REAL_POS] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` FLOOR_POS) THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `frac x = &0` THEN ASM_REWRITE_TAC[REAL_LT_LE] THENL + [ASM_CASES_TAC `n = 0` THEN + ASM_SIMP_TAC[REAL_ADD_RID; REAL_LT_IMP_NZ] THEN + SUBGOAL_THEN `&(n - 1) + &1 = &n` + (fun th -> ASM_MESON_TAC[th; REAL_LE_REFL; REAL_LT_01]) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LE_1] THEN REAL_ARITH_TAC; + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `frac x`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]]]] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `x = &1` THEN ASM_REWRITE_TAC[GAMMA_1] THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_FIELD `&0 < g /\ f / g = &1 ==> f = g`) THEN + ASM_SIMP_TAC[GAMMA_POS_LT] THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC + `\n. f(x) / ((&n rpow x * &(FACT n)) / product (0..n) (\m. x + &m))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_SIMP_TAC[REALLIM_DIV; REALLIM_CONST; GAMMA_POS_LT; + GAMMA; REAL_LT_IMP_NZ] THEN + ONCE_REWRITE_TAC[REALLIM_NULL] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. x * inv(&n)` THEN + SIMP_TAC[REALLIM_NULL_LMUL; REALLIM_1_OVER_N] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `2` THEN + SUBGOAL_THEN + `!n. &2 <= &n + ==> log(f(&n)) - log(f(&n - &1)) + <= (log(f(&n + x)) - log(f(&n))) / x /\ + (log(f(&n + x)) - log(f(&n))) / x + <= log(f(&n + &1)) - log(f(&n))` + MP_TAC THENL + [MP_TAC(SPECL [`f:real->real`; `{x | &0 < x}`] REAL_LOG_CONVEX_ON) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_TAC] THEN + MAP_EVERY (MP_TAC o SPECL [`log o f:real->real`; `{x | &0 < x}`]) + [REAL_CONVEX_ON_LEFT_SECANT; REAL_CONVEX_ON_RIGHT_SECANT] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(LABEL_TAC "L") THEN DISCH_THEN(LABEL_TAC "R") THEN + REPEAT STRIP_TAC THENL + [USE_THEN "L" (MP_TAC o SPECL [`&n - &1`; `&n + x`; `&n`]) THEN + USE_THEN "R" (MP_TAC o SPECL [`&n - &1`; `&n + x`; `&n`]) THEN + REWRITE_TAC[IN_ELIM_THM; IN_REAL_SEGMENT; o_THM] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `abs(x - (x - &1)) = &1`; REAL_DIV_1] THEN + DISCH_TAC THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs((n + x) - n) = x`] THEN + ASM_REAL_ARITH_TAC; + ASM_CASES_TAC `x = &1` THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_DIV_1] THEN + USE_THEN "R" (MP_TAC o SPECL [`&n`; `&n + &1`; `&n + x`]) THEN + REWRITE_TAC[IN_ELIM_THM; IN_REAL_SEGMENT; o_THM] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `abs((n + &1) - n) = &1`; REAL_DIV_1] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs((n + x) - n) = x`] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM LOG_DIV; REAL_LT_MUL; + REAL_ARITH `&2 <= x ==> &0 < x /\ &0 < x + &1 /\ &0 < x - &1`; + REAL_FIELD `&0 < x ==> (n * x) / x = n`] THEN + SUBGOAL_THEN + `!n. &2 <= n ==> f(n - &1) = f(n) / (n - &1)` (fun th -> SIMP_TAC[th]) + THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(f:real->real) n = f((n - &1) + &1)` SUBST1_TAC THENL + [AP_TERM_TAC THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ARITH `&2 <= n ==> &0 < n - &1`] THEN + UNDISCH_TAC `&2 <= n` THEN CONV_TAC REAL_FIELD]; + ASM_SIMP_TAC[REAL_ARITH `&2 <= x ==> &0 < x`; REAL_FIELD + `&0 < x /\ &2 <= y ==> x / (x / (y - &1)) = y - &1`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ]] THEN + SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_SUB; + ARITH_RULE `2 <= n ==> 1 <= n`] THEN + REWRITE_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD] THEN + SUBGOAL_THEN + `!n. 0 < n ==> f(&n) = &(FACT(n - 1))` + (fun th -> SIMP_TAC[ARITH_RULE `2 <= n ==> 0 < n /\ 0 < n - 1`; th]) + THENL + [INDUCT_TAC THEN REWRITE_TAC[ARITH; LT_0] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[REAL_ADD_LID; FACT; ARITH] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC n - 1 = SUC(n - 1)`] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUC; LE_1; FACT] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; MULT_SYM]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o BINOP_CONV) + [GSYM REAL_EXP_MONO_LE] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[REAL_EXP_ADD; EXP_LOG; REAL_OF_NUM_LT; LE_1; FACT_NZ; + ARITH_RULE `&2 <= &n /\ &0 < x ==> &0 < &n + x`] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN + SUBGOAL_THEN + `!n. 0 < n ==> f(&n + x) = product(0..n-1) (\k. x + &k) * f(x)` + (fun th -> SIMP_TAC[ARITH_RULE `2 <= n ==> 0 < n`; th]) + THENL + [INDUCT_TAC THEN REWRITE_TAC[ARITH] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_SIMP_TAC[REAL_ARITH `(&0 + &1) + x = x + &1`; ARITH] THEN + REWRITE_TAC[PRODUCT_SING_NUMSEG; REAL_ADD_RID]; + ASM_SIMP_TAC[REAL_ARITH `(n + &1) + x = (n + x) + &1`; + REAL_LT_ADD; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC n - 1 = SUC(n - 1)`] THEN + REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; LE_0] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN + REWRITE_TAC[REAL_MUL_AC; REAL_ADD_AC]]; + DISCH_TAC] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&1 <= x /\ x <= &1 + e ==> abs(x - &1) <= e`) THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_FIELD + `&2 <= n ==> &1 + x * inv n = (x + n) / n`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN + ONCE_REWRITE_TAC[REAL_ARITH `f * (r * n) * p:real = (p * f) * r * n`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `&0 < &n rpow x * &(FACT n)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_MUL; REAL_OF_NUM_LT; LE_1; FACT_NZ; + RPOW_POS_LT; ARITH_RULE `2 <= x ==> 0 < x`]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_MUL_LID] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(MP_TAC o CONJUNCT1)] THEN + REWRITE_TAC[ADD_SUB] THEN + ASM_SIMP_TAC[rpow; REAL_OF_NUM_LE; REAL_ARITH `&2 <= x ==> &0 < x`] THEN + REWRITE_TAC[REAL_MUL_AC]; + ASM_SIMP_TAC[PRODUCT_CLAUSES_RIGHT; LE_0; + ARITH_RULE `2 <= n ==> 0 < n`] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC LAND_CONV + [REAL_ARITH `a * b * c * d:real = b * (a * c) * d`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + SUBGOAL_THEN `FACT n = FACT(SUC(n - 1))` SUBST1_TAC THENL + [AP_TERM_TAC THEN ASM_ARITH_TAC; REWRITE_TAC[FACT]] THEN + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> SUC(n - 1) = n`] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `&0 < &n` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + SIMP_TAC[rpow; GSYM REAL_OF_NUM_MUL; REAL_MUL_AC] THEN + CONV_TAC REAL_FIELD]]);; + +(* ------------------------------------------------------------------------- *) +(* The integral definition, the current usual one and Euler's original one. *) +(* ------------------------------------------------------------------------- *) + +let EULER_HAS_INTEGRAL_CGAMMA = prove + (`!z. &0 < Re z + ==> ((\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))) + has_integral cgamma(z)) + {t | &0 <= drop t}`, + let lemma0 = prove + (`!z a b. &0 < Re z /\ &0 <= drop a + ==> (\t. Cx(drop t) cpow z) continuous_on interval [a,b]`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + ASM_CASES_TAC `t:real^1 = vec 0` THENL + [ASM_SIMP_TAC[CONTINUOUS_WITHIN; cpow; CX_INJ; GSYM LIFT_EQ; LIFT_NUM; + LIFT_DROP] THEN + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX_NORM] THEN + REWRITE_TAC[NORM_CEXP] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + EXISTS_TAC `\t. Cx(exp(Re z * log(drop t)))` THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [X_GEN_TAC `u:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DIST_0; NORM_POS_LT; GSYM DROP_EQ; + LIFT_DROP; DROP_VEC] THEN + STRIP_TAC THEN SUBGOAL_THEN `&0 < drop u` + (fun th -> SIMP_TAC[GSYM CX_LOG; RE_MUL_CX; th]) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[LIM_WITHIN; IN_INTERVAL_1; DIST_CX; REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e rpow inv(Re z)` THEN + ASM_SIMP_TAC[RPOW_POS_LT; DIST_0; REAL_ABS_EXP] THEN + X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN + SUBGOAL_THEN `e = exp(log e)` SUBST1_TAC THENL + [ASM_MESON_TAC[EXP_LOG]; REWRITE_TAC[REAL_EXP_MONO_LT]] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`] THEN + ASM_SIMP_TAC[GSYM LOG_RPOW] THEN MATCH_MP_TAC LOG_MONO_LT_IMP THEN + SUBGOAL_THEN `norm u = drop u` (fun th -> ASM_MESON_TAC[th]) THEN + REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN THEN + SUBGOAL_THEN + `(\a. Cx(drop a) cpow z) = (\w. w cpow z) o Cx o drop` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN + REWRITE_TAC[linear; o_DEF; DROP_ADD; DROP_CMUL; CX_ADD; + COMPLEX_CMUL; GSYM CX_MUL]; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE THEN + COMPLEX_DIFFERENTIABLE_TAC THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[o_DEF; RE_CX] THEN + ASM_REWRITE_TAC[REAL_LT_LE; GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]]) in + let lemma1 = prove + (`!n z. &0 < Re z + ==> ((\t. Cx(drop t) cpow (z - Cx(&1)) * Cx(&1 - drop t) pow n) + has_integral Cx(&(FACT n)) / cproduct (0..n) (\m. z + Cx(&m))) + (interval[vec 0,vec 1])`, + INDUCT_TAC THEN X_GEN_TAC `z:complex` THEN + ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[RE_CX; REAL_LT_REFL] THEN + DISCH_TAC THENL + [REWRITE_TAC[complex_pow; COMPLEX_MUL_RID; CPRODUCT_CLAUSES_NUMSEG] THEN + MP_TAC(ISPECL + [`\t. Cx(drop t) cpow z / z`; + `\t. Cx(drop t) cpow (z - Cx(&1))`; + `vec 0:real^1`; `vec 1:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN + REWRITE_TAC[DROP_VEC; CPOW_1; CPOW_0; FACT; complex_div] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID; COMPLEX_SUB_RZERO] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN + MATCH_MP_TAC lemma0 THEN ASM_REWRITE_TAC[DROP_VEC; REAL_POS]; + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[CX_SUB] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + COMPLEX_DIFF_TAC THEN ASM_REWRITE_TAC[RE_CX] THEN + UNDISCH_TAC `~(z = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; + FIRST_X_ASSUM(MP_TAC o SPEC `z + Cx(&1)`) THEN + REWRITE_TAC[RE_ADD; RE_CX; COMPLEX_RING `(z + Cx(&1)) - Cx(&1) = z`] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + MP_TAC(ISPECL + [`complex_mul`; + `\t. Cx(drop t) cpow z`; + `\t. Cx(&1) / Cx(&n + &1) * Cx(&1 - drop t) pow (n + 1)`; + `\t. z * Cx(drop t) cpow (z - Cx(&1))`; + `\t. --(Cx(&1 - drop t) pow n)`; + `vec 0:real^1`; `vec 1:real^1`; + `{vec 0:real^1}`; + `Cx(&(FACT n)) / cproduct (0..n) (\m. (z + Cx(&1)) + Cx(&m))`] + INTEGRATION_BY_PARTS) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL; DROP_VEC; + REAL_POS; COUNTABLE_SING] THEN + REWRITE_TAC[CPOW_0; REAL_SUB_REFL; COMPLEX_POW_ZERO; + ADD_EQ_0; ARITH] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; COMPLEX_SUB_LZERO] THEN + REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_RING `--Cx(&0) - y = --y`] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + ASM_SIMP_TAC[lemma0; DROP_VEC; REAL_POS] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_POW THEN + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_SUB; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]; + SIMP_TAC[IN_INTERVAL_1; DROP_VEC; IN_DIFF; + IN_SING; GSYM DROP_EQ] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CX_SUB] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + COMPLEX_DIFF_TAC THEN + ASM_REWRITE_TAC[RE_CX; COMPLEX_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; ADD_SUB; COMPLEX_MUL_ASSOC] THEN + MP_TAC(ARITH_RULE `~(n + 1 = 0)`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM CX_INJ] THEN + CONV_TAC COMPLEX_FIELD; + MATCH_MP_TAC HAS_INTEGRAL_NEG THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o SPEC `Cx(&n + &1) / z` o + MATCH_MP HAS_INTEGRAL_COMPLEX_LMUL) THEN + ASM_SIMP_TAC[REAL_ARITH `~(&n + &1 = &0)`; CX_INJ; COMPLEX_FIELD + `~(n = Cx(&0)) /\ ~(z = Cx(&0)) + ==> n / z * (z * p) * Cx(&1) / n * q = p * q`] THEN + REWRITE_TAC[GSYM ADD1] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FACT; GSYM REAL_OF_NUM_MUL; CX_MUL; GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + SIMP_TAC[CPRODUCT_CLAUSES_LEFT; ARITH_RULE `0 <= SUC n`] THEN + REWRITE_TAC[ADD1; COMPLEX_INV_MUL; COMPLEX_ADD_RID] THEN + REWRITE_TAC[ISPECL [`f:num->complex`; `m:num`; `1`] + CPRODUCT_OFFSET] THEN + REWRITE_TAC[GSYM COMPLEX_ADD_ASSOC; GSYM CX_ADD; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[ARITH_RULE `n + 1 = 1 + n`; COMPLEX_MUL_AC]]]) in + let lemma2 = prove + (`!z n. &0 < Re z + ==> ((\t. if drop t <= &n + then Cx(drop t) cpow (z - Cx(&1)) * + Cx(&1 - drop t / &n) pow n + else Cx(&0)) + has_integral (Cx(&n) cpow z * Cx(&(FACT n))) / + cproduct (0..n) (\m. z + Cx(&m))) + {t | &0 <= drop t}`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[CPOW_0; COMPLEX_MUL_LZERO; complex_div] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC [`\t:real^1. Cx(&0)`; `{vec 0:real^1}`] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_INTEGRAL_0; NEGLIGIBLE_SING] THEN + REWRITE_TAC[IN_DIFF; IN_SING; GSYM DROP_EQ; DROP_VEC; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN + REWRITE_TAC[HAS_INTEGRAL_RESTRICT_INTER] THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP lemma1) THEN + DISCH_THEN(MP_TAC o SPECL [`inv(&n)`; `vec 0:real^1`] o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY)) THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1] THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_OF_NUM_EQ; LE_1; REAL_ABS_INV] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV; REAL_POS] THEN + REWRITE_TAC[UNIT_INTERVAL_NONEMPTY; VECTOR_ADD_RID; REAL_ABS_NUM] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_0; VECTOR_ADD_RID] THEN + REWRITE_TAC[DROP_CMUL; COMPLEX_CMUL] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&n) cpow (z - Cx(&1))` o + MATCH_MP HAS_INTEGRAL_COMPLEX_LMUL) THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; + GSYM(ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] CPOW_SUC)] THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_MUL_ASSOC; GSYM LIFT_EQ_CMUL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] INTER; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM DROP_VEC; LIFT_DROP; GSYM IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[COMPLEX_RING `(z - Cx(&1)) + Cx(&1) = z`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN + REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; REAL_ARITH `inv x * y:real = y / x`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN IMP_REWRITE_TAC[GSYM CPOW_MUL_REAL] THEN + ASM_SIMP_TAC[REAL_CX; RE_CX; REAL_LE_DIV; REAL_POS; GSYM CX_MUL] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; LE_1]]) in + let lemma3 = prove + (`f integrable_on s + ==> (\x:real^N. lift(Re(f x))) integrable_on s /\ + integral s (\x. lift(Re(f x))) = lift(Re(integral s f))`, + SUBGOAL_THEN `!z. lift(Re z) = (lift o Re) z` + (fun th -> REWRITE_TAC[th]) THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC INTEGRABLE_LINEAR; MATCH_MP_TAC INTEGRAL_LINEAR] THEN + ASM_REWRITE_TAC[linear; COMPLEX_CMUL; o_THM; RE_ADD; RE_MUL_CX] THEN + REWRITE_TAC[LIFT_CMUL; LIFT_ADD]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n t. if drop t <= &n + then Cx(drop t) cpow (z - Cx(&1)) * Cx(&1 - drop t / &n) pow n + else Cx(&0)`; + `\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))`; + `\t. lift(Re(Cx(drop t) cpow (Cx(Re z) - Cx(&1)) / cexp(Cx(drop t))))`; + `{t | &0 <= drop t}`] DOMINATED_CONVERGENCE) THEN + ASM_SIMP_TAC[REWRITE_RULE[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] lemma2] THEN + ANTS_TAC THENL + [ALL_TAC; + SIMP_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MESON_TAC[CGAMMA; LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY]] THEN + REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `t:real`] THEN DISCH_TAC THEN + REWRITE_TAC[cpow; CX_INJ] THEN ASM_CASES_TAC `t = &0` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COND_ID; RE_CX; CEXP_0; COMPLEX_DIV_1; + COMPLEX_NORM_0; REAL_LE_REFL] THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_LT_LE; GSYM CX_EXP; GSYM CX_SUB; + GSYM CX_MUL; RE_CX; GSYM CX_DIV; GSYM REAL_EXP_SUB] THEN + COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_NORM_0; REAL_EXP_POS_LE] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; REAL_EXP_SUB; NORM_CEXP] THEN + REWRITE_TAC[RE_MUL_CX; RE_SUB; RE_CX; COMPLEX_NORM_POW] THEN + REWRITE_TAC[real_div] THEN SIMP_TAC[REAL_LE_LMUL_EQ; REAL_EXP_POS_LT] THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `~(&n = &0)` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM real_div; REAL_OF_NUM_EQ] THEN DISCH_TAC THEN + ASM_SIMP_TAC[real_abs; REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_MUL_LID; + REAL_OF_NUM_LT; LE_1] THEN + TRANS_TAC REAL_LE_TRANS `exp(--t / &n) pow n` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_LDIV_EQ; REAL_MUL_LID; + REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_ARITH `&1 - t / n = &1 + --t / n`; REAL_EXP_LE_X]; + REWRITE_TAC[GSYM REAL_EXP_N; GSYM REAL_EXP_NEG] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; REAL_LE_REFL]]; + REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN X_GEN_TAC `t:real` THEN + DISCH_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\k. Cx t cpow (z - Cx(&1)) * Cx(&1 - t / &k) pow k` THEN + CONJ_TAC THENL + [MP_TAC(SPEC `t + &1` REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; GSYM REAL_OF_NUM_LE] THEN + MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC; + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + REWRITE_TAC[CX_SUB; CX_DIV; GSYM CEXP_NEG] THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a - x / y:complex = a + --x / y`] THEN + REWRITE_TAC[CEXP_LIMIT]]] THEN + MP_TAC(ISPECL + [`\n t. lift(Re(if drop t <= &n + then Cx(drop t) cpow (Cx(Re z) - Cx(&1)) * + Cx(&1 - drop t / &n) pow n + else Cx(&0)))`; + `\t. lift(Re(Cx(drop t) cpow (Cx(Re z) - Cx(&1)) / cexp(Cx(drop t))))`; + `{t | &0 <= drop t}`] + MONOTONE_CONVERGENCE_INCREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + ASM_SIMP_TAC[lemma3; REWRITE_RULE[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] lemma2; + RE_CX; bounded; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_UNIV; FORALL_LIFT; LIFT_DROP; NORM_LIFT] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`; `t:real`] THEN DISCH_TAC THEN + ASM_CASES_TAC `t = &0` THEN + ASM_SIMP_TAC[CPOW_0; COMPLEX_MUL_LZERO; COND_ID; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[cpow; CX_INJ] THEN + ASM_SIMP_TAC[cpow; CX_INJ; GSYM CX_SUB; GSYM CX_EXP; GSYM CX_LOG; + REAL_LT_LE; GSYM CX_MUL; GSYM CX_DIV; RE_CX; GSYM CX_POW] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_CASES_TAC `t <= &n` THEN + ASM_SIMP_TAC[REAL_ARITH `x <= n ==> x <= n + &1`] THENL + [SIMP_TAC[RE_CX; REAL_LE_LMUL_EQ; REAL_EXP_POS_LT] THEN + REWRITE_TAC[GSYM RPOW_POW; GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC REAL_EXP_LIMIT_RPOW_LE THEN ASM_REAL_ARITH_TAC; + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL; RE_CX] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_SUB_LE] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + ASM_REAL_ARITH_TAC]; + X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC + `\k. lift(Re(Cx t cpow (Cx(Re z) - Cx(&1)) * + Cx(&1 - t / &k) pow k))` THEN + CONJ_TAC THENL + [MP_TAC(SPEC `t + &1` REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; GSYM REAL_OF_NUM_LE] THEN + MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC; + REWRITE_TAC[cpow; CX_INJ] THEN + ASM_CASES_TAC `t = &0` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; complex_div; LIM_CONST] THEN + ASM_SIMP_TAC[cpow; CX_INJ; GSYM CX_SUB; GSYM CX_EXP; GSYM CX_LOG; + REAL_LT_LE; GSYM CX_MUL; GSYM CX_INV; RE_CX; GSYM CX_POW] THEN + REWRITE_TAC[real_div; LIFT_CMUL; RE_CX] THEN MATCH_MP_TAC LIM_CMUL THEN + REWRITE_TAC[REAL_ARITH `&1 - t * inv x = &1 + --t / x`] THEN + REWRITE_TAC[GSYM REAL_EXP_NEG] THEN + REWRITE_TAC[GSYM(REWRITE_RULE[o_DEF] TENDSTO_REAL)] THEN + REWRITE_TAC[EXP_LIMIT]]; + MP_TAC(MATCH_MP CONVERGENT_IMP_BOUNDED (SPEC `Cx(Re z)` CGAMMA)) THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LE_TRANS]]);; + +let EULER_INTEGRAL = prove + (`!z. &0 < Re z + ==> integral {t | &0 <= drop t} + (\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))) = + cgamma(z)`, + MESON_TAC[INTEGRAL_UNIQUE; EULER_HAS_INTEGRAL_CGAMMA]);; + +let EULER_INTEGRABLE = prove + (`!z. &0 < Re z + ==> (\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t))) integrable_on + {t | &0 <= drop t}`, + MESON_TAC[EULER_HAS_INTEGRAL_CGAMMA; integrable_on]);; + +let EULER_HAS_REAL_INTEGRAL_GAMMA = prove + (`!x. &0 < x + ==> ((\t. t rpow (x - &1) / exp t) has_real_integral gamma(x)) + {t | &0 <= t}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral] THEN + MP_TAC(SPEC `Cx x` EULER_HAS_INTEGRAL_CGAMMA) THEN + ASM_REWRITE_TAC[gamma; o_DEF; RE_CX] THEN + DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [REWRITE_TAC[linear; RE_ADD; LIFT_ADD; COMPLEX_CMUL; RE_MUL_CX] THEN + REWRITE_TAC[LIFT_CMUL]; + ALL_TAC] THEN + SUBGOAL_THEN `IMAGE lift {t | &0 <= t} = {t | &0 <= drop t}` + SUBST1_TAC THENL + [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]; + ALL_TAC] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] + HAS_INTEGRAL_SPIKE)) THEN + EXISTS_TAC `{vec 0:real^1}` THEN + REWRITE_TAC[NEGLIGIBLE_SING; FORALL_LIFT; IN_DIFF; IN_ELIM_THM; + LIFT_DROP; IN_SING; GSYM DROP_EQ; DROP_VEC] THEN + SIMP_TAC[cpow; CX_INJ; rpow; REAL_LT_LE; GSYM CX_LOG; GSYM CX_SUB; + GSYM CX_EXP; GSYM CX_MUL; RE_CX; GSYM CX_DIV]);; + +let EULER_REAL_INTEGRAL = prove + (`!x. &0 < x + ==> real_integral {t | &0 <= t} (\t. t rpow (x - &1) / exp t) = + gamma(x)`, + MESON_TAC[REAL_INTEGRAL_UNIQUE; EULER_HAS_REAL_INTEGRAL_GAMMA]);; + +let EULER_REAL_INTEGRABLE = prove + (`!x. &0 < x + ==> (\t. t rpow (x - &1) / exp t) real_integrable_on {t | &0 <= t}`, + MESON_TAC[EULER_HAS_REAL_INTEGRAL_GAMMA; real_integrable_on]);; + +let EULER_ORIGINAL_REAL_INTEGRABLE = prove + (`!x. &0 < x + ==> (\t. (--log t) rpow (x - &1)) + real_integrable_on real_interval[&0,&1]`, + SUBGOAL_THEN + `!x. &0 < x + ==> ((\t. (--log t) rpow (x - &1)) + real_integrable_on real_interval[&0,&1] <=> + (\t. (--log t) rpow x) + real_integrable_on real_interval[&0,&1])` + ASSUME_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_LT_REFL] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`\t. inv(x) * (--log t) rpow x`; + `\t:real. t`; + `\t. --(&1) / t * (--log t) rpow (x - &1)`; + `\t:real. &1`; `&0`; `&1`; `{&0,&1}`] + REAL_INTEGRABLE_BY_PARTS_EQ) THEN + REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY; REAL_MUL_RID] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH + `&0 <= x ==> &0 < x \/ x = &0`)) + THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + SUBGOAL_THEN + `(\y. --log(y) rpow x) = (\y. y rpow x) o (\x. --x) o log` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN + CONJ_TAC) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_NEG; REAL_CONTINUOUS_AT_ID; + REAL_CONTINUOUS_AT_LOG] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + ASM_SIMP_TAC[REAL_LE_LT]; + FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\y. (--x * log(y rpow inv x) * y rpow inv x) rpow x` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + REWRITE_TAC[REAL_ARITH `&0 < abs(x - a) <=> ~(x = a)`] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[LOG_RPOW; REAL_LT_INV_EQ; REAL_FIELD + `~(x = &0) ==> --x * (inv x * y) * z = --y * z`] THEN + ASM_SIMP_TAC[RPOW_MUL; RPOW_RPOW; REAL_MUL_LINV] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1]; + SUBGOAL_THEN `&0 = &0 rpow x` + (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) + THENL [ASM_SIMP_TAC[rpow; REAL_LT_IMP_NZ; REAL_LT_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[] (ISPEC `\y. y rpow x` + REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RPOW; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + SUBGOAL_THEN + `(\y. log (y rpow inv x) * y rpow inv x) = + (\y. log y * y) o (\y. y rpow inv x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_COMPOSE_WITHIN THEN + EXISTS_TAC `{x | &0 <= x}` THEN EXISTS_TAC `&0 rpow inv x` THEN + ASM_REWRITE_TAC[REAL_ENTIRE; RPOW_EQ_0; REAL_INV_EQ_0] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[] (ISPEC `\y. y rpow x` + REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RPOW; REAL_LT_IMP_LE; + REAL_LE_INV_EQ] THEN + MP_TAC(ISPEC `&0` REAL_CONTINUOUS_AT_ID) THEN + SIMP_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL_WITHINREAL]; + REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + SIMP_TAC[RPOW_POS_LE; IN_REAL_INTERVAL; IN_ELIM_THM] THEN + MESON_TAC[REAL_LT_01]; + ASM_REWRITE_TAC[RPOW_ZERO; REAL_INV_EQ_0] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REALLIM_X_TIMES_LOG]]]]; + REWRITE_TAC[IN_REAL_INTERVAL; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + CONJ_TAC THEN REAL_DIFF_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM LOG_INV; REAL_INV_1_LT; LOG_POS_LT] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]; + ASM_REWRITE_TAC[REAL_INTEGRABLE_LMUL_EQ; REAL_INV_EQ_0] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_INTEGRABLE_LMUL_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_EQ THEN EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_DIFF; IN_SING] THEN + CONV_TAC REAL_FIELD]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. (\t. --log t pow n) real_integrable_on real_interval[&0,&1]` + ASSUME_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[CONJUNCT1 real_pow; REAL_INTEGRABLE_CONST] THEN + REWRITE_TAC[GSYM RPOW_POW] THEN X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `&n = &(SUC n) - &1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; + MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_OF_NUM_LT; LT_0]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. &0 < x + ==> (\t. --log t rpow x) real_integrable_on real_interval[&0,&1]` + (fun th -> ASM_MESON_TAC[th]) THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\t. max (&1) (--log t pow n)` THEN EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_RPOW THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + FIRST_X_ASSUM(MP_TAC o SPEC `1`) THEN REWRITE_TAC[REAL_POW_1]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN MATCH_MP_TAC + ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND THEN + EXISTS_TAC `\x:real. min (--log(&0) pow n) (&0)` THEN + ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `t:real` THEN + STRIP_TAC THEN ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= c ==> min a b <= c`) THEN + MATCH_MP_TAC REAL_POW_LE THEN ASM_SIMP_TAC[GSYM LOG_INV] THEN + MATCH_MP_TAC LOG_POS THEN MATCH_MP_TAC REAL_INV_1_LE THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_REAL_INTERVAL; IN_DIFF; IN_SING] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= --log t` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM LOG_INV] THEN MATCH_MP_TAC LOG_POS THEN + MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[real_abs; RPOW_POS_LE]] THEN + ASM_CASES_TAC `--(log t) <= &1` THENL + [MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= max y z`) THEN + MATCH_MP_TAC RPOW_1_LE THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `x <= z ==> x <= max y z`) THEN + REWRITE_TAC[GSYM RPOW_POW] THEN MATCH_MP_TAC RPOW_MONO THEN + ASM_REAL_ARITH_TAC]]);; + +let EULER_ORIGINAL_INTEGRABLE = prove + (`!z. &0 < Re z + ==> (\t. (--clog(Cx(drop t))) cpow (z - Cx(&1))) + integrable_on interval[vec 0,vec 1]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\t. lift((--log(drop t)) rpow (Re z - &1))` THEN + EXISTS_TAC `{vec 0:real^1,vec 1}` THEN + REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC + CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `{vec 0:real^1,vec 1}` THEN + REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY; + LEBESGUE_MEASURABLE_INTERVAL] THEN + SUBGOAL_THEN + `(\t. --clog (Cx(drop t)) cpow (z - Cx(&1))) = + ((\w. w cpow (z - Cx(&1))) o (--) o clog) o (\x. Cx(drop x))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_CX_DROP; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; + IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_LIFT; IN_INTERVAL_1; LIFT_DROP] THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; o_DEF] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + COMPLEX_DIFFERENTIABLE_TAC THEN + ASM_SIMP_TAC[GSYM CX_LOG; RE_CX; REAL_LT_LE; RE_NEG; GSYM LOG_INV] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LT_LE] THEN + MATCH_MP_TAC LOG_POS_LT THEN MATCH_MP_TAC REAL_INV_1_LT THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[INTERVAL_REAL_INTERVAL; DROP_VEC; + REWRITE_RULE[o_DEF] (GSYM REAL_INTEGRABLE_ON)] THEN + MATCH_MP_TAC EULER_ORIGINAL_REAL_INTEGRABLE THEN ASM_REWRITE_TAC[]; + + REWRITE_TAC[FORALL_LIFT; IN_DIFF; IN_INSERT; GSYM DROP_EQ; LIFT_DROP; + IN_INTERVAL_1; DROP_VEC; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < x /\ x < &1` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; cpow; rpow; GSYM CX_NEG; REAL_LT_IMP_NZ; RE_CX; + REAL_LT_IMP_LE; COMPLEX_NORM_MUL; NORM_CEXP; RE_SUB; CX_INJ; + REAL_LE_REFL; RE_MUL_CX; GSYM LOG_INV; LOG_POS_LT; REAL_INV_1_LT]]);; + +let EULER_ORIGINAL_HAS_INTEGRAL_CGAMMA = prove + (`!z. &0 < Re z + ==> ((\t. (--clog(Cx(drop t))) cpow (z - Cx(&1))) + has_integral cgamma(z)) (interval[vec 0,vec 1])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP EULER_ORIGINAL_INTEGRABLE) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^1`) THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONTINUOUS_WITHIN] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] LIM_UNIQUE)) THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN + MATCH_MP_TAC(SET_RULE + `{a,b} SUBSET interval[a,b] /\ ~(a = b) + ==> ~(?x. interval[a,b] = {x})`) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN + REWRITE_TAC[VEC_EQ; ARITH_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\x. integral(interval[vec 0,lift(--log(drop x))]) + (\t. Cx(drop t) cpow (z - Cx(&1)) / cexp(Cx(drop t)))` THEN + REWRITE_TAC[EVENTUALLY_WITHIN] THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; DIST_0; NORM_POS_LT; IN_INTERVAL_1; DROP_VEC; + GSYM DROP_EQ; DROP_VEC; FORALL_LIFT; LIFT_DROP] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\t. (--clog(Cx(drop(--t)))) cpow (z - Cx(&1))`; + `\t. --lift(exp(--drop t))`; + `\t. lift(exp(--drop t))`; + `vec 0:real^1`; `lift(--log x):real^1`; `--vec 1:real^1`; `vec 0:real^1`; + `{vec 0:real^1,vec 1}`] + HAS_INTEGRAL_SUBSTITUTION_STRONG) THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC; GSYM DROP_NEG] THEN + REWRITE_TAC[GSYM REFLECT_INTERVAL; GSYM INTEGRAL_REFLECT_GEN] THEN + REWRITE_TAC[DROP_NEG; LIFT_DROP; REAL_LE_NEG2; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[REAL_NEG_NEG; DROP_VEC; REAL_EXP_0; REAL_NEG_0] THEN + SIMP_TAC[GSYM CX_LOG; REAL_EXP_POS_LT; LOG_EXP] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_POS; COUNTABLE_INSERT; COUNTABLE_EMPTY] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[GSYM LOG_INV; LOG_POS; REAL_INV_1_LE] THEN + REWRITE_TAC[GSYM DROP_NEG; INTEGRABLE_REFLECT_GEN] THEN + REWRITE_TAC[REFLECT_INTERVAL; VECTOR_NEG_NEG; VECTOR_NEG_0] THEN + ASM_SIMP_TAC[EULER_ORIGINAL_INTEGRABLE] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM LIFT_NEG; DROP_NEG] THEN + REWRITE_TAC[GSYM LIFT_NUM; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM REAL_CONTINUOUS_ON)] THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC; + FORALL_LIFT; LIFT_DROP; DROP_NEG] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`; REAL_EXP_POS_LE] THEN + REWRITE_TAC[REAL_EXP_NEG; REAL_LE_NEG2] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_0] THEN + ASM_REWRITE_TAC[REAL_EXP_MONO_LE]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC; + FORALL_LIFT; LIFT_DROP; DROP_NEG; IN_DIFF; IN_INSERT; + NOT_IN_EMPTY; GSYM DROP_EQ; DE_MORGAN_THM] THEN + X_GEN_TAC `y:real` THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + REWRITE_TAC[GSYM LIFT_NEG; REWRITE_RULE[o_DEF] + (GSYM HAS_REAL_VECTOR_DERIVATIVE_AT)] THEN + REAL_DIFF_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + SUBGOAL_THEN + `(\t. --clog(Cx(--drop t)) cpow (z - Cx(&1))) = + (\w. --clog w cpow (z - Cx(&1))) o (\t. Cx(drop(--t)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; DROP_NEG]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_CX_DROP THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + SIMP_TAC[CONTINUOUS_NEG; CONTINUOUS_AT_ID]; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + COMPLEX_DIFFERENTIABLE_TAC THEN + REWRITE_TAC[RE_CX; VECTOR_NEG_NEG; LIFT_DROP] THEN + SIMP_TAC[REAL_EXP_POS_LT; GSYM CX_LOG; LOG_EXP] THEN + REWRITE_TAC[RE_NEG; RE_CX; REAL_NEG_NEG] THEN + ASM_REAL_ARITH_TAC]]]; + DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + ASM_SIMP_TAC[EXP_LOG; LIFT_NUM; COMPLEX_CMUL; CX_EXP; CEXP_NEG; CX_NEG; + COMPLEX_NEG_NEG] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[complex_div]]; + FIRST_ASSUM(MP_TAC o MATCH_MP EULER_HAS_INTEGRAL_CGAMMA) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN REWRITE_TAC[LIM_WITHIN] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `exp(--B)` THEN ASM_REWRITE_TAC[REAL_EXP_POS_LT] THEN + REWRITE_TAC[REAL_LT_01; DIST_0; NORM_POS_LT; IN_INTERVAL_1; DROP_VEC; + GSYM DROP_EQ; DROP_VEC; FORALL_LIFT; LIFT_DROP; NORM_LIFT] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`--lift B`; `lift(--log x)`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC] THEN + REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN DISJ2_TAC THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[REAL_EXP_NEG; EXP_LOG] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_NEG] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(NORM_ARITH + `i = j ==> norm(i - g) < e ==> dist(j,g) < e`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_NEG; LIFT_DROP; DROP_VEC] THEN ASM_REAL_ARITH_TAC]]);; + +let EULER_ORIGINAL_INTEGRAL = prove + (`!z. &0 < Re z + ==> integral (interval[vec 0,vec 1]) + (\t. (--clog(Cx(drop t))) cpow (z - Cx(&1))) = + cgamma(z)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC EULER_ORIGINAL_HAS_INTEGRAL_CGAMMA THEN + ASM_REWRITE_TAC[]);; + +let EULER_ORIGINAL_HAS_REAL_INTEGRAL_GAMMA = prove + (`!x. &0 < x + ==> ((\t. (--log t) rpow (x - &1)) has_real_integral gamma(x)) + (real_interval[&0,&1])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral] THEN + MP_TAC(SPEC `Cx x` EULER_ORIGINAL_HAS_INTEGRAL_CGAMMA) THEN + ASM_REWRITE_TAC[gamma; o_DEF; RE_CX] THEN + DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [REWRITE_TAC[linear; RE_ADD; LIFT_ADD; COMPLEX_CMUL; RE_MUL_CX] THEN + REWRITE_TAC[LIFT_CMUL]; + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_NUM]] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] + HAS_INTEGRAL_SPIKE)) THEN + EXISTS_TAC `{vec 0:real^1,vec 1}` THEN + REWRITE_TAC[NEGLIGIBLE_INSERT; FORALL_LIFT; IN_INTERVAL_1; DE_MORGAN_THM; + LIFT_DROP; IN_INSERT; NOT_IN_EMPTY; GSYM DROP_EQ; DROP_VEC; IN_DIFF] THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN X_GEN_TAC `y:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < --log y` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM LOG_INV] THEN MATCH_MP_TAC LOG_POS_LT THEN + MATCH_MP_TAC REAL_INV_1_LT THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[GSYM CX_LOG; cpow; rpow; COMPLEX_NEG_EQ_0; CX_INJ; + REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[GSYM CX_NEG; GSYM CX_LOG; GSYM CX_SUB; GSYM CX_MUL] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM CX_EXP; RE_CX]]);; + +let EULER_ORIGINAL_REAL_INTEGRAL = prove + (`!x. &0 < x + ==> real_integral (real_interval[&0,&1]) + (\t. (--log t) rpow (x - &1)) = + gamma(x)`, + MESON_TAC[REAL_INTEGRAL_UNIQUE; EULER_ORIGINAL_HAS_REAL_INTEGRAL_GAMMA]);; + +(* ------------------------------------------------------------------------- *) +(* Stirling's approximation. *) +(* ------------------------------------------------------------------------- *) + +let LGAMMA_STIRLING_INTEGRALS_EXIST,LGAMMA_STIRLING = (CONJ_PAIR o prove) + (`(!z n. 1 <= n /\ (Im z = &0 ==> &0 < Re z) + ==> (\t. Cx(bernoulli n (frac (drop t))) / (z + Cx(drop t)) pow n) + integrable_on {t | &0 <= drop t}) /\ + (!z p. + (Im z = &0 ==> &0 < Re z) + ==> lgamma(z) = + ((z - Cx(&1) / Cx(&2)) * clog(z) - z + Cx(log(&2 * pi) / &2)) + + vsum(1..p) (\k. Cx(bernoulli (2 * k) (&0) / + (&4 * &k pow 2 - &2 * &k)) / z pow (2 * k - 1)) - + integral {t | &0 <= drop t} + (\t. Cx(bernoulli (2 * p + 1) (frac(drop t))) / + (z + Cx(drop t)) pow (2 * p + 1)) / + Cx(&(2 * p + 1)))`, + let lemma1 = prove + (`!p n z. (Im z = &0 ==> &0 < Re z) + ==> (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * + Cx(&(FACT(2 * p))) / (z + Cx(drop x)) pow (2 * p + 1)) + integrable_on interval [lift(&0),lift(&n)] /\ + vsum(0..n) (\m. clog(Cx(&m) + z)) = + (z + Cx(&n) + Cx(&1) / Cx(&2)) * clog(z + Cx(&n)) - + (z - Cx(&1) / Cx(&2)) * clog(z) - Cx(&n) + + vsum(1..p) + (\k. Cx(bernoulli (2 * k) (&0) / &(FACT(2 * k))) * + (Cx(&(FACT(2 * k - 2))) / (z + Cx(&n)) pow (2 * k - 1) - + Cx(&(FACT(2 * k - 2))) / z pow (2 * k - 1))) + + integral (interval[lift(&0),lift(&n)]) + (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * + Cx(&(FACT(2 * p))) / (z + Cx(drop x)) pow (2 * p + 1)) / + Cx(&(FACT(2 * p + 1)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_RING `Cx(&n) + z = z + Cx(&n)`] THEN MP_TAC(ISPECL + [`\n w. if n = 0 then (z + w) * clog(z + w) - (z + w) + else if n = 1 then clog(z + w) + else Cx(--(&1) pow n * &(FACT(n - 2))) / + (z + w) pow (n - 1)`; + `0`; `n:num`; `p:num`] COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE) THEN + ASM_REWRITE_TAC[ADD_EQ_0; MULT_EQ_0; MULT_EQ_1] THEN + CONV_TAC NUM_REDUCE_CONV THEN ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL; LE_0] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(z + Cx x = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD; IM_CX; RE_CX] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[o_THM; ARITH_RULE `k + 1 = 1 <=> k = 0`] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL + [COMPLEX_DIFF_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[RE_ADD; IM_ADD; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `~(z + Cx x = Cx(&0))` THEN CONV_TAC COMPLEX_FIELD]; + ALL_TAC] THEN + ASM_CASES_TAC `k = 1` THEN ASM_REWRITE_TAC[] THEN COMPLEX_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_LID; COMPLEX_MUL_LID; + COMPLEX_POW_1; IM_ADD; RE_ADD; IM_CX; RE_CX] THEN + (CONJ_TAC ORELSE ASM_REAL_ARITH_TAC) THEN + ASM_REWRITE_TAC[COMPLEX_POW_EQ_0] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_RID; REAL_NEG_NEG; REAL_MUL_LNEG] THEN + REWRITE_TAC[COMPLEX_MUL_RID; CX_NEG; COMPLEX_POW_POW] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; COMPLEX_SUB_LZERO; COMPLEX_NEG_NEG; + COMPLEX_MUL_LNEG] THEN + REWRITE_TAC[GSYM complex_div] THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[GSYM complex_div; COMPLEX_DIV_POW2] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[ADD_SUB; ARITH_RULE + `~(k = 0) /\ ~(k = 1) ==> (k - 1) * 2 - (k - 1 - 1) = k`] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; complex_div] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM CX_MUL] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `~(k = 0) ==> (k + 1) - 2 = k - 1`] THEN + ASM_SIMP_TAC[ARITH_RULE + `~(k = 0) /\ ~(k = 1) ==> k - 1 = SUC(k - 2)`] THEN + REWRITE_TAC[FACT; REAL_OF_NUM_MUL] THEN REWRITE_TAC[MULT_SYM]; + REWRITE_TAC[ARITH_RULE `~(2 * p + 2 = 1)`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)] THEN + SIMP_TAC[LE_1] THEN + REWRITE_TAC[ARITH_RULE `(2 * p + 2) - 1 = 2 * p + 1`; ADD_SUB] THEN + REWRITE_TAC[REAL_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[COMPLEX_ADD_RID] THEN + CONV_TAC COMPLEX_RING) in + let lemma2 = prove + (`!z n. 2 <= n /\ (Im z = &0 ==> &0 < Re z) + ==> (\t. inv(z + Cx(drop t)) pow n) + absolutely_integrable_on {t | &0 <= drop t}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_POW_INV] THEN + MATCH_MP_TAC + MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\t. lift(inv(max (abs(Im z)) (Re z + drop t)) pow n)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN + SIMP_TAC[CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ADD; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; CONTINUOUS_ON_CX_DROP] THEN + REWRITE_TAC[IN_ELIM_THM; GSYM FORALL_DROP] THEN + REWRITE_TAC[COMPLEX_POW_EQ_0] THEN + REWRITE_TAC[COMPLEX_EQ; RE_ADD; IM_ADD; RE_CX; IM_CX] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC LEBESGUE_MEASURABLE_CONVEX THEN + MATCH_MP_TAC IS_INTERVAL_CONVEX THEN + REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN REAL_ARITH_TAC]; + ALL_TAC; + REWRITE_TAC[FORALL_IN_GSPEC; GSYM FORALL_DROP; LIFT_DROP] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM COMPLEX_POW_INV; COMPLEX_NORM_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[NORM_POS_LE; COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + MP_TAC(SPEC `z + Cx x` COMPLEX_NORM_GE_RE_IM) THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[REAL_ARITH `max m n = if n <= m then m else n`] THEN + REWRITE_TAC[COND_RAND; COND_RATOR] THEN + MATCH_MP_TAC INTEGRABLE_CASES THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `{t | &0 <= drop t /\ Re z + drop t <= abs (Im z)} = + interval[vec 0,lift(abs(Im z) - Re z)]` + (fun th -> REWRITE_TAC[th; INTEGRABLE_CONST]) THEN + SIMP_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC + `{t | abs(Im z) - Re z <= drop t} INTER {t | &0 <= drop t}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{lift(abs(Im z) - Re z)}` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNION; + IN_ELIM_THM; IN_SING; IN_INTER] THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_INTER] THEN + REWRITE_TAC[integrable_on] THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN + SUBGOAL_THEN + `!a. {t | abs(Im z) - Re z <= drop t} INTER interval[vec 0,a] = + interval[lift(max (&0) (abs (Im z) - Re z)),a]` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_INTERVAL_1] THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!b. &0 <= drop b /\ abs (Im z) - Re z <= drop b + ==> ((\x. lift(inv (Re z + drop x) pow n)) has_integral + lift + (inv((&1 - &n) * (Re z + drop b) pow (n - 1)) - + inv((&1 - &n) * + (Re z + max(&0) (abs(Im z) - Re z)) pow (n - 1)))) + (interval[lift(max (&0) (abs (Im z) - Re z)),b])` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. lift(inv((&1 - &n) * (Re z + drop x) pow (n - 1)))`; + `\x. lift(inv(Re z + drop x) pow n)`; + `lift(max (&0) (abs (Im z) - Re z))`; + `b:real^1`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_MAX_LE] THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_LIFT; LIFT_DROP; INTERVAL_REAL_INTERVAL] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] + (GSYM HAS_REAL_VECTOR_DERIVATIVE_WITHIN)] THEN + REWRITE_TAC[REAL_INV_MUL; REAL_INV_POW] THEN REPEAT STRIP_TAC THEN + REAL_DIFF_TAC THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[real_div; REAL_OF_NUM_LE; REAL_FIELD + `&2 <= x ==> inv(&1 - x) * (x - &1) * y * --(&0 + &1) * p = + y * p`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_INV_POW] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_POW_ADD] THEN + AP_TERM_TAC THEN ASM_ARITH_TAC; + REWRITE_TAC[LIFT_DROP; GSYM LIFT_SUB]]; + ALL_TAC] THEN + EXISTS_TAC `lift(inv + ((&n - &1) * + (Re z + max (&0) (abs(Im z) - Re z)) pow (n - 1)))` THEN + CONJ_TAC THENL + [X_GEN_TAC `b:real^1` THEN + ASM_CASES_TAC `&0 <= drop b /\ abs (Im z) - Re z <= drop b` THENL + [ASM_MESON_TAC[integrable_on]; MATCH_MP_TAC INTEGRABLE_ON_NULL] THEN + REWRITE_TAC[CONTENT_EQ_0_1; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\b. lift(inv((&1 - &n) * (Re z + b) pow (n - 1)) - + inv((&1 - &n) * + (Re z + max (&0) (abs(Im z) - Re z)) pow (n - 1)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN + EXISTS_TAC `max(&0) (abs(Im z) - Re z)` THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[LIFT_SUB; VECTOR_SUB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_LID] THEN + MATCH_MP_TAC LIM_ADD THEN + REWRITE_TAC[GSYM LIFT_NEG; GSYM REAL_INV_NEG; GSYM REAL_MUL_LNEG] THEN + REWRITE_TAC[REAL_NEG_SUB; LIM_CONST] THEN + REWRITE_TAC[REAL_INV_MUL; LIFT_CMUL] THEN + MATCH_MP_TAC LIM_NULL_CMUL THEN + REWRITE_TAC[GSYM LIFT_NUM; GSYM LIM_CX_LIFT] THEN + REWRITE_TAC[CX_INV; CX_POW; GSYM COMPLEX_POW_INV; CX_ADD] THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + MATCH_MP_TAC LIM_INV_X_POW_OFFSET THEN ASM_ARITH_TAC) in + let lemma3 = prove + (`!z n. 2 <= n /\ (Im z = &0 ==> &0 < Re z) + ==> (\t. Cx(bernoulli n (frac (drop t))) / (z + Cx(drop t)) pow n) + integrable_on {t | &0 <= drop t}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_CMUL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC THEN + ASM_SIMP_TAC[GSYM COMPLEX_POW_INV; lemma2]) in + let lemma4 = prove + (`!z p. (Im z = &0 ==> &0 < Re z) /\ 1 <= p + ==> ((\t. Cx(bernoulli 1 (frac(drop t))) / (z + Cx(drop t))) + has_integral + (integral {t | &0 <= drop t} + (\t. Cx(bernoulli (2 * p + 1) (frac(drop t))) / + (z + Cx(drop t)) pow (2 * p + 1)) / + Cx(&(2 * p + 1)) - + vsum(1..p) (\k. Cx(bernoulli (2 * k) (&0) / + (&4 * &k pow 2 - &2 * &k)) / + z pow (2 * k - 1)))) + {t | &0 <= drop t}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_LIM_SEQUENTIALLY THEN CONJ_TAC THENL + [REWRITE_TAC[o_DEF; LIFT_DROP; complex_div; COMPLEX_VEC_0] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL_BOUNDED THEN + EXISTS_TAC `&1 / &2` THEN CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[BERNOULLI_CONV `bernoulli 1 x`] THEN DISJ1_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN + MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN REAL_ARITH_TAC; + MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[LIM_INV_Z_OFFSET]]; + ALL_TAC] THEN + MP_TAC(GEN `n:num` (CONJ + (SPECL [`0`; `n:num`; `z:complex`] lemma1) + (SPECL [`p:num`; `n:num`; `z:complex`] lemma1))) THEN + ASM_REWRITE_TAC[FORALL_AND_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH `a * Cx(&1) / b = a / b`] THEN + REWRITE_TAC[LIFT_NUM; COMPLEX_POW_1; COMPLEX_DIV_1] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN + REWRITE_TAC[VECTOR_ARITH `a + vec 0 + x:real^N = a + y <=> x = y`] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th]) THEN + GEN_REWRITE_TAC LAND_CONV [COMPLEX_RING `a - b:complex = --b + a`] THEN + MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM VSUM_NEG] THEN MATCH_MP_TAC LIM_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[CX_DIV; complex_div; GSYM COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + REWRITE_TAC[SIMPLE_COMPLEX_ARITH + `inv x * (y * w - y * z):complex = y / x * (w - z)`] THEN + SUBGOAL_THEN + `Cx(&(FACT(2 * k - 2))) / Cx(&(FACT(2 * k))) = + inv(Cx(&4 * &k pow 2 - &2 * &k))` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [MATCH_MP_TAC(COMPLEX_FIELD + `~(y = Cx(&0)) /\ ~(z = Cx(&0)) /\ x * z = y + ==> x / y = inv(z)`) THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; FACT_NZ] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_ARITH + `&4 * x pow 2 - &2 * x = (&2 * x) * (&2 * x - &1)`] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= k ==> 1 <= 2 * k`; REAL_OF_NUM_SUB; + REAL_OF_NUM_MUL; GSYM CX_MUL; CX_INJ; REAL_OF_NUM_EQ] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `1 <= k` THEN SPEC_TAC(`k:num`,`k:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN (K ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `(2 + k) - 2 = k /\ (2 + k) - 1 = k + 1`] THEN + REWRITE_TAC[ARITH_RULE `2 + k = SUC(SUC k)`; FACT] THEN ARITH_TAC; + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + ONCE_REWRITE_TAC[COMPLEX_RING `--z = Cx(&0) - z`] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[GSYM COMPLEX_POW_INV] THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + MATCH_MP_TAC LIM_INV_N_POW_OFFSET THEN ASM_ARITH_TAC]; + MP_TAC(SPECL [`z:complex`; `2 * p + 1`] lemma3) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `Cx(&(FACT(2 * p)))` o + MATCH_MP INTEGRABLE_COMPLEX_LMUL) THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL] THEN + REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN + DISCH_THEN(MP_TAC o + MATCH_MP LIM_POSINFINITY_SEQUENTIALLY o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPEC `inv(Cx(&(FACT(2 * p + 1))))` o + MATCH_MP LIM_COMPLEX_RMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THENL + [REWRITE_TAC[LIFT_NUM; FUN_EQ_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[complex_div] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_AC]; + + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC(COMPLEX_RING + `x * y:complex = z ==> (x * i) * y = i * z`) THEN + REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL; CX_MUL] THEN + MATCH_MP_TAC(COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> a * inv(b * a) = inv b`) THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; FACT_NZ; NOT_SUC]]]) in + let lemma5 = prove + (`!z n. 1 <= n /\ (Im z = &0 ==> &0 < Re z) + ==> (\t. Cx(bernoulli n (frac (drop t))) / (z + Cx(drop t)) pow n) + integrable_on {t | &0 <= drop t}`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `1 <= n ==> n = 1 \/ 2 <= n`)) THEN + ASM_SIMP_TAC[lemma3; COMPLEX_POW_1] THEN + REWRITE_TAC[integrable_on] THEN + ASM_MESON_TAC[LE_REFL; lemma4]) in + let lemma6 = prove + (`!z. (Im z = &0 ==> &0 < Re z) + ==> lgamma(z) = + ((z - Cx(&1) / Cx(&2)) * clog(z) - z + Cx(&1)) + + (integral {t | &0 <= drop t} + (\t. Cx(bernoulli 1 (frac(drop t))) / + (Cx(&1) + Cx(drop t))) - + integral {t | &0 <= drop t} + (\t. Cx(bernoulli 1 (frac(drop t))) / + (z + Cx(drop t))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n. ~(z + Cx(&n) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_EQ; IM_ADD; RE_ADD; IM_CX; RE_CX] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(z = Cx(&0))` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPLEX_ADD_RID]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LGAMMA_ALT) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[TRIVIAL_LIMIT_SEQUENTIALLY] + (ISPEC `sequentially` LIM_UNIQUE))) THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC + `\n. z * clog (Cx(&n)) - clog (Cx(&n + &1)) + + ((Cx(&1) + Cx(&n) + Cx(&1) / Cx(&2)) * clog (Cx(&1) + Cx(&n)) - + (Cx(&1) - Cx(&1) / Cx(&2)) * clog (Cx(&1)) - + Cx(&n) + + integral (interval [lift (&0),lift (&n)]) + (\x. Cx(bernoulli 1 (frac (drop x))) * + Cx(&1) / (Cx(&1) + Cx(drop x)) pow 1) / + Cx(&1)) - + ((z + Cx(&n) + Cx(&1) / Cx(&2)) * clog (z + Cx(&n)) - + (z - Cx(&1) / Cx(&2)) * clog z - + Cx(&n) + + integral (interval [lift (&0),lift (&n)]) + (\x. Cx(bernoulli 1 (frac (drop x))) * + Cx(&1) / (z + Cx(drop x)) pow 1) / + Cx(&1))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `clog(Cx(&(FACT n))) = + vsum(0..n) (\m. clog(Cx(&m) + Cx(&1))) - clog(Cx(&n + &1))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_ADD; GSYM CX_ADD] THEN + REWRITE_TAC[GSYM(SPEC `1` VSUM_OFFSET); ADD_CLAUSES] THEN + SIMP_TAC[GSYM NPRODUCT_FACT; REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; + GSYM CX_LOG; LOG_PRODUCT; PRODUCT_POS_LT; IN_NUMSEG; + REAL_OF_NUM_LT; LE_1; GSYM VSUM_CX] THEN + REWRITE_TAC[GSYM ADD1; VSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`; REAL_OF_NUM_SUC] THEN + SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; LT_0] THEN + REWRITE_TAC[COMPLEX_RING `(a + b) - b:complex = a`]; + ONCE_REWRITE_TAC[COMPLEX_RING + `(a + b - c) - d:complex = (a - c) + (b - d)`]] THEN + MP_TAC(SPECL [`0`; `n:num`] lemma1) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; ARITH; VECTOR_ADD_LID] THEN + ASM_SIMP_TAC[RE_CX; REAL_LT_01]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_POW_1; COMPLEX_DIV_1] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `a + (b - c - n + x) - (d - e - n + y):complex = + (a + (b - c) - (d - e)) + (x - y)`] THEN + MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[CLOG_1; COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO] THEN + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[CX_ADD] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN EXISTS_TAC + `\n. z * (clog(Cx(&n)) - clog(z + Cx(&n))) + + (Cx(&n) + Cx(&1) / Cx(&2)) * + (clog(Cx(&1) + Cx(&n)) - clog(z + Cx(&n))) - + (Cx(&1) - z)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o BINDER_CONV o + LAND_CONV o RAND_CONV) [GSYM COMPLEX_ADD_LID] THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN REWRITE_TAC[LIM_SUB_CLOG]; + ONCE_REWRITE_TAC[COMPLEX_RING + `(a + h) * x - y:complex = h * x + a * x - y`] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + SIMP_TAC[LIM_NULL_COMPLEX_LMUL; LIM_SUB_CLOG] THEN + REWRITE_TAC[GSYM LIM_NULL_COMPLEX; LIM_N_MUL_SUB_CLOG]]; + REWRITE_TAC[complex_div; COMPLEX_MUL_LID] THEN + REWRITE_TAC[LIFT_NUM] THEN MATCH_MP_TAC LIM_SUB THEN + CONJ_TAC THEN REWRITE_TAC[GSYM LIFT_NUM] THEN + MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + REWRITE_TAC[LIFT_NUM] THEN + MATCH_MP_TAC(MATCH_MP (TAUT `(p <=> q /\ r) ==> (p ==> r)`) + (SPEC_ALL HAS_INTEGRAL_LIM_AT_POSINFINITY)) THEN + REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL; GSYM complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `z + x:complex = (z + x) pow 1`] THEN + MATCH_MP_TAC lemma5 THEN + ASM_REWRITE_TAC[LE_REFL; RE_CX; REAL_LT_01]]) in + let lemma7 = prove + (`((\y. integral {t | &0 <= drop t} + (\t. Cx (bernoulli 1 (frac (drop t))) / (ii * Cx y + Cx(drop t)))) + --> Cx(&0)) at_posinfinity`, + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\y. integral {t | &0 <= drop t} + (\t. Cx(bernoulli 3 (frac (drop t))) / + (ii * Cx y + Cx(drop t)) pow 3) / Cx(&3) - + Cx(bernoulli 2 (&0) / &2) / (ii * Cx y)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`ii * Cx y`; `1`] lemma4) THEN + ASM_SIMP_TAC[IM_MUL_II; RE_CX; REAL_LT_IMP_NZ; LE_REFL] THEN + REWRITE_TAC[VSUM_SING_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_POW_1] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC; + ALL_TAC] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_SUB THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + REWRITE_TAC[COMPLEX_INV_MUL] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + REWRITE_TAC[LIM_INV_X]] THEN + ONCE_REWRITE_TAC[complex_div] THEN MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL THEN + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC + `\y. Cx(&1 / &2 / y) * + integral {t | &0 <= drop t} + (\t. inv(Cx(&1) + Cx(drop t)) pow 2)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL THEN + REWRITE_TAC[real_div; CX_MUL] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL THEN + REWRITE_TAC[LIM_INV_X; CX_INV]] THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL; lemma2; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ARITH; + RE_CX; REAL_OF_NUM_LT] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(Re z) <= norm z /\ x <= Re z ==> x <= norm z`) THEN + REWRITE_TAC[COMPLEX_NORM_GE_RE_IM] THEN REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT THEN + REWRITE_TAC[DIMINDEX_2; ARITH] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC lemma5 THEN + REWRITE_TAC[ARITH; IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC lemma2 THEN + REWRITE_TAC[RE_CX; REAL_LT_01] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_LIFT; IN_ELIM_THM; LIFT_DROP; GSYM RE_DEF] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_INV; GSYM CX_MUL; GSYM CX_POW] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; RE_CX] THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 / y * x = (&1 / &4) * (&2 / y * x)`] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_LE_INV_EQ; NORM_POS_LE] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`3`; `frac x`] BERNOULLI_BOUND) THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[BERNOULLI_CONV `bernoulli 2 (&0)`] THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + SIMP_TAC[IN_REAL_INTERVAL; REAL_LT_IMP_LE; FLOOR_FRAC]; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_INV; GSYM REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_INV_INV] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_LT_MUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LT] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_POW; REAL_ARITH + `x pow 3 = (x:real) * x pow 2`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv(&2) * y * x = y * x / &2`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + W(MP_TAC o PART_MATCH (rand o rand) COMPLEX_NORM_GE_RE_IM o + rand o snd) THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX; IM_CX] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `&0 <= x / &2 <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_POW_LE THEN ASM_REAL_ARITH_TAC; + + REWRITE_TAC[COMPLEX_SQNORM] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; IM_CX; RE_CX] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_NEG_0] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 pow 2 <= y pow 2 /\ &0 <= (x - &1) pow 2 + ==> (&1 + x) pow 2 / &2 <= x pow 2 + y pow 2`) THEN + REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REAL_ARITH_TAC]) in + let lemma8 = prove + (`integral {t | &0 <= drop t} + (\t. Cx (bernoulli 1 (frac (drop t))) / (Cx(&1) + Cx(drop t))) = + Cx(log(&2 * pi) / &2 - &1)`, + MATCH_MP_TAC(MESON[REAL] + `real z /\ Re z = y ==> z = Cx y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_COMPLEX_INTEGRAL THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[COMPLEX_RING `z + x:complex = (z + x) pow 1`] THEN + MATCH_MP_TAC lemma5 THEN + ASM_REWRITE_TAC[LE_REFL; RE_CX; REAL_LT_01]; + REWRITE_TAC[GSYM CX_ADD; GSYM CX_DIV; REAL_CX]]; + GEN_REWRITE_TAC I [GSYM CX_INJ]] THEN + MATCH_MP_TAC(ISPEC `at_posinfinity` LIM_UNIQUE) THEN + EXISTS_TAC + `\y:real. Cx(Re(integral {t | &0 <= drop t} + (\t. Cx(bernoulli 1 (frac (drop t))) / (Cx(&1) + Cx(drop t)))))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY; LIM_CONST] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\y. Cx(Re(lgamma(ii * Cx y) - + ((ii * Cx y - Cx(&1) / Cx(&2)) * clog(ii * Cx y) - + ii * Cx y + Cx(&1)) + + integral {t | &0 <= drop t} + (\t. Cx(bernoulli 1 (frac(drop t))) / + (ii * Cx y + Cx(drop t)))))` THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPEC `ii * Cx y` lemma6) THEN + ASM_SIMP_TAC[IM_MUL_II; RE_CX; REAL_LT_IMP_NZ] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[COMPLEX_RING `(s + i - j) - s + j:complex = i`]; + ALL_TAC] THEN + REWRITE_TAC[RE_ADD; RE_SUB; CX_ADD; CX_SUB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN + MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\y. integral {t | &0 <= drop t} + (\t. Cx(bernoulli 1 (frac(drop t))) / (ii * Cx y + Cx(drop t)))` THEN + REWRITE_TAC[lemma7] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_GE_RE_IM]] THEN + REWRITE_TAC[RE_MUL_II; IM_CX; REAL_NEG_0; COMPLEX_SUB_RZERO; RE_CX] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\y. Cx(log(norm(cgamma(ii * Cx y)))) - + (Cx(--(pi * y + log y) / &2) + Cx(&1))` THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + BINOP_TAC THENL + [MP_TAC(SPEC `ii * Cx y` CGAMMA_LGAMMA) THEN COND_CASES_TAC THENL + [FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o AP_TERM `Im`)) THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; IM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_CEXP; LOG_EXP]]; + AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[COMPLEX_SUB_RDISTRIB; RE_SUB; GSYM CX_DIV] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; RE_MUL_II; IM_MUL_II; RE_MUL_CX; + IM_MUL_CX] THEN + ASM_SIMP_TAC[RE_CX; IM_CX; REAL_LT_IMP_LE; CX_INJ; REAL_LT_IMP_NZ; + GSYM CX_LOG; CLOG_MUL_II] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_CX; IM_CX; RE_MUL_II; IM_MUL_II] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\y. Cx((log(&2 * pi) - log(&1 - inv(exp(pi * y) pow 2))) / &2 - &1)` THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `ii * Cx y + Cx(&1)` CGAMMA_REFLECTION) THEN + REWRITE_TAC[CGAMMA_RECURRENCE; COMPLEX_ENTIRE; II_NZ; CX_INJ] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + REWRITE_TAC[COMPLEX_RING `Cx(&1) - (z + Cx(&1)) = --z`] THEN + MP_TAC(SPEC `cgamma(ii * Cx y)` COMPLEX_NORM_POW_2) THEN + REWRITE_TAC[CNJ_MUL; CNJ_II; CNJ_CX; CNJ_CGAMMA] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; GSYM COMPLEX_MUL_ASSOC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[COMPLEX_RING `w * (z + Cx(&1)) = w * z + w`] THEN + REWRITE_TAC[CSIN_ADD; GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; CX_NEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_MUL_RID] THEN + REWRITE_TAC[csin; COMPLEX_RING `--ii * x * ii * y = x * y`] THEN + REWRITE_TAC[COMPLEX_RING `ii * x * ii * y = --(x * y)`] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_INV; COMPLEX_INV_MUL; + COMPLEX_INV_NEG; COMPLEX_MUL_RNEG] THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD + `~(y = Cx(&0)) + ==> (ii * y * z = --(p * i * Cx(&2) * ii) <=> + z = --(Cx(&2) * p) * inv y * i)`] THEN + REWRITE_TAC[GSYM COMPLEX_INV_MUL; GSYM CX_MUL; + GSYM CX_EXP; CEXP_NEG] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; GSYM COMPLEX_MUL_RNEG; + COMPLEX_NEG_INV] THEN + REWRITE_TAC[COMPLEX_NEG_SUB] THEN + REWRITE_TAC[GSYM CX_INV; GSYM CX_SUB; GSYM CX_MUL; GSYM CX_INV] THEN + REWRITE_TAC[CX_INJ; GSYM CX_POW] THEN + DISCH_THEN(MP_TAC o AP_TERM `sqrt`) THEN + REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_INV_MUL] THEN + SUBGOAL_THEN `&0 < exp(pi * y) - inv(exp(pi * y))` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x < &1 /\ &1 < y ==> &0 < y - x`) THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_INV_LT_1; ALL_TAC] THEN + MATCH_MP_TAC REAL_EXP_LT_1 THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[PI_POS]; + ASM_SIMP_TAC[LOG_MUL; REAL_LT_INV_EQ; PI_POS; REAL_LT_MUL; + REAL_ARITH `&0 < &2 * x <=> &0 < x`; LOG_SQRT; LOG_INV]] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB] THEN + REWRITE_TAC[REAL_ARITH + `(l2 + --l + x) / &2 - (--(py + l) / &2 + &1) = + (l2 + py + x) / &2 - &1`] THEN + SIMP_TAC[REAL_EXP_NZ; REAL_FIELD + `~(e = &0) ==> e - inv e = e * (&1 - inv(e pow 2))`] THEN + SUBGOAL_THEN `inv (exp (pi * y) pow 2) < &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INV_LT_1 THEN + MATCH_MP_TAC REAL_POW_LT_1 THEN + REWRITE_TAC[ARITH] THEN + MATCH_MP_TAC REAL_EXP_LT_1 THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_MUL; PI_POS]; + ASM_SIMP_TAC[LOG_MUL; REAL_EXP_POS_LT; REAL_SUB_LT; LOG_EXP]] THEN + REWRITE_TAC[CX_INJ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CX_SUB; CX_DIV] THEN MATCH_MP_TAC LIM_SUB THEN + REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC LIM_COMPLEX_DIV THEN REWRITE_TAC[LIM_CONST] THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + MP_TAC(ISPECL + [`clog`; `at_posinfinity`; + `\y. Cx(&1 - inv(exp(pi * y) pow 2))`; + `Cx(&1)`] LIM_CONTINUOUS_FUNCTION) THEN + REWRITE_TAC[CLOG_1] THEN ANTS_TAC THENL + [SIMP_TAC[CONTINUOUS_AT_CLOG; RE_CX; REAL_LT_01; CX_SUB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[CX_INV; CX_EXP; CX_POW; GSYM COMPLEX_POW_INV] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_POW THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[LIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&1 + inv(e)` THEN REWRITE_TAC[dist; real_ge] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_NORM_INV] THEN + MATCH_MP_TAC REAL_LT_LINV THEN ASM_REWRITE_TAC[NORM_CEXP; RE_CX] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&1 + e <= x + ==> &1 + pi * x <= z /\ &0 <= x * (pi - &1) ==> e < z`)) THEN + REWRITE_TAC[REAL_EXP_LE_X] THEN MATCH_MP_TAC REAL_LE_MUL THEN + MP_TAC(SPEC `e:real` REAL_LT_INV_EQ) THEN + MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; real_ge] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(GSYM CX_LOG) THEN REWRITE_TAC[REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INV_LT_1 THEN MATCH_MP_TAC REAL_POW_LT_1 THEN + REWRITE_TAC[ARITH] THEN MATCH_MP_TAC REAL_EXP_LT_1 THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_SIMP_TAC[REAL_LT_MUL; PI_POS]]) in + CONJ_TAC THENL [MATCH_ACCEPT_TAC lemma5; ALL_TAC] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[lemma6] THEN + REWRITE_TAC[lemma8; CX_SUB] THEN + REWRITE_TAC[COMPLEX_RING + `(x + Cx(&1)) + (a - Cx(&1)) - b = (x + a) - b`] THEN + REWRITE_TAC[complex_sub; GSYM COMPLEX_ADD_ASSOC] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_CASES_TAC `p = 0` THENL + [ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_POW_1; COMPLEX_DIV_1; VECTOR_ADD_LID]; + MP_TAC(SPECL [`z:complex`; `p:num`] lemma4) THEN + ASM_SIMP_TAC[LE_1] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + REWRITE_TAC[complex_sub; COMPLEX_NEG_ADD; VECTOR_NEG_NEG] THEN + REWRITE_TAC[COMPLEX_ADD_SYM]]);; + +let LOG_GAMMA_STIRLING = prove + (`!x p. &0 < x + ==> log(gamma x) = + ((x - &1 / &2) * log(x) - x + log(&2 * pi) / &2) + + sum(1..p) (\k. bernoulli (2 * k) (&0) / + (&4 * &k pow 2 - &2 * &k) / x pow (2 * k - 1)) - + real_integral {t | &0 <= t} + (\t. bernoulli (2 * p + 1) (frac t) / + (x + t) pow (2 * p + 1)) / + &(2 * p + 1)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_EXP_INJ] THEN + ASM_SIMP_TAC[EXP_LOG; GAMMA_POS_LT] THEN + GEN_REWRITE_TAC I [GSYM CX_INJ] THEN REWRITE_TAC[CX_GAMMA] THEN + MP_TAC(ISPEC `Cx x` CGAMMA_LGAMMA) THEN + COND_CASES_TAC THENL + [FIRST_ASSUM(CHOOSE_THEN (MP_TAC o AP_TERM `Re`)) THEN + REWRITE_TAC[RE_ADD; RE_CX] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CX_EXP] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`Cx x`; `p:num`] LGAMMA_STIRLING) THEN + ASM_REWRITE_TAC[RE_CX; CX_GAMMA] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CX_ADD; CX_SUB; CX_DIV; CX_MUL; GSYM VSUM_CX] THEN + ASM_SIMP_TAC[GSYM CX_LOG; CX_POW] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX] THEN + REWRITE_TAC[RE_DEF; IM_DEF] THEN CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) INTEGRAL_COMPONENT o lhand o snd) THEN + ASM_SIMP_TAC[LGAMMA_STIRLING_INTEGRALS_EXIST; + ARITH_RULE `1 <= 2 * p + 1`; RE_CX] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_POW; GSYM CX_DIV; RE_CX; IM_CX] THEN + REWRITE_TAC[LIFT_NUM; INTEGRAL_0; DROP_VEC] THEN + SUBGOAL_THEN + `{t | &0 <= drop t} = IMAGE lift {t | &0 <= t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]; + MATCH_MP_TAC(GSYM(REWRITE_RULE[o_DEF] REAL_INTEGRAL))] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF] THEN + MP_TAC(SPECL [`Cx x`; `2 * p + 1`] LGAMMA_STIRLING_INTEGRALS_EXIST) THEN + ASM_REWRITE_TAC[RE_CX; ARITH_RULE `1 <= 2 * p + 1`] THEN + GEN_REWRITE_TAC LAND_CONV [INTEGRABLE_COMPONENTWISE] THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_POW; GSYM CX_DIV; RE_CX; GSYM RE_DEF] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Some other mathematical facts that don't directly involve the gamma *) +(* function can now be proved relatively easily: Euler's product for sin, *) +(* Wallis's product for pi, and the Gaussian integral. *) +(* ------------------------------------------------------------------------- *) + +let CSIN_PRODUCT = prove + (`!z. ((\n. z * cproduct(1..n) (\m. Cx(&1) - (z / Cx(pi * &m)) pow 2)) + --> csin(z)) sequentially`, + GEN_TAC THEN REWRITE_TAC[CX_MUL; complex_div; COMPLEX_INV_MUL] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[GSYM complex_div] THEN + ABBREV_TAC `w = z / Cx pi` THEN + SUBGOAL_THEN `Cx pi * w = z` ASSUME_TAC THENL + [EXPAND_TAC "w" THEN MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN + CONV_TAC COMPLEX_FIELD; + EXPAND_TAC "z" THEN + SUBGOAL_THEN `csin (Cx pi * w) = Cx pi * csin(Cx pi * w) / Cx pi` + SUBST1_TAC THENL + [MP_TAC PI_NZ THEN REWRITE_TAC[GSYM CX_INJ] THEN CONV_TAC COMPLEX_FIELD; + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + REWRITE_TAC[GSYM CGAMMA_REFLECTION] THEN + REWRITE_TAC[COMPLEX_INV_DIV; COMPLEX_INV_MUL] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN SPEC_TAC(`w:complex`,`z:complex`)]] THEN + X_GEN_TAC `z:complex` THEN + MP_TAC(SPEC `z:complex` RECIP_CGAMMA) THEN + MP_TAC(SPEC `Cx(&1) - z` RECIP_CGAMMA) THEN + REWRITE_TAC[COMPLEX_RING `Cx(&1) - z + m = (m + Cx(&1)) - z`] THEN + REWRITE_TAC[GSYM CX_ADD; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[GSYM + (ISPECL [`f:num->complex`; `m:num`; `1`] CPRODUCT_OFFSET)] THEN + SIMP_TAC[CPRODUCT_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[ADD_CLAUSES; COMPLEX_ADD_RID; GSYM IMP_CONJ_ALT] THEN + SIMP_TAC[CPRODUCT_CLAUSES_RIGHT; ARITH_RULE `0 < n + 1 /\ 1 <= n + 1`] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; ADD_SUB] THEN + SUBGOAL_THEN `((\n. Cx(&n) / (Cx(&n) + Cx(&1) - z)) --> Cx(&1)) sequentially` + MP_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_INV_1] THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + MATCH_MP_TAC LIM_COMPLEX_INV THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_RING] THEN + REWRITE_TAC[complex_div; COMPLEX_ADD_RDISTRIB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_ADD_RID] THEN + MATCH_MP_TAC LIM_ADD THEN + SIMP_TAC[LIM_INV_N; LIM_NULL_COMPLEX_LMUL] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN + SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; LE_1]; + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_COMPLEX_MUL)] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(ISPEC `norm(z:complex)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `MAX 1 N` THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN + STRIP_TAC THEN REWRITE_TAC[CPOW_SUB; CPOW_N; COMPLEX_POW_1] THEN + ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1] THEN + REWRITE_TAC[complex_div; COMPLEX_INV_MUL; COMPLEX_INV_INV] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[COMPLEX_RING + `a * b * c * d * e * f * g * h * i * j * k :complex = + (a * i) * (j * e) * (h * b) * c * (d * g) * (f * k)`] THEN + SUBGOAL_THEN `~((Cx(&n) + Cx(&1)) - z = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_SUB_0; GSYM CX_ADD] THEN + DISCH_THEN(MP_TAC o AP_TERM `norm:complex->real`) THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_RING `n + Cx(&1) - z = (n + Cx(&1)) - z`]] THEN + ASM_SIMP_TAC[COMPLEX_MUL_RINV; CX_INJ; REAL_OF_NUM_EQ; CPOW_EQ_0; LE_1] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM NPRODUCT_FACT; REAL_OF_NUM_NPRODUCT; CX_PRODUCT; FINITE_NUMSEG; + GSYM CPRODUCT_INV; GSYM CPRODUCT_MUL] THEN + MATCH_MP_TAC CPRODUCT_EQ THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(Cx(&k) = Cx(&0))` MP_TAC THENL + [ASM_SIMP_TAC[CX_INJ; REAL_OF_NUM_EQ; LE_1]; + CONV_TAC COMPLEX_FIELD]);; + +let SIN_PRODUCT = prove + (`!x. ((\n. x * product(1..n) (\m. &1 - (x / (pi * &m)) pow 2)) ---> sin(x)) + sequentially`, + GEN_TAC THEN MP_TAC(SPEC `Cx x` CSIN_PRODUCT) THEN + REWRITE_TAC[REALLIM_COMPLEX; o_DEF] THEN + SIMP_TAC[CX_MUL; CX_PRODUCT; FINITE_NUMSEG; CX_SIN] THEN + REWRITE_TAC[CX_SUB; CX_DIV; CX_POW; CX_MUL]);; + +let WALLIS_ALT = prove + (`((\n. product(1..n) (\k. (&2 * &k) / (&2 * &k - &1) * + (&2 * &k) / (&2 * &k + &1))) ---> pi / &2) + sequentially`, + ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REALLIM_INV THEN + CONJ_TAC THENL [ALL_TAC; MP_TAC PI_POS THEN CONV_TAC REAL_FIELD] THEN + MP_TAC(SPEC `pi / &2` SIN_PRODUCT) THEN REWRITE_TAC[SIN_PI2] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC; REAL_INV_INV] THEN + DISCH_THEN(MP_TAC o SPEC `inv pi * &2` o MATCH_MP REALLIM_LMUL) THEN + SIMP_TAC[REAL_MUL_RID; PI_NZ; REAL_FIELD + `~(pi = &0) ==> (pi * x) * inv pi = x /\ + (inv pi * &2) * (pi * inv(&2)) * y = y`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG] THEN + MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + CONV_TAC REAL_FIELD);; + +let WALLIS = prove + (`((\n. (&2 pow n * &(FACT n)) pow 4 / (&(FACT(2 * n)) * &(FACT(2 * n + 1)))) + ---> pi / &2) sequentially`, + MP_TAC WALLIS_ALT THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN + REWRITE_TAC[GSYM ADD1; ARITH_RULE `2 * SUC n = SUC(SUC(2 * n))`] THEN + REWRITE_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL] THEN + MAP_EVERY (MP_TAC o C SPEC FACT_NZ) [`n:num`; `2 * n`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD);; + +let GAUSSIAN_INTEGRAL = prove + (`((\x. exp(--(x pow 2))) has_real_integral sqrt pi) (:real)`, + SUBGOAL_THEN + `((\x. exp(--(x pow 2))) has_real_integral gamma(&1 / &2) / &2) + {x | &0 <= x}` + ASSUME_TAC THENL + [ALL_TAC; + SUBGOAL_THEN + `(:real) = {x | &0 <= x} UNION IMAGE (--) {x | &0 <= x}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`; UNWIND_THM1] THEN + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `sqrt x = sqrt x / &2 + sqrt x / &2`]] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_REFLECT_GEN] THEN + ASM_SIMP_TAC[REAL_POW_NEG; ARITH; GSYM GAMMA_HALF] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_ELIM_THM; SET_RULE + `s INTER IMAGE f s SUBSET {a} <=> !x. x IN s /\ f x IN s ==> f x = a`] THEN + REAL_ARITH_TAC] THEN + MP_TAC(SPEC `&1 / &2` EULER_HAS_REAL_INTEGRAL_GAMMA) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP HAS_REAL_INTEGRAL_RMUL) THEN + REWRITE_TAC[GSYM real_div] THEN + ONCE_REWRITE_TAC[HAS_REAL_INTEGRAL_ALT] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_INTER; + REAL_INTEGRABLE_RESTRICT_INTER; REAL_INTEGRAL_RESTRICT_INTER] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN + SIMP_TAC[REAL_ARITH `&0 < B ==> --B <= B /\ ~(B <= --B)`] THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; INTER; IN_REAL_INTERVAL] THEN + REWRITE_TAC[IN_ELIM_THM; REAL_ARITH + `&0 <= x /\ (a <= x /\ x <= b) <=> max (&0) a <= x /\ x <= b`] THEN + REWRITE_TAC[GSYM real_interval] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a <= --B /\ --B < B /\ B <= b <=> + max (&0) a = &0 /\ &0 < B /\ a <= --B /\ B <= b`] THEN + SIMP_TAC[] THEN + REWRITE_TAC[REAL_ARITH + `max (&0) a = &0 /\ &0 < B /\ a <= --B /\ B <= b <=> + a <= --B /\ &0 < B /\ B <= b`] THEN + GEN_REWRITE_TAC (BINOP_CONV o ONCE_DEPTH_CONV) [IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM] THEN + REWRITE_TAC[MESON[REAL_LE_REFL] `?a. a <= B`] THEN + ONCE_REWRITE_TAC[ + MESON[REAL_ARITH `a <= max a b /\ (&0 <= a ==> max (&0) a = a)`] + `(!a. P (max (&0) a)) <=> (!a. &0 <= a ==> P a)`] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!a b. &0 <= a /\ a <= b + ==> ((\x. exp(--(x pow 2))) has_real_integral + real_integral (real_interval[a pow 2,b pow 2]) + (\t. t rpow (-- &1 / &2) / exp t / &2)) + (real_interval[a,b])` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\t. t rpow (&1 / &2 - &1) / exp t / &2`; + `\x:real. x pow 2`; `\x. &2 * x`; + `a:real`; `b:real`; `(a:real) pow 2`; `(b:real) pow 2`; `{&0}`] + HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG) THEN + REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LE_REFL; REAL_LE_POW_2; COUNTABLE_SING; + REAL_POW_LE2] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + SIMP_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THENL + [REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL THEN + REAL_DIFFERENTIABLE_TAC THEN + ASM_REWRITE_TAC[REAL_LT_POW_2; REAL_EXP_NZ]]]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] HAS_REAL_INTEGRAL_SPIKE)) THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL; IN_DIFF; IN_SING] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 <= x` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_EXP_NEG; GSYM RPOW_POW] THEN + ASM_SIMP_TAC[RPOW_RPOW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[RPOW_NEG; RPOW_POW; REAL_POW_1] THEN + MP_TAC(SPEC `(x:real) pow 2` REAL_EXP_NZ) THEN + UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD]; + FIRST_X_ASSUM(K ALL_TAC o SPECL [`a:real`; `b:real`]) THEN + DISCH_THEN(LABEL_TAC "*")] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `b <= a \/ a <= b`) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL] THEN + REWRITE_TAC[real_integrable_on] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `&0`) THEN + REWRITE_TAC[REAL_LE_REFL; HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `&0 < B /\ B <= b <=> &0 < B /\ B <= b /\ &0 <= b`] THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `max B (&1)` THEN + ASM_REWRITE_TAC[REAL_LT_MAX; REAL_MAX_LE] THEN + X_GEN_TAC `b:real` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN TRANS_TAC REAL_LE_TRANS `(b:real) pow 1` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[ARITH]);; diff --git a/Multivariate/geom.ml b/Multivariate/geom.ml new file mode 100644 index 0000000..d14a463 --- /dev/null +++ b/Multivariate/geom.ml @@ -0,0 +1,933 @@ +(* ========================================================================= *) +(* Some geometric notions in real^N. *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +prioritize_vector();; + +(* ------------------------------------------------------------------------- *) +(* Pythagoras's theorem is almost immediate. *) +(* ------------------------------------------------------------------------- *) + +let PYTHAGORAS = prove + (`!A B C:real^N. + orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`, + REWRITE_TAC[NORM_POW_2; orthogonal; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Angle between vectors (always 0 <= angle <= pi). *) +(* ------------------------------------------------------------------------- *) + +let vector_angle = new_definition + `vector_angle x y = if x = vec 0 \/ y = vec 0 then pi / &2 + else acs((x dot y) / (norm x * norm y))`;; + +let VECTOR_ANGLE_LINEAR_IMAGE_EQ = prove + (`!f x y. linear f /\ (!x. norm(f x) = norm x) + ==> (vector_angle (f x) (f y) = vector_angle x y)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[vector_angle; GSYM NORM_EQ_0] THEN + ASM_MESON_TAC[PRESERVES_NORM_PRESERVES_DOT]);; + +add_linear_invariants [VECTOR_ANGLE_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of vector angles. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_ANGLE_REFL = prove + (`!x. vector_angle x x = if x = vec 0 then pi / &2 else &0`, + GEN_TAC THEN REWRITE_TAC[vector_angle; DISJ_ACI] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_POW_2] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_ENTIRE; NORM_EQ_0; ACS_1]);; + +let VECTOR_ANGLE_SYM = prove + (`!x y. vector_angle x y = vector_angle y x`, + REWRITE_TAC[vector_angle; DISJ_SYM; DOT_SYM; REAL_MUL_SYM]);; + +let VECTOR_ANGLE_LMUL = prove + (`!a x y:real^N. + vector_angle (a % x) y = + if a = &0 then pi / &2 + else if &0 <= a then vector_angle x y + else pi - vector_angle x y`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[vector_angle; VECTOR_MUL_EQ_0] THEN + ASM_CASES_TAC `x:real^N = vec 0 \/ y:real^N = vec 0` THEN + ASM_REWRITE_TAC[] THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_MUL; DOT_LMUL; real_div; REAL_INV_MUL; real_abs] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(a = &0) ==> (a * x) * (inv a * y) * z = x * y * z`] THEN + MATCH_MP_TAC ACS_NEG THEN + REWRITE_TAC[GSYM REAL_ABS_BOUNDS; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM real_div; NORM_CAUCHY_SCHWARZ_DIV]);; + +let VECTOR_ANGLE_RMUL = prove + (`!a x y:real^N. + vector_angle x (a % y) = + if a = &0 then pi / &2 + else if &0 <= a then vector_angle x y + else pi - vector_angle x y`, + ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN + REWRITE_TAC[VECTOR_ANGLE_LMUL]);; + +let VECTOR_ANGLE_LNEG = prove + (`!x y. vector_angle (--x) y = pi - vector_angle x y`, + REWRITE_TAC[VECTOR_ARITH `--x = -- &1 % x`; VECTOR_ANGLE_LMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let VECTOR_ANGLE_RNEG = prove + (`!x y. vector_angle x (--y) = pi - vector_angle x y`, + ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN REWRITE_TAC[VECTOR_ANGLE_LNEG]);; + +let VECTOR_ANGLE_NEG2 = prove + (`!x y. vector_angle (--x) (--y) = vector_angle x y`, + REWRITE_TAC[VECTOR_ANGLE_LNEG; VECTOR_ANGLE_RNEG] THEN REAL_ARITH_TAC);; + +let VECTOR_ANGLE = prove + (`!x y:real^N. x dot y = norm(x) * norm(y) * cos(vector_angle x y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_angle] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_LZERO; NORM_0; REAL_MUL_LZERO] THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN + ASM_REWRITE_TAC[DOT_RZERO; NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `a * b * c:real = c * a * b`] THEN + ASM_SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT] THEN + MATCH_MP_TAC(GSYM COS_ACS) THEN + ASM_REWRITE_TAC[REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV]);; + +let VECTOR_ANGLE_RANGE = prove + (`!x y:real^N. &0 <= vector_angle x y /\ vector_angle x y <= pi`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_angle] THEN COND_CASES_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DE_MORGAN_THM]) THEN MATCH_MP_TAC ACS_BOUNDS THEN + ASM_REWRITE_TAC[REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV]);; + +let ORTHOGONAL_VECTOR_ANGLE = prove + (`!x y:real^N. orthogonal x y <=> vector_angle x y = pi / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[orthogonal; vector_angle] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_RZERO] THEN + EQ_TAC THENL + [SIMP_TAC[real_div; REAL_MUL_LZERO] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM real_div; GSYM COS_PI2] THEN + MATCH_MP_TAC ACS_COS THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN + SIMP_TAC[COS_ACS; REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV; COS_PI2] THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; REAL_LT_MUL; NORM_POS_LT; REAL_MUL_LZERO]]);; + +let VECTOR_ANGLE_EQ_0 = prove + (`!x y:real^N. vector_angle x y = &0 <=> + ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x) % y = norm(y) % x`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN + ASM_SIMP_TAC[vector_angle; PI_NZ; REAL_ARITH `x / &2 = &0 <=> x = &0`] THEN + REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_EQ_LDIV_EQ; NORM_POS_LT; REAL_LT_MUL] THEN + MESON_TAC[ACS_1; COS_ACS; REAL_BOUNDS_LE; NORM_CAUCHY_SCHWARZ_DIV; COS_0]);; + +let VECTOR_ANGLE_EQ_PI = prove + (`!x y:real^N. vector_angle x y = pi <=> + ~(x = vec 0) /\ ~(y = vec 0) /\ + norm(x) % y + norm(y) % x = vec 0`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `--y:real^N`] VECTOR_ANGLE_EQ_0) THEN + SIMP_TAC[VECTOR_ANGLE_RNEG; REAL_ARITH `pi - x = &0 <=> x = pi`] THEN + STRIP_TAC THEN + REWRITE_TAC[NORM_NEG; VECTOR_ARITH `--x = vec 0 <=> x = vec 0`] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; + +let VECTOR_ANGLE_EQ_0_DIST = prove + (`!x y:real^N. vector_angle x y = &0 <=> + ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x + y) = norm x + norm y`, + REWRITE_TAC[VECTOR_ANGLE_EQ_0; GSYM NORM_TRIANGLE_EQ]);; + +let VECTOR_ANGLE_EQ_PI_DIST = prove + (`!x y:real^N. vector_angle x y = pi <=> + ~(x = vec 0) /\ ~(y = vec 0) /\ norm(x - y) = norm x + norm y`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `--y:real^N`] VECTOR_ANGLE_EQ_0_DIST) THEN + SIMP_TAC[VECTOR_ANGLE_RNEG; REAL_ARITH `pi - x = &0 <=> x = pi`] THEN + STRIP_TAC THEN REWRITE_TAC[NORM_NEG] THEN NORM_ARITH_TAC);; + +let SIN_VECTOR_ANGLE_POS = prove + (`!v w. &0 <= sin(vector_angle v w)`, + SIMP_TAC[SIN_POS_PI_LE; VECTOR_ANGLE_RANGE]);; + +let SIN_VECTOR_ANGLE_EQ_0 = prove + (`!x y. sin(vector_angle x y) = &0 <=> + vector_angle x y = &0 \/ vector_angle x y = pi`, + MESON_TAC[SIN_POS_PI; VECTOR_ANGLE_RANGE; REAL_LT_LE; SIN_0; SIN_PI]);; + +let ASN_SIN_VECTOR_ANGLE = prove + (`!x y:real^N. + asn(sin(vector_angle x y)) = + if vector_angle x y <= pi / &2 then vector_angle x y + else pi - vector_angle x y`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `asn(sin(pi - vector_angle (x:real^N) y))` THEN CONJ_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI] THEN + REAL_ARITH_TAC; + ALL_TAC]] THEN + MATCH_MP_TAC ASN_SIN THEN + MP_TAC(ISPECL [`x:real^N`; `y:real^N`] VECTOR_ANGLE_RANGE) THEN + ASM_REAL_ARITH_TAC);; + +let SIN_VECTOR_ANGLE_EQ = prove + (`!x y w z. + sin(vector_angle x y) = sin(vector_angle w z) <=> + vector_angle x y = vector_angle w z \/ + vector_angle x y = pi - vector_angle w z`, + REPEAT GEN_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[SIN_SUB; SIN_PI; COS_PI] THENL + [ALL_TAC; REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `asn`) THEN + REWRITE_TAC[ASN_SIN_VECTOR_ANGLE] THEN REAL_ARITH_TAC);; + +let CONTINUOUS_WITHIN_CX_VECTOR_ANGLE_COMPOSE = prove + (`!f:real^M->real^N g x s. + ~(f x = vec 0) /\ ~(g x = vec 0) /\ + f continuous (at x within s) /\ + g continuous (at x within s) + ==> (\x. Cx(vector_angle (f x) (g x))) continuous (at x within s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THEN + ASM_SIMP_TAC[CONTINUOUS_TRIVIAL_LIMIT; vector_angle] THEN + SUBGOAL_THEN + `(cacs o (\x. Cx(((f x:real^N) dot g x) / (norm(f x) * norm(g x))))) + continuous (at (x:real^M) within s)` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[CX_DIV; CX_MUL] THEN REWRITE_TAC[WITHIN_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV THEN + ASM_SIMP_TAC[NETLIMIT_WITHIN; COMPLEX_ENTIRE; CX_INJ; NORM_EQ_0] THEN + REWRITE_TAC[CONTINUOUS_CX_LIFT; GSYM CX_MUL; LIFT_CMUL] THEN + ASM_SIMP_TAC[CONTINUOUS_LIFT_DOT2] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN + ASM_SIMP_TAC[CONTINUOUS_LIFT_NORM_COMPOSE; o_DEF]; + MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN + EXISTS_TAC `{z | real z /\ abs(Re z) <= &1}` THEN + REWRITE_TAC[CONTINUOUS_WITHIN_CACS_REAL] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_CX; RE_CX; NORM_CAUCHY_SCHWARZ_DIV]]; + ASM_SIMP_TAC[CONTINUOUS_WITHIN; CX_ACS; o_DEF; + NORM_CAUCHY_SCHWARZ_DIV] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + SUBGOAL_THEN + `eventually (\y. ~((f:real^M->real^N) y = vec 0) /\ + ~((g:real^M->real^N) y = vec 0)) + (at x within s)` + MP_TAC THENL + [REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL + [UNDISCH_TAC `(f:real^M->real^N) continuous (at x within s)`; + UNDISCH_TAC `(g:real^M->real^N) continuous (at x within s)`] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THENL + [DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x)`); + DISCH_THEN(MP_TAC o SPEC `norm((g:real^M->real^N) x)`)] THEN + ASM_REWRITE_TAC[NORM_POS_LT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + SIMP_TAC[CX_ACS; NORM_CAUCHY_SCHWARZ_DIV]]]);; + +let CONTINUOUS_AT_CX_VECTOR_ANGLE = prove + (`!c x:real^N. ~(x = vec 0) ==> (Cx o vector_angle c) continuous (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[o_DEF; vector_angle] THEN + ASM_CASES_TAC `c:real^N = vec 0` THEN ASM_REWRITE_TAC[CONTINUOUS_CONST] THEN + MATCH_MP_TAC CONTINUOUS_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`\x:real^N. cacs(Cx((c dot x) / (norm c * norm x)))`; + `norm(x:real^N)`] THEN + ASM_REWRITE_TAC[NORM_POS_LT] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THENL + [ASM_MESON_TAC[NORM_ARITH `~(dist(vec 0,x) < norm x)`]; ALL_TAC] THEN + MATCH_MP_TAC(GSYM CX_ACS) THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_DIV]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_WITHIN_COMPOSE) THEN + CONJ_TAC THENL + [REWRITE_TAC[CX_DIV; CX_MUL] THEN REWRITE_TAC[WITHIN_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_DIV THEN + ASM_REWRITE_TAC[NETLIMIT_AT; COMPLEX_ENTIRE; CX_INJ; NORM_EQ_0] THEN + SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST; + CONTINUOUS_AT_CX_NORM; CONTINUOUS_AT_CX_DOT]; + MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN + EXISTS_TAC `{z | real z /\ abs(Re z) <= &1}` THEN + REWRITE_TAC[CONTINUOUS_WITHIN_CACS_REAL] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_CX; RE_CX; NORM_CAUCHY_SCHWARZ_DIV]]);; + +let CONTINUOUS_WITHIN_CX_VECTOR_ANGLE = prove + (`!c x:real^N s. + ~(x = vec 0) ==> (Cx o vector_angle c) continuous (at x within s)`, + SIMP_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CX_VECTOR_ANGLE]);; + +let REAL_CONTINUOUS_AT_VECTOR_ANGLE = prove + (`!c x:real^N. ~(x = vec 0) ==> (vector_angle c) real_continuous (at x)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_AT_CX_VECTOR_ANGLE]);; + +let REAL_CONTINUOUS_WITHIN_VECTOR_ANGLE = prove + (`!c s x:real^N. ~(x = vec 0) + ==> (vector_angle c) real_continuous (at x within s)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_WITHIN_CX_VECTOR_ANGLE]);; + +let CONTINUOUS_ON_CX_VECTOR_ANGLE = prove + (`!s. ~(vec 0 IN s) ==> (Cx o vector_angle c) continuous_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + ASM_MESON_TAC[CONTINUOUS_WITHIN_CX_VECTOR_ANGLE]);; + +let VECTOR_ANGLE_EQ = prove + (`!u v x y. ~(u = vec 0) /\ ~(v = vec 0) /\ ~(x = vec 0) /\ ~(y = vec 0) + ==> (vector_angle u v = vector_angle x y <=> + (x dot y) * norm(u) * norm(v) = + (u dot v) * norm(x) * norm(y))`, + SIMP_TAC[vector_angle; NORM_EQ_0; REAL_FIELD + `~(u = &0) /\ ~(v = &0) /\ ~(x = &0) /\ ~(y = &0) + ==> (a * u * v = b * x * y <=> a / (x * y) = b / (u * v))`] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `cos`) THEN + SIMP_TAC[COS_ACS; NORM_CAUCHY_SCHWARZ_DIV; REAL_BOUNDS_LE]);; + +let COS_VECTOR_ANGLE_EQ = prove + (`!u v x y. + cos(vector_angle u v) = cos(vector_angle x y) <=> + vector_angle u v = vector_angle x y`, + MESON_TAC[ACS_COS; VECTOR_ANGLE_RANGE]);; + +let COLLINEAR_VECTOR_ANGLE = prove + (`!x y. ~(x = vec 0) /\ ~(y = vec 0) + ==> (collinear {vec 0,x,y} <=> + vector_angle x y = &0 \/ vector_angle x y = pi)`, + REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL; NORM_CAUCHY_SCHWARZ_ABS_EQ; + VECTOR_ANGLE_EQ_0; VECTOR_ANGLE_EQ_PI] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN BINOP_TAC THEN + VECTOR_ARITH_TAC);; + +let COLLINEAR_SIN_VECTOR_ANGLE = prove + (`!x y. ~(x = vec 0) /\ ~(y = vec 0) + ==> (collinear {vec 0,x,y} <=> sin(vector_angle x y) = &0)`, + REWRITE_TAC[SIN_VECTOR_ANGLE_EQ_0; COLLINEAR_VECTOR_ANGLE]);; + +let COLLINEAR_SIN_VECTOR_ANGLE_IMP = prove + (`!x y. sin(vector_angle x y) = &0 + ==> ~(x = vec 0) /\ ~(y = vec 0) /\ collinear {vec 0,x,y}`, + MESON_TAC[COLLINEAR_SIN_VECTOR_ANGLE; SIN_VECTOR_ANGLE_EQ_0; + VECTOR_ANGLE_EQ_0_DIST; VECTOR_ANGLE_EQ_PI_DIST]);; + +let VECTOR_ANGLE_EQ_0_RIGHT = prove + (`!x y z:real^N. vector_angle x y = &0 + ==> (vector_angle x z = vector_angle y z)`, + REWRITE_TAC[VECTOR_ANGLE_EQ_0] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vector_angle (norm(x:real^N) % y) (z:real^N)` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[VECTOR_ANGLE_LMUL; NORM_EQ_0; NORM_POS_LE]; + REWRITE_TAC[VECTOR_ANGLE_LMUL] THEN + ASM_REWRITE_TAC[NORM_EQ_0; NORM_POS_LE]]);; + +let VECTOR_ANGLE_EQ_0_LEFT = prove + (`!x y z:real^N. vector_angle x y = &0 + ==> (vector_angle z x = vector_angle z y)`, + MESON_TAC[VECTOR_ANGLE_EQ_0_RIGHT; VECTOR_ANGLE_SYM]);; + +let VECTOR_ANGLE_EQ_PI_RIGHT = prove + (`!x y z:real^N. vector_angle x y = pi + ==> (vector_angle x z = pi - vector_angle y z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--x:real^N`; `y:real^N`; `z:real^N`] + VECTOR_ANGLE_EQ_0_RIGHT) THEN + ASM_REWRITE_TAC[VECTOR_ANGLE_LNEG] THEN REAL_ARITH_TAC);; + +let VECTOR_ANGLE_EQ_PI_LEFT = prove + (`!x y z:real^N. vector_angle x y = pi + ==> (vector_angle z x = pi - vector_angle z y)`, + MESON_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; VECTOR_ANGLE_SYM]);; + +let COS_VECTOR_ANGLE = prove + (`!x y:real^N. + cos(vector_angle x y) = if x = vec 0 \/ y = vec 0 then &0 + else (x dot y) / (norm x * norm y)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [ASM_REWRITE_TAC[vector_angle; COS_PI2]; ALL_TAC] THEN + ASM_CASES_TAC `y:real^N = vec 0` THENL + [ASM_REWRITE_TAC[vector_angle; COS_PI2]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_LT_MUL; NORM_POS_LT; VECTOR_ANGLE] THEN + REAL_ARITH_TAC);; + +let SIN_VECTOR_ANGLE = prove + (`!x y:real^N. + sin(vector_angle x y) = + if x = vec 0 \/ y = vec 0 then &1 + else sqrt(&1 - ((x dot y) / (norm x * norm y)) pow 2)`, + SIMP_TAC[SIN_COS_SQRT; SIN_VECTOR_ANGLE_POS; COS_VECTOR_ANGLE] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[SQRT_1]);; + +let SIN_SQUARED_VECTOR_ANGLE = prove + (`!x y:real^N. + sin(vector_angle x y) pow 2 = + if x = vec 0 \/ y = vec 0 then &1 + else &1 - ((x dot y) / (norm x * norm y)) pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC + [REWRITE_RULE [REAL_ARITH `s + c = &1 <=> s = &1 - c`] SIN_CIRCLE] THEN + REWRITE_TAC[COS_VECTOR_ANGLE] THEN REAL_ARITH_TAC);; + +let VECTOR_ANGLE_COMPLEX_LMUL = prove + (`!a. ~(a = Cx(&0)) + ==> vector_angle (a * x) (a * y) = vector_angle x y`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `x = Cx(&0)` THENL + [ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; vector_angle; COMPLEX_VEC_0]; + ALL_TAC] THEN + ASM_CASES_TAC `y = Cx(&0)` THENL + [ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; vector_angle; COMPLEX_VEC_0]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`a * x:complex`; `a * y:complex`; `x:complex`; `y:complex`] + VECTOR_ANGLE_EQ) THEN + ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_ENTIRE] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN MATCH_MP_TAC(REAL_RING + `a pow 2 * xy:real = d ==> xy * (a * x) * (a * y) = d * x * y`) THEN + REWRITE_TAC[NORM_POW_2] THEN + REWRITE_TAC[DOT_2; complex_mul; GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN + REAL_ARITH_TAC);; + +let VECTOR_ANGLE_1 = prove + (`!x. vector_angle x (Cx(&1)) = acs(Re x / norm x)`, + GEN_TAC THEN + SIMP_TAC[vector_angle; COMPLEX_VEC_0; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ] THEN + COND_CASES_TAC THENL + [ASM_REWRITE_TAC[real_div; RE_CX; ACS_0; REAL_MUL_LZERO]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_MUL_RID] THEN + REWRITE_TAC[DOT_2; GSYM RE_DEF; GSYM IM_DEF; RE_CX; IM_CX] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let ARG_EQ_VECTOR_ANGLE_1 = prove + (`!z. ~(z = Cx(&0)) /\ &0 <= Im z ==> Arg z = vector_angle z (Cx(&1))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ANGLE_1] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o LAND_CONV o RAND_CONV) [ARG] THEN + REWRITE_TAC[RE_MUL_CX; RE_CEXP; RE_II; IM_MUL_II; IM_CX; RE_CX] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_EXP_0; REAL_MUL_LID] THEN + ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD + `~(z = &0) ==> (z * x) / z = x`] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC ACS_COS THEN + ASM_REWRITE_TAC[ARG; ARG_LE_PI]);; + +let VECTOR_ANGLE_ARG = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> vector_angle w z = if &0 <= Im(z / w) then Arg(z / w) + else &2 * pi - Arg(z / w)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [SUBGOAL_THEN `z = w * (z / w) /\ w = w * Cx(&1)` MP_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC]; + SUBGOAL_THEN `w = z * (w / z) /\ z = z * Cx(&1)` MP_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; ALL_TAC]] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + ASM_SIMP_TAC[VECTOR_ANGLE_COMPLEX_LMUL] THENL + [ONCE_REWRITE_TAC[VECTOR_ANGLE_SYM] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC ARG_EQ_VECTOR_ANGLE_1 THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; + MP_TAC(ISPEC `z / w:complex` ARG_INV) THEN ANTS_TAC THENL + [ASM_MESON_TAC[real; REAL_LE_REFL]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[COMPLEX_INV_DIV] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC ARG_EQ_VECTOR_ANGLE_1 THEN CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; + ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + REWRITE_TAC[IM_COMPLEX_INV_GE_0] THEN ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Traditional geometric notion of angle (always 0 <= theta <= pi). *) +(* ------------------------------------------------------------------------- *) + +let angle = new_definition + `angle(a,b,c) = vector_angle (a - b) (c - b)`;; + +let ANGLE_LINEAR_IMAGE_EQ = prove + (`!f a b c. + linear f /\ (!x. norm(f x) = norm x) + ==> angle(f a,f b,f c) = angle(a,b,c)`, + SIMP_TAC[angle; GSYM LINEAR_SUB; VECTOR_ANGLE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [ANGLE_LINEAR_IMAGE_EQ];; + +let ANGLE_TRANSLATION_EQ = prove + (`!a b c d. angle(a + b,a + c,a + d) = angle(b,c,d)`, + REPEAT GEN_TAC THEN REWRITE_TAC[angle] THEN + BINOP_TAC THEN VECTOR_ARITH_TAC);; + +add_translation_invariants [ANGLE_TRANSLATION_EQ];; + +let VECTOR_ANGLE_ANGLE = prove + (`vector_angle x y = angle(x,vec 0,y)`, + REWRITE_TAC[angle; VECTOR_SUB_RZERO]);; + +let ANGLE_EQ_PI_DIST = prove + (`!A B C:real^N. + angle(A,B,C) = pi <=> + ~(A = B) /\ ~(C = B) /\ dist(A,C) = dist(A,B) + dist(B,C)`, + REWRITE_TAC[angle; VECTOR_ANGLE_EQ_PI_DIST] THEN NORM_ARITH_TAC);; + +let SIN_ANGLE_POS = prove + (`!A B C. &0 <= sin(angle(A,B,C))`, + REWRITE_TAC[angle; SIN_VECTOR_ANGLE_POS]);; + +let ANGLE = prove + (`!A B C. (A - C) dot (B - C) = dist(A,C) * dist(B,C) * cos(angle(A,C,B))`, + REWRITE_TAC[angle; dist; GSYM VECTOR_ANGLE]);; + +let ANGLE_REFL = prove + (`!A B. angle(A,A,B) = pi / &2 /\ angle(B,A,A) = pi / &2`, + REWRITE_TAC[angle; vector_angle; VECTOR_SUB_REFL]);; + +let ANGLE_REFL_MID = prove + (`!A B. ~(A = B) ==> angle(A,B,A) = &0`, + SIMP_TAC[angle; vector_angle; VECTOR_SUB_EQ; GSYM NORM_POW_2; ARITH; + GSYM REAL_POW_2; REAL_DIV_REFL; ACS_1; REAL_POW_EQ_0; NORM_EQ_0]);; + +let ANGLE_SYM = prove + (`!A B C. angle(A,B,C) = angle(C,B,A)`, + REWRITE_TAC[angle; vector_angle; VECTOR_SUB_EQ; DISJ_SYM; + REAL_MUL_SYM; DOT_SYM]);; + +let ANGLE_RANGE = prove + (`!A B C. &0 <= angle(A,B,C) /\ angle(A,B,C) <= pi`, + REWRITE_TAC[angle; VECTOR_ANGLE_RANGE]);; + +let COS_ANGLE_EQ = prove + (`!a b c a' b' c'. + cos(angle(a,b,c)) = cos(angle(a',b',c')) <=> + angle(a,b,c) = angle(a',b',c')`, + REWRITE_TAC[angle; COS_VECTOR_ANGLE_EQ]);; + +let ANGLE_EQ = prove + (`!a b c a' b' c'. + ~(a = b) /\ ~(c = b) /\ ~(a' = b') /\ ~(c' = b') + ==> (angle(a,b,c) = angle(a',b',c') <=> + ((a' - b') dot (c' - b')) * norm (a - b) * norm (c - b) = + ((a - b) dot (c - b)) * norm (a' - b') * norm (c' - b'))`, + SIMP_TAC[angle; VECTOR_ANGLE_EQ; VECTOR_SUB_EQ]);; + +let SIN_ANGLE_EQ_0 = prove + (`!A B C. sin(angle(A,B,C)) = &0 <=> angle(A,B,C) = &0 \/ angle(A,B,C) = pi`, + REWRITE_TAC[angle; SIN_VECTOR_ANGLE_EQ_0]);; + +let SIN_ANGLE_EQ = prove + (`!A B C A' B' C'. sin(angle(A,B,C)) = sin(angle(A',B',C')) <=> + angle(A,B,C) = angle(A',B',C') \/ + angle(A,B,C) = pi - angle(A',B',C')`, + REWRITE_TAC[angle; SIN_VECTOR_ANGLE_EQ]);; + +let COLLINEAR_ANGLE = prove + (`!A B C. ~(A = B) /\ ~(B = C) + ==> (collinear {A,B,C} <=> angle(A,B,C) = &0 \/ angle(A,B,C) = pi)`, + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + SIMP_TAC[COLLINEAR_VECTOR_ANGLE; VECTOR_SUB_EQ; angle]);; + +let COLLINEAR_SIN_ANGLE = prove + (`!A B C. ~(A = B) /\ ~(B = C) + ==> (collinear {A,B,C} <=> sin(angle(A,B,C)) = &0)`, + REWRITE_TAC[SIN_ANGLE_EQ_0; COLLINEAR_ANGLE]);; + +let COLLINEAR_SIN_ANGLE_IMP = prove + (`!A B C. sin(angle(A,B,C)) = &0 + ==> ~(A = B) /\ ~(B = C) /\ collinear {A,B,C}`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN REWRITE_TAC[angle] THEN + DISCH_THEN(MP_TAC o MATCH_MP COLLINEAR_SIN_VECTOR_ANGLE_IMP) THEN + SIMP_TAC[VECTOR_SUB_EQ]);; + +let ANGLE_EQ_0_RIGHT = prove + (`!A B C. angle(A,B,C) = &0 ==> angle(A,B,D) = angle(C,B,D)`, + REWRITE_TAC[VECTOR_ANGLE_EQ_0_RIGHT; angle]);; + +let ANGLE_EQ_0_LEFT = prove + (`!A B C. angle(A,B,C) = &0 ==> angle(D,B,A) = angle(D,B,C)`, + MESON_TAC[ANGLE_EQ_0_RIGHT; ANGLE_SYM]);; + +let ANGLE_EQ_PI_RIGHT = prove + (`!A B C. angle(A,B,C) = pi ==> angle(A,B,D) = pi - angle(C,B,D)`, + REWRITE_TAC[VECTOR_ANGLE_EQ_PI_RIGHT; angle]);; + +let ANGLE_EQ_PI_LEFT = prove + (`!A B C. angle(A,B,C) = pi ==> angle(A,B,D) = pi - angle(C,B,D)`, + MESON_TAC[ANGLE_EQ_PI_RIGHT; ANGLE_SYM]);; + +let COS_ANGLE = prove + (`!a b c. cos(angle(a,b,c)) = if a = b \/ c = b then &0 + else ((a - b) dot (c - b)) / + (norm(a - b) * norm(c - b))`, + REWRITE_TAC[angle; COS_VECTOR_ANGLE; VECTOR_SUB_EQ]);; + +let SIN_ANGLE = prove + (`!a b c. sin(angle(a,b,c)) = + if a = b \/ c = b then &1 + else sqrt(&1 - (((a - b) dot (c - b)) / + (norm(a - b) * norm(c - b))) pow 2)`, + REWRITE_TAC[angle; SIN_VECTOR_ANGLE; VECTOR_SUB_EQ]);; + +let SIN_SQUARED_ANGLE = prove + (`!a b c. sin(angle(a,b,c)) pow 2 = + if a = b \/ c = b then &1 + else &1 - (((a - b) dot (c - b)) / + (norm(a - b) * norm(c - b))) pow 2`, + REWRITE_TAC[angle; SIN_SQUARED_VECTOR_ANGLE; VECTOR_SUB_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* The law of cosines. *) +(* ------------------------------------------------------------------------- *) + +let LAW_OF_COSINES = prove + (`!A B C:real^N. + dist(B,C) pow 2 = (dist(A,B) pow 2 + dist(A,C) pow 2) - + &2 * dist(A,B) * dist(A,C) * cos(angle(B,A,C))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[angle; ONCE_REWRITE_RULE[NORM_SUB] dist; GSYM VECTOR_ANGLE; + NORM_POW_2] THEN + VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The law of sines. *) +(* ------------------------------------------------------------------------- *) + +let LAW_OF_SINES = prove + (`!A B C:real^N. + sin(angle(A,B,C)) * dist(B,C) = sin(angle(B,A,C)) * dist(A,C)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN + SIMP_TAC[SIN_ANGLE_POS; DIST_POS_LE; REAL_LE_MUL; ARITH] THEN + REWRITE_TAC[REAL_POW_MUL; MATCH_MP + (REAL_ARITH `x + y = &1 ==> x = &1 - y`) (SPEC_ALL SIN_CIRCLE)] THEN + ASM_CASES_TAC `A:real^N = B` THEN ASM_REWRITE_TAC[ANGLE_REFL; COS_PI2] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM VECTOR_SUB_EQ]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM NORM_EQ_0]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_RING + `~(a = &0) ==> a pow 2 * x = a pow 2 * y ==> x = y`)) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[GSYM dist] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN + REWRITE_TAC[REAL_RING + `a * (&1 - x) * b = c * (&1 - y) * d <=> + a * b - a * b * x = c * d - c * d * y`] THEN + REWRITE_TAC[GSYM REAL_POW_MUL; GSYM ANGLE] THEN + REWRITE_TAC[REAL_POW_MUL; dist; NORM_POW_2] THEN + REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* The sum of the angles of a triangle. *) +(* ------------------------------------------------------------------------- *) + +let TRIANGLE_ANGLE_SUM_LEMMA = prove + (`!A B C:real^N. ~(A = B) /\ ~(A = C) /\ ~(B = C) + ==> cos(angle(B,A,C) + angle(A,B,C) + angle(B,C,A)) = -- &1`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM NORM_EQ_0] THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`C:real^N`; `B:real^N`; `A:real^N`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] LAW_OF_SINES) THEN + MP_TAC(ISPECL [`B:real^N`; `A:real^N`; `C:real^N`] LAW_OF_SINES) THEN + MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `A:real^N`] LAW_OF_SINES) THEN + REWRITE_TAC[COS_ADD; SIN_ADD; dist; NORM_SUB] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t SIN_CIRCLE)) + [`angle(B:real^N,A,C)`; `angle(A:real^N,B,C)`; `angle(B:real^N,C,A)`] THEN + REWRITE_TAC[COS_ADD; SIN_ADD; ANGLE_SYM] THEN CONV_TAC REAL_RING);; + +let COS_MINUS1_LEMMA = prove + (`!x. cos(x) = -- &1 /\ &0 <= x /\ x < &3 * pi ==> x = pi`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?n. integer n /\ x = n * pi` + (X_CHOOSE_THEN `nn:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + REWRITE_TAC[GSYM SIN_EQ_0] THENL + [MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `?n. nn = &n` (X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_MUL_POS_LE]) THEN + SIMP_TAC[PI_POS; REAL_ARITH `&0 < p ==> ~(p < &0) /\ ~(p = &0)`] THEN + ASM_MESON_TAC[INTEGER_POS; REAL_LT_LE]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_RING `n = &1 ==> n * p = p`) THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(ARITH_RULE `n < 3 /\ ~(n = 0) /\ ~(n = 2) ==> n = 1`) THEN + RULE_ASSUM_TAC(SIMP_RULE[REAL_LT_RMUL_EQ; PI_POS; REAL_OF_NUM_LT]) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[COS_0; REAL_MUL_LZERO; COS_NPI] THEN + REAL_ARITH_TAC);; + +let TRIANGLE_ANGLE_SUM = prove + (`!A B C:real^N. ~(A = B /\ B = C /\ A = C) + ==> angle(B,A,C) + angle(A,B,C) + angle(B,C,A) = pi`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`A:real^N = B`; `B:real^N = C`; `A:real^N = C`] THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; ANGLE_REFL; REAL_HALF; REAL_ADD_RID] THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_ADD_LID; REAL_HALF] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC COS_MINUS1_LEMMA THEN + ASM_SIMP_TAC[TRIANGLE_ANGLE_SUM_LEMMA; REAL_LE_ADD; ANGLE_RANGE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= p /\ &0 <= y /\ y <= p /\ &0 <= z /\ z <= p /\ + ~(x = p /\ y = p /\ z = p) + ==> x + y + z < &3 * p`) THEN + ASM_SIMP_TAC[ANGLE_RANGE] THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ANGLE_EQ_PI_DIST])) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM VECTOR_SUB_EQ])) THEN + REWRITE_TAC[GSYM NORM_EQ_0; dist; NORM_SUB] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A few more lemmas about angles. *) +(* ------------------------------------------------------------------------- *) + +let ANGLE_EQ_PI_OTHERS = prove + (`!A B C:real^N. + angle(A,B,C) = pi + ==> angle(B,C,A) = &0 /\ angle(A,C,B) = &0 /\ + angle(B,A,C) = &0 /\ angle(C,A,B) = &0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [ANGLE_EQ_PI_DIST]) THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`] TRIANGLE_ANGLE_SUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `x + p + y = p ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN + SIMP_TAC[ANGLE_RANGE; ANGLE_SYM]);; + +let ANGLE_EQ_0_DIST = prove + (`!A B C:real^N. angle(A,B,C) = &0 <=> + ~(A = B) /\ ~(C = B) /\ + (dist(A,B) = dist(A,C) + dist(C,B) \/ + dist(B,C) = dist(A,C) + dist(A,B))`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `A:real^N = B` THENL + [ASM_REWRITE_TAC[angle; VECTOR_ANGLE_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN + ASM_CASES_TAC `B:real^N = C` THENL + [ASM_REWRITE_TAC[angle; VECTOR_ANGLE_EQ_0; VECTOR_SUB_EQ]; ALL_TAC] THEN + ASM_CASES_TAC `A:real^N = C` THENL + [ASM_SIMP_TAC[ANGLE_REFL_MID; DIST_REFL; REAL_ADD_LID]; ALL_TAC] THEN + EQ_TAC THENL + [ALL_TAC; + STRIP_TAC THENL + [MP_TAC(ISPECL[`A:real^N`; `C:real^N`; `B:real^N`] ANGLE_EQ_PI_DIST); + MP_TAC(ISPECL[`B:real^N`; `A:real^N`; `C:real^N`] ANGLE_EQ_PI_DIST)] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DIST_SYM; REAL_ADD_AC] THEN + DISCH_THEN(MP_TAC o MATCH_MP ANGLE_EQ_PI_OTHERS) THEN SIMP_TAC[]] THEN + ASM_REWRITE_TAC[angle; VECTOR_ANGLE_EQ_0; VECTOR_SUB_EQ] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (ISPECL [`norm(A - B:real^N)`; `norm(C - B:real^N)`] + REAL_LT_TOTAL) + THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; NORM_EQ_0; VECTOR_SUB_EQ; + VECTOR_ARITH `c - b:real^N = a - b <=> a = c`]; + ONCE_REWRITE_TAC[VECTOR_ARITH + `norm(A - B) % (C - B) = norm(C - B) % (A - B) <=> + (norm(C - B) - norm(A - B)) % (A - B) = norm(A - B) % (C - A)`]; + ONCE_REWRITE_TAC[VECTOR_ARITH + `norm(A - B) % (C - B) = norm(C - B) % (A - B) <=> + (norm(A - B) - norm(C - B)) % (C - B) = norm(C - B) % (A - C)`]] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] NORM_CROSS_MULTIPLY)) THEN + ASM_SIMP_TAC[REAL_SUB_LT; NORM_POS_LT; VECTOR_SUB_EQ] THEN + SIMP_TAC[GSYM DIST_TRIANGLE_EQ] THEN SIMP_TAC[DIST_SYM]);; + +let ANGLE_EQ_0_DIST_ABS = prove + (`!A B C:real^N. angle(A,B,C) = &0 <=> + ~(A = B) /\ ~(C = B) /\ + dist(A,C) = abs(dist(A,B) - dist(C,B))`, + REPEAT GEN_TAC THEN REWRITE_TAC[ANGLE_EQ_0_DIST] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`A:real^N`; `C:real^N`] DIST_POS_LE) THEN + REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some rules for congruent triangles (not necessarily in the same real^N). *) +(* ------------------------------------------------------------------------- *) + +let CONGRUENT_TRIANGLES_SSS = prove + (`!A B C:real^M A' B' C':real^N. + dist(A,B) = dist(A',B') /\ + dist(B,C) = dist(B',C') /\ + dist(C,A) = dist(C',A') + ==> angle(A,B,C) = angle(A',B',C')`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`dist(A':real^N,B') = &0`; `dist(B':real^N,C') = &0`] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_EQ_0]) THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; ANGLE_REFL] THEN + ONCE_REWRITE_TAC[GSYM COS_ANGLE_EQ] THEN + MP_TAC(ISPECL [`B:real^M`; `A:real^M`; `C:real^M`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`B':real^N`; `A':real^N`; `C':real^N`] LAW_OF_COSINES) THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DIST_EQ_0; DIST_SYM] THEN + CONV_TAC REAL_FIELD);; + +let CONGRUENT_TRIANGLES_SAS = prove + (`!A B C:real^M A' B' C':real^N. + dist(A,B) = dist(A',B') /\ + angle(A,B,C) = angle(A',B',C') /\ + dist(B,C) = dist(B',C') + ==> dist(A,C) = dist(A',C')`, + REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_EQ] THEN + MP_TAC(ISPECL [`B:real^M`; `A:real^M`; `C:real^M`] LAW_OF_COSINES) THEN + MP_TAC(ISPECL [`B':real^N`; `A':real^N`; `C':real^N`] LAW_OF_COSINES) THEN + REPEAT(DISCH_THEN SUBST1_TAC) THEN + REPEAT BINOP_TAC THEN ASM_MESON_TAC[DIST_SYM]);; + +let CONGRUENT_TRIANGLES_AAS = prove + (`!A B C:real^M A' B' C':real^N. + angle(A,B,C) = angle(A',B',C') /\ + angle(B,C,A) = angle(B',C',A') /\ + dist(A,B) = dist(A',B') /\ + ~(collinear {A,B,C}) + ==> dist(A,C) = dist(A',C') /\ dist(B,C) = dist(B',C')`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^M = B` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]; + ALL_TAC] THEN + DISCH_TAC THEN SUBGOAL_THEN `~(A':real^N = B')` ASSUME_TAC THENL + [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN + SUBGOAL_THEN `angle(C:real^M,A,B) = angle(C':real^N,A',B')` ASSUME_TAC THENL + [MP_TAC(ISPECL [`A:real^M`; `B:real^M`; `C:real^M`] TRIANGLE_ANGLE_SUM) THEN + MP_TAC(ISPECL [`A':real^N`; `B':real^N`; `C':real^N`] + TRIANGLE_ANGLE_SUM) THEN ASM_REWRITE_TAC[IMP_IMP] THEN + REWRITE_TAC[ANGLE_SYM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`C:real^M`; `B:real^M`; `A:real^M`] LAW_OF_SINES) THEN + MP_TAC(ISPECL [`C':real^N`; `B':real^N`; `A':real^N`] LAW_OF_SINES) THEN + SUBGOAL_THEN `~(sin(angle(B':real^N,C',A')) = &0)` MP_TAC THENL + [ASM_MESON_TAC[COLLINEAR_SIN_ANGLE_IMP; INSERT_AC]; + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ANGLE_SYM; DIST_SYM] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ANGLE_SYM; DIST_SYM] THEN + CONV_TAC REAL_FIELD]; + ASM_MESON_TAC[CONGRUENT_TRIANGLES_SAS; DIST_SYM; ANGLE_SYM]]);; + +let CONGRUENT_TRIANGLES_ASA = prove + (`!A B C:real^M A' B' C':real^N. + angle(A,B,C) = angle(A',B',C') /\ + dist(A,B) = dist(A',B') /\ + angle(B,A,C) = angle(B',A',C') /\ + ~(collinear {A,B,C}) + ==> dist(A,C) = dist(A',C')`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^M = B` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[INSERT_AC; COLLINEAR_2]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(A':real^N = B')` ASSUME_TAC THENL + [ASM_MESON_TAC[DIST_EQ_0]; ALL_TAC] THEN + MP_TAC(ISPECL [`A:real^M`; `B:real^M`; `C:real^M`] TRIANGLE_ANGLE_SUM) THEN + MP_TAC(ISPECL [`A':real^N`; `B':real^N`; `C':real^N`] + TRIANGLE_ANGLE_SUM) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `a + b + x = pi /\ a + b + y = pi ==> x = y`)) THEN + ASM_MESON_TAC[CONGRUENT_TRIANGLES_AAS; DIST_SYM; ANGLE_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Full versions where we deduce everything from the conditions. *) +(* ------------------------------------------------------------------------- *) + +let CONGRUENT_TRIANGLES_SSS_FULL = prove + (`!A B C:real^M A' B' C':real^N. + dist(A,B) = dist(A',B') /\ + dist(B,C) = dist(B',C') /\ + dist(C,A) = dist(C',A') + ==> dist(A,B) = dist(A',B') /\ + dist(B,C) = dist(B',C') /\ + dist(C,A) = dist(C',A') /\ + angle(A,B,C) = angle(A',B',C') /\ + angle(B,C,A) = angle(B',C',A') /\ + angle(C,A,B) = angle(C',A',B')`, + MESON_TAC[CONGRUENT_TRIANGLES_SSS; DIST_SYM; ANGLE_SYM]);; + +let CONGRUENT_TRIANGLES_SAS_FULL = prove + (`!A B C:real^M A' B' C':real^N. + dist(A,B) = dist(A',B') /\ + angle(A,B,C) = angle(A',B',C') /\ + dist(B,C) = dist(B',C') + ==> dist(A,B) = dist(A',B') /\ + dist(B,C) = dist(B',C') /\ + dist(C,A) = dist(C',A') /\ + angle(A,B,C) = angle(A',B',C') /\ + angle(B,C,A) = angle(B',C',A') /\ + angle(C,A,B) = angle(C',A',B')`, + MESON_TAC[CONGRUENT_TRIANGLES_SSS; DIST_SYM; ANGLE_SYM; + CONGRUENT_TRIANGLES_SAS]);; + +let CONGRUENT_TRIANGLES_AAS_FULL = prove + (`!A B C:real^M A' B' C':real^N. + angle(A,B,C) = angle(A',B',C') /\ + angle(B,C,A) = angle(B',C',A') /\ + dist(A,B) = dist(A',B') /\ + ~(collinear {A,B,C}) + ==> dist(A,B) = dist(A',B') /\ + dist(B,C) = dist(B',C') /\ + dist(C,A) = dist(C',A') /\ + angle(A,B,C) = angle(A',B',C') /\ + angle(B,C,A) = angle(B',C',A') /\ + angle(C,A,B) = angle(C',A',B')`, + MESON_TAC[CONGRUENT_TRIANGLES_SSS; DIST_SYM; ANGLE_SYM; + CONGRUENT_TRIANGLES_AAS]);; + +let CONGRUENT_TRIANGLES_ASA_FULL = prove + (`!A B C:real^M A' B' C':real^N. + angle(A,B,C) = angle(A',B',C') /\ + dist(A,B) = dist(A',B') /\ + angle(B,A,C) = angle(B',A',C') /\ + ~(collinear {A,B,C}) + ==> dist(A,B) = dist(A',B') /\ + dist(B,C) = dist(B',C') /\ + dist(C,A) = dist(C',A') /\ + angle(A,B,C) = angle(A',B',C') /\ + angle(B,C,A) = angle(B',C',A') /\ + angle(C,A,B) = angle(C',A',B')`, + MESON_TAC[CONGRUENT_TRIANGLES_ASA; CONGRUENT_TRIANGLES_SAS_FULL; + DIST_SYM; ANGLE_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Between-ness. *) +(* ------------------------------------------------------------------------- *) + +let ANGLE_BETWEEN = prove + (`!a b x. angle(a,x,b) = pi <=> ~(x = a) /\ ~(x = b) /\ between x (a,b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[between; ANGLE_EQ_PI_DIST] THEN + REWRITE_TAC[EQ_SYM_EQ]);; + +let BETWEEN_ANGLE = prove + (`!a b x. between x (a,b) <=> x = a \/ x = b \/ angle(a,x,b) = pi`, + REPEAT GEN_TAC THEN REWRITE_TAC[ANGLE_BETWEEN] THEN + MESON_TAC[BETWEEN_REFL]);; + +let ANGLES_ALONG_LINE = prove + (`!A B C D:real^N. + ~(C = A) /\ ~(C = B) /\ between C (A,B) + ==> angle(A,C,D) + angle(B,C,D) = pi`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM ANGLE_BETWEEN] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP ANGLE_EQ_PI_LEFT) THEN REAL_ARITH_TAC);; + +let ANGLES_ADD_BETWEEN = prove + (`!A B C D:real^N. + between C (A,B) /\ ~(D = A) /\ ~(D = B) + ==> angle(A,D,C) + angle(C,D,B) = angle(A,D,B)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `A:real^N = B` THENL + [ASM_SIMP_TAC[BETWEEN_REFL_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ADD_LID]; + ALL_TAC] THEN + ASM_CASES_TAC `C:real^N = A` THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ADD_LID] THEN + ASM_CASES_TAC `C:real^N = B` THEN + ASM_SIMP_TAC[ANGLE_REFL_MID; REAL_ADD_RID] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `C:real^N`; `D:real^N`] + ANGLES_ALONG_LINE) THEN + MP_TAC(ISPECL [`A:real^N`; `B:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN + MP_TAC(ISPECL [`A:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN + MP_TAC(ISPECL [`B:real^N`; `C:real^N`; `D:real^N`] TRIANGLE_ANGLE_SUM) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `angle(C:real^N,A,D) = angle(B,A,D) /\ + angle(A,B,D) = angle(C,B,D)` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [ALL_TAC; REWRITE_TAC[ANGLE_SYM] THEN REAL_ARITH_TAC] THEN + CONJ_TAC THEN MATCH_MP_TAC ANGLE_EQ_0_RIGHT THEN + ASM_MESON_TAC[ANGLE_EQ_PI_OTHERS; BETWEEN_ANGLE]);; diff --git a/Multivariate/integration.ml b/Multivariate/integration.ml new file mode 100644 index 0000000..5123a00 --- /dev/null +++ b/Multivariate/integration.ml @@ -0,0 +1,17665 @@ +(* ========================================================================= *) +(* Kurzweil-Henstock gauge integration in many dimensions. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Library/products.ml";; +needs "Library/floor.ml";; +needs "Multivariate/derivatives.ml";; +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Some useful lemmas about intervals. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_SUBSET_UNION_INTERVALS = prove + (`!s i j. (?a b:real^N. i = interval[a,b]) /\ (?c d. j = interval[c,d]) /\ + ~(interior j = {}) /\ + i SUBSET j UNION s /\ + interior(i) INTER interior(j) = {} + ==> interior i SUBSET interior s`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o check (is_var o lhs o concl))) THEN + MATCH_MP_TAC INTERIOR_MAXIMAL THEN REWRITE_TAC[OPEN_INTERIOR] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERIOR_CLOSED_INTERVAL]) THEN + SUBGOAL_THEN `interval(a:real^N,b) INTER interval[c,d] = {}` ASSUME_TAC THENL + [ASM_SIMP_TAC[INTER_INTERVAL_MIXED_EQ_EMPTY]; + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]]);; + +let INTER_INTERIOR_UNIONS_INTERVALS = prove + (`!s f. FINITE f /\ open s /\ + (!t. t IN f ==> ?a b:real^N. t = interval[a,b]) /\ + (!t. t IN f ==> s INTER (interior t) = {}) + ==> s INTER interior(UNIONS f) = {}`, + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> ~e ==> ~d`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM MEMBER_NOT_EMPTY] THEN + SIMP_TAC[OPEN_CONTAINS_BALL_EQ; OPEN_INTER; OPEN_INTERIOR] THEN + SIMP_TAC[OPEN_SUBSET_INTERIOR; OPEN_BALL; SUBSET_INTER] THEN + REWRITE_TAC[GSYM SUBSET_INTER] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REWRITE_TAC[UNIONS_0; INTER_EMPTY; SUBSET_EMPTY] THEN + MESON_TAC[CENTRE_IN_BALL; NOT_IN_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:real^N->bool`; `f:(real^N->bool)->bool`] THEN + DISCH_TAC THEN + REWRITE_TAC[UNIONS_INSERT; IN_INSERT] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[RIGHT_OR_DISTRIB; FORALL_AND_THM; EXISTS_OR_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `i:real^N->bool`) THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (X_CHOOSE_THEN `b:real^N` + SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT + `(r ==> s \/ p) ==> (p ==> q) ==> r ==> s \/ q`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC THEN + ASM_CASES_TAC `(x:real^N) IN interval[a,b]` THENL + [ALL_TAC; + SUBGOAL_THEN + `?d. &0 < d /\ ball(x,d) SUBSET ((:real^N) DIFF interval[a,b])` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[closed; OPEN_CONTAINS_BALL; CLOSED_INTERVAL; + IN_DIFF; IN_UNIV]; + ALL_TAC] THEN + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC [`x:real^N`; `min d e`] THEN + ASM_REWRITE_TAC[REAL_LT_MIN; SUBSET] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN + SIMP_TAC[IN_BALL; REAL_LT_MIN; IN_DIFF; IN_INTER; IN_UNIV; IN_UNION] THEN + ASM_MESON_TAC[]] THEN + ASM_CASES_TAC `(x:real^N) IN interval(a,b)` THENL + [DISJ1_TAC THEN + SUBGOAL_THEN + `?d. &0 < d /\ ball(x:real^N,d) SUBSET interval(a,b)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_CONTAINS_BALL; OPEN_INTERVAL]; ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x:real^N`; `min d e`] THEN + ASM_REWRITE_TAC[REAL_LT_MIN; SUBSET] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN + SIMP_TAC[IN_BALL; REAL_LT_MIN; IN_DIFF; IN_INTER; IN_UNIV; IN_UNION] THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_INTERVAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC[REAL_LT_LE] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[GSYM REAL_LT_LE; DE_MORGAN_THM] THEN + STRIP_TAC THEN DISJ2_TAC THENL + [EXISTS_TAC `x + --e / &2 % basis k :real^N`; + EXISTS_TAC `x + e / &2 % basis k :real^N`] THEN + EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b1 SUBSET k INTER (i UNION s) + ==> b2 SUBSET b1 /\ b2 INTER i = {} + ==> b2 SUBSET k INTER s`)) THEN + (CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_BALL] THEN + GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH `norm(d) = e / &2 ==> + dist(x + d,y) < e / &2 ==> dist(x,y) < e`) THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS] THEN UNDISCH_TAC `&0 < e` THEN + REAL_ARITH_TAC; + ALL_TAC]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_BALL; dist] THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN + W(MP_TAC o C ISPEC COMPONENT_LE_NORM o rand o lhand o lhand o snd) THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `x <= y /\ y < e ==> x < e`)) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o SPEC `k:num`) THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* This lemma about iterations comes up in a few places. *) +(* ------------------------------------------------------------------------- *) + +let ITERATE_NONZERO_IMAGE_LEMMA = prove + (`!op s f g a. + monoidal op /\ FINITE s /\ + g(a) = neutral op /\ + (!x y. x IN s /\ y IN s /\ f x = f y /\ ~(x = y) ==> g(f x) = neutral op) + ==> iterate op {f x | x | x IN s /\ ~(f x = a)} g = + iterate op s (g o f)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM ITERATE_SUPPORT] THEN + REWRITE_TAC[support] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x |x| x IN s /\ ~(f x = a)} = + IMAGE f {x | x IN s /\ ~(f x = a)}`] THEN + W(fun (asl,w) -> FIRST_ASSUM(fun th -> + MP_TAC(PART_MATCH (rand o rand) + (MATCH_MP ITERATE_IMAGE th) (rand w)))) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; o_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_SUPERSET) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; SUBSET] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; o_THM] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Bounds on intervals where they exist. *) +(* ------------------------------------------------------------------------- *) + +let interval_upperbound = new_definition + `(interval_upperbound:(real^M->bool)->real^M) s = + lambda i. sup {a | ?x. x IN s /\ (x$i = a)}`;; + +let interval_lowerbound = new_definition + `(interval_lowerbound:(real^M->bool)->real^M) s = + lambda i. inf {a | ?x. x IN s /\ (x$i = a)}`;; + +let INTERVAL_UPPERBOUND = prove + (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) + ==> interval_upperbound(interval[a,b]) = b`, + SIMP_TAC[interval_upperbound; CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_REFL]);; + +let INTERVAL_LOWERBOUND = prove + (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) + ==> interval_lowerbound(interval[a,b]) = a`, + SIMP_TAC[interval_lowerbound; CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_REFL]);; + +let INTERVAL_UPPERBOUND_1 = prove + (`!a b. drop a <= drop b ==> interval_upperbound(interval[a,b]) = b`, + SIMP_TAC[INTERVAL_UPPERBOUND; DIMINDEX_1; FORALL_1; drop]);; + +let INTERVAL_LOWERBOUND_1 = prove + (`!a b. drop a <= drop b ==> interval_lowerbound(interval[a,b]) = a`, + SIMP_TAC[INTERVAL_LOWERBOUND; DIMINDEX_1; FORALL_1; drop]);; + +let INTERVAL_LOWERBOUND_NONEMPTY = prove + (`!a b:real^N. + ~(interval[a,b] = {}) ==> interval_lowerbound(interval[a,b]) = a`, + SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_NE_EMPTY]);; + +let INTERVAL_UPPERBOUND_NONEMPTY = prove + (`!a b:real^N. + ~(interval[a,b] = {}) ==> interval_upperbound(interval[a,b]) = b`, + SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_NE_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Content (length, area, volume...) of an interval. *) +(* ------------------------------------------------------------------------- *) + +let content = new_definition + `content(s:real^M->bool) = + if s = {} then &0 else + product(1..dimindex(:M)) + (\i. (interval_upperbound s)$i - (interval_lowerbound s)$i)`;; + +let CONTENT_CLOSED_INTERVAL = prove + (`!a b:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) + ==> content(interval[a,b]) = + product(1..dimindex(:N)) (\i. b$i - a$i)`, + SIMP_TAC[content; INTERVAL_UPPERBOUND; INTERVAL_EQ_EMPTY; + INTERVAL_LOWERBOUND] THEN + MESON_TAC[REAL_NOT_LT]);; + +let CONTENT_1 = prove + (`!a b. drop a <= drop b ==> content(interval[a,b]) = drop b - drop a`, + SIMP_TAC[CONTENT_CLOSED_INTERVAL; FORALL_1; drop; DIMINDEX_1] THEN + REWRITE_TAC[PRODUCT_SING_NUMSEG]);; + +let CONTENT_UNIT = prove + (`content(interval[vec 0:real^N,vec 1]) = &1`, + REWRITE_TAC[content] THEN COND_CASES_TAC THENL + [POP_ASSUM MP_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_POS]; + MATCH_MP_TAC PRODUCT_EQ_1 THEN + SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; + VEC_COMPONENT; REAL_POS; IN_NUMSEG; REAL_SUB_RZERO]]);; + +let CONTENT_UNIT_1 = prove + (`content(interval[vec 0:real^1,vec 1]) = &1`, + MATCH_ACCEPT_TAC CONTENT_UNIT);; + +let CONTENT_POS_LE = prove + (`!a b:real^N. &0 <= content(interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC PRODUCT_POS_LE_NUMSEG THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_SUB_LE]);; + +let CONTENT_POS_LT = prove + (`!a b:real^N. + (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i) + ==> &0 < content(interval[a,b])`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_SUB_LT; + REAL_LT_IMP_LE]);; + +let CONTENT_POS_LT_1 = prove + (`!a b. drop a < drop b ==> &0 < content(interval[a,b])`, + SIMP_TAC[CONTENT_POS_LT; FORALL_1; DIMINDEX_1; GSYM drop]);; + +let CONTENT_EQ_0_GEN = prove + (`!s:real^N->bool. + bounded s + ==> (content s = &0 <=> + ?i a. 1 <= i /\ i <= dimindex(:N) /\ !x. x IN s ==> x$i = a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[content] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL + [MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_SUB_0] THEN DISCH_TAC THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `k:num` THEN + ASM_CASES_TAC `1 <= k` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[interval_upperbound; interval_lowerbound; LAMBDA_BETA] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_SUP_EQ_INF o lhs o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; + DISCH_THEN SUBST1_TAC THEN ASM SET_TAC[]]);; + +let CONTENT_EQ_0 = prove + (`!a b:real^N. + content(interval[a,b]) = &0 <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i`, + REPEAT GEN_TAC THEN REWRITE_TAC[content; INTERVAL_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + REWRITE_TAC[PRODUCT_EQ_0_NUMSEG; REAL_SUB_0] THEN + AP_TERM_TAC THEN ABS_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + SIMP_TAC[REAL_NOT_LT; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN + MESON_TAC[REAL_NOT_LE; REAL_LE_LT]);; + +let CONTENT_0_SUBSET_GEN = prove + (`!s t:real^N->bool. + s SUBSET t /\ bounded t /\ content t = &0 ==> content s = &0`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN `bounded(s:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[CONTENT_EQ_0_GEN] THEN ASM SET_TAC[]);; + +let CONTENT_0_SUBSET = prove + (`!s a b:real^N. + s SUBSET interval[a,b] /\ content(interval[a,b]) = &0 + ==> content s = &0`, + MESON_TAC[CONTENT_0_SUBSET_GEN; BOUNDED_INTERVAL]);; + +let CONTENT_CLOSED_INTERVAL_CASES = prove + (`!a b:real^N. + content(interval[a,b]) = + if !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i + then product(1..dimindex(:N)) (\i. b$i - a$i) + else &0`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[CONTENT_EQ_0; CONTENT_CLOSED_INTERVAL] THEN + ASM_MESON_TAC[REAL_LE_TOTAL]);; + +let CONTENT_EQ_0_INTERIOR = prove + (`!a b:real^N. + content(interval[a,b]) = &0 <=> interior(interval[a,b]) = {}`, + REWRITE_TAC[CONTENT_EQ_0; INTERIOR_CLOSED_INTERVAL; INTERVAL_EQ_EMPTY]);; + +let CONTENT_EQ_0_1 = prove + (`!a b:real^1. + content(interval[a,b]) = &0 <=> drop b <= drop a`, + REWRITE_TAC[CONTENT_EQ_0; drop; DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM] THEN + MESON_TAC[]);; + +let CONTENT_POS_LT_EQ = prove + (`!a b:real^N. + &0 < content(interval[a,b]) <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONTENT_POS_LT] THEN + REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + REWRITE_TAC[CONTENT_POS_LE; CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]);; + +let CONTENT_EMPTY = prove + (`content {} = &0`, + REWRITE_TAC[content]);; + +let CONTENT_SUBSET = prove + (`!a b c d:real^N. + interval[a,b] SUBSET interval[c,d] + ==> content(interval[a,b]) <= content(interval[c,d])`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [content] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_POS_LE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(fun th -> + MP_TAC(SPEC `a:real^N` th) THEN MP_TAC(SPEC `b:real^N` th)) THEN + ASM_SIMP_TAC[REAL_LE_REFL; content] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `(if b then c else d) = (if ~b then d else c)`] THEN + REWRITE_TAC[INTERVAL_NE_EMPTY] THEN COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS]] THEN + MATCH_MP_TAC PRODUCT_LE_NUMSEG THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let CONTENT_LT_NZ = prove + (`!a b. &0 < content(interval[a,b]) <=> ~(content(interval[a,b]) = &0)`, + REWRITE_TAC[CONTENT_POS_LT_EQ; CONTENT_EQ_0] THEN MESON_TAC[REAL_NOT_LE]);; + +let INTERVAL_BOUNDS_NULL_1 = prove + (`!a b:real^1. + content(interval[a,b]) = &0 + ==> interval_upperbound(interval[a,b]) = + interval_lowerbound(interval[a,b])`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL + [ASM_REWRITE_TAC[interval_upperbound; interval_lowerbound] THEN + REWRITE_TAC[sup; inf; NOT_IN_EMPTY; EMPTY_GSPEC] THEN DISCH_TAC THEN + REPLICATE_TAC 2 (AP_TERM_TAC THEN ABS_TAC) THEN + MESON_TAC[REAL_ARITH `~(x <= x - &1) /\ ~(x + &1 <= x)`]; + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN + REWRITE_TAC[CONTENT_EQ_0_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]);; + +let INTERVAL_BOUNDS_EMPTY_1 = prove + (`interval_upperbound({}:real^1->bool) = + interval_lowerbound({}:real^1->bool)`, + MESON_TAC[INTERVAL_BOUNDS_NULL_1; CONTENT_EMPTY; EMPTY_AS_INTERVAL]);; + +let CONTENT_PASTECART = prove + (`!a b:real^M c d:real^N. + content(interval[pastecart a c,pastecart b d]) = + content(interval[a,b]) * content(interval[c,d])`, + REPEAT GEN_TAC THEN + SIMP_TAC[CONTENT_CLOSED_INTERVAL_CASES; LAMBDA_BETA] THEN + MATCH_MP_TAC(MESON[REAL_MUL_LZERO; REAL_MUL_RZERO] + `(p <=> p1 /\ p2) /\ z = x * y + ==> (if p then z else &0) = + (if p1 then x else &0) * (if p2 then y else &0)`) THEN + CONJ_TAC THENL + [EQ_TAC THEN DISCH_TAC THEN TRY CONJ_TAC THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ADD_SUB]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[DIMINDEX_FINITE_SUM]) THEN + ASM_CASES_TAC `i <= dimindex(:M)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num` o CONJUNCT1); + FIRST_X_ASSUM(MP_TAC o SPEC `i - dimindex(:M)` o CONJUNCT2)] THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `i:num <= m ==> i <= m + n`] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; + SIMP_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE `1 <= n + 1`; + PRODUCT_ADD_SPLIT] THEN + BINOP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[PRODUCT_OFFSET]] THEN + MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; ADD_SUB; + ARITH_RULE `i:num <= m ==> i <= m + n`; + ARITH_RULE `i:num <= n ==> i + m <= m + n`] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The notion of a gauge --- simply an open set containing the point. *) +(* ------------------------------------------------------------------------- *) + +let gauge = new_definition + `gauge d <=> !x. x IN d(x) /\ open(d(x))`;; + +let GAUGE_BALL_DEPENDENT = prove + (`!e. (!x. &0 < e(x)) ==> gauge(\x. ball(x,e(x)))`, + SIMP_TAC[gauge; OPEN_BALL; IN_BALL; DIST_REFL]);; + +let GAUGE_BALL = prove + (`!e. &0 < e ==> gauge (\x. ball(x,e))`, + SIMP_TAC[gauge; OPEN_BALL; IN_BALL; DIST_REFL]);; + +let GAUGE_TRIVIAL = prove + (`gauge (\x. ball(x,&1))`, + SIMP_TAC[GAUGE_BALL; REAL_LT_01]);; + +let GAUGE_INTER = prove + (`!d1 d2. gauge d1 /\ gauge d2 ==> gauge (\x. (d1 x) INTER (d2 x))`, + SIMP_TAC[gauge; IN_INTER; OPEN_INTER]);; + +let GAUGE_INTERS = prove + (`!s. FINITE s /\ (!d. d IN s ==> gauge (f d)) + ==> gauge(\x. INTERS {f d x | d IN s})`, + REWRITE_TAC[gauge; IN_INTERS] THEN + REWRITE_TAC[SET_RULE `{f d x | d IN s} = IMAGE (\d. f d x) s`] THEN + SIMP_TAC[FORALL_IN_IMAGE; OPEN_INTERS; FINITE_IMAGE]);; + +let GAUGE_EXISTENCE_LEMMA = prove + (`(!x. ?d. p x ==> &0 < d /\ q d x) <=> + (!x. ?d. &0 < d /\ (p x ==> q d x))`, + MESON_TAC[REAL_LT_01]);; + +(* ------------------------------------------------------------------------- *) +(* Divisions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("division_of",(12,"right"));; + +let division_of = new_definition + `s division_of i <=> + FINITE s /\ + (!k. k IN s + ==> k SUBSET i /\ ~(k = {}) /\ ?a b. k = interval[a,b]) /\ + (!k1 k2. k1 IN s /\ k2 IN s /\ ~(k1 = k2) + ==> interior(k1) INTER interior(k2) = {}) /\ + (UNIONS s = i)`;; + +let DIVISION_OF = prove + (`s division_of i <=> + FINITE s /\ + (!k. k IN s ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\ + (!k1 k2. k1 IN s /\ k2 IN s /\ ~(k1 = k2) + ==> interior(k1) INTER interior(k2) = {}) /\ + UNIONS s = i`, + REWRITE_TAC[division_of] THEN SET_TAC[]);; + +let DIVISION_OF_FINITE = prove + (`!s i. s division_of i ==> FINITE s`, + MESON_TAC[division_of]);; + +let DIVISION_OF_SELF = prove + (`!a b. ~(interval[a,b] = {}) ==> {interval[a,b]} division_of interval[a,b]`, + REWRITE_TAC[division_of; FINITE_INSERT; FINITE_RULES; IN_SING; UNIONS_1] THEN + MESON_TAC[SUBSET_REFL]);; + +let DIVISION_OF_TRIVIAL = prove + (`!s. s division_of {} <=> s = {}`, + REWRITE_TAC[division_of; SUBSET_EMPTY; CONJ_ASSOC] THEN + REWRITE_TAC[TAUT `~(p /\ ~p)`; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[AC CONJ_ACI `((a /\ b) /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN + GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FINITE_RULES; UNIONS_0; NOT_IN_EMPTY]);; + +let EMPTY_DIVISION_OF = prove + (`!s. {} division_of s <=> s = {}`, + REWRITE_TAC[division_of; UNIONS_0; FINITE_EMPTY; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +let DIVISION_OF_SING = prove + (`!s a. s division_of interval[a,a] <=> s = {interval[a,a]}`, + let lemma = prove + (`s SUBSET {{a}} /\ p /\ UNIONS s = {a} <=> s = {{a}} /\ p`, + EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[SET_RULE `UNIONS {a} = a`] THEN ASM SET_TAC[]) in + REWRITE_TAC[division_of; INTERVAL_SING] THEN + REWRITE_TAC[SET_RULE `k SUBSET {a} /\ ~(k = {}) /\ p <=> k = {a} /\ p`] THEN + REWRITE_TAC[GSYM INTERVAL_SING] THEN + REWRITE_TAC[MESON[] `(k = interval[a,b] /\ ?c d. k = interval[c,d]) <=> + (k = interval[a,b])`] THEN + REWRITE_TAC[SET_RULE `(!k. k IN s ==> k = a) <=> s SUBSET {a}`] THEN + REWRITE_TAC[INTERVAL_SING; lemma] THEN MESON_TAC[FINITE_RULES; IN_SING]);; + +let ELEMENTARY_EMPTY = prove + (`?p. p division_of {}`, + REWRITE_TAC[DIVISION_OF_TRIVIAL; EXISTS_REFL]);; + +let ELEMENTARY_INTERVAL = prove + (`!a b. ?p. p division_of interval[a,b]`, + MESON_TAC[DIVISION_OF_TRIVIAL; DIVISION_OF_SELF]);; + +let DIVISION_CONTAINS = prove + (`!s i. s division_of i ==> !x. x IN i ==> ?k. x IN k /\ k IN s`, + REWRITE_TAC[division_of; EXTENSION; IN_UNIONS] THEN MESON_TAC[]);; + +let FORALL_IN_DIVISION = prove + (`!P d i. d division_of i + ==> ((!x. x IN d ==> P x) <=> + (!a b. interval[a,b] IN d ==> P(interval[a,b])))`, + REWRITE_TAC[division_of] THEN MESON_TAC[]);; + +let FORALL_IN_DIVISION_NONEMPTY = prove + (`!P d i. + d division_of i + ==> ((!x. x IN d ==> P x) <=> + (!a b. interval [a,b] IN d /\ ~(interval[a,b] = {}) + ==> P (interval [a,b])))`, + REWRITE_TAC[division_of] THEN MESON_TAC[]);; + +let DIVISION_OF_SUBSET = prove + (`!p q:(real^N->bool)->bool. + p division_of (UNIONS p) /\ q SUBSET p ==> q division_of (UNIONS q)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[division_of] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ASM SET_TAC[]; ASM SET_TAC[]]);; + +let DIVISION_OF_UNION_SELF = prove + (`!p s. p division_of s ==> p division_of (UNIONS p)`, + REWRITE_TAC[division_of] THEN MESON_TAC[]);; + +let DIVISION_OF_CONTENT_0 = prove + (`!a b d. content(interval[a,b]) = &0 /\ d division_of interval[a,b] + ==> !k. k IN d ==> content k = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM; CONTENT_POS_LE] THEN + ASM_MESON_TAC[CONTENT_SUBSET; division_of]);; + +let DIVISION_INTER = prove + (`!s1 s2:real^N->bool p1 p2. + p1 division_of s1 /\ + p2 division_of s2 + ==> {k1 INTER k2 | k1 IN p1 /\ k2 IN p2 /\ ~(k1 INTER k2 = {})} + division_of (s1 INTER s2)`, + let lemma = prove + (`{k1 INTER k2 | k1 IN p1 /\ k2 IN p2 /\ ~(k1 INTER k2 = {})} = + {s | s IN IMAGE (\(k1,k2). k1 INTER k2) (p1 CROSS p2) /\ + ~(s = {})}`, + REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; EXISTS_PAIR_THM; IN_CROSS] THEN + MESON_TAC[]) in + REPEAT GEN_TAC THEN REWRITE_TAC[DIVISION_OF] THEN STRIP_TAC THEN + ASM_SIMP_TAC[lemma; FINITE_RESTRICT; FINITE_CROSS; FINITE_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[INTER_INTERVAL]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `(interior x1 INTER interior x2 = {} \/ + interior y1 INTER interior y2 = {}) /\ + interior(x1 INTER y1) SUBSET interior(x1) /\ + interior(x1 INTER y1) SUBSET interior(y1) /\ + interior(x2 INTER y2) SUBSET interior(x2) /\ + interior(x2 INTER y2) SUBSET interior(y2) + ==> interior(x1 INTER y1) INTER interior(x2 INTER y2) = {}`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]; + REWRITE_TAC[SET_RULE `UNIONS {x | x IN s /\ ~(x = {})} = UNIONS s`] THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS; IN_INTER] THEN + MESON_TAC[IN_INTER]]);; + +let DIVISION_INTER_1 = prove + (`!d i a b:real^N. + d division_of i /\ interval[a,b] SUBSET i + ==> { interval[a,b] INTER k | k | + k IN d /\ ~(interval[a,b] INTER k = {}) } + division_of interval[a,b]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN + ASM_REWRITE_TAC[INTER_EMPTY; SET_RULE `{{} | F} = {}`; + DIVISION_OF_TRIVIAL] THEN + MP_TAC(ISPECL [`interval[a:real^N,b]`; `i:real^N->bool`; + `{interval[a:real^N,b]}`; `d:(real^N->bool)->bool`] + DIVISION_INTER) THEN + ASM_SIMP_TAC[DIVISION_OF_SELF; SET_RULE `s SUBSET t ==> s INTER t = s`] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; + +let ELEMENTARY_INTER = prove + (`!s t. (?p. p division_of s) /\ (?p. p division_of t) + ==> ?p. p division_of (s INTER t)`, + MESON_TAC[DIVISION_INTER]);; + +let ELEMENTARY_INTERS = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ ~(f = {}) /\ + (!s. s IN f ==> ?p. p division_of s) + ==> ?p. p division_of (INTERS f)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[INTERS_INSERT] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `s:(real^N->bool)->bool`] THEN + ASM_CASES_TAC `s:(real^N->bool)->bool = {}` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[INTERS_0; INTER_UNIV; IN_SING] THEN MESON_TAC[]; + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ELEMENTARY_INTER THEN ASM_MESON_TAC[]]);; + +let DIVISION_DISJOINT_UNION = prove + (`!s1 s2:real^N->bool p1 p2. + p1 division_of s1 /\ + p2 division_of s2 /\ + interior s1 INTER interior s2 = {} + ==> (p1 UNION p2) division_of (s1 UNION s2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[division_of] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FINITE_UNION; IN_UNION; EXISTS_OR_THM; SET_RULE + `UNIONS {x | P x \/ Q x} = UNIONS {x | P x} UNION UNIONS {x | Q x}`] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REPEAT STRIP_TAC THENL + [ASM SET_TAC[]; ALL_TAC; ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `!s' t'. s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {} + ==> s INTER t = {}`) + THENL + [MAP_EVERY EXISTS_TAC + [`interior s1:real^N->bool`; `interior s2:real^N->bool`]; + MAP_EVERY EXISTS_TAC + [`interior s2:real^N->bool`; `interior s1:real^N->bool`]] THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC SUBSET_INTERIOR) THEN + ASM SET_TAC[]);; + +let PARTIAL_DIVISION_EXTEND_1 = prove + (`!a b c d:real^N. + interval[c,d] SUBSET interval[a,b] /\ ~(interval[c,d] = {}) + ==> ?p. p division_of interval[a,b] /\ + interval[c,d] IN p`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN + EXISTS_TAC + `{interval + [(lambda i. if i < l then (c:real^N)$i else (a:real^N)$i):real^N, + (lambda i. if i < l then d$i else if i = l then c$l else b$i)] | + l IN 1..(dimindex(:N)+1)} UNION + {interval + [(lambda i. if i < l then c$i else if i = l then d$l else a$i), + (lambda i. if i < l then (d:real^N)$i else (b:real^N)$i):real^N] | + l IN 1..(dimindex(:N)+1)}` THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `dimindex(:N)+1` THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; ARITH_RULE `1 <= n + 1`] THEN + AP_TERM_TAC THEN SIMP_TAC[CONS_11; PAIR_EQ; CART_EQ; LAMBDA_BETA] THEN + SIMP_TAC[ARITH_RULE `i <= n ==> i < n + 1`]; + DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN + ASM_REWRITE_TAC[DIVISION_OF] THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN + SIMP_TAC[FINITE_UNION; FINITE_IMAGE; FINITE_NUMSEG]; + REWRITE_TAC[IN_UNION; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_AND_THM; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[IN_NUMSEG; INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN + CONJ_TAC THEN X_GEN_TAC `l:num` THEN DISCH_TAC THEN + (CONJ_TAC THENL [ALL_TAC; MESON_TAC[]]) THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + REWRITE_TAC[IN_UNION; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[SET_RULE + `(!y. y IN {f x | x IN s} \/ y IN {g x | x IN s} ==> P y) <=> + (!x. x IN s ==> P(f x) /\ P(g x))`] THEN + REWRITE_TAC[AND_FORALL_THM; IN_NUMSEG] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN + REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN + REWRITE_TAC[INTER_ACI; CONJ_ACI] THEN MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`l:num`; `m:num`] THEN + DISCH_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `(~p ==> q) <=> (~q ==> p)`] THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. ~(x IN s /\ x IN t)`] THEN + ASM_SIMP_TAC[IN_NUMSEG; INTERVAL_NE_EMPTY; LAMBDA_BETA; IN_INTERVAL; + INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT CONJ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` (LABEL_TAC "*")) THEN + AP_TERM_TAC THEN SIMP_TAC[CONS_11; PAIR_EQ; CART_EQ; LAMBDA_BETA] THENL + (let tac1 = + UNDISCH_TAC `l:num <= m` THEN GEN_REWRITE_TAC LAND_CONV [LE_LT] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `l:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[LT_REFL] THEN REAL_ARITH_TAC + and tac2 = + UNDISCH_TAC `l:num <= m` THEN GEN_REWRITE_TAC LAND_CONV [LE_LT] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `l:num`) THEN ANTS_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[LT_REFL] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + CONJ_TAC THEN X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num = l` THEN + ASM_REWRITE_TAC[LT_REFL] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `l:num`)) THEN + ASM_REWRITE_TAC[LT_REFL] THEN REAL_ARITH_TAC in + [tac1; tac2; tac2; tac1]); + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[IMP_CONJ; SUBSET; FORALL_IN_UNIONS; SIMPLE_IMAGE] THEN + REWRITE_TAC[IN_UNIONS; IN_INSERT; IN_UNION; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM; FORALL_AND_THM; + TAUT `(a \/ b ==> c) <=> (a ==> c) /\ (b ==> c)`] THEN + ASM_SIMP_TAC[IN_INTERVAL; IN_NUMSEG; LAMBDA_BETA] THEN + REPEAT CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `a IN s ==> (c DIFF a) SUBSET UNIONS s ==> c SUBSET UNIONS s`)) THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_INTERVAL] THEN X_GEN_TAC `x:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[TAUT `a ==> ~(b /\ ~c) <=> a /\ b ==> c`] THEN + DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_UNIONS; SIMPLE_IMAGE; EXISTS_IN_IMAGE; IN_UNION; + EXISTS_OR_THM; RIGHT_OR_DISTRIB] THEN + REWRITE_TAC[OR_EXISTS_THM] THEN EXISTS_TAC `l:num` THEN + ASM_SIMP_TAC[IN_NUMSEG; IN_INTERVAL; LAMBDA_BETA; + ARITH_RULE `x <= n ==> x <= n + 1`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[REAL_NOT_LE] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]);; + +let PARTIAL_DIVISION_EXTEND_INTERVAL = prove + (`!p a b:real^N. + p division_of (UNIONS p) /\ (UNIONS p) SUBSET interval[a,b] + ==> ?q. p SUBSET q /\ q division_of interval[a,b]`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `p:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET] THENL + [MESON_TAC[ELEMENTARY_INTERVAL]; STRIP_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + SUBGOAL_THEN `!k:real^N->bool. k IN p ==> ?q. q division_of interval[a,b] /\ + k IN q` + MP_TAC THENL + [X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPEC `k:real^N->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC PARTIAL_DIVISION_EXTEND_1 THEN ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `q:(real^N->bool)->(real^N->bool)->bool`) THEN + SUBGOAL_THEN + `?d. d division_of INTERS {UNIONS(q i DELETE i) | (i:real^N->bool) IN p}` + MP_TAC THENL + [MATCH_MP_TAC ELEMENTARY_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[IMAGE_EQ_EMPTY; FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `k:real^N->bool` THEN + DISCH_TAC THEN EXISTS_TAC `(q k) DELETE (k:real^N->bool)` THEN + MATCH_MP_TAC DIVISION_OF_SUBSET THEN + EXISTS_TAC `(q:(real^N->bool)->(real^N->bool)->bool) k` THEN + REWRITE_TAC[DELETE_SUBSET] THEN ASM_MESON_TAC[division_of]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `d:(real^N->bool)->bool`) THEN + EXISTS_TAC `(d UNION p):(real^N->bool)->bool` THEN + REWRITE_TAC[SUBSET_UNION] THEN + SUBGOAL_THEN `interval[a:real^N,b] = + INTERS {UNIONS (q i DELETE i) | i IN p} UNION + UNIONS p` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ + (!i. i IN s ==> f i UNION i = t) + ==> t = INTERS (IMAGE f s) UNION (UNIONS s)`) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE + `UNIONS k = s /\ i IN k ==> UNIONS (k DELETE i) UNION i = s`) THEN + ASM_MESON_TAC[division_of]; + ALL_TAC] THEN + MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN + CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE + `!s. u SUBSET s /\ s INTER t = {} ==> u INTER t = {}`) THEN + EXISTS_TAC `interior(UNIONS(q k DELETE (k:real^N->bool)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_INTERIOR THEN + MATCH_MP_TAC(SET_RULE `x IN s ==> INTERS s SUBSET x`) THEN ASM SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + REWRITE_TAC[OPEN_INTERIOR; FINITE_DELETE; IN_DELETE] THEN + ASM_MESON_TAC[division_of]);; + +let ELEMENTARY_BOUNDED = prove + (`!s. (?p. p division_of s) ==> bounded s`, + REWRITE_TAC[division_of] THEN + ASM_MESON_TAC[BOUNDED_UNIONS; BOUNDED_INTERVAL]);; + +let ELEMENTARY_SUBSET_INTERVAL = prove + (`!s. (?p. p division_of s) ==> ?a b. s SUBSET interval[a,b]`, + MESON_TAC[ELEMENTARY_BOUNDED; BOUNDED_SUBSET_CLOSED_INTERVAL]);; + +let DIVISION_UNION_INTERVALS_EXISTS = prove + (`!a b c d:real^N. + ~(interval[a,b] = {}) + ==> ?p. (interval[a,b] INSERT p) division_of + (interval[a,b] UNION interval[c,d])`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[c:real^N,d] = {}` THENL + [ASM_REWRITE_TAC[UNION_EMPTY] THEN ASM_MESON_TAC[DIVISION_OF_SELF]; + ALL_TAC] THEN + ASM_CASES_TAC `interval[a:real^N,b] INTER interval[c,d] = {}` THENL + [EXISTS_TAC `{interval[c:real^N,d]}` THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b} = {a} UNION {b}`] THEN + MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN + ASM_SIMP_TAC[DIVISION_OF_SELF] THEN + MATCH_MP_TAC(SET_RULE + `interior s SUBSET s /\ interior t SUBSET t /\ s INTER t = {} + ==> interior s INTER interior t = {}`) THEN + ASM_REWRITE_TAC[INTERIOR_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN + `?u v:real^N. interval[a,b] INTER interval[c,d] = interval[u,v]` + STRIP_ASSUME_TAC THENL [MESON_TAC[INTER_INTERVAL]; ALL_TAC] THEN + MP_TAC(ISPECL [`c:real^N`; `d:real^N`; `u:real^N`; `v:real^N`] + PARTIAL_DIVISION_EXTEND_1) THEN + ANTS_TAC THENL [ASM_MESON_TAC[INTER_SUBSET]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `p DELETE interval[u:real^N,v]` THEN + SUBGOAL_THEN `interval[a:real^N,b] UNION interval[c,d] = + interval[a,b] UNION UNIONS(p DELETE interval[u,v])` + SUBST1_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o + GEN_REWRITE_RULE I [division_of]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN + MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN + ASM_SIMP_TAC[DIVISION_OF_SELF] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_OF_SUBSET THEN + EXISTS_TAC `p:(real^N->bool)->bool` THEN + ASM_MESON_TAC[DIVISION_OF_UNION_SELF; DELETE_SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[GSYM INTERIOR_INTER] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `interior(interval[u:real^N,v] INTER + UNIONS (p DELETE interval[u,v]))` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `!cd. p SUBSET cd /\ uv = ab INTER cd + ==> (ab INTER p = uv INTER p)`) THEN + EXISTS_TAC `interval[c:real^N,d]` THEN + ASM_REWRITE_TAC[UNIONS_SUBSET; IN_DELETE] THEN + ASM_MESON_TAC[division_of]; + REWRITE_TAC[INTERIOR_INTER] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + REWRITE_TAC[IN_DELETE; OPEN_INTERIOR; FINITE_DELETE] THEN + ASM_MESON_TAC[division_of]]);; + +let DIVISION_OF_UNIONS = prove + (`!f. FINITE f /\ + (!p. p IN f ==> p division_of (UNIONS p)) /\ + (!k1 k2. k1 IN UNIONS f /\ k2 IN UNIONS f /\ ~(k1 = k2) + ==> interior k1 INTER interior k2 = {}) + ==> (UNIONS f) division_of UNIONS(UNIONS f)`, + REWRITE_TAC[division_of] THEN + SIMP_TAC[FINITE_UNIONS] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o el 1 o CONJUNCTS) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN SET_TAC[]);; + +let ELEMENTARY_UNION_INTERVAL_STRONG = prove + (`!p a b:real^N. + p division_of (UNIONS p) + ==> ?q. p SUBSET q /\ q division_of (interval[a,b] UNION UNIONS p)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `p:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[UNIONS_0; UNION_EMPTY; EMPTY_SUBSET] THEN + MESON_TAC[ELEMENTARY_INTERVAL]; + ALL_TAC] THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN + ASM_REWRITE_TAC[UNION_EMPTY] THENL [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + ASM_CASES_TAC `interior(interval[a:real^N,b]) = {}` THENL + [EXISTS_TAC `interval[a:real^N,b] INSERT p` THEN + REWRITE_TAC[division_of] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + SIMP_TAC[FINITE_INSERT; UNIONS_INSERT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `interval[a:real^N,b] SUBSET UNIONS p` THENL + [ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s UNION t = t`] THEN + ASM_MESON_TAC[SUBSET_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k:real^N->bool. k IN p + ==> ?q. ~(k IN q) /\ ~(q = {}) /\ + (k INSERT q) division_of (interval[a,b] UNION k)` + MP_TAC THENL + [X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPEC `k:real^N->bool` o CONJUNCT1 o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + ONCE_REWRITE_TAC[UNION_COMM] THEN + MP_TAC(ISPECL [`c:real^N`; `d:real^N`; `a:real^N`; `b:real^N`] + DIVISION_UNION_INTERVALS_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `q:(real^N->bool)->bool`) THEN + EXISTS_TAC `q DELETE interval[c:real^N,d]` THEN + ASM_REWRITE_TAC[IN_DELETE; SET_RULE + `x INSERT (q DELETE x) = x INSERT q`] THEN + DISCH_TAC THEN + UNDISCH_TAC `(interval[c:real^N,d] INSERT q) division_of + (interval [c,d] UNION interval [a,b])` THEN + ASM_SIMP_TAC[SET_RULE `s DELETE x = {} ==> x INSERT s = {x}`] THEN + REWRITE_TAC[division_of; UNIONS_1] THEN ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `q:(real^N->bool)->(real^N->bool)->bool`) THEN + MP_TAC(ISPEC `IMAGE (UNIONS o (q:(real^N->bool)->(real^N->bool)->bool)) p` + ELEMENTARY_INTERS) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + ANTS_TAC THENL + [X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + EXISTS_TAC `(q:(real^N->bool)->(real^N->bool)->bool) k` THEN + REWRITE_TAC[o_THM] THEN MATCH_MP_TAC DIVISION_OF_SUBSET THEN + EXISTS_TAC `(k:real^N->bool) INSERT q k` THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; SET_TAC[]]; + DISCH_THEN(X_CHOOSE_TAC `r:(real^N->bool)->bool`)] THEN + EXISTS_TAC `p UNION r:(real^N->bool)->bool` THEN SIMP_TAC[SUBSET_UNION] THEN + SUBGOAL_THEN + `interval[a:real^N,b] UNION UNIONS p = + UNIONS p UNION INTERS(IMAGE (UNIONS o q) p)` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_UNION] THEN + ASM_CASES_TAC `(y:real^N) IN UNIONS p` THEN ASM_REWRITE_TAC[IN_INTERS] THEN + REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM] THEN + SUBGOAL_THEN + `!k. k IN p ==> UNIONS(k INSERT q k) = interval[a:real^N,b] UNION k` + MP_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + REWRITE_TAC[UNIONS_INSERT; o_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EXTENSION] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IN_UNION] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + UNDISCH_TAC `~((y:real^N) IN UNIONS p)` THEN + SIMP_TAC[IN_UNIONS; NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + ASM_CASES_TAC `(y:real^N) IN interval[a,b]` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN + CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + ASM_SIMP_TAC[INTERIOR_FINITE_INTERS; FINITE_IMAGE] THEN + MATCH_MP_TAC(SET_RULE `(?x. x IN p /\ f x INTER s = {}) + ==> INTERS (IMAGE f p) INTER s = {}`) THEN + REWRITE_TAC[EXISTS_IN_IMAGE; o_THM] THEN EXISTS_TAC `k:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[division_of; FINITE_INSERT; IN_INSERT]; + ASM_MESON_TAC[division_of; FINITE_INSERT; IN_INSERT]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN + ASM_REWRITE_TAC[division_of; IN_INSERT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +let ELEMENTARY_UNION_INTERVAL = prove + (`!p a b:real^N. + p division_of (UNIONS p) + ==> ?q. q division_of (interval[a,b] UNION UNIONS p)`, + MESON_TAC[ELEMENTARY_UNION_INTERVAL_STRONG]);; + +let ELEMENTARY_UNIONS_INTERVALS = prove + (`!f. FINITE f /\ + (!s. s IN f ==> ?a b:real^N. s = interval[a,b]) + ==> (?p. p division_of (UNIONS f))`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; ELEMENTARY_EMPTY] THEN + REWRITE_TAC[IN_INSERT; TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `p:(real^N->bool)->bool`) THEN + SUBGOAL_THEN `UNIONS f:real^N->bool = UNIONS p` SUBST1_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + MATCH_MP_TAC ELEMENTARY_UNION_INTERVAL THEN ASM_MESON_TAC[division_of]);; + +let ELEMENTARY_UNION = prove + (`!s t:real^N->bool. + (?p. p division_of s) /\ (?p. p division_of t) + ==> (?p. p division_of (s UNION t))`, + REPEAT GEN_TAC THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_TAC `p1:(real^N->bool)->bool`) + (X_CHOOSE_TAC `p2:(real^N->bool)->bool`)) THEN + SUBGOAL_THEN `s UNION t :real^N->bool = UNIONS p1 UNION UNIONS p2` + SUBST1_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `UNIONS p1 UNION UNIONS p2 = UNIONS(p1 UNION p2)`] THEN + MATCH_MP_TAC ELEMENTARY_UNIONS_INTERVALS THEN + REWRITE_TAC[IN_UNION; FINITE_UNION] THEN + ASM_MESON_TAC[division_of]);; + +let PARTIAL_DIVISION_EXTEND = prove + (`!p q s t:real^N->bool. + p division_of s /\ q division_of t /\ s SUBSET t + ==> ?r. p SUBSET r /\ r division_of t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?a b:real^N. t SUBSET interval[a,b]` MP_TAC THENL + [ASM_MESON_TAC[ELEMENTARY_SUBSET_INTERVAL]; ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + SUBGOAL_THEN `?r1. p SUBSET r1 /\ r1 division_of interval[a:real^N,b]` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC PARTIAL_DIVISION_EXTEND_INTERVAL THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `?r2:(real^N->bool)->bool. + r2 division_of (UNIONS(r1 DIFF p)) INTER (UNIONS q)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ELEMENTARY_INTER THEN + ASM_MESON_TAC[FINITE_DIFF; IN_DIFF; division_of; + ELEMENTARY_UNIONS_INTERVALS]; + ALL_TAC] THEN + EXISTS_TAC `p UNION r2:(real^N->bool)->bool` THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `t:real^N->bool = UNIONS p UNION (UNIONS(r1 DIFF p) INTER UNIONS q)` + SUBST1_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o last o CONJUNCTS o + GEN_REWRITE_RULE I [division_of])) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]; + MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!t'. t SUBSET t' /\ s INTER t' = {} ==> s INTER t = {}`) THEN + EXISTS_TAC `interior(UNIONS(r1 DIFF p)):real^N->bool` THEN + CONJ_TAC THENL [MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + REWRITE_TAC[OPEN_INTERIOR] THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[IN_DIFF; FINITE_DIFF; division_of]; ALL_TAC]) THEN + REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[INTER_COMM]) THEN + ASM_MESON_TAC[division_of; SUBSET]]);; + +let INTERVAL_SUBDIVISION = prove + (`!a b c:real^N. + c IN interval[a,b] + ==> IMAGE (\s. interval[(lambda i. if i IN s then c$i else a$i), + (lambda i. if i IN s then b$i else c$i)]) + {s | s SUBSET 1..dimindex(:N)} + division_of interval[a,b]`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTERVAL]) THEN + REWRITE_TAC[DIVISION_OF] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET; FINITE_NUMSEG] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_INTERVAL; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + X_GEN_TAC `s:num->bool` THEN DISCH_TAC THEN + X_GEN_TAC `s':num->bool` THEN DISCH_TAC THEN + REWRITE_TAC[SET_RULE + `(~p ==> s INTER t = {}) <=> (!x. x IN s /\ x IN t ==> p)`] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + SIMP_TAC[LAMBDA_BETA] THEN + ASM_CASES_TAC `s':num->bool = s` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s' = s) ==> ?x. x IN s' /\ ~(x IN s) \/ x IN s /\ ~(x IN s')`)) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN + (ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; IN_NUMSEG]; REAL_ARITH_TAC]); + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + GEN_REWRITE_TAC I [SUBSET] THENL + [REWRITE_TAC[FORALL_IN_UNIONS] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; GSYM SUBSET] THEN + SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN EXISTS_TAC + `{i | i IN 1..dimindex(:N) /\ (c:real^N)$i <= (x:real^N)$i}` THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN + SIMP_TAC[LAMBDA_BETA; IN_ELIM_THM; IN_NUMSEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN + ASM_MESON_TAC[REAL_LE_TOTAL]]]);; + +let DIVISION_OF_NONTRIVIAL = prove + (`!s a b:real^N. + s division_of interval[a,b] /\ ~(content(interval[a,b]) = &0) + ==> {k | k IN s /\ ~(content k = &0)} division_of interval[a,b]`, + REPEAT GEN_TAC THEN WF_INDUCT_TAC `CARD(s:(real^N->bool)->bool)` THEN + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `{k:real^N->bool | k IN s /\ ~(content k = &0)} = s` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EXTENSION]) THEN + REWRITE_TAC[IN_ELIM_THM; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ ~b <=> a) <=> a /\ b`] THEN + X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (k:real^N->bool)`) THEN + ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM SET_TAC[]] THEN + REWRITE_TAC[DIVISION_OF] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [division_of]) THEN + ASM_SIMP_TAC[FINITE_DELETE; IN_DELETE] THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(k:real^N->bool) IN s`)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `d:real^N`] THEN + DISCH_THEN SUBST_ALL_TAC THEN + MATCH_MP_TAC(SET_RULE + `UNIONS s = i /\ k SUBSET UNIONS(s DELETE k) + ==> UNIONS(s DELETE k) = i`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[CLOSED_LIMPT; SUBSET] + `closed s /\ (!x. x IN k ==> x limit_point_of s) ==> k SUBSET s`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_UNIONS THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN + ASM_MESON_TAC[CLOSED_INTERVAL]; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN + SUBGOAL_THEN `?y:real^N. y IN UNIONS s /\ ~(y IN interval[c,d]) /\ + ~(y = x) /\ norm(y - x) < e` + MP_TAC THENL [ALL_TAC; SET_TAC[]] THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC + [`~(content(interval[a:real^N,b]) = &0)`; + `content(interval[c:real^N,d]) = &0`] THEN + REWRITE_TAC[CONTENT_EQ_0; NOT_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_TAC THEN UNDISCH_TAC `~(interval[c:real^N,d] = {})` THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[REAL_NOT_LT] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN + DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th) THEN + UNDISCH_TAC `interval[c:real^N,d] SUBSET interval[a,b]` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ASSUME `(x:real^N) IN interval[c,d]`) THEN + GEN_REWRITE_TAC LAND_CONV [IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_ARITH `d = c ==> (c <= x /\ x <= d <=> x = c)`] THEN + DISCH_TAC THEN + MP_TAC(ASSUME `(x:real^N) IN interval[a,b]`) THEN + GEN_REWRITE_TAC LAND_CONV [IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN EXISTS_TAC + `(lambda j. if j = i then + if (c:real^N)$i <= ((a:real^N)$i + (b:real^N)$i) / &2 + then c$i + min e (b$i - c$i) / &2 + else c$i - min e (c$i - a$i) / &2 + else (x:real^N)$j):real^N` THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN STRIP_TAC THEN + UNDISCH_TAC `(x:real^N) IN interval[a,b]` THEN + REWRITE_TAC[IN_INTERVAL] THEN DISCH_THEN(MP_TAC o SPEC `j:num`) THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[vector_norm; dot] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; GSYM REAL_POW_2] THEN + REWRITE_TAC[REAL_ARITH + `((if p then x else y) - y) pow 2 = if p then (x - y) pow 2 else &0`] THEN + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; POW_2_SQRT_ABS] THEN + ASM_REAL_ARITH_TAC]);; + +let DIVISION_OF_AFFINITY = prove + (`!d s:real^N->bool m c. + IMAGE (IMAGE (\x. m % x + c)) d division_of (IMAGE (\x. m % x + c) s) <=> + if m = &0 then if s = {} then d = {} + else ~(d = {}) /\ !k. k IN d ==> ~(k = {}) + else d division_of s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; DIVISION_OF_TRIVIAL; IMAGE_EQ_EMPTY] THEN + ASM_CASES_TAC `d:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; EMPTY_DIVISION_OF; UNIONS_0; + IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> IMAGE (\x. c) s = {c}`] THEN + ASM_CASES_TAC `!k:real^N->bool. k IN d ==> ~(k = {})` THEN + ASM_REWRITE_TAC[division_of] THENL + [ALL_TAC; + REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[IMAGE_EQ_EMPTY]] THEN + SUBGOAL_THEN + `IMAGE (IMAGE ((\x. c):real^N->real^N)) d = {{c}}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_IMAGE; IN_SING] THEN ASM SET_TAC[]; + SIMP_TAC[UNIONS_1; FINITE_SING; IN_SING; IMP_CONJ] THEN + REWRITE_TAC[SUBSET_REFL; NOT_INSERT_EMPTY] THEN + MESON_TAC[INTERVAL_SING]]; + REWRITE_TAC[division_of] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; GSYM INTERIOR_INTER] THEN + ASM_SIMP_TAC[FINITE_IMAGE_INJ_EQ; GSYM IMAGE_UNIONS; + VECTOR_ARITH `x + a:real^N = y + a <=> x = y`; + VECTOR_MUL_LCANCEL; + SET_RULE `(!x y. f x = f y <=> x = y) + ==> (IMAGE f s SUBSET IMAGE f t <=> s SUBSET t) /\ + (IMAGE f s = IMAGE f t <=> s = t) /\ + (IMAGE f s INTER IMAGE f t = IMAGE f (s INTER t))`] THEN + AP_TERM_TAC THEN BINOP_TAC THENL + [AP_TERM_TAC THEN ABS_TAC THEN REPLICATE_TAC 3 AP_TERM_TAC THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[IMAGE_AFFINITY_INTERVAL] THENL [ALL_TAC; MESON_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM + `IMAGE (\x:real^N. inv m % x + --(inv m % c))`) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; AFFINITY_INVERSES] THEN + ASM_REWRITE_TAC[IMAGE_I; IMAGE_AFFINITY_INTERVAL] THEN MESON_TAC[]; + SUBGOAL_THEN `(\x:real^N. m % x + c) = (\x. c + x) o (\x. m % x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[IMAGE_o; INTERIOR_TRANSLATION] THEN + ASM_SIMP_TAC[INTERIOR_INJECTIVE_LINEAR_IMAGE; LINEAR_SCALING; + VECTOR_MUL_LCANCEL; IMAGE_EQ_EMPTY]]]]);; + +let DIVISION_OF_TRANSLATION = prove + (`!d s:real^N->bool. + IMAGE (IMAGE (\x. a + x)) d division_of (IMAGE (\x. a + x) s) <=> + d division_of s`, + ONCE_REWRITE_TAC[VECTOR_ARITH `a + x:real^N = &1 % x + a`] THEN + REWRITE_TAC[DIVISION_OF_AFFINITY] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let DIVISION_OF_REFLECT = prove + (`!d s:real^N->bool. + IMAGE (IMAGE (--)) d division_of IMAGE (--) s <=> + d division_of s`, + REPEAT GEN_TAC THEN SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x + vec 0` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[DIVISION_OF_AFFINITY] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; + +let ELEMENTARY_COMPACT = prove + (`!s. (?d. d division_of s) ==> compact s`, + REWRITE_TAC[division_of] THEN + MESON_TAC[COMPACT_UNIONS; COMPACT_INTERVAL]);; + +let OPEN_COUNTABLE_LIMIT_ELEMENTARY = prove + (`!s:real^N->bool. + open s + ==> ?f. (!n. ?d. d division_of f n) /\ + (!n. f n SUBSET f(SUC n)) /\ + UNIONS {f n | n IN (:num)} = s`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `(\n. {}):num->real^N->bool` THEN + REWRITE_TAC[ELEMENTARY_EMPTY; EMPTY_SUBSET; UNIONS_GSPEC] THEN + ASM SET_TAC[]; + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` MP_TAC) THEN + ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN + MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:num->real^N->bool` THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN STRIP_TAC THEN + EXISTS_TAC `\n. UNIONS {(f:num->real^N->bool) m | m <= n}` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ELEMENTARY_UNIONS_INTERVALS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE] THEN ASM SET_TAC[]; + GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[UNIONS_GSPEC; UNIONS_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; EXTENSION] THEN + MESON_TAC[LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Tagged (partial) divisions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("tagged_partial_division_of",(12,"right"));; +parse_as_infix("tagged_division_of",(12,"right"));; + +let tagged_partial_division_of = new_definition + `s tagged_partial_division_of i <=> + FINITE s /\ + (!x k. (x,k) IN s + ==> x IN k /\ k SUBSET i /\ ?a b. k = interval[a,b]) /\ + (!x1 k1 x2 k2. (x1,k1) IN s /\ (x2,k2) IN s /\ ~((x1,k1) = (x2,k2)) + ==> (interior(k1) INTER interior(k2) = {}))`;; + +let tagged_division_of = new_definition + `s tagged_division_of i <=> + s tagged_partial_division_of i /\ (UNIONS {k | ?x. (x,k) IN s} = i)`;; + +let TAGGED_DIVISION_OF_FINITE = prove + (`!s i. s tagged_division_of i ==> FINITE s`, + SIMP_TAC[tagged_division_of; tagged_partial_division_of]);; + +let TAGGED_DIVISION_OF = prove + (`s tagged_division_of i <=> + FINITE s /\ + (!x k. (x,k) IN s + ==> x IN k /\ k SUBSET i /\ ?a b. k = interval[a,b]) /\ + (!x1 k1 x2 k2. (x1,k1) IN s /\ (x2,k2) IN s /\ ~((x1,k1) = (x2,k2)) + ==> (interior(k1) INTER interior(k2) = {})) /\ + (UNIONS {k | ?x. (x,k) IN s} = i)`, + REWRITE_TAC[tagged_division_of; tagged_partial_division_of; CONJ_ASSOC]);; + +let DIVISION_OF_TAGGED_DIVISION = prove + (`!s i. s tagged_division_of i ==> (IMAGE SND s) division_of i`, + REWRITE_TAC[TAGGED_DIVISION_OF; division_of] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; FORALL_PAIR_THM; PAIR_EQ] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIONS] THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM] THEN MESON_TAC[]]);; + +let PARTIAL_DIVISION_OF_TAGGED_DIVISION = prove + (`!s i. s tagged_partial_division_of i + ==> (IMAGE SND s) division_of UNIONS(IMAGE SND s)`, + REWRITE_TAC[tagged_partial_division_of; division_of] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ; DE_MORGAN_THM] THEN + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN REPEAT DISCH_TAC THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[FINITE_IMAGE]; + ALL_TAC; + ASM_MESON_TAC[]] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN + REWRITE_TAC[SUBSET; IN_UNIONS; IN_IMAGE; EXISTS_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN ASM SET_TAC[]);; + +let TAGGED_PARTIAL_DIVISION_SUBSET = prove + (`!s t i. s tagged_partial_division_of i /\ t SUBSET s + ==> t tagged_partial_division_of i`, + REWRITE_TAC[tagged_partial_division_of] THEN + MESON_TAC[FINITE_SUBSET; SUBSET]);; + +let VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA = prove + (`!d:(real^M->bool)->real^N p i. + p tagged_partial_division_of i /\ + (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 + ==> d(interval[u,v]) = vec 0) + ==> vsum p (\(x,k). d k) = vsum (IMAGE SND p) d`, + REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\(x:real^M,k:real^M->bool). d k:real^N) = d o SND` + SUBST1_TAC THENL [SIMP_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_THM]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:real^M->bool` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k':real^M->bool` THEN + ASM_CASES_TAC `k':real^M->bool = k` THEN + ASM_REWRITE_TAC[PAIR_EQ; INTER_ACI] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[]);; + +let VSUM_OVER_TAGGED_DIVISION_LEMMA = prove + (`!d:(real^M->bool)->real^N p i. + p tagged_division_of i /\ + (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 + ==> d(interval[u,v]) = vec 0) + ==> vsum p (\(x,k). d k) = vsum (IMAGE SND p) d`, + REWRITE_TAC[tagged_division_of] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN + EXISTS_TAC `i:real^M->bool` THEN ASM_REWRITE_TAC[]);; + +let SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA = prove + (`!d:(real^N->bool)->real p i. + p tagged_partial_division_of i /\ + (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 + ==> d(interval[u,v]) = &0) + ==> sum p (\(x,k). d k) = sum (IMAGE SND p) d`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o + REWRITE_RULE[tagged_partial_division_of]) THEN + ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN + ASM_SIMP_TAC[LIFT_SUM; FINITE_IMAGE; o_DEF; LAMBDA_PAIR_THM] THEN + MATCH_MP_TAC VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN + ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let SUM_OVER_TAGGED_DIVISION_LEMMA = prove + (`!d:(real^N->bool)->real p i. + p tagged_division_of i /\ + (!u v. ~(interval[u,v] = {}) /\ content(interval[u,v]) = &0 + ==> d(interval[u,v]) = &0) + ==> sum p (\(x,k). d k) = sum (IMAGE SND p) d`, + REWRITE_TAC[tagged_division_of] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA THEN + EXISTS_TAC `i:real^N->bool` THEN ASM_REWRITE_TAC[]);; + +let TAG_IN_INTERVAL = prove + (`!p i k. p tagged_division_of i /\ (x,k) IN p ==> x IN i`, + REWRITE_TAC[TAGGED_DIVISION_OF] THEN SET_TAC[]);; + +let TAGGED_DIVISION_OF_EMPTY = prove + (`{} tagged_division_of {}`, + REWRITE_TAC[tagged_division_of; tagged_partial_division_of] THEN + REWRITE_TAC[FINITE_RULES; EXTENSION; NOT_IN_EMPTY; IN_UNIONS; IN_ELIM_THM]);; + +let TAGGED_PARTIAL_DIVISION_OF_TRIVIAL = prove + (`!p. p tagged_partial_division_of {} <=> p = {}`, + REWRITE_TAC[tagged_partial_division_of; SUBSET_EMPTY; CONJ_ASSOC] THEN + REWRITE_TAC[SET_RULE `x IN k /\ k = {} <=> F`] THEN + REWRITE_TAC[GSYM FORALL_PAIR_THM; GSYM NOT_EXISTS_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[AC CONJ_ACI `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FINITE_RULES; UNIONS_0; NOT_IN_EMPTY]);; + +let TAGGED_DIVISION_OF_TRIVIAL = prove + (`!p. p tagged_division_of {} <=> p = {}`, + REWRITE_TAC[tagged_division_of; TAGGED_PARTIAL_DIVISION_OF_TRIVIAL] THEN + GEN_TAC THEN MATCH_MP_TAC(TAUT `(a ==> b) ==> (a /\ b <=> a)`) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NOT_IN_EMPTY] THEN SET_TAC[]);; + +let TAGGED_DIVISION_OF_SELF = prove + (`!x a b. x IN interval[a,b] + ==> {(x,interval[a,b])} tagged_division_of interval[a,b]`, + REWRITE_TAC[TAGGED_DIVISION_OF; FINITE_INSERT; FINITE_RULES; IN_SING] THEN + REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[SUBSET_REFL; UNWIND_THM2; SET_RULE `{k | k = a} = {a}`] THEN + REWRITE_TAC[UNIONS_1] THEN ASM_MESON_TAC[]);; + +let TAGGED_DIVISION_UNION = prove + (`!s1 s2:real^N->bool p1 p2. + p1 tagged_division_of s1 /\ + p2 tagged_division_of s2 /\ + interior s1 INTER interior s2 = {} + ==> (p1 UNION p2) tagged_division_of (s1 UNION s2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[TAGGED_DIVISION_OF] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FINITE_UNION; IN_UNION; EXISTS_OR_THM; SET_RULE + `UNIONS {x | P x \/ Q x} = UNIONS {x | P x} UNION UNIONS {x | Q x}`] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC; + ONCE_REWRITE_TAC[INTER_COMM]; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `!s' t'. s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {} + ==> s INTER t = {}`) THEN + MAP_EVERY EXISTS_TAC + [`interior s1:real^N->bool`; `interior s2:real^N->bool`] THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN + ASM_MESON_TAC[]);; + +let TAGGED_DIVISION_UNIONS = prove + (`!iset pfn. FINITE iset /\ + (!i:real^M->bool. i IN iset ==> pfn(i) tagged_division_of i) /\ + (!i1 i2. i1 IN iset /\ i2 IN iset /\ ~(i1 = i2) + ==> (interior(i1) INTER interior(i2) = {})) + ==> UNIONS(IMAGE pfn iset) tagged_division_of (UNIONS iset)`, + let lemma1 = prove + (`(?t. (?x. (t = f x) /\ P x) /\ Q t) <=> ?x. P x /\ Q(f x)`, + MESON_TAC[]) + and lemma2 = prove + (`!s1 t1 s2 t2. s1 SUBSET t1 /\ s2 SUBSET t2 /\ (t1 INTER t2 = {}) + ==> (s1 INTER s2 = {})`, + SET_TAC[]) in + REPEAT GEN_TAC THEN + REWRITE_TAC[ONCE_REWRITE_RULE[EXTENSION] tagged_division_of] THEN + REWRITE_TAC[tagged_partial_division_of; IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS; IN_IMAGE] THEN + SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC; ASM_MESON_TAC[]] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[lemma1] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`i1:real^M->bool`; `i2:real^M->bool`] THEN + ASM_CASES_TAC `i1 = i2:real^M->bool` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN + MAP_EVERY EXISTS_TAC + [`interior(i1:real^M->bool)`; `interior(i2:real^M->bool)`] THEN + ASM_MESON_TAC[SUBSET; SUBSET_INTERIOR]);; + +let TAGGED_PARTIAL_DIVISION_OF_UNION_SELF = prove + (`!p s. p tagged_partial_division_of s + ==> p tagged_division_of (UNIONS(IMAGE SND p))`, + SIMP_TAC[tagged_partial_division_of; TAGGED_DIVISION_OF] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[SUBSET; IN_UNIONS; IN_IMAGE; EXISTS_PAIR_THM] THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN MESON_TAC[]]);; + +let TAGGED_DIVISION_OF_UNION_SELF = prove + (`!p s. p tagged_division_of s + ==> p tagged_division_of (UNIONS(IMAGE SND p))`, + SIMP_TAC[TAGGED_DIVISION_OF] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(c ==> a /\ b) /\ c ==> a /\ b /\ c`) THEN CONJ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN MESON_TAC[]]);; + +let TAGGED_DIVISION_UNION_IMAGE_SND = prove + (`!p s. p tagged_division_of s ==> s = UNIONS(IMAGE SND p)`, + MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF; tagged_division_of]);; + +let TAGGED_DIVISION_OF_ALT = prove + (`!p s. p tagged_division_of s <=> + p tagged_partial_division_of s /\ + (!x. x IN s ==> ?t k. (t,k) IN p /\ x IN k)`, + REWRITE_TAC[tagged_division_of; GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_PAIR_THM; IN_ELIM_THM] THEN + REWRITE_TAC[tagged_partial_division_of; SUBSET] THEN MESON_TAC[]);; + +let TAGGED_DIVISION_OF_ANOTHER = prove + (`!p s s'. + p tagged_partial_division_of s' /\ + (!t k. (t,k) IN p ==> k SUBSET s) /\ + (!x. x IN s ==> ?t k. (t,k) IN p /\ x IN k) + ==> p tagged_division_of s`, + REWRITE_TAC[TAGGED_DIVISION_OF_ALT; tagged_partial_division_of] THEN + SET_TAC[]);; + +let TAGGED_PARTIAL_DIVISION_OF_SUBSET = prove + (`!p s t. p tagged_partial_division_of s /\ s SUBSET t + ==> p tagged_partial_division_of t`, + REWRITE_TAC[tagged_partial_division_of] THEN SET_TAC[]);; + +let TAGGED_DIVISION_OF_NONTRIVIAL = prove + (`!s a b:real^N. + s tagged_division_of interval[a,b] /\ ~(content(interval[a,b]) = &0) + ==> {(x,k) | (x,k) IN s /\ ~(content k = &0)} + tagged_division_of interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[TAGGED_DIVISION_OF_ALT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN + EXISTS_TAC `s:(real^N#(real^N->bool))->bool` THEN + RULE_ASSUM_TAC(REWRITE_RULE[tagged_division_of]) THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN + DISCH_THEN(MP_TAC o + MATCH_MP(REWRITE_RULE[IMP_CONJ] DIVISION_OF_NONTRIVIAL)) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_THM; + GSYM CONJ_ASSOC] THEN + MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Fine-ness of a partition w.r.t. a gauge. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("fine",(12,"right"));; + +let fine = new_definition + `d fine s <=> !x k. (x,k) IN s ==> k SUBSET d(x)`;; + +let FINE_INTER = prove + (`!p d1 d2. (\x. d1(x) INTER d2(x)) fine p <=> d1 fine p /\ d2 fine p`, + let lemma = prove + (`s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u`,SET_TAC[]) in + REWRITE_TAC[fine; IN_INTER; lemma] THEN MESON_TAC[]);; + +let FINE_INTERS = prove + (`!f s p. (\x. INTERS {f d x | d IN s}) fine p <=> + !d. d IN s ==> (f d) fine p`, + REWRITE_TAC[fine; SET_RULE `s SUBSET INTERS u <=> !t. t IN u ==> s SUBSET t`; + IN_ELIM_THM] THEN MESON_TAC[]);; + +let FINE_UNION = prove + (`!d p1 p2. d fine p1 /\ d fine p2 ==> d fine (p1 UNION p2)`, + REWRITE_TAC[fine; IN_UNION] THEN MESON_TAC[]);; + +let FINE_UNIONS = prove + (`!d ps. (!p. p IN ps ==> d fine p) ==> d fine (UNIONS ps)`, + REWRITE_TAC[fine; IN_UNIONS] THEN MESON_TAC[]);; + +let FINE_SUBSET = prove + (`!d p q. p SUBSET q /\ d fine q ==> d fine p`, + REWRITE_TAC[fine; SUBSET] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Gauge integral. Define on compact intervals first, then use a limit. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_integral_compact_interval",(12,"right"));; +parse_as_infix("has_integral",(12,"right"));; +parse_as_infix("integrable_on",(12,"right"));; + +let has_integral_compact_interval = new_definition + `(f has_integral_compact_interval y) i <=> + !e. &0 < e + ==> ?d. gauge d /\ + !p. p tagged_division_of i /\ d fine p + ==> norm(vsum p (\(x,k). content(k) % f(x)) - y) < e`;; + +let has_integral_def = new_definition + `(f has_integral y) i <=> + if ?a b. i = interval[a,b] then (f has_integral_compact_interval y) i + else !e. &0 < e + ==> ?B. &0 < B /\ + !a b. ball(vec 0,B) SUBSET interval[a,b] + ==> ?z. ((\x. if x IN i then f(x) else vec 0) + has_integral_compact_interval z) + (interval[a,b]) /\ + norm(z - y) < e`;; + +let has_integral = prove + (`(f has_integral y) (interval[a,b]) <=> + !e. &0 < e + ==> ?d. gauge d /\ + !p. p tagged_division_of interval[a,b] /\ d fine p + ==> norm(vsum p (\(x,k). content(k) % f(x)) - y) < e`, + REWRITE_TAC[has_integral_def; has_integral_compact_interval] THEN + MESON_TAC[]);; + +let has_integral_alt = prove + (`(f has_integral y) i <=> + if ?a b. i = interval[a,b] then (f has_integral y) i + else !e. &0 < e + ==> ?B. &0 < B /\ + !a b. ball(vec 0,B) SUBSET interval[a,b] + ==> ?z. ((\x. if x IN i then f(x) else vec 0) + has_integral z) (interval[a,b]) /\ + norm(z - y) < e`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [has_integral_def] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [POP_ASSUM(REPEAT_TCL CHOOSE_THEN SUBST1_TAC); ALL_TAC] THEN + REWRITE_TAC[has_integral_compact_interval; has_integral]);; + +let integrable_on = new_definition + `f integrable_on i <=> ?y. (f has_integral y) i`;; + +let integral = new_definition + `integral i f = @y. (f has_integral y) i`;; + +let INTEGRABLE_INTEGRAL = prove + (`!f i. f integrable_on i ==> (f has_integral (integral i f)) i`, + REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on; integral] THEN + CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);; + +let HAS_INTEGRAL_INTEGRABLE = prove + (`!f i s. (f has_integral i) s ==> f integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[]);; + +let HAS_INTEGRAL_INTEGRAL = prove + (`!f s. f integrable_on s <=> (f has_integral (integral s f)) s`, + MESON_TAC[INTEGRABLE_INTEGRAL; HAS_INTEGRAL_INTEGRABLE]);; + +let VSUM_CONTENT_NULL = prove + (`!f:real^M->real^N a b p. + content(interval[a,b]) = &0 /\ + p tagged_division_of interval[a,b] + ==> vsum p (\(x,k). content k % f x) = vec 0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_0 THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`p:real^M`; `k:real^M->bool`] THEN + DISCH_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPECL [`p:real^M`; `k:real^M->bool`]) THEN + ASM_MESON_TAC[CONTENT_SUBSET; CONTENT_POS_LE; REAL_ARITH + `&0 <= x /\ x <= y /\ y = &0 ==> x = &0`]);; + +(* ------------------------------------------------------------------------- *) +(* Some basic combining lemmas. *) +(* ------------------------------------------------------------------------- *) + +let TAGGED_DIVISION_UNIONS_EXISTS = prove + (`!d iset i:real^M->bool. + FINITE iset /\ + (!i. i IN iset ==> ?p. p tagged_division_of i /\ d fine p) /\ + (!i1 i2. i1 IN iset /\ i2 IN iset /\ ~(i1 = i2) + ==> (interior(i1) INTER interior(i2) = {})) /\ + (UNIONS iset = i) + ==> ?p. p tagged_division_of i /\ d fine p`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + EXISTS_TAC `UNIONS (IMAGE(p:(real^M->bool)->((real^M#(real^M->bool))->bool)) + iset)` THEN + ASM_SIMP_TAC[TAGGED_DIVISION_UNIONS] THEN + ASM_MESON_TAC[FINE_UNIONS; IN_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* The set we're concerned with must be closed. *) +(* ------------------------------------------------------------------------- *) + +let DIVISION_OF_CLOSED = prove + (`!s i. s division_of i ==> closed i`, + REWRITE_TAC[division_of] THEN MESON_TAC[CLOSED_UNIONS; CLOSED_INTERVAL]);; + +(* ------------------------------------------------------------------------- *) +(* General bisection principle for intervals; might be useful elsewhere. *) +(* ------------------------------------------------------------------------- *) + +let INTERVAL_BISECTION_STEP = prove + (`!P. P {} /\ + (!s t. P s /\ P t /\ interior(s) INTER interior(t) = {} + ==> P(s UNION t)) + ==> !a b:real^N. + ~(P(interval[a,b])) + ==> ?c d. ~(P(interval[c,d])) /\ + !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i <= c$i /\ c$i <= d$i /\ d$i <= b$i /\ + &2 * (d$i - c$i) <= b$i - a$i`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `!i. 1 <= i /\ i <= dimindex(:N) + ==> (a:real^N)$i <= (b:real^N)$i` THENL + [ALL_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTERVAL_NE_EMPTY]) THEN + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN + `!f. FINITE f /\ + (!s:real^N->bool. s IN f ==> P s) /\ + (!s:real^N->bool. s IN f ==> ?a b. s = interval[a,b]) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) + ==> interior(s) INTER interior(t) = {}) + ==> P(UNIONS f)` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[UNIONS_0; UNIONS_INSERT; NOT_IN_EMPTY; FORALL_IN_INSERT] THEN + REWRITE_TAC[IMP_IMP] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> + FIRST_X_ASSUM MATCH_MP_TAC THEN STRIP_ASSUME_TAC th) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `{ interval[c,d] | + !i. 1 <= i /\ i <= dimindex(:N) + ==> ((c:real^N)$i = (a:real^N)$i) /\ (d$i = (a$i + b$i) / &2) \/ + (c$i = (a$i + b$i) / &2) /\ ((d:real^N)$i = (b:real^N)$i)}`) THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN ANTS_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `IMAGE (\s. closed_interval + [(lambda i. if i IN s then (a:real^N)$i else (a$i + b$i) / &2):real^N, + (lambda i. if i IN s then (a$i + b$i) / &2 else (b:real^N)$i)]) + {s | s SUBSET (1..dimindex(:N))}` THEN + CONJ_TAC THENL + [SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `k:real^N->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` (X_CHOOSE_THEN `d:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC))) THEN + EXISTS_TAC `{i | 1 <= i /\ i <= dimindex(:N) /\ + ((c:real^N)$i = (a:real^N)$i)}` THEN + CONJ_TAC THENL [ALL_TAC; SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]] THEN + AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_ELIM_THM] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN `i:num` o SPEC `i:num`)) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN ANTS_TAC THENL + [UNDISCH_TAC `~P(interval[a:real^N,b])` THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [SWAP_EXISTS_THM] THEN + REWRITE_TAC[UNWIND_THM2; IN_INTERVAL] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> ((a ==> b) <=> (a ==> c))`) THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `(a \/ b) /\ c <=> ~(a ==> ~c) \/ ~(b ==> ~c)`] THEN + SIMP_TAC[] THEN + REWRITE_TAC[TAUT `~(a ==> ~b) <=> a /\ b`; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[EXISTS_OR_THM; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MATCH_MP_TAC(TAUT `b /\ (~a ==> e) /\ c ==> ~(a /\ b /\ c) ==> e`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> REPEAT DISCH_TAC THEN MP_TAC th) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IMP_IMP; INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC + [`c1:real^N`; `d1:real^N`; `c2:real^N`; `d2:real^N`] THEN + ASM_CASES_TAC `(c1 = c2:real^N) /\ (d1 = d2:real^N)` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (K ALL_TAC)) THEN MP_TAC th) THEN + REWRITE_TAC[IMP_IMP] THEN + UNDISCH_TAC `~((c1 = c2:real^N) /\ (d1 = d2:real^N))` THEN + REWRITE_TAC[CART_EQ; INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (fun th -> + DISCH_THEN(MP_TAC o SPEC `j:num`) THEN MP_TAC th)) THEN + REWRITE_TAC[NOT_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY; IN_INTER] THEN + SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_EQ_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[ + REAL_ARITH `~((a * &2 = a + b) /\ (a + b = b * &2)) <=> ~(a = b)`; + REAL_ARITH `~((a + b = a * &2) /\ (b * &2 = a + b)) <=> ~(a = b)`] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN MP_TAC th) THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> (a ==> b /\ c)`] THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let INTERVAL_BISECTION = prove + (`!P. P {} /\ + (!s t. P s /\ P t /\ interior(s) INTER interior(t) = {} + ==> P(s UNION t)) + ==> !a b:real^N. + ~(P(interval[a,b])) + ==> ?x. x IN interval[a,b] /\ + !e. &0 < e + ==> ?c d. x IN interval[c,d] /\ + interval[c,d] SUBSET ball(x,e) /\ + interval[c,d] SUBSET interval[a,b] /\ + ~P(interval[c,d])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?A B. (A(0) = a:real^N) /\ (B(0) = b) /\ + !n. ~(P(interval[A(SUC n),B(SUC n)])) /\ + !i. 1 <= i /\ i <= dimindex(:N) + ==> A(n)$i <= A(SUC n)$i /\ + A(SUC n)$i <= B(SUC n)$i /\ + B(SUC n)$i <= B(n)$i /\ + &2 * (B(SUC n)$i - A(SUC n)$i) <= B(n)$i - A(n)$i` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `P:(real^N->bool)->bool` INTERVAL_BISECTION_STEP) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real^N->real^N->real^N` + (X_CHOOSE_THEN `D:real^N->real^N->real^N` ASSUME_TAC)) THEN + MP_TAC(prove_recursive_functions_exist num_RECURSION + `(E 0 = a:real^N,b:real^N) /\ + (!n. E(SUC n) = C (FST(E n)) (SND(E n)), + D (FST(E n)) (SND(E n)))`) THEN + DISCH_THEN(X_CHOOSE_THEN `E:num->real^N#real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n. FST((E:num->real^N#real^N) n)` THEN + EXISTS_TAC `\n. SND((E:num->real^N#real^N) n)` THEN + ASM_REWRITE_TAC[] THEN INDUCT_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!e. &0 < e + ==> ?n:num. !x y. x IN interval[A(n),B(n)] /\ y IN interval[A(n),B(n)] + ==> dist(x,y:real^N) < e` + ASSUME_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(SPEC + `sum(1..dimindex(:N)) (\i. (b:real^N)$i - (a:real^N)$i) / e` + REAL_ARCH_POW2) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N))(\i. abs((x - y:real^N)$i))` THEN + REWRITE_TAC[dist; NORM_LE_L1] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) + (\i. (B:num->real^N)(n)$i - (A:num->real^N)(n)$i)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= x /\ x <= b /\ a <= y /\ y <= b + ==> abs(x - y) <= b - a`) THEN + UNDISCH_TAC `x IN interval[(A:num->real^N) n,B n]` THEN + UNDISCH_TAC `y IN interval[(A:num->real^N) n,B n]` THEN + REWRITE_TAC[IN_INTERVAL] THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `sum(1..dimindex(:N)) (\i. (b:real^N)$i - (a:real^N)$i) / + &2 pow n` THEN + CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + SPEC_TAC(`n:num`,`m:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; REAL_DIV_1; REAL_LE_REFL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_MUL_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN `?a:real^N. !n:num. a IN interval[A(n),B(n)]` MP_TAC THENL + [MATCH_MP_TAC DECREASING_CLOSED_NEST THEN + ASM_REWRITE_TAC[CLOSED_INTERVAL] THEN CONJ_TAC THENL + [REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN + ASM_MESON_TAC[REAL_NOT_LT; REAL_LE_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[LE_EXISTS] THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[GSYM LEFT_IMP_EXISTS_THM; EXISTS_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUBSET_REFL] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `interval[A(m + d:num):real^N,B(m + d)]` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x0:real^N` THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + MAP_EVERY EXISTS_TAC [`(A:num->real^N) n`; `(B:num->real^N) n`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]; + ALL_TAC; + SPEC_TAC(`n:num`,`p:num`) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN + `!m n. m <= n ==> interval[(A:num->real^N) n,B n] SUBSET interval[A m,B m]` + (fun th -> ASM_MESON_TAC[SUBSET; LE_0; th]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cousin's lemma. *) +(* ------------------------------------------------------------------------- *) + +let FINE_DIVISION_EXISTS = prove + (`!g a b:real^M. + gauge g ==> ?p. p tagged_division_of (interval[a,b]) /\ g fine p`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\s:real^M->bool. ?p. p tagged_division_of s /\ g fine p` + INTERVAL_BISECTION) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [MESON_TAC[TAGGED_DIVISION_UNION; FINE_UNION; + TAGGED_DIVISION_OF_EMPTY; fine; NOT_IN_EMPTY]; + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`])] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^M` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o REWRITE_RULE[gauge]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL; NOT_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{(x:real^M,interval[c:real^M,d])}`) THEN + ASM_SIMP_TAC[TAGGED_DIVISION_OF_SELF] THEN + REWRITE_TAC[fine; IN_SING; PAIR_EQ] THEN ASM_MESON_TAC[SUBSET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Basic theorems about integrals. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_UNIQUE = prove + (`!f:real^M->real^N i k1 k2. + (f has_integral k1) i /\ (f has_integral k2) i ==> k1 = k2`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `!f:real^M->real^N a b k1 k2. + (f has_integral k1) (interval[a,b]) /\ + (f has_integral k2) (interval[a,b]) + ==> k1 = k2` + MP_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM NORM_POS_LT] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `norm(k1 - k2 :real^N) / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC)) THEN + MP_TAC(ISPEC `\x. ((d1:real^M->real^M->bool) x) INTER (d2 x)` + FINE_DIVISION_EXISTS) THEN + ASM_SIMP_TAC[GAUGE_INTER] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_forall o concl))) THEN + REWRITE_TAC[] THEN REWRITE_TAC[IMP_IMP; NOT_EXISTS_THM] THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN + MATCH_MP_TAC(TAUT + `(f0 ==> f1 /\ f2) /\ ~(n1 /\ n2) + ==> (t /\ f1 ==> n1) /\ (t /\ f2 ==> n2) ==> ~(t /\ f0)`) THEN + CONJ_TAC THENL [SIMP_TAC[fine; SUBSET_INTER]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `c <= a + b ==> ~(a < c / &2 /\ b < c / &2)`) THEN + MESON_TAC[NORM_SUB; NORM_TRIANGLE; VECTOR_ARITH + `k1 - k2:real^N = (k1 - x) + (x - k2)`]; + ALL_TAC] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH + `~(&0 < norm(x - y)) ==> x = y`) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `norm(k1 - k2:real^N) / &2`)) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC + `ball(vec 0,B1) UNION ball(vec 0:real^M,B2)` + BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[BOUNDED_UNION; BOUNDED_BALL; UNION_SUBSET; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `w:real^N = z:real^N` SUBST_ALL_TAC THEN + ASM_MESON_TAC[NORM_ARITH + `~(norm(z - k1) < norm(k1 - k2) / &2 /\ + norm(z - k2) < norm(k1 - k2) / &2)`]);; + +let INTEGRAL_UNIQUE = prove + (`!f y k. + (f has_integral y) k ==> integral k f = y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE]);; + +let HAS_INTEGRAL_INTEGRABLE_INTEGRAL = prove + (`!f:real^M->real^N i s. + (f has_integral i) s <=> f integrable_on s /\ integral s f = i`, + MESON_TAC[INTEGRABLE_INTEGRAL; INTEGRAL_UNIQUE; integrable_on]);; + +let INTEGRAL_EQ_HAS_INTEGRAL = prove + (`!s f y. f integrable_on s ==> (integral s f = y <=> (f has_integral y) s)`, + MESON_TAC[INTEGRABLE_INTEGRAL; INTEGRAL_UNIQUE]);; + +let HAS_INTEGRAL_IS_0 = prove + (`!f:real^M->real^N s. + (!x. x IN s ==> (f(x) = vec 0)) ==> (f has_integral vec 0) s`, + SUBGOAL_THEN + `!f:real^M->real^N a b. + (!x. x IN interval[a,b] ==> (f(x) = vec 0)) + ==> (f has_integral vec 0) (interval[a,b])` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[has_integral] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN + SIMP_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + UNDISCH_TAC `&0 < e` THEN MATCH_MP_TAC(TAUT `(a <=> b) ==> b ==> a`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ; VECTOR_ADD_LID] THEN + MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(x:real^M) IN interval[a,b]` + (fun th -> ASM_SIMP_TAC[th; VECTOR_MUL_RZERO]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_division_of]) THEN + REWRITE_TAC[tagged_partial_division_of; SUBSET] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `vec 0:real^N` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +let HAS_INTEGRAL_0 = prove + (`!s. ((\x. vec 0) has_integral vec 0) s`, + SIMP_TAC[HAS_INTEGRAL_IS_0]);; + +let HAS_INTEGRAL_0_EQ = prove + (`!i s. ((\x. vec 0) has_integral i) s <=> i = vec 0`, + MESON_TAC[HAS_INTEGRAL_UNIQUE; HAS_INTEGRAL_0]);; + +let HAS_INTEGRAL_LINEAR = prove + (`!f:real^M->real^N y s h:real^N->real^P. + (f has_integral y) s /\ linear h ==> ((h o f) has_integral h(y)) s`, + SUBGOAL_THEN + `!f:real^M->real^N y a b h:real^N->real^P. + (f has_integral y) (interval[a,b]) /\ linear h + ==> ((h o f) has_integral h(y)) (interval[a,b])` + MP_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real / B`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN + FIRST_ASSUM(fun th -> W(fun (asl,w) -> + MP_TAC(PART_MATCH rand th (rand w)))) THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y <= e ==> x <= e`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[LINEAR_SUB; LINEAR_VSUM; o_DEF; LAMBDA_PAIR_THM; + LINEAR_CMUL; REAL_LE_REFL]; + ALL_TAC] THEN + DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_REWRITE_TAC[has_integral_alt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP + LINEAR_BOUNDED_POS) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(h:real^N->real^P) z` THEN + SUBGOAL_THEN + `(\x. if x IN s then ((h:real^N->real^P) o (f:real^M->real^N)) x else vec 0) + = h o (\x. if x IN s then f x else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[LINEAR_0]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `B * norm(z - y:real^N)` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; + +let HAS_INTEGRAL_CMUL = prove + (`!(f:real^M->real^N) k s c. + (f has_integral k) s + ==> ((\x. c % f(x)) has_integral (c % k)) s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[o_DEF] HAS_INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let HAS_INTEGRAL_NEG = prove + (`!f k s. (f has_integral k) s ==> ((\x. --(f x)) has_integral (--k)) s`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN REWRITE_TAC[HAS_INTEGRAL_CMUL]);; + +let HAS_INTEGRAL_ADD = prove + (`!f:real^M->real^N g s. + (f has_integral k) s /\ (g has_integral l) s + ==> ((\x. f(x) + g(x)) has_integral (k + l)) s`, + SUBGOAL_THEN + `!f:real^M->real^N g k l a b. + (f has_integral k) (interval[a,b]) /\ + (g has_integral l) (interval[a,b]) + ==> ((\x. f(x) + g(x)) has_integral (k + l)) (interval[a,b])` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[has_integral; AND_FORALL_THM] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\x. ((d1:real^M->real^M->bool) x) INTER (d2 x)` THEN + ASM_SIMP_TAC[GAUGE_INTER] THEN + REWRITE_TAC[tagged_division_of; tagged_partial_division_of] THEN + SIMP_TAC[VSUM_ADD; VECTOR_ADD_LDISTRIB; LAMBDA_PAIR] THEN + REWRITE_TAC[GSYM LAMBDA_PAIR] THEN + REWRITE_TAC[GSYM tagged_partial_division_of] THEN + REWRITE_TAC[GSYM tagged_division_of; FINE_INTER] THEN + SIMP_TAC[VECTOR_ARITH `(a + b) - (c + d) = (a - c) + (b - d):real^N`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_TRIANGLE_LT THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `max B1 B2:real` THEN ASM_REWRITE_TAC[REAL_LT_MAX] THEN + REWRITE_TAC[BALL_MAX_UNION; UNION_SUBSET] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `w + z:real^N` THEN + SUBGOAL_THEN + `(\x. if x IN s then (f:real^M->real^N) x + g x else vec 0) = + (\x. (if x IN s then f x else vec 0) + (if x IN s then g x else vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN + NORM_ARITH_TAC);; + +let HAS_INTEGRAL_SUB = prove + (`!f:real^M->real^N g s. + (f has_integral k) s /\ (g has_integral l) s + ==> ((\x. f(x) - g(x)) has_integral (k - l)) s`, + SIMP_TAC[VECTOR_SUB; HAS_INTEGRAL_NEG; HAS_INTEGRAL_ADD]);; + +let INTEGRAL_0 = prove + (`!s. integral s (\x. vec 0) = vec 0`, + MESON_TAC[INTEGRAL_UNIQUE; HAS_INTEGRAL_0]);; + +let INTEGRAL_ADD = prove + (`!f:real^M->real^N g k l s. + f integrable_on s /\ g integrable_on s + ==> integral s (\x. f x + g x) = integral s f + integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; + +let INTEGRAL_CMUL = prove + (`!f:real^M->real^N c s. + f integrable_on s ==> integral s (\x. c % f(x)) = c % integral s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; + +let INTEGRAL_NEG = prove + (`!f:real^M->real^N s. + f integrable_on s ==> integral s (\x. --f(x)) = --integral s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_NEG THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; + +let INTEGRAL_SUB = prove + (`!f:real^M->real^N g k l s. + f integrable_on s /\ g integrable_on s + ==> integral s (\x. f x - g x) = integral s f - integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_SUB THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; + +let INTEGRABLE_0 = prove + (`!s. (\x. vec 0) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_0]);; + +let INTEGRABLE_ADD = prove + (`!f:real^M->real^N g s. + f integrable_on s /\ g integrable_on s + ==> (\x. f x + g x) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_ADD]);; + +let INTEGRABLE_CMUL = prove + (`!f:real^M->real^N c s. + f integrable_on s ==> (\x. c % f(x)) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_CMUL]);; + +let INTEGRABLE_CMUL_EQ = prove + (`!f:real^M->real^N s c. + (\x. c % f x) integrable_on s <=> c = &0 \/ f integrable_on s`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[INTEGRABLE_CMUL; VECTOR_MUL_LZERO; INTEGRABLE_0] THEN + ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv c:real` o MATCH_MP INTEGRABLE_CMUL) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_LID; REAL_MUL_LINV; ETA_AX]);; + +let INTEGRABLE_NEG = prove + (`!f:real^M->real^N s. + f integrable_on s ==> (\x. --f(x)) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NEG]);; + +let INTEGRABLE_SUB = prove + (`!f:real^M->real^N g s. + f integrable_on s /\ g integrable_on s + ==> (\x. f x - g x) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_SUB]);; + +let INTEGRABLE_LINEAR = prove + (`!f h s. f integrable_on s /\ linear h ==> (h o f) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_LINEAR]);; + +let INTEGRAL_LINEAR = prove + (`!f:real^M->real^N s h:real^N->real^P. + f integrable_on s /\ linear h + ==> integral s (h o f) = h(integral s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNIQUE THEN + MAP_EVERY EXISTS_TAC + [`(h:real^N->real^P) o (f:real^M->real^N)`; `s:real^M->bool`] THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_INTEGRAL_LINEAR] THEN + ASM_SIMP_TAC[GSYM HAS_INTEGRAL_INTEGRAL; INTEGRABLE_LINEAR]);; + +let HAS_INTEGRAL_VSUM = prove + (`!f:A->real^M->real^N s t. + FINITE t /\ + (!a. a IN t ==> ((f a) has_integral (i a)) s) + ==> ((\x. vsum t (\a. f a x)) has_integral (vsum t i)) s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; HAS_INTEGRAL_0; IN_INSERT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_ADD THEN + ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; + +let INTEGRAL_VSUM = prove + (`!f:A->real^M->real^N s t. + FINITE t /\ + (!a. a IN t ==> (f a) integrable_on s) + ==> integral s (\x. vsum t (\a. f a x)) = + vsum t (\a. integral s (f a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]);; + +let INTEGRABLE_VSUM = prove + (`!f:A->real^M->real^N s t. + FINITE t /\ + (!a. a IN t ==> (f a) integrable_on s) + ==> (\x. vsum t (\a. f a x)) integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_VSUM]);; + +let HAS_INTEGRAL_EQ = prove + (`!f:real^M->real^N g k s. + (!x. x IN s ==> (f(x) = g(x))) /\ + (f has_integral k) s + ==> (g has_integral k) s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP HAS_INTEGRAL_IS_0) MP_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN + SIMP_TAC[VECTOR_ARITH `x - (x - y:real^N) = y`; ETA_AX; VECTOR_SUB_RZERO]);; + +let INTEGRABLE_EQ = prove + (`!f:real^M->real^N g s. + (!x. x IN s ==> (f(x) = g(x))) /\ + f integrable_on s + ==> g integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_EQ]);; + +let HAS_INTEGRAL_EQ_EQ = prove + (`!f:real^M->real^N g k s. + (!x. x IN s ==> (f(x) = g(x))) + ==> ((f has_integral k) s <=> (g has_integral k) s)`, + MESON_TAC[HAS_INTEGRAL_EQ]);; + +let HAS_INTEGRAL_NULL = prove + (`!f:real^M->real^N a b. + content(interval[a,b]) = &0 ==> (f has_integral vec 0) (interval[a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_integral] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 < e ==> x < e`) THEN + ASM_REWRITE_TAC[NORM_EQ_0] THEN ASM_MESON_TAC[VSUM_CONTENT_NULL]);; + +let HAS_INTEGRAL_NULL_EQ = prove + (`!f a b i. content(interval[a,b]) = &0 + ==> ((f has_integral i) (interval[a,b]) <=> i = vec 0)`, + ASM_MESON_TAC[INTEGRAL_UNIQUE; HAS_INTEGRAL_NULL]);; + +let INTEGRAL_NULL = prove + (`!f a b. content(interval[a,b]) = &0 + ==> integral(interval[a,b]) f = vec 0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + ASM_MESON_TAC[HAS_INTEGRAL_NULL]);; + +let INTEGRABLE_ON_NULL = prove + (`!f a b. content(interval[a,b]) = &0 + ==> f integrable_on interval[a,b]`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NULL]);; + +let HAS_INTEGRAL_EMPTY = prove + (`!f. (f has_integral vec 0) {}`, + MESON_TAC[HAS_INTEGRAL_NULL; CONTENT_EMPTY; EMPTY_AS_INTERVAL]);; + +let HAS_INTEGRAL_EMPTY_EQ = prove + (`!f i. (f has_integral i) {} <=> i = vec 0`, + MESON_TAC[HAS_INTEGRAL_UNIQUE; HAS_INTEGRAL_EMPTY]);; + +let INTEGRABLE_ON_EMPTY = prove + (`!f. f integrable_on {}`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_EMPTY]);; + +let INTEGRAL_EMPTY = prove + (`!f. integral {} f = vec 0`, + MESON_TAC[EMPTY_AS_INTERVAL; INTEGRAL_UNIQUE; HAS_INTEGRAL_EMPTY]);; + +let HAS_INTEGRAL_REFL = prove + (`!f a. (f has_integral vec 0) (interval[a,a])`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN + SIMP_TAC[INTERVAL_SING; INTERIOR_CLOSED_INTERVAL; CONTENT_EQ_0_INTERIOR]);; + +let INTEGRABLE_ON_REFL = prove + (`!f a. f integrable_on interval[a,a]`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_REFL]);; + +let INTEGRAL_REFL = prove + (`!f a. integral (interval[a,a]) f = vec 0`, + MESON_TAC[INTEGRAL_UNIQUE; HAS_INTEGRAL_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy-type criterion for integrability. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_CAUCHY = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] <=> + !e. &0 < e + ==> ?d. gauge d /\ + !p1 p2. p1 tagged_division_of interval[a,b] /\ d fine p1 /\ + p2 tagged_division_of interval[a,b] /\ d fine p2 + ==> norm(vsum p1 (\(x,k). content k % f x) - + vsum p2 (\(x,k). content k % f x)) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on; has_integral] THEN + EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `y:real^N` (MP_TAC o SPEC `e / &2`)) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:real^M->real^M->bool` THEN + REWRITE_TAC[GSYM dist] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real^M->real^M->bool` MP_TAC) THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + MP_TAC(GEN `n:num` + (ISPECL [`\x. INTERS {(d:num->real^M->real^M->bool) i x | i IN 0..n}`; + `a:real^M`; `b:real^M`] + FINE_DIVISION_EXISTS)) THEN + ASM_SIMP_TAC[GAUGE_INTERS; FINE_INTERS; FINITE_NUMSEG; SKOLEM_THM] THEN + REWRITE_TAC[IN_NUMSEG; LE_0; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num->(real^M#(real^M->bool))->bool` + STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `cauchy (\n. vsum (p n) + (\(x,k:real^M->bool). content k % (f:real^M->real^N) x))` + MP_TAC THENL + [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [MESON_TAC[DIST_SYM]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&m + &1)` THEN + CONJ_TAC THENL + [REWRITE_TAC[dist] THEN ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[dist] THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC + `(d:num->real^M->real^M->bool) (N1 + N2)` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `q:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM dist] THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_L THEN + EXISTS_TAC `vsum (p(N1+N2:num)) + (\(x,k:real^M->bool). content k % (f:real^M->real^N) x)` THEN + CONJ_TAC THENL + [REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `inv(&(N1 + N2) + &1)` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[dist] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Additivity of integral on abutting intervals. *) +(* ------------------------------------------------------------------------- *) + +let INTERVAL_SPLIT = prove + (`!a b:real^N c k. + 1 <= k /\ k <= dimindex(:N) + ==> interval[a,b] INTER {x | x$k <= c} = + interval[a,(lambda i. if i = k then min (b$k) c else b$i)] /\ + interval[a,b] INTER {x | x$k >= c} = + interval[(lambda i. if i = k then max (a$k) c else a$i),b]`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_INTER; IN_ELIM_THM] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC(TAUT `(c ==> b) /\ (c ==> a) /\ (a /\ b ==> c) + ==> (a /\ b <=> c)`) THEN + (CONJ_TAC THENL + [ASM_MESON_TAC[REAL_MAX_LE; REAL_LE_MIN; real_ge]; ALL_TAC]) THEN + REWRITE_TAC[LEFT_AND_FORALL_THM; real_ge] THEN CONJ_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN ASM_MESON_TAC[REAL_MAX_LE; REAL_LE_MIN]);; + +let CONTENT_SPLIT = prove + (`!a b:real^N k. + 1 <= k /\ k <= dimindex(:N) + ==> content(interval[a,b]) = + content(interval[a,b] INTER {x | x$k <= c}) + + content(interval[a,b] INTER {x | x$k >= c})`, + SIMP_TAC[INTERVAL_SPLIT; CONTENT_CLOSED_INTERVAL_CASES; LAMBDA_BETA] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_ARITH + `((a <= if p then b else c) <=> (p ==> a <= b) /\ (~p ==> a <= c)) /\ + ((if p then b else c) <= a <=> (p ==> b <= a) /\ (~p ==> c <= a))`] THEN + REWRITE_TAC[REAL_LE_MIN; REAL_MAX_LE] THEN + REWRITE_TAC[MESON[] `(i = k ==> p i k) <=> (i = k ==> p i i)`] THEN + REWRITE_TAC[TAUT `(p ==> a /\ b) /\ (~p ==> a) <=> a /\ (p ==> b)`] THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + ASM_CASES_TAC + `!i. 1 <= i /\ i <= dimindex(:N) ==> (a:real^N)$i <= (b:real^N)$i` THEN + ASM_REWRITE_TAC[REAL_ADD_RID] THEN + REWRITE_TAC[MESON[] `(!i. P i ==> i = k ==> Q i) <=> (P k ==> Q k)`] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `min b c = if c <= b then c else b`; + REAL_ARITH `max a c = if a <= c then c else a`] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]) THEN + REWRITE_TAC[MESON[] `(if i = k then a k else a i) = a i`] THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]] THEN + SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN + MATCH_MP_TAC(REAL_RING + `p'' = p /\ p':real = p + ==> (b - a) * p = (c - a) * p' + (b - c) * p''`) THEN + CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN SIMP_TAC[IN_DELETE]);; + +let DIVISION_SPLIT_LEFT_INJ,DIVISION_SPLIT_RIGHT_INJ = (CONJ_PAIR o prove) + (`(!d i k1 k2 k c. + d division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ + k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\ + k1 INTER {x | x$k <= c} = k2 INTER {x | x$k <= c} + ==> content(k1 INTER {x:real^N | x$k <= c}) = &0) /\ + (!d i k1 k2 k c. + d division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ + k1 IN d /\ k2 IN d /\ ~(k1 = k2) /\ + k1 INTER {x | x$k >= c} = k2 INTER {x | x$k >= c} + ==> content(k1 INTER {x:real^N | x$k >= c}) = &0)`, + let lemma = prove + (`!a b:real^N c k. + 1 <= k /\ k <= dimindex(:N) + ==> (content(interval[a,b] INTER {x | x$k <= c}) = &0 <=> + interior(interval[a,b] INTER {x | x$k <= c}) = {}) /\ + (content(interval[a,b] INTER {x | x$k >= c}) = &0 <=> + interior(interval[a,b] INTER {x | x$k >= c}) = {})`, + SIMP_TAC[INTERVAL_SPLIT; CONTENT_EQ_0_INTERIOR]) in + REPEAT STRIP_TAC THEN + REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (MP_TAC o CONJUNCT1) o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPECL + [`k1:real^N->bool`; `k2:real^N->bool`]) THEN + ASM_REWRITE_TAC[PAIR_EQ] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `k2:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N` (X_CHOOSE_THEN `v:real^N` + SUBST_ALL_TAC)) THEN + ASM_SIMP_TAC[lemma] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s INTER t = {} + ==> u SUBSET s /\ u SUBSET t ==> u = {}`)) THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]);; + +let TAGGED_DIVISION_SPLIT_LEFT_INJ = prove + (`!d i x1 k1 x2 k2 k c. + d tagged_division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ + (x1,k1) IN d /\ (x2,k2) IN d /\ ~(k1 = k2) /\ + k1 INTER {x | x$k <= c} = k2 INTER {x | x$k <= c} + ==> content(k1 INTER {x:real^N | x$k <= c}) = &0`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN + MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ THEN + EXISTS_TAC `IMAGE SND (d:(real^N#(real^N->bool))->bool)` THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[SND]);; + +let TAGGED_DIVISION_SPLIT_RIGHT_INJ = prove + (`!d i x1 k1 x2 k2 k c. + d tagged_division_of i /\ 1 <= k /\ k <= dimindex(:N) /\ + (x1,k1) IN d /\ (x2,k2) IN d /\ ~(k1 = k2) /\ + k1 INTER {x | x$k >= c} = k2 INTER {x | x$k >= c} + ==> content(k1 INTER {x:real^N | x$k >= c}) = &0`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN + MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ THEN + EXISTS_TAC `IMAGE SND (d:(real^N#(real^N->bool))->bool)` THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[SND]);; + +let DIVISION_SPLIT = prove + (`!p a b:real^N k c. + p division_of interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) + ==> {l INTER {x | x$k <= c} |l| l IN p /\ ~(l INTER {x | x$k <= c} = {})} + division_of (interval[a,b] INTER {x | x$k <= c}) /\ + {l INTER {x | x$k >= c} |l| l IN p /\ ~(l INTER {x | x$k >= c} = {})} + division_of (interval[a,b] INTER {x | x$k >= c})`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + SIMP_TAC[division_of; FINITE_IMAGE] THEN + SIMP_TAC[SET_RULE `(!x. x IN {f x | P x} ==> Q x) <=> (!x. P x ==> Q (f x))`; + MESON[] `(!x y. x IN s /\ y IN t /\ Q x y ==> P x y) <=> + (!x. x IN s ==> !y. y IN t ==> Q x y ==> P x y)`; + RIGHT_FORALL_IMP_THM] THEN + REPEAT(MATCH_MP_TAC(TAUT + `(a ==> a' /\ a'') /\ (b ==> b' /\ b'') + ==> a /\ b ==> (a' /\ b') /\ (a'' /\ b'')`) THEN CONJ_TAC) + THENL + [ONCE_REWRITE_TAC[SET_RULE + `{f x |x| x IN s /\ ~(f x = {})} = {y | y IN IMAGE f s /\ ~(y = {})}`] THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_IMAGE]; + REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `l:real^N->bool` THEN + DISCH_THEN(fun th -> CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN + (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN ASM_MESON_TAC[INTERVAL_SPLIT]); + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + (REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' + ==> s' INTER t' = {} ==> s INTER t = {}`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]); + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_UNIONS] THEN + ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS] THEN + CONJ_TAC THEN GEN_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]]);; + +let HAS_INTEGRAL_SPLIT = prove + (`!f:real^M->real^N k a b c. + (f has_integral i) (interval[a,b] INTER {x | x$k <= c}) /\ + (f has_integral j) (interval[a,b] INTER {x | x$k >= c}) /\ + 1 <= k /\ k <= dimindex(:M) + ==> (f has_integral (i + j)) (interval[a,b])`, + let lemma1 = prove + (`(!x k. (x,k) IN {x,f k | P x k} ==> Q x k) <=> + (!x k. P x k ==> Q x (f k))`, + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN + SET_TAC[]) in + let lemma2 = prove + (`!f:B->B s:(A#B)->bool. + FINITE s ==> FINITE {x,f k | (x,k) IN s /\ P x k}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\(x:A,k:B). x,(f k:B)) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_PAIR_THM; lemma1; IN_IMAGE] THEN + REWRITE_TAC[EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]) in + let lemma3 = prove + (`!f:real^M->real^N g:(real^M->bool)->(real^M->bool) p. + FINITE p + ==> vsum {x,g k |x,k| (x,k) IN p /\ ~(g k = {})} + (\(x,k). content k % f x) = + vsum (IMAGE (\(x,k). x,g k) p) (\(x,k). content k % f x)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_SIMP_TAC[FINITE_IMAGE; lemma2] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; VECTOR_MUL_EQ_0] THEN + MESON_TAC[CONTENT_EMPTY]) in + let lemma4 = prove + (`(\(x,l). content (g l) % f x) = + (\(x,l). content l % f x) o (\(x,l). x,g l)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; FORALL_PAIR_THM]) in + REPEAT GEN_TAC THEN + ASM_CASES_TAC `1 <= k /\ k <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN REWRITE_TAC[has_integral] THEN + ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN FIRST_X_ASSUM STRIP_ASSUME_TAC THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &2`) STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I2"))) THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I1"))) THEN + EXISTS_TAC `\x. if x$k = c then (d1(x:real^M) INTER d2(x)):real^M->bool + else ball(x,abs(x$k - c)) INTER d1(x) INTER d2(x)` THEN + CONJ_TAC THENL + [REWRITE_TAC[gauge] THEN GEN_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[OPEN_INTER; IN_INTER; OPEN_BALL; IN_BALL] THEN + ASM_REWRITE_TAC[DIST_REFL; GSYM REAL_ABS_NZ; REAL_SUB_0]; + ALL_TAC] THEN + X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `(!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {}) + ==> x$k <= c) /\ + (!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {}) + ==> x$k >= c)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL; real_ge] THEN DISCH_THEN + (MP_TAC o MATCH_MP (SET_RULE `k SUBSET (a INTER b) ==> k SUBSET a`)) THEN + REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M` MP_TAC) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((x - u:real^M)$k)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REMOVE_THEN "I2" (MP_TAC o SPEC + `{(x:real^M,kk INTER {x:real^M | x$k >= c}) |x,kk| + (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {})}`) THEN + REMOVE_THEN "I1" (MP_TAC o SPEC + `{(x:real^M,kk INTER {x:real^M | x$k <= c}) |x,kk| + (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {})}`) THEN + MATCH_MP_TAC(TAUT + `(a /\ b) /\ (a' /\ b' ==> c) ==> (a ==> a') ==> (b ==> b') ==> c`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + REWRITE_TAC[TAGGED_DIVISION_OF] THEN + REPEAT(MATCH_MP_TAC(TAUT + `(a ==> (a' /\ a'')) /\ (b ==> (b' /\ d) /\ (b'' /\ e)) + ==> a /\ b ==> ((a' /\ b') /\ d) /\ ((a'' /\ b'') /\ e)`) THEN + CONJ_TAC) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[lemma1] THEN REWRITE_TAC[IMP_IMP] THENL + [SIMP_TAC[lemma2]; + REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN + DISCH_THEN(fun th -> CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN + (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN + (MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN + ASM_MESON_TAC[INTERVAL_SPLIT]; + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + (REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' + ==> s' INTER t' = {} ==> s INTER t = {}`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]); + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ d /\ e + ==> (a ==> (b /\ d) /\ (c /\ e))`) THEN + CONJ_TAC THENL + [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_UNIONS] THEN + ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS] THEN + X_GEN_TAC `x:real^M` THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `kk:real^M->bool` THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + REWRITE_TAC[fine; lemma1] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `x < e / &2 /\ y < e / &2 ==> x + y < e`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP NORM_TRIANGLE_LT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[VECTOR_ARITH + `(a - i) + (b - j) = c - (i + j) <=> a + b = c:real^N`] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `vsum p (\(x,l). content (l INTER {x:real^M | x$k <= c}) % + (f:real^M->real^N) x) + + vsum p (\(x,l). content (l INTER {x:real^M | x$k >= c}) % + (f:real^M->real^N) x)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[GSYM VSUM_ADD] THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM; GSYM VECTOR_ADD_RDISTRIB] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN + DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`] o + el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM CONTENT_SPLIT]] THEN + ASM_SIMP_TAC[lemma3] THEN BINOP_TAC THEN + (GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [lemma4] THEN + MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN + ASM_MESON_TAC[TAGGED_DIVISION_SPLIT_LEFT_INJ; VECTOR_MUL_LZERO; + TAGGED_DIVISION_SPLIT_RIGHT_INJ]));; + +(* ------------------------------------------------------------------------- *) +(* A sort of converse, integrability on subintervals. *) +(* ------------------------------------------------------------------------- *) + +let TAGGED_DIVISION_UNION_INTERVAL = prove + (`!a b:real^N p1 p2 c k. + 1 <= k /\ k <= dimindex(:N) /\ + p1 tagged_division_of (interval[a,b] INTER {x | x$k <= c}) /\ + p2 tagged_division_of (interval[a,b] INTER {x | x$k >= c}) + ==> (p1 UNION p2) tagged_division_of (interval[a,b])`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `interval[a,b] = (interval[a,b] INTER {x:real^N | x$k <= c}) UNION + (interval[a,b] INTER {x:real^N | x$k >= c})` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(t UNION u = UNIV) ==> s = (s INTER t) UNION (s INTER u)`) THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_INTERVAL] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `k:num`)) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC);; + +let HAS_INTEGRAL_SEPARATE_SIDES = prove + (`!f:real^M->real^N i a b k. + (f has_integral i) (interval[a,b]) /\ + 1 <= k /\ k <= dimindex(:M) + ==> !e. &0 < e + ==> ?d. gauge d /\ + !p1 p2. p1 tagged_division_of + (interval[a,b] INTER {x | x$k <= c}) /\ + d fine p1 /\ + p2 tagged_division_of + (interval[a,b] INTER {x | x$k >= c}) /\ + d fine p2 + ==> norm((vsum p1 (\(x,k). content k % f x) + + vsum p2 (\(x,k). content k % f x)) - + i) < e`, + REWRITE_TAC[has_integral] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum p1 (\(x,k). content k % f x) + vsum p2 (\(x,k). content k % f x) = + vsum (p1 UNION p2) (\(x,k:real^M->bool). content k % (f:real^M->real^N) x)` + SUBST1_TAC THENL + [ALL_TAC; ASM_MESON_TAC[TAGGED_DIVISION_UNION_INTERVAL; FINE_UNION]] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I + [TAGGED_DIVISION_OF])) THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN + REWRITE_TAC[IN_INTER; VECTOR_MUL_EQ_0] THEN STRIP_TAC THEN DISJ1_TAC THEN + SUBGOAL_THEN + `(?a b:real^M. l = interval[a,b]) /\ + l SUBSET (interval[a,b] INTER {x | x$k <= c}) /\ + l SUBSET (interval[a,b] INTER {x | x$k >= c})` + MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[SET_RULE + `s SUBSET t /\ s SUBSET u <=> s SUBSET (t INTER u)`] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTER_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUBSET_INTERIOR) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; CONTENT_EQ_0_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE `t = {} ==> s SUBSET t ==> s = {}`) THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN EXISTS_TAC `k:num` THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC);; + +let INTEGRABLE_SPLIT = prove + (`!f:real^M->real^N a b. + f integrable_on (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:M) + ==> f integrable_on (interval[a,b] INTER {x | x$k <= c}) /\ + f integrable_on (interval[a,b] INTER {x | x$k >= c})`, + let lemma = prove + (`b - a = c + ==> norm(a:real^N) < e / &2 ==> norm(b) < e / &2 ==> norm(c) < e`, + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM dist] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_L THEN + EXISTS_TAC `vec 0:real^N` THEN + ASM_REWRITE_TAC[dist; VECTOR_SUB_LZERO; VECTOR_SUB_RZERO; NORM_NEG]) in + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [integrable_on] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN CONJ_TAC THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTEGRABLE_CAUCHY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `e / &2` o + MATCH_MP HAS_INTEGRAL_SEPARATE_SIDES) THEN + MAP_EVERY ABBREV_TAC + [`b' = (lambda i. if i = k then min ((b:real^M)$k) c else b$i):real^M`; + `a' = (lambda i. if i = k then max ((a:real^M)$k) c else a$i):real^M`] THEN + ASM_SIMP_TAC[REAL_HALF; INTERVAL_SPLIT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THENL + [DISCH_THEN(MP_TAC o SPECL [`a':real^M`; `b:real^M`]) THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[SWAP_FORALL_THM]); + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b':real^M`])] THEN + DISCH_THEN(X_CHOOSE_THEN `p:(real^M#(real^M->bool))->bool` + STRIP_ASSUME_TAC) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL [`p:(real^M#(real^M->bool))->bool`; + `p1:(real^M#(real^M->bool))->bool`] th) THEN + MP_TAC(SPECL [`p:(real^M#(real^M->bool))->bool`; + `p2:(real^M#(real^M->bool))->bool`] th)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC lemma THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Generalized notion of additivity. *) +(* ------------------------------------------------------------------------- *) + +let operative = new_definition + `operative op (f:(real^N->bool)->A) <=> + (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = neutral(op)) /\ + (!a b c k. 1 <= k /\ k <= dimindex(:N) + ==> f(interval[a,b]) = + op (f(interval[a,b] INTER {x | x$k <= c})) + (f(interval[a,b] INTER {x | x$k >= c})))`;; + +let OPERATIVE_TRIVIAL = prove + (`!op f a b. + operative op f /\ content(interval[a,b]) = &0 + ==> f(interval[a,b]) = neutral op`, + REWRITE_TAC[operative] THEN MESON_TAC[]);; + +let PROPERTY_EMPTY_INTERVAL = prove + (`!P. (!a b:real^N. content(interval[a,b]) = &0 ==> P(interval[a,b])) + ==> P {}`, + MESON_TAC[EMPTY_AS_INTERVAL; CONTENT_EMPTY]);; + +let OPERATIVE_EMPTY = prove + (`!op f:(real^N->bool)->A. operative op f ==> f {} = neutral op`, + REPEAT GEN_TAC THEN REWRITE_TAC[operative] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP PROPERTY_EMPTY_INTERVAL o CONJUNCT1));; + +(* ------------------------------------------------------------------------- *) +(* Using additivity of lifted function to encode definedness. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_OPTION = prove + (`(!x. P x) <=> P NONE /\ !x. P(SOME x)`, + MESON_TAC[cases "option"]);; + +let EXISTS_OPTION = prove + (`(?x. P x) <=> P NONE \/ ?x. P(SOME x)`, + MESON_TAC[cases "option"]);; + +let lifted = define + `(lifted op NONE _ = NONE) /\ + (lifted op _ NONE = NONE) /\ + (lifted op (SOME x) (SOME y) = SOME(op x y))`;; + +let NEUTRAL_LIFTED = prove + (`!op. monoidal op ==> neutral(lifted op) = SOME(neutral op)`, + REWRITE_TAC[neutral; monoidal] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SELECT_UNIQUE THEN + REWRITE_TAC[FORALL_OPTION; lifted; distinctness "option"; + injectivity "option"] THEN + ASM_MESON_TAC[]);; + +let MONOIDAL_LIFTED = prove + (`!op. monoidal op ==> monoidal(lifted op)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NEUTRAL_LIFTED; monoidal] THEN + REWRITE_TAC[FORALL_OPTION; lifted; distinctness "option"; + injectivity "option"] THEN + ASM_MESON_TAC[monoidal]);; + +let ITERATE_SOME = prove + (`!op. monoidal op + ==> !f s. FINITE s + ==> iterate (lifted op) s (\x. SOME(f x)) = + SOME(iterate op s f)`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_LIFTED; NEUTRAL_LIFTED] THEN + REWRITE_TAC[lifted]);; + +(* ------------------------------------------------------------------------- *) +(* Two key instances of additivity. *) +(* ------------------------------------------------------------------------- *) + +let OPERATIVE_CONTENT = prove + (`operative(+) content`, + REWRITE_TAC[operative; NEUTRAL_REAL_ADD; CONTENT_SPLIT]);; + +let OPERATIVE_INTEGRAL = prove + (`!f:real^M->real^N. + operative(lifted(+)) + (\i. if f integrable_on i then SOME(integral i f) else NONE)`, + SIMP_TAC[operative; NEUTRAL_LIFTED; MONOIDAL_VECTOR_ADD] THEN + REWRITE_TAC[NEUTRAL_VECTOR_ADD] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[lifted; distinctness "option"; injectivity "option"] THENL + [REWRITE_TAC[integral] THEN ASM_MESON_TAC[HAS_INTEGRAL_NULL_EQ]; + RULE_ASSUM_TAC(REWRITE_RULE[integrable_on]) THEN + ASM_MESON_TAC[HAS_INTEGRAL_NULL]; + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL)) THEN + ASM_MESON_TAC[HAS_INTEGRAL_SPLIT; HAS_INTEGRAL_UNIQUE]; + ASM_MESON_TAC[INTEGRABLE_SPLIT; integrable_on]; + ASM_MESON_TAC[INTEGRABLE_SPLIT]; + ASM_MESON_TAC[INTEGRABLE_SPLIT]; + RULE_ASSUM_TAC(REWRITE_RULE[integrable_on]) THEN + ASM_MESON_TAC[HAS_INTEGRAL_SPLIT]]);; + +(* ------------------------------------------------------------------------- *) +(* Points of division of a partition. *) +(* ------------------------------------------------------------------------- *) + +let division_points = new_definition + `division_points (k:real^N->bool) (d:(real^N->bool)->bool) = + {j,x | 1 <= j /\ j <= dimindex(:N) /\ + (interval_lowerbound k)$j < x /\ x < (interval_upperbound k)$j /\ + ?i. i IN d /\ + ((interval_lowerbound i)$j = x \/ + (interval_upperbound i)$j = x)}`;; + +let DIVISION_POINTS_FINITE = prove + (`!d i:real^N->bool. d division_of i ==> FINITE(division_points i d)`, + REWRITE_TAC[division_of; division_points] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CONJ_ASSOC; GSYM IN_NUMSEG] THEN + REWRITE_TAC[IN; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(REWRITE_RULE[IN] FINITE_PRODUCT_DEPENDENT) THEN + REWRITE_TAC[ETA_AX; FINITE_NUMSEG] THEN + X_GEN_TAC `j:num` THEN GEN_REWRITE_TAC LAND_CONV [GSYM IN] THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC + `IMAGE (\i:real^N->bool. (interval_lowerbound i)$j) d UNION + IMAGE (\i:real^N->bool. (interval_upperbound i)$j) d` THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNION; IN_ELIM_THM] THEN MESON_TAC[IN]);; + +let DIVISION_POINTS_SUBSET = prove + (`!a b:real^N c d k. + d division_of interval[a,b] /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i) /\ + 1 <= k /\ k <= dimindex(:N) /\ a$k < c /\ c < b$k + ==> division_points (interval[a,b] INTER {x | x$k <= c}) + {l INTER {x | x$k <= c} | l | + l IN d /\ ~(l INTER {x | x$k <= c} = {})} + SUBSET division_points (interval[a,b]) d /\ + division_points (interval[a,b] INTER {x | x$k >= c}) + {l INTER {x | x$k >= c} | l | + l IN d /\ ~(l INTER {x | x$k >= c} = {})} + SUBSET division_points (interval[a,b]) d`, + REPEAT STRIP_TAC THEN + (REWRITE_TAC[SUBSET; division_points; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`j:num`; `x:real`] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; + REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; + REAL_ARITH `c < b ==> min b c = c`] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; LAMBDA_BETA; + REAL_LT_IMP_LE; COND_ID; + TAUT `(a <= if p then x else y) <=> (if p then a <= x else a <= y)`; + TAUT `(if p then x else y) <= a <=> (if p then x <= a else y <= a)`] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL + [DISCH_THEN(K ALL_TAC) THEN REPEAT(POP_ASSUM MP_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) ==> (u:real^N)$i <= (v:real^N)$i` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM INTERVAL_NE_EMPTY] THEN ASM_MESON_TAC[division_of]; + ALL_TAC] THEN + REWRITE_TAC[INTERVAL_NE_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REPEAT(POP_ASSUM MP_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC));; + +let DIVISION_POINTS_PSUBSET = prove + (`!a b:real^N c d k. + d division_of interval[a,b] /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i) /\ + 1 <= k /\ k <= dimindex(:N) /\ a$k < c /\ c < b$k /\ + (?l. l IN d /\ + (interval_lowerbound l$k = c \/ interval_upperbound l$k = c)) + ==> division_points (interval[a,b] INTER {x | x$k <= c}) + {l INTER {x | x$k <= c} | l | + l IN d /\ ~(l INTER {x | x$k <= c} = {})} + PSUBSET division_points (interval[a,b]) d /\ + division_points (interval[a,b] INTER {x | x$k >= c}) + {l INTER {x | x$k >= c} | l | + l IN d /\ ~(l INTER {x | x$k >= c} = {})} + PSUBSET division_points (interval[a,b]) d`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[PSUBSET_MEMBER; DIVISION_POINTS_SUBSET] THENL + [EXISTS_TAC `k,(interval_lowerbound l:real^N)$k`; + EXISTS_TAC `k,(interval_lowerbound l:real^N)$k`; + EXISTS_TAC `k,(interval_upperbound l:real^N)$k`; + EXISTS_TAC `k,(interval_upperbound l:real^N)$k`] THEN + ASM_REWRITE_TAC[division_points; IN_ELIM_PAIR_THM] THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN + (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; + REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; + REAL_ARITH `c < b ==> min b c = c`] THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; LAMBDA_BETA; + REAL_LT_IMP_LE; COND_ID; + TAUT `(a <= if p then x else y) <=> (if p then a <= x else a <= y)`; + TAUT `(if p then x else y) <= a <=> (if p then x <= a else y <= a)`] THEN + REWRITE_TAC[REAL_LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation by divisions and tagged divisions. *) +(* ------------------------------------------------------------------------- *) + +let OPERATIVE_DIVISION = prove + (`!op d a b f:(real^N->bool)->A. + monoidal op /\ operative op f /\ d division_of interval[a,b] + ==> iterate(op) d f = f(interval[a,b])`, + REPEAT GEN_TAC THEN CONV_TAC(RAND_CONV SYM_CONV) THEN WF_INDUCT_TAC + `CARD (division_points (interval[a,b]:real^N->bool) d)` THEN + POP_ASSUM(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL + [SUBGOAL_THEN `iterate op d (f:(real^N->bool)->A) = neutral op` + (fun th -> ASM_MESON_TAC[th; operative]) THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + ITERATE_EQ_NEUTRAL) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + ASM_MESON_TAC[operative; DIVISION_OF_CONTENT_0]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN + REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_CASES_TAC `division_points (interval[a,b]:real^N->bool) d = {}` THENL + [DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN + `!i. i IN d + ==> ?u v:real^N. i = interval[u,v] /\ + !j. 1 <= j /\ j <= dimindex(:N) + ==> u$j = (a:real^N)$j /\ v$j = a$j \/ + u$j = (b:real^N)$j /\ v$j = b$j \/ + u$j = a$j /\ v$j = b$j` + (LABEL_TAC "*") THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`u:real^N`; `v:real^N`] THEN REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `interval[u:real^N,v]` o CONJUNCT1) THEN + ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (ASSUME_TAC o CONJUNCT1)) THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `a <= u /\ u <= v /\ v <= b /\ ~(a < u /\ u < b \/ a < v /\ v < b) + ==> u = a /\ v = a \/ u = b /\ v = b \/ u = a /\ v = b`) THEN + ASM_SIMP_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[division_points; NOT_IN_EMPTY; FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN DISCH_THEN(MP_TAC o SPEC `j:num`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `interval[u:real^N,v]`) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; + REAL_LT_IMP_LE] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `(u:real^N)$j` th) THEN + MP_TAC(SPEC `(v:real^N)$j` th)) THEN + FIRST_X_ASSUM(DISJ_CASES_THEN MP_TAC) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `interval[a:real^N,b] IN d` MP_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_UNIONS] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2) % (a + b:real^N)`) THEN + MATCH_MP_TAC(TAUT `b /\ (a ==> c) ==> (a <=> b) ==> c`) THEN + CONJ_TAC THENL + [SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `i:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN + SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + ASM_SIMP_TAC[REAL_ARITH + `a < b + ==> ((u = a /\ v = a \/ u = b /\ v = b \/ u = a /\ v = b) /\ + u <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= v <=> + u = a /\ v = b)`] THEN + ASM_MESON_TAC[CART_EQ]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP (SET_RULE + `a IN d ==> d = a INSERT (d DELETE a)`)) THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + SUBGOAL_THEN + `iterate op (d DELETE interval[a,b]) (f:(real^N->bool)->A) = neutral op` + (fun th -> ASM_MESON_TAC[th; monoidal]) THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + ITERATE_EQ_NEUTRAL) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `l:real^N->bool` THEN + REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN + SUBGOAL_THEN `content(l:real^N->bool) = &0` + (fun th -> ASM_MESON_TAC[th; operative]) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `l:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN + UNDISCH_TAC `~(interval[u:real^N,v] = interval[a,b])` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[] THEN DISCH_THEN(fun th -> AP_TERM_TAC THEN MP_TAC th) THEN + REWRITE_TAC[CONS_11; PAIR_EQ; CART_EQ; CONTENT_EQ_0] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [TAUT `a ==> b <=> ~a \/ b`] THEN + REWRITE_TAC[NOT_FORALL_THM; OR_EXISTS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `j:num` THEN + ASM_CASES_TAC `1 <= j /\ j <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [division_points] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`whatever:num#real`; `k:num`; `c:real`] THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (K ALL_TAC)) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `c:real`; `d:(real^N->bool)->bool`; + `k:num`] DIVISION_POINTS_PSUBSET) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN + (MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] CARD_PSUBSET))) THEN + MP_TAC(ISPECL [`d:(real^N->bool)->bool`; `a:real^N`; `b:real^N`; `k:num`; + `c:real`] + DIVISION_SPLIT) THEN + ASM_SIMP_TAC[DIVISION_POINTS_FINITE] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; + REAL_ARITH `c < b ==> min b c = c`] THEN + MAP_EVERY ABBREV_TAC + [`d1:(real^N->bool)->bool = + {l INTER {x | x$k <= c} | l | l IN d /\ ~(l INTER {x | x$k <= c} = {})}`; + `d2:(real^N->bool)->bool = + {l INTER {x | x$k >= c} | l | l IN d /\ ~(l INTER {x | x$k >= c} = {})}`; + `cb:real^N = (lambda i. if i = k then c else (b:real^N)$i)`; + `ca:real^N = (lambda i. if i = k then c else (a:real^N)$i)`] THEN + STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN DISCH_THEN(fun th -> + MP_TAC(SPECL [`a:real^N`; `cb:real^N`; `d1:(real^N->bool)->bool`] th) THEN + MP_TAC(SPECL [`ca:real^N`; `b:real^N`; `d2:(real^N->bool)->bool`] th)) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `op (iterate op d1 (f:(real^N->bool)->A)) + (iterate op d2 (f:(real^N->bool)->A))` THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I [operative]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `c:real`; `k:num`]) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + ASM_SIMP_TAC[REAL_ARITH `a < c ==> max a c = c`; + REAL_ARITH `c < b ==> min b c = c`]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `op (iterate op d (\l. f(l INTER {x | x$k <= c}):A)) + (iterate op d (\l. f(l INTER {x:real^N | x$k >= c})))` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[GSYM ITERATE_OP] THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + ITERATE_EQ) THEN + ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION + (ASSUME `d division_of interval[a:real^N,b]`)] THEN + ASM_MESON_TAC[operative]] THEN + MAP_EVERY EXPAND_TAC ["d1"; "d2"] THEN BINOP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC ITERATE_NONZERO_IMAGE_LEMMA THEN ASM_REWRITE_TAC[] THEN + (CONJ_TAC THENL [ASM_MESON_TAC[OPERATIVE_EMPTY]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`l:real^N->bool`; `m:real^N->bool`] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[OPERATIVE_TRIVIAL] + `operative op f /\ (?a b. l = interval[a,b]) /\ content l = &0 + ==> f l = neutral op`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[DIVISION_SPLIT_LEFT_INJ; + DIVISION_SPLIT_RIGHT_INJ]] THEN + SUBGOAL_THEN `?a b:real^N. m = interval[a,b]` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]));; + +let OPERATIVE_TAGGED_DIVISION = prove + (`!op d a b f:(real^N->bool)->A. + monoidal op /\ operative op f /\ d tagged_division_of interval[a,b] + ==> iterate(op) d (\(x,l). f l) = f(interval[a,b])`, + let lemma = prove + (`(\(x,l). f l) = (f o SND)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; FORALL_PAIR_THM]) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `iterate op (IMAGE SND (d:(real^N#(real^N->bool)->bool))) f :A` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[DIVISION_OF_TAGGED_DIVISION; OPERATIVE_DIVISION]] THEN + REWRITE_TAC[lemma] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + ITERATE_IMAGE_NONZERO) THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF_FINITE]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1 o CONJUNCT2)) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN REWRITE_TAC[PAIR_EQ] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[INTER_ACI] THEN + ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR; OPERATIVE_TRIVIAL; + TAGGED_DIVISION_OF]);; + +(* ------------------------------------------------------------------------- *) +(* Additivity of content. *) +(* ------------------------------------------------------------------------- *) + +let ADDITIVE_CONTENT_DIVISION = prove + (`!d a b:real^N. + d division_of interval[a,b] + ==> sum d content = content(interval[a,b])`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + (MATCH_MP + (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + OPERATIVE_DIVISION) + (CONJ MONOIDAL_REAL_ADD OPERATIVE_CONTENT))) THEN + REWRITE_TAC[sum]);; + +let ADDITIVE_CONTENT_TAGGED_DIVISION = prove + (`!d a b:real^N. + d tagged_division_of interval[a,b] + ==> sum d (\(x,l). content l) = content(interval[a,b])`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + (MATCH_MP + (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + OPERATIVE_TAGGED_DIVISION) + (CONJ MONOIDAL_REAL_ADD OPERATIVE_CONTENT))) THEN + REWRITE_TAC[sum]);; + +let SUBADDITIVE_CONTENT_DIVISION = prove + (`!d s a b:real^M. + d division_of s /\ s SUBSET interval[a,b] + ==> sum d content <= content(interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`d:(real^M->bool)->bool`; `a:real^M`; `b:real^M`] + PARTIAL_DIVISION_EXTEND_INTERVAL) THEN + ANTS_TAC THENL + [REWRITE_TAC[UNIONS_SUBSET] THEN + ASM_MESON_TAC[division_of; DIVISION_OF_UNION_SELF; SUBSET_TRANS]; + DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (p:(real^M->bool)->bool) content` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_MESON_TAC[division_of; CONTENT_POS_LE; IN_DIFF]; + ASM_MESON_TAC[ADDITIVE_CONTENT_DIVISION; REAL_LE_REFL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Finally, the integral of a constant! *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_CONST = prove + (`!a b:real^M c:real^N. + ((\x. c) has_integral (content(interval[a,b]) % c)) (interval[a,b])`, + REWRITE_TAC[has_integral] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + FIRST_X_ASSUM(fun th -> + ONCE_REWRITE_TAC[GSYM(MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th)]) THEN + ASM_SIMP_TAC[VSUM_VMUL; GSYM VSUM_SUB] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; VECTOR_SUB_REFL] THEN + ASM_REWRITE_TAC[GSYM LAMBDA_PAIR_THM; VSUM_0; NORM_0]);; + +let INTEGRABLE_CONST = prove + (`!a b:real^M c:real^N. (\x. c) integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `content(interval[a:real^M,b]) % c:real^N` THEN + REWRITE_TAC[HAS_INTEGRAL_CONST]);; + +let INTEGRAL_CONST = prove + (`!a b c. integral (interval[a,b]) (\x. c) = content(interval[a,b]) % c`, + REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + REWRITE_TAC[HAS_INTEGRAL_CONST]);; + +let INTEGRAL_PASTECART_CONST = prove + (`!a b:real^M c d:real^N k:real^P. + integral (interval[pastecart a c,pastecart b d]) (\x. k) = + integral (interval[a,b]) + (\x. integral (interval[c,d]) (\y. k))`, + REWRITE_TAC[INTEGRAL_CONST; CONTENT_PASTECART; VECTOR_MUL_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Bounds on the norm of Riemann sums and the integral itself. *) +(* ------------------------------------------------------------------------- *) + +let DSUM_BOUND = prove + (`!p a b:real^M c:real^N e. + p division_of interval[a,b] /\ norm(c) <= e + ==> norm(vsum p (\l. content l % c)) <= e * content(interval[a,b])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `y <= e ==> x <= y ==> x <= e`) THEN + REWRITE_TAC[LAMBDA_PAIR_THM; NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum p (\k:real^M->bool. content k * e)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + X_GEN_TAC `l:real^M->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(x) <= x`) THEN + ASM_MESON_TAC[DIVISION_OF; CONTENT_POS_LE]; + REWRITE_TAC[SUM_RMUL; ETA_AX] THEN + ASM_MESON_TAC[ADDITIVE_CONTENT_DIVISION; REAL_LE_REFL; REAL_MUL_SYM]]);; + +let RSUM_BOUND = prove + (`!p a b f:real^M->real^N e. + p tagged_division_of interval[a,b] /\ + (!x. x IN interval[a,b] ==> norm(f x) <= e) + ==> norm(vsum p (\(x,k). content k % f x)) + <= e * content(interval[a,b])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `y <= e ==> x <= y ==> x <= e`) THEN + REWRITE_TAC[LAMBDA_PAIR_THM; NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum p (\(x:real^M,k:real^M->bool). content k * e)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN SIMP_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE; REAL_ABS_REFL; + REAL_LE_REFL]; + ASM_MESON_TAC[TAG_IN_INTERVAL]]; + FIRST_ASSUM(fun th -> REWRITE_TAC + [GSYM(MATCH_MP ADDITIVE_CONTENT_TAGGED_DIVISION th)]) THEN + REWRITE_TAC[GSYM SUM_LMUL; LAMBDA_PAIR_THM] THEN + REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]]);; + +let RSUM_DIFF_BOUND = prove + (`!p a b f g:real^M->real^N. + p tagged_division_of interval[a,b] /\ + (!x. x IN interval[a,b] ==> norm(f x - g x) <= e) + ==> norm(vsum p (\(x,k). content k % f x) - + vsum p (\(x,k). content k % g x)) + <= e * content(interval[a,b])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `norm(vsum p (\(x,k). + content(k:real^M->bool) % ((f:real^M->real^N) x - g x)))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM VSUM_SUB; VECTOR_SUB_LDISTRIB] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; REAL_LE_REFL]; + ASM_SIMP_TAC[RSUM_BOUND]]);; + +let HAS_INTEGRAL_BOUND = prove + (`!f:real^M->real^N a b i B. + &0 <= B /\ + (f has_integral i) (interval[a,b]) /\ + (!x. x IN interval[a,b] ==> norm(f x) <= B) + ==> norm i <= B * content(interval[a,b])`, + let lemma = prove + (`norm(s) <= B ==> ~(norm(s - i) < norm(i) - B)`, + MATCH_MP_TAC(REAL_ARITH `n1 <= n + n2 ==> n <= B ==> ~(n2 < n1 - B)`) THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[NORM_TRIANGLE_SUB]) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `&0 < content(interval[a:real^M,b])` THENL + [ALL_TAC; + SUBGOAL_THEN `i:real^N = vec 0` SUBST1_TAC THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_0; CONTENT_POS_LE] THEN + ASM_MESON_TAC[HAS_INTEGRAL_NULL_EQ; CONTENT_LT_NZ]] THEN + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN + DISCH_THEN(MP_TAC o SPEC + `norm(i:real^N) - B * content(interval[a:real^M,b])`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d:real^M->real^M->bool`; `a:real^M`; `b:real^M`] + FINE_DIVISION_EXISTS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN + (X_CHOOSE_THEN `p:(real^M#(real^M->bool)->bool)` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool)->bool)`) THEN + ASM_MESON_TAC[lemma; RSUM_BOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Similar theorems about relationship among components. *) +(* ------------------------------------------------------------------------- *) + +let RSUM_COMPONENT_LE = prove + (`!p a b f:real^M->real^N g:real^M->real^N. + p tagged_division_of interval[a,b] /\ 1 <= i /\ i <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> (f x)$i <= (g x)$i) + ==> vsum p (\(x,k). content k % f x)$i <= + vsum p (\(x,k). content k % g x)$i`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_COMPONENT] THEN + MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FORALL_PAIR_THM; VECTOR_MUL_COMPONENT] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + ASM_MESON_TAC[SUBSET; REAL_LE_LMUL; CONTENT_POS_LE]);; + +let HAS_INTEGRAL_COMPONENT_LE = prove + (`!f:real^M->real^N g:real^M->real^N s i j k. + 1 <= k /\ k <= dimindex(:N) /\ + (f has_integral i) s /\ (g has_integral j) s /\ + (!x. x IN s ==> (f x)$k <= (g x)$k) + ==> i$k <= j$k`, + SUBGOAL_THEN + `!f:real^M->real^N g:real^M->real^N a b i j k. + 1 <= k /\ k <= dimindex(:N) /\ + (f has_integral i) (interval[a,b]) /\ + (g has_integral j) (interval[a,b]) /\ + (!x. x IN interval[a,b] ==> (f x)$k <= (g x)$k) + ==> i$k <= j$k` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < i - j) ==> i <= j`) THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `((i:real^N)$k - (j:real^N)$k) / &3` o + GEN_REWRITE_RULE I [has_integral])) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?p. p tagged_division_of interval[a:real^M,b] /\ + d1 fine p /\ d2 fine p` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM FINE_INTER] THEN MATCH_MP_TAC FINE_DIVISION_EXISTS THEN + ASM_SIMP_TAC[GAUGE_INTER]; + ALL_TAC] THEN + REPEAT + (FIRST_X_ASSUM(MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + DISCH_THEN(MP_TAC o SPEC `k:num` o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT]) THEN + SUBGOAL_THEN + `vsum p (\(x,l:real^M->bool). content l % (f:real^M->real^N) x)$k <= + vsum p (\(x,l). content l % (g:real^M->real^N) x)$k` + MP_TAC THENL + [MATCH_MP_TAC RSUM_COMPONENT_LE THEN ASM_MESON_TAC[]; + UNDISCH_TAC `&0 < (i:real^N)$k - (j:real^N)$k` THEN + SPEC_TAC(`vsum p (\(x:real^M,l:real^M->bool). + content l % (f x):real^N)$k`, + `fs:real`) THEN + SPEC_TAC(`vsum p (\(x:real^M,l:real^M->bool). + content l % (g x):real^N)$k`, + `gs:real`) THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC + `((i:real^N)$k - (j:real^N)$k) / &2`)) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC + `ball(vec 0,B1) UNION ball(vec 0:real^M,B2)` + BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[BOUNDED_UNION; BOUNDED_BALL; UNION_SUBSET; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(z:real^N)$k <= (w:real^N)$k` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(\x. if x IN s then f x else vec 0):real^M->real^N`; + `(\x. if x IN s then g x else vec 0):real^M->real^N`; + `a:real^M`; `b:real^M`] THEN + ASM_MESON_TAC[REAL_LE_REFL]; + MP_TAC(ISPECL [`w - j:real^N`; `k:num`] COMPONENT_LE_NORM) THEN + MP_TAC(ISPECL [`z - i:real^N`; `k:num`] COMPONENT_LE_NORM) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; ASSUME `1 <= k`; + ASSUME `k <= dimindex(:N)`] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN + NORM_ARITH_TAC]);; + +let INTEGRAL_COMPONENT_LE = prove + (`!f:real^M->real^N g:real^M->real^N s k. + 1 <= k /\ k <= dimindex(:N) /\ + f integrable_on s /\ g integrable_on s /\ + (!x. x IN s ==> (f x)$k <= (g x)$k) + ==> (integral s f)$k <= (integral s g)$k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_DROP_LE = prove + (`!f:real^M->real^1 g:real^M->real^1 s i j. + (f has_integral i) s /\ (g has_integral j) s /\ + (!x. x IN s ==> drop(f x) <= drop(g x)) + ==> drop i <= drop j`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; + +let INTEGRAL_DROP_LE = prove + (`!f:real^M->real^1 g:real^M->real^1 s. + f integrable_on s /\ g integrable_on s /\ + (!x. x IN s ==> drop(f x) <= drop(g x)) + ==> drop(integral s f) <= drop(integral s g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_LE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_COMPONENT_POS = prove + (`!f:real^M->real^N s i k. + 1 <= k /\ k <= dimindex(:N) /\ + (f has_integral i) s /\ + (!x. x IN s ==> &0 <= (f x)$k) + ==> &0 <= i$k`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\x. vec 0):real^M->real^N`; `f:real^M->real^N`; + `s:real^M->bool`; `vec 0:real^N`; + `i:real^N`; `k:num`] HAS_INTEGRAL_COMPONENT_LE) THEN + ASM_SIMP_TAC[VEC_COMPONENT; HAS_INTEGRAL_0]);; + +let INTEGRAL_COMPONENT_POS = prove + (`!f:real^M->real^N s k. + 1 <= k /\ k <= dimindex(:N) /\ + f integrable_on s /\ + (!x. x IN s ==> &0 <= (f x)$k) + ==> &0 <= (integral s f)$k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_POS THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_DROP_POS = prove + (`!f:real^M->real^1 s i. + (f has_integral i) s /\ + (!x. x IN s ==> &0 <= drop(f x)) + ==> &0 <= drop i`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_POS THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; + +let INTEGRAL_DROP_POS = prove + (`!f:real^M->real^1 s. + f integrable_on s /\ + (!x. x IN s ==> &0 <= drop(f x)) + ==> &0 <= drop(integral s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_COMPONENT_NEG = prove + (`!f:real^M->real^N s i k. + 1 <= k /\ k <= dimindex(:N) /\ + (f has_integral i) s /\ + (!x. x IN s ==> (f x)$k <= &0) + ==> i$k <= &0`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(\x. vec 0):real^M->real^N`; + `s:real^M->bool`; `i:real^N`; `vec 0:real^N`; + `k:num`] HAS_INTEGRAL_COMPONENT_LE) THEN + ASM_SIMP_TAC[VEC_COMPONENT; HAS_INTEGRAL_0]);; + +let HAS_INTEGRAL_DROP_NEG = prove + (`!f:real^M->real^1 s i. + (f has_integral i) s /\ + (!x. x IN s ==> drop(f x) <= &0) + ==> drop i <= &0`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_NEG THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; + +let HAS_INTEGRAL_COMPONENT_LBOUND = prove + (`!f:real^M->real^N a b i k. + (f has_integral i) (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> B <= f(x)$k) + ==> B * content(interval[a,b]) <= i$k`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\x. lambda i. B):real^M->real^N`; `f:real^M->real^N`; + `interval[a:real^M,b]`; + `content(interval[a:real^M,b]) % (lambda i. B):real^N`; + `i:real^N`; `k:num`] + HAS_INTEGRAL_COMPONENT_LE) THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; HAS_INTEGRAL_CONST] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let HAS_INTEGRAL_COMPONENT_UBOUND = prove + (`!f:real^M->real^N a b i k. + (f has_integral i) (interval[a,b]) /\ 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> f(x)$k <= B) + ==> i$k <= B * content(interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(\x. lambda i. B):real^M->real^N`; + `interval[a:real^M,b]`; `i:real^N`; + `content(interval[a:real^M,b]) % (lambda i. B):real^N`; + `k:num`] + HAS_INTEGRAL_COMPONENT_LE) THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; HAS_INTEGRAL_CONST] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let INTEGRAL_COMPONENT_LBOUND = prove + (`!f:real^M->real^N a b k. + f integrable_on interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> B <= f(x)$k) + ==> B * content(interval[a,b]) <= (integral(interval[a,b]) f)$k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LBOUND THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +let INTEGRAL_COMPONENT_UBOUND = prove + (`!f:real^M->real^N a b k. + f integrable_on interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN interval[a,b] ==> f(x)$k <= B) + ==> (integral(interval[a,b]) f)$k <= B * content(interval[a,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_UBOUND THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +(* ------------------------------------------------------------------------- *) +(* Uniform limit of integrable functions is integrable. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_UNIFORM_LIMIT = prove + (`!f a b. (!e. &0 < e + ==> ?g. (!x. x IN interval[a,b] ==> norm(f x - g x) <= e) /\ + g integrable_on interval[a,b] ) + ==> (f:real^M->real^N) integrable_on interval[a,b]`, + let lemma = prove + (`x <= norm(a + b) + c ==> x <= norm(a) + norm(b) + c`, + MESON_TAC[REAL_ADD_AC; NORM_TRIANGLE; REAL_LE_TRANS; REAL_LE_RADD]) in + let (lemma1,lemma2) = (CONJ_PAIR o prove) + (`(norm(s2 - s1) <= e / &2 /\ + norm(s1 - i1) < e / &4 /\ norm(s2 - i2) < e / &4 + ==> norm(i1 - i2) < e) /\ + (norm(sf - sg) <= e / &3 + ==> norm(i - s) < e / &3 ==> norm(sg - i) < e / &3 ==> norm(sf - s) < e)`, + CONJ_TAC THENL + [REWRITE_TAC[CONJ_ASSOC] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [NORM_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `w <= x + y + z + &0 + ==> (x <= e / &2 /\ y < e / &4) /\ z < e / &4 ==> w < e`); + MATCH_MP_TAC(REAL_ARITH + `w <= x + y + z + &0 + ==> x <= e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`)] THEN + REPEAT(MATCH_MP_TAC lemma) THEN REWRITE_TAC[REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `&0 < content(interval[a:real^M,b])` THENL + [ALL_TAC; + ASM_MESON_TAC[HAS_INTEGRAL_NULL; CONTENT_LT_NZ; integrable_on]] THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM; integrable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` (CONJUNCTS_THEN2 + ASSUME_TAC (X_CHOOSE_TAC `i:num->real^N`))) THEN + SUBGOAL_THEN `cauchy(i:num->real^N)` MP_TAC THENL + [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e / &4 / content(interval[a:real^M,b])` + REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REWRITE_TAC[GE] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [has_integral]) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `m:num` th) THEN + MP_TAC(SPEC `n:num` th)) THEN + DISCH_THEN(X_CHOOSE_THEN `gn:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `gm:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(\x. gm(x) INTER gn(x)):real^M->real^M->bool`; + `a:real^M`; `b:real^M`] FINE_DIVISION_EXISTS) THEN + ASM_SIMP_TAC[GAUGE_INTER; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`)) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[CONV_RULE(REWR_CONV FINE_INTER) th]) THEN + SUBGOAL_THEN `norm(vsum p (\(x,k:real^M->bool). content k % g (n:num) x) - + vsum p (\(x:real^M,k). content k % g m x :real^N)) + <= e / &2` + MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[dist] THEN MESON_TAC[lemma1]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 / &N * content(interval[a:real^M,b])` THEN CONJ_TAC THENL + [MATCH_MP_TAC RSUM_DIFF_BOUND; + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + ASM_REAL_ARITH_TAC] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`n:num`; `x:real^M`] th) THEN + MP_TAC(SPECL [`m:num`; `x:real^M`] th)) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [NORM_SUB] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_ADD2) THEN + DISCH_THEN(MP_TAC o MATCH_MP NORM_TRIANGLE_LE) THEN + MATCH_MP_TAC(REAL_ARITH `u = v /\ a <= inv(x) /\ b <= inv(x) ==> + u <= a + b ==> v <= &2 / x`) THEN + CONJ_TAC THENL [AP_TERM_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `s:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3` o GEN_REWRITE_RULE I + [LIM_SEQUENTIALLY]) THEN + ASM_SIMP_TAC[dist; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + MP_TAC(SPEC `e / &3 / content(interval[a:real^M,b])` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [has_integral]) THEN + DISCH_THEN(MP_TAC o SPECL [`N1 + N2:num`; `e / &3`]) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N1:num <= N1 + N2`)) THEN + MATCH_MP_TAC lemma2 THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(N1 + N2) + &1) * content(interval[a:real^M,b])` THEN + CONJ_TAC THENL + [MATCH_MP_TAC RSUM_DIFF_BOUND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a ==> y <= x ==> y <= a`)) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Negligible sets. *) +(* ------------------------------------------------------------------------- *) + +let indicator = new_definition + `indicator s :real^M->real^1 = \x. if x IN s then vec 1 else vec 0`;; + +let DROP_INDICATOR = prove + (`!s x. drop(indicator s x) = if x IN s then &1 else &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC]);; + +let DROP_INDICATOR_POS_LE = prove + (`!s x. &0 <= drop(indicator s x)`, + REWRITE_TAC[DROP_INDICATOR] THEN REAL_ARITH_TAC);; + +let DROP_INDICATOR_LE_1 = prove + (`!s x. drop(indicator s x) <= &1`, + REWRITE_TAC[DROP_INDICATOR] THEN REAL_ARITH_TAC);; + +let DROP_INDICATOR_ABS_LE_1 = prove + (`!s x. abs(drop(indicator s x)) <= &1`, + REWRITE_TAC[DROP_INDICATOR] THEN REAL_ARITH_TAC);; + +let negligible = new_definition + `negligible s <=> !a b. (indicator s has_integral (vec 0)) (interval[a,b])`;; + +(* ------------------------------------------------------------------------- *) +(* Negligibility of hyperplane. *) +(* ------------------------------------------------------------------------- *) + +let VSUM_NONZERO_IMAGE_LEMMA = prove + (`!s f:A->B g:B->real^N a. + FINITE s /\ g(a) = vec 0 /\ + (!x y. x IN s /\ y IN s /\ f x = f y /\ ~(x = y) ==> g(f x) = vec 0) + ==> vsum {f x |x| x IN s /\ ~(f x = a)} g = + vsum s (g o f)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `FINITE {(f:A->B) x |x| x IN s /\ ~(f x = a)}` + ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (f:A->B) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]; + ASM_SIMP_TAC[VSUM] THEN MATCH_MP_TAC ITERATE_NONZERO_IMAGE_LEMMA THEN + ASM_REWRITE_TAC[NEUTRAL_VECTOR_ADD; MONOIDAL_VECTOR_ADD]]);; + +let INTERVAL_DOUBLESPLIT = prove + (`1 <= k /\ k <= dimindex(:N) + ==> interval[a,b] INTER {x:real^N | abs(x$k - c) <= e} = + interval[(lambda i. if i = k then max (a$k) (c - e) else a$i), + (lambda i. if i = k then min (b$k) (c + e) else b$i)]`, + REWRITE_TAC[REAL_ARITH `abs(x - c) <= e <=> x >= c - e /\ x <= c + e`] THEN + REWRITE_TAC[SET_RULE `s INTER {x | P x /\ Q x} = + (s INTER {x | Q x}) INTER {x | P x}`] THEN + SIMP_TAC[INTERVAL_SPLIT]);; + +let DIVISION_DOUBLESPLIT = prove + (`!p a b:real^N k c e. + p division_of interval[a,b] /\ 1 <= k /\ k <= dimindex(:N) + ==> {l INTER {x | abs(x$k - c) <= e} |l| + l IN p /\ ~(l INTER {x | abs(x$k - c) <= e} = {})} + division_of (interval[a,b] INTER {x | abs(x$k - c) <= e})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `c + e:real` o MATCH_MP DIVISION_SPLIT) THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + FIRST_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (TAUT + `(a /\ b /\ c) /\ d ==> d /\ b /\ c`)) THEN + DISCH_THEN(MP_TAC o CONJUNCT2 o SPEC `c - e:real` o + MATCH_MP DIVISION_SPLIT) THEN + ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT; INTERVAL_SPLIT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(x - c) <= e <=> x >= c - e /\ x <= c + e`] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN + REWRITE_TAC[UNWIND_THM2] THEN AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);; + +let CONTENT_DOUBLESPLIT = prove + (`!a b:real^N k c e. + &0 < e /\ 1 <= k /\ k <= dimindex(:N) + ==> ?d. &0 < d /\ + content(interval[a,b] INTER {x | abs(x$k - c) <= d}) < e`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `content(interval[a:real^N,b])` THEN + CONJ_TAC THENL [FIRST_X_ASSUM(K ALL_TAC o SYM); ASM_REWRITE_TAC[]] THEN + ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT] THEN MATCH_MP_TAC CONTENT_SUBSET THEN + ASM_SIMP_TAC[GSYM INTERVAL_DOUBLESPLIT] THEN SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONTENT_EQ_0]) THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < product ((1..dimindex (:N)) DELETE k) + (\i. (b:real^N)$i - (a:real^N)$i)` + ASSUME_TAC THENL + [MATCH_MP_TAC PRODUCT_POS_LT THEN + ASM_SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_DELETE; IN_NUMSEG; + REAL_SUB_LT]; + ALL_TAC] THEN + ABBREV_TAC `d = e / &3 / product ((1..dimindex (:N)) DELETE k) + (\i. (b:real^N)$i - (a:real^N)$i)` THEN + EXISTS_TAC `d:real` THEN SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_DIV THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]; + ALL_TAC] THEN + ASM_SIMP_TAC[content; INTERVAL_DOUBLESPLIT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN + SUBGOAL_THEN `1..dimindex(:N) = k INSERT ((1..dimindex(:N)) DELETE k)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DELETE; IN_DELETE] THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; REAL_LT_IMP_LE; + LAMBDA_BETA; IN_DELETE; IN_NUMSEG] THEN + SUBGOAL_THEN + `product ((1..dimindex (:N)) DELETE k) + (\j. ((lambda i. if i = k then min (b$k) (c + d) else b$i):real^N)$j - + ((lambda i. if i = k then max (a$k) (c - d) else a$i):real^N)$j) = + product ((1..dimindex (:N)) DELETE k) + (\i. (b:real^N)$i - (a:real^N)$i)` + SUBST1_TAC THENL + [MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 * d` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < d /\ &3 * d <= x ==> &2 * d < x`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "d" THEN REAL_ARITH_TAC);; + +let NEGLIGIBLE_STANDARD_HYPERPLANE = prove + (`!c k. 1 <= k /\ k <= dimindex(:N) ==> negligible {x:real^N | x$k = c}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[negligible; has_integral] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `k:num`; `c:real`; `e:real`] + CONTENT_DOUBLESPLIT) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^N. ball(x,d)` THEN ASM_SIMP_TAC[GAUGE_BALL] THEN + ABBREV_TAC `i = indicator {x:real^N | x$k = c}` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum p (\(x,l). content l % i x) = + vsum p (\(x,l). content(l INTER {x:real^N | abs(x$k - c) <= d}) % + (i:real^N->real^1) x)` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `l:real^N->bool`] THEN + DISCH_TAC THEN EXPAND_TAC "i" THEN REWRITE_TAC[indicator] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `l:real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> l SUBSET s ==> l = l INTER t`) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM; dist] THEN + UNDISCH_THEN `(x:real^N)$k = c` (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `norm(vsum p (\(x:real^N,l). + content(l INTER {x:real^N | abs(x$k - c) <= d}) % + vec 1:real^1))` THEN + CONJ_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[VSUM_REAL; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs(x) <= abs(y)`) THEN + REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM; DROP_CMUL] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE; MATCH_MP_TAC SUM_LE] THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `l:real^N->bool`] THEN STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL; MATCH_MP_TAC REAL_LE_LMUL] THEN + EXPAND_TAC "i" THEN REWRITE_TAC[DROP_VEC] THEN + REWRITE_TAC[DROP_INDICATOR_POS_LE; DROP_INDICATOR_LE_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `l:real^N->bool`] o + el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT; CONTENT_POS_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(\l. content (l INTER {x | abs (x$k - c) <= d}) % vec 1): + (real^N->bool)->real^1`; + `p:real^N#(real^N->bool)->bool`; + `interval[a:real^N,b]`] + VSUM_OVER_TAGGED_DIVISION_LEMMA) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `!x. x = &0 /\ &0 <= y /\ y <= x ==> y = &0`) THEN + EXISTS_TAC `content(interval[u:real^N,v])` THEN + CONJ_TAC THEN POP_ASSUM MP_TAC THEN REWRITE_TAC[] THEN + DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[CONTENT_POS_LE; INTERVAL_DOUBLESPLIT] THEN + MATCH_MP_TAC CONTENT_SUBSET THEN + ASM_SIMP_TAC[GSYM INTERVAL_DOUBLESPLIT] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL + [`IMAGE SND (p:real^N#(real^N->bool)->bool)`; + `\l. l INTER {x:real^N | abs (x$k - c) <= d}`; + `\l:real^N->bool. content l % vec 1 :real^1`; + `{}:real^N->bool`] VSUM_NONZERO_IMAGE_LEMMA) THEN + REWRITE_TAC[o_DEF] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_TAGGED_DIVISION) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN + REWRITE_TAC[CONTENT_EMPTY; VECTOR_MUL_LZERO] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN + X_GEN_TAC `m:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN + SIMP_TAC[INTERVAL_DOUBLESPLIT; ASSUME `1 <= k`; + ASSUME `k <= dimindex(:N)`] THEN + REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN + ASM_SIMP_TAC[GSYM INTERVAL_DOUBLESPLIT] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPECL [`interval[u:real^N,v]`; `m:real^N->bool`] o + el 2 o CONJUNCTS) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `u SUBSET s /\ u SUBSET t ==> s INTER t = {} ==> u = {}`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC + `&1 * content(interval[a,b] INTER {x:real^N | abs (x$k - c) <= d})` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_MUL_LID]] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] + DIVISION_DOUBLESPLIT)) THEN + DISCH_THEN(MP_TAC o SPECL [`k:num`; `c:real`; `d:real`]) THEN + ASM_SIMP_TAC[INTERVAL_DOUBLESPLIT] THEN DISCH_TAC THEN + MATCH_MP_TAC DSUM_BOUND THEN + ASM_SIMP_TAC[NORM_REAL; VEC_COMPONENT; DIMINDEX_1; LE_REFL] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A technical lemma about "refinement" of division. *) +(* ------------------------------------------------------------------------- *) + +let TAGGED_DIVISION_FINER = prove + (`!p a b:real^N d. p tagged_division_of interval[a,b] /\ gauge d + ==> ?q. q tagged_division_of interval[a,b] /\ d fine q /\ + !x k. (x,k) IN p /\ k SUBSET d(x) ==> (x,k) IN q`, + let lemma1 = prove + (`{k | ?x. (x,k) IN p} = IMAGE SND p`, + REWRITE_TAC[EXTENSION; EXISTS_PAIR_THM; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[]) in + SUBGOAL_THEN + `!a b:real^N d p. + FINITE p + ==> p tagged_partial_division_of interval[a,b] /\ gauge d + ==> ?q. q tagged_division_of (UNIONS {k | ?x. x,k IN p}) /\ + d fine q /\ + !x k. (x,k) IN p /\ k SUBSET d(x) ==> (x,k) IN q` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [tagged_division_of] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM)) THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[IMP_IMP]) THEN + ASM_MESON_TAC[tagged_partial_division_of]] THEN + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[SET_RULE `UNIONS {k | ?x. x,k IN {}} = {}`] THEN + EXISTS_TAC `{}:real^N#(real^N->bool)->bool` THEN + REWRITE_TAC[fine; NOT_IN_EMPTY; TAGGED_DIVISION_OF_EMPTY]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [FORALL_PAIR_THM] THEN MAP_EVERY X_GEN_TAC + [`x:real^N`; `k:real^N->bool`; `p:real^N#(real^N->bool)->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN + EXISTS_TAC `(x:real^N,k:real^N->bool) INSERT p` THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:real^N#(real^N->bool)->bool` + STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `UNIONS {l:real^N->bool | ?y:real^N. (y,l) IN (x,k) INSERT p} = + k UNION UNIONS {l | ?y. (y,l) IN p}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNION; IN_UNIONS] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INSERT; PAIR_EQ] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `?u v:real^N. k = interval[u,v]` MP_TAC THENL + [ASM_MESON_TAC[IN_INSERT; tagged_partial_division_of]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN + ASM_CASES_TAC `interval[u,v] SUBSET ((d:real^N->real^N->bool) x)` THENL + [EXISTS_TAC `{(x:real^N,interval[u:real^N,v])} UNION q1` THEN CONJ_TAC THENL + [MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC TAGGED_DIVISION_OF_SELF THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [tagged_partial_division_of]) THEN + REWRITE_TAC[IN_INSERT; PAIR_EQ] THEN MESON_TAC[]; + ALL_TAC]; + CONJ_TAC THENL + [MATCH_MP_TAC FINE_UNION THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[fine; IN_SING; PAIR_EQ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_INSERT; PAIR_EQ; IN_UNION; IN_SING] THEN + ASM_MESON_TAC[]]; + FIRST_ASSUM(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o MATCH_MP + FINE_DIVISION_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `q2:real^N#(real^N->bool)->bool` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `q2 UNION q1:real^N#(real^N->bool)->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC TAGGED_DIVISION_UNION THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[FINE_UNION] THEN + ASM_REWRITE_TAC[IN_INSERT; PAIR_EQ; IN_UNION; IN_SING] THEN + ASM_MESON_TAC[]]] THEN + (MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + REWRITE_TAC[lemma1; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [tagged_partial_division_of]) THEN + REWRITE_TAC[IN_INSERT; FINITE_INSERT; PAIR_EQ] THEN + STRIP_TAC THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; OPEN_INTERVAL]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[]));; + +(* ------------------------------------------------------------------------- *) +(* Hence the main theorem about negligible sets. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_NEGLIGIBLE = prove + (`!f:real^M->real^N s t. + negligible s /\ (!x. x IN (t DIFF s) ==> f x = vec 0) + ==> (f has_integral (vec 0)) t`, + let lemma = prove + (`!f:B->real g:A#B->real s t. + FINITE s /\ FINITE t /\ + (!x y. (x,y) IN t ==> &0 <= g(x,y)) /\ + (!y. y IN s ==> ?x. (x,y) IN t /\ f(y) <= g(x,y)) + ==> sum s f <= sum t g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN + EXISTS_TAC `SND:A#B->B` THEN + REWRITE_TAC[EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN + ASM_MESON_TAC[]) in + SUBGOAL_THEN + `!f:real^M->real^N s a b. + negligible s /\ (!x. ~(x IN s) ==> f x = vec 0) + ==> (f has_integral (vec 0)) (interval[a,b])` + ASSUME_TAC THENL + [ALL_TAC; + REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_EQ THEN + EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else vec 0` THEN + SIMP_TAC[] THEN + FIRST_X_ASSUM(CHOOSE_THEN(CHOOSE_THEN SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `vec 0:real^N` THEN + ASM_REWRITE_TAC[NORM_0; VECTOR_SUB_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[]] THEN + REWRITE_TAC[negligible; has_integral; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MAP_EVERY(fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) + [`a:real^M`; `b:real^M`] THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o + SPEC `e / &2 / ((&n + &1) * &2 pow n)`) THEN + REWRITE_TAC[real_div; REAL_MUL_POS_LT] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; + FORALL_AND_THM; ARITH; REAL_ARITH `&0 < &n + &1`; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. (d:num->real^M->real^M->bool) + (num_of_int(int_of_real(floor(norm(f x:real^N))))) x` THEN + CONJ_TAC THENL [REWRITE_TAC[gauge] THEN ASM_MESON_TAC[gauge]; ALL_TAC] THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_CASES_TAC `p:real^M#(real^M->bool)->bool = {}` THEN + ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0] THEN + MP_TAC(SPEC `sup(IMAGE (\(x,k:real^M->bool). norm((f:real^M->real^N) x)) p)` + REAL_ARCH_SIMPLE) THEN + ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MP_TAC(GEN `i:num` + (ISPECL [`p:real^M#(real^M->bool)->bool`; `a:real^M`; `b:real^M`; + `(d:num->real^M->real^M->bool) i`] + TAGGED_DIVISION_FINER)) THEN + ASM_REWRITE_TAC[SKOLEM_THM; RIGHT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->real^M#(real^M->bool)->bool` + STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `sum(0..N+1) (\i. (&i + &1) * + norm(vsum (q i) (\(x:real^M,k:real^M->bool). + content k % indicator s x)))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (0..N+1) (\i. e / &2 / &2 pow i)` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div; SUM_LMUL; GSYM REAL_POW_INV] THEN + REWRITE_TAC[SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `(e * &1 / &2) * (&1 - x) / (&1 / &2) < e <=> + &0 < e * x`] THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_ARITH `&0 < &1 / &2`]] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN + FIRST_ASSUM(ASSUME_TAC o GEN `i:num` o + MATCH_MP TAGGED_DIVISION_OF_FINITE o SPEC `i:num`) THEN + ASM_SIMP_TAC[VSUM_REAL; NORM_LIFT] THEN + REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM; DROP_CMUL] THEN + REWRITE_TAC[real_abs] THEN + SUBGOAL_THEN + `!i:num. &0 <= sum (q i) (\(x:real^M,y:real^M->bool). + content y * drop (indicator s x))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_POS_LE THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[DROP_INDICATOR_POS_LE] THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE]; + ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM SUM_LMUL] THEN + REWRITE_TAC[LAMBDA_PAIR_THM] THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> n <= x ==> n <= y`) THEN + ASM_SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN + MATCH_MP_TAC lemma THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FORALL_PAIR_THM; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL] THEN + REWRITE_TAC[DROP_INDICATOR_POS_LE] THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN ABBREV_TAC + `n = num_of_int(int_of_real(floor(norm((f:real^M->real^N) x))))` THEN + SUBGOAL_THEN `&n <= norm((f:real^M->real^N) x) /\ + norm(f x) < &n + &1` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `&n = floor(norm((f:real^M->real^N) x))` + (fun th -> MESON_TAC[th; FLOOR]) THEN + EXPAND_TAC "n" THEN + MP_TAC(ISPEC `norm((f:real^M->real^N) x)` FLOOR_POS) THEN + REWRITE_TAC[NORM_POS_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM int_of_num; NUM_OF_INT_OF_NUM]; + ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm((f:real^M->real^N) x)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x <= n ==> x <= n + &1`) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_SIMP_TAC[indicator] THEN + REWRITE_TAC[DROP_VEC; REAL_MUL_RZERO; NORM_0; + VECTOR_MUL_RZERO; REAL_LE_REFL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[DROP_VEC; REAL_MUL_RID; NORM_MUL] THEN + SUBGOAL_THEN `&0 <= content(k:real^M->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE]; ALL_TAC] THEN + ASM_REWRITE_TAC[real_abs] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]);; + +let HAS_INTEGRAL_SPIKE = prove + (`!f:real^M->real^N g s t. + negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ + (f has_integral y) t + ==> (g has_integral y) t`, + SUBGOAL_THEN + `!f:real^M->real^N g s a b y. + negligible s /\ (!x. x IN (interval[a,b] DIFF s) ==> g x = f x) + ==> (f has_integral y) (interval[a,b]) + ==> (g has_integral y) (interval[a,b])` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\x. (f:real^M->real^N)(x) + (g(x) - f(x))) has_integral (y + vec 0)) + (interval[a,b])` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[VECTOR_ARITH `f + g - f = g /\ f + vec 0 = f`; ETA_AX]] THEN + MATCH_MP_TAC HAS_INTEGRAL_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[has_integral_alt] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(CHOOSE_THEN(CHOOSE_THEN SUBST_ALL_TAC)) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let HAS_INTEGRAL_SPIKE_EQ = prove + (`!f:real^M->real^N g s t y. + negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> ((f has_integral y) t <=> (g has_integral y) t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[NORM_SUB]);; + +let INTEGRABLE_SPIKE = prove + (`!f:real^M->real^N g s t. + negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> f integrable_on t ==> g integrable_on t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE) THEN ASM_REWRITE_TAC[]);; + +let INTEGRABLE_SPIKE_EQ = prove + (`!f:real^M->real^N g s t. + negligible s /\ (!x. x IN t DIFF s ==> g x = f x) + ==> (f integrable_on t <=> g integrable_on t)`, + MESON_TAC[INTEGRABLE_SPIKE]);; + +let INTEGRAL_SPIKE = prove + (`!f:real^M->real^N g s t y. + negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> integral t f = integral t g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN + AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some other trivialities about negligible sets. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_SUBSET = prove + (`!s:real^N->bool t:real^N->bool. + negligible s /\ t SUBSET s ==> negligible t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[negligible] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC [`(\x. vec 0):real^N->real^1`; `s:real^N->bool`] THEN + ASM_REWRITE_TAC[HAS_INTEGRAL_0] THEN + REWRITE_TAC[indicator] THEN ASM SET_TAC[]);; + +let NEGLIGIBLE_DIFF = prove + (`!s t:real^N->bool. negligible s ==> negligible(s DIFF t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_DIFF]);; + +let NEGLIGIBLE_INTER = prove + (`!s t. negligible s \/ negligible t ==> negligible(s INTER t)`, + MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]);; + +let NEGLIGIBLE_UNION = prove + (`!s t:real^N->bool. + negligible s /\ negligible t ==> negligible (s UNION t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MP_TAC THEN + REWRITE_TAC[negligible; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:real^N` THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN + REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[indicator; IN_UNION; IN_DIFF; VECTOR_ADD_LID]);; + +let NEGLIGIBLE_UNION_EQ = prove + (`!s t:real^N->bool. + negligible (s UNION t) <=> negligible s /\ negligible t`, + MESON_TAC[NEGLIGIBLE_UNION; SUBSET_UNION; NEGLIGIBLE_SUBSET]);; + +let NEGLIGIBLE_SING = prove + (`!a:real^N. negligible {a}`, + GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x | (x:real^N)$1 = (a:real^N)$1}` THEN + SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; LE_REFL; DIMINDEX_GE_1] THEN + SET_TAC[]);; + +let NEGLIGIBLE_INSERT = prove + (`!a:real^N s. negligible(a INSERT s) <=> negligible s`, + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_SING]);; + +let NEGLIGIBLE_EMPTY = prove + (`negligible {}`, + MESON_TAC[EMPTY_SUBSET; NEGLIGIBLE_SUBSET; NEGLIGIBLE_SING]);; + +let NEGLIGIBLE_FINITE = prove + (`!s. FINITE s ==> negligible s`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NEGLIGIBLE_EMPTY; NEGLIGIBLE_INSERT]);; + +let NEGLIGIBLE_UNIONS = prove + (`!s. FINITE s /\ (!t. t IN s ==> negligible t) + ==> negligible(UNIONS s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NEGLIGIBLE_EMPTY; IN_INSERT] THEN + SIMP_TAC[NEGLIGIBLE_UNION]);; + +let NEGLIGIBLE = prove + (`!s:real^N->bool. negligible s <=> !t. (indicator s has_integral vec 0) t`, + GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; REWRITE_TAC[negligible] THEN SIMP_TAC[]] THEN + DISCH_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[has_integral_alt] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[negligible]; ALL_TAC] THEN + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `vec 0:real^1` THEN + MP_TAC(ISPECL [`s:real^N->bool`; `s INTER t:real^N->bool`] + NEGLIGIBLE_SUBSET) THEN + ASM_REWRITE_TAC[INTER_SUBSET; negligible; VECTOR_SUB_REFL; NORM_0] THEN + REWRITE_TAC[indicator; IN_INTER] THEN + SIMP_TAC[TAUT `(if p /\ q then r else s) = + (if q then if p then r else s else s)`]);; + +(* ------------------------------------------------------------------------- *) +(* Finite or empty cases of the spike theorem are quite commonly needed. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_SPIKE_FINITE = prove + (`!f:real^M->real^N g s t y. + FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ + (f has_integral y) t + ==> (g has_integral y) t`, + MESON_TAC[HAS_INTEGRAL_SPIKE; NEGLIGIBLE_FINITE]);; + +let HAS_INTEGRAL_SPIKE_FINITE_EQ = prove + (`!f:real^M->real^N g s y. + FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> ((f has_integral y) t <=> (g has_integral y) t)`, + MESON_TAC[HAS_INTEGRAL_SPIKE_FINITE]);; + +let INTEGRABLE_SPIKE_FINITE = prove + (`!f:real^M->real^N g s. + FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> f integrable_on t + ==> g integrable_on t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE_FINITE) THEN ASM_REWRITE_TAC[]);; + +let INTEGRAL_EQ = prove + (`!f:real^M->real^N g s. + (!x. x IN s ==> f x = g x) ==> integral s f = integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{}:real^M->bool` THEN ASM_SIMP_TAC[NEGLIGIBLE_EMPTY; IN_DIFF]);; + +let INTEGRAL_EQ_0 = prove + (`!f:real^M->real^N s. (!x. x IN s ==> f x = vec 0) ==> integral s f = vec 0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral s ((\x. vec 0):real^M->real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRAL_0]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, the boundary of an interval is negligible. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_FRONTIER_INTERVAL = prove + (`!a b:real^N. negligible(interval[a,b] DIFF interval(a,b))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `UNIONS (IMAGE (\k. {x:real^N | x$k = (a:real^N)$k} UNION + {x:real^N | x$k = (b:real^N)$k}) + (1..dimindex(:N)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN + SIMP_TAC[IN_NUMSEG; NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_STANDARD_HYPERPLANE]; + REWRITE_TAC[SUBSET; IN_DIFF; IN_INTERVAL; IN_UNIONS; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG; IN_UNION; IN_ELIM_THM; REAL_LT_LE] THEN + MESON_TAC[]]);; + +let HAS_INTEGRAL_SPIKE_INTERIOR = prove + (`!f:real^M->real^N g a b y. + (!x. x IN interval(a,b) ==> g x = f x) /\ + (f has_integral y) (interval[a,b]) + ==> (g has_integral y) (interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE) THEN + EXISTS_TAC `interval[a:real^M,b] DIFF interval(a,b)` THEN + REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN ASM SET_TAC[]);; + +let HAS_INTEGRAL_SPIKE_INTERIOR_EQ = prove + (`!f:real^M->real^N g a b y. + (!x. x IN interval(a,b) ==> g x = f x) + ==> ((f has_integral y) (interval[a,b]) <=> + (g has_integral y) (interval[a,b]))`, + MESON_TAC[HAS_INTEGRAL_SPIKE_INTERIOR]);; + +let INTEGRABLE_SPIKE_INTERIOR = prove + (`!f:real^M->real^N g a b. + (!x. x IN interval(a,b) ==> g x = f x) + ==> f integrable_on (interval[a,b]) + ==> g integrable_on (interval[a,b])`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MP_TAC(SPEC_ALL HAS_INTEGRAL_SPIKE_INTERIOR) THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Integrability of continuous functions. *) +(* ------------------------------------------------------------------------- *) + +let NEUTRAL_AND = prove + (`neutral(/\) = T`, + REWRITE_TAC[neutral; FORALL_BOOL_THM] THEN MESON_TAC[]);; + +let MONOIDAL_AND = prove + (`monoidal(/\)`, + REWRITE_TAC[monoidal; NEUTRAL_AND; CONJ_ACI]);; + +let ITERATE_AND = prove + (`!p s. FINITE s ==> (iterate(/\) s p <=> !x. x IN s ==> p x)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[MONOIDAL_AND; NEUTRAL_AND; ITERATE_CLAUSES] THEN SET_TAC[]);; + +let OPERATIVE_DIVISION_AND = prove + (`!P d a b. operative(/\) P /\ d division_of interval[a,b] + ==> ((!i. i IN d ==> P i) <=> P(interval[a,b]))`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o CONJ MONOIDAL_AND) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_DIVISION) THEN + ASM_MESON_TAC[ITERATE_AND; DIVISION_OF_FINITE]);; + +let OPERATIVE_APPROXIMABLE = prove + (`!f:real^M->real^N e. + &0 <= e + ==> operative(/\) + (\i. ?g. (!x. x IN i ==> norm (f x - g x) <= e) /\ + g integrable_on i)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[operative; NEUTRAL_AND] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; integrable_on] THEN + ASM_MESON_TAC[HAS_INTEGRAL_NULL]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`; `c:real`; `k:num`] THEN + STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_SPLIT; IN_INTER]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `g1:real^M->real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `g2:real^M->real^N` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\x. if x$k = c then (f:real^M->real^N)(x) else + if x$k <= c then g1(x) else g2(x)` THEN + CONJ_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER; IN_ELIM_THM]) THEN + ASM_MESON_TAC[REAL_ARITH `x <= c \/ x >= c`]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^M. if x$k = c then f x else if x$k <= c then g1 x else g2 x) + integrable_on (interval[u,v] INTER {x | x$k <= c}) /\ + (\x. if x$k = c then f x :real^N else if x$k <= c then g1 x else g2 x) + integrable_on (interval[u,v] INTER {x | x$k >= c})` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[integrable_on] THEN ASM_MESON_TAC[HAS_INTEGRAL_SPLIT]] THEN + CONJ_TAC THENL + [UNDISCH_TAC + `(g1:real^M->real^N) integrable_on (interval[u,v] INTER {x | x$k <= c})`; + UNDISCH_TAC + `(g2:real^M->real^N) integrable_on (interval[u,v] INTER {x | x$k >= c})` + ] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN + ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN + EXISTS_TAC `{x:real^M | x$k = c}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; IN_DIFF; IN_INTER; IN_ELIM_THM; + REAL_ARITH `x >= c /\ ~(x = c) ==> ~(x <= c)`] THEN + EXISTS_TAC `e:real` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]);; + +let APPROXIMABLE_ON_DIVISION = prove + (`!f:real^M->real^N d a b. + &0 <= e /\ + (d division_of interval[a,b]) /\ + (!i. i IN d + ==> ?g. (!x. x IN i ==> norm (f x - g x) <= e) /\ + g integrable_on i) + ==> ?g. (!x. x IN interval[a,b] ==> norm (f x - g x) <= e) /\ + g integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(/\)`; `d:(real^M->bool)->bool`; + `a:real^M`; `b:real^M`; + `\i. ?g:real^M->real^N. + (!x. x IN i ==> norm (f x - g x) <= e) /\ + g integrable_on i`] + OPERATIVE_DIVISION) THEN + ASM_SIMP_TAC[OPERATIVE_APPROXIMABLE; MONOIDAL_AND] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[ITERATE_AND]);; + +let INTEGRABLE_CONTINUOUS = prove + (`!f:real^M->real^N a b. + f continuous_on interval[a,b] ==> f integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MATCH_MP_TAC APPROXIMABLE_ON_DIVISION THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPACT_UNIFORMLY_CONTINUOUS)) THEN + REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?p. p tagged_division_of interval[a:real^M,b] /\ (\x. ball(x,d)) fine p` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[FINE_DIVISION_EXISTS; GAUGE_BALL]; ALL_TAC] THEN + EXISTS_TAC `IMAGE SND (p:real^M#(real^M->bool)->bool)` THEN + ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN + DISCH_TAC THEN EXISTS_TAC `\y:real^M. (f:real^M->real^N) x` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + DISCH_THEN(MP_TAC o + SPECL [`x:real^M`; `l:real^M->bool`] o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[SUBSET] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + REWRITE_TAC[SUBSET; IN_BALL; dist] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[REAL_LT_IMP_LE; NORM_SUB]; + REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `content(interval[a':real^M,b']) % (f:real^M->real^N) x` THEN + REWRITE_TAC[HAS_INTEGRAL_CONST]]);; + +(* ------------------------------------------------------------------------- *) +(* Specialization of additivity to one dimension. *) +(* ------------------------------------------------------------------------- *) + +let OPERATIVE_1_LT = prove + (`!op. monoidal op + ==> !f. operative op f <=> + (!a b. drop b <= drop a ==> f(interval[a,b]) = neutral op) /\ + (!a b c. drop a < drop c /\ drop c < drop b + ==> op (f(interval[a,c])) (f(interval[c,b])) = + f(interval[a,b]))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[operative; CONTENT_EQ_0_1] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_TAC THEN REWRITE_TAC[FORALL_1; DIMINDEX_1] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^1` THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `b:real^1` THEN + EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `c:real^1` THEN FIRST_ASSUM(SUBST1_TAC o SPEC `drop c`) THEN + DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; DIMINDEX_1; LE_REFL; REAL_LT_IMP_LE] THEN + BINOP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ] THEN + SIMP_TAC[FORALL_1; CART_EQ; DIMINDEX_1; LAMBDA_BETA; LE_REFL] THEN + REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `d:real` THEN ABBREV_TAC `c = lift d` THEN + SUBGOAL_THEN `d = drop c` SUBST1_TAC THENL + [ASM_MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + SIMP_TAC[INTERVAL_SPLIT; LE_REFL; drop; DIMINDEX_1] THEN + REWRITE_TAC[GSYM drop] THEN + DISJ_CASES_TAC(REAL_ARITH `drop c <= drop a \/ drop a < drop c`) THENL + [SUBGOAL_THEN + `content(interval[a:real^1, + (lambda i. if i = 1 then min (drop b) (drop c) else b$i)]) = &0 /\ + interval[(lambda i. if i = 1 then max (drop a) (drop c) else a$i),b] = + interval[a,b]` + (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THENL + [CONJ_TAC THENL + [SIMP_TAC[CONTENT_EQ_0_1]; + AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ]] THEN + SIMP_TAC[drop; CART_EQ; FORALL_1; LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN + UNDISCH_TAC `drop c <= drop a` THEN REWRITE_TAC[drop] THEN + REAL_ARITH_TAC; + REWRITE_TAC[CONTENT_EQ_0_1] THEN + DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN ASM_MESON_TAC[monoidal]]; + ALL_TAC] THEN + DISJ_CASES_TAC(REAL_ARITH `drop b <= drop c \/ drop c < drop b`) THENL + [SUBGOAL_THEN + `interval[a,(lambda i. if i = 1 then min (drop b) (drop c) else b$i)] = + interval[a,b] /\ + content(interval + [(lambda i. if i = 1 then max (drop a) (drop c) else a$i),b]) = &0` + (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC) THENL + [CONJ_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[CONS_11; PAIR_EQ]; + SIMP_TAC[CONTENT_EQ_0_1]] THEN + SIMP_TAC[drop; CART_EQ; FORALL_1; LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN + UNDISCH_TAC `drop b <= drop c` THEN REWRITE_TAC[drop] THEN + REAL_ARITH_TAC; + REWRITE_TAC[CONTENT_EQ_0_1] THEN + DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN ASM_MESON_TAC[monoidal]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(lambda i. if i = 1 then min (drop b) (drop c) else b$i) = c /\ + (lambda i. if i = 1 then max (drop a) (drop c) else a$i) = c` + (fun th -> REWRITE_TAC[th] THEN ASM_MESON_TAC[]) THEN + SIMP_TAC[CART_EQ; FORALL_1; DIMINDEX_1; LE_REFL; LAMBDA_BETA] THEN + REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC);; + +let OPERATIVE_1_LE = prove + (`!op. monoidal op + ==> !f. operative op f <=> + (!a b. drop b <= drop a ==> f(interval[a,b]) = neutral op) /\ + (!a b c. drop a <= drop c /\ drop c <= drop b + ==> op (f(interval[a,c])) (f(interval[c,b])) = + f(interval[a,b]))`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[OPERATIVE_1_LT] THEN MESON_TAC[REAL_LT_IMP_LE]] THEN + REWRITE_TAC[operative; CONTENT_EQ_0_1] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_1; DIMINDEX_1] THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) + [`a:real^1`; `b:real^1`] THEN DISCH_TAC THEN + X_GEN_TAC `c:real^1` THEN FIRST_ASSUM(SUBST1_TAC o SPEC `drop c`) THEN + DISCH_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LE_TRANS) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; DIMINDEX_1; LE_REFL] THEN + BINOP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ] THEN + SIMP_TAC[FORALL_1; CART_EQ; DIMINDEX_1; LAMBDA_BETA; LE_REFL] THEN + REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Special case of additivity we need for the FCT. *) +(* ------------------------------------------------------------------------- *) + +let ADDITIVE_TAGGED_DIVISION_1 = prove + (`!f:real^1->real^N p a b. + drop a <= drop b /\ + p tagged_division_of interval[a,b] + ==> vsum p + (\(x,k). f(interval_upperbound k) - f(interval_lowerbound k)) = + f b - f a`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(+):real^N->real^N->real^N`; + `p:(real^1#(real^1->bool)->bool)`; + `a:real^1`; `b:real^1`; + `(\k. if k = {} then vec 0 + else f(interval_upperbound k) - f(interval_lowerbound k)): + ((real^1->bool)->real^N)`] OPERATIVE_TAGGED_DIVISION) THEN + ASM_SIMP_TAC[MONOIDAL_VECTOR_ADD; OPERATIVE_1_LT; NEUTRAL_VECTOR_ADD; + INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_ARITH `a <= b ==> ~(b < a)`; + REAL_LT_IMP_LE; CONTENT_EQ_0_1; + INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + SIMP_TAC[REAL_ARITH `b <= a ==> (b < a <=> ~(b = a))`] THEN + SIMP_TAC[DROP_EQ; TAUT + `(if ~p then x else y) = (if p then y else x)`] THEN + SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; REAL_LE_REFL] THEN + REWRITE_TAC[VECTOR_SUB_REFL; COND_ID; EQ_SYM_EQ] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_LT_TRANS) THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; + REAL_ARITH `b < a ==> ~(a < b)`; REAL_LT_IMP_LE] THEN + MESON_TAC[VECTOR_ARITH `(c - a) + (b - c):real^N = b - a`]; + ALL_TAC] THEN + ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; GSYM REAL_NOT_LE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM VSUM] THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF; MEMBER_NOT_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* A useful lemma allowing us to factor out the content size. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_FACTOR_CONTENT = prove + (`!f:real^M->real^N i a b. + (f has_integral i) (interval[a,b]) <=> + (!e. &0 < e + ==> ?d. gauge d /\ + (!p. p tagged_division_of interval[a,b] /\ d fine p + ==> norm (vsum p (\(x,k). content k % f x) - i) + <= e * content(interval[a,b])))`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THENL + [MP_TAC(SPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] + VSUM_CONTENT_NULL) THEN + ASM_SIMP_TAC[HAS_INTEGRAL_NULL_EQ; VECTOR_SUB_LZERO; NORM_NEG] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; NORM_LE_0] THEN + ASM_MESON_TAC[FINE_DIVISION_EXISTS; GAUGE_TRIVIAL; REAL_LT_01]; + ALL_TAC] THEN + REWRITE_TAC[has_integral] THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `e * content(interval[a:real^M,b])`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; CONTENT_LT_NZ] THEN MESON_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / content(interval[a:real^M,b])`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; CONTENT_LT_NZ; REAL_OF_NUM_LT; ARITH] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL] THEN + ASM_MESON_TAC[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`]);; + +(* ------------------------------------------------------------------------- *) +(* Attempt a systematic general set of "offset" results for components. *) +(* ------------------------------------------------------------------------- *) + +let GAUGE_MODIFY = prove + (`!f:real^M->real^N. + (!s. open s ==> open {x | f(x) IN s}) + ==> !d. gauge d ==> gauge (\x y. d (f x) (f y))`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + SIMP_TAC[gauge; IN] THEN DISCH_TAC THEN + X_GEN_TAC `x:real^M` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[IN]);; + +(* ------------------------------------------------------------------------- *) +(* Integrabibility on subintervals. *) +(* ------------------------------------------------------------------------- *) + +let OPERATIVE_INTEGRABLE = prove + (`!f. operative (/\) (\i. f integrable_on i)`, + GEN_TAC THEN REWRITE_TAC[operative; NEUTRAL_AND] THEN CONJ_TAC THENL + [REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_NULL_EQ]; + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[INTEGRABLE_SPLIT] THEN + REWRITE_TAC[integrable_on] THEN ASM_MESON_TAC[HAS_INTEGRAL_SPLIT]]);; + +let INTEGRABLE_SUBINTERVAL = prove + (`!f:real^M->real^N a b c d. + f integrable_on interval[a,b] /\ + interval[c,d] SUBSET interval[a,b] + ==> f integrable_on interval[c,d]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[c:real^M,d] = {}` THENL + [ASM_REWRITE_TAC[integrable_on] THEN + MESON_TAC[HAS_INTEGRAL_NULL; CONTENT_EMPTY; EMPTY_AS_INTERVAL]; + ASM_MESON_TAC[OPERATIVE_INTEGRABLE; OPERATIVE_DIVISION_AND; + PARTIAL_DIVISION_EXTEND_1]]);; + +(* ------------------------------------------------------------------------- *) +(* Combining adjacent intervals in 1 dimension. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_COMBINE = prove + (`!f i:real^N j a b c. + drop a <= drop c /\ drop c <= drop b /\ + (f has_integral i) (interval[a,c]) /\ + (f has_integral j) (interval[c,b]) + ==> (f has_integral (i + j)) (interval[a,b])`, + REPEAT STRIP_TAC THEN MP_TAC + ((CONJUNCT2 o GEN_REWRITE_RULE I + [MATCH_MP OPERATIVE_1_LE(MATCH_MP MONOIDAL_LIFTED MONOIDAL_VECTOR_ADD)]) + (ISPEC `f:real^1->real^N` OPERATIVE_INTEGRAL)) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`; `c:real^1`]) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[lifted; distinctness "option"; injectivity "option"]) THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL; HAS_INTEGRAL_UNIQUE; integrable_on; + INTEGRAL_UNIQUE]);; + +let INTEGRAL_COMBINE = prove + (`!f:real^1->real^N a b c. + drop a <= drop c /\ drop c <= drop b /\ f integrable_on (interval[a,b]) + ==> integral(interval[a,c]) f + integral(interval[c,b]) f = + integral(interval[a,b]) f`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN + EXISTS_TAC `c:real^1` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL]);; + +let INTEGRABLE_COMBINE = prove + (`!f a b c. + drop a <= drop c /\ drop c <= drop b /\ + f integrable_on interval[a,c] /\ + f integrable_on interval[c,b] + ==> f integrable_on interval[a,b]`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMBINE]);; + +(* ------------------------------------------------------------------------- *) +(* Reduce integrability to "local" integrability. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_ON_LITTLE_SUBINTERVALS = prove + (`!f:real^M->real^N a b. + (!x. x IN interval[a,b] + ==> ?d. &0 < d /\ + !u v. x IN interval[u,v] /\ + interval[u,v] SUBSET ball(x,d) /\ + interval[u,v] SUBSET interval[a,b] + ==> f integrable_on interval[u,v]) + ==> f integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; GAUGE_EXISTENCE_LEMMA] THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^M->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`\x:real^M. ball(x,d x)`; `a:real^M`; `b:real^M`] + FINE_DIVISION_EXISTS) THEN + ASM_SIMP_TAC[GAUGE_BALL_DEPENDENT; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] OPERATIVE_DIVISION_AND) + (ISPEC `f:real^M->real^N` OPERATIVE_INTEGRABLE)) THEN + DISCH_THEN(MP_TAC o SPECL + [`IMAGE SND (p:real^M#(real^M->bool)->bool)`; `a:real^M`; `b:real^M`]) THEN + ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o el 1 o CONJUNCTS o + GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Second FCT or existence of antiderivative. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE = prove + (`!f:real^1->real^N a b x. + f integrable_on interval[a,b] /\ x IN interval[a,b] /\ + f continuous (at x within interval[a,b]) + ==> ((\u. integral (interval [a,u]) f) has_vector_derivative f x) + (at x within interval [a,b])`, + REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN_ALT] THEN + CONJ_TAC THENL + [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN + DISJ_CASES_TAC(REAL_ARITH `drop x <= drop y \/ drop y <= drop x`) THENL + [ASM_SIMP_TAC[REAL_ARITH `x <= y ==> abs(y - x) = y - x`]; + ONCE_REWRITE_TAC[VECTOR_ARITH + `fy - fx - (x - y) % c:real^N = --(fx - fy - (y - x) % c)`] THEN + ASM_SIMP_TAC[NORM_NEG; REAL_ARITH `x <= y ==> abs(x - y) = y - x`]] THEN + ASM_SIMP_TAC[GSYM CONTENT_1] THEN MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN + EXISTS_TAC `(\u. f(u) - f(x)):real^1->real^N` THEN + (ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONJ_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[IN_INTERVAL_1; NORM_REAL; DROP_SUB; GSYM drop] THEN + REAL_ARITH_TAC] THEN + MATCH_MP_TAC HAS_INTEGRAL_SUB THEN REWRITE_TAC[HAS_INTEGRAL_CONST]) THENL + [SUBGOAL_THEN + `integral(interval[a,x]) f + integral(interval[x,y]) f = + integral(interval[a,y]) f /\ + ((f:real^1->real^N) has_integral integral(interval[x,y]) f) + (interval[x,y])` + (fun th -> MESON_TAC[th; + VECTOR_ARITH `a + b = c:real^N ==> c - a = b`]); + SUBGOAL_THEN + `integral(interval[a,y]) f + integral(interval[y,x]) f = + integral(interval[a,x]) f /\ + ((f:real^1->real^N) has_integral integral(interval[y,x]) f) + (interval[y,x])` + (fun th -> MESON_TAC[th; + VECTOR_ARITH `a + b = c:real^N ==> c - a = b`])] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_COMBINE; + MATCH_MP_TAC INTEGRABLE_INTEGRAL] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN + ASM_SIMP_TAC[INTEGRABLE_CONTINUOUS; SUBSET_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC));; + +let INTEGRAL_HAS_VECTOR_DERIVATIVE = prove + (`!f:real^1->real^N a b. + f continuous_on interval[a,b] + ==> !x. x IN interval[a,b] + ==> ((\u. integral (interval[a,u]) f) has_vector_derivative f(x)) + (at x within interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE THEN + ASM_MESON_TAC[INTEGRABLE_CONTINUOUS; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]);; + +let ANTIDERIVATIVE_CONTINUOUS = prove + (`!f:real^1->real^N a b. + f continuous_on interval[a,b] + ==> ?g. !x. x IN interval[a,b] + ==> (g has_vector_derivative f(x)) + (at x within interval[a,b])`, + MESON_TAC[INTEGRAL_HAS_VECTOR_DERIVATIVE]);; + +(* ------------------------------------------------------------------------- *) +(* General "twiddling" for interval-to-interval function image. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_TWIDDLE = prove + (`!f:real^N->real^P (g:real^M->real^N) h r i a b. + &0 < r /\ + (!x. h(g x) = x) /\ (!x. g(h x) = x) /\ (!x. g continuous at x) /\ + (!u v. ?w z. IMAGE g (interval[u,v]) = interval[w,z]) /\ + (!u v. ?w z. IMAGE h (interval[u,v]) = interval[w,z]) /\ + (!u v. content(IMAGE g (interval[u,v])) = r * content(interval[u,v])) /\ + (f has_integral i) (interval[a,b]) + ==> ((\x. f(g x)) has_integral (inv r) % i) (IMAGE h (interval[a,b]))`, + let lemma0 = prove + (`(!x k. (x,k) IN IMAGE (\(x,k). f x,g k) p ==> P x k) <=> + (!x k. (x,k) IN p ==> P (f x) (g k))`, + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]) + and lemma1 = prove + (`{k | ?x. (x,k) IN p} = IMAGE SND p`, + REWRITE_TAC[EXTENSION; EXISTS_PAIR_THM; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[]) + and lemma2 = prove + (`SND o (\(x,k). f x,g k) = g o SND`, + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM; o_DEF]) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN + ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_INTEGRAL_EMPTY_EQ; VECTOR_MUL_RZERO] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[has_integral] THEN + ASM_REWRITE_TAC[has_integral_def; has_integral_compact_interval] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e * r:real`) THEN + ASM_SIMP_TAC[REAL_LT_MUL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x y:real^M. (d:real^N->real^N->bool) (g x) (g y)` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + SIMP_TAC[gauge; IN; FORALL_AND_THM] THEN + STRIP_TAC THEN X_GEN_TAC `x:real^M` THEN + SUBGOAL_THEN `(\y:real^M. (d:real^N->real^N->bool) (g x) (g y)) = + {y | g y IN (d (g x))}` SUBST1_TAC + THENL [SET_TAC[]; ASM_SIMP_TAC[CONTINUOUS_OPEN_PREIMAGE_UNIV]]; + ALL_TAC] THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `IMAGE (\(x,k). (g:real^M->real^N) x, IMAGE g k) p`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + REWRITE_TAC[fine; lemma0] THEN + STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + ASM SET_TAC[]] THEN + SUBGOAL_THEN + `interval[a,b] = IMAGE ((g:real^M->real^N) o h) (interval[a,b])` + SUBST1_TAC THENL [SIMP_TAC[o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?u v. IMAGE (h:real^N->real^M) (interval[a,b]) = + interval[u,v]` + (REPEAT_TCL CHOOSE_THEN + (fun th -> SUBST_ALL_TAC th THEN ASSUME_TAC th)) THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + REWRITE_TAC[TAGGED_DIVISION_OF; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[lemma0] THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE]; ALL_TAC] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN + DISCH_TAC THEN + UNDISCH_TAC + `!x:real^M k. + x,k IN p + ==> x IN k /\ + k SUBSET interval[u,v] /\ + ?w z. k = interval[w,z]` THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[lemma1; GSYM IMAGE_o; lemma2] THEN + REWRITE_TAC[IMAGE_o; GSYM IMAGE_UNIONS; ETA_AX]] THEN + MAP_EVERY X_GEN_TAC [`x1:real^M`; `k1:real^M->bool`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x2:real^M`; `k2:real^M->bool`] THEN STRIP_TAC THEN + UNDISCH_TAC + `!x1:real^M k1:real^M->bool. + x1,k1 IN p + ==> (!x2 k2. + x2,k2 IN p /\ ~(x1,k1 = x2,k2) + ==> interior k1 INTER interior k2 = {})` THEN + DISCH_THEN(MP_TAC o SPECL [`x1:real^M`; `k1:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`x2:real^M`; `k2:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `interior(IMAGE f s) SUBSET IMAGE f (interior s) /\ + interior(IMAGE f t) SUBSET IMAGE f (interior t) /\ + (!x y. f x = f y ==> x = y) + ==> interior s INTER interior t = {} + ==> interior(IMAGE f s) INTER interior(IMAGE f t) = {}`) THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC INTERIOR_IMAGE_SUBSET) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) VSUM_IMAGE + (lhand(rand(lhand(lhand w)))))) THEN + ANTS_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `abs r` THEN ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs x`] THEN + REWRITE_TAC[GSYM NORM_MUL] THEN ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a * b ==> x = y ==> y < b * a`)) THEN + AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_MUL_LID; GSYM VSUM_LMUL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM; VECTOR_MUL_ASSOC] THEN + REPEAT STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of permuting the coordinates. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_TWIZZLE_INTERVAL = prove + (`!f:real^N->real^P p a b:real^M. + (f has_integral y) (interval[(lambda i. a$(p i)),(lambda i. b$(p i))]) /\ + dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) + ==> ((\x. f(lambda i. x$p i)) has_integral y) (interval[a,b])`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`f:real^N->real^P`; `(\x. lambda i. x$(p i)):real^M->real^N`; + `(\x. lambda i. x$(inverse p i)):real^N->real^M`; + `&1`; `y:real^P`; + `((\x. lambda i. x$(p i)):real^M->real^N) a`; + `((\x. lambda i. x$(p i)):real^M->real^N) b`] + HAS_INTEGRAL_TWIDDLE) THEN + REWRITE_TAC[REAL_LT_01] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PERMUTES_INVERSE) THEN + MP_TAC(SPEC `inverse p:num->num` + (INST_TYPE [`:N`,`:M`; `:M`,`:N`] IMAGE_TWIZZLE_INTERVAL)) THEN + MP_TAC(SPEC `p:num->num` IMAGE_TWIZZLE_INTERVAL) THEN + ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN + REPLICATE_TAC 2 (DISCH_THEN(fun th -> REWRITE_TAC[th])) THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; + IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; + GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; + VECTOR_ADD_COMPONENT]; + MESON_TAC[]; + MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN + SIMP_TAC[REAL_MUL_LID; CONTENT_CLOSED_INTERVAL_CASES] THEN + AP_THM_TAC THEN BINOP_TAC THENL + [IMP_REWRITE_TAC[LAMBDA_BETA] THEN + REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]; + MP_TAC(MATCH_MP PRODUCT_PERMUTE + (ASSUME `p permutes 1..dimindex(:N)`)) THEN + ASM_REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN + MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN REWRITE_TAC[o_DEF] THEN + IMP_REWRITE_TAC[LAMBDA_BETA] THEN REWRITE_TAC[] THEN + IMP_REWRITE_TAC[LAMBDA_BETA]]]; + REWRITE_TAC[o_DEF; REAL_INV_1; VECTOR_MUL_LID] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[PAIR_EQ; LAMBDA_BETA; CART_EQ] THEN + IMP_REWRITE_TAC[LAMBDA_BETA] THEN + REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of a basic affine transformation. *) +(* ------------------------------------------------------------------------- *) + +let INTERVAL_IMAGE_AFFINITY_INTERVAL = prove + (`!a b m c. ?u v. IMAGE (\x. m % x + c) (interval[a,b]) = interval[u,v]`, + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + MESON_TAC[EMPTY_AS_INTERVAL]);; + +let CONTENT_IMAGE_AFFINITY_INTERVAL = prove + (`!a b:real^N m c. + content(IMAGE (\x. m % x + c) (interval[a,b])) = + (abs m) pow (dimindex(:N)) * content(interval[a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTENT_EMPTY; REAL_MUL_RZERO] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN COND_CASES_TAC THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (lhand o rand) CONTENT_CLOSED_INTERVAL + (lhs w))) THEN + (ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + REAL_LE_RADD; REAL_LE_LMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `m * b <= m * a <=> --m * a <= --m * b`] THEN + ASM_SIMP_TAC[REAL_ARITH `~(&0 <= x) ==> &0 <= --x`; REAL_LE_LMUL]; + ALL_TAC]) THEN + DISCH_THEN SUBST1_TAC THEN + ONCE_REWRITE_TAC[GSYM PRODUCT_CONST_NUMSEG_1] THEN + ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM PRODUCT_MUL_NUMSEG] THEN + MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_NUMSEG; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + ASM_REAL_ARITH_TAC);; + +let HAS_INTEGRAL_AFFINITY = prove + (`!f:real^M->real^N i a b m c. + (f has_integral i) (interval[a,b]) /\ ~(m = &0) + ==> ((\x. f(m % x + c)) has_integral + (inv(abs(m) pow dimindex(:M)) % i)) + (IMAGE (\x. inv m % x + --(inv(m) % c)) (interval[a,b]))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_TWIDDLE THEN + ASM_SIMP_TAC[INTERVAL_IMAGE_AFFINITY_INTERVAL; GSYM REAL_ABS_NZ; + REAL_POW_LT; PRODUCT_EQ_0_NUMSEG; CONTENT_IMAGE_AFFINITY_INTERVAL] THEN + ASM_SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID; CONTINUOUS_CONST; + CONTINUOUS_ADD] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; VECTOR_MUL_RNEG] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RINV] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let INTEGRABLE_AFFINITY = prove + (`!f:real^M->real^N a b m c. + f integrable_on interval[a,b] /\ ~(m = &0) + ==> (\x. f(m % x + c)) integrable_on + (IMAGE (\x. inv m % x + --(inv(m) % c)) (interval[a,b]))`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_AFFINITY]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of stretching coordinate axes separately. *) +(* ------------------------------------------------------------------------- *) + +let CONTENT_IMAGE_STRETCH_INTERVAL = prove + (`!a b:real^N m. + content(IMAGE (\x. lambda k. m k * x$k) (interval[a,b]):real^N->bool) = + abs(product(1..dimindex(:N)) m) * content(interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[content; IMAGE_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + ASM_REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; LAMBDA_BETA; + REAL_ARITH `min a b <= max a b`] THEN + ASM_REWRITE_TAC[REAL_ARITH `max a b - min a b = abs(b - a)`; + GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[PRODUCT_MUL; FINITE_NUMSEG; + REAL_ARITH `a <= b ==> abs(b - a) = b - a`] THEN + ASM_SIMP_TAC[PRODUCT_ABS; FINITE_NUMSEG]);; + +let HAS_INTEGRAL_STRETCH = prove + (`!f:real^M->real^N i m a b. + (f has_integral i) (interval[a,b]) /\ + (!k. 1 <= k /\ k <= dimindex(:M) ==> ~(m k = &0)) + ==> ((\x:real^M. f(lambda k. m k * x$k)) has_integral + (inv(abs(product(1..dimindex(:M)) m)) % i)) + (IMAGE (\x. lambda k. inv(m k) * x$k) (interval[a,b]))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_TWIDDLE THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV; REAL_MUL_LID] THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; PRODUCT_EQ_0_NUMSEG] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + SIMP_TAC[linear; LAMBDA_BETA; CART_EQ; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC; + REWRITE_TAC[CONTENT_IMAGE_STRETCH_INTERVAL] THEN + REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]]);; + +let INTEGRABLE_STRETCH = prove + (`!f:real^M->real^N m a b. + f integrable_on interval[a,b] /\ + (!k. 1 <= k /\ k <= dimindex(:M) ==> ~(m k = &0)) + ==> (\x:real^M. f(lambda k. m k * x$k)) integrable_on + (IMAGE (\x. lambda k. inv(m k) * x$k) (interval[a,b]))`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_STRETCH]);; + +(* ------------------------------------------------------------------------- *) +(* Even more special cases. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_REFLECT_LEMMA = prove + (`!f:real^M->real^N i a b. + (f has_integral i) (interval[a,b]) + ==> ((\x. f(--x)) has_integral i) (interval[--b,--a])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o C CONJ (REAL_ARITH `~(-- &1 = &0)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^M`) THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_NEG_0] THEN + REWRITE_TAC[REAL_INV_NEG; REAL_INV_1] THEN + REWRITE_TAC[VECTOR_ARITH `-- &1 % x + vec 0 = --x`] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN POP_ASSUM(K ALL_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN + REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);; + +let HAS_INTEGRAL_REFLECT = prove + (`!f:real^M->real^N i a b. + ((\x. f(--x)) has_integral i) (interval[--b,--a]) <=> + (f has_integral i) (interval[a,b])`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_REFLECT_LEMMA) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let INTEGRABLE_REFLECT = prove + (`!f:real^M->real^N a b. + (\x. f(--x)) integrable_on (interval[--b,--a]) <=> + f integrable_on (interval[a,b])`, + REWRITE_TAC[integrable_on; HAS_INTEGRAL_REFLECT]);; + +let INTEGRAL_REFLECT = prove + (`!f:real^M->real^N a b. + integral (interval[--b,--a]) (\x. f(--x)) = + integral (interval[a,b]) f`, + REWRITE_TAC[integral; HAS_INTEGRAL_REFLECT]);; + +(* ------------------------------------------------------------------------- *) +(* Technical lemmas about how many non-trivial intervals of a division a *) +(* point can be in (we sometimes need this for bounding sums). *) +(* ------------------------------------------------------------------------- *) + +let DIVISION_COMMON_POINT_BOUND = prove + (`!d s:real^N->bool x. + d division_of s + ==> CARD {k | k IN d /\ ~(content k = &0) /\ x IN k} + <= 2 EXP (dimindex(:N))`, + let lemma = prove + (`!f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + FINITE s /\ CARD(IMAGE f s) <= n + ==> CARD(s) <= n`, + MESON_TAC[CARD_IMAGE_INJ]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!k. k IN d ==> ?a b:real^N. interval[a,b] = k` MP_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`A:(real^N->bool)->real^N`; `B:(real^N->bool)->real^N`] THEN + STRIP_TAC THEN MATCH_MP_TAC(ISPEC + `\d. (lambda i. (x:real^N)$i = (A:(real^N->bool)->real^N)(d)$i):bool^N` + lemma) THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC FINITE_RESTRICT THEN ASM_MESON_TAC[division_of]; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(:bool^N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN REWRITE_TAC[SUBSET_UNIV] THEN + SIMP_TAC[FINITE_CART_UNIV; FINITE_BOOL]; + SIMP_TAC[FINITE_BOOL; CARD_CART_UNIV; CARD_BOOL; LE_REFL]]] THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN + SIMP_TAC[IN_ELIM_THM; CART_EQ; LAMBDA_BETA] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`] o + el 2 o CONJUNCTS) THEN + ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN + MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN + MAP_EVERY UNDISCH_TAC + [`(x:real^N) IN k`; `(x:real^N) IN l`; + `~(content(k:real^N->bool) = &0)`; + `~(content(l:real^N->bool) = &0)`] THEN + SUBGOAL_THEN + `k = interval[A k:real^N,B k] /\ l = interval[A l,B l]` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [ASM_MESON_TAC[]; REWRITE_TAC[INTER_INTERVAL]] THEN + REWRITE_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL] THEN + SIMP_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND = prove + (`!p s:real^N->bool y. + p tagged_partial_division_of s + ==> CARD {(x,k) | (x,k) IN p /\ y IN k /\ ~(content k = &0)} + <= 2 EXP (dimindex(:N))`, + let lemma = prove + (`!f s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + FINITE s /\ CARD(IMAGE f s) <= n + ==> CARD(s) <= n`, + MESON_TAC[CARD_IMAGE_INJ]) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `SND` lemma) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM; PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC [`x1:real^N`; `k1:real^N->bool`] THEN + REPEAT DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x2:real^N`; `k2:real^N->bool`] THEN + REPEAT DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN + DISCH_THEN(MP_TAC o SPECL + [`x1:real^N`; `k1:real^N->bool`; `x2:real^N`; `k2:real^N->bool`] o + CONJUNCT2 o CONJUNCT2) THEN + ASM_REWRITE_TAC[PAIR_EQ] THEN + MATCH_MP_TAC(TAUT `~q ==> (~p ==> q) ==> p`) THEN + REWRITE_TAC[INTER_ACI] THEN + ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR; tagged_partial_division_of]; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `p:real^N#(real^N->bool)->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; SET_TAC[]]; + FIRST_ASSUM(MP_TAC o MATCH_MP PARTIAL_DIVISION_OF_TAGGED_DIVISION) THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N` o + MATCH_MP DIVISION_COMMON_POINT_BOUND) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN + MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM] THEN MESON_TAC[]; + MATCH_MP_TAC FINITE_RESTRICT THEN MATCH_MP_TAC FINITE_IMAGE THEN + ASM_MESON_TAC[tagged_partial_division_of]]]);; + +let TAGGED_PARTIAL_DIVISION_COMMON_TAGS = prove + (`!p s:real^N->bool x. + p tagged_partial_division_of s + ==> CARD {(x,k) | k | (x,k) IN p /\ ~(content k = &0)} + <= 2 EXP (dimindex(:N))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o + MATCH_MP TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN + MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN + ASM_MESON_TAC[tagged_partial_division_of]; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `p:real^N#(real^N->bool)->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Integrating characteristic function of an interval. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL = prove + (`!f:real^M->real^N a b c d i. + (f has_integral i) (interval[c,d]) /\ + interval[c,d] SUBSET interval[a,b] + ==> ((\x. if x IN interval(c,d) then f x else vec 0) has_integral i) + (interval[a,b])`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `interval[c:real^M,d] = {}` THENL + [FIRST_ASSUM(MP_TAC o AP_TERM + `interior:(real^M->bool)->(real^M->bool)`) THEN + SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_EMPTY] THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; HAS_INTEGRAL_0_EQ; HAS_INTEGRAL_EMPTY_EQ]; + ALL_TAC] THEN + ABBREV_TAC `g:real^M->real^N = + \x. if x IN interval(c,d) then f x else vec 0` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN + REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o MATCH_MP PARTIAL_DIVISION_EXTEND_1) THEN + DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`lifted((+):real^N->real^N->real^N)`; + `p:(real^M->bool)->bool`; + `a:real^M`; `b:real^M`; + `\i. if (g:real^M->real^N) integrable_on i + then SOME (integral i g) else NONE`] + OPERATIVE_DIVISION) THEN + ASM_SIMP_TAC[OPERATIVE_INTEGRAL; MONOIDAL_LIFTED; MONOIDAL_VECTOR_ADD] THEN + SUBGOAL_THEN + `iterate (lifted (+)) p + (\i. if (g:real^M->real^N) integrable_on i + then SOME (integral i g) else NONE) = + SOME i` + SUBST1_TAC THENL + [ALL_TAC; + COND_CASES_TAC THEN + REWRITE_TAC[distinctness "option"; injectivity "option"] THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `x IN s ==> s = x INSERT (s DELETE x)`)) THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_LIFTED; MONOIDAL_VECTOR_ADD; + FINITE_DELETE; IN_DELETE] THEN + SUBGOAL_THEN `(g:real^M->real^N) integrable_on interval[c,d]` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN + MATCH_MP_TAC INTEGRABLE_SPIKE_INTERIOR THEN + EXPAND_TAC "g" THEN SIMP_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `iterate (lifted (+)) (p DELETE interval[c,d]) + (\i. if (g:real^M->real^N) integrable_on i + then SOME (integral i g) else NONE) = SOME(vec 0)` + SUBST1_TAC THENL + [ALL_TAC; + REWRITE_TAC[lifted; VECTOR_ADD_RID] THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN + EXISTS_TAC `f:real^M->real^N` THEN + EXPAND_TAC "g" THEN ASM_SIMP_TAC[]] THEN + SIMP_TAC[GSYM NEUTRAL_VECTOR_ADD; GSYM NEUTRAL_LIFTED; + MONOIDAL_VECTOR_ADD] THEN + MATCH_MP_TAC(MATCH_MP ITERATE_EQ_NEUTRAL + (MATCH_MP MONOIDAL_LIFTED(SPEC_ALL MONOIDAL_VECTOR_ADD))) THEN + SIMP_TAC[NEUTRAL_LIFTED; NEUTRAL_VECTOR_ADD; MONOIDAL_VECTOR_ADD] THEN + X_GEN_TAC `k:real^M->bool` THEN REWRITE_TAC[IN_DELETE] THEN STRIP_TAC THEN + SUBGOAL_THEN `((g:real^M->real^N) has_integral (vec 0)) k` + (fun th -> MESON_TAC[th; integrable_on; INTEGRAL_UNIQUE]) THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` MP_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_INTERIOR THEN + EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN + REWRITE_TAC[HAS_INTEGRAL_0] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL + [`interval[c:real^M,d]`; `interval[u:real^M,v]`]) THEN + ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM SET_TAC[]);; + +let HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL = prove + (`!f:real^M->real^N a b c d i. + (f has_integral i) (interval[c,d]) /\ + interval[c,d] SUBSET interval[a,b] + ==> ((\x. if x IN interval[c,d] then f x else vec 0) has_integral i) + (interval[a,b])`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE) THEN + EXISTS_TAC `interval[c:real^M,d] DIFF interval(c,d)` THEN + REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN REWRITE_TAC[IN_DIFF] THEN + MP_TAC(ISPECL [`c:real^M`; `d:real^M`] INTERVAL_OPEN_SUBSET_CLOSED) THEN + SET_TAC[]);; + +let HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ = prove + (`!f:real^M->real^N a b c d i. + interval[c,d] SUBSET interval[a,b] + ==> (((\x. if x IN interval[c,d] then f x else vec 0) has_integral i) + (interval[a,b]) <=> + (f has_integral i) (interval[c,d]))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[c:real^M,d] = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; HAS_INTEGRAL_0_EQ; HAS_INTEGRAL_EMPTY_EQ]; + ALL_TAC] THEN + EQ_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL] THEN + SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[c,d]` MP_TAC THENL + [MATCH_MP_TAC INTEGRABLE_EQ THEN + EXISTS_TAC `\x. if x IN interval[c:real^M,d] + then f x:real^N else vec 0` THEN + SIMP_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + ASM_MESON_TAC[integrable_on]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + MP_TAC(ASSUME `interval[c:real^M,d] SUBSET interval[a,b]`) THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL) THEN + ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE; INTEGRABLE_INTEGRAL]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we can apply the limit process uniformly to all integrals. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL = prove + (`!f:real^M->real^N i s. + (f has_integral i) s <=> + !e. &0 < e + ==> ?B. &0 < B /\ + !a b. ball(vec 0,B) SUBSET interval[a,b] + ==> ?z. ((\x. if x IN s then f(x) else vec 0) + has_integral z) (interval[a,b]) /\ + norm(z - i) < e`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [has_integral_alt] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(X_CHOOSE_THEN `a:real^M` (X_CHOOSE_THEN `b:real^M` + SUBST_ALL_TAC)) THEN + MP_TAC(ISPECL [`a:real^M`; `b:real^M`] (CONJUNCT1 BOUNDED_INTERVAL)) THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `B + &1` THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_01] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN + REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN + DISCH_TAC THEN EXISTS_TAC `i:real^N` THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0] THEN + MATCH_MP_TAC HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL THEN + ASM_MESON_TAC[SUBSET; REAL_ARITH `n <= B ==> n < B + &1`]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `?y. ((f:real^M->real^N) has_integral y) (interval[a,b])` + MP_TAC THENL + [SUBGOAL_THEN + `?c d. interval[a,b] SUBSET interval[c,d] /\ + (\x. if x IN interval[a,b] then (f:real^M->real^N) x + else vec 0) integrable_on interval[c,d]` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `c:real^M = lambda i. --(max B C)` THEN + ABBREV_TAC `d:real^M = lambda i. max B C` THEN + MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN + X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN + SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^M`; `d:real^M`]) THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN + X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN + SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + MATCH_MP_TAC(REAL_ARITH `x < C ==> x <= max B C`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + MESON_TAC[integrable_on]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [integrable_on]) THEN + ASM_SIMP_TAC[HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + SUBGOAL_THEN `i:real^N = y` ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH `~(&0 < norm(y - i)) ==> i = y`) THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `norm(y - i:real^N)`) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `C:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + ABBREV_TAC `c:real^M = lambda i. --(max B C)` THEN + ABBREV_TAC `d:real^M = lambda i. max B C` THEN + MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN + X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN + SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + MATCH_MP_TAC(REAL_ARITH `x < C ==> x <= max B C`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `interval[a:real^M,b] SUBSET interval[c,d]` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL] THEN + X_GEN_TAC `k:num` THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN + SIMP_TAC[LAMBDA_BETA; REAL_BOUNDS_LE] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + MATCH_MP_TAC(REAL_ARITH `x <= B ==> x <= max B C`) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ] THEN + ASM_MESON_TAC[REAL_LT_REFL; HAS_INTEGRAL_UNIQUE]);; + +let HAS_INTEGRAL_TWIZZLE = prove + (`!f:real^N->real^P s:real^M->bool y p. + dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) /\ + (f has_integral y) (IMAGE (\x. lambda i. x$p i) s) + ==> ((\x. f(lambda i. x$p i)) has_integral y) s`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(lambda i. (a:real^M)$p i):real^N`; + `(lambda i. (b:real^M)$p i):real^N`]) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + SIMP_TAC[SUBSET; IN_BALL_0; IN_INTERVAL; LAMBDA_BETA] THEN + ASM_REWRITE_TAC[NORM_LT_SQUARE; dot] THEN DISCH_TAC THEN ANTS_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(lambda i. (x:real^N)$(inverse p i)):real^M`) THEN + SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a ==> x = y ==> y < a`)) THEN + FIRST_ASSUM(MP_TAC o GSYM o + MATCH_MP SUM_PERMUTE o MATCH_MP PERMUTES_INVERSE) THEN + ONCE_ASM_REWRITE_TAC[] THEN SIMP_TAC[o_DEF]; + REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^P` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HAS_INTEGRAL_TWIZZLE_INTERVAL)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_THM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x y. f x = f y ==> x = y) + ==> (f x IN IMAGE f s <=> x IN s)`) THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]);; + +let HAS_INTEGRAL_TWIZZLE_EQ = prove + (`!f:real^N->real^P s:real^M->bool y p. + dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) + ==> ((f has_integral y) (IMAGE (\x. lambda i. x$p i) s) <=> + ((\x. f(lambda i. x$p i)) has_integral y) s)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[HAS_INTEGRAL_TWIZZLE]; ALL_TAC] THEN + MP_TAC(ISPECL + [`(f:real^N->real^P) o ((\x. lambda i. x$p i):real^M->real^N)`; + `IMAGE ((\x. lambda i. x$p i):real^M->real^N) s`; + `y:real^P`; `inverse p:num->num`] HAS_INTEGRAL_TWIZZLE) THEN + REWRITE_TAC[] THEN ONCE_ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[PERMUTES_INVERSE; o_DEF; GSYM IMAGE_o] THEN + MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THEN MATCH_MP_TAC EQ_IMP THENL + [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. f x = x) ==> s = IMAGE f s`) THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA]; + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; FUN_EQ_THM; LAMBDA_BETA]] THEN + IMP_REWRITE_TAC[LAMBDA_BETA] THEN + REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]);; + +let HAS_INTEGRAL_PASTECART_SYM_ALT = prove + (`!f:real^(M,N)finite_sum->real^P s y. + ((\z. f(pastecart (sndcart z) (fstcart z))) has_integral y) s <=> + (f has_integral y) (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?p. p permutes 1..dimindex(:(M,N)finite_sum) /\ + !z. pastecart (sndcart z:real^M) (fstcart z:real^N) = + lambda i. z$(p i)` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + EXISTS_TAC `\i. if 1 <= i /\ i <= dimindex(:M) then i + dimindex(:N) + else if i <= dimindex(:M) + dimindex(:N) then i - dimindex(:M) + else i` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PERMUTES_BIJECTIONS THEN + EXISTS_TAC `\i. if 1 <= i /\ i <= dimindex(:N) then i + dimindex(:M) + else if i <= dimindex(:M) + dimindex(:N) then i - dimindex(:N) + else i` THEN + SIMP_TAC[IN_NUMSEG; DIMINDEX_FINITE_SUM] THEN ARITH_TAC; + SIMP_TAC[FUN_EQ_THM; CART_EQ; pastecart; LAMBDA_BETA] THEN + SIMP_TAC[fstcart; sndcart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `i:num <= n ==> i + m <= n + m`] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + TRY(MATCH_MP_TAC LAMBDA_BETA) THEN ASM_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC HAS_INTEGRAL_TWIZZLE_EQ THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM]]);; + +let HAS_INTEGRAL_PASTECART_SYM = prove + (`!f:real^(M,N)finite_sum->real^P s y. + ((\z. f(pastecart (sndcart z) (fstcart z))) has_integral y) + (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) <=> + (f has_integral y) s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real^(M,N)finite_sum->real^P`; + `IMAGE (\z. pastecart (sndcart z) (fstcart z)) + (s:real^(M,N)finite_sum->bool)`; `y:real^P`] + HAS_INTEGRAL_PASTECART_SYM_ALT) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[PASTECART_FST_SND; IMAGE_ID]);; + +let INTEGRAL_PASTECART_SYM = prove + (`!f:real^(M,N)finite_sum->real^P s y. + integral + (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) + (\z. f(pastecart (sndcart z) (fstcart z))) = + integral s f`, + REWRITE_TAC[integral; HAS_INTEGRAL_PASTECART_SYM]);; + +let INTEGRABLE_PASTECART_SYM = prove + (`!f:real^(M,N)finite_sum->real^P s y. + (\z. f(pastecart (sndcart z) (fstcart z))) integrable_on + (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) <=> + f integrable_on s`, + REWRITE_TAC[integrable_on; HAS_INTEGRAL_PASTECART_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a general restriction property. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_RESTRICT = prove + (`!f:real^M->real^N s t i. + s SUBSET t + ==> (((\x. if x IN s then f x else vec 0) has_integral i) t <=> + (f has_integral i) s)`, + REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[MESON[] `(if p then if q then x else y else y) = + (if q then if p then x else y else y)`] THEN + ASM_SIMP_TAC[]);; + +let INTEGRAL_RESTRICT = prove + (`!f:real^M->real^N s t. + s SUBSET t + ==> integral t (\x. if x IN s then f x else vec 0) = + integral s f`, + SIMP_TAC[integral; HAS_INTEGRAL_RESTRICT]);; + +let INTEGRABLE_RESTRICT = prove + (`!f:real^M->real^N s t. + s SUBSET t + ==> ((\x. if x IN s then f x else vec 0) integrable_on t <=> + f integrable_on s)`, + SIMP_TAC[integrable_on; HAS_INTEGRAL_RESTRICT]);; + +let HAS_INTEGRAL_RESTRICT_UNIV = prove + (`!f:real^M->real^N s i. + ((\x. if x IN s then f x else vec 0) has_integral i) (:real^M) <=> + (f has_integral i) s`, + SIMP_TAC[HAS_INTEGRAL_RESTRICT; SUBSET_UNIV]);; + +let INTEGRAL_RESTRICT_UNIV = prove + (`!f:real^M->real^N s. + integral (:real^M) (\x. if x IN s then f x else vec 0) = + integral s f`, + REWRITE_TAC[integral; HAS_INTEGRAL_RESTRICT_UNIV]);; + +let INTEGRABLE_RESTRICT_UNIV = prove + (`!f s. (\x. if x IN s then f x else vec 0) integrable_on (:real^M) <=> + f integrable_on s`, + REWRITE_TAC[integrable_on; HAS_INTEGRAL_RESTRICT_UNIV]);; + +let HAS_INTEGRAL_RESTRICT_INTER = prove + (`!f:real^M->real^N s t. + ((\x. if x IN s then f x else vec 0) has_integral i) t <=> + (f has_integral i) (s INTER t)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[IN_INTER] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; + +let INTEGRAL_RESTRICT_INTER = prove + (`!f:real^M->real^N s t. + integral t (\x. if x IN s then f x else vec 0) = + integral (s INTER t) f`, + REWRITE_TAC[integral; HAS_INTEGRAL_RESTRICT_INTER]);; + +let INTEGRABLE_RESTRICT_INTER = prove + (`!f:real^M->real^N s t. + (\x. if x IN s then f x else vec 0) integrable_on t <=> + f integrable_on (s INTER t)`, + REWRITE_TAC[integrable_on; HAS_INTEGRAL_RESTRICT_INTER]);; + +let HAS_INTEGRAL_ON_SUPERSET = prove + (`!f s t. + (!x. ~(x IN s) ==> f x = vec 0) /\ s SUBSET t /\ (f has_integral i) s + ==> (f has_integral i) t`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]);; + +let INTEGRABLE_ON_SUPERSET = prove + (`!f s t. + (!x. ~(x IN s) ==> f x = vec 0) /\ s SUBSET t /\ f integrable_on s + ==> f integrable_on t`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_ON_SUPERSET]);; + +let NEGLIGIBLE_ON_INTERVALS = prove + (`!s. negligible s <=> !a b:real^N. negligible(s INTER interval[a,b])`, + GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[negligible] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + FIRST_ASSUM(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN + EXISTS_TAC `s INTER interval[a:real^N,b]` THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[indicator; IN_DIFF; IN_INTER] THEN + MESON_TAC[]);; + +let NEGLIGIBLE_BOUNDED_SUBSETS = prove + (`!s:real^N->bool. + negligible s <=> !t. bounded t /\ t SUBSET s ==> negligible t`, + MESON_TAC[NEGLIGIBLE_ON_INTERVALS; INTER_SUBSET; BOUNDED_SUBSET; + BOUNDED_INTERVAL; NEGLIGIBLE_SUBSET]);; + +let NEGLIGIBLE_ON_COUNTABLE_INTERVALS = prove + (`!s:real^N->bool. + negligible s <=> + !n. negligible (s INTER interval[--vec n,vec n])`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [NEGLIGIBLE_ON_INTERVALS] THEN + EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a b:real^N. ?n. s INTER interval[a,b] = + ((s INTER interval[--vec n,vec n]) INTER interval[a,b])` + (fun th -> ASM_MESON_TAC[th; NEGLIGIBLE_ON_INTERVALS]) THEN + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`interval[a:real^N,b]`; `vec 0:real^N`] + BOUNDED_SUBSET_CBALL) THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `r:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `i SUBSET b ==> b SUBSET n ==> s INTER i = (s INTER n) INTER i`)) THEN + REWRITE_TAC[SUBSET; IN_CBALL_0; IN_INTERVAL; VEC_COMPONENT; + VECTOR_NEG_COMPONENT; GSYM REAL_ABS_BOUNDS] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);; + +let HAS_INTEGRAL_SPIKE_SET_EQ = prove + (`!f:real^M->real^N s t y. + negligible(s DIFF t UNION t DIFF s) + ==> ((f has_integral y) s <=> (f has_integral y) t)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ THEN + EXISTS_TAC `s DIFF t UNION t DIFF s:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let HAS_INTEGRAL_SPIKE_SET = prove + (`!f:real^M->real^N s t y. + negligible(s DIFF t UNION t DIFF s) /\ + (f has_integral y) s + ==> (f has_integral y) t`, + MESON_TAC[HAS_INTEGRAL_SPIKE_SET_EQ]);; + +let INTEGRABLE_SPIKE_SET = prove + (`!f:real^M->real^N s t. + negligible(s DIFF t UNION t DIFF s) + ==> f integrable_on s ==> f integrable_on t`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_SPIKE_SET_EQ]);; + +let INTEGRABLE_SPIKE_SET_EQ = prove + (`!f:real^M->real^N s t. + negligible(s DIFF t UNION t DIFF s) + ==> (f integrable_on s <=> f integrable_on t)`, + MESON_TAC[INTEGRABLE_SPIKE_SET; UNION_COMM]);; + +let INTEGRAL_SPIKE_SET = prove + (`!f:real^M->real^N g s t. + negligible(s DIFF t UNION t DIFF s) + ==> integral s f = integral t f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[integral] THEN + AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN + ASM_MESON_TAC[]);; + +let HAS_INTEGRAL_INTERIOR = prove + (`!f:real^M->real^N y s. + negligible(frontier s) + ==> ((f has_integral y) (interior s) <=> (f has_integral y) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REWRITE_TAC[frontier] THEN + MP_TAC(ISPEC `s:real^M->bool` INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN + SET_TAC[]);; + +let HAS_INTEGRAL_CLOSURE = prove + (`!f:real^M->real^N y s. + negligible(frontier s) + ==> ((f has_integral y) (closure s) <=> (f has_integral y) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET_EQ THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REWRITE_TAC[frontier] THEN + MP_TAC(ISPEC `s:real^M->bool` INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN + SET_TAC[]);; + +let INTEGRABLE_CASES = prove + (`!f g:real^M->real^N s. + f integrable_on {x | x IN s /\ P x} /\ + g integrable_on {x | x IN s /\ ~P x} + ==> (\x. if P x then f x else g x) integrable_on s`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ) THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN + MESON_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas that are useful later. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_DROP_POS_AE = prove + (`!f:real^M->real^1 s t i. + (f has_integral i) s /\ + negligible t /\ (!x. x IN s DIFF t ==> &0 <= drop(f x)) + ==> &0 <= drop i`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS THEN + EXISTS_TAC `f:real^M->real^1` THEN EXISTS_TAC `s DIFF t:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE_SET THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SET_TAC[]);; + +let INTEGRAL_DROP_POS_AE = prove + (`!f:real^M->real^1 s t. + f integrable_on s /\ + negligible t /\ (!x. x IN s DIFF t ==> &0 <= drop(f x)) + ==> &0 <= drop(integral s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_POS_AE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_SUBSET_COMPONENT_LE = prove + (`!f:real^M->real^N s t i j k. + s SUBSET t /\ (f has_integral i) s /\ (f has_integral j) t /\ + 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN t ==> &0 <= f(x)$k) + ==> i$k <= j$k`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN + MAP_EVERY EXISTS_TAC + [`(\x. if x IN s then f x else vec 0):real^M->real^N`; + `(\x. if x IN t then f x else vec 0):real^M->real^N`; + `(:real^M)`] THEN + ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN + ASM_SIMP_TAC[VEC_COMPONENT] THEN ASM SET_TAC[]);; + +let INTEGRAL_SUBSET_COMPONENT_LE = prove + (`!f:real^M->real^N s t k. + s SUBSET t /\ f integrable_on s /\ f integrable_on t /\ + 1 <= k /\ k <= dimindex(:N) /\ + (!x. x IN t ==> &0 <= f(x)$k) + ==> (integral s f)$k <= (integral t f)$k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_SUBSET_DROP_LE = prove + (`!f:real^M->real^1 s t i j. + s SUBSET t /\ (f has_integral i) s /\ (f has_integral j) t /\ + (!x. x IN t ==> &0 <= drop(f x)) + ==> drop i <= drop j`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_SUBSET_COMPONENT_LE THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; + +let INTEGRAL_SUBSET_DROP_LE = prove + (`!f:real^M->real^1 s t. + s SUBSET t /\ f integrable_on s /\ f integrable_on t /\ + (!x. x IN t ==> &0 <= drop(f(x))) + ==> drop(integral s f) <= drop(integral t f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SUBSET_DROP_LE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_ALT = prove + (`!f:real^M->real^N s i. + (f has_integral i) s <=> + (!a b. (\x. if x IN s then f x else vec 0) + integrable_on interval[a,b]) /\ + (!e. &0 < e + ==> ?B. &0 < B /\ + !a b. ball (vec 0,B) SUBSET interval[a,b] + ==> norm(integral(interval[a,b]) + (\x. if x IN s then f x else vec 0) - + i) < e)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN + SPEC_TAC(`\x. if x IN s then (f:real^M->real^N) x else vec 0`, + `f:real^M->real^N`) THEN + GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[INTEGRAL_UNIQUE; integrable_on]] THEN + DISCH_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[INTEGRAL_UNIQUE]] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + POP_ASSUM(MP_TAC o C MATCH_MP REAL_LT_01) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + EXISTS_TAC `(lambda i. min ((a:real^M)$i) (--B)):real^M` THEN + EXISTS_TAC `(lambda i. max ((b:real^M)$i) B):real^M` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`(lambda i. min ((a:real^M)$i) (--B)):real^M`; + `(lambda i. max ((b:real^M)$i) B):real^M`]) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[integrable_on]]; + SIMP_TAC[SUBSET; IN_INTERVAL; IN_BALL; LAMBDA_BETA; + REAL_MIN_LE; REAL_LE_MAX]] THEN + SIMP_TAC[SUBSET; IN_BALL; IN_INTERVAL; LAMBDA_BETA] THEN + GEN_TAC THEN REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm x`] THEN + DISCH_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= B ==> min a (--B) <= x /\ x <= max b B`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^M)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPONENT_LE_NORM]);; + +let INTEGRABLE_ALT = prove + (`!f:real^M->real^N s. + f integrable_on s <=> + (!a b. (\x. if x IN s then f x else vec 0) integrable_on + interval[a,b]) /\ + (!e. &0 < e + ==> ?B. &0 < B /\ + !a b c d. + ball(vec 0,B) SUBSET interval[a,b] /\ + ball(vec 0,B) SUBSET interval[c,d] + ==> norm(integral (interval[a,b]) + (\x. if x IN s then f x else vec 0) - + integral (interval[c,d]) + (\x. if x IN s then f x else vec 0)) < e)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [integrable_on] THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_TAC THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + MESON_TAC[NORM_ARITH `norm(a - y) < e / &2 /\ norm(b - y) < e / &2 + ==> norm(a - b) < e`]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `cauchy (\n. integral (interval[(lambda i. --(&n)),(lambda i. &n)]) + (\x. if x IN s then (f:real^M->real^N) x else vec 0))` + MP_TAC THENL + [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `B:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[dist] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`] THEN + CONJ_TAC; + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:real^N` THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_THEN(LABEL_TAC "C") THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "C" (MP_TAC o SPEC `e / &2`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + MP_TAC(SPEC `max (&N) B` REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[REAL_MAX_LE; REAL_OF_NUM_LE] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&n` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(i1 - i2) < e / &2 ==> dist(i1,i) < e / &2 ==> norm(i2 - i) < e`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^M,&n)` THEN + ASM_SIMP_TAC[SUBSET_BALL] THEN + REWRITE_TAC[SUBSET; IN_BALL; NORM_ARITH `dist(vec 0,x) = norm x`]] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[REAL_BOUNDS_LE] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(x:real^M)` THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN + REAL_ARITH_TAC);; + +let INTEGRABLE_ALT_SUBSET = prove + (`!f:real^M->real^N s. + f integrable_on s <=> + (!a b. (\x. if x IN s then f x else vec 0) integrable_on + interval[a,b]) /\ + (!e. &0 < e + ==> ?B. &0 < B /\ + !a b c d. + ball(vec 0,B) SUBSET interval[a,b] /\ + interval[a,b] SUBSET interval[c,d] + ==> norm(integral (interval[a,b]) + (\x. if x IN s then f x else vec 0) - + integral (interval[c,d]) + (\x. if x IN s then f x else vec 0)) < e)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [INTEGRABLE_ALT] THEN + ABBREV_TAC `g:real^M->real^N = \x. if x IN s then f x else vec 0` THEN + POP_ASSUM(K ALL_TAC) THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + DISCH_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_TRANS]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real^M`; `d:real^M`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(lambda i. max ((a:real^M)$i) ((c:real^M)$i)):real^M`; + `(lambda i. min ((b:real^M)$i) ((d:real^M)$i)):real^M`]) THEN + ASM_REWRITE_TAC[GSYM INTER_INTERVAL; SUBSET_INTER] THEN + DISCH_THEN(fun th -> + MP_TAC(ISPECL [`a:real^M`; `b:real^M`] th) THEN + MP_TAC(ISPECL [`c:real^M`; `d:real^M`] th)) THEN + ASM_REWRITE_TAC[INTER_SUBSET] THEN NORM_ARITH_TAC);; + +let INTEGRABLE_ON_SUBINTERVAL = prove + (`!f:real^M->real^N s a b. + f integrable_on s /\ interval[a,b] SUBSET s + ==> f integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [INTEGRABLE_ALT] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o CONJUNCT1) ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] INTEGRABLE_EQ) THEN + ASM SET_TAC[]);; + +let INTEGRAL_SPLIT = prove + (`!f:real^M->real^N a b t k. + f integrable_on interval[a,b] /\ 1 <= k /\ k <= dimindex(:M) + ==> integral (interval[a,b]) f = + integral(interval + [a,(lambda i. if i = k then min (b$k) t else b$i)]) f + + integral(interval + [(lambda i. if i = k then max (a$k) t else a$i),b]) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_SPLIT THEN + MAP_EVERY EXISTS_TAC [`k:num`; `t:real`] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; GSYM HAS_INTEGRAL_INTEGRAL] THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `interval[a:real^M,b]` THEN + ASM_SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let INTEGRAL_SPLIT_SIGNED = prove + (`!f:real^M->real^N a b t k. + 1 <= k /\ k <= dimindex(:M) /\ a$k <= t /\ a$k <= b$k /\ + f integrable_on + interval[a,(lambda i. if i = k then max (b$k) t else b$i)] + ==> integral (interval[a,b]) f = + integral(interval + [a,(lambda i. if i = k then t else b$i)]) f + + (if b$k < t then -- &1 else &1) % + integral(interval + [(lambda i. if i = k then min (b$k) t else a$i), + (lambda i. if i = k then max (b$k) t else b$i)]) f`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [MP_TAC(ISPECL + [`f:real^M->real^N`; + `a:real^M`; + `(lambda i. if i = k then t else (b:real^M)$i):real^M`; + `(b:real^M)$k`; `k:num`] + INTEGRAL_SPLIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN + ASM_SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(VECTOR_ARITH + `x = y /\ w = z + ==> x:real^N = (y + z) + --(&1) % w`) THEN + CONJ_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ; CART_EQ] THEN TRY CONJ_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + GEN_TAC THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + ASM_REAL_ARITH_TAC]; + MP_TAC(ISPECL + [`f:real^M->real^N`; + `a:real^M`; + `b:real^M`; + `t:real`; `k:num`] + INTEGRAL_SPLIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] INTEGRABLE_ON_SUBINTERVAL)) THEN + ASM_SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ; CART_EQ] THEN TRY CONJ_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + GEN_TAC THEN STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +let INTEGRAL_INTERVALS_INCLUSION_EXCLUSION = prove + (`!f:real^M->real^N a b c d. + f integrable_on interval[a,b] /\ + c IN interval[a,b] /\ d IN interval[a,b] + ==> integral(interval[a,d]) f = + vsum {s | s SUBSET 1..dimindex(:M)} + (\s. --(&1) pow CARD {i | i IN s /\ d$i < c$i} % + integral + (interval[(lambda i. if i IN s + then min (c$i) (d$i) + else (a:real^M)$i), + (lambda i. if i IN s + then max (c$i) (d$i) + else c$i)]) f)`, + let lemma1 = prove + (`!f:(num->bool)->real^N n. + vsum {s | s SUBSET 1..SUC n} f = + vsum {s | s SUBSET 1..n} f + + vsum {s | s SUBSET 1..n} (\s. f(SUC n INSERT s))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[NUMSEG_CLAUSES; ARITH_RULE `1 <= SUC n`; POWERSET_CLAUSES] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhs o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET; FINITE_NUMSEG] THEN + REWRITE_TAC[SET_RULE + `DISJOINT s (IMAGE f t) <=> !x. x IN t ==> ~(f x IN s)`] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN + REWRITE_TAC[IN_INSERT; IN_NUMSEG] THEN ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] VSUM_IMAGE) THEN + SIMP_TAC[FINITE_POWERSET; FINITE_NUMSEG] THEN + MAP_EVERY X_GEN_TAC [`s:num->bool`; `t:num->bool`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(SET_RULE + `~(a IN i) + ==> s SUBSET i /\ t SUBSET i /\ a INSERT s = a INSERT t + ==> s = t`) THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC]) in + let lemma2 = prove + (`!f:real^M->real^N m a:real^M c:real^M d:real^M. + f integrable_on (:real^M) /\ m <= dimindex(:M) /\ + (!i. m < i /\ i <= dimindex(:M) ==> a$i = c$i \/ d$i = c$i) /\ + (!i. m < i /\ i <= dimindex(:M) ==> a$i = c$i ==> a$i = d$i) /\ + (!i. 1 <= i /\ i <= dimindex(:M) ==> a$i <= c$i /\ a$i <= d$i) + ==> integral(interval[a,d]) f = + vsum {s | s SUBSET 1..m} + (\s. --(&1) pow CARD {i | i IN s /\ d$i < c$i} % + integral + (interval[(lambda i. if i IN s + then min (c$i) (d$i) + else (a:real^M)$i), + (lambda i. if i IN s + then max (c$i) (d$i) + else c$i)]) f)`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[NUMSEG_CLAUSES; ARITH; SUBSET_EMPTY; SING_GSPEC] THEN + REWRITE_TAC[VSUM_SING; NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES] THEN + REWRITE_TAC[real_pow; LAMBDA_ETA; VECTOR_MUL_LID] THEN + REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC + `?k. 1 <= k /\ k <= dimindex(:M) /\ (a:real^M)$k = (c:real^M)$k` + THENL + [MATCH_MP_TAC(MESON[] `i = vec 0 /\ j = vec 0 ==> i:real^N = j`) THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_NULL THEN + REWRITE_TAC[CONTENT_EQ_0] THEN ASM_MESON_TAC[]; + SUBGOAL_THEN `d:real^M = c:real^M` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[CART_EQ] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[lemma1] THEN + SUBGOAL_THEN + `!s. s SUBSET 1..m + ==> --(&1) pow CARD {i | i IN SUC m INSERT s /\ d$i < c$i} = + (if (d:real^M)$(SUC m) < (c:real^M)$(SUC m) then -- &1 else &1) * + --(&1) pow CARD {i | i IN s /\ d$i < c$i}` + (fun th -> SIMP_TAC[th; IN_ELIM_THM]) THENL + [X_GEN_TAC `s:num->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `FINITE(s:num->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_NUMSEG; FINITE_SUBSET]; ALL_TAC] THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RESTRICT; SET_RULE + `P a ==> {x | x IN a INSERT s /\ P x} = + a INSERT {x | x IN s /\ P x}`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[real_pow] THEN + SUBGOAL_THEN `~(SUC m IN 1..m)` (fun th -> ASM SET_TAC[th]) THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; + ASM_SIMP_TAC[REAL_MUL_LID; SET_RULE + `~(P a) ==> {x | x IN a INSERT s /\ P x} = {x | x IN s /\ P x}`]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `a:real^M`; `d:real^M`; `(c:real^M)$SUC m`; `SUC m`] + INTEGRAL_SPLIT_SIGNED) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `1 <= SUC n`; INTEGRABLE_ON_SUBINTERVAL; + SUBSET_UNIV]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[VSUM_LMUL; GSYM VECTOR_MUL_ASSOC] THEN + BINOP_TAC THENL [ALL_TAC; AP_TERM_TAC] THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`a:real^M`; + `c:real^M`; + `(lambda i. if i = SUC m then (c:real^M)$SUC m + else (d:real^M)$i):real^M`]); + FIRST_X_ASSUM(MP_TAC o SPECL + [`(lambda i. if i = SUC m + then min ((d:real^M)$SUC m) ((c:real^M)$SUC m) + else (a:real^M)$i):real^M`; + `(lambda i. if i = SUC m + then max ((d:real^M)$SUC m) ((c:real^M)$SUC m) + else (c:real^M)$i):real^M`; + `(lambda i. if i = SUC m + then max ((d:real^M)$SUC m) ((c:real^M)$SUC m) + else d$i):real^M`])] THEN + (ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[ARITH_RULE `m < i <=> i = SUC m \/ SUC m < i`]; + X_GEN_TAC `i:num` THEN STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN TRY REAL_ARITH_TAC THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `s:num->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_TAC THEN BINOP_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `i IN 1..m` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + SUBGOAL_THEN `i <= dimindex(:M)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; AND_FORALL_THM] THEN + X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(i:num) IN s` THEN ASM_REWRITE_TAC[IN_INSERT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN TRY REAL_ARITH_TAC THEN + SUBGOAL_THEN `~(SUC m IN 1..m)` (fun th -> ASM SET_TAC[th]) THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC]])) in + REWRITE_TAC[IN_INTERVAL] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. if x IN interval[a,b] then (f:real^M->real^N) x else vec 0`; + `dimindex(:M)`; `a:real^M`; `c:real^M`; `d:real^M`] + lemma2) THEN + ASM_SIMP_TAC[LTE_ANTISYM; INTEGRABLE_RESTRICT_UNIV; LE_REFL] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:num->bool` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN AP_TERM_TAC] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `i SUBSET j ==> !x. x IN i ==> (if x IN j then f x else b) = f x`) THEN + ASM_SIMP_TAC[SUBSET_INTERVAL; REAL_LE_REFL; LAMBDA_BETA] THEN + DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION = prove + (`!f:real^M->real^N a b c d. + f integrable_on interval[a,b] /\ + c IN interval[a,b] /\ d IN interval[a,b] + ==> integral(interval[a,d]) f - integral(interval[a,c]) f = + vsum {s | ~(s = {}) /\ s SUBSET 1..dimindex(:M)} + (\s. --(&1) pow CARD {i | i IN s /\ d$i < c$i} % + integral + (interval[(lambda i. if i IN s + then min (c$i) (d$i) + else (a:real^M)$i), + (lambda i. if i IN s + then max (c$i) (d$i) + else c$i)]) f)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o + MATCH_MP INTEGRAL_INTERVALS_INCLUSION_EXCLUSION) THEN + REWRITE_TAC[SET_RULE `{s | ~(s = a) /\ P s} = {s | P s} DELETE a`] THEN + SIMP_TAC[VSUM_DELETE; FINITE_POWERSET; FINITE_NUMSEG; EMPTY_SUBSET; + IN_ELIM_THM] THEN + REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; CARD_CLAUSES; LAMBDA_ETA] THEN + REWRITE_TAC[real_pow; VECTOR_MUL_LID]);; + +let INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT = prove + (`!f:real^M->real^N a b c. + f integrable_on interval[a,b] /\ c IN interval[a,b] + ==> integral(interval[a,c]) f = + vsum {s | s SUBSET 1..dimindex (:M)} + (\s. --(&1) pow CARD s % + integral + (interval[(lambda i. if i IN s then c$i else a$i), + b]) + f)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `b:real^M`; `c:real^M`] + INTEGRAL_INTERVALS_INCLUSION_EXCLUSION) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN ANTS_TAC THENL + [ASM_MESON_TAC[ENDS_IN_INTERVAL; MEMBER_NOT_EMPTY]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `s:num->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_CASES_TAC `?k. k IN s /\ (c:real^M)$k = (b:real^M)$k` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `1 <= k /\ k <= dimindex(:M)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[IN_NUMSEG; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(MESON[] `a:real^N = vec 0 /\ b = vec 0 ==> a = b`) THEN + CONJ_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + MATCH_MP_TAC INTEGRAL_NULL THEN REWRITE_TAC[CONTENT_EQ_0] THEN + EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN BINOP_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_LT_LE; SUBSET; IN_NUMSEG]; + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; PAIR_EQ; LAMBDA_BETA] THEN + CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + +let INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT = prove + (`!f:real^M->real^N a b c. + f integrable_on interval[a,b] /\ c IN interval[a,b] + ==> integral(interval[c,b]) f = + vsum {s | s SUBSET 1..dimindex (:M)} + (\s. --(&1) pow CARD s % + integral + (interval[a,(lambda i. if i IN s then c$i else b$i)]) + f)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\x. (f:real^M->real^N) (--x)`; + `--b:real^M`; + `--a:real^M`; + `--c:real^M`] + INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT) THEN + REWRITE_TAC[REAL_ARITH `min (--a) (--b) = --(max a b)`; + REAL_ARITH `max (--a) (--b) = --(min a b)`; + VECTOR_NEG_COMPONENT] THEN + SUBGOAL_THEN + `!P x y. (lambda i. if P i then --(x i) else --(y i)):real^M = + --(lambda i. if P i then x i else y i)` + (fun th -> REWRITE_TAC[th]) + THENL + [SIMP_TAC[CART_EQ; VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN MESON_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[INTEGRAL_REFLECT; INTEGRABLE_REFLECT; + IN_INTERVAL_REFLECT]);; + +let HAS_INTEGRAL_REFLECT_GEN = prove + (`!f:real^M->real^N i s. + ((\x. f(--x)) has_integral i) s <=> (f has_integral i) (IMAGE (--) s)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM INTEGRABLE_REFLECT; GSYM INTEGRAL_REFLECT] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_NEG_NEG] THEN + REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `x:real^N = --y <=> --x = y`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MESON[VECTOR_NEG_NEG] + `(!x:real^N y:real^N. P x y) <=> (!x y. P (--y) (--x))`] THEN + REWRITE_TAC[VECTOR_NEG_NEG] THEN + REWRITE_TAC[SUBSET; IN_BALL_0; GSYM REFLECT_INTERVAL; IN_IMAGE] THEN + REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `x:real^N = --y <=> --x = y`] THEN + ONCE_REWRITE_TAC[GSYM NORM_NEG] THEN + REWRITE_TAC[MESON[VECTOR_NEG_NEG] `(!x:real^N. P (--x)) <=> (!x. P x)`] THEN + REWRITE_TAC[NORM_NEG]);; + +let INTEGRABLE_REFLECT_GEN = prove + (`!f:real^M->real^N s. + (\x. f(--x)) integrable_on s <=> f integrable_on (IMAGE (--) s)`, + REWRITE_TAC[integrable_on; HAS_INTEGRAL_REFLECT_GEN]);; + +let INTEGRAL_REFLECT_GEN = prove + (`!f:real^M->real^N s. + integral s (\x. f(--x)) = integral (IMAGE (--) s) f`, + REWRITE_TAC[integral; HAS_INTEGRAL_REFLECT_GEN]);; + +(* ------------------------------------------------------------------------- *) +(* A straddling criterion for integrability. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_STRADDLE_INTERVAL = prove + (`!f:real^N->real^1 a b. + (!e. &0 < e + ==> ?g h i j. (g has_integral i) (interval[a,b]) /\ + (h has_integral j) (interval[a,b]) /\ + norm(i - j) < e /\ + !x. x IN interval[a,b] + ==> drop(g x) <= drop(f x) /\ + drop(f x) <= drop(h x)) + ==> f integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[INTEGRABLE_CAUCHY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`g:real^N->real^1`; `h:real^N->real^1`; `i:real^1`; `j:real^1`] THEN + REWRITE_TAC[has_integral] THEN REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_TAC THEN DISCH_TAC THEN + EXISTS_TAC `(\x. d1 x INTER d2 x):real^N->real^N->bool` THEN + ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN + MAP_EVERY X_GEN_TAC + [`p1:(real^N#(real^N->bool))->bool`; + `p2:(real^N#(real^N->bool))->bool`] THEN + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `p1:(real^N#(real^N->bool))->bool` th) THEN + MP_TAC(SPEC `p2:(real^N#(real^N->bool))->bool` th))) THEN + EVERY_ASSUM(fun th -> try ASSUME_TAC(MATCH_MP TAGGED_DIVISION_OF_FINITE th) + with Failure _ -> ALL_TAC) THEN + ASM_SIMP_TAC[VSUM_REAL] THEN REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM] THEN + SUBST1_TAC(SYM(ISPEC `i:real^1` (CONJUNCT1 LIFT_DROP))) THEN + SUBST1_TAC(SYM(ISPEC `j:real^1` (CONJUNCT1 LIFT_DROP))) THEN + REWRITE_TAC[GSYM LIFT_SUB; DROP_CMUL; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH + `g1 - h2 <= f1 - f2 /\ f1 - f2 <= h1 - g2 /\ + abs(i - j) < e / &3 + ==> abs(g2 - i) < e / &3 + ==> abs(g1 - i) < e / &3 + ==> abs(h2 - j) < e / &3 + ==> abs(h1 - j) < e / &3 + ==> abs(f1 - f2) < e`) THEN + ASM_REWRITE_TAC[GSYM DROP_SUB; GSYM NORM_LIFT; LIFT_DROP] THEN CONJ_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x <= x' /\ y' <= y ==> x - y <= x' - y'`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF; CONTENT_POS_LE; SUBSET]);; + +let INTEGRABLE_STRADDLE = prove + (`!f:real^N->real^1 s. + (!e. &0 < e + ==> ?g h i j. (g has_integral i) s /\ + (h has_integral j) s /\ + norm(i - j) < e /\ + !x. x IN s + ==> drop(g x) <= drop(f x) /\ + drop(f x) <= drop(h x)) + ==> f integrable_on s`, + let lemma = prove + (`&0 <= drop x /\ drop x <= drop y ==> norm x <= norm y`, + REWRITE_TAC[NORM_REAL; GSYM drop] THEN REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a b. (\x. if x IN s then (f:real^N->real^1) x else vec 0) + integrable_on interval[a,b]` + ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[HAS_INTEGRAL_ALT]) THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + MATCH_MP_TAC INTEGRABLE_STRADDLE_INTERVAL THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`g:real^N->real^1`; `h:real^N->real^1`; `i:real^1`; `j:real^1`] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &4`) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &4`) STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "H"))) THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G"))) THEN + MAP_EVERY EXISTS_TAC + [`\x. if x IN s then (g:real^N->real^1) x else vec 0`; + `\x. if x IN s then (h:real^N->real^1) x else vec 0`; + `integral(interval[a:real^N,b]) + (\x. if x IN s then (g:real^N->real^1) x else vec 0:real^1)`; + `integral(interval[a:real^N,b]) + (\x. if x IN s then (h:real^N->real^1) x else vec 0:real^1)`] THEN + ASM_SIMP_TAC[INTEGRABLE_INTEGRAL] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN + ABBREV_TAC `c:real^N = lambda i. min ((a:real^N)$i) (--(max B1 B2))` THEN + ABBREV_TAC `d:real^N = lambda i. max ((b:real^N)$i) (max B1 B2)` THEN + REMOVE_THEN "H" (MP_TAC o SPECL [`c:real^N`; `d:real^N`]) THEN + REMOVE_THEN "G" (MP_TAC o SPECL [`c:real^N`; `d:real^N`]) THEN + MATCH_MP_TAC(TAUT + `(a /\ c) /\ (b /\ d ==> e) ==> (a ==> b) ==> (c ==> d) ==> e`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["c"; "d"] THEN + SIMP_TAC[SUBSET; IN_BALL; IN_INTERVAL; LAMBDA_BETA] THEN + GEN_TAC THEN REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm x`] THEN + DISCH_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= B ==> min a (--B) <= x /\ x <= max b B`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(x:real^N)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; COMPONENT_LE_NORM; REAL_LE_MAX]; + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(i - j) < e / &4 /\ + norm(ah - ag) <= norm(ch - cg) + ==> norm(cg - i) < e / &4 /\ + norm(ch - j) < e / &4 + ==> norm(ag - ah) < e`) THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM INTEGRAL_SUB] THEN + MATCH_MP_TAC lemma THEN CONJ_TAC THENL + [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`] HAS_INTEGRAL_DROP_POS) THEN + MAP_EVERY EXISTS_TAC + [`(\x. (if x IN s then h x else vec 0) - (if x IN s then g x else vec 0)) + :real^N->real^1`; + `interval[a:real^N,b]`] THEN + ASM_SIMP_TAC[INTEGRABLE_INTEGRAL; HAS_INTEGRAL_SUB] THEN + ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRABLE_INTEGRAL] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; REAL_POS] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + MATCH_MP_TAC(INST_TYPE [`:N`,`:M`] HAS_INTEGRAL_SUBSET_DROP_LE) THEN + MAP_EVERY EXISTS_TAC + [`(\x. (if x IN s then h x else vec 0) - (if x IN s then g x else vec 0)) + :real^N->real^1`; + `interval[a:real^N,b]`; `interval[c:real^N,d]`] THEN + ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRABLE_INTEGRAL] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_TAC THEN + MAP_EVERY EXPAND_TAC ["c"; "d"] THEN + SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; REAL_POS] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[INTEGRABLE_ALT] THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; HAS_INTEGRAL_ALT] THEN + MAP_EVERY X_GEN_TAC + [`g:real^N->real^1`; `h:real^N->real^1`; `i:real^1`; `j:real^1`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / &3`)) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e / &3`)) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G"))) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "H"))) THEN + EXISTS_TAC `max B1 B2` THEN + ASM_REWRITE_TAC[REAL_LT_MAX; BALL_MAX_UNION; UNION_SUBSET] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `c:real^N`; `d:real^N`] THEN + STRIP_TAC THEN REWRITE_TAC[ABS_DROP; DROP_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `!ga gc ha hc i j. + ga <= fa /\ fa <= ha /\ + gc <= fc /\ fc <= hc /\ + abs(ga - i) < e / &3 /\ + abs(gc - i) < e / &3 /\ + abs(ha - j) < e / &3 /\ + abs(hc - j) < e / &3 /\ + abs(i - j) < e / &3 + ==> abs(fa - fc) < e`) THEN + MAP_EVERY EXISTS_TAC + [`drop(integral(interval[a:real^N,b]) (\x. if x IN s then g x else vec 0))`; + `drop(integral(interval[c:real^N,d]) (\x. if x IN s then g x else vec 0))`; + `drop(integral(interval[a:real^N,b]) (\x. if x IN s then h x else vec 0))`; + `drop(integral(interval[c:real^N,d]) (\x. if x IN s then h x else vec 0))`; + `drop i`; `drop j`] THEN + REWRITE_TAC[GSYM DROP_SUB; GSYM ABS_DROP] THEN ASM_SIMP_TAC[] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]);; + +let HAS_INTEGRAL_STRADDLE_NULL = prove + (`!f g:real^N->real^1 s. + (!x. x IN s ==> &0 <= drop(f x) /\ drop(f x) <= drop(g x)) /\ + (g has_integral (vec 0)) s + ==> (f has_integral (vec 0)) s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_STRADDLE THEN + GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC + [`(\x. vec 0):real^N->real^1`; `g:real^N->real^1`; + `vec 0:real^1`; `vec 0:real^1`] THEN + ASM_REWRITE_TAC[DROP_VEC; HAS_INTEGRAL_0; VECTOR_SUB_REFL; NORM_0]; + DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^N->real^1`] + HAS_INTEGRAL_DROP_LE); + MATCH_MP_TAC(ISPECL [`(\x. vec 0):real^N->real^1`; `f:real^N->real^1`] + HAS_INTEGRAL_DROP_LE)] THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[GSYM HAS_INTEGRAL_INTEGRAL; DROP_VEC; HAS_INTEGRAL_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Adding integrals over several sets. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_UNION = prove + (`!f:real^M->real^N i j s t. + (f has_integral i) s /\ (f has_integral j) t /\ negligible(s INTER t) + ==> (f has_integral (i + j)) (s UNION t)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `(\x. if x IN (s INTER t) then &2 % f(x) + else if x IN (s UNION t) then f(x) + else vec 0):real^M->real^N` THEN + EXISTS_TAC `s INTER t:real^M->bool` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNION; IN_INTER; IN_UNIV] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let INTEGRAL_UNION = prove + (`!f:real^M->real^N s t. + f integrable_on s /\ f integrable_on t /\ negligible(s INTER t) + ==> integral (s UNION t) f = integral s f + integral t f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_UNION THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +let HAS_INTEGRAL_UNIONS = prove + (`!f:real^M->real^N i t. + FINITE t /\ + (!s. s IN t ==> (f has_integral (i s)) s) /\ + (!s s'. s IN t /\ s' IN t /\ ~(s = s') ==> negligible(s INTER s')) + ==> (f has_integral (vsum t i)) (UNIONS t)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_VSUM) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE) THEN + EXISTS_TAC + `UNIONS (IMAGE (\(a,b). a INTER b :real^M->bool) + {a,b | a IN t /\ b IN {y | y IN t /\ ~(a = y)}})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN + ASM_SIMP_TAC[FINITE_RESTRICT]; + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + ASM_SIMP_TAC[IN_ELIM_THM]]; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIV; IN_DIFF] THEN + ASM_CASES_TAC `(x:real^M) IN UNIONS t` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[SET_RULE + `~(x IN UNIONS t) <=> !s. s IN t ==> ~(x IN s)`]) THEN + ASM_SIMP_TAC[VSUM_0]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; EXISTS_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M->bool`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN + ASM_SIMP_TAC[MESON[] + `x IN a /\ a IN t + ==> ((!b. ~((b IN t /\ ~(a = b)) /\ x IN b)) <=> + (!b. b IN t ==> (x IN b <=> b = a)))`] THEN + ASM_REWRITE_TAC[VSUM_DELTA]]);; + +let HAS_INTEGRAL_DIFF = prove + (`!f:real^M->real^N i j s t. + (f has_integral i) s /\ + (f has_integral j) t /\ + negligible (t DIFF s) + ==> (f has_integral (i - j)) (s DIFF t)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `(\x. if x IN (t DIFF s) then --(f x) + else if x IN (s DIFF t) then f x + else vec 0):real^M->real^N` THEN + EXISTS_TAC `t DIFF s:real^M->bool` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNION; IN_INTER; IN_UNIV] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let INTEGRAL_DIFF = prove + (`!f:real^M->real^N s t. + f integrable_on s /\ f integrable_on t /\ negligible(t DIFF s) + ==> integral (s DIFF t) f = integral s f - integral t f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_DIFF THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +(* ------------------------------------------------------------------------- *) +(* In particular adding integrals over a division, maybe not of an interval. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_COMBINE_DIVISION = prove + (`!f:real^M->real^N s d i. + d division_of s /\ + (!k. k IN d ==> (f has_integral (i k)) k) + ==> (f has_integral (vsum d i)) s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o + GEN_REWRITE_RULE I [division_of]) THEN + MATCH_MP_TAC HAS_INTEGRAL_UNIONS THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?u v:real^M x y:real^M. + k1 = interval[u,v] /\ k2 = interval[x,y]` + (REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) + THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o el 2 o CONJUNCTS o + GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPECL + [`interval[u:real^M,v]`; `interval[x:real^M,y]`]) THEN + ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `(interval[u,v:real^M] DIFF interval(u,v)) UNION + (interval[x,y] DIFF interval(x,y))` THEN + SIMP_TAC[NEGLIGIBLE_FRONTIER_INTERVAL; NEGLIGIBLE_UNION] THEN + ASM SET_TAC[]);; + +let INTEGRAL_COMBINE_DIVISION_BOTTOMUP = prove + (`!f:real^M->real^N d s. + d division_of s /\ (!k. k IN d ==> f integrable_on k) + ==> integral s f = vsum d (\i. integral i f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +let HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN = prove + (`!f:real^M->real^N s d k. + f integrable_on s /\ d division_of k /\ k SUBSET s + ==> (f has_integral (vsum d (\i. integral i f))) k`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]);; + +let INTEGRAL_COMBINE_DIVISION_TOPDOWN = prove + (`!f:real^M->real^N d s. + f integrable_on s /\ d division_of s + ==> integral s f = vsum d (\i. integral i f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]);; + +let INTEGRABLE_COMBINE_DIVISION = prove + (`!f d s. + d division_of s /\ (!i. i IN d ==> f integrable_on i) + ==> f integrable_on s`, + REWRITE_TAC[integrable_on] THEN MESON_TAC[HAS_INTEGRAL_COMBINE_DIVISION]);; + +let INTEGRABLE_ON_SUBDIVISION = prove + (`!f:real^M->real^N s d i. + d division_of i /\ + f integrable_on s /\ i SUBSET s + ==> f integrable_on i`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_COMBINE_DIVISION THEN + EXISTS_TAC `d:(real^M->bool)->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + ASM_MESON_TAC[division_of; UNIONS_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Also tagged divisions. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_COMBINE_TAGGED_DIVISION = prove + (`!f:real^M->real^N s p i. + p tagged_division_of s /\ + (!x k. (x,k) IN p ==> (f has_integral (i k)) k) + ==> (f has_integral (vsum p (\(x,k). i k))) s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^M k:real^M->bool. + (x,k) IN p ==> ((f:real^M->real^N) has_integral integral k f) k` + ASSUME_TAC THENL + [ASM_MESON_TAC[HAS_INTEGRAL_INTEGRAL; integrable_on]; ALL_TAC] THEN + SUBGOAL_THEN + `((f:real^M->real^N) has_integral + (vsum (IMAGE SND (p:real^M#(real^M->bool)->bool)) + (\k. integral k f))) s` + MP_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum p (\(x:real^M,k:real^M->bool). integral k f:real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + ASM_MESON_TAC[HAS_INTEGRAL_UNIQUE]; + MATCH_MP_TAC VSUM_OVER_TAGGED_DIVISION_LEMMA THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[INTEGRAL_NULL]]);; + +let INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP = prove + (`!f:real^M->real^N p a b. + p tagged_division_of interval[a,b] /\ + (!x k. (x,k) IN p ==> f integrable_on k) + ==> integral (interval[a,b]) f = vsum p (\(x,k). integral k f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +let HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN = prove + (`!f:real^M->real^N a b p. + f integrable_on interval[a,b] /\ p tagged_division_of interval[a,b] + ==> (f has_integral (vsum p (\(x,k). integral k f))) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN + ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; TAGGED_DIVISION_OF]);; + +let INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN = prove + (`!f:real^M->real^N a b p. + f integrable_on interval[a,b] /\ p tagged_division_of interval[a,b] + ==> integral (interval[a,b]) f = vsum p (\(x,k). integral k f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Henstock's lemma. *) +(* ------------------------------------------------------------------------- *) + +let HENSTOCK_LEMMA_PART1 = prove + (`!f:real^M->real^N a b d e. + f integrable_on interval[a,b] /\ + &0 < e /\ gauge d /\ + (!p. p tagged_division_of interval[a,b] /\ d fine p + ==> norm (vsum p (\(x,k). content k % f x) - + integral(interval[a,b]) f) < e) + ==> !p. p tagged_partial_division_of interval[a,b] /\ d fine p + ==> norm(vsum p (\(x,k). content k % f x - + integral k f)) <= e`, + let lemma = prove + (`(!k. &0 < k ==> x <= e + k) ==> x <= e`, + DISCH_THEN(MP_TAC o SPEC `(x - e) / &2`) THEN REAL_ARITH_TAC) in + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC lemma THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`IMAGE SND (p:(real^M#(real^M->bool))->bool)`; `a:real^M`; `b:real^M`] + PARTIAL_DIVISION_EXTEND_INTERVAL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[PARTIAL_DIVISION_OF_TAGGED_DIVISION]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + ASM_MESON_TAC[tagged_partial_division_of; SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN `FINITE(p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP(SET_RULE + `s SUBSET t ==> t = s UNION (t DIFF s)`)) THEN + ABBREV_TAC `r = q DIFF IMAGE SND (p:(real^M#(real^M->bool))->bool)` THEN + SUBGOAL_THEN `IMAGE SND (p:(real^M#(real^M->bool))->bool) INTER r = {}` + ASSUME_TAC THENL [EXPAND_TAC "r" THEN SET_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST_ALL_TAC THEN + SUBGOAL_THEN `FINITE(r:(real^M->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[division_of; FINITE_UNION]; ALL_TAC] THEN + SUBGOAL_THEN + `!i. i IN r + ==> ?p. p tagged_division_of i /\ d fine p /\ + norm(vsum p (\(x,j). content j % f x) - + integral i (f:real^M->real^N)) + < k / (&(CARD(r:(real^M->bool)->bool)) + &1)` + MP_TAC THENL + [X_GEN_TAC `i:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `(i:real^M->bool) SUBSET interval[a,b]` ASSUME_TAC THENL + [ASM_MESON_TAC[division_of; IN_UNION]; ALL_TAC] THEN + SUBGOAL_THEN `?u v:real^M. i = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[division_of; IN_UNION]; ALL_TAC] THEN + SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[u,v]` MP_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + REWRITE_TAC[has_integral] THEN + DISCH_THEN(MP_TAC o SPEC `k / (&(CARD(r:(real^M->bool)->bool)) + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &n + &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `dd:real^M->real^M->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPECL [`d:real^M->real^M->bool`; `dd:real^M->real^M->bool`] + GAUGE_INTER) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN + DISCH_THEN(MP_TAC o SPECL [`u:real^M`; `v:real^M`]) THEN + REWRITE_TAC[FINE_INTER] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `q:(real^M->bool)->(real^M#(real^M->bool))->bool` + STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `p UNION UNIONS {q (i:real^M->bool) | i IN r} + :(real^M#(real^M->bool))->bool`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC FINE_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINE_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE]] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o last o CONJUNCTS o + GEN_REWRITE_RULE I [division_of]) THEN + REWRITE_TAC[UNIONS_UNION] THEN + MATCH_MP_TAC TAGGED_DIVISION_UNION THEN CONJ_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; ALL_TAC] THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC TAGGED_DIVISION_UNIONS THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + SIMP_TAC[FINITE_UNION; IN_UNION] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + REWRITE_TAC[OPEN_INTERIOR] THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[division_of; FINITE_UNION; IN_UNION]; ALL_TAC]) THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC INTER_INTERIOR_UNIONS_INTERVALS THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; OPEN_INTERIOR] THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of; FINITE_IMAGE]; ALL_TAC]) THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MATCH_MP_TAC o el 2 o CONJUNCTS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM] THEN + ASM_REWRITE_TAC[EXISTS_PAIR_THM; IN_IMAGE; IN_INTER; IN_UNION] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `vsum (p UNION UNIONS {q i | i IN r}) (\(x,k). content k % f x) = + vsum p (\(x:real^M,k:real^M->bool). content k % f x:real^N) + + vsum (UNIONS {q i | (i:real^M->bool) IN r}) (\(x,k). content k % f x)` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_UNION_NONZERO THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF_FINITE]; ALL_TAC] THEN + REWRITE_TAC[IN_INTER] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_UNIONS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(l:real^M->bool) SUBSET k` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPECL [`k:real^M->bool`; `l:real^M->bool`] o + el 2 o CONJUNCTS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[IN_UNION; IN_IMAGE; EXISTS_PAIR_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[NOT_IN_EMPTY; GSYM NOT_EXISTS_THM] THEN + ASM_REWRITE_TAC[EXISTS_PAIR_THM; IN_IMAGE; IN_INTER; IN_UNION] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUBSET_INTERIOR; SET_RULE `s SUBSET t ==> t INTER s = s`] THEN + SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` + (fun th -> REPEAT_TCL CHOOSE_THEN SUBST1_TAC th THEN + SIMP_TAC[VECTOR_MUL_LZERO; GSYM CONTENT_EQ_0_INTERIOR]) THEN + ASM_MESON_TAC[tagged_partial_division_of]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_UNIONS_NONZERO o + rand o lhand o rand o lhand o lhand o snd) THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; IN_UNION]; ALL_TAC] THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + X_GEN_TAC `l:real^M->bool` THEN DISCH_TAC THEN + DISCH_TAC THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `m:real^M->bool`] THEN + DISCH_TAC THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN + SUBGOAL_THEN `?u v:real^M. m = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF; IN_UNION]; ALL_TAC] THEN + REWRITE_TAC[CONTENT_EQ_0_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE `!t. s SUBSET t /\ t = {} ==> s = {}`) THEN + EXISTS_TAC `interior(k INTER l:real^M->bool)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[SUBSET_INTER] THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + REWRITE_TAC[INTERIOR_INTER] THEN + DISCH_THEN(MATCH_MP_TAC o SPECL [`k:real^M->bool`; `l:real^M->bool`] o + el 2 o CONJUNCTS) THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_UNION] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_IMAGE_NONZERO o + rand o lhand o rand o lhand o lhand o snd) THEN + ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `l:real^M->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_0 THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `m:real^M->bool`] THEN DISCH_TAC THEN + MP_TAC(ASSUME `!i:real^M->bool. i IN r ==> q i tagged_division_of i`) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `l:real^M->bool` th) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPEC `k:real^M->bool` th) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC]) THEN + ASM_REWRITE_TAC[tagged_division_of] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `vsum p (\(x,k). content k % (f:real^M->real^N) x - integral k f) = + vsum p (\(x,k). content k % f x) - vsum p (\(x,k). integral k f)` + SUBST1_TAC THENL [ASM_SIMP_TAC[GSYM VSUM_SUB; LAMBDA_PAIR_THM]; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `!ir. ip + ir = i /\ + norm(cr - ir) < k + ==> norm((cp + cr) - i) < e ==> norm(cp - ip) <= e + k`) THEN + EXISTS_TAC `vsum r (\k. integral k (f:real^M->real^N))` THEN CONJ_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum (IMAGE SND (p:(real^M#(real^M->bool))->bool) UNION r) + (\k. integral k (f:real^M->real^N))` THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[INTEGRAL_COMBINE_DIVISION_TOPDOWN]] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum (IMAGE SND (p:(real^M#(real^M->bool))->bool)) + (\k. integral k (f:real^M->real^N)) + + vsum r (\k. integral k f)` THEN + CONJ_TAC THENL + [ALL_TAC; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN + ASM_SIMP_TAC[FINITE_IMAGE; NOT_IN_EMPTY]] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `(\(x:real^M,k). integral k (f:real^M->real^N)) = + (\k. integral k f) o SND` + SUBST1_TAC THENL + [SIMP_TAC[o_THM; FUN_EQ_THM; FORALL_PAIR_THM]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`x:real^M`; `l:real^M->bool`; `y:real^M`; `m:real^M->bool`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [tagged_partial_division_of]) THEN + DISCH_THEN(CONJUNCTS_THEN MP_TAC o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPECL + [`x:real^M`; `l:real^M->bool`; `y:real^M`; `l:real^M->bool`]) THEN + ASM_REWRITE_TAC[INTER_IDEMPOT] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC o last o CONJUNCTS) THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_NULL THEN + ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM VSUM_SUB] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (r:(real^M->bool)->bool) (\x. k / (&(CARD r) + &1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ASM_SIMP_TAC[SUM_CONST] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &x + &1`] THEN + REWRITE_TAC[REAL_ARITH `a * k < k * b <=> &0 < k * (b - a)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +let HENSTOCK_LEMMA_PART2 = prove + (`!f:real^M->real^N a b d e. + f integrable_on interval[a,b] /\ + &0 < e /\ gauge d /\ + (!p. p tagged_division_of interval[a,b] /\ d fine p + ==> norm (vsum p (\(x,k). content k % f x) - + integral(interval[a,b]) f) < e) + ==> !p. p tagged_partial_division_of interval[a,b] /\ d fine p + ==> sum p (\(x,k). norm(content k % f x - + integral k f)) + <= &2 * &(dimindex(:N)) * e`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LAMBDA_PAIR] THEN + MATCH_MP_TAC VSUM_NORM_ALLSUBSETS_BOUND THEN + REWRITE_TAC[LAMBDA_PAIR_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + X_GEN_TAC `q:(real^M#(real^M->bool))->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + HENSTOCK_LEMMA_PART1) THEN + MAP_EVERY EXISTS_TAC + [`a:real^M`; `b:real^M`; `d:real^M->real^M->bool`] THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[FINE_SUBSET; TAGGED_PARTIAL_DIVISION_SUBSET]);; + +let HENSTOCK_LEMMA = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> !e. &0 < e + ==> ?d. gauge d /\ + !p. p tagged_partial_division_of interval[a,b] /\ + d fine p + ==> sum p (\(x,k). norm(content k % f x - + integral k f)) < e`, + MP_TAC HENSTOCK_LEMMA_PART2 THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN MP_TAC th) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + GEN_REWRITE_TAC LAND_CONV [has_integral] THEN + DISCH_THEN(MP_TAC o SPEC `e / (&2 * (&(dimindex(:N)) + &1))`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2 * (&n + &1)`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPECL + [`d:real^M->real^M->bool`; `e / (&2 * (&(dimindex(:N)) + &1))`]) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &2 * (&n + &1)`] THEN + DISCH_THEN(fun th -> EXISTS_TAC `d:real^M->real^M->bool` THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `d < e ==> x <= d ==> x < e`) THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; REAL_MUL_ASSOC] THEN + SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Monotone convergence (bounded interval first). *) +(* ------------------------------------------------------------------------- *) + +let MONOTONE_CONVERGENCE_INTERVAL = prove + (`!f:num->real^N->real^1 g a b. + (!k. (f k) integrable_on interval[a,b]) /\ + (!k x. x IN interval[a,b] ==> drop(f k x) <= drop(f (SUC k) x)) /\ + (!x. x IN interval[a,b] ==> ((\k. f k x) --> g x) sequentially) /\ + bounded {integral (interval[a,b]) (f k) | k IN (:num)} + ==> g integrable_on interval[a,b] /\ + ((\k. integral (interval[a,b]) (f k)) + --> integral (interval[a,b]) g) sequentially`, + let lemma = prove + (`{(x,y) | P x y} = {p | P (FST p) (SND p)}`, + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_ELIM_THM]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `content(interval[a:real^N,b]) = &0` THENL + [ASM_SIMP_TAC[INTEGRAL_NULL; INTEGRABLE_ON_NULL; LIM_CONST]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONTENT_LT_NZ])] THEN + SUBGOAL_THEN + `!x:real^N k:num. x IN interval[a,b] ==> drop(f k x) <= drop(g x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\k. (f:num->real^N->real^1) k x` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[REAL_LE_TRANS] THEN + ASM_SIMP_TAC[REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `?i. ((\k. integral (interval[a,b]) (f k:real^N->real^1)) --> i) + sequentially` + CHOOSE_TAC THENL + [MATCH_MP_TAC BOUNDED_INCREASING_CONVERGENT THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k. drop(integral(interval[a,b]) ((f:num->real^N->real^1) k)) <= drop i` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\k. integral(interval[a,b]) ((f:num->real^N->real^1) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN + GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `((g:real^N->real^1) has_integral i) (interval[a,b])` + ASSUME_TAC THENL + [REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [HAS_INTEGRAL_INTEGRAL]) THEN + REWRITE_TAC[has_integral] THEN + DISCH_THEN(MP_TAC o GEN `k:num` o + SPECL [`k:num`; `e / &2 pow (k + 2)`]) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC LAND_CONV [SKOLEM_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `b:num->real^N->real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?r. !k. r:num <= k + ==> &0 <= drop i - drop(integral(interval[a:real^N,b]) (f k)) /\ + drop i - drop(integral(interval[a,b]) (f k)) < e / &4` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[ABS_DROP; dist; DROP_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= y ==> abs(x - y) < e ==> &0 <= y - x /\ y - x < e`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN interval[a:real^N,b] + ==> ?n. r:num <= n /\ + !k. n <= k ==> &0 <= drop(g x) - drop(f k x) /\ + drop(g x) - drop(f k x) < + e / (&4 * content(interval[a,b]))` + MP_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o RAND_CONV) + [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[REAL_SUB_LE] THEN + DISCH_THEN(MP_TAC o SPEC `e / (&4 * content(interval[a:real^N,b]))`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[dist; ABS_DROP; DROP_SUB] THEN + ASM_SIMP_TAC[REAL_ARITH `f <= g ==> abs(f - g) = g - f`] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N + r:num` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[ARITH_RULE `N + r:num <= k ==> N <= k`]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + REWRITE_TAC[FORALL_AND_THM; TAUT + `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `m:real^N->num` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `d:real^N->real^N->bool = \x. b(m x:num) x` THEN + EXISTS_TAC `d:real^N->real^N->bool` THEN CONJ_TAC THENL + [EXPAND_TAC "d" THEN REWRITE_TAC[gauge] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [gauge]) THEN + SIMP_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `p:(real^N#(real^N->bool))->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `!b c. norm(a - b) <= e / &4 /\ + norm(b - c) < e / &2 /\ + norm(c - d) < e / &4 + ==> norm(a - d) < e`) THEN + EXISTS_TAC `vsum p (\(x:real^N,k:real^N->bool). + content k % (f:num->real^N->real^1) (m x) x)` THEN + EXISTS_TAC `vsum p (\(x:real^N,k:real^N->bool). + integral k ((f:num->real^N->real^1) (m x)))` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + SUBGOAL_THEN `?s:num. !t:real^N#(real^N->bool). t IN p ==> m(FST t) <= s` + MP_TAC THENL [ASM_SIMP_TAC[UPPER_BOUND_FINITE_SET]; ALL_TAC] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN DISCH_THEN(X_CHOOSE_TAC `s:num`) THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM VSUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN + REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB] THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `y <= e ==> x <= y ==> x <= e`) THEN + REWRITE_TAC[LAMBDA_PAIR_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum p (\(x:real^N,k:real^N->bool). + content k * e / (&4 * content (interval[a:real^N,b])))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `k:real^N->bool`] THEN + DISCH_TAC THEN REWRITE_TAC[NORM_MUL; GSYM VECTOR_SUB_LDISTRIB] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + REWRITE_TAC[ABS_DROP; DROP_SUB] THEN + REWRITE_TAC[REAL_ARITH `abs(x) <= x <=> &0 <= x`] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= g - f /\ g - f < e ==> abs(g - f) <= e`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[LE_REFL] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[LAMBDA_PAIR; SUM_RMUL] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP + ADDITIVE_CONTENT_TAGGED_DIVISION th]) THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + UNDISCH_TAC `&0 < content(interval[a:real^N,b])` THEN + CONV_TAC REAL_FIELD; + ASM_SIMP_TAC[GSYM VSUM_SUB] THEN REWRITE_TAC[LAMBDA_PAIR_THM] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `norm(vsum (0..s) + (\j. vsum {(x:real^N,k:real^N->bool) | (x,k) IN p /\ m(x) = j} + (\(x,k). content k % f (m x) x :real^1 - + integral k (f (m x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[lemma] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(GSYM VSUM_GROUP) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG; LE_0] THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (0..s) (\i. e / &2 pow (i + 2))` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div; GSYM REAL_POW_INV; SUM_LMUL] THEN + REWRITE_TAC[REAL_POW_ADD; SUM_RMUL] THEN REWRITE_TAC[SUM_GP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; CONJUNCT1 LT] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x * y ==> (&1 - x) * y < y`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_POW_LT THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `t:num` THEN REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `norm(vsum {x:real^N,k:real^N->bool | x,k IN p /\ m x:num = t} + (\(x,k). content k % f t x - integral k (f t)):real^1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + HENSTOCK_LEMMA_PART1) THEN + MAP_EVERY EXISTS_TAC + [`a:real^N`; `b:real^N`; `(b(t:num)):real^N->real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + CONJ_TAC THENL + [MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_SUBSET THEN + EXISTS_TAC `p:(real^N#(real^N->bool))->bool` THEN + SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + ASM_MESON_TAC[tagged_division_of]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + EXPAND_TAC "d" THEN REWRITE_TAC[fine; IN_ELIM_PAIR_THM] THEN MESON_TAC[]; + + MP_TAC(ISPECL [`(f:num->real^N->real^1) s`; `a:real^N`; `b:real^N`; + `p:(real^N#(real^N->bool))->bool`] + INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN + MP_TAC(ISPECL [`(f:num->real^N->real^1) r`; `a:real^N`; `b:real^N`; + `p:(real^N#(real^N->bool))->bool`] + INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN + ASM_SIMP_TAC[ABS_DROP; DROP_SUB; DROP_VSUM; GSYM DROP_EQ] THEN + REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM] THEN MATCH_MP_TAC(REAL_ARITH + `sr <= sx /\ sx <= ss /\ ks <= i /\ &0 <= i - kr /\ i - kr < e + ==> kr = sr ==> ks = ss ==> abs(sx - i) < e`) THEN + ASM_SIMP_TAC[LE_REFL] THEN CONJ_TAC THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `i:real^N->bool`] THEN DISCH_TAC THEN + (SUBGOAL_THEN `i SUBSET interval[a:real^N,b]` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + SUBGOAL_THEN `?u v:real^N. i = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC]) THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL]; ALL_TAC]) THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPEC + `\m n:num. drop (f m (y:real^N)) <= drop (f n y)` + TRANSITIVE_STEPWISE_LE) THEN + REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL] THEN + (ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC]) THEN + DISCH_THEN MATCH_MP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + ASM_REWRITE_TAC[]);; + +let MONOTONE_CONVERGENCE_INCREASING = prove + (`!f:num->real^N->real^1 g s. + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ + bounded {integral s (f k) | k IN (:num)} + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + SUBGOAL_THEN + `!f:num->real^N->real^1 g s. + (!k x. x IN s ==> &0 <= drop(f k x)) /\ + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ + bounded {integral s (f k) | k IN (:num)} + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o ISPECL + [`\n x:real^N. f(SUC n) x - f 0 x:real^1`; + `\x. (g:real^N->real^1) x - f 0 x`; `s:real^N->bool`]) THEN + REWRITE_TAC[] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN + MP_TAC(ISPEC + `\m n:num. drop (f m (x:real^N)) <= drop (f n x)` + TRANSITIVE_STEPWISE_LE) THEN + REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL] THEN ASM_MESON_TAC[LE_0]; + GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `x - a <= y - a <=> x <= y`]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_SUB THEN SIMP_TAC[LIM_CONST] THEN + REWRITE_TAC[ADD1] THEN + MATCH_MP_TAC(ISPECL[`f:num->real^1`; `l:real^1`; `1`] SEQ_OFFSET) THEN + ASM_SIMP_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX; bounded] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` + (fun th -> EXISTS_TAC `B + norm(integral s (f 0:real^N->real^1))` THEN + X_GEN_TAC `k:num` THEN MP_TAC(SPEC `SUC k` th))) THEN + NORM_ARITH_TAC; + ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX; IMP_CONJ] THEN + SUBGOAL_THEN `(f 0:real^N->real^1) integrable_on s` MP_TAC THENL + [ASM_REWRITE_TAC[]; ONCE_REWRITE_TAC[IMP_IMP]] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_ADD) THEN + REWRITE_TAC[ETA_AX; VECTOR_ARITH `f + (g - f):real^N = g`] THEN + DISCH_TAC THEN ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX] THEN + MP_TAC(ISPECL [`sequentially`; `integral s (f 0:real^N->real^1)`] + LIM_CONST) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + REWRITE_TAC[ETA_AX; VECTOR_ARITH `f + (g - f):real^N = g`] THEN + REWRITE_TAC[ADD1] THEN + SIMP_TAC[ISPECL[`f:num->real^1`; `l:real^1`; `1`] SEQ_OFFSET_REV]]] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^N k:num. x IN s ==> drop(f k x) <= drop(g x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\k. (f:num->real^N->real^1) k x` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN REWRITE_TAC[REAL_LE_TRANS] THEN + ASM_SIMP_TAC[REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `?i. ((\k. integral s (f k:real^N->real^1)) --> i) + sequentially` + CHOOSE_TAC THENL + [MATCH_MP_TAC BOUNDED_INCREASING_CONVERGENT THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k. drop(integral s ((f:num->real^N->real^1) k)) <= drop i` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND) THEN + EXISTS_TAC `\k. integral(s) ((f:num->real^N->real^1) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `k:num` THEN SPEC_TAC(`k:num`,`k:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN + GEN_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `((g:real^N->real^1) has_integral i) s` ASSUME_TAC THENL + [ALL_TAC; + CONJ_TAC THENL [ASM_MESON_TAC[integrable_on]; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[HAS_INTEGRAL_ALT] THEN + MP_TAC(ISPECL + [`\k x. if x IN s then (f:num->real^N->real^1) k x else vec 0`; + `\x. if x IN s then (g:real^N->real^1) x else vec 0`] + (MATCH_MP(MESON[] `(!a b c d. P a b c d ==> Q a b c d) + ==> !a b. (!c d. P a b c d) ==> (!c d. Q a b c d)`) + MONOTONE_CONVERGENCE_INTERVAL)) THEN + ANTS_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [INTEGRABLE_ALT]) THEN + SIMP_TAC[]; + DISCH_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[LIM_CONST]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[ABS_DROP] THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ y <= x ==> abs(x) <= a ==> abs(y) <= a`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_REFL; DROP_VEC]; + ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN + ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; ETA_AX] THEN + GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_REFL; DROP_VEC; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[dist; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [HAS_INTEGRAL_INTEGRAL]) THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPECL [`N:num`; `e / &4`]) THEN + ASM_SIMP_TAC[dist; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o C MATCH_MP (ARITH_RULE `N:num <= N`)) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `norm(x - y) < e / &4 /\ norm(z - x) < e / &4 + ==> norm(z - y) < e / &2`)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV) + [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`; `e / &2`]) THEN + ASM_REWRITE_TAC[dist; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M + N:num`)) THEN + REWRITE_TAC[LE_ADD; ABS_DROP; DROP_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `f1 <= f2 /\ f2 <= i + ==> abs(f2 - g) < e / &2 ==> abs(f1 - i) < e / &2 ==> abs(g - i) < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + MP_TAC(ISPEC + `\m n:num. drop (f m (x:real^N)) <= drop (f n x)` + TRANSITIVE_STEPWISE_LE) THEN + REWRITE_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral s ((f:num->real^N->real^1) (M + N)))` THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN + ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; ETA_AX] THEN + GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_REFL; DROP_VEC; REAL_LE_REFL]);; + +let MONOTONE_CONVERGENCE_DECREASING = prove + (`!f:num->real^N->real^1 g s. + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f (SUC k) x) <= drop(f k x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) /\ + bounded {integral s (f k) | k IN (:num)} + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`(\k x. --(f k x)):num->real^N->real^1`; + `(\x. --(g x)):real^N->real^1`; `s:real^N->bool`] + MONOTONE_CONVERGENCE_INCREASING) THEN + FIRST_ASSUM MP_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> d) ==> a ==> (b ==> c) ==> d`) THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_NEG) THEN REWRITE_TAC[]; + SIMP_TAC[DROP_NEG; REAL_LE_NEG2]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NEG THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `IMAGE (\x. --x) + {integral s (f k:real^N->real^1) | k IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN + ASM_SIMP_TAC[LINEAR_COMPOSE_NEG; LINEAR_ID]; + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[o_THM] THEN + MATCH_MP_TAC INTEGRAL_NEG THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o MATCH_MP INTEGRABLE_NEG) (MP_TAC o MATCH_MP LIM_NEG)) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN TRY GEN_TAC THEN + MATCH_MP_TAC(VECTOR_ARITH `x:real^N = --y ==> --x = y`) THEN + MATCH_MP_TAC INTEGRAL_NEG THEN ASM_REWRITE_TAC[]);; + +let MONOTONE_CONVERGENCE_INCREASING_AE = prove + (`!f:num->real^N->real^1 g s t. + (!k. (f k) integrable_on s) /\ + negligible t /\ + (!k x. x IN s DIFF t ==> drop(f k x) <= drop(f (SUC k) x)) /\ + (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) /\ + bounded {integral s (f k) | k IN (:num)} + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\n x. if x IN t then vec 0 + else (f:num->real^N->real^1) n x`; + `\x. if x IN t then vec 0 + else (g:real^N->real^1) x`; `s:real^N->bool`] + MONOTONE_CONVERGENCE_INCREASING) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `(f:num->real^N->real^1) k` THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]; + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[LIM_CONST] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + BOUNDED_SUBSET)) THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) + ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]; + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]]);; + +let MONOTONE_CONVERGENCE_DECREASING_AE = prove + (`!f:num->real^N->real^1 g s t. + (!k. (f k) integrable_on s) /\ + negligible t /\ + (!k x. x IN s DIFF t ==> drop(f (SUC k) x) <= drop(f k x)) /\ + (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) /\ + bounded {integral s (f k) | k IN (:num)} + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\n x. if x IN t then vec 0 + else (f:num->real^N->real^1) n x`; + `\x. if x IN t then vec 0 + else (g:real^N->real^1) x`; `s:real^N->bool`] + MONOTONE_CONVERGENCE_DECREASING) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `(f:num->real^N->real^1) k` THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]; + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[LIM_CONST] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + BOUNDED_SUBSET)) THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) + ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]; + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]]);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas about existence and bounds between integrals. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_NORM_BOUND_INTEGRAL = prove + (`!f:real^M->real^N g s. + f integrable_on s /\ g integrable_on s /\ + (!x. x IN s ==> norm(f x) <= drop(g x)) + ==> norm(integral s f) <= drop(integral s g)`, + let lemma = prove + (`(!e. &0 < e ==> x < y + e) ==> x <= y`, + DISCH_THEN(MP_TAC o SPEC `x - y:real`) THEN REAL_ARITH_TAC) in + SUBGOAL_THEN + `!f:real^M->real^N g a b. + f integrable_on interval[a,b] /\ g integrable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> norm(f x) <= drop(g x)) + ==> norm(integral(interval[a,b]) f) <= drop(integral(interval[a,b]) g)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `(f:real^M->real^N) integrable_on interval[a,b]` THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + REWRITE_TAC[has_integral] THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d1:real^M->real^M->bool` THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d2:real^M->real^M->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPECL [`d1:real^M->real^M->bool`; `d2:real^M->real^M->bool`] + GAUGE_INTER) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN + REWRITE_TAC[FINE_INTER; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN + ASM_REWRITE_TAC[ABS_DROP; DROP_SUB] THEN MATCH_MP_TAC(NORM_ARITH + `norm(sg) <= dsa + ==> abs(dsa - dia) < e / &2 ==> norm(sg - ig) < e / &2 + ==> norm(ig) < dia + e`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[DROP_VSUM] THEN MATCH_MP_TAC VSUM_NORM_LE THEN + ASM_REWRITE_TAC[o_DEF; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + REWRITE_TAC[NORM_MUL; DROP_CMUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + REWRITE_TAC[REAL_ARITH `abs x <= x <=> &0 <= x`] THEN + ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF; SUBSET]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN (fun th -> + ASSUME_TAC(CONJUNCT1(GEN_REWRITE_RULE I [INTEGRABLE_ALT] th)) THEN + MP_TAC(MATCH_MP INTEGRABLE_INTEGRAL th))) THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN + DISCH_THEN(LABEL_TAC "A") THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "A" (MP_TAC o SPEC `e / &2`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "F"))) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A"))) THEN + MP_TAC(ISPEC `ball(vec 0,max B1 B2):real^M->bool` + BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[BALL_MAX_UNION; UNION_SUBSET] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^1` (CONJUNCTS_THEN2 ASSUME_TAC + (fun th -> DISCH_THEN(X_CHOOSE_THEN `w:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN MP_TAC th))) THEN + ASM_REWRITE_TAC[ABS_DROP; DROP_SUB] THEN MATCH_MP_TAC(NORM_ARITH + `norm(sg) <= dsa + ==> abs(dsa - dia) < e / &2 ==> norm(sg - ig) < e / &2 + ==> norm(ig) < dia + e`) THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM o MATCH_MP INTEGRAL_UNIQUE)) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_LE_REFL]);; + +let INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT = prove + (`!f:real^M->real^N g:real^M->real^P s k. + 1 <= k /\ k <= dimindex(:P) /\ + f integrable_on s /\ g integrable_on s /\ + (!x. x IN s ==> norm(f x) <= (g x)$k) + ==> norm(integral s f) <= (integral s g)$k`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral s ((\y. lift(y$k)) o (g:real^M->real^P)))` THEN + SUBGOAL_THEN `linear(\y:real^P. lift(y$k))` ASSUME_TAC THENL + [ASM_SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LIFT_ADD; LIFT_CMUL]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[o_THM; LIFT_DROP] THEN MATCH_MP_TAC INTEGRABLE_LINEAR THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `integral s ((\y. lift (y$k)) o (g:real^M->real^P)) = + (\y. lift (y$k)) (integral s g)` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_LINEAR THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]]);; + +let HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT = prove + (`!f:real^M->real^N g:real^M->real^P s i j k. + 1 <= k /\ k <= dimindex(:P) /\ + (f has_integral i) s /\ (g has_integral j) s /\ + (!x. x IN s ==> norm(f x) <= (g x)$k) + ==> norm(i) <= j$k`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(fun th -> + SUBST1_TAC(SYM(MATCH_MP INTEGRAL_UNIQUE th)) THEN + ASSUME_TAC(MATCH_MP HAS_INTEGRAL_INTEGRABLE th))) THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT THEN + ASM_REWRITE_TAC[]);; + +let INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND = prove + (`!f:real^M->real^N g s. + (!a b. (\x. if x IN s then f x else vec 0) + integrable_on interval[a,b]) /\ + (!x. x IN s ==> norm(f x) <= drop(g x)) /\ + g integrable_on s + ==> f integrable_on s`, + let lemma = prove + (`!f:real^M->real^N g. + (!a b. f integrable_on interval[a,b]) /\ + (!x. norm(f x) <= drop(g x)) /\ + g integrable_on (:real^M) + ==> f integrable_on (:real^M)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[INTEGRABLE_ALT_SUBSET] THEN + ASM_REWRITE_TAC[IN_UNIV; ETA_AX] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < c ==> a < c`) THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_DIFF; NEGLIGIBLE_EMPTY; + SET_RULE `s SUBSET t ==> s DIFF t = {}`] THEN + REWRITE_TAC[ABS_DROP] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_MESON_TAC[integrable_on; HAS_INTEGRAL_DIFF; NEGLIGIBLE_EMPTY; + SET_RULE `s SUBSET t ==> s DIFF t = {}`]) in + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN + DISCH_TAC THEN MATCH_MP_TAC lemma THEN + EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN + ASM_REWRITE_TAC[] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit limit statement for integrals over [0,inf]. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_LIM_AT_POSINFINITY = prove + (`!f l:real^N. + (f has_integral l) {t | &0 <= drop t} <=> + (!a. f integrable_on interval[vec 0,a]) /\ + ((\a. integral (interval[vec 0,lift a]) f) --> l) at_posinfinity`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_INTER; INTEGRABLE_RESTRICT_INTER] THEN + SUBGOAL_THEN + `!a b. {t | &0 <= drop t} INTER interval[a,b] = + interval[lift(max (&0) (drop a)),b]` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[EXTENSION; FORALL_LIFT; IN_INTER; IN_INTERVAL_1; + LIFT_DROP; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[LIM_AT_POSINFINITY; dist; real_ge] THEN + EQ_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `a:real^1` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `a:real^1`]) THEN + REWRITE_TAC[DROP_VEC; LIFT_NUM; REAL_ARITH `max x x = x`]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + X_GEN_TAC `b:real` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPECL [`lift(--b)`; `lift b`]) THEN + REWRITE_TAC[DROP_VEC; LIFT_NUM; LIFT_DROP] THEN + SUBGOAL_THEN `max (&0) (--b) = &0` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[LIFT_NUM]] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b:real^1`) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_SUBINTERVAL) THEN + SIMP_TAC[SUBSET_INTERVAL_1; DROP_ADD; DROP_SUB; DROP_VEC; LIFT_DROP] THEN + REAL_ARITH_TAC; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` (LABEL_TAC "*")) THEN + EXISTS_TAC `abs B + &1` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN + REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; LIFT_DROP] THEN + STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `max (&0) (drop a) = &0` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[LIFT_NUM]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop b`) THEN + REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]);; + +let HAS_INTEGRAL_LIM_SEQUENTIALLY = prove + (`!f:real^1->real^N l. + (f o lift --> vec 0) at_posinfinity /\ + (!n. f integrable_on interval[vec 0,vec n]) /\ + ((\n. integral (interval[vec 0,vec n]) f) --> l) sequentially + ==> (f has_integral l) {t | &0 <= drop t}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL_LIM_AT_POSINFINITY] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [X_GEN_TAC `a:real^1` THEN MP_TAC(SPEC `drop a` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_SUBINTERVAL) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC] THEN + REWRITE_TAC[LIM_AT_POSINFINITY; real_ge] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_POSINFINITY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; o_THM; real_ge; FORALL_DROP; LIFT_DROP] THEN + REWRITE_TAC[DIST_0; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `max (&N) B + &1` THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN MP_TAC(SPEC `drop x` FLOOR_POS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + SUBGOAL_THEN + `integral(interval[vec 0,x]) (f:real^1->real^N) = + integral(interval[vec 0,vec n]) f + integral(interval[vec n,x]) f` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE THEN + ASM_REWRITE_TAC[DROP_VEC] THEN + MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `dist(a:real^N,l) < e / &2 /\ norm b <= e / &2 ==> dist(a + b,l) < e`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS + `drop(integral(interval[vec n:real^1,x]) (\x. lift(e / &2)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST; IN_INTERVAL_1; LIFT_DROP] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `interval[vec 0:real^1,x]` THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; DROP_VEC] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[INTEGRAL_CONST] THEN IMP_REWRITE_TAC[CONTENT_1] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_DROP; DROP_VEC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + MP_TAC(SPEC `drop x` FLOOR) THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[DROP_VEC] THEN MP_TAC(SPEC `drop x` FLOOR) THEN + ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Interval functions of bounded variation on a set. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_bounded_setvariation_on",(12,"right"));; + +let set_variation = new_definition + `set_variation s (f:(real^M->bool)->real^N) = + sup { sum d (\k. norm(f k)) | ?t. d division_of t /\ t SUBSET s}`;; + +let has_bounded_setvariation_on = new_definition + `(f:(real^M->bool)->real^N) has_bounded_setvariation_on s <=> + ?B. !d t. d division_of t /\ t SUBSET s + ==> sum d (\k. norm(f k)) <= B`;; + +let HAS_BOUNDED_SETVARIATION_ON = prove + (`!f:(real^M->bool)->real^N s. + f has_bounded_setvariation_on s <=> + ?B. &0 < B /\ !d t. d division_of t /\ t SUBSET s + ==> sum d (\k. norm(f k)) <= B`, + REWRITE_TAC[has_bounded_setvariation_on] THEN + MESON_TAC[REAL_ARITH `&0 < abs B + &1 /\ (x <= B ==> x <= abs B + &1)`]);; + +let HAS_BOUNDED_SETVARIATION_ON_EQ = prove + (`!f g:(real^M->bool)->real^N s. + (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s + ==> f(interval[a,b]) = g(interval[a,b])) /\ + f has_bounded_setvariation_on s + ==> g has_bounded_setvariation_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[has_bounded_setvariation_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:(real^M->bool)->bool` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^M->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= B ==> y <= B`) THEN + MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]);; + +let SET_VARIATION_EQ = prove + (`!f g:(real^M->bool)->real^N s. + (!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s + ==> f(interval[a,b]) = g(interval[a,b])) + ==> set_variation s f = set_variation s g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]);; + +let HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE = prove + (`!f:(real^M->bool)->real^N s. + f has_bounded_setvariation_on s <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\k. lift(f k$i)) has_bounded_setvariation_on s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_setvariation_on; NORM_LIFT] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `B:real` THEN + MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`d:(real^M->bool)->bool`; `t:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_MESON_TAC[DIVISION_OF_FINITE]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:num->real` THEN DISCH_TAC THEN + EXISTS_TAC `sum (1..dimindex(:N)) B` THEN + MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d (\k. sum (1..dimindex(:N)) + (\i. abs(((f:(real^M->bool)->real^N) k)$i)))` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[SUM_LE; NORM_LE_L1] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN + ASM_SIMP_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_MESON_TAC[]]);; + +let SETVARIATION_EQUAL_LEMMA = prove + (`!mf:((real^M->bool)->real^N)->((real^M->bool)->real^N) ms ms'. + (!s. ms'(ms s) = s /\ ms(ms' s) = s) /\ + (!f a b. ~(interval[a,b] = {}) + ==> mf f (ms (interval[a,b])) = f (interval[a,b]) /\ + ?a' b'. ~(interval[a',b'] = {}) /\ + ms' (interval[a,b]) = interval[a',b']) /\ + (!t u. t SUBSET u ==> ms t SUBSET ms u /\ ms' t SUBSET ms' u) /\ + (!d t. d division_of t + ==> (IMAGE ms d) division_of ms t /\ + (IMAGE ms' d) division_of ms' t) + ==> (!f s. (mf f) has_bounded_setvariation_on (ms s) <=> + f has_bounded_setvariation_on s) /\ + (!f s. set_variation (ms s) (mf f) = set_variation s f)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN + MATCH_MP_TAC(MESON[] + `((!f s. s1 f s = s2 f s) ==> P) /\ + (!f s. s1 f s = s2 f s) + ==> P /\ (!f s. sup (s1 f s) = sup (s2 f s))`) THEN + CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `IMAGE (ms':(real^M->bool)->real^M->bool) d`; + EXISTS_TAC `IMAGE (ms:(real^M->bool)->real^M->bool) d`] THEN + (CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o rand o snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC]) THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[o_THM] THEN FIRST_ASSUM + (fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN STRIP_TAC THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `?a' b':real^M. ~(interval[a',b'] = {}) /\ + ms' (interval[a:real^M,b]) = interval[a',b']` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY = prove + (`!f:(real^M->bool)->real^N s. + (?d. d division_of s) + ==> (f has_bounded_setvariation_on s <=> + ?B. !d. d division_of s ==> sum d (\k. norm(f k)) <= B)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[has_bounded_setvariation_on] THEN EQ_TAC THEN + MATCH_MP_TAC MONO_EXISTS THENL [MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `d':(real^M->bool)->bool`) THEN + MP_TAC(ISPECL [`d:(real^M->bool)->bool`; `d':(real^M->bool)->bool`; + `t:real^M->bool`; `s:real^M->bool`] PARTIAL_DIVISION_EXTEND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `d'':(real^M->bool)->bool`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d'' (\k:real^M->bool. norm(f k:real^N))` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]);; + +let HAS_BOUNDED_SETVARIATION_ON_INTERVAL = prove + (`!f:(real^M->bool)->real^N a b. + f has_bounded_setvariation_on interval[a,b] <=> + ?B. !d. d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= B`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY THEN + REWRITE_TAC[ELEMENTARY_INTERVAL]);; + +let HAS_BOUNDED_SETVARIATION_ON_UNIV = prove + (`!f:(real^M->bool)->real^N. + f has_bounded_setvariation_on (:real^M) <=> + ?B. !d. d division_of UNIONS d ==> sum d (\k. norm(f k)) <= B`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_setvariation_on; SUBSET_UNIV] THEN + MESON_TAC[DIVISION_OF_UNION_SELF]);; + +let HAS_BOUNDED_SETVARIATION_ON_SUBSET = prove + (`!f:(real^M->bool)->real^N s t. + f has_bounded_setvariation_on s /\ t SUBSET s + ==> f has_bounded_setvariation_on t`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[has_bounded_setvariation_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[SUBSET_TRANS]);; + +let HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS = prove + (`!f:(real^M->bool)->real^N s. + f has_bounded_setvariation_on s + ==> bounded { f(interval[c,d]) | interval[c,d] SUBSET s}`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on; bounded] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + EXISTS_TAC `max (abs B) (norm((f:(real^M->bool)->real^N) {}))` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN DISCH_TAC THEN + ASM_CASES_TAC `interval[c:real^M,d] = {}` THEN + ASM_REWRITE_TAC[REAL_ARITH `a <= max b a`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`{interval[c:real^M,d]}`; `interval[c:real^M,d]`]) THEN + ASM_SIMP_TAC[DIVISION_OF_SELF; SUM_SING] THEN REAL_ARITH_TAC);; + +let HAS_BOUNDED_SETVARIATION_ON_NORM = prove + (`!f:(real^M->bool)->real^N s. + (\x. lift(norm(f x))) has_bounded_setvariation_on s <=> + f has_bounded_setvariation_on s`, + REWRITE_TAC[has_bounded_setvariation_on; NORM_REAL; GSYM drop] THEN + REWRITE_TAC[REAL_ABS_NORM; LIFT_DROP]);; + +let HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR = prove + (`!f:(real^M->bool)->real^N g:real^N->real^P s. + f has_bounded_setvariation_on s /\ linear g + ==> (g o f) has_bounded_setvariation_on s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `C:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN + EXISTS_TAC `B * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN + STRIP_TAC THEN REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d (\k. C * norm((f:(real^M->bool)->real^N) k))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[DIVISION_OF_FINITE]; + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + ASM_MESON_TAC[]]);; + +let HAS_BOUNDED_SETVARIATION_ON_0 = prove + (`!s:real^N->bool. (\x. vec 0) has_bounded_setvariation_on s`, + REWRITE_TAC[has_bounded_setvariation_on; NORM_0; SUM_0] THEN + MESON_TAC[REAL_LE_REFL]);; + +let SET_VARIATION_0 = prove + (`!s:real^N->bool. set_variation s (\x. vec 0) = &0`, + GEN_TAC THEN REWRITE_TAC[set_variation; NORM_0; SUM_0] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SUP_SING] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + MESON_TAC[ELEMENTARY_EMPTY; EMPTY_SUBSET]);; + +let HAS_BOUNDED_SETVARIATION_ON_CMUL = prove + (`!f:(real^M->bool)->real^N c s. + f has_bounded_setvariation_on s + ==> (\x. c % f x) has_bounded_setvariation_on s`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; o_DEF] + HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR) THEN + REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; + +let HAS_BOUNDED_SETVARIATION_ON_NEG = prove + (`!f:(real^M->bool)->real^N s. + (\x. --(f x)) has_bounded_setvariation_on s <=> + f has_bounded_setvariation_on s`, + REWRITE_TAC[has_bounded_setvariation_on; NORM_NEG]);; + +let HAS_BOUNDED_SETVARIATION_ON_ADD = prove + (`!f:(real^M->bool)->real^N g s. + f has_bounded_setvariation_on s /\ + g has_bounded_setvariation_on s + ==> (\x. f x + g x) has_bounded_setvariation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `B + C:real` THEN + MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d (\k. norm((f:(real^M->bool)->real^N) k)) + + sum d (\k. norm((g:(real^M->bool)->real^N) k))` THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_ADD2]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM SUM_ADD] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[NORM_TRIANGLE]);; + +let HAS_BOUNDED_SETVARIATION_ON_SUB = prove + (`!f:(real^M->bool)->real^N g s. + f has_bounded_setvariation_on s /\ + g has_bounded_setvariation_on s + ==> (\x. f x - g x) has_bounded_setvariation_on s`, + REWRITE_TAC[VECTOR_ARITH `x - y:real^N = x + --y`] THEN + SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_ADD; HAS_BOUNDED_SETVARIATION_ON_NEG]);; + +let HAS_BOUNDED_SETVARIATION_ON_NULL = prove + (`!f:(real^M->bool)->real^N s. + (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = vec 0) /\ + content s = &0 /\ bounded s + ==> f has_bounded_setvariation_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN + EXISTS_TAC `&0` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x <= &0`) THEN + MATCH_MP_TAC SUM_EQ_0 THEN REWRITE_TAC[NORM_EQ_0] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]);; + +let SET_VARIATION_ELEMENTARY_LEMMA = prove + (`!f:(real^M->bool)->real^N s. + (?d. d division_of s) + ==> ((!d t. d division_of t /\ t SUBSET s + ==> sum d (\k. norm(f k)) <= b) <=> + (!d. d division_of s ==> sum d (\k. norm(f k)) <= b))`, + REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `d1:(real^M->bool)->bool`) THEN + EQ_TAC THENL [MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `d2:(real^M->bool)->bool` THEN + X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN MP_TAC(ISPECL + [`d2:(real^M->bool)->bool`; `d1:(real^M->bool)->bool`; + `t:real^M->bool`; `s:real^M->bool`] PARTIAL_DIVISION_EXTEND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `d3:(real^M->bool)->bool`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d3 (\k:real^M->bool. norm(f k:real^N))` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN ASM_MESON_TAC[DIVISION_OF_FINITE]);; + +let SET_VARIATION_ON_ELEMENTARY = prove + (`!f:(real^M->bool)->real^N s. + (?d. d division_of s) + ==> set_variation s f = + sup { sum d (\k. norm(f k)) | d division_of s}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[set_variation; sup] THEN + REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN + ASM_SIMP_TAC[SET_VARIATION_ELEMENTARY_LEMMA]);; + +let SET_VARIATION_ON_INTERVAL = prove + (`!f:(real^M->bool)->real^N a b. + set_variation (interval[a,b]) f = + sup { sum d (\k. norm(f k)) | d division_of interval[a,b]}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SET_VARIATION_ON_ELEMENTARY THEN + REWRITE_TAC[ELEMENTARY_INTERVAL]);; + +let HAS_BOUNDED_SETVARIATION_WORKS = prove + (`!f:(real^M->bool)->real^N s. + f has_bounded_setvariation_on s + ==> (!d t. d division_of t /\ t SUBSET s + ==> sum d (\k. norm(f k)) <= set_variation s f) /\ + (!B. (!d t. d division_of t /\ t SUBSET s + ==> sum d (\k. norm (f k)) <= B) + ==> set_variation s f <= B)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_setvariation_on] THEN + DISCH_TAC THEN + MP_TAC(ISPEC `{ sum d (\k. norm((f:(real^M->bool)->real^N) k)) | + ?t. d division_of t /\ t SUBSET s}` + SUP) THEN + REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[set_variation] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`&0`; `{}:(real^M->bool)->bool`] THEN + REWRITE_TAC[SUM_CLAUSES] THEN EXISTS_TAC `{}:real^M->bool` THEN + SIMP_TAC[division_of; EMPTY_SUBSET; NOT_IN_EMPTY; FINITE_EMPTY; UNIONS_0]);; + +let HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY = prove + (`!f:(real^M->bool)->real^N s. + f has_bounded_setvariation_on s /\ (?d. d division_of s) + ==> (!d. d division_of s + ==> sum d (\k. norm(f k)) <= set_variation s f) /\ + (!B. (!d. d division_of s ==> sum d (\k. norm(f k)) <= B) + ==> set_variation s f <= B)`, + SIMP_TAC[GSYM SET_VARIATION_ELEMENTARY_LEMMA] THEN + MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);; + +let HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL = prove + (`!f:(real^M->bool)->real^N a b. + f has_bounded_setvariation_on interval[a,b] + ==> (!d. d division_of interval[a,b] + ==> sum d (\k. norm(f k)) <= set_variation (interval[a,b]) f) /\ + (!B. (!d. d division_of interval[a,b] + ==> sum d (\k. norm(f k)) <= B) + ==> set_variation (interval[a,b]) f <= B)`, + SIMP_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY; ELEMENTARY_INTERVAL]);; + +let SET_VARIATION_UBOUND = prove + (`!f:(real^M->bool)->real^N s B. + f has_bounded_setvariation_on s /\ + (!d t. d division_of t /\ t SUBSET s ==> sum d (\k. norm(f k)) <= B) + ==> set_variation s f <= B`, + MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);; + +let SET_VARIATION_UBOUND_ON_INTERVAL = prove + (`!f:(real^M->bool)->real^N a b B. + f has_bounded_setvariation_on interval[a,b] /\ + (!d. d division_of interval[a,b] ==> sum d (\k. norm(f k)) <= B) + ==> set_variation (interval[a,b]) f <= B`, + SIMP_TAC[GSYM SET_VARIATION_ELEMENTARY_LEMMA; ELEMENTARY_INTERVAL] THEN + MESON_TAC[SET_VARIATION_UBOUND]);; + +let SET_VARIATION_LBOUND = prove + (`!f:(real^M->bool)->real^N s B. + f has_bounded_setvariation_on s /\ + (?d t. d division_of t /\ t SUBSET s /\ B <= sum d (\k. norm(f k))) + ==> B <= set_variation s f`, + MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS; REAL_LE_TRANS]);; + +let SET_VARIATION_LBOUND_ON_INTERVAL = prove + (`!f:(real^M->bool)->real^N a b B. + f has_bounded_setvariation_on interval[a,b] /\ + (?d. d division_of interval[a,b] /\ B <= sum d (\k. norm(f k))) + ==> B <= set_variation (interval[a,b]) f`, + MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL; REAL_LE_TRANS]);; + +let SET_VARIATION = prove + (`!f:(real^M->bool)->real^N s d t. + f has_bounded_setvariation_on s /\ d division_of t /\ t SUBSET s + ==> sum d (\k. norm(f k)) <= set_variation s f`, + MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS]);; + +let SET_VARIATION_WORKS_ON_INTERVAL = prove + (`!f:(real^M->bool)->real^N a b d. + f has_bounded_setvariation_on interval[a,b] /\ + d division_of interval[a,b] + ==> sum d (\k. norm(f k)) <= set_variation (interval[a,b]) f`, + MESON_TAC[HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL]);; + +let SET_VARIATION_POS_LE = prove + (`!f:(real^M->bool)->real^N s. + f has_bounded_setvariation_on s ==> &0 <= set_variation s f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SET_VARIATION)) THEN + DISCH_THEN(MP_TAC o SPECL[`{}:(real^M->bool)->bool`; `{}:real^M->bool`]) THEN + REWRITE_TAC[EMPTY_SUBSET; SUM_CLAUSES; DIVISION_OF_TRIVIAL]);; + +let SET_VARIATION_GE_FUNCTION = prove + (`!f:(real^M->bool)->real^N s a b. + f has_bounded_setvariation_on s /\ + interval[a,b] SUBSET s /\ ~(interval[a,b] = {}) + ==> norm(f(interval[a,b])) <= set_variation s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_LBOUND THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `{interval[a:real^M,b]}` THEN + EXISTS_TAC `interval[a:real^M,b]` THEN + ASM_REWRITE_TAC[SUM_SING; REAL_LE_REFL] THEN + ASM_SIMP_TAC[DIVISION_OF_SELF]);; + +let SET_VARIATION_ON_NULL = prove + (`!f:(real^M->bool)->real^N s. + (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = vec 0) /\ + content s = &0 /\ bounded s + ==> set_variation s f = &0`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC SET_VARIATION_UBOUND THEN + ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x = &0 ==> x <= &0`) THEN + MATCH_MP_TAC SUM_EQ_0 THEN REWRITE_TAC[NORM_EQ_0] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]; + MATCH_MP_TAC SET_VARIATION_POS_LE THEN + ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL]]);; + +let SET_VARIATION_TRIANGLE = prove + (`!f:(real^M->bool)->real^N g s. + f has_bounded_setvariation_on s /\ + g has_bounded_setvariation_on s + ==> set_variation s (\x. f x + g x) + <= set_variation s f + set_variation s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SET_VARIATION_UBOUND THEN + ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_ADD] THEN + MAP_EVERY X_GEN_TAC [`d:(real^M->bool)->bool`; `t:real^M->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d (\k. norm((f:(real^M->bool)->real^N) k)) + + sum d (\k. norm((g:(real^M->bool)->real^N) k))` THEN + CONJ_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM SUM_ADD] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[NORM_TRIANGLE]; + MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THEN MATCH_MP_TAC SET_VARIATION THEN ASM_MESON_TAC[]]);; + +let OPERATIVE_LIFTED_SETVARIATION = prove + (`!f:(real^M->bool)->real^N. + operative(+) f + ==> operative (lifted(+)) + (\i. if f has_bounded_setvariation_on i + then SOME(set_variation i f) else NONE)`, + let lemma1 = prove + (`!f:(real^M->bool)->real B1 B2 k a b. + 1 <= k /\ k <= dimindex(:M) /\ + (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = &0) /\ + (!a b c. f(interval[a,b]) <= + f(interval[a,b] INTER {x | x$k <= c}) + + f(interval[a,b] INTER {x | x$k >= c})) /\ + (!d. d division_of (interval[a,b] INTER {x | x$k <= c}) + ==> sum d f <= B1) /\ + (!d. d division_of (interval[a,b] INTER {x | x$k >= c}) + ==> sum d f <= B2) + ==> !d. d division_of interval[a,b] ==> sum d f <= B1 + B2`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "L") (LABEL_TAC "R")) THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum {l INTER {x:real^M | x$k <= c} | l | l IN d /\ + ~(l INTER {x | x$k <= c} = {})} f + + sum {l INTER {x | x$k >= c} | l | l IN d /\ + ~(l INTER {x | x$k >= c} = {})} f` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[DIVISION_SPLIT]] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + W(fun (asl,w) -> + MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (lhand(rand w))) THEN + MP_TAC(PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO (rand(rand w)))) THEN + MATCH_MP_TAC(TAUT + `(a1 /\ a2) /\ (b1 /\ b2 ==> c) + ==> (a1 ==> b1) ==> (a2 ==> b2) ==> c`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[FINITE_RESTRICT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THENL + [MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ; + MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ] THEN + ASM_MESON_TAC[]; + DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC)] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum d (f o (\l. l INTER {x | x$k <= c})) + + sum d (f o (\l. l INTER {x:real^M | x$k >= c}))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[o_THM] THEN + FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]); + MATCH_MP_TAC(REAL_ARITH `x = y /\ w = z ==> x + w <= y + z`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} SUBSET s`] THEN + REWRITE_TAC[SET_RULE `(x IN s /\ ~(x IN {x | x IN s /\ ~P x}) ==> Q x) <=> + (x IN s ==> P x ==> Q x)`] THEN + SIMP_TAC[o_THM] THEN ASM_MESON_TAC[EMPTY_AS_INTERVAL; CONTENT_EMPTY]]) + and lemma2 = prove + (`!f:(real^M->bool)->real B k. + 1 <= k /\ k <= dimindex(:M) /\ + (!a b. content(interval[a,b]) = &0 ==> f(interval[a,b]) = &0) /\ + (!d. d division_of interval[a,b] ==> sum d f <= B) + ==> !d1 d2. d1 division_of (interval[a,b] INTER {x | x$k <= c}) /\ + d2 division_of (interval[a,b] INTER {x | x$k >= c}) + ==> sum d1 f + sum d2 f <= B`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d1 UNION d2:(real^M->bool)->bool`) THEN + ANTS_TAC THENL + [SUBGOAL_THEN + `interval[a,b] = (interval[a,b] INTER {x:real^M | x$k <= c}) UNION + (interval[a,b] INTER {x:real^M | x$k >= c})` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. x IN t \/ x IN u) ==> (s = s INTER t UNION s INTER u)`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC DIVISION_DISJOINT_UNION THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM INTERIOR_INTER] THEN + MATCH_MP_TAC(SET_RULE + `!t. interior s SUBSET interior t /\ interior t = {} + ==> interior s = {}`) THEN + EXISTS_TAC `{x:real^M | x$k = c}` THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[INTERIOR_STANDARD_HYPERPLANE]] THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC]; + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= b ==> y <= b`) THEN + MATCH_MP_TAC SUM_UNION_NONZERO THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; ALL_TAC]) THEN + X_GEN_TAC `k:real^M->bool` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC CONTENT_0_SUBSET_GEN THEN + EXISTS_TAC `interval[a,b] INTER {x:real^M | x$k = c}` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `(interval[a,b] INTER {x:real^M | x$k <= c}) INTER + (interval[a,b] INTER {x:real^M | x$k >= c})` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[SUBSET_INTER] THEN ASM_MESON_TAC[division_of]; + REWRITE_TAC[SET_RULE + `(s INTER t) INTER (s INTER u) = s INTER t INTER u`] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC]; + SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN + REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + ASM_SIMP_TAC[GSYM INTER_ASSOC; INTERVAL_SPLIT] THEN + REWRITE_TAC[CONTENT_EQ_0] THEN EXISTS_TAC `k:num` THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]]) in + REWRITE_TAC[operative; NEUTRAL_VECTOR_ADD] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN + ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL; BOUNDED_INTERVAL; + MONOIDAL_REAL_ADD; SET_VARIATION_ON_NULL; NEUTRAL_LIFTED; + NEUTRAL_REAL_ADD] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real`; `k:num`] THEN + STRIP_TAC THEN ASM_CASES_TAC + `(f:(real^M->bool)->real^N) has_bounded_setvariation_on interval[a,b]` THEN + ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `(f:(real^M->bool)->real^N) has_bounded_setvariation_on + interval[a,b] INTER {x | x$k <= c} /\ + (f:(real^M->bool)->real^N) has_bounded_setvariation_on + interval[a,b] INTER {x | x$k >= c}` + ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_SUBSET)) THEN + REWRITE_TAC[INTER_SUBSET]; + ALL_TAC] THEN + ASM_REWRITE_TAC[lifted] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] lemma1) THEN + MAP_EVERY EXISTS_TAC [`k:num`; `a:real^M`; `b:real^M`] THEN + ASM_SIMP_TAC[NORM_0] THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `x:real^N = y + z ==> norm(x) <= norm y + norm z`) THEN + ASM_SIMP_TAC[]; + FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_AND) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; SET_VARIATION_WORKS_ON_INTERVAL]]; + ONCE_REWRITE_TAC[REAL_ARITH `x + y <= z <=> x <= z - y`] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN + ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN + X_GEN_TAC `d1:(real^M->bool)->bool` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x <= y - z <=> z <= y - x`] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + MATCH_MP_TAC SET_VARIATION_UBOUND_ON_INTERVAL THEN + ASM_SIMP_TAC[GSYM INTERVAL_SPLIT] THEN + X_GEN_TAC `d2:(real^M->bool)->bool` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `x <= y - z <=> z + x <= y`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] lemma2) THEN + EXISTS_TAC `k:num` THEN + ASM_SIMP_TAC[NORM_0; SET_VARIATION_WORKS_ON_INTERVAL]]; + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[lifted]) THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN + EXISTS_TAC `set_variation (interval[a,b] INTER {x | x$k <= c}) + (f:(real^M->bool)->real^N) + + set_variation (interval[a,b] INTER {x | x$k >= c}) f` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] lemma1) THEN + MAP_EVERY EXISTS_TAC [`k:num`; `a:real^M`; `b:real^M`] THEN + ASM_SIMP_TAC[NORM_0] THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `x:real^N = y + z ==> norm(x) <= norm y + norm z`) THEN + ASM_SIMP_TAC[]; + UNDISCH_TAC + `(f:(real^M->bool)->real^N) has_bounded_setvariation_on + (interval[a,b] INTER {x | x$k <= c})` THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; SET_VARIATION_WORKS_ON_INTERVAL]; + UNDISCH_TAC + `(f:(real^M->bool)->real^N) has_bounded_setvariation_on + (interval[a,b] INTER {x | x$k >= c})` THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; SET_VARIATION_WORKS_ON_INTERVAL]]]);; + +let HAS_BOUNDED_SETVARIATION_ON_DIVISION = prove + (`!f:(real^M->bool)->real^N a b d. + operative (+) f /\ d division_of interval[a,b] + ==> ((!k. k IN d ==> f has_bounded_setvariation_on k) <=> + f has_bounded_setvariation_on interval[a,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN + ASM_REWRITE_TAC[operative; NEUTRAL_AND] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[operative; NEUTRAL_VECTOR_ADD]) THEN + ASM_SIMP_TAC[HAS_BOUNDED_SETVARIATION_ON_NULL; BOUNDED_INTERVAL]; + FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN + REWRITE_TAC[operative] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[lifted; distinctness "option"])]);; + +let SET_VARIATION_ON_DIVISION = prove + (`!f:(real^M->bool)->real^N a b d. + operative (+) f /\ d division_of interval[a,b] /\ + f has_bounded_setvariation_on interval[a,b] + ==> sum d (\k. set_variation k f) = set_variation (interval[a,b]) f`, + let lemma0 = prove + (`!op x y. lifted op (SOME x) y = SOME z <=> ?w. y = SOME w /\ op x w = z`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC option_INDUCT THEN + REWRITE_TAC[lifted; distinctness "option"; injectivity "option"] THEN + MESON_TAC[]) in + let lemma = prove + (`!P op f s z. + monoidal op /\ FINITE s /\ + iterate(lifted op) s (\i. if P i then SOME(f i) else NONE) = SOME z + ==> iterate op s f = z`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_LIFTED; NEUTRAL_LIFTED] THEN + REWRITE_TAC[injectivity "option"] THEN REPEAT GEN_TAC THEN + STRIP_TAC THEN GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[lifted; distinctness "option"] THEN ASM_MESON_TAC[lemma0]) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPERATIVE_LIFTED_SETVARIATION) THEN + DISCH_THEN(MP_TAC o SPECL[`d:(real^M->bool)->bool`; `a:real^M`; `b:real^M`] o + MATCH_MP (REWRITE_RULE [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] + OPERATIVE_DIVISION)) THEN + ASM_SIMP_TAC[MONOIDAL_LIFTED; MONOIDAL_REAL_ADD] THEN + MP_TAC(ISPECL + [`\k. (f:(real^M->bool)->real^N) has_bounded_setvariation_on k`; + `(+):real->real->real`; + `\k. set_variation k (f:(real^M->bool)->real^N)`; + `d:(real^M->bool)->bool`; + `set_variation (interval[a,b]) (f:(real^M->bool)->real^N)`] + lemma) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_REWRITE_TAC[sum; MONOIDAL_REAL_ADD]);; + +let SET_VARIATION_MONOTONE = prove + (`!f:(real^M->bool)->real^N s t. + f has_bounded_setvariation_on s /\ t SUBSET s + ==> set_variation t f <= set_variation s f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`&0`; `{}:(real^M->bool)->bool`] THEN + REWRITE_TAC[SUM_CLAUSES] THEN EXISTS_TAC `{}:real^M->bool` THEN + REWRITE_TAC[EMPTY_SUBSET; DIVISION_OF_TRIVIAL]; + MATCH_MP_TAC(SET_RULE + `(!d. P d ==> Q d) ==> {f d | P d} SUBSET {f d | Q d}`) THEN + ASM_MESON_TAC[SUBSET_TRANS]; + REWRITE_TAC[FORALL_IN_GSPEC; LEFT_IMP_EXISTS_THM] THEN + ASM_REWRITE_TAC[GSYM has_bounded_setvariation_on]]);; + +let HAS_BOUNDED_SETVARIATION_REFLECT2_EQ,SET_VARIATION_REFLECT2 = + (CONJ_PAIR o prove) + (`(!f:(real^M->bool)->real^N s. + (\k. f(IMAGE (--) k)) has_bounded_setvariation_on (IMAGE (--) s) <=> + f has_bounded_setvariation_on s) /\ + (!f:(real^M->bool)->real^N s. + set_variation (IMAGE (--) s) (\k. f(IMAGE (--) k)) = + set_variation s f)`, + MATCH_MP_TAC SETVARIATION_EQUAL_LEMMA THEN + EXISTS_TAC `IMAGE ((--):real^M->real^M)` THEN + SIMP_TAC[IMAGE_SUBSET; GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[VECTOR_NEG_NEG; IMAGE_ID; REFLECT_INTERVAL] THEN + SIMP_TAC[ETA_AX; DIVISION_OF_REFLECT] THEN + SIMP_TAC[EQ_INTERVAL; TAUT `~q /\ (p /\ q \/ r) <=> ~q /\ r`] THEN + REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN + REWRITE_TAC[UNWIND_THM1; CONTRAPOS_THM] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY; VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);; + +let HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ, SET_VARIATION_TRANSLATION2 = + (CONJ_PAIR o prove) + (`(!a f:(real^M->bool)->real^N s. + (\k. f(IMAGE (\x. a + x) k)) + has_bounded_setvariation_on (IMAGE (\x. --a + x) s) <=> + f has_bounded_setvariation_on s) /\ + (!a f:(real^M->bool)->real^N s. + set_variation (IMAGE (\x. --a + x) s) (\k. f(IMAGE (\x. a + x) k)) = + set_variation s f)`, + GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `a:real^M` THEN + MATCH_MP_TAC SETVARIATION_EQUAL_LEMMA THEN + EXISTS_TAC `\s. IMAGE (\x:real^M. a + x) s` THEN + SIMP_TAC[IMAGE_SUBSET; GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`] THEN + REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN + SIMP_TAC[EQ_INTERVAL; TAUT `~q /\ (p /\ q \/ r) <=> ~q /\ r`] THEN + REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ q /\ p`] THEN + REWRITE_TAC[UNWIND_THM1; CONTRAPOS_THM] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY; VECTOR_ADD_COMPONENT; REAL_LT_LADD] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [ETA_AX] THEN + ASM_SIMP_TAC[DIVISION_OF_TRANSLATION]);; + +let HAS_BOUNDED_SETVARIATION_TRANSLATION = prove + (`!f:(real^M->bool)->real^N s a. + f has_bounded_setvariation_on s + ==> (\k. f(IMAGE (\x. a + x) k)) + has_bounded_setvariation_on (IMAGE (\x. --a + x) s)`, + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Absolute integrability (this is the same as Lebesgue integrability). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("absolutely_integrable_on",(12,"right"));; + +let absolutely_integrable_on = new_definition + `f absolutely_integrable_on s <=> + f integrable_on s /\ (\x. lift(norm(f x))) integrable_on s`;; + +let ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f s. f absolutely_integrable_on s ==> f integrable_on s`, + SIMP_TAC[absolutely_integrable_on]);; + +let ABSOLUTELY_INTEGRABLE_LE = prove + (`!f:real^M->real^N s. + f absolutely_integrable_on s + ==> norm(integral s f) <= drop(integral s (\x. lift(norm(f x))))`, + REWRITE_TAC[absolutely_integrable_on] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);; + +let ABSOLUTELY_INTEGRABLE_ON_NULL = prove + (`!f a b. content(interval[a,b]) = &0 + ==> f absolutely_integrable_on interval[a,b]`, + SIMP_TAC[absolutely_integrable_on; INTEGRABLE_ON_NULL]);; + +let ABSOLUTELY_INTEGRABLE_0 = prove + (`!s. (\x. vec 0) absolutely_integrable_on s`, + REWRITE_TAC[absolutely_integrable_on; NORM_0; LIFT_NUM; INTEGRABLE_0]);; + +let ABSOLUTELY_INTEGRABLE_CMUL = prove + (`!f s c. f absolutely_integrable_on s + ==> (\x. c % f(x)) absolutely_integrable_on s`, + SIMP_TAC[absolutely_integrable_on; INTEGRABLE_CMUL; NORM_MUL; LIFT_CMUL]);; + +let ABSOLUTELY_INTEGRABLE_NEG = prove + (`!f s. f absolutely_integrable_on s + ==> (\x. --f(x)) absolutely_integrable_on s`, + SIMP_TAC[absolutely_integrable_on; INTEGRABLE_NEG; NORM_NEG]);; + +let ABSOLUTELY_INTEGRABLE_NORM = prove + (`!f s. f absolutely_integrable_on s + ==> (\x. lift(norm(f x))) absolutely_integrable_on s`, + SIMP_TAC[absolutely_integrable_on; NORM_LIFT; REAL_ABS_NORM]);; + +let ABSOLUTELY_INTEGRABLE_ABS_1 = prove + (`!f s. f absolutely_integrable_on s + ==> (\x. lift(abs(drop(f x)))) absolutely_integrable_on s`, + REWRITE_TAC[GSYM NORM_LIFT; LIFT_DROP; ABSOLUTELY_INTEGRABLE_NORM]);; + +let ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL = prove + (`!f:real^M->real^N s a b. + f absolutely_integrable_on s /\ interval[a,b] SUBSET s + ==> f absolutely_integrable_on interval[a,b]`, + REWRITE_TAC[absolutely_integrable_on] THEN + MESON_TAC[INTEGRABLE_ON_SUBINTERVAL]);; + +let ABSOLUTELY_INTEGRABLE_SPIKE = prove + (`!f:real^M->real^N g s t. + negligible s /\ (!x. x IN t DIFF s ==> g x = f x) + ==> f absolutely_integrable_on t ==> g absolutely_integrable_on t`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[absolutely_integrable_on] THEN MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_SPIKE THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[]);; + +let ABSOLUTELY_INTEGRABLE_RESTRICT_INTER = prove + (`!f:real^M->real^N s t. + (\x. if x IN s then f x else vec 0) absolutely_integrable_on t <=> + f absolutely_integrable_on (s INTER t)`, + REWRITE_TAC[absolutely_integrable_on; GSYM INTEGRABLE_RESTRICT_INTER] THEN + REWRITE_TAC[COND_RAND; NORM_0; LIFT_NUM]);; + +let ABSOLUTELY_INTEGRABLE_EQ = prove + (`!f:real^M->real^N g s. + (!x. x IN s ==> f x = g x) /\ f absolutely_integrable_on s + ==> g absolutely_integrable_on s`, + REWRITE_TAC[absolutely_integrable_on] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; + EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))`] THEN + ASM_SIMP_TAC[]);; + +let ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION = prove + (`!f:real^M->real^N s. + f absolutely_integrable_on s + ==> (\k. integral k f) has_bounded_setvariation_on s`, + REWRITE_TAC[has_bounded_setvariation_on] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC + `drop(integral (s:real^M->bool) (\x. lift(norm(f x:real^N))))` THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN + X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `(UNIONS d:real^M->bool) SUBSET s` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET_TRANS; division_of]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `drop(integral (UNIONS d) (\x. lift(norm((f:real^M->real^N) x))))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + EXISTS_TAC `s:real^M->bool` THEN + EXISTS_TAC `d:(real^M->bool)->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[DIVISION_OF_SUBSET; division_of]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `drop(vsum d (\i. integral i (\x:real^M. lift(norm(f x:real^N)))))` THEN + CONJ_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[DROP_VSUM] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[o_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_MESON_TAC[division_of; SUBSET_TRANS]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[DIVISION_OF_UNION_SELF]] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + MAP_EVERY EXISTS_TAC [`s:real^M->bool`; `d:(real^M->bool)->bool`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]]);; + +let lemma = prove + (`!f:A->real^N g s e. + sum s (\x. norm(f x - g x)) < e + ==> FINITE s + ==> abs(sum s (\x. norm(f x)) - sum s (\x. norm(g x))) < e`, + REPEAT GEN_TAC THEN SIMP_TAC[GSYM SUM_SUB] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_ABS o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `y <= z ==> x <= y ==> x <= z`) THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN NORM_ARITH_TAC);; + +let BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] /\ + (\k. integral k f) has_bounded_setvariation_on interval[a,b] + ==> f absolutely_integrable_on interval[a,b]`, + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN + MP_TAC(ISPEC `IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) + {d | d division_of interval[a,b] }` + SUP) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + ABBREV_TAC + `i = sup (IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) + {d | d division_of interval[a,b] })` THEN + ANTS_TAC THENL + [REWRITE_TAC[ELEMENTARY_INTERVAL] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift i` THEN + REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i - e / &2`) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i <= i - e / &2)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + SUBGOAL_THEN + `!x. ?e. &0 < e /\ + !i. i IN d /\ ~(x IN i) ==> ball(x:real^M,e) INTER i = {}` + MP_TAC THENL + [X_GEN_TAC `x:real^M` THEN MP_TAC(ISPECL + [`UNIONS {i:real^M->bool | i IN d /\ ~(x IN i)}`; `x:real^M`] + SEPARATE_POINT_CLOSED) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC CLOSED_UNIONS THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; IMP_CONJ] THEN + FIRST_ASSUM(fun t -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN + REWRITE_TAC[CLOSED_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN + SIMP_TAC[FORALL_IN_UNIONS; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN + REWRITE_TAC[IN_ELIM_THM; DE_MORGAN_THM; REAL_NOT_LT] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `k:real^M->real` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `e / &2` o MATCH_MP HENSTOCK_LEMMA) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^M. g(x) INTER ball(x,k x)` THEN CONJ_TAC THENL + [MATCH_MP_TAC GAUGE_INTER THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[gauge; CENTRE_IN_BALL; OPEN_BALL]; + ALL_TAC] THEN + REWRITE_TAC[FINE_INTER] THEN X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN + STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ABBREV_TAC + `p' = {(x:real^M,k:real^M->bool) | + ?i l. x IN i /\ i IN d /\ (x,l) IN p /\ k = i INTER l}` THEN + SUBGOAL_THEN `g fine (p':(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [EXPAND_TAC "p'" THEN + MP_TAC(ASSUME `g fine (p:(real^M#(real^M->bool))->bool)`) THEN + REWRITE_TAC[fine; IN_ELIM_PAIR_THM] THEN + MESON_TAC[SET_RULE `k SUBSET l ==> (i INTER k) SUBSET l`]; + ALL_TAC] THEN + SUBGOAL_THEN `p' tagged_division_of interval[a:real^M,b]` ASSUME_TAC THENL + [REWRITE_TAC[TAGGED_DIVISION_OF] THEN EXPAND_TAC "p'" THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `IMAGE (\(k,(x,l)). x,k INTER l) + {k,xl | k IN (d:(real^M->bool)->bool) /\ + xl IN (p:(real^M#(real^M->bool))->bool)}` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_PRODUCT] THEN + EXPAND_TAC "p'" THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN + MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`i:real^M->bool`; `l:real^M->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_SIMP_TAC[IN_INTER] THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE `l SUBSET s ==> (k INTER l) SUBSET s`) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPEC `i:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[INTER_INTERVAL] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN MAP_EVERY X_GEN_TAC + [`x1:real^M`; `k1:real^M->bool`; `x2:real^M`; `k2:real^M->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `i1:real^M->bool` (X_CHOOSE_THEN `l1:real^M->bool` + STRIP_ASSUME_TAC)) MP_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `i2:real^M->bool` (X_CHOOSE_THEN `l2:real^M->bool` + STRIP_ASSUME_TAC)) ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC(SET_RULE + `(interior(i1) INTER interior(i2) = {} \/ + interior(l1) INTER interior(l2) = {}) /\ + interior(i1 INTER l1) SUBSET interior(i1) /\ + interior(i2 INTER l2) SUBSET interior(i2) /\ + interior(i1 INTER l1) SUBSET interior(l1) /\ + interior(i2 INTER l2) SUBSET interior(l2) + ==> interior(i1 INTER l1) INTER interior(i2 INTER l2) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`x1:real^M`; `l1:real^M->bool`; `x2:real^M`; `l2:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`i1:real^M->bool`; `i2:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN + ASM_REWRITE_TAC[PAIR_EQ] THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE `i SUBSET s ==> (i INTER k) SUBSET s`) THEN + ASM_MESON_TAC[division_of]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[MESON[] + `p /\ q /\ r /\ x = t /\ P x <=> x = t /\ p /\ q /\ r /\ P t`] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c d. P a b c d) <=> (?d b c a. P a b c d)`] THEN + REWRITE_TAC[IN_INTER; UNWIND_THM2] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^M->bool` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o last o CONJUNCTS o + GEN_REWRITE_RULE I [division_of]) THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `y:real^M`) THEN + ASM_REWRITE_TAC[IN_UNIONS] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `k:real^M->bool`]) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `y:real^M` THEN ASM_REWRITE_TAC[INTER; IN_ELIM_THM] THEN + UNDISCH_TAC `(\x:real^M. ball (x,k x)) fine p` THEN + REWRITE_TAC[fine; SUBSET] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p':(real^M#(real^M->bool))->bool`) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + REWRITE_TAC[LAMBDA_PAIR] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + ASM_SIMP_TAC[DROP_VSUM; o_DEF; SUM_SUB; DROP_SUB; ABS_DROP] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; DROP_CMUL; NORM_MUL; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `!sni. i - e / &2 < sni /\ + sni' <= i /\ sni <= sni' /\ sf' = sf + ==> abs(sf' - sni') < e / &2 + ==> abs(sf - i) < e`) THEN + EXISTS_TAC `sum d (\k. norm (integral k (f:real^M->real^N)))` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\k. norm(integral k (f:real^M->real^N))`; + `p':(real^M#(real^M->bool))->bool`; + `interval[a:real^M,b]`] SUM_OVER_TAGGED_DIVISION_LEMMA) THEN + ASM_SIMP_TAC[INTEGRAL_NULL; NORM_0] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIVISION_OF_TAGGED_DIVISION]; + ALL_TAC] THEN + SUBGOAL_THEN + `p' = {x:real^M,(i INTER l:real^M->bool) | + (x,l) IN p /\ i IN d /\ ~(i INTER l = {})}` + (LABEL_TAC "p'") THENL + [EXPAND_TAC "p'" THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN + REWRITE_TAC[PAIR_EQ; GSYM CONJ_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `i:real^M->bool` THEN REWRITE_TAC[] THEN + CONV_TAC(RAND_CONV UNWIND_CONV) THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `l:real^M->bool` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `k:real^M->bool = i INTER l` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[IN_INTER; GSYM MEMBER_NOT_EMPTY] THEN + EQ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^M` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `i:real^M->bool`]) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `y:real^M` THEN ASM_REWRITE_TAC[INTER; IN_ELIM_THM] THEN + UNDISCH_TAC `(\x:real^M. ball (x,k x)) fine p` THEN + REWRITE_TAC[fine; SUBSET] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL + [`\y. norm(integral y (f:real^M->real^N))`; + `p':(real^M#(real^M->bool))->bool`; + `interval[a:real^M,b]`] + SUM_OVER_TAGGED_DIVISION_LEMMA) THEN + ASM_SIMP_TAC[INTEGRAL_NULL; NORM_0] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {i INTER l | i IN d /\ + (l IN IMAGE SND (p:(real^M#(real^M->bool))->bool))} + (\k. norm(integral k (f:real^M->real^N)))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_SUPERSET THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; PAIR_EQ; EXISTS_PAIR_THM] THEN + MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`kk:real^M->bool`; `i:real^M->bool`; `l:real^M->bool`] THEN + ASM_CASES_TAC `kk:real^M->bool = i INTER l` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; UNWIND_THM1] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x:real^M`)) MP_TAC) THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPECL + [`x:real^M`; `x:real^M`; `i:real^M->bool`; `l:real^M->bool`]) THEN + ASM_SIMP_TAC[INTEGRAL_EMPTY; NORM_0]] THEN + SUBGOAL_THEN + `{k INTER l | k IN d /\ l IN IMAGE SND (p:(real^M#(real^M->bool))->bool)} = + IMAGE (\(k,l). k INTER l) {k,l | k IN d /\ l IN IMAGE SND p}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN + CONV_TAC(REDEPTH_CONV UNWIND_CONV) THEN MESON_TAC[]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN + ANTS_TAC THENL + [ASSUME_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION + (ASSUME `p tagged_division_of interval[a:real^M,b]`)) THEN + ASM_SIMP_TAC[FINITE_PRODUCT; FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`l1:real^M->bool`; `k1:real^M->bool`; + `l2:real^M->bool`; `k2:real^M->bool`] THEN + REWRITE_TAC[PAIR_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN `interior(l2 INTER k2:real^M->bool) = {}` MP_TAC THENL + [ALL_TAC; + MP_TAC(ASSUME `d division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[division_of] THEN + DISCH_THEN(MP_TAC o SPEC `l2:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME + `(IMAGE SND (p:(real^M#(real^M->bool))->bool)) + division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[division_of] THEN + DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[INTER_INTERVAL] THEN DISCH_TAC THEN + REWRITE_TAC[NORM_EQ_0] THEN + MATCH_MP_TAC INTEGRAL_NULL THEN + ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR]] THEN + MATCH_MP_TAC(SET_RULE + `(interior(k1) INTER interior(k2) = {} \/ + interior(l1) INTER interior(l2) = {}) /\ + interior(l1 INTER k1) SUBSET interior(k1) /\ + interior(l2 INTER k2) SUBSET interior(k2) /\ + interior(l1 INTER k1) SUBSET interior(l1) /\ + interior(l2 INTER k2) SUBSET interior(l2) /\ + interior(l1 INTER k1) = interior(l2 INTER k2) + ==> interior(l2 INTER k2) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME `d division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`l1:real^M->bool`; `l2:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME + `(IMAGE SND (p:(real^M#(real^M->bool))->bool)) + division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[division_of] THEN DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`k1:real^M->bool`; `k2:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [LAMBDA_PAIR_THM] THEN + ASM_SIMP_TAC[GSYM SUM_SUM_PRODUCT; FINITE_IMAGE] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum { k INTER l | + l IN IMAGE SND (p:(real^M#(real^M->bool))->bool)} + (\k. norm(integral k (f:real^M->real^N)))` THEN + CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[o_DEF; REAL_LE_REFL]] THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `interior(k INTER k2:real^M->bool) = {}` MP_TAC THENL + [ALL_TAC; + MP_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION + (ASSUME `p tagged_division_of interval[a:real^M,b]`)) THEN + MP_TAC(ASSUME `d division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[division_of] THEN + DISCH_THEN(MP_TAC o SPEC `k:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[INTER_INTERVAL; GSYM CONTENT_EQ_0_INTERIOR] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL] THEN + SIMP_TAC[GSYM CONTENT_EQ_0_INTERIOR; INTEGRAL_NULL; NORM_0]] THEN + MATCH_MP_TAC(SET_RULE + `interior(k INTER k2) SUBSET interior(k1 INTER k2) /\ + interior(k1 INTER k2) = {} + ==> interior(k INTER k2) = {}`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(MATCH_MP DIVISION_OF_TAGGED_DIVISION + (ASSUME `p tagged_division_of interval[a:real^M,b]`)) THEN + REWRITE_TAC[division_of] THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + REWRITE_TAC[INTERIOR_INTER] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b]` ASSUME_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + ABBREV_TAC `d' = + {interval[u,v] INTER l |l| + l IN IMAGE SND (p:(real^M#(real^M->bool))->bool) /\ + ~(interval[u,v] INTER l = {})}` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum d' (\k. norm (integral k (f:real^M->real^N)))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_SUPERSET THEN + EXPAND_TAC "d'" THEN REWRITE_TAC[SUBSET; SET_RULE + `a IN {f x |x| x IN s /\ ~(f x = b)} <=> + a IN {f x | x IN s} /\ ~(a = b)`] THEN + SIMP_TAC[IMP_CONJ; INTEGRAL_EMPTY; NORM_0]] THEN + SUBGOAL_THEN `d' division_of interval[u:real^M,v]` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN MATCH_MP_TAC DIVISION_INTER_1 THEN + EXISTS_TAC `interval[a:real^M,b]` THEN + ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum d' (\i. integral i (f:real^M->real^N)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN + ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + REWRITE_TAC[REAL_LE_REFL] THEN ASM_MESON_TAC[division_of]; + ALL_TAC] THEN + REMOVE_THEN "p'" SUBST_ALL_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {x,i INTER l | (x,l) IN p /\ i IN d} + (\(x,k:real^M->bool). + abs(content k) * norm((f:real^M->real^N) x))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `i:real^M->bool`] THEN + ASM_CASES_TAC `i:real^M->bool = {}` THEN + ASM_SIMP_TAC[CONTENT_EMPTY; REAL_ABS_NUM; REAL_MUL_LZERO] THEN + MATCH_MP_TAC(TAUT `(a <=> b) ==> a /\ ~b ==> c`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `{x,i INTER l | x,l IN (p:(real^M#(real^M->bool))->bool) /\ i IN d} = + IMAGE (\((x,l),k). x,k INTER l) {m,k | m IN p /\ k IN d}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; EXISTS_PAIR_THM; FORALL_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN + CONV_TAC(REDEPTH_CONV UNWIND_CONV) THEN MESON_TAC[]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_PRODUCT] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`x1:real^M`; `l1:real^M->bool`; `k1:real^M->bool`; + `x2:real^M`; `l2:real^M->bool`; `k2:real^M->bool`] THEN + REWRITE_TAC[PAIR_EQ] THEN + ASM_CASES_TAC `x1:real^M = x2` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN + REWRITE_TAC[REAL_ABS_ZERO] THEN + SUBGOAL_THEN `interior(k2 INTER l2:real^M->bool) = {}` MP_TAC THENL + [ALL_TAC; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME `p tagged_division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[TAGGED_DIVISION_OF] THEN + DISCH_THEN(MP_TAC o el 1 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`x2:real^M`; `l2:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[INTER_INTERVAL; CONTENT_EQ_0_INTERIOR]] THEN + MATCH_MP_TAC(SET_RULE + `(interior(k1) INTER interior(k2) = {} \/ + interior(l1) INTER interior(l2) = {}) /\ + interior(k1 INTER l1) SUBSET interior(k1) /\ + interior(k2 INTER l2) SUBSET interior(k2) /\ + interior(k1 INTER l1) SUBSET interior(l1) /\ + interior(k2 INTER l2) SUBSET interior(l2) /\ + interior(k1 INTER l1) = interior(k2 INTER l2) + ==> interior(k2 INTER l2) = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; INTER_SUBSET] THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL [`k1:real^M->bool`; `k2:real^M->bool`]) THEN + MP_TAC(ASSUME `p tagged_division_of interval[a:real^M,b]`) THEN + REWRITE_TAC[TAGGED_DIVISION_OF] THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + DISCH_THEN(MP_TAC o SPECL + [`x2:real^M`; `l1:real^M->bool`; `x2:real^M`; `l2:real^M->bool`]) THEN + ASM_REWRITE_TAC[PAIR_EQ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [LAMBDA_PAIR_THM] THEN + ASM_SIMP_TAC[GSYM SUM_SUM_PRODUCT] THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN + DISCH_TAC THEN REWRITE_TAC[o_THM; SUM_RMUL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum d (\k. content(k INTER interval[u:real^M,v]))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[real_abs] THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?w z:real^M. k = interval[w,z]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + REWRITE_TAC[INTER_INTERVAL; CONTENT_POS_LE]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {k INTER interval[u:real^M,v] | k IN d} content` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_IMAGE_NONZERO THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `interior(k2 INTER interval[u:real^M,v]) = {}` MP_TAC THENL + [ALL_TAC; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool` o el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[INTER_INTERVAL; CONTENT_EQ_0_INTERIOR]] THEN + MATCH_MP_TAC(SET_RULE + `interior(k2 INTER i) SUBSET interior(k1 INTER k2) /\ + interior(k1 INTER k2) = {} + ==> interior(k2 INTER i) = {}`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN + REWRITE_TAC[INTERIOR_INTER] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b]` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum {k INTER interval[u:real^M,v] |k| + k IN d /\ ~(k INTER interval[u,v] = {})} content` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUPERSET THEN + REWRITE_TAC[SUBSET; SET_RULE + `a IN {f x |x| x IN s /\ ~(f x = b)} <=> + a IN {f x | x IN s} /\ ~(a = b)`] THEN + SIMP_TAC[IMP_CONJ; CONTENT_EMPTY]; + ALL_TAC] THEN + MATCH_MP_TAC ADDITIVE_CONTENT_DIVISION THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC DIVISION_INTER_1 THEN + EXISTS_TAC `interval[a:real^M,b]` THEN ASM_REWRITE_TAC[]);; + +let BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE = prove + (`!f:real^M->real^N. + f integrable_on UNIV /\ + (\k. integral k f) has_bounded_setvariation_on (:real^M) + ==> f absolutely_integrable_on UNIV`, + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[absolutely_integrable_on] THEN + MP_TAC(ISPEC `IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) + {d | d division_of (UNIONS d) }` + SUP) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + ABBREV_TAC + `i = sup (IMAGE (\d. sum d (\k. norm(integral k (f:real^M->real^N)))) + {d | d division_of (UNIONS d) })` THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + EXISTS_TAC `{}:(real^M->bool)->bool` THEN + REWRITE_TAC[UNIONS_0; DIVISION_OF_TRIVIAL]; + ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift i` THEN + REWRITE_TAC[HAS_INTEGRAL_ALT; IN_UNIV] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] + (REWRITE_RULE[HAS_BOUNDED_SETVARIATION_ON_INTERVAL] + BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL)) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_integrable_on]] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real^M)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + EXISTS_TAC `B:real` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIVISION_OF_UNION_SELF]; + ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i - e`) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i <= i - e)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `bounded(UNIONS d:real^M->bool)` MP_TAC THENL + [ASM_MESON_TAC[ELEMENTARY_BOUNDED]; ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `K:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `K + &1` THEN ASM_SIMP_TAC[REAL_LT_ADD; REAL_LT_01] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + REWRITE_TAC[ABS_DROP; DROP_SUB; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `!s1. i - e < s1 /\ s1 <= s /\ s < i + e ==> abs(s - i) < e`) THEN + EXISTS_TAC `sum (d:(real^M->bool)->bool) (\k. norm (integral k + (f:real^M->real^N)))` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d + (\k. drop(integral k (\x. lift(norm((f:real^M->real^N) x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LE THEN + ASM_REWRITE_TAC[absolutely_integrable_on] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (UNIONS d) + (\x. lift(norm((f:real^M->real^N) x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(MESON[REAL_LE_REFL; LIFT_DROP] + `lift x = y ==> x <= drop y`) THEN + ASM_SIMP_TAC[LIFT_SUM; o_DEF; LIFT_DROP] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_BOTTOMUP THEN + FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]); + ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(vec 0:real^M,K + &1)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_BALL] THEN + ASM_SIMP_TAC[NORM_ARITH `norm(x) <= K ==> dist(vec 0,x) < K + &1`]; + ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + EXISTS_TAC `interval[a:real^M,b]` THEN + EXISTS_TAC `d:(real^M->bool)->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN + REWRITE_TAC[HAS_INTEGRAL_INTEGRAL; has_integral] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`] + HENSTOCK_LEMMA) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "+")) THEN + SUBGOAL_THEN `?p. p tagged_division_of interval[a:real^M,b] /\ + d1 fine p /\ d2 fine p` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM FINE_INTER] THEN MATCH_MP_TAC FINE_DIVISION_EXISTS THEN + ASM_SIMP_TAC[GAUGE_INTER]; + ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `p:(real^M#(real^M->bool)->bool)`) THEN + REMOVE_THEN "+" (MP_TAC o SPEC `p:(real^M#(real^M->bool)->bool)`) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN + REWRITE_TAC[ABS_DROP; DROP_SUB] THEN + REWRITE_TAC[LAMBDA_PAIR] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[DROP_VSUM; o_DEF; SUM_SUB] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; DROP_CMUL; NORM_MUL; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `sf' = sf /\ si <= i + ==> abs(sf - si) < e / &2 + ==> abs(sf' - di) < e / &2 + ==> di < i + e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; real_abs] THEN + ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum p (\(x:real^M,k). norm(integral k f)) = + sum (IMAGE SND p) (\k. norm(integral k (f:real^M->real^N)))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_OVER_TAGGED_DIVISION_LEMMA THEN + EXISTS_TAC `interval[a:real^M,b]` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[INTEGRAL_NULL; NORM_0]; + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC PARTIAL_DIVISION_OF_TAGGED_DIVISION THEN + EXISTS_TAC `interval[a:real^M,b]` THEN ASM_MESON_TAC[tagged_division_of]);; + +let ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ = prove + (`!f:real^M->real^N. + f absolutely_integrable_on (:real^M) <=> + f integrable_on (:real^M) /\ + (\k. integral k f) has_bounded_setvariation_on (:real^M)`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; + BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);; + +let ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ = prove + (`!f:real^M->real^N a b. + f absolutely_integrable_on interval[a,b] <=> + f integrable_on interval[a,b] /\ + (\k. integral k f) has_bounded_setvariation_on interval[a,b]`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; + BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);; + +let ABSOLUTELY_INTEGRABLE_SET_VARIATION = prove + (`!f:real^M->real^N a b. + f absolutely_integrable_on interval[a,b] + ==> set_variation (interval[a,b]) (\k. integral k f) = + drop(integral (interval[a,b]) (\x. lift(norm(f x))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[set_variation] THEN + MATCH_MP_TAC REAL_SUP_UNIQUE THEN + REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN CONJ_TAC THENL + [X_GEN_TAC `d:(real^M->bool)->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^M->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral s (\x. lift(norm((f:real^M->real^N) x))))` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`\x. lift(norm((f:real^M->real^N) x))`; + `d:(real^M->bool)->bool`; `s:real^M->bool`] + INTEGRAL_COMBINE_DIVISION_TOPDOWN) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + EXISTS_TAC `interval[a:real^M,b]` THEN ASM_MESON_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[DROP_VSUM] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[o_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM absolutely_integrable_on] THEN + RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN + ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL; SUBSET_TRANS]; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + EXISTS_TAC `interval[a:real^M,b]` THEN ASM_MESON_TAC[]]; + X_GEN_TAC `B:real` THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ABBREV_TAC `e = drop(integral (interval [a,b]) + (\x. lift(norm((f:real^M->real^N) x)))) - + B` THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2` o MATCH_MP HENSTOCK_LEMMA) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "F"))) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[HAS_INTEGRAL_INTEGRAL; has_integral] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A"))) THEN + MP_TAC(ISPECL + [`\x. (d1:real^M->real^M->bool) x INTER d2 x`; + `a:real^M`; `b:real^M`] + FINE_DIVISION_EXISTS) THEN + ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^M#(real^M->bool)->bool` + STRIP_ASSUME_TAC) THEN + REMOVE_THEN "A" (MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN + REMOVE_THEN "F" (MP_TAC o SPEC `p:real^M#(real^M->bool)->bool`) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[tagged_division_of]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\x. lift(norm((f:real^M->real^N) x))`; + `a:real^M`; `b:real^M`; `p:real^M#(real^M->bool)->bool`] + INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST_ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + DISCH_TAC THEN + SUBGOAL_THEN + `abs(sum p (\(x,k). content k * norm((f:real^M->real^N) x)) - + sum p (\(x,k:real^M->bool). norm(integral k f))) < e / &2` + MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LET_TRANS)) THEN + ASM_SIMP_TAC[GSYM SUM_SUB] THEN MATCH_MP_TAC SUM_ABS_LE THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `x = norm u ==> abs(x - norm v) <= norm(u - v:real^N)`) THEN + REWRITE_TAC[NORM_MUL; real_abs] THEN + ASM_MESON_TAC[CONTENT_POS_LE; TAGGED_DIVISION_OF]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM NORM_LIFT] THEN + ASM_SIMP_TAC[LIFT_SUB; LIFT_SUM] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; o_DEF; LIFT_CMUL; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `norm(x - y:real^N) < e / &2 /\ norm(x - z) < e / &2 + ==> norm(y - z) < e`)) THEN + REWRITE_TAC[NORM_1; DROP_SUB] THEN + DISCH_THEN(MP_TAC o SPEC `B:real` o MATCH_MP + (REAL_ARITH `!B. abs(x - y) < e ==> y - B = e ==> &0 < x - B`)) THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[DROP_VSUM; REAL_SUB_LT] THEN + REWRITE_TAC[o_DEF; LAMBDA_PAIR_THM; LIFT_DROP] THEN DISCH_TAC THEN + EXISTS_TAC `IMAGE SND (p:real^M#(real^M->bool)->bool)` THEN CONJ_TAC THENL + [EXISTS_TAC `interval[a:real^M,b]` THEN + ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION; SUBSET_REFL]; + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN + DISCH_THEN(fun th -> + W(MP_TAC o PART_MATCH (rand o rand) th o rand o snd)) THEN + SIMP_TAC[INTEGRAL_NULL; NORM_0] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]]]);; + +let ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV = prove + (`!f s. (\x. if x IN s then f x else vec 0) + absolutely_integrable_on (:real^M) <=> + f absolutely_integrable_on s`, + REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_RESTRICT_UNIV; + COND_RAND; NORM_0; LIFT_NUM]);; + +let ABSOLUTELY_INTEGRABLE_CONST = prove + (`!a b c. (\x. c) absolutely_integrable_on interval[a,b]`, + REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_CONST]);; + +let ABSOLUTELY_INTEGRABLE_ADD = prove + (`!f:real^M->real^N g s. + f absolutely_integrable_on s /\ + g absolutely_integrable_on s + ==> (\x. f(x) + g(x)) absolutely_integrable_on s`, + SUBGOAL_THEN + `!f:real^M->real^N g. + f absolutely_integrable_on (:real^M) /\ + g absolutely_integrable_on (:real^M) + ==> (\x. f(x) + g(x)) absolutely_integrable_on (:real^M)` + ASSUME_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + REPEAT GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID]] THEN + REPEAT STRIP_TAC THEN + EVERY_ASSUM(STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN + MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN + ASM_SIMP_TAC[INTEGRABLE_ADD] THEN + MP_TAC(ISPECL [`g:real^M->real^N`; `(:real^M)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN + ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN + DISCH_THEN(X_CHOOSE_TAC `B1:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `B2:real`) THEN EXISTS_TAC `B1 + B2:real` THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^M->bool)->bool`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= B1 ==> x <= a + B2 ==> x <= B1 + B2`)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `b <= B2 ==> x <= a + b ==> x <= a + B2`)) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN + FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH `x = y + z ==> norm(x) <= norm(y) + norm(z)`) THEN + MATCH_MP_TAC INTEGRAL_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; + +let ABSOLUTELY_INTEGRABLE_SUB = prove + (`!f:real^M->real^N g s. + f absolutely_integrable_on s /\ + g absolutely_integrable_on s + ==> (\x. f(x) - g(x)) absolutely_integrable_on s`, + REWRITE_TAC[VECTOR_SUB] THEN + SIMP_TAC[ABSOLUTELY_INTEGRABLE_ADD; ABSOLUTELY_INTEGRABLE_NEG]);; + +let ABSOLUTELY_INTEGRABLE_LINEAR = prove + (`!f:real^M->real^N h:real^N->real^P s. + f absolutely_integrable_on s /\ linear h + ==> (h o f) absolutely_integrable_on s`, + SUBGOAL_THEN + `!f:real^M->real^N h:real^N->real^P. + f absolutely_integrable_on (:real^M) /\ linear h + ==> (h o f) absolutely_integrable_on (:real^M)` + ASSUME_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> + ANTE_RES_THEN MP_TAC th THEN + ASSUME_TAC(MATCH_MP LINEAR_0 (CONJUNCT2 th))) THEN + ASM_REWRITE_TAC[o_DEF; COND_RAND]] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN + RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN + ASM_SIMP_TAC[INTEGRABLE_LINEAR; HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP + LINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN EXISTS_TAC `B * b:real` THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B * sum d (\k. norm(integral k (f:real^M->real^N)))` THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_LE THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(h(integral (interval[a,b]) (f:real^M->real^N)):real^P)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN MATCH_MP_TAC HAS_INTEGRAL_LINEAR THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; + +let ABSOLUTELY_INTEGRABLE_VSUM = prove + (`!f:A->real^M->real^N s t. + FINITE t /\ + (!a. a IN t ==> (f a) absolutely_integrable_on s) + ==> (\x. vsum t (\a. f a x)) absolutely_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; ABSOLUTELY_INTEGRABLE_0; IN_INSERT; + ABSOLUTELY_INTEGRABLE_ADD; ETA_AX]);; + +let ABSOLUTELY_INTEGRABLE_ABS = prove + (`!f:real^M->real^N s. + f absolutely_integrable_on s + ==> (\x. (lambda i. abs(f(x)$i)):real^N) absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. (lambda i. abs(f(x)$i))):real^M->real^N = + (\x. vsum (1..dimindex(:N)) + (\i. (((\y. (lambda j. if j = i then drop y else &0)) o + (\x. lift(norm((lambda j. if j = i then x$i else &0):real^N))) o + (f:real^M->real^N)) x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN + GEN_REWRITE_TAC I [CART_EQ] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; VSUM_COMPONENT; o_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; LIFT_DROP] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[vector_norm; dot] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sqrt(sum (1..dimindex(:N)) + (\k. if k = i then ((f:real^M->real^N) x)$i pow 2 + else &0))` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG; POW_2_SQRT_ABS]; ALL_TAC] THEN + AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN + SIMP_TAC[IN_NUMSEG; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_POW_2]; + ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_VSUM THEN + REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[DROP_ADD; REAL_ADD_LID; DROP_CMUL; REAL_MUL_RZERO]] THEN + REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + SUBGOAL_THEN + `(\x. lambda j. if j = i then (f x:real^N)$i else &0):real^M->real^N = + (\x. lambda j. if j = i then x$i else &0) o f` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]);; + +let ABSOLUTELY_INTEGRABLE_MAX = prove + (`!f:real^M->real^N g:real^M->real^N s. + f absolutely_integrable_on s /\ g absolutely_integrable_on s + ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) + absolutely_integrable_on s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ABS) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2)` o + MATCH_MP ABSOLUTELY_INTEGRABLE_CMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_ADD_COMPONENT] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC);; + +let ABSOLUTELY_INTEGRABLE_MAX_1 = prove + (`!f:real^M->real g:real^M->real s. + (\x. lift(f x)) absolutely_integrable_on s /\ + (\x. lift(g x)) absolutely_integrable_on s + ==> (\x. lift(max (f x) (g x))) absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. (lambda i. max (lift(f x)$i) (lift(g x)$i)):real^1) + absolutely_integrable_on (s:real^M->bool)` + MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_MAX]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; lift]);; + +let ABSOLUTELY_INTEGRABLE_MIN = prove + (`!f:real^M->real^N g:real^M->real^N s. + f absolutely_integrable_on s /\ g absolutely_integrable_on s + ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) + absolutely_integrable_on s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ABS) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_ADD) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SUB) THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2)` o + MATCH_MP ABSOLUTELY_INTEGRABLE_CMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_ADD_COMPONENT] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC);; + +let ABSOLUTELY_INTEGRABLE_MIN_1 = prove + (`!f:real^M->real g:real^M->real s. + (\x. lift(f x)) absolutely_integrable_on s /\ + (\x. lift(g x)) absolutely_integrable_on s + ==> (\x. lift(min (f x) (g x))) absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. (lambda i. min (lift(f x)$i) (lift(g x)$i)):real^1) + absolutely_integrable_on (s:real^M->bool)` + MP_TAC THENL [ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_MIN]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; CART_EQ] THEN SIMP_TAC[LAMBDA_BETA; lift]);; + +let ABSOLUTELY_INTEGRABLE_ABS_EQ = prove + (`!f:real^M->real^N s. + f absolutely_integrable_on s <=> + f integrable_on s /\ + (\x. (lambda i. abs(f(x)$i)):real^N) integrable_on s`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[ABSOLUTELY_INTEGRABLE_ABS; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + SUBGOAL_THEN + `!f:real^M->real^N. + f integrable_on (:real^M) /\ + (\x. (lambda i. abs(f(x)$i)):real^N) integrable_on (:real^M) + ==> f absolutely_integrable_on (:real^M)` + ASSUME_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; + GSYM INTEGRABLE_RESTRICT_UNIV] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + REWRITE_TAC[CART_EQ] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; COND_COMPONENT; VEC_COMPONENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_ABS_0]] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN + EXISTS_TAC + `sum (1..dimindex(:N)) + (\i. integral (:real^M) + (\x. (lambda j. abs ((f:real^M->real^N) x$j)):real^N)$i)` THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d (\k. sum (1..dimindex(:N)) + (\i. integral k + (\x. (lambda j. abs ((f:real^M->real^N) x$j)):real^N)$i))` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + FIRST_ASSUM(fun t -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION t]) THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (1..dimindex(:N)) + (\i. abs((integral (interval[a,b]) (f:real^M->real^N))$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y /\ --x <= y ==> abs(x) <= y`) THEN + ASM_SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN + SUBGOAL_THEN `(f:real^M->real^N) integrable_on interval[a,b] /\ + (\x. (lambda i. abs (f x$i)):real^N) integrable_on interval[a,b]` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_NEG] THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_COMPONENT_LE THEN + ASM_SIMP_TAC[INTEGRABLE_NEG; LAMBDA_BETA] THEN + ASM_SIMP_TAC[VECTOR_NEG_COMPONENT] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST_ALL_TAC THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `(integral (UNIONS d) + (\x. (lambda j. abs ((f:real^M->real^N) x$j)):real^N))$k` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM VSUM_COMPONENT] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_TOPDOWN THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRAL_SUBSET_COMPONENT_LE THEN + ASM_SIMP_TAC[LAMBDA_BETA; SUBSET_UNIV; REAL_ABS_POS]] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + MAP_EVERY EXISTS_TAC [`(:real^M)`; `d:(real^M->bool)->bool`] THEN + ASM_REWRITE_TAC[SUBSET_UNIV]);; + +let NONNEGATIVE_ABSOLUTELY_INTEGRABLE = prove + (`!f:real^M->real^N s. + (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) + ==> &0 <= f(x)$i) /\ + f integrable_on s + ==> f absolutely_integrable_on s`, + SIMP_TAC[ABSOLUTELY_INTEGRABLE_ABS_EQ] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_EQ THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; real_abs]);; + +let ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND = prove + (`!f:real^M->real^N g s. + (!x. x IN s ==> norm(f x) <= drop(g x)) /\ + f integrable_on s /\ g integrable_on s + ==> f absolutely_integrable_on s`, + SUBGOAL_THEN + `!f:real^M->real^N g. + (!x. norm(f x) <= drop(g x)) /\ + f integrable_on (:real^M) /\ g integrable_on (:real^M) + ==> f absolutely_integrable_on (:real^M)` + ASSUME_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV; GSYM + ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_UNIV] THEN + EXISTS_TAC `drop(integral(:real^M) g)` THEN + X_GEN_TAC `d:(real^M->bool)->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum d (\k. drop(integral k (g:real^M->real^1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (UNIONS d:real^M->bool) g)` THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x = y ==> y <= x`) THEN + ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_SUM; o_DEF] THEN + MATCH_MP_TAC INTEGRAL_COMBINE_DIVISION_BOTTOMUP THEN + FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IN_UNIV] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[NORM_ARITH `norm(x) <= y ==> &0 <= y`]] THEN + MATCH_MP_TAC INTEGRABLE_ON_SUBDIVISION THEN + MAP_EVERY EXISTS_TAC [`(:real^M)`; `d:(real^M->bool)->bool`] THEN + ASM_REWRITE_TAC[SUBSET_UNIV]]);; + +let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND = prove + (`!f:real^M->real^N g:real^M->real^P s. + (!x. x IN s ==> norm(f x) <= norm(g x)) /\ + f integrable_on s /\ g absolutely_integrable_on s + ==> f absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I + [absolutely_integrable_on]) THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `(\x. lift(norm((g:real^M->real^P) x)))`; + `s:real^M->bool`] ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND) THEN + ASM_REWRITE_TAC[LIFT_DROP]);; + +let ABSOLUTELY_INTEGRABLE_INF_1 = prove + (`!fs s:real^N->bool k:A->bool. + FINITE k /\ ~(k = {}) /\ + (!i. i IN k ==> (\x. lift(fs x i)) absolutely_integrable_on s) + ==> (\x. lift(inf (IMAGE (fs x) k))) absolutely_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN + SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN + ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1 THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INSERT]);; + +let ABSOLUTELY_INTEGRABLE_SUP_1 = prove + (`!fs s:real^N->bool k:A->bool. + FINITE k /\ ~(k = {}) /\ + (!i. i IN k ==> (\x. lift(fs x i)) absolutely_integrable_on s) + ==> (\x. lift(sup (IMAGE (fs x) k))) absolutely_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN + SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN + ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INSERT]);; + +let ABSOLUTELY_INTEGRABLE_CONTINUOUS = prove + (`!f:real^M->real^N a b. + f continuous_on interval[a,b] + ==> f absolutely_integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + SUBGOAL_THEN `compact(IMAGE (f:real^M->real^N) (interval[a,b]))` MP_TAC THENL + [ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_INTERVAL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^M. lift(B)` THEN + ASM_SIMP_TAC[INTEGRABLE_CONST; LIFT_DROP; INTEGRABLE_CONTINUOUS]);; + +let INTEGRABLE_MIN_CONST_1 = prove + (`!f s t. + &0 <= t /\ (!x. x IN s ==> &0 <= f x) /\ + (\x:real^N. lift(f x)) integrable_on s + ==> (\x. lift(min (f x) t)) integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN + EXISTS_TAC `\x:real^N. lift(f x)` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN + MP_TAC(ISPECL + [`\x:real^N. if x IN s then f x else &0`; + `(\x. t):real^N->real`; + `interval[a:real^N,b]`] ABSOLUTELY_INTEGRABLE_MIN_1) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [SIMP_TAC[ABSOLUTELY_INTEGRABLE_CONTINUOUS; CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[COND_RAND; LIFT_DROP; LIFT_NUM] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; LIFT_DROP; GSYM drop]; + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]);; + +let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND = prove + (`!f:real^M->real^N g:real^M->real^N s. + (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> f(x)$i <= g(x)$i) /\ + f integrable_on s /\ g absolutely_integrable_on s + ==> f absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `(\x. (g:real^M->real^N)(x) - (g(x) - f(x))) absolutely_integrable_on s` + MP_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[REAL_SUB_LE; VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + REWRITE_TAC[VECTOR_ARITH `x - (x - y):real^N = y`; ETA_AX]]);; + +let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND = prove + (`!f:real^M->real^N g:real^M->real^N s. + (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> f(x)$i <= g(x)$i) /\ + f absolutely_integrable_on s /\ g integrable_on s + ==> g absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `(\x. (f:real^M->real^N)(x) + (g(x) - f(x))) absolutely_integrable_on s` + MP_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ADD THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[REAL_SUB_LE; VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + REWRITE_TAC[VECTOR_ARITH `y + (x - y):real^N = x`; ETA_AX]]);; + +let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND = prove + (`!f:real^M->real^1 g:real^M->real^1 s. + (!x. x IN s ==> drop(f(x)) <= drop(g(x))) /\ + f integrable_on s /\ g absolutely_integrable_on s + ==> f absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN + EXISTS_TAC `g:real^M->real^1` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; + +let ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND = prove + (`!f:real^M->real^1 g:real^M->real^1 s. + (!x. x IN s ==> drop(f(x)) <= drop(g(x))) /\ + f absolutely_integrable_on s /\ g integrable_on s + ==> g absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN + EXISTS_TAC `f:real^M->real^1` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; + +let ABSOLUTELY_INTEGRABLE_PASTECART_SYM = prove + (`!f:real^(M,N)finite_sum->real^P s y. + (\z. f(pastecart (sndcart z) (fstcart z))) absolutely_integrable_on + (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s) <=> + f absolutely_integrable_on s`, + REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_PASTECART_SYM]);; + +let [HAS_INTEGRAL_PASTECART_SYM_UNIV; INTEGRAL_PASTECART_SYM_UNIV; + INTEGRABLE_PASTECART_SYM_UNIV; ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV] = + (CONJUNCTS o prove) + (`(!f:real^(M,N)finite_sum->real^P s y. + ((\z. f(pastecart (sndcart z) (fstcart z))) has_integral y) UNIV <=> + (f has_integral y) UNIV) /\ + (!f:real^(M,N)finite_sum->real^P s y. + integral UNIV (\z. f(pastecart (sndcart z) (fstcart z))) = + integral UNIV f) /\ + (!f:real^(M,N)finite_sum->real^P s y. + (\z. f(pastecart (sndcart z) (fstcart z))) integrable_on UNIV <=> + f integrable_on UNIV) /\ + (!f:real^(M,N)finite_sum->real^P s y. + (\z. f(pastecart (sndcart z) (fstcart z))) + absolutely_integrable_on UNIV <=> + f absolutely_integrable_on UNIV)`, + REPEAT STRIP_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM HAS_INTEGRAL_PASTECART_SYM]; + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_PASTECART_SYM]; + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRABLE_PASTECART_SYM]; + GEN_REWRITE_TAC RAND_CONV [GSYM ABSOLUTELY_INTEGRABLE_PASTECART_SYM]] THEN + TRY AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[FORALL_PASTECART] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Relating vector integrals to integrals of components. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_COMPONENTWISE = prove + (`!f:real^M->real^N s y. + (f has_integral y) s <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> ((\x. lift((f x)$i)) has_integral (lift(y$i))) s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o ISPEC `\u:real^N. lift(u$i)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[LINEAR_LIFT_COMPONENT]; + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o BINDER_CONV) + [GSYM BASIS_EXPANSION] THEN + MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o ISPEC `\v. drop(v) % (basis i:real^N)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN + SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_VMUL_DROP; LINEAR_ID]]);; + +let INTEGRABLE_COMPONENTWISE = prove + (`!f:real^M->real^N s. + f integrable_on s <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift((f x)$i)) integrable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[integrable_on] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [HAS_INTEGRAL_COMPONENTWISE] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM; GSYM EXISTS_LIFT]);; + +let LIFT_INTEGRAL_COMPONENT = prove + (`!f:real^M->real^N. + f integrable_on s + ==> lift((integral s f)$k) = integral s (\x. lift((f x)$k))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_COMPONENTWISE] THEN + ASM_SIMP_TAC[]);; + +let INTEGRAL_COMPONENT = prove + (`!f:real^M->real^N. + f integrable_on s + ==> (integral s f)$k = drop(integral s (\x. lift((f x)$k)))`, + SIMP_TAC[GSYM LIFT_INTEGRAL_COMPONENT; LIFT_DROP]);; + +let ABSOLUTELY_INTEGRABLE_COMPONENTWISE = prove + (`!f:real^M->real^N s. + f absolutely_integrable_on s <=> + (!i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift(f x$i)) absolutely_integrable_on s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN + MATCH_MP_TAC(MESON[] + `(p <=> !i. a i ==> P i) /\ + (p /\ (!i. a i ==> P i) ==> (q <=> (!i. a i ==> Q i))) + ==> (p /\ q <=> (!i. a i ==> P i /\ Q i))`) THEN + CONJ_TAC THENL [REWRITE_TAC[GSYM INTEGRABLE_COMPONENTWISE]; ALL_TAC] THEN + REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [SUBGOAL_THEN + `(\x. lift((f:real^M->real^N) x$i)) absolutely_integrable_on s` + MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_integrable_on]] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))` THEN + ASM_SIMP_TAC[ABS_DROP; LIFT_DROP; COMPONENT_LE_NORM]; + SUBGOAL_THEN + `(f:real^M->real^N) absolutely_integrable_on s` + MP_TAC THENL [ALL_TAC; SIMP_TAC[absolutely_integrable_on]] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC + `\x. vsum (1..dimindex(:N)) + (\i. lift(norm(lift((f:real^M->real^N)(x)$i))))` THEN + ASM_SIMP_TAC[INTEGRABLE_VSUM; IN_NUMSEG; FINITE_NUMSEG] THEN + SIMP_TAC[DROP_VSUM; FINITE_NUMSEG; o_DEF; LIFT_DROP] THEN + REWRITE_TAC[NORM_LIFT; NORM_LE_L1]]);; + +(* ------------------------------------------------------------------------- *) +(* Dominated convergence. *) +(* ------------------------------------------------------------------------- *) + +let DOMINATED_CONVERGENCE = prove + (`!f:num->real^M->real^N g h s. + (!k. (f k) integrable_on s) /\ h integrable_on s /\ + (!k x. x IN s ==> norm(f k x) <= drop(h x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + SUBGOAL_THEN + `!f:num->real^M->real^1 g h s. + (!k. (f k) integrable_on s) /\ h integrable_on s /\ + (!k x. x IN s ==> norm(f k x) <= drop(h x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!j. 1 <= j /\ j <= dimindex(:N) + ==> (\x. lift((g x)$j)) integrable_on s /\ + ((\k. integral s (\x. lift (((f:num->real^M->real^N) k x)$j))) + --> integral s (\x. lift ((g x:real^N)$j))) sequentially` + STRIP_ASSUME_TAC THENL + [REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [INTEGRABLE_COMPONENTWISE]) THEN + ASM_SIMP_TAC[]; + MAP_EVERY X_GEN_TAC [`i:num`; `x:real^M`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm((f:num->real^M->real^N) i x)` THEN + ASM_SIMP_TAC[NORM_LIFT; COMPONENT_LE_NORM]; + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [LIM_COMPONENTWISE_LIFT] THEN + ASM_SIMP_TAC[]]; + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [GEN_REWRITE_TAC I [INTEGRABLE_COMPONENTWISE] THEN ASM_SIMP_TAC[]; + DISCH_TAC THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN + ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT]]]] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP MONO_FORALL (GEN `m:num` + (ISPECL [`\k:num x:real^M. lift(inf {drop(f j x) | j IN m..(m+k)})`; + `\x:real^M. lift(inf {drop(f j x) | m:num <= j})`; + `s:real^M->bool`] + MONOTONE_CONVERGENCE_DECREASING))) THEN + REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [X_GEN_TAC `m:num` THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; + + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + MATCH_MP_TAC LOWER_BOUND_FINITE_SET_REAL THEN + REWRITE_TAC[FINITE_NUMSEG]; + + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[dist; ABS_DROP; LIFT_DROP; DROP_SUB] THEN + MP_TAC(SPEC `{drop((f:num->real^M->real^1) j x) | m <= j}` INF) THEN + ABBREV_TAC `i = inf {drop((f:num->real^M->real^1) j x) | m <= j}` THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL + [CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN + EXISTS_TAC `--drop(h(x:real^M))` THEN X_GEN_TAC `j:num` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`j:num`; `x:real^M`]) THEN + ASM_REWRITE_TAC[ABS_DROP] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `i + e:real`)) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i + e <= i)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `y < i + e ==> i <= ix /\ ix <= y ==> abs(ix - i) < e`)) THEN + CONJ_TAC THENL + [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN ANTS_TAC THENL + [REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:real` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN + ASM_ARITH_TAC; + + REWRITE_TAC[bounded] THEN + EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN + MATCH_MP_TAC REAL_ABS_INF_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD; GSYM ABS_DROP]]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + MP_TAC(MATCH_MP MONO_FORALL (GEN `m:num` + (ISPECL [`\k:num x:real^M. lift(sup {drop(f j x) | j IN m..(m+k)})`; + `\x:real^M. lift(sup {drop(f j x) | m:num <= j})`; + `s:real^M->bool`] + MONOTONE_CONVERGENCE_INCREASING))) THEN + REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [X_GEN_TAC `m:num` THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUP_1 THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; + + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + MATCH_MP_TAC UPPER_BOUND_FINITE_SET_REAL THEN + REWRITE_TAC[FINITE_NUMSEG]; + + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[dist; ABS_DROP; LIFT_DROP; DROP_SUB] THEN + MP_TAC(SPEC `{drop((f:num->real^M->real^1) j x) | m <= j}` SUP) THEN + ABBREV_TAC `i = sup {drop((f:num->real^M->real^1) j x) | m <= j}` THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL + [CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN + EXISTS_TAC `drop(h(x:real^M))` THEN X_GEN_TAC `j:num` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`j:num`; `x:real^M`]) THEN + ASM_REWRITE_TAC[ABS_DROP] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `i - e:real`)) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i <= i - e)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `i - e < y ==> ix <= i /\ y <= ix ==> abs(ix - i) < e`)) THEN + CONJ_TAC THENL + [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + W(MP_TAC o C SPEC SUP o rand o rand o snd) THEN ANTS_TAC THENL + [REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:real` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN + ASM_ARITH_TAC; + + REWRITE_TAC[bounded] THEN + EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUP_1 THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN + MATCH_MP_TAC REAL_ABS_SUP_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD; GSYM ABS_DROP]]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + MP_TAC(ISPECL + [`\k:num x:real^M. lift(inf {drop(f j x) | k <= j})`; + `g:real^M->real^1`; + `s:real^M->bool`] + MONOTONE_CONVERGENCE_INCREASING) THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_LE] THEN + CONJ_TAC THENL [MESON_TAC[LT_REFL]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `--drop(h(x:real^M))` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> --a <= x`) THEN + ASM_SIMP_TAC[GSYM ABS_DROP]; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e / &2` th)) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN + REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INF_ASCLOSE THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_TRANS; REAL_LT_IMP_LE]] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN + MESON_TAC[LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN + X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN + MATCH_MP_TAC REAL_ABS_INF_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[GSYM ABS_DROP; IN_ELIM_THM] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN + MESON_TAC[LE_REFL]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A"))] THEN + MP_TAC(ISPECL + [`\k:num x:real^M. lift(sup {drop(f j x) | k <= j})`; + `g:real^M->real^1`; + `s:real^M->bool`] + MONOTONE_CONVERGENCE_DECREASING) THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_LE] THEN + CONJ_TAC THENL [MESON_TAC[LT_REFL]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `drop(h(x:real^M))` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + ASM_SIMP_TAC[GSYM ABS_DROP]; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(fun th -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e / &2` th)) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `M:num` THEN + REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_SUP_ASCLOSE THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_TRANS; REAL_LT_IMP_LE]] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN + MESON_TAC[LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `drop(integral s (h:real^M->real^1))` THEN + X_GEN_TAC `p:num` THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[ABS_DROP; LIFT_DROP] THEN + MATCH_MP_TAC REAL_ABS_SUP_LE THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[GSYM ABS_DROP; IN_ELIM_THM] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN + MESON_TAC[LE_REFL]; + DISCH_THEN(LABEL_TAC "B")] THEN + ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "A" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "N1")) THEN + REMOVE_THEN "B" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "N2")) THEN + EXISTS_TAC `N1 + N2:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REMOVE_THEN "N1" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `N1 + N2 <= n ==> N1:num <= n`]; ALL_TAC] THEN + REMOVE_THEN "N2" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `N1 + N2 <= n ==> N2:num <= n`]; ALL_TAC] THEN + REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `i0 <= i /\ i <= i1 + ==> abs(i1 - g) < e ==> abs(i0 - g) < e ==> abs(i - g) < e`) THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THENL + [W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ANTS_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN + CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN + EXISTS_TAC `--drop(h(x:real^M))` THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> --a <= x`) THEN + REWRITE_TAC[GSYM ABS_DROP] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[LE_REFL]]; + W(MP_TAC o C SPEC SUP o rand o rand o snd) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ANTS_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; NOT_FORALL_THM] THEN + CONJ_TAC THENL [MESON_TAC[LE_REFL]; ALL_TAC] THEN + EXISTS_TAC `drop(h(x:real^M))` THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= a ==> x <= a`) THEN + REWRITE_TAC[GSYM ABS_DROP] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN REWRITE_TAC[LE_REFL]]]);; + +let DOMINATED_CONVERGENCE_INTEGRABLE = prove + (`!f:num->real^M->real^N g h s. + (!k. f k absolutely_integrable_on s) /\ + h integrable_on s /\ + (!k x. x IN s ==> norm(g x) <= drop(h x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) + ==> g integrable_on s`, + let lemma = prove + (`!f:num->real^N->real^1 g h s. + (!k. f k absolutely_integrable_on s) /\ + h integrable_on s /\ + (!x. x IN s ==> norm(g x) <= drop(h x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) + ==> g integrable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(h:real^N->real^1) absolutely_integrable_on s` + ASSUME_TAC THENL + [MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[DIMINDEX_1; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; IMP_IMP] THEN + ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n:num x:real^N. + lift(min (max (--(drop(h x))) (drop(f n x))) (drop(h x)))`; + `g:real^N->real^1`; + `h:real^N->real^1`; + `s:real^N->bool`] DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1 THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1 THEN + ASM_SIMP_TAC[LIFT_NEG; LIFT_DROP; ETA_AX; ABSOLUTELY_INTEGRABLE_NEG]; + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; ABS_DROP] THEN + SUBGOAL_THEN `&0 <= drop((h:real^N->real^1) x)` MP_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; NORM_POS_LE]; REAL_ARITH_TAC]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + UNDISCH_TAC + `!x. x IN s ==> ((\n. (f:num->real^N->real^1) n x) --> g x) + sequentially` THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[tendsto] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[dist; ABS_DROP; DROP_SUB; LIFT_DROP] THEN + REAL_ARITH_TAC]) in + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE; + INTEGRABLE_COMPONENTWISE] THEN + DISCH_TAC THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC lemma THEN + EXISTS_TAC `\i x. lift(((f:num->real^M->real^N) i x)$k)` THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[COMPONENT_LE_NORM; NORM_LIFT; REAL_LE_TRANS]; + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[LIM_COMPONENTWISE_LIFT]) THEN + RULE_ASSUM_TAC BETA_RULE THEN ASM_SIMP_TAC[]]);; + +let DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE = prove + (`!f:num->real^M->real^N g h s. + (!k. f k absolutely_integrable_on s) /\ + h integrable_on s /\ + (!k x. x IN s ==> norm(g x) <= drop(h x)) /\ + (!x. x IN s ==> ((\k. f k x) --> g x) sequentially) + ==> g absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN + EXISTS_TAC `f:num->real^M->real^N` THEN + EXISTS_TAC `h:real^M->real^1` THEN ASM_REWRITE_TAC[]);; + +let DOMINATED_CONVERGENCE_AE = prove + (`!f:num->real^M->real^N g h s t. + (!k. (f k) integrable_on s) /\ h integrable_on s /\ negligible t /\ + (!k x. x IN s DIFF t ==> norm(f k x) <= drop(h x)) /\ + (!x. x IN s DIFF t ==> ((\k. f k x) --> g x) sequentially) + ==> g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^M->real^N`; `g:real^M->real^N`; + `h:real^M->real^1`; `s DIFF t:real^M->bool`] + DOMINATED_CONVERGENCE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SPIKE_SET; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + TRY ABS_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE_SET]] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A few more properties of negligible sets. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_ON_UNIV = prove + (`!s. negligible s <=> (indicator s has_integral vec 0) (:real^N)`, + GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[NEGLIGIBLE]; ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[negligible] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + SUBGOAL_THEN `indicator s integrable_on interval[a:real^N,b]` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^N)` THEN ASM_MESON_TAC[SUBSET_UNIV; integrable_on]; + ASM_SIMP_TAC[GSYM INTEGRAL_EQ_HAS_INTEGRAL] THEN + REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN + CONJ_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP INTEGRAL_UNIQUE) THEN + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE; + REWRITE_TAC[DROP_VEC] THEN MATCH_MP_TAC INTEGRAL_DROP_POS] THEN + ASM_REWRITE_TAC[SUBSET_UNIV; DROP_INDICATOR_POS_LE] THEN + ASM_MESON_TAC[integrable_on]]);; + +let NEGLIGIBLE_COUNTABLE_UNIONS = prove + (`!s:num->real^N->bool. + (!n. negligible(s n)) ==> negligible(UNIONS {s(n) | n IN (:num)})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n. indicator(UNIONS {(s:num->real^N->bool)(m) | m <= n})`; + `indicator(UNIONS {(s:num->real^N->bool)(m) | m IN (:num)})`; + `(:real^N)`] MONOTONE_CONVERGENCE_INCREASING) THEN + SUBGOAL_THEN + `!n. negligible(UNIONS {(s:num->real^N->bool)(m) | m <= n})` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE; FORALL_IN_IMAGE]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n:num. (indicator (UNIONS {s m | m <= n})) integrable_on (:real^N)` + ASSUME_TAC THENL + [ASM_MESON_TAC[NEGLIGIBLE_ON_UNIV; integrable_on]; ALL_TAC] THEN + SUBGOAL_THEN + `!n:num. integral (:real^N) (indicator (UNIONS {s m | m <= n})) = vec 0` + ASSUME_TAC THENL + [ASM_MESON_TAC[NEGLIGIBLE_ON_UNIV; INTEGRAL_UNIQUE]; ALL_TAC] THEN + ASM_SIMP_TAC[NEGLIGIBLE_ON_UNIV; LIM_CONST_EQ; + TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[INTEGRAL_EQ_HAS_INTEGRAL]] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:num`; `x:real^N`] THEN DISCH_TAC THEN + REWRITE_TAC[indicator] THEN + SUBGOAL_THEN + `x IN UNIONS {(s:num->real^N->bool) m | m <= k} + ==> x IN UNIONS {s m | m <= SUC k}` + MP_TAC THENL + [SPEC_TAC(`x:real^N`,`x:real^N`) THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[DROP_VEC; REAL_LE_REFL; REAL_POS]]; + X_GEN_TAC `x:real^N` THEN DISCH_THEN(K ALL_TAC) THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; indicator] THEN + ASM_CASES_TAC `x IN UNIONS {(s:num->real^N->bool) m | m IN (:num)}` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_GSPEC]) THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) + [UNIONS_GSPEC]) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]; + REWRITE_TAC[SET_RULE `{c | x | x IN UNIV} = {c}`; + BOUNDED_INSERT; BOUNDED_EMPTY]]);; + +let HAS_INTEGRAL_NEGLIGIBLE_EQ = prove + (`!f:real^M->real^N s. + (!x i. x IN s /\ 1 <= i /\ i <= dimindex(:N) ==> &0 <= f(x)$i) + ==> ((f has_integral vec 0) s <=> + negligible {x | x IN s /\ ~(f x = vec 0)})`, + let lemma = prove + (`!f:real^N->real^1 s. + (!x. x IN s ==> &0 <= drop(f x)) /\ (f has_integral vec 0) s + ==> negligible {x | x IN s /\ ~(f x = vec 0)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC + `UNIONS {{x | x IN s /\ norm((f:real^N->real^1) x) >= &1 / (&n + &1)} | + n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[NEGLIGIBLE_ON_UNIV; indicator] THEN + MATCH_MP_TAC HAS_INTEGRAL_STRADDLE_NULL THEN + EXISTS_TAC `(\x. if x IN s then (&n + &1) % f(x) else vec 0): + real^N->real^1` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN + X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[DROP_VEC; DROP_CMUL; REAL_POS] THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a <= abs x ==> a <= x`) THEN + ASM_SIMP_TAC[GSYM ABS_DROP]; + COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; REAL_POS; DROP_CMUL] THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL; REAL_LE_ADD]]; + REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = (&n + &1) % vec 0`) THEN + MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[GSYM NORM_POS_LT] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `n:num` + STRIP_ASSUME_TAC)) THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN + EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LT_IMP_LE]]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN + EXISTS_TAC `{x | x IN s /\ ~((f:real^M->real^N) x = vec 0)}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN MESON_TAC[]] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `UNIONS {{x | x IN s /\ ~(((f:real^M->real^N) x)$k = &0)} | + k IN 1..dimindex(:N)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN MATCH_MP_TAC lemma THEN + ASM_SIMP_TAC[LIFT_DROP] THEN + FIRST_X_ASSUM(MP_TAC o ISPEC `\y:real^N. lift(y$k)` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_LINEAR)) THEN + REWRITE_TAC[o_DEF; VEC_COMPONENT; LIFT_NUM] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[linear] THEN + SIMP_TAC[LIFT_ADD; VECTOR_ADD_COMPONENT; LIFT_CMUL; VECTOR_MUL_COMPONENT]; + REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC; CART_EQ; IN_NUMSEG] THEN + REWRITE_TAC[VEC_COMPONENT; IN_ELIM_THM] THEN MESON_TAC[]]);; + +let NEGLIGIBLE_COUNTABLE = prove + (`!s:real^N->bool. COUNTABLE s ==> negligible s`, + let lemma = prove + (`IMAGE f s = UNIONS {{f x} | x IN s}`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIONS; IN_SING; IN_ELIM_THM] THEN + MESON_TAC[IN_SING]) in + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` SUBST1_TAC o + MATCH_MP COUNTABLE_AS_IMAGE) THEN + ONCE_REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN + REWRITE_TAC[NEGLIGIBLE_SING]);; + +(* ------------------------------------------------------------------------- *) +(* More basic "almost everywhere" variants of other theorems. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_COMPONENT_LE_AE = prove + (`!f:real^M->real^N g:real^M->real^N s i j k t. + 1 <= k /\ k <= dimindex(:N) /\ negligible t /\ + (f has_integral i) s /\ (g has_integral j) s /\ + (!x. x IN s DIFF t ==> (f x)$k <= (g x)$k) + ==> i$k <= j$k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE THEN + EXISTS_TAC `\x. if x IN t then vec 0 else (f:real^M->real^N) x` THEN + EXISTS_TAC `\x. if x IN t then vec 0 else (g:real^M->real^N) x` THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `f:real^M->real^N` THEN + EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]; + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN EXISTS_TAC `g:real^M->real^N` THEN + EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]; + COND_CASES_TAC THEN ASM_SIMP_TAC[IN_DIFF; REAL_LE_REFL]]);; + +let INTEGRAL_COMPONENT_LE_AE = prove + (`!f:real^M->real^N g:real^M->real^N s k t. + 1 <= k /\ k <= dimindex(:N) /\ negligible t /\ + f integrable_on s /\ g integrable_on s /\ + (!x. x IN s DIFF t ==> (f x)$k <= (g x)$k) + ==> (integral s f)$k <= (integral s g)$k`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE_AE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let HAS_INTEGRAL_DROP_LE_AE = prove + (`!f:real^M->real^1 g:real^M->real^1 s i j t. + (f has_integral i) s /\ (g has_integral j) s /\ + negligible t /\ (!x. x IN s DIFF t ==> drop(f x) <= drop(g x)) + ==> drop i <= drop j`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_COMPONENT_LE_AE THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN ASM_MESON_TAC[]);; + +let INTEGRAL_DROP_LE_AE = prove + (`!f:real^M->real^1 g:real^M->real^1 s t. + f integrable_on s /\ g integrable_on s /\ + negligible t /\ (!x. x IN s DIFF t ==> drop(f x) <= drop(g x)) + ==> drop(integral s f) <= drop(integral s g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_DROP_LE_AE THEN + ASM_MESON_TAC[INTEGRABLE_INTEGRAL]);; + +let NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE = prove + (`!f:real^M->real^N s t. + negligible t /\ + (!x i. x IN s DIFF t /\ 1 <= i /\ i <= dimindex(:N) + ==> &0 <= f(x)$i) /\ + f integrable_on s + ==> f absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN + EXISTS_TAC `\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0` THEN + EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_REFL; VEC_COMPONENT]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `t:real^M->bool`] THEN + ASM_SIMP_TAC[]);; + +let INTEGRAL_NORM_BOUND_INTEGRAL_AE = prove + (`!f:real^M->real^N g s t. + f integrable_on s /\ g integrable_on s /\ + negligible t /\ (!x. x IN s DIFF t ==> norm(f x) <= drop(g x)) + ==> norm(integral s f) <= drop(integral s g)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0`; + `\x. if x IN s DIFF t then (g:real^M->real^1) x else vec 0`; + `s:real^M->bool`] + INTEGRAL_NORM_BOUND_INTEGRAL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `f:real^M->real^N`; + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `g:real^M->real^1`; + ASM_MESON_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN + EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `t:real^M->bool` THEN + ASM_SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Beppo Levi theorem. *) +(* ------------------------------------------------------------------------- *) + +let BEPPO_LEVI_INCREASING = prove + (`!f:num->real^N->real^1 s. + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially`, + SUBGOAL_THEN + `!f:num->real^N->real^1 s. + (!k x. x IN s ==> &0 <= drop(f k x)) /\ + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o ISPECL + [`\n x:real^N. f(n:num) x - f 0 x:real^1`; `s:real^N->bool`]) THEN + REWRITE_TAC[] THEN ANTS_TAC THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN + MP_TAC(ISPEC + `\m n:num. drop (f m (x:real^N)) <= drop (f n x)` + TRANSITIVE_STEPWISE_LE) THEN + REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL] THEN ASM_MESON_TAC[LE_0]; + GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_SUB; REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `x - a <= y - a <=> x <= y`]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + ASM_SIMP_TAC[INTEGRAL_SUB; ETA_AX; bounded] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` + (fun th -> EXISTS_TAC `B + norm(integral s (f 0:real^N->real^1))` THEN + X_GEN_TAC `k:num` THEN MP_TAC(SPEC `k:num` th))) THEN + NORM_ARITH_TAC; + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\x. g x + f 0 x):real^N->real^1` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN + REWRITE_TAC[VECTOR_ARITH `a - b - c:real^1 = a - (c + b)`]]] THEN + REPEAT STRIP_TAC THEN + ABBREV_TAC + `g = \i n:num x:real^N. lift(min (drop(f n x) / (&i + &1)) (&1))` THEN + SUBGOAL_THEN + `!i n. ((g:num->num->real^N->real^1) i n) integrable_on s` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN + MATCH_MP_TAC INTEGRABLE_MIN_CONST_1 THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV; REAL_LE_ADD] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + ASM_SIMP_TAC[LIFT_CMUL; LIFT_DROP; INTEGRABLE_CMUL; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i:num k:num x:real^N. x IN s ==> drop(g i k x) <= drop(g i (SUC k) x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> min x a <= min y a`) THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &n + &1`]; + ALL_TAC] THEN + SUBGOAL_THEN `!i:num k:num x:real^N. x IN s ==> norm(g i k x:real^1) <= &1` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "g" THEN + REWRITE_TAC[LIFT_DROP; NORM_REAL; GSYM drop] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs(min x (&1)) <= &1`) THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_DIV; REAL_LE_ADD]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i:num x:real^N. x IN s ==> ?h:real^1. ((\n. g i n x) --> h) sequentially` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n. drop(g (i:num) (n:num) (x:real^N))`; `&1`] + CONVERGENT_BOUNDED_MONOTONE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[GSYM ABS_DROP] THEN DISJ1_TAC THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_SIMP_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `l:real` (fun th -> + EXISTS_TAC `lift l` THEN MP_TAC th)) THEN + REWRITE_TAC[LIM_SEQUENTIALLY; DIST_REAL; GSYM drop; LIFT_DROP]]; + GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `h:num->real^N->real^1` THEN STRIP_TAC THEN + MP_TAC(GEN `i:num `(ISPECL + [`g(i:num):num->real^N->real^1`; `h(i:num):real^N->real^1`; + `s:real^N->bool`] MONOTONE_CONVERGENCE_INCREASING)) THEN + DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [GEN_TAC THEN REWRITE_TAC[bounded] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `K:real` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_UNIV] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC(REAL_ARITH + `norm a = drop a /\ x <= drop a ==> x <= norm a`) THEN + CONJ_TAC THENL + [REWRITE_TAC[NORM_REAL; GSYM drop; REAL_ABS_REFL] THEN + MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= y ==> abs(min x (&1)) <= y`) THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_POS; REAL_LE_DIV] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &i + &1`] THEN + REWRITE_TAC[REAL_ARITH `a <= a * (x + &1) <=> &0 <= a * x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS]]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + ABBREV_TAC + `Z = + {x:real^N | x IN s /\ ~(?l:real^1. ((\k. f k x) --> l) sequentially)}` THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `Z:real^N->bool` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; GSYM SKOLEM_THM; RIGHT_EXISTS_IMP_THM] THEN + CONJ_TAC THENL + [ALL_TAC; EXPAND_TAC "Z" THEN REWRITE_TAC[IN_ELIM_THM] THEN SET_TAC[]] THEN + MP_TAC(ISPECL + [`h:num->real^N->real^1`; + `(\x. if x IN Z then vec 1 else vec 0):real^N->real^1`; + `s:real^N->bool`] + MONOTONE_CONVERGENCE_DECREASING) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!i x:real^N. x IN s ==> drop(h (SUC i) x) <= drop(h i x)` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `x:real^N`] THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN + EXISTS_TAC `\n. (g:num->num->real^N->real^1) (SUC i) n x` THEN + EXISTS_TAC `\n. (g:num->num->real^N->real^1) i n x` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> min x a <= min y a`) THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!i. norm(integral s ((h:num->real^N->real^1) i)) <= B / (&i + &1)` + ASSUME_TAC THENL + [X_GEN_TAC `i:num` THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\k. integral s ((g:num->num->real^N->real^1) i k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `drop(integral s (\x. inv(&i + &1) % (f:num->real^N->real^1) n x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[INTEGRABLE_CMUL; ETA_AX] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN + REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP; DROP_CMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= y ==> abs(min x (&1)) <= y`) THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_POS; REAL_LE_DIV] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[INTEGRAL_CMUL; ETA_AX; DROP_CMUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_DIV2_EQ; + REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN + ASM_REWRITE_TAC[GSYM ABS_DROP]]; + ALL_TAC] THEN + ANTS_TAC THENL + [REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [ALL_TAC; + EXISTS_TAC `B:real` THEN X_GEN_TAC `i:num` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `B / (&i + &1)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &i + &1`] THEN + REWRITE_TAC[REAL_ARITH `B <= B * (i + &1) <=> &0 <= i * B`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LT_IMP_LE]] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^N) IN Z` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN + UNDISCH_TAC `(x:real^N) IN Z` THEN EXPAND_TAC "Z" THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(GEN `B:real` (ISPECL + [`\n. drop(f (n:num) (x:real^N))`; `B:real`] + CONVERGENT_BOUNDED_MONOTONE)) THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; LEFT_EXISTS_AND_THM] THEN + MATCH_MP_TAC(TAUT + `q /\ ~r /\ (q ==> ~p ==> s) + ==> (p /\ (q \/ q') ==> r) ==> s`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_SIMP_TAC[REAL_LE_REFL; REAL_LE_TRANS] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `lift l`) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DIST_REAL; GSYM drop; DROP_SUB; LIFT_DROP]; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM; EVENTUALLY_SEQUENTIALLY] THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; REAL_NOT_LE] THEN + DISCH_TAC THEN + EXISTS_TAC `0` THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `(\n. (g:num->num->real^N->real^1) i n x)` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + EXPAND_TAC "g" THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&i + &1`) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `min a b = b <=> b <= a`] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &i + &1`; REAL_MUL_LID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a < abs N ==> &0 <= N /\ N <= n ==> a <= n`)) THEN + ASM_SIMP_TAC[]; + UNDISCH_TAC `~((x:real^N) IN Z)` THEN EXPAND_TAC "Z" THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `l:real^1` THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `e / C:real` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN STRIP_TAC THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N) * C` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C / (&i + &1)` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. (g:num->num->real^N->real^1) i n x` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `n:num` THEN + EXPAND_TAC "g" THEN REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= a ==> abs(min x (&1)) <= a`) THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; REAL_POS] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_ARITH `&0 < &i + &1`] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN + ASM_REWRITE_TAC[GSYM NORM_LIFT; LIFT_DROP]]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(MESON[LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY] + `(f --> vec 0) sequentially /\ (i = vec 0 ==> p) + ==> (f --> i) sequentially ==> p`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC `\i. B / (&i + &1)` THEN + ASM_SIMP_TAC[ALWAYS_EVENTUALLY] THEN + REWRITE_TAC[real_div; LIFT_CMUL] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = B % vec 0`) THEN + MATCH_MP_TAC LIM_CMUL THEN + REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0] THEN + X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_LIFT; GSYM drop; LIFT_DROP; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ASM_SIMP_TAC[INTEGRAL_EQ_HAS_INTEGRAL] THEN + W(MP_TAC o PART_MATCH (lhs o rand) HAS_INTEGRAL_NEGLIGIBLE_EQ o + lhand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[DROP_VEC; REAL_POS]; + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; VEC_EQ; ARITH_EQ] THEN + EXPAND_TAC "Z" THEN SIMP_TAC[IN_ELIM_THM]]]]);; + +let BEPPO_LEVI_DECREASING = prove + (`!f:num->real^N->real^1 s. + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f (SUC k) x) <= drop(f k x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + !x. x IN (s DIFF k) ==> ((\k. f k x) --> g x) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. --((f:num->real^N->real^1) n x)`; `s:real^N->bool`] + BEPPO_LEVI_INCREASING) THEN + ASM_SIMP_TAC[INTEGRABLE_NEG; DROP_NEG; ETA_AX; REAL_LE_NEG2] THEN + ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[INTEGRAL_NEG; ETA_AX; NORM_NEG]; + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^N->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. --((g:real^N->real^1) x)` THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV o ABS_CONV) + [GSYM VECTOR_NEG_NEG] THEN + ASM_SIMP_TAC[LIM_NEG_EQ]]);; + +let BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING = prove + (`!f:num->real^N->real^1 s. + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f k x) <= drop(f (SUC k) x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + (!x. x IN (s DIFF k) + ==> ((\k. f k x) --> g x) sequentially) /\ + g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BEPPO_LEVI_INCREASING) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(g:real^N->real^1) integrable_on (s DIFF k) /\ + ((\i. integral (s DIFF k) (f i)) --> integral (s DIFF k) g) sequentially` + MP_TAC THENL + [MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)); + ALL_TAC] THEN + (SUBGOAL_THEN + `!f:real^N->real^1. integral (s DIFF k) f = integral s f /\ + (f integrable_on (s DIFF k) <=> f integrable_on s)` + (fun th -> SIMP_TAC[th; IN_DIFF]) THEN + GEN_TAC THEN CONJ_TAC THEN TRY EQ_TAC THEN + (MATCH_MP_TAC INTEGRABLE_SPIKE_SET ORELSE + MATCH_MP_TAC INTEGRAL_SPIKE_SET) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SET_TAC[]));; + +let BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING = prove + (`!f:num->real^N->real^1 s. + (!k. (f k) integrable_on s) /\ + (!k x. x IN s ==> drop(f (SUC k) x) <= drop(f k x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + (!x. x IN (s DIFF k) + ==> ((\k. f k x) --> g x) sequentially) /\ + g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BEPPO_LEVI_DECREASING) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(g:real^N->real^1) integrable_on (s DIFF k) /\ + ((\i. integral (s DIFF k) (f i)) --> integral (s DIFF k) g) sequentially` + MP_TAC THENL + [MATCH_MP_TAC MONOTONE_CONVERGENCE_DECREASING THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (is_conj o concl)); + ALL_TAC] THEN + (SUBGOAL_THEN + `!f:real^N->real^1. integral (s DIFF k) f = integral s f /\ + (f integrable_on (s DIFF k) <=> f integrable_on s)` + (fun th -> SIMP_TAC[th; IN_DIFF]) THEN + GEN_TAC THEN CONJ_TAC THEN TRY EQ_TAC THEN + (MATCH_MP_TAC INTEGRABLE_SPIKE_SET ORELSE + MATCH_MP_TAC INTEGRAL_SPIKE_SET) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SET_TAC[]));; + +let BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE = prove + (`!f:num->real^N->real^1 s. + (!k. (f k) integrable_on s) /\ + (!k. ?t. negligible t /\ + !x. x IN s DIFF t ==> drop(f k x) <= drop(f (SUC k) x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + (!x. x IN (s DIFF k) + ==> ((\k. f k x) --> g x) sequentially) /\ + g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num->real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\n x. if x IN UNIONS {t k | k IN (:num)} then vec 0 + else (f:num->real^N->real^1) n x`; `s:real^N->bool`] + BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN + SUBGOAL_THEN + `negligible(UNIONS {t k | k IN (:num)}:real^N->bool)` + ASSUME_TAC THENL [ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE_UNIONS]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `(f:num->real^N->real^1) k` THEN + EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]; + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + BOUNDED_SUBSET)) THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) + ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u UNION UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `(f --> l) sequentially ==> f = g ==> (g --> l) sequentially`)) THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]]);; + +let BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE = prove + (`!f:num->real^N->real^1 s. + (!k. (f k) integrable_on s) /\ + (!k. ?t. negligible t /\ + !x. x IN s DIFF t ==> drop(f (SUC k) x) <= drop(f k x)) /\ + bounded {integral s (f k) | k IN (:num)} + ==> ?g k. negligible k /\ + (!x. x IN (s DIFF k) + ==> ((\k. f k x) --> g x) sequentially) /\ + g integrable_on s /\ + ((\k. integral s (f k)) --> integral s g) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `t:num->real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\n x. if x IN UNIONS {t k | k IN (:num)} then vec 0 + else (f:num->real^N->real^1) n x`; `s:real^N->bool`] + BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING) THEN + SUBGOAL_THEN + `negligible(UNIONS {t k | k IN (:num)}:real^N->bool)` + ASSUME_TAC THENL [ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE_UNIONS]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + EXISTS_TAC `(f:num->real^N->real^1) k` THEN + EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]; + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + BOUNDED_SUBSET)) THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) + ==> {f x | x IN s} SUBSET {g x | x IN s}`) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^1` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u UNION UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `(f --> l) sequentially ==> f = g ==> (g --> l) sequentially`)) THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `UNIONS {t k | k IN (:num)}:real^N->bool` THEN + ASM_SIMP_TAC[IN_DIFF]]]);; + +(* ------------------------------------------------------------------------- *) +(* Fatou's lemma and Lieb's extension. *) +(* ------------------------------------------------------------------------- *) + +let FATOU = prove + (`!f:num->real^N->real^1 g s t B. + negligible t /\ + (!n. (f n) integrable_on s) /\ + (!n x. x IN s DIFF t ==> &0 <= drop(f n x)) /\ + (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) /\ + (!n. drop(integral s (f n)) <= B) + ==> g integrable_on s /\ + &0 <= drop(integral s g) /\ drop(integral s g) <= B`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC + `h = \n x. lift(inf {drop((f:num->real^N->real^1) j x) | n <= j})` THEN + MP_TAC(MATCH_MP MONO_FORALL (GEN `m:num` + (ISPECL [`\k:num x:real^N. lift(inf {drop(f j x) | j IN m..(m+k)})`; + `(h:num->real^N->real^1) m`; + `s:real^N->bool`; `t:real^N->bool`] + MONOTONE_CONVERGENCE_DECREASING_AE))) THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [X_GEN_TAC `m:num` THEN EXPAND_TAC "h" THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop]; + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + MATCH_MP_TAC LOWER_BOUND_FINITE_SET_REAL THEN + REWRITE_TAC[FINITE_NUMSEG]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[dist; ABS_DROP; LIFT_DROP; DROP_SUB] THEN + MP_TAC(SPEC `{drop((f:num->real^N->real^1) j x) | m <= j}` INF) THEN + ABBREV_TAC `i = inf {drop((f:num->real^N->real^1) j x) | m <= j}` THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN + ANTS_TAC THENL [ASM_MESON_TAC[LE_REFL]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `i + e:real`)) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(i + e <= i)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `y < i + e ==> i <= ix /\ ix <= y ==> abs(ix - i) < e`)) THEN + CONJ_TAC THENL + [EXPAND_TAC "i" THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC; + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + W(MP_TAC o C SPEC INF o rand o lhand o snd) THEN ANTS_TAC THENL + [REWRITE_TAC[IMAGE_EQ_EMPTY; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:real` THEN GEN_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + DISCH_THEN(fun th -> FIRST_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG] THEN + ASM_ARITH_TAC; + REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; NORM_REAL; GSYM drop] THEN + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= b ==> abs(x) <= b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_POS_AE THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[LIFT_DROP] THEN + CONJ_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; LE_ADD]]; + TRANS_TAC REAL_LE_TRANS + `drop (integral s ((f:num->real^N->real^1) m))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + SIMP_TAC[REAL_INF_LE_FINITE; LIFT_DROP; SIMPLE_IMAGE; + FINITE_IMAGE; IMAGE_EQ_EMPTY; FINITE_NUMSEG; IN_NUMSEG; + NUMSEG_EMPTY; NOT_LT; LE_ADD; EXISTS_IN_IMAGE] THEN + MESON_TAC[REAL_LE_REFL; LE_REFL; LE_ADD]]] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INF_1 THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop]]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + MP_TAC(ISPECL [`h:num->real^N->real^1`; `g:real^N->real^1`; + `s:real^N->bool`; `t:real^N->bool`] + MONOTONE_CONVERGENCE_INCREASING_AE) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!n. &0 <= drop(integral s ((h:num->real^N->real^1) n)) /\ + drop(integral s ((h:num->real^N->real^1) n)) <= B` + MP_TAC THENL + [X_GEN_TAC `m:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_POS_AE THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[LIFT_DROP] THEN + EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + MESON_TAC[LE_REFL]; + TRANS_TAC REAL_LE_TRANS + `drop (integral s ((f:num->real^N->real^1) m))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM INF_SING] THEN + MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REWRITE_TAC[NOT_INSERT_EMPTY; SING_SUBSET; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ASM_MESON_TAC[]] THEN + MESON_TAC[LE_REFL; REAL_LE_REFL]]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_GSPEC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_LE] THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[LT_REFL]; + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; + ASM_MESON_TAC[]]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN REWRITE_TAC[DIST_REAL; GSYM drop] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ g - e / &2 <= h /\ h <= g + e / &2 ==> abs(h - g) < e`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "h" THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC REAL_INF_BOUNDS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[SET_RULE `{f n | P n} = {} <=> !n. ~P n`] THEN + CONJ_TAC THENL [MESON_TAC[LE_REFL]; GEN_TAC THEN DISCH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(h - g) < e / &2 ==> g - e / &2 <= h /\ h <= g + e / &2`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[LE_TRANS]; + REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN EXISTS_TAC `B:real` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= b ==> abs x <= b`) THEN + ASM_REWRITE_TAC[]]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LBOUND); + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND)] THEN + EXISTS_TAC `\n. integral s ((h:num->real^N->real^1) n)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_TRUE]]);; + +let LIEB = prove + (`!f:num->real^M->real^N g s t. + (!n. f n absolutely_integrable_on s) /\ g absolutely_integrable_on s /\ + negligible t /\ (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) + ==> ((\n. integral s (\x. lift(norm(f n x - g x))) - + (integral s (\x. lift(norm(f n x))) - + integral s (\x. lift(norm(g x))))) + --> vec 0) sequentially`, + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [GSYM INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX; + ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n x. lift(norm((f:num->real^M->real^N) n x - g x) - + (norm(f n x) - norm(g x)))`; + `(\x. vec 0):real^M->real^1`; + `\x. &2 % lift(norm((g:real^M->real^N) x))`; + `s:real^M->bool`; `t:real^M->bool`] + DOMINATED_CONVERGENCE_AE) THEN + REWRITE_TAC[LIFT_SUB; DROP_CMUL; INTEGRAL_0; INTEGRABLE_0] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [GSYM INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_SUB; ETA_AX; INTEGRABLE_CMUL; + ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; LIFT_DROP] THEN CONV_TAC NORM_ARITH; + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_SUB THEN + ASM_SIMP_TAC[GSYM LIM_NULL_NORM; GSYM LIM_NULL; LIM_NORM]]);; + +(* ------------------------------------------------------------------------- *) +(* Fundamental theorem of calculus, starting with strong forms. *) +(* ------------------------------------------------------------------------- *) + +let FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG = prove + (`!f:real^1->real^N f' s a b. + COUNTABLE s /\ + drop a <= drop b /\ f continuous_on interval[a,b] /\ + (!x. x IN interval[a,b] DIFF s + ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) + ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `(\x. if x IN s then vec 0 else f' x):real^1->real^N` THEN + EXISTS_TAC `s:real^1->bool` THEN + ASM_SIMP_TAC[NEGLIGIBLE_COUNTABLE; IN_DIFF] THEN + SUBGOAL_THEN + `?f t. s = IMAGE (f:num->real^1) t /\ + (!m n. m IN t /\ n IN t /\ f m = f n ==> m = n)` + MP_TAC THENL + [ASM_CASES_TAC `FINITE(s:real^1->bool)` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ASM_MESON_TAC[]; + MP_TAC(ISPEC `s:real^1->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ASM_REWRITE_TAC[INFINITE] THEN MESON_TAC[IN_UNIV]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_LEFT_INVERSE] THEN + MAP_EVERY X_GEN_TAC [`r:num->real^1`; `t:num->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `n:real^1->num`)] THEN + REWRITE_TAC[HAS_INTEGRAL_FACTOR_CONTENT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!x. ?d. &0 < d /\ + (x IN interval[a,b] + ==> (x IN IMAGE (r:num->real^1) t + ==> !y. norm(y - x) < d /\ y IN interval[a,b] + ==> norm(f y - f x) + <= e / &2 pow (4 + n x) * norm(b - a)) /\ + (~(x IN IMAGE r t) + ==> !y. norm(y - x) < d /\ y IN interval[a,b] + ==> norm(f y - f x - drop(y - x) % f' x:real^N) + <= e / &2 * norm(y - x)))` + MP_TAC THENL + [X_GEN_TAC `x:real^1` THEN + ASM_CASES_TAC `(x:real^1) IN interval[a,b]` THENL + [ALL_TAC; EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN + ASM_CASES_TAC `x IN IMAGE (r:num->real^1) t` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `a <= b ==> a = b \/ a < b`)) THEN + REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + UNDISCH_TAC `(x:real^1) IN interval[a,b]` THEN + ASM_SIMP_TAC[INTERVAL_SING; IN_SING; VECTOR_SUB_REFL; NORM_0] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[dist] THEN + DISCH_THEN(MP_TAC o SPEC + `e / &2 pow (4 + n(x:real^1)) * norm(b - a:real^1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_LT_POW2; GSYM DROP_EQ; REAL_LT_IMP_NE] THEN + MESON_TAC[REAL_LT_IMP_LE]]; + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN + ASM_REWRITE_TAC[IN_DIFF; has_vector_derivative; + HAS_DERIVATIVE_WITHIN_ALT] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2` o CONJUNCT2) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM; IMP_IMP; + TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN + X_GEN_TAC `d:real^1->real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "E") (LABEL_TAC "U"))] THEN + EXISTS_TAC `\x. ball(x:real^1,d(x))` THEN + ASM_SIMP_TAC[GAUGE_BALL_DEPENDENT] THEN + X_GEN_TAC `p:(real^1#(real^1->bool))->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^N`; `p:(real^1#(real^1->bool))->bool`; + `a:real^1`; `b:real^1`] + ADDITIVE_TAGGED_DIVISION_1) THEN + ASM_SIMP_TAC[CONTENT_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM VSUM_SUB; LAMBDA_PAIR_THM] THEN + SUBGOAL_THEN + `p:(real^1#(real^1->bool))->bool = + {(x,k) | (x,k) IN p /\ x IN IMAGE r (t:num->bool)} UNION + {(x,k) | (x,k) IN p /\ ~(x IN IMAGE r (t:num->bool))}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_UNION] THEN + MESON_TAC[]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o rand o lhand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN + SIMP_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM] THEN CONJ_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `p:(real^1#(real^1->bool))->bool` THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_PAIR_THM]; + DISCH_THEN SUBST1_TAC] THEN + SUBGOAL_THEN + `(!P. FINITE {(x:real^1,k:real^1->bool) | (x,k) IN p /\ P x k}) /\ + (!P x. FINITE {(x:real^1,k:real^1->bool) |k| (x,k) IN p /\ P x k})` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `p:real^1#(real^1->bool)->bool` THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC]; + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) <= e / &2 * a /\ norm(y) <= e / &2 * a + ==> norm(x + y) <= e * a`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `norm(vsum {(x,k) | (x,k) IN p /\ x IN IMAGE (r:num->real^1) t /\ + ~(content k = &0)} + (\(x,k). --(f(interval_upperbound k) - + (f:real^1->real^N)(interval_lowerbound k))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ_SUPERSET THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + SIMP_TAC[VECTOR_ARITH `a % vec 0 - x:real^N = --x`] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + ASM_REWRITE_TAC[CONTENT_EQ_0_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN + SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1; + INTERVAL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(VECTOR_ARITH + `x:real^N = y ==> --(x - y) = vec 0`) THEN + AP_TERM_TAC THEN ASM_REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum {(x,k:real^1->bool) | (x,k) IN p /\ x IN IMAGE (r:num->real^1) t /\ + ~(content k = &0)} + ((\(x,k). e / &2 pow (3 + n x) * norm (b - a:real^1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` + MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN + (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN + SIMP_TAC[CONTENT_EQ_0_1; REAL_NOT_LE; REAL_LT_IMP_LE; IN_INTERVAL_1; + INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + REPEAT STRIP_TAC THEN + REMOVE_THEN "E" (MP_TAC o SPEC `x:real^1`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `interval[u:real^1,v]`]) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN + ASM_REWRITE_TAC[dist; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_SUB] THEN DISCH_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + REPEAT(ANTS_TAC THENL + [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_NE_EMPTY_1; + REAL_LT_IMP_LE]; + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN + REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN NORM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`FST:real^1#(real^1->bool)->real^1`; + `\(x:real^1,k:real^1->bool). e / &2 pow (3 + n x) * norm (b - a:real^1)`; + `{(x,k:real^1->bool) | (x,k) IN p /\ x IN IMAGE (r:num->real^1) t /\ + ~(content k = &0)}`; + `IMAGE (r:num->real^1) t` + ] SUM_GROUP) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum (IMAGE (r:num->real^1) t) + (\x. sum {(x,k:real^1->bool) |k| + (x,k) IN p /\ ~(content k = &0)} + (\yk. e / &2 pow (3 + n x) * norm(b - a:real^1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CONST] THEN + REWRITE_TAC[SUM_RMUL; NORM_1; DROP_SUB; REAL_MUL_ASSOC] THEN + ASM_REWRITE_TAC[real_abs; REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_REWRITE_TAC[REAL_SUB_LE; REAL_POW_ADD; real_div; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `p * e * inv(&2 pow 3) * n = e / &8 * (p * n)`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; SUM_LMUL; REAL_ARITH + `e / &8 * x <= e * inv(&2) <=> e * x <= e * &4`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum (IMAGE (r:num->real^1) t INTER + IMAGE (FST:real^1#(real^1->bool)->real^1) p) + (\x. &(CARD {(x,k:real^1->bool) | k | + (x,k) IN p /\ ~(content k = &0)}) * + inv(&2 pow n x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_SUPERSET THEN + REWRITE_TAC[INTER_SUBSET; IMP_CONJ; FORALL_IN_IMAGE] THEN + SIMP_TAC[IN_INTER; FUN_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ENTIRE] THEN + DISJ1_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(MESON[CARD_CLAUSES] `s = {} ==> CARD s = 0`) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum (IMAGE (r:num->real^1) t INTER + IMAGE (FST:real^1#(real^1->bool)->real^1) p) + (\x. &2 / &2 pow (n x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INTER] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS; REAL_OF_NUM_LE] THEN + GEN_REWRITE_TAC RAND_CONV [ARITH_RULE `2 = 2 EXP 1`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN + MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_COMMON_TAGS THEN + ASM_MESON_TAC[tagged_division_of]; + ALL_TAC] THEN + REWRITE_TAC[real_div; SUM_LMUL; REAL_ARITH `&2 * x <= &4 <=> x <= &2`; + REAL_INV_POW] THEN + SUBGOAL_THEN + `(\x:real^1. inv (&2) pow n x) = (\n. inv(&2) pow n) o n` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE o lhand o snd) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + SUBGOAL_THEN + `?m. IMAGE (n:real^1->num) + (IMAGE (r:num->real^1) t INTER + IMAGE (FST:real^1#(real^1->bool)->real^1) p) SUBSET 0..m` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_NUMSEG; LE_0] THEN + MATCH_MP_TAC UPPER_BOUND_FINITE_SET THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INTER]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..m) (\n. inv(&2) pow n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN ASM SET_TAC[]; + REWRITE_TAC[SUM_GP; LT; SUB_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `(&1 - x) / (&1 / &2) <= &2 <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]; + MP_TAC(ISPECL [`\x:real^1. x`; `p:(real^1#(real^1->bool))->bool`; + `a:real^1`; `b:real^1`] + ADDITIVE_TAGGED_DIVISION_1) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o AP_TERM `drop`) THEN + ASM_SIMP_TAC[DROP_VSUM; DROP_SUB] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum {(x:real^1,k:real^1->bool) | + (x,k) IN p /\ ~(x IN IMAGE r (t:num->bool))} + (\x. e / &2 * (drop o + (\(x,k). interval_upperbound k - interval_lowerbound k)) x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN + SIMP_TAC[o_DEF] THEN + REWRITE_TAC[NORM_ARITH `norm(a - (b - c):real^N) = norm(b - c - a)`] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN STRIP_TAC THEN + SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` + MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN + (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN + REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_THEN(fun th -> + ASSUME_TAC th THEN MP_TAC(MATCH_MP REAL_LE_TRANS th)) THEN + SIMP_TAC[CONTENT_1; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + DISCH_TAC THEN REMOVE_THEN "U" (MP_TAC o SPEC `x:real^1`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; IN_INTERVAL_1]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^1`; `interval[u:real^1,v]`]) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + DISCH_THEN(fun th -> + MP_TAC(ISPEC `u:real^1` th) THEN MP_TAC(ISPEC `v:real^1` th)) THEN + ASM_REWRITE_TAC[dist; ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_SUB] THEN DISCH_TAC THEN DISCH_TAC THEN + REPEAT(ANTS_TAC THENL + [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_NE_EMPTY_1; + REAL_LT_IMP_LE]; + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`]]) THEN + REWRITE_TAC[NORM_1; DROP_SUB] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b ==> abs(a - b) = b - a`; + REAL_ARITH `b <= a ==> abs(a - b) = a - b`] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC(NORM_ARITH + `x - y:real^N = z ==> norm(x) <= c - b + ==> norm(y) <= b - a ==> norm(z) <= c - a`) THEN + VECTOR_ARITH_TAC; + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_PAIR_THM]] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `k:real^1->bool`] THEN STRIP_TAC THEN + SUBGOAL_THEN `?u v:real^1. k = interval[u,v] /\ x IN interval[u,v]` + MP_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN + (CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC)) THEN + REWRITE_TAC[IN_INTERVAL_1; o_THM] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_TRANS) THEN + SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[DROP_SUB] THEN ASM_REAL_ARITH_TAC]]);; + +let FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG = prove + (`!f:real^1->real^N f' s a b. + COUNTABLE s /\ + drop a <= drop b /\ f continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) DIFF s + ==> (f has_vector_derivative f'(x)) (at x)) + ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN + EXISTS_TAC `(a:real^1) INSERT (b:real^1) INSERT s` THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT; IN_INTERVAL_1; IN_DIFF] THEN + REWRITE_TAC[DE_MORGAN_THM; IN_INSERT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DIFF; IN_INSERT] THEN + ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ]);; + +let FUNDAMENTAL_THEOREM_OF_CALCULUS = prove + (`!f:real^1->real^N f' a b. + drop a <= drop b /\ + (!x. x IN interval[a,b] + ==> (f has_vector_derivative f'(x)) (at x within interval[a,b])) + ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN + EXISTS_TAC `{}:real^1->bool` THEN + ASM_REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY] THEN + MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[differentiable_on] THEN + ASM_MESON_TAC[has_vector_derivative; differentiable]);; + +let FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR = prove + (`!f:real^1->real^N f' a b. + drop a <= drop b /\ f continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) + ==> (f has_vector_derivative f'(x)) (at x)) + ==> (f' has_integral (f(b) - f(a))) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN + EXISTS_TAC `{}:real^1->bool` THEN + ASM_REWRITE_TAC[COUNTABLE_EMPTY; DIFF_EMPTY]);; + +let ANTIDERIVATIVE_INTEGRAL_CONTINUOUS = prove + (`!f:real^1->real^N a b. + (f continuous_on interval[a,b]) + ==> ?g. !u v. u IN interval[a,b] /\ v IN interval[a,b] /\ drop u <= drop v + ==> (f has_integral (g(v) - g(u))) (interval[u,v])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ANTIDERIVATIVE_CONTINUOUS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN + STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `interval[a:real^1,b]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; IN_INTERVAL_1] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* This doesn't directly involve integration, but that gives an easy proof. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL = prove + (`!f:real^1->real^N a b k y. + COUNTABLE k /\ f continuous_on interval[a,b] /\ f a = y /\ + (!x. x IN (interval[a,b] DIFF k) + ==> (f has_derivative (\h. vec 0)) (at x within interval[a,b])) + ==> !x. x IN interval[a,b] ==> f x = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(ISPEC `(\x. vec 0):real^1->real^N` HAS_INTEGRAL_UNIQUE) THEN + EXISTS_TAC `interval[a:real^1,x]` THEN + REWRITE_TAC[HAS_INTEGRAL_0] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN + EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[a:real^1,b]` THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REAL_ARITH_TAC; + X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN + SIMP_TAC[IN_DIFF; IN_INTERVAL_1] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_DERIVATIVE_WITHIN_SUBSET)) THEN + DISCH_THEN(MP_TAC o SPEC `interval(a:real^1,b)`) THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN + REWRITE_TAC[has_vector_derivative; VECTOR_MUL_RZERO] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_OPEN THEN + REPEAT(POP_ASSUM MP_TAC) THEN + SIMP_TAC[OPEN_INTERVAL; IN_INTERVAL_1; IN_DIFF] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Generalize a bit to any convex set. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX = prove + (`!f:real^M->real^N s k c y. + convex s /\ COUNTABLE k /\ f continuous_on s /\ c IN s /\ f c = y /\ + (!x. x IN (s DIFF k) ==> (f has_derivative (\h. vec 0)) (at x within s)) + ==> !x. x IN s ==> f x = y`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `z:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`(f:real^M->real^N) o (\t. (&1 - drop t) % x + drop t % y)`; + `vec 0:real^1`; `vec 1:real^1`; + `{t | ((&1 - drop t) % (x:real^M) + drop t % y) IN k}`; + `(f:real^M->real^N) x`] + HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL) THEN + REWRITE_TAC[o_THM] THEN ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ; + VECTOR_ARITH `(&1 - t) % x + t % y = (&1 - u) % x + u % y <=> + (t - u) % (x - y) = vec 0`]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; LIFT_SUB] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN + REWRITE_TAC[DROP_VEC] THEN ASM_MESON_TAC[CONVEX_ALT]]; + AP_TERM_TAC THEN REWRITE_TAC[DROP_VEC] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `(\h. vec 0) = ((\h. vec 0):real^M->real^N) o + (\t. drop t % (y - x))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `t % (y - x) = ((&0 - t) % x) + t % y`] THEN + MATCH_MP_TAC HAS_DERIVATIVE_ADD THEN + REWRITE_TAC[GSYM DROP_NEG; GSYM DROP_VEC; GSYM DROP_SUB] THEN + SIMP_TAC[HAS_DERIVATIVE_VMUL_DROP; HAS_DERIVATIVE_ID] THEN + REWRITE_TAC[DROP_SUB; VECTOR_SUB_RDISTRIB] THEN + MATCH_MP_TAC HAS_DERIVATIVE_SUB THEN + REWRITE_TAC[VECTOR_MUL_LZERO; DROP_VEC; HAS_DERIVATIVE_CONST] THEN + SIMP_TAC[HAS_DERIVATIVE_VMUL_DROP; HAS_DERIVATIVE_ID]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:real^M->bool` THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_ALT]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DIFF]) THEN + SIMP_TAC[IN_ELIM_THM; IN_DIFF] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; DROP_VEC] THEN + ASM_MESON_TAC[CONVEX_ALT]);; + +(* ------------------------------------------------------------------------- *) +(* Also to any open connected set with finite set of exceptions. Could *) +(* generalize to locally convex set with limpt-free set of exceptions. *) +(* ------------------------------------------------------------------------- *) + +let HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED = prove + (`!f:real^M->real^N s k c y. + connected s /\ open s /\ COUNTABLE k /\ f continuous_on s /\ + c IN s /\ f c = y /\ + (!x. x IN (s DIFF k) ==> (f has_derivative (\h. vec 0)) (at x within s)) + ==> !x. x IN s ==> f x = y`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN + DISCH_THEN(MP_TAC o SPEC + `{x | x IN s /\ (f:real^M->real^N) x IN {y}}`) THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN CONJ_TAC THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE; CLOSED_SING] THEN + MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + UNDISCH_TAC `open(s:real^M->bool)` THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^M` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX THEN + MAP_EVERY EXISTS_TAC [`k:real^M->bool`; `u:real^M`] THEN + ASM_REWRITE_TAC[CONVEX_BALL; IN_DIFF; CENTRE_IN_BALL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_DIFF]);; + +(* ------------------------------------------------------------------------- *) +(* Integration by parts. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRATION_BY_PARTS = prove + (`!(bop:real^M->real^N->real^P) f g f' g' a b c y. + bilinear bop /\ drop a <= drop b /\ COUNTABLE c /\ + (\x. bop (f x) (g x)) continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) DIFF c + ==> (f has_vector_derivative f'(x)) (at x) /\ + (g has_vector_derivative g'(x)) (at x)) /\ + ((\x. bop (f x) (g' x)) has_integral + ((bop (f b) (g b) - bop (f a) (g a)) - y)) + (interval[a,b]) + ==> ((\x. bop (f' x) (g x)) has_integral y) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^1. (bop:real^M->real^N->real^P) (f x) (g x)`; + `\x:real^1. (bop:real^M->real^N->real^P) (f x) (g' x) + + (bop:real^M->real^N->real^P) (f' x) (g x)`; + `c:real^1->bool`; `a:real^1`; `b:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN + ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_BILINEAR_AT] THEN + FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB)) THEN + REWRITE_TAC[VECTOR_ARITH `b - a - (b - a - y):real^N = y`; VECTOR_ADD_SUB]);; + +let INTEGRATION_BY_PARTS_SIMPLE = prove + (`!(bop:real^M->real^N->real^P) f g f' g' a b y. + bilinear bop /\ drop a <= drop b /\ + (!x. x IN interval[a,b] + ==> (f has_vector_derivative f'(x)) (at x within interval[a,b]) /\ + (g has_vector_derivative g'(x)) (at x within interval[a,b])) /\ + ((\x. bop (f x) (g' x)) has_integral + ((bop (f b) (g b) - bop (f a) (g a)) - y)) + (interval[a,b]) + ==> ((\x. bop (f' x) (g x)) has_integral y) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^1. (bop:real^M->real^N->real^P) (f x) (g x)`; + `\x:real^1. (bop:real^M->real^N->real^P) (f x) (g' x) + + (bop:real^M->real^N->real^P) (f' x) (g x)`; + `a:real^1`; `b:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN] THEN + FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB)) THEN + REWRITE_TAC[VECTOR_ARITH `b - a - (b - a - y):real^N = y`; VECTOR_ADD_SUB]);; + +let INTEGRABLE_BY_PARTS = prove + (`!(bop:real^M->real^N->real^P) f g f' g' a b c. + bilinear bop /\ COUNTABLE c /\ + (\x. bop (f x) (g x)) continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) DIFF c + ==> (f has_vector_derivative f'(x)) (at x) /\ + (g has_vector_derivative g'(x)) (at x)) /\ + (\x. bop (f x) (g' x)) integrable_on interval[a,b] + ==> (\x. bop (f' x) (g x)) integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `drop b <= drop a \/ drop a <= drop b`) THENL + [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC INTEGRABLE_ON_NULL THEN + ASM_REWRITE_TAC[CONTENT_EQ_0_1]; + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[integrable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^P` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(bop ((f:real^1->real^M) b) ((g:real^1->real^N) b) - + bop (f a) (g a)) - (y:real^P)` THEN + MATCH_MP_TAC INTEGRATION_BY_PARTS THEN MAP_EVERY EXISTS_TAC + [`f:real^1->real^M`; `g':real^1->real^N`; `c:real^1->bool`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `b - a - ((b - a) - y):real^N = y`]]);; + +let INTEGRABLE_BY_PARTS_EQ = prove + (`!(bop:real^M->real^N->real^P) f g f' g' a b c. + bilinear bop /\ COUNTABLE c /\ + (\x. bop (f x) (g x)) continuous_on interval[a,b] /\ + (!x. x IN interval(a,b) DIFF c + ==> (f has_vector_derivative f'(x)) (at x) /\ + (g has_vector_derivative g'(x)) (at x)) + ==> ((\x. bop (f x) (g' x)) integrable_on interval[a,b] <=> + (\x. bop (f' x) (g x)) integrable_on interval[a,b])`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_BY_PARTS]; DISCH_TAC] THEN + MP_TAC(ISPEC `\x y. (bop:real^M->real^N->real^P) y x` + INTEGRABLE_BY_PARTS) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + UNDISCH_TAC `bilinear(bop:real^M->real^N->real^P)` THEN + REWRITE_TAC[bilinear] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Equiintegrability. The definition here only really makes sense for an *) +(* elementary set. We just use compact intervals in applications below. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("equiintegrable_on",(12,"right"));; + +let equiintegrable_on = new_definition + `fs equiintegrable_on i <=> + (!f:real^M->real^N. f IN fs ==> f integrable_on i) /\ + (!e. &0 < e + ==> ?d. gauge d /\ + !f p. f IN fs /\ p tagged_division_of i /\ d fine p + ==> norm(vsum p (\(x,k). content(k) % f(x)) - + integral i f) < e)`;; + +let EQUIINTEGRABLE_ON_SING = prove + (`!f:real^M->real^N a b. + {f} equiintegrable_on interval[a,b] <=> + f integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN + REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN + ASM_CASES_TAC `(f:real^M->real^N) integrable_on interval[a,b]` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + REWRITE_TAC[has_integral; IMP_IMP]);; + +(* ------------------------------------------------------------------------- *) +(* Basic combining theorems for the interval of integration. *) +(* ------------------------------------------------------------------------- *) + +let EQUIINTEGRABLE_ON_NULL = prove + (`!fs:(real^M->real^N)->bool a b. + content(interval[a,b]) = &0 ==> fs equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[equiintegrable_on] THEN + ASM_SIMP_TAC[INTEGRABLE_ON_NULL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN + FIRST_ASSUM(fun th -> SIMP_TAC[MATCH_MP (REWRITE_RULE[IMP_CONJ] + VSUM_CONTENT_NULL) th]) THEN + ASM_SIMP_TAC[INTEGRAL_NULL; VECTOR_SUB_REFL; NORM_0]);; + +let EQUIINTEGRABLE_ON_SPLIT = prove + (`!fs:(real^M->real^N)->bool k a b c. + fs equiintegrable_on (interval[a,b] INTER {x | x$k <= c}) /\ + fs equiintegrable_on (interval[a,b] INTER {x | x$k >= c}) /\ + 1 <= k /\ k <= dimindex(:M) + ==> fs equiintegrable_on (interval[a,b])`, + let lemma1 = prove + (`(!x k. (x,k) IN {x,f k | P x k} ==> Q x k) <=> + (!x k. P x k ==> Q x (f k))`, + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN + SET_TAC[]) in + let lemma2 = prove + (`!f:B->B s:(A#B)->bool. + FINITE s ==> FINITE {x,f k | (x,k) IN s /\ P x k}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\(x:A,k:B). x,(f k:B)) s` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_PAIR_THM; lemma1; IN_IMAGE] THEN + REWRITE_TAC[EXISTS_PAIR_THM; PAIR_EQ] THEN MESON_TAC[]) in + let lemma3 = prove + (`!f:real^M->real^N g:(real^M->bool)->(real^M->bool) p. + FINITE p + ==> vsum {x,g k |x,k| (x,k) IN p /\ ~(g k = {})} + (\(x,k). content k % f x) = + vsum (IMAGE (\(x,k). x,g k) p) (\(x,k). content k % f x)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_SIMP_TAC[FINITE_IMAGE; lemma2] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; SUBSET; IN_IMAGE; EXISTS_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ; VECTOR_MUL_EQ_0] THEN + MESON_TAC[CONTENT_EMPTY]) in + let lemma4 = prove + (`(\(x,l). content (g l) % f x) = + (\(x,l). content l % f x) o (\(x,l). x,g l)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; FORALL_PAIR_THM]) in + REPEAT GEN_TAC THEN + ASM_CASES_TAC `1 <= k /\ k <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[equiintegrable_on] THEN + MATCH_MP_TAC(TAUT + `(a /\ b ==> c) /\ (a /\ b /\ c ==> a' /\ b' ==> c') + ==> (a /\ a') /\ (b /\ b') ==> c /\ c'`) THEN + CONJ_TAC THENL + [REWRITE_TAC[integrable_on] THEN ASM MESON_TAC[HAS_INTEGRAL_SPLIT]; + STRIP_TAC] THEN + SUBGOAL_THEN + `!f:real^M->real^N. + f IN fs + ==> integral (interval[a,b]) f = + integral (interval [a,b] INTER {x | x$k <= c}) f + + integral (interval [a,b] INTER {x | x$k >= c}) f` + (fun th -> SIMP_TAC[th]) + THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_SPLIT THEN + MAP_EVERY EXISTS_TAC [`k:num`; `c:real`] THEN + ASM_SIMP_TAC[GSYM HAS_INTEGRAL_INTEGRAL]; + ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 (MP_TAC o SPEC `e / &2`) STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I2"))) THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "I1"))) THEN + EXISTS_TAC `\x. if x$k = c then (d1(x:real^M) INTER d2(x)):real^M->bool + else ball(x,abs(x$k - c)) INTER d1(x) INTER d2(x)` THEN + CONJ_TAC THENL + [REWRITE_TAC[gauge] THEN GEN_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[OPEN_INTER; IN_INTER; OPEN_BALL; IN_BALL] THEN + ASM_REWRITE_TAC[DIST_REFL; GSYM REAL_ABS_NZ; REAL_SUB_0]; + ALL_TAC] THEN + X_GEN_TAC `f:real^M->real^N` THEN + X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `(!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {}) + ==> x$k <= c) /\ + (!x:real^M kk. (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {}) + ==> x$k >= c)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL; real_ge] THEN DISCH_THEN + (MP_TAC o MATCH_MP (SET_RULE `k SUBSET (a INTER b) ==> k SUBSET a`)) THEN + REWRITE_TAC[SUBSET; IN_BALL; dist] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M` MP_TAC) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((x - u:real^M)$k)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REMOVE_THEN "I2" (MP_TAC o SPEC + `{(x:real^M,kk INTER {x:real^M | x$k >= c}) |x,kk| + (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k >= c} = {})}` o + SPEC `f:real^M->real^N`) THEN + REMOVE_THEN "I1" (MP_TAC o SPEC + `{(x:real^M,kk INTER {x:real^M | x$k <= c}) |x,kk| + (x,kk) IN p /\ ~(kk INTER {x:real^M | x$k <= c} = {})}` o + SPEC `f:real^M->real^N`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT + `(a /\ b) /\ (a' /\ b' ==> c) ==> (a ==> a') ==> (b ==> b') ==> c`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + REWRITE_TAC[TAGGED_DIVISION_OF] THEN + REPEAT(MATCH_MP_TAC(TAUT + `(a ==> (a' /\ a'')) /\ (b ==> (b' /\ d) /\ (b'' /\ e)) + ==> a /\ b ==> ((a' /\ b') /\ d) /\ ((a'' /\ b'') /\ e)`) THEN + CONJ_TAC) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[lemma1] THEN REWRITE_TAC[IMP_IMP] THENL + [SIMP_TAC[lemma2]; + REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `kk:real^M->bool` THEN + DISCH_THEN(fun th -> CONJ_TAC THEN STRIP_TAC THEN MP_TAC th) THEN + (ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC]) THEN + (MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN + ASM_MESON_TAC[INTERVAL_SPLIT]; + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + (REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[PAIR_EQ]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' + ==> s' INTER t' = {} ==> s INTER t = {}`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]); + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a ==> b /\ c) /\ d /\ e + ==> (a ==> (b /\ d) /\ (c /\ e))`) THEN + CONJ_TAC THENL + [DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[INTER_UNIONS] THEN + ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS] THEN + X_GEN_TAC `x:real^M` THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `kk:real^M->bool` THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN MESON_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + CONJ_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + REWRITE_TAC[fine; lemma1] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `x < e / &2 /\ y < e / &2 ==> x + y < e`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP NORM_TRIANGLE_LT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[VECTOR_ARITH + `(a - i) + (b - j) = c - (i + j) <=> a + b = c:real^N`] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `vsum p (\(x,l). content (l INTER {x:real^M | x$k <= c}) % + (f:real^M->real^N) x) + + vsum p (\(x,l). content (l INTER {x:real^M | x$k >= c}) % + (f:real^M->real^N) x)` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[GSYM VSUM_ADD] THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM; GSYM VECTOR_ADD_RDISTRIB] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `l:real^M->bool`] THEN + DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `l:real^M->bool`] o + el 1 o CONJUNCTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM CONTENT_SPLIT]] THEN + ASM_SIMP_TAC[lemma3] THEN BINOP_TAC THEN + (GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [lemma4] THEN + MATCH_MP_TAC VSUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN + ASM_MESON_TAC[TAGGED_DIVISION_SPLIT_LEFT_INJ; VECTOR_MUL_LZERO; + TAGGED_DIVISION_SPLIT_RIGHT_INJ]));; + +let EQUIINTEGRABLE_DIVISION = prove + (`!fs:(real^M->real^N)->bool d a b. + d division_of interval[a,b] + ==> (fs equiintegrable_on interval[a,b] <=> + !i. i IN d ==> fs equiintegrable_on i)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC OPERATIVE_DIVISION_AND THEN + ASM_REWRITE_TAC[operative; NEUTRAL_AND] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[equiintegrable_on; INTEGRABLE_ON_NULL] THEN + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `\x:real^M. ball(x,&1)` THEN + ASM_SIMP_TAC[GAUGE_TRIVIAL; INTEGRAL_NULL; VECTOR_SUB_RZERO] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `&0 < e ==> x = vec 0 ==> norm x < e`)) THEN + MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF]) THEN + ASM_MESON_TAC[CONTENT_EQ_0_INTERIOR; SUBSET_INTERIOR; + SET_RULE `s = {} <=> s SUBSET {}`]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `c:real`; `k:num`] THEN + STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[EQUIINTEGRABLE_ON_SPLIT]] THEN + ASM_SIMP_TAC[INTEGRABLE_SPLIT; equiintegrable_on] THEN + STRIP_TAC THEN CONJ_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + (FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + ASM_CASES_TAC `gauge(d:real^M->real^M->bool)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN + ASM_CASES_TAC `(f:real^M->real^N) IN fs` THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; + `d:real^M->real^M->bool`; `e / &2`] + HENSTOCK_LEMMA_PART1) THEN ASM_SIMP_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TAGGED_PARTIAL_DIVISION_OF_SUBSET THEN + RULE_ASSUM_TAC(REWRITE_RULE[tagged_division_of]) THEN + ASM_MESON_TAC[INTER_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `&0 < e /\ x:real^N = y ==> norm(x) <= e / &2 ==> norm(y) < e`) THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN o rand o rand o snd) THEN + ASM_SIMP_TAC[GSYM INTERVAL_SPLIT; INTEGRABLE_SPLIT] THEN + DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM VSUM_SUB] THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM]));; + +(* ------------------------------------------------------------------------- *) +(* Main limit theorem for an equiintegrable sequence. *) +(* ------------------------------------------------------------------------- *) + +let EQUIINTEGRABLE_LIMIT = prove + (`!f g:real^M->real^N a b. + {f n | n IN (:num)} equiintegrable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> ((\n. f n x) --> g x) sequentially) + ==> g integrable_on interval[a,b] /\ + ((\n. integral(interval[a,b]) (f n)) --> integral(interval[a,b]) g) + sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN + ASM_SIMP_TAC[INTEGRABLE_ON_NULL; INTEGRAL_NULL; LIM_CONST] THEN + SUBGOAL_THEN `cauchy (\n. integral(interval[a,b]) (f n :real^M->real^N))` + MP_TAC THENL + [REWRITE_TAC[cauchy] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN + DISCH_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FINE_DIVISION_EXISTS) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `b:real^M`]) THEN + DISCH_THEN(X_CHOOSE_THEN `p:(real^M#(real^M->bool))->bool` + STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPECL + [`n:num`; `p:(real^M#(real^M->bool))->bool`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN + `cauchy (\n. vsum p (\(x,k:real^M->bool). + content k % (f:num->real^M->real^N) n x))` + MP_TAC THENL + [MATCH_MP_TAC CONVERGENT_IMP_CAUCHY THEN + EXISTS_TAC `vsum p (\(x,k:real^M->bool). + content k % (g:real^M->real^N) x)` THEN + MATCH_MP_TAC + (REWRITE_RULE[LAMBDA_PAIR_THM] + (REWRITE_RULE[FORALL_PAIR_THM] + (ISPECL [`sequentially`; `\(x:real^M,k:real^M->bool) (n:num). + content k % (f n x:real^N)`] LIM_VSUM))) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + ASM_SIMP_TAC[SUBSET] THEN ASM_MESON_TAC[]; + REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; GE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + ASM_CASES_TAC `N:num <= m /\ N <= n` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(sm - gm:real^N) < e / &3 /\ norm(sn - gn) < e / &3 + ==> dist(sm,sn) < e / &3 ==> dist(gm,gn) < e`) THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN + DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN + SUBGOAL_THEN `((g:real^M->real^N) has_integral l) (interval[a,b])` + (fun th -> ASM_MESON_TAC[th; integrable_on; INTEGRAL_UNIQUE]) THEN + REWRITE_TAC[has_integral] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; IN_UNIV] THEN + DISCH_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `p:(real^M#(real^M->bool))->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n:num. vsum p (\(x,k:real^M->bool). content k % f n x) - + integral (interval [a,b]) (f n :real^M->real^N)` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; REAL_LT_IMP_LE] THEN + REWRITE_TAC[EVENTUALLY_TRUE] THEN + MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + MATCH_MP_TAC + (REWRITE_RULE[LAMBDA_PAIR_THM] + (REWRITE_RULE[FORALL_PAIR_THM] + (ISPECL [`sequentially`; `\(x:real^M,k:real^M->bool) (n:num). + content k % (f n x:real^N)`] LIM_VSUM))) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + ASM_SIMP_TAC[SUBSET] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems for the set of equiintegrable functions. *) +(* ------------------------------------------------------------------------- *) + +let EQUIINTEGRABLE_SUBSET = prove + (`!fs gs s. + fs equiintegrable_on s /\ gs SUBSET fs ==> gs equiintegrable_on s`, + REWRITE_TAC[equiintegrable_on; SUBSET] THEN MESON_TAC[]);; + +let EQUIINTEGRABLE_UNION = prove + (`!fs:(real^M->real^N)->bool gs s. + fs equiintegrable_on s /\ gs equiintegrable_on s + ==> (fs UNION gs) equiintegrable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on; IN_UNION] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `e:real`)) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. (d1:real^M->real^M->bool) x INTER d2 x` THEN + ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; + +let EQUIINTEGRABLE_EQ = prove + (`!fs gs:(real^M->real^N)->bool s. + fs equiintegrable_on s /\ + (!g. g IN gs ==> ?f. f IN fs /\ (!x. x IN s ==> f x = g x)) + ==> gs equiintegrable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC (LABEL_TAC "*")) THEN + CONJ_TAC THENL + [X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `g:real^M->real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:real^M->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:real^M->real^N`) THEN + ASM_MESON_TAC[INTEGRABLE_SPIKE; IN_DIFF; NEGLIGIBLE_EMPTY]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`g:real^M->real^N`;`p:(real^M#(real^M->bool))->bool`] THEN + STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `g:real^M->real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:real^M->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real^M->real^N`;`p:(real^M#(real^M->bool))->bool`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] + `x:real^N = y /\ a = b ==> norm(x - a) < e ==> norm(y - b) < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF; SUBSET]) THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[INTEGRAL_EQ]]]);; + +let EQUIINTEGRABLE_CMUL = prove + (`!fs:(real^M->real^N)->bool s k. + fs equiintegrable_on s + ==> {(\x. c % f x) | abs(c) <= k /\ f IN fs} equiintegrable_on s`, + REPEAT GEN_TAC THEN + SIMP_TAC[equiintegrable_on; INTEGRABLE_CMUL; FORALL_IN_GSPEC] THEN + STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; INTEGRAL_CMUL; IMP_IMP] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs(k) + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_MUL_LZERO; + REAL_ARITH `&0 < abs(k) + &1`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `f:real^M->real^N`; + `p:(real^M#(real^M->bool))->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPECL [`f:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x <= c * y ==> x <= y * (c + &1)`) THEN + REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC(REAL_ARITH + `!c. x = c * y /\ c * y <= k * y ==> x <= k * y`) THEN + EXISTS_TAC `abs c:real` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM NORM_MUL; GSYM VSUM_LMUL; VECTOR_SUB_LDISTRIB] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; VECTOR_MUL_ASSOC; REAL_MUL_SYM]; + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REAL_ARITH_TAC]);; + +let EQUIINTEGRABLE_ADD = prove + (`!fs:(real^M->real^N)->bool gs s. + fs equiintegrable_on s /\ gs equiintegrable_on s + ==> {(\x. f x + g x) | f IN fs /\ g IN gs} equiintegrable_on s`, + REPEAT GEN_TAC THEN + SIMP_TAC[equiintegrable_on; INTEGRABLE_ADD; FORALL_IN_GSPEC] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "f")) + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "g"))) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; INTEGRAL_ADD; IMP_IMP] THEN + REMOVE_THEN "g" (MP_TAC o SPEC `e / &2`) THEN + REMOVE_THEN "f" (MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "f"))) THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real^M->real^M->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "g"))) THEN + EXISTS_TAC `\x. (d1:real^M->real^M->bool) x INTER d2 x` THEN + ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`; + `p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN + REMOVE_THEN "g" (MP_TAC o SPECL + [`g:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`]) THEN + REMOVE_THEN "f" (MP_TAC o SPECL + [`f:real^M->real^N`; `p:(real^M#(real^M->bool))->bool`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH + `s + s' = t + ==> norm(s - i) < e / &2 ==> norm(s' - i') < e / &2 + ==> norm(t - (i + i')) < e`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM VSUM_ADD] THEN + REWRITE_TAC[LAMBDA_PAIR_THM; VECTOR_ADD_LDISTRIB]);; + +let EQUIINTEGRABLE_NEG = prove + (`!fs:(real^M->real^N)->bool s. + fs equiintegrable_on s + ==> {(\x. --(f x)) | f IN fs} equiintegrable_on s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `&1` o MATCH_MP EQUIINTEGRABLE_CMUL) THEN + MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN EXISTS_TAC `-- &1` THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VECTOR_MUL_LID] THEN REAL_ARITH_TAC);; + +let EQUIINTEGRABLE_SUB = prove + (`!fs:(real^M->real^N)->bool gs s. + fs equiintegrable_on s /\ gs equiintegrable_on s + ==> {(\x. f x - g x) | f IN fs /\ g IN gs} equiintegrable_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 + MP_TAC (MP_TAC o MATCH_MP EQUIINTEGRABLE_NEG)) THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_ADD) THEN + MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN + EXISTS_TAC `\x. --((g:real^M->real^N) x)` THEN + ASM_REWRITE_TAC[VECTOR_SUB] THEN EXISTS_TAC `g:real^M->real^N` THEN + ASM_REWRITE_TAC[]);; + +let EQUIINTEGRABLE_SUM = prove + (`!fs:(real^M->real^N)->bool a b. + fs equiintegrable_on interval[a,b] + ==> {(\x. vsum t (\i. c i % f i x)) | + FINITE t /\ + (!i:A. i IN t ==> &0 <= c i /\ (f i) IN fs) /\ + sum t c = &1} + equiintegrable_on interval[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; RIGHT_IMP_FORALL_THM] THEN + STRIP_TAC THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [INTEGRABLE_CMUL; INTEGRABLE_VSUM; ETA_AX; INTEGRAL_VSUM] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC + [`t:A->bool`; `c:A->real`; `f:A->real^M->real^N`; + `p:(real^M#(real^M->bool))->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!i:A. i IN t + ==> integral (interval[a,b]) (\x:real^M. c i % f i x:real^N) = + vsum p (\(x:real^M,k). + integral (k:real^M->bool) (\x:real^M. c i % f i x))` + (fun th -> SIMP_TAC[th]) + THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN + ASM_SIMP_TAC[INTEGRABLE_CMUL; ETA_AX]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + SUBGOAL_THEN + `vsum p (\(x,k:real^M->bool). content k % vsum t (\i. c i % f i x)) = + vsum t (\i. c i % + vsum p (\(x,k). content k % (f:A->real^M->real^N) i x))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM VSUM_LMUL] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_SWAP o + rand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_SYM]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum t (\i:A. c i * e / &2)` THEN CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[SUM_RMUL; ETA_AX; REAL_MUL_LID] THEN ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[GSYM VSUM_SUB] THEN MATCH_MP_TAC VSUM_NORM_LE THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN + ASM_SIMP_TAC[GSYM VSUM_LMUL; GSYM VSUM_SUB] THEN + REWRITE_TAC[LAMBDA_PAIR_THM] THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`(f:A->real^M->real^N) i`; `p:(real^M#(real^M->bool))->bool`]) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + DISCH_THEN(MP_TAC o SPEC `abs((c:A->real) i)` o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_LMUL)) THEN + ASM_REWRITE_TAC[REAL_ABS_POS; GSYM NORM_MUL] THEN + ASM_SIMP_TAC[GSYM VSUM_LMUL; VECTOR_SUB_LDISTRIB; real_abs] THEN + REWRITE_TAC[LAMBDA_PAIR_THM] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= a ==> y <= a`) THEN + AP_TERM_TAC THEN + SUBGOAL_THEN + `integral (interval[a,b]) ((f:A->real^M->real^N) i) = + vsum p (\(x:real^M,k). integral (k:real^M->bool) (f i))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM VSUM_LMUL; GSYM VSUM_SUB] THEN + MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_CMUL THEN + RULE_ASSUM_TAC(REWRITE_RULE[TAGGED_DIVISION_OF]) THEN + ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL]);; + +let EQUIINTEGRABLE_UNIFORM_LIMIT = prove + (`!fs:(real^M->real^N)->bool a b. + fs equiintegrable_on interval[a,b] + ==> {g | !e. &0 < e + ==> ?f. f IN fs /\ + !x. x IN interval[a,b] ==> norm(g x - f x) < e} + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN + REWRITE_TAC[equiintegrable_on; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN + STRIP_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_UNIFORM_LIMIT; REAL_LT_IMP_LE]; ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC + [`g:real^M->real^N`;`p:(real^M#(real^M->bool))->bool`] THEN + STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + SUBGOAL_THEN `(g:real^M->real^N) integrable_on interval[a,b]` + ASSUME_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_UNIFORM_LIMIT; REAL_LT_IMP_LE]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:num->real^M->real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN interval[a,b] + ==> ((\n. f n x) --> (g:real^M->real^N) x) sequentially` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `k:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `k:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,b) = norm(b - a)`] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:num->real^M->real^N`; `g:real^M->real^N`; + `a:real^M`; `b:real^M`] EQUIINTEGRABLE_LIMIT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQUIINTEGRABLE_SUBSET THEN + EXISTS_TAC `fs:(real^M->real^N)->bool` THEN ASM SET_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN + SUBGOAL_THEN + `((\n. vsum p (\(x,k:real^M->bool). + content k % (f:num->real^M->real^N) n x)) --> + vsum p (\(x,k). content k % g x)) sequentially` + (LABEL_TAC "+") + THENL + [MATCH_MP_TAC + (REWRITE_RULE[LAMBDA_PAIR_THM] + (REWRITE_RULE[FORALL_PAIR_THM] + (ISPECL [`sequentially`; `\(x:real^M,k:real^M->bool) (n:num). + content k % (f n x:real^N)`] LIM_VSUM))) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_CMUL THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + ASM_SIMP_TAC[SUBSET] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[dist]] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "*")) THEN + REMOVE_THEN "+" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[dist]] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "+")) THEN + SUBGOAL_THEN `?n:num. N1 <= n /\ N2 <= n` STRIP_ASSUME_TAC THENL + [EXISTS_TAC `N1 + N2:num` THEN ARITH_TAC; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN + REMOVE_THEN "+" (MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(f:num->real^M->real^N) n`;`p:(real^M#(real^M->bool))->bool`]) THEN + ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let EQUIINTEGRABLE_REFLECT = prove + (`!fs:(real^M->real^N)->bool a b. + fs equiintegrable_on interval[a,b] + ==> {(\x. f(--x)) | f IN fs} equiintegrable_on interval[--b,--a]`, + let lemma = prove + (`(!x k. (x,k) IN IMAGE (\(x,k). f x k,g x k) s ==> Q x k) <=> + (!x k. (x,k) IN s ==> Q (f x k) (g x k))`, + REWRITE_TAC[IN_IMAGE; PAIR_EQ; EXISTS_PAIR_THM] THEN SET_TAC[]) in + REPEAT GEN_TAC THEN REWRITE_TAC[equiintegrable_on] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[INTEGRABLE_REFLECT; INTEGRAL_REFLECT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. IMAGE (--) ((d:real^M->real^M->bool) (--x))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + SIMP_TAC[gauge; OPEN_NEGATIONS] THEN DISCH_TAC THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_NEG] THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `f:real^M->real^N` THEN DISCH_TAC THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:real^M->real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\(x,k). (--x:real^M,IMAGE (--) (k:real^M->bool))) p`) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [TAGGED_DIVISION_OF]) THEN + REWRITE_TAC[TAGGED_DIVISION_OF] THEN + STRIP_TAC THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; lemma] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[FUN_IN_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN + ASM_SIMP_TAC[VECTOR_NEG_NEG; GSYM SUBSET] THEN ASM_MESON_TAC[]; + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = --y <=> --x = y`] THEN + ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN + REWRITE_TAC[UNWIND_THM1] THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + ASM_MESON_TAC[VECTOR_NEG_NEG]]; + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`y:real^M`; `l:real^M->bool`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`x:real^M`; `k:real^M->bool`; + `y:real^M`; `l:real^M->bool`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN + CONJ_TAC THENL [MESON_TAC[PAIR_EQ]; ALL_TAC] THEN + REWRITE_TAC[INTERIOR_NEGATIONS] THEN + MATCH_MP_TAC(SET_RULE + `(!x. f(f x) = x) + ==> s INTER t = {} ==> IMAGE f s INTER IMAGE f t = {}`) THEN + REWRITE_TAC[VECTOR_NEG_NEG]; + GEN_REWRITE_TAC I [EXTENSION] THEN + ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN X_GEN_TAC `y:real^M` THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + MATCH_MP_TAC(MESON[] + `!f. (!x. f(f x) = x) /\ (!x. P x <=> Q(f x)) + ==> ((?x. P x) <=> (?x. Q x))`) THEN + EXISTS_TAC `IMAGE ((--):real^M->real^M)` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; IMAGE_ID]; + ALL_TAC] THEN + X_GEN_TAC `t:real^M->bool` THEN BINOP_TAC THENL + [REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM; PAIR_EQ] THEN + SUBGOAL_THEN `!k:real^M->bool. IMAGE (--) (IMAGE (--) k) = k` + MP_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; IMAGE_ID]; + MESON_TAC[]]; + MATCH_MP_TAC(SET_RULE + `(!x. f(f x) = x) ==> (y IN s <=> f y IN IMAGE f s)`) THEN + REWRITE_TAC[VECTOR_NEG_NEG]]]; + ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [fine]) THEN + REWRITE_TAC[fine; lemma] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `(!x. f(f x) = x) ==> k SUBSET IMAGE f s ==> IMAGE f k SUBSET s`) THEN + REWRITE_TAC[VECTOR_NEG_NEG]; + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `x:real^N = y ==> norm(x - i) < e ==> norm(y - i) < e`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC(MESON[] + `(!x. f(f x) = x) + ==> !x y. x IN p /\ y IN p /\ f x = f y ==> x = y`) THEN + REWRITE_TAC[FORALL_PAIR_THM; GSYM IMAGE_o; o_DEF; VECTOR_NEG_NEG; + IMAGE_ID]; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `(--):real^M->real^M = (\x. --(&1) % x + vec 0)` SUBST1_TAC + THENL [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CONTENT_IMAGE_AFFINITY_INTERVAL; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID; REAL_ABS_NUM]]]);; + +(* ------------------------------------------------------------------------- *) +(* Some technical lemmas about minimizing a "flat" part of a sum over a *) +(* division, followed by subinterval resictions for equiintegrable family. *) +(* ------------------------------------------------------------------------- *) + +let SUM_CONTENT_AREA_OVER_THIN_DIVISION = prove + (`!d a b:real^M s i c. + d division_of s /\ s SUBSET interval[a,b] /\ + 1 <= i /\ i <= dimindex(:M) /\ a$i <= c /\ c <= b$i /\ + (!k. k IN d ==> ~(k INTER {x | x$i = c} = {})) + ==> (b$i - a$i) * + sum d (\k. content k / + (interval_upperbound k$i - interval_lowerbound k$i)) + <= &2 * content(interval[a,b])`, + let lemma0 = prove + (`!k:real^M->bool i. + 1 <= i /\ i <= dimindex(:M) + ==> content k / (interval_upperbound k$i - interval_lowerbound k$i) = + if content k = &0 then &0 + else product ((1..dimindex(:M)) DELETE i) + (\j. interval_upperbound k$j - + interval_lowerbound k$j)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[content] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[CONTENT_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN + `1..dimindex(:M) = i INSERT ((1..dimindex(:M)) DELETE i)` + MP_TAC THENL + [REWRITE_TAC[SET_RULE `s = x INSERT (s DELETE x) <=> x IN s`] THEN + ASM_REWRITE_TAC[IN_NUMSEG]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [th])] THEN + ASM_SIMP_TAC[PRODUCT_CLAUSES; IN_NUMSEG; FINITE_DELETE; FINITE_NUMSEG; + IN_DELETE] THEN + MATCH_MP_TAC(REAL_FIELD `~(y = &0) ==> (y * x) * inv y = x`) THEN + DISCH_TAC THEN + UNDISCH_TAC `~(content(k:real^M->bool) = &0)` THEN + ASM_REWRITE_TAC[content; PRODUCT_EQ_0_NUMSEG] THEN ASM_MESON_TAC[]) + and lemma1 = prove + (`!d a b:real^M s i. + d division_of s /\ s SUBSET interval[a,b] /\ + 1 <= i /\ i <= dimindex(:M) /\ + ((!k. k IN d + ==> ~(content k = &0) /\ ~(k INTER {x | x$i = a$i} = {})) \/ + (!k. k IN d + ==> ~(content k = &0) /\ ~(k INTER {x | x$i = b$i} = {}))) + ==> (b$i - a$i) * + sum d (\k. content k / + (interval_upperbound k$i - interval_lowerbound k$i)) + <= content(interval[a,b])`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ABBREV_TAC + `extend = + \k:real^M->bool. interval + [(lambda j. if j = i then (a:real^M)$i + else interval_lowerbound k$j):real^M, + (lambda j. if j = i then (b:real^M)$i + else interval_upperbound k$j)]` THEN + SUBGOAL_THEN `!k. k IN d ==> k SUBSET interval[a:real^M,b]` + ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[division_of]) THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!k:real^M->bool. k IN d ==> ~(k = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + SUBGOAL_THEN + `(!k. k IN d ==> ~((extend:(real^M->bool)->(real^M->bool)) k = {})) /\ + (!k. k IN d ==> extend k SUBSET interval[a,b])` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN + (DISCH_TAC THEN EXPAND_TAC "extend" THEN + SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b]` MP_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(interval[u:real^M,v] = {})` MP_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + SIMP_TAC[SUBSET_INTERVAL; INTERVAL_NE_EMPTY; LAMBDA_BETA; + INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN + MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]); + ALL_TAC] THEN + SUBGOAL_THEN + `!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) + ==> interior((extend:(real^M->bool)->(real^M->bool)) k1) INTER + interior(extend k2) = {}` + ASSUME_TAC THENL + [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`w:real^M`; `z:real^M`] THEN DISCH_TAC THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o el 2 o CONJUNCTS) THEN DISCH_THEN(MP_TAC o SPECL + [`interval[u:real^M,v]`; `interval[w:real^M,z]`]) THEN + ASM_REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXPAND_TAC "extend" THEN + SIMP_TAC[INTERIOR_CLOSED_INTERVAL; IN_INTERVAL; LAMBDA_BETA] THEN + SUBGOAL_THEN `~(interval[u:real^M,v] = {}) /\ + ~(interval[w:real^M,z] = {})` + MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + SIMP_TAC[SUBSET_INTERVAL; INTERVAL_NE_EMPTY; LAMBDA_BETA; + INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN + STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `x:real^M` MP_TAC) THEN + MP_TAC(MESON[] + `(!P. (!j:num. P j) <=> P i /\ (!j. ~(j = i) ==> P j))`) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (LAND_CONV o ONCE_DEPTH_CONV) [th]) THEN + ASM_SIMP_TAC[IMP_IMP] THEN STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_THEN + (fun th -> MP_TAC(SPEC `interval[u:real^M,v]` th) THEN + MP_TAC(SPEC `interval[w:real^M,z]` th))) THEN + ASM_REWRITE_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL] THEN + REWRITE_TAC[IMP_CONJ; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[IN_INTERVAL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `q:real^M` THEN STRIP_TAC THEN + X_GEN_TAC `r:real^M` THEN STRIP_TAC THEN + X_GEN_TAC `s:real^M` THEN STRIP_TAC THEN + X_GEN_TAC `t:real^M` THEN STRIP_TAC THENL + [EXISTS_TAC `(lambda j. if j = i then min ((q:real^M)$i) ((s:real^M)$i) + else (x:real^M)$j):real^M`; + EXISTS_TAC `(lambda j. if j = i then max ((q:real^M)$i) ((s:real^M)$i) + else (x:real^M)$j):real^M`] THEN + (SIMP_TAC[AND_FORALL_THM; LAMBDA_BETA] THEN X_GEN_TAC `j:num` THEN + ASM_CASES_TAC `j:num = i` THEN ASM_SIMP_TAC[] THEN + UNDISCH_THEN `j:num = i` SUBST_ALL_TAC THEN + SUBGOAL_THEN `interval[u:real^M,v] SUBSET interval[a,b] /\ + interval[w:real^M,z] SUBSET interval[a,b]` + MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(interval[u:real^M,v] = {}) /\ + ~(interval[w:real^M,z] = {})` + MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL] THEN + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC); + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum (IMAGE (extend:(real^M->bool)->(real^M->bool)) d) content` THEN + CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE_NONZERO o rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`k1:real^M->bool`; `k2:real^M->bool`]) THEN + ASM_REWRITE_TAC[INTER_IDEMPOT] THEN + EXPAND_TAC "extend" THEN REWRITE_TAC[CONTENT_EQ_0_INTERIOR]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN + ASM_CASES_TAC `content(interval[u:real^M,v]) = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; o_THM] THEN + EXPAND_TAC "extend" THEN REWRITE_TAC[CONTENT_POS_LE]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND; + REAL_LT_IMP_LE; real_div; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + SUBGOAL_THEN + `~((extend:(real^M->bool)->(real^M->bool)) (interval[u,v]) = {})` + MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + EXPAND_TAC "extend" THEN ASM_SIMP_TAC[content; o_THM] THEN + ASM_SIMP_TAC[INTERVAL_NE_EMPTY; INTERVAL_LOWERBOUND; + INTERVAL_UPPERBOUND; REAL_LT_IMP_LE] THEN + DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN + `1..dimindex(:M) = i INSERT ((1..dimindex(:M)) DELETE i)` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) THEN + ASM_REWRITE_TAC[IN_NUMSEG]; + ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DELETE] THEN + ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC(REAL_RING + `x:real = y ==> ab * uv * x = (ab * y) * uv`) THEN + MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA]]; + MATCH_MP_TAC SUBADDITIVE_CONTENT_DIVISION THEN EXISTS_TAC + `UNIONS (IMAGE (extend:(real^M->bool)->(real^M->bool)) d)` THEN + ASM_SIMP_TAC[UNIONS_SUBSET; division_of; FINITE_IMAGE] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + REPEAT CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN + DISCH_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN + EXPAND_TAC "extend" THEN REWRITE_TAC[] THEN MESON_TAC[]; + ASM_MESON_TAC[]; + ASM_SIMP_TAC[]]]) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THENL + [MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 <= y ==> x <= &2 * y`) THEN + REWRITE_TAC[CONTENT_POS_LE; REAL_ENTIRE] THEN DISJ2_TAC THEN + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `k:real^M->bool` THEN + DISCH_TAC THEN REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN + MATCH_MP_TAC CONTENT_0_SUBSET THEN + MAP_EVERY EXISTS_TAC [`a:real^M`; `b:real^M`] THEN + ASM_MESON_TAC[division_of; SUBSET_TRANS]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + MP_TAC(ISPECL + [`{k | k IN {l INTER {x | x$i <= c} | l | + l IN d /\ ~(l INTER {x:real^M | x$i <= c} = {})} /\ + ~(content k = &0)}`; + `a:real^M`; + `(lambda j. if j = i then c else (b:real^M)$j):real^M`; + `UNIONS {k | k IN {l INTER {x | x$i <= c} | l | + l IN d /\ ~(l INTER {x:real^M | x$i <= c} = {})} /\ + ~(content k = &0)}`; + `i:num`] lemma1) THEN + MP_TAC(ISPECL + [`{k | k IN {l INTER {x | x$i >= c} | l | + l IN d /\ ~(l INTER {x:real^M | x$i >= c} = {})} /\ + ~(content k = &0)}`; + `(lambda j. if j = i then c else (a:real^M)$j):real^M`; + `b:real^M`; + `UNIONS {k | k IN {l INTER {x | x$i >= c} | l | + l IN d /\ ~(l INTER {x:real^M | x$i >= c} = {})} /\ + ~(content k = &0)}`; + `i:num`] lemma1) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT + `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p2 ==> q2) ==> (p1 ==> q1) ==> r`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN + (REPEAT CONJ_TAC THENL + [REWRITE_TAC[division_of] THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_RESTRICT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + CONJ_TAC THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN + REPEAT DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; SUBSET; IN_UNIONS] THEN ASM_MESON_TAC[]; + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]]; + X_GEN_TAC `k:real^M->bool` THEN REPEAT DISCH_TAC THEN + X_GEN_TAC `l:real^M->bool` THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + DISCH_THEN(MP_TAC o SPECL [`k:real^M->bool`; `l:real^M->bool`] o + el 2 o CONJUNCTS) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' + ==> s' INTER t' = {} ==> s INTER t = {}`) THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_INTERIOR THEN SET_TAC[]]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN + X_GEN_TAC `k:real^M->bool` THEN REPEAT DISCH_TAC THEN + SUBGOAL_THEN `k SUBSET interval[a:real^M,b]` MP_TAC THENL + [ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `i INTER h SUBSET j ==> k SUBSET i ==> k INTER h SUBSET j`) THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; SUBSET_INTERVAL; LAMBDA_BETA] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REAL_ARITH_TAC; + ALL_TAC]) + THENL [DISJ2_TAC; DISJ1_TAC] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ] THEN + ASM_SIMP_TAC[LAMBDA_BETA; real_ge] THEN ASM SET_TAC[REAL_LE_REFL]; + ASM_SIMP_TAC[LAMBDA_BETA]] THEN + SUBGOAL_THEN + `sum {k | k IN + { l INTER {x | x$i <= c} | l | + l IN d /\ ~(l INTER {x:real^M | x$i <= c} = {})} /\ + ~(content k = &0)} + (\k. content k / + (interval_upperbound k$i - interval_lowerbound k$i)) = + sum d ((\k. content k / + (interval_upperbound k$i - interval_lowerbound k$i)) o + (\k. k INTER {x | x$i <= c})) /\ + sum {k | k IN + { l INTER {x | x$i >= c} | l | + l IN d /\ ~(l INTER {x:real^M | x$i >= c} = {})} /\ + ~(content k = &0)} + (\k. content k / + (interval_upperbound k$i - interval_lowerbound k$i)) = + sum d ((\k. content k / + (interval_upperbound k$i - interval_lowerbound k$i)) o + (\k. k INTER {x | x$i >= c}))` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN + (W(MP_TAC o PART_MATCH (rand o rand) SUM_IMAGE_NONZERO o rand o snd) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `l:real^M->bool`] THEN + STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_ENTIRE] THEN DISJ1_TAC THEN + (MATCH_MP_TAC DIVISION_SPLIT_LEFT_INJ ORELSE + MATCH_MP_TAC DIVISION_SPLIT_RIGHT_INJ) THEN ASM_MESON_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `x IN IMAGE f d /\ + ~(x IN {x | x IN {f y |y| y IN d /\ ~(f y = a)} /\ ~P x}) + ==> (!y. f y = a ==> P(f y)) ==> P x`)) THEN + SIMP_TAC[CONTENT_EMPTY; real_div; REAL_MUL_LZERO]]); + ALL_TAC] THEN + MAP_EVERY (fun (t,tac) -> + ASM_CASES_TAC t THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN DISCH_THEN(MP_TAC o tac) THEN + MATCH_MP_TAC(REAL_ARITH `x = y /\ a <= b ==> x <= a ==> y <= b`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + PURE_REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN + REWRITE_TAC[real_ge; SET_RULE + `k INTER {x | P x} = k <=> (!x. x IN k ==> P x)`] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN `x IN interval[a:real^M,b]` MP_TAC THENL + [ASM_MESON_TAC[SUBSET; division_of]; ALL_TAC] THEN + ASM_SIMP_TAC[IN_INTERVAL]; + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x <= y ==> x <= &2 * y`) THEN + REWRITE_TAC[CONTENT_POS_LE] THEN MATCH_MP_TAC CONTENT_SUBSET THEN + SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN + MESON_TAC[REAL_LE_REFL]]; + ALL_TAC]) + [`c = (a:real^M)$i`,CONJUNCT2; `c = (b:real^M)$i`,CONJUNCT1] THEN + SUBGOAL_THEN `(a:real^M)$i < c /\ c < (b:real^M)$i` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + REWRITE_TAC[REAL_ARITH `(x * &2) / y = &2 * x / y`] THEN + MATCH_MP_TAC(REAL_ARITH + `s <= s1 + s2 /\ c1 = c /\ c2 = c + ==> s1 <= c1 /\ s2 <= c2 ==> s <= &2 * c`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[lemma0] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN DISCH_TAC THEN + SUBGOAL_THEN + `~(interval[u:real^M,v] = {}) /\ interval[u,v] SUBSET interval[a,b]` + MP_TAC THENL [ASM_MESON_TAC[division_of; SUBSET_TRANS]; ALL_TAC] THEN + SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; IMP_CONJ] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ c1 + c2 = c /\ + (~(c1 = &0) ==> x1 = x) /\ (~(c2 = &0) ==> x2 = x) + ==> (if c = &0 then &0 else x) <= + (if c1 = &0 then &0 else x1) + + (if c2 = &0 then &0 else x2)`) THEN + ASM_SIMP_TAC[GSYM CONTENT_SPLIT] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; CONTENT_POS_LE] THEN CONJ_TAC THENL + [MATCH_MP_TAC PRODUCT_POS_LE THEN + ASM_SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_DELETE; IN_NUMSEG; + INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_SUB_LE]; + REWRITE_TAC[CONTENT_EQ_0; REAL_NOT_LE; MESON[] + `~(?i. P i /\ Q i /\ R i) <=> (!i. P i /\ Q i ==> ~R i)`] THEN + SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_LT_IMP_LE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; IN_DELETE; + IN_NUMSEG; LAMBDA_BETA]]; + SUBGOAL_THEN + `~(interval[a,b] = {}) /\ + ~(interval[a:real^M,(lambda j. if j = i then c else b$j)] = {}) /\ + ~(interval[(lambda j. if j = i then c else a$j):real^M,b] = {})` + MP_TAC THENL + [SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; + ALL_TAC] THEN + SIMP_TAC[content] THEN + SIMP_TAC[INTERVAL_NE_EMPTY; INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `1..dimindex(:M) = i INSERT ((1..dimindex(:M)) DELETE i)` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) THEN + ASM_REWRITE_TAC[IN_NUMSEG]; + ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DELETE] THEN + ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA] THEN + CONJ_TAC THEN MATCH_MP_TAC(REAL_FIELD + `y < x /\ z < w /\ a = b + ==> ((x - y) * a) / (x - y) = ((w - z) * b) / (w - z)`) THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA]]);; + +let BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION = prove + (`!fs f:real^M->real^N a b e. + fs equiintegrable_on interval[a,b] /\ f IN fs /\ + (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) /\ + &0 < e + ==> ?d. gauge d /\ + !c i p h. c IN interval[a,b] /\ 1 <= i /\ i <= dimindex(:M) /\ + p tagged_partial_division_of interval[a,b] /\ + d fine p /\ + h IN fs /\ + (!x k. (x,k) IN p ==> ~(k INTER {x | x$i = c$i} = {})) + ==> sum p(\(x,k). norm(integral k h)) < e`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THENL + [EXISTS_TAC `\x:real^M. ball(x,&1)` THEN REWRITE_TAC[GAUGE_TRIVIAL] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&0 < e ==> x = &0 ==> x < e`)) THEN + MATCH_MP_TAC SUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + GEN_TAC THEN X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?u v:real^M. k = interval[u,v] /\ interval[u,v] SUBSET interval[a,b]` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC INTEGRAL_NULL THEN + ASM_MESON_TAC[CONTENT_0_SUBSET]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN + `?d. gauge d /\ + !p h. p tagged_partial_division_of interval [a,b] /\ + d fine p /\ (h:real^M->real^N) IN fs + ==> sum p (\(x,k). norm(content k % h x - integral k h)) < + e / &2` + (X_CHOOSE_THEN `g0:real^M->real^M->bool` STRIP_ASSUME_TAC) + THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [equiintegrable_on]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC + `e / &5 / (&(dimindex(:N)) + &1)`)) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &5 /\ &0 < &n + &1`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC + [`p:(real^M#(real^M->bool))->bool`; `h:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^M->real^N`; `a:real^M`; `b:real^M`; + `g:real^M->real^M->bool`; `e / &5 / (&(dimindex(:N)) + &1)`] + HENSTOCK_LEMMA_PART2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &5 /\ &0 < &n + &1`] THEN + DISCH_THEN(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `a < b ==> x <= a ==> x < b`) THEN + REWRITE_TAC[REAL_ARITH `&2 * d * e / &5 / (d + &1) = + (e * &2 / &5 * d) / (d + &1)`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ &0 < e * d ==> e * &2 / &5 * d < e / &2 * (d + &1)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; + ALL_TAC] THEN + ABBREV_TAC + `g:real^M->real^M->bool = + \x. g0(x) INTER + ball(x,(e / &8 / (norm(f x:real^N) + &1)) * + inf(IMAGE (\m. b$m - a$m) (1..dimindex(:M))) / + content(interval[a:real^M,b]))` THEN + SUBGOAL_THEN `gauge(g:real^M->real^M->bool)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN MATCH_MP_TAC GAUGE_INTER THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN + X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_ARITH + `&0 < &8 /\ &0 < norm(x:real^N) + &1`] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhand o rand) REAL_LT_INF_FINITE o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FINITE_RESTRICT] THEN + SIMP_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; + GSYM NOT_LE; DIMINDEX_GE_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; IN_NUMSEG] THEN + MESON_TAC[]; + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[REAL_SUB_LT; IN_NUMSEG; GSYM REAL_ABS_NZ; REAL_SUB_0; + IN_ELIM_THM]]; + ALL_TAC] THEN + EXISTS_TAC `g:real^M->real^M->bool` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`c:real^M`; `i:num`; `p:(real^M#(real^M->bool))->bool`; + `h:real^M->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `interval[c:real^M,b] SUBSET interval[a,b]` + ASSUME_TAC THENL + [UNDISCH_TAC `c IN interval[a:real^M,b]` THEN + SIMP_TAC[IN_INTERVAL; SUBSET_INTERVAL; REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `FINITE(p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + MP_TAC(ASSUME `(g:real^M->real^M->bool) fine p`) THEN + EXPAND_TAC "g" THEN REWRITE_TAC[FINE_INTER] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "F")) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN + DISCH_THEN(MP_TAC o SPEC `h:real^M->real^N`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x - y <= e / &2 ==> y < e / &2 ==> x < e`) THEN + ASM_SIMP_TAC[GSYM SUM_SUB] THEN + ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum p (\(x:real^M,k:real^M->bool). norm(content k % h x:real^N))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[NORM_ARITH `norm y - norm(x - y:real^N) <= norm x`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum p (\(x:real^M,k). + e / &4 * (b$i - a$i) / content(interval[a:real^M,b]) * + content(k:real^M->bool) / + (interval_upperbound k$i - interval_lowerbound k$i))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + ASM_CASES_TAC `content(k:real^M->bool) = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; VECTOR_MUL_LZERO; NORM_0; + REAL_MUL_RZERO; REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `a * b * content k / d = content k * (a * b) / d`; + NORM_MUL] THEN + SUBGOAL_THEN `&0 < content(k:real^M->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CONTENT_LT_NZ; tagged_partial_division_of]; ALL_TAC] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LE_LMUL_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `x + &1 <= y ==> x <= y`) THEN + SUBGOAL_THEN `?u v. k = interval[u:real^M,v]` MP_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) THEN + MP_TAC(ISPECL [`u:real^M`; `v:real^M`] CONTENT_POS_LT_EQ) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; REAL_LT_IMP_LE] THEN + DISCH_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_RDIV_EQ o snd) THEN + ASM_SIMP_TAC[REAL_SUB_LT] THEN DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_ARITH `&0 < norm(x:real^N) + &1`] THEN + REMOVE_THEN "F" MP_TAC THEN REWRITE_TAC[fine] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `interval[u:real^M,v]`]) THEN + ASM_REWRITE_TAC[SUBSET] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `v:real^M` th) THEN + MP_TAC(SPEC `u:real^M` th)) THEN + ASM_SIMP_TAC[INTERVAL_NE_EMPTY; REAL_LT_IMP_LE; ENDS_IN_INTERVAL] THEN + REWRITE_TAC[IN_BALL; IMP_IMP] THEN + MATCH_MP_TAC(NORM_ARITH + `abs(vi - ui) <= norm(v - u:real^N) /\ &2 * a <= b + ==> dist(x,u) < a /\ dist(x,v) < a ==> vi - ui <= b`) THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM] THEN + REWRITE_TAC[REAL_ARITH `&2 * e / &8 / x * y = e / &4 * y / x`] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * inv b * inv c:real = (a / c) / b`] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= e ==> x <= e`) THEN + REWRITE_TAC[real_div; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + SIMP_TAC[REAL_INF_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; FINITE_NUMSEG; + NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; REAL_LE_INF_FINITE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_NUMSEG] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_LE_REFL; REAL_SUB_LE; + REAL_LT_IMP_LE] THEN + ASM_MESON_TAC[REAL_LE_REFL]; + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x + &1 <= abs(y + &1)`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[tagged_partial_division_of; SUBSET]]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP TAGGED_PARTIAL_DIVISION_OF_UNION_SELF) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN + DISCH_THEN(fun th -> + W(MP_TAC o PART_MATCH (lhs o rand) th o lhand o snd)) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [SIMP_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[SUM_LMUL; REAL_ARITH + `e / &4 * ba / c * s <= e / &2 <=> e * (ba * s) / c <= e * &2`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC SUM_CONTENT_AREA_OVER_THIN_DIVISION THEN + EXISTS_TAC `UNIONS(IMAGE SND (p:(real^M#(real^M->bool))->bool))` THEN + EXISTS_TAC `(c:real^M)$i` THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_SIMP_TAC[] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC DIVISION_OF_TAGGED_DIVISION THEN + ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + ASM_MESON_TAC[tagged_partial_division_of]; + ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM]]);; + +let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE = prove + (`!fs f:real^M->real^N a b. + fs equiintegrable_on interval[a,b] /\ f IN fs /\ + (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) + ==> { (\x. if x$i <= c then h x else vec 0) | + i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } + equiintegrable_on interval[a,b]`, + let lemma = prove + (`(!x k. (x,k) IN IMAGE (\(x,k). f x k,g x k) s ==> Q x k) <=> + (!x k. (x,k) IN s ==> Q (f x k) (g x k))`, + REWRITE_TAC[IN_IMAGE; PAIR_EQ; EXISTS_PAIR_THM] THEN SET_TAC[]) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN + ASM_SIMP_TAC[EQUIINTEGRABLE_ON_NULL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM CONTENT_LT_NZ]) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[CONTENT_POS_LT_EQ] THEN STRIP_TAC THEN + REWRITE_TAC[equiintegrable_on] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_UNIV; IMP_IMP; GSYM CONJ_ASSOC; RIGHT_IMP_FORALL_THM; + IN_NUMSEG] THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o REWRITE_RULE[equiintegrable_on]) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `x$i <= c <=> x IN {x:real^N | x$i <= c}`] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_INTER] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[INTERVAL_SPLIT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `interval[a:real^M,b]` THEN ASM_SIMP_TAC[] THEN + SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA; REAL_LE_REFL] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + DISCH_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`fs:(real^M->real^N)->bool`; `f:real^M->real^N`; + `a:real^M`; `b:real^M`; `e / &12`] + BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &12`] THEN + DISCH_THEN(X_CHOOSE_THEN `g0:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?d. gauge d /\ + !p h. p tagged_partial_division_of interval [a,b] /\ + d fine p /\ (h:real^M->real^N) IN fs + ==> sum p (\(x,k). norm(content k % h x - integral k h)) < + e / &3` + (X_CHOOSE_THEN `g1:real^M->real^M->bool` STRIP_ASSUME_TAC) + THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[equiintegrable_on]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &7 / (&(dimindex(:N)) + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &7 /\ &0 < &n + &1`] THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:real^M->real^M->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`p:(real^M#(real^M->bool))->bool`; `h:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^M->real^N`; `a:real^M`; `b:real^M`; + `d:real^M->real^M->bool`; `e / &7 / (&(dimindex(:N)) + &1)`] + HENSTOCK_LEMMA_PART2) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &7 /\ &0 < &n + &1`] THEN + DISCH_THEN(MP_TAC o SPEC `p:(real^M#(real^M->bool))->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `a < b ==> x <= a ==> x < b`) THEN + REWRITE_TAC[REAL_ARITH `&2 * d * e / &7 / (d + &1) = + (e * &2 / &7 * d) / (d + &1)`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ &0 < e * d ==> e * &2 / &7 * d < e / &3 * (d + &1)`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; + ALL_TAC] THEN + EXISTS_TAC `\x. (g0:real^M->real^M->bool) x INTER g1 x` THEN + ASM_SIMP_TAC[GAUGE_INTER; FINE_INTER] THEN + X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(MESON[] + `!P. ((!c. (a:real^M)$i <= c /\ c <= (b:real^M)$i ==> P c) ==> (!c. P c)) /\ + (!c. (a:real^M)$i <= c /\ c <= (b:real^M)$i ==> P c) + ==> !c. P c`) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [DISCH_THEN(LABEL_TAC "*") THEN + X_GEN_TAC `c:real` THEN + ASM_CASES_TAC `(a:real^M)$i <= c /\ c <= (b:real^M)$i` THENL + [REMOVE_THEN "*" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `(b:real^M)$i`) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^M->real^N` THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `p:real^M#(real^M->bool)->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH + `x:real^N = vec 0 /\ y = vec 0 /\ &0 < e ==> norm(x - y) < e`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC VSUM_EQ_0 THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + SUBGOAL_THEN `(x:real^M) IN interval[a,b]` MP_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral(interval[a,b]) ((\x. vec 0):real^M->real^N)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[INTEGRAL_0]] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC(NORM_ARITH + `x:real^N = y /\ w = z ==> norm(x - w) < e ==> norm(y - z) < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + SUBGOAL_THEN `(x:real^M) IN interval[a,b]` MP_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + X_GEN_TAC `c:real` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; + `p:(real^M#(real^M->bool))->bool`] THEN STRIP_TAC THEN + ABBREV_TAC + `q:(real^M#(real^M->bool))->bool = + {(x,k) | (x,k) IN p /\ ~(k INTER {x | x$i <= c} = {})}` THEN + MP_TAC(ISPECL + [`\x. if x$i <= c then (h:real^M->real^N) x else vec 0`; + `a:real^M`; `b:real^M`; `p:(real^M#(real^M->bool))->bool`] + INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `FINITE(p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + SUBGOAL_THEN `q SUBSET (p:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [EXPAND_TAC "q" THEN SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; + ALL_TAC] THEN + SUBGOAL_THEN `FINITE(q:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM VSUM_SUB] THEN ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `q tagged_partial_division_of interval[a:real^M,b] /\ + g0 fine q /\ g1 fine q` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET; tagged_division_of; + FINE_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(MESON[] `!q. vsum p s = vsum q s /\ norm(vsum q s) < e + ==> norm(vsum p s:real^N) < e`) THEN + EXISTS_TAC `q:(real^M#(real^M->bool))->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + EXPAND_TAC "q" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:real^M) IN k` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + REWRITE_TAC[IN_INTER; NOT_IN_EMPTY] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_SUB_LZERO] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral k ((\x. vec 0):real^M->real^N)` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[INTEGRAL_0]] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `norm(vsum q (\(x,k). content k % h x - integral k (h:real^M->real^N))) + < e / &3` + MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sum q + (\(x,k). norm(content k % h x - integral k (h:real^M->real^N)))` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC VSUM_NORM_LE THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM; REAL_LE_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x - y:real^N) <= &2 * e / &3 + ==> norm(x) < e / &3 ==> norm(y) < e`) THEN + ASM_SIMP_TAC[GSYM VSUM_SUB] THEN ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN + REWRITE_TAC[] THEN + ABBREV_TAC + `r:(real^M#(real^M->bool))->bool = + {(x,k) | (x,k) IN q /\ ~(k SUBSET {x | x$i <= c})}` THEN + SUBGOAL_THEN `r SUBSET (q:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [EXPAND_TAC "r" THEN SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; + ALL_TAC] THEN + SUBGOAL_THEN `FINITE(r:(real^M#(real^M->bool))->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `r tagged_partial_division_of interval[a:real^M,b] /\ + g0 fine r /\ g1 fine r` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET; FINE_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(MESON[] `!r. vsum q s = vsum r s /\ norm(vsum r s) <= e + ==> norm(vsum q s:real^N) <= e`) THEN + EXISTS_TAC `r:(real^M#(real^M->bool))->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + EXPAND_TAC "r" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:real^M) IN k` ASSUME_TAC THENL + [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH `c - i - (c - j):real^N = j - i`] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN MATCH_MP_TAC INTEGRAL_EQ THEN + ASM SET_TAC[]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[] THEN + MAP_EVERY ABBREV_TAC + [`s:(real^M#(real^M->bool))->bool = + {(x,k) | (x,k) IN r /\ x IN {x | x$i <= c}}`; + `t:(real^M#(real^M->bool))->bool = + {(x,k) | (x,k) IN r /\ ~(x IN {x | x$i <= c})}`] THEN + SUBGOAL_THEN + `(s:(real^M#(real^M->bool))->bool) SUBSET r /\ + (t:(real^M#(real^M->bool))->bool) SUBSET r` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["s"; "t"] THEN + SIMP_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM]; + ALL_TAC] THEN + SUBGOAL_THEN + `FINITE(s:(real^M#(real^M->bool))->bool) /\ + FINITE(t:(real^M#(real^M->bool))->bool)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT (s:(real^M#(real^M->bool))->bool) t` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["s"; "t"] THEN + REWRITE_TAC[EXTENSION; DISJOINT; IN_INTER; FORALL_PAIR_THM; + IN_ELIM_PAIR_THM] THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `r:(real^M#(real^M->bool))->bool = s UNION t` SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["s"; "t"] THEN + REWRITE_TAC[EXTENSION; IN_UNION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_UNION] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum s (\(x:real^M,k). norm + (integral k (h:real^M->real^N) - + integral k (\x. if x$i <= c then h x else vec 0))) + + sum t (\(x:real^M,k). norm + ((content k % (h:real^M->real^N) x - integral k h) + + integral k (\x. if x$i <= c then h x else vec 0)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN + MAP_EVERY EXPAND_TAC ["s"; "t"] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(NORM_ARITH `a:real^N = --b ==> norm a = norm b`) THEN + VECTOR_ARITH_TAC; + AP_TERM_TAC THEN VECTOR_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `s tagged_partial_division_of interval[a:real^M,b] /\ + t tagged_partial_division_of interval[a:real^M,b] /\ + g0 fine s /\ g1 fine s /\ g0 fine t /\ g1 fine t` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_SUBSET; FINE_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `(sum s (\(x:real^M,k). norm(integral k (h:real^M->real^N))) + + sum (IMAGE (\(x,k). (x,k INTER {x | x$i <= c})) s) + (\(x:real^M,k). norm(integral k (h:real^M->real^N)))) + + (sum t (\(x:real^M,k). norm(content k % h x - integral k h)) + + sum t (\(x:real^M,k). norm(integral k (h:real^M->real^N))) + + sum (IMAGE (\(x,k). (x,k INTER {x | x$i >= c})) t) + (\(x:real^M,k). norm(integral k (h:real^M->real^N))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o + rand o rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`] THEN + ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[PAIR_EQ] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`s:real^M#(real^M->bool)->bool`; + `UNIONS(IMAGE SND (s:real^M#(real^M->bool)->bool))`; + `x:real^M`; `k:real^M->bool`; + `y:real^M`; `l:real^M->bool`; `i:num`; `c:real`] + TAGGED_DIVISION_SPLIT_LEFT_INJ) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; ALL_TAC] THEN + REWRITE_TAC[NORM_EQ_0] THEN + SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST1_TAC) + THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTEGRAL_NULL]; + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[o_THM; FORALL_PAIR_THM] THEN + ONCE_REWRITE_TAC[SET_RULE + `x$i <= c <=> x IN {x:real^M | x$i <= c}`] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN + REWRITE_TAC[IN_ELIM_THM; INTER_COMM] THEN + REWRITE_TAC[NORM_ARITH `norm(a - b:real^N) <= norm a + norm b`]]; + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_NONZERO o + rand o rand o rand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`x:real^M`; `k:real^M->bool`; `y:real^M`; `l:real^M->bool`] THEN + ASM_CASES_TAC `x:real^M = y` THEN ASM_REWRITE_TAC[PAIR_EQ] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`t:real^M#(real^M->bool)->bool`; + `UNIONS(IMAGE SND (t:real^M#(real^M->bool)->bool))`; + `x:real^M`; `k:real^M->bool`; + `y:real^M`; `l:real^M->bool`; `i:num`; `c:real`] + TAGGED_DIVISION_SPLIT_RIGHT_INJ) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[TAGGED_PARTIAL_DIVISION_OF_UNION_SELF]; ALL_TAC] THEN + REWRITE_TAC[NORM_EQ_0] THEN + SUBGOAL_THEN `?u v:real^M. l = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST1_TAC) + THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; INTEGRAL_NULL]; + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[o_THM; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `k:real^M->bool`] THEN DISCH_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `i = i1 + i2 + ==> norm(c + i1:real^N) <= norm(c) + norm(i) + norm(i2)`) THEN + ONCE_REWRITE_TAC[SET_RULE + `x$i <= c <=> x IN {x:real^M | x$i <= c}`] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN + ONCE_REWRITE_TAC[SET_RULE `{x | P x} INTER s = s INTER {x | P x}`] THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[tagged_partial_division_of]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MATCH_MP_TAC INTEGRAL_SPLIT THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `interval[a:real^M,b]` THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[tagged_partial_division_of]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^M k. (x,k) IN r ==> ~(k INTER {x:real^M | x$i = c} = {})` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MAP_EVERY EXPAND_TAC ["r"; "q"] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; SUBSET; EXTENSION; NOT_FORALL_THM] THEN + REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY; IN_INTER; NOT_IMP] THEN + DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IVT_COMPONENT THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_TOTAL]] THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + MATCH_MP_TAC CONVEX_CONNECTED THEN REWRITE_TAC[CONVEX_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= e / &6 /\ y <= e / &2 ==> x + y <= &2 * e / &3`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `x < e / &12 /\ y < e / &12 ==> x + y <= e / &6`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(lambda j. if j = i then c else (a:real^M)$j):real^M` THEN + EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LAMBDA_BETA; IN_INTERVAL] THENL + [CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; + EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + ASM_MESON_TAC[]]; + REPEAT CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; + UNDISCH_TAC `s tagged_partial_division_of interval[a:real^M,b]`; + UNDISCH_TAC `(g0:real^M->real^M->bool) fine s` THEN + REWRITE_TAC[fine; FORALL_IN_IMAGE; lemma] THEN SET_TAC[]; + REWRITE_TAC[lemma] THEN + REPEAT GEN_TAC THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC(SET_RULE + `~(k INTER t = {}) /\ t SUBSET s ==> ~((k INTER s) INTER t = {})`) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]]; + MATCH_MP_TAC(REAL_ARITH + `x < e / &3 /\ y < e / &12 /\ z < e / &12 ==> x + y + z <= e / &2`) THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(lambda j. if j = i then c else (a:real^M)$j):real^M` THEN + EXISTS_TAC `i:num` THEN ASM_SIMP_TAC[LAMBDA_BETA; IN_INTERVAL] THENL + [CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; + EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + ASM_MESON_TAC[]]; + REPEAT CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_REFL]; + UNDISCH_TAC `t tagged_partial_division_of interval[a:real^M,b]`; + UNDISCH_TAC `(g0:real^M->real^M->bool) fine t` THEN + REWRITE_TAC[fine; FORALL_IN_IMAGE; lemma] THEN SET_TAC[]; + REWRITE_TAC[lemma] THEN + REPEAT GEN_TAC THEN EXPAND_TAC "t" THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC(SET_RULE + `~(k INTER t = {}) /\ t SUBSET s ==> ~((k INTER s) INTER t = {})`) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL; real_ge] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]]]] THEN + REWRITE_TAC[tagged_partial_division_of] THEN + (MATCH_MP_TAC MONO_AND THEN SIMP_TAC[FINITE_IMAGE] THEN + MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN + REWRITE_TAC[lemma] THEN CONJ_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:real^M->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SIMP_TAC[real_ge; IN_INTER; IN_ELIM_THM] THEN ASM SET_TAC[REAL_LE_TOTAL]; + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [SET_TAC[]; + STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SPLIT] THEN MESON_TAC[]]]; + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[PAIR_EQ; CONTRAPOS_THM] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' + ==> s' INTER t' = {} ==> s INTER t = {}`) THEN CONJ_TAC THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[INTER_SUBSET]]));; + +let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE = prove + (`!fs f:real^M->real^N a b. + fs equiintegrable_on interval[a,b] /\ f IN fs /\ + (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) + ==> { (\x. if x$i >= c then h x else vec 0) | + i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`{\x. (f:real^M->real^N) (--x) | f IN fs}`; + `\x. (f:real^M->real^N)(--x)`; + `--b:real^M`; `--a:real^M`] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE) THEN + ASM_SIMP_TAC[EQUIINTEGRABLE_REFLECT] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[GSYM IN_INTERVAL_REFLECT] THEN + ASM_SIMP_TAC[VECTOR_NEG_NEG] THEN + REWRITE_TAC[SIMPLE_IMAGE; IN_IMAGE] THEN + EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_REFLECT) THEN + REWRITE_TAC[VECTOR_NEG_NEG] THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN + STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC + `(\x. if (--x)$i >= c then (h:real^M->real^N)(--x) else vec 0)` THEN + REWRITE_TAC[VECTOR_NEG_NEG] THEN MAP_EVERY EXISTS_TAC + [`i:num`; `--c:real`; `\x. (h:real^M->real^N)(--x)`] THEN + ASM_REWRITE_TAC[IN_UNIV; VECTOR_NEG_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `--x >= c <=> x <= --c`] THEN + EXISTS_TAC `h:real^M->real^N` THEN ASM_REWRITE_TAC[]]);; + +let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT = prove + (`!fs f:real^M->real^N a b. + fs equiintegrable_on interval[a,b] /\ f IN fs /\ + (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) + ==> { (\x. if x$i < c then h x else vec 0) | + i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`fs:(real^M->real^N)->bool`; `f:real^M->real^N`; + `a:real^M`; `b:real^M`] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE) THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC + `(fs:(real^M->real^N)->bool) equiintegrable_on interval[a,b]` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_SUB) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN + STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `h:real^M->real^N` THEN + EXISTS_TAC `\x. if x$i >= c then (h:real^M->real^N) x else vec 0` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[FUN_EQ_THM; real_ge; GSYM REAL_NOT_LT] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC]);; + +let EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT = prove + (`!fs f:real^M->real^N a b. + fs equiintegrable_on interval[a,b] /\ f IN fs /\ + (!h x. h IN fs /\ x IN interval[a,b] ==> norm(h x) <= norm(f x)) + ==> { (\x. if x$i > c then h x else vec 0) | + i IN 1..dimindex(:M) /\ c IN (:real) /\ h IN fs } + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`fs:(real^M->real^N)->bool`; `f:real^M->real^N`; + `a:real^M`; `b:real^M`] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE) THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC + `(fs:(real^M->real^N)->bool) equiintegrable_on interval[a,b]` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_SUB) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN + STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `h:real^M->real^N` THEN + EXISTS_TAC `\x. if x$i <= c then (h:real^M->real^N) x else vec 0` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`i:num`; `c:real`; `h:real^M->real^N`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[FUN_EQ_THM; real_gt; GSYM REAL_NOT_LE] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC]);; + +let EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> { (\x. if x IN interval(c,d) then f x else vec 0) | + c IN (:real^M) /\ d IN (:real^M) } + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. n <= dimindex(:M) + ==> f INSERT + { (\x. if !i. 1 <= i /\ i <= n ==> c$i < x$i /\ x$i < d$i + then (f:real^M->real^N) x else vec 0) | + c IN (:real^M) /\ d IN (:real^M) } + equiintegrable_on interval[a,b]` + MP_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN + ASM_REWRITE_TAC[ETA_AX; EQUIINTEGRABLE_ON_SING; SET_RULE + `f INSERT {f |c,d| c IN UNIV /\ d IN UNIV} = {f}`] THEN + X_GEN_TAC `n:num` THEN ASM_CASES_TAC `SUC n <= dimindex(:M)` THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT)) THEN + REWRITE_TAC[IN_INSERT] THEN ANTS_TAC THENL + [REWRITE_TAC[TAUT + `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN + SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN + DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT)) THEN + ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN ANTS_TAC THENL + [REWRITE_TAC[TAUT + `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN + SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC; LEFT_OR_DISTRIB] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; + FORALL_AND_THM] THEN + SIMP_TAC[IN_UNIV] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]); + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> (x INSERT s) SUBSET ({x} UNION t)`) THEN + REWRITE_TAC[SUBSET; real_gt; FORALL_IN_GSPEC; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + EXISTS_TAC `(c:real^M)$(SUC n)` THEN + MATCH_MP_TAC(MESON[] + `(?i c k. P i c k /\ Q (g i c k)) + ==> ?h. (h = f \/ ?i c k. P i c k /\ h = g i c k) /\ Q h`) THEN + EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + EXISTS_TAC `(d:real^M)$(SUC n)` THEN + EXISTS_TAC + `\x. if !i. 1 <= i /\ i <= n ==> (c:real^M)$i < x$i /\ x$i < (d:real^M)$i + then (f:real^M->real^N) x else vec 0` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [DISJ2_TAC THEN + MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[]; + REWRITE_TAC[FUN_EQ_THM; LE] THEN + ASM_MESON_TAC[ARITH_RULE `1 <= SUC n`]]; + DISCH_THEN(MP_TAC o SPEC `dimindex(:M)`) THEN + REWRITE_TAC[IN_INTERVAL; LE_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + SET_TAC[]]);; + +let EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> { (\x. if x IN interval[c,d] then f x else vec 0) | + c IN (:real^M) /\ d IN (:real^M) } + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. n <= dimindex(:M) + ==> f INSERT + { (\x. if !i. 1 <= i /\ i <= n ==> c$i <= x$i /\ x$i <= d$i + then (f:real^M->real^N) x else vec 0) | + c IN (:real^M) /\ d IN (:real^M) } + equiintegrable_on interval[a,b]` + MP_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN + ASM_REWRITE_TAC[ETA_AX; EQUIINTEGRABLE_ON_SING; SET_RULE + `f INSERT {f |c,d| c IN UNIV /\ d IN UNIV} = {f}`] THEN + X_GEN_TAC `n:num` THEN ASM_CASES_TAC `SUC n <= dimindex(:M)` THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE)) THEN + REWRITE_TAC[IN_INSERT] THEN ANTS_TAC THENL + [REWRITE_TAC[TAUT + `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN + SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN + DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE)) THEN + ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN ANTS_TAC THENL + [REWRITE_TAC[TAUT + `a \/ b ==> c ==> d <=> (a ==> c ==> d) /\ (b ==> c ==> d)`] THEN + SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC; LEFT_OR_DISTRIB] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[REAL_LE_REFL; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC; + FORALL_AND_THM] THEN + SIMP_TAC[IN_UNIV] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]); + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> (x INSERT s) SUBSET ({x} UNION t)`) THEN + REWRITE_TAC[SUBSET; real_ge; FORALL_IN_GSPEC; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + EXISTS_TAC `(c:real^M)$(SUC n)` THEN + MATCH_MP_TAC(MESON[] + `(?i c k. P i c k /\ Q (g i c k)) + ==> ?h. (h = f \/ ?i c k. P i c k /\ h = g i c k) /\ Q h`) THEN + EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[IN_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + EXISTS_TAC `(d:real^M)$(SUC n)` THEN + EXISTS_TAC + `\x. if !i. 1 <= i /\ i <= n ==> (c:real^M)$i <= x$i /\ x$i <= (d:real^M)$i + then (f:real^M->real^N) x else vec 0` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [DISJ2_TAC THEN + MAP_EVERY EXISTS_TAC [`c:real^M`; `d:real^M`] THEN REWRITE_TAC[]; + REWRITE_TAC[FUN_EQ_THM; LE] THEN + ASM_MESON_TAC[ARITH_RULE `1 <= SUC n`]]; + DISCH_THEN(MP_TAC o SPEC `dimindex(:M)`) THEN + REWRITE_TAC[IN_INTERVAL; LE_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of the indefinite integral. *) +(* ------------------------------------------------------------------------- *) + +let INDEFINITE_INTEGRAL_CONTINUOUS = prove + (`!f:real^M->real^N a b c d e. + f integrable_on interval[a,b] /\ + c IN interval[a,b] /\ d IN interval[a,b] /\ &0 < e + ==> ?k. &0 < k /\ + !c' d'. c' IN interval[a,b] /\ + d' IN interval[a,b] /\ + norm(c' - c) <= k /\ norm(d' - d) <= k + ==> norm(integral(interval[c',d']) f - + integral(interval[c,d]) f) < e`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[] `(?k. P k /\ Q k) <=> ~(!k. P k ==> ~Q k)`] THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + PURE_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; SKOLEM_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT; GSYM CONJ_ASSOC] THEN + MAP_EVERY X_GEN_TAC [`u:num->real^M`; `v:num->real^M`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + ABBREV_TAC + `k:real^M->bool = + UNIONS (IMAGE (\i. {x | x$i = (c:real^M)$i} UNION {x | x$i = (d:real^M)$i}) + (1..dimindex(:M)))` THEN + SUBGOAL_THEN `negligible(k:real^M->bool)` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ASM_SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_STANDARD_HYPERPLANE]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n:num x. if x IN interval[u n,v n] then + if x IN k then vec 0 else (f:real^M->real^N) x + else vec 0`; + `\x. if x IN interval[c,d] then + if x IN k then vec 0 else (f:real^M->real^N) x + else vec 0`; + `a:real^M`; `b:real^M`] EQUIINTEGRABLE_LIMIT) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\x. if x IN k then vec 0 else (f:real^M->real^N) x) + integrable_on interval[a,b]` + MP_TAC THENL + [UNDISCH_TAC `(f:real^M->real^N) integrable_on interval[a,b]` THEN + MATCH_MP_TAC INTEGRABLE_SPIKE THEN EXISTS_TAC `k:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP + EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `n:num` THEN MAP_EVERY EXISTS_TAC + [`(u:num->real^M) n`; `(v:num->real^M) n`] THEN + REWRITE_TAC[]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^M) IN k` THEN + ASM_REWRITE_TAC[COND_ID; LIM_CONST] THEN MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `inf (IMAGE (\i. min (abs((x:real^M)$i - (c:real^M)$i)) + (abs((x:real^M)$i - (d:real^M)$i))) + (1..dimindex(:M)))` REAL_ARCH_INV) THEN + SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; + FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; IN_NUMSEG] THEN + UNDISCH_TAC `~((x:real^M) IN k)` THEN EXPAND_TAC "k" THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[IN_NUMSEG; SET_RULE + `~(p /\ x IN (s UNION t)) <=> p ==> ~(x IN s) /\ ~(x IN t)`] THEN + REWRITE_TAC[IN_ELIM_THM; REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x IN interval[(u:num->real^M) n,v n] <=> x IN interval[c,d]` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[IN_INTERVAL] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `!N n. abs(u - c) <= n /\ abs(v - d) <= n /\ + N < abs(x - c) /\ N < abs(x - d) /\ n <= N + ==> (u <= x /\ x <= v <=> c <= x /\ x <= d)`) THEN + MAP_EVERY EXISTS_TAC [`inv(&N)`; `inv(&n + &1)`] THEN + ASM_SIMP_TAC[] THEN REPEAT (CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; VECTOR_SUB_COMPONENT]; + ALL_TAC]) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN + SUBGOAL_THEN + `interval[c:real^M,d] INTER interval[a,b] = interval[c,d] /\ + !n:num. interval[u n,v n] INTER interval[a,b] = interval[u n,v n]` + (fun th -> SIMP_TAC[th]) + THENL + [REWRITE_TAC[SET_RULE `s INTER t = s <=> s SUBSET t`] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[LE_REFL; REAL_NOT_LT] THEN + FIRST_ASSUM(fun th -> MP_TAC(SPEC `N:num` th) THEN MATCH_MP_TAC + (NORM_ARITH `x = a /\ y = b ==> e <= norm(x - y) ==> e <= dist(a,b)`)) THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_SIMP_TAC[IN_DIFF]]);; + +let INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> (\x. integral (interval[a,x]) f) continuous_on interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[continuous_within] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; + `a:real^M`; `x:real^M`; `e:real`] + INDEFINITE_INTEGRAL_CONTINUOUS) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[dist]] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[ENDS_IN_INTERVAL; VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN + ASM SET_TAC[]);; + +let INDEFINITE_INTEGRAL_CONTINUOUS_LEFT = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> (\x. integral(interval[x,b]) f) continuous_on interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[continuous_within] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a:real^M`; `b:real^M`; + `x:real^M`; `b:real^M`; `e:real`] + INDEFINITE_INTEGRAL_CONTINUOUS) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[dist]] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[ENDS_IN_INTERVAL; VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN + ASM SET_TAC[]);; + +let INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> (\y. integral (interval[fstcart y,sndcart y]) f) + uniformly_continuous_on interval[pastecart a a,pastecart b b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COMPACT_UNIFORMLY_CONTINUOUS THEN + REWRITE_TAC[COMPACT_INTERVAL; continuous_on] THEN + REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; PCROSS] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `d:real^M`] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `a:real^M`; `b:real^M`; `c:real^M`; `d:real^M`; + `e:real`] INDEFINITE_INTEGRAL_CONTINUOUS) THEN + ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[PASTECART_SUB] THEN + ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LT_IMP_LE; REAL_LE_TRANS]);; + +let INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT = prove + (`!f:real^M->real^N a b e. + f integrable_on interval[a,b] /\ &0 < e + ==> ?k. &0 < k /\ + !c d c' d'. c IN interval[a,b] /\ d IN interval[a,b] /\ + c' IN interval[a,b] /\ d' IN interval[a,b] /\ + norm (c' - c) <= k /\ norm (d' - d) <= k + ==> norm(integral(interval[c',d']) f - + integral(interval[c,d]) f) < e`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `a:real^M`; `b:real^M`] + INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS) THEN + ASM_REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real^M`; `c':real^M`; `d:real^M`; `d':real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`pastecart (c:real^M) (c':real^M)`; + `pastecart (d:real^M) (d':real^M)`]) THEN + REWRITE_TAC[GSYM PCROSS_INTERVAL; PCROSS] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[NORM_PASTECART_LE; REAL_LET_TRANS; + REAL_ARITH `&0 < k /\ x <= k / &3 /\ y <= k / &3 ==> x + y < k`]);; + +let BOUNDED_INTEGRALS_OVER_SUBINTERVALS = prove + (`!f:real^M->real^N a b. + f integrable_on interval[a,b] + ==> bounded { integral (interval[c,d]) f | + interval[c,d] SUBSET interval[a,b]}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP + INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE)) THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL; IS_INTERVAL_INTERVAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN + ASM_SIMP_TAC[INTEGRAL_EMPTY; NORM_0; REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Substitution. *) +(* ------------------------------------------------------------------------- *) + +let HAS_INTEGRAL_SUBSTITUTION_STRONG = prove + (`!f:real^1->real^N g g' a b c d k. + COUNTABLE k /\ + f integrable_on interval[c,d] /\ + g continuous_on interval[a,b] /\ + IMAGE g (interval[a,b]) SUBSET interval[c,d] /\ + (!x. x IN interval[a,b] DIFF k + ==> (g has_vector_derivative g'(x)) + (at x within interval[a,b]) /\ + f continuous + (at(g x)) within interval[c,d]) /\ + drop a <= drop b /\ drop c <= drop d /\ drop(g a) <= drop(g b) + ==> ((\x. drop(g' x) % f(g x)) has_integral + integral (interval[g a,g b]) f) (interval[a,b])`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `ff = \x. integral (interval[c,x]) (f:real^1->real^N)` THEN + MP_TAC(ISPECL + [`(ff:real^1->real^N) o (g:real^1->real^1)`; + `\x:real^1. drop(g' x) % (f:real^1->real^N)(g x)`; + + `k:real^1->bool`; `a:real^1`; `b:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[c:real^1,d]` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "ff" THEN + MATCH_MP_TAC INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + INTERVAL_OPEN_SUBSET_CLOSED)) THEN + SUBGOAL_THEN `(ff o g has_vector_derivative + drop(g' x) % (f:real^1->real^N)(g x)) + (at x within interval[a,b])` + MP_TAC THENL + [MATCH_MP_TAC VECTOR_DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[IN_DIFF] THEN + MP_TAC(ISPECL [`f:real^1->real^N`; `c:real^1`; `d:real^1`; + `(g:real^1->real^1) x`] + INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE) THEN + ASM_SIMP_TAC[CONTINUOUS_AT_WITHIN; IN_DIFF] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET]; + REWRITE_TAC[has_vector_derivative; has_derivative] THEN + ASM_SIMP_TAC[LIM_WITHIN_INTERIOR; INTERIOR_INTERVAL; + NETLIMIT_WITHIN_INTERIOR; NETLIMIT_AT]]]; + EXPAND_TAC "ff" THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(VECTOR_ARITH + `z + w:real^N = y ==> y - z = w`) THEN + MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + INTEGRABLE_SUBINTERVAL))] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL_1; SUBSET] THEN + ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]]);; + +(* ------------------------------------------------------------------------- *) +(* Second mean value theorem and corollaries. *) +(* ------------------------------------------------------------------------- *) + +let SECOND_MEAN_VALUE_THEOREM_FULL = prove + (`!f:real^1->real^1 g a b. + ~(interval[a,b] = {}) /\ + f integrable_on interval [a,b] /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g x <= g y) + ==> ?c. c IN interval [a,b] /\ + ((\x. g x % f x) has_integral + (g(a) % integral (interval[a,c]) f + + g(b) % integral (interval[c,b]) f)) (interval[a,b])`, + let lemma1 = prove + (`!f:real->real s. + (!x. x IN s ==> &0 <= f x /\ f x <= &1) + ==> (!n x. x IN s /\ ~(n = 0) + ==> abs(f x - + sum(1..n) (\k. if &k / &n <= f(x) + then inv(&n) else &0)) < inv(&n))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?m. floor(&n * (f:real->real) x) = &m` CHOOSE_TAC THENL + [MATCH_MP_TAC FLOOR_POS THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN `!k. &k / &n <= (f:real->real) x <=> k <= m` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + SIMP_TAC[REAL_LE_FLOOR; INTEGER_CLOSED; REAL_MUL_SYM]; + ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n + 1`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; real_div; REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `y <= &1 /\ &0 < i ==> ~(&1 + i <= y)`; + REAL_LT_INV_EQ; REAL_OF_NUM_LT; LE_1; NOT_LE] THEN + SIMP_TAC[IN_NUMSEG; ARITH_RULE + `m < n + 1 ==> ((1 <= k /\ k <= n) /\ k <= m <=> 1 <= k /\ k <= m)`] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM numseg; SUM_CONST_NUMSEG; ADD_SUB] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&n)` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ABS_NUM; REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1; REAL_SUB_LDISTRIB; GSYM real_div] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `f <= x /\ x < f + &1 ==> abs(x - f) < &1`) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[FLOOR]) in + let lemma2 = prove + (`!f:real^1->real^N g a b. + f integrable_on interval[a,b] /\ + (!x y. drop x <= drop y ==> g(x) <= g(y)) + ==> {(\x. if c <= g(x) then f x else vec 0) | c IN (:real)} + equiintegrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM EQUIINTEGRABLE_ON_SING]) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `f:real^1->real^N` (MATCH_MP (REWRITE_RULE[IMP_CONJ] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE) th)) THEN + MP_TAC(SPEC `f:real^1->real^N` (MATCH_MP (REWRITE_RULE[IMP_CONJ] + EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT) th)) THEN + MP_TAC th) THEN + SIMP_TAC[IN_SING; REAL_LE_REFL] THEN + SUBGOAL_THEN `{(\x. vec 0):real^1->real^N} equiintegrable_on interval[a,b]` + MP_TAC THENL + [REWRITE_TAC[EQUIINTEGRABLE_ON_SING; INTEGRABLE_CONST]; ALL_TAC] THEN + REPEAT(ONCE_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP EQUIINTEGRABLE_UNION)) THEN + REWRITE_TAC[NUMSEG_SING; DIMINDEX_1; IN_SING] THEN + REWRITE_TAC[SET_RULE `{m i c h | i = 1 /\ c IN (:real) /\ h = f} = + {m 1 c f | c IN (:real)}`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN + X_GEN_TAC `y:real` THEN + ASM_CASES_TAC `!x. y <= (g:real^1->real) x` THENL + [ASM_REWRITE_TAC[ETA_AX; IN_UNION; IN_SING]; ALL_TAC] THEN + ASM_CASES_TAC `!x. ~(y <= (g:real^1->real) x)` THENL + [ASM_REWRITE_TAC[ETA_AX; IN_UNION; IN_SING]; ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE drop {x | y <= (g:real^1->real) x}` INF) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; IMAGE_EQ_EMPTY] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]; + STRIP_TAC THEN REWRITE_TAC[real_gt; real_ge]] THEN + REWRITE_TAC[IN_UNION; GSYM DISJ_ASSOC] THEN + ASM_CASES_TAC `y <= g(lift(inf(IMAGE drop {x | y <= g x})))` THENL + [REPEAT DISJ2_TAC; REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `inf(IMAGE drop {x | y <= g x})` THEN + REWRITE_TAC[FUN_EQ_THM] THEN + MATCH_MP_TAC(MESON[] + `(!x. P x <=> Q x) + ==> !x. (if P x then f x else b) = (if Q x then f x else b)`) THEN + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[GSYM REAL_NOT_LE; GSYM drop] THEN + ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LT_ANTISYM; REAL_LE_TRANS; LIFT_DROP]) in + let lemma3 = prove + (`!f:real^1->real^N g a b. + f integrable_on interval[a,b] /\ + (!x y. drop x <= drop y ==> g(x) <= g(y)) + ==> {(\x. vsum (1..n) + (\k. if &k / &n <= g x then inv(&n) % f(x) else vec 0)) | + ~(n = 0)} + equiintegrable_on interval[a,b]`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o + MATCH_MP lemma2) THEN + DISCH_THEN(MP_TAC o MATCH_MP + (INST_TYPE [`:num`,`:A`] EQUIINTEGRABLE_SUM)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] EQUIINTEGRABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`1..n`; `\k:num. inv(&n)`; + `\k x. if &k / &n <= g x then (f:real^1->real^N) x else vec 0`] THEN + ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[FINITE_NUMSEG; COND_RAND; COND_RATOR; VECTOR_MUL_RZERO] THEN + X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG; REAL_LE_INV_EQ; REAL_POS] THEN STRIP_TAC THEN + EXISTS_TAC `&k / &n` THEN REWRITE_TAC[]) in + let lemma4 = prove + (`!f:real^1->real^1 g a b. + ~(interval[a,b] = {}) /\ + f integrable_on interval[a,b] /\ + (!x y. drop x <= drop y ==> g(x) <= g(y)) /\ + (!x. x IN interval[a,b] ==> &0 <= g x /\ g x <= &1) + ==> (\x. g(x) % f(x)) integrable_on interval[a,b] /\ + ?c. c IN interval[a,b] /\ + integral (interval[a,b]) (\x. g(x) % f(x)) = + integral (interval[c,b]) f`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `?m M. IMAGE (\x. integral (interval[x,b]) (f:real^1->real^1)) + (interval[a,b]) = interval[m,M]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN + ASM_SIMP_TAC[INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; CONVEX_CONNECTED; + CONVEX_INTERVAL; COMPACT_INTERVAL]; + ALL_TAC] THEN + MP_TAC(ISPECL[`f:real^1->real^1`; `g:real^1->real`; `a:real^1`; `b:real^1`] + lemma3) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n. ?c. c IN interval[a,b] /\ + integral (interval[c,b]) (f:real^1->real^1) = + integral (interval[a,b]) + (\x. vsum (1..n) + (\k. if &k / &n <= g x then inv(&n) % f x else vec 0))` + MP_TAC THENL + [X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG; ARITH_EQ; INTEGRAL_0] THEN + EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `g:real^1->real`; + `a:real^1`; `b:real^1`] lemma2) THEN + ASM_REWRITE_TAC[equiintegrable_on; FORALL_IN_GSPEC; IN_UNIV] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN + REWRITE_TAC[MESON[VECTOR_MUL_RZERO] + `(if p then a % x else vec 0:real^1) = + a % (if p then x else vec 0)`] THEN + ASM_SIMP_TAC[VSUM_LMUL; INTEGRAL_CMUL; INTEGRABLE_VSUM; ETA_AX; + FINITE_NUMSEG; INTEGRAL_VSUM] THEN + SUBGOAL_THEN + `!y:real. ?d:real^1. + d IN interval[a,b] /\ + integral (interval[a,b]) (\x. if y <= g x then f x else vec 0) = + integral (interval[d,b]) (f:real^1->real^1)` + MP_TAC THENL + [X_GEN_TAC `y:real` THEN + SUBGOAL_THEN + `{x | y <= g x} = {} \/ + {x | y <= g x} = (:real^1) \/ + (?a. {x | y <= g x} = {x | a <= drop x}) \/ + (?a. {x | y <= g x} = {x | a < drop x})` + MP_TAC THENL + [MATCH_MP_TAC(TAUT `(~a /\ ~b ==> c \/ d) ==> a \/ b \/ c \/ d`) THEN + DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE drop {x | y <= (g:real^1->real) x}` INF) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; IMAGE_EQ_EMPTY] THEN + ANTS_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]; + STRIP_TAC] THEN + ASM_CASES_TAC `y <= g(lift(inf(IMAGE drop {x | y <= g x})))` THENL + [DISJ1_TAC; DISJ2_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + EXISTS_TAC `inf(IMAGE drop {x | y <= g x})` THEN + REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[GSYM REAL_NOT_LE; GSYM drop] THEN + ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LT_ANTISYM; + REAL_LE_TRANS; LIFT_DROP]; + REWRITE_TAC[EXTENSION; IN_UNIV; NOT_IN_EMPTY; IN_ELIM_THM] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL + [EXISTS_TAC `b:real^1` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTEGRAL_0]; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC MP_TAC) THENL + [EXISTS_TAC `a:real^1` THEN + ASM_REWRITE_TAC[ETA_AX; ENDS_IN_INTERVAL]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [OR_EXISTS_THM] THEN + REWRITE_TAC[EXISTS_DROP] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^1` ASSUME_TAC) THEN + ASM_CASES_TAC `drop d < drop a` THENL + [EXISTS_TAC `a:real^1` THEN + ASM_REWRITE_TAC[ETA_AX; ENDS_IN_INTERVAL] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN + REWRITE_TAC[IN_DIFF; IN_INTERVAL_1; NOT_IN_EMPTY] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(y <= (g:real^1->real) x)` THEN + FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `drop b < drop d` THENL + [EXISTS_TAC `b:real^1` THEN + SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTEGRAL_0] THEN + MATCH_MP_TAC INTEGRAL_EQ_0 THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `y <= (g:real^1->real) x` THEN + FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `d:real^1` THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[SET_RULE + `~((g:real^1->real) x < y) <=> x IN {x | ~(g x < y)}`] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN + MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{d:real^1}` THEN + REWRITE_TAC[NEGLIGIBLE_SING; REAL_NOT_LT; SUBSET] THEN GEN_TAC THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_INTER; IN_DIFF; IN_INTERVAL_1; + IN_ELIM_THM; IN_SING; GSYM DROP_EQ] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o GEN `k:num` o SPEC `&k / &n`) THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:num->real^1` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `IMAGE f s = t ==> !y. y IN t ==> ?x. x IN s /\ f x = y`)) THEN + REWRITE_TAC[GSYM VSUM_LMUL] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[CONVEX_INDEXED] + (CONJUNCT1(SPEC_ALL CONVEX_INTERVAL))) THEN + REWRITE_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_LE_INV_EQ; REAL_POS] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN ASM SET_TAC[]]; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `c:num->real^1` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN + SUBGOAL_THEN `compact(interval[a:real^1,b])` MP_TAC THENL + [REWRITE_TAC[COMPACT_INTERVAL]; REWRITE_TAC[compact]] THEN + DISCH_THEN(MP_TAC o SPEC `c:num->real^1`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`d:real^1`; `s:num->num`] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\n:num x. vsum (1..(s n)) + (\k. if &k / &(s n) <= g x + then inv(&(s n)) % (f:real^1->real^1) x + else vec 0)`; + `\x. g x % (f:real^1->real^1) x`; `a:real^1`; `b:real^1`] + EQUIINTEGRABLE_LIMIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC EQUIINTEGRABLE_SUBSET THEN + EXISTS_TAC + `{\x. vsum(1..0) (\k. if &k / &0 <= g x + then inv(&0) % (f:real^1->real^1) x else vec 0)} + UNION + {\x. vsum (1..n) + (\k. if &k / &n <= g x then inv (&n) % f x else vec 0) + | ~(n = 0)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQUIINTEGRABLE_UNION THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EQUIINTEGRABLE_ON_SING; VSUM_CLAUSES_NUMSEG; + ARITH_EQ] THEN + REWRITE_TAC[INTEGRABLE_0]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV; IN_UNION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `n:num` THEN ASM_CASES_TAC `(s:num->num) n = 0` THEN + ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN + EXISTS_TAC `(s:num->num) n` THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[MESON[VECTOR_MUL_LZERO] + `(if p then a % x else vec 0) = (if p then a else &0) % x`] THEN + REWRITE_TAC[VSUM_RMUL] THEN MATCH_MP_TAC LIM_VMUL THEN + REWRITE_TAC[LIM_SEQUENTIALLY; o_DEF; DIST_LIFT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n)` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL + [`(g:real^1->real) o lift`; `IMAGE drop (interval[a,b])`] + lemma1) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; IMP_CONJ; + RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `inv(&((s:num->num) n))` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT]] THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP MONOTONE_BIGGER) THEN + ASM_ARITH_TAC; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `d:real^1` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n. integral (interval [c((s:num->num) n),b]) + (f:real^1->real^1)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] + INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `d:real^1`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `(c:num->real^1) o (s:num->num)`) THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_DEF]]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(g:real^1->real) a <= g b` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + ASM_MESON_TAC[INTERVAL_EQ_EMPTY_1; REAL_LET_TOTAL]; + ALL_TAC] THEN + REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THENL + [ALL_TAC; + SUBGOAL_THEN + `!x. x IN interval[a,b] ==> g(x) % (f:real^1->real^1)(x) = g(a) % f x` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE + [IN_INTERVAL_1; INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TRANS; REAL_LE_TOTAL]; + ALL_TAC] THEN + EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + MATCH_MP_TAC HAS_INTEGRAL_EQ THEN + EXISTS_TAC `\x. g(a:real^1) % (f:real^1->real^1) x` THEN + ASM_SIMP_TAC[INTEGRAL_NULL; CONTENT_EQ_0_1; REAL_LE_REFL] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]] THEN + MP_TAC(ISPECL + [`f:real^1->real^1`; + `\x. if drop x < drop a then &0 + else if drop b < drop x then &1 + else (g(x) - g(a)) / (g(b) - g(a))`; + `a:real^1`; `b:real^1`] + lemma4) THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [CONJ_TAC THEN + REPEAT GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL]) THEN + TRY ASM_REAL_ARITH_TAC THEN + ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LE_DIV2_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_SUB_LE; + REAL_ARITH `x - a <= y - a <=> x <= y`] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + DISCH_THEN(MP_TAC o SPEC `(g:real^1->real) b - g a` o + MATCH_MP HAS_INTEGRAL_CMUL) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPEC `(g:real^1->real)(a)` o + MATCH_MP HAS_INTEGRAL_CMUL) THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] + INTEGRAL_COMBINE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_ARITH + `ga % (i1 + i2) + (gb - ga) % i2:real^N = ga % i1 + gb % i2`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM REAL_NOT_LE; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN + VECTOR_ARITH_TAC);; + +let SECOND_MEAN_VALUE_THEOREM = prove + (`!f:real^1->real^1 g a b. + ~(interval[a,b] = {}) /\ + f integrable_on interval [a,b] /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g x <= g y) + ==> ?c. c IN interval [a,b] /\ + integral (interval[a,b]) (\x. g x % f x) = + g(a) % integral (interval[a,c]) f + + g(b) % integral (interval[c,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_FULL) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; + +let SECOND_MEAN_VALUE_THEOREM_GEN_FULL = prove + (`!f:real^1->real^1 g a b u v. + ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ + (!x. x IN interval(a,b) ==> u <= g x /\ g x <= v) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g x <= g y) + ==> ?c. c IN interval [a,b] /\ + ((\x. g x % f x) has_integral + (u % integral (interval[a,c]) f + + v % integral (interval[c,b]) f)) (interval[a,b])`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `b:real^1 = a` THENL + [EXISTS_TAC `a:real^1` THEN ASM_REWRITE_TAC[INTERVAL_SING; IN_SING] THEN + ASM_SIMP_TAC[GSYM INTERVAL_SING; INTEGRAL_NULL; CONTENT_EQ_0_1; + VECTOR_ADD_LID; REAL_LE_REFL; VECTOR_MUL_RZERO; HAS_INTEGRAL_NULL]; + ALL_TAC] THEN + SUBGOAL_THEN `drop a < drop b` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LE; DROP_EQ; REAL_LT_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `u <= v` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERVAL_EQ_EMPTY_1; MEMBER_NOT_EMPTY; REAL_NOT_LT; + REAL_LE_TRANS]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real^1->real^1`; + `\x:real^1. if x = a then u else if x = b then v else g x:real`; + `a:real^1`; `b:real^1`] SECOND_MEAN_VALUE_THEOREM_FULL) THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + ASM_CASES_TAC `x:real^1 = a` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[REAL_LE_REFL; INTERVAL_CASES_1]; ALL_TAC] THEN + ASM_CASES_TAC `y:real^1 = b` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[REAL_LE_REFL; INTERVAL_CASES_1]; ALL_TAC] THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM DROP_EQ]) THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC + (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE) THEN + EXISTS_TAC `{a:real^1,b}` THEN + SIMP_TAC[NEGLIGIBLE_EMPTY; NEGLIGIBLE_INSERT; IN_DIFF; IN_INSERT; + NOT_IN_EMPTY; DE_MORGAN_THM]]);; + +let SECOND_MEAN_VALUE_THEOREM_GEN = prove + (`!f:real^1->real^1 g a b u v. + ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ + (!x. x IN interval(a,b) ==> u <= g x /\ g x <= v) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g x <= g y) + ==> ?c. c IN interval [a,b] /\ + integral (interval[a,b]) (\x. g x % f x) = + u % integral (interval[a,c]) f + + v % integral (interval[c,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; + +let SECOND_MEAN_VALUE_THEOREM_BONNET_FULL = prove + (`!f:real^1->real^1 g a b. + ~(interval[a,b] = {}) /\ f integrable_on interval [a,b] /\ + (!x. x IN interval[a,b] ==> &0 <= g x) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g x <= g y) + ==> ?c. c IN interval [a,b] /\ + ((\x. g x % f x) has_integral + (g(b) % integral (interval[c,b]) f)) (interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real^1->real^1`; `g:real^1->real`; `a:real^1`; `b:real^1`; + `&0`; `(g:real^1->real) b`] SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; + +let SECOND_MEAN_VALUE_THEOREM_BONNET = prove + (`!f:real^1->real^1 g a b. + ~(interval[a,b] = {}) /\ f integrable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> &0 <= g x) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g x <= g y) + ==> ?c. c IN interval [a,b] /\ + integral (interval[a,b]) (\x. g x % f x) = + g(b) % integral (interval[c,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REWRITE_TAC[]);; + +let INTEGRABLE_INCREASING_PRODUCT = prove + (`!f:real^1->real^N g a b. + f integrable_on interval[a,b] /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g(x) <= g(y)) + ==> (\x. g(x) % f(x)) integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN + ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN + ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\x. lift((f:real^1->real^N) x$i)`; + `g:real^1->real`; `a:real^1`; `b:real^1`] + SECOND_MEAN_VALUE_THEOREM_FULL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL; integrable_on] THEN + MESON_TAC[]]);; + +let INTEGRABLE_INCREASING_PRODUCT_UNIV = prove + (`!f:real^1->real^N g B. + f integrable_on (:real^1) /\ + (!x y. drop x <= drop y ==> g x <= g y) /\ + (!x. abs(g x) <= B) + ==> (\x. g x % f x) integrable_on (:real^1)`, + let lemma = prove + (`!f:real^1->real^1 g B. + f integrable_on (:real^1) /\ + (!x y. drop x <= drop y ==> g x <= g y) /\ + (!x. abs(g x) <= B) + ==> (\x. g x % f x) integrable_on (:real^1)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_ALT_SUBSET] THEN + REWRITE_TAC[IN_UNIV; ETA_AX] THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN + ASM_SIMP_TAC[]; + DISCH_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (&8 * abs B + &8)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &8 * abs B + &8`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `C:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(ball(vec 0:real^1,C) = {})` ASSUME_TAC THENL + [ASM_REWRITE_TAC[BALL_EQ_EMPTY; REAL_NOT_LE]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN + STRIP_TAC THEN SUBGOAL_THEN + `~(interval[a:real^1,b] = {}) /\ ~(interval[c:real^1,d] = {})` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL_1]) THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\x. g x % (f:real^1->real^1) x`; + `c:real^1`; `b:real^1`; `a:real^1`] INTEGRAL_COMBINE) THEN + MP_TAC(ISPECL [`\x. g x % (f:real^1->real^1) x`; + `c:real^1`; `d:real^1`; `b:real^1`] INTEGRAL_COMBINE) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_NOT_LE; NORM_ARITH + `norm(ab - ((ca + ab) + bd):real^1) = norm(ca + bd)`] THEN + MP_TAC(ISPECL[`f:real^1->real^1`; `g:real^1->real`; `c:real^1`; `a:real^1`] + SECOND_MEAN_VALUE_THEOREM) THEN + ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL[`f:real^1->real^1`; `g:real^1->real`; `b:real^1`; `d:real^1`] + SECOND_MEAN_VALUE_THEOREM) THEN + ASM_SIMP_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^1` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x y. drop y <= drop a + ==> norm(integral (interval[x,y]) (f:real^1->real^1)) + < e / (&4 * abs B + &4)` + (LABEL_TAC "L") + THENL + [REPEAT STRIP_TAC THEN + ASM_CASES_TAC `drop x <= drop y` THENL + [FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL[`a:real^1`; `b:real^1`; `y:real^1`; `b:real^1`] th) THEN + MP_TAC(SPECL[`a:real^1`; `b:real^1`; `x:real^1`; `b:real^1`] th)) THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `b:real^1`; `y:real^1`] + INTEGRAL_COMBINE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC(NORM_ARITH + `&2 * d = e + ==> norm(ab - (xy + yb)) < d + ==> norm(ab - yb) < d + ==> norm(xy:real^1) < e`) THEN + CONV_TAC REAL_FIELD; + SUBGOAL_THEN `interval[x:real^1,y] = {}` SUBST1_TAC THENL + [REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[INTEGRAL_EMPTY; NORM_0] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. drop b <= drop x + ==> norm(integral (interval[x,y]) (f:real^1->real^1)) + < e / (&4 * abs B + &4)` + (LABEL_TAC "R") + THENL + [REPEAT STRIP_TAC THEN + ASM_CASES_TAC `drop x <= drop y` THENL + [FIRST_X_ASSUM(fun th -> + MP_TAC(SPECL[`a:real^1`; `b:real^1`; `a:real^1`; `x:real^1`] th) THEN + MP_TAC(SPECL[`a:real^1`; `b:real^1`; `a:real^1`; `y:real^1`] th)) THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `y:real^1`; `x:real^1`] + INTEGRAL_COMBINE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC(NORM_ARITH + `&2 * d = e + ==> norm(ab - (ax + xy)) < d + ==> norm(ab - ax) < d + ==> norm(xy:real^1) < e`) THEN + CONV_TAC REAL_FIELD; + SUBGOAL_THEN `interval[x:real^1,y] = {}` SUBST1_TAC THENL + [REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[INTEGRAL_EMPTY; NORM_0] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&4 * B * e / (&4 * abs B + &4)` THEN CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `(norm a <= e /\ norm b <= e) /\ (norm c <= e /\ norm d <= e) + ==> norm((a + b) + (c + d):real^1) <= &4 * e`) THEN + REWRITE_TAC[NORM_MUL] THEN CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + REMOVE_THEN "L" MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + REMOVE_THEN "R" MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_ARITH + `&4 * B * e / y < e <=> e * (&4 * B) / y < e * &1`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < &4 * abs B + &4`] THEN + REAL_ARITH_TAC]) in + GEN_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN + REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT; LIFT_CMUL] THEN + MATCH_MP_TAC lemma THEN EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[]);; + +let INTEGRABLE_INCREASING = prove + (`!f:real^1->real^N a b. + (!x y i. x IN interval[a,b] /\ y IN interval[a,b] /\ + drop x <= drop y /\ 1 <= i /\ i <= dimindex(:N) + ==> f(x)$i <= f(y)$i) + ==> f integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + REWRITE_TAC[LIFT_CMUL; LIFT_NUM] THEN + MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN + ASM_SIMP_TAC[INTEGRABLE_CONST]);; + +let INTEGRABLE_INCREASING_1 = prove + (`!f:real^1->real^1 a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) + ==> f integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; + +let INTEGRABLE_DECREASING_PRODUCT = prove + (`!f:real^1->real^N g a b. + f integrable_on interval[a,b] /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> g(y) <= g(x)) + ==> (\x. g(x) % f(x)) integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x % y:real^N = --(--x % y)`] THEN + MATCH_MP_TAC INTEGRABLE_NEG THEN + MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN + ASM_REWRITE_TAC[REAL_LE_NEG2]);; + +let INTEGRABLE_DECREASING_PRODUCT_UNIV = prove + (`!f:real^1->real^N g B. + f integrable_on (:real^1) /\ + (!x y. drop x <= drop y ==> g y <= g x) /\ + (!x. abs(g x) <= B) + ==> (\x. g x % f x) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x % y:real^N = --(--x % y)`] THEN + MATCH_MP_TAC INTEGRABLE_NEG THEN + MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT_UNIV THEN + EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG]);; + +let INTEGRABLE_DECREASING = prove + (`!f:real^1->real^N a b. + (!x y i. x IN interval[a,b] /\ y IN interval[a,b] /\ + drop x <= drop y /\ 1 <= i /\ i <= dimindex(:N) + ==> f(y)$i <= f(x)$i) + ==> f integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM VECTOR_NEG_NEG] THEN + MATCH_MP_TAC INTEGRABLE_NEG THEN MATCH_MP_TAC INTEGRABLE_INCREASING THEN + ASM_SIMP_TAC[VECTOR_NEG_COMPONENT; REAL_LE_NEG2]);; + +let INTEGRABLE_DECREASING_1 = prove + (`!f:real^1->real^1 a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f y) <= drop(f x)) + ==> f integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_DECREASING THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop]);; + +(* ------------------------------------------------------------------------- *) +(* Bounded variation and variation function, for real^1->real^N functions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_bounded_variation_on",(12,"right"));; + +let has_bounded_variation_on = new_definition + `(f:real^1->real^N) has_bounded_variation_on s <=> + (\k. f(interval_upperbound k) - f(interval_lowerbound k)) + has_bounded_setvariation_on s`;; + +let vector_variation = new_definition + `vector_variation s (f:real^1->real^N) = + set_variation s (\k. f(interval_upperbound k) - f(interval_lowerbound k))`;; + +let HAS_BOUNDED_VARIATION_ON_EQ = prove + (`!f g:real^1->real^N s. + (!x. x IN s ==> f x = g x) /\ f has_bounded_variation_on s + ==> g has_bounded_variation_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[has_bounded_variation_on] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN + SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; + GSYM INTERVAL_NE_EMPTY] THEN + ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]);; + +let VECTOR_VARIATION_EQ = prove + (`!f g:real^1->real^N s. + (!x. x IN s ==> f x = g x) + ==> vector_variation s f = vector_variation s g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN + MATCH_MP_TAC SET_VARIATION_EQ THEN + SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; + GSYM INTERVAL_NE_EMPTY] THEN + ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]);; + +let HAS_BOUNDED_VARIATION_ON_COMPONENTWISE = prove + (`!f:real^1->real^N s. + f has_bounded_variation_on s <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift(f x$i)) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + GEN_REWRITE_TAC LAND_CONV [HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; LIFT_SUB]);; + +let VARIATION_EQUAL_LEMMA = prove + (`!ms ms'. + (!s. ms'(ms s) = s /\ ms(ms' s) = s) /\ + (!d t. d division_of t + ==> (IMAGE (IMAGE ms) d) division_of IMAGE ms t /\ + (IMAGE (IMAGE ms') d) division_of IMAGE ms' t) /\ + (!a b. ~(interval[a,b] = {}) + ==> IMAGE ms' (interval [a,b]) = interval[ms' a,ms' b] \/ + IMAGE ms' (interval [a,b]) = interval[ms' b,ms' a]) + ==> (!f:real^1->real^N s. + (\x. f(ms' x)) has_bounded_variation_on (IMAGE ms s) <=> + f has_bounded_variation_on s) /\ + (!f:real^1->real^N s. + vector_variation (IMAGE ms s) (\x. f(ms' x)) = + vector_variation s f)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN + GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `f:real^1->real^N` THEN + MP_TAC(ISPECL + [`\f k. (f:(real^1->bool)->real^N) (IMAGE (ms':real^1->real^1) k)`; + `IMAGE (ms:real^1->real^1)`; + `IMAGE (ms':real^1->real^1)`] + SETVARIATION_EQUAL_LEMMA) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; IMAGE_SUBSET] THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[IMAGE_EQ_EMPTY]; + ALL_TAC] THEN + REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [AND_FORALL_THM] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `\k. (f:real^1->real^N) (interval_upperbound k) - + f (interval_lowerbound k)` th)) THEN + REWRITE_TAC[] THEN DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `s:real^1->bool` THEN + REWRITE_TAC[has_bounded_setvariation_on; set_variation] THEN + CONJ_TAC THENL + [REPLICATE_TAC 3 (AP_TERM_TAC THEN ABS_TAC) THEN + REWRITE_TAC[TAUT `((p ==> q) <=> (p ==> r)) <=> p ==> (q <=> r)`] THEN + STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; + AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `(!x. P x ==> f x = g x) ==> {f x | P x} = {g x | P x}`) THEN + GEN_TAC THEN STRIP_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION_NONEMPTY th]) THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `IMAGE f s = s' ==> ~(s = {}) ==> IMAGE f s = s' /\ ~(s' = {})`)) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN + NORM_ARITH_TAC);; + +let HAS_BOUNDED_VARIATION_ON_SUBSET = prove + (`!f:real^1->real^N s t. + f has_bounded_variation_on s /\ t SUBSET s + ==> f has_bounded_variation_on t`, + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_SUBSET; has_bounded_variation_on]);; + +let HAS_BOUNDED_VARIATION_ON_CONST = prove + (`!s c:real^N. (\x. c) has_bounded_variation_on s`, + REWRITE_TAC[has_bounded_variation_on; VECTOR_SUB_REFL; + HAS_BOUNDED_SETVARIATION_ON_0]);; + +let VECTOR_VARIATION_CONST = prove + (`!s c:real^N. vector_variation s (\x. c) = &0`, + REWRITE_TAC[vector_variation; VECTOR_SUB_REFL; SET_VARIATION_0]);; + +let HAS_BOUNDED_VARIATION_ON_CMUL = prove + (`!f:real^1->real^N c s. + f has_bounded_variation_on s + ==> (\x. c % f x) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; HAS_BOUNDED_SETVARIATION_ON_CMUL]);; + +let HAS_BOUNDED_VARIATION_ON_NEG = prove + (`!f:real^1->real^N s. + f has_bounded_variation_on s + ==> (\x. --f x) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + REWRITE_TAC[VECTOR_ARITH `--a - --b:real^N = --(a - b)`; + HAS_BOUNDED_SETVARIATION_ON_NEG]);; + +let HAS_BOUNDED_VARIATION_ON_ADD = prove + (`!f g:real^1->real^N s. + f has_bounded_variation_on s /\ g has_bounded_variation_on s + ==> (\x. f x + g x) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + REWRITE_TAC[VECTOR_ARITH `(f + g) - (f' + g'):real^N = (f - f') + (g - g')`; + HAS_BOUNDED_SETVARIATION_ON_ADD]);; + +let HAS_BOUNDED_VARIATION_ON_SUB = prove + (`!f g:real^1->real^N s. + f has_bounded_variation_on s /\ g has_bounded_variation_on s + ==> (\x. f x - g x) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + REWRITE_TAC[VECTOR_ARITH `(f - g) - (f' - g'):real^N = (f - f') - (g - g')`; + HAS_BOUNDED_SETVARIATION_ON_SUB]);; + +let HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR = prove + (`!f:real^1->real^M g:real^M->real^N s. + f has_bounded_variation_on s /\ linear g + ==> (g o f) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + SIMP_TAC[o_THM; GSYM LINEAR_SUB] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR) THEN + REWRITE_TAC[o_DEF]);; + +let HAS_BOUNDED_VARIATION_ON_NULL = prove + (`!f:real^1->real^N s. + content s = &0 /\ bounded s ==> f has_bounded_variation_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_NULL THEN + ASM_SIMP_TAC[INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL]);; + +let HAS_BOUNDED_VARIATION_ON_EMPTY = prove + (`!f:real^1->real^N. f has_bounded_variation_on {}`, + MESON_TAC[CONTENT_EMPTY; BOUNDED_EMPTY; HAS_BOUNDED_VARIATION_ON_NULL]);; + +let VECTOR_VARIATION_ON_NULL = prove + (`!f s. content s = &0 /\ bounded s ==> vector_variation s f = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN + MATCH_MP_TAC SET_VARIATION_ON_NULL THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL]);; + +let HAS_BOUNDED_VARIATION_ON_NORM = prove + (`!f:real^1->real^N s. + f has_bounded_variation_on s + ==> (\x. lift(norm(f x))) has_bounded_variation_on s`, + REWRITE_TAC[has_bounded_variation_on; has_bounded_setvariation_on] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_LE THEN + REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP; DROP_SUB] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_FINITE]; NORM_ARITH_TAC]);; + +let HAS_BOUNDED_VARIATION_ON_MAX = prove + (`!f g s. f has_bounded_variation_on s /\ g has_bounded_variation_on s + ==> (\x. lift(max (drop(f x)) (drop(g x)))) + has_bounded_variation_on s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `max a b = inv(&2) * (a + b + abs(a - b))`] THEN + REWRITE_TAC[LIFT_CMUL; LIFT_ADD; LIFT_DROP; GSYM DROP_SUB] THEN + REWRITE_TAC[drop; GSYM NORM_REAL] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NORM THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[]);; + +let HAS_BOUNDED_VARIATION_ON_MIN = prove + (`!f g s. f has_bounded_variation_on s /\ g has_bounded_variation_on s + ==> (\x. lift(min (drop(f x)) (drop(g x)))) + has_bounded_variation_on s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `min a b = inv(&2) * ((a + b) - abs(a - b))`] THEN + REWRITE_TAC[LIFT_CMUL; LIFT_ADD; LIFT_DROP; LIFT_SUB; GSYM DROP_SUB] THEN + REWRITE_TAC[drop; GSYM NORM_REAL] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_CMUL THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN + ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_ADD] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NORM THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN ASM_REWRITE_TAC[]);; + +let HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS = prove + (`!f:real^1->real^N s. + f has_bounded_variation_on s + ==> bounded { f(d) - f(c) | interval[c,d] SUBSET s /\ + ~(interval[c,d] = {})}`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP + HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`d:real^1`; `c:real^1`] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN STRIP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`c:real^1`; `d:real^1`] THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1]);; + +let HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL = prove + (`!f:real^1->real^N a b. + f has_bounded_variation_on interval[a,b] + ==> bounded(IMAGE f (interval[a,b]))`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS) THEN + REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_GSPEC; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B + norm((f:real^1->real^N) a)` THEN + ASM_SIMP_TAC[NORM_ARITH `&0 < B ==> &0 < B + norm(x:real^N)`] THEN + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `a:real^1`]) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; NORM_ARITH_TAC]);; + +let HAS_BOUNDED_VARIATION_ON_MUL = prove + (`!f g:real^1->real^N a b. + f has_bounded_variation_on interval[a,b] /\ + g has_bounded_variation_on interval[a,b] + ==> (\x. drop(f x) % g x) has_bounded_variation_on interval[a,b]`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `bounded(IMAGE (f:real^1->real^1) (interval[a,b])) /\ + bounded(IMAGE (g:real^1->real^N) (interval[a,b]))` + MP_TAC THENL + [ASM_SIMP_TAC[HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL]; + REWRITE_TAC[BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN + REWRITE_TAC[HAS_BOUNDED_SETVARIATION_ON_INTERVAL; + has_bounded_variation_on] THEN + DISCH_THEN(X_CHOOSE_THEN `C2:real` (LABEL_TAC "G")) THEN + DISCH_THEN(X_CHOOSE_THEN `C1:real` (LABEL_TAC "F")) THEN + EXISTS_TAC `B1 * C2 + B2 * C1:real` THEN + X_GEN_TAC `d:(real^1->bool)->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `B1 * sum d (\k. norm((g:real^1->real^N)(interval_upperbound k) - + g(interval_lowerbound k))) + + B2 * sum d (\k. norm((f:real^1->real^1)(interval_upperbound k) - + f(interval_lowerbound k)))` THEN + CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[REAL_LE_LMUL_EQ]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_ADD] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `f' % g' - f % g:real^N = f' % (g' - g) + (f' - f) % g`] THEN + MATCH_MP_TAC(NORM_ARITH + `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN + REWRITE_TAC[NORM_MUL; NORM_REAL] THEN + REWRITE_TAC[drop; GSYM NORM_REAL; GSYM VECTOR_SUB_COMPONENT] THEN + SUBGOAL_THEN `~(interval[u:real^1,v] = {})` MP_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN DISCH_TAC THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` MP_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; GSYM REAL_NOT_LE] THEN + STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; + +let VECTOR_VARIATION_POS_LE = prove + (`!f:real^1->real^N s. + f has_bounded_variation_on s ==> &0 <= vector_variation s f`, + REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN + REWRITE_TAC[SET_VARIATION_POS_LE]);; + +let VECTOR_VARIATION_GE_NORM_FUNCTION = prove + (`!f:real^1->real^N s a b. + f has_bounded_variation_on s /\ segment[a,b] SUBSET s + ==> norm(f b - f a) <= vector_variation s f`, + REWRITE_TAC[FORALL_LIFT] THEN GEN_TAC THEN GEN_TAC THEN + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [MESON_TAC[SEGMENT_SYM; NORM_SUB]; ALL_TAC] THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP; has_bounded_variation_on] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\k. (f:real^1->real^N)(interval_upperbound k) - f(interval_lowerbound k)`; + `s:real^1->bool`; `a:real^1`; `b:real^1`] SET_VARIATION_GE_FUNCTION) THEN + ASM_REWRITE_TAC[vector_variation; INTERVAL_NE_EMPTY_1] THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN + ASM_MESON_TAC[SEGMENT_1]);; + +let VECTOR_VARIATION_GE_DROP_FUNCTION = prove + (`!f s a b. + f has_bounded_variation_on s /\ segment[a,b] SUBSET s + ==> drop(f b) - drop(f a) <= vector_variation s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm((f:real^1->real^1) b - f a)` THEN + ASM_SIMP_TAC[VECTOR_VARIATION_GE_NORM_FUNCTION] THEN + REWRITE_TAC[NORM_REAL; DROP_SUB; GSYM drop] THEN REAL_ARITH_TAC);; + +let VECTOR_VARIATION_CONST_EQ = prove + (`!f:real^1->real^N s. + is_interval s /\ f has_bounded_variation_on s + ==> (vector_variation s f = &0 <=> ?c. !x. x IN s ==> f x = c)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[MESON[] + `(?c. !x. P x ==> f x = c) <=> !a b. P a /\ P b ==> f a = f b`] THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^N`; `s:real^1->bool`; + `a:real^1`; `b:real^1`] VECTOR_VARIATION_GE_NORM_FUNCTION) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT]; + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH]; + DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN + MP_TAC(ISPECL [`f:real^1->real^N`; `(\x. c):real^1->real^N`; + `s:real^1->bool`] VECTOR_VARIATION_EQ) THEN + ASM_SIMP_TAC[VECTOR_VARIATION_CONST]]);; + +let VECTOR_VARIATION_MONOTONE = prove + (`!f s t. f has_bounded_variation_on s /\ t SUBSET s + ==> vector_variation t f <= vector_variation s f`, + REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN + REWRITE_TAC[SET_VARIATION_MONOTONE]);; + +let VECTOR_VARIATION_NEG = prove + (`!f:real^1->real^N s. + vector_variation s (\x. --(f x)) = vector_variation s f`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_variation; set_variation] THEN + REWRITE_TAC[NORM_ARITH `norm(--x - --y:real^N) = norm(x - y)`]);; + +let VECTOR_VARIATION_TRIANGLE = prove + (`!f g:real^1->real^N s. + f has_bounded_variation_on s /\ g has_bounded_variation_on s + ==> vector_variation s (\x. f x + g x) + <= vector_variation s f + vector_variation s g`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN + DISCH_THEN(MP_TAC o MATCH_MP SET_VARIATION_TRIANGLE) THEN + REWRITE_TAC[VECTOR_ARITH `(a + b) - (c + d):real^N = (a - c) + (b - d)`]);; + +let OPERATIVE_FUNCTION_ENDPOINT_DIFF = prove + (`!f:real^1->real^N. + operative (+) (\k. f (interval_upperbound k) - f (interval_lowerbound k))`, + GEN_TAC THEN + SIMP_TAC[operative; INTERVAL_BOUNDS_NULL_1; VECTOR_SUB_REFL] THEN + REWRITE_TAC[NEUTRAL_VECTOR_ADD; DIMINDEX_1; FORALL_1; GSYM drop] THEN + REWRITE_TAC[FORALL_DROP] THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`] THEN + ASM_CASES_TAC `interval[a:real^1,b] = {}` THENL + [ASM_REWRITE_TAC[INTER_EMPTY; INTERVAL_BOUNDS_EMPTY_1] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `interval[a,b] INTER {x | drop x <= drop c} = {}` THENL + [ASM_REWRITE_TAC[INTERVAL_BOUNDS_EMPTY_1; VECTOR_SUB_REFL] THEN + SUBGOAL_THEN `interval[a,b] INTER {x | drop x >= drop c} = interval[a,b]` + (fun th -> REWRITE_TAC[th; VECTOR_ADD_LID]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `i INTER s = {} ==> s UNION t = UNIV ==> i INTER t = i`)) THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `interval[a,b] INTER {x | drop x >= drop c} = {}` THENL + [ASM_REWRITE_TAC[INTERVAL_BOUNDS_EMPTY_1; VECTOR_SUB_REFL] THEN + SUBGOAL_THEN `interval[a,b] INTER {x | drop x <= drop c} = interval[a,b]` + (fun th -> REWRITE_TAC[th; VECTOR_ADD_RID]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `i INTER s = {} ==> s UNION t = UNIV ==> i INTER t = i`)) THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SIMP_TAC[INTERVAL_SPLIT; drop; DIMINDEX_1; LE_REFL] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN + SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1] THEN + SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN STRIP_TAC THEN + MATCH_MP_TAC(VECTOR_ARITH + `fx:real^N = fy ==> fb - fa = fx - fa + fb - fy`) THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; drop] THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL] THEN ASM_REAL_ARITH_TAC);; + +let OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF = prove + (`!f:real^1->real. + operative (+) (\k. f (interval_upperbound k) - f (interval_lowerbound k))`, + GEN_TAC THEN + MP_TAC(ISPEC `lift o (f:real^1->real)` OPERATIVE_FUNCTION_ENDPOINT_DIFF) THEN + REWRITE_TAC[operative; NEUTRAL_REAL_ADD; NEUTRAL_VECTOR_ADD] THEN + REWRITE_TAC[o_THM; GSYM LIFT_SUB; GSYM LIFT_ADD; GSYM LIFT_NUM] THEN + REWRITE_TAC[LIFT_EQ]);; + +let OPERATIVE_LIFTED_VECTOR_VARIATION = prove + (`!f:real^1->real^N. + operative (lifted(+)) + (\i. if f has_bounded_variation_on i + then SOME(vector_variation i f) else NONE)`, + GEN_TAC THEN REWRITE_TAC[has_bounded_variation_on; vector_variation] THEN + MATCH_MP_TAC OPERATIVE_LIFTED_SETVARIATION THEN + REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; + +let HAS_BOUNDED_VARIATION_ON_DIVISION = prove + (`!f:real^1->real^N a b d. + d division_of interval[a,b] + ==> ((!k. k IN d ==> f has_bounded_variation_on k) <=> + f has_bounded_variation_on interval[a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + MATCH_MP_TAC HAS_BOUNDED_SETVARIATION_ON_DIVISION THEN + ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF]);; + +let VECTOR_VARIATION_ON_DIVISION = prove + (`!f:real^1->real^N a b d. + d division_of interval[a,b] /\ + f has_bounded_variation_on interval[a,b] + ==> sum d (\k. vector_variation k f) = + vector_variation (interval[a,b]) f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN + MATCH_MP_TAC SET_VARIATION_ON_DIVISION THEN + ASM_REWRITE_TAC[OPERATIVE_FUNCTION_ENDPOINT_DIFF; GSYM + has_bounded_variation_on]);; + +let HAS_BOUNDED_VARIATION_ON_COMBINE = prove + (`!f:real^1->real^N a b c. + drop a <= drop c /\ drop c <= drop b + ==> (f has_bounded_variation_on interval[a,b] <=> + f has_bounded_variation_on interval[a,c] /\ + f has_bounded_variation_on interval[c,b])`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPEC `f:real^1->real^N` OPERATIVE_LIFTED_VECTOR_VARIATION) THEN + REWRITE_TAC[operative; FORALL_1; FORALL_DROP; DIMINDEX_1] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`; `c:real^1`] o + CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `interval[a,b] INTER {x:real^1 | x$1 <= drop c} = interval[a,c] /\ + interval[a,b] INTER {x:real^1 | x$1 >= drop c} = interval[c,b]` + (fun th -> REWRITE_TAC[th]) + THENL + [SIMP_TAC[EXTENSION; IN_INTER; GSYM drop; IN_INTERVAL_1; IN_ELIM_THM] THEN + ASM_REAL_ARITH_TAC; + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[distinctness "option"; lifted])]);; + +let VECTOR_VARIATION_COMBINE = prove + (`!f:real^1->real^N a b c. + drop a <= drop c /\ + drop c <= drop b /\ + f has_bounded_variation_on interval[a,b] + ==> vector_variation (interval[a,c]) f + + vector_variation (interval[c,b]) f = + vector_variation (interval[a,b]) f`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPEC `f:real^1->real^N` OPERATIVE_LIFTED_VECTOR_VARIATION) THEN + REWRITE_TAC[operative; FORALL_1; FORALL_DROP; DIMINDEX_1] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`; `c:real^1`] o + CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN REPEAT(COND_CASES_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; INTER_SUBSET]]) THEN + REWRITE_TAC[lifted; injectivity "option"] THEN DISCH_THEN SUBST1_TAC THEN + SIMP_TAC[INTERVAL_SPLIT; DIMINDEX_1; LE_REFL] THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[EXTENSION; IN_INTERVAL_1; drop; LAMBDA_BETA; + DIMINDEX_1; LE_REFL] THEN + REWRITE_TAC[GSYM drop] THEN ASM_REAL_ARITH_TAC);; + +let VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE = prove + (`!f a b c d. + f has_bounded_variation_on interval[a,b] /\ + interval[c,d] SUBSET interval[a,b] /\ ~(interval[c,d] = {}) + ==> vector_variation (interval[c,d]) f - drop(f d - f c) <= + vector_variation (interval[a,b]) f - drop(f b - f a)`, + REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1; REAL_NOT_LT] THEN + REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `drop(f c) - drop(f a) <= vector_variation(interval[a,c]) f /\ + drop(f b) - drop(f d) <= vector_variation(interval[d,b]) f` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_GE_DROP_FUNCTION THEN + ASM_REWRITE_TAC[SEGMENT_1; SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN + (CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[DROP_SUB] THEN + MP_TAC(ISPEC `f:real^1->real^1` VECTOR_VARIATION_COMBINE) THEN + DISCH_THEN(fun th -> + MP_TAC(SPECL [`a:real^1`; `b:real^1`; `d:real^1`] th) THEN + MP_TAC(SPECL [`a:real^1`; `d:real^1`; `c:real^1`] th)) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]);; + +let INCREASING_BOUNDED_VARIATION = prove + (`!f a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) + ==> f has_bounded_variation_on interval[a,b]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN + ASM_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_EMPTY] THEN + REWRITE_TAC[has_bounded_variation_on; + HAS_BOUNDED_SETVARIATION_ON_INTERVAL] THEN + EXISTS_TAC `drop(f b) - drop(f(a:real^1))` THEN + MP_TAC(MATCH_MP (REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] + OPERATIVE_DIVISION) (SPEC `drop o (f:real^1->real^1)` + OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF)) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[GSYM sum; MONOIDAL_REAL_ADD] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_SIMP_TAC[o_THM; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(interval[u:real^1,v] = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_SIMP_TAC[DROP_SUB; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> abs(y - x) = y - x`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` MP_TAC THENL + [ASM_MESON_TAC[division_of]; REWRITE_TAC[SUBSET_INTERVAL_1]] THEN + ASM_REAL_ARITH_TAC);; + +let DECREASING_BOUNDED_VARIATION = prove + (`!f a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f y) <= drop(f x)) + ==> f has_bounded_variation_on interval[a,b]`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) + [GSYM REAL_LE_NEG2] THEN + REWRITE_TAC[GSYM DROP_NEG] THEN + DISCH_THEN(MP_TAC o MATCH_MP INCREASING_BOUNDED_VARIATION) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NEG) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let INCREASING_VECTOR_VARIATION = prove + (`!f a b. + ~(interval[a,b] = {}) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) + ==> vector_variation (interval[a,b]) f = drop(f b) - drop(f a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_variation] THEN + REWRITE_TAC[SET_VARIATION_ON_INTERVAL] THEN + SUBGOAL_THEN + `{sum d (\k. norm (f (interval_upperbound k) - f (interval_lowerbound k))) | + d division_of interval[a:real^1,b]} = + {drop (f b) - drop(f a)}` + (fun th -> SIMP_TAC[SUP_INSERT_FINITE; FINITE_EMPTY; th]) THEN + MATCH_MP_TAC(SET_RULE + `(?x. P x) /\ (!x. P x ==> f x = a) ==> {f x | P x} = {a}`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION_OF_SELF]; ALL_TAC] THEN + MP_TAC(MATCH_MP (REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] + OPERATIVE_DIVISION) (SPEC `drop o (f:real^1->real^1)` + OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF)) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[GSYM sum; MONOIDAL_REAL_ADD] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_SIMP_TAC[o_THM; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(interval[u:real^1,v] = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_SIMP_TAC[DROP_SUB; INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> abs(y - x) = y - x`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + SUBGOAL_THEN `interval[u:real^1,v] SUBSET interval[a,b]` MP_TAC THENL + [ASM_MESON_TAC[division_of]; REWRITE_TAC[SUBSET_INTERVAL_1]] THEN + ASM_REAL_ARITH_TAC);; + +let DECREASING_VECTOR_VARIATION = prove + (`!f a b. + ~(interval[a,b] = {}) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f y) <= drop(f x)) + ==> vector_variation (interval[a,b]) f = drop(f a) - drop(f b)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) + [GSYM REAL_LE_NEG2] THEN + REWRITE_TAC[GSYM DROP_NEG] THEN + DISCH_THEN(MP_TAC o MATCH_MP INCREASING_VECTOR_VARIATION) THEN + SIMP_TAC[VECTOR_VARIATION_NEG; DROP_NEG] THEN + DISCH_TAC THEN REAL_ARITH_TAC);; + +let HAS_BOUNDED_VARIATION_TRANSLATION2_EQ,VECTOR_VARIATION_TRANSLATION2 = + (CONJ_PAIR o prove) + (`(!a f:real^1->real^N s. + (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. --a + x) s) <=> + f has_bounded_variation_on s) /\ + (!a f:real^1->real^N s. + vector_variation (IMAGE (\x. --a + x) s) (\x. f(a + x)) = + vector_variation s f)`, + GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `a:real^1` THEN + MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [VECTOR_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[DIVISION_OF_TRANSLATION; GSYM INTERVAL_TRANSLATION]);; + +let HAS_BOUNDED_VARIATION_AFFINITY2_EQ,VECTOR_VARIATION_AFFINITY2 = + (CONJ_PAIR o prove) + (`(!m c f:real^1->real^N s. + (\x. f (m % x + c)) has_bounded_variation_on + IMAGE (\x. inv m % x + --(inv m % c)) s <=> + m = &0 \/ f has_bounded_variation_on s) /\ + (!m c f:real^1->real^N s. + vector_variation (IMAGE (\x. inv m % x + --(inv m % c)) s) + (\x. f (m % x + c)) = + if m = &0 then &0 else vector_variation s f)`, + GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `m:real` THEN + GEN_REWRITE_TAC I [AND_FORALL_THM] THEN X_GEN_TAC `c:real^1` THEN + ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST] THEN + REWRITE_TAC[VECTOR_VARIATION_CONST]; + MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN + ASM_SIMP_TAC[REWRITE_RULE[FUN_EQ_THM; o_DEF] AFFINITY_INVERSES; I_THM] THEN + ASM_SIMP_TAC[IMAGE_AFFINITY_INTERVAL] THEN + ASM_REWRITE_TAC[DIVISION_OF_AFFINITY; REAL_INV_EQ_0] THEN + MESON_TAC[]]);; + +let HAS_BOUNDED_VARIATION_AFFINITY_EQ,VECTOR_VARIATION_AFFINITY = + (CONJ_PAIR o prove) + (`(!m c f:real^1->real^N s. + (\x. f(m % x + c)) has_bounded_variation_on s <=> + m = &0 \/ f has_bounded_variation_on (IMAGE (\x. m % x + c) s)) /\ + (!m c f:real^1->real^N s. + vector_variation s (\x. f(m % x + c)) = + if m = &0 then &0 else vector_variation (IMAGE (\x. m % x + c) s) f)`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `m = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST; + VECTOR_VARIATION_CONST] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL[`m:real`; `c:real^1`; `f:real^1->real^N`; + `IMAGE (\x:real^1. m % x + c) s`] + HAS_BOUNDED_VARIATION_AFFINITY2_EQ); + MP_TAC(ISPECL[`m:real`; `c:real^1`; `f:real^1->real^N`; + `IMAGE (\x:real^1. m % x + c) s`] + VECTOR_VARIATION_AFFINITY2)] THEN + ASM_SIMP_TAC[AFFINITY_INVERSES; GSYM IMAGE_o; IMAGE_I]);; + +let HAS_BOUNDED_VARIATION_TRANSLATION_EQ,VECTOR_VARIATION_TRANSLATION = + (CONJ_PAIR o prove) + (`(!a f:real^1->real^N s. + (\x. f(a + x)) has_bounded_variation_on s <=> + f has_bounded_variation_on (IMAGE (\x. a + x) s)) /\ + (!a f:real^1->real^N s. + vector_variation s (\x. f(a + x)) = + vector_variation (IMAGE (\x. a + x) s) f)`, + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL[`a:real^1`; `f:real^1->real^N`; `IMAGE (\x:real^1. a + x) s`] + HAS_BOUNDED_VARIATION_TRANSLATION2_EQ); + MP_TAC(ISPECL[`a:real^1`; `f:real^1->real^N`; `IMAGE (\x:real^1. a + x) s`] + VECTOR_VARIATION_TRANSLATION2)] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[IMAGE_ID; VECTOR_ARITH `--a + a + x:real^N = x`; + VECTOR_ARITH `a + --a + x:real^N = x`]);; + +let HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL, + VECTOR_VARIATION_TRANSLATION_INTERVAL = + (CONJ_PAIR o prove) + (`(!a f:real^1->real^N u v. + (\x. f(a + x)) has_bounded_variation_on interval[u,v] <=> + f has_bounded_variation_on interval[a+u,a+v]) /\ + (!a f:real^1->real^N u v. + vector_variation (interval[u,v]) (\x. f(a + x)) = + vector_variation (interval[a+u,a+v]) f)`, + REWRITE_TAC[INTERVAL_TRANSLATION; HAS_BOUNDED_VARIATION_TRANSLATION_EQ; + VECTOR_VARIATION_TRANSLATION]);; + +let HAS_BOUNDED_VARIATION_TRANSLATION = prove + (`!f:real^1->real^N s a. + f has_bounded_variation_on s + ==> (\x. f(a + x)) has_bounded_variation_on (IMAGE (\x. --a + x) s)`, + REWRITE_TAC[HAS_BOUNDED_VARIATION_TRANSLATION2_EQ]);; + +let HAS_BOUNDED_VARIATION_REFLECT2_EQ,VECTOR_VARIATION_REFLECT2 = + (CONJ_PAIR o prove) + (`(!f:real^1->real^N s. + (\x. f(--x)) has_bounded_variation_on (IMAGE (--) s) <=> + f has_bounded_variation_on s) /\ + (!f:real^1->real^N s. + vector_variation (IMAGE (--) s) (\x. f(--x)) = + vector_variation s f)`, + MATCH_MP_TAC VARIATION_EQUAL_LEMMA THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [VECTOR_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[DIVISION_OF_REFLECT; REFLECT_INTERVAL]);; + +let HAS_BOUNDED_VARIATION_REFLECT_EQ,VECTOR_VARIATION_REFLECT = + (CONJ_PAIR o prove) + (`(!f:real^1->real^N s. + (\x. f(--x)) has_bounded_variation_on s <=> + f has_bounded_variation_on (IMAGE (--) s)) /\ + (!f:real^1->real^N s. + vector_variation s (\x. f(--x)) = + vector_variation (IMAGE (--) s) f)`, + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL[`f:real^1->real^N`; `IMAGE (--) (s:real^1->bool)`] + HAS_BOUNDED_VARIATION_REFLECT2_EQ); + MP_TAC(ISPECL[`f:real^1->real^N`; `IMAGE (--) (s:real^1->bool)`] + VECTOR_VARIATION_REFLECT2)] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[IMAGE_ID; VECTOR_NEG_NEG]);; + +let HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL, + VECTOR_VARIATION_REFLECT_INTERVAL = + (CONJ_PAIR o prove) + (`(!f:real^1->real^N u v. + (\x. f(--x)) has_bounded_variation_on interval[u,v] <=> + f has_bounded_variation_on interval[--v,--u]) /\ + (!f:real^1->real^N u v. + vector_variation (interval[u,v]) (\x. f(--x)) = + vector_variation (interval[--v,--u]) f)`, + REWRITE_TAC[GSYM REFLECT_INTERVAL; HAS_BOUNDED_VARIATION_REFLECT_EQ; + VECTOR_VARIATION_REFLECT]);; + +let HAS_BOUNDED_VARIATION_DARBOUX = prove + (`!f a b. + f has_bounded_variation_on interval[a,b] <=> + ?g h. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(g x) <= drop(g y)) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(h x) <= drop(h y)) /\ + (!x. f x = g x - h x)`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC + [`\x:real^1. lift(vector_variation (interval[a,x]) (f:real^1->real^1))`; + `\x:real^1. lift(vector_variation (interval[a,x]) f) - f x`] THEN + REWRITE_TAC[VECTOR_ARITH `a - (a - x):real^1 = x`] THEN + REWRITE_TAC[LIFT_DROP; DROP_SUB] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC VECTOR_VARIATION_MONOTONE; + MATCH_MP_TAC(REAL_ARITH + `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN + EXISTS_TAC `drop(f(a:real^1))` THEN + REWRITE_TAC[GSYM DROP_SUB] THEN + MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE] THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)); + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN + ASM_REAL_ARITH_TAC); + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN + ASM_REWRITE_TAC[]]);; + +let HAS_BOUNDED_VARIATION_DARBOUX_STRICT = prove + (`!f a b. + f has_bounded_variation_on interval[a,b] <=> + ?g h. (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y + ==> drop(g x) < drop(g y)) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x < drop y + ==> drop(h x) < drop(h y)) /\ + (!x. f x = g x - h x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`\x:real^1. g x + x`; `\x:real^1. h x + x`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `(a + x) - (b + x):real^1 = a - b`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[DROP_ADD] THEN + MATCH_MP_TAC REAL_LET_ADD2 THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MAP_EVERY EXISTS_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + ASM_REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN ASM_MESON_TAC[]]);; + +let HAS_BOUNDED_VARIATION_COMPOSE_INCREASING = prove + (`!f g:real^1->real^N a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) /\ + g has_bounded_variation_on interval[f a,f b] + ==> (g o f) has_bounded_variation_on interval[a,b]`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^1->real^1`; `k:real^1->real^1`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`(h:real^1->real^1) o (f:real^1->real^1)`; + `(k:real^1->real^1) o (f:real^1->real^1)`] THEN + ASM_REWRITE_TAC[o_THM] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTERVAL_1] THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; + +let HAS_BOUNDED_VARIATION_ON_REFLECT = prove + (`!f:real^1->real^N s. + f has_bounded_variation_on IMAGE (--) s + ==> (\x. f(--x)) has_bounded_variation_on s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_variation_on] THEN + REWRITE_TAC[has_bounded_setvariation_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`d:(real^1->bool)->bool`; `t:real^1->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`IMAGE (IMAGE (--)) (d:(real^1->bool)->bool)`; + `IMAGE (--) (t:real^1->bool)`]) THEN + ASM_SIMP_TAC[DIVISION_OF_REFLECT] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM SUBSET] THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhand o lhand o snd) THEN + ANTS_TAC THENL + [MESON_TAC[VECTOR_ARITH `--x:real^N = --y <=> x = y`; INJECTIVE_IMAGE]; + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= d ==> y <= d`) THEN + MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERVAL_NE_EMPTY_1; division_of]; ALL_TAC] THEN + ASM_REWRITE_TAC[o_THM; REFLECT_INTERVAL] THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1; + DROP_NEG; REAL_LE_NEG2] THEN + NORM_ARITH_TAC]);; + +let HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL = prove + (`!f:real^1->real^N a b. + f has_bounded_variation_on interval[--b,--a] + ==> (\x. f(--x)) has_bounded_variation_on interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_REFLECT THEN + ASM_REWRITE_TAC[REFLECT_INTERVAL]);; + +let VECTOR_VARIATION_REFLECT = prove + (`!f:real^1->real^N s. + vector_variation s (\x. f(--x)) = + vector_variation (IMAGE (--) s) f`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_variation; set_variation] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^1->bool)->bool` + (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (IMAGE (--)) (d:(real^1->bool)->bool)` THEN + (CONJ_TAC THENL + [EXISTS_TAC `IMAGE (--) (t:real^1->bool)` THEN + ASM_SIMP_TAC[DIVISION_OF_REFLECT] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_IMAGE]) THEN + ASM_MESON_TAC[VECTOR_NEG_NEG; IN_IMAGE]; + ALL_TAC]) THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o rand o snd) THEN + (ANTS_TAC THENL + [MESON_TAC[VECTOR_ARITH `--x:real^N = --y <=> x = y`; INJECTIVE_IMAGE]; + DISCH_THEN SUBST1_TAC]) THEN + MATCH_MP_TAC SUM_EQ THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP FORALL_IN_DIVISION th]) THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + (SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERVAL_NE_EMPTY_1; division_of]; ALL_TAC]) THEN + ASM_REWRITE_TAC[o_THM; REFLECT_INTERVAL] THEN + ASM_SIMP_TAC[INTERVAL_UPPERBOUND_1; INTERVAL_LOWERBOUND_1; + DROP_NEG; REAL_LE_NEG2; VECTOR_NEG_NEG] THEN + NORM_ARITH_TAC);; + +let VECTOR_VARIATION_REFLECT_INTERVAL = prove + (`!f:real^1->real^N a b. + vector_variation (interval[a,b]) (\x. f(--x)) = + vector_variation (interval[--b,--a]) f`, + REWRITE_TAC[VECTOR_VARIATION_REFLECT; REFLECT_INTERVAL]);; + +let HAS_BOUNDED_VARIATION_COMPOSE_DECREASING = prove + (`!f g:real^1->real^N a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f y) <= drop(f x)) /\ + g has_bounded_variation_on interval[f b,f a] + ==> (g o f) has_bounded_variation_on interval[a,b]`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[VECTOR_NEG_NEG] + (ISPECL [`f:real^1->real^N`; `--b:real^1`; `--a:real^1`] + HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL))) THEN + POP_ASSUM MP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o BINDER_CONV o RAND_CONV) + [GSYM REAL_LE_NEG2] THEN + REWRITE_TAC[GSYM DROP_NEG; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_COMPOSE_INCREASING) THEN + REWRITE_TAC[o_DEF; VECTOR_NEG_NEG]);; + +let HAS_BOUNDED_VARIATION_ON_ID = prove + (`!a b. (\x. x) has_bounded_variation_on interval[a,b]`, + REPEAT GEN_TAC THEN MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN + SIMP_TAC[]);; + +let HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE = prove + (`!f:real^1->real^1 g:real^1->real^N a b. + linear f /\ g has_bounded_variation_on IMAGE f (interval[a,b]) + ==> (g o f) has_bounded_variation_on interval[a,b]`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LINEAR_1]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` SUBST_ALL_TAC) THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH + `c = &0 \/ &0 <= c /\ &0 < c \/ ~(&0 <= c) /\ &0 < --c`) + THENL + [ASM_REWRITE_TAC[o_DEF; VECTOR_MUL_LZERO; HAS_BOUNDED_VARIATION_ON_CONST]; + MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_INCREASING THEN + REWRITE_TAC[DROP_CMUL]; + MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_DECREASING THEN + REWRITE_TAC[DROP_CMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `c * y <= c * x <=> --c * x <= --c * y`]] THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(MESON[] + `g has_bounded_variation_on s + ==> s = t ==> g has_bounded_variation_on t`)) THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `c % x:real^N = c % x + vec 0`] THEN + ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[INTERVAL_EQ_EMPTY_1; DROP_CMUL] THENL + [ALL_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `c * y < c * x <=> --c * x < --c * y`]] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + ASM_REWRITE_TAC[GSYM INTERVAL_EQ_EMPTY_1]);; + +let INCREASING_LEFT_LIMIT_1 = prove + (`!f a b c. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) /\ + c IN interval[a,b] + ==> ?l. (f --> l) (at c within interval[a,c])`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `lift(sup {drop(f x) | x IN interval[a,b] /\ drop x < drop c})` THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[LIM_WITHIN] THEN + REWRITE_TAC[DIST_REAL; GSYM drop] THEN + ASM_CASES_TAC `{x | x IN interval[a,b] /\ drop x < drop c} = {}` THENL + [GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC(TAUT + `(a ==> ~b) ==> a ==> b ==> c`) THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM; IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `{drop(f x) | x IN interval[a,b] /\ drop x < drop c}` SUP) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; + EXISTS_TAC `drop(f(b:real^1))` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]; + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_ID] THEN + ABBREV_TAC `s = sup (IMAGE (\x. drop(f x)) + {x | x IN interval[a,b] /\ drop x < drop c})` THEN + REWRITE_TAC[LIFT_DROP] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `s - e:real`)) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(s <= s - e)`; NOT_FORALL_THM] THEN + REWRITE_TAC[NOT_IMP; REAL_NOT_LE; IN_INTERVAL_1] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `drop c - drop d` THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`d:real^1`; `x:real^1`]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REAL_ARITH_TAC]);; + +let DECREASING_LEFT_LIMIT_1 = prove + (`!f a b c. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f y) <= drop(f x)) /\ + c IN interval[a,b] + ==> ?l. (f --> l) (at c within interval[a,c])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. --((f:real^1->real^1) x)`; `a:real^1`; `b:real^1`; `c:real^1`] + INCREASING_LEFT_LIMIT_1) THEN + ASM_REWRITE_TAC[REAL_LE_NEG2; DROP_NEG] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; + +let INCREASING_RIGHT_LIMIT_1 = prove + (`!f a b c. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) /\ + c IN interval[a,b] + ==> ?l. (f --> l) (at c within interval[c,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. (f:real^1->real^1) (--x)`; + `--b:real^1`; `--a:real^1`; `--c:real^1`] + DECREASING_LEFT_LIMIT_1) THEN + ASM_REWRITE_TAC[IN_INTERVAL_REFLECT] THEN + ONCE_REWRITE_TAC[MESON[VECTOR_NEG_NEG] + `(!x:real^1 y:real^1. P x y) <=> (!x y. P (--x) (--y))`] THEN + REWRITE_TAC[DROP_NEG; IN_INTERVAL_REFLECT; VECTOR_NEG_NEG] THEN + ASM_SIMP_TAC[REAL_LE_NEG2] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `l:real^1` THEN REWRITE_TAC[LIM_WITHIN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [MESON[VECTOR_NEG_NEG] `(!x:real^1. P x) <=> (!x. P (--x))`] THEN + REWRITE_TAC[IN_INTERVAL_REFLECT; VECTOR_NEG_NEG; + NORM_ARITH `dist(--x:real^1,--y) = dist(x,y)`]);; + +let DECREASING_RIGHT_LIMIT_1 = prove + (`!f a b c. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f y) <= drop(f x)) /\ + c IN interval[a,b] + ==> ?l. (f --> l) (at c within interval[c,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. --((f:real^1->real^1) x)`; `a:real^1`; `b:real^1`; `c:real^1`] + INCREASING_RIGHT_LIMIT_1) THEN + ASM_REWRITE_TAC[REAL_LE_NEG2; DROP_NEG] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM LIM_NEG_EQ] THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; + +let HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT = prove + (`!f:real^1->real^N a b c. + f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] + ==> ?l. (f --> l) (at c within interval[a,c])`, + ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT; + HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`\x. lift((f:real^1->real^N)x$i)`,`f:real^1->real^1`) THEN + UNDISCH_TAC `(c:real^1) IN interval[a,b]` THEN POP_ASSUM_LIST(K ALL_TAC) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM EXISTS_LIFT] THEN + FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONJ_ASSOC] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN + (MP_TAC o SPEC `c:real^1` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] INCREASING_LEFT_LIMIT_1))) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `l2:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `l1:real^1` THEN DISCH_TAC THEN + EXISTS_TAC `l1 - l2:real^1` THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ASM_SIMP_TAC[LIM_SUB]);; + +let HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT = prove + (`!f:real^1->real^N a b c. + f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] + ==> ?l. (f --> l) (at c within interval[c,b])`, + ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT; + HAS_BOUNDED_VARIATION_ON_COMPONENTWISE] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`\x. lift((f:real^1->real^N)x$i)`,`f:real^1->real^1`) THEN + UNDISCH_TAC `(c:real^1) IN interval[a,b]` THEN POP_ASSUM_LIST(K ALL_TAC) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM EXISTS_LIFT] THEN + FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONJ_ASSOC] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_THEN(CONJUNCTS_THEN + (MP_TAC o SPEC `c:real^1` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] INCREASING_RIGHT_LIMIT_1))) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `l2:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `l1:real^1` THEN DISCH_TAC THEN + EXISTS_TAC `l1 - l2:real^1` THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ASM_SIMP_TAC[LIM_SUB]);; + +let VECTOR_VARIATION_CONTINUOUS_LEFT = prove + (`!f:real^1->real^1 a b c. + f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] + ==> ((\x. lift(vector_variation(interval[a,x]) f)) + continuous (at c within interval[a,c]) <=> + f continuous (at c within interval[a,c]))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[continuous_within] THEN + REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + REWRITE_TAC[GSYM DROP_SUB] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `c:real^1`; `x:real^1`] + VECTOR_VARIATION_COMBINE) THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH `abs(a - (a + b)) = abs b`] THEN + REWRITE_TAC[drop; GSYM NORM_REAL] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)); + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC] THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN ASM_CASES_TAC `c limit_point_of interval[a:real^1,c]` THENL + [ALL_TAC; + ASM_REWRITE_TAC[CONTINUOUS_WITHIN; LIM; TRIVIAL_LIMIT_WITHIN]] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] + INCREASING_LEFT_LIMIT_1) THEN + MP_TAC(ISPECL [`g:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] + INCREASING_LEFT_LIMIT_1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `gc:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `hc:real^1` THEN DISCH_TAC THEN + ABBREV_TAC `k = gc - (g:real^1->real^1) c` THEN + SUBGOAL_THEN `hc - (h:real^1->real^1) c = k` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `hc' - hc:real^1 = gc' - gc <=> gc' - hc' = gc - hc`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_WITHIN]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + LIM_UNIQUE) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ASM_SIMP_TAC[LIM_SUB]; + ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`g':real^1->real^1 = \x. if drop c <= drop x then g(x) + k else g(x)`; + `h':real^1->real^1 = \x. if drop c <= drop x then h(x) + k else h(x)`] THEN + SUBGOAL_THEN + `(!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ drop x <= drop y + ==> drop(g' x) <= drop(g' y)) /\ + (!x y. x IN interval[a,c] /\ y IN interval[a,c] /\ drop x <= drop y + ==> drop(h' x) <= drop(h' y))` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + (ASM_CASES_TAC `drop c <= drop x` THENL + [SUBGOAL_THEN `drop c <= drop y` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[DROP_ADD; REAL_LE_RADD] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC] THEN + SUBGOAL_THEN `y:real^1 = c` SUBST_ALL_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `gc - g c = k + ==> b <= drop(g c + (gc - g c)) ==> b <= drop(g c + k)`)) THEN + REWRITE_TAC[VECTOR_ARITH `a + b - a:real^1 = b`] THEN + MATCH_MP_TAC(ISPEC `at c within interval[a:real^1,c]` + LIM_DROP_LBOUND)) + THENL [EXISTS_TAC `g:real^1->real^1`; EXISTS_TAC `h:real^1->real^1`] THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN + EXISTS_TAC `drop c - drop x` THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN + REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(g':real^1->real^1) continuous (at c within interval[a,c]) /\ + (h':real^1->real^1) continuous (at c within interval[a,c])` + MP_TAC THENL + [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; REAL_LE_REFL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH + `g - g':real^1 = k <=> g' + k = g`]) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN + MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN + REWRITE_TAC[LIM_WITHIN; DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN + SIMP_TAC[REAL_ARITH `x <= c /\ &0 < abs(x - c) ==> ~(c <= x)`] THEN + REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN + MESON_TAC[REAL_LT_01]; + ALL_TAC] THEN + REWRITE_TAC[continuous_within] THEN + REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN + DISCH_THEN(fun th -> + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`) th) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `d:real^1` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `c:real^1`; `d:real^1`] + VECTOR_VARIATION_COMBINE) THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[REAL_ARITH `abs(a - (a + b)) = abs b`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < a ==> abs x < a`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `f:real^1->real^1 = \x. g' x - h' x` SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g':real^1->real^1`; `\x. --((h':real^1->real^1) x)`; + `interval[d:real^1,c]`] VECTOR_VARIATION_TRIANGLE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NEG] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN + EXISTS_TAC `interval[a:real^1,c]` THEN + ASM_SIMP_TAC[INCREASING_BOUNDED_VARIATION; SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[VECTOR_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `y < a / &2 /\ z < a / &2 ==> x <= y + z ==> x < a`) THEN + REWRITE_TAC[VECTOR_VARIATION_NEG] THEN CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) + INCREASING_VECTOR_VARIATION o lhand o snd) THEN + (ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1; REAL_NOT_LT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC]) THEN + MATCH_MP_TAC(REAL_ARITH `abs(x - y) < e ==> y - x < e`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let VECTOR_VARIATION_CONTINUOUS_RIGHT = prove + (`!f:real^1->real^1 a b c. + f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] + ==> ((\x. lift(vector_variation(interval[a,x]) f)) + continuous (at c within interval[c,b]) <=> + f continuous (at c within interval[c,b]))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[continuous_within] THEN + REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + REWRITE_TAC[GSYM DROP_SUB] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `x:real^1`; `c:real^1`] + VECTOR_VARIATION_COMBINE) THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH `abs((a + b) - a) = abs b`] THEN + REWRITE_TAC[drop; GSYM NORM_REAL] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs a`) THEN + MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)); + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC] THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN ASM_CASES_TAC `c limit_point_of interval[c:real^1,b]` THENL + [ALL_TAC; + ASM_REWRITE_TAC[CONTINUOUS_WITHIN; LIM; TRIVIAL_LIMIT_WITHIN]] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] + INCREASING_RIGHT_LIMIT_1) THEN + MP_TAC(ISPECL [`g:real^1->real^1`; `a:real^1`; `b:real^1`; `c:real^1`] + INCREASING_RIGHT_LIMIT_1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `gc:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `hc:real^1` THEN DISCH_TAC THEN + ABBREV_TAC `k = gc - (g:real^1->real^1) c` THEN + SUBGOAL_THEN `hc - (h:real^1->real^1) c = k` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `hc' - hc:real^1 = gc' - gc <=> gc' - hc' = gc - hc`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_WITHIN]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + LIM_UNIQUE) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ASM_SIMP_TAC[LIM_SUB]; + ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`g':real^1->real^1 = \x. if drop x <= drop c then g(x) + k else g(x)`; + `h':real^1->real^1 = \x. if drop x <= drop c then h(x) + k else h(x)`] THEN + SUBGOAL_THEN + `(!x y. x IN interval[c,b] /\ y IN interval[c,b] /\ drop x <= drop y + ==> drop(g' x) <= drop(g' y)) /\ + (!x y. x IN interval[c,b] /\ y IN interval[c,b] /\ drop x <= drop y + ==> drop(h' x) <= drop(h' y))` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + (ASM_CASES_TAC `drop y <= drop c` THENL + [SUBGOAL_THEN `drop x <= drop c` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[DROP_ADD; REAL_LE_RADD] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC] THEN + SUBGOAL_THEN `x:real^1 = c` SUBST_ALL_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `gc - g c = k + ==> drop(g c + (gc - g c)) <= b ==> drop(g c + k) <= b`)) THEN + REWRITE_TAC[VECTOR_ARITH `a + b - a:real^1 = b`] THEN + MATCH_MP_TAC(ISPEC `at c within interval[c:real^1,b]` + LIM_DROP_UBOUND)) + THENL [EXISTS_TAC `g:real^1->real^1`; EXISTS_TAC `h:real^1->real^1`] THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN + EXISTS_TAC `drop y - drop c` THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN + REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(g':real^1->real^1) continuous (at c within interval[c,b]) /\ + (h':real^1->real^1) continuous (at c within interval[c,b])` + MP_TAC THENL + [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; REAL_LE_REFL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_ARITH + `g - g':real^1 = k <=> g' + k = g`]) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM)) THEN + MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN + REWRITE_TAC[LIM_WITHIN; DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN + SIMP_TAC[REAL_ARITH `c <= x /\ &0 < abs(x - c) ==> ~(x <= c)`] THEN + REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN + MESON_TAC[REAL_LT_01]; + ALL_TAC] THEN + REWRITE_TAC[continuous_within] THEN + REWRITE_TAC[DIST_LIFT; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN + DISCH_THEN(fun th -> + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`) th) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `d:real^1` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `d:real^1`; `c:real^1`] + VECTOR_VARIATION_COMBINE) THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[REAL_ARITH `(a + b) - a:real = b`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < a ==> abs x < a`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VECTOR_VARIATION_POS_LE THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `f:real^1->real^1 = \x. g' x - h' x` SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["g'"; "h'"] THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g':real^1->real^1`; `\x. --((h':real^1->real^1) x)`; + `interval[c:real^1,d]`] VECTOR_VARIATION_TRIANGLE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NEG] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUBSET THEN + EXISTS_TAC `interval[c:real^1,b]` THEN + ASM_SIMP_TAC[INCREASING_BOUNDED_VARIATION; SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[VECTOR_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `y < a / &2 /\ z < a / &2 ==> x <= y + z ==> x < a`) THEN + REWRITE_TAC[VECTOR_VARIATION_NEG] THEN CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) + INCREASING_VECTOR_VARIATION o lhand o snd) THEN + (ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REWRITE_TAC[INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1; REAL_NOT_LT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC]) THEN + MATCH_MP_TAC(REAL_ARITH `abs x < e ==> x < e`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let VECTOR_VARIATION_CONTINUOUS = prove + (`!f:real^1->real^1 a b c. + f has_bounded_variation_on interval[a,b] /\ c IN interval[a,b] + ==> ((\x. lift(vector_variation(interval[a,x]) f)) + continuous (at c within interval[a,b]) <=> + f continuous (at c within interval[a,b]))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!f:real^1->real^1. + f continuous (at c within interval[a,b]) <=> + f continuous (at c within interval[a,c]) /\ + f continuous (at c within interval[c,b])` + (fun th -> REWRITE_TAC[th] THEN + ASM_MESON_TAC[VECTOR_VARIATION_CONTINUOUS_LEFT; + VECTOR_VARIATION_CONTINUOUS_RIGHT]) THEN + GEN_TAC THEN REWRITE_TAC[CONTINUOUS_WITHIN] THEN EQ_TAC THENL + [DISCH_THEN(ASSUME_TAC o GEN_ALL o + MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_WITHIN_SUBSET)) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; + DISCH_THEN(MP_TAC o MATCH_MP LIM_UNION) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LIM_WITHIN_SUBSET)] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC);; + +let HAS_BOUNDED_VARIATION_DARBOUX_STRONG = prove + (`!f a b. + f has_bounded_variation_on interval[a,b] + ==> ?g h. (!x. f x = g x - h x) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ + drop x <= drop y + ==> drop(g x) <= drop(g y)) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ + drop x <= drop y + ==> drop(h x) <= drop(h y)) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ + drop x < drop y + ==> drop(g x) < drop(g y)) /\ + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ + drop x < drop y + ==> drop(h x) < drop(h y)) /\ + (!x. x IN interval[a,b] /\ + f continuous (at x within interval[a,x]) + ==> g continuous (at x within interval[a,x]) /\ + h continuous (at x within interval[a,x])) /\ + (!x. x IN interval[a,b] /\ + f continuous (at x within interval[x,b]) + ==> g continuous (at x within interval[x,b]) /\ + h continuous (at x within interval[x,b])) /\ + (!x. x IN interval[a,b] /\ + f continuous (at x within interval[a,b]) + ==> g continuous (at x within interval[a,b]) /\ + h continuous (at x within interval[a,b]))`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`\x:real^1. x + lift(vector_variation (interval[a,x]) (f:real^1->real^1))`; + `\x:real^1. x + lift(vector_variation (interval[a,x]) f) - f x`] THEN + REWRITE_TAC[VECTOR_ARITH `(x + l) - (x + l - f):real^1 = f`] THEN + REWRITE_TAC[LIFT_DROP; DROP_SUB; DROP_ADD] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC VECTOR_VARIATION_MONOTONE; + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN + EXISTS_TAC `drop(f(a:real^1))` THEN + REWRITE_TAC[GSYM DROP_SUB] THEN + MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC VECTOR_VARIATION_MONOTONE; + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN + EXISTS_TAC `drop(f(a:real^1))` THEN + REWRITE_TAC[GSYM DROP_SUB] THEN + MATCH_MP_TAC VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; + MATCH_MP_TAC CONTINUOUS_ADD THEN + REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] + VECTOR_VARIATION_CONTINUOUS_LEFT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_ADD THEN + REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] + VECTOR_VARIATION_CONTINUOUS_LEFT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_ADD THEN + REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] + VECTOR_VARIATION_CONTINUOUS_RIGHT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_ADD THEN + REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] + VECTOR_VARIATION_CONTINUOUS_RIGHT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_ADD THEN + REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] + VECTOR_VARIATION_CONTINUOUS) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_ADD THEN + REWRITE_TAC[CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`; `x:real^1`] + VECTOR_VARIATION_CONTINUOUS) THEN + ASM_REWRITE_TAC[]] THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)); + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_EQ_EMPTY_1] THEN + ASM_REAL_ARITH_TAC));; + +let HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES = prove + (`!f:real^1->real^1 a b. + f has_bounded_variation_on interval[a,b] + ==> COUNTABLE {x | x IN interval[a,b] /\ ~(f continuous at x)}`, + SUBGOAL_THEN + `!f a b. + (!x y. x IN interval[a,b] /\ y IN interval[a,b] /\ drop x <= drop y + ==> drop(f x) <= drop(f y)) + ==> COUNTABLE {x | x IN interval[a,b] /\ ~(f continuous at x)}` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(ISPECL [`g:real^1->real^1`; `a:real^1`; `b:real^1`] th) THEN + MP_TAC(ISPECL [`h:real^1->real^1`; `a:real^1`; `b:real^1`] th)) THEN + ASM_REWRITE_TAC[IMP_IMP; GSYM COUNTABLE_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(TAUT + `(p /\ q ==> r) ==> a /\ ~r ==> a /\ ~p \/ a /\ ~q`) THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ASM_SIMP_TAC[CONTINUOUS_SUB]] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; COUNTABLE_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_EQ_EMPTY_1; REAL_NOT_LT]) THEN + ASM_SIMP_TAC[CLOSED_OPEN_INTERVAL_1] THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC + `a INSERT b INSERT + {x | x IN interval(a,b) /\ ~((f:real^1->real^1) continuous at x)}` THEN + CONJ_TAC THENL [REWRITE_TAC[COUNTABLE_INSERT]; SET_TAC[]] THEN + SUBGOAL_THEN + `(!c:real^1. c IN interval(a,b) ==> c limit_point_of interval[a,c]) /\ + (!c:real^1. c IN interval(a,b) ==> c limit_point_of interval[c,b])` + STRIP_ASSUME_TAC THENL + [SIMP_TAC[IN_INTERVAL_1; REAL_LE_REFL; LIMPT_OF_CONVEX; + CONVEX_INTERVAL; REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM INTERVAL_SING; GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] + INCREASING_LEFT_LIMIT_1) THEN + ASM_REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real^1->real^1` (LABEL_TAC "l")) THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `a:real^1`; `b:real^1`] + INCREASING_RIGHT_LIMIT_1) THEN + ASM_REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^1` (LABEL_TAC "r")) THEN + SUBGOAL_THEN + `!c. c IN interval(a:real^1,b) + ==> drop(l c) <= drop(f c) /\ drop(f c) <= drop(r c)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(ISPEC `at c within interval[a:real^1,c]` + LIM_DROP_UBOUND); + MATCH_MP_TAC(ISPEC `at c within interval[c:real^1,b]` + LIM_DROP_LBOUND)] THEN + EXISTS_TAC `f:real^1->real^1` THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED; + TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; IN_INTERVAL_1] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(!c x. c IN interval(a:real^1,b) /\ x IN interval[a,b] /\ drop x < drop c + ==> drop(f x) <= drop(l c)) /\ + (!c x. c IN interval(a:real^1,b) /\ x IN interval[a,b] /\ drop c < drop x + ==> drop(r c) <= drop(f x))` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(ISPEC `at c within interval[a:real^1,c]` + LIM_DROP_LBOUND); + MATCH_MP_TAC(ISPEC `at c within interval[c:real^1,b]` + LIM_DROP_UBOUND)] THEN + EXISTS_TAC `f:real^1->real^1` THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED; + TRIVIAL_LIMIT_WITHIN; EVENTUALLY_WITHIN] + THENL + [EXISTS_TAC `drop c - drop x`; EXISTS_TAC `drop x - drop c`] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; DIST_REAL; GSYM drop] THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[COUNTABLE; ge_c] THEN + TRANS_TAC CARD_LE_TRANS `rational` THEN + GEN_REWRITE_TAC RAND_CONV [GSYM ge_c] THEN + REWRITE_TAC[COUNTABLE_RATIONAL; GSYM COUNTABLE; le_c] THEN + SUBGOAL_THEN + `!c. c IN interval(a,b) /\ ~((f:real^1->real^1) continuous at c) + ==> drop(l(c:real^1)) < drop(r c)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN + SUBGOAL_THEN `l c = (f:real^1->real^1) c /\ r c = f c` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONTINUOUS_AT]) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `((f:real^1->real^1) --> f c) (at c within interval(a,b))` + MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[OPEN_INTERVAL; LIM_WITHIN_OPEN]] THEN + MATCH_MP_TAC LIM_WITHIN_SUBSET THEN + EXISTS_TAC `interval[a:real^1,c] UNION interval[c,b]` THEN + REWRITE_TAC[LIM_WITHIN_UNION] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REWRITE_RULE[SUBSET] INTERVAL_OPEN_SUBSET_CLOSED]; + REWRITE_TAC[SUBSET; IN_UNION; IN_INTERVAL_1] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!c. c IN interval(a,b) /\ ~((f:real^1->real^1) continuous at c) + ==> ?q. rational q /\ drop(l c) < q /\ q < drop(r c)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `drop(l(c:real^1)) < drop(r c)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`(drop(l(c:real^1)) + drop(r c)) / &2`; + `(drop(r c) - drop(l(c:real^1))) / &2`] + RATIONAL_APPROXIMATION) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_SUB_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_INTERVAL_1] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real` THEN + SIMP_TAC[IN] THEN DISCH_THEN(LABEL_TAC "*") THEN + MATCH_MP_TAC(MESON[REAL_LE_TOTAL] + `(!x y. P x y ==> P y x) /\ (!x y. drop x <= drop y ==> P x y) + ==> !x y. P x y`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[REAL_LE_LT; DROP_EQ] THEN + ASM_CASES_TAC `x:real^1 = y` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `q(x:real^1) < q(y)` MP_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[REAL_LT_REFL]] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `drop(r(x:real^1))` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `drop(l(y:real^1))` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(f(inv(&2) % (x + y):real^1))` THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_ADD] THEN + ASM_REAL_ARITH_TAC);; + +let HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE = prove + (`!f:real^1->real^N s a b. + COUNTABLE s /\ f continuous_on interval[a,b] /\ + (!x. x IN interval[a,b] DIFF s ==> f differentiable at x) + ==> (f has_bounded_variation_on interval[a,b] <=> + (\x. vector_derivative f (at x)) + absolutely_integrable_on interval[a,b])`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ] THEN + REWRITE_TAC[has_bounded_variation_on] THEN + MATCH_MP_TAC(TAUT `q /\ (p <=> r) ==> (p <=> q /\ r)`) THEN CONJ_TAC THENL + [ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN + ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN + MP_TAC(ISPECL [`f:real^1->real^N`; + `\x. vector_derivative (f:real^1->real^N) (at x)`; + `s:real^1->bool`; `a:real^1`; `b:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG) THEN + ASM_MESON_TAC[VECTOR_DERIVATIVE_WORKS; integrable_on; + HAS_VECTOR_DERIVATIVE_AT_WITHIN]; + MATCH_MP_TAC(MESON[HAS_BOUNDED_SETVARIATION_ON_EQ] + `(!a b. ~(interval[a,b] = {}) /\ interval[a,b] SUBSET s + ==> f(interval[a,b]) = g(interval[a,b])) + ==> (f has_bounded_setvariation_on s <=> + g has_bounded_setvariation_on s)`) THEN + SIMP_TAC[INTERVAL_UPPERBOUND; INTERVAL_LOWERBOUND; + GSYM INTERVAL_NE_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN + REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^N`; + `\x. vector_derivative (f:real^1->real^N) (at x)`; + `s:real^1->bool`; `u:real^1`; `v:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG) THEN + ASM_REWRITE_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[INTEGRAL_UNIQUE]] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; IN_DIFF; SUBSET]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + ASM_SIMP_TAC[GSYM VECTOR_DERIVATIVE_WORKS] THEN ASM SET_TAC[]]]);; + +let HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE = prove + (`!f:real^1->real^N s a b. + COUNTABLE s /\ f continuous_on interval[a,b] /\ + (!x. x IN interval[a,b] DIFF s ==> f differentiable at x) + ==> (f has_bounded_variation_on interval[a,b] <=> + (\x. lift(norm(vector_derivative f (at x)))) + integrable_on interval[a,b])`, + REPEAT GEN_TAC THEN DISCH_THEN(fun th -> + STRIP_ASSUME_TAC th THEN + REWRITE_TAC[MATCH_MP HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE + th]) THEN + REWRITE_TAC[absolutely_integrable_on] THEN + MATCH_MP_TAC(TAUT `p ==> (p /\ q <=> q)`) THEN + ASM_CASES_TAC `interval[a:real^1,b] = {}` THEN + ASM_REWRITE_TAC[INTEGRABLE_ON_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN + MP_TAC(ISPECL [`f:real^1->real^N`; + `\x. vector_derivative (f:real^1->real^N) (at x)`; + `s:real^1->bool`; `a:real^1`; `b:real^1`] + FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG) THEN + ASM_MESON_TAC[VECTOR_DERIVATIVE_WORKS; integrable_on; + HAS_VECTOR_DERIVATIVE_AT_WITHIN]);; + +let VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE = prove + (`!f:real^1->real^N s a b. + COUNTABLE s /\ f continuous_on interval[a,b] /\ + (!x. x IN interval[a,b] DIFF s ==> f differentiable at x) /\ + f has_bounded_variation_on interval[a,b] + ==> vector_variation (interval[a,b]) f = + drop(integral (interval[a,b]) + (\x. lift(norm(vector_derivative f (at x)))))`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`f:real^1->real^N`; `s:real^1->bool`; `a:real^1`; `b:real^1`] + HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_SET_VARIATION) THEN + REWRITE_TAC[vector_variation] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SET_VARIATION_EQ THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN + SIMP_TAC[INTERVAL_NE_EMPTY_1; INTERVAL_LOWERBOUND_1; + INTERVAL_UPPERBOUND_1] THEN + STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG THEN + EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + ASM_MESON_TAC[VECTOR_DERIVATIVE_WORKS; HAS_VECTOR_DERIVATIVE_AT_WITHIN; + IN_DIFF; SUBSET]);; + +let INTEGRABLE_BOUNDED_VARIATION_PRODUCT = prove + (`!f:real^1->real^N g a b. + f integrable_on interval[a,b] /\ + g has_bounded_variation_on interval[a,b] + ==> (\x. drop(g x) % f x) integrable_on interval[a,b]`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [HAS_BOUNDED_VARIATION_DARBOUX]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^1->real^1`; `k:real^1->real^1`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[DROP_SUB; VECTOR_SUB_RDISTRIB] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_INCREASING_PRODUCT THEN + ASM_REWRITE_TAC[]);; + +let INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT = prove + (`!f:real^1->real^N g a b. + f integrable_on interval[a,b] /\ + (lift o g) has_bounded_variation_on interval[a,b] + ==> (\x. g x % f x) integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_BOUNDED_VARIATION_PRODUCT) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT = prove + (`!f:real^1->real^N a b. + f absolutely_integrable_on interval[a,b] + ==> (\c. integral (interval[a,c]) f) has_bounded_variation_on + interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_variation_on] THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN + SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; LIFT_EQ; + INTERVAL_UPPERBOUND_NONEMPTY] THEN + SIMP_TAC[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1; GSYM REAL_NOT_LE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH + `a:real^N = b - c <=> c + a = b`] THEN + MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_ON_SUBINTERVAL) THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; + +let HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT = prove + (`!f:real^1->real^N a b. + f absolutely_integrable_on interval[a,b] + ==> (\c. integral (interval[c,b]) f) has_bounded_variation_on + interval[a,b]`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_bounded_variation_on] THEN + ONCE_REWRITE_TAC[GSYM HAS_BOUNDED_SETVARIATION_ON_NEG] THEN + FIRST_ASSUM(MP_TAC o + MATCH_MP ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_SETVARIATION_ON_EQ) THEN + SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; LIFT_EQ; + INTERVAL_UPPERBOUND_NONEMPTY] THEN + SIMP_TAC[INTERVAL_NE_EMPTY_1; SUBSET_INTERVAL_1; GSYM REAL_NOT_LE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[VECTOR_ARITH + `a:real^N = --(b - c) <=> a + b = c`] THEN + MATCH_MP_TAC INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] INTEGRABLE_ON_SUBINTERVAL) THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Rectifiable paths and path length defined using variation. *) +(* ------------------------------------------------------------------------- *) + +let rectifiable_path = new_definition + `rectifiable_path (g:real^1->real^N) <=> + path g /\ g has_bounded_variation_on interval[vec 0,vec 1]`;; + +let path_length = new_definition + `path_length (g:real^1->real^N) = + vector_variation (interval[vec 0,vec 1]) g`;; + +let BOUNDED_RECTIFIABLE_PATH_IMAGE = prove + (`!g:real^1->real^N. rectifiable_path g ==> bounded(path_image g)`, + SIMP_TAC[rectifiable_path; BOUNDED_PATH_IMAGE]);; + +let RECTIFIABLE_PATH_IMP_PATH = prove + (`!g:real^1->real^N. rectifiable_path g ==> path g`, + SIMP_TAC[rectifiable_path]);; + +let RECTIFIABLE_PATH_LINEPATH = prove + (`!a b:real^N. rectifiable_path(linepath(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[rectifiable_path; PATH_LINEPATH] THEN + REWRITE_TAC[linepath] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_ADD THEN + REWRITE_TAC[GSYM DROP_VEC; GSYM DROP_SUB] THEN + CONJ_TAC THEN MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_MUL THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CONST] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_ID] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_SUB THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_CONST] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_ID]);; + +let RECTIFIABLE_PATH_REVERSEPATH = prove + (`!g:real^1->real^N. rectifiable_path(reversepath g) <=> rectifiable_path g`, + SUBGOAL_THEN + `!g:real^1->real^N. rectifiable_path g ==> rectifiable_path(reversepath g)` + (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN + GEN_TAC THEN REWRITE_TAC[rectifiable_path] THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[PATH_REVERSEPATH] THEN + REWRITE_TAC[reversepath] THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_COMPOSE_DECREASING THEN + ASM_REWRITE_TAC[DROP_SUB; VECTOR_SUB_RZERO; VECTOR_SUB_REFL] THEN + REAL_ARITH_TAC);; + +let PATH_LENGTH_REVERSEPATH = prove + (`!g:real^1->real^N. path_length(reversepath g) = path_length g`, + GEN_TAC THEN REWRITE_TAC[path_length; reversepath] THEN + REWRITE_TAC[VECTOR_SUB; VECTOR_VARIATION_REFLECT] THEN + REWRITE_TAC[VECTOR_VARIATION_TRANSLATION] THEN + REWRITE_TAC[REFLECT_INTERVAL; GSYM INTERVAL_TRANSLATION] THEN + REWRITE_TAC[GSYM VECTOR_SUB; VECTOR_SUB_REFL; VECTOR_SUB_RZERO]);; + +let RECTIFIABLE_PATH_SUBPATH = prove + (`!u v g:real^1->real^N. + rectifiable_path g /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] + ==> rectifiable_path(subpath u v g)`, + REPEAT GEN_TAC THEN SIMP_TAC[PATH_SUBPATH; rectifiable_path] THEN + STRIP_TAC THEN REWRITE_TAC[subpath] THEN + ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_AFFINITY_EQ; IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[UNIT_INTERVAL_NONEMPTY; DROP_SUB; REAL_SUB_LE; REAL_SUB_0] THEN + DISJ2_TAC THEN COND_CASES_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_REAL_ARITH_TAC);; + +let RECTIFIABLE_PATH_JOIN = prove + (`!g1 g2:real^1->real^N. + pathfinish g1 = pathstart g2 + ==> (rectifiable_path(g1 ++ g2) <=> + rectifiable_path g1 /\ rectifiable_path g2)`, + REPEAT GEN_TAC THEN SIMP_TAC[rectifiable_path; PATH_JOIN] THEN + REWRITE_TAC[pathfinish; pathstart] THEN DISCH_TAC THEN + ASM_CASES_TAC `path(g1:real^1->real^N)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `path(g2:real^1->real^N)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`g1 ++ g2:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; + `lift(&1 / &2)`] + HAS_BOUNDED_VARIATION_ON_COMBINE) THEN + REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[joinpaths] THEN BINOP_TAC THEN + MATCH_MP_TAC EQ_TRANS THENL + [EXISTS_TAC + `(\x. (g1:real^1->real^N)(&2 % x)) has_bounded_variation_on + interval [vec 0,lift(&1 / &2)]` THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x:real^N = &2 % x + vec 0`]; + EXISTS_TAC + `(\x. (g2:real^1->real^N)(&2 % x - vec 1)) has_bounded_variation_on + interval [lift (&1 / &2),vec 1]` THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x - v:real^N = &2 % x + --v`]] THEN + (CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[HAS_BOUNDED_VARIATION_AFFINITY_EQ] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; INTERVAL_EQ_EMPTY_1] THEN + REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ; GSYM DROP_EQ] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP; DROP_VEC; DROP_NEG] THEN + REAL_ARITH_TAC]) THEN + MATCH_MP_TAC(MESON[HAS_BOUNDED_VARIATION_ON_EQ] + `(!x. x IN s ==> f x = g x) + ==> (f has_bounded_variation_on s <=> + g has_bounded_variation_on s)`) THEN + SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN X_GEN_TAC `x:real^1` THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 % x + --vec 1:real^1 = vec 0 /\ &2 % x = vec 1` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[VECTOR_SUB_EQ; GSYM VECTOR_SUB] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC);; + +let RECTIFIABLE_PATH_JOIN_IMP = prove + (`!g1 g2:real^1->real^N. + rectifiable_path g1 /\ rectifiable_path g2 /\ + pathfinish g1 = pathstart g2 + ==> rectifiable_path(g1 ++ g2)`, + SIMP_TAC[RECTIFIABLE_PATH_JOIN]);; + +let RECTIFIABLE_PATH_JOIN_EQ = prove + (`!g1 g2:real^1->real^N. + rectifiable_path g1 /\ rectifiable_path g2 + ==> (rectifiable_path (g1 ++ g2) <=> pathfinish g1 = pathstart g2)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[RECTIFIABLE_PATH_JOIN_IMP] THEN + DISCH_TAC THEN MATCH_MP_TAC PATH_JOIN_PATH_ENDS THEN + ASM_SIMP_TAC[RECTIFIABLE_PATH_IMP_PATH]);; + +let PATH_LENGTH_JOIN = prove + (`!g1 g2:real^1->real^N. + rectifiable_path g1 /\ rectifiable_path g2 /\ + pathfinish g1 = pathstart g2 + ==> path_length(g1 ++ g2) = path_length g1 + path_length g2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[path_length] THEN + MP_TAC(ISPECL [`g1 ++ g2:real^1->real^N`; `vec 0:real^1`; `vec 1:real^1`; + `lift(&1 / &2)`] + VECTOR_VARIATION_COMBINE) THEN + REWRITE_TAC[DROP_VEC; LIFT_DROP] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ANTS_TAC THENL + [ASM_MESON_TAC[rectifiable_path; RECTIFIABLE_PATH_JOIN_IMP]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `vector_variation (interval [vec 0,lift (&1 / &2)]) + (\x. (g1:real^1->real^N)(&2 % x)) + + vector_variation (interval [lift (&1 / &2),vec 1]) + (\x. (g2:real^1->real^N)(&2 % x - vec 1))` THEN + CONJ_TAC THENL + [BINOP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_EQ THEN + SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; joinpaths] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathfinish; pathstart]) THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 % x - vec 1:real^1 = vec 0 /\ &2 % x = vec 1` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN ASM_REAL_ARITH_TAC; + ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x:real^N = &2 % x + vec 0`] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `(&2 % x + vec 0) - v:real^N = &2 % x + --v`] THEN + REWRITE_TAC[VECTOR_VARIATION_AFFINITY; IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN BINOP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CONS_11; PAIR_EQ; GSYM DROP_EQ] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP; DROP_VEC; DROP_NEG] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Useful equivalent formulations where the path is differentiable. *) +(* ------------------------------------------------------------------------- *) + +let RECTIFIABLE_PATH_DIFFERENTIABLE = prove + (`!g:real^1->real^N s. + COUNTABLE s /\ path g /\ + (!t. t IN interval[vec 0,vec 1] DIFF s ==> g differentiable at t) + ==> (rectifiable_path g <=> + (\t. vector_derivative g (at t)) + absolutely_integrable_on interval[vec 0,vec 1])`, + SIMP_TAC[rectifiable_path] THEN REWRITE_TAC[path] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE THEN + EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[]);; + +let PATH_LENGTH_DIFFERENTIABLE = prove + (`!g:real^1->real^N s. + COUNTABLE s /\ rectifiable_path g /\ + (!t. t IN interval[vec 0,vec 1] DIFF s ==> g differentiable at t) + ==> path_length g = + drop(integral (interval[vec 0,vec 1]) + (\t. lift(norm(vector_derivative g (at t)))))`, + REWRITE_TAC[rectifiable_path; path_length; path] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE THEN + EXISTS_TAC `s:real^1->bool` THEN ASM_REWRITE_TAC[]);; diff --git a/Multivariate/make.ml b/Multivariate/make.ml new file mode 100644 index 0000000..1a6773d --- /dev/null +++ b/Multivariate/make.ml @@ -0,0 +1,36 @@ +(* ========================================================================= *) +(* Theory of multivariate calculus in Euclidean space. *) +(* ========================================================================= *) + +loadt "Library/card.ml";; (* For countable set theorems. *) +loadt "Library/permutations.ml";; (* For determinants *) +loadt "Library/products.ml";; (* For determinants and integrals *) +loadt "Library/floor.ml";; (* Useful here and there *) +loadt "Multivariate/misc.ml";; (* Background stuff *) + +(* ------------------------------------------------------------------------- *) +(* The main core theory. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/vectors.ml";; (* Basic vectors, linear algebra *) +loadt "Multivariate/determinants.ml";; (* Determinant and trace *) +loadt "Multivariate/topology.ml";; (* Basic topological notions *) +loadt "Multivariate/convex.ml";; (* Convex sets and functions *) +loadt "Multivariate/paths.ml";; (* Paths, simple connectedness etc. *) +loadt "Multivariate/polytope.ml";; (* Faces, polytopes, polyhedra etc. *) +loadt "Multivariate/dimension.ml";; (* Dimensional theorems *) +loadt "Multivariate/derivatives.ml";; (* Derivatives *) + +(* ------------------------------------------------------------------------- *) +(* Work in progress. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/clifford.ml";; (* Geometric (Clifford) algebra *) +loadt "Multivariate/integration.ml";; (* Integration *) +loadt "Multivariate/measure.ml";; (* Lebesgue measure *) + +(* ------------------------------------------------------------------------- *) +(* Updated database, for convenience where dynamic updating doesn't work. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/multivariate_database.ml";; diff --git a/Multivariate/make_complex.ml b/Multivariate/make_complex.ml new file mode 100644 index 0000000..0d695e4 --- /dev/null +++ b/Multivariate/make_complex.ml @@ -0,0 +1,49 @@ +(* ========================================================================= *) +(* Theory of multivariate calculus in Euclidean space. *) +(* ========================================================================= *) + +loadt "Library/card.ml";; (* For countable set theorems. *) +loadt "Library/permutations.ml";; (* For determinants *) +loadt "Library/products.ml";; (* For determinants and integrals *) +loadt "Library/floor.ml";; (* Useful here and there *) +loadt "Multivariate/misc.ml";; (* Background stuff *) +loadt "Library/binomial.ml";; (* For Leibniz deriv formula etc. *) +loadt "Library/iter.ml";; (* n-fold iteration of function *) + +(* ------------------------------------------------------------------------- *) +(* The main core theory. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/vectors.ml";; (* Basic vectors, linear algebra *) +loadt "Multivariate/determinants.ml";; (* Determinant and trace *) +loadt "Multivariate/topology.ml";; (* Basic topological notions *) +loadt "Multivariate/convex.ml";; (* Convex sets and functions *) +loadt "Multivariate/paths.ml";; (* Paths, simple connectedness etc. *) +loadt "Multivariate/polytope.ml";; (* Faces, polytopes, polyhedra etc. *) +loadt "Multivariate/dimension.ml";; (* Dimensional theorems *) +loadt "Multivariate/derivatives.ml";; (* Derivatives *) + +(* ------------------------------------------------------------------------- *) +(* Work in progress. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/clifford.ml";; (* Geometric (Clifford) algebra *) +loadt "Multivariate/integration.ml";; (* Integration *) +loadt "Multivariate/measure.ml";; (* Lebesgue measure *) + +(* ------------------------------------------------------------------------- *) +(* Complex numbers (as R^2) and complex analysis. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/complexes.ml";; (* Complex numbers *) +loadt "Multivariate/canal.ml";; (* Complex analysis *) +loadt "Multivariate/transcendentals.ml";; (* Real & complex transcendentals *) +loadt "Multivariate/realanalysis.ml";; (* Some analytical stuff on R *) +loadt "Multivariate/moretop.ml";; (* Further topological results *) +loadt "Multivariate/cauchy.ml";; (* Complex line integrals *) + +(* ------------------------------------------------------------------------- *) +(* Updated database, for convenience where dynamic updating doesn't work. *) +(* ------------------------------------------------------------------------- *) + +loadt "Multivariate/complex_database.ml";; diff --git a/Multivariate/measure.ml b/Multivariate/measure.ml new file mode 100644 index 0000000..b651fc3 --- /dev/null +++ b/Multivariate/measure.ml @@ -0,0 +1,13308 @@ +(* ========================================================================= *) +(* Lebesgue measure, measurable functions (defined via the gauge integral). *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Library/card.ml";; +needs "Library/permutations.ml";; +needs "Multivariate/integration.ml";; +needs "Multivariate/determinants.ml";; +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* Lebesgue measure in the case where the measure is finite. This is our *) +(* default notion of "measurable", but we also define "lebesgue_measurable" *) +(* further down. Note that in neither case do we assume the set is bounded. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_measure",(12,"right"));; + +let has_measure = new_definition + `s has_measure m <=> ((\x. vec 1) has_integral (lift m)) s`;; + +let measurable = new_definition + `measurable s <=> ?m. s has_measure m`;; + +let measure = new_definition + `measure s = @m. s has_measure m`;; + +let HAS_MEASURE_MEASURE = prove + (`!s. measurable s <=> s has_measure (measure s)`, + REWRITE_TAC[measure; measurable] THEN MESON_TAC[]);; + +let HAS_MEASURE_UNIQUE = prove + (`!s m1 m2. s has_measure m1 /\ s has_measure m2 ==> m1 = m2`, + REWRITE_TAC[has_measure; GSYM LIFT_EQ] THEN MESON_TAC[HAS_INTEGRAL_UNIQUE]);; + +let MEASURE_UNIQUE = prove + (`!s m. s has_measure m ==> measure s = m`, + MESON_TAC[HAS_MEASURE_UNIQUE; HAS_MEASURE_MEASURE; measurable]);; + +let HAS_MEASURE_MEASURABLE_MEASURE = prove + (`!s m. s has_measure m <=> measurable s /\ measure s = m`, + REWRITE_TAC[HAS_MEASURE_MEASURE] THEN MESON_TAC[MEASURE_UNIQUE]);; + +let HAS_MEASURE_IMP_MEASURABLE = prove + (`!s m. s has_measure m ==> measurable s`, + REWRITE_TAC[measurable] THEN MESON_TAC[]);; + +let HAS_MEASURE = prove + (`!s m. s has_measure m <=> + ((\x. if x IN s then vec 1 else vec 0) has_integral (lift m)) + (:real^N)`, + SIMP_TAC[HAS_INTEGRAL_RESTRICT_UNIV; has_measure]);; + +let MEASURABLE = prove + (`!s. measurable s <=> (\x. vec 1:real^1) integrable_on s`, + REWRITE_TAC[measurable; integrable_on; + has_measure; EXISTS_DROP; LIFT_DROP]);; + +let MEASURABLE_INTEGRABLE = prove + (`measurable s <=> + (\x. if x IN s then vec 1 else vec 0:real^1) integrable_on UNIV`, + REWRITE_TAC[measurable; integrable_on; + HAS_MEASURE; EXISTS_DROP; LIFT_DROP]);; + +let MEASURE_INTEGRAL = prove + (`!s. measurable s ==> measure s = drop (integral s (\x. vec 1))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + ASM_REWRITE_TAC[GSYM has_measure; GSYM HAS_MEASURE_MEASURE]);; + +let MEASURE_INTEGRAL_UNIV = prove + (`!s. measurable s + ==> measure s = + drop(integral UNIV (\x. if x IN s then vec 1 else vec 0))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + ASM_REWRITE_TAC[GSYM HAS_MEASURE; GSYM HAS_MEASURE_MEASURE]);; + +let INTEGRAL_MEASURE = prove + (`!s. measurable s ==> integral s (\x. vec 1) = lift(measure s)`, + SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; MEASURE_INTEGRAL]);; + +let INTEGRAL_MEASURE_UNIV = prove + (`!s. measurable s + ==> integral UNIV (\x. if x IN s then vec 1 else vec 0) = + lift(measure s)`, + SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; MEASURE_INTEGRAL_UNIV]);; + +let HAS_MEASURE_INTERVAL = prove + (`(!a b:real^N. interval[a,b] has_measure content(interval[a,b])) /\ + (!a b:real^N. interval(a,b) has_measure content(interval[a,b]))`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[has_measure] THEN + ONCE_REWRITE_TAC[LIFT_EQ_CMUL] THEN REWRITE_TAC[HAS_INTEGRAL_CONST]; + ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN SIMP_TAC[HAS_MEASURE] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_INTEGRAL_SPIKE) THEN + EXISTS_TAC `interval[a:real^N,b] DIFF interval(a,b)` THEN + REWRITE_TAC[NEGLIGIBLE_FRONTIER_INTERVAL] THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] INTERVAL_OPEN_SUBSET_CLOSED) THEN + SET_TAC[]);; + +let MEASURABLE_INTERVAL = prove + (`(!a b:real^N. measurable (interval[a,b])) /\ + (!a b:real^N. measurable (interval(a,b)))`, + REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_INTERVAL]);; + +let MEASURE_INTERVAL = prove + (`(!a b:real^N. measure(interval[a,b]) = content(interval[a,b])) /\ + (!a b:real^N. measure(interval(a,b)) = content(interval[a,b]))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + REWRITE_TAC[HAS_MEASURE_INTERVAL]);; + +let MEASURE_INTERVAL_1 = prove + (`(!a b:real^1. measure(interval[a,b]) = + if drop a <= drop b then drop b - drop a else &0) /\ + (!a b:real^1. measure(interval(a,b)) = + if drop a <= drop b then drop b - drop a else &0)`, + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; PRODUCT_1; drop]);; + +let MEASURE_INTERVAL_1_ALT = prove + (`(!a b:real^1. measure(interval[a,b]) = + if drop a < drop b then drop b - drop a else &0) /\ + (!a b:real^1. measure(interval(a,b)) = + if drop a < drop b then drop b - drop a else &0)`, + REWRITE_TAC[MEASURE_INTERVAL_1] THEN REAL_ARITH_TAC);; + +let MEASURE_INTERVAL_2 = prove + (`(!a b:real^2. measure(interval[a,b]) = + if a$1 <= b$1 /\ a$2 <= b$2 + then (b$1 - a$1) * (b$2 - a$2) + else &0) /\ + (!a b:real^2. measure(interval(a,b)) = + if a$1 <= b$1 /\ a$2 <= b$2 + then (b$1 - a$1) * (b$2 - a$2) + else &0)`, + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; PRODUCT_2]);; + +let MEASURE_INTERVAL_2_ALT = prove + (`(!a b:real^2. measure(interval[a,b]) = + if a$1 < b$1 /\ a$2 < b$2 + then (b$1 - a$1) * (b$2 - a$2) + else &0) /\ + (!a b:real^2. measure(interval(a,b)) = + if a$1 < b$1 /\ a$2 < b$2 + then (b$1 - a$1) * (b$2 - a$2) + else &0)`, + REWRITE_TAC[MEASURE_INTERVAL_2] THEN REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`(a:real^2)$1 = (b:real^2)$1`; `(a:real^2)$2 = (b:real^2)$2`] THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN + ASM_REWRITE_TAC[REAL_LT_LE]);; + +let MEASURE_INTERVAL_3 = prove + (`(!a b:real^3. measure(interval[a,b]) = + if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) + else &0) /\ + (!a b:real^3. measure(interval(a,b)) = + if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) + else &0)`, + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[DIMINDEX_3; FORALL_3; PRODUCT_3]);; + +let MEASURE_INTERVAL_3_ALT = prove + (`(!a b:real^3. measure(interval[a,b]) = + if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) + else &0) /\ + (!a b:real^3. measure(interval(a,b)) = + if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) + else &0)`, + REWRITE_TAC[MEASURE_INTERVAL_3] THEN REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`(a:real^3)$1 = (b:real^3)$1`; + `(a:real^3)$2 = (b:real^3)$2`; + `(a:real^3)$3 = (b:real^3)$3`] THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN + ASM_REWRITE_TAC[REAL_LT_LE]);; + +let MEASURE_INTERVAL_4 = prove + (`(!a b:real^4. measure(interval[a,b]) = + if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 /\ a$4 <= b$4 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) + else &0) /\ + (!a b:real^4. measure(interval(a,b)) = + if a$1 <= b$1 /\ a$2 <= b$2 /\ a$3 <= b$3 /\ a$4 <= b$4 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) + else &0)`, + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[DIMINDEX_4; FORALL_4; PRODUCT_4]);; + +let MEASURE_INTERVAL_4_ALT = prove + (`(!a b:real^4. measure(interval[a,b]) = + if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 /\ a$4 < b$4 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) + else &0) /\ + (!a b:real^4. measure(interval(a,b)) = + if a$1 < b$1 /\ a$2 < b$2 /\ a$3 < b$3 /\ a$4 < b$4 + then (b$1 - a$1) * (b$2 - a$2) * (b$3 - a$3) * (b$4 - a$4) + else &0)`, + REWRITE_TAC[MEASURE_INTERVAL_4] THEN REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`(a:real^4)$1 = (b:real^4)$1`; + `(a:real^4)$2 = (b:real^4)$2`; + `(a:real^4)$3 = (b:real^4)$3`; + `(a:real^4)$4 = (b:real^4)$4`] THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_SUB_REFL; REAL_LE_REFL; REAL_ABS_NUM; COND_ID] THEN + ASM_REWRITE_TAC[REAL_LT_LE]);; + +let MEASURABLE_INTER = prove + (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s INTER t)`, + REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\x. if x IN s INTER t then vec 1 else vec 0):real^N->real^1 = + (\x. lambda i. min (((if x IN s then vec 1 else vec 0):real^1)$i) + (((if x IN t then vec 1 else vec 0):real^1)$i))` + SUBST1_TAC THENL + [SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN + X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN + ASM_SIMP_TAC[IN_INTER; VEC_COMPONENT] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN THEN + CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS]);; + +let MEASURABLE_UNION = prove + (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s UNION t)`, + REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\x. if x IN s UNION t then vec 1 else vec 0):real^N->real^1 = + (\x. lambda i. max (((if x IN s then vec 1 else vec 0):real^1)$i) + (((if x IN t then vec 1 else vec 0):real^1)$i))` + SUBST1_TAC THENL + [SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN + X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^N) IN s`; `(x:real^N) IN t`] THEN + ASM_SIMP_TAC[IN_UNION; VEC_COMPONENT] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX THEN + CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[VEC_COMPONENT; REAL_POS]);; + +let HAS_MEASURE_DISJOINT_UNION = prove + (`!s1 s2 m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ DISJOINT s1 s2 + ==> (s1 UNION s2) has_measure (m1 + m2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_MEASURE; CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]) THEN + ASM SET_TAC[]);; + +let MEASURE_DISJOINT_UNION = prove + (`!s t. measurable s /\ measurable t /\ DISJOINT s t + ==> measure(s UNION t) = measure s + measure t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNION; GSYM HAS_MEASURE_MEASURE]);; + +let MEASURE_DISJOINT_UNION_EQ = prove + (`!s t u. + measurable s /\ measurable t /\ s UNION t = u /\ DISJOINT s t + ==> measure s + measure t = measure u`, + MESON_TAC[MEASURE_DISJOINT_UNION]);; + +let HAS_MEASURE_POS_LE = prove + (`!m s:real^N->bool. s has_measure m ==> &0 <= m`, + REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN + REWRITE_TAC[drop] THEN MATCH_MP_TAC(ISPEC + `(\x. if x IN s then vec 1 else vec 0):real^N->real^1` + HAS_INTEGRAL_COMPONENT_POS) THEN + EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[DIMINDEX_1; ARITH; IN_UNIV] THEN + GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[GSYM drop; DROP_VEC; REAL_POS]);; + +let MEASURE_POS_LE = prove + (`!s. measurable s ==> &0 <= measure s`, + REWRITE_TAC[HAS_MEASURE_MEASURE; HAS_MEASURE_POS_LE]);; + +let HAS_MEASURE_SUBSET = prove + (`!s1 s2:real^N->bool m1 m2. + s1 has_measure m1 /\ s2 has_measure m2 /\ s1 SUBSET s2 + ==> m1 <= m2`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_measure] THEN STRIP_TAC THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN + MATCH_MP_TAC(ISPEC `(\x. vec 1):real^N->real^1` + HAS_INTEGRAL_SUBSET_DROP_LE) THEN + MAP_EVERY EXISTS_TAC [`s1:real^N->bool`; `s2:real^N->bool`] THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_POS]);; + +let MEASURE_SUBSET = prove + (`!s t. measurable s /\ measurable t /\ s SUBSET t + ==> measure s <= measure t`, + REWRITE_TAC[HAS_MEASURE_MEASURE] THEN MESON_TAC[HAS_MEASURE_SUBSET]);; + +let HAS_MEASURE_0 = prove + (`!s:real^N->bool. s has_measure &0 <=> negligible s`, + GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; + REWRITE_TAC[NEGLIGIBLE; has_measure] THEN + DISCH_THEN(MP_TAC o SPEC `(:real^N)`) THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[IN_UNIV; indicator; LIFT_NUM]] THEN + REWRITE_TAC[negligible] THEN REWRITE_TAC[has_measure] THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[LIFT_NUM] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [HAS_INTEGRAL_ALT]) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[integrable_on; IN_UNIV] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) + [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[indicator] THEN DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN + SUBGOAL_THEN `y:real^1 = vec 0` (fun th -> ASM_MESON_TAC[th]) THEN + REWRITE_TAC[GSYM DROP_EQ; GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC + `(\x. if x IN interval [a,b] + then if x IN s then vec 1 else vec 0 else vec 0):real^N->real^1` + HAS_INTEGRAL_DROP_LE) THEN + EXISTS_TAC `(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; + REWRITE_TAC[DROP_VEC] THEN MATCH_MP_TAC(ISPEC + `(\x. if x IN interval [a,b] + then if x IN s then vec 1 else vec 0 else vec 0):real^N->real^1` + HAS_INTEGRAL_DROP_POS)] THEN + EXISTS_TAC `(:real^N)` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);; + +let MEASURE_EQ_0 = prove + (`!s. negligible s ==> measure s = &0`, + MESON_TAC[MEASURE_UNIQUE; HAS_MEASURE_0]);; + +let NEGLIGIBLE_IMP_MEASURABLE = prove + (`!s:real^N->bool. negligible s ==> measurable s`, + MESON_TAC[HAS_MEASURE_0; measurable]);; + +let HAS_MEASURE_EMPTY = prove + (`{} has_measure &0`, + REWRITE_TAC[HAS_MEASURE_0; NEGLIGIBLE_EMPTY]);; + +let MEASURE_EMPTY = prove + (`measure {} = &0`, + SIMP_TAC[MEASURE_EQ_0; NEGLIGIBLE_EMPTY]);; + +let MEASURABLE_EMPTY = prove + (`measurable {}`, + REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_EMPTY]);; + +let MEASURABLE_MEASURE_EQ_0 = prove + (`!s. measurable s ==> (measure s = &0 <=> negligible s)`, + REWRITE_TAC[HAS_MEASURE_MEASURE; GSYM HAS_MEASURE_0] THEN + MESON_TAC[MEASURE_UNIQUE]);; + +let NEGLIGIBLE_EQ_MEASURE_0 = prove + (`!s:real^N->bool. + negligible s <=> measurable s /\ measure s = &0`, + MESON_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_MEASURE_EQ_0]);; + +let MEASURABLE_MEASURE_POS_LT = prove + (`!s. measurable s ==> (&0 < measure s <=> ~negligible s)`, + SIMP_TAC[REAL_LT_LE; MEASURE_POS_LE; GSYM MEASURABLE_MEASURE_EQ_0] THEN + REWRITE_TAC[EQ_SYM_EQ]);; + +let NEGLIGIBLE_INTERVAL = prove + (`(!a b. negligible(interval[a,b]) <=> interval(a,b) = {}) /\ + (!a b. negligible(interval(a,b)) <=> interval(a,b) = {})`, + REWRITE_TAC[GSYM HAS_MEASURE_0] THEN + MESON_TAC[HAS_MEASURE_INTERVAL; CONTENT_EQ_0_INTERIOR; + INTERIOR_CLOSED_INTERVAL; HAS_MEASURE_UNIQUE]);; + +let MEASURABLE_UNIONS = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ (!s. s IN f ==> measurable s) + ==> measurable (UNIONS f)`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[UNIONS_0; UNIONS_INSERT; MEASURABLE_EMPTY] THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_UNION THEN ASM_SIMP_TAC[]);; + +let HAS_MEASURE_DIFF_SUBSET = prove + (`!s1 s2 m1 m2. s1 has_measure m1 /\ s2 has_measure m2 /\ s2 SUBSET s1 + ==> (s1 DIFF s2) has_measure (m1 - m2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_MEASURE; CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN + REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN + ASM SET_TAC[]);; + +let MEASURABLE_DIFF = prove + (`!s t:real^N->bool. measurable s /\ measurable t ==> measurable (s DIFF t)`, + SUBGOAL_THEN + `!s t:real^N->bool. measurable s /\ measurable t /\ t SUBSET s + ==> measurable (s DIFF t)` + ASSUME_TAC THENL + [REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_DIFF_SUBSET]; + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[MEASURABLE_INTER] THEN + SET_TAC[]]);; + +let MEASURE_DIFF_SUBSET = prove + (`!s t. measurable s /\ measurable t /\ t SUBSET s + ==> measure(s DIFF t) = measure s - measure t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_DIFF_SUBSET; GSYM HAS_MEASURE_MEASURE]);; + +let HAS_MEASURE_UNION_NEGLIGIBLE = prove + (`!s t:real^N->bool m. + s has_measure m /\ negligible t ==> (s UNION t) has_measure m`, + REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC + [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; + `t:real^N->bool`] THEN + ASM_SIMP_TAC[IN_DIFF; IN_UNIV; IN_UNION]);; + +let HAS_MEASURE_DIFF_NEGLIGIBLE = prove + (`!s t:real^N->bool m. + s has_measure m /\ negligible t ==> (s DIFF t) has_measure m`, + REWRITE_TAC[HAS_MEASURE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC + [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; + `t:real^N->bool`] THEN + ASM_SIMP_TAC[IN_DIFF; IN_UNIV; IN_UNION]);; + +let HAS_MEASURE_UNION_NEGLIGIBLE_EQ = prove + (`!s t:real^N->bool m. + negligible t ==> ((s UNION t) has_measure m <=> s has_measure m)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[HAS_MEASURE_UNION_NEGLIGIBLE] THEN + SUBST1_TAC(SET_RULE `s:real^N->bool = (s UNION t) DIFF (t DIFF s)`) THEN + MATCH_MP_TAC HAS_MEASURE_DIFF_NEGLIGIBLE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NEGLIGIBLE_DIFF THEN ASM_REWRITE_TAC[]);; + +let HAS_MEASURE_DIFF_NEGLIGIBLE_EQ = prove + (`!s t:real^N->bool m. + negligible t ==> ((s DIFF t) has_measure m <=> s has_measure m)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE] THEN + SUBST1_TAC(SET_RULE `s:real^N->bool = (s DIFF t) UNION (t INTER s)`) THEN + MATCH_MP_TAC HAS_MEASURE_UNION_NEGLIGIBLE THEN + ASM_SIMP_TAC[NEGLIGIBLE_INTER]);; + +let HAS_MEASURE_ALMOST = prove + (`!s s' t m. s has_measure m /\ negligible t /\ s UNION t = s' UNION t + ==> s' has_measure m`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `s UNION t = s' UNION t ==> s' = (s UNION t) DIFF (t DIFF s')`)) THEN + ASM_SIMP_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE; HAS_MEASURE_UNION_NEGLIGIBLE; + NEGLIGIBLE_DIFF]);; + +let HAS_MEASURE_ALMOST_EQ = prove + (`!s s' t. negligible t /\ s UNION t = s' UNION t + ==> (s has_measure m <=> s' has_measure m)`, + MESON_TAC[HAS_MEASURE_ALMOST]);; + +let MEASURABLE_ALMOST = prove + (`!s s' t. measurable s /\ negligible t /\ s UNION t = s' UNION t + ==> measurable s'`, + REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ALMOST]);; + +let HAS_MEASURE_NEGLIGIBLE_UNION = prove + (`!s1 s2:real^N->bool m1 m2. + s1 has_measure m1 /\ s2 has_measure m2 /\ negligible(s1 INTER s2) + ==> (s1 UNION s2) has_measure (m1 + m2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN + MAP_EVERY EXISTS_TAC + [`(s1 DIFF (s1 INTER s2)) UNION (s2 DIFF (s1 INTER s2)):real^N->bool`; + `s1 INTER s2:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC HAS_MEASURE_DISJOINT_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HAS_MEASURE_ALMOST THEN EXISTS_TAC `s1:real^N->bool`; + MATCH_MP_TAC HAS_MEASURE_ALMOST THEN EXISTS_TAC `s2:real^N->bool`; + SET_TAC[]] THEN + EXISTS_TAC `s1 INTER s2:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let MEASURE_NEGLIGIBLE_UNION = prove + (`!s t. measurable s /\ measurable t /\ negligible(s INTER t) + ==> measure(s UNION t) = measure s + measure t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNION; GSYM HAS_MEASURE_MEASURE]);; + +let MEASURE_NEGLIGIBLE_UNION_EQ = prove + (`!s t u. + measurable s /\ measurable t /\ s UNION t = u /\ negligible(s INTER t) + ==> measure s + measure t = measure u`, + MESON_TAC[MEASURE_NEGLIGIBLE_UNION]);; + +let HAS_MEASURE_NEGLIGIBLE_SYMDIFF = prove + (`!s t:real^N->bool m. + s has_measure m /\ + negligible((s DIFF t) UNION (t DIFF s)) + ==> t has_measure m`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN + MAP_EVERY EXISTS_TAC + [`s:real^N->bool`; `(s DIFF t) UNION (t DIFF s):real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let MEASURABLE_NEGLIGIBLE_SYMDIFF = prove + (`!s t:real^N->bool. + measurable s /\ negligible((s DIFF t) UNION (t DIFF s)) + ==> measurable t`, + REWRITE_TAC[measurable] THEN + MESON_TAC[HAS_MEASURE_NEGLIGIBLE_SYMDIFF]);; + +let MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ = prove + (`!s t:real^N->bool. + negligible(s DIFF t UNION t DIFF s) + ==> (measurable s <=> measurable t)`, + MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF; UNION_COMM]);; + +let MEASURE_NEGLIGIBLE_SYMDIFF = prove + (`!s t:real^N->bool. + negligible(s DIFF t UNION t DIFF s) ==> measure s = measure t`, + REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC + [`measurable(s:real^N->bool)`; `measurable(t:real^N->bool)`] + THENL + [ASM_MESON_TAC[HAS_MEASURE_NEGLIGIBLE_SYMDIFF; MEASURE_UNIQUE; + HAS_MEASURE_MEASURE]; + ASM_MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ]; + ASM_MESON_TAC[MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ]; + REWRITE_TAC[measure] THEN AP_TERM_TAC THEN ABS_TAC THEN + ASM_MESON_TAC[measurable]]);; + +let NEGLIGIBLE_SYMDIFF_EQ = prove + (`!s t:real^N->bool. + negligible (s DIFF t UNION t DIFF s) + ==> (negligible s <=> negligible t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + SET_TAC[]);; + +let NEGLIGIBLE_DELETE = prove + (`!a:real^N. negligible(s DELETE a) <=> negligible s`, + GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{a:real^N}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; + +let HAS_MEASURE_NEGLIGIBLE_UNIONS = prove + (`!m f:(real^N->bool)->bool. + FINITE f /\ + (!s. s IN f ==> s has_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> negligible(s INTER t)) + ==> (UNIONS f) has_measure (sum f m)`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; UNIONS_0; UNIONS_INSERT; HAS_MEASURE_EMPTY] THEN + REWRITE_TAC[IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN + STRIP_TAC THEN STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNION THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +let MEASURE_NEGLIGIBLE_UNIONS = prove + (`!m f:(real^N->bool)->bool. + FINITE f /\ + (!s. s IN f ==> s has_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> negligible(s INTER t)) + ==> measure(UNIONS f) = sum f m`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS]);; + +let HAS_MEASURE_DISJOINT_UNIONS = prove + (`!m f:(real^N->bool)->bool. + FINITE f /\ + (!s. s IN f ==> s has_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) + ==> (UNIONS f) has_measure (sum f m)`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS THEN + ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; + +let MEASURE_DISJOINT_UNIONS = prove + (`!m f:(real^N->bool)->bool. + FINITE f /\ + (!s. s IN f ==> s has_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) + ==> measure(UNIONS f) = sum f m`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS]);; + +let HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE = prove + (`!f:A->real^N->bool s. + FINITE s /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) + ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum s (\x. measure(f x)) = sum (IMAGE (f:A->real^N->bool) s) measure` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`]) THEN + ASM_SIMP_TAC[INTER_ACI; MEASURABLE_MEASURE_EQ_0]; + MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS THEN + ASM_SIMP_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[FINITE_IMAGE; HAS_MEASURE_MEASURE]]);; + +let MEASURE_NEGLIGIBLE_UNIONS_IMAGE = prove + (`!f:A->real^N->bool s. + FINITE s /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) + ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE]);; + +let HAS_MEASURE_DISJOINT_UNIONS_IMAGE = prove + (`!f:A->real^N->bool s. + FINITE s /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN + ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; + +let MEASURE_DISJOINT_UNIONS_IMAGE = prove + (`!f:A->real^N->bool s. + FINITE s /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS_IMAGE]);; + +let HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove + (`!f:A->real^N->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) + ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->real^N->bool`; + `{x | x IN s /\ ~((f:A->real^N->bool) x = {})}`] + HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN + ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[NOT_IN_EMPTY]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN + REWRITE_TAC[MEASURE_EMPTY]]);; + +let MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove + (`!f:A->real^N->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> negligible((f x) INTER (f y))) + ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);; + +let HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove + (`!f:A->real^N->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> (UNIONS (IMAGE f s)) has_measure (sum s (\x. measure(f x)))`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN + ASM_SIMP_TAC[NEGLIGIBLE_EMPTY]);; + +let MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove + (`!f:A->real^N->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> measure(UNIONS (IMAGE f s)) = sum s (\x. measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);; + +let MEASURE_UNION = prove + (`!s t:real^N->bool. + measurable s /\ measurable t + ==> measure(s UNION t) = measure(s) + measure(t) - measure(s INTER t)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `s UNION t = (s INTER t) UNION (s DIFF t) UNION (t DIFF s)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + b - c:real = c + (a - c) + (b - c)`] THEN + MP_TAC(ISPECL [`s DIFF t:real^N->bool`; `t DIFF s:real^N->bool`] + MEASURE_DISJOINT_UNION) THEN + ASM_SIMP_TAC[MEASURABLE_DIFF] THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s INTER t:real^N->bool`; + `(s DIFF t) UNION (t DIFF s):real^N->bool`] + MEASURE_DISJOINT_UNION) THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_INTER] THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL + [EXISTS_TAC `measure((s DIFF t) UNION (s INTER t):real^N->bool)`; + EXISTS_TAC `measure((t DIFF s) UNION (s INTER t):real^N->bool)`] THEN + (CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTER]; + AP_TERM_TAC] THEN + SET_TAC[]));; + +let MEASURE_UNION_LE = prove + (`!s t:real^N->bool. + measurable s /\ measurable t + ==> measure(s UNION t) <= measure s + measure t`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURE_UNION] THEN + REWRITE_TAC[REAL_ARITH `a + b - c <= a + b <=> &0 <= c`] THEN + MATCH_MP_TAC MEASURE_POS_LE THEN ASM_SIMP_TAC[MEASURABLE_INTER]);; + +let MEASURE_UNIONS_LE = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ (!s. s IN f ==> measurable s) + ==> measure(UNIONS f) <= sum f (\s. measure s)`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN + REWRITE_TAC[MEASURE_EMPTY; REAL_LE_REFL] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `f:(real^N->bool)->bool`] THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(s:real^N->bool) + measure(UNIONS f:real^N->bool)` THEN + ASM_SIMP_TAC[MEASURE_UNION_LE; MEASURABLE_UNIONS] THEN + REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[]);; + +let MEASURABLE_INSERT = prove + (`!x s:real^N->bool. measurable(x INSERT s) <=> measurable s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; + +let MEASURE_INSERT = prove + (`!x s:real^N->bool. measure(x INSERT s) = measure s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real^N}` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN SET_TAC[]);; + +let MEASURE_UNIONS_LE_IMAGE = prove + (`!f:A->bool s:A->(real^N->bool). + FINITE f /\ (!a. a IN f ==> measurable(s a)) + ==> measure(UNIONS (IMAGE s f)) <= sum f (\a. measure(s a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\k:real^N->bool. measure k)` THEN + ASM_SIMP_TAC[MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN + ASM_SIMP_TAC[MEASURE_POS_LE]);; + +let MEASURABLE_INNER_OUTER = prove + (`!s:real^N->bool. + measurable s <=> + !e. &0 < e + ==> ?t u. t SUBSET s /\ s SUBSET u /\ + measurable t /\ measurable u /\ + abs(measure t - measure u) < e`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM]; + ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(\x. if x IN t then vec 1 else vec 0):real^N->real^1`; + `(\x. if x IN u then vec 1 else vec 0):real^N->real^1`; + `lift(measure(t:real^N->bool))`; + `lift(measure(u:real^N->bool))`] THEN + ASM_REWRITE_TAC[GSYM HAS_MEASURE; GSYM HAS_MEASURE_MEASURE] THEN + ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN + ASM SET_TAC[]);; + +let HAS_MEASURE_INNER_OUTER = prove + (`!s:real^N->bool m. + s has_measure m <=> + (!e. &0 < e ==> ?t. t SUBSET s /\ measurable t /\ + m - e < measure t) /\ + (!e. &0 < e ==> ?u. s SUBSET u /\ measurable u /\ + measure u < m + e)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [GEN_REWRITE_TAC I [MEASURABLE_INNER_OUTER] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "u" (MP_TAC o SPEC `e / &2`) THEN + REMOVE_THEN "t" (MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ t <= u /\ m - e / &2 < t /\ u < m + e / &2 + ==> abs(t - u) < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `~(&0 < x - y) /\ ~(&0 < y - x) ==> x = y`) THEN + CONJ_TAC THEN DISCH_TAC THENL + [REMOVE_THEN "u" (MP_TAC o SPEC `measure(s:real^N->bool) - m`) THEN + ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE]; + REMOVE_THEN "t" (MP_TAC o SPEC `m - measure(s:real^N->bool)`) THEN + ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN + ASM_MESON_TAC[MEASURE_SUBSET]]);; + +let HAS_MEASURE_INNER_OUTER_LE = prove + (`!s:real^N->bool m. + s has_measure m <=> + (!e. &0 < e ==> ?t. t SUBSET s /\ measurable t /\ + m - e <= measure t) /\ + (!e. &0 < e ==> ?u. s SUBSET u /\ measurable u /\ + measure u <= m + e)`, + REWRITE_TAC[HAS_MEASURE_INNER_OUTER] THEN + MESON_TAC[REAL_ARITH `&0 < e /\ m - e / &2 <= t ==> m - e < t`; + REAL_ARITH `&0 < e /\ u <= m + e / &2 ==> u < m + e`; + REAL_ARITH `&0 < e <=> &0 < e / &2`; REAL_LT_IMP_LE]);; + +let NEGLIGIBLE_OUTER = prove + (`!s:real^N->bool. + negligible s <=> + !e. &0 < e ==> ?t. s SUBSET t /\ measurable t /\ measure t < e`, + GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_INNER_OUTER] THEN + REWRITE_TAC[REAL_ADD_LID] THEN MATCH_MP_TAC(TAUT `a ==> (a /\ b <=> b)`) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN + REWRITE_TAC[EMPTY_SUBSET; MEASURABLE_EMPTY; MEASURE_EMPTY] THEN + ASM_REAL_ARITH_TAC);; + +let NEGLIGIBLE_OUTER_LE = prove + (`!s:real^N->bool. + negligible s <=> + !e. &0 < e ==> ?t. s SUBSET t /\ measurable t /\ measure t <= e`, + REWRITE_TAC[NEGLIGIBLE_OUTER] THEN + MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH + `&0 < e ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)`]);; + +let HAS_MEASURE_LIMIT = prove + (`!s. s has_measure m <=> + !e. &0 < e + ==> ?B. &0 < B /\ + !a b. ball(vec 0,B) SUBSET interval[a,b] + ==> ?z. (s INTER interval[a,b]) has_measure z /\ + abs(z - m) < e`, + GEN_TAC THEN REWRITE_TAC[HAS_MEASURE] THEN + GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL] THEN + REWRITE_TAC[IN_UNIV] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[MESON[IN_INTER] + `(if x IN k INTER s then a else b) = + (if x IN s then if x IN k then a else b else b)`] THEN + REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; NORM_LIFT]);; + +let MEASURE_LIMIT = prove + (`!s:real^N->bool e. + measurable s /\ &0 < e + ==> ?B. &0 < B /\ + !a b. ball(vec 0,B) SUBSET interval[a,b] + ==> abs(measure(s INTER interval[a,b]) - + measure s) < e`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[MEASURE_UNIQUE]);; + +let INTEGRABLE_ON_CONST = prove + (`!c:real^N. (\x:real^M. c) integrable_on s <=> c = vec 0 \/ measurable s`, + GEN_TAC THEN ASM_CASES_TAC `c:real^N = vec 0` THEN + ASM_REWRITE_TAC[INTEGRABLE_0; MEASURABLE] THEN EQ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o + ISPEC `(\y. lambda i. y$k / (c:real^N)$k):real^N->real^1` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_LINEAR)) THEN + ASM_SIMP_TAC[vec; o_DEF; REAL_DIV_REFL] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o + ISPEC `(\y. lambda i. (c:real^N)$i * y$i):real^1->real^N` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] INTEGRABLE_LINEAR)) THEN + ANTS_TAC THENL + [SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA] THEN REAL_ARITH_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; o_THM; LAMBDA_BETA; VEC_COMPONENT] THEN + REWRITE_TAC[REAL_MUL_RID]]]);; + +let ABSOLUTELY_INTEGRABLE_ON_CONST = prove + (`!c. (\x. c) absolutely_integrable_on s <=> c = vec 0 \/ measurable s`, + REWRITE_TAC[absolutely_integrable_on; INTEGRABLE_ON_CONST] THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; DROP_VEC; NORM_EQ_0]);; + +let OPEN_NOT_NEGLIGIBLE = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(negligible s)`, + GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:real^N` THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN + SUBGOAL_THEN `negligible(interval[a - e / (&(dimindex(:N))) % vec 1:real^N, + a + e / (&(dimindex(:N))) % vec 1])` + MP_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `cball(a:real^N,e)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL; VECTOR_ADD_COMPONENT; + VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID; + REAL_ARITH `a - e <= x /\ x <= a + e <=> abs(x - a) <= e`; dist] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_BOUND_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY; NOT_LT] THEN + REWRITE_TAC[IN_NUMSEG; VECTOR_SUB_COMPONENT; DIMINDEX_GE_1] THEN + ASM_MESON_TAC[REAL_ABS_SUB]; + REWRITE_TAC[NEGLIGIBLE_INTERVAL; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_MUL_RID; + VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `a - e < a + e <=> &0 < e`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]]);; + +let NOT_NEGLIGIBLE_UNIV = prove + (`~negligible(:real^N)`, + SIMP_TAC[OPEN_NOT_NEGLIGIBLE; OPEN_UNIV; UNIV_NOT_EMPTY]);; + +let NEGLIGIBLE_EMPTY_INTERIOR = prove + (`!s:real^N->bool. negligible s ==> interior s = {}`, + MESON_TAC[OPEN_NOT_NEGLIGIBLE; INTERIOR_SUBSET; OPEN_INTERIOR; + NEGLIGIBLE_SUBSET]);; + +let HAS_INTEGRAL_NEGLIGIBLE_EQ_AE = prove + (`!f:real^M->real^N s t. + negligible t /\ + (!x i. x IN s DIFF t /\ 1 <= i /\ i <= dimindex (:N) ==> &0 <= f x$i) + ==> ((f has_integral vec 0) s <=> + negligible {x | x IN s /\ ~(f x = vec 0)})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. if x IN t then vec 0 else (f:real^M->real^N) x`; + `s:real^M->bool`] HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[VEC_COMPONENT; IN_DIFF; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_SPIKE_EQ; + MATCH_MP_TAC NEGLIGIBLE_SYMDIFF_EQ THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET] THEN + EXISTS_TAC `t:real^M->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of measure under simple affine transformations. *) +(* ------------------------------------------------------------------------- *) + +let HAS_MEASURE_AFFINITY = prove + (`!s m c y. s has_measure y + ==> (IMAGE (\x:real^N. m % x + c) s) + has_measure abs(m) pow (dimindex(:N)) * y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `m = &0` THENL + [ASM_REWRITE_TAC[REAL_ABS_NUM; VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN + ONCE_REWRITE_TAC[MATCH_MP (ARITH_RULE `~(x = 0) ==> x = SUC(x - 1)`) + (SPEC_ALL DIMINDEX_NONZERO)] THEN DISCH_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; HAS_MEASURE_0] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{c:real^N}` THEN + SIMP_TAC[NEGLIGIBLE_FINITE; FINITE_RULES] THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[HAS_MEASURE] THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(m) pow dimindex(:N)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `abs(m) * B + norm(c:real^N)` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < B /\ &0 <= x ==> &0 < B + x`; + NORM_POS_LE; REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN + ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; UNWIND_THM1] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`if &0 <= m then inv m % u + --(inv m % c):real^N + else inv m % v + --(inv m % c)`; + `if &0 <= m then inv m % v + --(inv m % c):real^N + else inv m % u + --(inv m % c)`]) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b ==> c) ==> (a ==> b) ==> c`) THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `m % x + c:real^N`) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[IN_BALL; IN_INTERVAL] THEN + CONJ_TAC THENL + [REWRITE_TAC[NORM_ARITH `dist(vec 0,x) = norm(x:real^N)`] THEN + DISCH_TAC THEN MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) < a ==> norm(x + y) < a + norm(y)`) THEN + ASM_SIMP_TAC[NORM_MUL; REAL_LT_LMUL; GSYM REAL_ABS_NZ]; + ALL_TAC] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_NEG_COMPONENT; + COND_COMPONENT] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[REAL_ARITH `m * u + --(m * c):real = (u - c) * m`] THEN + SUBST1_TAC(REAL_ARITH + `inv(m) = if &0 <= inv(m) then abs(inv m) else --(abs(inv m))`) THEN + SIMP_TAC[REAL_LE_INV_EQ] THEN + REWRITE_TAC[REAL_ARITH `(x - y:real) * --z = (y - x) * z`] THEN + REWRITE_TAC[REAL_ABS_INV; GSYM real_div] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; GSYM REAL_ABS_NZ] THEN + ASM_REWRITE_TAC[real_abs] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN DISCH_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^1` + (fun th -> EXISTS_TAC `(abs m pow dimindex (:N)) % z:real^1` THEN + MP_TAC th)) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_FIELD `~(x = &0) ==> ~(inv x = &0)`)) THEN + REWRITE_TAC[TAUT `a ==> b ==> c <=> b /\ a ==> c`] THEN + DISCH_THEN(MP_TAC o SPEC `--(inv m % c):real^N` o + MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_INV_INV] THEN + SIMP_TAC[COND_ID] THEN COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; + VECTOR_MUL_LNEG; VECTOR_MUL_RNEG] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID; VECTOR_NEG_NEG] THEN + REWRITE_TAC[VECTOR_ARITH `(u + --c) + c:real^N = u`] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV; GSYM REAL_POW_INV] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[LIFT_CMUL; GSYM VECTOR_SUB_LDISTRIB] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_POW; REAL_ABS_ABS] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_POW_LT; GSYM REAL_ABS_NZ]);; + +let STRETCH_GALOIS = prove + (`!x:real^N y:real^N m. + (!k. 1 <= k /\ k <= dimindex(:N) ==> ~(m k = &0)) + ==> ((y = (lambda k. m k * x$k)) <=> (lambda k. inv(m k) * y$k) = x)`, + REPEAT GEN_TAC THEN SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + MATCH_MP_TAC(MESON[] + `(!x. p x ==> (q x <=> r x)) + ==> (!x. p x) ==> ((!x. q x) <=> (!x. r x))`) THEN + GEN_TAC THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_FIELD);; + +let HAS_MEASURE_STRETCH = prove + (`!s m y. s has_measure y + ==> (IMAGE (\x:real^N. lambda k. m k * x$k) s :real^N->bool) + has_measure abs(product (1..dimindex(:N)) m) * y`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC + `!k. 1 <= k /\ k <= dimindex(:N) ==> ~(m k = &0)` + THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `product(1..dimindex (:N)) m = &0` SUBST1_TAC THENL + [ASM_MESON_TAC[PRODUCT_EQ_0_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO; HAS_MEASURE_0] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | x$k = &0}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; REAL_MUL_LZERO]] THEN + UNDISCH_TAC `(s:real^N->bool) has_measure y` THEN + REWRITE_TAC[HAS_MEASURE] THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL] THEN REWRITE_TAC[IN_UNIV] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < abs(product(1..dimindex(:N)) m)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_ABS_NZ; REAL_LT_DIV; PRODUCT_EQ_0_NUMSEG]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real / abs(product(1..dimindex(:N)) m)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `sup(IMAGE (\k. abs(m k) * B) (1..dimindex(:N)))` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; NUMSEG_EMPTY; FINITE_NUMSEG; + IN_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1; IMAGE_EQ_EMPTY; + EXISTS_IN_IMAGE] THEN + ASM_MESON_TAC[IN_NUMSEG; DIMINDEX_GE_1; LE_REFL; REAL_LT_MUL; REAL_ABS_NZ]; + DISCH_TAC] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[IN_IMAGE; STRETCH_GALOIS; UNWIND_THM1] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(lambda k. min (inv(m k) * (u:real^N)$k) + (inv(m k) * (v:real^N)$k)):real^N`; + `(lambda k. max (inv(m k) * (u:real^N)$k) + (inv(m k) * (v:real^N)$k)):real^N`]) THEN + MATCH_MP_TAC(TAUT `a /\ (b ==> a ==> c) ==> (a ==> b) ==> c`) THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `z:real^1` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `!k. 1 <= k /\ k <= dimindex (:N) ==> ~(inv(m k) = &0)` + MP_TAC THENL [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_STRETCH)] THEN + (MP_TAC(ISPECL [`u:real^N`; `v:real^N`; `\i:num. inv(m i:real)`] + IMAGE_STRETCH_INTERVAL) THEN + SUBGOAL_THEN `~(interval[u:real^N,v] = {})` ASSUME_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`)) THEN + ASM_REWRITE_TAC[BALL_EQ_EMPTY; GSYM REAL_NOT_LT]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM)) + THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b SUBSET s ==> b' SUBSET IMAGE f b ==> b' SUBSET IMAGE f s`)) THEN + REWRITE_TAC[IN_BALL; SUBSET; NORM_ARITH `dist(vec 0:real^N,x) = norm x`; + IN_IMAGE] THEN + ASM_SIMP_TAC[STRETCH_GALOIS; REAL_INV_EQ_0; UNWIND_THM1; REAL_INV_INV] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC + `norm(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) % x:real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_MUL_COMPONENT; REAL_ABS_MUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN + ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; + NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[REAL_LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[NORM_MUL] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `abs(sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))) * B` THEN + SUBGOAL_THEN `&0 < sup(IMAGE(\k. abs(m k)) (1..dimindex(:N)))` + ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; + NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; GSYM REAL_ABS_NZ; IN_NUMSEG] THEN + ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_ARITH `&0 < x ==> &0 < abs x`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sup(IMAGE(\k. abs(m k)) (1..dimindex(:N))) * B` THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_ARITH `&0 < x ==> abs x <= x`] THEN + ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; + NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN + ASM_SIMP_TAC[EXISTS_IN_IMAGE; REAL_LE_RMUL_EQ] THEN + ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY; + NUMSEG_EMPTY; FINITE_NUMSEG; GSYM NOT_LE; DIMINDEX_GE_1] THEN + MP_TAC(ISPEC `IMAGE (\k. abs (m k)) (1..dimindex(:N))` SUP_FINITE) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_EQ_EMPTY; NUMSEG_EMPTY; + GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]; + + MATCH_MP_TAC(MESON[] + `s = t /\ P z ==> (f has_integral z) s ==> Q + ==> ?w. (f has_integral w) t /\ P w`) THEN + SIMP_TAC[GSYM PRODUCT_INV; FINITE_NUMSEG; GSYM REAL_ABS_INV] THEN + REWRITE_TAC[REAL_INV_INV] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE + `(!x. f x = x) ==> IMAGE f s = s`) THEN + SIMP_TAC[o_THM; LAMBDA_BETA; CART_EQ] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID]; + REWRITE_TAC[ABS_DROP; DROP_SUB; LIFT_DROP; DROP_CMUL] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; ETA_AX] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THEN + ASM_MESON_TAC[ABS_DROP; DROP_SUB; LIFT_DROP]]]);; + +let HAS_MEASURE_TRANSLATION = prove + (`!s m a. s has_measure m ==> (IMAGE (\x:real^N. a + x) s) has_measure m`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `&1`; `a:real^N`; `m:real`] + HAS_MEASURE_AFFINITY) THEN + REWRITE_TAC[VECTOR_MUL_LID; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + REWRITE_TAC[VECTOR_ADD_SYM]);; + +let NEGLIGIBLE_TRANSLATION = prove + (`!s a. negligible s ==> negligible (IMAGE (\x:real^N. a + x) s)`, + SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION]);; + +let HAS_MEASURE_TRANSLATION_EQ = prove + (`!a s m. (IMAGE (\x:real^N. a + x) s) has_measure m <=> s has_measure m`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_TRANSLATION] THEN + DISCH_THEN(MP_TAC o SPEC `--a:real^N` o + MATCH_MP HAS_MEASURE_TRANSLATION) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + b:real^N = b`] THEN + SET_TAC[]);; + +add_translation_invariants [HAS_MEASURE_TRANSLATION_EQ];; + +let MEASURE_TRANSLATION = prove + (`!a s. measure(IMAGE (\x:real^N. a + x) s) = measure s`, + REWRITE_TAC[measure; HAS_MEASURE_TRANSLATION_EQ]);; + +add_translation_invariants [MEASURE_TRANSLATION];; + +let NEGLIGIBLE_TRANSLATION_REV = prove + (`!s a. negligible (IMAGE (\x:real^N. a + x) s) ==> negligible s`, + SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);; + +let NEGLIGIBLE_TRANSLATION_EQ = prove + (`!a s. negligible (IMAGE (\x:real^N. a + x) s) <=> negligible s`, + SIMP_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_TRANSLATION_EQ]);; + +add_translation_invariants [NEGLIGIBLE_TRANSLATION_EQ];; + +let MEASURABLE_TRANSLATION_EQ = prove + (`!a:real^N s. measurable (IMAGE (\x. a + x) s) <=> measurable s`, + REWRITE_TAC[measurable; HAS_MEASURE_TRANSLATION_EQ]);; + +add_translation_invariants [MEASURABLE_TRANSLATION_EQ];; + +let MEASURABLE_TRANSLATION = prove + (`!s a:real^N. measurable s ==> measurable (IMAGE (\x. a + x) s)`, + REWRITE_TAC[MEASURABLE_TRANSLATION_EQ]);; + +let HAS_MEASURE_SCALING = prove + (`!s m c. s has_measure m + ==> (IMAGE (\x:real^N. c % x) s) has_measure + (abs(c) pow dimindex(:N)) * m`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `c:real`; `vec 0:real^N`; `m:real`] + HAS_MEASURE_AFFINITY) THEN + REWRITE_TAC[VECTOR_ADD_RID]);; + +let HAS_MEASURE_SCALING_EQ = prove + (`!s m c. ~(c = &0) + ==> (IMAGE (\x:real^N. c % x) s + has_measure (abs(c) pow dimindex(:N)) * m <=> + s has_measure m)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_MEASURE_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv(c):real` o MATCH_MP HAS_MEASURE_SCALING) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[GSYM REAL_POW_MUL; VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID; VECTOR_MUL_LID] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; + +let MEASURABLE_SCALING = prove + (`!s c. measurable s ==> measurable (IMAGE (\x:real^N. c % x) s)`, + REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_SCALING]);; + +let MEASURABLE_SCALING_EQ = prove + (`!s c. ~(c = &0) + ==> (measurable (IMAGE (\x:real^N. c % x) s) <=> measurable s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP MEASURABLE_SCALING) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN + SET_TAC[]);; + +let MEASURE_SCALING = prove + (`!s. measurable s + ==> measure(IMAGE (\x:real^N. c % x) s) = + (abs(c) pow dimindex(:N)) * measure s`, + REWRITE_TAC[HAS_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURE_UNIQUE THEN ASM_SIMP_TAC[HAS_MEASURE_SCALING]);; + +(* ------------------------------------------------------------------------- *) +(* Measurability of countable unions and intersections of various kinds. *) +(* ------------------------------------------------------------------------- *) + +let HAS_MEASURE_NESTED_UNIONS = prove + (`!s:num->real^N->bool B. + (!n. measurable(s n)) /\ + (!n. measure(s n) <= B) /\ + (!n. s(n) SUBSET s(SUC n)) + ==> measurable(UNIONS { s(n) | n IN (:num) }) /\ + ((\n. lift(measure(s n))) + --> lift(measure(UNIONS { s(n) | n IN (:num) }))) + sequentially`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b /\ (b ==> c))`] THEN + SIMP_TAC[MEASURE_INTEGRAL_UNIV; LIFT_DROP] THEN + REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT `b /\ c ==> b /\ (b ==> c)`) THEN + MATCH_MP_TAC MONOTONE_CONVERGENCE_INCREASING THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL] THEN ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN COND_CASES_TAC THENL + [MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o PART_MATCH (rand o rand) + TRANSITIVE_STEPWISE_LE_EQ o concl) THEN + ASM_REWRITE_TAC[SUBSET_TRANS; SUBSET_REFL] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN + SIMP_TAC[NOT_EXISTS_THM; IN_UNIV; LIM_CONST]]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEASURABLE_INTEGRABLE]) THEN + ASM_SIMP_TAC[INTEGRAL_MEASURE_UNIV] THEN + REWRITE_TAC[bounded; SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN + EXISTS_TAC `B:real` THEN REWRITE_TAC[IN_UNIV; NORM_LIFT] THEN + REWRITE_TAC[real_abs] THEN ASM_MESON_TAC[MEASURE_POS_LE]]);; + +let MEASURABLE_NESTED_UNIONS = prove + (`!s:num->real^N->bool B. + (!n. measurable(s n)) /\ + (!n. measure(s n) <= B) /\ + (!n. s(n) SUBSET s(SUC n)) + ==> measurable(UNIONS { s(n) | n IN (:num) })`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_NESTED_UNIONS) THEN + SIMP_TAC[]);; + +let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS = prove + (`!s:num->real^N->bool B. + (!n. measurable(s n)) /\ + (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\ + (!n. sum (0..n) (\k. measure(s k)) <= B) + ==> measurable(UNIONS { s(n) | n IN (:num) }) /\ + ((\n. lift(measure(s n))) sums + lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real^N->bool`; `B:real`] + HAS_MEASURE_NESTED_UNIONS) THEN + REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN + SUBGOAL_THEN + `!n. (UNIONS (IMAGE s (0..n)):real^N->bool) has_measure + (sum(0..n) (\k. measure(s k)))` + MP_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN + ASM_SIMP_TAC[FINITE_NUMSEG]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + ASSUME_TAC(GEN `n:num` (MATCH_MP MEASURE_UNIQUE (SPEC `n:num` th)))) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN + GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN + SUBGOAL_THEN + `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real^N->bool = + UNIONS (IMAGE s (:num))` + (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[]) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);; + +let NEGLIGIBLE_COUNTABLE_UNIONS_GEN = prove + (`!f. COUNTABLE f /\ (!s:real^N->bool. s IN f ==> negligible s) + ==> negligible(UNIONS f)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0; NEGLIGIBLE_EMPTY] THEN + MP_TAC(ISPEC `f:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN ASM_REWRITE_TAC[]);; + +let HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED = prove + (`!s:num->real^N->bool. + (!n. measurable(s n)) /\ + (!m n. ~(m = n) ==> negligible(s m INTER s n)) /\ + bounded(UNIONS { s(n) | n IN (:num) }) + ==> measurable(UNIONS { s(n) | n IN (:num) }) /\ + ((\n. lift(measure(s n))) sums + lift(measure(UNIONS { s(n) | n IN (:num) }))) (from 0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS THEN + EXISTS_TAC `measure(interval[a:real^N,b])` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS (IMAGE (s:num->real^N->bool) (0..n)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN + ASM_SIMP_TAC[FINITE_NUMSEG]; + MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE]; + ASM SET_TAC[]]]);; + +let MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove + (`!s:num->real^N->bool. + (!n. measurable(s n)) /\ + bounded(UNIONS { s(n) | n IN (:num) }) + ==> measurable(UNIONS { s(n) | n IN (:num) })`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `UNIONS { s(n):real^N->bool | n IN (:num) } = + UNIONS { UNIONS {s(m) | m IN 0..n} | n IN (:num)}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[IN_NUMSEG; IN_UNIV; LE_0] THEN MESON_TAC[LE_REFL]; + MATCH_MP_TAC MEASURABLE_NESTED_UNIONS THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + EXISTS_TAC `measure(interval[a:real^N,b])` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG]; + DISCH_TAC] THEN + CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[MEASURABLE_INTERVAL] THEN ASM SET_TAC[]; + GEN_TAC THEN REWRITE_TAC[NUMSEG_CLAUSES; LE_0] THEN SET_TAC[]]]);; + +let MEASURE_COUNTABLE_UNIONS_LE_STRONG = prove + (`!d:num->(real^N->bool) B. + (!n. measurable(d n)) /\ + (!n. measure(UNIONS {d k | k <= n}) <= B) + ==> measurable(UNIONS {d n | n IN (:num)}) /\ + measure(UNIONS {d n | n IN (:num)}) <= B`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n. UNIONS {(d:num->(real^N->bool)) k | k IN (0..n)}`; + `B:real`] + HAS_MEASURE_NESTED_UNIONS) THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `UNIONS {UNIONS {d k | k IN (0..n)} | n IN (:num)} = + UNIONS {d n:real^N->bool | n IN (:num)}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_NUMSEG; LE_0] THEN + MESON_TAC[LE_REFL]; + ALL_TAC] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE]; + ASM_REWRITE_TAC[IN_NUMSEG; LE_0]; + GEN_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC SUBSET_UNIONS THEN MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET_NUMSEG] THEN ARITH_TAC]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_UBOUND) THEN + EXISTS_TAC `\n. lift(measure(UNIONS {d k | k IN 0..n} :real^N->bool))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[LIFT_DROP; IN_NUMSEG; LE_0]]);; + +let MEASURE_COUNTABLE_UNIONS_LE = prove + (`!d:num->(real^N->bool) B. + (!n. measurable(d n)) /\ + (!n. sum(0..n) (\k. measure(d k)) <= B) + ==> measurable(UNIONS {d n | n IN (:num)}) /\ + measure(UNIONS {d n | n IN (:num)}) <= B`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`0..n`;`d:num->real^N->bool`] MEASURE_UNIONS_LE_IMAGE) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + REPEAT(FIRST_X_ASSUM (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE; numseg; LE_0; IN_ELIM_THM] THEN + MESON_TAC[REAL_LE_TRANS]);; + +let MEASURABLE_COUNTABLE_UNIONS_STRONG = prove + (`!s:num->real^N->bool B. + (!n. measurable(s n)) /\ + (!n. measure(UNIONS {s k | k <= n}) <= B) + ==> measurable(UNIONS { s(n) | n IN (:num) })`, + MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE_STRONG; REAL_LE_REFL]);; + +let MEASURABLE_COUNTABLE_UNIONS = prove + (`!s:num->real^N->bool B. + (!n. measurable(s n)) /\ + (!n. sum (0..n) (\k. measure(s k)) <= B) + ==> measurable(UNIONS { s(n) | n IN (:num) })`, + MESON_TAC[MEASURE_COUNTABLE_UNIONS_LE; REAL_LE_REFL]);; + +let MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN = prove + (`!D B. COUNTABLE D /\ + (!d:real^N->bool. d IN D ==> measurable d) /\ + (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B) + ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL + [ASM_SIMP_TAC[UNIONS_0; MEASURABLE_EMPTY; SUBSET_EMPTY] THEN + MESON_TAC[FINITE_EMPTY]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; FORALL_SUBSET_IMAGE] THEN + REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{k:num | k <= n}`) THEN + SIMP_TAC[FINITE_NUMSEG_LE; FINITE_IMAGE] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + REPLICATE_TAC 3 AP_TERM_TAC THEN SET_TAC[]]);; + +let MEASURE_COUNTABLE_UNIONS_LE_GEN = prove + (`!D B. COUNTABLE D /\ + (!d:real^N->bool. d IN D ==> measurable d) /\ + (!D'. D' SUBSET D /\ FINITE D' ==> sum D' (\d. measure d) <= B) + ==> measurable(UNIONS D) /\ measure(UNIONS D) <= B`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `D':(real^N->bool)->bool` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `D':(real^N->bool)->bool`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC MEASURE_UNIONS_LE THEN ASM SET_TAC[]);; + +let MEASURABLE_COUNTABLE_INTERS = prove + (`!s:num->real^N->bool. + (!n. measurable(s n)) + ==> measurable(INTERS { s(n) | n IN (:num) })`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `INTERS { s(n):real^N->bool | n IN (:num) } = + s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_STRONG THEN + EXISTS_TAC `measure(s 0:real^N->bool)` THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; LE_0] THEN + GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN + MESON_TAC[IN_DIFF]] THEN + ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + MEASURABLE_DIFF; MEASURABLE_UNIONS]);; + +let MEASURABLE_COUNTABLE_INTERS_GEN = prove + (`!D. COUNTABLE D /\ ~(D = {}) /\ + (!d:real^N->bool. d IN D ==> measurable d) + ==> measurable(INTERS D)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE; IN_UNIV] THEN + GEN_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN ASM SET_TAC[]);; + +let MEASURE_COUNTABLE_UNIONS_APPROACHABLE = prove + (`!D B e. + COUNTABLE D /\ + (!d. d IN D ==> measurable d) /\ + (!D'. D' SUBSET D /\ FINITE D' ==> measure(UNIONS D') <= B) /\ + &0 < e + ==> ?D'. D' SUBSET D /\ FINITE D' /\ + measure(UNIONS D) - e < measure(UNIONS D':real^N->bool)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL + [DISCH_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET; FINITE_EMPTY; UNIONS_0; MEASURE_EMPTY] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPEC `D:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real^N->bool` SUBST1_TAC) THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; + FORALL_SUBSET_IMAGE] THEN + REWRITE_TAC[IN_UNIV; SUBSET_UNIV] THEN REPEAT DISCH_TAC THEN + MP_TAC(ISPECL + [`\n. UNIONS(IMAGE (d:num->real^N->bool) {k | k <= n})`; + `B:real`] HAS_MEASURE_NESTED_UNIONS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE; + FINITE_NUMSEG_LE; IN_ELIM_THM] THEN + GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `UNIONS {UNIONS (IMAGE d {k | k <= n}) | n IN (:num)}:real^N->bool = + UNIONS (IMAGE d (:num))` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE] THEN REWRITE_TAC[UNIONS_GSPEC] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EXTENSION] THEN + MESON_TAC[LE_REFL]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[LIM_SEQUENTIALLY; DIST_REAL; GSYM drop; LIFT_DROP] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN + EXISTS_TAC `{k:num | k <= n}` THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `abs(x - u) < e /\ &0 < e ==> u - e < x`]]);; + +let HAS_MEASURE_NESTED_INTERS = prove + (`!s:num->real^N->bool. + (!n. measurable(s n)) /\ + (!n. s(SUC n) SUBSET s(n)) + ==> measurable(INTERS {s n | n IN (:num)}) /\ + ((\n. lift(measure (s n))) --> + lift(measure (INTERS {s n | n IN (:num)}))) sequentially`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`\n. (s:num->real^N->bool) 0 DIFF s n`; `measure(s 0:real^N->bool)`] + HAS_MEASURE_NESTED_UNIONS) THEN + ASM_SIMP_TAC[MEASURABLE_DIFF] THEN ANTS_TAC THENL + [CONJ_TAC THEN X_GEN_TAC `n:num` THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; SUBSET_DIFF] THEN SET_TAC[]; + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN SET_TAC[]]; + SUBGOAL_THEN + `UNIONS {s 0 DIFF s n | n IN (:num)} = + s 0 DIFF INTERS {s n :real^N->bool | n IN (:num)}` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[DIFF_INTERS] THEN SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN + `measurable(s 0 DIFF (s 0 DIFF INTERS {s n | n IN (:num)}) + :real^N->bool)` + MP_TAC THENL [ASM_SIMP_TAC[MEASURABLE_DIFF]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `t SUBSET s ==> s DIFF (s DIFF t) = t`) THEN + REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM] THEN SET_TAC[]; + + MP_TAC(ISPECL [`sequentially`; `lift(measure(s 0:real^N->bool))`] + LIM_CONST) THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + REWRITE_TAC[GSYM LIFT_SUB] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[LIFT_EQ; FUN_EQ_THM] THEN + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `s - m:real = n <=> m = s - n`] THEN + MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_COUNTABLE_INTERS] THENL + [ALL_TAC; SET_TAC[]] THEN + MP_TAC(ISPEC `\m n:num. (s n :real^N->bool) SUBSET (s m)` + TRANSITIVE_STEPWISE_LE) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [SET_TAC[]; MESON_TAC[LE_0]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Measurability of compact and bounded open sets. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_COMPACT = prove + (`!s:real^N->bool. compact s ==> measurable s`, + let lemma = prove + (`!f s:real^N->bool. + (!n. FINITE(f n)) /\ + (!n. s SUBSET UNIONS(f n)) /\ + (!x. ~(x IN s) ==> ?n. ~(x IN UNIONS(f n))) /\ + (!n a. a IN f(SUC n) ==> ?b. b IN f(n) /\ a SUBSET b) /\ + (!n a. a IN f(n) ==> measurable a) + ==> measurable s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n. UNIONS(f(SUC n):(real^N->bool)->bool) SUBSET UNIONS(f n)` + ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `s = INTERS { UNIONS(f n) | n IN (:num) }:real^N->bool` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[IN_IMAGE] THEN ASM SET_TAC[]; + MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[]]) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN + EXISTS_TAC + `\n. { k | ?u:real^N. (!i. 1 <= i /\ i <= dimindex(:N) + ==> integer(u$i)) /\ + k = { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> u$i / &2 pow n <= x$i /\ + x$i < (u$i + &1) / &2 pow n } /\ + ~(s INTER k = {})}` THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + SUBGOAL_THEN + `?N. !x:real^N i. x IN s /\ 1 <= i /\ i <= dimindex(:N) + ==> abs(x$i * &2 pow n) < &N` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + MP_TAC(SPEC `B * &2 pow n` (MATCH_MP REAL_ARCH REAL_LT_01)) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MUL_RID] THEN + X_GEN_TAC `N:num` THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_LET_TRANS]; + ALL_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `IMAGE (\u. {x | !i. 1 <= i /\ i <= dimindex(:N) + ==> (u:real^N)$i <= (x:real^N)$i * &2 pow n /\ + x$i * &2 pow n < u$i + &1}) + {u | !i. 1 <= i /\ i <= dimindex(:N) ==> integer (u$i) /\ + abs(u$i) <= &N}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_CART THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE; FINITE_INTSEG]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `l:real^N->bool` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC[] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_REVERSE_INTEGERS THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` MP_TAC) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `k:num`)) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `k:num`]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + X_GEN_TAC `n:num` THEN REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN + REWRITE_TAC[UNWIND_THM2] THEN SIMP_TAC[LAMBDA_BETA; FLOOR] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_MUL_SYM; FLOOR]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN + REWRITE_TAC[closed; open_def] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; + DIMINDEX_GE_1; ARITH_RULE `0 < x <=> 1 <= x`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN + REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + X_GEN_TAC `u:real^N` THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `d < e ==> x <= d ==> x < e`)) THEN + REWRITE_TAC[dist] THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC SUM_BOUND THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN + ASM_REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_LID; GSYM REAL_POW_INV] THEN REAL_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) ASSUME_TAC) THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b /\ c) /\ d <=> b /\ a /\ c /\ d`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + EXISTS_TAC `(lambda i. floor((u:real^N)$i / &2)):real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; LAMBDA_BETA; FLOOR] THEN + MATCH_MP_TAC(SET_RULE `~(s INTER a = {}) /\ a SUBSET b + ==> ~(s INTER b = {}) /\ a SUBSET b`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "a" THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + MP_TAC(SPEC `(u:real^N)$k / &2` FLOOR) THEN + REWRITE_TAC[REAL_ARITH `u / &2 < floor(u / &2) + &1 <=> + u < &2 * floor(u / &2) + &2`] THEN + ASM_SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED; FLOOR_FRAC] THEN + REAL_ARITH_TAC; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `a:real^N->bool`; `u:real^N`] THEN + DISCH_THEN(SUBST1_TAC o CONJUNCT1 o CONJUNCT2) THEN + ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN + GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `interval(inv(&2 pow n) % u:real^N, + inv(&2 pow n) % (u + vec 1))` THEN + EXISTS_TAC `interval[inv(&2 pow n) % u:real^N, + inv(&2 pow n) % (u + vec 1)]` THEN + REWRITE_TAC[MEASURABLE_INTERVAL; MEASURE_INTERVAL] THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN + CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT; + VEC_COMPONENT] THEN + REAL_ARITH_TAC]);; + +let MEASURABLE_OPEN = prove + (`!s:real^N->bool. bounded s /\ open s ==> measurable s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> s = t DIFF (t DIFF s)`)) THEN + MATCH_MP_TAC MEASURABLE_DIFF THEN + REWRITE_TAC[MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC MEASURABLE_COMPACT THEN + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_DIFF; BOUNDED_INTERVAL] THEN + MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[CLOSED_INTERVAL]);; + +let MEASURE_OPEN_POS_LT = prove + (`!s. open s /\ bounded s /\ ~(s = {}) ==> &0 < measure s`, + MESON_TAC[OPEN_NOT_NEGLIGIBLE; MEASURABLE_MEASURE_POS_LT; MEASURABLE_OPEN]);; + +let MEASURABLE_CLOSURE = prove + (`!s. bounded s ==> measurable(closure s)`, + SIMP_TAC[MEASURABLE_COMPACT; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; + BOUNDED_CLOSURE]);; + +let MEASURABLE_INTERIOR = prove + (`!s. bounded s ==> measurable(interior s)`, + SIMP_TAC[MEASURABLE_OPEN; OPEN_INTERIOR; BOUNDED_INTERIOR]);; + +let MEASURABLE_FRONTIER = prove + (`!s:real^N->bool. bounded s ==> measurable(frontier s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN + MATCH_MP_TAC MEASURABLE_DIFF THEN + ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; + +let MEASURE_FRONTIER = prove + (`!s:real^N->bool. + bounded s + ==> measure(frontier s) = measure(closure s) - measure(interior s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[frontier] THEN + MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_CLOSURE; MEASURABLE_INTERIOR] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; + +let MEASURE_CLOSURE = prove + (`!s:real^N->bool. + bounded s /\ negligible(frontier s) + ==> measure(closure s) = measure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + ASM_SIMP_TAC[MEASURABLE_CLOSURE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + REWRITE_TAC[frontier] THEN SET_TAC[]);; + +let MEASURE_INTERIOR = prove + (`!s:real^N->bool. + bounded s /\ negligible(frontier s) + ==> measure(interior s) = measure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_SYMDIFF THEN + ASM_SIMP_TAC[MEASURABLE_INTERIOR] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + REWRITE_TAC[frontier] THEN SET_TAC[]);; + +let MEASURABLE_JORDAN = prove + (`!s:real^N->bool. bounded s /\ negligible(frontier s) ==> measurable s`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN + GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `interior(s):real^N->bool` THEN + EXISTS_TAC `closure(s):real^N->bool` THEN + ASM_SIMP_TAC[MEASURABLE_INTERIOR; MEASURABLE_CLOSURE] THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + ASM_SIMP_TAC[GSYM MEASURE_FRONTIER; REAL_ABS_NUM; MEASURE_EQ_0]);; + +let HAS_MEASURE_ELEMENTARY = prove + (`!d s. d division_of s ==> s has_measure (sum d content)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_measure] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIVISION_OF_FINITE) THEN + ASM_SIMP_TAC[LIFT_SUM] THEN + MATCH_MP_TAC HAS_INTEGRAL_COMBINE_DIVISION THEN + ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM has_measure] THEN + ASM_MESON_TAC[HAS_MEASURE_INTERVAL; division_of]);; + +let MEASURABLE_ELEMENTARY = prove + (`!d s. d division_of s ==> measurable s`, + REWRITE_TAC[measurable] THEN MESON_TAC[HAS_MEASURE_ELEMENTARY]);; + +let MEASURE_ELEMENTARY = prove + (`!d s. d division_of s ==> measure s = sum d content`, + MESON_TAC[HAS_MEASURE_ELEMENTARY; MEASURE_UNIQUE]);; + +let MEASURABLE_INTER_INTERVAL = prove + (`!s a b:real^N. measurable s ==> measurable (s INTER interval[a,b])`, + SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL]);; + +let MEASURABLE_INSIDE = prove + (`!s:real^N->bool. compact s ==> measurable(inside s)`, + SIMP_TAC[MEASURABLE_OPEN; BOUNDED_INSIDE; COMPACT_IMP_CLOSED; + OPEN_INSIDE; COMPACT_IMP_BOUNDED]);; + +(* ------------------------------------------------------------------------- *) +(* A nice lemma for negligibility proofs. *) +(* ------------------------------------------------------------------------- *) + +let STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE = prove + (`!s. measurable s /\ bounded s /\ + (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1) + ==> negligible s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(&0 < measure(s:real^N->bool))` + (fun th -> ASM_MESON_TAC[th; MEASURABLE_MEASURE_POS_LT]) THEN + DISCH_TAC THEN + MP_TAC(SPEC `(vec 0:real^N) INSERT s` + BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN + ASM_SIMP_TAC[BOUNDED_INSERT; COMPACT_IMP_BOUNDED; NOT_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET] THEN STRIP_TAC THEN + SUBGOAL_THEN + `?N. EVEN N /\ &0 < &N /\ + measure(interval[--a:real^N,a]) + < (&N * measure(s:real^N->bool)) / &4 pow dimindex (:N)` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC + `measure(interval[--a:real^N,a]) * &4 pow (dimindex(:N))` o + MATCH_MP REAL_ARCH) THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + SIMP_TAC[GSYM REAL_LT_LDIV_EQ; ASSUME `&0 < measure(s:real^N->bool)`] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `2 * (N DIV 2 + 1)` THEN REWRITE_TAC[EVEN_MULT; ARITH] THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a ==> a <= b ==> x < b`)) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`UNIONS (IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s) + (1..N))`; + `interval[--a:real^N,a]`] MEASURE_SUBSET) THEN + MP_TAC(ISPECL [`measure:(real^N->bool)->real`; + `IMAGE (\m. IMAGE (\x:real^N. (&m / &N) % x) s) (1..N)`] + HAS_MEASURE_DISJOINT_UNIONS) THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN + MATCH_MP_TAC MEASURABLE_SCALING THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ ~c ==> d <=> a /\ b /\ ~d ==> c`] THEN + SUBGOAL_THEN + `!m n. m IN 1..N /\ n IN 1..N /\ + ~(DISJOINT (IMAGE (\x:real^N. &m / &N % x) s) + (IMAGE (\x. &n / &N % x) s)) + ==> m = n` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `(%) (&N / &m) :real^N->real^N`) THEN + SUBGOAL_THEN `~(&N = &0) /\ ~(&m = &0)` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG])) THEN + ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE (BINDER_CONV o BINDER_CONV) + [GSYM CONTRAPOS_THM]) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_FIELD + `~(x = &0) /\ ~(y = &0) ==> x / y * y / x = &1`] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(x = &0) /\ ~(y = &0) ==> x / y * z / x = z / y`] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`&n / &m`; `y:real^N`]) THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_FIELD + `~(y = &0) ==> (x / y = &1 <=> x = y)`] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; EQ_SYM_EQ]; + ALL_TAC] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[measurable] THEN ASM_MESON_TAC[]; + REWRITE_TAC[MEASURABLE_INTERVAL]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `a:real^N`] CONVEX_INTERVAL) THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[CONVEX_ALT] o CONJUNCT1) THEN + DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `x:real^N`; `&n / &N`]) THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + DISCH_THEN MATCH_MP_TAC THEN SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_NUMSEG]) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `1 <= n /\ n <= N ==> 0 < N /\ n <= N`)) THEN + SIMP_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT; REAL_LE_LDIV_EQ] THEN + SIMP_TAC[REAL_MUL_LID]; + ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE) THEN + ASM_SIMP_TAC[MEASURE_SCALING; REAL_NOT_LE] THEN + FIRST_X_ASSUM(K ALL_TAC o SPEC `&0`) THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC + `sum (1..N) (measure o (\m. IMAGE (\x:real^N. &m / &N % x) s))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_IMAGE THEN REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[SET_RULE `DISJOINT s s <=> s = {}`; IMAGE_EQ_EMPTY] THEN + DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[REAL_LT_REFL; MEASURE_EMPTY]] THEN + FIRST_X_ASSUM(K ALL_TAC o SPEC `0`) THEN + ASM_SIMP_TAC[o_DEF; MEASURE_SCALING; SUM_RMUL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < a ==> a <= b ==> x < b`)) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REWRITE_TAC[GSYM SUM_RMUL] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `M:num` SUBST_ALL_TAC o + GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_MUL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `&0 < &2 * x <=> &0 < x`]) THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < y ==> x / (&2 * y) * &4 = x * &2 / y`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(M..(2*M)) (\i. (&i * &2 / &M) pow dimindex (:N))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_LE_DIV; REAL_POS] THEN + REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG; SUBSET] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_OF_NUM_LT]) THEN + ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(M..(2*M)) (\i. &2)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_CONST_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `(2 * M + 1) - M = M + 1`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow (dimindex(:N))` THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN + MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[DIMINDEX_GE_1] THEN + ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_POS; ARITH; real_div; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `M:num <= n` THEN ARITH_TAC);; + +let STARLIKE_NEGLIGIBLE_LEMMA = prove + (`!s. compact s /\ + (!c x:real^N. &0 <= c /\ x IN s /\ (c % x) IN s ==> c = &1) + ==> negligible s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE THEN + ASM_MESON_TAC[MEASURABLE_COMPACT; COMPACT_IMP_BOUNDED]);; + +let STARLIKE_NEGLIGIBLE = prove + (`!s a. closed s /\ + (!c x:real^N. &0 <= c /\ (a + x) IN s /\ (a + c % x) IN s ==> c = &1) + ==> negligible s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION_REV THEN + EXISTS_TAC `--a:real^N` THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + MATCH_MP_TAC STARLIKE_NEGLIGIBLE_LEMMA THEN CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_INTER_COMPACT THEN REWRITE_TAC[COMPACT_INTERVAL] THEN + ASM_SIMP_TAC[CLOSED_TRANSLATION]; + REWRITE_TAC[IN_IMAGE; IN_INTER] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> y = a + x`] THEN + REWRITE_TAC[UNWIND_THM2] THEN ASM MESON_TAC[]]);; + +let STARLIKE_NEGLIGIBLE_STRONG = prove + (`!s a. closed s /\ + (!c x:real^N. &0 <= c /\ c < &1 /\ (a + x) IN s + ==> ~((a + c % x) IN s)) + ==> negligible s`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `~(x < y) /\ ~(y < x) ==> x = y`) THEN + STRIP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`inv c:real`; `c % x:real^N`]) THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < c ==> ~(c = &0)`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; + +(* ------------------------------------------------------------------------- *) +(* In particular. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_HYPERPLANE = prove + (`!a b. ~(a = vec 0 /\ b = &0) ==> negligible {x:real^N | a dot x = b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | F} = {}`; NEGLIGIBLE_EMPTY] THEN + MATCH_MP_TAC STARLIKE_NEGLIGIBLE THEN + SUBGOAL_THEN `?x:real^N. ~(a dot x = b)` MP_TAC THENL + [MATCH_MP_TAC(MESON[] `!a:real^N. P a \/ P(--a) ==> ?x. P x`) THEN + EXISTS_TAC `a:real^N` THEN REWRITE_TAC[DOT_RNEG] THEN + MATCH_MP_TAC(REAL_ARITH `~(a = &0) ==> ~(a = b) \/ ~(--a = b)`) THEN + ASM_REWRITE_TAC[DOT_EQ_0]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[CLOSED_HYPERPLANE; IN_ELIM_THM; DOT_RADD; DOT_RMUL] THEN + MAP_EVERY X_GEN_TAC [`t:real`; `y:real^N`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `&0 <= t /\ ac + ay = b /\ ac + t * ay = b + ==> ((ay = &0 ==> ac = b) /\ (t - &1) * ay = &0)`)) THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_SUB_0] THEN CONV_TAC TAUT);; + +let NEGLIGIBLE_LOWDIM = prove + (`!s:real^N->bool. dim(s) < dimindex(:N) ==> negligible s`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `span(s):real^N->bool` THEN REWRITE_TAC[SPAN_INC] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | a dot x = &0}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; + +let NEGLIGIBLE_AFFINE_HULL = prove + (`!s:real^N->bool. + FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(affine hull s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[AFFINE_HULL_EMPTY; NEGLIGIBLE_EMPTY] THEN + SUBGOAL_THEN + `!x s:real^N->bool n. + ~(x IN s) /\ (x INSERT s) HAS_SIZE n /\ n <= dimindex(:N) + ==> negligible(affine hull(x INSERT s))` + (fun th -> MESON_TAC[th; HAS_SIZE; FINITE_INSERT]) THEN + X_GEN_TAC `orig:real^N` THEN GEOM_ORIGIN_TAC `orig:real^N` THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; IN_INSERT; SPAN_INSERT_0; HULL_INC] THEN + REWRITE_TAC[HAS_SIZE; FINITE_INSERT; IMP_CONJ] THEN + SIMP_TAC[CARD_CLAUSES] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(s:real^N->bool)` THEN + ASM_SIMP_TAC[DIM_LE_CARD; DIM_SPAN] THEN ASM_ARITH_TAC);; + +let NEGLIGIBLE_AFFINE_HULL_1 = prove + (`!a:real^1. negligible (affine hull {a})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN + ARITH_TAC);; + +let NEGLIGIBLE_AFFINE_HULL_2 = prove + (`!a b:real^2. negligible (affine hull {a,b})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN + ARITH_TAC);; + +let NEGLIGIBLE_AFFINE_HULL_3 = prove + (`!a b c:real^3. negligible (affine hull {a,b,c})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_AFFINE_HULL THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN + ARITH_TAC);; + +let NEGLIGIBLE_CONVEX_HULL = prove + (`!s:real^N->bool. + FINITE s /\ CARD(s) <= dimindex(:N) ==> negligible(convex hull s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP NEGLIGIBLE_AFFINE_HULL) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL]);; + +let NEGLIGIBLE_CONVEX_HULL_1 = prove + (`!a:real^1. negligible (convex hull {a})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_1] THEN + ARITH_TAC);; + +let NEGLIGIBLE_CONVEX_HULL_2 = prove + (`!a b:real^2. negligible (convex hull {a,b})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_2] THEN + ARITH_TAC);; + +let NEGLIGIBLE_CONVEX_HULL_3 = prove + (`!a b c:real^3. negligible (convex hull {a,b,c})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_CONVEX_HULL THEN + SIMP_TAC[FINITE_INSERT; CARD_CLAUSES; FINITE_EMPTY; DIMINDEX_3] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Measurability of bounded convex sets. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_CONVEX_FRONTIER = prove + (`!s:real^N->bool. convex s ==> negligible(frontier s)`, + SUBGOAL_THEN + `!s:real^N->bool. convex s /\ (vec 0) IN s ==> negligible(frontier s)` + ASSUME_TAC THENL + [ALL_TAC; + X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[FRONTIER_EMPTY; NEGLIGIBLE_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN + ASM_SIMP_TAC[CONVEX_TRANSLATION; IN_IMAGE] THEN + ASM_REWRITE_TAC[UNWIND_THM2; + VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + REWRITE_TAC[FRONTIER_TRANSLATION; NEGLIGIBLE_TRANSLATION_EQ]] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` DIM_SUBSET_UNIV) THEN + REWRITE_TAC[ARITH_RULE `d:num <= e <=> d < e \/ d = e`] THEN STRIP_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `closure s:real^N->bool` THEN + REWRITE_TAC[frontier; SUBSET_DIFF] THEN + MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_REWRITE_TAC[DIM_CLOSURE]; + ALL_TAC] THEN + SUBGOAL_THEN `?a:real^N. a IN interior s` CHOOSE_TAC THENL + [X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC + (ISPEC `s:real^N->bool` BASIS_EXISTS) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(ISPEC `b:real^N->bool` INTERIOR_SIMPLEX_NONEMPTY) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[INSERT_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC STARLIKE_NEGLIGIBLE_STRONG THEN + EXISTS_TAC `a:real^N` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[frontier; IN_DIFF; DE_MORGAN_THM] THEN DISJ2_TAC THEN + SIMP_TAC[VECTOR_ARITH + `a + c % x:real^N = (a + x) - (&1 - c) % ((a + x) - a)`] THEN + MATCH_MP_TAC IN_INTERIOR_CLOSURE_CONVEX_SHRINK THEN + RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let MEASURABLE_CONVEX = prove + (`!s:real^N->bool. convex s /\ bounded s ==> measurable s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_JORDAN THEN + ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER]);; + +let NEGLIGIBLE_CONVEX_INTERIOR = prove + (`!s:real^N->bool. convex s ==> (negligible s <=> interior s = {})`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[OPEN_NOT_NEGLIGIBLE; INTERIOR_SUBSET; OPEN_INTERIOR; + NEGLIGIBLE_SUBSET]; + DISCH_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `frontier s:real^N->bool` THEN + ASM_SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER] THEN + ASM_REWRITE_TAC[frontier; DIFF_EMPTY; CLOSURE_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Various special cases. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_SPHERE = prove + (`!a:real^N r. negligible (sphere(a,e))`, + REWRITE_TAC[GSYM FRONTIER_CBALL] THEN + SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_CBALL]);; + +let MEASURABLE_BALL = prove + (`!a r. measurable(ball(a,r))`, + SIMP_TAC[MEASURABLE_OPEN; BOUNDED_BALL; OPEN_BALL]);; + +let MEASURABLE_CBALL = prove + (`!a r. measurable(cball(a,r))`, + SIMP_TAC[MEASURABLE_COMPACT; COMPACT_CBALL]);; + +let MEASURE_BALL_POS = prove + (`!x:real^N e. &0 < e ==> &0 < measure(ball(x,e))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_OPEN_POS_LT THEN + REWRITE_TAC[OPEN_BALL; BOUNDED_BALL; BALL_EQ_EMPTY] THEN + ASM_REAL_ARITH_TAC);; + +let MEASURE_CBALL_POS = prove + (`!x:real^N e. &0 < e ==> &0 < measure(cball(x,e))`, + MESON_TAC[MEASURE_SUBSET; REAL_LTE_TRANS; MEASURABLE_BALL; MEASURABLE_CBALL; + BALL_SUBSET_CBALL; MEASURE_BALL_POS]);; + +let HAS_INTEGRAL_OPEN_INTERVAL = prove + (`!f a b y. (f has_integral y) (interval(a,b)) <=> + (f has_integral y) (interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INTERIOR_CLOSED_INTERVAL] THEN + MATCH_MP_TAC HAS_INTEGRAL_INTERIOR THEN + MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN + REWRITE_TAC[CONVEX_INTERVAL]);; + +let INTEGRABLE_ON_OPEN_INTERVAL = prove + (`!f a b. f integrable_on interval(a,b) <=> + f integrable_on interval[a,b]`, + REWRITE_TAC[integrable_on; HAS_INTEGRAL_OPEN_INTERVAL]);; + +let INTEGRAL_OPEN_INTERVAL = prove + (`!f a b. integral(interval(a,b)) f = integral(interval[a,b]) f`, + REWRITE_TAC[integral; HAS_INTEGRAL_OPEN_INTERVAL]);; + +(* ------------------------------------------------------------------------- *) +(* An existence theorem for "improper" integrals. Hake's theorem implies *) +(* that if the integrals over subintervals have a limit then the integral *) +(* exists. This is incomparable: we only need a priori to assume that *) +(* the integrals are bounded, and we get absolute integrability, but we *) +(* also need a (rather weak) bound assumption on the function. *) +(* ------------------------------------------------------------------------- *) + +let ABSOLUTELY_INTEGRABLE_IMPROPER = prove + (`!net:A net f:real^M->real^N a b. + (!c d. interval[c,d] SUBSET interval(a,b) + ==> f integrable_on interval[c,d]) /\ + bounded { integral (interval[c,d]) f | + interval[c,d] SUBSET interval(a,b)} /\ + (!i. 1 <= i /\ i <= dimindex(:N) + ==> ?g. g absolutely_integrable_on interval[a,b] /\ + ((!x. x IN interval[a,b] ==> (f x)$i <= drop(g x)) \/ + (!x. x IN interval[a,b] ==> (f x)$i >= drop(g x)))) + ==> f absolutely_integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `content(interval[a:real^M,b]) = &0` THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_NULL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONTENT_LT_NZ; CONTENT_POS_LT_EQ]) THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[real_ge] THEN + SUBGOAL_THEN + `(!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET + interval(a:real^M,b)) /\ + (!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET + interval[a:real^M,b])` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ t SUBSET u ==> s SUBSET t /\ s SUBSET u`) THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `a < a + x <=> &0 < x`; + REAL_ARITH `b - x < b <=> &0 < x`; REAL_LT_MUL; + REAL_SUB_LT; REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. interval[a + inv(&n + &1) % (b - a),b - inv(&n + &1) % (b - a)] SUBSET + interval[a + inv(&(SUC n) + &1) % (b - a):real^M, + b - inv(&(SUC n) + &1) % (b - a)]` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL] THEN GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `a + x * y <= a + w * y <=> &0 <= (w - x) * y`; + REAL_ARITH `b - w * y <= b - x * y <=> &0 <= (w - x) * y`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE; GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^1` STRIP_ASSUME_TAC) THENL + [MATCH_MP_TAC + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN + EXISTS_TAC `g:real^M->real^1` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN + ASM_REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP] THEN + SUBGOAL_THEN + `(\x. lift((f:real^M->real^N) x$i)) = (\x. g x - (g x - lift(f x$i)))` + SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + MP_TAC(ISPECL + [`\n x. if x IN interval[a + inv(&n + &1) % (b - a), + b - inv(&n + &1) % (b - a)] + then g x - lift((f:real^M->real^N) x $i) else vec 0`; + `\x. g x - lift((f:real^M->real^N) x$i)`; + `interval(a:real^M,b)`] MONOTONE_CONVERGENCE_INCREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; SIMP_TAC[INTEGRABLE_ON_OPEN_INTERVAL]] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN + ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN + CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN + ASM_MESON_TAC[]]; + ALL_TAC]; + MATCH_MP_TAC + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN + EXISTS_TAC `g:real^M->real^1` THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; DIMINDEX_1] THEN + ASM_REWRITE_TAC[IMP_IMP; FORALL_1; GSYM drop; LIFT_DROP] THEN + SUBGOAL_THEN + `(\x. lift((f:real^M->real^N) x$i)) = (\x. (lift(f x$i) - g x) + g x)` + SUBST1_TAC THENL [ABS_TAC THEN CONV_TAC VECTOR_ARITH; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + MP_TAC(ISPECL + [`\n x. if x IN interval[a + inv(&n + &1) % (b - a), + b - inv(&n + &1) % (b - a)] + then lift((f:real^M->real^N) x $i) - g x else vec 0`; + `\x. lift((f:real^M->real^N) x$i) - g x`; + `interval(a:real^M,b)`] MONOTONE_CONVERGENCE_INCREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; SIMP_TAC[INTEGRABLE_ON_OPEN_INTERVAL]] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_INTER; INTEGRAL_RESTRICT_INTER] THEN + ASM_SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`] THEN + CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]; + ALL_TAC]] THEN + (REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN + ASM_SIMP_TAC[DROP_SUB; DROP_VEC; REAL_SUB_LE; LIFT_DROP] THEN + ASM SET_TAC[]; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN + DISCH_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN MP_TAC(SPEC + `inf({(x - a:real^M)$i / (b - a)$i | i IN 1..dimindex(:M)} UNION + {(b - x:real^M)$i / (b - a)$i | i IN 1..dimindex(:M)})` + REAL_ARCH_INV) THEN + SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1; + FINITE_UNION; IMAGE_UNION; EMPTY_UNION] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_IMAGE] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; IN_NUMSEG; EVENTUALLY_SEQUENTIALLY] THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_RDIV_EQ; REAL_MUL_LZERO] THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC(MESON[] `(!x. ~P x) ==> (?x. P x) ==> Q`) THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT; REAL_ARITH + `a + y <= x /\ x <= b - y <=> y <= x - a /\ y <= b - x`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&N)` THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1] THEN + ASM_ARITH_TAC; + FIRST_ASSUM(MP_TAC o MATCH_MP + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_INTEGRALS_OVER_SUBINTERVALS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B + C:real` THEN ASM_SIMP_TAC[REAL_LT_ADD] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN + GEN_TAC THEN W(MP_TAC o PART_MATCH (lhs o rand) INTEGRAL_SUB o + rand o lhand o snd) THEN + ASM_SIMP_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_SUBINTERVAL; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + DISCH_THEN SUBST1_TAC]]) + THENL + [MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) <= c /\ norm(y) <= b ==> norm(x - y) <= b + c`); + MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) <= c /\ norm(y) <= b ==> norm(x - y) <= c + b`)] THEN + ASM_SIMP_TAC[] THEN IMP_REWRITE_TAC[GSYM LIFT_INTEGRAL_COMPONENT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM INTEGRABLE_COMPONENTWISE]) THEN + ASM_SIMP_TAC[NORM_LIFT] THEN + W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Crude upper bounds for measure of balls. *) +(* ------------------------------------------------------------------------- *) + +let MEASURE_CBALL_BOUND = prove + (`!x:real^N d. + &0 <= d ==> measure(cball(x,d)) <= (&2 * d) pow (dimindex(:N))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(interval[x - d % vec 1:real^N,x + d % vec 1])` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_CBALL; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; dist] THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`x - y:real^N`; `i:num`] COMPONENT_LE_NORM) THEN + ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC; + SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_MUL; REAL_POS] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `(x + a) - (x - a):real = &2 * a`] THEN + REWRITE_TAC[PRODUCT_CONST_NUMSEG; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + REWRITE_TAC[REAL_MUL_RID; ADD_SUB; REAL_LE_REFL]]);; + +let MEASURE_BALL_BOUND = prove + (`!x:real^N d. + &0 <= d ==> measure(ball(x,d)) <= (&2 * d) pow (dimindex(:N))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(cball(x:real^N,d))` THEN + ASM_SIMP_TAC[MEASURE_CBALL_BOUND] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[BALL_SUBSET_CBALL; MEASURABLE_BALL; MEASURABLE_CBALL]);; + +(* ------------------------------------------------------------------------- *) +(* Negligibility of image under non-injective linear map. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_LINEAR_SINGULAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ ~(!x y. f(x) = f(y) ==> x = y) + ==> negligible(IMAGE f s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LINEAR_SINGULAR_IMAGE_HYPERPLANE) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | a dot x = &0}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_HYPERPLANE]);; + +(* ------------------------------------------------------------------------- *) +(* Some technical lemmas used in the approximation results that follow. *) +(* Proof of the covering lemma is an obvious multidimensional generalization *) +(* of Lemma 3, p65 of Swartz's "Introduction to Gauge Integrals". *) +(* ------------------------------------------------------------------------- *) + +let COVERING_LEMMA = prove + (`!a b:real^N s g. + s SUBSET interval[a,b] /\ ~(interval(a,b) = {}) /\ gauge g + ==> ?d. COUNTABLE d /\ + (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\ + (?c d. k = interval[c,d])) /\ + (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) + ==> interior k1 INTER interior k2 = {}) /\ + (!k. k IN d ==> ?x. x IN (s INTER k) /\ k SUBSET g(x)) /\ + (!u v. interval[u,v] IN d + ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) + ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ + s SUBSET UNIONS d`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?d. COUNTABLE d /\ + (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\ + (?c d:real^N. k = interval[c,d])) /\ + (!k1 k2. k1 IN d /\ k2 IN d + ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/ + interior k1 INTER interior k2 = {}) /\ + (!x. x IN s ==> ?k. k IN d /\ x IN k /\ k SUBSET g(x)) /\ + (!u v. interval[u,v] IN d + ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) + ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ + (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l})` + ASSUME_TAC THENL + [EXISTS_TAC + `IMAGE (\(n,v). + interval[(lambda i. a$i + &(v$i) / &2 pow n * + ((b:real^N)$i - (a:real^N)$i)):real^N, + (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))]) + {n,v | n IN (:num) /\ + v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> v$i < 2 EXP n}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN + MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN + REWRITE_TAC[NUM_COUNTABLE; IN_UNIV] THEN + GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN + MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN + SIMP_TAC[INTERVAL_NE_EMPTY; SUBSET_INTERVAL; LAMBDA_BETA] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LE_MUL_EQ; + REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_LE_ADDR; REAL_ARITH + `a + x * (b - a) <= b <=> &0 <= (&1 - x) * (b - a)`] THEN + SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_DIV2_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_ARITH `x <= x + &1 /\ x < x + &1`] THEN + REWRITE_TAC[REAL_SUB_LE] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_POS; REAL_MUL_LID] THEN + SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_POW; REAL_OF_NUM_LE] THEN + ASM_SIMP_TAC[ARITH_RULE `x + 1 <= y <=> x < y`; REAL_LT_IMP_LE]; + ALL_TAC] THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; IN_UNIV] THEN REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN SET_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`v:num^N`; `w:num^N`] THEN REPEAT DISCH_TAC THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL; SUBSET_INTERVAL] THEN + SIMP_TAC[DISJOINT_INTERVAL; LAMBDA_BETA] THEN + MATCH_MP_TAC(TAUT `p \/ q \/ r ==> (a ==> p) \/ (b ==> q) \/ r`) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT; LAMBDA_BETA] THEN + REWRITE_TAC[NOT_IMP; REAL_LE_LADD] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_ARITH `~(x + &1 <= x)`] THEN DISJ2_TAC THEN + MATCH_MP_TAC(MESON[] + `(!i. ~P i ==> Q i) ==> (!i. Q i) \/ (?i. P i)`) THEN + X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE] THEN + UNDISCH_TAC `m:num <= n` THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2; REAL_LT_DIV2_EQ] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2; + REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN + SIMP_TAC[REAL_LT_INTEGERS; INTEGER_CLOSED] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?e. &0 < e /\ !y. (!i. 1 <= i /\ i <= dimindex(:N) + ==> abs((x:real^N)$i - (y:real^N)$i) <= e) + ==> y IN g(x)` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [gauge]) THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / &2 / &(dimindex(:N))` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; + ARITH] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ x IN s ==> x IN t`) THEN + EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[IN_BALL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN + ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; + DIMINDEX_GE_1; VECTOR_SUB_COMPONENT; CARD_NUMSEG_1]; + ALL_TAC] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MP_TAC(SPECL [`&1 / &2`; `e / norm(b - a:real^N)`] + REAL_ARCH_POW_INV) THEN + SUBGOAL_THEN `&0 < norm(b - a:real^N)` ASSUME_TAC THENL + [ASM_MESON_TAC[VECTOR_SUB_EQ; NORM_POS_LT; INTERVAL_SING]; ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN DISCH_TAC THEN + SIMP_TAC[IN_ELIM_THM; IN_INTERVAL; SUBSET; LAMBDA_BETA] THEN + MATCH_MP_TAC(MESON[] + `(!x. Q x ==> R x) /\ (?x. P x /\ Q x) ==> ?x. P x /\ Q x /\ R x`) THEN + CONJ_TAC THENL + [REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`w:num^N`; `y:real^N`] THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(a + n <= x /\ x <= a + m) /\ + (a + n <= y /\ y <= a + m) ==> abs(x - y) <= m - n`)) THEN + MATCH_MP_TAC(REAL_ARITH + `y * z <= e + ==> a <= ((x + &1) * y) * z - ((x * y) * z) ==> a <= e`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `n < e * x ==> &0 <= e * (inv y - x) ==> n <= e / y`)) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_SUB_LT] THEN + MP_TAC(SPECL [`b - a:real^N`; `i:num`] COMPONENT_LE_NORM) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_UNIV; AND_FORALL_THM] THEN + REWRITE_TAC[TAUT `(a ==> c) /\ (a ==> b) <=> a ==> b /\ c`] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN + SUBGOAL_THEN `(x:real^N) IN interval[a,b]` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN STRIP_TAC THEN + DISJ_CASES_TAC(MATCH_MP (REAL_ARITH `x <= y ==> x = y \/ x < y`) + (ASSUME `(x:real^N)$i <= (b:real^N)$i`)) + THENL + [EXISTS_TAC `2 EXP n - 1` THEN + SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_LT; + EXP_LT_0; LE_1; ARITH] THEN + ASM_REWRITE_TAC[REAL_SUB_ADD; REAL_ARITH `a - &1 < a`] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 * (b - a) = x /\ y <= x ==> a + y <= b /\ b <= a + x`) THEN + ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ; REAL_LE_RMUL_EQ; + REAL_SUB_LT; REAL_LT_INV_EQ; REAL_LT_POW2] THEN + SIMP_TAC[GSYM REAL_OF_NUM_POW; REAL_MUL_RINV; REAL_POW_EQ_0; + REAL_OF_NUM_EQ; ARITH_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPEC `&2 pow n * ((x:real^N)$i - (a:real^N)$i) / + ((b:real^N)$i - (a:real^N)$i)` FLOOR_POS) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LE_MUL; REAL_LE_MUL; REAL_POW_LE; REAL_POS; + REAL_SUB_LE; REAL_LT_IMP_LE; REAL_LE_DIV]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + REWRITE_TAC[REAL_ARITH `a + b * c <= x /\ x <= a + b' * c <=> + b * c <= x - a /\ x - a <= b' * c`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ; + REAL_SUB_LT; GSYM real_div] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN + SIMP_TAC[FLOOR; REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `((x:real^N)$i - (a:real^N)$i) / + ((b:real^N)$i - (a:real^N)$i) * + &2 pow n` THEN + REWRITE_TAC[FLOOR] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; REAL_LT_POW2] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_MUL_LID; REAL_SUB_LT] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN + REWRITE_TAC[EQ_INTERVAL; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY; IN_UNIV; IN_ELIM_THM] THEN + SIMP_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`; LAMBDA_BETA] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[REAL_LT_LADD; REAL_LT_RMUL_EQ; REAL_SUB_LT; + REAL_LT_DIV2_EQ; REAL_LT_POW2; + REAL_ARITH `~(v + &1 < v)`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + STRIP_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `v:num^N`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC + `IMAGE (\(n,v). + interval[(lambda i. a$i + &(v$i) / &2 pow n * + ((b:real^N)$i - (a:real^N)$i)):real^N, + (lambda i. a$i + (&(v$i) + &1) / &2 pow n * (b$i - a$i))]) + {m,v | m IN 0..n /\ + v IN {v:num^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> v$i < 2 EXP m}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN + MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN + REWRITE_TAC[FINITE_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_CART THEN REWRITE_TAC[FINITE_NUMSEG_LT]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `w:num^N`] THEN DISCH_TAC THEN + DISCH_TAC THEN SIMP_TAC[IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MAP_EVERY EXISTS_TAC [`m:num`; `w:num^N`] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_NUMSEG; GSYM NOT_LT; LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_INTERVAL]) THEN + SIMP_TAC[NOT_IMP; LAMBDA_BETA] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[REAL_LE_LADD; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_ARITH `x <= x + &1`] THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `w / m <= v / n /\ (v + &1) / n <= (w + &1) / m + ==> inv n <= inv m`)) THEN + REWRITE_TAC[REAL_NOT_LE] THEN MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO_LT THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN + `?d. COUNTABLE d /\ + (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(interior k = {}) /\ + (?c d:real^N. k = interval[c,d])) /\ + (!k1 k2. k1 IN d /\ k2 IN d + ==> k1 SUBSET k2 \/ k2 SUBSET k1 \/ + interior k1 INTER interior k2 = {}) /\ + (!k. k IN d ==> (?x. x IN s INTER k /\ k SUBSET g x)) /\ + (!u v. interval[u,v] IN d + ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) + ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ + (!k. k IN d ==> FINITE {l | l IN d /\ k SUBSET l}) /\ + s SUBSET UNIONS d` + MP_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `{k:real^N->bool | k IN d /\ ?x. x IN (s INTER k) /\ k SUBSET g x}` THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `d:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + X_GEN_TAC `k:real^N->bool` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{l:real^N->bool | l IN d /\ k SUBSET l}` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ASM SET_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `{k:real^N->bool | k IN d /\ !k'. k' IN d /\ ~(k = k') + ==> ~(k SUBSET k')}` THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `d:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[FORALL_IN_UNIONS] THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `x:real^N`] THEN DISCH_TAC THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + MP_TAC(ISPEC `\k l:real^N->bool. k IN d /\ l IN d /\ l SUBSET k /\ ~(k = l)` + WF_FINITE) THEN + REWRITE_TAC[WF] THEN ANTS_TAC THENL + [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN X_GEN_TAC `l:real^N->bool` THEN + ASM_CASES_TAC `(l:real^N->bool) IN d` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_RULES] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{m:real^N->bool | m IN d /\ l SUBSET m}` THEN + ASM_SIMP_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `\l:real^N->bool. l IN d /\ x IN l`) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +let COUNTABLE_ELEMENTARY_DIVISION = prove + (`!d. COUNTABLE d /\ (!k. k IN d ==> ?a b:real^N. k = interval[a,b]) + ==> ?d'. COUNTABLE d' /\ + (!k. k IN d' ==> ~(k = {}) /\ ?a b. k = interval[a,b]) /\ + (!k l. k IN d' /\ l IN d' /\ ~(k = l) + ==> interior k INTER interior l = {}) /\ + UNIONS d' = UNIONS d`, + let lemma = prove + (`!s. UNIONS(s DELETE {}) = UNIONS s`, + REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN + MESON_TAC[NOT_IN_EMPTY]) in + REWRITE_TAC[IMP_CONJ; FORALL_COUNTABLE_AS_IMAGE] THEN + REWRITE_TAC[UNIONS_0; EMPTY_UNIONS] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN + REWRITE_TAC[NOT_IN_EMPTY; COUNTABLE_EMPTY]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`d:num->real^N->bool`; `a:num->real^N`; `b:num->real^N`] THEN + DISCH_TAC THEN + (CHOOSE_THEN MP_TAC o prove_recursive_functions_exist num_RECURSION) + `x 0 = ({}:(real^N->bool)->bool) /\ + (!n. x(SUC n) = @q. (x n) SUBSET q /\ + q division_of (d n) UNION UNIONS(x n))` THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!n:num. (x n) division_of UNIONS {d k:real^N->bool | k < n}` + ASSUME_TAC THENL + [INDUCT_TAC THEN + ASM_REWRITE_TAC[LT; SET_RULE `UNIONS {f x |x| F} = {}`; + DIVISION_OF_TRIVIAL] THEN + FIRST_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o + MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o + MATCH_MP DIVISION_OF_UNION_SELF) THEN + DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN + REWRITE_TAC[SET_RULE `{f x | x = a \/ q x} = f a INSERT {f x | q x}`] THEN + REWRITE_TAC[UNIONS_INSERT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM o last o CONJUNCTS) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n. m <= n ==> (x:num->(real^N->bool)->bool) m SUBSET x n` + ASSUME_TAC THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + REPEAT(CONJ_TAC THENL [SET_TAC[]; ALL_TAC]) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`(a:num->real^N) n`; `(b:num->real^N) n`] o + MATCH_MP ELEMENTARY_UNION_INTERVAL_STRONG o + MATCH_MP DIVISION_OF_UNION_SELF o SPEC `n:num`) THEN + DISCH_THEN(ASSUME_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `UNIONS(IMAGE x (:num)) DELETE ({}:real^N->bool)` THEN + REWRITE_TAC[COUNTABLE_DELETE; IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_UNIONS THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN + GEN_TAC THEN MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN + ASM_MESON_TAC[DIVISION_OF_FINITE]; + MAP_EVERY X_GEN_TAC [`n:num`; `k:real^N->bool`] THEN + ASM_MESON_TAC[division_of]; + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + GEN_REWRITE_TAC BINDER_CONV [SWAP_FORALL_THM] THEN + MATCH_MP_TAC WLOG_LE THEN + CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o + SPEC `n:num`) THEN ASM SET_TAC[]; + REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV; + FORALL_IN_UNIONS; SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] + THENL + [X_GEN_TAC `k:real^N->bool` THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o + SPEC `n:num`) THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`n:num`; `y:real^N`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [division_of] o + SPEC `SUC n`) THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_MESON_TAC[ARITH_RULE `n < SUC n`]]]);; + +let EXPAND_CLOSED_OPEN_INTERVAL = prove + (`!a b:real^N e. + &0 < e + ==> ?c d. interval[a,b] SUBSET interval(c,d) /\ + measure(interval(c,d)) <= measure(interval[a,b]) + e`, + let lemma = prove + (`!f n. (\x. lift(product(1..n) (\i. f i + drop x))) continuous at (vec 0)`, + GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; ARITH_EQ; CONTINUOUS_CONST] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_CONST]) in + REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = midpoint(a,b)` THEN + POP_ASSUM MP_TAC THEN GEOM_ORIGIN_TAC `m:real^N` THEN + REWRITE_TAC[midpoint; VECTOR_ARITH + `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN + REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + DISCH_TAC THEN ASM_CASES_TAC `interval[--b:real^N,b] = {}` THENL + [MAP_EVERY EXISTS_TAC [`--b:real^N`; `b:real^N`] THEN + REWRITE_TAC[MEASURE_INTERVAL] THEN + ASM_REWRITE_TAC[CONTENT_EMPTY; EMPTY_SUBSET] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= x <=> &0 <= x`] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`\i. &2 * (b:real^N)$i`; `dimindex(:N)`] lemma) THEN + REWRITE_TAC[continuous_at; DIST_LIFT; FORALL_LIFT; DIST_0; DROP_VEC] THEN + REWRITE_TAC[NORM_LIFT; LIFT_DROP; REAL_ADD_RID] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC + [`--(b + k / &4 % vec 1:real^N)`; `b + k / &4 % vec 1:real^N`] THEN + REWRITE_TAC[MEASURE_INTERVAL; SUBSET_INTERVAL; + CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH `--x <= x <=> &0 <= x`; REAL_LT_ADDR; + REAL_ARITH `&0 < k / &4 <=> &0 < k`; + REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < b`; + REAL_ARITH `&0 <= b /\ &0 < k ==> --(b + k) < --b`; + REAL_ARITH `&0 <= b /\ &0 < k ==> &0 <= b + k`] THEN + REWRITE_TAC[REAL_ARITH `b - --b = &2 * b`; REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC(REAL_ARITH `abs(a - b) < e ==> a <= b + e`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Outer and inner approximation of measurable set by well-behaved sets. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_OUTER_INTERVALS_BOUNDED = prove + (`!s a b:real^N e. + measurable s /\ s SUBSET interval[a,b] /\ &0 < e + ==> ?d. COUNTABLE d /\ + (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\ + (?c d. k = interval[c,d])) /\ + (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) + ==> interior k1 INTER interior k2 = {}) /\ + (!u v. interval[u,v] IN d + ==> ?n. !i. 1 <= i /\ i <= dimindex(:N) + ==> v$i - u$i = (b$i - a$i) / &2 pow n) /\ + (!k. k IN d /\ ~(interval(a,b) = {}) ==> ~(interior k = {})) /\ + s SUBSET UNIONS d /\ + measurable (UNIONS d) /\ + measure (UNIONS d) <= measure s + e`, + let lemma = prove + (`(!x y. (x,y) IN IMAGE (\z. f z,g z) s ==> P x y) <=> + (!z. z IN s ==> P (f z) (g z))`, + REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN MESON_TAC[]) in + REPEAT GEN_TAC THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM_REWRITE_TAC[SUBSET_EMPTY] THEN STRIP_TAC THEN + EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; UNIONS_0; MEASURE_EMPTY; REAL_ADD_LID; + SUBSET_REFL; COUNTABLE_EMPTY; MEASURABLE_EMPTY] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + STRIP_TAC THEN ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN + ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `{interval[a:real^N,b]}` THEN + REWRITE_TAC[UNIONS_1; COUNTABLE_SING] THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT; + NOT_IN_EMPTY; SUBSET_REFL; MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_SING; EQ_INTERVAL] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `0` THEN + ASM_REWRITE_TAC[real_pow; REAL_DIV_1]; + SUBGOAL_THEN + `measure(interval[a:real^N,b]) = &0 /\ measure(s:real^N->bool) = &0` + (fun th -> ASM_SIMP_TAC[th; REAL_LT_IMP_LE; REAL_ADD_LID]) THEN + SUBGOAL_THEN + `interval[a:real^N,b] has_measure &0 /\ + (s:real^N->bool) has_measure &0` + (fun th -> MESON_TAC[th; MEASURE_UNIQUE]) THEN + REWRITE_TAC[HAS_MEASURE_0] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[NEGLIGIBLE_INTERVAL]; + ASM_MESON_TAC[NEGLIGIBLE_SUBSET]]]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN + DISCH_THEN(X_CHOOSE_TAC `m:real`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURE_UNIQUE) THEN + SUBGOAL_THEN + `((\x:real^N. if x IN s then vec 1 else vec 0) has_integral (lift m)) + (interval[a,b])` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_EQ) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_integral]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`a:real^N`; `b:real^N`; `s:real^N->bool`; + `g:real^N->real^N->bool`] COVERING_LEMMA) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_EMPTY]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`(\x. if x IN s then vec 1 else vec 0):real^N->real^1`; + `a:real^N`; `b:real^N`; `g:real^N->real^N->bool`; + `e:real`] + HENSTOCK_LEMMA_PART1) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "*") THEN + SUBGOAL_THEN + `!k l:real^N->bool. k IN d /\ l IN d /\ ~(k = l) + ==> negligible(k INTER l)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `l:real^N->bool`]) THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN + `?x y:real^N u v:real^N. k = interval[x,y] /\ l = interval[u,v]` + MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN + REWRITE_TAC[INTERIOR_CLOSED_INTERVAL] THEN DISCH_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `(interval[x:real^N,y] DIFF interval(x,y)) UNION + (interval[u:real^N,v] DIFF interval(u,v)) UNION + (interval (x,y) INTER interval (u,v))` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + ASM_REWRITE_TAC[UNION_EMPTY] THEN + SIMP_TAC[NEGLIGIBLE_UNION; NEGLIGIBLE_FRONTIER_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `!D. FINITE D /\ D SUBSET d + ==> measurable(UNIONS D :real^N->bool) /\ measure(UNIONS D) <= m + e` + ASSUME_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `?t:(real^N->bool)->real^N. !k. k IN D ==> t(k) IN (s INTER k) /\ + k SUBSET (g(t k))` + (CHOOSE_THEN (LABEL_TAC "+")) THENL + [REWRITE_TAC[GSYM SKOLEM_THM] THEN ASM SET_TAC[]; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC + `IMAGE (\k. (t:(real^N->bool)->real^N) k,k) D`) THEN + ASM_SIMP_TAC[VSUM_IMAGE; PAIR_EQ] THEN REWRITE_TAC[o_DEF] THEN + ANTS_TAC THENL + [REWRITE_TAC[tagged_partial_division_of; fine] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[lemma; RIGHT_FORALL_IMP_THM; IMP_CONJ; PAIR_EQ] THEN + ASM_SIMP_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET]]; + ALL_TAC] THEN + USE_THEN "+" (MP_TAC o REWRITE_RULE[IN_INTER]) THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[VSUM_SUB] THEN + SUBGOAL_THEN `D division_of (UNIONS D:real^N->bool)` ASSUME_TAC THENL + [REWRITE_TAC[division_of] THEN ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_ELEMENTARY) THEN + SUBGOAL_THEN `vsum D (\k:real^N->bool. content k % vec 1) = + lift(measure(UNIONS D))` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN + ASM_SIMP_TAC[LIFT_DROP; DROP_VSUM; o_DEF; DROP_CMUL; DROP_VEC] THEN + SIMP_TAC[REAL_MUL_RID; ETA_AX] THEN ASM_MESON_TAC[MEASURE_ELEMENTARY]; + ALL_TAC] THEN + SUBGOAL_THEN + `vsum D (\k. integral k (\x:real^N. if x IN s then vec 1 else vec 0)) = + lift(sum D (\k. measure(k INTER s)))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `measurable(k:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_MEASURE_UNIV; MEASURABLE_INTER] THEN + REWRITE_TAC[MESON[IN_INTER] + `(if x IN k INTER s then a else b) = + (if x IN k then if x IN s then a else b else b)`] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]; + ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `y <= m ==> abs(x - y) <= e ==> x <= m + e`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS D INTER s:real^N->bool)` THEN + CONJ_TAC THENL + [ALL_TAC; + EXPAND_TAC "m" THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC MEASURABLE_INTER THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_INTER]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `l:real^N->bool`] THEN + STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `k INTER l:real^N->bool` THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL + [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ASM_REWRITE_TAC[INFINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool` + (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN + MP_TAC(ISPECL [`s:num->real^N->bool`; `m + e:real`] + HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN + MATCH_MP_TAC(TAUT `a /\ (a /\ b ==> c) ==> (a ==> b) ==> c`) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_IMAGE; IN_UNIV]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL; MEASURABLE_INTER]; + ASM_MESON_TAC[]; + X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (s:num->real^N->bool) (0..n)`) THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; IMAGE_SUBSET; SUBSET_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= e ==> y <= e`) THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE THEN + ASM_MESON_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 LIFT_DROP)] THEN + REWRITE_TAC[drop] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_UBOUND) THEN + EXISTS_TAC + `\n. vsum(from 0 INTER (0..n)) (\n. lift(measure(s n:real^N->bool)))` THEN + ASM_REWRITE_TAC[GSYM sums; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[DIMINDEX_1; ARITH; EVENTUALLY_SEQUENTIALLY] THEN + SIMP_TAC[VSUM_COMPONENT; ARITH; DIMINDEX_1] THEN + ASM_REWRITE_TAC[GSYM drop; LIFT_DROP; FROM_INTER_NUMSEG]);; + +let MEASURABLE_OUTER_CLOSED_INTERVALS = prove + (`!s:real^N->bool e. + measurable s /\ &0 < e + ==> ?d. COUNTABLE d /\ + (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval[a,b])) /\ + (!k l. k IN d /\ l IN d /\ ~(k = l) + ==> interior k INTER interior l = {}) /\ + s SUBSET UNIONS d /\ + measurable (UNIONS d) /\ + measure (UNIONS d) <= measure s + e`, + let lemma = prove + (`UNIONS (UNIONS {d n | n IN (:num)}) = + UNIONS {UNIONS(d n) | n IN (:num)}`, + REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?d. COUNTABLE d /\ + (!k. k IN d ==> ?a b:real^N. k = interval[a,b]) /\ + s SUBSET UNIONS d /\ + measurable (UNIONS d) /\ + measure (UNIONS d) <= measure s + e` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(X_CHOOSE_THEN `d1:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `d1:(real^N->bool)->bool` COUNTABLE_ELEMENTARY_DIVISION) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:(real^N->bool)->bool` THEN + STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[]] THEN + MP_TAC(ISPECL + [`\n. s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`; + `measure(s:real^N->bool)`] HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS) THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN + SUBGOAL_THEN + `!m n. ~(m = n) + ==> (s INTER (ball(vec 0,&m + &1) DIFF ball(vec 0,&m))) INTER + (s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n))) = + ({}:real^N->bool)` + ASSUME_TAC THENL + [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [MESON_TAC[INTER_COMM]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE + `m1 SUBSET n + ==> (s INTER (m1 DIFF m)) INTER (s INTER (n1 DIFF n)) = {}`) THEN + MATCH_MP_TAC SUBSET_BALL THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[NEGLIGIBLE_EMPTY] THEN X_GEN_TAC `n:num` THEN + W(MP_TAC o PART_MATCH (rand o rand) + MEASURE_DISJOINT_UNIONS_IMAGE o lhand o snd) THEN + ASM_SIMP_TAC[FINITE_NUMSEG; DISJOINT] THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN + SIMP_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM; IN_INTER] THEN + ASM_SIMP_TAC[MEASURABLE_UNIONS; FINITE_NUMSEG; FORALL_IN_IMAGE; + FINITE_IMAGE; MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL]; + ALL_TAC] THEN + SUBGOAL_THEN + `UNIONS {s INTER (ball(vec 0,&n + &1) DIFF ball(vec 0,&n)) | n IN (:num)} = + (s:real^N->bool)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?n. (x:real^N) IN ball(vec 0,&n)` MP_TAC THENL + [REWRITE_TAC[IN_BALL_0; REAL_ARCH_LT]; + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[IN_BALL_0; GSYM REAL_NOT_LE; NORM_POS_LE]; + STRIP_TAC THEN EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_DIFF] THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; + ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN + MP_TAC(MATCH_MP MONO_FORALL (GEN `n:num` + (ISPECL + [`s INTER (ball(vec 0:real^N,&n + &1) DIFF ball(vec 0,&n))`; + `--(vec(n + 1)):real^N`; `vec(n + 1):real^N`; + `e / &2 / &2 pow n`] + MEASURABLE_OUTER_INTERVALS_BOUNDED))) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_LT_POW2] THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_BALL] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_INTERVAL; IN_BALL_0; IN_DIFF; REAL_NOT_LT; + REAL_OF_NUM_ADD; VECTOR_NEG_COMPONENT; VEC_COMPONENT; REAL_BOUNDS_LE] THEN + MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; REAL_LT_IMP_LE]; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN + X_GEN_TAC `d:num->(real^N->bool)->bool` THEN STRIP_TAC THEN + EXISTS_TAC `UNIONS {d n | n IN (:num)} :(real^N->bool)->bool` THEN + REWRITE_TAC[lemma] THEN CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_UNIONS THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE] THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IN_UNIONS] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum(0..n) (\k. measure(s INTER (ball(vec 0:real^N,&k + &1) DIFF + ball(vec 0,&k))) + e / &2 / &2 pow k)` THEN + ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNIONS_IMAGE o + lhand o snd) THEN + ASM_SIMP_TAC[DISJOINT; FINITE_NUMSEG; MEASURABLE_DIFF; MEASURABLE_INTER; + MEASURABLE_BALL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_UNIONS; FORALL_IN_IMAGE; FINITE_NUMSEG; + FINITE_IMAGE; MEASURABLE_DIFF; MEASURABLE_INTER; MEASURABLE_BALL] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]; + REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP; LT] THEN + REWRITE_TAC[GSYM real_div] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `e / &2 * (&1 - x) / (&1 / &2) <= e <=> + &0 <= e * x`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; + +let MEASURABLE_OUTER_OPEN_INTERVALS = prove + (`!s:real^N->bool e. + measurable s /\ &0 < e + ==> ?d. COUNTABLE d /\ + (!k. k IN d ==> ~(k = {}) /\ (?a b. k = interval(a,b))) /\ + s SUBSET UNIONS d /\ + measurable (UNIONS d) /\ + measure (UNIONS d) <= measure s + e`, + let lemma = prove + (`!s. UNIONS(s DELETE {}) = UNIONS s`, + REWRITE_TAC[EXTENSION; IN_UNIONS; IN_DELETE] THEN + MESON_TAC[NOT_IN_EMPTY]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] + MEASURABLE_OUTER_CLOSED_INTERVALS) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `dset:(real^N->bool)->bool` THEN + ASM_CASES_TAC `dset:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[UNIONS_0; SUBSET_EMPTY] THEN STRIP_TAC THEN + EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY; MEASURE_EMPTY; SUBSET_REFL] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN + `?f. dset = IMAGE (f:num->(real^N->bool)) (:num) DELETE {} /\ + (!m n. f m = f n ==> m = n \/ f n = {})` + MP_TAC THENL + [ASM_CASES_TAC `FINITE(dset:(real^N->bool)->bool)` THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_HAS_SIZE]) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_INDEX) THEN + ABBREV_TAC `m = CARD(dset:(real^N->bool)->bool)` THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\i. if i < m then (f:num->real^N->bool) i else {}` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_DELETE; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[]; + MP_TAC(ISPEC `dset:(real^N->bool)->bool` + COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[SET_RULE `s = s DELETE a <=> ~(a IN s)`] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:num->real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; FORALL_AND_THM; SKOLEM_THM; + IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DELETE; lemma] THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `(!x. ~(P x) ==> ~(P x) /\ Q x) ==> (!x. P x ==> Q x) ==> !x. Q x`)) THEN + ANTS_TAC THENL [MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN + DISCH_TAC THEN DISCH_TAC THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + GEN_REWRITE_TAC I [IMP_CONJ] THEN + DISCH_THEN(MP_TAC o MATCH_MP(MESON[] + `(!x y. ~(P x) /\ ~(P y) /\ ~(f x = f y) ==> Q x y) + ==> (!x y. P x ==> Q x y) /\ (!x y. P y ==> Q x y) + ==> (!x y. ~(f x = f y) ==> Q x y)`)) THEN + SIMP_TAC[INTERIOR_EMPTY; INTER_EMPTY] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?d. COUNTABLE d /\ + (!k. k IN d ==> ?a b:real^N. k = interval(a,b)) /\ + s SUBSET UNIONS d /\ + measurable (UNIONS d) /\ + measure (UNIONS d) <= measure s + e` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(X_CHOOSE_TAC `d:(real^N->bool)->bool`) THEN + EXISTS_TAC `d DELETE ({}:real^N->bool)` THEN + ASM_SIMP_TAC[lemma; COUNTABLE_DELETE; IN_DELETE]] THEN + MP_TAC(GEN `n:num` (ISPECL [`(a:num->real^N) n`; `(b:num->real^N) n`; + `e / &2 pow (n + 2)`] EXPAND_CLOSED_OPEN_INTERVAL)) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; SKOLEM_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + MAP_EVERY X_GEN_TAC [`A:num->real^N`; `B:num->real^N`] THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (\n. interval(A n:real^N,B n)) (:num)` THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN + ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE; IN_UNIV] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN + REWRITE_TAC[MEASURABLE_INTERVAL] THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum(0..n) (\i. measure(interval[a i:real^N,b i]) + e / &2 pow (i + 2))` THEN + ASM_SIMP_TAC[SUM_LE_NUMSEG] THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; SUM_LMUL; REAL_POW_ADD; SUM_RMUL] THEN + REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH + `s <= m + e / &2 /\ &0 <= e * x + ==> s + e * (&1 - x) / (&1 / &2) * &1 / &4 <= m + e`) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_LT_IMP_LE; + REAL_LE_DIV; REAL_POS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN + W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o + lhand o snd) THEN + REWRITE_TAC[FINITE_NUMSEG; MEASURABLE_INTERVAL] THEN ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `interval[(a:num->real^N) i,b i] = interval[a j,b j]` THENL + [UNDISCH_TAC + `!m n. (d:num->real^N->bool) m = d n ==> m = n \/ d n = {}` THEN + DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE + (BINDER_CONV o BINDER_CONV o RAND_CONV o LAND_CONV) + [GSYM INTERIOR_INTER]) THEN + DISCH_THEN(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM HAS_MEASURE_0; HAS_MEASURE_MEASURABLE_MEASURE] THEN + SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC(MESON[MEASURE_EMPTY] + `measure(interior s) = measure s + ==> interior s = {} ==> measure s = &0`) THEN + MATCH_MP_TAC MEASURE_INTERIOR THEN + SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL; NEGLIGIBLE_CONVEX_FRONTIER; + CONVEX_INTER; CONVEX_INTERVAL]]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL; + FINITE_NUMSEG]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_UNIONS THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]]);; + +let MEASURABLE_OUTER_OPEN = prove + (`!s:real^N->bool e. + measurable s /\ &0 < e + ==> ?t. open t /\ s SUBSET t /\ + measurable t /\ measure t < measure s + e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] + MEASURABLE_OUTER_OPEN_INTERVALS) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:(real^N->bool)->bool` THEN STRIP_TAC THEN + EXISTS_TAC `UNIONS d :real^N->bool` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e /\ m <= s + e / &2 ==> m < s + e`] THEN + MATCH_MP_TAC OPEN_UNIONS THEN ASM_MESON_TAC[OPEN_INTERVAL]);; + +let MEASURABLE_INNER_COMPACT = prove + (`!s:real^N->bool e. + measurable s /\ &0 < e + ==> ?t. compact t /\ t SUBSET s /\ + measurable t /\ measure s < measure t + e`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`interval[a:real^N,b] DIFF s`; `e/ &4`] + MEASURABLE_OUTER_OPEN) THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL; + REAL_ARITH `&0 < e ==> &0 < e / &4`] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `interval[a:real^N,b] DIFF t` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_SIMP_TAC[CLOSED_DIFF; CLOSED_INTERVAL; BOUNDED_DIFF; BOUNDED_INTERVAL]; + ASM SET_TAC[]; + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL]; + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ + measure(s) < measure(interval[a,b] INTER s) + e / &4 /\ + measure(t) < measure(interval[a,b] DIFF s) + e / &4 /\ + measure(interval[a,b] INTER s) + + measure(interval[a,b] DIFF s) = measure(interval[a,b]) /\ + measure(interval[a,b] INTER t) + + measure(interval[a,b] DIFF t) = measure(interval[a,b]) /\ + measure(interval[a,b] INTER t) <= measure t + ==> measure s < measure(interval[a,b] DIFF t) + e`) THEN + ASM_SIMP_TAC[MEASURE_SUBSET; INTER_SUBSET; MEASURABLE_INTER; + MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL + [FIRST_ASSUM(SUBST_ALL_TAC o SYM o MATCH_MP MEASURE_UNIQUE) THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REAL_ARITH_TAC; + CONJ_TAC THEN MATCH_MP_TAC MEASURE_DISJOINT_UNION_EQ THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN + SET_TAC[]]]);; + +let OPEN_MEASURABLE_INNER_DIVISION = prove + (`!s:real^N->bool e. + open s /\ measurable s /\ &0 < e + ==> ?D. D division_of UNIONS D /\ + UNIONS D SUBSET s /\ + measure s < measure(UNIONS D) + e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + ASM_REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPEC `s INTER interval(a - vec 1:real^N,b + vec 1)` + OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_INTERVAL; SUBSET_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`D:(real^N->bool)->bool`; `measure(s:real^N->bool)`; + `e / &2`] MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS D :real^N->bool)` THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL]; + ASM_SIMP_TAC[SUBSET_UNIONS]]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET]]; + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `d:(real^N->bool)->bool` ELEMENTARY_UNIONS_INTERVALS) THEN + ANTS_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:(real^N->bool)->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN `UNIONS p :real^N->bool = UNIONS d` SUBST1_TAC THENL + [ASM_MESON_TAC[division_of]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `UNIONS D :real^N->bool` THEN + ASM_SIMP_TAC[SUBSET_UNIONS; INTER_SUBSET]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `ms' - e / &2 < mud ==> ms < ms' + e / &2 ==> ms < mud + e`)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(sc - s) < e / &2 + ==> sc <= so /\ sc <= s ==> s < so + e / &2`)) THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL; INTER_SUBSET] THEN + MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN + REWRITE_TAC[SUBSET_INTERVAL; VECTOR_SUB_COMPONENT; VEC_COMPONENT; + VECTOR_ADD_COMPONENT] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence for linear transformation, suffices to check compact intervals. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_LINEAR_IMAGE_INTERVAL = prove + (`!f a b. linear f ==> measurable(IMAGE f (interval[a,b]))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN + ASM_MESON_TAC[CONVEX_INTERVAL]; + MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN + ASM_MESON_TAC[BOUNDED_INTERVAL]]);; + +let HAS_MEASURE_LINEAR_SUFFICIENT = prove + (`!f:real^N->real^N m. + linear f /\ + (!a b. IMAGE f (interval[a,b]) has_measure + (m * measure(interval[a,b]))) + ==> !s. measurable s ==> (IMAGE f s) has_measure (m * measure s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `m < &0 \/ &0 <= m`) THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_POS_LE) THEN + MATCH_MP_TAC(TAUT `~a ==> a ==> b`) THEN + MATCH_MP_TAC(REAL_ARITH `&0 < --m * x ==> ~(&0 <= m * x)`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_NEG_GT0] THEN + REWRITE_TAC[MEASURE_INTERVAL] THEN MATCH_MP_TAC CONTENT_POS_LT THEN + SIMP_TAC[VEC_COMPONENT; REAL_LT_01]; + ALL_TAC] THEN + ASM_CASES_TAC `!x y. (f:real^N->real^N) x = f y ==> x = y` THENL + [ALL_TAC; + SUBGOAL_THEN `!s. negligible(IMAGE (f:real^N->real^N) s)` ASSUME_TAC THENL + [ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; ALL_TAC] THEN + SUBGOAL_THEN `m * measure(interval[vec 0:real^N,vec 1]) = &0` MP_TAC THENL + [MATCH_MP_TAC(ISPEC `IMAGE (f:real^N->real^N) (interval[vec 0,vec 1])` + HAS_MEASURE_UNIQUE) THEN + ASM_REWRITE_TAC[HAS_MEASURE_0]; + REWRITE_TAC[REAL_ENTIRE; MEASURE_INTERVAL] THEN + MATCH_MP_TAC(TAUT `~b /\ (a ==> c) ==> a \/ b ==> c`) THEN CONJ_TAC THENL + [SIMP_TAC[CONTENT_EQ_0_INTERIOR; INTERIOR_CLOSED_INTERVAL; + INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01]; + ASM_SIMP_TAC[REAL_MUL_LZERO; HAS_MEASURE_0]]]] THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_ISOMORPHISM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN + UNDISCH_THEN `!x y. (f:real^N->real^N) x = f y ==> x = y` (K ALL_TAC) THEN + SUBGOAL_THEN + `!s. bounded s /\ measurable s + ==> (IMAGE (f:real^N->real^N) s) has_measure (m * measure s)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!d. COUNTABLE d /\ + (!k. k IN d ==> k SUBSET interval[a,b] /\ ~(k = {}) /\ + (?c d. k = interval[c,d])) /\ + (!k1 k2. k1 IN d /\ k2 IN d /\ ~(k1 = k2) + ==> interior k1 INTER interior k2 = {}) + ==> IMAGE (f:real^N->real^N) (UNIONS d) has_measure + (m * measure(UNIONS d))` + ASSUME_TAC THENL + [REWRITE_TAC[IMAGE_UNIONS] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!g:real^N->real^N. + linear g + ==> !k l. k IN d /\ l IN d /\ ~(k = l) + ==> negligible((IMAGE g k) INTER (IMAGE g l))` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + ASM_CASES_TAC `!x y. (g:real^N->real^N) x = g y ==> x = y` THENL + [ALL_TAC; + ASM_MESON_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE; + NEGLIGIBLE_INTER]] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `frontier(IMAGE (g:real^N->real^N) k INTER IMAGE g l) UNION + interior(IMAGE g k INTER IMAGE g l)` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `s SUBSET t ==> s SUBSET (t DIFF u) UNION u`) THEN + REWRITE_TAC[CLOSURE_SUBSET]] THEN + MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_CONVEX_FRONTIER THEN + MATCH_MP_TAC CONVEX_INTER THEN CONJ_TAC THEN + MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_MESON_TAC[CONVEX_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[INTERIOR_INTER] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `IMAGE (g:real^N->real^N) (interior k) INTER + IMAGE g (interior l)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC + `IMAGE (g:real^N->real^N) (interior k INTER interior l)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]; ASM SET_TAC[]]; + MATCH_MP_TAC(SET_RULE + `s SUBSET u /\ t SUBSET v ==> (s INTER t) SUBSET (u INTER v)`) THEN + CONJ_TAC THEN MATCH_MP_TAC INTERIOR_IMAGE_SUBSET THEN + ASM_MESON_TAC[LINEAR_CONTINUOUS_AT]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `f:real^N->real^N` th) THEN + MP_TAC(SPEC `\x:real^N. x` th)) THEN + ASM_REWRITE_TAC[LINEAR_ID; SET_RULE `IMAGE (\x. x) s = s`] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL + [MP_TAC(ISPECL [`IMAGE (f:real^N->real^N)`; `d:(real^N->bool)->bool`] + HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum d (\k:real^N->bool. m * measure k)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS THEN + ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN + ASM_MESON_TAC[MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ASM_REWRITE_TAC[INFINITE] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->real^N->bool` + (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN + MP_TAC(ISPEC `s:num->real^N->bool` + HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN + MP_TAC(ISPEC `\n:num. IMAGE (f:real^N->real^N) (s n)` + HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_IMAGE; IN_UNIV]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM]) THEN + ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_INTERVAL]; + ASM_MESON_TAC[]; + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[GSYM IMAGE_UNIONS; IMAGE_o] THEN + MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN + EXISTS_TAC `interval[a:real^N,b]` THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + STRIP_TAC THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL]; + ASM_MESON_TAC[]; + MATCH_MP_TAC BOUNDED_SUBSET THEN REWRITE_TAC[UNIONS_SUBSET] THEN + EXISTS_TAC `interval[a:real^N,b]` THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + SUBGOAL_THEN `m * measure (UNIONS (IMAGE s (:num)):real^N->bool) = + measure(UNIONS (IMAGE (\x. IMAGE f (s x)) (:num)):real^N->bool)` + (fun th -> ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE; th]) THEN + ONCE_REWRITE_TAC[GSYM LIFT_EQ] THEN + MATCH_MP_TAC SERIES_UNIQUE THEN + EXISTS_TAC `\n:num. lift(measure(IMAGE (f:real^N->real^N) (s n)))` THEN + EXISTS_TAC `from 0` THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\n:num. m % lift(measure(s n:real^N->bool))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM LIFT_CMUL; LIFT_EQ] THEN + ASM_MESON_TAC[MEASURE_UNIQUE]; + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC SERIES_CMUL THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[HAS_MEASURE_INNER_OUTER_LE] THEN CONJ_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THENL + [MP_TAC(ISPECL [`interval[a,b] DIFF s:real^N->bool`; `a:real^N`; + `b:real^N`; `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < &1 + abs x`; REAL_LT_DIV] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE f (interval[a,b]) DIFF + IMAGE (f:real^N->real^N) (UNIONS d)` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_DIFF; measurable]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(IMAGE f (interval[a,b])) - + measure(IMAGE (f:real^N->real^N) (UNIONS d))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC]) THEN + MATCH_MP_TAC IMAGE_SUBSET THEN ASM_SIMP_TAC[UNIONS_SUBSET]] THEN + UNDISCH_TAC `!a b. IMAGE (f:real^N->real^N) (interval [a,b]) + has_measure m * measure (interval [a,b])` THEN + DISCH_THEN(ASSUME_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MEASURE_UNIQUE)) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `m * measure(s:real^N->bool) - m * e / (&1 + abs m)` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `d <= a + e ==> a = i - s ==> s - e <= i - d`)) THEN + MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN + ASM_REWRITE_TAC[MEASURABLE_INTERVAL]; + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`; + `e / (&1 + abs m)`] MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (f:real^N->real^N) (UNIONS d)` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:(real^N->bool)->bool`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN + SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `m * measure(s:real^N->bool) + m * e / (&1 + abs m)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN ASM_SIMP_TAC[REAL_LE_LMUL]; + REWRITE_TAC[REAL_LE_LADD] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HAS_MEASURE_LIMIT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HAS_MEASURE_MEASURE]) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_LIMIT] THEN + DISCH_THEN(MP_TAC o SPEC `e / (&1 + abs m)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &1 + abs x`] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN + MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN + REMOVE_THEN "*" MP_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `d:real^N` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`interval[c:real^N,d]`; `vec 0:real^N`] + BOUNDED_SUBSET_BALL) THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_BOUNDED_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + + EXISTS_TAC `D * C:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `s INTER (IMAGE (h:real^N->real^N) (interval[a,b]))`) THEN + SUBGOAL_THEN + `IMAGE (f:real^N->real^N) (s INTER IMAGE h (interval [a,b])) = + (IMAGE f s) INTER interval[a,b]` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[BOUNDED_INTER; BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL]; + ALL_TAC] THEN + DISCH_TAC THEN EXISTS_TAC + `m * measure(s INTER (IMAGE (h:real^N->real^N) (interval[a,b])))` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `m * e / (&1 + abs m)` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN REAL_ARITH_TAC] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [real_abs] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(z - m) < e ==> z <= w /\ w <= m ==> abs(w - m) <= e`)) THEN + SUBST1_TAC(SYM(MATCH_MP MEASURE_UNIQUE + (ASSUME `s INTER interval [c:real^N,d] has_measure z`))) THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_LINEAR_IMAGE_INTERVAL; + MEASURABLE_INTERVAL; INTER_SUBSET] THEN + MATCH_MP_TAC(SET_RULE + `!v. t SUBSET v /\ v SUBSET u ==> s INTER t SUBSET s INTER u`) THEN + EXISTS_TAC `ball(vec 0:real^N,D)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `!f. (!x. h(f x) = x) /\ IMAGE f s SUBSET t ==> s SUBSET IMAGE h t`) THEN + EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `ball(vec 0:real^N,D * C)` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `C * norm(x:real^N)` THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Some inductions by expressing mapping in terms of elementary matrices. *) +(* ------------------------------------------------------------------------- *) + +let INDUCT_MATRIX_ROW_OPERATIONS = prove + (`!P:real^N^N->bool. + (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\ + (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> A$i$j = &0) ==> P A) /\ + (!A m n. P A /\ 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(lambda i j. A$i$(swap(m,n) j))) /\ + (!A m n c. P A /\ 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(lambda i. if i = m then row m A + c % row n A + else row i A)) + ==> !A. P A`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "zero_row") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "diagonal") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "swap_cols") (LABEL_TAC "row_op")) THEN + SUBGOAL_THEN + `!k A:real^N^N. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + k <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> A$i$j = &0) + ==> P A` + (fun th -> GEN_TAC THEN MATCH_MP_TAC th THEN + EXISTS_TAC `dimindex(:N) + 1` THEN ARITH_TAC) THEN + MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN USE_THEN "diagonal" MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[LE_0]; + ALL_TAC] THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "ind_hyp") THEN + DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC (ARITH_RULE `k = 0 \/ 1 <= k`) THEN + ASM_REWRITE_TAC[ARITH] THEN + ASM_CASES_TAC `k <= dimindex(:N)` THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN + ASM_ARITH_TAC] THEN + SUBGOAL_THEN + `!A:real^N^N. + ~(A$k$k = &0) /\ + (!i j. 1 <= i /\ i <= dimindex (:N) /\ + SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j) + ==> A$i$j = &0) + ==> P A` + (LABEL_TAC "nonzero_hyp") THENL + [ALL_TAC; + X_GEN_TAC `A:real^N^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `row k (A:real^N^N) = vec 0` THENL + [REMOVE_THEN "zero_row" MATCH_MP_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + SIMP_TAC[VEC_COMPONENT; row; LAMBDA_BETA] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `l:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `l:num = k` THENL + [REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REMOVE_THEN "swap_cols" (MP_TAC o SPECL + [`(lambda i j. (A:real^N^N)$i$swap(k,l) j):real^N^N`; + `k:num`; `l:num`]) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA])] THEN + REMOVE_THEN "nonzero_hyp" MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= i <=> 1 <= i /\ SUC k <= i`] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + ASM_REWRITE_TAC[swap] THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + STRIP_TAC THEN SUBGOAL_THEN `l:num <= k` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC] THEN + SUBGOAL_THEN + `!l A:real^N^N. + ~(A$k$k = &0) /\ + (!i j. 1 <= i /\ i <= dimindex (:N) /\ + SUC k <= j /\ j <= dimindex (:N) /\ ~(i = j) + ==> A$i$j = &0) /\ + (!i. l <= i /\ i <= dimindex(:N) /\ ~(i = k) ==> A$i$k = &0) + ==> P A` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN + REWRITE_TAC[CONJ_ASSOC; ARITH_RULE `~(n + 1 <= i /\ i <= n)`]] THEN + MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN + USE_THEN "ind_hyp" MATCH_MP_TAC THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `j:num = k` THENL + [ASM_REWRITE_TAC[] THEN USE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC; + REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + X_GEN_TAC `l:num` THEN DISCH_THEN(LABEL_TAC "inner_hyp") THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "main") (LABEL_TAC "aux")) THEN + ASM_CASES_TAC `l:num = k` THENL + [REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + DISJ_CASES_TAC(ARITH_RULE `l = 0 \/ 1 <= l`) THENL + [REMOVE_THEN "ind_hyp" MATCH_MP_TAC THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `j:num = k` THENL + [ASM_REWRITE_TAC[] THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC; + REMOVE_THEN "main" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_CASES_TAC `l <= dimindex(:N)` THENL + [ALL_TAC; + REMOVE_THEN "inner_hyp" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC] THEN + REMOVE_THEN "inner_hyp" (MP_TAC o SPECL + [`(lambda i. if i = l then row l (A:real^N^N) + --(A$l$k/A$k$k) % row k A + else row i A):real^N^N`]) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `!i. l <= i ==> 1 <= i` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[ARITH_RULE `SUC k <= j <=> 1 <= j /\ SUC k <= j`] THEN + ASM_SIMP_TAC[LAMBDA_BETA; row; COND_COMPONENT; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> x + --(x / y) * y = &0`] THEN + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `i:num = l` THEN ASM_REWRITE_TAC[] THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_RING `x = &0 /\ y = &0 ==> x + z * y = &0`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + REPEAT STRIP_TAC THEN REMOVE_THEN "aux" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN REMOVE_THEN "row_op" (MP_TAC o SPECL + [`(lambda i. if i = l then row l A + --(A$l$k / A$k$k) % row k A + else row i (A:real^N^N)):real^N^N`; + `l:num`; `k:num`; `(A:real^N^N)$l$k / A$k$k`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; row; COND_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let INDUCT_MATRIX_ELEMENTARY = prove + (`!P:real^N^N->bool. + (!A B. P A /\ P B ==> P(A ** B)) /\ + (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\ + (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> A$i$j = &0) ==> P A) /\ + (!m n. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\ + (!m n c. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(lambda i j. if i = m /\ j = n then c + else if i = j then &1 else &0)) + ==> !A. P A`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> + MATCH_MP_TAC INDUCT_MATRIX_ROW_OPERATIONS THEN MP_TAC th) THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN + DISCH_THEN(fun th -> X_GEN_TAC `A:real^N^N` THEN MP_TAC th) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(P:real^N^N->bool) A` THENL + [REWRITE_TAC[GSYM IMP_CONJ]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul; row] THENL + [ASM_SIMP_TAC[mat; IN_DIMINDEX_SWAP; LAMBDA_BETA] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; REAL_MUL_RID] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[swap; IN_NUMSEG]) THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[SUM_DELTA; LAMBDA_BETA; IN_NUMSEG; REAL_MUL_LID]] THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; LAMBDA_BETA] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `sum {m,n} (\k. (if k = n then c else if m = k then &1 else &0) * + (A:real^N^N)$k$j)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUPERSET THEN + ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; + IN_NUMSEG; REAL_MUL_LZERO] THEN + ASM_ARITH_TAC; + ASM_SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC]);; + +let INDUCT_MATRIX_ELEMENTARY_ALT = prove + (`!P:real^N^N->bool. + (!A B. P A /\ P B ==> P(A ** B)) /\ + (!A i. 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 ==> P A) /\ + (!A. (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ ~(i = j) + ==> A$i$j = &0) ==> P A) /\ + (!m n. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(lambda i j. (mat 1:real^N^N)$i$(swap(m,n) j))) /\ + (!m n. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(lambda i j. if i = m /\ j = n \/ i = j then &1 else &0)) + ==> !A. P A`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC INDUCT_MATRIX_ELEMENTARY THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `c = &0` THENL + [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN + ASM_SIMP_TAC[LAMBDA_BETA; COND_ID]; + ALL_TAC] THEN + SUBGOAL_THEN + `(lambda i j. if i = m /\ j = n then c else if i = j then &1 else &0) = + ((lambda i j. if i = j then if j = n then inv c else &1 else &0):real^N^N) ** + ((lambda i j. if i = m /\ j = n \/ i = j then &1 else &0):real^N^N) ** + ((lambda i j. if i = j then if j = n then c else &1 else &0):real^N^N)` + SUBST1_TAC THENL + [ALL_TAC; + REPEAT(MATCH_MP_TAC(ASSUME `!A B:real^N^N. P A /\ P B ==> P(A ** B)`) THEN + CONJ_TAC) THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]) THEN + ASM_SIMP_TAC[LAMBDA_BETA]] THEN + SIMP_TAC[CART_EQ; matrix_mul; LAMBDA_BETA] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_ARITH + `(if p then &1 else &0) * (if q then c else &0) = + if q then if p then c else &0 else &0`] THEN + REWRITE_TAC[REAL_ARITH + `(if p then x else &0) * y = (if p then x * y else &0)`] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG] THEN + ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `j:num = n` THEN ASM_REWRITE_TAC[REAL_MUL_LID; EQ_SYM_EQ] THEN + ASM_CASES_TAC `i:num = n` THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID; REAL_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* The same thing in mapping form (might have been easier all along). *) +(* ------------------------------------------------------------------------- *) + +let INDUCT_LINEAR_ELEMENTARY = prove + (`!P. (!f g. linear f /\ linear g /\ P f /\ P g ==> P(f o g)) /\ + (!f i. linear f /\ 1 <= i /\ i <= dimindex(:N) /\ (!x. (f x)$i = &0) + ==> P f) /\ + (!c. P(\x. lambda i. c i * x$i)) /\ + (!m n. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(\x. lambda i. x$swap(m,n) i)) /\ + (!m n. 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ ~(m = n) + ==> P(\x. lambda i. if i = m then x$m + x$n else x$i)) + ==> !f:real^N->real^N. linear f ==> P f`, + GEN_TAC THEN + MP_TAC(ISPEC `\A:real^N^N. P(\x:real^N. A ** x):bool` + INDUCT_MATRIX_ELEMENTARY_ALT) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL + [ALL_TAC; + DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `matrix(f:real^N->real^N)`) THEN + ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX]] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `B:real^N^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`\x:real^N. (A:real^N^N) ** x`; `\x:real^N. (B:real^N^N) ** x`]) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; o_DEF] THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`A:real^N^N`; `m:num`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`\x:real^N. (A:real^N^N) ** x`; `m:num`]) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `row m (A:real^N^N) = vec 0` THEN + ASM_SIMP_TAC[CART_EQ; row; LAMBDA_BETA; VEC_COMPONENT; matrix_vector_mul; + REAL_MUL_LZERO; SUM_0]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `A:real^N^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\i. (A:real^N^N)$i$i`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum(1..dimindex(:N)) (\j. if j = i then (A:real^N^N)$i$j * (x:real^N)$j + else &0)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]; ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_LZERO]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `m:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; matrix_vector_mul; FUN_EQ_THM; LAMBDA_BETA; + mat; IN_DIMINDEX_SWAP] + THENL + [ONCE_REWRITE_TAC[SWAP_GALOIS] THEN ONCE_REWRITE_TAC[COND_RAND] THEN + ONCE_REWRITE_TAC[COND_RATOR] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_LID; REAL_MUL_LZERO; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[swap] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; REAL_MUL_LID; IN_NUMSEG] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {m,n} (\j. if n = j \/ j = m then (x:real^N)$j else &0)` THEN + CONJ_TAC THENL + [SIMP_TAC[SUM_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[REAL_ADD_RID]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + ASM_SIMP_TAC[SUBSET; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; + IN_NUMSEG; REAL_MUL_LZERO] THEN + ASM_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the effect of an arbitrary linear map on a measurable set. *) +(* ------------------------------------------------------------------------- *) + +let LAMBDA_SWAP_GALOIS = prove + (`!x:real^N y:real^N. + 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) + ==> (x = (lambda i. y$swap(m,n) i) <=> + (lambda i. x$swap(m,n) i) = y)`, + SIMP_TAC[CART_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN + ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN + ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]);; + +let LAMBDA_ADD_GALOIS = prove + (`!x:real^N y:real^N. + 1 <= m /\ m <= dimindex(:N) /\ 1 <= n /\ n <= dimindex(:N) /\ + ~(m = n) + ==> (x = (lambda i. if i = m then y$m + y$n else y$i) <=> + (lambda i. if i = m then x$m - x$n else x$i) = y)`, + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let HAS_MEASURE_SHEAR_INTERVAL = prove + (`!a b:real^N m n. + 1 <= m /\ m <= dimindex(:N) /\ + 1 <= n /\ n <= dimindex(:N) /\ + ~(m = n) /\ ~(interval[a,b] = {}) /\ + &0 <= a$n + ==> (IMAGE (\x. (lambda i. if i = m then x$m + x$n else x$i)) + (interval[a,b]):real^N->bool) + has_measure measure (interval [a,b])`, + let lemma = prove + (`!s t u v:real^N->bool. + measurable s /\ measurable t /\ measurable u /\ + negligible(s INTER t) /\ negligible(s INTER u) /\ + negligible(t INTER u) /\ + s UNION t UNION u = v + ==> v has_measure (measure s) + (measure t) + (measure u)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_UNION] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_UNION] THEN + ASM_SIMP_TAC[MEASURE_EQ_0; UNION_OVER_INTER; MEASURE_UNION; + MEASURABLE_UNION; NEGLIGIBLE_INTER; MEASURABLE_INTER] THEN + REAL_ARITH_TAC) + and lemma' = prove + (`!s t u a:real^N. + measurable s /\ measurable t /\ + s UNION (IMAGE (\x. a + x) t) = u /\ + negligible(s INTER (IMAGE (\x. a + x) t)) + ==> measure s + measure t = measure u`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_SIMP_TAC[MEASURE_NEGLIGIBLE_UNION; MEASURABLE_TRANSLATION_EQ; + MEASURE_TRANSLATION]) in + REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `linear((\x. lambda i. if i = m then x$m + x$n else x$i):real^N->real^N)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i) + (interval[a:real^N,b]):real^N->bool`; + `interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER + {x:real^N | (basis m - basis n) dot x <= a$m}`; + `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER + {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`; + `interval[a:real^N, + (lambda i. if i = m then (b:real^N)$m + b$n else b$i)]`] + lemma) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL; + CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE; + CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER; + BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN + REWRITE_TAC[INTER] THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN + ASM_SIMP_TAC[LAMBDA_ADD_GALOIS; UNWIND_THM1] THEN + ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA; + DOT_BASIS; DOT_LSUB] THEN + ONCE_REWRITE_TAC[MESON[] + `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN + ASM_SIMP_TAC[] THEN + REWRITE_TAC[TAUT `(p /\ x) /\ (q /\ x) /\ r <=> x /\ p /\ q /\ r`; + TAUT `(p /\ x) /\ q /\ (r /\ x) <=> x /\ p /\ q /\ r`; + TAUT `((p /\ x) /\ q) /\ (r /\ x) /\ s <=> + x /\ p /\ q /\ r /\ s`; + TAUT `(a /\ x \/ (b /\ x) /\ c \/ (d /\ x) /\ e <=> f /\ x) <=> + x ==> (a \/ b /\ c \/ d /\ e <=> f)`] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THENL + [EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}`; + EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`; + EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (b:real^N)$m}`] + THEN (CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[BASIS_INJ]; + ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM; + NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]); + ALL_TAC] THEN + ASM_SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE; + MEASURABLE_LINEAR_IMAGE_INTERVAL; + MEASURABLE_INTERVAL] THEN + MP_TAC(ISPECL + [`interval[a,(lambda i. if i = m then (b:real^N)$m + b$n else b$i)] INTER + {x:real^N | (basis m - basis n) dot x <= a$m}`; + `interval[a,(lambda i. if i = m then b$m + b$n else b$i)] INTER + {x:real^N | (basis m - basis n) dot x >= (b:real^N)$m}`; + `interval[a:real^N, + (lambda i. if i = m then (a:real^N)$m + b$n + else (b:real^N)$i)]`; + `(lambda i. if i = m then (a:real^N)$m - (b:real^N)$m + else &0):real^N`] + lemma') THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; CONVEX_INTERVAL; + CONVEX_HALFSPACE_LE; CONVEX_HALFSPACE_GE; + CONVEX_INTER; MEASURABLE_CONVEX; BOUNDED_INTER; + BOUNDED_LINEAR_IMAGE; BOUNDED_INTERVAL] THEN + REWRITE_TAC[INTER] THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = (lambda i. p i) + y <=> + x - (lambda i. p i) = y`] THEN + ASM_SIMP_TAC[IN_INTERVAL; IN_ELIM_THM; LAMBDA_BETA; + DOT_BASIS; DOT_LSUB; UNWIND_THM1; + VECTOR_SUB_COMPONENT] THEN + ONCE_REWRITE_TAC[MESON[] + `(!i:num. P i) <=> P m /\ (!i. ~(i = m) ==> P i)`] THEN + ASM_SIMP_TAC[REAL_SUB_RZERO] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC + `!i. ~(i = m) + ==> 1 <= i /\ i <= dimindex (:N) + ==> (a:real^N)$i <= (x:real^N)$i /\ + x$i <= (b:real^N)$i` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ONCE_REWRITE_TAC[TAUT `((a /\ b) /\ c) /\ (d /\ e) /\ f <=> + (b /\ e) /\ a /\ c /\ d /\ f`] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | (basis m - basis n) dot x = (a:real^N)$m}` + THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[BASIS_INJ]; + ASM_SIMP_TAC[DOT_LSUB; DOT_BASIS; SUBSET; IN_ELIM_THM; + NOT_IN_EMPTY] THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(REAL_ARITH + `a:real = b + c ==> a = x + b ==> x = c`) THEN + ASM_SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES; + LAMBDA_BETA] THEN + REPEAT(COND_CASES_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) THEN + SUBGOAL_THEN `1..dimindex(:N) = m INSERT ((1..dimindex(:N)) DELETE m)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_DELETE; IN_NUMSEG] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_DELETE; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[IN_DELETE] THEN + MATCH_MP_TAC(REAL_RING + `s1:real = s3 /\ s2 = s3 + ==> ((bm + bn) - am) * s1 = + ((am + bn) - am) * s2 + (bm - am) * s3`) THEN + CONJ_TAC THEN MATCH_MP_TAC PRODUCT_EQ THEN + SIMP_TAC[IN_DELETE] THEN REAL_ARITH_TAC);; + +let HAS_MEASURE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ measurable s + ==> (IMAGE f s) has_measure (abs(det(matrix f)) * measure s)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC INDUCT_LINEAR_ELEMENTARY THEN REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `IMAGE (g:real^N->real^N) s`) + (MP_TAC o SPEC `s:real^N->bool`)) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [HAS_MEASURE_MEASURABLE_MEASURE] THEN + STRIP_TAC THEN ASM_SIMP_TAC[MATRIX_COMPOSE; DET_MUL; REAL_ABS_MUL] THEN + REWRITE_TAC[IMAGE_o; GSYM REAL_MUL_ASSOC]; + + MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `m:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(!x y. (f:real^N->real^N) x = f y ==> x = y)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN + EXISTS_TAC `basis m:real^N` THEN + ASM_SIMP_TAC[BASIS_NONZERO; DOT_BASIS]; + ALL_TAC] THEN + MP_TAC(ISPEC `matrix f:real^N^N` INVERTIBLE_DET_NZ) THEN + ASM_SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE_INJECTIVE; + MATRIX_WORKS; REAL_ABS_NUM; REAL_MUL_LZERO] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[HAS_MEASURE_0] THEN + ASM_SIMP_TAC[NEGLIGIBLE_LINEAR_SINGULAR_IMAGE]; + + MAP_EVERY X_GEN_TAC [`c:num->real`; `s:real^N->bool`] THEN + DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[HAS_MEASURE_MEASURE]) THEN + FIRST_ASSUM(MP_TAC o SPEC `c:num->real` o + MATCH_MP HAS_MEASURE_STRETCH) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[matrix; LAMBDA_BETA] THEN + W(MP_TAC o PART_MATCH (lhs o rand) DET_DIAGONAL o rand o snd) THEN + SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; REAL_MUL_RZERO] THEN + DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + REWRITE_TAC[REAL_MUL_RID]; + + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN + ASM_SIMP_TAC[linear; LAMBDA_BETA; IN_DIMINDEX_SWAP; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; CART_EQ] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + SUBGOAL_THEN `matrix (\x:real^N. lambda i. x$swap (m,n) i):real^N^N = + transp(lambda i j. (mat 1:real^N^N)$i$swap (m,n) j)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[MATRIX_EQ; LAMBDA_BETA; IN_DIMINDEX_SWAP; + matrix_vector_mul; CART_EQ; matrix; mat; basis; + COND_COMPONENT; transp] THEN + REWRITE_TAC[EQ_SYM_EQ]; + ALL_TAC] THEN + REWRITE_TAC[DET_TRANSP] THEN + W(MP_TAC o PART_MATCH (lhs o rand) DET_PERMUTE_COLUMNS o + rand o lhand o rand o snd) THEN + ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG; ETA_AX] THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[DET_I; REAL_ABS_SIGN; REAL_MUL_RID; REAL_MUL_LID] THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(IMAGE (\x:real^N. lambda i. x$swap (m,n) i) + (interval[a,b]):real^N->bool = {})` + MP_TAC THENL [ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x:real^N. lambda i. x$swap (m,n) i) + (interval[a,b]):real^N->bool = + interval[(lambda i. a$swap (m,n) i), + (lambda i. b$swap (m,n) i)]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_IMAGE] THEN + ASM_SIMP_TAC[LAMBDA_SWAP_GALOIS; UNWIND_THM1] THEN + SIMP_TAC[LAMBDA_BETA] THEN GEN_TAC THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `swap(m,n) (i:num)`) THEN + ASM_SIMP_TAC[IN_DIMINDEX_SWAP] THEN + ASM_MESON_TAC[REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM] SWAP_IDEMPOTENT]; + ALL_TAC] THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[MEASURE_INTERVAL] THEN + ASM_SIMP_TAC[CONTENT_CLOSED_INTERVAL; GSYM INTERVAL_NE_EMPTY] THEN + DISCH_THEN(K ALL_TAC) THEN SIMP_TAC[LAMBDA_BETA] THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; IN_DIMINDEX_SWAP] THEN + MP_TAC(ISPECL [`\i. (b - a:real^N)$i`; `swap(m:num,n)`; `1..dimindex(:N)`] + (GSYM PRODUCT_PERMUTE)) THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[PERMUTES_SWAP; IN_NUMSEG]; + + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_MEASURE_LINEAR_SUFFICIENT THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[linear; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; CART_EQ] THEN REAL_ARITH_TAC; + DISCH_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + SUBGOAL_THEN + `det(matrix(\x. lambda i. if i = m then (x:real^N)$m + x$n + else x$i):real^N^N) = &1` + SUBST1_TAC THENL + [ASM_SIMP_TAC[matrix; basis; COND_COMPONENT; LAMBDA_BETA] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(m:num = n) ==> m < n \/ n < m`)) + THENL + [W(MP_TAC o PART_MATCH (lhs o rand) DET_UPPERTRIANGULAR o lhs o snd); + W(MP_TAC o PART_MATCH (lhs o rand) DET_LOWERTRIANGULAR o lhs o snd)] + THEN ASM_SIMP_TAC[LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT; + matrix; REAL_ADD_RID; COND_ID; + PRODUCT_CONST_NUMSEG; REAL_POW_ONE] THEN + DISCH_THEN MATCH_MP_TAC THEN + REPEAT GEN_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LID] THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM_SIMP_TAC[IMAGE_CLAUSES; HAS_MEASURE_EMPTY; MEASURE_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x. lambda i. if i = m then x$m + x$n else x$i) (interval [a,b]) = + IMAGE (\x:real^N. (lambda i. if i = m \/ i = n then a$n else &0) + + x) + (IMAGE (\x:real^N. lambda i. if i = m then x$m + x$n else x$i) + (IMAGE (\x. (lambda i. if i = n then --(a$n) else &0) + x) + (interval[a,b])))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[FUN_EQ_THM; o_THM; VECTOR_ADD_COMPONENT; LAMBDA_BETA; + CART_EQ] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN + STRIP_TAC THEN ASM_CASES_TAC `i:num = m` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i:num = n` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC HAS_MEASURE_TRANSLATION THEN + SUBGOAL_THEN + `measure(interval[a,b]) = + measure(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x) + (interval[a,b]):real^N->bool)` + SUBST1_TAC THENL [REWRITE_TAC[MEASURE_TRANSLATION]; ALL_TAC] THEN + SUBGOAL_THEN + `~(IMAGE (\x:real^N. (lambda i. if i = n then --(a$n) else &0) + x) + (interval[a,b]):real^N->bool = {})` + MP_TAC THENL [ASM_SIMP_TAC[IMAGE_EQ_EMPTY]; ALL_TAC] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `c + x:real^N = &1 % x + c`] THEN + ASM_REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; REAL_POS] THEN + DISCH_TAC THEN MATCH_MP_TAC HAS_MEASURE_SHEAR_INTERVAL THEN + ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC]);; + +let MEASURABLE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ measurable s ==> measurable(IMAGE f s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN + SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);; + +let MEASURE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ measurable s + ==> measure(IMAGE f s) = abs(det(matrix f)) * measure s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE) THEN + SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);; + +let HAS_MEASURE_LINEAR_IMAGE_ALT = prove + (`!f:real^N->real^N s m. + linear f /\ s has_measure m + ==> (IMAGE f s) has_measure (abs(det(matrix f)) * m)`, + MESON_TAC[MEASURE_UNIQUE; measurable; HAS_MEASURE_LINEAR_IMAGE]);; + +let HAS_MEASURE_LINEAR_IMAGE_SAME = prove + (`!f s. linear f /\ measurable s /\ abs(det(matrix f)) = &1 + ==> (IMAGE f s) has_measure (measure s)`, + MESON_TAC[HAS_MEASURE_LINEAR_IMAGE; REAL_MUL_LID]);; + +let MEASURE_LINEAR_IMAGE_SAME = prove + (`!f:real^N->real^N s. + linear f /\ measurable s /\ abs(det(matrix f)) = &1 + ==> measure(IMAGE f s) = measure s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_SAME) THEN + SIMP_TAC[HAS_MEASURE_MEASURABLE_MEASURE]);; + +let MEASURABLE_LINEAR_IMAGE_EQ = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (measurable (IMAGE f s) <=> measurable s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE MEASURABLE_LINEAR_IMAGE));; + +add_linear_invariants [MEASURABLE_LINEAR_IMAGE_EQ];; + +let NEGLIGIBLE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. linear f /\ negligible s ==> negligible(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM HAS_MEASURE_0] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN + REWRITE_TAC[REAL_MUL_RZERO]);; + +let NEGLIGIBLE_LINEAR_IMAGE_EQ = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (negligible (IMAGE f s) <=> negligible s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE NEGLIGIBLE_LINEAR_IMAGE));; + +add_linear_invariants [NEGLIGIBLE_LINEAR_IMAGE_EQ];; + +let HAS_MEASURE_ORTHOGONAL_IMAGE = prove + (`!f:real^N->real^N s m. + orthogonal_transformation f /\ s has_measure m + ==> (IMAGE f s) has_measure m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_LINEAR_IMAGE_ALT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC(REAL_RING `x = &1 ==> x * m = m`) THEN + REWRITE_TAC[REAL_ARITH `abs x = &1 <=> x = &1 \/ x = -- &1`] THEN + MATCH_MP_TAC DET_ORTHOGONAL_MATRIX THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX]);; + +let HAS_MEASURE_ORTHOGONAL_IMAGE_EQ = prove + (`!f:real^N->real^N s m. + orthogonal_transformation f + ==> ((IMAGE f s) has_measure m <=> s has_measure m)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[HAS_MEASURE_ORTHOGONAL_IMAGE] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_MEASURE_ORTHOGONAL_IMAGE) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; IMAGE_I]);; + +add_linear_invariants + [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] HAS_MEASURE_ORTHOGONAL_IMAGE_EQ];; + +let MEASURE_ORTHOGONAL_IMAGE_EQ = prove + (`!f:real^N->real^N s. + orthogonal_transformation f + ==> measure(IMAGE f s) = measure s`, + SIMP_TAC[measure; HAS_MEASURE_ORTHOGONAL_IMAGE_EQ]);; + +add_linear_invariants + [REWRITE_RULE[ORTHOGONAL_TRANSFORMATION] MEASURE_ORTHOGONAL_IMAGE_EQ];; + +let HAS_MEASURE_ISOMETRY = prove + (`!f:real^M->real^N s m. + dimindex(:M) = dimindex(:N) /\ linear f /\ (!x. norm(f x) = norm x) + ==> (IMAGE f s has_measure m <=> s has_measure m)`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS + `IMAGE ((\x. lambda i. x$i):real^N->real^M) (IMAGE (f:real^M->real^N) s) + has_measure m` THEN + CONJ_TAC THENL + [SPEC_TAC(`IMAGE (f:real^M->real^N) s`,`s:real^N->bool`) THEN GEN_TAC THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[has_measure] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + HAS_INTEGRAL_TWIZZLE_EQ o lhand o snd) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ONCE_ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM I_DEF; PERMUTES_I]; + REWRITE_TAC[GSYM IMAGE_o] THEN + MATCH_MP_TAC HAS_MEASURE_ORTHOGONAL_IMAGE_EQ THEN + ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; o_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]; + X_GEN_TAC `x:real^M` THEN + TRANS_TAC EQ_TRANS `norm((f:real^M->real^N) x)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN + SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN SIMP_TAC[LAMBDA_BETA]]]);; + +let MEASURABLE_LINEAR_IMAGE_EQ_GEN = prove + (`!f:real^M->real^N s. + dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y) + ==> (measurable(IMAGE f s) <=> measurable s)`, + REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS + `measurable(IMAGE ((\x. lambda i. x$i):real^N->real^M) + (IMAGE (f:real^M->real^N) s))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN REWRITE_TAC[measurable] THEN + AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_MEASURE_ISOMETRY THEN + ONCE_ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]; + SIMP_TAC[NORM_EQ; dot; LAMBDA_BETA] THEN + ASM_MESON_TAC[]]; + REWRITE_TAC[GSYM IMAGE_o] THEN + MATCH_MP_TAC MEASURABLE_LINEAR_IMAGE_EQ THEN CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_COMPOSE THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]; + SIMP_TAC[CART_EQ; LAMBDA_BETA; o_DEF] THEN + ASM_MESON_TAC[CART_EQ]]]);; + +let MEASURE_ISOMETRY = prove + (`!f:real^M->real^N s. + dimindex(:M) = dimindex(:N) /\ linear f /\ (!x. norm(f x) = norm x) + ==> measure (IMAGE f s) = measure s`, + REPEAT GEN_TAC THEN REWRITE_TAC[measure] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP HAS_MEASURE_ISOMETRY th]));; + +(* ------------------------------------------------------------------------- *) +(* Measure of a standard simplex. *) +(* ------------------------------------------------------------------------- *) + +let CONGRUENT_IMAGE_STD_SIMPLEX = prove + (`!p. p permutes 1..dimindex(:N) + ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\ + (!i. 1 <= i /\ i < dimindex(:N) + ==> x$(p i) <= x$(p(i + 1)))} = + IMAGE (\x:real^N. lambda i. sum(1..inverse p(i)) (\j. x$j)) + {x | (!i. 1 <= i /\ i <= dimindex (:N) ==> &0 <= x$i) /\ + sum (1..dimindex (:N)) (\i. x$i) <= &1}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN + ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL; + ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`; + ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1] THEN + STRIP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN + ASM_SIMP_TAC[SUM_SING_NUMSEG; DIMINDEX_GE_1; LE_REFL] THEN + REWRITE_TAC[GSYM ADD1; SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + ASM_SIMP_TAC[REAL_LE_ADDR] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + STRIP_TAC THEN + EXISTS_TAC `(lambda i. if i = 1 then x$(p 1) + else (x:real^N)$p(i) - x$p(i - 1)):real^N` THEN + ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; LAMBDA_BETA_PERM; LE_REFL; + ARITH_RULE `i < n ==> i <= n /\ i + 1 <= n`; + ARITH_RULE `1 <= n + 1`; DIMINDEX_GE_1; CART_EQ] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `1 <= inverse (p:num->num) i /\ + !x. x <= inverse p i ==> x <= dimindex(:N)` + ASSUME_TAC THENL + [ASM_MESON_TAC[PERMUTES_INVERSE; IN_NUMSEG; LE_TRANS; PERMUTES_IN_IMAGE]; + ASM_SIMP_TAC[LAMBDA_BETA] THEN ASM_SIMP_TAC[SUM_CLAUSES_LEFT; ARITH]] THEN + SIMP_TAC[ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINDER_CONV) + [GSYM REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN + REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `1 <= p ==> p = 1 \/ 2 <= p`) o CONJUNCT1) THEN + ASM_SIMP_TAC[ARITH] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP PERMUTES_INVERSES th]) THEN + REWRITE_TAC[REAL_ADD_RID] THEN TRY REAL_ARITH_TAC THEN + ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_INVERSE]; + + X_GEN_TAC `i:num` THEN STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_LE] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN + ASM_SIMP_TAC[SUB_ADD] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; + + SIMP_TAC[SUM_CLAUSES_LEFT; DIMINDEX_GE_1; ARITH; + ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o BINDER_CONV) + [GSYM REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[SUM_PARTIAL_PRE] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; COND_ID] THEN + REWRITE_TAC[REAL_MUL_LID; ARITH; REAL_SUB_RZERO] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_ADD_RID] THEN + ASM_REWRITE_TAC[REAL_ARITH `x + y - x:real = y`] THEN + ASM_MESON_TAC[DIMINDEX_GE_1; + ARITH_RULE `1 <= n /\ ~(2 <= n) ==> n = 1`]]);; + +let HAS_MEASURE_IMAGE_STD_SIMPLEX = prove + (`!p. p permutes 1..dimindex(:N) + ==> {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\ + (!i. 1 <= i /\ i < dimindex(:N) + ==> x$(p i) <= x$(p(i + 1)))} + has_measure + (measure (convex hull + (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CONGRUENT_IMAGE_STD_SIMPLEX] THEN + ASM_SIMP_TAC[GSYM STD_SIMPLEX] THEN + MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE_SAME THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[linear; CART_EQ] THEN + ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN + REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]; + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `abs(det + ((lambda i. ((lambda i j. if j <= i then &1 else &0):real^N^N) + $inverse p i) + :real^N^N))` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CART_EQ] THEN + ASM_SIMP_TAC[matrix; LAMBDA_BETA; BASIS_COMPONENT; COND_COMPONENT; + LAMBDA_BETA_PERM; PERMUTES_INVERSE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum (1..inverse (p:num->num) i) + (\k. if k = j then &1 else &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN + ASM_SIMP_TAC[IN_NUMSEG; PERMUTES_IN_IMAGE; basis] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LAMBDA_BETA THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; LE_TRANS; + PERMUTES_INVERSE]; + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG]]; + ALL_TAC] THEN + ASM_SIMP_TAC[PERMUTES_INVERSE; DET_PERMUTE_ROWS; ETA_AX] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_SIGN; REAL_MUL_LID] THEN + MATCH_MP_TAC(REAL_ARITH `x = &1 ==> abs x = &1`) THEN + ASM_SIMP_TAC[DET_LOWERTRIANGULAR; GSYM NOT_LT; LAMBDA_BETA] THEN + REWRITE_TAC[LT_REFL; PRODUCT_CONST_NUMSEG; REAL_POW_ONE]]);; + +let HAS_MEASURE_STD_SIMPLEX = prove + (`(convex hull (vec 0:real^N INSERT {basis i | 1 <= i /\ i <= dimindex(:N)})) + has_measure inv(&(FACT(dimindex(:N))))`, + let lemma = prove + (`!f:num->real. (!i. 1 <= i /\ i < n ==> f i <= f(i + 1)) <=> + (!i j. 1 <= i /\ i <= j /\ j <= n ==> f i <= f j)`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LE; REAL_LE_REFL] THEN + STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) j` THEN + ASM_SIMP_TAC[ARITH_RULE `SUC x <= y ==> x <= y`] THEN + REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]) in + MP_TAC(ISPECL + [`\p. {x:real^N | &0 <= x$(p 1) /\ x$(p(dimindex(:N))) <= &1 /\ + (!i. 1 <= i /\ i < dimindex(:N) + ==> x$(p i) <= x$(p(i + 1)))}`; + `{p | p permutes 1..dimindex(:N)}`] + HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE) THEN + ASM_SIMP_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_IMAGE_STD_SIMPLEX; IN_ELIM_THM] THEN + ASM_SIMP_TAC[SUM_CONST; FINITE_PERMUTATIONS; FINITE_NUMSEG; + CARD_PERMUTATIONS; CARD_NUMSEG_1] THEN + ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`p:num->num`; `q:num->num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `?i. i IN 1..dimindex(:N) /\ ~(p i:num = q i)` MP_TAC THENL + [ASM_MESON_TAC[permutes; FUN_EQ_THM]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[TAUT `a ==> ~(b /\ ~c) <=> a /\ b ==> c`] THEN + REWRITE_TAC[IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^N | (basis(p(k:num)) - basis(q k)) dot x = &0}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_HYPERPLANE THEN REWRITE_TAC[VECTOR_SUB_EQ] THEN + MATCH_MP_TAC BASIS_NE THEN ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM; DOT_LSUB; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[DOT_BASIS; GSYM IN_NUMSEG; PERMUTES_IN_IMAGE] THEN + SUBGOAL_THEN `?l. (q:num->num) l = p(k:num)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[permutes]; ALL_TAC] THEN + SUBGOAL_THEN `1 <= l /\ l <= dimindex(:N)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN + SUBGOAL_THEN `k:num < l` ASSUME_TAC THENL + [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN + ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG]; + ALL_TAC] THEN + SUBGOAL_THEN `?m. (p:num->num) m = q(k:num)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[permutes]; ALL_TAC] THEN + SUBGOAL_THEN `1 <= m /\ m <= dimindex(:N)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG]; ALL_TAC] THEN + SUBGOAL_THEN `k:num < m` ASSUME_TAC THENL + [REWRITE_TAC[GSYM NOT_LE] THEN REWRITE_TAC[LE_LT] THEN + ASM_MESON_TAC[PERMUTES_INJECTIVE; IN_NUMSEG]; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[lemma] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN + ASM_SIMP_TAC[LT_IMP_LE; IMP_IMP; REAL_LE_ANTISYM; REAL_SUB_0] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN + ASM_MESON_TAC[PERMUTES_IN_IMAGE; IN_NUMSEG; DOT_BASIS]; + ALL_TAC] THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN + DISCH_THEN(ASSUME_TAC o CONJUNCT2) THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN + REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(y = &0) ==> (x = inv y <=> y * x = &1)`; + REAL_OF_NUM_EQ; FACT_NZ] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `measure(interval[vec 0:real^N,vec 1])` THEN CONJ_TAC THENL + [AP_TERM_TAC; REWRITE_TAC[MEASURE_INTERVAL; CONTENT_UNIT]] THEN + REWRITE_TAC[lemma] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; + RIGHT_FORALL_IMP_THM; IN_ELIM_THM] THEN + SIMP_TAC[IMP_IMP; IN_INTERVAL; LAMBDA_BETA; VEC_COMPONENT] THEN + X_GEN_TAC `p:num->num` THEN STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN + STRIP_TAC THEN X_GEN_TAC `i:num` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `(x:real^N)$(p 1)`; + EXISTS_TAC `(x:real^N)$(p(dimindex(:N)))`] THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `i:num` o MATCH_MP PERMUTES_SURJECTIVE) THEN + ASM_MESON_TAC[LE_REFL; PERMUTES_IN_IMAGE; IN_NUMSEG]; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIONS(IMAGE f t) <=> + !x. x IN s ==> ?y. y IN t /\ x IN f y`] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTERVAL; IN_ELIM_THM] THEN + SIMP_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN + MP_TAC(ISPEC `\i j. ~((x:real^N)$j <= x$i)` TOPOLOGICAL_SORT) THEN + REWRITE_TAC[REAL_NOT_LE; REAL_NOT_LT] THEN + ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`dimindex(:N)`; `1..dimindex(:N)`]) THEN + REWRITE_TAC[HAS_SIZE_NUMSEG_1; EXTENSION; IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->num` (CONJUNCTS_THEN2 + (ASSUME_TAC o GSYM) ASSUME_TAC)) THEN + EXISTS_TAC `\i. if i IN 1..dimindex(:N) then f(i) else i` THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ARITH_RULE + `1 <= i /\ i <= j /\ j <= n <=> + 1 <= i /\ 1 <= j /\ i <= n /\ j <= n /\ i <= j`] THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1] THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[LE_REFL; DIMINDEX_GE_1; LE_LT; REAL_LE_LT]] THEN + SIMP_TAC[PERMUTES_FINITE_SURJECTIVE; FINITE_NUMSEG] THEN + SIMP_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the measure of a general simplex. *) +(* ------------------------------------------------------------------------- *) + +let HAS_MEASURE_SIMPLEX_0 = prove + (`!l:(real^N)list. + LENGTH l = dimindex(:N) + ==> (convex hull (vec 0 INSERT set_of_list l)) has_measure + abs(det(vector l)) / &(FACT(dimindex(:N)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vec 0 INSERT (set_of_list l) = + IMAGE (\x:real^N. transp(vector l:real^N^N) ** x) + (vec 0 INSERT {basis i:real^N | 1 <= i /\ i <= dimindex(:N)})` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[IMAGE_CLAUSES; GSYM IMAGE_o; o_DEF] THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO] THEN AP_TERM_TAC THEN + SIMP_TAC[matrix_vector_mul; vector; transp; LAMBDA_BETA; basis] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(b /\ c ==> ~a)`] THEN + X_GEN_TAC `y:real^N` THEN SIMP_TAC[LAMBDA_BETA; REAL_MUL_RID] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[NOT_IMP; REAL_MUL_RID; GSYM CART_EQ] THEN + ASM_REWRITE_TAC[IN_SET_OF_LIST; MEM_EXISTS_EL] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `SUC i`; EXISTS_TAC `i - 1`] THEN + ASM_REWRITE_TAC[SUC_SUB1] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN + SUBGOAL_THEN + `det(vector l:real^N^N) = det(matrix(\x:real^N. transp(vector l) ** x))` + SUBST1_TAC THENL + [REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL; DET_TRANSP]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN + ASM_SIMP_TAC[GSYM(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_STD_SIMPLEX)] THEN + MATCH_MP_TAC HAS_MEASURE_LINEAR_IMAGE THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN + MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN REWRITE_TAC[BOUNDED_INSERT] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC FINITE_IMP_BOUNDED THEN MATCH_MP_TAC FINITE_IMAGE THEN + REWRITE_TAC[GSYM numseg; FINITE_NUMSEG]);; + +let HAS_MEASURE_SIMPLEX = prove + (`!a l:(real^N)list. + LENGTH l = dimindex(:N) + ==> (convex hull (set_of_list(CONS a l))) has_measure + abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `MAP (\x:real^N. x - a) l` HAS_MEASURE_SIMPLEX_0) THEN + ASM_REWRITE_TAC[LENGTH_MAP; set_of_list] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP HAS_MEASURE_TRANSLATION) THEN + REWRITE_TAC[GSYM CONVEX_HULL_TRANSLATION] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[IMAGE_CLAUSES; VECTOR_ADD_RID; SET_OF_LIST_MAP] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `a + x - a:real^N = x`; + SET_RULE `IMAGE (\x. x) s = s`]);; + +let MEASURABLE_CONVEX_HULL = prove + (`!s. bounded s ==> measurable(convex hull s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN + ASM_SIMP_TAC[CONVEX_CONVEX_HULL; BOUNDED_CONVEX_HULL]);; + +let MEASURABLE_SIMPLEX = prove + (`!l. measurable(convex hull (set_of_list l))`, + GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX_HULL THEN + MATCH_MP_TAC FINITE_IMP_BOUNDED THEN REWRITE_TAC[FINITE_SET_OF_LIST]);; + +let MEASURE_SIMPLEX = prove + (`!a l:(real^N)list. + LENGTH l = dimindex(:N) + ==> measure(convex hull (set_of_list(CONS a l))) = + abs(det(vector(MAP (\x. x - a) l))) / &(FACT(dimindex(:N)))`, + MESON_TAC[HAS_MEASURE_SIMPLEX; HAS_MEASURE_MEASURABLE_MEASURE]);; + +(* ------------------------------------------------------------------------- *) +(* Area of a triangle. *) +(* ------------------------------------------------------------------------- *) + +let HAS_MEASURE_TRIANGLE = prove + (`!a b c:real^2. + convex hull {a,b,c} has_measure + abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^2`; `[b;c]:(real^2)list`] HAS_MEASURE_SIMPLEX) THEN + REWRITE_TAC[LENGTH; DIMINDEX_2; ARITH; set_of_list; MAP] THEN + CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_2; VECTOR_2] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_2; ARITH]);; + +let MEASURABLE_TRIANGLE = prove + (`!a b c:real^N. measurable(convex hull {a,b,c})`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; + +let MEASURE_TRIANGLE = prove + (`!a b c:real^2. + measure(convex hull {a,b,c}) = + abs((b$1 - a$1) * (c$2 - a$2) - (b$2 - a$2) * (c$1 - a$1)) / &2`, + REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_TRIANGLE]);; + +(* ------------------------------------------------------------------------- *) +(* Volume of a tetrahedron. *) +(* ------------------------------------------------------------------------- *) + +let HAS_MEASURE_TETRAHEDRON = prove + (`!a b c d:real^3. + convex hull {a,b,c,d} has_measure + abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) + + (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) + + (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) - + (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) - + (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) - + (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / + &6`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^3`; `[b;c;d]:(real^3)list`] HAS_MEASURE_SIMPLEX) THEN + REWRITE_TAC[LENGTH; DIMINDEX_3; ARITH; set_of_list; MAP] THEN + CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[DET_3; VECTOR_3] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH]);; + +let MEASURABLE_TETRAHEDRON = prove + (`!a b c d:real^N. measurable(convex hull {a,b,c,d})`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_CONVEX THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN MATCH_MP_TAC FINITE_IMP_BOUNDED THEN + REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; + +let MEASURE_TETRAHEDRON = prove + (`!a b c d:real^3. + measure(convex hull {a,b,c,d}) = + abs((b$1 - a$1) * (c$2 - a$2) * (d$3 - a$3) + + (b$2 - a$2) * (c$3 - a$3) * (d$1 - a$1) + + (b$3 - a$3) * (c$1 - a$1) * (d$2 - a$2) - + (b$1 - a$1) * (c$3 - a$3) * (d$2 - a$2) - + (b$2 - a$2) * (c$1 - a$1) * (d$3 - a$3) - + (b$3 - a$3) * (c$2 - a$2) * (d$1 - a$1)) / &6`, + REWRITE_TAC[REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE] + HAS_MEASURE_TETRAHEDRON]);; + +(* ------------------------------------------------------------------------- *) +(* Steinhaus's theorem. (Stromberg's proof as given on Wikipedia.) *) +(* ------------------------------------------------------------------------- *) + +let STEINHAUS = prove + (`!s:real^N->bool. + measurable s /\ &0 < measure s + ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`] + MEASURABLE_INNER_COMPACT) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `measure(s:real^N->bool) / &3`] + MEASURABLE_OUTER_OPEN) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < x / &3 <=> &0 < x`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`k:real^N->bool`; `(:real^N) DIFF u`] + SEPARATE_COMPACT_CLOSED) THEN + ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_BALL_0; IN_ELIM_THM] THEN + X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `~((IMAGE (\x:real^N. v + x) k) INTER k = {})` MP_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPECL [`IMAGE (\x:real^N. v + x) k`; `k:real^N->bool`] + MEASURE_UNION) THEN + ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_EMPTY] THEN + REWRITE_TAC[MEASURE_TRANSLATION; REAL_SUB_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH + `!s:real^N->bool u:real^N->bool. + measure u < measure s + measure s / &3 /\ + measure s < measure k + measure s / &3 /\ + measure x <= measure u + ==> ~(measure x = measure k + measure k)`) THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_UNION] THEN + ASM_REWRITE_TAC[UNION_SUBSET] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `v + x:real^N`]) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; NORM_ARITH + `d <= dist(x:real^N,v + x) <=> ~(norm v < d)`]; + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `v:real^N = x - y <=> x = v + y`] THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* A measurable set with cardinality less than c is negligible. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_NONNEGLIGIBLE_IMP_LARGE = prove + (`!s:real^N->bool. measurable s /\ &0 < measure s ==> s =_c (:real)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:real^N->bool)` THENL + [ASM_MESON_TAC[NEGLIGIBLE_FINITE; MEASURABLE_MEASURE_POS_LT]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN CONJ_TAC THENL + [MESON_TAC[CARD_EQ_EUCLIDEAN; CARD_EQ_SYM; CARD_EQ_IMP_LE]; ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `interval(vec 0:real^N,vec 1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN + MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVAL_UNIV THEN + REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^N,vec 1]` THEN + SIMP_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CARD_LE_SUBSET] THEN + TRANS_TAC CARD_LE_TRANS `cball(vec 0:real^N,d / &2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_EQ_IMP_LE THEN + MATCH_MP_TAC HOMEOMORPHIC_IMP_CARD_EQ THEN + MATCH_MP_TAC HOMEOMORPHIC_CONVEX_COMPACT THEN + REWRITE_TAC[CONVEX_INTERVAL; COMPACT_INTERVAL; INTERIOR_CLOSED_INTERVAL; + CONVEX_CBALL; COMPACT_CBALL; UNIT_INTERVAL_NONEMPTY; + INTERIOR_CBALL; BALL_EQ_EMPTY] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `ball(vec 0:real^N,d)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_LE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `IMAGE (\(x:real^N,y). x - y) (s *_c s)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[mul_c; CARD_LE_SUBSET; SET_RULE + `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`]; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `((s:real^N->bool) *_c s)` THEN + REWRITE_TAC[CARD_LE_IMAGE] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN MATCH_MP_TAC CARD_SQUARE_INFINITE THEN + ASM_REWRITE_TAC[INFINITE]);; + +let MEASURABLE_SMALL_IMP_NEGLIGIBLE = prove + (`!s:real^N->bool. measurable s /\ s <_c (:real) ==> negligible s`, + GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `a /\ b ==> c <=> a ==> ~c ==> ~b`] THEN + SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT] THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_NONNEGLIGIBLE_IMP_LARGE) THEN + REWRITE_TAC[lt_c] THEN MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Austin's Lemma. *) +(* ------------------------------------------------------------------------- *) + +let AUSTIN_LEMMA = prove + (`!D. FINITE D /\ + (!d. d IN D + ==> ?k a b. d = interval[a:real^N,b] /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> b$i - a$i = k)) + ==> ?D'. D' SUBSET D /\ pairwise DISJOINT D' /\ + measure(UNIONS D') >= + measure(UNIONS D) / &3 pow (dimindex(:N))`, + GEN_TAC THEN WF_INDUCT_TAC `CARD(D:(real^N->bool)->bool)` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + ASM_CASES_TAC `D:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[SUBSET_EMPTY; UNWIND_THM2; PAIRWISE_EMPTY] THEN + REWRITE_TAC[UNIONS_0; real_ge; MEASURE_EMPTY; NOT_IN_EMPTY] THEN + REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `?d:real^N->bool. d IN D /\ !d'. d' IN D ==> measure d' <= measure d` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `IMAGE measure (D:(real^N->bool)->bool)` SUP_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `{c:real^N->bool | c IN (D DELETE d) /\ c INTER d = {}}`) THEN + ANTS_TAC THENL [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[FINITE_DELETE; FINITE_RESTRICT; IN_ELIM_THM; real_ge] THEN + ANTS_TAC THENL [ASM_SIMP_TAC[IN_DELETE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `D':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(d:real^N->bool) INSERT D'` THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + REWRITE_TAC[pairwise; IN_INSERT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a3 b3:real^N. + measure(interval[a3,b3]) = &3 pow dimindex(:N) * measure d /\ + !c. c IN D /\ ~(c INTER d = {}) ==> c SUBSET interval[a3,b3]` + STRIP_ASSUME_TAC THENL + [USE_THEN "*" (MP_TAC o SPEC `d:real^N->bool`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real`; `a:real^N`; `b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + EXISTS_TAC `inv(&2) % (a + b) - &3 / &2 % (b - a):real^N` THEN + EXISTS_TAC `inv(&2) % (a + b) + &3 / &2 % (b - a):real^N` THEN + CONJ_TAC THENL + [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `(x + &3 / &2 * a) - (x - &3 / &2 * a) = &3 * a`; + REAL_ARITH `x - a <= x + a <=> &0 <= a`] THEN + ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= &3 / &2 * x - &0 <=> &0 <= x`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + SIMP_TAC[PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; REAL_POW_MUL]; + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k':real`; `a':real^N`; `b':real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE RAND_CONV [DISJOINT_INTERVAL]) THEN + REWRITE_TAC[NOT_EXISTS_THM; SUBSET_INTERVAL] THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `interval[a':real^N,b']`) THEN + ASM_REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT] THEN + REWRITE_TAC[REAL_ARITH `a$k <= b$k <=> &0 <= b$k - a$k`] THEN + ASM_SIMP_TAC[IN_NUMSEG] THEN + ASM_CASES_TAC `&0 <= k` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `&0 <= k'` THEN ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(fun th -> + SIMP_TAC[th] THEN MP_TAC(ISPEC `i:num` th))) THEN + ASM_SIMP_TAC[PRODUCT_CONST; CARD_NUMSEG_1; FINITE_NUMSEG] THEN + DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] + REAL_POW_LE2_REV)) THEN + ASM_SIMP_TAC[DIMINDEX_GE_1; LE_1] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[UNIONS_INSERT] THEN + SUBGOAL_THEN `!d:real^N->bool. d IN D ==> measurable d` ASSUME_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_DISJOINT_UNION o + rand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC MEASURABLE_UNIONS THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + FINITE_SUBSET)) THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_DELETE]; + DISCH_THEN SUBST1_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(interval[a3:real^N,b3]) + + measure(UNIONS D DIFF interval[a3,b3])` THEN + CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) MEASURE_DISJOINT_UNION o + rand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF; + MEASURABLE_INTERVAL] THEN SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_UNIONS]; + ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_DIFF; + MEASURABLE_INTERVAL; MEASURABLE_UNION]; + SET_TAC[]]]; + ASM_REWRITE_TAC[REAL_ARITH `a * x + y <= (x + z) * a <=> y <= z * a`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `y <= a ==> x <= y ==> x <= a`)) THEN + SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNIONS; MEASURABLE_INTERVAL; + IN_ELIM_THM; IN_DELETE; FINITE_DELETE; FINITE_RESTRICT] THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Some differentiability-like properties of the indefinite integral. *) +(* The first two proofs are minor variants of each other, but it was more *) +(* work to derive one from the other. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRABLE_CCONTINUOUS_EXPLICIT = prove + (`!f:real^M->real^N. + (!a b. f integrable_on interval[a,b]) + ==> ?k. negligible k /\ + !x e. ~(x IN k) /\ &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(inv(content(interval[x,x + h % vec 1])) % + integral (interval[x,x + h % vec 1]) f - + f(x)) < e`, + REPEAT STRIP_TAC THEN REWRITE_TAC[IN_UNIV] THEN + MAP_EVERY ABBREV_TAC + [`box = \h x. interval[x:real^M,x + h % vec 1]`; + `box2 = \h x. interval[x:real^M - h % vec 1,x + h % vec 1]`; + `i = \h:real x:real^M. inv(content(box h x)) % + integral (box h x) (f:real^M->real^N)`] THEN + SUBGOAL_THEN + `?k. negligible k /\ + !x e. ~(x IN k) /\ &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(i h x - (f:real^M->real^N) x) < e` + MP_TAC THENL + [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN + EXISTS_TAC + `{x | ~(!e. &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN + SIMP_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC + `UNIONS {{x | !d. &0 < d + ==> ?h. &0 < h /\ h < d /\ + inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)} + | k IN (:num)}` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN + REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + X_GEN_TAC `d:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[dist] THEN + MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `jj:num` THEN + SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL + [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`] + HENSTOCK_LEMMA) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &6 pow (dimindex(:M))`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; + REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN + ABBREV_TAC + `E = {x | x IN interval[a,b] /\ + !d. &0 < d + ==> ?h. &0 < h /\ h < d /\ + mu <= dist(i h x,(f:real^M->real^N) x)}` THEN + SUBGOAL_THEN + `!x. x IN E + ==> ?h. &0 < h /\ + (box h x:real^M->bool) SUBSET (g x) /\ + (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\ + mu <= dist(i h x,(f:real^M->real^N) x)` + MP_TAC THENL + [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN + REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN + ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "box" THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN + X_GEN_TAC `y:real^M` THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN + SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN + EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN + DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uv:real^M->real` THEN + REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`; + `\x:real^M. if x IN E then ball(x,uv x) else g(x)`] + COVERING_LEMMA) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL + [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[gauge] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN + EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `measurable(UNIONS D:real^M->bool) /\ + measure(UNIONS D) <= measure(interval[a:real^M,b])` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?d. d SUBSET D /\ FINITE d /\ + measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL + [EXISTS_TAC `{}:(real^M->bool)->bool` THEN + ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`; + `measure(UNIONS D:real^M->bool) / &2`] + MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN + ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN + CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS]; + ALL_TAC]) THEN + ASM SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN + MP_TAC(ISPEC + `IMAGE (\k:real^M->bool. (box2:real->real^M->real^M->bool) + (uv(tag k):real) ((tag k:real^M))) d` + AUSTIN_LEMMA) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box2" THEN + EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN + EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN + EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; + MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + EXPAND_TAC "box2" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; + REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN + X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + EXPAND_TAC "box2" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN + X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + + SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS (IMAGE (\k:real^M->bool. + (box:real->real^M->real^M->bool) + (uv(tag k):real) ((tag k:real^M))) p)) * + &6 pow dimindex (:M)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `!box. IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool) + (uv(tag k):real) ((tag k:real^M))) p = + IMAGE (\t. box (uv t) t) (IMAGE tag p)` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[GSYM IMAGE_o; o_DEF]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o + lhand o rand o snd) THEN + W(MP_TAC o PART_MATCH (lhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o + lhand o lhand o rand o snd) THEN + MATCH_MP_TAC(TAUT + `fp /\ (mb /\ mb') /\ (db /\ db') /\ (m1 /\ m2 ==> p) + ==> (fp /\ mb /\ db ==> m1) ==> (fp /\ mb' /\ db' ==> m2) ==> p`) THEN + SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ASM_SIMP_TAC[FINITE_IMAGE]] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN + REWRITE_TAC[MEASURABLE_INTERVAL]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; AND_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`k1:real^M->bool`; `k2:real^M->bool`] THEN + MATCH_MP_TAC(TAUT + `(q ==> r) /\ (p ==> q) ==> (p ==> q) /\ (p ==> r)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' ==> (s INTER t) SUBSET (s' INTER t')`) THEN + CONJ_TAC THEN MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + STRIP_TAC THEN + MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `k1:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `k2:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN + SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\ + &0 <= uv((tag:(real^M->bool)->real^M) k2)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SET_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN + REWRITE_TAC[GSYM SUM_RMUL] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `t:real^M` THEN DISCH_THEN(K ALL_TAC) THEN + SUBST1_TAC(REAL_ARITH `&6 = &2 * &3`) THEN + REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`; + REAL_ARITH `a - x <= a + x <=> &0 <= x`] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `(t + h) - (t - h):real = &2 * h`; + REAL_ARITH `(t + h) - t:real = h`] THEN + REWRITE_TAC[PRODUCT_MUL_NUMSEG; PRODUCT_CONST_NUMSEG] THEN + REWRITE_TAC[ADD_SUB; REAL_MUL_AC]; + ALL_TAC] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `IMAGE (\k. (tag:(real^M->bool)->real^M) k, + (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN + ANTS_TAC THENL + [REWRITE_TAC[tagged_partial_division_of; fine] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN + REWRITE_TAC[MESON[] + `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=> + (!k. k IN d ==> P (tag k) (g k))`] THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 < u ==> x <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET]; + ASM_MESON_TAC[SUBSET]; + EXPAND_TAC "box" THEN MESON_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN + ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN + ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXPAND_TAC "box2" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN + SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\ + &0 <= uv((tag:(real^M->bool)->real^M) k2)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(SET_RULE + `i1 SUBSET s1 /\ i2 SUBSET s2 + ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN + CONJ_TAC THEN MATCH_MP_TAC(MESON[INTERIOR_SUBSET; SUBSET_TRANS] + `s SUBSET t ==> interior s SUBSET t`) THEN + MAP_EVERY EXPAND_TAC ["box"; "box2"] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ASM_MESON_TAC[SUBSET]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN + CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN + MATCH_MP_TAC SUM_LE_INCLUDED THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN + REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN + EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC + THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag k):real^M->bool)` + MP_TAC THENL + [EXPAND_TAC "box" THEN + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a <= a + x`] THEN + MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN + REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (funpow 2 RAND_CONV) + [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN + ASSUME_TAC th) THEN + REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN + SUBGOAL_THEN + `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N, + f(tag k))` + MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN + REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN + UNDISCH_TAC + `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) + (tag k):real^M->bool)` THEN + EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN + REWRITE_TAC[VECTOR_MUL_LID]);; + +let INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC = prove + (`!f:real^M->real^N. + (!a b. f integrable_on interval[a,b]) + ==> ?k. negligible k /\ + !x e. ~(x IN k) /\ &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(inv(content(interval[x - h % vec 1,x + h % vec 1])) % + integral (interval[x - h % vec 1,x + h % vec 1]) f - + f(x)) < e`, + REPEAT STRIP_TAC THEN + MAP_EVERY ABBREV_TAC + [`box = \h x. interval[x - h % vec 1:real^M,x + h % vec 1]`; + `i = \h:real x:real^M. inv(content(box h x)) % + integral (box h x) (f:real^M->real^N)`] THEN + SUBGOAL_THEN + `?k. negligible k /\ + !x e. ~(x IN k) /\ &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(i h x - (f:real^M->real^N) x) < e` + MP_TAC THENL + [ALL_TAC; MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[]] THEN + EXISTS_TAC + `{x | ~(!e. &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(i h x - (f:real^M->real^N) x) < e)}` THEN + SIMP_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC + `UNIONS {{x | !d. &0 < d + ==> ?h. &0 < h /\ h < d /\ + inv(&k + &1) <= dist(i h x,(f:real^M->real^N) x)} + | k IN (:num)}` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`y:real^M`; `e:real`] THEN STRIP_TAC THEN + REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + X_GEN_TAC `d:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[dist] THEN + MATCH_MP_TAC (REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&k)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `jj:num` THEN + SUBGOAL_THEN `&0 < inv(&jj + &1)` MP_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + SPEC_TAC(`inv(&jj + &1)`,`mu:real`) THEN GEN_TAC THEN DISCH_TAC] THEN + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + ASM_CASES_TAC `negligible(interval[a:real^M,b])` THENL + [ASM_MESON_TAC[NEGLIGIBLE_SUBSET; INTER_SUBSET]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NEGLIGIBLE_INTERVAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `a - vec 1:real^M`; `b + vec 1:real^M`] + HENSTOCK_LEMMA) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_ON_SUBINTERVAL; SUBSET_UNIV]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `(e * mu) / &2 / &3 pow (dimindex(:M))`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; + REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^M->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SET_RULE `{x | P x} INTER s = {x | x IN s /\ P x}`] THEN + ABBREV_TAC + `E = {x | x IN interval[a,b] /\ + !d. &0 < d + ==> ?h. &0 < h /\ h < d /\ + mu <= dist(i h x,(f:real^M->real^N) x)}` THEN + SUBGOAL_THEN + `!x. x IN E + ==> ?h. &0 < h /\ + (box h x:real^M->bool) SUBSET (g x) /\ + (box h x:real^M->bool) SUBSET interval[a - vec 1,b + vec 1] /\ + mu <= dist(i h x,(f:real^M->real^N) x)` + MP_TAC THENL + [X_GEN_TAC `x:real^M` THEN EXPAND_TAC "E" THEN REWRITE_TAC[IN_ELIM_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [gauge]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `x:real^M`) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `min (&1) (d / &(dimindex(:M)))`)) THEN + REWRITE_TAC[REAL_LT_MIN; REAL_LT_01; GSYM CONJ_ASSOC] THEN + ASM_SIMP_TAC[REAL_LT_DIV; DIMINDEX_GE_1; LE_1; REAL_OF_NUM_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(x:real^M,d)` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "box" THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_BALL] THEN + X_GEN_TAC `y:real^M` THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:M)) (\i. abs((x - y:real^M)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; IN_NUMSEG] THEN + SIMP_TAC[NOT_LT; DIMINDEX_GE_1; CARD_NUMSEG_1; VECTOR_SUB_COMPONENT] THEN + ASM_MESON_TAC[REAL_LET_TRANS]; + UNDISCH_TAC `(x:real^M) IN interval[a,b]` THEN + EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_INTERVAL] THEN + DISCH_THEN(fun th -> X_GEN_TAC `y:real^M` THEN MP_TAC th) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uv:real^M->real` THEN + REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^M`; `b:real^M`; `E:real^M->bool`; + `\x:real^M. if x IN E then ball(x,uv x) else g(x)`] + COVERING_LEMMA) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[INTERVAL_NE_EMPTY] THEN CONJ_TAC THENL + [EXPAND_TAC "E" THEN SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[gauge] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[gauge]) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `D:(real^M->bool)->bool`) THEN + EXISTS_TAC `UNIONS D:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `measurable(UNIONS D:real^M->bool) /\ + measure(UNIONS D) <= measure(interval[a:real^M,b])` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?d. d SUBSET D /\ FINITE d /\ + measure(UNIONS D:real^M->bool) <= &2 * measure(UNIONS d)` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `measure(UNIONS D:real^M->bool) = &0` THENL + [EXISTS_TAC `{}:(real^M->bool)->bool` THEN + ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; MEASURE_EMPTY; UNIONS_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + MP_TAC(ISPECL [`D:(real^M->bool)->bool`; `measure(interval[a:real^M,b])`; + `measure(UNIONS D:real^M->bool) / &2`] + MEASURE_COUNTABLE_UNIONS_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_MEASURE_POS_LT; REAL_HALF] THEN + ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN + CONJ_TAC THENL [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL; MEASURABLE_UNIONS]; + ALL_TAC]) THEN + ASM SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o el 3 o CONJUNCTS) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + SIMP_TAC[IN_INTER] THEN REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(X_CHOOSE_TAC `tag:(real^M->bool)->real^M`) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `D <= &2 * d ==> d <= e / &2 ==> D <= e`)) THEN + MP_TAC(ISPEC + `IMAGE (\k:real^M->bool. (box:real->real^M->real^M->bool) + (uv(tag k):real) ((tag k:real^M))) d` + AUSTIN_LEMMA) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN EXPAND_TAC "box" THEN + EXISTS_TAC `&2 * uv((tag:(real^M->bool)->real^M) k):real` THEN + EXISTS_TAC `(tag:(real^M->bool)->real^M) k - uv(tag k) % vec 1:real^M` THEN + EXISTS_TAC `(tag:(real^M->bool)->real^M) k + uv(tag k) % vec 1:real^M` THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[EXISTS_SUBSET_IMAGE; real_ge] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `p:(real^M->bool)->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REAL_ARITH + `d <= d' /\ p <= e ==> d' <= p ==> d <= e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; + MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; + REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_IMAGE] THEN + X_GEN_TAC `z:real^M` THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(z:real^M) IN k` THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(tag k:real^M,uv(tag(k:real^M->bool)))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + EXPAND_TAC "box" THEN REWRITE_TAC[SUBSET; IN_BALL; IN_INTERVAL] THEN + X_GEN_TAC `z:real^M` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + SIMP_TAC[REAL_ARITH `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; REAL_LE_TRANS]]; + ALL_TAC] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + SUBGOAL_THEN `FINITE(p:(real^M->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN + EXISTS_TAC `mu:real` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `IMAGE (\k. (tag:(real^M->bool)->real^M) k, + (box(uv(tag k):real) (tag k):real^M->bool)) p`) THEN + ANTS_TAC THENL + [REWRITE_TAC[tagged_partial_division_of; fine] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_IMAGE; PAIR_EQ] THEN + REWRITE_TAC[MESON[] + `(!x j. (?k. (x = tag k /\ j = g k) /\ k IN d) ==> P x j) <=> + (!k. k IN d ==> P (tag k) (g k))`] THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "box" THEN REWRITE_TAC[IN_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 < u ==> x - u <= x /\ x <= x + u`) THEN ASM_MESON_TAC[SUBSET]; + ASM_MESON_TAC[SUBSET]; + EXPAND_TAC "box" THEN MESON_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k1:real^M->bool` THEN + ASM_CASES_TAC `(k1:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k2:real^M->bool` THEN + ASM_CASES_TAC `(k2:real^M->bool) IN p` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(tag:(real^M->bool)->real^M) k1 = tag k2` THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXPAND_TAC "box" THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `x - e <= x + e <=> &0 <= e`] THEN + SUBGOAL_THEN `&0 <= uv((tag:(real^M->bool)->real^M) k1) /\ + &0 <= uv((tag:(real^M->bool)->real^M) k2)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + MATCH_MP_TAC MONO_NOT THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(SET_RULE + `i1 SUBSET s1 /\ i2 SUBSET s2 + ==> DISJOINT s1 s2 ==> i1 INTER i2 = {}`) THEN + REWRITE_TAC[INTERIOR_SUBSET]]; + ASM_MESON_TAC[SUBSET]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `e = e' /\ y <= x ==> x < e ==> y <= e'`) THEN + CONJ_TAC THENL [REWRITE_TAC[real_div; REAL_MUL_AC]; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + EXPAND_TAC "box" THEN REWRITE_TAC[MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a' <= e ==> a <= a' ==> a <= e`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM SUM_RMUL] THEN + MATCH_MP_TAC SUM_LE_INCLUDED THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; RIGHT_EXISTS_AND_THM; FINITE_IMAGE] THEN + REWRITE_TAC[NORM_POS_LE; EXISTS_IN_IMAGE] THEN + EXISTS_TAC `SND:real^M#(real^M->bool)->real^M->bool` THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `&0 < uv(tag(k:real^M->bool):real^M):real` ASSUME_TAC + THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) (tag +k):real^M->bool)` + MP_TAC THENL + [EXPAND_TAC "box" THEN + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> a - x <= a + x`] THEN + MATCH_MP_TAC PRODUCT_POS_LT_NUMSEG THEN + REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (funpow 2 RAND_CONV) + [MATCH_MP(REAL_ARITH `&0 < x ==> x = abs x`) th] THEN + ASSUME_TAC th) THEN + REWRITE_TAC[real_div; GSYM REAL_ABS_INV] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM NORM_MUL] THEN + SUBGOAL_THEN + `mu <= dist(i (uv(tag(k:real^M->bool):real^M):real) (tag k):real^N, + f(tag k))` + MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> m <= x ==> m <= y`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN EXPAND_TAC "i" THEN + REWRITE_TAC[dist; VECTOR_SUB_LDISTRIB] THEN + UNDISCH_TAC + `&0 < measure(box(uv(tag(k:real^M->bool):real^M):real) + (tag k):real^M->bool)` THEN + EXPAND_TAC "box" THEN REWRITE_TAC[MEASURE_INTERVAL] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_LT_IMP_NZ; REAL_MUL_LINV] THEN + REWRITE_TAC[VECTOR_MUL_LID]);; + +let HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL = prove + (`!f:real^1->real^N a b. + f integrable_on interval[a,b] + ==> ?k. negligible k /\ + !x. x IN interval[a,b] DIFF k + ==> ((\x. integral(interval[a,x]) f) has_vector_derivative + f(x)) (at x within interval[a,b])`, + SUBGOAL_THEN + `!f:real^1->real^N a b. + f integrable_on interval[a,b] + ==> ?k. negligible k /\ + !x e. x IN interval[a,b] DIFF k /\ & 0 < e + ==> ?d. &0 < d /\ + !x'. x' IN interval[a,b] /\ + drop x < drop x' /\ drop x' < drop x + d + ==> norm(integral(interval[x,x']) f - + drop(x' - x) % f x) / + norm(x' - x) < e` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MP_TAC(ISPEC + `(\x. if x IN interval[a,b] then f x else vec 0):real^1->real^N` + INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; SUBSET_UNIV]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `e:real`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop y - drop x`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `x + (drop y - drop x) % vec 1 = y` SUBST1_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_VEC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CONTENT_1; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN + ASM_SIMP_TAC[REAL_EQ_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ; + GSYM DROP_EQ; REAL_LT_IMP_NE] THEN + SUBGOAL_THEN `norm(y - x) = abs(drop y - drop x)` SUBST1_TAC THENL + [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB]; ALL_TAC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM NORM_MUL)] THEN + REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_FIELD `x < y ==> (y - x) * inv(y - x) = &1`] THEN + AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIFF_EMPTY] THEN DISCH_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(ISPECL [`f:real^1->real^N`; `a:real^1`; `b:real^1`] th) THEN + MP_TAC(ISPECL [`\x. (f:real^1->real^N) (--x)`; `--b:real^1`; + `--a:real^1`] th)) THEN + ASM_REWRITE_TAC[INTEGRABLE_REFLECT] THEN + DISCH_THEN(X_CHOOSE_THEN `k2:real^1->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN + DISCH_THEN(X_CHOOSE_THEN `k1:real^1->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN + EXISTS_TAC `k1 UNION IMAGE (--) k2:real^1->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[linear] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNION; DE_MORGAN_THM] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `x:real^1 = --x' <=> --x = x'`] THEN + REWRITE_TAC[UNWIND_THM1] THEN STRIP_TAC THEN + REWRITE_TAC[has_vector_derivative; HAS_DERIVATIVE_WITHIN] THEN CONJ_TAC THENL + [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "2" (MP_TAC o SPECL [`--x:real^1`; `e:real`]) THEN + REMOVE_THEN "1" (MP_TAC o SPECL [`x:real^1`; `e:real`]) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INTERVAL_REFLECT] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN STRIP_TAC THEN + SUBGOAL_THEN `drop x < drop y \/ drop y < drop x` DISJ_CASES_TAC THENL + [ASM_REAL_ARITH_TAC; + REMOVE_THEN "1" (MP_TAC o SPEC `y:real^1`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(VECTOR_ARITH `c + a:real^N = b ==> a = b - c`) THEN + MATCH_MP_TAC INTEGRAL_COMBINE THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + REMOVE_THEN "2" (MP_TAC o SPEC `--y:real^1`) THEN + ANTS_TAC THENL [SIMP_TAC[DROP_NEG] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `norm(--y - --x) = abs(drop y - drop x)` SUBST1_TAC THENL + [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; DROP_NEG] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x < e ==> y < e`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[INTEGRAL_REFLECT] THEN + REWRITE_TAC[VECTOR_NEG_NEG; DROP_SUB; DROP_NEG] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `x - (--a - --b) % y:real^N = --(--x - (a - b) % y)`] THEN + REWRITE_TAC[NORM_NEG] THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(VECTOR_ARITH `b + a = c ==> --a:real^N = b - c`) THEN + MATCH_MP_TAC INTEGRAL_COMBINE THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real^1`; `b:real^1`] THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]);; + +let ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS = prove + (`!f:real^M->real^N. + (!a b. f absolutely_integrable_on interval[a,b]) + ==> ?k. negligible k /\ + !x e. ~(x IN k) /\ &0 < e + ==> ?d. &0 < d /\ + !h. &0 < h /\ h < d + ==> norm(inv(content(interval[x - h % vec 1, + x + h % vec 1])) % + integral (interval[x - h % vec 1, + x + h % vec 1]) + (\t. lift(norm(f t - f x)))) + < e`, + REPEAT STRIP_TAC THEN + MP_TAC(GEN `r:real^N` (ISPEC `\t. lift(norm((f:real^M->real^N) t - r))` + INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC)) THEN + REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST]; + ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `k:real^N->real^M->bool` THEN STRIP_TAC THEN + EXISTS_TAC + `UNIONS (IMAGE (k:real^N->real^M->bool) + {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RATIONAL_COORDINATES] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN STRIP_TAC THEN + MP_TAC(SET_RULE `(f:real^M->real^N) x IN (:real^N)`) THEN + REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`r:real^N`; `x:real^M`; `e / &3`]) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(y1:real^N) < e / &3 /\ norm(i1 - i2) <= e / &3 + ==> norm(i1 - y1) < e / &3 ==> norm(i2) < e`) THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[dist; DIST_SYM]; ALL_TAC] THEN + REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `abs(inv(content(interval[x - h % vec 1,x + h % vec 1]))) * + drop(integral (interval[x - h % vec 1,x + h % vec 1]) + (\x:real^M. lift(e / &3)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_SUB o rand o lhand o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_CONST]; + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM; LIFT_DROP; GSYM LIFT_SUB] THEN + ASM_MESON_TAC[NORM_ARITH + `dist(r,x) < e / &3 + ==> abs(norm(y - r:real^N) - norm(y - x)) <= e / &3`]]]; + ASM_CASES_TAC + `content(interval[x - h % vec 1:real^M,x + h % vec 1]) = &0` + THENL + [ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_NUM; REAL_MUL_LZERO] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ABS_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; + GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[INTEGRAL_CONST; DROP_CMUL; LIFT_DROP] THEN + SIMP_TAC[real_abs; CONTENT_POS_LE; REAL_MUL_SYM; REAL_LE_REFL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Measurability of a function on a set (not necessarily itself measurable). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("measurable_on",(12,"right"));; + +let measurable_on = new_definition + `(f:real^M->real^N) measurable_on s <=> + ?k g. negligible k /\ + (!n. (g n) continuous_on (:real^M)) /\ + (!x. ~(x IN k) + ==> ((\n. g n x) --> if x IN s then f(x) else vec 0) + sequentially)`;; + +let MEASURABLE_ON_UNIV = prove + (`(\x. if x IN s then f(x) else vec 0) measurable_on (:real^M) <=> + f measurable_on s`, + REWRITE_TAC[measurable_on; IN_UNIV; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Lebesgue measurability (like "measurable" but allowing infinite measure) *) +(* ------------------------------------------------------------------------- *) + +let lebesgue_measurable = new_definition + `lebesgue_measurable s <=> (indicator s) measurable_on (:real^N)`;; + +(* ------------------------------------------------------------------------- *) +(* Relation between measurability and integrability. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f:real^M->real^N g s. + f measurable_on s /\ + g integrable_on s /\ + (!x. x IN s ==> norm(f x) <= drop(g x)) + ==> f integrable_on s`, + let lemma = prove + (`!f:real^M->real^N g a b. + f measurable_on (:real^M) /\ + g integrable_on interval[a,b] /\ + (!x. x IN interval[a,b] ==> norm(f x) <= drop(g x)) + ==> f integrable_on interval[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `h:num->real^M->real^N`] THEN + STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN + MAP_EVERY EXISTS_TAC + [`h:num->real^M->real^N`; `g:real^M->real^1`] THEN + ASM_SIMP_TAC[IN_DIFF] THEN REWRITE_TAC[LEFT_AND_FORALL_THM] THEN + X_GEN_TAC `n:num` THEN + UNDISCH_TAC `(g:real^M->real^1) integrable_on interval [a,b]` THEN + SUBGOAL_THEN + `(h:num->real^M->real^N) n absolutely_integrable_on interval[a,b]` + MP_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + REWRITE_TAC[IMP_IMP; absolutely_integrable_on; GSYM CONJ_ASSOC] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN + MATCH_MP_TAC INTEGRABLE_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN SET_TAC[]]) in + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND THEN + EXISTS_TAC `g:real^M->real^1` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + MATCH_MP_TAC lemma THEN + EXISTS_TAC `(\x. if x IN s then g x else vec 0):real^M->real^1` THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_ALT]) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; DROP_VEC; REAL_POS]);; + +let MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f:real^M->real^N g s k. + f measurable_on s /\ g integrable_on s /\ negligible k /\ + (!x. x IN s DIFF k ==> norm(f x) <= drop(g x)) + ==> f integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN EXISTS_TAC + `\x. if x IN k then lift(norm((f:real^M->real^N) x)) else g x` THEN + ASM_SIMP_TAC[COND_RAND; IN_DIFF; LIFT_DROP; REAL_LE_REFL; COND_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC [`g:real^M->real^1`; `k:real^M->bool`] THEN + ASM_SIMP_TAC[IN_DIFF]);; + +let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove + (`!f:real^M->real^N g s. + f measurable_on s /\ + g integrable_on s /\ + (!x. x IN s ==> norm(f x) <= drop(g x)) + ==> f absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `g:real^M->real^1`] + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[NORM_REAL; GSYM drop] THEN + ASM_MESON_TAC[REAL_ABS_LE; REAL_LE_TRANS]; + ASM_MESON_TAC[MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE]; + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; GSYM drop] THEN + ASM_MESON_TAC[NORM_ARITH `norm(x) <= a ==> &0 <= a`]]);; + +let INTEGRAL_DROP_LE_MEASURABLE = prove + (`!f g s:real^N->bool. + f measurable_on s /\ + g integrable_on s /\ + (!x. x IN s ==> &0 <= drop(f x) /\ drop(f x) <= drop(g x)) + ==> drop(integral s f) <= drop(integral s g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `g:real^N->real^1` THEN + ASM_SIMP_TAC[NORM_REAL; GSYM drop; real_abs]);; + +let INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE = prove + (`!f:real^M->real^N. + (!a b. f integrable_on interval[a,b]) ==> f measurable_on (:real^M)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN + MAP_EVERY ABBREV_TAC + [`box = \h x. interval[x:real^M,x + h % vec 1]`; + `i = \h:real x:real^M. inv(content(box h x)) % + integral (box h x) (f:real^M->real^N)`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `(\n x. i (inv(&n + &1)) x):num->real^M->real^N` THEN + REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[continuous_on; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`; `e:real`] THEN + DISCH_TAC THEN EXPAND_TAC "i" THEN EXPAND_TAC "box" THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; + `x - &2 % vec 1:real^M`; + `x + &2 % vec 1:real^M`; + `x:real^M`; + `x + inv(&n + &1) % vec 1:real^M`; + `e * (&1 / (&n + &1)) pow dimindex(:M)`] + INDEFINITE_INTEGRAL_CONTINUOUS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; + REAL_MUL_RID; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 <= inv(&n + &1) /\ inv(&n + &1) <= &1` MP_TAC THENL + [ALL_TAC; REAL_ARITH_TAC] THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LT_DIV THEN + REAL_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min k (&1)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN + ASM_REWRITE_TAC[dist] THEN X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `a <= a + x <=> &0 <= x`] THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_ARITH `&0 <= &n + &1`] THEN + REWRITE_TAC[REAL_ARITH `(x + inv y) - x = &1 / y`] THEN + REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB] THEN + REWRITE_TAC[GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW; REAL_ABS_DIV] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_DIV; REAL_POW_LT; + REAL_ARITH `&0 < &1 /\ &0 < &n + &1`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_ARITH `(y + i) - (x + i):real^N = y - x`; + VECTOR_ARITH `(y - i) - (x - i):real^N = y - x`] THEN + ASM_SIMP_TAC[IN_INTERVAL; REAL_LT_IMP_LE] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; dist; + VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i /\ i <= dimindex(:M)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= i /\ i <= &1 /\ abs(x - y) <= &1 + ==> (x - &2 <= y /\ y <= x + &2) /\ + (x - &2 <= y + i /\ y + i <= x + &2)`) THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; + REAL_ARITH `&0 <= &n + &1 /\ &1 <= &n + &1`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LT_IMP_LE; NORM_SUB; + REAL_LE_TRANS]]; + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_CCONTINUOUS_EXPLICIT) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + ASM_CASES_TAC `negligible(k:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^M` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real` THEN STRIP_TAC THEN + MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MAP_EVERY EXPAND_TAC ["i"; "box"] THEN REWRITE_TAC[dist] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC]);; + +let INTEGRABLE_IMP_MEASURABLE = prove + (`!f:real^M->real^N s. + f integrable_on s ==> f measurable_on s`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV; GSYM MEASURABLE_ON_UNIV] THEN + SPEC_TAC(`\x. if x IN s then (f:real^M->real^N) x else vec 0`, + `f:real^M->real^N`) THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; + +let ABSOLUTELY_INTEGRABLE_MEASURABLE = prove + (`!f:real^M->real^N s. + f absolutely_integrable_on s <=> + f measurable_on s /\ (\x. lift(norm(f x))) integrable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_integrable_on] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN + REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE] THEN STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. lift(norm((f:real^M->real^N) x))` THEN + ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Composing continuous and measurable functions; a few variants. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_COMPOSE_CONTINUOUS = prove + (`!f:real^M->real^N g:real^N->real^P. + f measurable_on (:real^M) /\ g continuous_on (:real^N) + ==> (g o f) measurable_on (:real^M)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[measurable_on; IN_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n x. (g:real^N->real^P) ((h:num->real^M->real^N) n x)` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [CONTINUOUS_ON_SEQUENTIALLY]) THEN + ASM_SIMP_TAC[o_DEF; IN_UNIV]]);; + +let MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove + (`!f:real^M->real^N g:real^N->real^P s. + f measurable_on s /\ g continuous_on (:real^N) /\ g(vec 0) = vec 0 + ==> (g o f) measurable_on s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);; + +let MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove + (`!f:real^M->real^N g:real^N->real^P a b. + f measurable_on (:real^M) /\ + (!x. f(x) IN interval(a,b)) /\ + g continuous_on interval(a,b) + ==> (g o f) measurable_on (:real^M)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[measurable_on; IN_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `h:num->real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(\n x. (g:real^N->real^P) + (lambda i. max ((a:real^N)$i + (b$i - a$i) / (&n + &2)) + (min ((h n x:real^N)$i) + ((b:real^N)$i - (b$i - a$i) / (&n + &2))))) + :num->real^M->real^P` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MP_TAC(ISPECL + [`(:real^M)`; + `(lambda i. (b:real^N)$i - (b$i - (a:real^N)$i) / (&n + &2)):real^N`] + CONTINUOUS_ON_CONST) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN + MP_TAC(ISPECL + [`(:real^M)`; + `(lambda i. (a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2)):real^N`] + CONTINUOUS_ON_CONST) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval(a:real^N,b)` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M` o CONJUNCT1) THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `&0 < ((b:real^N)$i - (a:real^N)$i) / (&n + &2) /\ + ((b:real^N)$i - (a:real^N)$i) / (&n + &2) <= (b$i - a$i) / &2` MP_TAC + THENL [ALL_TAC; REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < &n + &2`] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[real_div]] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV2 THEN REAL_ARITH_TAC]]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\n. (lambda i. ((a:real^N)$i + ((b:real^N)$i - a$i) / (&n + &2)))) + --> a) sequentially /\ + ((\n. (lambda i. ((b:real^N)$i - ((b:real^N)$i - a$i) / (&n + &2)))) + --> b) sequentially` + MP_TAC THENL + [ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN + SIMP_TAC[LAMBDA_BETA] THEN + CONJ_TAC THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + REWRITE_TAC[real_sub] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_ADD_RID] THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC LIM_ADD THEN + REWRITE_TAC[LIM_CONST; LIFT_NEG; real_div; LIFT_CMUL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_NEG_0] THEN + TRY(MATCH_MP_TAC LIM_NEG) THEN REWRITE_TAC[VECTOR_NEG_0] THEN + SUBST1_TAC(VECTOR_ARITH + `vec 0:real^1 = ((b:real^N)$j + --((a:real^N)$j)) % vec 0`) THEN + MATCH_MP_TAC LIM_CMUL THEN + REWRITE_TAC[LIM_SEQUENTIALLY; DIST_0; NORM_LIFT] THEN + X_GEN_TAC `e:real` THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT; LE_1; + REAL_OF_NUM_LE; REAL_ABS_NUM] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> a /\ c ==> b ==> d`] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_MIN) THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; FUN_EQ_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL]) THEN + ASM_MESON_TAC[REAL_ARITH `a < x /\ x < b ==> max a (min x b) = x`]]);; + +let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove + (`!f:real^M->real^N g:real^N->real^P s. + closed s /\ + f measurable_on (:real^M) /\ + (!x. f(x) IN s) /\ + g continuous_on s + ==> (g o f) measurable_on (:real^M)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^P`; `(:real^N)`; `s:real^N->bool`] + TIETZE_UNBOUNDED) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^P` THEN + DISCH_TAC THEN SUBGOAL_THEN + `(g:real^N->real^P) o (f:real^M->real^N) = h o f` SUBST1_TAC + THENL [ASM_SIMP_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN ASM_REWRITE_TAC[]);; + +let MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove + (`!f:real^M->real^N g:real^N->real^P s t. + closed s /\ + f measurable_on t /\ + (!x. f(x) IN s) /\ + g continuous_on s /\ + vec 0 IN s /\ g(vec 0) = vec 0 + ==> (g o f) measurable_on t`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + MP_TAC(ISPECL [`(\x. if x IN t then f x else vec 0):real^M->real^N`; + `g:real^N->real^P`; `s:real^N->bool`] + MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Basic closure properties of measurable functions. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_IMP_MEASURABLE_ON = prove + (`!f:real^M->real^N. f continuous_on (:real^M) ==> f measurable_on (:real^M)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN + EXISTS_TAC `{}:real^M->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + EXISTS_TAC `\n:num. (f:real^M->real^N)` THEN + ASM_REWRITE_TAC[LIM_CONST]);; + +let MEASURABLE_ON_CONST = prove + (`!k:real^N. (\x. k) measurable_on (:real^M)`, + SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; CONTINUOUS_ON_CONST]);; + +let MEASURABLE_ON_0 = prove + (`!s. (\x. vec 0) measurable_on s`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_CONST; COND_ID]);; + +let MEASURABLE_ON_CMUL = prove + (`!c f:real^M->real^N s. + f measurable_on s ==> (\x. c % f x) measurable_on s`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID]);; + +let MEASURABLE_ON_NEG = prove + (`!f:real^M->real^N s. + f measurable_on s ==> (\x. --(f x)) measurable_on s`, + REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`; + MEASURABLE_ON_CMUL]);; + +let MEASURABLE_ON_NEG_EQ = prove + (`!f:real^M->real^N s. (\x. --(f x)) measurable_on s <=> f measurable_on s`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let MEASURABLE_ON_NORM = prove + (`!f:real^M->real^N s. + f measurable_on s ==> (\x. lift(norm(f x))) measurable_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o ISPEC `\x:real^N. lift(norm x)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS_0)) THEN + REWRITE_TAC[o_DEF; NORM_0; LIFT_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[continuous_on; IN_UNIV; DIST_LIFT] THEN + GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let MEASURABLE_ON_PASTECART = prove + (`!f:real^M->real^N g:real^M->real^P s. + f measurable_on s /\ g measurable_on s + ==> (\x. pastecart (f x) (g x)) measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `k1:real^M->bool` MP_TAC) + (X_CHOOSE_THEN `k2:real^M->bool` MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `g2:num->real^M->real^P` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g1:num->real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k1 UNION k2:real^M->bool` THEN + ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN + EXISTS_TAC `(\n x. pastecart (g1 n x) (g2 n x)) + :num->real^M->real^(N,P)finite_sum` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX; IN_UNION; DE_MORGAN_THM] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN + REWRITE_TAC[GSYM PASTECART_VEC] THEN ASM_SIMP_TAC[LIM_PASTECART]);; + +let MEASURABLE_ON_COMBINE = prove + (`!h:real^N->real^P->real^Q f:real^M->real^N g:real^M->real^P s. + f measurable_on s /\ g measurable_on s /\ + (\x. h (fstcart x) (sndcart x)) continuous_on UNIV /\ + h (vec 0) (vec 0) = vec 0 + ==> (\x. h (f x) (g x)) measurable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^M. (h:real^N->real^P->real^Q) (f x) (g x)) = + (\x. h (fstcart x) (sndcart x)) o (\x. pastecart (f x) (g x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; FSTCART_PASTECART; SNDCART_PASTECART; o_THM]; + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN + ASM_SIMP_TAC[MEASURABLE_ON_PASTECART; FSTCART_VEC; SNDCART_VEC]]);; + +let MEASURABLE_ON_ADD = prove + (`!f:real^M->real^N g:real^M->real^N s. + f measurable_on s /\ g measurable_on s + ==> (\x. f x + g x) measurable_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN + ASM_REWRITE_TAC[VECTOR_ADD_LID] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let MEASURABLE_ON_SUB = prove + (`!f:real^M->real^N g:real^M->real^N s. + f measurable_on s /\ g measurable_on s + ==> (\x. f x - g x) measurable_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN + ASM_REWRITE_TAC[VECTOR_SUB_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let MEASURABLE_ON_MAX = prove + (`!f:real^M->real^N g:real^M->real^N s. + f measurable_on s /\ g measurable_on s + ==> (\x. (lambda i. max ((f x)$i) ((g x)$i)):real^N) + measurable_on s`, + let lemma = REWRITE_RULE[] + (ISPEC `(\x y. lambda i. max (x$i) (y$i)):real^N->real^N->real^N` + MEASURABLE_ON_COMBINE) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + REWRITE_TAC[REAL_ARITH `max x x = x`; LAMBDA_ETA] THEN + SIMP_TAC[continuous_on; LAMBDA_BETA; IN_UNIV; DIST_LIFT] THEN + GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^(N,N)finite_sum`; `e:real`] THEN + DISCH_TAC THEN EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[dist] THEN + X_GEN_TAC `y:real^(N,N)finite_sum` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x - y) < e /\ abs(x' - y') < e + ==> abs(max x x' - max y y') < e`) THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN CONJ_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `norm(x) < e /\ abs(x$i) <= norm x ==> abs(x$i) < e`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM FSTCART_SUB; GSYM SNDCART_SUB] THEN + ASM_MESON_TAC[REAL_LET_TRANS; NORM_FSTCART; NORM_SNDCART]);; + +let MEASURABLE_ON_MIN = prove + (`!f:real^M->real^N g:real^M->real^N s. + f measurable_on s /\ g measurable_on s + ==> (\x. (lambda i. min ((f x)$i) ((g x)$i)):real^N) + measurable_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG)) THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN + SIMP_TAC[CART_EQ; VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN REAL_ARITH_TAC);; + +let MEASURABLE_ON_DROP_MUL = prove + (`!f g:real^M->real^N s. + f measurable_on s /\ g measurable_on s + ==> (\x. drop(f x) % g x) measurable_on s`, + let lemma = REWRITE_RULE[] + (ISPEC `\x y. drop x % y :real^N` MEASURABLE_ON_COMBINE) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; ETA_AX; LIFT_DROP] THEN + CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let MEASURABLE_ON_LIFT_MUL = prove + (`!f g s. (\x. lift(f x)) measurable_on s /\ + (\x. lift(g x)) measurable_on s + ==> (\x. lift(f x * g x)) measurable_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN + REWRITE_TAC[LIFT_CMUL; LIFT_DROP]);; + +let MEASURABLE_ON_VSUM = prove + (`!f:A->real^M->real^N t. + FINITE t /\ (!i. i IN t ==> (f i) measurable_on s) + ==> (\x. vsum t (\i. f i x)) measurable_on s`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; MEASURABLE_ON_0; MEASURABLE_ON_ADD; IN_INSERT; + ETA_AX]);; + +let MEASURABLE_ON_COMPONENTWISE = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + (!i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift(f x$i)) measurable_on (:real^M))`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o + ISPEC `\x:real^N. lift(x$i)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF]; + ALL_TAC] THEN + REWRITE_TAC[measurable_on; IN_UNIV] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`k:num->real^M->bool`; `g:num->num->real^M->real^1`] THEN + DISCH_TAC THEN + EXISTS_TAC `UNIONS(IMAGE k (1..dimindex(:N))):real^M->bool` THEN + EXISTS_TAC `(\n x. lambda i. drop(g i n x)):num->real^M->real^N` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; FORALL_IN_IMAGE; FINITE_IMAGE]; + GEN_TAC THEN ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN + ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]);; + +let MEASURABLE_ON_SPIKE = prove + (`!f:real^M->real^N g s t. + negligible s /\ (!x. x IN t DIFF s ==> g x = f x) + ==> f measurable_on t ==> g measurable_on t`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + REWRITE_TAC[measurable_on] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s UNION k:real^M->bool` THEN + ASM_SIMP_TAC[DE_MORGAN_THM; IN_UNION; NEGLIGIBLE_UNION]);; + +let MEASURABLE_ON_SPIKE_SET = prove + (`!f:real^M->real^N s t. + negligible (s DIFF t UNION t DIFF s) + ==> f measurable_on s + ==> f measurable_on t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[measurable_on] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g:num->real^M->real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k UNION (s DIFF t UNION t DIFF s):real^M->bool` THEN + ASM_SIMP_TAC[NEGLIGIBLE_UNION; IN_UNION; DE_MORGAN_THM] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let MEASURABLE_ON_RESTRICT = prove + (`!f:real^M->real^N s. + f measurable_on (:real^M) /\ lebesgue_measurable s + ==> (\x. if x IN s then f(x) else vec 0) measurable_on (:real^M)`, + REPEAT GEN_TAC THEN REWRITE_TAC[lebesgue_measurable; indicator] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN VECTOR_ARITH_TAC);; + +let MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove + (`!f s t. s SUBSET t /\ f measurable_on t /\ + lebesgue_measurable s + ==> f measurable_on s`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);; + +let MEASURABLE_ON_LIMIT = prove + (`!f:num->real^M->real^N g s k. + (!n. (f n) measurable_on s) /\ + negligible k /\ + (!x. x IN s DIFF k ==> ((\n. f n x) --> g x) sequentially) + ==> g measurable_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`vec 0:real^N`; `vec 1:real^N`] + HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN + REWRITE_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01] THEN + REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h':real^N->real^N`; `h:real^N->real^N`] THEN + REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN + SUBGOAL_THEN + `((h':real^N->real^N) o (h:real^N->real^N) o + (\x. if x IN s then g x else vec 0)) measurable_on (:real^M)` + MP_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[o_DEF; MEASURABLE_ON_UNIV]] THEN + SUBGOAL_THEN `!y:real^N. norm(h y:real^N) <= &(dimindex(:N))` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE h UNIV = s ==> (!z. z IN s ==> P z) ==> !y. P(h y)`)) THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTERVAL] THEN + REWRITE_TAC[VEC_COMPONENT] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((y:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x /\ x < &1 ==> abs(x) <= &1`]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `vec 1:real^N`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `interval[a:real^M,b] DIFF k` THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC DOMINATED_CONVERGENCE_INTEGRABLE THEN + MAP_EVERY EXISTS_TAC + [`(\n x. h(if x IN s then f n x else vec 0:real^N)):num->real^M->real^N`; + `(\x. vec(dimindex(:N))):real^M->real^1`] THEN + REWRITE_TAC[o_DEF; INTEGRABLE_CONST] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC + MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `(\x. vec(dimindex(:N))):real^M->real^1` THEN + ASM_REWRITE_TAC[ETA_AX; INTEGRABLE_CONST] THEN + ASM_SIMP_TAC[DROP_VEC] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN + EXISTS_TAC `interval[a:real^M,b:real^M]` THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[indicator; lebesgue_measurable] + MEASURABLE_ON_RESTRICT) THEN + REWRITE_TAC[MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL + [MP_TAC(ISPECL + [`(\x. if x IN s then f (n:num) x else vec 0):real^M->real^N`; + `h:real^N->real^N`] MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN + ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[MEASURABLE_ON_UNIV; ETA_AX]; + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + REWRITE_TAC[INTEGRABLE_CONST]]; + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `interval[a:real^M,b:real^M]` THEN + REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `interval[a:real^M,b:real^M]` THEN + REWRITE_TAC[INTEGRABLE_CONST] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + ASM_SIMP_TAC[DROP_VEC]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]]; + REWRITE_TAC[o_THM] THEN ASM SET_TAC[]]);; + +let MEASURABLE_ON_BILINEAR = prove + (`!op:real^N->real^P->real^Q f g s:real^M->bool. + bilinear op /\ f measurable_on s /\ g measurable_on s + ==> (\x. op (f x) (g x)) measurable_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `ff:num->real^M->real^N`] THEN + REPLICATE_TAC 3 DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`k':real^M->bool`; `gg:num->real^M->real^P`] THEN + REPLICATE_TAC 3 DISCH_TAC THEN EXISTS_TAC `k UNION k':real^M->bool` THEN + EXISTS_TAC + `\n:num x:real^M. (op:real^N->real^P->real^Q) (ff n x) (gg n x)` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL + [GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_CONTINUOUS_ON_COMPOSE)) THEN + ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(if x IN s then (op:real^N->real^P->real^Q) (f x) (g x) else vec 0) = + op (if x IN s then f(x:real^M) else vec 0) + (if x IN s then g(x:real^M) else vec 0)` + SUBST1_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bilinear]) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o GEN `y:real^N` o MATCH_MP LINEAR_0 o SPEC `y:real^N`) + (MP_TAC o GEN `z:real^P` o MATCH_MP LINEAR_0 o SPEC `z:real^P`)) THEN + MESON_TAC[]; + REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + LIM_BILINEAR)) THEN + ASM_SIMP_TAC[]]]);; + +let ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT = prove + (`!op:real^N->real^P->real^Q f g s:real^M->bool. + bilinear op /\ + f measurable_on s /\ bounded (IMAGE f s) /\ + g absolutely_integrable_on s + ==> (\x. op (f x) (g x)) absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x:real^M. lift(B * C * norm((g:real^M->real^P) x))` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + MEASURABLE_ON_BILINEAR)) THEN + ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; + REWRITE_TAC[LIFT_CMUL] THEN + REPEAT(MATCH_MP_TAC INTEGRABLE_CMUL) THEN + RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + TRANS_TAC REAL_LE_TRANS + `B * norm((f:real^M->real^N) x) * norm(g x:real^P)` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[NORM_POS_LE]]);; + +let MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE = prove + (`!f:real^M->real^N g s t. + f measurable_on s /\ g integrable_on s /\ negligible t /\ + (!x. x IN s DIFF t ==> norm(f x) <= drop(g x)) + ==> f absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] ABSOLUTELY_INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC + [`\x. if x IN s DIFF t then (f:real^M->real^N) x else vec 0`; + `t:real^M->bool`] THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x. if x IN s DIFF t then (g:real^M->real^1) x else vec 0` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[TAUT `p ==> q ==> r <=> q ==> p ==> r`] + MEASURABLE_ON_SPIKE)); + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[TAUT `p ==> q ==> r <=> q ==> p ==> r`] + INTEGRABLE_SPIKE)); + ASM_MESON_TAC[REAL_LE_REFL; NORM_0; DROP_VEC]] THEN + EXISTS_TAC `t:real^M->bool` THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Natural closure properties of measurable functions; the intersection *) +(* one is actually quite tedious since we end up reinventing cube roots *) +(* before they actually get introduced in transcendentals.ml *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_EMPTY = prove + (`!f:real^M->real^N. f measurable_on {}`, + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[NOT_IN_EMPTY; MEASURABLE_ON_CONST]);; + +let MEASURABLE_ON_INTER = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ f measurable_on t + ==> f measurable_on (s INTER t)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> p /\ p ==> q ==> r`] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_LIFT_MUL) THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + REWRITE_TAC[VEC_COMPONENT; REAL_ARITH + `(if p then x else &0) * (if q then y else &0) = + if p /\ q then x * y else &0`] THEN + SUBGOAL_THEN `!s. (\x. lift (drop x pow 3)) continuous_on s` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_ARITH `(x:real) pow 3 = x * x * x`] THEN + REWRITE_TAC[LIFT_CMUL] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]); + ALL_TAC] THEN + SUBGOAL_THEN `?r. !x. lift(drop(r x) pow 3) = x` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM; FORALL_LIFT; GSYM EXISTS_DROP; LIFT_EQ] THEN + X_GEN_TAC `x:real` THEN MP_TAC(ISPECL + [`\x. lift (drop x pow 3)`; `lift(--(abs x + &1))`; + `lift(abs x + &1)`;`x:real`; `1`] IVT_INCREASING_COMPONENT_1) THEN + REWRITE_TAC[GSYM drop; LIFT_DROP; EXISTS_DROP] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `(:real^1)`) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; + REWRITE_TAC[REAL_BOUNDS_LE; REAL_POW_NEG; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &0 <= x pow 2 /\ &0 <= x pow 3 ==> x <= (x + &1) pow 3`) THEN + SIMP_TAC[REAL_POW_LE; REAL_ABS_POS]]; + ALL_TAC] THEN + SUBGOAL_THEN `!x. r(lift(x pow 3)) = lift x` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN GEN_TAC THEN + MATCH_MP_TAC REAL_POW_EQ_ODD THEN EXISTS_TAC `3` THEN + ASM_REWRITE_TAC[ARITH; GSYM LIFT_EQ; LIFT_DROP]; + ALL_TAC] THEN + SUBGOAL_THEN `(r:real^1->real^1) continuous_on (:real^1)` ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`\x. lift(drop x pow 3)`; `(:real^1)`] THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN SUBST1_TAC(SYM th)) THEN + MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN + ASM_REWRITE_TAC[PATH_CONNECTED_UNIV; LIFT_EQ] THEN + SIMP_TAC[REAL_POW_EQ_ODD_EQ; ARITH; DROP_EQ]; + ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 pow 3`] THEN + REWRITE_TAC[REAL_ARITH `(x * x) * x:real = x pow 3`; IN_INTER] THEN + REWRITE_TAC[MESON[] `(if p then x pow 3 else y pow 3) = + (if p then x else y:real) pow 3`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o ISPEC `r:real^1->real^1` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] MEASURABLE_ON_COMPOSE_CONTINUOUS)) THEN + ASM_REWRITE_TAC[o_DEF]]);; + +let MEASURABLE_ON_DIFF = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ f measurable_on t ==> f measurable_on (s DIFF t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IMP_IMP] THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; IN_DIFF; IN_INTER] THEN + X_GEN_TAC `x:real^M` THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let MEASURABLE_ON_UNION = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ f measurable_on t ==> f measurable_on (s UNION t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_INTER) THEN + POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; IN_UNION; IN_INTER] THEN + X_GEN_TAC `x:real^M` THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(x:real^M) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let MEASURABLE_ON_UNIONS = prove + (`!f:real^M->real^N k. + FINITE k /\ (!s. s IN k ==> f measurable_on s) + ==> f measurable_on (UNIONS k)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY; UNIONS_INSERT] THEN + SIMP_TAC[FORALL_IN_INSERT; MEASURABLE_ON_UNION]);; + +let MEASURABLE_ON_COUNTABLE_UNIONS = prove + (`!f:real^M->real^N k. + COUNTABLE k /\ (!s. s IN k ==> f measurable_on s) + ==> f measurable_on (UNIONS k)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `k:(real^M->bool)->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0; MEASURABLE_ON_EMPTY] THEN + MP_TAC(ISPEC `k:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN + EXISTS_TAC `(\n x. if x IN UNIONS (IMAGE d (0..n)) then f x else vec 0): + num->real^M->real^N` THEN + EXISTS_TAC `{}:real^M->bool` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY; MEASURABLE_ON_UNIV] THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_UNIONS THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FORALL_IN_IMAGE]) THEN + SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV; FINITE_IMAGE; FINITE_NUMSEG]; + X_GEN_TAC `x:real^M` THEN DISCH_THEN(K ALL_TAC) THEN + ASM_CASES_TAC `(x:real^M) IN UNIONS (IMAGE d (:num))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIM_EVENTUALLY THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV; EVENTUALLY_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNIONS]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IN_NUMSEG; LE_0] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Negligibility of a Lipschitz image of a negligible set. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE = prove + (`!f:real^M->real^N s. + dimindex(:M) <= dimindex(:N) /\ negligible s /\ + (!x. x IN s + ==> ?t b. open t /\ x IN t /\ + !y. y IN s INTER t + ==> norm(f y - f x) <= b * norm(y - x)) + ==> negligible(IMAGE f s)`, + let lemma = prove + (`!f:real^M->real^N s B. + dimindex(:M) <= dimindex(:N) /\ bounded s /\ negligible s /\ &0 < B /\ + (!x. x IN s + ==> ?t. open t /\ x IN t /\ + !y. y IN s INTER t + ==> norm(f y - f x) <= B * norm(y - x)) + ==> negligible(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^M->bool`; + `e / &2 / (&2 * B * &(dimindex(:M))) pow (dimindex(:N))`] + MEASURABLE_OUTER_OPEN) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC REAL_POW_LT THEN + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + ASM_SIMP_TAC[DIMINDEX_GE_1; REAL_OF_NUM_LT; ARITH; LE_1]; + ALL_TAC] THEN + ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_HALF; MEASURE_EQ_0] THEN + REWRITE_TAC[REAL_ADD_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!x. ?r. &0 < r /\ r <= &1 / &2 /\ + (x IN s + ==> !y. norm(y - x:real^M) < r + ==> y IN t /\ + (y IN s + ==> norm(f y - f x:real^N) <= B * norm(y - x)))` + MP_TAC THENL + [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN + ASM_REWRITE_TAC[] THENL + [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `t INTER u :real^M->bool` open_def) THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_INTER; dist]] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (&1 / &2) r` THEN + ASM_REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl)) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + X_GEN_TAC `r:real^M->real` THEN STRIP_TAC] THEN + SUBGOAL_THEN + `?c. s SUBSET interval[--(vec c):real^M,vec c] /\ + ~(interval(--(vec c):real^M,vec c) = {})` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LE] THEN W(MP_TAC o + PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`; + `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN + ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN + + REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!k. k IN D + ==> ?u v z. k = interval[u,v] /\ ~(interval(u,v) = {}) /\ + z IN s /\ z IN interval[u,v] /\ + interval[u:real^M,v] SUBSET ball(z,r z)` + MP_TAC THENL + [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^M. d = interval[u,v]` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^M` THEN + DISCH_THEN SUBST_ALL_TAC THEN + ASM_MESON_TAC[SUBSET; INTERIOR_CLOSED_INTERVAL; IN_INTER]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`u:(real^M->bool)->real^M`; `v:(real^M->bool)->real^M`; + `z:(real^M->bool)->real^M`] THEN + DISCH_THEN(LABEL_TAC "*") THEN EXISTS_TAC + `UNIONS(IMAGE (\d:real^M->bool. + interval[(f:real^M->real^N)(z d) - + (B * &(dimindex(:M)) * + ((v(d):real^M)$1 - (u(d):real^M)$1)) % vec 1:real^N, + f(z d) + + (B * &(dimindex(:M)) * (v(d)$1 - u(d)$1)) % vec 1]) D)` THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN `(y:real^M) IN UNIONS D` MP_TAC THENL + [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[UNIONS_IMAGE]] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `d:real^M->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(y:real^M) IN ball(z(d:real^M->bool),r(z d))` MP_TAC THENL + [ASM_MESON_TAC[SUBSET]; REWRITE_TAC[IN_BALL; dist]] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN DISCH_TAC THEN + SUBGOAL_THEN + `y IN t /\ + norm((f:real^M->real^N) y - f(z d)) <= B * norm(y - z(d:real^M->bool))` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_INTERVAL] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH + `z - b <= y /\ y <= z + b <=> abs(y - z) <= b`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN W(MP_TAC o + PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LE_TRANS)) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) + [GSYM CARD_NUMSEG_1] THEN + SIMP_TAC[GSYM SUM_CONST; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `((v:(real^M->bool)->real^M) d - u d)$j` THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN CONJ_TAC THENL + [SUBGOAL_THEN `y IN interval[(u:(real^M->bool)->real^M) d,v d] /\ + (z d) IN interval[u d,v d]` + MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `j:num`)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN + ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]]; + ALL_TAC] THEN + MATCH_MP_TAC(MESON[] + `(x <= e / &2 ==> x < e) /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; MEASURABLE_INTERVAL] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN + ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow (dimindex(:N)) * + sum D' (\d:real^M->bool. measure d)` THEN + SUBGOAL_THEN `FINITE(D':(real^M->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[MEASURE_INTERVAL] THEN X_GEN_TAC `d:real^M->bool` THEN + DISCH_TAC THEN REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; REAL_ARITH + `(a - x <= a + x <=> &0 <= x) /\ (a + x) - (a - x) = &2 * x`] THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + SUBGOAL_THEN `d = interval[u d:real^M,v d]` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:M) + ==> ((u:(real^M->bool)->real^M) d)$i <= (v d:real^M)$i` + MP_TAC THENL + [ASM_MESON_TAC[SUBSET; INTERVAL_NE_EMPTY; REAL_LT_IMP_LE]; ALL_TAC] THEN + SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN DISCH_TAC THEN + REWRITE_TAC[PRODUCT_CONST_NUMSEG; REAL_POW_MUL] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_OF_NUM_LT; ARITH; + GSYM REAL_MUL_ASSOC; ADD_SUB; DIMINDEX_GE_1; LE_1] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `((v d:real^M)$1 - ((u:(real^M->bool)->real^M) d)$1) + pow (dimindex(:M))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[REAL_SUB_LE; DIMINDEX_GE_1; LE_REFL] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN W(MP_TAC o + PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN + REWRITE_TAC[DIMINDEX_GE_1; LE_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC(NORM_ARITH + `!z r. norm(z - u) < r /\ norm(z - v) < r /\ r <= &1 / &2 + ==> norm(v - u:real^M) <= &1`) THEN + MAP_EVERY EXISTS_TAC + [`(z:(real^M->bool)->real^M) d`; + `r((z:(real^M->bool)->real^M) d):real`] THEN + ASM_REWRITE_TAC[GSYM dist; GSYM IN_BALL] THEN + SUBGOAL_THEN + `(u:(real^M->bool)->real^M) d IN interval[u d,v d] /\ + (v:(real^M->bool)->real^M) d IN interval[u d,v d]` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + SIMP_TAC[GSYM PRODUCT_CONST; FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(u:(real^M->bool)->real^M) d`; `(v:(real^M->bool)->real^M) d`]) THEN + ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL; SUBSET]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * B * &(dimindex(:M))) pow dimindex(:N) * + measure(t:real^M->bool)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_IMP_LE; ALL_TAC]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + W(MP_TAC o PART_MATCH (rand o rand) REAL_LT_RDIV_EQ o snd)] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_LT_MUL; LE_1; DIMINDEX_GE_1; + REAL_ARITH `&0 < &2 * B <=> &0 < B`; REAL_OF_NUM_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS D':real^M->bool)` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`] + MEASURE_ELEMENTARY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[division_of] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN + GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]]; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]]; + MATCH_MP_TAC MEASURE_SUBSET THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_MESON_TAC[MEASURABLE_INTERVAL; SUBSET]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `UNIONS D:real^M->bool` THEN + ASM_SIMP_TAC[SUBSET_UNIONS] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS] THEN + X_GEN_TAC `d:real^M->bool` THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM SUBSET] THEN + SUBGOAL_THEN `d SUBSET ball(z d:real^M,r(z d))` MP_TAC THENL + [ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET; IN_BALL; dist] THEN + ASM_MESON_TAC[NORM_SUB]]]]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `s = UNIONS + {{x | x IN s /\ norm(x:real^M) <= &n /\ + ?t. open t /\ x IN t /\ + !y. y IN s INTER t + ==> norm(f y - f x:real^N) <= (&n + &1) * norm(y - x)} | + n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `t:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `max (norm(x:real^M)) b` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_MAX_LE] THEN + X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `b * norm(y - x:real^M)` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IMAGE_UNIONS] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN + MATCH_MP_TAC lemma THEN EXISTS_TAC `&n + &1` THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(vec 0:real^M,&n)` THEN + SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM]; + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; IN_INTER] THEN MESON_TAC[]]]);; + +let NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV = prove + (`!f:real^N->real^N s B. + negligible s /\ (!x y. norm(f x - f y) <= B * norm(x - y)) + ==> negligible(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN + ASM_REWRITE_TAC[LE_REFL] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`interval(a - vec 1:real^N,a + vec 1)`; `B:real`] THEN + ASM_REWRITE_TAC[OPEN_INTERVAL; IN_INTERVAL] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN + REAL_ARITH_TAC);; + +let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE = prove + (`!f:real^M->real^N s. + dimindex(:M) <= dimindex(:N) /\ negligible s /\ f differentiable_on s + ==> negligible(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE THEN + ASM_REWRITE_TAC[IN_INTER] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[differentiable; HAS_DERIVATIVE_WITHIN_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^M->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT_01; REAL_MUL_RID] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(x:real^M,d)` THEN EXISTS_TAC `B + &1` THEN + ASM_REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + REWRITE_TAC[IN_BALL; dist; REAL_ADD_RDISTRIB] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `!d. norm(y - x - d:real^N) <= z /\ norm(d) <= b + ==> norm(y - x) <= b + z`) THEN + EXISTS_TAC `(f':real^M->real^N)(y - x)` THEN + ASM_MESON_TAC[NORM_SUB]);; + +let NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM = prove + (`!f:real^M->real^N s. + dimindex(:M) < dimindex(:N) /\ f differentiable_on s + ==> negligible(IMAGE f s)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP + (ARITH_RULE `m < n ==> !x:num. x <= m ==> x <= n`)) THEN + SUBGOAL_THEN + `(f:real^M->real^N) = + (f o ((\x. lambda i. x$i):real^N->real^M)) o + ((\x. lambda i. if i <= dimindex(:M) then x$i else &0):real^M->real^N)` + SUBST1_TAC THENL + [SIMP_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]; + ONCE_REWRITE_TAC[IMAGE_o] THEN + MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN + REWRITE_TAC[LE_REFL] THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{y:real^N | y$(dimindex(:N)) = &0}` THEN + SIMP_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE; LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_GE_1] THEN + ASM_REWRITE_TAC[GSYM NOT_LT]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [differentiable_on]) THEN + REWRITE_TAC[differentiable_on; FORALL_IN_IMAGE] THEN STRIP_TAC THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_WITHIN THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN + SIMP_TAC[linear; LAMBDA_BETA; CART_EQ; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT]; + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN BINOP_TAC THENL + [AP_TERM_TAC; + MATCH_MP_TAC(SET_RULE + `(!x. f(g x) = x) ==> s = IMAGE f (IMAGE g s)`)] THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Simplest case of Sard's theorem (we don't need continuity of derivative). *) +(* ------------------------------------------------------------------------- *) + +let BABY_SARD = prove + (`!f:real^M->real^N f' s. + dimindex(:M) <= dimindex(:N) /\ + (!x. x IN s + ==> (f has_derivative f' x) (at x within s) /\ + rank(matrix(f' x)) < dimindex(:N)) + ==> negligible(IMAGE f s)`, + let lemma = prove + (`!p w e m. + dim p < dimindex(:N) /\ &0 <= m /\ &0 <= e + ==> ?s. measurable s /\ + {z:real^N | norm(z - w) <= m /\ + ?t. t IN p /\ norm(z - w - t) <= e} + SUBSET s /\ + measure s <= (&2 * e) * (&2 * m) pow (dimindex(:N) - 1)`, + REPEAT GEN_TAC THEN GEN_GEOM_ORIGIN_TAC `w:real^N` ["t"; "p"] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN + REWRITE_TAC[VECTOR_SUB_RZERO; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN + X_GEN_TAC `a:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT] THEN + ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC + `interval[--(lambda i. if i = 1 then e else m):real^N, + (lambda i. if i = 1 then e else m)]` THEN + REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL] THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN + X_GEN_TAC `x:real^N` THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[REAL_BOUNDS_LE] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[SPAN_SUPERSET; IN_ELIM_THM; DOT_BASIS; DOT_LMUL; + DIMINDEX_GE_1; LE_REFL; REAL_ENTIRE; REAL_LT_IMP_NZ] THEN + MP_TAC(ISPECL [`x - y:real^N`; `1`] COMPONENT_LE_NORM) THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; ARITH; DIMINDEX_GE_1] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN + SIMP_TAC[PRODUCT_CLAUSES_LEFT; DIMINDEX_GE_1] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN + SIMP_TAC[ARITH; ARITH_RULE `2 <= n ==> ~(n = 1)`] THEN + SIMP_TAC[PRODUCT_CONST_NUMSEG; DIMINDEX_GE_1; REAL_LE_REFL; ARITH_RULE + `1 <= n ==> (n + 1) - 2 = n - 1`]]) in + let semma = prove + (`!f:real^M->real^N f' s B. + dimindex(:M) <= dimindex(:N) /\ &0 < B /\ bounded s /\ + (!x. x IN s ==> (f has_derivative f' x) (at x within s) /\ + rank(matrix(f' x)) < dimindex(:N) /\ onorm(f' x) <= B) + ==> negligible(IMAGE f s)`, + REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!x. x IN s ==> linear((f':real^M->real^M->real^N) x)` + ASSUME_TAC THENL [ASM_MESON_TAC[has_derivative]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?c. s SUBSET interval(--(vec c):real^M,vec c) /\ + ~(interval(--(vec c):real^M,vec c) = {})` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `abs c + &1` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN REWRITE_TAC[SUBSET; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[IN_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN REWRITE_TAC[REAL_BOUNDS_LT] THEN W(MP_TAC o + PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[VEC_COMPONENT; DIMINDEX_GE_1; + LE_REFL; VECTOR_NEG_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `--x < x <=> &0 < &2 * x`; REAL_OF_NUM_MUL] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `?d. &0 < d /\ d <= B /\ + (d * &2) * (&4 * B) pow (dimindex(:N) - 1) <= + e / &(2 * c) pow dimindex(:M) / &(dimindex(:M)) pow dimindex(:M)` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC + `min B (e / &(2 * c) pow dimindex(:M) / + &(dimindex(:M)) pow dimindex(:M) / + (&4 * B) pow (dimindex(:N) - 1) / &2)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_ARITH `min x y <= x`] THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1; + REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH]; + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_POW_LT; + REAL_ARITH `&0 < &4 * B <=> &0 < B`; ARITH] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. ?r. &0 < r /\ r <= &1 / &2 /\ + (x IN s + ==> !y. y IN s /\ norm(y - x) < r + ==> norm((f:real^M->real^N) y - f x - f' x (y - x)) <= + d * norm(y - x))` + MP_TAC THENL + [X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN + ASM_REWRITE_TAC[] THENL + [ALL_TAC; EXISTS_TAC `&1 / &4` THEN REAL_ARITH_TAC] THEN + UNDISCH_THEN + `!x. x IN s ==> ((f:real^M->real^N) has_derivative f' x) (at x within s)` + (MP_TAC o REWRITE_RULE[HAS_DERIVATIVE_WITHIN_ALT]) THEN + ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `d:real`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min r (&1 / &2)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LE; REAL_LE_REFL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `r:real^M->real` THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(LABEL_TAC "*")] THEN + MP_TAC(ISPECL [`--(vec c):real^M`; `(vec c):real^M`; `s:real^M->bool`; + `\x:real^M. ball(x,r x)`] COVERING_LEMMA) THEN + ASM_REWRITE_TAC[gauge; OPEN_BALL; CENTRE_IN_BALL] THEN ANTS_TAC THENL + [ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; ALL_TAC] THEN + REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!k:real^M->bool. + k IN D + ==> ?t. measurable(t) /\ + IMAGE (f:real^M->real^N) (k INTER s) SUBSET t /\ + measure t <= e / &(2 * c) pow (dimindex(:M)) * measure(k)` + MP_TAC THENL + [X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?x:real^M. x IN (s INTER interval[u,v]) /\ + interval[u,v] SUBSET ball(x,r x)` + MP_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_INTER]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`IMAGE ((f':real^M->real^M->real^N) x) (:real^M)`; + `(f:real^M->real^N) x`; + `d * norm(v - u:real^M)`; + `(&2 * B) * norm(v - u:real^M)`] + lemma) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN + MP_TAC(ISPEC `matrix ((f':real^M->real^M->real^N) x)` + RANK_DIM_IM) THEN + ASM_SIMP_TAC[MATRIX_WORKS] THEN REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[]) THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN + REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^M` THEN + REWRITE_TAC[IN_INTER; EXISTS_IN_IMAGE; IN_UNIV] THEN + STRIP_TAC THEN REMOVE_THEN "*" + (MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[IN_BALL; SUBSET; NORM_SUB; dist]; ALL_TAC] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC(NORM_ARITH + `norm(z) <= B /\ d <= B + ==> norm(y - x - z:real^N) <= d + ==> norm(y - x) <= &2 * B`) THEN + CONJ_TAC THENL + [MP_TAC(ISPEC `(f':real^M->real^M->real^N) x` ONORM) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `y - x:real^M` o CONJUNCT1) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[ONORM_POS_LE; NORM_POS_LE]; + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]]; + DISCH_THEN(fun th -> EXISTS_TAC `y - x:real^M` THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ]] THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL])) THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_ARITH `&2 * (&2 * B) * n = (&4 * B) * n`] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_POW_MUL] THEN + SIMP_TAC[REAL_ARITH `(&2 * d * n) * a * b = d * &2 * a * (n * b)`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e / &(2 * c) pow (dimindex(:M)) / + (&(dimindex(:M)) pow dimindex(:M)) * + norm(v - u:real^M) pow dimindex(:N)` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_POW_LE]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [real_div] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_OF_NUM_LT; + LE_1; DIMINDEX_GE_1] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(v - u:real^M) pow dimindex(:M)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_MONO_INV THEN ASM_REWRITE_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN `u IN ball(x:real^M,r x) /\ v IN ball(x,r x)` MP_TAC + THENL + [ASM_MESON_TAC[SUBSET; ENDS_IN_INTERVAL; INTERIOR_EMPTY]; + REWRITE_TAC[IN_BALL] THEN + SUBGOAL_THEN `(r:real^M->real) x <= &1 / &2` MP_TAC THENL + [ASM_REWRITE_TAC[]; CONV_TAC NORM_ARITH]]; + REMOVE_THEN "*" (K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M`; `v:real^M`]) THEN + ASM_REWRITE_TAC[REAL_ARITH `x - --x = &2 * x`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; REAL_OF_NUM_MUL] THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(sum(1..dimindex(:M)) (\i. abs((v - u:real^M)$i))) + pow (dimindex(:M))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN SIMP_TAC[NORM_POS_LE; NORM_LE_L1]; + REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [GSYM REAL_SUB_LE] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2] THEN + ASM_SIMP_TAC[SUM_CONST_NUMSEG; PRODUCT_CONST_NUMSEG; + VECTOR_SUB_COMPONENT; ADD_SUB] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN BINOP_TAC THEN REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[REAL_ABS_REFL] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; REAL_LT_POW2]]]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:(real^M->bool)->(real^N->bool)` THEN DISCH_TAC THEN + EXISTS_TAC `UNIONS (IMAGE (g:(real^M->bool)->(real^N->bool)) D)` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `D':(real^M->bool)->bool` THEN STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o + lhand o snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum D' (\k:real^M->bool. + e / &(2 * c) pow (dimindex(:M)) * measure k)` THEN CONJ_TAC + THENL [MATCH_MP_TAC SUM_LE THEN ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN + REWRITE_TAC[REAL_ARITH `e / b * x:real = (e * x) / b`] THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_LE_LDIV_EQ; REAL_LE_LMUL_EQ] THEN + MP_TAC(ISPECL [`D':(real^M->bool)->bool`; `UNIONS D':real^M->bool`] + MEASURE_ELEMENTARY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[division_of] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[SUBSET]] THEN + GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[SUBSET; INTERIOR_EMPTY]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `y = z /\ x <= e ==> x = y ==> z <= e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(interval[--(vec c):real^M,vec c])` THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN REWRITE_TAC[MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL [MATCH_MP_TAC MEASURABLE_UNIONS; ASM SET_TAC[]] THEN + ASM_MESON_TAC[SUBSET; MEASURABLE_INTERVAL]; + SIMP_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VEC_COMPONENT; VECTOR_NEG_COMPONENT; REAL_ARITH + `x - --x = &2 * x /\ (--x <= x <=> &0 <= &2 * x)`] THEN + ASM_SIMP_TAC[REAL_OF_NUM_MUL; REAL_LT_IMP_LE] THEN + REWRITE_TAC[PRODUCT_CONST_NUMSEG; ADD_SUB; REAL_LE_REFL]]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `s = UNIONS + {{x | x IN s /\ norm(x:real^M) <= &n /\ + onorm((f':real^M->real^M->real^N) x) <= &n} | + n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_MAX_LE; REAL_ARCH_SIMPLE]; + REWRITE_TAC[IMAGE_UNIONS] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[GSYM IMAGE_o; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_UNIV] THEN + MATCH_MP_TAC semma THEN + MAP_EVERY EXISTS_TAC [`f':real^M->real^M->real^N`; `&n + &1:real`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(vec 0:real^M,&n)` THEN + SIMP_TAC[BOUNDED_CBALL; SUBSET; IN_CBALL_0; IN_ELIM_THM]; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `x <= n ==> x <= n + &1`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_DERIVATIVE_WITHIN_SUBSET)) THEN SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Also negligibility of BV low-dimensional image. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL = prove + (`!f:real^1->real^N a b. + 2 <= dimindex(:N) /\ f has_bounded_variation_on interval[a,b] + ==> negligible(IMAGE f (interval[a,b]))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT)) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `l:real^1->real^N` THEN DISCH_TAC THEN + X_GEN_TAC `r:real^1->real^N` THEN DISCH_TAC THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `ee:real` THEN DISCH_TAC THEN + ABBREV_TAC + `e = min (&1) (ee / + (&2 pow (dimindex(:N)) * + vector_variation (interval[a,b]) (f:real^1->real^N) + &1))` THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [EXPAND_TAC "e" THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 < min (&1) x`) THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[VECTOR_VARIATION_POS_LE] THEN + MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!c. ?d. &0 < d /\ + (c IN interval[a,b] + ==> (!x. x IN interval[a,c] /\ ~(x = c) /\ dist(x,c) < d + ==> dist((f:real^1->real^N) x,l c) < e) /\ + (!x. x IN interval[c,b] /\ ~(x = c) /\ dist(x,c) < d + ==> dist(f x,r c) < e))` + MP_TAC THENL + [X_GEN_TAC `c:real^1` THEN ASM_CASES_TAC `(c:real^1) IN interval[a,b]` THENL + [ALL_TAC; EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `c:real^1`)) THEN + ASM_REWRITE_TAC[LIM_WITHIN; IMP_IMP; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[GSYM DIST_NZ] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_SIMP_TAC[REAL_LT_MIN]; + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real^1->real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN + MP_TAC(ISPECL [`\x:real^1. ball(x,d x)`; `a:real^1`; `b:real^1`] + FINE_DIVISION_EXISTS) THEN + ASM_REWRITE_TAC[fine; gauge; OPEN_BALL; CENTRE_IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN + `p:(real^1#(real^1->bool))->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TAGGED_DIVISION_OF_FINITE) THEN + EXISTS_TAC + `UNIONS(IMAGE (\(c,k). + (f c) INSERT + (cball((l:real^1->real^N) c, + min e (vector_variation (interval[interval_lowerbound k,c]) + (f:real^1->real^N))) UNION + cball((r:real^1->real^N) c, + min e (vector_variation (interval[c,interval_upperbound k]) + (f:real^1->real^N))))) p)` THEN + REPEAT CONJ_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP TAGGED_DIVISION_UNION_IMAGE_SND) THEN + REWRITE_TAC[IMAGE_UNIONS; GSYM IMAGE_o] THEN + MATCH_MP_TAC UNIONS_MONO_IMAGE THEN + REWRITE_TAC[FORALL_PAIR_THM; o_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^1. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; INTERVAL_NE_EMPTY_1; NOT_IN_EMPTY]; + ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `interval[u:real^1,v]`]) THEN + ASM_REWRITE_TAC[SUBSET; IN_INTERVAL_1; IN_CBALL] THEN DISCH_TAC THEN + REWRITE_TAC[IN_INSERT; IN_UNION] THEN ASM_CASES_TAC `x:real^1 = c` THEN + ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN + SIMP_TAC[IN_CBALL; REAL_LE_MIN] THEN ASM_CASES_TAC `drop x <= drop c` THENL + [DISJ1_TAC THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REMOVE_THEN "*" (MP_TAC o SPEC `c:real^1`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1) THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN + ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF]; + ALL_TAC] THEN + SUBGOAL_THEN `drop a <= drop u /\ drop x < drop c /\ + drop c <= drop v /\ drop v <= drop b` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN + ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF; + REAL_LE_TOTAL]; + ALL_TAC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist] THEN + MATCH_MP_TAC + (REWRITE_RULE[LIFT_DROP; FORALL_LIFT] + (ISPEC `at c within interval [u:real^1,c]` LIM_DROP_UBOUND)) THEN + EXISTS_TAC `\y:real^1. lift(norm(f x - f y:real^N))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIFT_DROP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN + ASM_SIMP_TAC[IN_INTERVAL_1; LIM_CONST] THEN + MATCH_MP_TAC LIM_WITHIN_SUBSET THEN + EXISTS_TAC `interval[a:real^1,c]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]; + W(MP_TAC o PART_MATCH (lhs o rand) LIMPT_OF_CONVEX o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[CONVEX_INTERVAL; ENDS_IN_INTERVAL; + INTERVAL_NE_EMPTY_1] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE + `(?y. ~(y = x) /\ y IN s) ==> ~(s = {x})`) THEN + EXISTS_TAC `u:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(CONJUNCT1(SPEC_ALL + (REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_INTERVAL))) THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]; + DISJ2_TAC THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REMOVE_THEN "*" (MP_TAC o SPEC `c:real^1`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; SUBSET]; ALL_TAC] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN + ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF; + REAL_LE_TOTAL]; + ALL_TAC] THEN + SUBGOAL_THEN `drop a <= drop c /\ drop c < drop x /\ + drop x <= drop v /\ drop v <= drop b` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_NOT_LE] THEN + ASM_MESON_TAC[IN_INTERVAL_1; SUBSET; TAGGED_DIVISION_OF; + REAL_LE_TOTAL]; + ALL_TAC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist] THEN + MATCH_MP_TAC + (REWRITE_RULE[LIFT_DROP; FORALL_LIFT] + (ISPEC `at c within interval [c:real^1,v]` LIM_DROP_UBOUND)) THEN + EXISTS_TAC `\y:real^1. lift(norm(f x - f y:real^N))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIFT_DROP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LIM_NORM THEN MATCH_MP_TAC LIM_SUB THEN + ASM_SIMP_TAC[IN_INTERVAL_1; LIM_CONST] THEN + MATCH_MP_TAC LIM_WITHIN_SUBSET THEN + EXISTS_TAC `interval[c:real^1,b]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]; + W(MP_TAC o PART_MATCH (lhs o rand) LIMPT_OF_CONVEX o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[CONVEX_INTERVAL; ENDS_IN_INTERVAL; + INTERVAL_NE_EMPTY_1] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(SET_RULE + `(?y. ~(y = x) /\ y IN s) ==> ~(s = {x})`) THEN + EXISTS_TAC `v:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1] THEN STRIP_TAC THEN + MATCH_MP_TAC VECTOR_VARIATION_GE_NORM_FUNCTION THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(CONJUNCT1(SPEC_ALL + (REWRITE_RULE[CONVEX_CONTAINS_SEGMENT] CONVEX_INTERVAL))) THEN + REWRITE_TAC[IN_INTERVAL_1] THEN ASM_REAL_ARITH_TAC]]]; + MATCH_MP_TAC MEASURABLE_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_UNION; MEASURABLE_INSERT]; + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o + lhand o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_PAIR_THM] THEN + SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_UNION; MEASURABLE_INSERT]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN + ONCE_REWRITE_TAC[LAMBDA_PAIR_THM] THEN REWRITE_TAC[MEASURE_INSERT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `&2 pow (dimindex(:N)) * + e * sum p (\(x:real^1,k). vector_variation k (f:real^1->real^N))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^1`; `k:real^1->bool`] THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^1. k = interval[u,v]` + (REPEAT_TCL CHOOSE_THEN SUBST_ALL_TAC) + THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + SUBGOAL_THEN `drop u <= drop v` ASSUME_TAC THENL + [ASM_MESON_TAC[TAGGED_DIVISION_OF; INTERVAL_NE_EMPTY_1; NOT_IN_EMPTY]; + ASM_SIMP_TAC[INTERVAL_LOWERBOUND_1; INTERVAL_UPPERBOUND_1]] THEN + SUBGOAL_THEN + `(f:real^1->real^N) has_bounded_variation_on interval[u,c] /\ + (f:real^1->real^N) has_bounded_variation_on interval[c,v]` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_SUBSET)) THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `interval[u:real^1,v]` THEN + (CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[TAGGED_DIVISION_OF]]) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM IN_INTERVAL_1] THEN ASM_MESON_TAC[TAGGED_DIVISION_OF]; + ALL_TAC] THEN + SUBGOAL_THEN + `vector_variation (interval [u,v]) (f:real^1->real^N) = + vector_variation (interval [u,c]) f + + vector_variation (interval [c,v]) f` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC VECTOR_VARIATION_COMBINE THEN + ASM_REWRITE_TAC[CONJ_ASSOC; GSYM IN_INTERVAL_1] THEN + CONJ_TAC THENL [ASM_MESON_TAC[TAGGED_DIVISION_OF]; ALL_TAC] THEN + ASM_MESON_TAC[TAGGED_DIVISION_OF; HAS_BOUNDED_VARIATION_ON_SUBSET]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNION_LE o lhand o snd) THEN + REWRITE_TAC[MEASURABLE_CBALL; REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) + MEASURE_CBALL_BOUND o lhand o snd) THEN + ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_POW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_POW_LE; REAL_POS] THEN + (SUBGOAL_THEN `dimindex(:N) = (dimindex(:N) - 1) + 1` SUBST1_TAC THENL + [ASM_ARITH_TAC; REWRITE_TAC[REAL_POW_ADD; REAL_POW_1]]) THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE; + REAL_POW_LE; REAL_ARITH `min e v <= v`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(e:real) pow (dimindex(:N) - 1)` THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_LE_MIN; REAL_LT_IMP_LE; VECTOR_VARIATION_POS_LE] THEN + REAL_ARITH_TAC; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_POW_1] THEN + MATCH_MP_TAC REAL_POW_MONO_INV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN EXPAND_TAC "e" THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_ARITH_TAC]]); + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `&2 pow dimindex (:N) * + (ee / (&2 pow (dimindex(:N)) * + vector_variation (interval[a,b]) (f:real^1->real^N) + &1)) * + sum p (\(x:real^1,k). vector_variation k f)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POS; REAL_POW_LE] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [EXPAND_TAC "e" THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + ASM_MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; TAGGED_DIVISION_OF; + VECTOR_VARIATION_POS_LE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `a * b / c * d:real = (b * a * d) / c`] THEN + W(MP_TAC o PART_MATCH (lhand o rand) REAL_LE_LDIV_EQ o snd) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; VECTOR_VARIATION_POS_LE; + REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= y + &1`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUM_OVER_TAGGED_DIVISION_LEMMA)) THEN DISCH_THEN(fun th -> + W(MP_TAC o PART_MATCH (lhs o rand) th o lhand o snd)) THEN + SIMP_TAC[VECTOR_VARIATION_ON_NULL; BOUNDED_INTERVAL] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC VECTOR_VARIATION_ON_DIVISION THEN + ASM_SIMP_TAC[DIVISION_OF_TAGGED_DIVISION]]]);; + +let NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE = prove + (`!g:real^1->real^N. + 2 <= dimindex(:N) /\ rectifiable_path g ==> negligible(path_image g)`, + REWRITE_TAC[rectifiable_path; path_image] THEN + SIMP_TAC[NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of Lebesgue measurable sets. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_IMP_LEBESGUE_MEASURABLE = prove + (`!s:real^N->bool. measurable s ==> lebesgue_measurable s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lebesgue_measurable] THEN + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + ASM_REWRITE_TAC[indicator; GSYM MEASURABLE_INTEGRABLE]);; + +let NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE = prove + (`!s:real^N->bool. negligible s ==> lebesgue_measurable s`, + SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; + +let LEBESGUE_MEASURABLE_EMPTY = prove + (`lebesgue_measurable {}`, + SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_EMPTY]);; + +let LEBESGUE_MEASURABLE_UNIV = prove + (`lebesgue_measurable (:real^N)`, + REWRITE_TAC[lebesgue_measurable; indicator; IN_UNIV; MEASURABLE_ON_CONST]);; + +let LEBESGUE_MEASURABLE_COMPACT = prove + (`!s:real^N->bool. compact s ==> lebesgue_measurable s`, + SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_COMPACT]);; + +let LEBESGUE_MEASURABLE_INTERVAL = prove + (`(!a b:real^N. lebesgue_measurable(interval[a,b])) /\ + (!a b:real^N. lebesgue_measurable(interval(a,b)))`, + SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; MEASURABLE_INTERVAL]);; + +let LEBESGUE_MEASURABLE_INTER = prove + (`!s t:real^N->bool. + lebesgue_measurable s /\ lebesgue_measurable t + ==> lebesgue_measurable(s INTER t)`, + REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_INTER]);; + +let LEBESGUE_MEASURABLE_UNION = prove + (`!s t:real^N->bool. + lebesgue_measurable s /\ lebesgue_measurable t + ==> lebesgue_measurable(s UNION t)`, + REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_UNION]);; + +let LEBESGUE_MEASURABLE_DIFF = prove + (`!s t:real^N->bool. + lebesgue_measurable s /\ lebesgue_measurable t + ==> lebesgue_measurable(s DIFF t)`, + REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_DIFF]);; + +let LEBESGUE_MEASURABLE_COMPL = prove + (`!s. lebesgue_measurable((:real^N) DIFF s) <=> lebesgue_measurable s`, + MESON_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_UNIV; + SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]);; + +let LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove + (`!s. lebesgue_measurable s <=> + !a b:real^N. lebesgue_measurable(s INTER interval[a,b])`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_INTER] THEN + REWRITE_TAC[lebesgue_measurable] THEN DISCH_TAC THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN + REWRITE_TAC[INTEGRABLE_CONST] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; indicator; IN_INTER] THEN MESON_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[indicator] THEN + COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop] THEN + REAL_ARITH_TAC]);; + +let LEBESGUE_MEASURABLE_CLOSED = prove + (`!s:real^N->bool. closed s ==> lebesgue_measurable s`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN + ASM_SIMP_TAC[CLOSED_INTER_COMPACT; LEBESGUE_MEASURABLE_COMPACT; + COMPACT_INTERVAL]);; + +let LEBESGUE_MEASURABLE_OPEN = prove + (`!s:real^N->bool. open s ==> lebesgue_measurable s`, + REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED]);; + +let LEBESGUE_MEASURABLE_UNIONS = prove + (`!f. FINITE f /\ (!s. s IN f ==> lebesgue_measurable s) + ==> lebesgue_measurable (UNIONS f)`, + REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_UNIONS]);; + +let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove + (`!f:(real^N->bool)->bool. + COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s) + ==> lebesgue_measurable (UNIONS f)`, + REWRITE_TAC[indicator; lebesgue_measurable; MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_COUNTABLE_UNIONS]);; + +let LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove + (`!s:num->real^N->bool. + (!n. lebesgue_measurable(s n)) + ==> lebesgue_measurable(UNIONS {s n | n IN (:num)})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV; NUM_COUNTABLE]);; + +let LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove + (`!f:(real^N->bool)->bool. + COUNTABLE f /\ (!s. s IN f ==> lebesgue_measurable s) + ==> lebesgue_measurable (INTERS f)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INTERS_UNIONS; LEBESGUE_MEASURABLE_COMPL] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; + LEBESGUE_MEASURABLE_COMPL]);; + +let LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove + (`!s:num->real^N->bool. + (!n. lebesgue_measurable(s n)) + ==> lebesgue_measurable(INTERS {s n | n IN (:num)})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; + NUM_COUNTABLE]);; + +let LEBESGUE_MEASURABLE_INTERS = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ (!s. s IN f ==> lebesgue_measurable s) + ==> lebesgue_measurable (INTERS f)`, + SIMP_TAC[LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);; + +let LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove + (`!s:real^N->bool. bounded s ==> (lebesgue_measurable s <=> measurable s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN + REWRITE_TAC[lebesgue_measurable; indicator; MEASURABLE_INTEGRABLE] THEN + SUBGOAL_THEN `?a b:real^N. s = s INTER interval[a,b]` + (REPEAT_TCL CHOOSE_THEN SUBST1_TAC) + THENL [REWRITE_TAC[SET_RULE `s = s INTER t <=> s SUBSET t`] THEN + ASM_MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL]; ALL_TAC] THEN + REWRITE_TAC[IN_INTER; MESON[] + `(if P x /\ Q x then a else b) = + (if Q x then if P x then a else b else b)`] THEN + REWRITE_TAC[MEASURABLE_ON_UNIV; INTEGRABLE_RESTRICT_UNIV] THEN + STRIP_TAC THEN MATCH_MP_TAC + MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST; NORM_REAL; DROP_VEC; GSYM drop] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN SIMP_TAC[DROP_VEC] THEN + REAL_ARITH_TAC);; + +let LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS = prove + (`!s:real^N->bool. + lebesgue_measurable s <=> + (!a b. measurable(s INTER interval[a,b]))`, + MESON_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS; + LEBESGUE_MEASURABLE_IFF_MEASURABLE; + BOUNDED_INTER; BOUNDED_INTERVAL]);; + +let LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS = prove + (`!s:real^N->bool. + lebesgue_measurable s <=> + (!n. measurable(s INTER interval[--vec n,vec n]))`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV + [LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS] THEN + EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a b:real^N. ?n. s INTER interval[a,b] = + ((s INTER interval[--vec n,vec n]) INTER interval[a,b])` + (fun th -> ASM_MESON_TAC[th; MEASURABLE_INTERVAL; MEASURABLE_INTER]) THEN + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`interval[a:real^N,b]`; `vec 0:real^N`] + BOUNDED_SUBSET_CBALL) THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `r:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `i SUBSET b ==> b SUBSET n ==> s INTER i = (s INTER n) INTER i`)) THEN + REWRITE_TAC[SUBSET; IN_CBALL_0; IN_INTERVAL; VEC_COMPONENT; + VECTOR_NEG_COMPONENT; GSYM REAL_ABS_BOUNDS] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);; + +let MEASURABLE_ON_MEASURABLE_SUBSET = prove + (`!f s t. s SUBSET t /\ f measurable_on t /\ measurable s + ==> f measurable_on s`, + MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; + MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; + +let MEASURABLE_ON_CASES = prove + (`!P f g:real^M->real^N s. + lebesgue_measurable {x | P x} /\ + f measurable_on s /\ g measurable_on s + ==> (\x. if P x then f x else g x) measurable_on s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x. (if x IN s then if P x then (f:real^M->real^N) x else g x else vec 0) = + (if x IN {x | P x} then if x IN s then f x else vec 0 else vec 0) + + (if x IN (:real^M) DIFF {x | P x} + then if x IN s then g x else vec 0 else vec 0)` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN + MESON_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID]; + MATCH_MP_TAC MEASURABLE_ON_ADD THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN + ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]]);; + +let LEBESGUE_MEASURABLE_JORDAN = prove + (`!s:real^N->bool. negligible(frontier s) ==> lebesgue_measurable s`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + MATCH_MP_TAC MEASURABLE_JORDAN THEN + SIMP_TAC[BOUNDED_INTER; BOUNDED_INTERVAL] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `frontier s UNION frontier(interval[a:real^N,b])` THEN + ASM_REWRITE_TAC[FRONTIER_INTER_SUBSET; NEGLIGIBLE_UNION_EQ] THEN + SIMP_TAC[NEGLIGIBLE_CONVEX_FRONTIER; CONVEX_INTERVAL]);; + +let LEBESGUE_MEASURABLE_CONVEX = prove + (`!s:real^N->bool. convex s ==> lebesgue_measurable s`, + SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN; NEGLIGIBLE_CONVEX_FRONTIER]);; + +(* ------------------------------------------------------------------------- *) +(* Invariance theorems for Lebesgue measurability. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_TRANSLATION = prove + (`!f:real^M->real^N s a. + f measurable_on (IMAGE (\x. a + x) s) + ==> (\x. f(a + x)) measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `IMAGE (\x:real^M. --a + x) k` THEN + EXISTS_TAC `\n. (g:num->real^M->real^N) n o (\x. a + x)` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + X_GEN_TAC `x:real^M` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN + REWRITE_TAC[o_DEF; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = --a + y <=> a + x = y`] THEN + REWRITE_TAC[UNWIND_THM1; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]);; + +let MEASURABLE_ON_TRANSLATION_EQ = prove + (`!f:real^M->real^N s a. + (\x. f(a + x)) measurable_on s <=> + f measurable_on (IMAGE (\x. a + x) s)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[MEASURABLE_ON_TRANSLATION] THEN + MP_TAC(ISPECL [`\x. (f:real^M->real^N) (a + x)`; + `IMAGE (\x:real^M. a + x) s`; `--a:real^M`] + MEASURABLE_ON_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; ETA_AX; IMAGE_ID; VECTOR_ARITH + `--a + a + x:real^N = x /\ a + --a + x = x`]);; + +let NEGLIGIBLE_LINEAR_IMAGE_GEN = prove + (`!f:real^M->real^N s. + linear f /\ negligible s /\ dimindex(:M) <= dimindex(:N) + ==> negligible (IMAGE f s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);; + +let MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN = prove + (`!f:real^M->real^N h:real^N->real^P s. + dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y) + ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`, + let lemma = prove + (`!f:real^N->real^P g:real^M->real^N h s. + dimindex(:M) = dimindex(:N) /\ + linear g /\ linear h /\ (!x. h(g x) = x) /\ (!x. g(h x) = x) + ==> (f o g) measurable_on s ==> f measurable_on (IMAGE g s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on] THEN + STRIP_TAC THEN DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` + (X_CHOOSE_THEN `G:num->real^M->real^P` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `IMAGE (g:real^M->real^N) k` THEN + EXISTS_TAC `\n x. (G:num->real^M->real^P) n ((h:real^N->real^M) x)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_GEN THEN + ASM_MESON_TAC[LE_REFL]; + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^N->real^M) y`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_REWRITE_TAC[o_THM] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; FUN_EQ_THM; o_THM; I_THM] THEN + X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN + SUBGOAL_THEN `!y:real^N. (f:real^M->real^N) ((g:real^N->real^M) y) = y` + ASSUME_TAC THENL + [SUBGOAL_THEN `IMAGE (f:real^M->real^N) UNIV = UNIV` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN]; + ALL_TAC] THEN + EQ_TAC THENL [ASM_MESON_TAC[lemma]; DISCH_TAC] THEN + MP_TAC(ISPECL [`(h:real^N->real^P) o (f:real^M->real^N)`; + `g:real^N->real^M`; `f:real^M->real^N`; + `IMAGE (f:real^M->real^N) s`] lemma) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; ETA_AX] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +let MEASURABLE_ON_LINEAR_IMAGE_EQ = prove + (`!f:real^N->real^N h:real^N->real^P s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((h o f) measurable_on s <=> h measurable_on (IMAGE f s))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN THEN + ASM_MESON_TAC[]);; + +let LEBESGUE_MEASURABLE_TRANSLATION = prove + (`!a:real^N s. + lebesgue_measurable (IMAGE (\x. a + x) s) <=> + lebesgue_measurable s`, + ONCE_REWRITE_TAC[LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN + SIMP_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE; + BOUNDED_INTER; BOUNDED_INTERVAL] THEN + GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [LEBESGUE_MEASURABLE_TRANSLATION];; + +let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (lebesgue_measurable (IMAGE f s) <=> + lebesgue_measurable s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE) THEN + REWRITE_TAC[lebesgue_measurable] THEN MP_TAC(ISPECL + [`g:real^N->real^N`; `indicator(s:real^N->bool)`; `(:real^N)`] + MEASURABLE_ON_LINEAR_IMAGE_EQ) THEN + ASM_REWRITE_TAC[indicator; o_DEF] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC EQ_IMP] THEN + BINOP_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; + AP_TERM_TAC THEN ASM SET_TAC[]]);; + +add_linear_invariants [LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Various common equivalent forms of function measurability. *) +(* ------------------------------------------------------------------------- *) + +let (MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT, + MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT) = (CONJ_PAIR o prove) + (`(!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | f(x)$k < a}) /\ + (!f:real^M->real^N. + f measurable_on (:real^M) <=> + ?g. (!n. (g n) measurable_on (:real^M)) /\ + (!n. FINITE(IMAGE (g n) (:real^M))) /\ + (!x. ((\n. g n x) --> f x) sequentially))`, + let lemma0 = prove + (`!f:real^M->real^1 n m. + integer m /\ + m / &2 pow n <= drop(f x) /\ + drop(f x) < (m + &1) / &2 pow n /\ + abs(m) <= &2 pow (2 * n) + ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} + (\k. k / &2 pow n % + indicator {y:real^M | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} + x) = + lift(m / &2 pow n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `vsum {m} (\k. k / &2 pow n % + indicator {y:real^M | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} + x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `k:real` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `F ==> p`) THEN + UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in + let lemma1 = prove + (`!f:real^M->real^1. + (!a b. lebesgue_measurable {x | a <= drop(f x) /\ drop(f x) < b}) + ==> ?g. (!n. (g n) measurable_on (:real^M)) /\ + (!n. FINITE(IMAGE (g n) (:real^M))) /\ + (!x. ((\n. g n x) --> f x) sequentially)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC + `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} + (\k. k / &2 pow n % + indicator {y:real^M | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} + x)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN + REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN + ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX]; + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n)) + {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_IMAGE] THEN + ASM_CASES_TAC + `?k. integer k /\ abs k <= &2 pow (2 * n) /\ + k / &2 pow n <= drop(f(x:real^M)) /\ + drop(f x) < (k + &1) / &2 pow n` + THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN + X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC lemma0 THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN + MATCH_MP_TAC VSUM_EQ_0 THEN + X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MP_TAC(ISPECL [`&2`; `abs(drop((f:real^M->real^1) x))`] + REAL_ARCH_POW) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + REWRITE_TAC[REAL_POW_INV] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN + SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN + EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^M)))` THEN + SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^M->real^1) x) < e` + MP_TAC THENL + [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ; + REAL_OF_NUM_EQ; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN + EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e * &2 pow N2` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC(NORM_ARITH + `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN + MATCH_MP_TAC lemma0 THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN + SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE; + INTEGER_CLOSED] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN + REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW; + REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> e <= d ==> x <= d`))] THEN + MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_ARITH_TAC]) in + MATCH_MP_TAC(MESON[] + `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f) + ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `g:real^M->real^N` THEN DISCH_TAC THEN + ABBREV_TAC `f:real^M->real^N = \x. --(g x)` THEN + SUBGOAL_THEN `(f:real^M->real^N) measurable_on (:real^M)` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN MATCH_MP_TAC MEASURABLE_ON_NEG THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM REAL_LT_NEG2] THEN X_GEN_TAC `a:real` THEN + SPEC_TAC(`--a:real`,`a:real`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + SIMP_TAC[GSYM VECTOR_NEG_COMPONENT] THEN DISCH_THEN(K ALL_TAC) THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o + GEN_REWRITE_RULE I [MEASURABLE_ON_COMPONENTWISE]) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(GEN `d:real` (ISPECL + [`\x. lift ((f:real^M->real^N) x$k)`; + `(\x. lift a + (lambda i. d)):real^M->real^1`; + `(:real^M)`] MEASURABLE_ON_MIN)) THEN + ASM_REWRITE_TAC[MEASURABLE_ON_CONST] THEN + DISCH_THEN(fun th -> + MP_TAC(GEN `n:num` (ISPEC `&n + &1` (MATCH_MP MEASURABLE_ON_CMUL + (MATCH_MP MEASURABLE_ON_SUB + (CONJ (SPEC `inv(&n + &1)` th) (SPEC `&0` th))))))) THEN + REWRITE_TAC[lebesgue_measurable; indicator] THEN + DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + MEASURABLE_ON_LIMIT)) THEN + EXISTS_TAC `{}:real^M->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; IN_UNIV; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_ELIM_THM] THEN + SIMP_TAC[LIM_SEQUENTIALLY; DIST_REAL; VECTOR_MUL_COMPONENT; + VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + LAMBDA_BETA; DIMINDEX_1; ARITH] THEN + REWRITE_TAC[GSYM drop; LIFT_DROP; REAL_ADD_RID] THEN + SIMP_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`; REAL_ARITH + `&0 < d ==> (min x (a + d) - min x a = + if x <= a then &0 else if x <= a + d then x - a else d)`] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `a < (f:real^M->real^N) x $k` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[REAL_ARITH `(x:real^N)$k <= a <=> ~(a < x$k)`] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; DROP_VEC; REAL_SUB_REFL; REAL_ABS_NUM] THEN + MP_TAC(SPEC `((f:real^M->real^N) x)$k - a` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `a + inv(&n + &1) < ((f:real^M->real^N) x)$k` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `N < f - a ==> n <= N ==> a + n < f`)) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `~(&n + &1 = &0)`] THEN + ASM_REAL_ARITH_TAC]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!k. 1 <= k /\ k <= dimindex(:N) + ==> ?g. (!n. (g n) measurable_on (:real^M)) /\ + (!n. FINITE(IMAGE (g n) (:real^M))) /\ + (!x. ((\n. g n x) --> lift((f x:real^N)$k)) sequentially)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma1 THEN + ASM_SIMP_TAC[LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN + ASM_SIMP_TAC[REAL_NOT_LE]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_EXISTS_THM]] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->num->real^M->real^1` MP_TAC) THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + EXISTS_TAC + `\n x. (lambda k. drop((g:num->num->real^M->real^1) k n x)):real^N` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]; + X_GEN_TAC `n:num` THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> lift(x$i) IN IMAGE (g i (n:num)) (:real^M)}` THEN + ASM_SIMP_TAC[GSYM IN_IMAGE_LIFT_DROP; SET_RULE `{x | x IN s} = s`; + FINITE_IMAGE; FINITE_CART] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + SIMP_TAC[IN_IMAGE; IN_UNIV; LAMBDA_BETA; DROP_EQ] THEN MESON_TAC[]; + X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; LIFT_DROP; ETA_AX]]; + X_GEN_TAC `f:real^M->real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN + MAP_EVERY EXISTS_TAC [`g:num->real^M->real^N`; `{}:real^M->bool`] THEN + ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY]]);; + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | f(x)$k >= a}`, + GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x >= a <=> ~(x < a)`] THEN + REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]);; + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | f(x)$k > a}`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN + GEN_REWRITE_TAC LAND_CONV + [MESON[REAL_NEG_NEG] `(!x. P x) <=> (!x:real. P(--x))`] THEN + REWRITE_TAC[real_gt; VECTOR_NEG_COMPONENT; REAL_LT_NEG2]);; + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | f(x)$k <= a}`, + GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x <= a <=> ~(x > a)`] THEN + REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]);; + +let (MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL, + MEASURABLE_ON_PREIMAGE_OPEN) = (CONJ_PAIR o prove) + (`(!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a b. lebesgue_measurable {x | f(x) IN interval(a,b)}) /\ + (!f:real^M->real^N. + f measurable_on (:real^M) <=> + !t. open t ==> lebesgue_measurable {x | f(x) IN t})`, + let ulemma = prove + (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + MATCH_MP_TAC(MESON[] + `(!f. P f ==> Q f) /\ (!f. Q f ==> R f) /\ (!f. R f ==> P f) + ==> (!f. P f <=> Q f) /\ (!f. P f <=> R f)`) THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{x | (f:real^M->real^N) x IN interval(a,b)} = + INTERS {{x | a$k < f(x)$k} | k IN 1..dimindex(:N)} INTER + INTERS {{x | (--b)$k < --(f(x))$k} | k IN 1..dimindex(:N)}` + SUBST1_TAC THENL + [REWRITE_TAC[IN_INTERVAL; GSYM IN_NUMSEG] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_LT_NEG2] THEN + REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN + CONJ_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN + SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]); + FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]] THEN + ASM_SIMP_TAC[real_gt]]; + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_OPEN_INTERVALS) THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM]; + REPEAT STRIP_TAC THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `{x:real^M | (f x)$k < a} = {x | f x IN {y:real^N | y$k < a}}`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]]);; + +let MEASURABLE_ON_PREIMAGE_CLOSED = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !t. closed t ==> lebesgue_measurable {x | f(x) IN t}`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL; closed] THEN + REWRITE_TAC[SET_RULE + `UNIV DIFF {x | f x IN t} = {x | f x IN (UNIV DIFF t)}`] THEN + REWRITE_TAC[MESON[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] + `(!s. P(UNIV DIFF s)) <=> (!s. P s)`] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);; + +let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a b. lebesgue_measurable {x | f(x) IN interval[a,b]}`, + let ulemma = prove + (`{x | f x IN UNIONS D} = UNIONS {{x | f(x) IN s} | s IN D}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED; CLOSED_INTERVAL]; DISCH_TAC] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_CLOSED_INTERVALS) THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ONCE_REWRITE_TAC[ulemma] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM]);; + +let LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove + (`!f:real^M->real^N t. + f measurable_on (:real^M) /\ open t + ==> lebesgue_measurable {x | f(x) IN t}`, + SIMP_TAC[MEASURABLE_ON_PREIMAGE_OPEN]);; + +let LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove + (`!f:real^M->real^N t. + f measurable_on (:real^M) /\ closed t + ==> lebesgue_measurable {x | f(x) IN t}`, + SIMP_TAC[MEASURABLE_ON_PREIMAGE_CLOSED]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_LE = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k <= (a:real^N)$k}`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `{x | !k. P k ==> f x$k <= a k} = + {x | f(x) IN {y | !k. P k ==> y$k <= a k}}`] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I + [MEASURABLE_ON_PREIMAGE_CLOSED]) THEN + REWRITE_TAC[CLOSED_INTERVAL_LEFT]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x | (f:real^M->real^N) x$k <= a} = + UNIONS + {{x | !j. 1 <= j /\ j <= dimindex(:N) ==> + f x$j <= ((lambda i. if i = k then a else &n):real^N)$j} | + n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN SIMP_TAC[LAMBDA_BETA] THEN + SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN GEN_TAC THEN + ASM_CASES_TAC `(y:real^N)$k <= a` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC + `sup {(y:real^N)$j | j IN 1..dimindex(:N)}` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[REAL_SUP_LE_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; + FORALL_IN_IMAGE]]]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_GE = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k >= (a:real^N)$k}`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_ORTHANT_LE] THEN + GEN_REWRITE_TAC LAND_CONV + [MESON[VECTOR_NEG_NEG] `(!x:real^N. P x) <=> (!x. P(--x))`] THEN + REWRITE_TAC[REAL_ARITH `--x <= --y <=> x >= y`; VECTOR_NEG_COMPONENT]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_LT = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k < (a:real^N)$k}`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `{x | !k. P k ==> f x$k < a k} = + {x | f(x) IN {y | !k. P k ==> y$k < a k}}`] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I + [MEASURABLE_ON_PREIMAGE_OPEN]) THEN + REWRITE_TAC[OPEN_INTERVAL_LEFT]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x | (f:real^M->real^N) x$k < a} = + UNIONS + {{x | !j. 1 <= j /\ j <= dimindex(:N) ==> + f x$j < ((lambda i. if i = k then a else &n):real^N)$j} | + n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN SIMP_TAC[LAMBDA_BETA] THEN + SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN GEN_TAC THEN + ASM_CASES_TAC `(y:real^N)$k < a` THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC + `&1 + sup {(y:real^N)$j | j IN 1..dimindex(:N)}` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[REAL_ARITH `&1 + x <= y <=> x <= y - &1`] THEN + SIMP_TAC[REAL_SUP_LE_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN + ASM_MESON_TAC[REAL_ARITH `x <= y - &1 ==> x < y`]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE; + FORALL_IN_IMAGE]]]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_GT = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) <=> + !a. lebesgue_measurable {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k > (a:real^N)$k}`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_ORTHANT_LT] THEN + GEN_REWRITE_TAC LAND_CONV + [MESON[VECTOR_NEG_NEG] `(!x:real^N. P x) <=> (!x. P(--x))`] THEN + REWRITE_TAC[REAL_ARITH `--x < --y <=> x > y`; VECTOR_NEG_COMPONENT]);; + +let MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING = prove + (`!f:real^N->real^1. + f measurable_on (:real^N) /\ (!x. &0 <= drop(f x)) <=> + ?g. (!n x. &0 <= drop(g n x) /\ drop(g n x) <= drop(f x)) /\ + (!n x. drop(g n x) <= drop(g(SUC n) x)) /\ + (!n. (g n) measurable_on (:real^N)) /\ + (!n. FINITE(IMAGE (g n) (:real^N))) /\ + (!x. ((\n. g n x) --> f x) sequentially)`, + let lemma = prove + (`!f:real^M->real^1 n m. + integer m /\ + m / &2 pow n <= drop(f x) /\ + drop(f x) < (m + &1) / &2 pow n /\ + abs(m) <= &2 pow (2 * n) + ==> vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} + (\k. k / &2 pow n % + indicator {y:real^M | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} + x) = + lift(m / &2 pow n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `vsum {m} (\k. k / &2 pow n % + indicator {y:real^M | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} + x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_REWRITE_TAC[SING_SUBSET; IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `k:real` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[indicator; IN_ELIM_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `F ==> p`) THEN + UNDISCH_TAC `~(k:real = m)` THEN ASM_SIMP_TAC[REAL_EQ_INTEGERS] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[VSUM_SING; indicator; IN_ELIM_THM; LIFT_EQ_CMUL]]) in + REPEAT STRIP_TAC THEN EQ_TAC THENL + [STRIP_TAC; + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL + [GEN_REWRITE_TAC RAND_CONV [MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; + MESON_TAC[REAL_LE_TRANS]]] THEN + SUBGOAL_THEN + `!a b. lebesgue_measurable {x:real^N | a <= drop(f x) /\ drop(f x) < b}` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | Q x} DIFF {x | ~P x}`] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN REWRITE_TAC[REAL_NOT_LE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]) THEN + SIMP_TAC[drop; FORALL_1; DIMINDEX_1]; + FIRST_X_ASSUM(K ALL_TAC o GEN_REWRITE_RULE I [measurable_on])] THEN + REWRITE_TAC[FORALL_AND_THM; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(MESON[] + `(!x. P x /\ R x ==> Q x) /\ (?x. P x /\ R x) + ==> (?x. P x /\ Q x /\ R x)`) THEN + CONJ_TAC THENL + [X_GEN_TAC `g:num->real^N->real^1` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^N`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY] o + SPEC `x:real^N`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `drop((g:num->real^N->real^1) n x - f x)`) THEN + ASM_REWRITE_TAC[DROP_SUB; REAL_SUB_LT; NOT_EXISTS_THM] THEN + X_GEN_TAC `N:num` THEN DISCH_THEN(MP_TAC o SPEC `N + n:num`) THEN + REWRITE_TAC[LE_ADD; DIST_REAL; GSYM drop] THEN + MATCH_MP_TAC(REAL_ARITH + `f < g /\ g <= g' ==> ~(abs(g' - f) < g - f)`) THEN + ASM_REWRITE_TAC[] THEN MP_TAC(ARITH_RULE `n:num <= N + n`) THEN + SPEC_TAC(`N + n:num`,`m:num`) THEN SPEC_TAC(`n:num`,`n:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC + `\n x. vsum {k | integer k /\ abs(k) <= &2 pow (2 * n)} + (\k. k / &2 pow n % + indicator {y:real^N | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} + x)` THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `!n. FINITE {k | integer k /\ abs k <= &2 pow (2 * n)}` + ASSUME_TAC THENL + [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[VSUM_REAL; LIFT_DROP; o_DEF] THEN + MATCH_MP_TAC SUM_POS_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `k:real` THEN STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN + ASM_CASES_TAC `&0 <= k` THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[DROP_INDICATOR_POS_LE]; + MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 <= x`) THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN REWRITE_TAC[indicator] THEN + COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN + MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN + REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN + ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; REAL_MUL_LZERO; INTEGER_CLOSED] THEN + ASM_REAL_ARITH_TAC]; + REPEAT GEN_TAC THEN SIMP_TAC[VSUM_REAL; LIFT_DROP; o_DEF; DROP_CMUL] THEN + TRANS_TAC REAL_LE_TRANS + `sum {k | integer k /\ abs(k) <= &2 pow (2 * n)} + (\k. k / &2 pow n * + (drop(indicator {y:real^N | k / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1 / &2) / &2 pow n} x) + + drop(indicator {y:real^N | (k + &1 / &2) / &2 pow n <= drop(f y) /\ + drop(f y) < (k + &1) / &2 pow n} x)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + X_GEN_TAC `k:real` THEN STRIP_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[indicator; IN_ELIM_THM] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[DROP_VEC]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `x / y = (&2 * x) * inv(&2) * inv(y)`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow); + REAL_ARITH `&2 * (k + &1 / &2) = &2 * k + &1`; + REAL_ARITH `&2 * (k + &1) = (&2 * k + &1) + &1`] THEN + ASM_SIMP_TAC[REAL_ADD_LDISTRIB; SUM_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `!g. sum s f <= sum s g /\ a + sum s g <= b ==> a + sum s f <= b`) THEN + EXISTS_TAC + `\k. (&2 * k + &1) / &2 pow SUC n * + drop + (indicator + {y | (&2 * k + &1) / &2 pow SUC n <= drop ((f:real^N->real^1) y) /\ + drop (f y) < ((&2 * k + &1) + &1) / &2 pow SUC n} x)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[DROP_INDICATOR_POS_LE; REAL_LE_DIV2_EQ; REAL_LT_POW2] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `\x. &2 * x` SUM_IMAGE) THEN + MP_TAC(ISPEC `\x. &2 * x + &1` SUM_IMAGE) THEN + REWRITE_TAC[REAL_EQ_ADD_RCANCEL; REAL_EQ_MUL_LCANCEL] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; ARITH; IMP_CONJ; o_DEF] THEN + REPEAT(DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th])) THEN + W(MP_TAC o PART_MATCH (rand o rand) SUM_UNION o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; SET_RULE + `DISJOINT (IMAGE f s) (IMAGE g s) <=> + !x. x IN s ==> !y. y IN s ==> ~(f x = g y)`] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `i:real` THEN STRIP_TAC THEN + X_GEN_TAC `j:real` THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `&2 * x = &2 * y + &1 ==> &2 * abs(x - y) = &1`)) THEN + SUBGOAL_THEN `integer(i - j)` MP_TAC THENL + [ASM_SIMP_TAC[INTEGER_CLOSED]; REWRITE_TAC[integer]] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; ARITH]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC SUM_SUBSET THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE] THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> x IN u) /\ (!x. x IN t ==> x IN u) + ==> !x. x IN (s UNION t) DIFF u ==> P x`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + SIMP_TAC[INTEGER_CLOSED; ARITH_RULE `2 * SUC n = 2 + 2 * n`] THEN + REWRITE_TAC[REAL_POW_ADD] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= n /\ &1 <= n ==> abs(&2 * x + &1) <= &2 pow 2 * n`) THEN + ASM_REWRITE_TAC[REAL_LE_POW2]; + X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN + STRIP_TAC THEN REWRITE_TAC[DROP_CMUL] THEN + ASM_CASES_TAC `&0 <= k` THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[DROP_INDICATOR_POS_LE]; + MATCH_MP_TAC(REAL_ARITH `x = &0 ==> &0 <= x`) THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + REWRITE_TAC[indicator] THEN + COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN + MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN + REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&0` THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_POW2] THEN + ASM_SIMP_TAC[GSYM REAL_LT_INTEGERS; REAL_MUL_LZERO; + INTEGER_CLOSED] THEN + ASM_REAL_ARITH_TAC]]; + X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_VSUM THEN + REWRITE_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN + ASM_REWRITE_TAC[GSYM lebesgue_measurable; ETA_AX]; + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\k. lift(k / &2 pow n)) + {k | integer k /\ abs(k) <= &2 pow (2 * n)}` THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_ABS_BOUNDS; FINITE_INTSEG; FINITE_IMAGE]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_IMAGE] THEN + ASM_CASES_TAC + `?k. integer k /\ abs k <= &2 pow (2 * n) /\ + k / &2 pow n <= drop(f(x:real^N)) /\ + drop(f x) < (k + &1) / &2 pow n` + THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS) THEN + X_GEN_TAC `m:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC lemma THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; INTEGER_CLOSED; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_POW_LE; REAL_POS; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[LIFT_NUM; GSYM real_div] THEN + MATCH_MP_TAC VSUM_EQ_0 THEN + X_GEN_TAC `k:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ2_TAC THEN + REWRITE_TAC[indicator; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MP_TAC(ISPECL [`&2`; `abs(drop((f:real^N->real^1) x))`] + REAL_ARCH_POW) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; DISCH_THEN(X_CHOOSE_TAC `N1:num`)] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + REWRITE_TAC[REAL_POW_INV] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` MP_TAC) THEN + SUBST1_TAC(REAL_ARITH `inv(&2 pow N2) = &1 / &2 pow N2`) THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN DISCH_TAC THEN + EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ABBREV_TAC `m = floor(&2 pow n * drop(f(x:real^N)))` THEN + SUBGOAL_THEN `dist(lift(m / &2 pow n),(f:real^N->real^1) x) < e` + MP_TAC THENL + [REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `abs(&2 pow n)` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_SUB_LDISTRIB] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_POW_EQ_0; GSYM REAL_ABS_NZ; + REAL_OF_NUM_EQ; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= y /\ y < x + &1 /\ &1 <= z ==> abs(x - y) < z`) THEN + EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e * &2 pow N2` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC(NORM_ARITH + `x:real^1 = y ==> dist(y,z) < e ==> dist(x,z) < e`) THEN + MATCH_MP_TAC lemma THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + EXPAND_TAC "m" THEN REWRITE_TAC[FLOOR] THEN + SIMP_TAC[REAL_ABS_BOUNDS; REAL_LE_FLOOR; REAL_FLOOR_LE; + INTEGER_CLOSED] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> --e <= x /\ x - &1 < e`) THEN + REWRITE_TAC[MULT_2; REAL_POW_ADD; REAL_ABS_MUL; REAL_ABS_POW; + REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_POW_LE; REAL_POS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> e <= d ==> x <= d`))] THEN + MATCH_MP_TAC REAL_POW_MONO THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* More connections with measure where Lebesgue measurability is useful. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_LEGESGUE_MEASURABLE_SUBSET = prove + (`!s t:real^N->bool. + lebesgue_measurable s /\ measurable t /\ s SUBSET t + ==> measurable s`, + REWRITE_TAC[lebesgue_measurable; MEASURABLE_INTEGRABLE] THEN + REWRITE_TAC[indicator] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. if x IN t then vec 1 else vec 0):real^N->real^1` THEN + ASM_REWRITE_TAC[IN_UNIV] THEN GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[DROP_VEC; NORM_REAL; GSYM drop]) THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_LE_REFL; REAL_POS] THEN ASM SET_TAC[]);; + +let MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE = prove + (`!s t:real^N->bool. + lebesgue_measurable s /\ measurable t ==> measurable(s INTER t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_INTER; MEASURABLE_IMP_LEBESGUE_MEASURABLE; + INTER_SUBSET]);; + +let MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE = prove + (`!s t:real^N->bool. + measurable s /\ lebesgue_measurable t ==> measurable(s INTER t)`, + MESON_TAC[INTER_COMM; MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE]);; + +let MEASURABLE_INTER_HALFSPACE_LE = prove + (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i <= a})`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE THEN + ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_LE; LEBESGUE_MEASURABLE_CLOSED]);; + +let MEASURABLE_INTER_HALFSPACE_GE = prove + (`!s a i. measurable s ==> measurable(s INTER {x:real^N | x$i >= a})`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE THEN + ASM_SIMP_TAC[CLOSED_HALFSPACE_COMPONENT_GE; LEBESGUE_MEASURABLE_CLOSED]);; + +let MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE = prove + (`!s t. measurable s /\ lebesgue_measurable t ==> measurable(s DIFF t)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + ASM_SIMP_TAC[MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE; + LEBESGUE_MEASURABLE_COMPL]);; + +(* ------------------------------------------------------------------------- *) +(* Negigibility of set with uncountably many disjoint translates. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_DISJOINT_TRANSLATES = prove + (`!s:real^N->bool k z. + lebesgue_measurable s /\ z limit_point_of k /\ + pairwise (\a b. DISJOINT (IMAGE (\x. a + x) s) (IMAGE (\x. b + x) s)) k + ==> negligible s`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + ABBREV_TAC `t = s INTER interval[a:real^N,b]` THEN + SUBGOAL_THEN `measurable(t:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; + MEASURABLE_INTERVAL; INTER_COMM]; + ALL_TAC] THEN + SUBGOAL_THEN `bounded(t:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[BOUNDED_INTER; BOUNDED_INTERVAL]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_EQ_0] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN + ASM_SIMP_TAC[MEASURE_POS_LE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&1` o + GEN_REWRITE_RULE I [LIMPT_INFINITE_CBALL]) THEN + REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o + SPEC `measure(IMAGE (\x:real^N. z + x) (interval[a - vec 1,b + vec 1]))` o + MATCH_MP REAL_ARCH) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + MP_TAC(ISPECL [`n:num`; `k INTER cball(z:real^N,&1)`] + CHOOSE_SUBSET_STRONG) THEN + ANTS_TAC THENL [ASM_MESON_TAC[INFINITE]; ALL_TAC] THEN + REWRITE_TAC[SUBSET_INTER; LEFT_IMP_EXISTS_THM; REAL_NOT_LT] THEN + X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN + TRANS_TAC REAL_LE_TRANS + `measure(UNIONS(IMAGE (\a. IMAGE (\x:real^N. a + x) t) u))` THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + SUBGOAL_THEN + `UNIONS(IMAGE (\a. IMAGE (\x:real^N. a + x) t) u) has_measure + &n * measure(t:real^N->bool)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\a. IMAGE (\x:real^N. a + x) t`; `u:real^N->bool`] + HAS_MEASURE_DISJOINT_UNIONS_IMAGE) THEN + ASM_SIMP_TAC[MEASURABLE_TRANSLATION_EQ; MEASURE_TRANSLATION; + SUM_CONST] THEN + DISCH_THEN MATCH_MP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM SET_TAC[]; + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN STRIP_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_LE_REFL]; MATCH_MP_TAC MEASURE_SUBSET] THEN + ASM_REWRITE_TAC[MEASURABLE_TRANSLATION_EQ; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; + RIGHT_FORALL_IMP_THM] THEN + X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE; UNWIND_THM1; VECTOR_ARITH + `d + e:real^N = z + y <=> e + d - z = y`] THEN + SUBGOAL_THEN `x IN interval[a:real^N,b]` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[IN_INTERVAL]] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN + REWRITE_TAC[VEC_COMPONENT] THEN MATCH_MP_TAC(REAL_ARITH + `abs(d) <= &1 + ==> a <= x /\ x <= b ==> a - &1 <= x + d /\ x + d <= b + &1`) THEN + SUBGOAL_THEN `e IN cball(z:real^N,&1)` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[IN_CBALL]] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM]);; + +(* ------------------------------------------------------------------------- *) +(* Sometimes convenient to restrict the sets in "preimage" characterization *) +(* of measurable functions to choose points from a dense set. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE = prove + (`!f:real^M->real^N r. + closure (IMAGE lift r) = (:real^1) + ==> (f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r + ==> lebesgue_measurable {x | f(x)$k <= a})`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real`; `k:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!n. ?x. x IN r /\ a < x /\ x < a + inv(&n + &1)` + MP_TAC THENL + [GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[IN_UNIV; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPECL + [`lift(a + inv(&n + &1) / &2)`; `inv(&n + &1) / &2`]) THEN + REWRITE_TAC[REAL_HALF; DIST_LIFT; REAL_LT_INV_EQ] THEN + ANTS_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + SIMP_TAC[] THEN REAL_ARITH_TAC; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `t:num->real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | (f:real^M->real^N) x$k <= a} = + INTERS {{x | (f x)$k <= t n} | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN EQ_TAC THENL + [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `i < f - a ==> !j. j <= i /\ a < t /\ t < a + j ==> &0 < f - t`)) THEN + EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE = prove + (`!f:real^M->real^N r. + closure (IMAGE lift r) = (:real^1) + ==> (f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r + ==> lebesgue_measurable {x | f(x)$k >= a})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN + MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) r:real->bool`] + MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_NEG] THEN + ASM_REWRITE_TAC[GSYM o_DEF; IMAGE_o; CLOSURE_NEGATIONS] THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + MESON_TAC[VECTOR_NEG_NEG]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= --y <=> x >= y`]]);; + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE = prove + (`!f:real^M->real^N r. + closure (IMAGE lift r) = (:real^1) + ==> (f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r + ==> lebesgue_measurable {x | f(x)$k < a})`, + GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`] THEN + REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN + SIMP_TAC[GSYM MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE]);; + +let MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE = prove + (`!f:real^M->real^N r. + closure (IMAGE lift r) = (:real^1) + ==> (f measurable_on (:real^M) <=> + !a k. 1 <= k /\ k <= dimindex(:N) /\ a IN r + ==> lebesgue_measurable {x | f(x)$k > a})`, + GEN_TAC THEN REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`] THEN + REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL] THEN + SIMP_TAC[GSYM MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE]);; + +let MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE = prove + (`!f:real^M->real^N t. + closure t = (:real^N) + ==> (f measurable_on (:real^M) <=> + !a b. a IN t /\ b IN t + ==> lebesgue_measurable {x | f(x) IN interval[a,b]})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + SUBGOAL_THEN + `!n. ?u v:real^N. + (u IN t /\ u IN interval[(a - lambda i. inv(&n + &1)),a]) /\ + (v IN t /\ v IN interval[b,(b + lambda i. inv(&n + &1))])` + MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `~(interior s INTER t = {}) /\ interior s SUBSET s + ==> ?x. x IN t /\ x IN s`) THEN + REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN + W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o + rand o snd) THEN + REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `a - i < a <=> &0 < i`; + REAL_ARITH `b < b + i <=> &0 < i`] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `{x | (f:real^M->real^N) x IN interval[a,b]} = + INTERS {{x | f x IN interval[u n,v n]} | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[IN_INTERVAL] THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN + REWRITE_TAC[DE_MORGAN_THM; EXISTS_OR_THM; REAL_NOT_LE] THEN + MATCH_MP_TAC MONO_OR THEN CONJ_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `!a i j. i < a - f /\ j <= i /\ a - j <= t /\ t <= a + ==> &0 < t - f`) THEN EXISTS_TAC `(a:real^N)$k`; + MATCH_MP_TAC(REAL_ARITH + `!a i j. i < f - a /\ j <= i /\ a <= t /\ t <= a + j + ==> &0 < f - t`) THEN EXISTS_TAC `(b:real^N)$k`] THEN + MAP_EVERY EXISTS_TAC [`inv(&n)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; + +let MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE = prove + (`!f:real^M->real^N t. + closure t = (:real^N) + ==> (f measurable_on (:real^M) <=> + !a b. a IN t /\ b IN t + ==> lebesgue_measurable {x | f(x) IN interval(a,b)})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + SUBGOAL_THEN + `!n. ?u v:real^N. + (u IN t /\ u IN interval[a,(a + lambda i. inv(&n + &1))]) /\ + (v IN t /\ v IN interval[(b - lambda i. inv(&n + &1)),b])` + MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THEN MATCH_MP_TAC(SET_RULE + `~(interior s INTER t = {}) /\ interior s SUBSET s + ==> ?x. x IN t /\ x IN s`) THEN + REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN + W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o + rand o snd) THEN + REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `a - i < a <=> &0 < i`; + REAL_ARITH `b < b + i <=> &0 < i`] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:num->real^N`; `v:num->real^N`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `{x | (f:real^M->real^N) x IN interval(a,b)} = + UNIONS {{x | f x IN interval(u n,v n)} | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN + EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]] THEN + SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `&0 < inf { min ((y - a:real^N)$i) ((b - y:real^N)$i) | + i IN 1..dimindex(:N)}` + MP_TAC THENL + [SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; REAL_SUB_LT; + VECTOR_SUB_COMPONENT; IN_NUMSEG]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `k:num`])) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL + [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE = prove + (`!f:real^M->real^N t. + closure t = (:real^N) + ==> (f measurable_on (:real^M) <=> + !a. a IN t + ==> lebesgue_measurable + {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k <= (a:real^N)$k})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_ORTHANT_LE] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN + SUBGOAL_THEN + `!n. ?u:real^N. + u IN t /\ u IN interval[a,(a + lambda i. inv(&n + &1))]` + MP_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `~(interior s INTER t = {}) /\ interior s SUBSET s + ==> ?x. x IN t /\ x IN s`) THEN + REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN + W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o + rand o snd) THEN + REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `b < b + i <=> &0 < i`] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `u:num->real^N` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `{x | !i. 1 <= i /\ i <= dimindex(:N) + ==> (f:real^M->real^N) x$i <= (a:real^N)$i} = + INTERS {{x | !i. 1 <= i /\ i <= dimindex(:N) + ==> (f:real^M->real^N) x$i <= (u n:real^N)$i} | + n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL [ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `!a i j. i < f - a /\ j <= i /\ a <= t /\ t <= a + j + ==> &0 < f - t`) THEN EXISTS_TAC `(a:real^N)$k` THEN + MAP_EVERY EXISTS_TAC [`inv(&n)`; `inv(&n + &1)`] THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE = prove + (`!f:real^M->real^N t. + closure t = (:real^N) + ==> (f measurable_on (:real^M) <=> + !a. a IN t + ==> lebesgue_measurable + {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k >= (a:real^N)$k})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN + MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) t:real^N->bool`] + MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE) THEN + ASM_REWRITE_TAC[CLOSURE_NEGATIONS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x <= --y <=> x >= y`] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE = prove + (`!f:real^M->real^N t. + closure t = (:real^N) + ==> (f measurable_on (:real^M) <=> + !a. a IN t + ==> lebesgue_measurable + {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k < (a:real^N)$k})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_PREIMAGE_ORTHANT_LT] THEN + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN X_GEN_TAC `a:real^N` THEN + SUBGOAL_THEN + `!n. ?u:real^N. + u IN t /\ u IN interval[(a - lambda i. inv(&n + &1)):real^N,a]` + MP_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `~(interior s INTER t = {}) /\ interior s SUBSET s + ==> ?x. x IN t /\ x IN s`) THEN + REWRITE_TAC[INTERIOR_INTERVAL; INTERVAL_OPEN_SUBSET_CLOSED] THEN + W(MP_TAC o PART_MATCH (rand o rand) OPEN_INTER_CLOSURE_EQ_EMPTY o + rand o snd) THEN + REWRITE_TAC[OPEN_INTERVAL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[INTER_UNIV; INTERVAL_NE_EMPTY] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `b - i < b <=> &0 < i`] THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `u:num->real^N` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [IN_INTERVAL] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; LAMBDA_BETA]] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `{x | !i. 1 <= i /\ i <= dimindex(:N) + ==> (f:real^M->real^N) x$i < (a:real^N)$i} = + UNIONS {{x | !i. 1 <= i /\ i <= dimindex(:N) + ==> (f:real^M->real^N) x$i < (u n:real^N)$i} | + n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INTERVAL] THEN + EQ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LET_TRANS; REAL_LTE_TRANS]] THEN + SPEC_TAC(`(f:real^M->real^N) x`,`y:real^N`) THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `&0 < inf { (a - y:real^N)$i | i IN 1..dimindex(:N)}` + MP_TAC THENL + [SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; REAL_LT_MIN; REAL_SUB_LT; + VECTOR_SUB_COMPONENT; IN_NUMSEG]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + SIMP_TAC[REAL_LT_INF_FINITE; SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `k:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `k:num`])) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL + [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + SIMP_TAC[COUNTABLE_IMAGE; NUM_COUNTABLE; SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]]);; + +let MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE = prove + (`!f:real^M->real^N t. + closure t = (:real^N) + ==> (f measurable_on (:real^M) <=> + !a. a IN t + ==> lebesgue_measurable + {x | !k. 1 <= k /\ k <= dimindex(:N) + ==> f(x)$k > (a:real^N)$k})`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEASURABLE_ON_NEG_EQ] THEN + MP_TAC(ISPECL [`(\x. --f x):real^M->real^N`; `IMAGE (--) t:real^N->bool`] + MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE) THEN + ASM_REWRITE_TAC[CLOSURE_NEGATIONS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_ARITH `--x < --y <=> x > y`] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_UNIV] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Localized variants of function measurability equivalents. *) +(* ------------------------------------------------------------------------- *) + +let [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; + MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL] = + (CONJUNCTS o prove) + (`(!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !t. closed t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !a b. lebesgue_measurable {x | x IN s /\ f x IN interval[a,b]})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !t. open t ==> lebesgue_measurable {x | x IN s /\ f x IN t})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | x IN s /\ (f x)$k >= a})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | x IN s /\ (f x)$k > a})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | x IN s /\ (f x)$k <= a})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable {x | x IN s /\ (f x)$k < a})) /\ + (!f:real^M->real^N s. + lebesgue_measurable s + ==> (f measurable_on s <=> + !a b. lebesgue_measurable {x | x IN s /\ f x IN interval(a,b)}))`, + let lemma = prove + (`!f s P. {x | P(if x IN s then f x else vec 0)} = + if P(vec 0) then s INTER {x | P(f x)} UNION ((:real^M) DIFF s) + else {x | x IN s /\ P(f x)}`, + REPEAT GEN_TAC THEN + COND_CASES_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN SET_TAC[]) in + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REPEAT STRIP_TAC THENL + [REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT]; + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL]] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] lemma) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + TRY(MATCH_MP_TAC(TAUT `(q <=> q') ==> (p ==> q <=> p ==> q')`)) THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + EQ_TAC THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_UNION; LEBESGUE_MEASURABLE_COMPL] THEN + UNDISCH_TAC `lebesgue_measurable(s:real^M->bool)` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ lebesgue_measurable s /\ open t + ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, + MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);; + +let LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ lebesgue_measurable s /\ closed t + ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, + MESON_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);; + +let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ = prove + (`!f:real^M->real^N s. + f measurable_on s /\ lebesgue_measurable s <=> + !t. open t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN + REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN + SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]);; + +let MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ = prove + (`!f:real^M->real^N s. + f measurable_on s /\ lebesgue_measurable s <=> + !t. closed t ==> lebesgue_measurable {x | x IN s /\ f(x) IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN + REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN + SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]);; + +let [MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED; + MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; + MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN; + MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; + MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; + MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; + MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; + MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL] = + (CONJUNCTS o prove) + (`(!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !t. closed t ==> measurable {x | x IN s /\ f x IN t})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !a b. measurable {x | x IN s /\ f x IN interval[a,b]})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !t. open t ==> measurable {x | x IN s /\ f x IN t})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> measurable {x | x IN s /\ (f x)$k >= a})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> measurable {x | x IN s /\ (f x)$k > a})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> measurable {x | x IN s /\ (f x)$k <= a})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !a k. 1 <= k /\ k <= dimindex(:N) + ==> measurable {x | x IN s /\ (f x)$k < a})) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !a b. measurable {x | x IN s /\ f x IN interval(a,b)}))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP MEASURABLE_IMP_LEBESGUE_MEASURABLE) THENL + [ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED]; + ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL]; + ASM_SIMP_TAC[MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN]; + ASM_SIMP_TAC + [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE]; + ASM_SIMP_TAC + [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT]; + ASM_SIMP_TAC + [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE]; + ASM_SIMP_TAC + [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT]; + ASM_SIMP_TAC + [MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL]] THEN + EQ_TAC THEN SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_SIMP_TAC[] THEN SET_TAC[]);; + +let MEASURABLE_MEASURABLE_PREIMAGE_OPEN = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ measurable s /\ open t + ==> measurable {x | x IN s /\ f(x) IN t}`, + MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);; + +let MEASURABLE_MEASURABLE_PREIMAGE_CLOSED = prove + (`!f:real^M->real^N s t. + f measurable_on s /\ measurable s /\ closed t + ==> measurable {x | x IN s /\ f(x) IN t}`, + MESON_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);; + +let MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ = prove + (`!f:real^M->real^N s. + f measurable_on s /\ measurable s <=> + !t. open t ==> measurable {x | x IN s /\ f(x) IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_OPEN] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN + REWRITE_TAC[OPEN_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN + SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN]);; + +let MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ = prove + (`!f:real^M->real^N s. + f measurable_on s /\ measurable s <=> + !t. closed t ==> measurable {x | x IN s /\ f(x) IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[MEASURABLE_MEASURABLE_PREIMAGE_CLOSED] THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(SPEC `(:real^N)` th)) THEN + REWRITE_TAC[CLOSED_UNIV; SET_RULE `{x | x IN s /\ f x IN UNIV} = s`] THEN + SIMP_TAC[MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Regularity properties and Steinhaus, this time for Lebesgue measure. *) +(* ------------------------------------------------------------------------- *) + +let LEBESGUE_MEASURABLE_OUTER_OPEN = prove + (`!s:real^N->bool e. + lebesgue_measurable s /\ &0 < e + ==> ?t. open t /\ + s SUBSET t /\ + measurable(t DIFF s) /\ + measure(t DIFF s) < e`, + REPEAT STRIP_TAC THEN MP_TAC(GEN `n:num` + (ISPECL [`s INTER ball(vec 0:real^N,&2 pow n)`; + `e / &4 / &2 pow n`] + MEASURABLE_OUTER_OPEN)) THEN + ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; REAL_LT_DIV; + MEASURABLE_BALL; REAL_LT_INV_EQ; REAL_LT_POW2; + REAL_ARITH `&0 < e / &4 <=> &0 < e`] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `t:num->real^N->bool` THEN STRIP_TAC THEN + EXISTS_TAC `UNIONS(IMAGE t (:num)):real^N->bool` THEN + ASM_SIMP_TAC[OPEN_UNIONS; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPEC `norm(x:real^N)` REAL_ARCH_POW2) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_BALL_0; IN_INTER]; + REWRITE_TAC[UNIONS_DIFF; SET_RULE + `{f x | x IN IMAGE g s} = {f(g(x)) | x IN s}`] THEN + MATCH_MP_TAC(MESON[REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`] + `&0 < e /\ P /\ x <= e / &2 ==> P /\ x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN + ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE] THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(t i DIFF (s INTER ball(vec 0:real^N,&2 pow i)))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE; + MEASURABLE_INTER; MEASURABLE_BALL; LEBESGUE_MEASURABLE_INTER; + MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN + SET_TAC[]; + ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_DIFF; MEASURABLE_BALL; + MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN + ASM_SIMP_TAC[REAL_ARITH `t < s + e ==> t - s <= e`]]; + REWRITE_TAC[real_div; SUM_LMUL; REAL_INV_POW; SUM_GP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 LT] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN + REWRITE_TAC[REAL_ARITH + `&1 / &4 * (&1 - x) * &2 <= &1 / &2 <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV]]);; + +let LEBESGUE_MEASURABLE_INNER_CLOSED = prove + (`!s:real^N->bool e. + lebesgue_measurable s /\ &0 < e + ==> ?t. closed t /\ + t SUBSET s /\ + measurable(s DIFF t) /\ + measure(s DIFF t) < e`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM LEBESGUE_MEASURABLE_COMPL] THEN + DISCH_THEN(X_CHOOSE_TAC `t:real^N->bool` o MATCH_MP + LEBESGUE_MEASURABLE_OUTER_OPEN) THEN + EXISTS_TAC `(:real^N) DIFF t` THEN POP_ASSUM MP_TAC THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN + REWRITE_TAC[GSYM OPEN_CLOSED] THENL + [SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC] THEN + SET_TAC[]);; + +let STEINHAUS_LEBESGUE = prove + (`!s:real^N->bool. + lebesgue_measurable s /\ ~negligible s + ==> ?d. &0 < d /\ ball(vec 0,d) SUBSET {x - y | x IN s /\ y IN s}`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + MP_TAC(ISPEC `s INTER interval[a:real^N,b]` STEINHAUS) THEN + ASM_SIMP_TAC[GSYM MEASURABLE_MEASURE_POS_LT; MEASURABLE_INTERVAL; + MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN + SET_TAC[]);; + +let LEBESGUE_MEASURABLE_REGULAR_OUTER = prove + (`!s:real^N->bool. + lebesgue_measurable s + ==> ?k c. negligible k /\ (!n. open(c n)) /\ + s = INTERS {c n | n IN (:num)} DIFF k`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + LEBESGUE_MEASURABLE_OUTER_OPEN)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN + REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN + EXISTS_TAC `INTERS {c n | n IN (:num)} DIFF s:real^N->bool` THEN + EXISTS_TAC `c:num->real^N->bool` THEN + ASM_REWRITE_TAC[SET_RULE `s = t DIFF (t DIFF s) <=> s SUBSET t`] THEN + ASM_REWRITE_TAC[SUBSET_INTERS; FORALL_IN_GSPEC] THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `(c:num->real^N->bool) n DIFF s` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]);; + +let LEBESGUE_MEASURABLE_REGULAR_INNER = prove + (`!s:real^N->bool. + lebesgue_measurable s + ==> ?k c. negligible k /\ (!n. compact(c n)) /\ + s = UNIONS {c n | n IN (:num)} UNION k`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN + REWRITE_TAC[REAL_LT_POW2; SKOLEM_THM; REAL_LT_INV_EQ] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `c:num->real^N->bool` THEN STRIP_TAC THEN + EXISTS_TAC `s DIFF UNIONS {c n | n IN (:num)}:real^N->bool` THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `s DIFF (c:num->real^N->bool) n` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SET_TAC[]; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TRANS]]; + SUBGOAL_THEN + `?d. (!n. compact(d n:real^N->bool)) /\ + UNIONS {d n | n IN (:num)} = UNIONS {c n | n IN (:num)}` + MP_TAC THENL + [MP_TAC(GEN `n:num` (ISPEC + `(c:num->real^N->bool) n` CLOSED_UNION_COMPACT_SUBSETS)) THEN + ASM_REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN DISCH_THEN + (X_CHOOSE_THEN `d:num->num->real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `COUNTABLE {d n m:real^N->bool | n IN (:num) /\ m IN (:num)}` + MP_TAC THENL + [MATCH_MP_TAC COUNTABLE_PRODUCT_DEPENDENT THEN + REWRITE_TAC[NUM_COUNTABLE]; + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COUNTABLE_AS_IMAGE)) THEN + ANTS_TAC THENL [SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN + ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC]]]);; + +(* ------------------------------------------------------------------------- *) +(* A Lebesgue measurable set is almost an F_sigma. *) +(* ------------------------------------------------------------------------- *) + +let LEBESGUE_MEASURABLE_ALMOST_FSIGMA = prove + (`!s:real^N->bool. + lebesgue_measurable s + ==> ?c t. UNIONS c UNION t = s /\ DISJOINT (UNIONS c) t /\ + COUNTABLE c /\ (!u. u IN c ==> closed u) /\ negligible t`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + LEBESGUE_MEASURABLE_INNER_CLOSED)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM] THEN + X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (f:num->real^N->bool) (:num)` THEN + EXISTS_TAC `s DIFF UNIONS (IMAGE (f:num->real^N->bool) (:num))` THEN + ASM_SIMP_TAC[SET_RULE `DISJOINT s (u DIFF s)`; COUNTABLE_IMAGE; + NUM_COUNTABLE; FORALL_IN_IMAGE; IN_UNIV; UNIONS_SUBSET; + SET_RULE `s UNION (u DIFF s) = u <=> s SUBSET u`] THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s DIFF (f:num->real^N->bool) n` THEN + ASM_REWRITE_TAC[UNIONS_IMAGE] THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS `inv(&n + &1)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN TRANS_TAC REAL_LE_TRANS `inv(&n)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existence of nonmeasurable subsets of any set of positive measure. *) +(* ------------------------------------------------------------------------- *) + +let NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS = prove + (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> lebesgue_measurable t`, + let lemma = prove + (`!s:real^N->bool. + lebesgue_measurable s /\ + (!x y q. x IN s /\ y IN s /\ rational q /\ y = q % basis 1 + x ==> y = x) + ==> negligible s`, + SIMP_TAC[VECTOR_ARITH `q + x:real^N = x <=> q = vec 0`; VECTOR_MUL_EQ_0; + BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN + DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` STEINHAUS_LEBESGUE) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `q:real` o MATCH_MP RATIONAL_BETWEEN) THEN + FIRST_X_ASSUM + (MP_TAC o SPEC `q % basis 1:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + SIMP_TAC[IN_BALL_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; + ARITH; NOT_IMP] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN + ASM_REWRITE_TAC[REAL_MUL_RID; IN_ELIM_THM; NOT_EXISTS_THM; + VECTOR_ARITH `q:real^N = x - y <=> x = q + y`] THEN + ASM_CASES_TAC `q = &0` THENL [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[]]) in + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; + DISCH_TAC] THEN + ABBREV_TAC + `(canonize:real^N->real^N) = + \x. @y. y IN s /\ ?q. rational q /\ q % basis 1 + y = x` THEN + SUBGOAL_THEN + `!x:real^N. x IN s + ==> canonize x IN s /\ + ?q. rational q /\ q % basis 1 + canonize x = x` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "canonize" THEN + CONV_TAC SELECT_CONV THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[RATIONAL_CLOSED] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `v = IMAGE (canonize:real^N->real^N) s` THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC + `UNIONS (IMAGE (\q. IMAGE (\x:real^N. q % basis 1 + x) v) rational)` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS_GEN THEN + SIMP_TAC[COUNTABLE_RATIONAL; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[NEGLIGIBLE_TRANSLATION_EQ] THEN GEN_TAC THEN + DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC lemma THEN + CONJ_TAC THENL [FIRST_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + EXPAND_TAC "v" THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `q:real` THEN REPEAT DISCH_TAC THEN + EXPAND_TAC "canonize" THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `z:real^N` THEN AP_TERM_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN + ASM_REWRITE_TAC[VECTOR_ARITH `q % b + x:real^N = y <=> x = y - q % b`] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH `x - q % b:real^N = y - r % b - s % b <=> + y + (q - r - s) % b = x /\ x + (r + s - q) % b = y`] THEN + STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC + (BINDER_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [SYM th]) THEN + SIMP_TAC[VECTOR_MUL_EQ_0; BASIS_NONZERO; DIMINDEX_GE_1; ARITH; VECTOR_ARITH + `y - q % b:real^N = (y + r % b) - s % b <=> (q + r - s) % b = vec 0`] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[REAL_ARITH `a + b - c = &0 <=> c = a + b`; UNWIND_THM2] THEN + ASM_SIMP_TAC[RATIONAL_CLOSED]);; + +let NEGLIGIBLE_IFF_MEASURABLE_SUBSETS = prove + (`!s:real^N->bool. negligible s <=> !t. t SUBSET s ==> measurable t`, + MESON_TAC[NEGLIGIBLE_SUBSET; NEGLIGIBLE_IMP_MEASURABLE; + MEASURABLE_IMP_LEBESGUE_MEASURABLE; + NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS]);; + +(* ------------------------------------------------------------------------- *) +(* Preserving Lebesgue measurability vs. preserving negligibility. *) +(* ------------------------------------------------------------------------- *) + +let PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE = prove + (`!f s:real^N->bool. + (!t. negligible t /\ t SUBSET s ==> lebesgue_measurable(IMAGE f t)) + ==> (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS] THEN + REWRITE_TAC[FORALL_SUBSET_IMAGE] THEN + ASM_MESON_TAC[NEGLIGIBLE_SUBSET; SUBSET_TRANS]);; + +let LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!t. negligible t /\ t SUBSET s ==> negligible(IMAGE f t)) + ==> !t. lebesgue_measurable t /\ t SUBSET s + ==> lebesgue_measurable(IMAGE f t)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(STRIP_ASSUME_TAC o + MATCH_MP LEBESGUE_MEASURABLE_REGULAR_INNER) THEN + ASM_REWRITE_TAC[IMAGE_UNION; IMAGE_UNIONS] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN + SUBGOAL_THEN `(k:real^M->bool) SUBSET s` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; FORALL_IN_IMAGE] THEN + SIMP_TAC[IN_UNIV; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN + GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_COMPACT THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]);; + +let LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE = prove + (`!f:real^M->real^N s. + dimindex(:M) <= dimindex(:N) /\ + f differentiable_on s /\ lebesgue_measurable s + ==> lebesgue_measurable(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] + LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE) THEN + EXISTS_TAC `s:real^M->bool` THEN + ASM_SIMP_TAC[SUBSET_REFL; DIFFERENTIABLE_IMP_CONTINUOUS_ON] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE THEN + ASM_MESON_TAC[DIFFERENTIABLE_ON_SUBSET]);; + +let LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN = prove + (`!f:real^M->real^N s. + linear f /\ lebesgue_measurable s /\ dimindex(:M) <= dimindex(:N) + ==> lebesgue_measurable(IMAGE f s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]);; + +let MEASURABLE_LINEAR_IMAGE_GEN = prove + (`!f:real^M->real^N s. + linear f /\ measurable s /\ dimindex(:M) <= dimindex(:N) + ==> measurable(IMAGE f s)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `m:num <= n ==> m < n \/ m = n`)) + THENL + [MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN + MATCH_MP_TAC NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR]; + ASM_CASES_TAC `!x y. (f:real^M->real^N) x = f y ==> x = y` THENL + [ASM_MESON_TAC[MEASURABLE_LINEAR_IMAGE_EQ_GEN]; ALL_TAC] THEN + MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN + MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] + DIM_IMAGE_KERNEL_GEN) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV] THEN ONCE_ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(ARITH_RULE + `x <= y /\ ~(d = 0) ==> x < y + d`) THEN + SIMP_TAC[DIM_SUBSET; IMAGE_SUBSET; SUBSET_UNIV] THEN + REWRITE_TAC[IN_UNIV; DIM_EQ_0] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_0) THEN ASM SET_TAC[]]);; + +let LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN = prove + (`!f:real^M->real^N s. + dimindex(:M) = dimindex(:N) /\ linear f /\ (!x y. f x = f y ==> x = y) + ==> (lebesgue_measurable(IMAGE f s) <=> lebesgue_measurable s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!y. f((g:real^N->real^M) y) = y` ASSUME_TAC THENL + [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + EQ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL]] THEN + DISCH_TAC THEN + SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) (IMAGE f s)` SUBST1_TAC THENL + [ASM SET_TAC[]; + ASM_MESON_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Measurability of continuous functions. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove + (`!f:real^M->real^N s. + f continuous_on s /\ lebesgue_measurable s + ==> f measurable_on s`, + let lemma = prove + (`!s. lebesgue_measurable s + ==> ?u:num->real^M->bool. + (!n. closed(u n)) /\ (!n. u n SUBSET s) /\ + (!n. measurable(s DIFF u n) /\ + measure(s DIFF u n) < inv(&n + &1)) /\ + (!n. u(n) SUBSET u(SUC n))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n t. closed t /\ t SUBSET s + ==> ?u:real^M->bool. + closed u /\ t SUBSET u /\ u SUBSET s /\ + measurable(s DIFF u) /\ measure(s DIFF u) < inv(&n + &1)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s DIFF t:real^M->bool`; `inv(&n + &1)`] + LEBESGUE_MEASURABLE_INNER_CLOSED) THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; LEBESGUE_MEASURABLE_CLOSED] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t UNION u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNION] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[SET_RULE `s DIFF (t UNION u) = s DIFF t DIFF u`]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `v:num->(real^M->bool)->(real^M->bool)` THEN DISCH_TAC THEN + MP_TAC(prove_recursive_functions_exist num_RECURSION + `(u:num->real^M->bool) 0 = v 0 {} /\ + (!n. u(SUC n) = v (SUC n) (u n))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:num->real^M->bool` THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!n. closed(u n) /\ (u:num->real^M->bool) n SUBSET s` + ASSUME_TAC THENL + [INDUCT_TAC THEN + ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET]; + ASM_SIMP_TAC[]] THEN + INDUCT_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[CLOSED_EMPTY; EMPTY_SUBSET]]) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `u:num->real^M->bool` STRIP_ASSUME_TAC o + MATCH_MP lemma) THEN + SUBGOAL_THEN `lebesgue_measurable((:real^M) DIFF s)` MP_TAC THENL + [ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_COMPL]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC o + MATCH_MP lemma) THEN + REWRITE_TAC[measurable_on] THEN + EXISTS_TAC `(:real^M) DIFF + (UNIONS {u n | n IN (:num)} UNION UNIONS {v n | n IN (:num)})` THEN + SUBGOAL_THEN + `!n. ?g. g continuous_on (:real^M) /\ + (!x. x IN u(n) UNION v(n:num) + ==> g x = if x IN s then (f:real^M->real^N)(x) else vec 0)` + MP_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN + ASM_SIMP_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; CLOSED_UNION] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `g:num->real^M->real^N` THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `(s DIFF UNIONS {u n | n IN (:num)}) UNION + ((:real^M) DIFF s DIFF UNIONS {v n | n IN (:num)})` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC NEGLIGIBLE_UNION THEN CONJ_TAC THEN + REWRITE_TAC[NEGLIGIBLE_OUTER] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `e:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `s DIFF u(n:num):real^M->bool`; + EXISTS_TAC `(:real^M) DIFF s DIFF v(n:num):real^M->bool`] THEN + (CONJ_TAC THENL [SET_TAC[]; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `inv(&n)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; REAL_ARITH_TAC]); + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[SET_RULE + `~(x IN (UNIV DIFF (s UNION t))) <=> x IN s \/ x IN t`] THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + REWRITE_TAC[OR_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_UNION] THEN + SUBGOAL_THEN + `!i j. i <= j ==> (u:num->real^M->bool)(i) SUBSET u(j) /\ + (v:num->real^M->bool)(i) SUBSET v(j)` + (fun th -> ASM_MESON_TAC[SUBSET; th]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]]);; + +let CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET = prove + (`!f:real^M->real^N s. + f continuous_on s /\ closed s ==> f measurable_on s`, + SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; + LEBESGUE_MEASURABLE_CLOSED]);; + +let CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove + (`!f:real^M->real^N s m. + f continuous_on (s DIFF m) /\ lebesgue_measurable s /\ negligible m + ==> f measurable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N) measurable_on (s DIFF m)` MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_DIFF; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; + MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Measurability of a.e. derivatives. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_VECTOR_DERIVATIVE = prove + (`!f:real^1->real^N f' s k. + negligible k /\ negligible(frontier s) /\ + (!x. x IN (s DIFF k) ==> (f has_vector_derivative f'(x)) (at x)) + ==> f' measurable_on s`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + ABBREV_TAC `g:real^1->real^N = \x. if x IN s then f(x) else vec 0` THEN + SUBGOAL_THEN `(g:real^1->real^N) measurable_on (:real^1)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN + EXISTS_TAC `s DIFF k:real^1->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `k:real^1->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_ON THEN + MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN + ASM_MESON_TAC[differentiable; has_vector_derivative]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN + ASM_SIMP_TAC[NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE] THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_JORDAN]]]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN + EXISTS_TAC `\n x. (&n + &1) % (g(x + lift(inv(&n + &1))) - g(x):real^N)` THEN + EXISTS_TAC `k UNION frontier s:real^1->bool` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN + MATCH_MP_TAC MEASURABLE_ON_SUB THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + REWRITE_TAC[MEASURABLE_ON_TRANSLATION_EQ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `g measurable_on s ==> t = s ==> g measurable_on t`)) THEN + MATCH_MP_TAC(SET_RULE + `!g. (!x. f(g x) = x /\ g(f x) = x) ==> IMAGE f UNIV = UNIV`) THEN + EXISTS_TAC `\x. --(lift(inv(&n + &1))) + x` THEN VECTOR_ARITH_TAC; + + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_UNIV; IN_DIFF; IN_UNION; DE_MORGAN_THM; frontier; + CLOSURE_INTERIOR] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL; IN_DIFF; IN_UNIV] THEN + X_GEN_TAC `d:real` THEN ASM_SIMP_TAC[DIST_REFL] THEN STRIP_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THENL + [EXISTS_TAC `(\n. vec 0):num->real^N`; + EXISTS_TAC `(\n. (&n + &1) % (f(x + lift (inv (&n + &1))) - f x)) + :num->real^N`] THEN + (CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `d:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN + SUBGOAL_THEN `dist(x,x + lift(inv(&n + &1))) < d` ASSUME_TAC THENL + [REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_INV] THEN + REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + EXPAND_TAC "g" THEN REWRITE_TAC[] THEN ASM_SIMP_TAC[DIST_REFL] THEN + VECTOR_ARITH_TAC]; + ALL_TAC]) THEN + REWRITE_TAC[LIM_CONST] THEN + UNDISCH_THEN + `!x. x IN s DIFF k + ==> ((f:real^1->real^N) has_vector_derivative f' x) (at x)` + (MP_TAC o SPEC `x:real^1`) THEN + ASM_SIMP_TAC[IN_DIFF; DIST_REFL; has_vector_derivative] THEN + REWRITE_TAC[has_derivative; NETLIMIT_AT] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[LIM_AT; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN + MP_TAC(SPEC `k:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + lift(inv(&n + &1))` o CONJUNCT2) THEN + REWRITE_TAC[NORM_ARITH `dist(x + a:real^N,x) = norm a`] THEN + REWRITE_TAC[NORM_LIFT; REAL_ABS_INV; REAL_ARITH `abs(&n + &1) = &n + &1`; + VECTOR_ARITH `(x + e) - x:real^N = e`; LIFT_DROP] THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_TRANS] THEN + EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + MATCH_MP_TAC(NORM_ARITH + `x - y:real^N = z ==> dist(z,vec 0) < e ==> dist(x,y) < e`) THEN + REWRITE_TAC[REAL_INV_INV; VECTOR_SUB_LDISTRIB; VECTOR_ADD_LDISTRIB] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID; + REAL_ARITH `~(&n + &1 = &0)`] THEN + VECTOR_ARITH_TAC]]);; + +let ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER = prove + (`!f:real^M->real^N s t. + f absolutely_integrable_on s /\ lebesgue_measurable t + ==> f absolutely_integrable_on (s INTER t)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + STRIP_TAC THEN + MATCH_MP_TAC + MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\x. lift(norm(if x IN s then (f:real^M->real^N) x else vec 0))` THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; IN_UNIV; IN_INTER; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[MESON[] + `(if p /\ q then x else y) = if q then if p then x else y else y`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_CASES THEN + ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`; MEASURABLE_ON_0] THEN + ASM_SIMP_TAC[INTEGRABLE_IMP_MEASURABLE; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN t` THEN + ASM_REWRITE_TAC[REAL_LE_REFL; LIFT_DROP; NORM_0; NORM_POS_LE]]);; + +let ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET = prove + (`!f:real^M->real^N s t. + f absolutely_integrable_on s /\ t SUBSET s /\ lebesgue_measurable t + ==> f absolutely_integrable_on t`, + MESON_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER; + SET_RULE `s SUBSET t ==> s = t INTER s`]);; + +(* ------------------------------------------------------------------------- *) +(* Approximation of L_1 functions by bounded continuous ones. *) +(* Note that 100/fourier.ml has some generalizations to L_p spaces. *) +(* ------------------------------------------------------------------------- *) + +let ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS = prove + (`!f:real^M->real^N s e. + lebesgue_measurable s /\ f absolutely_integrable_on s /\ &0 < e + ==> ?g. g absolutely_integrable_on s /\ + g continuous_on (:real^M) /\ + bounded (IMAGE g (:real^M)) /\ + norm(integral s (\x. lift(norm(f x - g x)))) < e`, + let lemma = prove + (`!f:real^M->real^N s e. + measurable s /\ f absolutely_integrable_on s /\ &0 < e + ==> ?g. g absolutely_integrable_on s /\ + g continuous_on (:real^M) /\ + bounded (IMAGE g (:real^M)) /\ + norm(integral s (\x. lift(norm(f x - g x)))) < e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?h. h absolutely_integrable_on s /\ + bounded (IMAGE h (:real^M)) /\ + norm(integral s (\x. lift(norm(f x - h x:real^N)))) < e / &2` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL + [`\n x. lift(norm + (f x - (lambda i. max (--(&n)) + (min (&n) ((f:real^M->real^N)(x)$i)))))`; + `(\x. vec 0):real^M->real^1`; + `\x. lift(norm((f:real^M->real^N)(x)))`; + `s:real^M->bool`] + DOMINATED_CONVERGENCE) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!n. ((\x. lambda i. max (--(&n)) (min (&n) ((f x:real^N)$i))) + :real^M->real^N) absolutely_integrable_on s` + ASSUME_TAC THENL + [GEN_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `(\x. lambda i. &n):real^M->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MIN)) THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN + DISCH_THEN(MP_TAC o SPEC `(\x. lambda i. --(&n)):real^M->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] ABSOLUTELY_INTEGRABLE_MAX)) THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_ON_CONST] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA]; + ALL_TAC] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SUB]; + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN REAL_ARITH_TAC; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `d:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `norm((f:real^M->real^N) x)` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[DIST_0; NORM_LIFT; REAL_ABS_NORM; GSYM LIFT_SUB] THEN + MATCH_MP_TAC(NORM_ARITH + `&0 < d /\ x = y ==> norm(x:real^N - y) < d`) THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= n ==> x = max (--n) (min n x)`) THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; REAL_OF_NUM_LE]]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[INTEGRAL_0; DIST_0; LE_REFL] THEN DISCH_TAC THEN + EXISTS_TAC `(\x. lambda i. max (--(&n)) (min (&n) + ((f:real^M->real^N)(x)$i))):real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[BOUNDED_COMPONENTWISE] THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `&n` THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_SIMP_TAC[NORM_LIFT; LAMBDA_BETA] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?k g. negligible k /\ + (!n. g n continuous_on (:real^M)) /\ + (!n x. norm(g n x:real^N) <= norm(B % vec 1:real^N)) /\ + (!x. x IN (s DIFF k) ==> ((\n. g n x) --> h x) sequentially)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `(h:real^M->real^N) measurable_on s` MP_TAC THENL + [ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; ALL_TAC] THEN + REWRITE_TAC[measurable_on] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\n x. lambda i. max (--B) (min B (((g n x):real^N)$i))): + num->real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + MP_TAC(ISPECL [`(:real^M)`; `(lambda i. B):real^N`] + CONTINUOUS_ON_CONST) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MIN) THEN + MP_TAC(ISPECL [`(:real^M)`; `(lambda i. --B):real^N`] + CONTINUOUS_ON_CONST) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VEC_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC; + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `ee:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(c - a:real^N) <= norm(b - a) + ==> dist(b,a) < ee ==> dist(c,a) < ee`) THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP NORM_BOUND_COMPONENT_LE) THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. (g:num->real^M->real^N) n absolutely_integrable_on s` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC + MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `(\x. lift(norm(B % vec 1:real^N))):real^M->real^1` THEN + ASM_REWRITE_TAC[LIFT_DROP; INTEGRABLE_ON_CONST] THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[lebesgue_measurable; indicator] + MEASURABLE_ON_RESTRICT) THEN + ASM_SIMP_TAC[CONTINUOUS_IMP_MEASURABLE_ON; ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + ASM_REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n x. lift(norm((g:num->real^M->real^N) n x - h x))`; + `(\x. vec 0):real^M->real^1`; + `(\x. lift(B + norm(B % vec 1:real^N))):real^M->real^1`; + `s DIFF k:real^M->bool`] DOMINATED_CONVERGENCE) THEN + ASM_SIMP_TAC[INTEGRAL_0; INTEGRABLE_ON_CONST; MEASURABLE_DIFF; + NEGLIGIBLE_IMP_MEASURABLE] THEN + ANTS_TAC THENL + [REWRITE_TAC[NORM_LIFT; REAL_ABS_NORM] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE_SET) THEN + EXISTS_TAC `s:real^M->bool` THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(g:real^N) <= b /\ norm(h) <= a ==> norm(g - h) <= a + b`) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM LIM_NULL_NORM; GSYM LIM_NULL]]; + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL; DIST_0] THEN DISCH_TAC THEN + EXISTS_TAC `(g:num->real^M->real^N) n` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm(integral s (\x. lift(norm(f x - h x)))) + + norm(integral s (\x. lift(norm + ((g:num->real^M->real^N) n x - h x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `norm(x:real^N) <= norm(y + z:real^N) + ==> norm(x) <= norm(y) + norm(z)`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) (GSYM INTEGRAL_ADD) o + rand o rand o snd) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + ABSOLUTELY_INTEGRABLE_SUB; ETA_AX] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(MESON[] + `norm x = drop x /\ norm(a:real^N) <= drop x + ==> norm a <= norm x`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC NORM_1_POS THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN + SIMP_TAC[DROP_ADD; LIFT_DROP; NORM_POS_LE; REAL_LE_ADD] THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC; + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REWRITE_TAC[DROP_ADD; LIFT_DROP; NORM_LIFT; REAL_ABS_NORM] THEN + REWRITE_TAC[NORM_ARITH + `norm(f - g:real^N) <= norm(f - h) + norm(g - h)`] THEN + CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC]] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; + ABSOLUTELY_INTEGRABLE_SUB; ETA_AX]; + MATCH_MP_TAC(REAL_ARITH `a < e / &2 /\ b < e / &2 ==> a + b < e`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `x < e ==> x = y ==> y < e`)) THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE_SET THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `k:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(!u v. f absolutely_integrable_on (s INTER interval[u,v])) /\ + (!u v. (f:real^M->real^N) absolutely_integrable_on (s DIFF interval[u,v]))` + STRIP_ASSUME_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER; + LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_DIFF; + LEBESGUE_MEASURABLE_UNIV]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a b. norm(integral (s INTER interval[a,b]) (\x. lift(norm(f x))) - + integral s (\x. lift(norm((f:real^M->real^N) x)))) < e / &3` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [absolutely_integrable_on]) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[HAS_INTEGRAL_INTEGRAL] THEN + REWRITE_TAC[HAS_INTEGRAL_ALT; INTEGRAL_RESTRICT_INTER] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3` o CONJUNCT2) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL; BOUNDED_BALL]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `s INTER interval[a:real^M,b]`; `e / &3`] + lemma) THEN + ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; + MEASURABLE_INTERVAL; REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?c d. interval[a:real^M,b] SUBSET interval(c,d) /\ + measure(interval(c,d)) - measure(interval[a,b]) < e / &3 / B` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:real^M`; `b:real^M`; + `e / &3 / B / &2`] + EXPAND_CLOSED_OPEN_INTERVAL) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; REAL_ARITH `&0 < &3`] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < e ==> x <= y + e / &2 ==> x - y < e`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < &3`]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x. if x IN interval[a,b] then (g:real^M->real^N) x else vec 0`; + `(:real^M)`; + `interval[a,b] UNION ((:real^M) DIFF interval(c,d))`; + `B:real`] TIETZE) THEN + REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN; IN_UNIV] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE; FORALL_IN_UNION] THEN + SIMP_TAC[CLOSED_UNION; CLOSED_INTERVAL; GSYM OPEN_CLOSED; OPEN_INTERVAL; + IN_DIFF; IN_UNIV] THEN + ASM_SIMP_TAC[COND_RAND; NORM_0; COND_RATOR; REAL_LT_IMP_LE; COND_ID] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + SIMP_TAC[CLOSED_INTERVAL; GSYM OPEN_CLOSED; OPEN_INTERVAL] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N`] THEN + REWRITE_TAC[FORALL_IN_UNION; bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_EQ THEN + EXISTS_TAC `\x. if x IN s INTER interval(c,d) + then (h:real^M->real^N) x else vec 0` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_INTER] THEN + MATCH_MP_TAC + MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `(\x. lift B):real^M->real^1` THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST; LIFT_DROP] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_CASES THEN + ASM_REWRITE_TAC[SET_RULE `{x | x IN s} = s`; MEASURABLE_ON_0] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + REWRITE_TAC[INTEGRABLE_ON_OPEN_INTERVAL; INTEGRABLE_CONST]; + GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE]]; + DISCH_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(!u v. h absolutely_integrable_on (s INTER interval[u,v])) /\ + (!u v. (h:real^M->real^N) absolutely_integrable_on (s DIFF interval[u,v]))` + STRIP_ASSUME_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER; + LEBESGUE_MEASURABLE_INTERVAL; LEBESGUE_MEASURABLE_DIFF; + LEBESGUE_MEASURABLE_UNIV]; + ALL_TAC] THEN + TRANS_TAC REAL_LET_TRANS + `norm(integral (s INTER interval[a,b]) + (\x. lift(norm((f:real^M->real^N) x - h x)))) + + norm(integral (s DIFF interval[a,b]) + (\x. lift(norm(f x - h x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `a + b:real^N = c ==> norm(c) <= norm(a) + norm(b)`) THEN + W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o lhand o snd) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; SET_RULE + `(s INTER t) INTER (s DIFF t) = {} /\ + (s INTER t) UNION (s DIFF t) = s`] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `norm(integral s f) < e / &3 + ==> integral s f = integral s g /\ + y < &2 / &3 * e ==> norm(integral s g) + y < e`)) THEN + CONJ_TAC THENL [MATCH_MP_TAC INTEGRAL_EQ THEN ASM SET_TAC[]; ALL_TAC] THEN + TRANS_TAC REAL_LET_TRANS + `drop(integral (s DIFF interval[a,b]) + (\x. lift(norm((f:real^M->real^N) x)) + + lift(norm(h x:real^N))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_SUB; + ABSOLUTELY_INTEGRABLE_ADD; LIFT_DROP; DROP_ADD; NORM_LIFT; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + CONV_TAC NORM_ARITH; + ASM_SIMP_TAC[INTEGRAL_ADD; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + ABSOLUTELY_INTEGRABLE_NORM; DROP_ADD]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e / &3 ==> z = x /\ y <= e / &3 ==> z + y < &2 / &3 * e`)) THEN + CONJ_TAC THENL + [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `z + y = x /\ &0 <= y ==> y = abs(z - x)`) THEN + ASM_SIMP_TAC[INTEGRAL_DROP_POS; LIFT_DROP; NORM_POS_LE; + ABSOLUTELY_INTEGRABLE_NORM; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[GSYM DROP_ADD; DROP_EQ] THEN + W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_UNION o lhand o snd) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; SET_RULE + `(s INTER t) INTER (s DIFF t) = {} /\ + (s INTER t) UNION (s DIFF t) = s`] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC; + ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS + `drop(integral (interval(c,d) DIFF interval[a,b]) (\x:real^M. lift B))` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; IN_UNIV] THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; INTEGRABLE_ON_CONST; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_DIFF] THEN + ASM_CASES_TAC `x IN interval(c:real^M,d)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `x IN interval[a:real^M,b]` THEN ASM_REWRITE_TAC[] THEN + REPEAT COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LE_REFL; LIFT_DROP; NORM_0; REAL_LT_IMP_LE; + DROP_VEC] THEN + ASM_MESON_TAC[IN_DIFF; IN_UNIV; NORM_0; REAL_LE_REFL]; + SIMP_TAC[LIFT_EQ_CMUL; INTEGRAL_CMUL; INTEGRABLE_ON_CONST; + MEASURABLE_DIFF; MEASURABLE_INTERVAL; INTEGRAL_MEASURE] THEN + REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> y = x ==> y <= e`)) THEN + MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN + ASM_REWRITE_TAC[MEASURABLE_INTERVAL]]);; + +(* ------------------------------------------------------------------------- *) +(* Luzin's theorem (Talvila and Loeb's proof from Marius Junge's notes). *) +(* ------------------------------------------------------------------------- *) + +let LUZIN = prove + (`!f:real^M->real^N s e. + measurable s /\ f measurable_on s /\ &0 < e + ==> ?k. compact k /\ k SUBSET s /\ + measure(s DIFF k) < e /\ f continuous_on k`, + REPEAT STRIP_TAC THEN + X_CHOOSE_THEN `v:num->real^N->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE_SEQUENCE THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] + MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] + MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + SUBGOAL_THEN + `!n. ?k k'. + compact k /\ k SUBSET {x | x IN s /\ (f:real^M->real^N) x IN v n} /\ + compact k' /\ k' SUBSET {x | x IN s /\ f x IN ((:real^N) DIFF v n)} /\ + measure(s DIFF (k UNION k')) < e / &4 / &2 pow n` + MP_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (v:num->real^N->bool) n}`; + `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; ARITH; REAL_LT_DIV; REAL_LT_POW2] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`{x:real^M | x IN s /\ f(x) IN (:real^N) DIFF v(n:num)}`; + `e / &4 / &2 / &2 pow n`] MEASURABLE_INNER_COMPACT) THEN + ASM_SIMP_TAC[GSYM OPEN_CLOSED; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; + ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k':real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `measure(({x | x IN s /\ (f:real^M->real^N) x IN v n} DIFF k) UNION + ({x | x IN s /\ f x IN ((:real^N) DIFF v(n:num))} DIFF k'))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT; + GSYM OPEN_CLOSED] THEN SET_TAC[]; + ASM_SIMP_TAC[MEASURE_UNION; MEASURABLE_DIFF; MEASURABLE_COMPACT; + GSYM OPEN_CLOSED; MEASURE_DIFF_SUBSET] THEN + MATCH_MP_TAC(REAL_ARITH + `s < k + e / &4 / &2 / d /\ s' < k' + e / &4 / &2 / d /\ m = &0 + ==> (s - k) + (s' - k') - m < e / &4 / d`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[MEASURE_EMPTY] + `s = {} ==> measure s = &0`) THEN SET_TAC[]]; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_DIFF; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `k':num->real^M->bool`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + EXISTS_TAC `INTERS {k n UNION k' n | n IN (:num)} :real^M->bool` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_INTERS THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; COMPACT_UNION] THEN SET_TAC[]; + REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]; + REWRITE_TAC[DIFF_INTERS; SET_RULE + `{f y | y IN {g x | x IN s}} = {f(g x) | x IN s}`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC + (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_UNION; MEASURABLE_COMPACT] THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\i. e / &4 / &2 pow i)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_SIMP_TAC[real_div; SUM_LMUL; REAL_LE_LMUL_EQ; REAL_ARITH + `(e * inv(&4)) * s <= e * inv(&2) <=> e * s <= e * &2`] THEN + REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ARITH + `(&1 - s) / (&1 / &2) <= &2 <=> &0 <= s`] THEN + MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; + + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[CONTINUOUS_WITHIN_OPEN; IN_ELIM_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?n:num. (f:real^M->real^N)(x) IN v(n) /\ v(n) SUBSET t` + STRIP_ASSUME_TAC THENL + [UNDISCH_THEN + `!s. open s ==> (?k. s:real^N->bool = UNIONS {v(n:num) | n IN k})` + (MP_TAC o SPEC `t:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; UNIONS_GSPEC] THEN ASM SET_TAC[]; + EXISTS_TAC `(:real^M) DIFF k'(n:num)` THEN + ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]]);; + +let LUZIN_EQ,LUZIN_EQ_ALT = (CONJ_PAIR o prove) + (`(!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !e. &0 < e + ==> ?k. compact k /\ k SUBSET s /\ + measure(s DIFF k) < e /\ f continuous_on k)) /\ + (!f:real^M->real^N s. + measurable s + ==> (f measurable_on s <=> + !e. &0 < e + ==> ?k g. compact k /\ k SUBSET s /\ + measure(s DIFF k) < e /\ + g continuous_on (:real^M) /\ + (!x. x IN k ==> g x = f x)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[LUZIN]; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBTOPOLOGY_UNIV; GSYM CLOSED_IN]; + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&2 pow n)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + MAP_EVERY X_GEN_TAC [`k:num->real^M->bool`; `g:num->real^M->real^N`] THEN + STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC + [`g:num->real^M->real^N`; + `s DIFF UNIONS {INTERS {k m | n <= m} | n IN (:num)}:real^M->bool`] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + ASM_MESON_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; CONTINUOUS_ON_SUBSET; + SUBSET_UNIV]; + SIMP_TAC[DIFF_UNIONS_NONEMPTY; SET_RULE `~({f x | x IN UNIV} = {})`] THEN + REWRITE_TAC[NEGLIGIBLE_OUTER] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`inv(&2)`; `e / &4`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_INV]] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s DIFF INTERS {k m | n:num <= m}:real^M->bool` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; + MATCH_MP_TAC MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_COUNTABLE_INTERS_GEN THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[LE_REFL]] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN + MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV]; + REWRITE_TAC[DIFF_INTERS] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC + (MESON[] `measurable s /\ measure s <= b ==> measure s <= b`) THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_GEN THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; MEASURABLE_COMPACT; MEASURABLE_DIFF] THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[SET_RULE `{x | x IN s} = s`] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN + MESON_TAC[NUM_COUNTABLE; COUNTABLE_SUBSET; SUBSET_UNIV]; + REWRITE_TAC[SIMPLE_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `ns:num->bool` THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE_LE o lhand o snd) THEN + ASM_SIMP_TAC[o_DEF; MEASURE_POS_LE; MEASURABLE_DIFF; + MEASURABLE_COMPACT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + FIRST_ASSUM(MP_TAC o SPEC `\x:num. x` o + MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `m:num` THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (n..m) (\i. measure(s DIFF k i:real^M->bool))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF; MEASURABLE_COMPACT; + FINITE_NUMSEG; SUBSET; IN_NUMSEG]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (n..m) (\i. inv(&2 pow i))` THEN + ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_INV_POW; SUM_GP; LT] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC(REAL_ARITH + `a <= e / &4 /\ &0 <= b + ==> (a - b) / (&1 / &2) <= e / &2`) THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_POW_INV] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_IMP_LE; REAL_LE_INV_EQ; + REAL_LT_POW2]]]; + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[UNIONS_GSPEC; IN_INTER] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM; INTERS_GSPEC] THEN + STRIP_TAC THEN MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Egorov's thoerem. *) +(* ------------------------------------------------------------------------- *) + +let EGOROV = prove + (`!f:num->real^M->real^N g s t. + measurable s /\ negligible t /\ + (!n. f n measurable_on s) /\ g measurable_on s /\ + (!x. x IN s DIFF t ==> ((\n. f n x) --> g x) sequentially) + ==> !d. &0 < d + ==> ?k. k SUBSET s /\ measurable k /\ measure k < d /\ + !e. &0 < e + ==> ?N. !n x. N <= n /\ x IN s DIFF k + ==> dist(f n x,g x) < e`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `e = \n m. UNIONS{{x | x IN s /\ + dist((f:num->real^M->real^N) k x,g x) + >= inv(&m + &1)} | n <= k}` THEN + SUBGOAL_THEN + `!m n. measurable ((e:num->num->real^M->bool) n m)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "e" THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN SET_TAC[]] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_SUBSET_NUM; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_ARITH + `dist(a:real^M,b) >= e <=> ~(dist(vec 0,a - b) < e)`] THEN + REWRITE_TAC[GSYM IN_BALL; SET_RULE `~(x IN s) <=> x IN UNIV DIFF s`] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN + ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_BALL; + MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN + MATCH_MP_TAC MEASURABLE_ON_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] MEASURABLE_ON_SPIKE_SET) THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[ETA_AX] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m. ?k. measure((e:num->num->real^M->bool) k m) < d / &2 pow (m + 2)` + MP_TAC THENL + [GEN_TAC THEN MP_TAC(ISPEC + `\n. (e:num->num->real^M->bool) n m` HAS_MEASURE_NESTED_INTERS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [GEN_TAC THEN EXPAND_TAC "e" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_UNIONS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ARITH_TAC; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)] THEN + SUBGOAL_THEN + `measure (INTERS {(e:num->num->real^M->bool) n m | n IN (:num)}) = &0` + SUBST1_TAC THENL + [MATCH_MP_TAC MEASURE_EQ_0 THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real^M->bool` THEN + ASM_REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_REWRITE_TAC[IN_DIFF] THEN + EXPAND_TAC "e" THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; NOT_FORALL_THM; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&m + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &m + &1`] THEN + REWRITE_TAC[DE_MORGAN_THM; real_ge; REAL_NOT_LE] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; LIFT_NUM; DIST_0; NORM_LIFT] THEN + DISCH_THEN(MP_TAC o SPEC `d / &2 pow (m + 2)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN + REAL_ARITH_TAC; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:num->num` THEN DISCH_TAC] THEN + EXISTS_TAC `UNIONS {(e:num->num->real^M->bool) (k m) m | m IN (:num)}` THEN + CONJ_TAC THENL + [REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN EXPAND_TAC "e" THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\m. (e:num->num->real^M->bool) (k m) m`; `d / &2`] + MEASURE_COUNTABLE_UNIONS_LE) THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [X_GEN_TAC `n:num`; + ASM_MESON_TAC[REAL_ARITH `&0 < d /\ x <= d / &2 ==> x < d`]] THEN + TRANS_TAC REAL_LE_TRANS `sum(0..n) (\m. d / &2 pow (m + 2))` THEN + ASM_SIMP_TAC[SUM_LE_NUMSEG; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_POW; REAL_MUL_ASSOC] THEN + REWRITE_TAC[SUM_RMUL; SUM_LMUL; SUM_GP; CONJUNCT1 LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x ==> (&1 - x) / (&1 / &2) * &1 / &4 <= &1 / &2`) THEN + MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC REAL_RAT_REDUCE_CONV; + + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN EXISTS_TAC `(k:num->num) m` THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^M`] THEN EXPAND_TAC "e" THEN + REWRITE_TAC[IN_DIFF; UNIONS_GSPEC; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; IN_UNIV] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN + ASM_REWRITE_TAC[REAL_NOT_LE; real_ge] THEN FIRST_X_ASSUM(MATCH_MP_TAC o + MATCH_MP (REAL_ARITH `i < e ==> m <= i ==> d < m ==> d < e`)) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* A kind of absolute continuity of the integral. *) +(* ------------------------------------------------------------------------- *) + +let ABSOLUTELY_CONTINUOUS_INTEGRAL = prove + (`!f:real^M->real^N s e. + f absolutely_integrable_on s /\ &0 < e + ==> ?d. &0 < d /\ + !t. t SUBSET s /\ measurable t /\ measure t < d + ==> norm(integral t f) < e`, + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. if x IN s then (f:real^M->real^N) x else vec 0`; + `(:real^M)`; `e / &2`] + ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS) THEN + ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / &2 / B` THEN ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF] THEN + X_GEN_TAC `t:real^M->bool` THEN STRIP_TAC THEN + TRANS_TAC REAL_LET_TRANS + `drop(integral t (\x. lift(norm((if x IN s then f x else vec 0) - g x)) + + lift(norm((g:real^M->real^N) x))))` THEN + + SUBGOAL_THEN + `(g:real^M->real^N) absolutely_integrable_on t /\ + (\x. if x IN s then (f:real^M->real^N) x else vec 0) + absolutely_integrable_on t` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^M)` THEN + ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; SUBSET_UNIV]; + ALL_TAC] THEN + SUBGOAL_THEN `(f:real^M->real^N) absolutely_integrable_on t` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + ABSOLUTELY_INTEGRABLE_EQ)) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [ABSOLUTELY_INTEGRABLE_NORM; ABSOLUTELY_INTEGRABLE_ADD; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP; DROP_ADD] THEN + COND_CASES_TAC THENL [CONV_TAC NORM_ARITH; ASM SET_TAC[]]; + ALL_TAC] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [ABSOLUTELY_INTEGRABLE_NORM; INTEGRAL_ADD; DROP_ADD; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `norm(integral s (f:real^M->real^1)) < e / &2 + ==> drop(integral t f) <= norm(integral s f) + ==> drop(integral t f) < e / &2`)) THEN + REWRITE_TAC[NORM_REAL; GSYM drop] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NORM; IN_UNIV; SUBSET_UNIV; LIFT_DROP; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; ABSOLUTELY_INTEGRABLE_SUB] THEN + REWRITE_TAC[NORM_POS_LE]; + + TRANS_TAC REAL_LET_TRANS `drop(integral t (\x:real^M. lift B))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_SIMP_TAC[LIFT_DROP; ABSOLUTELY_INTEGRABLE_NORM; INTEGRABLE_ON_CONST; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + ASM_SIMP_TAC[LIFT_EQ_CMUL; INTEGRAL_CMUL; INTEGRABLE_ON_CONST; + INTEGRAL_MEASURE] THEN + REWRITE_TAC[DROP_CMUL; DROP_VEC; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]]]);; + +(* ------------------------------------------------------------------------- *) +(* Convergence in measure implies convergence AE of a subsequence. *) +(* ------------------------------------------------------------------------- *) + +let CONVERGENCE_IN_MEASURE = prove + (`!f:num->real^M->real^N g s. + (!n. f n measurable_on s) /\ + (!e. &0 < e + ==> eventually + (\n. ?t. {x | x IN s /\ dist(f n x,g x) >= e} SUBSET t /\ + measurable t /\ measure t < e) + sequentially) + ==> ?r t. (!m n:num. m < n ==> r m < r n) /\ + negligible t /\ t SUBSET s /\ + !x. x IN s DIFF t + ==> ((\n. f (r n) x) --> g x) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?r. (!n. ?t. {x | x IN s /\ dist(f (r n) x,(g:real^M->real^N) x) + >= inv(&2 pow n)} SUBSET t /\ + measurable t /\ measure t < inv(&2 pow n)) /\ + (!n. r n :num < r(SUC n))` + MP_TAC THENL + [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `&1`); + MAP_EVERY X_GEN_TAC [`n:num`; `p:num`] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow (SUC n))`)] THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_INV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THENL + [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(MP_TAC o SPEC `m:num`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_REFL]; + DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `m + p + 1:num`)) THEN + DISCH_THEN(fun th -> EXISTS_TAC `m + p + 1:num` THEN MP_TAC th) THEN + REWRITE_TAC[LE_ADD; ARITH_RULE `p < m + p + 1`]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + X_GEN_TAC `t:num->real^M->bool` THEN STRIP_TAC] THEN + EXISTS_TAC `s INTER + INTERS {UNIONS {(t:num->real^M->bool) k | n <= k} | n IN (:num)}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + MATCH_MP_TAC NEGLIGIBLE_INTER THEN DISJ2_TAC THEN + SIMP_TAC[NEGLIGIBLE_OUTER_LE] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e / &2`] REAL_ARCH_POW_INV) THEN + ASM_REWRITE_TAC[REAL_POW_INV; REAL_HALF] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `UNIONS {(t:num->real^M->bool) k | N <= k}` THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE `x IN s ==> INTERS s SUBSET x`) THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[LE_EXISTS; SET_RULE + `{f n | ?d. n = N + d} = {f(N + n) | n IN (:num)}`] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN + TRANS_TAC REAL_LE_TRANS `sum(0..n) (\k. inv(&2 pow (N + k)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_INV_MUL; SUM_LMUL; GSYM REAL_POW_INV] THEN + REWRITE_TAC[SUM_GP; CONJUNCT1 LT] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_INV_INV] THEN + REWRITE_TAC[REAL_ARITH `x * y * &2 <= e <=> y * x <= e / &2`] THEN + REWRITE_TAC[REAL_POW_INV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `n < e / &2 ==> &0 <= x * n ==> (&1 - x) * n <= e / &2`)) THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_LE_INV_EQ; GSYM REAL_POW_ADD] THEN + SIMP_TAC[REAL_POW_LE; REAL_POS]; + + REWRITE_TAC[INTER_SUBSET]; + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[SET_RULE `s DIFF (s INTER t) = s DIFF t`] THEN + REWRITE_TAC[IN_DIFF; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "*")) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N + M:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPECL [`n:num`; `x:real^M`]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; real_ge; REAL_NOT_LE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN + TRANS_TAC REAL_LET_TRANS `inv(&2 pow M)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Fubini-type results for measure. *) +(* ------------------------------------------------------------------------- *) + +let FUBINI_MEASURE = prove + (`!s:real^(M,N)finite_sum->bool. + measurable s + ==> negligible {x | ~measurable {y | pastecart x y IN s}} /\ + ((\x. lift(measure {y | pastecart x y IN s})) + has_integral lift(measure s)) UNIV`, + let MEASURE_PASTECART_INTERVAL = prove + (`!a b:real^(M,N)finite_sum. + (!x. measurable {y | pastecart x y IN interval[a,b]}) /\ + ((\x. lift(measure {y | pastecart x y IN interval[a,b]})) + has_integral lift(measure(interval[a,b]))) UNIV`, + REWRITE_TAC[FORALL_PASTECART] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `c:real^N`; `b:real^M`; `d:real^N`] THEN + REWRITE_TAC[GSYM PCROSS_INTERVAL; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[SET_RULE `{x | P /\ Q x} = if P then {x | Q x} else {}`] THEN + REWRITE_TAC[COND_RAND; SET_RULE `{x | x IN s} = s`] THEN + REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_EMPTY; COND_ID] THEN + REWRITE_TAC[MEASURE_EMPTY; LIFT_NUM; HAS_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART] THEN + REWRITE_TAC[LIFT_CMUL; HAS_INTEGRAL_CONST]) in + let MEASURE_PASTECART_ELEMENTARY = prove + (`!s:real^(M,N)finite_sum->bool. + (?d. d division_of s) + ==> (!x. measurable {y | pastecart x y IN s}) /\ + ((\x. lift(measure {y | pastecart x y IN s})) + has_integral lift(measure s)) UNIV`, + let lemma = prove + (`{x | f x IN UNIONS s} = UNIONS {{x | f x IN d} | d IN s}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + GEN_TAC THEN REWRITE_TAC[division_of; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:(real^(M,N)finite_sum->bool)->bool` THEN + STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[lemma] THEN + CONJ_TAC THENL + [X_GEN_TAC `s:real^M` THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + X_GEN_TAC `k:real^(M,N)finite_sum->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?a b:real^(M,N)finite_sum. k = interval[a,b]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[MEASURE_PASTECART_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\x. vsum d (\k. lift(measure {y | pastecart x y IN k}))) has_integral + vsum d (\k:real^(M,N)finite_sum->bool. lift(measure k))) UNIV` + MP_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_VSUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `k:real^(M,N)finite_sum->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?a b:real^(M,N)finite_sum. k = interval[a,b]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[MEASURE_PASTECART_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC(MESON[HAS_INTEGRAL_SPIKE] + `!t. negligible t /\ a = b /\ (!x. x IN s DIFF t ==> g x = f x) + ==> (f has_integral a) s ==> (g has_integral b) s`) THEN + EXISTS_TAC + `UNIONS { {x | (x:real^M)$i = + fstcart(interval_lowerbound k:real^(M,N)finite_sum)$i} | + i IN 1..dimindex(:M) /\ k IN d} UNION + UNIONS { {x | x$i = fstcart(interval_upperbound k)$i} | + i IN 1..dimindex(:M) /\ k IN d}` THEN + CONJ_TAC THENL + [REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN + CONJ_TAC THEN MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[CONJ_SYM] FINITE_PRODUCT_DEPENDENT; + FINITE_NUMSEG] THEN + SIMP_TAC[FORALL_IN_GSPEC; NEGLIGIBLE_STANDARD_HYPERPLANE; IN_NUMSEG]; + REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM LIFT_SUM); FUN_EQ_THM; LIFT_EQ] THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNIONS_IMAGE] THEN + ASM_REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN + (CONJ_TAC THENL + [ASM_MESON_TAC[MEASURE_PASTECART_INTERVAL; MEASURABLE_INTERVAL]; + ALL_TAC]) THEN + MAP_EVERY X_GEN_TAC + [`k:real^(M,N)finite_sum->bool`; `l:real^(M,N)finite_sum->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`k:real^(M,N)finite_sum->bool`; `l:real^(M,N)finite_sum->bool`]) THEN + ASM_REWRITE_TAC[GSYM INTERIOR_INTER] THEN + (SUBGOAL_THEN + `?a b:real^(M,N)finite_sum c d:real^(M,N)finite_sum. + k = interval[a,b] /\ l = interval[c,d]` + MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; NEGLIGIBLE_CONVEX_INTERIOR; + CONVEX_INTER; CONVEX_INTERVAL] THEN + REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; + PASTECART_IN_PCROSS] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P /\ Q x} INTER {x | R /\ S x} = + {x | P /\ R} INTER {x | Q x /\ S x}`] THEN + REWRITE_TAC[INTER_PCROSS; INTERIOR_PCROSS; GSYM INTER] THEN + REWRITE_TAC[SET_RULE `{x | P} = if P then UNIV else {}`] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; INTER_EMPTY; INTER_UNIV] THEN + SIMP_TAC[NEGLIGIBLE_CONVEX_INTERIOR; CONVEX_INTER; CONVEX_INTERVAL] THEN + REWRITE_TAC[PCROSS_EQ_EMPTY; TAUT `(if p then q else T) <=> p ==> q`] THEN + REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + SIMP_TAC[] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_UNION]) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN + DISCH_THEN(CONJUNCTS_THEN(fun th -> + MP_TAC(SPEC `l:real^(M,N)finite_sum->bool` th) THEN + MP_TAC(SPEC `k:real^(M,N)finite_sum->bool` th))) THEN + REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[PCROSS_INTERVAL]) THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[TAUT `~a \/ b <=> a ==> b`] THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND_NONEMPTY; INTERVAL_UPPERBOUND_NONEMPTY; + FSTCART_PASTECART] THEN + REPLICATE_TAC 3 (GEN_REWRITE_TAC I [IMP_IMP]) THEN + MATCH_MP_TAC(TAUT `(a ==> c ==> ~b) ==> a ==> b ==> c ==> d`) THEN + REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY; AND_FORALL_THM; + INTERIOR_INTERVAL; IMP_IMP; INTER_INTERVAL] THEN + MATCH_MP_TAC MONO_FORALL THEN SIMP_TAC[LAMBDA_BETA] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN REAL_ARITH_TAC) in + let MEASURE_PASTECART_OPEN_MEASURABLE = prove + (`!s:real^(M,N)finite_sum->bool. + open s /\ measurable s + ==> negligible {x | ~measurable {y | pastecart x y IN s}} /\ + ((\x. lift(measure {y | pastecart x y IN s})) + has_integral lift(measure s)) UNIV`, + let lemur = prove + (`UNIONS {{y | pastecart x y IN g n} | n IN (:num)} = + {y | pastecart x y IN UNIONS {g n | n IN (:num)}}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `g:num->real^(M,N)finite_sum->bool` + STRIP_ASSUME_TAC o MATCH_MP OPEN_COUNTABLE_LIMIT_ELEMENTARY) THEN + SUBGOAL_THEN `!n:num. g n SUBSET (s:real^(M,N)finite_sum->bool)` + ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)})`; + `(:real^M)`] BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN + MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->bool) n` + MEASURE_PASTECART_ELEMENTARY)) THEN + ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LIFT_DROP] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[MEASURE_PASTECART_ELEMENTARY]; ALL_TAC]) THEN + ASM SET_TAC[]; + REWRITE_TAC[bounded; FORALL_IN_GSPEC; NORM_LIFT] THEN + EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN + GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= y ==> abs x <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_POS_LE; + MATCH_MP_TAC MEASURE_SUBSET] THEN + ASM_MESON_TAC[MEASURABLE_ELEMENTARY]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^1`; `t:real^M->bool`] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + SUBGOAL_THEN + `!x:real^M. + ~(x IN t) ==> {y:real^N | pastecart x y IN s} has_measure drop(f x)` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV; NORM_LIFT] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL + [`\n. {y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) n}`; + `B:real`] + HAS_MEASURE_NESTED_UNIONS) THEN + ASM_SIMP_TAC[lemur; REAL_ARITH `abs x <= B ==> x <= B`] THEN + ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN + ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; GSYM LIFT_EQ] THEN + ASM_MESON_TAC[LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY; LIFT_DROP]; + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REWRITE_TAC[measurable] THEN ASM SET_TAC[]; + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^1`; `t:real^M->bool`] THEN + ASM_REWRITE_TAC[NEGLIGIBLE; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN + CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_UNIQUE]; ALL_TAC] THEN + ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC + `\k. lift(measure ((g:num->real^(M,N)finite_sum->bool) k))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MP_TAC(ISPECL [`g:num->real^(M,N)finite_sum->bool`; + `measure(s:real^(M,N)finite_sum->bool)`] + HAS_MEASURE_NESTED_UNIONS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[MEASURABLE_ELEMENTARY; MEASURE_SUBSET]]]) in + let MEASURE_PASTECART_COMPACT = prove + (`!s:real^(M,N)finite_sum->bool. + compact s + ==> (!x. measurable {y | pastecart x y IN s}) /\ + ((\x. lift(measure {y | pastecart x y IN s})) + has_integral lift(measure s)) UNIV`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_GSPEC] THEN + MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS]; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CONTINUOUS_PASTECART; + CONTINUOUS_CONST; CONTINUOUS_AT_ID]]; + DISCH_TAC] THEN + SUBGOAL_THEN + `?t:real^(M,N)finite_sum->bool. + open t /\ measurable t /\ s SUBSET t` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET_BALL; COMPACT_IMP_BOUNDED; + MEASURABLE_BALL; OPEN_BALL]; + ALL_TAC] THEN + MP_TAC(ISPEC `t:real^(M,N)finite_sum->bool` + MEASURE_PASTECART_OPEN_MEASURABLE) THEN + MP_TAC(ISPEC `t DIFF s:real^(M,N)finite_sum->bool` + MEASURE_PASTECART_OPEN_MEASURABLE) THEN + ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_COMPACT; OPEN_DIFF; + COMPACT_IMP_CLOSED; MEASURE_DIFF_SUBSET; IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[LIFT_SUB; IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN + REWRITE_TAC[VECTOR_ARITH `t - (t - s):real^1 = s`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] + HAS_INTEGRAL_SPIKE)) THEN + EXISTS_TAC + `{x | ~measurable {y | pastecart x y IN t DIFF s}} UNION + {x:real^M | ~measurable {y:real^N | pastecart x y IN t}}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN + SIMP_TAC[IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN + STRIP_TAC THEN REWRITE_TAC[LIFT_EQ; GSYM LIFT_SUB] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a:real = b - c <=> c = b - a`] THEN + REWRITE_TAC[SET_RULE + `{y | pastecart x y IN t /\ ~(pastecart x y IN s)} = + {y | pastecart x y IN t} DIFF {y | pastecart x y IN s}`] THEN + MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN ASM SET_TAC[]) in + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `?f. (!n. compact(f n) /\ f n SUBSET s /\ measurable(f n) /\ + measure s < measure(f n) + inv(&n + &1)) /\ + (!n. (f:num->real^(M,N)finite_sum->bool) n SUBSET f(SUC n))` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_INNER_COMPACT THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `t:real^(M,N)finite_sum->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^(M,N)finite_sum->bool`; `inv(&(SUC n) + &1)`] + MEASURABLE_INNER_COMPACT) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t UNION u:real^(M,N)finite_sum->bool` THEN + ASM_SIMP_TAC[COMPACT_UNION; UNION_SUBSET; MEASURABLE_UNION] THEN + REWRITE_TAC[SUBSET_UNION] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `s < a + e ==> a <= b ==> s < b + e`)) THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_UNION; SUBSET_UNION]; + ALL_TAC] THEN + SUBGOAL_THEN + `?g. (!n. open(g n) /\ s SUBSET g n /\ measurable(g n) /\ + measure(g n) < measure s + inv(&n + &1)) /\ + (!n. (g:num->real^(M,N)finite_sum->bool) (SUC n) SUBSET g n)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC DEPENDENT_CHOICE THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_OUTER_OPEN THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `t:real^(M,N)finite_sum->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^(M,N)finite_sum->bool`; `inv(&(SUC n) + &1)`] + MEASURABLE_OUTER_OPEN) THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^(M,N)finite_sum->bool` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t INTER u:real^(M,N)finite_sum->bool` THEN + ASM_SIMP_TAC[OPEN_INTER; SUBSET_INTER; MEASURABLE_INTER] THEN + REWRITE_TAC[INTER_SUBSET] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `a < s + e ==> b <= a ==> b < s + e`)) THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_INTER; INTER_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)}) - + lift(measure {y:real^N | pastecart x y IN (f n)})`; + `(:real^M)`] BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE) THEN + MP_TAC(GEN `n:num` (ISPEC `(f:num->real^(M,N)finite_sum->bool) n` + MEASURE_PASTECART_COMPACT)) THEN + MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->bool) n` + MEASURE_PASTECART_OPEN_MEASURABLE)) THEN + ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL; FORALL_AND_THM] THEN + STRIP_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; DROP_SUB; LIFT_DROP] THEN + ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRAL_SUB] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN EXISTS_TAC + `{x:real^M | ~measurable {y:real^N | pastecart x y IN g n}} UNION + {x:real^M | ~measurable {y | pastecart x y IN g (SUC n)}}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_UNION; DE_MORGAN_THM] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `f <= f' /\ g' <= g ==> g' - f' <= g - f`) THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + EXISTS_TAC `measure((g:num->real^(M,N)finite_sum->bool) 0) - + measure((f:num->real^(M,N)finite_sum->bool) 0)` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH + `!s. f' <= s /\ s <= g' /\ f <= f' /\ g' <= g + ==> abs(g' - f') <= g - f`) THEN + EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN MP_TAC(ARITH_RULE `0 <= n`) THEN + SPEC_TAC(`n:num`,`n:num`) THEN SPEC_TAC(`0`,`m:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN + SET_TAC[]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`h:real^M->real^1`; `k:real^M->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `?t. negligible t /\ + (!n x. ~(x IN t) ==> measurable {y:real^N | pastecart x y IN g n}) /\ + (!x. ~(x IN t) + ==> ((\k. lift(measure {y | pastecart x y IN g k}) - + lift(measure {y:real^N | pastecart x y IN f k})) --> vec 0) + sequentially) /\ + (!x. ~(x IN t) ==> (h:real^M->real^1) x = vec 0)` + MP_TAC THENL + [MP_TAC(ISPECL + [`\x. if x IN UNIONS{ {x | ~measurable {y:real^N | pastecart x y IN g n}} + | n IN (:num)} UNION k + then vec 0 else (h:real^M->real^1) x`; `(:real^M)`] + HAS_INTEGRAL_NEGLIGIBLE_EQ) THEN + REWRITE_TAC[IN_UNIV; DIMINDEX_1; FORALL_1] THEN ANTS_TAC THENL + [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN + COND_CASES_TAC THEN REWRITE_TAC[VEC_COMPONENT; REAL_LE_REFL] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_COMPONENT_LBOUND) THEN + EXISTS_TAC + `\k:num. lift(measure {y | pastecart x y IN + (g:num->real^(M,N)finite_sum->bool) k}) - + lift(measure {y | pastecart x y IN + (f:num->real^(M,N)finite_sum->bool) k})` THEN + REWRITE_TAC[DIMINDEX_1; TRIVIAL_LIMIT_SEQUENTIALLY; LE_REFL] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC ALWAYS_EVENTUALLY THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP] THEN + REWRITE_TAC[REAL_SUB_LE] THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_GSPEC]) THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN ANTS_TAC THENL + [MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `h:real^M->real^1` THEN + EXISTS_TAC `UNIONS{ {x | ~measurable {y | pastecart x y IN + (g:num->real^(M,N)finite_sum->bool) n}} + | n IN (:num)} UNION k` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNION; IN_UNIV] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IN_UNIV] NEGLIGIBLE_COUNTABLE_UNIONS) THEN + ASM_REWRITE_TAC[]; + MESON_TAC[]; + ASM_REWRITE_TAC[HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN EXISTS_TAC + `\k. lift(measure((g:num->real^(M,N)finite_sum->bool) k)) - + lift(measure((f:num->real^(M,N)finite_sum->bool) k))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; GSYM LIFT_SUB; DIST_0; NORM_LIFT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `!s d. f <= s /\ s <= g /\ s < f + d /\ g < s + d /\ d <= e / &2 + ==> abs(g - f) < e`) THEN + EXISTS_TAC `measure(s:real^(M,N)finite_sum->bool)` THEN + EXISTS_TAC `inv(&n + &1)` THEN ASM_REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[MEASURE_SUBSET]; ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS `inv(&N)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC]; + DISCH_TAC THEN EXISTS_TAC + `{x | ~((if x IN + UNIONS {{x | ~measurable {y | pastecart x y IN g n}} | n | T} UNION k + then vec 0 else (h:real^M->real^1) x) = vec 0)} UNION + UNIONS {{x | ~measurable {y | pastecart x y IN + (g:num->real^(M,N)finite_sum->bool) n}} | n | T} UNION + k` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN + ASM_SIMP_TAC[IN_UNION; DE_MORGAN_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IN_UNIV] NEGLIGIBLE_COUNTABLE_UNIONS) THEN + ASM_REWRITE_TAC[]; + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]]; + FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`) THEN STRIP_TAC] THEN + SUBGOAL_THEN + `!x:real^M. ~(x IN t) ==> measurable {y:real^N | pastecart x y IN s}` + ASSUME_TAC THENL + [REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[MEASURABLE_INNER_OUTER] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[DIST_0] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[LE_REFL; GSYM LIFT_SUB; NORM_LIFT] THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC + [`{y | pastecart x y IN (f:num->real^(M,N)finite_sum->bool) N}`; + `{y | pastecart x y IN (g:num->real^(M,N)finite_sum->bool) N}`] THEN + ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN EXISTS_TAC `t:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n:num x:real^M. lift(measure {y:real^N | pastecart x y IN (g n)})`; + `\x:real^M. lift(measure {y:real^N | pastecart x y IN s})`; + `(:real^M)`; `t:real^M->bool`] MONOTONE_CONVERGENCE_DECREASING_AE) THEN + ASM_REWRITE_TAC[LIFT_DROP; IN_UNIV; IN_DIFF] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[IN_DIFF] THEN ASM SET_TAC[]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^M` th) THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_SIMP_TAC[DIST_0] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[DIST_LIFT; GSYM dist] THEN + MATCH_MP_TAC(REAL_ARITH + `f <= s /\ s <= g ==> abs(g - f) < e ==> abs(g - s) < e`) THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[IN_DIFF] THEN ASM SET_TAC[]; + REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + EXISTS_TAC `measure((g:num->real^(M,N)finite_sum->bool) 0)` THEN + ASM_SIMP_TAC[NORM_LIFT; real_abs; MEASURE_POS_LE] THEN + X_GEN_TAC `m:num` THEN MP_TAC(ARITH_RULE `0 <= m`) THEN + SPEC_TAC(`m:num`,`m:num`) THEN SPEC_TAC(`0`,`n:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + REPEAT(CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN + GEN_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[]]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\k. lift(measure((g:num->real^(M,N)finite_sum->bool) k))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; DIST_LIFT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `!d. g < s + d /\ s <= g /\ d < e ==> abs(g - s) < e`) THEN + EXISTS_TAC `inv(&n + &1)` THEN ASM_SIMP_TAC[MEASURE_SUBSET] THEN + TRANS_TAC REAL_LET_TRANS `inv(&N)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC]);; + +let FUBINI_MEASURE_ALT = prove + (`!s:real^(M,N)finite_sum->bool. + measurable s + ==> negligible {y | ~measurable {x | pastecart x y IN s}} /\ + ((\y. lift(measure {x | pastecart x y IN s})) + has_integral lift(measure s)) UNIV`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z)) + (s:real^(M,N)finite_sum->bool)` + FUBINI_MEASURE) THEN + MP_TAC(ISPEC + `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)` + HAS_MEASURE_ISOMETRY) THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL + [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN + SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN + SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]; + DISCH_TAC THEN ASM_REWRITE_TAC[measurable; measure] THEN + ASM_REWRITE_TAC[GSYM measurable; GSYM measure] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; + SNDCART_PASTECART; PASTECART_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);; + +let FUBINI_LEBESGUE_MEASURABLE = prove + (`!s:real^(M,N)finite_sum->bool. + lebesgue_measurable s + ==> negligible {x | ~lebesgue_measurable {y | pastecart x y IN s}}`, + let lemma = prove + (`{x | ?n. P n x} = UNIONS {{x | P n x} | n IN (:num)}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_COUNTABLE_INTERVALS] THEN + X_GEN_TAC `m:num` THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN + REWRITE_TAC[INTER; IN_ELIM_THM; NOT_FORALL_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `n:num` THEN + MP_TAC(ISPEC `(s:real^(M,N)finite_sum->bool) INTER + (interval[--vec m,vec m] PCROSS interval[--vec n,vec n])` + FUBINI_MEASURE) THEN + ANTS_TAC THENL + [REWRITE_TAC[PCROSS_INTERVAL] THEN + ASM_MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS]; + DISCH_THEN(MP_TAC o CONJUNCT1)] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN + ASM_CASES_TAC `(x:real^M) IN interval[--vec m,vec m]` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);; + +let FUBINI_LEBESGUE_MEASURABLE_ALT = prove + (`!s:real^(M,N)finite_sum->bool. + lebesgue_measurable s + ==> negligible {y | ~lebesgue_measurable {x | pastecart x y IN s}}`, + let lemma = prove + (`{x | ?n. P n x} = UNIONS {{x | P n x} | n IN (:num)}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_COUNTABLE_INTERVALS] THEN + X_GEN_TAC `n:num` THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS] THEN + REWRITE_TAC[INTER; IN_ELIM_THM; NOT_FORALL_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[lemma] THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `m:num` THEN + MP_TAC(ISPEC `(s:real^(M,N)finite_sum->bool) INTER + (interval[--vec m,vec m] PCROSS interval[--vec n,vec n])` + FUBINI_MEASURE_ALT) THEN + ANTS_TAC THENL + [REWRITE_TAC[PCROSS_INTERVAL] THEN + ASM_MESON_TAC[LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS]; + DISCH_THEN(MP_TAC o CONJUNCT1)] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN + ASM_CASES_TAC `(y:real^N) IN interval[--vec n,vec n]` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; MEASURABLE_EMPTY]);; + +let FUBINI_NEGLIGIBLE = prove + (`!s. negligible s + ==> negligible + {x:real^M | ~negligible {y:real^N | pastecart x y IN s}}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE o MATCH_MP + NEGLIGIBLE_IMP_MEASURABLE) THEN + ASM_SIMP_TAC[MEASURE_EQ_0; LIFT_NUM; IMP_CONJ] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\x:real^M. lift (measure {y:real^N | pastecart x y IN s})`; + `(:real^M)`; + `{x:real^M | ~measurable {y:real^N | pastecart x y IN s}}`] + HAS_INTEGRAL_NEGLIGIBLE_EQ_AE) THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN + SIMP_TAC[IMP_IMP; FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP; IN_UNIV] THEN + ASM_SIMP_TAC[MEASURE_POS_LE; IMP_CONJ] THEN DISCH_THEN(K ALL_TAC) THEN + UNDISCH_TAC + `negligible {x:real^M | ~measurable {y:real^N | pastecart x y IN s}}` THEN + REWRITE_TAC[IMP_IMP; GSYM NEGLIGIBLE_UNION_EQ] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; GSYM DROP_EQ] THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[HAS_MEASURE_MEASURE; GSYM HAS_MEASURE_0] THEN + SET_TAC[]);; + +let FUBINI_NEGLIGIBLE_ALT = prove + (`!s. negligible s + ==> negligible + {y:real^N | ~negligible {x:real^M | pastecart x y IN s}}`, + let lemma = prove + (`!s:real^(M,N)finite_sum->bool. + negligible s + ==> negligible (IMAGE (\z. pastecart (sndcart z) (fstcart z)) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE_GEN THEN + ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM; LE_REFL] THEN + REWRITE_TAC[linear; FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; + FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL; + GSYM PASTECART_ADD; GSYM PASTECART_CMUL]) in + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_NEGLIGIBLE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[UNWIND_THM1; UNWIND_THM2]);; + +let NEGLIGIBLE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + negligible(s PCROSS t) <=> negligible s \/ negligible t`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_NEGLIGIBLE) THEN + REWRITE_TAC[PASTECART_IN_PCROSS] THEN + REWRITE_TAC[SET_RULE `{y | P /\ Q y} = if P then {y | Q y} else {}`] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + ASM_CASES_TAC `negligible(t:real^N->bool)` THEN + ASM_REWRITE_TAC[SET_RULE `~(if P then F else T) = P`; + SET_RULE `{x | x IN s} = s`]; + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; INTER_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`aa:real^M`; `a:real^N`; `bb:real^M`; `b:real^N`] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `(s:real^M->bool) PCROSS interval[a:real^N,b]` THEN + REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL + [`s:real^M->bool`; `e / (content(interval[a:real^N,b]) + &1)`] + MEASURABLE_OUTER_CLOSED_INTERVALS) THEN + ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_LT_DIV; CONTENT_POS_LE; + MEASURE_EQ_0; REAL_ADD_LID; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `UNIONS { (k:real^M->bool) PCROSS interval[a:real^N,b] | + k IN d}` THEN + ASM_REWRITE_TAC[GSYM PCROSS_UNIONS; SUBSET_PCROSS; SUBSET_REFL] THEN + REWRITE_TAC[PCROSS_UNIONS] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `D:(real^M->bool)->bool` THEN STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o + lhand o snd) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL; SUBSET]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN + TRANS_TAC REAL_LE_TRANS + `sum D (\k:real^M->bool. measure k * content(interval[a:real^N,b]))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^M. k = interval[u,v]` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET]; ASM_REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART]; + REWRITE_TAC[SUM_RMUL]] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x * (y + &1) <= e ==> x * y <= e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN + ASM_MESON_TAC[MEASURE_POS_LE; SUBSET; MEASURABLE_INTERVAL]; + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < x + &1`; + CONTENT_POS_LE]] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN + TRANS_TAC REAL_LE_TRANS `measure(UNIONS D:real^M->bool)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE; + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[SUBSET_UNIONS] THEN + ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_INTERVAL; SUBSET]] THEN + TRANS_TAC EQ_TRANS `sum (D:(real^M->bool)->bool) content` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN + REWRITE_TAC[division_of] THEN ASM SET_TAC[]]; + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + REWRITE_TAC[FORALL_PASTECART; GSYM PCROSS_INTERVAL; INTER_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `aa:real^N`; `b:real^M`; `bb:real^N`] THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `interval[a:real^M,b] PCROSS (t:real^N->bool)` THEN + REWRITE_TAC[SUBSET_PCROSS; INTER_SUBSET] THEN + REWRITE_TAC[NEGLIGIBLE_OUTER_LE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC(ISPECL + [`t:real^N->bool`; `e / (content(interval[a:real^M,b]) + &1)`] + MEASURABLE_OUTER_CLOSED_INTERVALS) THEN + ASM_SIMP_TAC[NEGLIGIBLE_IMP_MEASURABLE; REAL_LT_DIV; CONTENT_POS_LE; + MEASURE_EQ_0; REAL_ADD_LID; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `UNIONS { interval[a:real^M,b] PCROSS (k:real^N->bool) | + k IN d}` THEN + ASM_REWRITE_TAC[GSYM PCROSS_UNIONS; SUBSET_PCROSS; SUBSET_REFL] THEN + REWRITE_TAC[PCROSS_UNIONS] THEN + MATCH_MP_TAC MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `D:(real^N->bool)->bool` THEN STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) MEASURE_UNIONS_LE_IMAGE o + lhand o snd) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL; PCROSS_INTERVAL; SUBSET]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)] THEN + TRANS_TAC REAL_LE_TRANS + `sum D (\k:real^N->bool. content(interval[a:real^M,b]) * measure k)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v:real^N. k = interval[u,v]` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET]; ASM_REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[PCROSS_INTERVAL; MEASURE_INTERVAL; CONTENT_PASTECART]; + REWRITE_TAC[SUM_LMUL]] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x * (y + &1) <= e ==> y * x <= e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN + ASM_MESON_TAC[MEASURE_POS_LE; SUBSET; MEASURABLE_INTERVAL]; + SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < x + &1`; + CONTENT_POS_LE]] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS)) THEN + TRANS_TAC REAL_LE_TRANS `measure(UNIONS D:real^N->bool)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE; + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[SUBSET_UNIONS] THEN + ASM_MESON_TAC[MEASURABLE_UNIONS; MEASURABLE_INTERVAL; SUBSET]] THEN + TRANS_TAC EQ_TRANS `sum (D:(real^N->bool)->bool) content` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_MESON_TAC[MEASURE_INTERVAL; SUBSET]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_ELEMENTARY THEN + REWRITE_TAC[division_of] THEN ASM SET_TAC[]]]);; + +let FUBINI_TONELLI_MEASURE = prove + (`!s:real^(M,N)finite_sum->bool. + lebesgue_measurable s + ==> (measurable s <=> + negligible {x | ~measurable {y | pastecart x y IN s}} /\ + (\x. lift(measure {y | pastecart x y IN s})) integrable_on UNIV)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[FUBINI_MEASURE; integrable_on]; STRIP_TAC] THEN + MP_TAC(ISPECL + [`\n. s INTER ball(vec 0:real^(M,N)finite_sum,&n)`; + `drop(integral (:real^M) + (\x. lift (measure {y:real^N | pastecart x y IN s})))`] + MEASURABLE_NESTED_UNIONS) THEN + ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; + MEASURABLE_BALL; GSYM REAL_OF_NUM_SUC; SUBSET_BALL; + REAL_ARITH `x <= x + &1`; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN + ANTS_TAC THENL + [X_GEN_TAC `n:num` THEN + MP_TAC(SPEC `s INTER ball(vec 0:real^(M,N)finite_sum,&n)` + FUBINI_MEASURE) THEN + ASM_SIMP_TAC[MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; + MEASURABLE_BALL; HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC INTEGRAL_DROP_LE_AE THEN + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `{x:real^M | ~measurable {y:real^N | pastecart x y IN s}} UNION + {x:real^M | ~measurable {y:real^N | pastecart x y IN s INTER + ball (vec 0,&n)}}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; IN_DIFF; IN_UNIV; DE_MORGAN_THM; + IN_UNION; IN_ELIM_THM; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[UNIONS_GSPEC; IN_INTER; IN_BALL_0; IN_UNIV] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[REAL_ARCH_LT]]);; + +let FUBINI_TONELLI_MEASURE_ALT = prove + (`!s:real^(M,N)finite_sum->bool. + lebesgue_measurable s + ==> (measurable s <=> + negligible {y | ~measurable {x | pastecart x y IN s}} /\ + (\y. lift(measure {x | pastecart x y IN s})) integrable_on UNIV)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z)) + (s:real^(M,N)finite_sum->bool)` + FUBINI_TONELLI_MEASURE) THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LINEAR_PASTECART; + LINEAR_FSTCART; LINEAR_SNDCART; DIMINDEX_FINITE_SUM; + ARITH_RULE `m + n:num <= n + m`] THEN + MP_TAC(ISPEC + `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)` + HAS_MEASURE_ISOMETRY) THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL + [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN + SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN + SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]; + DISCH_TAC THEN ASM_REWRITE_TAC[measurable; measure] THEN + ASM_REWRITE_TAC[GSYM measurable; GSYM measure] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; + SNDCART_PASTECART; PASTECART_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);; + +let FUBINI_TONELLI_NEGLIGIBLE = prove + (`!s:real^(M,N)finite_sum->bool. + lebesgue_measurable s + ==> (negligible s <=> + negligible {x | ~negligible {y | pastecart x y IN s}})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[FUBINI_NEGLIGIBLE] THEN DISCH_TAC THEN + REWRITE_TAC[NEGLIGIBLE_EQ_MEASURE_0] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[FUBINI_TONELLI_MEASURE] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; CONTRAPOS_THM; + NEGLIGIBLE_IMP_MEASURABLE]; + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] INTEGRABLE_SPIKE)]; + DISCH_TAC THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FUBINI_MEASURE) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_INTEGRAL_UNIQUE)) THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE] THEN + EXISTS_TAC `(\x. vec 0):real^M->real^1` THEN + EXISTS_TAC + `{x:real^M | ~negligible {y:real^N | pastecart x y IN s}}` THEN + ASM_REWRITE_TAC[INTEGRABLE_0; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + SIMP_TAC[MEASURE_EQ_0; GSYM DROP_EQ; DROP_VEC; LIFT_DROP; HAS_INTEGRAL_0]);; + +let FUBINI_TONELLI_NEGLIGIBLE_ALT = prove + (`!s:real^(M,N)finite_sum->bool. + lebesgue_measurable s + ==> (negligible s <=> + negligible {y | ~negligible {x | pastecart x y IN s}})`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE (\z. pastecart (sndcart z) (fstcart z)) + (s:real^(M,N)finite_sum->bool)` + FUBINI_TONELLI_NEGLIGIBLE) THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; LINEAR_PASTECART; + LINEAR_FSTCART; LINEAR_SNDCART; DIMINDEX_FINITE_SUM; + ARITH_RULE `m + n:num <= n + m`] THEN + MP_TAC(ISPEC + `\z:real^(M,N)finite_sum. pastecart (sndcart z) (fstcart z)` + HAS_MEASURE_ISOMETRY) THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN ANTS_TAC THENL + [REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN + SIMP_TAC[LINEAR_PASTECART; LINEAR_FSTCART; LINEAR_SNDCART] THEN + SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]; + DISCH_TAC THEN ASM_REWRITE_TAC[HAS_MEASURE_0] THEN + ASM_REWRITE_TAC[GSYM HAS_MEASURE_0] THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART; + SNDCART_PASTECART; PASTECART_INJ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM1]]);; + +let LEBESGUE_MEASURABLE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + lebesgue_measurable(s PCROSS t) <=> + negligible s \/ negligible t \/ + (lebesgue_measurable s /\ lebesgue_measurable t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `negligible(s:real^M->bool)` THENL + [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; + ASM_REWRITE_TAC[]] THEN + ASM_CASES_TAC `negligible(t:real^N->bool)` THENL + [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE]; + ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[lebesgue_measurable; measurable_on; IN_UNIV] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC + [`k:real^(M,N)finite_sum->bool`; + `g:num->real^(M,N)finite_sum->real^1`] THEN + STRIP_TAC THEN FIRST_ASSUM(fun th -> + ASSUME_TAC(MATCH_MP FUBINI_NEGLIGIBLE th) THEN + ASSUME_TAC(MATCH_MP FUBINI_NEGLIGIBLE_ALT th)) THEN + SUBGOAL_THEN + `~(s SUBSET {x:real^M | ~negligible {y:real^N | pastecart x y IN k}})` + MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `~(t SUBSET {y:real^N | ~negligible {x:real^M | pastecart x y IN k}})` + MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{x:real^M | pastecart x (y:real^N) IN k}` THEN + EXISTS_TAC `\n x. (g:num->real^(M,N)finite_sum->real^1) + n (pastecart x y)` THEN + EXISTS_TAC `{y:real^N | pastecart (x:real^M) y IN k}` THEN + EXISTS_TAC `\n y. (g:num->real^(M,N)finite_sum->real^1) + n (pastecart x y)` THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THEN + (CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + ALL_TAC]) + THENL + [X_GEN_TAC `u:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (u:real^M) (y:real^N)`); + X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (x:real^M) (v:real^N)`)] THEN + ASM_REWRITE_TAC[indicator; PASTECART_IN_PCROSS]; + MAP_EVERY X_GEN_TAC + [`u:real^M->bool`; `f:num->real^M->real^1`; + `v:real^N->bool`; `g:num->real^N->real^1`] THEN + STRIP_TAC THEN + EXISTS_TAC `u PCROSS (:real^N) UNION (:real^M) PCROSS v` THEN + EXISTS_TAC `\n:num z:real^(M,N)finite_sum. + lift(drop(f n (fstcart z)) * drop(g n (sndcart z)))` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ; NEGLIGIBLE_PCROSS] THEN + CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + REWRITE_TAC[FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[IN_UNIV; DE_MORGAN_THM; LIFT_CMUL; LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SUBGOAL_THEN `indicator (s PCROSS t) (pastecart x y) = + drop(indicator s (x:real^M)) % indicator t (y:real^N)` + SUBST1_TAC THENL + [REWRITE_TAC[indicator; PASTECART_IN_PCROSS] THEN + MAP_EVERY ASM_CASES_TAC [`(x:real^M) IN s`; `(y:real^N) IN t`] THEN + ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC LIM_MUL THEN REWRITE_TAC[o_DEF; LIFT_DROP] THEN + ASM_SIMP_TAC[]]]]);; + +let MEASURABLE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + measurable(s PCROSS t) <=> + negligible s \/ negligible t \/ (measurable s /\ measurable t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `negligible(s:real^M->bool)` THENL + [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_MEASURABLE]; + ASM_REWRITE_TAC[]] THEN + ASM_CASES_TAC `negligible(t:real^N->bool)` THENL + [ASM_MESON_TAC[NEGLIGIBLE_PCROSS; NEGLIGIBLE_IMP_MEASURABLE]; + ASM_REWRITE_TAC[]] THEN + ASM_CASES_TAC + `lebesgue_measurable((s:real^M->bool) PCROSS (t:real^N->bool))` + THENL + [ASM_SIMP_TAC[FUBINI_TONELLI_MEASURE; PASTECART_IN_PCROSS]; + ASM_MESON_TAC[LEBESGUE_MEASURABLE_PCROSS; + MEASURABLE_IMP_LEBESGUE_MEASURABLE]] THEN + REWRITE_TAC[SET_RULE `{x | P /\ x IN s} = if P then s else {}`] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[MEASURABLE_EMPTY; MEASURE_EMPTY] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[LIFT_NUM; INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN + REWRITE_TAC[SET_RULE + `{x | if x IN s then P else F} = if P then s else {}`] THEN + ASM_CASES_TAC `measurable(s:real^M->bool)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `measurable(t:real^N->bool)` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN + ASM_MESON_TAC[NEGLIGIBLE_EQ_MEASURE_0]);; + +let HAS_MEASURE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool a b. + s has_measure a /\ t has_measure b + ==> (s PCROSS t) has_measure (a * b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(s:real^M->bool) PCROSS (t:real^N->bool)` + FUBINI_MEASURE) THEN + REWRITE_TAC[MEASURABLE_PCROSS; PASTECART_IN_PCROSS] THEN + ANTS_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `{y | P /\ y IN s} = if P then s else {}`] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[MEASURABLE_EMPTY; MEASURE_EMPTY] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[LIFT_NUM; INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN + REWRITE_TAC[SET_RULE + `{x | if x IN s then P else F} = if P then s else {}`] THEN + REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN STRIP_TAC THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_PCROSS] THEN + CONJ_TAC THENL [ASM_MESON_TAC[measurable]; ALL_TAC] THEN + REWRITE_TAC[GSYM LIFT_EQ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_INTEGRAL_UNIQUE)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_MEASURE_MEASURABLE_MEASURE]) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[LIFT_CMUL] THEN + ASM_REWRITE_TAC[LIFT_EQ_CMUL] THEN MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN + REWRITE_TAC[GSYM LIFT_EQ_CMUL] THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + ASM_REWRITE_TAC[GSYM HAS_MEASURE; HAS_MEASURE_MEASURABLE_MEASURE]);; + +let MEASURE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + measurable s /\ measurable t + ==> measure(s PCROSS t) = measure s * measure t`, + MESON_TAC[HAS_MEASURE_MEASURABLE_MEASURE; HAS_MEASURE_PCROSS]);; + +(* ------------------------------------------------------------------------- *) +(* Relate the measurability of a function and of its ordinate set. *) +(* ------------------------------------------------------------------------- *) + +let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE = prove + (`!f:real^M->real^N k. + f measurable_on (:real^M) + ==> lebesgue_measurable {pastecart x (y:real^N) | y$k <= (f x)$k}`, + let lemma = prove + (`!x y. x <= y <=> !q. rational q /\ y < q ==> x < q`, + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LET_TRANS]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE; NOT_FORALL_THM; NOT_IMP; REAL_NOT_LT] THEN + MESON_TAC[RATIONAL_BETWEEN; REAL_LT_IMP_LE]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{pastecart (x:real^M) (y:real^N) | y$k <= (f x:real^N)$k} = + INTERS {{pastecart x y | (f x)$k < q ==> y$k < q} | q IN rational}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; EXTENSION; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN + ONCE_REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN MESON_TAC[lemma; IN]; + ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN + SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; COUNTABLE_RATIONAL] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN ONCE_REWRITE_TAC[SET_RULE + `{f x y | P x y ==> Q x y} = {f x y | Q x y} UNION {f x y | ~(P x y)}`] THEN + X_GEN_TAC `q:real` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN + REWRITE_TAC[REAL_NOT_LT; GSYM PCROSS; LEBESGUE_MEASURABLE_PCROSS; + SET_RULE `{f x y |x,y| P x} = {f x y | x IN {x | P x} /\ y IN UNIV}`; + SET_RULE `{f x y |x,y| Q y} = {f x y | x IN UNIV /\ y IN {x | Q x}}`] THEN + CONJ_TAC THEN REPEAT DISJ2_TAC THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THENL + [MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT]; + ONCE_REWRITE_TAC[SET_RULE + `{x | q <= (f x)$k} = {x | f x IN {y | q <= y$k}}`] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_PREIMAGE_CLOSED THEN + ASM_REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]]);; + +let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT = prove + (`!f:real^M->real^N k. + f measurable_on (:real^M) + ==> lebesgue_measurable {pastecart x (y:real^N) | y$k < (f x)$k}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `f < y <=> ~(--f <= --y)`] THEN + MP_TAC(ISPECL [`(--) o (f:real^M->real^N)`; `k:num`] + LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + SIMP_TAC[CONTINUOUS_ON_NEG; CONTINUOUS_ON_ID]; + ALL_TAC] THEN + MP_TAC(ISPEC + `\z:real^(M,N)finite_sum. pastecart (fstcart z) (--sndcart z)` + LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ) THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; PASTECART_INJ; VECTOR_EQ_NEG2; + GSYM PASTECART_EQ] THEN + ANTS_TAC THENL + [REWRITE_TAC[linear; PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART; + FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; SNDCART_CMUL] THEN + VECTOR_ARITH_TAC; + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th])] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM LEBESGUE_MEASURABLE_COMPL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `UNIV DIFF s = t <=> s = UNIV DIFF t`] THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_PASTECART_THM; o_DEF; + FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT; REAL_NEG_NEG] THEN + MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VECTOR_NEG_NEG]);; + +let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ, + LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ = (CONJ_PAIR o prove) + (`(!f:real^M->real^N. + f measurable_on (:real^M) <=> + !k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable + {pastecart x (y:real^N) | y$k <= (f x)$k}) /\ + (!f:real^M->real^N. + f measurable_on (:real^M) <=> + lebesgue_measurable + {pastecart x (y:real^N) | !k. 1 <= k /\ k <= dimindex(:N) + ==> y$k <= (f x)$k})`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) + ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THEN DISCH_TAC THENL + [ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE]; + SUBGOAL_THEN + `{ pastecart x y | + !k. 1 <= k /\ k <= dimindex(:N) + ==> (y:real^N)$k <= (f:real^M->real^N) x$k } = + INTERS {{ pastecart x y | (y:real^N)$k <= (f:real^M->real^N) x$k} | + k IN 1..dimindex(:N)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_INJ] THEN MESON_TAC[]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG]]; + MP_TAC(ISPECL + [`f:real^M->real^N`; + `{y | lebesgue_measurable + {x | !k. 1 <= k /\ k <= dimindex (:N) + ==> (y:real^N)$k <= (f:real^M->real^N) x$k}}`] + MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; real_ge] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_LEBESGUE_MEASURABLE_ALT) THEN + REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; NEGLIGIBLE_EMPTY_INTERIOR]]);; + +let LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ, + LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ = (CONJ_PAIR o prove) + (`(!f:real^M->real^N. + f measurable_on (:real^M) <=> + !k. 1 <= k /\ k <= dimindex(:N) + ==> lebesgue_measurable + {pastecart x (y:real^N) | y$k < (f x)$k}) /\ + (!f:real^M->real^N. + f measurable_on (:real^M) <=> + lebesgue_measurable + {pastecart x (y:real^N) | !k. 1 <= k /\ k <= dimindex(:N) + ==> y$k < (f x)$k})`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) + ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THEN DISCH_TAC THENL + [ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT]; + SUBGOAL_THEN + `{ pastecart x y | + !k. 1 <= k /\ k <= dimindex(:N) + ==> (y:real^N)$k < (f:real^M->real^N) x$k } = + INTERS {{ pastecart x y | (y:real^N)$k < (f:real^M->real^N) x$k} | + k IN 1..dimindex(:N)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_INJ] THEN MESON_TAC[]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IN_NUMSEG]]; + MP_TAC(ISPECL + [`f:real^M->real^N`; + `{y | lebesgue_measurable + {x | !k. 1 <= k /\ k <= dimindex (:N) + ==> (y:real^N)$k < (f:real^M->real^N) x$k}}`] + MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; real_gt] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_LEBESGUE_MEASURABLE_ALT) THEN + REWRITE_TAC[SET_RULE `{x | ~P x} = UNIV DIFF {x | P x}`] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; NEGLIGIBLE_EMPTY_INTERIOR]]);; + +let NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) ==> negligible {pastecart x y | f x = y}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_DISJOINT_TRANSLATES THEN + EXISTS_TAC `{pastecart (vec 0:real^M) x | x IN (:real^N)}` THEN + EXISTS_TAC `vec 0:real^(M,N)finite_sum` THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `{pastecart x y | (f:real^M->real^N) x = y} = + INTERS {{pastecart x y | y$i <= (f x)$i} DIFF + {pastecart x y | y$i < (f x)$i} | i IN 1..dimindex(:N)}` + SUBST1_TAC THENL + [REWRITE_TAC[CART_EQ; INTERS_GSPEC; EXTENSION; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_NUMSEG] THEN + ONCE_REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF; REAL_NOT_LT] THEN + REWRITE_TAC[REAL_LE_ANTISYM] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTERS THEN + SIMP_TAC[FINITE_IMAGE; SIMPLE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; + LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT]; + MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN + REWRITE_TAC[GSYM PCROSS; SET_RULE + `{f a x | x IN s} = {f w x | w IN {a} /\ x IN s}`] THEN + REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[CONNECTED_SING; CONNECTED_PCROSS_EQ; CONNECTED_UNIV] THEN + REWRITE_TAC[IN_SING; IN_UNIV] THEN MATCH_MP_TAC(SET_RULE + `!a b. a IN s /\ b IN s /\ ~(a = b) ==> ~(?a. s = {a})`) THEN + EXISTS_TAC `pastecart (vec 0:real^M) (vec 0:real^N)` THEN + EXISTS_TAC `pastecart (vec 0:real^M) (vec 1:real^N)` THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING; IN_UNIV] THEN + REWRITE_TAC[PASTECART_INJ; VEC_EQ; ARITH_EQ]; + + REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; PASTECART_INJ] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; PASTECART_INJ; FORALL_IN_IMAGE; + SET_RULE `DISJOINT s t <=> !x. x IN s ==> !y. y IN t ==> ~(x = y)`] THEN + REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; PASTECART_INJ] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x':real^M`; `y':real^N`] THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + ASM_CASES_TAC `x':real^M = x` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(a:real^N = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + CONV_TAC VECTOR_ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Hence relate integrals and "area under curve" for functions into R^+. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE = prove + (`!f:real^N->real^1. + (!x. &0 <= drop(f x)) + ==> (f measurable_on (:real^N) <=> + lebesgue_measurable { pastecart x y | y IN interval[vec 0,f x]})`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; IN_INTERVAL_1; GSYM drop; DROP_VEC] THEN + EQ_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN + `{pastecart x y | &0 <= drop y /\ drop y <= drop (f x)} = + (:real^N) PCROSS {y | &0 <= drop y} INTER + {pastecart (x:real^N) y | drop y <= drop (f x)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_INTER; IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN + SIMP_TAC[LEBESGUE_MEASURABLE_CLOSED; GSYM real_ge; drop; + CLOSED_HALFSPACE_COMPONENT_GE]]; + SUBGOAL_THEN + `{pastecart (x:real^N) y | drop y <= drop (f x)} = + {pastecart x y | &0 <= drop y /\ drop y <= drop (f x)} UNION + (:real^N) PCROSS {y | drop y < &0}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_UNION; IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_NOT_LE; REAL_LT_IMP_LE; REAL_LE_TRANS]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_UNION THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN + SIMP_TAC[LEBESGUE_MEASURABLE_OPEN; drop; + OPEN_HALFSPACE_COMPONENT_LT]]]);; + +let INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE = prove + (`!f:real^N->real^1. + (!x. &0 <= drop(f x)) + ==> (f integrable_on (:real^N) <=> + measurable { pastecart x y | y IN interval[vec 0,f x]})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) FUBINI_TONELLI_MEASURE o snd) THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN + ASM_SIMP_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN + REWRITE_TAC[MEASURABLE_INTERVAL; EMPTY_GSPEC; NEGLIGIBLE_EMPTY] THEN + ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + SUBGOAL_THEN + `{pastecart x y | y IN interval [vec 0,f x]} = + {pastecart x y | drop y <= drop(f x)} INTER + (:real^N) PCROSS {x | &0 <= drop x}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM; + PASTECART_IN_PCROSS; IN_UNIV] THEN + REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; DROP_VEC; CONJ_SYM]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN REWRITE_TAC[drop] THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; + INTEGRABLE_IMP_MEASURABLE; LEBESGUE_MEASURABLE_PCROSS] THEN + REPEAT DISJ2_TAC THEN REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED THEN + REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]]; + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN + ASM_SIMP_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN + REWRITE_TAC[ETA_AX; GSYM LIFT_EQ] THEN MESON_TAC[integrable_on]]);; + +let HAS_INTEGRAL_MEASURE_UNDER_CURVE = prove + (`!f:real^N->real^1 m. + (!x. &0 <= drop(f x)) + ==> ((f has_integral lift m) (:real^N) <=> + { pastecart x y | y IN interval[vec 0,f x]} has_measure m)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; + HAS_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MATCH_MP_TAC(TAUT + `(p <=> p') /\ (p /\ p' ==> (q <=> q')) ==> (p /\ q <=> p' /\ q')`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE]; STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; SET_RULE `{x | x IN s} = s`] THEN + ASM_REWRITE_TAC[MEASURE_INTERVAL_1; DROP_VEC; REAL_SUB_RZERO; LIFT_DROP] THEN + REWRITE_TAC[ETA_AX; GSYM LIFT_EQ] THEN + ASM_MESON_TAC[integrable_on; INTEGRAL_UNIQUE]);; + +(* ------------------------------------------------------------------------- *) +(* Some miscellanous lemmas. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_COMPOSE_FSTCART = prove + (`!f:real^M->real^P. + f measurable_on (:real^M) + ==> (\z:real^(M,N)finite_sum. f(fstcart z)) measurable_on + (:real^(M,N)finite_sum)`, + GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:num->real^M->real^P`] THEN + STRIP_TAC THEN + EXISTS_TAC `(k:real^M->bool) PCROSS (:real^N)` THEN + EXISTS_TAC `(\n z. g n (fstcart z)):num->real^(M,N)finite_sum->real^P` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_PCROSS; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_UNIV; FSTCART_PASTECART; SNDCART_PASTECART] THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);; + +let MEASURABLE_ON_COMPOSE_SNDCART = prove + (`!f:real^N->real^P. + f measurable_on (:real^N) + ==> (\z:real^(M,N)finite_sum. f(sndcart z)) measurable_on + (:real^(M,N)finite_sum)`, + GEN_TAC THEN REWRITE_TAC[measurable_on; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `g:num->real^N->real^P`] THEN + STRIP_TAC THEN + EXISTS_TAC `(:real^M) PCROSS (k:real^N->bool)` THEN + EXISTS_TAC `(\n z. g n (sndcart z)):num->real^(M,N)finite_sum->real^P` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_PCROSS; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_UNIV; SNDCART_PASTECART; SNDCART_PASTECART] THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]);; + +let MEASURABLE_ON_COMPOSE_SUB = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) + ==> (\z. f(fstcart z - sndcart z)) + measurable_on (:real^(M,M)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. f(fstcart z - sndcart z)):real^(M,M)finite_sum->real^N = + (\z. f(fstcart z)) o + (\z. pastecart (fstcart z - sndcart z) (sndcart z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART]; + W(MP_TAC o PART_MATCH (lhs o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o + snd)] THEN + REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN + ANTS_TAC THENL + [REWRITE_TAC[PASTECART_INJ] THEN + CONJ_TAC THENL [MATCH_MP_TAC LINEAR_PASTECART; CONV_TAC VECTOR_ARITH] THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_FSTCART; LINEAR_COMPOSE_SUB]; + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^(M,M)finite_sum)` THEN + ASM_SIMP_TAC[MEASURABLE_ON_COMPOSE_FSTCART; SUBSET_UNIV] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN THEN + REWRITE_TAC[LE_REFL; LEBESGUE_MEASURABLE_UNIV] THEN + MATCH_MP_TAC LINEAR_PASTECART THEN + SIMP_TAC[LINEAR_SNDCART; LINEAR_FSTCART; LINEAR_COMPOSE_SUB]]);; + +(* ------------------------------------------------------------------------- *) +(* Fubini for absolute integrability. *) +(* ------------------------------------------------------------------------- *) + +let FUBINI_ABSOLUTELY_INTEGRABLE = prove + (`!f:real^(M,N)finite_sum->real^P. + f absolutely_integrable_on (:real^(M,N)finite_sum) + ==> negligible + {x | ~((\y. f(pastecart x y)) + absolutely_integrable_on (:real^N))} /\ + ((\x. integral (:real^N) (\y. f(pastecart x y))) has_integral + integral (:real^(M,N)finite_sum) f) (:real^M)`, + let lemma = prove + (`{x | ~(!i. i IN k ==> P i x)} = UNIONS {{x | ~P i x} | i IN k}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + let assoclemma = prove + (`!P:real^(M,N)finite_sum->real^P->bool. + {pastecart x y | P x y} has_measure m + ==> {pastecart x (pastecart y z) | P (pastecart x y) z} + has_measure m`, + GEN_TAC THEN MP_TAC(ISPECL + [`\z. pastecart (fstcart(fstcart z):real^M) + (pastecart (sndcart(fstcart z):real^N) + (sndcart z:real^P))`; + `{pastecart (x:real^(M,N)finite_sum) (y:real^P) | P x y}`; + `m:real`] HAS_MEASURE_ISOMETRY) THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_AC] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN + REWRITE_TAC[GSYM o_DEF] THEN + REPEAT(MATCH_MP_TAC LINEAR_COMPOSE THEN CONJ_TAC) THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]; + SIMP_TAC[FORALL_PASTECART; NORM_EQ; GSYM NORM_POW_2; SQNORM_PASTECART; + FSTCART_PASTECART; SNDCART_PASTECART; REAL_ADD_AC]]; + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[FORALL_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART; + IN_ELIM_THM; EXISTS_PASTECART; PASTECART_INJ] THEN + MESON_TAC[]]) in + let FUBINI_LEMMA = prove + (`!f:real^(M,N)finite_sum->real^1. + f integrable_on (:real^(M,N)finite_sum) /\ (!x. &0 <= drop(f x)) + ==> negligible {x | ~((f o pastecart x) integrable_on (:real^N))} /\ + ((\x. integral (:real^N) (f o pastecart x)) has_integral + integral (:real^(M,N)finite_sum) f) (:real^M)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `f:real^(M,N)finite_sum->real^1` + INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `measurable { pastecart x (pastecart y z) | + z IN interval[vec 0,(f:real^(M,N)finite_sum->real^1) + (pastecart x y)] }` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [measurable]) THEN + REWRITE_TAC[measurable] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[assoclemma]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE) THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + REWRITE_TAC[SET_RULE + `{x | ?y z. P y z /\ x = pastecart y z} = + {pastecart y z | P y z}`] THEN + MP_TAC(GEN `x:real^M` (ISPEC + `(f:real^(M,N)finite_sum->real^1) o pastecart x` + INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE)) THEN + ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(MESON[] + `y = z /\ ((f has_integral y) s ==> (g has_integral y) s) + ==> (f has_integral y) s ==> (g has_integral z) s`) THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[HAS_INTEGRAL_MEASURE_UNDER_CURVE] THEN + ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MEASURE_UNIQUE THEN + MATCH_MP_TAC assoclemma THEN + ASM_REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE)) THEN + EXISTS_TAC + `{x | ~((\y. (f:real^(M,N)finite_sum->real^1) (pastecart x y)) + integrable_on (:real^N))}` THEN + ASM_REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[HAS_INTEGRAL_MEASURE_UNDER_CURVE] THEN + ASM_SIMP_TAC[GSYM HAS_MEASURE_MEASURE]]) in + let FUBINI_1 = prove + (`!f:real^(M,N)finite_sum->real^1. + f absolutely_integrable_on (:real^(M,N)finite_sum) + ==> negligible + {x | ~((f o pastecart x) absolutely_integrable_on (:real^N))} /\ + ((\x. integral (:real^N) (f o pastecart x)) has_integral + integral (:real^(M,N)finite_sum) f) (:real^M)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC + [`g = \x:real^(M,N)finite_sum. lift (max (&0) (drop(f x)))`; + `h = \x:real^(M,N)finite_sum. --(lift (min (&0) (drop(f x))))`] THEN + SUBGOAL_THEN `!x:real^(M,N)finite_sum. &0 <= drop(g x) /\ &0 <= drop(h x)` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN + REWRITE_TAC[DROP_NEG; LIFT_DROP] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(g:real^(M,N)finite_sum->real^1) absolutely_integrable_on UNIV /\ + (h:real^(M,N)finite_sum->real^1) absolutely_integrable_on UNIV` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN REWRITE_TAC[] THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NEG) THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MAX_1; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_MIN_1] THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX; LIFT_NUM] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0]; + ALL_TAC] THEN + SUBGOAL_THEN + `(f:real^(M,N)finite_sum->real^1) = \x. g x - h x` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["g"; "h"] THEN + REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; LIFT_DROP; DROP_SUB; DROP_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `h:real^(M,N)finite_sum->real^1` FUBINI_LEMMA) THEN + MP_TAC(ISPEC `g:real^(M,N)finite_sum->real^1` FUBINI_LEMMA) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + ONCE_REWRITE_TAC[TAUT + `p /\ q ==> r /\ s ==> t <=> p /\ r ==> q /\ s ==> t`] THEN + REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ; o_DEF] THEN DISCH_TAC THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + NEGLIGIBLE_SUBSET)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; GSYM DE_MORGAN_THM] THEN + REWRITE_TAC[CONTRAPOS_THM; o_DEF] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; IN_UNIV]; + ASM_SIMP_TAC[INTEGRAL_SUB; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] HAS_INTEGRAL_SPIKE))) THEN + FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN + SIMP_TAC[DE_MORGAN_THM; INTEGRAL_SUB]]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_COMPONENTWISE] THEN + REWRITE_TAC[GSYM IN_NUMSEG; lemma] THEN + MATCH_MP_TAC NEGLIGIBLE_UNIONS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG]; + DISCH_TAC THEN + ONCE_REWRITE_TAC[HAS_INTEGRAL_COMPONENTWISE]] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [ABSOLUTELY_INTEGRABLE_COMPONENTWISE]) THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_1) THEN SIMP_TAC[o_DEF] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] + HAS_INTEGRAL_SPIKE)) THEN + FIRST_ASSUM(fun th -> EXISTS_TAC(rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN + ASM_SIMP_TAC[LIFT_INTEGRAL_COMPONENT; + ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]);; + +let FUBINI_ABSOLUTELY_INTEGRABLE_ALT = prove + (`!f:real^(M,N)finite_sum->real^P. + f absolutely_integrable_on (:real^(M,N)finite_sum) + ==> negligible + {y | ~((\x. f(pastecart x y)) + absolutely_integrable_on (:real^M))} /\ + ((\y. integral (:real^M) (\x. f(pastecart x y))) has_integral + integral (:real^(M,N)finite_sum) f) (:real^N)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [GSYM ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV]) THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[INTEGRAL_PASTECART_SYM_UNIV]);; + +let FUBINI_INTEGRAL = prove + (`!f:real^(M,N)finite_sum->real^P. + f absolutely_integrable_on UNIV + ==> integral UNIV f = + integral UNIV (\x. integral UNIV (\y. f(pastecart x y)))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o CONJUNCT2 o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);; + +let FUBINI_INTEGRAL_ALT = prove + (`!f:real^(M,N)finite_sum->real^P. + f absolutely_integrable_on UNIV + ==> integral UNIV f = + integral UNIV (\y. integral UNIV (\x. f(pastecart x y)))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o CONJUNCT2 o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT) THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);; + +let FUBINI_INTEGRAL_INTERVAL = prove + (`!f:real^(M,N)finite_sum->real^P a b c d. + f absolutely_integrable_on interval[pastecart a c,pastecart b d] + ==> integral (interval[pastecart a c,pastecart b d]) f = + integral (interval[a,b]) + (\x. integral (interval[c,d]) + (\y. f(pastecart x y)))`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_INTEGRAL) THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[PASTECART_IN_PCROSS; GSYM PCROSS_INTERVAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[INTEGRAL_0] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; + +let FUBINI_INTEGRAL_INTERVAL_ALT = prove + (`!f:real^(M,N)finite_sum->real^P a b c d. + f absolutely_integrable_on interval[pastecart a c,pastecart b d] + ==> integral (interval[pastecart a c,pastecart b d]) f = + integral (interval[c,d]) + (\y. integral (interval[a,b]) + (\x. f(pastecart x y)))`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_INTEGRAL_ALT) THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[PASTECART_IN_PCROSS; GSYM PCROSS_INTERVAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[INTEGRAL_0] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; + +let INTEGRAL_PASTECART_CONTINUOUS = prove + (`!f:real^(M,N)finite_sum->real^P a b c d. + f continuous_on interval[pastecart a c,pastecart b d] + ==> integral (interval[pastecart a c,pastecart b d]) f = + integral (interval[a,b]) + (\x. integral (interval[c,d]) + (\y. f(pastecart x y)))`, + SIMP_TAC[FUBINI_INTEGRAL_INTERVAL; ABSOLUTELY_INTEGRABLE_CONTINUOUS]);; + +let INTEGRAL_SWAP_CONTINUOUS = prove + (`!f:real^M->real^N->real^P a b c d. + (\z. f (fstcart z) (sndcart z)) + continuous_on interval[pastecart a c,pastecart b d] + ==> integral (interval[a,b]) (\x. integral (interval[c,d]) (f x)) = + integral (interval[c,d]) + (\y. integral (interval[a,b]) (\x. f x y))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_CONTINUOUS) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(MATCH_MP FUBINI_INTEGRAL_INTERVAL_ALT th) THEN + MP_TAC(MATCH_MP FUBINI_INTEGRAL_INTERVAL th)) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[ETA_AX]);; + +let FUBINI_TONELLI = prove + (`!f:real^(M,N)finite_sum->real^P. + f measurable_on (:real^(M,N)finite_sum) + ==> (f absolutely_integrable_on (:real^(M,N)finite_sum) <=> + negligible + {x | ~((\y. f(pastecart x y)) absolutely_integrable_on (:real^N))} /\ + (\x. integral (:real^N) (\y. lift(norm(f(pastecart x y))))) + integrable_on (:real^M))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_ASSUM(ACCEPT_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE); + ALL_TAC] THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN ABBREV_TAC + `g = \n x. if x IN interval[--vec n,vec n] + then lift(min (norm ((f:real^(M,N)finite_sum->real^P) x)) (&n)) + else vec 0` THEN + SUBGOAL_THEN + `!n. (g:num->real^(M,N)finite_sum->real^1) n absolutely_integrable_on UNIV` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + REWRITE_TAC[IN_UNIV; DIMINDEX_1; FORALL_1] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; GSYM drop; LIFT_DROP; DROP_VEC] THEN + CONJ_TAC THENL [CONV_TAC NORM_ARITH; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CASES THEN + REWRITE_TAC[INTEGRABLE_0; IN_UNIV; SET_RULE `{x | x IN s} = s`] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x:real^(M,N)finite_sum. lift(&n)` THEN + REWRITE_TAC[INTEGRABLE_CONST; NORM_LIFT; LIFT_DROP] THEN + SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> abs(min x (&n)) <= &n`] THEN + MP_TAC(ISPECL + [`\x. lift(norm((f:real^(M,N)finite_sum->real^P) x))`; + `\x:real^(M,N)finite_sum. lift(&n)`; + `interval[--vec n:real^(M,N)finite_sum,vec n]`] MEASURABLE_ON_MIN) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^(M,N)finite_sum)` THEN + REWRITE_TAC[SUBSET_UNIV; LEBESGUE_MEASURABLE_INTERVAL] THEN + ASM_SIMP_TAC[MEASURABLE_ON_NORM; MEASURABLE_ON_CONST]; + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[DIMINDEX_1; LIFT_DROP; FORALL_1; GSYM drop]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g:num->real^(M,N)finite_sum->real^1`; + `\x. lift(norm((f:real^(M,N)finite_sum->real^P) x))`; + `(:real^(M,N)finite_sum)`] + MONOTONE_CONVERGENCE_INCREASING) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; IN_UNIV] THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN + REWRITE_TAC[REAL_LE_REFL; DROP_VEC; GSYM REAL_OF_NUM_SUC] THEN + TRY(CONV_TAC NORM_ARITH) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (TAUT `~p ==> p ==> q`)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + REWRITE_TAC[SUBSET_INTERVAL; VEC_COMPONENT; VECTOR_NEG_COMPONENT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REPEAT STRIP_TAC THEN + REAL_ARITH_TAC; + X_GEN_TAC `z:real^(M,N)finite_sum` THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + MP_TAC(ISPEC `&1 + max (norm z) (norm((f:real^(M,N)finite_sum->real^P) z))` + REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN REWRITE_TAC[] THEN COND_CASES_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[REAL_ARITH `min a b = a <=> a <= b`] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `~p ==> p ==> q`)) THEN + REWRITE_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN + REWRITE_TAC[GSYM REAL_ABS_BOUNDS] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x$i) <= norm(x:real^N) /\ norm x <= a ==> abs(x$i) <= a`) THEN + REWRITE_TAC[COMPONENT_LE_NORM] THEN ASM_REAL_ARITH_TAC]; + MP_TAC(GEN `n:num` (ISPEC `(g:num->real^(M,N)finite_sum->real^1) n` + FUBINI_ABSOLUTELY_INTEGRABLE)) THEN + ASM_REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[GSYM(MATCH_MP INTEGRAL_UNIQUE (SPEC `n:num` th))]) THEN + REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + EXISTS_TAC + `drop(integral (:real^M) + (\x. lift(norm(integral (:real^N) + (\y. lift(norm( + (f:real^(M,N)finite_sum->real^P) (pastecart x y))))))))` THEN + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL_AE THEN + EXISTS_TAC + `{x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y)) + absolutely_integrable_on (:real^N))} UNION + {x | ~((\y. (g:num->real^(M,N)finite_sum->real^1) n (pastecart x y)) + absolutely_integrable_on (:real^N))}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_UNION_EQ] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[integrable_on]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE THEN + EXISTS_TAC + `{x | ~((\y. (f:real^(M,N)finite_sum->real^P)(pastecart x y)) + absolutely_integrable_on (:real^N))}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[absolutely_integrable_on; GSYM drop] THEN + STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN + ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE]; + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM; DE_MORGAN_THM] THEN + STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(REAL_ARITH + `drop a <= norm a /\ x <= drop a==> x <= norm a`) THEN CONJ_TAC + THENL [REWRITE_TAC[drop; NORM_REAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + RULE_ASSUM_TAC(REWRITE_RULE[absolutely_integrable_on]) THEN + ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; IN_UNIV] THEN + X_GEN_TAC `y:real^N` THEN EXPAND_TAC "g" THEN + COND_CASES_TAC THEN REWRITE_TAC[NORM_0; NORM_POS_LE] THEN + REWRITE_TAC[NORM_LIFT] THEN CONV_TAC NORM_ARITH]]);; + +let FUBINI_TONELLI_ALT = prove + (`!f:real^(M,N)finite_sum->real^P. + f measurable_on (:real^(M,N)finite_sum) + ==> (f absolutely_integrable_on (:real^(M,N)finite_sum) <=> + negligible + {y | ~((\x. f(pastecart x y)) absolutely_integrable_on (:real^M))} /\ + (\y. integral (:real^M) (\x. lift(norm(f(pastecart x y))))) + integrable_on (:real^N))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `(f:real^(M,N)finite_sum->real^P) o (\z. pastecart (sndcart z) (fstcart z))` + FUBINI_TONELLI) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN o + snd) THEN + ASM_REWRITE_TAC[DIMINDEX_FINITE_SUM; ADD_SYM] THEN ANTS_TAC THENL + [SIMP_TAC[linear; FORALL_PASTECART; FSTCART_PASTECART; + SNDCART_PASTECART; PASTECART_INJ; + FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL] THEN + REWRITE_TAC[GSYM PASTECART_ADD; GSYM PASTECART_CMUL]; + DISCH_THEN SUBST1_TAC THEN POP_ASSUM MP_TAC THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[EXISTS_PASTECART; FORALL_PASTECART] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN MESON_TAC[]]; + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; o_DEF; + FSTCART_PASTECART; SNDCART_PASTECART]]);; diff --git a/Multivariate/misc.ml b/Multivariate/misc.ml new file mode 100644 index 0000000..18fc40c --- /dev/null +++ b/Multivariate/misc.ml @@ -0,0 +1,562 @@ +(* ========================================================================= *) +(* Various convenient background stuff. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +prioritize_real();; + +(* ------------------------------------------------------------------------- *) +(* A couple of extra tactics used in some proofs below. *) +(* ------------------------------------------------------------------------- *) + +let ASSERT_TAC tm = + SUBGOAL_THEN tm STRIP_ASSUME_TAC;; + +let EQ_TRANS_TAC tm = + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC tm THEN CONJ_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Miscellaneous lemmas. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_DIFF = prove + (`(?s:A->bool. P(UNIV DIFF s)) <=> (?s. P s)`, + MESON_TAC[prove(`UNIV DIFF (UNIV DIFF s) = s`,SET_TAC[])]);; + +let GE_REFL = prove + (`!n:num. n >= n`, + REWRITE_TAC[GE; LE_REFL]);; + +let FORALL_SUC = prove + (`(!n. ~(n = 0) ==> P n) <=> (!n. P(SUC n))`, + MESON_TAC[num_CASES; NOT_SUC]);; + +let SEQ_MONO_LEMMA = prove + (`!d e. (!n. n >= m ==> d(n) < e(n)) /\ (!n. n >= m ==> e(n) <= e(m)) + ==> !n:num. n >= m ==> d(n) < e(m)`, + MESON_TAC[GE; REAL_LTE_TRANS]);; + +let REAL_HALF = prove + (`(!e. &0 < e / &2 <=> &0 < e) /\ + (!e. e / &2 + e / &2 = e) /\ + (!e. &2 * (e / &2) = e)`, + REAL_ARITH_TAC);; + +let UPPER_BOUND_FINITE_SET = prove + (`!f:(A->num) s. FINITE(s) ==> ?a. !x. x IN s ==> f(x) <= a`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; + +let UPPER_BOUND_FINITE_SET_REAL = prove + (`!f:(A->real) s. FINITE(s) ==> ?a. !x. x IN s ==> f(x) <= a`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; + +let LOWER_BOUND_FINITE_SET = prove + (`!f:(A->num) s. FINITE(s) ==> ?a. !x. x IN s ==> a <= f(x)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; + +let LOWER_BOUND_FINITE_SET_REAL = prove + (`!f:(A->real) s. FINITE(s) ==> ?a. !x. x IN s ==> a <= f(x)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; + +let REAL_CONVEX_BOUND2_LT = prove + (`!x y a u v. x < a /\ y < b /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> u * x + v * y < u * a + v * b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN REPEAT STRIP_TAC; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_LT_IMP_LE]] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC);; + +let REAL_CONVEX_BOUND_LT = prove + (`!x y a u v. x < a /\ y < a /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> u * x + v * y < a`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `u * a + v * a:real` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_CONVEX_BOUND2_LT]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + UNDISCH_TAC `u + v = &1` THEN CONV_TAC REAL_RING]);; + +let REAL_CONVEX_BOUND_LE = prove + (`!x y a u v. x <= a /\ y <= a /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> u * x + v * y <= a`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(u + v) * a` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL; REAL_MUL_LID]] THEN + ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_LE_ADD2; REAL_LE_LMUL]);; + +let INFINITE_ENUMERATE_WEAK = prove + (`!s:num->bool. + INFINITE s + ==> ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ (!n. r n IN s)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP INFINITE_ENUMERATE) THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let APPROACHABLE_LT_LE = prove + (`!P f. (?d. &0 < d /\ !x. f(x) < d ==> P x) = + (?d. &0 < d /\ !x. f(x) <= d ==> P x)`, + let lemma = prove + (`&0 < d ==> x <= d / &2 ==> x < d`, + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN REAL_ARITH_TAC) in + MESON_TAC[REAL_LT_IMP_LE; lemma; REAL_HALF]);; + +let REAL_LE_BETWEEN = prove + (`!a b. a <= b <=> ?x. a <= x /\ x <= b`, + MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; + +let REAL_LET_BETWEEN = prove + (`!a b. a < b <=> (?x. a <= x /\ x < b)`, + MESON_TAC[REAL_LE_REFL; REAL_LET_TRANS]);; + +let REAL_LTE_BETWEEN = prove + (`!a b. a < b <=> (?x. a < x /\ x <= b)`, + MESON_TAC[REAL_LE_REFL; REAL_LTE_TRANS]);; + +let REAL_LT_BETWEEN = prove + (`!a b. a < b <=> ?x. a < x /\ x < b`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_TRANS]] THEN + DISCH_TAC THEN EXISTS_TAC `(a + b) / &2` THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let TRIANGLE_LEMMA = prove + (`!x y z. &0 <= x /\ &0 <= y /\ &0 <= z /\ x pow 2 <= y pow 2 + z pow 2 + ==> x <= y + z`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `(y + z) pow 2` THEN + ASM_SIMP_TAC[REAL_POW_LT2; REAL_LE_ADD; ARITH_EQ] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_2; REAL_ARITH + `x * x + y * y <= (x + y) * (x + y) <=> &0 <= x * y`]);; + +let LAMBDA_SKOLEM = prove + (`(!i. 1 <= i /\ i <= dimindex(:N) ==> ?x. P i x) = + (?x:A^N. !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i))`, + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `x:num->A`) THEN + EXISTS_TAC `(lambda i. x i):A^N` THEN ASM_SIMP_TAC[LAMBDA_BETA]; + DISCH_THEN(X_CHOOSE_TAC `x:A^N`) THEN + EXISTS_TAC `\i. (x:A^N)$i` THEN ASM_REWRITE_TAC[]]);; + +let LAMBDA_PAIR = prove + (`(\(x,y). P x y) = (\p. P (FST p) (SND p))`, + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[]);; + +let EPSILON_DELTA_MINIMAL = prove + (`!P:real->A->bool Q. + FINITE {x | Q x} /\ + (!d e x. Q x /\ &0 < e /\ e < d ==> P d x ==> P e x) /\ + (!x. Q x ==> ?d. &0 < d /\ P d x) + ==> ?d. &0 < d /\ !x. Q x ==> P d x`, + REWRITE_TAC[IMP_IMP] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `{x:A | Q x} = {}` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_ELIM_THM] THEN + DISCH_TAC THEN EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01]; + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_EXISTS_THM]) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:A->real` THEN DISCH_TAC THEN + EXISTS_TAC `inf(IMAGE d {x:A | Q x})` THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + X_GEN_TAC `a:A` THEN DISCH_TAC THEN + SUBGOAL_THEN + `&0 < inf(IMAGE d {x:A | Q x}) /\ inf(IMAGE d {x | Q x}) <= d a` + MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; + FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_LE_REFL]; + REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(d:A->real) a` THEN ASM_SIMP_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* A generic notion of "hull" (convex, affine, conic hull and closure). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("hull",(21,"left"));; + +let hull = new_definition + `P hull s = INTERS {t | P t /\ s SUBSET t}`;; + +let HULL_P = prove + (`!P s. P s ==> (P hull s = s)`, + REWRITE_TAC[hull; EXTENSION; IN_INTERS; IN_ELIM_THM] THEN + MESON_TAC[SUBSET]);; + +let P_HULL = prove + (`!P s. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) ==> P(P hull s)`, + REWRITE_TAC[hull] THEN SIMP_TAC[IN_ELIM_THM]);; + +let HULL_EQ = prove + (`!P s. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) + ==> ((P hull s = s) <=> P s)`, + MESON_TAC[P_HULL; HULL_P]);; + +let HULL_HULL = prove + (`!P s. P hull (P hull s) = P hull s`, + REWRITE_TAC[hull; EXTENSION; IN_INTERS; IN_ELIM_THM; SUBSET] THEN + MESON_TAC[]);; + +let HULL_SUBSET = prove + (`!P s. s SUBSET (P hull s)`, + REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; + +let HULL_MONO = prove + (`!P s t. s SUBSET t ==> (P hull s) SUBSET (P hull t)`, + REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; + +let HULL_ANTIMONO = prove + (`!P Q s. P SUBSET Q ==> (Q hull s) SUBSET (P hull s)`, + REWRITE_TAC[SUBSET; hull; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[IN]);; + +let HULL_MINIMAL = prove + (`!P s t. s SUBSET t /\ P t ==> (P hull s) SUBSET t`, + REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; + +let SUBSET_HULL = prove + (`!P s t. P t ==> ((P hull s) SUBSET t <=> s SUBSET t)`, + REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; + +let HULL_UNIQUE = prove + (`!P s t. s SUBSET t /\ P t /\ (!t'. s SUBSET t' /\ P t' ==> t SUBSET t') + ==> (P hull s = t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[hull; SUBSET; IN_INTERS; IN_ELIM_THM] THEN + ASM_MESON_TAC[SUBSET_HULL; SUBSET]);; + +let HULL_UNION_SUBSET = prove + (`!P s t. (P hull s) UNION (P hull t) SUBSET (P hull (s UNION t))`, + SIMP_TAC[UNION_SUBSET; HULL_MONO; SUBSET_UNION]);; + +let HULL_UNION = prove + (`!P s t. P hull (s UNION t) = P hull (P hull s UNION P hull t)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[hull] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; UNION_SUBSET] THEN + MESON_TAC[SUBSET_HULL]);; + +let HULL_UNION_LEFT = prove + (`!P s t:A->bool. + P hull (s UNION t) = P hull (P hull s UNION t)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[hull] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; UNION_SUBSET] THEN + MESON_TAC[SUBSET_HULL]);; + +let HULL_UNION_RIGHT = prove + (`!P s t:A->bool. + P hull (s UNION t) = P hull (s UNION P hull t)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[hull] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; UNION_SUBSET] THEN + MESON_TAC[SUBSET_HULL]);; + +let HULL_REDUNDANT_EQ = prove + (`!P a s. a IN (P hull s) <=> (P hull (a INSERT s) = P hull s)`, + REWRITE_TAC[hull] THEN SET_TAC[]);; + +let HULL_REDUNDANT = prove + (`!P a s. a IN (P hull s) ==> (P hull (a INSERT s) = P hull s)`, + REWRITE_TAC[HULL_REDUNDANT_EQ]);; + +let HULL_INDUCT = prove + (`!P p s. (!x:A. x IN s ==> p x) /\ P {x | p x} + ==> !x. x IN P hull s ==> p x`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`P:(A->bool)->bool`; `s:A->bool`; `{x:A | p x}`] + HULL_MINIMAL) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM]);; + +let HULL_INC = prove + (`!P s x. x IN s ==> x IN P hull s`, + MESON_TAC[REWRITE_RULE[SUBSET] HULL_SUBSET]);; + +let HULL_IMAGE_SUBSET = prove + (`!P f s. P(P hull s) /\ (!s. P s ==> P(IMAGE f s)) + ==> P hull (IMAGE f s) SUBSET (IMAGE f (P hull s))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[IMAGE_SUBSET; HULL_SUBSET]);; + +let HULL_IMAGE_GALOIS = prove + (`!P f g s. (!s. P(P hull s)) /\ + (!s. P s ==> P(IMAGE f s)) /\ (!s. P s ==> P(IMAGE g s)) /\ + (!s t. s SUBSET IMAGE g t <=> IMAGE f s SUBSET t) + ==> P hull (IMAGE f s) = IMAGE f (P hull s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[HULL_IMAGE_SUBSET] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[HULL_SUBSET]);; + +let HULL_IMAGE = prove + (`!P f s. (!s. P(P hull s)) /\ (!s. P(IMAGE f s) <=> P s) /\ + (!x y:A. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> P hull (IMAGE f s) = IMAGE f (P hull s)`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[BIJECTIVE_LEFT_RIGHT_INVERSE] THEN + DISCH_THEN(X_CHOOSE_THEN `g:A->A` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC HULL_IMAGE_GALOIS THEN EXISTS_TAC `g:A->A` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + X_GEN_TAC `s:A->bool` THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let IS_HULL = prove + (`!P s. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) + ==> (P s <=> ?t. s = P hull t)`, + MESON_TAC[HULL_P; P_HULL]);; + +let HULLS_EQ = prove + (`!P s t. + (!f. (!s. s IN f ==> P s) ==> P (INTERS f)) /\ + s SUBSET P hull t /\ t SUBSET P hull s + ==> P hull s = P hull t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[P_HULL]);; + +let HULL_P_AND_Q = prove + (`!P Q. (!f. (!s. s IN f ==> P s) ==> P(INTERS f)) /\ + (!f. (!s. s IN f ==> Q s) ==> Q(INTERS f)) /\ + (!s. Q s ==> Q(P hull s)) + ==> (\x. P x /\ Q x) hull s = P hull (Q hull s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HULL_UNIQUE THEN ASM_SIMP_TAC[HULL_INC; SUBSET_HULL] THEN + ASM_MESON_TAC[P_HULL; HULL_SUBSET; SUBSET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* More variants of the Archimedian property and useful consequences. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ARCH_INV = prove + (`!e. &0 < e <=> ?n. ~(n = 0) /\ &0 < inv(&n) /\ inv(&n) < e`, + GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_TRANS]] THEN + DISCH_TAC THEN MP_TAC(SPEC `inv(e)` REAL_ARCH_LT) THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[REAL_LT_INV2; REAL_INV_INV; REAL_LT_INV_EQ; REAL_LT_TRANS; + REAL_LT_ANTISYM]);; + +let REAL_POW_LBOUND = prove + (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH + `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; + +let REAL_ARCH_POW = prove + (`!x y. &1 < x ==> ?n. y < x pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 + &n * (x - &1)` THEN + ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN + ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH + `&1 < x ==> &0 <= x - &1`]);; + +let REAL_ARCH_POW2 = prove + (`!x. ?n. x < &2 pow n`, + SIMP_TAC[REAL_ARCH_POW; REAL_OF_NUM_LT; ARITH]);; + +let REAL_ARCH_POW_INV = prove + (`!x y. &0 < y /\ x < &1 ==> ?n. x pow n < y`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < x` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_POW_1; REAL_LET_TRANS; REAL_NOT_LT]] THEN + SUBGOAL_THEN `inv(&1) < inv(x)` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_INV2]; REWRITE_TAC[REAL_INV_1]] THEN + DISCH_THEN(MP_TAC o SPEC `inv(y)` o MATCH_MP REAL_ARCH_POW) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN + ASM_SIMP_TAC[GSYM REAL_POW_INV; REAL_LT_INV; REAL_LT_INV2]);; + +let FORALL_POS_MONO = prove + (`!P. (!d e. d < e /\ P d ==> P e) /\ (!n. ~(n = 0) ==> P(inv(&n))) + ==> !e. &0 < e ==> P e`, + MESON_TAC[REAL_ARCH_INV; REAL_LT_TRANS]);; + +let FORALL_POS_MONO_1 = prove + (`!P. (!d e. d < e /\ P d ==> P e) /\ (!n. P(inv(&n + &1))) + ==> !e. &0 < e ==> P e`, + REWRITE_TAC[REAL_OF_NUM_SUC; GSYM FORALL_SUC; FORALL_POS_MONO]);; + +let REAL_ARCH_RDIV_EQ_0 = prove + (`!x c. &0 <= x /\ &0 <= c /\ (!m. 0 < m ==> &m * x <= c) ==> x = &0`, + SIMP_TAC [GSYM REAL_LE_ANTISYM; GSYM REAL_NOT_LT] THEN REPEAT STRIP_TAC THEN + POP_ASSUM (STRIP_ASSUME_TAC o SPEC `c:real` o MATCH_MP REAL_ARCH) THEN + ASM_CASES_TAC `n=0` THENL + [POP_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC (REWRITE_RULE [REAL_MUL_LZERO]) THEN + ASM_MESON_TAC [REAL_LET_ANTISYM]; + ASM_MESON_TAC [REAL_LET_ANTISYM; REAL_MUL_SYM; LT_NZ]]);; + +(* ------------------------------------------------------------------------- *) +(* Relate max and min to sup and inf. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MAX_SUP = prove + (`!x y. max x y = sup {x,y}`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_SUP_LE_FINITE; REAL_LE_SUP_FINITE; + FINITE_RULES; NOT_INSERT_EMPTY; REAL_MAX_LE; REAL_LE_MAX] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LE_TOTAL]);; + +let REAL_MIN_INF = prove + (`!x y. min x y = inf {x,y}`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_INF_LE_FINITE; REAL_LE_INF_FINITE; + FINITE_RULES; NOT_INSERT_EMPTY; REAL_MIN_LE; REAL_LE_MIN] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LE_TOTAL]);; + +(* ------------------------------------------------------------------------- *) +(* Define square root here to decouple it from the existing analysis theory. *) +(* We totalize by making sqrt(-x) = -sqrt(x), which looks rather unnatural *) +(* but allows many convenient properties to be used without sideconditions. *) +(* ------------------------------------------------------------------------- *) + +let sqrt = new_definition + `sqrt(x) = @y. real_sgn y = real_sgn x /\ y pow 2 = abs x`;; + +let SQRT_UNIQUE = prove + (`!x y. &0 <= y /\ y pow 2 = x ==> sqrt(x) = y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[sqrt] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_SGN_POW_2; REAL_ABS_POW] THEN + X_GEN_TAC `z:real` THEN ASM_REWRITE_TAC[real_abs] THEN + REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x:real = y \/ x = --y`] THEN + REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC);; + +let POW_2_SQRT = prove + (`!x. &0 <= x ==> sqrt(x pow 2) = x`, + MESON_TAC[SQRT_UNIQUE]);; + +let SQRT_0 = prove + (`sqrt(&0) = &0`, + MESON_TAC[SQRT_UNIQUE; REAL_POW_2; REAL_MUL_LZERO; REAL_POS]);; + +let SQRT_1 = prove + (`sqrt(&1) = &1`, + MESON_TAC[SQRT_UNIQUE; REAL_POW_2; REAL_MUL_LID; REAL_POS]);; + +let POW_2_SQRT_ABS = prove + (`!x. sqrt(x pow 2) = abs(x)`, + GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE THEN + REWRITE_TAC[REAL_ABS_POS; REAL_POW_2; GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[real_abs; REAL_LE_SQUARE]);; + +(* ------------------------------------------------------------------------- *) +(* Geometric progression. *) +(* ------------------------------------------------------------------------- *) + +let SUM_GP_BASIC = prove + (`!x n. (&1 - x) * sum(0..n) (\i. x pow i) = &1 - x pow (SUC n)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[real_pow; REAL_MUL_RID; LE_0] THEN + ASM_REWRITE_TAC[REAL_ADD_LDISTRIB; real_pow] THEN REAL_ARITH_TAC);; + +let SUM_GP_MULTIPLIED = prove + (`!x m n. m <= n + ==> ((&1 - x) * sum(m..n) (\i. x pow i) = x pow m - x pow (SUC n))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC + [SUM_OFFSET_0; REAL_POW_ADD; REAL_MUL_ASSOC; SUM_GP_BASIC; SUM_RMUL] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; GSYM REAL_POW_ADD; REAL_MUL_LID] THEN + ASM_SIMP_TAC[ARITH_RULE `m <= n ==> (SUC(n - m) + m = SUC n)`]);; + +let SUM_GP = prove + (`!x m n. + sum(m..n) (\i. x pow i) = + if n < m then &0 + else if x = &1 then &((n + 1) - m) + else (x pow m - x pow (SUC n)) / (&1 - x)`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(ARITH_RULE `n < m \/ ~(n < m) /\ m <= n:num`) THEN + ASM_SIMP_TAC[SUM_TRIV_NUMSEG] THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[REAL_POW_ONE; SUM_CONST_NUMSEG; REAL_MUL_RID]; ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&1 - x` THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_SUB_0; SUM_GP_MULTIPLIED]);; + +let SUM_GP_OFFSET = prove + (`!x m n. sum(m..m+n) (\i. x pow i) = + if x = &1 then &n + &1 + else x pow m * (&1 - x pow (SUC n)) / (&1 - x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUM_GP; ARITH_RULE `~(m + n < m:num)`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[REAL_OF_NUM_ADD] THEN AP_TERM_TAC THEN ARITH_TAC; + REWRITE_TAC[real_div; real_pow; REAL_POW_ADD] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Segment of natural numbers starting at a specific number. *) +(* ------------------------------------------------------------------------- *) + +let from = new_definition + `from n = {m:num | n <= m}`;; + +let FROM_0 = prove + (`from 0 = (:num)`, + REWRITE_TAC[from; LE_0] THEN SET_TAC[]);; + +let IN_FROM = prove + (`!m n. m IN from n <=> n <= m`, + REWRITE_TAC[from; IN_ELIM_THM]);; + +let FROM_INTER_NUMSEG_GEN = prove + (`!k m n. (from k) INTER (m..n) = (if m < k then k..n else m..n)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[from; IN_ELIM_THM; IN_INTER; IN_NUMSEG; EXTENSION] THEN + ARITH_TAC);; + +let FROM_INTER_NUMSEG_MAX = prove + (`!m n p. from p INTER (m..n) = (MAX p m..n)`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; IN_FROM] THEN ARITH_TAC);; + +let FROM_INTER_NUMSEG = prove + (`!k n. (from k) INTER (0..n) = k..n`, + REWRITE_TAC[from; IN_ELIM_THM; IN_INTER; IN_NUMSEG; EXTENSION] THEN + ARITH_TAC);; + +let INFINITE_FROM = prove + (`!n. INFINITE(from n)`, + GEN_TAC THEN + SUBGOAL_THEN `from n = (:num) DIFF {i | i < n}` + (fun th -> SIMP_TAC[th; INFINITE_DIFF_FINITE; FINITE_NUMSEG_LT; + num_INFINITE]) THEN + REWRITE_TAC[EXTENSION; from; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Make a Horner-style evaluation of sum(m..n) (\k. a(k) * x pow k). *) +(* ------------------------------------------------------------------------- *) + +let HORNER_SUM_CONV = + let horner_0,horner_s = (CONJ_PAIR o prove) + (`(sum(0..0) (\i. c(i) * x pow i) = c 0) /\ + (sum(0..SUC n) (\i. c(i) * x pow i) = + c(0) + x * sum(0..n) (\i. c(i+1) * x pow i))`, + REWRITE_TAC[CONJUNCT1 SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x * c * y:real = c * x * y`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow); ADD1] THEN + REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_pow; REAL_MUL_RID]) in + let conv_0 = GEN_REWRITE_CONV I [horner_0] THENC NUM_REDUCE_CONV + and conv_s = LAND_CONV(RAND_CONV(num_CONV)) THENC + GEN_REWRITE_CONV I [horner_s] THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV [LEFT_ADD_DISTRIB] THENC + GEN_REWRITE_CONV TOP_DEPTH_CONV [GSYM ADD_ASSOC] THENC + NUM_REDUCE_CONV in + let rec conv tm = + try (conv_0 THENC REAL_RAT_REDUCE_CONV) tm with Failure _ -> + (conv_s THENC RAND_CONV(RAND_CONV conv) THENC REAL_RAT_REDUCE_CONV) tm in + conv;; diff --git a/Multivariate/moretop.ml b/Multivariate/moretop.ml new file mode 100644 index 0000000..0292013 --- /dev/null +++ b/Multivariate/moretop.ml @@ -0,0 +1,7349 @@ +(* ========================================================================= *) +(* Additional topology theory. *) +(* *) +(* (c) Copyright, John Harrison 1998-2013 *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* Injective map into R is also an open map w.r.t. the universe, and this *) +(* is actually an implication in both directions for an interval. Compare *) +(* the local form in INJECTIVE_INTO_1D_IMP_OPEN_MAP (not a bi-implication). *) +(* ------------------------------------------------------------------------- *) + +let INJECTIVE_EQ_1D_OPEN_MAP_UNIV = prove + (`!f:real^1->real^1 s. + f continuous_on s /\ is_interval s + ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> + (!t. open t /\ t SUBSET s ==> open(IMAGE f t)))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^1`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[BALL_1] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (f:real^1->real^1) + (segment (x - lift d,x + lift d))` THEN + MP_TAC(ISPECL + [`f:real^1->real^1`; `x - lift d`; `x + lift d`] + CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1) THEN + REWRITE_TAC[SEGMENT_1; DROP_ADD; DROP_SUB; LIFT_DROP] THEN + ASM_CASES_TAC `drop x - d <= drop x + d` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM SEGMENT_1]; + ASM_REAL_ARITH_TAC] THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC[OPEN_SEGMENT_1]; + MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_TRANS]]; + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `x:real^1`; `y:real^1`] + CONTINUOUS_IVT_LOCAL_EXTREMUM) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT_EQ; IS_INTERVAL_CONVEX_1; + CONTINUOUS_ON_SUBSET]; + DISCH_THEN(X_CHOOSE_TAC `z:real^1`) THEN + FIRST_ASSUM(MP_TAC o SPEC `segment(x:real^1,y)`) THEN + REWRITE_TAC[OPEN_SEGMENT_1; NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; IS_INTERVAL_CONVEX_1; + SUBSET_TRANS; SEGMENT_OPEN_SUBSET_CLOSED]; + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `z:real^1`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z + lift(e / &2)`); + DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) z - lift(e / &2)`)] THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(a + b:real^N,a) = norm b`; + NORM_ARITH `dist(a - b:real^N,a) = norm b`; NORM_LIFT; + REAL_ARITH `abs(e / &2) < e <=> &0 < e`] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^1` (STRIP_ASSUME_TAC o GSYM)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:real^1`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] SEGMENT_OPEN_SUBSET_CLOSED] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]]]);; + +(* ------------------------------------------------------------------------- *) +(* Map f:S^m->S^n for m < n is nullhomotopic. *) +(* ------------------------------------------------------------------------- *) + +let INESSENTIAL_SPHEREMAP_LOWDIM_GEN = prove + (`!f:real^M->real^N s t. + convex s /\ bounded s /\ convex t /\ bounded t /\ aff_dim s < aff_dim t /\ + f continuous_on relative_frontier s /\ + IMAGE f (relative_frontier s) SUBSET (relative_frontier t) + ==> ?c. homotopic_with (\z. T) + (relative_frontier s,relative_frontier t) f (\x. c)`, + let lemma1 = prove + (`!f:real^N->real^N s t. + subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\ + f differentiable_on sphere(vec 0,&1) INTER s + ==> ~(IMAGE f (sphere(vec 0,&1) INTER s) = sphere(vec 0,&1) INTER t)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC + `(g:real^N->real^N) = + \x. norm(x) % (f:real^N->real^N)(inv(norm x) % x)` THEN + SUBGOAL_THEN + `(g:real^N->real^N) differentiable_on s DELETE (vec 0)` + ASSUME_TAC THENL + [EXPAND_TAC "g" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN + SIMP_TAC[o_DEF; DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN + REWRITE_TAC[DIFFERENTIABLE_ON_ID] THEN + SUBGOAL_THEN + `lift o (\x:real^N. inv(norm x)) = + (lift o inv o drop) o (\x. lift(norm x))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN + SIMP_TAC[DIFFERENTIABLE_ON_NORM; IN_DELETE] THEN + MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN + SIMP_TAC[FORALL_IN_IMAGE; IN_DELETE; GSYM REAL_DIFFERENTIABLE_AT] THEN + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN + ASM_REWRITE_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + DIFFERENTIABLE_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_INTER; + SUBSPACE_MUL; NORM_MUL; IN_DELETE] THEN + SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (g:real^N->real^N) (s DELETE vec 0) = t DELETE (vec 0)` + ASSUME_TAC THENL + [UNDISCH_TAC `IMAGE (f:real^N->real^N) (sphere (vec 0,&1) INTER s) = + sphere (vec 0,&1) INTER t` THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; + IN_INTER; IN_SPHERE_0] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[IN_IMAGE; IN_INTER; IN_SPHERE_0] THEN + SIMP_TAC[IN_DELETE; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN + MATCH_MP_TAC(TAUT + `(p ==> r) /\ (p ==> q ==> s) ==> p /\ q ==> r /\ s`) THEN + CONJ_TAC THENL [ALL_TAC; DISCH_TAC] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + MP_TAC(SPEC `inv(norm x) % x:real^N` th)) THEN + ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; + REAL_MUL_LINV; NORM_EQ_0; + NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `norm(x:real^N) % y:real^N` THEN + ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_NORM; REAL_MUL_RID] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_MUL_EQ_0; NORM_EQ_0] THEN + ASM_SIMP_TAC[NORM_ARITH `norm x = &1 ==> ~(x:real^N = vec 0)`] THEN + UNDISCH_THEN `inv(norm x) % x = (f:real^N->real^N) y` + (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0] THEN + REWRITE_TAC[VECTOR_MUL_LID]; + ALL_TAC] THEN + MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] + DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; DIM_UNIV; IN_UNIV; SUBSET_UNIV] THEN + ABBREV_TAC `t' = {y:real^N | !x. x IN t ==> orthogonal x y}` THEN + DISCH_TAC THEN + SUBGOAL_THEN `subspace(t':real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "t'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS]; + ALL_TAC] THEN + SUBGOAL_THEN + `?fst snd. linear fst /\ linear snd /\ + (!z. fst(z) IN t /\ snd z IN t' /\ fst z + snd z = z) /\ + (!x y:real^N. x IN t /\ y IN t' + ==> fst(x + y) = x /\ snd(x + y) = y)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `t:real^N->bool` ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN + REWRITE_TAC[SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `fst:real^N->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `snd:real^N->real^N` THEN + DISCH_THEN(MP_TAC o GSYM) THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE; FORALL_AND_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q /\ s) ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL + [EXPAND_TAC "t'" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[ORTHOGONAL_SYM]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `r /\ (r ==> p /\ q) ==> p /\ q /\ r`) THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN ASM SET_TAC[]; + DISCH_TAC] THEN + REWRITE_TAC[linear] THEN + MATCH_MP_TAC(TAUT `(p /\ r) /\ (q /\ s) ==> (p /\ q) /\ (r /\ s)`) THEN + REWRITE_TAC[AND_FORALL_THM] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `t':real^N->bool`] THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE; SUBSPACE_ADD; SUBSPACE_MUL] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + ASM_REWRITE_TAC[GSYM VECTOR_ADD_LDISTRIB] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x:real^N. (g:real^N->real^N)(fst x) + snd x`; + `{x + y:real^N | x IN (s DELETE vec 0) /\ y IN t'}`] + NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE) THEN + REWRITE_TAC[LE_REFL; NOT_IMP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t':real^N->bool`] DIM_SUMS_INTER) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `t' + t = n ==> s < t /\ d' <= d /\ i = 0 + ==> d + i = s + t' ==> d' < n`)) THEN + ASM_REWRITE_TAC[DIM_EQ_0] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIM_SUBSET THEN SET_TAC[]; EXPAND_TAC "t'"] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_SING; IN_ELIM_THM] THEN + ASM_MESON_TAC[SUBSET; ORTHOGONAL_REFL]; + MATCH_MP_TAC DIFFERENTIABLE_ON_ADD THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_LINEAR] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + DIFFERENTIABLE_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[IN_DELETE]; + SUBGOAL_THEN + `~negligible {x + y | x IN IMAGE (g:real^N->real^N) (s DELETE vec 0) /\ + y IN t'}` + MP_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `negligible(t':real^N->bool)` MP_TAC THENL + [MATCH_MP_TAC NEGLIGIBLE_LOWDIM THEN ASM_ARITH_TAC; + REWRITE_TAC[TAUT `p ==> ~q <=> ~(p /\ q)`]] THEN + REWRITE_TAC[GSYM NEGLIGIBLE_UNION_EQ] THEN + MP_TAC NOT_NEGLIGIBLE_UNIV THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM; IN_DELETE] THEN + X_GEN_TAC `z:real^N` THEN + REWRITE_TAC[TAUT `p \/ q <=> ~p ==> q`] THEN DISCH_TAC THEN + EXISTS_TAC `(fst:real^N->real^N) z` THEN + EXISTS_TAC `(snd:real^N->real^N) z` THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[VECTOR_ADD_LID]; + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_IMAGE; IN_DELETE] THEN + X_GEN_TAC `x:real^N` THEN REPEAT DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x + y:real^N` THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN ASM + SET_TAC[]]]) in + let lemma2 = prove + (`!f:real^N->real^N s t. + subspace s /\ subspace t /\ dim s < dim t /\ s SUBSET t /\ + f continuous_on sphere(vec 0,&1) INTER s /\ + IMAGE f (sphere(vec 0,&1) INTER s) SUBSET sphere(vec 0,&1) INTER t + ==> ?c. homotopic_with (\x. T) + (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t) + f (\x. c)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `sphere(vec 0:real^N,&1) INTER s`; + `&1 / &2`; `t:real^N->bool`;] + STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_SPHERE; CLOSED_SUBSPACE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!x. x IN sphere(vec 0,&1) INTER s ==> ~((g:real^N->real^N) x = vec 0)` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_SPHERE_0]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN + CONV_TAC NORM_ARITH; + ALL_TAC] THEN + SUBGOAL_THEN `(g:real^N->real^N) differentiable_on + sphere(vec 0,&1) INTER s` + ASSUME_TAC THENL + [ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION]; ALL_TAC] THEN + ABBREV_TAC `(h:real^N->real^N) = \x. inv(norm(g x)) % g x` THEN + SUBGOAL_THEN + `!x. x IN sphere(vec 0,&1) INTER s + ==> (h:real^N->real^N) x IN sphere(vec 0,&1) INTER t` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN + ASM_SIMP_TAC[SUBSPACE_MUL; IN_INTER; IN_SPHERE_0; NORM_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; GSYM IN_SPHERE_0]; + ALL_TAC] THEN + SUBGOAL_THEN + `(h:real^N->real^N) differentiable_on sphere(vec 0,&1) INTER s` + ASSUME_TAC THENL + [EXPAND_TAC "h" THEN MATCH_MP_TAC DIFFERENTIABLE_ON_MUL THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION; o_DEF] THEN + SUBGOAL_THEN + `(\x. lift(inv(norm((g:real^N->real^N) x)))) = + (lift o inv o drop) o (\x. lift(norm x)) o (g:real^N->real^N)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_ON_COMPOSE THEN + ASM_SIMP_TAC[DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN + MATCH_MP_TAC DIFFERENTIABLE_ON_NORM THEN + ASM_REWRITE_TAC[SET_RULE + `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`]; + MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN + REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE_0] THEN + X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_DIFFERENTIABLE_AT; o_THM] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_INV_ATREAL THEN + ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ID; NORM_EQ_0; IN_SPHERE_0]]; + ALL_TAC] THEN + SUBGOAL_THEN + `?c. homotopic_with (\z. T) + (sphere(vec 0,&1) INTER s,sphere(vec 0,&1) INTER t) + (h:real^N->real^N) (\x. c)` + MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN + SUBGOAL_THEN + `homotopic_with (\z. T) + (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N)) + f g` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN + ASM_SIMP_TAC[CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE + `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX] THEN ASM SET_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP SEGMENT_BOUND) THEN + SUBGOAL_THEN + `(f:real^N->real^N) x IN sphere(vec 0,&1) /\ + norm(f x - g x) < &1/ &2` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_SPHERE_0] THEN CONV_TAC NORM_ARITH]; + DISCH_THEN(MP_TAC o + ISPECL [`\y:real^N. inv(norm y) % y`; + `sphere(vec 0:real^N,&1) INTER t`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN + ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN + ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN + SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE + [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN + ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; + REAL_INV_1; VECTOR_MUL_LID]]]] THEN + SUBGOAL_THEN + `?c. c IN (sphere(vec 0,&1) INTER t) DIFF + (IMAGE (h:real^N->real^N) (sphere(vec 0,&1) INTER s))` + MP_TAC THENL + [MATCH_MP_TAC(SET_RULE + `t SUBSET s /\ ~(t = s) ==> ?a. a IN s DIFF t`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC lemma1] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER; IN_DIFF; IN_IMAGE] THEN + REWRITE_TAC[SET_RULE + `~(?x. P x /\ x IN s /\ x IN t) <=> + (!x. x IN s INTER t ==> ~(P x))`] THEN + X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN + EXISTS_TAC `--c:real^N` THEN + SUBGOAL_THEN + `homotopic_with (\z. T) + (sphere(vec 0:real^N,&1) INTER s,t DELETE (vec 0:real^N)) + h (\x. --c)` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN + ASM_SIMP_TAC[DIFFERENTIABLE_IMP_CONTINUOUS_ON; CONTINUOUS_ON_CONST] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SET_RULE + `s SUBSET t DELETE v <=> s SUBSET t /\ ~(v IN s)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[SUBSPACE_IMP_CONVEX; INSERT_SUBSET; SUBSPACE_NEG] THEN + ASM SET_TAC[]; + DISCH_TAC THEN MP_TAC(ISPECL + [`(h:real^N->real^N) x`; `vec 0:real^N`; `--c:real^N`] + MIDPOINT_BETWEEN) THEN + ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; DIST_0; NORM_NEG] THEN + SUBGOAL_THEN `((h:real^N->real^N) x) IN sphere(vec 0,&1) /\ + (c:real^N) IN sphere(vec 0,&1)` + MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_SPHERE_0]] THEN + STRIP_TAC THEN REWRITE_TAC[midpoint; VECTOR_ARITH + `vec 0:real^N = inv(&2) % (x + --y) <=> x = y`] THEN + ASM SET_TAC[]]; + DISCH_THEN(MP_TAC o + ISPECL [`\y:real^N. inv(norm y) % y`; + `sphere(vec 0:real^N,&1) INTER t`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN + ASM_REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[IN_DELETE; NORM_EQ_0] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_NORM]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_INTER] THEN + ASM_SIMP_TAC[SUBSPACE_MUL; IN_SPHERE_0; NORM_MUL; REAL_ABS_MUL] THEN + SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0]]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE + [SUBSET; IN_INTER; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN + ASM_SIMP_TAC[IN_SPHERE_0; IN_INTER; REAL_INV_1; VECTOR_MUL_LID; + NORM_NEG]]]) in + let lemma3 = prove + (`!s:real^M->bool u:real^N->bool. + bounded s /\ convex s /\ subspace u /\ aff_dim s <= &(dim u) + ==> ?t. subspace t /\ t SUBSET u /\ + (~(s = {}) ==> aff_dim t = aff_dim s) /\ + (relative_frontier s) homeomorphic + (sphere(vec 0,&1) INTER t)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL + [STRIP_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN + ASM_REWRITE_TAC[SUBSPACE_TRIVIAL; RELATIVE_FRONTIER_EMPTY] THEN + ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY; + SET_RULE `s INTER {a} = {} <=> ~(a IN s)`; + IN_SPHERE_0; NORM_0; SING_SUBSET; SUBSPACE_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` MP_TAC o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + GEOM_ORIGIN_TAC `a:real^M` THEN + SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LE; GSYM DIM_UNIV] THEN + REPEAT STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE; AFF_DIM_DIM_SUBSPACE; INT_OF_NUM_EQ] THEN + STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS + `relative_frontier(ball(vec 0:real^N,&1) INTER t)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS THEN + ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; + SUBSPACE_IMP_CONVEX; CONVEX_BALL] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_0) THEN + SUBGOAL_THEN `~(t INTER ball(vec 0:real^N,&1) = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 0:real^N` THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01]; + ASM_SIMP_TAC[AFF_DIM_CONVEX_INTER_OPEN; OPEN_BALL; + SUBSPACE_IMP_CONVEX] THEN + ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]]; + MATCH_MP_TAC(MESON[HOMEOMORPHIC_REFL] `s = t ==> s homeomorphic t`) THEN + SIMP_TAC[GSYM FRONTIER_BALL; REAL_LT_01] THEN + MATCH_MP_TAC RELATIVE_FRONTIER_CONVEX_INTER_AFFINE THEN + ASM_SIMP_TAC[CONVEX_BALL; SUBSPACE_IMP_AFFINE; + GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `vec 0:real^N` THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; INTERIOR_OPEN; OPEN_BALL; + SUBSPACE_0; IN_INTER; REAL_LT_01]]) in + ONCE_REWRITE_TAC[MESON[] `(!a b c. P a b c) <=> (!b c a. P a b c)`] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_SIMP_TAC[HOMOTOPIC_WITH; RELATIVE_FRONTIER_EMPTY; PCROSS_EMPTY; + NOT_IN_EMPTY; IMAGE_CLAUSES; CONTINUOUS_ON_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; GSYM INT_NOT_LE; AFF_DIM_GE] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`t:real^N->bool`; `(:real^N)`] lemma3) THEN + ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV; AFF_DIM_LE_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `t':real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP + HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL th]) THEN + MP_TAC(ISPECL [`s:real^M->bool`; `t':real^N->bool`] lemma3) THEN + ASM_SIMP_TAC[GSYM AFF_DIM_DIM_SUBSPACE] THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `s':real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT) THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP + HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL th]) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma2 THEN + ASM_SIMP_TAC[GSYM INT_OF_NUM_LT; GSYM AFF_DIM_DIM_SUBSPACE] THEN + ASM_INT_ARITH_TAC);; + +let INESSENTIAL_SPHEREMAP_LOWDIM = prove + (`!f:real^M->real^N a r b s. + dimindex(:M) < dimindex(:N) /\ + f continuous_on sphere(a,r) /\ + IMAGE f (sphere(a,r)) SUBSET (sphere(b,s)) + ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s <= &0` THEN + ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN + ASM_CASES_TAC `r <= &0` THEN + ASM_SIMP_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN + ASM_SIMP_TAC[GSYM FRONTIER_CBALL; INTERIOR_CBALL; BALL_EQ_EMPTY; + CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL + RELATIVE_FRONTIER_NONEMPTY_INTERIOR)] THEN + STRIP_TAC THEN MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LE; INT_OF_NUM_LT]);; + +let HOMEOMORPHIC_SPHERES_EQ,HOMOTOPY_EQUIVALENT_SPHERES_EQ = + (CONJ_PAIR o prove) + (`(!a:real^M b:real^N r s. + sphere(a,r) homeomorphic sphere(b,s) <=> + r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/ + &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)) /\ + (!a:real^M b:real^N r s. + sphere(a,r) homotopy_equivalent sphere(b,s) <=> + r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/ + &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N))`, + let lemma = prove + (`!a:real^M r b:real^N s. + dimindex(:M) < dimindex(:N) /\ &0 < r /\ &0 < s + ==> ~(sphere(a,r) homotopy_equivalent sphere(b,s))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `sphere(a:real^M,r)` o + MATCH_MP HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY) THEN + MATCH_MP_TAC(TAUT `~p /\ q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL + [SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL + [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `c:real^M` THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPECL[`\a:real^M. a`; `(\a. c):real^M->real^M`]) THEN + SIMP_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; + IMAGE_ID; SUBSET_REFL] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(contractible(sphere(a:real^M,r)))` MP_TAC THENL + [REWRITE_TAC[CONTRACTIBLE_SPHERE] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[contractible] THEN MESON_TAC[]]; + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPEC `g:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN + MP_TAC(ISPEC `f:real^M->real^N` INESSENTIAL_SPHEREMAP_LOWDIM) THEN + ASM_REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN DISCH_THEN + (MP_TAC o SPECL [`a:real^M`; `r:real`; `b:real^N`; `s:real`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ; RIGHT_IMP_FORALL_THM] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP] THEN DISCH_THEN + (fun th -> CONJUNCTS_THEN (ASSUME_TAC o MATCH_MP + HOMOTOPIC_WITH_IMP_SUBSET) th THEN + MP_TAC th) THEN + MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM] + `homotopic_with p (s,t) c d + ==> homotopic_with p (s,t) f c /\ + homotopic_with p (s,t) g d + ==> homotopic_with p (s,t) f g`) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN + MP_TAC(ISPECL [`b:real^N`; `s:real`] PATH_CONNECTED_SPHERE) THEN + ANTS_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `m < n ==> 1 <= m ==> 2 <= n`)) THEN REWRITE_TAC[DIMINDEX_GE_1]; + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + DISCH_THEN MATCH_MP_TAC THEN + SUBGOAL_THEN `~(sphere(a:real^M,r) = {})` MP_TAC THENL + [REWRITE_TAC[SPHERE_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + ASM SET_TAC[]]]]) in + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC(TAUT + `(r ==> p) /\ (q ==> r) /\ (p ==> q) ==> (r <=> q) /\ (p <=> q)`) THEN + REWRITE_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT] THEN + ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY; + HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY] + THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `s < &0` THEN + ASM_SIMP_TAC[SPHERE_EMPTY; SPHERE_EQ_EMPTY; + HOMEOMORPHIC_EMPTY; HOMOTOPY_EQUIVALENT_EMPTY] + THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING; + HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE; + ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM] + HOMOTOPY_EQUIVALENT_SING] + THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `s = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; REAL_LT_REFL; HOMEOMORPHIC_SING; + HOMOTOPY_EQUIVALENT_SING; CONTRACTIBLE_SPHERE; + ONCE_REWRITE_RULE[HOMOTOPY_EQUIVALENT_SYM] + HOMOTOPY_EQUIVALENT_SING] + THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < r /\ &0 < s` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + CONJ_TAC THENL + [DISCH_THEN(fun th -> + let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in + MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[ARITH_RULE `~(m:num = n) <=> m < n \/ n < m`] THEN + STRIP_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM]] THEN + ASM_SIMP_TAC[lemma]]);; + +let SIMPLY_CONNECTED_SPHERE_GEN = prove + (`!s. convex s /\ bounded s /\ &3 <= aff_dim s + ==> simply_connected(relative_frontier s)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP; + PATH_CONNECTED_SPHERE_GEN; + INT_ARITH `&3:int <= x ==> ~(x = &1)`] THEN + SUBGOAL_THEN `sphere(vec 0:real^2,&1) = relative_frontier(cball(vec 0,&1))` + SUBST1_TAC THENL + [REWRITE_TAC[RELATIVE_FRONTIER_CBALL; REAL_OF_NUM_EQ; ARITH]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN + REWRITE_TAC[DIMINDEX_2; REAL_LT_01] THEN ASM_INT_ARITH_TAC);; + +let SIMPLY_CONNECTED_SPHERE = prove + (`!a:real^N r. 3 <= dimindex(:N) ==> simply_connected(sphere(a,r))`, + REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) THEN + ASM_SIMP_TAC[SPHERE_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN + ASM_SIMP_TAC[SPHERE_SING; CONVEX_SING; CONVEX_IMP_SIMPLY_CONNECTED] THEN + MP_TAC(ISPEC `cball(a:real^N,r)` SIMPLY_CONNECTED_SPHERE_GEN) THEN + ASM_SIMP_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL; CONVEX_CBALL; + BOUNDED_CBALL; REAL_LT_IMP_NE; INT_OF_NUM_LE]);; + +let SIMPLY_CONNECTED_PUNCTURED_CONVEX = prove + (`!s a:real^N. + convex s /\ &3 <= aff_dim s ==> simply_connected(s DELETE a)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN relative_interior s` THENL + [ALL_TAC; + MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN + MATCH_MP_TAC CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR_CBALL]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC)) THEN + MP_TAC(ISPECL + [`cball(a:real^N,e) INTER affine hull s`; `s:real^N->bool`; `a:real^N`] + HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX) THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(MESON[HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS] + `simply_connected s + ==> s homotopy_equivalent t ==> simply_connected t`) THEN + MATCH_MP_TAC SIMPLY_CONNECTED_SPHERE_GEN] THEN + ASM_SIMP_TAC[CONVEX_INTER; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX; + CONVEX_CBALL; BOUNDED_INTER; BOUNDED_CBALL] THEN + REPEAT CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_INTERIOR_CONVEX_INTER_AFFINE o + rand o snd) THEN + REWRITE_TAC[CONVEX_CBALL; AFFINE_AFFINE_HULL; INTERIOR_CBALL] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_SIMP_TAC[CENTRE_IN_BALL] THEN + ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[CENTRE_IN_BALL; IN_INTER]] THEN + ASM_MESON_TAC[SUBSET; HULL_SUBSET; RELATIVE_INTERIOR_SUBSET]; + REWRITE_TAC[relative_frontier] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `s SUBSET u ==> c = s ==> c DIFF i SUBSET u`)) THEN + REWRITE_TAC[CLOSURE_EQ] THEN MATCH_MP_TAC CLOSED_INTER THEN + REWRITE_TAC[CLOSED_AFFINE_HULL; CLOSED_CBALL]; + ONCE_REWRITE_TAC[INTER_COMM] THEN + W(MP_TAC o PART_MATCH (lhs o rand) + + AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR o rand o snd); + ONCE_REWRITE_TAC[INTER_COMM] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR o + rand o snd)] THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; GSYM MEMBER_NOT_EMPTY; + LEFT_IMP_EXISTS_THM; IN_INTER] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN + ASM_SIMP_TAC[INTERIOR_CBALL; CENTRE_IN_BALL; HULL_INC; HULL_SUBSET; + AFF_DIM_AFFINE_HULL]);; + +let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE = prove + (`!a. 3 <= dimindex(:N) ==> simply_connected((:real^N) DELETE a)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `&1`] o + MATCH_MP SIMPLY_CONNECTED_SPHERE) THEN + MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN + MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`] + HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN + REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL; + RELATIVE_FRONTIER_CBALL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL; + BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);; + +let SIMPLY_CONNECTED_CONVEX_DIFF_FINITE = prove + (`!s t:real^N->bool. + convex s /\ &3 <= aff_dim s /\ FINITE t + ==> simply_connected(s DIFF t)`, + let lemma = prove + (`!P. (?u v. P u /\ P v /\ ~(u = v)) /\ + (!c. P c ==> ~(s INTER {x:real^N | x$k = c} = {})) + ==> ?u v. u IN s INTER {x | P(x$k)} /\ v IN s INTER {x | P(x$k)} /\ + ~(u = v)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `u:real` th) THEN MP_TAC(SPEC `v:real` th)) THEN + ASM SET_TAC[]) in + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + WF_INDUCT_TAC `CARD(t:real^N->bool)` THEN + X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN + REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC (SET_RULE + `s INTER t = {} \/ ?a:real^N. s INTER t = {a} \/ + ?a b. ~(a = b) /\ a IN s /\ a IN t /\ b IN s /\ b IN t`) THEN + ASM_SIMP_TAC[CONVEX_IMP_SIMPLY_CONNECTED; SIMPLY_CONNECTED_PUNCTURED_CONVEX; + DIFF_EMPTY; SET_RULE `s DIFF {a} = s DELETE a`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[NOT_IMP; LEFT_IMP_EXISTS_THM; NOT_FORALL_THM] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `~(x = y) ==> x < y \/ y < x`)) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + ONCE_REWRITE_TAC[REWRITE_RULE[IMP_CONJ_ALT] IMP_IMP] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`b:real^N`; `a:real^N`] THEN + MATCH_MP_TAC(MESON[] + `(!a b. R a b ==> R b a) /\ (!a b. P a b ==> R a b) + ==> !a b. P a b \/ P b a ==> R a b`) THEN + CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI]; REPEAT STRIP_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN + SUBGOAL_THEN + `!s t. s DIFF t = + {x | x IN s /\ x$k < (b:real^N)$k} DIFF + {x | x IN t /\ x$k < b$k} UNION + {x:real^N | x IN s /\ (a:real^N)$k < x$k} DIFF + {x | x IN t /\ a$k < x$k}` + (fun th -> ONCE_REWRITE_TAC[th] THEN ASSUME_TAC(GSYM th)) + THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `a < b ==> !x. a < x \/ x < b`)) THEN SET_TAC[]; + MATCH_MP_TAC SIMPLY_CONNECTED_UNION THEN ASM_REWRITE_TAC[]] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} = + (s DIFF t) INTER {x | P x}`] THEN + MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]; + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} = + (s DIFF t) INTER {x | P x}`] THEN + MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + REWRITE_TAC[GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`; + FINITE_INTER; CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH + `&3:int <= x ==> y = x ==> &3 <= y`)) THEN + MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN + ASM_REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`; + FINITE_INTER; CONVEX_INTER; + REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[REAL_LT_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH + `&3:int <= x ==> y = x ==> &3 <= y`)) THEN + MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN + ASM_REWRITE_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN + ASM SET_TAC[]; + ALL_TAC; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} DIFF {x | x IN t /\ P x} = + (s DIFF t) INTER {x | P x}`] THEN + REWRITE_TAC[SET_RULE `(s INTER u) INTER (s INTER v) = s INTER (u INTER v)`; + SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF t`] THEN + REWRITE_TAC[SET_RULE `s INTER u DIFF s INTER t = s INTER u DIFF t`] THENL + [MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN + ASM_SIMP_TAC[FINITE_IMP_COUNTABLE; CONVEX_INTER; COLLINEAR_AFF_DIM; + CONVEX_HALFSPACE_COMPONENT_LT; + REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (INT_ARITH + `&3:int <= x ==> y = x ==> ~(y <= &1)`)) THEN + MATCH_MP_TAC AFF_DIM_CONVEX_INTER_OPEN THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_HALFSPACE_COMPONENT_LT; + REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT] THEN + MATCH_MP_TAC(MESON[INFINITE; FINITE_EMPTY] + `INFINITE s ==> ~(s = {})`); + REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN + MATCH_MP_TAC(MESON[FINITE_SUBSET; INFINITE] + `INFINITE s /\ FINITE t ==> ~(s SUBSET t)`) THEN + ASM_REWRITE_TAC[]] THEN + (ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [CONNECTED_FINITE_IFF_SING; INFINITE; CONVEX_CONNECTED; + CONVEX_INTER; CONVEX_HALFSPACE_COMPONENT_LT; + REWRITE_RULE[real_gt] CONVEX_HALFSPACE_COMPONENT_GT] THEN + MATCH_MP_TAC(SET_RULE + `!u v. u IN s /\ v IN s /\ ~(u = v) ==> ~(s = {} \/ ?z. s = {z})`) THEN + REWRITE_TAC[SET_RULE `{x | P x} INTER {x | Q x} = {x | Q x /\ P x}`] THEN + MP_TAC lemma THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [EXISTS_TAC `a$k + &1 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN + EXISTS_TAC `a$k + &2 / &3 * ((b:real^N)$k - (a:real^N)$k)` THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `c:real` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN + SUBGOAL_THEN `!x:real^N. x$k = basis k dot x` (fun t -> SIMP_TAC[t]) THENL + [ASM_MESON_TAC[DOT_BASIS]; MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE] THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN + ASM_SIMP_TAC[CONVEX_CONNECTED; DOT_BASIS; REAL_LT_IMP_LE]]));; + +(* ------------------------------------------------------------------------- *) +(* Some technical lemmas about extending maps from cell complexes. *) +(* ------------------------------------------------------------------------- *) + +let EXTEND_MAP_CELL_COMPLEX_TO_SPHERE, + EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE = (CONJ_PAIR o prove) + (`(!f:real^M->real^N m s t. + FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c < aff_dim t) /\ + (!c1 c2. c1 IN m /\ c2 IN m + ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\ + s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\ + f continuous_on s /\ IMAGE f s SUBSET relative_frontier t + ==> ?g. g continuous_on UNIONS m /\ + IMAGE g (UNIONS m) SUBSET relative_frontier t /\ + !x. x IN s ==> g x = f x) /\ + (!f:real^M->real^N m s t. + FINITE m /\ (!c. c IN m ==> polytope c /\ aff_dim c <= aff_dim t) /\ + (!c1 c2. c1 IN m /\ c2 IN m + ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) /\ + s SUBSET UNIONS m /\ closed s /\ convex t /\ bounded t /\ + f continuous_on s /\ IMAGE f s SUBSET relative_frontier t + ==> ?k g. FINITE k /\ DISJOINT k s /\ + g continuous_on (UNIONS m DIFF k) /\ + IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\ + !x. x IN s ==> g x = f x)`, + let wemma = prove + (`!h:real^M->real^N k t f. + (!s. s IN f ==> ?g. g continuous_on s /\ + IMAGE g s SUBSET t /\ + !x. x IN s INTER k ==> g x = h x) /\ + FINITE f /\ (!s. s IN f ==> closed s) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k) + ==> ?g. g continuous_on (UNIONS f) /\ + IMAGE g (UNIONS f) SUBSET t /\ + !x. x IN (UNIONS f) INTER k ==> g x = h x`, + REPLICATE_TAC 3 GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY; + INTER_EMPTY; NOT_IN_EMPTY] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN + MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN + ASM_SIMP_TAC[UNIONS_INSERT] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN ASM_SIMP_TAC[CLOSED_UNIONS] THEN + ASM SET_TAC[]) in + let lemma = prove + (`!h:real^M->real^N k t f. + (!s. s IN f ==> ?g. g continuous_on s /\ + IMAGE g s SUBSET t /\ + !x. x IN s INTER k ==> g x = h x) /\ + FINITE f /\ (!s. s IN f ==> closed s) /\ + (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s) + ==> (s INTER t) SUBSET k) + ==> ?g. g continuous_on (UNIONS f) /\ + IMAGE g (UNIONS f) SUBSET t /\ + !x. x IN (UNIONS f) INTER k ==> g x = h x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP UNIONS_MAXIMAL_SETS) THEN + MATCH_MP_TAC wemma THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN ASM SET_TAC[]) in + let zemma = prove + (`!f:real^M->real^N m n t. + FINITE m /\ (!c. c IN m ==> polytope c) /\ + n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c < aff_dim t) /\ + (!c1 c2. c1 IN m /\ c2 IN m + ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\ + convex t /\ bounded t /\ + f continuous_on (UNIONS n) /\ + IMAGE f (UNIONS n) SUBSET relative_frontier t + ==> ?g. g continuous_on (UNIONS m) /\ + IMAGE g (UNIONS m) SUBSET relative_frontier t /\ + (!x. x IN UNIONS n ==> g x = f x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `m DIFF n:(real^M->bool)->bool = {}` THENL + [SUBGOAL_THEN `(UNIONS m:real^M->bool) SUBSET UNIONS n` ASSUME_TAC THENL + [ASM SET_TAC[]; EXISTS_TAC `f:real^M->real^N`] THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. &i <= aff_dim t + ==> ?g. g continuous_on + (UNIONS + (n UNION {d | ?c. c IN m /\ d face_of c /\ + aff_dim d < &i})) /\ + IMAGE g (UNIONS + (n UNION {d | ?c. c IN m /\ d face_of c /\ + aff_dim d < &i})) + SUBSET relative_frontier t /\ + (!x. x IN UNIONS n ==> g x = (f:real^M->real^N) x)` + MP_TAC THENL + [ALL_TAC; + MP_TAC(ISPEC `aff_dim(t:real^N->bool)` INT_OF_NUM_EXISTS) THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[AFF_DIM_GE; MEMBER_NOT_EMPTY; + INT_ARITH `--(&1):int <= s /\ s < t ==> &0 <= t`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN + SUBGOAL_THEN + `UNIONS (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &i}) = + UNIONS m:real^M->bool` + (fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC UNIONS_MONO THEN REWRITE_TAC[IN_UNION] THEN + REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET]; GEN_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[FACE_OF_IMP_SUBSET]; + MATCH_MP_TAC SUBSET_UNIONS THEN REWRITE_TAC[SUBSET; IN_UNION] THEN + X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `(d:real^M->bool) IN n` THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `d:real^M->bool` THEN + ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX] THEN + ASM SET_TAC[]]] THEN + MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL + [REWRITE_TAC[INT_ARITH `d < &0 <=> (--(&1) <= d ==> d:int = --(&1))`] THEN + REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1] THEN + SUBGOAL_THEN + `{d:real^M->bool| ?c. c IN m /\ d face_of c /\ d = {}} = {{}}` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `d:real^M->bool` THEN + REWRITE_TAC[IN_SING; IN_ELIM_THM] THEN + ASM_CASES_TAC `d:real^M->bool = {}` THEN + ASM_REWRITE_TAC[EMPTY_FACE_OF] THEN ASM SET_TAC[]; + REWRITE_TAC[UNIONS_UNION; UNIONS_1; UNION_EMPTY] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN + REWRITE_TAC[INT_ARITH `p + &1 <= x <=> p:int < x`] THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[INT_LT_IMP_LE] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[INT_ARITH `x:int < p + &1 <=> x <= p`] THEN + SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[AFF_DIM_EMPTY; INT_ARITH `~(&p:int < --(&1))`]; + ALL_TAC] THEN + SUBGOAL_THEN `~(relative_frontier t:real^N->bool = {})` ASSUME_TAC THENL + [ASM_REWRITE_TAC[RELATIVE_FRONTIER_EQ_EMPTY] THEN DISCH_TAC THEN + MP_TAC(ISPEC `t:real^N->bool` AFFINE_BOUNDED_EQ_LOWDIM) THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!d. d IN n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} + ==> ?g. (g:real^M->real^N) continuous_on d /\ + IMAGE g d SUBSET relative_frontier t /\ + !x. x IN d INTER + UNIONS + (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p}) + ==> g x = h x` + MP_TAC THENL + [X_GEN_TAC `d:real^M->bool` THEN + ASM_CASES_TAC `(d:real^M->bool) SUBSET UNIONS + (n UNION {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p})` + THENL + [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `h:real^M->real^N` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `?a:real^M. d = {a}` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` SUBST_ALL_TAC) THEN + DISCH_THEN(K ALL_TAC) THEN ASM_SIMP_TAC[CONTINUOUS_ON_SING; SET_RULE + `~({a} SUBSET s) ==> ~(x IN {a} INTER s)`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; + FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(MESON[] `(?c. P(\x. c)) ==> (?f. P f)`) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(d:real^M->bool = {})` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s SUBSET UNIONS f) ==> ~(s IN f)`)) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP + (SET_RULE `~(d IN s UNION t) /\ d IN s UNION u + ==> ~(d IN s) /\ d IN u DIFF t`)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `d IN + {d | ?c. c IN m /\ d face_of c /\ aff_dim d <= &p} DIFF + {d | ?c. c IN m /\ d face_of c /\ aff_dim d < &p} + ==> ?c. c IN m /\ d face_of c /\ + (aff_dim d <= &p /\ ~(aff_dim d < &p))`)) THEN + REWRITE_TAC[INT_ARITH `d:int <= p /\ ~(d < p) <=> d = p`] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:real^M->real^N`; `relative_frontier d:real^M->bool`; + `t:real^N->bool`] NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION) THEN + ASM_REWRITE_TAC[CLOSED_RELATIVE_FRONTIER; + RELATIVE_FRONTIER_EQ_EMPTY] THEN + SUBGOAL_THEN + `relative_frontier d SUBSET + UNIONS {e:real^M->bool | e face_of c /\ aff_dim e < &p}` + ASSUME_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o + lhand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC SUBSET_UNIONS THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN + X_GEN_TAC `f:real^M->bool` THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[FACE_OF_TRANS]; INT_ARITH_TAC]; + ALL_TAC] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM_MESON_TAC[AFFINE_BOUNDED_EQ_TRIVIAL; FACE_OF_POLYTOPE_POLYTOPE; + POLYTOPE_IMP_BOUNDED]; + ASM SET_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INESSENTIAL_SPHEREMAP_LOWDIM_GEN THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_CONVEX]; + ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; POLYTOPE_IMP_BOUNDED]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[INTER_UNIONS] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `(!x. x IN s ==> P x) ==> t SUBSET s + ==> !x. x IN t ==> P x`)) THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN CONJ_TAC THENL + [MATCH_MP_TAC(MESON[] + `(d INTER e) face_of d /\ (d INTER e) face_of e + ==> (d INTER e) face_of d`) THEN + MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN + EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_MESON_TAC[FACE_OF_REFL; SUBSET; POLYTOPE_IMP_CONVEX]; + REWRITE_TAC[SET_RULE `d INTER e = d <=> d SUBSET e`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[AFF_DIM_SUBSET; INT_NOT_LE]]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] lemma)) THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]] THEN + CONJ_TAC THENL + [REWRITE_TAC[FINITE_UNION] THEN + CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN + CONJ_TAC THENL + [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + ASM_MESON_TAC[FINITE_POLYTOPE_FACES]; + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_IMP_CLOSED; POLYTOPE_IMP_CLOSED; + POLYTOPE_IMP_CONVEX; SUBSET]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC) + THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (DISJ_CASES_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC)) MP_TAC) + THENL [ASM SET_TAC[]; STRIP_TAC] THEN + REWRITE_TAC[UNIONS_UNION] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s SUBSET t UNION u`) THEN + MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET UNIONS s`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `c:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `d INTER e face_of (d:real^M->bool) /\ + d INTER e face_of e` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[FACE_OF_TRANS]; ALL_TAC] THEN + TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]; + ASM SET_TAC[]]) in + let memma = prove + (`!h:real^M->real^N k t u f. + (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\ + IMAGE g (s DELETE a) SUBSET t /\ + !x. x IN s INTER k ==> g x = h x) /\ + FINITE f /\ (!s. s IN f ==> closed s) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> (s INTER t) SUBSET k) + ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\ + g continuous_on (UNIONS f DIFF c) /\ + IMAGE g (UNIONS f DIFF c) SUBSET t /\ + !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`, + REPLICATE_TAC 4 GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q ==> p /\ r ==> s`] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; IMAGE_CLAUSES; EMPTY_SUBSET; CONTINUOUS_ON_EMPTY; + INTER_EMPTY; NOT_IN_EMPTY; EMPTY_DIFF] THEN + CONJ_TAC THENL + [MESON_TAC[DISJOINT_EMPTY; FINITE_EMPTY; CARD_CLAUSES; LE_REFL]; + ALL_TAC] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_INSERT] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; SUBSET_REFL] THEN + MAP_EVERY X_GEN_TAC [`s:real^M->bool`; `u:(real^M->bool)->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN + ASM_SIMP_TAC[UNIONS_INSERT] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[CARD_CLAUSES] THEN + ASM_CASES_TAC `(s:real^M->bool) UNION UNIONS u = UNIONS u` THENL + [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[ARITH_RULE `x <= y ==> x <= SUC y`]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^M` + (X_CHOOSE_THEN `f:real^M->real^N` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(a:real^M) INSERT c` THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; RIGHT_EXISTS_AND_THM] THEN + REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ASM_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `\x. if x IN s then (f:real^M->real^N) x else g x` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(s DIFF ((a:real^M) INSERT c)) UNION + (UNIONS u DIFF ((a:real^M) INSERT c))` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `UNIONS u:real^M->bool` THEN ASM_SIMP_TAC[CLOSED_UNIONS]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + ALL_TAC] THEN + ASM SET_TAC[]) in + let temma = prove + (`!h:real^M->real^N k t u f. + (!s. s IN f ==> ?a g. ~(a IN u) /\ g continuous_on (s DELETE a) /\ + IMAGE g (s DELETE a) SUBSET t /\ + !x. x IN s INTER k ==> g x = h x) /\ + FINITE f /\ (!s. s IN f ==> closed s) /\ + (!s t. s IN f /\ t IN f /\ ~(s SUBSET t) /\ ~(t SUBSET s) + ==> (s INTER t) SUBSET k) + ==> ?c g. FINITE c /\ DISJOINT c u /\ CARD c <= CARD f /\ + g continuous_on (UNIONS f DIFF c) /\ + IMAGE g (UNIONS f DIFF c) SUBSET t /\ + !x. x IN (UNIONS f DIFF c) INTER k ==> g x = h x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real^M->real^N`; `k:real^M->bool`; `t:real^N->bool`; + `u:real^M->bool`; + `{t:real^M->bool | t IN f /\ + (!u. u IN f ==> ~(t PSUBSET u))}`] + memma) THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM; UNIONS_MAXIMAL_SETS] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + LE_TRANS)) THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_SIMP_TAC[] THEN SET_TAC[]) in + let bemma = prove + (`!f:real^M->real^N m n t. + FINITE m /\ (!c. c IN m ==> polytope c) /\ + n SUBSET m /\ (!c. c IN m DIFF n ==> aff_dim c <= aff_dim t) /\ + (!c1 c2. c1 IN m /\ c2 IN m + ==> (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2) /\ + convex t /\ bounded t /\ + f continuous_on (UNIONS n) /\ + IMAGE f (UNIONS n) SUBSET relative_frontier t + ==> ?k g. FINITE k /\ DISJOINT k (UNIONS n) /\ CARD k <= CARD m /\ + g continuous_on (UNIONS m DIFF k) /\ + IMAGE g (UNIONS m DIFF k) SUBSET relative_frontier t /\ + (!x. x IN UNIONS n ==> g x = f x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; + `n UNION {d:real^M->bool | ?c. c IN m DIFF n /\ d face_of c /\ + aff_dim d < aff_dim(t:real^N->bool)}`; + `n:(real^M->bool)->bool`; `t:real^N->bool`] zemma) THEN + ASM_REWRITE_TAC[SUBSET_UNION; SET_RULE + `(n UNION m) DIFF n = m DIFF n`] THEN + SIMP_TAC[IN_DIFF; IN_ELIM_THM; LEFT_IMP_EXISTS_THM; + LEFT_AND_EXISTS_THM] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FINITE_UNION] THEN + CONJ_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `UNIONS {{d:real^M->bool | d face_of c} | c IN m}` THEN + CONJ_TAC THENL + [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + ASM_MESON_TAC[FINITE_POLYTOPE_FACES]; + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; SUBSET]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_INTER_SUBFACE; SUBSET; FACE_OF_REFL; + POLYTOPE_IMP_CONVEX; FACE_OF_IMP_CONVEX]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!d. d IN m + ==> ?a g. ~(a IN UNIONS n) /\ + (g:real^M->real^N) continuous_on (d DELETE a) /\ + IMAGE g (d DELETE a) SUBSET relative_frontier t /\ + !x. x IN d INTER + UNIONS + (n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\ + d face_of c /\ + aff_dim d < aff_dim t}) + ==> g x = h x` + MP_TAC THENL + [X_GEN_TAC `d:real^M->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `(d:real^M->bool) SUBSET + UNIONS(n UNION {d | ?c. (c IN m /\ ~(c IN n)) /\ + d face_of c /\ + aff_dim d < aff_dim(t:real^N->bool)})` + THENL + [SUBGOAL_THEN `~(UNIONS n = (:real^M))` MP_TAC THENL + [MATCH_MP_TAC(MESON[NOT_BOUNDED_UNIV] + `bounded s ==> ~(s = UNIV)`) THEN + MATCH_MP_TAC BOUNDED_UNIONS THEN + ASM_MESON_TAC[POLYTOPE_IMP_BOUNDED; SUBSET; FINITE_SUBSET]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EXTENSION]] THEN + REWRITE_TAC[IN_UNIV; NOT_FORALL_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN + STRIP_TAC THEN EXISTS_TAC `h:real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; + SET_RULE `s SUBSET t ==> s DELETE a SUBSET t`]; + ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISJ_CASES_THEN MP_TAC (SPEC + `relative_interior(d:real^M->bool) = {}` EXCLUDED_MIDDLE) + THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYTOPE_IMP_CONVEX] THEN + ASM SET_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN + SUBGOAL_THEN + `relative_frontier d SUBSET + UNIONS {e:real^M->bool | e face_of d /\ + aff_dim e < aff_dim(t:real^N->bool)}` + ASSUME_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_OF_POLYHEDRON o + lhand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_POLYTOPE_POLYTOPE]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC SUBSET_UNIONS THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; facet_of] THEN + ASM_SIMP_TAC[INT_ARITH `d - &1:int < t <=> d <= t`; IN_DIFF]; + ALL_TAC] THEN + MP_TAC(ISPECL [`d:real^M->bool`; `a:real^M`] + RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN + ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED] THEN + REWRITE_TAC[retract_of; LEFT_IMP_EXISTS_THM; retraction] THEN + X_GEN_TAC `r:real^M->real^M` THEN STRIP_TAC THEN + EXISTS_TAC `(h:real^M->real^N) o (r:real^M->real^M)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `e INTER d face_of e /\ e INTER d face_of (d:real^M->bool)` + MP_TAC THENL [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] FACE_OF_SUBSET_RELATIVE_FRONTIER) o + CONJUNCT2) THEN + REWRITE_TAC[NOT_IMP; relative_frontier] THEN + MP_TAC(ISPEC `d:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[HULL_SUBSET; SET_RULE + `s SUBSET t ==> s DELETE a SUBSET t DELETE a`]; + REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE h t SUBSET u ==> s SUBSET t ==> IMAGE h s SUBSET u`)); + SIMP_TAC[INTER_UNIONS; o_THM] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `(!x. x IN s ==> r x = x) ==> t SUBSET s + ==> !x. x IN t ==> h(r x) = h x`)) THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + X_GEN_TAC `e:real^M->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC FACE_OF_SUBSET_RELATIVE_FRONTIER THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC(MESON[] + `(d INTER e) face_of d /\ (d INTER e) face_of e + ==> (d INTER e) face_of d`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNION]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THENL + [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC FACE_OF_INTER_SUBFACE THEN + MAP_EVERY EXISTS_TAC [`d:real^M->bool`; `c:real^M->bool`] THEN + ASM_SIMP_TAC[FACE_OF_REFL; POLYTOPE_IMP_CONVEX]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE r (h DELETE a) SUBSET t ==> d SUBSET h /\ t SUBSET u + ==> IMAGE r (d DELETE a) SUBSET u`)) THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] temma)) THEN + ANTS_TAC THENL + [ALL_TAC; + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]] THEN + ASM_SIMP_TAC[POLYTOPE_IMP_CLOSED] THEN + MAP_EVERY X_GEN_TAC [`d:real^M->bool`; `e:real^M->bool`] THEN + STRIP_TAC THEN REWRITE_TAC[UNIONS_UNION] THEN + ASM_CASES_TAC `(d:real^M->bool) IN n` THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `x IN s ==> x SUBSET t UNION UNIONS s`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `d:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `d INTER e:real^M->bool = d` THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN TRANS_TAC INT_LTE_TRANS `aff_dim(d:real^M->bool)` THEN + ASM_SIMP_TAC[IN_DIFF] THEN MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN + ASM_MESON_TAC[POLYTOPE_IMP_CONVEX]) in + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL + [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; + `relative_frontier t:real^N->bool`] + NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN + ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ENR_IMP_ANR; + ENR_RELATIVE_FRONTIER_CONVEX] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`] + SEPARATE_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN + REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool) - &1`; + `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN + ASM_SIMP_TAC[INT_ARITH `x:int <= t - &1 <=> x < t`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`g:real^M->real^N`; `n:(real^M->bool)->bool`; + `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`] + zemma) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `diameter(c:real^M->bool)` THEN + ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN + ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED]]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `compact(s:real^M->bool)` ASSUME_TAC THENL + [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; + `relative_frontier t:real^N->bool`] + NEIGHBOURHOOD_EXTENSION_INTO_ANR) THEN + ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; ENR_IMP_ANR; + ENR_RELATIVE_FRONTIER_CONVEX] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^M->bool`; `(:real^M) DIFF v`] + SEPARATE_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[GSYM OPEN_CLOSED; IN_DIFF; IN_UNIV] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN + REWRITE_TAC[REAL_NOT_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`m:(real^M->bool)->bool`; `aff_dim(t:real^N->bool)`; + `d:real`] CELL_COMPLEX_SUBDIVISION_EXISTS) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`g:real^M->real^N`; `n:(real^M->bool)->bool`; + `{c:real^M->bool | c IN n /\ c SUBSET v}`; `t:real^N->bool`] + bemma) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[SUBSET_RESTRICT; IN_DIFF] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^M->bool` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `DISJOINT k u ==> s SUBSET u ==> DISJOINT k s`)) THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC; + X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN + (SUBGOAL_THEN `(x:real^M) IN UNIONS n` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `x:real^M` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `diameter(c:real^M->bool)` THEN + ASM_SIMP_TAC[dist] THEN MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN + ASM_SIMP_TAC[POLYTOPE_IMP_BOUNDED])]]);; + +(* ------------------------------------------------------------------------- *) +(* Special cases and corollaries involving spheres. *) +(* ------------------------------------------------------------------------- *) + +let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE = prove + (`!f:real^M->real^N s t u. + compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\ + s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u + ==> ?k g. FINITE k /\ k SUBSET t /\ DISJOINT k s /\ + g continuous_on (t DIFF k) /\ + IMAGE g (t DIFF k) SUBSET relative_frontier u /\ + !x. x IN s ==> g x = f x`, + let lemma = prove + (`!f:A->B->bool P k. + INFINITE {x | P x} /\ FINITE k /\ + (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> ?x. P x /\ DISJOINT k (f x)`, + REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=> + ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN + MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + ASM SET_TAC[]) in + SUBGOAL_THEN + `!f:real^M->real^N s t u. + compact s /\ convex u /\ bounded u /\ aff_dim t <= aff_dim u /\ + s SUBSET t /\ f continuous_on s /\ IMAGE f s SUBSET relative_frontier u + ==> ?k g. FINITE k /\ DISJOINT k s /\ + g continuous_on (t DIFF k) /\ + IMAGE g (t DIFF k) SUBSET relative_frontier u /\ + !x. x IN s ==> g x = f x` + MP_TAC THENL + [ALL_TAC; + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k INTER t:real^M->bool` THEN + ASM_SIMP_TAC[FINITE_INTER; INTER_SUBSET] THEN + REPEAT CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]] THEN + SUBGOAL_THEN + `!f:real^M->real^N s t u. + compact s /\ s SUBSET t /\ affine t /\ + convex u /\ bounded u /\ aff_dim t <= aff_dim u /\ + f continuous_on s /\ IMAGE f s SUBSET relative_frontier u + ==> ?k g. FINITE k /\ DISJOINT k s /\ + g continuous_on (t DIFF k) /\ + IMAGE g (t DIFF k) SUBSET relative_frontier u /\ + !x. x IN s ==> g x = f x` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?k g. FINITE k /\ DISJOINT k s /\ + g continuous_on (affine hull t DIFF k) /\ + IMAGE g (affine hull t DIFF k) SUBSET relative_frontier u /\ + !x. x IN s ==> g x = (f:real^M->real^N) x` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[AFF_DIM_AFFINE_HULL; AFFINE_AFFINE_HULL] THEN + TRANS_TAC SUBSET_TRANS `t:real^M->bool` THEN + ASM_REWRITE_TAC[HULL_SUBSET]; + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + MATCH_MP_TAC IMAGE_SUBSET] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF k SUBSET t DIFF k`) THEN + REWRITE_TAC[HULL_SUBSET]]] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN + UNDISCH_TAC `bounded(u:real^N->bool)` THEN + ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN + SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[AFF_DIM_GE; INT_ARITH + `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN + REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THEN + EXISTS_TAC `{a:real^M}` THEN + ASM_REWRITE_TAC[DISJOINT_EMPTY; FINITE_SING; NOT_IN_EMPTY; + EMPTY_DIFF; DIFF_EQ_EMPTY; IMAGE_CLAUSES; + CONTINUOUS_ON_EMPTY; EMPTY_SUBSET]; + EXISTS_TAC `{}:real^M->bool` THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN + EXISTS_TAC `(\x. y):real^M->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN + REWRITE_TAC[INSERT_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; + `{interval[--(b + vec 1):real^M,b + vec 1] INTER t}`; + `s:real^M->bool`; `u:real^N->bool`] + EXTEND_MAP_CELL_COMPLEX_TO_SPHERE_COFINITE) THEN + SUBGOAL_THEN + `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT; + VEC_COMPONENT] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FINITE_SING] THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IMP_IMP] THEN + REWRITE_TAC[INTER_IDEMPOT; UNIONS_1; FACE_OF_REFL_EQ; SUBSET_INTER] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[HULL_SUBSET; COMPACT_IMP_CLOSED] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC POLYTOPE_INTER_POLYHEDRON THEN + ASM_SIMP_TAC[POLYTOPE_INTERVAL; AFFINE_IMP_POLYHEDRON]; + TRANS_TAC INT_LE_TRANS `aff_dim(t:real^M->bool)` THEN + ASM_SIMP_TAC[AFF_DIM_SUBSET; INTER_SUBSET]; + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_INTERVAL; AFFINE_IMP_CONVEX]; + ASM SET_TAC[]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `k:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?d:real. (&1 / &2 <= d /\ d <= &1) /\ + DISJOINT k (frontier(interval[--(b + lambda i. d):real^M, + (b + lambda i. d)]))` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC lemma THEN + ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN + REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN + SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; + LAMBDA_BETA] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN + `interval[--b:real^M,b] SUBSET interval(--c,c) /\ + interval[--b:real^M,b] SUBSET interval[--c,c] /\ + interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC + `(g:real^M->real^N) o + closest_point (interval[--c,c] INTER t)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN + ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE; + AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))]; + REWRITE_TAC[IMAGE_o] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + MATCH_MP_TAC IMAGE_SUBSET; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN + TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN + CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CLOSEST_POINT_SELF THEN + ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN + (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN + CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN + ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THEN + MATCH_MP_TAC(SET_RULE + `closest_point s x IN relative_frontier s /\ + DISJOINT k (relative_frontier s) + ==> ~(closest_point s x IN k)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + W(MP_TAC o PART_MATCH (lhs o rand) + AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN + ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN + ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[]; + W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o + rand o snd) THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN + ASM SET_TAC[]]));; + +let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN = prove + (`!f:real^M->real^N s t u p. + compact s /\ convex u /\ bounded u /\ + affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\ + f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\ + (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {})) + ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\ + g continuous_on (t DIFF k) /\ + IMAGE g (t DIFF k) SUBSET relative_frontier u /\ + !x. x IN s ==> g x = f x`, + let lemma0 = prove + (`!u t s v. closed_in (subtopology euclidean u) v /\ t SUBSET u /\ + s = v INTER t + ==> closed_in (subtopology euclidean t) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]) in + let lemma1 = prove + (`!f:A->B->bool P k. + INFINITE {x | P x} /\ FINITE k /\ + (!x y. P x /\ P y /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> ?x. P x /\ DISJOINT k (f x)`, + REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE `(?x. P x /\ DISJOINT k (f x)) <=> + ~(!x. ?y. P x ==> y IN k /\ y IN f x)`] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `g:A->B`) THEN + MP_TAC(ISPECL [`g:A->B`; `{x:A | P x}`] FINITE_IMAGE_INJ_EQ) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + ASM SET_TAC[]) in + let lemma2 = prove + (`!f:real^M->real^N s t k p u. + FINITE k /\ affine u /\ + f continuous_on ((u:real^M->bool) DIFF k) /\ + IMAGE f ((u:real^M->bool) DIFF k) SUBSET t /\ + (!c. c IN components((u:real^M->bool) DIFF s) /\ ~(c INTER k = {}) + ==> ~(c INTER p = {})) /\ + closed_in (subtopology euclidean u) s /\ DISJOINT k s /\ k SUBSET u + ==> ?g. g continuous_on ((u:real^M->bool) DIFF p) /\ + IMAGE g ((u:real^M->bool) DIFF p) SUBSET t /\ + !x. x IN s ==> g x = f x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `k:real^M->bool = {}` THENL + [ASM_REWRITE_TAC[DIFF_EMPTY] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_DIFF]; ASM SET_TAC[]]; + STRIP_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + SUBGOAL_THEN `~(((u:real^M->bool) DIFF s) INTER k = {})` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o LAND_CONV) + [UNIONS_COMPONENTS] THEN + REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `co:real^M->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `locally connected (u:real^M->bool)` ASSUME_TAC THENL + [ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_IMP_LOCALLY_CONNECTED]; + ALL_TAC] THEN + SUBGOAL_THEN + `!c. c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {}) + ==> ?a g. a IN c /\ a IN p /\ + g continuous_on (s UNION (c DELETE a)) /\ + IMAGE g (s UNION (c DELETE a)) SUBSET t /\ + !x. x IN s ==> g x = (f:real^M->real^N) x` + MP_TAC THENL + [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `open_in (subtopology euclidean u) (c:real^M->bool)` + MP_TAC THENL + [MATCH_MP_TAC OPEN_IN_TRANS THEN + EXISTS_TAC `u DIFF s:real^M->bool` THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `u:real^M->bool` THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th)] THEN + REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `a:real^M`)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `ball(a:real^M,d) INTER u SUBSET c` ASSUME_TAC THENL + [ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS; + SET_RULE `b SUBSET c ==> b INTER u SUBSET c INTER u`]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`ball(a:real^M,d) INTER u`; `c:real^M->bool`; + `s UNION c:real^M->bool`; `c INTER k:real^M->bool`] + HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN) THEN + ASM_REWRITE_TAC[INTER_SUBSET; SUBSET_UNION; UNION_SUBSET] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^M->bool` THEN + ASM_SIMP_TAC[HULL_MINIMAL; HULL_SUBSET]; + MP_TAC(ISPECL [`c:real^M->bool`; `u:real^M->bool`] + AFFINE_HULL_OPEN_IN) THEN + ASM_SIMP_TAC[HULL_P] THEN ASM SET_TAC[]; + REWRITE_TAC[HULL_SUBSET]; + ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ASM_MESON_TAC[FINITE_SUBSET; INTER_SUBSET]; + MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `u:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; INTER_COMM]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `a:real^M` THEN REWRITE_TAC[CENTRE_IN_BALL] THEN + ASM SET_TAC[]]; + REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`cball(a:real^M,d) INTER u`; `a:real^M`] + RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL) THEN + MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`] + RELATIVE_INTERIOR_CONVEX_INTER_AFFINE) THEN + MP_TAC(ISPECL [`cball(a:real^M,d)`; `u:real^M->bool`] + RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN + MP_TAC(ISPECL [`u:real^M->bool`; `cball(a:real^M,d)`] + (ONCE_REWRITE_RULE[INTER_COMM] + AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR)) THEN + ASM_SIMP_TAC[CONVEX_CBALL; FRONTIER_CBALL; INTERIOR_CBALL] THEN + SUBGOAL_THEN `a IN ball(a:real^M,d) INTER u` ASSUME_TAC THENL + [ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REPLICATE_TAC 3 + (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_CBALL; AFFINE_IMP_CONVEX] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; BOUNDED_CBALL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[retract_of; retraction] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^M->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(f:real^M->real^N) o (k:real^M->real^M) o + (\x. if x IN ball(a,d) then r x else x)` THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN + COND_CASES_TAC THENL + [ASM SET_TAC[]; AP_TERM_TAC THEN ASM SET_TAC[]]] THEN + ABBREV_TAC `j = \x:real^M. if x IN ball(a,d) then r x else x` THEN + SUBGOAL_THEN + `(j:real^M->real^M) continuous_on ((u:real^M->bool) DELETE a)` + ASSUME_TAC THENL + [EXPAND_TAC "j" THEN + SUBGOAL_THEN + `u DELETE (a:real^M) = + (cball(a,d) DELETE a) INTER u UNION + ((u:real^M->bool) DIFF ball(a,d))` + (fun th -> SUBST1_TAC th THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + SUBST1_TAC(SYM th)) + THENL + [MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_DIFF; IN_INTER; IN_DELETE; CONTINUOUS_ON_ID] THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + REWRITE_TAC[GSYM BALL_UNION_SPHERE] THEN ASM SET_TAC[]] THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THENL + [EXISTS_TAC `cball(a:real^M,d)` THEN REWRITE_TAC[CLOSED_CBALL]; + EXISTS_TAC `(:real^M) DIFF ball(a,d)` THEN + REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL]] THEN + MP_TAC(ISPECL [`a:real^M`; `d:real`] BALL_SUBSET_CBALL) THEN + MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (j:real^M->real^M) (s UNION c DELETE a) SUBSET + (s UNION c DIFF ball(a,d))` + ASSUME_TAC THENL + [EXPAND_TAC "j" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + COND_CASES_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + SUBGOAL_THEN `(r:real^M->real^M) x IN sphere(a,d)` MP_TAC THENL + [MP_TAC(ISPECL [`a:real^M`; `d:real`] CENTRE_IN_BALL) THEN + ASM SET_TAC[]; + REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) + THENL [ASM SET_TAC[]; ASM SET_TAC[]; ALL_TAC]; + ONCE_REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `IMAGE f u SUBSET t + ==> s SUBSET u ==> IMAGE f s SUBSET t`))] THEN + REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET u ==> IMAGE f u SUBSET t ==> IMAGE f s SUBSET t`)) THEN + REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; FORALL_IN_IMAGE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`a:(real^M->bool)->real^M`; `h:(real^M->bool)->real^M->real^N`] THEN + DISCH_TAC THEN MP_TAC(ISPECL + [`h:(real^M->bool)->real^M->real^N`; + `\c:real^M->bool. s UNION (c DELETE (a c))`; + `s UNION UNIONS + { c DELETE (a c) | + c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`; + `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`] + PASTING_LEMMA_EXISTS_CLOSED) THEN + SUBGOAL_THEN + `FINITE {c | c IN components((u:real^M->bool) DIFF s) /\ + ~(c INTER k = {})}` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`\c:real^M->bool. c INTER k`; + `{c | c IN components ((u:real^M->bool) DIFF s) /\ ~(c INTER k = {})}`] + FINITE_IMAGE_INJ_EQ) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [MESON_TAC[COMPONENTS_EQ; + SET_RULE + `s INTER k = t INTER k /\ ~(s INTER k = {}) + ==> ~(s INTER t = {})`]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE; IN_ELIM_THM]] THEN + MP_TAC(ISPEC + `{c INTER k |c| c IN components((u:real^M->bool) DIFF s) /\ + ~(c INTER k = {})}` + FINITE_UNIONS) THEN + MATCH_MP_TAC(TAUT `p ==> (p <=> q /\ r) ==> q`) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + FINITE_SUBSET)) THEN + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; + X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC lemma0 THEN + MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `s UNION c:real^M->bool`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[UNION_SUBSET; UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + MESON_TAC[IN_COMPONENTS_SUBSET; + SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u`]; + ASM_SIMP_TAC[CLOSED_UNION_COMPLEMENT_COMPONENT; UNIONS_GSPEC] THEN + MATCH_MP_TAC(SET_RULE + `~(a IN t) /\ c DELETE a SUBSET t + ==> s UNION c DELETE a = (s UNION c) INTER (s UNION t)`) THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `c':real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; + `c:real^M->bool`; `c':real^M->bool`] + COMPONENTS_EQ) THEN + ASM_CASES_TAC `c':real^M->bool = c` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM SET_TAC[]]; + MAP_EVERY X_GEN_TAC + [`c1:real^M->bool`; `c2:real^M->bool`; `x:real^M`] THEN + STRIP_TAC THEN ASM_CASES_TAC `c2:real^M->bool = c1` THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `x IN u INTER (s UNION c1 DELETE a) INTER (s UNION c2 DELETE b) + ==> (c1 INTER c2 = {}) ==> x IN s`)) THEN + ANTS_TAC THENL [ASM_MESON_TAC[COMPONENTS_EQ]; ASM_SIMP_TAC[]]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN + MP_TAC + (ISPECL [`\x. x IN s UNION + UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\ + c INTER k = {}}`; + `f:real^M->real^N`; + `g:real^M->real^N`; + `s UNION + UNIONS {c | c IN components((u:real^M->bool) DIFF s) /\ + c INTER k = {}}`; + `s UNION + UNIONS { c DELETE (a c) | + c IN components((u:real^M->bool) DIFF s) /\ + ~(c INTER k = {})}`] + CONTINUOUS_ON_CASES_LOCAL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN + EXISTS_TAC `u DIFF + UNIONS {c DELETE a c | + c IN components ((u:real^M->bool) DIFF s) /\ + ~(c INTER k = {})}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `c:real^M->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC OPEN_IN_DELETE THEN MATCH_MP_TAC OPEN_IN_TRANS THEN + EXISTS_TAC `u DIFF s:real^M->bool` THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `u:real^M->bool` THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]; + ASM_REWRITE_TAC[UNION_SUBSET] THEN + REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN + MESON_TAC[IN_COMPONENTS_SUBSET; + SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\ + c SUBSET u`]; + REWRITE_TAC[SET_RULE + `(s UNION t) UNION (s UNION u) = (s UNION t) UNION u`] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET u /\ t INTER s = {} + ==> s = (u DIFF t) INTER (s UNION t)`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[UNION_SUBSET] THEN + REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN + MESON_TAC[IN_COMPONENTS_SUBSET; + SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\ + c SUBSET u`]; + ALL_TAC] THEN + REWRITE_TAC[EMPTY_UNION; SET_RULE + `c INTER (s UNION t) = (s INTER c) UNION (c INTER t)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `t SUBSET UNIV DIFF s ==> s INTER t = {}`) THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) + MP_TAC) THEN ASM SET_TAC[]; + REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN + X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; + `c:real^M->bool`; `c':real^M->bool`] + COMPONENTS_EQ) THEN + ASM_CASES_TAC `c':real^M->bool = c` THENL + [ASM_MESON_TAC[]; ASM SET_TAC[]]]]; + MATCH_MP_TAC lemma0 THEN EXISTS_TAC `u:real^M->bool` THEN + EXISTS_TAC + `UNIONS {s UNION c |c| c IN components ((u:real^M->bool) DIFF s) /\ + ~(c INTER k = {})}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[UNION_SUBSET] THEN + REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN + MESON_TAC[IN_COMPONENTS_SUBSET; + SET_RULE `c SUBSET u DIFF s ==> c DELETE a SUBSET u /\ + c SUBSET u`]; + MATCH_MP_TAC(SET_RULE + `t SUBSET u /\ u INTER s SUBSET t ==> t = u INTER (s UNION t)`) THEN + CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `u INTER t SUBSET s ==> u INTER (s UNION t) SUBSET s UNION v`) THEN + MATCH_MP_TAC(SET_RULE + `((UNIV DIFF s) INTER t) INTER u SUBSET s + ==> t INTER u SUBSET s`) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o TOP_DEPTH_CONV) + [INTER_UNIONS] THEN + REWRITE_TAC[SET_RULE + `{g x | x IN {f y | P y}} = {g(f y) | P y}`] THEN + REWRITE_TAC[SET_RULE + `(UNIV DIFF s) INTER (s UNION c) = c DIFF s`] THEN + REWRITE_TAC[SET_RULE + `t INTER u SUBSET s <=> t INTER ((UNIV DIFF s) INTER u) = {}`] THEN + ONCE_REWRITE_TAC[INTER_UNIONS] THEN + REWRITE_TAC[EMPTY_UNIONS; FORALL_IN_GSPEC; INTER_UNIONS] THEN + X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; + `c:real^M->bool`; `c':real^M->bool`] + COMPONENTS_EQ) THEN + ASM_CASES_TAC `c':real^M->bool = c` THENL + [ASM_MESON_TAC[]; ASM SET_TAC[]]]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[UNION_SUBSET] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) + MP_TAC) THEN ASM SET_TAC[]; + REWRITE_TAC[TAUT `p /\ ~p <=> F`] THEN X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[IN_UNION] THEN + ASM_CASES_TAC `(x:real^M) IN s` THEN ASM_REWRITE_TAC[] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_DELETE] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `c:real^M->bool`) + (X_CHOOSE_TAC `c':real^M->bool`)) THEN + MP_TAC(ISPECL [`(u:real^M->bool) DIFF s`; + `c:real^M->bool`; `c':real^M->bool`] + COMPONENTS_EQ) THEN + ASM_CASES_TAC `c':real^M->bool = c` THENL + [ASM_MESON_TAC[]; ASM SET_TAC[]]]; + MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET] + `t SUBSET s /\ P f + ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[SET_RULE + `(s UNION t) UNION (s UNION u) = s UNION (t UNION u)`] THEN + MATCH_MP_TAC(SET_RULE + `(u DIFF s) DIFF p SUBSET t + ==> u DIFF p SUBSET s UNION t`) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNIONS_COMPONENTS] THEN + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; + SIMP_TAC[IN_UNION]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_UNION; IN_UNIV] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:real^M) IN s` THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN COND_CASES_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `x IN ((u:real^M->bool) DIFF s)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN + REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `c:real^M->bool`]) THEN + ASM_REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]) in + let lemma3 = prove + (`!f:real^M->real^N s t u p. + compact s /\ convex u /\ bounded u /\ + affine t /\ aff_dim t <= aff_dim u /\ s SUBSET t /\ + f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\ + (!c. c IN components(t DIFF s) ==> ~(c INTER p = {})) + ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\ + g continuous_on (t DIFF k) /\ + IMAGE g (t DIFF k) SUBSET relative_frontier u /\ + !x. x IN s ==> g x = f x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; + `t:real^M->bool`; `u:real^N->bool`] + EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_SIMPLE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!x. ?y. x IN k + ==> ?c. c IN components (t DIFF s:real^M->bool) /\ + x IN c /\ y IN c /\ y IN p` + MP_TAC THENL + [X_GEN_TAC `x:real^M` THEN REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(x:real^M) IN (t DIFF s)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [UNIONS_COMPONENTS] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[IN_UNIONS; RIGHT_EXISTS_AND_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^M` (LABEL_TAC "*"))] THEN + EXISTS_TAC `IMAGE (h:real^M->real^M) k` THEN + MP_TAC(ISPECL + [`g:real^M->real^N`; `s:real^M->bool`; + `relative_frontier u:real^N->bool`; `k:real^M->bool`; + `IMAGE (h:real^M->real^M) k`; `t:real^M->bool`] lemma2) THEN + ASM_SIMP_TAC[AFFINE_AFFINE_HULL; FINITE_IMAGE] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; EXISTS_IN_IMAGE; IN_INTER] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN + STRIP_TAC THEN REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c':real^M->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(t:real^M->bool) DIFF s`; + `c:real^M->bool`; `c':real^M->bool`] + COMPONENTS_EQ) THEN + ASM_CASES_TAC `c':real^M->bool = c` THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `(:real^M)` THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_UNIV]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^M->real^N` THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET; IN_DIFF]]) in + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_CASES_TAC `relative_frontier(u:real^N->bool) = {}` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[RELATIVE_FRONTIER_EQ_EMPTY]) THEN + UNDISCH_TAC `bounded(u:real^N->bool)` THEN + ASM_SIMP_TAC[AFFINE_BOUNDED_EQ_LOWDIM] THEN DISCH_TAC THEN + SUBGOAL_THEN `aff_dim(t:real^M->bool) <= &0` MP_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[AFF_DIM_GE; INT_ARITH + `--(&1):int <= x ==> (x <= &0 <=> x = --(&1) \/ x = &0)`] THEN + REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^M`)) THENL + [EXISTS_TAC `{}:real^M->bool` THEN + ASM_REWRITE_TAC[EMPTY_DIFF; FINITE_EMPTY; CONTINUOUS_ON_EMPTY; + IMAGE_CLAUSES; NOT_IN_EMPTY] THEN + SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN + ASM_REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF] THEN + REWRITE_TAC[CONNECTED_SING; NOT_INSERT_EMPTY; BOUNDED_SING] THEN + DISCH_TAC THEN EXISTS_TAC `{a:real^M}` THEN + ASM_REWRITE_TAC[DIFF_EQ_EMPTY; CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY; + FINITE_SING; IMAGE_CLAUSES; EMPTY_SUBSET] THEN + ASM SET_TAC[]]; + EXISTS_TAC `{}:real^M->bool` THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + ASM_SIMP_TAC[FINITE_EMPTY; DISJOINT_EMPTY; NOT_IN_EMPTY; DIFF_EMPTY] THEN + EXISTS_TAC `(\x. y):real^M->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC) THEN + REWRITE_TAC[INSERT_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `s:real^M->bool`; + `t:real^M->bool`; `u:real^N->bool`; + `p UNION (UNIONS {c | c IN components (t DIFF s) /\ ~bounded c} DIFF + interval[--(b + vec 1):real^M,b + vec 1])`] + lemma3) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC `bounded(c:real^M->bool)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(c SUBSET interval[--(b + vec 1):real^M,b + vec 1])` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real^M->bool`; `g:real^M->real^N`] THEN + STRIP_TAC THEN + EXISTS_TAC `k INTER interval[--(b + vec 1):real^M,b + vec 1]` THEN + ASM_SIMP_TAC[FINITE_INTER; RIGHT_EXISTS_AND_THM] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + SUBGOAL_THEN + `interval[--b,b] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_NEG_COMPONENT; + VEC_COMPONENT] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?d:real. (&1 / &2 <= d /\ d <= &1) /\ + DISJOINT k (frontier(interval[--(b + lambda i. d):real^M, + (b + lambda i. d)]))` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC lemma1 THEN + ASM_SIMP_TAC[INFINITE; FINITE_REAL_INTERVAL; REAL_NOT_LE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `c SUBSET i' ==> DISJOINT (c DIFF i) (c' DIFF i')`) THEN + REWRITE_TAC[INTERIOR_INTERVAL; CLOSURE_INTERVAL] THEN + SIMP_TAC[SUBSET_INTERVAL; VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; + LAMBDA_BETA] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `c:real^M = b + lambda i. d` THEN SUBGOAL_THEN + `interval[--b:real^M,b] SUBSET interval(--c,c) /\ + interval[--b:real^M,b] SUBSET interval[--c,c] /\ + interval[--c,c] SUBSET interval[--(b + vec 1):real^M,b + vec 1]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL] THEN EXPAND_TAC "c" THEN REPEAT CONJ_TAC THEN + SIMP_TAC[VECTOR_NEG_COMPONENT; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[VEC_COMPONENT] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC + `(g:real^M->real^N) o + closest_point (interval[--c,c] INTER t)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CLOSEST_POINT THEN + ASM_SIMP_TAC[CONVEX_INTER; CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE; + AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; CONVEX_INTERVAL] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))]; + REWRITE_TAC[IMAGE_o] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + MATCH_MP_TAC IMAGE_SUBSET; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN + TRANS_TAC EQ_TRANS `(g:real^M->real^N) x` THEN + CONJ_TAC THENL [AP_TERM_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CLOSEST_POINT_SELF THEN + ASM_SIMP_TAC[IN_INTER; HULL_INC] THEN ASM SET_TAC[]] THEN + (REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `closest_point s x IN s /\ s SUBSET u ==> closest_point s x IN u`) THEN + CONJ_TAC THENL [MATCH_MP_TAC CLOSEST_POINT_IN_SET; ASM SET_TAC[]] THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL; CLOSED_AFFINE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `x IN interval[--c:real^M,c]` THEN + ASM_SIMP_TAC[CLOSEST_POINT_SELF; IN_INTER] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `closest_point s x IN relative_frontier s /\ + DISJOINT k (relative_frontier s) + ==> ~(closest_point s x IN k)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSEST_POINT_IN_RELATIVE_FRONTIER THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_AFFINE; CLOSED_INTERVAL] THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF]] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SUBSET; RELATIVE_INTERIOR_SUBSET; IN_INTER]] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + W(MP_TAC o PART_MATCH (lhs o rand) + AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR o rand o snd) THEN + ASM_SIMP_TAC[HULL_HULL; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX] THEN + ASM_SIMP_TAC[HULL_P] THEN ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[INTERIOR_INTERVAL] THEN ASM SET_TAC[]; + W(MP_TAC o PART_MATCH (lhs o rand) RELATIVE_FRONTIER_CONVEX_INTER_AFFINE o + rand o snd) THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[CONVEX_INTERVAL; AFFINE_AFFINE_HULL; INTERIOR_INTERVAL] THEN + ASM SET_TAC[]]));; + +let EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE = prove + (`!f:real^M->real^N s t a r p. + compact s /\ affine t /\ aff_dim t <= &(dimindex(:N)) /\ s SUBSET t /\ + &0 <= r /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ + (!c. c IN components(t DIFF s) /\ bounded c ==> ~(c INTER p = {})) + ==> ?k g. FINITE k /\ k SUBSET p /\ k SUBSET t /\ DISJOINT k s /\ + g continuous_on (t DIFF k) /\ + IMAGE g (t DIFF k) SUBSET sphere(a,r) /\ + !x. x IN s ==> g x = f x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `r = &0` THENL + [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN + EXISTS_TAC `{}:real^M->bool` THEN + EXISTS_TAC `(\x. a):real^M->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[]; + MP_TAC(ISPECL [`a:real^N`; `r:real`] RELATIVE_FRONTIER_CBALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + STRIP_TAC THEN MATCH_MP_TAC EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +let EXTEND_MAP_UNIV_TO_SPHERE_COFINITE = prove + (`!f:real^M->real^N s a r p. + dimindex(:M) <= dimindex(:N) /\ &0 <= r /\ + compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ + (!c. c IN components((:real^M) DIFF s) /\ bounded c + ==> ~(c INTER p = {})) + ==> ?k g. FINITE k /\ k SUBSET p /\ DISJOINT k s /\ + g continuous_on ((:real^M) DIFF k) /\ + IMAGE g ((:real^M) DIFF k) SUBSET sphere(a,r) /\ + !x. x IN s ==> g x = f x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `(:real^M)`; + `a:real^N`; `r:real`; `p:real^M->bool`] + EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE) THEN + ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; INT_OF_NUM_LE]);; + +let EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT = prove + (`!f:real^M->real^N s a r. + dimindex(:M) <= dimindex(:N) /\ &0 <= r /\ + compact s /\ f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ + (!c. c IN components((:real^M) DIFF s) ==> ~bounded c) + ==> ?g. g continuous_on (:real^M) /\ + IMAGE g (:real^M) SUBSET sphere(a,r) /\ + !x. x IN s ==> g x = f x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `a:real^N`; `r:real`; + `{}:real^M->bool`] EXTEND_MAP_UNIV_TO_SPHERE_COFINITE) THEN + ASM_SIMP_TAC[IMP_CONJ; SUBSET_EMPTY; RIGHT_EXISTS_AND_THM] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; DISJOINT_EMPTY; DIFF_EMPTY] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]);; + +let EXTEND_MAP_SPHERE_TO_SPHERE_GEN = prove + (`!f:real^M->real^N c s t. + closed c /\ c SUBSET relative_frontier s /\ convex s /\ bounded s /\ + convex t /\ bounded t /\ aff_dim s <= aff_dim t /\ + f continuous_on c /\ IMAGE f c SUBSET relative_frontier t + ==> ?g. g continuous_on (relative_frontier s) /\ + IMAGE g (relative_frontier s) SUBSET relative_frontier t /\ + !x. x IN c ==> g x = f x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?p:real^M->bool. polytope p /\ aff_dim p = aff_dim(s:real^M->bool)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC CHOOSE_POLYTOPE THEN + ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV]; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^M->bool`; `p:real^M->bool`] + HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN + ASM_SIMP_TAC[POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED; homeomorphic] THEN + REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`(f:real^M->real^N) o (k:real^M->real^M)`; + `{f:real^M->bool | f face_of p /\ ~(f = p)}`; + `IMAGE (h:real^M->real^M) c`; + `t:real^N->bool`] EXTEND_MAP_CELL_COMPLEX_TO_SPHERE) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[GSYM RELATIVE_FRONTIER_OF_POLYHEDRON_ALT; + POLYTOPE_IMP_POLYHEDRON] THEN + REWRITE_TAC[IN_ELIM_THM; GSYM IMAGE_o; o_THM] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{f:real^M->bool | f face_of p}` THEN + ASM_SIMP_TAC[FINITE_POLYTOPE_FACES] THEN SET_TAC[]; + ASM_MESON_TAC[FACE_OF_POLYTOPE_POLYTOPE; + FACE_OF_AFF_DIM_LT; POLYTOPE_IMP_CONVEX; INT_LTE_TRANS]; + ASM_MESON_TAC[FACE_OF_INTER; FACE_OF_SUBSET; + INTER_SUBSET; FACE_OF_INTER; FACE_OF_IMP_SUBSET]; + ASM SET_TAC[]; + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC] THEN + ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + BOUNDED_SUBSET)) THEN + ASM_SIMP_TAC[BOUNDED_RELATIVE_FRONTIER]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN + REWRITE_TAC[IMAGE_o; o_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]]);; + +let EXTEND_MAP_SPHERE_TO_SPHERE = prove + (`!f:real^M->real^N c a r b s. + dimindex(:M) <= dimindex(:N) /\ closed c /\ c SUBSET sphere(a,r) /\ + f continuous_on c /\ IMAGE f c SUBSET sphere(b,s) /\ + (&0 <= r /\ c = {} ==> &0 <= s) + ==> ?g. g continuous_on sphere(a,r) /\ + IMAGE g (sphere(a,r)) SUBSET sphere(b,s) /\ + !x. x IN c ==> g x = f x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[SPHERE_EMPTY; NOT_IN_EMPTY; CONTINUOUS_ON_EMPTY; + IMAGE_CLAUSES; EMPTY_SUBSET] + THENL [MESON_TAC[]; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN + ASM_CASES_TAC `sphere(b:real^N,s) = {}` THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SPHERE_EQ_EMPTY]) THEN + ASM SET_TAC[]; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPHERE_EQ_EMPTY])] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; CONTINUOUS_ON_SING; REAL_LE_REFL] THENL + [ASM_CASES_TAC `c:real^M->bool = {}` THENL + [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC(MESON[] + `(?c. P(\x. c)) ==> ?f. P f`) THEN ASM SET_TAC[]; + DISCH_TAC THEN EXISTS_TAC `f:real^M->real^N` THEN ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `s = &0` THENL + [ASM_SIMP_TAC[SPHERE_SING] THEN STRIP_TAC THEN + EXISTS_TAC `(\x. b):real^M->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; + ALL_TAC] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`; + `cball(a:real^M,r)`; `cball(b:real^N,s)`] + EXTEND_MAP_SPHERE_TO_SPHERE_GEN) THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; AFF_DIM_CBALL; + RELATIVE_FRONTIER_CBALL] THEN + DISCH_THEN MATCH_MP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[INT_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC);; + +let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN = prove + (`!f:real^M->real^N s t u p. + convex t /\ bounded t /\ convex u /\ bounded u /\ + aff_dim t <= aff_dim u + &1 /\ + closed s /\ s SUBSET relative_frontier t /\ + f continuous_on s /\ IMAGE f s SUBSET relative_frontier u /\ + (!c. c IN components(relative_frontier t DIFF s) ==> ~(c INTER p = {})) + ==> ?k g. FINITE k /\ k SUBSET p /\ + k SUBSET relative_frontier t /\ DISJOINT k s /\ + g continuous_on (relative_frontier t DIFF k) /\ + IMAGE g (relative_frontier t DIFF k) SUBSET + relative_frontier u /\ + !x. x IN s ==> g x = f x`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s = (relative_frontier t:real^M->bool)` THENL + [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN + ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[]; + POP_ASSUM MP_TAC] THEN + ASM_CASES_TAC `relative_frontier t:real^M->bool = {}` THENL + [ASM SET_TAC[]; REPEAT STRIP_TAC] THEN + SUBGOAL_THEN + `?c q:real^M. c IN components (relative_frontier t DIFF s) /\ + q IN c /\ q IN relative_frontier t /\ ~(q IN s) /\ q IN p` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `(relative_frontier t:real^M->bool) DIFF s` + UNIONS_COMPONENTS) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s = u ==> ~(s = {}) ==> ~(u = {})`)) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[EMPTY_UNIONS]] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^M->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM IN_DIFF] THEN + ASM_MESON_TAC[SUBSET; IN_COMPONENTS_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN + `?af. affine af /\ aff_dim(t:real^M->bool) = aff_dim(af:real^M->bool) + &1` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^M)`; `aff_dim(t:real^M->bool) - &1`] + CHOOSE_AFFINE_SUBSET) THEN + REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL + [MATCH_MP_TAC(INT_ARITH + `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN + REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN + ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY]; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL [`t:real^M->bool`; `af:real^M->bool`; `q:real^M`] + HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN + ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^M->real^M`; `k:real^M->real^M`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`(f:real^M->real^N) o (k:real^M->real^M)`; + `IMAGE (h:real^M->real^M) s`; + `(af:real^M->bool)`; + `u:real^N->bool`; + `IMAGE (h:real^M->real^M) (p INTER relative_frontier t DELETE q)`] + EXTEND_MAP_AFFINE_TO_SPHERE_COFINITE_GEN) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; + COMPACT_RELATIVE_FRONTIER_BOUNDED]]; + ASM_INT_ARITH_TAC; + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + X_GEN_TAC `l:real^M->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `~(l:real^M->bool = {})` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `?x:real^M. x IN l` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `l SUBSET af DIFF IMAGE (h:real^M->real^M) s` + ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `connected(l:real^M->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN + SUBGOAL_THEN + `?r. r IN components (relative_frontier t DIFF s) /\ + IMAGE (k:real^M->real^M) l SUBSET r` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN + EXISTS_TAC `connected_component (relative_frontier t DIFF s) + ((k:real^M->real^M) x)` THEN + EXISTS_TAC `(k:real^M->real^M) x` THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_SIMP_TAC[FUN_IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `r:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INTER] THEN + X_GEN_TAC `z:real^M` THEN STRIP_TAC THEN + SUBGOAL_THEN `r SUBSET ((relative_frontier t:real^M->bool) DIFF s)` + ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `connected(r:real^M->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN + ASM_CASES_TAC `(q:real^M) IN r` THENL + [ALL_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `(h:real^M->real^M) z` THEN REWRITE_TAC[IN_INTER] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN + EXISTS_TAC `IMAGE (h:real^M->real^M) r` THEN + ASM_SIMP_TAC[FUN_IN_IMAGE] THEN MATCH_MP_TAC COMPONENTS_MAXIMAL THEN + EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE + `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN + X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN + MATCH_MP_TAC(MESON[] + `k(h y) = y /\ k(h y') = y' /\ ~(y = y') + ==> k(h y) = k(h y') ==> F`) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]] THEN + SUBGOAL_THEN + `?n. open_in (subtopology euclidean (relative_frontier t)) n /\ + (q:real^M) IN n /\ n INTER IMAGE (k:real^M->real^M) l = {}` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `relative_frontier t DIFF + IMAGE (k:real^M->real^M) (closure l)` THEN + SUBGOAL_THEN `closure l SUBSET (af:real^M->bool)` ASSUME_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[CLOSED_AFFINE] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]; + MP_TAC(ISPEC `l:real^M->bool` CLOSURE_SUBSET) THEN SET_TAC[]]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + SUBGOAL_THEN + `?w. connected w /\ w SUBSET r DELETE q /\ + (k:real^M->real^M) x IN w /\ ~((n DELETE q) INTER w = {})` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(TAUT `F ==> p`) THEN + SUBGOAL_THEN `IMAGE (h:real^M->real^M) w SUBSET l` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC COMPONENTS_MAXIMAL THEN + EXISTS_TAC `af DIFF IMAGE (h:real^M->real^M) s` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE + `~(h y IN IMAGE h s) <=> !y'. y' IN s ==> ~(h y = h y')`] THEN + X_GEN_TAC `y':real^M` THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `k:real^M->real^M`) THEN + MATCH_MP_TAC(MESON[] + `k(h y) = y /\ k(h y') = y' /\ ~(y = y') + ==> k(h y) = k(h y') ==> F`) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]] THEN + SUBGOAL_THEN `path_connected(r:real^M->bool)` MP_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) PATH_CONNECTED_EQ_CONNECTED_LPC o + snd) THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN + ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE_GEN] THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN + EXISTS_TAC `(relative_frontier t:real^M->bool) DIFF s` THEN + CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN + ASM_SIMP_TAC[LOCALLY_CONNECTED_SPHERE_GEN]; + ALL_TAC] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN + DISCH_THEN(MP_TAC o SPECL [`(k:real^M->real^M) x`; `q:real^M`]) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC o + GEN_REWRITE_RULE I [arc]) THEN + DISCH_TAC THEN + SUBGOAL_THEN + `open_in (subtopology euclidean (interval[vec 0,vec 1])) + {x | x IN interval[vec 0,vec 1] /\ + (g:real^1->real^M) x IN n}` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `(relative_frontier t:real^M->bool)` THEN + ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[OPEN_IN_CONTAINS_CBALL] THEN + REWRITE_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN + DISCH_THEN(MP_TAC o SPEC `vec 1:real^1`) THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ABBREV_TAC `t' = lift(&1 - min (&1 / &2) r)` THEN + SUBGOAL_THEN `t' IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL + [EXPAND_TAC "t'" THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `t':real^1`) THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_CBALL; DIST_REAL; + DROP_VEC; GSYM drop] THEN + ANTS_TAC THENL + [EXPAND_TAC "t'" THEN REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC] THEN + EXISTS_TAC `IMAGE (g:real^1->real^M) (interval[vec 0,t'])` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + REWRITE_TAC[CONNECTED_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[GSYM path; SUBSET_INTERVAL_1] THEN + ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1]; + REWRITE_TAC[SET_RULE + `s SUBSET t DELETE q <=> s SUBSET t /\ !x. x IN s ==> ~(x = q)`] THEN + CONJ_TAC THENL + [TRANS_TAC SUBSET_TRANS + `IMAGE (g:real^1->real^M) (interval[vec 0,vec 1])` THEN + CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_REWRITE_TAC[REAL_LE_REFL; GSYM IN_INTERVAL_1; + SUBSET_INTERVAL_1]; + ASM_REWRITE_TAC[GSYM path_image]]; + REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `t'':real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [SYM th]) THEN + REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`t'':real^1`; `vec 1:real^1`]) THEN + ASM_REWRITE_TAC[GSYM DROP_EQ] THEN + UNDISCH_TAC `t'' IN interval[vec 0:real^1,t']` THEN + EXPAND_TAC "t'" THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN + CONJ_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN + EXPAND_TAC "t'" THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IN_INTER] THEN + EXISTS_TAC `t':real^1` THEN CONJ_TAC THENL + [EXPAND_TAC "t'" THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[IN_DELETE] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [SYM th]) THEN + REWRITE_TAC[pathfinish] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`t':real^1`; `vec 1:real^1`]) THEN + ASM_REWRITE_TAC[GSYM DROP_EQ] THEN + EXPAND_TAC "t'" THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]]]; + ALL_TAC] THEN + ASM_SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`tk:real^M->bool`; `g:real^M->real^N`] THEN + REWRITE_TAC[o_THM] THEN + STRIP_TAC THEN EXISTS_TAC `q INSERT IMAGE (k:real^M->real^M) tk` THEN + EXISTS_TAC `(g:real^M->real^N) o (h:real^M->real^M)` THEN + ASM_SIMP_TAC[FINITE_INSERT; FINITE_IMAGE; o_THM] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `a IN t /\ s SUBSET t DELETE a ==> a INSERT s SUBSET t`) THEN + ASM_REWRITE_TAC[] THEN + TRANS_TAC SUBSET_TRANS + `p INTER (relative_frontier t:real^M->bool) DELETE q` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `t SUBSET IMAGE h s ==> IMAGE k (IMAGE h s) SUBSET s + ==> IMAGE k t SUBSET s`)) THEN + REWRITE_TAC[GSYM IMAGE_o] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = x) ==> IMAGE f s SUBSET s`) THEN + REWRITE_TAC[o_THM] THEN ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE = prove + (`!f:real^M->real^N s a d b e p. + dimindex(:M) <= dimindex(:N) + 1 /\ + (&0 < d /\ s = {} ==> &0 <= e) /\ + closed s /\ s SUBSET sphere(a,d) /\ + f continuous_on s /\ IMAGE f s SUBSET sphere(b,e) /\ + (!c. c IN components(sphere(a,d) DIFF s) ==> ~(c INTER p = {})) + ==> ?k g. FINITE k /\ k SUBSET p /\ + k SUBSET sphere(a,d) /\ DISJOINT k s /\ + g continuous_on (sphere(a,d) DIFF k) /\ + IMAGE g (sphere(a,d) DIFF k) SUBSET sphere(b,e) /\ + !x. x IN s ==> g x = f x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s = sphere(a:real^M,d)` THENL + [ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`{}:real^M->bool`; `f:real^M->real^N`] THEN + ASM_REWRITE_TAC[FINITE_EMPTY; DIFF_EMPTY] THEN SET_TAC[]; + POP_ASSUM MP_TAC] THEN + ASM_CASES_TAC `d < &0` THENL + [ASM_SIMP_TAC[SPHERE_EMPTY] THEN SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `d = &0` THENL + [ASM_SIMP_TAC[SPHERE_SING] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `{a:real^M}` THEN + REWRITE_TAC[FINITE_SING; CONTINUOUS_ON_EMPTY; DIFF_EQ_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{a:real^M}`) THEN + REWRITE_TAC[DIFF_EMPTY; IN_COMPONENTS_SELF; CONNECTED_SING] THEN + REWRITE_TAC[IMAGE_CLAUSES] THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `e = &0` THENL + [ASM_SIMP_TAC[SPHERE_SING] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `{}:real^M->bool` THEN + EXISTS_TAC `(\x. b):real^M->real^N` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; FINITE_EMPTY] THEN ASM SET_TAC[]; + REPEAT STRIP_TAC] THEN + SUBGOAL_THEN `&0 <= e` ASSUME_TAC THENL + [ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_SIMP_TAC[] THEN + MP_TAC(SYM(ISPECL [`b:real^N`; `e:real`] SPHERE_EQ_EMPTY)) THEN + SIMP_TAC[GSYM REAL_NOT_LT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `s:real^M->bool`; `cball(a:real^M,d)`; + `cball(b:real^N,e)`; `p:real^M->bool`] + EXTEND_MAP_SPHERE_TO_SPHERE_COFINITE_GEN) THEN + ASM_REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL] THEN + REWRITE_TAC[AFF_DIM_CBALL] THEN + MP_TAC(ISPECL [`a:real^M`; `d:real`] RELATIVE_FRONTIER_CBALL) THEN + MP_TAC(ISPECL [`b:real^N`; `e:real`] RELATIVE_FRONTIER_CBALL) THEN + ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN + ASM_REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Borsuk-style characterization of separation. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_BORSUK_MAP = prove + (`!s a:real^N. + ~(a IN s) ==> (\x. inv(norm (x - a)) % (x - a)) continuous_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV); ALL_TAC] THEN + SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]);; + +let BORSUK_MAP_INTO_SPHERE = prove + (`!s a:real^N. + IMAGE (\x. inv(norm (x - a)) % (x - a)) s SUBSET sphere(vec 0,&1) <=> + ~(a IN s)`, + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + REWRITE_TAC[REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`] THEN + REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN MESON_TAC[]);; + +let BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT = prove + (`!s a b. path_component ((:real^N) DIFF s) a b + ==> homotopic_with (\x. T) (s,sphere(vec 0,&1)) + (\x. inv(norm(x - a)) % (x - a)) + (\x. inv(norm(x - b)) % (x - b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET; + FORALL_IN_IMAGE; IN_UNIV; IN_DIFF] THEN + X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN + SIMP_TAC[HOMOTOPIC_WITH] THEN + EXISTS_TAC `\z. inv(norm(sndcart z - g(fstcart z))) % + (sndcart z - (g:real^1->real^N)(fstcart z))` THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_SPHERE_0; + SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + NORM_EQ_0; VECTOR_SUB_EQ] THEN CONJ_TAC + THENL [MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE; ASM_MESON_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + REWRITE_TAC[IMAGE_FSTCART_PCROSS] THEN ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]; + REPEAT STRIP_TAC THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_MUL_LINV THEN + ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN ASM_MESON_TAC[]]);; + +let NON_EXTENSIBLE_BORSUK_MAP = prove + (`!s c a:real^N. + compact s /\ c IN components((:real^N) DIFF s) /\ bounded c /\ a IN c + ==> ~(?g. g continuous_on (s UNION c) /\ + IMAGE g (s UNION c) SUBSET sphere (vec 0,&1) /\ + (!x. x IN s ==> g x = inv(norm(x - a)) % (x - a)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + SUBGOAL_THEN `c = connected_component ((:real^N) DIFF s) a` SUBST_ALL_TAC + THENL [ASM_MESON_TAC[IN_COMPONENTS; CONNECTED_COMPONENT_EQ]; ALL_TAC] THEN + MP_TAC(ISPECL + [`s UNION connected_component ((:real^N) DIFF s) a`; `a:real^N`] + BOUNDED_SUBSET_BALL) THEN + ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o MATCH_MP NO_RETRACTION_CBALL) THEN + REWRITE_TAC[retract_of; retraction] THEN + EXISTS_TAC `\x. if x IN connected_component ((:real^N) DIFF s) a + then a + r % g(x) + else a + r % inv(norm(x - a)) % (x - a)` THEN + REWRITE_TAC[SPHERE_SUBSET_CBALL] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `cball(a:real^N,r) = + (s UNION connected_component ((:real^N) DIFF s) a) UNION + (cball(a,r) DIFF connected_component ((:real^N) DIFF s) a)` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN ASM + SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN + ASM_SIMP_TAC[IN_COMPONENTS; COMPACT_IMP_CLOSED; IN_UNIV; IN_DIFF] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC CLOSED_DIFF THEN + ASM_SIMP_TAC[CLOSED_CBALL; OPEN_CONNECTED_COMPONENT; GSYM closed; + COMPACT_IMP_CLOSED]; + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN ASM_SIMP_TAC[CONTINUOUS_ON_CONST]; + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_BORSUK_MAP THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; IN_DIFF; REAL_LT_IMP_LE] THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]; + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; + + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_SPHERE; NORM_ARITH `dist(a:real^N,a + x) = norm x`; + NORM_MUL] THEN + ASM_SIMP_TAC[REAL_ABS_INV; REAL_ABS_NORM; VECTOR_SUB_EQ; + REAL_FIELD `&0 < r ==> abs r = r /\ (r * x = r <=> x = &1)`; + REAL_FIELD `inv x * x = &1 <=> ~(x = &0)`; NORM_EQ_0] + THENL + [ONCE_REWRITE_TAC[GSYM IN_SPHERE_0] THEN ASM SET_TAC[]; + UNDISCH_TAC `~(x IN connected_component ((:real^N) DIFF s) a)` THEN + SIMP_TAC[CONTRAPOS_THM; IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]; + SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s UNION t SUBSET u ==> !x. x IN t /\ ~(x IN u) ==> wev`)) THEN + EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[NORM_SUB] dist; IN_BALL; + REAL_LT_REFL]]);; + +let BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT = prove + (`!s a. compact s /\ ~(a IN s) + ==> (bounded(connected_component ((:real^N) DIFF s) a) <=> + ~(?c. homotopic_with (\x. T) (s,sphere(vec 0:real^N,&1)) + (\x. inv(norm(x - a)) % (x - a)) (\x. c)))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV; NOT_BOUNDED_UNIV] THEN + SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES; + CONTINUOUS_ON_EMPTY; EMPTY_SUBSET]; + ALL_TAC] THEN + EQ_TAC THENL + [ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + REPEAT DISCH_TAC THEN + MP_TAC(ISPECL + [`\x:real^N. inv(norm(x - a)) % (x - a)`; `s:real^N->bool`; + `vec 0:real^N`; `&1`] + NULLHOMOTOPIC_INTO_SPHERE_EXTENSION) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; NOT_IMP; CONTINUOUS_ON_BORSUK_MAP; + BORSUK_MAP_INTO_SPHERE] THEN + MP_TAC(ISPECL [`s:real^N->bool`; + `connected_component ((:real^N) DIFF s) a`; + `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[]; + REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]; SET_TAC[]]]; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL o + MATCH_MP COMPACT_IMP_BOUNDED) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?b. b IN connected_component ((:real^N) DIFF s) a /\ + ~(b IN ball(vec 0,r))` + MP_TAC THENL + [REWRITE_TAC[SET_RULE `(?b. b IN s /\ ~(b IN t)) <=> ~(s SUBSET t)`] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL]; + DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `?c. homotopic_with (\x. T) (ball(vec 0:real^N,r),sphere (vec 0,&1)) + (\x. inv (norm (x - b)) % (x - b)) (\x. c)` + MP_TAC THENL + [MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE; + CONVEX_IMP_CONTRACTIBLE; CONVEX_BALL]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN STRIP_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN + EXISTS_TAC `\x:real^N. inv(norm (x - b)) % (x - b)` THEN CONJ_TAC THENL + [MATCH_MP_TAC BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT THEN + ASM_SIMP_TAC[OPEN_PATH_CONNECTED_COMPONENT; GSYM closed; + COMPACT_IMP_CLOSED] THEN ASM_MESON_TAC[IN]; + ASM_MESON_TAC[HOMOTOPIC_WITH_SUBSET_LEFT]]]);; + +let HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT = prove + (`!s a b. + compact s /\ ~(a IN s) /\ ~(b IN s) /\ + bounded (connected_component ((:real^N) DIFF s) a) /\ + homotopic_with (\x. T) (s,sphere(vec 0,&1)) + (\x. inv(norm(x - a)) % (x - a)) + (\x. inv(norm(x - b)) % (x - b)) + ==> connected_component ((:real^N) DIFF s) a b`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM IN] THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `connected_component ((:real^N) DIFF s) a`; + `a:real^N`] NON_EXTENSIBLE_BORSUK_MAP) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_REWRITE_TAC[IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN ASM_MESON_TAC[]; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM]] THEN + DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC BORSUK_HOMOTOPY_EXTENSION THEN + EXISTS_TAC `\x:real^N. inv(norm(x - b)) % (x - b)` THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; ANR_SPHERE; + CLOSED_SUBSET; SUBSET_UNION] THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_BORSUK_MAP; IN_UNION; BORSUK_MAP_INTO_SPHERE] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + MATCH_MP_TAC CLOSED_UNION_COMPLEMENT_COMPONENT THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; IN_COMPONENTS; IN_DIFF; IN_UNIV] THEN + ASM_MESON_TAC[]);; + +let BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ = prove + (`!s a b. 2 <= dimindex(:N) /\ compact s /\ ~(a IN s) /\ ~(b IN s) + ==> (homotopic_with (\x. T) (s,sphere(vec 0,&1)) + (\x. inv(norm(x - a)) % (x - a)) + (\x. inv(norm(x - b)) % (x - b)) <=> + connected_component ((:real^N) DIFF s) a b)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC; + ASM_SIMP_TAC[GSYM OPEN_PATH_CONNECTED_COMPONENT; GSYM closed; + COMPACT_IMP_CLOSED] THEN + REWRITE_TAC[BORSUK_MAPS_HOMOTOPIC_IN_PATH_COMPONENT]] THEN + ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) a)` THENL + [MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `bounded(connected_component ((:real^N) DIFF s) b)` THENL + [ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN + MATCH_MP_TAC HOMOTOPIC_BORSUK_MAPS_IN_BOUNDED_COMPONENT THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^N) DIFF s`; `a:real^N`; `b:real^N`] + COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV; + SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]);; + +let BORSUK_SEPARATION_THEOREM_GEN = prove + (`!s:real^N->bool. + compact s + ==> ((!c. c IN components((:real^N) DIFF s) ==> ~bounded c) <=> + (!f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1) + ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c)))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; components; EXISTS_IN_GSPEC; NOT_IMP; + IN_UNIV; IN_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:real^N. inv(norm(x - a)) % (x - a)` THEN + ASM_SIMP_TAC[GSYM BORSUK_MAP_ESSENTIAL_BOUNDED_COMPONENT; + CONTINUOUS_ON_BORSUK_MAP; BORSUK_MAP_INTO_SPHERE]] THEN + DISCH_TAC THEN X_GEN_TAC `f:real^N->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real^N->real^N`; `s:real^N->bool`; `vec 0:real^N`; `&1:real`] + EXTEND_MAP_UNIV_TO_SPHERE_NO_BOUNDED_COMPONENT) THEN + ASM_REWRITE_TAC[LE_REFL; REAL_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`g:real^N->real^N`; `(:real^N)`; `sphere(vec 0:real^N,&1)`] + NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN + ASM_REWRITE_TAC[CONTRACTIBLE_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_SUBSET_LEFT)) THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] + HOMOTOPIC_WITH_EQ) THEN + ASM_SIMP_TAC[]);; + +let BORSUK_SEPARATION_THEOREM = prove + (`!s:real^N->bool. + 2 <= dimindex(:N) /\ compact s + ==> (connected((:real^N) DIFF s) <=> + !f. f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0:real^N,&1) + ==> ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) f (\x. c))`, + SIMP_TAC[GSYM BORSUK_SEPARATION_THEOREM_GEN] THEN + X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPEC `(:real^N) DIFF s` COMPONENTS_EQ_SING) THEN + MP_TAC(ISPEC `(:real^N) DIFF s` COBOUNDED_IMP_UNBOUNDED) THEN + ASM_CASES_TAC `(:real^N) DIFF s = {}` THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; + BOUNDED_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY]; + + REWRITE_TAC[components; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN + DISCH_TAC THEN REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ] THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; + SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]]);; + +let HOMOTOPY_EQUIVALENT_SEPARATION = prove + (`!s t. compact s /\ compact t /\ s homotopy_equivalent t + ==> (connected((:real^N) DIFF s) <=> connected((:real^N) DIFF t))`, + let special = prove + (`!s:real^1->bool. + bounded s /\ connected((:real^1) DIFF s) ==> s = {}`, + REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; EXTENSION; NOT_IN_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_INTERVAL_1]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + REWRITE_TAC[IN_UNIV; IN_DIFF; SUBSET; IN_INTERVAL_1] THEN + MESON_TAC[REAL_LT_REFL; REAL_LT_IMP_LE]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL + [REWRITE_TAC[DIMINDEX_GE_1]; + REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`] THEN + REWRITE_TAC[GSYM DIMINDEX_1]] THEN + STRIP_TAC THENL + [ASSUME_TAC(GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`) + special) THEN + EQ_TAC THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`); + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`)] THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN DISCH_TAC THEN + UNDISCH_TAC `(s:real^N->bool) homotopy_equivalent (t:real^N->bool)` THEN + ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[CONNECTED_UNIV; DIFF_EMPTY]; + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BORSUK_SEPARATION_THEOREM] THEN + MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN + ASM_REWRITE_TAC[]]);; + +let JORDAN_BROUWER_SEPARATION = prove + (`!s a:real^N r. + &0 < r /\ s homeomorphic sphere(a,r) ==> ~connected((:real^N) DIFF s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `sphere(a:real^N,r)`] + HOMOTOPY_EQUIVALENT_SEPARATION) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE; + HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]; + DISCH_THEN SUBST1_TAC] THEN + DISCH_TAC THEN MP_TAC(ISPECL + [`(:real^N) DIFF sphere(a,r)`; + `ball(a:real^N,r)`] CONNECTED_INTER_FRONTIER) THEN + ASM_SIMP_TAC[FRONTIER_BALL; NOT_IMP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM CBALL_DIFF_BALL] THEN MATCH_MP_TAC(SET_RULE + `~(b = {}) + ==> ~((UNIV DIFF (c DIFF b)) INTER b = {})`) THEN + ASM_SIMP_TAC[BALL_EQ_EMPTY; REAL_NOT_LE]; + MATCH_MP_TAC(SET_RULE + `~(s UNION t = UNIV) ==> ~(UNIV DIFF t DIFF s = {})`) THEN + REWRITE_TAC[BALL_UNION_SPHERE] THEN + MESON_TAC[BOUNDED_CBALL; NOT_BOUNDED_UNIV]; + SET_TAC[]]);; + +let JORDAN_BROUWER_FRONTIER = prove + (`!s t a:real^N r. + 2 <= dimindex(:N) /\ + s homeomorphic sphere(a,r) /\ t IN components((:real^N) DIFF s) + ==> frontier t = s`, + let lemma = prove + (`!s a r. 2 <= dimindex(:N) /\ &0 < r /\ s PSUBSET sphere(a,r) + ==> connected((:real^N) DIFF s)`, + REWRITE_TAC[PSUBSET_ALT; SUBSET; IN_SPHERE; GSYM REAL_LE_ANTISYM] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(:real^N) DIFF s = + {x:real^N | dist(a,x) <= r /\ ~(x IN s)} UNION + {x:real^N | r <= dist(a,x) /\ ~(x IN s)}` + SUBST1_TAC THENL + [SET_TAC[REAL_LE_TOTAL]; MATCH_MP_TAC CONNECTED_UNION] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `ball(a:real^N,r)` THEN + ASM_SIMP_TAC[CONNECTED_BALL; CLOSURE_BALL; SUBSET; IN_BALL; IN_CBALL; + IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]; + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `(:real^N) DIFF cball(a,r)` THEN + REWRITE_TAC[CLOSURE_COMPLEMENT; SUBSET; IN_DIFF; IN_UNIV; + IN_BALL; IN_CBALL; IN_ELIM_THM; INTERIOR_CBALL] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_NOT_LE]] THEN + MATCH_MP_TAC CONNECTED_OPEN_DIFF_CBALL THEN + ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV; OPEN_UNIV]; + ASM SET_TAC[]]) in + MAP_EVERY X_GEN_TAC + [`s:real^N->bool`; `c:real^N->bool`; `a:real^N`; `r:real`] THEN + ASM_CASES_TAC `r < &0` THENL + [ASM_SIMP_TAC[SPHERE_EMPTY; HOMEOMORPHIC_EMPTY; IMP_CONJ; DIFF_EMPTY] THEN + SIMP_TAC[snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); + UNIV_NOT_EMPTY; CONNECTED_UNIV; IN_SING; FRONTIER_UNIV]; + ALL_TAC] THEN + ASM_CASES_TAC `r = &0` THENL + [ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; SPHERE_SING; FINITE_SING] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_EMPTY; GSYM HAS_SIZE; NOT_IN_EMPTY] THEN + REWRITE_TAC[HAS_SIZE_CLAUSES; UNWIND_THM2; NOT_IN_EMPTY; IMP_CONJ] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; CONNECTED_PUNCTURED_UNIVERSE; IN_SING; + snd(EQ_IMP_RULE(SPEC_ALL COMPONENTS_EQ_SING)); FRONTIER_SING; + SET_RULE `UNIV DIFF s = {} <=> s = UNIV`; FRONTIER_COMPLEMENT; + MESON[BOUNDED_SING; NOT_BOUNDED_UNIV] `~((:real^N) = {a})`]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN + SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED] THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[JORDAN_BROUWER_SEPARATION]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`t:real^N->bool`; `IMAGE (f:real^N->real^N) t`] + HOMOTOPY_EQUIVALENT_SEPARATION) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; PSUBSET]; + DISCH_TAC THEN + SUBGOAL_THEN `t homeomorphic (IMAGE (f:real^N->real^N) t)` MP_TAC THENL + [REWRITE_TAC[homeomorphic] THEN MAP_EVERY EXISTS_TAC + [`f:real^N->real^N`; `g:real^N->real^N`] THEN + ASM_REWRITE_TAC[HOMEOMORPHISM] THEN REPEAT CONJ_TAC THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET))) THEN ASM SET_TAC[]; + ASM_MESON_TAC[HOMEOMORPHIC_COMPACTNESS; + HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]]]; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `r:real`] THEN ASM SET_TAC[]]);; + +let JORDAN_BROUWER_NONSEPARATION = prove + (`!s t a:real^N r. + 2 <= dimindex(:N) /\ + s homeomorphic sphere(a,r) /\ t PSUBSET s + ==> connected((:real^N) DIFF t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!c. c IN components((:real^N) DIFF s) + ==> connected(c UNION (s DIFF t))` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `c:real^N->bool` THEN + CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; ALL_TAC] THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[UNION_SUBSET; CLOSURE_SUBSET]] THEN + SUBGOAL_THEN `s:real^N->bool = frontier c` SUBST1_TAC THENL + [ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER]; ALL_TAC] THEN + REWRITE_TAC[frontier] THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(components((:real^N) DIFF s) = {})` + ASSUME_TAC THENL + [REWRITE_TAC[COMPONENTS_EQ_EMPTY; SET_RULE + `UNIV DIFF s = {} <=> s = UNIV`] THEN + ASM_MESON_TAC[NOT_BOUNDED_UNIV; COMPACT_EQ_BOUNDED_CLOSED; + HOMEOMORPHIC_COMPACTNESS; COMPACT_SPHERE]; + ALL_TAC] THEN + SUBGOAL_THEN + `(:real^N) DIFF t = + UNIONS {c UNION (s DIFF t) | c | c IN components((:real^N) DIFF s)}` + SUBST1_TAC THENL + [MP_TAC(ISPEC `(:real^N) DIFF s` UNIONS_COMPONENTS) THEN + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_UNIONS THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[INTERS_GSPEC] THEN ASM SET_TAC[]]);; + +let JORDAN_BROUWER_ACCESSIBILITY = prove + (`!s c a:real^N r v x. + 2 <= dimindex(:N) /\ + s homeomorphic sphere(a,r) /\ + c IN components((:real^N) DIFF s) /\ x IN c /\ + open_in (subtopology euclidean s) v /\ ~(v = {}) + ==> ?g. arc g /\ + IMAGE g (interval[vec 0,vec 1] DELETE (vec 1)) SUBSET c /\ + pathstart g = x /\ + pathfinish g IN v`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN + REWRITE_TAC[COMPACT_SPHERE] THEN + REWRITE_TAC[closed; COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN + MATCH_MP_TAC DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[JORDAN_BROUWER_FRONTIER; OPEN_COMPONENTS; + IN_COMPONENTS_CONNECTED]);; + +(* ------------------------------------------------------------------------- *) +(* Invariance of domain and corollaries. *) +(* ------------------------------------------------------------------------- *) + +let INVARIANCE_OF_DOMAIN = prove + (`!f:real^N->real^N s. + f continuous_on s /\ open s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> open(IMAGE f s)`, + let lemma = prove + (`!f:real^N->real^N a r. + f continuous_on cball(a,r) /\ &0 < r /\ + (!x y. x IN cball(a,r) /\ y IN cball(a,r) /\ f x = f y ==> x = y) + ==> open(IMAGE f (ball(a,r)))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [MP_TAC(ISPECL [`(:real^N)`; `(:real^1)`] ISOMETRIES_SUBSPACES) THEN + ASM_SIMP_TAC[SUBSPACE_UNIV; DIM_UNIV; DIMINDEX_1; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `k:real^1->real^N`] THEN + REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(h:real^N->real^1) o f o (k:real^1->real^N)`; + `IMAGE (h:real^N->real^1) (cball(a,r))`] + INJECTIVE_EQ_1D_OPEN_MAP_UNIV) THEN + MATCH_MP_TAC(TAUT + `p /\ q /\ r /\ (s ==> t) + ==> (p /\ q ==> (r <=> s)) ==> t`) THEN + REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; GSYM IMAGE_o] THEN + ASM_REWRITE_TAC[o_DEF; IMAGE_ID]; + REWRITE_TAC[IS_INTERVAL_CONNECTED_1] THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CBALL]; + ASM_SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_IMAGE; o_DEF] THEN + ASM SET_TAC[]; + DISCH_THEN(MP_TAC o SPEC `IMAGE (h:real^N->real^1) (ball(a,r))`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET; BALL_SUBSET_CBALL; GSYM IMAGE_o] THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`a:real^N`; `r:real`] OPEN_BALL); ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THENL + [CONV_TAC SYM_CONV; + REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[IMAGE_o] THEN + ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN + MATCH_MP_TAC OPEN_BIJECTIVE_LINEAR_IMAGE_EQ THEN + ASM_MESON_TAC[]]; + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN + REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE (f:real^N->real^N) (sphere(a,r))`; + `a:real^N`; `r:real`] + JORDAN_BROUWER_SEPARATION) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN EXISTS_TAC `f:real^N->real^N` THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL; + COMPACT_SPHERE]; + DISCH_TAC] THEN + MP_TAC(ISPEC `(:real^N) DIFF IMAGE f (sphere(a:real^N,r))` + COBOUNDED_HAS_BOUNDED_COMPONENT) THEN + ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL; + COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_BOUNDED]; + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `IMAGE (f:real^N->real^N) (ball(a,r)) = c` + SUBST1_TAC THENL + [ALL_TAC; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + OPEN_COMPONENTS)) THEN + REWRITE_TAC[GSYM closed] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET; SPHERE_SUBSET_CBALL; + COMPACT_SPHERE; COMPACT_CONTINUOUS_IMAGE; COMPACT_IMP_CLOSED]] THEN + MATCH_MP_TAC(SET_RULE + `~(c = {}) /\ (~(c INTER t = {}) ==> t SUBSET c) /\ c SUBSET t + ==> t = c`) THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COMPONENTS_MAXIMAL)) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + REWRITE_TAC[CONNECTED_BALL] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; BALL_SUBSET_CBALL]; + REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN + ASM SET_TAC[]]; + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + FIRST_ASSUM(MP_TAC o SPEC `(:real^N) DIFF IMAGE f (cball(a:real^N,r))` o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COMPONENTS_MAXIMAL)) THEN + SIMP_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`; + IMAGE_SUBSET; SPHERE_SUBSET_CBALL] THEN + MATCH_MP_TAC(TAUT `p /\ ~r /\ (~q ==> s) ==> (p /\ q ==> r) ==> s`) THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(INST_TYPE [`:N`,`:M`] + CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT) THEN + EXISTS_TAC `cball(a:real^N,r)` THEN + ASM_REWRITE_TAC[CONVEX_CBALL; COMPACT_CBALL] THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + EXISTS_TAC `f:real^N->real^N` THEN ASM_REWRITE_TAC[COMPACT_CBALL]; + DISCH_THEN(MP_TAC o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COBOUNDED_IMP_UNBOUNDED THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + ASM_MESON_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE; + COMPACT_CBALL]; + REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]]]) in + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (f:real^N->real^N) (ball(a,r))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC lemma THEN ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; + ASM_SIMP_TAC[FUN_IN_IMAGE; CENTRE_IN_BALL]; + MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]]);; + +let INVARIANCE_OF_DOMAIN_SUBSPACES = prove + (`!f:real^M->real^N u v s. + subspace u /\ subspace v /\ dim v <= dim u /\ + f continuous_on s /\ IMAGE f s SUBSET v /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + open_in (subtopology euclidean u) s + ==> open_in (subtopology euclidean v) (IMAGE f s)`, + let lemma0 = prove + (`!f:real^M->real^M s u. + subspace s /\ dim s = dimindex(:N) /\ + f continuous_on u /\ IMAGE f u SUBSET s /\ + (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\ + open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean s) (IMAGE f u)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`(:real^N)`; `s:real^M->bool`] + HOMEOMORPHIC_SUBSPACES) THEN + ASM_REWRITE_TAC[DIM_UNIV; SUBSPACE_UNIV] THEN + REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`(k:real^M->real^N) o f o (h:real^N->real^M)`; + `IMAGE (k:real^M->real^N) u`] INVARIANCE_OF_DOMAIN) THEN + REWRITE_TAC[GSYM IMAGE_o; o_THM] THEN + SUBGOAL_THEN + `!t. open t <=> + open_in (subtopology euclidean (IMAGE (k:real^M->real^N) s)) t` + (fun th -> REWRITE_TAC[th]) + THENL [ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN]; ALL_TAC] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[homeomorphism]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `IMAGE f u = + IMAGE (h:real^N->real^M) (IMAGE ((k o f o h) o (k:real^M->real^N)) u)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`k:real^M->real^N`; `(:real^N)`] THEN + ASM_REWRITE_TAC[homeomorphism]]]) in + let lemma1 = prove + (`!f:real^N->real^N s u. + subspace s /\ f continuous_on u /\ IMAGE f u SUBSET s /\ + (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) /\ + open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean s) (IMAGE f u)`, + REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ABBREV_TAC `s' = {y:real^N | !x. x IN s ==> orthogonal x y}` THEN + SUBGOAL_THEN `subspace(s':real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "s'" THEN REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTORS]; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SUBSPACE_IMP_NONEMPTY)] THEN + ABBREV_TAC `g:real^(N,N)finite_sum->real^(N,N)finite_sum = + \z. pastecart (f(fstcart z)) (sndcart z)` THEN + SUBGOAL_THEN + `g continuous_on ((u:real^N->bool) PCROSS s') /\ + IMAGE g (u PCROSS s') SUBSET (s:real^N->bool) PCROSS (s':real^N->bool) /\ + (!w z. w IN u PCROSS s' /\ z IN u PCROSS s' ==> (g w = g z <=> w = z))` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "g" THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; + IMAGE_FSTCART_PCROSS] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + SIMP_TAC[PASTECART_IN_PCROSS; SNDCART_PASTECART; + FSTCART_PASTECART] THEN + ASM SET_TAC[]; + EXPAND_TAC "g" THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; + SNDCART_PASTECART] THEN + ASM_SIMP_TAC[PASTECART_INJ]]; + ALL_TAC] THEN + SUBGOAL_THEN + `open_in (subtopology euclidean (s PCROSS s')) + (IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) + (u PCROSS s'))` + MP_TAC THENL + [MATCH_MP_TAC lemma0 THEN + ASM_SIMP_TAC[SUBSPACE_PCROSS; OPEN_IN_PCROSS_EQ; OPEN_IN_REFL] THEN + CONJ_TAC THENL [ASM_SIMP_TAC[DIM_PCROSS]; ASM_MESON_TAC[]] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] + DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN + ASM_REWRITE_TAC[SUBSET_UNIV; SUBSPACE_UNIV; IN_UNIV; DIM_UNIV] THEN + ARITH_TAC; + SUBGOAL_THEN + `IMAGE (g:real^(N,N)finite_sum->real^(N,N)finite_sum) (u PCROSS s') = + IMAGE f u PCROSS s'` + SUBST1_TAC THENL + [EXPAND_TAC "g" THEN + REWRITE_TAC[EXTENSION; EXISTS_PASTECART; PASTECART_IN_PCROSS; + IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_INJ] THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; IMAGE_EQ_EMPTY] THEN + STRIP_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY]]]) in + REWRITE_TAC[INJECTIVE_ON_ALT] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`] + CHOOSE_SUBSPACE_OF_SUBSPACE) THEN ASM_SIMP_TAC[SPAN_OF_SUBSPACE] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`v:real^N->bool`; `v:real^M->bool`] + HOMEOMORPHIC_SUBSPACES) THEN + ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) s = + IMAGE (k:real^M->real^N) (IMAGE ((h:real^N->real^M) o f) s)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN u ==> f x = g x) ==> IMAGE f u = IMAGE g u`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + ASM_SIMP_TAC[SUBSET; o_THM] THEN ASM SET_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`h:real^N->real^M`; `v:real^M->bool`] THEN + ASM_REWRITE_TAC[homeomorphism] THEN + MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN + ASM_REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC lemma1 THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]]);; + +let INVARIANCE_OF_DIMENSION_SUBSPACES = prove + (`!f:real^M->real^N u v s. + subspace u /\ subspace v /\ + ~(s = {}) /\ open_in (subtopology euclidean u) s /\ + f continuous_on s /\ IMAGE f s SUBSET v /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> dim u <= dim v`, + REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`u:real^M->bool`; `dim(v:real^N->bool)`] + CHOOSE_SUBSPACE_OF_SUBSPACE) THEN + ASM_SIMP_TAC[SPAN_OF_SUBSPACE; LE_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`v:real^N->bool`; `t:real^M->bool`] + HOMEOMORPHIC_SUBSPACES) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[homeomorphic; homeomorphism; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^M`; `k:real^M->real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`(h:real^N->real^M) o (f:real^M->real^N)`; `u:real^M->bool`; + `u:real^M->bool`; `s:real^M->bool`] + INVARIANCE_OF_DOMAIN_SUBSPACES) THEN + ASM_REWRITE_TAC[LE_LT; NOT_IMP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + REWRITE_TAC[o_THM] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s SUBSET t` + ASSUME_TAC THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; ALL_TAC] THEN + ABBREV_TAC `w = IMAGE ((h:real^N->real^M) o (f:real^M->real^N)) s` THEN + DISCH_TAC THEN UNDISCH_TAC `dim(t:real^M->bool) < dim(u:real^M->bool)` THEN + REWRITE_TAC[NOT_LT] THEN MP_TAC(ISPECL + [`w:real^M->bool`; `u:real^M->bool`] DIM_OPEN_IN) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[IMAGE_EQ_EMPTY]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + ASM_SIMP_TAC[DIM_SUBSET]);; + +let INVARIANCE_OF_DOMAIN_AFFINE_SETS = prove + (`!f:real^M->real^N u v s. + affine u /\ affine v /\ aff_dim v <= aff_dim u /\ + f continuous_on s /\ IMAGE f s SUBSET v /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + open_in (subtopology euclidean u) s + ==> open_in (subtopology euclidean v) (IMAGE f s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`; + `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`; + `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DOMAIN_SUBSPACES) THEN + REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN + SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN + ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN + ANTS_TAC THENL + [ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN + ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE; + VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + ASM_MESON_TAC[]; + REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]); + REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN + MATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]]; + ALL_TAC] THEN + ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF; + IMAGE_ID; ETA_AX]);; + +let INVARIANCE_OF_DIMENSION_AFFINE_SETS = prove + (`!f:real^M->real^N u v s. + affine u /\ affine v /\ + ~(s = {}) /\ open_in (subtopology euclidean u) s /\ + f continuous_on s /\ IMAGE f s SUBSET v /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> aff_dim u <= aff_dim v`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; OPEN_IN_EMPTY; INJECTIVE_ON_ALT] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?a:real^M b:real^N. a IN s /\ a IN u /\ b IN v` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(\x. --b + x) o (f:real^M->real^N) o (\x. a + x)`; + `IMAGE (\x:real^M. --a + x) u`; `IMAGE (\x:real^N. --b + x) v`; + `IMAGE (\x:real^M. --a + x) s`] INVARIANCE_OF_DIMENSION_SUBSPACES) THEN + REWRITE_TAC[IMAGE_o; INJECTIVE_ON_ALT; OPEN_IN_TRANSLATION_EQ] THEN + SIMP_TAC[IMP_CONJ; GSYM INT_OF_NUM_LE; GSYM AFF_DIM_DIM_SUBSPACE] THEN + ASM_REWRITE_TAC[AFF_DIM_TRANSLATION_EQ; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_IN_IMAGE; o_THM; GSYM IMAGE_o; IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN MATCH_MP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC AFFINE_IMP_SUBSPACE THEN + ASM_REWRITE_TAC[AFFINE_TRANSLATION_EQ] THEN REWRITE_TAC[IN_IMAGE; + VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]); + REWRITE_TAC[GSYM o_ASSOC] THEN REWRITE_TAC[IMAGE_o] THEN + MATCH_MP_TAC IMAGE_SUBSET; + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]]] THEN + ASM_SIMP_TAC[VECTOR_ARITH `a + --a + x:real^N = x`; GSYM IMAGE_o; o_DEF; + IMAGE_ID; ETA_AX]);; + +let INVARIANCE_OF_DIMENSION = prove + (`!f:real^M->real^N s. + f continuous_on s /\ open s /\ ~(s = {}) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> dimindex(:M) <= dimindex(:N)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; SUBSET_UNIV; SUBTOPOLOGY_UNIV; + GSYM OPEN_IN]);; + +let CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE = prove + (`!f:real^M->real^N s t. + subspace s /\ subspace t /\ + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> dim(s) <= dim(t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DIMENSION_SUBSPACES THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[OPEN_IN_REFL] THEN ASM_SIMP_TAC[SUBSPACE_IMP_NONEMPTY]);; + +let INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN = prove + (`!f:real^M->real^N s t. + + convex s /\ f continuous_on s /\ IMAGE f s SUBSET affine hull t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> aff_dim(s) <= aff_dim(t)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_GE] THEN + MP_TAC(ISPECL + [`f:real^M->real^N`; `affine hull s:real^M->bool`; + `affine hull t:real^N->bool`; `relative_interior s:real^M->bool`] + INVARIANCE_OF_DIMENSION_AFFINE_SETS) THEN + ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL; + OPEN_IN_RELATIVE_INTERIOR] THEN + DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN + ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; + +let HOMEOMORPHIC_CONVEX_SETS = prove + (`!s:real^M->bool t:real^N->bool. + convex s /\ convex t /\ s homeomorphic t ==> aff_dim s = aff_dim t`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; GSYM INT_LE_ANTISYM; homeomorphism] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION_CONVEX_DOMAIN THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^N->real^M`] THEN + ASM_REWRITE_TAC[HULL_SUBSET] THEN ASM SET_TAC[]);; + +let HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + convex s /\ compact s /\ convex t /\ compact t + ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`, + MESON_TAC[HOMEOMORPHIC_CONVEX_SETS; HOMEOMORPHIC_CONVEX_COMPACT_SETS]);; + +let INVARIANCE_OF_DOMAIN_GEN = prove + (`!f:real^M->real^N s. + dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> open(IMAGE f s)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `(:real^M)`; `(:real^N)`; `s:real^M->bool`] + INVARIANCE_OF_DOMAIN_SUBSPACES) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; SUBSPACE_UNIV; + DIM_UNIV; SUBSET_UNIV]);; + +let INJECTIVE_INTO_1D_IMP_OPEN_MAP_UNIV = prove + (`!f:real^N->real^1 s t. + f continuous_on s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + open t /\ t SUBSET s + ==> open (IMAGE f t)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN + ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]);; + +let CONTINUOUS_ON_INVERSE_OPEN = prove + (`!f:real^M->real^N g s. + dimindex(:N) <= dimindex(:M) /\ + f continuous_on s /\ open s /\ + (!x. x IN s ==> g(f x) = x) + ==> g continuous_on IMAGE f s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN + X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN IMAGE f s /\ g x IN t} = IMAGE (f:real^M->real^N) (s INTER t)` + SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC OPEN_OPEN_IN_TRANS] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + CONJ_TAC THEN MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN THEN + ASM_SIMP_TAC[OPEN_INTER; IN_INTER] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]);; + +let CONTINUOUS_ON_INVERSE_INTO_1D = prove + (`!f:real^N->real^1 g s t. + f continuous_on s /\ + (path_connected s \/ compact s \/ open s) /\ + IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) + ==> g continuous_on t`, + REPEAT STRIP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`f:real^N->real^1`; `s:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INJECTIVE_INTO_1D_IMP_OPEN_MAP THEN ASM SET_TAC[]; + ASM_MESON_TAC[CONTINUOUS_ON_INVERSE]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN THEN + ASM_REWRITE_TAC[DIMINDEX_1; DIMINDEX_GE_1]]);; + +let REAL_CONTINUOUS_ON_INVERSE = prove + (`!f g s. f real_continuous_on s /\ + (is_realinterval s \/ real_compact s \/ real_open s) /\ + (!x. x IN s ==> g(f x) = x) + ==> g real_continuous_on (IMAGE f s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; real_compact; REAL_OPEN; + IS_REALINTERVAL_IS_INTERVAL] THEN + DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_INVERSE_INTO_1D THEN + MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN + ASM_REWRITE_TAC[GSYM IS_INTERVAL_PATH_CONNECTED_1] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; GSYM IMAGE_o]);; + +let REAL_CONTINUOUS_ON_INVERSE_ALT = prove + (`!f g s t. f real_continuous_on s /\ + (is_realinterval s \/ real_compact s \/ real_open s) /\ + IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) + ==> g real_continuous_on t`, + MESON_TAC[REAL_CONTINUOUS_ON_INVERSE]);; + +let INVARIANCE_OF_DOMAIN_HOMEOMORPHISM = prove + (`!f:real^M->real^N s. + dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ?g. homeomorphism (s,IMAGE f s) (f,g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + DISCH_TAC THEN ASM_REWRITE_TAC[homeomorphism] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_INVERSE_OPEN] THEN ASM SET_TAC[]);; + +let INVARIANCE_OF_DOMAIN_HOMEOMORPHIC = prove + (`!f:real^M->real^N s. + dimindex(:N) <= dimindex(:M) /\ f continuous_on s /\ open s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> s homeomorphic (IMAGE f s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP INVARIANCE_OF_DOMAIN_HOMEOMORPHISM) THEN + REWRITE_TAC[homeomorphic] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_INTERVALS_EQ = prove + (`(!a b:real^M c d:real^N. + interval[a,b] homeomorphic interval[c,d] <=> + aff_dim(interval[a,b]) = aff_dim(interval[c,d])) /\ + (!a b:real^M c d:real^N. + interval[a,b] homeomorphic interval(c,d) <=> + interval[a,b] = {} /\ interval(c,d) = {}) /\ + (!a b:real^M c d:real^N. + interval(a,b) homeomorphic interval[c,d] <=> + interval(a,b) = {} /\ interval[c,d] = {}) /\ + (!a b:real^M c d:real^N. + interval(a,b) homeomorphic interval(c,d) <=> + interval(a,b) = {} /\ interval(c,d) = {} \/ + ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) /\ + dimindex(:M) = dimindex(:N))`, + SIMP_TAC[HOMEOMORPHIC_CONVEX_COMPACT_SETS_EQ; CONVEX_INTERVAL; + COMPACT_INTERVAL] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY] THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN + REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; + FIRST_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_COMPACTNESS) THEN + REWRITE_TAC[COMPACT_INTERVAL_EQ] THEN ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; + MATCH_MP_TAC(TAUT + `(p <=> q) /\ (~p /\ ~q ==> r) ==> p /\ q \/ ~p /\ ~q /\ r`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHIC_EMPTY]; STRIP_TAC] THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THENL + [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THENL + [EXISTS_TAC `interval(a:real^M,b)`; + EXISTS_TAC `interval(c:real^N,d)`] THEN + ASM_REWRITE_TAC[OPEN_INTERVAL] THEN ASM SET_TAC[]; + TRANS_TAC HOMEOMORPHIC_TRANS + `IMAGE ((\x. lambda i. x$i):real^M->real^N) + (interval(a,b))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHIC THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[LE_REFL]; + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA; CART_EQ]; + REWRITE_TAC[OPEN_INTERVAL]; + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE ((\x. lambda i. x$i):real^M->real^N) + (interval(a,b)) = + interval((lambda i. a$i),(lambda i. b$i))` + SUBST1_TAC THENL + [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `(lambda i. (y:real^N)$i):real^M` THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]; + MATCH_MP_TAC HOMEOMORPHIC_OPEN_INTERVALS THEN + GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN + SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY])) THEN + ASM_MESON_TAC[]]]);; + +let CONTINUOUS_IMAGE_SUBSET_INTERIOR = prove + (`!f:real^M->real^N s. + f continuous_on s /\ dimindex(:N) <= dimindex(:M) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN + SIMP_TAC[IMAGE_SUBSET; INTERIOR_SUBSET] THEN + ASM_CASES_TAC `interior s:real^M->bool = {}` THENL + [ASM_REWRITE_TAC[INTERIOR_EMPTY; OPEN_EMPTY; IMAGE_CLAUSES]; + MATCH_MP_TAC INVARIANCE_OF_DOMAIN_GEN] THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);; + +let HOMEOMORPHIC_INTERIORS_SAME_DIMENSION = prove + (`!s:real^M->bool t:real^N->bool. + dimindex(:M) = dimindex(:N) /\ s homeomorphic t + ==> (interior s) homeomorphic (interior t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + STRIP_TAC THEN ASM_SIMP_TAC[REWRITE_RULE[SUBSET] INTERIOR_SUBSET] THEN + REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN + ASM_MESON_TAC[LE_REFL]]; + SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN + ASM_MESON_TAC[LE_REFL]]; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET]]);; + +let HOMEOMORPHIC_INTERIORS = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ (interior s = {} <=> interior t = {}) + ==> (interior s) homeomorphic (interior t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `interior t:real^N->bool = {}` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_INTERIORS_SAME_DIMENSION THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM + (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL + [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`]; + MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);; + +let HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION = prove + (`!s:real^M->bool t:real^N->bool. + dimindex(:M) = dimindex(:N) /\ + s homeomorphic t /\ closed s /\ closed t + ==> (frontier s) homeomorphic (frontier t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] FRONTIER_SUBSET_CLOSED] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[FRONTIER_SUBSET_CLOSED; CONTINUOUS_ON_SUBSET]] THEN + ASM_SIMP_TAC[frontier; CLOSURE_CLOSED] THEN + SUBGOAL_THEN + `(!x:real^M. x IN interior s ==> f x IN interior t) /\ + (!y:real^N. y IN interior t ==> g y IN interior s)` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN + ASM_MESON_TAC[LE_REFL]]; + SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_INTERIOR THEN + ASM_MESON_TAC[LE_REFL]]]);; + +let HOMEOMORPHIC_FRONTIERS = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ closed s /\ closed t /\ + (interior s = {} <=> interior t = {}) + ==> (frontier s) homeomorphic (frontier t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `interior t:real^N->bool = {}` THENL + [ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; STRIP_TAC] THEN + MATCH_MP_TAC HOMEOMORPHIC_FRONTIERS_SAME_DIMENSION THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM + (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL + [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `interior s:real^M->bool`]; + MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `interior t:real^N->bool`]] THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTERIOR_SUBSET; SUBSET]);; + +let CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ aff_dim t <= aff_dim s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> IMAGE f (relative_interior s) SUBSET relative_interior(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RELATIVE_INTERIOR_MAXIMAL THEN + SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET] THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN_AFFINE_SETS THEN + EXISTS_TAC `affine hull s:real^M->bool` THEN + ASM_REWRITE_TAC[AFFINE_AFFINE_HULL; AFF_DIM_AFFINE_HULL] THEN + REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR] THEN CONJ_TAC THENL + [ASM_MESON_TAC[AFF_DIM_SUBSET; INT_LE_TRANS]; ALL_TAC] THEN + ASSUME_TAC(ISPEC `s:real^M->bool` RELATIVE_INTERIOR_SUBSET) THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + SIMP_TAC[IMAGE_SUBSET; RELATIVE_INTERIOR_SUBSET; HULL_SUBSET]);; + +let HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION = prove + (`!s:real^M->bool t:real^N->bool. + aff_dim s = aff_dim t /\ s homeomorphic t + ==> (relative_interior s) homeomorphic (relative_interior t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + STRIP_TAC THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET] THEN + REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN + ASM SET_TAC[]]; + SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN + ASM SET_TAC[]]; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]]);; + +let HOMEOMORPHIC_RELATIVE_INTERIORS = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ + (relative_interior s = {} <=> relative_interior t = {}) + ==> (relative_interior s) homeomorphic (relative_interior t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_EMPTY] THEN STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_INTERIORS_SAME_DIMENSION THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM + (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL + [MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `relative_interior s:real^M->bool`]; + MAP_EVERY EXISTS_TAC + [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN + ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN + (REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]; + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE + `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t' + ==> IMAGE f s' SUBSET t'`]; + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));; + +let HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION = prove + (`!s:real^M->bool t:real^N->bool. + aff_dim s = aff_dim t /\ s homeomorphic t + ==> (s DIFF relative_interior s) homeomorphic + (t DIFF relative_interior t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + STRIP_TAC THEN ASM_SIMP_TAC[IN_DIFF] THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SUBSET_DIFF; CONTINUOUS_ON_SUBSET]] THEN + SUBGOAL_THEN + `(!x:real^M. x IN relative_interior s ==> f x IN relative_interior t) /\ + (!y:real^N. y IN relative_interior t ==> g y IN relative_interior s)` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `t = IMAGE (f:real^M->real^N) s` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN + ASM SET_TAC[]]; + SUBGOAL_THEN `s = IMAGE (g:real^N->real^M) t` SUBST1_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN + ASM SET_TAC[]]]);; + +let HOMEOMORPHIC_RELATIVE_BOUNDARIES = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ + (relative_interior s = {} <=> relative_interior t = {}) + ==> (s DIFF relative_interior s) homeomorphic + (t DIFF relative_interior t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `relative_interior t:real^N->bool = {}` THEN + ASM_SIMP_TAC[DIFF_EMPTY] THEN STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_RELATIVE_BOUNDARIES_SAME_DIMENSION THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM + (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_MINIMAL]) THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION_AFFINE_SETS THENL + [MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `relative_interior s:real^M->bool`]; + MAP_EVERY EXISTS_TAC + [`g:real^N->real^M`; `relative_interior t:real^N->bool`]] THEN + ASM_REWRITE_TAC[OPEN_IN_RELATIVE_INTERIOR; AFFINE_AFFINE_HULL] THEN + (REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; RELATIVE_INTERIOR_SUBSET]; + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_SUBSET; SET_RULE + `(!x. x IN s ==> f x IN t) /\ s' SUBSET s /\ t SUBSET t' + ==> IMAGE f s' SUBSET t'`]; + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]]));; + +let UNIFORMLY_CONTINUOUS_HOMEOMORPHISM_UNIV_TRIVIAL = prove + (`!f g s:real^N->bool. + homeomorphism (s,(:real^N)) (f,g) /\ f uniformly_continuous_on s + ==> s = (:real^N)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism; IN_UNIV] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THENL [SET_TAC[]; STRIP_TAC] THEN + MP_TAC(ISPEC `s:real^N->bool` CLOPEN) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; complete] THEN + X_GEN_TAC `x:num->real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `cauchy ((f:real^N->real^N) o x)` MP_TAC THENL + [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN + DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN + EXISTS_TAC `(g:real^N->real^N) l` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `(g:real^N->real^N) o (f:real^N->real^N) o (x:num->real^N)` THEN + REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM SET_TAC[]; + MATCH_MP_TAC LIM_CONTINUOUS_FUNCTION THEN ASM_SIMP_TAC[GSYM o_DEF] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]]; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + ASM_REWRITE_TAC[OPEN_UNIV] THEN ASM SET_TAC[]]);; + +let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN = prove + (`!f:real^M->real^N u s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + bounded u /\ convex u /\ affine t /\ aff_dim t < aff_dim u /\ + open_in (subtopology euclidean (relative_frontier u)) s + ==> open_in (subtopology euclidean t) (IMAGE f s)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `relative_frontier u:real^M->bool = {}` THEN + ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; IMAGE_CLAUSES; OPEN_IN_EMPTY] THEN + STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + SUBGOAL_THEN + `?b c:real^M. b IN relative_frontier u /\ c IN relative_frontier u /\ + ~(b = c)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `~(s = {} \/ ?x. s = {x}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN + ASM_MESON_TAC[RELATIVE_FRONTIER_NOT_SING]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^M)`; `aff_dim(u:real^M->bool) - &1`] + CHOOSE_AFFINE_SUBSET) THEN + REWRITE_TAC[SUBSET_UNIV; AFFINE_UNIV] THEN ANTS_TAC THENL + [MATCH_MP_TAC(INT_ARITH + `&0:int <= t /\ t <= n ==> --a <= t - a /\ t - &1 <= n`) THEN + REWRITE_TAC[AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFF_DIM_POS_LE] THEN + ASM_MESON_TAC[RELATIVE_FRONTIER_EMPTY; NOT_IN_EMPTY]; + DISCH_THEN(X_CHOOSE_THEN `af:real^M->bool` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL [`u:real^M->bool`; `af:real^M->bool`] + HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN + ASM_REWRITE_TAC[INT_ARITH `x - a + a:int = x`] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `c:real^M` th) THEN MP_TAC(SPEC `b:real^M` th)) THEN + ASM_REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^M->real^M`; `h:real^M->real^M`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`j:real^M->real^M`; `k:real^M->real^M`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`(f:real^M->real^N) o (k:real^M->real^M)`; + `(af:real^M->bool)`; + `t:real^N->bool`; `IMAGE (j:real^M->real^M) (s DELETE c)`] + INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN + MP_TAC(ISPECL + [`(f:real^M->real^N) o (h:real^M->real^M)`; + `(af:real^M->bool)`; + `t:real^N->bool`; `IMAGE (g:real^M->real^M) (s DELETE b)`] + INVARIANCE_OF_DOMAIN_AFFINE_SETS) THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[IMP_IMP; INT_ARITH `x:int <= y - &1 <=> x < y`] THEN + MATCH_MP_TAC(TAUT + `(p1 /\ p2) /\ (q1 /\ q2 ==> r) ==> (p1 ==> q1) /\ (p2 ==> q2) ==> r`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN + ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC + [`h:real^M->real^M`; `relative_frontier u DELETE (b:real^M)`] THEN + ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_DELETE]) THEN + ASM_SIMP_TAC[o_THM; IN_DELETE; IMP_CONJ] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN MAP_EVERY EXISTS_TAC + [`k:real^M->real^M`; `relative_frontier u DELETE (c:real^M)`] THEN + ASM_SIMP_TAC[homeomorphism; DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; OPEN_IN_OPEN] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP OPEN_IN_UNION) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) + ((s DELETE b) UNION (s DELETE c))` THEN + CONJ_TAC THENL + [REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[IMAGE_o] THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET = prove + (`!f:real^M->real^N a r s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + ~(r = &0) /\ affine t /\ aff_dim t < &(dimindex(:M)) /\ + open_in (subtopology euclidean (sphere(a,r))) s + ==> open_in (subtopology euclidean t) (IMAGE f s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `sphere(a:real^M,r) = {}` THEN + ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; OPEN_IN_EMPTY; IMAGE_CLAUSES] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SPHERE_EQ_EMPTY; REAL_NOT_LT]) THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `cball(a:real^M,r)`; + `s:real^M->bool`; `t:real^N->bool`] + INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET_GEN) THEN + ASM_REWRITE_TAC[AFF_DIM_CBALL; RELATIVE_FRONTIER_CBALL; + BOUNDED_CBALL; CONVEX_CBALL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let NO_EMBEDDING_SPHERE_LOWDIM = prove + (`!f:real^M->real^N a r. + &0 < r /\ + f continuous_on sphere(a,r) /\ + (!x y. x IN sphere(a,r) /\ y IN sphere(a,r) /\ f x = f y ==> x = y) + ==> dimindex(:M) <= dimindex(:N)`, + REWRITE_TAC[GSYM NOT_LT] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (sphere(a:real^M,r))` + COMPACT_OPEN) THEN + ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY; + COMPACT_SPHERE; SPHERE_EQ_EMPTY; + REAL_ARITH `&0 < r ==> ~(r < &0)`] THEN + ONCE_REWRITE_TAC[OPEN_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN_SPHERE_AFFINE_SET THEN + MAP_EVERY EXISTS_TAC [`a:real^M`; `r:real`] THEN + ASM_REWRITE_TAC[AFFINE_UNIV; SUBSET_UNIV; AFF_DIM_UNIV; + OPEN_IN_REFL; INT_OF_NUM_LT] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Dimension-based conditions for various homeomorphisms. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_SUBSPACES_EQ = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t ==> (s homeomorphic t <=> dim s = dim t)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[HOMEOMORPHIC_SUBSPACES]] THEN + REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_INJECTIVE_IMAGE_SUBSPACE_DIM_LE THEN + ASM_MESON_TAC[]);; + +let HOMEOMORPHIC_AFFINE_SETS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + affine s /\ affine t ==> (s homeomorphic t <=> aff_dim s = aff_dim t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN + POP_ASSUM MP_TAC THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [EQ_SYM_EQ] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_EQ_MINUS1; HOMEOMORPHIC_EMPTY] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC + [GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN + GEOM_ORIGIN_TAC `a:real^M` THEN GEOM_ORIGIN_TAC `b:real^N` THEN + SIMP_TAC[AFFINE_EQ_SUBSPACE; HOMEOMORPHIC_SUBSPACES_EQ; AFF_DIM_DIM_0; + HULL_INC; INT_OF_NUM_EQ] THEN + MESON_TAC[]);; + +let HOMEOMORPHIC_HYPERPLANES_EQ = prove + (`!a:real^M b c:real^N d. + ~(a = vec 0) /\ ~(c = vec 0) + ==> ({x | a dot x = b} homeomorphic {x | c dot x = d} <=> + dimindex(:M) = dimindex(:N))`, + SIMP_TAC[HOMEOMORPHIC_AFFINE_SETS_EQ; AFFINE_HYPERPLANE] THEN + SIMP_TAC[AFF_DIM_HYPERPLANE; INT_OF_NUM_EQ; + INT_ARITH `x - &1:int = y - &1 <=> x = y`]);; + +let HOMEOMORPHIC_UNIV_UNIV = prove + (`(:real^M) homeomorphic (:real^N) <=> dimindex(:M) = dimindex(:N)`, + SIMP_TAC[HOMEOMORPHIC_SUBSPACES_EQ; DIM_UNIV; SUBSPACE_UNIV]);; + +let HOMEOMORPHIC_CBALLS_EQ = prove + (`!a:real^M b:real^N r s. + cball(a,r) homeomorphic cball(b,s) <=> + r < &0 /\ s < &0 \/ r = &0 /\ s = &0 \/ + &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`, + let lemma = + let d = `dimindex(:M) = dimindex(:N)` + and t = `?a:real^M b:real^N. ~(cball(a,r) homeomorphic cball(b,s))` in + DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THENL + [ASM_SIMP_TAC[CBALL_EMPTY; HOMEOMORPHIC_EMPTY; CBALL_EQ_EMPTY] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THENL + [ASM_SIMP_TAC[CBALL_TRIVIAL; FINITE_SING; HOMEOMORPHIC_FINITE_STRONG] THEN + REWRITE_TAC[FINITE_CBALL] THEN + ASM_CASES_TAC `s < &0` THEN + ASM_SIMP_TAC[CBALL_EMPTY; CARD_CLAUSES; FINITE_EMPTY; + NOT_IN_EMPTY; ARITH; REAL_LT_IMP_NE] THEN + ASM_CASES_TAC `s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[CBALL_TRIVIAL; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; + REAL_LE_REFL; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `s <= &0` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_FINITE_STRONG; FINITE_CBALL] THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < s` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL + [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`] THEN + MP_TAC(ISPECL [`a:real^M`; `r:real`] BALL_SUBSET_CBALL); + MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`] THEN + MP_TAC(ISPECL [`b:real^N`; `s:real`] BALL_SUBSET_CBALL)] THEN + ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN + ASM_MESON_TAC[SUBSET; CONTINUOUS_ON_SUBSET]; + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_CBALLS]]);; + +let HOMEOMORPHIC_BALLS_EQ = prove + (`!a:real^M b:real^N r s. + ball(a,r) homeomorphic ball(b,s) <=> + r <= &0 /\ s <= &0 \/ + &0 < r /\ &0 < s /\ dimindex(:M) = dimindex(:N)`, + let lemma = + let d = `dimindex(:M) = dimindex(:N)` + and t = `?a:real^M b:real^N. ~(ball(a,r) homeomorphic ball(b,s))` in + DISCH d (DISCH t (GEOM_EQUAL_DIMENSION_RULE (ASSUME d) (ASSUME t))) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL + [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `s <= &0` THENL + [ASM_SIMP_TAC[BALL_EMPTY; HOMEOMORPHIC_EMPTY; BALL_EQ_EMPTY] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [REWRITE_TAC[homeomorphic; HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THEN + MATCH_MP_TAC INVARIANCE_OF_DIMENSION THENL + [MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `ball(a:real^M,r)`]; + MAP_EVERY EXISTS_TAC [`g:real^N->real^M`; `ball(b:real^N,s)`]] THEN + ASM_REWRITE_TAC[BALL_EQ_EMPTY; OPEN_BALL; REAL_NOT_LE] THEN + ASM SET_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_SIMP_TAC[HOMEOMORPHIC_BALLS]]);; + +let SIMPLY_CONNECTED_SPHERE_EQ = prove + (`!a:real^N r. + simply_connected(sphere(a,r)) <=> 3 <= dimindex(:N) \/ r <= &0`, + let hslemma = prove + (`!a:real^M r b:real^N s. + dimindex(:M) = dimindex(:N) + ==> &0 < r /\ &0 < s ==> (sphere(a,r) homeomorphic sphere(b,s))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> + let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in + MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in + REPEAT GEN_TAC THEN + ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[SPHERE_EMPTY; REAL_LT_IMP_LE; SIMPLY_CONNECTED_EMPTY] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONVEX_IMP_SIMPLY_CONNECTED; + CONVEX_SING] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN + EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_SPHERE] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[ARITH_RULE `~(3 <= n) <=> (1 <= n ==> n = 1 \/ n = 2)`] THEN + REWRITE_TAC[DIMINDEX_GE_1] THEN STRIP_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP SIMPLY_CONNECTED_IMP_CONNECTED) THEN + ASM_REWRITE_TAC[CONNECTED_SPHERE_EQ; ARITH] THEN ASM_REAL_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_2]) THEN + FIRST_ASSUM(MP_TAC o ISPECL [`a:real^N`; `r:real`; `vec 0:real^2`; + `&1:real`] o MATCH_MP hslemma) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_SIMPLY_CONNECTED_EQ) THEN + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^2. x`) THEN + REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; SUBSET_REFL] THEN + REWRITE_TAC[GSYM contractible; CONTRACTIBLE_SPHERE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV]);; + +let SIMPLY_CONNECTED_PUNCTURED_UNIVERSE_EQ = prove + (`!a. simply_connected((:real^N) DELETE a) <=> 3 <= dimindex(:N)`, + GEN_TAC THEN TRANS_TAC EQ_TRANS `simply_connected(sphere(a:real^N,&1))` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ]] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + MATCH_MP_TAC HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS THEN + MP_TAC(ISPECL [`cball(a:real^N,&1)`; `a:real^N`] + HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL) THEN + REWRITE_TAC[CONVEX_CBALL; BOUNDED_CBALL; RELATIVE_INTERIOR_CBALL; + RELATIVE_FRONTIER_CBALL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[CENTRE_IN_BALL; AFFINE_HULL_NONEMPTY_INTERIOR; INTERIOR_CBALL; + BALL_EQ_EMPTY; REAL_OF_NUM_LE; ARITH; REAL_LT_01]);; + +let NOT_SIMPLY_CONNECTED_CIRCLE = prove + (`!a:real^2 r. &0 < r ==> ~simply_connected(sphere(a,r))`, + REWRITE_TAC[SIMPLY_CONNECTED_SPHERE_EQ; DIMINDEX_2; ARITH] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The power, squaring and exponential functions as covering maps. *) +(* ------------------------------------------------------------------------- *) + +let COVERING_SPACE_POW_PUNCTURED_PLANE = prove + (`!n. 0 < n + ==> covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow n)) + ((:complex) DIFF {Cx (&0)})`, + let lemma = prove + (`!n. 0 < n + ==> ?e. &0 < e /\ + !w z. norm(w - z) < e * norm(z) + ==> (w pow n = z pow n <=> w = z)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `0 < n ==> n = 1 \/ 2 <= n`)) THEN + ASM_SIMP_TAC[COMPLEX_POW_1] THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + EXISTS_TAC `&2 * sin(pi / &n)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN + MATCH_MP_TAC SIN_POS_PI THEN + ASM_SIMP_TAC[REAL_LT_DIV; PI_POS; REAL_OF_NUM_LT] THEN + REWRITE_TAC[REAL_ARITH `x / y < x <=> &0 < x * (&1 - inv y)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[PI_POS; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INV_LT_1 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_SUB_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[] THEN + SIMP_TAC[NORM_ARITH `norm(w) < x * &0 <=> F`]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; COMPLEX_NORM_NZ] THEN + ASM_SIMP_TAC[COMPLEX_POW_EQ_0; COMPLEX_FIELD + `~(z = Cx(&0)) ==> (w = z <=> w / z = Cx(&1))`] THEN + REWRITE_TAC[GSYM COMPLEX_NORM_DIV; GSYM COMPLEX_POW_DIV] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(z = Cx(&0)) ==> (w - z) / z = w / z - Cx(&1)`] THEN + ASM_CASES_TAC `w / z = Cx(&0)` THENL + [ASM_REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1]; + UNDISCH_TAC `~(w / z = Cx(&0))` THEN + UNDISCH_THEN `~(z = Cx(&0))` (K ALL_TAC) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + SPEC_TAC(`w / z:complex`,`z:complex`) THEN REPEAT STRIP_TAC] THEN + EQ_TAC THEN SIMP_TAC[COMPLEX_POW_ONE] THEN DISCH_TAC THEN + UNDISCH_TAC `norm(z - Cx(&1)) < &2 * sin (pi / &n)` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN + DISCH_TAC THEN MP_TAC(SPEC `n:num` COMPLEX_ROOTS_UNITY) THEN + ASM_SIMP_TAC[LE_1; EXTENSION; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` MP_TAC) THEN + REWRITE_TAC[COMPLEX_RING `t * p * ii * q = ii * (t * p * q)`] THEN + REWRITE_TAC[GSYM CX_MUL] THEN ASM_CASES_TAC `j = 0` THENL + [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; CEXP_0; + COMPLEX_MUL_RZERO]; + STRIP_TAC THEN ASM_REWRITE_TAC[DIST_CEXP_II_1]] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> &2 * x <= &2 * abs y`) THEN + REWRITE_TAC[REAL_ARITH `(&2 * x) / &2 = x`] THEN + ASM_CASES_TAC `&j / &n <= &1 / &2` THENL + [ALL_TAC; + SUBGOAL_THEN `sin(pi * &j / &n) = sin(pi * &(n - j) / &n)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE; REAL_OF_NUM_LT; + REAL_FIELD `&0 < n ==> pi * (n - j) / n = pi - pi * j / n`] THEN + REWRITE_TAC[SIN_SUB; COS_PI; SIN_PI] THEN REAL_ARITH_TAC; + ALL_TAC]] THEN + MATCH_MP_TAC SIN_MONO_LE THEN + REWRITE_TAC[REAL_ARITH `--(pi / &2) = pi * --(&1 / &2)`; real_div] THEN + SIMP_TAC[REAL_LE_LMUL_EQ; PI_POS] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_MUL_LINV; REAL_LT_IMP_NZ; + REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LT; LE_1; + ARITH_RULE `j < n ==> 1 <= n - j`; REAL_OF_NUM_LE; + REAL_ARITH `&0 <= x ==> --(&1 / &2) <= x`; + REAL_POS; REAL_LE_INV_EQ] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `n - j <= inv(&2) * n <=> inv(&2) * n <= j`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LE_RDIV_EQ; + REAL_OF_NUM_LT] THEN + ASM_REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + SIMP_TAC[covering_space; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN + SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV; IN_SING] THEN + ASM_MESON_TAC[COMPLEX_POW_EQ_0; EXISTS_COMPLEX_ROOT; LE_1]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC + (BINDER_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV; IN_DIFF; IN_SING] THEN + SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + MP_TAC(SPEC `n:num` lemma) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `d = (min (&1 / &2) (e / &4)) * norm(z:complex)` THEN + SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!w x y. w pow n = z pow n /\ x IN ball(w,d) /\ y IN ball(w,d) + ==> (x pow n = y pow n <=> x = y)` + ASSUME_TAC THENL + [REWRITE_TAC[IN_BALL] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN + ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN + ASM_CASES_TAC `w = Cx(&0)` THENL + [ASM_MESON_TAC[COMPLEX_NORM_ZERO]; DISCH_THEN SUBST_ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 * d` THEN CONJ_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`dist(w:complex,x) < d`; `dist(w:complex,y) < d`] THEN + CONV_TAC NORM_ARITH; + ALL_TAC] THEN + EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * e / &4 * norm(w:complex)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_ARITH + `&2 * e / &4 * x <= e * y <=> e * x <= e * &2 * y`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `dist(z,y) < d ==> d <= &1 / &2 * norm(z) + ==> norm(z) <= &2 * norm y`)) THEN + EXPAND_TAC "d" THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `IMAGE (\w. w pow n) (ball(z,d))` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; + MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW; CONTINUOUS_ON_ID] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[SET_RULE + `~(z IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = z))`] THEN + X_GEN_TAC `w:complex` THEN + ASM_SIMP_TAC[IN_BALL; COMPLEX_POW_EQ_0; LE_1] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN DISCH_TAC THEN + EXPAND_TAC "d" THEN + REWRITE_TAC[REAL_ARITH `~(z < e * z) <=> &0 <= z * (&1 - e)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH; + ALL_TAC] THEN + SUBGOAL_THEN + `!z'. z' pow n = z pow n + ==> IMAGE (\w. w pow n) (ball(z',d)) = + IMAGE (\w. w pow n) (ball(z,d))` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `w = Cx(&0)` THENL + [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN + X_GEN_TAC `x:complex` THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `y:complex` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `z / w * y:complex`; + EXISTS_TAC `w / z * y:complex`] THEN + ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL; + COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(w = Cx(&0)) ==> z - z / w * y = z / w * (w - y)`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN + (SUBGOAL_THEN `norm(z pow n) = norm(w pow n)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]]) THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN + ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist]; + ALL_TAC] THEN + EXISTS_TAC `{ ball(z',d) | z' pow n = z pow n}` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:complex` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `x IN ball(w:complex,d)` THEN + ASM_REWRITE_TAC[IN_BALL; GSYM COMPLEX_VEC_0; DIST_0] THEN + SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN + ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_NOT_LT] THEN DISCH_TAC THEN + EXPAND_TAC "d" THEN REWRITE_TAC[REAL_ARITH + `e * z <= z <=> &0 <= z * (&1 - e)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH; + SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) = + IMAGE (\w. w pow n) (ball(w,d))` + SUBST1_TAC THENL [ASM_MESON_TAC[]; ASM SET_TAC[]]]; + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:complex` THEN + REWRITE_TAC[IN_BALL] THEN STRIP_TAC THEN + ASM_CASES_TAC `y = Cx(&0)` THENL + [ASM_MESON_TAC[COMPLEX_POW_EQ_0; LE_1]; ALL_TAC] THEN + EXISTS_TAC `x / y * z:complex` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN + ASM_SIMP_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV; COMPLEX_DIV_REFL; + COMPLEX_POW_EQ_0; LE_1; COMPLEX_MUL_LID; dist] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(y = Cx(&0)) ==> x / y * z - x = x / y * (z - y)`] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_DIV] THEN + SUBGOAL_THEN `norm(y pow n) = norm(x pow n)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN + REWRITE_TAC[COMPLEX_POW_MUL; COMPLEX_POW_DIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN + ASM_SIMP_TAC[LE_1; NORM_POS_LE; REAL_DIV_REFL; COMPLEX_NORM_ZERO] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; GSYM dist]]; + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + REWRITE_TAC[OPEN_BALL; IN_BALL; REAL_NOT_LT; dist; COMPLEX_SUB_RZERO] THEN + SUBGOAL_THEN `norm(w pow n) = norm(z pow n)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN + ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN DISCH_THEN SUBST1_TAC THEN + EXPAND_TAC "d" THEN + REWRITE_TAC[REAL_ARITH `e * z <= z <=> &0 <= z * (&1 - e)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[pairwise; IMP_CONJ; FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN + X_GEN_TAC `u:complex` THEN DISCH_TAC THEN + X_GEN_TAC `v:complex` THEN DISCH_TAC THEN + ASM_CASES_TAC `v:complex = u` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN + X_GEN_TAC `x:complex` THEN REWRITE_TAC[IN_BALL] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `dist(u,x) < d /\ dist(v,x) < d ==> dist(u,v) < &2 * d`)) THEN + REWRITE_TAC[REAL_NOT_LT] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `e * norm(z:complex)` THEN CONJ_TAC THENL + [EXPAND_TAC "d" THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN REWRITE_TAC[dist]] THEN + SUBGOAL_THEN `norm(z pow n) = norm(v pow n)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[COMPLEX_NORM_POW]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] REAL_POW_EQ))) THEN + ASM_SIMP_TAC[LE_1; NORM_POS_LE] THEN ASM_MESON_TAC[]; + X_GEN_TAC `w:complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `IMAGE (\w. w pow n) (ball(z,d)) = + IMAGE (\w. w pow n) (ball(w,d))` + SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INVARIANCE_OF_DOMAIN_HOMEOMORPHISM THEN + SIMP_TAC[LE_REFL; OPEN_BALL; CONTINUOUS_ON_COMPLEX_POW; + CONTINUOUS_ON_ID] THEN + ASM_MESON_TAC[]]);; + +let COVERING_SPACE_SQUARE_PUNCTURED_PLANE = prove + (`covering_space ((:complex) DIFF {Cx(&0)},(\z. z pow 2)) + ((:complex) DIFF {Cx (&0)})`, + SIMP_TAC[COVERING_SPACE_POW_PUNCTURED_PLANE; ARITH]);; + +let COVERING_SPACE_CEXP_PUNCTURED_PLANE = prove + (`covering_space((:complex),cexp) ((:complex) DIFF {Cx(&0)})`, + SIMP_TAC[covering_space; IN_UNIV; CONTINUOUS_ON_CEXP; IN_DIFF; IN_SING] THEN + CONJ_TAC THENL [SET_TAC[CEXP_CLOG; CEXP_NZ]; ALL_TAC] THEN + SIMP_TAC[OPEN_IN_OPEN_EQ; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN + SIMP_TAC[SUBSET_UNIV; SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN + X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + EXISTS_TAC `IMAGE cexp (ball(clog z,&1))` THEN + REWRITE_TAC[SET_RULE `~(z IN IMAGE f s) <=> !x. x IN s ==> ~(f x = z)`] THEN + REWRITE_TAC[CEXP_NZ] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `clog z` THEN + ASM_SIMP_TAC[CEXP_CLOG; CENTRE_IN_BALL; REAL_LT_01]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. x IN cball(clog z,&1) /\ y IN cball(clog z,&1) /\ cexp x = cexp y + ==> x = y` + ASSUME_TAC THENL + [REWRITE_TAC[IN_CBALL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_EQ_CEXP THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `norm(x - y:complex)` THEN + REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2` THEN CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH; + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INVARIANCE_OF_DOMAIN THEN + REWRITE_TAC[OPEN_BALL; CONTINUOUS_ON_CEXP] THEN + ASM_MESON_TAC[SUBSET; BALL_SUBSET_CBALL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`cball(clog z,&1)`; `cexp`; + `IMAGE cexp (cball(clog z,&1))`] HOMEOMORPHISM_COMPACT) THEN + ASM_REWRITE_TAC[COMPACT_CBALL; CONTINUOUS_ON_CEXP] THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `l:complex->complex` THEN STRIP_TAC THEN + EXISTS_TAC `{ IMAGE (\x. x + Cx (&2 * n * pi) * ii) + (ball(clog z,&1)) + | integer n}` THEN + SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; + ONCE_REWRITE_RULE[VECTOR_ADD_SYM] OPEN_TRANSLATION] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; IN_IMAGE; CEXP_EQ] THEN SET_TAC[]; + REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `m:real` THEN DISCH_TAC THEN + X_GEN_TAC `n:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `m:real = n` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[IN_BALL; dist; SET_RULE + `DISJOINT (IMAGE f s) (IMAGE g s) <=> + !x y. x IN s /\ y IN s ==> ~(f x = g y)`] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(NORM_ARITH + `&2 <= norm(m - n) + ==> norm(c - x) < &1 /\ norm(c - y) < &1 ==> ~(x + m = y + n)`) THEN + REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_II; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_PI; REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * &1 * pi` THEN + CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + SIMP_TAC[REAL_LE_RMUL_EQ; PI_POS; REAL_POS] THEN + MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN + ASM_SIMP_TAC[REAL_SUB_0; INTEGER_CLOSED]; + X_GEN_TAC `n:real` THEN DISCH_TAC THEN + EXISTS_TAC `(\x. x + Cx(&2 * n * pi) * ii) o (l:complex->complex)` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CEXP; o_THM; IMAGE_o; FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INJECTIVE_ON_ALT]) THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID; + REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. e(f x) = e x) ==> IMAGE e (IMAGE f s) = IMAGE e s`) THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_INTEGER_2PI; COMPLEX_MUL_RID]; + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> l(e x) = x) + ==> IMAGE t (IMAGE l (IMAGE e s)) = IMAGE t s`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] BALL_SUBSET_CBALL]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + ASM_MESON_TAC[BALL_SUBSET_CBALL; IMAGE_SUBSET; + CONTINUOUS_ON_SUBSET]]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence the Borsukian results about mappings into circle. *) +(* ------------------------------------------------------------------------- *) + +let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM = prove + (`!f:real^N->complex s. + (?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=> + (?g. g continuous_on s /\ (!x. x IN s ==> f x = cexp(g x)))`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(CHOOSE_THEN + (MP_TAC o CONJ COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN + DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION) THEN + REWRITE_TAC[SUBSET_UNIV] THEN MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) + (cexp o g) (\x:real^N. a)` + MP_TAC THENL + [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN + EXISTS_TAC `(:complex)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + ASM_SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV] THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_UNIV; IN_DIFF; IN_SING; CEXP_NZ]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + ASM_SIMP_TAC[o_THM]]]);; + +let INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE = prove + (`!f:real^N->complex s. + (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) + ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`, + REPEAT GEN_TAC THEN + SIMP_TAC[sphere; GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN + REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + SIMP_TAC[SUBSET; DIST_0; FORALL_IN_GSPEC; IN_UNIV; IN_DIFF; IN_SING] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC);; + +let INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE = prove + (`!f:real^N->complex s. + (?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) f (\t. a)) <=> + (?g. (Cx o g) continuous_on s /\ + !x. x IN s ==> f x = cexp(ii * Cx(g x)))`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o + MATCH_MP INESSENTIAL_IMP_CONTINUOUS_LOGARITHM_CIRCLE) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Im o (g:real^N->complex)` THEN CONJ_TAC THENL + [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM]; + FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o CONJUNCT1 o + MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; NORM_CEXP] THEN + REWRITE_TAC[EULER; o_THM; RE_MUL_II; IM_MUL_II] THEN + SIMP_TAC[RE_CX; IM_CX; REAL_NEG_0; REAL_EXP_0]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?a. homotopic_with (\h. T) (s,sphere(vec 0,&1)) + ((cexp o (\z. ii * z)) o (Cx o g)) (\x:real^N. a)` + MP_TAC THENL + [MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN + EXISTS_TAC `{z | Im z = &0}` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_CEXP; CONJ_ASSOC; + CONTINUOUS_ON_COMPLEX_LMUL; CONTINUOUS_ON_ID] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_SPHERE_0; + o_THM; IM_CX] THEN + SIMP_TAC[NORM_CEXP; RE_MUL_II; REAL_EXP_0; REAL_NEG_0]; + MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN + MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN CONJ_TAC THENL + [REWRITE_TAC[IM_DEF; CONVEX_STANDARD_HYPERPLANE]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[IM_CX]]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:complex` THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + ASM_SIMP_TAC[o_THM]]]);; + +let HOMOTOPIC_CIRCLEMAPS_DIV,HOMOTOPIC_CIRCLEMAPS_DIV_1 = (CONJ_PAIR o prove) + (`(!f g:real^N->real^2 s. + homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=> + f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\ + g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\ + ?c. homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. c)) /\ + (!f g:real^N->real^2 s. + homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g <=> + f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,&1) /\ + g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,&1) /\ + homotopic_with (\x. T) (s,sphere(vec 0,&1)) (\x. f x / g x) (\x. Cx(&1)))`, + let lemma = prove + (`!f g h:real^N->real^2 s. + homotopic_with (\x. T) (s,sphere(vec 0,&1)) f g + ==> h continuous_on s /\ (!x. x IN s ==> h(x) IN sphere(vec 0,&1)) + ==> homotopic_with (\x. T) (s,sphere(vec 0,&1)) + (\x. f x * h x) (\x. g x * h x)`, + REWRITE_TAC[IN_SPHERE_0] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + ASM_SIMP_TAC[HOMOTOPIC_WITH; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; FORALL_IN_PCROSS] THEN + X_GEN_TAC `k:real^((1,N)finite_sum)->real^2` THEN STRIP_TAC THEN + EXISTS_TAC `\z. (k:real^(1,N)finite_sum->real^2) z * h(sndcart z)` THEN + ASM_SIMP_TAC[COMPLEX_NORM_MUL; SNDCART_PASTECART; REAL_MUL_LID] THEN + ASM_REWRITE_TAC[SNDCART_PASTECART] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + ASM_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN + ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]) in + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC + (TAUT `(q <=> r) /\ (p <=> r) ==> (p <=> q) /\ (p <=> r)`) THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN + DISCH_TAC) THEN + EQ_TAC THENL + [ALL_TAC; DISCH_TAC THEN EXISTS_TAC `Cx(&1)` THEN ASM_MESON_TAC[]] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c:complex` THEN + DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN + MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`vec 0:real^2`; `&1`] PATH_CONNECTED_SPHERE) THEN + REWRITE_TAC[DIMINDEX_2; LE_REFL; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[IN_SPHERE_0; COMPLEX_NORM_CX; REAL_ABS_NUM]]; + EQ_TAC THEN STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP lemma) THENL + [FIRST_ASSUM(STRIP_ASSUME_TAC o + MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + DISCH_THEN(MP_TAC o SPEC `\x. inv((g:real^N->complex) x)`); + DISCH_THEN(MP_TAC o SPEC `g:real^N->complex`)] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN + ASM_SIMP_TAC[IN_SPHERE_0; COMPLEX_NORM_INV; REAL_INV_1] THEN + ASM_SIMP_TAC[GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ; + CONTINUOUS_ON_COMPLEX_INV] THEN + ASM_REWRITE_TAC[SUBSET; IN_SPHERE_0; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] + HOMOTOPIC_WITH_EQ) THEN + ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_MUL_LID; COMPLEX_MUL_RINV; + GSYM complex_div; COMPLEX_DIV_REFL; + GSYM COMPLEX_NORM_ZERO; REAL_OF_NUM_EQ; ARITH_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, complex logs exist on various "well-behaved" sets. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE = prove + (`!f:real^N->complex s. + f continuous_on s /\ contractible s /\ + (!x. x IN s ==> ~(f x = Cx(&0))) + ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NULLHOMOTOPIC_FROM_CONTRACTIBLE THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED = prove + (`!f:real^N->complex s. + f continuous_on s /\ simply_connected s /\ locally path_connected s /\ + (!x. x IN s ==> ~(f x = Cx(&0))) + ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = cexp(g x)`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPECL [`f:real^N->complex`; `s:real^N->bool`] + (MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT) + COVERING_SPACE_CEXP_PUNCTURED_PLANE)) THEN + ASM_REWRITE_TAC[IN_UNIV] THEN ASM SET_TAC[]);; + +let CONTINUOUS_LOGARITHM_ON_CBALL = prove + (`!f:real^N->complex a r. + f continuous_on cball(a,r) /\ + (!z. z IN cball(a,r) ==> ~(f z = Cx(&0))) + ==> ?h. h continuous_on cball(a,r) /\ + !z. z IN cball(a,r) ==> f z = cexp(h z)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN + MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN + MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN + ASM_REWRITE_TAC[CONVEX_CBALL]);; + +let CONTINUOUS_LOGARITHM_ON_BALL = prove + (`!f:real^N->complex a r. + f continuous_on ball(a,r) /\ + (!x. x IN ball(a,r) ==> ~(f x = Cx(&0))) + ==> ?h. h continuous_on ball(a,r) /\ + !x. x IN ball(a,r) ==> f x = cexp(h x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; NOT_IN_EMPTY] THEN + MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN + MATCH_MP_TAC CONVEX_IMP_STARLIKE THEN + ASM_REWRITE_TAC[CONVEX_BALL]);; + +let CONTINUOUS_SQRT_ON_CONTRACTIBLE = prove + (`!f:real^N->complex s. + f continuous_on s /\ contractible s /\ + (!x. x IN s ==> ~(f x = Cx(&0))) + ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN + ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN + CONV_TAC COMPLEX_RING);; + +let CONTINUOUS_SQRT_ON_SIMPLY_CONNECTED = prove + (`!f:real^N->complex s. + f continuous_on s /\ simply_connected s /\ locally path_connected s /\ + (!x. x IN s ==> ~(f x = Cx(&0))) + ==> ?g. g continuous_on s /\ !x. x IN s ==> f x = (g x) pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:real^N. cexp(g z / Cx(&2))` THEN + ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST] THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* Analogously, holomorphic logarithms and square roots. *) +(* ------------------------------------------------------------------------- *) + +let CONTRACTIBLE_IMP_HOLOMORPHIC_LOG,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG = + (CONJ_PAIR o prove) + (`(!s:complex->bool. + contractible s + ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z)) /\ + (!s:complex->bool. + simply_connected s /\ locally path_connected s + ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = cexp(g z))`, + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] + CONTINUOUS_LOGARITHM_ON_CONTRACTIBLE); + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] + CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED)] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_IMP_CONTINUOUS_ON] THEN + (MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:complex->complex` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `f holomorphic_on s` THEN + REWRITE_TAC[holomorphic_on] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `z:complex` THEN ASM_CASES_TAC `(z:complex) IN s` THEN + ASM_REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN] THEN + DISCH_THEN(X_CHOOSE_THEN `f':complex` MP_TAC) THEN + DISCH_THEN(MP_TAC o + ISPECL [`\x. (cexp(g x) - cexp(g z)) / (x - z)`; `&1`] o + MATCH_MP (REWRITE_RULE [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + LIM_TRANSFORM_WITHIN)) THEN + ASM_SIMP_TAC[REAL_LT_01] THEN + DISCH_THEN(MP_TAC o + SPECL [`\x:complex. if g x = g z then cexp(g z) + else (cexp(g x) - cexp(g z)) / (g x - g z)`; + `cexp(g(z:complex))`] o + MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_COMPLEX_DIV)) THEN + REWRITE_TAC[CEXP_NZ] THEN ANTS_TAC THENL + [SUBGOAL_THEN + `(\x. if g x = g z then cexp(g z) + else (cexp(g x) - cexp(g(z:complex))) / (g x - g z)) = + (\y. if y = g z then cexp(g z) else (cexp y - cexp(g z)) / (y - g z)) o g` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPOSE_AT THEN + EXISTS_TAC `(g:complex->complex) z` THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON]; + REWRITE_TAC[EVENTUALLY_TRUE]; + ONCE_REWRITE_TAC[LIM_AT_ZERO] THEN + SIMP_TAC[COMPLEX_VEC_0; COMPLEX_ADD_SUB; COMPLEX_EQ_ADD_LCANCEL_0] THEN + MP_TAC(SPEC `cexp(g(z:complex))` (MATCH_MP LIM_COMPLEX_LMUL + LIM_CEXP_MINUS_1)) THEN REWRITE_TAC[COMPLEX_MUL_RID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + SIMP_TAC[EVENTUALLY_AT; GSYM DIST_NZ; CEXP_ADD] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + SIMPLE_COMPLEX_ARITH_TAC]; + DISCH_THEN(fun th -> + EXISTS_TAC `f' / cexp(g(z:complex))` THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + LIM_TRANSFORM_EVENTUALLY) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN + DISCH_THEN(MP_TAC o SPEC `z:complex`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; tendsto] THEN + DISCH_THEN(MP_TAC o SPEC `&2 * pi`) THEN + REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `w:complex` THEN REWRITE_TAC[dist] THEN DISCH_TAC THEN + COND_CASES_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_SUB_REFL; complex_div; COMPLEX_MUL_LZERO]; + ASM_CASES_TAC `w:complex = z` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(cexp(g(w:complex)) = cexp(g z))` MP_TAC THENL + [UNDISCH_TAC `~((g:complex->complex) w = g z)` THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] COMPLEX_EQ_CEXP) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LET_TRANS)) THEN + REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]; + REPEAT(FIRST_X_ASSUM(MP_TAC o check(is_neg o concl))) THEN + CONV_TAC COMPLEX_FIELD]]]));; + +let CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT,SIMPLY_CONNECTED_IMP_HOLOMORPHIC_SQRT = + (CONJ_PAIR o prove) + (`(!s:complex->bool. + contractible s + ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = g z pow 2) /\ + (!s:complex->bool. + simply_connected s /\ locally path_connected s + ==> !f. f holomorphic_on s /\ (!z. z IN s ==> ~(f z = Cx(&0))) + ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = g z pow 2)`, + CONJ_TAC THEN GEN_TAC THENL + [DISCH_THEN(ASSUME_TAC o MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG); + DISCH_THEN(ASSUME_TAC o + MATCH_MP SIMPLY_CONNECTED_IMP_HOLOMORPHIC_LOG)] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:complex->complex`) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:complex. cexp(g z / Cx(&2))` THEN + ASM_SIMP_TAC[GSYM CEXP_N; COMPLEX_RING `Cx(&2) * z / Cx(&2) = z`] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN + REWRITE_TAC[HOLOMORPHIC_ON_CEXP] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_DIV THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_CONST] THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* Related theorems about holomorphic inverse cosines. *) +(* ------------------------------------------------------------------------- *) + +let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS = prove + (`!f s. f holomorphic_on s /\ contractible s /\ + (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1))) + ==> ?g. g holomorphic_on s /\ !z. z IN s ==> f z = ccos(g z)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\z:complex. Cx(&1) - f(z) pow 2` o + MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_SQRT) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_SUB; HOLOMORPHIC_ON_CONST; HOLOMORPHIC_ON_POW; + COMPLEX_RING `~(Cx(&1) - z pow 2 = Cx(&0)) <=> + ~(z = Cx(&1)) /\ ~(z = --Cx(&1))`] THEN + REWRITE_TAC[COMPLEX_RING + `Cx(&1) - w pow 2 = z pow 2 <=> + (w + ii * z) * (w - ii * z) = Cx(&1)`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `\z:complex. f(z) + ii * g(z)` o + MATCH_MP CONTRACTIBLE_IMP_HOLOMORPHIC_LOG) THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; + COMPLEX_RING `(a + b) * (a - b) = Cx(&1) ==> ~(a + b = Cx(&0))`] THEN + DISCH_THEN(X_CHOOSE_THEN `h:complex->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:complex. --ii * h(z)` THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_MUL; HOLOMORPHIC_ON_CONST; ccos] THEN + X_GEN_TAC `z:complex` THEN + DISCH_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (COMPLEX_FIELD + `a * b = Cx(&1) ==> b = inv a`)) THEN + ASM_SIMP_TAC[GSYM CEXP_NEG] THEN + FIRST_X_ASSUM(ASSUME_TAC o SYM) THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + ASM_REWRITE_TAC[COMPLEX_RING `ii * --ii * z = z`; + COMPLEX_RING `--ii * --ii * z = --z`] THEN + CONV_TAC COMPLEX_RING);; + +let CONTRACTIBLE_IMP_HOLOMORPHIC_ACS_BOUNDED = prove + (`!f s a. + f holomorphic_on s /\ contractible s /\ a IN s /\ + (!z. z IN s ==> ~(f z = Cx(&1)) /\ ~(f z = --Cx(&1))) + ==> ?g. g holomorphic_on s /\ norm(g a) <= pi + norm(f a) /\ + !z. z IN s ==> f z = ccos(g z)`, + let lemma = prove + (`!w. ?v. ccos(v) = w /\ norm(v) <= pi + norm(w)`, + GEN_TAC THEN EXISTS_TAC `cacs w` THEN ABBREV_TAC `v = cacs w` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[CCOS_CACS]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + SIMP_TAC[NORM_LE_SQUARE; PI_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= b * c /\ a <= b pow 2 + c pow 2 ==> a <= (b + c) pow 2`) THEN + SIMP_TAC[REAL_LE_MUL; PI_POS_LE; NORM_POS_LE] THEN + REWRITE_TAC[COMPLEX_SQNORM; GSYM NORM_POW_2; NORM_CCOS_POW_2] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN + EXPAND_TAC "v" THEN REWRITE_TAC[REAL_ABS_PI; RE_CACS_BOUND] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= c /\ x <= (d / &2) pow 2 ==> x <= c + d pow 2 / &4`) THEN + REWRITE_TAC[REAL_LE_POW_2; GSYM REAL_LE_SQUARE_ABS; REAL_LE_ABS_SINH]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:complex->complex`; `s:complex->bool`] + CONTRACTIBLE_IMP_HOLOMORPHIC_ACS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `(f:complex->complex) a` lemma) THEN + DISCH_THEN(X_CHOOSE_THEN `b:complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `ccos b = ccos(g(a:complex))` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[CCOS_EQ]] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real` (STRIP_ASSUME_TAC o GSYM)) THENL + [EXISTS_TAC `\z:complex. g z + Cx(&2 * n * pi)`; + EXISTS_TAC `\z:complex. --(g z) + Cx(&2 * n * pi)`] THEN + ASM_SIMP_TAC[HOLOMORPHIC_ON_ADD; HOLOMORPHIC_ON_NEG; + HOLOMORPHIC_ON_CONST] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[CCOS_EQ] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Extension property for inessential maps. This almost follows from *) +(* INESSENTIAL_NEIGHBOURHOOD_EXTENSION except that here we don't need to *) +(* assume that t is closed in s. *) +(* ------------------------------------------------------------------------- *) + +let INESSENTIAL_NEIGHBOURHOOD_EXTENSION_LOGARITHM = prove + (`!f:real^N->complex s t. + f continuous_on s /\ t SUBSET s /\ + (?g. g continuous_on t /\ !x. x IN t ==> f x = cexp(g x)) + ==> ?u. t SUBSET u /\ open_in (subtopology euclidean s) u /\ + (?g. g continuous_on u /\ !x. x IN u ==> f x = cexp(g x))`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` (STRIP_ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN + `!x. x IN t + ==> ?d. &0 < d /\ + (!y. y IN s /\ dist(x,y) < d + ==> norm(f y / f x - Cx(&1)) < &1 / &7) /\ + (!z:real^N. z IN t /\ dist(x,z) < &2 * d + ==> norm(h z - h x) < &1 / &5)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + UNDISCH_TAC `(h:real^N->complex) continuous_on t` THEN + GEN_REWRITE_TAC LAND_CONV [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[continuous_within] THEN + DISCH_THEN(MP_TAC o SPEC `&1 / &5`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [dist] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~((f:real^N->complex) x = Cx(&0))` ASSUME_TAC THENL + [ASM_MESON_TAC[CEXP_NZ]; ALL_TAC] THEN + SUBGOAL_THEN + `(\y:real^N. f y / f x) continuous (at x within s)` + MP_TAC THENL + [REWRITE_TAC[complex_div] THEN MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_CONST] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; SUBSET]; + REWRITE_TAC[continuous_within] THEN + DISCH_THEN(MP_TAC o SPEC `&1 / &7`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[COMPLEX_DIV_REFL; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `min d (e / &2)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_HALF] THEN CONJ_TAC THENL + [ASM_MESON_TAC[NORM_SUB]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real^N->real` THEN DISCH_THEN(LABEL_TAC "*")] THEN + ABBREV_TAC `u = \x. s INTER ball(x:real^N,d x)` THEN + ABBREV_TAC `g = \x y. h(x:real^N) + clog(f y / f x)` THEN + SUBGOAL_THEN + `(!x:real^N. x IN t ==> x IN u x) /\ + (!x. x IN t ==> open_in (subtopology euclidean s) (u x))` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "u" THEN + ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:real^N y:real^N. x IN t /\ y IN u x ==> cexp(g x y) = f y` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + EXPAND_TAC "g" THEN REWRITE_TAC[CEXP_ADD] THEN ASM_SIMP_TAC[] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN + MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `norm(x - y) < &1 / &7 ==> norm(y) = &1 ==> ~(x = vec 0)`)) THEN + SIMP_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; CEXP_CLOG; COMPLEX_VEC_0] THEN + SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_DIV_EQ_0; DE_MORGAN_THM]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g:real^N->real^N->complex`; + `u:real^N->real^N->bool`; + `UNIONS {(u:real^N->real^N->bool) x | x IN t}`; + `t:real^N->bool`] + PASTING_LEMMA_EXISTS) THEN + REWRITE_TAC[SUBSET_REFL] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; + EXPAND_TAC "g" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[complex_div] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_RMUL THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; + MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; IN_INTER] THEN + X_GEN_TAC `y:real^N` THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN + REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH + `abs x < &1 ==> &0 < x + &1`) THEN + MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS] + `norm z < &1 ==> abs(Re z) < &1`) THEN + MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N` o el 1 o CONJUNCTS) THEN + MP_TAC(ASSUME `y IN (u:real^N->real^N->bool) x`) THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]]]; + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[IM_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `&5 < a /\ abs(ha - hb) < &1 / &5 /\ abs(fa) < &2 /\ abs(fb) < &2 + ==> abs((ha + fa) - (hb + fb)) < a`) THEN + CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM IM_SUB] THEN + MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS] + `norm z < a ==> abs(Im z) < a`) THEN + MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`) THEN + MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`) THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IMP_IMP; IN_INTER; IN_BALL] THEN + DISCH_THEN(MP_TAC o MATCH_MP (TAUT + `(p /\ q) /\ (p /\ r) ==> q /\ r`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `dist(a,x) < d /\ dist(b,x) < e + ==> dist(a,b) < &2 * d \/ dist(a,b) < &2 * e`)) THEN + STRIP_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`); + REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + ASM_MESON_TAC[NORM_SUB; DIST_SYM]; + CONJ_TAC THEN TRANS_TAC REAL_LT_TRANS `pi / &2` THEN + (CONJ_TAC THENL + [ALL_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]) THEN + MATCH_MP_TAC RE_CLOG_POS_LT_IMP THEN + ONCE_REWRITE_TAC[COMPLEX_RING `z = (z - Cx(&1)) + Cx(&1)`] THEN + REWRITE_TAC[RE_ADD; RE_CX] THEN MATCH_MP_TAC(REAL_ARITH + `abs x < &1 ==> &0 < x + &1`) THEN + MATCH_MP_TAC(MESON[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS] + `norm z < &1 ==> abs(Re z) < &1`) THEN + MATCH_MP_TAC(REAL_ARITH `x < &1 / &7 ==> x < &1`) THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `a:real^N`); + REMOVE_THEN "*" (MP_TAC o SPEC `b:real^N`)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N` o el 1 o CONJUNCTS) THEN + DISCH_THEN MATCH_MP_TAC THENL + [MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) a`); + MP_TAC(ASSUME `x IN (u:real^N->real^N->bool) b`)] THEN + EXPAND_TAC "u" THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]]]; + DISCH_THEN(X_CHOOSE_THEN `h':real^N->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `UNIONS {(u:real^N->real^N->bool) x | x IN t}` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_GSPEC] THEN + EXISTS_TAC `h':real^N->complex` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_IN_UNIONS; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `x:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The "borsukian" property of sets. This doesn't seem to have a standard *) +(* name. Kuratowski uses "contractible with respect to [S^1]" while *) +(* Whyburn uses "property b". It's closely related to unicoherence. *) +(* ------------------------------------------------------------------------- *) + +let borsukian = new_definition + `borsukian(s:real^N->bool) <=> + !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) + ==> ?a. homotopic_with (\h. T) (s,(:real^2) DIFF {Cx(&0)}) + f (\x. a)`;; + +let BORSUKIAN_RETRACTION_GEN = prove + (`!s:real^M->bool t:real^N->bool h k. + h continuous_on s /\ IMAGE h s = t /\ + k continuous_on t /\ IMAGE k t SUBSET s /\ + (!y. y IN t ==> h(k y) = y) /\ + borsukian s + ==> borsukian t`, + REPEAT GEN_TAC THEN REWRITE_TAC[borsukian] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_forall o concl)) THEN + PURE_ONCE_REWRITE_TAC[TAUT `p /\ q <=> p /\ q /\ T`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN) THEN + REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let RETRACT_OF_BORSUKIAN = prove + (`!s t:real^N->bool. borsukian t /\ s retract_of t ==> borsukian s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] (REWRITE_RULE[CONJ_ASSOC] + BORSUKIAN_RETRACTION_GEN)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [retract_of]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:real^N->real^N` THEN + REWRITE_TAC[RETRACTION] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `\x:real^N. x` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID]);; + +let HOMEOMORPHIC_BORSUKIAN = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ borsukian s ==> borsukian t`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN + MESON_TAC[BORSUKIAN_RETRACTION_GEN; SUBSET_REFL]);; + +let HOMEOMORPHIC_BORSUKIAN_EQ = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> (borsukian s <=> borsukian t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_BORSUKIAN) THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; + +let BORSUKIAN_TRANSLATION = prove + (`!a:real^N s. borsukian (IMAGE (\x. a + x) s) <=> borsukian s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; + +add_translation_invariants [BORSUKIAN_TRANSLATION];; + +let BORSUKIAN_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (borsukian(IMAGE f s) <=> borsukian s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_BORSUKIAN_EQ THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; + HOMEOMORPHIC_REFL]);; + +add_linear_invariants [BORSUKIAN_INJECTIVE_LINEAR_IMAGE];; + +let HOMOTOPY_EQUIVALENT_BORSUKIANNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t + ==> (borsukian s <=> borsukian t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[borsukian] THEN + MATCH_MP_TAC HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL THEN + ASM_REWRITE_TAC[]);; + +let BORSUKIAN_ALT = prove + (`!s:real^N->bool. + borsukian s <=> + !f g:real^N->real^2. + f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) /\ + g continuous_on s /\ IMAGE g s SUBSET ((:real^2) DIFF {Cx(&0)}) + ==> homotopic_with (\h. T) (s,(:real^2) DIFF {Cx (&0)}) f g`, + REWRITE_TAC[borsukian; HOMOTOPIC_TRIVIALITY] THEN + SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; DIMINDEX_2; LE_REFL]);; + +let BORSUKIAN_CONTINUOUS_LOGARITHM = prove + (`!s:real^N->bool. + borsukian s <=> + !f. f continuous_on s /\ IMAGE f s SUBSET ((:real^2) DIFF {Cx(&0)}) + ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`, + REWRITE_TAC[borsukian; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM]);; + +let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE = prove + (`!s:real^N->bool. + borsukian s <=> + !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) + ==> ?g. g continuous_on s /\ (!x. x IN s ==> f(x) = cexp(g x))`, + GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0; SET_RULE + `IMAGE f s SUBSET UNIV DIFF {a} <=> !z. z IN s ==> ~(f z = a)`] THEN + EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real^N` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `\x:real^N. f(x) / Cx(norm(f x))`) THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NORM; + REAL_DIV_REFL; NORM_EQ_0; COMPLEX_NORM_ZERO] THEN + ANTS_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_DIV THEN + ASM_REWRITE_TAC[CX_INJ; COMPLEX_NORM_ZERO; CONTINUOUS_ON_CX_LIFT] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_NORM_COMPOSE]; + ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD + `~(z = Cx(&0)) ==> (w / z = u <=> w = z * u)`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `\x. clog(Cx(norm(f x:complex))) + (g:real^N->complex)(x)` THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG; CX_INJ; COMPLEX_NORM_ZERO] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CX_LIFT; CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN + MATCH_MP_TAC CONTINUOUS_ON_CLOG THEN + ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; RE_CX; COMPLEX_NORM_NZ]]]);; + +let BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX = prove + (`!s:real^N->bool. + borsukian s <=> + !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) + ==> ?g. (Cx o g) continuous_on s /\ + (!x. x IN s ==> f x = cexp(ii * Cx(g x)))`, + GEN_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; COMPLEX_IN_SPHERE_0] THEN EQ_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^N->complex` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN + EXISTS_TAC `Im o (g:real^N->complex)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CX_IM; CONTINUOUS_ON_COMPOSE; o_ASSOC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(f:real^N->complex) x = cexp(g x)` THEN + ASM_REWRITE_TAC[NORM_CEXP; o_DEF; REAL_EXP_EQ_1] THEN + DISCH_TAC THEN AP_TERM_TAC THEN + ASM_REWRITE_TAC[COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_NEG_0]; + X_GEN_TAC `g:real^N->real` THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^N. ii * Cx(g x)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + ASM_REWRITE_TAC[GSYM o_DEF]]);; + +let BORSUKIAN_CIRCLE = prove + (`!s:real^N->bool. + borsukian s <=> + !f. f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) + ==> ?a. homotopic_with (\h. T) (s,sphere(Cx(&0),&1)) + f (\x. a)`, + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN + REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN + REWRITE_TAC[COMPLEX_VEC_0]);; + +let BORSUKIAN_CIRCLE_ALT = prove + (`!s:real^N->bool. + borsukian s <=> + !f g:real^N->real^2. + f continuous_on s /\ IMAGE f s SUBSET sphere(Cx(&0),&1) /\ + g continuous_on s /\ IMAGE g s SUBSET sphere(Cx(&0),&1) + ==> homotopic_with (\h. T) (s,sphere(Cx(&0),&1)) f g`, + REWRITE_TAC[BORSUKIAN_CIRCLE; HOMOTOPIC_TRIVIALITY] THEN + SIMP_TAC[PATH_CONNECTED_SPHERE; DIMINDEX_2; LE_REFL]);; + +let CONTRACTIBLE_IMP_BORSUKIAN = prove + (`!s:real^N->bool. contractible s ==> borsukian s`, + SIMP_TAC[borsukian; CONTRACTIBLE_IMP_PATH_CONNECTED] THEN + MESON_TAC[NULLHOMOTOPIC_FROM_CONTRACTIBLE]);; + +let SIMPLY_CONNECTED_IMP_BORSUKIAN = prove + (`!s:real^N->bool. + simply_connected s /\ locally path_connected s ==> borsukian s`, + SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED THEN + ASM SET_TAC[]);; + +let STARLIKE_IMP_BORSUKIAN = prove + (`!s:real^N->bool. starlike s ==> borsukian s`, + SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; STARLIKE_IMP_CONTRACTIBLE]);; + +let BORSUKIAN_EMPTY = prove + (`borsukian({}:real^N->bool)`, + SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_EMPTY]);; + +let BORSUKIAN_UNIV = prove + (`borsukian(:real^N)`, + SIMP_TAC[CONTRACTIBLE_IMP_BORSUKIAN; CONTRACTIBLE_UNIV]);; + +let CONVEX_IMP_BORSUKIAN = prove + (`!s:real^N->bool. convex s ==> borsukian s`, + MESON_TAC[STARLIKE_IMP_BORSUKIAN; CONVEX_IMP_STARLIKE; BORSUKIAN_EMPTY]);; + +let BORSUKIAN_SPHERE = prove + (`!a:real^N r. 3 <= dimindex(:N) ==> borsukian (sphere(a,r))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLY_CONNECTED_IMP_BORSUKIAN THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN + ASM_SIMP_TAC[LOCALLY_PATH_CONNECTED_SPHERE; SIMPLY_CONNECTED_SPHERE]);; + +let BORSUKIAN_OPEN_UNION = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t /\ + borsukian s /\ borsukian t /\ connected(s INTER t) + ==> borsukian(s UNION t)`, + REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN + STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN + ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL + [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`] + CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + EXISTS_TAC `&2 * pi` THEN + REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `a - b:complex = c - d <=> a - c = b - d`] THEN + DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LET_TRANS)) THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING + `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN + REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]]; + + REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN + DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN + EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN + ASM SET_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN + SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`; + CEXP_NZ; COMPLEX_MUL_LID] THEN + ASM SET_TAC[]]]);; + +let BORSUKIAN_CLOSED_UNION = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + borsukian s /\ borsukian t /\ connected(s INTER t) + ==> borsukian(s UNION t)`, + REPEAT GEN_TAC THEN SIMP_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN + STRIP_TAC THEN X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`)) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC)] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ASM SET_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN + ASM_CASES_TAC `s INTER t:real^N->bool = {}` THENL + [EXISTS_TAC `(\x. if x IN s then g x else h x):real^N->complex` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(\x. g x - h x):real^N->complex`; `s INTER t:real^N->bool`] + CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + EXISTS_TAC `&2 * pi` THEN + REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `a - b:complex = c - d <=> a - c = b - d`] THEN + DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + REWRITE_TAC[CEXP_SUB] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LET_TRANS)) THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [COMPLEX_RING + `(a - b) - (c - d):complex = (a - c) - (b - d)`] THEN + REWRITE_TAC[GSYM IM_SUB; COMPLEX_NORM_GE_RE_IM]]; + + REWRITE_TAC[IN_INTER; COMPLEX_EQ_SUB_RADD] THEN + DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN + EXISTS_TAC `(\x. if x IN s then g x else a + h x):real^N->complex` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST] THEN + ASM SET_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ y IN t` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `cexp(a + h(y:real^N)) = cexp(h y)` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[CEXP_ADD]] THEN + SIMP_TAC[COMPLEX_RING `a * z = z <=> a = Cx(&1) \/ z = Cx(&0)`; + CEXP_NZ; COMPLEX_MUL_LID] THEN + ASM SET_TAC[]]]);; + +let BORSUKIAN_SEPARATION_COMPACT = prove + (`!s:real^2->bool. + compact s ==> (borsukian s <=> connected((:real^2) DIFF s))`, + SIMP_TAC[BORSUKIAN_CIRCLE; BORSUK_SEPARATION_THEOREM; DIMINDEX_2; LE_REFL; + COMPLEX_VEC_0]);; + +let BORSUKIAN_COMPONENTWISE_EQ = prove + (`!s:real^N->bool. + locally connected s \/ compact s + ==> (borsukian s <=> !c. c IN components s ==> borsukian c)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[BORSUKIAN_ALT] THEN + MATCH_MP_TAC COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS THEN + ASM_SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING]);; + +let BORSUKIAN_COMPONENTWISE = prove + (`!s:real^N->bool. + (locally connected s \/ compact s) /\ + (!c. c IN components s ==> borsukian c) + ==> borsukian s`, + MESON_TAC[BORSUKIAN_COMPONENTWISE_EQ]);; + +let BORSUKIAN_MONOTONE_IMAGE_COMPACT = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ + borsukian s + ==> borsukian t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM] THEN + X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [BORSUKIAN_CONTINUOUS_LOGARITHM]) THEN + DISCH_THEN(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN + ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f':real^N->real^M` THEN STRIP_TAC THEN + EXISTS_TAC `(h:real^M->complex) o (f':real^N->real^M)` THEN + REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_FROM_CLOSED_GRAPH THEN + EXISTS_TAC `IMAGE (h:real^M->complex) s` THEN + ASM_SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; IMAGE_o] THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[o_THM]] THEN + SUBGOAL_THEN + `{pastecart x ((h:real^M->complex) ((f':real^N->real^M) x)) | x IN t} = + {p | ?x. x IN s /\ pastecart x p IN + {z | z IN s PCROSS UNIV /\ + (sndcart z - pastecart (f(fstcart z)) + (h(fstcart z))) IN {vec 0}}}` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CLOSED_COMPACT_PROJECTION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_SIMP_TAC[CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED] THEN + REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN REWRITE_TAC[GSYM o_DEF] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN + ASM_REWRITE_TAC[UNIV_NOT_EMPTY]] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS; FSTCART_PASTECART; + SNDCART_PASTECART; IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM] THEN + REWRITE_TAC[CONJ_ASSOC; PASTECART_INJ] THEN + MAP_EVERY X_GEN_TAC [`y:real^N`; `z:complex`] THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[UNWIND_THM1] THEN EQ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?a. !x. x IN {x | x IN s /\ (f:real^M->real^N) x = y} + ==> h x - h(f' y):complex = a` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:complex` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `(f':real^N->real^M) y`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[VECTOR_SUB_REFL]] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `v:real^M` THEN STRIP_TAC THEN + EXISTS_TAC `&2 * pi` THEN + REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + X_GEN_TAC `u:real^M` THEN + REWRITE_TAC[COMPLEX_RING `a - x:complex = b - x <=> a = b`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + REWRITE_TAC[COMPLEX_RING `(a - x) - (b - x):complex = a - b`] THEN + DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN REWRITE_TAC[GSYM IM_SUB] THEN + ASM_MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);; + +let BORSUKIAN_OPEN_MAP_IMAGE_COMPACT = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ + borsukian s + ==> borsukian t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[BORSUKIAN_CONTINUOUS_LOGARITHM_CIRCLE_CX] THEN STRIP_TAC THEN + X_GEN_TAC `g:real^N->complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g:real^N->complex) o (f:real^M->real^N)`) THEN + ASM_SIMP_TAC[IMAGE_o; CONTINUOUS_ON_COMPOSE; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!y. ?x. y IN t ==> x IN s /\ (f:real^M->real^N) x = y /\ + (!x'. x' IN s /\ f x' = y ==> h x <= h x')` + MP_TAC THENL + [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{ h x:real | x IN s /\ (f:real^M->real^N) x = y}` + COMPACT_ATTAINS_INF) THEN + REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM CONJ_ASSOC] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[GSYM IMAGE_o] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + ONCE_REWRITE_TAC[SET_RULE `x = y <=> x IN {y}`] THEN + MATCH_MP_TAC PROPER_MAP_FROM_COMPACT THEN + ASM_REWRITE_TAC[CLOSED_IN_SING; SUBSET_REFL]]; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `k:real^N->real^M` THEN DISCH_TAC THEN + EXISTS_TAC `(h:real^M->real) o (k:real^N->real^M)` THEN + REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[continuous_on] THEN X_GEN_TAC `y:real^N` THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`Cx o (h:real^M->real)`; `s:real^M->bool`] + COMPACT_UNIFORMLY_CONTINUOUS) THEN + ASM_REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[o_THM; DIST_CX] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\y. {x | x IN s /\ (f:real^M->real^N) x = y}`; + `s:real^M->bool`; `t:real^N->bool`] + UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN + ASM_SIMP_TAC[GSYM CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE; + GSYM OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE; + SUBSET_REFL; SUBSET_RESTRICT] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `d:real`]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [MATCH_MP_TAC COMPACT_IMP_BOUNDED; ASM SET_TAC[]] THEN + MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_REWRITE_TAC[SET_RULE `x IN s /\ f x = y <=> x IN s /\ f x IN {y}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[CLOSED_IN_SING; SUBSET_REFL]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `y':real^N` THEN STRIP_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y':real^N`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `(k:real^N->real^M) y`) + (MP_TAC o SPEC `(k:real^N->real^M) y'`)) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `w':real^M` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `y':real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `w':real^M`) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`w:real^M`; `(k:real^N->real^M) y'`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`w':real^M`; `(k:real^N->real^M) y`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Unicoherence (closed). *) +(* ------------------------------------------------------------------------- *) + +let unicoherent = new_definition + `unicoherent(u:real^N->bool) <=> + !s t. connected s /\ connected t /\ s UNION t = u /\ + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t + ==> connected (s INTER t)`;; + +let HOMEOMORPHIC_UNICOHERENT = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ unicoherent s ==> unicoherent t`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + STRIP_TAC THEN REWRITE_TAC[unicoherent] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `u INTER v = IMAGE (f:real^M->real^N) + (IMAGE (g:real^N->real^M) u INTER IMAGE g v)` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> r /\ (p /\ q) /\ s`] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + CONJ_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `t:real^N->bool`] THEN + ASM_REWRITE_TAC[homeomorphism]]);; + +let HOMEOMORPHIC_UNICOHERENT_EQ = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> (unicoherent s <=> unicoherent t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_UNICOHERENT) THEN + ASM_MESON_TAC[HOMEOMORPHIC_SYM]);; + +let UNICOHERENT_TRANSLATION = prove + (`!a:real^N s. unicoherent (IMAGE (\x. a + x) s) <=> unicoherent s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; + +add_translation_invariants [UNICOHERENT_TRANSLATION];; + +let UNICOHERENT_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (unicoherent(IMAGE f s) <=> unicoherent s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_UNICOHERENT_EQ THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; + HOMEOMORPHIC_REFL]);; + +add_linear_invariants [UNICOHERENT_INJECTIVE_LINEAR_IMAGE];; + +let BORSUKIAN_IMP_UNICOHERENT = prove + (`!u:real^N->bool. borsukian u ==> unicoherent u`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[unicoherent] THEN + SUBGOAL_THEN + `!f. f continuous_on u /\ IMAGE f u SUBSET sphere(vec 0,&1) + ==> ?a. homotopic_with (\h. T) + (u,(:complex) DIFF {Cx (&0)}) (f:real^N->complex) (\t. a)` + MP_TAC THENL + [FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I + [BORSUKIAN_CIRCLE]) THEN + X_GEN_TAC `f:real^N->complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:real^N->complex`) THEN + ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_SUBSET_RIGHT) THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF {a} <=> ~(a IN s)`] THEN + REWRITE_TAC[IN_SPHERE; DIST_REFL] THEN REAL_ARITH_TAC; + POP_ASSUM(K ALL_TAC)] THEN + REWRITE_TAC[sphere; DIST_0; INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN + REPEAT STRIP_TAC THEN SIMP_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean u) (v:real^N->bool) /\ + closed_in (subtopology euclidean u) (w:real^N->bool)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_INTER; CLOSED_IN_TRANS]; ALL_TAC] THEN + MP_TAC(ISPECL + [`v:real^N->bool`; `w:real^N->bool`; `u:real^N->bool`; + `vec 0:real^1`; `vec 1:real^1`] URYSOHN_LOCAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^1` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?g:real^N->real^2. + g continuous_on u /\ IMAGE g u SUBSET {x | norm x = &1} /\ + (!x. x IN s ==> g(x) = cexp(Cx pi * ii * Cx(drop(q x)))) /\ + (!x. x IN t ==> g(x) = inv(cexp(Cx pi * ii * Cx(drop(q x)))))` + (DESTRUCT_TAC "@g. cont circle s t") THENL + [EXISTS_TAC + `\x. if (x:real^N) IN s then cexp(Cx pi * ii * Cx(drop(q x))) + else inv(cexp(Cx pi * ii * Cx(drop(q x))))` THEN + SUBGOAL_THEN + `!x:real^N. + x IN s INTER t + ==> cexp(Cx pi * ii * Cx(drop(q x))) = + inv(cexp(Cx pi * ii * Cx(drop (q x))))` + ASSUME_TAC THENL + [SUBST1_TAC(SYM(ASSUME `v UNION w:real^N->bool = s INTER t`)) THEN + REWRITE_TAC[IN_UNION] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; CEXP_0; COMPLEX_INV_1] THEN + REWRITE_TAC[COMPLEX_MUL_RID; EULER] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN + REWRITE_TAC[RE_II; IM_II; REAL_MUL_RZERO; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID; COS_PI; SIN_PI] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + SIMP_TAC[] THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "u" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[SET_RULE + `P /\ ~P \/ x IN t /\ x IN s <=> x IN s INTER t`] THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_INV THEN REWRITE_TAC[CEXP_NZ]] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_NORM_INV; NORM_CEXP] THEN + REWRITE_TAC[RE_MUL_CX; RE_MUL_II; IM_CX] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0; REAL_INV_1]; + GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + FIRST_X_ASSUM(MP_TAC o SPEC `g:real^N->complex`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `(?n. integer n /\ + !x:real^N. x IN s + ==> h(x) - Cx pi * ii * Cx (drop (q x)) = + Cx(&2 * n * pi) * ii) /\ + (?n. integer n /\ + !x:real^N. x IN t + ==> h(x) + Cx pi * ii * Cx (drop (q x)) = + Cx(&2 * n * pi) * ii)` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `m:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) + (X_CHOOSE_THEN `n:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) + THENL + [CONJ_TAC THEN MATCH_MP_TAC(MESON[] + `(?x. x IN s) /\ + (!x. x IN s ==> ?n. P n /\ f x = k n) /\ + (?a. !x. x IN s ==> f x = a) + ==> (?n. P n /\ !x. x IN s ==> f x = k n)`) THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN + (CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_RING `a + b:complex = c <=> a = --b + c`; + COMPLEX_RING `a - b:complex = c <=> a = b + c`] THEN + REWRITE_TAC[GSYM CEXP_EQ; CEXP_NEG] THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(LABEL_TAC "*") THEN + MATCH_MP_TAC CONTINUOUS_DISCRETE_RANGE_CONSTANT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [(MATCH_MP_TAC CONTINUOUS_ON_ADD ORELSE + MATCH_MP_TAC CONTINUOUS_ON_SUB) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNION]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `&2 * pi` THEN + REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REMOVE_THEN "*" (fun th -> + MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_EQ_MUL_RCANCEL; II_NZ; GSYM COMPLEX_SUB_RDISTRIB; + COMPLEX_NORM_MUL; CX_INJ; COMPLEX_NORM_II; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_EQ_MUL_LCANCEL; GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_EQ_MUL_RCANCEL; PI_NZ; REAL_ABS_PI] THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_OF_NUM_EQ; ARITH_EQ] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_ARITH + `&2 * p <= &2 * a * p <=> &0 <= &2 * p * (a - &1)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[PI_POS_LE; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN + ASM_SIMP_TAC[INTEGER_CLOSED; REAL_SUB_0]]); + ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `p ==> q ==> F <=> ~(p /\ q)`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `(!x. x IN s ==> P x) /\ (!x. x IN t ==> Q x) + ==> ~(v = {}) /\ ~(w = {}) /\ v UNION w SUBSET s INTER t + ==> ~(!y z. y IN v /\ z IN w ==> ~(P y /\ Q y /\ P z /\ Q z))`)) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING + `y + p = n /\ y - p = m /\ z + q = n /\ z - q = m ==> q:complex = p`)) THEN + REWRITE_TAC[DROP_VEC; COMPLEX_MUL_RZERO; COMPLEX_ENTIRE; CX_INJ] THEN + REWRITE_TAC[PI_NZ; II_NZ; REAL_OF_NUM_EQ; ARITH_EQ]);; + +let CONTRACTIBLE_IMP_UNICOHERENT = prove + (`!u:real^N->bool. contractible u ==> unicoherent u`, + SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONTRACTIBLE_IMP_BORSUKIAN]);; + +let CONVEX_IMP_UNICOHERENT = prove + (`!u:real^N->bool. convex u ==> unicoherent u`, + SIMP_TAC[BORSUKIAN_IMP_UNICOHERENT; CONVEX_IMP_BORSUKIAN]);; + +let UNICOHERENT_UNIV = prove + (`unicoherent(:real^N)`, + SIMP_TAC[CONVEX_IMP_UNICOHERENT; CONVEX_UNIV]);; + +let UNICOHERENT_MONOTONE_IMAGE_COMPACT = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ + unicoherent s + ==> unicoherent t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `compact(t:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPACT_CONTINUOUS_IMAGE]; REWRITE_TAC[unicoherent]] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [unicoherent]) THEN + DISCH_THEN(MP_TAC o SPECL + [`{x | x IN s /\ (f:real^M->real^N) x IN u}`; + `{x | x IN s /\ (f:real^M->real^N) x IN v}`]) THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; SUBSET_RESTRICT; + CONTINUOUS_CLOSED_PREIMAGE; CONJ_ASSOC] THEN + REWRITE_TAC[IMP_CONJ_ALT] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] + CONNECTED_CLOSED_MONOTONE_PREIMAGE) THEN + + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_IMP_CLOSED_MAP]; ALL_TAC] THEN + DISCH_TAC THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Several common variants of unicoherence for R^n. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_FRONTIER_SIMPLE = prove + (`!s. connected(s) /\ connected((:real^N) DIFF s) ==> connected(frontier s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES] THEN + MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN + REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + ASM_SIMP_TAC[CLOSED_CLOSURE; CONNECTED_CLOSURE] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET closure s /\ t SUBSET closure t /\ s UNION t = UNIV + ==> closure s UNION closure t = UNIV`) THEN + REWRITE_TAC[CLOSURE_SUBSET] THEN SET_TAC[]);; + +let CONNECTED_FRONTIER_COMPONENT_COMPLEMENT = prove + (`!s c:real^N->bool. + connected s /\ c IN components((:real^N) DIFF s) + ==> connected(frontier c)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_FRONTIER_SIMPLE THEN + CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; CONNECTED_UNIV]]);; + +let CONNECTED_FRONTIER_DISJOINT = prove + (`!s t:real^N->bool. + connected s /\ connected t /\ DISJOINT s t /\ frontier s SUBSET frontier t + ==> connected(frontier s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s = (:real^N)` THEN + ASM_REWRITE_TAC[FRONTIER_UNIV; CONNECTED_EMPTY] THEN + SUBGOAL_THEN `?c. c IN components((:real^N) DIFF s) /\ t SUBSET c` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `frontier s:real^N->bool = frontier c` SUBST1_TAC THENL + [ALL_TAC; ASM_MESON_TAC[CONNECTED_FRONTIER_COMPONENT_COMPLEMENT]] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[frontier; IN_DIFF] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o + MATCH_MP SUBSET_CLOSURE) THEN + ASM_MESON_TAC[SUBSET; frontier; IN_DIFF]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [GSYM FRONTIER_COMPLEMENT]) THEN + REWRITE_TAC[frontier] THEN + MATCH_MP_TAC(SET_RULE `u SUBSET t ==> x IN s DIFF t ==> ~(x IN u)`) THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN + ASM_MESON_TAC[IN_COMPONENTS_SUBSET]]; + GEN_REWRITE_TAC RAND_CONV [GSYM FRONTIER_COMPLEMENT] THEN + ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET]]);; + +let SEPARATION_BY_COMPONENT_CLOSED_POINTWISE = prove + (`!s a b. closed s /\ ~connected_component ((:real^N) DIFF s) a b + ==> ?c. c IN components s /\ + ~connected_component((:real^N) DIFF c) a b`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL + [EXISTS_TAC `connected_component s (a:real^N)` THEN + ASM_REWRITE_TAC[IN_COMPONENTS] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN + REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]; + ALL_TAC] THEN + ASM_CASES_TAC `(b:real^N) IN s` THENL + [EXISTS_TAC `connected_component s (b:real^N)` THEN + ASM_REWRITE_TAC[IN_COMPONENTS] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN + REWRITE_TAC[IN_UNIV; IN_DIFF] THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IRREDUCIBLE_SEPARATOR) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?c:real^N->bool. c IN components s /\ t SUBSET c` MP_TAC THENL + [MATCH_MP_TAC EXISTS_COMPONENT_SUPERSET THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(t b) ==> s SUBSET t ==> ~(s b)`)) THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN + ASM SET_TAC[]] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`connected_component ((:real^N) DIFF t) a`; + `connected_component ((:real^N) DIFF t) b`] + CONNECTED_FRONTIER_DISJOINT) THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_DISJOINT] THEN + ASM_REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN + SUBGOAL_THEN + `frontier(connected_component ((:real^N) DIFF t) a) = t /\ + frontier(connected_component ((:real^N) DIFF t) b) = t` + (fun th -> ASM_REWRITE_TAC[th; SUBSET_REFL]) THEN + CONJ_TAC THEN MATCH_MP_TAC FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE THENL + [EXISTS_TAC `b:real^N`; EXISTS_TAC `a:real^N`] THEN + ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN + ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; + +let SEPARATION_BY_COMPONENT_CLOSED = prove + (`!s. closed s /\ ~connected((:real^N) DIFF s) + ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`, + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNIV] THEN + MP_TAC SEPARATION_BY_COMPONENT_CLOSED_POINTWISE THEN + MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[REWRITE_RULE[SUBSET] IN_COMPONENTS_SUBSET]);; + +let SEPARATION_BY_UNION_CLOSED_POINTWISE = prove + (`!s t a b. closed s /\ closed t /\ DISJOINT s t /\ + connected_component ((:real^N) DIFF s) a b /\ + connected_component ((:real^N) DIFF t) a b + ==> connected_component ((:real^N) DIFF (s UNION t)) a b`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN (fun th -> + ASSUME_TAC th THEN MP_TAC(MATCH_MP CONNECTED_COMPONENT_IN th))) THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] SEPARATION_BY_COMPONENT_CLOSED_POINTWISE)) THEN + ASM_SIMP_TAC[CLOSED_UNION; NOT_EXISTS_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `(c:real^N->bool) SUBSET s \/ c SUBSET t` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN + REWRITE_TAC[CONNECTED_CLOSED; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + UNDISCH_TAC `connected_component ((:real^N) DIFF s) a b`; + UNDISCH_TAC `connected_component ((:real^N) DIFF t) a b`] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s b ==> t b`) THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN + ASM SET_TAC[]);; + +let SEPARATION_BY_UNION_CLOSED = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ DISJOINT s t /\ + connected((:real^N) DIFF s) /\ + connected((:real^N) DIFF t) + ==> connected((:real^N) DIFF (s UNION t))`, + SIMP_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IN_DIFF; IN_UNION; IN_UNIV] THEN + MESON_TAC[SEPARATION_BY_UNION_CLOSED_POINTWISE]);; + +let OPEN_UNICOHERENT_UNIV = prove + (`!s t. open s /\ open t /\ connected s /\ connected t /\ + s UNION t = (:real^N) + ==> connected(s INTER t)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `s INTER t = UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t))`] THEN + MATCH_MP_TAC SEPARATION_BY_UNION_CLOSED THEN + ASM_SIMP_TAC[GSYM OPEN_CLOSED; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + ASM SET_TAC[]);; + +let SEPARATION_BY_COMPONENT_OPEN = prove + (`!s. open s /\ ~connected((:real^N) DIFF s) + ==> ?c. c IN components s /\ ~connected((:real^N) DIFF c)`, + let lemma = prove + (`!s t u. closed s /\ closed t /\ s INTER t = {} /\ + connected u /\ ~(u INTER s = {}) /\ ~(u INTER t = {}) + ==> ?c. c IN components((:real^N) DIFF (s UNION t)) /\ + ~(c INTER u = {}) /\ + ~(frontier c INTER s = {}) /\ + ~(frontier c INTER t = {})`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[MESON[] + `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED]) THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`s UNION + UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\ + frontier c SUBSET s}`; + `t UNION + UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\ + frontier c SUBSET t}`] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL + [REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s SUBSET t UNION u`) THEN + MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) + (SPEC_ALL FRONTIER_UNION_SUBSET)) THEN + ASM_REWRITE_TAC[UNION_SUBSET; FRONTIER_SUBSET_EQ] THEN + MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) + (SPEC_ALL FRONTIER_UNIONS_SUBSET_CLOSURE)) THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[UNIONS_SUBSET] THEN + SIMP_TAC[FORALL_IN_GSPEC]; + ALL_TAC]) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `(s UNION t) UNION + UNIONS {c | c IN components((:real^N) DIFF (s UNION t)) /\ + ~(c INTER u = {})}` THEN + CONJ_TAC THENL + [MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` UNIONS_COMPONENTS) THEN + SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `c SUBSET d UNION e + ==> (s UNION t) UNION c SUBSET (s UNION d) UNION (t UNION e)`) THEN + REWRITE_TAC[GSYM UNIONS_UNION] THEN MATCH_MP_TAC SUBSET_UNIONS THEN + ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[DE_MORGAN_THM] THEN + MATCH_MP_TAC(SET_RULE + `c SUBSET s UNION t + ==> c INTER s = {} \/ c INTER t = {} + ==> c SUBSET s \/ c SUBSET t`) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN + REWRITE_TAC[FRONTIER_COMPLEMENT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN + ASM_SIMP_TAC[FRONTIER_SUBSET_EQ; CLOSED_UNION]]; + MATCH_MP_TAC(SET_RULE + `c UNION d SUBSET UNIV DIFF (s UNION t) /\ s INTER t = {} /\ DISJOINT c d + ==> (s UNION c) INTER (t UNION d) INTER u = {}`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM UNIONS_UNION] THEN + GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN + MATCH_MP_TAC SUBSET_UNIONS THEN SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `(!s. s IN c ==> !t. t IN c' ==> s INTER t = {}) + ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MP_TAC(ISPEC `(:real^N) DIFF (s UNION t)` COMPONENTS_NONOVERLAP) THEN + SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `c':real^N->bool` THEN + ASM_CASES_TAC `c':real^N->bool = c` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `c SUBSET s ==> s INTER t = {} /\ ~(c = {}) ==> ~(c SUBSET t)`)) THEN + ASM_REWRITE_TAC[FRONTIER_EQ_EMPTY] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + ASM SET_TAC[]]; + ASM SET_TAC[]; + ASM SET_TAC[]]) in + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[CONNECTED_CLOSED_SET; GSYM OPEN_CLOSED; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`t:real^N->bool`; `u:real^N->bool`; `(:real^N)`] + lemma) THEN + ASM_REWRITE_TAC[CONNECTED_UNIV; SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MP_TAC(ISPEC `c:real^N->bool` CONNECTED_FRONTIER_SIMPLE) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONNECTED_CLOSED] THEN + MAP_EVERY EXISTS_TAC [`t:real^N->bool`; `u:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FRONTIER_OF_COMPONENTS_SUBSET) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN + ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN + ASM_REWRITE_TAC[FRONTIER_SUBSET_EQ; GSYM OPEN_CLOSED]);; + +let SEPARATION_BY_UNION_OPEN = prove + (`!s t:real^N->bool. + open s /\ open t /\ DISJOINT s t /\ + connected((:real^N) DIFF s) /\ + connected((:real^N) DIFF t) + ==> connected((:real^N) DIFF (s UNION t))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`] THEN + MATCH_MP_TAC(REWRITE_RULE[unicoherent] UNICOHERENT_UNIV) THEN + REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; + +let CONNECTED_INTER_DISJOINT_OPEN_FRONTIERS = prove + (`!s t:real^N->bool. + open s /\ connected s /\ open t /\ connected t /\ + DISJOINT (frontier s) (frontier t) + ==> connected(s INTER t)`, + let lemma = prove + (`~(f = {}) ==> s UNION UNIONS f = UNIONS {s UNION c | c IN f}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]) in + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[INTER_EMPTY; CONNECTED_EMPTY] THEN + MAP_EVERY ASM_CASES_TAC [`s = (:real^N)`; `t = (:real^N)`] THEN + ASM_REWRITE_TAC[INTER_UNIV; CONNECTED_UNIV] THEN + ASM_CASES_TAC `s INTER t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN + MP_TAC(ISPECL + [`s UNION UNIONS {c | c IN components((:real^N) DIFF closure t) /\ + ~(c INTER s = {})}`; + `t UNION UNIONS {c | c IN components((:real^N) DIFF closure s) /\ + ~(c INTER t = {})}`] + OPEN_UNICOHERENT_UNIV) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN + MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; + MATCH_MP_TAC OPEN_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[IN_ELIM_THM] THEN + MESON_TAC[OPEN_COMPONENTS; closed; CLOSED_CLOSURE]; + MATCH_MP_TAC(MESON[] + `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s)) + ==> connected(u UNION UNIONS s)`) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN + ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN + REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION]; + MATCH_MP_TAC(MESON[] + `(s = {} \/ ~(s = {}) ==> connected(u UNION UNIONS s)) + ==> connected(u UNION UNIONS s)`) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[UNION_EMPTY; UNIONS_0] THEN + ASM_SIMP_TAC[lemma] THEN MATCH_MP_TAC CONNECTED_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONNECTED_UNION; IN_COMPONENTS_CONNECTED; UNION_COMM]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ ~(s = {}) ==> ~(t = {})`) THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_INTERS] THEN + REWRITE_TAC[FORALL_IN_GSPEC; SUBSET_UNION]; + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_UNION; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(x:real^N) IN t` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o MATCH_MP (SET_RULE + `DISJOINT s t ==> !x. ~(x IN s) \/ ~(x IN t)`)) THEN + ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN STRIP_TAC THENL + [SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))` + MP_TAC THENL + [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; + closed; CLOSED_CLOSURE]; + ALL_TAC] THEN + SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))` + MP_TAC THENL + [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; + closed; CLOSED_CLOSURE]; + ALL_TAC]; + SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure t))` + MP_TAC THENL + [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `d INTER s:real^N->bool = {}` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `d INTER closure(s:real^N->bool) = {}` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; + closed; CLOSED_CLOSURE]; + ALL_TAC] THEN + SUBGOAL_THEN `x IN UNIONS(components((:real^N) DIFF closure s))` + MP_TAC THENL + [ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; IN_DIFF; IN_UNIV] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `c INTER t:real^N->bool = {}` THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `c INTER closure(t:real^N->bool) = {}` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_COMPONENTS; + closed; CLOSED_CLOSURE]; + ALL_TAC]] THEN + (FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `DISJOINT s t ==> !c d. ~(c = {}) /\ c SUBSET s /\ d SUBSET t /\ c = d + ==> p`)) THEN + MAP_EVERY EXISTS_TAC + [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[FRONTIER_EQ_EMPTY; DE_MORGAN_THM] THEN + ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_SUBSET; + SET_RULE `s SUBSET UNIV DIFF t /\ s = UNIV ==> t = {}`; + CLOSURE_EQ_EMPTY]; + ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT; + FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; + ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT; + FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; + AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + MATCH_MP_TAC COMPONENTS_MAXIMAL THENL + [EXISTS_TAC `(:real^N) DIFF closure t`; + EXISTS_TAC `(:real^N) DIFF closure s`] THEN + ASM_REWRITE_TAC[] THEN + (CONJ_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ASM SET_TAC[]])])]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `s INTER t' = {} /\ t INTER s' = {} /\ s' INTER t' = {} + ==> (s UNION s') INTER (t UNION t') = s INTER t`) THEN + REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC; + UNIONS_SUBSET] THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `d:real^N->bool` THENL + [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + MP_TAC(ISPECL [`(:real^N) DIFF closure s`; `d:real^N->bool`] + IN_COMPONENTS_SUBSET) THEN + SET_TAC[]; + MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN + MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `d:real^N->bool`] + IN_COMPONENTS_SUBSET) THEN + SET_TAC[]; + STRIP_TAC THEN X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC] THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `DISJOINT s t + ==> !c d. c SUBSET s /\ d SUBSET t /\ ~(c INTER d = {}) ==> F`)) THEN + MAP_EVERY EXISTS_TAC + [`frontier c:real^N->bool`; `frontier d:real^N->bool`] THEN + REPEAT(CONJ_TAC THENL + [ASM_MESON_TAC[FRONTIER_OF_COMPONENTS_SUBSET;FRONTIER_COMPLEMENT; + FRONTIER_CLOSURE_SUBSET; SUBSET_TRANS]; ALL_TAC]) THEN + MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_FRONTIER_COMPONENT_COMPLEMENT THEN + EXISTS_TAC `closure s:real^N->bool` THEN + ASM_MESON_TAC[CONNECTED_CLOSURE]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `c DIFF d = c INTER (UNIV DIFF d)`] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN CONJ_TAC THEN + MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ALL_TAC; + MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN + EXISTS_TAC `closure t:real^N->bool` THEN + ASM_SIMP_TAC[CONNECTED_UNIV; SUBSET_UNIV; CONNECTED_CLOSURE]; + ALL_TAC; + ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; + +let NONSEPARATION_BY_COMPONENT_EQ = prove + (`!s. (open s \/ closed s) + ==> ((!c. c IN components s ==> connected((:real^N) DIFF c)) <=> + connected((:real^N) DIFF s))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[SEPARATION_BY_COMPONENT_OPEN]; + ALL_TAC; + ASM_MESON_TAC[SEPARATION_BY_COMPONENT_CLOSED]; + ALL_TAC] THEN + MATCH_MP_TAC COMPONENT_COMPLEMENT_CONNECTED THEN + EXISTS_TAC `(:real^N) DIFF s` THEN + ASM_REWRITE_TAC[CONNECTED_UNIV; SUBSET_UNIV; + SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]);; + +(* ------------------------------------------------------------------------- *) +(* Another interesting equivalent of an inessential mapping into C-{0} *) +(* ------------------------------------------------------------------------- *) + +let INESSENTIAL_EQ_EXTENSIBLE = prove + (`!f s. + closed s + ==> ((?a. homotopic_with (\h. T) (s,(:complex) DIFF {Cx(&0)}) f (\t. a)) <=> + (?g. g continuous_on (:real^N) /\ + (!x. x IN s ==> g x = f x) /\ (!x. ~(g x = Cx(&0)))))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `a:complex`) THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `\x:real^N. Cx(&1)` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; NOT_IN_EMPTY] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + FIRST_ASSUM(MP_TAC o + SPEC `(:real^N)` o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ_ALT] + (REWRITE_RULE[CONJ_ASSOC] BORSUK_HOMOTOPY_EXTENSION)) o + GEN_REWRITE_RULE I [HOMOTOPIC_WITH_SYM]) THEN + ASM_REWRITE_TAC[GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN + SIMP_TAC[OPEN_IMP_ANR; OPEN_DIFF; OPEN_UNIV; CLOSED_SING] THEN + ASM_SIMP_TAC[CLOSED_UNIV; CONTINUOUS_ON_CONST] THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM] THEN + MP_TAC(ISPECL [`vec 0:real^N`; `&1`] HOMEOMORPHIC_BALL_UNIV) THEN + REWRITE_TAC[REAL_LT_01; homeomorphic; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN + REWRITE_TAC[homeomorphism; IN_UNIV] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(g:real^N->complex) o (h:real^N->real^N)`; + `vec 0:real^N`; `&1`] CONTINUOUS_LOGARITHM_ON_BALL) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `j:real^N->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(j:real^N->complex) o (k:real^N->real^N)` THEN + ASM_SIMP_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Another simple case where sphere maps are nullhomotopic. *) +(* ------------------------------------------------------------------------- *) + +let INESSENTIAL_SPHEREMAP_2 = prove + (`!f:real^M->real^N a r b s. + 2 < dimindex(:M) /\ dimindex(:N) = 2 /\ + f continuous_on sphere(a,r) /\ + IMAGE f (sphere(a,r)) SUBSET (sphere(b,s)) + ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(b,s)) f (\x. c)`, + let lemma = prove + (`!f:real^N->real^2 a r. + 2 < dimindex(:N) /\ + f continuous_on sphere(a,r) /\ + IMAGE f (sphere(a,r)) SUBSET (sphere(vec 0,&1)) + ==> ?c. homotopic_with (\z. T) (sphere(a,r),sphere(vec 0,&1)) + f (\x. c)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN + MP_TAC(ISPECL [`f:real^N->real^2`; `sphere(a:real^N,r)`] + CONTINUOUS_LOGARITHM_ON_SIMPLY_CONNECTED) THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_SPHERE_EQ; LOCALLY_PATH_CONNECTED_SPHERE] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[ARITH_RULE `3 <= n <=> 2 < n`] THEN FIRST_X_ASSUM + (MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE f s SUBSET t ==> (!x. P x ==> ~(x IN t)) + ==> !x. x IN s ==> ~P(f x)`)) THEN + SIMP_TAC[COMPLEX_NORM_0; IN_SPHERE_0] THEN REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^2` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Im o (g:real^N->real^2)` THEN CONJ_TAC THENL + [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CX_IM]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_SIMP_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF; COMPLEX_EQ; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_SIMP_TAC[IN_SPHERE_0; NORM_CEXP; REAL_EXP_EQ_1] THEN + REAL_ARITH_TAC]]) + and hslemma = prove + (`!a:real^M r b:real^N s. + dimindex(:M) = dimindex(:N) /\ &0 < r /\ &0 < s + ==> (sphere(a,r) homeomorphic sphere(b,s))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> + let t = `?a:real^M b:real^N. ~(sphere(a,r) homeomorphic sphere(b,s))` in + MP_TAC(DISCH t (GEOM_EQUAL_DIMENSION_RULE th (ASSUME t)))) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES] THEN MESON_TAC[]) in + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s <= &0` THEN + ASM_SIMP_TAC[NULLHOMOTOPIC_INTO_CONTRACTIBLE; CONTRACTIBLE_SPHERE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN + SUBGOAL_THEN + `(sphere(b:real^N,s)) homeomorphic (sphere(vec 0:real^2,&1))` + MP_TAC THENL + [ASM_SIMP_TAC[hslemma; REAL_LT_01; DIMINDEX_2]; + REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^2`; `k:real^2->real^N`] THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`(h:real^N->real^2) o (f:real^M->real^N)`; + `a:real^M`; `r:real`] lemma) THEN + ASM_REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL + [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + DISCH_THEN(X_CHOOSE_THEN `c:real^2` (fun th -> + EXISTS_TAC `(k:real^2->real^N) c` THEN MP_TAC th)) THEN + DISCH_THEN(MP_TAC o ISPEC `k:real^2->real^N` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN + DISCH_THEN(MP_TAC o SPEC `sphere(b:real^N,s)`) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Janiszewski's theorem. *) +(* ------------------------------------------------------------------------- *) + +let JANISZEWSKI = prove + (`!s t a b:real^2. + compact s /\ closed t /\ connected(s INTER t) /\ + connected_component ((:real^2) DIFF s) a b /\ + connected_component ((:real^2) DIFF t) a b + ==> connected_component ((:real^2) DIFF (s UNION t)) a b`, + let lemma = prove + (`!s t a b:real^2. + compact s /\ compact t /\ connected(s INTER t) /\ + connected_component ((:real^2) DIFF s) a b /\ + connected_component ((:real^2) DIFF t) a b + ==> connected_component ((:real^2) DIFF (s UNION t)) a b`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN)) THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM BORSUK_MAPS_HOMOTOPIC_IN_CONNECTED_COMPONENT_EQ; + DIMINDEX_2; LE_REFL; COMPACT_UNION; IN_UNION] THEN + ONCE_REWRITE_TAC[HOMOTOPIC_CIRCLEMAPS_DIV] THEN + REWRITE_TAC[INESSENTIAL_EQ_CONTINUOUS_LOGARITHM_CIRCLE] THEN + ASM_SIMP_TAC[BORSUK_MAP_INTO_SPHERE; CONTINUOUS_ON_BORSUK_MAP; + IN_UNION] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `g:real^2->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `h:real^2->real` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) (t:real^2->bool)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL + [EXISTS_TAC `s:real^2->bool`; EXISTS_TAC `t:real^2->bool`] THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `s INTER t:real^2->bool = {}` THENL + [EXISTS_TAC `(\x. if x IN s then g x else h x):real^2->real` THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[o_DEF; COND_RAND] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[GSYM o_DEF] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x:real^2. lift(g x) - lift(h x)`; `s INTER t:real^2->bool`] + CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[GSYM CONTINUOUS_ON_CX_LIFT] THEN + REWRITE_TAC[GSYM o_DEF] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; INTER_SUBSET]; + REWRITE_TAC[o_DEF]] THEN + X_GEN_TAC `x:real^2` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + EXISTS_TAC `&2 * pi` THEN + REWRITE_TAC[REAL_ARITH `&0 < &2 * x <=> &0 < x`; PI_POS] THEN + X_GEN_TAC `y:real^2` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LE] THEN + REWRITE_TAC[GSYM LIFT_SUB; LIFT_EQ; NORM_LIFT] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_RING `a - b:real = c - d <=> a - c = b - d`] THEN + REWRITE_TAC[GSYM CX_INJ] THEN + MATCH_MP_TAC(COMPLEX_RING `ii * w = ii * z ==> w = z`) THEN + MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL + [REWRITE_TAC[IM_MUL_II; RE_CX] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[CX_SUB; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN + ASM_MESON_TAC[]]; + REWRITE_TAC[EXISTS_LIFT; GSYM LIFT_SUB; LIFT_EQ; IN_INTER] THEN + REWRITE_TAC[REAL_EQ_SUB_RADD; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN + EXISTS_TAC `(\x. if x IN s then g x else z + h x):real^2->real` THEN + CONJ_TAC THENL + [REWRITE_TAC[o_DEF; COND_RAND] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_SIMP_TAC[TAUT `~(p /\ ~p)`; CX_ADD; GSYM o_DEF] THEN + REWRITE_TAC[o_DEF; CX_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; GSYM o_DEF]; + X_GEN_TAC `x:real^2` THEN REWRITE_TAC[] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?w:real^2. cexp(ii * Cx(h w)) = cexp (ii * Cx(z + h w))` + (CHOOSE_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + REWRITE_TAC[COMPLEX_FIELD `a = b * a <=> a = Cx(&0) \/ b = Cx(&1)`; + CEXP_NZ]]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c:real^2->bool. + compact c /\ connected c /\ a IN c /\ b IN c /\ c INTER t = {}` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `path_component((:real^2) DIFF t) a b` MP_TAC THENL + [ASM_MESON_TAC[OPEN_PATH_CONNECTED_COMPONENT; closed; COMPACT_IMP_CLOSED]; + REWRITE_TAC[path_component; SET_RULE + `s SUBSET UNIV DIFF t <=> s INTER t = {}`]] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `path_image(g:real^1->real^2)` THEN + ASM_SIMP_TAC[CONNECTED_PATH_IMAGE; COMPACT_PATH_IMAGE] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`c UNION s:real^2->bool`; `vec 0:real^2`] + BOUNDED_SUBSET_BALL) THEN + ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^2->bool`; + `(t INTER cball(vec 0,r)) UNION sphere(vec 0:real^2,r)`; + `a:real^2`; `b:real^2`] lemma) THEN + ASM_SIMP_TAC[COMPACT_UNION; CLOSED_INTER_COMPACT; + COMPACT_SPHERE; COMPACT_CBALL] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [UNDISCH_TAC `connected(s INTER t:real^2->bool)` THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC; + REWRITE_TAC[connected_component] THEN EXISTS_TAC `c:real^2->bool`] THEN + MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] CBALL_DIFF_SPHERE) THEN + ASM SET_TAC[]; + REWRITE_TAC[connected_component] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `u:real^2->bool` THEN + SIMP_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`u:real^2->bool`; `cball(vec 0:real^2,r)`] CONNECTED_INTER_FRONTIER) THEN + ASM_REWRITE_TAC[FRONTIER_CBALL] THEN + MP_TAC(ISPECL [`vec 0:real^2`; `r:real`] BALL_SUBSET_CBALL) THEN + ASM SET_TAC[]]);; + +let JANISZEWSKI_GEN = prove + (`!s t a b:real^N. + dimindex(:N) <= 2 /\ + compact s /\ closed t /\ connected(s INTER t) /\ + connected_component ((:real^N) DIFF s) a b /\ + connected_component ((:real^N) DIFF t) a b + ==> connected_component ((:real^N) DIFF (s UNION t)) a b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [ASM_SIMP_TAC[CONNECTED_COMPONENT_1_GEN] THEN SET_TAC[]; + ASM_SIMP_TAC[ARITH_RULE `1 <= n /\ ~(n = 1) ==> (n <= 2 <=> n = 2)`; + DIMINDEX_GE_1] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[GSYM DIMINDEX_2] THEN + DISCH_THEN(fun th -> + MATCH_ACCEPT_TAC(GEOM_EQUAL_DIMENSION_RULE th JANISZEWSKI))]);; + +let JANISZEWSKI_CONNECTED = prove + (`!s t:real^2->bool. + compact s /\ closed t /\ connected(s INTER t) /\ + connected ((:real^2) DIFF s) /\ connected ((:real^2) DIFF t) + ==> connected((:real^2) DIFF (s UNION t))`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_UNION] THEN + ASM_MESON_TAC[JANISZEWSKI]);; + +let JANISZEWSKI_DUAL = prove + (`!s t:real^2->bool. + compact s /\ compact t /\ connected s /\ connected t /\ + connected((:real^2) DIFF (s UNION t)) + ==> connected(s INTER t)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s UNION t:real^2->bool` BORSUKIAN_IMP_UNICOHERENT) THEN + ASM_SIMP_TAC[BORSUKIAN_SEPARATION_COMPACT; COMPACT_UNION; unicoherent] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The Jordan Curve theorem. *) +(* ------------------------------------------------------------------------- *) + +let JORDAN_CURVE_THEOREM = prove + (`!c:real^1->real^2. + simple_path c /\ pathfinish c = pathstart c + ==> ?ins out. + ~(ins = {}) /\ open ins /\ connected ins /\ + ~(out = {}) /\ open out /\ connected out /\ + bounded ins /\ ~bounded out /\ + ins INTER out = {} /\ + ins UNION out = (:real^2) DIFF path_image c /\ + frontier ins = path_image c /\ + frontier out = path_image c`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `path_image(c:real^1->real^2) homeomorphic sphere(vec 0:real^2,&1)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE; REAL_LT_01]; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SIMPLE_PATH_IMP_PATH) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP COMPACT_PATH_IMAGE) THEN + ABBREV_TAC `s:real^2->bool = path_image c`] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + JORDAN_BROUWER_SEPARATION)) THEN + REWRITE_TAC[REAL_LT_01] THEN DISCH_TAC THEN + MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_UNBOUNDED_COMPONENTS) THEN + MP_TAC(ISPEC `(:real^2) DIFF s` COBOUNDED_HAS_BOUNDED_COMPONENT) THEN + ASM_SIMP_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COMPACT_IMP_BOUNDED; + DIMINDEX_2; LE_REFL; IMP_IMP] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `ins:real^2->bool` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `out:real^2->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPLICATE_TAC 5 (GEN_REWRITE_TAC I [CONJ_ASSOC]) THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED; + OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED]; + STRIP_TAC] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[COMPONENTS_EQ]; DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN + REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[]; + STRIP_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [UNIONS_COMPONENTS] THEN + REWRITE_TAC[GSYM UNIONS_2] THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `a IN s /\ b IN s /\ (!c. c IN s /\ ~(c = a) /\ ~(c = b) ==> F) + ==> {a,b} = s`) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `mid:real^2->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `frontier mid:real^2->bool = s` ASSUME_TAC THENL + [MATCH_MP_TAC JORDAN_BROUWER_FRONTIER THEN + REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `open(mid:real^2->bool) /\ connected mid /\ ~(mid = {})` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED; + OPEN_COMPONENTS; closed; COMPACT_IMP_CLOSED]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a b:real^2. + a IN s /\ b IN s /\ ~(a = b) /\ + ?g. arc g /\ pathstart g = a /\ pathfinish g = b /\ + path_image g DIFF {a,b} SUBSET mid` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `?a b:real^2. a IN s /\ b IN s /\ ~(a = b)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!c. s SUBSET {c} ==> F) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`) THEN + ASM_MESON_TAC[INFINITE_SIMPLE_PATH_IMAGE; INFINITE; FINITE_SING; + FINITE_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`mid:real^2->bool`; `s INTER ball(a:real^2,dist(a,b))`; + `s INTER ball(b:real^2,dist(a,b))`] + DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN ANTS_TAC THENL + [SUBGOAL_THEN + `a IN ball(a:real^2,dist(a,b)) /\ b IN ball(b,dist(a,b)) /\ + ~(a IN ball(b,dist(a,b))) /\ ~(b IN ball(a,dist(a,b)))` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_REWRITE_TAC[IN_BALL; DIST_REFL; GSYM DIST_NZ] THEN + REWRITE_TAC[DIST_SYM] THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `g:real^1->real^2` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`pathstart g:real^2`; `pathfinish g:real^2`] THEN + ASM_SIMP_TAC[ARC_DISTINCT_ENDS] THEN EXISTS_TAC `g:real^1->real^2` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path_image; pathstart; pathfinish] THEN + SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`c:real^1->real^2`; `a:real^2`; `b:real^2`] + EXISTS_DOUBLE_ARC) THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^1->real^2`; `d:real^1->real^2`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?x:real^2 y:real^2. x IN ins /\ y IN out` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`(path_image u UNION path_image g):real^2->bool`; + `(path_image d UNION path_image g):real^2->bool`; + `x:real^2`; `y:real^2`] JANISZEWSKI) THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [COMPACT_UNION; COMPACT_IMP_CLOSED; COMPACT_PATH_IMAGE; + ARC_IMP_PATH; NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(path_image u UNION path_image g) INTER + (path_image d UNION path_image g) = path_image(g:real^1->real^2)` + (fun th -> ASM_SIMP_TAC[CONNECTED_ARC_IMAGE; th]) THEN + MATCH_MP_TAC(SET_RULE + `u INTER d SUBSET s ==> (u UNION s) INTER (d UNION s) = s`) THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; + ARC_IMP_PATH]; + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `ins UNION out UNION (s DIFF path_image u):real^2->bool` THEN + ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = + (s UNION u) UNION (t UNION u)`] THEN + MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `ins:real^2->bool` THEN + ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `out:real^2->bool` THEN + ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN + ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN + SUBGOAL_THEN `~(path_image d SUBSET {a:real^2,b})` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + FINITE_SUBSET)) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]]; + SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\ + (mid:real^2->bool) INTER out = {}` + MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN + ASM SET_TAC[]]; + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `ins UNION out UNION (s DIFF path_image d):real^2->bool` THEN + ASM_REWRITE_TAC[IN_UNION] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = + (s UNION u) UNION (t UNION u)`] THEN + MATCH_MP_TAC CONNECTED_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `ins:real^2->bool` THEN + ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `out:real^2->bool` THEN + ASM_SIMP_TAC[UNION_SUBSET; CLOSURE_UNION_FRONTIER; SUBSET_UNION] THEN + ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `~(u = {}) ==> ~((s UNION u) INTER (t UNION u) = {})`) THEN + SUBGOAL_THEN `~(path_image u SUBSET {a:real^2,b})` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + FINITE_SUBSET)) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + ASM_SIMP_TAC[INFINITE_ARC_IMAGE; GSYM INFINITE]]; + SUBGOAL_THEN `ins INTER out = {} /\ ins INTER mid = {} /\ + (mid:real^2->bool) INTER out = {}` + MP_TAC THENL [ASM_MESON_TAC[COMPONENTS_NONOVERLAP]; ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_SUBSET)) THEN + ASM SET_TAC[]]; + SUBGOAL_THEN `~(connected_component ((:real^2) DIFF s) x y)` MP_TAC THENL + [REWRITE_TAC[connected_component] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^2->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(:real^2) DIFF s`; `t:real^2->bool`] + COMPONENTS_MAXIMAL) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `ins:real^2->bool` th) THEN + MP_TAC(SPEC `out:real^2->bool` th)) THEN ASM SET_TAC[]; + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s y ==> t y`) THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN + ASM SET_TAC[]]]);; + +let JORDAN_DISCONNECTED = prove + (`!c. simple_path c /\ pathfinish c = pathstart c + ==> ~connected((:real^2) DIFF path_image c)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[connected] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let JORDAN_INSIDE_OUTSIDE = prove + (`!c:real^1->real^2. + simple_path c /\ pathfinish c = pathstart c + ==> ~(inside(path_image c) = {}) /\ + open(inside(path_image c)) /\ + connected(inside(path_image c)) /\ + ~(outside(path_image c) = {}) /\ + open(outside(path_image c)) /\ + connected(outside(path_image c)) /\ + bounded(inside(path_image c)) /\ + ~bounded(outside(path_image c)) /\ + inside(path_image c) INTER outside(path_image c) = {} /\ + inside(path_image c) UNION outside(path_image c) = + (:real^2) DIFF path_image c /\ + frontier(inside(path_image c)) = path_image c /\ + frontier(outside(path_image c)) = path_image c`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP JORDAN_CURVE_THEOREM) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`ins:real^2->bool`; `out:real^2->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `inside(path_image c) :real^2->bool = ins /\ + outside(path_image c):real^2->bool = out ` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC INSIDE_OUTSIDE_UNIQUE THEN ASM_SIMP_TAC[JORDAN_DISCONNECTED]);; + +(* ------------------------------------------------------------------------- *) +(* Triple-curve or "theta-curve" theorem. Proof that there is no fourth *) +(* component taken from Kuratowski's Topology vol 2, para 61, II. *) +(* ------------------------------------------------------------------------- *) + +let SPLIT_INSIDE_SIMPLE_CLOSED_CURVE = prove + (`!c1 c2 c a b:real^2. + ~(a = b) /\ + simple_path c1 /\ pathstart c1 = a /\ pathfinish c1 = b /\ + simple_path c2 /\ pathstart c2 = a /\ pathfinish c2 = b /\ + simple_path c /\ pathstart c = a /\ pathfinish c = b /\ + path_image c1 INTER path_image c2 = {a,b} /\ + path_image c1 INTER path_image c = {a,b} /\ + path_image c2 INTER path_image c = {a,b} /\ + ~(path_image c INTER inside(path_image c1 UNION path_image c2) = {}) + ==> inside(path_image c1 UNION path_image c) INTER + inside(path_image c2 UNION path_image c) = {} /\ + inside(path_image c1 UNION path_image c) UNION + inside(path_image c2 UNION path_image c) UNION + (path_image c DIFF {a,b}) = + inside(path_image c1 UNION path_image c2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY (MP_TAC o C ISPEC JORDAN_INSIDE_OUTSIDE) + [`(c1 ++ reversepath c2):real^1->real^2`; + `(c1 ++ reversepath c):real^1->real^2`; + `(c2 ++ reversepath c):real^1->real^2`] THEN + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + SIMPLE_PATH_JOIN_LOOP; SIMPLE_PATH_IMP_ARC; + PATH_IMAGE_JOIN; SIMPLE_PATH_IMP_PATH; PATH_IMAGE_REVERSEPATH; + SIMPLE_PATH_REVERSEPATH; ARC_REVERSEPATH; + SUBSET_REFL] THEN + REPLICATE_TAC 3 STRIP_TAC THEN + SUBGOAL_THEN + `path_image(c:real^1->real^2) INTER + outside(path_image c1 UNION path_image c2) = {}` + ASSUME_TAC THENL + [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `connected(path_image(c:real^1->real^2) DIFF + {pathstart c,pathfinish c})` + MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN + ASM_REWRITE_TAC[connected] THEN + MAP_EVERY EXISTS_TAC + [`inside(path_image c1 UNION path_image c2):real^2->bool`; + `outside(path_image c1 UNION path_image c2):real^2->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `outside(path_image c1 UNION path_image c2) SUBSET + outside(path_image c1 UNION path_image (c:real^1->real^2)) /\ + outside(path_image c1 UNION path_image c2) SUBSET + outside(path_image c2 UNION path_image c)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM]] THEN + MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[UNION_COMM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `path_image(c1:real^1->real^2) INTER + inside(path_image c2 UNION path_image c) = {}` + ASSUME_TAC THENL + [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool = + frontier(outside(path_image c2 UNION path_image c))` + MP_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [UNION_COMM] THEN + MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `connected(path_image(c1:real^1->real^2) DIFF + {pathstart c1,pathfinish c1})` + MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN + ASM_REWRITE_TAC[connected] THEN + MAP_EVERY EXISTS_TAC + [`inside(path_image c2 UNION path_image c):real^2->bool`; + `outside(path_image c2 UNION path_image c):real^2->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `path_image(c2:real^1->real^2) INTER + inside(path_image c1 UNION path_image c) = {}` + ASSUME_TAC THENL + [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `frontier(outside(path_image c1 UNION path_image c2)):real^2->bool = + frontier(outside(path_image c1 UNION path_image c))` + MP_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OUTSIDE_UNION_OUTSIDE_UNION THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `connected(path_image(c2:real^1->real^2) DIFF + {pathstart c2,pathfinish c2})` + MP_TAC THENL [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_ENDLESS]; ALL_TAC] THEN + ASM_REWRITE_TAC[connected] THEN + MAP_EVERY EXISTS_TAC + [`inside(path_image c1 UNION path_image c):real^2->bool`; + `outside(path_image c1 UNION path_image c):real^2->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + MP_TAC(ISPEC `c:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `inside(path_image c1 UNION path_image (c:real^1->real^2)) SUBSET + inside(path_image c1 UNION path_image c2) /\ + inside(path_image c2 UNION path_image (c:real^1->real^2)) SUBSET + inside(path_image c1 UNION path_image c2)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF t SUBSET UNIV DIFF s <=> s SUBSET t`] THENL + [ALL_TAC; GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [UNION_COMM]] THEN + MATCH_MP_TAC(SET_RULE + `out1 SUBSET out2 /\ c2 DIFF (c1 UNION c) SUBSET out2 + ==> (c1 UNION c2) UNION out1 SUBSET (c1 UNION c) UNION out2`) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[OUTSIDE_INSIDE] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `inside(path_image c1 UNION path_image c :real^2->bool) SUBSET + outside(path_image c2 UNION path_image c) /\ + inside(path_image c2 UNION path_image c) SUBSET + outside(path_image c1 UNION path_image c)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SUBSET] THEN CONJ_TAC THEN + X_GEN_TAC `x:real^2` THEN DISCH_TAC THENL + [SUBGOAL_THEN `?z:real^2. z IN path_image c1 /\ + z IN outside(path_image c2 UNION path_image c)` + (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL + [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN + MP_TAC(ISPEC `c1:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN + MP_TAC(ASSUME + `open(outside(path_image c2 UNION path_image c):real^2->bool)`) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ASSUME + `frontier(inside(path_image c1 UNION path_image c):real^2->bool) = + path_image c1 UNION path_image c`) THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN + ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN + REWRITE_TAC[connected_component] THEN CONJ_TAC THENL + [EXISTS_TAC + `outside(path_image c2 UNION path_image c:real^2->bool)` THEN + ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`; + OUTSIDE_NO_OVERLAP] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]; + EXISTS_TAC `inside(path_image c1 UNION path_image c:real^2->bool)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `inside(c1 UNION c) INTER (c1 UNION c) = {} /\ + c2 INTER inside(c1 UNION c) = {} + ==> inside(c1 UNION c) SUBSET UNIV DIFF (c2 UNION c)`) THEN + ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]]; + SUBGOAL_THEN `?z:real^2. z IN path_image c2 /\ + z IN outside(path_image c1 UNION path_image c)` + (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL + [REWRITE_TAC[OUTSIDE_INSIDE; IN_DIFF; IN_UNION; IN_UNIV] THEN + MP_TAC(ISPEC `c2:real^1->real^2` NONEMPTY_SIMPLE_PATH_ENDLESS) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[OUTSIDE; IN_ELIM_THM; CONTRAPOS_THM] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN + MP_TAC(ASSUME + `open(outside(path_image c1 UNION path_image c):real^2->bool)`) THEN + REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ASSUME + `frontier(inside(path_image c2 UNION path_image c):real^2->bool) = + path_image c2 UNION path_image c`) THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN REWRITE_TAC[frontier] THEN + ASM_SIMP_TAC[IN_UNION; IN_DIFF; CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real` o CONJUNCT1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `w:real^2` THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN EXISTS_TAC `w:real^2` THEN + REWRITE_TAC[connected_component] THEN CONJ_TAC THENL + [EXISTS_TAC + `outside(path_image c1 UNION path_image c:real^2->bool)` THEN + ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`; + OUTSIDE_NO_OVERLAP] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] IN_BALL]; + EXISTS_TAC `inside(path_image c2 UNION path_image c:real^2->bool)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `inside(c2 UNION c) INTER (c2 UNION c) = {} /\ + c1 INTER inside(c2 UNION c) = {} + ==> inside(c2 UNION c) SUBSET UNIV DIFF (c1 UNION c)`) THEN + ASM_REWRITE_TAC[INSIDE_NO_OVERLAP]]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `!u. s SUBSET u /\ t INTER u = {} ==> s INTER t = {}`) THEN + EXISTS_TAC `outside(path_image c2 UNION path_image c):real^2->bool` THEN + ASM_REWRITE_TAC[INSIDE_INTER_OUTSIDE]; + ALL_TAC] THEN + SUBGOAL_THEN + `outside (path_image c1 UNION path_image c) INTER + outside (path_image c2 UNION path_image c):real^2->bool + SUBSET outside (path_image c1 UNION path_image c2)` + MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[SET_RULE `s INTER t = u <=> + (UNIV DIFF s) UNION (UNIV DIFF t) = UNIV DIFF u`] THEN + REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC COMPONENTS_MAXIMAL THEN + EXISTS_TAC `(:real^2) DIFF (path_image c1 UNION path_image c2)` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]; DISCH_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MP_TAC(ISPECL + [`closure(inside(path_image c1 UNION path_image c)):real^2->bool`; + `closure(inside(path_image c2 UNION path_image c)):real^2->bool`] + JANISZEWSKI_CONNECTED) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE; CLOSED_CLOSURE] THEN + ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; + SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; + ONCE_REWRITE_RULE[UNION_COMM] UNION_WITH_INSIDE] THEN + REWRITE_TAC[SET_RULE + `UNIV DIFF ((UNIV DIFF s) UNION (UNIV DIFF t)) = s INTER t`] THEN + DISCH_THEN MATCH_MP_TAC THEN + SUBGOAL_THEN `connected(path_image c:real^2->bool)` MP_TAC THENL + [ASM_SIMP_TAC[CONNECTED_SIMPLE_PATH_IMAGE]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM UNION_WITH_INSIDE] THEN ASM SET_TAC[]);; diff --git a/Multivariate/multivariate_database.ml b/Multivariate/multivariate_database.ml new file mode 100644 index 0000000..8709025 --- /dev/null +++ b/Multivariate/multivariate_database.ml @@ -0,0 +1,8892 @@ +needs "help.ml";; + +theorems := +[ +"ABSOLUTELY_CONTINUOUS_INTEGRAL",ABSOLUTELY_CONTINUOUS_INTEGRAL; +"ABSOLUTELY_INTEGRABLE_0",ABSOLUTELY_INTEGRABLE_0; +"ABSOLUTELY_INTEGRABLE_ABS",ABSOLUTELY_INTEGRABLE_ABS; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_BOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_LBOUND; +"ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND",ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_DROP_UBOUND; +"ABSOLUTELY_INTEGRABLE_ABS_1",ABSOLUTELY_INTEGRABLE_ABS_1; +"ABSOLUTELY_INTEGRABLE_ABS_EQ",ABSOLUTELY_INTEGRABLE_ABS_EQ; +"ABSOLUTELY_INTEGRABLE_ADD",ABSOLUTELY_INTEGRABLE_ADD; +"ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_APPROXIMATE_CONTINUOUS; +"ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT",ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT; +"ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION; +"ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_EQ; +"ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ",ABSOLUTELY_INTEGRABLE_BOUNDED_SETVARIATION_UNIV_EQ; +"ABSOLUTELY_INTEGRABLE_CMUL",ABSOLUTELY_INTEGRABLE_CMUL; +"ABSOLUTELY_INTEGRABLE_COMPONENTWISE",ABSOLUTELY_INTEGRABLE_COMPONENTWISE; +"ABSOLUTELY_INTEGRABLE_CONST",ABSOLUTELY_INTEGRABLE_CONST; +"ABSOLUTELY_INTEGRABLE_CONTINUOUS",ABSOLUTELY_INTEGRABLE_CONTINUOUS; +"ABSOLUTELY_INTEGRABLE_EQ",ABSOLUTELY_INTEGRABLE_EQ; +"ABSOLUTELY_INTEGRABLE_IMPROPER",ABSOLUTELY_INTEGRABLE_IMPROPER; +"ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE",ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; +"ABSOLUTELY_INTEGRABLE_INF_1",ABSOLUTELY_INTEGRABLE_INF_1; +"ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND",ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND; +"ABSOLUTELY_INTEGRABLE_LE",ABSOLUTELY_INTEGRABLE_LE; +"ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS",ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS; +"ABSOLUTELY_INTEGRABLE_LINEAR",ABSOLUTELY_INTEGRABLE_LINEAR; +"ABSOLUTELY_INTEGRABLE_MAX",ABSOLUTELY_INTEGRABLE_MAX; +"ABSOLUTELY_INTEGRABLE_MAX_1",ABSOLUTELY_INTEGRABLE_MAX_1; +"ABSOLUTELY_INTEGRABLE_MEASURABLE",ABSOLUTELY_INTEGRABLE_MEASURABLE; +"ABSOLUTELY_INTEGRABLE_MIN",ABSOLUTELY_INTEGRABLE_MIN; +"ABSOLUTELY_INTEGRABLE_MIN_1",ABSOLUTELY_INTEGRABLE_MIN_1; +"ABSOLUTELY_INTEGRABLE_NEG",ABSOLUTELY_INTEGRABLE_NEG; +"ABSOLUTELY_INTEGRABLE_NORM",ABSOLUTELY_INTEGRABLE_NORM; +"ABSOLUTELY_INTEGRABLE_ON_CONST",ABSOLUTELY_INTEGRABLE_ON_CONST; +"ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER",ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_INTER; +"ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET",ABSOLUTELY_INTEGRABLE_ON_LEBSESGUE_MEASURABLE_SUBSET; +"ABSOLUTELY_INTEGRABLE_ON_NULL",ABSOLUTELY_INTEGRABLE_ON_NULL; +"ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL",ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL; +"ABSOLUTELY_INTEGRABLE_PASTECART_SYM",ABSOLUTELY_INTEGRABLE_PASTECART_SYM; +"ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV",ABSOLUTELY_INTEGRABLE_PASTECART_SYM_UNIV; +"ABSOLUTELY_INTEGRABLE_RESTRICT_INTER",ABSOLUTELY_INTEGRABLE_RESTRICT_INTER; +"ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV",ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV; +"ABSOLUTELY_INTEGRABLE_SET_VARIATION",ABSOLUTELY_INTEGRABLE_SET_VARIATION; +"ABSOLUTELY_INTEGRABLE_SPIKE",ABSOLUTELY_INTEGRABLE_SPIKE; +"ABSOLUTELY_INTEGRABLE_SUB",ABSOLUTELY_INTEGRABLE_SUB; +"ABSOLUTELY_INTEGRABLE_SUP_1",ABSOLUTELY_INTEGRABLE_SUP_1; +"ABSOLUTELY_INTEGRABLE_VSUM",ABSOLUTELY_INTEGRABLE_VSUM; +"ABSOLUTE_EXTENSOR_IMP_AR",ABSOLUTE_EXTENSOR_IMP_AR; +"ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR",ABSOLUTE_NEIGHBOURHOOD_EXTENSOR_IMP_ANR; +"ABSOLUTE_RETRACTION_CONVEX_CLOSED",ABSOLUTE_RETRACTION_CONVEX_CLOSED; +"ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE",ABSOLUTE_RETRACTION_CONVEX_CLOSED_RELATIVE; +"ABSOLUTE_RETRACT_CONTRACTIBLE_ANR",ABSOLUTE_RETRACT_CONTRACTIBLE_ANR; +"ABSOLUTE_RETRACT_CONVEX",ABSOLUTE_RETRACT_CONVEX; +"ABSOLUTE_RETRACT_CONVEX_CLOSED",ABSOLUTE_RETRACT_CONVEX_CLOSED; +"ABSOLUTE_RETRACT_FROM_UNION_AND_INTER",ABSOLUTE_RETRACT_FROM_UNION_AND_INTER; +"ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT",ABSOLUTE_RETRACT_HOMEOMORPHIC_CONVEX_COMPACT; +"ABSOLUTE_RETRACT_IMP_AR",ABSOLUTE_RETRACT_IMP_AR; +"ABSOLUTE_RETRACT_IMP_AR_GEN",ABSOLUTE_RETRACT_IMP_AR_GEN; +"ABSOLUTE_RETRACT_PATH_IMAGE_ARC",ABSOLUTE_RETRACT_PATH_IMAGE_ARC; +"ABSOLUTE_RETRACT_UNION",ABSOLUTE_RETRACT_UNION; +"ABSORPTION",ABSORPTION; +"ABS_DROP",ABS_DROP; +"ABS_SIMP",ABS_SIMP; +"ADD",ADD; +"ADD1",ADD1; +"ADDITIVE_CONTENT_DIVISION",ADDITIVE_CONTENT_DIVISION; +"ADDITIVE_CONTENT_TAGGED_DIVISION",ADDITIVE_CONTENT_TAGGED_DIVISION; +"ADDITIVE_TAGGED_DIVISION_1",ADDITIVE_TAGGED_DIVISION_1; +"ADD_0",ADD_0; +"ADD_AC",ADD_AC; +"ADD_ASSOC",ADD_ASSOC; +"ADD_CLAUSES",ADD_CLAUSES; +"ADD_EQ_0",ADD_EQ_0; +"ADD_SUB",ADD_SUB; +"ADD_SUB2",ADD_SUB2; +"ADD_SUBR",ADD_SUBR; +"ADD_SUBR2",ADD_SUBR2; +"ADD_SUC",ADD_SUC; +"ADD_SYM",ADD_SYM; +"ADJOINT_ADJOINT",ADJOINT_ADJOINT; +"ADJOINT_CLAUSES",ADJOINT_CLAUSES; +"ADJOINT_COMPOSE",ADJOINT_COMPOSE; +"ADJOINT_INJECTIVE",ADJOINT_INJECTIVE; +"ADJOINT_INJECTIVE_INJECTIVE",ADJOINT_INJECTIVE_INJECTIVE; +"ADJOINT_INJECTIVE_INJECTIVE_0",ADJOINT_INJECTIVE_INJECTIVE_0; +"ADJOINT_LINEAR",ADJOINT_LINEAR; +"ADJOINT_MATRIX",ADJOINT_MATRIX; +"ADJOINT_SURJECTIVE",ADJOINT_SURJECTIVE; +"ADJOINT_UNIQUE",ADJOINT_UNIQUE; +"ADJOINT_WORKS",ADJOINT_WORKS; +"ADMISSIBLE_BASE",ADMISSIBLE_BASE; +"ADMISSIBLE_COMB",ADMISSIBLE_COMB; +"ADMISSIBLE_COND",ADMISSIBLE_COND; +"ADMISSIBLE_CONST",ADMISSIBLE_CONST; +"ADMISSIBLE_GUARDED_PATTERN",ADMISSIBLE_GUARDED_PATTERN; +"ADMISSIBLE_IMP_SUPERADMISSIBLE",ADMISSIBLE_IMP_SUPERADMISSIBLE; +"ADMISSIBLE_LAMBDA",ADMISSIBLE_LAMBDA; +"ADMISSIBLE_MAP",ADMISSIBLE_MAP; +"ADMISSIBLE_MATCH",ADMISSIBLE_MATCH; +"ADMISSIBLE_MATCH_SEQPATTERN",ADMISSIBLE_MATCH_SEQPATTERN; +"ADMISSIBLE_NEST",ADMISSIBLE_NEST; +"ADMISSIBLE_NSUM",ADMISSIBLE_NSUM; +"ADMISSIBLE_RAND",ADMISSIBLE_RAND; +"ADMISSIBLE_SEQPATTERN",ADMISSIBLE_SEQPATTERN; +"ADMISSIBLE_SUM",ADMISSIBLE_SUM; +"ADMISSIBLE_UNGUARDED_PATTERN",ADMISSIBLE_UNGUARDED_PATTERN; +"AFFINE",AFFINE; +"AFFINE_AFFINE_HULL",AFFINE_AFFINE_HULL; +"AFFINE_AFFINITY",AFFINE_AFFINITY; +"AFFINE_ALT",AFFINE_ALT; +"AFFINE_BASIS_EXISTS",AFFINE_BASIS_EXISTS; +"AFFINE_BOUNDED_EQ_LOWDIM",AFFINE_BOUNDED_EQ_LOWDIM; +"AFFINE_BOUNDED_EQ_TRIVIAL",AFFINE_BOUNDED_EQ_TRIVIAL; +"AFFINE_DEPENDENT_BIGGERSET",AFFINE_DEPENDENT_BIGGERSET; +"AFFINE_DEPENDENT_BIGGERSET_GENERAL",AFFINE_DEPENDENT_BIGGERSET_GENERAL; +"AFFINE_DEPENDENT_CHOOSE",AFFINE_DEPENDENT_CHOOSE; +"AFFINE_DEPENDENT_EXPLICIT",AFFINE_DEPENDENT_EXPLICIT; +"AFFINE_DEPENDENT_EXPLICIT_FINITE",AFFINE_DEPENDENT_EXPLICIT_FINITE; +"AFFINE_DEPENDENT_IMP_COLLINEAR_3",AFFINE_DEPENDENT_IMP_COLLINEAR_3; +"AFFINE_DEPENDENT_IMP_DEPENDENT",AFFINE_DEPENDENT_IMP_DEPENDENT; +"AFFINE_DEPENDENT_LINEAR_IMAGE",AFFINE_DEPENDENT_LINEAR_IMAGE; +"AFFINE_DEPENDENT_LINEAR_IMAGE_EQ",AFFINE_DEPENDENT_LINEAR_IMAGE_EQ; +"AFFINE_DEPENDENT_MONO",AFFINE_DEPENDENT_MONO; +"AFFINE_DEPENDENT_TRANSLATION",AFFINE_DEPENDENT_TRANSLATION; +"AFFINE_DEPENDENT_TRANSLATION_EQ",AFFINE_DEPENDENT_TRANSLATION_EQ; +"AFFINE_DIFFERENCES",AFFINE_DIFFERENCES; +"AFFINE_DIFFS_SUBSPACE",AFFINE_DIFFS_SUBSPACE; +"AFFINE_EMPTY",AFFINE_EMPTY; +"AFFINE_EQ_SUBSPACE",AFFINE_EQ_SUBSPACE; +"AFFINE_EXPLICIT",AFFINE_EXPLICIT; +"AFFINE_HULLS_EQ",AFFINE_HULLS_EQ; +"AFFINE_HULL_2",AFFINE_HULL_2; +"AFFINE_HULL_2_ALT",AFFINE_HULL_2_ALT; +"AFFINE_HULL_3",AFFINE_HULL_3; +"AFFINE_HULL_3_IMP_COLLINEAR",AFFINE_HULL_3_IMP_COLLINEAR; +"AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_AFFINE_INTER_NONEMPTY_INTERIOR; +"AFFINE_HULL_AFFINE_INTER_OPEN",AFFINE_HULL_AFFINE_INTER_OPEN; +"AFFINE_HULL_AFFINE_INTER_OPEN_IN",AFFINE_HULL_AFFINE_INTER_OPEN_IN; +"AFFINE_HULL_CLOSURE",AFFINE_HULL_CLOSURE; +"AFFINE_HULL_CONVEX_HULL",AFFINE_HULL_CONVEX_HULL; +"AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR",AFFINE_HULL_CONVEX_INTER_NONEMPTY_INTERIOR; +"AFFINE_HULL_CONVEX_INTER_OPEN",AFFINE_HULL_CONVEX_INTER_OPEN; +"AFFINE_HULL_CONVEX_INTER_OPEN_IN",AFFINE_HULL_CONVEX_INTER_OPEN_IN; +"AFFINE_HULL_EMPTY",AFFINE_HULL_EMPTY; +"AFFINE_HULL_EQ",AFFINE_HULL_EQ; +"AFFINE_HULL_EQ_EMPTY",AFFINE_HULL_EQ_EMPTY; +"AFFINE_HULL_EQ_SING",AFFINE_HULL_EQ_SING; +"AFFINE_HULL_EQ_SPAN",AFFINE_HULL_EQ_SPAN; +"AFFINE_HULL_EQ_SPAN_EQ",AFFINE_HULL_EQ_SPAN_EQ; +"AFFINE_HULL_EXPLICIT",AFFINE_HULL_EXPLICIT; +"AFFINE_HULL_EXPLICIT_ALT",AFFINE_HULL_EXPLICIT_ALT; +"AFFINE_HULL_EXPLICIT_UNIQUE",AFFINE_HULL_EXPLICIT_UNIQUE; +"AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR",AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR; +"AFFINE_HULL_FINITE",AFFINE_HULL_FINITE; +"AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES",AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES; +"AFFINE_HULL_FINITE_STEP",AFFINE_HULL_FINITE_STEP; +"AFFINE_HULL_FINITE_STEP_GEN",AFFINE_HULL_FINITE_STEP_GEN; +"AFFINE_HULL_HALFSPACE_GE",AFFINE_HULL_HALFSPACE_GE; +"AFFINE_HULL_HALFSPACE_GT",AFFINE_HULL_HALFSPACE_GT; +"AFFINE_HULL_HALFSPACE_LE",AFFINE_HULL_HALFSPACE_LE; +"AFFINE_HULL_HALFSPACE_LT",AFFINE_HULL_HALFSPACE_LT; +"AFFINE_HULL_INDEXED",AFFINE_HULL_INDEXED; +"AFFINE_HULL_INSERT_SPAN",AFFINE_HULL_INSERT_SPAN; +"AFFINE_HULL_INSERT_SUBSET_SPAN",AFFINE_HULL_INSERT_SUBSET_SPAN; +"AFFINE_HULL_INTER",AFFINE_HULL_INTER; +"AFFINE_HULL_INTERS",AFFINE_HULL_INTERS; +"AFFINE_HULL_LINEAR_IMAGE",AFFINE_HULL_LINEAR_IMAGE; +"AFFINE_HULL_NONEMPTY_INTERIOR",AFFINE_HULL_NONEMPTY_INTERIOR; +"AFFINE_HULL_OPEN",AFFINE_HULL_OPEN; +"AFFINE_HULL_OPEN_IN",AFFINE_HULL_OPEN_IN; +"AFFINE_HULL_PCROSS",AFFINE_HULL_PCROSS; +"AFFINE_HULL_RELATIVE_INTERIOR",AFFINE_HULL_RELATIVE_INTERIOR; +"AFFINE_HULL_SEGMENT",AFFINE_HULL_SEGMENT; +"AFFINE_HULL_SING",AFFINE_HULL_SING; +"AFFINE_HULL_SPAN",AFFINE_HULL_SPAN; +"AFFINE_HULL_SUBSET_SPAN",AFFINE_HULL_SUBSET_SPAN; +"AFFINE_HULL_TRANSLATION",AFFINE_HULL_TRANSLATION; +"AFFINE_HULL_UNIV",AFFINE_HULL_UNIV; +"AFFINE_HYPERPLANE",AFFINE_HYPERPLANE; +"AFFINE_HYPERPLANE_SUMS_EQ_UNIV",AFFINE_HYPERPLANE_SUMS_EQ_UNIV; +"AFFINE_IMP_CONVEX",AFFINE_IMP_CONVEX; +"AFFINE_IMP_POLYHEDRON",AFFINE_IMP_POLYHEDRON; +"AFFINE_IMP_SUBSPACE",AFFINE_IMP_SUBSPACE; +"AFFINE_INDEPENDENT_1",AFFINE_INDEPENDENT_1; +"AFFINE_INDEPENDENT_2",AFFINE_INDEPENDENT_2; +"AFFINE_INDEPENDENT_CARD_DIM_DIFFS",AFFINE_INDEPENDENT_CARD_DIM_DIFFS; +"AFFINE_INDEPENDENT_CARD_LE",AFFINE_INDEPENDENT_CARD_LE; +"AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL",AFFINE_INDEPENDENT_CONVEX_AFFINE_HULL; +"AFFINE_INDEPENDENT_DELETE",AFFINE_INDEPENDENT_DELETE; +"AFFINE_INDEPENDENT_EMPTY",AFFINE_INDEPENDENT_EMPTY; +"AFFINE_INDEPENDENT_IFF_CARD",AFFINE_INDEPENDENT_IFF_CARD; +"AFFINE_INDEPENDENT_IMP_FINITE",AFFINE_INDEPENDENT_IMP_FINITE; +"AFFINE_INDEPENDENT_INSERT",AFFINE_INDEPENDENT_INSERT; +"AFFINE_INDEPENDENT_SPAN_EQ",AFFINE_INDEPENDENT_SPAN_EQ; +"AFFINE_INDEPENDENT_SPAN_GT",AFFINE_INDEPENDENT_SPAN_GT; +"AFFINE_INDEPENDENT_STDBASIS",AFFINE_INDEPENDENT_STDBASIS; +"AFFINE_INDEPENDENT_SUBSET",AFFINE_INDEPENDENT_SUBSET; +"AFFINE_INDEXED",AFFINE_INDEXED; +"AFFINE_INTER",AFFINE_INTER; +"AFFINE_INTERS",AFFINE_INTERS; +"AFFINE_LINEAR_IMAGE",AFFINE_LINEAR_IMAGE; +"AFFINE_LINEAR_IMAGE_EQ",AFFINE_LINEAR_IMAGE_EQ; +"AFFINE_NEGATIONS",AFFINE_NEGATIONS; +"AFFINE_PARALLEL_SLICE",AFFINE_PARALLEL_SLICE; +"AFFINE_PCROSS",AFFINE_PCROSS; +"AFFINE_PCROSS_EQ",AFFINE_PCROSS_EQ; +"AFFINE_SCALING",AFFINE_SCALING; +"AFFINE_SCALING_EQ",AFFINE_SCALING_EQ; +"AFFINE_SING",AFFINE_SING; +"AFFINE_SPAN",AFFINE_SPAN; +"AFFINE_STANDARD_HYPERPLANE",AFFINE_STANDARD_HYPERPLANE; +"AFFINE_SUMS",AFFINE_SUMS; +"AFFINE_TRANSLATION",AFFINE_TRANSLATION; +"AFFINE_TRANSLATION_EQ",AFFINE_TRANSLATION_EQ; +"AFFINE_TRANSLATION_SUBSPACE",AFFINE_TRANSLATION_SUBSPACE; +"AFFINE_TRANSLATION_SUBSPACE_EXPLICIT",AFFINE_TRANSLATION_SUBSPACE_EXPLICIT; +"AFFINE_TRANSLATION_UNIQUE_SUBSPACE",AFFINE_TRANSLATION_UNIQUE_SUBSPACE; +"AFFINE_UNIV",AFFINE_UNIV; +"AFFINE_VSUM",AFFINE_VSUM; +"AFFINE_VSUM_STRONG",AFFINE_VSUM_STRONG; +"AFFINITY_INVERSES",AFFINITY_INVERSES; +"AFF_DIM",AFF_DIM; +"AFF_DIM_2",AFF_DIM_2; +"AFF_DIM_AFFINE_HULL",AFF_DIM_AFFINE_HULL; +"AFF_DIM_AFFINE_INDEPENDENT",AFF_DIM_AFFINE_INDEPENDENT; +"AFF_DIM_AFFINE_INTER_HYPERPLANE",AFF_DIM_AFFINE_INTER_HYPERPLANE; +"AFF_DIM_BALL",AFF_DIM_BALL; +"AFF_DIM_CBALL",AFF_DIM_CBALL; +"AFF_DIM_CLOSURE",AFF_DIM_CLOSURE; +"AFF_DIM_CONVEX_HULL",AFF_DIM_CONVEX_HULL; +"AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR",AFF_DIM_CONVEX_INTER_NONEMPTY_INTERIOR; +"AFF_DIM_CONVEX_INTER_OPEN",AFF_DIM_CONVEX_INTER_OPEN; +"AFF_DIM_DIM_0",AFF_DIM_DIM_0; +"AFF_DIM_DIM_AFFINE_DIFFS",AFF_DIM_DIM_AFFINE_DIFFS; +"AFF_DIM_DIM_SUBSPACE",AFF_DIM_DIM_SUBSPACE; +"AFF_DIM_EMPTY",AFF_DIM_EMPTY; +"AFF_DIM_EQ_0",AFF_DIM_EQ_0; +"AFF_DIM_EQ_AFFINE_HULL",AFF_DIM_EQ_AFFINE_HULL; +"AFF_DIM_EQ_FULL",AFF_DIM_EQ_FULL; +"AFF_DIM_EQ_HYPERPLANE",AFF_DIM_EQ_HYPERPLANE; +"AFF_DIM_EQ_MINUS1",AFF_DIM_EQ_MINUS1; +"AFF_DIM_GE",AFF_DIM_GE; +"AFF_DIM_HALFSPACE_GE",AFF_DIM_HALFSPACE_GE; +"AFF_DIM_HALFSPACE_GT",AFF_DIM_HALFSPACE_GT; +"AFF_DIM_HALFSPACE_LE",AFF_DIM_HALFSPACE_LE; +"AFF_DIM_HALFSPACE_LT",AFF_DIM_HALFSPACE_LT; +"AFF_DIM_HYPERPLANE",AFF_DIM_HYPERPLANE; +"AFF_DIM_INJECTIVE_LINEAR_IMAGE",AFF_DIM_INJECTIVE_LINEAR_IMAGE; +"AFF_DIM_INSERT",AFF_DIM_INSERT; +"AFF_DIM_INTERVAL",AFF_DIM_INTERVAL; +"AFF_DIM_LE_CARD",AFF_DIM_LE_CARD; +"AFF_DIM_LE_DIM",AFF_DIM_LE_DIM; +"AFF_DIM_LE_UNIV",AFF_DIM_LE_UNIV; +"AFF_DIM_LINEAR_IMAGE_LE",AFF_DIM_LINEAR_IMAGE_LE; +"AFF_DIM_LT_FULL",AFF_DIM_LT_FULL; +"AFF_DIM_NONEMPTY_INTERIOR",AFF_DIM_NONEMPTY_INTERIOR; +"AFF_DIM_NONEMPTY_INTERIOR_EQ",AFF_DIM_NONEMPTY_INTERIOR_EQ; +"AFF_DIM_OPEN",AFF_DIM_OPEN; +"AFF_DIM_OPEN_IN",AFF_DIM_OPEN_IN; +"AFF_DIM_POS_LE",AFF_DIM_POS_LE; +"AFF_DIM_PSUBSET",AFF_DIM_PSUBSET; +"AFF_DIM_SIMPLEX",AFF_DIM_SIMPLEX; +"AFF_DIM_SING",AFF_DIM_SING; +"AFF_DIM_SUBSET",AFF_DIM_SUBSET; +"AFF_DIM_SUMS_INTER",AFF_DIM_SUMS_INTER; +"AFF_DIM_TRANSLATION_EQ",AFF_DIM_TRANSLATION_EQ; +"AFF_DIM_UNIQUE",AFF_DIM_UNIQUE; +"AFF_DIM_UNIV",AFF_DIM_UNIV; +"AFF_LOWDIM_SUBSET_HYPERPLANE",AFF_LOWDIM_SUBSET_HYPERPLANE; +"ALL",ALL; +"ALL2",ALL2; +"ALL2_ALL",ALL2_ALL; +"ALL2_AND_RIGHT",ALL2_AND_RIGHT; +"ALL2_DEF",ALL2_DEF; +"ALL2_MAP",ALL2_MAP; +"ALL2_MAP2",ALL2_MAP2; +"ALL_APPEND",ALL_APPEND; +"ALL_EL",ALL_EL; +"ALL_FILTER",ALL_FILTER; +"ALL_IMP",ALL_IMP; +"ALL_MAP",ALL_MAP; +"ALL_MEM",ALL_MEM; +"ALL_MP",ALL_MP; +"ALL_T",ALL_T; +"ALWAYS_EVENTUALLY",ALWAYS_EVENTUALLY; +"AND_ALL",AND_ALL; +"AND_ALL2",AND_ALL2; +"AND_CLAUSES",AND_CLAUSES; +"AND_DEF",AND_DEF; +"AND_FORALL_THM",AND_FORALL_THM; +"ANR",ANR; +"ANR_BALL",ANR_BALL; +"ANR_CBALL",ANR_CBALL; +"ANR_CLOSED_UNION",ANR_CLOSED_UNION; +"ANR_CLOSED_UNION_LOCAL",ANR_CLOSED_UNION_LOCAL; +"ANR_COMPONENT_ANR",ANR_COMPONENT_ANR; +"ANR_CONNECTED_COMPONENT_ANR",ANR_CONNECTED_COMPONENT_ANR; +"ANR_DELETE",ANR_DELETE; +"ANR_EMPTY",ANR_EMPTY; +"ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_EQ_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; +"ANR_FINITE_UNIONS_CONVEX_CLOSED",ANR_FINITE_UNIONS_CONVEX_CLOSED; +"ANR_FROM_UNION_AND_INTER",ANR_FROM_UNION_AND_INTER; +"ANR_FROM_UNION_AND_INTER_LOCAL",ANR_FROM_UNION_AND_INTER_LOCAL; +"ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_EXTENSOR; +"ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_CLOSED_NEIGHBOURHOOD_RETRACT; +"ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_EXTENSOR; +"ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; +"ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ANR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; +"ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT",ANR_IMP_CLOSED_NEIGHBOURHOOD_RETRACT; +"ANR_IMP_LOCALLY_CONNECTED",ANR_IMP_LOCALLY_CONNECTED; +"ANR_IMP_LOCALLY_PATH_CONNECTED",ANR_IMP_LOCALLY_PATH_CONNECTED; +"ANR_IMP_NEIGHBOURHOOD_RETRACT",ANR_IMP_NEIGHBOURHOOD_RETRACT; +"ANR_INSERT",ANR_INSERT; +"ANR_INTERIOR",ANR_INTERIOR; +"ANR_INTERVAL",ANR_INTERVAL; +"ANR_LINEAR_IMAGE_EQ",ANR_LINEAR_IMAGE_EQ; +"ANR_NEIGHBORHOOD_RETRACT",ANR_NEIGHBORHOOD_RETRACT; +"ANR_OPEN_IN",ANR_OPEN_IN; +"ANR_PATH_COMPONENT_ANR",ANR_PATH_COMPONENT_ANR; +"ANR_PCROSS",ANR_PCROSS; +"ANR_PCROSS_EQ",ANR_PCROSS_EQ; +"ANR_RELATIVE_FRONTIER_CONVEX",ANR_RELATIVE_FRONTIER_CONVEX; +"ANR_RELATIVE_INTERIOR",ANR_RELATIVE_INTERIOR; +"ANR_RETRACT_OF_ANR",ANR_RETRACT_OF_ANR; +"ANR_SIMPLICIAL_COMPLEX",ANR_SIMPLICIAL_COMPLEX; +"ANR_SING",ANR_SING; +"ANR_SPHERE",ANR_SPHERE; +"ANR_TRANSLATION",ANR_TRANSLATION; +"ANR_TRIANGULATION",ANR_TRIANGULATION; +"ANR_UNIV",ANR_UNIV; +"ANTIDERIVATIVE_CONTINUOUS",ANTIDERIVATIVE_CONTINUOUS; +"ANTIDERIVATIVE_INTEGRAL_CONTINUOUS",ANTIDERIVATIVE_INTEGRAL_CONTINUOUS; +"ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL",ANY_CLOSEST_POINT_AFFINE_ORTHOGONAL; +"ANY_CLOSEST_POINT_DOT",ANY_CLOSEST_POINT_DOT; +"ANY_CLOSEST_POINT_UNIQUE",ANY_CLOSEST_POINT_UNIQUE; +"APPEND",APPEND; +"APPEND_ASSOC",APPEND_ASSOC; +"APPEND_BUTLAST_LAST",APPEND_BUTLAST_LAST; +"APPEND_EQ_NIL",APPEND_EQ_NIL; +"APPEND_NIL",APPEND_NIL; +"APPEND_SING",APPEND_SING; +"APPROACHABLE_LT_LE",APPROACHABLE_LT_LE; +"APPROXIMABLE_ON_DIVISION",APPROXIMABLE_ON_DIVISION; +"AR",AR; +"ARC_ASSOC",ARC_ASSOC; +"ARC_CONNECTED_TRANS",ARC_CONNECTED_TRANS; +"ARC_DISTINCT_ENDS",ARC_DISTINCT_ENDS; +"ARC_IMP_PATH",ARC_IMP_PATH; +"ARC_IMP_SIMPLE_PATH",ARC_IMP_SIMPLE_PATH; +"ARC_JOIN",ARC_JOIN; +"ARC_JOIN_EQ",ARC_JOIN_EQ; +"ARC_JOIN_EQ_ALT",ARC_JOIN_EQ_ALT; +"ARC_LINEAR_IMAGE_EQ",ARC_LINEAR_IMAGE_EQ; +"ARC_LINEPATH",ARC_LINEPATH; +"ARC_LINEPATH_EQ",ARC_LINEPATH_EQ; +"ARC_REVERSEPATH",ARC_REVERSEPATH; +"ARC_SIMPLE_PATH",ARC_SIMPLE_PATH; +"ARC_SIMPLE_PATH_SUBPATH",ARC_SIMPLE_PATH_SUBPATH; +"ARC_SIMPLE_PATH_SUBPATH_INTERIOR",ARC_SIMPLE_PATH_SUBPATH_INTERIOR; +"ARC_SUBPATH_ARC",ARC_SUBPATH_ARC; +"ARC_SUBPATH_EQ",ARC_SUBPATH_EQ; +"ARC_TRANSLATION_EQ",ARC_TRANSLATION_EQ; +"ARITH",ARITH; +"ARITH_ADD",ARITH_ADD; +"ARITH_EQ",ARITH_EQ; +"ARITH_EVEN",ARITH_EVEN; +"ARITH_EXP",ARITH_EXP; +"ARITH_GE",ARITH_GE; +"ARITH_GT",ARITH_GT; +"ARITH_LE",ARITH_LE; +"ARITH_LT",ARITH_LT; +"ARITH_MULT",ARITH_MULT; +"ARITH_ODD",ARITH_ODD; +"ARITH_PRE",ARITH_PRE; +"ARITH_SUB",ARITH_SUB; +"ARITH_SUC",ARITH_SUC; +"ARITH_ZERO",ARITH_ZERO; +"ARZELA_ASCOLI",ARZELA_ASCOLI; +"AR_ANR",AR_ANR; +"AR_BALL",AR_BALL; +"AR_CBALL",AR_CBALL; +"AR_CLOSED_UNION",AR_CLOSED_UNION; +"AR_CLOSED_UNION_LOCAL",AR_CLOSED_UNION_LOCAL; +"AR_EQ_ABSOLUTE_EXTENSOR",AR_EQ_ABSOLUTE_EXTENSOR; +"AR_FROM_UNION_AND_INTER",AR_FROM_UNION_AND_INTER; +"AR_FROM_UNION_AND_INTER_LOCAL",AR_FROM_UNION_AND_INTER_LOCAL; +"AR_IMP_ABSOLUTE_EXTENSOR",AR_IMP_ABSOLUTE_EXTENSOR; +"AR_IMP_ABSOLUTE_RETRACT",AR_IMP_ABSOLUTE_RETRACT; +"AR_IMP_ABSOLUTE_RETRACT_UNIV",AR_IMP_ABSOLUTE_RETRACT_UNIV; +"AR_IMP_ANR",AR_IMP_ANR; +"AR_IMP_CONTRACTIBLE",AR_IMP_CONTRACTIBLE; +"AR_IMP_LOCALLY_CONNECTED",AR_IMP_LOCALLY_CONNECTED; +"AR_IMP_LOCALLY_PATH_CONNECTED",AR_IMP_LOCALLY_PATH_CONNECTED; +"AR_IMP_RETRACT",AR_IMP_RETRACT; +"AR_INTERVAL",AR_INTERVAL; +"AR_LINEAR_IMAGE_EQ",AR_LINEAR_IMAGE_EQ; +"AR_PCROSS",AR_PCROSS; +"AR_PCROSS_EQ",AR_PCROSS_EQ; +"AR_RETRACT_OF_AR",AR_RETRACT_OF_AR; +"AR_SING",AR_SING; +"AR_TRANSLATION",AR_TRANSLATION; +"AR_UNIV",AR_UNIV; +"ASSOC",ASSOC; +"AT",AT; +"AT_INFINITY",AT_INFINITY; +"AT_NEGINFINITY",AT_NEGINFINITY; +"AT_POSINFINITY",AT_POSINFINITY; +"AUSTIN_LEMMA",AUSTIN_LEMMA; +"BABY_SARD",BABY_SARD; +"BAIRE",BAIRE; +"BAIRE_ALT",BAIRE_ALT; +"BALL_1",BALL_1; +"BALL_EMPTY",BALL_EMPTY; +"BALL_EQ_EMPTY",BALL_EQ_EMPTY; +"BALL_INTERVAL",BALL_INTERVAL; +"BALL_INTERVAL_0",BALL_INTERVAL_0; +"BALL_LINEAR_IMAGE",BALL_LINEAR_IMAGE; +"BALL_MAX_UNION",BALL_MAX_UNION; +"BALL_MIN_INTER",BALL_MIN_INTER; +"BALL_SCALING",BALL_SCALING; +"BALL_SUBSET_CBALL",BALL_SUBSET_CBALL; +"BALL_SUBSET_OPEN_MAP_IMAGE",BALL_SUBSET_OPEN_MAP_IMAGE; +"BALL_TRANSLATION",BALL_TRANSLATION; +"BALL_TRIVIAL",BALL_TRIVIAL; +"BALL_UNION_SPHERE",BALL_UNION_SPHERE; +"BANACH_FIX",BANACH_FIX; +"BASIS_CARD_EQ_DIM",BASIS_CARD_EQ_DIM; +"BASIS_COMPONENT",BASIS_COMPONENT; +"BASIS_COORDINATES_CONTINUOUS",BASIS_COORDINATES_CONTINUOUS; +"BASIS_COORDINATES_LIPSCHITZ",BASIS_COORDINATES_LIPSCHITZ; +"BASIS_EQ_0",BASIS_EQ_0; +"BASIS_EXISTS",BASIS_EXISTS; +"BASIS_EXISTS_FINITE",BASIS_EXISTS_FINITE; +"BASIS_EXPANSION",BASIS_EXPANSION; +"BASIS_EXPANSION_UNIQUE",BASIS_EXPANSION_UNIQUE; +"BASIS_HAS_SIZE_DIM",BASIS_HAS_SIZE_DIM; +"BASIS_HAS_SIZE_UNIV",BASIS_HAS_SIZE_UNIV; +"BASIS_INJ",BASIS_INJ; +"BASIS_INJ_EQ",BASIS_INJ_EQ; +"BASIS_NE",BASIS_NE; +"BASIS_NONZERO",BASIS_NONZERO; +"BASIS_ORTHOGONAL",BASIS_ORTHOGONAL; +"BASIS_SUBSPACE_EXISTS",BASIS_SUBSPACE_EXISTS; +"BEPPO_LEVI_DECREASING",BEPPO_LEVI_DECREASING; +"BEPPO_LEVI_INCREASING",BEPPO_LEVI_INCREASING; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING_AE; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING; +"BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE",BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING_AE; +"BESSEL_INEQUALITY",BESSEL_INEQUALITY; +"BETA_THM",BETA_THM; +"BETWEEN_ANTISYM",BETWEEN_ANTISYM; +"BETWEEN_COLLINEAR_DIST_EQ",BETWEEN_COLLINEAR_DIST_EQ; +"BETWEEN_DIST_LE",BETWEEN_DIST_LE; +"BETWEEN_DIST_LT",BETWEEN_DIST_LT; +"BETWEEN_DOT",BETWEEN_DOT; +"BETWEEN_EXISTS_EXTENSION",BETWEEN_EXISTS_EXTENSION; +"BETWEEN_IMP_COLLINEAR",BETWEEN_IMP_COLLINEAR; +"BETWEEN_IN_CONVEX_HULL",BETWEEN_IN_CONVEX_HULL; +"BETWEEN_IN_SEGMENT",BETWEEN_IN_SEGMENT; +"BETWEEN_LINEAR_IMAGE_EQ",BETWEEN_LINEAR_IMAGE_EQ; +"BETWEEN_MIDPOINT",BETWEEN_MIDPOINT; +"BETWEEN_NORM",BETWEEN_NORM; +"BETWEEN_NORM_LE",BETWEEN_NORM_LE; +"BETWEEN_NORM_LT",BETWEEN_NORM_LT; +"BETWEEN_REFL",BETWEEN_REFL; +"BETWEEN_REFL_EQ",BETWEEN_REFL_EQ; +"BETWEEN_SYM",BETWEEN_SYM; +"BETWEEN_TRANS",BETWEEN_TRANS; +"BETWEEN_TRANSLATION",BETWEEN_TRANSLATION; +"BETWEEN_TRANS_2",BETWEEN_TRANS_2; +"BIJ",BIJ; +"BIJECTIONS_CARD_EQ",BIJECTIONS_CARD_EQ; +"BIJECTIONS_HAS_SIZE",BIJECTIONS_HAS_SIZE; +"BIJECTIONS_HAS_SIZE_EQ",BIJECTIONS_HAS_SIZE_EQ; +"BIJECTIVE_INJECTIVE_SURJECTIVE",BIJECTIVE_INJECTIVE_SURJECTIVE; +"BIJECTIVE_INVERSES",BIJECTIVE_INVERSES; +"BIJECTIVE_LEFT_RIGHT_INVERSE",BIJECTIVE_LEFT_RIGHT_INVERSE; +"BIJECTIVE_ON_LEFT_RIGHT_INVERSE",BIJECTIVE_ON_LEFT_RIGHT_INVERSE; +"BILINEAR_BOUNDED",BILINEAR_BOUNDED; +"BILINEAR_BOUNDED_POS",BILINEAR_BOUNDED_POS; +"BILINEAR_CONTINUOUS_COMPOSE",BILINEAR_CONTINUOUS_COMPOSE; +"BILINEAR_CONTINUOUS_ON_COMPOSE",BILINEAR_CONTINUOUS_ON_COMPOSE; +"BILINEAR_DIFFERENTIABLE_AT_COMPOSE",BILINEAR_DIFFERENTIABLE_AT_COMPOSE; +"BILINEAR_DIFFERENTIABLE_ON_COMPOSE",BILINEAR_DIFFERENTIABLE_ON_COMPOSE; +"BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE",BILINEAR_DIFFERENTIABLE_WITHIN_COMPOSE; +"BILINEAR_DOT",BILINEAR_DOT; +"BILINEAR_DROP_MUL",BILINEAR_DROP_MUL; +"BILINEAR_EQ",BILINEAR_EQ; +"BILINEAR_EQ_MBASIS",BILINEAR_EQ_MBASIS; +"BILINEAR_EQ_STDBASIS",BILINEAR_EQ_STDBASIS; +"BILINEAR_GEOM",BILINEAR_GEOM; +"BILINEAR_INNER",BILINEAR_INNER; +"BILINEAR_LADD",BILINEAR_LADD; +"BILINEAR_LMUL",BILINEAR_LMUL; +"BILINEAR_LNEG",BILINEAR_LNEG; +"BILINEAR_LSUB",BILINEAR_LSUB; +"BILINEAR_LZERO",BILINEAR_LZERO; +"BILINEAR_OUTER",BILINEAR_OUTER; +"BILINEAR_PRODUCT",BILINEAR_PRODUCT; +"BILINEAR_RADD",BILINEAR_RADD; +"BILINEAR_RMUL",BILINEAR_RMUL; +"BILINEAR_RNEG",BILINEAR_RNEG; +"BILINEAR_RSUB",BILINEAR_RSUB; +"BILINEAR_RZERO",BILINEAR_RZERO; +"BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE",BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE; +"BILINEAR_VSUM",BILINEAR_VSUM; +"BILINEAR_VSUM_PARTIAL_PRE",BILINEAR_VSUM_PARTIAL_PRE; +"BILINEAR_VSUM_PARTIAL_SUC",BILINEAR_VSUM_PARTIAL_SUC; +"BINARYSUM_BITSET",BINARYSUM_BITSET; +"BINARYSUM_BOUND",BINARYSUM_BOUND; +"BINARYSUM_BOUND_EQ",BINARYSUM_BOUND_EQ; +"BINARYSUM_BOUND_LEMMA",BINARYSUM_BOUND_LEMMA; +"BINARYSUM_DIV",BINARYSUM_DIV; +"BINARYSUM_DIV_DIVISIBLE",BINARYSUM_DIV_DIVISIBLE; +"BINARY_INDUCT",BINARY_INDUCT; +"BIT0",BIT0; +"BIT0_DEF",BIT0_DEF; +"BIT0_THM",BIT0_THM; +"BIT1",BIT1; +"BIT1_DEF",BIT1_DEF; +"BIT1_THM",BIT1_THM; +"BITSET_0",BITSET_0; +"BITSET_BINARYSUM",BITSET_BINARYSUM; +"BITSET_BOUND",BITSET_BOUND; +"BITSET_BOUND_EQ",BITSET_BOUND_EQ; +"BITSET_BOUND_LEMMA",BITSET_BOUND_LEMMA; +"BITSET_BOUND_WEAK",BITSET_BOUND_WEAK; +"BITSET_EQ",BITSET_EQ; +"BITSET_EQ_EMPTY",BITSET_EQ_EMPTY; +"BITSET_STEP",BITSET_STEP; +"BOLZANO_WEIERSTRASS",BOLZANO_WEIERSTRASS; +"BOLZANO_WEIERSTRASS_CONTRAPOS",BOLZANO_WEIERSTRASS_CONTRAPOS; +"BOLZANO_WEIERSTRASS_IMP_BOUNDED",BOLZANO_WEIERSTRASS_IMP_BOUNDED; +"BOLZANO_WEIERSTRASS_IMP_CLOSED",BOLZANO_WEIERSTRASS_IMP_CLOSED; +"BOOL_CASES_AX",BOOL_CASES_AX; +"BORSUK_HOMOTOPY_EXTENSION",BORSUK_HOMOTOPY_EXTENSION; +"BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC",BORSUK_HOMOTOPY_EXTENSION_HOMOTOPIC; +"BOTTOM",BOTTOM; +"BOUNDED_ARC_IMAGE",BOUNDED_ARC_IMAGE; +"BOUNDED_BALL",BOUNDED_BALL; +"BOUNDED_CBALL",BOUNDED_CBALL; +"BOUNDED_CLOSED_CHAIN",BOUNDED_CLOSED_CHAIN; +"BOUNDED_CLOSED_IMP_COMPACT",BOUNDED_CLOSED_IMP_COMPACT; +"BOUNDED_CLOSED_INTERVAL",BOUNDED_CLOSED_INTERVAL; +"BOUNDED_CLOSED_NEST",BOUNDED_CLOSED_NEST; +"BOUNDED_CLOSURE",BOUNDED_CLOSURE; +"BOUNDED_CLOSURE_EQ",BOUNDED_CLOSURE_EQ; +"BOUNDED_COMPONENTWISE",BOUNDED_COMPONENTWISE; +"BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS",BOUNDED_COMPONENT_RETRACT_COMPLEMENT_MEETS; +"BOUNDED_CONVEX_HULL",BOUNDED_CONVEX_HULL; +"BOUNDED_CONVEX_HULL_EQ",BOUNDED_CONVEX_HULL_EQ; +"BOUNDED_DECREASING_CONVERGENT",BOUNDED_DECREASING_CONVERGENT; +"BOUNDED_DIFF",BOUNDED_DIFF; +"BOUNDED_DIFFS",BOUNDED_DIFFS; +"BOUNDED_EMPTY",BOUNDED_EMPTY; +"BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION",BOUNDED_EQUIINTEGRAL_OVER_THIN_TAGGED_PARTIAL_DIVISION; +"BOUNDED_EQ_BOLZANO_WEIERSTRASS",BOUNDED_EQ_BOLZANO_WEIERSTRASS; +"BOUNDED_FINITE",BOUNDED_FINITE; +"BOUNDED_FRONTIER",BOUNDED_FRONTIER; +"BOUNDED_FUNCTIONS_BIJECTIONS_1",BOUNDED_FUNCTIONS_BIJECTIONS_1; +"BOUNDED_FUNCTIONS_BIJECTIONS_2",BOUNDED_FUNCTIONS_BIJECTIONS_2; +"BOUNDED_HALFSPACE_GE",BOUNDED_HALFSPACE_GE; +"BOUNDED_HALFSPACE_GT",BOUNDED_HALFSPACE_GT; +"BOUNDED_HALFSPACE_LE",BOUNDED_HALFSPACE_LE; +"BOUNDED_HALFSPACE_LT",BOUNDED_HALFSPACE_LT; +"BOUNDED_HAS_INF",BOUNDED_HAS_INF; +"BOUNDED_HAS_SUP",BOUNDED_HAS_SUP; +"BOUNDED_HYPERPLANE_EQ_TRIVIAL",BOUNDED_HYPERPLANE_EQ_TRIVIAL; +"BOUNDED_INCREASING_CONVERGENT",BOUNDED_INCREASING_CONVERGENT; +"BOUNDED_INSERT",BOUNDED_INSERT; +"BOUNDED_INSIDE",BOUNDED_INSIDE; +"BOUNDED_INTEGRALS_OVER_SUBINTERVALS",BOUNDED_INTEGRALS_OVER_SUBINTERVALS; +"BOUNDED_INTER",BOUNDED_INTER; +"BOUNDED_INTERIOR",BOUNDED_INTERIOR; +"BOUNDED_INTERS",BOUNDED_INTERS; +"BOUNDED_INTERVAL",BOUNDED_INTERVAL; +"BOUNDED_LIFT",BOUNDED_LIFT; +"BOUNDED_LINEAR_IMAGE",BOUNDED_LINEAR_IMAGE; +"BOUNDED_LINEAR_IMAGE_EQ",BOUNDED_LINEAR_IMAGE_EQ; +"BOUNDED_NEGATIONS",BOUNDED_NEGATIONS; +"BOUNDED_PARTIAL_SUMS",BOUNDED_PARTIAL_SUMS; +"BOUNDED_PATH_IMAGE",BOUNDED_PATH_IMAGE; +"BOUNDED_PCROSS",BOUNDED_PCROSS; +"BOUNDED_PCROSS_EQ",BOUNDED_PCROSS_EQ; +"BOUNDED_POS",BOUNDED_POS; +"BOUNDED_POS_LT",BOUNDED_POS_LT; +"BOUNDED_RECTIFIABLE_PATH_IMAGE",BOUNDED_RECTIFIABLE_PATH_IMAGE; +"BOUNDED_RELATIVE_FRONTIER",BOUNDED_RELATIVE_FRONTIER; +"BOUNDED_SCALING",BOUNDED_SCALING; +"BOUNDED_SEGMENT",BOUNDED_SEGMENT; +"BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE; +"BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL",BOUNDED_SETVARIATION_ABSOLUTELY_INTEGRABLE_INTERVAL; +"BOUNDED_SIMPLE_PATH_IMAGE",BOUNDED_SIMPLE_PATH_IMAGE; +"BOUNDED_SING",BOUNDED_SING; +"BOUNDED_SPHERE",BOUNDED_SPHERE; +"BOUNDED_SUBSET",BOUNDED_SUBSET; +"BOUNDED_SUBSET_BALL",BOUNDED_SUBSET_BALL; +"BOUNDED_SUBSET_CBALL",BOUNDED_SUBSET_CBALL; +"BOUNDED_SUBSET_CLOSED_INTERVAL",BOUNDED_SUBSET_CLOSED_INTERVAL; +"BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC; +"BOUNDED_SUBSET_OPEN_INTERVAL",BOUNDED_SUBSET_OPEN_INTERVAL; +"BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC",BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC; +"BOUNDED_SUMS",BOUNDED_SUMS; +"BOUNDED_SUMS_IMAGE",BOUNDED_SUMS_IMAGE; +"BOUNDED_SUMS_IMAGES",BOUNDED_SUMS_IMAGES; +"BOUNDED_TRANSLATION",BOUNDED_TRANSLATION; +"BOUNDED_TRANSLATION_EQ",BOUNDED_TRANSLATION_EQ; +"BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE",BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE; +"BOUNDED_UNION",BOUNDED_UNION; +"BOUNDED_UNIONS",BOUNDED_UNIONS; +"BOUNDED_UNIQUE_OUTSIDE",BOUNDED_UNIQUE_OUTSIDE; +"BOUNDS_DIVIDED",BOUNDS_DIVIDED; +"BOUNDS_IGNORE",BOUNDS_IGNORE; +"BOUNDS_LINEAR",BOUNDS_LINEAR; +"BOUNDS_LINEAR_0",BOUNDS_LINEAR_0; +"BOUNDS_NOTZERO",BOUNDS_NOTZERO; +"BROUWER",BROUWER; +"BROUWER_ABSOLUTE_RETRACT",BROUWER_ABSOLUTE_RETRACT; +"BROUWER_ABSOLUTE_RETRACT_GEN",BROUWER_ABSOLUTE_RETRACT_GEN; +"BROUWER_AR",BROUWER_AR; +"BROUWER_BALL",BROUWER_BALL; +"BROUWER_COMPACTNESS_LEMMA",BROUWER_COMPACTNESS_LEMMA; +"BROUWER_CONTRACTIBLE_ANR",BROUWER_CONTRACTIBLE_ANR; +"BROUWER_CUBE",BROUWER_CUBE; +"BROUWER_FACTOR_THROUGH_AR",BROUWER_FACTOR_THROUGH_AR; +"BROUWER_INESSENTIAL_ANR",BROUWER_INESSENTIAL_ANR; +"BROUWER_REDUCTION_THEOREM",BROUWER_REDUCTION_THEOREM; +"BROUWER_REDUCTION_THEOREM_GEN",BROUWER_REDUCTION_THEOREM_GEN; +"BROUWER_SURJECTIVE",BROUWER_SURJECTIVE; +"BROUWER_SURJECTIVE_CBALL",BROUWER_SURJECTIVE_CBALL; +"BROUWER_WEAK",BROUWER_WEAK; +"BUTLAST",BUTLAST; +"CANTOR_BENDIXSON",CANTOR_BENDIXSON; +"CANTOR_THM",CANTOR_THM; +"CANTOR_THM_UNIV",CANTOR_THM_UNIV; +"CARATHEODORY",CARATHEODORY; +"CARATHEODORY_AFF_DIM",CARATHEODORY_AFF_DIM; +"CARD",CARD; +"CARD_ADD2_ABSORB_LE",CARD_ADD2_ABSORB_LE; +"CARD_ADD2_ABSORB_LT",CARD_ADD2_ABSORB_LT; +"CARD_ADD_ABSORB",CARD_ADD_ABSORB; +"CARD_ADD_ABSORB_LE",CARD_ADD_ABSORB_LE; +"CARD_ADD_ASSOC",CARD_ADD_ASSOC; +"CARD_ADD_C",CARD_ADD_C; +"CARD_ADD_CONG",CARD_ADD_CONG; +"CARD_ADD_FINITE",CARD_ADD_FINITE; +"CARD_ADD_FINITE_EQ",CARD_ADD_FINITE_EQ; +"CARD_ADD_LE_MUL_INFINITE",CARD_ADD_LE_MUL_INFINITE; +"CARD_ADD_SYM",CARD_ADD_SYM; +"CARD_ADD_SYMDIFF_INTER",CARD_ADD_SYMDIFF_INTER; +"CARD_BOOL",CARD_BOOL; +"CARD_CART_UNIV",CARD_CART_UNIV; +"CARD_CLAUSES",CARD_CLAUSES; +"CARD_COUNTABLE_CONG",CARD_COUNTABLE_CONG; +"CARD_CROSS",CARD_CROSS; +"CARD_DELETE",CARD_DELETE; +"CARD_DIFF",CARD_DIFF; +"CARD_DIFF_INTER",CARD_DIFF_INTER; +"CARD_DISJOINT_UNION",CARD_DISJOINT_UNION; +"CARD_EQ_0",CARD_EQ_0; +"CARD_EQ_ARC_IMAGE",CARD_EQ_ARC_IMAGE; +"CARD_EQ_BALL",CARD_EQ_BALL; +"CARD_EQ_BIJECTION",CARD_EQ_BIJECTION; +"CARD_EQ_BIJECTIONS",CARD_EQ_BIJECTIONS; +"CARD_EQ_CARD",CARD_EQ_CARD; +"CARD_EQ_CARD_IMP",CARD_EQ_CARD_IMP; +"CARD_EQ_CART",CARD_EQ_CART; +"CARD_EQ_CBALL",CARD_EQ_CBALL; +"CARD_EQ_CLOSED",CARD_EQ_CLOSED; +"CARD_EQ_CLOSED_SETS",CARD_EQ_CLOSED_SETS; +"CARD_EQ_COMPACT_SETS",CARD_EQ_COMPACT_SETS; +"CARD_EQ_CONDENSATION_POINTS",CARD_EQ_CONDENSATION_POINTS; +"CARD_EQ_CONDENSATION_POINTS_IN_SET",CARD_EQ_CONDENSATION_POINTS_IN_SET; +"CARD_EQ_CONG",CARD_EQ_CONG; +"CARD_EQ_CONNECTED",CARD_EQ_CONNECTED; +"CARD_EQ_CONVEX",CARD_EQ_CONVEX; +"CARD_EQ_COUNTABLE",CARD_EQ_COUNTABLE; +"CARD_EQ_COUNTABLE_SUBSETS_REAL",CARD_EQ_COUNTABLE_SUBSETS_REAL; +"CARD_EQ_COVERING_MAP_FIBRES",CARD_EQ_COVERING_MAP_FIBRES; +"CARD_EQ_DIM",CARD_EQ_DIM; +"CARD_EQ_EMPTY",CARD_EQ_EMPTY; +"CARD_EQ_EUCLIDEAN",CARD_EQ_EUCLIDEAN; +"CARD_EQ_FINITE",CARD_EQ_FINITE; +"CARD_EQ_FINITE_SUBSETS",CARD_EQ_FINITE_SUBSETS; +"CARD_EQ_IMAGE",CARD_EQ_IMAGE; +"CARD_EQ_IMP_LE",CARD_EQ_IMP_LE; +"CARD_EQ_INTEGER",CARD_EQ_INTEGER; +"CARD_EQ_INTERVAL",CARD_EQ_INTERVAL; +"CARD_EQ_LIST",CARD_EQ_LIST; +"CARD_EQ_LIST_GEN",CARD_EQ_LIST_GEN; +"CARD_EQ_NONEMPTY_INTERIOR",CARD_EQ_NONEMPTY_INTERIOR; +"CARD_EQ_NSUM",CARD_EQ_NSUM; +"CARD_EQ_OPEN",CARD_EQ_OPEN; +"CARD_EQ_OPEN_IN",CARD_EQ_OPEN_IN; +"CARD_EQ_OPEN_IN_AFFINE",CARD_EQ_OPEN_IN_AFFINE; +"CARD_EQ_OPEN_SETS",CARD_EQ_OPEN_SETS; +"CARD_EQ_PATH_CONNECTED",CARD_EQ_PATH_CONNECTED; +"CARD_EQ_PCROSS",CARD_EQ_PCROSS; +"CARD_EQ_PERFECT_SET",CARD_EQ_PERFECT_SET; +"CARD_EQ_RATIONAL",CARD_EQ_RATIONAL; +"CARD_EQ_REAL",CARD_EQ_REAL; +"CARD_EQ_REAL_IMP_UNCOUNTABLE",CARD_EQ_REAL_IMP_UNCOUNTABLE; +"CARD_EQ_REAL_SEQUENCES",CARD_EQ_REAL_SEQUENCES; +"CARD_EQ_REFL",CARD_EQ_REFL; +"CARD_EQ_SEGMENT",CARD_EQ_SEGMENT; +"CARD_EQ_SIMPLE_PATH_IMAGE",CARD_EQ_SIMPLE_PATH_IMAGE; +"CARD_EQ_SPHERE",CARD_EQ_SPHERE; +"CARD_EQ_SUM",CARD_EQ_SUM; +"CARD_EQ_SYM",CARD_EQ_SYM; +"CARD_EQ_TRANS",CARD_EQ_TRANS; +"CARD_FACES_OF_SIMPLEX",CARD_FACES_OF_SIMPLEX; +"CARD_FINITE_CONG",CARD_FINITE_CONG; +"CARD_FINITE_IMAGE",CARD_FINITE_IMAGE; +"CARD_FUNSPACE",CARD_FUNSPACE; +"CARD_FUNSPACE_CONG",CARD_FUNSPACE_CONG; +"CARD_FUNSPACE_CURRY",CARD_FUNSPACE_CURRY; +"CARD_FUNSPACE_LE",CARD_FUNSPACE_LE; +"CARD_FUNSPACE_UNIV",CARD_FUNSPACE_UNIV; +"CARD_GE_DIM_INDEPENDENT",CARD_GE_DIM_INDEPENDENT; +"CARD_HAS_SIZE_CONG",CARD_HAS_SIZE_CONG; +"CARD_IMAGE_EQ_INJ",CARD_IMAGE_EQ_INJ; +"CARD_IMAGE_INJ",CARD_IMAGE_INJ; +"CARD_IMAGE_INJ_EQ",CARD_IMAGE_INJ_EQ; +"CARD_IMAGE_LE",CARD_IMAGE_LE; +"CARD_INFINITE_CONG",CARD_INFINITE_CONG; +"CARD_INTSEG_INT",CARD_INTSEG_INT; +"CARD_LDISTRIB",CARD_LDISTRIB; +"CARD_LET_TOTAL",CARD_LET_TOTAL; +"CARD_LET_TRANS",CARD_LET_TRANS; +"CARD_LE_ADD",CARD_LE_ADD; +"CARD_LE_ADDL",CARD_LE_ADDL; +"CARD_LE_ADDR",CARD_LE_ADDR; +"CARD_LE_ANTISYM",CARD_LE_ANTISYM; +"CARD_LE_CARD",CARD_LE_CARD; +"CARD_LE_CARD_IMP",CARD_LE_CARD_IMP; +"CARD_LE_COMPONENTS",CARD_LE_COMPONENTS; +"CARD_LE_CONG",CARD_LE_CONG; +"CARD_LE_CONNECTED_COMPONENTS",CARD_LE_CONNECTED_COMPONENTS; +"CARD_LE_COUNTABLE",CARD_LE_COUNTABLE; +"CARD_LE_COUNTABLE_SUBSETS",CARD_LE_COUNTABLE_SUBSETS; +"CARD_LE_DIM_SPANNING",CARD_LE_DIM_SPANNING; +"CARD_LE_EMPTY",CARD_LE_EMPTY; +"CARD_LE_EQ_SUBSET",CARD_LE_EQ_SUBSET; +"CARD_LE_FINITE",CARD_LE_FINITE; +"CARD_LE_FINITE_SUBSETS",CARD_LE_FINITE_SUBSETS; +"CARD_LE_IMAGE",CARD_LE_IMAGE; +"CARD_LE_IMAGE_GEN",CARD_LE_IMAGE_GEN; +"CARD_LE_INFINITE",CARD_LE_INFINITE; +"CARD_LE_INJ",CARD_LE_INJ; +"CARD_LE_LIST",CARD_LE_LIST; +"CARD_LE_LT",CARD_LE_LT; +"CARD_LE_MUL",CARD_LE_MUL; +"CARD_LE_PATH_COMPONENTS",CARD_LE_PATH_COMPONENTS; +"CARD_LE_POWERSET",CARD_LE_POWERSET; +"CARD_LE_REFL",CARD_LE_REFL; +"CARD_LE_RELATIONAL",CARD_LE_RELATIONAL; +"CARD_LE_RELATIONAL_FULL",CARD_LE_RELATIONAL_FULL; +"CARD_LE_RETRACT_COMPLEMENT_COMPONENTS",CARD_LE_RETRACT_COMPLEMENT_COMPONENTS; +"CARD_LE_SQUARE",CARD_LE_SQUARE; +"CARD_LE_SUBPOWERSET",CARD_LE_SUBPOWERSET; +"CARD_LE_SUBSET",CARD_LE_SUBSET; +"CARD_LE_TOTAL",CARD_LE_TOTAL; +"CARD_LE_TRANS",CARD_LE_TRANS; +"CARD_LE_UNIV",CARD_LE_UNIV; +"CARD_LTE_TOTAL",CARD_LTE_TOTAL; +"CARD_LTE_TRANS",CARD_LTE_TRANS; +"CARD_LT_ADD",CARD_LT_ADD; +"CARD_LT_CARD",CARD_LT_CARD; +"CARD_LT_CONG",CARD_LT_CONG; +"CARD_LT_FINITE_INFINITE",CARD_LT_FINITE_INFINITE; +"CARD_LT_IMP_DISCONNECTED",CARD_LT_IMP_DISCONNECTED; +"CARD_LT_IMP_LE",CARD_LT_IMP_LE; +"CARD_LT_LE",CARD_LT_LE; +"CARD_LT_REFL",CARD_LT_REFL; +"CARD_LT_TOTAL",CARD_LT_TOTAL; +"CARD_LT_TRANS",CARD_LT_TRANS; +"CARD_MUL2_ABSORB_LE",CARD_MUL2_ABSORB_LE; +"CARD_MUL_ABSORB",CARD_MUL_ABSORB; +"CARD_MUL_ABSORB_LE",CARD_MUL_ABSORB_LE; +"CARD_MUL_ASSOC",CARD_MUL_ASSOC; +"CARD_MUL_CONG",CARD_MUL_CONG; +"CARD_MUL_FINITE",CARD_MUL_FINITE; +"CARD_MUL_LT_INFINITE",CARD_MUL_LT_INFINITE; +"CARD_MUL_LT_LEMMA",CARD_MUL_LT_LEMMA; +"CARD_MUL_SYM",CARD_MUL_SYM; +"CARD_NOT_LE",CARD_NOT_LE; +"CARD_NOT_LT",CARD_NOT_LT; +"CARD_NUMSEG",CARD_NUMSEG; +"CARD_NUMSEG_1",CARD_NUMSEG_1; +"CARD_NUMSEG_LE",CARD_NUMSEG_LE; +"CARD_NUMSEG_LEMMA",CARD_NUMSEG_LEMMA; +"CARD_NUMSEG_LT",CARD_NUMSEG_LT; +"CARD_PERMUTATIONS",CARD_PERMUTATIONS; +"CARD_POWERSET",CARD_POWERSET; +"CARD_PRODUCT",CARD_PRODUCT; +"CARD_PSUBSET",CARD_PSUBSET; +"CARD_RDISTRIB",CARD_RDISTRIB; +"CARD_SET_OF_LIST_LE",CARD_SET_OF_LIST_LE; +"CARD_SING",CARD_SING; +"CARD_SQUARE_INFINITE",CARD_SQUARE_INFINITE; +"CARD_SQUARE_NUM",CARD_SQUARE_NUM; +"CARD_STDBASIS",CARD_STDBASIS; +"CARD_SUBSET",CARD_SUBSET; +"CARD_SUBSET_EQ",CARD_SUBSET_EQ; +"CARD_SUBSET_IMAGE",CARD_SUBSET_IMAGE; +"CARD_SUBSET_LE",CARD_SUBSET_LE; +"CARD_UNION",CARD_UNION; +"CARD_UNIONS",CARD_UNIONS; +"CARD_UNIONS_LE",CARD_UNIONS_LE; +"CARD_UNION_EQ",CARD_UNION_EQ; +"CARD_UNION_GEN",CARD_UNION_GEN; +"CARD_UNION_LE",CARD_UNION_LE; +"CARD_UNION_LEMMA",CARD_UNION_LEMMA; +"CARD_UNION_OVERLAP",CARD_UNION_OVERLAP; +"CARD_UNION_OVERLAP_EQ",CARD_UNION_OVERLAP_EQ; +"CART_EQ",CART_EQ; +"CART_EQ_FULL",CART_EQ_FULL; +"CASEWISE",CASEWISE; +"CASEWISE_CASES",CASEWISE_CASES; +"CASEWISE_DEF",CASEWISE_DEF; +"CASEWISE_WORKS",CASEWISE_WORKS; +"CAUCHY",CAUCHY; +"CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE",CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE; +"CAUCHY_CONTINUOUS_IMP_CONTINUOUS",CAUCHY_CONTINUOUS_IMP_CONTINUOUS; +"CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA",CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA; +"CAUCHY_IMP_BOUNDED",CAUCHY_IMP_BOUNDED; +"CAUCHY_ISOMETRIC",CAUCHY_ISOMETRIC; +"CBALL_DIFF_BALL",CBALL_DIFF_BALL; +"CBALL_DIFF_SPHERE",CBALL_DIFF_SPHERE; +"CBALL_EMPTY",CBALL_EMPTY; +"CBALL_EQ_EMPTY",CBALL_EQ_EMPTY; +"CBALL_EQ_SING",CBALL_EQ_SING; +"CBALL_INTERVAL",CBALL_INTERVAL; +"CBALL_INTERVAL_0",CBALL_INTERVAL_0; +"CBALL_LINEAR_IMAGE",CBALL_LINEAR_IMAGE; +"CBALL_MAX_UNION",CBALL_MAX_UNION; +"CBALL_MIN_INTER",CBALL_MIN_INTER; +"CBALL_SCALING",CBALL_SCALING; +"CBALL_SING",CBALL_SING; +"CBALL_TRANSLATION",CBALL_TRANSLATION; +"CBALL_TRIVIAL",CBALL_TRIVIAL; +"CELL_COMPLEX_SUBDIVISION_EXISTS",CELL_COMPLEX_SUBDIVISION_EXISTS; +"CENTRE_IN_BALL",CENTRE_IN_BALL; +"CENTRE_IN_CBALL",CENTRE_IN_CBALL; +"CHAIN_SUBSET",CHAIN_SUBSET; +"CHARACTERISTIC_POLYNOMIAL",CHARACTERISTIC_POLYNOMIAL; +"CHOICE",CHOICE; +"CHOICE_DEF",CHOICE_DEF; +"CHOOSE_AFFINE_SUBSET",CHOOSE_AFFINE_SUBSET; +"CHOOSE_POLYTOPE",CHOOSE_POLYTOPE; +"CHOOSE_SIMPLEX",CHOOSE_SIMPLEX; +"CHOOSE_SUBSET",CHOOSE_SUBSET; +"CHOOSE_SUBSET_BETWEEN",CHOOSE_SUBSET_BETWEEN; +"CHOOSE_SUBSET_STRONG",CHOOSE_SUBSET_STRONG; +"CHOOSE_SUBSPACE_OF_SUBSPACE",CHOOSE_SUBSPACE_OF_SUBSPACE; +"CLOPEN",CLOPEN; +"CLOPEN_IN_COMPONENTS",CLOPEN_IN_COMPONENTS; +"CLOPEN_UNIONS_COMPONENTS",CLOPEN_UNIONS_COMPONENTS; +"CLOSED_AFFINE",CLOSED_AFFINE; +"CLOSED_AFFINE_HULL",CLOSED_AFFINE_HULL; +"CLOSED_APPROACHABLE",CLOSED_APPROACHABLE; +"CLOSED_ARC_IMAGE",CLOSED_ARC_IMAGE; +"CLOSED_AS_FRONTIER",CLOSED_AS_FRONTIER; +"CLOSED_AS_FRONTIER_OF_SUBSET",CLOSED_AS_FRONTIER_OF_SUBSET; +"CLOSED_AS_GDELTA",CLOSED_AS_GDELTA; +"CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE",CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE; +"CLOSED_CBALL",CLOSED_CBALL; +"CLOSED_CLOSURE",CLOSED_CLOSURE; +"CLOSED_COMPACT_DIFFERENCES",CLOSED_COMPACT_DIFFERENCES; +"CLOSED_COMPACT_PROJECTION",CLOSED_COMPACT_PROJECTION; +"CLOSED_COMPACT_SUMS",CLOSED_COMPACT_SUMS; +"CLOSED_COMPONENTS",CLOSED_COMPONENTS; +"CLOSED_CONDENSATION_POINTS",CLOSED_CONDENSATION_POINTS; +"CLOSED_CONNECTED_COMPONENT",CLOSED_CONNECTED_COMPONENT; +"CLOSED_CONTAINS_SEQUENTIAL_LIMIT",CLOSED_CONTAINS_SEQUENTIAL_LIMIT; +"CLOSED_CONVEX_CONE_HULL",CLOSED_CONVEX_CONE_HULL; +"CLOSED_DIFF",CLOSED_DIFF; +"CLOSED_DIFF_OPEN_INTERVAL_1",CLOSED_DIFF_OPEN_INTERVAL_1; +"CLOSED_EMPTY",CLOSED_EMPTY; +"CLOSED_FIP",CLOSED_FIP; +"CLOSED_FORALL",CLOSED_FORALL; +"CLOSED_FORALL_IN",CLOSED_FORALL_IN; +"CLOSED_HALFSPACE_COMPONENT_GE",CLOSED_HALFSPACE_COMPONENT_GE; +"CLOSED_HALFSPACE_COMPONENT_LE",CLOSED_HALFSPACE_COMPONENT_LE; +"CLOSED_HALFSPACE_GE",CLOSED_HALFSPACE_GE; +"CLOSED_HALFSPACE_LE",CLOSED_HALFSPACE_LE; +"CLOSED_HYPERPLANE",CLOSED_HYPERPLANE; +"CLOSED_IMP_FIP",CLOSED_IMP_FIP; +"CLOSED_IMP_FIP_COMPACT",CLOSED_IMP_FIP_COMPACT; +"CLOSED_IMP_LOCALLY_COMPACT",CLOSED_IMP_LOCALLY_COMPACT; +"CLOSED_IN",CLOSED_IN; +"CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE; +"CLOSED_INJECTIVE_IMAGE_SUBSPACE",CLOSED_INJECTIVE_IMAGE_SUBSPACE; +"CLOSED_INJECTIVE_LINEAR_IMAGE",CLOSED_INJECTIVE_LINEAR_IMAGE; +"CLOSED_INJECTIVE_LINEAR_IMAGE_EQ",CLOSED_INJECTIVE_LINEAR_IMAGE_EQ; +"CLOSED_INSERT",CLOSED_INSERT; +"CLOSED_INTER",CLOSED_INTER; +"CLOSED_INTERS",CLOSED_INTERS; +"CLOSED_INTERS_COMPACT",CLOSED_INTERS_COMPACT; +"CLOSED_INTERVAL",CLOSED_INTERVAL; +"CLOSED_INTERVAL_AS_CONVEX_HULL",CLOSED_INTERVAL_AS_CONVEX_HULL; +"CLOSED_INTERVAL_EQ",CLOSED_INTERVAL_EQ; +"CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL",CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL; +"CLOSED_INTERVAL_LEFT",CLOSED_INTERVAL_LEFT; +"CLOSED_INTERVAL_RIGHT",CLOSED_INTERVAL_RIGHT; +"CLOSED_INTER_COMPACT",CLOSED_INTER_COMPACT; +"CLOSED_IN_CLOSED",CLOSED_IN_CLOSED; +"CLOSED_IN_CLOSED_EQ",CLOSED_IN_CLOSED_EQ; +"CLOSED_IN_CLOSED_INTER",CLOSED_IN_CLOSED_INTER; +"CLOSED_IN_CLOSED_TRANS",CLOSED_IN_CLOSED_TRANS; +"CLOSED_IN_COMPACT",CLOSED_IN_COMPACT; +"CLOSED_IN_COMPACT_EQ",CLOSED_IN_COMPACT_EQ; +"CLOSED_IN_COMPACT_PROJECTION",CLOSED_IN_COMPACT_PROJECTION; +"CLOSED_IN_COMPONENT",CLOSED_IN_COMPONENT; +"CLOSED_IN_CONNECTED_COMPONENT",CLOSED_IN_CONNECTED_COMPONENT; +"CLOSED_IN_DIFF",CLOSED_IN_DIFF; +"CLOSED_IN_EMPTY",CLOSED_IN_EMPTY; +"CLOSED_IN_IMP_SUBSET",CLOSED_IN_IMP_SUBSET; +"CLOSED_IN_INJECTIVE_LINEAR_IMAGE",CLOSED_IN_INJECTIVE_LINEAR_IMAGE; +"CLOSED_IN_INTER",CLOSED_IN_INTER; +"CLOSED_IN_INTERS",CLOSED_IN_INTERS; +"CLOSED_IN_INTER_CLOSED",CLOSED_IN_INTER_CLOSED; +"CLOSED_IN_INTER_CLOSURE",CLOSED_IN_INTER_CLOSURE; +"CLOSED_IN_LIMPT",CLOSED_IN_LIMPT; +"CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; +"CLOSED_IN_PCROSS",CLOSED_IN_PCROSS; +"CLOSED_IN_PCROSS_EQ",CLOSED_IN_PCROSS_EQ; +"CLOSED_IN_REFL",CLOSED_IN_REFL; +"CLOSED_IN_RETRACT",CLOSED_IN_RETRACT; +"CLOSED_IN_SING",CLOSED_IN_SING; +"CLOSED_IN_SUBSET",CLOSED_IN_SUBSET; +"CLOSED_IN_SUBSET_TRANS",CLOSED_IN_SUBSET_TRANS; +"CLOSED_IN_SUBTOPOLOGY",CLOSED_IN_SUBTOPOLOGY; +"CLOSED_IN_SUBTOPOLOGY_EMPTY",CLOSED_IN_SUBTOPOLOGY_EMPTY; +"CLOSED_IN_SUBTOPOLOGY_REFL",CLOSED_IN_SUBTOPOLOGY_REFL; +"CLOSED_IN_SUBTOPOLOGY_UNION",CLOSED_IN_SUBTOPOLOGY_UNION; +"CLOSED_IN_TOPSPACE",CLOSED_IN_TOPSPACE; +"CLOSED_IN_TRANS",CLOSED_IN_TRANS; +"CLOSED_IN_TRANSLATION_EQ",CLOSED_IN_TRANSLATION_EQ; +"CLOSED_IN_TRANS_EQ",CLOSED_IN_TRANS_EQ; +"CLOSED_IN_UNION",CLOSED_IN_UNION; +"CLOSED_IN_UNIONS",CLOSED_IN_UNIONS; +"CLOSED_IN_UNION_COMPLEMENT_COMPONENT",CLOSED_IN_UNION_COMPLEMENT_COMPONENT; +"CLOSED_IN_UNION_COMPLEMENT_COMPONENTS",CLOSED_IN_UNION_COMPLEMENT_COMPONENTS; +"CLOSED_IRREDUCIBLE_SEPARATOR",CLOSED_IRREDUCIBLE_SEPARATOR; +"CLOSED_LIFT",CLOSED_LIFT; +"CLOSED_LIMPT",CLOSED_LIMPT; +"CLOSED_LIMPTS",CLOSED_LIMPTS; +"CLOSED_MAP_FROM_COMPOSITION_INJECTIVE",CLOSED_MAP_FROM_COMPOSITION_INJECTIVE; +"CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE",CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE; +"CLOSED_MAP_FSTCART",CLOSED_MAP_FSTCART; +"CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE",CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE; +"CLOSED_MAP_IMP_OPEN_MAP",CLOSED_MAP_IMP_OPEN_MAP; +"CLOSED_MAP_IMP_QUOTIENT_MAP",CLOSED_MAP_IMP_QUOTIENT_MAP; +"CLOSED_MAP_OPEN_SUPERSET_PREIMAGE",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE; +"CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ; +"CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT",CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT; +"CLOSED_MAP_RESTRICT",CLOSED_MAP_RESTRICT; +"CLOSED_MAP_SNDCART",CLOSED_MAP_SNDCART; +"CLOSED_NEGATIONS",CLOSED_NEGATIONS; +"CLOSED_OPEN_INTERVAL_1",CLOSED_OPEN_INTERVAL_1; +"CLOSED_PATH_IMAGE",CLOSED_PATH_IMAGE; +"CLOSED_PCROSS",CLOSED_PCROSS; +"CLOSED_PCROSS_EQ",CLOSED_PCROSS_EQ; +"CLOSED_POSITIVE_ORTHANT",CLOSED_POSITIVE_ORTHANT; +"CLOSED_RELATIVE_BOUNDARY",CLOSED_RELATIVE_BOUNDARY; +"CLOSED_RELATIVE_FRONTIER",CLOSED_RELATIVE_FRONTIER; +"CLOSED_SCALING",CLOSED_SCALING; +"CLOSED_SEGMENT",CLOSED_SEGMENT; +"CLOSED_SEGMENT_LINEAR_IMAGE",CLOSED_SEGMENT_LINEAR_IMAGE; +"CLOSED_SEQUENTIAL_LIMITS",CLOSED_SEQUENTIAL_LIMITS; +"CLOSED_SHIFTPATH",CLOSED_SHIFTPATH; +"CLOSED_SIMPLEX",CLOSED_SIMPLEX; +"CLOSED_SIMPLE_PATH_IMAGE",CLOSED_SIMPLE_PATH_IMAGE; +"CLOSED_SING",CLOSED_SING; +"CLOSED_SPAN",CLOSED_SPAN; +"CLOSED_SPHERE",CLOSED_SPHERE; +"CLOSED_STANDARD_HYPERPLANE",CLOSED_STANDARD_HYPERPLANE; +"CLOSED_SUBSET",CLOSED_SUBSET; +"CLOSED_SUBSET_EQ",CLOSED_SUBSET_EQ; +"CLOSED_SUBSPACE",CLOSED_SUBSPACE; +"CLOSED_SUBSTANDARD",CLOSED_SUBSTANDARD; +"CLOSED_TRANSLATION",CLOSED_TRANSLATION; +"CLOSED_TRANSLATION_EQ",CLOSED_TRANSLATION_EQ; +"CLOSED_UNION",CLOSED_UNION; +"CLOSED_UNIONS",CLOSED_UNIONS; +"CLOSED_UNION_COMPACT_SUBSETS",CLOSED_UNION_COMPACT_SUBSETS; +"CLOSED_UNION_COMPLEMENT_COMPONENT",CLOSED_UNION_COMPLEMENT_COMPONENT; +"CLOSED_UNION_COMPLEMENT_COMPONENTS",CLOSED_UNION_COMPLEMENT_COMPONENTS; +"CLOSED_UNIV",CLOSED_UNIV; +"CLOSER_POINTS_LEMMA",CLOSER_POINTS_LEMMA; +"CLOSER_POINT_LEMMA",CLOSER_POINT_LEMMA; +"CLOSEST_POINT_AFFINE_ORTHOGONAL",CLOSEST_POINT_AFFINE_ORTHOGONAL; +"CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ",CLOSEST_POINT_AFFINE_ORTHOGONAL_EQ; +"CLOSEST_POINT_DOT",CLOSEST_POINT_DOT; +"CLOSEST_POINT_EXISTS",CLOSEST_POINT_EXISTS; +"CLOSEST_POINT_IN_FRONTIER",CLOSEST_POINT_IN_FRONTIER; +"CLOSEST_POINT_IN_INTERIOR",CLOSEST_POINT_IN_INTERIOR; +"CLOSEST_POINT_IN_RELATIVE_FRONTIER",CLOSEST_POINT_IN_RELATIVE_FRONTIER; +"CLOSEST_POINT_IN_RELATIVE_INTERIOR",CLOSEST_POINT_IN_RELATIVE_INTERIOR; +"CLOSEST_POINT_IN_SET",CLOSEST_POINT_IN_SET; +"CLOSEST_POINT_LE",CLOSEST_POINT_LE; +"CLOSEST_POINT_LIPSCHITZ",CLOSEST_POINT_LIPSCHITZ; +"CLOSEST_POINT_LT",CLOSEST_POINT_LT; +"CLOSEST_POINT_REFL",CLOSEST_POINT_REFL; +"CLOSEST_POINT_SELF",CLOSEST_POINT_SELF; +"CLOSEST_POINT_UNIQUE",CLOSEST_POINT_UNIQUE; +"CLOSURE_APPROACHABLE",CLOSURE_APPROACHABLE; +"CLOSURE_BALL",CLOSURE_BALL; +"CLOSURE_BOUNDED_LINEAR_IMAGE",CLOSURE_BOUNDED_LINEAR_IMAGE; +"CLOSURE_CLOSED",CLOSURE_CLOSED; +"CLOSURE_CLOSURE",CLOSURE_CLOSURE; +"CLOSURE_COCOUNTABLE_COORDINATES",CLOSURE_COCOUNTABLE_COORDINATES; +"CLOSURE_COMPLEMENT",CLOSURE_COMPLEMENT; +"CLOSURE_CONVEX_HULL",CLOSURE_CONVEX_HULL; +"CLOSURE_CONVEX_INTER_AFFINE",CLOSURE_CONVEX_INTER_AFFINE; +"CLOSURE_CONVEX_INTER_SUPERSET",CLOSURE_CONVEX_INTER_SUPERSET; +"CLOSURE_COSMALL_COORDINATES",CLOSURE_COSMALL_COORDINATES; +"CLOSURE_DYADIC_RATIONALS",CLOSURE_DYADIC_RATIONALS; +"CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET",CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET; +"CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET",CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET; +"CLOSURE_EMPTY",CLOSURE_EMPTY; +"CLOSURE_EQ",CLOSURE_EQ; +"CLOSURE_EQ_EMPTY",CLOSURE_EQ_EMPTY; +"CLOSURE_HALFSPACE_COMPONENT_GT",CLOSURE_HALFSPACE_COMPONENT_GT; +"CLOSURE_HALFSPACE_COMPONENT_LT",CLOSURE_HALFSPACE_COMPONENT_LT; +"CLOSURE_HALFSPACE_GT",CLOSURE_HALFSPACE_GT; +"CLOSURE_HALFSPACE_LT",CLOSURE_HALFSPACE_LT; +"CLOSURE_HULL",CLOSURE_HULL; +"CLOSURE_IMAGE_BOUNDED",CLOSURE_IMAGE_BOUNDED; +"CLOSURE_IMAGE_CLOSURE",CLOSURE_IMAGE_CLOSURE; +"CLOSURE_INJECTIVE_LINEAR_IMAGE",CLOSURE_INJECTIVE_LINEAR_IMAGE; +"CLOSURE_INSIDE_SUBSET",CLOSURE_INSIDE_SUBSET; +"CLOSURE_INTERIOR",CLOSURE_INTERIOR; +"CLOSURE_INTERIOR_IDEMP",CLOSURE_INTERIOR_IDEMP; +"CLOSURE_INTERIOR_UNION_CLOSED",CLOSURE_INTERIOR_UNION_CLOSED; +"CLOSURE_INTERS_CONVEX",CLOSURE_INTERS_CONVEX; +"CLOSURE_INTERS_CONVEX_OPEN",CLOSURE_INTERS_CONVEX_OPEN; +"CLOSURE_INTERS_SUBSET",CLOSURE_INTERS_SUBSET; +"CLOSURE_INTERVAL",CLOSURE_INTERVAL; +"CLOSURE_INTER_CONVEX",CLOSURE_INTER_CONVEX; +"CLOSURE_INTER_CONVEX_OPEN",CLOSURE_INTER_CONVEX_OPEN; +"CLOSURE_INTER_SUBSET",CLOSURE_INTER_SUBSET; +"CLOSURE_IRRATIONAL_COORDINATES",CLOSURE_IRRATIONAL_COORDINATES; +"CLOSURE_LINEAR_IMAGE_SUBSET",CLOSURE_LINEAR_IMAGE_SUBSET; +"CLOSURE_MINIMAL",CLOSURE_MINIMAL; +"CLOSURE_MINIMAL_EQ",CLOSURE_MINIMAL_EQ; +"CLOSURE_NEGATIONS",CLOSURE_NEGATIONS; +"CLOSURE_OPEN_INTERVAL",CLOSURE_OPEN_INTERVAL; +"CLOSURE_OPEN_INTER_SUPERSET",CLOSURE_OPEN_INTER_SUPERSET; +"CLOSURE_OUTSIDE_SUBSET",CLOSURE_OUTSIDE_SUBSET; +"CLOSURE_PCROSS",CLOSURE_PCROSS; +"CLOSURE_RATIONALS_IN_CONVEX_SET",CLOSURE_RATIONALS_IN_CONVEX_SET; +"CLOSURE_RATIONALS_IN_OPEN_SET",CLOSURE_RATIONALS_IN_OPEN_SET; +"CLOSURE_RATIONAL_COORDINATES",CLOSURE_RATIONAL_COORDINATES; +"CLOSURE_SEGMENT",CLOSURE_SEGMENT; +"CLOSURE_SEQUENTIAL",CLOSURE_SEQUENTIAL; +"CLOSURE_SING",CLOSURE_SING; +"CLOSURE_SUBSET",CLOSURE_SUBSET; +"CLOSURE_SUBSET_AFFINE_HULL",CLOSURE_SUBSET_AFFINE_HULL; +"CLOSURE_SUBSET_EQ",CLOSURE_SUBSET_EQ; +"CLOSURE_SUMS",CLOSURE_SUMS; +"CLOSURE_SURJECTIVE_LINEAR_IMAGE",CLOSURE_SURJECTIVE_LINEAR_IMAGE; +"CLOSURE_TRANSLATION",CLOSURE_TRANSLATION; +"CLOSURE_UNION",CLOSURE_UNION; +"CLOSURE_UNIONS",CLOSURE_UNIONS; +"CLOSURE_UNION_FRONTIER",CLOSURE_UNION_FRONTIER; +"CLOSURE_UNIQUE",CLOSURE_UNIQUE; +"CLOSURE_UNIV",CLOSURE_UNIV; +"COBOUNDED_HAS_BOUNDED_COMPONENT",COBOUNDED_HAS_BOUNDED_COMPONENT; +"COBOUNDED_IMP_UNBOUNDED",COBOUNDED_IMP_UNBOUNDED; +"COBOUNDED_INTER_UNBOUNDED",COBOUNDED_INTER_UNBOUNDED; +"COBOUNDED_OUTSIDE",COBOUNDED_OUTSIDE; +"COBOUNDED_UNBOUNDED_COMPONENT",COBOUNDED_UNBOUNDED_COMPONENT; +"COBOUNDED_UNBOUNDED_COMPONENTS",COBOUNDED_UNBOUNDED_COMPONENTS; +"COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT; +"COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS",COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS; +"COCOUNTABLE_APPROXIMATION",COCOUNTABLE_APPROXIMATION; +"CODESET_SETCODE_BIJECTIONS",CODESET_SETCODE_BIJECTIONS; +"COFACTOR_0",COFACTOR_0; +"COFACTOR_CMUL",COFACTOR_CMUL; +"COFACTOR_COFACTOR",COFACTOR_COFACTOR; +"COFACTOR_COLUMN",COFACTOR_COLUMN; +"COFACTOR_EQ_0",COFACTOR_EQ_0; +"COFACTOR_I",COFACTOR_I; +"COFACTOR_MATRIX_INV",COFACTOR_MATRIX_INV; +"COFACTOR_MATRIX_MUL",COFACTOR_MATRIX_MUL; +"COFACTOR_ROW",COFACTOR_ROW; +"COFACTOR_TRANSP",COFACTOR_TRANSP; +"COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS; +"COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL",COHOMOTOPICALLY_TRIVIAL_ON_COMPONENTS_NULL; +"COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; +"COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; +"COLLINEAR_1",COLLINEAR_1; +"COLLINEAR_2",COLLINEAR_2; +"COLLINEAR_3",COLLINEAR_3; +"COLLINEAR_3_2D",COLLINEAR_3_2D; +"COLLINEAR_3_AFFINE_HULL",COLLINEAR_3_AFFINE_HULL; +"COLLINEAR_3_DOT_MULTIPLES",COLLINEAR_3_DOT_MULTIPLES; +"COLLINEAR_3_EQ_AFFINE_DEPENDENT",COLLINEAR_3_EQ_AFFINE_DEPENDENT; +"COLLINEAR_3_EXPAND",COLLINEAR_3_EXPAND; +"COLLINEAR_3_IN_AFFINE_HULL",COLLINEAR_3_IN_AFFINE_HULL; +"COLLINEAR_3_TRANS",COLLINEAR_3_TRANS; +"COLLINEAR_4_3",COLLINEAR_4_3; +"COLLINEAR_AFFINE_HULL",COLLINEAR_AFFINE_HULL; +"COLLINEAR_AFFINE_HULL_COLLINEAR",COLLINEAR_AFFINE_HULL_COLLINEAR; +"COLLINEAR_AFF_DIM",COLLINEAR_AFF_DIM; +"COLLINEAR_BETWEEN_CASES",COLLINEAR_BETWEEN_CASES; +"COLLINEAR_CONVEX_HULL_COLLINEAR",COLLINEAR_CONVEX_HULL_COLLINEAR; +"COLLINEAR_DIST_BETWEEN",COLLINEAR_DIST_BETWEEN; +"COLLINEAR_DIST_IN_CLOSED_SEGMENT",COLLINEAR_DIST_IN_CLOSED_SEGMENT; +"COLLINEAR_DIST_IN_OPEN_SEGMENT",COLLINEAR_DIST_IN_OPEN_SEGMENT; +"COLLINEAR_EMPTY",COLLINEAR_EMPTY; +"COLLINEAR_EXTREME_POINTS",COLLINEAR_EXTREME_POINTS; +"COLLINEAR_IMP_COPLANAR",COLLINEAR_IMP_COPLANAR; +"COLLINEAR_LEMMA",COLLINEAR_LEMMA; +"COLLINEAR_LEMMA_ALT",COLLINEAR_LEMMA_ALT; +"COLLINEAR_LINEAR_IMAGE",COLLINEAR_LINEAR_IMAGE; +"COLLINEAR_LINEAR_IMAGE_EQ",COLLINEAR_LINEAR_IMAGE_EQ; +"COLLINEAR_MIDPOINT",COLLINEAR_MIDPOINT; +"COLLINEAR_SEGMENT",COLLINEAR_SEGMENT; +"COLLINEAR_SING",COLLINEAR_SING; +"COLLINEAR_SMALL",COLLINEAR_SMALL; +"COLLINEAR_SUBSET",COLLINEAR_SUBSET; +"COLLINEAR_TRANSLATION",COLLINEAR_TRANSLATION; +"COLLINEAR_TRANSLATION_EQ",COLLINEAR_TRANSLATION_EQ; +"COLLINEAR_TRIPLES",COLLINEAR_TRIPLES; +"COLUMNS_IMAGE_BASIS",COLUMNS_IMAGE_BASIS; +"COLUMNS_TRANSP",COLUMNS_TRANSP; +"COLUMN_TRANSP",COLUMN_TRANSP; +"COMMA_DEF",COMMA_DEF; +"COMPACT_AFFINITY",COMPACT_AFFINITY; +"COMPACT_AR",COMPACT_AR; +"COMPACT_ARC_IMAGE",COMPACT_ARC_IMAGE; +"COMPACT_ATTAINS_INF",COMPACT_ATTAINS_INF; +"COMPACT_ATTAINS_SUP",COMPACT_ATTAINS_SUP; +"COMPACT_CBALL",COMPACT_CBALL; +"COMPACT_CHAIN",COMPACT_CHAIN; +"COMPACT_CLOSED_DIFFERENCES",COMPACT_CLOSED_DIFFERENCES; +"COMPACT_CLOSED_SUMS",COMPACT_CLOSED_SUMS; +"COMPACT_CLOSURE",COMPACT_CLOSURE; +"COMPACT_COMPONENTS",COMPACT_COMPONENTS; +"COMPACT_CONTINUOUS_IMAGE",COMPACT_CONTINUOUS_IMAGE; +"COMPACT_CONTINUOUS_IMAGE_EQ",COMPACT_CONTINUOUS_IMAGE_EQ; +"COMPACT_CONVEX_COLLINEAR_SEGMENT",COMPACT_CONVEX_COLLINEAR_SEGMENT; +"COMPACT_CONVEX_COMBINATIONS",COMPACT_CONVEX_COMBINATIONS; +"COMPACT_CONVEX_HULL",COMPACT_CONVEX_HULL; +"COMPACT_DIFF",COMPACT_DIFF; +"COMPACT_DIFFERENCES",COMPACT_DIFFERENCES; +"COMPACT_EMPTY",COMPACT_EMPTY; +"COMPACT_EQ_BOLZANO_WEIERSTRASS",COMPACT_EQ_BOLZANO_WEIERSTRASS; +"COMPACT_EQ_BOUNDED_CLOSED",COMPACT_EQ_BOUNDED_CLOSED; +"COMPACT_EQ_HEINE_BOREL",COMPACT_EQ_HEINE_BOREL; +"COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY",COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY; +"COMPACT_FIP",COMPACT_FIP; +"COMPACT_FRONTIER",COMPACT_FRONTIER; +"COMPACT_FRONTIER_BOUNDED",COMPACT_FRONTIER_BOUNDED; +"COMPACT_FRONTIER_LINE_LEMMA",COMPACT_FRONTIER_LINE_LEMMA; +"COMPACT_IMP_BOUNDED",COMPACT_IMP_BOUNDED; +"COMPACT_IMP_CLOSED",COMPACT_IMP_CLOSED; +"COMPACT_IMP_COMPLETE",COMPACT_IMP_COMPLETE; +"COMPACT_IMP_FIP",COMPACT_IMP_FIP; +"COMPACT_IMP_HEINE_BOREL",COMPACT_IMP_HEINE_BOREL; +"COMPACT_IMP_TOTALLY_BOUNDED",COMPACT_IMP_TOTALLY_BOUNDED; +"COMPACT_INSERT",COMPACT_INSERT; +"COMPACT_INTER",COMPACT_INTER; +"COMPACT_INTERS",COMPACT_INTERS; +"COMPACT_INTERVAL",COMPACT_INTERVAL; +"COMPACT_INTERVAL_EQ",COMPACT_INTERVAL_EQ; +"COMPACT_INTER_CLOSED",COMPACT_INTER_CLOSED; +"COMPACT_LEMMA",COMPACT_LEMMA; +"COMPACT_LINEAR_IMAGE",COMPACT_LINEAR_IMAGE; +"COMPACT_LINEAR_IMAGE_EQ",COMPACT_LINEAR_IMAGE_EQ; +"COMPACT_NEGATIONS",COMPACT_NEGATIONS; +"COMPACT_NEST",COMPACT_NEST; +"COMPACT_OPEN",COMPACT_OPEN; +"COMPACT_PATH_IMAGE",COMPACT_PATH_IMAGE; +"COMPACT_PCROSS",COMPACT_PCROSS; +"COMPACT_PCROSS_EQ",COMPACT_PCROSS_EQ; +"COMPACT_REAL_LEMMA",COMPACT_REAL_LEMMA; +"COMPACT_RELATIVE_BOUNDARY",COMPACT_RELATIVE_BOUNDARY; +"COMPACT_RELATIVE_FRONTIER",COMPACT_RELATIVE_FRONTIER; +"COMPACT_RELATIVE_FRONTIER_BOUNDED",COMPACT_RELATIVE_FRONTIER_BOUNDED; +"COMPACT_SCALING",COMPACT_SCALING; +"COMPACT_SEGMENT",COMPACT_SEGMENT; +"COMPACT_SEQUENCE_WITH_LIMIT",COMPACT_SEQUENCE_WITH_LIMIT; +"COMPACT_SIMPLEX",COMPACT_SIMPLEX; +"COMPACT_SIMPLE_PATH_IMAGE",COMPACT_SIMPLE_PATH_IMAGE; +"COMPACT_SING",COMPACT_SING; +"COMPACT_SPHERE",COMPACT_SPHERE; +"COMPACT_SUBSET_FRONTIER_RETRACTION",COMPACT_SUBSET_FRONTIER_RETRACTION; +"COMPACT_SUMS",COMPACT_SUMS; +"COMPACT_SUP_MAXDISTANCE",COMPACT_SUP_MAXDISTANCE; +"COMPACT_TRANSLATION",COMPACT_TRANSLATION; +"COMPACT_TRANSLATION_EQ",COMPACT_TRANSLATION_EQ; +"COMPACT_UNIFORMLY_CONTINUOUS",COMPACT_UNIFORMLY_CONTINUOUS; +"COMPACT_UNIFORMLY_EQUICONTINUOUS",COMPACT_UNIFORMLY_EQUICONTINUOUS; +"COMPACT_UNION",COMPACT_UNION; +"COMPACT_UNIONS",COMPACT_UNIONS; +"COMPLEMENT_CONNECTED_COMPONENT_UNIONS",COMPLEMENT_CONNECTED_COMPONENT_UNIONS; +"COMPLEMENT_PATH_COMPONENT_UNIONS",COMPLEMENT_PATH_COMPONENT_UNIONS; +"COMPLETE_EQ_CLOSED",COMPLETE_EQ_CLOSED; +"COMPLETE_FACE_TOP",COMPLETE_FACE_TOP; +"COMPLETE_INJECTIVE_LINEAR_IMAGE",COMPLETE_INJECTIVE_LINEAR_IMAGE; +"COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ",COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ; +"COMPLETE_ISOMETRIC_IMAGE",COMPLETE_ISOMETRIC_IMAGE; +"COMPLETE_SUBSPACE",COMPLETE_SUBSPACE; +"COMPLETE_TRANSLATION_EQ",COMPLETE_TRANSLATION_EQ; +"COMPLETE_UNIV",COMPLETE_UNIV; +"COMPONENT",COMPONENT; +"COMPONENTS_EMPTY",COMPONENTS_EMPTY; +"COMPONENTS_EQ",COMPONENTS_EQ; +"COMPONENTS_EQ_EMPTY",COMPONENTS_EQ_EMPTY; +"COMPONENTS_EQ_SING",COMPONENTS_EQ_SING; +"COMPONENTS_EQ_SING_EXISTS",COMPONENTS_EQ_SING_EXISTS; +"COMPONENTS_INTERMEDIATE_SUBSET",COMPONENTS_INTERMEDIATE_SUBSET; +"COMPONENTS_LINEAR_IMAGE",COMPONENTS_LINEAR_IMAGE; +"COMPONENTS_MAXIMAL",COMPONENTS_MAXIMAL; +"COMPONENTS_NONOVERLAP",COMPONENTS_NONOVERLAP; +"COMPONENTS_OPEN_UNIQUE",COMPONENTS_OPEN_UNIQUE; +"COMPONENTS_TRANSLATION",COMPONENTS_TRANSLATION; +"COMPONENTS_UNIQUE",COMPONENTS_UNIQUE; +"COMPONENTS_UNIQUE_EQ",COMPONENTS_UNIQUE_EQ; +"COMPONENTS_UNIV",COMPONENTS_UNIV; +"COMPONENT_COMPLEMENT_CONNECTED",COMPONENT_COMPLEMENT_CONNECTED; +"COMPONENT_LE_INFNORM",COMPONENT_LE_INFNORM; +"COMPONENT_LE_NORM",COMPONENT_LE_NORM; +"COMPONENT_LE_ONORM",COMPONENT_LE_ONORM; +"COMPONENT_RETRACT_COMPLEMENT_MEETS",COMPONENT_RETRACT_COMPLEMENT_MEETS; +"CONDENSATION_POINTS_EQ_EMPTY",CONDENSATION_POINTS_EQ_EMPTY; +"CONDENSATION_POINT_IMP_LIMPT",CONDENSATION_POINT_IMP_LIMPT; +"CONDENSATION_POINT_INFINITE_BALL",CONDENSATION_POINT_INFINITE_BALL; +"CONDENSATION_POINT_INFINITE_CBALL",CONDENSATION_POINT_INFINITE_CBALL; +"CONDENSATION_POINT_OF_CONDENSATION_POINTS",CONDENSATION_POINT_OF_CONDENSATION_POINTS; +"CONDENSATION_POINT_OF_SUBSET",CONDENSATION_POINT_OF_SUBSET; +"COND_ABS",COND_ABS; +"COND_CLAUSES",COND_CLAUSES; +"COND_COMPONENT",COND_COMPONENT; +"COND_DEF",COND_DEF; +"COND_ELIM_THM",COND_ELIM_THM; +"COND_EXPAND",COND_EXPAND; +"COND_ID",COND_ID; +"COND_RAND",COND_RAND; +"COND_RATOR",COND_RATOR; +"CONGRUENT_IMAGE_STD_SIMPLEX",CONGRUENT_IMAGE_STD_SIMPLEX; +"CONIC_CONIC_HULL",CONIC_CONIC_HULL; +"CONIC_CONTAINS_0",CONIC_CONTAINS_0; +"CONIC_CONVEX_CONE_HULL",CONIC_CONVEX_CONE_HULL; +"CONIC_EMPTY",CONIC_EMPTY; +"CONIC_HALFSPACE_GE",CONIC_HALFSPACE_GE; +"CONIC_HALFSPACE_LE",CONIC_HALFSPACE_LE; +"CONIC_HULL_EMPTY",CONIC_HULL_EMPTY; +"CONIC_HULL_EQ",CONIC_HULL_EQ; +"CONIC_HULL_EQ_EMPTY",CONIC_HULL_EQ_EMPTY; +"CONIC_HULL_EXPLICIT",CONIC_HULL_EXPLICIT; +"CONIC_HULL_LINEAR_IMAGE",CONIC_HULL_LINEAR_IMAGE; +"CONIC_HULL_SUBSET_CONVEX_CONE_HULL",CONIC_HULL_SUBSET_CONVEX_CONE_HULL; +"CONIC_INTERS",CONIC_INTERS; +"CONIC_LINEAR_IMAGE",CONIC_LINEAR_IMAGE; +"CONIC_LINEAR_IMAGE_EQ",CONIC_LINEAR_IMAGE_EQ; +"CONIC_NEGATIONS",CONIC_NEGATIONS; +"CONIC_PCROSS",CONIC_PCROSS; +"CONIC_PCROSS_EQ",CONIC_PCROSS_EQ; +"CONIC_POSITIVE_ORTHANT",CONIC_POSITIVE_ORTHANT; +"CONIC_SPAN",CONIC_SPAN; +"CONIC_SUMS",CONIC_SUMS; +"CONIC_UNIV",CONIC_UNIV; +"CONJ_ACI",CONJ_ACI; +"CONJ_ASSOC",CONJ_ASSOC; +"CONJ_SYM",CONJ_SYM; +"CONNECTED_ANNULUS",CONNECTED_ANNULUS; +"CONNECTED_ARC_COMPLEMENT",CONNECTED_ARC_COMPLEMENT; +"CONNECTED_ARC_IMAGE",CONNECTED_ARC_IMAGE; +"CONNECTED_BALL",CONNECTED_BALL; +"CONNECTED_CARD_EQ_IFF_NONTRIVIAL",CONNECTED_CARD_EQ_IFF_NONTRIVIAL; +"CONNECTED_CBALL",CONNECTED_CBALL; +"CONNECTED_CHAIN",CONNECTED_CHAIN; +"CONNECTED_CHAIN_GEN",CONNECTED_CHAIN_GEN; +"CONNECTED_CLOPEN",CONNECTED_CLOPEN; +"CONNECTED_CLOSED",CONNECTED_CLOSED; +"CONNECTED_CLOSED_IN",CONNECTED_CLOSED_IN; +"CONNECTED_CLOSED_IN_EQ",CONNECTED_CLOSED_IN_EQ; +"CONNECTED_CLOSED_MONOTONE_PREIMAGE",CONNECTED_CLOSED_MONOTONE_PREIMAGE; +"CONNECTED_CLOSED_SET",CONNECTED_CLOSED_SET; +"CONNECTED_CLOSURE",CONNECTED_CLOSURE; +"CONNECTED_COMPACT_INTERVAL_1",CONNECTED_COMPACT_INTERVAL_1; +"CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; +"CONNECTED_COMPLEMENT_BOUNDED_CONVEX",CONNECTED_COMPLEMENT_BOUNDED_CONVEX; +"CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; +"CONNECTED_COMPONENT_1",CONNECTED_COMPONENT_1; +"CONNECTED_COMPONENT_1_GEN",CONNECTED_COMPONENT_1_GEN; +"CONNECTED_COMPONENT_DISJOINT",CONNECTED_COMPONENT_DISJOINT; +"CONNECTED_COMPONENT_EMPTY",CONNECTED_COMPONENT_EMPTY; +"CONNECTED_COMPONENT_EQ",CONNECTED_COMPONENT_EQ; +"CONNECTED_COMPONENT_EQUIVALENCE_RELATION",CONNECTED_COMPONENT_EQUIVALENCE_RELATION; +"CONNECTED_COMPONENT_EQ_EMPTY",CONNECTED_COMPONENT_EQ_EMPTY; +"CONNECTED_COMPONENT_EQ_EQ",CONNECTED_COMPONENT_EQ_EQ; +"CONNECTED_COMPONENT_EQ_SELF",CONNECTED_COMPONENT_EQ_SELF; +"CONNECTED_COMPONENT_EQ_UNIV",CONNECTED_COMPONENT_EQ_UNIV; +"CONNECTED_COMPONENT_IDEMP",CONNECTED_COMPONENT_IDEMP; +"CONNECTED_COMPONENT_IN",CONNECTED_COMPONENT_IN; +"CONNECTED_COMPONENT_INTERMEDIATE_SUBSET",CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; +"CONNECTED_COMPONENT_LINEAR_IMAGE",CONNECTED_COMPONENT_LINEAR_IMAGE; +"CONNECTED_COMPONENT_MAXIMAL",CONNECTED_COMPONENT_MAXIMAL; +"CONNECTED_COMPONENT_MONO",CONNECTED_COMPONENT_MONO; +"CONNECTED_COMPONENT_NONOVERLAP",CONNECTED_COMPONENT_NONOVERLAP; +"CONNECTED_COMPONENT_OF_SUBSET",CONNECTED_COMPONENT_OF_SUBSET; +"CONNECTED_COMPONENT_OVERLAP",CONNECTED_COMPONENT_OVERLAP; +"CONNECTED_COMPONENT_REFL",CONNECTED_COMPONENT_REFL; +"CONNECTED_COMPONENT_REFL_EQ",CONNECTED_COMPONENT_REFL_EQ; +"CONNECTED_COMPONENT_SET",CONNECTED_COMPONENT_SET; +"CONNECTED_COMPONENT_SUBSET",CONNECTED_COMPONENT_SUBSET; +"CONNECTED_COMPONENT_SYM",CONNECTED_COMPONENT_SYM; +"CONNECTED_COMPONENT_SYM_EQ",CONNECTED_COMPONENT_SYM_EQ; +"CONNECTED_COMPONENT_TRANS",CONNECTED_COMPONENT_TRANS; +"CONNECTED_COMPONENT_TRANSLATION",CONNECTED_COMPONENT_TRANSLATION; +"CONNECTED_COMPONENT_UNIONS",CONNECTED_COMPONENT_UNIONS; +"CONNECTED_COMPONENT_UNIQUE",CONNECTED_COMPONENT_UNIQUE; +"CONNECTED_COMPONENT_UNIV",CONNECTED_COMPONENT_UNIV; +"CONNECTED_CONNECTED_COMPONENT",CONNECTED_CONNECTED_COMPONENT; +"CONNECTED_CONNECTED_COMPONENT_SET",CONNECTED_CONNECTED_COMPONENT_SET; +"CONNECTED_CONTINUOUS_IMAGE",CONNECTED_CONTINUOUS_IMAGE; +"CONNECTED_CONVEX_1",CONNECTED_CONVEX_1; +"CONNECTED_CONVEX_1_GEN",CONNECTED_CONVEX_1_GEN; +"CONNECTED_CONVEX_DIFF_CARD_LT",CONNECTED_CONVEX_DIFF_CARD_LT; +"CONNECTED_CONVEX_DIFF_COUNTABLE",CONNECTED_CONVEX_DIFF_COUNTABLE; +"CONNECTED_DIFF_BALL",CONNECTED_DIFF_BALL; +"CONNECTED_DIFF_OPEN_FROM_CLOSED",CONNECTED_DIFF_OPEN_FROM_CLOSED; +"CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE",CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE; +"CONNECTED_EMPTY",CONNECTED_EMPTY; +"CONNECTED_EQUIVALENCE_RELATION",CONNECTED_EQUIVALENCE_RELATION; +"CONNECTED_EQUIVALENCE_RELATION_GEN",CONNECTED_EQUIVALENCE_RELATION_GEN; +"CONNECTED_EQ_COMPONENTS_SUBSET_SING",CONNECTED_EQ_COMPONENTS_SUBSET_SING; +"CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS",CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS; +"CONNECTED_EQ_CONNECTED_COMPONENTS_EQ",CONNECTED_EQ_CONNECTED_COMPONENTS_EQ; +"CONNECTED_EQ_CONNECTED_COMPONENT_EQ",CONNECTED_EQ_CONNECTED_COMPONENT_EQ; +"CONNECTED_FINITE_IFF_COUNTABLE",CONNECTED_FINITE_IFF_COUNTABLE; +"CONNECTED_FINITE_IFF_SING",CONNECTED_FINITE_IFF_SING; +"CONNECTED_FROM_CLOSED_UNION_AND_INTER",CONNECTED_FROM_CLOSED_UNION_AND_INTER; +"CONNECTED_FROM_OPEN_UNION_AND_INTER",CONNECTED_FROM_OPEN_UNION_AND_INTER; +"CONNECTED_IFF_CONNECTED_COMPONENT",CONNECTED_IFF_CONNECTED_COMPONENT; +"CONNECTED_IMP_PERFECT",CONNECTED_IMP_PERFECT; +"CONNECTED_IMP_PERFECT_AFF_DIM",CONNECTED_IMP_PERFECT_AFF_DIM; +"CONNECTED_IMP_PERFECT_CLOSED",CONNECTED_IMP_PERFECT_CLOSED; +"CONNECTED_INDUCTION",CONNECTED_INDUCTION; +"CONNECTED_INDUCTION_SIMPLE",CONNECTED_INDUCTION_SIMPLE; +"CONNECTED_INFINITE_IFF_CARD_EQ",CONNECTED_INFINITE_IFF_CARD_EQ; +"CONNECTED_INTERMEDIATE_CLOSURE",CONNECTED_INTERMEDIATE_CLOSURE; +"CONNECTED_INTERVAL",CONNECTED_INTERVAL; +"CONNECTED_INTER_FRONTIER",CONNECTED_INTER_FRONTIER; +"CONNECTED_INTER_RELATIVE_FRONTIER",CONNECTED_INTER_RELATIVE_FRONTIER; +"CONNECTED_IVT_COMPONENT",CONNECTED_IVT_COMPONENT; +"CONNECTED_IVT_HYPERPLANE",CONNECTED_IVT_HYPERPLANE; +"CONNECTED_LINEAR_IMAGE",CONNECTED_LINEAR_IMAGE; +"CONNECTED_LINEAR_IMAGE_EQ",CONNECTED_LINEAR_IMAGE_EQ; +"CONNECTED_MONOTONE_QUOTIENT_PREIMAGE",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE; +"CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN",CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN; +"CONNECTED_NEGATIONS",CONNECTED_NEGATIONS; +"CONNECTED_NEST",CONNECTED_NEST; +"CONNECTED_NEST_GEN",CONNECTED_NEST_GEN; +"CONNECTED_OPEN_ARC_CONNECTED",CONNECTED_OPEN_ARC_CONNECTED; +"CONNECTED_OPEN_DELETE",CONNECTED_OPEN_DELETE; +"CONNECTED_OPEN_DIFF_CARD_LT",CONNECTED_OPEN_DIFF_CARD_LT; +"CONNECTED_OPEN_DIFF_CBALL",CONNECTED_OPEN_DIFF_CBALL; +"CONNECTED_OPEN_DIFF_COUNTABLE",CONNECTED_OPEN_DIFF_COUNTABLE; +"CONNECTED_OPEN_IN",CONNECTED_OPEN_IN; +"CONNECTED_OPEN_IN_DIFF_CARD_LT",CONNECTED_OPEN_IN_DIFF_CARD_LT; +"CONNECTED_OPEN_IN_EQ",CONNECTED_OPEN_IN_EQ; +"CONNECTED_OPEN_MONOTONE_PREIMAGE",CONNECTED_OPEN_MONOTONE_PREIMAGE; +"CONNECTED_OPEN_PATH_CONNECTED",CONNECTED_OPEN_PATH_CONNECTED; +"CONNECTED_OPEN_SET",CONNECTED_OPEN_SET; +"CONNECTED_OUTSIDE",CONNECTED_OUTSIDE; +"CONNECTED_PATH_IMAGE",CONNECTED_PATH_IMAGE; +"CONNECTED_PCROSS",CONNECTED_PCROSS; +"CONNECTED_PCROSS_EQ",CONNECTED_PCROSS_EQ; +"CONNECTED_PUNCTURED_BALL",CONNECTED_PUNCTURED_BALL; +"CONNECTED_PUNCTURED_CONVEX",CONNECTED_PUNCTURED_CONVEX; +"CONNECTED_PUNCTURED_UNIVERSE",CONNECTED_PUNCTURED_UNIVERSE; +"CONNECTED_REAL_LEMMA",CONNECTED_REAL_LEMMA; +"CONNECTED_RETRACT_COMPLEMENT",CONNECTED_RETRACT_COMPLEMENT; +"CONNECTED_SCALING",CONNECTED_SCALING; +"CONNECTED_SEGMENT",CONNECTED_SEGMENT; +"CONNECTED_SEMIOPEN_SEGMENT",CONNECTED_SEMIOPEN_SEGMENT; +"CONNECTED_SIMPLE_PATH_ENDLESS",CONNECTED_SIMPLE_PATH_ENDLESS; +"CONNECTED_SIMPLE_PATH_IMAGE",CONNECTED_SIMPLE_PATH_IMAGE; +"CONNECTED_SING",CONNECTED_SING; +"CONNECTED_SPHERE",CONNECTED_SPHERE; +"CONNECTED_SPHERE_EQ",CONNECTED_SPHERE_EQ; +"CONNECTED_SPHERE_GEN",CONNECTED_SPHERE_GEN; +"CONNECTED_SUBSET_CLOPEN",CONNECTED_SUBSET_CLOPEN; +"CONNECTED_SUMS",CONNECTED_SUMS; +"CONNECTED_TRANSLATION",CONNECTED_TRANSLATION; +"CONNECTED_TRANSLATION_EQ",CONNECTED_TRANSLATION_EQ; +"CONNECTED_UNION",CONNECTED_UNION; +"CONNECTED_UNIONS",CONNECTED_UNIONS; +"CONNECTED_UNION_CLOPEN_IN_COMPLEMENT",CONNECTED_UNION_CLOPEN_IN_COMPLEMENT; +"CONNECTED_UNION_STRONG",CONNECTED_UNION_STRONG; +"CONNECTED_UNIV",CONNECTED_UNIV; +"CONNECTED_WITH_INSIDE",CONNECTED_WITH_INSIDE; +"CONNECTED_WITH_OUTSIDE",CONNECTED_WITH_OUTSIDE; +"CONSTR",CONSTR; +"CONSTR_BOT",CONSTR_BOT; +"CONSTR_IND",CONSTR_IND; +"CONSTR_INJ",CONSTR_INJ; +"CONSTR_REC",CONSTR_REC; +"CONS_11",CONS_11; +"CONS_HD_TL",CONS_HD_TL; +"CONTENT_0_SUBSET",CONTENT_0_SUBSET; +"CONTENT_0_SUBSET_GEN",CONTENT_0_SUBSET_GEN; +"CONTENT_1",CONTENT_1; +"CONTENT_CLOSED_INTERVAL",CONTENT_CLOSED_INTERVAL; +"CONTENT_CLOSED_INTERVAL_CASES",CONTENT_CLOSED_INTERVAL_CASES; +"CONTENT_DOUBLESPLIT",CONTENT_DOUBLESPLIT; +"CONTENT_EMPTY",CONTENT_EMPTY; +"CONTENT_EQ_0",CONTENT_EQ_0; +"CONTENT_EQ_0_1",CONTENT_EQ_0_1; +"CONTENT_EQ_0_GEN",CONTENT_EQ_0_GEN; +"CONTENT_EQ_0_INTERIOR",CONTENT_EQ_0_INTERIOR; +"CONTENT_IMAGE_AFFINITY_INTERVAL",CONTENT_IMAGE_AFFINITY_INTERVAL; +"CONTENT_IMAGE_STRETCH_INTERVAL",CONTENT_IMAGE_STRETCH_INTERVAL; +"CONTENT_LT_NZ",CONTENT_LT_NZ; +"CONTENT_PASTECART",CONTENT_PASTECART; +"CONTENT_POS_LE",CONTENT_POS_LE; +"CONTENT_POS_LT",CONTENT_POS_LT; +"CONTENT_POS_LT_1",CONTENT_POS_LT_1; +"CONTENT_POS_LT_EQ",CONTENT_POS_LT_EQ; +"CONTENT_SPLIT",CONTENT_SPLIT; +"CONTENT_SUBSET",CONTENT_SUBSET; +"CONTENT_UNIT",CONTENT_UNIT; +"CONTENT_UNIT_1",CONTENT_UNIT_1; +"CONTINUOUS_ABS",CONTINUOUS_ABS; +"CONTINUOUS_ADD",CONTINUOUS_ADD; +"CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"CONTINUOUS_AGREE_ON_CLOSURE",CONTINUOUS_AGREE_ON_CLOSURE; +"CONTINUOUS_AT",CONTINUOUS_AT; +"CONTINUOUS_ATTAINS_INF",CONTINUOUS_ATTAINS_INF; +"CONTINUOUS_ATTAINS_SUP",CONTINUOUS_ATTAINS_SUP; +"CONTINUOUS_AT_AVOID",CONTINUOUS_AT_AVOID; +"CONTINUOUS_AT_BALL",CONTINUOUS_AT_BALL; +"CONTINUOUS_AT_CLOSEST_POINT",CONTINUOUS_AT_CLOSEST_POINT; +"CONTINUOUS_AT_COMPOSE",CONTINUOUS_AT_COMPOSE; +"CONTINUOUS_AT_COMPOSE_EQ",CONTINUOUS_AT_COMPOSE_EQ; +"CONTINUOUS_AT_DIST_CLOSEST_POINT",CONTINUOUS_AT_DIST_CLOSEST_POINT; +"CONTINUOUS_AT_ID",CONTINUOUS_AT_ID; +"CONTINUOUS_AT_IMP_CONTINUOUS_ON",CONTINUOUS_AT_IMP_CONTINUOUS_ON; +"CONTINUOUS_AT_INV",CONTINUOUS_AT_INV; +"CONTINUOUS_AT_LIFT_COMPONENT",CONTINUOUS_AT_LIFT_COMPONENT; +"CONTINUOUS_AT_LIFT_DIST",CONTINUOUS_AT_LIFT_DIST; +"CONTINUOUS_AT_LIFT_DOT",CONTINUOUS_AT_LIFT_DOT; +"CONTINUOUS_AT_LIFT_INFNORM",CONTINUOUS_AT_LIFT_INFNORM; +"CONTINUOUS_AT_LIFT_NORM",CONTINUOUS_AT_LIFT_NORM; +"CONTINUOUS_AT_LIFT_RANGE",CONTINUOUS_AT_LIFT_RANGE; +"CONTINUOUS_AT_LIFT_SETDIST",CONTINUOUS_AT_LIFT_SETDIST; +"CONTINUOUS_AT_LINEAR_IMAGE",CONTINUOUS_AT_LINEAR_IMAGE; +"CONTINUOUS_AT_OPEN",CONTINUOUS_AT_OPEN; +"CONTINUOUS_AT_SEQUENTIALLY",CONTINUOUS_AT_SEQUENTIALLY; +"CONTINUOUS_AT_SQRT",CONTINUOUS_AT_SQRT; +"CONTINUOUS_AT_SQRT_COMPOSE",CONTINUOUS_AT_SQRT_COMPOSE; +"CONTINUOUS_AT_TRANSLATION",CONTINUOUS_AT_TRANSLATION; +"CONTINUOUS_AT_WITHIN",CONTINUOUS_AT_WITHIN; +"CONTINUOUS_AT_WITHIN_INV",CONTINUOUS_AT_WITHIN_INV; +"CONTINUOUS_CARD_LT_RANGE_CONSTANT",CONTINUOUS_CARD_LT_RANGE_CONSTANT; +"CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ",CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ; +"CONTINUOUS_CLOSED_GRAPH",CONTINUOUS_CLOSED_GRAPH; +"CONTINUOUS_CLOSED_GRAPH_EQ",CONTINUOUS_CLOSED_GRAPH_EQ; +"CONTINUOUS_CLOSED_GRAPH_GEN",CONTINUOUS_CLOSED_GRAPH_GEN; +"CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS",CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS; +"CONTINUOUS_CLOSED_IN_PREIMAGE",CONTINUOUS_CLOSED_IN_PREIMAGE; +"CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT; +"CONTINUOUS_CLOSED_IN_PREIMAGE_EQ",CONTINUOUS_CLOSED_IN_PREIMAGE_EQ; +"CONTINUOUS_CLOSED_IN_PREIMAGE_GEN",CONTINUOUS_CLOSED_IN_PREIMAGE_GEN; +"CONTINUOUS_CLOSED_PREIMAGE",CONTINUOUS_CLOSED_PREIMAGE; +"CONTINUOUS_CLOSED_PREIMAGE_CONSTANT",CONTINUOUS_CLOSED_PREIMAGE_CONSTANT; +"CONTINUOUS_CLOSED_PREIMAGE_UNIV",CONTINUOUS_CLOSED_PREIMAGE_UNIV; +"CONTINUOUS_CMUL",CONTINUOUS_CMUL; +"CONTINUOUS_COMPONENTWISE_LIFT",CONTINUOUS_COMPONENTWISE_LIFT; +"CONTINUOUS_CONST",CONTINUOUS_CONST; +"CONTINUOUS_CONSTANT_ON_CLOSURE",CONTINUOUS_CONSTANT_ON_CLOSURE; +"CONTINUOUS_COUNTABLE_RANGE_CONSTANT",CONTINUOUS_COUNTABLE_RANGE_CONSTANT; +"CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ",CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ; +"CONTINUOUS_DIAMETER",CONTINUOUS_DIAMETER; +"CONTINUOUS_DISCONNECTED_RANGE_CONSTANT",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT; +"CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ",CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; +"CONTINUOUS_DISCRETE_RANGE_CONSTANT",CONTINUOUS_DISCRETE_RANGE_CONSTANT; +"CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ",CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; +"CONTINUOUS_FINITE_RANGE_CONSTANT",CONTINUOUS_FINITE_RANGE_CONSTANT; +"CONTINUOUS_FINITE_RANGE_CONSTANT_EQ",CONTINUOUS_FINITE_RANGE_CONSTANT_EQ; +"CONTINUOUS_FROM_CLOSED_GRAPH",CONTINUOUS_FROM_CLOSED_GRAPH; +"CONTINUOUS_GE_ON_CLOSURE",CONTINUOUS_GE_ON_CLOSURE; +"CONTINUOUS_IMP_CLOSED_MAP",CONTINUOUS_IMP_CLOSED_MAP; +"CONTINUOUS_IMP_MEASURABLE_ON",CONTINUOUS_IMP_MEASURABLE_ON; +"CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET; +"CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"CONTINUOUS_IMP_QUOTIENT_MAP",CONTINUOUS_IMP_QUOTIENT_MAP; +"CONTINUOUS_INJECTIVE_IFF_MONOTONIC",CONTINUOUS_INJECTIVE_IFF_MONOTONIC; +"CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1; +"CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1",CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1; +"CONTINUOUS_INTERVAL_BIJ",CONTINUOUS_INTERVAL_BIJ; +"CONTINUOUS_INV",CONTINUOUS_INV; +"CONTINUOUS_IVT_LOCAL_EXTREMUM",CONTINUOUS_IVT_LOCAL_EXTREMUM; +"CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP; +"CONTINUOUS_LEVELSET_OPEN",CONTINUOUS_LEVELSET_OPEN; +"CONTINUOUS_LEVELSET_OPEN_IN",CONTINUOUS_LEVELSET_OPEN_IN; +"CONTINUOUS_LEVELSET_OPEN_IN_CASES",CONTINUOUS_LEVELSET_OPEN_IN_CASES; +"CONTINUOUS_LE_ON_CLOSURE",CONTINUOUS_LE_ON_CLOSURE; +"CONTINUOUS_LIFT_COMPONENT_COMPOSE",CONTINUOUS_LIFT_COMPONENT_COMPOSE; +"CONTINUOUS_LIFT_DET",CONTINUOUS_LIFT_DET; +"CONTINUOUS_LIFT_DOT2",CONTINUOUS_LIFT_DOT2; +"CONTINUOUS_LIFT_NORM_COMPOSE",CONTINUOUS_LIFT_NORM_COMPOSE; +"CONTINUOUS_LIFT_POW",CONTINUOUS_LIFT_POW; +"CONTINUOUS_LIFT_PRODUCT",CONTINUOUS_LIFT_PRODUCT; +"CONTINUOUS_LINEPATH_AT",CONTINUOUS_LINEPATH_AT; +"CONTINUOUS_MAX",CONTINUOUS_MAX; +"CONTINUOUS_MIDPOINT_CONVEX",CONTINUOUS_MIDPOINT_CONVEX; +"CONTINUOUS_MIN",CONTINUOUS_MIN; +"CONTINUOUS_MUL",CONTINUOUS_MUL; +"CONTINUOUS_NEG",CONTINUOUS_NEG; +"CONTINUOUS_ON",CONTINUOUS_ON; +"CONTINUOUS_ON_ABS",CONTINUOUS_ON_ABS; +"CONTINUOUS_ON_ADD",CONTINUOUS_ON_ADD; +"CONTINUOUS_ON_AVOID",CONTINUOUS_ON_AVOID; +"CONTINUOUS_ON_CASES",CONTINUOUS_ON_CASES; +"CONTINUOUS_ON_CASES_1",CONTINUOUS_ON_CASES_1; +"CONTINUOUS_ON_CASES_LE",CONTINUOUS_ON_CASES_LE; +"CONTINUOUS_ON_CASES_LOCAL",CONTINUOUS_ON_CASES_LOCAL; +"CONTINUOUS_ON_CASES_LOCAL_OPEN",CONTINUOUS_ON_CASES_LOCAL_OPEN; +"CONTINUOUS_ON_CASES_OPEN",CONTINUOUS_ON_CASES_OPEN; +"CONTINUOUS_ON_CLOSED",CONTINUOUS_ON_CLOSED; +"CONTINUOUS_ON_CLOSED_GEN",CONTINUOUS_ON_CLOSED_GEN; +"CONTINUOUS_ON_CLOSEST_POINT",CONTINUOUS_ON_CLOSEST_POINT; +"CONTINUOUS_ON_CLOSURE",CONTINUOUS_ON_CLOSURE; +"CONTINUOUS_ON_CLOSURE_COMPONENT_GE",CONTINUOUS_ON_CLOSURE_COMPONENT_GE; +"CONTINUOUS_ON_CLOSURE_COMPONENT_LE",CONTINUOUS_ON_CLOSURE_COMPONENT_LE; +"CONTINUOUS_ON_CLOSURE_NORM_LE",CONTINUOUS_ON_CLOSURE_NORM_LE; +"CONTINUOUS_ON_CLOSURE_SEQUENTIALLY",CONTINUOUS_ON_CLOSURE_SEQUENTIALLY; +"CONTINUOUS_ON_CMUL",CONTINUOUS_ON_CMUL; +"CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION",CONTINUOUS_ON_COMPACT_SURFACE_PROJECTION; +"CONTINUOUS_ON_COMPONENTS",CONTINUOUS_ON_COMPONENTS; +"CONTINUOUS_ON_COMPONENTS_EQ",CONTINUOUS_ON_COMPONENTS_EQ; +"CONTINUOUS_ON_COMPONENTS_FINITE",CONTINUOUS_ON_COMPONENTS_FINITE; +"CONTINUOUS_ON_COMPONENTS_GEN",CONTINUOUS_ON_COMPONENTS_GEN; +"CONTINUOUS_ON_COMPONENTS_OPEN",CONTINUOUS_ON_COMPONENTS_OPEN; +"CONTINUOUS_ON_COMPONENTS_OPEN_EQ",CONTINUOUS_ON_COMPONENTS_OPEN_EQ; +"CONTINUOUS_ON_COMPONENTWISE_LIFT",CONTINUOUS_ON_COMPONENTWISE_LIFT; +"CONTINUOUS_ON_COMPOSE",CONTINUOUS_ON_COMPOSE; +"CONTINUOUS_ON_COMPOSE_QUOTIENT",CONTINUOUS_ON_COMPOSE_QUOTIENT; +"CONTINUOUS_ON_CONST",CONTINUOUS_ON_CONST; +"CONTINUOUS_ON_DIST_CLOSEST_POINT",CONTINUOUS_ON_DIST_CLOSEST_POINT; +"CONTINUOUS_ON_EMPTY",CONTINUOUS_ON_EMPTY; +"CONTINUOUS_ON_EQ",CONTINUOUS_ON_EQ; +"CONTINUOUS_ON_EQ_CONTINUOUS_AT",CONTINUOUS_ON_EQ_CONTINUOUS_AT; +"CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN",CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; +"CONTINUOUS_ON_FINITE",CONTINUOUS_ON_FINITE; +"CONTINUOUS_ON_ID",CONTINUOUS_ON_ID; +"CONTINUOUS_ON_IMP_CLOSED_IN",CONTINUOUS_ON_IMP_CLOSED_IN; +"CONTINUOUS_ON_IMP_OPEN_IN",CONTINUOUS_ON_IMP_OPEN_IN; +"CONTINUOUS_ON_INTERIOR",CONTINUOUS_ON_INTERIOR; +"CONTINUOUS_ON_INTERVAL_BIJ",CONTINUOUS_ON_INTERVAL_BIJ; +"CONTINUOUS_ON_INV",CONTINUOUS_ON_INV; +"CONTINUOUS_ON_INVERSE",CONTINUOUS_ON_INVERSE; +"CONTINUOUS_ON_INVERSE_CLOSED_MAP",CONTINUOUS_ON_INVERSE_CLOSED_MAP; +"CONTINUOUS_ON_INVERSE_OPEN_MAP",CONTINUOUS_ON_INVERSE_OPEN_MAP; +"CONTINUOUS_ON_LIFT_COMPONENT",CONTINUOUS_ON_LIFT_COMPONENT; +"CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE",CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; +"CONTINUOUS_ON_LIFT_DET",CONTINUOUS_ON_LIFT_DET; +"CONTINUOUS_ON_LIFT_DIST",CONTINUOUS_ON_LIFT_DIST; +"CONTINUOUS_ON_LIFT_DOT",CONTINUOUS_ON_LIFT_DOT; +"CONTINUOUS_ON_LIFT_DOT2",CONTINUOUS_ON_LIFT_DOT2; +"CONTINUOUS_ON_LIFT_NORM",CONTINUOUS_ON_LIFT_NORM; +"CONTINUOUS_ON_LIFT_NORM_COMPOSE",CONTINUOUS_ON_LIFT_NORM_COMPOSE; +"CONTINUOUS_ON_LIFT_POW",CONTINUOUS_ON_LIFT_POW; +"CONTINUOUS_ON_LIFT_PRODUCT",CONTINUOUS_ON_LIFT_PRODUCT; +"CONTINUOUS_ON_LIFT_RANGE",CONTINUOUS_ON_LIFT_RANGE; +"CONTINUOUS_ON_LIFT_SETDIST",CONTINUOUS_ON_LIFT_SETDIST; +"CONTINUOUS_ON_LIFT_SQRT",CONTINUOUS_ON_LIFT_SQRT; +"CONTINUOUS_ON_LIFT_SQRT_COMPOSE",CONTINUOUS_ON_LIFT_SQRT_COMPOSE; +"CONTINUOUS_ON_LINEPATH",CONTINUOUS_ON_LINEPATH; +"CONTINUOUS_ON_MAX",CONTINUOUS_ON_MAX; +"CONTINUOUS_ON_MIN",CONTINUOUS_ON_MIN; +"CONTINUOUS_ON_MUL",CONTINUOUS_ON_MUL; +"CONTINUOUS_ON_NEG",CONTINUOUS_ON_NEG; +"CONTINUOUS_ON_NO_LIMPT",CONTINUOUS_ON_NO_LIMPT; +"CONTINUOUS_ON_OPEN",CONTINUOUS_ON_OPEN; +"CONTINUOUS_ON_OPEN_AVOID",CONTINUOUS_ON_OPEN_AVOID; +"CONTINUOUS_ON_OPEN_GEN",CONTINUOUS_ON_OPEN_GEN; +"CONTINUOUS_ON_PASTECART",CONTINUOUS_ON_PASTECART; +"CONTINUOUS_ON_SEQUENTIALLY",CONTINUOUS_ON_SEQUENTIALLY; +"CONTINUOUS_ON_SING",CONTINUOUS_ON_SING; +"CONTINUOUS_ON_SUB",CONTINUOUS_ON_SUB; +"CONTINUOUS_ON_SUBSET",CONTINUOUS_ON_SUBSET; +"CONTINUOUS_ON_UNION",CONTINUOUS_ON_UNION; +"CONTINUOUS_ON_UNION_LOCAL",CONTINUOUS_ON_UNION_LOCAL; +"CONTINUOUS_ON_UNION_LOCAL_OPEN",CONTINUOUS_ON_UNION_LOCAL_OPEN; +"CONTINUOUS_ON_UNION_OPEN",CONTINUOUS_ON_UNION_OPEN; +"CONTINUOUS_ON_VMUL",CONTINUOUS_ON_VMUL; +"CONTINUOUS_ON_VSUM",CONTINUOUS_ON_VSUM; +"CONTINUOUS_OPEN_IN_PREIMAGE",CONTINUOUS_OPEN_IN_PREIMAGE; +"CONTINUOUS_OPEN_IN_PREIMAGE_EQ",CONTINUOUS_OPEN_IN_PREIMAGE_EQ; +"CONTINUOUS_OPEN_IN_PREIMAGE_GEN",CONTINUOUS_OPEN_IN_PREIMAGE_GEN; +"CONTINUOUS_OPEN_PREIMAGE",CONTINUOUS_OPEN_PREIMAGE; +"CONTINUOUS_OPEN_PREIMAGE_UNIV",CONTINUOUS_OPEN_PREIMAGE_UNIV; +"CONTINUOUS_PASTECART",CONTINUOUS_PASTECART; +"CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP",CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP; +"CONTINUOUS_SUB",CONTINUOUS_SUB; +"CONTINUOUS_TRANSFORM_AT",CONTINUOUS_TRANSFORM_AT; +"CONTINUOUS_TRANSFORM_WITHIN",CONTINUOUS_TRANSFORM_WITHIN; +"CONTINUOUS_TRANSFORM_WITHIN_OPEN",CONTINUOUS_TRANSFORM_WITHIN_OPEN; +"CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN",CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN; +"CONTINUOUS_TRIVIAL_LIMIT",CONTINUOUS_TRIVIAL_LIMIT; +"CONTINUOUS_UNIFORM_LIMIT",CONTINUOUS_UNIFORM_LIMIT; +"CONTINUOUS_VMUL",CONTINUOUS_VMUL; +"CONTINUOUS_VSUM",CONTINUOUS_VSUM; +"CONTINUOUS_WITHIN",CONTINUOUS_WITHIN; +"CONTINUOUS_WITHIN_AVOID",CONTINUOUS_WITHIN_AVOID; +"CONTINUOUS_WITHIN_BALL",CONTINUOUS_WITHIN_BALL; +"CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL",CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL; +"CONTINUOUS_WITHIN_COMPOSE",CONTINUOUS_WITHIN_COMPOSE; +"CONTINUOUS_WITHIN_ID",CONTINUOUS_WITHIN_ID; +"CONTINUOUS_WITHIN_LIFT_SQRT",CONTINUOUS_WITHIN_LIFT_SQRT; +"CONTINUOUS_WITHIN_OPEN",CONTINUOUS_WITHIN_OPEN; +"CONTINUOUS_WITHIN_SEQUENTIALLY",CONTINUOUS_WITHIN_SEQUENTIALLY; +"CONTINUOUS_WITHIN_SQRT_COMPOSE",CONTINUOUS_WITHIN_SQRT_COMPOSE; +"CONTINUOUS_WITHIN_SUBSET",CONTINUOUS_WITHIN_SUBSET; +"CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS",CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS; +"CONTRACTIBLE_EMPTY",CONTRACTIBLE_EMPTY; +"CONTRACTIBLE_IMP_CONNECTED",CONTRACTIBLE_IMP_CONNECTED; +"CONTRACTIBLE_IMP_PATH_CONNECTED",CONTRACTIBLE_IMP_PATH_CONNECTED; +"CONTRACTIBLE_IMP_SIMPLY_CONNECTED",CONTRACTIBLE_IMP_SIMPLY_CONNECTED; +"CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE",CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE; +"CONTRACTIBLE_PCROSS",CONTRACTIBLE_PCROSS; +"CONTRACTIBLE_PCROSS_EQ",CONTRACTIBLE_PCROSS_EQ; +"CONTRACTIBLE_PUNCTURED_SPHERE",CONTRACTIBLE_PUNCTURED_SPHERE; +"CONTRACTIBLE_SING",CONTRACTIBLE_SING; +"CONTRACTIBLE_SPHERE",CONTRACTIBLE_SPHERE; +"CONTRACTIBLE_TRANSLATION",CONTRACTIBLE_TRANSLATION; +"CONTRACTIBLE_UNIV",CONTRACTIBLE_UNIV; +"CONTRACTION_IMP_CONTINUOUS_ON",CONTRACTION_IMP_CONTINUOUS_ON; +"CONTRAPOS_THM",CONTRAPOS_THM; +"CONVERGENCE_IN_MEASURE",CONVERGENCE_IN_MEASURE; +"CONVERGENT_BOUNDED_INCREASING",CONVERGENT_BOUNDED_INCREASING; +"CONVERGENT_BOUNDED_MONOTONE",CONVERGENT_BOUNDED_MONOTONE; +"CONVERGENT_EQ_CAUCHY",CONVERGENT_EQ_CAUCHY; +"CONVERGENT_IMP_BOUNDED",CONVERGENT_IMP_BOUNDED; +"CONVERGENT_IMP_CAUCHY",CONVERGENT_IMP_CAUCHY; +"CONVEX",CONVEX; +"CONVEX_ADD",CONVEX_ADD; +"CONVEX_AFFINITY",CONVEX_AFFINITY; +"CONVEX_ALT",CONVEX_ALT; +"CONVEX_AND_AFFINE_INTER_OPEN",CONVEX_AND_AFFINE_INTER_OPEN; +"CONVEX_BALL",CONVEX_BALL; +"CONVEX_BOUNDS_LEMMA",CONVEX_BOUNDS_LEMMA; +"CONVEX_CBALL",CONVEX_CBALL; +"CONVEX_CLOSED_CONTAINS_SAME_RAY",CONVEX_CLOSED_CONTAINS_SAME_RAY; +"CONVEX_CLOSURE",CONVEX_CLOSURE; +"CONVEX_CLOSURE_INTERIOR",CONVEX_CLOSURE_INTERIOR; +"CONVEX_CLOSURE_RELATIVE_INTERIOR",CONVEX_CLOSURE_RELATIVE_INTERIOR; +"CONVEX_CMUL",CONVEX_CMUL; +"CONVEX_CONE",CONVEX_CONE; +"CONVEX_CONE_ADD",CONVEX_CONE_ADD; +"CONVEX_CONE_CONTAINS_0",CONVEX_CONE_CONTAINS_0; +"CONVEX_CONE_CONVEX_CONE_HULL",CONVEX_CONE_CONVEX_CONE_HULL; +"CONVEX_CONE_HALFSPACE_GE",CONVEX_CONE_HALFSPACE_GE; +"CONVEX_CONE_HALFSPACE_LE",CONVEX_CONE_HALFSPACE_LE; +"CONVEX_CONE_HULL_ADD",CONVEX_CONE_HULL_ADD; +"CONVEX_CONE_HULL_CONTAINS_0",CONVEX_CONE_HULL_CONTAINS_0; +"CONVEX_CONE_HULL_CONVEX_HULL",CONVEX_CONE_HULL_CONVEX_HULL; +"CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY",CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; +"CONVEX_CONE_HULL_EMPTY",CONVEX_CONE_HULL_EMPTY; +"CONVEX_CONE_HULL_LINEAR_IMAGE",CONVEX_CONE_HULL_LINEAR_IMAGE; +"CONVEX_CONE_HULL_MUL",CONVEX_CONE_HULL_MUL; +"CONVEX_CONE_HULL_NONEMPTY",CONVEX_CONE_HULL_NONEMPTY; +"CONVEX_CONE_HULL_SEPARATE",CONVEX_CONE_HULL_SEPARATE; +"CONVEX_CONE_HULL_SEPARATE_NONEMPTY",CONVEX_CONE_HULL_SEPARATE_NONEMPTY; +"CONVEX_CONE_HULL_UNION",CONVEX_CONE_HULL_UNION; +"CONVEX_CONE_INTERS",CONVEX_CONE_INTERS; +"CONVEX_CONE_LINEAR_IMAGE",CONVEX_CONE_LINEAR_IMAGE; +"CONVEX_CONE_LINEAR_IMAGE_EQ",CONVEX_CONE_LINEAR_IMAGE_EQ; +"CONVEX_CONE_MUL",CONVEX_CONE_MUL; +"CONVEX_CONE_NEGATIONS",CONVEX_CONE_NEGATIONS; +"CONVEX_CONE_NONEMPTY",CONVEX_CONE_NONEMPTY; +"CONVEX_CONE_PCROSS",CONVEX_CONE_PCROSS; +"CONVEX_CONE_PCROSS_EQ",CONVEX_CONE_PCROSS_EQ; +"CONVEX_CONE_SING",CONVEX_CONE_SING; +"CONVEX_CONE_SPAN",CONVEX_CONE_SPAN; +"CONVEX_CONE_SUMS",CONVEX_CONE_SUMS; +"CONVEX_CONIC_HULL",CONVEX_CONIC_HULL; +"CONVEX_CONNECTED",CONVEX_CONNECTED; +"CONVEX_CONNECTED_1",CONVEX_CONNECTED_1; +"CONVEX_CONNECTED_1_GEN",CONVEX_CONNECTED_1_GEN; +"CONVEX_CONNECTED_COLLINEAR",CONVEX_CONNECTED_COLLINEAR; +"CONVEX_CONTAINS_OPEN_SEGMENT",CONVEX_CONTAINS_OPEN_SEGMENT; +"CONVEX_CONTAINS_SEGMENT",CONVEX_CONTAINS_SEGMENT; +"CONVEX_CONTAINS_SEGMENT_EQ",CONVEX_CONTAINS_SEGMENT_EQ; +"CONVEX_CONTAINS_SEGMENT_IMP",CONVEX_CONTAINS_SEGMENT_IMP; +"CONVEX_CONVEX_CONE_HULL",CONVEX_CONVEX_CONE_HULL; +"CONVEX_CONVEX_HULL",CONVEX_CONVEX_HULL; +"CONVEX_DIFFERENCES",CONVEX_DIFFERENCES; +"CONVEX_DISTANCE",CONVEX_DISTANCE; +"CONVEX_EMPTY",CONVEX_EMPTY; +"CONVEX_EPIGRAPH",CONVEX_EPIGRAPH; +"CONVEX_EPIGRAPH_CONVEX",CONVEX_EPIGRAPH_CONVEX; +"CONVEX_EQ_CONNECTED_LINE_INTERSECTION",CONVEX_EQ_CONNECTED_LINE_INTERSECTION; +"CONVEX_EQ_CONVEX_LINE_INTERSECTION",CONVEX_EQ_CONVEX_LINE_INTERSECTION; +"CONVEX_EXPLICIT",CONVEX_EXPLICIT; +"CONVEX_FINITE",CONVEX_FINITE; +"CONVEX_HALFSPACE_COMPONENT_GE",CONVEX_HALFSPACE_COMPONENT_GE; +"CONVEX_HALFSPACE_COMPONENT_GT",CONVEX_HALFSPACE_COMPONENT_GT; +"CONVEX_HALFSPACE_COMPONENT_LE",CONVEX_HALFSPACE_COMPONENT_LE; +"CONVEX_HALFSPACE_COMPONENT_LT",CONVEX_HALFSPACE_COMPONENT_LT; +"CONVEX_HALFSPACE_GE",CONVEX_HALFSPACE_GE; +"CONVEX_HALFSPACE_GT",CONVEX_HALFSPACE_GT; +"CONVEX_HALFSPACE_INTERSECTION",CONVEX_HALFSPACE_INTERSECTION; +"CONVEX_HALFSPACE_LE",CONVEX_HALFSPACE_LE; +"CONVEX_HALFSPACE_LT",CONVEX_HALFSPACE_LT; +"CONVEX_HULLS_EQ",CONVEX_HULLS_EQ; +"CONVEX_HULL_2",CONVEX_HULL_2; +"CONVEX_HULL_2_ALT",CONVEX_HULL_2_ALT; +"CONVEX_HULL_3",CONVEX_HULL_3; +"CONVEX_HULL_3_ALT",CONVEX_HULL_3_ALT; +"CONVEX_HULL_AFFINITY",CONVEX_HULL_AFFINITY; +"CONVEX_HULL_CARATHEODORY",CONVEX_HULL_CARATHEODORY; +"CONVEX_HULL_CARATHEODORY_AFF_DIM",CONVEX_HULL_CARATHEODORY_AFF_DIM; +"CONVEX_HULL_EMPTY",CONVEX_HULL_EMPTY; +"CONVEX_HULL_EQ",CONVEX_HULL_EQ; +"CONVEX_HULL_EQ_EMPTY",CONVEX_HULL_EQ_EMPTY; +"CONVEX_HULL_EQ_SING",CONVEX_HULL_EQ_SING; +"CONVEX_HULL_EXCHANGE_INTER",CONVEX_HULL_EXCHANGE_INTER; +"CONVEX_HULL_EXCHANGE_UNION",CONVEX_HULL_EXCHANGE_UNION; +"CONVEX_HULL_EXPLICIT",CONVEX_HULL_EXPLICIT; +"CONVEX_HULL_FINITE",CONVEX_HULL_FINITE; +"CONVEX_HULL_FINITE_STEP",CONVEX_HULL_FINITE_STEP; +"CONVEX_HULL_INDEXED",CONVEX_HULL_INDEXED; +"CONVEX_HULL_INSERT",CONVEX_HULL_INSERT; +"CONVEX_HULL_INSERT_ALT",CONVEX_HULL_INSERT_ALT; +"CONVEX_HULL_INTER",CONVEX_HULL_INTER; +"CONVEX_HULL_INTERIOR_SUBSET",CONVEX_HULL_INTERIOR_SUBSET; +"CONVEX_HULL_INTERS",CONVEX_HULL_INTERS; +"CONVEX_HULL_LINEAR_IMAGE",CONVEX_HULL_LINEAR_IMAGE; +"CONVEX_HULL_PCROSS",CONVEX_HULL_PCROSS; +"CONVEX_HULL_SCALING",CONVEX_HULL_SCALING; +"CONVEX_HULL_SING",CONVEX_HULL_SING; +"CONVEX_HULL_SUBSET_AFFINE_HULL",CONVEX_HULL_SUBSET_AFFINE_HULL; +"CONVEX_HULL_SUBSET_CONVEX_CONE_HULL",CONVEX_HULL_SUBSET_CONVEX_CONE_HULL; +"CONVEX_HULL_SUBSET_SPAN",CONVEX_HULL_SUBSET_SPAN; +"CONVEX_HULL_SUMS",CONVEX_HULL_SUMS; +"CONVEX_HULL_TRANSLATION",CONVEX_HULL_TRANSLATION; +"CONVEX_HULL_UNION_EXPLICIT",CONVEX_HULL_UNION_EXPLICIT; +"CONVEX_HULL_UNION_NONEMPTY_EXPLICIT",CONVEX_HULL_UNION_NONEMPTY_EXPLICIT; +"CONVEX_HULL_UNION_UNIONS",CONVEX_HULL_UNION_UNIONS; +"CONVEX_HULL_UNIV",CONVEX_HULL_UNIV; +"CONVEX_HYPERPLANE",CONVEX_HYPERPLANE; +"CONVEX_IMP_ANR",CONVEX_IMP_ANR; +"CONVEX_IMP_AR",CONVEX_IMP_AR; +"CONVEX_IMP_CONTRACTIBLE",CONVEX_IMP_CONTRACTIBLE; +"CONVEX_IMP_LOCALLY_CONNECTED",CONVEX_IMP_LOCALLY_CONNECTED; +"CONVEX_IMP_LOCALLY_PATH_CONNECTED",CONVEX_IMP_LOCALLY_PATH_CONNECTED; +"CONVEX_IMP_PATH_CONNECTED",CONVEX_IMP_PATH_CONNECTED; +"CONVEX_IMP_SIMPLY_CONNECTED",CONVEX_IMP_SIMPLY_CONNECTED; +"CONVEX_IMP_STARLIKE",CONVEX_IMP_STARLIKE; +"CONVEX_INDEXED",CONVEX_INDEXED; +"CONVEX_INNER_APPROXIMATION",CONVEX_INNER_APPROXIMATION; +"CONVEX_INNER_POLYTOPE",CONVEX_INNER_POLYTOPE; +"CONVEX_INTER",CONVEX_INTER; +"CONVEX_INTERIOR",CONVEX_INTERIOR; +"CONVEX_INTERIOR_CLOSURE",CONVEX_INTERIOR_CLOSURE; +"CONVEX_INTERMEDIATE_BALL",CONVEX_INTERMEDIATE_BALL; +"CONVEX_INTERS",CONVEX_INTERS; +"CONVEX_INTERVAL",CONVEX_INTERVAL; +"CONVEX_LINEAR_IMAGE",CONVEX_LINEAR_IMAGE; +"CONVEX_LINEAR_IMAGE_EQ",CONVEX_LINEAR_IMAGE_EQ; +"CONVEX_LINEAR_PREIMAGE",CONVEX_LINEAR_PREIMAGE; +"CONVEX_LOCAL_GLOBAL_MINIMUM",CONVEX_LOCAL_GLOBAL_MINIMUM; +"CONVEX_LOWER",CONVEX_LOWER; +"CONVEX_LOWER_SEGMENT",CONVEX_LOWER_SEGMENT; +"CONVEX_MAX",CONVEX_MAX; +"CONVEX_NEGATIONS",CONVEX_NEGATIONS; +"CONVEX_NORM",CONVEX_NORM; +"CONVEX_ON_BOUNDED_CONTINUOUS",CONVEX_ON_BOUNDED_CONTINUOUS; +"CONVEX_ON_COMPOSE_LINEAR",CONVEX_ON_COMPOSE_LINEAR; +"CONVEX_ON_CONTINUOUS",CONVEX_ON_CONTINUOUS; +"CONVEX_ON_CONVEX_HULL_BOUND",CONVEX_ON_CONVEX_HULL_BOUND; +"CONVEX_ON_DERIVATIVES",CONVEX_ON_DERIVATIVES; +"CONVEX_ON_DERIVATIVES_IMP",CONVEX_ON_DERIVATIVES_IMP; +"CONVEX_ON_DERIVATIVE_SECANT",CONVEX_ON_DERIVATIVE_SECANT; +"CONVEX_ON_DERIVATIVE_SECANT_IMP",CONVEX_ON_DERIVATIVE_SECANT_IMP; +"CONVEX_ON_EPIGRAPH_SLICE_LE",CONVEX_ON_EPIGRAPH_SLICE_LE; +"CONVEX_ON_EPIGRAPH_SLICE_LT",CONVEX_ON_EPIGRAPH_SLICE_LT; +"CONVEX_ON_EQ",CONVEX_ON_EQ; +"CONVEX_ON_IMP_JENSEN",CONVEX_ON_IMP_JENSEN; +"CONVEX_ON_JENSEN",CONVEX_ON_JENSEN; +"CONVEX_ON_LEFT_SECANT",CONVEX_ON_LEFT_SECANT; +"CONVEX_ON_LEFT_SECANT_MUL",CONVEX_ON_LEFT_SECANT_MUL; +"CONVEX_ON_RIGHT_SECANT",CONVEX_ON_RIGHT_SECANT; +"CONVEX_ON_RIGHT_SECANT_MUL",CONVEX_ON_RIGHT_SECANT_MUL; +"CONVEX_ON_SECANT_DERIVATIVE",CONVEX_ON_SECANT_DERIVATIVE; +"CONVEX_ON_SECANT_DERIVATIVE_IMP",CONVEX_ON_SECANT_DERIVATIVE_IMP; +"CONVEX_ON_SETDIST",CONVEX_ON_SETDIST; +"CONVEX_ON_SUBSET",CONVEX_ON_SUBSET; +"CONVEX_ON_TRANSLATION",CONVEX_ON_TRANSLATION; +"CONVEX_OPEN_SEGMENT_CASES",CONVEX_OPEN_SEGMENT_CASES; +"CONVEX_OUTER_APPROXIMATION",CONVEX_OUTER_APPROXIMATION; +"CONVEX_OUTER_POLYTOPE",CONVEX_OUTER_POLYTOPE; +"CONVEX_PCROSS",CONVEX_PCROSS; +"CONVEX_PCROSS_EQ",CONVEX_PCROSS_EQ; +"CONVEX_POSITIVE_ORTHANT",CONVEX_POSITIVE_ORTHANT; +"CONVEX_RELATIVE_INTERIOR",CONVEX_RELATIVE_INTERIOR; +"CONVEX_RELATIVE_INTERIOR_CLOSURE",CONVEX_RELATIVE_INTERIOR_CLOSURE; +"CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE; +"CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE",CONVEX_SAME_RELATIVE_INTERIOR_CLOSURE_STRADDLE; +"CONVEX_SCALING",CONVEX_SCALING; +"CONVEX_SCALING_EQ",CONVEX_SCALING_EQ; +"CONVEX_SEGMENT",CONVEX_SEGMENT; +"CONVEX_SEMIOPEN_SEGMENT",CONVEX_SEMIOPEN_SEGMENT; +"CONVEX_SIMPLEX",CONVEX_SIMPLEX; +"CONVEX_SING",CONVEX_SING; +"CONVEX_SPAN",CONVEX_SPAN; +"CONVEX_STANDARD_HYPERPLANE",CONVEX_STANDARD_HYPERPLANE; +"CONVEX_SUMS",CONVEX_SUMS; +"CONVEX_TRANSLATION",CONVEX_TRANSLATION; +"CONVEX_TRANSLATION_EQ",CONVEX_TRANSLATION_EQ; +"CONVEX_UNIV",CONVEX_UNIV; +"CONVEX_VSUM",CONVEX_VSUM; +"CONVEX_VSUM_STRONG",CONVEX_VSUM_STRONG; +"COPLANAR_2",COPLANAR_2; +"COPLANAR_3",COPLANAR_3; +"COPLANAR_AFFINE_HULL_COPLANAR",COPLANAR_AFFINE_HULL_COPLANAR; +"COPLANAR_EMPTY",COPLANAR_EMPTY; +"COPLANAR_LINEAR_IMAGE",COPLANAR_LINEAR_IMAGE; +"COPLANAR_LINEAR_IMAGE_EQ",COPLANAR_LINEAR_IMAGE_EQ; +"COPLANAR_SING",COPLANAR_SING; +"COPLANAR_SMALL",COPLANAR_SMALL; +"COPLANAR_SUBSET",COPLANAR_SUBSET; +"COPLANAR_TRANSLATION",COPLANAR_TRANSLATION; +"COPLANAR_TRANSLATION_EQ",COPLANAR_TRANSLATION_EQ; +"COSMALL_APPROXIMATION",COSMALL_APPROXIMATION; +"COUNTABLE",COUNTABLE; +"COUNTABLE_ALT",COUNTABLE_ALT; +"COUNTABLE_ANR_COMPONENTS",COUNTABLE_ANR_COMPONENTS; +"COUNTABLE_ANR_CONNECTED_COMPONENTS",COUNTABLE_ANR_CONNECTED_COMPONENTS; +"COUNTABLE_ANR_PATH_COMPONENTS",COUNTABLE_ANR_PATH_COMPONENTS; +"COUNTABLE_AS_IMAGE",COUNTABLE_AS_IMAGE; +"COUNTABLE_AS_IMAGE_SUBSET",COUNTABLE_AS_IMAGE_SUBSET; +"COUNTABLE_AS_IMAGE_SUBSET_EQ",COUNTABLE_AS_IMAGE_SUBSET_EQ; +"COUNTABLE_AS_INJECTIVE_IMAGE",COUNTABLE_AS_INJECTIVE_IMAGE; +"COUNTABLE_CARD_MUL",COUNTABLE_CARD_MUL; +"COUNTABLE_CARD_MUL_EQ",COUNTABLE_CARD_MUL_EQ; +"COUNTABLE_CART",COUNTABLE_CART; +"COUNTABLE_CASES",COUNTABLE_CASES; +"COUNTABLE_COMPONENTS",COUNTABLE_COMPONENTS; +"COUNTABLE_CONNECTED_COMPONENTS",COUNTABLE_CONNECTED_COMPONENTS; +"COUNTABLE_CROSS",COUNTABLE_CROSS; +"COUNTABLE_DELETE",COUNTABLE_DELETE; +"COUNTABLE_DIFF_FINITE",COUNTABLE_DIFF_FINITE; +"COUNTABLE_DISJOINT_OPEN_SUBSETS",COUNTABLE_DISJOINT_OPEN_SUBSETS; +"COUNTABLE_ELEMENTARY_DIVISION",COUNTABLE_ELEMENTARY_DIVISION; +"COUNTABLE_EMPTY",COUNTABLE_EMPTY; +"COUNTABLE_EMPTY_INTERIOR",COUNTABLE_EMPTY_INTERIOR; +"COUNTABLE_ENR_COMPONENTS",COUNTABLE_ENR_COMPONENTS; +"COUNTABLE_ENR_CONNECTED_COMPONENTS",COUNTABLE_ENR_CONNECTED_COMPONENTS; +"COUNTABLE_ENR_PATH_COMPONENTS",COUNTABLE_ENR_PATH_COMPONENTS; +"COUNTABLE_FINITE_SUBSETS",COUNTABLE_FINITE_SUBSETS; +"COUNTABLE_IMAGE",COUNTABLE_IMAGE; +"COUNTABLE_IMAGE_INJ",COUNTABLE_IMAGE_INJ; +"COUNTABLE_IMAGE_INJ_EQ",COUNTABLE_IMAGE_INJ_EQ; +"COUNTABLE_IMAGE_INJ_GENERAL",COUNTABLE_IMAGE_INJ_GENERAL; +"COUNTABLE_IMP_CARD_LT_REAL",COUNTABLE_IMP_CARD_LT_REAL; +"COUNTABLE_IMP_DISCONNECTED",COUNTABLE_IMP_DISCONNECTED; +"COUNTABLE_INSERT",COUNTABLE_INSERT; +"COUNTABLE_INTEGER",COUNTABLE_INTEGER; +"COUNTABLE_INTEGER_COORDINATES",COUNTABLE_INTEGER_COORDINATES; +"COUNTABLE_INTER",COUNTABLE_INTER; +"COUNTABLE_LIST",COUNTABLE_LIST; +"COUNTABLE_LIST_GEN",COUNTABLE_LIST_GEN; +"COUNTABLE_NON_CONDENSATION_POINTS",COUNTABLE_NON_CONDENSATION_POINTS; +"COUNTABLE_OPEN_INTERVAL",COUNTABLE_OPEN_INTERVAL; +"COUNTABLE_PATH_COMPONENTS",COUNTABLE_PATH_COMPONENTS; +"COUNTABLE_PCROSS",COUNTABLE_PCROSS; +"COUNTABLE_PCROSS_EQ",COUNTABLE_PCROSS_EQ; +"COUNTABLE_PRODUCT_DEPENDENT",COUNTABLE_PRODUCT_DEPENDENT; +"COUNTABLE_RATIONAL",COUNTABLE_RATIONAL; +"COUNTABLE_RATIONAL_COORDINATES",COUNTABLE_RATIONAL_COORDINATES; +"COUNTABLE_RESTRICT",COUNTABLE_RESTRICT; +"COUNTABLE_SING",COUNTABLE_SING; +"COUNTABLE_SUBSET",COUNTABLE_SUBSET; +"COUNTABLE_SUBSET_IMAGE",COUNTABLE_SUBSET_IMAGE; +"COUNTABLE_SUBSET_NUM",COUNTABLE_SUBSET_NUM; +"COUNTABLE_UNION",COUNTABLE_UNION; +"COUNTABLE_UNIONS",COUNTABLE_UNIONS; +"COUNTABLE_UNION_IMP",COUNTABLE_UNION_IMP; +"COVERING_LEMMA",COVERING_LEMMA; +"COVERING_SPACE_CLOSED_MAP",COVERING_SPACE_CLOSED_MAP; +"COVERING_SPACE_COMPACT",COVERING_SPACE_COMPACT; +"COVERING_SPACE_COUNTABLE_SHEETS",COVERING_SPACE_COUNTABLE_SHEETS; +"COVERING_SPACE_FIBRE_NO_LIMPT",COVERING_SPACE_FIBRE_NO_LIMPT; +"COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE",COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE; +"COVERING_SPACE_FINITE_SHEETS",COVERING_SPACE_FINITE_SHEETS; +"COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP; +"COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG",COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG; +"COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP",COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP; +"COVERING_SPACE_HOMEOMORPHISM",COVERING_SPACE_HOMEOMORPHISM; +"COVERING_SPACE_IMP_CONTINUOUS",COVERING_SPACE_IMP_CONTINUOUS; +"COVERING_SPACE_IMP_SURJECTIVE",COVERING_SPACE_IMP_SURJECTIVE; +"COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP",COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP; +"COVERING_SPACE_INJECTIVE",COVERING_SPACE_INJECTIVE; +"COVERING_SPACE_LIFT",COVERING_SPACE_LIFT; +"COVERING_SPACE_LIFT_GENERAL",COVERING_SPACE_LIFT_GENERAL; +"COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION",COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION; +"COVERING_SPACE_LIFT_HOMOTOPIC_PATH",COVERING_SPACE_LIFT_HOMOTOPIC_PATH; +"COVERING_SPACE_LIFT_HOMOTOPIC_PATHS",COVERING_SPACE_LIFT_HOMOTOPIC_PATHS; +"COVERING_SPACE_LIFT_HOMOTOPY",COVERING_SPACE_LIFT_HOMOTOPY; +"COVERING_SPACE_LIFT_HOMOTOPY_ALT",COVERING_SPACE_LIFT_HOMOTOPY_ALT; +"COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION",COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION; +"COVERING_SPACE_LIFT_PATH",COVERING_SPACE_LIFT_PATH; +"COVERING_SPACE_LIFT_PATH_STRONG",COVERING_SPACE_LIFT_PATH_STRONG; +"COVERING_SPACE_LIFT_STRONG",COVERING_SPACE_LIFT_STRONG; +"COVERING_SPACE_LIFT_STRONGER",COVERING_SPACE_LIFT_STRONGER; +"COVERING_SPACE_LIFT_UNIQUE",COVERING_SPACE_LIFT_UNIQUE; +"COVERING_SPACE_LIFT_UNIQUE_GEN",COVERING_SPACE_LIFT_UNIQUE_GEN; +"COVERING_SPACE_LIFT_UNIQUE_IDENTITY",COVERING_SPACE_LIFT_UNIQUE_IDENTITY; +"COVERING_SPACE_LOCALLY",COVERING_SPACE_LOCALLY; +"COVERING_SPACE_LOCALLY_COMPACT",COVERING_SPACE_LOCALLY_COMPACT; +"COVERING_SPACE_LOCALLY_COMPACT_EQ",COVERING_SPACE_LOCALLY_COMPACT_EQ; +"COVERING_SPACE_LOCALLY_CONNECTED",COVERING_SPACE_LOCALLY_CONNECTED; +"COVERING_SPACE_LOCALLY_CONNECTED_EQ",COVERING_SPACE_LOCALLY_CONNECTED_EQ; +"COVERING_SPACE_LOCALLY_EQ",COVERING_SPACE_LOCALLY_EQ; +"COVERING_SPACE_LOCALLY_PATH_CONNECTED",COVERING_SPACE_LOCALLY_PATH_CONNECTED; +"COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ",COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ; +"COVERING_SPACE_LOCAL_HOMEOMORPHISM",COVERING_SPACE_LOCAL_HOMEOMORPHISM; +"COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT",COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT; +"COVERING_SPACE_MONODROMY",COVERING_SPACE_MONODROMY; +"COVERING_SPACE_OPEN_MAP",COVERING_SPACE_OPEN_MAP; +"COVERING_SPACE_QUOTIENT_MAP",COVERING_SPACE_QUOTIENT_MAP; +"COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP",COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP; +"CRAMER",CRAMER; +"CRAMER_LEMMA",CRAMER_LEMMA; +"CRAMER_LEMMA_TRANSP",CRAMER_LEMMA_TRANSP; +"CRAMER_MATRIX_LEFT",CRAMER_MATRIX_LEFT; +"CRAMER_MATRIX_LEFT_INVERSE",CRAMER_MATRIX_LEFT_INVERSE; +"CRAMER_MATRIX_RIGHT",CRAMER_MATRIX_RIGHT; +"CRAMER_MATRIX_RIGHT_INVERSE",CRAMER_MATRIX_RIGHT_INVERSE; +"CROSS",CROSS; +"CROSS_EQ_EMPTY",CROSS_EQ_EMPTY; +"CURRY_DEF",CURRY_DEF; +"DECIMAL",DECIMAL; +"DECOMPOSITION",DECOMPOSITION; +"DECREASING_BOUNDED_VARIATION",DECREASING_BOUNDED_VARIATION; +"DECREASING_CLOSED_NEST",DECREASING_CLOSED_NEST; +"DECREASING_CLOSED_NEST_SING",DECREASING_CLOSED_NEST_SING; +"DECREASING_LEFT_LIMIT_1",DECREASING_LEFT_LIMIT_1; +"DECREASING_RIGHT_LIMIT_1",DECREASING_RIGHT_LIMIT_1; +"DECREASING_VECTOR_VARIATION",DECREASING_VECTOR_VARIATION; +"DEFORMATION_RETRACT",DEFORMATION_RETRACT; +"DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT",DEFORMATION_RETRACT_IMP_HOMOTOPY_EQUIVALENT; +"DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING",DEFORMATION_RETRACT_OF_CONTRACTIBLE_SING; +"DELETE",DELETE; +"DELETE_COMM",DELETE_COMM; +"DELETE_DELETE",DELETE_DELETE; +"DELETE_INSERT",DELETE_INSERT; +"DELETE_INTER",DELETE_INTER; +"DELETE_NON_ELEMENT",DELETE_NON_ELEMENT; +"DELETE_SUBSET",DELETE_SUBSET; +"DENSE_ACCESSIBLE_FRONTIER_POINTS",DENSE_ACCESSIBLE_FRONTIER_POINTS; +"DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED",DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED; +"DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS",DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS; +"DEPENDENT_2",DEPENDENT_2; +"DEPENDENT_3",DEPENDENT_3; +"DEPENDENT_AFFINE_DEPENDENT_CASES",DEPENDENT_AFFINE_DEPENDENT_CASES; +"DEPENDENT_BIGGERSET",DEPENDENT_BIGGERSET; +"DEPENDENT_BIGGERSET_GENERAL",DEPENDENT_BIGGERSET_GENERAL; +"DEPENDENT_CHOICE",DEPENDENT_CHOICE; +"DEPENDENT_CHOICE_FIXED",DEPENDENT_CHOICE_FIXED; +"DEPENDENT_EXPLICIT",DEPENDENT_EXPLICIT; +"DEPENDENT_FINITE",DEPENDENT_FINITE; +"DEPENDENT_IMP_AFFINE_DEPENDENT",DEPENDENT_IMP_AFFINE_DEPENDENT; +"DEPENDENT_LINEAR_IMAGE",DEPENDENT_LINEAR_IMAGE; +"DEPENDENT_LINEAR_IMAGE_EQ",DEPENDENT_LINEAR_IMAGE_EQ; +"DEPENDENT_MONO",DEPENDENT_MONO; +"DEPENDENT_SING",DEPENDENT_SING; +"DEST_MK_MULTIVECTOR",DEST_MK_MULTIVECTOR; +"DEST_REC_INJ",DEST_REC_INJ; +"DET_0",DET_0; +"DET_1",DET_1; +"DET_2",DET_2; +"DET_3",DET_3; +"DET_4",DET_4; +"DET_CMUL",DET_CMUL; +"DET_COFACTOR",DET_COFACTOR; +"DET_COFACTOR_EXPANSION",DET_COFACTOR_EXPANSION; +"DET_DEPENDENT_COLUMNS",DET_DEPENDENT_COLUMNS; +"DET_DEPENDENT_ROWS",DET_DEPENDENT_ROWS; +"DET_DIAGONAL",DET_DIAGONAL; +"DET_EQ_0",DET_EQ_0; +"DET_EQ_0_RANK",DET_EQ_0_RANK; +"DET_I",DET_I; +"DET_IDENTICAL_COLUMNS",DET_IDENTICAL_COLUMNS; +"DET_IDENTICAL_ROWS",DET_IDENTICAL_ROWS; +"DET_LINEAR_ROWS_VSUM",DET_LINEAR_ROWS_VSUM; +"DET_LINEAR_ROWS_VSUM_LEMMA",DET_LINEAR_ROWS_VSUM_LEMMA; +"DET_LINEAR_ROW_VSUM",DET_LINEAR_ROW_VSUM; +"DET_LOWERTRIANGULAR",DET_LOWERTRIANGULAR; +"DET_MATRIX_EQ_0",DET_MATRIX_EQ_0; +"DET_MATRIX_EQ_0_LEFT",DET_MATRIX_EQ_0_LEFT; +"DET_MATRIX_EQ_0_RIGHT",DET_MATRIX_EQ_0_RIGHT; +"DET_MATRIX_REFLECT_ALONG",DET_MATRIX_REFLECT_ALONG; +"DET_MUL",DET_MUL; +"DET_NEG",DET_NEG; +"DET_OPEN_MAP",DET_OPEN_MAP; +"DET_ORTHOGONAL_MATRIX",DET_ORTHOGONAL_MATRIX; +"DET_PERMUTE_COLUMNS",DET_PERMUTE_COLUMNS; +"DET_PERMUTE_ROWS",DET_PERMUTE_ROWS; +"DET_ROWS_MUL",DET_ROWS_MUL; +"DET_ROW_ADD",DET_ROW_ADD; +"DET_ROW_MUL",DET_ROW_MUL; +"DET_ROW_OPERATION",DET_ROW_OPERATION; +"DET_ROW_SPAN",DET_ROW_SPAN; +"DET_TRANSP",DET_TRANSP; +"DET_UPPERTRIANGULAR",DET_UPPERTRIANGULAR; +"DET_ZERO_COLUMN",DET_ZERO_COLUMN; +"DET_ZERO_ROW",DET_ZERO_ROW; +"DE_MORGAN_THM",DE_MORGAN_THM; +"DIAMETER_ATTAINED_FRONTIER",DIAMETER_ATTAINED_FRONTIER; +"DIAMETER_ATTAINED_RELATIVE_FRONTIER",DIAMETER_ATTAINED_RELATIVE_FRONTIER; +"DIAMETER_BALL",DIAMETER_BALL; +"DIAMETER_BOUNDED",DIAMETER_BOUNDED; +"DIAMETER_BOUNDED_BOUND",DIAMETER_BOUNDED_BOUND; +"DIAMETER_BOUNDED_BOUND_LT",DIAMETER_BOUNDED_BOUND_LT; +"DIAMETER_CBALL",DIAMETER_CBALL; +"DIAMETER_CLOSURE",DIAMETER_CLOSURE; +"DIAMETER_COMPACT_ATTAINED",DIAMETER_COMPACT_ATTAINED; +"DIAMETER_CONVEX_HULL",DIAMETER_CONVEX_HULL; +"DIAMETER_EMPTY",DIAMETER_EMPTY; +"DIAMETER_EQ_0",DIAMETER_EQ_0; +"DIAMETER_FRONTIER",DIAMETER_FRONTIER; +"DIAMETER_INTERVAL",DIAMETER_INTERVAL; +"DIAMETER_LE",DIAMETER_LE; +"DIAMETER_LINEAR_IMAGE",DIAMETER_LINEAR_IMAGE; +"DIAMETER_POS_LE",DIAMETER_POS_LE; +"DIAMETER_RELATIVE_FRONTIER",DIAMETER_RELATIVE_FRONTIER; +"DIAMETER_SIMPLEX",DIAMETER_SIMPLEX; +"DIAMETER_SING",DIAMETER_SING; +"DIAMETER_SPHERE",DIAMETER_SPHERE; +"DIAMETER_SUBSET",DIAMETER_SUBSET; +"DIAMETER_SUBSET_CBALL",DIAMETER_SUBSET_CBALL; +"DIAMETER_SUBSET_CBALL_NONEMPTY",DIAMETER_SUBSET_CBALL_NONEMPTY; +"DIAMETER_SUMS",DIAMETER_SUMS; +"DIAMETER_TRANSLATION",DIAMETER_TRANSLATION; +"DIFF",DIFF; +"DIFFERENTIABLE_ADD",DIFFERENTIABLE_ADD; +"DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON",DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; +"DIFFERENTIABLE_AT_LIFT_DOT2",DIFFERENTIABLE_AT_LIFT_DOT2; +"DIFFERENTIABLE_AT_WITHIN",DIFFERENTIABLE_AT_WITHIN; +"DIFFERENTIABLE_BOUND",DIFFERENTIABLE_BOUND; +"DIFFERENTIABLE_CHAIN_AT",DIFFERENTIABLE_CHAIN_AT; +"DIFFERENTIABLE_CHAIN_WITHIN",DIFFERENTIABLE_CHAIN_WITHIN; +"DIFFERENTIABLE_CMUL",DIFFERENTIABLE_CMUL; +"DIFFERENTIABLE_COMPONENTWISE_AT",DIFFERENTIABLE_COMPONENTWISE_AT; +"DIFFERENTIABLE_COMPONENTWISE_WITHIN",DIFFERENTIABLE_COMPONENTWISE_WITHIN; +"DIFFERENTIABLE_CONST",DIFFERENTIABLE_CONST; +"DIFFERENTIABLE_ID",DIFFERENTIABLE_ID; +"DIFFERENTIABLE_IMP_CONTINUOUS_AT",DIFFERENTIABLE_IMP_CONTINUOUS_AT; +"DIFFERENTIABLE_IMP_CONTINUOUS_ON",DIFFERENTIABLE_IMP_CONTINUOUS_ON; +"DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN",DIFFERENTIABLE_IMP_CONTINUOUS_WITHIN; +"DIFFERENTIABLE_LIFT_COMPONENT",DIFFERENTIABLE_LIFT_COMPONENT; +"DIFFERENTIABLE_LINEAR",DIFFERENTIABLE_LINEAR; +"DIFFERENTIABLE_MUL_AT",DIFFERENTIABLE_MUL_AT; +"DIFFERENTIABLE_MUL_WITHIN",DIFFERENTIABLE_MUL_WITHIN; +"DIFFERENTIABLE_NEG",DIFFERENTIABLE_NEG; +"DIFFERENTIABLE_ON_ADD",DIFFERENTIABLE_ON_ADD; +"DIFFERENTIABLE_ON_COMPOSE",DIFFERENTIABLE_ON_COMPOSE; +"DIFFERENTIABLE_ON_CONST",DIFFERENTIABLE_ON_CONST; +"DIFFERENTIABLE_ON_EMPTY",DIFFERENTIABLE_ON_EMPTY; +"DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT",DIFFERENTIABLE_ON_EQ_DIFFERENTIABLE_AT; +"DIFFERENTIABLE_ON_ID",DIFFERENTIABLE_ON_ID; +"DIFFERENTIABLE_ON_LIFT_DOT2",DIFFERENTIABLE_ON_LIFT_DOT2; +"DIFFERENTIABLE_ON_LINEAR",DIFFERENTIABLE_ON_LINEAR; +"DIFFERENTIABLE_ON_MUL",DIFFERENTIABLE_ON_MUL; +"DIFFERENTIABLE_ON_NEG",DIFFERENTIABLE_ON_NEG; +"DIFFERENTIABLE_ON_SQNORM",DIFFERENTIABLE_ON_SQNORM; +"DIFFERENTIABLE_ON_SUB",DIFFERENTIABLE_ON_SUB; +"DIFFERENTIABLE_ON_SUBSET",DIFFERENTIABLE_ON_SUBSET; +"DIFFERENTIABLE_SQNORM_AT",DIFFERENTIABLE_SQNORM_AT; +"DIFFERENTIABLE_SUB",DIFFERENTIABLE_SUB; +"DIFFERENTIABLE_TRANSFORM_AT",DIFFERENTIABLE_TRANSFORM_AT; +"DIFFERENTIABLE_TRANSFORM_WITHIN",DIFFERENTIABLE_TRANSFORM_WITHIN; +"DIFFERENTIABLE_VSUM",DIFFERENTIABLE_VSUM; +"DIFFERENTIABLE_VSUM_NUMSEG",DIFFERENTIABLE_VSUM_NUMSEG; +"DIFFERENTIABLE_WITHIN_LIFT_DOT2",DIFFERENTIABLE_WITHIN_LIFT_DOT2; +"DIFFERENTIABLE_WITHIN_OPEN",DIFFERENTIABLE_WITHIN_OPEN; +"DIFFERENTIABLE_WITHIN_SUBSET",DIFFERENTIABLE_WITHIN_SUBSET; +"DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM",DIFFERENTIAL_COMPONENT_NEG_AT_MAXIMUM; +"DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM",DIFFERENTIAL_COMPONENT_POS_AT_MINIMUM; +"DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN",DIFFERENTIAL_COMPONENT_ZERO_AT_MAXMIN; +"DIFFERENTIAL_ZERO_MAXMIN",DIFFERENTIAL_ZERO_MAXMIN; +"DIFFERENTIAL_ZERO_MAXMIN_COMPONENT",DIFFERENTIAL_ZERO_MAXMIN_COMPONENT; +"DIFFERENT_NORM_3_COLLINEAR_POINTS",DIFFERENT_NORM_3_COLLINEAR_POINTS; +"DIFFS_AFFINE_HULL_SPAN",DIFFS_AFFINE_HULL_SPAN; +"DIFF_CHAIN_AT",DIFF_CHAIN_AT; +"DIFF_CHAIN_WITHIN",DIFF_CHAIN_WITHIN; +"DIFF_CLOSURE_SUBSET",DIFF_CLOSURE_SUBSET; +"DIFF_DIFF",DIFF_DIFF; +"DIFF_EMPTY",DIFF_EMPTY; +"DIFF_EQ_EMPTY",DIFF_EQ_EMPTY; +"DIFF_INSERT",DIFF_INSERT; +"DIFF_INTERS",DIFF_INTERS; +"DIFF_UNIONS",DIFF_UNIONS; +"DIFF_UNIONS_NONEMPTY",DIFF_UNIONS_NONEMPTY; +"DIFF_UNIV",DIFF_UNIV; +"DIMINDEX_1",DIMINDEX_1; +"DIMINDEX_2",DIMINDEX_2; +"DIMINDEX_3",DIMINDEX_3; +"DIMINDEX_4",DIMINDEX_4; +"DIMINDEX_FINITE_IMAGE",DIMINDEX_FINITE_IMAGE; +"DIMINDEX_FINITE_SUM",DIMINDEX_FINITE_SUM; +"DIMINDEX_GE_1",DIMINDEX_GE_1; +"DIMINDEX_HAS_SIZE_FINITE_SUM",DIMINDEX_HAS_SIZE_FINITE_SUM; +"DIMINDEX_MULTIVECTOR",DIMINDEX_MULTIVECTOR; +"DIMINDEX_NONZERO",DIMINDEX_NONZERO; +"DIMINDEX_UNIQUE",DIMINDEX_UNIQUE; +"DIMINDEX_UNIV",DIMINDEX_UNIV; +"DIM_CLOSURE",DIM_CLOSURE; +"DIM_EMPTY",DIM_EMPTY; +"DIM_EQ_0",DIM_EQ_0; +"DIM_EQ_CARD",DIM_EQ_CARD; +"DIM_EQ_FULL",DIM_EQ_FULL; +"DIM_EQ_HYPERPLANE",DIM_EQ_HYPERPLANE; +"DIM_EQ_SPAN",DIM_EQ_SPAN; +"DIM_HYPERPLANE",DIM_HYPERPLANE; +"DIM_IMAGE_KERNEL",DIM_IMAGE_KERNEL; +"DIM_IMAGE_KERNEL_GEN",DIM_IMAGE_KERNEL_GEN; +"DIM_INJECTIVE_LINEAR_IMAGE",DIM_INJECTIVE_LINEAR_IMAGE; +"DIM_INSERT",DIM_INSERT; +"DIM_INSERT_0",DIM_INSERT_0; +"DIM_KERNEL_COMPOSE",DIM_KERNEL_COMPOSE; +"DIM_LE_CARD",DIM_LE_CARD; +"DIM_LINEAR_IMAGE_LE",DIM_LINEAR_IMAGE_LE; +"DIM_OPEN",DIM_OPEN; +"DIM_OPEN_IN",DIM_OPEN_IN; +"DIM_ORTHOGONAL_SUM",DIM_ORTHOGONAL_SUM; +"DIM_PCROSS",DIM_PCROSS; +"DIM_PCROSS_STRONG",DIM_PCROSS_STRONG; +"DIM_PSUBSET",DIM_PSUBSET; +"DIM_ROWS_LE_DIM_COLUMNS",DIM_ROWS_LE_DIM_COLUMNS; +"DIM_SING",DIM_SING; +"DIM_SPAN",DIM_SPAN; +"DIM_SPECIAL_HYPERPLANE",DIM_SPECIAL_HYPERPLANE; +"DIM_SPECIAL_SUBSPACE",DIM_SPECIAL_SUBSPACE; +"DIM_SUBSET",DIM_SUBSET; +"DIM_SUBSET_UNIV",DIM_SUBSET_UNIV; +"DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS",DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS; +"DIM_SUBSTANDARD",DIM_SUBSTANDARD; +"DIM_SUMS_INTER",DIM_SUMS_INTER; +"DIM_UNIQUE",DIM_UNIQUE; +"DIM_UNIV",DIM_UNIV; +"DINI",DINI; +"DISCRETE_BOUNDED_IMP_FINITE",DISCRETE_BOUNDED_IMP_FINITE; +"DISCRETE_IMP_CLOSED",DISCRETE_IMP_CLOSED; +"DISCRETE_IMP_COUNTABLE",DISCRETE_IMP_COUNTABLE; +"DISJOINT",DISJOINT; +"DISJOINT_AFFINE_HULL",DISJOINT_AFFINE_HULL; +"DISJOINT_DELETE_SYM",DISJOINT_DELETE_SYM; +"DISJOINT_EMPTY",DISJOINT_EMPTY; +"DISJOINT_EMPTY_REFL",DISJOINT_EMPTY_REFL; +"DISJOINT_INSERT",DISJOINT_INSERT; +"DISJOINT_INTERVAL",DISJOINT_INTERVAL; +"DISJOINT_INTERVAL_1",DISJOINT_INTERVAL_1; +"DISJOINT_NUMSEG",DISJOINT_NUMSEG; +"DISJOINT_SYM",DISJOINT_SYM; +"DISJOINT_UNION",DISJOINT_UNION; +"DISJ_ACI",DISJ_ACI; +"DISJ_ASSOC",DISJ_ASSOC; +"DISJ_SYM",DISJ_SYM; +"DISTANCE_ATTAINS_INF",DISTANCE_ATTAINS_INF; +"DISTANCE_ATTAINS_SUP",DISTANCE_ATTAINS_SUP; +"DIST_0",DIST_0; +"DIST_ADD2",DIST_ADD2; +"DIST_ADD2_REV",DIST_ADD2_REV; +"DIST_ADDBOUND",DIST_ADDBOUND; +"DIST_CLOSEST_POINT_LIPSCHITZ",DIST_CLOSEST_POINT_LIPSCHITZ; +"DIST_DECREASES_CLOSED_SEGMENT",DIST_DECREASES_CLOSED_SEGMENT; +"DIST_DECREASES_OPEN_SEGMENT",DIST_DECREASES_OPEN_SEGMENT; +"DIST_ELIM_THM",DIST_ELIM_THM; +"DIST_EQ",DIST_EQ; +"DIST_EQ_0",DIST_EQ_0; +"DIST_FSTCART",DIST_FSTCART; +"DIST_INCREASES_ONLINE",DIST_INCREASES_ONLINE; +"DIST_IN_CLOSED_SEGMENT",DIST_IN_CLOSED_SEGMENT; +"DIST_IN_OPEN_SEGMENT",DIST_IN_OPEN_SEGMENT; +"DIST_LADD",DIST_LADD; +"DIST_LADD_0",DIST_LADD_0; +"DIST_LE_0",DIST_LE_0; +"DIST_LE_CASES",DIST_LE_CASES; +"DIST_LIFT",DIST_LIFT; +"DIST_LMUL",DIST_LMUL; +"DIST_LZERO",DIST_LZERO; +"DIST_MIDPOINT",DIST_MIDPOINT; +"DIST_MUL",DIST_MUL; +"DIST_NZ",DIST_NZ; +"DIST_PASTECART_CANCEL",DIST_PASTECART_CANCEL; +"DIST_POS_LE",DIST_POS_LE; +"DIST_POS_LT",DIST_POS_LT; +"DIST_RADD",DIST_RADD; +"DIST_RADD_0",DIST_RADD_0; +"DIST_REAL",DIST_REAL; +"DIST_REFL",DIST_REFL; +"DIST_RMUL",DIST_RMUL; +"DIST_RZERO",DIST_RZERO; +"DIST_SNDCART",DIST_SNDCART; +"DIST_SYM",DIST_SYM; +"DIST_TRIANGLE",DIST_TRIANGLE; +"DIST_TRIANGLES_LE",DIST_TRIANGLES_LE; +"DIST_TRIANGLE_ADD",DIST_TRIANGLE_ADD; +"DIST_TRIANGLE_ADD_HALF",DIST_TRIANGLE_ADD_HALF; +"DIST_TRIANGLE_ALT",DIST_TRIANGLE_ALT; +"DIST_TRIANGLE_EQ",DIST_TRIANGLE_EQ; +"DIST_TRIANGLE_HALF_L",DIST_TRIANGLE_HALF_L; +"DIST_TRIANGLE_HALF_R",DIST_TRIANGLE_HALF_R; +"DIST_TRIANGLE_LE",DIST_TRIANGLE_LE; +"DIST_TRIANGLE_LT",DIST_TRIANGLE_LT; +"DIVIDES_LE",DIVIDES_LE; +"DIVISION",DIVISION; +"DIVISION_0",DIVISION_0; +"DIVISION_COMMON_POINT_BOUND",DIVISION_COMMON_POINT_BOUND; +"DIVISION_CONTAINS",DIVISION_CONTAINS; +"DIVISION_DISJOINT_UNION",DIVISION_DISJOINT_UNION; +"DIVISION_DOUBLESPLIT",DIVISION_DOUBLESPLIT; +"DIVISION_INTER",DIVISION_INTER; +"DIVISION_INTER_1",DIVISION_INTER_1; +"DIVISION_OF",DIVISION_OF; +"DIVISION_OF_AFFINITY",DIVISION_OF_AFFINITY; +"DIVISION_OF_CLOSED",DIVISION_OF_CLOSED; +"DIVISION_OF_CONTENT_0",DIVISION_OF_CONTENT_0; +"DIVISION_OF_FINITE",DIVISION_OF_FINITE; +"DIVISION_OF_NONTRIVIAL",DIVISION_OF_NONTRIVIAL; +"DIVISION_OF_REFLECT",DIVISION_OF_REFLECT; +"DIVISION_OF_SELF",DIVISION_OF_SELF; +"DIVISION_OF_SING",DIVISION_OF_SING; +"DIVISION_OF_SUBSET",DIVISION_OF_SUBSET; +"DIVISION_OF_TAGGED_DIVISION",DIVISION_OF_TAGGED_DIVISION; +"DIVISION_OF_TRANSLATION",DIVISION_OF_TRANSLATION; +"DIVISION_OF_TRIVIAL",DIVISION_OF_TRIVIAL; +"DIVISION_OF_UNIONS",DIVISION_OF_UNIONS; +"DIVISION_OF_UNION_SELF",DIVISION_OF_UNION_SELF; +"DIVISION_POINTS_FINITE",DIVISION_POINTS_FINITE; +"DIVISION_POINTS_PSUBSET",DIVISION_POINTS_PSUBSET; +"DIVISION_POINTS_SUBSET",DIVISION_POINTS_SUBSET; +"DIVISION_SIMP",DIVISION_SIMP; +"DIVISION_SPLIT",DIVISION_SPLIT; +"DIVISION_SPLIT_LEFT_INJ",DIVISION_SPLIT_LEFT_INJ; +"DIVISION_SPLIT_RIGHT_INJ",DIVISION_SPLIT_RIGHT_INJ; +"DIVISION_UNION_INTERVALS_EXISTS",DIVISION_UNION_INTERVALS_EXISTS; +"DIVMOD_ELIM_THM",DIVMOD_ELIM_THM; +"DIVMOD_ELIM_THM'",DIVMOD_ELIM_THM'; +"DIVMOD_EXIST",DIVMOD_EXIST; +"DIVMOD_EXIST_0",DIVMOD_EXIST_0; +"DIVMOD_UNIQ",DIVMOD_UNIQ; +"DIVMOD_UNIQ_LEMMA",DIVMOD_UNIQ_LEMMA; +"DIV_0",DIV_0; +"DIV_1",DIV_1; +"DIV_ADD_MOD",DIV_ADD_MOD; +"DIV_DIV",DIV_DIV; +"DIV_EQ_0",DIV_EQ_0; +"DIV_EQ_EXCLUSION",DIV_EQ_EXCLUSION; +"DIV_LE",DIV_LE; +"DIV_LE_EXCLUSION",DIV_LE_EXCLUSION; +"DIV_LT",DIV_LT; +"DIV_MOD",DIV_MOD; +"DIV_MONO",DIV_MONO; +"DIV_MONO2",DIV_MONO2; +"DIV_MONO_LT",DIV_MONO_LT; +"DIV_MULT",DIV_MULT; +"DIV_MULT2",DIV_MULT2; +"DIV_MULT_ADD",DIV_MULT_ADD; +"DIV_MUL_LE",DIV_MUL_LE; +"DIV_REFL",DIV_REFL; +"DIV_UNIQ",DIV_UNIQ; +"DOMINATED_CONVERGENCE",DOMINATED_CONVERGENCE; +"DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE",DOMINATED_CONVERGENCE_ABSOLUTELY_INTEGRABLE; +"DOMINATED_CONVERGENCE_AE",DOMINATED_CONVERGENCE_AE; +"DOMINATED_CONVERGENCE_INTEGRABLE",DOMINATED_CONVERGENCE_INTEGRABLE; +"DOT_1",DOT_1; +"DOT_2",DOT_2; +"DOT_3",DOT_3; +"DOT_4",DOT_4; +"DOT_BASIS",DOT_BASIS; +"DOT_BASIS_BASIS",DOT_BASIS_BASIS; +"DOT_BASIS_BASIS_UNEQUAL",DOT_BASIS_BASIS_UNEQUAL; +"DOT_CAUCHY_SCHWARZ_EQUAL",DOT_CAUCHY_SCHWARZ_EQUAL; +"DOT_EQ_0",DOT_EQ_0; +"DOT_LADD",DOT_LADD; +"DOT_LMUL",DOT_LMUL; +"DOT_LMUL_MATRIX",DOT_LMUL_MATRIX; +"DOT_LNEG",DOT_LNEG; +"DOT_LSUB",DOT_LSUB; +"DOT_LSUM",DOT_LSUM; +"DOT_LZERO",DOT_LZERO; +"DOT_MATRIX_PRODUCT",DOT_MATRIX_PRODUCT; +"DOT_MATRIX_VECTOR_MUL",DOT_MATRIX_VECTOR_MUL; +"DOT_NORM",DOT_NORM; +"DOT_NORM_NEG",DOT_NORM_NEG; +"DOT_NORM_SUB",DOT_NORM_SUB; +"DOT_PASTECART",DOT_PASTECART; +"DOT_POS_LE",DOT_POS_LE; +"DOT_POS_LT",DOT_POS_LT; +"DOT_RADD",DOT_RADD; +"DOT_RMUL",DOT_RMUL; +"DOT_RNEG",DOT_RNEG; +"DOT_ROWVECTOR_COLUMNVECTOR",DOT_ROWVECTOR_COLUMNVECTOR; +"DOT_RSUB",DOT_RSUB; +"DOT_RSUM",DOT_RSUM; +"DOT_RZERO",DOT_RZERO; +"DOT_SQUARE_NORM",DOT_SQUARE_NORM; +"DOT_SYM",DOT_SYM; +"DROP_ADD",DROP_ADD; +"DROP_CMUL",DROP_CMUL; +"DROP_DIFFERENTIAL_NEG_AT_MAXIMUM",DROP_DIFFERENTIAL_NEG_AT_MAXIMUM; +"DROP_DIFFERENTIAL_POS_AT_MINIMUM",DROP_DIFFERENTIAL_POS_AT_MINIMUM; +"DROP_EQ",DROP_EQ; +"DROP_EQ_0",DROP_EQ_0; +"DROP_INDICATOR",DROP_INDICATOR; +"DROP_INDICATOR_ABS_LE_1",DROP_INDICATOR_ABS_LE_1; +"DROP_INDICATOR_LE_1",DROP_INDICATOR_LE_1; +"DROP_INDICATOR_POS_LE",DROP_INDICATOR_POS_LE; +"DROP_IN_IMAGE_DROP",DROP_IN_IMAGE_DROP; +"DROP_LAMBDA",DROP_LAMBDA; +"DROP_NEG",DROP_NEG; +"DROP_SUB",DROP_SUB; +"DROP_VEC",DROP_VEC; +"DROP_VSUM",DROP_VSUM; +"DROP_WLOG_LE",DROP_WLOG_LE; +"DSUM_BOUND",DSUM_BOUND; +"DUGUNDJI",DUGUNDJI; +"EDELSTEIN_FIX",EDELSTEIN_FIX; +"EDGE_OF_IMP_SUBSET",EDGE_OF_IMP_SUBSET; +"EDGE_OF_LINEAR_IMAGE",EDGE_OF_LINEAR_IMAGE; +"EDGE_OF_TRANSLATION_EQ",EDGE_OF_TRANSLATION_EQ; +"EGOROV",EGOROV; +"EL",EL; +"ELEMENTARY_BOUNDED",ELEMENTARY_BOUNDED; +"ELEMENTARY_COMPACT",ELEMENTARY_COMPACT; +"ELEMENTARY_EMPTY",ELEMENTARY_EMPTY; +"ELEMENTARY_INTER",ELEMENTARY_INTER; +"ELEMENTARY_INTERS",ELEMENTARY_INTERS; +"ELEMENTARY_INTERVAL",ELEMENTARY_INTERVAL; +"ELEMENTARY_SUBSET_INTERVAL",ELEMENTARY_SUBSET_INTERVAL; +"ELEMENTARY_UNION",ELEMENTARY_UNION; +"ELEMENTARY_UNIONS_INTERVALS",ELEMENTARY_UNIONS_INTERVALS; +"ELEMENTARY_UNION_INTERVAL",ELEMENTARY_UNION_INTERVAL; +"ELEMENTARY_UNION_INTERVAL_STRONG",ELEMENTARY_UNION_INTERVAL_STRONG; +"EL_APPEND",EL_APPEND; +"EL_CONS",EL_CONS; +"EL_MAP",EL_MAP; +"EL_TL",EL_TL; +"EMPTY",EMPTY; +"EMPTY_AS_INTERVAL",EMPTY_AS_INTERVAL; +"EMPTY_DELETE",EMPTY_DELETE; +"EMPTY_DIFF",EMPTY_DIFF; +"EMPTY_DIVISION_OF",EMPTY_DIVISION_OF; +"EMPTY_EXPOSED_FACE_OF",EMPTY_EXPOSED_FACE_OF; +"EMPTY_FACE_OF",EMPTY_FACE_OF; +"EMPTY_GSPEC",EMPTY_GSPEC; +"EMPTY_INTERIOR_AFFINE_HULL",EMPTY_INTERIOR_AFFINE_HULL; +"EMPTY_INTERIOR_CONVEX_HULL",EMPTY_INTERIOR_CONVEX_HULL; +"EMPTY_INTERIOR_FINITE",EMPTY_INTERIOR_FINITE; +"EMPTY_INTERIOR_LOWDIM",EMPTY_INTERIOR_LOWDIM; +"EMPTY_INTERIOR_SUBSET_HYPERPLANE",EMPTY_INTERIOR_SUBSET_HYPERPLANE; +"EMPTY_NOT_UNIV",EMPTY_NOT_UNIV; +"EMPTY_SUBSET",EMPTY_SUBSET; +"EMPTY_UNION",EMPTY_UNION; +"EMPTY_UNIONS",EMPTY_UNIONS; +"ENDPOINTS_SHIFTPATH",ENDPOINTS_SHIFTPATH; +"ENDS_IN_INTERVAL",ENDS_IN_INTERVAL; +"ENDS_IN_SEGMENT",ENDS_IN_SEGMENT; +"ENDS_IN_UNIT_INTERVAL",ENDS_IN_UNIT_INTERVAL; +"ENDS_NOT_IN_SEGMENT",ENDS_NOT_IN_SEGMENT; +"ENR",ENR; +"ENR_ANR",ENR_ANR; +"ENR_BALL",ENR_BALL; +"ENR_BOUNDED",ENR_BOUNDED; +"ENR_CBALL",ENR_CBALL; +"ENR_CLOSED_UNION",ENR_CLOSED_UNION; +"ENR_CLOSED_UNION_LOCAL",ENR_CLOSED_UNION_LOCAL; +"ENR_COMPONENT_ENR",ENR_COMPONENT_ENR; +"ENR_CONNECTED_COMPONENT_ENR",ENR_CONNECTED_COMPONENT_ENR; +"ENR_CONVEX_CLOSED",ENR_CONVEX_CLOSED; +"ENR_DELETE",ENR_DELETE; +"ENR_EMPTY",ENR_EMPTY; +"ENR_FINITE_UNIONS_CONVEX_CLOSED",ENR_FINITE_UNIONS_CONVEX_CLOSED; +"ENR_FROM_UNION_AND_INTER",ENR_FROM_UNION_AND_INTER; +"ENR_FROM_UNION_AND_INTER_GEN",ENR_FROM_UNION_AND_INTER_GEN; +"ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT; +"ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV",ENR_IMP_ABSOLUTE_NEIGHBOURHOOD_RETRACT_UNIV; +"ENR_IMP_ANR",ENR_IMP_ANR; +"ENR_IMP_LOCALLY_COMPACT",ENR_IMP_LOCALLY_COMPACT; +"ENR_IMP_LOCALLY_CONNECTED",ENR_IMP_LOCALLY_CONNECTED; +"ENR_IMP_LOCALLY_PATH_CONNECTED",ENR_IMP_LOCALLY_PATH_CONNECTED; +"ENR_INSERT",ENR_INSERT; +"ENR_INTERIOR",ENR_INTERIOR; +"ENR_INTERVAL",ENR_INTERVAL; +"ENR_LINEAR_IMAGE_EQ",ENR_LINEAR_IMAGE_EQ; +"ENR_NEIGHBORHOOD_RETRACT",ENR_NEIGHBORHOOD_RETRACT; +"ENR_OPEN_IN",ENR_OPEN_IN; +"ENR_PATH_COMPONENT_ENR",ENR_PATH_COMPONENT_ENR; +"ENR_PCROSS",ENR_PCROSS; +"ENR_PCROSS_EQ",ENR_PCROSS_EQ; +"ENR_RELATIVE_FRONTIER_CONVEX",ENR_RELATIVE_FRONTIER_CONVEX; +"ENR_RELATIVE_INTERIOR",ENR_RELATIVE_INTERIOR; +"ENR_RETRACT_OF_ENR",ENR_RETRACT_OF_ENR; +"ENR_SIMPLICIAL_COMPLEX",ENR_SIMPLICIAL_COMPLEX; +"ENR_SING",ENR_SING; +"ENR_SPHERE",ENR_SPHERE; +"ENR_TRANSLATION",ENR_TRANSLATION; +"ENR_TRIANGULATION",ENR_TRIANGULATION; +"ENR_UNIV",ENR_UNIV; +"EPSILON_DELTA_MINIMAL",EPSILON_DELTA_MINIMAL; +"EQUIINTEGRABLE_ADD",EQUIINTEGRABLE_ADD; +"EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_CLOSED_INTERVAL_RESTRICTIONS; +"EQUIINTEGRABLE_CMUL",EQUIINTEGRABLE_CMUL; +"EQUIINTEGRABLE_DIVISION",EQUIINTEGRABLE_DIVISION; +"EQUIINTEGRABLE_EQ",EQUIINTEGRABLE_EQ; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GE; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_GT; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LE; +"EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT",EQUIINTEGRABLE_HALFSPACE_RESTRICTIONS_LT; +"EQUIINTEGRABLE_LIMIT",EQUIINTEGRABLE_LIMIT; +"EQUIINTEGRABLE_NEG",EQUIINTEGRABLE_NEG; +"EQUIINTEGRABLE_ON_NULL",EQUIINTEGRABLE_ON_NULL; +"EQUIINTEGRABLE_ON_SING",EQUIINTEGRABLE_ON_SING; +"EQUIINTEGRABLE_ON_SPLIT",EQUIINTEGRABLE_ON_SPLIT; +"EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS",EQUIINTEGRABLE_OPEN_INTERVAL_RESTRICTIONS; +"EQUIINTEGRABLE_REFLECT",EQUIINTEGRABLE_REFLECT; +"EQUIINTEGRABLE_SUB",EQUIINTEGRABLE_SUB; +"EQUIINTEGRABLE_SUBSET",EQUIINTEGRABLE_SUBSET; +"EQUIINTEGRABLE_SUM",EQUIINTEGRABLE_SUM; +"EQUIINTEGRABLE_UNIFORM_LIMIT",EQUIINTEGRABLE_UNIFORM_LIMIT; +"EQUIINTEGRABLE_UNION",EQUIINTEGRABLE_UNION; +"EQ_ADD_LCANCEL",EQ_ADD_LCANCEL; +"EQ_ADD_LCANCEL_0",EQ_ADD_LCANCEL_0; +"EQ_ADD_RCANCEL",EQ_ADD_RCANCEL; +"EQ_ADD_RCANCEL_0",EQ_ADD_RCANCEL_0; +"EQ_BALLS",EQ_BALLS; +"EQ_C",EQ_C; +"EQ_CLAUSES",EQ_CLAUSES; +"EQ_C_BIJECTIONS",EQ_C_BIJECTIONS; +"EQ_EXP",EQ_EXP; +"EQ_EXT",EQ_EXT; +"EQ_IMP",EQ_IMP; +"EQ_IMP_LE",EQ_IMP_LE; +"EQ_INTERVAL",EQ_INTERVAL; +"EQ_INTERVAL_1",EQ_INTERVAL_1; +"EQ_MULT_LCANCEL",EQ_MULT_LCANCEL; +"EQ_MULT_RCANCEL",EQ_MULT_RCANCEL; +"EQ_REFL",EQ_REFL; +"EQ_SPAN_INSERT_EQ",EQ_SPAN_INSERT_EQ; +"EQ_SUMS_LCANCEL",EQ_SUMS_LCANCEL; +"EQ_SUMS_RCANCEL",EQ_SUMS_RCANCEL; +"EQ_SYM",EQ_SYM; +"EQ_SYM_EQ",EQ_SYM_EQ; +"EQ_TRANS",EQ_TRANS; +"EQ_UNIV",EQ_UNIV; +"ETA_AX",ETA_AX; +"EUCLIDEAN_SPACE_INFINITE",EUCLIDEAN_SPACE_INFINITE; +"EULER_ROTATION_THEOREM",EULER_ROTATION_THEOREM; +"EULER_ROTOINVERSION_THEOREM",EULER_ROTOINVERSION_THEOREM; +"EVEN",EVEN; +"EVENPERM_COMPOSE",EVENPERM_COMPOSE; +"EVENPERM_I",EVENPERM_I; +"EVENPERM_INVERSE",EVENPERM_INVERSE; +"EVENPERM_SWAP",EVENPERM_SWAP; +"EVENPERM_UNIQUE",EVENPERM_UNIQUE; +"EVENTUALLY_AND",EVENTUALLY_AND; +"EVENTUALLY_AT",EVENTUALLY_AT; +"EVENTUALLY_AT_INFINITY",EVENTUALLY_AT_INFINITY; +"EVENTUALLY_AT_INFINITY_POS",EVENTUALLY_AT_INFINITY_POS; +"EVENTUALLY_AT_NEGINFINITY",EVENTUALLY_AT_NEGINFINITY; +"EVENTUALLY_AT_POSINFINITY",EVENTUALLY_AT_POSINFINITY; +"EVENTUALLY_FALSE",EVENTUALLY_FALSE; +"EVENTUALLY_FORALL",EVENTUALLY_FORALL; +"EVENTUALLY_HAPPENS",EVENTUALLY_HAPPENS; +"EVENTUALLY_MONO",EVENTUALLY_MONO; +"EVENTUALLY_MP",EVENTUALLY_MP; +"EVENTUALLY_SEQUENTIALLY",EVENTUALLY_SEQUENTIALLY; +"EVENTUALLY_TRUE",EVENTUALLY_TRUE; +"EVENTUALLY_WITHIN",EVENTUALLY_WITHIN; +"EVENTUALLY_WITHIN_INTERIOR",EVENTUALLY_WITHIN_INTERIOR; +"EVENTUALLY_WITHIN_LE",EVENTUALLY_WITHIN_LE; +"EVEN_ADD",EVEN_ADD; +"EVEN_AND_ODD",EVEN_AND_ODD; +"EVEN_DOUBLE",EVEN_DOUBLE; +"EVEN_EXISTS",EVEN_EXISTS; +"EVEN_EXISTS_LEMMA",EVEN_EXISTS_LEMMA; +"EVEN_EXP",EVEN_EXP; +"EVEN_MOD",EVEN_MOD; +"EVEN_MULT",EVEN_MULT; +"EVEN_NSUM",EVEN_NSUM; +"EVEN_ODD_DECOMPOSITION",EVEN_ODD_DECOMPOSITION; +"EVEN_OR_ODD",EVEN_OR_ODD; +"EVEN_SUB",EVEN_SUB; +"EX",EX; +"EXCHANGE_LEMMA",EXCHANGE_LEMMA; +"EXCLUDED_MIDDLE",EXCLUDED_MIDDLE; +"EXISTS_ARC_PSUBSET_SIMPLE_PATH",EXISTS_ARC_PSUBSET_SIMPLE_PATH; +"EXISTS_BOOL_THM",EXISTS_BOOL_THM; +"EXISTS_COMPONENT_SUPERSET",EXISTS_COMPONENT_SUPERSET; +"EXISTS_COUNTABLE_SUBSET_IMAGE",EXISTS_COUNTABLE_SUBSET_IMAGE; +"EXISTS_CURRY",EXISTS_CURRY; +"EXISTS_DEF",EXISTS_DEF; +"EXISTS_DIFF",EXISTS_DIFF; +"EXISTS_DOUBLE_ARC",EXISTS_DOUBLE_ARC; +"EXISTS_DROP",EXISTS_DROP; +"EXISTS_DROP_FUN",EXISTS_DROP_FUN; +"EXISTS_DROP_IMAGE",EXISTS_DROP_IMAGE; +"EXISTS_EX",EXISTS_EX; +"EXISTS_FINITE_SUBSET_IMAGE",EXISTS_FINITE_SUBSET_IMAGE; +"EXISTS_IN_CLAUSES",EXISTS_IN_CLAUSES; +"EXISTS_IN_GSPEC",EXISTS_IN_GSPEC; +"EXISTS_IN_IMAGE",EXISTS_IN_IMAGE; +"EXISTS_IN_INSERT",EXISTS_IN_INSERT; +"EXISTS_IN_PCROSS",EXISTS_IN_PCROSS; +"EXISTS_IN_UNION",EXISTS_IN_UNION; +"EXISTS_IN_UNIONS",EXISTS_IN_UNIONS; +"EXISTS_LIFT",EXISTS_LIFT; +"EXISTS_LIFT_FUN",EXISTS_LIFT_FUN; +"EXISTS_LIFT_IMAGE",EXISTS_LIFT_IMAGE; +"EXISTS_NOT_THM",EXISTS_NOT_THM; +"EXISTS_ONE_REP",EXISTS_ONE_REP; +"EXISTS_OPTION",EXISTS_OPTION; +"EXISTS_OR_THM",EXISTS_OR_THM; +"EXISTS_PAIRED_THM",EXISTS_PAIRED_THM; +"EXISTS_PAIR_THM",EXISTS_PAIR_THM; +"EXISTS_PASTECART",EXISTS_PASTECART; +"EXISTS_PATH_SUBPATH_TO_FRONTIER",EXISTS_PATH_SUBPATH_TO_FRONTIER; +"EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED",EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED; +"EXISTS_REFL",EXISTS_REFL; +"EXISTS_SIMP",EXISTS_SIMP; +"EXISTS_SUBARC_OF_ARC_NOENDS",EXISTS_SUBARC_OF_ARC_NOENDS; +"EXISTS_SUBPATH_OF_ARC_NOENDS",EXISTS_SUBPATH_OF_ARC_NOENDS; +"EXISTS_SUBPATH_OF_PATH",EXISTS_SUBPATH_OF_PATH; +"EXISTS_SUBSET_IMAGE",EXISTS_SUBSET_IMAGE; +"EXISTS_SUBSET_UNION",EXISTS_SUBSET_UNION; +"EXISTS_SUM_THM",EXISTS_SUM_THM; +"EXISTS_SWAP",EXISTS_SWAP; +"EXISTS_THM",EXISTS_THM; +"EXISTS_TRIPLED_THM",EXISTS_TRIPLED_THM; +"EXISTS_UNCURRY",EXISTS_UNCURRY; +"EXISTS_UNIQUE",EXISTS_UNIQUE; +"EXISTS_UNIQUE_ALT",EXISTS_UNIQUE_ALT; +"EXISTS_UNIQUE_DEF",EXISTS_UNIQUE_DEF; +"EXISTS_UNIQUE_REFL",EXISTS_UNIQUE_REFL; +"EXISTS_UNIQUE_THM",EXISTS_UNIQUE_THM; +"EXISTS_UNPAIR_THM",EXISTS_UNPAIR_THM; +"EXISTS_VECTOR_1",EXISTS_VECTOR_1; +"EXISTS_VECTOR_2",EXISTS_VECTOR_2; +"EXISTS_VECTOR_3",EXISTS_VECTOR_3; +"EXISTS_VECTOR_4",EXISTS_VECTOR_4; +"EXP",EXP; +"EXPAND_CLOSED_OPEN_INTERVAL",EXPAND_CLOSED_OPEN_INTERVAL; +"EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL; +"EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_INTERIOR_CONVEX_HULL_MINIMAL; +"EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL; +"EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL",EXPLICIT_SUBSET_RELATIVE_INTERIOR_CONVEX_HULL_MINIMAL; +"EXPOSED_FACE_OF",EXPOSED_FACE_OF; +"EXPOSED_FACE_OF_INTER",EXPOSED_FACE_OF_INTER; +"EXPOSED_FACE_OF_INTERS",EXPOSED_FACE_OF_INTERS; +"EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"EXPOSED_FACE_OF_LINEAR_IMAGE",EXPOSED_FACE_OF_LINEAR_IMAGE; +"EXPOSED_FACE_OF_PARALLEL",EXPOSED_FACE_OF_PARALLEL; +"EXPOSED_FACE_OF_POLYHEDRON",EXPOSED_FACE_OF_POLYHEDRON; +"EXPOSED_FACE_OF_REFL",EXPOSED_FACE_OF_REFL; +"EXPOSED_FACE_OF_REFL_EQ",EXPOSED_FACE_OF_REFL_EQ; +"EXPOSED_FACE_OF_SUMS",EXPOSED_FACE_OF_SUMS; +"EXPOSED_FACE_OF_TRANSLATION_EQ",EXPOSED_FACE_OF_TRANSLATION_EQ; +"EXPOSED_POINT_OF_FURTHEST_POINT",EXPOSED_POINT_OF_FURTHEST_POINT; +"EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"EXP_1",EXP_1; +"EXP_2",EXP_2; +"EXP_ADD",EXP_ADD; +"EXP_EQ_0",EXP_EQ_0; +"EXP_EQ_1",EXP_EQ_1; +"EXP_LT_0",EXP_LT_0; +"EXP_MONO_EQ",EXP_MONO_EQ; +"EXP_MONO_LE",EXP_MONO_LE; +"EXP_MONO_LE_IMP",EXP_MONO_LE_IMP; +"EXP_MONO_LT",EXP_MONO_LT; +"EXP_MONO_LT_IMP",EXP_MONO_LT_IMP; +"EXP_MULT",EXP_MULT; +"EXP_ONE",EXP_ONE; +"EXP_ZERO",EXP_ZERO; +"EXTEND_FL",EXTEND_FL; +"EXTEND_INSEG",EXTEND_INSEG; +"EXTEND_LINSEG",EXTEND_LINSEG; +"EXTEND_TO_AFFINE_BASIS",EXTEND_TO_AFFINE_BASIS; +"EXTENSION",EXTENSION; +"EXTENSION_FROM_CLOPEN",EXTENSION_FROM_CLOPEN; +"EXTENSION_FROM_COMPONENT",EXTENSION_FROM_COMPONENT; +"EXTENSION_INTO_AR",EXTENSION_INTO_AR; +"EXTENSION_INTO_AR_LOCAL",EXTENSION_INTO_AR_LOCAL; +"EXTREME_POINTS_OF_CONVEX_HULL",EXTREME_POINTS_OF_CONVEX_HULL; +"EXTREME_POINTS_OF_CONVEX_HULL_EQ",EXTREME_POINTS_OF_CONVEX_HULL_EQ; +"EXTREME_POINTS_OF_LINEAR_IMAGE",EXTREME_POINTS_OF_LINEAR_IMAGE; +"EXTREME_POINTS_OF_TRANSLATION",EXTREME_POINTS_OF_TRANSLATION; +"EXTREME_POINT_EXISTS_CONVEX",EXTREME_POINT_EXISTS_CONVEX; +"EXTREME_POINT_NOT_IN_INTERIOR",EXTREME_POINT_NOT_IN_INTERIOR; +"EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR",EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; +"EXTREME_POINT_OF_CONIC",EXTREME_POINT_OF_CONIC; +"EXTREME_POINT_OF_CONVEX_HULL",EXTREME_POINT_OF_CONVEX_HULL; +"EXTREME_POINT_OF_CONVEX_HULL_2",EXTREME_POINT_OF_CONVEX_HULL_2; +"EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT; +"EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT",EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT; +"EXTREME_POINT_OF_CONVEX_HULL_EQ",EXTREME_POINT_OF_CONVEX_HULL_EQ; +"EXTREME_POINT_OF_CONVEX_HULL_INSERT",EXTREME_POINT_OF_CONVEX_HULL_INSERT; +"EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ",EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ; +"EXTREME_POINT_OF_EMPTY",EXTREME_POINT_OF_EMPTY; +"EXTREME_POINT_OF_FACE",EXTREME_POINT_OF_FACE; +"EXTREME_POINT_OF_INTER",EXTREME_POINT_OF_INTER; +"EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE",EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"EXTREME_POINT_OF_LINEAR_IMAGE",EXTREME_POINT_OF_LINEAR_IMAGE; +"EXTREME_POINT_OF_MIDPOINT",EXTREME_POINT_OF_MIDPOINT; +"EXTREME_POINT_OF_SEGMENT",EXTREME_POINT_OF_SEGMENT; +"EXTREME_POINT_OF_SING",EXTREME_POINT_OF_SING; +"EXTREME_POINT_OF_STILLCONVEX",EXTREME_POINT_OF_STILLCONVEX; +"EXTREME_POINT_OF_TRANSLATION_EQ",EXTREME_POINT_OF_TRANSLATION_EQ; +"EX_IMP",EX_IMP; +"EX_MAP",EX_MAP; +"EX_MEM",EX_MEM; +"FACES_OF_LINEAR_IMAGE",FACES_OF_LINEAR_IMAGE; +"FACES_OF_SIMPLEX",FACES_OF_SIMPLEX; +"FACES_OF_TRANSLATION",FACES_OF_TRANSLATION; +"FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT",FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT; +"FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT; +"FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT",FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT; +"FACET_OF_EMPTY",FACET_OF_EMPTY; +"FACET_OF_HALFSPACE_GE",FACET_OF_HALFSPACE_GE; +"FACET_OF_HALFSPACE_LE",FACET_OF_HALFSPACE_LE; +"FACET_OF_IMP_FACE_OF",FACET_OF_IMP_FACE_OF; +"FACET_OF_IMP_PROPER",FACET_OF_IMP_PROPER; +"FACET_OF_IMP_SUBSET",FACET_OF_IMP_SUBSET; +"FACET_OF_LINEAR_IMAGE",FACET_OF_LINEAR_IMAGE; +"FACET_OF_POLYHEDRON",FACET_OF_POLYHEDRON; +"FACET_OF_POLYHEDRON_EXPLICIT",FACET_OF_POLYHEDRON_EXPLICIT; +"FACET_OF_REFL",FACET_OF_REFL; +"FACET_OF_TRANSLATION_EQ",FACET_OF_TRANSLATION_EQ; +"FACE_OF_AFFINE_EQ",FACE_OF_AFFINE_EQ; +"FACE_OF_AFFINE_TRIVIAL",FACE_OF_AFFINE_TRIVIAL; +"FACE_OF_AFF_DIM_LT",FACE_OF_AFF_DIM_LT; +"FACE_OF_CONIC",FACE_OF_CONIC; +"FACE_OF_CONVEX_HULLS",FACE_OF_CONVEX_HULLS; +"FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT",FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT; +"FACE_OF_CONVEX_HULL_INSERT",FACE_OF_CONVEX_HULL_INSERT; +"FACE_OF_CONVEX_HULL_INSERT_EQ",FACE_OF_CONVEX_HULL_INSERT_EQ; +"FACE_OF_CONVEX_HULL_SUBSET",FACE_OF_CONVEX_HULL_SUBSET; +"FACE_OF_DISJOINT_INTERIOR",FACE_OF_DISJOINT_INTERIOR; +"FACE_OF_DISJOINT_RELATIVE_INTERIOR",FACE_OF_DISJOINT_RELATIVE_INTERIOR; +"FACE_OF_EMPTY",FACE_OF_EMPTY; +"FACE_OF_EQ",FACE_OF_EQ; +"FACE_OF_FACE",FACE_OF_FACE; +"FACE_OF_HALFSPACE_GE",FACE_OF_HALFSPACE_GE; +"FACE_OF_HALFSPACE_LE",FACE_OF_HALFSPACE_LE; +"FACE_OF_IMP_CLOSED",FACE_OF_IMP_CLOSED; +"FACE_OF_IMP_COMPACT",FACE_OF_IMP_COMPACT; +"FACE_OF_IMP_CONVEX",FACE_OF_IMP_CONVEX; +"FACE_OF_IMP_SUBSET",FACE_OF_IMP_SUBSET; +"FACE_OF_INTER",FACE_OF_INTER; +"FACE_OF_INTERS",FACE_OF_INTERS; +"FACE_OF_INTER_INTER",FACE_OF_INTER_INTER; +"FACE_OF_INTER_SUBFACE",FACE_OF_INTER_SUBFACE; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; +"FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG",FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG; +"FACE_OF_LINEAR_IMAGE",FACE_OF_LINEAR_IMAGE; +"FACE_OF_PCROSS",FACE_OF_PCROSS; +"FACE_OF_PCROSS_DECOMP",FACE_OF_PCROSS_DECOMP; +"FACE_OF_PCROSS_EQ",FACE_OF_PCROSS_EQ; +"FACE_OF_POLYHEDRON",FACE_OF_POLYHEDRON; +"FACE_OF_POLYHEDRON_EXPLICIT",FACE_OF_POLYHEDRON_EXPLICIT; +"FACE_OF_POLYHEDRON_POLYHEDRON",FACE_OF_POLYHEDRON_POLYHEDRON; +"FACE_OF_POLYHEDRON_SUBSET_EXPLICIT",FACE_OF_POLYHEDRON_SUBSET_EXPLICIT; +"FACE_OF_POLYHEDRON_SUBSET_FACET",FACE_OF_POLYHEDRON_SUBSET_FACET; +"FACE_OF_POLYTOPE_POLYTOPE",FACE_OF_POLYTOPE_POLYTOPE; +"FACE_OF_REFL",FACE_OF_REFL; +"FACE_OF_REFL_EQ",FACE_OF_REFL_EQ; +"FACE_OF_SIMPLEX_SUBSET",FACE_OF_SIMPLEX_SUBSET; +"FACE_OF_SING",FACE_OF_SING; +"FACE_OF_SLICE",FACE_OF_SLICE; +"FACE_OF_STILLCONVEX",FACE_OF_STILLCONVEX; +"FACE_OF_SUBSET",FACE_OF_SUBSET; +"FACE_OF_SUBSET_RELATIVE_BOUNDARY",FACE_OF_SUBSET_RELATIVE_BOUNDARY; +"FACE_OF_SUBSET_RELATIVE_FRONTIER",FACE_OF_SUBSET_RELATIVE_FRONTIER; +"FACE_OF_TRANS",FACE_OF_TRANS; +"FACE_OF_TRANSLATION_EQ",FACE_OF_TRANSLATION_EQ; +"FACT",FACT; +"FACT_LE",FACT_LE; +"FACT_LT",FACT_LT; +"FACT_MONO",FACT_MONO; +"FACT_NZ",FACT_NZ; +"FARKAS_LEMMA",FARKAS_LEMMA; +"FARKAS_LEMMA_ALT",FARKAS_LEMMA_ALT; +"FASHODA",FASHODA; +"FASHODA_INTERLACE",FASHODA_INTERLACE; +"FASHODA_UNIT",FASHODA_UNIT; +"FASHODA_UNIT_PATH",FASHODA_UNIT_PATH; +"FATOU",FATOU; +"FCONS",FCONS; +"FCONS_UNDO",FCONS_UNDO; +"FILTER",FILTER; +"FILTER_APPEND",FILTER_APPEND; +"FILTER_MAP",FILTER_MAP; +"FINE_DIVISION_EXISTS",FINE_DIVISION_EXISTS; +"FINE_INTER",FINE_INTER; +"FINE_INTERS",FINE_INTERS; +"FINE_SUBSET",FINE_SUBSET; +"FINE_UNION",FINE_UNION; +"FINE_UNIONS",FINE_UNIONS; +"FINITELY_GENERATED_CONIC_POLYHEDRON",FINITELY_GENERATED_CONIC_POLYHEDRON; +"FINITE_ANR_COMPONENTS",FINITE_ANR_COMPONENTS; +"FINITE_BALL",FINITE_BALL; +"FINITE_BITSET",FINITE_BITSET; +"FINITE_BOOL",FINITE_BOOL; +"FINITE_BOUNDED_FUNCTIONS",FINITE_BOUNDED_FUNCTIONS; +"FINITE_CARD_LT",FINITE_CARD_LT; +"FINITE_CART",FINITE_CART; +"FINITE_CART_SUBSET_LEMMA",FINITE_CART_SUBSET_LEMMA; +"FINITE_CART_UNIV",FINITE_CART_UNIV; +"FINITE_CASES",FINITE_CASES; +"FINITE_CBALL",FINITE_CBALL; +"FINITE_COLUMNS",FINITE_COLUMNS; +"FINITE_COMPLEMENT_ANR_COMPONENTS",FINITE_COMPLEMENT_ANR_COMPONENTS; +"FINITE_COMPLEMENT_ENR_COMPONENTS",FINITE_COMPLEMENT_ENR_COMPONENTS; +"FINITE_COMPONENTS",FINITE_COMPONENTS; +"FINITE_CROSS",FINITE_CROSS; +"FINITE_DELETE",FINITE_DELETE; +"FINITE_DELETE_IMP",FINITE_DELETE_IMP; +"FINITE_DIFF",FINITE_DIFF; +"FINITE_EMPTY",FINITE_EMPTY; +"FINITE_EMPTY_INTERIOR",FINITE_EMPTY_INTERIOR; +"FINITE_ENR_COMPONENTS",FINITE_ENR_COMPONENTS; +"FINITE_FACES_OF_SIMPLEX",FINITE_FACES_OF_SIMPLEX; +"FINITE_FINITE_IMAGE",FINITE_FINITE_IMAGE; +"FINITE_FINITE_PREIMAGE",FINITE_FINITE_PREIMAGE; +"FINITE_FINITE_PREIMAGE_GENERAL",FINITE_FINITE_PREIMAGE_GENERAL; +"FINITE_FINITE_UNIONS",FINITE_FINITE_UNIONS; +"FINITE_FUNSPACE",FINITE_FUNSPACE; +"FINITE_FUNSPACE_UNIV",FINITE_FUNSPACE_UNIV; +"FINITE_HAS_SIZE",FINITE_HAS_SIZE; +"FINITE_IMAGE",FINITE_IMAGE; +"FINITE_IMAGE_EXPAND",FINITE_IMAGE_EXPAND; +"FINITE_IMAGE_IMAGE",FINITE_IMAGE_IMAGE; +"FINITE_IMAGE_INJ",FINITE_IMAGE_INJ; +"FINITE_IMAGE_INJ_EQ",FINITE_IMAGE_INJ_EQ; +"FINITE_IMAGE_INJ_GENERAL",FINITE_IMAGE_INJ_GENERAL; +"FINITE_IMP_ANR",FINITE_IMP_ANR; +"FINITE_IMP_BOUNDED",FINITE_IMP_BOUNDED; +"FINITE_IMP_BOUNDED_CONVEX_HULL",FINITE_IMP_BOUNDED_CONVEX_HULL; +"FINITE_IMP_CLOSED",FINITE_IMP_CLOSED; +"FINITE_IMP_CLOSED_IN",FINITE_IMP_CLOSED_IN; +"FINITE_IMP_COMPACT",FINITE_IMP_COMPACT; +"FINITE_IMP_COMPACT_CONVEX_HULL",FINITE_IMP_COMPACT_CONVEX_HULL; +"FINITE_IMP_COUNTABLE",FINITE_IMP_COUNTABLE; +"FINITE_IMP_ENR",FINITE_IMP_ENR; +"FINITE_IMP_NOT_OPEN",FINITE_IMP_NOT_OPEN; +"FINITE_INDEX_INJ",FINITE_INDEX_INJ; +"FINITE_INDEX_INRANGE",FINITE_INDEX_INRANGE; +"FINITE_INDEX_INRANGE_2",FINITE_INDEX_INRANGE_2; +"FINITE_INDEX_NUMBERS",FINITE_INDEX_NUMBERS; +"FINITE_INDEX_NUMSEG",FINITE_INDEX_NUMSEG; +"FINITE_INDEX_NUMSEG_SPECIAL",FINITE_INDEX_NUMSEG_SPECIAL; +"FINITE_INDEX_WORKS",FINITE_INDEX_WORKS; +"FINITE_INDUCT",FINITE_INDUCT; +"FINITE_INDUCT_DELETE",FINITE_INDUCT_DELETE; +"FINITE_INDUCT_STRONG",FINITE_INDUCT_STRONG; +"FINITE_INSERT",FINITE_INSERT; +"FINITE_INTER",FINITE_INTER; +"FINITE_INTERVAL_1",FINITE_INTERVAL_1; +"FINITE_INTER_COLLINEAR_OPEN_SEGMENTS",FINITE_INTER_COLLINEAR_OPEN_SEGMENTS; +"FINITE_INTER_NUMSEG",FINITE_INTER_NUMSEG; +"FINITE_INTSEG",FINITE_INTSEG; +"FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS",FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS; +"FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS",FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS; +"FINITE_MULTIVECTOR",FINITE_MULTIVECTOR; +"FINITE_NUMSEG",FINITE_NUMSEG; +"FINITE_NUMSEG_LE",FINITE_NUMSEG_LE; +"FINITE_NUMSEG_LT",FINITE_NUMSEG_LT; +"FINITE_PCROSS",FINITE_PCROSS; +"FINITE_PCROSS_EQ",FINITE_PCROSS_EQ; +"FINITE_PERMUTATIONS",FINITE_PERMUTATIONS; +"FINITE_POLYHEDRON_EXPOSED_FACES",FINITE_POLYHEDRON_EXPOSED_FACES; +"FINITE_POLYHEDRON_EXTREME_POINTS",FINITE_POLYHEDRON_EXTREME_POINTS; +"FINITE_POLYHEDRON_FACES",FINITE_POLYHEDRON_FACES; +"FINITE_POLYHEDRON_FACETS",FINITE_POLYHEDRON_FACETS; +"FINITE_POLYTOPE_FACES",FINITE_POLYTOPE_FACES; +"FINITE_POLYTOPE_FACETS",FINITE_POLYTOPE_FACETS; +"FINITE_POWERSET",FINITE_POWERSET; +"FINITE_PRODUCT",FINITE_PRODUCT; +"FINITE_PRODUCT_DEPENDENT",FINITE_PRODUCT_DEPENDENT; +"FINITE_REAL_INTERVAL",FINITE_REAL_INTERVAL; +"FINITE_RECURSION",FINITE_RECURSION; +"FINITE_RECURSION_DELETE",FINITE_RECURSION_DELETE; +"FINITE_RESTRICT",FINITE_RESTRICT; +"FINITE_ROWS",FINITE_ROWS; +"FINITE_RULES",FINITE_RULES; +"FINITE_SEGMENT",FINITE_SEGMENT; +"FINITE_SET_AVOID",FINITE_SET_AVOID; +"FINITE_SET_OF_LIST",FINITE_SET_OF_LIST; +"FINITE_SIMPLICES",FINITE_SIMPLICES; +"FINITE_SING",FINITE_SING; +"FINITE_SPHERE",FINITE_SPHERE; +"FINITE_SPHERE_1",FINITE_SPHERE_1; +"FINITE_STDBASIS",FINITE_STDBASIS; +"FINITE_SUBSET",FINITE_SUBSET; +"FINITE_SUBSET_IMAGE",FINITE_SUBSET_IMAGE; +"FINITE_SUBSET_IMAGE_IMP",FINITE_SUBSET_IMAGE_IMP; +"FINITE_SUM_IMAGE",FINITE_SUM_IMAGE; +"FINITE_SUPPORT",FINITE_SUPPORT; +"FINITE_SUPPORT_DELTA",FINITE_SUPPORT_DELTA; +"FINITE_TRANSITIVITY_CHAIN",FINITE_TRANSITIVITY_CHAIN; +"FINITE_UNION",FINITE_UNION; +"FINITE_UNIONS",FINITE_UNIONS; +"FINITE_UNION_IMP",FINITE_UNION_IMP; +"FINREC",FINREC; +"FINREC_1_LEMMA",FINREC_1_LEMMA; +"FINREC_EXISTS_LEMMA",FINREC_EXISTS_LEMMA; +"FINREC_FUN",FINREC_FUN; +"FINREC_FUN_LEMMA",FINREC_FUN_LEMMA; +"FINREC_SUC_LEMMA",FINREC_SUC_LEMMA; +"FINREC_UNIQUE_LEMMA",FINREC_UNIQUE_LEMMA; +"FIXED_POINT_INESSENTIAL_SPHERE_MAP",FIXED_POINT_INESSENTIAL_SPHERE_MAP; +"FIXING_SWAPSEQ_DECREASE",FIXING_SWAPSEQ_DECREASE; +"FLATTEN_LEMMA",FLATTEN_LEMMA; +"FLOOR",FLOOR; +"FLOOR_DIV_DIV",FLOOR_DIV_DIV; +"FLOOR_DOUBLE",FLOOR_DOUBLE; +"FLOOR_EQ_0",FLOOR_EQ_0; +"FLOOR_FRAC",FLOOR_FRAC; +"FLOOR_MONO",FLOOR_MONO; +"FLOOR_NUM",FLOOR_NUM; +"FLOOR_POS",FLOOR_POS; +"FLOOR_POS_LE",FLOOR_POS_LE; +"FLOOR_UNIQUE",FLOOR_UNIQUE; +"FL_RESTRICT",FL_RESTRICT; +"FL_RESTRICTED_SUBSET",FL_RESTRICTED_SUBSET; +"FL_SUC",FL_SUC; +"FNIL",FNIL; +"FORALL_1",FORALL_1; +"FORALL_2",FORALL_2; +"FORALL_3",FORALL_3; +"FORALL_4",FORALL_4; +"FORALL_ALL",FORALL_ALL; +"FORALL_AND_THM",FORALL_AND_THM; +"FORALL_BOOL_THM",FORALL_BOOL_THM; +"FORALL_COUNTABLE_AS_IMAGE",FORALL_COUNTABLE_AS_IMAGE; +"FORALL_COUNTABLE_SUBSET_IMAGE",FORALL_COUNTABLE_SUBSET_IMAGE; +"FORALL_CURRY",FORALL_CURRY; +"FORALL_DEF",FORALL_DEF; +"FORALL_DIMINDEX_1",FORALL_DIMINDEX_1; +"FORALL_DOT_EQ_0",FORALL_DOT_EQ_0; +"FORALL_DROP",FORALL_DROP; +"FORALL_DROP_FUN",FORALL_DROP_FUN; +"FORALL_DROP_IMAGE",FORALL_DROP_IMAGE; +"FORALL_EVENTUALLY",FORALL_EVENTUALLY; +"FORALL_FINITE_INDEX",FORALL_FINITE_INDEX; +"FORALL_FINITE_SUBSET_IMAGE",FORALL_FINITE_SUBSET_IMAGE; +"FORALL_INTEGER",FORALL_INTEGER; +"FORALL_IN_CLAUSES",FORALL_IN_CLAUSES; +"FORALL_IN_CLOSURE",FORALL_IN_CLOSURE; +"FORALL_IN_CLOSURE_EQ",FORALL_IN_CLOSURE_EQ; +"FORALL_IN_DIVISION",FORALL_IN_DIVISION; +"FORALL_IN_DIVISION_NONEMPTY",FORALL_IN_DIVISION_NONEMPTY; +"FORALL_IN_GSPEC",FORALL_IN_GSPEC; +"FORALL_IN_IMAGE",FORALL_IN_IMAGE; +"FORALL_IN_INSERT",FORALL_IN_INSERT; +"FORALL_IN_PCROSS",FORALL_IN_PCROSS; +"FORALL_IN_UNION",FORALL_IN_UNION; +"FORALL_IN_UNIONS",FORALL_IN_UNIONS; +"FORALL_LIFT",FORALL_LIFT; +"FORALL_LIFT_FUN",FORALL_LIFT_FUN; +"FORALL_LIFT_IMAGE",FORALL_LIFT_IMAGE; +"FORALL_MULTIVECTOR",FORALL_MULTIVECTOR; +"FORALL_NOT_THM",FORALL_NOT_THM; +"FORALL_OF_DROP",FORALL_OF_DROP; +"FORALL_OF_PASTECART",FORALL_OF_PASTECART; +"FORALL_OPTION",FORALL_OPTION; +"FORALL_PAIRED_THM",FORALL_PAIRED_THM; +"FORALL_PAIR_THM",FORALL_PAIR_THM; +"FORALL_PASTECART",FORALL_PASTECART; +"FORALL_POS_MONO",FORALL_POS_MONO; +"FORALL_POS_MONO_1",FORALL_POS_MONO_1; +"FORALL_REAL_ONE",FORALL_REAL_ONE; +"FORALL_SETCODE",FORALL_SETCODE; +"FORALL_SIMP",FORALL_SIMP; +"FORALL_SUBSET_IMAGE",FORALL_SUBSET_IMAGE; +"FORALL_SUBSET_UNION",FORALL_SUBSET_UNION; +"FORALL_SUC",FORALL_SUC; +"FORALL_SUM_THM",FORALL_SUM_THM; +"FORALL_TRIPLED_THM",FORALL_TRIPLED_THM; +"FORALL_UNCURRY",FORALL_UNCURRY; +"FORALL_UNPAIR_THM",FORALL_UNPAIR_THM; +"FORALL_UNWIND_THM1",FORALL_UNWIND_THM1; +"FORALL_UNWIND_THM2",FORALL_UNWIND_THM2; +"FORALL_VECTOR_1",FORALL_VECTOR_1; +"FORALL_VECTOR_2",FORALL_VECTOR_2; +"FORALL_VECTOR_3",FORALL_VECTOR_3; +"FORALL_VECTOR_4",FORALL_VECTOR_4; +"FRAC_FLOOR",FRAC_FLOOR; +"FRAC_NUM",FRAC_NUM; +"FRAC_UNIQUE",FRAC_UNIQUE; +"FRECHET_DERIVATIVE_AT",FRECHET_DERIVATIVE_AT; +"FRECHET_DERIVATIVE_CONST_AT",FRECHET_DERIVATIVE_CONST_AT; +"FRECHET_DERIVATIVE_UNIQUE_AT",FRECHET_DERIVATIVE_UNIQUE_AT; +"FRECHET_DERIVATIVE_UNIQUE_WITHIN",FRECHET_DERIVATIVE_UNIQUE_WITHIN; +"FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; +"FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL",FRECHET_DERIVATIVE_UNIQUE_WITHIN_OPEN_INTERVAL; +"FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL",FRECHET_DERIVATIVE_WITHIN_CLOSED_INTERVAL; +"FRECHET_DERIVATIVE_WORKS",FRECHET_DERIVATIVE_WORKS; +"FROM_0",FROM_0; +"FROM_INTER_NUMSEG",FROM_INTER_NUMSEG; +"FROM_INTER_NUMSEG_GEN",FROM_INTER_NUMSEG_GEN; +"FROM_INTER_NUMSEG_MAX",FROM_INTER_NUMSEG_MAX; +"FRONTIER_BALL",FRONTIER_BALL; +"FRONTIER_BIJECTIVE_LINEAR_IMAGE",FRONTIER_BIJECTIVE_LINEAR_IMAGE; +"FRONTIER_CBALL",FRONTIER_CBALL; +"FRONTIER_CLOSED",FRONTIER_CLOSED; +"FRONTIER_CLOSED_INTERVAL",FRONTIER_CLOSED_INTERVAL; +"FRONTIER_CLOSURES",FRONTIER_CLOSURES; +"FRONTIER_CLOSURE_CONVEX",FRONTIER_CLOSURE_CONVEX; +"FRONTIER_CLOSURE_SUBSET",FRONTIER_CLOSURE_SUBSET; +"FRONTIER_COMPLEMENT",FRONTIER_COMPLEMENT; +"FRONTIER_CONVEX_HULL_CASES",FRONTIER_CONVEX_HULL_CASES; +"FRONTIER_CONVEX_HULL_EXPLICIT",FRONTIER_CONVEX_HULL_EXPLICIT; +"FRONTIER_DISJOINT_EQ",FRONTIER_DISJOINT_EQ; +"FRONTIER_EMPTY",FRONTIER_EMPTY; +"FRONTIER_EQ_EMPTY",FRONTIER_EQ_EMPTY; +"FRONTIER_FRONTIER",FRONTIER_FRONTIER; +"FRONTIER_FRONTIER_FRONTIER",FRONTIER_FRONTIER_FRONTIER; +"FRONTIER_FRONTIER_SUBSET",FRONTIER_FRONTIER_SUBSET; +"FRONTIER_HALFSPACE_GE",FRONTIER_HALFSPACE_GE; +"FRONTIER_HALFSPACE_GT",FRONTIER_HALFSPACE_GT; +"FRONTIER_HALFSPACE_LE",FRONTIER_HALFSPACE_LE; +"FRONTIER_HALFSPACE_LT",FRONTIER_HALFSPACE_LT; +"FRONTIER_INJECTIVE_LINEAR_IMAGE",FRONTIER_INJECTIVE_LINEAR_IMAGE; +"FRONTIER_INSIDE_SUBSET",FRONTIER_INSIDE_SUBSET; +"FRONTIER_INTERIORS",FRONTIER_INTERIORS; +"FRONTIER_INTERIOR_SUBSET",FRONTIER_INTERIOR_SUBSET; +"FRONTIER_INTER_SUBSET",FRONTIER_INTER_SUBSET; +"FRONTIER_INTER_SUBSET_INTER",FRONTIER_INTER_SUBSET_INTER; +"FRONTIER_MINIMAL_SEPARATING_CLOSED",FRONTIER_MINIMAL_SEPARATING_CLOSED; +"FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE",FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE; +"FRONTIER_NOT_EMPTY",FRONTIER_NOT_EMPTY; +"FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT",FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; +"FRONTIER_OF_COMPONENTS_SUBSET",FRONTIER_OF_COMPONENTS_SUBSET; +"FRONTIER_OF_CONNECTED_COMPONENT_SUBSET",FRONTIER_OF_CONNECTED_COMPONENT_SUBSET; +"FRONTIER_OF_CONVEX_HULL",FRONTIER_OF_CONVEX_HULL; +"FRONTIER_OF_TRIANGLE",FRONTIER_OF_TRIANGLE; +"FRONTIER_OPEN_INTERVAL",FRONTIER_OPEN_INTERVAL; +"FRONTIER_OUTSIDE_SUBSET",FRONTIER_OUTSIDE_SUBSET; +"FRONTIER_PCROSS",FRONTIER_PCROSS; +"FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE",FRONTIER_RETRACT_OF_PUNCTURED_UNIVERSE; +"FRONTIER_SING",FRONTIER_SING; +"FRONTIER_STRADDLE",FRONTIER_STRADDLE; +"FRONTIER_SUBSET_CLOSED",FRONTIER_SUBSET_CLOSED; +"FRONTIER_SUBSET_COMPACT",FRONTIER_SUBSET_COMPACT; +"FRONTIER_SUBSET_EQ",FRONTIER_SUBSET_EQ; +"FRONTIER_SUBSET_RETRACTION",FRONTIER_SUBSET_RETRACTION; +"FRONTIER_SURJECTIVE_LINEAR_IMAGE",FRONTIER_SURJECTIVE_LINEAR_IMAGE; +"FRONTIER_TRANSLATION",FRONTIER_TRANSLATION; +"FRONTIER_UNION",FRONTIER_UNION; +"FRONTIER_UNIONS_SUBSET",FRONTIER_UNIONS_SUBSET; +"FRONTIER_UNIONS_SUBSET_CLOSURE",FRONTIER_UNIONS_SUBSET_CLOSURE; +"FRONTIER_UNION_SUBSET",FRONTIER_UNION_SUBSET; +"FRONTIER_UNIV",FRONTIER_UNIV; +"FST",FST; +"FSTCART_ADD",FSTCART_ADD; +"FSTCART_CMUL",FSTCART_CMUL; +"FSTCART_NEG",FSTCART_NEG; +"FSTCART_PASTECART",FSTCART_PASTECART; +"FSTCART_SUB",FSTCART_SUB; +"FSTCART_VEC",FSTCART_VEC; +"FSTCART_VSUM",FSTCART_VSUM; +"FST_DEF",FST_DEF; +"FUBINI_ABSOLUTELY_INTEGRABLE",FUBINI_ABSOLUTELY_INTEGRABLE; +"FUBINI_ABSOLUTELY_INTEGRABLE_ALT",FUBINI_ABSOLUTELY_INTEGRABLE_ALT; +"FUBINI_INTEGRAL",FUBINI_INTEGRAL; +"FUBINI_INTEGRAL_ALT",FUBINI_INTEGRAL_ALT; +"FUBINI_INTEGRAL_INTERVAL",FUBINI_INTEGRAL_INTERVAL; +"FUBINI_INTEGRAL_INTERVAL_ALT",FUBINI_INTEGRAL_INTERVAL_ALT; +"FUBINI_LEBESGUE_MEASURABLE",FUBINI_LEBESGUE_MEASURABLE; +"FUBINI_LEBESGUE_MEASURABLE_ALT",FUBINI_LEBESGUE_MEASURABLE_ALT; +"FUBINI_MEASURE",FUBINI_MEASURE; +"FUBINI_MEASURE_ALT",FUBINI_MEASURE_ALT; +"FUBINI_NEGLIGIBLE",FUBINI_NEGLIGIBLE; +"FUBINI_NEGLIGIBLE_ALT",FUBINI_NEGLIGIBLE_ALT; +"FUBINI_TONELLI",FUBINI_TONELLI; +"FUBINI_TONELLI_ALT",FUBINI_TONELLI_ALT; +"FUBINI_TONELLI_MEASURE",FUBINI_TONELLI_MEASURE; +"FUBINI_TONELLI_MEASURE_ALT",FUBINI_TONELLI_MEASURE_ALT; +"FUBINI_TONELLI_NEGLIGIBLE",FUBINI_TONELLI_NEGLIGIBLE; +"FUBINI_TONELLI_NEGLIGIBLE_ALT",FUBINI_TONELLI_NEGLIGIBLE_ALT; +"FULL_RANK_INJECTIVE",FULL_RANK_INJECTIVE; +"FULL_RANK_SURJECTIVE",FULL_RANK_SURJECTIVE; +"FUNCTION_CONVERGENT_SUBSEQUENCE",FUNCTION_CONVERGENT_SUBSEQUENCE; +"FUNCTION_FACTORS_LEFT",FUNCTION_FACTORS_LEFT; +"FUNCTION_FACTORS_LEFT_GEN",FUNCTION_FACTORS_LEFT_GEN; +"FUNCTION_FACTORS_RIGHT",FUNCTION_FACTORS_RIGHT; +"FUNCTION_FACTORS_RIGHT_GEN",FUNCTION_FACTORS_RIGHT_GEN; +"FUNDAMENTAL_THEOREM_OF_CALCULUS",FUNDAMENTAL_THEOREM_OF_CALCULUS; +"FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR; +"FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG; +"FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG",FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG; +"FUN_EQ_THM",FUN_EQ_THM; +"FUN_IN_IMAGE",FUN_IN_IMAGE; +"F_DEF",F_DEF; +"GABS_DEF",GABS_DEF; +"GAUGE_BALL",GAUGE_BALL; +"GAUGE_BALL_DEPENDENT",GAUGE_BALL_DEPENDENT; +"GAUGE_EXISTENCE_LEMMA",GAUGE_EXISTENCE_LEMMA; +"GAUGE_INTER",GAUGE_INTER; +"GAUGE_INTERS",GAUGE_INTERS; +"GAUGE_MODIFY",GAUGE_MODIFY; +"GAUGE_TRIVIAL",GAUGE_TRIVIAL; +"GE",GE; +"GENERAL_CONNECTED_OPEN",GENERAL_CONNECTED_OPEN; +"GEOM_ASSOC",GEOM_ASSOC; +"GEOM_LADD",GEOM_LADD; +"GEOM_LMUL",GEOM_LMUL; +"GEOM_LNEG",GEOM_LNEG; +"GEOM_LZERO",GEOM_LZERO; +"GEOM_MBASIS",GEOM_MBASIS; +"GEOM_MBASIS_SING",GEOM_MBASIS_SING; +"GEOM_RADD",GEOM_RADD; +"GEOM_RMUL",GEOM_RMUL; +"GEOM_RNEG",GEOM_RNEG; +"GEOM_RZERO",GEOM_RZERO; +"GEQ_DEF",GEQ_DEF; +"GE_C",GE_C; +"GE_REFL",GE_REFL; +"GRADE_ADD",GRADE_ADD; +"GRADE_CMUL",GRADE_CMUL; +"GRAM_SCHMIDT_STEP",GRAM_SCHMIDT_STEP; +"GRASSMANN_PLUCKER_2",GRASSMANN_PLUCKER_2; +"GRASSMANN_PLUCKER_3",GRASSMANN_PLUCKER_3; +"GRASSMANN_PLUCKER_4",GRASSMANN_PLUCKER_4; +"GSPEC",GSPEC; +"GT",GT; +"HALFSPACE_EQ_EMPTY_GE",HALFSPACE_EQ_EMPTY_GE; +"HALFSPACE_EQ_EMPTY_GT",HALFSPACE_EQ_EMPTY_GT; +"HALFSPACE_EQ_EMPTY_LE",HALFSPACE_EQ_EMPTY_LE; +"HALFSPACE_EQ_EMPTY_LT",HALFSPACE_EQ_EMPTY_LT; +"HAS_ANTIDERIVATIVE_LIMIT",HAS_ANTIDERIVATIVE_LIMIT; +"HAS_ANTIDERIVATIVE_SEQUENCE",HAS_ANTIDERIVATIVE_SEQUENCE; +"HAS_BOUNDED_SETVARIATION_ON",HAS_BOUNDED_SETVARIATION_ON; +"HAS_BOUNDED_SETVARIATION_ON_0",HAS_BOUNDED_SETVARIATION_ON_0; +"HAS_BOUNDED_SETVARIATION_ON_ADD",HAS_BOUNDED_SETVARIATION_ON_ADD; +"HAS_BOUNDED_SETVARIATION_ON_CMUL",HAS_BOUNDED_SETVARIATION_ON_CMUL; +"HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE",HAS_BOUNDED_SETVARIATION_ON_COMPONENTWISE; +"HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_SETVARIATION_ON_COMPOSE_LINEAR; +"HAS_BOUNDED_SETVARIATION_ON_DIVISION",HAS_BOUNDED_SETVARIATION_ON_DIVISION; +"HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_ON_ELEMENTARY; +"HAS_BOUNDED_SETVARIATION_ON_EQ",HAS_BOUNDED_SETVARIATION_ON_EQ; +"HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_SETVARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; +"HAS_BOUNDED_SETVARIATION_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_ON_INTERVAL; +"HAS_BOUNDED_SETVARIATION_ON_NEG",HAS_BOUNDED_SETVARIATION_ON_NEG; +"HAS_BOUNDED_SETVARIATION_ON_NORM",HAS_BOUNDED_SETVARIATION_ON_NORM; +"HAS_BOUNDED_SETVARIATION_ON_NULL",HAS_BOUNDED_SETVARIATION_ON_NULL; +"HAS_BOUNDED_SETVARIATION_ON_SUB",HAS_BOUNDED_SETVARIATION_ON_SUB; +"HAS_BOUNDED_SETVARIATION_ON_SUBSET",HAS_BOUNDED_SETVARIATION_ON_SUBSET; +"HAS_BOUNDED_SETVARIATION_ON_UNIV",HAS_BOUNDED_SETVARIATION_ON_UNIV; +"HAS_BOUNDED_SETVARIATION_REFLECT2_EQ",HAS_BOUNDED_SETVARIATION_REFLECT2_EQ; +"HAS_BOUNDED_SETVARIATION_TRANSLATION",HAS_BOUNDED_SETVARIATION_TRANSLATION; +"HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ",HAS_BOUNDED_SETVARIATION_TRANSLATION2_EQ; +"HAS_BOUNDED_SETVARIATION_WORKS",HAS_BOUNDED_SETVARIATION_WORKS; +"HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY",HAS_BOUNDED_SETVARIATION_WORKS_ON_ELEMENTARY; +"HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL",HAS_BOUNDED_SETVARIATION_WORKS_ON_INTERVAL; +"HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE",HAS_BOUNDED_VARIATION_ABSOLUTELY_INTEGRABLE_DERIVATIVE; +"HAS_BOUNDED_VARIATION_AFFINITY2_EQ",HAS_BOUNDED_VARIATION_AFFINITY2_EQ; +"HAS_BOUNDED_VARIATION_AFFINITY_EQ",HAS_BOUNDED_VARIATION_AFFINITY_EQ; +"HAS_BOUNDED_VARIATION_COMPOSE_DECREASING",HAS_BOUNDED_VARIATION_COMPOSE_DECREASING; +"HAS_BOUNDED_VARIATION_COMPOSE_INCREASING",HAS_BOUNDED_VARIATION_COMPOSE_INCREASING; +"HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES",HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES; +"HAS_BOUNDED_VARIATION_DARBOUX",HAS_BOUNDED_VARIATION_DARBOUX; +"HAS_BOUNDED_VARIATION_DARBOUX_STRICT",HAS_BOUNDED_VARIATION_DARBOUX_STRICT; +"HAS_BOUNDED_VARIATION_DARBOUX_STRONG",HAS_BOUNDED_VARIATION_DARBOUX_STRONG; +"HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE",HAS_BOUNDED_VARIATION_INTEGRABLE_NORM_DERIVATIVE; +"HAS_BOUNDED_VARIATION_ON_ADD",HAS_BOUNDED_VARIATION_ON_ADD; +"HAS_BOUNDED_VARIATION_ON_CMUL",HAS_BOUNDED_VARIATION_ON_CMUL; +"HAS_BOUNDED_VARIATION_ON_COMBINE",HAS_BOUNDED_VARIATION_ON_COMBINE; +"HAS_BOUNDED_VARIATION_ON_COMPONENTWISE",HAS_BOUNDED_VARIATION_ON_COMPONENTWISE; +"HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR",HAS_BOUNDED_VARIATION_ON_COMPOSE_LINEAR; +"HAS_BOUNDED_VARIATION_ON_CONST",HAS_BOUNDED_VARIATION_ON_CONST; +"HAS_BOUNDED_VARIATION_ON_DIVISION",HAS_BOUNDED_VARIATION_ON_DIVISION; +"HAS_BOUNDED_VARIATION_ON_EMPTY",HAS_BOUNDED_VARIATION_ON_EMPTY; +"HAS_BOUNDED_VARIATION_ON_EQ",HAS_BOUNDED_VARIATION_ON_EQ; +"HAS_BOUNDED_VARIATION_ON_ID",HAS_BOUNDED_VARIATION_ON_ID; +"HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL; +"HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS",HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_SUBINTERVALS; +"HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_LEFT; +"HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT",HAS_BOUNDED_VARIATION_ON_INDEFINITE_INTEGRAL_RIGHT; +"HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE",HAS_BOUNDED_VARIATION_ON_LINEAR_IMAGE; +"HAS_BOUNDED_VARIATION_ON_MAX",HAS_BOUNDED_VARIATION_ON_MAX; +"HAS_BOUNDED_VARIATION_ON_MIN",HAS_BOUNDED_VARIATION_ON_MIN; +"HAS_BOUNDED_VARIATION_ON_MUL",HAS_BOUNDED_VARIATION_ON_MUL; +"HAS_BOUNDED_VARIATION_ON_NEG",HAS_BOUNDED_VARIATION_ON_NEG; +"HAS_BOUNDED_VARIATION_ON_NORM",HAS_BOUNDED_VARIATION_ON_NORM; +"HAS_BOUNDED_VARIATION_ON_NULL",HAS_BOUNDED_VARIATION_ON_NULL; +"HAS_BOUNDED_VARIATION_ON_REFLECT",HAS_BOUNDED_VARIATION_ON_REFLECT; +"HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL",HAS_BOUNDED_VARIATION_ON_REFLECT_INTERVAL; +"HAS_BOUNDED_VARIATION_ON_SUB",HAS_BOUNDED_VARIATION_ON_SUB; +"HAS_BOUNDED_VARIATION_ON_SUBSET",HAS_BOUNDED_VARIATION_ON_SUBSET; +"HAS_BOUNDED_VARIATION_REFLECT2_EQ",HAS_BOUNDED_VARIATION_REFLECT2_EQ; +"HAS_BOUNDED_VARIATION_REFLECT_EQ",HAS_BOUNDED_VARIATION_REFLECT_EQ; +"HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL",HAS_BOUNDED_VARIATION_REFLECT_EQ_INTERVAL; +"HAS_BOUNDED_VARIATION_TRANSLATION",HAS_BOUNDED_VARIATION_TRANSLATION; +"HAS_BOUNDED_VARIATION_TRANSLATION2_EQ",HAS_BOUNDED_VARIATION_TRANSLATION2_EQ; +"HAS_BOUNDED_VARIATION_TRANSLATION_EQ",HAS_BOUNDED_VARIATION_TRANSLATION_EQ; +"HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL",HAS_BOUNDED_VARIATION_TRANSLATION_EQ_INTERVAL; +"HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT; +"HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT",HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT; +"HAS_DERIVATIVE_ADD",HAS_DERIVATIVE_ADD; +"HAS_DERIVATIVE_AT",HAS_DERIVATIVE_AT; +"HAS_DERIVATIVE_AT_ALT",HAS_DERIVATIVE_AT_ALT; +"HAS_DERIVATIVE_AT_WITHIN",HAS_DERIVATIVE_AT_WITHIN; +"HAS_DERIVATIVE_BILINEAR_AT",HAS_DERIVATIVE_BILINEAR_AT; +"HAS_DERIVATIVE_BILINEAR_WITHIN",HAS_DERIVATIVE_BILINEAR_WITHIN; +"HAS_DERIVATIVE_CMUL",HAS_DERIVATIVE_CMUL; +"HAS_DERIVATIVE_CMUL_EQ",HAS_DERIVATIVE_CMUL_EQ; +"HAS_DERIVATIVE_COMPONENTWISE_AT",HAS_DERIVATIVE_COMPONENTWISE_AT; +"HAS_DERIVATIVE_COMPONENTWISE_WITHIN",HAS_DERIVATIVE_COMPONENTWISE_WITHIN; +"HAS_DERIVATIVE_CONST",HAS_DERIVATIVE_CONST; +"HAS_DERIVATIVE_ID",HAS_DERIVATIVE_ID; +"HAS_DERIVATIVE_IMP_DIFFERENTIABLE",HAS_DERIVATIVE_IMP_DIFFERENTIABLE; +"HAS_DERIVATIVE_INVERSE",HAS_DERIVATIVE_INVERSE; +"HAS_DERIVATIVE_INVERSE_BASIC",HAS_DERIVATIVE_INVERSE_BASIC; +"HAS_DERIVATIVE_INVERSE_BASIC_X",HAS_DERIVATIVE_INVERSE_BASIC_X; +"HAS_DERIVATIVE_INVERSE_DIEUDONNE",HAS_DERIVATIVE_INVERSE_DIEUDONNE; +"HAS_DERIVATIVE_INVERSE_ON",HAS_DERIVATIVE_INVERSE_ON; +"HAS_DERIVATIVE_INVERSE_STRONG",HAS_DERIVATIVE_INVERSE_STRONG; +"HAS_DERIVATIVE_INVERSE_STRONG_X",HAS_DERIVATIVE_INVERSE_STRONG_X; +"HAS_DERIVATIVE_LIFT_COMPONENT",HAS_DERIVATIVE_LIFT_COMPONENT; +"HAS_DERIVATIVE_LIFT_DOT",HAS_DERIVATIVE_LIFT_DOT; +"HAS_DERIVATIVE_LINEAR",HAS_DERIVATIVE_LINEAR; +"HAS_DERIVATIVE_LOCALLY_INJECTIVE",HAS_DERIVATIVE_LOCALLY_INJECTIVE; +"HAS_DERIVATIVE_MUL_AT",HAS_DERIVATIVE_MUL_AT; +"HAS_DERIVATIVE_MUL_WITHIN",HAS_DERIVATIVE_MUL_WITHIN; +"HAS_DERIVATIVE_NEG",HAS_DERIVATIVE_NEG; +"HAS_DERIVATIVE_NEG_EQ",HAS_DERIVATIVE_NEG_EQ; +"HAS_DERIVATIVE_SEQUENCE",HAS_DERIVATIVE_SEQUENCE; +"HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ",HAS_DERIVATIVE_SEQUENCE_LIPSCHITZ; +"HAS_DERIVATIVE_SERIES",HAS_DERIVATIVE_SERIES; +"HAS_DERIVATIVE_SQNORM_AT",HAS_DERIVATIVE_SQNORM_AT; +"HAS_DERIVATIVE_SUB",HAS_DERIVATIVE_SUB; +"HAS_DERIVATIVE_TRANSFORM_AT",HAS_DERIVATIVE_TRANSFORM_AT; +"HAS_DERIVATIVE_TRANSFORM_WITHIN",HAS_DERIVATIVE_TRANSFORM_WITHIN; +"HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"HAS_DERIVATIVE_VMUL_COMPONENT",HAS_DERIVATIVE_VMUL_COMPONENT; +"HAS_DERIVATIVE_VMUL_DROP",HAS_DERIVATIVE_VMUL_DROP; +"HAS_DERIVATIVE_VSUM",HAS_DERIVATIVE_VSUM; +"HAS_DERIVATIVE_VSUM_NUMSEG",HAS_DERIVATIVE_VSUM_NUMSEG; +"HAS_DERIVATIVE_WITHIN",HAS_DERIVATIVE_WITHIN; +"HAS_DERIVATIVE_WITHIN_ALT",HAS_DERIVATIVE_WITHIN_ALT; +"HAS_DERIVATIVE_WITHIN_OPEN",HAS_DERIVATIVE_WITHIN_OPEN; +"HAS_DERIVATIVE_WITHIN_SUBSET",HAS_DERIVATIVE_WITHIN_SUBSET; +"HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT",HAS_DERIVATIVE_ZERO_CONNECTED_CONSTANT; +"HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE",HAS_DERIVATIVE_ZERO_CONNECTED_UNIQUE; +"HAS_DERIVATIVE_ZERO_CONSTANT",HAS_DERIVATIVE_ZERO_CONSTANT; +"HAS_DERIVATIVE_ZERO_UNIQUE",HAS_DERIVATIVE_ZERO_UNIQUE; +"HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONNECTED; +"HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX; +"HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL",HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL; +"HAS_FRECHET_DERIVATIVE_UNIQUE_AT",HAS_FRECHET_DERIVATIVE_UNIQUE_AT; +"HAS_INTEGRAL",HAS_INTEGRAL; +"HAS_INTEGRAL_0",HAS_INTEGRAL_0; +"HAS_INTEGRAL_0_EQ",HAS_INTEGRAL_0_EQ; +"HAS_INTEGRAL_ADD",HAS_INTEGRAL_ADD; +"HAS_INTEGRAL_AFFINITY",HAS_INTEGRAL_AFFINITY; +"HAS_INTEGRAL_ALT",HAS_INTEGRAL_ALT; +"HAS_INTEGRAL_BOUND",HAS_INTEGRAL_BOUND; +"HAS_INTEGRAL_CLOSURE",HAS_INTEGRAL_CLOSURE; +"HAS_INTEGRAL_CMUL",HAS_INTEGRAL_CMUL; +"HAS_INTEGRAL_COMBINE",HAS_INTEGRAL_COMBINE; +"HAS_INTEGRAL_COMBINE_DIVISION",HAS_INTEGRAL_COMBINE_DIVISION; +"HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_DIVISION_TOPDOWN; +"HAS_INTEGRAL_COMBINE_TAGGED_DIVISION",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION; +"HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",HAS_INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; +"HAS_INTEGRAL_COMPONENTWISE",HAS_INTEGRAL_COMPONENTWISE; +"HAS_INTEGRAL_COMPONENT_LBOUND",HAS_INTEGRAL_COMPONENT_LBOUND; +"HAS_INTEGRAL_COMPONENT_LE",HAS_INTEGRAL_COMPONENT_LE; +"HAS_INTEGRAL_COMPONENT_LE_AE",HAS_INTEGRAL_COMPONENT_LE_AE; +"HAS_INTEGRAL_COMPONENT_NEG",HAS_INTEGRAL_COMPONENT_NEG; +"HAS_INTEGRAL_COMPONENT_POS",HAS_INTEGRAL_COMPONENT_POS; +"HAS_INTEGRAL_COMPONENT_UBOUND",HAS_INTEGRAL_COMPONENT_UBOUND; +"HAS_INTEGRAL_CONST",HAS_INTEGRAL_CONST; +"HAS_INTEGRAL_DIFF",HAS_INTEGRAL_DIFF; +"HAS_INTEGRAL_DROP_LE",HAS_INTEGRAL_DROP_LE; +"HAS_INTEGRAL_DROP_LE_AE",HAS_INTEGRAL_DROP_LE_AE; +"HAS_INTEGRAL_DROP_NEG",HAS_INTEGRAL_DROP_NEG; +"HAS_INTEGRAL_DROP_POS",HAS_INTEGRAL_DROP_POS; +"HAS_INTEGRAL_DROP_POS_AE",HAS_INTEGRAL_DROP_POS_AE; +"HAS_INTEGRAL_EMPTY",HAS_INTEGRAL_EMPTY; +"HAS_INTEGRAL_EMPTY_EQ",HAS_INTEGRAL_EMPTY_EQ; +"HAS_INTEGRAL_EQ",HAS_INTEGRAL_EQ; +"HAS_INTEGRAL_EQ_EQ",HAS_INTEGRAL_EQ_EQ; +"HAS_INTEGRAL_FACTOR_CONTENT",HAS_INTEGRAL_FACTOR_CONTENT; +"HAS_INTEGRAL_INTEGRABLE",HAS_INTEGRAL_INTEGRABLE; +"HAS_INTEGRAL_INTEGRABLE_INTEGRAL",HAS_INTEGRAL_INTEGRABLE_INTEGRAL; +"HAS_INTEGRAL_INTEGRAL",HAS_INTEGRAL_INTEGRAL; +"HAS_INTEGRAL_INTERIOR",HAS_INTEGRAL_INTERIOR; +"HAS_INTEGRAL_IS_0",HAS_INTEGRAL_IS_0; +"HAS_INTEGRAL_LIM_AT_POSINFINITY",HAS_INTEGRAL_LIM_AT_POSINFINITY; +"HAS_INTEGRAL_LIM_SEQUENTIALLY",HAS_INTEGRAL_LIM_SEQUENTIALLY; +"HAS_INTEGRAL_LINEAR",HAS_INTEGRAL_LINEAR; +"HAS_INTEGRAL_MEASURE_UNDER_CURVE",HAS_INTEGRAL_MEASURE_UNDER_CURVE; +"HAS_INTEGRAL_NEG",HAS_INTEGRAL_NEG; +"HAS_INTEGRAL_NEGLIGIBLE",HAS_INTEGRAL_NEGLIGIBLE; +"HAS_INTEGRAL_NEGLIGIBLE_EQ",HAS_INTEGRAL_NEGLIGIBLE_EQ; +"HAS_INTEGRAL_NEGLIGIBLE_EQ_AE",HAS_INTEGRAL_NEGLIGIBLE_EQ_AE; +"HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",HAS_INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; +"HAS_INTEGRAL_NULL",HAS_INTEGRAL_NULL; +"HAS_INTEGRAL_NULL_EQ",HAS_INTEGRAL_NULL_EQ; +"HAS_INTEGRAL_ON_SUPERSET",HAS_INTEGRAL_ON_SUPERSET; +"HAS_INTEGRAL_OPEN_INTERVAL",HAS_INTEGRAL_OPEN_INTERVAL; +"HAS_INTEGRAL_PASTECART_SYM",HAS_INTEGRAL_PASTECART_SYM; +"HAS_INTEGRAL_PASTECART_SYM_ALT",HAS_INTEGRAL_PASTECART_SYM_ALT; +"HAS_INTEGRAL_PASTECART_SYM_UNIV",HAS_INTEGRAL_PASTECART_SYM_UNIV; +"HAS_INTEGRAL_REFL",HAS_INTEGRAL_REFL; +"HAS_INTEGRAL_REFLECT",HAS_INTEGRAL_REFLECT; +"HAS_INTEGRAL_REFLECT_GEN",HAS_INTEGRAL_REFLECT_GEN; +"HAS_INTEGRAL_REFLECT_LEMMA",HAS_INTEGRAL_REFLECT_LEMMA; +"HAS_INTEGRAL_RESTRICT",HAS_INTEGRAL_RESTRICT; +"HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVAL; +"HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ",HAS_INTEGRAL_RESTRICT_CLOSED_SUBINTERVALS_EQ; +"HAS_INTEGRAL_RESTRICT_INTER",HAS_INTEGRAL_RESTRICT_INTER; +"HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL",HAS_INTEGRAL_RESTRICT_OPEN_SUBINTERVAL; +"HAS_INTEGRAL_RESTRICT_UNIV",HAS_INTEGRAL_RESTRICT_UNIV; +"HAS_INTEGRAL_SEPARATE_SIDES",HAS_INTEGRAL_SEPARATE_SIDES; +"HAS_INTEGRAL_SPIKE",HAS_INTEGRAL_SPIKE; +"HAS_INTEGRAL_SPIKE_EQ",HAS_INTEGRAL_SPIKE_EQ; +"HAS_INTEGRAL_SPIKE_FINITE",HAS_INTEGRAL_SPIKE_FINITE; +"HAS_INTEGRAL_SPIKE_FINITE_EQ",HAS_INTEGRAL_SPIKE_FINITE_EQ; +"HAS_INTEGRAL_SPIKE_INTERIOR",HAS_INTEGRAL_SPIKE_INTERIOR; +"HAS_INTEGRAL_SPIKE_INTERIOR_EQ",HAS_INTEGRAL_SPIKE_INTERIOR_EQ; +"HAS_INTEGRAL_SPIKE_SET",HAS_INTEGRAL_SPIKE_SET; +"HAS_INTEGRAL_SPIKE_SET_EQ",HAS_INTEGRAL_SPIKE_SET_EQ; +"HAS_INTEGRAL_SPLIT",HAS_INTEGRAL_SPLIT; +"HAS_INTEGRAL_STRADDLE_NULL",HAS_INTEGRAL_STRADDLE_NULL; +"HAS_INTEGRAL_STRETCH",HAS_INTEGRAL_STRETCH; +"HAS_INTEGRAL_SUB",HAS_INTEGRAL_SUB; +"HAS_INTEGRAL_SUBSET_COMPONENT_LE",HAS_INTEGRAL_SUBSET_COMPONENT_LE; +"HAS_INTEGRAL_SUBSET_DROP_LE",HAS_INTEGRAL_SUBSET_DROP_LE; +"HAS_INTEGRAL_SUBSTITUTION_STRONG",HAS_INTEGRAL_SUBSTITUTION_STRONG; +"HAS_INTEGRAL_TWIDDLE",HAS_INTEGRAL_TWIDDLE; +"HAS_INTEGRAL_TWIZZLE",HAS_INTEGRAL_TWIZZLE; +"HAS_INTEGRAL_TWIZZLE_EQ",HAS_INTEGRAL_TWIZZLE_EQ; +"HAS_INTEGRAL_TWIZZLE_INTERVAL",HAS_INTEGRAL_TWIZZLE_INTERVAL; +"HAS_INTEGRAL_UNION",HAS_INTEGRAL_UNION; +"HAS_INTEGRAL_UNIONS",HAS_INTEGRAL_UNIONS; +"HAS_INTEGRAL_UNIQUE",HAS_INTEGRAL_UNIQUE; +"HAS_INTEGRAL_VSUM",HAS_INTEGRAL_VSUM; +"HAS_MEASURE",HAS_MEASURE; +"HAS_MEASURE_0",HAS_MEASURE_0; +"HAS_MEASURE_AFFINITY",HAS_MEASURE_AFFINITY; +"HAS_MEASURE_ALMOST",HAS_MEASURE_ALMOST; +"HAS_MEASURE_ALMOST_EQ",HAS_MEASURE_ALMOST_EQ; +"HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS; +"HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED",HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED; +"HAS_MEASURE_DIFF_NEGLIGIBLE",HAS_MEASURE_DIFF_NEGLIGIBLE; +"HAS_MEASURE_DIFF_NEGLIGIBLE_EQ",HAS_MEASURE_DIFF_NEGLIGIBLE_EQ; +"HAS_MEASURE_DIFF_SUBSET",HAS_MEASURE_DIFF_SUBSET; +"HAS_MEASURE_DISJOINT_UNION",HAS_MEASURE_DISJOINT_UNION; +"HAS_MEASURE_DISJOINT_UNIONS",HAS_MEASURE_DISJOINT_UNIONS; +"HAS_MEASURE_DISJOINT_UNIONS_IMAGE",HAS_MEASURE_DISJOINT_UNIONS_IMAGE; +"HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",HAS_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; +"HAS_MEASURE_ELEMENTARY",HAS_MEASURE_ELEMENTARY; +"HAS_MEASURE_EMPTY",HAS_MEASURE_EMPTY; +"HAS_MEASURE_IMAGE_STD_SIMPLEX",HAS_MEASURE_IMAGE_STD_SIMPLEX; +"HAS_MEASURE_IMP_MEASURABLE",HAS_MEASURE_IMP_MEASURABLE; +"HAS_MEASURE_INNER_OUTER",HAS_MEASURE_INNER_OUTER; +"HAS_MEASURE_INNER_OUTER_LE",HAS_MEASURE_INNER_OUTER_LE; +"HAS_MEASURE_INTERVAL",HAS_MEASURE_INTERVAL; +"HAS_MEASURE_ISOMETRY",HAS_MEASURE_ISOMETRY; +"HAS_MEASURE_LIMIT",HAS_MEASURE_LIMIT; +"HAS_MEASURE_LINEAR_IMAGE",HAS_MEASURE_LINEAR_IMAGE; +"HAS_MEASURE_LINEAR_IMAGE_ALT",HAS_MEASURE_LINEAR_IMAGE_ALT; +"HAS_MEASURE_LINEAR_IMAGE_SAME",HAS_MEASURE_LINEAR_IMAGE_SAME; +"HAS_MEASURE_LINEAR_SUFFICIENT",HAS_MEASURE_LINEAR_SUFFICIENT; +"HAS_MEASURE_MEASURABLE_MEASURE",HAS_MEASURE_MEASURABLE_MEASURE; +"HAS_MEASURE_MEASURE",HAS_MEASURE_MEASURE; +"HAS_MEASURE_NEGLIGIBLE_SYMDIFF",HAS_MEASURE_NEGLIGIBLE_SYMDIFF; +"HAS_MEASURE_NEGLIGIBLE_UNION",HAS_MEASURE_NEGLIGIBLE_UNION; +"HAS_MEASURE_NEGLIGIBLE_UNIONS",HAS_MEASURE_NEGLIGIBLE_UNIONS; +"HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE; +"HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",HAS_MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; +"HAS_MEASURE_NESTED_INTERS",HAS_MEASURE_NESTED_INTERS; +"HAS_MEASURE_NESTED_UNIONS",HAS_MEASURE_NESTED_UNIONS; +"HAS_MEASURE_ORTHOGONAL_IMAGE",HAS_MEASURE_ORTHOGONAL_IMAGE; +"HAS_MEASURE_ORTHOGONAL_IMAGE_EQ",HAS_MEASURE_ORTHOGONAL_IMAGE_EQ; +"HAS_MEASURE_PCROSS",HAS_MEASURE_PCROSS; +"HAS_MEASURE_POS_LE",HAS_MEASURE_POS_LE; +"HAS_MEASURE_SCALING",HAS_MEASURE_SCALING; +"HAS_MEASURE_SCALING_EQ",HAS_MEASURE_SCALING_EQ; +"HAS_MEASURE_SHEAR_INTERVAL",HAS_MEASURE_SHEAR_INTERVAL; +"HAS_MEASURE_SIMPLEX",HAS_MEASURE_SIMPLEX; +"HAS_MEASURE_SIMPLEX_0",HAS_MEASURE_SIMPLEX_0; +"HAS_MEASURE_STD_SIMPLEX",HAS_MEASURE_STD_SIMPLEX; +"HAS_MEASURE_STRETCH",HAS_MEASURE_STRETCH; +"HAS_MEASURE_SUBSET",HAS_MEASURE_SUBSET; +"HAS_MEASURE_TETRAHEDRON",HAS_MEASURE_TETRAHEDRON; +"HAS_MEASURE_TRANSLATION",HAS_MEASURE_TRANSLATION; +"HAS_MEASURE_TRANSLATION_EQ",HAS_MEASURE_TRANSLATION_EQ; +"HAS_MEASURE_TRIANGLE",HAS_MEASURE_TRIANGLE; +"HAS_MEASURE_UNION_NEGLIGIBLE",HAS_MEASURE_UNION_NEGLIGIBLE; +"HAS_MEASURE_UNION_NEGLIGIBLE_EQ",HAS_MEASURE_UNION_NEGLIGIBLE_EQ; +"HAS_MEASURE_UNIQUE",HAS_MEASURE_UNIQUE; +"HAS_SIZE",HAS_SIZE; +"HAS_SIZE_0",HAS_SIZE_0; +"HAS_SIZE_1",HAS_SIZE_1; +"HAS_SIZE_1_EXISTS",HAS_SIZE_1_EXISTS; +"HAS_SIZE_2",HAS_SIZE_2; +"HAS_SIZE_2_EXISTS",HAS_SIZE_2_EXISTS; +"HAS_SIZE_3",HAS_SIZE_3; +"HAS_SIZE_4",HAS_SIZE_4; +"HAS_SIZE_BOOL",HAS_SIZE_BOOL; +"HAS_SIZE_CARD",HAS_SIZE_CARD; +"HAS_SIZE_CART_UNIV",HAS_SIZE_CART_UNIV; +"HAS_SIZE_CLAUSES",HAS_SIZE_CLAUSES; +"HAS_SIZE_CROSS",HAS_SIZE_CROSS; +"HAS_SIZE_DIFF",HAS_SIZE_DIFF; +"HAS_SIZE_FACES_OF_SIMPLEX",HAS_SIZE_FACES_OF_SIMPLEX; +"HAS_SIZE_FINITE_IMAGE",HAS_SIZE_FINITE_IMAGE; +"HAS_SIZE_FUNSPACE",HAS_SIZE_FUNSPACE; +"HAS_SIZE_FUNSPACE_UNIV",HAS_SIZE_FUNSPACE_UNIV; +"HAS_SIZE_IMAGE_INJ",HAS_SIZE_IMAGE_INJ; +"HAS_SIZE_IMAGE_INJ_EQ",HAS_SIZE_IMAGE_INJ_EQ; +"HAS_SIZE_INDEX",HAS_SIZE_INDEX; +"HAS_SIZE_INTSEG_INT",HAS_SIZE_INTSEG_INT; +"HAS_SIZE_INTSEG_NUM",HAS_SIZE_INTSEG_NUM; +"HAS_SIZE_MULTIVECTOR",HAS_SIZE_MULTIVECTOR; +"HAS_SIZE_NUMSEG",HAS_SIZE_NUMSEG; +"HAS_SIZE_NUMSEG_1",HAS_SIZE_NUMSEG_1; +"HAS_SIZE_NUMSEG_LE",HAS_SIZE_NUMSEG_LE; +"HAS_SIZE_NUMSEG_LT",HAS_SIZE_NUMSEG_LT; +"HAS_SIZE_PCROSS",HAS_SIZE_PCROSS; +"HAS_SIZE_PERMUTATIONS",HAS_SIZE_PERMUTATIONS; +"HAS_SIZE_POWERSET",HAS_SIZE_POWERSET; +"HAS_SIZE_PRODUCT",HAS_SIZE_PRODUCT; +"HAS_SIZE_PRODUCT_DEPENDENT",HAS_SIZE_PRODUCT_DEPENDENT; +"HAS_SIZE_SET_OF_LIST",HAS_SIZE_SET_OF_LIST; +"HAS_SIZE_STDBASIS",HAS_SIZE_STDBASIS; +"HAS_SIZE_SUC",HAS_SIZE_SUC; +"HAS_SIZE_UNION",HAS_SIZE_UNION; +"HAS_SIZE_UNIONS",HAS_SIZE_UNIONS; +"HAS_VECTOR_DERIVATIVE_ADD",HAS_VECTOR_DERIVATIVE_ADD; +"HAS_VECTOR_DERIVATIVE_AT_WITHIN",HAS_VECTOR_DERIVATIVE_AT_WITHIN; +"HAS_VECTOR_DERIVATIVE_BILINEAR_AT",HAS_VECTOR_DERIVATIVE_BILINEAR_AT; +"HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN",HAS_VECTOR_DERIVATIVE_BILINEAR_WITHIN; +"HAS_VECTOR_DERIVATIVE_CMUL",HAS_VECTOR_DERIVATIVE_CMUL; +"HAS_VECTOR_DERIVATIVE_CMUL_EQ",HAS_VECTOR_DERIVATIVE_CMUL_EQ; +"HAS_VECTOR_DERIVATIVE_CONST",HAS_VECTOR_DERIVATIVE_CONST; +"HAS_VECTOR_DERIVATIVE_ID",HAS_VECTOR_DERIVATIVE_ID; +"HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL",HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL; +"HAS_VECTOR_DERIVATIVE_NEG",HAS_VECTOR_DERIVATIVE_NEG; +"HAS_VECTOR_DERIVATIVE_NEG_EQ",HAS_VECTOR_DERIVATIVE_NEG_EQ; +"HAS_VECTOR_DERIVATIVE_SUB",HAS_VECTOR_DERIVATIVE_SUB; +"HAS_VECTOR_DERIVATIVE_TRANSFORM_AT",HAS_VECTOR_DERIVATIVE_TRANSFORM_AT; +"HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN; +"HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN",HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN_OPEN; +"HAS_VECTOR_DERIVATIVE_UNIQUE_AT",HAS_VECTOR_DERIVATIVE_UNIQUE_AT; +"HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET",HAS_VECTOR_DERIVATIVE_WITHIN_SUBSET; +"HAUSDIST_ALT",HAUSDIST_ALT; +"HAUSDIST_BALLS",HAUSDIST_BALLS; +"HAUSDIST_CLOSURE",HAUSDIST_CLOSURE; +"HAUSDIST_COMPACT_EXISTS",HAUSDIST_COMPACT_EXISTS; +"HAUSDIST_COMPACT_NONTRIVIAL",HAUSDIST_COMPACT_NONTRIVIAL; +"HAUSDIST_COMPACT_SUMS",HAUSDIST_COMPACT_SUMS; +"HAUSDIST_CONVEX_HULLS",HAUSDIST_CONVEX_HULLS; +"HAUSDIST_EMPTY",HAUSDIST_EMPTY; +"HAUSDIST_EQ",HAUSDIST_EQ; +"HAUSDIST_EQ_0",HAUSDIST_EQ_0; +"HAUSDIST_LINEAR_IMAGE",HAUSDIST_LINEAR_IMAGE; +"HAUSDIST_NONTRIVIAL",HAUSDIST_NONTRIVIAL; +"HAUSDIST_NONTRIVIAL_ALT",HAUSDIST_NONTRIVIAL_ALT; +"HAUSDIST_POS_LE",HAUSDIST_POS_LE; +"HAUSDIST_REFL",HAUSDIST_REFL; +"HAUSDIST_SINGS",HAUSDIST_SINGS; +"HAUSDIST_SUMS",HAUSDIST_SUMS; +"HAUSDIST_SYM",HAUSDIST_SYM; +"HAUSDIST_TRANS",HAUSDIST_TRANS; +"HAUSDIST_TRANSLATION",HAUSDIST_TRANSLATION; +"HD",HD; +"HD_APPEND",HD_APPEND; +"HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS",HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS; +"HEINE_BOREL_LEMMA",HEINE_BOREL_LEMMA; +"HELLY",HELLY; +"HELLY_ALT",HELLY_ALT; +"HELLY_CLOSED",HELLY_CLOSED; +"HELLY_CLOSED_ALT",HELLY_CLOSED_ALT; +"HELLY_COMPACT",HELLY_COMPACT; +"HELLY_COMPACT_ALT",HELLY_COMPACT_ALT; +"HELLY_INDUCT",HELLY_INDUCT; +"HENSTOCK_LEMMA",HENSTOCK_LEMMA; +"HENSTOCK_LEMMA_PART1",HENSTOCK_LEMMA_PART1; +"HENSTOCK_LEMMA_PART2",HENSTOCK_LEMMA_PART2; +"HOMEOMORPHIC_AFFINE_SETS",HOMEOMORPHIC_AFFINE_SETS; +"HOMEOMORPHIC_AFFINITY",HOMEOMORPHIC_AFFINITY; +"HOMEOMORPHIC_ANRNESS",HOMEOMORPHIC_ANRNESS; +"HOMEOMORPHIC_ARC_IMAGES",HOMEOMORPHIC_ARC_IMAGES; +"HOMEOMORPHIC_ARC_IMAGE_INTERVAL",HOMEOMORPHIC_ARC_IMAGE_INTERVAL; +"HOMEOMORPHIC_ARC_IMAGE_SEGMENT",HOMEOMORPHIC_ARC_IMAGE_SEGMENT; +"HOMEOMORPHIC_ARNESS",HOMEOMORPHIC_ARNESS; +"HOMEOMORPHIC_BALLS",HOMEOMORPHIC_BALLS; +"HOMEOMORPHIC_BALL_UNIV",HOMEOMORPHIC_BALL_UNIV; +"HOMEOMORPHIC_CBALLS",HOMEOMORPHIC_CBALLS; +"HOMEOMORPHIC_CLOSED_INTERVALS",HOMEOMORPHIC_CLOSED_INTERVALS; +"HOMEOMORPHIC_CLOSED_IN_CONVEX",HOMEOMORPHIC_CLOSED_IN_CONVEX; +"HOMEOMORPHIC_COMPACT",HOMEOMORPHIC_COMPACT; +"HOMEOMORPHIC_COMPACTNESS",HOMEOMORPHIC_COMPACTNESS; +"HOMEOMORPHIC_COMPACT_ARNESS",HOMEOMORPHIC_COMPACT_ARNESS; +"HOMEOMORPHIC_CONNECTEDNESS",HOMEOMORPHIC_CONNECTEDNESS; +"HOMEOMORPHIC_CONTRACTIBLE",HOMEOMORPHIC_CONTRACTIBLE; +"HOMEOMORPHIC_CONTRACTIBLE_EQ",HOMEOMORPHIC_CONTRACTIBLE_EQ; +"HOMEOMORPHIC_CONVEX_COMPACT",HOMEOMORPHIC_CONVEX_COMPACT; +"HOMEOMORPHIC_CONVEX_COMPACT_CBALL",HOMEOMORPHIC_CONVEX_COMPACT_CBALL; +"HOMEOMORPHIC_CONVEX_COMPACT_SETS",HOMEOMORPHIC_CONVEX_COMPACT_SETS; +"HOMEOMORPHIC_EMPTY",HOMEOMORPHIC_EMPTY; +"HOMEOMORPHIC_ENRNESS",HOMEOMORPHIC_ENRNESS; +"HOMEOMORPHIC_FINITE",HOMEOMORPHIC_FINITE; +"HOMEOMORPHIC_FINITE_STRONG",HOMEOMORPHIC_FINITE_STRONG; +"HOMEOMORPHIC_FIXPOINT_PROPERTY",HOMEOMORPHIC_FIXPOINT_PROPERTY; +"HOMEOMORPHIC_HYPERPLANES",HOMEOMORPHIC_HYPERPLANES; +"HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE",HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE; +"HOMEOMORPHIC_HYPERPLANE_UNIV",HOMEOMORPHIC_HYPERPLANE_UNIV; +"HOMEOMORPHIC_IMP_CARD_EQ",HOMEOMORPHIC_IMP_CARD_EQ; +"HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT",HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; +"HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; +"HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; +"HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF",HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF; +"HOMEOMORPHIC_LOCALLY",HOMEOMORPHIC_LOCALLY; +"HOMEOMORPHIC_LOCAL_COMPACTNESS",HOMEOMORPHIC_LOCAL_COMPACTNESS; +"HOMEOMORPHIC_LOCAL_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_CONNECTEDNESS; +"HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS",HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS; +"HOMEOMORPHIC_MINIMAL",HOMEOMORPHIC_MINIMAL; +"HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL",HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL; +"HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS",HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS; +"HOMEOMORPHIC_OPEN_INTERVALS",HOMEOMORPHIC_OPEN_INTERVALS; +"HOMEOMORPHIC_OPEN_INTERVALS_1",HOMEOMORPHIC_OPEN_INTERVALS_1; +"HOMEOMORPHIC_OPEN_INTERVAL_UNIV",HOMEOMORPHIC_OPEN_INTERVAL_UNIV; +"HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1",HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; +"HOMEOMORPHIC_PATH_CONNECTEDNESS",HOMEOMORPHIC_PATH_CONNECTEDNESS; +"HOMEOMORPHIC_PCROSS",HOMEOMORPHIC_PCROSS; +"HOMEOMORPHIC_PCROSS_ASSOC",HOMEOMORPHIC_PCROSS_ASSOC; +"HOMEOMORPHIC_PCROSS_SING",HOMEOMORPHIC_PCROSS_SING; +"HOMEOMORPHIC_PCROSS_SYM",HOMEOMORPHIC_PCROSS_SYM; +"HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE; +"HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE; +"HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN",HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN; +"HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE",HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE; +"HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV",HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV; +"HOMEOMORPHIC_REFL",HOMEOMORPHIC_REFL; +"HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS",HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS; +"HOMEOMORPHIC_SCALING",HOMEOMORPHIC_SCALING; +"HOMEOMORPHIC_SCALING_LEFT",HOMEOMORPHIC_SCALING_LEFT; +"HOMEOMORPHIC_SCALING_RIGHT",HOMEOMORPHIC_SCALING_RIGHT; +"HOMEOMORPHIC_SIMPLY_CONNECTED",HOMEOMORPHIC_SIMPLY_CONNECTED; +"HOMEOMORPHIC_SIMPLY_CONNECTED_EQ",HOMEOMORPHIC_SIMPLY_CONNECTED_EQ; +"HOMEOMORPHIC_SING",HOMEOMORPHIC_SING; +"HOMEOMORPHIC_SPHERES",HOMEOMORPHIC_SPHERES; +"HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE",HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE; +"HOMEOMORPHIC_SUBSPACES",HOMEOMORPHIC_SUBSPACES; +"HOMEOMORPHIC_SYM",HOMEOMORPHIC_SYM; +"HOMEOMORPHIC_TRANS",HOMEOMORPHIC_TRANS; +"HOMEOMORPHIC_TRANSLATION",HOMEOMORPHIC_TRANSLATION; +"HOMEOMORPHIC_TRANSLATION_LEFT_EQ",HOMEOMORPHIC_TRANSLATION_LEFT_EQ; +"HOMEOMORPHIC_TRANSLATION_RIGHT_EQ",HOMEOMORPHIC_TRANSLATION_RIGHT_EQ; +"HOMEOMORPHIC_TRANSLATION_SELF",HOMEOMORPHIC_TRANSLATION_SELF; +"HOMEOMORPHISM",HOMEOMORPHISM; +"HOMEOMORPHISM_ARC",HOMEOMORPHISM_ARC; +"HOMEOMORPHISM_COMPACT",HOMEOMORPHISM_COMPACT; +"HOMEOMORPHISM_COMPOSE",HOMEOMORPHISM_COMPOSE; +"HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE; +"HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE",HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE; +"HOMEOMORPHISM_GROUPING_POINTS_EXISTS",HOMEOMORPHISM_GROUPING_POINTS_EXISTS; +"HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN",HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN; +"HOMEOMORPHISM_I",HOMEOMORPHISM_I; +"HOMEOMORPHISM_ID",HOMEOMORPHISM_ID; +"HOMEOMORPHISM_IMP_CLOSED_MAP",HOMEOMORPHISM_IMP_CLOSED_MAP; +"HOMEOMORPHISM_IMP_COVERING_SPACE",HOMEOMORPHISM_IMP_COVERING_SPACE; +"HOMEOMORPHISM_IMP_OPEN_MAP",HOMEOMORPHISM_IMP_OPEN_MAP; +"HOMEOMORPHISM_IMP_QUOTIENT_MAP",HOMEOMORPHISM_IMP_QUOTIENT_MAP; +"HOMEOMORPHISM_INJECTIVE_CLOSED_MAP",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP; +"HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ",HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ; +"HOMEOMORPHISM_INJECTIVE_OPEN_MAP",HOMEOMORPHISM_INJECTIVE_OPEN_MAP; +"HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ",HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; +"HOMEOMORPHISM_LOCALLY",HOMEOMORPHISM_LOCALLY; +"HOMEOMORPHISM_MOVING_POINTS_EXISTS",HOMEOMORPHISM_MOVING_POINTS_EXISTS; +"HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN",HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN; +"HOMEOMORPHISM_MOVING_POINT_EXISTS",HOMEOMORPHISM_MOVING_POINT_EXISTS; +"HOMEOMORPHISM_OF_SUBSETS",HOMEOMORPHISM_OF_SUBSETS; +"HOMEOMORPHISM_SYM",HOMEOMORPHISM_SYM; +"HOMOGENEOUS_LINEAR_EQUATIONS_DET",HOMOGENEOUS_LINEAR_EQUATIONS_DET; +"HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN; +"HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN",HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN; +"HOMOTOPIC_COMPOSE",HOMOTOPIC_COMPOSE; +"HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT; +"HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT; +"HOMOTOPIC_CONSTANT_MAPS",HOMOTOPIC_CONSTANT_MAPS; +"HOMOTOPIC_FROM_CONTRACTIBLE",HOMOTOPIC_FROM_CONTRACTIBLE; +"HOMOTOPIC_INTO_CONTRACTIBLE",HOMOTOPIC_INTO_CONTRACTIBLE; +"HOMOTOPIC_INTO_RETRACT",HOMOTOPIC_INTO_RETRACT; +"HOMOTOPIC_JOIN_LEMMA",HOMOTOPIC_JOIN_LEMMA; +"HOMOTOPIC_JOIN_SUBPATHS",HOMOTOPIC_JOIN_SUBPATHS; +"HOMOTOPIC_LOOPS",HOMOTOPIC_LOOPS; +"HOMOTOPIC_LOOPS_ADD_SYM",HOMOTOPIC_LOOPS_ADD_SYM; +"HOMOTOPIC_LOOPS_CONJUGATE",HOMOTOPIC_LOOPS_CONJUGATE; +"HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE",HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE; +"HOMOTOPIC_LOOPS_EQ",HOMOTOPIC_LOOPS_EQ; +"HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL",HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL; +"HOMOTOPIC_LOOPS_IMP_LOOP",HOMOTOPIC_LOOPS_IMP_LOOP; +"HOMOTOPIC_LOOPS_IMP_PATH",HOMOTOPIC_LOOPS_IMP_PATH; +"HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE",HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE; +"HOMOTOPIC_LOOPS_IMP_SUBSET",HOMOTOPIC_LOOPS_IMP_SUBSET; +"HOMOTOPIC_LOOPS_LINEAR",HOMOTOPIC_LOOPS_LINEAR; +"HOMOTOPIC_LOOPS_NEARBY_EXPLICIT",HOMOTOPIC_LOOPS_NEARBY_EXPLICIT; +"HOMOTOPIC_LOOPS_REFL",HOMOTOPIC_LOOPS_REFL; +"HOMOTOPIC_LOOPS_SHIFTPATH",HOMOTOPIC_LOOPS_SHIFTPATH; +"HOMOTOPIC_LOOPS_SHIFTPATH_SELF",HOMOTOPIC_LOOPS_SHIFTPATH_SELF; +"HOMOTOPIC_LOOPS_SUBSET",HOMOTOPIC_LOOPS_SUBSET; +"HOMOTOPIC_LOOPS_SYM",HOMOTOPIC_LOOPS_SYM; +"HOMOTOPIC_LOOPS_TRANS",HOMOTOPIC_LOOPS_TRANS; +"HOMOTOPIC_NEARBY_LOOPS",HOMOTOPIC_NEARBY_LOOPS; +"HOMOTOPIC_NEARBY_PATHS",HOMOTOPIC_NEARBY_PATHS; +"HOMOTOPIC_NEIGHBOURHOOD_EXTENSION",HOMOTOPIC_NEIGHBOURHOOD_EXTENSION; +"HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS",HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS; +"HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS",HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS; +"HOMOTOPIC_ON_CLOPEN_UNIONS",HOMOTOPIC_ON_CLOPEN_UNIONS; +"HOMOTOPIC_ON_COMPONENTS",HOMOTOPIC_ON_COMPONENTS; +"HOMOTOPIC_ON_COMPONENTS_EQ",HOMOTOPIC_ON_COMPONENTS_EQ; +"HOMOTOPIC_ON_EMPTY",HOMOTOPIC_ON_EMPTY; +"HOMOTOPIC_PATHS",HOMOTOPIC_PATHS; +"HOMOTOPIC_PATHS_ASSOC",HOMOTOPIC_PATHS_ASSOC; +"HOMOTOPIC_PATHS_CONTINUOUS_IMAGE",HOMOTOPIC_PATHS_CONTINUOUS_IMAGE; +"HOMOTOPIC_PATHS_EQ",HOMOTOPIC_PATHS_EQ; +"HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS",HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS; +"HOMOTOPIC_PATHS_IMP_PATH",HOMOTOPIC_PATHS_IMP_PATH; +"HOMOTOPIC_PATHS_IMP_PATHFINISH",HOMOTOPIC_PATHS_IMP_PATHFINISH; +"HOMOTOPIC_PATHS_IMP_PATHSTART",HOMOTOPIC_PATHS_IMP_PATHSTART; +"HOMOTOPIC_PATHS_IMP_SUBSET",HOMOTOPIC_PATHS_IMP_SUBSET; +"HOMOTOPIC_PATHS_JOIN",HOMOTOPIC_PATHS_JOIN; +"HOMOTOPIC_PATHS_LID",HOMOTOPIC_PATHS_LID; +"HOMOTOPIC_PATHS_LINEAR",HOMOTOPIC_PATHS_LINEAR; +"HOMOTOPIC_PATHS_LINV",HOMOTOPIC_PATHS_LINV; +"HOMOTOPIC_PATHS_LOOP_PARTS",HOMOTOPIC_PATHS_LOOP_PARTS; +"HOMOTOPIC_PATHS_NEARBY_EXPLICIT",HOMOTOPIC_PATHS_NEARBY_EXPLICIT; +"HOMOTOPIC_PATHS_REFL",HOMOTOPIC_PATHS_REFL; +"HOMOTOPIC_PATHS_REPARAMETRIZE",HOMOTOPIC_PATHS_REPARAMETRIZE; +"HOMOTOPIC_PATHS_REVERSEPATH",HOMOTOPIC_PATHS_REVERSEPATH; +"HOMOTOPIC_PATHS_RID",HOMOTOPIC_PATHS_RID; +"HOMOTOPIC_PATHS_RINV",HOMOTOPIC_PATHS_RINV; +"HOMOTOPIC_PATHS_SUBSET",HOMOTOPIC_PATHS_SUBSET; +"HOMOTOPIC_PATHS_SYM",HOMOTOPIC_PATHS_SYM; +"HOMOTOPIC_PATHS_TRANS",HOMOTOPIC_PATHS_TRANS; +"HOMOTOPIC_POINTS_EQ_PATH_COMPONENT",HOMOTOPIC_POINTS_EQ_PATH_COMPONENT; +"HOMOTOPIC_THROUGH_CONTRACTIBLE",HOMOTOPIC_THROUGH_CONTRACTIBLE; +"HOMOTOPIC_TRIVIALITY",HOMOTOPIC_TRIVIALITY; +"HOMOTOPIC_WITH",HOMOTOPIC_WITH; +"HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT; +"HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT",HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT; +"HOMOTOPIC_WITH_EQ",HOMOTOPIC_WITH_EQ; +"HOMOTOPIC_WITH_EQUAL",HOMOTOPIC_WITH_EQUAL; +"HOMOTOPIC_WITH_IMP_CONTINUOUS",HOMOTOPIC_WITH_IMP_CONTINUOUS; +"HOMOTOPIC_WITH_IMP_PROPERTY",HOMOTOPIC_WITH_IMP_PROPERTY; +"HOMOTOPIC_WITH_IMP_SUBSET",HOMOTOPIC_WITH_IMP_SUBSET; +"HOMOTOPIC_WITH_LINEAR",HOMOTOPIC_WITH_LINEAR; +"HOMOTOPIC_WITH_MONO",HOMOTOPIC_WITH_MONO; +"HOMOTOPIC_WITH_PCROSS",HOMOTOPIC_WITH_PCROSS; +"HOMOTOPIC_WITH_REFL",HOMOTOPIC_WITH_REFL; +"HOMOTOPIC_WITH_SUBSET_LEFT",HOMOTOPIC_WITH_SUBSET_LEFT; +"HOMOTOPIC_WITH_SUBSET_RIGHT",HOMOTOPIC_WITH_SUBSET_RIGHT; +"HOMOTOPIC_WITH_SYM",HOMOTOPIC_WITH_SYM; +"HOMOTOPIC_WITH_TRANS",HOMOTOPIC_WITH_TRANS; +"HOMOTOPY_DOMINATED_CONTRACTIBILITY",HOMOTOPY_DOMINATED_CONTRACTIBILITY; +"HOMOTOPY_EQUIVALENT",HOMOTOPY_EQUIVALENT; +"HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY; +"HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL; +"HOMOTOPY_EQUIVALENT_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_CONNECTEDNESS; +"HOMOTOPY_EQUIVALENT_CONTRACTIBILITY",HOMOTOPY_EQUIVALENT_CONTRACTIBILITY; +"HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS",HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; +"HOMOTOPY_EQUIVALENT_EMPTY",HOMOTOPY_EQUIVALENT_EMPTY; +"HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY; +"HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL",HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL; +"HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; +"HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ; +"HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF",HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF; +"HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS",HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS; +"HOMOTOPY_EQUIVALENT_REFL",HOMOTOPY_EQUIVALENT_REFL; +"HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_AFFINE_HULL; +"HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX",HOMOTOPY_EQUIVALENT_RELATIVE_FRONTIER_PUNCTURED_CONVEX; +"HOMOTOPY_EQUIVALENT_SING",HOMOTOPY_EQUIVALENT_SING; +"HOMOTOPY_EQUIVALENT_SYM",HOMOTOPY_EQUIVALENT_SYM; +"HOMOTOPY_EQUIVALENT_TRANS",HOMOTOPY_EQUIVALENT_TRANS; +"HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ; +"HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ",HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ; +"HOMOTOPY_EQUIVALENT_TRANSLATION_SELF",HOMOTOPY_EQUIVALENT_TRANSLATION_SELF; +"HOMOTOPY_INVARIANT_CONNECTEDNESS",HOMOTOPY_INVARIANT_CONNECTEDNESS; +"HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS",HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS; +"HP",HP; +"HREAL_ADD_AC",HREAL_ADD_AC; +"HREAL_ADD_ASSOC",HREAL_ADD_ASSOC; +"HREAL_ADD_LCANCEL",HREAL_ADD_LCANCEL; +"HREAL_ADD_LDISTRIB",HREAL_ADD_LDISTRIB; +"HREAL_ADD_LID",HREAL_ADD_LID; +"HREAL_ADD_RDISTRIB",HREAL_ADD_RDISTRIB; +"HREAL_ADD_RID",HREAL_ADD_RID; +"HREAL_ADD_SYM",HREAL_ADD_SYM; +"HREAL_ARCH",HREAL_ARCH; +"HREAL_COMPLETE",HREAL_COMPLETE; +"HREAL_EQ_ADD_LCANCEL",HREAL_EQ_ADD_LCANCEL; +"HREAL_EQ_ADD_RCANCEL",HREAL_EQ_ADD_RCANCEL; +"HREAL_INV_0",HREAL_INV_0; +"HREAL_LE_ADD",HREAL_LE_ADD; +"HREAL_LE_ADD2",HREAL_LE_ADD2; +"HREAL_LE_ADD_LCANCEL",HREAL_LE_ADD_LCANCEL; +"HREAL_LE_ADD_RCANCEL",HREAL_LE_ADD_RCANCEL; +"HREAL_LE_ANTISYM",HREAL_LE_ANTISYM; +"HREAL_LE_EXISTS",HREAL_LE_EXISTS; +"HREAL_LE_EXISTS_DEF",HREAL_LE_EXISTS_DEF; +"HREAL_LE_MUL_RCANCEL_IMP",HREAL_LE_MUL_RCANCEL_IMP; +"HREAL_LE_REFL",HREAL_LE_REFL; +"HREAL_LE_TOTAL",HREAL_LE_TOTAL; +"HREAL_LE_TRANS",HREAL_LE_TRANS; +"HREAL_MUL_ASSOC",HREAL_MUL_ASSOC; +"HREAL_MUL_LID",HREAL_MUL_LID; +"HREAL_MUL_LINV",HREAL_MUL_LINV; +"HREAL_MUL_LZERO",HREAL_MUL_LZERO; +"HREAL_MUL_RZERO",HREAL_MUL_RZERO; +"HREAL_MUL_SYM",HREAL_MUL_SYM; +"HREAL_OF_NUM_ADD",HREAL_OF_NUM_ADD; +"HREAL_OF_NUM_EQ",HREAL_OF_NUM_EQ; +"HREAL_OF_NUM_LE",HREAL_OF_NUM_LE; +"HREAL_OF_NUM_MUL",HREAL_OF_NUM_MUL; +"HULLS_EQ",HULLS_EQ; +"HULL_ANTIMONO",HULL_ANTIMONO; +"HULL_EQ",HULL_EQ; +"HULL_HULL",HULL_HULL; +"HULL_IMAGE",HULL_IMAGE; +"HULL_IMAGE_GALOIS",HULL_IMAGE_GALOIS; +"HULL_IMAGE_SUBSET",HULL_IMAGE_SUBSET; +"HULL_INC",HULL_INC; +"HULL_INDUCT",HULL_INDUCT; +"HULL_MINIMAL",HULL_MINIMAL; +"HULL_MONO",HULL_MONO; +"HULL_P",HULL_P; +"HULL_P_AND_Q",HULL_P_AND_Q; +"HULL_REDUNDANT",HULL_REDUNDANT; +"HULL_REDUNDANT_EQ",HULL_REDUNDANT_EQ; +"HULL_SUBSET",HULL_SUBSET; +"HULL_UNION",HULL_UNION; +"HULL_UNION_LEFT",HULL_UNION_LEFT; +"HULL_UNION_RIGHT",HULL_UNION_RIGHT; +"HULL_UNION_SUBSET",HULL_UNION_SUBSET; +"HULL_UNIQUE",HULL_UNIQUE; +"HYPERPLANE_EQ_EMPTY",HYPERPLANE_EQ_EMPTY; +"HYPERPLANE_EQ_UNIV",HYPERPLANE_EQ_UNIV; +"HYPERPLANE_FACET_OF_HALFSPACE_GE",HYPERPLANE_FACET_OF_HALFSPACE_GE; +"HYPERPLANE_FACET_OF_HALFSPACE_LE",HYPERPLANE_FACET_OF_HALFSPACE_LE; +"HYPERPLANE_FACE_OF_HALFSPACE_GE",HYPERPLANE_FACE_OF_HALFSPACE_GE; +"HYPERPLANE_FACE_OF_HALFSPACE_LE",HYPERPLANE_FACE_OF_HALFSPACE_LE; +"IDEMPOTENT_IMP_RETRACTION",IDEMPOTENT_IMP_RETRACTION; +"IMAGE",IMAGE; +"IMAGE_AFFINITY_INTERVAL",IMAGE_AFFINITY_INTERVAL; +"IMAGE_CLAUSES",IMAGE_CLAUSES; +"IMAGE_CLOSURE_SUBSET",IMAGE_CLOSURE_SUBSET; +"IMAGE_COMPOSE_PERMUTATIONS_L",IMAGE_COMPOSE_PERMUTATIONS_L; +"IMAGE_COMPOSE_PERMUTATIONS_R",IMAGE_COMPOSE_PERMUTATIONS_R; +"IMAGE_CONST",IMAGE_CONST; +"IMAGE_DELETE_INJ",IMAGE_DELETE_INJ; +"IMAGE_DIFF_INJ",IMAGE_DIFF_INJ; +"IMAGE_DROP_UNIV",IMAGE_DROP_UNIV; +"IMAGE_EQ_EMPTY",IMAGE_EQ_EMPTY; +"IMAGE_FSTCART_PCROSS",IMAGE_FSTCART_PCROSS; +"IMAGE_I",IMAGE_I; +"IMAGE_ID",IMAGE_ID; +"IMAGE_IMP_INJECTIVE",IMAGE_IMP_INJECTIVE; +"IMAGE_IMP_INJECTIVE_GEN",IMAGE_IMP_INJECTIVE_GEN; +"IMAGE_INJECTIVE_IMAGE_OF_SUBSET",IMAGE_INJECTIVE_IMAGE_OF_SUBSET; +"IMAGE_INTER_INJ",IMAGE_INTER_INJ; +"IMAGE_INVERSE_PERMUTATIONS",IMAGE_INVERSE_PERMUTATIONS; +"IMAGE_LEMMA_0",IMAGE_LEMMA_0; +"IMAGE_LEMMA_1",IMAGE_LEMMA_1; +"IMAGE_LEMMA_2",IMAGE_LEMMA_2; +"IMAGE_LIFT_DROP",IMAGE_LIFT_DROP; +"IMAGE_LIFT_UNIV",IMAGE_LIFT_UNIV; +"IMAGE_SNDCART_PCROSS",IMAGE_SNDCART_PCROSS; +"IMAGE_STRETCH_INTERVAL",IMAGE_STRETCH_INTERVAL; +"IMAGE_SUBSET",IMAGE_SUBSET; +"IMAGE_TWIZZLE_INTERVAL",IMAGE_TWIZZLE_INTERVAL; +"IMAGE_UNION",IMAGE_UNION; +"IMAGE_UNIONS",IMAGE_UNIONS; +"IMAGE_o",IMAGE_o; +"IMP_CLAUSES",IMP_CLAUSES; +"IMP_CONJ",IMP_CONJ; +"IMP_CONJ_ALT",IMP_CONJ_ALT; +"IMP_DEF",IMP_DEF; +"IMP_IMP",IMP_IMP; +"IN",IN; +"INCREASING_BOUNDED_VARIATION",INCREASING_BOUNDED_VARIATION; +"INCREASING_LEFT_LIMIT_1",INCREASING_LEFT_LIMIT_1; +"INCREASING_RIGHT_LIMIT_1",INCREASING_RIGHT_LIMIT_1; +"INCREASING_VECTOR_VARIATION",INCREASING_VECTOR_VARIATION; +"INDEFINITE_INTEGRAL_CONTINUOUS",INDEFINITE_INTEGRAL_CONTINUOUS; +"INDEFINITE_INTEGRAL_CONTINUOUS_LEFT",INDEFINITE_INTEGRAL_CONTINUOUS_LEFT; +"INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT",INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT; +"INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS; +"INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT",INDEFINITE_INTEGRAL_UNIFORMLY_CONTINUOUS_EXPLICIT; +"INDEPENDENT_2",INDEPENDENT_2; +"INDEPENDENT_3",INDEPENDENT_3; +"INDEPENDENT_BOUND",INDEPENDENT_BOUND; +"INDEPENDENT_BOUND_GENERAL",INDEPENDENT_BOUND_GENERAL; +"INDEPENDENT_CARD_LE_DIM",INDEPENDENT_CARD_LE_DIM; +"INDEPENDENT_EMPTY",INDEPENDENT_EMPTY; +"INDEPENDENT_EXPLICIT",INDEPENDENT_EXPLICIT; +"INDEPENDENT_IMP_AFFINE_DEPENDENT_0",INDEPENDENT_IMP_AFFINE_DEPENDENT_0; +"INDEPENDENT_IMP_FINITE",INDEPENDENT_IMP_FINITE; +"INDEPENDENT_INJECTIVE_IMAGE",INDEPENDENT_INJECTIVE_IMAGE; +"INDEPENDENT_INJECTIVE_IMAGE_GEN",INDEPENDENT_INJECTIVE_IMAGE_GEN; +"INDEPENDENT_INSERT",INDEPENDENT_INSERT; +"INDEPENDENT_LINEAR_IMAGE_EQ",INDEPENDENT_LINEAR_IMAGE_EQ; +"INDEPENDENT_MONO",INDEPENDENT_MONO; +"INDEPENDENT_NONZERO",INDEPENDENT_NONZERO; +"INDEPENDENT_SING",INDEPENDENT_SING; +"INDEPENDENT_SPAN_BOUND",INDEPENDENT_SPAN_BOUND; +"INDEPENDENT_STDBASIS",INDEPENDENT_STDBASIS; +"INDUCT_LINEAR_ELEMENTARY",INDUCT_LINEAR_ELEMENTARY; +"INDUCT_MATRIX_ELEMENTARY",INDUCT_MATRIX_ELEMENTARY; +"INDUCT_MATRIX_ELEMENTARY_ALT",INDUCT_MATRIX_ELEMENTARY_ALT; +"INDUCT_MATRIX_ROW_OPERATIONS",INDUCT_MATRIX_ROW_OPERATIONS; +"IND_SUC_0",IND_SUC_0; +"IND_SUC_0_EXISTS",IND_SUC_0_EXISTS; +"IND_SUC_INJ",IND_SUC_INJ; +"IND_SUC_SPEC",IND_SUC_SPEC; +"INESSENTIAL_ON_CLOPEN_UNIONS",INESSENTIAL_ON_CLOPEN_UNIONS; +"INESSENTIAL_ON_COMPONENTS",INESSENTIAL_ON_COMPONENTS; +"INESSENTIAL_ON_COMPONENTS_EQ",INESSENTIAL_ON_COMPONENTS_EQ; +"INF",INF; +"INFINITE",INFINITE; +"INFINITE_ARC_IMAGE",INFINITE_ARC_IMAGE; +"INFINITE_CARD_LE",INFINITE_CARD_LE; +"INFINITE_DIFF_FINITE",INFINITE_DIFF_FINITE; +"INFINITE_ENUMERATE",INFINITE_ENUMERATE; +"INFINITE_ENUMERATE_WEAK",INFINITE_ENUMERATE_WEAK; +"INFINITE_FROM",INFINITE_FROM; +"INFINITE_IMAGE_INJ",INFINITE_IMAGE_INJ; +"INFINITE_INTEGER",INFINITE_INTEGER; +"INFINITE_NONEMPTY",INFINITE_NONEMPTY; +"INFINITE_OPEN_IN",INFINITE_OPEN_IN; +"INFINITE_RATIONAL",INFINITE_RATIONAL; +"INFINITE_SIMPLE_PATH_IMAGE",INFINITE_SIMPLE_PATH_IMAGE; +"INFINITE_SUPERSET",INFINITE_SUPERSET; +"INFINITY_AX",INFINITY_AX; +"INFNORM_0",INFNORM_0; +"INFNORM_2",INFNORM_2; +"INFNORM_EQ_0",INFNORM_EQ_0; +"INFNORM_EQ_1_2",INFNORM_EQ_1_2; +"INFNORM_EQ_1_IMP",INFNORM_EQ_1_IMP; +"INFNORM_LE_NORM",INFNORM_LE_NORM; +"INFNORM_MUL",INFNORM_MUL; +"INFNORM_MUL_LEMMA",INFNORM_MUL_LEMMA; +"INFNORM_NEG",INFNORM_NEG; +"INFNORM_POS_LE",INFNORM_POS_LE; +"INFNORM_POS_LT",INFNORM_POS_LT; +"INFNORM_SET_IMAGE",INFNORM_SET_IMAGE; +"INFNORM_SET_LEMMA",INFNORM_SET_LEMMA; +"INFNORM_SUB",INFNORM_SUB; +"INFNORM_TRIANGLE",INFNORM_TRIANGLE; +"INFSUM_0",INFSUM_0; +"INFSUM_ADD",INFSUM_ADD; +"INFSUM_CMUL",INFSUM_CMUL; +"INFSUM_EQ",INFSUM_EQ; +"INFSUM_LINEAR",INFSUM_LINEAR; +"INFSUM_NEG",INFSUM_NEG; +"INFSUM_RESTRICT",INFSUM_RESTRICT; +"INFSUM_SUB",INFSUM_SUB; +"INFSUM_UNIQUE",INFSUM_UNIQUE; +"INF_CLOSURE",INF_CLOSURE; +"INF_EQ",INF_EQ; +"INF_FINITE",INF_FINITE; +"INF_FINITE_LEMMA",INF_FINITE_LEMMA; +"INF_INSERT",INF_INSERT; +"INF_INSERT_FINITE",INF_INSERT_FINITE; +"INF_SING",INF_SING; +"INF_UNION",INF_UNION; +"INF_UNIQUE",INF_UNIQUE; +"INF_UNIQUE_FINITE",INF_UNIQUE_FINITE; +"INJ",INJ; +"INJA",INJA; +"INJA_INJ",INJA_INJ; +"INJECTIVE_ALT",INJECTIVE_ALT; +"INJECTIVE_IMAGE",INJECTIVE_IMAGE; +"INJECTIVE_IMP_ISOMETRIC",INJECTIVE_IMP_ISOMETRIC; +"INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM",INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM; +"INJECTIVE_INTO_1D_IMP_OPEN_MAP",INJECTIVE_INTO_1D_IMP_OPEN_MAP; +"INJECTIVE_INVERSE",INJECTIVE_INVERSE; +"INJECTIVE_INVERSE_o",INJECTIVE_INVERSE_o; +"INJECTIVE_LEFT_INVERSE",INJECTIVE_LEFT_INVERSE; +"INJECTIVE_LEFT_INVERSE_NONEMPTY",INJECTIVE_LEFT_INVERSE_NONEMPTY; +"INJECTIVE_MAP",INJECTIVE_MAP; +"INJECTIVE_MAP_OPEN_IFF_CLOSED",INJECTIVE_MAP_OPEN_IFF_CLOSED; +"INJECTIVE_ON_ALT",INJECTIVE_ON_ALT; +"INJECTIVE_ON_IMAGE",INJECTIVE_ON_IMAGE; +"INJECTIVE_ON_LEFT_INVERSE",INJECTIVE_ON_LEFT_INVERSE; +"INJECTIVE_SCALING",INJECTIVE_SCALING; +"INJF",INJF; +"INJF_INJ",INJF_INJ; +"INJN",INJN; +"INJN_INJ",INJN_INJ; +"INJP",INJP; +"INJP_INJ",INJP_INJ; +"INJ_INVERSE2",INJ_INVERSE2; +"INNER_LADD",INNER_LADD; +"INNER_LMUL",INNER_LMUL; +"INNER_LNEG",INNER_LNEG; +"INNER_LZERO",INNER_LZERO; +"INNER_RADD",INNER_RADD; +"INNER_RMUL",INNER_RMUL; +"INNER_RNEG",INNER_RNEG; +"INNER_RZERO",INNER_RZERO; +"INSEG_LINSEG",INSEG_LINSEG; +"INSEG_PROPER_SUBSET",INSEG_PROPER_SUBSET; +"INSEG_PROPER_SUBSET_FL",INSEG_PROPER_SUBSET_FL; +"INSEG_SUBSET",INSEG_SUBSET; +"INSEG_SUBSET_FL",INSEG_SUBSET_FL; +"INSEG_WOSET",INSEG_WOSET; +"INSERT",INSERT; +"INSERT_AC",INSERT_AC; +"INSERT_COMM",INSERT_COMM; +"INSERT_DEF",INSERT_DEF; +"INSERT_DELETE",INSERT_DELETE; +"INSERT_DIFF",INSERT_DIFF; +"INSERT_INSERT",INSERT_INSERT; +"INSERT_INTER",INSERT_INTER; +"INSERT_SUBSET",INSERT_SUBSET; +"INSERT_UNION",INSERT_UNION; +"INSERT_UNION_EQ",INSERT_UNION_EQ; +"INSERT_UNIV",INSERT_UNIV; +"INSIDE_ARC_EMPTY",INSIDE_ARC_EMPTY; +"INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY",INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY; +"INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY",INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY; +"INSIDE_CONNECTED_COMPONENT_LE",INSIDE_CONNECTED_COMPONENT_LE; +"INSIDE_CONNECTED_COMPONENT_LT",INSIDE_CONNECTED_COMPONENT_LT; +"INSIDE_CONVEX",INSIDE_CONVEX; +"INSIDE_EMPTY",INSIDE_EMPTY; +"INSIDE_EQ_OUTSIDE",INSIDE_EQ_OUTSIDE; +"INSIDE_FRONTIER_EQ_INTERIOR",INSIDE_FRONTIER_EQ_INTERIOR; +"INSIDE_INSIDE",INSIDE_INSIDE; +"INSIDE_INSIDE_COMPACT_CONNECTED",INSIDE_INSIDE_COMPACT_CONNECTED; +"INSIDE_INSIDE_EQ_EMPTY",INSIDE_INSIDE_EQ_EMPTY; +"INSIDE_INSIDE_SUBSET",INSIDE_INSIDE_SUBSET; +"INSIDE_INTER_OUTSIDE",INSIDE_INTER_OUTSIDE; +"INSIDE_IN_COMPONENTS",INSIDE_IN_COMPONENTS; +"INSIDE_LINEAR_IMAGE",INSIDE_LINEAR_IMAGE; +"INSIDE_MONO",INSIDE_MONO; +"INSIDE_NO_OVERLAP",INSIDE_NO_OVERLAP; +"INSIDE_OF_TRIANGLE",INSIDE_OF_TRIANGLE; +"INSIDE_OUTSIDE",INSIDE_OUTSIDE; +"INSIDE_OUTSIDE_INTERSECT_CONNECTED",INSIDE_OUTSIDE_INTERSECT_CONNECTED; +"INSIDE_OUTSIDE_UNIQUE",INSIDE_OUTSIDE_UNIQUE; +"INSIDE_SAME_COMPONENT",INSIDE_SAME_COMPONENT; +"INSIDE_SIMPLE_CURVE_IMP_CLOSED",INSIDE_SIMPLE_CURVE_IMP_CLOSED; +"INSIDE_SUBSET",INSIDE_SUBSET; +"INSIDE_TRANSLATION",INSIDE_TRANSLATION; +"INSIDE_UNION_OUTSIDE",INSIDE_UNION_OUTSIDE; +"INSIDE_UNIQUE",INSIDE_UNIQUE; +"INTEGER_ABS",INTEGER_ABS; +"INTEGER_ABS_MUL_EQ_1",INTEGER_ABS_MUL_EQ_1; +"INTEGER_ADD",INTEGER_ADD; +"INTEGER_ADD_EQ",INTEGER_ADD_EQ; +"INTEGER_CASES",INTEGER_CASES; +"INTEGER_CLOSED",INTEGER_CLOSED; +"INTEGER_DET",INTEGER_DET; +"INTEGER_DIV",INTEGER_DIV; +"INTEGER_EXISTS_BETWEEN",INTEGER_EXISTS_BETWEEN; +"INTEGER_EXISTS_BETWEEN_ABS",INTEGER_EXISTS_BETWEEN_ABS; +"INTEGER_EXISTS_BETWEEN_ABS_LT",INTEGER_EXISTS_BETWEEN_ABS_LT; +"INTEGER_EXISTS_BETWEEN_ALT",INTEGER_EXISTS_BETWEEN_ALT; +"INTEGER_EXISTS_BETWEEN_LT",INTEGER_EXISTS_BETWEEN_LT; +"INTEGER_MUL",INTEGER_MUL; +"INTEGER_NEG",INTEGER_NEG; +"INTEGER_POS",INTEGER_POS; +"INTEGER_POW",INTEGER_POW; +"INTEGER_PRODUCT",INTEGER_PRODUCT; +"INTEGER_ROUND",INTEGER_ROUND; +"INTEGER_SIGN",INTEGER_SIGN; +"INTEGER_SUB",INTEGER_SUB; +"INTEGER_SUB_EQ",INTEGER_SUB_EQ; +"INTEGER_SUM",INTEGER_SUM; +"INTEGRABLE_0",INTEGRABLE_0; +"INTEGRABLE_ADD",INTEGRABLE_ADD; +"INTEGRABLE_AFFINITY",INTEGRABLE_AFFINITY; +"INTEGRABLE_ALT",INTEGRABLE_ALT; +"INTEGRABLE_ALT_SUBSET",INTEGRABLE_ALT_SUBSET; +"INTEGRABLE_BOUNDED_VARIATION_PRODUCT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT; +"INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT",INTEGRABLE_BOUNDED_VARIATION_PRODUCT_ALT; +"INTEGRABLE_BY_PARTS",INTEGRABLE_BY_PARTS; +"INTEGRABLE_BY_PARTS_EQ",INTEGRABLE_BY_PARTS_EQ; +"INTEGRABLE_CASES",INTEGRABLE_CASES; +"INTEGRABLE_CAUCHY",INTEGRABLE_CAUCHY; +"INTEGRABLE_CCONTINUOUS_EXPLICIT",INTEGRABLE_CCONTINUOUS_EXPLICIT; +"INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC",INTEGRABLE_CCONTINUOUS_EXPLICIT_SYMMETRIC; +"INTEGRABLE_CMUL",INTEGRABLE_CMUL; +"INTEGRABLE_CMUL_EQ",INTEGRABLE_CMUL_EQ; +"INTEGRABLE_COMBINE",INTEGRABLE_COMBINE; +"INTEGRABLE_COMBINE_DIVISION",INTEGRABLE_COMBINE_DIVISION; +"INTEGRABLE_COMPONENTWISE",INTEGRABLE_COMPONENTWISE; +"INTEGRABLE_CONST",INTEGRABLE_CONST; +"INTEGRABLE_CONTINUOUS",INTEGRABLE_CONTINUOUS; +"INTEGRABLE_DECREASING",INTEGRABLE_DECREASING; +"INTEGRABLE_DECREASING_1",INTEGRABLE_DECREASING_1; +"INTEGRABLE_DECREASING_PRODUCT",INTEGRABLE_DECREASING_PRODUCT; +"INTEGRABLE_DECREASING_PRODUCT_UNIV",INTEGRABLE_DECREASING_PRODUCT_UNIV; +"INTEGRABLE_EQ",INTEGRABLE_EQ; +"INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE",INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE; +"INTEGRABLE_IMP_MEASURABLE",INTEGRABLE_IMP_MEASURABLE; +"INTEGRABLE_INCREASING",INTEGRABLE_INCREASING; +"INTEGRABLE_INCREASING_1",INTEGRABLE_INCREASING_1; +"INTEGRABLE_INCREASING_PRODUCT",INTEGRABLE_INCREASING_PRODUCT; +"INTEGRABLE_INCREASING_PRODUCT_UNIV",INTEGRABLE_INCREASING_PRODUCT_UNIV; +"INTEGRABLE_INTEGRAL",INTEGRABLE_INTEGRAL; +"INTEGRABLE_LINEAR",INTEGRABLE_LINEAR; +"INTEGRABLE_MIN_CONST_1",INTEGRABLE_MIN_CONST_1; +"INTEGRABLE_NEG",INTEGRABLE_NEG; +"INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND",INTEGRABLE_ON_ALL_INTERVALS_INTEGRABLE_BOUND; +"INTEGRABLE_ON_CONST",INTEGRABLE_ON_CONST; +"INTEGRABLE_ON_EMPTY",INTEGRABLE_ON_EMPTY; +"INTEGRABLE_ON_LITTLE_SUBINTERVALS",INTEGRABLE_ON_LITTLE_SUBINTERVALS; +"INTEGRABLE_ON_NULL",INTEGRABLE_ON_NULL; +"INTEGRABLE_ON_OPEN_INTERVAL",INTEGRABLE_ON_OPEN_INTERVAL; +"INTEGRABLE_ON_REFL",INTEGRABLE_ON_REFL; +"INTEGRABLE_ON_SUBDIVISION",INTEGRABLE_ON_SUBDIVISION; +"INTEGRABLE_ON_SUBINTERVAL",INTEGRABLE_ON_SUBINTERVAL; +"INTEGRABLE_ON_SUPERSET",INTEGRABLE_ON_SUPERSET; +"INTEGRABLE_PASTECART_SYM",INTEGRABLE_PASTECART_SYM; +"INTEGRABLE_PASTECART_SYM_UNIV",INTEGRABLE_PASTECART_SYM_UNIV; +"INTEGRABLE_REFLECT",INTEGRABLE_REFLECT; +"INTEGRABLE_REFLECT_GEN",INTEGRABLE_REFLECT_GEN; +"INTEGRABLE_RESTRICT",INTEGRABLE_RESTRICT; +"INTEGRABLE_RESTRICT_INTER",INTEGRABLE_RESTRICT_INTER; +"INTEGRABLE_RESTRICT_UNIV",INTEGRABLE_RESTRICT_UNIV; +"INTEGRABLE_SPIKE",INTEGRABLE_SPIKE; +"INTEGRABLE_SPIKE_EQ",INTEGRABLE_SPIKE_EQ; +"INTEGRABLE_SPIKE_FINITE",INTEGRABLE_SPIKE_FINITE; +"INTEGRABLE_SPIKE_INTERIOR",INTEGRABLE_SPIKE_INTERIOR; +"INTEGRABLE_SPIKE_SET",INTEGRABLE_SPIKE_SET; +"INTEGRABLE_SPIKE_SET_EQ",INTEGRABLE_SPIKE_SET_EQ; +"INTEGRABLE_SPLIT",INTEGRABLE_SPLIT; +"INTEGRABLE_STRADDLE",INTEGRABLE_STRADDLE; +"INTEGRABLE_STRADDLE_INTERVAL",INTEGRABLE_STRADDLE_INTERVAL; +"INTEGRABLE_STRETCH",INTEGRABLE_STRETCH; +"INTEGRABLE_SUB",INTEGRABLE_SUB; +"INTEGRABLE_SUBINTERVAL",INTEGRABLE_SUBINTERVAL; +"INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE",INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE; +"INTEGRABLE_UNIFORM_LIMIT",INTEGRABLE_UNIFORM_LIMIT; +"INTEGRABLE_VSUM",INTEGRABLE_VSUM; +"INTEGRAL_0",INTEGRAL_0; +"INTEGRAL_ADD",INTEGRAL_ADD; +"INTEGRAL_CMUL",INTEGRAL_CMUL; +"INTEGRAL_COMBINE",INTEGRAL_COMBINE; +"INTEGRAL_COMBINE_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_DIVISION_BOTTOMUP; +"INTEGRAL_COMBINE_DIVISION_TOPDOWN",INTEGRAL_COMBINE_DIVISION_TOPDOWN; +"INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP",INTEGRAL_COMBINE_TAGGED_DIVISION_BOTTOMUP; +"INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN",INTEGRAL_COMBINE_TAGGED_DIVISION_TOPDOWN; +"INTEGRAL_COMPONENT",INTEGRAL_COMPONENT; +"INTEGRAL_COMPONENT_LBOUND",INTEGRAL_COMPONENT_LBOUND; +"INTEGRAL_COMPONENT_LE",INTEGRAL_COMPONENT_LE; +"INTEGRAL_COMPONENT_LE_AE",INTEGRAL_COMPONENT_LE_AE; +"INTEGRAL_COMPONENT_POS",INTEGRAL_COMPONENT_POS; +"INTEGRAL_COMPONENT_UBOUND",INTEGRAL_COMPONENT_UBOUND; +"INTEGRAL_CONST",INTEGRAL_CONST; +"INTEGRAL_DIFF",INTEGRAL_DIFF; +"INTEGRAL_DROP_LE",INTEGRAL_DROP_LE; +"INTEGRAL_DROP_LE_AE",INTEGRAL_DROP_LE_AE; +"INTEGRAL_DROP_LE_MEASURABLE",INTEGRAL_DROP_LE_MEASURABLE; +"INTEGRAL_DROP_POS",INTEGRAL_DROP_POS; +"INTEGRAL_DROP_POS_AE",INTEGRAL_DROP_POS_AE; +"INTEGRAL_EMPTY",INTEGRAL_EMPTY; +"INTEGRAL_EQ",INTEGRAL_EQ; +"INTEGRAL_EQ_0",INTEGRAL_EQ_0; +"INTEGRAL_EQ_HAS_INTEGRAL",INTEGRAL_EQ_HAS_INTEGRAL; +"INTEGRAL_HAS_VECTOR_DERIVATIVE",INTEGRAL_HAS_VECTOR_DERIVATIVE; +"INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE",INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE; +"INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_DIFF_INCLUSION_EXCLUSION; +"INTEGRAL_INTERVALS_INCLUSION_EXCLUSION",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION; +"INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_LEFT; +"INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT",INTEGRAL_INTERVALS_INCLUSION_EXCLUSION_RIGHT; +"INTEGRAL_LINEAR",INTEGRAL_LINEAR; +"INTEGRAL_MEASURE",INTEGRAL_MEASURE; +"INTEGRAL_MEASURE_UNIV",INTEGRAL_MEASURE_UNIV; +"INTEGRAL_NEG",INTEGRAL_NEG; +"INTEGRAL_NORM_BOUND_INTEGRAL",INTEGRAL_NORM_BOUND_INTEGRAL; +"INTEGRAL_NORM_BOUND_INTEGRAL_AE",INTEGRAL_NORM_BOUND_INTEGRAL_AE; +"INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT",INTEGRAL_NORM_BOUND_INTEGRAL_COMPONENT; +"INTEGRAL_NULL",INTEGRAL_NULL; +"INTEGRAL_OPEN_INTERVAL",INTEGRAL_OPEN_INTERVAL; +"INTEGRAL_PASTECART_CONST",INTEGRAL_PASTECART_CONST; +"INTEGRAL_PASTECART_CONTINUOUS",INTEGRAL_PASTECART_CONTINUOUS; +"INTEGRAL_PASTECART_SYM",INTEGRAL_PASTECART_SYM; +"INTEGRAL_PASTECART_SYM_UNIV",INTEGRAL_PASTECART_SYM_UNIV; +"INTEGRAL_REFL",INTEGRAL_REFL; +"INTEGRAL_REFLECT",INTEGRAL_REFLECT; +"INTEGRAL_REFLECT_GEN",INTEGRAL_REFLECT_GEN; +"INTEGRAL_RESTRICT",INTEGRAL_RESTRICT; +"INTEGRAL_RESTRICT_INTER",INTEGRAL_RESTRICT_INTER; +"INTEGRAL_RESTRICT_UNIV",INTEGRAL_RESTRICT_UNIV; +"INTEGRAL_SPIKE",INTEGRAL_SPIKE; +"INTEGRAL_SPIKE_SET",INTEGRAL_SPIKE_SET; +"INTEGRAL_SPLIT",INTEGRAL_SPLIT; +"INTEGRAL_SPLIT_SIGNED",INTEGRAL_SPLIT_SIGNED; +"INTEGRAL_SUB",INTEGRAL_SUB; +"INTEGRAL_SUBSET_COMPONENT_LE",INTEGRAL_SUBSET_COMPONENT_LE; +"INTEGRAL_SUBSET_DROP_LE",INTEGRAL_SUBSET_DROP_LE; +"INTEGRAL_SWAP_CONTINUOUS",INTEGRAL_SWAP_CONTINUOUS; +"INTEGRAL_UNION",INTEGRAL_UNION; +"INTEGRAL_UNIQUE",INTEGRAL_UNIQUE; +"INTEGRAL_VSUM",INTEGRAL_VSUM; +"INTEGRATION_BY_PARTS",INTEGRATION_BY_PARTS; +"INTEGRATION_BY_PARTS_SIMPLE",INTEGRATION_BY_PARTS_SIMPLE; +"INTER",INTER; +"INTERIOR_BALL",INTERIOR_BALL; +"INTERIOR_BIJECTIVE_LINEAR_IMAGE",INTERIOR_BIJECTIVE_LINEAR_IMAGE; +"INTERIOR_CBALL",INTERIOR_CBALL; +"INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER",INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER; +"INTERIOR_CLOSED_INTERVAL",INTERIOR_CLOSED_INTERVAL; +"INTERIOR_CLOSED_UNION_EMPTY_INTERIOR",INTERIOR_CLOSED_UNION_EMPTY_INTERIOR; +"INTERIOR_CLOSURE",INTERIOR_CLOSURE; +"INTERIOR_CLOSURE_IDEMP",INTERIOR_CLOSURE_IDEMP; +"INTERIOR_CLOSURE_INTER_OPEN",INTERIOR_CLOSURE_INTER_OPEN; +"INTERIOR_COMPLEMENT",INTERIOR_COMPLEMENT; +"INTERIOR_CONVEX_HULL_3",INTERIOR_CONVEX_HULL_3; +"INTERIOR_CONVEX_HULL_3_MINIMAL",INTERIOR_CONVEX_HULL_3_MINIMAL; +"INTERIOR_CONVEX_HULL_EQ_EMPTY",INTERIOR_CONVEX_HULL_EQ_EMPTY; +"INTERIOR_CONVEX_HULL_EXPLICIT",INTERIOR_CONVEX_HULL_EXPLICIT; +"INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL",INTERIOR_CONVEX_HULL_EXPLICIT_MINIMAL; +"INTERIOR_DIFF",INTERIOR_DIFF; +"INTERIOR_EMPTY",INTERIOR_EMPTY; +"INTERIOR_EQ",INTERIOR_EQ; +"INTERIOR_EQ_EMPTY",INTERIOR_EQ_EMPTY; +"INTERIOR_EQ_EMPTY_ALT",INTERIOR_EQ_EMPTY_ALT; +"INTERIOR_FINITE_INTERS",INTERIOR_FINITE_INTERS; +"INTERIOR_FRONTIER",INTERIOR_FRONTIER; +"INTERIOR_FRONTIER_EMPTY",INTERIOR_FRONTIER_EMPTY; +"INTERIOR_HALFSPACE_COMPONENT_GE",INTERIOR_HALFSPACE_COMPONENT_GE; +"INTERIOR_HALFSPACE_COMPONENT_LE",INTERIOR_HALFSPACE_COMPONENT_LE; +"INTERIOR_HALFSPACE_GE",INTERIOR_HALFSPACE_GE; +"INTERIOR_HALFSPACE_LE",INTERIOR_HALFSPACE_LE; +"INTERIOR_HYPERPLANE",INTERIOR_HYPERPLANE; +"INTERIOR_IMAGE_SUBSET",INTERIOR_IMAGE_SUBSET; +"INTERIOR_INJECTIVE_LINEAR_IMAGE",INTERIOR_INJECTIVE_LINEAR_IMAGE; +"INTERIOR_INSIDE_FRONTIER",INTERIOR_INSIDE_FRONTIER; +"INTERIOR_INTER",INTERIOR_INTER; +"INTERIOR_INTERIOR",INTERIOR_INTERIOR; +"INTERIOR_INTERS_SUBSET",INTERIOR_INTERS_SUBSET; +"INTERIOR_INTERVAL",INTERIOR_INTERVAL; +"INTERIOR_LIMIT_POINT",INTERIOR_LIMIT_POINT; +"INTERIOR_MAXIMAL",INTERIOR_MAXIMAL; +"INTERIOR_MAXIMAL_EQ",INTERIOR_MAXIMAL_EQ; +"INTERIOR_NEGATIONS",INTERIOR_NEGATIONS; +"INTERIOR_OF_TRIANGLE",INTERIOR_OF_TRIANGLE; +"INTERIOR_OPEN",INTERIOR_OPEN; +"INTERIOR_PCROSS",INTERIOR_PCROSS; +"INTERIOR_SEGMENT",INTERIOR_SEGMENT; +"INTERIOR_SIMPLEX_NONEMPTY",INTERIOR_SIMPLEX_NONEMPTY; +"INTERIOR_SING",INTERIOR_SING; +"INTERIOR_STANDARD_HYPERPLANE",INTERIOR_STANDARD_HYPERPLANE; +"INTERIOR_STD_SIMPLEX",INTERIOR_STD_SIMPLEX; +"INTERIOR_SUBSET",INTERIOR_SUBSET; +"INTERIOR_SUBSET_RELATIVE_INTERIOR",INTERIOR_SUBSET_RELATIVE_INTERIOR; +"INTERIOR_SUBSET_UNION_INTERVALS",INTERIOR_SUBSET_UNION_INTERVALS; +"INTERIOR_SURJECTIVE_LINEAR_IMAGE",INTERIOR_SURJECTIVE_LINEAR_IMAGE; +"INTERIOR_TRANSLATION",INTERIOR_TRANSLATION; +"INTERIOR_UNIONS_OPEN_SUBSETS",INTERIOR_UNIONS_OPEN_SUBSETS; +"INTERIOR_UNION_EQ_EMPTY",INTERIOR_UNION_EQ_EMPTY; +"INTERIOR_UNIQUE",INTERIOR_UNIQUE; +"INTERIOR_UNIV",INTERIOR_UNIV; +"INTERS",INTERS; +"INTERS_0",INTERS_0; +"INTERS_1",INTERS_1; +"INTERS_2",INTERS_2; +"INTERS_FACES_FINITE_ALTBOUND",INTERS_FACES_FINITE_ALTBOUND; +"INTERS_FACES_FINITE_BOUND",INTERS_FACES_FINITE_BOUND; +"INTERS_GSPEC",INTERS_GSPEC; +"INTERS_IMAGE",INTERS_IMAGE; +"INTERS_INSERT",INTERS_INSERT; +"INTERS_OVER_UNIONS",INTERS_OVER_UNIONS; +"INTERS_UNION",INTERS_UNION; +"INTERS_UNIONS",INTERS_UNIONS; +"INTERVAL_BIJ_AFFINE",INTERVAL_BIJ_AFFINE; +"INTERVAL_BIJ_BIJ",INTERVAL_BIJ_BIJ; +"INTERVAL_BISECTION",INTERVAL_BISECTION; +"INTERVAL_BISECTION_STEP",INTERVAL_BISECTION_STEP; +"INTERVAL_BOUNDS_EMPTY_1",INTERVAL_BOUNDS_EMPTY_1; +"INTERVAL_BOUNDS_NULL_1",INTERVAL_BOUNDS_NULL_1; +"INTERVAL_CASES_1",INTERVAL_CASES_1; +"INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD",INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD; +"INTERVAL_DOUBLESPLIT",INTERVAL_DOUBLESPLIT; +"INTERVAL_EQ_EMPTY",INTERVAL_EQ_EMPTY; +"INTERVAL_EQ_EMPTY_1",INTERVAL_EQ_EMPTY_1; +"INTERVAL_IMAGE_AFFINITY_INTERVAL",INTERVAL_IMAGE_AFFINITY_INTERVAL; +"INTERVAL_IMAGE_STRETCH_INTERVAL",INTERVAL_IMAGE_STRETCH_INTERVAL; +"INTERVAL_LOWERBOUND",INTERVAL_LOWERBOUND; +"INTERVAL_LOWERBOUND_1",INTERVAL_LOWERBOUND_1; +"INTERVAL_LOWERBOUND_NONEMPTY",INTERVAL_LOWERBOUND_NONEMPTY; +"INTERVAL_NE_EMPTY",INTERVAL_NE_EMPTY; +"INTERVAL_NE_EMPTY_1",INTERVAL_NE_EMPTY_1; +"INTERVAL_OPEN_SUBSET_CLOSED",INTERVAL_OPEN_SUBSET_CLOSED; +"INTERVAL_SING",INTERVAL_SING; +"INTERVAL_SPLIT",INTERVAL_SPLIT; +"INTERVAL_SUBDIVISION",INTERVAL_SUBDIVISION; +"INTERVAL_SUBSET_IS_INTERVAL",INTERVAL_SUBSET_IS_INTERVAL; +"INTERVAL_TRANSLATION",INTERVAL_TRANSLATION; +"INTERVAL_UPPERBOUND",INTERVAL_UPPERBOUND; +"INTERVAL_UPPERBOUND_1",INTERVAL_UPPERBOUND_1; +"INTERVAL_UPPERBOUND_NONEMPTY",INTERVAL_UPPERBOUND_NONEMPTY; +"INTER_ACI",INTER_ACI; +"INTER_ASSOC",INTER_ASSOC; +"INTER_BALLS_EQ_EMPTY",INTER_BALLS_EQ_EMPTY; +"INTER_COMM",INTER_COMM; +"INTER_EMPTY",INTER_EMPTY; +"INTER_IDEMPOT",INTER_IDEMPOT; +"INTER_INTERIOR_UNIONS_INTERVALS",INTER_INTERIOR_UNIONS_INTERVALS; +"INTER_INTERVAL",INTER_INTERVAL; +"INTER_INTERVAL_1",INTER_INTERVAL_1; +"INTER_INTERVAL_MIXED_EQ_EMPTY",INTER_INTERVAL_MIXED_EQ_EMPTY; +"INTER_OVER_UNION",INTER_OVER_UNION; +"INTER_PCROSS",INTER_PCROSS; +"INTER_SEGMENT",INTER_SEGMENT; +"INTER_SUBSET",INTER_SUBSET; +"INTER_UNIONS",INTER_UNIONS; +"INTER_UNIV",INTER_UNIV; +"INT_ABS",INT_ABS; +"INT_ABS_0",INT_ABS_0; +"INT_ABS_1",INT_ABS_1; +"INT_ABS_ABS",INT_ABS_ABS; +"INT_ABS_BETWEEN",INT_ABS_BETWEEN; +"INT_ABS_BETWEEN1",INT_ABS_BETWEEN1; +"INT_ABS_BETWEEN2",INT_ABS_BETWEEN2; +"INT_ABS_BOUND",INT_ABS_BOUND; +"INT_ABS_CASES",INT_ABS_CASES; +"INT_ABS_CIRCLE",INT_ABS_CIRCLE; +"INT_ABS_LE",INT_ABS_LE; +"INT_ABS_MUL",INT_ABS_MUL; +"INT_ABS_MUL_1",INT_ABS_MUL_1; +"INT_ABS_NEG",INT_ABS_NEG; +"INT_ABS_NUM",INT_ABS_NUM; +"INT_ABS_NZ",INT_ABS_NZ; +"INT_ABS_POS",INT_ABS_POS; +"INT_ABS_POW",INT_ABS_POW; +"INT_ABS_REFL",INT_ABS_REFL; +"INT_ABS_SGN",INT_ABS_SGN; +"INT_ABS_SIGN",INT_ABS_SIGN; +"INT_ABS_SIGN2",INT_ABS_SIGN2; +"INT_ABS_STILLNZ",INT_ABS_STILLNZ; +"INT_ABS_SUB",INT_ABS_SUB; +"INT_ABS_SUB_ABS",INT_ABS_SUB_ABS; +"INT_ABS_TRIANGLE",INT_ABS_TRIANGLE; +"INT_ABS_ZERO",INT_ABS_ZERO; +"INT_ADD2_SUB2",INT_ADD2_SUB2; +"INT_ADD_AC",INT_ADD_AC; +"INT_ADD_ASSOC",INT_ADD_ASSOC; +"INT_ADD_LDISTRIB",INT_ADD_LDISTRIB; +"INT_ADD_LID",INT_ADD_LID; +"INT_ADD_LINV",INT_ADD_LINV; +"INT_ADD_RDISTRIB",INT_ADD_RDISTRIB; +"INT_ADD_RID",INT_ADD_RID; +"INT_ADD_RINV",INT_ADD_RINV; +"INT_ADD_SUB",INT_ADD_SUB; +"INT_ADD_SUB2",INT_ADD_SUB2; +"INT_ADD_SYM",INT_ADD_SYM; +"INT_ARCH",INT_ARCH; +"INT_BOUNDS_LE",INT_BOUNDS_LE; +"INT_BOUNDS_LT",INT_BOUNDS_LT; +"INT_DIFFSQ",INT_DIFFSQ; +"INT_DIVISION",INT_DIVISION; +"INT_DIVISION_0",INT_DIVISION_0; +"INT_DIVMOD_EXIST_0",INT_DIVMOD_EXIST_0; +"INT_DIVMOD_UNIQ",INT_DIVMOD_UNIQ; +"INT_ENTIRE",INT_ENTIRE; +"INT_EQ_ADD_LCANCEL",INT_EQ_ADD_LCANCEL; +"INT_EQ_ADD_LCANCEL_0",INT_EQ_ADD_LCANCEL_0; +"INT_EQ_ADD_RCANCEL",INT_EQ_ADD_RCANCEL; +"INT_EQ_ADD_RCANCEL_0",INT_EQ_ADD_RCANCEL_0; +"INT_EQ_IMP_LE",INT_EQ_IMP_LE; +"INT_EQ_MUL_LCANCEL",INT_EQ_MUL_LCANCEL; +"INT_EQ_MUL_RCANCEL",INT_EQ_MUL_RCANCEL; +"INT_EQ_NEG2",INT_EQ_NEG2; +"INT_EQ_SGN_ABS",INT_EQ_SGN_ABS; +"INT_EQ_SQUARE_ABS",INT_EQ_SQUARE_ABS; +"INT_EQ_SUB_LADD",INT_EQ_SUB_LADD; +"INT_EQ_SUB_RADD",INT_EQ_SUB_RADD; +"INT_EXISTS_ABS",INT_EXISTS_ABS; +"INT_EXISTS_POS",INT_EXISTS_POS; +"INT_FORALL_ABS",INT_FORALL_ABS; +"INT_FORALL_POS",INT_FORALL_POS; +"INT_GCD_EXISTS",INT_GCD_EXISTS; +"INT_GCD_EXISTS_POS",INT_GCD_EXISTS_POS; +"INT_GE",INT_GE; +"INT_GT",INT_GT; +"INT_GT_DISCRETE",INT_GT_DISCRETE; +"INT_IMAGE",INT_IMAGE; +"INT_LET_ADD",INT_LET_ADD; +"INT_LET_ADD2",INT_LET_ADD2; +"INT_LET_ANTISYM",INT_LET_ANTISYM; +"INT_LET_TOTAL",INT_LET_TOTAL; +"INT_LET_TRANS",INT_LET_TRANS; +"INT_LE_01",INT_LE_01; +"INT_LE_ADD",INT_LE_ADD; +"INT_LE_ADD2",INT_LE_ADD2; +"INT_LE_ADDL",INT_LE_ADDL; +"INT_LE_ADDR",INT_LE_ADDR; +"INT_LE_ANTISYM",INT_LE_ANTISYM; +"INT_LE_DISCRETE",INT_LE_DISCRETE; +"INT_LE_DOUBLE",INT_LE_DOUBLE; +"INT_LE_LADD",INT_LE_LADD; +"INT_LE_LADD_IMP",INT_LE_LADD_IMP; +"INT_LE_LMUL",INT_LE_LMUL; +"INT_LE_LNEG",INT_LE_LNEG; +"INT_LE_LT",INT_LE_LT; +"INT_LE_MAX",INT_LE_MAX; +"INT_LE_MIN",INT_LE_MIN; +"INT_LE_MUL",INT_LE_MUL; +"INT_LE_MUL_EQ",INT_LE_MUL_EQ; +"INT_LE_NEG",INT_LE_NEG; +"INT_LE_NEG2",INT_LE_NEG2; +"INT_LE_NEGL",INT_LE_NEGL; +"INT_LE_NEGR",INT_LE_NEGR; +"INT_LE_NEGTOTAL",INT_LE_NEGTOTAL; +"INT_LE_POW2",INT_LE_POW2; +"INT_LE_RADD",INT_LE_RADD; +"INT_LE_REFL",INT_LE_REFL; +"INT_LE_RMUL",INT_LE_RMUL; +"INT_LE_RNEG",INT_LE_RNEG; +"INT_LE_SQUARE",INT_LE_SQUARE; +"INT_LE_SQUARE_ABS",INT_LE_SQUARE_ABS; +"INT_LE_SUB_LADD",INT_LE_SUB_LADD; +"INT_LE_SUB_RADD",INT_LE_SUB_RADD; +"INT_LE_TOTAL",INT_LE_TOTAL; +"INT_LE_TRANS",INT_LE_TRANS; +"INT_LNEG_UNIQ",INT_LNEG_UNIQ; +"INT_LT",INT_LT; +"INT_LTE_ADD",INT_LTE_ADD; +"INT_LTE_ADD2",INT_LTE_ADD2; +"INT_LTE_ANTISYM",INT_LTE_ANTISYM; +"INT_LTE_TOTAL",INT_LTE_TOTAL; +"INT_LTE_TRANS",INT_LTE_TRANS; +"INT_LT_01",INT_LT_01; +"INT_LT_ADD",INT_LT_ADD; +"INT_LT_ADD1",INT_LT_ADD1; +"INT_LT_ADD2",INT_LT_ADD2; +"INT_LT_ADDL",INT_LT_ADDL; +"INT_LT_ADDNEG",INT_LT_ADDNEG; +"INT_LT_ADDNEG2",INT_LT_ADDNEG2; +"INT_LT_ADDR",INT_LT_ADDR; +"INT_LT_ADD_SUB",INT_LT_ADD_SUB; +"INT_LT_ANTISYM",INT_LT_ANTISYM; +"INT_LT_DISCRETE",INT_LT_DISCRETE; +"INT_LT_GT",INT_LT_GT; +"INT_LT_IMP_LE",INT_LT_IMP_LE; +"INT_LT_IMP_NE",INT_LT_IMP_NE; +"INT_LT_LADD",INT_LT_LADD; +"INT_LT_LE",INT_LT_LE; +"INT_LT_LMUL_EQ",INT_LT_LMUL_EQ; +"INT_LT_MAX",INT_LT_MAX; +"INT_LT_MIN",INT_LT_MIN; +"INT_LT_MUL",INT_LT_MUL; +"INT_LT_MUL_EQ",INT_LT_MUL_EQ; +"INT_LT_NEG",INT_LT_NEG; +"INT_LT_NEG2",INT_LT_NEG2; +"INT_LT_NEGTOTAL",INT_LT_NEGTOTAL; +"INT_LT_POW2",INT_LT_POW2; +"INT_LT_RADD",INT_LT_RADD; +"INT_LT_REFL",INT_LT_REFL; +"INT_LT_RMUL_EQ",INT_LT_RMUL_EQ; +"INT_LT_SQUARE_ABS",INT_LT_SQUARE_ABS; +"INT_LT_SUB_LADD",INT_LT_SUB_LADD; +"INT_LT_SUB_RADD",INT_LT_SUB_RADD; +"INT_LT_TOTAL",INT_LT_TOTAL; +"INT_LT_TRANS",INT_LT_TRANS; +"INT_MAX",INT_MAX; +"INT_MAX_ACI",INT_MAX_ACI; +"INT_MAX_ASSOC",INT_MAX_ASSOC; +"INT_MAX_LE",INT_MAX_LE; +"INT_MAX_LT",INT_MAX_LT; +"INT_MAX_MAX",INT_MAX_MAX; +"INT_MAX_MIN",INT_MAX_MIN; +"INT_MAX_SYM",INT_MAX_SYM; +"INT_MIN",INT_MIN; +"INT_MIN_ACI",INT_MIN_ACI; +"INT_MIN_ASSOC",INT_MIN_ASSOC; +"INT_MIN_LE",INT_MIN_LE; +"INT_MIN_LT",INT_MIN_LT; +"INT_MIN_MAX",INT_MIN_MAX; +"INT_MIN_MIN",INT_MIN_MIN; +"INT_MIN_SYM",INT_MIN_SYM; +"INT_MUL_AC",INT_MUL_AC; +"INT_MUL_ASSOC",INT_MUL_ASSOC; +"INT_MUL_LID",INT_MUL_LID; +"INT_MUL_LNEG",INT_MUL_LNEG; +"INT_MUL_LZERO",INT_MUL_LZERO; +"INT_MUL_POS_LE",INT_MUL_POS_LE; +"INT_MUL_POS_LT",INT_MUL_POS_LT; +"INT_MUL_RID",INT_MUL_RID; +"INT_MUL_RNEG",INT_MUL_RNEG; +"INT_MUL_RZERO",INT_MUL_RZERO; +"INT_MUL_SYM",INT_MUL_SYM; +"INT_NEGNEG",INT_NEGNEG; +"INT_NEG_0",INT_NEG_0; +"INT_NEG_ADD",INT_NEG_ADD; +"INT_NEG_EQ",INT_NEG_EQ; +"INT_NEG_EQ_0",INT_NEG_EQ_0; +"INT_NEG_GE0",INT_NEG_GE0; +"INT_NEG_GT0",INT_NEG_GT0; +"INT_NEG_LE0",INT_NEG_LE0; +"INT_NEG_LMUL",INT_NEG_LMUL; +"INT_NEG_LT0",INT_NEG_LT0; +"INT_NEG_MINUS1",INT_NEG_MINUS1; +"INT_NEG_MUL2",INT_NEG_MUL2; +"INT_NEG_NEG",INT_NEG_NEG; +"INT_NEG_RMUL",INT_NEG_RMUL; +"INT_NEG_SUB",INT_NEG_SUB; +"INT_NOT_EQ",INT_NOT_EQ; +"INT_NOT_LE",INT_NOT_LE; +"INT_NOT_LT",INT_NOT_LT; +"INT_OF_NUM_ADD",INT_OF_NUM_ADD; +"INT_OF_NUM_EQ",INT_OF_NUM_EQ; +"INT_OF_NUM_EXISTS",INT_OF_NUM_EXISTS; +"INT_OF_NUM_GE",INT_OF_NUM_GE; +"INT_OF_NUM_GT",INT_OF_NUM_GT; +"INT_OF_NUM_LE",INT_OF_NUM_LE; +"INT_OF_NUM_LT",INT_OF_NUM_LT; +"INT_OF_NUM_MAX",INT_OF_NUM_MAX; +"INT_OF_NUM_MIN",INT_OF_NUM_MIN; +"INT_OF_NUM_MUL",INT_OF_NUM_MUL; +"INT_OF_NUM_OF_INT",INT_OF_NUM_OF_INT; +"INT_OF_NUM_POW",INT_OF_NUM_POW; +"INT_OF_NUM_SUB",INT_OF_NUM_SUB; +"INT_OF_NUM_SUC",INT_OF_NUM_SUC; +"INT_OF_REAL_OF_INT",INT_OF_REAL_OF_INT; +"INT_POS",INT_POS; +"INT_POS_NZ",INT_POS_NZ; +"INT_POW",INT_POW; +"INT_POW2_ABS",INT_POW2_ABS; +"INT_POW_1",INT_POW_1; +"INT_POW_1_LE",INT_POW_1_LE; +"INT_POW_1_LT",INT_POW_1_LT; +"INT_POW_2",INT_POW_2; +"INT_POW_ADD",INT_POW_ADD; +"INT_POW_EQ",INT_POW_EQ; +"INT_POW_EQ_0",INT_POW_EQ_0; +"INT_POW_EQ_ABS",INT_POW_EQ_ABS; +"INT_POW_LE",INT_POW_LE; +"INT_POW_LE2",INT_POW_LE2; +"INT_POW_LE2_ODD",INT_POW_LE2_ODD; +"INT_POW_LE2_REV",INT_POW_LE2_REV; +"INT_POW_LE_1",INT_POW_LE_1; +"INT_POW_LT",INT_POW_LT; +"INT_POW_LT2",INT_POW_LT2; +"INT_POW_LT2_REV",INT_POW_LT2_REV; +"INT_POW_LT_1",INT_POW_LT_1; +"INT_POW_MONO",INT_POW_MONO; +"INT_POW_MONO_LT",INT_POW_MONO_LT; +"INT_POW_MUL",INT_POW_MUL; +"INT_POW_NEG",INT_POW_NEG; +"INT_POW_NZ",INT_POW_NZ; +"INT_POW_ONE",INT_POW_ONE; +"INT_POW_POW",INT_POW_POW; +"INT_POW_ZERO",INT_POW_ZERO; +"INT_RNEG_UNIQ",INT_RNEG_UNIQ; +"INT_SGN",INT_SGN; +"INT_SGN_0",INT_SGN_0; +"INT_SGN_ABS",INT_SGN_ABS; +"INT_SGN_CASES",INT_SGN_CASES; +"INT_SGN_EQ",INT_SGN_EQ; +"INT_SGN_INEQS",INT_SGN_INEQS; +"INT_SGN_INT_SGN",INT_SGN_INT_SGN; +"INT_SGN_MUL",INT_SGN_MUL; +"INT_SGN_NEG",INT_SGN_NEG; +"INT_SGN_POW",INT_SGN_POW; +"INT_SGN_POW_2",INT_SGN_POW_2; +"INT_SOS_EQ_0",INT_SOS_EQ_0; +"INT_SUB",INT_SUB; +"INT_SUB_0",INT_SUB_0; +"INT_SUB_ABS",INT_SUB_ABS; +"INT_SUB_ADD",INT_SUB_ADD; +"INT_SUB_ADD2",INT_SUB_ADD2; +"INT_SUB_LDISTRIB",INT_SUB_LDISTRIB; +"INT_SUB_LE",INT_SUB_LE; +"INT_SUB_LNEG",INT_SUB_LNEG; +"INT_SUB_LT",INT_SUB_LT; +"INT_SUB_LZERO",INT_SUB_LZERO; +"INT_SUB_NEG2",INT_SUB_NEG2; +"INT_SUB_RDISTRIB",INT_SUB_RDISTRIB; +"INT_SUB_REFL",INT_SUB_REFL; +"INT_SUB_RNEG",INT_SUB_RNEG; +"INT_SUB_RZERO",INT_SUB_RZERO; +"INT_SUB_SUB",INT_SUB_SUB; +"INT_SUB_SUB2",INT_SUB_SUB2; +"INT_SUB_TRIANGLE",INT_SUB_TRIANGLE; +"INT_WOP",INT_WOP; +"INVERSE_FUNCTION_C1",INVERSE_FUNCTION_C1; +"INVERSE_I",INVERSE_I; +"INVERSE_SWAP",INVERSE_SWAP; +"INVERSE_UNIQUE_o",INVERSE_UNIQUE_o; +"INVERTIBLE_COFACTOR",INVERTIBLE_COFACTOR; +"INVERTIBLE_DET_NZ",INVERTIBLE_DET_NZ; +"INVERTIBLE_FIXPOINT_PROPERTY",INVERTIBLE_FIXPOINT_PROPERTY; +"INVERTIBLE_IMP_SQUARE_MATRIX",INVERTIBLE_IMP_SQUARE_MATRIX; +"INVERTIBLE_LEFT_INVERSE",INVERTIBLE_LEFT_INVERSE; +"INVERTIBLE_MATRIX_MUL",INVERTIBLE_MATRIX_MUL; +"INVERTIBLE_NEG",INVERTIBLE_NEG; +"INVERTIBLE_RIGHT_INVERSE",INVERTIBLE_RIGHT_INVERSE; +"INVERTIBLE_TRANSP",INVERTIBLE_TRANSP; +"IN_AFFINE_ADD_MUL",IN_AFFINE_ADD_MUL; +"IN_AFFINE_ADD_MUL_DIFF",IN_AFFINE_ADD_MUL_DIFF; +"IN_AFFINE_HULL_LINEAR_IMAGE",IN_AFFINE_HULL_LINEAR_IMAGE; +"IN_AFFINE_MUL_DIFF_ADD",IN_AFFINE_MUL_DIFF_ADD; +"IN_AFFINE_SUB_MUL_DIFF",IN_AFFINE_SUB_MUL_DIFF; +"IN_BALL",IN_BALL; +"IN_BALL_0",IN_BALL_0; +"IN_CARD_ADD",IN_CARD_ADD; +"IN_CARD_MUL",IN_CARD_MUL; +"IN_CBALL",IN_CBALL; +"IN_CBALL_0",IN_CBALL_0; +"IN_CLOSURE_CONNECTED_COMPONENT",IN_CLOSURE_CONNECTED_COMPONENT; +"IN_CLOSURE_DELETE",IN_CLOSURE_DELETE; +"IN_COMPONENTS",IN_COMPONENTS; +"IN_COMPONENTS_CONNECTED",IN_COMPONENTS_CONNECTED; +"IN_COMPONENTS_MAXIMAL",IN_COMPONENTS_MAXIMAL; +"IN_COMPONENTS_NONEMPTY",IN_COMPONENTS_NONEMPTY; +"IN_COMPONENTS_SELF",IN_COMPONENTS_SELF; +"IN_COMPONENTS_SUBSET",IN_COMPONENTS_SUBSET; +"IN_COMPONENTS_UNIONS_COMPLEMENT",IN_COMPONENTS_UNIONS_COMPLEMENT; +"IN_CONVEX_HULL_EXCHANGE",IN_CONVEX_HULL_EXCHANGE; +"IN_CONVEX_HULL_EXCHANGE_UNIQUE",IN_CONVEX_HULL_EXCHANGE_UNIQUE; +"IN_CONVEX_HULL_LINEAR_IMAGE",IN_CONVEX_HULL_LINEAR_IMAGE; +"IN_CONVEX_SET",IN_CONVEX_SET; +"IN_CROSS",IN_CROSS; +"IN_DELETE",IN_DELETE; +"IN_DELETE_EQ",IN_DELETE_EQ; +"IN_DIFF",IN_DIFF; +"IN_DIMINDEX_SWAP",IN_DIMINDEX_SWAP; +"IN_DIRECTION",IN_DIRECTION; +"IN_DISJOINT",IN_DISJOINT; +"IN_ELIM_PAIR_THM",IN_ELIM_PAIR_THM; +"IN_ELIM_PASTECART_THM",IN_ELIM_PASTECART_THM; +"IN_ELIM_THM",IN_ELIM_THM; +"IN_EPIGRAPH",IN_EPIGRAPH; +"IN_FROM",IN_FROM; +"IN_FRONTIER_CONVEX_HULL",IN_FRONTIER_CONVEX_HULL; +"IN_IMAGE",IN_IMAGE; +"IN_IMAGE_LIFT_DROP",IN_IMAGE_LIFT_DROP; +"IN_INSERT",IN_INSERT; +"IN_INTER",IN_INTER; +"IN_INTERIOR",IN_INTERIOR; +"IN_INTERIOR_CBALL",IN_INTERIOR_CBALL; +"IN_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_INTERIOR_CLOSURE_CONVEX_SEGMENT; +"IN_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_INTERIOR_CLOSURE_CONVEX_SHRINK; +"IN_INTERIOR_CONVEX_SHRINK",IN_INTERIOR_CONVEX_SHRINK; +"IN_INTERIOR_LINEAR_IMAGE",IN_INTERIOR_LINEAR_IMAGE; +"IN_INTERS",IN_INTERS; +"IN_INTERVAL",IN_INTERVAL; +"IN_INTERVAL_1",IN_INTERVAL_1; +"IN_INTERVAL_INTERVAL_BIJ",IN_INTERVAL_INTERVAL_BIJ; +"IN_INTERVAL_REFLECT",IN_INTERVAL_REFLECT; +"IN_NUMSEG",IN_NUMSEG; +"IN_NUMSEG_0",IN_NUMSEG_0; +"IN_OPEN_SEGMENT",IN_OPEN_SEGMENT; +"IN_OPEN_SEGMENT_ALT",IN_OPEN_SEGMENT_ALT; +"IN_RELATIVE_INTERIOR",IN_RELATIVE_INTERIOR; +"IN_RELATIVE_INTERIOR_CBALL",IN_RELATIVE_INTERIOR_CBALL; +"IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT; +"IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SHRINK; +"IN_RELATIVE_INTERIOR_CONVEX_SHRINK",IN_RELATIVE_INTERIOR_CONVEX_SHRINK; +"IN_REST",IN_REST; +"IN_SEGMENT",IN_SEGMENT; +"IN_SEGMENT_COMPONENT",IN_SEGMENT_COMPONENT; +"IN_SET_OF_LIST",IN_SET_OF_LIST; +"IN_SING",IN_SING; +"IN_SPAN_DELETE",IN_SPAN_DELETE; +"IN_SPAN_IMAGE_BASIS",IN_SPAN_IMAGE_BASIS; +"IN_SPAN_INSERT",IN_SPAN_INSERT; +"IN_SPHERE",IN_SPHERE; +"IN_SPHERE_0",IN_SPHERE_0; +"IN_SUPPORT",IN_SUPPORT; +"IN_UNION",IN_UNION; +"IN_UNIONS",IN_UNIONS; +"IN_UNIV",IN_UNIV; +"IRRATIONAL_APPROXIMATION",IRRATIONAL_APPROXIMATION; +"ISO",ISO; +"ISOMETRIES_SUBSPACES",ISOMETRIES_SUBSPACES; +"ISOMETRY_IMP_AFFINITY",ISOMETRY_IMP_AFFINITY; +"ISOMETRY_IMP_EMBEDDING",ISOMETRY_IMP_EMBEDDING; +"ISOMETRY_IMP_HOMEOMORPHISM_COMPACT",ISOMETRY_IMP_HOMEOMORPHISM_COMPACT; +"ISOMETRY_IMP_OPEN_MAP",ISOMETRY_IMP_OPEN_MAP; +"ISOMETRY_LINEAR",ISOMETRY_LINEAR; +"ISOMETRY_ON_IMP_CONTINUOUS_ON",ISOMETRY_ON_IMP_CONTINUOUS_ON; +"ISOMETRY_SPHERE_EXTEND",ISOMETRY_SPHERE_EXTEND; +"ISOMETRY_SUBSET_SUBSPACE",ISOMETRY_SUBSET_SUBSPACE; +"ISOMETRY_SUBSPACES",ISOMETRY_SUBSPACES; +"ISOMETRY_UNIV_SUBSPACE",ISOMETRY_UNIV_SUBSPACE; +"ISOMETRY_UNIV_SUPERSET_SUBSPACE",ISOMETRY_UNIV_SUPERSET_SUBSPACE; +"ISOMETRY_UNIV_UNIV",ISOMETRY_UNIV_UNIV; +"ISOMORPHISMS_UNIV_UNIV",ISOMORPHISMS_UNIV_UNIV; +"ISOMORPHISM_EXPAND",ISOMORPHISM_EXPAND; +"ISO_FUN",ISO_FUN; +"ISO_REFL",ISO_REFL; +"ISO_USAGE",ISO_USAGE; +"ISTOPLOGY_SUBTOPOLOGY",ISTOPLOGY_SUBTOPOLOGY; +"ISTOPOLOGY_OPEN_IN",ISTOPOLOGY_OPEN_IN; +"IS_AFFINE_HULL",IS_AFFINE_HULL; +"IS_CONVEX_HULL",IS_CONVEX_HULL; +"IS_HULL",IS_HULL; +"IS_INTERVAL_1",IS_INTERVAL_1; +"IS_INTERVAL_1_CASES",IS_INTERVAL_1_CASES; +"IS_INTERVAL_COMPACT",IS_INTERVAL_COMPACT; +"IS_INTERVAL_CONNECTED",IS_INTERVAL_CONNECTED; +"IS_INTERVAL_CONNECTED_1",IS_INTERVAL_CONNECTED_1; +"IS_INTERVAL_CONTRACTIBLE_1",IS_INTERVAL_CONTRACTIBLE_1; +"IS_INTERVAL_CONVEX",IS_INTERVAL_CONVEX; +"IS_INTERVAL_CONVEX_1",IS_INTERVAL_CONVEX_1; +"IS_INTERVAL_EMPTY",IS_INTERVAL_EMPTY; +"IS_INTERVAL_IMP_LOCALLY_COMPACT",IS_INTERVAL_IMP_LOCALLY_COMPACT; +"IS_INTERVAL_INTER",IS_INTERVAL_INTER; +"IS_INTERVAL_INTERVAL",IS_INTERVAL_INTERVAL; +"IS_INTERVAL_PATH_CONNECTED",IS_INTERVAL_PATH_CONNECTED; +"IS_INTERVAL_PATH_CONNECTED_1",IS_INTERVAL_PATH_CONNECTED_1; +"IS_INTERVAL_PCROSS",IS_INTERVAL_PCROSS; +"IS_INTERVAL_PCROSS_EQ",IS_INTERVAL_PCROSS_EQ; +"IS_INTERVAL_POINTWISE",IS_INTERVAL_POINTWISE; +"IS_INTERVAL_SCALING",IS_INTERVAL_SCALING; +"IS_INTERVAL_SCALING_EQ",IS_INTERVAL_SCALING_EQ; +"IS_INTERVAL_SIMPLY_CONNECTED_1",IS_INTERVAL_SIMPLY_CONNECTED_1; +"IS_INTERVAL_SING",IS_INTERVAL_SING; +"IS_INTERVAL_SUMS",IS_INTERVAL_SUMS; +"IS_INTERVAL_TRANSLATION",IS_INTERVAL_TRANSLATION; +"IS_INTERVAL_TRANSLATION_EQ",IS_INTERVAL_TRANSLATION_EQ; +"IS_INTERVAL_UNIV",IS_INTERVAL_UNIV; +"ITERATE_AND",ITERATE_AND; +"ITERATE_BIJECTION",ITERATE_BIJECTION; +"ITERATE_CASES",ITERATE_CASES; +"ITERATE_CLAUSES",ITERATE_CLAUSES; +"ITERATE_CLAUSES_GEN",ITERATE_CLAUSES_GEN; +"ITERATE_CLAUSES_NUMSEG",ITERATE_CLAUSES_NUMSEG; +"ITERATE_CLOSED",ITERATE_CLOSED; +"ITERATE_DELETE",ITERATE_DELETE; +"ITERATE_DELTA",ITERATE_DELTA; +"ITERATE_DIFF",ITERATE_DIFF; +"ITERATE_DIFF_GEN",ITERATE_DIFF_GEN; +"ITERATE_EQ",ITERATE_EQ; +"ITERATE_EQ_GENERAL",ITERATE_EQ_GENERAL; +"ITERATE_EQ_GENERAL_INVERSES",ITERATE_EQ_GENERAL_INVERSES; +"ITERATE_EQ_NEUTRAL",ITERATE_EQ_NEUTRAL; +"ITERATE_EXPAND_CASES",ITERATE_EXPAND_CASES; +"ITERATE_IMAGE",ITERATE_IMAGE; +"ITERATE_IMAGE_NONZERO",ITERATE_IMAGE_NONZERO; +"ITERATE_INCL_EXCL",ITERATE_INCL_EXCL; +"ITERATE_INJECTION",ITERATE_INJECTION; +"ITERATE_ITERATE_PRODUCT",ITERATE_ITERATE_PRODUCT; +"ITERATE_NONZERO_IMAGE_LEMMA",ITERATE_NONZERO_IMAGE_LEMMA; +"ITERATE_OP",ITERATE_OP; +"ITERATE_OP_GEN",ITERATE_OP_GEN; +"ITERATE_PAIR",ITERATE_PAIR; +"ITERATE_PERMUTE",ITERATE_PERMUTE; +"ITERATE_RELATED",ITERATE_RELATED; +"ITERATE_SING",ITERATE_SING; +"ITERATE_SOME",ITERATE_SOME; +"ITERATE_SUPERSET",ITERATE_SUPERSET; +"ITERATE_SUPPORT",ITERATE_SUPPORT; +"ITERATE_UNION",ITERATE_UNION; +"ITERATE_UNION_GEN",ITERATE_UNION_GEN; +"ITERATE_UNION_NONZERO",ITERATE_UNION_NONZERO; +"ITLIST",ITLIST; +"ITLIST2",ITLIST2; +"ITLIST2_DEF",ITLIST2_DEF; +"ITLIST_APPEND",ITLIST_APPEND; +"ITLIST_EXTRA",ITLIST_EXTRA; +"ITSET",ITSET; +"ITSET_EQ",ITSET_EQ; +"IVT_DECREASING_COMPONENT_1",IVT_DECREASING_COMPONENT_1; +"IVT_DECREASING_COMPONENT_ON_1",IVT_DECREASING_COMPONENT_ON_1; +"IVT_INCREASING_COMPONENT_1",IVT_INCREASING_COMPONENT_1; +"IVT_INCREASING_COMPONENT_ON_1",IVT_INCREASING_COMPONENT_ON_1; +"I_DEF",I_DEF; +"I_O_ID",I_O_ID; +"I_THM",I_THM; +"JACOBIAN_WORKS",JACOBIAN_WORKS; +"JOINABLE_COMPONENTS_EQ",JOINABLE_COMPONENTS_EQ; +"JOINABLE_CONNECTED_COMPONENT_EQ",JOINABLE_CONNECTED_COMPONENT_EQ; +"JOINPATHS",JOINPATHS; +"JOINPATHS_LINEAR_IMAGE",JOINPATHS_LINEAR_IMAGE; +"JOINPATHS_TRANSLATION",JOINPATHS_TRANSLATION; +"JOIN_PATHS_EQ",JOIN_PATHS_EQ; +"JOIN_SUBPATHS_MIDDLE",JOIN_SUBPATHS_MIDDLE; +"JUNG",JUNG; +"KIRCHBERGER",KIRCHBERGER; +"KL",KL; +"KLE_ADJACENT",KLE_ADJACENT; +"KLE_ANTISYM",KLE_ANTISYM; +"KLE_BETWEEN_L",KLE_BETWEEN_L; +"KLE_BETWEEN_R",KLE_BETWEEN_R; +"KLE_IMP_POINTWISE",KLE_IMP_POINTWISE; +"KLE_MAXIMAL",KLE_MAXIMAL; +"KLE_MINIMAL",KLE_MINIMAL; +"KLE_RANGE_COMBINE",KLE_RANGE_COMBINE; +"KLE_RANGE_COMBINE_L",KLE_RANGE_COMBINE_L; +"KLE_RANGE_COMBINE_R",KLE_RANGE_COMBINE_R; +"KLE_RANGE_INDUCT",KLE_RANGE_INDUCT; +"KLE_REFL",KLE_REFL; +"KLE_STRICT",KLE_STRICT; +"KLE_STRICT_SET",KLE_STRICT_SET; +"KLE_SUC",KLE_SUC; +"KLE_TRANS",KLE_TRANS; +"KLE_TRANS_1",KLE_TRANS_1; +"KLE_TRANS_2",KLE_TRANS_2; +"KL_POSET_LEMMA",KL_POSET_LEMMA; +"KREIN_MILMAN",KREIN_MILMAN; +"KREIN_MILMAN_FRONTIER",KREIN_MILMAN_FRONTIER; +"KREIN_MILMAN_MINKOWSKI",KREIN_MILMAN_MINKOWSKI; +"KREIN_MILMAN_POLYTOPE",KREIN_MILMAN_POLYTOPE; +"KREIN_MILMAN_RELATIVE_FRONTIER",KREIN_MILMAN_RELATIVE_FRONTIER; +"KSIMPLEX_0",KSIMPLEX_0; +"KSIMPLEX_EXTREMA",KSIMPLEX_EXTREMA; +"KSIMPLEX_EXTREMA_STRONG",KSIMPLEX_EXTREMA_STRONG; +"KSIMPLEX_FIX_PLANE",KSIMPLEX_FIX_PLANE; +"KSIMPLEX_FIX_PLANE_0",KSIMPLEX_FIX_PLANE_0; +"KSIMPLEX_FIX_PLANE_P",KSIMPLEX_FIX_PLANE_P; +"KSIMPLEX_PREDECESSOR",KSIMPLEX_PREDECESSOR; +"KSIMPLEX_REPLACE_0",KSIMPLEX_REPLACE_0; +"KSIMPLEX_REPLACE_1",KSIMPLEX_REPLACE_1; +"KSIMPLEX_REPLACE_2",KSIMPLEX_REPLACE_2; +"KSIMPLEX_SUCCESSOR",KSIMPLEX_SUCCESSOR; +"KUHN_COMBINATORIAL",KUHN_COMBINATORIAL; +"KUHN_COMPLETE_LEMMA",KUHN_COMPLETE_LEMMA; +"KUHN_COUNTING_LEMMA",KUHN_COUNTING_LEMMA; +"KUHN_INDUCTION",KUHN_INDUCTION; +"KUHN_LABELLING_LEMMA",KUHN_LABELLING_LEMMA; +"KUHN_LEMMA",KUHN_LEMMA; +"KUHN_SIMPLEX_LEMMA",KUHN_SIMPLEX_LEMMA; +"L1_LE_NORM",L1_LE_NORM; +"LAMBDA_ADD_GALOIS",LAMBDA_ADD_GALOIS; +"LAMBDA_BETA",LAMBDA_BETA; +"LAMBDA_BETA_PERM",LAMBDA_BETA_PERM; +"LAMBDA_ETA",LAMBDA_ETA; +"LAMBDA_PAIR",LAMBDA_PAIR; +"LAMBDA_PAIR_THM",LAMBDA_PAIR_THM; +"LAMBDA_SKOLEM",LAMBDA_SKOLEM; +"LAMBDA_SWAP_GALOIS",LAMBDA_SWAP_GALOIS; +"LAMBDA_UNIQUE",LAMBDA_UNIQUE; +"LAST",LAST; +"LAST_APPEND",LAST_APPEND; +"LAST_CLAUSES",LAST_CLAUSES; +"LAST_EL",LAST_EL; +"LE",LE; +"LEBESGUE_COVERING_LEMMA",LEBESGUE_COVERING_LEMMA; +"LEBESGUE_MEASURABLE_ALMOST_FSIGMA",LEBESGUE_MEASURABLE_ALMOST_FSIGMA; +"LEBESGUE_MEASURABLE_CLOSED",LEBESGUE_MEASURABLE_CLOSED; +"LEBESGUE_MEASURABLE_COMPACT",LEBESGUE_MEASURABLE_COMPACT; +"LEBESGUE_MEASURABLE_COMPL",LEBESGUE_MEASURABLE_COMPL; +"LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE",LEBESGUE_MEASURABLE_CONTINUOUS_IMAGE; +"LEBESGUE_MEASURABLE_CONVEX",LEBESGUE_MEASURABLE_CONVEX; +"LEBESGUE_MEASURABLE_COUNTABLE_INTERS",LEBESGUE_MEASURABLE_COUNTABLE_INTERS; +"LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT; +"LEBESGUE_MEASURABLE_COUNTABLE_UNIONS",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS; +"LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT",LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT; +"LEBESGUE_MEASURABLE_DIFF",LEBESGUE_MEASURABLE_DIFF; +"LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE",LEBESGUE_MEASURABLE_DIFFERENTIABLE_IMAGE; +"LEBESGUE_MEASURABLE_EMPTY",LEBESGUE_MEASURABLE_EMPTY; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LE_EQ; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT; +"LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORDINATE_SET_LT_EQ; +"LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LE_EQ; +"LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ",LEBESGUE_MEASURABLE_FUNCTION_ORTHANT_SET_LT_EQ; +"LEBESGUE_MEASURABLE_IFF_MEASURABLE",LEBESGUE_MEASURABLE_IFF_MEASURABLE; +"LEBESGUE_MEASURABLE_INNER_CLOSED",LEBESGUE_MEASURABLE_INNER_CLOSED; +"LEBESGUE_MEASURABLE_INTER",LEBESGUE_MEASURABLE_INTER; +"LEBESGUE_MEASURABLE_INTERS",LEBESGUE_MEASURABLE_INTERS; +"LEBESGUE_MEASURABLE_INTERVAL",LEBESGUE_MEASURABLE_INTERVAL; +"LEBESGUE_MEASURABLE_JORDAN",LEBESGUE_MEASURABLE_JORDAN; +"LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ; +"LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_EQ_GEN; +"LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN",LEBESGUE_MEASURABLE_LINEAR_IMAGE_GEN; +"LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_COUNTABLE_SUBINTERVALS; +"LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_MEASURABLE_ON_SUBINTERVALS; +"LEBESGUE_MEASURABLE_ON_SUBINTERVALS",LEBESGUE_MEASURABLE_ON_SUBINTERVALS; +"LEBESGUE_MEASURABLE_OPEN",LEBESGUE_MEASURABLE_OPEN; +"LEBESGUE_MEASURABLE_OUTER_OPEN",LEBESGUE_MEASURABLE_OUTER_OPEN; +"LEBESGUE_MEASURABLE_PCROSS",LEBESGUE_MEASURABLE_PCROSS; +"LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"LEBESGUE_MEASURABLE_PREIMAGE_OPEN",LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"LEBESGUE_MEASURABLE_REGULAR_INNER",LEBESGUE_MEASURABLE_REGULAR_INNER; +"LEBESGUE_MEASURABLE_REGULAR_OUTER",LEBESGUE_MEASURABLE_REGULAR_OUTER; +"LEBESGUE_MEASURABLE_TRANSLATION",LEBESGUE_MEASURABLE_TRANSLATION; +"LEBESGUE_MEASURABLE_UNION",LEBESGUE_MEASURABLE_UNION; +"LEBESGUE_MEASURABLE_UNIONS",LEBESGUE_MEASURABLE_UNIONS; +"LEBESGUE_MEASURABLE_UNIV",LEBESGUE_MEASURABLE_UNIV; +"LEFT_ADD_DISTRIB",LEFT_ADD_DISTRIB; +"LEFT_AND_EXISTS_THM",LEFT_AND_EXISTS_THM; +"LEFT_AND_FORALL_THM",LEFT_AND_FORALL_THM; +"LEFT_EXISTS_AND_THM",LEFT_EXISTS_AND_THM; +"LEFT_EXISTS_IMP_THM",LEFT_EXISTS_IMP_THM; +"LEFT_FORALL_IMP_THM",LEFT_FORALL_IMP_THM; +"LEFT_FORALL_OR_THM",LEFT_FORALL_OR_THM; +"LEFT_IMP_EXISTS_THM",LEFT_IMP_EXISTS_THM; +"LEFT_IMP_FORALL_THM",LEFT_IMP_FORALL_THM; +"LEFT_INVERSE_LINEAR",LEFT_INVERSE_LINEAR; +"LEFT_INVERTIBLE_TRANSP",LEFT_INVERTIBLE_TRANSP; +"LEFT_OR_DISTRIB",LEFT_OR_DISTRIB; +"LEFT_OR_EXISTS_THM",LEFT_OR_EXISTS_THM; +"LEFT_OR_FORALL_THM",LEFT_OR_FORALL_THM; +"LEFT_RIGHT_INVERSE_EQ",LEFT_RIGHT_INVERSE_EQ; +"LEFT_RIGHT_INVERSE_LINEAR",LEFT_RIGHT_INVERSE_LINEAR; +"LEFT_SUB_DISTRIB",LEFT_SUB_DISTRIB; +"LEMMA",LEMMA; +"LENGTH",LENGTH; +"LENGTH_APPEND",LENGTH_APPEND; +"LENGTH_EQ_CONS",LENGTH_EQ_CONS; +"LENGTH_EQ_NIL",LENGTH_EQ_NIL; +"LENGTH_LIST_OF_SET",LENGTH_LIST_OF_SET; +"LENGTH_MAP",LENGTH_MAP; +"LENGTH_MAP2",LENGTH_MAP2; +"LENGTH_REPLICATE",LENGTH_REPLICATE; +"LENGTH_TL",LENGTH_TL; +"LET_ADD2",LET_ADD2; +"LET_ANTISYM",LET_ANTISYM; +"LET_CASES",LET_CASES; +"LET_DEF",LET_DEF; +"LET_END_DEF",LET_END_DEF; +"LET_TRANS",LET_TRANS; +"LE_0",LE_0; +"LE_1",LE_1; +"LE_ADD",LE_ADD; +"LE_ADD2",LE_ADD2; +"LE_ADDR",LE_ADDR; +"LE_ADD_LCANCEL",LE_ADD_LCANCEL; +"LE_ADD_RCANCEL",LE_ADD_RCANCEL; +"LE_ANTISYM",LE_ANTISYM; +"LE_C",LE_C; +"LE_CASES",LE_CASES; +"LE_EXISTS",LE_EXISTS; +"LE_EXP",LE_EXP; +"LE_LDIV",LE_LDIV; +"LE_LDIV_EQ",LE_LDIV_EQ; +"LE_LT",LE_LT; +"LE_MULT2",LE_MULT2; +"LE_MULT_LCANCEL",LE_MULT_LCANCEL; +"LE_MULT_RCANCEL",LE_MULT_RCANCEL; +"LE_RDIV_EQ",LE_RDIV_EQ; +"LE_REFL",LE_REFL; +"LE_SQUARE_REFL",LE_SQUARE_REFL; +"LE_SUC",LE_SUC; +"LE_SUC_LT",LE_SUC_LT; +"LE_TRANS",LE_TRANS; +"LIEB",LIEB; +"LIFT_ADD",LIFT_ADD; +"LIFT_CMUL",LIFT_CMUL; +"LIFT_COMPONENT",LIFT_COMPONENT; +"LIFT_DROP",LIFT_DROP; +"LIFT_EQ",LIFT_EQ; +"LIFT_EQ_CMUL",LIFT_EQ_CMUL; +"LIFT_INTEGRAL_COMPONENT",LIFT_INTEGRAL_COMPONENT; +"LIFT_IN_IMAGE_LIFT",LIFT_IN_IMAGE_LIFT; +"LIFT_NEG",LIFT_NEG; +"LIFT_NUM",LIFT_NUM; +"LIFT_SUB",LIFT_SUB; +"LIFT_SUM",LIFT_SUM; +"LIFT_TO_QUOTIENT_SPACE",LIFT_TO_QUOTIENT_SPACE; +"LIM",LIM; +"LIMIT_POINT_FINITE",LIMIT_POINT_FINITE; +"LIMIT_POINT_OF_SPHERE",LIMIT_POINT_OF_SPHERE; +"LIMIT_POINT_UNION",LIMIT_POINT_UNION; +"LIMPT_APPROACHABLE",LIMPT_APPROACHABLE; +"LIMPT_APPROACHABLE_LE",LIMPT_APPROACHABLE_LE; +"LIMPT_APPROACHABLE_LIFT",LIMPT_APPROACHABLE_LIFT; +"LIMPT_BALL",LIMPT_BALL; +"LIMPT_EMPTY",LIMPT_EMPTY; +"LIMPT_INFINITE_BALL",LIMPT_INFINITE_BALL; +"LIMPT_INFINITE_CBALL",LIMPT_INFINITE_CBALL; +"LIMPT_INFINITE_OPEN",LIMPT_INFINITE_OPEN; +"LIMPT_INJECTIVE_LINEAR_IMAGE_EQ",LIMPT_INJECTIVE_LINEAR_IMAGE_EQ; +"LIMPT_INSERT",LIMPT_INSERT; +"LIMPT_OF_CLOSURE",LIMPT_OF_CLOSURE; +"LIMPT_OF_CONDENSATION_POINTS",LIMPT_OF_CONDENSATION_POINTS; +"LIMPT_OF_CONVEX",LIMPT_OF_CONVEX; +"LIMPT_OF_LIMPTS",LIMPT_OF_LIMPTS; +"LIMPT_OF_OPEN",LIMPT_OF_OPEN; +"LIMPT_OF_OPEN_IN",LIMPT_OF_OPEN_IN; +"LIMPT_OF_SEQUENCE_SUBSEQUENCE",LIMPT_OF_SEQUENCE_SUBSEQUENCE; +"LIMPT_OF_UNIV",LIMPT_OF_UNIV; +"LIMPT_PCROSS",LIMPT_PCROSS; +"LIMPT_SEQUENTIAL",LIMPT_SEQUENTIAL; +"LIMPT_SEQUENTIAL_INJ",LIMPT_SEQUENTIAL_INJ; +"LIMPT_SING",LIMPT_SING; +"LIMPT_SUBSET",LIMPT_SUBSET; +"LIMPT_TRANSLATION_EQ",LIMPT_TRANSLATION_EQ; +"LIMPT_UNIV",LIMPT_UNIV; +"LIM_ABS",LIM_ABS; +"LIM_ADD",LIM_ADD; +"LIM_AT",LIM_AT; +"LIM_AT_ID",LIM_AT_ID; +"LIM_AT_INFINITY",LIM_AT_INFINITY; +"LIM_AT_INFINITY_POS",LIM_AT_INFINITY_POS; +"LIM_AT_LE",LIM_AT_LE; +"LIM_AT_NEGINFINITY",LIM_AT_NEGINFINITY; +"LIM_AT_POSINFINITY",LIM_AT_POSINFINITY; +"LIM_AT_WITHIN",LIM_AT_WITHIN; +"LIM_AT_ZERO",LIM_AT_ZERO; +"LIM_BILINEAR",LIM_BILINEAR; +"LIM_CASES_COFINITE_SEQUENTIALLY",LIM_CASES_COFINITE_SEQUENTIALLY; +"LIM_CASES_FINITE_SEQUENTIALLY",LIM_CASES_FINITE_SEQUENTIALLY; +"LIM_CASES_SEQUENTIALLY",LIM_CASES_SEQUENTIALLY; +"LIM_CMUL",LIM_CMUL; +"LIM_CMUL_EQ",LIM_CMUL_EQ; +"LIM_COMPONENT",LIM_COMPONENT; +"LIM_COMPONENTWISE_LIFT",LIM_COMPONENTWISE_LIFT; +"LIM_COMPONENT_EQ",LIM_COMPONENT_EQ; +"LIM_COMPONENT_LBOUND",LIM_COMPONENT_LBOUND; +"LIM_COMPONENT_LE",LIM_COMPONENT_LE; +"LIM_COMPONENT_UBOUND",LIM_COMPONENT_UBOUND; +"LIM_COMPOSE_AT",LIM_COMPOSE_AT; +"LIM_COMPOSE_WITHIN",LIM_COMPOSE_WITHIN; +"LIM_CONG_AT",LIM_CONG_AT; +"LIM_CONG_WITHIN",LIM_CONG_WITHIN; +"LIM_CONST",LIM_CONST; +"LIM_CONST_EQ",LIM_CONST_EQ; +"LIM_CONTINUOUS_FUNCTION",LIM_CONTINUOUS_FUNCTION; +"LIM_DROP_LBOUND",LIM_DROP_LBOUND; +"LIM_DROP_LE",LIM_DROP_LE; +"LIM_DROP_UBOUND",LIM_DROP_UBOUND; +"LIM_EVENTUALLY",LIM_EVENTUALLY; +"LIM_INFINITY_POSINFINITY_LIFT",LIM_INFINITY_POSINFINITY_LIFT; +"LIM_INV",LIM_INV; +"LIM_IN_CLOSED_SET",LIM_IN_CLOSED_SET; +"LIM_LIFT_DOT",LIM_LIFT_DOT; +"LIM_LINEAR",LIM_LINEAR; +"LIM_MAX",LIM_MAX; +"LIM_MIN",LIM_MIN; +"LIM_MUL",LIM_MUL; +"LIM_MUL_NORM_WITHIN",LIM_MUL_NORM_WITHIN; +"LIM_NEG",LIM_NEG; +"LIM_NEG_EQ",LIM_NEG_EQ; +"LIM_NORM",LIM_NORM; +"LIM_NORM_LBOUND",LIM_NORM_LBOUND; +"LIM_NORM_UBOUND",LIM_NORM_UBOUND; +"LIM_NULL",LIM_NULL; +"LIM_NULL_ADD",LIM_NULL_ADD; +"LIM_NULL_CMUL",LIM_NULL_CMUL; +"LIM_NULL_CMUL_BOUNDED",LIM_NULL_CMUL_BOUNDED; +"LIM_NULL_CMUL_EQ",LIM_NULL_CMUL_EQ; +"LIM_NULL_COMPARISON",LIM_NULL_COMPARISON; +"LIM_NULL_NORM",LIM_NULL_NORM; +"LIM_NULL_SUB",LIM_NULL_SUB; +"LIM_NULL_VMUL_BOUNDED",LIM_NULL_VMUL_BOUNDED; +"LIM_PASTECART",LIM_PASTECART; +"LIM_PASTECART_EQ",LIM_PASTECART_EQ; +"LIM_POSINFINITY_SEQUENTIALLY",LIM_POSINFINITY_SEQUENTIALLY; +"LIM_SEQUENTIALLY",LIM_SEQUENTIALLY; +"LIM_SUB",LIM_SUB; +"LIM_SUBSEQUENCE",LIM_SUBSEQUENCE; +"LIM_TRANSFORM",LIM_TRANSFORM; +"LIM_TRANSFORM_AT",LIM_TRANSFORM_AT; +"LIM_TRANSFORM_AWAY_AT",LIM_TRANSFORM_AWAY_AT; +"LIM_TRANSFORM_AWAY_WITHIN",LIM_TRANSFORM_AWAY_WITHIN; +"LIM_TRANSFORM_BOUND",LIM_TRANSFORM_BOUND; +"LIM_TRANSFORM_EQ",LIM_TRANSFORM_EQ; +"LIM_TRANSFORM_EVENTUALLY",LIM_TRANSFORM_EVENTUALLY; +"LIM_TRANSFORM_WITHIN",LIM_TRANSFORM_WITHIN; +"LIM_TRANSFORM_WITHIN_OPEN",LIM_TRANSFORM_WITHIN_OPEN; +"LIM_TRANSFORM_WITHIN_OPEN_IN",LIM_TRANSFORM_WITHIN_OPEN_IN; +"LIM_TRANSFORM_WITHIN_SET",LIM_TRANSFORM_WITHIN_SET; +"LIM_UNION",LIM_UNION; +"LIM_UNION_UNIV",LIM_UNION_UNIV; +"LIM_UNIQUE",LIM_UNIQUE; +"LIM_VMUL",LIM_VMUL; +"LIM_VSUM",LIM_VSUM; +"LIM_WITHIN",LIM_WITHIN; +"LIM_WITHIN_CLOSED_TRIVIAL",LIM_WITHIN_CLOSED_TRIVIAL; +"LIM_WITHIN_EMPTY",LIM_WITHIN_EMPTY; +"LIM_WITHIN_ID",LIM_WITHIN_ID; +"LIM_WITHIN_INTERIOR",LIM_WITHIN_INTERIOR; +"LIM_WITHIN_LE",LIM_WITHIN_LE; +"LIM_WITHIN_OPEN",LIM_WITHIN_OPEN; +"LIM_WITHIN_SUBSET",LIM_WITHIN_SUBSET; +"LIM_WITHIN_UNION",LIM_WITHIN_UNION; +"LINDELOF",LINDELOF; +"LINDELOF_OPEN_IN",LINDELOF_OPEN_IN; +"LINEAR_0",LINEAR_0; +"LINEAR_1",LINEAR_1; +"LINEAR_ADD",LINEAR_ADD; +"LINEAR_BIJECTIVE_DIMINDEX_EQ",LINEAR_BIJECTIVE_DIMINDEX_EQ; +"LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE",LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE; +"LINEAR_BOUNDED",LINEAR_BOUNDED; +"LINEAR_BOUNDED_POS",LINEAR_BOUNDED_POS; +"LINEAR_CMUL",LINEAR_CMUL; +"LINEAR_COMPONENTWISE",LINEAR_COMPONENTWISE; +"LINEAR_COMPONENTWISE_EXPANSION",LINEAR_COMPONENTWISE_EXPANSION; +"LINEAR_COMPOSE",LINEAR_COMPOSE; +"LINEAR_COMPOSE_ADD",LINEAR_COMPOSE_ADD; +"LINEAR_COMPOSE_CMUL",LINEAR_COMPOSE_CMUL; +"LINEAR_COMPOSE_NEG",LINEAR_COMPOSE_NEG; +"LINEAR_COMPOSE_SUB",LINEAR_COMPOSE_SUB; +"LINEAR_COMPOSE_VSUM",LINEAR_COMPOSE_VSUM; +"LINEAR_CONTINUOUS_AT",LINEAR_CONTINUOUS_AT; +"LINEAR_CONTINUOUS_COMPOSE",LINEAR_CONTINUOUS_COMPOSE; +"LINEAR_CONTINUOUS_ON",LINEAR_CONTINUOUS_ON; +"LINEAR_CONTINUOUS_ON_COMPOSE",LINEAR_CONTINUOUS_ON_COMPOSE; +"LINEAR_CONTINUOUS_WITHIN",LINEAR_CONTINUOUS_WITHIN; +"LINEAR_EQ",LINEAR_EQ; +"LINEAR_EQ_0",LINEAR_EQ_0; +"LINEAR_EQ_0_SPAN",LINEAR_EQ_0_SPAN; +"LINEAR_EQ_MATRIX",LINEAR_EQ_MATRIX; +"LINEAR_EQ_MBASIS",LINEAR_EQ_MBASIS; +"LINEAR_EQ_STDBASIS",LINEAR_EQ_STDBASIS; +"LINEAR_FRECHET_DERIVATIVE",LINEAR_FRECHET_DERIVATIVE; +"LINEAR_FROM_REALS",LINEAR_FROM_REALS; +"LINEAR_FSTCART",LINEAR_FSTCART; +"LINEAR_I",LINEAR_I; +"LINEAR_ID",LINEAR_ID; +"LINEAR_IMAGE_SUBSET_INTERIOR",LINEAR_IMAGE_SUBSET_INTERIOR; +"LINEAR_INDEPENDENT_EXTEND",LINEAR_INDEPENDENT_EXTEND; +"LINEAR_INDEPENDENT_EXTEND_LEMMA",LINEAR_INDEPENDENT_EXTEND_LEMMA; +"LINEAR_INDEP_IMAGE_LEMMA",LINEAR_INDEP_IMAGE_LEMMA; +"LINEAR_INJECTIVE_0",LINEAR_INJECTIVE_0; +"LINEAR_INJECTIVE_0_SUBSPACE",LINEAR_INJECTIVE_0_SUBSPACE; +"LINEAR_INJECTIVE_BOUNDED_BELOW_POS",LINEAR_INJECTIVE_BOUNDED_BELOW_POS; +"LINEAR_INJECTIVE_DIMINDEX_LE",LINEAR_INJECTIVE_DIMINDEX_LE; +"LINEAR_INJECTIVE_IFF_DIM",LINEAR_INJECTIVE_IFF_DIM; +"LINEAR_INJECTIVE_IMP_SURJECTIVE",LINEAR_INJECTIVE_IMP_SURJECTIVE; +"LINEAR_INJECTIVE_ISOMORPHISM",LINEAR_INJECTIVE_ISOMORPHISM; +"LINEAR_INJECTIVE_LEFT_INVERSE",LINEAR_INJECTIVE_LEFT_INVERSE; +"LINEAR_INTERIOR_IMAGE_SUBSET",LINEAR_INTERIOR_IMAGE_SUBSET; +"LINEAR_INVERSE_LEFT",LINEAR_INVERSE_LEFT; +"LINEAR_INVERTIBLE_BOUNDED_BELOW",LINEAR_INVERTIBLE_BOUNDED_BELOW; +"LINEAR_INVERTIBLE_BOUNDED_BELOW_POS",LINEAR_INVERTIBLE_BOUNDED_BELOW_POS; +"LINEAR_LIFT_COMPONENT",LINEAR_LIFT_COMPONENT; +"LINEAR_LIFT_DOT",LINEAR_LIFT_DOT; +"LINEAR_LIM_0",LINEAR_LIM_0; +"LINEAR_MATRIX_EXISTS",LINEAR_MATRIX_EXISTS; +"LINEAR_NEG",LINEAR_NEG; +"LINEAR_NEGATION",LINEAR_NEGATION; +"LINEAR_OPEN_MAPPING",LINEAR_OPEN_MAPPING; +"LINEAR_PASTECART",LINEAR_PASTECART; +"LINEAR_PROPERTY",LINEAR_PROPERTY; +"LINEAR_REFLECT_ALONG",LINEAR_REFLECT_ALONG; +"LINEAR_SCALING",LINEAR_SCALING; +"LINEAR_SINGULAR_IMAGE_HYPERPLANE",LINEAR_SINGULAR_IMAGE_HYPERPLANE; +"LINEAR_SINGULAR_INTO_HYPERPLANE",LINEAR_SINGULAR_INTO_HYPERPLANE; +"LINEAR_SNDCART",LINEAR_SNDCART; +"LINEAR_SUB",LINEAR_SUB; +"LINEAR_SUBSPACE_GRAPH",LINEAR_SUBSPACE_GRAPH; +"LINEAR_SURJECTIVE_DIMINDEX_LE",LINEAR_SURJECTIVE_DIMINDEX_LE; +"LINEAR_SURJECTIVE_IFF_DIM",LINEAR_SURJECTIVE_IFF_DIM; +"LINEAR_SURJECTIVE_IFF_INJECTIVE",LINEAR_SURJECTIVE_IFF_INJECTIVE; +"LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN",LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN; +"LINEAR_SURJECTIVE_IMP_INJECTIVE",LINEAR_SURJECTIVE_IMP_INJECTIVE; +"LINEAR_SURJECTIVE_ISOMORPHISM",LINEAR_SURJECTIVE_ISOMORPHISM; +"LINEAR_SURJECTIVE_RIGHT_INVERSE",LINEAR_SURJECTIVE_RIGHT_INVERSE; +"LINEAR_TO_REALS",LINEAR_TO_REALS; +"LINEAR_UNIFORMLY_CONTINUOUS_ON",LINEAR_UNIFORMLY_CONTINUOUS_ON; +"LINEAR_VMUL_COMPONENT",LINEAR_VMUL_COMPONENT; +"LINEAR_VMUL_DROP",LINEAR_VMUL_DROP; +"LINEAR_VSUM",LINEAR_VSUM; +"LINEAR_VSUM_MUL",LINEAR_VSUM_MUL; +"LINEAR_ZERO",LINEAR_ZERO; +"LINEPATH_LINEAR_IMAGE",LINEPATH_LINEAR_IMAGE; +"LINEPATH_REFL",LINEPATH_REFL; +"LINEPATH_TRANSLATION",LINEPATH_TRANSLATION; +"LINSEG_FL",LINSEG_FL; +"LINSEG_INSEG",LINSEG_INSEG; +"LINSEG_WOSET",LINSEG_WOSET; +"LIST_OF_SET_EMPTY",LIST_OF_SET_EMPTY; +"LIST_OF_SET_PROPERTIES",LIST_OF_SET_PROPERTIES; +"LIST_OF_SET_SING",LIST_OF_SET_SING; +"LOCALLY_CLOSED",LOCALLY_CLOSED; +"LOCALLY_COMPACT",LOCALLY_COMPACT; +"LOCALLY_COMPACT_ALT",LOCALLY_COMPACT_ALT; +"LOCALLY_COMPACT_CLOSED_IN",LOCALLY_COMPACT_CLOSED_IN; +"LOCALLY_COMPACT_CLOSED_INTER_OPEN",LOCALLY_COMPACT_CLOSED_INTER_OPEN; +"LOCALLY_COMPACT_CLOSED_IN_OPEN",LOCALLY_COMPACT_CLOSED_IN_OPEN; +"LOCALLY_COMPACT_CLOSED_UNION",LOCALLY_COMPACT_CLOSED_UNION; +"LOCALLY_COMPACT_COMPACT",LOCALLY_COMPACT_COMPACT; +"LOCALLY_COMPACT_COMPACT_ALT",LOCALLY_COMPACT_COMPACT_ALT; +"LOCALLY_COMPACT_COMPACT_SUBOPEN",LOCALLY_COMPACT_COMPACT_SUBOPEN; +"LOCALLY_COMPACT_DELETE",LOCALLY_COMPACT_DELETE; +"LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED",LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED; +"LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED",LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED; +"LOCALLY_COMPACT_INTER",LOCALLY_COMPACT_INTER; +"LOCALLY_COMPACT_INTER_CBALL",LOCALLY_COMPACT_INTER_CBALL; +"LOCALLY_COMPACT_INTER_CBALLS",LOCALLY_COMPACT_INTER_CBALLS; +"LOCALLY_COMPACT_LINEAR_IMAGE_EQ",LOCALLY_COMPACT_LINEAR_IMAGE_EQ; +"LOCALLY_COMPACT_OPEN_IN",LOCALLY_COMPACT_OPEN_IN; +"LOCALLY_COMPACT_OPEN_INTER_CLOSURE",LOCALLY_COMPACT_OPEN_INTER_CLOSURE; +"LOCALLY_COMPACT_OPEN_UNION",LOCALLY_COMPACT_OPEN_UNION; +"LOCALLY_COMPACT_PCROSS",LOCALLY_COMPACT_PCROSS; +"LOCALLY_COMPACT_PCROSS_EQ",LOCALLY_COMPACT_PCROSS_EQ; +"LOCALLY_COMPACT_PROPER_IMAGE",LOCALLY_COMPACT_PROPER_IMAGE; +"LOCALLY_COMPACT_PROPER_IMAGE_EQ",LOCALLY_COMPACT_PROPER_IMAGE_EQ; +"LOCALLY_COMPACT_TRANSLATION_EQ",LOCALLY_COMPACT_TRANSLATION_EQ; +"LOCALLY_COMPACT_UNIV",LOCALLY_COMPACT_UNIV; +"LOCALLY_CONNECTED",LOCALLY_CONNECTED; +"LOCALLY_CONNECTED_COMPONENTS",LOCALLY_CONNECTED_COMPONENTS; +"LOCALLY_CONNECTED_CONNECTED_COMPONENT",LOCALLY_CONNECTED_CONNECTED_COMPONENT; +"LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT; +"LOCALLY_CONNECTED_IM_KLEINEN",LOCALLY_CONNECTED_IM_KLEINEN; +"LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE; +"LOCALLY_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_CONNECTED_LINEAR_IMAGE_EQ; +"LOCALLY_CONNECTED_OPEN_COMPONENT",LOCALLY_CONNECTED_OPEN_COMPONENT; +"LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT",LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT; +"LOCALLY_CONNECTED_PATH_IMAGE",LOCALLY_CONNECTED_PATH_IMAGE; +"LOCALLY_CONNECTED_PCROSS",LOCALLY_CONNECTED_PCROSS; +"LOCALLY_CONNECTED_PCROSS_EQ",LOCALLY_CONNECTED_PCROSS_EQ; +"LOCALLY_CONNECTED_QUOTIENT_IMAGE",LOCALLY_CONNECTED_QUOTIENT_IMAGE; +"LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE; +"LOCALLY_CONNECTED_SPHERE",LOCALLY_CONNECTED_SPHERE; +"LOCALLY_CONNECTED_SPHERE_GEN",LOCALLY_CONNECTED_SPHERE_GEN; +"LOCALLY_CONNECTED_TRANSLATION_EQ",LOCALLY_CONNECTED_TRANSLATION_EQ; +"LOCALLY_CONNECTED_UNIV",LOCALLY_CONNECTED_UNIV; +"LOCALLY_CONVEX",LOCALLY_CONVEX; +"LOCALLY_DIFF_CLOSED",LOCALLY_DIFF_CLOSED; +"LOCALLY_EMPTY",LOCALLY_EMPTY; +"LOCALLY_INJECTIVE_LINEAR_IMAGE",LOCALLY_INJECTIVE_LINEAR_IMAGE; +"LOCALLY_INTER",LOCALLY_INTER; +"LOCALLY_MONO",LOCALLY_MONO; +"LOCALLY_OPEN_MAP_IMAGE",LOCALLY_OPEN_MAP_IMAGE; +"LOCALLY_OPEN_SUBSET",LOCALLY_OPEN_SUBSET; +"LOCALLY_PATH_CONNECTED",LOCALLY_PATH_CONNECTED; +"LOCALLY_PATH_CONNECTED_COMPONENTS",LOCALLY_PATH_CONNECTED_COMPONENTS; +"LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT",LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT; +"LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT",LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT; +"LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED",LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED; +"LOCALLY_PATH_CONNECTED_IM_KLEINEN",LOCALLY_PATH_CONNECTED_IM_KLEINEN; +"LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE; +"LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ",LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ; +"LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT; +"LOCALLY_PATH_CONNECTED_PATH_COMPONENT",LOCALLY_PATH_CONNECTED_PATH_COMPONENT; +"LOCALLY_PATH_CONNECTED_PATH_IMAGE",LOCALLY_PATH_CONNECTED_PATH_IMAGE; +"LOCALLY_PATH_CONNECTED_PCROSS",LOCALLY_PATH_CONNECTED_PCROSS; +"LOCALLY_PATH_CONNECTED_PCROSS_EQ",LOCALLY_PATH_CONNECTED_PCROSS_EQ; +"LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE",LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE; +"LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE",LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE; +"LOCALLY_PATH_CONNECTED_SPHERE",LOCALLY_PATH_CONNECTED_SPHERE; +"LOCALLY_PATH_CONNECTED_SPHERE_GEN",LOCALLY_PATH_CONNECTED_SPHERE_GEN; +"LOCALLY_PATH_CONNECTED_TRANSLATION_EQ",LOCALLY_PATH_CONNECTED_TRANSLATION_EQ; +"LOCALLY_PATH_CONNECTED_UNIV",LOCALLY_PATH_CONNECTED_UNIV; +"LOCALLY_PCROSS",LOCALLY_PCROSS; +"LOCALLY_SING",LOCALLY_SING; +"LOCALLY_TRANSLATION",LOCALLY_TRANSLATION; +"LOWDIM_EQ_HYPERPLANE",LOWDIM_EQ_HYPERPLANE; +"LOWDIM_EXPAND_BASIS",LOWDIM_EXPAND_BASIS; +"LOWDIM_EXPAND_DIMENSION",LOWDIM_EXPAND_DIMENSION; +"LOWDIM_SUBSET_HYPERPLANE",LOWDIM_SUBSET_HYPERPLANE; +"LOWER_BOUND_FINITE_SET",LOWER_BOUND_FINITE_SET; +"LOWER_BOUND_FINITE_SET_REAL",LOWER_BOUND_FINITE_SET_REAL; +"LOWER_HEMICONTINUOUS",LOWER_HEMICONTINUOUS; +"LT",LT; +"LTE_ADD2",LTE_ADD2; +"LTE_ANTISYM",LTE_ANTISYM; +"LTE_CASES",LTE_CASES; +"LTE_TRANS",LTE_TRANS; +"LT_0",LT_0; +"LT_ADD",LT_ADD; +"LT_ADD2",LT_ADD2; +"LT_ADDR",LT_ADDR; +"LT_ADD_LCANCEL",LT_ADD_LCANCEL; +"LT_ADD_RCANCEL",LT_ADD_RCANCEL; +"LT_ANTISYM",LT_ANTISYM; +"LT_CASES",LT_CASES; +"LT_EXISTS",LT_EXISTS; +"LT_EXP",LT_EXP; +"LT_IMP_LE",LT_IMP_LE; +"LT_LE",LT_LE; +"LT_LMULT",LT_LMULT; +"LT_MULT",LT_MULT; +"LT_MULT2",LT_MULT2; +"LT_MULT_LCANCEL",LT_MULT_LCANCEL; +"LT_MULT_RCANCEL",LT_MULT_RCANCEL; +"LT_NZ",LT_NZ; +"LT_POW2_REFL",LT_POW2_REFL; +"LT_REFL",LT_REFL; +"LT_SUC",LT_SUC; +"LT_SUC_LE",LT_SUC_LE; +"LT_TRANS",LT_TRANS; +"LUZIN",LUZIN; +"LUZIN_EQ",LUZIN_EQ; +"LUZIN_EQ_ALT",LUZIN_EQ_ALT; +"MAP",MAP; +"MAP2",MAP2; +"MAP2_DEF",MAP2_DEF; +"MAPPING_CONNECTED_ONTO_SEGMENT",MAPPING_CONNECTED_ONTO_SEGMENT; +"MAP_APPEND",MAP_APPEND; +"MAP_EQ",MAP_EQ; +"MAP_EQ_ALL2",MAP_EQ_ALL2; +"MAP_EQ_DEGEN",MAP_EQ_DEGEN; +"MAP_EQ_NIL",MAP_EQ_NIL; +"MAP_FST_ZIP",MAP_FST_ZIP; +"MAP_I",MAP_I; +"MAP_ID",MAP_ID; +"MAP_REVERSE",MAP_REVERSE; +"MAP_SND_ZIP",MAP_SND_ZIP; +"MAP_o",MAP_o; +"MATCH_SEQPATTERN",MATCH_SEQPATTERN; +"MATRIX_ADD_AC",MATRIX_ADD_AC; +"MATRIX_ADD_ASSOC",MATRIX_ADD_ASSOC; +"MATRIX_ADD_COMPONENT",MATRIX_ADD_COMPONENT; +"MATRIX_ADD_LDISTRIB",MATRIX_ADD_LDISTRIB; +"MATRIX_ADD_LID",MATRIX_ADD_LID; +"MATRIX_ADD_LNEG",MATRIX_ADD_LNEG; +"MATRIX_ADD_RDISTRIB",MATRIX_ADD_RDISTRIB; +"MATRIX_ADD_RID",MATRIX_ADD_RID; +"MATRIX_ADD_RNEG",MATRIX_ADD_RNEG; +"MATRIX_ADD_SYM",MATRIX_ADD_SYM; +"MATRIX_ADJOINT",MATRIX_ADJOINT; +"MATRIX_CMUL_ADD_LDISTRIB",MATRIX_CMUL_ADD_LDISTRIB; +"MATRIX_CMUL_ADD_RDISTRIB",MATRIX_CMUL_ADD_RDISTRIB; +"MATRIX_CMUL_ASSOC",MATRIX_CMUL_ASSOC; +"MATRIX_CMUL_COMPONENT",MATRIX_CMUL_COMPONENT; +"MATRIX_CMUL_EQ_0",MATRIX_CMUL_EQ_0; +"MATRIX_CMUL_LID",MATRIX_CMUL_LID; +"MATRIX_CMUL_LZERO",MATRIX_CMUL_LZERO; +"MATRIX_CMUL_RZERO",MATRIX_CMUL_RZERO; +"MATRIX_CMUL_SUB_LDISTRIB",MATRIX_CMUL_SUB_LDISTRIB; +"MATRIX_CMUL_SUB_RDISTRIB",MATRIX_CMUL_SUB_RDISTRIB; +"MATRIX_COMPONENT_LE_ONORM",MATRIX_COMPONENT_LE_ONORM; +"MATRIX_COMPOSE",MATRIX_COMPOSE; +"MATRIX_EQ",MATRIX_EQ; +"MATRIX_EQUAL_COLUMNS",MATRIX_EQUAL_COLUMNS; +"MATRIX_EQUAL_ROWS",MATRIX_EQUAL_ROWS; +"MATRIX_FULL_LINEAR_EQUATIONS",MATRIX_FULL_LINEAR_EQUATIONS; +"MATRIX_I",MATRIX_I; +"MATRIX_ID",MATRIX_ID; +"MATRIX_INV",MATRIX_INV; +"MATRIX_INVERTIBLE",MATRIX_INVERTIBLE; +"MATRIX_INV_COFACTOR",MATRIX_INV_COFACTOR; +"MATRIX_INV_I",MATRIX_INV_I; +"MATRIX_INV_MUL",MATRIX_INV_MUL; +"MATRIX_INV_UNIQUE",MATRIX_INV_UNIQUE; +"MATRIX_INV_UNIQUE_LEFT",MATRIX_INV_UNIQUE_LEFT; +"MATRIX_INV_UNIQUE_RIGHT",MATRIX_INV_UNIQUE_RIGHT; +"MATRIX_LEFT_INVERSE_COFACTOR",MATRIX_LEFT_INVERSE_COFACTOR; +"MATRIX_LEFT_INVERTIBLE",MATRIX_LEFT_INVERTIBLE; +"MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS",MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS; +"MATRIX_LEFT_INVERTIBLE_INJECTIVE",MATRIX_LEFT_INVERTIBLE_INJECTIVE; +"MATRIX_LEFT_INVERTIBLE_KER",MATRIX_LEFT_INVERTIBLE_KER; +"MATRIX_LEFT_INVERTIBLE_SPAN_ROWS",MATRIX_LEFT_INVERTIBLE_SPAN_ROWS; +"MATRIX_LEFT_RIGHT_INVERSE",MATRIX_LEFT_RIGHT_INVERSE; +"MATRIX_MUL_ASSOC",MATRIX_MUL_ASSOC; +"MATRIX_MUL_COMPONENT",MATRIX_MUL_COMPONENT; +"MATRIX_MUL_DOT",MATRIX_MUL_DOT; +"MATRIX_MUL_LEFT_COFACTOR",MATRIX_MUL_LEFT_COFACTOR; +"MATRIX_MUL_LID",MATRIX_MUL_LID; +"MATRIX_MUL_LINV",MATRIX_MUL_LINV; +"MATRIX_MUL_LMUL",MATRIX_MUL_LMUL; +"MATRIX_MUL_LNEG",MATRIX_MUL_LNEG; +"MATRIX_MUL_LTRANSP_DOT_COLUMN",MATRIX_MUL_LTRANSP_DOT_COLUMN; +"MATRIX_MUL_LZERO",MATRIX_MUL_LZERO; +"MATRIX_MUL_RID",MATRIX_MUL_RID; +"MATRIX_MUL_RIGHT_COFACTOR",MATRIX_MUL_RIGHT_COFACTOR; +"MATRIX_MUL_RINV",MATRIX_MUL_RINV; +"MATRIX_MUL_RMUL",MATRIX_MUL_RMUL; +"MATRIX_MUL_RNEG",MATRIX_MUL_RNEG; +"MATRIX_MUL_RTRANSP_DOT_ROW",MATRIX_MUL_RTRANSP_DOT_ROW; +"MATRIX_MUL_RZERO",MATRIX_MUL_RZERO; +"MATRIX_MUL_VSUM",MATRIX_MUL_VSUM; +"MATRIX_MUL_VSUM_ALT",MATRIX_MUL_VSUM_ALT; +"MATRIX_NEG_0",MATRIX_NEG_0; +"MATRIX_NEG_ADD",MATRIX_NEG_ADD; +"MATRIX_NEG_COMPONENT",MATRIX_NEG_COMPONENT; +"MATRIX_NEG_EQ_0",MATRIX_NEG_EQ_0; +"MATRIX_NEG_MINUS1",MATRIX_NEG_MINUS1; +"MATRIX_NEG_NEG",MATRIX_NEG_NEG; +"MATRIX_NEG_SUB",MATRIX_NEG_SUB; +"MATRIX_NONFULL_LINEAR_EQUATIONS",MATRIX_NONFULL_LINEAR_EQUATIONS; +"MATRIX_NONFULL_LINEAR_EQUATIONS_EQ",MATRIX_NONFULL_LINEAR_EQUATIONS_EQ; +"MATRIX_OF_MATRIX_VECTOR_MUL",MATRIX_OF_MATRIX_VECTOR_MUL; +"MATRIX_REFLECT_ALONG_BASIS",MATRIX_REFLECT_ALONG_BASIS; +"MATRIX_RIGHT_INVERSE_COFACTOR",MATRIX_RIGHT_INVERSE_COFACTOR; +"MATRIX_RIGHT_INVERTIBLE",MATRIX_RIGHT_INVERTIBLE; +"MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS",MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS; +"MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS",MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS; +"MATRIX_RIGHT_INVERTIBLE_SURJECTIVE",MATRIX_RIGHT_INVERTIBLE_SURJECTIVE; +"MATRIX_SELF_ADJOINT",MATRIX_SELF_ADJOINT; +"MATRIX_SUB",MATRIX_SUB; +"MATRIX_SUB_COMPONENT",MATRIX_SUB_COMPONENT; +"MATRIX_SUB_LDISTRIB",MATRIX_SUB_LDISTRIB; +"MATRIX_SUB_LZERO",MATRIX_SUB_LZERO; +"MATRIX_SUB_RDISTRIB",MATRIX_SUB_RDISTRIB; +"MATRIX_SUB_REFL",MATRIX_SUB_REFL; +"MATRIX_SUB_RZERO",MATRIX_SUB_RZERO; +"MATRIX_TRANSP_MUL",MATRIX_TRANSP_MUL; +"MATRIX_TRIVIAL_LINEAR_EQUATIONS",MATRIX_TRIVIAL_LINEAR_EQUATIONS; +"MATRIX_VECTOR_COLUMN",MATRIX_VECTOR_COLUMN; +"MATRIX_VECTOR_MUL",MATRIX_VECTOR_MUL; +"MATRIX_VECTOR_MUL_ADD_LDISTRIB",MATRIX_VECTOR_MUL_ADD_LDISTRIB; +"MATRIX_VECTOR_MUL_ADD_RDISTRIB",MATRIX_VECTOR_MUL_ADD_RDISTRIB; +"MATRIX_VECTOR_MUL_ASSOC",MATRIX_VECTOR_MUL_ASSOC; +"MATRIX_VECTOR_MUL_BASIS",MATRIX_VECTOR_MUL_BASIS; +"MATRIX_VECTOR_MUL_COMPONENT",MATRIX_VECTOR_MUL_COMPONENT; +"MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE",MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE; +"MATRIX_VECTOR_MUL_IN_COLUMNSPACE",MATRIX_VECTOR_MUL_IN_COLUMNSPACE; +"MATRIX_VECTOR_MUL_LID",MATRIX_VECTOR_MUL_LID; +"MATRIX_VECTOR_MUL_LINEAR",MATRIX_VECTOR_MUL_LINEAR; +"MATRIX_VECTOR_MUL_LZERO",MATRIX_VECTOR_MUL_LZERO; +"MATRIX_VECTOR_MUL_RMUL",MATRIX_VECTOR_MUL_RMUL; +"MATRIX_VECTOR_MUL_RZERO",MATRIX_VECTOR_MUL_RZERO; +"MATRIX_VECTOR_MUL_SUB_LDISTRIB",MATRIX_VECTOR_MUL_SUB_LDISTRIB; +"MATRIX_VECTOR_MUL_SUB_RDISTRIB",MATRIX_VECTOR_MUL_SUB_RDISTRIB; +"MATRIX_VECTOR_MUL_TRANSP",MATRIX_VECTOR_MUL_TRANSP; +"MATRIX_WLOG_INVERTIBLE",MATRIX_WLOG_INVERTIBLE; +"MATRIX_WORKS",MATRIX_WORKS; +"MAT_0_COMPONENT",MAT_0_COMPONENT; +"MAT_COMPONENT",MAT_COMPONENT; +"MAT_EQ",MAT_EQ; +"MAX",MAX; +"MAXIMAL_AFFINE_INDEPENDENT_SUBSET",MAXIMAL_AFFINE_INDEPENDENT_SUBSET; +"MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE",MAXIMAL_AFFINE_INDEPENDENT_SUBSET_AFFINE; +"MAXIMAL_INDEPENDENT_SUBSET",MAXIMAL_INDEPENDENT_SUBSET; +"MAXIMAL_INDEPENDENT_SUBSET_EXTEND",MAXIMAL_INDEPENDENT_SUBSET_EXTEND; +"MBASIS_COMPONENT",MBASIS_COMPONENT; +"MBASIS_EQ_0",MBASIS_EQ_0; +"MBASIS_EXPANSION",MBASIS_EXPANSION; +"MBASIS_EXTENSION",MBASIS_EXTENSION; +"MBASIS_NONZERO",MBASIS_NONZERO; +"MBASIS_SPLIT",MBASIS_SPLIT; +"MEASURABLE",MEASURABLE; +"MEASURABLE_ALMOST",MEASURABLE_ALMOST; +"MEASURABLE_BALL",MEASURABLE_BALL; +"MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE; +"MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE; +"MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE; +"MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE",MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE; +"MEASURABLE_CBALL",MEASURABLE_CBALL; +"MEASURABLE_CLOSURE",MEASURABLE_CLOSURE; +"MEASURABLE_COMPACT",MEASURABLE_COMPACT; +"MEASURABLE_CONVEX",MEASURABLE_CONVEX; +"MEASURABLE_CONVEX_HULL",MEASURABLE_CONVEX_HULL; +"MEASURABLE_COUNTABLE_INTERS",MEASURABLE_COUNTABLE_INTERS; +"MEASURABLE_COUNTABLE_INTERS_GEN",MEASURABLE_COUNTABLE_INTERS_GEN; +"MEASURABLE_COUNTABLE_UNIONS",MEASURABLE_COUNTABLE_UNIONS; +"MEASURABLE_COUNTABLE_UNIONS_BOUNDED",MEASURABLE_COUNTABLE_UNIONS_BOUNDED; +"MEASURABLE_COUNTABLE_UNIONS_STRONG",MEASURABLE_COUNTABLE_UNIONS_STRONG; +"MEASURABLE_DIFF",MEASURABLE_DIFF; +"MEASURABLE_ELEMENTARY",MEASURABLE_ELEMENTARY; +"MEASURABLE_EMPTY",MEASURABLE_EMPTY; +"MEASURABLE_FRONTIER",MEASURABLE_FRONTIER; +"MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE",MEASURABLE_IFF_LEBESGUE_MEASURABLE_UNDER_CURVE; +"MEASURABLE_IMP_LEBESGUE_MEASURABLE",MEASURABLE_IMP_LEBESGUE_MEASURABLE; +"MEASURABLE_INNER_COMPACT",MEASURABLE_INNER_COMPACT; +"MEASURABLE_INNER_OUTER",MEASURABLE_INNER_OUTER; +"MEASURABLE_INSERT",MEASURABLE_INSERT; +"MEASURABLE_INSIDE",MEASURABLE_INSIDE; +"MEASURABLE_INTEGRABLE",MEASURABLE_INTEGRABLE; +"MEASURABLE_INTER",MEASURABLE_INTER; +"MEASURABLE_INTERIOR",MEASURABLE_INTERIOR; +"MEASURABLE_INTERVAL",MEASURABLE_INTERVAL; +"MEASURABLE_INTER_HALFSPACE_GE",MEASURABLE_INTER_HALFSPACE_GE; +"MEASURABLE_INTER_HALFSPACE_LE",MEASURABLE_INTER_HALFSPACE_LE; +"MEASURABLE_INTER_INTERVAL",MEASURABLE_INTER_INTERVAL; +"MEASURABLE_JORDAN",MEASURABLE_JORDAN; +"MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE",MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE; +"MEASURABLE_LEGESGUE_MEASURABLE_SUBSET",MEASURABLE_LEGESGUE_MEASURABLE_SUBSET; +"MEASURABLE_LINEAR_IMAGE",MEASURABLE_LINEAR_IMAGE; +"MEASURABLE_LINEAR_IMAGE_EQ",MEASURABLE_LINEAR_IMAGE_EQ; +"MEASURABLE_LINEAR_IMAGE_EQ_GEN",MEASURABLE_LINEAR_IMAGE_EQ_GEN; +"MEASURABLE_LINEAR_IMAGE_GEN",MEASURABLE_LINEAR_IMAGE_GEN; +"MEASURABLE_LINEAR_IMAGE_INTERVAL",MEASURABLE_LINEAR_IMAGE_INTERVAL; +"MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE",MEASURABLE_MEASURABLE_DIFF_LEGESGUE_MEASURABLE; +"MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE",MEASURABLE_MEASURABLE_INTER_LEGESGUE_MEASURABLE; +"MEASURABLE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_MEASURABLE_PREIMAGE_CLOSED; +"MEASURABLE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_MEASURABLE_PREIMAGE_OPEN; +"MEASURABLE_MEASURE_EQ_0",MEASURABLE_MEASURE_EQ_0; +"MEASURABLE_MEASURE_POS_LT",MEASURABLE_MEASURE_POS_LT; +"MEASURABLE_NEGLIGIBLE_SYMDIFF",MEASURABLE_NEGLIGIBLE_SYMDIFF; +"MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ",MEASURABLE_NEGLIGIBLE_SYMDIFF_EQ; +"MEASURABLE_NESTED_UNIONS",MEASURABLE_NESTED_UNIONS; +"MEASURABLE_NONNEGLIGIBLE_IMP_LARGE",MEASURABLE_NONNEGLIGIBLE_IMP_LARGE; +"MEASURABLE_ON_0",MEASURABLE_ON_0; +"MEASURABLE_ON_ADD",MEASURABLE_ON_ADD; +"MEASURABLE_ON_BILINEAR",MEASURABLE_ON_BILINEAR; +"MEASURABLE_ON_CASES",MEASURABLE_ON_CASES; +"MEASURABLE_ON_CMUL",MEASURABLE_ON_CMUL; +"MEASURABLE_ON_COMBINE",MEASURABLE_ON_COMBINE; +"MEASURABLE_ON_COMPONENTWISE",MEASURABLE_ON_COMPONENTWISE; +"MEASURABLE_ON_COMPOSE_CONTINUOUS",MEASURABLE_ON_COMPOSE_CONTINUOUS; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_0; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0",MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0; +"MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL",MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL; +"MEASURABLE_ON_COMPOSE_FSTCART",MEASURABLE_ON_COMPOSE_FSTCART; +"MEASURABLE_ON_COMPOSE_SNDCART",MEASURABLE_ON_COMPOSE_SNDCART; +"MEASURABLE_ON_COMPOSE_SUB",MEASURABLE_ON_COMPOSE_SUB; +"MEASURABLE_ON_CONST",MEASURABLE_ON_CONST; +"MEASURABLE_ON_COUNTABLE_UNIONS",MEASURABLE_ON_COUNTABLE_UNIONS; +"MEASURABLE_ON_DIFF",MEASURABLE_ON_DIFF; +"MEASURABLE_ON_DROP_MUL",MEASURABLE_ON_DROP_MUL; +"MEASURABLE_ON_EMPTY",MEASURABLE_ON_EMPTY; +"MEASURABLE_ON_INTER",MEASURABLE_ON_INTER; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_EQ; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_EQ; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_LEBESGUE_MEASURABLE_PREIMAGE_OPEN_INTERVAL; +"MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET",MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; +"MEASURABLE_ON_LIFT_MUL",MEASURABLE_ON_LIFT_MUL; +"MEASURABLE_ON_LIMIT",MEASURABLE_ON_LIMIT; +"MEASURABLE_ON_LINEAR_IMAGE_EQ",MEASURABLE_ON_LINEAR_IMAGE_EQ; +"MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN",MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN; +"MEASURABLE_ON_MAX",MEASURABLE_ON_MAX; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_EQ; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_CLOSED_INTERVAL; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GE; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_GT; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LE; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_MEASURABLE_PREIMAGE_HALFSPACE_COMPONENT_LT; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_EQ; +"MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_MEASURABLE_PREIMAGE_OPEN_INTERVAL; +"MEASURABLE_ON_MEASURABLE_SUBSET",MEASURABLE_ON_MEASURABLE_SUBSET; +"MEASURABLE_ON_MIN",MEASURABLE_ON_MIN; +"MEASURABLE_ON_NEG",MEASURABLE_ON_NEG; +"MEASURABLE_ON_NEG_EQ",MEASURABLE_ON_NEG_EQ; +"MEASURABLE_ON_NORM",MEASURABLE_ON_NORM; +"MEASURABLE_ON_PASTECART",MEASURABLE_ON_PASTECART; +"MEASURABLE_ON_PREIMAGE_CLOSED",MEASURABLE_ON_PREIMAGE_CLOSED; +"MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; +"MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE_DENSE; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT; +"MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE",MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT_DENSE; +"MEASURABLE_ON_PREIMAGE_OPEN",MEASURABLE_ON_PREIMAGE_OPEN; +"MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; +"MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE",MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GE_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GT",MEASURABLE_ON_PREIMAGE_ORTHANT_GT; +"MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_GT_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LE_DENSE; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LT",MEASURABLE_ON_PREIMAGE_ORTHANT_LT; +"MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE",MEASURABLE_ON_PREIMAGE_ORTHANT_LT_DENSE; +"MEASURABLE_ON_RESTRICT",MEASURABLE_ON_RESTRICT; +"MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT; +"MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING",MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT_INCREASING; +"MEASURABLE_ON_SPIKE",MEASURABLE_ON_SPIKE; +"MEASURABLE_ON_SPIKE_SET",MEASURABLE_ON_SPIKE_SET; +"MEASURABLE_ON_SUB",MEASURABLE_ON_SUB; +"MEASURABLE_ON_TRANSLATION",MEASURABLE_ON_TRANSLATION; +"MEASURABLE_ON_TRANSLATION_EQ",MEASURABLE_ON_TRANSLATION_EQ; +"MEASURABLE_ON_UNION",MEASURABLE_ON_UNION; +"MEASURABLE_ON_UNIONS",MEASURABLE_ON_UNIONS; +"MEASURABLE_ON_UNIV",MEASURABLE_ON_UNIV; +"MEASURABLE_ON_VECTOR_DERIVATIVE",MEASURABLE_ON_VECTOR_DERIVATIVE; +"MEASURABLE_ON_VSUM",MEASURABLE_ON_VSUM; +"MEASURABLE_OPEN",MEASURABLE_OPEN; +"MEASURABLE_OUTER_CLOSED_INTERVALS",MEASURABLE_OUTER_CLOSED_INTERVALS; +"MEASURABLE_OUTER_INTERVALS_BOUNDED",MEASURABLE_OUTER_INTERVALS_BOUNDED; +"MEASURABLE_OUTER_OPEN",MEASURABLE_OUTER_OPEN; +"MEASURABLE_OUTER_OPEN_INTERVALS",MEASURABLE_OUTER_OPEN_INTERVALS; +"MEASURABLE_PCROSS",MEASURABLE_PCROSS; +"MEASURABLE_SCALING",MEASURABLE_SCALING; +"MEASURABLE_SCALING_EQ",MEASURABLE_SCALING_EQ; +"MEASURABLE_SIMPLEX",MEASURABLE_SIMPLEX; +"MEASURABLE_SMALL_IMP_NEGLIGIBLE",MEASURABLE_SMALL_IMP_NEGLIGIBLE; +"MEASURABLE_TETRAHEDRON",MEASURABLE_TETRAHEDRON; +"MEASURABLE_TRANSLATION",MEASURABLE_TRANSLATION; +"MEASURABLE_TRANSLATION_EQ",MEASURABLE_TRANSLATION_EQ; +"MEASURABLE_TRIANGLE",MEASURABLE_TRIANGLE; +"MEASURABLE_UNION",MEASURABLE_UNION; +"MEASURABLE_UNIONS",MEASURABLE_UNIONS; +"MEASURE",MEASURE; +"MEASURE_BALL_BOUND",MEASURE_BALL_BOUND; +"MEASURE_BALL_POS",MEASURE_BALL_POS; +"MEASURE_CBALL_BOUND",MEASURE_CBALL_BOUND; +"MEASURE_CBALL_POS",MEASURE_CBALL_POS; +"MEASURE_CLOSURE",MEASURE_CLOSURE; +"MEASURE_COUNTABLE_UNIONS_APPROACHABLE",MEASURE_COUNTABLE_UNIONS_APPROACHABLE; +"MEASURE_COUNTABLE_UNIONS_LE",MEASURE_COUNTABLE_UNIONS_LE; +"MEASURE_COUNTABLE_UNIONS_LE_GEN",MEASURE_COUNTABLE_UNIONS_LE_GEN; +"MEASURE_COUNTABLE_UNIONS_LE_STRONG",MEASURE_COUNTABLE_UNIONS_LE_STRONG; +"MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN",MEASURE_COUNTABLE_UNIONS_LE_STRONG_GEN; +"MEASURE_DIFF_SUBSET",MEASURE_DIFF_SUBSET; +"MEASURE_DISJOINT_UNION",MEASURE_DISJOINT_UNION; +"MEASURE_DISJOINT_UNIONS",MEASURE_DISJOINT_UNIONS; +"MEASURE_DISJOINT_UNIONS_IMAGE",MEASURE_DISJOINT_UNIONS_IMAGE; +"MEASURE_DISJOINT_UNIONS_IMAGE_STRONG",MEASURE_DISJOINT_UNIONS_IMAGE_STRONG; +"MEASURE_DISJOINT_UNION_EQ",MEASURE_DISJOINT_UNION_EQ; +"MEASURE_ELEMENTARY",MEASURE_ELEMENTARY; +"MEASURE_EMPTY",MEASURE_EMPTY; +"MEASURE_EQ_0",MEASURE_EQ_0; +"MEASURE_FRONTIER",MEASURE_FRONTIER; +"MEASURE_INSERT",MEASURE_INSERT; +"MEASURE_INTEGRAL",MEASURE_INTEGRAL; +"MEASURE_INTEGRAL_UNIV",MEASURE_INTEGRAL_UNIV; +"MEASURE_INTERIOR",MEASURE_INTERIOR; +"MEASURE_INTERVAL",MEASURE_INTERVAL; +"MEASURE_INTERVAL_1",MEASURE_INTERVAL_1; +"MEASURE_INTERVAL_1_ALT",MEASURE_INTERVAL_1_ALT; +"MEASURE_INTERVAL_2",MEASURE_INTERVAL_2; +"MEASURE_INTERVAL_2_ALT",MEASURE_INTERVAL_2_ALT; +"MEASURE_INTERVAL_3",MEASURE_INTERVAL_3; +"MEASURE_INTERVAL_3_ALT",MEASURE_INTERVAL_3_ALT; +"MEASURE_INTERVAL_4",MEASURE_INTERVAL_4; +"MEASURE_INTERVAL_4_ALT",MEASURE_INTERVAL_4_ALT; +"MEASURE_ISOMETRY",MEASURE_ISOMETRY; +"MEASURE_LE",MEASURE_LE; +"MEASURE_LIMIT",MEASURE_LIMIT; +"MEASURE_LINEAR_IMAGE",MEASURE_LINEAR_IMAGE; +"MEASURE_LINEAR_IMAGE_SAME",MEASURE_LINEAR_IMAGE_SAME; +"MEASURE_NEGLIGIBLE_SYMDIFF",MEASURE_NEGLIGIBLE_SYMDIFF; +"MEASURE_NEGLIGIBLE_UNION",MEASURE_NEGLIGIBLE_UNION; +"MEASURE_NEGLIGIBLE_UNIONS",MEASURE_NEGLIGIBLE_UNIONS; +"MEASURE_NEGLIGIBLE_UNIONS_IMAGE",MEASURE_NEGLIGIBLE_UNIONS_IMAGE; +"MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG",MEASURE_NEGLIGIBLE_UNIONS_IMAGE_STRONG; +"MEASURE_NEGLIGIBLE_UNION_EQ",MEASURE_NEGLIGIBLE_UNION_EQ; +"MEASURE_OPEN_POS_LT",MEASURE_OPEN_POS_LT; +"MEASURE_ORTHOGONAL_IMAGE_EQ",MEASURE_ORTHOGONAL_IMAGE_EQ; +"MEASURE_PCROSS",MEASURE_PCROSS; +"MEASURE_POS_LE",MEASURE_POS_LE; +"MEASURE_SCALING",MEASURE_SCALING; +"MEASURE_SIMPLEX",MEASURE_SIMPLEX; +"MEASURE_SUBSET",MEASURE_SUBSET; +"MEASURE_TETRAHEDRON",MEASURE_TETRAHEDRON; +"MEASURE_TRANSLATION",MEASURE_TRANSLATION; +"MEASURE_TRIANGLE",MEASURE_TRIANGLE; +"MEASURE_UNION",MEASURE_UNION; +"MEASURE_UNIONS_LE",MEASURE_UNIONS_LE; +"MEASURE_UNIONS_LE_IMAGE",MEASURE_UNIONS_LE_IMAGE; +"MEASURE_UNION_LE",MEASURE_UNION_LE; +"MEASURE_UNIQUE",MEASURE_UNIQUE; +"MEM",MEM; +"MEMBER_NOT_EMPTY",MEMBER_NOT_EMPTY; +"MEM_APPEND",MEM_APPEND; +"MEM_APPEND_DECOMPOSE",MEM_APPEND_DECOMPOSE; +"MEM_APPEND_DECOMPOSE_LEFT",MEM_APPEND_DECOMPOSE_LEFT; +"MEM_ASSOC",MEM_ASSOC; +"MEM_EL",MEM_EL; +"MEM_EXISTS_EL",MEM_EXISTS_EL; +"MEM_FILTER",MEM_FILTER; +"MEM_LINEAR_IMAGE",MEM_LINEAR_IMAGE; +"MEM_LIST_OF_SET",MEM_LIST_OF_SET; +"MEM_MAP",MEM_MAP; +"MEM_TRANSLATION",MEM_TRANSLATION; +"MIDPOINTS_IN_CONVEX_HULL",MIDPOINTS_IN_CONVEX_HULL; +"MIDPOINT_BETWEEN",MIDPOINT_BETWEEN; +"MIDPOINT_COLLINEAR",MIDPOINT_COLLINEAR; +"MIDPOINT_CONVEX_DYADIC_RATIONALS",MIDPOINT_CONVEX_DYADIC_RATIONALS; +"MIDPOINT_EQ_ENDPOINT",MIDPOINT_EQ_ENDPOINT; +"MIDPOINT_IN_CONVEX",MIDPOINT_IN_CONVEX; +"MIDPOINT_IN_SEGMENT",MIDPOINT_IN_SEGMENT; +"MIDPOINT_LINEAR_IMAGE",MIDPOINT_LINEAR_IMAGE; +"MIDPOINT_REFL",MIDPOINT_REFL; +"MIDPOINT_SYM",MIDPOINT_SYM; +"MIN",MIN; +"MINIMAL",MINIMAL; +"MINIMAL_CONTINUUM",MINIMAL_CONTINUUM; +"MINIMAL_IN_INSERT",MINIMAL_IN_INSERT; +"MK_REC_INJ",MK_REC_INJ; +"MOD_0",MOD_0; +"MOD_1",MOD_1; +"MOD_ADD_MOD",MOD_ADD_MOD; +"MOD_EQ",MOD_EQ; +"MOD_EQ_0",MOD_EQ_0; +"MOD_EXISTS",MOD_EXISTS; +"MOD_EXP_MOD",MOD_EXP_MOD; +"MOD_LE",MOD_LE; +"MOD_LT",MOD_LT; +"MOD_MOD",MOD_MOD; +"MOD_MOD_EXP_MIN",MOD_MOD_EXP_MIN; +"MOD_MOD_REFL",MOD_MOD_REFL; +"MOD_MULT",MOD_MULT; +"MOD_MULT2",MOD_MULT2; +"MOD_MULT_ADD",MOD_MULT_ADD; +"MOD_MULT_LMOD",MOD_MULT_LMOD; +"MOD_MULT_MOD2",MOD_MULT_MOD2; +"MOD_MULT_RMOD",MOD_MULT_RMOD; +"MOD_NSUM_MOD",MOD_NSUM_MOD; +"MOD_NSUM_MOD_NUMSEG",MOD_NSUM_MOD_NUMSEG; +"MOD_REFL",MOD_REFL; +"MOD_UNIQ",MOD_UNIQ; +"MONOIDAL_AC",MONOIDAL_AC; +"MONOIDAL_ADD",MONOIDAL_ADD; +"MONOIDAL_AND",MONOIDAL_AND; +"MONOIDAL_LIFTED",MONOIDAL_LIFTED; +"MONOIDAL_MUL",MONOIDAL_MUL; +"MONOIDAL_REAL_ADD",MONOIDAL_REAL_ADD; +"MONOIDAL_REAL_MUL",MONOIDAL_REAL_MUL; +"MONOIDAL_VECTOR_ADD",MONOIDAL_VECTOR_ADD; +"MONOTONE_BIGGER",MONOTONE_BIGGER; +"MONOTONE_CONVERGENCE_DECREASING",MONOTONE_CONVERGENCE_DECREASING; +"MONOTONE_CONVERGENCE_DECREASING_AE",MONOTONE_CONVERGENCE_DECREASING_AE; +"MONOTONE_CONVERGENCE_INCREASING",MONOTONE_CONVERGENCE_INCREASING; +"MONOTONE_CONVERGENCE_INCREASING_AE",MONOTONE_CONVERGENCE_INCREASING_AE; +"MONOTONE_CONVERGENCE_INTERVAL",MONOTONE_CONVERGENCE_INTERVAL; +"MONOTONE_SUBSEQUENCE",MONOTONE_SUBSEQUENCE; +"MONO_ALL",MONO_ALL; +"MONO_ALL2",MONO_ALL2; +"MONO_AND",MONO_AND; +"MONO_COND",MONO_COND; +"MONO_EXISTS",MONO_EXISTS; +"MONO_FORALL",MONO_FORALL; +"MONO_IMP",MONO_IMP; +"MONO_NOT",MONO_NOT; +"MONO_OR",MONO_OR; +"MULT",MULT; +"MULTIVECTOR_ADD_COMPONENT",MULTIVECTOR_ADD_COMPONENT; +"MULTIVECTOR_BETA",MULTIVECTOR_BETA; +"MULTIVECTOR_EQ",MULTIVECTOR_EQ; +"MULTIVECTOR_ETA",MULTIVECTOR_ETA; +"MULTIVECTOR_GRADE",MULTIVECTOR_GRADE; +"MULTIVECTOR_IMAGE",MULTIVECTOR_IMAGE; +"MULTIVECTOR_MUL_COMPONENT",MULTIVECTOR_MUL_COMPONENT; +"MULTIVECTOR_UNIQUE",MULTIVECTOR_UNIQUE; +"MULTIVECTOR_VEC_COMPONENT",MULTIVECTOR_VEC_COMPONENT; +"MULTIVECTOR_VSUM",MULTIVECTOR_VSUM; +"MULTIVECTOR_VSUM_COMPONENT",MULTIVECTOR_VSUM_COMPONENT; +"MULT_0",MULT_0; +"MULT_2",MULT_2; +"MULT_AC",MULT_AC; +"MULT_ASSOC",MULT_ASSOC; +"MULT_CLAUSES",MULT_CLAUSES; +"MULT_DIV_LE",MULT_DIV_LE; +"MULT_EQ_0",MULT_EQ_0; +"MULT_EQ_1",MULT_EQ_1; +"MULT_EXP",MULT_EXP; +"MULT_SUC",MULT_SUC; +"MULT_SYM",MULT_SYM; +"MUL_C_UNIV",MUL_C_UNIV; +"MUMFORD_LEMMA",MUMFORD_LEMMA; +"MVT",MVT; +"MVT_GENERAL",MVT_GENERAL; +"MVT_SIMPLE",MVT_SIMPLE; +"MVT_VERY_SIMPLE",MVT_VERY_SIMPLE; +"NADD_ADD",NADD_ADD; +"NADD_ADDITIVE",NADD_ADDITIVE; +"NADD_ADD_ASSOC",NADD_ADD_ASSOC; +"NADD_ADD_LCANCEL",NADD_ADD_LCANCEL; +"NADD_ADD_LID",NADD_ADD_LID; +"NADD_ADD_SYM",NADD_ADD_SYM; +"NADD_ADD_WELLDEF",NADD_ADD_WELLDEF; +"NADD_ALTMUL",NADD_ALTMUL; +"NADD_ARCH",NADD_ARCH; +"NADD_ARCH_LEMMA",NADD_ARCH_LEMMA; +"NADD_ARCH_MULT",NADD_ARCH_MULT; +"NADD_ARCH_ZERO",NADD_ARCH_ZERO; +"NADD_BOUND",NADD_BOUND; +"NADD_CAUCHY",NADD_CAUCHY; +"NADD_COMPLETE",NADD_COMPLETE; +"NADD_DIST",NADD_DIST; +"NADD_DIST_LEMMA",NADD_DIST_LEMMA; +"NADD_EQ_IMP_LE",NADD_EQ_IMP_LE; +"NADD_EQ_REFL",NADD_EQ_REFL; +"NADD_EQ_SYM",NADD_EQ_SYM; +"NADD_EQ_TRANS",NADD_EQ_TRANS; +"NADD_INV",NADD_INV; +"NADD_INV_0",NADD_INV_0; +"NADD_INV_WELLDEF",NADD_INV_WELLDEF; +"NADD_LBOUND",NADD_LBOUND; +"NADD_LDISTRIB",NADD_LDISTRIB; +"NADD_LE_0",NADD_LE_0; +"NADD_LE_ADD",NADD_LE_ADD; +"NADD_LE_ANTISYM",NADD_LE_ANTISYM; +"NADD_LE_EXISTS",NADD_LE_EXISTS; +"NADD_LE_LADD",NADD_LE_LADD; +"NADD_LE_LMUL",NADD_LE_LMUL; +"NADD_LE_RADD",NADD_LE_RADD; +"NADD_LE_REFL",NADD_LE_REFL; +"NADD_LE_RMUL",NADD_LE_RMUL; +"NADD_LE_TOTAL",NADD_LE_TOTAL; +"NADD_LE_TOTAL_LEMMA",NADD_LE_TOTAL_LEMMA; +"NADD_LE_TRANS",NADD_LE_TRANS; +"NADD_LE_WELLDEF",NADD_LE_WELLDEF; +"NADD_LE_WELLDEF_LEMMA",NADD_LE_WELLDEF_LEMMA; +"NADD_MUL",NADD_MUL; +"NADD_MULTIPLICATIVE",NADD_MULTIPLICATIVE; +"NADD_MUL_ASSOC",NADD_MUL_ASSOC; +"NADD_MUL_LID",NADD_MUL_LID; +"NADD_MUL_LINV",NADD_MUL_LINV; +"NADD_MUL_LINV_LEMMA0",NADD_MUL_LINV_LEMMA0; +"NADD_MUL_LINV_LEMMA1",NADD_MUL_LINV_LEMMA1; +"NADD_MUL_LINV_LEMMA2",NADD_MUL_LINV_LEMMA2; +"NADD_MUL_LINV_LEMMA3",NADD_MUL_LINV_LEMMA3; +"NADD_MUL_LINV_LEMMA4",NADD_MUL_LINV_LEMMA4; +"NADD_MUL_LINV_LEMMA5",NADD_MUL_LINV_LEMMA5; +"NADD_MUL_LINV_LEMMA6",NADD_MUL_LINV_LEMMA6; +"NADD_MUL_LINV_LEMMA7",NADD_MUL_LINV_LEMMA7; +"NADD_MUL_LINV_LEMMA7a",NADD_MUL_LINV_LEMMA7a; +"NADD_MUL_LINV_LEMMA8",NADD_MUL_LINV_LEMMA8; +"NADD_MUL_SYM",NADD_MUL_SYM; +"NADD_MUL_WELLDEF",NADD_MUL_WELLDEF; +"NADD_MUL_WELLDEF_LEMMA",NADD_MUL_WELLDEF_LEMMA; +"NADD_NONZERO",NADD_NONZERO; +"NADD_OF_NUM",NADD_OF_NUM; +"NADD_OF_NUM_ADD",NADD_OF_NUM_ADD; +"NADD_OF_NUM_EQ",NADD_OF_NUM_EQ; +"NADD_OF_NUM_LE",NADD_OF_NUM_LE; +"NADD_OF_NUM_MUL",NADD_OF_NUM_MUL; +"NADD_OF_NUM_WELLDEF",NADD_OF_NUM_WELLDEF; +"NADD_RDISTRIB",NADD_RDISTRIB; +"NADD_SUC",NADD_SUC; +"NADD_UBOUND",NADD_UBOUND; +"NEARBY_INVERTIBLE_MATRIX",NEARBY_INVERTIBLE_MATRIX; +"NEGATIONS_BALL",NEGATIONS_BALL; +"NEGATIONS_CBALL",NEGATIONS_CBALL; +"NEGATIONS_SPHERE",NEGATIONS_SPHERE; +"NEGLIGIBLE",NEGLIGIBLE; +"NEGLIGIBLE_AFFINE_HULL",NEGLIGIBLE_AFFINE_HULL; +"NEGLIGIBLE_AFFINE_HULL_1",NEGLIGIBLE_AFFINE_HULL_1; +"NEGLIGIBLE_AFFINE_HULL_2",NEGLIGIBLE_AFFINE_HULL_2; +"NEGLIGIBLE_AFFINE_HULL_3",NEGLIGIBLE_AFFINE_HULL_3; +"NEGLIGIBLE_BOUNDED_SUBSETS",NEGLIGIBLE_BOUNDED_SUBSETS; +"NEGLIGIBLE_CONVEX_FRONTIER",NEGLIGIBLE_CONVEX_FRONTIER; +"NEGLIGIBLE_CONVEX_HULL",NEGLIGIBLE_CONVEX_HULL; +"NEGLIGIBLE_CONVEX_HULL_1",NEGLIGIBLE_CONVEX_HULL_1; +"NEGLIGIBLE_CONVEX_HULL_2",NEGLIGIBLE_CONVEX_HULL_2; +"NEGLIGIBLE_CONVEX_HULL_3",NEGLIGIBLE_CONVEX_HULL_3; +"NEGLIGIBLE_CONVEX_INTERIOR",NEGLIGIBLE_CONVEX_INTERIOR; +"NEGLIGIBLE_COUNTABLE",NEGLIGIBLE_COUNTABLE; +"NEGLIGIBLE_COUNTABLE_UNIONS",NEGLIGIBLE_COUNTABLE_UNIONS; +"NEGLIGIBLE_COUNTABLE_UNIONS_GEN",NEGLIGIBLE_COUNTABLE_UNIONS_GEN; +"NEGLIGIBLE_DELETE",NEGLIGIBLE_DELETE; +"NEGLIGIBLE_DIFF",NEGLIGIBLE_DIFF; +"NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_LOWDIM; +"NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE",NEGLIGIBLE_DIFFERENTIABLE_IMAGE_NEGLIGIBLE; +"NEGLIGIBLE_DISJOINT_TRANSLATES",NEGLIGIBLE_DISJOINT_TRANSLATES; +"NEGLIGIBLE_EMPTY",NEGLIGIBLE_EMPTY; +"NEGLIGIBLE_EMPTY_INTERIOR",NEGLIGIBLE_EMPTY_INTERIOR; +"NEGLIGIBLE_EQ_MEASURE_0",NEGLIGIBLE_EQ_MEASURE_0; +"NEGLIGIBLE_FINITE",NEGLIGIBLE_FINITE; +"NEGLIGIBLE_FRONTIER_INTERVAL",NEGLIGIBLE_FRONTIER_INTERVAL; +"NEGLIGIBLE_HYPERPLANE",NEGLIGIBLE_HYPERPLANE; +"NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_LEBESGUE_MEASURABLE_SUBSETS; +"NEGLIGIBLE_IFF_MEASURABLE_SUBSETS",NEGLIGIBLE_IFF_MEASURABLE_SUBSETS; +"NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL",NEGLIGIBLE_IMAGE_BOUNDED_VARIATION_INTERVAL; +"NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE",NEGLIGIBLE_IMP_LEBESGUE_MEASURABLE; +"NEGLIGIBLE_IMP_MEASURABLE",NEGLIGIBLE_IMP_MEASURABLE; +"NEGLIGIBLE_INSERT",NEGLIGIBLE_INSERT; +"NEGLIGIBLE_INTER",NEGLIGIBLE_INTER; +"NEGLIGIBLE_INTERVAL",NEGLIGIBLE_INTERVAL; +"NEGLIGIBLE_LINEAR_IMAGE",NEGLIGIBLE_LINEAR_IMAGE; +"NEGLIGIBLE_LINEAR_IMAGE_EQ",NEGLIGIBLE_LINEAR_IMAGE_EQ; +"NEGLIGIBLE_LINEAR_IMAGE_GEN",NEGLIGIBLE_LINEAR_IMAGE_GEN; +"NEGLIGIBLE_LINEAR_SINGULAR_IMAGE",NEGLIGIBLE_LINEAR_SINGULAR_IMAGE; +"NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV",NEGLIGIBLE_LIPSCHITZ_IMAGE_UNIV; +"NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE",NEGLIGIBLE_LOCALLY_LIPSCHITZ_IMAGE; +"NEGLIGIBLE_LOWDIM",NEGLIGIBLE_LOWDIM; +"NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH",NEGLIGIBLE_MEASURABLE_FUNCTION_GRAPH; +"NEGLIGIBLE_ON_COUNTABLE_INTERVALS",NEGLIGIBLE_ON_COUNTABLE_INTERVALS; +"NEGLIGIBLE_ON_INTERVALS",NEGLIGIBLE_ON_INTERVALS; +"NEGLIGIBLE_ON_UNIV",NEGLIGIBLE_ON_UNIV; +"NEGLIGIBLE_OUTER",NEGLIGIBLE_OUTER; +"NEGLIGIBLE_OUTER_LE",NEGLIGIBLE_OUTER_LE; +"NEGLIGIBLE_PCROSS",NEGLIGIBLE_PCROSS; +"NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE",NEGLIGIBLE_RECTIFIABLE_PATH_IMAGE; +"NEGLIGIBLE_SING",NEGLIGIBLE_SING; +"NEGLIGIBLE_SPHERE",NEGLIGIBLE_SPHERE; +"NEGLIGIBLE_STANDARD_HYPERPLANE",NEGLIGIBLE_STANDARD_HYPERPLANE; +"NEGLIGIBLE_SUBSET",NEGLIGIBLE_SUBSET; +"NEGLIGIBLE_SYMDIFF_EQ",NEGLIGIBLE_SYMDIFF_EQ; +"NEGLIGIBLE_TRANSLATION",NEGLIGIBLE_TRANSLATION; +"NEGLIGIBLE_TRANSLATION_EQ",NEGLIGIBLE_TRANSLATION_EQ; +"NEGLIGIBLE_TRANSLATION_REV",NEGLIGIBLE_TRANSLATION_REV; +"NEGLIGIBLE_UNION",NEGLIGIBLE_UNION; +"NEGLIGIBLE_UNIONS",NEGLIGIBLE_UNIONS; +"NEGLIGIBLE_UNION_EQ",NEGLIGIBLE_UNION_EQ; +"NEIGHBOURHOOD_EXTENSION_INTO_ANR",NEIGHBOURHOOD_EXTENSION_INTO_ANR; +"NET",NET; +"NETLIMIT_AT",NETLIMIT_AT; +"NETLIMIT_WITHIN",NETLIMIT_WITHIN; +"NETLIMIT_WITHIN_INTERIOR",NETLIMIT_WITHIN_INTERIOR; +"NET_DILEMMA",NET_DILEMMA; +"NEUTRAL_ADD",NEUTRAL_ADD; +"NEUTRAL_AND",NEUTRAL_AND; +"NEUTRAL_LIFTED",NEUTRAL_LIFTED; +"NEUTRAL_MUL",NEUTRAL_MUL; +"NEUTRAL_OUTER",NEUTRAL_OUTER; +"NEUTRAL_REAL_ADD",NEUTRAL_REAL_ADD; +"NEUTRAL_REAL_MUL",NEUTRAL_REAL_MUL; +"NEUTRAL_VECTOR_ADD",NEUTRAL_VECTOR_ADD; +"NONEMPTY_SIMPLE_PATH_ENDLESS",NONEMPTY_SIMPLE_PATH_ENDLESS; +"NONNEGATIVE_ABSOLUTELY_INTEGRABLE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE; +"NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE",NONNEGATIVE_ABSOLUTELY_INTEGRABLE_AE; +"NONTRIVIAL_LIMIT_WITHIN",NONTRIVIAL_LIMIT_WITHIN; +"NORM_0",NORM_0; +"NORM_1",NORM_1; +"NORM_1_POS",NORM_1_POS; +"NORM_ADD_PYTHAGOREAN",NORM_ADD_PYTHAGOREAN; +"NORM_BASIS",NORM_BASIS; +"NORM_BASIS_1",NORM_BASIS_1; +"NORM_BOUND_COMPONENT_LE",NORM_BOUND_COMPONENT_LE; +"NORM_BOUND_COMPONENT_LT",NORM_BOUND_COMPONENT_LT; +"NORM_BOUND_GENERALIZE",NORM_BOUND_GENERALIZE; +"NORM_CAUCHY_SCHWARZ",NORM_CAUCHY_SCHWARZ; +"NORM_CAUCHY_SCHWARZ_ABS",NORM_CAUCHY_SCHWARZ_ABS; +"NORM_CAUCHY_SCHWARZ_ABS_EQ",NORM_CAUCHY_SCHWARZ_ABS_EQ; +"NORM_CAUCHY_SCHWARZ_DIV",NORM_CAUCHY_SCHWARZ_DIV; +"NORM_CAUCHY_SCHWARZ_EQ",NORM_CAUCHY_SCHWARZ_EQ; +"NORM_CAUCHY_SCHWARZ_EQUAL",NORM_CAUCHY_SCHWARZ_EQUAL; +"NORM_COLUMN_LE_ONORM",NORM_COLUMN_LE_ONORM; +"NORM_CROSS_MULTIPLY",NORM_CROSS_MULTIPLY; +"NORM_EQ",NORM_EQ; +"NORM_EQ_0",NORM_EQ_0; +"NORM_EQ_0_DOT",NORM_EQ_0_DOT; +"NORM_EQ_0_IMP",NORM_EQ_0_IMP; +"NORM_EQ_1",NORM_EQ_1; +"NORM_EQ_SQUARE",NORM_EQ_SQUARE; +"NORM_FSTCART",NORM_FSTCART; +"NORM_GE_SQUARE",NORM_GE_SQUARE; +"NORM_GT_SQUARE",NORM_GT_SQUARE; +"NORM_INCREASES_ONLINE",NORM_INCREASES_ONLINE; +"NORM_LE",NORM_LE; +"NORM_LE_0",NORM_LE_0; +"NORM_LE_COMPONENTWISE",NORM_LE_COMPONENTWISE; +"NORM_LE_INFNORM",NORM_LE_INFNORM; +"NORM_LE_L1",NORM_LE_L1; +"NORM_LE_PASTECART",NORM_LE_PASTECART; +"NORM_LE_SQUARE",NORM_LE_SQUARE; +"NORM_LIFT",NORM_LIFT; +"NORM_LT",NORM_LT; +"NORM_LT_SQUARE",NORM_LT_SQUARE; +"NORM_LT_SQUARE_ALT",NORM_LT_SQUARE_ALT; +"NORM_MUL",NORM_MUL; +"NORM_NEG",NORM_NEG; +"NORM_PASTECART",NORM_PASTECART; +"NORM_PASTECART_0",NORM_PASTECART_0; +"NORM_PASTECART_LE",NORM_PASTECART_LE; +"NORM_POS_LE",NORM_POS_LE; +"NORM_POS_LT",NORM_POS_LT; +"NORM_POW_2",NORM_POW_2; +"NORM_REAL",NORM_REAL; +"NORM_SEGMENT_LOWERBOUND",NORM_SEGMENT_LOWERBOUND; +"NORM_SEGMENT_ORTHOGONAL_LOWERBOUND",NORM_SEGMENT_ORTHOGONAL_LOWERBOUND; +"NORM_SNDCART",NORM_SNDCART; +"NORM_SUB",NORM_SUB; +"NORM_TRIANGLE",NORM_TRIANGLE; +"NORM_TRIANGLE_EQ",NORM_TRIANGLE_EQ; +"NORM_TRIANGLE_LE",NORM_TRIANGLE_LE; +"NORM_TRIANGLE_LT",NORM_TRIANGLE_LT; +"NORM_TRIANGLE_SUB",NORM_TRIANGLE_SUB; +"NORM_VSUM_PYTHAGOREAN",NORM_VSUM_PYTHAGOREAN; +"NORM_VSUM_TRIVIAL_LEMMA",NORM_VSUM_TRIVIAL_LEMMA; +"NOT_ABSOLUTE_RETRACT_COBOUNDED",NOT_ABSOLUTE_RETRACT_COBOUNDED; +"NOT_ALL",NOT_ALL; +"NOT_AR_EMPTY",NOT_AR_EMPTY; +"NOT_BOUNDED_UNIV",NOT_BOUNDED_UNIV; +"NOT_CLAUSES",NOT_CLAUSES; +"NOT_CLAUSES_WEAK",NOT_CLAUSES_WEAK; +"NOT_CONS_NIL",NOT_CONS_NIL; +"NOT_DEF",NOT_DEF; +"NOT_EMPTY_INSERT",NOT_EMPTY_INSERT; +"NOT_EQUAL_SETS",NOT_EQUAL_SETS; +"NOT_EVEN",NOT_EVEN; +"NOT_EVENTUALLY",NOT_EVENTUALLY; +"NOT_EX",NOT_EX; +"NOT_EXISTS_THM",NOT_EXISTS_THM; +"NOT_FORALL_THM",NOT_FORALL_THM; +"NOT_IMP",NOT_IMP; +"NOT_INSERT_EMPTY",NOT_INSERT_EMPTY; +"NOT_INTERVAL_UNIV",NOT_INTERVAL_UNIV; +"NOT_IN_EMPTY",NOT_IN_EMPTY; +"NOT_IN_INTERIOR_CONVEX_HULL",NOT_IN_INTERIOR_CONVEX_HULL; +"NOT_IN_PATH_IMAGE_JOIN",NOT_IN_PATH_IMAGE_JOIN; +"NOT_LE",NOT_LE; +"NOT_LT",NOT_LT; +"NOT_NEGLIGIBLE_UNIV",NOT_NEGLIGIBLE_UNIV; +"NOT_ODD",NOT_ODD; +"NOT_ON_PATH_BALL",NOT_ON_PATH_BALL; +"NOT_ON_PATH_CBALL",NOT_ON_PATH_CBALL; +"NOT_OUTSIDE_CONNECTED_COMPONENT_LE",NOT_OUTSIDE_CONNECTED_COMPONENT_LE; +"NOT_OUTSIDE_CONNECTED_COMPONENT_LT",NOT_OUTSIDE_CONNECTED_COMPONENT_LT; +"NOT_PSUBSET_EMPTY",NOT_PSUBSET_EMPTY; +"NOT_SUC",NOT_SUC; +"NOT_UNIV_PSUBSET",NOT_UNIV_PSUBSET; +"NOWHERE_DENSE",NOWHERE_DENSE; +"NOWHERE_DENSE_UNION",NOWHERE_DENSE_UNION; +"NO_LIMIT_POINT_IMP_CLOSED",NO_LIMIT_POINT_IMP_CLOSED; +"NO_RETRACTION_CBALL",NO_RETRACTION_CBALL; +"NO_RETRACTION_FRONTIER_BOUNDED",NO_RETRACTION_FRONTIER_BOUNDED; +"NPRODUCT_ADD_SPLIT",NPRODUCT_ADD_SPLIT; +"NPRODUCT_CLAUSES",NPRODUCT_CLAUSES; +"NPRODUCT_CLAUSES_LEFT",NPRODUCT_CLAUSES_LEFT; +"NPRODUCT_CLAUSES_NUMSEG",NPRODUCT_CLAUSES_NUMSEG; +"NPRODUCT_CLAUSES_RIGHT",NPRODUCT_CLAUSES_RIGHT; +"NPRODUCT_CLOSED",NPRODUCT_CLOSED; +"NPRODUCT_CONST",NPRODUCT_CONST; +"NPRODUCT_CONST_NUMSEG",NPRODUCT_CONST_NUMSEG; +"NPRODUCT_CONST_NUMSEG_1",NPRODUCT_CONST_NUMSEG_1; +"NPRODUCT_DELETE",NPRODUCT_DELETE; +"NPRODUCT_EQ",NPRODUCT_EQ; +"NPRODUCT_EQ_0",NPRODUCT_EQ_0; +"NPRODUCT_EQ_0_NUMSEG",NPRODUCT_EQ_0_NUMSEG; +"NPRODUCT_EQ_1",NPRODUCT_EQ_1; +"NPRODUCT_EQ_1_NUMSEG",NPRODUCT_EQ_1_NUMSEG; +"NPRODUCT_EQ_NUMSEG",NPRODUCT_EQ_NUMSEG; +"NPRODUCT_FACT",NPRODUCT_FACT; +"NPRODUCT_IMAGE",NPRODUCT_IMAGE; +"NPRODUCT_LE",NPRODUCT_LE; +"NPRODUCT_LE_NUMSEG",NPRODUCT_LE_NUMSEG; +"NPRODUCT_MUL",NPRODUCT_MUL; +"NPRODUCT_MUL_NUMSEG",NPRODUCT_MUL_NUMSEG; +"NPRODUCT_OFFSET",NPRODUCT_OFFSET; +"NPRODUCT_ONE",NPRODUCT_ONE; +"NPRODUCT_PAIR",NPRODUCT_PAIR; +"NPRODUCT_POS_LT",NPRODUCT_POS_LT; +"NPRODUCT_POS_LT_NUMSEG",NPRODUCT_POS_LT_NUMSEG; +"NPRODUCT_SING",NPRODUCT_SING; +"NPRODUCT_SING_NUMSEG",NPRODUCT_SING_NUMSEG; +"NPRODUCT_SUPERSET",NPRODUCT_SUPERSET; +"NPRODUCT_SUPPORT",NPRODUCT_SUPPORT; +"NPRODUCT_UNION",NPRODUCT_UNION; +"NSUM_0",NSUM_0; +"NSUM_ADD",NSUM_ADD; +"NSUM_ADD_GEN",NSUM_ADD_GEN; +"NSUM_ADD_NUMSEG",NSUM_ADD_NUMSEG; +"NSUM_ADD_SPLIT",NSUM_ADD_SPLIT; +"NSUM_BIJECTION",NSUM_BIJECTION; +"NSUM_BOUND",NSUM_BOUND; +"NSUM_BOUND_GEN",NSUM_BOUND_GEN; +"NSUM_BOUND_LT",NSUM_BOUND_LT; +"NSUM_BOUND_LT_ALL",NSUM_BOUND_LT_ALL; +"NSUM_BOUND_LT_GEN",NSUM_BOUND_LT_GEN; +"NSUM_CASES",NSUM_CASES; +"NSUM_CLAUSES",NSUM_CLAUSES; +"NSUM_CLAUSES_LEFT",NSUM_CLAUSES_LEFT; +"NSUM_CLAUSES_NUMSEG",NSUM_CLAUSES_NUMSEG; +"NSUM_CLAUSES_RIGHT",NSUM_CLAUSES_RIGHT; +"NSUM_CLOSED",NSUM_CLOSED; +"NSUM_CONST",NSUM_CONST; +"NSUM_CONST_NUMSEG",NSUM_CONST_NUMSEG; +"NSUM_DEGENERATE",NSUM_DEGENERATE; +"NSUM_DELETE",NSUM_DELETE; +"NSUM_DELTA",NSUM_DELTA; +"NSUM_DIFF",NSUM_DIFF; +"NSUM_EQ",NSUM_EQ; +"NSUM_EQ_0",NSUM_EQ_0; +"NSUM_EQ_0_IFF",NSUM_EQ_0_IFF; +"NSUM_EQ_0_IFF_NUMSEG",NSUM_EQ_0_IFF_NUMSEG; +"NSUM_EQ_0_NUMSEG",NSUM_EQ_0_NUMSEG; +"NSUM_EQ_GENERAL",NSUM_EQ_GENERAL; +"NSUM_EQ_GENERAL_INVERSES",NSUM_EQ_GENERAL_INVERSES; +"NSUM_EQ_NUMSEG",NSUM_EQ_NUMSEG; +"NSUM_EQ_SUPERSET",NSUM_EQ_SUPERSET; +"NSUM_GROUP",NSUM_GROUP; +"NSUM_IMAGE",NSUM_IMAGE; +"NSUM_IMAGE_GEN",NSUM_IMAGE_GEN; +"NSUM_IMAGE_NONZERO",NSUM_IMAGE_NONZERO; +"NSUM_INCL_EXCL",NSUM_INCL_EXCL; +"NSUM_INJECTION",NSUM_INJECTION; +"NSUM_LE",NSUM_LE; +"NSUM_LE_GEN",NSUM_LE_GEN; +"NSUM_LE_NUMSEG",NSUM_LE_NUMSEG; +"NSUM_LMUL",NSUM_LMUL; +"NSUM_LT",NSUM_LT; +"NSUM_LT_ALL",NSUM_LT_ALL; +"NSUM_MULTICOUNT",NSUM_MULTICOUNT; +"NSUM_MULTICOUNT_GEN",NSUM_MULTICOUNT_GEN; +"NSUM_NSUM_PRODUCT",NSUM_NSUM_PRODUCT; +"NSUM_NSUM_RESTRICT",NSUM_NSUM_RESTRICT; +"NSUM_OFFSET",NSUM_OFFSET; +"NSUM_OFFSET_0",NSUM_OFFSET_0; +"NSUM_PAIR",NSUM_PAIR; +"NSUM_PERMUTE",NSUM_PERMUTE; +"NSUM_PERMUTE_NUMSEG",NSUM_PERMUTE_NUMSEG; +"NSUM_POS_BOUND",NSUM_POS_BOUND; +"NSUM_POS_LT",NSUM_POS_LT; +"NSUM_POS_LT_ALL",NSUM_POS_LT_ALL; +"NSUM_RESTRICT",NSUM_RESTRICT; +"NSUM_RESTRICT_SET",NSUM_RESTRICT_SET; +"NSUM_RMUL",NSUM_RMUL; +"NSUM_SING",NSUM_SING; +"NSUM_SING_NUMSEG",NSUM_SING_NUMSEG; +"NSUM_SUBSET",NSUM_SUBSET; +"NSUM_SUBSET_SIMPLE",NSUM_SUBSET_SIMPLE; +"NSUM_SUPERSET",NSUM_SUPERSET; +"NSUM_SUPPORT",NSUM_SUPPORT; +"NSUM_SWAP",NSUM_SWAP; +"NSUM_SWAP_NUMSEG",NSUM_SWAP_NUMSEG; +"NSUM_TRIV_NUMSEG",NSUM_TRIV_NUMSEG; +"NSUM_UNION",NSUM_UNION; +"NSUM_UNIONS_NONZERO",NSUM_UNIONS_NONZERO; +"NSUM_UNION_EQ",NSUM_UNION_EQ; +"NSUM_UNION_LZERO",NSUM_UNION_LZERO; +"NSUM_UNION_NONZERO",NSUM_UNION_NONZERO; +"NSUM_UNION_RZERO",NSUM_UNION_RZERO; +"NULL",NULL; +"NULLHOMOTOPIC_FROM_CONTRACTIBLE",NULLHOMOTOPIC_FROM_CONTRACTIBLE; +"NULLHOMOTOPIC_FROM_SPHERE_EXTENSION",NULLHOMOTOPIC_FROM_SPHERE_EXTENSION; +"NULLHOMOTOPIC_INTO_ANR_EXTENSION",NULLHOMOTOPIC_INTO_ANR_EXTENSION; +"NULLHOMOTOPIC_INTO_CONTRACTIBLE",NULLHOMOTOPIC_INTO_CONTRACTIBLE; +"NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION",NULLHOMOTOPIC_INTO_RELATIVE_FRONTIER_EXTENSION; +"NULLHOMOTOPIC_INTO_SPHERE_EXTENSION",NULLHOMOTOPIC_INTO_SPHERE_EXTENSION; +"NULLHOMOTOPIC_THROUGH_CONTRACTIBLE",NULLHOMOTOPIC_THROUGH_CONTRACTIBLE; +"NULLSPACE_INTER_ROWSPACE",NULLSPACE_INTER_ROWSPACE; +"NUMERAL",NUMERAL; +"NUMPAIR",NUMPAIR; +"NUMPAIR_DEST",NUMPAIR_DEST; +"NUMPAIR_INJ",NUMPAIR_INJ; +"NUMPAIR_INJ_LEMMA",NUMPAIR_INJ_LEMMA; +"NUMSEG_ADD_SPLIT",NUMSEG_ADD_SPLIT; +"NUMSEG_CLAUSES",NUMSEG_CLAUSES; +"NUMSEG_COMBINE_L",NUMSEG_COMBINE_L; +"NUMSEG_COMBINE_R",NUMSEG_COMBINE_R; +"NUMSEG_DIMINDEX_NONEMPTY",NUMSEG_DIMINDEX_NONEMPTY; +"NUMSEG_EMPTY",NUMSEG_EMPTY; +"NUMSEG_LE",NUMSEG_LE; +"NUMSEG_LREC",NUMSEG_LREC; +"NUMSEG_LT",NUMSEG_LT; +"NUMSEG_OFFSET_IMAGE",NUMSEG_OFFSET_IMAGE; +"NUMSEG_REC",NUMSEG_REC; +"NUMSEG_RREC",NUMSEG_RREC; +"NUMSEG_SING",NUMSEG_SING; +"NUMSUM",NUMSUM; +"NUMSUM_DEST",NUMSUM_DEST; +"NUMSUM_INJ",NUMSUM_INJ; +"NUM_COUNTABLE",NUM_COUNTABLE; +"NUM_GCD",NUM_GCD; +"NUM_OF_INT",NUM_OF_INT; +"NUM_OF_INT_OF_NUM",NUM_OF_INT_OF_NUM; +"NUM_REP_CASES",NUM_REP_CASES; +"NUM_REP_INDUCT",NUM_REP_INDUCT; +"NUM_REP_RULES",NUM_REP_RULES; +"ODD",ODD; +"ODD_ADD",ODD_ADD; +"ODD_DOUBLE",ODD_DOUBLE; +"ODD_EXISTS",ODD_EXISTS; +"ODD_EXP",ODD_EXP; +"ODD_MOD",ODD_MOD; +"ODD_MULT",ODD_MULT; +"ODD_SUB",ODD_SUB; +"OEP",OEP; +"OLDNET",OLDNET; +"ONE",ONE; +"ONE_ONE",ONE_ONE; +"ONORM",ONORM; +"ONORM_COMPOSE",ONORM_COMPOSE; +"ONORM_CONST",ONORM_CONST; +"ONORM_EQ_0",ONORM_EQ_0; +"ONORM_I",ONORM_I; +"ONORM_ID",ONORM_ID; +"ONORM_NEG",ONORM_NEG; +"ONORM_NEG_LEMMA",ONORM_NEG_LEMMA; +"ONORM_POS_LE",ONORM_POS_LE; +"ONORM_POS_LT",ONORM_POS_LT; +"ONORM_TRIANGLE",ONORM_TRIANGLE; +"ONORM_TRIANGLE_LE",ONORM_TRIANGLE_LE; +"ONORM_TRIANGLE_LT",ONORM_TRIANGLE_LT; +"ONTO",ONTO; +"OPEN_AFFINITY",OPEN_AFFINITY; +"OPEN_BALL",OPEN_BALL; +"OPEN_BIJECTIVE_LINEAR_IMAGE_EQ",OPEN_BIJECTIVE_LINEAR_IMAGE_EQ; +"OPEN_CLOSED",OPEN_CLOSED; +"OPEN_CLOSED_INTERVAL_1",OPEN_CLOSED_INTERVAL_1; +"OPEN_CLOSED_INTERVAL_CONVEX",OPEN_CLOSED_INTERVAL_CONVEX; +"OPEN_COMPONENTS",OPEN_COMPONENTS; +"OPEN_CONNECTED_COMPONENT",OPEN_CONNECTED_COMPONENT; +"OPEN_CONTAINS_BALL",OPEN_CONTAINS_BALL; +"OPEN_CONTAINS_BALL_EQ",OPEN_CONTAINS_BALL_EQ; +"OPEN_CONTAINS_CBALL",OPEN_CONTAINS_CBALL; +"OPEN_CONTAINS_CBALL_EQ",OPEN_CONTAINS_CBALL_EQ; +"OPEN_CONTAINS_INTERVAL",OPEN_CONTAINS_INTERVAL; +"OPEN_CONTAINS_OPEN_INTERVAL",OPEN_CONTAINS_OPEN_INTERVAL; +"OPEN_CONVEX_HULL",OPEN_CONVEX_HULL; +"OPEN_COUNTABLE_LIMIT_ELEMENTARY",OPEN_COUNTABLE_LIMIT_ELEMENTARY; +"OPEN_COUNTABLE_UNION_CLOSED_INTERVALS",OPEN_COUNTABLE_UNION_CLOSED_INTERVALS; +"OPEN_COUNTABLE_UNION_OPEN_INTERVALS",OPEN_COUNTABLE_UNION_OPEN_INTERVALS; +"OPEN_DELETE",OPEN_DELETE; +"OPEN_DIFF",OPEN_DIFF; +"OPEN_EMPTY",OPEN_EMPTY; +"OPEN_EXISTS",OPEN_EXISTS; +"OPEN_EXISTS_IN",OPEN_EXISTS_IN; +"OPEN_GENERAL_COMPONENT",OPEN_GENERAL_COMPONENT; +"OPEN_HALFSPACE_COMPONENT_GT",OPEN_HALFSPACE_COMPONENT_GT; +"OPEN_HALFSPACE_COMPONENT_LT",OPEN_HALFSPACE_COMPONENT_LT; +"OPEN_HALFSPACE_GT",OPEN_HALFSPACE_GT; +"OPEN_HALFSPACE_LT",OPEN_HALFSPACE_LT; +"OPEN_IMP_ANR",OPEN_IMP_ANR; +"OPEN_IMP_ENR",OPEN_IMP_ENR; +"OPEN_IMP_INFINITE",OPEN_IMP_INFINITE; +"OPEN_IMP_LOCALLY_COMPACT",OPEN_IMP_LOCALLY_COMPACT; +"OPEN_IMP_LOCALLY_CONNECTED",OPEN_IMP_LOCALLY_CONNECTED; +"OPEN_IMP_LOCALLY_PATH_CONNECTED",OPEN_IMP_LOCALLY_PATH_CONNECTED; +"OPEN_IN",OPEN_IN; +"OPEN_INSIDE",OPEN_INSIDE; +"OPEN_INTER",OPEN_INTER; +"OPEN_INTERIOR",OPEN_INTERIOR; +"OPEN_INTERS",OPEN_INTERS; +"OPEN_INTERVAL",OPEN_INTERVAL; +"OPEN_INTERVAL_EQ",OPEN_INTERVAL_EQ; +"OPEN_INTERVAL_LEFT",OPEN_INTERVAL_LEFT; +"OPEN_INTERVAL_LEMMA",OPEN_INTERVAL_LEMMA; +"OPEN_INTERVAL_MIDPOINT",OPEN_INTERVAL_MIDPOINT; +"OPEN_INTERVAL_RIGHT",OPEN_INTERVAL_RIGHT; +"OPEN_INTER_CLOSURE_EQ_EMPTY",OPEN_INTER_CLOSURE_EQ_EMPTY; +"OPEN_INTER_CLOSURE_SUBSET",OPEN_INTER_CLOSURE_SUBSET; +"OPEN_IN_CLAUSES",OPEN_IN_CLAUSES; +"OPEN_IN_CLOSED_IN",OPEN_IN_CLOSED_IN; +"OPEN_IN_CLOSED_IN_EQ",OPEN_IN_CLOSED_IN_EQ; +"OPEN_IN_COMPONENTS_LOCALLY_CONNECTED",OPEN_IN_COMPONENTS_LOCALLY_CONNECTED; +"OPEN_IN_CONNECTED_COMPONENT",OPEN_IN_CONNECTED_COMPONENT; +"OPEN_IN_CONNECTED_COMPONENTS",OPEN_IN_CONNECTED_COMPONENTS; +"OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED",OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; +"OPEN_IN_CONTAINS_BALL",OPEN_IN_CONTAINS_BALL; +"OPEN_IN_CONTAINS_CBALL",OPEN_IN_CONTAINS_CBALL; +"OPEN_IN_DELETE",OPEN_IN_DELETE; +"OPEN_IN_DIFF",OPEN_IN_DIFF; +"OPEN_IN_EMPTY",OPEN_IN_EMPTY; +"OPEN_IN_IMP_SUBSET",OPEN_IN_IMP_SUBSET; +"OPEN_IN_INJECTIVE_LINEAR_IMAGE",OPEN_IN_INJECTIVE_LINEAR_IMAGE; +"OPEN_IN_INTER",OPEN_IN_INTER; +"OPEN_IN_INTERS",OPEN_IN_INTERS; +"OPEN_IN_INTER_OPEN",OPEN_IN_INTER_OPEN; +"OPEN_IN_LOCALLY_COMPACT",OPEN_IN_LOCALLY_COMPACT; +"OPEN_IN_OPEN",OPEN_IN_OPEN; +"OPEN_IN_OPEN_EQ",OPEN_IN_OPEN_EQ; +"OPEN_IN_OPEN_INTER",OPEN_IN_OPEN_INTER; +"OPEN_IN_OPEN_TRANS",OPEN_IN_OPEN_TRANS; +"OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED",OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; +"OPEN_IN_PCROSS",OPEN_IN_PCROSS; +"OPEN_IN_PCROSS_EQ",OPEN_IN_PCROSS_EQ; +"OPEN_IN_REFL",OPEN_IN_REFL; +"OPEN_IN_RELATIVE_INTERIOR",OPEN_IN_RELATIVE_INTERIOR; +"OPEN_IN_SET_RELATIVE_INTERIOR",OPEN_IN_SET_RELATIVE_INTERIOR; +"OPEN_IN_SING",OPEN_IN_SING; +"OPEN_IN_SUBOPEN",OPEN_IN_SUBOPEN; +"OPEN_IN_SUBSET",OPEN_IN_SUBSET; +"OPEN_IN_SUBSET_RELATIVE_INTERIOR",OPEN_IN_SUBSET_RELATIVE_INTERIOR; +"OPEN_IN_SUBSET_TRANS",OPEN_IN_SUBSET_TRANS; +"OPEN_IN_SUBTOPOLOGY",OPEN_IN_SUBTOPOLOGY; +"OPEN_IN_SUBTOPOLOGY_EMPTY",OPEN_IN_SUBTOPOLOGY_EMPTY; +"OPEN_IN_SUBTOPOLOGY_INTER_SUBSET",OPEN_IN_SUBTOPOLOGY_INTER_SUBSET; +"OPEN_IN_SUBTOPOLOGY_REFL",OPEN_IN_SUBTOPOLOGY_REFL; +"OPEN_IN_SUBTOPOLOGY_UNION",OPEN_IN_SUBTOPOLOGY_UNION; +"OPEN_IN_TOPSPACE",OPEN_IN_TOPSPACE; +"OPEN_IN_TRANS",OPEN_IN_TRANS; +"OPEN_IN_TRANSLATION_EQ",OPEN_IN_TRANSLATION_EQ; +"OPEN_IN_TRANS_EQ",OPEN_IN_TRANS_EQ; +"OPEN_IN_UNION",OPEN_IN_UNION; +"OPEN_IN_UNIONS",OPEN_IN_UNIONS; +"OPEN_LIFT",OPEN_LIFT; +"OPEN_MAP_CLOSED_SUPERSET_PREIMAGE",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE; +"OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ",OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ; +"OPEN_MAP_FROM_COMPOSITION_INJECTIVE",OPEN_MAP_FROM_COMPOSITION_INJECTIVE; +"OPEN_MAP_FROM_COMPOSITION_SURJECTIVE",OPEN_MAP_FROM_COMPOSITION_SURJECTIVE; +"OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE",OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE; +"OPEN_MAP_IMP_CLOSED_MAP",OPEN_MAP_IMP_CLOSED_MAP; +"OPEN_MAP_IMP_QUOTIENT_MAP",OPEN_MAP_IMP_QUOTIENT_MAP; +"OPEN_MAP_RESTRICT",OPEN_MAP_RESTRICT; +"OPEN_MEASURABLE_INNER_DIVISION",OPEN_MEASURABLE_INNER_DIVISION; +"OPEN_NEGATIONS",OPEN_NEGATIONS; +"OPEN_NON_GENERAL_COMPONENT",OPEN_NON_GENERAL_COMPONENT; +"OPEN_NON_PATH_COMPONENT",OPEN_NON_PATH_COMPONENT; +"OPEN_NOT_NEGLIGIBLE",OPEN_NOT_NEGLIGIBLE; +"OPEN_OPEN_IN_TRANS",OPEN_OPEN_IN_TRANS; +"OPEN_OPEN_LEFT_PROJECTION",OPEN_OPEN_LEFT_PROJECTION; +"OPEN_OPEN_RIGHT_PROJECTION",OPEN_OPEN_RIGHT_PROJECTION; +"OPEN_OUTSIDE",OPEN_OUTSIDE; +"OPEN_PATH_COMPONENT",OPEN_PATH_COMPONENT; +"OPEN_PATH_CONNECTED_COMPONENT",OPEN_PATH_CONNECTED_COMPONENT; +"OPEN_PCROSS",OPEN_PCROSS; +"OPEN_PCROSS_EQ",OPEN_PCROSS_EQ; +"OPEN_POSITIVE_MULTIPLES",OPEN_POSITIVE_MULTIPLES; +"OPEN_POSITIVE_ORTHANT",OPEN_POSITIVE_ORTHANT; +"OPEN_SCALING",OPEN_SCALING; +"OPEN_SEGMENT_1",OPEN_SEGMENT_1; +"OPEN_SEGMENT_ALT",OPEN_SEGMENT_ALT; +"OPEN_SEGMENT_LINEAR_IMAGE",OPEN_SEGMENT_LINEAR_IMAGE; +"OPEN_SET_COCOUNTABLE_COORDINATES",OPEN_SET_COCOUNTABLE_COORDINATES; +"OPEN_SET_COSMALL_COORDINATES",OPEN_SET_COSMALL_COORDINATES; +"OPEN_SET_IRRATIONAL_COORDINATES",OPEN_SET_IRRATIONAL_COORDINATES; +"OPEN_SET_RATIONAL_COORDINATES",OPEN_SET_RATIONAL_COORDINATES; +"OPEN_SUBOPEN",OPEN_SUBOPEN; +"OPEN_SUBSET",OPEN_SUBSET; +"OPEN_SUBSET_INTERIOR",OPEN_SUBSET_INTERIOR; +"OPEN_SUMS",OPEN_SUMS; +"OPEN_SURJECTIVE_LINEAR_IMAGE",OPEN_SURJECTIVE_LINEAR_IMAGE; +"OPEN_TRANSLATION",OPEN_TRANSLATION; +"OPEN_TRANSLATION_EQ",OPEN_TRANSLATION_EQ; +"OPEN_UNION",OPEN_UNION; +"OPEN_UNIONS",OPEN_UNIONS; +"OPEN_UNION_COMPACT_SUBSETS",OPEN_UNION_COMPACT_SUBSETS; +"OPEN_UNIV",OPEN_UNIV; +"OPERATIVE_1_LE",OPERATIVE_1_LE; +"OPERATIVE_1_LT",OPERATIVE_1_LT; +"OPERATIVE_APPROXIMABLE",OPERATIVE_APPROXIMABLE; +"OPERATIVE_CONTENT",OPERATIVE_CONTENT; +"OPERATIVE_DIVISION",OPERATIVE_DIVISION; +"OPERATIVE_DIVISION_AND",OPERATIVE_DIVISION_AND; +"OPERATIVE_EMPTY",OPERATIVE_EMPTY; +"OPERATIVE_FUNCTION_ENDPOINT_DIFF",OPERATIVE_FUNCTION_ENDPOINT_DIFF; +"OPERATIVE_INTEGRABLE",OPERATIVE_INTEGRABLE; +"OPERATIVE_INTEGRAL",OPERATIVE_INTEGRAL; +"OPERATIVE_LIFTED_SETVARIATION",OPERATIVE_LIFTED_SETVARIATION; +"OPERATIVE_LIFTED_VECTOR_VARIATION",OPERATIVE_LIFTED_VECTOR_VARIATION; +"OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF",OPERATIVE_REAL_FUNCTION_ENDPOINT_DIFF; +"OPERATIVE_TAGGED_DIVISION",OPERATIVE_TAGGED_DIVISION; +"OPERATIVE_TRIVIAL",OPERATIVE_TRIVIAL; +"ORDINAL_CHAINED",ORDINAL_CHAINED; +"ORDINAL_CHAINED_LEMMA",ORDINAL_CHAINED_LEMMA; +"ORDINAL_SUC",ORDINAL_SUC; +"ORDINAL_UNION",ORDINAL_UNION; +"ORDINAL_UNION_LEMMA",ORDINAL_UNION_LEMMA; +"ORDINAL_UP",ORDINAL_UP; +"ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG",ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG; +"ORTHOGONAL_0",ORTHOGONAL_0; +"ORTHOGONAL_ANY_CLOSEST_POINT",ORTHOGONAL_ANY_CLOSEST_POINT; +"ORTHOGONAL_BASIS",ORTHOGONAL_BASIS; +"ORTHOGONAL_BASIS_BASIS",ORTHOGONAL_BASIS_BASIS; +"ORTHOGONAL_BASIS_EXISTS",ORTHOGONAL_BASIS_EXISTS; +"ORTHOGONAL_BASIS_SUBSPACE",ORTHOGONAL_BASIS_SUBSPACE; +"ORTHOGONAL_CLAUSES",ORTHOGONAL_CLAUSES; +"ORTHOGONAL_EXTENSION",ORTHOGONAL_EXTENSION; +"ORTHOGONAL_EXTENSION_STRONG",ORTHOGONAL_EXTENSION_STRONG; +"ORTHOGONAL_LINEAR_IMAGE_EQ",ORTHOGONAL_LINEAR_IMAGE_EQ; +"ORTHOGONAL_LNEG",ORTHOGONAL_LNEG; +"ORTHOGONAL_LVSUM",ORTHOGONAL_LVSUM; +"ORTHOGONAL_MATRIX",ORTHOGONAL_MATRIX; +"ORTHOGONAL_MATRIX_2",ORTHOGONAL_MATRIX_2; +"ORTHOGONAL_MATRIX_2_ALT",ORTHOGONAL_MATRIX_2_ALT; +"ORTHOGONAL_MATRIX_ALT",ORTHOGONAL_MATRIX_ALT; +"ORTHOGONAL_MATRIX_EXISTS_BASIS",ORTHOGONAL_MATRIX_EXISTS_BASIS; +"ORTHOGONAL_MATRIX_ID",ORTHOGONAL_MATRIX_ID; +"ORTHOGONAL_MATRIX_INV",ORTHOGONAL_MATRIX_INV; +"ORTHOGONAL_MATRIX_MATRIX",ORTHOGONAL_MATRIX_MATRIX; +"ORTHOGONAL_MATRIX_MUL",ORTHOGONAL_MATRIX_MUL; +"ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_MATRIX_ORTHOGONAL_EIGENVECTORS; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_INDEXED; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_PAIRWISE; +"ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_COLUMNS_SPAN; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_PAIRWISE; +"ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN",ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_SPAN; +"ORTHOGONAL_MATRIX_TRANSFORMATION",ORTHOGONAL_MATRIX_TRANSFORMATION; +"ORTHOGONAL_MATRIX_TRANSP",ORTHOGONAL_MATRIX_TRANSP; +"ORTHOGONAL_MUL",ORTHOGONAL_MUL; +"ORTHOGONAL_NULLSPACE_ROWSPACE",ORTHOGONAL_NULLSPACE_ROWSPACE; +"ORTHOGONAL_REFL",ORTHOGONAL_REFL; +"ORTHOGONAL_RNEG",ORTHOGONAL_RNEG; +"ORTHOGONAL_ROTATION_OR_ROTOINVERSION",ORTHOGONAL_ROTATION_OR_ROTOINVERSION; +"ORTHOGONAL_RVSUM",ORTHOGONAL_RVSUM; +"ORTHOGONAL_SPANNINGSET_SUBSPACE",ORTHOGONAL_SPANNINGSET_SUBSPACE; +"ORTHOGONAL_SUBSPACE_DECOMP",ORTHOGONAL_SUBSPACE_DECOMP; +"ORTHOGONAL_SUBSPACE_DECOMP_EXISTS",ORTHOGONAL_SUBSPACE_DECOMP_EXISTS; +"ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE",ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE; +"ORTHOGONAL_SYM",ORTHOGONAL_SYM; +"ORTHOGONAL_TO_ORTHOGONAL_2D",ORTHOGONAL_TO_ORTHOGONAL_2D; +"ORTHOGONAL_TO_SPAN",ORTHOGONAL_TO_SPAN; +"ORTHOGONAL_TO_SPANS_EQ",ORTHOGONAL_TO_SPANS_EQ; +"ORTHOGONAL_TO_SPAN_EQ",ORTHOGONAL_TO_SPAN_EQ; +"ORTHOGONAL_TO_SUBSPACE_EXISTS",ORTHOGONAL_TO_SUBSPACE_EXISTS; +"ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN",ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN; +"ORTHOGONAL_TO_VECTOR_EXISTS",ORTHOGONAL_TO_VECTOR_EXISTS; +"ORTHOGONAL_TRANSFORMATION",ORTHOGONAL_TRANSFORMATION; +"ORTHOGONAL_TRANSFORMATION_BALL",ORTHOGONAL_TRANSFORMATION_BALL; +"ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS",ORTHOGONAL_TRANSFORMATION_BETWEEN_ORTHOGONAL_SETS; +"ORTHOGONAL_TRANSFORMATION_CBALL",ORTHOGONAL_TRANSFORMATION_CBALL; +"ORTHOGONAL_TRANSFORMATION_COMPOSE",ORTHOGONAL_TRANSFORMATION_COMPOSE; +"ORTHOGONAL_TRANSFORMATION_EXISTS",ORTHOGONAL_TRANSFORMATION_EXISTS; +"ORTHOGONAL_TRANSFORMATION_EXISTS_1",ORTHOGONAL_TRANSFORMATION_EXISTS_1; +"ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS",ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS; +"ORTHOGONAL_TRANSFORMATION_I",ORTHOGONAL_TRANSFORMATION_I; +"ORTHOGONAL_TRANSFORMATION_ID",ORTHOGONAL_TRANSFORMATION_ID; +"ORTHOGONAL_TRANSFORMATION_INJECTIVE",ORTHOGONAL_TRANSFORMATION_INJECTIVE; +"ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE; +"ORTHOGONAL_TRANSFORMATION_INVERSE",ORTHOGONAL_TRANSFORMATION_INVERSE; +"ORTHOGONAL_TRANSFORMATION_INVERSE_o",ORTHOGONAL_TRANSFORMATION_INVERSE_o; +"ORTHOGONAL_TRANSFORMATION_ISOMETRY",ORTHOGONAL_TRANSFORMATION_ISOMETRY; +"ORTHOGONAL_TRANSFORMATION_LINEAR",ORTHOGONAL_TRANSFORMATION_LINEAR; +"ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL",ORTHOGONAL_TRANSFORMATION_LOWDIM_HORIZONTAL; +"ORTHOGONAL_TRANSFORMATION_MATRIX",ORTHOGONAL_TRANSFORMATION_MATRIX; +"ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE",ORTHOGONAL_TRANSFORMATION_ONTO_SUBSPACE; +"ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS",ORTHOGONAL_TRANSFORMATION_ORTHOGONAL_EIGENVECTORS; +"ORTHOGONAL_TRANSFORMATION_SPHERE",ORTHOGONAL_TRANSFORMATION_SPHERE; +"ORTHOGONAL_TRANSFORMATION_SURJECTIVE",ORTHOGONAL_TRANSFORMATION_SURJECTIVE; +"ORTHONORMAL_BASIS_EXPAND",ORTHONORMAL_BASIS_EXPAND; +"ORTHONORMAL_BASIS_SUBSPACE",ORTHONORMAL_BASIS_SUBSPACE; +"ORTHONORMAL_EXTENSION",ORTHONORMAL_EXTENSION; +"OR_CLAUSES",OR_CLAUSES; +"OR_DEF",OR_DEF; +"OR_EXISTS_THM",OR_EXISTS_THM; +"OUTER",OUTER; +"OUTERMORPHISM_MBASIS",OUTERMORPHISM_MBASIS; +"OUTERMORPHISM_MBASIS_EMPTY",OUTERMORPHISM_MBASIS_EMPTY; +"OUTER_ACI",OUTER_ACI; +"OUTER_ASSOC",OUTER_ASSOC; +"OUTER_LADD",OUTER_LADD; +"OUTER_LMUL",OUTER_LMUL; +"OUTER_LNEG",OUTER_LNEG; +"OUTER_LZERO",OUTER_LZERO; +"OUTER_MBASIS",OUTER_MBASIS; +"OUTER_MBASIS_LSCALAR",OUTER_MBASIS_LSCALAR; +"OUTER_MBASIS_REFL",OUTER_MBASIS_REFL; +"OUTER_MBASIS_RSCALAR",OUTER_MBASIS_RSCALAR; +"OUTER_MBASIS_SING",OUTER_MBASIS_SING; +"OUTER_MBASIS_SKEWSYM",OUTER_MBASIS_SKEWSYM; +"OUTER_RADD",OUTER_RADD; +"OUTER_RMUL",OUTER_RMUL; +"OUTER_RNEG",OUTER_RNEG; +"OUTER_RZERO",OUTER_RZERO; +"OUTL",OUTL; +"OUTR",OUTR; +"OUTSIDE",OUTSIDE; +"OUTSIDE_BOUNDED_NONEMPTY",OUTSIDE_BOUNDED_NONEMPTY; +"OUTSIDE_COMPACT_IN_OPEN",OUTSIDE_COMPACT_IN_OPEN; +"OUTSIDE_CONNECTED_COMPONENT_LE",OUTSIDE_CONNECTED_COMPONENT_LE; +"OUTSIDE_CONNECTED_COMPONENT_LT",OUTSIDE_CONNECTED_COMPONENT_LT; +"OUTSIDE_CONVEX",OUTSIDE_CONVEX; +"OUTSIDE_EMPTY",OUTSIDE_EMPTY; +"OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE",OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE; +"OUTSIDE_FRONTIER_MISSES_CLOSURE",OUTSIDE_FRONTIER_MISSES_CLOSURE; +"OUTSIDE_INSIDE",OUTSIDE_INSIDE; +"OUTSIDE_IN_COMPONENTS",OUTSIDE_IN_COMPONENTS; +"OUTSIDE_LINEAR_IMAGE",OUTSIDE_LINEAR_IMAGE; +"OUTSIDE_MONO",OUTSIDE_MONO; +"OUTSIDE_NO_OVERLAP",OUTSIDE_NO_OVERLAP; +"OUTSIDE_SAME_COMPONENT",OUTSIDE_SAME_COMPONENT; +"OUTSIDE_SUBSET_CONVEX",OUTSIDE_SUBSET_CONVEX; +"OUTSIDE_TRANSLATION",OUTSIDE_TRANSLATION; +"OUTSIDE_UNION_OUTSIDE_UNION",OUTSIDE_UNION_OUTSIDE_UNION; +"PAIR",PAIR; +"PAIRED_ETA_THM",PAIRED_ETA_THM; +"PAIRED_EXT",PAIRED_EXT; +"PAIRWISE",PAIRWISE; +"PAIRWISE_DISJOINT_COMPONENTS",PAIRWISE_DISJOINT_COMPONENTS; +"PAIRWISE_EMPTY",PAIRWISE_EMPTY; +"PAIRWISE_IMAGE",PAIRWISE_IMAGE; +"PAIRWISE_INSERT",PAIRWISE_INSERT; +"PAIRWISE_MONO",PAIRWISE_MONO; +"PAIRWISE_ORTHOGONAL_IMP_FINITE",PAIRWISE_ORTHOGONAL_IMP_FINITE; +"PAIRWISE_ORTHOGONAL_INDEPENDENT",PAIRWISE_ORTHOGONAL_INDEPENDENT; +"PAIRWISE_SING",PAIRWISE_SING; +"PAIR_EQ",PAIR_EQ; +"PAIR_EXISTS_THM",PAIR_EXISTS_THM; +"PAIR_SURJECTIVE",PAIR_SURJECTIVE; +"PARACOMPACT",PARACOMPACT; +"PARACOMPACT_CLOSED",PARACOMPACT_CLOSED; +"PARACOMPACT_CLOSED_IN",PARACOMPACT_CLOSED_IN; +"PARTIAL_DIVISION_EXTEND",PARTIAL_DIVISION_EXTEND; +"PARTIAL_DIVISION_EXTEND_1",PARTIAL_DIVISION_EXTEND_1; +"PARTIAL_DIVISION_EXTEND_INTERVAL",PARTIAL_DIVISION_EXTEND_INTERVAL; +"PARTIAL_DIVISION_OF_TAGGED_DIVISION",PARTIAL_DIVISION_OF_TAGGED_DIVISION; +"PARTIAL_SUMS_COMPONENT_LE_INFSUM",PARTIAL_SUMS_COMPONENT_LE_INFSUM; +"PARTIAL_SUMS_DROP_LE_INFSUM",PARTIAL_SUMS_DROP_LE_INFSUM; +"PASSOC_DEF",PASSOC_DEF; +"PASTECART_ADD",PASTECART_ADD; +"PASTECART_AS_ORTHOGONAL_SUM",PASTECART_AS_ORTHOGONAL_SUM; +"PASTECART_CMUL",PASTECART_CMUL; +"PASTECART_EQ",PASTECART_EQ; +"PASTECART_EQ_VEC",PASTECART_EQ_VEC; +"PASTECART_FST_SND",PASTECART_FST_SND; +"PASTECART_INJ",PASTECART_INJ; +"PASTECART_IN_INTERIOR_SUBTOPOLOGY",PASTECART_IN_INTERIOR_SUBTOPOLOGY; +"PASTECART_IN_PCROSS",PASTECART_IN_PCROSS; +"PASTECART_NEG",PASTECART_NEG; +"PASTECART_SUB",PASTECART_SUB; +"PASTECART_VEC",PASTECART_VEC; +"PASTECART_VSUM",PASTECART_VSUM; +"PASTING_LEMMA",PASTING_LEMMA; +"PASTING_LEMMA_CLOSED",PASTING_LEMMA_CLOSED; +"PASTING_LEMMA_EXISTS",PASTING_LEMMA_EXISTS; +"PASTING_LEMMA_EXISTS_CLOSED",PASTING_LEMMA_EXISTS_CLOSED; +"PATHFINISH_COMPOSE",PATHFINISH_COMPOSE; +"PATHFINISH_IN_PATH_IMAGE",PATHFINISH_IN_PATH_IMAGE; +"PATHFINISH_JOIN",PATHFINISH_JOIN; +"PATHFINISH_LINEAR_IMAGE",PATHFINISH_LINEAR_IMAGE; +"PATHFINISH_LINEPATH",PATHFINISH_LINEPATH; +"PATHFINISH_REVERSEPATH",PATHFINISH_REVERSEPATH; +"PATHFINISH_SHIFTPATH",PATHFINISH_SHIFTPATH; +"PATHFINISH_SUBPATH",PATHFINISH_SUBPATH; +"PATHFINISH_TRANSLATION",PATHFINISH_TRANSLATION; +"PATHSTART_COMPOSE",PATHSTART_COMPOSE; +"PATHSTART_IN_PATH_IMAGE",PATHSTART_IN_PATH_IMAGE; +"PATHSTART_JOIN",PATHSTART_JOIN; +"PATHSTART_LINEAR_IMAGE_EQ",PATHSTART_LINEAR_IMAGE_EQ; +"PATHSTART_LINEPATH",PATHSTART_LINEPATH; +"PATHSTART_REVERSEPATH",PATHSTART_REVERSEPATH; +"PATHSTART_SHIFTPATH",PATHSTART_SHIFTPATH; +"PATHSTART_SUBPATH",PATHSTART_SUBPATH; +"PATHSTART_TRANSLATION",PATHSTART_TRANSLATION; +"PATH_ASSOC",PATH_ASSOC; +"PATH_COMPONENT",PATH_COMPONENT; +"PATH_COMPONENT_DISJOINT",PATH_COMPONENT_DISJOINT; +"PATH_COMPONENT_EMPTY",PATH_COMPONENT_EMPTY; +"PATH_COMPONENT_EQ",PATH_COMPONENT_EQ; +"PATH_COMPONENT_EQ_CONNECTED_COMPONENT",PATH_COMPONENT_EQ_CONNECTED_COMPONENT; +"PATH_COMPONENT_EQ_EMPTY",PATH_COMPONENT_EQ_EMPTY; +"PATH_COMPONENT_EQ_EQ",PATH_COMPONENT_EQ_EQ; +"PATH_COMPONENT_IMP_HOMOTOPIC_POINTS",PATH_COMPONENT_IMP_HOMOTOPIC_POINTS; +"PATH_COMPONENT_IN",PATH_COMPONENT_IN; +"PATH_COMPONENT_INTERMEDIATE_SUBSET",PATH_COMPONENT_INTERMEDIATE_SUBSET; +"PATH_COMPONENT_LINEAR_IMAGE",PATH_COMPONENT_LINEAR_IMAGE; +"PATH_COMPONENT_MAXIMAL",PATH_COMPONENT_MAXIMAL; +"PATH_COMPONENT_MONO",PATH_COMPONENT_MONO; +"PATH_COMPONENT_OF_SUBSET",PATH_COMPONENT_OF_SUBSET; +"PATH_COMPONENT_PATH_COMPONENT",PATH_COMPONENT_PATH_COMPONENT; +"PATH_COMPONENT_PATH_IMAGE_PATHSTART",PATH_COMPONENT_PATH_IMAGE_PATHSTART; +"PATH_COMPONENT_REFL",PATH_COMPONENT_REFL; +"PATH_COMPONENT_REFL_EQ",PATH_COMPONENT_REFL_EQ; +"PATH_COMPONENT_SET",PATH_COMPONENT_SET; +"PATH_COMPONENT_SUBSET",PATH_COMPONENT_SUBSET; +"PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT",PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; +"PATH_COMPONENT_SYM",PATH_COMPONENT_SYM; +"PATH_COMPONENT_SYM_EQ",PATH_COMPONENT_SYM_EQ; +"PATH_COMPONENT_TRANS",PATH_COMPONENT_TRANS; +"PATH_COMPONENT_TRANSLATION",PATH_COMPONENT_TRANSLATION; +"PATH_COMPONENT_UNIQUE",PATH_COMPONENT_UNIQUE; +"PATH_COMPONENT_UNIV",PATH_COMPONENT_UNIV; +"PATH_COMPOSE_JOIN",PATH_COMPOSE_JOIN; +"PATH_COMPOSE_REVERSEPATH",PATH_COMPOSE_REVERSEPATH; +"PATH_CONNECTED_ANNULUS",PATH_CONNECTED_ANNULUS; +"PATH_CONNECTED_ARCWISE",PATH_CONNECTED_ARCWISE; +"PATH_CONNECTED_ARC_COMPLEMENT",PATH_CONNECTED_ARC_COMPLEMENT; +"PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT",PATH_CONNECTED_COMPLEMENT_ABSOLUTE_RETRACT; +"PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX",PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX; +"PATH_CONNECTED_COMPLEMENT_CARD_LT",PATH_CONNECTED_COMPLEMENT_CARD_LT; +"PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT",PATH_CONNECTED_COMPLEMENT_HOMEOMORPHIC_CONVEX_COMPACT; +"PATH_CONNECTED_COMPONENT_SET",PATH_CONNECTED_COMPONENT_SET; +"PATH_CONNECTED_CONTINUOUS_IMAGE",PATH_CONNECTED_CONTINUOUS_IMAGE; +"PATH_CONNECTED_CONVEX_DIFF_CARD_LT",PATH_CONNECTED_CONVEX_DIFF_CARD_LT; +"PATH_CONNECTED_CONVEX_DIFF_COUNTABLE",PATH_CONNECTED_CONVEX_DIFF_COUNTABLE; +"PATH_CONNECTED_DIFF_BALL",PATH_CONNECTED_DIFF_BALL; +"PATH_CONNECTED_EMPTY",PATH_CONNECTED_EMPTY; +"PATH_CONNECTED_EQ_CONNECTED",PATH_CONNECTED_EQ_CONNECTED; +"PATH_CONNECTED_EQ_CONNECTED_LPC",PATH_CONNECTED_EQ_CONNECTED_LPC; +"PATH_CONNECTED_EQ_HOMOTOPIC_POINTS",PATH_CONNECTED_EQ_HOMOTOPIC_POINTS; +"PATH_CONNECTED_IFF_PATH_COMPONENT",PATH_CONNECTED_IFF_PATH_COMPONENT; +"PATH_CONNECTED_IMP_CONNECTED",PATH_CONNECTED_IMP_CONNECTED; +"PATH_CONNECTED_INTERVAL",PATH_CONNECTED_INTERVAL; +"PATH_CONNECTED_LINEAR_IMAGE",PATH_CONNECTED_LINEAR_IMAGE; +"PATH_CONNECTED_LINEAR_IMAGE_EQ",PATH_CONNECTED_LINEAR_IMAGE_EQ; +"PATH_CONNECTED_LINEPATH",PATH_CONNECTED_LINEPATH; +"PATH_CONNECTED_NEGATIONS",PATH_CONNECTED_NEGATIONS; +"PATH_CONNECTED_OPEN_DELETE",PATH_CONNECTED_OPEN_DELETE; +"PATH_CONNECTED_OPEN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_DIFF_CARD_LT; +"PATH_CONNECTED_OPEN_DIFF_COUNTABLE",PATH_CONNECTED_OPEN_DIFF_COUNTABLE; +"PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT",PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT; +"PATH_CONNECTED_PATH_COMPONENT",PATH_CONNECTED_PATH_COMPONENT; +"PATH_CONNECTED_PATH_IMAGE",PATH_CONNECTED_PATH_IMAGE; +"PATH_CONNECTED_PCROSS",PATH_CONNECTED_PCROSS; +"PATH_CONNECTED_PCROSS_EQ",PATH_CONNECTED_PCROSS_EQ; +"PATH_CONNECTED_PUNCTURED_BALL",PATH_CONNECTED_PUNCTURED_BALL; +"PATH_CONNECTED_PUNCTURED_CONVEX",PATH_CONNECTED_PUNCTURED_CONVEX; +"PATH_CONNECTED_PUNCTURED_UNIVERSE",PATH_CONNECTED_PUNCTURED_UNIVERSE; +"PATH_CONNECTED_SCALING",PATH_CONNECTED_SCALING; +"PATH_CONNECTED_SEGMENT",PATH_CONNECTED_SEGMENT; +"PATH_CONNECTED_SEMIOPEN_SEGMENT",PATH_CONNECTED_SEMIOPEN_SEGMENT; +"PATH_CONNECTED_SING",PATH_CONNECTED_SING; +"PATH_CONNECTED_SPHERE",PATH_CONNECTED_SPHERE; +"PATH_CONNECTED_SPHERE_EQ",PATH_CONNECTED_SPHERE_EQ; +"PATH_CONNECTED_SPHERE_GEN",PATH_CONNECTED_SPHERE_GEN; +"PATH_CONNECTED_SUMS",PATH_CONNECTED_SUMS; +"PATH_CONNECTED_TRANSLATION",PATH_CONNECTED_TRANSLATION; +"PATH_CONNECTED_TRANSLATION_EQ",PATH_CONNECTED_TRANSLATION_EQ; +"PATH_CONNECTED_UNION",PATH_CONNECTED_UNION; +"PATH_CONNECTED_UNIV",PATH_CONNECTED_UNIV; +"PATH_CONTAINS_ARC",PATH_CONTAINS_ARC; +"PATH_CONTINUOUS_IMAGE",PATH_CONTINUOUS_IMAGE; +"PATH_EQ",PATH_EQ; +"PATH_IMAGE_COMPOSE",PATH_IMAGE_COMPOSE; +"PATH_IMAGE_JOIN",PATH_IMAGE_JOIN; +"PATH_IMAGE_JOIN_SUBSET",PATH_IMAGE_JOIN_SUBSET; +"PATH_IMAGE_LINEAR_IMAGE",PATH_IMAGE_LINEAR_IMAGE; +"PATH_IMAGE_LINEPATH",PATH_IMAGE_LINEPATH; +"PATH_IMAGE_NONEMPTY",PATH_IMAGE_NONEMPTY; +"PATH_IMAGE_REVERSEPATH",PATH_IMAGE_REVERSEPATH; +"PATH_IMAGE_SHIFTPATH",PATH_IMAGE_SHIFTPATH; +"PATH_IMAGE_SUBPATH",PATH_IMAGE_SUBPATH; +"PATH_IMAGE_SUBPATH_GEN",PATH_IMAGE_SUBPATH_GEN; +"PATH_IMAGE_SUBPATH_SUBSET",PATH_IMAGE_SUBPATH_SUBSET; +"PATH_IMAGE_SYM",PATH_IMAGE_SYM; +"PATH_IMAGE_TRANSLATION",PATH_IMAGE_TRANSLATION; +"PATH_JOIN",PATH_JOIN; +"PATH_JOIN_EQ",PATH_JOIN_EQ; +"PATH_JOIN_IMP",PATH_JOIN_IMP; +"PATH_JOIN_PATH_ENDS",PATH_JOIN_PATH_ENDS; +"PATH_LENGTH_DIFFERENTIABLE",PATH_LENGTH_DIFFERENTIABLE; +"PATH_LENGTH_JOIN",PATH_LENGTH_JOIN; +"PATH_LENGTH_REVERSEPATH",PATH_LENGTH_REVERSEPATH; +"PATH_LINEAR_IMAGE_EQ",PATH_LINEAR_IMAGE_EQ; +"PATH_LINEPATH",PATH_LINEPATH; +"PATH_REVERSEPATH",PATH_REVERSEPATH; +"PATH_SHIFTPATH",PATH_SHIFTPATH; +"PATH_SUBPATH",PATH_SUBPATH; +"PATH_SYM",PATH_SYM; +"PATH_TRANSLATION_EQ",PATH_TRANSLATION_EQ; +"PCROSS",PCROSS; +"PCROSS_AS_ORTHOGONAL_SUM",PCROSS_AS_ORTHOGONAL_SUM; +"PCROSS_DIFF",PCROSS_DIFF; +"PCROSS_EMPTY",PCROSS_EMPTY; +"PCROSS_EQ",PCROSS_EQ; +"PCROSS_EQ_EMPTY",PCROSS_EQ_EMPTY; +"PCROSS_INTER",PCROSS_INTER; +"PCROSS_INTERVAL",PCROSS_INTERVAL; +"PCROSS_MONO",PCROSS_MONO; +"PCROSS_UNION",PCROSS_UNION; +"PCROSS_UNIONS",PCROSS_UNIONS; +"PCROSS_UNIONS_UNIONS",PCROSS_UNIONS_UNIONS; +"PERMUTATION",PERMUTATION; +"PERMUTATION_BIJECTIVE",PERMUTATION_BIJECTIVE; +"PERMUTATION_COMPOSE",PERMUTATION_COMPOSE; +"PERMUTATION_COMPOSE_EQ",PERMUTATION_COMPOSE_EQ; +"PERMUTATION_COMPOSE_SWAP",PERMUTATION_COMPOSE_SWAP; +"PERMUTATION_FINITE_SUPPORT",PERMUTATION_FINITE_SUPPORT; +"PERMUTATION_I",PERMUTATION_I; +"PERMUTATION_INVERSE",PERMUTATION_INVERSE; +"PERMUTATION_INVERSE_COMPOSE",PERMUTATION_INVERSE_COMPOSE; +"PERMUTATION_INVERSE_WORKS",PERMUTATION_INVERSE_WORKS; +"PERMUTATION_LEMMA",PERMUTATION_LEMMA; +"PERMUTATION_PERMUTES",PERMUTATION_PERMUTES; +"PERMUTATION_SWAP",PERMUTATION_SWAP; +"PERMUTES_BIJECTIONS",PERMUTES_BIJECTIONS; +"PERMUTES_COMPOSE",PERMUTES_COMPOSE; +"PERMUTES_EMPTY",PERMUTES_EMPTY; +"PERMUTES_FINITE_INJECTIVE",PERMUTES_FINITE_INJECTIVE; +"PERMUTES_FINITE_SURJECTIVE",PERMUTES_FINITE_SURJECTIVE; +"PERMUTES_I",PERMUTES_I; +"PERMUTES_IMAGE",PERMUTES_IMAGE; +"PERMUTES_INDUCT",PERMUTES_INDUCT; +"PERMUTES_INJECTIVE",PERMUTES_INJECTIVE; +"PERMUTES_INSERT",PERMUTES_INSERT; +"PERMUTES_INSERT_LEMMA",PERMUTES_INSERT_LEMMA; +"PERMUTES_INVERSE",PERMUTES_INVERSE; +"PERMUTES_INVERSES",PERMUTES_INVERSES; +"PERMUTES_INVERSES_o",PERMUTES_INVERSES_o; +"PERMUTES_INVERSE_EQ",PERMUTES_INVERSE_EQ; +"PERMUTES_INVERSE_INVERSE",PERMUTES_INVERSE_INVERSE; +"PERMUTES_IN_IMAGE",PERMUTES_IN_IMAGE; +"PERMUTES_IN_NUMSEG",PERMUTES_IN_NUMSEG; +"PERMUTES_NUMSET_GE",PERMUTES_NUMSET_GE; +"PERMUTES_NUMSET_LE",PERMUTES_NUMSET_LE; +"PERMUTES_SING",PERMUTES_SING; +"PERMUTES_SUBSET",PERMUTES_SUBSET; +"PERMUTES_SUPERSET",PERMUTES_SUPERSET; +"PERMUTES_SURJECTIVE",PERMUTES_SURJECTIVE; +"PERMUTES_SWAP",PERMUTES_SWAP; +"PERMUTES_UNIV",PERMUTES_UNIV; +"POINTWISE_ANTISYM",POINTWISE_ANTISYM; +"POINTWISE_MAXIMAL",POINTWISE_MAXIMAL; +"POINTWISE_MINIMAL",POINTWISE_MINIMAL; +"POLYHEDRAL_CONVEX_CONE",POLYHEDRAL_CONVEX_CONE; +"POLYHEDRON_AFFINE_HULL",POLYHEDRON_AFFINE_HULL; +"POLYHEDRON_AS_CONE_PLUS_CONV",POLYHEDRON_AS_CONE_PLUS_CONV; +"POLYHEDRON_CONVEX_CONE_HULL",POLYHEDRON_CONVEX_CONE_HULL; +"POLYHEDRON_CONVEX_HULL",POLYHEDRON_CONVEX_HULL; +"POLYHEDRON_EMPTY",POLYHEDRON_EMPTY; +"POLYHEDRON_EQ_FINITE_EXPOSED_FACES",POLYHEDRON_EQ_FINITE_EXPOSED_FACES; +"POLYHEDRON_EQ_FINITE_FACES",POLYHEDRON_EQ_FINITE_FACES; +"POLYHEDRON_HALFSPACE_GE",POLYHEDRON_HALFSPACE_GE; +"POLYHEDRON_HALFSPACE_LE",POLYHEDRON_HALFSPACE_LE; +"POLYHEDRON_HYPERPLANE",POLYHEDRON_HYPERPLANE; +"POLYHEDRON_IMP_CLOSED",POLYHEDRON_IMP_CLOSED; +"POLYHEDRON_IMP_CONVEX",POLYHEDRON_IMP_CONVEX; +"POLYHEDRON_INTER",POLYHEDRON_INTER; +"POLYHEDRON_INTERS",POLYHEDRON_INTERS; +"POLYHEDRON_INTERVAL",POLYHEDRON_INTERVAL; +"POLYHEDRON_INTER_AFFINE",POLYHEDRON_INTER_AFFINE; +"POLYHEDRON_INTER_AFFINE_MINIMAL",POLYHEDRON_INTER_AFFINE_MINIMAL; +"POLYHEDRON_INTER_AFFINE_PARALLEL",POLYHEDRON_INTER_AFFINE_PARALLEL; +"POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL",POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL; +"POLYHEDRON_INTER_POLYTOPE",POLYHEDRON_INTER_POLYTOPE; +"POLYHEDRON_LINEAR_IMAGE",POLYHEDRON_LINEAR_IMAGE; +"POLYHEDRON_LINEAR_IMAGE_EQ",POLYHEDRON_LINEAR_IMAGE_EQ; +"POLYHEDRON_NEGATIONS",POLYHEDRON_NEGATIONS; +"POLYHEDRON_POLYTOPE_SUMS",POLYHEDRON_POLYTOPE_SUMS; +"POLYHEDRON_POSITIVE_ORTHANT",POLYHEDRON_POSITIVE_ORTHANT; +"POLYHEDRON_RIDGE_TWO_FACETS",POLYHEDRON_RIDGE_TWO_FACETS; +"POLYHEDRON_SUMS",POLYHEDRON_SUMS; +"POLYHEDRON_TRANSLATION_EQ",POLYHEDRON_TRANSLATION_EQ; +"POLYHEDRON_UNIV",POLYHEDRON_UNIV; +"POLYNOMIAL_FUNCTION_ADD",POLYNOMIAL_FUNCTION_ADD; +"POLYNOMIAL_FUNCTION_CONST",POLYNOMIAL_FUNCTION_CONST; +"POLYNOMIAL_FUNCTION_FINITE_ROOTS",POLYNOMIAL_FUNCTION_FINITE_ROOTS; +"POLYNOMIAL_FUNCTION_I",POLYNOMIAL_FUNCTION_I; +"POLYNOMIAL_FUNCTION_ID",POLYNOMIAL_FUNCTION_ID; +"POLYNOMIAL_FUNCTION_INDUCT",POLYNOMIAL_FUNCTION_INDUCT; +"POLYNOMIAL_FUNCTION_LMUL",POLYNOMIAL_FUNCTION_LMUL; +"POLYNOMIAL_FUNCTION_MUL",POLYNOMIAL_FUNCTION_MUL; +"POLYNOMIAL_FUNCTION_NEG",POLYNOMIAL_FUNCTION_NEG; +"POLYNOMIAL_FUNCTION_POW",POLYNOMIAL_FUNCTION_POW; +"POLYNOMIAL_FUNCTION_RMUL",POLYNOMIAL_FUNCTION_RMUL; +"POLYNOMIAL_FUNCTION_SUB",POLYNOMIAL_FUNCTION_SUB; +"POLYNOMIAL_FUNCTION_SUM",POLYNOMIAL_FUNCTION_SUM; +"POLYNOMIAL_FUNCTION_o",POLYNOMIAL_FUNCTION_o; +"POLYTOPE_CONVEX_HULL",POLYTOPE_CONVEX_HULL; +"POLYTOPE_EMPTY",POLYTOPE_EMPTY; +"POLYTOPE_EQ_BOUNDED_POLYHEDRON",POLYTOPE_EQ_BOUNDED_POLYHEDRON; +"POLYTOPE_FACET_EXISTS",POLYTOPE_FACET_EXISTS; +"POLYTOPE_FACET_LOWER_BOUND",POLYTOPE_FACET_LOWER_BOUND; +"POLYTOPE_IMP_BOUNDED",POLYTOPE_IMP_BOUNDED; +"POLYTOPE_IMP_CLOSED",POLYTOPE_IMP_CLOSED; +"POLYTOPE_IMP_COMPACT",POLYTOPE_IMP_COMPACT; +"POLYTOPE_IMP_CONVEX",POLYTOPE_IMP_CONVEX; +"POLYTOPE_IMP_POLYHEDRON",POLYTOPE_IMP_POLYHEDRON; +"POLYTOPE_INTER",POLYTOPE_INTER; +"POLYTOPE_INTERVAL",POLYTOPE_INTERVAL; +"POLYTOPE_INTER_POLYHEDRON",POLYTOPE_INTER_POLYHEDRON; +"POLYTOPE_LINEAR_IMAGE",POLYTOPE_LINEAR_IMAGE; +"POLYTOPE_LINEAR_IMAGE_EQ",POLYTOPE_LINEAR_IMAGE_EQ; +"POLYTOPE_NEGATIONS",POLYTOPE_NEGATIONS; +"POLYTOPE_PCROSS",POLYTOPE_PCROSS; +"POLYTOPE_PCROSS_EQ",POLYTOPE_PCROSS_EQ; +"POLYTOPE_SCALING",POLYTOPE_SCALING; +"POLYTOPE_SCALING_EQ",POLYTOPE_SCALING_EQ; +"POLYTOPE_SING",POLYTOPE_SING; +"POLYTOPE_SUMS",POLYTOPE_SUMS; +"POLYTOPE_TRANSLATION_EQ",POLYTOPE_TRANSLATION_EQ; +"POLYTOPE_UNION_CONVEX_HULL_FACETS",POLYTOPE_UNION_CONVEX_HULL_FACETS; +"POLYTOPE_VERTEX_LOWER_BOUND",POLYTOPE_VERTEX_LOWER_BOUND; +"POSET_ANTISYM",POSET_ANTISYM; +"POSET_FLEQ",POSET_FLEQ; +"POSET_REFL",POSET_REFL; +"POSET_RESTRICTED_SUBSET",POSET_RESTRICTED_SUBSET; +"POSET_TRANS",POSET_TRANS; +"POWERSET_CLAUSES",POWERSET_CLAUSES; +"POW_2_SQRT",POW_2_SQRT; +"POW_2_SQRT_ABS",POW_2_SQRT_ABS; +"PRE",PRE; +"PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE",PRESERVES_LEBESGUE_MEASURABLE_IMP_PRESERVES_NEGLIGIBLE; +"PRESERVES_NORM_INJECTIVE",PRESERVES_NORM_INJECTIVE; +"PRESERVES_NORM_PRESERVES_DOT",PRESERVES_NORM_PRESERVES_DOT; +"PRE_ELIM_THM",PRE_ELIM_THM; +"PRE_ELIM_THM'",PRE_ELIM_THM'; +"PRODUCT_1",PRODUCT_1; +"PRODUCT_2",PRODUCT_2; +"PRODUCT_3",PRODUCT_3; +"PRODUCT_4",PRODUCT_4; +"PRODUCT_ABS",PRODUCT_ABS; +"PRODUCT_ADD_SPLIT",PRODUCT_ADD_SPLIT; +"PRODUCT_ASSOCIATIVE",PRODUCT_ASSOCIATIVE; +"PRODUCT_CLAUSES",PRODUCT_CLAUSES; +"PRODUCT_CLAUSES_LEFT",PRODUCT_CLAUSES_LEFT; +"PRODUCT_CLAUSES_NUMSEG",PRODUCT_CLAUSES_NUMSEG; +"PRODUCT_CLAUSES_RIGHT",PRODUCT_CLAUSES_RIGHT; +"PRODUCT_CLOSED",PRODUCT_CLOSED; +"PRODUCT_CONST",PRODUCT_CONST; +"PRODUCT_CONST_NUMSEG",PRODUCT_CONST_NUMSEG; +"PRODUCT_CONST_NUMSEG_1",PRODUCT_CONST_NUMSEG_1; +"PRODUCT_DELETE",PRODUCT_DELETE; +"PRODUCT_DIV",PRODUCT_DIV; +"PRODUCT_DIV_NUMSEG",PRODUCT_DIV_NUMSEG; +"PRODUCT_EQ",PRODUCT_EQ; +"PRODUCT_EQ_0",PRODUCT_EQ_0; +"PRODUCT_EQ_0_NUMSEG",PRODUCT_EQ_0_NUMSEG; +"PRODUCT_EQ_1",PRODUCT_EQ_1; +"PRODUCT_EQ_1_NUMSEG",PRODUCT_EQ_1_NUMSEG; +"PRODUCT_EQ_NUMSEG",PRODUCT_EQ_NUMSEG; +"PRODUCT_IMAGE",PRODUCT_IMAGE; +"PRODUCT_INV",PRODUCT_INV; +"PRODUCT_LADD",PRODUCT_LADD; +"PRODUCT_LE",PRODUCT_LE; +"PRODUCT_LE_1",PRODUCT_LE_1; +"PRODUCT_LE_NUMSEG",PRODUCT_LE_NUMSEG; +"PRODUCT_LMUL",PRODUCT_LMUL; +"PRODUCT_LNEG",PRODUCT_LNEG; +"PRODUCT_LZERO",PRODUCT_LZERO; +"PRODUCT_MBASIS",PRODUCT_MBASIS; +"PRODUCT_MBASIS_SING",PRODUCT_MBASIS_SING; +"PRODUCT_MUL",PRODUCT_MUL; +"PRODUCT_MUL_NUMSEG",PRODUCT_MUL_NUMSEG; +"PRODUCT_NEG",PRODUCT_NEG; +"PRODUCT_NEG_NUMSEG",PRODUCT_NEG_NUMSEG; +"PRODUCT_NEG_NUMSEG_1",PRODUCT_NEG_NUMSEG_1; +"PRODUCT_OFFSET",PRODUCT_OFFSET; +"PRODUCT_ONE",PRODUCT_ONE; +"PRODUCT_PAIR",PRODUCT_PAIR; +"PRODUCT_PERMUTE",PRODUCT_PERMUTE; +"PRODUCT_PERMUTE_NUMSEG",PRODUCT_PERMUTE_NUMSEG; +"PRODUCT_POS_LE",PRODUCT_POS_LE; +"PRODUCT_POS_LE_NUMSEG",PRODUCT_POS_LE_NUMSEG; +"PRODUCT_POS_LT",PRODUCT_POS_LT; +"PRODUCT_POS_LT_NUMSEG",PRODUCT_POS_LT_NUMSEG; +"PRODUCT_RADD",PRODUCT_RADD; +"PRODUCT_RMUL",PRODUCT_RMUL; +"PRODUCT_RNEG",PRODUCT_RNEG; +"PRODUCT_RZERO",PRODUCT_RZERO; +"PRODUCT_SING",PRODUCT_SING; +"PRODUCT_SING_NUMSEG",PRODUCT_SING_NUMSEG; +"PRODUCT_SUPERSET",PRODUCT_SUPERSET; +"PRODUCT_SUPPORT",PRODUCT_SUPPORT; +"PRODUCT_UNION",PRODUCT_UNION; +"PROPERTY_EMPTY_INTERVAL",PROPERTY_EMPTY_INTERVAL; +"PROPER_MAP",PROPER_MAP; +"PROPER_MAP_COMPOSE",PROPER_MAP_COMPOSE; +"PROPER_MAP_FROM_COMPACT",PROPER_MAP_FROM_COMPACT; +"PROPER_MAP_FROM_COMPOSITION_LEFT",PROPER_MAP_FROM_COMPOSITION_LEFT; +"PROPER_MAP_FROM_COMPOSITION_RIGHT",PROPER_MAP_FROM_COMPOSITION_RIGHT; +"PROPER_MAP_FSTCART",PROPER_MAP_FSTCART; +"PROPER_MAP_SNDCART",PROPER_MAP_SNDCART; +"PSUBSET",PSUBSET; +"PSUBSET_ALT",PSUBSET_ALT; +"PSUBSET_INSERT_SUBSET",PSUBSET_INSERT_SUBSET; +"PSUBSET_IRREFL",PSUBSET_IRREFL; +"PSUBSET_MEMBER",PSUBSET_MEMBER; +"PSUBSET_SUBSET_TRANS",PSUBSET_SUBSET_TRANS; +"PSUBSET_TRANS",PSUBSET_TRANS; +"PSUBSET_UNIV",PSUBSET_UNIV; +"P_HULL",P_HULL; +"Product_DEF",Product_DEF; +"QUANTIFY_SURJECTION_HIGHER_THM",QUANTIFY_SURJECTION_HIGHER_THM; +"QUANTIFY_SURJECTION_THM",QUANTIFY_SURJECTION_THM; +"QUASICOMPACT_OPEN_CLOSED",QUASICOMPACT_OPEN_CLOSED; +"QUOTIENT_MAP_CLOSED_MAP_EQ",QUOTIENT_MAP_CLOSED_MAP_EQ; +"QUOTIENT_MAP_COMPOSE",QUOTIENT_MAP_COMPOSE; +"QUOTIENT_MAP_FROM_COMPOSITION",QUOTIENT_MAP_FROM_COMPOSITION; +"QUOTIENT_MAP_FROM_SUBSET",QUOTIENT_MAP_FROM_SUBSET; +"QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED",QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED; +"QUOTIENT_MAP_IMP_CONTINUOUS_OPEN",QUOTIENT_MAP_IMP_CONTINUOUS_OPEN; +"QUOTIENT_MAP_OPEN_CLOSED",QUOTIENT_MAP_OPEN_CLOSED; +"QUOTIENT_MAP_OPEN_MAP_EQ",QUOTIENT_MAP_OPEN_MAP_EQ; +"QUOTIENT_MAP_RESTRICT",QUOTIENT_MAP_RESTRICT; +"RADON",RADON; +"RADON_EX_LEMMA",RADON_EX_LEMMA; +"RADON_PARTITION",RADON_PARTITION; +"RADON_S_LEMMA",RADON_S_LEMMA; +"RADON_V_LEMMA",RADON_V_LEMMA; +"RANK_0",RANK_0; +"RANK_BOUND",RANK_BOUND; +"RANK_COFACTOR",RANK_COFACTOR; +"RANK_COFACTOR_EQ_1",RANK_COFACTOR_EQ_1; +"RANK_COFACTOR_EQ_FULL",RANK_COFACTOR_EQ_FULL; +"RANK_DIM_IM",RANK_DIM_IM; +"RANK_EQ_0",RANK_EQ_0; +"RANK_EQ_FULL_DET",RANK_EQ_FULL_DET; +"RANK_GRAM",RANK_GRAM; +"RANK_I",RANK_I; +"RANK_MUL_LE_LEFT",RANK_MUL_LE_LEFT; +"RANK_MUL_LE_RIGHT",RANK_MUL_LE_RIGHT; +"RANK_NULLSPACE",RANK_NULLSPACE; +"RANK_ROW",RANK_ROW; +"RANK_SYLVESTER",RANK_SYLVESTER; +"RANK_TRANSP",RANK_TRANSP; +"RANK_TRIANGLE",RANK_TRIANGLE; +"RATIONAL_ABS",RATIONAL_ABS; +"RATIONAL_ADD",RATIONAL_ADD; +"RATIONAL_ALT",RATIONAL_ALT; +"RATIONAL_APPROXIMATION",RATIONAL_APPROXIMATION; +"RATIONAL_APPROXIMATION_STRADDLE",RATIONAL_APPROXIMATION_STRADDLE; +"RATIONAL_BETWEEN",RATIONAL_BETWEEN; +"RATIONAL_CLOSED",RATIONAL_CLOSED; +"RATIONAL_DIV",RATIONAL_DIV; +"RATIONAL_INTEGER",RATIONAL_INTEGER; +"RATIONAL_INV",RATIONAL_INV; +"RATIONAL_INV_EQ",RATIONAL_INV_EQ; +"RATIONAL_MUL",RATIONAL_MUL; +"RATIONAL_NEG",RATIONAL_NEG; +"RATIONAL_NEG_EQ",RATIONAL_NEG_EQ; +"RATIONAL_NUM",RATIONAL_NUM; +"RATIONAL_POW",RATIONAL_POW; +"RATIONAL_SUB",RATIONAL_SUB; +"RAT_LEMMA1",RAT_LEMMA1; +"RAT_LEMMA2",RAT_LEMMA2; +"RAT_LEMMA3",RAT_LEMMA3; +"RAT_LEMMA4",RAT_LEMMA4; +"RAT_LEMMA5",RAT_LEMMA5; +"RAY_TO_FRONTIER",RAY_TO_FRONTIER; +"RAY_TO_RELATIVE_FRONTIER",RAY_TO_RELATIVE_FRONTIER; +"REAL_ABS_0",REAL_ABS_0; +"REAL_ABS_1",REAL_ABS_1; +"REAL_ABS_ABS",REAL_ABS_ABS; +"REAL_ABS_BETWEEN",REAL_ABS_BETWEEN; +"REAL_ABS_BETWEEN1",REAL_ABS_BETWEEN1; +"REAL_ABS_BETWEEN2",REAL_ABS_BETWEEN2; +"REAL_ABS_BOUND",REAL_ABS_BOUND; +"REAL_ABS_BOUNDS",REAL_ABS_BOUNDS; +"REAL_ABS_CASES",REAL_ABS_CASES; +"REAL_ABS_CIRCLE",REAL_ABS_CIRCLE; +"REAL_ABS_DIV",REAL_ABS_DIV; +"REAL_ABS_INFNORM",REAL_ABS_INFNORM; +"REAL_ABS_INF_LE",REAL_ABS_INF_LE; +"REAL_ABS_INTEGER_LEMMA",REAL_ABS_INTEGER_LEMMA; +"REAL_ABS_INV",REAL_ABS_INV; +"REAL_ABS_LE",REAL_ABS_LE; +"REAL_ABS_MUL",REAL_ABS_MUL; +"REAL_ABS_NEG",REAL_ABS_NEG; +"REAL_ABS_NORM",REAL_ABS_NORM; +"REAL_ABS_NUM",REAL_ABS_NUM; +"REAL_ABS_NZ",REAL_ABS_NZ; +"REAL_ABS_POS",REAL_ABS_POS; +"REAL_ABS_POW",REAL_ABS_POW; +"REAL_ABS_REFL",REAL_ABS_REFL; +"REAL_ABS_SGN",REAL_ABS_SGN; +"REAL_ABS_SIGN",REAL_ABS_SIGN; +"REAL_ABS_SIGN2",REAL_ABS_SIGN2; +"REAL_ABS_STILLNZ",REAL_ABS_STILLNZ; +"REAL_ABS_SUB",REAL_ABS_SUB; +"REAL_ABS_SUB_ABS",REAL_ABS_SUB_ABS; +"REAL_ABS_SUB_INFNORM",REAL_ABS_SUB_INFNORM; +"REAL_ABS_SUB_NORM",REAL_ABS_SUB_NORM; +"REAL_ABS_SUP_LE",REAL_ABS_SUP_LE; +"REAL_ABS_TRIANGLE",REAL_ABS_TRIANGLE; +"REAL_ABS_TRIANGLE_LE",REAL_ABS_TRIANGLE_LE; +"REAL_ABS_TRIANGLE_LT",REAL_ABS_TRIANGLE_LT; +"REAL_ABS_ZERO",REAL_ABS_ZERO; +"REAL_ADD2_SUB2",REAL_ADD2_SUB2; +"REAL_ADD_AC",REAL_ADD_AC; +"REAL_ADD_ASSOC",REAL_ADD_ASSOC; +"REAL_ADD_LDISTRIB",REAL_ADD_LDISTRIB; +"REAL_ADD_LID",REAL_ADD_LID; +"REAL_ADD_LINV",REAL_ADD_LINV; +"REAL_ADD_RDISTRIB",REAL_ADD_RDISTRIB; +"REAL_ADD_RID",REAL_ADD_RID; +"REAL_ADD_RINV",REAL_ADD_RINV; +"REAL_ADD_SUB",REAL_ADD_SUB; +"REAL_ADD_SUB2",REAL_ADD_SUB2; +"REAL_ADD_SYM",REAL_ADD_SYM; +"REAL_AFFINITY_EQ",REAL_AFFINITY_EQ; +"REAL_AFFINITY_LE",REAL_AFFINITY_LE; +"REAL_AFFINITY_LT",REAL_AFFINITY_LT; +"REAL_ARCH",REAL_ARCH; +"REAL_ARCH_INV",REAL_ARCH_INV; +"REAL_ARCH_LT",REAL_ARCH_LT; +"REAL_ARCH_POW",REAL_ARCH_POW; +"REAL_ARCH_POW2",REAL_ARCH_POW2; +"REAL_ARCH_POW_INV",REAL_ARCH_POW_INV; +"REAL_ARCH_RDIV_EQ_0",REAL_ARCH_RDIV_EQ_0; +"REAL_ARCH_SIMPLE",REAL_ARCH_SIMPLE; +"REAL_BOUNDS_LE",REAL_BOUNDS_LE; +"REAL_BOUNDS_LT",REAL_BOUNDS_LT; +"REAL_CARD_INTSEG_INT",REAL_CARD_INTSEG_INT; +"REAL_COMPLETE",REAL_COMPLETE; +"REAL_COMPLETE_SOMEPOS",REAL_COMPLETE_SOMEPOS; +"REAL_CONVEX_BOUND2_LT",REAL_CONVEX_BOUND2_LT; +"REAL_CONVEX_BOUND_LE",REAL_CONVEX_BOUND_LE; +"REAL_CONVEX_BOUND_LT",REAL_CONVEX_BOUND_LT; +"REAL_DIFFSQ",REAL_DIFFSQ; +"REAL_DIV_1",REAL_DIV_1; +"REAL_DIV_EQ_0",REAL_DIV_EQ_0; +"REAL_DIV_LMUL",REAL_DIV_LMUL; +"REAL_DIV_POW2",REAL_DIV_POW2; +"REAL_DIV_POW2_ALT",REAL_DIV_POW2_ALT; +"REAL_DIV_REFL",REAL_DIV_REFL; +"REAL_DIV_RMUL",REAL_DIV_RMUL; +"REAL_DIV_SQRT",REAL_DIV_SQRT; +"REAL_DOWN",REAL_DOWN; +"REAL_DOWN2",REAL_DOWN2; +"REAL_ENTIRE",REAL_ENTIRE; +"REAL_EQ_ADD_LCANCEL",REAL_EQ_ADD_LCANCEL; +"REAL_EQ_ADD_LCANCEL_0",REAL_EQ_ADD_LCANCEL_0; +"REAL_EQ_ADD_RCANCEL",REAL_EQ_ADD_RCANCEL; +"REAL_EQ_ADD_RCANCEL_0",REAL_EQ_ADD_RCANCEL_0; +"REAL_EQ_AFFINITY",REAL_EQ_AFFINITY; +"REAL_EQ_IMP_LE",REAL_EQ_IMP_LE; +"REAL_EQ_INTEGERS",REAL_EQ_INTEGERS; +"REAL_EQ_INTEGERS_IMP",REAL_EQ_INTEGERS_IMP; +"REAL_EQ_INV2",REAL_EQ_INV2; +"REAL_EQ_LCANCEL_IMP",REAL_EQ_LCANCEL_IMP; +"REAL_EQ_LDIV_EQ",REAL_EQ_LDIV_EQ; +"REAL_EQ_MUL_LCANCEL",REAL_EQ_MUL_LCANCEL; +"REAL_EQ_MUL_RCANCEL",REAL_EQ_MUL_RCANCEL; +"REAL_EQ_NEG2",REAL_EQ_NEG2; +"REAL_EQ_RCANCEL_IMP",REAL_EQ_RCANCEL_IMP; +"REAL_EQ_RDIV_EQ",REAL_EQ_RDIV_EQ; +"REAL_EQ_SGN_ABS",REAL_EQ_SGN_ABS; +"REAL_EQ_SQUARE_ABS",REAL_EQ_SQUARE_ABS; +"REAL_EQ_SUB_LADD",REAL_EQ_SUB_LADD; +"REAL_EQ_SUB_RADD",REAL_EQ_SUB_RADD; +"REAL_FLOOR_ADD",REAL_FLOOR_ADD; +"REAL_FLOOR_EQ",REAL_FLOOR_EQ; +"REAL_FLOOR_LE",REAL_FLOOR_LE; +"REAL_FLOOR_LT",REAL_FLOOR_LT; +"REAL_FLOOR_REFL",REAL_FLOOR_REFL; +"REAL_FRAC_ADD",REAL_FRAC_ADD; +"REAL_FRAC_EQ",REAL_FRAC_EQ; +"REAL_FRAC_EQ_0",REAL_FRAC_EQ_0; +"REAL_FRAC_POS_LT",REAL_FRAC_POS_LT; +"REAL_FRAC_ZERO",REAL_FRAC_ZERO; +"REAL_HALF",REAL_HALF; +"REAL_HAUSDIST_LE",REAL_HAUSDIST_LE; +"REAL_HAUSDIST_LE_EQ",REAL_HAUSDIST_LE_EQ; +"REAL_HAUSDIST_LE_SUMS",REAL_HAUSDIST_LE_SUMS; +"REAL_HREAL_LEMMA1",REAL_HREAL_LEMMA1; +"REAL_HREAL_LEMMA2",REAL_HREAL_LEMMA2; +"REAL_INF_ASCLOSE",REAL_INF_ASCLOSE; +"REAL_INF_BOUNDS",REAL_INF_BOUNDS; +"REAL_INF_LE",REAL_INF_LE; +"REAL_INF_LE_FINITE",REAL_INF_LE_FINITE; +"REAL_INF_LT_FINITE",REAL_INF_LT_FINITE; +"REAL_INF_UNIQUE",REAL_INF_UNIQUE; +"REAL_INV_0",REAL_INV_0; +"REAL_INV_1",REAL_INV_1; +"REAL_INV_1_LE",REAL_INV_1_LE; +"REAL_INV_1_LT",REAL_INV_1_LT; +"REAL_INV_DIV",REAL_INV_DIV; +"REAL_INV_EQ_0",REAL_INV_EQ_0; +"REAL_INV_EQ_1",REAL_INV_EQ_1; +"REAL_INV_INV",REAL_INV_INV; +"REAL_INV_LE_1",REAL_INV_LE_1; +"REAL_INV_LT_1",REAL_INV_LT_1; +"REAL_INV_MUL",REAL_INV_MUL; +"REAL_INV_NEG",REAL_INV_NEG; +"REAL_INV_POW",REAL_INV_POW; +"REAL_INV_SGN",REAL_INV_SGN; +"REAL_LET_ADD",REAL_LET_ADD; +"REAL_LET_ADD2",REAL_LET_ADD2; +"REAL_LET_ANTISYM",REAL_LET_ANTISYM; +"REAL_LET_BETWEEN",REAL_LET_BETWEEN; +"REAL_LET_TOTAL",REAL_LET_TOTAL; +"REAL_LET_TRANS",REAL_LET_TRANS; +"REAL_LE_01",REAL_LE_01; +"REAL_LE_ADD",REAL_LE_ADD; +"REAL_LE_ADD2",REAL_LE_ADD2; +"REAL_LE_ADDL",REAL_LE_ADDL; +"REAL_LE_ADDR",REAL_LE_ADDR; +"REAL_LE_AFFINITY",REAL_LE_AFFINITY; +"REAL_LE_ANTISYM",REAL_LE_ANTISYM; +"REAL_LE_BETWEEN",REAL_LE_BETWEEN; +"REAL_LE_CASES_INTEGERS",REAL_LE_CASES_INTEGERS; +"REAL_LE_DIV",REAL_LE_DIV; +"REAL_LE_DIV2_EQ",REAL_LE_DIV2_EQ; +"REAL_LE_DOUBLE",REAL_LE_DOUBLE; +"REAL_LE_FLOOR",REAL_LE_FLOOR; +"REAL_LE_HAUSDIST",REAL_LE_HAUSDIST; +"REAL_LE_INF",REAL_LE_INF; +"REAL_LE_INF_EQ",REAL_LE_INF_EQ; +"REAL_LE_INF_FINITE",REAL_LE_INF_FINITE; +"REAL_LE_INF_SUBSET",REAL_LE_INF_SUBSET; +"REAL_LE_INTEGERS",REAL_LE_INTEGERS; +"REAL_LE_INV",REAL_LE_INV; +"REAL_LE_INV2",REAL_LE_INV2; +"REAL_LE_INV_EQ",REAL_LE_INV_EQ; +"REAL_LE_LADD",REAL_LE_LADD; +"REAL_LE_LADD_IMP",REAL_LE_LADD_IMP; +"REAL_LE_LCANCEL_IMP",REAL_LE_LCANCEL_IMP; +"REAL_LE_LDIV_EQ",REAL_LE_LDIV_EQ; +"REAL_LE_LINV",REAL_LE_LINV; +"REAL_LE_LMUL",REAL_LE_LMUL; +"REAL_LE_LMUL_EQ",REAL_LE_LMUL_EQ; +"REAL_LE_LNEG",REAL_LE_LNEG; +"REAL_LE_LSQRT",REAL_LE_LSQRT; +"REAL_LE_LT",REAL_LE_LT; +"REAL_LE_MAX",REAL_LE_MAX; +"REAL_LE_MIN",REAL_LE_MIN; +"REAL_LE_MUL",REAL_LE_MUL; +"REAL_LE_MUL2",REAL_LE_MUL2; +"REAL_LE_MUL_EQ",REAL_LE_MUL_EQ; +"REAL_LE_NEG",REAL_LE_NEG; +"REAL_LE_NEG2",REAL_LE_NEG2; +"REAL_LE_NEGL",REAL_LE_NEGL; +"REAL_LE_NEGR",REAL_LE_NEGR; +"REAL_LE_NEGTOTAL",REAL_LE_NEGTOTAL; +"REAL_LE_POW2",REAL_LE_POW2; +"REAL_LE_POW_2",REAL_LE_POW_2; +"REAL_LE_RADD",REAL_LE_RADD; +"REAL_LE_RCANCEL_IMP",REAL_LE_RCANCEL_IMP; +"REAL_LE_RDIV_EQ",REAL_LE_RDIV_EQ; +"REAL_LE_REFL",REAL_LE_REFL; +"REAL_LE_REVERSE_INTEGERS",REAL_LE_REVERSE_INTEGERS; +"REAL_LE_RINV",REAL_LE_RINV; +"REAL_LE_RMUL",REAL_LE_RMUL; +"REAL_LE_RMUL_EQ",REAL_LE_RMUL_EQ; +"REAL_LE_RNEG",REAL_LE_RNEG; +"REAL_LE_RSQRT",REAL_LE_RSQRT; +"REAL_LE_SETDIST",REAL_LE_SETDIST; +"REAL_LE_SETDIST_EQ",REAL_LE_SETDIST_EQ; +"REAL_LE_SQUARE",REAL_LE_SQUARE; +"REAL_LE_SQUARE_ABS",REAL_LE_SQUARE_ABS; +"REAL_LE_SUB_LADD",REAL_LE_SUB_LADD; +"REAL_LE_SUB_RADD",REAL_LE_SUB_RADD; +"REAL_LE_SUP",REAL_LE_SUP; +"REAL_LE_SUP_FINITE",REAL_LE_SUP_FINITE; +"REAL_LE_TOTAL",REAL_LE_TOTAL; +"REAL_LE_TRANS",REAL_LE_TRANS; +"REAL_LNEG_UNIQ",REAL_LNEG_UNIQ; +"REAL_LSQRT_LE",REAL_LSQRT_LE; +"REAL_LTE_ADD",REAL_LTE_ADD; +"REAL_LTE_ADD2",REAL_LTE_ADD2; +"REAL_LTE_ANTISYM",REAL_LTE_ANTISYM; +"REAL_LTE_BETWEEN",REAL_LTE_BETWEEN; +"REAL_LTE_TOTAL",REAL_LTE_TOTAL; +"REAL_LTE_TRANS",REAL_LTE_TRANS; +"REAL_LT_01",REAL_LT_01; +"REAL_LT_ADD",REAL_LT_ADD; +"REAL_LT_ADD1",REAL_LT_ADD1; +"REAL_LT_ADD2",REAL_LT_ADD2; +"REAL_LT_ADDL",REAL_LT_ADDL; +"REAL_LT_ADDNEG",REAL_LT_ADDNEG; +"REAL_LT_ADDNEG2",REAL_LT_ADDNEG2; +"REAL_LT_ADDR",REAL_LT_ADDR; +"REAL_LT_ADD_SUB",REAL_LT_ADD_SUB; +"REAL_LT_AFFINITY",REAL_LT_AFFINITY; +"REAL_LT_ANTISYM",REAL_LT_ANTISYM; +"REAL_LT_BETWEEN",REAL_LT_BETWEEN; +"REAL_LT_DIV",REAL_LT_DIV; +"REAL_LT_DIV2_EQ",REAL_LT_DIV2_EQ; +"REAL_LT_GT",REAL_LT_GT; +"REAL_LT_IMP_LE",REAL_LT_IMP_LE; +"REAL_LT_IMP_NE",REAL_LT_IMP_NE; +"REAL_LT_IMP_NZ",REAL_LT_IMP_NZ; +"REAL_LT_INF_FINITE",REAL_LT_INF_FINITE; +"REAL_LT_INTEGERS",REAL_LT_INTEGERS; +"REAL_LT_INV",REAL_LT_INV; +"REAL_LT_INV2",REAL_LT_INV2; +"REAL_LT_INV_EQ",REAL_LT_INV_EQ; +"REAL_LT_LADD",REAL_LT_LADD; +"REAL_LT_LADD_IMP",REAL_LT_LADD_IMP; +"REAL_LT_LCANCEL_IMP",REAL_LT_LCANCEL_IMP; +"REAL_LT_LDIV_EQ",REAL_LT_LDIV_EQ; +"REAL_LT_LE",REAL_LT_LE; +"REAL_LT_LINV",REAL_LT_LINV; +"REAL_LT_LMUL",REAL_LT_LMUL; +"REAL_LT_LMUL_EQ",REAL_LT_LMUL_EQ; +"REAL_LT_LNEG",REAL_LT_LNEG; +"REAL_LT_LSQRT",REAL_LT_LSQRT; +"REAL_LT_MAX",REAL_LT_MAX; +"REAL_LT_MIN",REAL_LT_MIN; +"REAL_LT_MUL",REAL_LT_MUL; +"REAL_LT_MUL2",REAL_LT_MUL2; +"REAL_LT_MUL_EQ",REAL_LT_MUL_EQ; +"REAL_LT_NEG",REAL_LT_NEG; +"REAL_LT_NEG2",REAL_LT_NEG2; +"REAL_LT_NEGTOTAL",REAL_LT_NEGTOTAL; +"REAL_LT_POW2",REAL_LT_POW2; +"REAL_LT_POW_2",REAL_LT_POW_2; +"REAL_LT_RADD",REAL_LT_RADD; +"REAL_LT_RCANCEL_IMP",REAL_LT_RCANCEL_IMP; +"REAL_LT_RDIV_EQ",REAL_LT_RDIV_EQ; +"REAL_LT_REFL",REAL_LT_REFL; +"REAL_LT_RINV",REAL_LT_RINV; +"REAL_LT_RMUL",REAL_LT_RMUL; +"REAL_LT_RMUL_EQ",REAL_LT_RMUL_EQ; +"REAL_LT_RNEG",REAL_LT_RNEG; +"REAL_LT_RSQRT",REAL_LT_RSQRT; +"REAL_LT_SQUARE",REAL_LT_SQUARE; +"REAL_LT_SQUARE_ABS",REAL_LT_SQUARE_ABS; +"REAL_LT_SUB_LADD",REAL_LT_SUB_LADD; +"REAL_LT_SUB_RADD",REAL_LT_SUB_RADD; +"REAL_LT_SUP_FINITE",REAL_LT_SUP_FINITE; +"REAL_LT_TOTAL",REAL_LT_TOTAL; +"REAL_LT_TRANS",REAL_LT_TRANS; +"REAL_MAX_ACI",REAL_MAX_ACI; +"REAL_MAX_ASSOC",REAL_MAX_ASSOC; +"REAL_MAX_LE",REAL_MAX_LE; +"REAL_MAX_LT",REAL_MAX_LT; +"REAL_MAX_MAX",REAL_MAX_MAX; +"REAL_MAX_MIN",REAL_MAX_MIN; +"REAL_MAX_SUP",REAL_MAX_SUP; +"REAL_MAX_SYM",REAL_MAX_SYM; +"REAL_MIN_ACI",REAL_MIN_ACI; +"REAL_MIN_ASSOC",REAL_MIN_ASSOC; +"REAL_MIN_INF",REAL_MIN_INF; +"REAL_MIN_LE",REAL_MIN_LE; +"REAL_MIN_LT",REAL_MIN_LT; +"REAL_MIN_MAX",REAL_MIN_MAX; +"REAL_MIN_MIN",REAL_MIN_MIN; +"REAL_MIN_SYM",REAL_MIN_SYM; +"REAL_MUL_2",REAL_MUL_2; +"REAL_MUL_AC",REAL_MUL_AC; +"REAL_MUL_ASSOC",REAL_MUL_ASSOC; +"REAL_MUL_LID",REAL_MUL_LID; +"REAL_MUL_LINV",REAL_MUL_LINV; +"REAL_MUL_LINV_UNIQ",REAL_MUL_LINV_UNIQ; +"REAL_MUL_LNEG",REAL_MUL_LNEG; +"REAL_MUL_LZERO",REAL_MUL_LZERO; +"REAL_MUL_POS_LE",REAL_MUL_POS_LE; +"REAL_MUL_POS_LT",REAL_MUL_POS_LT; +"REAL_MUL_RID",REAL_MUL_RID; +"REAL_MUL_RINV",REAL_MUL_RINV; +"REAL_MUL_RINV_UNIQ",REAL_MUL_RINV_UNIQ; +"REAL_MUL_RNEG",REAL_MUL_RNEG; +"REAL_MUL_RZERO",REAL_MUL_RZERO; +"REAL_MUL_SUM",REAL_MUL_SUM; +"REAL_MUL_SUM_NUMSEG",REAL_MUL_SUM_NUMSEG; +"REAL_MUL_SYM",REAL_MUL_SYM; +"REAL_NEGNEG",REAL_NEGNEG; +"REAL_NEG_0",REAL_NEG_0; +"REAL_NEG_ADD",REAL_NEG_ADD; +"REAL_NEG_EQ",REAL_NEG_EQ; +"REAL_NEG_EQ_0",REAL_NEG_EQ_0; +"REAL_NEG_GE0",REAL_NEG_GE0; +"REAL_NEG_GT0",REAL_NEG_GT0; +"REAL_NEG_LE0",REAL_NEG_LE0; +"REAL_NEG_LMUL",REAL_NEG_LMUL; +"REAL_NEG_LT0",REAL_NEG_LT0; +"REAL_NEG_MINUS1",REAL_NEG_MINUS1; +"REAL_NEG_MUL2",REAL_NEG_MUL2; +"REAL_NEG_NEG",REAL_NEG_NEG; +"REAL_NEG_RMUL",REAL_NEG_RMUL; +"REAL_NEG_SUB",REAL_NEG_SUB; +"REAL_NOT_EQ",REAL_NOT_EQ; +"REAL_NOT_LE",REAL_NOT_LE; +"REAL_NOT_LT",REAL_NOT_LT; +"REAL_OF_INT_OF_REAL",REAL_OF_INT_OF_REAL; +"REAL_OF_NUM_ADD",REAL_OF_NUM_ADD; +"REAL_OF_NUM_EQ",REAL_OF_NUM_EQ; +"REAL_OF_NUM_GE",REAL_OF_NUM_GE; +"REAL_OF_NUM_GT",REAL_OF_NUM_GT; +"REAL_OF_NUM_LE",REAL_OF_NUM_LE; +"REAL_OF_NUM_LT",REAL_OF_NUM_LT; +"REAL_OF_NUM_MAX",REAL_OF_NUM_MAX; +"REAL_OF_NUM_MIN",REAL_OF_NUM_MIN; +"REAL_OF_NUM_MUL",REAL_OF_NUM_MUL; +"REAL_OF_NUM_NPRODUCT",REAL_OF_NUM_NPRODUCT; +"REAL_OF_NUM_POW",REAL_OF_NUM_POW; +"REAL_OF_NUM_SUB",REAL_OF_NUM_SUB; +"REAL_OF_NUM_SUC",REAL_OF_NUM_SUC; +"REAL_OF_NUM_SUM",REAL_OF_NUM_SUM; +"REAL_OF_NUM_SUM_NUMSEG",REAL_OF_NUM_SUM_NUMSEG; +"REAL_POLYFUN_EQ_0",REAL_POLYFUN_EQ_0; +"REAL_POLYFUN_EQ_CONST",REAL_POLYFUN_EQ_CONST; +"REAL_POLYFUN_FINITE_ROOTS",REAL_POLYFUN_FINITE_ROOTS; +"REAL_POLYFUN_ROOTBOUND",REAL_POLYFUN_ROOTBOUND; +"REAL_POLY_CLAUSES",REAL_POLY_CLAUSES; +"REAL_POLY_NEG_CLAUSES",REAL_POLY_NEG_CLAUSES; +"REAL_POS",REAL_POS; +"REAL_POS_NZ",REAL_POS_NZ; +"REAL_POW2_ABS",REAL_POW2_ABS; +"REAL_POW_1",REAL_POW_1; +"REAL_POW_1_LE",REAL_POW_1_LE; +"REAL_POW_1_LT",REAL_POW_1_LT; +"REAL_POW_2",REAL_POW_2; +"REAL_POW_ADD",REAL_POW_ADD; +"REAL_POW_DIV",REAL_POW_DIV; +"REAL_POW_EQ",REAL_POW_EQ; +"REAL_POW_EQ_0",REAL_POW_EQ_0; +"REAL_POW_EQ_1",REAL_POW_EQ_1; +"REAL_POW_EQ_1_IMP",REAL_POW_EQ_1_IMP; +"REAL_POW_EQ_ABS",REAL_POW_EQ_ABS; +"REAL_POW_EQ_EQ",REAL_POW_EQ_EQ; +"REAL_POW_EQ_ODD",REAL_POW_EQ_ODD; +"REAL_POW_EQ_ODD_EQ",REAL_POW_EQ_ODD_EQ; +"REAL_POW_INV",REAL_POW_INV; +"REAL_POW_LBOUND",REAL_POW_LBOUND; +"REAL_POW_LE",REAL_POW_LE; +"REAL_POW_LE2",REAL_POW_LE2; +"REAL_POW_LE2_ODD",REAL_POW_LE2_ODD; +"REAL_POW_LE2_ODD_EQ",REAL_POW_LE2_ODD_EQ; +"REAL_POW_LE2_REV",REAL_POW_LE2_REV; +"REAL_POW_LE_1",REAL_POW_LE_1; +"REAL_POW_LT",REAL_POW_LT; +"REAL_POW_LT2",REAL_POW_LT2; +"REAL_POW_LT2_ODD",REAL_POW_LT2_ODD; +"REAL_POW_LT2_ODD_EQ",REAL_POW_LT2_ODD_EQ; +"REAL_POW_LT2_REV",REAL_POW_LT2_REV; +"REAL_POW_LT_1",REAL_POW_LT_1; +"REAL_POW_MONO",REAL_POW_MONO; +"REAL_POW_MONO_INV",REAL_POW_MONO_INV; +"REAL_POW_MONO_LT",REAL_POW_MONO_LT; +"REAL_POW_MUL",REAL_POW_MUL; +"REAL_POW_NEG",REAL_POW_NEG; +"REAL_POW_NZ",REAL_POW_NZ; +"REAL_POW_ONE",REAL_POW_ONE; +"REAL_POW_POW",REAL_POW_POW; +"REAL_POW_SUB",REAL_POW_SUB; +"REAL_POW_ZERO",REAL_POW_ZERO; +"REAL_RNEG_UNIQ",REAL_RNEG_UNIQ; +"REAL_RSQRT_LE",REAL_RSQRT_LE; +"REAL_SETDIST_LT_EXISTS",REAL_SETDIST_LT_EXISTS; +"REAL_SGN",REAL_SGN; +"REAL_SGN_0",REAL_SGN_0; +"REAL_SGN_ABS",REAL_SGN_ABS; +"REAL_SGN_CASES",REAL_SGN_CASES; +"REAL_SGN_DIV",REAL_SGN_DIV; +"REAL_SGN_EQ",REAL_SGN_EQ; +"REAL_SGN_INEQS",REAL_SGN_INEQS; +"REAL_SGN_INV",REAL_SGN_INV; +"REAL_SGN_MUL",REAL_SGN_MUL; +"REAL_SGN_NEG",REAL_SGN_NEG; +"REAL_SGN_POW",REAL_SGN_POW; +"REAL_SGN_POW_2",REAL_SGN_POW_2; +"REAL_SGN_REAL_SGN",REAL_SGN_REAL_SGN; +"REAL_SGN_SQRT",REAL_SGN_SQRT; +"REAL_SOS_EQ_0",REAL_SOS_EQ_0; +"REAL_SQRT_POW_2",REAL_SQRT_POW_2; +"REAL_SUB_0",REAL_SUB_0; +"REAL_SUB_ABS",REAL_SUB_ABS; +"REAL_SUB_ADD",REAL_SUB_ADD; +"REAL_SUB_ADD2",REAL_SUB_ADD2; +"REAL_SUB_INV",REAL_SUB_INV; +"REAL_SUB_LDISTRIB",REAL_SUB_LDISTRIB; +"REAL_SUB_LE",REAL_SUB_LE; +"REAL_SUB_LNEG",REAL_SUB_LNEG; +"REAL_SUB_LT",REAL_SUB_LT; +"REAL_SUB_LZERO",REAL_SUB_LZERO; +"REAL_SUB_NEG2",REAL_SUB_NEG2; +"REAL_SUB_POLYFUN",REAL_SUB_POLYFUN; +"REAL_SUB_POLYFUN_ALT",REAL_SUB_POLYFUN_ALT; +"REAL_SUB_POW",REAL_SUB_POW; +"REAL_SUB_POW_L1",REAL_SUB_POW_L1; +"REAL_SUB_POW_R1",REAL_SUB_POW_R1; +"REAL_SUB_RDISTRIB",REAL_SUB_RDISTRIB; +"REAL_SUB_REFL",REAL_SUB_REFL; +"REAL_SUB_RNEG",REAL_SUB_RNEG; +"REAL_SUB_RZERO",REAL_SUB_RZERO; +"REAL_SUB_SUB",REAL_SUB_SUB; +"REAL_SUB_SUB2",REAL_SUB_SUB2; +"REAL_SUB_TRIANGLE",REAL_SUB_TRIANGLE; +"REAL_SUP_ASCLOSE",REAL_SUP_ASCLOSE; +"REAL_SUP_BOUNDS",REAL_SUP_BOUNDS; +"REAL_SUP_EQ_INF",REAL_SUP_EQ_INF; +"REAL_SUP_LE",REAL_SUP_LE; +"REAL_SUP_LE_EQ",REAL_SUP_LE_EQ; +"REAL_SUP_LE_FINITE",REAL_SUP_LE_FINITE; +"REAL_SUP_LE_SUBSET",REAL_SUP_LE_SUBSET; +"REAL_SUP_LT_FINITE",REAL_SUP_LT_FINITE; +"REAL_SUP_UNIQUE",REAL_SUP_UNIQUE; +"REAL_TRUNCATE",REAL_TRUNCATE; +"REAL_TRUNCATE_POS",REAL_TRUNCATE_POS; +"REAL_WLOG_LE",REAL_WLOG_LE; +"REAL_WLOG_LT",REAL_WLOG_LT; +"RECTIFIABLE_PATH_DIFFERENTIABLE",RECTIFIABLE_PATH_DIFFERENTIABLE; +"RECTIFIABLE_PATH_IMP_PATH",RECTIFIABLE_PATH_IMP_PATH; +"RECTIFIABLE_PATH_JOIN",RECTIFIABLE_PATH_JOIN; +"RECTIFIABLE_PATH_JOIN_EQ",RECTIFIABLE_PATH_JOIN_EQ; +"RECTIFIABLE_PATH_JOIN_IMP",RECTIFIABLE_PATH_JOIN_IMP; +"RECTIFIABLE_PATH_LINEPATH",RECTIFIABLE_PATH_LINEPATH; +"RECTIFIABLE_PATH_REVERSEPATH",RECTIFIABLE_PATH_REVERSEPATH; +"RECTIFIABLE_PATH_SUBPATH",RECTIFIABLE_PATH_SUBPATH; +"RECURSION_CASEWISE",RECURSION_CASEWISE; +"RECURSION_CASEWISE_PAIRWISE",RECURSION_CASEWISE_PAIRWISE; +"RECURSION_SUPERADMISSIBLE",RECURSION_SUPERADMISSIBLE; +"REDUCED_LABELLING",REDUCED_LABELLING; +"REDUCED_LABELLING_0",REDUCED_LABELLING_0; +"REDUCED_LABELLING_1",REDUCED_LABELLING_1; +"REDUCED_LABELLING_SUC",REDUCED_LABELLING_SUC; +"REDUCED_LABELLING_UNIQUE",REDUCED_LABELLING_UNIQUE; +"REDUCE_LABELLING_0",REDUCE_LABELLING_0; +"REFLECT_ALONG_0",REFLECT_ALONG_0; +"REFLECT_ALONG_1D",REFLECT_ALONG_1D; +"REFLECT_ALONG_ADD",REFLECT_ALONG_ADD; +"REFLECT_ALONG_BASIS",REFLECT_ALONG_BASIS; +"REFLECT_ALONG_EQ_0",REFLECT_ALONG_EQ_0; +"REFLECT_ALONG_EQ_SELF",REFLECT_ALONG_EQ_SELF; +"REFLECT_ALONG_INVOLUTION",REFLECT_ALONG_INVOLUTION; +"REFLECT_ALONG_LINEAR_IMAGE",REFLECT_ALONG_LINEAR_IMAGE; +"REFLECT_ALONG_MUL",REFLECT_ALONG_MUL; +"REFLECT_ALONG_REFL",REFLECT_ALONG_REFL; +"REFLECT_ALONG_SCALE",REFLECT_ALONG_SCALE; +"REFLECT_ALONG_ZERO",REFLECT_ALONG_ZERO; +"REFLECT_INTERVAL",REFLECT_INTERVAL; +"REFL_CLAUSE",REFL_CLAUSE; +"REGULAR_CLOSED_UNION",REGULAR_CLOSED_UNION; +"REGULAR_OPEN_INTER",REGULAR_OPEN_INTER; +"RELATIVE_BOUNDARY_OF_CONVEX_HULL",RELATIVE_BOUNDARY_OF_CONVEX_HULL; +"RELATIVE_BOUNDARY_OF_POLYHEDRON",RELATIVE_BOUNDARY_OF_POLYHEDRON; +"RELATIVE_BOUNDARY_OF_TRIANGLE",RELATIVE_BOUNDARY_OF_TRIANGLE; +"RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_BOUNDARY_RETRACT_OF_PUNCTURED_AFFINE_HULL; +"RELATIVE_FRONTIER_BALL",RELATIVE_FRONTIER_BALL; +"RELATIVE_FRONTIER_CBALL",RELATIVE_FRONTIER_CBALL; +"RELATIVE_FRONTIER_CLOSURE",RELATIVE_FRONTIER_CLOSURE; +"RELATIVE_FRONTIER_CONVEX_HULL_CASES",RELATIVE_FRONTIER_CONVEX_HULL_CASES; +"RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT",RELATIVE_FRONTIER_CONVEX_HULL_EXPLICIT; +"RELATIVE_FRONTIER_CONVEX_INTER_AFFINE",RELATIVE_FRONTIER_CONVEX_INTER_AFFINE; +"RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX",RELATIVE_FRONTIER_DEFORMATION_RETRACT_OF_PUNCTURED_CONVEX; +"RELATIVE_FRONTIER_EMPTY",RELATIVE_FRONTIER_EMPTY; +"RELATIVE_FRONTIER_EQ_EMPTY",RELATIVE_FRONTIER_EQ_EMPTY; +"RELATIVE_FRONTIER_FRONTIER",RELATIVE_FRONTIER_FRONTIER; +"RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE",RELATIVE_FRONTIER_INJECTIVE_LINEAR_IMAGE; +"RELATIVE_FRONTIER_NONEMPTY_INTERIOR",RELATIVE_FRONTIER_NONEMPTY_INTERIOR; +"RELATIVE_FRONTIER_NOT_SING",RELATIVE_FRONTIER_NOT_SING; +"RELATIVE_FRONTIER_OF_CONVEX_HULL",RELATIVE_FRONTIER_OF_CONVEX_HULL; +"RELATIVE_FRONTIER_OF_POLYHEDRON",RELATIVE_FRONTIER_OF_POLYHEDRON; +"RELATIVE_FRONTIER_OF_POLYHEDRON_ALT",RELATIVE_FRONTIER_OF_POLYHEDRON_ALT; +"RELATIVE_FRONTIER_OF_TRIANGLE",RELATIVE_FRONTIER_OF_TRIANGLE; +"RELATIVE_FRONTIER_RELATIVE_INTERIOR",RELATIVE_FRONTIER_RELATIVE_INTERIOR; +"RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL",RELATIVE_FRONTIER_RETRACT_OF_PUNCTURED_AFFINE_HULL; +"RELATIVE_FRONTIER_SING",RELATIVE_FRONTIER_SING; +"RELATIVE_FRONTIER_TRANSLATION",RELATIVE_FRONTIER_TRANSLATION; +"RELATIVE_INTERIOR",RELATIVE_INTERIOR; +"RELATIVE_INTERIOR_AFFINE",RELATIVE_INTERIOR_AFFINE; +"RELATIVE_INTERIOR_BALL",RELATIVE_INTERIOR_BALL; +"RELATIVE_INTERIOR_CBALL",RELATIVE_INTERIOR_CBALL; +"RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY",RELATIVE_INTERIOR_CONVEX_CONTAINS_SAME_RAY; +"RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT",RELATIVE_INTERIOR_CONVEX_HULL_EXPLICIT; +"RELATIVE_INTERIOR_CONVEX_INTER_AFFINE",RELATIVE_INTERIOR_CONVEX_INTER_AFFINE; +"RELATIVE_INTERIOR_CONVEX_PROLONG",RELATIVE_INTERIOR_CONVEX_PROLONG; +"RELATIVE_INTERIOR_EMPTY",RELATIVE_INTERIOR_EMPTY; +"RELATIVE_INTERIOR_EQ",RELATIVE_INTERIOR_EQ; +"RELATIVE_INTERIOR_EQ_CLOSURE",RELATIVE_INTERIOR_EQ_CLOSURE; +"RELATIVE_INTERIOR_EQ_EMPTY",RELATIVE_INTERIOR_EQ_EMPTY; +"RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE",RELATIVE_INTERIOR_INJECTIVE_LINEAR_IMAGE; +"RELATIVE_INTERIOR_INTERIOR",RELATIVE_INTERIOR_INTERIOR; +"RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX",RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; +"RELATIVE_INTERIOR_MAXIMAL",RELATIVE_INTERIOR_MAXIMAL; +"RELATIVE_INTERIOR_NONEMPTY_INTERIOR",RELATIVE_INTERIOR_NONEMPTY_INTERIOR; +"RELATIVE_INTERIOR_OF_POLYHEDRON",RELATIVE_INTERIOR_OF_POLYHEDRON; +"RELATIVE_INTERIOR_OPEN",RELATIVE_INTERIOR_OPEN; +"RELATIVE_INTERIOR_OPEN_IN",RELATIVE_INTERIOR_OPEN_IN; +"RELATIVE_INTERIOR_PCROSS",RELATIVE_INTERIOR_PCROSS; +"RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT",RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT; +"RELATIVE_INTERIOR_PROLONG",RELATIVE_INTERIOR_PROLONG; +"RELATIVE_INTERIOR_SEGMENT",RELATIVE_INTERIOR_SEGMENT; +"RELATIVE_INTERIOR_SING",RELATIVE_INTERIOR_SING; +"RELATIVE_INTERIOR_SUBSET",RELATIVE_INTERIOR_SUBSET; +"RELATIVE_INTERIOR_TRANSLATION",RELATIVE_INTERIOR_TRANSLATION; +"RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAY; +"RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS",RELATIVE_INTERIOR_UNBOUNDED_CONVEX_CONTAINS_RAYS; +"RELATIVE_INTERIOR_UNIQUE",RELATIVE_INTERIOR_UNIQUE; +"RELATIVE_INTERIOR_UNIV",RELATIVE_INTERIOR_UNIV; +"REPLICATE",REPLICATE; +"REP_ABS_PAIR",REP_ABS_PAIR; +"REST",REST; +"RETRACTION",RETRACTION; +"RETRACTION_ARC",RETRACTION_ARC; +"RETRACTION_IDEMPOTENT",RETRACTION_IDEMPOTENT; +"RETRACTION_IMP_QUOTIENT_MAP",RETRACTION_IMP_QUOTIENT_MAP; +"RETRACTION_REFL",RETRACTION_REFL; +"RETRACTION_SUBSET",RETRACTION_SUBSET; +"RETRACTION_o",RETRACTION_o; +"RETRACT_FIXPOINT_PROPERTY",RETRACT_FIXPOINT_PROPERTY; +"RETRACT_FROM_UNION_AND_INTER",RETRACT_FROM_UNION_AND_INTER; +"RETRACT_OF_CLOSED",RETRACT_OF_CLOSED; +"RETRACT_OF_COHOMOTOPICALLY_TRIVIAL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL; +"RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_COHOMOTOPICALLY_TRIVIAL_NULL; +"RETRACT_OF_COMPACT",RETRACT_OF_COMPACT; +"RETRACT_OF_CONNECTED",RETRACT_OF_CONNECTED; +"RETRACT_OF_CONTRACTIBLE",RETRACT_OF_CONTRACTIBLE; +"RETRACT_OF_EMPTY",RETRACT_OF_EMPTY; +"RETRACT_OF_HOMOTOPICALLY_TRIVIAL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL; +"RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL",RETRACT_OF_HOMOTOPICALLY_TRIVIAL_NULL; +"RETRACT_OF_IMP_EXTENSIBLE",RETRACT_OF_IMP_EXTENSIBLE; +"RETRACT_OF_IMP_SUBSET",RETRACT_OF_IMP_SUBSET; +"RETRACT_OF_INJECTIVE_LINEAR_IMAGE",RETRACT_OF_INJECTIVE_LINEAR_IMAGE; +"RETRACT_OF_LINEAR_IMAGE_EQ",RETRACT_OF_LINEAR_IMAGE_EQ; +"RETRACT_OF_LOCALLY_COMPACT",RETRACT_OF_LOCALLY_COMPACT; +"RETRACT_OF_LOCALLY_CONNECTED",RETRACT_OF_LOCALLY_CONNECTED; +"RETRACT_OF_LOCALLY_PATH_CONNECTED",RETRACT_OF_LOCALLY_PATH_CONNECTED; +"RETRACT_OF_PATH_CONNECTED",RETRACT_OF_PATH_CONNECTED; +"RETRACT_OF_PCROSS",RETRACT_OF_PCROSS; +"RETRACT_OF_PCROSS_EQ",RETRACT_OF_PCROSS_EQ; +"RETRACT_OF_REFL",RETRACT_OF_REFL; +"RETRACT_OF_SIMPLY_CONNECTED",RETRACT_OF_SIMPLY_CONNECTED; +"RETRACT_OF_SING",RETRACT_OF_SING; +"RETRACT_OF_SUBSET",RETRACT_OF_SUBSET; +"RETRACT_OF_TRANS",RETRACT_OF_TRANS; +"RETRACT_OF_TRANSLATION",RETRACT_OF_TRANSLATION; +"RETRACT_OF_TRANSLATION_EQ",RETRACT_OF_TRANSLATION_EQ; +"RETRACT_OF_UNIV",RETRACT_OF_UNIV; +"REVERSE",REVERSE; +"REVERSEPATH_JOINPATHS",REVERSEPATH_JOINPATHS; +"REVERSEPATH_LINEAR_IMAGE",REVERSEPATH_LINEAR_IMAGE; +"REVERSEPATH_LINEPATH",REVERSEPATH_LINEPATH; +"REVERSEPATH_REVERSEPATH",REVERSEPATH_REVERSEPATH; +"REVERSEPATH_SUBPATH",REVERSEPATH_SUBPATH; +"REVERSEPATH_TRANSLATION",REVERSEPATH_TRANSLATION; +"REVERSE_APPEND",REVERSE_APPEND; +"REVERSE_REVERSE",REVERSE_REVERSE; +"RIGHT_ADD_DISTRIB",RIGHT_ADD_DISTRIB; +"RIGHT_AND_EXISTS_THM",RIGHT_AND_EXISTS_THM; +"RIGHT_AND_FORALL_THM",RIGHT_AND_FORALL_THM; +"RIGHT_EXISTS_AND_THM",RIGHT_EXISTS_AND_THM; +"RIGHT_EXISTS_IMP_THM",RIGHT_EXISTS_IMP_THM; +"RIGHT_FORALL_IMP_THM",RIGHT_FORALL_IMP_THM; +"RIGHT_FORALL_OR_THM",RIGHT_FORALL_OR_THM; +"RIGHT_IMP_EXISTS_THM",RIGHT_IMP_EXISTS_THM; +"RIGHT_IMP_FORALL_THM",RIGHT_IMP_FORALL_THM; +"RIGHT_INVERSE_LINEAR",RIGHT_INVERSE_LINEAR; +"RIGHT_INVERTIBLE_TRANSP",RIGHT_INVERTIBLE_TRANSP; +"RIGHT_OR_DISTRIB",RIGHT_OR_DISTRIB; +"RIGHT_OR_EXISTS_THM",RIGHT_OR_EXISTS_THM; +"RIGHT_OR_FORALL_THM",RIGHT_OR_FORALL_THM; +"RIGHT_SUB_DISTRIB",RIGHT_SUB_DISTRIB; +"RIGID_TRANSFORMATION_BETWEEN_2",RIGID_TRANSFORMATION_BETWEEN_2; +"RIGID_TRANSFORMATION_BETWEEN_3",RIGID_TRANSFORMATION_BETWEEN_3; +"RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS; +"RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG",RIGID_TRANSFORMATION_BETWEEN_CONGRUENT_SETS_STRONG; +"ROLLE",ROLLE; +"ROTATION_EXISTS",ROTATION_EXISTS; +"ROTATION_EXISTS_1",ROTATION_EXISTS_1; +"ROTATION_LOWDIM_HORIZONTAL",ROTATION_LOWDIM_HORIZONTAL; +"ROTATION_MATRIX_2",ROTATION_MATRIX_2; +"ROTATION_MATRIX_EXISTS_BASIS",ROTATION_MATRIX_EXISTS_BASIS; +"ROTATION_RIGHTWARD_LINE",ROTATION_RIGHTWARD_LINE; +"ROTHE",ROTHE; +"ROTOINVERSION_MATRIX_REFLECT_ALONG",ROTOINVERSION_MATRIX_REFLECT_ALONG; +"ROWS_TRANSP",ROWS_TRANSP; +"ROW_TRANSP",ROW_TRANSP; +"RSUM_BOUND",RSUM_BOUND; +"RSUM_COMPONENT_LE",RSUM_COMPONENT_LE; +"RSUM_DIFF_BOUND",RSUM_DIFF_BOUND; +"SAME_DISTANCES_TO_AFFINE_HULL",SAME_DISTANCES_TO_AFFINE_HULL; +"SCALING_LINEAR",SCALING_LINEAR; +"SCHAUDER",SCHAUDER; +"SCHAUDER_GEN",SCHAUDER_GEN; +"SCHAUDER_PROJECTION",SCHAUDER_PROJECTION; +"SCHAUDER_UNIV",SCHAUDER_UNIV; +"SECOND_MEAN_VALUE_THEOREM",SECOND_MEAN_VALUE_THEOREM; +"SECOND_MEAN_VALUE_THEOREM_BONNET",SECOND_MEAN_VALUE_THEOREM_BONNET; +"SECOND_MEAN_VALUE_THEOREM_BONNET_FULL",SECOND_MEAN_VALUE_THEOREM_BONNET_FULL; +"SECOND_MEAN_VALUE_THEOREM_FULL",SECOND_MEAN_VALUE_THEOREM_FULL; +"SECOND_MEAN_VALUE_THEOREM_GEN",SECOND_MEAN_VALUE_THEOREM_GEN; +"SECOND_MEAN_VALUE_THEOREM_GEN_FULL",SECOND_MEAN_VALUE_THEOREM_GEN_FULL; +"SEGMENT_1",SEGMENT_1; +"SEGMENT_AS_BALL",SEGMENT_AS_BALL; +"SEGMENT_BOUND",SEGMENT_BOUND; +"SEGMENT_CLOSED_OPEN",SEGMENT_CLOSED_OPEN; +"SEGMENT_CONVEX_HULL",SEGMENT_CONVEX_HULL; +"SEGMENT_EDGE_OF",SEGMENT_EDGE_OF; +"SEGMENT_EQ",SEGMENT_EQ; +"SEGMENT_EQ_EMPTY",SEGMENT_EQ_EMPTY; +"SEGMENT_EQ_SING",SEGMENT_EQ_SING; +"SEGMENT_FACE_OF",SEGMENT_FACE_OF; +"SEGMENT_FURTHEST_LE",SEGMENT_FURTHEST_LE; +"SEGMENT_HORIZONTAL",SEGMENT_HORIZONTAL; +"SEGMENT_IMAGE_INTERVAL",SEGMENT_IMAGE_INTERVAL; +"SEGMENT_OPEN_SUBSET_CLOSED",SEGMENT_OPEN_SUBSET_CLOSED; +"SEGMENT_REFL",SEGMENT_REFL; +"SEGMENT_SCALAR_MULTIPLE",SEGMENT_SCALAR_MULTIPLE; +"SEGMENT_SYM",SEGMENT_SYM; +"SEGMENT_TO_CLOSEST_POINT",SEGMENT_TO_CLOSEST_POINT; +"SEGMENT_TO_POINT_EXISTS",SEGMENT_TO_POINT_EXISTS; +"SEGMENT_TRANSLATION",SEGMENT_TRANSLATION; +"SEGMENT_VERTICAL",SEGMENT_VERTICAL; +"SELECT_AX",SELECT_AX; +"SELECT_REFL",SELECT_REFL; +"SELECT_UNIQUE",SELECT_UNIQUE; +"SELF_ADJOINT_COMPOSE",SELF_ADJOINT_COMPOSE; +"SELF_ADJOINT_HAS_EIGENVECTOR",SELF_ADJOINT_HAS_EIGENVECTOR; +"SELF_ADJOINT_HAS_EIGENVECTOR_BASIS",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS; +"SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE; +"SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE",SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE; +"SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS",SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS; +"SEPARABLE",SEPARABLE; +"SEPARATE_CLOSED_COMPACT",SEPARATE_CLOSED_COMPACT; +"SEPARATE_CLOSED_CONES",SEPARATE_CLOSED_CONES; +"SEPARATE_COMPACT_CLOSED",SEPARATE_COMPACT_CLOSED; +"SEPARATE_POINT_CLOSED",SEPARATE_POINT_CLOSED; +"SEPARATING_HYPERPLANE_CLOSED_0",SEPARATING_HYPERPLANE_CLOSED_0; +"SEPARATING_HYPERPLANE_CLOSED_0_INSET",SEPARATING_HYPERPLANE_CLOSED_0_INSET; +"SEPARATING_HYPERPLANE_CLOSED_COMPACT",SEPARATING_HYPERPLANE_CLOSED_COMPACT; +"SEPARATING_HYPERPLANE_CLOSED_POINT",SEPARATING_HYPERPLANE_CLOSED_POINT; +"SEPARATING_HYPERPLANE_CLOSED_POINT_INSET",SEPARATING_HYPERPLANE_CLOSED_POINT_INSET; +"SEPARATING_HYPERPLANE_COMPACT_CLOSED",SEPARATING_HYPERPLANE_COMPACT_CLOSED; +"SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO",SEPARATING_HYPERPLANE_COMPACT_CLOSED_NONZERO; +"SEPARATING_HYPERPLANE_COMPACT_COMPACT",SEPARATING_HYPERPLANE_COMPACT_COMPACT; +"SEPARATING_HYPERPLANE_POLYHEDRA",SEPARATING_HYPERPLANE_POLYHEDRA; +"SEPARATING_HYPERPLANE_RELATIVE_INTERIORS",SEPARATING_HYPERPLANE_RELATIVE_INTERIORS; +"SEPARATING_HYPERPLANE_SETS",SEPARATING_HYPERPLANE_SETS; +"SEPARATING_HYPERPLANE_SET_0",SEPARATING_HYPERPLANE_SET_0; +"SEPARATING_HYPERPLANE_SET_0_INSPAN",SEPARATING_HYPERPLANE_SET_0_INSPAN; +"SEPARATING_HYPERPLANE_SET_POINT_INAFF",SEPARATING_HYPERPLANE_SET_POINT_INAFF; +"SEPARATION_CLOSURES",SEPARATION_CLOSURES; +"SEPARATION_HAUSDORFF",SEPARATION_HAUSDORFF; +"SEPARATION_NORMAL",SEPARATION_NORMAL; +"SEPARATION_NORMAL_COMPACT",SEPARATION_NORMAL_COMPACT; +"SEPARATION_NORMAL_LOCAL",SEPARATION_NORMAL_LOCAL; +"SEPARATION_T0",SEPARATION_T0; +"SEPARATION_T1",SEPARATION_T1; +"SEPARATION_T2",SEPARATION_T2; +"SEQITERATE_CLAUSES",SEQITERATE_CLAUSES; +"SEQITERATE_ITERATE",SEQITERATE_ITERATE; +"SEQUENCE_CAUCHY_WLOG",SEQUENCE_CAUCHY_WLOG; +"SEQUENCE_INFINITE_LEMMA",SEQUENCE_INFINITE_LEMMA; +"SEQUENCE_UNIQUE_LIMPT",SEQUENCE_UNIQUE_LIMPT; +"SEQUENTIALLY",SEQUENTIALLY; +"SEQ_HARMONIC",SEQ_HARMONIC; +"SEQ_MONO_LEMMA",SEQ_MONO_LEMMA; +"SEQ_OFFSET",SEQ_OFFSET; +"SEQ_OFFSET_NEG",SEQ_OFFSET_NEG; +"SEQ_OFFSET_REV",SEQ_OFFSET_REV; +"SERIES_0",SERIES_0; +"SERIES_ADD",SERIES_ADD; +"SERIES_BOUND",SERIES_BOUND; +"SERIES_CAUCHY",SERIES_CAUCHY; +"SERIES_CAUCHY_UNIFORM",SERIES_CAUCHY_UNIFORM; +"SERIES_CMUL",SERIES_CMUL; +"SERIES_COMPARISON",SERIES_COMPARISON; +"SERIES_COMPARISON_BOUND",SERIES_COMPARISON_BOUND; +"SERIES_COMPARISON_UNIFORM",SERIES_COMPARISON_UNIFORM; +"SERIES_COMPONENT",SERIES_COMPONENT; +"SERIES_DIFFS",SERIES_DIFFS; +"SERIES_DIRICHLET",SERIES_DIRICHLET; +"SERIES_DIRICHLET_BILINEAR",SERIES_DIRICHLET_BILINEAR; +"SERIES_DROP_LE",SERIES_DROP_LE; +"SERIES_DROP_POS",SERIES_DROP_POS; +"SERIES_FINITE",SERIES_FINITE; +"SERIES_FINITE_SUPPORT",SERIES_FINITE_SUPPORT; +"SERIES_FROM",SERIES_FROM; +"SERIES_GOESTOZERO",SERIES_GOESTOZERO; +"SERIES_INJECTIVE_IMAGE",SERIES_INJECTIVE_IMAGE; +"SERIES_INJECTIVE_IMAGE_STRONG",SERIES_INJECTIVE_IMAGE_STRONG; +"SERIES_LIFT_ABSCONV_IMP_CONV",SERIES_LIFT_ABSCONV_IMP_CONV; +"SERIES_LINEAR",SERIES_LINEAR; +"SERIES_NEG",SERIES_NEG; +"SERIES_RATIO",SERIES_RATIO; +"SERIES_REARRANGE",SERIES_REARRANGE; +"SERIES_REARRANGE_EQ",SERIES_REARRANGE_EQ; +"SERIES_RESTRICT",SERIES_RESTRICT; +"SERIES_SUB",SERIES_SUB; +"SERIES_SUBSET",SERIES_SUBSET; +"SERIES_TERMS_TOZERO",SERIES_TERMS_TOZERO; +"SERIES_TRIVIAL",SERIES_TRIVIAL; +"SERIES_UNIQUE",SERIES_UNIQUE; +"SERIES_VSUM",SERIES_VSUM; +"SETCODE_BOUNDS",SETCODE_BOUNDS; +"SETDIST_BALLS",SETDIST_BALLS; +"SETDIST_CLOSED_COMPACT",SETDIST_CLOSED_COMPACT; +"SETDIST_CLOSEST_POINT",SETDIST_CLOSEST_POINT; +"SETDIST_CLOSURE",SETDIST_CLOSURE; +"SETDIST_COMPACT_CLOSED",SETDIST_COMPACT_CLOSED; +"SETDIST_DIFFERENCES",SETDIST_DIFFERENCES; +"SETDIST_EMPTY",SETDIST_EMPTY; +"SETDIST_EQ_0_BOUNDED",SETDIST_EQ_0_BOUNDED; +"SETDIST_EQ_0_CLOSED",SETDIST_EQ_0_CLOSED; +"SETDIST_EQ_0_CLOSED_COMPACT",SETDIST_EQ_0_CLOSED_COMPACT; +"SETDIST_EQ_0_CLOSED_IN",SETDIST_EQ_0_CLOSED_IN; +"SETDIST_EQ_0_COMPACT_CLOSED",SETDIST_EQ_0_COMPACT_CLOSED; +"SETDIST_EQ_0_SING",SETDIST_EQ_0_SING; +"SETDIST_LE_DIST",SETDIST_LE_DIST; +"SETDIST_LE_HAUSDIST",SETDIST_LE_HAUSDIST; +"SETDIST_LE_SING",SETDIST_LE_SING; +"SETDIST_LINEAR_IMAGE",SETDIST_LINEAR_IMAGE; +"SETDIST_LIPSCHITZ",SETDIST_LIPSCHITZ; +"SETDIST_POS_LE",SETDIST_POS_LE; +"SETDIST_REFL",SETDIST_REFL; +"SETDIST_SINGS",SETDIST_SINGS; +"SETDIST_SING_IN_SET",SETDIST_SING_IN_SET; +"SETDIST_SING_LE_HAUSDIST",SETDIST_SING_LE_HAUSDIST; +"SETDIST_SING_TRIANGLE",SETDIST_SING_TRIANGLE; +"SETDIST_SUBSET_LEFT",SETDIST_SUBSET_LEFT; +"SETDIST_SUBSET_RIGHT",SETDIST_SUBSET_RIGHT; +"SETDIST_SYM",SETDIST_SYM; +"SETDIST_TRANSLATION",SETDIST_TRANSLATION; +"SETDIST_TRIANGLE",SETDIST_TRIANGLE; +"SETDIST_UNIQUE",SETDIST_UNIQUE; +"SETSPEC",SETSPEC; +"SETVARIATION_EQUAL_LEMMA",SETVARIATION_EQUAL_LEMMA; +"SET_CASES",SET_CASES; +"SET_DIFF_FRONTIER",SET_DIFF_FRONTIER; +"SET_OF_LIST_APPEND",SET_OF_LIST_APPEND; +"SET_OF_LIST_EQ_EMPTY",SET_OF_LIST_EQ_EMPTY; +"SET_OF_LIST_MAP",SET_OF_LIST_MAP; +"SET_OF_LIST_OF_SET",SET_OF_LIST_OF_SET; +"SET_PAIR_THM",SET_PAIR_THM; +"SET_PROVE_CASES",SET_PROVE_CASES; +"SET_RECURSION_LEMMA",SET_RECURSION_LEMMA; +"SET_VARIATION",SET_VARIATION; +"SET_VARIATION_0",SET_VARIATION_0; +"SET_VARIATION_ELEMENTARY_LEMMA",SET_VARIATION_ELEMENTARY_LEMMA; +"SET_VARIATION_EQ",SET_VARIATION_EQ; +"SET_VARIATION_GE_FUNCTION",SET_VARIATION_GE_FUNCTION; +"SET_VARIATION_LBOUND",SET_VARIATION_LBOUND; +"SET_VARIATION_LBOUND_ON_INTERVAL",SET_VARIATION_LBOUND_ON_INTERVAL; +"SET_VARIATION_MONOTONE",SET_VARIATION_MONOTONE; +"SET_VARIATION_ON_DIVISION",SET_VARIATION_ON_DIVISION; +"SET_VARIATION_ON_ELEMENTARY",SET_VARIATION_ON_ELEMENTARY; +"SET_VARIATION_ON_INTERVAL",SET_VARIATION_ON_INTERVAL; +"SET_VARIATION_ON_NULL",SET_VARIATION_ON_NULL; +"SET_VARIATION_POS_LE",SET_VARIATION_POS_LE; +"SET_VARIATION_REFLECT2",SET_VARIATION_REFLECT2; +"SET_VARIATION_TRANSLATION2",SET_VARIATION_TRANSLATION2; +"SET_VARIATION_TRIANGLE",SET_VARIATION_TRIANGLE; +"SET_VARIATION_UBOUND",SET_VARIATION_UBOUND; +"SET_VARIATION_UBOUND_ON_INTERVAL",SET_VARIATION_UBOUND_ON_INTERVAL; +"SET_VARIATION_WORKS_ON_INTERVAL",SET_VARIATION_WORKS_ON_INTERVAL; +"SHIFTPATH_LINEAR_IMAGE",SHIFTPATH_LINEAR_IMAGE; +"SHIFTPATH_SHIFTPATH",SHIFTPATH_SHIFTPATH; +"SHIFTPATH_TRANSLATION",SHIFTPATH_TRANSLATION; +"SHIFTPATH_TRIVIAL",SHIFTPATH_TRIVIAL; +"SIGMA_COMPACT",SIGMA_COMPACT; +"SIGN_COMPOSE",SIGN_COMPOSE; +"SIGN_I",SIGN_I; +"SIGN_IDEMPOTENT",SIGN_IDEMPOTENT; +"SIGN_INVERSE",SIGN_INVERSE; +"SIGN_NZ",SIGN_NZ; +"SIGN_SWAP",SIGN_SWAP; +"SIMPLEX",SIMPLEX; +"SIMPLEX_DIM_GE",SIMPLEX_DIM_GE; +"SIMPLEX_EMPTY",SIMPLEX_EMPTY; +"SIMPLEX_EXPLICIT",SIMPLEX_EXPLICIT; +"SIMPLEX_EXTREMAL_LE",SIMPLEX_EXTREMAL_LE; +"SIMPLEX_EXTREMAL_LE_EXISTS",SIMPLEX_EXTREMAL_LE_EXISTS; +"SIMPLEX_EXTREME_POINTS",SIMPLEX_EXTREME_POINTS; +"SIMPLEX_FACE_OF_SIMPLEX",SIMPLEX_FACE_OF_SIMPLEX; +"SIMPLEX_FURTHEST_LE",SIMPLEX_FURTHEST_LE; +"SIMPLEX_FURTHEST_LE_EXISTS",SIMPLEX_FURTHEST_LE_EXISTS; +"SIMPLEX_FURTHEST_LT",SIMPLEX_FURTHEST_LT; +"SIMPLEX_IMP_POLYTOPE",SIMPLEX_IMP_POLYTOPE; +"SIMPLEX_MINUS_1",SIMPLEX_MINUS_1; +"SIMPLEX_TOP_FACE",SIMPLEX_TOP_FACE; +"SIMPLE_IMAGE",SIMPLE_IMAGE; +"SIMPLE_IMAGE_GEN",SIMPLE_IMAGE_GEN; +"SIMPLE_PATH_ASSOC",SIMPLE_PATH_ASSOC; +"SIMPLE_PATH_CASES",SIMPLE_PATH_CASES; +"SIMPLE_PATH_ENDLESS",SIMPLE_PATH_ENDLESS; +"SIMPLE_PATH_EQ_ARC",SIMPLE_PATH_EQ_ARC; +"SIMPLE_PATH_IMP_ARC",SIMPLE_PATH_IMP_ARC; +"SIMPLE_PATH_IMP_PATH",SIMPLE_PATH_IMP_PATH; +"SIMPLE_PATH_JOIN_IMP",SIMPLE_PATH_JOIN_IMP; +"SIMPLE_PATH_JOIN_LOOP",SIMPLE_PATH_JOIN_LOOP; +"SIMPLE_PATH_JOIN_LOOP_EQ",SIMPLE_PATH_JOIN_LOOP_EQ; +"SIMPLE_PATH_LINEAR_IMAGE_EQ",SIMPLE_PATH_LINEAR_IMAGE_EQ; +"SIMPLE_PATH_LINEPATH",SIMPLE_PATH_LINEPATH; +"SIMPLE_PATH_LINEPATH_EQ",SIMPLE_PATH_LINEPATH_EQ; +"SIMPLE_PATH_REVERSEPATH",SIMPLE_PATH_REVERSEPATH; +"SIMPLE_PATH_SHIFTPATH",SIMPLE_PATH_SHIFTPATH; +"SIMPLE_PATH_SUBPATH",SIMPLE_PATH_SUBPATH; +"SIMPLE_PATH_SUBPATH_EQ",SIMPLE_PATH_SUBPATH_EQ; +"SIMPLE_PATH_SYM",SIMPLE_PATH_SYM; +"SIMPLE_PATH_TRANSLATION_EQ",SIMPLE_PATH_TRANSLATION_EQ; +"SIMPLICIAL_COMPLEX_IMP_TRIANGULATION",SIMPLICIAL_COMPLEX_IMP_TRIANGULATION; +"SIMPLY_CONNECTED_EMPTY",SIMPLY_CONNECTED_EMPTY; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME; +"SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH",SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; +"SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS",SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS; +"SIMPLY_CONNECTED_IMP_CONNECTED",SIMPLY_CONNECTED_IMP_CONNECTED; +"SIMPLY_CONNECTED_IMP_PATH_CONNECTED",SIMPLY_CONNECTED_IMP_PATH_CONNECTED; +"SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE",SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE; +"SIMPLY_CONNECTED_PCROSS",SIMPLY_CONNECTED_PCROSS; +"SIMPLY_CONNECTED_PCROSS_EQ",SIMPLY_CONNECTED_PCROSS_EQ; +"SIMPLY_CONNECTED_RETRACTION_GEN",SIMPLY_CONNECTED_RETRACTION_GEN; +"SIMPLY_CONNECTED_TRANSLATION",SIMPLY_CONNECTED_TRANSLATION; +"SIMPLY_CONNECTED_UNION",SIMPLY_CONNECTED_UNION; +"SING",SING; +"SING_GSPEC",SING_GSPEC; +"SING_SUBSET",SING_SUBSET; +"SKOLEM_THM",SKOLEM_THM; +"SKOLEM_THM_GEN",SKOLEM_THM_GEN; +"SND",SND; +"SNDCART_ADD",SNDCART_ADD; +"SNDCART_CMUL",SNDCART_CMUL; +"SNDCART_NEG",SNDCART_NEG; +"SNDCART_PASTECART",SNDCART_PASTECART; +"SNDCART_SUB",SNDCART_SUB; +"SNDCART_VEC",SNDCART_VEC; +"SNDCART_VSUM",SNDCART_VSUM; +"SND_DEF",SND_DEF; +"SPANNING_SUBSET_INDEPENDENT",SPANNING_SUBSET_INDEPENDENT; +"SPANNING_SURJECTIVE_IMAGE",SPANNING_SURJECTIVE_IMAGE; +"SPANS_IMAGE",SPANS_IMAGE; +"SPAN_0",SPAN_0; +"SPAN_2",SPAN_2; +"SPAN_3",SPAN_3; +"SPAN_ADD",SPAN_ADD; +"SPAN_ADD_EQ",SPAN_ADD_EQ; +"SPAN_BREAKDOWN",SPAN_BREAKDOWN; +"SPAN_BREAKDOWN_EQ",SPAN_BREAKDOWN_EQ; +"SPAN_CARD_GE_DIM",SPAN_CARD_GE_DIM; +"SPAN_CLAUSES",SPAN_CLAUSES; +"SPAN_CONVEX_CONE_ALLSIGNS",SPAN_CONVEX_CONE_ALLSIGNS; +"SPAN_DELETE_0",SPAN_DELETE_0; +"SPAN_EMPTY",SPAN_EMPTY; +"SPAN_EQ",SPAN_EQ; +"SPAN_EQ_DIM",SPAN_EQ_DIM; +"SPAN_EQ_INSERT",SPAN_EQ_INSERT; +"SPAN_EQ_SELF",SPAN_EQ_SELF; +"SPAN_EXPLICIT",SPAN_EXPLICIT; +"SPAN_FINITE",SPAN_FINITE; +"SPAN_IMAGE_SCALE",SPAN_IMAGE_SCALE; +"SPAN_INC",SPAN_INC; +"SPAN_INDUCT",SPAN_INDUCT; +"SPAN_INDUCT_ALT",SPAN_INDUCT_ALT; +"SPAN_INSERT_0",SPAN_INSERT_0; +"SPAN_LINEAR_IMAGE",SPAN_LINEAR_IMAGE; +"SPAN_MBASIS",SPAN_MBASIS; +"SPAN_MONO",SPAN_MONO; +"SPAN_MUL",SPAN_MUL; +"SPAN_MUL_EQ",SPAN_MUL_EQ; +"SPAN_NEG",SPAN_NEG; +"SPAN_NEG_EQ",SPAN_NEG_EQ; +"SPAN_NOT_UNIV_ORTHOGONAL",SPAN_NOT_UNIV_ORTHOGONAL; +"SPAN_NOT_UNIV_SUBSET_HYPERPLANE",SPAN_NOT_UNIV_SUBSET_HYPERPLANE; +"SPAN_OF_SUBSPACE",SPAN_OF_SUBSPACE; +"SPAN_OPEN",SPAN_OPEN; +"SPAN_PCROSS",SPAN_PCROSS; +"SPAN_PCROSS_SUBSET",SPAN_PCROSS_SUBSET; +"SPAN_SING",SPAN_SING; +"SPAN_SPAN",SPAN_SPAN; +"SPAN_SPECIAL_SCALE",SPAN_SPECIAL_SCALE; +"SPAN_STDBASIS",SPAN_STDBASIS; +"SPAN_SUB",SPAN_SUB; +"SPAN_SUBSET_SUBSPACE",SPAN_SUBSET_SUBSPACE; +"SPAN_SUBSPACE",SPAN_SUBSPACE; +"SPAN_SUMS",SPAN_SUMS; +"SPAN_SUPERSET",SPAN_SUPERSET; +"SPAN_TRANS",SPAN_TRANS; +"SPAN_UNION",SPAN_UNION; +"SPAN_UNION_SUBSET",SPAN_UNION_SUBSET; +"SPAN_UNIV",SPAN_UNIV; +"SPAN_VSUM",SPAN_VSUM; +"SPECIAL_HYPERPLANE_SPAN",SPECIAL_HYPERPLANE_SPAN; +"SPHERE_1",SPHERE_1; +"SPHERE_EMPTY",SPHERE_EMPTY; +"SPHERE_EQ_EMPTY",SPHERE_EQ_EMPTY; +"SPHERE_EQ_SING",SPHERE_EQ_SING; +"SPHERE_LINEAR_IMAGE",SPHERE_LINEAR_IMAGE; +"SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE; +"SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN",SPHERE_RETRACT_OF_PUNCTURED_UNIVERSE_GEN; +"SPHERE_SING",SPHERE_SING; +"SPHERE_SUBSET_CBALL",SPHERE_SUBSET_CBALL; +"SPHERE_TRANSLATION",SPHERE_TRANSLATION; +"SPHERE_UNION_BALL",SPHERE_UNION_BALL; +"SQNORM_PASTECART",SQNORM_PASTECART; +"SQRT_0",SQRT_0; +"SQRT_1",SQRT_1; +"SQRT_DIV",SQRT_DIV; +"SQRT_EQ_0",SQRT_EQ_0; +"SQRT_EVEN_POW2",SQRT_EVEN_POW2; +"SQRT_INJ",SQRT_INJ; +"SQRT_INV",SQRT_INV; +"SQRT_LE_0",SQRT_LE_0; +"SQRT_LT_0",SQRT_LT_0; +"SQRT_MONO_LE",SQRT_MONO_LE; +"SQRT_MONO_LE_EQ",SQRT_MONO_LE_EQ; +"SQRT_MONO_LT",SQRT_MONO_LT; +"SQRT_MONO_LT_EQ",SQRT_MONO_LT_EQ; +"SQRT_MUL",SQRT_MUL; +"SQRT_NEG",SQRT_NEG; +"SQRT_POS_LE",SQRT_POS_LE; +"SQRT_POS_LT",SQRT_POS_LT; +"SQRT_POW2",SQRT_POW2; +"SQRT_POW_2",SQRT_POW_2; +"SQRT_UNIQUE",SQRT_UNIQUE; +"SQRT_UNIQUE_GEN",SQRT_UNIQUE_GEN; +"SQRT_WORKS",SQRT_WORKS; +"SQRT_WORKS_GEN",SQRT_WORKS_GEN; +"SQUARE_BOUND_LEMMA",SQUARE_BOUND_LEMMA; +"SQUARE_CONTINUOUS",SQUARE_CONTINUOUS; +"STARLIKE_CLOSURE",STARLIKE_CLOSURE; +"STARLIKE_COMPACT_PROJECTIVE",STARLIKE_COMPACT_PROJECTIVE; +"STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS",STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS; +"STARLIKE_IMP_CONNECTED",STARLIKE_IMP_CONNECTED; +"STARLIKE_IMP_CONTRACTIBLE",STARLIKE_IMP_CONTRACTIBLE; +"STARLIKE_IMP_CONTRACTIBLE_GEN",STARLIKE_IMP_CONTRACTIBLE_GEN; +"STARLIKE_IMP_PATH_CONNECTED",STARLIKE_IMP_PATH_CONNECTED; +"STARLIKE_IMP_SIMPLY_CONNECTED",STARLIKE_IMP_SIMPLY_CONNECTED; +"STARLIKE_LINEAR_IMAGE",STARLIKE_LINEAR_IMAGE; +"STARLIKE_LINEAR_IMAGE_EQ",STARLIKE_LINEAR_IMAGE_EQ; +"STARLIKE_NEGLIGIBLE",STARLIKE_NEGLIGIBLE; +"STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE",STARLIKE_NEGLIGIBLE_BOUNDED_MEASURABLE; +"STARLIKE_NEGLIGIBLE_LEMMA",STARLIKE_NEGLIGIBLE_LEMMA; +"STARLIKE_NEGLIGIBLE_STRONG",STARLIKE_NEGLIGIBLE_STRONG; +"STARLIKE_PCROSS",STARLIKE_PCROSS; +"STARLIKE_PCROSS_EQ",STARLIKE_PCROSS_EQ; +"STARLIKE_TRANSLATION_EQ",STARLIKE_TRANSLATION_EQ; +"STARLIKE_UNIV",STARLIKE_UNIV; +"STD_SIMPLEX",STD_SIMPLEX; +"STEINHAUS",STEINHAUS; +"STEINHAUS_LEBESGUE",STEINHAUS_LEBESGUE; +"STRETCH_GALOIS",STRETCH_GALOIS; +"SUB",SUB; +"SUBADDITIVE_CONTENT_DIVISION",SUBADDITIVE_CONTENT_DIVISION; +"SUBORDINATE_PARTITION_OF_UNITY",SUBORDINATE_PARTITION_OF_UNITY; +"SUBPATH_LINEAR_IMAGE",SUBPATH_LINEAR_IMAGE; +"SUBPATH_REFL",SUBPATH_REFL; +"SUBPATH_REVERSEPATH",SUBPATH_REVERSEPATH; +"SUBPATH_SCALING_LEMMA",SUBPATH_SCALING_LEMMA; +"SUBPATH_TO_FRONTIER",SUBPATH_TO_FRONTIER; +"SUBPATH_TO_FRONTIER_EXPLICIT",SUBPATH_TO_FRONTIER_EXPLICIT; +"SUBPATH_TO_FRONTIER_STRONG",SUBPATH_TO_FRONTIER_STRONG; +"SUBPATH_TRANSLATION",SUBPATH_TRANSLATION; +"SUBPATH_TRIVIAL",SUBPATH_TRIVIAL; +"SUBSEQUENCE_DIAGONALIZATION_LEMMA",SUBSEQUENCE_DIAGONALIZATION_LEMMA; +"SUBSET",SUBSET; +"SUBSET_ANTISYM",SUBSET_ANTISYM; +"SUBSET_ANTISYM_EQ",SUBSET_ANTISYM_EQ; +"SUBSET_BALL",SUBSET_BALL; +"SUBSET_BALLS",SUBSET_BALLS; +"SUBSET_CARD_EQ",SUBSET_CARD_EQ; +"SUBSET_CBALL",SUBSET_CBALL; +"SUBSET_CLOSURE",SUBSET_CLOSURE; +"SUBSET_CONTINUOUS_IMAGE_SEGMENT_1",SUBSET_CONTINUOUS_IMAGE_SEGMENT_1; +"SUBSET_DELETE",SUBSET_DELETE; +"SUBSET_DIFF",SUBSET_DIFF; +"SUBSET_DROP_IMAGE",SUBSET_DROP_IMAGE; +"SUBSET_EMPTY",SUBSET_EMPTY; +"SUBSET_FACE_OF_SIMPLEX",SUBSET_FACE_OF_SIMPLEX; +"SUBSET_HULL",SUBSET_HULL; +"SUBSET_HYPERPLANES",SUBSET_HYPERPLANES; +"SUBSET_IMAGE",SUBSET_IMAGE; +"SUBSET_INSERT",SUBSET_INSERT; +"SUBSET_INSERT_DELETE",SUBSET_INSERT_DELETE; +"SUBSET_INTER",SUBSET_INTER; +"SUBSET_INTERIOR",SUBSET_INTERIOR; +"SUBSET_INTERS",SUBSET_INTERS; +"SUBSET_INTERVAL",SUBSET_INTERVAL; +"SUBSET_INTERVAL_1",SUBSET_INTERVAL_1; +"SUBSET_INTERVAL_IMP",SUBSET_INTERVAL_IMP; +"SUBSET_INTER_ABSORPTION",SUBSET_INTER_ABSORPTION; +"SUBSET_LE_DIM",SUBSET_LE_DIM; +"SUBSET_LIFT_IMAGE",SUBSET_LIFT_IMAGE; +"SUBSET_NUMSEG",SUBSET_NUMSEG; +"SUBSET_OF_FACE_OF",SUBSET_OF_FACE_OF; +"SUBSET_PATH_IMAGE_JOIN",SUBSET_PATH_IMAGE_JOIN; +"SUBSET_PCROSS",SUBSET_PCROSS; +"SUBSET_PRED",SUBSET_PRED; +"SUBSET_PSUBSET_TRANS",SUBSET_PSUBSET_TRANS; +"SUBSET_REFL",SUBSET_REFL; +"SUBSET_RELATIVE_INTERIOR",SUBSET_RELATIVE_INTERIOR; +"SUBSET_RESTRICT",SUBSET_RESTRICT; +"SUBSET_SECOND_COUNTABLE",SUBSET_SECOND_COUNTABLE; +"SUBSET_SEGMENT",SUBSET_SEGMENT; +"SUBSET_SEGMENT_OPEN_CLOSED",SUBSET_SEGMENT_OPEN_CLOSED; +"SUBSET_SUMS_LCANCEL",SUBSET_SUMS_LCANCEL; +"SUBSET_SUMS_RCANCEL",SUBSET_SUMS_RCANCEL; +"SUBSET_TRANS",SUBSET_TRANS; +"SUBSET_UNION",SUBSET_UNION; +"SUBSET_UNIONS",SUBSET_UNIONS; +"SUBSET_UNION_ABSORPTION",SUBSET_UNION_ABSORPTION; +"SUBSET_UNIV",SUBSET_UNIV; +"SUBSPACE_0",SUBSPACE_0; +"SUBSPACE_ADD",SUBSPACE_ADD; +"SUBSPACE_BOUNDED_EQ_TRIVIAL",SUBSPACE_BOUNDED_EQ_TRIVIAL; +"SUBSPACE_CONVEX_CONE_SYMMETRIC",SUBSPACE_CONVEX_CONE_SYMMETRIC; +"SUBSPACE_HYPERPLANE",SUBSPACE_HYPERPLANE; +"SUBSPACE_IMP_AFFINE",SUBSPACE_IMP_AFFINE; +"SUBSPACE_IMP_CONIC",SUBSPACE_IMP_CONIC; +"SUBSPACE_IMP_CONVEX",SUBSPACE_IMP_CONVEX; +"SUBSPACE_IMP_CONVEX_CONE",SUBSPACE_IMP_CONVEX_CONE; +"SUBSPACE_IMP_NONEMPTY",SUBSPACE_IMP_NONEMPTY; +"SUBSPACE_INTER",SUBSPACE_INTER; +"SUBSPACE_INTERS",SUBSPACE_INTERS; +"SUBSPACE_ISOMORPHISM",SUBSPACE_ISOMORPHISM; +"SUBSPACE_KERNEL",SUBSPACE_KERNEL; +"SUBSPACE_LINEAR_FIXED_POINTS",SUBSPACE_LINEAR_FIXED_POINTS; +"SUBSPACE_LINEAR_IMAGE",SUBSPACE_LINEAR_IMAGE; +"SUBSPACE_LINEAR_IMAGE_EQ",SUBSPACE_LINEAR_IMAGE_EQ; +"SUBSPACE_LINEAR_PREIMAGE",SUBSPACE_LINEAR_PREIMAGE; +"SUBSPACE_MUL",SUBSPACE_MUL; +"SUBSPACE_NEG",SUBSPACE_NEG; +"SUBSPACE_ORTHOGONAL_TO_VECTOR",SUBSPACE_ORTHOGONAL_TO_VECTOR; +"SUBSPACE_ORTHOGONAL_TO_VECTORS",SUBSPACE_ORTHOGONAL_TO_VECTORS; +"SUBSPACE_PCROSS",SUBSPACE_PCROSS; +"SUBSPACE_PCROSS_EQ",SUBSPACE_PCROSS_EQ; +"SUBSPACE_SPAN",SUBSPACE_SPAN; +"SUBSPACE_SPECIAL_HYPERPLANE",SUBSPACE_SPECIAL_HYPERPLANE; +"SUBSPACE_SUB",SUBSPACE_SUB; +"SUBSPACE_SUBSTANDARD",SUBSPACE_SUBSTANDARD; +"SUBSPACE_SUMS",SUBSPACE_SUMS; +"SUBSPACE_TRANSLATION_SELF",SUBSPACE_TRANSLATION_SELF; +"SUBSPACE_TRANSLATION_SELF_EQ",SUBSPACE_TRANSLATION_SELF_EQ; +"SUBSPACE_TRIVIAL",SUBSPACE_TRIVIAL; +"SUBSPACE_UNION_CHAIN",SUBSPACE_UNION_CHAIN; +"SUBSPACE_UNIV",SUBSPACE_UNIV; +"SUBSPACE_VSUM",SUBSPACE_VSUM; +"SUBTOPOLOGY_SUPERSET",SUBTOPOLOGY_SUPERSET; +"SUBTOPOLOGY_TOPSPACE",SUBTOPOLOGY_TOPSPACE; +"SUBTOPOLOGY_UNIV",SUBTOPOLOGY_UNIV; +"SUB_0",SUB_0; +"SUB_ADD",SUB_ADD; +"SUB_ADD_LCANCEL",SUB_ADD_LCANCEL; +"SUB_ADD_RCANCEL",SUB_ADD_RCANCEL; +"SUB_ELIM_THM",SUB_ELIM_THM; +"SUB_ELIM_THM'",SUB_ELIM_THM'; +"SUB_EQ_0",SUB_EQ_0; +"SUB_PRESUC",SUB_PRESUC; +"SUB_REFL",SUB_REFL; +"SUB_SUC",SUB_SUC; +"SUC_DEF",SUC_DEF; +"SUC_INJ",SUC_INJ; +"SUC_SUB1",SUC_SUB1; +"SUMMABLE_0",SUMMABLE_0; +"SUMMABLE_ADD",SUMMABLE_ADD; +"SUMMABLE_BILINEAR_PARTIAL_PRE",SUMMABLE_BILINEAR_PARTIAL_PRE; +"SUMMABLE_CAUCHY",SUMMABLE_CAUCHY; +"SUMMABLE_CMUL",SUMMABLE_CMUL; +"SUMMABLE_COMPARISON",SUMMABLE_COMPARISON; +"SUMMABLE_COMPONENT",SUMMABLE_COMPONENT; +"SUMMABLE_EQ",SUMMABLE_EQ; +"SUMMABLE_EQ_COFINITE",SUMMABLE_EQ_COFINITE; +"SUMMABLE_EQ_EVENTUALLY",SUMMABLE_EQ_EVENTUALLY; +"SUMMABLE_FROM_ELSEWHERE",SUMMABLE_FROM_ELSEWHERE; +"SUMMABLE_IFF",SUMMABLE_IFF; +"SUMMABLE_IFF_COFINITE",SUMMABLE_IFF_COFINITE; +"SUMMABLE_IFF_EVENTUALLY",SUMMABLE_IFF_EVENTUALLY; +"SUMMABLE_IMP_BOUNDED",SUMMABLE_IMP_BOUNDED; +"SUMMABLE_IMP_SUMS_BOUNDED",SUMMABLE_IMP_SUMS_BOUNDED; +"SUMMABLE_IMP_TOZERO",SUMMABLE_IMP_TOZERO; +"SUMMABLE_LINEAR",SUMMABLE_LINEAR; +"SUMMABLE_NEG",SUMMABLE_NEG; +"SUMMABLE_REARRANGE",SUMMABLE_REARRANGE; +"SUMMABLE_REINDEX",SUMMABLE_REINDEX; +"SUMMABLE_RESTRICT",SUMMABLE_RESTRICT; +"SUMMABLE_SUB",SUMMABLE_SUB; +"SUMMABLE_SUBSET",SUMMABLE_SUBSET; +"SUMMABLE_SUBSET_ABSCONV",SUMMABLE_SUBSET_ABSCONV; +"SUMMABLE_TRIVIAL",SUMMABLE_TRIVIAL; +"SUMS_0",SUMS_0; +"SUMS_ASSOC",SUMS_ASSOC; +"SUMS_EQ",SUMS_EQ; +"SUMS_FINITE_DIFF",SUMS_FINITE_DIFF; +"SUMS_FINITE_UNION",SUMS_FINITE_UNION; +"SUMS_IFF",SUMS_IFF; +"SUMS_INFSUM",SUMS_INFSUM; +"SUMS_INTERVALS",SUMS_INTERVALS; +"SUMS_LIM",SUMS_LIM; +"SUMS_OFFSET",SUMS_OFFSET; +"SUMS_OFFSET_REV",SUMS_OFFSET_REV; +"SUMS_REINDEX",SUMS_REINDEX; +"SUMS_REINDEX_GEN",SUMS_REINDEX_GEN; +"SUMS_SUMMABLE",SUMS_SUMMABLE; +"SUMS_SYM",SUMS_SYM; +"SUM_0",SUM_0; +"SUM_1",SUM_1; +"SUM_2",SUM_2; +"SUM_3",SUM_3; +"SUM_4",SUM_4; +"SUM_ABS",SUM_ABS; +"SUM_ABS_BOUND",SUM_ABS_BOUND; +"SUM_ABS_LE",SUM_ABS_LE; +"SUM_ABS_NUMSEG",SUM_ABS_NUMSEG; +"SUM_ADD",SUM_ADD; +"SUM_ADD_GEN",SUM_ADD_GEN; +"SUM_ADD_NUMSEG",SUM_ADD_NUMSEG; +"SUM_ADD_SPLIT",SUM_ADD_SPLIT; +"SUM_BIJECTION",SUM_BIJECTION; +"SUM_BOUND",SUM_BOUND; +"SUM_BOUND_GEN",SUM_BOUND_GEN; +"SUM_BOUND_LT",SUM_BOUND_LT; +"SUM_BOUND_LT_ALL",SUM_BOUND_LT_ALL; +"SUM_BOUND_LT_GEN",SUM_BOUND_LT_GEN; +"SUM_CASES",SUM_CASES; +"SUM_CASES_1",SUM_CASES_1; +"SUM_CLAUSES",SUM_CLAUSES; +"SUM_CLAUSES_LEFT",SUM_CLAUSES_LEFT; +"SUM_CLAUSES_NUMSEG",SUM_CLAUSES_NUMSEG; +"SUM_CLAUSES_RIGHT",SUM_CLAUSES_RIGHT; +"SUM_CLOSED",SUM_CLOSED; +"SUM_COMBINE_L",SUM_COMBINE_L; +"SUM_COMBINE_R",SUM_COMBINE_R; +"SUM_CONST",SUM_CONST; +"SUM_CONST_NUMSEG",SUM_CONST_NUMSEG; +"SUM_CONTENT_AREA_OVER_THIN_DIVISION",SUM_CONTENT_AREA_OVER_THIN_DIVISION; +"SUM_DEGENERATE",SUM_DEGENERATE; +"SUM_DELETE",SUM_DELETE; +"SUM_DELETE_CASES",SUM_DELETE_CASES; +"SUM_DELTA",SUM_DELTA; +"SUM_DIFF",SUM_DIFF; +"SUM_DIFFS",SUM_DIFFS; +"SUM_DIFFS_ALT",SUM_DIFFS_ALT; +"SUM_EQ",SUM_EQ; +"SUM_EQ_0",SUM_EQ_0; +"SUM_EQ_0_NUMSEG",SUM_EQ_0_NUMSEG; +"SUM_EQ_GENERAL",SUM_EQ_GENERAL; +"SUM_EQ_GENERAL_INVERSES",SUM_EQ_GENERAL_INVERSES; +"SUM_EQ_NUMSEG",SUM_EQ_NUMSEG; +"SUM_EQ_SUPERSET",SUM_EQ_SUPERSET; +"SUM_GP",SUM_GP; +"SUM_GP_BASIC",SUM_GP_BASIC; +"SUM_GP_MULTIPLIED",SUM_GP_MULTIPLIED; +"SUM_GP_OFFSET",SUM_GP_OFFSET; +"SUM_GROUP",SUM_GROUP; +"SUM_IMAGE",SUM_IMAGE; +"SUM_IMAGE_GEN",SUM_IMAGE_GEN; +"SUM_IMAGE_LE",SUM_IMAGE_LE; +"SUM_IMAGE_NONZERO",SUM_IMAGE_NONZERO; +"SUM_INCL_EXCL",SUM_INCL_EXCL; +"SUM_INJECTION",SUM_INJECTION; +"SUM_LE",SUM_LE; +"SUM_LE_INCLUDED",SUM_LE_INCLUDED; +"SUM_LE_NUMSEG",SUM_LE_NUMSEG; +"SUM_LMUL",SUM_LMUL; +"SUM_LT",SUM_LT; +"SUM_LT_ALL",SUM_LT_ALL; +"SUM_MULTICOUNT",SUM_MULTICOUNT; +"SUM_MULTICOUNT_GEN",SUM_MULTICOUNT_GEN; +"SUM_NEG",SUM_NEG; +"SUM_OFFSET",SUM_OFFSET; +"SUM_OFFSET_0",SUM_OFFSET_0; +"SUM_OVER_PERMUTATIONS_INSERT",SUM_OVER_PERMUTATIONS_INSERT; +"SUM_OVER_PERMUTATIONS_NUMSEG",SUM_OVER_PERMUTATIONS_NUMSEG; +"SUM_OVER_TAGGED_DIVISION_LEMMA",SUM_OVER_TAGGED_DIVISION_LEMMA; +"SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",SUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; +"SUM_PAIR",SUM_PAIR; +"SUM_PARTIAL_PRE",SUM_PARTIAL_PRE; +"SUM_PARTIAL_SUC",SUM_PARTIAL_SUC; +"SUM_PERMUTATIONS_COMPOSE_L",SUM_PERMUTATIONS_COMPOSE_L; +"SUM_PERMUTATIONS_COMPOSE_R",SUM_PERMUTATIONS_COMPOSE_R; +"SUM_PERMUTATIONS_INVERSE",SUM_PERMUTATIONS_INVERSE; +"SUM_PERMUTE",SUM_PERMUTE; +"SUM_PERMUTE_NUMSEG",SUM_PERMUTE_NUMSEG; +"SUM_POS_BOUND",SUM_POS_BOUND; +"SUM_POS_EQ_0",SUM_POS_EQ_0; +"SUM_POS_EQ_0_NUMSEG",SUM_POS_EQ_0_NUMSEG; +"SUM_POS_LE",SUM_POS_LE; +"SUM_POS_LE_NUMSEG",SUM_POS_LE_NUMSEG; +"SUM_POS_LT",SUM_POS_LT; +"SUM_POS_LT_ALL",SUM_POS_LT_ALL; +"SUM_RESTRICT",SUM_RESTRICT; +"SUM_RESTRICT_SET",SUM_RESTRICT_SET; +"SUM_RMUL",SUM_RMUL; +"SUM_SING",SUM_SING; +"SUM_SING_NUMSEG",SUM_SING_NUMSEG; +"SUM_SUB",SUM_SUB; +"SUM_SUBSET",SUM_SUBSET; +"SUM_SUBSET_SIMPLE",SUM_SUBSET_SIMPLE; +"SUM_SUB_NUMSEG",SUM_SUB_NUMSEG; +"SUM_SUM_PRODUCT",SUM_SUM_PRODUCT; +"SUM_SUM_RESTRICT",SUM_SUM_RESTRICT; +"SUM_SUPERSET",SUM_SUPERSET; +"SUM_SUPPORT",SUM_SUPPORT; +"SUM_SWAP",SUM_SWAP; +"SUM_SWAP_NUMSEG",SUM_SWAP_NUMSEG; +"SUM_TRIV_NUMSEG",SUM_TRIV_NUMSEG; +"SUM_UNION",SUM_UNION; +"SUM_UNIONS_NONZERO",SUM_UNIONS_NONZERO; +"SUM_UNION_EQ",SUM_UNION_EQ; +"SUM_UNION_LZERO",SUM_UNION_LZERO; +"SUM_UNION_NONZERO",SUM_UNION_NONZERO; +"SUM_UNION_RZERO",SUM_UNION_RZERO; +"SUM_VSUM",SUM_VSUM; +"SUM_ZERO_EXISTS",SUM_ZERO_EXISTS; +"SUP",SUP; +"SUPERADMISSIBLE_COND",SUPERADMISSIBLE_COND; +"SUPERADMISSIBLE_CONST",SUPERADMISSIBLE_CONST; +"SUPERADMISSIBLE_MATCH_GUARDED_PATTERN",SUPERADMISSIBLE_MATCH_GUARDED_PATTERN; +"SUPERADMISSIBLE_MATCH_SEQPATTERN",SUPERADMISSIBLE_MATCH_SEQPATTERN; +"SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN",SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN; +"SUPERADMISSIBLE_T",SUPERADMISSIBLE_T; +"SUPERADMISSIBLE_TAIL",SUPERADMISSIBLE_TAIL; +"SUPPORTING_HYPERPLANE_CLOSED_POINT",SUPPORTING_HYPERPLANE_CLOSED_POINT; +"SUPPORTING_HYPERPLANE_COMPACT_POINT_INF",SUPPORTING_HYPERPLANE_COMPACT_POINT_INF; +"SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP",SUPPORTING_HYPERPLANE_COMPACT_POINT_SUP; +"SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY",SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY; +"SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER",SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER; +"SUPPORT_CLAUSES",SUPPORT_CLAUSES; +"SUPPORT_DELTA",SUPPORT_DELTA; +"SUPPORT_EMPTY",SUPPORT_EMPTY; +"SUPPORT_SUBSET",SUPPORT_SUBSET; +"SUPPORT_SUPPORT",SUPPORT_SUPPORT; +"SUP_CLOSURE",SUP_CLOSURE; +"SUP_EQ",SUP_EQ; +"SUP_FINITE",SUP_FINITE; +"SUP_FINITE_LEMMA",SUP_FINITE_LEMMA; +"SUP_INSERT",SUP_INSERT; +"SUP_INSERT_FINITE",SUP_INSERT_FINITE; +"SUP_SING",SUP_SING; +"SUP_UNION",SUP_UNION; +"SUP_UNIQUE",SUP_UNIQUE; +"SUP_UNIQUE_FINITE",SUP_UNIQUE_FINITE; +"SURA_BURA",SURA_BURA; +"SURA_BURA_CLOPEN_SUBSET",SURA_BURA_CLOPEN_SUBSET; +"SURA_BURA_COMPACT",SURA_BURA_COMPACT; +"SURJ",SURJ; +"SURJECTIVE_EXISTS_THM",SURJECTIVE_EXISTS_THM; +"SURJECTIVE_FORALL_THM",SURJECTIVE_FORALL_THM; +"SURJECTIVE_IFF_INJECTIVE",SURJECTIVE_IFF_INJECTIVE; +"SURJECTIVE_IFF_INJECTIVE_GEN",SURJECTIVE_IFF_INJECTIVE_GEN; +"SURJECTIVE_IMAGE",SURJECTIVE_IMAGE; +"SURJECTIVE_IMAGE_EQ",SURJECTIVE_IMAGE_EQ; +"SURJECTIVE_IMAGE_THM",SURJECTIVE_IMAGE_THM; +"SURJECTIVE_INVERSE",SURJECTIVE_INVERSE; +"SURJECTIVE_INVERSE_o",SURJECTIVE_INVERSE_o; +"SURJECTIVE_MAP",SURJECTIVE_MAP; +"SURJECTIVE_ON_IMAGE",SURJECTIVE_ON_IMAGE; +"SURJECTIVE_ON_RIGHT_INVERSE",SURJECTIVE_ON_RIGHT_INVERSE; +"SURJECTIVE_RIGHT_INVERSE",SURJECTIVE_RIGHT_INVERSE; +"SURJECTIVE_SCALING",SURJECTIVE_SCALING; +"SUSSMANN_OPEN_MAPPING",SUSSMANN_OPEN_MAPPING; +"SWAPSEQ_COMPOSE",SWAPSEQ_COMPOSE; +"SWAPSEQ_ENDSWAP",SWAPSEQ_ENDSWAP; +"SWAPSEQ_EVEN_EVEN",SWAPSEQ_EVEN_EVEN; +"SWAPSEQ_I",SWAPSEQ_I; +"SWAPSEQ_IDENTITY_EVEN",SWAPSEQ_IDENTITY_EVEN; +"SWAPSEQ_INVERSE",SWAPSEQ_INVERSE; +"SWAPSEQ_INVERSE_EXISTS",SWAPSEQ_INVERSE_EXISTS; +"SWAPSEQ_SWAP",SWAPSEQ_SWAP; +"SWAP_COMMON",SWAP_COMMON; +"SWAP_COMMON'",SWAP_COMMON'; +"SWAP_EXISTS_THM",SWAP_EXISTS_THM; +"SWAP_FORALL_THM",SWAP_FORALL_THM; +"SWAP_GALOIS",SWAP_GALOIS; +"SWAP_GENERAL",SWAP_GENERAL; +"SWAP_IDEMPOTENT",SWAP_IDEMPOTENT; +"SWAP_INDEPENDENT",SWAP_INDEPENDENT; +"SWAP_REFL",SWAP_REFL; +"SWAP_SYM",SWAP_SYM; +"SYLVESTER_DETERMINANT_IDENTITY",SYLVESTER_DETERMINANT_IDENTITY; +"SYMDIFF_PARITY_LEMMA",SYMDIFF_PARITY_LEMMA; +"SYMMETRIC_CLOSURE",SYMMETRIC_CLOSURE; +"SYMMETRIC_INTERIOR",SYMMETRIC_INTERIOR; +"SYMMETRIC_LINEAR_IMAGE",SYMMETRIC_LINEAR_IMAGE; +"SYMMETRIC_MATRIX",SYMMETRIC_MATRIX; +"SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT",SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT; +"SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE",SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE; +"SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE",SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE; +"SYMMETRIC_MATRIX_MUL",SYMMETRIC_MATRIX_MUL; +"SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS",SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS; +"SYMMETRIX_MATRIX_CONJUGATE",SYMMETRIX_MATRIX_CONJUGATE; +"SYMMETRY_LEMMA",SYMMETRY_LEMMA; +"TAGGED_DIVISION_FINER",TAGGED_DIVISION_FINER; +"TAGGED_DIVISION_OF",TAGGED_DIVISION_OF; +"TAGGED_DIVISION_OF_ALT",TAGGED_DIVISION_OF_ALT; +"TAGGED_DIVISION_OF_ANOTHER",TAGGED_DIVISION_OF_ANOTHER; +"TAGGED_DIVISION_OF_EMPTY",TAGGED_DIVISION_OF_EMPTY; +"TAGGED_DIVISION_OF_FINITE",TAGGED_DIVISION_OF_FINITE; +"TAGGED_DIVISION_OF_NONTRIVIAL",TAGGED_DIVISION_OF_NONTRIVIAL; +"TAGGED_DIVISION_OF_SELF",TAGGED_DIVISION_OF_SELF; +"TAGGED_DIVISION_OF_TRIVIAL",TAGGED_DIVISION_OF_TRIVIAL; +"TAGGED_DIVISION_OF_UNION_SELF",TAGGED_DIVISION_OF_UNION_SELF; +"TAGGED_DIVISION_SPLIT_LEFT_INJ",TAGGED_DIVISION_SPLIT_LEFT_INJ; +"TAGGED_DIVISION_SPLIT_RIGHT_INJ",TAGGED_DIVISION_SPLIT_RIGHT_INJ; +"TAGGED_DIVISION_UNION",TAGGED_DIVISION_UNION; +"TAGGED_DIVISION_UNIONS",TAGGED_DIVISION_UNIONS; +"TAGGED_DIVISION_UNIONS_EXISTS",TAGGED_DIVISION_UNIONS_EXISTS; +"TAGGED_DIVISION_UNION_IMAGE_SND",TAGGED_DIVISION_UNION_IMAGE_SND; +"TAGGED_DIVISION_UNION_INTERVAL",TAGGED_DIVISION_UNION_INTERVAL; +"TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND",TAGGED_PARTIAL_DIVISION_COMMON_POINT_BOUND; +"TAGGED_PARTIAL_DIVISION_COMMON_TAGS",TAGGED_PARTIAL_DIVISION_COMMON_TAGS; +"TAGGED_PARTIAL_DIVISION_OF_SUBSET",TAGGED_PARTIAL_DIVISION_OF_SUBSET; +"TAGGED_PARTIAL_DIVISION_OF_TRIVIAL",TAGGED_PARTIAL_DIVISION_OF_TRIVIAL; +"TAGGED_PARTIAL_DIVISION_OF_UNION_SELF",TAGGED_PARTIAL_DIVISION_OF_UNION_SELF; +"TAGGED_PARTIAL_DIVISION_SUBSET",TAGGED_PARTIAL_DIVISION_SUBSET; +"TAG_IN_INTERVAL",TAG_IN_INTERVAL; +"TARSKI_SET",TARSKI_SET; +"TENDSTO_LIM",TENDSTO_LIM; +"TIETZE",TIETZE; +"TIETZE_CLOSED_INTERVAL",TIETZE_CLOSED_INTERVAL; +"TIETZE_CLOSED_INTERVAL_1",TIETZE_CLOSED_INTERVAL_1; +"TIETZE_OPEN_INTERVAL",TIETZE_OPEN_INTERVAL; +"TIETZE_OPEN_INTERVAL_1",TIETZE_OPEN_INTERVAL_1; +"TIETZE_UNBOUNDED",TIETZE_UNBOUNDED; +"TL",TL; +"TOPOLOGICAL_SORT",TOPOLOGICAL_SORT; +"TOPOLOGY_EQ",TOPOLOGY_EQ; +"TOPSPACE_EUCLIDEAN",TOPSPACE_EUCLIDEAN; +"TOPSPACE_EUCLIDEAN_SUBTOPOLOGY",TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; +"TOPSPACE_SUBTOPOLOGY",TOPSPACE_SUBTOPOLOGY; +"TRACE_0",TRACE_0; +"TRACE_ADD",TRACE_ADD; +"TRACE_CONJUGATE",TRACE_CONJUGATE; +"TRACE_I",TRACE_I; +"TRACE_MUL_SYM",TRACE_MUL_SYM; +"TRACE_SUB",TRACE_SUB; +"TRACE_TRANSP",TRACE_TRANSP; +"TRANSITIVE_STEPWISE_LE",TRANSITIVE_STEPWISE_LE; +"TRANSITIVE_STEPWISE_LE_EQ",TRANSITIVE_STEPWISE_LE_EQ; +"TRANSITIVE_STEPWISE_LT",TRANSITIVE_STEPWISE_LT; +"TRANSITIVE_STEPWISE_LT_EQ",TRANSITIVE_STEPWISE_LT_EQ; +"TRANSLATION_DIFF",TRANSLATION_DIFF; +"TRANSLATION_EQ_IMP",TRANSLATION_EQ_IMP; +"TRANSLATION_GALOIS",TRANSLATION_GALOIS; +"TRANSLATION_UNIV",TRANSLATION_UNIV; +"TRANSP_COLUMNVECTOR",TRANSP_COLUMNVECTOR; +"TRANSP_COMPONENT",TRANSP_COMPONENT; +"TRANSP_DIAGONAL_MATRIX",TRANSP_DIAGONAL_MATRIX; +"TRANSP_EQ",TRANSP_EQ; +"TRANSP_MAT",TRANSP_MAT; +"TRANSP_MATRIX_ADD",TRANSP_MATRIX_ADD; +"TRANSP_MATRIX_CMUL",TRANSP_MATRIX_CMUL; +"TRANSP_MATRIX_NEG",TRANSP_MATRIX_NEG; +"TRANSP_MATRIX_SUB",TRANSP_MATRIX_SUB; +"TRANSP_ROWVECTOR",TRANSP_ROWVECTOR; +"TRANSP_TRANSP",TRANSP_TRANSP; +"TREAL_ADD_ASSOC",TREAL_ADD_ASSOC; +"TREAL_ADD_LDISTRIB",TREAL_ADD_LDISTRIB; +"TREAL_ADD_LID",TREAL_ADD_LID; +"TREAL_ADD_LINV",TREAL_ADD_LINV; +"TREAL_ADD_SYM",TREAL_ADD_SYM; +"TREAL_ADD_SYM_EQ",TREAL_ADD_SYM_EQ; +"TREAL_ADD_WELLDEF",TREAL_ADD_WELLDEF; +"TREAL_ADD_WELLDEFR",TREAL_ADD_WELLDEFR; +"TREAL_EQ_AP",TREAL_EQ_AP; +"TREAL_EQ_IMP_LE",TREAL_EQ_IMP_LE; +"TREAL_EQ_REFL",TREAL_EQ_REFL; +"TREAL_EQ_SYM",TREAL_EQ_SYM; +"TREAL_EQ_TRANS",TREAL_EQ_TRANS; +"TREAL_INV_0",TREAL_INV_0; +"TREAL_INV_WELLDEF",TREAL_INV_WELLDEF; +"TREAL_LE_ANTISYM",TREAL_LE_ANTISYM; +"TREAL_LE_LADD_IMP",TREAL_LE_LADD_IMP; +"TREAL_LE_MUL",TREAL_LE_MUL; +"TREAL_LE_REFL",TREAL_LE_REFL; +"TREAL_LE_TOTAL",TREAL_LE_TOTAL; +"TREAL_LE_TRANS",TREAL_LE_TRANS; +"TREAL_LE_WELLDEF",TREAL_LE_WELLDEF; +"TREAL_MUL_ASSOC",TREAL_MUL_ASSOC; +"TREAL_MUL_LID",TREAL_MUL_LID; +"TREAL_MUL_LINV",TREAL_MUL_LINV; +"TREAL_MUL_SYM",TREAL_MUL_SYM; +"TREAL_MUL_SYM_EQ",TREAL_MUL_SYM_EQ; +"TREAL_MUL_WELLDEF",TREAL_MUL_WELLDEF; +"TREAL_MUL_WELLDEFR",TREAL_MUL_WELLDEFR; +"TREAL_NEG_WELLDEF",TREAL_NEG_WELLDEF; +"TREAL_OF_NUM_ADD",TREAL_OF_NUM_ADD; +"TREAL_OF_NUM_EQ",TREAL_OF_NUM_EQ; +"TREAL_OF_NUM_LE",TREAL_OF_NUM_LE; +"TREAL_OF_NUM_MUL",TREAL_OF_NUM_MUL; +"TREAL_OF_NUM_WELLDEF",TREAL_OF_NUM_WELLDEF; +"TRIANGLE_LEMMA",TRIANGLE_LEMMA; +"TRIANGULATION_INTER_SIMPLEX",TRIANGULATION_INTER_SIMPLEX; +"TRIANGULATION_SIMPLICIAL_COMPLEX",TRIANGULATION_SIMPLICIAL_COMPLEX; +"TRIANGULATION_SUBSET",TRIANGULATION_SUBSET; +"TRIANGULATION_UNION",TRIANGULATION_UNION; +"TRIVIAL_LIMIT_AT",TRIVIAL_LIMIT_AT; +"TRIVIAL_LIMIT_AT_INFINITY",TRIVIAL_LIMIT_AT_INFINITY; +"TRIVIAL_LIMIT_AT_NEGINFINITY",TRIVIAL_LIMIT_AT_NEGINFINITY; +"TRIVIAL_LIMIT_AT_POSINFINITY",TRIVIAL_LIMIT_AT_POSINFINITY; +"TRIVIAL_LIMIT_SEQUENTIALLY",TRIVIAL_LIMIT_SEQUENTIALLY; +"TRIVIAL_LIMIT_WITHIN",TRIVIAL_LIMIT_WITHIN; +"TRIVIAL_LIMIT_WITHIN_CONVEX",TRIVIAL_LIMIT_WITHIN_CONVEX; +"TRIV_AND_EXISTS_THM",TRIV_AND_EXISTS_THM; +"TRIV_EXISTS_AND_THM",TRIV_EXISTS_AND_THM; +"TRIV_EXISTS_IMP_THM",TRIV_EXISTS_IMP_THM; +"TRIV_FORALL_IMP_THM",TRIV_FORALL_IMP_THM; +"TRIV_FORALL_OR_THM",TRIV_FORALL_OR_THM; +"TRIV_OR_FORALL_THM",TRIV_OR_FORALL_THM; +"TRUTH",TRUTH; +"TUBE_LEMMA",TUBE_LEMMA; +"TUBE_LEMMA_GEN",TUBE_LEMMA_GEN; +"TWO",TWO; +"T_DEF",T_DEF; +"UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT",UNBOUNDED_COMPONENTS_COMPLEMENT_ABSOLUTE_RETRACT; +"UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAY; +"UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS",UNBOUNDED_CONVEX_CLOSED_CONTAINS_RAYS; +"UNBOUNDED_HALFSPACE_COMPONENT_GE",UNBOUNDED_HALFSPACE_COMPONENT_GE; +"UNBOUNDED_HALFSPACE_COMPONENT_GT",UNBOUNDED_HALFSPACE_COMPONENT_GT; +"UNBOUNDED_HALFSPACE_COMPONENT_LE",UNBOUNDED_HALFSPACE_COMPONENT_LE; +"UNBOUNDED_HALFSPACE_COMPONENT_LT",UNBOUNDED_HALFSPACE_COMPONENT_LT; +"UNBOUNDED_INTER_COBOUNDED",UNBOUNDED_INTER_COBOUNDED; +"UNBOUNDED_OUTSIDE",UNBOUNDED_OUTSIDE; +"UNCOUNTABLE_CONNECTED",UNCOUNTABLE_CONNECTED; +"UNCOUNTABLE_CONTAINS_LIMIT_POINT",UNCOUNTABLE_CONTAINS_LIMIT_POINT; +"UNCOUNTABLE_CONVEX",UNCOUNTABLE_CONVEX; +"UNCOUNTABLE_EUCLIDEAN",UNCOUNTABLE_EUCLIDEAN; +"UNCOUNTABLE_HAS_CONDENSATION_POINT",UNCOUNTABLE_HAS_CONDENSATION_POINT; +"UNCOUNTABLE_INTERVAL",UNCOUNTABLE_INTERVAL; +"UNCOUNTABLE_NONEMPTY_INTERIOR",UNCOUNTABLE_NONEMPTY_INTERIOR; +"UNCOUNTABLE_OPEN",UNCOUNTABLE_OPEN; +"UNCOUNTABLE_PATH_CONNECTED",UNCOUNTABLE_PATH_CONNECTED; +"UNCOUNTABLE_REAL",UNCOUNTABLE_REAL; +"UNCOUNTABLE_SEGMENT",UNCOUNTABLE_SEGMENT; +"UNCURRY_DEF",UNCURRY_DEF; +"UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT",UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT; +"UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE",UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE; +"UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS; +"UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS",UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; +"UNIFORMLY_CONTINUOUS_ON_ADD",UNIFORMLY_CONTINUOUS_ON_ADD; +"UNIFORMLY_CONTINUOUS_ON_CLOSURE",UNIFORMLY_CONTINUOUS_ON_CLOSURE; +"UNIFORMLY_CONTINUOUS_ON_CMUL",UNIFORMLY_CONTINUOUS_ON_CMUL; +"UNIFORMLY_CONTINUOUS_ON_COMPOSE",UNIFORMLY_CONTINUOUS_ON_COMPOSE; +"UNIFORMLY_CONTINUOUS_ON_CONST",UNIFORMLY_CONTINUOUS_ON_CONST; +"UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT",UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT; +"UNIFORMLY_CONTINUOUS_ON_EQ",UNIFORMLY_CONTINUOUS_ON_EQ; +"UNIFORMLY_CONTINUOUS_ON_ID",UNIFORMLY_CONTINUOUS_ON_ID; +"UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST",UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST; +"UNIFORMLY_CONTINUOUS_ON_MUL",UNIFORMLY_CONTINUOUS_ON_MUL; +"UNIFORMLY_CONTINUOUS_ON_NEG",UNIFORMLY_CONTINUOUS_ON_NEG; +"UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY",UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; +"UNIFORMLY_CONTINUOUS_ON_SUB",UNIFORMLY_CONTINUOUS_ON_SUB; +"UNIFORMLY_CONTINUOUS_ON_SUBSET",UNIFORMLY_CONTINUOUS_ON_SUBSET; +"UNIFORMLY_CONTINUOUS_ON_VMUL",UNIFORMLY_CONTINUOUS_ON_VMUL; +"UNIFORMLY_CONTINUOUS_ON_VSUM",UNIFORMLY_CONTINUOUS_ON_VSUM; +"UNIFORMLY_CONVERGENT_EQ_CAUCHY",UNIFORMLY_CONVERGENT_EQ_CAUCHY; +"UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT",UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT; +"UNIFORM_LIM_ADD",UNIFORM_LIM_ADD; +"UNIFORM_LIM_BILINEAR",UNIFORM_LIM_BILINEAR; +"UNIFORM_LIM_SUB",UNIFORM_LIM_SUB; +"UNION",UNION; +"UNIONS",UNIONS; +"UNIONS_0",UNIONS_0; +"UNIONS_1",UNIONS_1; +"UNIONS_2",UNIONS_2; +"UNIONS_COMPONENTS",UNIONS_COMPONENTS; +"UNIONS_CONNECTED_COMPONENT",UNIONS_CONNECTED_COMPONENT; +"UNIONS_DIFF",UNIONS_DIFF; +"UNIONS_GSPEC",UNIONS_GSPEC; +"UNIONS_IMAGE",UNIONS_IMAGE; +"UNIONS_INSERT",UNIONS_INSERT; +"UNIONS_INTERS",UNIONS_INTERS; +"UNIONS_MAXIMAL_SETS",UNIONS_MAXIMAL_SETS; +"UNIONS_MONO",UNIONS_MONO; +"UNIONS_MONO_IMAGE",UNIONS_MONO_IMAGE; +"UNIONS_PATH_COMPONENT",UNIONS_PATH_COMPONENT; +"UNIONS_PRED",UNIONS_PRED; +"UNIONS_SUBSET",UNIONS_SUBSET; +"UNIONS_UNION",UNIONS_UNION; +"UNION_ACI",UNION_ACI; +"UNION_ASSOC",UNION_ASSOC; +"UNION_COMM",UNION_COMM; +"UNION_EMPTY",UNION_EMPTY; +"UNION_FL",UNION_FL; +"UNION_FRONTIER",UNION_FRONTIER; +"UNION_IDEMPOT",UNION_IDEMPOT; +"UNION_INSEG",UNION_INSEG; +"UNION_INTERIOR_SUBSET",UNION_INTERIOR_SUBSET; +"UNION_LE_ADD_C",UNION_LE_ADD_C; +"UNION_OVER_INTER",UNION_OVER_INTER; +"UNION_SEGMENT",UNION_SEGMENT; +"UNION_SUBSET",UNION_SUBSET; +"UNION_UNIV",UNION_UNIV; +"UNION_WITH_INSIDE",UNION_WITH_INSIDE; +"UNION_WITH_OUTSIDE",UNION_WITH_OUTSIDE; +"UNIQUE_SKOLEM_ALT",UNIQUE_SKOLEM_ALT; +"UNIQUE_SKOLEM_THM",UNIQUE_SKOLEM_THM; +"UNIT_INTERVAL_CONVEX_HULL",UNIT_INTERVAL_CONVEX_HULL; +"UNIT_INTERVAL_NONEMPTY",UNIT_INTERVAL_NONEMPTY; +"UNIV",UNIV; +"UNIV_GSPEC",UNIV_GSPEC; +"UNIV_NOT_EMPTY",UNIV_NOT_EMPTY; +"UNIV_PCROSS_UNIV",UNIV_PCROSS_UNIV; +"UNIV_SECOND_COUNTABLE",UNIV_SECOND_COUNTABLE; +"UNIV_SECOND_COUNTABLE_SEQUENCE",UNIV_SECOND_COUNTABLE_SEQUENCE; +"UNIV_SUBSET",UNIV_SUBSET; +"UNWIND_THM1",UNWIND_THM1; +"UNWIND_THM2",UNWIND_THM2; +"UPPER_BOUND_FINITE_SET",UPPER_BOUND_FINITE_SET; +"UPPER_BOUND_FINITE_SET_REAL",UPPER_BOUND_FINITE_SET_REAL; +"UPPER_HEMICONTINUOUS",UPPER_HEMICONTINUOUS; +"UPPER_LOWER_HEMICONTINUOUS",UPPER_LOWER_HEMICONTINUOUS; +"UPPER_LOWER_HEMICONTINUOUS_EXPLICIT",UPPER_LOWER_HEMICONTINUOUS_EXPLICIT; +"URYSOHN",URYSOHN; +"URYSOHN_LOCAL",URYSOHN_LOCAL; +"URYSOHN_LOCAL_STRONG",URYSOHN_LOCAL_STRONG; +"URYSOHN_STRONG",URYSOHN_STRONG; +"VARIATION_EQUAL_LEMMA",VARIATION_EQUAL_LEMMA; +"VECTOR_1",VECTOR_1; +"VECTOR_2",VECTOR_2; +"VECTOR_3",VECTOR_3; +"VECTOR_4",VECTOR_4; +"VECTOR_ADD_AC",VECTOR_ADD_AC; +"VECTOR_ADD_ASSOC",VECTOR_ADD_ASSOC; +"VECTOR_ADD_COMPONENT",VECTOR_ADD_COMPONENT; +"VECTOR_ADD_LDISTRIB",VECTOR_ADD_LDISTRIB; +"VECTOR_ADD_LID",VECTOR_ADD_LID; +"VECTOR_ADD_LINV",VECTOR_ADD_LINV; +"VECTOR_ADD_RDISTRIB",VECTOR_ADD_RDISTRIB; +"VECTOR_ADD_RID",VECTOR_ADD_RID; +"VECTOR_ADD_RINV",VECTOR_ADD_RINV; +"VECTOR_ADD_SUB",VECTOR_ADD_SUB; +"VECTOR_ADD_SYM",VECTOR_ADD_SYM; +"VECTOR_AFFINITY_EQ",VECTOR_AFFINITY_EQ; +"VECTOR_CHOOSE_DIST",VECTOR_CHOOSE_DIST; +"VECTOR_CHOOSE_SIZE",VECTOR_CHOOSE_SIZE; +"VECTOR_COMPONENTWISE",VECTOR_COMPONENTWISE; +"VECTOR_DERIVATIVE_AT",VECTOR_DERIVATIVE_AT; +"VECTOR_DERIVATIVE_CONST_AT",VECTOR_DERIVATIVE_CONST_AT; +"VECTOR_DERIVATIVE_UNIQUE_AT",VECTOR_DERIVATIVE_UNIQUE_AT; +"VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_UNIQUE_WITHIN_CLOSED_INTERVAL; +"VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL",VECTOR_DERIVATIVE_WITHIN_CLOSED_INTERVAL; +"VECTOR_DERIVATIVE_WORKS",VECTOR_DERIVATIVE_WORKS; +"VECTOR_DIFF_CHAIN_AT",VECTOR_DIFF_CHAIN_AT; +"VECTOR_DIFF_CHAIN_WITHIN",VECTOR_DIFF_CHAIN_WITHIN; +"VECTOR_EQ",VECTOR_EQ; +"VECTOR_EQ_ADDR",VECTOR_EQ_ADDR; +"VECTOR_EQ_AFFINITY",VECTOR_EQ_AFFINITY; +"VECTOR_EQ_DOT_SPAN",VECTOR_EQ_DOT_SPAN; +"VECTOR_EQ_LDOT",VECTOR_EQ_LDOT; +"VECTOR_EQ_NEG2",VECTOR_EQ_NEG2; +"VECTOR_EQ_RDOT",VECTOR_EQ_RDOT; +"VECTOR_EXPAND_1",VECTOR_EXPAND_1; +"VECTOR_EXPAND_2",VECTOR_EXPAND_2; +"VECTOR_EXPAND_3",VECTOR_EXPAND_3; +"VECTOR_EXPAND_4",VECTOR_EXPAND_4; +"VECTOR_IN_ORTHOGONAL_BASIS",VECTOR_IN_ORTHOGONAL_BASIS; +"VECTOR_IN_ORTHOGONAL_SPANNINGSET",VECTOR_IN_ORTHOGONAL_SPANNINGSET; +"VECTOR_IN_ORTHONORMAL_BASIS",VECTOR_IN_ORTHONORMAL_BASIS; +"VECTOR_MATRIX_MUL_TRANSP",VECTOR_MATRIX_MUL_TRANSP; +"VECTOR_MUL_ASSOC",VECTOR_MUL_ASSOC; +"VECTOR_MUL_COMPONENT",VECTOR_MUL_COMPONENT; +"VECTOR_MUL_EQ_0",VECTOR_MUL_EQ_0; +"VECTOR_MUL_LCANCEL",VECTOR_MUL_LCANCEL; +"VECTOR_MUL_LCANCEL_IMP",VECTOR_MUL_LCANCEL_IMP; +"VECTOR_MUL_LID",VECTOR_MUL_LID; +"VECTOR_MUL_LNEG",VECTOR_MUL_LNEG; +"VECTOR_MUL_LZERO",VECTOR_MUL_LZERO; +"VECTOR_MUL_RCANCEL",VECTOR_MUL_RCANCEL; +"VECTOR_MUL_RCANCEL_IMP",VECTOR_MUL_RCANCEL_IMP; +"VECTOR_MUL_RNEG",VECTOR_MUL_RNEG; +"VECTOR_MUL_RZERO",VECTOR_MUL_RZERO; +"VECTOR_NEG_0",VECTOR_NEG_0; +"VECTOR_NEG_COMPONENT",VECTOR_NEG_COMPONENT; +"VECTOR_NEG_EQ_0",VECTOR_NEG_EQ_0; +"VECTOR_NEG_MINUS1",VECTOR_NEG_MINUS1; +"VECTOR_NEG_NEG",VECTOR_NEG_NEG; +"VECTOR_NEG_SUB",VECTOR_NEG_SUB; +"VECTOR_ONE",VECTOR_ONE; +"VECTOR_SUB",VECTOR_SUB; +"VECTOR_SUB_ADD",VECTOR_SUB_ADD; +"VECTOR_SUB_ADD2",VECTOR_SUB_ADD2; +"VECTOR_SUB_COMPONENT",VECTOR_SUB_COMPONENT; +"VECTOR_SUB_EQ",VECTOR_SUB_EQ; +"VECTOR_SUB_LDISTRIB",VECTOR_SUB_LDISTRIB; +"VECTOR_SUB_LZERO",VECTOR_SUB_LZERO; +"VECTOR_SUB_PROJECT_ORTHOGONAL",VECTOR_SUB_PROJECT_ORTHOGONAL; +"VECTOR_SUB_RADD",VECTOR_SUB_RADD; +"VECTOR_SUB_RDISTRIB",VECTOR_SUB_RDISTRIB; +"VECTOR_SUB_REFL",VECTOR_SUB_REFL; +"VECTOR_SUB_RZERO",VECTOR_SUB_RZERO; +"VECTOR_VARIATION_AFFINITY",VECTOR_VARIATION_AFFINITY; +"VECTOR_VARIATION_AFFINITY2",VECTOR_VARIATION_AFFINITY2; +"VECTOR_VARIATION_COMBINE",VECTOR_VARIATION_COMBINE; +"VECTOR_VARIATION_CONST",VECTOR_VARIATION_CONST; +"VECTOR_VARIATION_CONST_EQ",VECTOR_VARIATION_CONST_EQ; +"VECTOR_VARIATION_CONTINUOUS",VECTOR_VARIATION_CONTINUOUS; +"VECTOR_VARIATION_CONTINUOUS_LEFT",VECTOR_VARIATION_CONTINUOUS_LEFT; +"VECTOR_VARIATION_CONTINUOUS_RIGHT",VECTOR_VARIATION_CONTINUOUS_RIGHT; +"VECTOR_VARIATION_EQ",VECTOR_VARIATION_EQ; +"VECTOR_VARIATION_GE_DROP_FUNCTION",VECTOR_VARIATION_GE_DROP_FUNCTION; +"VECTOR_VARIATION_GE_NORM_FUNCTION",VECTOR_VARIATION_GE_NORM_FUNCTION; +"VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE",VECTOR_VARIATION_INTEGRAL_NORM_DERIVATIVE; +"VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE",VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE; +"VECTOR_VARIATION_MONOTONE",VECTOR_VARIATION_MONOTONE; +"VECTOR_VARIATION_NEG",VECTOR_VARIATION_NEG; +"VECTOR_VARIATION_ON_DIVISION",VECTOR_VARIATION_ON_DIVISION; +"VECTOR_VARIATION_ON_NULL",VECTOR_VARIATION_ON_NULL; +"VECTOR_VARIATION_POS_LE",VECTOR_VARIATION_POS_LE; +"VECTOR_VARIATION_REFLECT",VECTOR_VARIATION_REFLECT; +"VECTOR_VARIATION_REFLECT2",VECTOR_VARIATION_REFLECT2; +"VECTOR_VARIATION_REFLECT_INTERVAL",VECTOR_VARIATION_REFLECT_INTERVAL; +"VECTOR_VARIATION_TRANSLATION",VECTOR_VARIATION_TRANSLATION; +"VECTOR_VARIATION_TRANSLATION2",VECTOR_VARIATION_TRANSLATION2; +"VECTOR_VARIATION_TRANSLATION_INTERVAL",VECTOR_VARIATION_TRANSLATION_INTERVAL; +"VECTOR_VARIATION_TRIANGLE",VECTOR_VARIATION_TRIANGLE; +"VEC_COMPONENT",VEC_COMPONENT; +"VEC_EQ",VEC_EQ; +"VSUM",VSUM; +"VSUM_0",VSUM_0; +"VSUM_1",VSUM_1; +"VSUM_2",VSUM_2; +"VSUM_3",VSUM_3; +"VSUM_4",VSUM_4; +"VSUM_ADD",VSUM_ADD; +"VSUM_ADD_GEN",VSUM_ADD_GEN; +"VSUM_ADD_NUMSEG",VSUM_ADD_NUMSEG; +"VSUM_ADD_SPLIT",VSUM_ADD_SPLIT; +"VSUM_BIJECTION",VSUM_BIJECTION; +"VSUM_CASES",VSUM_CASES; +"VSUM_CASES_1",VSUM_CASES_1; +"VSUM_CLAUSES",VSUM_CLAUSES; +"VSUM_CLAUSES_LEFT",VSUM_CLAUSES_LEFT; +"VSUM_CLAUSES_NUMSEG",VSUM_CLAUSES_NUMSEG; +"VSUM_CLAUSES_RIGHT",VSUM_CLAUSES_RIGHT; +"VSUM_CMUL_NUMSEG",VSUM_CMUL_NUMSEG; +"VSUM_COMBINE_L",VSUM_COMBINE_L; +"VSUM_COMBINE_R",VSUM_COMBINE_R; +"VSUM_COMPONENT",VSUM_COMPONENT; +"VSUM_CONST",VSUM_CONST; +"VSUM_CONST_NUMSEG",VSUM_CONST_NUMSEG; +"VSUM_CONTENT_NULL",VSUM_CONTENT_NULL; +"VSUM_DELETE",VSUM_DELETE; +"VSUM_DELETE_CASES",VSUM_DELETE_CASES; +"VSUM_DELTA",VSUM_DELTA; +"VSUM_DIFF",VSUM_DIFF; +"VSUM_DIFFS",VSUM_DIFFS; +"VSUM_DIFFS_ALT",VSUM_DIFFS_ALT; +"VSUM_DIFF_LEMMA",VSUM_DIFF_LEMMA; +"VSUM_EQ",VSUM_EQ; +"VSUM_EQ_0",VSUM_EQ_0; +"VSUM_EQ_GENERAL",VSUM_EQ_GENERAL; +"VSUM_EQ_GENERAL_INVERSES",VSUM_EQ_GENERAL_INVERSES; +"VSUM_EQ_NUMSEG",VSUM_EQ_NUMSEG; +"VSUM_EQ_SUPERSET",VSUM_EQ_SUPERSET; +"VSUM_GROUP",VSUM_GROUP; +"VSUM_IMAGE",VSUM_IMAGE; +"VSUM_IMAGE_GEN",VSUM_IMAGE_GEN; +"VSUM_IMAGE_NONZERO",VSUM_IMAGE_NONZERO; +"VSUM_INCL_EXCL",VSUM_INCL_EXCL; +"VSUM_INJECTION",VSUM_INJECTION; +"VSUM_LMUL",VSUM_LMUL; +"VSUM_NEG",VSUM_NEG; +"VSUM_NONZERO_IMAGE_LEMMA",VSUM_NONZERO_IMAGE_LEMMA; +"VSUM_NORM",VSUM_NORM; +"VSUM_NORM_ALLSUBSETS_BOUND",VSUM_NORM_ALLSUBSETS_BOUND; +"VSUM_NORM_BOUND",VSUM_NORM_BOUND; +"VSUM_NORM_LE",VSUM_NORM_LE; +"VSUM_NORM_TRIANGLE",VSUM_NORM_TRIANGLE; +"VSUM_OFFSET",VSUM_OFFSET; +"VSUM_OFFSET_0",VSUM_OFFSET_0; +"VSUM_OVER_TAGGED_DIVISION_LEMMA",VSUM_OVER_TAGGED_DIVISION_LEMMA; +"VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA",VSUM_OVER_TAGGED_PARTIAL_DIVISION_LEMMA; +"VSUM_PAIR",VSUM_PAIR; +"VSUM_PAIR_0",VSUM_PAIR_0; +"VSUM_PARTIAL_PRE",VSUM_PARTIAL_PRE; +"VSUM_PARTIAL_SUC",VSUM_PARTIAL_SUC; +"VSUM_REAL",VSUM_REAL; +"VSUM_RESTRICT",VSUM_RESTRICT; +"VSUM_RESTRICT_SET",VSUM_RESTRICT_SET; +"VSUM_RMUL",VSUM_RMUL; +"VSUM_SING",VSUM_SING; +"VSUM_SING_NUMSEG",VSUM_SING_NUMSEG; +"VSUM_SUB",VSUM_SUB; +"VSUM_SUB_NUMSEG",VSUM_SUB_NUMSEG; +"VSUM_SUC",VSUM_SUC; +"VSUM_SUPERSET",VSUM_SUPERSET; +"VSUM_SUPPORT",VSUM_SUPPORT; +"VSUM_SWAP",VSUM_SWAP; +"VSUM_SWAP_NUMSEG",VSUM_SWAP_NUMSEG; +"VSUM_TRIV_NUMSEG",VSUM_TRIV_NUMSEG; +"VSUM_UNION",VSUM_UNION; +"VSUM_UNIONS_NONZERO",VSUM_UNIONS_NONZERO; +"VSUM_UNION_LZERO",VSUM_UNION_LZERO; +"VSUM_UNION_NONZERO",VSUM_UNION_NONZERO; +"VSUM_UNION_RZERO",VSUM_UNION_RZERO; +"VSUM_VMUL",VSUM_VMUL; +"VSUM_VSUM_PRODUCT",VSUM_VSUM_PRODUCT; +"WF",WF; +"WF_DCHAIN",WF_DCHAIN; +"WF_EQ",WF_EQ; +"WF_EREC",WF_EREC; +"WF_FALSE",WF_FALSE; +"WF_FINITE",WF_FINITE; +"WF_IND",WF_IND; +"WF_INT_MEASURE",WF_INT_MEASURE; +"WF_INT_MEASURE_2",WF_INT_MEASURE_2; +"WF_LEX",WF_LEX; +"WF_LEX_DEPENDENT",WF_LEX_DEPENDENT; +"WF_MEASURE",WF_MEASURE; +"WF_MEASURE_GEN",WF_MEASURE_GEN; +"WF_POINTWISE",WF_POINTWISE; +"WF_REC",WF_REC; +"WF_REC_CASES",WF_REC_CASES; +"WF_REC_CASES'",WF_REC_CASES'; +"WF_REC_INVARIANT",WF_REC_INVARIANT; +"WF_REC_TAIL",WF_REC_TAIL; +"WF_REC_TAIL_GENERAL",WF_REC_TAIL_GENERAL; +"WF_REC_TAIL_GENERAL'",WF_REC_TAIL_GENERAL'; +"WF_REC_WF",WF_REC_WF; +"WF_REC_num",WF_REC_num; +"WF_REFL",WF_REFL; +"WF_SUBSET",WF_SUBSET; +"WF_UREC",WF_UREC; +"WF_UREC_WF",WF_UREC_WF; +"WF_num",WF_num; +"WITHIN",WITHIN; +"WITHIN_UNIV",WITHIN_UNIV; +"WITHIN_WITHIN",WITHIN_WITHIN; +"WLOG_LE",WLOG_LE; +"WLOG_LINEAR_INJECTIVE_IMAGE",WLOG_LINEAR_INJECTIVE_IMAGE; +"WLOG_LINEAR_INJECTIVE_IMAGE_2",WLOG_LINEAR_INJECTIVE_IMAGE_2; +"WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT; +"WLOG_LINEAR_INJECTIVE_IMAGE_ALT",WLOG_LINEAR_INJECTIVE_IMAGE_ALT; +"WLOG_LT",WLOG_LT; +"WO",WO; +"WOSET",WOSET; +"WOSET_ANTISYM",WOSET_ANTISYM; +"WOSET_FLEQ",WOSET_FLEQ; +"WOSET_POSET",WOSET_POSET; +"WOSET_REFL",WOSET_REFL; +"WOSET_TOTAL",WOSET_TOTAL; +"WOSET_TOTAL_LE",WOSET_TOTAL_LE; +"WOSET_TOTAL_LT",WOSET_TOTAL_LT; +"WOSET_TRANS",WOSET_TRANS; +"WOSET_TRANS_LE",WOSET_TRANS_LE; +"WOSET_TRANS_LESS",WOSET_TRANS_LESS; +"WOSET_WELL",WOSET_WELL; +"WOSET_WELL_CONTRAPOS",WOSET_WELL_CONTRAPOS; +"ZBOT",ZBOT; +"ZCONSTR",ZCONSTR; +"ZCONSTR_ZBOT",ZCONSTR_ZBOT; +"ZERO_DEF",ZERO_DEF; +"ZIP",ZIP; +"ZIP_DEF",ZIP_DEF; +"ZL",ZL; +"ZL_SUBSETS",ZL_SUBSETS; +"ZL_SUBSETS_UNIONS",ZL_SUBSETS_UNIONS; +"ZL_SUBSETS_UNIONS_NONEMPTY",ZL_SUBSETS_UNIONS_NONEMPTY; +"ZRECSPACE_CASES",ZRECSPACE_CASES; +"ZRECSPACE_INDUCT",ZRECSPACE_INDUCT; +"ZRECSPACE_RULES",ZRECSPACE_RULES; +"_FALSITY_",_FALSITY_; +"_FUNCTION",_FUNCTION; +"_GUARDED_PATTERN",_GUARDED_PATTERN; +"_MATCH",_MATCH; +"_SEQPATTERN",_SEQPATTERN; +"_UNGUARDED_PATTERN",_UNGUARDED_PATTERN; +"absolutely_integrable_on",absolutely_integrable_on; +"add_c",add_c; +"adjoint",adjoint; +"admissible",admissible; +"aff_dim",aff_dim; +"affine",affine; +"affine_dependent",affine_dependent; +"arc",arc; +"at",at; +"at_infinity",at_infinity; +"at_neginfinity",at_neginfinity; +"at_posinfinity",at_posinfinity; +"ball",ball; +"basis",basis; +"between",between; +"bilinear",bilinear; +"binarysum",binarysum; +"bitset",bitset; +"bool_INDUCT",bool_INDUCT; +"bool_RECURSION",bool_RECURSION; +"bounded",bounded; +"cart_tybij",cart_tybij; +"cauchy",cauchy; +"cball",cball; +"chain",chain; +"char_INDUCT",char_INDUCT; +"char_RECURSION",char_RECURSION; +"closed",closed; +"closed_in",closed_in; +"closed_interval",closed_interval; +"closed_segment",closed_segment; +"closest_point",closest_point; +"closure",closure; +"codeset",codeset; +"cofactor",cofactor; +"collinear",collinear; +"column",column; +"columns",columns; +"columnvector",columnvector; +"compact",compact; +"complete",complete; +"components",components; +"condensation_point_of",condensation_point_of; +"cong",cong; +"conic",conic; +"connected",connected; +"connected_component",connected_component; +"content",content; +"continuous",continuous; +"continuous_at",continuous_at; +"continuous_on",continuous_on; +"continuous_within",continuous_within; +"contractible",contractible; +"convex",convex; +"convex_cone",convex_cone; +"convex_on",convex_on; +"coplanar",coplanar; +"covering_space",covering_space; +"dependent",dependent; +"dest_int_rep",dest_int_rep; +"det",det; +"diagonal_matrix",diagonal_matrix; +"diameter",diameter; +"differentiable",differentiable; +"differentiable_on",differentiable_on; +"dim",dim; +"dimindex",dimindex; +"dist",dist; +"divides",divides; +"division_of",division_of; +"division_points",division_points; +"dot",dot; +"drop",drop; +"edge_of",edge_of; +"epigraph",epigraph; +"eq_c",eq_c; +"equiintegrable_on",equiintegrable_on; +"euclidean",euclidean; +"evenperm",evenperm; +"eventually",eventually; +"exposed_face_of",exposed_face_of; +"extreme_point_of",extreme_point_of; +"face_of",face_of; +"facet_of",facet_of; +"fine",fine; +"finite_image_tybij",finite_image_tybij; +"finite_index",finite_index; +"finite_sum_tybij",finite_sum_tybij; +"fl",fl; +"frechet_derivative",frechet_derivative; +"from",from; +"frontier",frontier; +"fstcart",fstcart; +"gauge",gauge; +"ge_c",ge_c; +"geom_mul",geom_mul; +"grade",grade; +"gt_c",gt_c; +"has_bounded_setvariation_on",has_bounded_setvariation_on; +"has_bounded_variation_on",has_bounded_variation_on; +"has_derivative",has_derivative; +"has_derivative_at",has_derivative_at; +"has_derivative_within",has_derivative_within; +"has_integral",has_integral; +"has_integral_alt",has_integral_alt; +"has_integral_compact_interval",has_integral_compact_interval; +"has_integral_def",has_integral_def; +"has_measure",has_measure; +"has_vector_derivative",has_vector_derivative; +"hausdist",hausdist; +"homeomorphic",homeomorphic; +"homeomorphism",homeomorphism; +"homotopic_loops",homotopic_loops; +"homotopic_paths",homotopic_paths; +"homotopic_with",homotopic_with; +"homotopy_equivalent",homotopy_equivalent; +"hreal_add",hreal_add; +"hreal_add_th",hreal_add_th; +"hreal_inv",hreal_inv; +"hreal_inv_th",hreal_inv_th; +"hreal_le",hreal_le; +"hreal_le_th",hreal_le_th; +"hreal_mul",hreal_mul; +"hreal_mul_th",hreal_mul_th; +"hreal_of_num",hreal_of_num; +"hreal_of_num_th",hreal_of_num_th; +"hull",hull; +"in_direction",in_direction; +"independent",independent; +"indicator",indicator; +"inf",inf; +"infnorm",infnorm; +"infsum",infsum; +"inner",inner; +"inseg",inseg; +"inside",inside; +"int_abs",int_abs; +"int_abs_th",int_abs_th; +"int_abstr",int_abstr; +"int_add",int_add; +"int_add_th",int_add_th; +"int_congruent",int_congruent; +"int_coprime",int_coprime; +"int_divides",int_divides; +"int_eq",int_eq; +"int_gcd",int_gcd; +"int_ge",int_ge; +"int_gt",int_gt; +"int_le",int_le; +"int_lt",int_lt; +"int_max",int_max; +"int_max_th",int_max_th; +"int_min",int_min; +"int_min_th",int_min_th; +"int_mod",int_mod; +"int_mul",int_mul; +"int_mul_th",int_mul_th; +"int_neg",int_neg; +"int_neg_th",int_neg_th; +"int_of_num",int_of_num; +"int_of_num_th",int_of_num_th; +"int_pow",int_pow; +"int_pow_th",int_pow_th; +"int_rep",int_rep; +"int_sgn",int_sgn; +"int_sgn_th",int_sgn_th; +"int_sub",int_sub; +"int_sub_th",int_sub_th; +"int_tybij",int_tybij; +"integer",integer; +"integrable_on",integrable_on; +"integral",integral; +"interior",interior; +"interval",interval; +"interval_bij",interval_bij; +"interval_lowerbound",interval_lowerbound; +"interval_upperbound",interval_upperbound; +"inverse",inverse; +"invertible",invertible; +"is_int",is_int; +"is_interval",is_interval; +"is_nadd",is_nadd; +"is_nadd_0",is_nadd_0; +"istopology",istopology; +"iterate",iterate; +"jacobian",jacobian; +"joinpaths",joinpaths; +"kle",kle; +"ksimplex",ksimplex; +"lambda",lambda; +"lambdas",lambdas; +"le_c",le_c; +"lebesgue_measurable",lebesgue_measurable; +"lemma",lemma; +"less",less; +"lift",lift; +"lifted",lifted; +"lim",lim; +"limit_point_of",limit_point_of; +"linear",linear; +"linepath",linepath; +"linseg",linseg; +"list_CASES",list_CASES; +"list_INDUCT",list_INDUCT; +"list_RECURSION",list_RECURSION; +"list_of_set",list_of_set; +"locally",locally; +"lt_c",lt_c; +"mat",mat; +"matrix",matrix; +"matrix_add",matrix_add; +"matrix_cmul",matrix_cmul; +"matrix_inv",matrix_inv; +"matrix_mul",matrix_mul; +"matrix_neg",matrix_neg; +"matrix_sub",matrix_sub; +"matrix_vector_mul",matrix_vector_mul; +"mbasis",mbasis; +"measurable",measurable; +"measurable_on",measurable_on; +"measure",measure; +"midpoint",midpoint; +"minimal",minimal; +"mk_pair_def",mk_pair_def; +"monoidal",monoidal; +"mul_c",mul_c; +"multivec",multivec; +"multivector",multivector; +"multivector_tybij",multivector_tybij; +"multivector_tybij_th",multivector_tybij_th; +"nadd_abs",nadd_abs; +"nadd_add",nadd_add; +"nadd_eq",nadd_eq; +"nadd_inv",nadd_inv; +"nadd_le",nadd_le; +"nadd_mul",nadd_mul; +"nadd_of_num",nadd_of_num; +"nadd_rep",nadd_rep; +"nadd_rinv",nadd_rinv; +"negligible",negligible; +"net_tybij",net_tybij; +"netlimit",netlimit; +"neutral",neutral; +"nproduct",nproduct; +"nsum",nsum; +"num_Axiom",num_Axiom; +"num_CASES",num_CASES; +"num_FINITE",num_FINITE; +"num_FINITE_AVOID",num_FINITE_AVOID; +"num_INDUCTION",num_INDUCTION; +"num_INFINITE",num_INFINITE; +"num_MAX",num_MAX; +"num_RECURSION",num_RECURSION; +"num_RECURSION_STD",num_RECURSION_STD; +"num_WF",num_WF; +"num_WOP",num_WOP; +"num_congruent",num_congruent; +"num_coprime",num_coprime; +"num_divides",num_divides; +"num_gcd",num_gcd; +"num_mod",num_mod; +"num_of_int",num_of_int; +"numseg",numseg; +"o_ASSOC",o_ASSOC; +"o_DEF",o_DEF; +"o_THM",o_THM; +"one",one; +"one_Axiom",one_Axiom; +"one_DEF",one_DEF; +"one_INDUCT",one_INDUCT; +"one_RECURSION",one_RECURSION; +"one_axiom",one_axiom; +"one_tydef",one_tydef; +"onorm",onorm; +"open_def",open_def; +"open_in",open_in; +"open_interval",open_interval; +"open_segment",open_segment; +"operative",operative; +"option_INDUCT",option_INDUCT; +"option_RECURSION",option_RECURSION; +"ordinal",ordinal; +"orthogonal",orthogonal; +"orthogonal_matrix",orthogonal_matrix; +"orthogonal_transformation",orthogonal_transformation; +"outer",outer; +"outermorphism",outermorphism; +"outside",outside; +"pair_INDUCT",pair_INDUCT; +"pair_RECURSION",pair_RECURSION; +"pairwise",pairwise; +"pastecart",pastecart; +"path",path; +"path_component",path_component; +"path_connected",path_connected; +"path_image",path_image; +"path_length",path_length; +"pathfinish",pathfinish; +"pathstart",pathstart; +"permutation",permutation; +"permutes",permutes; +"polyhedron",polyhedron; +"polynomial_function",polynomial_function; +"polytope",polytope; +"poset",poset; +"prod_tybij",prod_tybij; +"product",product; +"rank",rank; +"rational",rational; +"real_INFINITE",real_INFINITE; +"real_abs",real_abs; +"real_add",real_add; +"real_add_th",real_add_th; +"real_div",real_div; +"real_ge",real_ge; +"real_gt",real_gt; +"real_inv",real_inv; +"real_inv_th",real_inv_th; +"real_le",real_le; +"real_le_th",real_le_th; +"real_lt",real_lt; +"real_max",real_max; +"real_min",real_min; +"real_mod",real_mod; +"real_mul",real_mul; +"real_mul_th",real_mul_th; +"real_neg",real_neg; +"real_neg_th",real_neg_th; +"real_of_num",real_of_num; +"real_of_num_th",real_of_num_th; +"real_pow",real_pow; +"real_sgn",real_sgn; +"real_sub",real_sub; +"rectifiable_path",rectifiable_path; +"reduced",reduced; +"reflect_along",reflect_along; +"relative_frontier",relative_frontier; +"relative_interior",relative_interior; +"retract_of",retract_of; +"retraction",retraction; +"reversepath",reversepath; +"reversion",reversion; +"rotation_matrix",rotation_matrix; +"rotoinversion_matrix",rotoinversion_matrix; +"row",row; +"rows",rows; +"rowvector",rowvector; +"segment",segment; +"seqiterate",seqiterate; +"seqiterate_EXISTS",seqiterate_EXISTS; +"sequentially",sequentially; +"set_of_list",set_of_list; +"set_variation",set_variation; +"setcode",setcode; +"setdist",setdist; +"shiftpath",shiftpath; +"sign",sign; +"simple_path",simple_path; +"simplex",simplex; +"simplicial_complex",simplicial_complex; +"simply_connected",simply_connected; +"sindex",sindex; +"sndcart",sndcart; +"span",span; +"sphere",sphere; +"sqrt",sqrt; +"starlike",starlike; +"string_INFINITE",string_INFINITE; +"subpath",subpath; +"subspace",subspace; +"subtopology",subtopology; +"sum",sum; +"sum_CASES",sum_CASES; +"sum_DISTINCT",sum_DISTINCT; +"sum_INDUCT",sum_INDUCT; +"sum_INJECTIVE",sum_INJECTIVE; +"sum_RECURSION",sum_RECURSION; +"summable",summable; +"sums",sums; +"sup",sup; +"superadmissible",superadmissible; +"support",support; +"swap",swap; +"swapseq_CASES",swapseq_CASES; +"swapseq_INDUCT",swapseq_INDUCT; +"swapseq_RULES",swapseq_RULES; +"tagged_division_of",tagged_division_of; +"tagged_partial_division_of",tagged_partial_division_of; +"tailadmissible",tailadmissible; +"tendsto",tendsto; +"topology_tybij",topology_tybij; +"topology_tybij_th",topology_tybij_th; +"topspace",topspace; +"toset",toset; +"trace",trace; +"transp",transp; +"treal_add",treal_add; +"treal_eq",treal_eq; +"treal_inv",treal_inv; +"treal_le",treal_le; +"treal_mul",treal_mul; +"treal_neg",treal_neg; +"treal_of_num",treal_of_num; +"triangulation",triangulation; +"trivial_limit",trivial_limit; +"uniformly_continuous_on",uniformly_continuous_on; +"vec",vec; +"vector",vector; +"vector_add",vector_add; +"vector_derivative",vector_derivative; +"vector_matrix_mul",vector_matrix_mul; +"vector_mul",vector_mul; +"vector_neg",vector_neg; +"vector_norm",vector_norm; +"vector_sub",vector_sub; +"vector_variation",vector_variation; +"vsum",vsum; +"within",within; +"woset",woset +];; diff --git a/Multivariate/paths.ml b/Multivariate/paths.ml new file mode 100644 index 0000000..6d84262 --- /dev/null +++ b/Multivariate/paths.ml @@ -0,0 +1,17066 @@ +(* ========================================================================= *) +(* Paths, connectedness, homotopy, simple connectedness & contractibility. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; + +(* ------------------------------------------------------------------------- *) +(* Paths and arcs. *) +(* ------------------------------------------------------------------------- *) + +let path = new_definition + `!g:real^1->real^N. path g <=> g continuous_on interval[vec 0,vec 1]`;; + +let pathstart = new_definition + `pathstart (g:real^1->real^N) = g(vec 0)`;; + +let pathfinish = new_definition + `pathfinish (g:real^1->real^N) = g(vec 1)`;; + +let path_image = new_definition + `path_image (g:real^1->real^N) = IMAGE g (interval[vec 0,vec 1])`;; + +let reversepath = new_definition + `reversepath (g:real^1->real^N) = \x. g(vec 1 - x)`;; + +let joinpaths = new_definition + `(g1 ++ g2) = \x. if drop x <= &1 / &2 then g1(&2 % x) + else g2(&2 % x - vec 1)`;; + +let simple_path = new_definition + `simple_path (g:real^1->real^N) <=> + path g /\ + !x y. x IN interval[vec 0,vec 1] /\ + y IN interval[vec 0,vec 1] /\ + g x = g y + ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0`;; + +let arc = new_definition + `arc (g:real^1->real^N) <=> + path g /\ + !x y. x IN interval [vec 0,vec 1] /\ + y IN interval [vec 0,vec 1] /\ + g x = g y + ==> x = y`;; + +(* ------------------------------------------------------------------------- *) +(* Invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let PATH_EQ = prove + (`!p q. (!t. t IN interval[vec 0,vec 1] ==> p t = q t) /\ path p + ==> path q`, + REWRITE_TAC[path; CONTINUOUS_ON_EQ]);; + +let PATH_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N g. + path g /\ f continuous_on path_image g ==> path(f o g)`, + REWRITE_TAC[path; path_image; CONTINUOUS_ON_COMPOSE]);; + +let PATH_TRANSLATION_EQ = prove + (`!a g:real^1->real^N. path((\x. a + x) o g) <=> path g`, + REPEAT GEN_TAC THEN REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN `(g:real^1->real^N) = (\x. --a + x) o (\x. a + x) o g` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; + +add_translation_invariants [PATH_TRANSLATION_EQ];; + +let PATH_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N g. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (path(f o g) <=> path g)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `h:real^N->real^M` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN + REWRITE_TAC[path] THEN EQ_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN `g:real^1->real^M = h o (f:real^M->real^N) o g` + SUBST1_TAC THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]);; + +add_linear_invariants [PATH_LINEAR_IMAGE_EQ];; + +let PATHSTART_TRANSLATION = prove + (`!a g. pathstart((\x. a + x) o g) = a + pathstart g`, + REWRITE_TAC[pathstart; o_THM]);; + +add_translation_invariants [PATHSTART_TRANSLATION];; + +let PATHSTART_LINEAR_IMAGE_EQ = prove + (`!f g. linear f ==> pathstart(f o g) = f(pathstart g)`, + REWRITE_TAC[pathstart; o_THM]);; + +add_linear_invariants [PATHSTART_LINEAR_IMAGE_EQ];; + +let PATHFINISH_TRANSLATION = prove + (`!a g. pathfinish((\x. a + x) o g) = a + pathfinish g`, + REWRITE_TAC[pathfinish; o_THM]);; + +add_translation_invariants [PATHFINISH_TRANSLATION];; + +let PATHFINISH_LINEAR_IMAGE = prove + (`!f g. linear f ==> pathfinish(f o g) = f(pathfinish g)`, + REWRITE_TAC[pathfinish; o_THM]);; + +add_linear_invariants [PATHFINISH_LINEAR_IMAGE];; + +let PATH_IMAGE_TRANSLATION = prove + (`!a g. path_image((\x. a + x) o g) = IMAGE (\x. a + x) (path_image g)`, + REWRITE_TAC[path_image; IMAGE_o]);; + +add_translation_invariants [PATH_IMAGE_TRANSLATION];; + +let PATH_IMAGE_LINEAR_IMAGE = prove + (`!f g. linear f ==> path_image(f o g) = IMAGE f (path_image g)`, + REWRITE_TAC[path_image; IMAGE_o]);; + +add_linear_invariants [PATH_IMAGE_LINEAR_IMAGE];; + +let REVERSEPATH_TRANSLATION = prove + (`!a g. reversepath((\x. a + x) o g) = (\x. a + x) o reversepath g`, + REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);; + +add_translation_invariants [REVERSEPATH_TRANSLATION];; + +let REVERSEPATH_LINEAR_IMAGE = prove + (`!f g. linear f ==> reversepath(f o g) = f o reversepath g`, + REWRITE_TAC[FUN_EQ_THM; reversepath; o_THM]);; + +add_linear_invariants [REVERSEPATH_LINEAR_IMAGE];; + +let JOINPATHS_TRANSLATION = prove + (`!a:real^N g1 g2. ((\x. a + x) o g1) ++ ((\x. a + x) o g2) = + (\x. a + x) o (g1 ++ g2)`, + REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);; + +add_translation_invariants [JOINPATHS_TRANSLATION];; + +let JOINPATHS_LINEAR_IMAGE = prove + (`!f g1 g2. linear f ==> (f o g1) ++ (f o g2) = f o (g1 ++ g2)`, + REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM]);; + +add_linear_invariants [JOINPATHS_LINEAR_IMAGE];; + +let SIMPLE_PATH_TRANSLATION_EQ = prove + (`!a g:real^1->real^N. simple_path((\x. a + x) o g) <=> simple_path g`, + REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN + REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);; + +add_translation_invariants [SIMPLE_PATH_TRANSLATION_EQ];; + +let SIMPLE_PATH_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N g. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (simple_path(f o g) <=> simple_path g)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[simple_path; PATH_TRANSLATION_EQ] THEN + BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; + +add_linear_invariants [SIMPLE_PATH_LINEAR_IMAGE_EQ];; + +let ARC_TRANSLATION_EQ = prove + (`!a g:real^1->real^N. arc((\x. a + x) o g) <=> arc g`, + REPEAT GEN_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN + REWRITE_TAC[o_THM; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]);; + +add_translation_invariants [ARC_TRANSLATION_EQ];; + +let ARC_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N g. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (arc(f o g) <=> arc g)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[arc; PATH_TRANSLATION_EQ] THEN + BINOP_TAC THENL [ASM_MESON_TAC[PATH_LINEAR_IMAGE_EQ]; ALL_TAC] THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; + +add_linear_invariants [ARC_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Basic lemmas about paths. *) +(* ------------------------------------------------------------------------- *) + +let ARC_IMP_SIMPLE_PATH = prove + (`!g. arc g ==> simple_path g`, + REWRITE_TAC[arc; simple_path] THEN MESON_TAC[]);; + +let ARC_IMP_PATH = prove + (`!g. arc g ==> path g`, + REWRITE_TAC[arc] THEN MESON_TAC[]);; + +let SIMPLE_PATH_IMP_PATH = prove + (`!g. simple_path g ==> path g`, + REWRITE_TAC[simple_path] THEN MESON_TAC[]);; + +let SIMPLE_PATH_CASES = prove + (`!g:real^1->real^N. simple_path g ==> arc g \/ pathfinish g = pathstart g`, + REWRITE_TAC[simple_path; arc; pathfinish; pathstart] THEN + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(g:real^1->real^N) (vec 0) = g(vec 1)` THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^1`; `v:real^1`]) THEN + ASM_MESON_TAC[]);; + +let SIMPLE_PATH_IMP_ARC = prove + (`!g:real^1->real^N. + simple_path g /\ ~(pathfinish g = pathstart g) ==> arc g`, + MESON_TAC[SIMPLE_PATH_CASES]);; + +let ARC_DISTINCT_ENDS = prove + (`!g:real^1->real^N. arc g ==> ~(pathfinish g = pathstart g)`, + GEN_TAC THEN REWRITE_TAC[arc; pathfinish; pathstart] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a /\ b /\ ~d ==> ~c`] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let ARC_SIMPLE_PATH = prove + (`!g:real^1->real^N. + arc g <=> simple_path g /\ ~(pathfinish g = pathstart g)`, + MESON_TAC[SIMPLE_PATH_CASES; ARC_IMP_SIMPLE_PATH; ARC_DISTINCT_ENDS]);; + +let SIMPLE_PATH_EQ_ARC = prove + (`!g. ~(pathstart g = pathfinish g) ==> (simple_path g <=> arc g)`, + SIMP_TAC[ARC_SIMPLE_PATH]);; + +let PATH_IMAGE_NONEMPTY = prove + (`!g. ~(path_image g = {})`, + REWRITE_TAC[path_image; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY] THEN + SIMP_TAC[DIMINDEX_1; CONJ_ASSOC; LE_ANTISYM; UNWIND_THM1; VEC_COMPONENT; + ARITH; REAL_OF_NUM_LT]);; + +let PATHSTART_IN_PATH_IMAGE = prove + (`!g. (pathstart g) IN path_image g`, + GEN_TAC THEN REWRITE_TAC[pathstart; path_image] THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS]);; + +let PATHFINISH_IN_PATH_IMAGE = prove + (`!g. (pathfinish g) IN path_image g`, + GEN_TAC THEN REWRITE_TAC[pathfinish; path_image] THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REAL_ARITH_TAC);; + +let CONNECTED_PATH_IMAGE = prove + (`!g. path g ==> connected(path_image g)`, + REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[CONVEX_CONNECTED; CONVEX_INTERVAL]);; + +let COMPACT_PATH_IMAGE = prove + (`!g. path g ==> compact(path_image g)`, + REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL]);; + +let BOUNDED_PATH_IMAGE = prove + (`!g. path g ==> bounded(path_image g)`, + MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_BOUNDED]);; + +let CLOSED_PATH_IMAGE = prove + (`!g. path g ==> closed(path_image g)`, + MESON_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED]);; + +let CONNECTED_SIMPLE_PATH_IMAGE = prove + (`!g. simple_path g ==> connected(path_image g)`, + MESON_TAC[CONNECTED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; + +let COMPACT_SIMPLE_PATH_IMAGE = prove + (`!g. simple_path g ==> compact(path_image g)`, + MESON_TAC[COMPACT_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; + +let BOUNDED_SIMPLE_PATH_IMAGE = prove + (`!g. simple_path g ==> bounded(path_image g)`, + MESON_TAC[BOUNDED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; + +let CLOSED_SIMPLE_PATH_IMAGE = prove + (`!g. simple_path g ==> closed(path_image g)`, + MESON_TAC[CLOSED_PATH_IMAGE; SIMPLE_PATH_IMP_PATH]);; + +let CONNECTED_ARC_IMAGE = prove + (`!g. arc g ==> connected(path_image g)`, + MESON_TAC[CONNECTED_PATH_IMAGE; ARC_IMP_PATH]);; + +let COMPACT_ARC_IMAGE = prove + (`!g. arc g ==> compact(path_image g)`, + MESON_TAC[COMPACT_PATH_IMAGE; ARC_IMP_PATH]);; + +let BOUNDED_ARC_IMAGE = prove + (`!g. arc g ==> bounded(path_image g)`, + MESON_TAC[BOUNDED_PATH_IMAGE; ARC_IMP_PATH]);; + +let CLOSED_ARC_IMAGE = prove + (`!g. arc g ==> closed(path_image g)`, + MESON_TAC[CLOSED_PATH_IMAGE; ARC_IMP_PATH]);; + +let PATHSTART_COMPOSE = prove + (`!f p. pathstart(f o p) = f(pathstart p)`, + REWRITE_TAC[pathstart; o_THM]);; + +let PATHFINISH_COMPOSE = prove + (`!f p. pathfinish(f o p) = f(pathfinish p)`, + REWRITE_TAC[pathfinish; o_THM]);; + +let PATH_IMAGE_COMPOSE = prove + (`!f p. path_image (f o p) = IMAGE f (path_image p)`, + REWRITE_TAC[path_image; IMAGE_o]);; + +let PATH_COMPOSE_JOIN = prove + (`!f p q. f o (p ++ q) = (f o p) ++ (f o q)`, + REWRITE_TAC[joinpaths; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);; + +let PATH_COMPOSE_REVERSEPATH = prove + (`!f p. f o reversepath p = reversepath(f o p)`, + REWRITE_TAC[reversepath; o_DEF; FUN_EQ_THM] THEN MESON_TAC[]);; + +let JOIN_PATHS_EQ = prove + (`!p q:real^1->real^N. + (!t. t IN interval[vec 0,vec 1] ==> p t = p' t) /\ + (!t. t IN interval[vec 0,vec 1] ==> q t = q' t) + ==> !t. t IN interval[vec 0,vec 1] ==> (p ++ q) t = (p' ++ q') t`, + REWRITE_TAC[joinpaths; IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN + ASM_REAL_ARITH_TAC);; + +let CARD_EQ_SIMPLE_PATH_IMAGE = prove + (`!g. simple_path g ==> path_image g =_c (:real)`, + SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SIMPLE_PATH_IMAGE] THEN + GEN_TAC THEN REWRITE_TAC[simple_path; path_image] THEN MATCH_MP_TAC(SET_RULE + `(?u v. u IN s /\ v IN s /\ ~(u = a) /\ ~(v = a) /\ ~(u = v)) + ==> P /\ (!x y. x IN s /\ y IN s /\ f x = f y + ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) + ==> ~(?c. IMAGE f s SUBSET {c})`) THEN + MAP_EVERY EXISTS_TAC [`lift(&1 / &3)`; `lift(&1 / &2)`] THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_NUM; LIFT_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let INFINITE_SIMPLE_PATH_IMAGE = prove + (`!g. simple_path g ==> INFINITE(path_image g)`, + MESON_TAC[CARD_EQ_SIMPLE_PATH_IMAGE; INFINITE; FINITE_IMP_COUNTABLE; + UNCOUNTABLE_REAL; CARD_COUNTABLE_CONG]);; + +let CARD_EQ_ARC_IMAGE = prove + (`!g. arc g ==> path_image g =_c (:real)`, + MESON_TAC[ARC_IMP_SIMPLE_PATH; CARD_EQ_SIMPLE_PATH_IMAGE]);; + +let INFINITE_ARC_IMAGE = prove + (`!g. arc g ==> INFINITE(path_image g)`, + MESON_TAC[ARC_IMP_SIMPLE_PATH; INFINITE_SIMPLE_PATH_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Simple paths with the endpoints removed. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLE_PATH_ENDLESS = prove + (`!c:real^1->real^N. + simple_path c + ==> path_image c DIFF {pathstart c,pathfinish c} = + IMAGE c (interval(vec 0,vec 1))`, + REWRITE_TAC[simple_path; path_image; pathstart; pathfinish] THEN + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1; path] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x y. x IN s /\ y IN s /\ c x = c y + ==> x = y \/ x = a /\ y = b \/ x = b /\ y = a) /\ + a IN s /\ b IN s + ==> IMAGE c s DIFF {c a,c b} = IMAGE c (s DIFF {a,b})`) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);; + +let CONNECTED_SIMPLE_PATH_ENDLESS = prove + (`!c:real^1->real^N. + simple_path c + ==> connected(path_image c DIFF {pathstart c,pathfinish c})`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIMPLE_PATH_ENDLESS] THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + SIMP_TAC[CONVEX_INTERVAL; CONVEX_CONNECTED] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + RULE_ASSUM_TAC(REWRITE_RULE[simple_path; path]) THEN + ASM_REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]);; + +let NONEMPTY_SIMPLE_PATH_ENDLESS = prove + (`!c:real^1->real^N. + simple_path c ==> ~(path_image c DIFF {pathstart c,pathfinish c} = {})`, + SIMP_TAC[SIMPLE_PATH_ENDLESS; IMAGE_EQ_EMPTY; INTERVAL_EQ_EMPTY_1] THEN + REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The operations on paths. *) +(* ------------------------------------------------------------------------- *) + +let JOINPATHS = prove + (`!g1 g2. pathfinish g1 = pathstart g2 + ==> g1 ++ g2 = \x. if drop x < &1 / &2 then g1(&2 % x) + else g2 (&2 % x - vec 1)`, + REWRITE_TAC[pathstart; pathfinish] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[joinpaths; FUN_EQ_THM] THEN + X_GEN_TAC `x:real^1` THEN ASM_CASES_TAC `drop x = &1 / &2` THENL + [FIRST_X_ASSUM(MP_TAC o AP_TERM `lift`) THEN + REWRITE_TAC[LIFT_DROP] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_CMUL; REAL_LT_REFL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL]; + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC]);; + +let REVERSEPATH_REVERSEPATH = prove + (`!g:real^1->real^N. reversepath(reversepath g) = g`, + REWRITE_TAC[reversepath; ETA_AX; + VECTOR_ARITH `vec 1 - (vec 1 - x):real^1 = x`]);; + +let PATHSTART_REVERSEPATH = prove + (`pathstart(reversepath g) = pathfinish g`, + REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_RZERO]);; + +let PATHFINISH_REVERSEPATH = prove + (`pathfinish(reversepath g) = pathstart g`, + REWRITE_TAC[pathstart; reversepath; pathfinish; VECTOR_SUB_REFL]);; + +let PATHSTART_JOIN = prove + (`!g1 g2. pathstart(g1 ++ g2) = pathstart g1`, + REWRITE_TAC[joinpaths; pathstart; pathstart; DROP_VEC; VECTOR_MUL_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let PATHFINISH_JOIN = prove + (`!g1 g2. pathfinish(g1 ++ g2) = pathfinish g2`, + REPEAT GEN_TAC THEN REWRITE_TAC[joinpaths; pathfinish; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN AP_TERM_TAC THEN VECTOR_ARITH_TAC);; + +let PATH_IMAGE_REVERSEPATH = prove + (`!g:real^1->real^N. path_image(reversepath g) = path_image g`, + SUBGOAL_THEN `!g:real^1->real^N. + path_image(reversepath g) SUBSET path_image g` + (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH; SUBSET_ANTISYM]) THEN + REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^N`; `x:real^1`] THEN + DISCH_TAC THEN REWRITE_TAC[reversepath; IN_IMAGE] THEN + EXISTS_TAC `vec 1 - x:real^1` THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC);; + +let PATH_REVERSEPATH = prove + (`!g:real^1->real^N. path(reversepath g) <=> path g`, + SUBGOAL_THEN `!g:real^1->real^N. path g ==> path(reversepath g)` + (fun th -> MESON_TAC[th; REVERSEPATH_REVERSEPATH]) THEN + GEN_TAC THEN REWRITE_TAC[path; reversepath] THEN STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC; DROP_SUB] THEN REAL_ARITH_TAC);; + +let PATH_JOIN = prove + (`!g1 g2:real^1->real^N. + pathfinish g1 = pathstart g2 + ==> (path(g1 ++ g2) <=> path g1 /\ path g2)`, + REWRITE_TAC[path; pathfinish; pathstart] THEN + REPEAT STRIP_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(g1:real^1->real^N) = (\x. g1 (&2 % x)) o (\x. &1 / &2 % x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN + SIMP_TAC[DROP_VEC; REAL_ARITH `&1 / &2 * x <= &1 / &2 <=> x <= &1`]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN + REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC; + SUBGOAL_THEN + `(g2:real^1->real^N) = + (\x. g2 (&2 % x - vec 1)) o (\x. &1 / &2 % (x + vec 1))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `(g1 ++ g2):real^1->real^N` THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; joinpaths; IN_INTERVAL_1; DROP_CMUL] THEN + REWRITE_TAC[DROP_VEC; DROP_ADD; REAL_ARITH + `&1 / &2 * (x + &1) <= &1 / &2 <=> x <= &0`] THEN + SIMP_TAC[REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`; LIFT_NUM; + VECTOR_MUL_ASSOC; GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LID] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_ARITH `(x + vec 1) - vec 1 = x`]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_CMUL] THEN + REWRITE_TAC[DROP_VEC; DROP_ADD] THEN REAL_ARITH_TAC]; + STRIP_TAC THEN + SUBGOAL_THEN `interval[vec 0,vec 1] = + interval[vec 0,lift(&1 / &2)] UNION + interval[lift(&1 / &2),vec 1]` + SUBST1_TAC THENL + [SIMP_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `\x. (g1:real^1->real^N) (&2 % x)`; + EXISTS_TAC `\x. (g2:real^1->real^N) (&2 % x - vec 1)`] THEN + REWRITE_TAC[joinpaths] THEN SIMP_TAC[IN_INTERVAL_1; LIFT_DROP] THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % (x:real^1) = &2 % x + vec 0`] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM]; + ALL_TAC] THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_ARITH `&1 / &2 <= x ==> (x <= &1 / &2 <=> x = &1 / &2)`; + GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[LIFT_NUM] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[LIFT_NUM; VECTOR_SUB_REFL]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `&2 % x - vec 1 = &2 % x + --vec 1`] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL] THEN + REWRITE_TAC[REAL_POS; INTERVAL_EQ_EMPTY_1; LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_ADD_RID; VECTOR_MUL_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x + --x = x /\ x + --x = vec 0`]]);; + +let PATH_JOIN_IMP = prove + (`!g1 g2:real^1->real^N. + path g1 /\ path g2 /\ pathfinish g1 = pathstart g2 + ==> path(g1 ++ g2)`, + MESON_TAC[PATH_JOIN]);; + +let PATH_IMAGE_JOIN_SUBSET = prove + (`!g1 g2:real^1->real^N. + path_image(g1 ++ g2) SUBSET (path_image g1 UNION path_image g2)`, + REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN + GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; IN_UNION; IN_IMAGE; DROP_VEC; joinpaths] THEN + STRIP_TAC THEN ASM_CASES_TAC `drop x <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL + [DISJ1_TAC THEN EXISTS_TAC `&2 % x:real^1` THEN REWRITE_TAC[DROP_CMUL]; + DISJ2_TAC THEN EXISTS_TAC `&2 % x - vec 1:real^1` THEN + REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC]] THEN + ASM_REAL_ARITH_TAC);; + +let SUBSET_PATH_IMAGE_JOIN = prove + (`!g1 g2:real^1->real^N s. + path_image g1 SUBSET s /\ path_image g2 SUBSET s + ==> path_image(g1 ++ g2) SUBSET s`, + MP_TAC PATH_IMAGE_JOIN_SUBSET THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + SET_TAC[]);; + +let PATH_IMAGE_JOIN = prove + (`!g1 g2. pathfinish g1 = pathstart g2 + ==> path_image(g1 ++ g2) = path_image g1 UNION path_image g2`, + REWRITE_TAC[pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[PATH_IMAGE_JOIN_SUBSET] THEN + REWRITE_TAC[path_image; SUBSET; FORALL_AND_THM; IN_UNION; TAUT + `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + REWRITE_TAC[FORALL_IN_IMAGE; joinpaths] THEN + REWRITE_TAC[IN_INTERVAL_1; IN_IMAGE; DROP_VEC] THEN + CONJ_TAC THEN X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THENL + [EXISTS_TAC `(&1 / &2) % x:real^1` THEN + ASM_REWRITE_TAC[DROP_CMUL; REAL_ARITH + `&1 / &2 * x <= &1 / &2 <=> x <= &1`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID]; + EXISTS_TAC `(&1 / &2) % (x + vec 1):real^1` THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; DROP_VEC] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(x + vec 1) - vec 1 = x`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (&1 / &2 * (x + &1) <= &1 / &2 <=> + x = &0)`] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_LID; DROP_VEC]] THEN + ASM_REAL_ARITH_TAC);; + +let NOT_IN_PATH_IMAGE_JOIN = prove + (`!g1 g2 x. ~(x IN path_image g1) /\ ~(x IN path_image g2) + ==> ~(x IN path_image(g1 ++ g2))`, + MESON_TAC[PATH_IMAGE_JOIN_SUBSET; SUBSET; IN_UNION]);; + +let ARC_REVERSEPATH = prove + (`!g. arc g ==> arc(reversepath g)`, + GEN_TAC THEN SIMP_TAC[arc; PATH_REVERSEPATH] THEN + REWRITE_TAC[arc; reversepath] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC);; + +let SIMPLE_PATH_REVERSEPATH = prove + (`!g. simple_path g ==> simple_path (reversepath g)`, + GEN_TAC THEN SIMP_TAC[simple_path; PATH_REVERSEPATH] THEN + REWRITE_TAC[simple_path; reversepath] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1 - x:real^1`; `vec 1 - y:real^1`]) THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC);; + +let SIMPLE_PATH_JOIN_LOOP = prove + (`!g1 g2:real^1->real^N. + arc g1 /\ arc g2 /\ + pathfinish g1 = pathstart g2 /\ + pathfinish g2 = pathstart g1 /\ + (path_image g1 INTER path_image g2) SUBSET + {pathstart g1,pathstart g2} + ==> simple_path(g1 ++ g2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN + MATCH_MP_TAC(TAUT + `(a /\ b /\ c /\ d ==> f) /\ + (a' /\ b' /\ c /\ d /\ e ==> g) + ==> (a /\ a') /\ (b /\ b') /\ c /\ d /\ e ==> f /\ g`) THEN + CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN + REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart; + pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN + MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN + MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL + [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC; + ALL_TAC; + ASM_REAL_ARITH_TAC; + REMOVE_THEN "G2" (MP_TAC o SPECL + [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> DISJ1_TAC THEN MP_TAC th) THEN VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN + EXISTS_TAC `&2 % y:real^1 - vec 1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + STRIP_TAC THENL + [DISJ2_TAC THEN DISJ1_TAC; + DISJ1_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&1 / &2 % vec 1:real^1`] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [SUBGOAL_THEN `&2 % x:real^1 = vec 0` MP_TAC THENL + [ALL_TAC; VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G1" MATCH_MP_TAC; + DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_RZERO]) THEN + UNDISCH_TAC `T` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 1` MP_TAC THENL + [ALL_TAC; VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G2" MATCH_MP_TAC; + SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL + [ALL_TAC; VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G1" MATCH_MP_TAC; + DISCH_THEN SUBST_ALL_TAC THEN + SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL + [ALL_TAC; VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G2" MATCH_MP_TAC] THEN + (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN + ASM_REAL_ARITH_TAC));; + +let ARC_JOIN = prove + (`!g1 g2:real^1->real^N. + arc g1 /\ arc g2 /\ + pathfinish g1 = pathstart g2 /\ + (path_image g1 INTER path_image g2) SUBSET {pathstart g2} + ==> arc(g1 ++ g2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[arc; simple_path] THEN + MATCH_MP_TAC(TAUT + `(a /\ b /\ c /\ d ==> f) /\ + (a' /\ b' /\ c /\ d ==> g) + ==> (a /\ a') /\ (b /\ b') /\ c /\ d ==> f /\ g`) THEN + CONJ_TAC THENL [MESON_TAC[PATH_JOIN]; ALL_TAC] THEN + REWRITE_TAC[arc; simple_path; SUBSET; IN_INTER; pathstart; + pathfinish; IN_INTERVAL_1; DROP_VEC; IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G1") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "G2") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "G0")) THEN + MATCH_MP_TAC DROP_WLOG_LE THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[joinpaths] THEN + MAP_EVERY ASM_CASES_TAC [`drop x <= &1 / &2`; `drop y <= &1 / &2`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL + [REMOVE_THEN "G1" (MP_TAC o SPECL [`&2 % x:real^1`; `&2 % y:real^1`]) THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + VECTOR_ARITH_TAC; + ALL_TAC; + ASM_REAL_ARITH_TAC; + REMOVE_THEN "G2" (MP_TAC o SPECL + [`&2 % x:real^1 - vec 1`; `&2 % y:real^1 - vec 1`]) THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_VEC; DROP_SUB] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G0" (MP_TAC o SPEC `(g1:real^1->real^N) (&2 % x)`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[path_image; IN_IMAGE] THEN EXISTS_TAC `&2 % x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[path_image; IN_IMAGE] THEN + EXISTS_TAC `&2 % y:real^1 - vec 1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN `x:real^1 = &1 / &2 % vec 1` SUBST_ALL_TAC THENL + [SUBGOAL_THEN `&2 % x:real^1 = vec 1` MP_TAC THENL + [ALL_TAC; VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G1" MATCH_MP_TAC; + SUBGOAL_THEN `&2 % y:real^1 - vec 1 = vec 0` MP_TAC THENL + [ALL_TAC; VECTOR_ARITH_TAC] THEN + REMOVE_THEN "G2" MATCH_MP_TAC] THEN + (REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_SUB; DROP_VEC] THEN + ASM_REAL_ARITH_TAC));; + +let REVERSEPATH_JOINPATHS = prove + (`!g1 g2. pathfinish g1 = pathstart g2 + ==> reversepath(g1 ++ g2) = reversepath g2 ++ reversepath g1`, + REPEAT GEN_TAC THEN + REWRITE_TAC[reversepath; joinpaths; pathfinish; pathstart; FUN_EQ_THM] THEN + DISCH_TAC THEN X_GEN_TAC `t:real^1` THEN + REWRITE_TAC[DROP_VEC; DROP_SUB; REAL_ARITH + `&1 - x <= &1 / &2 <=> &1 / &2 <= x`] THEN + ASM_CASES_TAC `t = lift(&1 / &2)` THENL + [ASM_REWRITE_TAC[LIFT_DROP; REAL_LE_REFL; GSYM LIFT_NUM; GSYM LIFT_SUB; + GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[LIFT_NUM]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DROP_EQ]) THEN + REWRITE_TAC[LIFT_DROP] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_ARITH + `~(x = &1 / &2) ==> (&1 / &2 <= x <=> ~(x <= &1 / &2))`] THEN + ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Some reversed and "if and only if" versions of joining theorems. *) +(* ------------------------------------------------------------------------- *) + +let PATH_JOIN_PATH_ENDS = prove + (`!g1 g2:real^1->real^N. + path g2 /\ path(g1 ++ g2) ==> pathfinish g1 = pathstart g2`, + REPEAT GEN_TAC THEN DISJ_CASES_TAC(NORM_ARITH + `pathfinish g1:real^N = pathstart g2 \/ + &0 < dist(pathfinish g1,pathstart g2)`) THEN + ASM_REWRITE_TAC[path; continuous_on; joinpaths] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + REWRITE_TAC[pathstart; pathfinish] THEN + ABBREV_TAC `e = dist((g1:real^1->real^N)(vec 1),g2(vec 0:real^1))` THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `vec 0:real^1`) (MP_TAC o SPEC `lift(&1 / &2)`)) THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; LIFT_DROP; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM LIFT_CMUL; IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1"))) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2"))) THEN + REMOVE_THEN "2" (MP_TAC o SPEC `lift(min (&1 / &2) (min d1 d2) / &2)`) THEN + REWRITE_TAC[LIFT_DROP; DIST_LIFT; DIST_0; NORM_REAL; GSYM drop] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REMOVE_THEN "1" (MP_TAC o SPEC + `lift(&1 / &2 + min (&1 / &2) (min d1 d2) / &4)`) THEN + REWRITE_TAC[LIFT_DROP; DIST_LIFT] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM LIFT_CMUL; LIFT_ADD; REAL_ADD_LDISTRIB] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN + REWRITE_TAC[VECTOR_ADD_SUB; REAL_ARITH `&2 * x / &4 = x / &2`] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let PATH_JOIN_EQ = prove + (`!g1 g2:real^1->real^N. + path g1 /\ path g2 + ==> (path(g1 ++ g2) <=> pathfinish g1 = pathstart g2)`, + MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_JOIN_IMP]);; + +let SIMPLE_PATH_JOIN_IMP = prove + (`!g1 g2:real^1->real^N. + simple_path(g1 ++ g2) /\ pathfinish g1 = pathstart g2 + ==> arc g1 /\ arc g2 /\ + path_image g1 INTER path_image g2 SUBSET + {pathstart g1, pathstart g2}`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `path(g1:real^1->real^N) /\ path(g2:real^1->real^N)` THENL + [ALL_TAC; ASM_MESON_TAC[PATH_JOIN; SIMPLE_PATH_IMP_PATH]] THEN + REWRITE_TAC[simple_path; pathstart; pathfinish; arc] THEN + STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`&1 / &2 % x:real^1`; `&1 / &2 % y:real^1`]) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; joinpaths; DROP_CMUL] THEN + REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`&1 / &2 % (x + vec 1):real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN + ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_ADD; DROP_CMUL] THEN + REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID; VECTOR_ARITH `(a + b) - b:real^N = a`] THEN + ASM_REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; VECTOR_MUL_LID; DROP_VEC; + DROP_ADD] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SET_RULE + `s INTER t SUBSET u <=> !x. x IN s ==> x IN t ==> x IN u`] THEN + REWRITE_TAC[path_image; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN + SUBST1_TAC(SYM(ASSUME + `(g1:real^1->real^N)(vec 1) = g2(vec 0:real^1)`)) THEN + MATCH_MP_TAC(SET_RULE `x = a \/ x = b ==> f x IN {f a,f b}`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`&1 / &2 % x:real^1`; `&1 / &2 % (y + vec 1):real^1`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_ADD] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [joinpaths] THEN + ASM_SIMP_TAC[JOINPATHS; pathstart; pathfinish] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_VEC] THEN + REPEAT(COND_CASES_TAC THEN TRY ASM_REAL_ARITH_TAC) THEN + REWRITE_TAC[VECTOR_ARITH `&2 % &1 / &2 % x:real^N = x`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `(a + b) - b:real^N = a`]; + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_VEC] THEN + ASM_REAL_ARITH_TAC]]);; + +let SIMPLE_PATH_JOIN_LOOP_EQ = prove + (`!g1 g2:real^1->real^N. + pathfinish g2 = pathstart g1 /\ + pathfinish g1 = pathstart g2 + ==> (simple_path(g1 ++ g2) <=> + arc g1 /\ arc g2 /\ + path_image g1 INTER path_image g2 SUBSET + {pathstart g1, pathstart g2})`, + MESON_TAC[SIMPLE_PATH_JOIN_IMP; SIMPLE_PATH_JOIN_LOOP]);; + +let ARC_JOIN_EQ = prove + (`!g1 g2:real^1->real^N. + pathfinish g1 = pathstart g2 + ==> (arc(g1 ++ g2) <=> + arc g1 /\ arc g2 /\ + path_image g1 INTER path_image g2 SUBSET {pathstart g2})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[ARC_JOIN] THEN + GEN_REWRITE_TAC LAND_CONV [ARC_SIMPLE_PATH] THEN + REWRITE_TAC[PATHFINISH_JOIN; PATHSTART_JOIN] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g1:real^1->real^N`; `g2:real^1->real^N`] + SIMPLE_PATH_JOIN_IMP) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~((pathstart g1:real^N) IN path_image g2)` + (fun th -> MP_TAC th THEN ASM SET_TAC[]) THEN + REWRITE_TAC[path_image; IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN + DISCH_THEN(MP_TAC o SPECL [`vec 0:real^1`; `lift(&1 / &2) + inv(&2) % u`] o + CONJUNCT2) THEN + REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1; DROP_ADD; DROP_VEC; + DROP_CMUL; LIFT_DROP; joinpaths] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_IMP_NZ; + REAL_ARITH `&0 <= x ==> &0 < &1 / &2 + &1 / &2 * x`] THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 + &1 / &2 * u = &1 <=> u = &1`] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 <= u ==> (&1 / &2 + &1 / &2 * u <= &1 / &2 <=> u = &0)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + ASM_SIMP_TAC[REAL_ARITH `u <= &1 ==> &1 / &2 + &1 / &2 * u <= &1`] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_RID; GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN + ASM_REWRITE_TAC[VEC_EQ] THEN ARITH_TAC; + REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM LIFT_CMUL] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[LIFT_NUM; VECTOR_MUL_LID; VECTOR_ADD_SUB] THEN + ASM_MESON_TAC[]]);; + +let ARC_JOIN_EQ_ALT = prove + (`!g1 g2:real^1->real^N. + pathfinish g1 = pathstart g2 + ==> (arc(g1 ++ g2) <=> + arc g1 /\ arc g2 /\ + path_image g1 INTER path_image g2 = {pathstart g2})`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[ARC_JOIN_EQ] THEN + MP_TAC(ISPEC `g1:real^1->real^N` PATHFINISH_IN_PATH_IMAGE) THEN + MP_TAC(ISPEC `g2:real^1->real^N` PATHSTART_IN_PATH_IMAGE) THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Reassociating a joined path doesn't matter for various properties. *) +(* ------------------------------------------------------------------------- *) + +let PATH_ASSOC = prove + (`!p q r:real^1->real^N. + pathfinish p = pathstart q /\ pathfinish q = pathstart r + ==> (path(p ++ (q ++ r)) <=> path((p ++ q) ++ r))`, + SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN] THEN CONV_TAC TAUT);; + +let SIMPLE_PATH_ASSOC = prove + (`!p q r:real^1->real^N. + pathfinish p = pathstart q /\ pathfinish q = pathstart r + ==> (simple_path(p ++ (q ++ r)) <=> simple_path((p ++ q) ++ r))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `pathstart(p:real^1->real^N) = pathfinish r` THENL + [ALL_TAC; + ASM_SIMP_TAC[SIMPLE_PATH_EQ_ARC; PATHSTART_JOIN; PATHFINISH_JOIN]] THEN + ASM_SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; PATHSTART_JOIN; PATHFINISH_JOIN; + ARC_JOIN_EQ; PATH_IMAGE_JOIN] THEN + MAP_EVERY ASM_CASES_TAC + [`arc(p:real^1->real^N)`; `arc(q:real^1->real^N)`; + `arc(r:real^1->real^N)`] THEN + ASM_REWRITE_TAC[UNION_OVER_INTER; UNION_SUBSET; + ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP ARC_DISTINCT_ENDS)) THEN + MAP_EVERY (fun t -> MP_TAC(ISPEC t PATHSTART_IN_PATH_IMAGE) THEN + MP_TAC(ISPEC t PATHFINISH_IN_PATH_IMAGE)) + [`p:real^1->real^N`; `q:real^1->real^N`; `r:real^1->real^N`] THEN + ASM SET_TAC[]);; + +let ARC_ASSOC = prove + (`!p q r:real^1->real^N. + pathfinish p = pathstart q /\ pathfinish q = pathstart r + ==> (arc(p ++ (q ++ r)) <=> arc((p ++ q) ++ r))`, + SIMP_TAC[ARC_SIMPLE_PATH; SIMPLE_PATH_ASSOC] THEN + SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN]);; + +(* ------------------------------------------------------------------------- *) +(* In the case of a loop, neither does symmetry. *) +(* ------------------------------------------------------------------------- *) + +let PATH_SYM = prove + (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p + ==> (path(p ++ q) <=> path(q ++ p))`, + SIMP_TAC[PATH_JOIN; CONJ_ACI]);; + +let SIMPLE_PATH_SYM = prove + (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p + ==> (simple_path(p ++ q) <=> simple_path(q ++ p))`, + SIMP_TAC[SIMPLE_PATH_JOIN_LOOP_EQ; INTER_ACI; CONJ_ACI; INSERT_AC]);; + +let PATH_IMAGE_SYM = prove + (`!p q. pathfinish p = pathstart q /\ pathfinish q = pathstart p + ==> path_image(p ++ q) = path_image(q ++ p)`, + SIMP_TAC[PATH_IMAGE_JOIN; UNION_ACI]);; + +(* ------------------------------------------------------------------------- *) +(* Reparametrizing a closed curve to start at some chosen point. *) +(* ------------------------------------------------------------------------- *) + +let shiftpath = new_definition + `shiftpath a (f:real^1->real^N) = + \x. if drop(a + x) <= &1 then f(a + x) + else f(a + x - vec 1)`;; + +let SHIFTPATH_TRANSLATION = prove + (`!a t g. shiftpath t ((\x. a + x) o g) = (\x. a + x) o shiftpath t g`, + REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);; + +add_translation_invariants [SHIFTPATH_TRANSLATION];; + +let SHIFTPATH_LINEAR_IMAGE = prove + (`!f t g. linear f ==> shiftpath t (f o g) = f o shiftpath t g`, + REWRITE_TAC[FUN_EQ_THM; shiftpath; o_THM] THEN MESON_TAC[]);; + +add_linear_invariants [SHIFTPATH_LINEAR_IMAGE];; + +let PATHSTART_SHIFTPATH = prove + (`!a g. drop a <= &1 ==> pathstart(shiftpath a g) = g(a)`, + SIMP_TAC[pathstart; shiftpath; VECTOR_ADD_RID]);; + +let PATHFINISH_SHIFTPATH = prove + (`!a g. &0 <= drop a /\ pathfinish g = pathstart g + ==> pathfinish(shiftpath a g) = g(a)`, + SIMP_TAC[pathfinish; shiftpath; pathstart; DROP_ADD; DROP_VEC] THEN + REWRITE_TAC[VECTOR_ARITH `a + vec 1 - vec 1 = a`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> (x + &1 <= &1 <=> x = &0)`] THEN + SIMP_TAC[DROP_EQ_0; VECTOR_ADD_LID] THEN MESON_TAC[]);; + +let ENDPOINTS_SHIFTPATH = prove + (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] + ==> pathfinish(shiftpath a g) = g a /\ + pathstart(shiftpath a g) = g a`, + SIMP_TAC[IN_INTERVAL_1; DROP_VEC; + PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]);; + +let CLOSED_SHIFTPATH = prove + (`!a g. pathfinish g = pathstart g /\ a IN interval[vec 0,vec 1] + ==> pathfinish(shiftpath a g) = pathstart(shiftpath a g)`, + SIMP_TAC[IN_INTERVAL_1; PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; + DROP_VEC]);; + +let PATH_SHIFTPATH = prove + (`!g a. path g /\ pathfinish g:real^N = pathstart g /\ + a IN interval[vec 0,vec 1] + ==> path(shiftpath a g)`, + REWRITE_TAC[shiftpath; path] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `interval[vec 0,vec 1] = interval[vec 0,vec 1 - a:real^1] UNION + interval[vec 1 - a,vec 1]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_UNION THEN REWRITE_TAC[CLOSED_INTERVAL] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `(\x. g(a + x)):real^1->real^N` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN + SIMP_TAC[REAL_ARITH `a + x <= &1 <=> x <= &1 - a`]; + EXISTS_TAC `(\x. g(a + x - vec 1)):real^1->real^N` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_VEC; DROP_SUB] THEN + SIMP_TAC[REAL_ARITH `&1 - a <= x ==> (a + x <= &1 <=> a + x = &1)`] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[VECTOR_ARITH `a + x - vec 1 = (a + x) - vec 1`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_NUM; LIFT_DROP] THEN + REWRITE_TAC[VECTOR_SUB_REFL; COND_ID]] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; + CONTINUOUS_ON_SUB] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_ADD] THEN + REAL_ARITH_TAC);; + +let SHIFTPATH_SHIFTPATH = prove + (`!g a x. a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g /\ + x IN interval[vec 0,vec 1] + ==> shiftpath (vec 1 - a) (shiftpath a g) x = g x`, + REWRITE_TAC[shiftpath; pathfinish; pathstart] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[DROP_VEC] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; + AP_TERM_TAC THEN VECTOR_ARITH_TAC; + AP_TERM_TAC THEN VECTOR_ARITH_TAC; + ASM_REAL_ARITH_TAC] THEN + SUBGOAL_THEN `x:real^1 = vec 0` SUBST1_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[VECTOR_ARITH `a + vec 1 - a + vec 0:real^1 = vec 1`]]);; + +let PATH_IMAGE_SHIFTPATH = prove + (`!a g:real^1->real^N. + a IN interval[vec 0,vec 1] /\ pathfinish g = pathstart g + ==> path_image(shiftpath a g) = path_image g`, + REWRITE_TAC[IN_INTERVAL_1; pathfinish; pathstart] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + REWRITE_TAC[path_image; shiftpath; FORALL_IN_IMAGE; SUBSET] THEN + REWRITE_TAC[IN_IMAGE] THEN REPEAT STRIP_TAC THEN + REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_IMAGE] THENL + [EXISTS_TAC `a + x:real^1`; + EXISTS_TAC `a + x - vec 1:real^1`; + ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_SUB; DROP_ADD] THEN + TRY REAL_ARITH_TAC THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `drop a <= drop x` THENL + [EXISTS_TAC `x - a:real^1` THEN + REWRITE_TAC[VECTOR_ARITH `a + x - a:real^1 = x`; DROP_SUB] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + EXISTS_TAC `vec 1 + x - a:real^1` THEN + REWRITE_TAC[VECTOR_ARITH `a + (v + x - a) - v:real^1 = x`] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC] THEN + ASM_CASES_TAC `x:real^1 = vec 0` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + v + x - a:real^1 = v + x`] THEN + ASM_REWRITE_TAC[VECTOR_ADD_RID; DROP_VEC; COND_ID] THEN + ASM_REWRITE_TAC[REAL_ARITH `a + &1 + x - a <= &1 <=> x <= &0`] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM DROP_EQ; DROP_VEC] THEN + TRY(COND_CASES_TAC THEN POP_ASSUM MP_TAC) THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + +let SIMPLE_PATH_SHIFTPATH = prove + (`!g a. simple_path g /\ pathfinish g = pathstart g /\ + a IN interval[vec 0,vec 1] + ==> simple_path(shiftpath a g)`, + REPEAT GEN_TAC THEN REWRITE_TAC[simple_path] THEN + MATCH_MP_TAC(TAUT + `(a /\ c /\ d ==> e) /\ (b /\ c /\ d ==> f) + ==> (a /\ b) /\ c /\ d ==> e /\ f`) THEN + CONJ_TAC THENL [MESON_TAC[PATH_SHIFTPATH]; ALL_TAC] THEN + REWRITE_TAC[simple_path; shiftpath; IN_INTERVAL_1; DROP_VEC; + DROP_ADD; DROP_SUB] THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + STRIP_TAC THEN REPEAT GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o C MATCH_MP th)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; GSYM DROP_EQ] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Choosing a sub-path of an existing path. *) +(* ------------------------------------------------------------------------- *) + +let subpath = new_definition + `subpath u v g = \x. g(u + drop(v - u) % x)`;; + +let SUBPATH_SCALING_LEMMA = prove + (`!u v. + IMAGE (\x. u + drop(v - u) % x) (interval[vec 0,vec 1]) = segment[u,v]`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + REWRITE_TAC[IMAGE_AFFINITY_INTERVAL; SEGMENT_1] THEN + REWRITE_TAC[DROP_SUB; REAL_SUB_LE; INTERVAL_EQ_EMPTY_1; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + BINOP_TAC THEN REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO] THEN + REWRITE_TAC[LIFT_DROP; LIFT_SUB] THEN VECTOR_ARITH_TAC);; + +let PATH_IMAGE_SUBPATH_GEN = prove + (`!u v g:real^1->real^N. path_image(subpath u v g) = IMAGE g (segment[u,v])`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_image; subpath] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o; SUBPATH_SCALING_LEMMA]);; + +let PATH_IMAGE_SUBPATH = prove + (`!u v g:real^1->real^N. + drop u <= drop v + ==> path_image(subpath u v g) = IMAGE g (interval[u,v])`, + SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; SEGMENT_1]);; + +let PATH_SUBPATH = prove + (`!u v g:real^1->real^N. + path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] + ==> path(subpath u v g)`, + REWRITE_TAC[path; subpath] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBPATH_SCALING_LEMMA; SEGMENT_1] THEN + COND_CASES_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_1] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + REAL_ARITH_TAC);; + +let PATHSTART_SUBPATH = prove + (`!u v g:real^1->real^N. pathstart(subpath u v g) = g(u)`, + REWRITE_TAC[pathstart; subpath; VECTOR_MUL_RZERO; VECTOR_ADD_RID]);; + +let PATHFINISH_SUBPATH = prove + (`!u v g:real^1->real^N. pathfinish(subpath u v g) = g(v)`, + REWRITE_TAC[pathfinish; subpath; GSYM LIFT_EQ_CMUL] THEN + REWRITE_TAC[LIFT_DROP; VECTOR_ARITH `u + v - u:real^N = v`]);; + +let SUBPATH_TRIVIAL = prove + (`!g. subpath (vec 0) (vec 1) g = g`, + REWRITE_TAC[subpath; VECTOR_SUB_RZERO; DROP_VEC; VECTOR_MUL_LID; + VECTOR_ADD_LID; ETA_AX]);; + +let SUBPATH_REVERSEPATH = prove + (`!g. subpath (vec 1) (vec 0) g = reversepath g`, + REWRITE_TAC[subpath; reversepath; VECTOR_SUB_LZERO; DROP_NEG; DROP_VEC] THEN + REWRITE_TAC[VECTOR_ARITH `a + -- &1 % b:real^N = a - b`]);; + +let REVERSEPATH_SUBPATH = prove + (`!g u v. reversepath(subpath u v g) = subpath v u g`, + REWRITE_TAC[reversepath; subpath; FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[DROP_SUB; VECTOR_SUB_LDISTRIB] THEN + REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_SUB; LIFT_DROP] THEN + VECTOR_ARITH_TAC);; + +let SUBPATH_TRANSLATION = prove + (`!a g u v. subpath u v ((\x. a + x) o g) = (\x. a + x) o subpath u v g`, + REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);; + +add_translation_invariants [SUBPATH_TRANSLATION];; + +let SUBPATH_LINEAR_IMAGE = prove + (`!f g u v. linear f ==> subpath u v (f o g) = f o subpath u v g`, + REWRITE_TAC[FUN_EQ_THM; subpath; o_THM]);; + +add_linear_invariants [SUBPATH_LINEAR_IMAGE];; + +let SIMPLE_PATH_SUBPATH_EQ = prove + (`!g u v. simple_path(subpath u v g) <=> + path(subpath u v g) /\ ~(u = v) /\ + (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y + ==> x = y \/ x = u /\ y = v \/ x = v /\ y = u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[simple_path; subpath] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `u + a % x = u <=> a % x = vec 0`; + VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_MUL_LCANCEL] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_ADD; DROP_SUB; + REAL_RING `u + (v - u) * y = v <=> v = u \/ y = &1`] THEN + REWRITE_TAC[REAL_SUB_0; DROP_EQ; GSYM DROP_VEC] THEN + ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let ARC_SUBPATH_EQ = prove + (`!g u v. arc(subpath u v g) <=> + path(subpath u v g) /\ ~(u = v) /\ + (!x y. x IN segment[u,v] /\ y IN segment[u,v] /\ g x = g y + ==> x = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[arc; subpath] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM SUBPATH_SCALING_LEMMA] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `u + a % x = u + a % y <=> a % (x - y) = vec 0`; + VECTOR_MUL_EQ_0; DROP_EQ_0; VECTOR_SUB_EQ] THEN + ASM_CASES_TAC `v:real^1 = u` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`lift(&1 / &2)`; `lift(&3 / &4)`]) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ; LIFT_DROP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let SIMPLE_PATH_SUBPATH = prove + (`!g u v. simple_path g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + ~(u = v) + ==> simple_path(subpath u v g)`, + SIMP_TAC[SIMPLE_PATH_SUBPATH_EQ; PATH_SUBPATH; SIMPLE_PATH_IMP_PATH] THEN + REWRITE_TAC[simple_path] THEN GEN_TAC THEN + REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN + CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN + SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^1`; `y:real^1`]) THEN + SUBGOAL_THEN + `!x:real^1. x IN interval[u,v] ==> x IN interval[vec 0,vec 1]` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM SUBSET; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_TRANS]; + ASM_SIMP_TAC[]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[DROP_VEC; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; + +let ARC_SIMPLE_PATH_SUBPATH = prove + (`!g u v. simple_path g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + ~(g u = g v) + ==> arc(subpath u v g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIMPLE_PATH_IMP_ARC THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + ASM_MESON_TAC[SIMPLE_PATH_SUBPATH]);; + +let ARC_SUBPATH_ARC = prove + (`!u v g. arc g /\ + u IN interval [vec 0,vec 1] /\ v IN interval [vec 0,vec 1] /\ + ~(u = v) + ==> arc(subpath u v g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN + ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH; arc]);; + +let ARC_SIMPLE_PATH_SUBPATH_INTERIOR = prove + (`!g u v. simple_path g /\ + u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + ~(u = v) /\ abs(drop u - drop v) < &1 + ==> arc(subpath u v g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN + DISCH_THEN(MP_TAC o SPECL [`u:real^1`; `v:real^1`] o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC);; + +let PATH_IMAGE_SUBPATH_SUBSET = prove + (`!u v g:real^1->real^N. + path g /\ u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] + ==> path_image(subpath u v g) SUBSET path_image g`, + SIMP_TAC[PATH_IMAGE_SUBPATH_GEN] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);; + +let JOIN_SUBPATHS_MIDDLE = prove + (`!p:real^1->real^N. + subpath (vec 0) (lift(&1 / &2)) p ++ subpath (lift(&1 / &2)) (vec 1) p = p`, + REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[joinpaths; subpath] THEN COND_CASES_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; DROP_CMUL; LIFT_DROP; + DROP_VEC] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some additional lemmas about choosing sub-paths. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_SUBPATH_OF_PATH = prove + (`!g a b:real^N. + path g /\ a IN path_image g /\ b IN path_image g + ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\ + path_image h SUBSET path_image g`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN + GEN_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN + EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN + ASM_REWRITE_TAC[GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN + ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]);; + +let EXISTS_SUBPATH_OF_ARC_NOENDS = prove + (`!g a b:real^N. + arc g /\ a IN path_image g /\ b IN path_image g /\ + {a,b} INTER {pathstart g,pathfinish g} = {} + ==> ?h. path h /\ pathstart h = a /\ pathfinish h = b /\ + path_image h SUBSET + (path_image g) DIFF {pathstart g,pathfinish g}`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN + GEN_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN DISCH_TAC THEN + EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN + ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN + REWRITE_TAC[path_image; pathstart; pathfinish] THEN + REWRITE_TAC[SET_RULE + `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN + REWRITE_TAC[IN_IMAGE] THEN + SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])` + STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN + REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN + RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL + [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN + SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\ + (vec 1:real^1) IN interval[vec 0,vec 1]` + MP_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]; + ASM SET_TAC[]]);; + +let EXISTS_SUBARC_OF_ARC_NOENDS = prove + (`!g a b:real^N. + arc g /\ a IN path_image g /\ b IN path_image g /\ ~(a = b) /\ + {a,b} INTER {pathstart g,pathfinish g} = {} + ==> ?h. arc h /\ pathstart h = a /\ pathfinish h = b /\ + path_image h SUBSET + (path_image g) DIFF {pathstart g,pathfinish g}`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image; FORALL_IN_IMAGE] THEN + GEN_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `v:real^1` THEN REPEAT DISCH_TAC THEN + EXISTS_TAC `subpath u v (g:real^1->real^N)` THEN + ASM_SIMP_TAC[PATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + ARC_IMP_PATH; GSYM path_image; PATH_IMAGE_SUBPATH_GEN] THEN + CONJ_TAC THENL + [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN + ASM_SIMP_TAC[ARC_IMP_SIMPLE_PATH]; + ALL_TAC] THEN + REWRITE_TAC[path_image; pathstart; pathfinish] THEN + REWRITE_TAC[SET_RULE + `s SUBSET t DIFF {a,b} <=> s SUBSET t /\ ~(a IN s) /\ ~(b IN s)`] THEN + REWRITE_TAC[IN_IMAGE] THEN + SUBGOAL_THEN `~(vec 0 IN segment[u:real^1,v]) /\ ~(vec 1 IN segment[u,v])` + STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + SIMP_TAC[REAL_ARITH `a <= b ==> (b <= a <=> a = b)`] THEN + REWRITE_TAC[GSYM DROP_VEC; DROP_EQ] THEN + RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `segment[u:real^1,v] SUBSET interval[vec 0,vec 1]` MP_TAC THENL + [SIMP_TAC[SEGMENT_CONVEX_HULL; SUBSET_HULL; CONVEX_INTERVAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[arc; pathstart; pathfinish]) THEN + SUBGOAL_THEN `(vec 0:real^1) IN interval[vec 0,vec 1] /\ + (vec 1:real^1) IN interval[vec 0,vec 1]` + MP_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]; + ASM SET_TAC[]]);; + +let EXISTS_ARC_PSUBSET_SIMPLE_PATH = prove + (`!g:real^1->real^N. + simple_path g /\ closed s /\ s PSUBSET path_image g + ==> ?h. arc h /\ + s SUBSET path_image h /\ + path_image h SUBSET path_image g`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP SIMPLE_PATH_CASES) THENL + [EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [path_image] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^1` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `(h:real^1->real^N) = shiftpath u g` THEN + SUBGOAL_THEN + `simple_path(h:real^1->real^N) /\ + pathstart h = (g:real^1->real^N) u /\ + pathfinish h = (g:real^1->real^N) u /\ + path_image h = path_image g` + MP_TAC THENL + [EXPAND_TAC "h" THEN + ASM_MESON_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; + PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH; + IN_INTERVAL_1; DROP_VEC]; + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + UNDISCH_THEN `pathstart(h:real^1->real^N) = (g:real^1->real^N) u` + (SUBST_ALL_TAC o SYM)] THEN + SUBGOAL_THEN + `open_in (subtopology euclidean (interval[vec 0,vec 1])) + {x:real^1 | x IN interval[vec 0,vec 1] /\ + (h x) IN ((:real^N) DIFF s)}` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN + ASM_SIMP_TAC[GSYM path; GSYM closed; SIMPLE_PATH_IMP_PATH]; + REWRITE_TAC[open_in] THEN DISCH_THEN(MP_TAC o CONJUNCT2)] THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `vec 0:real^1` th) THEN MP_TAC(SPEC `vec 1:real^1` th)) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN + REWRITE_TAC[DIST_REAL; VEC_COMPONENT; REAL_SUB_RZERO] THEN + SIMP_TAC[GSYM drop] THEN + ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + ANTS_TAC THENL [ASM_MESON_TAC[pathstart]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `subpath (lift(min d1 (&1 / &4))) (lift(&1 - min d2 (&1 / &4))) + (h:real^1->real^N)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH_INTERIOR THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP; LIFT_EQ] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> t INTER s SUBSET u ==> s SUBSET u`)) THEN + REWRITE_TAC[SUBSET; IN_INTER; IMP_CONJ] THEN + SIMP_TAC[PATH_IMAGE_SUBPATH; LIFT_DROP; + REAL_ARITH `min d1 (&1 / &4) <= &1 - min d2 (&1 / &4)`] THEN + REWRITE_TAC[FORALL_IN_IMAGE; path_image; IN_INTERVAL_1; DROP_VEC] THEN + X_GEN_TAC `x:real^1` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^1` THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN + ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + ASM_REAL_ARITH_TAC]);; + +let EXISTS_DOUBLE_ARC = prove + (`!g:real^1->real^N a b. + simple_path g /\ pathfinish g = pathstart g /\ + a IN path_image g /\ b IN path_image g /\ ~(a = b) + ==> ?u d. arc u /\ arc d /\ + pathstart u = a /\ pathfinish u = b /\ + pathstart d = b /\ pathfinish d = a /\ + (path_image u) INTER (path_image d) = {a,b} /\ + (path_image u) UNION (path_image d) = path_image g`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; path_image] THEN + ONCE_REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN REPEAT DISCH_TAC THEN + X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN REWRITE_TAC[GSYM path_image] THEN + X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN DISCH_TAC THEN + ABBREV_TAC `h = shiftpath u (g:real^1->real^N)` THEN + SUBGOAL_THEN + `simple_path(h:real^1->real^N) /\ + pathstart h = g u /\ + pathfinish h = g u /\ + path_image h = path_image g` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "h" THEN + ASM_SIMP_TAC[SIMPLE_PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + EXPAND_TAC "h" THEN + ASM_SIMP_TAC[PATHSTART_SHIFTPATH; PATHFINISH_SHIFTPATH]; + UNDISCH_THEN `path_image h :real^N->bool = path_image g` + (SUBST_ALL_TAC o SYM)] THEN + UNDISCH_TAC `(b:real^N) IN path_image h` THEN + REWRITE_TAC[IN_IMAGE; path_image; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN + MAP_EVERY EXISTS_TAC + [`subpath (vec 0) v (h:real^1->real^N)`; + `subpath v (vec 1) (h:real^1->real^N)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + UNDISCH_THEN `b = (h:real^1->real^N) v` SUBST_ALL_TAC THEN + STRIP_ASSUME_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC] + (ASSUME `(v:real^1) IN interval[vec 0,vec 1]`)) THEN + ASM_SIMP_TAC[ARC_SIMPLE_PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; + REAL_LE_REFL; REAL_POS; PATH_IMAGE_SUBPATH] THEN + REWRITE_TAC[GSYM IMAGE_UNION; path_image] THEN + UNDISCH_THEN `(h:real^1->real^N)(vec 0) = (g:real^1->real^N) u` + (SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN + `interval[vec 0,v] UNION interval[v,vec 1] = interval[vec 0:real^1,vec 1]` + ASSUME_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[IMAGE_SUBSET] THEN + MATCH_MP_TAC(SET_RULE + `(!x y. x IN (s UNION t) /\ y IN (s UNION t) /\ f x = f y + ==> x = y \/ x = vec 0 /\ y = vec 1 \/ x = vec 1 /\ y = vec 0) /\ + (f(vec 0) = f(vec 1)) /\ (vec 0) IN s /\ (vec 1) IN t /\ + s INTER t = {c} + ==> IMAGE f s INTER IMAGE f t = {f (vec 0), f c}`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[simple_path]) THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_INTER; IN_UNION] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN ASM_REAL_ARITH_TAC);; + +let SUBPATH_TO_FRONTIER_EXPLICIT = prove + (`!g:real^1->real^N s. + path g /\ pathstart g IN s /\ ~(pathfinish g IN s) + ==> ?u. u IN interval[vec 0,vec 1] /\ + (!x. &0 <= drop x /\ drop x < drop u ==> g x IN interior s) /\ + ~(g u IN interior s) /\ + (u = vec 0 \/ g u IN closure s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{u | lift u IN interval[vec 0,vec 1] /\ + g(lift u) IN closure((:real^N) DIFF s)}` + COMPACT_ATTAINS_INF) THEN + SIMP_TAC[LIFT_DROP; SET_RULE + `(!x. lift(drop x) = x) ==> IMAGE lift {x | P(lift x)} = {x | P x}`] THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish; SUBSET; + path_image; FORALL_IN_IMAGE]) THEN + CONJ_TAC THENL + [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSED_INTERVAL]]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[LIFT_NUM] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV]]; + ALL_TAC] THEN + REWRITE_TAC[EXISTS_DROP; FORALL_DROP; IN_ELIM_THM; LIFT_DROP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN + REWRITE_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[subpath; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN + ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; GSYM DROP_EQ] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [TAUT `a /\ ~b ==> c <=> a /\ ~c ==> b`]) THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^1`) THEN DISCH_TAC] THEN + ASM_CASES_TAC `drop u = &0` THEN + ASM_REWRITE_TAC[frontier; IN_DIFF; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[path; pathstart; pathfinish]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN + DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `lift(max (&0) (drop u - d / &2))`) THEN + REWRITE_TAC[LIFT_DROP; DIST_REAL; GSYM drop] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC + (MESON[] `P a ==> dist(a,y) < e ==> ?x. P x /\ dist(x,y) < e`) THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] INTERIOR_SUBSET) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN ASM_ARITH_TAC);; + +let SUBPATH_TO_FRONTIER_STRONG = prove + (`!g:real^1->real^N s. + path g /\ pathstart g IN s /\ ~(pathfinish g IN s) + ==> ?u. u IN interval[vec 0,vec 1] /\ + ~(pathfinish(subpath (vec 0) u g) IN interior s) /\ + (u = vec 0 \/ + (!x. x IN interval[vec 0,vec 1] /\ ~(x = vec 1) + ==> (subpath (vec 0) u g x) IN interior s) /\ + pathfinish(subpath (vec 0) u g) IN closure s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_EXPLICIT) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN + REWRITE_TAC[subpath; pathfinish; VECTOR_SUB_RZERO; VECTOR_ADD_LID] THEN + ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[DROP_VEC; VECTOR_MUL_LZERO] THEN + ASM_REWRITE_TAC[GSYM LIFT_EQ_CMUL; LIFT_DROP] THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC] THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL] THEN + REWRITE_TAC[REAL_ARITH `u * x < u <=> &0 < u * (&1 - x)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_SUB_LT] THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN + ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]);; + +let SUBPATH_TO_FRONTIER = prove + (`!g:real^1->real^N s. + path g /\ pathstart g IN s /\ ~(pathfinish g IN s) + ==> ?u. u IN interval[vec 0,vec 1] /\ + pathfinish(subpath (vec 0) u g) IN frontier s /\ + (path_image(subpath (vec 0) u g) DELETE + pathfinish(subpath (vec 0) u g)) + SUBSET interior s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[frontier; IN_DIFF] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUBPATH_TO_FRONTIER_STRONG) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN + ASM_CASES_TAC `u:real^1 = vec 0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN STRIP_TAC THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + REWRITE_TAC[subpath; path_image; VECTOR_SUB_REFL; DROP_VEC; + VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + SET_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_DELETE; IMP_CONJ] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; pathfinish] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN ASM_MESON_TAC[]]);; + +let EXISTS_PATH_SUBPATH_TO_FRONTIER = prove + (`!g:real^1->real^N s. + path g /\ pathstart g IN s /\ ~(pathfinish g IN s) + ==> ?h. path h /\ pathstart h = pathstart g /\ + (path_image h) SUBSET (path_image g) /\ + (path_image h DELETE (pathfinish h)) SUBSET interior s /\ + pathfinish h IN frontier s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP SUBPATH_TO_FRONTIER) THEN + EXISTS_TAC `subpath (vec 0) u (g:real^1->real^N)` THEN + ASM_SIMP_TAC[PATH_SUBPATH; IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; + PATHSTART_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN + REWRITE_TAC[pathstart]);; + +let EXISTS_PATH_SUBPATH_TO_FRONTIER_CLOSED = prove + (`!g:real^1->real^N s. + closed s /\ path g /\ pathstart g IN s /\ ~(pathfinish g IN s) + ==> ?h. path h /\ pathstart h = pathstart g /\ + (path_image h) SUBSET (path_image g) INTER s /\ + pathfinish h IN frontier s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN + MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET_INTER] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `(pathfinish h:real^N) INSERT (path_image h DELETE pathfinish h)` THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN CONJ_TAC THENL + [ASM_MESON_TAC[frontier; CLOSURE_EQ; IN_DIFF]; + ASM_MESON_TAC[SUBSET_TRANS; INTERIOR_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of straight-line paths. *) +(* ------------------------------------------------------------------------- *) + +let linepath = new_definition + `linepath(a,b) = \x. (&1 - drop x) % a + drop x % b`;; + +let LINEPATH_TRANSLATION = prove + (`!a b c. linepath(a + b,a + c) = (\x. a + x) o linepath(b,c)`, + REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; + +add_translation_invariants [LINEPATH_TRANSLATION];; + +let LINEPATH_LINEAR_IMAGE = prove + (`!f. linear f ==> !b c. linepath(f b,f c) = f o linepath(b,c)`, + REWRITE_TAC[linepath; o_THM; FUN_EQ_THM] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_ADD) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP LINEAR_CMUL) THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +add_linear_invariants [LINEPATH_LINEAR_IMAGE];; + +let PATHSTART_LINEPATH = prove + (`!a b. pathstart(linepath(a,b)) = a`, + REWRITE_TAC[linepath; pathstart; DROP_VEC] THEN VECTOR_ARITH_TAC);; + +let PATHFINISH_LINEPATH = prove + (`!a b. pathfinish(linepath(a,b)) = b`, + REWRITE_TAC[linepath; pathfinish; DROP_VEC] THEN VECTOR_ARITH_TAC);; + +let CONTINUOUS_LINEPATH_AT = prove + (`!a b x. linepath(a,b) continuous (at x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[linepath] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + y = x + u % --x + y`] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; + +let CONTINUOUS_ON_LINEPATH = prove + (`!a b s. linepath(a,b) continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_LINEPATH_AT]);; + +let PATH_LINEPATH = prove + (`!a b. path(linepath(a,b))`, + REWRITE_TAC[path; CONTINUOUS_ON_LINEPATH]);; + +let PATH_IMAGE_LINEPATH = prove + (`!a b. path_image(linepath (a,b)) = segment[a,b]`, + REWRITE_TAC[segment; path_image; linepath] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTERVAL] THEN + SIMP_TAC[DIMINDEX_1; FORALL_1; VEC_COMPONENT; ARITH] THEN + REWRITE_TAC[EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN MESON_TAC[]);; + +let REVERSEPATH_LINEPATH = prove + (`!a b. reversepath(linepath(a,b)) = linepath(b,a)`, + REWRITE_TAC[reversepath; linepath; DROP_SUB; DROP_VEC; FUN_EQ_THM] THEN + VECTOR_ARITH_TAC);; + +let ARC_LINEPATH = prove + (`!a b. ~(a = b) ==> arc(linepath(a,b))`, + REWRITE_TAC[arc; PATH_LINEPATH] THEN REWRITE_TAC[linepath] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=> + (x - y) % (a - b) = vec 0`] THEN + SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; DROP_EQ; REAL_SUB_0]);; + +let SIMPLE_PATH_LINEPATH = prove + (`!a b. ~(a = b) ==> simple_path(linepath(a,b))`, + MESON_TAC[ARC_IMP_SIMPLE_PATH; ARC_LINEPATH]);; + +let SIMPLE_PATH_LINEPATH_EQ = prove + (`!a b:real^N. simple_path(linepath(a,b)) <=> ~(a = b)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[SIMPLE_PATH_LINEPATH] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[simple_path] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[linepath; GSYM VECTOR_ADD_RDISTRIB] THEN + DISCH_THEN(MP_TAC o SPECL [`lift(&0)`; `lift(&1 / &2)`]) THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM DROP_EQ; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +let ARC_LINEPATH_EQ = prove + (`!a b. arc(linepath(a,b)) <=> ~(a = b)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ARC_LINEPATH] THEN + MESON_TAC[SIMPLE_PATH_LINEPATH_EQ; ARC_IMP_SIMPLE_PATH]);; + +let LINEPATH_REFL = prove + (`!a. linepath(a,a) = \x. a`, + REWRITE_TAC[linepath; VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`]);; + +let SHIFTPATH_TRIVIAL = prove + (`!t a. shiftpath t (linepath(a,a)) = linepath(a,a)`, + REWRITE_TAC[shiftpath; LINEPATH_REFL; COND_ID]);; + +let SUBPATH_REFL = prove + (`!g a. subpath a a g = linepath(g a,g a)`, + REWRITE_TAC[subpath; linepath; VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO; + FUN_EQ_THM; VECTOR_ADD_RID] THEN + VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Bounding a point away from a path. *) +(* ------------------------------------------------------------------------- *) + +let NOT_ON_PATH_BALL = prove + (`!g z:real^N. + path g /\ ~(z IN path_image g) + ==> ?e. &0 < e /\ ball(z,e) INTER (path_image g) = {}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`path_image g:real^N->bool`; `z:real^N`] + DISTANCE_ATTAINS_INF) THEN + REWRITE_TAC[PATH_IMAGE_NONEMPTY] THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE; COMPACT_IMP_CLOSED] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `dist(z:real^N,a)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIST_POS_LT]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_BALL; IN_INTER] THEN + ASM_MESON_TAC[REAL_NOT_LE]);; + +let NOT_ON_PATH_CBALL = prove + (`!g z:real^N. + path g /\ ~(z IN path_image g) + ==> ?e. &0 < e /\ cball(z,e) INTER (path_image g) = {}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NOT_ON_PATH_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphisms of arc images. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHISM_ARC = prove + (`!g:real^1->real^N. + arc g ==> ?h. homeomorphism (interval[vec 0,vec 1],path_image g) (g,h)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN + ASM_REWRITE_TAC[path_image; COMPACT_INTERVAL; GSYM path; GSYM arc]);; + +let HOMEOMORPHIC_ARC_IMAGE_INTERVAL = prove + (`!g:real^1->real^N a b:real^1. + arc g /\ drop a < drop b ==> (path_image g) homeomorphic interval[a,b]`, + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN + EXISTS_TAC `g:real^1->real^N` THEN ASM_SIMP_TAC[HOMEOMORPHISM_ARC]; + MATCH_MP_TAC HOMEOMORPHIC_CLOSED_INTERVALS THEN + ASM_REWRITE_TAC[INTERVAL_NE_EMPTY_1; DROP_VEC; REAL_LT_01]]);; + +let HOMEOMORPHIC_ARC_IMAGES = prove + (`!g:real^1->real^M h:real^1->real^N. + arc g /\ arc h ==> (path_image g) homeomorphic (path_image h)`, + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `interval[vec 0:real^1,vec 1]` THEN + CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN + MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGE_INTERVAL THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_LT_01]);; + +let HOMEOMORPHIC_ARC_IMAGE_SEGMENT = prove + (`!g:real^1->real^N a b:real^M. + arc g /\ ~(a = b) ==> (path_image g) homeomorphic segment[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM PATH_IMAGE_LINEPATH] THEN + MATCH_MP_TAC HOMEOMORPHIC_ARC_IMAGES THEN + ASM_REWRITE_TAC[ARC_LINEPATH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Path component, considered as a "joinability" relation (from Tom Hales). *) +(* ------------------------------------------------------------------------- *) + +let path_component = new_definition + `path_component s x y <=> + ?g. path g /\ path_image g SUBSET s /\ + pathstart g = x /\ pathfinish g = y`;; + +let PATH_COMPONENT_IN = prove + (`!s x y. path_component s x y ==> x IN s /\ y IN s`, + REWRITE_TAC[path_component; path_image; pathstart; pathfinish] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o SYM)) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_LE_REFL; REAL_POS]);; + +let PATH_COMPONENT_REFL = prove + (`!s x:real^N. x IN s ==> path_component s x x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN + EXISTS_TAC `(\u. x):real^1->real^N` THEN + REWRITE_TAC[pathstart; pathfinish; path_image; path; + CONTINUOUS_ON_CONST; IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; + +let PATH_COMPONENT_REFL_EQ = prove + (`!s x:real^N. path_component s x x <=> x IN s`, + MESON_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_REFL]);; + +let PATH_COMPONENT_SYM = prove + (`!s x y:real^N. path_component s x y ==> path_component s y x`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN + MESON_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);; + +let PATH_COMPONENT_SYM_EQ = prove + (`!s x y. path_component s x y <=> path_component s y x`, + MESON_TAC[PATH_COMPONENT_SYM]);; + +let PATH_COMPONENT_TRANS = prove + (`!s x y:real^N. + path_component s x y /\ path_component s y z ==> path_component s x z`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_component] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `g1:real^1->real^N`) (X_CHOOSE_TAC `g2:real^1->real^N`)) THEN + EXISTS_TAC `g1 ++ g2 :real^1->real^N` THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET; + PATHSTART_JOIN; PATHFINISH_JOIN]);; + +let PATH_COMPONENT_OF_SUBSET = prove + (`!s t x. s SUBSET t /\ path_component s x y ==> path_component t x y`, + REWRITE_TAC[path_component] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Can also consider it as a set, as the name suggests. *) +(* ------------------------------------------------------------------------- *) + +let PATH_COMPONENT_SET = prove + (`!s x. path_component s x = + { y | ?g. path g /\ path_image g SUBSET s /\ + pathstart g = x /\ pathfinish g = y }`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REWRITE_TAC[IN; path_component]);; + +let PATH_COMPONENT_SUBSET = prove + (`!s x. (path_component s x) SUBSET s`, + REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[PATH_COMPONENT_IN; IN]);; + +let PATH_COMPONENT_EQ_EMPTY = prove + (`!s x. path_component s x = {} <=> ~(x IN s)`, + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + MESON_TAC[IN; PATH_COMPONENT_REFL; PATH_COMPONENT_IN]);; + +let PATH_COMPONENT_EMPTY = prove + (`!x. path_component {} x = {}`, + REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);; + +let UNIONS_PATH_COMPONENT = prove + (`!s:real^N->bool. UNIONS {path_component s x |x| x IN s} = s`, + GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; PATH_COMPONENT_SUBSET] THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ]);; + +let PATH_COMPONENT_TRANSLATION = prove + (`!a s x. path_component (IMAGE (\x. a + x) s) (a + x) = + IMAGE (\x. a + x) (path_component s x)`, + REWRITE_TAC[PATH_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [PATH_COMPONENT_TRANSLATION];; + +let PATH_COMPONENT_LINEAR_IMAGE = prove + (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> path_component (IMAGE f s) (f x) = + IMAGE f (path_component s x)`, + REWRITE_TAC[PATH_COMPONENT_SET] THEN + GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [PATH_COMPONENT_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Path connectedness of a space. *) +(* ------------------------------------------------------------------------- *) + +let path_connected = new_definition + `path_connected s <=> + !x y. x IN s /\ y IN s + ==> ?g. path g /\ (path_image g) SUBSET s /\ + pathstart g = x /\ pathfinish g = y`;; + +let PATH_CONNECTED_IFF_PATH_COMPONENT = prove + (`!s. path_connected s <=> !x y. x IN s /\ y IN s ==> path_component s x y`, + REWRITE_TAC[path_connected; path_component]);; + +let PATH_CONNECTED_COMPONENT_SET = prove + (`!s. path_connected s <=> !x. x IN s ==> path_component s x = s`, + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[PATH_COMPONENT_SUBSET] THEN SET_TAC[]);; + +let PATH_COMPONENT_MONO = prove + (`!s t x. s SUBSET t ==> (path_component s x) SUBSET (path_component t x)`, + REWRITE_TAC[PATH_COMPONENT_SET] THEN SET_TAC[]);; + +let PATH_COMPONENT_MAXIMAL = prove + (`!s t x. x IN t /\ path_connected t /\ t SUBSET s + ==> t SUBSET (path_component s x)`, + REWRITE_TAC[path_connected; PATH_COMPONENT_SET; SUBSET; IN_ELIM_THM] THEN + MESON_TAC[]);; + +let PATH_COMPONENT_EQ = prove + (`!s x y. y IN path_component s x + ==> path_component s y = path_component s x`, + REWRITE_TAC[EXTENSION; IN] THEN + MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);; + +let PATH_COMPONENT_PATH_IMAGE_PATHSTART = prove + (`!p x:real^N. + path p /\ x IN path_image p + ==> path_component (path_image p) (pathstart p) x`, + REWRITE_TAC[path_image; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^1 = vec 0` THENL + [ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC PATH_COMPONENT_REFL THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC; REAL_POS]; + ALL_TAC] THEN + REWRITE_TAC[path_component] THEN + EXISTS_TAC `\y. (p:real^1->real^N)(drop x % y)` THEN + ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN + REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path]) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET); + ONCE_REWRITE_TAC[GSYM o_DEF] THEN REWRITE_TAC[IMAGE_o] THEN + MATCH_MP_TAC IMAGE_SUBSET; + AP_TERM_TAC THEN REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC] THEN + REWRITE_TAC[REAL_MUL_RID]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + SIMP_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; REAL_LE_MUL] THEN + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]);; + +let PATH_CONNECTED_PATH_IMAGE = prove + (`!p:real^1->real^N. path p ==> path_connected(path_image p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC PATH_COMPONENT_TRANS THEN + EXISTS_TAC `pathstart p :real^N` THEN + ASM_MESON_TAC[PATH_COMPONENT_PATH_IMAGE_PATHSTART; PATH_COMPONENT_SYM]);; + +let PATH_CONNECTED_PATH_COMPONENT = prove + (`!s x:real^N. path_connected(path_component s x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_connected; IN] THEN + MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN + SUBGOAL_THEN `path_component s y (z:real^N)` MP_TAC THENL + [ASM_MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]; ALL_TAC] THEN + REWRITE_TAC[path_component] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:real^1->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `path_component s (x:real^N) = path_component s y` + SUBST1_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_EQ; IN]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:real^1->real^N`; `w:real^N`] + PATH_COMPONENT_PATH_IMAGE_PATHSTART) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_MONO) THEN + REWRITE_TAC[SUBSET; IN] THEN MESON_TAC[]);; + +let PATH_COMPONENT = prove + (`!s x y:real^N. + path_component s x y <=> + ?t. path_connected t /\ t SUBSET s /\ x IN t /\ y IN t`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `path_component s (x:real^N)` THEN + REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT; PATH_COMPONENT_SUBSET] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_IN) THEN + ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL_EQ]; + REWRITE_TAC[path_component] THEN ASM_MESON_TAC[path_connected; SUBSET]]);; + +let PATH_COMPONENT_PATH_COMPONENT = prove + (`!s x:real^N. + path_component (path_component s x) x = path_component s x`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `(x:real^N) IN s` THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[PATH_COMPONENT_MONO; PATH_COMPONENT_SUBSET] THEN + MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN + REWRITE_TAC[SUBSET_REFL; PATH_CONNECTED_PATH_COMPONENT] THEN + ASM_REWRITE_TAC[IN; PATH_COMPONENT_REFL_EQ]; + MATCH_MP_TAC(SET_RULE `s = {} /\ t = {} ==> s = t`) THEN + ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN + ASM_MESON_TAC[SUBSET; PATH_COMPONENT_SUBSET]]);; + +let PATH_CONNECTED_LINEPATH = prove + (`!s a b:real^N. segment[a,b] SUBSET s ==> path_component s a b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[path_component] THEN + EXISTS_TAC `linepath(a:real^N,b)` THEN + ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH]);; + +let PATH_COMPONENT_DISJOINT = prove + (`!s a b. DISJOINT (path_component s a) (path_component s b) <=> + ~(a IN path_component s b)`, + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN] THEN MESON_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS]);; + +let PATH_COMPONENT_EQ_EQ = prove + (`!s x y:real^N. + path_component s x = path_component s y <=> + ~(x IN s) /\ ~(y IN s) \/ + x IN s /\ y IN s /\ path_component s x y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL + [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[FUN_EQ_THM] THEN + ASM_MESON_TAC[PATH_COMPONENT_TRANS; PATH_COMPONENT_REFL; + PATH_COMPONENT_SYM]; + ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM PATH_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN + ONCE_REWRITE_TAC[PATH_COMPONENT_SYM_EQ] THEN + ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY]]);; + +let PATH_COMPONENT_UNIQUE = prove + (`!s c x:real^N. + x IN c /\ c SUBSET s /\ path_connected c /\ + (!c'. x IN c' /\ c' SUBSET s /\ path_connected c' + ==> c' SUBSET c) + ==> path_component s x = c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN + REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; + +let PATH_COMPONENT_INTERMEDIATE_SUBSET = prove + (`!t u a:real^N. + path_component u a SUBSET t /\ t SUBSET u + ==> path_component t a = path_component u a`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_UNIQUE THEN + ASM_REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_REFL; IN]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN + ASM SET_TAC[]; + ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET]]);; + +let COMPLEMENT_PATH_COMPONENT_UNIONS = prove + (`!s x:real^N. + s DIFF path_component s x = + UNIONS({path_component s y | y | y IN s} DELETE (path_component s x))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM UNIONS_PATH_COMPONENT] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s DELETE a ==> DISJOINT a x) + ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN + SIMP_TAC[PATH_COMPONENT_DISJOINT; PATH_COMPONENT_EQ_EQ] THEN + MESON_TAC[IN; SUBSET; PATH_COMPONENT_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* General "locally connected implies connected" type results. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_GENERAL_COMPONENT = prove + (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\ + (!s x y. c s x y ==> c s y x) /\ + (!s x y z. c s x y /\ c s y z ==> c s x z) /\ + (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\ + (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s + ==> c (ball(x,e)) x y) + ==> !s x:real^N. open s ==> open(c s x)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN + DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[SUBSET; IN] THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:real^N) IN s /\ y IN s` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN + REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `y:real^N` THEN + ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN + EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + REMOVE_THEN "BALL" MATCH_MP_TAC THEN + REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);; + +let OPEN_NON_GENERAL_COMPONENT = prove + (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\ + (!s x y. c s x y ==> c s y x) /\ + (!s x y z. c s x y /\ c s y z ==> c s x z) /\ + (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\ + (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s + ==> c (ball(x,e)) x y) + ==> !s x:real^N. open s ==> open(s DIFF c s x)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "IN") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SYM") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "TRANS") MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "SUBSET") (LABEL_TAC "BALL")) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL; SUBSET; IN_BALL] THEN + DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o REWRITE_RULE[IN])) THEN + FIRST_X_ASSUM(MP_TAC o C MATCH_MP (ASSUME `(y:real^N) IN s`)) THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[IN] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN REWRITE_TAC[] THEN + REMOVE_THEN "TRANS" MATCH_MP_TAC THEN EXISTS_TAC `z:real^N` THEN + ASM_REWRITE_TAC[] THEN REMOVE_THEN "SUBSET" MATCH_MP_TAC THEN + EXISTS_TAC `ball(y:real^N,e)` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + REMOVE_THEN "SYM" MATCH_MP_TAC THEN + REMOVE_THEN "BALL" MATCH_MP_TAC THEN + REWRITE_TAC[SUBSET; IN_BALL] THEN ASM_MESON_TAC[]);; + +let GENERAL_CONNECTED_OPEN = prove + (`!c. (!s x y. c s x y ==> x IN s /\ y IN s) /\ + (!s x y. c s x y ==> c s y x) /\ + (!s x y z. c s x y /\ c s y z ==> c s x z) /\ + (!s t x y. s SUBSET t /\ c s x y ==> c t x y) /\ + (!s x y e. y IN ball(x,e) /\ ball(x,e) SUBSET s + ==> c (ball(x,e)) x y) + ==> !s x y:real^N. open s /\ connected s /\ x IN s /\ y IN s + ==> c s x y`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[NOT_EXISTS_THM; LEFT_IMP_FORALL_THM] THEN + MAP_EVERY EXISTS_TAC + [`c (s:real^N->bool) (x:real^N):real^N->bool`; + `s DIFF (c (s:real^N->bool) (x:real^N))`] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ c /\ d /\ e /\ (f ==> g) + ==> ~(a /\ b /\ c /\ d /\ e /\ ~f) ==> g`) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool` + OPEN_GENERAL_COMPONENT) THEN ASM_MESON_TAC[]; + MP_TAC(SPEC `c:(real^N->bool)->real^N->real^N->bool` + OPEN_NON_GENERAL_COMPONENT) THEN ASM_MESON_TAC[]; + SET_TAC[]; + SET_TAC[]; + ALL_TAC; + ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[IN_INTER] THEN REWRITE_TAC[IN] THEN + FIRST_ASSUM(MATCH_MP_TAC o + SPECL [`ball(x:real^N,e)`; `s:real^N->bool`]) THEN + ASM_MESON_TAC[CENTRE_IN_BALL]);; + +(* ------------------------------------------------------------------------- *) +(* Some useful lemmas about path-connectedness. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_IMP_PATH_CONNECTED = prove + (`!s:real^N->bool. convex s ==> path_connected s`, + REWRITE_TAC[CONVEX_ALT; path_connected] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `\u. (&1 - drop u) % x + drop u % y:real^N` THEN + ASM_SIMP_TAC[pathstart; pathfinish; DROP_VEC; path; path_image; + SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; GSYM FORALL_DROP] THEN + CONJ_TAC THENL [ALL_TAC; CONJ_TAC THEN VECTOR_ARITH_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; + +let PATH_CONNECTED_UNIV = prove + (`path_connected(:real^N)`, + SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV]);; + +let IS_INTERVAL_PATH_CONNECTED = prove + (`!s. is_interval s ==> path_connected s`, + SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; IS_INTERVAL_CONVEX]);; + +let PATH_CONNECTED_INTERVAL = prove + (`(!a b:real^N. path_connected(interval[a,b])) /\ + (!a b:real^N. path_connected(interval(a,b)))`, + SIMP_TAC[IS_INTERVAL_PATH_CONNECTED; IS_INTERVAL_INTERVAL]);; + +let PATH_COMPONENT_UNIV = prove + (`!x. path_component(:real^N) x = (:real^N)`, + MESON_TAC[PATH_CONNECTED_COMPONENT_SET; PATH_CONNECTED_UNIV; IN_UNIV]);; + +let PATH_CONNECTED_IMP_CONNECTED = prove + (`!s:real^N->bool. path_connected s ==> connected s`, + GEN_TAC THEN + REWRITE_TAC[path_connected; CONNECTED_IFF_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `path_image(g:real^1->real^N)` THEN + ASM_MESON_TAC[CONNECTED_PATH_IMAGE; PATHSTART_IN_PATH_IMAGE; + PATHFINISH_IN_PATH_IMAGE]);; + +let OPEN_PATH_COMPONENT = prove + (`!s x:real^N. open s ==> open(path_component s x)`, + MATCH_MP_TAC OPEN_GENERAL_COMPONENT THEN + REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS; + PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT] + (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN + ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);; + +let OPEN_NON_PATH_COMPONENT = prove + (`!s x:real^N. open s ==> open(s DIFF path_component s x)`, + MATCH_MP_TAC OPEN_NON_GENERAL_COMPONENT THEN + REWRITE_TAC[PATH_COMPONENT_IN; PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS; + PATH_COMPONENT_OF_SUBSET] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT] + (MATCH_MP CONVEX_IMP_PATH_CONNECTED (SPEC_ALL CONVEX_BALL))) THEN + ASM_MESON_TAC[CENTRE_IN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; NOT_IN_EMPTY]);; + +let PATH_CONNECTED_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ path_connected s ==> path_connected (IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[path_connected] THEN STRIP_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN + ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:real^M->real^N) o (g:real^1->real^M)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + ASM_REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]);; + +let HOMEOMORPHIC_PATH_CONNECTEDNESS = prove + (`!s t. s homeomorphic t ==> (path_connected s <=> path_connected t)`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN + MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]);; + +let PATH_CONNECTED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + path_connected s /\ linear f ==> path_connected(IMAGE f s)`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; PATH_CONNECTED_CONTINUOUS_IMAGE]);; + +let PATH_CONNECTED_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (path_connected (IMAGE f s) <=> path_connected s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE PATH_CONNECTED_LINEAR_IMAGE));; + +add_linear_invariants [PATH_CONNECTED_LINEAR_IMAGE_EQ];; + +let PATH_CONNECTED_EMPTY = prove + (`path_connected {}`, + REWRITE_TAC[path_connected; NOT_IN_EMPTY]);; + +let PATH_CONNECTED_SING = prove + (`!a:real^N. path_connected {a}`, + GEN_TAC THEN REWRITE_TAC[path_connected; IN_SING] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `linepath(a:real^N,a)` THEN + ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + REWRITE_TAC[SEGMENT_REFL; PATH_IMAGE_LINEPATH; SUBSET_REFL]);; + +let PATH_CONNECTED_UNION = prove + (`!s t. path_connected s /\ path_connected t /\ ~(s INTER t = {}) + ==> path_connected (s UNION t)`, + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + REWRITE_TAC[IN_INTER; IN_UNION] THEN + MESON_TAC[PATH_COMPONENT_OF_SUBSET; SUBSET_UNION; PATH_COMPONENT_TRANS]);; + +let PATH_CONNECTED_TRANSLATION = prove + (`!a s. path_connected s ==> path_connected (IMAGE (\x:real^N. a + x) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; + +let PATH_CONNECTED_TRANSLATION_EQ = prove + (`!a s. path_connected (IMAGE (\x:real^N. a + x) s) <=> path_connected s`, + REWRITE_TAC[path_connected] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [PATH_CONNECTED_TRANSLATION_EQ];; + +let PATH_CONNECTED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + path_connected s /\ path_connected t + ==> path_connected (s PCROSS t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS; path_connected] THEN DISCH_TAC THEN + REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`]) + (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN + X_GEN_TAC `g:real^1->real^M` THEN STRIP_TAC THEN + EXISTS_TAC `(\t. pastecart (x1:real^M) ((h:real^1->real^N) t)) ++ + (\t. pastecart ((g:real^1->real^M) t) (y2:real^N))` THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[path_image; FORALL_IN_IMAGE; SUBSET]) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PATH_JOIN_IMP THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST]; + REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST]; + ASM_REWRITE_TAC[pathstart; pathfinish]]; + MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN + ASM_SIMP_TAC[path_image; FORALL_IN_IMAGE; SUBSET; IN_ELIM_PASTECART_THM]; + REWRITE_TAC[PATHSTART_JOIN] THEN ASM_REWRITE_TAC[pathstart]; + REWRITE_TAC[PATHFINISH_JOIN] THEN ASM_REWRITE_TAC[pathfinish]]);; + +let PATH_CONNECTED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + path_connected(s PCROSS t) <=> + s = {} \/ t = {} \/ path_connected s /\ path_connected t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; PATH_CONNECTED_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[PATH_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] + PATH_CONNECTED_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] + PATH_CONNECTED_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let PATH_CONNECTED_SCALING = prove + (`!s:real^N->bool c. + path_connected s ==> path_connected (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let PATH_CONNECTED_NEGATIONS = prove + (`!s:real^N->bool. + path_connected s ==> path_connected (IMAGE (--) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let PATH_CONNECTED_SUMS = prove + (`!s t:real^N->bool. + path_connected s /\ path_connected t + ==> path_connected {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP PATH_CONNECTED_PCROSS) THEN + DISCH_THEN(MP_TAC o ISPEC + `\z. (fstcart z + sndcart z:real^N)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + PATH_CONNECTED_CONTINUOUS_IMAGE)) THEN + SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; + LINEAR_SNDCART; PCROSS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN + REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MESON_TAC[]);; + +let IS_INTERVAL_PATH_CONNECTED_1 = prove + (`!s:real^1->bool. is_interval s <=> path_connected s`, + MESON_TAC[CONVEX_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED; + IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1]);; + +(* ------------------------------------------------------------------------- *) +(* Bounds on components of a continuous image. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_PATH_COMPONENTS = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> {path_component (IMAGE f s) y | y | y IN IMAGE f s} + <=_c {path_component s x | x | x IN s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN + SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC + `\c. path_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_EQ THEN + REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[PATH_COMPONENT] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (path_component s x)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_COMPONENT_SUBSET; + PATH_CONNECTED_PATH_COMPONENT]; + MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[PATH_COMPONENT_SUBSET]; + ALL_TAC; ALL_TAC] THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN + ASM_MESON_TAC[PATH_COMPONENT_REFL_EQ]);; + +let CARD_LE_CONNECTED_COMPONENTS = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> {connected_component (IMAGE f s) y | y | y IN IMAGE f s} + <=_c {connected_component s x | x | x IN s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LE_C] THEN + SIMP_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC; FORALL_IN_IMAGE] THEN EXISTS_TAC + `\c. connected_component (IMAGE (f:real^M->real^N) s) (f(@x. x IN c))` THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN EXISTS_TAC `x:real^M` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN + REWRITE_TAC[IN] THEN ONCE_REWRITE_TAC[connected_component] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (connected_component s x)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_COMPONENT_SUBSET; + CONNECTED_CONNECTED_COMPONENT]; + MATCH_MP_TAC IMAGE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; + ALL_TAC; ALL_TAC] THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_REFL_EQ]);; + +let CARD_LE_COMPONENTS = prove + (`!f:real^M->real^N s. + f continuous_on s ==> components(IMAGE f s) <=_c components s`, + REWRITE_TAC[components; CARD_LE_CONNECTED_COMPONENTS]);; + +(* ------------------------------------------------------------------------- *) +(* More stuff about segments. *) +(* ------------------------------------------------------------------------- *) + +let SEGMENT_OPEN_SUBSET_CLOSED = prove + (`!a b. segment(a,b) SUBSET segment[a,b]`, + REWRITE_TAC[CONJUNCT2(SPEC_ALL segment)] THEN SET_TAC[]);; + +let BOUNDED_SEGMENT = prove + (`(!a b:real^N. bounded(segment[a,b])) /\ + (!a b:real^N. bounded(segment(a,b)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC(MESON[BOUNDED_SUBSET] + `bounded s /\ t SUBSET s ==> bounded s /\ bounded t`) THEN + REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED] THEN + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC COMPACT_CONVEX_HULL THEN + SIMP_TAC[COMPACT_INSERT; COMPACT_EMPTY]);; + +let SEGMENT_IMAGE_INTERVAL = prove + (`(!a b. segment[a,b] = + IMAGE (\u. (&1 - drop u) % a + drop u % b) + (interval[vec 0,vec 1])) /\ + (!a b. ~(a = b) + ==> segment(a,b) = + IMAGE (\u. (&1 - drop u) % a + drop u % b) + (interval(vec 0,vec 1)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_SEGMENT] THEN + ASM_REWRITE_TAC[GSYM EXISTS_DROP; DROP_VEC] THEN MESON_TAC[]);; + +let CLOSURE_SEGMENT = prove + (`(!a b:real^N. closure(segment[a,b]) = segment[a,b]) /\ + (!a b:real^N. closure(segment(a,b)) = if a = b then {} else segment[a,b])`, + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[CLOSURE_EQ; COMPACT_IMP_CLOSED; SEGMENT_CONVEX_HULL; + COMPACT_CONVEX_HULL; COMPACT_INSERT; COMPACT_EMPTY]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[SEGMENT_REFL; CLOSURE_EMPTY] THEN + ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THEN + ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL CLOSURE_OPEN_INTERVAL); + INTERVAL_EQ_EMPTY_1; DROP_VEC; REAL_ARITH `~(&1 <= &0)`] THEN + SUBGOAL_THEN + `(\u. (&1 - drop u) % a + drop u % (b:real^N)) = + (\x. a + x) o (\u. drop u % (b - a))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IMAGE_o; CLOSURE_TRANSLATION] THEN AP_TERM_TAC THEN + MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN + ASM_REWRITE_TAC[VECTOR_MUL_RCANCEL; VECTOR_SUB_EQ; DROP_EQ] THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; + +let CLOSED_SEGMENT = prove + (`(!a b:real^N. closed(segment[a,b])) /\ + (!a b:real^N. closed(segment(a,b)) <=> a = b)`, + REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL] THEN + MESON_TAC[ENDS_NOT_IN_SEGMENT; ENDS_IN_SEGMENT]);; + +let COMPACT_SEGMENT = prove + (`(!a b:real^N. compact(segment[a,b])) /\ + (!a b:real^N. compact(segment(a,b)) <=> a = b)`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_SEGMENT; BOUNDED_SEGMENT]);; + +let AFFINE_HULL_SEGMENT = prove + (`(!a b:real^N. affine hull (segment [a,b]) = affine hull {a,b}) /\ + (!a b:real^N. affine hull (segment(a,b)) = + if a = b then {} else affine hull {a,b})`, + REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL] THEN + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM AFFINE_HULL_CLOSURE] THEN + REWRITE_TAC[CLOSURE_SEGMENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[AFFINE_HULL_EMPTY] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL; AFFINE_HULL_CONVEX_HULL]);; + +let SEGMENT_AS_BALL = prove + (`(!a b. segment[a:real^N,b] = + affine hull {a,b} INTER cball(inv(&2) % (a + b),norm(b - a) / &2)) /\ + (!a b. segment(a:real^N,b) = + affine hull {a,b} INTER ball(inv(&2) % (a + b),norm(b - a) / &2))`, + REPEAT STRIP_TAC THEN + (ASM_CASES_TAC `b:real^N = a` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; VECTOR_SUB_REFL; NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[BALL_TRIVIAL; CBALL_TRIVIAL] THENL + [REWRITE_TAC[INTER_EMPTY; INSERT_AC] THEN + REWRITE_TAC[VECTOR_ARITH `&1 / &2 % (a + a) = a`] THEN + REWRITE_TAC[SET_RULE `a = b INTER a <=> a SUBSET b`; HULL_SUBSET]; + ASM_REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_INTER; AFFINE_HULL_2] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `u + v:real = &1 <=> u = &1 - v`] THEN + REWRITE_TAC[UNWIND_THM2] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `y:real^N = (&1 - u) % a + u % b` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN_BALL; IN_CBALL; dist; VECTOR_ARITH + `&1 / &2 % (a + b) - ((&1 - u) % a + u % b):real^N = + (&1 / &2 - u) % (b - a)`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_LT_MUL_EQ; REAL_LE_MUL_EQ; NORM_POS_LT; + VECTOR_SUB_EQ; REAL_ARITH `a * n < n / &2 <=> &0 < n * (inv(&2) - a)`; + REAL_ARITH `a * n <= n / &2 <=> &0 <= n * (inv(&2) - a)`] THEN + REAL_ARITH_TAC]));; + +let CONVEX_SEGMENT = prove + (`(!a b. convex(segment[a,b])) /\ (!a b. convex(segment(a,b)))`, + REWRITE_TAC[SEGMENT_AS_BALL] THEN + SIMP_TAC[CONVEX_INTER; CONVEX_BALL; CONVEX_CBALL; + AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]);; + +let RELATIVE_INTERIOR_SEGMENT = prove + (`(!a b:real^N. + relative_interior(segment[a,b]) = if a = b then {a} else segment(a,b)) /\ + (!a b:real^N. relative_interior(segment(a,b)) = segment(a,b))`, + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_EMPTY] THEN + REWRITE_TAC[RELATIVE_INTERIOR_EQ; OPEN_IN_OPEN] THEN + ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN + EXISTS_TAC `ball(inv(&2) % (a + b):real^N,norm(b - a) / &2)` THEN + REWRITE_TAC[OPEN_BALL; SEGMENT_AS_BALL]; + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[SEGMENT_REFL; RELATIVE_INTERIOR_SING] THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 CLOSURE_SEGMENT)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + MATCH_MP_TAC CONVEX_RELATIVE_INTERIOR_CLOSURE THEN + REWRITE_TAC[CONVEX_SEGMENT]]);; + +let PATH_CONNECTED_SEGMENT = prove + (`(!a b. path_connected(segment[a,b])) /\ + (!a b. path_connected(segment(a,b)))`, + SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEGMENT]);; + +let CONNECTED_SEGMENT = prove + (`(!a b. connected(segment[a,b])) /\ (!a b. connected(segment(a,b)))`, + SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEGMENT]);; + +let CONVEX_SEMIOPEN_SEGMENT = prove + (`(!a b:real^N. convex(segment[a,b] DELETE a)) /\ + (!a b:real^N. convex(segment[a,b] DELETE b))`, + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN + CONJ_TAC THENL [MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THEN + ASM_SIMP_TAC[SEGMENT_REFL; SET_RULE `{a} DELETE a = {}`; CONVEX_EMPTY] THEN + REWRITE_TAC[CONVEX_ALT; IN_DELETE] THEN + SIMP_TAC[REWRITE_RULE[CONVEX_ALT] CONVEX_SEGMENT] THEN + REWRITE_TAC[IN_SEGMENT] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; + GSYM VECTOR_ADD_ASSOC] THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `x % a + y % b + z % a + w % b:real^N = a <=> + (&1 - x - z) % a = (w + y) % b`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL; REAL_ARITH + `&1 - (&1 - u) * (&1 - v) - u * (&1 - w) = + u * w + (&1 - u) * v`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH + `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_ARITH `&1 - x = &0 <=> x = &1`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `(u = &0 \/ w = &0) /\ (u = &1 \/ v = &0) + ==> u = &0 /\ v = &0 \/ u = &1 /\ w = &0 \/ v = &0 /\ w = &0`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (CONJUNCTS_THEN SUBST_ALL_TAC)) THEN + ASM_MESON_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);; + +let PATH_CONNECTED_SEMIOPEN_SEGMENT = prove + (`(!a b:real^N. path_connected(segment[a,b] DELETE a)) /\ + (!a b:real^N. path_connected(segment[a,b] DELETE b))`, + SIMP_TAC[CONVEX_IMP_PATH_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);; + +let CONNECTED_SEMIOPEN_SEGMENT = prove + (`(!a b:real^N. connected(segment[a,b] DELETE a)) /\ + (!a b:real^N. connected(segment[a,b] DELETE b))`, + SIMP_TAC[CONVEX_CONNECTED; CONVEX_SEMIOPEN_SEGMENT]);; + +let SEGMENT_EQ_EMPTY = prove + (`(!a b:real^N. ~(segment[a,b] = {})) /\ + (!a b:real^N. segment(a,b) = {} <=> a = b)`, + REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_EMPTY; NOT_INSERT_EMPTY] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL] THEN + ASM_MESON_TAC[NOT_IN_EMPTY; MIDPOINT_IN_SEGMENT]);; + +let FINITE_SEGMENT = prove + (`(!a b:real^N. FINITE(segment[a,b]) <=> a = b) /\ + (!a b:real^N. FINITE(segment(a,b)) <=> a = b)`, + REWRITE_TAC[open_segment; SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN + REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; FINITE_SING] THEN + REWRITE_TAC[SEGMENT_IMAGE_INTERVAL] THEN + W(MP_TAC o PART_MATCH (lhs o rand) FINITE_IMAGE_INJ_EQ o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % a + u % b:real^N = (&1 - v) % a + v % b <=> + (u - v) % (b - a) = vec 0`] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; REAL_SUB_0; DROP_EQ]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[FINITE_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC] THEN REAL_ARITH_TAC]);; + +let SEGMENT_EQ_SING = prove + (`(!a b c:real^N. segment[a,b] = {c} <=> a = c /\ b = c) /\ + (!a b c:real^N. ~(segment(a,b) = {c}))`, + REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_EQ_SING] THEN + CONJ_TAC THENL [SET_TAC[]; REPEAT GEN_TAC] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; NOT_INSERT_EMPTY] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] (CONJUNCT2 FINITE_SEGMENT)) THEN + ASM_REWRITE_TAC[FINITE_SING]);; + +let SUBSET_SEGMENT_OPEN_CLOSED = prove + (`!a b c d:real^N. + segment(a,b) SUBSET segment(c,d) <=> + a = b \/ segment[a,b] SUBSET segment[c,d]`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN + ASM_REWRITE_TAC[CLOSURE_SEGMENT] THEN + COND_CASES_TAC THEN REWRITE_TAC[SUBSET_EMPTY; SEGMENT_EQ_EMPTY]; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THEN + REWRITE_TAC[SEGMENT_REFL; EMPTY_SUBSET] THEN + ABBREV_TAC `m:real^N = d - c` THEN POP_ASSUM MP_TAC THEN + GEOM_NORMALIZE_TAC `m:real^N` THEN + SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; SEGMENT_EQ_SING; SEGMENT_EQ_EMPTY; + SET_RULE `s SUBSET {a} <=> s = {a} \/ s = {}`; SUBSET_REFL] THEN + X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN + GEOM_ORIGIN_TAC `c:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `d:real^N` THEN + X_GEN_TAC `d:real` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM(K ALL_TAC) THEN DISCH_TAC THEN + SUBGOAL_THEN `collinear{vec 0:real^N,&1 % basis 1,x} /\ + collinear{vec 0:real^N,&1 % basis 1,y}` + MP_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN + CONJ_TAC THEN MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN + REWRITE_TAC[BETWEEN_IN_SEGMENT] THEN + ASM_MESON_TAC[SUBSET; ENDS_IN_SEGMENT]; + ALL_TAC] THEN + SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; + VECTOR_ARITH `&1 % x:real^N = vec 0 <=> x = vec 0`] THEN + REWRITE_TAC[IMP_CONJ; VECTOR_MUL_ASSOC; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[REAL_MUL_RID] THEN + DISCH_THEN SUBST_ALL_TAC THEN X_GEN_TAC `b:real` THEN + DISCH_THEN SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN + ASM_SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; VECTOR_MUL_RCANCEL; BASIS_NONZERO; + DIMINDEX_GE_1; LE_REFL; SET_RULE + `(!x y. x % v = y % v <=> x = y) + ==> ({x % v | P x} SUBSET {x % v | Q x} <=> + {x | P x} SUBSET {x | Q x})`] THEN + REWRITE_TAC[REAL_ARITH `a <= x /\ x <= b \/ b <= x /\ x <= a <=> + min a b <= x /\ x <= max a b`; + REAL_ARITH `a < x /\ x < b \/ b < x /\ x < a <=> + min a b < x /\ x < max a b`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN + X_GEN_TAC `x:real` THEN + FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th) + [`min (a:real) b`; `max (a:real) b`]) THEN + REAL_ARITH_TAC);; + +let SUBSET_SEGMENT = prove + (`(!a b c d:real^N. + segment[a,b] SUBSET segment[c,d] <=> + a IN segment[c,d] /\ b IN segment[c,d]) /\ + (!a b c d:real^N. + segment[a,b] SUBSET segment(c,d) <=> + a IN segment(c,d) /\ b IN segment(c,d)) /\ + (!a b c d:real^N. + segment(a,b) SUBSET segment[c,d] <=> + a = b \/ a IN segment[c,d] /\ b IN segment[c,d]) /\ + (!a b c d:real^N. + segment(a,b) SUBSET segment(c,d) <=> + a = b \/ a IN segment[c,d] /\ b IN segment[c,d])`, + MATCH_MP_TAC(TAUT `(a /\ b) /\ (a /\ b ==> c) ==> a /\ b /\ c`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [SEGMENT_CONVEX_HULL] THEN + SIMP_TAC[SUBSET_HULL; CONVEX_SEGMENT] THEN SET_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_SEGMENT_OPEN_CLOSED] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `closure(segment(a:real^N,b)) SUBSET segment[c,d]` THEN + CONJ_TAC THENL [SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_SEGMENT]; ALL_TAC] THEN + REWRITE_TAC[CLOSURE_SEGMENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[EMPTY_SUBSET]]);; + +let INTERIOR_SEGMENT = prove + (`(!a b:real^N. interior(segment[a,b]) = + if 2 <= dimindex(:N) then {} else segment(a,b)) /\ + (!a b:real^N. interior(segment(a,b)) = + if 2 <= dimindex(:N) then {} else segment(a,b))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `2 <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(SET_RULE `t SUBSET s /\ s = {} ==> s = {} /\ t = {}`) THEN + SIMP_TAC[SEGMENT_OPEN_SUBSET_CLOSED; SUBSET_INTERIOR] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + MATCH_MP_TAC EMPTY_INTERIOR_CONVEX_HULL THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN FIRST_ASSUM + (MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS)) THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC; + ASM_CASES_TAC `a:real^N = b` THEN + ASM_SIMP_TAC[SEGMENT_REFL; INTERIOR_EMPTY; EMPTY_INTERIOR_FINITE; + FINITE_SING] THEN + SUBGOAL_THEN + `affine hull (segment[a,b]) = (:real^N) /\ + affine hull (segment(a,b)) = (:real^N)` + (fun th -> ASM_SIMP_TAC[th; GSYM RELATIVE_INTERIOR_INTERIOR; + RELATIVE_INTERIOR_SEGMENT]) THEN + ASM_REWRITE_TAC[AFFINE_HULL_SEGMENT] THEN + MATCH_MP_TAC AFFINE_INDEPENDENT_SPAN_GT THEN + REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_ARITH_TAC]);; + +let SEGMENT_EQ = prove + (`(!a b c d:real^N. + segment[a,b] = segment[c,d] <=> {a,b} = {c,d}) /\ + (!a b c d:real^N. + ~(segment[a,b] = segment(c,d))) /\ + (!a b c d:real^N. + ~(segment(a,b) = segment[c,d])) /\ + (!a b c d:real^N. + segment(a,b) = segment(c,d) <=> a = b /\ c = d \/ {a,b} = {c,d})`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(fun th -> MP_TAC th THEN + MP_TAC(AP_TERM `\s:real^N->bool. s DIFF relative_interior s` th)) THEN + REWRITE_TAC[RELATIVE_INTERIOR_SEGMENT] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[SEGMENT_REFL]) THEN + SIMP_TAC[ENDS_IN_SEGMENT; open_segment; SET_RULE + `a IN s /\ b IN s ==> s DIFF (s DIFF {a,b}) = {a,b}`] THEN + ASM SET_TAC[SEGMENT_EQ_SING]; + SIMP_TAC[SEGMENT_CONVEX_HULL]]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o AP_TERM `closed:(real^N->bool)->bool`) THEN + REWRITE_TAC[CONJUNCT1 CLOSED_SEGMENT] THEN + REWRITE_TAC[GSYM CLOSURE_EQ; CLOSURE_SEGMENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM SET_TAC[SEGMENT_EQ_EMPTY]; + REWRITE_TAC[open_segment; ENDS_IN_SEGMENT; SET_RULE + `s = s DIFF {a,b} <=> ~(a IN s) /\ ~(b IN s)`]]; + DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = d` THEN + ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + CONV_TAC(BINOP_CONV SYM_CONV)THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_EQ_EMPTY; SEGMENT_REFL] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_SEGMENT_OPEN_CLOSED] THEN + ASM_REWRITE_TAC[SUBSET_ANTISYM_EQ]]);; + +let COLLINEAR_SEGMENT = prove + (`(!a b:real^N. collinear(segment[a,b])) /\ + (!a b:real^N. collinear(segment(a,b)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COLLINEAR_SUBSET) THEN + REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]]);; + +let INTER_SEGMENT = prove + (`!a b c:real^N. + b IN segment[a,c] \/ ~collinear{a,b,c} + ==> segment[a,b] INTER segment[b,c] = {b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c:real^N = a` THENL + [ASM_SIMP_TAC[SEGMENT_REFL; IN_SING; INTER_IDEMPOT; INSERT_AC; COLLINEAR_2]; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`{a:real^N,c}`; `b:real^N`; `{a:real^N}`; `{c:real^N}`] + CONVEX_HULL_EXCHANGE_INTER) THEN + ASM_REWRITE_TAC[AFFINE_INDEPENDENT_2] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INSERT_AC]] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[SET_RULE `~(a = c) ==> {a} INTER {c} = {}`] THEN + REWRITE_TAC[CONVEX_HULL_SING]; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `~(s INTER t = {b}) + ==> b IN s /\ b IN t + ==> ?a. ~(a = b) /\ a IN s /\ b IN s /\ a IN t /\ b IN t`)) THEN + ANTS_TAC THENL [REWRITE_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real^N` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR)) THEN + MATCH_MP_TAC COLLINEAR_3_TRANS THEN EXISTS_TAC `d:real^N` THEN + REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);; + +let SUBSET_CONTINUOUS_IMAGE_SEGMENT_1 = prove + (`!f:real^N->real^1 a b. + f continuous_on segment[a,b] + ==> segment[f a,f b] SUBSET IMAGE f (segment[a,b])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONNECTED_CONTINUOUS_IMAGE)) THEN + REWRITE_TAC[CONNECTED_SEGMENT] THEN + REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_CONVEX_1] THEN + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN + MESON_TAC[IN_IMAGE; ENDS_IN_SEGMENT]);; + +let CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1 = prove + (`!f:real^N->real^1 a b. + f continuous_on segment[a,b] /\ + (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y) + ==> IMAGE f (segment[a,b]) = segment[f a,f b]`, + let lemma = prove + (`!a b c:real^1. + ~(a = b) /\ ~(a IN segment(c,b)) /\ ~(b IN segment(a,c)) + ==> c IN segment[a,b]`, + REWRITE_TAC[FORALL_LIFT; SEGMENT_1; LIFT_DROP] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1; LIFT_EQ] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]) THEN + ASM_REAL_ARITH_TAC) in + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^1->real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^1`; `g:real^1->real^N`; + `segment[a:real^N,b]`] + CONTINUOUS_ON_INVERSE) THEN + ASM_REWRITE_TAC[COMPACT_SEGMENT] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[SUBSET_CONTINUOUS_IMAGE_SEGMENT_1]; DISCH_TAC] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL] THENL [SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC lemma THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[ENDS_IN_SEGMENT]; DISCH_TAC] THEN + ONCE_REWRITE_TAC[segment] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`f:real^N->real^1`; `c:real^N`; `b:real^N`] + SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN + SUBGOAL_THEN `segment[c:real^N,b] SUBSET segment[a,b]` ASSUME_TAC THENL + [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) a`) THEN + ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN + X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = a` THENL + [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT]; + ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]; + MP_TAC(ISPECL [`f:real^N->real^1`; `a:real^N`; `c:real^N`] + SUBSET_CONTINUOUS_IMAGE_SEGMENT_1) THEN + SUBGOAL_THEN `segment[a:real^N,c] SUBSET segment[a,b]` ASSUME_TAC THENL + [ASM_REWRITE_TAC[SUBSET_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; REWRITE_TAC[SUBSET]] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^N->real^1) b`) THEN + ASM_REWRITE_TAC[IN_IMAGE; NOT_EXISTS_THM] THEN + X_GEN_TAC `d:real^N` THEN ASM_CASES_TAC `d:real^N = b` THENL + [ASM_MESON_TAC[BETWEEN_ANTISYM; BETWEEN_IN_SEGMENT; BETWEEN_SYM]; + ASM_MESON_TAC[ENDS_IN_SEGMENT; SUBSET]]]);; + +let CONTINUOUS_INJECTIVE_IMAGE_OPEN_SEGMENT_1 = prove + (`!f:real^N->real^1 a b. + f continuous_on segment[a,b] /\ + (!x y. x IN segment[a,b] /\ y IN segment[a,b] /\ f x = f y ==> x = y) + ==> IMAGE f (segment(a,b)) = segment(f a,f b)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[segment] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] ENDS_IN_SEGMENT) THEN + MP_TAC(ISPECL [`(f:real^N->real^1) a`; `(f:real^1->real^1) b`] + ENDS_IN_SEGMENT) THEN + ASM SET_TAC[]);; + +let CONTINUOUS_IVT_LOCAL_EXTREMUM = prove + (`!f:real^N->real^1 a b. + f continuous_on segment[a,b] /\ ~(a = b) /\ f(a) = f(b) + ==> ?z. z IN segment(a,b) /\ + ((!w. w IN segment[a,b] ==> drop(f w) <= drop(f z)) \/ + (!w. w IN segment[a,b] ==> drop(f z) <= drop(f w)))`, + REPEAT STRIP_TAC THEN + MAP_EVERY (MP_TAC o ISPECL + [`drop o (f:real^N->real^1)`; `segment[a:real^N,b]`]) + [CONTINUOUS_ATTAINS_SUP; CONTINUOUS_ATTAINS_INF] THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN + REWRITE_TAC[COMPACT_SEGMENT; SEGMENT_EQ_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `(d:real^N) IN segment(a,b)` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `(c:real^N) IN segment(a,b)` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `midpoint(a:real^N,b)` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[MIDPOINT_IN_SEGMENT]; DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CONJUNCT2 segment]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [segment])) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT(DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[REAL_LE_ANTISYM; DROP_EQ]);; + +let FRONTIER_UNIONS_SUBSET_CLOSURE = prove + (`!f:(real^N->bool)->bool. + frontier(UNIONS f) SUBSET closure(UNIONS {frontier t | t IN f})`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN + REWRITE_TAC[SUBSET; IN_DIFF; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[EXISTS_IN_UNIONS; EXISTS_IN_GSPEC; RIGHT_EXISTS_AND_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + ASM_CASES_TAC `(t:real^N->bool) IN f` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(x:real^N) IN t` THENL + [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[frontier; DIST_REFL; IN_DIFF] THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + SPEC_TAC(`x:real^N`,`z:real^N`) THEN + REWRITE_TAC[CONTRAPOS_THM; GSYM SUBSET] THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`segment[x:real^N,y]`; `t:real^N->bool`] + CONNECTED_INTER_FRONTIER) THEN + SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN + ANTS_TAC THENL [ASM_MESON_TAC[ENDS_IN_SEGMENT]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; DIST_SYM; REAL_LET_TRANS]]);; + +let FRONTIER_UNIONS_SUBSET = prove + (`!f:(real^N->bool)->bool. + FINITE f ==> frontier(UNIONS f) SUBSET UNIONS {frontier t | t IN f}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] + `s SUBSET closure t /\ closure t = t ==> s SUBSET t`) THEN + REWRITE_TAC[FRONTIER_UNIONS_SUBSET_CLOSURE; CLOSURE_EQ] THEN + MATCH_MP_TAC CLOSED_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE; FRONTIER_CLOSED]);; + +let CLOSURE_CONVEX_INTER_AFFINE = prove + (`!s t:real^N->bool. + convex s /\ affine t /\ ~(relative_interior s INTER t = {}) + ==> closure(s INTER t) = closure(s) INTER t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET_INTER] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]; + TRANS_TAC SUBSET_TRANS `closure t:real^N->bool` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; CLOSED_AFFINE; SUBSET_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:real^N` MP_TAC o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT GEN_TAC THEN + REWRITE_TAC[IN_INTER] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[AFFINE_EQ_SUBSPACE] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REWRITE_RULE[SUBSET] + RELATIVE_INTERIOR_SUBSET)) THEN + REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN + STRIP_TAC THEN ASM_CASES_TAC `x:real^N = vec 0` THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN_INTER]; + ALL_TAC] THEN + SUBGOAL_THEN `x IN closure(segment(vec 0:real^N,x))` MP_TAC THENL + [ASM_REWRITE_TAC[CLOSURE_SEGMENT; ENDS_IN_SEGMENT]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN REWRITE_TAC[SUBSET_INTER] THEN + CONJ_TAC THENL + [TRANS_TAC SUBSET_TRANS `relative_interior s:real^N->bool` THEN + REWRITE_TAC[RELATIVE_INTERIOR_SUBSET] THEN + MATCH_MP_TAC IN_RELATIVE_INTERIOR_CLOSURE_CONVEX_SEGMENT THEN + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[SUBSET; IN_SEGMENT; VECTOR_MUL_RZERO; VECTOR_ADD_LID; + SUBSPACE_MUL; LEFT_IMP_EXISTS_THM]]);; + +let RELATIVE_FRONTIER_CONVEX_INTER_AFFINE = prove + (`!s t:real^N->bool. + convex s /\ affine t /\ ~(interior s INTER t = {}) + ==> relative_frontier(s INTER t) = frontier s INTER t`, + SIMP_TAC[relative_frontier; RELATIVE_INTERIOR_CONVEX_INTER_AFFINE; + frontier] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(relative_interior s INTER t:real^N->bool = {})` + ASSUME_TAC THENL + [MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[CLOSURE_CONVEX_INTER_AFFINE] THEN SET_TAC[]]);; + +let CONNECTED_COMPONENT_1_GEN = prove + (`!s a b:real^N. + dimindex(:N) = 1 + ==> (connected_component s a b <=> segment[a,b] SUBSET s)`, + SIMP_TAC[connected_component; GSYM CONNECTED_CONVEX_1_GEN] THEN + MESON_TAC[CONVEX_CONTAINS_SEGMENT; SUBSET; CONVEX_SEGMENT; + ENDS_IN_SEGMENT]);; + +let CONNECTED_COMPONENT_1 = prove + (`!s a b:real^1. connected_component s a b <=> segment[a,b] SUBSET s`, + SIMP_TAC[CONNECTED_COMPONENT_1_GEN; DIMINDEX_1]);; + +(* ------------------------------------------------------------------------- *) +(* An injective function into R is a homeomorphism and so an open map. *) +(* ------------------------------------------------------------------------- *) + +let INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM = prove + (`!f:real^N->real^1 s. + f continuous_on s /\ path_connected s + ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> + ?g. homeomorphism (s,IMAGE f s) (f,g))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE]; + REWRITE_TAC[homeomorphism] THEN MESON_TAC[]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^1->real^N` THEN + STRIP_TAC THEN ASM_SIMP_TAC[homeomorphism; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `is_interval (IMAGE (f:real^N->real^1) s)` ASSUME_TAC THENL + [REWRITE_TAC[IS_INTERVAL_PATH_CONNECTED_1] THEN + ASM_MESON_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE]; + ALL_TAC] THEN + REWRITE_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ABBREV_TAC `y = (f:real^N->real^1) x` THEN + ABBREV_TAC `t = IMAGE (f:real^N->real^1) s` THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?a b d. a IN s /\ b IN s /\ &0 < d /\ + ball(y,d) INTER t SUBSET segment[(f:real^N->real^1) a,f b]` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`t:real^1->bool`; `y:real^1`] + INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN + REWRITE_TAC[SET_RULE + `P /\ y IN s /\ (s = {} \/ a IN t /\ b IN t) /\ R <=> + a IN t /\ b IN t /\ P /\ y IN s /\ R`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[EXISTS_IN_IMAGE] THEN + REWRITE_TAC[SEGMENT_1; IN_INTERVAL_1] THEN + MESON_TAC[REAL_LE_TRANS]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(g:real^1->real^N) continuous_on segment[(f:real^N->real^1) a,f b]` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `IMAGE (f:real^N->real^1) (path_image p)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ASM SET_TAC[]]; + SUBGOAL_THEN `convex(IMAGE (f:real^N->real^1) (path_image p))` + MP_TAC THENL + [REWRITE_TAC[GSYM IS_INTERVAL_CONVEX_1; IS_INTERVAL_CONNECTED_1] THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[CONNECTED_PATH_IMAGE] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE]]]; + REWRITE_TAC[continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x':real^N` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_INTER; IN_BALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM SET_TAC[]]]);; + +let INJECTIVE_INTO_1D_IMP_OPEN_MAP = prove + (`!f:real^N->real^1 s t. + f continuous_on s /\ path_connected s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + open_in (subtopology euclidean s) t + ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + ASM_MESON_TAC[INJECTIVE_INTO_1D_EQ_HOMEOMORPHISM]);; + +(* ------------------------------------------------------------------------- *) +(* Injective function on an interval is strictly increasing or decreasing. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove + (`!f:real^1->real^1 s. + f continuous_on s /\ is_interval s + ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> + (!x y. x IN s /\ y IN s /\ drop x < drop y + ==> drop(f x) < drop(f y)) \/ + (!x y. x IN s /\ y IN s /\ drop x < drop y + ==> drop(f y) < drop(f x)))`, + let lemma = prove + (`!s f:real^1->real^1. + f continuous_on s /\ is_interval s /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> !u v w. u IN s /\ v IN s /\ w IN s /\ + drop u < drop v /\ drop v < drop w /\ + drop(f u) <= drop(f v) /\ drop(f w) <= drop(f v) ==> F`, + REWRITE_TAC[IS_INTERVAL_CONVEX_1; CONVEX_CONTAINS_SEGMENT] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^1`; `u:real^1`; `w:real^1`] + CONTINUOUS_INJECTIVE_IMAGE_SEGMENT_1) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^1->real^1) v`) THEN + MATCH_MP_TAC(TAUT `p /\ ~q ==> (p <=> q) ==> F`) THEN CONJ_TAC THENL + [MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[SEGMENT_1] THEN + COND_CASES_TAC THENL + [ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE]; ASM_REAL_ARITH_TAC]; + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1] THEN DISCH_TAC THENL + [SUBGOAL_THEN `drop(f(w:real^1)) = drop(f v)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]; + SUBGOAL_THEN `drop(f(u:real^1)) = drop(f v)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_MESON_TAC[DROP_EQ; REAL_LT_REFL]]]]) + and tac s1 s2 = + let [l1;l2] = map (map (fun x -> mk_var(x,`:real^1`)) o explode) [s1;s2] in + REPEAT(FIRST_X_ASSUM(fun th -> + MP_TAC(ISPECL l1 th) THEN MP_TAC(ISPECL l2 th))) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC in + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM DROP_EQ] THEN + MESON_TAC[REAL_LT_TOTAL; REAL_LT_REFL]] THEN + DISCH_TAC THEN MATCH_MP_TAC(MESON[] + `(!a b c d. ~(~P a b /\ ~Q c d)) ==> (!x y. P x y) \/ (!x y. Q x y)`) THEN + MAP_EVERY X_GEN_TAC [`a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] THEN + REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN STRIP_TAC THEN + REPEAT + (FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_LE_LT]) THEN + REWRITE_TAC[DROP_EQ] THEN STRIP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]]) THEN + MP_TAC(ISPEC `s:real^1->bool` lemma) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `(--) o (f:real^1->real^1)` th) THEN + MP_TAC(SPEC `f:real^1->real^1` th)) THEN + ASM_REWRITE_TAC[o_THM; VECTOR_ARITH `--x:real^N = --y <=> x = y`] THEN + DISCH_TAC THEN REWRITE_TAC[NOT_IMP; DROP_NEG; REAL_LE_NEG2] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE;LINEAR_CONTINUOUS_ON; LINEAR_NEGATION]; + DISCH_TAC] THEN + ASM_CASES_TAC `drop d <= drop a` THENL [tac "cab" "cdb"; ALL_TAC] THEN + ASM_CASES_TAC `drop b <= drop c` THENL [tac "abd" "acd"; ALL_TAC] THEN + ASM_CASES_TAC `c:real^1 = a /\ d:real^1 = b` THENL + [ASM_MESON_TAC[REAL_LT_ANTISYM]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `~(c = a /\ d = b) + ==> (c = a ==> d = b) /\ (d = b ==> c = a) /\ + (~(c = a) /\ ~(d = b) ==> F) ==> F`)) THEN + REPEAT CONJ_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "adb" "abd"; + DISCH_THEN SUBST_ALL_TAC THEN SIMP_TAC[GSYM DROP_EQ] THEN tac "acb" "cab"; + REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC] THEN + ASM_CASES_TAC `drop a <= drop c` THENL [tac "acb" "acd"; tac "cab" "cad"]);; + +(* ------------------------------------------------------------------------- *) +(* Some uncountability results for relevant sets. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_SEGMENT = prove + (`(!a b:real^N. ~(a = b) ==> segment[a,b] =_c (:real)) /\ + (!a b:real^N. ~(a = b) ==> segment(a,b) =_c (:real))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SEGMENT_IMAGE_INTERVAL] THENL + [TRANS_TAC CARD_EQ_TRANS `interval[vec 0:real^1,vec 1]`; + TRANS_TAC CARD_EQ_TRANS `interval(vec 0:real^1,vec 1)`] THEN + SIMP_TAC[CARD_EQ_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN + MATCH_MP_TAC CARD_EQ_IMAGE THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ; VECTOR_ARITH + `(&1 - x) % a + x % b:real^N = (&1 - y) % a + y % b <=> + (x - y) % (a - b) = vec 0`] THEN + SIMP_TAC[REAL_SUB_0; DROP_EQ]);; + +let UNCOUNTABLE_SEGMENT = prove + (`(!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment[a,b])) /\ + (!a b:real^N. ~(a = b) ==> ~COUNTABLE(segment(a,b)))`, + SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_SEGMENT]);; + +let CARD_EQ_PATH_CONNECTED = prove + (`!s a b:real^N. + path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, + MESON_TAC[CARD_EQ_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; + +let UNCOUNTABLE_PATH_CONNECTED = prove + (`!s a b:real^N. + path_connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN + MATCH_MP_TAC CARD_EQ_PATH_CONNECTED THEN + ASM_MESON_TAC[]);; + +let CARD_EQ_CONVEX = prove + (`!s a b:real^N. + convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, + MESON_TAC[CARD_EQ_PATH_CONNECTED; CONVEX_IMP_PATH_CONNECTED]);; + +let UNCOUNTABLE_CONVEX = prove + (`!s a b:real^N. + convex s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN + MATCH_MP_TAC CARD_EQ_CONVEX THEN + ASM_MESON_TAC[]);; + +let CARD_EQ_NONEMPTY_INTERIOR = prove + (`!s:real^N->bool. ~(interior s = {}) ==> s =_c (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[CARD_LE_UNIV; CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN]; + TRANS_TAC CARD_LE_TRANS `interior(s:real^N->bool)` THEN + SIMP_TAC[CARD_LE_SUBSET; INTERIOR_SUBSET] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN + MATCH_MP_TAC CARD_EQ_OPEN THEN ASM_REWRITE_TAC[OPEN_INTERIOR]]);; + +let UNCOUNTABLE_NONEMPTY_INTERIOR = prove + (`!s:real^N->bool. ~(interior s = {}) ==> ~(COUNTABLE s)`, + SIMP_TAC[CARD_EQ_NONEMPTY_INTERIOR; CARD_EQ_REAL_IMP_UNCOUNTABLE]);; + +let COUNTABLE_EMPTY_INTERIOR = prove + (`!s:real^N->bool. COUNTABLE s ==> interior s = {}`, + MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]);; + +let FINITE_EMPTY_INTERIOR = prove + (`!s:real^N->bool. FINITE s ==> interior s = {}`, + SIMP_TAC[COUNTABLE_EMPTY_INTERIOR; FINITE_IMP_COUNTABLE]);; + +let [CONNECTED_FINITE_IFF_SING; + CONNECTED_FINITE_IFF_COUNTABLE; + CONNECTED_INFINITE_IFF_CARD_EQ] = (CONJUNCTS o prove) + (`(!s:real^N->bool. connected s ==> (FINITE s <=> s = {} \/ ?a. s = {a})) /\ + (!s:real^N->bool. connected s ==> (FINITE s <=> COUNTABLE s)) /\ + (!s:real^N->bool. connected s ==> (INFINITE s <=> s =_c (:real)))`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `connected(s:real^N->bool)` THEN + ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC(TAUT + `(f ==> c) /\ (r ==> ~c) /\ (s ==> f) /\ (~s ==> r) + ==> (f <=> s) /\ (f <=> c) /\ (~f <=> r)`) THEN + REWRITE_TAC[FINITE_IMP_COUNTABLE] THEN + REPEAT CONJ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_INSERT; FINITE_EMPTY] THEN + MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]);; + +let CLOSED_AS_FRONTIER_OF_SUBSET = prove + (`!s:real^N->bool. closed s <=> ?t. t SUBSET s /\ s = frontier t`, + GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[FRONTIER_CLOSED]] THEN + DISCH_TAC THEN MP_TAC(ISPEC `s:real^N->bool` SEPARABLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + SIMP_TAC[frontier] THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `s SUBSET c /\ c SUBSET s /\ i = {} ==> s = c DIFF i`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET_CLOSURE; CLOSURE_CLOSED]; + ASM_MESON_TAC[UNCOUNTABLE_NONEMPTY_INTERIOR]]);; + +let CLOSED_AS_FRONTIER = prove + (`!s:real^N->bool. closed s <=> ?t. s = frontier t`, + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[CLOSED_AS_FRONTIER_OF_SUBSET]; MESON_TAC[FRONTIER_CLOSED]]);; + +let CARD_EQ_CLOSED = prove + (`!s:real^N->bool. closed s ==> s <=_c (:num) \/ s =_c (:real)`, + let slemma = prove + (`!s:real^N->bool. + ~COUNTABLE s + ==> ?x y. ~(x = y) /\ x IN s /\ y IN s /\ + x condensation_point_of s /\ + y condensation_point_of s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_INFINITE_CONG) THEN + REWRITE_TAC[INFINITE] THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> s) ==> (p <=> q) ==> s`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[FINITE_IMP_COUNTABLE]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`2`; `{x:real^N | x IN s /\ x condensation_point_of s}`] + CHOOSE_SUBSET_STRONG) THEN + ASM_REWRITE_TAC[HAS_SIZE_CONV `s HAS_SIZE 2`; RIGHT_AND_EXISTS_THM] THEN + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_INSERT; NOT_IN_EMPTY]) THEN + ASM_REWRITE_TAC[]) in + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[GSYM COUNTABLE_ALT] THEN + ASM_CASES_TAC `COUNTABLE(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!n t:real^N->bool. + closed t /\ ~COUNTABLE t + ==> ?l r. (compact l /\ ~COUNTABLE l) /\ (compact r /\ ~COUNTABLE r) /\ + l INTER r = {} /\ l SUBSET t /\ r SUBSET t /\ + diameter l <= inv(&2 pow n) /\ + diameter r <= inv(&2 pow n)` + MP_TAC THENL + [REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o MATCH_MP slemma)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`t INTER cball(a:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`; + `t INTER cball(b:real^N,min (inv(&2 pow (SUC n))) (dist(a,b) / &3))`] THEN + ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I + [CONDENSATION_POINT_INFINITE_CBALL]) THEN + REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN + UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH; + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I + [CONDENSATION_POINT_INFINITE_CBALL]) THEN + REWRITE_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2] THEN + UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH; + MATCH_MP_TAC(SET_RULE + `(!x. ~(x IN t /\ x IN u)) ==> (s INTER t) INTER (s INTER u) = {}`) THEN + REWRITE_TAC[IN_CBALL; REAL_LE_MIN] THEN + UNDISCH_TAC `~(a:real^N = b)` THEN CONV_TAC NORM_ARITH; + SET_TAC[]; + SET_TAC[]; + MATCH_MP_TAC DIAMETER_LE THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN + REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN + CONV_TAC NORM_ARITH; + MATCH_MP_TAC DIAMETER_LE THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE; REAL_LT_POW2] THEN + REWRITE_TAC[IN_INTER; IN_CBALL; REAL_LE_MIN; real_pow; REAL_INV_MUL] THEN + CONV_TAC NORM_ARITH]; + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`l:num->(real^N->bool)->(real^N->bool)`; + `r:num->(real^N->bool)->(real^N->bool)`] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!b. ?x:num->real^N->bool. + (x 0 = s) /\ (!n. x(SUC n) = if b(n) then r n (x n) else l n (x n))` + MP_TAC THENL + [GEN_TAC THEN + W(ACCEPT_TAC o prove_recursive_functions_exist num_RECURSION o + snd o dest_exists o snd); + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM]] THEN + X_GEN_TAC `x:(num->bool)->num->real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE]; + TRANS_TAC CARD_LE_TRANS `(:num->bool)` THEN + SIMP_TAC[CARD_EQ_REAL; CARD_EQ_IMP_LE]] THEN + REWRITE_TAC[le_c; IN_UNIV] THEN + SUBGOAL_THEN + `!b n. closed((x:(num->bool)->num->real^N->bool) b n) /\ + ~COUNTABLE(x b n)` + MP_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + MP_TAC(GEN `b:num->bool` (ISPEC `(x:(num->bool)->num->real^N->bool) b` + DECREASING_CLOSED_NEST_SING)) THEN + DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN ANTS_TAC THENL + [ASM_SIMP_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[COUNTABLE_EMPTY]; + GEN_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + REWRITE_TAC[SUBSET_REFL] THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`b:num->bool`; `e:real`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ASM_REWRITE_TAC[REAL_POW_INV] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + EXISTS_TAC `SUC m` THEN ASM_SIMP_TAC[] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[TAUT `p /\ q /\ r ==> s <=> q /\ r ==> p ==> s`] + DIAMETER_BOUNDED_BOUND)) THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN + UNDISCH_TAC `inv(&2 pow m) < e` THEN MATCH_MP_TAC(NORM_ARITH + `d <= i ==> i < e ==> norm(x - y) <= d ==> dist(x:real^N,y) < e`) THEN + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `f:(num->bool)->real^N` THEN STRIP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `b:num->bool` THEN + REWRITE_TAC[SET_RULE `x IN s <=> {x} SUBSET s`] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + SIMP_TAC[FORALL_UNWIND_THM2] THEN GEN_TAC THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`b:num->bool`; `c:num->bool`] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [FUN_EQ_THM] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN ONCE_REWRITE_TAC[num_WOP] THEN + SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `!f g. INTERS f = {a} /\ INTERS g = {b} /\ + (?s t. s IN f /\ t IN g /\ s INTER t = {}) + ==> ~(a = b)`) THEN + EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) b n}` THEN + EXISTS_TAC `{t | ?n. t = (x:(num->bool)->num->real^N->bool) c n}` THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `(x:(num->bool)->num->real^N->bool) b (SUC k)` THEN + EXISTS_TAC `(x:(num->bool)->num->real^N->bool) c (SUC k)` THEN + REPEAT(CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN ASM_SIMP_TAC[] THEN + SUBGOAL_THEN + `!i. i <= k ==> (x:(num->bool)->num->real^N->bool) b i = x c i` + MP_TAC THENL + [INDUCT_TAC THEN ASM_SIMP_TAC[LE_SUC_LT; LT_IMP_LE]; + DISCH_THEN(MP_TAC o SPEC `k:num`)] THEN + REWRITE_TAC[LE_REFL] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [TAUT `~(p <=> q) <=> (q <=> ~p)`]) THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_MESON_TAC[INTER_COMM]]]);; + +let CONDENSATION_POINTS_EQ_EMPTY,CARD_EQ_CONDENSATION_POINTS = + (CONJ_PAIR o prove) + (`(!s:real^N->bool. + {x | x condensation_point_of s} = {} <=> COUNTABLE s) /\ + (!s:real^N->bool. + {x | x condensation_point_of s} =_c (:real) <=> ~(COUNTABLE s))`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT + `(r ==> p) /\ (~r ==> q) /\ (p ==> ~q) + ==> (p <=> r) /\ (q <=> ~r)`) THEN + REPEAT CONJ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REWRITE_TAC[condensation_point_of] THEN + ASM_MESON_TAC[COUNTABLE_SUBSET; INTER_SUBSET; IN_UNIV; OPEN_UNIV]; + DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE + [TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] CARD_EQ_CLOSED) THEN + REWRITE_TAC[CLOSED_CONDENSATION_POINTS; GSYM COUNTABLE_ALT] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CARD_EQ_CONDENSATION_POINTS_IN_SET) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_COUNTABLE_CONG) THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN SET_TAC[]; + DISCH_THEN SUBST1_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_FINITE_CONG) THEN + REWRITE_TAC[FINITE_EMPTY; GSYM INFINITE; real_INFINITE]]);; + +let UNCOUNTABLE_HAS_CONDENSATION_POINT = prove + (`!s:real^N->bool. ~COUNTABLE s ==> ?x. x condensation_point_of s`, + REWRITE_TAC[GSYM CONDENSATION_POINTS_EQ_EMPTY] THEN SET_TAC[]);; + +let CARD_EQ_PERFECT_SET = prove + (`!s:real^N->bool. + closed s /\ (!x. x IN s ==> x limit_point_of s) /\ ~(s = {}) + ==> s =_c (:real)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP CARD_EQ_CLOSED) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM COUNTABLE; GSYM ge_c]) THEN + MP_TAC(ISPECL [`IMAGE (\x:real^N. s DELETE x) s`; `s:real^N->bool`] + BAIRE) THEN ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL] THEN + MATCH_MP_TAC(TAUT `p /\ ~q ==> (p ==> q) ==> r`) THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + GEN_REWRITE_TAC I [SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^N = y` THEN + ASM_SIMP_TAC[IN_CLOSURE_DELETE] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN_DELETE]; + REWRITE_TAC[INTERS_IMAGE; IN_DELETE] THEN + SUBGOAL_THEN `{y:real^N | !x. x IN s ==> y IN s /\ ~(y = x)} = {}` + SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_REWRITE_TAC[CLOSURE_EMPTY; SUBSET_EMPTY]]]);; + +(* ------------------------------------------------------------------------- *) +(* Density of sets with small complement, including irrationals. *) +(* ------------------------------------------------------------------------- *) + +let COSMALL_APPROXIMATION = prove + (`!s. ((:real) DIFF s) <_c (:real) + ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`, + let lemma = prove + (`!s. ((:real^1) DIFF s) <_c (:real) + ==> !x e. &0 < e ==> ?y. y IN s /\ norm(y - x) < e`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `~({x | P x} SUBSET UNIV DIFF s) ==> ?x. x IN s /\ P x`) THEN + MP_TAC(ISPEC `ball(x:real^1,e)` CARD_EQ_OPEN) THEN + ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN + REWRITE_TAC[CARD_NOT_LE] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist); GSYM ball] THEN + TRANS_TAC CARD_LTE_TRANS `(:real)` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE]) in + REWRITE_TAC[FORALL_DROP_IMAGE; FORALL_DROP; EXISTS_DROP] THEN + REWRITE_TAC[GSYM IMAGE_DROP_UNIV; GSYM DROP_SUB; GSYM ABS_DROP] THEN + REWRITE_TAC[DROP_IN_IMAGE_DROP] THEN REWRITE_TAC[GSYM FORALL_DROP] THEN + SIMP_TAC[GSYM IMAGE_DIFF_INJ; DROP_EQ] THEN GEN_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC lemma THEN POP_ASSUM MP_TAC THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC CARD_LT_CONG THEN + REWRITE_TAC[IMAGE_DROP_UNIV; CARD_EQ_REFL] THEN + MATCH_MP_TAC CARD_EQ_IMAGE THEN SIMP_TAC[DROP_EQ]);; + +let COCOUNTABLE_APPROXIMATION = prove + (`!s. COUNTABLE((:real) DIFF s) + ==> !x e. &0 < e ==> ?y. y IN s /\ abs(y - x) < e`, + GEN_TAC THEN REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_TAC THEN + MATCH_MP_TAC COSMALL_APPROXIMATION THEN + TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_REWRITE_TAC[] THEN + TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + REWRITE_TAC[CARD_EQ_REAL]);; + +let IRRATIONAL_APPROXIMATION = prove + (`!x e. &0 < e ==> ?y. ~(rational y) /\ abs(y - x) < e`, + REWRITE_TAC[SET_RULE `~rational y <=> y IN UNIV DIFF rational`] THEN + MATCH_MP_TAC COCOUNTABLE_APPROXIMATION THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`; COUNTABLE_RATIONAL]);; + +let OPEN_SET_COSMALL_COORDINATES = prove + (`!P. (!i. 1 <= i /\ i <= dimindex(:N) + ==> (:real) DIFF {x | P i x} <_c (:real)) + ==> !s:real^N->bool. + open s /\ ~(s = {}) + ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?y:real. P i y /\ abs(y - (a:real^N)$i) < d / &(dimindex(:N))` + MP_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP COSMALL_APPROXIMATION) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; + REWRITE_TAC[LAMBDA_SKOLEM] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_CBALL; dist] THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_BOUND_GEN THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; CARD_NUMSEG_1]]);; + +let OPEN_SET_COCOUNTABLE_COORDINATES = prove + (`!P. (!i. 1 <= i /\ i <= dimindex(:N) + ==> COUNTABLE((:real) DIFF {x | P i x})) + ==> !s:real^N->bool. + open s /\ ~(s = {}) + ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> P i (x$i)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC OPEN_SET_COSMALL_COORDINATES THEN + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN + TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + REWRITE_TAC[CARD_EQ_REAL]);; + +let OPEN_SET_IRRATIONAL_COORDINATES = prove + (`!s:real^N->bool. + open s /\ ~(s = {}) + ==> ?x. x IN s /\ !i. 1 <= i /\ i <= dimindex(:N) ==> ~rational(x$i)`, + MATCH_MP_TAC OPEN_SET_COCOUNTABLE_COORDINATES THEN + REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);; + +let CLOSURE_COSMALL_COORDINATES = prove + (`!P. (!i. 1 <= i /\ i <= dimindex(:N) + ==> (:real) DIFF {x | P i x} <_c (:real)) + ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} = + (:real^N)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_SET_COSMALL_COORDINATES) THEN + DISCH_THEN(MP_TAC o SPEC `ball(x:real^N,e)`) THEN + ASM_REWRITE_TAC[OPEN_BALL; BALL_EQ_EMPTY; REAL_NOT_LE; IN_BALL] THEN + MESON_TAC[DIST_SYM]);; + +let CLOSURE_COCOUNTABLE_COORDINATES = prove + (`!P. (!i. 1 <= i /\ i <= dimindex(:N) + ==> COUNTABLE((:real) DIFF {x | P i x})) + ==> closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> P i (x$i)} = + (:real^N)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_COSMALL_COORDINATES THEN + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_LET_TRANS `(:num)` THEN ASM_SIMP_TAC[GSYM COUNTABLE_ALT] THEN + TRANS_TAC CARD_LTE_TRANS `(:num->bool)` THEN SIMP_TAC[CANTOR_THM_UNIV] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + REWRITE_TAC[CARD_EQ_REAL]);; + +let CLOSURE_IRRATIONAL_COORDINATES = prove + (`closure {x | !i. 1 <= i /\ i <= dimindex (:N) ==> ~rational(x$i)} = + (:real^N)`, + MATCH_MP_TAC CLOSURE_COCOUNTABLE_COORDINATES THEN + REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~P x} = P`; COUNTABLE_RATIONAL]);; + +(* ------------------------------------------------------------------------- *) +(* Every path between distinct points contains an arc, and hence *) +(* that path connection is equivalent to arcwise connection, for distinct *) +(* points. The proof is based on Whyburn's "Topological Analysis". *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL = prove + (`!f:real^1->real^N. + f continuous_on interval[vec 0,vec 1] /\ + (!y. connected {x | x IN interval[vec 0,vec 1] /\ f x = y}) /\ + ~(f(vec 1) = f(vec 0)) + ==> (IMAGE f (interval[vec 0,vec 1])) homeomorphic + (interval[vec 0:real^1,vec 1])`, + let closure_dyadic_rationals_in_convex_set_pos_1 = prove + (`!s. convex s /\ ~(interior s = {}) /\ (!x. x IN s ==> &0 <= drop x) + ==> closure(s INTER { lift(&m / &2 pow n) | + m IN (:num) /\ n IN (:num)}) = + closure s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^1->bool` CLOSURE_DYADIC_RATIONALS_IN_CONVEX_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN t ==> x IN u) /\ (!x. x IN u ==> x IN s ==> x IN t) + ==> s INTER t = s INTER u`) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; DIMINDEX_1; FORALL_1] THEN + REWRITE_TAC[IN_ELIM_THM; EXISTS_LIFT; GSYM drop; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `x / y:real = inv y * x`; LIFT_CMUL] THEN + CONJ_TAC THENL [MESON_TAC[INTEGER_CLOSED]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real^1`] THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(&2 pow n) % x:real^1`) THEN + ASM_SIMP_TAC[DROP_CMUL; REAL_LE_MUL_EQ; REAL_LT_POW2; REAL_LT_INV_EQ] THEN + ASM_MESON_TAC[INTEGER_POS; LIFT_DROP]) in + let function_on_dyadic_rationals = prove + (`!f:num->num->A. + (!m n. f (2 * m) (n + 1) = f m n) + ==> ?g. !m n. g(&m / &2 pow n) = f m n`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN MP_TAC(ISPECL + [`\(m,n). (f:num->num->A) m n`; `\(m,n). &m / &2 pow n`] + FUNCTION_FACTORS_LEFT) THEN + REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM; o_THM] THEN + DISCH_THEN (SUBST1_TAC o SYM) THEN + ONCE_REWRITE_TAC[MESON[] + `(!a b c d. P a b c d) <=> (!b d a c. P a b c d)`] THEN + MATCH_MP_TAC WLOG_LE THEN REPEAT CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + SIMP_TAC[REAL_FIELD `~(y = &0) /\ ~(y' = &0) + ==> (x / y = x' / y' <=> y' / y * x = x')`; + REAL_POW_EQ_0; REAL_OF_NUM_EQ; REAL_DIV_POW2; ARITH_EQ] THEN + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[ADD_SUB2; REAL_OF_NUM_MUL; REAL_OF_NUM_EQ; REAL_OF_NUM_POW] THEN + REWRITE_TAC[MESON[] + `(!n n' d. n' = f d n ==> !m m'. g d m = m' ==> P m m' n d) <=> + (!d m n. P m (g d m) n d)`] THEN + INDUCT_TAC THEN SIMP_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[GSYM MULT_ASSOC; ADD1] THEN ASM_MESON_TAC[]) in + let recursion_on_dyadic_rationals = prove + (`!b:num->A l r. + ?f. (!m. f(&m) = b m) /\ + (!m n. f(&(4 * m + 1) / &2 pow (n + 1)) = + l(f(&(2 * m + 1) / &2 pow n))) /\ + (!m n. f(&(4 * m + 3) / &2 pow (n + 1)) = + r(f(&(2 * m + 1) / &2 pow n)))`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `?f:num->num->A. + (!m n. f (2 * m) (n + 1) = f m n) /\ + (!m. f m 0 = b m) /\ + (!m n. f (4 * m + 1) (n + 1) = l(f (2 * m + 1) n)) /\ + (!m n. f (4 * m + 3) (n + 1) = r(f (2 * m + 1) n))` + MP_TAC THENL + [MP_TAC(prove_recursive_functions_exist num_RECURSION + `(!m. f m 0 = (b:num->A) m) /\ + (!m n. f m (SUC n) = + if EVEN m then f (m DIV 2) n + else if EVEN(m DIV 2) + then l(f ((m + 1) DIV 2) n) + else r(f (m DIV 2) n))`) THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `f:num->num->A` THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[ADD1]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVEN_MULT; ARITH_EVEN; ARITH_RULE `(2 * m) DIV 2 = m`] THEN + REWRITE_TAC[ARITH_RULE `(4 * m + 1) DIV 2 = 2 * m`; + ARITH_RULE `(4 * m + 3) DIV 2 = 2 * m + 1`; + ARITH_RULE `((4 * m + 1) + 1) DIV 2 = 2 * m + 1`; + ARITH_RULE `((4 * m + 3) + 1) DIV 2 = 2 * m + 2`] THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; EVEN; ARITH_EVEN; SND]; + DISCH_THEN(X_CHOOSE_THEN `f:num->num->A` + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(MP_TAC o MATCH_MP function_on_dyadic_rationals) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(fun th -> RULE_ASSUM_TAC(REWRITE_RULE[GSYM th])) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_ARITH `x / &2 pow 0 = x`]) THEN + ASM_REWRITE_TAC[]]) in + let recursion_on_dyadic_rationals_1 = prove + (`!b:A l r. + ?f. (!m. f(&m / &2) = b) /\ + (!m n. 0 < n ==> f(&(4 * m + 1) / &2 pow (n + 1)) = + l(f(&(2 * m + 1) / &2 pow n))) /\ + (!m n. 0 < n ==> f(&(4 * m + 3) / &2 pow (n + 1)) = + r(f(&(2 * m + 1) / &2 pow n)))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`(\n. b):num->A`; `l:A->A`; `r:A->A`] + recursion_on_dyadic_rationals) THEN + REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real->A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. (f:real->A)(&2 * x)` THEN + ASM_REWRITE_TAC[REAL_ARITH `&2 * x / &2 = x`] THEN + CONJ_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT_REFL] THEN + ASM_SIMP_TAC[ADD_CLAUSES; real_pow; REAL_POW_EQ_0; REAL_OF_NUM_EQ; + ARITH_EQ; REAL_FIELD `~(y = &0) ==> &2 * x / (&2 * y) = x / y`]) in + let exists_function_unpair = prove + (`(?f:A->B#C. P f) <=> (?f1 f2. P(\x. (f1 x,f2 x)))`, + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN STRIP_TAC THEN + EXISTS_TAC `\x. FST((f:A->B#C) x)` THEN + EXISTS_TAC `\x. SND((f:A->B#C) x)` THEN + ASM_REWRITE_TAC[PAIR; ETA_AX]) in + let dyadics_in_open_unit_interval = prove + (`interval(vec 0,vec 1) INTER + {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)} = + {lift(&m / &2 pow n) | 0 < m /\ m < 2 EXP n}`, + MATCH_MP_TAC(SET_RULE + `(!m n. (f m n) IN s <=> P m n) + ==> s INTER {f m n | m IN UNIV /\ n IN UNIV} = + {f m n | P m n}`) THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a b m. m IN interval[a,b] /\ interval[a,b] SUBSET interval[vec 0,vec 1] + ==> ?c d. drop a <= drop c /\ drop c <= drop m /\ + drop m <= drop d /\ drop d <= drop b /\ + (!x. x IN interval[c,d] ==> f x = f m) /\ + (!x. x IN interval[a,c] DELETE c ==> ~(f x = f m)) /\ + (!x. x IN interval[d,b] DELETE d ==> ~(f x = f m)) /\ + (!x y. x IN interval[a,c] DELETE c /\ + y IN interval[d,b] DELETE d + ==> ~((f:real^1->real^N) x = f y))` + MP_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET_INTERVAL_1] THEN + REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `?c d. {x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} = + interval[c,d]` + MP_TAC THENL + [SUBGOAL_THEN + `{x | x IN interval[a,b] /\ (f:real^1->real^N) x = f m} = + interval[a,b] INTER + {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; IN_ELIM_THM; + DROP_VEC] THEN + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?c d. {x | x IN interval[vec 0,vec 1] /\ (f:real^1->real^N) x = f m} = + interval[c,d]` + MP_TAC THENL + [ASM_REWRITE_TAC[GSYM CONNECTED_COMPACT_INTERVAL_1] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | x IN s /\ P x}`] THEN + MATCH_MP_TAC COMPACT_INTER_CLOSED THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN + ASM_REWRITE_TAC[CLOSED_INTERVAL]; + STRIP_TAC THEN ASM_REWRITE_TAC[INTER_INTERVAL_1] THEN MESON_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^1` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `m IN interval[c:real^1,d]` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [GSYM th]) THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_INTERVAL_1; IN_DELETE] THEN STRIP_TAC] THEN + SUBGOAL_THEN `{c:real^1,d} SUBSET interval[c,d]` MP_TAC THENL + [ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [GSYM th]) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM; IN_INTERVAL_1] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]] THEN + CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[GSYM IN_INTERVAL_1] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [GSYM th]) THEN SIMP_TAC[IN_ELIM_THM]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `{x | x IN s /\ f x = a} = t + ==> (!x. P x ==> x IN s) /\ (!x. P x /\ Q x ==> ~(x IN t)) + ==> !x. P x /\ Q x ==> ~(f x = a)`)) THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN `{x:real^1,y} INTER interval[c,d] = {}` MP_TAC THENL + [REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`; + IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o LAND_CONV o RAND_CONV) [GSYM th])] THEN + REWRITE_TAC[SET_RULE `{a,b} INTER s = {} <=> ~(a IN s) /\ ~(b IN s)`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1] THEN + ASM_CASES_TAC `(f:real^1->real^N) x = f m` THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(f:real^1->real^N) y = f m` THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1] o + SPEC `(f:real^1->real^N) y`) THEN + ASM_REWRITE_TAC[IS_INTERVAL_1] THEN DISCH_THEN(MP_TAC o SPECL + [`x:real^1`; `y:real^1`; `m:real^1`]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`leftcut:real^1->real^1->real^1->real^1`; + `rightcut:real^1->real^1->real^1->real^1`] THEN + STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o SPECL + [`vec 0:real^1`; `vec 1:real^1`; `vec 0:real^1`]) THEN + REWRITE_TAC[SUBSET_REFL; ENDS_IN_UNIT_INTERVAL] THEN ABBREV_TAC + `u = (rightcut:real^1->real^1->real^1->real^1) (vec 0) (vec 1) (vec 0)` THEN + REWRITE_TAC[CONJ_ASSOC; REAL_LE_ANTISYM; DROP_EQ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL + [`u:real^1`; `vec 1:real^1`; `vec 1:real^1`]) THEN + REWRITE_TAC[ENDS_IN_INTERVAL; SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN ABBREV_TAC + `v = (leftcut:real^1->real^1->real^1->real^1) u (vec 1) (vec 1)` THEN + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d /\ e <=> (c /\ d) /\ a /\ b /\ e`] THEN + REWRITE_TAC[REAL_LE_ANTISYM; DROP_EQ] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[INTERVAL_SING; SET_RULE `~(x IN ({a} DELETE a))`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN interval[vec 0,v] DELETE v + ==> ~((f:real^1->real^N) x = f(vec 1))` + ASSUME_TAC THENL + [X_GEN_TAC `t:real^1` THEN + REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN STRIP_TAC THEN + ASM_CASES_TAC `drop t < drop u` THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `~(f1 = f0) ==> ft = f0 ==> ~(ft = f1)`)); + ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN + ASM_REAL_ARITH_TAC; + UNDISCH_THEN + `!x. x IN interval[u,v] DELETE v ==> ~((f:real^1->real^N) x = f (vec 1))` + (K ALL_TAC)] THEN + MP_TAC(ISPECL + [`(u:real^1,v:real^1)`; + `\(a,b). (a:real^1,leftcut a b (midpoint(a,b)):real^1)`; + `\(a,b). (rightcut a b (midpoint(a,b)):real^1,b:real^1)`] + recursion_on_dyadic_rationals_1) THEN + REWRITE_TAC[exists_function_unpair; PAIR_EQ] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real->real^1`; `b:real->real^1`] THEN + ABBREV_TAC `(c:real->real^1) x = midpoint(a x,b x)` THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!m n. drop u <= drop(a(&m / &2 pow n)) /\ + drop(a(&m / &2 pow n)) <= drop(b(&m / &2 pow n)) /\ + drop(b(&m / &2 pow n)) <= drop v` + MP_TAC THENL + [GEN_REWRITE_TAC I [SWAP_FORALL_THM] THEN MATCH_MP_TAC num_INDUCTION THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_LE_REFL]; + X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*")] THEN + X_GEN_TAC `p:num` THEN DISJ_CASES_TAC(SPEC `p:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_pow] THEN + ASM_SIMP_TAC[REAL_LT_POW2; REAL_FIELD + `&0 < y ==> (&2 * x) / (&2 * y) = x / y`]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL + [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID; REAL_LE_REFL]; + REWRITE_TAC[ADD1]] THEN + DISJ_CASES_TAC(SPEC `m:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + ASM_SIMP_TAC[ARITH_RULE `2 * 2 * r = 4 * r`]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` SUBST_ALL_TAC) THEN + ASM_SIMP_TAC[ARITH_RULE `2 * SUC(2 * r) + 1 = 4 * r + 3`]] THEN + (FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * r + 1) / &2 pow n):real^1`; + `b(&(2 * r + 1) / &2 pow n):real^1`; + `c(&(2 * r + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM th]) THEN + REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN + UNDISCH_TAC `drop(vec 0) <= drop u` THEN + UNDISCH_TAC `drop v <= drop (vec 1)`; + ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `2 * r + 1`) THEN REAL_ARITH_TAC); + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + SUBGOAL_THEN `!m n. drop(vec 0) <= drop(a(&m / &2 pow n))` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!m n. drop(b(&m / &2 pow n)) <= drop(vec 1)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN + `!m n. drop(a(&m / &2 pow n)) <= drop(c(&m / &2 pow n)) /\ + drop(c(&m / &2 pow n)) <= drop(b(&m / &2 pow n))` + MP_TAC THENL + [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x` + (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH + `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + SUBGOAL_THEN + `!i m n j. ODD j /\ + abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) + ==> drop(a(&j / &2 pow n)) <= drop(c(&i / &2 pow m)) /\ + drop(c(&i / &2 pow m)) <= drop(b(&j / &2 pow n))` + ASSUME_TAC THENL + [REPLICATE_TAC 3 GEN_TAC THEN WF_INDUCT_TAC `m - n:num` THEN + DISJ_CASES_TAC(ARITH_RULE `m <= n \/ n:num < m`) THENL + [GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `abs(&2 pow n) * abs(&i / &2 pow m - &j / &2 pow n)` + REAL_ABS_INTEGER_LEMMA) THEN + MATCH_MP_TAC(TAUT + `i /\ ~b /\ (n ==> p) ==> (i /\ ~n ==> b) ==> p`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_MUL; INTEGER_ABS] THEN + REWRITE_TAC[REAL_ARITH + `n * (x / m - y / n):real = x * (n / m) - y * (n / n)`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_SUB; LE_REFL; REAL_OF_NUM_EQ; ARITH_EQ] THEN + MESON_TAC[INTEGER_CLOSED]; + SIMP_TAC[REAL_ABS_MUL; REAL_ABS_ABS; REAL_ABS_POW; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `~(&1 <= x * y) <=> y * x < &1`] THEN + SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + ASM_REWRITE_TAC[REAL_ARITH `&1 / x = inv x`]; + ASM_SIMP_TAC[REAL_ABS_POW; REAL_ABS_NUM; REAL_ENTIRE; REAL_LT_IMP_NZ; + REAL_LT_POW2; REAL_ARITH `abs(x - y) = &0 <=> x = y`]]; + ALL_TAC] THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IMP_CONJ; ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL + [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN ASM_MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + UNDISCH_THEN `n:num < m` + (fun th -> let th' = MATCH_MP + (ARITH_RULE `n < m ==> m - SUC n < m - n`) th in + FIRST_X_ASSUM(MP_TAC o C MATCH_MP th')) THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH + `&i / &2 pow m = &(2 * j + 1) / &2 pow n \/ + &i / &2 pow m < &(2 * j + 1) / &2 pow n \/ + &(2 * j + 1) / &2 pow n < &i / &2 pow m`) + THENL + [ASM_REWRITE_TAC[ADD1]; + DISCH_THEN(MP_TAC o SPEC `4 * j + 1`) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN + MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `x < i /\ &2 * n1 = n /\ j + n1 = i + ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN + ASM_REWRITE_TAC[REAL_ARITH `a / b + inv b = (a + &1) / b`] THEN + REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `b' <= b ==> a <= c /\ c <= b' ==> a <= c /\ c <= b`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * j + 1) / &2 pow n):real^1`; + `b(&(2 * j + 1) / &2 pow n):real^1`; + `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM th]) THEN + REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH + `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]; + DISCH_THEN(MP_TAC o SPEC `4 * j + 3`) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ASM_SIMP_TAC[ADD1] THEN + MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `i < x /\ &2 * n1 = n /\ j - n1 = i + ==> abs(x - i) < n ==> abs(x - j) < n1`) THEN + ASM_REWRITE_TAC[REAL_ARITH `a / b - inv b = (a - &1) / b`] THEN + REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `a <= a' ==> a' <= c /\ c <= b ==> a <= c /\ c <= b`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * j + 1) / &2 pow n):real^1`; + `b(&(2 * j + 1) / &2 pow n):real^1`; + `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM th]) THEN + REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH + `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n. ODD m ==> abs(drop(a(&m / &2 pow n)) - drop(b(&m / &2 pow n))) + <= &2 / &2 pow n` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `x / &2 pow 0 = (&2 * x) / &2`] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN CONV_TAC NUM_REDUCE_CONV THEN + RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[ODD_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL + [ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DROP_VEC]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * 2 * j) = 4 * j + 1`] THEN + ASM_SIMP_TAC[ADD1] THEN + MATCH_MP_TAC(REAL_ARITH + `drop c = (drop a + drop b) / &2 /\ + abs(drop a - drop b) <= &2 * k /\ + drop a <= drop(leftcut a b c) /\ + drop(leftcut a b c) <= drop c + ==> abs(drop a - drop(leftcut a b c)) <= k`); + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * SUC(2 * j)) = 4 * j + 3`] THEN + ASM_SIMP_TAC[ADD1] THEN + MATCH_MP_TAC(REAL_ARITH + `drop c = (drop a + drop b) / &2 /\ + abs(drop a - drop b) <= &2 * k /\ + drop c <= drop(rightcut a b c) /\ + drop(rightcut a b c) <= drop b + ==> abs(drop(rightcut a b c) - drop b) <= k`)] THEN + (CONJ_TAC THENL + [UNDISCH_THEN `!x:real. midpoint(a x:real^1,b x) = c x` + (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `&2 * x * inv y * inv(&2 pow 1) = x / y`] THEN + ASM_SIMP_TAC[GSYM real_div; ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * j + 1) / &2 pow n):real^1`; + `b(&(2 * j + 1) / &2 pow n):real^1`; + `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM th]) THEN + REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH + `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]); + ALL_TAC] THEN + SUBGOAL_THEN + `!n j. 0 < 2 * j /\ 2 * j < 2 EXP n + ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow n)) = + f(a(&(2 * j + 1) / &2 pow n))` + ASSUME_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`; + ARITH_RULE `2 * j < 2 <=> j < 1`] THEN + ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "+") THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ARITH_RULE `0 < 2 * j <=> 0 < j`; + ARITH_RULE `2 * j < 2 <=> j < 1`] THEN + ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `k:num` THEN DISJ_CASES_TAC(SPEC `k:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN + REWRITE_TAC[EXP; ARITH_RULE `0 < 2 * j <=> 0 < j`; LT_MULT_LCANCEL] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_SIMP_TAC[ARITH_RULE `0 < j ==> 2 * 2 * j - 1 = 4 * (j - 1) + 3`; + ADD1; ARITH_RULE `2 * 2 * j + 1 = 4 * j + 1`] THEN + SIMP_TAC[ARITH_RULE `0 < j ==> 2 * (j - 1) + 1 = 2 * j - 1`] THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST1_TAC) THEN + STRIP_TAC THEN + ASM_SIMP_TAC[ADD1; ARITH_RULE `2 * SUC(2 * j) - 1 = 4 * j + 1`; + ARITH_RULE `2 * SUC(2 * j) + 1 = 4 * j + 3`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * j + 1) / &2 pow n):real^1`; + `b(&(2 * j + 1) / &2 pow n):real^1`; + `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM th]) THEN + REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[DROP_CMUL; DROP_ADD; REAL_ARITH + `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a <= b`]; + REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(MESON[] + `a IN s /\ b IN s ==> (!x. x IN s ==> f x = c) ==> f a = f b`) THEN + REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n j. 0 < j /\ j < 2 EXP n + ==> (f:real^1->real^N)(b(&(2 * j - 1) / &2 pow (n + 1))) = + f(c(&j / &2 pow n)) /\ + f(a(&(2 * j + 1) / &2 pow (n + 1))) = f(c(&j / &2 pow n))` + ASSUME_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[ARITH_RULE `~(0 < j /\ j < 2 EXP 0)`] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN + X_GEN_TAC `j:num` THEN + DISJ_CASES_TAC(SPEC `j:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + REWRITE_TAC[ADD_CLAUSES; EXP; ARITH_RULE `0 < 2 * k <=> 0 < k`; + ARITH_RULE `2 * x < 2 * y <=> x < y`] THEN STRIP_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(MESON[] + `c' = c /\ a' = a /\ b' = b + ==> b = c /\ a = c ==> b' = c' /\ a' = c'`) THEN + REPEAT CONJ_TAC THEN AP_TERM_TAC THENL + [AP_TERM_TAC THEN + REWRITE_TAC[real_pow; real_div; REAL_INV_MUL; + GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + REWRITE_TAC[ADD1; ARITH_RULE `2 * 2 * n = 4 * n`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + SUBGOAL_THEN `k = PRE k + 1` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `2 * (k + 1) - 1 = 2 * k + 1`; + ARITH_RULE `2 * 2 * (k + 1) - 1 = 4 * k + 3`] THEN + REWRITE_TAC[ADD1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + REWRITE_TAC[EXP; ARITH_RULE `SUC(2 * k) < 2 * n <=> k < n`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * k + 1) / &2 pow (SUC n)):real^1`; + `b(&(2 * k + 1) / &2 pow (SUC n)):real^1`; + `c(&(2 * k + 1) / &2 pow (SUC n)):real^1`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1]; + REPLICATE_TAC 4 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MATCH_MP_TAC th) THEN + ASM_SIMP_TAC[ARITH_RULE `2 * (2 * k + 1) - 1 = 4 * k + 1`; ADD1; + ARITH_RULE `2 * (2 * k + 1) + 1 = 4 * k + 3`; + ARITH_RULE `0 < n + 1`] THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM ADD1] THEN + ASM_SIMP_TAC[ARITH_RULE `SUC(2 * k) = 2 * k + 1`] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN + MP_TAC(ISPECL [`\x. (f:real^1->real^N)(c(drop x))`; + `interval(vec 0,vec 1) INTER + {lift(&m / &2 pow n) | m IN (:num) /\ n IN (:num)}`] + UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN + SIMP_TAC[closure_dyadic_rationals_in_convex_set_pos_1; + CONVEX_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL; + UNIT_INTERVAL_NONEMPTY; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; + CLOSURE_OPEN_INTERVAL] THEN + REWRITE_TAC[dyadics_in_open_unit_interval] THEN + ANTS_TAC THENL + [REWRITE_TAC[uniformly_continuous_on; FORALL_IN_GSPEC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN SUBGOAL_THEN + `(f:real^1->real^N) uniformly_continuous_on interval[vec 0,vec 1]` + MP_TAC THENL + [ASM_SIMP_TAC[COMPACT_UNIFORMLY_CONTINUOUS; COMPACT_INTERVAL]; + REWRITE_TAC[uniformly_continuous_on]] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`inv(&2)`; `min (d:real) (&1 / &4)`] REAL_ARCH_POW_INV) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN + EXISTS_TAC `inv(&2 pow n)` THEN + REWRITE_TAC[REAL_LT_POW2; REAL_LT_INV_EQ] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + SUBGOAL_THEN + `!i j m. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\ + abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) + ==> norm((f:real^1->real^N)(c(&i / &2 pow m)) - + f(c(&j / &2 pow n))) < e / &2` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - a) < e + ==> x = a \/ + abs(x - (a - e / &2)) < e / &2 \/ + abs(x - (a + e / &2)) < e / &2`)) + THENL + [DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_HALF]; + ALL_TAC] THEN + SUBGOAL_THEN + `&j / &2 pow n = &(2 * j) / &2 pow (n + 1)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL; + GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[real_div; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM real_div; + GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 real_pow))] THEN + REWRITE_TAC[ADD1; REAL_ARITH `x / n + inv n = (x + &1) / n`; + REAL_ARITH `x / n - inv n = (x - &1) / n`] THEN + ASM_SIMP_TAC[REAL_OF_NUM_SUB; ARITH_RULE `0 < j ==> 1 <= 2 * j`] THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN STRIP_TAC THENL + [SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) = + f(b (&(2 * j - 1) / &2 pow (n + 1)))` + SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]; + SUBGOAL_THEN `(f:real^1->real^N)(c(&j / &2 pow n)) = + f(a (&(2 * j + 1) / &2 pow (n + 1)))` + SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC]] THEN + REWRITE_TAC[GSYM dist] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1] THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `m:num`; `n + 1`]) THENL + [DISCH_THEN(MP_TAC o SPEC `2 * j - 1`) THEN REWRITE_TAC[ODD_SUB]; + DISCH_THEN(MP_TAC o SPEC `2 * j + 1`) THEN REWRITE_TAC[ODD_ADD]] THEN + ASM_REWRITE_TAC[ODD_MULT; ARITH; ARITH_RULE `1 < 2 * j <=> 0 < j`] THEN + REWRITE_TAC[DIST_REAL; GSYM drop] THENL + [MATCH_MP_TAC(NORM_ARITH + `!t. abs(a - b) <= t /\ t < d + ==> a <= c /\ c <= b ==> abs(c - b) < d`); + MATCH_MP_TAC(NORM_ARITH + `!t. abs(a - b) <= t /\ t < d + ==> a <= c /\ c <= b ==> abs(c - a) < d`)] THEN + EXISTS_TAC `&2 / &2 pow (n + 1)` THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ODD_SUB; ODD_ADD; ODD_MULT; ARITH_ODD] THEN + ASM_REWRITE_TAC[ARITH_RULE `1 < 2 * j <=> 0 < j`]; + REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN + ASM_REAL_ARITH_TAC]); + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `m:num`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN + REWRITE_TAC[DIST_LIFT; LIFT_DROP] THEN STRIP_TAC THEN + SUBGOAL_THEN + `?j. 0 < j /\ j < 2 EXP n /\ + abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\ + abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m) + (&2 pow n * &k / &2 pow p)` + FLOOR_POS) THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_MAX; REAL_LE_DIV; + REAL_POS; REAL_POW_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `j:num`) THEN + MP_TAC(SPEC `max (&2 pow n * &i / &2 pow m) + (&2 pow n * &k / &2 pow p)` FLOOR) THEN + ASM_REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_ARITH `(j + &1) / n = j / n + inv n`] THEN + ASM_CASES_TAC `j = 0` THENL + [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; REAL_ADD_LID] THEN + DISCH_TAC THEN EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ARITH_RULE `1 < n <=> 2 EXP 1 <= n`] THEN + ASM_SIMP_TAC[LE_EXP; LE_1] THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x < inv n /\ &0 < y /\ y < inv n + ==> abs(x - &1 / n) < inv n /\ abs(y - &1 / n) < inv n`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_LT_POW2]; + DISCH_TAC THEN EXISTS_TAC `j:num` THEN ASM_SIMP_TAC[LE_1] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_POW] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_FLOOR; INTEGER_CLOSED] THEN + REWRITE_TAC[REAL_NOT_LE; REAL_MAX_LT] THEN + REWRITE_TAC[REAL_ARITH `n * x < n <=> n * x < n * &1`] THEN + SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_POW2; REAL_LT_LDIV_EQ] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_POW; REAL_OF_NUM_LT]]; + MATCH_MP_TAC(NORM_ARITH + `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2 + ==> dist(w,z) < e`) THEN + EXISTS_TAC `(f:real^1->real^N)(c(&j / &2 pow n))` THEN + REWRITE_TAC[dist] THEN CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN + REWRITE_TAC[FORALL_IN_GSPEC; LIFT_DROP] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o CONJUNCT1)) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS) THEN + ONCE_REWRITE_TAC[MESON[] `h x = f(c(drop x)) <=> f(c(drop x)) = h x`] THEN + REWRITE_TAC[IN_INTER; IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN + ASM_REWRITE_TAC[IN_UNIV; LIFT_DROP; IMP_IMP; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN DISCH_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)` + closure_dyadic_rationals_in_convex_set_pos_1) THEN + SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; + INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01; + CLOSURE_OPEN_INTERVAL] THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN + MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]; + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL]; + SIMP_TAC[dyadics_in_open_unit_interval; SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]]; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `closure(IMAGE (h:real^1->real^N) + (interval (vec 0,vec 1) INTER + {lift (&m / &2 pow n) | m IN (:num) /\ n IN (:num)}))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_INTERVAL; + COMPACT_CONTINUOUS_IMAGE] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED]] THEN + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[dyadics_in_open_unit_interval; + EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN UNDISCH_TAC + `(f:real^1->real^N) continuous_on interval [vec 0,vec 1]` THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPACT_UNIFORMLY_CONTINUOUS)) THEN + REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!n. ~(n = 0) + ==> ?m y. ODD m /\ 0 < m /\ m < 2 EXP n /\ + y IN interval[a(&m / &2 pow n),b(&m / &2 pow n)] /\ + (f:real^1->real^N) y = f x` + MP_TAC THENL + [ALL_TAC; + MP_TAC(SPECL [`inv(&2)`; `min (d / &2) (&1 / &4)`] + REAL_ARCH_POW_INV) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_POW_INV; REAL_LT_MIN] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN STRIP_TAC THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^1` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN EXISTS_TAC `n:num` THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REWRITE_TAC[DIST_REAL; GSYM drop; IN_INTERVAL_1] THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= y /\ y <= b + ==> a <= c /\ c <= b /\ abs(a - b) < d + ==> abs(c - y) < d`)) THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC]) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&2 / &2 pow n` THEN + ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[NOT_SUC] THEN + X_GEN_TAC `n:num` THEN ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `1` THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[REAL_POW_1] THEN + SUBGOAL_THEN + `x IN interval[vec 0:real^1,u] \/ + x IN interval[u,v] \/ + x IN interval[v,vec 1]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + EXISTS_TAC `u:real^1` THEN + ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]; + EXISTS_TAC `x:real^1` THEN ASM_MESON_TAC[]; + EXISTS_TAC `v:real^1` THEN + ASM_MESON_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1]]; + DISCH_THEN(X_CHOOSE_THEN `m:num` + (X_CHOOSE_THEN `y:real^1` MP_TAC)) THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (SUBST1_TAC o SYM)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ADD1] THEN DISCH_TAC THEN + SUBGOAL_THEN + `y IN interval[a(&(2 * j + 1) / &2 pow n):real^1, + b(&(4 * j + 1) / &2 pow (n + 1))] \/ + y IN interval[b(&(4 * j + 1) / &2 pow (n + 1)), + a(&(4 * j + 3) / &2 pow (n + 1))] \/ + y IN interval[a(&(4 * j + 3) / &2 pow (n + 1)), + b(&(2 * j + 1) / &2 pow n)]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + EXISTS_TAC `4 * j + 1` THEN + EXISTS_TAC `y:real^1` THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `y IN interval[a,b] + ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN + ASM_MESON_TAC[LE_1]; + EXISTS_TAC `4 * j + 1` THEN + EXISTS_TAC `b(&(4 * j + 1) / &2 pow (n + 1)):real^1` THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LE_TRANS]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * j + 1) / &2 pow n):real^1`; + `b(&(2 * j + 1) / &2 pow n):real^1`; + `c(&(2 * j + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[midpoint; IN_INTERVAL_1; SUBSET_INTERVAL_1]; + REPLICATE_TAC 4 + (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)] THEN + MATCH_MP_TAC(MESON[] + `a IN s /\ b IN s ==> (!x. x IN s ==> f x = k) ==> f a = f b`) THEN + SUBGOAL_THEN + `leftcut (a (&(2 * j + 1) / &2 pow n)) + (b (&(2 * j + 1) / &2 pow n)) + (c (&(2 * j + 1) / &2 pow n):real^1):real^1 = + b(&(4 * j + 1) / &2 pow (n + 1)) /\ + rightcut (a (&(2 * j + 1) / &2 pow n)) + (b (&(2 * j + 1) / &2 pow n)) + (c (&(2 * j + 1) / &2 pow n)):real^1 = + a(&(4 * j + 3) / &2 pow (n + 1))` + (CONJUNCTS_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[LE_1]; ALL_TAC] THEN + REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY_1] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `y IN interval[a,b] + ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN + ASM_MESON_TAC[LE_1]; + EXISTS_TAC `4 * j + 3` THEN + EXISTS_TAC `y:real^1` THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH; EXP_ADD] THEN + REPEAT(CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `y IN interval[a,b] + ==> a = a' /\ b = b' ==> y IN interval[a',b']`)) THEN + ASM_MESON_TAC[LE_1]]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n m. drop(a(&m / &2 pow n)) < drop(b(&m / &2 pow n)) /\ + (!x. drop(a(&m / &2 pow n)) < drop x /\ + drop x <= drop(b(&m / &2 pow n)) + ==> ~(f x = f(a(&m / &2 pow n)))) /\ + (!x. drop(a(&m / &2 pow n)) <= drop x /\ + drop x < drop(b(&m / &2 pow n)) + ==> ~(f x :real^N = f(b(&m / &2 pow n))))` + ASSUME_TAC THENL + [SUBGOAL_THEN `drop u < drop v` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE; DROP_EQ] THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE + [IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ; DROP_VEC]) THEN + ASM_MESON_TAC[DROP_EQ]; + ALL_TAC] THEN + SUBGOAL_THEN + `(!x. drop u < drop x /\ drop x <= drop v + ==> ~((f:real^1->real^N) x = f u)) /\ + (!x. drop u <= drop x /\ drop x < drop v + ==> ~(f x = f v))` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `(f:real^1->real^N) u = f(vec 0) /\ + (f:real^1->real^N) v = f(vec 1)` + (CONJUNCTS_THEN SUBST1_TAC) + THENL + [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL]; + ALL_TAC] THEN + CONJ_TAC THEN GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_DELETE; IN_INTERVAL_1; GSYM DROP_EQ] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC num_INDUCTION THEN + ASM_REWRITE_TAC[REAL_ARITH `&m / &2 pow 0 = (&2 * &m) / &2`] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "*") THEN + DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 0 < n`) THEN + ASM_REWRITE_TAC[ARITH; REAL_POW_1] THEN + X_GEN_TAC `j:num` THEN + DISJ_CASES_TAC(ISPEC `j:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL; real_pow] THEN + ASM_REWRITE_TAC[REAL_ARITH `(&2 * p) * inv(&2) * inv q = p / q`]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + DISJ_CASES_TAC(ISPEC `k:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + ASM_SIMP_TAC[ARITH_RULE `2 * 2 * m = 4 * m`; ADD1] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * m + 1) / &2 pow n):real^1`; + `b(&(2 * m + 1) / &2 pow n):real^1`; + `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(K ALL_TAC)] THEN + SUBGOAL_THEN + `(f:real^1->real^N) + (leftcut (a (&(2 * m + 1) / &2 pow n):real^1) + (b (&(2 * m + 1) / &2 pow n):real^1) + (c (&(2 * m + 1) / &2 pow n):real^1)) = + (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))` + ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN + REPEAT CONJ_TAC THENL + [DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + UNDISCH_THEN + `(f:real^1->real^N) (a (&(2 * m + 1) / &2 pow n)) = + f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN + REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN + REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`); + midpoint; DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[REAL_ARITH + `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`]; + GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT1 o CONJUNCT2 o SPEC_ALL) THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM + (fun th -> MATCH_MP_TAC th THEN + REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN + GEN_REWRITE_TAC I [REAL_ARITH + `(a <= x /\ x <= b) /\ ~(x = b) <=> a <= x /\ x < b`]) THEN + ASM_REWRITE_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + ASM_SIMP_TAC[ARITH_RULE `2 * (2 * m + 1) + 1 = 4 * m + 3`; ADD1] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * m + 1) / &2 pow n):real^1`; + `b(&(2 * m + 1) / &2 pow n):real^1`; + `c(&(2 * m + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(K ALL_TAC)] THEN + SUBGOAL_THEN + `(f:real^1->real^N) + (rightcut (a (&(2 * m + 1) / &2 pow n):real^1) + (b (&(2 * m + 1) / &2 pow n):real^1) + (c (&(2 * m + 1) / &2 pow n):real^1)) = + (f:real^1->real^N) (c(&(2 * m + 1) / &2 pow n))` + ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_LT_LE] THEN ASM_REWRITE_TAC[DROP_EQ] THEN + REPEAT CONJ_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_THEN + `(f:real^1->real^N) (b (&(2 * m + 1) / &2 pow n)) = + f(c (&(2 * m + 1) / &2 pow n))` (MP_TAC o SYM) THEN + REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN + REWRITE_TAC[GSYM(ASSUME `!x. midpoint ((a:real->real^1) x,b x) = c x`); + midpoint; DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[REAL_ARITH + `a <= inv(&2) * (a + b) /\ inv(&2) * (a + b) < b <=> a < b`]; + GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM + (fun th -> MATCH_MP_TAC th THEN + REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN + GEN_REWRITE_TAC I [REAL_ARITH + `(a <= x /\ x <= b) /\ ~(x = a) <=> a < x /\ x <= b`]) THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o CONJUNCT2 o SPEC_ALL) THEN + ASM_MESON_TAC[REAL_LE_TRANS]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m i n j. 0 < i /\ i < 2 EXP m /\ 0 < j /\ j < 2 EXP n /\ + &i / &2 pow m < &j / &2 pow n + ==> drop(c(&i / &2 pow m)) <= drop(c(&j / &2 pow n))` + ASSUME_TAC THENL + [SUBGOAL_THEN + `!N m p i k. + 0 < i /\ i < 2 EXP m /\ 0 < k /\ k < 2 EXP p /\ + &i / &2 pow m < &k / &2 pow p /\ m + p = N + ==> ?j n. ODD(j) /\ ~(n = 0) /\ + &i / &2 pow m <= &j / &2 pow n /\ + &j / &2 pow n <= &k / &2 pow p /\ + abs(&i / &2 pow m - &j / &2 pow n) < inv(&2 pow n) /\ + abs(&k / &2 pow p - &j / &2 pow n) < inv(&2 pow n)` + MP_TAC THENL + [MATCH_MP_TAC num_WF THEN X_GEN_TAC `N:num` THEN + DISCH_THEN(LABEL_TAC "I") THEN + MAP_EVERY X_GEN_TAC [`m:num`; `p:num`; `i:num`; `k:num`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `&i / &2 pow m <= &1 / &2 pow 1 /\ + &1 / &2 pow 1 <= &k / &2 pow p \/ + &k / &2 pow p < &1 / &2 \/ + &1 / &2 < &i / &2 pow m` + (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) + THENL + [ASM_REAL_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`1`; `1`] THEN ASM_REWRITE_TAC[ARITH] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < i /\ i <= &1 / &2 pow 1 /\ &1 / &2 pow 1 <= k /\ k < &1 + ==> abs(i - &1 / &2 pow 1) < inv(&2 pow 1) /\ + abs(k - &1 / &2 pow 1) < inv(&2 pow 1)`) THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[MULT_CLAUSES; REAL_OF_NUM_POW; REAL_OF_NUM_MUL] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT]; + REMOVE_THEN "I" MP_TAC THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN + REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN + REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN + ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `p:num`; `i:num`; `k:num`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`&k / &2 pow SUC p < &1 / &2`; + `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN + REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; + REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN + SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `x < y /\ y < &1 ==> x < &1 /\ y < &1`)) THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LT]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `SUC n` THEN ASM_REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; + REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC; + REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; + REAL_OF_NUM_LT; ARITH]]; + REMOVE_THEN "I" MP_TAC THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN + REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ARITH_RULE `i < 2 EXP 0 <=> ~(0 < i)`] THEN + REWRITE_TAC[TAUT `p /\ ~p /\ q <=> F`] THEN POP_ASSUM(K ALL_TAC) THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC `m + p:num`) THEN + ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL + [`m:num`; `p:num`; `i - 2 EXP m`; `k - 2 EXP p`]) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC + [`&1 / &2 < &i / &2 pow SUC m`; + `&i / &2 pow SUC m < &k / &2 pow SUC p`] THEN + REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; + REAL_ARITH `x * inv(&2) * y = (x * y) * inv(&2)`] THEN + SIMP_TAC[GSYM real_div; REAL_LT_DIV2_EQ; REAL_OF_NUM_LT; ARITH] THEN + GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th -> + STRIP_ASSUME_TAC th THEN MP_TAC(MATCH_MP + (REAL_ARITH `i < k /\ &1 < i ==> &1 < i /\ &1 < k`) th)) THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_POW2; REAL_MUL_LID] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [REAL_OF_NUM_POW] THEN + SIMP_TAC[REAL_OF_NUM_LT; GSYM REAL_OF_NUM_SUB; LT_IMP_LE] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[ARITH_RULE `a < b ==> 0 < b - a`] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN + ASM_REWRITE_TAC[REAL_ARITH `u * inv v - &1 < w * inv z - &1 <=> + u / v < w / z`] THEN + CONJ_TAC THEN MATCH_MP_TAC(ARITH_RULE + `i < 2 * m ==> i - m < m`) THEN + ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)]; + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN + REWRITE_TAC[GSYM real_div] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `n:num` + STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `2 EXP n + j` THEN EXISTS_TAC `SUC n` THEN + ASM_REWRITE_TAC[NOT_SUC; ODD_ADD; ODD_EXP; ARITH] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[real_div; real_pow; REAL_INV_MUL; + REAL_ARITH `inv(&2) * y = y * inv(&2)`] THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB; REAL_MUL_ASSOC; + REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM real_div; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; + REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_LT_POW2] THEN + REWRITE_TAC[GSYM real_div] THEN ASM_REAL_ARITH_TAC]]; + DISCH_THEN(fun th -> + MAP_EVERY X_GEN_TAC [`m:num`; `i:num`; `p:num`; `k:num`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`m + p:num`; `m:num`; `p:num`; `i:num`; `k:num`] th)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`j:num`; `n:num`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + REWRITE_TAC[ADD1; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `q:num` THEN DISCH_THEN SUBST_ALL_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(c(&(2 * q + 1) / &2 pow n))` THEN CONJ_TAC THENL + [ASM_CASES_TAC `&i / &2 pow m = &(2 * q + 1) / &2 pow n` THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN + SUBGOAL_THEN + `drop(a(&(4 * q + 1) / &2 pow (n + 1))) <= drop(c(&i / &2 pow m)) /\ + drop(c(&i / &2 pow m)) <= drop(b(&(4 * q + 1) / &2 pow (n + 1)))` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN + SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(i - q) < n + ==> i <= q /\ ~(i = q) /\ q = q' + n / &2 + ==> abs(i - q') < n / &2`)) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH + `l <= d ==> u <= v /\ c <= l ==> c <= d`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * q + 1) / &2 pow n):real^1`; + `b(&(2 * q + 1) / &2 pow n):real^1`; + `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]]; + ASM_CASES_TAC `&k / &2 pow p = &(2 * q + 1) / &2 pow n` THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN + SUBGOAL_THEN + `drop(a(&(4 * q + 3) / &2 pow (n + 1))) <= drop(c(&k / &2 pow p)) /\ + drop(c(&k / &2 pow p)) <= drop(b(&(4 * q + 3) / &2 pow (n + 1)))` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN + SIMP_TAC[real_div; REAL_POW_ADD; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM real_div; REAL_POW_1] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(i - q) < n + ==> q <= i /\ ~(i = q) /\ q' = q + n / &2 + ==> abs(i - q') < n / &2`)) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[LE_1] THEN MATCH_MP_TAC(REAL_ARITH + `d <= l ==> l <= c /\ u <= v ==> d <= c`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * q + 1) / &2 pow n):real^1`; + `b(&(2 * q + 1) / &2 pow n):real^1`; + `c(&(2 * q + 1) / &2 pow n):real^1`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]]]]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1; DROP_VEC] THEN + MAP_EVERY X_GEN_TAC [`x1:real^1`; `x2:real^1`] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?m n. 0 < m /\ m < 2 EXP n /\ + drop x1 < &m / &2 pow n /\ &m / &2 pow n < drop x2 /\ + ~(h(x1):real^N = h(lift(&m / &2 pow n)))` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `interval(vec 0:real^1,vec 1)` + closure_dyadic_rationals_in_convex_set_pos_1) THEN + SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; + INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01; + CLOSURE_OPEN_INTERVAL] THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2) % (x1 + x2):real^1`) THEN + REWRITE_TAC[dyadics_in_open_unit_interval; IN_INTERVAL_1; DROP_VEC] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (q <=> p) ==> r`) THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[CLOSURE_APPROACHABLE]] THEN + DISCH_THEN(MP_TAC o SPEC `(drop x2 - drop x1) / &64`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[EXISTS_IN_GSPEC]] THEN + REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP; DROP_CMUL; DROP_ADD] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `?m n. (0 < m /\ m < 2 EXP n) /\ + abs(&m / &2 pow n - inv (&2) * (drop x1 + drop x2)) < + (drop x2 - drop x1) / &64 /\ + inv(&2 pow n) < (drop x2 - drop x1) / &128` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`inv(&2)`; `min (&1 / &4) ((drop x2 - drop x1) / &128)`] + REAL_ARCH_POW_INV) THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + ASM_CASES_TAC `N = 0` THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_INV_POW; REAL_LT_MIN; EXISTS_IN_GSPEC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num` + STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `2 EXP N * m` THEN EXISTS_TAC `N + n:num` THEN + ASM_SIMP_TAC[EXP_ADD; LT_MULT; EXP_LT_0; LT_MULT_LCANCEL; LE_1; + ARITH_EQ] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_ADD; real_div; REAL_INV_MUL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW; REAL_ARITH + `(N * n) * inv N * inv m:real = (N / N) * (n / m)`] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH_EQ; + REAL_MUL_LID; GSYM real_div]; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&2) pow N` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_MONO_INV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LE_ADD]]; + REWRITE_TAC[CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] + `!m n m' n'. (P m n /\ P m' n') /\ + (P m n /\ P m' n' ==> ~(g m n = g m' n')) + ==> (?m n. P m n /\ ~(a = g m n))`) THEN + MAP_EVERY EXISTS_TAC + [`2 * m + 1`; `n + 1`; `4 * m + 3`; `n + 2`] THEN + CONJ_TAC THENL + [REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN CONJ_TAC THEN + (REWRITE_TAC[GSYM CONJ_ASSOC] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC])) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - inv(&2) * (x1 + x2)) < (x2 - x1) / &64 + ==> abs(x - y) < (x2 - x1) / &4 + ==> x1 < y /\ y < x2`)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `n < x / &128 ==> &0 < x /\ y < &4 * n ==> y < x / &4`)) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `a / y = x /\ abs(b / y) < z + ==> abs(x - (a + b) / y) < z`) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[REAL_POW_ADD] THEN + SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_MUL; REAL_ABS_POW] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_LT_RMUL_EQ; REAL_EQ_MUL_RCANCEL; REAL_LT_INV_EQ; + REAL_LT_POW2; REAL_INV_EQ_0; REAL_POW_EQ_0; ARITH_EQ; + REAL_OF_NUM_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o SPECL [`n + 2`; `4 * m + 3`]) THEN + UNDISCH_THEN `!x. midpoint ((a:real->real^1) x,b x) = c x` + (fun th -> REWRITE_TAC[GSYM th] THEN + ASM_SIMP_TAC[ARITH_RULE `n + 2 = (n + 1) + 1 /\ 0 < n + 1`] THEN + REWRITE_TAC[th] THEN ASSUME_TAC th) THEN + DISCH_TAC THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a(&(2 * m + 1) / &2 pow (n + 1)):real^1`; + `b(&(2 * m + 1) / &2 pow (n + 1)):real^1`; + `c(&(2 * m + 1) / &2 pow (n + 1)):real^1`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + REPLICATE_TAC 6 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT1)] THEN + REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; GSYM DROP_EQ] THEN + REWRITE_TAC[REAL_ARITH + `(a <= b /\ b <= c) /\ ~(b = a) <=> a < b /\ b <= c`] THEN + REWRITE_TAC[midpoint; DROP_CMUL; DROP_ADD] THEN + ASM_REWRITE_TAC[REAL_ARITH + `a < inv(&2) * (a + b) /\ inv(&2) * (a + b) <= b <=> a < b`] THEN + ASM_REWRITE_TAC[REAL_LT_LE]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE h (interval[vec 0,lift(&m / &2 pow n)]) SUBSET + IMAGE (f:real^1->real^N) (interval[vec 0,c(&m / &2 pow n)]) /\ + IMAGE h (interval[lift(&m / &2 pow n),vec 1]) SUBSET + IMAGE (f:real^1->real^N) (interval[c(&m / &2 pow n),vec 1])` + MP_TAC THENL + [MP_TAC(ISPEC `interval(lift(&m / &2 pow n),vec 1)` + closure_dyadic_rationals_in_convex_set_pos_1) THEN + MP_TAC(ISPEC `interval(vec 0,lift(&m / &2 pow n))` + closure_dyadic_rationals_in_convex_set_pos_1) THEN + SUBGOAL_THEN `&0 < &m / &2 pow n /\ &m / &2 pow n < &1` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_POW2; REAL_OF_NUM_LT; REAL_LT_LDIV_EQ; + REAL_OF_NUM_MUL; REAL_OF_NUM_LT; REAL_OF_NUM_POW; MULT_CLAUSES]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT + `(p1 /\ p2) /\ (q1 ==> r1) /\ (q2 ==> r2) + ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r1 /\ r2`) THEN + ASM_SIMP_TAC[CONVEX_INTERVAL; IN_INTERVAL_1; REAL_LT_IMP_LE; DROP_VEC; + INTERIOR_OPEN; OPEN_INTERVAL; INTERVAL_NE_EMPTY_1; REAL_LT_01; + CLOSURE_OPEN_INTERVAL; LIFT_DROP] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + (MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_INTERVAL] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN + ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; REAL_LT_IMP_LE; DROP_VEC; + REAL_LE_REFL]; + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; REAL_LE_REFL] THEN + ASM_MESON_TAC[REAL_LE_TRANS]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(SET_RULE + `i SUBSET interval(vec 0,vec 1) /\ + (!x. x IN interval(vec 0,vec 1) INTER l ==> x IN i ==> P x) + ==> !x. x IN i INTER l ==> P x`) THEN + ASM_SIMP_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; + REAL_LT_IMP_LE; REAL_LE_REFL] THEN + REWRITE_TAC[dyadics_in_open_unit_interval; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`k:num`; `p:num`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN REWRITE_TAC[IN_INTERVAL_1] THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[REAL_LE_TRANS]]); + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `IMAGE h s SUBSET t /\ IMAGE h s' SUBSET t' + ==> !x y. x IN s /\ y IN s' ==> h(x) IN t /\ h(y) IN t'`)) THEN + DISCH_THEN(MP_TAC o SPECL [`x1:real^1`; `x2:real^1`]) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC; REAL_LT_IMP_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `a IN IMAGE f s /\ a IN IMAGE f t + ==> ?x y. x IN s /\ y IN t /\ f x = a /\ f y = a`)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t1:real^1`; `t2:real^1`] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(h:real^1->real^N) x2` o + GEN_REWRITE_RULE BINDER_CONV [GSYM IS_INTERVAL_CONNECTED_1]) THEN + REWRITE_TAC[IS_INTERVAL_1; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPECL + [`t1:real^1`; `t2:real^1`; `c(&m / &2 pow n):real^1`]) THEN + UNDISCH_TAC `~(h x1:real^N = h(lift (&m / &2 pow n)))` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC(TAUT `q ==> p ==> ~q ==> r`) THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + ASM_MESON_TAC[REAL_LE_TRANS]]);; + +let PATH_CONTAINS_ARC = prove + (`!p:real^1->real^N a b. + path p /\ pathstart p = a /\ pathfinish p = b /\ ~(a = b) + ==> ?q. arc q /\ path_image q SUBSET path_image p /\ + pathstart q = a /\ pathfinish q = b`, + REWRITE_TAC[pathstart; pathfinish; path] THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real^N`; `a:real^N`; `b:real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`\s. s SUBSET interval[vec 0,vec 1] /\ + vec 0 IN s /\ vec 1 IN s /\ + (!x y. x IN s /\ y IN s /\ segment(x,y) INTER s = {} + ==> (f:real^1->real^N)(x) = f(y))`; + `interval[vec 0:real^1,vec 1]`] + BROUWER_REDUCTION_THEOREM_GEN) THEN + ASM_REWRITE_TAC[GSYM path_image; CLOSED_INTERVAL; SUBSET_REFL] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `s INTER i = {} ==> s SUBSET i ==> s = {}`)) THEN + REWRITE_TAC[SEGMENT_EQ_EMPTY] THEN + ANTS_TAC THENL [ONCE_REWRITE_TAC[segment]; MESON_TAC[]] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF i SUBSET t`) THEN + ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]] THEN + X_GEN_TAC `s:num->real^1->bool` THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; SUBSET; IN_ELIM_THM; IN_UNIV] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; + REWRITE_TAC[FORALL_DROP; LIFT_DROP]] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN + SIMP_TAC[SEGMENT_1; REAL_LT_IMP_LE] THEN DISCH_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPACT_UNIFORMLY_CONTINUOUS)) THEN + REWRITE_TAC[COMPACT_INTERVAL; uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `norm((f:real^1->real^N) x - f y) / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; NORM_POS_LT; VECTOR_SUB_EQ] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?u v. u IN interval[vec 0,vec 1] /\ v IN interval[vec 0,vec 1] /\ + norm(u - x) < e /\ norm(v - y) < e /\ (f:real^1->real^N) u = f v` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(fun th -> + MP_TAC(ISPECL [`x:real^1`; `u:real^1`] th) THEN + MP_TAC(ISPECL [`y:real^1`; `v:real^1`] th)) THEN + ASM_REWRITE_TAC[dist] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> ~r) ==> p ==> ~(q ==> r)`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC NORM_ARITH]] THEN + SUBGOAL_THEN + `?w z. w IN interval(x,y) /\ z IN interval(x,y) /\ drop w < drop z /\ + norm(w - x) < e /\ norm(z - y) < e` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `x + lift(min e (drop y - drop x) / &3)` THEN + EXISTS_TAC `y - lift(min e (drop y - drop x) / &3)` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_ADD; DROP_SUB; LIFT_DROP; + NORM_REAL; GSYM drop] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`interval[w:real^1,z]`; + `{s n :real^1->bool | n IN (:num)}`] COMPACT_IMP_FIP) THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_GSPEC] THEN + MATCH_MP_TAC(TAUT `q /\ (~p ==> r) ==> (p ==> ~q) ==> r`) THEN + CONJ_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_UNIV] THEN FIRST_X_ASSUM(MATCH_MP_TAC o + MATCH_MP (SET_RULE + `s INTER u = {} ==> t SUBSET s ==> t INTER u = {}`)) THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[MESON[] `~(!x. P x /\ Q x ==> R x) <=> + (?x. P x /\ Q x /\ ~R x)`] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP + UPPER_BOUND_FINITE_SET) THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `interval[w,z] INTER (s:num->real^1->bool) n = {}` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `a INTER t = {} ==> s SUBSET t ==> a INTER s = {}`)) THEN + REWRITE_TAC[SUBSET; INTERS_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE + `(!x. x IN s n ==> !i. i IN k ==> x IN s i) <=> + (!i. i IN k ==> s n SUBSET s i)`] THEN + SUBGOAL_THEN + `!i n. i <= n ==> (s:num->real^1->bool) n SUBSET s i` + (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_REWRITE_TAC[] THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?u. u IN (s:num->real^1->bool) n /\ u IN interval[x,w] /\ + (interval[u,w] DELETE u) INTER (s n) = {}` + MP_TAC THENL + [ASM_CASES_TAC `w IN (s:num->real^1->bool) n` THENL + [EXISTS_TAC `w:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN + REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[x,w]`; + `w:real^1`] SEGMENT_TO_POINT_EXISTS) THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^1` THEN + ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN + REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]; + ANTS_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]]]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^1` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?v. v IN (s:num->real^1->bool) n /\ v IN interval[z,y] /\ + (interval[z,v] DELETE v) INTER (s n) = {}` + MP_TAC THENL + [ASM_CASES_TAC `z IN (s:num->real^1->bool) n` THENL + [EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[ENDS_IN_INTERVAL] THEN + REWRITE_TAC[INTERVAL_SING; SET_RULE `{a} DELETE a = {}`] THEN + REWRITE_TAC[INTER_EMPTY; INTERVAL_NE_EMPTY_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`(s:num->real^1->bool) n INTER interval[z,y]`; + `z:real^1`] SEGMENT_TO_POINT_EXISTS) THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_INTERVAL] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^1` THEN + ASM_REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN + REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `s INTER t INTER u = {} ==> s SUBSET u ==> s INTER t = {}`)) THEN + REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL + [ANTS_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL_1] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN ASM SET_TAC[]]; + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM_MESON_TAC[DROP_EQ; REAL_LE_ANTISYM]]]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM SET_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[NORM_REAL; GSYM drop; DROP_SUB]) THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[SEGMENT_1] THEN COND_CASES_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`interval[w,z] INTER (s:num->real^1->bool) n = {}`; + `interval[u,w] DELETE u INTER (s:num->real^1->bool) n = {}`; + `interval[z,v] DELETE v INTER (s:num->real^1->bool) n = {}`] THEN + REWRITE_TAC[IMP_IMP; SET_RULE + `s1 INTER t = {} /\ s2 INTER t = {} <=> + (s1 UNION s2) INTER t = {}`] THEN + MATCH_MP_TAC(SET_RULE + `t SUBSET s ==> s INTER u = {} ==> t INTER u = {}`) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_DELETE; + GSYM DROP_EQ; IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `t:real^1->bool = {}` THENL + [ASM_MESON_TAC[IN_IMAGE; NOT_IN_EMPTY]; ALL_TAC] THEN + ABBREV_TAC + `h = \x. (f:real^1->real^N)(@y. y IN t /\ segment(x,y) INTER t = {})` THEN + SUBGOAL_THEN + `!x y. y IN t /\ segment(x,y) INTER t = {} ==> h(x) = (f:real^1->real^N)(y)` + ASSUME_TAC THENL + [SUBGOAL_THEN + `!x y z. y IN t /\ segment(x,y) INTER t = {} /\ + z IN t /\ segment(x,z) INTER t = {} + ==> (f:real^1->real^N)(y) = f(z)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:real^1) IN t` THENL + [ASM_MESON_TAC[]; UNDISCH_TAC `~((x:real^1) IN t)`] THEN + ONCE_REWRITE_TAC[TAUT `p ==> a /\ b /\ c /\ d ==> q <=> + (a /\ c) ==> p /\ b /\ d ==> q`] THEN + STRIP_TAC THEN + REWRITE_TAC[SET_RULE `~(x IN t) /\ s INTER t = {} /\ s' INTER t = {} <=> + (x INSERT (s UNION s')) INTER t = {}`] THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE + `s SUBSET s' ==> s' INTER t = {} ==> s INTER t = {}`) THEN + REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN + GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `!x. x IN t ==> h(x) = (f:real^1->real^N)(x)` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[SEGMENT_REFL; INTER_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:real^1. ?y. y IN t /\ segment(x,y) INTER t = {}` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^1` THEN + EXISTS_TAC `closest_point t (x:real^1)` THEN + ASM_SIMP_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. segment(x,y) INTER t = {} ==> (h:real^1->real^N) x = h y` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^1`; `x':real^1`] THEN + ASM_CASES_TAC `(x:real^1) IN t` THENL + [ASM_MESON_TAC[SEGMENT_SYM]; ALL_TAC] THEN + ASM_CASES_TAC `(x':real^1) IN t` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?y y'. y IN t /\ segment(x,y) INTER t = {} /\ h x = f y /\ + y' IN t /\ segment(x',y') INTER t = {} /\ + (h:real^1->real^N) x' = f y'` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY UNDISCH_TAC + [`~((x:real^1) IN t)`; `~((x':real^1) IN t)`; + `segment(x:real^1,y) INTER t = {}`; + `segment(x':real^1,y') INTER t = {}`; + `segment(x:real^1,x') INTER t = {}`] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET (x1 INSERT x2 INSERT (s0 UNION s1 UNION s2)) + ==> s0 INTER t = {} ==> s1 INTER t = {} ==> s2 INTER t = {} + ==> ~(x1 IN t) ==> ~(x2 IN t) ==> s INTER t = {}`) THEN + REWRITE_TAC[SEGMENT_1; SUBSET; IN_UNION; IN_INSERT; IN_INTERVAL_1] THEN + GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `h:real^1->real^N` HOMEOMORPHIC_MONOTONE_IMAGE_INTERVAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[continuous_on] THEN X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN + DISCH_THEN(MP_TAC o SPEC `u:real^1`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `v:real^1` THEN STRIP_TAC THEN + ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL + [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `(?w:real^1. w IN t /\ w IN segment[u,v] /\ segment(u,w) INTER t = {}) /\ + (?z:real^1. z IN t /\ z IN segment[u,v] /\ segment(v,z) INTER t = {})` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `u:real^1`] + SEGMENT_TO_POINT_EXISTS); + MP_TAC(ISPECL [`segment[u:real^1,v] INTER t`; `v:real^1`] + SEGMENT_TO_POINT_EXISTS)] THEN + (ASM_SIMP_TAC[CLOSED_INTER; CLOSED_SEGMENT] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(segment(u,v) INTER t = {}) + ==> segment(u,v) SUBSET segment[u,v] + ==> ~(segment[u,v] INTER t = {})`)) THEN + REWRITE_TAC[SEGMENT_OPEN_SUBSET_CLOSED]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `w:real^1` THEN + SIMP_TAC[IN_INTER] THEN + MATCH_MP_TAC(SET_RULE + `(w IN uv ==> uw SUBSET uv) + ==> (w IN uv /\ w IN t) /\ (uw INTER uv INTER t = {}) + ==> uw INTER t = {}`) THEN + DISCH_TAC THEN REWRITE_TAC[open_segment] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t`) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[GSYM SEGMENT_CONVEX_HULL; CONVEX_SEGMENT] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_SEGMENT]); + SUBGOAL_THEN `(h:real^1->real^N) u = (f:real^1->real^N) w /\ + (h:real^1->real^N) v = (f:real^1->real^N) z` + (fun th -> REWRITE_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH + `!u. dist(w:real^N,u) < e / &2 /\ dist(z,u) < e / &2 + ==> dist(w,z) < e`) THEN + EXISTS_TAC `(f:real^1->real^N) u` THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[CONVEX_INTERVAL; INSERT_SUBSET; EMPTY_SUBSET]; + ASM_MESON_TAC[DIST_IN_CLOSED_SEGMENT; REAL_LET_TRANS; DIST_SYM]])]; + X_GEN_TAC `z:real^N` THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `segment[u:real^1,v]` THEN + REWRITE_TAC[CONNECTED_SEGMENT; ENDS_IN_SEGMENT] THEN + ASM_CASES_TAC `segment(u:real^1,v) INTER t = {}` THENL + [REWRITE_TAC[SET_RULE `s SUBSET {x | x IN t /\ P x} <=> + s SUBSET t /\ !x. x IN s ==> P x`] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; CONVEX_INTERVAL]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `segment(u:real^1,x) INTER t = {}` + (fun th -> ASM_MESON_TAC[th]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `uv INTER t = {} ==> ux SUBSET uv ==> ux INTER t = {}`)) THEN + UNDISCH_TAC `(x:real^1) IN segment[u,v]` THEN + REWRITE_TAC[SEGMENT_1] THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; SUBSET_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF segment(u:real^1,v)`) THEN + ASM_REWRITE_TAC[SET_RULE `t DIFF s PSUBSET t <=> ~(s INTER t = {})`] THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_DIFF THEN ASM_REWRITE_TAC[OPEN_SEGMENT_1]; + ASM SET_TAC[]; + ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC + [`(u:real^1) IN interval[vec 0,vec 1]`; + `(v:real^1) IN interval[vec 0,vec 1]`] THEN + REWRITE_TAC[SEGMENT_1] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[IN_DIFF] THEN MAP_EVERY UNDISCH_TAC + [`(u:real^1) IN interval[vec 0,vec 1]`; + `(v:real^1) IN interval[vec 0,vec 1]`] THEN + REWRITE_TAC[SEGMENT_1] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + ASM_CASES_TAC `segment(x:real^1,y) INTER segment(u,v) = {}` THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(segment(x:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\ + segment(y:real^1,v) SUBSET segment(x,y) DIFF segment(u,v)) \/ + (segment(y:real^1,u) SUBSET segment(x,y) DIFF segment(u,v) /\ + segment(x:real^1,v) SUBSET segment(x,y) DIFF segment(u,v))` + MP_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`~(x IN segment(u:real^1,v))`; `~(y IN segment(u:real^1,v))`; + `~(segment(x:real^1,y) INTER segment (u,v) = {})`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) + [`v:real^1`; `u:real^1`; `y:real^1`; `x:real^1`] THEN + REWRITE_TAC[FORALL_LIFT] THEN + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN + REWRITE_TAC[FORALL_LIFT] THEN + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THENL + [REWRITE_TAC[SEGMENT_SYM] THEN MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP] THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[SEGMENT_1] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[IN_INTERVAL_1; SUBSET; IN_DIFF; AND_FORALL_THM] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(DISJ_CASES_THEN(CONJUNCTS_THEN + (let sl = SET_RULE + `i SUBSET xy DIFF uv + ==> xy INTER (t DIFF uv) = {} ==> i INTER t = {}` in + fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP (MATCH_MP sl th))))) THEN + ASM_MESON_TAC[]]]; + ASM_MESON_TAC[]]; + DISCH_TAC] THEN + SUBGOAL_THEN + `?q:real^1->real^N. + arc q /\ path_image q SUBSET path_image f /\ + a IN path_image q /\ b IN path_image q` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[homeomorphism] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN + REWRITE_TAC[arc; path; path_image] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM MESON_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; path_image] THEN ASM SET_TAC[]; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^1` THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 1:real^1` THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM_MESON_TAC[]]; + SUBGOAL_THEN + `?u v. u IN interval[vec 0,vec 1] /\ a = (q:real^1->real^N) u /\ + v IN interval[vec 0,vec 1] /\ b = (q:real^1->real^N) v` + STRIP_ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `subpath u v (q:real^1->real^N)` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ARC_SIMPLE_PATH_SUBPATH THEN + ASM_MESON_TAC[ARC_IMP_SIMPLE_PATH]; + ASM_MESON_TAC[SUBSET_TRANS; PATH_IMAGE_SUBPATH_SUBSET; ARC_IMP_PATH]; + ASM_MESON_TAC[pathstart; PATHSTART_SUBPATH]; + ASM_MESON_TAC[pathfinish; PATHFINISH_SUBPATH]]]);; + +let PATH_CONNECTED_ARCWISE = prove + (`!s:real^N->bool. + path_connected s <=> + !x y. x IN s /\ y IN s /\ ~(x = y) + ==> ?g. arc g /\ + path_image g SUBSET s /\ + pathstart g = x /\ + pathfinish g = y`, + GEN_TAC THEN REWRITE_TAC[path_connected] THEN EQ_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THENL + [DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g:real^1->real^N`; `x:real^N`; `y:real^N`] + PATH_CONTAINS_ARC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[SUBSET_TRANS]; + ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `linepath(y:real^N,y)` THEN + ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARC_IMP_PATH]]]);; + +let ARC_CONNECTED_TRANS = prove + (`!g h:real^1->real^N. + arc g /\ arc h /\ + pathfinish g = pathstart h /\ ~(pathstart g = pathfinish h) + ==> ?i. arc i /\ + path_image i SUBSET (path_image g UNION path_image h) /\ + pathstart i = pathstart g /\ + pathfinish i = pathfinish h`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g ++ h:real^1->real^N`; `pathstart(g):real^N`; + `pathfinish(h):real^N`] PATH_CONTAINS_ARC) THEN + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATH_JOIN_EQ; ARC_IMP_PATH; + PATH_IMAGE_JOIN]);; + +(* ------------------------------------------------------------------------- *) +(* Local versions of topological properties in general. *) +(* ------------------------------------------------------------------------- *) + +let locally = new_definition + `locally P (s:real^N->bool) <=> + !w x. open_in (subtopology euclidean s) w /\ x IN w + ==> ?u v. open_in (subtopology euclidean s) u /\ P v /\ + x IN u /\ u SUBSET v /\ v SUBSET w`;; + +let LOCALLY_MONO = prove + (`!P Q s. (!t. P t ==> Q t) /\ locally P s ==> locally Q s`, + REWRITE_TAC[locally] THEN MESON_TAC[]);; + +let LOCALLY_OPEN_SUBSET = prove + (`!P s t:real^N->bool. + locally P s /\ open_in (subtopology euclidean s) t + ==> locally P t`, + REPEAT GEN_TAC THEN REWRITE_TAC[locally] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN + ANTS_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_MESON_TAC[open_in; SUBSET]);; + +let LOCALLY_DIFF_CLOSED = prove + (`!P s t:real^N->bool. + locally P s /\ closed_in (subtopology euclidean s) t + ==> locally P (s DIFF t)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN + ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]);; + +let LOCALLY_EMPTY = prove + (`!P. locally P {}`, + REWRITE_TAC[locally] THEN MESON_TAC[open_in; SUBSET; NOT_IN_EMPTY]);; + +let LOCALLY_SING = prove + (`!P a. locally P {a} <=> P {a}`, + REWRITE_TAC[locally; open_in] THEN + REWRITE_TAC[SET_RULE + `(w SUBSET {a} /\ P) /\ x IN w <=> w = {a} /\ x = a /\ P`] THEN + SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2; IN_SING] THEN + REWRITE_TAC[SET_RULE + `(u SUBSET {a} /\ P) /\ Q /\ a IN u /\ u SUBSET v /\ v SUBSET {a} <=> + u = {a} /\ v = {a} /\ P /\ Q`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; IN_SING] THEN + REWRITE_TAC[FORALL_UNWIND_THM2; MESON[REAL_LT_01] `?x. &0 < x`]);; + +let LOCALLY_INTER = prove + (`!P:(real^N->bool)->bool. + (!s t. P s /\ P t ==> P(s INTER t)) + ==> !s t. locally P s /\ locally P t ==> locally P (s INTER t)`, + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[locally; OPEN_IN_OPEN] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; GSYM CONJ_ASSOC; MESON[] + `(!w x. (?t. P t /\ w = f t) /\ Q w x ==> R w x) <=> + (!t x. P t /\ Q (f t) x ==> R (f t) x)`] THEN + ONCE_REWRITE_TAC[MESON[] + `(?a b c. P a b c /\ Q a b c /\ R a b c) <=> + (?b c a. Q a b c /\ P a b c /\ R a b c)`] THEN + REWRITE_TAC[AND_FORALL_THM; UNWIND_THM2; IN_INTER] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `w:real^N->bool` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u1:real^N->bool` (X_CHOOSE_THEN `v1:real^N->bool` + STRIP_ASSUME_TAC)) + (X_CHOOSE_THEN `u2:real^N->bool` (X_CHOOSE_THEN `v2:real^N->bool` + STRIP_ASSUME_TAC))) THEN + EXISTS_TAC `u1 INTER u2:real^N->bool` THEN + EXISTS_TAC `v1 INTER v2:real^N->bool` THEN + ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);; + +let HOMEOMORPHISM_LOCALLY = prove + (`!P Q f:real^N->real^M g. + (!s t. homeomorphism (s,t) (f,g) ==> (P s <=> Q t)) + ==> (!s t. homeomorphism (s,t) (f,g) + ==> (locally P s <=> locally Q t))`, + + let lemma = prove + (`!P Q f g. + (!s t. P s /\ homeomorphism (s,t) (f,g) ==> Q t) + ==> (!s:real^N->bool t:real^M->bool. + locally P s /\ homeomorphism (s,t) (f,g) ==> locally Q t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[locally] THEN STRIP_TAC THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN + MAP_EVERY X_GEN_TAC [`w:real^M->bool`; `y:real^M`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`IMAGE (g:real^M->real^N) w`; `(g:real^M->real^N) y`]) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + SUBGOAL_THEN `IMAGE (g:real^M->real^N) w = + {x | x IN s /\ f(x) IN w}` + SUBST1_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`IMAGE (f:real^N->real^M) u`; `IMAGE (f:real^N->real^M) v`] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `IMAGE (f:real^N->real^M) u = + {x | x IN t /\ g(x) IN u}` + SUBST1_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `v:real^N->bool` THEN + ASM_REWRITE_TAC[homeomorphism] THEN + REWRITE_TAC[homeomorphism] THEN REPEAT CONJ_TAC THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))); + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[open_in]) THEN ASM SET_TAC[]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; + TAUT `p ==> q /\ r ==> s <=> p /\ r ==> q ==> s`] lemma) THEN + ASM_MESON_TAC[HOMEOMORPHISM_SYM]);; + +let HOMEOMORPHIC_LOCALLY = prove + (`!P Q. (!s:real^N->bool t:real^M->bool. s homeomorphic t ==> (P s <=> Q t)) + ==> (!s t. s homeomorphic t ==> (locally P s <=> locally Q t))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[MESON[] + `(!a b c d. P a b c d) <=> (!c d a b. P a b c d)`] THEN + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_LOCALLY THEN + ASM_MESON_TAC[homeomorphic]);; + +let LOCALLY_TRANSLATION = prove + (`!P:(real^N->bool)->bool. + (!a s. P (IMAGE (\x. a + x) s) <=> P s) + ==> (!a s. locally P (IMAGE (\x. a + x) s) <=> locally P s)`, + GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MP_TAC(ISPECL + [`P:(real^N->bool)->bool`; `P:(real^N->bool)->bool`; + `\x:real^N. a + x`; `\x:real^N. --a + x`] + HOMEOMORPHISM_LOCALLY) THEN + REWRITE_TAC[homeomorphism] THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x /\ a + --a + x = x`] THEN + MESON_TAC[]);; + +let LOCALLY_INJECTIVE_LINEAR_IMAGE = prove + (`!P:(real^N->bool)->bool Q:(real^M->bool)->bool. + (!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (P (IMAGE f s) <=> Q s)) + ==> (!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (locally P (IMAGE f s) <=> locally Q s))`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + ASM_CASES_TAC `linear(f:real^M->real^N) /\ (!x y. f x = f y ==> x = y)` THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LINEAR_INJECTIVE_LEFT_INVERSE) THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`Q:(real^M->bool)->bool`; `P:(real^N->bool)->bool`; + `f:real^M->real^N`; `g:real^N->real^M`] + HOMEOMORPHISM_LOCALLY) THEN + ASM_SIMP_TAC[homeomorphism; LINEAR_CONTINUOUS_ON] THEN + ASM_REWRITE_TAC[FORALL_UNWIND_THM1; IMP_CONJ; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN MESON_TAC[]);; + +let LOCALLY_OPEN_MAP_IMAGE = prove + (`!P Q f:real^M->real^N s. + f continuous_on s /\ + (!t. open_in (subtopology euclidean s) t + ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) /\ + (!t. t SUBSET s /\ P t ==> Q(IMAGE f t)) /\ + locally P s + ==> locally Q (IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[locally] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `y:real^N`] THEN + STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + FIRST_ASSUM(MP_TAC o SPEC `w:real^N->bool` o + GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `?x. x IN s /\ (f:real^M->real^N) x = y` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`{x | x IN s /\ (f:real^M->real^N) x IN w}`; `x:real^M`]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`IMAGE (f:real^M->real^N) u`; `IMAGE (f:real^M->real^N) v`] THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Important special cases of local connectedness & path connectedness. *) +(* ------------------------------------------------------------------------- *) + +let LOCALLY_CONNECTED,LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT = + (CONJ_PAIR o prove) + (`(!s:real^N->bool. + locally connected s <=> + !v x. open_in (subtopology euclidean s) v /\ x IN v + ==> ?u. open_in (subtopology euclidean s) u /\ + connected u /\ + x IN u /\ u SUBSET v) /\ + (!s:real^N->bool. + locally connected s <=> + !t x. open_in (subtopology euclidean s) t /\ x IN t + ==> open_in (subtopology euclidean s) + (connected_component t x))`, + REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN + MATCH_MP_TAC(TAUT + `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[SUBSET_REFL]; + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC + THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool` + STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN + EXISTS_TAC `connected_component u (x:real^N)` THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN + ASM_SIMP_TAC[IN; CONNECTED_COMPONENT_REFL]]);; + +let LOCALLY_PATH_CONNECTED,LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT = + (CONJ_PAIR o prove) + (`(!s:real^N->bool. + locally path_connected s <=> + !v x. open_in (subtopology euclidean s) v /\ x IN v + ==> ?u. open_in (subtopology euclidean s) u /\ + path_connected u /\ + x IN u /\ u SUBSET v) /\ + (!s:real^N->bool. + locally path_connected s <=> + !t x. open_in (subtopology euclidean s) t /\ x IN t + ==> open_in (subtopology euclidean s) + (path_component t x))`, + REWRITE_TAC[AND_FORALL_THM; locally] THEN X_GEN_TAC `s:real^N->bool` THEN + MATCH_MP_TAC(TAUT + `(q ==> p) /\ (p ==> r) /\ (r ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[SUBSET_REFL]; + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN ANTS_TAC + THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` (X_CHOOSE_THEN `a:real^N->bool` + STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `a:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN + EXISTS_TAC `path_component u (x:real^N)` THEN + REWRITE_TAC[PATH_COMPONENT_SUBSET; PATH_CONNECTED_PATH_COMPONENT] THEN + ASM_SIMP_TAC[IN; PATH_COMPONENT_REFL]]);; + +let LOCALLY_CONNECTED_OPEN_COMPONENT = prove + (`!s:real^N->bool. + locally connected s <=> + !t c. open_in (subtopology euclidean s) t /\ c IN components t + ==> open_in (subtopology euclidean s) c`, + REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC]);; + +let LOCALLY_CONNECTED_IM_KLEINEN = prove + (`!s:real^N->bool. + locally connected s <=> + !v x. open_in (subtopology euclidean s) v /\ x IN v + ==> ?u. open_in (subtopology euclidean s) u /\ + x IN u /\ u SUBSET v /\ + !y. y IN u + ==> ?c. connected c /\ c SUBSET v /\ x IN c /\ y IN c`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LOCALLY_CONNECTED] THEN MESON_TAC[SUBSET_REFL]; DISCH_TAC] THEN + REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN + ANTS_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(k:real^N->bool) SUBSET c` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC COMPONENTS_MAXIMAL THEN + EXISTS_TAC `u:real^N->bool` THEN ASM SET_TAC[]);; + +let LOCALLY_PATH_CONNECTED_IM_KLEINEN = prove + (`!s:real^N->bool. + locally path_connected s <=> + !v x. open_in (subtopology euclidean s) v /\ x IN v + ==> ?u. open_in (subtopology euclidean s) u /\ + x IN u /\ u SUBSET v /\ + !y. y IN u + ==> ?p. path p /\ path_image p SUBSET v /\ + pathstart p = x /\ pathfinish p = y`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN + REWRITE_TAC[path_connected] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `z:real^N`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `x:real^N`]) THEN + ANTS_TAC THENL [ASM_MESON_TAC[PATH_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(path_image p) SUBSET path_component u (z:real^N)` MP_TAC + THENL [ALL_TAC; ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN + MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN + ASM_SIMP_TAC[PATH_CONNECTED_PATH_IMAGE] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]]);; + +let LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED = prove + (`!s:real^N->bool. locally path_connected s ==> locally connected s`, + MESON_TAC[LOCALLY_MONO; PATH_CONNECTED_IMP_CONNECTED]);; + +let LOCALLY_CONNECTED_COMPONENTS = prove + (`!s c:real^N->bool. + locally connected s /\ c IN components s ==> locally connected c`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);; + +let LOCALLY_CONNECTED_CONNECTED_COMPONENT = prove + (`!s x:real^N. + locally connected s + ==> locally connected (connected_component s x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN + ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN + MATCH_MP_TAC LOCALLY_CONNECTED_COMPONENTS THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; + +let LOCALLY_PATH_CONNECTED_COMPONENTS = prove + (`!s c:real^N->bool. + locally path_connected s /\ c IN components s + ==> locally path_connected c`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] LOCALLY_OPEN_SUBSET)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + GEN_REWRITE_RULE I [LOCALLY_CONNECTED_OPEN_COMPONENT] o + MATCH_MP LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED) THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[OPEN_IN_REFL]);; + +let LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT = prove + (`!s x:real^N. + locally path_connected s + ==> locally path_connected (connected_component s x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN + ASM_REWRITE_TAC[LOCALLY_EMPTY] THEN + MATCH_MP_TAC LOCALLY_PATH_CONNECTED_COMPONENTS THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[IN_COMPONENTS] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; + +let OPEN_IMP_LOCALLY_PATH_CONNECTED = prove + (`!s:real^N->bool. open s ==> locally path_connected s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN + EXISTS_TAC `convex:(real^N->bool)->bool` THEN + REWRITE_TAC[CONVEX_IMP_PATH_CONNECTED] THEN + ASM_SIMP_TAC[locally; OPEN_IN_OPEN_EQ] THEN + ASM_MESON_TAC[OPEN_CONTAINS_BALL; CENTRE_IN_BALL; OPEN_BALL; CONVEX_BALL; + SUBSET]);; + +let OPEN_IMP_LOCALLY_CONNECTED = prove + (`!s:real^N->bool. open s ==> locally connected s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_MONO THEN + EXISTS_TAC `path_connected:(real^N->bool)->bool` THEN + ASM_SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; + PATH_CONNECTED_IMP_CONNECTED]);; + +let LOCALLY_PATH_CONNECTED_UNIV = prove + (`locally path_connected (:real^N)`, + SIMP_TAC[OPEN_IMP_LOCALLY_PATH_CONNECTED; OPEN_UNIV]);; + +let LOCALLY_CONNECTED_UNIV = prove + (`locally connected (:real^N)`, + SIMP_TAC[OPEN_IMP_LOCALLY_CONNECTED; OPEN_UNIV]);; + +let OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED = prove + (`!s x:real^N. + locally connected s + ==> open_in (subtopology euclidean s) (connected_component s x)`, + REWRITE_TAC[LOCALLY_CONNECTED_OPEN_CONNECTED_COMPONENT] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]; + ASM_MESON_TAC[OPEN_IN_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]]);; + +let OPEN_IN_COMPONENTS_LOCALLY_CONNECTED = prove + (`!s c:real^N->bool. + locally connected s /\ c IN components s + ==> open_in (subtopology euclidean s) c`, + MESON_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT; OPEN_IN_REFL]);; + +let OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove + (`!s x:real^N. + locally path_connected s + ==> open_in (subtopology euclidean s) (path_component s x)`, + REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; TOPSPACE_EUCLIDEAN]; + ASM_MESON_TAC[OPEN_IN_EMPTY; PATH_COMPONENT_EQ_EMPTY]]);; + +let CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED = prove + (`!s x:real^N. + locally path_connected s + ==> closed_in (subtopology euclidean s) (path_component s x)`, + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; + PATH_COMPONENT_SUBSET] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEMENT_PATH_COMPONENT_UNIONS] THEN + MATCH_MP_TAC OPEN_IN_UNIONS THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN + ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED]);; + +let CONVEX_IMP_LOCALLY_PATH_CONNECTED = prove + (`!s:real^N->bool. convex s ==> locally path_connected s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED] THEN + MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s INTER ball(x:real^N,e)` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[OPEN_BALL]; + MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_BALL]; + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL]; + ASM SET_TAC[]]);; + +let OPEN_IN_CONNECTED_COMPONENTS = prove + (`!s c:real^N->bool. + FINITE(components s) /\ c IN components s + ==> open_in (subtopology euclidean s) c`, + REWRITE_TAC[components; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT]);; + +let FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS = prove + (`!s:real^N->bool. + compact s /\ locally connected s + ==> FINITE {connected_component s x |x| x IN s}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{connected_component s (x:real^N) |x| x IN s}` o + GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + ASM_SIMP_TAC[OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; FORALL_IN_GSPEC; + UNIONS_CONNECTED_COMPONENT; SUBSET_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN + ASM_CASES_TAC `{connected_component s (x:real^N) |x| x IN s} = cs` THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x:real^N. x IN s /\ ~(connected_component s x IN cs)` + MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ x IN connected_component s y /\ + connected_component s y IN cs` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + ASM_MESON_TAC[]);; + +let FINITE_LOCALLY_PATH_CONNECTED_PATH_COMPONENTS = prove + (`!s:real^N->bool. + compact s /\ locally path_connected s + ==> FINITE {path_component s x |x| x IN s}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{path_component s (x:real^N) |x| x IN s}` o + GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; FORALL_IN_GSPEC; + UNIONS_PATH_COMPONENT; SUBSET_REFL] THEN + DISCH_THEN(X_CHOOSE_THEN `cs:(real^N->bool)->bool` MP_TAC) THEN + ASM_CASES_TAC `{path_component s (x:real^N) |x| x IN s} = cs` THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(TAUT `(p ==> ~r) ==> p /\ q /\ r ==> s`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x:real^N. x IN s /\ ~(path_component s x IN cs)` + MP_TAC THENL [ASM SET_TAC[]; SIMP_TAC[SUBSET; NOT_FORALL_THM]] THEN + + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?y:real^N. y IN s /\ x IN path_component s y /\ + path_component s y IN cs` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PATH_COMPONENT_EQ) THEN + ASM_MESON_TAC[]);; + +let FINITE_COMPONENTS = prove + (`!s:real^N->bool. compact s /\ locally connected s ==> FINITE(components s)`, + REWRITE_TAC[components; FINITE_LOCALLY_CONNECTED_CONNECTED_COMPONENTS]);; + +let CONVEX_IMP_LOCALLY_CONNECTED = prove + (`!s:real^N->bool. convex s ==> locally connected s`, + MESON_TAC[CONVEX_IMP_LOCALLY_PATH_CONNECTED; + LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; + +let HOMEOMORPHIC_LOCAL_CONNECTEDNESS = prove + (`!s t. s homeomorphic t ==> (locally connected s <=> locally connected t)`, + MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN + REWRITE_TAC[HOMEOMORPHIC_CONNECTEDNESS]);; + +let HOMEOMORPHIC_LOCAL_PATH_CONNECTEDNESS = prove + (`!s t. s homeomorphic t + ==> (locally path_connected s <=> locally path_connected t)`, + MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN + REWRITE_TAC[HOMEOMORPHIC_PATH_CONNECTEDNESS]);; + +let LOCALLY_PATH_CONNECTED_TRANSLATION_EQ = prove + (`!a:real^N s. locally path_connected (IMAGE (\x. a + x) s) <=> + locally path_connected s`, + MATCH_MP_TAC LOCALLY_TRANSLATION THEN + REWRITE_TAC[PATH_CONNECTED_TRANSLATION_EQ]);; + +add_translation_invariants [LOCALLY_PATH_CONNECTED_TRANSLATION_EQ];; + +let LOCALLY_CONNECTED_TRANSLATION_EQ = prove + (`!a:real^N s. locally connected (IMAGE (\x. a + x) s) <=> + locally connected s`, + MATCH_MP_TAC LOCALLY_TRANSLATION THEN + REWRITE_TAC[CONNECTED_TRANSLATION_EQ]);; + +add_translation_invariants [LOCALLY_CONNECTED_TRANSLATION_EQ];; + +let LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (locally path_connected (IMAGE f s) <=> locally path_connected s)`, + MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[PATH_CONNECTED_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [LOCALLY_PATH_CONNECTED_LINEAR_IMAGE_EQ];; + +let LOCALLY_CONNECTED_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (locally connected (IMAGE f s) <=> locally connected s)`, + MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[CONNECTED_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [LOCALLY_CONNECTED_LINEAR_IMAGE_EQ];; + +let LOCALLY_CONNECTED_QUOTIENT_IMAGE = prove + (`!f:real^M->real^N s. + (!t. t SUBSET IMAGE f s + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> + open_in (subtopology euclidean (IMAGE f s)) t)) /\ + locally connected s + ==> locally connected (IMAGE f s)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[LOCALLY_CONNECTED_OPEN_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `c:real^N->bool`] THEN + STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC + `connected_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [LOCALLY_CONNECTED_OPEN_COMPONENT]) THEN + REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_COMPONENTS; IN_ELIM_THM] THEN ASM SET_TAC[]; + ALL_TAC; + ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`] + CONNECTED_COMPONENT_SUBSET) THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) (connected_component {w | w IN s /\ f w IN u} x) + SUBSET c` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC COMPONENTS_MAXIMAL THEN EXISTS_TAC `u:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN + CONJ_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in]; + ASM SET_TAC[]]; + ASM SET_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `(f:real^M->real^N) x` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FUN_IN_IMAGE]] THEN + GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM SET_TAC[]);; + +let LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE = prove + (`!f:real^M->real^N s. + (!t. t SUBSET IMAGE f s + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> + open_in (subtopology euclidean (IMAGE f s)) t)) /\ + locally path_connected s + ==> locally path_connected (IMAGE f s)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `y:real^N`] THEN + STRIP_TAC THEN + ASSUME_TAC(ISPECL [`u:real^N->bool`; `y:real^N`] PATH_COMPONENT_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + FIRST_ASSUM(MP_TAC o SPEC `path_component u (y:real^N)`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC + `path_component {w | w IN s /\ (f:real^M->real^N)(w) IN u} x` THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [LOCALLY_PATH_CONNECTED_OPEN_PATH_COMPONENT]) THEN + REWRITE_TAC[IMP_CONJ_ALT] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]; + ALL_TAC; + ASSUME_TAC(ISPECL [`{w | w IN s /\ (f:real^M->real^N) w IN u}`; `x:real^M`] + PATH_COMPONENT_SUBSET) THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) (path_component {w | w IN s /\ f w IN u} x) + SUBSET path_component u y` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP PATH_COMPONENT_EQ) THEN + MATCH_MP_TAC PATH_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FUN_IN_IMAGE; + MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN + REWRITE_TAC[PATH_CONNECTED_PATH_COMPONENT] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN + CONJ_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN ASM_MESON_TAC[open_in]; + ASM SET_TAC[]]; + ASM SET_TAC[]]] THEN + GEN_REWRITE_TAC I [IN] THEN REWRITE_TAC[PATH_COMPONENT_REFL_EQ] THEN + ASM SET_TAC[]);; + +let LOCALLY_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove + (`!f:real^M->real^N s. + locally connected s /\ compact s /\ f continuous_on s + ==> locally connected (IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_CONNECTED_QUOTIENT_IMAGE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; + COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; + CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; + +let LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT = prove + (`!f:real^M->real^N s. + locally path_connected s /\ compact s /\ f continuous_on s + ==> locally path_connected (IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED; + COMPACT_CONTINUOUS_IMAGE; IMAGE_SUBSET] THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED; COMPACT_CONTINUOUS_IMAGE; + CONTINUOUS_ON_SUBSET; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; + +let LOCALLY_PATH_CONNECTED_PATH_IMAGE = prove + (`!p:real^1->real^N. path p ==> locally path_connected (path_image p)`, + REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LOCALLY_PATH_CONNECTED_CONTINUOUS_IMAGE_COMPACT THEN + ASM_SIMP_TAC[COMPACT_INTERVAL; CONVEX_INTERVAL; + CONVEX_IMP_LOCALLY_PATH_CONNECTED]);; + +let LOCALLY_CONNECTED_PATH_IMAGE = prove + (`!p:real^1->real^N. path p ==> locally connected (path_image p)`, + SIMP_TAC[LOCALLY_PATH_CONNECTED_PATH_IMAGE; + LOCALLY_PATH_CONNECTED_IMP_LOCALLY_CONNECTED]);; + +let LOCALLY_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + (!x. x IN s ==> g(f x) = x) /\ + locally connected s + ==> locally connected (IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN + MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);; + +let LOCALLY_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\ + locally connected s + ==> locally connected (IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LOCALLY_CONNECTED_QUOTIENT_IMAGE) THEN + MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);; + +let LOCALLY_PATH_CONNECTED_LEFT_INVERTIBLE_IMAGE = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + (!x. x IN s ==> g(f x) = x) /\ + locally path_connected s + ==> locally path_connected (IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN + MATCH_MP_TAC CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP THEN ASM_MESON_TAC[]);; + +let LOCALLY_PATH_CONNECTED_RIGHT_INVERTIBLE_IMAGE = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + IMAGE g (IMAGE f s) SUBSET s /\ (!x. x IN IMAGE f s ==> f(g x) = x) /\ + locally path_connected s + ==> locally path_connected (IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + LOCALLY_PATH_CONNECTED_QUOTIENT_IMAGE) THEN + MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `g:real^N->real^M` THEN ASM SET_TAC[]);; + +let LOCALLY_PCROSS = prove + (`!P Q R. + (!s:real^M->bool t:real^N->bool. P s /\ Q t ==> R(s PCROSS t)) + ==> (!s t. locally P s /\ locally Q t ==> locally R (s PCROSS t))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[locally; FORALL_PASTECART] THEN + MAP_EVERY X_GEN_TAC + [`w:real^(M,N)finite_sum->bool`; `x:real^M`; `y:real^N`] THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN + MP_TAC(MATCH_MP PASTECART_IN_INTERIOR_SUBTOPOLOGY + (ONCE_REWRITE_RULE[CONJ_SYM] th))) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `x:real^M`] o + GEN_REWRITE_RULE I [locally]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`v:real^N->bool`; `y:real^N`] o + GEN_REWRITE_RULE I [locally]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`v':real^N->bool`; `v'':real^N->bool`] THEN + STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`u':real^M->bool`; `u'':real^M->bool`] THEN + STRIP_TAC THEN + EXISTS_TAC `(u':real^M->bool) PCROSS (v':real^N->bool)` THEN + EXISTS_TAC `(u'':real^M->bool) PCROSS (v'':real^N->bool)` THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS; PCROSS_MONO; OPEN_IN_PCROSS] THEN + ASM_MESON_TAC[PCROSS_MONO; SUBSET_TRANS]);; + +let LOCALLY_CONNECTED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + locally connected s /\ locally connected t + ==> locally connected (s PCROSS t)`, + MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[CONNECTED_PCROSS]);; + +let LOCALLY_PATH_CONNECTED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + locally path_connected s /\ locally path_connected t + ==> locally path_connected (s PCROSS t)`, + MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[PATH_CONNECTED_PCROSS]);; + +let LOCALLY_CONNECTED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + locally connected (s PCROSS t) <=> + s = {} \/ t = {} \/ locally connected s /\ locally connected t`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[LOCALLY_CONNECTED_PCROSS] THEN + GEN_REWRITE_TAC LAND_CONV [LOCALLY_CONNECTED] THEN DISCH_TAC THEN + REWRITE_TAC[LOCALLY_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN + UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(u:real^M->bool) PCROSS (t:real^N->bool)`; + `pastecart (x:real^M) (y:real^N)`]); + MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN + UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(s:real^M->bool) PCROSS (v:real^N->bool)`; + `pastecart (x:real^M) (y:real^N)`])] THEN + ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV; + OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`; + `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN + EXISTS_TAC `IMAGE fstcart (w:real^(M,N)finite_sum->bool)` THEN + ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_FSTCART] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]]; + DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `IMAGE sndcart (w:real^(M,N)finite_sum->bool)` THEN + ASM_SIMP_TAC[CONNECTED_LINEAR_IMAGE; LINEAR_SNDCART] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]]] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN + ASM SET_TAC[]);; + +let LOCALLY_PATH_CONNECTED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + locally path_connected (s PCROSS t) <=> + s = {} \/ t = {} \/ + locally path_connected s /\ locally path_connected t`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; LOCALLY_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[LOCALLY_PATH_CONNECTED_PCROSS] THEN + GEN_REWRITE_TAC LAND_CONV [LOCALLY_PATH_CONNECTED] THEN DISCH_TAC THEN + REWRITE_TAC[LOCALLY_PATH_CONNECTED_IM_KLEINEN] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN + UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(u:real^M->bool) PCROSS (t:real^N->bool)`; + `pastecart (x:real^M) (y:real^N)`]); + MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `y:real^N`] THEN STRIP_TAC THEN + UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(s:real^M->bool) PCROSS (v:real^N->bool)`; + `pastecart (x:real^M) (y:real^N)`])] THEN + ASM_SIMP_TAC[OPEN_IN_PCROSS_EQ; PASTECART_IN_PCROSS; SUBSET_UNIV; + OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `w:real^(M,N)finite_sum->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `t:real^N->bool`; `w:real^(M,N)finite_sum->bool`; + `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u':real^M->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `w:real^(M,N)finite_sum->bool`] + PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_FSTCART] THEN + REWRITE_TAC[path_connected] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `z:real^M`]) THEN ANTS_TAC THENL + [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART]; + MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; FSTCART_PASTECART] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]; + DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `v':real^N->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `w:real^(M,N)finite_sum->bool`] + PATH_CONNECTED_LINEAR_IMAGE) THEN ASM_REWRITE_TAC[LINEAR_SNDCART] THEN + REWRITE_TAC[path_connected] THEN + DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN ANTS_TAC THENL + [REWRITE_TAC[IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART]; + MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PASTECART; SNDCART_PASTECART] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [SUBSET; FORALL_IN_PCROSS; PASTECART_IN_PCROSS; FORALL_PASTECART]) THEN + ASM SET_TAC[]);; + +let CARD_EQ_OPEN_IN = prove + (`!u s:real^N->bool. + locally connected u /\ + open_in (subtopology euclidean u) s /\ + (?x. x IN s /\ x limit_point_of u) + ==> s =_c (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_EUCLIDEAN] THEN + MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[IN_INTER] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_CONNECTED]) THEN + DISCH_THEN(MP_TAC o SPECL [`u INTER t:real^N->bool`; `x:real^N`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; IN_INTER] THEN + REWRITE_TAC[OPEN_IN_OPEN; GSYM CONJ_ASSOC; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[UNWIND_THM2; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [limit_point_of]) THEN + DISCH_THEN(MP_TAC o SPEC `t INTER v:real^N->bool`) THEN + ASM_SIMP_TAC[IN_INTER; OPEN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + TRANS_TAC CARD_LE_TRANS `u INTER v:real^N->bool` THEN + ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONNECTED THEN + ASM SET_TAC[]);; + +let CARD_EQ_OPEN_IN_AFFINE = prove + (`!u s:real^N->bool. + affine u /\ ~(aff_dim u = &0) /\ + open_in (subtopology euclidean u) s /\ ~(s = {}) + ==> s =_c (:real)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_EQ_OPEN_IN THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[CONVEX_IMP_LOCALLY_CONNECTED; AFFINE_IMP_CONVEX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX; CONVEX_CONNECTED] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Locally convex sets. *) +(* ------------------------------------------------------------------------- *) + +let LOCALLY_CONVEX = prove + (`!s:real^N->bool. + locally convex s <=> + !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\ + open_in (subtopology euclidean s) u /\ + convex v`, + GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN + MESON_TAC[SUBSET_INTER]; + MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN + REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN + EXISTS_TAC `cball(x:real^N,e) INTER v` THEN + ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL; + CONVEX_INTER; CONVEX_CBALL; IN_INTER] THEN + MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of local compactness. *) +(* ------------------------------------------------------------------------- *) + +let LOCALLY_COMPACT = prove + (`!s:real^N->bool. + locally compact s <=> + !x. x IN s ==> ?u v. x IN u /\ u SUBSET v /\ v SUBSET s /\ + open_in (subtopology euclidean s) u /\ + compact v`, + GEN_TAC THEN REWRITE_TAC[locally] THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`s INTER ball(x:real^N,&1)`; `x:real^N`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN + MESON_TAC[SUBSET_INTER]; + MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN + REWRITE_TAC[IMP_CONJ] THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(s INTER ball(x:real^N,e)) INTER u` THEN + EXISTS_TAC `cball(x:real^N,e) INTER v` THEN + ASM_SIMP_TAC[OPEN_IN_INTER; OPEN_IN_OPEN_INTER; OPEN_BALL; CENTRE_IN_BALL; + COMPACT_INTER; COMPACT_CBALL; IN_INTER] THEN + MP_TAC(ISPECL [`x:real^N`; `e:real`] BALL_SUBSET_CBALL) THEN + ASM SET_TAC[]]);; + +let LOCALLY_COMPACT_ALT = prove + (`!s:real^N->bool. + locally compact s <=> + !x. x IN s + ==> ?u. x IN u /\ + open_in (subtopology euclidean s) u /\ + compact(closure u) /\ closure u SUBSET s`, + GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN + MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL; + COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; + +let LOCALLY_COMPACT_INTER_CBALL = prove + (`!s:real^N->bool. + locally compact s <=> + !x. x IN s ==> ?e. &0 < e /\ closed(cball(x,e) INTER s)`, + GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT; OPEN_IN_CONTAINS_CBALL] THEN + EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_SIMP_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `cball(x:real^N,e) INTER s = cball (x,e) INTER v` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[COMPACT_CBALL; COMPACT_INTER; COMPACT_IMP_CLOSED]; + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + EXISTS_TAC `ball(x:real^N,e) INTER s` THEN + EXISTS_TAC `cball(x:real^N,e) INTER s` THEN + REWRITE_TAC[GSYM OPEN_IN_CONTAINS_CBALL] THEN + ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET] THEN + ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; BOUNDED_CBALL] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + MESON_TAC[SUBSET; IN_INTER; BALL_SUBSET_CBALL]]);; + +let LOCALLY_COMPACT_INTER_CBALLS = prove + (`!s:real^N->bool. + locally compact s <=> + !x. x IN s ==> ?e. &0 < e /\ !d. d <= e ==> closed(cball(x,d) INTER s)`, + GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `cball(x:real^N,d) INTER s = cball(x,d) INTER cball(x,e) INTER s` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM INTER_ASSOC; GSYM CBALL_MIN_INTER] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + BINOP_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_CBALL]]);; + +let LOCALLY_COMPACT_COMPACT = prove + (`!s:real^N->bool. + locally compact s <=> + !k. k SUBSET s /\ compact k + ==> ?u v. k SUBSET u /\ + u SUBSET v /\ + v SUBSET s /\ + open_in (subtopology euclidean s) u /\ + + compact v`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LOCALLY_COMPACT] THEN EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SING_SUBSET; COMPACT_SING]] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[RIGHT_IMP_EXISTS_THM] o + check (is_forall o concl)) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. k INTER u x) k`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_INTER THEN REWRITE_TAC[OPEN_IN_REFL] THEN + ASM SET_TAC[]; + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `UNIONS(IMAGE (u:real^N->real^N->bool) t)` THEN + EXISTS_TAC `UNIONS(IMAGE (v:real^N->real^N->bool) t)` THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; ALL_TAC; ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS; + MATCH_MP_TAC COMPACT_UNIONS THEN ASM_SIMP_TAC[FINITE_IMAGE]] THEN + ASM SET_TAC[]]);; + +let LOCALLY_COMPACT_COMPACT_ALT = prove + (`!s:real^N->bool. + locally compact s <=> + !k. k SUBSET s /\ compact k + ==> ?u. k SUBSET u /\ + open_in (subtopology euclidean s) u /\ + compact(closure u) /\ closure u SUBSET s`, + GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN + MESON_TAC[CLOSURE_SUBSET; SUBSET_TRANS; CLOSURE_MINIMAL; + COMPACT_CLOSURE; BOUNDED_SUBSET; COMPACT_EQ_BOUNDED_CLOSED]);; + +let LOCALLY_COMPACT_COMPACT_SUBOPEN = prove + (`!s:real^N->bool. + locally compact s <=> + !k t. k SUBSET s /\ compact k /\ open t /\ k SUBSET t + ==> ?u v. k SUBSET u /\ u SUBSET v /\ u SUBSET t /\ v SUBSET s /\ + open_in (subtopology euclidean s) u /\ + compact v`, + GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_COMPACT] THEN + EQ_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `k:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`u INTER t:real^N->bool`; `closure(u INTER t:real^N->bool)`] THEN + REWRITE_TAC[CLOSURE_SUBSET; INTER_SUBSET] THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + TRANS_TAC SUBSET_TRANS `closure(u:real^N->bool)` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + TRANS_TAC SUBSET_TRANS `v:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; + ASM_SIMP_TAC[OPEN_IN_INTER_OPEN]; + REWRITE_TAC[COMPACT_CLOSURE] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET; SUBSET_TRANS; + COMPACT_IMP_BOUNDED]]; + FIRST_X_ASSUM(MP_TAC o SPECL [`k:real^N->bool`; `(:real^N)`]) THEN + ASM_REWRITE_TAC[OPEN_UNIV; SUBSET_UNIV]]);; + +let OPEN_IMP_LOCALLY_COMPACT = prove + (`!s:real^N->bool. open s ==> locally compact s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`ball(x:real^N,e)`; `cball(x:real^N,e)`] THEN + ASM_REWRITE_TAC[BALL_SUBSET_CBALL; CENTRE_IN_BALL; COMPACT_CBALL] THEN + MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN ASM_REWRITE_TAC[OPEN_BALL] THEN + ASM_MESON_TAC[BALL_SUBSET_CBALL; SUBSET_TRANS]);; + +let CLOSED_IMP_LOCALLY_COMPACT = prove + (`!s:real^N->bool. closed s ==> locally compact s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC + [`s INTER ball(x:real^N,&1)`; `s INTER cball(x:real^N,&1)`] THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; INTER_SUBSET; REAL_LT_01] THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN + MP_TAC(ISPECL [`x:real^N`; `&1`] BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);; + +let IS_INTERVAL_IMP_LOCALLY_COMPACT = prove + (`!s:real^N->bool. is_interval s ==> locally compact s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] + INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `d:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`s INTER ball(x:real^N,d)`; `interval[a:real^N,b]`] THEN + ASM_SIMP_TAC[COMPACT_INTERVAL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; IN_INTER] THEN ASM SET_TAC[]);; + +let LOCALLY_COMPACT_UNIV = prove + (`locally compact (:real^N)`, + SIMP_TAC[OPEN_IMP_LOCALLY_COMPACT; OPEN_UNIV]);; + +let LOCALLY_COMPACT_INTER = prove + (`!s t:real^N->bool. + locally compact s /\ locally compact t + ==> locally compact (s INTER t)`, + MATCH_MP_TAC LOCALLY_INTER THEN REWRITE_TAC[COMPACT_INTER]);; + +let LOCALLY_COMPACT_OPEN_IN = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean s) t /\ locally compact s + ==> locally compact t`, + REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; OPEN_IMP_LOCALLY_COMPACT]);; + +let LOCALLY_COMPACT_CLOSED_IN = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean s) t /\ locally compact s + ==> locally compact t`, + REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LOCALLY_COMPACT_INTER; CLOSED_IMP_LOCALLY_COMPACT]);; + +let LOCALLY_COMPACT_DELETE = prove + (`!s a:real^N. locally compact s ==> locally compact (s DELETE a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LOCALLY_COMPACT_OPEN_IN THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[OPEN_IN_DELETE; OPEN_IN_REFL]);; + +let SIGMA_COMPACT = prove + (`!s:real^N->bool. + locally compact s + ==> ?f. COUNTABLE f /\ (!t. t IN f ==> compact t) /\ UNIONS f = s`, + GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `c:real^N->real^N->bool`] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`IMAGE (u:real^N->real^N->bool) s`; `s:real^N->bool`] + LINDELOF_OPEN_IN) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (c:real^N->real^N->bool) t` THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; FORALL_IN_IMAGE; FORALL_IN_UNIONS] THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN ASM SET_TAC[]);; + +let HOMEOMORPHIC_LOCAL_COMPACTNESS = prove + (`!s t:real^N->bool. + s homeomorphic t ==> (locally compact s <=> locally compact t)`, + MATCH_MP_TAC HOMEOMORPHIC_LOCALLY THEN + REWRITE_TAC[HOMEOMORPHIC_COMPACTNESS]);; + +let LOCALLY_COMPACT_TRANSLATION_EQ = prove + (`!a:real^N s. locally compact (IMAGE (\x. a + x) s) <=> + locally compact s`, + MATCH_MP_TAC LOCALLY_TRANSLATION THEN + REWRITE_TAC[COMPACT_TRANSLATION_EQ]);; + +add_translation_invariants [LOCALLY_COMPACT_TRANSLATION_EQ];; + +let LOCALLY_COMPACT_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (locally compact (IMAGE f s) <=> locally compact s)`, + MATCH_MP_TAC LOCALLY_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[COMPACT_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [LOCALLY_COMPACT_LINEAR_IMAGE_EQ];; + +let LOCALLY_CLOSED = prove + (`!s:real^N->bool. locally closed s <=> locally compact s`, + GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[LOCALLY_MONO; COMPACT_IMP_CLOSED]] THEN + REWRITE_TAC[locally] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`w:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^N->bool`; `x:real^N`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + EXISTS_TAC `u INTER ball(x:real^N,&1)` THEN + EXISTS_TAC `v INTER cball(x:real^N,&1)` THEN + ASM_SIMP_TAC[OPEN_IN_INTER_OPEN; OPEN_BALL] THEN + ASM_SIMP_TAC[CLOSED_INTER_COMPACT; COMPACT_CBALL] THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_LT_01] THEN + MP_TAC(ISPEC `x:real^N` BALL_SUBSET_CBALL) THEN ASM SET_TAC[]);; + +let LOCALLY_COMPACT_OPEN_UNION = prove + (`!s t:real^N->bool. + locally compact s /\ locally compact t /\ + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t + ==> locally compact (s UNION t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN + INTRO_TAC "lcs lct os ot" THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL + [REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN + REMOVE_THEN "os" + (MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]); + REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN + REMOVE_THEN "ot" + (MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL])] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + REWRITE_TAC[CBALL_MIN_INTER; INTER_ASSOC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `u INTER st SUBSET s ==> s SUBSET st ==> u INTER st = u INTER s`)) THEN + REWRITE_TAC[SUBSET_UNION] THEN DISCH_THEN SUBST1_TAC THEN + ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL; INTER_ACI]);; + +let LOCALLY_COMPACT_CLOSED_UNION = prove + (`!s t:real^N->bool. + locally compact s /\ locally compact t /\ + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t + ==> locally compact (s UNION t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LOCALLY_COMPACT_INTER_CBALL; IN_UNION] THEN + INTRO_TAC "lcs lct cs ct" THEN X_GEN_TAC `x:real^N` THEN + DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (TAUT + `p \/ q ==> p /\ q \/ p /\ ~q \/ q /\ ~p`)) + THENL + [REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN + REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + SIMP_TAC[SET_RULE `u INTER (s UNION t) = u INTER s UNION u INTER t`] THEN + MATCH_MP_TAC CLOSED_UNION THEN REWRITE_TAC[CBALL_MIN_INTER] THEN + ASM_MESON_TAC[CLOSED_CBALL; CLOSED_INTER; INTER_ACI]; + REMOVE_THEN "lcs" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "ct" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in]); + REMOVE_THEN "lct" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "cs" (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [closed_in])] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_CBALL]) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; IN_DIFF; IN_UNION] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d e:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THENL + [SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) = + cball(x,d) INTER cball (x,e) INTER s` SUBST1_TAC + THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]; + SUBGOAL_THEN `cball (x:real^N,min d e) INTER (s UNION t) = + cball(x,d) INTER cball (x,e) INTER t` SUBST1_TAC + THENL [REWRITE_TAC[CBALL_MIN_INTER] THEN ASM SET_TAC[]; ALL_TAC]] THEN + ASM_MESON_TAC[CLOSED_INTER; CLOSED_CBALL]);; + +let LOCALLY_COMPACT_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + locally compact s /\ locally compact t + ==> locally compact (s PCROSS t)`, + MATCH_MP_TAC LOCALLY_PCROSS THEN REWRITE_TAC[COMPACT_PCROSS]);; + +let LOCALLY_COMPACT_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + locally compact (s PCROSS t) <=> + s = {} \/ t = {} \/ locally compact s /\ locally compact t`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; PCROSS_EMPTY; LOCALLY_EMPTY] THEN + MATCH_MP_TAC(TAUT `(~p ==> s) /\ (~q ==> r) ==> p \/ q \/ r /\ s`) THEN + CONJ_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THENL + [X_GEN_TAC `a:real^M`; X_GEN_TAC `b:real^N`] THEN + DISCH_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LOCALLY_COMPACT_INTER)) + THENL + [DISCH_THEN(MP_TAC o SPEC `{a:real^M} PCROSS (:real^N)`); + DISCH_THEN(MP_TAC o SPEC `(:real^M) PCROSS {b:real^N}`)] THEN + ASM_SIMP_TAC[LOCALLY_COMPACT_PCROSS; CLOSED_IMP_LOCALLY_COMPACT; + CLOSED_UNIV; CLOSED_SING; INTER_PCROSS; INTER_UNIV; + SET_RULE `a IN s ==> s INTER {a} = {a}`] THEN + ASM_MESON_TAC[HOMEOMORPHIC_PCROSS_SING; HOMEOMORPHIC_LOCAL_COMPACTNESS]);; + +let OPEN_IN_LOCALLY_COMPACT = prove + (`!s t:real^N->bool. + locally compact s + ==> (open_in (subtopology euclidean s) t <=> + t SUBSET s /\ + !k. compact k /\ k SUBSET s + ==> open_in (subtopology euclidean k) (k INTER t))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN EXISTS_TAC `t INTER u:real^N->bool` THEN + ASM_REWRITE_TAC[IN_INTER; INTER_SUBSET] THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `closure u:real^N->bool`) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `(closure u:real^N->bool) SUBSET v` MP_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; + REWRITE_TAC[COMPACT_CLOSURE] THEN + ASM_MESON_TAC[SUBSET_TRANS; BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]]; + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN + MP_TAC(ISPEC `u:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]]]);; + +let LOCALLY_COMPACT_PROPER_IMAGE_EQ = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!k. k SUBSET (IMAGE f s) /\ compact k + ==> compact {x | x IN s /\ f x IN k}) + ==> (locally compact s <=> locally compact (IMAGE f s))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; + `IMAGE (f:real^M->real^N) s`] PROPER_MAP) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN X_GEN_TAC `y:real^N` THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_ALT]) THEN + DISCH_THEN(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}`) THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?v. open_in (subtopology euclidean (IMAGE f s)) v /\ + y IN v /\ + {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET u` + MP_TAC THENL + [GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o LAND_CONV) + [GSYM SING_SUBSET] THEN + MATCH_MP_TAC CLOSED_MAP_OPEN_SUPERSET_PREIMAGE THEN + ASM_REWRITE_TAC[SING_SUBSET; IN_SING]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `closure v SUBSET IMAGE (f:real^M->real^N) (closure u)` + ASSUME_TAC THENL + [TRANS_TAC SUBSET_TRANS `closure(IMAGE (f:real^M->real^N) u)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_CLOSURE THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]; + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + BOUNDED_SUBSET)) THEN + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]]; + REWRITE_TAC[LOCALLY_COMPACT_ALT] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_ALT]) THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ASM_SIMP_TAC[FUN_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `closure v:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN v}` THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + ASM_MESON_TAC[SUBSET_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `closure {x | x IN s /\ f x IN v} SUBSET + {x | x IN s /\ (f:real^M->real^N) x IN closure v}` + ASSUME_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN + MP_TAC(ISPEC `v:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN + ASM_MESON_TAC[COMPACT_IMP_BOUNDED; BOUNDED_SUBSET]]]);; + +let LOCALLY_COMPACT_PROPER_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!k. k SUBSET (IMAGE f s) /\ compact k + ==> compact {x | x IN s /\ f x IN k}) /\ + locally compact s + ==> locally compact (IMAGE f s)`, + MESON_TAC[LOCALLY_COMPACT_PROPER_IMAGE_EQ]);; + +let MUMFORD_LEMMA = prove + (`!f:real^M->real^N s t y. + f continuous_on s /\ IMAGE f s SUBSET t /\ locally compact s /\ + y IN t /\ compact {x | x IN s /\ f x = y} + ==> ?u v. open_in (subtopology euclidean s) u /\ + open_in (subtopology euclidean t) v /\ + {x | x IN s /\ f x = y} SUBSET u /\ y IN v /\ + IMAGE f u SUBSET v /\ + (!k. k SUBSET v /\ compact k + ==> compact {x | x IN u /\ f x IN k})`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `{x | x IN s /\ (f:real^M->real^N) x = y}` o + GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT]) THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(closure u:real^M->bool) SUBSET v` ASSUME_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]; + ALL_TAC] THEN + SUBGOAL_THEN `compact(closure u:real^M->bool)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `!b. open_in (subtopology euclidean t) b /\ y IN b + ==> u INTER {x | x IN s /\ (f:real^M->real^N) x IN b} PSUBSET + closure u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}` + MP_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET] THEN + SIMP_TAC[CLOSURE_SUBSET; + SET_RULE `s SUBSET t ==> s INTER u SUBSET t INTER u`] THEN + MATCH_MP_TAC(MESON[] `!P. ~P s /\ P t ==> ~(s = t)`) THEN + EXISTS_TAC + `\a. !k. k SUBSET b /\ compact k + ==> compact {x | x IN a /\ (f:real^M->real^N) x IN k}` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL + [`u INTER {x | x IN s /\ (f:real^M->real^N) x IN b}`; + `b:real^N->bool`]) THEN + ASM_REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`] THEN ANTS_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN ASM SET_TAC[]; + ASM SET_TAC[]]; + X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN closure u INTER {x | x IN s /\ f x IN b} /\ f x IN k} = + v INTER {x | x IN closure u /\ (f:real^M->real^N) x IN k}` + SUBST1_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_INTER_CLOSED] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_CLOSURE] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]]; + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC + `t INTER ball(y:real^N,inv(&n + &1))`) THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; IN_INTER; CENTRE_IN_BALL] THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + SIMP_TAC[CLOSURE_SUBSET; SET_RULE + `u SUBSET u' + ==> (u INTER t PSUBSET u' INTER t <=> + ?x. x IN u' /\ ~(x IN u) /\ x IN t)`] THEN + REWRITE_TAC[SKOLEM_THM; IN_ELIM_THM; IN_BALL; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `closure u:real^M->bool` compact) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:num->real^M`) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`l:real^M`; `r:num->num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N) l = y` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `(f:real^M->real^N) o x o (r:num->num)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(f:real^M->real^N) continuous_on closure u` MP_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[o_THM]; + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN + ASM_REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + TRANS_TAC REAL_LT_TRANS `inv(&n + &1)` THEN ASM_REWRITE_TAC[] THEN + TRANS_TAC REAL_LT_TRANS `inv(&N)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `l:real^M`)) THEN + REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `e:real` THEN STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + ASM_REWRITE_TAC[LE_REFL; o_THM] THEN ASM SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Locally compact sets are closed in an open set and are homeomorphic *) +(* to an absolutely closed set if we have one more dimension to play with. *) +(* ------------------------------------------------------------------------- *) + +let LOCALLY_COMPACT_OPEN_INTER_CLOSURE = prove + (`!s:real^N->bool. locally compact s ==> ?t. open t /\ s = t INTER closure s`, + GEN_TAC THEN SIMP_TAC[LOCALLY_COMPACT; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; TAUT `p /\ x = y /\ q <=> x = y /\ p /\ q`] THEN + ONCE_REWRITE_TAC[MESON[] `(?a b c. P a b c) <=> (?c b a. P a b c)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->real^N->bool`; `v:real^N->real^N->bool`] THEN + DISCH_TAC THEN EXISTS_TAC `UNIONS (IMAGE (u:real^N->real^N->bool) s)` THEN + ASM_SIMP_TAC[CLOSED_CLOSURE; OPEN_UNIONS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `UNIONS {v INTER s | v | v IN IMAGE (u:real^N->real^N->bool) s}` THEN + CONJ_TAC THENL + [SIMP_TAC[UNIONS_GSPEC; EXISTS_IN_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN + AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f(g x) = f'(g x)) + ==> {f x | x IN IMAGE g s} = {f' x | x IN IMAGE g s}`) THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET_INTER; INTER_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `closure((u:real^N->real^N->bool) x INTER s)` THEN + ASM_SIMP_TAC[OPEN_INTER_CLOSURE_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `(v:real^N->real^N->bool) x` THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN ASM SET_TAC[]]);; + +let LOCALLY_COMPACT_CLOSED_IN_OPEN = prove + (`!s:real^N->bool. + locally compact s ==> ?t. open t /\ closed_in (subtopology euclidean t) s`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]);; + +let LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED = prove + (`!s:real^M->bool. + locally compact s + ==> ?t:real^(M,N)finite_sum->bool f. + closed t /\ homeomorphism (s,t) (f,fstcart)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `closed(s:real^M->bool)` THENL + [EXISTS_TAC `(s:real^M->bool) PCROSS {vec 0:real^N}` THEN + EXISTS_TAC `\x. (pastecart x (vec 0):real^(M,N)finite_sum)` THEN + ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_SING; HOMEOMORPHISM] THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; + LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN + SIMP_TAC[FSTCART_PASTECART]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LOCALLY_COMPACT_OPEN_INTER_CLOSURE) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + DISJ_CASES_TAC(SET_RULE `t = (:real^M) \/ ~((:real^M) DIFF t = {})`) THENL + [ASM_MESON_TAC[CLOSURE_EQ; INTER_UNIV]; ALL_TAC] THEN + ABBREV_TAC + `f:real^M->real^(M,N)finite_sum = + \x. pastecart x (inv(setdist({x},(:real^M) DIFF t)) % vec 1)` THEN + SUBGOAL_THEN + `homeomorphism (t,IMAGE (f:real^M->real^(M,N)finite_sum) t) (f,fstcart)` + ASSUME_TAC THENL + [SIMP_TAC[HOMEOMORPHISM; SUBSET_REFL; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(TAUT `(r ==> q /\ s) /\ r /\ p ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL [SET_TAC[]; EXPAND_TAC "f"] THEN + SIMP_TAC[FSTCART_PASTECART] THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + REWRITE_TAC[CONTINUOUS_ON_ID] THEN MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + REWRITE_TAC[SETDIST_EQ_0_SING; CONTINUOUS_ON_LIFT_SETDIST] THEN + ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN]; + ALL_TAC] THEN + EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) s` THEN + EXISTS_TAC `f:real^M->real^(M,N)finite_sum` THEN CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^(M,N)finite_sum) t` THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN MAP_EVERY EXISTS_TAC + [`fstcart:real^(M,N)finite_sum->real^M`; `t:real^M->bool`] THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "s" THEN + SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE]; + SUBGOAL_THEN + `IMAGE (f:real^M->real^(M,N)finite_sum) t = + {z | (setdist({fstcart z},(:real^M) DIFF t) % sndcart z) IN {vec 1}}` + SUBST1_TAC THENL + [EXPAND_TAC "f" THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_INJ; + FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE; IN_INTER; + GSYM CONJ_ASSOC; UNWIND_THM1; IN_SING] THEN + REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; VEC_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN + MP_TAC(ISPECL [`(:real^M) DIFF t`; `x:real^M`] + (CONJUNCT1 SETDIST_EQ_0_SING)) THEN + ASM_SIMP_TAC[CLOSURE_COMPLEMENT; IN_DIFF; IN_UNIV; INTERIOR_OPEN] THEN + ASM_CASES_TAC `(x:real^M) IN t` THEN ASM_SIMP_TAC[REAL_FIELD + `~(x = &0) ==> (y = inv x * &1 <=> x * y = &1)`] THEN + DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING] THEN X_GEN_TAC `z:real^(M,N)finite_sum` THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_SNDCART; o_DEF] THEN + SUBGOAL_THEN + `(\z:real^(M,N)finite_sum. + lift(setdist({fstcart z},(:real^M) DIFF t))) = + (\x. lift (setdist ({x},(:real^M) DIFF t))) o fstcart` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART] THEN + REWRITE_TAC[CONTINUOUS_AT_LIFT_SETDIST]]]; + MATCH_MP_TAC HOMEOMORPHISM_OF_SUBSETS THEN MAP_EVERY EXISTS_TAC + [`t:real^M->bool`; `IMAGE (f:real^M->real^(M,N)finite_sum) t`] THEN + ASM SET_TAC[]]);; + +let LOCALLY_COMPACT_CLOSED_INTER_OPEN = prove + (`!s:real^N->bool. + locally compact s <=> ?t u. closed t /\ open u /\ s = t INTER u`, + MESON_TAC[CLOSED_IMP_LOCALLY_COMPACT; OPEN_IMP_LOCALLY_COMPACT; + LOCALLY_COMPACT_INTER; INTER_COMM; CLOSED_CLOSURE; + LOCALLY_COMPACT_OPEN_INTER_CLOSURE]);; + +(* ------------------------------------------------------------------------- *) +(* Sura-Bura's results about compact components of sets. *) +(* ------------------------------------------------------------------------- *) + +let SURA_BURA_COMPACT = prove + (`!s c:real^N->bool. + compact s /\ c IN components s + ==> c = INTERS {t | c SUBSET t /\ + open_in (subtopology euclidean s) t /\ + closed_in (subtopology euclidean s) t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [components]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> SUBST1_TAC th THEN ASSUME_TAC(SYM th)) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + SUBGOAL_THEN `(x:real^N) IN c` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN + SUBGOAL_THEN `(c:real^N->bool) SUBSET s` ASSUME_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN + REWRITE_TAC[IN_ELIM_THM; CONNECTED_COMPONENT_SUBSET; + OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV]] THEN + W(fun (asl,w) -> ABBREV_TAC(mk_eq(`k:real^N->bool`,rand w))) THEN + SUBGOAL_THEN `closed(k:real^N->bool)` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC CLOSED_INTERS THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; + ALL_TAC] THEN + REWRITE_TAC[CONNECTED_CLOSED_IN_EQ; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k1:real^N->bool`; `k2:real^N->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`k1:real^N->bool`; `k2:real^N->bool`] SEPARATION_NORMAL) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`v1:real^N->bool`; `v2:real^N->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s DIFF (v1 UNION v2):real^N->bool`; + `{t:real^N->bool | connected_component s x SUBSET t /\ + open_in (subtopology euclidean s) t /\ + closed_in (subtopology euclidean s) t}`] + COMPACT_IMP_FIP) THEN + ASM_SIMP_TAC[NOT_IMP; COMPACT_DIFF; OPEN_UNION; IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; + ONCE_REWRITE_TAC[SUBSET] THEN REWRITE_TAC[IN_ELIM_THM]; + ASM SET_TAC[]] THEN + X_GEN_TAC `f:(real^N->bool)->bool` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c0:real^N->bool. + c SUBSET c0 /\ c0 SUBSET (v1 UNION v2) /\ + open_in (subtopology euclidean s) c0 /\ + closed_in (subtopology euclidean s) c0` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[TOPSPACE_EUCLIDEAN; SUBSET_UNIV; + OPEN_IN_SUBTOPOLOGY_REFL; CLOSED_IN_SUBTOPOLOGY_REFL] THEN + UNDISCH_TAC + `(s DIFF (v1 UNION v2)) INTER INTERS f :real^N->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; INTER_UNIV] THEN SET_TAC[]; + EXISTS_TAC `INTERS f :real^N->bool` THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `(s DIFF u) INTER t = {} + ==> t SUBSET s + ==> t SUBSET u`)) THEN + MATCH_MP_TAC(SET_RULE + `~(f = {}) /\ (!s. s IN f ==> s SUBSET t) ==> INTERS f SUBSET t`) THEN + ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; + MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `connected(c:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean c0) (c0 INTER v1 :real^N->bool) /\ + closed_in (subtopology euclidean c0) (c0 INTER v2 :real^N->bool)` + MP_TAC THENL + [CONJ_TAC THEN + MATCH_MP_TAC(MESON[] + `closed_in top (c INTER closure v) /\ + c INTER closure v = c INTER v + ==> closed_in top (c INTER v)`) THEN + (CONJ_TAC THENL + [MESON_TAC[CLOSED_IN_CLOSED; CLOSED_CLOSURE]; ALL_TAC]) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `c0 SUBSET vv ==> c0 INTER (vv INTER v') = c0 INTER v + ==> c0 INTER v' = c0 INTER v`)) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[INTER_COMM] UNION_OVER_INTER; + UNION_OVER_INTER] THEN + SIMP_TAC[SET_RULE `s SUBSET t ==> s INTER t = s`; CLOSURE_SUBSET] THENL + [ALL_TAC; ONCE_REWRITE_TAC[UNION_COMM]] THEN + MATCH_MP_TAC(SET_RULE `t = {} ==> s UNION (u INTER t) = s`) THEN + ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u1:real^N->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `u2:real^N->bool` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `closed(c0:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_CLOSED_TRANS; COMPACT_IMP_CLOSED]; ALL_TAC] THEN + REWRITE_TAC[CONNECTED_CLOSED] THEN MAP_EVERY EXISTS_TAC + [`c0 INTER u1:real^N->bool`; `c0 INTER u2:real^N->bool`] THEN + ASM_SIMP_TAC[CLOSED_INTER] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN CONJ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `c SUBSET (c0 INTER v2 :real^N->bool)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `k SUBSET (c0 INTER v2 :real^N->bool)` ASSUME_TAC THENL + [ALL_TAC; ASM SET_TAC[]]; + STRIP_TAC THEN + SUBGOAL_THEN `c SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `k SUBSET (c0 INTER v1 :real^N->bool)` ASSUME_TAC THENL + [ALL_TAC; ASM SET_TAC[]]] THEN + (UNDISCH_THEN `k1 UNION k2 :real^N->bool = k` (K ALL_TAC) THEN + EXPAND_TAC "k" THEN + MATCH_MP_TAC(SET_RULE `s IN t ==> INTERS t SUBSET s`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC OPEN_IN_INTER_OPEN THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_IN_INTER_CLOSED THEN ASM_REWRITE_TAC[]]));; + +let SURA_BURA_CLOPEN_SUBSET = prove + (`!s c u:real^N->bool. + locally compact s /\ + c IN components s /\ compact c /\ + open u /\ c SUBSET u + ==> ?k. open_in (subtopology euclidean s) k /\ compact k /\ + c SUBSET k /\ k SUBSET u`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [LOCALLY_COMPACT_COMPACT_SUBOPEN]) THEN + DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `u:real^N->bool`]) THEN + ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `k:real^N->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`k:real^N->bool`; `c:real^N->bool`] + SURA_BURA_COMPACT) THEN + ASM_SIMP_TAC[CLOSED_IN_COMPACT_EQ] THEN ANTS_TAC THENL + [MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + DISCH_THEN(ASSUME_TAC o SYM)] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + MP_TAC(ISPECL + [`(:real^N) DIFF (u INTER w)`; + `{t:real^N->bool | c SUBSET t /\ open_in (subtopology euclidean k) t /\ + compact t /\ t SUBSET k}`] + CLOSED_IMP_FIP_COMPACT) THEN + ASM_SIMP_TAC[GSYM OPEN_CLOSED; OPEN_INTER; FORALL_IN_GSPEC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM; SET_RULE + `(UNIV DIFF u) INTER s = {} <=> s SUBSET u`] THEN + DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; FINITE_EMPTY] THEN + REWRITE_TAC[SET_RULE `UNIV SUBSET s INTER t <=> s = UNIV /\ t = UNIV`] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTER_UNIV]) THEN + UNDISCH_THEN `s:real^N->bool = v` (SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN `k:real^N->bool = s` SUBST_ALL_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[SUBSET_UNIV]] THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[IN_COMPONENTS_SUBSET; OPEN_IN_REFL]; + STRIP_TAC THEN EXISTS_TAC `INTERS f:real^N->bool` THEN + ASM_SIMP_TAC[COMPACT_INTERS] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `k:real^N->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTERS THEN ASM_SIMP_TAC[]; + EXPAND_TAC "v" THEN REWRITE_TAC[SUBSET_INTER] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `(!t. t IN f ==> t SUBSET s) /\ ~(f = {}) ==> INTERS f SUBSET s`) THEN + ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET_TRANS]]]);; + +let SURA_BURA = prove + (`!s c:real^N->bool. + locally compact s /\ c IN components s /\ compact c + ==> c = INTERS {k | c SUBSET k /\ compact k /\ + open_in (subtopology euclidean s) k}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`{x:real^N}`; `c:real^N->bool`] SEPARATION_NORMAL) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_SING] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`; `v:real^N->bool`] + SURA_BURA_CLOPEN_SUBSET) THEN + ASM_REWRITE_TAC[IN_INTERS; NOT_FORALL_THM; IN_ELIM_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Relations between components and path components. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_CONNECTED_COMPONENT = prove + (`!s x:real^N. open s ==> open(connected_component s x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + DISCH_TAC THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[SUBSET; CONNECTED_COMPONENT_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `connected_component s (x:real^N) = connected_component s y` + SUBST1_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; CONNECTED_BALL]]);; + +let IN_CLOSURE_CONNECTED_COMPONENT = prove + (`!x y:real^N. + x IN s /\ open s + ==> (x IN closure(connected_component s y) <=> + x IN connected_component s y)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + REWRITE_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + DISCH_TAC THEN SUBGOAL_THEN + `~((connected_component s (x:real^N)) INTER + closure(connected_component s y) = {})` + MP_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[IN_INTER] THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + ASM_SIMP_TAC[OPEN_INTER_CLOSURE_EQ_EMPTY; OPEN_CONNECTED_COMPONENT] THEN + REWRITE_TAC[CONNECTED_COMPONENT_OVERLAP] THEN + STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]]);; + +let PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT = prove + (`!s x:real^N. (path_component s x) SUBSET (connected_component s x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(x:real^N) IN s` THENL + [MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[PATH_COMPONENT_SUBSET; IN; PATH_COMPONENT_REFL_EQ] THEN + SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; PATH_CONNECTED_PATH_COMPONENT]; + ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; SUBSET_REFL; + CONNECTED_COMPONENT_EQ_EMPTY]]);; + +let PATH_COMPONENT_EQ_CONNECTED_COMPONENT = prove + (`!s x:real^N. + locally path_connected s + ==> (path_component s x = connected_component s x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(x:real^N) IN s` THENL + [ALL_TAC; + ASM_MESON_TAC[PATH_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY]] THEN + MP_TAC(ISPECL[`s:real^N->bool`; `x:real^N`] + CONNECTED_CONNECTED_COMPONENT) THEN REWRITE_TAC[CONNECTED_CLOPEN] THEN + REWRITE_TAC[TAUT `p ==> q \/ r <=> p /\ ~q ==> r`] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS; + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS] THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; + CLOSED_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; + PATH_COMPONENT_SUBSET_CONNECTED_COMPONENT; + CONNECTED_COMPONENT_SUBSET]);; + +let LOCALLY_PATH_CONNECTED_PATH_COMPONENT = prove + (`!s x:real^N. + locally path_connected s + ==> locally path_connected (path_component s x)`, + MESON_TAC[LOCALLY_PATH_CONNECTED_CONNECTED_COMPONENT; + PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);; + +let OPEN_PATH_CONNECTED_COMPONENT = prove + (`!s x:real^N. open s ==> path_component s x = connected_component s x`, + SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT; + OPEN_IMP_LOCALLY_PATH_CONNECTED]);; + +let PATH_CONNECTED_EQ_CONNECTED_LPC = prove + (`!s. locally path_connected s ==> (path_connected s <=> connected s)`, + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; + CONNECTED_IFF_CONNECTED_COMPONENT] THEN + SIMP_TAC[PATH_COMPONENT_EQ_CONNECTED_COMPONENT]);; + +let PATH_CONNECTED_EQ_CONNECTED = prove + (`!s. open s ==> (path_connected s <=> connected s)`, + SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED_LPC; OPEN_IMP_LOCALLY_PATH_CONNECTED]);; + +let CONNECTED_OPEN_PATH_CONNECTED = prove + (`!s:real^N->bool. open s /\ connected s ==> path_connected s`, + SIMP_TAC[PATH_CONNECTED_EQ_CONNECTED]);; + +let CONNECTED_OPEN_ARC_CONNECTED = prove + (`!s:real^N->bool. + open s /\ connected s + ==> !x y. x IN s /\ y IN s + ==> x = y \/ + ?g. arc g /\ + path_image g SUBSET s /\ + pathstart g = x /\ + pathfinish g = y`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_OPEN_PATH_CONNECTED) THEN + REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);; + +let OPEN_COMPONENTS = prove + (`!u:real^N->bool s. open u /\ s IN components u ==> open s`, + REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC (MESON[IN_COMPONENTS; + ASSUME `s:real^N->bool IN components u`] `?x. s:real^N->bool = + connected_component u x`) THEN ASM_SIMP_TAC [OPEN_CONNECTED_COMPONENT]);; + +let COMPONENTS_OPEN_UNIQUE = prove + (`!f:(real^N->bool)->bool s. + (!c. c IN f ==> open c /\ connected c /\ ~(c = {})) /\ + pairwise DISJOINT f /\ UNIONS f = s + ==> components s = f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE THEN + ASM_REWRITE_TAC[GSYM UNIONS_COMPONENTS; PAIRWISE_DISJOINT_COMPONENTS] THEN + ASM_MESON_TAC[OPEN_COMPONENTS; IN_COMPONENTS_NONEMPTY; + IN_COMPONENTS_CONNECTED; OPEN_UNIONS]);; + +let CONTINUOUS_ON_COMPONENTS = prove + (`!f:real^M->real^N s. + locally connected s /\ (!c. c IN components s ==> f continuous_on c) + ==> f continuous_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPONENTS_GEN THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[OPEN_IN_COMPONENTS_LOCALLY_CONNECTED]);; + +let CONTINUOUS_ON_COMPONENTS_EQ = prove + (`!f s. locally connected s + ==> (f continuous_on s <=> + !c. c IN components s ==> f continuous_on c)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET]; + ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS]]);; + +let CONTINUOUS_ON_COMPONENTS_OPEN = prove + (`!f:real^M->real^N s. + open s /\ (!c. c IN components s ==> f continuous_on c) + ==> f continuous_on s`, + ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS; OPEN_IMP_LOCALLY_CONNECTED]);; + +let CONTINUOUS_ON_COMPONENTS_OPEN_EQ = prove + (`!f s. open s + ==> (f continuous_on s <=> + !c. c IN components s ==> f continuous_on c)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[CONTINUOUS_ON_SUBSET; IN_COMPONENTS_SUBSET]; + ASM_MESON_TAC[CONTINUOUS_ON_COMPONENTS_OPEN]]);; + +let CLOSED_IN_UNION_COMPLEMENT_COMPONENTS = prove + (`!u s:real^N->bool c. + locally connected u /\ + closed_in (subtopology euclidean u) s /\ c SUBSET components(u DIFF s) + ==> closed_in (subtopology euclidean u) (s UNION UNIONS c)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `s UNION UNIONS c:real^N->bool = + u DIFF (UNIONS(components(u DIFF s) DIFF c))` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET u /\ u DIFF s = c UNION c' /\ DISJOINT c c' + ==> s UNION c = u DIFF c'`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[GSYM UNIONS_UNION; GSYM UNIONS_COMPONENTS; SET_RULE + `s SUBSET t ==> s UNION (t DIFF s) = t`] THEN + MATCH_MP_TAC(SET_RULE + `(!s t. s IN c /\ t IN c' ==> DISJOINT s t) + ==> DISJOINT (UNIONS c) (UNIONS c')`) THEN + REWRITE_TAC[IN_DIFF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(u:real^N->bool) DIFF s` + PAIRWISE_DISJOINT_COMPONENTS) THEN + REWRITE_TAC[pairwise] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN ASM_MESON_TAC[]; + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_DIFF] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[IN_DIFF] THEN + X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN + EXISTS_TAC `u DIFF s:real^N->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_COMPONENTS_LOCALLY_CONNECTED THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LOCALLY_OPEN_SUBSET THEN + EXISTS_TAC `u:real^N->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_SIMP_TAC[OPEN_IN_REFL]]);; + +let CLOSED_UNION_COMPLEMENT_COMPONENTS = prove + (`!s c. closed s /\ c SUBSET components((:real^N) DIFF s) + ==> closed(s UNION UNIONS c)`, + ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN + ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);; + +let CLOSED_IN_UNION_COMPLEMENT_COMPONENT = prove + (`!u s c:real^N->bool. + locally connected u /\ + closed_in (subtopology euclidean u) s /\ + c IN components(u DIFF s) + ==> closed_in (subtopology euclidean u) (s UNION c)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM UNIONS_1] THEN + MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENTS THEN + ASM_REWRITE_TAC[SING_SUBSET]);; + +let CLOSED_UNION_COMPLEMENT_COMPONENT = prove + (`!s c. closed s /\ c IN components((:real^N) DIFF s) ==> closed(s UNION c)`, + ONCE_REWRITE_TAC[CLOSED_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CLOSED_IN_UNION_COMPLEMENT_COMPONENT THEN + ASM_REWRITE_TAC[LOCALLY_CONNECTED_UNIV]);; + +let COUNTABLE_CONNECTED_COMPONENTS = prove + (`!s:real^N->bool t. + locally connected s ==> COUNTABLE {connected_component s x | x IN t}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{connected_component s (x:real^N) |x| x IN s}`; + `s:real^N->bool`] LINDELOF_OPEN_IN) THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_CONNECTED_COMPONENT_LOCALLY_CONNECTED; + UNIONS_CONNECTED_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `({}:real^N->bool) INSERT u` THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN + DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] + COMPLEMENT_CONNECTED_COMPONENT_UNIONS) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF] THEN + ASM_CASES_TAC `(x:real^N) IN connected_component s x` THENL + [ALL_TAC; ASM_MESON_TAC[IN; CONNECTED_COMPONENT_REFL]] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN + MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);; + +let COUNTABLE_PATH_COMPONENTS = prove + (`!s:real^N->bool t. + locally path_connected s ==> COUNTABLE {path_component s x | x IN t}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{path_component s (x:real^N) |x| x IN s}`; + `s:real^N->bool`] LINDELOF_OPEN_IN) THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; OPEN_IN_PATH_COMPONENT_LOCALLY_PATH_CONNECTED; + UNIONS_PATH_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `({}:real^N->bool) INSERT u` THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INSERT] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[PATH_COMPONENT_EQ_EMPTY] THEN + DISCH_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] + COMPLEMENT_PATH_COMPONENT_UNIONS) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF] THEN + ASM_CASES_TAC `(x:real^N) IN path_component s x` THENL + [ALL_TAC; ASM_MESON_TAC[IN; PATH_COMPONENT_REFL]] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:real^N) IN UNIONS u` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN + MATCH_MP_TAC SUBSET_UNIONS THEN ASM SET_TAC[]);; + +let COUNTABLE_COMPONENTS = prove + (`!s:real^N->bool. locally connected s ==> COUNTABLE(components s)`, + SIMP_TAC[components; COUNTABLE_CONNECTED_COMPONENTS]);; + +let FRONTIER_MINIMAL_SEPARATING_CLOSED = prove + (`!s c. closed s /\ ~connected((:real^N) DIFF s) /\ + (!t. closed t /\ t PSUBSET s ==> connected((:real^N) DIFF t)) /\ + c IN components ((:real^N) DIFF s) + ==> frontier c = s`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o + GEN_REWRITE_RULE RAND_CONV [CONNECTED_EQ_CONNECTED_COMPONENTS_EQ]) THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `~(!x x'. x IN s /\ x' IN s ==> x = x') + ==> !x. x IN s ==> ?y. y IN s /\ ~(y = x)`)) THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `frontier c:real^N->bool`) THEN + REWRITE_TAC[SET_RULE `s PSUBSET t <=> s SUBSET t /\ ~(t SUBSET s)`; + GSYM SUBSET_ANTISYM_EQ] THEN + ASM_SIMP_TAC[FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT; FRONTIER_CLOSED] THEN + MATCH_MP_TAC(TAUT `~r ==> (~p ==> r) ==> p`) THEN + REWRITE_TAC[connected] THEN + MAP_EVERY EXISTS_TAC [`c:real^N->bool`; `(:real^N) DIFF closure c`] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[OPEN_COMPONENTS; closed]; + REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]; + MP_TAC(ISPEC `c:real^N->bool` INTERIOR_SUBSET) THEN + REWRITE_TAC[frontier] THEN SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `c SUBSET c' ==> c INTER (UNIV DIFF c') INTER s = {}`) THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; CLOSURE_SUBSET]; + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `ci = c /\ ~(c = {}) + ==> ~(c INTER (UNIV DIFF (cc DIFF ci)) = {})`) THEN + ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY; INTERIOR_OPEN; closed; + OPEN_COMPONENTS]; + REWRITE_TAC[frontier] THEN MATCH_MP_TAC(SET_RULE + `~(UNIV DIFF c = {}) + ==> ~((UNIV DIFF c) INTER (UNIV DIFF (c DIFF i)) = {})`) THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN + MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ ~(t = {}) ==> ~(s = {})`) THEN + EXISTS_TAC `d:real^N->bool` THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]] THEN + MATCH_MP_TAC INTERIOR_MAXIMAL THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + ASM_MESON_TAC[COMPONENTS_NONOVERLAP; OPEN_COMPONENTS; GSYM closed]]);; + +let FRONTIER_MINIMAL_SEPARATING_CLOSED_POINTWISE = prove + (`!s a b. closed s /\ ~(a IN s) /\ + ~connected_component ((:real^N) DIFF s) a b /\ + (!t. closed t /\ t PSUBSET s + ==> connected_component((:real^N) DIFF t) a b) + ==> frontier(connected_component ((:real^N) DIFF s) a) = s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC FRONTIER_OF_COMPONENTS_CLOSED_COMPLEMENT THEN + ASM_REWRITE_TAC[IN_COMPONENTS; IN_UNIV; IN_DIFF] THEN ASM SET_TAC[]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `frontier (connected_component ((:real^N) DIFF s) a)`) THEN + ASM_REWRITE_TAC[FRONTIER_CLOSED] THEN + GEN_REWRITE_TAC RAND_CONV [connected_component] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `t SUBSET UNIV DIFF f ==> ~(t INTER f = {}) ==> F`)) THEN + MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_DIFF] THEN + CONJ_TAC THENL [EXISTS_TAC `a:real^N`; EXISTS_TAC `b:real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_UNIV; IN_DIFF]]);; + +(* ------------------------------------------------------------------------- *) +(* If two points are separated by a closed set, there's a minimal one. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_IRREDUCIBLE_SEPARATOR = prove + (`!s a b:real^N. + closed s /\ ~connected_component ((:real^N) DIFF s) a b + ==> ?t. t SUBSET s /\ closed t /\ ~(t = {}) /\ + ~connected_component ((:real^N) DIFF t) a b /\ + !u. u PSUBSET t ==> connected_component ((:real^N) DIFF u) a b`, + MAP_EVERY X_GEN_TAC [`c:real^N->bool`; `a:real^N`; `b:real^N`] THEN + STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN c` THENL + [EXISTS_TAC `{a:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN + SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `(b:real^N) IN c` THENL + [EXISTS_TAC `{b:real^N}` THEN ASM_REWRITE_TAC[CLOSED_SING; SING_SUBSET] THEN + SIMP_TAC[SET_RULE `s PSUBSET {a} <=> s = {}`; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[UNIV]] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN SET_TAC[]; + ALL_TAC] THEN + MAP_EVERY ABBREV_TAC + [`r = connected_component ((:real^N) DIFF c) a`; + `s = connected_component ((:real^N) DIFF closure r) b`] THEN + EXISTS_TAC `frontier s:real^N->bool` THEN REWRITE_TAC[FRONTIER_CLOSED] THEN + SUBGOAL_THEN `(a:real^N) IN r` ASSUME_TAC THENL + [EXPAND_TAC "r" THEN REWRITE_TAC[IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(b:real^N) IN s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_REWRITE_TAC[IN_UNIV; IN_DIFF] THEN + REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[IN]; EXPAND_TAC "r"] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + FRONTIER_OF_CONNECTED_COMPONENT_SUBSET)) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(b IN s) ==> t SUBSET s ==> b IN t ==> F`)) THEN + ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ]; + ALL_TAC] THEN + SUBGOAL_THEN `frontier(s:real^N->bool) SUBSET frontier r` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN + MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] + `frontier s SUBSET t ==> frontier(connected_component s a) SUBSET t`) THEN + REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_CLOSURE_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT + `(q ==> r) /\ p /\ ~r /\ s ==> p /\ ~q /\ ~r /\ s`) THEN + CONJ_TAC THENL + [SIMP_TAC[DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN REWRITE_TAC[UNIV]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + EXPAND_TAC "r" THEN + MATCH_MP_TAC(MESON[SUBSET_TRANS; FRONTIER_OF_CONNECTED_COMPONENT_SUBSET] + `frontier s SUBSET t ==>frontier (connected_component s a) SUBSET t`) THEN + ASM_REWRITE_TAC[FRONTIER_COMPLEMENT; FRONTIER_SUBSET_EQ]; + REWRITE_TAC[connected_component; NOT_EXISTS_THM; SET_RULE + `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC)) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN CONJ_TAC THENL + [EXISTS_TAC `b:real^N` THEN ASM_REWRITE_TAC[]; EXISTS_TAC `a:real^N`] THEN + ASM_REWRITE_TAC[IN_DIFF] THEN EXPAND_TAC "s" THEN REWRITE_TAC[IN] THEN + DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP CONNECTED_COMPONENT_IN) THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `u:real^N->bool` THEN REWRITE_TAC[PSUBSET_ALT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `(p:real^N) INSERT (s UNION r)` THEN + ASM_REWRITE_TAC[IN_INSERT; IN_UNION] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE + `a INSERT (s UNION t) = (a INSERT s) UNION (a INSERT t)`] THEN + MATCH_MP_TAC CONNECTED_UNION THEN REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + CONJ_TAC THEN MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THENL + [EXISTS_TAC `s:real^N->bool`; EXISTS_TAC `r:real^N->bool`] THEN + (CONJ_TAC THENL + [ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT]; ALL_TAC] THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[INSERT_SUBSET]] THEN + REWRITE_TAC[CLOSURE_SUBSET] THEN + ASM_REWRITE_TAC[CLOSURE_UNION_FRONTIER; IN_UNION] THEN ASM SET_TAC[]); + MATCH_MP_TAC(SET_RULE + `s INTER u = {} /\ t INTER u = {} /\ ~(p IN u) + ==> p INSERT (s UNION t) SUBSET UNIV DIFF u`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `u SUBSET t ==> t INTER s = {} ==> s INTER u = {}`)) THEN + REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "s"; + SUBGOAL_THEN `frontier(r:real^N->bool) INTER r = {}` + (fun th -> ASM SET_TAC[th]) THEN + REWRITE_TAC[FRONTIER_DISJOINT_EQ] THEN EXPAND_TAC "r"] THEN + MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN + ASM_REWRITE_TAC[GSYM closed; CLOSED_CLOSURE]]]);; + +(* ------------------------------------------------------------------------- *) +(* Lower bound on norms within segment between vectors. *) +(* Could have used these for connectedness results below, in fact. *) +(* ------------------------------------------------------------------------- *) + +let NORM_SEGMENT_LOWERBOUND = prove + (`!a b x:real^N r d. + &0 < r /\ + norm(a) = r /\ norm(b) = r /\ x IN segment[a,b] /\ + a dot b = d * r pow 2 + ==> sqrt((&1 - abs d) / &2) * r <= norm(x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM real_ge] THEN + REWRITE_TAC[NORM_GE_SQUARE] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[real_ge; DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH + `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2 - + &2 * (&1 - u) * u * abs d * r pow 2` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_MUL; REAL_MUL_ASSOC] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + REWRITE_TAC[GSYM REAL_POW_2; REAL_ARITH + `(&1 - u) pow 2 + u pow 2 - ((&2 * (&1 - u)) * u) * d = + (&1 + d) * (&1 - &2 * u + &2 * u pow 2) - d`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 + abs d) * &1 / &2 - abs d` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `(&1 + d) * &1 / &2 - d = (&1 - d) / &2`] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SQRT_POW_2 THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`] NORM_CAUCHY_SCHWARZ_ABS) THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_POW2_ABS] THEN + ASM_REWRITE_TAC[REAL_ARITH `r * r = &1 * r pow 2`] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x - a <= y - a`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `&0 <= (u - &1 / &2) * (u - &1 / &2) + ==> &1 / &2 <= &1 - &2 * u + &2 * u pow 2`) THEN + REWRITE_TAC[REAL_LE_SQUARE]]]; + ASM_REWRITE_TAC[GSYM NORM_POW_2; REAL_LE_LADD; real_sub] THEN + MATCH_MP_TAC(REAL_ARITH `abs(a) <= --x ==> x <= a`) THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_LNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + ASM_REWRITE_TAC[real_abs; GSYM real_sub; REAL_SUB_LE; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of orthogonality (could replace 2 by sqrt(2)). *) +(* ------------------------------------------------------------------------- *) + +let NORM_SEGMENT_ORTHOGONAL_LOWERBOUND = prove + (`!a b:real^N x r. + r <= norm(a) /\ r <= norm(b) /\ orthogonal a b /\ x IN segment[a,b] + ==> r / &2 <= norm(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM real_ge] THEN + REWRITE_TAC[NORM_GE_SQUARE] THEN REWRITE_TAC[real_ge] THEN + ASM_CASES_TAC `r <= &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[orthogonal] THEN STRIP_TAC THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; REAL_MUL_RZERO; VECTOR_ARITH + `(a + b) dot (a + b) = a dot a + b dot b + &2 * a dot b`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 - u) * (&1 - u) * r pow 2 + u * u * r pow 2` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `(r / &2) pow 2 = &1 / &4 * r pow 2`] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= (u - &1 / &2) * (u - &1 / &2) + ==> &1 / &4 <= (&1 - u) * (&1 - u) + u * u`) THEN + REWRITE_TAC[REAL_LE_SQUARE]; + REWRITE_TAC[REAL_ADD_RID] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THEN + REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Accessibility of frontier points. *) +(* ------------------------------------------------------------------------- *) + +let DENSE_ACCESSIBLE_FRONTIER_POINTS = prove + (`!s:real^N->bool v. + open s /\ open_in (subtopology euclidean (frontier s)) v /\ ~(v = {}) + ==> ?g. arc g /\ + IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\ + pathstart g IN s /\ pathfinish g IN v`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `z:real^N`)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `(z:real^N) IN frontier s` MP_TAC THENL + [ASM SET_TAC[]; + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[frontier] THEN ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN]] THEN + REWRITE_TAC[closure; IN_UNION; TAUT `(p \/ q) /\ ~p <=> ~p /\ q`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `r:real`) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `s INTER ball(z:real^N,r) = {}` THENL + [ASM_MESON_TAC[INFINITE; FINITE_EMPTY]; DISCH_THEN(K ALL_TAC)] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~((y:real^N) IN frontier s)` ASSUME_TAC THENL + [ASM_SIMP_TAC[IN_DIFF; INTERIOR_OPEN; frontier]; ALL_TAC] THEN + SUBGOAL_THEN `path_connected(ball(z:real^N,r))` MP_TAC THENL + [ASM_SIMP_TAC[CONVEX_BALL; CONVEX_IMP_PATH_CONNECTED]; ALL_TAC] THEN + REWRITE_TAC[PATH_CONNECTED_ARCWISE] THEN + DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC + `IMAGE drop {t | t IN interval[vec 0,vec 1] /\ + (g:real^1->real^N) t IN frontier s}` + COMPACT_ATTAINS_INF) THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IMP_CONJ] THEN + REWRITE_TAC[IMP_IMP; FORALL_IN_GSPEC; EXISTS_IN_GSPEC; GSYM IMAGE_o] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_ID] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + REWRITE_TAC[BOUNDED_INTERVAL; SUBSET_RESTRICT]; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + REWRITE_TAC[FRONTIER_CLOSED; CLOSED_INTERVAL; GSYM path] THEN + ASM_MESON_TAC[arc]]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `vec 1:real^1` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN + ASM_MESON_TAC[pathfinish; SUBSET]]; + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `subpath (vec 0) t (g:real^1->real^N)` THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC ARC_SUBPATH_ARC THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + ASM_MESON_TAC[pathstart]; + REWRITE_TAC[arc] THEN STRIP_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [GSYM pathstart] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; RULE_ASSUM_TAC(SIMP_RULE[path_image]) THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> IMAGE f (s DELETE a) SUBSET t`) THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; GSYM path_image] THEN + W(MP_TAC o PART_MATCH (lhand o rand) PATH_IMAGE_SUBPATH o lhand o lhand o + snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[IN_INTERVAL_1]; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[REWRITE_RULE[pathfinish] PATHFINISH_SUBPATH] THEN + MATCH_MP_TAC(SET_RULE + `IMAGE f (s DELETE a) DIFF t = {} + ==> IMAGE f s DELETE f a SUBSET t`) THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT + `p /\ q /\ ~r ==> ~s <=> p /\ q /\ s ==> r`] + CONNECTED_INTER_FRONTIER) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [arc]) THEN + REWRITE_TAC[path] THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `interval(vec 0:real^1,t)` THEN + REWRITE_TAC[CONNECTED_INTERVAL; CLOSURE_INTERVAL] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[SUBSET; IN_DELETE; GSYM DROP_EQ; IN_INTERVAL_1] THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[SET_RULE + `~(IMAGE f s INTER t = {}) <=> ?x. x IN s /\ f x IN t`] THEN + EXISTS_TAC `vec 0:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; IN_DELETE; REAL_LE_REFL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + ASM SET_TAC[pathstart]; + REWRITE_TAC[SET_RULE + `IMAGE g i INTER s = {} <=> !x. x IN i ==> ~(g x IN s)`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_DELETE; IN_UNIV; IN_DIFF] THEN + X_GEN_TAC `z:real^1` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[GSYM DROP_EQ; IN_INTERVAL_1] THEN DISCH_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + ASM_REAL_ARITH_TAC]]);; + +let DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED = prove + (`!s:real^N->bool v x. + open s /\ connected s /\ x IN s /\ + open_in (subtopology euclidean (frontier s)) v /\ ~(v = {}) + ==> ?g. arc g /\ + IMAGE g (interval [vec 0,vec 1] DELETE vec 1) SUBSET s /\ + pathstart g = x /\ pathfinish g IN v`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `v:real^N->bool`] + DENSE_ACCESSIBLE_FRONTIER_POINTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[CONNECTED_OPEN_PATH_CONNECTED]; ALL_TAC] THEN + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `pathstart g:real^N`]) THEN + ASM_REWRITE_TAC[path_component; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:real^1->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f ++ g:real^1->real^N`; `x:real^N`; `pathfinish g:real^N`] + PATH_CONTAINS_ARC) THEN + ASM_SIMP_TAC[PATH_JOIN_EQ; ARC_IMP_PATH; PATH_IMAGE_JOIN; + PATHSTART_JOIN; PATHFINISH_JOIN] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + GEN_REWRITE_TAC LAND_CONV [SUBSET] THEN + ASM_SIMP_TAC[frontier; INTERIOR_OPEN; IN_DIFF] THEN + DISCH_TAC THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^1->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(SET_RULE + `a IN s /\ IMAGE f s DELETE (f a) SUBSET t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> IMAGE f (s DELETE a) SUBSET t`) THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + CONJ_TAC THENL [REWRITE_TAC[GSYM path_image]; ASM_MESON_TAC[arc]] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `h SUBSET f UNION g + ==> f SUBSET s /\ g DELETE a SUBSET s ==> h DELETE a SUBSET s`)) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish]) THEN + REWRITE_TAC[path_image] THEN ASM SET_TAC[]);; + +let DENSE_ACCESSIBLE_FRONTIER_POINT_PAIRS = prove + (`!s u v:real^N->bool. + open s /\ connected s /\ + open_in (subtopology euclidean (frontier s)) u /\ + open_in (subtopology euclidean (frontier s)) v /\ + ~(u = {}) /\ ~(v = {}) /\ ~(u = v) + ==> ?g. arc g /\ + pathstart g IN u /\ pathfinish g IN v /\ + IMAGE g (interval(vec 0,vec 1)) SUBSET s`, + GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN + GEN_REWRITE_TAC (funpow 2 BINDER_CONV o LAND_CONV o RAND_CONV) + [GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[DE_MORGAN_THM; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC(MESON[] + `(!u v. R u v ==> R v u) /\ (!u v. P u v ==> R u v) + ==> !u v. P u v \/ P v u ==> R u v`) THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `g:real^1->real^N` THEN + STRIP_TAC THEN EXISTS_TAC `reversepath g:real^1->real^N` THEN + ASM_SIMP_TAC[ARC_REVERSEPATH; PATHSTART_REVERSEPATH; + PATHFINISH_REVERSEPATH] THEN + REWRITE_TAC[reversepath] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `IMAGE f i SUBSET t + ==> IMAGE r i SUBSET i ==> IMAGE f (IMAGE r i) SUBSET t`)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[FRONTIER_EMPTY; OPEN_IN_SUBTOPOLOGY_EMPTY] THENL + [CONV_TAC TAUT; STRIP_TAC THEN UNDISCH_TAC `~(s:real^N->bool = {})`] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `v:real^N->bool`; `x:real^N`] + DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `(u DELETE pathfinish g):real^N->bool`; `x:real^N`] + DENSE_ACCESSIBLE_FRONTIER_POINTS_CONNECTED) THEN + ASM_SIMP_TAC[OPEN_IN_DELETE; IN_DELETE; LEFT_IMP_EXISTS_THM] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(reversepath h ++ g):real^1->real^N`; + `pathfinish h:real^N`; `pathfinish g:real^N`] + PATH_CONTAINS_ARC) THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATH_REVERSEPATH; ARC_IMP_PATH; PATH_IMAGE_JOIN; + PATH_IMAGE_REVERSEPATH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^1->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN + MATCH_MP_TAC(SET_RULE + `(!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + t SUBSET s /\ IMAGE f s SUBSET u UNION IMAGE f t + ==> IMAGE f (s DIFF t) SUBSET u`) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; ENDS_IN_UNIT_INTERVAL] THEN + CONJ_TAC THENL [ASM_MESON_TAC[arc]; REWRITE_TAC[GSYM path_image]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish; path_image]) THEN + REWRITE_TAC[path_image] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some simple positive connection theorems. *) +(* ------------------------------------------------------------------------- *) + +let PATH_CONNECTED_CONVEX_DIFF_CARD_LT = prove + (`!u s:real^N->bool. + convex u /\ ~(collinear u) /\ s <_c (:real) ==> path_connected(u DIFF s)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[path_connected; IN_DIFF; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + ASM_CASES_TAC `a:real^N = b` THENL + [EXISTS_TAC `linepath(a:real^N,b)` THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `m:real^N = midpoint(a,b)` THEN + SUBGOAL_THEN `~(m:real^N = a) /\ ~(m = b)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[MIDPOINT_EQ_ENDPOINT]; ALL_TAC] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + GEOM_ORIGIN_TAC `m:real^N` THEN REPEAT GEN_TAC THEN + GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN GEN_TAC THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `bbb:real` THEN + DISCH_TAC THEN SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN + DISCH_THEN SUBST1_TAC THEN POP_ASSUM(K ALL_TAC) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[midpoint; VECTOR_MUL_LID] THEN + REWRITE_TAC[VECTOR_ARITH `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`] THEN + ASM_CASES_TAC `a:real^N = --(basis 1)` THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(K ALL_TAC) THEN + REPLICATE_TAC 7 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `segment[--basis 1:real^N,basis 1] SUBSET u` ASSUME_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(vec 0:real^N) IN u` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `&1 / &2` THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `?c:real^N k. 1 <= k /\ ~(k = 1) /\ k <= dimindex(:N) /\ + c IN u /\ ~(c$k = &0)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM NOT_FORALL_THM; TAUT + `a /\ ~b /\ c /\ d /\ ~e <=> ~(d ==> a /\ c ==> ~b ==> e)`] THEN + DISCH_TAC THEN UNDISCH_TAC `~collinear(u:real^N->bool)` THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL] THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `basis 1:real^N`] THEN + SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC; IN_INSERT; SPAN_INSERT_0] THEN + REWRITE_TAC[SPAN_SING; SUBSET; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN EXISTS_TAC `(c:real^N)$1` THEN + SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(c:real^N = vec 0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `segment[vec 0:real^N,c] SUBSET u` ASSUME_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?z:real^N. z IN segment[vec 0,c] /\ + (segment[--basis 1,z] UNION segment[z,basis 1]) INTER s = {}` + STRIP_ASSUME_TAC THENL + [ALL_TAC; + EXISTS_TAC `linepath(--basis 1:real^N,z) ++ linepath(z,basis 1)` THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; PATH_LINEPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_JOIN] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `(t UNION v) INTER s = {} + ==> t SUBSET u /\ v SUBSET u + ==> (t UNION v) SUBSET u DIFF s`)) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN ASM SET_TAC[]] THEN + MATCH_MP_TAC(SET_RULE + `~(s SUBSET {z | z IN s /\ ~P z}) ==> ?z. z IN s /\ P z`) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN + REWRITE_TAC[CARD_NOT_LE; SET_RULE + `~((b UNION c) INTER s = {}) <=> + ~(b INTER s = {}) \/ ~(c INTER s = {})`] THEN + REWRITE_TAC[SET_RULE + `{x | P x /\ (Q x \/ R x)} = {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN + W(MP_TAC o PART_MATCH lhand UNION_LE_ADD_C o lhand o snd) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_LET_TRANS) THEN + TRANS_TAC CARD_LTE_TRANS `(:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_ADD2_ABSORB_LT THEN REWRITE_TAC[real_INFINITE]; + MATCH_MP_TAC CARD_EQ_IMP_LE THEN ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + ASM_SIMP_TAC[CARD_EQ_SEGMENT]] THEN + REWRITE_TAC[MESON[SEGMENT_SYM] `segment[--a:real^N,b] = segment[b,--a]`] THEN + SUBGOAL_THEN + `!b:real^N. + b IN u /\ ~(b IN s) /\ ~(b = vec 0) /\ b$k = &0 + ==> {z | z IN segment[vec 0,c] /\ ~(segment[z,b] INTER s = {})} <_c + (:real)` + (fun th -> CONJ_TAC THEN MATCH_MP_TAC th THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; VECTOR_NEG_COMPONENT] THEN + ASM_SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; + BASIS_COMPONENT] THEN + REWRITE_TAC[REAL_NEG_0]) THEN + REPEAT STRIP_TAC THEN TRANS_TAC CARD_LET_TRANS `s:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> r /\ p /\ q`] THEN + MATCH_MP_TAC CARD_LE_RELATIONAL THEN + MAP_EVERY X_GEN_TAC [`w:real^N`; `x1:real^N`; `x2:real^N`] THEN + REWRITE_TAC[SEGMENT_SYM] THEN STRIP_TAC THEN + ASM_CASES_TAC `x2:real^N = x1` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`x1:real^N`; `b:real^N`; `x2:real^N`] INTER_SEGMENT) THEN + REWRITE_TAC[NOT_IMP; SEGMENT_SYM] THEN + CONJ_TAC THENL [DISJ2_TAC; REWRITE_TAC[SEGMENT_SYM] THEN ASM SET_TAC[]] THEN + ONCE_REWRITE_TAC[SET_RULE `{x1,b,x2} = {x1,x2,b}`] THEN + ASM_SIMP_TAC[COLLINEAR_3_AFFINE_HULL] THEN STRIP_TAC THEN + SUBGOAL_THEN `(b:real^N) IN affine hull {vec 0,c}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b IN s ==> s SUBSET t ==> b IN t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[AFFINE_AFFINE_HULL] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `segment[c:real^N,vec 0]` THEN + CONJ_TAC THENL [ASM SET_TAC[]; ONCE_REWRITE_TAC[SEGMENT_SYM]] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL; CONVEX_HULL_SUBSET_AFFINE_HULL]; + REWRITE_TAC[AFFINE_HULL_2_ALT; IN_ELIM_THM; IN_UNIV] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_SUB_RZERO; NOT_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN + ASM_CASES_TAC `r = &0` THEN ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. x$k`) THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_ENTIRE]]);; + +let CONNECTED_CONVEX_DIFF_CARD_LT = prove + (`!u s. convex u /\ ~collinear u /\ s <_c (:real) ==> connected(u DIFF s)`, + SIMP_TAC[PATH_CONNECTED_CONVEX_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);; + +let PATH_CONNECTED_CONVEX_DIFF_COUNTABLE = prove + (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> path_connected(u DIFF s)`, + MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; PATH_CONNECTED_CONVEX_DIFF_CARD_LT]);; + +let CONNECTED_CONVEX_DIFF_COUNTABLE = prove + (`!u s. convex u /\ ~collinear u /\ COUNTABLE s ==> connected(u DIFF s)`, + MESON_TAC[COUNTABLE_IMP_CARD_LT_REAL; CONNECTED_CONVEX_DIFF_CARD_LT]);; + +let PATH_CONNECTED_PUNCTURED_CONVEX = prove + (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> path_connected(s DELETE a)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (INT_ARITH + `~(x:int = &1) ==> --(&1) <= x ==> x = -- &1 \/ x = &0 \/ &2 <= x`)) THEN + ASM_REWRITE_TAC[AFF_DIM_GE; AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{} DELETE a = {}`] THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `b:real^N` SUBST1_TAC) THEN + ASM_CASES_TAC `b:real^N = a` THEN + ASM_REWRITE_TAC[PATH_CONNECTED_EMPTY; SET_RULE `{a} DELETE a = {}`] THEN + ASM_SIMP_TAC[SET_RULE `~(b = a) ==> {a} DELETE b = {a}`] THEN + REWRITE_TAC[PATH_CONNECTED_SING]; + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN + MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_COUNTABLE THEN + ASM_REWRITE_TAC[COUNTABLE_SING; COLLINEAR_AFF_DIM] THEN + ASM_INT_ARITH_TAC]);; + +let CONNECTED_PUNCTURED_CONVEX = prove + (`!s a:real^N. convex s /\ ~(aff_dim s = &1) ==> connected(s DELETE a)`, + SIMP_TAC[PATH_CONNECTED_PUNCTURED_CONVEX; PATH_CONNECTED_IMP_CONNECTED]);; + +let PATH_CONNECTED_COMPLEMENT_CARD_LT = prove + (`!s. 2 <= dimindex(:N) /\ s <_c (:real) + ==> path_connected((:real^N) DIFF s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_CONVEX_DIFF_CARD_LT THEN + ASM_REWRITE_TAC[CONVEX_UNIV; COLLINEAR_AFF_DIM; AFF_DIM_UNIV] THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC);; + +let PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT = prove + (`!s t:real^N->bool. + connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ + ~collinear s /\ t <_c (:real) + ==> path_connected(s DIFF t)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IN_DIFF] THEN + REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> p /\ r /\ q /\ s`] THEN + MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION_GEN THEN + ASM_REWRITE_TAC[IN_DIFF] THEN + REWRITE_TAC[PATH_COMPONENT_SYM; PATH_COMPONENT_TRANS] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `x:real^N`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `open_in (subtopology euclidean (affine hull s)) (u:real^N->bool)` + MP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN + REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE `~(s SUBSET t) ==> ?x. x IN s /\ ~(x IN t)`) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_LE_SUBSET) THEN + REWRITE_TAC[CARD_NOT_LE] THEN TRANS_TAC CARD_LTE_TRANS `(:real)` THEN + ASM_REWRITE_TAC[] THEN + TRANS_TAC CARD_LE_TRANS `ball(x:real^N,r) INTER affine hull s` THEN + ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_EQ_CONVEX THEN + EXISTS_TAC `x:real^N` THEN + ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL; + AFFINE_AFFINE_HULL; IN_INTER; CENTRE_IN_BALL; HULL_INC] THEN + SUBGOAL_THEN `~(s SUBSET {x:real^N})` MP_TAC THENL + [ASM_MESON_TAC[COLLINEAR_SUBSET; COLLINEAR_SING]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_SING; NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x + r / &2 / norm(y - x) % (y - x):real^N` THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + ASM_SIMP_TAC[HULL_INC; IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL] THEN + REWRITE_TAC[IN_BALL; VECTOR_ARITH `x:real^N = x + y <=> y = vec 0`] THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_DIV_EQ_0; NORM_EQ_0; VECTOR_SUB_EQ; + REAL_LT_IMP_NZ; NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `x:real^N`)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(x:real^N,r) INTER affine hull s` THEN + ASM_SIMP_TAC[IN_INTER; HULL_INC; CENTRE_IN_BALL] THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[INTER_COMM]OPEN_IN_OPEN_INTER; OPEN_BALL]; + MAP_EVERY X_GEN_TAC [`y:real^N`; `z:real^N`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`ball(x:real^N,r) INTER affine hull s`; `t:real^N->bool`] + PATH_CONNECTED_CONVEX_DIFF_CARD_LT) THEN + ASM_SIMP_TAC[CONVEX_INTER; AFFINE_IMP_CONVEX; CONVEX_BALL; + AFFINE_AFFINE_HULL] THEN + ANTS_TAC THENL + [REWRITE_TAC[COLLINEAR_AFF_DIM] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN + W(MP_TAC o PART_MATCH (lhs o rand) AFF_DIM_CONVEX_INTER_OPEN o + lhand o rand o snd) THEN + SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL; OPEN_BALL] THEN + ANTS_TAC THENL [ASM SET_TAC[CENTRE_IN_BALL]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AFF_DIM_AFFINE_HULL] THEN + ASM_REWRITE_TAC[GSYM COLLINEAR_AFF_DIM]; + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + DISCH_THEN(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[IN_INTER; IN_DIFF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] PATH_COMPONENT_OF_SUBSET) THEN + ASM SET_TAC[]]]]);; + +let CONNECTED_OPEN_IN_DIFF_CARD_LT = prove + (`!s t:real^N->bool. + connected s /\ open_in (subtopology euclidean (affine hull s)) s /\ + ~collinear s /\ t <_c (:real) + ==> connected(s DIFF t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN + MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN + ASM_REWRITE_TAC[]);; + +let PATH_CONNECTED_OPEN_DIFF_CARD_LT = prove + (`!s t:real^N->bool. + 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real) + ==> path_connected(s DIFF t)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[EMPTY_DIFF; PATH_CONNECTED_EMPTY] THEN + MATCH_MP_TAC PATH_CONNECTED_OPEN_IN_DIFF_CARD_LT THEN + ASM_REWRITE_TAC[COLLINEAR_AFF_DIM] THEN + ASM_SIMP_TAC[AFFINE_HULL_OPEN; AFF_DIM_OPEN] THEN + ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN + ASM_ARITH_TAC);; + +let CONNECTED_OPEN_DIFF_CARD_LT = prove + (`!s t:real^N->bool. + 2 <= dimindex(:N) /\ open s /\ connected s /\ t <_c (:real) + ==> connected(s DIFF t)`, + SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_CARD_LT; PATH_CONNECTED_IMP_CONNECTED]);; + +let PATH_CONNECTED_OPEN_DIFF_COUNTABLE = prove + (`!s t:real^N->bool. + 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t + ==> path_connected(s DIFF t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_CARD_LT THEN + ASM_REWRITE_TAC[GSYM CARD_NOT_LE] THEN + ASM_MESON_TAC[UNCOUNTABLE_REAL; CARD_LE_COUNTABLE]);; + +let CONNECTED_OPEN_DIFF_COUNTABLE = prove + (`!s t:real^N->bool. + 2 <= dimindex(:N) /\ open s /\ connected s /\ COUNTABLE t + ==> connected(s DIFF t)`, + SIMP_TAC[PATH_CONNECTED_OPEN_DIFF_COUNTABLE; PATH_CONNECTED_IMP_CONNECTED]);; + +let PATH_CONNECTED_OPEN_DELETE = prove + (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s + ==> path_connected(s DELETE a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN + MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN + ASM_REWRITE_TAC[COUNTABLE_SING]);; + +let CONNECTED_OPEN_DELETE = prove + (`!s a:real^N. 2 <= dimindex(:N) /\ open s /\ connected s + ==> connected(s DELETE a)`, + SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; PATH_CONNECTED_IMP_CONNECTED]);; + +let PATH_CONNECTED_PUNCTURED_UNIVERSE = prove + (`!a. 2 <= dimindex(:N) ==> path_connected((:real^N) DIFF {a})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_OPEN_DIFF_COUNTABLE THEN + ASM_REWRITE_TAC[OPEN_UNIV; CONNECTED_UNIV; COUNTABLE_SING]);; + +let CONNECTED_PUNCTURED_UNIVERSE = prove + (`!a. 2 <= dimindex(:N) ==> connected((:real^N) DIFF {a})`, + SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE; PATH_CONNECTED_IMP_CONNECTED]);; + +let PATH_CONNECTED_PUNCTURED_BALL = prove + (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(ball(a,r) DELETE a)`, + SIMP_TAC[PATH_CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);; + +let CONNECTED_PUNCTURED_BALL = prove + (`!a:real^N r. 2 <= dimindex(:N) ==> connected(ball(a,r) DELETE a)`, + SIMP_TAC[CONNECTED_OPEN_DELETE; OPEN_BALL; CONNECTED_BALL]);; + +let PATH_CONNECTED_SPHERE = prove + (`!a:real^N r. 2 <= dimindex(:N) ==> path_connected(sphere(a,r))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[sphere; dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN + GEOM_ORIGIN_TAC `a:real^N` THEN GEN_TAC THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN DISCH_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) + THENL + [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm(x:real^N) = r)`] THEN + REWRITE_TAC[EMPTY_GSPEC; PATH_CONNECTED_EMPTY]; + ASM_REWRITE_TAC[NORM_EQ_0; SING_GSPEC; PATH_CONNECTED_SING]; + SUBGOAL_THEN + `{x:real^N | norm x = r} = + IMAGE (\x. r / norm x % x) ((:real^N) DIFF {vec 0})` + SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM; IN_DIFF; IN_SING; IN_UNIV] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; + NORM_EQ_0; REAL_ARITH `&0 < r ==> abs r = r`] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN + ASM_MESON_TAC[NORM_0; REAL_LT_IMP_NZ]; + MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[PATH_CONNECTED_PUNCTURED_UNIVERSE] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + REWRITE_TAC[o_DEF; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN + DISCH_TAC THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_CMUL THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_WITHIN_INV) THEN + ASM_REWRITE_TAC[NORM_EQ_0] THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]]]);; + +let CONNECTED_SPHERE = prove + (`!a:real^N r. 2 <= dimindex(:N) ==> connected(sphere(a,r))`, + SIMP_TAC[PATH_CONNECTED_SPHERE; PATH_CONNECTED_IMP_CONNECTED]);; + +let CONNECTED_SPHERE_EQ = prove + (`!a:real^N r. connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`, + let lemma = prove + (`!a:real^1 r. &0 < r + ==> ?x y. ~(x = y) /\ dist(a,x) = r /\ dist(a,y) = r`, + MP_TAC SPHERE_1 THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_SPHERE; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(MESON[] + `~(a = b) ==> ?x y. ~(x = y) /\ (x = a \/ x = b) /\ (y = a \/ y = b)`) THEN + REWRITE_TAC[VECTOR_ARITH `a - r:real^1 = a + r <=> r = vec 0`] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; LIFT_DROP] THEN ASM_REAL_ARITH_TAC) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[SPHERE_EMPTY; CONNECTED_EMPTY; REAL_LT_IMP_LE] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; REAL_LE_REFL; CONNECTED_SING] THEN + SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[GSYM REAL_NOT_LT]] THEN + EQ_TAC THEN SIMP_TAC[CONNECTED_SPHERE] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_FINITE_IFF_SING) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DIMINDEX_1] THEN + DISCH_TAC THEN FIRST_ASSUM (fun th -> + REWRITE_TAC[GEOM_EQUAL_DIMENSION_RULE th FINITE_SPHERE_1]) THEN + REWRITE_TAC[SET_RULE + `~(s = {} \/ ?a. s = {a}) <=> ?x y. ~(x = y) /\ x IN s /\ y IN s`] THEN + REWRITE_TAC[IN_SPHERE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o C GEOM_EQUAL_DIMENSION_RULE lemma) THEN + ASM_REWRITE_TAC[]);; + +let PATH_CONNECTED_SPHERE_EQ = prove + (`!a:real^N r. path_connected(sphere(a,r)) <=> 2 <= dimindex(:N) \/ r <= &0`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[GSYM CONNECTED_SPHERE_EQ; PATH_CONNECTED_IMP_CONNECTED]; + STRIP_TAC THEN ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]] THEN + ASM_CASES_TAC `r < &0` THEN + ASM_SIMP_TAC[SPHERE_EMPTY; PATH_CONNECTED_EMPTY] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; PATH_CONNECTED_SING] THEN + ASM_REAL_ARITH_TAC);; + +let FINITE_SPHERE = prove + (`!a:real^N r. FINITE(sphere(a,r)) <=> r <= &0 \/ dimindex(:N) = 1`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THEN + ASM_REWRITE_TAC[] THENL + [RULE_ASSUM_TAC(REWRITE_RULE[GSYM DIMINDEX_1]) THEN + FIRST_ASSUM(MATCH_ACCEPT_TAC o C PROVE_HYP + (GEOM_EQUAL_DIMENSION_RULE(ASSUME `dimindex(:N) = dimindex(:1)`) + FINITE_SPHERE_1)); + ASM_SIMP_TAC[CONNECTED_SPHERE; ARITH_RULE `2 <= n <=> 1 <= n /\ ~(n = 1)`; + DIMINDEX_GE_1; CONNECTED_FINITE_IFF_SING] THEN + REWRITE_TAC[SET_RULE `(s = {} \/ ?a. s = {a}) <=> + (!a b. a IN s /\ b IN s ==> a = b)`] THEN + SIMP_TAC[IN_SPHERE] THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] VECTOR_CHOOSE_DIST) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `a - (x - a):real^N`]) THEN + FIRST_X_ASSUM(K ALL_TAC o check (is_neg o concl)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH]);; + +let LIMIT_POINT_OF_SPHERE = prove + (`!a r x:real^N. x limit_point_of sphere(a,r) <=> + &0 < r /\ 2 <= dimindex(:N) /\ x IN sphere(a,r)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(sphere(a:real^N,r))` THENL + [ASM_SIMP_TAC[LIMIT_POINT_FINITE]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[FINITE_SPHERE]) THEN + REWRITE_TAC[DE_MORGAN_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_NOT_LE; ARITH; REAL_NOT_LT] THEN + ASM_SIMP_TAC[GSYM REAL_NOT_LE; DIMINDEX_GE_1; + ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN + EQ_TAC THEN REWRITE_TAC[REWRITE_RULE[CLOSED_LIMPT] CLOSED_SPHERE] THEN + DISCH_TAC THEN MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN + ASM_SIMP_TAC[CONNECTED_SPHERE_EQ; DIMINDEX_GE_1; + ARITH_RULE `1 <= n ==> (2 <= n <=> ~(n = 1))`] THEN + ASM_MESON_TAC[FINITE_SING]);; + +let CARD_EQ_SPHERE = prove + (`!a:real^N r. 2 <= dimindex(:N) /\ &0 < r ==> sphere(a,r) =_c (:real)`, + SIMP_TAC[CONNECTED_CARD_EQ_IFF_NONTRIVIAL; CONNECTED_SPHERE] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[FINITE_SING; FINITE_SPHERE; REAL_NOT_LE; DE_MORGAN_THM] THEN + ASM_ARITH_TAC);; + +let PATH_CONNECTED_ANNULUS = prove + (`(!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\ + (!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> path_connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\ + (!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\ + (!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> path_connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`, + let lemma = prove + (`!a:real^N P. + 2 <= dimindex(:N) /\ path_connected {lift r | &0 <= r /\ P r} + ==> path_connected {x | P(norm(x - a))}`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:real^N | P(norm(x))} = + IMAGE (\z. drop(fstcart z) % sndcart z) + {pastecart x y | x IN {lift x | &0 <= x /\ P x} /\ + y IN {y | norm y = &1}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART] THEN + X_GEN_TAC `z:real^N` THEN REWRITE_TAC[EXISTS_LIFT; LIFT_DROP] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IMAGE_ID] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[real_abs] THEN ASM_CASES_TAC `z:real^N = vec 0` THENL + [MAP_EVERY EXISTS_TAC [`&0`; `basis 1:real^N`] THEN + ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_LZERO] THEN + ASM_MESON_TAC[NORM_0; REAL_ABS_NUM; REAL_LE_REFL]; + MAP_EVERY EXISTS_TAC [`norm(z:real^N)`; `inv(norm z) % z:real^N`] THEN + ASM_SIMP_TAC[REAL_ABS_NORM; NORM_MUL; VECTOR_MUL_ASSOC; VECTOR_MUL_LID; + NORM_POS_LE; REAL_ABS_INV; REAL_MUL_RINV; REAL_MUL_LINV; NORM_EQ_0]]; + MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; + REWRITE_TAC[GSYM PCROSS] THEN + MATCH_MP_TAC PATH_CONNECTED_PCROSS THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[NORM_ARITH `norm y = norm(y - vec 0:real^N)`] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + REWRITE_TAC[REWRITE_RULE[dist] (GSYM sphere)] THEN + ASM_SIMP_TAC[PATH_CONNECTED_SPHERE]]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `a:real^N` lemma) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONVEX_IMP_PATH_CONNECTED THEN + MATCH_MP_TAC IS_INTERVAL_CONVEX THEN + REWRITE_TAC[is_interval] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; FORALL_1; DIMINDEX_1] THEN + REWRITE_TAC[IN_ELIM_THM; GSYM drop] THEN REAL_ARITH_TAC);; + +let CONNECTED_ANNULUS = prove + (`(!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> connected {x | r1 < norm(x - a) /\ norm(x - a) < r2}) /\ + (!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> connected {x | r1 < norm(x - a) /\ norm(x - a) <= r2}) /\ + (!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2}) /\ + (!a:real^N r1 r2. + 2 <= dimindex(:N) + ==> connected {x | r1 <= norm(x - a) /\ norm(x - a) < r2})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PATH_CONNECTED_IMP_CONNECTED THEN + ASM_SIMP_TAC[PATH_CONNECTED_ANNULUS]);; + +let PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove + (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s + ==> path_connected((:real^N) DIFF s)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[DIFF_EMPTY; CONVEX_IMP_PATH_CONNECTED; CONVEX_UNIV] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(x:real^N = a) /\ ~(y = a)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `bounded((x:real^N) INSERT y INSERT s)` MP_TAC THENL + [ASM_REWRITE_TAC[BOUNDED_INSERT]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + REWRITE_TAC[INSERT_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC PATH_COMPONENT_TRANS THEN + ABBREV_TAC `C = (B / norm(x - a:real^N))` THEN + EXISTS_TAC `a + C % (x - a):real^N` THEN CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN + REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % x + u % (a + B % (x - a)):real^N = + a + (&1 + (B - &1) * u) % (x - a)`] THEN + X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + DISCH_THEN(MP_TAC o SPECL + [`a:real^N`; `a + (&1 + (C - &1) * u) % (x - a):real^N`; + `&1 / (&1 + (C - &1) * u)`]) THEN + SUBGOAL_THEN `&1 <= &1 + (C - &1) * u` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[REAL_SUB_LE] THEN + EXPAND_TAC "C" THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(x - a) = norm(a - x)`]; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP + (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN + ASM_REWRITE_TAC[NOT_IMP] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ; + REAL_MUL_LID] THEN + ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL; + REAL_LT_IMP_NZ] THEN + UNDISCH_TAC `~((x:real^N) IN s)` THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC PATH_COMPONENT_SYM THEN + MATCH_MP_TAC PATH_COMPONENT_TRANS THEN + ABBREV_TAC `D = (B / norm(y - a:real^N))` THEN + EXISTS_TAC `a + D % (y - a):real^N` THEN CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONNECTED_LINEPATH THEN + REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - u) % y + u % (a + B % (y - a)):real^N = + a + (&1 + (B - &1) * u) % (y - a)`] THEN + X_GEN_TAC `u:real` THEN STRIP_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + DISCH_THEN(MP_TAC o SPECL + [`a:real^N`; `a + (&1 + (D - &1) * u) % (y - a):real^N`; + `&1 / (&1 + (D - &1) * u)`]) THEN + SUBGOAL_THEN `&1 <= &1 + (D - &1) * u` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[REAL_SUB_LE] THEN + EXPAND_TAC "D" THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL; dist]) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_ARITH `&1 * norm(y - a) = norm(a - y)`]; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP + (REAL_ARITH `&1 <= a ==> &0 < a`))] THEN + ASM_REWRITE_TAC[NOT_IMP] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE; REAL_LE_LDIV_EQ; + REAL_MUL_LID] THEN + ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; REAL_DIV_RMUL; + REAL_LT_IMP_NZ] THEN + UNDISCH_TAC `~((y:real^N) IN s)` THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC PATH_COMPONENT_OF_SUBSET THEN + EXISTS_TAC `{x:real^N | norm(x - a) = B}` THEN CONJ_TAC THENL + [UNDISCH_TAC `s SUBSET ball(a:real^N,B)` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF; IN_UNIV; IN_BALL; dist] THEN + MESON_TAC[NORM_SUB; REAL_LT_REFL]; + MP_TAC(ISPECL [`a:real^N`; `B:real`] PATH_CONNECTED_SPHERE) THEN + REWRITE_TAC[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] THEN + ASM_REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_ELIM_THM; VECTOR_ADD_SUB; NORM_MUL] THEN + MAP_EVERY EXPAND_TAC ["C"; "D"] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let CONNECTED_COMPLEMENT_BOUNDED_CONVEX = prove + (`!s. 2 <= dimindex(:N) /\ bounded s /\ convex s + ==> connected((:real^N) DIFF s)`, + SIMP_TAC[PATH_CONNECTED_IMP_CONNECTED; + PATH_CONNECTED_COMPLEMENT_BOUNDED_CONVEX]);; + +let CONNECTED_DIFF_BALL = prove + (`!s a:real^N r. + 2 <= dimindex(:N) /\ connected s /\ cball(a,r) SUBSET s + ==> connected(s DIFF ball(a,r))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_DIFF_OPEN_FROM_CLOSED THEN + EXISTS_TAC `cball(a:real^N,r)` THEN + ASM_REWRITE_TAC[OPEN_BALL; CLOSED_CBALL; BALL_SUBSET_CBALL] THEN + REWRITE_TAC[CBALL_DIFF_BALL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + ASM_SIMP_TAC[CONNECTED_SPHERE]);; + +let PATH_CONNECTED_DIFF_BALL = prove + (`!s a:real^N r. + 2 <= dimindex(:N) /\ path_connected s /\ cball(a,r) SUBSET s + ==> path_connected(s DIFF ball(a,r))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `ball(a:real^N,r) = {}` THEN + ASM_SIMP_TAC[DIFF_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[BALL_EQ_EMPTY; REAL_NOT_LE]) THEN + REWRITE_TAC[path_connected] THEN + FIRST_ASSUM(MP_TAC o SPEC `a:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_LT_IMP_LE] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + DISCH_THEN(fun th -> + MP_TAC(SPECL [`x:real^N`; `a:real^N`] th) THEN + MP_TAC(SPECL [`y:real^N`; `a:real^N`] th)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g2:real^1->real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g1:real^1->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`g2:real^1->real^N`; `(:real^N) DIFF ball(a,r)`] + EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN + MP_TAC(ISPECL [`g1:real^1->real^N`; `(:real^N) DIFF ball(a,r)`] + EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + ASM_SIMP_TAC[FRONTIER_COMPLEMENT; INTERIOR_COMPLEMENT; CLOSURE_BALL] THEN + ASM_SIMP_TAC[FRONTIER_BALL; IN_SPHERE] THEN + X_GEN_TAC `h1:real^1->real^N` THEN STRIP_TAC THEN + X_GEN_TAC `h2:real^1->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] PATH_CONNECTED_SPHERE) THEN + ASM_REWRITE_TAC[path_connected] THEN + DISCH_THEN(MP_TAC o SPECL + [`pathfinish h1:real^N`; `pathfinish h2:real^N`]) THEN + ASM_SIMP_TAC[IN_SPHERE] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^1->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `h1 ++ h ++ reversepath h2:real^1->real^N` THEN + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; PATHSTART_REVERSEPATH; + PATHFINISH_REVERSEPATH; PATH_JOIN; PATH_REVERSEPATH; + PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN + REWRITE_TAC[UNION_SUBSET] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + UNDISCH_TAC `cball(a:real^N,r) SUBSET s` THEN + SIMP_TAC[SUBSET; IN_CBALL; IN_SPHERE; IN_BALL; IN_DIFF] THEN + MESON_TAC[REAL_LE_REFL; REAL_LT_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET t /\ s INTER u = {} ==> s SUBSET t DIFF u`) THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s DELETE a SUBSET (UNIV DIFF t) ==> ~(a IN u) /\ u SUBSET t + ==> s INTER u = {}`)) THEN + ASM_REWRITE_TAC[BALL_SUBSET_CBALL; IN_BALL; REAL_LT_REFL]);; + +let CONNECTED_OPEN_DIFF_CBALL = prove + (`!s a:real^N r. + 2 <= dimindex (:N) /\ open s /\ connected s /\ cball(a,r) SUBSET s + ==> connected(s DIFF cball(a,r))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `cball(a:real^N,r) = {}` THEN ASM_REWRITE_TAC[DIFF_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[CBALL_EQ_EMPTY; REAL_NOT_LT]) THEN + SUBGOAL_THEN `?r'. r < r' /\ cball(a:real^N,r') SUBSET s` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `s = (:real^N)` THENL + [EXISTS_TAC `r + &1` THEN ASM_SIMP_TAC[SUBSET_UNIV] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`] + SETDIST_POS_LE) THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN + ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; GSYM OPEN_CLOSED; + COMPACT_CBALL; CBALL_EQ_EMPTY] THEN + ASM_REWRITE_TAC[SET_RULE `UNIV DIFF s = {} <=> s = UNIV`] THEN + ASM_SIMP_TAC[SET_RULE `b INTER (UNIV DIFF s) = {} <=> b SUBSET s`; + REAL_ARITH `&0 <= r ==> ~(r < &0)`] THEN + STRIP_TAC THEN + EXISTS_TAC `r + setdist(cball(a,r),(:real^N) DIFF s) / &2` THEN + ASM_REWRITE_TAC[REAL_LT_ADDR; REAL_HALF; SUBSET; IN_CBALL] THEN + X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `x:real^N = a` THENL + [ASM_MESON_TAC[SUBSET; DIST_REFL; IN_CBALL]; ALL_TAC] THEN + ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[REAL_NOT_LE] THEN + MP_TAC(ISPECL [`cball(a:real^N,r)`; `(:real^N) DIFF s`; + `a + r / dist(a,x) % (x - a):real^N`; `x:real^N`] + SETDIST_LE_DIST) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; ONCE_REWRITE_RULE[DIST_SYM] dist; + REAL_ABS_NORM; REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REWRITE_TAC[REAL_ARITH `abs r <= r <=> &0 <= r`] THEN + REWRITE_TAC[NORM_MUL; VECTOR_ARITH + `x - (a + d % (x - a)):real^N = (&1 - d) % (x - a)`] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_NORM; REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[SUBSET]) THEN + ASM_REWRITE_TAC[IN_CBALL; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + REAL_ARITH_TAC; + SUBGOAL_THEN `s DIFF cball(a:real^N,r) = + s DIFF ball(a,r') UNION + {x | r < norm(x - a) /\ norm(x - a) <= r'}` + SUBST1_TAC THENL + [REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE + `b' SUBSET c' /\ c' SUBSET s /\ c SUBSET b' + ==> s DIFF c = (s DIFF b') UNION {x | ~(x IN c) /\ x IN c'}`) THEN + ASM_REWRITE_TAC[BALL_SUBSET_CBALL] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CONNECTED_UNION THEN + ASM_SIMP_TAC[CONNECTED_ANNULUS; PATH_CONNECTED_DIFF_BALL; + PATH_CONNECTED_IMP_CONNECTED; CONNECTED_OPEN_PATH_CONNECTED] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] (GSYM dist)] THEN + REWRITE_TAC[GSYM REAL_NOT_LE; GSYM IN_CBALL] THEN MATCH_MP_TAC(SET_RULE + `c' SUBSET s /\ (?x. x IN c' /\ ~(x IN b') /\ ~(x IN c)) + ==> ~((s DIFF b') INTER {x | ~(x IN c) /\ x IN c'} = {})`) THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `a + r' % basis 1:real^N` THEN + REWRITE_TAC[IN_BALL; IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of unbounded components. *) +(* ------------------------------------------------------------------------- *) + +let COBOUNDED_UNBOUNDED_COMPONENT = prove + (`!s. bounded((:real^N) DIFF s) + ==> ?x. x IN s /\ ~bounded(connected_component s x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B % basis 1:real^N` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `B % basis 1:real^N` o + GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_UNIV; IN_DIFF; IN_BALL_0] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> ~(abs B * &1 < B)`]; + MP_TAC(ISPECL [`basis 1:real^N`; `B:real`] BOUNDED_HALFSPACE_GE) THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + SIMP_TAC[CONVEX_HALFSPACE_GE; CONVEX_CONNECTED] THEN + ASM_SIMP_TAC[IN_ELIM_THM; DOT_RMUL; DOT_BASIS_BASIS; DIMINDEX_GE_1; + LE_REFL; real_ge; REAL_MUL_RID; REAL_LE_REFL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `UNIV DIFF s SUBSET b ==> (!x. x IN h ==> ~(x IN b)) ==> h SUBSET s`)) THEN + SIMP_TAC[IN_ELIM_THM; DOT_BASIS; IN_BALL_0; DIMINDEX_GE_1; LE_REFL] THEN + GEN_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= n ==> b <= x ==> b <= n`) THEN + SIMP_TAC[COMPONENT_LE_NORM; DIMINDEX_GE_1; LE_REFL]]);; + +let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT = prove + (`!s x y:real^N. + 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ + ~bounded(connected_component s x) /\ + ~bounded(connected_component s y) + ==> connected_component s x = connected_component s y`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `ball(vec 0:real^N,B)` CONNECTED_COMPLEMENT_BOUNDED_CONVEX) THEN + ASM_REWRITE_TAC[BOUNDED_BALL; CONVEX_BALL] THEN DISCH_TAC THEN + MAP_EVERY + (MP_TAC o SPEC `B:real` o REWRITE_RULE[bounded; NOT_EXISTS_THM] o ASSUME) + [`~bounded(connected_component s (y:real^N))`; + `~bounded(connected_component s (x:real^N))`] THEN + REWRITE_TAC[NOT_FORALL_THM; IN; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `x':real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `y':real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN REWRITE_TAC[IN] THEN + SUBGOAL_THEN `connected_component s (x':real^N) (y':real^N)` ASSUME_TAC THENL + [REWRITE_TAC[connected_component] THEN + EXISTS_TAC `(:real^N) DIFF ball (vec 0,B)` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV]] THEN + REWRITE_TAC[IN_BALL_0] THEN ASM_MESON_TAC[REAL_LT_IMP_LE]; + ASM_MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]]);; + +let COBOUNDED_UNBOUNDED_COMPONENTS = prove + (`!s. bounded ((:real^N) DIFF s) ==> ?c. c IN components s /\ ~bounded c`, + REWRITE_TAC[components; EXISTS_IN_GSPEC; COBOUNDED_UNBOUNDED_COMPONENT]);; + +let COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS = prove + (`!s c c'. + 2 <= dimindex(:N) /\ + bounded ((:real^N) DIFF s) /\ + c IN components s /\ ~bounded c /\ + c' IN components s /\ ~bounded c' + ==> c' = c`, + REWRITE_TAC[components; IN_ELIM_THM] THEN + MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT]);; + +let COBOUNDED_HAS_BOUNDED_COMPONENT = prove + (`!s. 2 <= dimindex(:N) /\ bounded((:real^N) DIFF s) /\ ~connected s + ==> ?c. c IN components s /\ bounded c`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c c':real^N->bool. c IN components s /\ c' IN components s /\ ~(c = c')` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ ~(?a. s = {a}) ==> ?x y. x IN s /\ y IN s /\ ~(x = y)`) THEN + ASM_REWRITE_TAC[COMPONENTS_EQ_SING_EXISTS; COMPONENTS_EQ_EMPTY] THEN + ASM_MESON_TAC[DIFF_EMPTY; NOT_BOUNDED_UNIV]; + ASM_MESON_TAC[COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS]]);; + +(* ------------------------------------------------------------------------- *) +(* Self-homeomorphisms shuffling points about in various ways. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHISM_MOVING_POINT_EXISTS = prove + (`!s t a b:real^N. + open_in (subtopology euclidean (affine hull s)) s /\ + s SUBSET t /\ t SUBSET affine hull s /\ + connected s /\ a IN s /\ b IN s + ==> ?f g. homeomorphism (t,t) (f,g) /\ f a = b /\ + {x | ~(f x = x /\ g x = x)} SUBSET s /\ + bounded {x | ~(f x = x /\ g x = x)}`, + let lemma1 = prove + (`!a t r u:real^N. + affine t /\ a IN t /\ u IN ball(a,r) INTER t + ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t) + (f,g) /\ + f(a) = u /\ (!x. x IN sphere(a,r) ==> f(x) = x)`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL + [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; ALL_TAC] THEN + EXISTS_TAC `\x:real^N. (&1 - norm(x - a) / r) % (u - a) + x` THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN + ASM_SIMP_TAC[COMPACT_INTER_CLOSED; COMPACT_CBALL; CLOSED_AFFINE]; + ASM_SIMP_TAC[IN_SPHERE; ONCE_REWRITE_RULE[NORM_SUB] dist; + REAL_DIV_REFL; REAL_LT_IMP_NZ; IN_INTER] THEN + REWRITE_TAC[real_div; VECTOR_SUB_REFL; NORM_0; REAL_MUL_LZERO] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN + SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x IN s) /\ (!y. y IN s ==> ?x. x IN s /\ f x = y) + ==> IMAGE f s = s`) THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `(&1 - n) % (u - a) + x:real^N = a + (&1 - n) % (u - a) + (x - a)`]; + ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN GEOM_ORIGIN_TAC `a:real^N` THEN + REWRITE_TAC[IN_BALL_0; VECTOR_SUB_RZERO; IN_CBALL_0; IN_INTER] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID; + VECTOR_ARITH `a + x:real^N = a + y <=> x = y`; + VECTOR_ARITH `(&1 - n) % u + a + x = (&1 - m) % u + a + y <=> + (n - m) % u:real^N = x - y`] THEN + REWRITE_TAC[REAL_ARITH `x / r - y / r:real = (x - y) / r`] THENL + [ALL_TAC; + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `norm(x:real^N) = norm(y:real^N)` THEN + ASM_REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO; VECTOR_MUL_LZERO; + VECTOR_ARITH `vec 0:real^N = x - y <=> x = y`] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:real^N->real`) THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `r = norm(x - y:real^N) ==> r < abs(norm x - norm y) * &1 ==> F`)) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LT_LMUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ONCE_REWRITE_TAC[REAL_MUL_SYM]] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < r ==> &0 < abs r`] THEN + ASM_REAL_ARITH_TAC] THEN + REPEAT GEN_TAC THEN + ASM_CASES_TAC `subspace(t:real^N->bool)` THENL + [ALL_TAC; ASM_MESON_TAC[AFFINE_IMP_SUBSPACE]] THEN + ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `norm(x) + norm(y) <= &1 * r ==> norm(x + y:real^N) <= r`) THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_LDIV_EQ; REAL_ARITH + `(a * u + x) / r:real = a * u / r + x / r`] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= &1 /\ a <= abs(&1 - x) * &1 ==> a + x <= &1`) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\a. lift((&1 - drop a) * r - norm(y - drop a % u:real^N))`; + `vec 0:real^1`; `vec 1:real^1`; `&0`; `1`] + IVT_DECREASING_COMPONENT_1) THEN + REWRITE_TAC[DIMINDEX_1; GSYM drop; LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[REAL_POS; LE_REFL; REAL_SUB_REFL; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO; VECTOR_SUB_RZERO; REAL_MUL_LID] THEN + REWRITE_TAC[NORM_ARITH `&0 * r - norm(x:real^N) <= &0`] THEN + ASM_REWRITE_TAC[REAL_SUB_LE; GSYM EXISTS_DROP; IN_INTERVAL_1] THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `(&1 - x) * r - b:real = r - r * x - b`] THEN + REWRITE_TAC[LIFT_SUB; LIFT_CMUL; LIFT_DROP] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THEN + REWRITE_TAC[CONTINUOUS_CONST]) THEN + SIMP_TAC[CONTINUOUS_CMUL; CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_AT_ID; CONTINUOUS_CONST]; + + ASM_SIMP_TAC[DROP_VEC; REAL_FIELD + `&0 < r ==> ((&1 - x) * r - n = &0 <=> &1 - n / r = x)`] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `y - a % u:real^N` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]) in + let lemma2 = prove + (`!a t u v:real^N r. + affine t /\ a IN t /\ + u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t + ==> ?f g. homeomorphism (cball(a,r) INTER t,cball(a,r) INTER t) + (f,g) /\ f(u) = v /\ + !x. x IN sphere(a,r) /\ x IN t ==> f(x) = x`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `r <= &0 \/ &0 < r`) THENL + [ASM_MESON_TAC[BALL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY]; + REPLICATE_TAC 2 (DISCH_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_TAC] THEN + MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `r:real`] lemma1) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> + FIRST_ASSUM(CONJUNCTS_THEN(MP_TAC o MATCH_MP th))) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN + STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN + STRIP_TAC THEN + EXISTS_TAC `(f1:real^N->real^N) o (g2:real^N->real^N)` THEN + EXISTS_TAC `(f2:real^N->real^N) o (g1:real^N->real^N)` THEN + REWRITE_TAC[o_THM; SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_COMPOSE THEN ASM_MESON_TAC[HOMEOMORPHISM_SYM]; + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; IN_INTER]) THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`a:real^N`; `r:real`] CENTRE_IN_CBALL) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM SET_TAC[]; + MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN + ASM SET_TAC[]]]) in + let lemma3 = prove + (`!a t u v:real^N r s. + affine t /\ a IN t /\ ball(a,r) INTER t SUBSET s /\ s SUBSET t /\ + u IN ball(a,r) INTER t /\ v IN ball(a,r) INTER t + ==> ?f g. homeomorphism (s,s) (f,g) /\ f(u) = v /\ + {x | ~(f x = x /\ g x = x)} SUBSET ball(a,r) INTER t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `t:real^N->bool`; `u:real^N`; `v:real^N`; + `r:real`] lemma2) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then f x else x` THEN + EXISTS_TAC `\x:real^N. if x IN ball(a,r) INTER t then g x else x` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN + REWRITE_TAC[HOMEOMORPHISM; SUBSET; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(!x:real^N. x IN ball(a,r) INTER t ==> f x IN ball(a,r)) /\ + (!x:real^N. x IN ball(a,r) INTER t ==> g x IN ball(a,r))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN ASM SET_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[IN_INTER] THEN REPEAT CONJ_TAC THEN + TRY(X_GEN_TAC `x:real^N` THEN + ASM_CASES_TAC `x IN ball(a:real^N,r)` THEN ASM_SIMP_TAC[] THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[]) THEN + ASM SET_TAC[]) THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(cball(a,r) INTER t) UNION + ((t:real^N->bool) DIFF ball(a,r))` THEN + (CONJ_TAC THENL + [ALL_TAC; + MP_TAC(ISPECL [`a:real^N`; `r:real`] BALL_SUBSET_CBALL) THEN + ASM SET_TAC[]]) THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + ASM_SIMP_TAC[CLOSED_CBALL; CLOSED_DIFF; OPEN_BALL; CONTINUOUS_ON_ID; + GSYM IN_DIFF; CBALL_DIFF_BALL; CLOSED_AFFINE; CLOSED_INTER] THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] SPHERE_SUBSET_CBALL) THEN + MP_TAC(ISPECL [`a:real^N`; `r:real`] CBALL_DIFF_BALL) THEN + ASM SET_TAC[]) in + REWRITE_TAC[TAUT `p /\ q /\ r /\ s /\ t ==> u <=> + p /\ q /\ r /\ s ==> t ==> u`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ONCE_REWRITE_TAC[TAUT `p ==> q <=> p ==> p /\ q`] THEN + MATCH_MP_TAC CONNECTED_EQUIVALENCE_RELATION THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THEN X_GEN_TAC `a:real^N` THENL + [X_GEN_TAC `b:real^N` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^N->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^N` THEN + REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[TAUT `~(p /\ q) <=> ~(q /\ p)`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THEN ASM_REWRITE_TAC[]) + [`(a:real^N) IN s`; `(b:real^N) IN s`; `(c:real^N) IN s`] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f1:real^N->real^N`; `g1:real^N->real^N`] THEN + STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`f2:real^N->real^N`; `g2:real^N->real^N`] THEN + STRIP_TAC THEN + EXISTS_TAC `(f2:real^N->real^N) o (f1:real^N->real^N)` THEN + EXISTS_TAC `(g1:real^N->real^N) o (g2:real^N->real^N)` THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `{x | ~(f1 x = x /\ g1 x = x)} UNION + {x:real^N | ~(f2 x = x /\ g2 x = x)}` THEN + ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]; + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N` o CONJUNCT2) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s INTER ball(a:real^N,r)` THEN + ASM_SIMP_TAC[IN_INTER; CENTRE_IN_BALL; OPEN_IN_OPEN_INTER; OPEN_BALL] THEN + X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`a:real^N`; `affine hull s:real^N->bool`; + `a:real^N`; `b:real^N`; `r:real`; `t:real^N->bool`] + lemma3) THEN + ASM_SIMP_TAC[CENTRE_IN_BALL; AFFINE_AFFINE_HULL; HULL_INC; IN_INTER] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; INTER_SUBSET; SUBSET_TRANS]]);; + +let HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN = prove + (`!s t x (y:A->real^N) k. + &2 <= aff_dim s /\ open_in (subtopology euclidean (affine hull s)) s /\ + s SUBSET t /\ t SUBSET affine hull s /\ connected s /\ + FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\ + pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k + ==> ?f g. homeomorphism (t,t) (f,g) /\ + (!i. i IN k ==> f(x i) = y i) /\ + {x | ~(f x = x /\ g x = x)} SUBSET s /\ + bounded {x | ~(f x = x /\ g x = x)}`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `FINITE(k:A->bool)` THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`s:real^N->bool`,`s:real^N->bool`) THEN POP_ASSUM MP_TAC THEN + SPEC_TAC(`k:A->bool`,`k:A->bool`) THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + CONJ_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN + REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN + REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:A`; `k:A->bool`] THEN STRIP_TAC THEN + X_GEN_TAC `s:real^N->bool` THEN + REWRITE_TAC[PAIRWISE_INSERT; FORALL_IN_INSERT] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`s DIFF IMAGE (y:A->real^N) k`; `t:real^N->bool`; + `(f:real^N->real^N) ((x:A->real^N) i)`; `(y:A->real^N) i`] + HOMEOMORPHISM_MOVING_POINT_EXISTS) THEN + SUBGOAL_THEN + `affine hull (s DIFF (IMAGE (y:A->real^N) k)) = affine hull s` + SUBST1_TAC THENL + [MATCH_MP_TAC AFFINE_HULL_OPEN_IN THEN CONJ_TAC THENL + [TRANS_TAC OPEN_IN_TRANS `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[]; + + REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + FINITE_SUBSET)) THEN + ASM_SIMP_TAC[FINITE_IMAGE; CONNECTED_FINITE_IFF_SING] THEN + UNDISCH_TAC `&2 <= aff_dim(s:real^N->bool)` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; AFF_DIM_SING] THEN + CONV_TAC INT_REDUCE_CONV]; + ASM_REWRITE_TAC[]] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_IMP_CLOSED_IN THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; + ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_OPEN_IN_DIFF_CARD_LT THEN + ASM_REWRITE_TAC[COLLINEAR_AFF_DIM; + INT_ARITH `~(s:int <= &1) <=> &2 <= s`] THEN + MATCH_MP_TAC CARD_LT_FINITE_INFINITE THEN + ASM_SIMP_TAC[FINITE_IMAGE; real_INFINITE]; + ALL_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN REWRITE_TAC[IN_DIFF] THEN + (CONJ_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[IN_DIFF]]) THEN + SIMP_TAC[SET_RULE `~(y IN IMAGE f s) <=> !x. x IN s ==> ~(f x = y)`] THEN + ASM SET_TAC[]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(h:real^N->real^N) o (f:real^N->real^N)`; + `(g:real^N->real^N) o (k:real^N->real^N)`] THEN + CONJ_TAC THENL [ASM_MESON_TAC[HOMEOMORPHISM_COMPOSE]; ALL_TAC] THEN + ASM_SIMP_TAC[o_THM] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `{x | ~(f x = x /\ g x = x)} UNION + {x:real^N | ~(h x = x /\ k x = x)}` THEN + ASM_REWRITE_TAC[BOUNDED_UNION] THEN ASM SET_TAC[]]);; + +let HOMEOMORPHISM_MOVING_POINTS_EXISTS = prove + (`!s t x (y:A->real^N) k. + 2 <= dimindex(:N) /\ open s /\ connected s /\ s SUBSET t /\ + FINITE k /\ (!i. i IN k ==> x i IN s /\ y i IN s) /\ + pairwise (\i j. ~(x i = x j) /\ ~(y i = y j)) k + ==> ?f g. homeomorphism (t,t) (f,g) /\ + (!i. i IN k ==> f(x i) = y i) /\ + {x | ~(f x = x /\ g x = x)} SUBSET s /\ + bounded {x | ~(f x = x /\ g x = x)}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [STRIP_TAC THEN REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN + REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM; EMPTY_GSPEC] THEN + REWRITE_TAC[EMPTY_SUBSET; BOUNDED_EMPTY] THEN ASM SET_TAC[]; + STRIP_TAC] THEN + MATCH_MP_TAC HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SUBGOAL_THEN `affine hull s = (:real^N)` SUBST1_TAC THENL + [MATCH_MP_TAC AFFINE_HULL_OPEN THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; AFF_DIM_UNIV] THEN + ASM_REWRITE_TAC[INT_OF_NUM_LE; SUBSET_UNIV]]);; + +let HOMEOMORPHISM_GROUPING_POINTS_EXISTS = prove + (`!u s t k:real^N->bool. + open u /\ open s /\ connected s /\ ~(u = {}) /\ + FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t + ==> ?f g. homeomorphism (t,t) (f,g) /\ + {x | ~(f x = x /\ g x = x)} SUBSET s /\ + bounded {x | ~(f x = x /\ g x = x)} /\ + !x. x IN k ==> (f x) IN u`, + let lemma1 = prove + (`!a b:real^1 c d:real^1. + drop a < drop b /\ drop c < drop d + ==> ?f g. homeomorphism (interval[a,b],interval[c,d]) (f,g) /\ + f(a) = c /\ f(b) = d`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `\x. c + (drop x - drop a) / (drop b - drop a) % (d - c:real^1)` THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_LT; REAL_LT_IMP_NZ; + REAL_ARITH `(a - a) / x = &0`; LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + REWRITE_TAC[LIFT_CMUL; real_div; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; + REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_IMAGE] THEN + ASM_SIMP_TAC[GSYM DROP_EQ; DROP_ADD; DROP_CMUL; DROP_SUB; REAL_FIELD + `a < b /\ c < d + ==> (x = c + (y - a) / (b - a) * (d - c) <=> + a + (x - c) / (d - c) * (b - a) = y)`] THEN + REWRITE_TAC[GSYM EXISTS_DROP; UNWIND_THM1] THEN + REWRITE_TAC[REAL_ARITH + `c <= c + x /\ c + x <= d <=> &0 <= x /\ x <= &1 * (d - c)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_LE_RMUL_EQ; REAL_SUB_LT] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`; + REAL_FIELD `a < b ==> (x / (b - a) = y / (b - a) <=> x = y)`; + REAL_ARITH `x - a:real = y - a <=> x = y`; + VECTOR_MUL_RCANCEL; DROP_EQ; VECTOR_SUB_EQ] THEN + ASM_MESON_TAC[REAL_LT_REFL]]) in + let lemma2 = prove + (`!a b c:real^1 u v w:real^1 f1 g1 f2 g2. + homeomorphism (interval[a,b],interval[u,v]) (f1,g1) /\ + homeomorphism (interval[b,c],interval[v,w]) (f2,g2) + ==> b IN interval[a,c] /\ v IN interval[u,w] /\ + f1 a = u /\ f1 b = v /\ f2 b = v /\ f2 c = w + ==> ?f g. homeomorphism(interval[a,c],interval[u,w]) (f,g) /\ + f a = u /\ f c = w /\ + (!x. x IN interval[a,b] ==> f x = f1 x) /\ + (!x. x IN interval[b,c] ==> f x = f2 x)`, + REWRITE_TAC[IN_INTERVAL_1] THEN REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM + (STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism])) THEN + EXISTS_TAC `\x. if drop x <= drop b then (f1:real^1->real^1) x + else f2 x` THEN + ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; REAL_LE_REFL] THEN + ASM_SIMP_TAC[DROP_EQ; REAL_ARITH `b <= c ==> (c <= b <=> c = b)`] THEN + CONJ_TAC THENL [REWRITE_TAC[GSYM CONJ_ASSOC]; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN + REWRITE_TAC[COMPACT_INTERVAL] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID; DROP_EQ] THEN + CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_DROP; IN_ELIM_THM; IN_INTERVAL_1]; + SUBGOAL_THEN + `interval[a:real^1,c] = interval[a,b] UNION interval[b,c] /\ + interval[u:real^1,w] = interval[u,v] UNION interval[v,w]` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[IMAGE_UNION] THEN BINOP_TAC THEN FIRST_X_ASSUM(fun th -> + GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN + SIMP_TAC[IN_INTERVAL_1; REAL_ARITH + `b <= c ==> (c <= b <=> c = b)`] THEN + ASM_MESON_TAC[DROP_EQ]]; + REWRITE_TAC[FORALL_LIFT] THEN MATCH_MP_TAC REAL_WLOG_LT THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP; IN_INTERVAL_1] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN DISCH_TAC THEN + ASM_CASES_TAC `drop y <= drop b` THEN ASM_REWRITE_TAC[] THENL + [COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; REAL_NOT_LE]) THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LT_IMP_LE]] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(f1:real^1->real^1) x IN interval[u,v] INTER interval[v,w]` + MP_TAC THENL + [REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN ASM_REWRITE_TAC[IN_INTERVAL_1] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_INTER; IN_INTERVAL_1] THEN DISCH_THEN(MP_TAC o MATCH_MP + (REAL_ARITH `(a <= x /\ x <= b) /\ (b <= x /\ x <= c) ==> x = b`)) THEN + REWRITE_TAC[DROP_EQ] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(f1:real^1->real^1) x = f1 b /\ (f2:real^1->real^1) y = f2 b` + MP_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(MESON[] + `!g1:real^1->real^1 g2:real^1->real^1. + g1(f1 x) = x /\ g1(f1 b) = b /\ g2(f2 y) = y /\ g2(f2 b) = b + ==> f1 x = f1 b /\ f2 y = f2 b ==> x = y`) THEN + MAP_EVERY EXISTS_TAC [`g1:real^1->real^1`; `g2:real^1->real^1`] THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]) in + let lemma3 = prove + (`!a b c d u v:real^1. + interval[c,d] SUBSET interval(a,b) /\ + interval[u,v] SUBSET interval(a,b) /\ + ~(interval(c,d) = {}) /\ ~(interval(u,v) = {}) + ==> ?f g. homeomorphism (interval[a,b],interval[a,b]) (f,g) /\ + f a = a /\ f b = b /\ + !x. x IN interval[c,d] ==> f(x) IN interval[u,v]`, + REPEAT GEN_TAC THEN + REWRITE_TAC[SUBSET_INTERVAL_1; INTERVAL_NE_EMPTY_1] THEN + ASM_CASES_TAC `drop u < drop v` THEN + ASM_SIMP_TAC[REAL_ARITH `u < v ==> ~(v < u)`] THEN + ASM_CASES_TAC `interval[c:real^1,d] = {}` THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(EXISTS_TAC `I:real^1->real^1`) THEN + REWRITE_TAC[HOMEOMORPHISM_I; NOT_IN_EMPTY; I_THM]; + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY_1]) THEN + ASM_SIMP_TAC[REAL_ARITH `c <= d ==> ~(d < c)`] THEN STRIP_TAC] THEN + MP_TAC(ISPECL [`d:real^1`; `b:real^1`; `v:real^1`; `b:real^1`] lemma1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f3:real^1->real^1`; `g3:real^1->real^1`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`c:real^1`; `d:real^1`; `u:real^1`; `v:real^1`] lemma1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f2:real^1->real^1`; `g2:real^1->real^1`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`a:real^1`; `c:real^1`; `a:real^1`; `u:real^1`] lemma1) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f1:real^1->real^1`; `g1:real^1->real^1`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(fun th -> + ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC(MATCH_MP lemma2 th)) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f4:real^1->real^1`; `g4:real^1->real^1`] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC I [IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma2) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; REAL_LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[] THEN + DISCH_THEN(STRIP_ASSUME_TAC o CONJUNCT2) THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1]) THEN + SUBGOAL_THEN `drop a <= drop x` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[]]) in + let lemma4 = prove + (`!s k u t:real^1->bool. + open u /\ open s /\ connected s /\ ~(u = {}) /\ + FINITE k /\ k SUBSET s /\ u SUBSET s /\ s SUBSET t + ==> ?f g. homeomorphism (t,t) (f,g) /\ + (!x. x IN k ==> f(x) IN u) /\ + {x | ~(f x = x /\ g x = x)} SUBSET s /\ + bounded {x | ~(f x = x /\ g x = x)}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?c d:real^1. ~(interval(c,d) = {}) /\ interval[c,d] SUBSET u` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `open(u:real^1->bool)` THEN + REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^1`) THEN + DISCH_THEN(MP_TAC o SPEC `y:real^1`) THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?a b:real^1. ~(interval(a,b) = {}) /\ + k SUBSET interval[a,b] /\ + interval[a,b] SUBSET s` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `k:real^1->bool = {}` THENL + [ASM_MESON_TAC[SUBSET_TRANS; EMPTY_SUBSET]; ALL_TAC] THEN + MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_SUP) THEN + MP_TAC(SPEC `IMAGE drop k` COMPACT_ATTAINS_INF) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_EQ_EMPTY; + IMAGE_ID; FINITE_IMP_COMPACT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^1` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^1` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `open(s:real^1->bool)` THEN + REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `b:real^1`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`u:real^1`; `v:real^1`] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL_1] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`a:real^1`; `v:real^1`] THEN + REWRITE_TAC[INTERVAL_NE_EMPTY_1] THEN FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN + REWRITE_TAC[IS_INTERVAL_1] THEN + ASM_MESON_TAC[GSYM MEMBER_NOT_EMPTY; REAL_LET_TRANS; REAL_LE_TRANS; + REAL_LT_IMP_LE; SUBSET; REAL_LE_TOTAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `?w z:real^1. interval[w,z] SUBSET s /\ + interval[a,b] UNION interval[c,d] SUBSET interval(w,z)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `?w z:real^1. interval[w,z] SUBSET s /\ + interval[a,b] UNION interval[c,d] SUBSET interval[w,z]` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `lift(min (drop a) (drop c))` THEN + EXISTS_TAC `lift(max (drop b) (drop d))` THEN + REWRITE_TAC[UNION_SUBSET; SUBSET_INTERVAL_1; LIFT_DROP] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM IS_INTERVAL_CONNECTED_1]) THEN + REWRITE_TAC[IS_INTERVAL_1; SUBSET; IN_INTERVAL_1; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `lift(min (drop a) (drop c))` THEN + EXISTS_TAC `lift(max (drop b) (drop d))` THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN + REWRITE_TAC[real_min; real_max] THEN CONJ_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN + ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET; INTERVAL_EQ_EMPTY_1; + REAL_LT_IMP_LE]; + ASM_REAL_ARITH_TAC]; + UNDISCH_TAC `open(s:real^1->bool)` THEN + REWRITE_TAC[OPEN_CONTAINS_INTERVAL] THEN DISCH_THEN(fun th -> + MP_TAC(SPEC `z:real^1` th) THEN MP_TAC(SPEC `w:real^1` th)) THEN + SUBGOAL_THEN `(w:real^1) IN interval[w,z] /\ z IN interval[w,z]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[ENDS_IN_INTERVAL] THEN MP_TAC + (ISPECL [`a:real^1`; `b:real^1`] INTERVAL_OPEN_SUBSET_CLOSED) THEN + ASM SET_TAC[]; + REWRITE_TAC[UNION_SUBSET]] THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`w0:real^1`; `w1:real^1`] THEN + REWRITE_TAC[IN_INTERVAL_1; SUBSET] THEN STRIP_TAC THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`z0:real^1`; `z1:real^1`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`w0:real^1`; `z1:real^1`] THEN + RULE_ASSUM_TAC + (REWRITE_RULE[ENDS_IN_UNIT_INTERVAL; INTERVAL_NE_EMPTY_1; + UNION_SUBSET; SUBSET_INTERVAL_1]) THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_INTERVAL_1]) THEN + X_GEN_TAC `x:real^1` THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`)) THEN + ASM_CASES_TAC `(x:real^1) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [UNION_SUBSET]) THEN + MP_TAC(ISPECL + [`w:real^1`; `z:real^1`; `a:real^1`; `b:real^1`; `c:real^1`; `d:real^1`] + lemma3) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN + EXISTS_TAC `\x:real^1. if x IN interval[w,z] then f x else x` THEN + EXISTS_TAC `\x:real^1. if x IN interval[w,z] then g x else x` THEN + ASSUME_TAC(ISPECL [`w:real^1`; `z:real^1`]INTERVAL_OPEN_SUBSET_CLOSED) THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM SET_TAC[]; + ALL_TAC; + ASM SET_TAC[]; + ASM SET_TAC[]; + ALL_TAC; + ASM SET_TAC[]; + ASM SET_TAC[]; + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[w:real^1,z]` THEN + REWRITE_TAC[BOUNDED_INTERVAL] THEN ASM SET_TAC[]] THEN + (SUBGOAL_THEN + `t = interval[w:real^1,z] UNION (t DIFF interval(w,z))` + (fun th -> SUBST1_TAC th THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASSUME_TAC(SYM th)) + THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_SUBSET THEN REWRITE_TAC[CLOSED_INTERVAL] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + MATCH_MP_TAC OPEN_SUBSET THEN REWRITE_TAC[OPEN_INTERVAL] THEN + ASM SET_TAC[]; + REWRITE_TAC[CLOSED_DIFF_OPEN_INTERVAL_1; SET_RULE + `p /\ ~p \/ x IN t DIFF s /\ x IN u <=> x IN t /\ x IN u DIFF s`] THEN + MAP_EVERY (MP_TAC o ISPECL [`w:real^1`; `z:real^1`]) + (CONJUNCTS ENDS_IN_INTERVAL) THEN + ASM SET_TAC[]])) in + REPEAT STRIP_TAC THEN ASM_CASES_TAC `2 <= dimindex(:N)` THENL + [MP_TAC(ISPECL + [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN + ANTS_TAC THENL [ASM_MESON_TAC[FINITE_IMP_NOT_OPEN]; ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`; + `y:real^N->real^N`; `k:real^N->bool`] + HOMEOMORPHISM_MOVING_POINTS_EXISTS) THEN + ASM_REWRITE_TAC[pairwise] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_LE]) THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n < 2 <=> n = 1)`] THEN + REWRITE_TAC[GSYM DIMINDEX_1] THEN + DISCH_THEN(MP_TAC o MATCH_MP ISOMORPHISMS_UNIV_UNIV) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`IMAGE (h:real^N->real^1) s`; + `IMAGE (h:real^N->real^1) k`; + `IMAGE (h:real^N->real^1) u`; + `IMAGE (h:real^N->real^1) t`] + lemma4) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY; + CONNECTED_CONTINUOUS_IMAGE; LINEAR_CONTINUOUS_ON] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[OPEN_BIJECTIVE_LINEAR_IMAGE_EQ]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)`; + `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)`] THEN + ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_CONTINUOUS_ON] THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `{x | ~(j ((f:real^1->real^1) (h x)) = x /\ j (g (h x)) = x)} = + IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_SIMP_TAC[BOUNDED_LINEAR_IMAGE]]);; + +let HOMEOMORPHISM_GROUPING_POINTS_EXISTS_GEN = prove + (`!u s t k:real^N->bool. + open_in (subtopology euclidean (affine hull s)) s /\ + s SUBSET t /\ t SUBSET affine hull s /\ connected s /\ + FINITE k /\ k SUBSET s /\ + open_in (subtopology euclidean s) u /\ ~(u = {}) + ==> ?f g. homeomorphism (t,t) (f,g) /\ + (!x. x IN k ==> f(x) IN u) /\ + {x | ~(f x = x /\ g x = x)} SUBSET s /\ + bounded {x | ~(f x = x /\ g x = x)}`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&2 <= aff_dim(s:real^N->bool)` THENL + [MP_TAC(ISPECL + [`CARD(k:real^N->bool)`; `u:real^N->bool`] CHOOSE_SUBSET_STRONG) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[GSYM INFINITE] THEN + MATCH_MP_TAC INFINITE_OPEN_IN THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONNECTED_IMP_PERFECT_AFF_DIM THEN + ASM_SIMP_TAC[CONVEX_CONNECTED; AFFINE_AFFINE_HULL; AFFINE_IMP_CONVEX; + AFF_DIM_AFFINE_HULL] THEN + CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; + REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN MP_TAC + (ISPECL [`k:real^N->bool`; `p:real^N->bool`] CARD_EQ_BIJECTION) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^N->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `t:real^N->bool`; `\x:real^N. x`; + `y:real^N->real^N`; `k:real^N->bool`] + HOMEOMORPHISM_MOVING_POINTS_EXISTS_GEN) THEN + ASM_REWRITE_TAC[pairwise] THEN + REPEAT(FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INT_NOT_LE])] THEN + SIMP_TAC[AFF_DIM_GE; INT_ARITH + `--(&1):int <= x ==> (x < &2 <=> x = --(&1) \/ x = &0 \/ x = &1)`] THEN + REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EQ_0] THEN + SUBGOAL_THEN + `(u:real^N->bool) SUBSET s /\ s SUBSET affine hull s` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL [ASM SET_TAC[]; ALL_TAC] THEN + STRIP_TAC THENL + [REPEAT(EXISTS_TAC `I:real^N->real^N`) THEN + REWRITE_TAC[HOMEOMORPHISM_I; I_THM; EMPTY_GSPEC; BOUNDED_EMPTY] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`affine hull s:real^N->bool`; `(:real^1)`] + HOMEOMORPHIC_AFFINE_SETS) THEN + ASM_REWRITE_TAC[AFF_DIM_UNIV; AFFINE_AFFINE_HULL; AFFINE_UNIV] THEN + ASM_REWRITE_TAC[DIMINDEX_1; AFF_DIM_AFFINE_HULL] THEN + REWRITE_TAC[homeomorphic; homeomorphism; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^1`; `j:real^1->real^N`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`IMAGE (h:real^N->real^1) u`; `IMAGE (h:real^N->real^1) s`; + `IMAGE (h:real^N->real^1) t`; `IMAGE (h:real^N->real^1) k`] + HOMEOMORPHISM_GROUPING_POINTS_EXISTS) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_SUBSET; IMAGE_EQ_EMPTY] THEN + ANTS_TAC THENL + [MP_TAC(ISPECL + [`h:real^N->real^1`; `j:real^1->real^N`; + `affine hull s:real^N->bool`; `(:real^1)`] + HOMEOMORPHISM_IMP_OPEN_MAP) THEN + ASM_SIMP_TAC[homeomorphism; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN + REPEAT STRIP_TAC THENL [ASM_MESON_TAC[OPEN_IN_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; homeomorphism]] THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real^1`; `g:real^1->real^1`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`\x. if x IN affine hull s + then ((j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)) x + else x`; + `\x. if x IN affine hull s + then ((j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)) x + else x`] THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM_SIMP_TAC[SET_RULE + `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN + REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN + ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC + `(j:real^1->real^N) o (f:real^1->real^1) o (h:real^N->real^1)` THEN + REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]; + ASM_SIMP_TAC[SET_RULE + `t SUBSET s ==> IMAGE (\x. if x IN s then f x else x) t = IMAGE f t`] THEN + REPLICATE_TAC 3 (ONCE_REWRITE_TAC[GSYM o_DEF]) THEN + ASM_REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC + `(j:real^1->real^N) o (g:real^1->real^1) o (h:real^N->real^1)` THEN + REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]; + ALL_TAC; + ALL_TAC] THEN + REWRITE_TAC[MESON[] `(if P then f x else x) = x <=> ~P \/ f x = x`] THEN + REWRITE_TAC[DE_MORGAN_THM; GSYM LEFT_OR_DISTRIB] THEN + (SUBGOAL_THEN + `{x | x IN affine hull s /\ (~(j (f (h x)) = x) \/ ~(j (g (h x)) = x))} = + IMAGE (j:real^1->real^N) {x | ~(f x = x /\ g x = x)}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC]) + THENL + [TRANS_TAC SUBSET_TRANS + `IMAGE (j:real^1->real^N) (IMAGE (h:real^N->real^1) s)` THEN + ASM SET_TAC[]; + MATCH_MP_TAC(MESON[CLOSURE_SUBSET; BOUNDED_SUBSET; IMAGE_SUBSET] + `bounded (IMAGE f (closure s)) ==> bounded (IMAGE f s)`) THEN + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]);; + +(* ------------------------------------------------------------------------- *) +(* The "inside" and "outside" of a set, i.e. the points respectively in a *) +(* bounded or unbounded connected component of the set's complement. *) +(* ------------------------------------------------------------------------- *) + +let inside = new_definition + `inside s = {x | ~(x IN s) /\ + bounded(connected_component ((:real^N) DIFF s) x)}`;; + +let outside = new_definition + `outside s = {x | ~(x IN s) /\ + ~bounded(connected_component ((:real^N) DIFF s) x)}`;; + +let INSIDE_TRANSLATION = prove + (`!a s. inside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (inside s)`, + REWRITE_TAC[inside] THEN GEOM_TRANSLATE_TAC[]);; + +let OUTSIDE_TRANSLATION = prove + (`!a s. outside(IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (outside s)`, + REWRITE_TAC[outside] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [INSIDE_TRANSLATION; OUTSIDE_TRANSLATION];; + +let INSIDE_LINEAR_IMAGE = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> inside(IMAGE f s) = IMAGE f (inside s)`, + REWRITE_TAC[inside] THEN GEOM_TRANSFORM_TAC[]);; + +let OUTSIDE_LINEAR_IMAGE = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> outside(IMAGE f s) = IMAGE f (outside s)`, + REWRITE_TAC[outside] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [INSIDE_LINEAR_IMAGE; OUTSIDE_LINEAR_IMAGE];; + +let OUTSIDE = prove + (`!s. outside s = {x | ~bounded(connected_component((:real^N) DIFF s) x)}`, + GEN_TAC THEN REWRITE_TAC[outside; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN ASM_CASES_TAC `(x:real^N) IN s` THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[BOUNDED_EMPTY; CONNECTED_COMPONENT_EQ_EMPTY; IN_DIFF]);; + +let INSIDE_NO_OVERLAP = prove + (`!s. inside s INTER s = {}`, + REWRITE_TAC[inside] THEN SET_TAC[]);; + +let OUTSIDE_NO_OVERLAP = prove + (`!s. outside s INTER s = {}`, + REWRITE_TAC[outside] THEN SET_TAC[]);; + +let INSIDE_INTER_OUTSIDE = prove + (`!s. inside s INTER outside s = {}`, + REWRITE_TAC[inside; outside] THEN SET_TAC[]);; + +let INSIDE_UNION_OUTSIDE = prove + (`!s. inside s UNION outside s = (:real^N) DIFF s`, + REWRITE_TAC[inside; outside] THEN SET_TAC[]);; + +let INSIDE_EQ_OUTSIDE = prove + (`!s. inside s = outside s <=> s = (:real^N)`, + REWRITE_TAC[inside; outside] THEN SET_TAC[]);; + +let INSIDE_OUTSIDE = prove + (`!s. inside s = (:real^N) DIFF (s UNION outside s)`, + GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`) + [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN + SET_TAC[]);; + +let OUTSIDE_INSIDE = prove + (`!s. outside s = (:real^N) DIFF (s UNION inside s)`, + GEN_TAC THEN MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`) + [INSIDE_INTER_OUTSIDE; INSIDE_UNION_OUTSIDE] THEN + SET_TAC[]);; + +let UNION_WITH_INSIDE = prove + (`!s. s UNION inside s = (:real^N) DIFF outside s`, + REWRITE_TAC[OUTSIDE_INSIDE] THEN SET_TAC[]);; + +let UNION_WITH_OUTSIDE = prove + (`!s. s UNION outside s = (:real^N) DIFF inside s`, + REWRITE_TAC[INSIDE_OUTSIDE] THEN SET_TAC[]);; + +let OUTSIDE_MONO = prove + (`!s t. s SUBSET t ==> outside t SUBSET outside s`, + REPEAT GEN_TAC THEN REWRITE_TAC[OUTSIDE; SUBSET; IN_ELIM_THM] THEN + DISCH_TAC THEN GEN_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; + +let INSIDE_MONO = prove + (`!s t. s SUBSET t ==> inside s DIFF t SUBSET inside t`, + REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; IN_DIFF; inside; IN_ELIM_THM] THEN + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) + ASSUME_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MONO THEN ASM SET_TAC[]);; + +let COBOUNDED_OUTSIDE = prove + (`!s:real^N->bool. bounded s ==> bounded((:real^N) DIFF outside s)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[outside] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF {x | ~(x IN s) /\ ~P x} = + s UNION {x | P x}`] THEN + ASM_REWRITE_TAC[BOUNDED_UNION] THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,B)` THEN + REWRITE_TAC[BOUNDED_BALL; SUBSET; IN_ELIM_THM; IN_BALL_0] THEN + X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LT] THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [ASM_REWRITE_TAC[NORM_0] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(B + C) / norm(x) % x:real^N`) THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; NOT_IMP] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN + EXISTS_TAC `segment[x:real^N,(B + C) / norm(x) % x]` THEN + REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `(:real^N) DIFF ball(vec 0,B)` THEN + ASM_REWRITE_TAC[SET_RULE + `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_BALL_0] THEN + REWRITE_TAC[segment; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN + STRIP_TAC THEN REWRITE_TAC[REAL_NOT_LT] THEN + REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; NORM_MUL; VECTOR_MUL_ASSOC] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < B /\ B <= x ==> B <= abs x`) THEN + ASM_SIMP_TAC[REAL_ADD_RDISTRIB; REAL_DIV_RMUL; NORM_EQ_0; GSYM + REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 - u) * B + u * (B + C)` THEN + ASM_SIMP_TAC[REAL_LE_RADD; REAL_LE_LMUL; REAL_SUB_LE] THEN + SIMP_TAC[REAL_ARITH `B <= (&1 - u) * B + u * (B + C) <=> &0 <= u * C`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC);; + +let UNBOUNDED_OUTSIDE = prove + (`!s:real^N->bool. bounded s ==> ~bounded(outside s)`, + MESON_TAC[COBOUNDED_IMP_UNBOUNDED; COBOUNDED_OUTSIDE]);; + +let BOUNDED_INSIDE = prove + (`!s:real^N->bool. bounded s ==> bounded(inside s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `(:real^N) DIFF outside s` THEN + ASM_SIMP_TAC[COBOUNDED_OUTSIDE] THEN + MP_TAC(ISPEC `s:real^N->bool` INSIDE_INTER_OUTSIDE) THEN SET_TAC[]);; + +let CONNECTED_OUTSIDE = prove + (`!s:real^N->bool. 2 <= dimindex(:N) /\ bounded s ==> connected(outside s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REWRITE_TAC[outside; IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN + EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN + REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real^N` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + CONNECTED_COMPONENT_SUBSET)) THEN + REWRITE_TAC[IN_DIFF] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ]; + REWRITE_TAC[CONNECTED_COMPONENT_IDEMP] THEN + SUBGOAL_THEN `connected_component ((:real^N) DIFF s) x = + connected_component ((:real^N) DIFF s) y` + SUBST1_TAC THENL + [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENT THEN + ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]; + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ; IN_DIFF; IN_UNIV]]]);; + +let OUTSIDE_CONNECTED_COMPONENT_LT = prove + (`!s. outside s = + {x | !B. ?y. B < norm(y) /\ + connected_component((:real^N) DIFF s) x y}`, + REWRITE_TAC[OUTSIDE; bounded; EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[IN] THEN ASM_MESON_TAC[REAL_NOT_LE]);; + +let OUTSIDE_CONNECTED_COMPONENT_LE = prove + (`!s. outside s = + {x | !B. ?y. B <= norm(y) /\ + connected_component((:real^N) DIFF s) x y}`, + GEN_TAC THEN REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);; + +let NOT_OUTSIDE_CONNECTED_COMPONENT_LT = prove + (`!s. 2 <= dimindex(:N) /\ bounded s + ==> (:real^N) DIFF (outside s) = + {x | !B. ?y. B < norm(y) /\ + ~(connected_component((:real^N) DIFF s) x y)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[bounded] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `C:real`) THEN X_GEN_TAC `B:real` THEN + EXISTS_TAC `(abs B + abs C + &1) % basis 1:real^N` THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN + CONJ_TAC THENL [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + REAL_ARITH_TAC; + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN STRIP_TAC THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `B:real`) THEN DISCH_THEN + (X_CHOOSE_THEN `z:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_OF_SUBSET THEN + EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN + ASM_REWRITE_TAC[SUBSET; IN_DIFF; IN_CBALL_0; IN_UNIV; CONTRAPOS_THM] THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `(:real^N) DIFF cball(vec 0,B)` THEN + ASM_SIMP_TAC[SUBSET_REFL; IN_DIFF; IN_UNIV; IN_CBALL_0; REAL_NOT_LE] THEN + MATCH_MP_TAC CONNECTED_COMPLEMENT_BOUNDED_CONVEX THEN + ASM_SIMP_TAC[BOUNDED_CBALL; CONVEX_CBALL]]);; + +let NOT_OUTSIDE_CONNECTED_COMPONENT_LE = prove + (`!s. 2 <= dimindex(:N) /\ bounded s + ==> (:real^N) DIFF (outside s) = + {x | !B. ?y. B <= norm(y) /\ + ~(connected_component((:real^N) DIFF s) x y)}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MESON_TAC[REAL_LT_IMP_LE; REAL_ARITH `B + &1 <= x ==> B < x`]);; + +let INSIDE_CONNECTED_COMPONENT_LT = prove + (`!s. 2 <= dimindex(:N) /\ bounded s + ==> inside s = + {x:real^N | ~(x IN s) /\ + !B. ?y. B < norm(y) /\ + ~(connected_component((:real^N) DIFF s) x y)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN + ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LT] THEN SET_TAC[]);; + +let INSIDE_CONNECTED_COMPONENT_LE = prove + (`!s. 2 <= dimindex(:N) /\ bounded s + ==> inside s = + {x:real^N | ~(x IN s) /\ + !B. ?y. B <= norm(y) /\ + ~(connected_component((:real^N) DIFF s) x y)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[INSIDE_OUTSIDE] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (s UNION t) = (UNIV DIFF t) DIFF s`] THEN + ASM_SIMP_TAC[NOT_OUTSIDE_CONNECTED_COMPONENT_LE] THEN SET_TAC[]);; + +let OUTSIDE_UNION_OUTSIDE_UNION = prove + (`!c c1 c2:real^N->bool. + c INTER outside(c1 UNION c2) = {} + ==> outside(c1 UNION c2) SUBSET outside(c1 UNION c)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[OUTSIDE_CONNECTED_COMPONENT_LT; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `B:real` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[connected_component] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `t SUBSET outside(c1 UNION c2:real^N->bool)` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `connected_component((:real^N) DIFF (c1 UNION c2)) x` THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]; ALL_TAC] THEN + UNDISCH_TAC `(x:real^N) IN outside(c1 UNION c2)` THEN + REWRITE_TAC[OUTSIDE; IN_ELIM_THM; SUBSET] THEN + MESON_TAC[CONNECTED_COMPONENT_EQ]);; + +let INSIDE_SUBSET = prove + (`!s t u. connected u /\ ~bounded u /\ t UNION u = (:real^N) DIFF s + ==> inside s SUBSET t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + UNDISCH_TAC `~bounded(u:real^N->bool)` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `connected_component((:real^N) DIFF s) x` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let INSIDE_UNIQUE = prove + (`!s t u. connected t /\ bounded t /\ + connected u /\ ~(bounded u) /\ + ~connected((:real^N) DIFF s) /\ + t UNION u = (:real^N) DIFF s + ==> inside s = t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ASM_MESON_TAC[INSIDE_SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; inside; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `!s u. c INTER s = {} /\ c INTER u = {} /\ t UNION u = UNIV DIFF s + ==> c SUBSET t`) THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `c INTER s = {} <=> c SUBSET (UNIV DIFF s)`] THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `(!x. x IN s /\ x IN t ==> F) ==> s INTER t = {}`) THEN + X_GEN_TAC `y:real^N` THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [IN] THEN STRIP_TAC THEN + UNDISCH_TAC `~connected((:real^N) DIFF s)` THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN + SUBGOAL_THEN + `(!w. w IN t ==> connected_component ((:real^N) DIFF s) x w) /\ + (!w. w IN u ==> connected_component ((:real^N) DIFF s) y w)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[connected_component] THENL + [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `u:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_UNION] THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM]]);; + +let INSIDE_OUTSIDE_UNIQUE = prove + (`!s t u. connected t /\ bounded t /\ + connected u /\ ~(bounded u) /\ + ~connected((:real^N) DIFF s) /\ + t UNION u = (:real^N) DIFF s + ==> inside s = t /\ outside s = u`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[INSIDE_UNIQUE]; + MP_TAC(ISPEC `(:real^N) DIFF s` INSIDE_NO_OVERLAP) THEN + SUBGOAL_THEN `t INTER u:real^N->bool = {}` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + UNDISCH_TAC `~connected ((:real^N) DIFF s)` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_UNION THEN + ASM_REWRITE_TAC[]]);; + +let INTERIOR_INSIDE_FRONTIER = prove + (`!s:real^N->bool. bounded s ==> interior s SUBSET inside(frontier s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[inside; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[frontier; IN_DIFF]; DISCH_TAC] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN `~(connected_component((:real^N) DIFF frontier s) x INTER + frontier s = {})` + MP_TAC THENL + [MATCH_MP_TAC CONNECTED_INTER_FRONTIER THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; GSYM MEMBER_NOT_EMPTY] THEN + CONJ_TAC THENL [REWRITE_TAC[IN_INTER]; ASM SET_TAC[]] THEN + EXISTS_TAC `x:real^N` THEN CONJ_TAC THENL + [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN + GEN_REWRITE_TAC I [GSYM IN] THEN ASM SET_TAC[]; + ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]]; + REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (UNIV DIFF t)`] THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; + +let INSIDE_EMPTY = prove + (`inside {} = {}`, + REWRITE_TAC[inside; NOT_IN_EMPTY; DIFF_EMPTY; CONNECTED_COMPONENT_UNIV] THEN + REWRITE_TAC[NOT_BOUNDED_UNIV; EMPTY_GSPEC]);; + +let OUTSIDE_EMPTY = prove + (`outside {} = (:real^N)`, + REWRITE_TAC[OUTSIDE_INSIDE; INSIDE_EMPTY] THEN SET_TAC[]);; + +let INSIDE_SAME_COMPONENT = prove + (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN inside s + ==> y IN inside s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN]) + MP_TAC) THEN + REWRITE_TAC[inside; IN_ELIM_THM] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN + SIMP_TAC[IN_DIFF]);; + +let OUTSIDE_SAME_COMPONENT = prove + (`!s x y. connected_component((:real^N) DIFF s) x y /\ x IN outside s + ==> y IN outside s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GEN_REWRITE_RULE I [GSYM IN]) + MP_TAC) THEN + REWRITE_TAC[outside; IN_ELIM_THM] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONNECTED_COMPONENT_IN) THEN + SIMP_TAC[IN_DIFF]);; + +let OUTSIDE_CONVEX = prove + (`!s. convex s ==> outside s = (:real^N) DIFF s`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; + REWRITE_RULE[SET_RULE `t INTER s = {} <=> t SUBSET UNIV DIFF s`] + OUTSIDE_NO_OVERLAP] THEN + REWRITE_TAC[SUBSET; IN_UNIV; IN_DIFF] THEN + MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[OUTSIDE_EMPTY; IN_UNIV] THEN + X_GEN_TAC `a:real^N` THEN GEOM_ORIGIN_TAC `a:real^N` THEN + X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN + MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT t)`) THEN + SPEC_TAC(`(vec 0:real^N) INSERT t`,`s:real^N->bool`) THEN + GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[outside; IN_ELIM_THM] THEN + SUBGOAL_THEN `~(x:real^N = vec 0)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(max (&2) ((B + &1) / norm(x))) % x:real^N`) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [REWRITE_TAC[IN] THEN REWRITE_TAC[connected_component] THEN + EXISTS_TAC `segment[x:real^N,(max (&2) ((B + &1) / norm(x))) % x]` THEN + REWRITE_TAC[ENDS_IN_SEGMENT; CONNECTED_SEGMENT] THEN + REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real` THEN + ASM_CASES_TAC `u = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; REAL_SUB_RZERO; + VECTOR_ADD_RID; IN_DIFF; IN_UNIV] THEN + DISCH_TAC THEN + REWRITE_TAC[VECTOR_ARITH `a % x + b % c % x:real^N = (a + b * c) % x`] THEN + ABBREV_TAC `c = &1 - u + u * max (&2) ((B + &1) / norm(x:real^N))` THEN + DISCH_TAC THEN SUBGOAL_THEN `&1 < c` ASSUME_TAC THENL + [EXPAND_TAC "c" THEN + REWRITE_TAC[REAL_ARITH `&1 < &1 - u + u * x <=> &0 < u * (x - &1)`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `~((x:real^N) IN s)` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `x:real^N = (&1 - inv c) % vec 0 + inv c % c % x` + SUBST1_TAC THENL + [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `&1 < x ==> ~(x = &0)`] THEN + REWRITE_TAC[VECTOR_MUL_LID]; + MATCH_MP_TAC IN_CONVEX_SET THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_INV_LE_1; REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC]]; + ASM_SIMP_TAC[NORM_MUL; REAL_NOT_LE; GSYM REAL_LT_LDIV_EQ; NORM_POS_LT] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < b /\ b < c ==> b < abs(max (&2) c)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_DIV2_EQ] THEN + REAL_ARITH_TAC]);; + +let INSIDE_CONVEX = prove + (`!s. convex s ==> inside s = {}`, + SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_CONVEX] THEN SET_TAC[]);; + +let OUTSIDE_SUBSET_CONVEX = prove + (`!s t. convex t /\ s SUBSET t ==> (:real^N) DIFF t SUBSET outside s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `outside(t:real^N->bool)` THEN + ASM_SIMP_TAC[OUTSIDE_MONO] THEN + ASM_SIMP_TAC[OUTSIDE_CONVEX; SUBSET_REFL]);; + +let OUTSIDE_FRONTIER_MISSES_CLOSURE = prove + (`!s. bounded s ==> outside(frontier s) SUBSET (:real^N) DIFF closure s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OUTSIDE_INSIDE] THEN + SIMP_TAC[SET_RULE `(UNIV DIFF s) SUBSET (UNIV DIFF t) <=> t SUBSET s`] THEN + REWRITE_TAC[frontier] THEN + MATCH_MP_TAC(SET_RULE + `i SUBSET ins ==> c SUBSET (c DIFF i) UNION ins`) THEN + ASM_SIMP_TAC[GSYM frontier; INTERIOR_INSIDE_FRONTIER]);; + +let OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE = prove + (`!s. bounded s /\ convex s + ==> outside(frontier s) = (:real^N) DIFF closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[OUTSIDE_FRONTIER_MISSES_CLOSURE] THEN + MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN + ASM_SIMP_TAC[CONVEX_CLOSURE; frontier] THEN SET_TAC[]);; + +let INSIDE_FRONTIER_EQ_INTERIOR = prove + (`!s:real^N->bool. + bounded s /\ convex s ==> inside(frontier s) = interior s`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[INSIDE_OUTSIDE; OUTSIDE_FRONTIER_EQ_COMPLEMENT_CLOSURE] THEN + REWRITE_TAC[frontier] THEN + MAP_EVERY (MP_TAC o ISPEC `s:real^N->bool`) + [CLOSURE_SUBSET; INTERIOR_SUBSET] THEN + ASM SET_TAC[]);; + +let OPEN_INSIDE = prove + (`!s:real^N->bool. closed s ==> open(inside s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL + [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed]; + REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN + GEN_REWRITE_TAC I [GSYM IN] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + MP_TAC(ISPEC `s:real^N->bool` INSIDE_NO_OVERLAP) THEN + ASM SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);; + +let OPEN_OUTSIDE = prove + (`!s:real^N->bool. closed s ==> open(outside s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `open(connected_component ((:real^N) DIFF s) x)` MP_TAC THENL + [MATCH_MP_TAC OPEN_CONNECTED_COMPONENT THEN ASM_REWRITE_TAC[GSYM closed]; + REWRITE_TAC[open_def] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ] THEN + GEN_REWRITE_TAC I [GSYM IN] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + MP_TAC(ISPEC `s:real^N->bool` OUTSIDE_NO_OVERLAP) THEN + ASM SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[DIST_SYM]]]);; + +let CLOSURE_INSIDE_SUBSET = prove + (`!s:real^N->bool. closed s ==> closure(inside s) SUBSET s UNION inside s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[closed; GSYM OUTSIDE_INSIDE; OPEN_OUTSIDE] THEN SET_TAC[]);; + +let FRONTIER_INSIDE_SUBSET = prove + (`!s:real^N->bool. closed s ==> frontier(inside s) SUBSET s`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[frontier; OPEN_INSIDE; INTERIOR_OPEN] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_INSIDE_SUBSET) THEN SET_TAC[]);; + +let CLOSURE_OUTSIDE_SUBSET = prove + (`!s:real^N->bool. closed s ==> closure(outside s) SUBSET s UNION outside s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[closed; GSYM INSIDE_OUTSIDE; OPEN_INSIDE] THEN SET_TAC[]);; + +let FRONTIER_OUTSIDE_SUBSET = prove + (`!s:real^N->bool. closed s ==> frontier(outside s) SUBSET s`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[frontier; OPEN_OUTSIDE; INTERIOR_OPEN] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSURE_OUTSIDE_SUBSET) THEN SET_TAC[]);; + +let INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY = prove + (`!s. connected((:real^N) DIFF s) /\ ~bounded((:real^N) DIFF s) + ==> inside s = {}`, + REWRITE_TAC[inside; CONNECTED_CONNECTED_COMPONENT_SET] THEN + REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`] THEN + SIMP_TAC[IN_ELIM_THM; IN_DIFF; IN_UNIV; TAUT `~(a /\ b) <=> a ==> ~b`]);; + +let INSIDE_BOUNDED_COMPLEMENT_CONNECTED_EMPTY = prove + (`!s. connected((:real^N) DIFF s) /\ bounded s + ==> inside s = {}`, + MESON_TAC[INSIDE_COMPLEMENT_UNBOUNDED_CONNECTED_EMPTY; + COBOUNDED_IMP_UNBOUNDED]);; + +let INSIDE_INSIDE = prove + (`!s t:real^N->bool. + s SUBSET inside t ==> inside s DIFF t SUBSET inside t`, + REPEAT STRIP_TAC THEN SIMP_TAC[SUBSET; inside; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + ASM_CASES_TAC `s INTER connected_component ((:real^N) DIFF t) x = {}` THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `connected_component ((:real^N) DIFF s) x` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s INTER t = {}) ==> ?x. x IN s /\ x IN t`)) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST_ALL_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[inside; IN_ELIM_THM]]);; + +let INSIDE_INSIDE_SUBSET = prove + (`!s:real^N->bool. inside(inside s) SUBSET s`, + GEN_TAC THEN MP_TAC + (ISPECL [`inside s:real^N->bool`; `s:real^N->bool`] INSIDE_INSIDE) THEN + REWRITE_TAC[SUBSET_REFL] THEN + MP_TAC(ISPEC `inside s:real^N->bool` INSIDE_NO_OVERLAP) THEN SET_TAC[]);; + +let INSIDE_OUTSIDE_INTERSECT_CONNECTED = prove + (`!s t:real^N->bool. + connected t /\ ~(inside s INTER t = {}) /\ ~(outside s INTER t = {}) + ==> ~(s INTER t = {})`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + REWRITE_TAC[inside; outside; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `connected_component ((:real^N) DIFF s) y = + connected_component ((:real^N) DIFF s) x` + (fun th -> ASM_MESON_TAC[th]) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EQ; IN_DIFF; IN_UNIV] THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `t:real^N->bool` THEN ASM SET_TAC[]);; + +let OUTSIDE_BOUNDED_NONEMPTY = prove + (`!s:real^N->bool. bounded s ==> ~(outside s = {})`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] OUTSIDE_SUBSET_CONVEX)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[CONVEX_BALL; SUBSET_EMPTY] THEN + REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN + MESON_TAC[BOUNDED_BALL; BOUNDED_SUBSET; NOT_BOUNDED_UNIV]);; + +let OUTSIDE_COMPACT_IN_OPEN = prove + (`!s t:real^N->bool. + compact s /\ open t /\ s SUBSET t /\ ~(t = {}) + ==> ~(outside s INTER t = {})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OUTSIDE_BOUNDED_NONEMPTY o + MATCH_MP COMPACT_IMP_BOUNDED) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM; IN_INTER] THEN + X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `(a:real^N) IN t` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`linepath(a:real^N,b)`; `(:real^N) DIFF t`] + EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN + REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^1->real^N` THEN REWRITE_TAC[FRONTIER_COMPLEMENT] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; INTERIOR_DIFF; INTERIOR_UNIV] THEN + ABBREV_TAC `c:real^N = pathfinish g` THEN STRIP_TAC THEN + SUBGOAL_THEN `frontier t SUBSET (:real^N) DIFF s` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN + REWRITE_TAC[frontier] THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV]] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MP_TAC(ISPEC `(:real^N) DIFF s` OPEN_CONTAINS_CBALL) THEN + ASM_SIMP_TAC[GSYM closed; COMPACT_IMP_CLOSED; IN_DIFF; IN_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`c:real^N`; `t:real^N->bool`] + CLOSURE_APPROACHABLE) THEN + RULE_ASSUM_TAC(REWRITE_RULE[frontier; IN_DIFF]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[connected_component] THEN + EXISTS_TAC `path_image(g) UNION segment[c:real^N,d]` THEN + REWRITE_TAC[IN_UNION; ENDS_IN_SEGMENT] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_UNION THEN + ASM_SIMP_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY; + CONNECTED_PATH_IMAGE] THEN + EXISTS_TAC `c:real^N` THEN REWRITE_TAC[ENDS_IN_SEGMENT; IN_INTER] THEN + ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]; + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]] THEN + REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(c IN s) + ==> (t DELETE c) SUBSET (UNIV DIFF s) + ==> t SUBSET (UNIV DIFF s)`)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + SIMP_TAC[SET_RULE `UNIV DIFF s SUBSET UNIV DIFF t <=> t SUBSET s`] THEN + ASM_MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[CONVEX_CBALL; INSERT_SUBSET; REAL_LT_IMP_LE; + EMPTY_SUBSET; CENTRE_IN_CBALL] THEN + REWRITE_TAC[IN_CBALL] THEN + ASM_MESON_TAC[DIST_SYM; REAL_LT_IMP_LE]]]);; + +let INSIDE_INSIDE_COMPACT_CONNECTED = prove + (`!s t:real^N->bool. + closed s /\ compact t /\ s SUBSET inside t /\ connected t + ==> inside s SUBSET inside t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `inside t:real^N->bool = {}` THEN + ASM_SIMP_TAC[INSIDE_EMPTY; SUBSET_EMPTY; EMPTY_SUBSET] THEN + SUBGOAL_THEN `1 <= dimindex(:N)` MP_TAC THENL + [REWRITE_TAC[DIMINDEX_GE_1]; + REWRITE_TAC[ARITH_RULE `1 <= n <=> n = 1 \/ 2 <= n`]] THEN + STRIP_TAC THEN ASM_SIMP_TAC[GSYM CONNECTED_CONVEX_1_GEN] THENL + [ASM_MESON_TAC[INSIDE_CONVEX]; ALL_TAC] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP INSIDE_INSIDE) THEN + MATCH_MP_TAC(SET_RULE + `s INTER t = {} ==> s DIFF t SUBSET u ==> s SUBSET u`) THEN + SUBGOAL_THEN `compact(s:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; BOUNDED_INSIDE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + INSIDE_OUTSIDE_INTERSECT_CONNECTED) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT + `r /\ q ==> (~p /\ q ==> ~r) ==> p`) THEN + CONJ_TAC THENL + [MP_TAC(ISPEC `t:real^N->bool` INSIDE_NO_OVERLAP) THEN ASM SET_TAC[]; + ONCE_REWRITE_TAC[INTER_COMM]] THEN + MATCH_MP_TAC INSIDE_OUTSIDE_INTERSECT_CONNECTED THEN + ASM_SIMP_TAC[CONNECTED_OUTSIDE; COMPACT_IMP_BOUNDED] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OUTSIDE_COMPACT_IN_OPEN THEN + ASM_SIMP_TAC[OPEN_INSIDE; COMPACT_IMP_CLOSED]; + MP_TAC(ISPECL [`s UNION t:real^N->bool`; `vec 0:real^N`] + BOUNDED_SUBSET_BALL) THEN + ASM_SIMP_TAC[BOUNDED_UNION; COMPACT_IMP_BOUNDED] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `!u. ~(u = UNIV) /\ UNIV DIFF u SUBSET s /\ UNIV DIFF u SUBSET t + ==> ~(s INTER t = {})`) THEN + EXISTS_TAC `ball(vec 0:real^N,r)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[NOT_BOUNDED_UNIV; BOUNDED_BALL]; ALL_TAC] THEN + CONJ_TAC THEN MATCH_MP_TAC OUTSIDE_SUBSET_CONVEX THEN + REWRITE_TAC[CONVEX_BALL] THEN ASM SET_TAC[]]);; + +let CONNECTED_WITH_INSIDE = prove + (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION inside s)`, + GEN_TAC THEN ASM_CASES_TAC `s UNION inside s = (:real^N)` THEN + ASM_REWRITE_TAC[CONNECTED_UNIV] THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN (s UNION inside s) + ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\ + t SUBSET (s UNION inside s)` + MP_TAC THENL + [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN + ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`linepath(a:real^N,b)`; `inside s:real^N->bool`] + EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN + ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + IN_UNION; OPEN_INSIDE; INTERIOR_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `pathfinish g :real^N` THEN + EXISTS_TAC `path_image g :real^N->bool` THEN + ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[FRONTIER_INSIDE_SUBSET; SUBSET]; + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; + ASM SET_TAC[]]]; + DISCH_THEN(fun th -> + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN + ASM SET_TAC[]]);; + +let CONNECTED_WITH_OUTSIDE = prove + (`!s:real^N->bool. closed s /\ connected s ==> connected(s UNION outside s)`, + GEN_TAC THEN ASM_CASES_TAC `s UNION outside s = (:real^N)` THEN + ASM_REWRITE_TAC[CONNECTED_UNIV] THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT] THEN + REWRITE_TAC[CONNECTED_COMPONENT_SET; IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN (s UNION outside s) + ==> ?y:real^N t. y IN s /\ connected t /\ x IN t /\ y IN t /\ + t SUBSET (s UNION outside s)` + MP_TAC THENL + [X_GEN_TAC `a:real^N` THEN REWRITE_TAC[IN_UNION] THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real^N`; `{a:real^N}`] THEN + ASM_REWRITE_TAC[IN_SING; CONNECTED_SING] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s UNION t = UNIV) ==> ?b. ~(b IN s) /\ ~(b IN t)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`linepath(a:real^N,b)`; `outside s:real^N->bool`] + EXISTS_PATH_SUBPATH_TO_FRONTIER) THEN + ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + IN_UNION; OPEN_OUTSIDE; INTERIOR_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `pathfinish g :real^N` THEN + EXISTS_TAC `path_image g :real^N->bool` THEN + ASM_SIMP_TAC[PATHFINISH_IN_PATH_IMAGE; CONNECTED_PATH_IMAGE] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[FRONTIER_OUTSIDE_SUBSET; SUBSET]; + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE]; + ASM SET_TAC[]]]; + DISCH_THEN(fun th -> + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + MP_TAC(SPEC `y:real^N` th) THEN MP_TAC(SPEC `x:real^N` th)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`b:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t UNION v UNION u:real^N->bool` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REPEAT(MATCH_MP_TAC CONNECTED_UNION THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC) THEN + ASM SET_TAC[]]);; + +let INSIDE_INSIDE_EQ_EMPTY = prove + (`!s:real^N->bool. + closed s /\ connected s ==> inside(inside s) = {}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real^N` THEN ONCE_REWRITE_TAC[inside] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[INSIDE_OUTSIDE] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[CONNECTED_COMPONENT_EQ_SELF; CONNECTED_WITH_OUTSIDE] THEN + REWRITE_TAC[BOUNDED_UNION] THEN MESON_TAC[UNBOUNDED_OUTSIDE]);; + +let INSIDE_IN_COMPONENTS = prove + (`!s. (inside s) IN components((:real^N) DIFF s) <=> + connected(inside s) /\ ~(inside s = {})`, + X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN + ASM_CASES_TAC `inside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `connected(inside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + REWRITE_TAC[INSIDE_NO_OVERLAP] THEN + X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC INSIDE_SAME_COMPONENT THEN + UNDISCH_TAC `~(inside s:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[connected_component] THEN + EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);; + +let OUTSIDE_IN_COMPONENTS = prove + (`!s. (outside s) IN components((:real^N) DIFF s) <=> + connected(outside s) /\ ~(outside s = {})`, + X_GEN_TAC `s:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS_MAXIMAL] THEN + ASM_CASES_TAC `outside s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `connected(outside s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> s INTER t = {}`] THEN + REWRITE_TAC[OUTSIDE_NO_OVERLAP] THEN + X_GEN_TAC `d:real^N->bool` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC OUTSIDE_SAME_COMPONENT THEN + UNDISCH_TAC `~(outside s:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[connected_component] THEN + EXISTS_TAC `d:real^N->bool` THEN ASM SET_TAC[]);; + +let BOUNDED_UNIQUE_OUTSIDE = prove + (`!c s. 2 <= dimindex(:N) /\ bounded s + ==> (c IN components ((:real^N) DIFF s) /\ ~bounded c <=> + c = outside s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [MATCH_MP_TAC COBOUNDED_UNIQUE_UNBOUNDED_COMPONENTS THEN + EXISTS_TAC `(:real^N) DIFF s` THEN + ASM_REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]; + ASM_REWRITE_TAC[OUTSIDE_IN_COMPONENTS]] THEN + ASM_SIMP_TAC[UNBOUNDED_OUTSIDE; OUTSIDE_BOUNDED_NONEMPTY; + CONNECTED_OUTSIDE]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy of maps p,q : X->Y with property P of all intermediate maps. *) +(* We often just want to require that it fixes some subset, but to take in *) +(* the case of loop homotopy it's convenient to have a general property P. *) +(* ------------------------------------------------------------------------- *) + +let homotopic_with = new_definition + `homotopic_with P (X,Y) p q <=> + ?h:real^(1,M)finite_sum->real^N. + h continuous_on (interval[vec 0,vec 1] PCROSS X) /\ + IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\ + (!x. h(pastecart (vec 0) x) = p x) /\ + (!x. h(pastecart (vec 1) x) = q x) /\ + (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x)))`;; + +(* ------------------------------------------------------------------------- *) +(* We often want to just localize the ending function equality or whatever. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_WITH = prove + (`(!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k)) + ==> (homotopic_with P (X,Y) p q <=> + ?h:real^(1,M)finite_sum->real^N. + h continuous_on (interval[vec 0,vec 1] PCROSS X) /\ + IMAGE h (interval[vec 0,vec 1] PCROSS X) SUBSET Y /\ + (!x. x IN X ==> h(pastecart (vec 0) x) = p x) /\ + (!x. x IN X ==> h(pastecart (vec 1) x) = q x) /\ + (!t. t IN interval[vec 0,vec 1] ==> P(\x. h(pastecart t x))))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL + [REWRITE_TAC[homotopic_with; PCROSS] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]; + REWRITE_TAC[homotopic_with; PCROSS] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` + (fun th -> EXISTS_TAC + `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y + else if fstcart(y) = vec 0 then p(sndcart y) + else q(sndcart y)` THEN + MP_TAC th)) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN + SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART]; + SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN + SIMP_TAC[FORALL_IN_GSPEC; SNDCART_PASTECART]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[]]]);; + +let HOMOTOPIC_WITH_EQ = prove + (`!P X Y f g f' g':real^M->real^N. + homotopic_with P (X,Y) f g /\ + (!x. x IN X ==> f' x = f x /\ g' x = g x) /\ + (!h k. (!x. x IN X ==> h x = k x) ==> (P h <=> P k)) + ==> homotopic_with P (X,Y) f' g'`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[homotopic_with] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` + (fun th -> EXISTS_TAC + `\y. if sndcart(y) IN X then (h:real^(1,M)finite_sum->real^N) y + else if fstcart(y) = vec 0 then f'(sndcart y) + else g'(sndcart y)` THEN + MP_TAC th)) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; VEC_EQ; ARITH_EQ] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN + SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART]; + SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN + SIMP_TAC[FORALL_IN_PCROSS; SNDCART_PASTECART]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `t:real^1` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[]]);; + +let HOMOTOPIC_WITH_EQUAL = prove + (`!P f:real^M->real^N g s t. + P f /\ P g /\ + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!x. x IN s ==> g x = f x) + ==> homotopic_with P (s,t) f g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN + EXISTS_TAC `\z:real^(1,M)finite_sum. + if fstcart z = vec 1 then g(sndcart z):real^N else f(sndcart z)` THEN + REWRITE_TAC[VEC_EQ; ARITH_EQ; SNDCART_PASTECART; FSTCART_PASTECART] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `\z:real^(1,M)finite_sum. (f:real^M->real^N)(sndcart z)` THEN + ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[COND_ID] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; IMAGE_SNDCART_PCROSS] THEN + ASM_REWRITE_TAC[UNIT_INTERVAL_NONEMPTY]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + REWRITE_TAC[ FSTCART_PASTECART; SNDCART_PASTECART] THEN + CONJ_TAC THEN X_GEN_TAC `t:real^1` THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `t:real^1 = vec 1` THEN ASM_REWRITE_TAC[ETA_AX] THEN + ASM SET_TAC[]]);; + +let HOMOTOPIC_CONSTANT_MAPS = prove + (`!s:real^M->bool t:real^N->bool a b. + homotopic_with (\x. T) (s,t) (\x. a) (\x. b) <=> + s = {} \/ path_component t a b`, + REPEAT GEN_TAC THEN SIMP_TAC[HOMOTOPIC_WITH; path_component] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; PCROSS_EMPTY; IMAGE_CLAUSES] THEN + REWRITE_TAC[EMPTY_SUBSET; CONTINUOUS_ON_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PATH_IMAGE_NONEMPTY; SUBSET_EMPTY; PCROSS_EQ_EMPTY; + IMAGE_EQ_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?c:real^M. c IN s` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `(h:real^(1,M)finite_sum->real^N) o (\t. pastecart t c)` THEN + ASM_SIMP_TAC[pathstart; pathfinish; o_THM; PATH_IMAGE_COMPOSE] THEN + CONJ_TAC THENL + [REWRITE_TAC[path] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + REWRITE_TAC[path_image]] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS]; + REWRITE_TAC[path; pathstart; path_image; pathfinish] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(g:real^1->real^N) o (fstcart:real^(1,M)finite_sum->real^1)` THEN + ASM_SIMP_TAC[FSTCART_PASTECART; o_THM; IMAGE_o; IMAGE_FSTCART_PCROSS] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; + IMAGE_FSTCART_PCROSS]]);; + +(* ------------------------------------------------------------------------- *) +(* Trivial properties. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_WITH_IMP_PROPERTY = prove + (`!P X Y (f:real^M->real^N) g. homotopic_with P (X,Y) f g ==> P f /\ P g`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN DISCH_THEN + (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN + MP_TAC(SPEC `vec 1:real^1` th)) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL; ETA_AX]);; + +let HOMOTOPIC_WITH_IMP_CONTINUOUS = prove + (`!P X Y (f:real^M->real^N) g. + homotopic_with P (X,Y) f g ==> f continuous_on X /\ g continuous_on X`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN + STRIP_TAC THEN + SUBGOAL_THEN + `((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 0) x)) + continuous_on X /\ + ((h:real^(1,M)finite_sum->real^N) o (\x. pastecart (vec 1) x)) + continuous_on X` + MP_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[o_DEF; ETA_AX]] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN + SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]);; + +let HOMOTOPIC_WITH_IMP_SUBSET = prove + (`!P X Y (f:real^M->real^N) g. + homotopic_with P (X,Y) f g ==> IMAGE f X SUBSET Y /\ IMAGE g X SUBSET Y`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` MP_TAC) THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN DISCH_THEN + (fun th -> MP_TAC(SPEC `vec 0:real^1` th) THEN + MP_TAC(SPEC `vec 1:real^1` th)) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]);; + +let HOMOTOPIC_WITH_MONO = prove + (`!P Q X Y f g:real^M->real^N. + homotopic_with P (X,Y) f g /\ + (!h. h continuous_on X /\ IMAGE h X SUBSET Y /\ P h ==> Q h) + ==> homotopic_with Q (X,Y) f g`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[homotopic_with; PCROSS] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let HOMOTOPIC_WITH_SUBSET_LEFT = prove + (`!P X Y Z f g. + homotopic_with P (X,Y) f g /\ Z SUBSET X + ==> homotopic_with P (Z,Y) f g`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[homotopic_with; PCROSS] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let HOMOTOPIC_WITH_SUBSET_RIGHT = prove + (`!P X Y Z (f:real^M->real^N) g h. + homotopic_with P (X,Y) f g /\ Y SUBSET Z + ==> homotopic_with P (X,Z) f g`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[homotopic_with] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + ASM_MESON_TAC[SUBSET_TRANS]);; + +let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT = prove + (`!p f:real^N->real^P g h:real^M->real^N W X Y. + homotopic_with (\f. p(f o h)) (X,Y) f g /\ + h continuous_on W /\ IMAGE h W SUBSET X + ==> homotopic_with p (W,Y) (f o h) (g o h)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[homotopic_with; o_DEF; PCROSS] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^(1,N)finite_sum->real^P` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. + (k:real^(1,N)finite_sum->real^P) + (pastecart (fstcart y) (h(sndcart y)))` THEN + ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT = prove + (`!f:real^N->real^P g h:real^M->real^N W X Y. + homotopic_with (\f. T) (X,Y) f g /\ + h continuous_on W /\ IMAGE h W SUBSET X + ==> homotopic_with (\f. T) (W,Y) (f o h) (g o h)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `X:real^N->bool` THEN ASM_REWRITE_TAC[]);; + +let HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT = prove + (`!p f:real^M->real^N g h:real^N->real^P X Y Z. + homotopic_with (\f. p(h o f)) (X,Y) f g /\ + h continuous_on Y /\ IMAGE h Y SUBSET Z + ==> homotopic_with p (X,Z) (h o f) (h o g)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[homotopic_with; o_DEF] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(h:real^N->real^P) o (k:real^(1,M)finite_sum->real^N)` THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + ALL_TAC] THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]);; + +let HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT = prove + (`!f:real^M->real^N g h:real^N->real^P X Y Z. + homotopic_with (\f. T) (X,Y) f g /\ + h continuous_on Y /\ IMAGE h Y SUBSET Z + ==> homotopic_with (\f. T) (X,Z) (h o f) (h o g)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `Y:real^N->bool` THEN ASM_REWRITE_TAC[]);; + +let HOMOTOPIC_WITH_PCROSS = prove + (`!f:real^M->real^N f':real^P->real^Q g g' p p' q s s' t t'. + homotopic_with p (s,t) f g /\ + homotopic_with p' (s',t') f' g' /\ + (!f g. p f /\ p' g ==> q(\x. pastecart (f(fstcart x)) (g(sndcart x)))) + ==> homotopic_with q (s PCROSS s',t PCROSS t') + (\z. pastecart (f(fstcart z)) (f'(sndcart z))) + (\z. pastecart (g(fstcart z)) (g'(sndcart z)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with] THEN + REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `k:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `k':real^(1,P)finite_sum->real^Q` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC + `\z:real^(1,(M,P)finite_sum)finite_sum. + pastecart (k(pastecart (fstcart z) (fstcart(sndcart z))):real^N) + (k'(pastecart (fstcart z) (sndcart(sndcart z))):real^Q)` THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS]) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS; + IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + (CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; + IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; + PASTECART_IN_PCROSS]]));; + +let HOMOTOPIC_ON_EMPTY = prove + (`!t f g. homotopic_with (\x. T) ({},t) f g`, + SIMP_TAC[HOMOTOPIC_WITH; NOT_IN_EMPTY; PCROSS_EMPTY] THEN + REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy with P is an equivalence relation (on continuous functions *) +(* mapping X into Y that satisfy P, though this only affects reflexivity). *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_WITH_REFL = prove + (`!P X Y (f:real^M->real^N). + homotopic_with P (X,Y) f f <=> + f continuous_on X /\ IMAGE f X SUBSET Y /\ P f`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[HOMOTOPIC_WITH_IMP_PROPERTY; HOMOTOPIC_WITH_IMP_CONTINUOUS; + HOMOTOPIC_WITH_IMP_SUBSET]; + STRIP_TAC THEN REWRITE_TAC[homotopic_with; PCROSS]] THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) (sndcart y)` THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_SIMP_TAC[SNDCART_PASTECART; ETA_AX; SUBSET; FORALL_IN_IMAGE; + FORALL_IN_GSPEC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]);; + +let HOMOTOPIC_WITH_SYM = prove + (`!P X Y (f:real^M->real^N) g. + homotopic_with P (X,Y) f g <=> homotopic_with P (X,Y) g f`, + REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC(MESON[] + `(!x y. P x y ==> P y x) ==> (!x y. P x y <=> P y x)`) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,M)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. + (h:real^(1,M)finite_sum->real^N) + (pastecart (vec 1 - fstcart y) (sndcart y))` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; VECTOR_SUB_RZERO] THEN REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; + LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s + ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC]; + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[PASTECART_EQ] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; FSTCART_PASTECART; SNDCART_PASTECART] THEN + SIMP_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC);; + +let HOMOTOPIC_WITH_TRANS = prove + (`!P X Y (f:real^M->real^N) g h. + homotopic_with P (X,Y) f g /\ homotopic_with P (X,Y) g h + ==> homotopic_with P (X,Y) f h`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_with; PCROSS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `k1:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `k2:real^(1,M)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. + if drop(fstcart y) <= &1 / &2 + then (k1:real^(1,M)finite_sum->real^N) + (pastecart (&2 % fstcart y) (sndcart y)) + else (k2:real^(1,M)finite_sum->real^N) + (pastecart (&2 % fstcart y - vec 1) (sndcart y))` THEN + REWRITE_TAC[FSTCART_PASTECART; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; SNDCART_PASTECART] THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `interval[vec 0:real^1,vec 1] = + interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `{f x y | x IN s UNION t /\ y IN u} = + {f x y | x IN s /\ y IN u} UNION + {f x y | x IN t /\ y IN u}`] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d /\ e <=> (a /\ b) /\ (c /\ d) /\ e`] THEN + CONJ_TAC THENL + [REWRITE_TAC[CLOSED_IN_CLOSED] THEN CONJ_TAC THENL + [EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) | + t IN interval[vec 0,lift(&1 / &2)] /\ x IN UNIV }`; + EXISTS_TAC `{ pastecart (t:real^1) (x:real^M) | + t IN interval[lift(&1 / &2),vec 1] /\ x IN UNIV}`] THEN + SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; + CLOSED_INTERVAL; CLOSED_UNIV] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; TAUT + `(x IN (s UNION t) /\ x IN u ==> x IN v) <=> + (x IN u ==> x IN (s UNION t) ==> x IN v)`] THEN + REWRITE_TAC[PASTECART_EQ; IN_ELIM_THM; IN_UNION] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV] THEN + MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [CONJ_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; + LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; + SNDCART_PASTECART] THEN + REWRITE_TAC[MESON[] `(?t x. P t x /\ a = t /\ b = x) <=> P a b`] THEN + SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN + REAL_ARITH_TAC; + REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN + SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_ARITH + `&1 / &2 <= t ==> (t <= &1 / &2 <=> t = &1 / &2)`] THEN + SIMP_TAC[GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN + REWRITE_TAC[GSYM LIFT_SUB] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[LIFT_NUM]]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET t ==> x IN s ==> k x IN t`)) THEN + ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_INTERVAL_1; DROP_VEC; + DROP_CMUL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + STRIP_TAC THEN ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC]);; + +let HOMOTOPIC_COMPOSE = prove + (`!f f':real^M->real^N g g':real^N->real^P s t u. + homotopic_with (\x. T) (s,t) f f' /\ + homotopic_with (\x. T) (t,u) g g' + ==> homotopic_with (\x. T) (s,u) (g o f) (g' o f')`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN + EXISTS_TAC `(g:real^N->real^P) o (f':real^M->real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT; + MATCH_MP_TAC HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT] THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(fun th -> + ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS th) THEN + ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th))) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Two characterizations of homotopic triviality, one of which *) +(* implicitly incorporates path-connectedness. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_TRIVIALITY = prove + (`!s:real^M->bool t:real^N->bool. + (!f g. f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on s /\ IMAGE g s SUBSET t + ==> homotopic_with (\x. T) (s,t) f g) <=> + (s = {} \/ path_connected t) /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET t + ==> ?c. homotopic_with (\x. T) (s,t) f (\x. c))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; HOMOTOPIC_WITH; NOT_IN_EMPTY; + PCROSS_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET]; + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY; PATH_CONNECTED_EMPTY]] THEN + EQ_TAC THEN REPEAT STRIP_TAC THENL + [REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT] THEN + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) HOMOTOPIC_CONSTANT_MAPS o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST] THEN + ASM SET_TAC[]; + SUBGOAL_THEN `?c:real^N. c IN t` MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; CONTINUOUS_ON_CONST]; + FIRST_X_ASSUM(fun th -> + MP_TAC(ISPEC `g:real^M->real^N` th) THEN + MP_TAC(ISPEC `f:real^M->real^N` th)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `d:real^N` THEN DISCH_TAC THEN + TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. c):real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + TRANS_TAC HOMOTOPIC_WITH_TRANS `(\x. d):real^M->real^N` THEN + ASM_REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET)) THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy on a union of closed-open sets. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_ON_CLOPEN_UNIONS = prove + (`!f:real^M->real^N g t u. + (!s. s IN u + ==> closed_in (subtopology euclidean (UNIONS u)) s /\ + open_in (subtopology euclidean (UNIONS u)) s /\ + homotopic_with (\x. T) (s,t) f g) + ==> homotopic_with (\x. T) (UNIONS u,t) f g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?v. v SUBSET u /\ COUNTABLE v /\ UNIONS v :real^M->bool = UNIONS u` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC LINDELOF_OPEN_IN THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)] THEN + ASM_CASES_TAC `v:(real^M->bool)->bool = {}` THEN + ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY; UNIONS_0] THEN + MP_TAC(ISPEC `v:(real^M->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:num->real^M->bool` THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN `n:num` o SPEC `(f:num->real^M->bool) n`) THEN + DISCH_THEN(MP_TAC o MATCH_MP MONO_FORALL) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[FORALL_AND_THM]] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [homotopic_with] THEN + SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH] THEN + X_GEN_TAC `h:num->real^(1,M)finite_sum->real^N` THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`h:num->real^(1,M)finite_sum->real^N`; + `(\n. interval[vec 0,vec 1] PCROSS (f n DIFF UNIONS {f m | m < n})) + :num->real^(1,M)finite_sum->bool`; + `(interval[vec 0,vec 1] PCROSS UNIONS(IMAGE f (:num))) + :real^(1,M)finite_sum->bool`; + `(:num)`] PASTING_LEMMA_EXISTS) THEN + REWRITE_TAC[IN_UNIV; FORALL_AND_THM; INTER_PCROSS] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; SUBSET; IN_ELIM_THM; FORALL_PASTECART] THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_UNIONS; FORALL_IN_IMAGE; IN_UNIV; IMP_CONJ] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; IN_DIFF; IN_ELIM_THM] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN MESON_TAC[]; + X_GEN_TAC `n:num` THEN MATCH_MP_TAC OPEN_IN_PCROSS THEN + REWRITE_TAC[OPEN_IN_REFL] THEN MATCH_MP_TAC OPEN_IN_DIFF THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[FINITE_NUMSEG_LT; FINITE_IMAGE] THEN ASM SET_TAC[]; + X_GEN_TAC `n:num` THEN FIRST_X_ASSUM(fun th -> + MATCH_MP_TAC(MATCH_MP(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET) + (SPEC `n:num` th))) THEN + REWRITE_TAC[SUBSET_PCROSS; SUBSET_REFL; SUBSET_DIFF]; + MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[INTER_ACI] THEN MESON_TAC[]; + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN SET_TAC[]]]; + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g:real^(1,M)finite_sum->real^N` THEN + REWRITE_TAC[INTER_ACI; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_IN_UNIONS; FORALL_IN_IMAGE; IMP_CONJ; SUBSET; + RIGHT_FORALL_IMP_THM; IN_UNIV; FORALL_IN_PCROSS] THEN + CONJ_TAC THENL + [X_GEN_TAC `t:real^1` THEN DISCH_TAC; CONJ_TAC] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `y:real^M` THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^1`; `y:real^M`; `n:num`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^1`; `y:real^M`; `n:num`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`vec 1:real^1`; `y:real^M`; `n:num`])] THEN + ASM_REWRITE_TAC[IN_INTER; UNIONS_IMAGE; IN_UNIV; IN_DIFF; + UNIONS_GSPEC; IN_ELIM_THM; ENDS_IN_UNIT_INTERVAL] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN + REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);; + +let INESSENTIAL_ON_CLOPEN_UNIONS = prove + (`!f:real^M->real^N t u. + path_connected t /\ + (!s. s IN u + ==> closed_in (subtopology euclidean (UNIONS u)) s /\ + open_in (subtopology euclidean (UNIONS u)) s /\ + ?a. homotopic_with (\x. T) (s,t) f (\x. a)) + ==> ?a. homotopic_with (\x. T) (UNIONS u,t) f (\x. a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `UNIONS u:real^M->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0; HOMOTOPIC_ON_EMPTY] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [EMPTY_UNIONS]) THEN + REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN + X_GEN_TAC `c:real^M->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `a:real^N` THEN + MATCH_MP_TAC HOMOTOPIC_ON_CLOPEN_UNIONS THEN + X_GEN_TAC `s:real^M->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[HOMOTOPIC_ON_EMPTY] THEN X_GEN_TAC `b:real^N` THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `IMAGE (\x. a) s SUBSET t ==> ~(s = {}) ==> a IN t`)) THEN + ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy of paths, maintaining the same endpoints. *) +(* ------------------------------------------------------------------------- *) + +let homotopic_paths = new_definition + `homotopic_paths s p q = + homotopic_with + (\r. pathstart r = pathstart p /\ pathfinish r = pathfinish p) + (interval[vec 0:real^1,vec 1],s) + p q`;; + +let HOMOTOPIC_PATHS = prove + (`!s p q:real^1->real^N. + homotopic_paths s p q <=> + ?h. h continuous_on + interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\ + IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) + SUBSET s /\ + (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\ + (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\ + (!t. t IN interval[vec 0:real^1,vec 1] + ==> pathstart(h o pastecart t) = pathstart p /\ + pathfinish(h o pastecart t) = pathfinish p)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[homotopic_paths] THEN + W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; + +let HOMOTOPIC_PATHS_IMP_PATHSTART = prove + (`!s p q. homotopic_paths s p q ==> pathstart p = pathstart q`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN + SIMP_TAC[]);; + +let HOMOTOPIC_PATHS_IMP_PATHFINISH = prove + (`!s p q. homotopic_paths s p q ==> pathfinish p = pathfinish q`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN + SIMP_TAC[]);; + +let HOMOTOPIC_PATHS_IMP_PATH = prove + (`!s p q. homotopic_paths s p q ==> path p /\ path q`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN + SIMP_TAC[path]);; + +let HOMOTOPIC_PATHS_IMP_SUBSET = prove + (`!s p q. + homotopic_paths s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_paths] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + SIMP_TAC[path_image]);; + +let HOMOTOPIC_PATHS_REFL = prove + (`!s p. homotopic_paths s p p <=> + path p /\ path_image p SUBSET s`, + REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_REFL; path; path_image]);; + +let HOMOTOPIC_PATHS_SYM = prove + (`!s p q. homotopic_paths s p q <=> homotopic_paths s q p`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN ASM_SIMP_TAC[homotopic_paths]);; + +let HOMOTOPIC_PATHS_TRANS = prove + (`!s p q r. + homotopic_paths s p q /\ homotopic_paths s q r + ==> homotopic_paths s p r`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(CONJUNCTS_THEN + (fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART th) THEN + ASSUME_TAC(MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH th))) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE BINOP_CONV [homotopic_paths]) THEN + ASM_REWRITE_TAC[HOMOTOPIC_WITH_TRANS; homotopic_paths]);; + +let HOMOTOPIC_PATHS_EQ = prove + (`!p:real^1->real^N q s. + path p /\ path_image p SUBSET s /\ + (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t)) + ==> homotopic_paths s p q`, + REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_paths] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN + REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN + ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN + ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN + REWRITE_TAC[pathstart; pathfinish] THEN + MESON_TAC[ENDS_IN_UNIT_INTERVAL]);; + +let HOMOTOPIC_PATHS_REPARAMETRIZE = prove + (`!p:real^1->real^N q f:real^1->real^1. + path p /\ path_image p SUBSET s /\ + (?f. f continuous_on interval[vec 0,vec 1] /\ + IMAGE f (interval[vec 0,vec 1]) SUBSET interval[vec 0,vec 1] /\ + f(vec 0) = vec 0 /\ f(vec 1) = vec 1 /\ + !t. t IN interval[vec 0,vec 1] ==> q(t) = p(f t)) + ==> homotopic_paths s p q`, + REWRITE_TAC[path; path_image] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_EQ THEN + ASM_SIMP_TAC[o_THM; pathstart; pathfinish; o_THM; + IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL] THEN + REWRITE_TAC[path; path_image] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `(p:real^1->real^N) o (f:real^1->real^1)` THEN + ASM_SIMP_TAC[o_THM] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + ASM SET_TAC[]]; + REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN + EXISTS_TAC `(p:real^1->real^N) o + (\y. (&1 - drop(fstcart y)) % f(sndcart y) + + drop(fstcart y) % sndcart y)` THEN + ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; + pathstart; pathfinish] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_RZERO; VECTOR_ADD_LID; + VECTOR_MUL_LID; VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - u) % x + u % x:real^N = x`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART; + LINEAR_SNDCART; CONTINUOUS_ON_SUB] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))]; + ONCE_REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE p i SUBSET s + ==> IMAGE f x SUBSET i + ==> IMAGE p (IMAGE f x) SUBSET s`))] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; SNDCART_PASTECART; + FSTCART_PASTECART] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[CONVEX_ALT] (CONJUNCT1(SPEC_ALL + CONVEX_INTERVAL))) THEN + ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC; SUBSET; IN_IMAGE]]);; + +let HOMOTOPIC_PATHS_SUBSET = prove + (`!s p q. + homotopic_paths s p q /\ s SUBSET t + ==> homotopic_paths t p q`, + REWRITE_TAC[homotopic_paths; HOMOTOPIC_WITH_SUBSET_RIGHT]);; + +(* ------------------------------------------------------------------------- *) +(* A slightly ad-hoc but useful lemma in constructing homotopies. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_JOIN_LEMMA = prove + (`!p q:real^1->real^1->real^N. + (\y. p (fstcart y) (sndcart y)) continuous_on + (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\ + (\y. q (fstcart y) (sndcart y)) continuous_on + (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) /\ + (!t. t IN interval[vec 0,vec 1] ==> pathfinish(p t) = pathstart(q t)) + ==> (\y. (p(fstcart y) ++ q(fstcart y)) (sndcart y)) continuous_on + (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1])`, + REWRITE_TAC[joinpaths; PCROSS] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\y. p (fstcart y) (&2 % sndcart y)):real^(1,1)finite_sum->real^N = + (\y. p (fstcart y) (sndcart y)) o + (\y. pastecart (fstcart y) (&2 % sndcart y))` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC]; + SUBGOAL_THEN + `(\y. q (fstcart y) (&2 % sndcart y - vec 1)):real^(1,1)finite_sum->real^N = + (\y. q (fstcart y) (sndcart y)) o + (\y. pastecart (fstcart y) (&2 % sndcart y - vec 1))` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART]; ALL_TAC]; + SIMP_TAC[o_DEF; LIFT_DROP; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; ETA_AX]; + SIMP_TAC[IMP_CONJ; FORALL_IN_GSPEC; FSTCART_PASTECART; SNDCART_PASTECART; + GSYM LIFT_EQ; LIFT_DROP; GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_SIMP_TAC[LIFT_NUM; VECTOR_SUB_REFL]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + (CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_PASTECART; ALL_TAC]) THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_CONST; LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ] THEN + SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Congruence properties of homotopy w.r.t. path-combining operations. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_PATHS_REVERSEPATH = prove + (`!s p q:real^1->real^N. + homotopic_paths s (reversepath p) (reversepath q) <=> + homotopic_paths s p q`, + GEN_TAC THEN MATCH_MP_TAC(MESON[] + `(!p. f(f p) = p) /\ + (!a b. homotopic_paths s a b ==> homotopic_paths s (f a) (f b)) + ==> !a b. homotopic_paths s (f a) (f b) <=> + homotopic_paths s a b`) THEN + REWRITE_TAC[REVERSEPATH_REVERSEPATH] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS; o_DEF] THEN DISCH_THEN + (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\y:real^(1,1)finite_sum. + (h:real^(1,1)finite_sum->real^N) + (pastecart(fstcart y) (vec 1 - sndcart y))` THEN + ASM_REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_SIMP_TAC[reversepath; pathstart; pathfinish; VECTOR_SUB_REFL; + VECTOR_SUB_RZERO] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; + IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]; + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE h s SUBSET t ==> IMAGE g s SUBSET s + ==> IMAGE h (IMAGE g s) SUBSET t`)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; + IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN REAL_ARITH_TAC]);; + +let HOMOTOPIC_PATHS_JOIN = prove + (`!s p q p' q':real^1->real^N. + homotopic_paths s p p' /\ homotopic_paths s q q' /\ + pathfinish p = pathstart q + ==> homotopic_paths s (p ++ q) (p' ++ q')`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `k1:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `k2:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(\y. ((k1 o pastecart (fstcart y)) ++ + (k2 o pastecart (fstcart y))) (sndcart y)) + :real^(1,1)finite_sum->real^N` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN + ASM_REWRITE_TAC[o_DEF; PASTECART_FST_SND; ETA_AX] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[pathstart; pathfinish] THEN ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE + `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN + REWRITE_TAC[path_image; SUBSET; FORALL_IN_IMAGE; o_DEF] THEN ASM SET_TAC[]; + ALL_TAC; ALL_TAC; ALL_TAC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[joinpaths; o_DEF] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[VECTOR_ARITH `&2 % x - x:real^N = x`; VECTOR_MUL_RZERO]);; + +let HOMOTOPIC_PATHS_CONTINUOUS_IMAGE = prove + (`!f:real^1->real^M g h:real^M->real^N s t. + homotopic_paths s f g /\ + h continuous_on s /\ IMAGE h s SUBSET t + ==> homotopic_paths t (h o f) (h o g)`, + REWRITE_TAC[homotopic_paths] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_WITH_MONO)) THEN + SIMP_TAC[pathstart; pathfinish; o_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Group properties for homotopy of paths (so taking equivalence classes *) +(* under homotopy would give the fundamental group). *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_PATHS_RID = prove + (`!s p. path p /\ path_image p SUBSET s + ==> homotopic_paths s (p ++ linepath(pathfinish p,pathfinish p)) p`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN + ASM_REWRITE_TAC[joinpaths] THEN + EXISTS_TAC `\t. if drop t <= &1 / &2 then &2 % t else vec 1` THEN + ASM_REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_RZERO; linepath; pathfinish; + VECTOR_ARITH `(&1 - t) % x + t % x:real^N = x`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `interval[vec 0:real^1,vec 1] = + interval[vec 0,lift(&1 / &2)] UNION interval[lift(&1 / &2),vec 1]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + SIMP_TAC[CLOSED_INTERVAL; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST; IN_INTERVAL_1; DROP_VEC; LIFT_DROP; + GSYM DROP_EQ; DROP_CMUL] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN + GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[DROP_CMUL; DROP_VEC] THEN + ASM_REAL_ARITH_TAC]);; + +let HOMOTOPIC_PATHS_LID = prove + (`!s p:real^1->real^N. + path p /\ path_image p SUBSET s + ==> homotopic_paths s (linepath(pathstart p,pathstart p) ++ p) p`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN + REWRITE_TAC[o_DEF; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN + SIMP_TAC[REVERSEPATH_JOINPATHS; REVERSEPATH_LINEPATH; + PATHFINISH_LINEPATH] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p :real^1->real^N`] + HOMOTOPIC_PATHS_RID) THEN + ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]);; + +let HOMOTOPIC_PATHS_ASSOC = prove + (`!s p q r:real^1->real^N. + path p /\ path_image p SUBSET s /\ + path q /\ path_image q SUBSET s /\ + path r /\ path_image r SUBSET s /\ + pathfinish p = pathstart q /\ pathfinish q = pathstart r + ==> homotopic_paths s (p ++ (q ++ r)) ((p ++ q) ++ r)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET; + PATHSTART_JOIN; PATHFINISH_JOIN] THEN + REWRITE_TAC[joinpaths] THEN + EXISTS_TAC `\t. if drop t <= &1 / &2 then inv(&2) % t + else if drop t <= &3 / &4 then t - lift(&1 / &4) + else &2 % t - vec 1` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; LIFT_DROP] THEN + REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[GSYM LIFT_SUB; GSYM LIFT_CMUL; GSYM LIFT_NUM] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; DROP_VEC] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REWRITE_TAC[DROP_CMUL; DROP_VEC; LIFT_DROP; DROP_SUB] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_RZERO]; + REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + VECTOR_ARITH_TAC; + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + STRIP_TAC THEN + ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[DROP_CMUL] THEN + ASM_REWRITE_TAC[REAL_ARITH `inv(&2) * t <= &1 / &2 <=> t <= &1`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN + ASM_CASES_TAC `drop t <= &3 / &4` THEN + ASM_REWRITE_TAC[DROP_SUB; DROP_VEC; DROP_CMUL; LIFT_DROP; + REAL_ARITH `&2 * (t - &1 / &4) <= &1 / &2 <=> t <= &1 / &2`; + REAL_ARITH `&2 * t - &1 <= &1 / &2 <=> t <= &3 / &4`; + REAL_ARITH `t - &1 / &4 <= &1 / &2 <=> t <= &3 / &4`] THEN + REWRITE_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; GSYM LIFT_CMUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[LIFT_NUM] THEN + REWRITE_TAC[VECTOR_ARITH `a - b - b:real^N = a - &2 % b`]]);; + +let HOMOTOPIC_PATHS_RINV = prove + (`!s p:real^1->real^N. + path p /\ path_image p SUBSET s + ==> homotopic_paths s + (p ++ reversepath p) (linepath(pathstart p,pathstart p))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN + EXISTS_TAC `(\y. (subpath (vec 0) (fstcart y) p ++ + reversepath(subpath (vec 0) (fstcart y) p)) (sndcart y)) + : real^(1,1)finite_sum->real^N` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL] THEN + REWRITE_TAC[ETA_AX; PATHSTART_JOIN; PATHFINISH_JOIN] THEN + REWRITE_TAC[REVERSEPATH_SUBPATH; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[joinpaths] THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN + RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + CONTINUOUS_ON_CMUL]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN + REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[subpath; VECTOR_ADD_LID; VECTOR_SUB_RZERO] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + CONTINUOUS_ON_CMUL; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_IN_IMAGE; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_CMUL; DROP_VEC; DROP_ADD; + REAL_ARITH `t + (&0 - t) * (&2 * x - &1) = + t * &2 * (&1 - x)`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_SUB_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop x * &2 * &1 / &2` THEN CONJ_TAC THEN + REPEAT(MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC) THEN + ASM_REAL_ARITH_TAC]; + SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; + REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[subpath] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_VEC; DROP_ADD; DROP_CMUL; + LIFT_DROP] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX; + SET_RULE `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN + REWRITE_TAC[GSYM path_image] THEN MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN + REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [path_image]) THEN + MATCH_MP_TAC(SET_RULE + `t SUBSET s /\ u SUBSET s + ==> IMAGE p s SUBSET v + ==> IMAGE p t SUBSET v /\ IMAGE p u SUBSET v`) THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_INTERVAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; REAL_POS; REAL_LE_REFL]; + REWRITE_TAC[subpath; linepath; pathstart; joinpaths] THEN + REWRITE_TAC[VECTOR_SUB_REFL; DROP_VEC; VECTOR_MUL_LZERO] THEN + REWRITE_TAC[VECTOR_ADD_RID; COND_ID] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[pathstart; PATHFINISH_LINEPATH; PATHSTART_LINEPATH]]);; + +let HOMOTOPIC_PATHS_LINV = prove + (`!s p:real^1->real^N. + path p /\ path_image p SUBSET s + ==> homotopic_paths s + (reversepath p ++ p) (linepath(pathfinish p,pathfinish p))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `reversepath p:real^1->real^N`] + HOMOTOPIC_PATHS_RINV) THEN + ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN + REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + REVERSEPATH_REVERSEPATH]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy of loops without requiring preservation of endpoints. *) +(* ------------------------------------------------------------------------- *) + +let homotopic_loops = new_definition + `homotopic_loops s p q = + homotopic_with + (\r. pathfinish r = pathstart r) + (interval[vec 0:real^1,vec 1],s) + p q`;; + +let HOMOTOPIC_LOOPS = prove + (`!s p q:real^1->real^N. + homotopic_loops s p q <=> + ?h. h continuous_on + interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1] /\ + IMAGE h (interval[vec 0,vec 1] PCROSS interval[vec 0,vec 1]) + SUBSET s /\ + (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 0) x) = p x) /\ + (!x. x IN interval[vec 0,vec 1] ==> h(pastecart (vec 1) x) = q x) /\ + (!t. t IN interval[vec 0:real^1,vec 1] + ==> pathfinish(h o pastecart t) = pathstart(h o pastecart t))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[homotopic_loops] THEN + W(MP_TAC o PART_MATCH (lhand o rand) HOMOTOPIC_WITH o lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[pathstart; pathfinish; ENDS_IN_UNIT_INTERVAL]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; + +let HOMOTOPIC_LOOPS_IMP_LOOP = prove + (`!s p q. homotopic_loops s p q + ==> pathfinish p = pathstart p /\ + pathfinish q = pathstart q`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN + SIMP_TAC[]);; + +let HOMOTOPIC_LOOPS_IMP_PATH = prove + (`!s p q. homotopic_loops s p q ==> path p /\ path q`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN + SIMP_TAC[path]);; + +let HOMOTOPIC_LOOPS_IMP_SUBSET = prove + (`!s p q. + homotopic_loops s p q ==> path_image p SUBSET s /\ path_image q SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + SIMP_TAC[path_image]);; + +let HOMOTOPIC_LOOPS_REFL = prove + (`!s p. homotopic_loops s p p <=> + path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p`, + REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_REFL; path; path_image]);; + +let HOMOTOPIC_LOOPS_SYM = prove + (`!s p q. homotopic_loops s p q <=> homotopic_loops s q p`, + REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SYM]);; + +let HOMOTOPIC_LOOPS_TRANS = prove + (`!s p q r. + homotopic_loops s p q /\ homotopic_loops s q r + ==> homotopic_loops s p r`, + REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_TRANS]);; + +let HOMOTOPIC_LOOPS_SUBSET = prove + (`!s p q. + homotopic_loops s p q /\ s SUBSET t + ==> homotopic_loops t p q`, + REWRITE_TAC[homotopic_loops; HOMOTOPIC_WITH_SUBSET_RIGHT]);; + +let HOMOTOPIC_LOOPS_EQ = prove + (`!p:real^1->real^N q s. + path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ + (!t. t IN interval[vec 0,vec 1] ==> p(t) = q(t)) + ==> homotopic_loops s p q`, + REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_loops] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN + REPEAT(EXISTS_TAC `p:real^1->real^N`) THEN + ASM_SIMP_TAC[HOMOTOPIC_WITH_REFL] THEN + ASM_REWRITE_TAC[GSYM path; GSYM path_image] THEN + REWRITE_TAC[pathstart; pathfinish] THEN + MESON_TAC[ENDS_IN_UNIT_INTERVAL]);; + +let HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE = prove + (`!f:real^1->real^M g h:real^M->real^N s t. + homotopic_loops s f g /\ + h continuous_on s /\ IMAGE h s SUBSET t + ==> homotopic_loops t (h o f) (h o g)`, + REWRITE_TAC[homotopic_loops] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_WITH_MONO)) THEN + SIMP_TAC[pathstart; pathfinish; o_THM]);; + +let HOMOTOPIC_LOOPS_SHIFTPATH_SELF = prove + (`!p:real^1->real^N t s. + path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ + t IN interval[vec 0,vec 1] + ==> homotopic_loops s p (shiftpath t p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_LOOPS] THEN EXISTS_TAC + `\z. shiftpath (drop t % fstcart z) (p:real^1->real^N) (sndcart z)` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_DEF] THEN + REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; ETA_AX] THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC(SET_RULE + `IMAGE p t SUBSET u /\ + (!x. x IN s ==> IMAGE(shiftpath (f x) p) t = IMAGE p t) + ==> (!x y. x IN s /\ y IN t ==> shiftpath (f x) p y IN u)`) THEN + ASM_REWRITE_TAC[GSYM path_image] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC PATH_IMAGE_SHIFTPATH THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[REAL_LE_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]; + SIMP_TAC[shiftpath; VECTOR_ADD_LID; IN_INTERVAL_1; DROP_VEC]; + REWRITE_TAC[LIFT_DROP]; + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN MATCH_MP_TAC CLOSED_SHIFTPATH THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[REAL_LE_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[]] THEN + REWRITE_TAC[shiftpath; DROP_ADD; DROP_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; + LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + CONTINUOUS_ON_CONST] THEN + RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; + DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; o_DEF; LIFT_DROP; + LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_SUB] THEN + RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; + DROP_ADD; DROP_CMUL; DROP_VEC; REAL_LE_ADD; REAL_LE_MUL] THEN + SIMP_TAC[REAL_ARITH `&0 <= x + y - &1 <=> &1 <= x + y`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `t * x <= &1 * &1 /\ y <= &1 ==> t * x + y - &1 <= &1`) THEN + ASM_SIMP_TAC[REAL_LE_MUL2; REAL_POS]; + REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART]; + SIMP_TAC[GSYM LIFT_EQ; LIFT_ADD; LIFT_CMUL; LIFT_DROP; LIFT_NUM; + VECTOR_ARITH `a + b - c:real^1 = (a + b) - c`] THEN + ASM_MESON_TAC[VECTOR_SUB_REFL; pathstart; pathfinish]]);; + +(* ------------------------------------------------------------------------- *) +(* Relations between the two variants of homotopy. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS = prove + (`!s p q. homotopic_paths s p q /\ + pathfinish p = pathstart p /\ + pathfinish q = pathstart p + ==> homotopic_loops s p q`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[homotopic_paths; homotopic_loops] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_MONO) THEN + ASM_SIMP_TAC[]);; + +let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL = prove + (`!s p a:real^N. + homotopic_loops s p (linepath(a,a)) + ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_LOOPS_IMP_LOOP) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_PATH) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_loops]) THEN + REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC + `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[HOMOTOPIC_PATHS_RID; HOMOTOPIC_PATHS_SYM]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC + `linepath(pathstart p,pathstart p) ++ (p:real^1->real^N) ++ + linepath(pathfinish p,pathfinish p)` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MP_TAC(ISPECL [`s:real^N->bool`; + `(p:real^1->real^N) ++ linepath(pathfinish p,pathfinish p)`] + HOMOTOPIC_PATHS_LID) THEN + REWRITE_TAC[PATHSTART_JOIN] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_LINEPATH; PATHSTART_LINEPATH] THEN + MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN EXISTS_TAC + `((\u. (h:real^(1,1)finite_sum->real^N) (pastecart u (vec 0))) ++ + linepath(a,a) ++ + reversepath(\u. h (pastecart u (vec 0))))` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(MESON[HOMOTOPIC_PATHS_LID; HOMOTOPIC_PATHS_JOIN; + HOMOTOPIC_PATHS_TRANS; HOMOTOPIC_PATHS_SYM; + HOMOTOPIC_PATHS_RINV] + `(path p /\ path(reversepath p)) /\ + (path_image p SUBSET s /\ path_image(reversepath p) SUBSET s) /\ + (pathfinish p = pathstart(linepath(b,b) ++ reversepath p) /\ + pathstart(reversepath p) = b) /\ + pathstart p = a + ==> homotopic_paths s (p ++ linepath(b,b) ++ reversepath p) + (linepath(a,a))`) THEN + REWRITE_TAC[PATHSTART_REVERSEPATH; PATHSTART_JOIN; PATH_REVERSEPATH; + PATH_IMAGE_REVERSEPATH; PATHSTART_LINEPATH] THEN + ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish; + LINEPATH_REFL] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; + ENDS_IN_UNIT_INTERVAL]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM; + ENDS_IN_UNIT_INTERVAL]]] THEN + REWRITE_TAC[homotopic_paths; homotopic_with; PCROSS] THEN + EXISTS_TAC + `\y:real^(1,1)finite_sum. + (subpath (vec 0) (fstcart y) (\u. h(pastecart u (vec 0))) ++ + (\u. (h:real^(1,1)finite_sum->real^N) (pastecart (fstcart y) u)) ++ + subpath (fstcart y) (vec 0) (\u. h(pastecart u (vec 0)))) + (sndcart y)` THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL; + SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX; + PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[pathstart]] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN + ASM_REWRITE_TAC[PASTECART_FST_SND; ETA_AX] THEN CONJ_TAC THENL + [ALL_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + REWRITE_TAC[PATHSTART_SUBPATH] THEN + ASM_SIMP_TAC[pathstart; pathfinish]]; + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + REWRITE_TAC[PATHFINISH_SUBPATH; PATHSTART_JOIN] THEN + ASM_SIMP_TAC[pathstart]] THEN + REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; VECTOR_ADD_LID] THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_MUL; + LIFT_DROP; CONTINUOUS_ON_NEG; DROP_NEG; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + LIFT_NEG; o_DEF; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_ADD; DROP_NEG; DROP_VEC; DROP_CMUL; REAL_POS] THEN + SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE; REAL_ARITH + `t + --t * x = t * (&1 - x)`] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `t * x <= t * &1 /\ &1 * t <= &1 * &1 ==> t * x <= &1`) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; + + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; IMP_CONJ; + RIGHT_FORALL_IMP_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE + `(!x. x IN s ==> f x IN t) <=> IMAGE f s SUBSET t`] THEN + REWRITE_TAC[GSYM path_image; ETA_AX] THEN + REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + REWRITE_TAC[path_image; subpath] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_PASTECART_THM] THEN + SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL; DROP_ADD] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH `t + (&0 - t) * x = t * (&1 - x)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_SUB_LE] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]);; + +let HOMOTOPIC_LOOPS_CONJUGATE = prove + (`!p q s:real^N->bool. + path p /\ path_image p SUBSET s /\ + path q /\ path_image q SUBSET s /\ + pathfinish p = pathstart q /\ pathfinish q = pathstart q + ==> homotopic_loops s (p ++ q ++ reversepath p) q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN EXISTS_TAC + `linepath(pathstart q,pathstart q) ++ (q:real^1->real^N) ++ + linepath(pathstart q,pathstart q)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN + MP_TAC(ISPECL [`s:real^N->bool`; + `(q:real^1->real^N) ++ linepath(pathfinish q,pathfinish q)`] + HOMOTOPIC_PATHS_LID) THEN + ASM_SIMP_TAC[PATHSTART_JOIN; PATHFINISH_JOIN; UNION_SUBSET; SING_SUBSET; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_IMAGE_LINEPATH; + PATH_JOIN; PATH_IMAGE_JOIN; PATH_LINEPATH; SEGMENT_REFL] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN + ASM_MESON_TAC[HOMOTOPIC_PATHS_RID]] THEN + REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN + EXISTS_TAC + `(\y. (subpath (fstcart y) (vec 1) p ++ q ++ subpath (vec 1) (fstcart y) p) + (sndcart y)):real^(1,1)finite_sum->real^N` THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SUBPATH_TRIVIAL; + SUBPATH_REFL; SUBPATH_REVERSEPATH; ETA_AX; + PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[path; path_image]) THEN + MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN + REPEAT CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REWRITE_RULE[PCROSS] HOMOTOPIC_JOIN_LEMMA) THEN + REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + SIMP_TAC[SNDCART_PASTECART]; + ALL_TAC; + REWRITE_TAC[PATHSTART_SUBPATH] THEN ASM_REWRITE_TAC[pathfinish]]; + REWRITE_TAC[PATHSTART_JOIN; PATHFINISH_SUBPATH] THEN + ASM_REWRITE_TAC[pathstart]] THEN + REWRITE_TAC[subpath] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + (CONJ_TAC THENL + [REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; CONTINUOUS_ON_CONST; LINEAR_FSTCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_ADD; DROP_SUB; DROP_VEC; DROP_CMUL]]) + THENL + [REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC REAL_LE_MUL) THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `t + (&1 - t) * x <= &1 <=> + (&1 - t) * x <= (&1 - t) * &1`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `x * (&1 - t) <= x * &1 /\ x <= &1 + ==> &0 <= &1 + (t - &1) * x`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH + `a + (t - &1) * x <= a <=> &0 <= (&1 - t) * x`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[ETA_AX; GSYM path_image; SET_RULE + `(!x. x IN i ==> f x IN s) <=> IMAGE f i SUBSET s`] THEN + REPEAT STRIP_TAC THEN + REPEAT(MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `path_image p:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC PATH_IMAGE_SUBPATH_SUBSET THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);; + +(* ------------------------------------------------------------------------- *) +(* Relating homotopy of trivial loops to path-connectedness. *) +(* ------------------------------------------------------------------------- *) + +let PATH_COMPONENT_IMP_HOMOTOPIC_POINTS = prove + (`!s a b:real^N. + path_component s a b + ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`, + REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[pathstart; pathfinish; path_image; path] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\y:real^(1,1)finite_sum. (g(fstcart y):real^N)` THEN + ASM_SIMP_TAC[FSTCART_PASTECART; linepath] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - x) % a + x % a:real^N = a`] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC; FSTCART_PASTECART]);; + +let HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE = prove + (`!s p q:real^1->real^N t. + homotopic_loops s p q /\ t IN interval[vec 0,vec 1] + ==> path_component s (p t) (q t)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[path_component; homotopic_loops; homotopic_with; PCROSS] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` MP_TAC) THEN + STRIP_TAC THEN + EXISTS_TAC `\u. (h:real^(1,1)finite_sum->real^N) (pastecart u t)` THEN + ASM_REWRITE_TAC[pathstart; pathfinish] THEN CONJ_TAC THENL + [REWRITE_TAC[path] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ASM SET_TAC[]]; + REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);; + +let HOMOTOPIC_POINTS_EQ_PATH_COMPONENT = prove + (`!s a b:real^N. + homotopic_loops s (linepath(a,a)) (linepath(b,b)) <=> + path_component s a b`, + REPEAT GEN_TAC THEN EQ_TAC THEN + REWRITE_TAC[PATH_COMPONENT_IMP_HOMOTOPIC_POINTS] THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^1` o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_LOOPS_IMP_PATH_COMPONENT_VALUE)) THEN + REWRITE_TAC[linepath; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - &0) % a + &0 % b:real^N = a`]);; + +let PATH_CONNECTED_EQ_HOMOTOPIC_POINTS = prove + (`!s:real^N->bool. + path_connected s <=> + !a b. a IN s /\ b IN s + ==> homotopic_loops s (linepath(a,a)) (linepath(b,b))`, + GEN_TAC THEN REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN + REWRITE_TAC[path_connected; path_component]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy of "nearby" function, paths and loops. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_WITH_LINEAR = prove + (`!f g:real^M->real^N s t. + f continuous_on s /\ g continuous_on s /\ + (!x. x IN s ==> segment[f x,g x] SUBSET t) + ==> homotopic_with (\z. T) (s,t) f g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[homotopic_with] THEN + EXISTS_TAC + `\y. ((&1 - drop(fstcart y)) % (f:real^M->real^N)(sndcart y) + + drop(fstcart y) % g(sndcart y):real^N)` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; ETA_AX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + SIMP_TAC[SNDCART_PASTECART; FORALL_IN_PCROSS]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^M`] THEN STRIP_TAC THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^M` THEN + ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN + ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]);; + +let HOMOTOPIC_PATHS_LINEAR,HOMOTOPIC_LOOPS_LINEAR = (CONJ_PAIR o prove) + (`(!g s:real^N->bool h. + path g /\ path h /\ + pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ + (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s) + ==> homotopic_paths s g h) /\ + (!g s:real^N->bool h. + path g /\ path h /\ + pathfinish g = pathstart g /\ pathfinish h = pathstart h /\ + (!t x. t IN interval[vec 0,vec 1] ==> segment[g t,h t] SUBSET s) + ==> homotopic_loops s g h)`, + CONJ_TAC THEN + (REWRITE_TAC[pathstart; pathfinish] THEN + REWRITE_TAC[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[homotopic_paths; homotopic_loops; homotopic_with; PCROSS] THEN + EXISTS_TAC + `\y:real^(1,1)finite_sum. + ((&1 - drop(fstcart y)) % g(sndcart y) + + drop(fstcart y) % h(sndcart y):real^N)` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN + ASM_REWRITE_TAC[pathstart; pathfinish; REAL_SUB_REFL; REAL_SUB_RZERO] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - t) % a + t % a:real^N = a`] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_ADD_RID] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; LIFT_SUB] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; ETA_AX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + RULE_ASSUM_TAC(REWRITE_RULE[path]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + SIMP_TAC[SNDCART_PASTECART]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `u:real^1`] THEN STRIP_TAC THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `u:real^1` THEN + ASM_REWRITE_TAC[IN_SEGMENT] THEN EXISTS_TAC `drop t` THEN + ASM_MESON_TAC[IN_INTERVAL_1; DROP_VEC]]));; + +let HOMOTOPIC_PATHS_NEARBY_EXPLICIT, + HOMOTOPIC_LOOPS_NEARBY_EXPLICIT = (CONJ_PAIR o prove) + (`(!g s:real^N->bool h. + path g /\ path h /\ + pathstart h = pathstart g /\ pathfinish h = pathfinish g /\ + (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s) + ==> norm(h t - g t) < norm(g t - x)) + ==> homotopic_paths s g h) /\ + (!g s:real^N->bool h. + path g /\ path h /\ + pathfinish g = pathstart g /\ pathfinish h = pathstart h /\ + (!t x. t IN interval[vec 0,vec 1] /\ ~(x IN s) + ==> norm(h t - g t) < norm(g t - x)) + ==> homotopic_loops s g h)`, + ONCE_REWRITE_TAC[TAUT `p /\ ~q ==> r <=> p /\ ~r ==> q`] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_LINEAR; + MATCH_MP_TAC HOMOTOPIC_LOOPS_LINEAR] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; segment; FORALL_IN_GSPEC] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + X_GEN_TAC `u:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `t:real^1` THEN + ASM_REWRITE_TAC[REAL_NOT_LT] THEN + MP_TAC(ISPECL [`(g:real^1->real^N) t`; `(h:real^1->real^N) t`] + DIST_IN_CLOSED_SEGMENT) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + REWRITE_TAC[segment; FORALL_IN_GSPEC; + ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + ASM_MESON_TAC[]);; + +let HOMOTOPIC_NEARBY_PATHS,HOMOTOPIC_NEARBY_LOOPS = (CONJ_PAIR o prove) + (`(!g s:real^N->bool. + path g /\ open s /\ path_image g SUBSET s + ==> ?e. &0 < e /\ + !h. path h /\ + pathstart h = pathstart g /\ + pathfinish h = pathfinish g /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e) + ==> homotopic_paths s g h) /\ + (!g s:real^N->bool. + path g /\ pathfinish g = pathstart g /\ open s /\ path_image g SUBSET s + ==> ?e. &0 < e /\ + !h. path h /\ + pathfinish h = pathstart h /\ + (!t. t IN interval[vec 0,vec 1] ==> norm(h t - g t) < e) + ==> homotopic_loops s g h)`, + CONJ_TAC THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`path_image g:real^N->bool`; `(:real^N) DIFF s`] + SEPARATE_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_DIFF; IN_UNIV; dist]]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + REWRITE_TAC[REAL_NOT_LE] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real^1->real^N` THEN STRIP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_NEARBY_EXPLICIT; + MATCH_MP_TAC HOMOTOPIC_LOOPS_NEARBY_EXPLICIT] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `x:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e:real` THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[path_image] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy of non-antipodal sphere maps. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS = prove + (`!f g:real^M->real^N s a r. + f continuous_on s /\ IMAGE f s SUBSET sphere(a,r) /\ + g continuous_on s /\ IMAGE g s SUBSET sphere(a,r) /\ + (!x. x IN s ==> ~(midpoint(f x,g x) = a)) + ==> homotopic_with (\x. T) (s,sphere(a,r)) f g`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `r <= &0` THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN + REPEAT(EXISTS_TAC `g:real^M->real^N`) THEN + ASM_REWRITE_TAC[HOMOTOPIC_WITH_REFL] THEN + SUBGOAL_THEN `?c:real^N. sphere(a,r) SUBSET {c}` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[SPHERE_SING; SPHERE_EMPTY; REAL_LT_LE] THEN + MESON_TAC[SUBSET_REFL; EMPTY_SUBSET]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LE]) THEN STRIP_TAC] THEN + SUBGOAL_THEN + `homotopic_with (\z. T) (s:real^M->bool,(:real^N) DELETE a) f g` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_LINEAR THEN + ASM_REWRITE_TAC[SET_RULE `s SUBSET UNIV DELETE a <=> ~(a IN s)`] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_SPHERE; IMP_IMP] THEN + REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + FIRST_X_ASSUM(MP_TAC o GSYM o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; MIDPOINT_BETWEEN] THEN + MESON_TAC[DIST_SYM]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o + ISPECL [`\y:real^N. a + r / norm(y - a) % (y - a)`; + `sphere(a:real^N,r)`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[real_div; o_DEF; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[IN_DELETE; NORM_EQ_0; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]; + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_DELETE; IN_SPHERE] THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + b) = norm b`] THEN + SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[real_abs; REAL_LE_RMUL; REAL_DIV_RMUL; + NORM_EQ_0; VECTOR_SUB_EQ; REAL_LT_IMP_LE]]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE]) THEN + ASM_SIMP_TAC[NORM_ARITH `norm(a - b:real^N) = dist(b,a)`] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN REPEAT STRIP_TAC THEN + VECTOR_ARITH_TAC]);; + +let HOMOTOPIC_NON_ANTIPODAL_SPHEREMAPS = prove + (`!f g:real^M->real^N s r. + f continuous_on s /\ IMAGE f s SUBSET sphere(vec 0,r) /\ + g continuous_on s /\ IMAGE g s SUBSET sphere(vec 0,r) /\ + (!x. x IN s ==> ~(f x = --g x)) + ==> homotopic_with (\x. T) (s,sphere(vec 0,r)) f g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_NON_MIDPOINT_SPHEREMAPS THEN + ASM_REWRITE_TAC[midpoint; VECTOR_ARITH + `inv(&2) % (a + b):real^N = vec 0 <=> a = --b`]);; + +(* ------------------------------------------------------------------------- *) +(* Retracts, in a general sense, preserve (co)homotopic triviality. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove + (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. + (h continuous_on s /\ IMAGE h s = t /\ + k continuous_on t /\ IMAGE k t SUBSET s /\ + (!y. y IN t ==> h(k y) = y) /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\ + (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\ + (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ P f /\ + g continuous_on u /\ IMAGE g u SUBSET s /\ P g + ==> homotopic_with P (u,s) f g) + ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f /\ + g continuous_on u /\ IMAGE g u SUBSET t /\ Q g + ==> homotopic_with Q (u,t) f g)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`p:real^P->real^N`; `q:real^P->real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`(k:real^N->real^M) o (p:real^P->real^N)`; + `(k:real^N->real^M) o (q:real^P->real^N)`]) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC + [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`; + `(h:real^M->real^N) o (k:real^N->real^M) o (q:real^P->real^N)`] THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_WITH_MONO)) THEN + ASM_SIMP_TAC[]);; + +let HOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove + (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. + (h continuous_on s /\ IMAGE h s = t /\ + k continuous_on t /\ IMAGE k t SUBSET s /\ + (!y. y IN t ==> h(k y) = y) /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f ==> P(k o f)) /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f ==> Q(h o f)) /\ + (!h k. (!x. x IN u ==> h x = k x) ==> (Q h <=> Q k))) /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET s /\ P f + ==> ?c. homotopic_with P (u,s) f (\x. c)) + ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t /\ Q f + ==> ?c. homotopic_with Q (u,t) f (\x. c))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^P->real^N` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `(k:real^N->real^M) o (p:real^P->real^N)`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[IMAGE_o] THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_TAC `c:real^M`)] THEN + EXISTS_TAC `(h:real^M->real^N) c` THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC + [`(h:real^M->real^N) o (k:real^N->real^M) o (p:real^P->real^N)`; + `(h:real^M->real^N) o ((\x. c):real^P->real^M)`] THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_WITH_MONO)) THEN + ASM_SIMP_TAC[]);; + +let COHOMOTOPICALLY_TRIVIAL_RETRACTION_GEN = prove + (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. + (h continuous_on s /\ IMAGE h s = t /\ + k continuous_on t /\ IMAGE k t SUBSET s /\ + (!y. y IN t ==> h(k y) = y) /\ + (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\ + (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\ + (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ P f /\ + g continuous_on s /\ IMAGE g s SUBSET u /\ P g + ==> homotopic_with P (s,u) f g) + ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ Q g + ==> homotopic_with Q (t,u) f g)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`p:real^N->real^P`; `q:real^N->real^P`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`(p:real^N->real^P) o (h:real^M->real^N)`; + `(q:real^N->real^P) o (h:real^M->real^N)`]) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC + [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`; + `((q:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`] THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_WITH_MONO)) THEN + ASM_SIMP_TAC[]);; + +let COHOMOTOPICALLY_TRIVIAL_RETRACTION_NULL_GEN = prove + (`!P Q s:real^M->bool t:real^N->bool u:real^P->bool h k. + (h continuous_on s /\ IMAGE h s = t /\ + k continuous_on t /\ IMAGE k t SUBSET s /\ + (!y. y IN t ==> h(k y) = y) /\ + (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f ==> P(f o h)) /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f ==> Q(f o k)) /\ + (!h k. (!x. x IN t ==> h x = k x) ==> (Q h <=> Q k))) /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET u /\ P f + ==> ?c. homotopic_with P (s,u) f (\x. c)) + ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u /\ Q f + ==> ?c. homotopic_with Q (t,u) f (\x. c))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `p:real^N->real^P` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `(p:real^N->real^P) o (h:real^M->real^N)`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[IMAGE_o] THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN ASM_REWRITE_TAC[] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_EQ THEN MAP_EVERY EXISTS_TAC + [`((p:real^N->real^P) o (h:real^M->real^N)) o (k:real^N->real^M)`; + `((\x. c):real^M->real^P) o (k:real^N->real^M)`] THEN + ASM_REWRITE_TAC[o_THM] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_WITH_MONO)) THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Another useful lemma. *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_JOIN_SUBPATHS = prove + (`!g:real^1->real^N s. + path g /\ path_image g SUBSET s /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] /\ + w IN interval[vec 0,vec 1] + ==> homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g)`, + let lemma1 = prove + (`!g:real^1->real^N s. + drop u <= drop v /\ drop v <= drop w + ==> path g /\ path_image g SUBSET s /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] /\ + w IN interval[vec 0,vec 1] /\ + drop u <= drop v /\ drop v <= drop w + ==> homotopic_paths s + (subpath u v g ++ subpath v w g) (subpath u w g)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN + EXISTS_TAC `path_image g:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `w:real^1 = u` THENL + [MP_TAC(ISPECL + [`path_image g:real^N->bool`; + `subpath u v (g:real^1->real^N)`] HOMOTOPIC_PATHS_RINV) THEN + ASM_REWRITE_TAC[REVERSEPATH_SUBPATH; SUBPATH_REFL] THEN + REWRITE_TAC[LINEPATH_REFL; PATHSTART_SUBPATH] THEN + ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_REPARAMETRIZE THEN + ASM_SIMP_TAC[PATH_SUBPATH; PATH_IMAGE_SUBPATH_SUBSET] THEN + EXISTS_TAC + `\t. if drop t <= &1 / &2 + then inv(drop(w - u)) % (&2 * drop(v - u)) % t + else inv(drop(w - u)) % + ((v - u) + drop(w - v) % (&2 % t - vec 1))` THEN + REWRITE_TAC[DROP_VEC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[VECTOR_MUL_RZERO] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_CASES_1 THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP; GSYM LIFT_NUM; + DROP_ADD; DROP_SUB] THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [CONTINUOUS_ON_MUL; o_DEF; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; + CONTINUOUS_ON_SUB; CONTINUOUS_ON_ADD] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC; + SUBGOAL_THEN `drop u < drop w` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_LE; DROP_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_CMUL; DROP_VEC; DROP_ADD; DROP_SUB] THEN + ONCE_REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + (CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC]) THEN + REWRITE_TAC[REAL_ARITH `v - u + x * t <= w - u <=> x * t <= w - v`; + REAL_ARITH `(&2 * x) * t = x * &2 * t`] THEN + MATCH_MP_TAC(REAL_ARITH `a * t <= a * &1 /\ a <= b ==> a * t <= b`) THEN + (CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_LMUL; ALL_TAC]) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `(v - u) + (w - v) * &1 = w - u`] THEN + ASM_SIMP_TAC[REAL_SUB_0; DROP_EQ; REAL_MUL_LINV]; + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[subpath; joinpaths] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; DROP_EQ_0; VECTOR_SUB_EQ] THEN + AP_TERM_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC; DROP_ADD; DROP_CMUL; DROP_SUB] THEN + REAL_ARITH_TAC]) in + let lemma2 = prove + (`path g /\ path_image g SUBSET s /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] /\ + w IN interval[vec 0,vec 1] /\ + homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g) + ==> homotopic_paths s (subpath w v g ++ subpath v u g) (subpath w u g)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN + SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + ASM_REWRITE_TAC[REVERSEPATH_SUBPATH]) in + let lemma3 = prove + (`path (g:real^1->real^N) /\ path_image g SUBSET s /\ + u IN interval[vec 0,vec 1] /\ + v IN interval[vec 0,vec 1] /\ + w IN interval[vec 0,vec 1] /\ + homotopic_paths s (subpath u v g ++ subpath v w g) (subpath u w g) + ==> homotopic_paths s (subpath v w g ++ subpath w u g) (subpath v u g)`, + let tac = + ASM_MESON_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; PATH_SUBPATH; + HOMOTOPIC_PATHS_REFL; PATH_IMAGE_SUBPATH_SUBSET; SUBSET_TRANS; + PATHSTART_JOIN; PATHFINISH_JOIN] in + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM HOMOTOPIC_PATHS_REVERSEPATH] THEN + SIMP_TAC[REVERSEPATH_JOINPATHS; PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + ASM_REWRITE_TAC[REVERSEPATH_SUBPATH] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC + `(subpath u v g ++ subpath v w g) ++ subpath w v g:real^1->real^N` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN tac; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC + `subpath u v g ++ (subpath v w g ++ subpath w v g):real^1->real^N` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN tac; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC + `(subpath u v g :real^1->real^N) ++ + linepath(pathfinish(subpath u v g),pathfinish(subpath u v g))` THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN tac] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + REPEAT CONJ_TAC THENL [tac; ALL_TAC; tac] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC + `linepath(pathstart(subpath v w g):real^N,pathstart(subpath v w g))` THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REVERSEPATH_SUBPATH] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_RINV THEN tac; + ALL_TAC] THEN + REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; HOMOTOPIC_PATHS_REFL; + PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; + INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_MESON_TAC[path_image; IN_IMAGE; SUBSET]) in + REPEAT STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `(drop u <= drop v /\ drop v <= drop w \/ + drop w <= drop v /\ drop v <= drop u) \/ + (drop u <= drop w /\ drop w <= drop v \/ + drop v <= drop w /\ drop w <= drop u) \/ + (drop v <= drop u /\ drop u <= drop w \/ + drop w <= drop u /\ drop u <= drop v)`) THEN + FIRST_ASSUM(MP_TAC o SPECL [`g:real^1->real^N`; `s:real^N->bool`] o + MATCH_MP lemma1) THEN + ASM_MESON_TAC[lemma2; lemma3]);; + +let HOMOTOPIC_LOOPS_SHIFTPATH = prove + (`!s:real^N->bool p q u. + homotopic_loops s p q /\ u IN interval[vec 0,vec 1] + ==> homotopic_loops s (shiftpath u p) (shiftpath u q)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; homotopic_with; PCROSS] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN DISCH_THEN( + (X_CHOOSE_THEN `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC + `\z. shiftpath u (\t. (h:real^(1,1)finite_sum->real^N) + (pastecart (fstcart z) t)) (sndcart z)` THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX] THEN + ASM_SIMP_TAC[CLOSED_SHIFTPATH] THEN CONJ_TAC THENL + [REWRITE_TAC[shiftpath; DROP_ADD; REAL_ARITH + `u + z <= &1 <=> z <= &1 - u`] THEN + SUBGOAL_THEN + `{ pastecart (t:real^1) (x:real^1) | + t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1]} = + { pastecart (t:real^1) (x:real^1) | + t IN interval[vec 0,vec 1] /\ x IN interval[vec 0,vec 1 - u]} UNION + { pastecart (t:real^1) (x:real^1) | + t IN interval[vec 0,vec 1] /\ x IN interval[vec 1 - u,vec 1]}` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE `s UNION s' = u + ==> {f t x | t IN i /\ x IN u} = + {f t x | t IN i /\ x IN s} UNION + {f t x | t IN i /\ x IN s'}`) THEN + UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN + REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + SIMP_TAC[REWRITE_RULE[PCROSS] CLOSED_PCROSS; CLOSED_INTERVAL] THEN + REWRITE_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; TAUT + `p /\ q \/ r /\ s ==> t <=> (p ==> q ==> t) /\ (r ==> s ==> t)`] THEN + SIMP_TAC[SNDCART_PASTECART; IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN + SIMP_TAC[REAL_ARITH `&1 - u <= x ==> (x <= &1 - u <=> x = &1 - u)`] THEN + SIMP_TAC[GSYM LIFT_EQ; LIFT_SUB; LIFT_DROP; LIFT_NUM] THEN + REWRITE_TAC[FSTCART_PASTECART; VECTOR_ARITH `u + v - u:real^N = v`; + VECTOR_ARITH `u + v - u - v:real^N = vec 0`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart; pathfinish]) THEN + ASM_SIMP_TAC[GSYM IN_INTERVAL_1; GSYM DROP_VEC] THEN CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; + LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART; + VECTOR_ARITH `u + z - v:real^N = (u - v) + z`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + UNDISCH_TAC `(u:real^1) IN interval[vec 0,vec 1]` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; + IN_ELIM_PASTECART_THM; DROP_ADD; DROP_SUB; DROP_VEC] THEN + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; SET_RULE + `(!t x. t IN i /\ x IN i ==> f t x IN s) <=> + (!t. t IN i ==> IMAGE (f t) i SUBSET s)`] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN REWRITE_TAC[GSYM path_image] THEN + ASM_SIMP_TAC[PATH_IMAGE_SHIFTPATH; ETA_AX] THEN + REWRITE_TAC[path_image] THEN ASM SET_TAC[]]);; + +let HOMOTOPIC_PATHS_LOOP_PARTS = prove + (`!s p q a:real^N. + homotopic_loops s (p ++ reversepath q) (linepath(a,a)) /\ path q + ==> homotopic_paths s p q`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL) THEN + REWRITE_TAC[PATHSTART_JOIN] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN + ASM_CASES_TAC `pathfinish p:real^N = pathstart(reversepath q)` THENL + [ASM_SIMP_TAC[PATH_JOIN; PATH_REVERSEPATH] THEN STRIP_TAC; + ASM_MESON_TAC[PATH_JOIN_PATH_ENDS; PATH_REVERSEPATH]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[PATHSTART_REVERSEPATH]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN + ASM_SIMP_TAC[PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; UNION_SUBSET; SING_SUBSET; + PATH_IMAGE_REVERSEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `p ++ (linepath(pathfinish p:real^N,pathfinish p))` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_RID THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ASM_SIMP_TAC[HOMOTOPIC_PATHS_LINV; PATHSTART_JOIN; PATHSTART_REVERSEPATH; + HOMOTOPIC_PATHS_REFL]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN + ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + PATH_IMAGE_REVERSEPATH; PATH_REVERSEPATH]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `linepath(pathstart p:real^N,pathstart p) ++ q` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN + REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH]; + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN + REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_LINEPATH; + PATHFINISH_REVERSEPATH] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_LID THEN ASM_REWRITE_TAC[]]);; + +let HOMOTOPIC_LOOPS_ADD_SYM = prove + (`!p q:real^1->real^N. + path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p /\ + path q /\ path_image q SUBSET s /\ pathfinish q = pathstart q /\ + pathstart q = pathstart p + ==> homotopic_loops s (p ++ q) (q ++ p)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + SUBGOAL_THEN `lift(&1 / &2) IN interval[vec 0,vec 1]` ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + EXISTS_TAC `shiftpath (lift(&1 / &2)) (p ++ q:real^1->real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_LOOPS_SHIFTPATH_SELF; + MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ] THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + UNION_SUBSET; IN_INTERVAL_1; DROP_VEC; LIFT_DROP; + PATH_SHIFTPATH; PATH_IMAGE_SHIFTPATH; CLOSED_SHIFTPATH] THEN + SIMP_TAC[shiftpath; joinpaths; LIFT_DROP; DROP_ADD; DROP_SUB; DROP_VEC; + REAL_ARITH `&0 <= t ==> (a + t <= a <=> t = &0)`; + REAL_ARITH `t <= &1 ==> &1 / &2 + t - &1 <= &1 / &2`; + REAL_ARITH `&1 / &2 + t <= &1 <=> t <= &1 / &2`] THEN + X_GEN_TAC `t:real^1` THEN STRIP_TAC THEN + ASM_CASES_TAC `drop t <= &1 / &2` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM; LIFT_DROP] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_RID] THENL + [REWRITE_TAC[GSYM LIFT_CMUL; VECTOR_MUL_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_MESON_TAC[LIFT_NUM; pathstart; pathfinish]; + ALL_TAC]; + ALL_TAC] THEN + AP_TERM_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_ADD; DROP_VEC; DROP_CMUL; + LIFT_DROP] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Simply connected sets defined as "all loops are homotopic (as loops)". *) +(* ------------------------------------------------------------------------- *) + +let simply_connected = new_definition + `simply_connected(s:real^N->bool) <=> + !p q. path p /\ pathfinish p = pathstart p /\ path_image p SUBSET s /\ + path q /\ pathfinish q = pathstart q /\ path_image q SUBSET s + ==> homotopic_loops s p q`;; + +let SIMPLY_CONNECTED_EMPTY = prove + (`simply_connected {}`, + REWRITE_TAC[simply_connected; SUBSET_EMPTY] THEN + MESON_TAC[PATH_IMAGE_NONEMPTY]);; + +let SIMPLY_CONNECTED_IMP_PATH_CONNECTED = prove + (`!s:real^N->bool. simply_connected s ==> path_connected s`, + REWRITE_TAC[simply_connected; PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH; + PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + ASM SET_TAC[]);; + +let SIMPLY_CONNECTED_IMP_CONNECTED = prove + (`!s:real^N->bool. simply_connected s ==> connected s`, + SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; + PATH_CONNECTED_IMP_CONNECTED]);; + +let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY = prove + (`!s:real^N->bool. + simply_connected s <=> + !p a. path p /\ path_image p SUBSET s /\ + pathfinish p = pathstart p /\ a IN s + ==> homotopic_loops s p (linepath(a,a))`, + GEN_TAC THEN REWRITE_TAC[simply_connected] THEN EQ_TAC THEN DISCH_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]; + MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `q:real^1->real^N`] THEN + STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `linepath(pathstart p:real^N,pathstart p)` THEN + CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMOTOPIC_LOOPS_SYM]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);; + +let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME = prove + (`!s:real^N->bool. + simply_connected s <=> + path_connected s /\ + !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p + ==> ?a. a IN s /\ homotopic_loops s p (linepath(a,a))`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN + MESON_TAC[SUBSET; PATHSTART_IN_PATH_IMAGE]; + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN + MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN + STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `linepath(b:real^N,b)` THEN + ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN + ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]]);; + +let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL = prove + (`!s:real^N->bool. + simply_connected s <=> + s = {} \/ + ?a. a IN s /\ + !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p + ==> homotopic_loops s p (linepath(a,a))`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN + EQ_TAC THENL + [STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:real^1->real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN + STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `linepath(b:real^N,b)` THEN + ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN + ASM_MESON_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT]; + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN + MAP_EVERY X_GEN_TAC [`b:real^N`; `c:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `linepath(a:real^N,a)` THEN + GEN_REWRITE_TAC RAND_CONV [HOMOTOPIC_LOOPS_SYM] THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL; + PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM SET_TAC[]]);; + +let SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH = prove + (`!s:real^N->bool. + simply_connected s <=> + path_connected s /\ + !p. path p /\ path_image p SUBSET s /\ pathfinish p = pathstart p + ==> homotopic_paths s p (linepath(pathstart p,pathstart p))`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_PATHS_NULL THEN + EXISTS_TAC `pathstart p :real^N` THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + REWRITE_RULE[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN + MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `a:real^N`] THEN + STRIP_TAC THEN MATCH_MP_TAC HOMOTOPIC_LOOPS_TRANS THEN + EXISTS_TAC `linepath(pathstart p:real^N,pathfinish p)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS THEN + ASM_SIMP_TAC[PATHFINISH_LINEPATH]; + ASM_REWRITE_TAC[HOMOTOPIC_POINTS_EQ_PATH_COMPONENT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]]);; + +let SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS = prove + (`!s:real^N->bool. + simply_connected s <=> + path_connected s /\ + !p q. path p /\ path_image p SUBSET s /\ + path q /\ path_image q SUBSET s /\ + pathstart q = pathstart p /\ pathfinish q = pathfinish p + ==> homotopic_paths s p q`, + REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `p:real^1->real^N` THENL + [X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p ++ reversepath q :real^1->real^N`) THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_REVERSEPATH; PATH_REVERSEPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH; + PATH_IMAGE_JOIN; UNION_SUBSET; PATH_IMAGE_REVERSEPATH] THEN + DISCH_TAC THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `p ++ linepath(pathfinish p,pathfinish p):real^1->real^N` THEN + GEN_REWRITE_TAC LAND_CONV [HOMOTOPIC_PATHS_SYM] THEN + ASM_SIMP_TAC[HOMOTOPIC_PATHS_RID] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `p ++ (reversepath q ++ q):real^1->real^N` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL; PATHSTART_LINEPATH] THEN + ASM_MESON_TAC[HOMOTOPIC_PATHS_LINV; HOMOTOPIC_PATHS_SYM]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `(p ++ reversepath q) ++ q:real^1->real^N` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_ASSOC THEN + ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH] THEN + ASM_REWRITE_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH]; + ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `linepath(pathstart q,pathstart q) ++ q:real^1->real^N` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ASM_SIMP_TAC[HOMOTOPIC_PATHS_RINV; HOMOTOPIC_PATHS_REFL] THEN + ASM_REWRITE_TAC[PATHFINISH_JOIN; PATHFINISH_REVERSEPATH]; + ASM_MESON_TAC[HOMOTOPIC_PATHS_LID]]; + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH; PATH_LINEPATH] THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]);; + +let SIMPLY_CONNECTED_RETRACTION_GEN = prove + (`!s:real^M->bool t:real^N->bool h k. + h continuous_on s /\ IMAGE h s = t /\ + k continuous_on t /\ IMAGE k t SUBSET s /\ + (!y. y IN t ==> h(k y) = y) /\ + simply_connected s + ==> simply_connected t`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[simply_connected; path; path_image; homotopic_loops] THEN + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ a' /\ b' /\ c' <=> a /\ c /\ b /\ a' /\ c' /\ b'`] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + HOMOTOPICALLY_TRIVIAL_RETRACTION_GEN) THEN + MAP_EVERY EXISTS_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN + ASM_SIMP_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN + REWRITE_TAC[pathfinish; pathstart] THEN MESON_TAC[ENDS_IN_UNIT_INTERVAL]);; + +let HOMEOMORPHIC_SIMPLY_CONNECTED = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ simply_connected s + ==> simply_connected t`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] SIMPLY_CONNECTED_RETRACTION_GEN)) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[homeomorphism; SUBSET_REFL]);; + +let HOMEOMORPHIC_SIMPLY_CONNECTED_EQ = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t + ==> (simply_connected s <=> simply_connected t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_SIMPLY_CONNECTED) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + ASM_REWRITE_TAC[]);; + +let SIMPLY_CONNECTED_TRANSLATION = prove + (`!a:real^N s. simply_connected (IMAGE (\x. a + x) s) <=> simply_connected s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);; + +add_translation_invariants [SIMPLY_CONNECTED_TRANSLATION];; + +let SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (simply_connected (IMAGE f s) <=> simply_connected s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_SIMPLY_CONNECTED_EQ THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; + HOMEOMORPHIC_REFL]);; + +add_linear_invariants [SIMPLY_CONNECTED_INJECTIVE_LINEAR_IMAGE];; + +let SIMPLY_CONNECTED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + simply_connected s /\ simply_connected t + ==> simply_connected(s PCROSS t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN + REWRITE_TAC[path; path_image; pathstart; pathfinish; FORALL_PASTECART] THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC + [`p:real^1->real^(M,N)finite_sum`; `a:real^M`; `b:real^N`] THEN + REWRITE_TAC[PASTECART_IN_PCROSS; FORALL_IN_IMAGE; SUBSET] THEN STRIP_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`fstcart o (p:real^1->real^(M,N)finite_sum)`; `a:real^M`]) + (MP_TAC o SPECL [`sndcart o (p:real^1->real^(M,N)finite_sum)`; + `b:real^N`])) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; LINEAR_FSTCART; LINEAR_SNDCART; + LINEAR_CONTINUOUS_ON; homotopic_loops; homotopic_with; + pathfinish; pathstart; IMAGE_o; o_THM] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN + ASM_MESON_TAC[SNDCART_PASTECART]; + DISCH_THEN(X_CHOOSE_THEN + `k:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC)] THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[PCROSS; IN_ELIM_THM]) THEN + ASM_MESON_TAC[FSTCART_PASTECART]; + DISCH_THEN(X_CHOOSE_THEN + `h:real^(1,1)finite_sum->real^M` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC + `(\z. pastecart (h z) (k z)) + :real^(1,1)finite_sum->real^(M,N)finite_sum` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_PASTECART; ETA_AX] THEN + REWRITE_TAC[LINEPATH_REFL; PASTECART_FST_SND] THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS]);; + +let SIMPLY_CONNECTED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + simply_connected(s PCROSS t) <=> + s = {} \/ t = {} \/ simply_connected s /\ simply_connected t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; SIMPLY_CONNECTED_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[SIMPLY_CONNECTED_PCROSS] THEN REPEAT STRIP_TAC THENL + [REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN + MAP_EVERY X_GEN_TAC [`p:real^1->real^M`; `a:real^M`] THEN + REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET; + FORALL_IN_IMAGE] THEN + STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN + DISCH_THEN(MP_TAC o SPECL + [`(\t. pastecart (p t) (b)):real^1->real^(M,N)finite_sum`; + `pastecart (a:real^M) (b:real^N)`]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN + ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET; + FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ; + CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`(\t. pastecart (p t) b):real^1->real^(M,N)finite_sum`; + `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`; + `fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`; `s:real^M->bool`] + HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + SIMP_TAC[o_DEF; LINEPATH_REFL; FSTCART_PASTECART; ETA_AX; + SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]; + REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY] THEN + MAP_EVERY X_GEN_TAC [`p:real^1->real^N`; `b:real^N`] THEN + REWRITE_TAC[path; path_image; pathstart; pathfinish; SUBSET; + FORALL_IN_IMAGE] THEN + STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ANY]) THEN + DISCH_THEN(MP_TAC o SPECL + [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`; + `pastecart (a:real^M) (b:real^N)`]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN + ASM_SIMP_TAC[path; path_image; pathstart; pathfinish; SUBSET; + FORALL_IN_IMAGE; PASTECART_IN_PCROSS; PASTECART_INJ; + CONTINUOUS_ON_PASTECART; ETA_AX; CONTINUOUS_ON_CONST] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`(\t. pastecart a (p t)):real^1->real^(M,N)finite_sum`; + `linepath (pastecart (a:real^M) (b:real^N),pastecart a b)`; + `sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`; `t:real^N->bool`] + HOMOTOPIC_LOOPS_CONTINUOUS_IMAGE) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + SIMP_TAC[o_DEF; LINEPATH_REFL; SNDCART_PASTECART; ETA_AX; + SUBSET; FORALL_IN_PCROSS; FORALL_IN_IMAGE]]);; + +(* ------------------------------------------------------------------------- *) +(* A mapping out of a sphere is nullhomotopic iff it extends to the ball. *) +(* This even works out in the degenerate cases when the radius is <= 0, and *) +(* we also don't need to explicitly assume continuity since it's already *) +(* implicit in both sides of the equivalence. *) +(* ------------------------------------------------------------------------- *) + +let NULLHOMOTOPIC_FROM_SPHERE_EXTENSION = prove + (`!f:real^M->real^N s a r. + (?c. homotopic_with (\x. T) (sphere(a,r),s) f (\x. c)) <=> + (?g. g continuous_on cball(a,r) /\ IMAGE g (cball(a,r)) SUBSET s /\ + !x. x IN sphere(a,r) ==> g x = f x)`, + let lemma = prove + (`!f:real^M->real^N g a r. + (!e. &0 < e + ==> ?d. &0 < d /\ + !x. ~(x = a) /\ norm(x - a) < d ==> norm(g x - f a) < e) /\ + g continuous_on (cball(a,r) DELETE a) /\ + (!x. x IN cball(a,r) /\ ~(x = a) ==> f x = g x) + ==> f continuous_on cball(a,r)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_CBALL; dist] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^M = a` THENL + [ASM_REWRITE_TAC[continuous_within; IN_CBALL; dist] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^M` THEN ASM_CASES_TAC `y:real^M = a` THEN + ASM_MESON_TAC[VECTOR_SUB_REFL; NORM_0]; + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN + EXISTS_TAC `g:real^M->real^N` THEN EXISTS_TAC `norm(x - a:real^M)` THEN + ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ; IN_CBALL; dist] THEN + CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_CBALL; dist]); + UNDISCH_TAC + `(g:real^M->real^N) continuous_on (cball(a,r) DELETE a)` THEN + REWRITE_TAC[continuous_on; continuous_within] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[IN_DELETE; IN_CBALL; dist] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (norm(x - a:real^M))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; NORM_POS_LT; VECTOR_SUB_EQ]] THEN + ASM_MESON_TAC[NORM_SUB; NORM_ARITH + `norm(y - x:real^N) < norm(x - a) ==> ~(y = a)`]]) in + REWRITE_TAC[sphere; ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `r < &0 \/ r = &0 \/ &0 < r`) + THENL + [ASM_SIMP_TAC[NORM_ARITH `r < &0 ==> ~(norm x = r)`] THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM CBALL_EQ_EMPTY]) THEN + ASM_SIMP_TAC[HOMOTOPIC_WITH; IMAGE_CLAUSES; EMPTY_GSPEC; NOT_IN_EMPTY; + PCROSS; SET_RULE `{f t x |x,t| F} = {}`; EMPTY_SUBSET] THEN + REWRITE_TAC[CONTINUOUS_ON_EMPTY]; + ASM_SIMP_TAC[NORM_EQ_0; VECTOR_SUB_EQ; CBALL_SING] THEN + SIMP_TAC[HOMOTOPIC_WITH; PCROSS; FORALL_IN_GSPEC; FORALL_UNWIND_THM2] THEN + ASM_CASES_TAC `(f:real^M->real^N) a IN s` THENL + [MATCH_MP_TAC(TAUT `p /\ q ==> (p <=> q)`) THEN CONJ_TAC THENL + [EXISTS_TAC `(f:real^M->real^N) a` THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. (f:real^M->real^N) a` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE]; + EXISTS_TAC `f:real^M->real^N` THEN REWRITE_TAC[CONTINUOUS_ON_SING] THEN + ASM SET_TAC[]]; + MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN CONJ_TAC THENL + [ASM SET_TAC[]; STRIP_TAC] THEN + UNDISCH_TAC `~((f:real^M->real^N) a IN s)` THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE h t SUBSET s ==> (?y. y IN t /\ z = h y) ==> z IN s`)) THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN + EXISTS_TAC `vec 0:real^1` THEN ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL] THEN + ASM_REWRITE_TAC[EXISTS_IN_GSPEC; UNWIND_THM2]]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT + `!p. (q ==> p) /\ (r ==> p) /\ (p ==> (q <=> r)) ==> (q <=> r)`) THEN + EXISTS_TAC + `(f:real^M->real^N) continuous_on {x | norm(x - a) = r} /\ + IMAGE f {x | norm(x - a) = r} SUBSET s` THEN + REPEAT CONJ_TAC THENL + [STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_CONTINUOUS) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN EXISTS_TAC `g:real^M->real^N` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `cball(a:real^M,r)`; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE g t SUBSET s + ==> u SUBSET t /\ (!x. x IN u ==> f x = g x) + ==> IMAGE f u SUBSET s`)) THEN + ASM_SIMP_TAC[]] THEN + ASM_SIMP_TAC[SUBSET; IN_CBALL; dist; IN_ELIM_THM] THEN + MESON_TAC[REAL_LE_REFL; NORM_SUB]; + STRIP_TAC] THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN EQ_TAC THENL + [REWRITE_TAC[homotopic_with; PCROSS; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`c:real^N`; `h:real^(1,M)finite_sum->real^N`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N) + (pastecart (lift(inv(r) * norm(x - a))) + (a + (if x = a then r % basis 1 + else r / norm(x - a) % (x - a))))` THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_MUL_LINV; REAL_DIV_REFL; REAL_LT_IMP_NZ; + LIFT_NUM; VECTOR_ARITH `a + &1 % (x - a):real^N = x`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC lemma THEN + EXISTS_TAC `\x. (h:real^(1,M)finite_sum->real^N) + (pastecart (lift(inv(r) * norm(x - a))) + (a + r / norm(x - a) % (x - a)))` THEN + SIMP_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0; REAL_MUL_RZERO; LIFT_NUM] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + COMPACT_UNIFORMLY_CONTINUOUS)) THEN + SIMP_TAC[REWRITE_RULE[PCROSS] COMPACT_PCROSS; + REWRITE_RULE[REWRITE_RULE[ONCE_REWRITE_RULE[DIST_SYM] dist] sphere] + COMPACT_SPHERE; COMPACT_INTERVAL] THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min r (d * r):real` THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_MIN] THEN + X_GEN_TAC `x:real^M` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `vec 0:real^1`) THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; RIGHT_IMP_FORALL_THM] THEN + ASM_REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `(!x t y. P x t y) ==> (!t x. P x t x)`)) THEN + REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; CONJ_ASSOC] THEN + REWRITE_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < r ==> abs r = r`] THEN + REWRITE_TAC[PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART] THEN + REWRITE_TAC[NORM_0; VECTOR_SUB_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN + REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM; NORM_LIFT] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LT_LDIV_EQ; REAL_ABS_NORM; + REAL_ARITH `&0 < r ==> abs r = r`]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; LIFT_CMUL; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_LIFT_NORM_COMPOSE] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST; + o_DEF; real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + GEN_TAC THEN REWRITE_TAC[IN_DELETE] THEN DISCH_TAC THEN + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_INV) THEN + ASM_SIMP_TAC[NETLIMIT_AT; NORM_EQ_0; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN + SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DELETE; IN_ELIM_THM] THEN + SIMP_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_SIMP_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE] THEN + SIMP_TAC[VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; + REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]]; + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_CBALL; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist] THEN REPEAT STRIP_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] (GSYM real_div)] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; NORM_POS_LE]; + REWRITE_TAC[VECTOR_ADD_SUB] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL; + REAL_ABS_DIV; REAL_ABS_NORM; + REAL_MUL_RID; REAL_ARITH `&0 < r ==> abs r = r`] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ]]; + GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `a + &1 % (x - a):real^N = x`]]; + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:real^M->real^N) a` THEN + ASM_SIMP_TAC[HOMOTOPIC_WITH; PCROSS] THEN + EXISTS_TAC `\y:real^(1,M)finite_sum. + (g:real^M->real^N) + (a + drop(fstcart y) % (sndcart y - a))` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_RID; VECTOR_MUL_LID] THEN + ASM_SIMP_TAC[VECTOR_SUB_ADD2] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN SIMP_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; + LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; LINEAR_FSTCART; ETA_AX]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))]; + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE g s SUBSET u ==> t SUBSET s ==> IMAGE g t SUBSET u`))] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; IN_ELIM_THM] THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^M,a + x) = norm x`] THEN + ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_LE_RMUL_EQ; + REAL_ARITH `x * r <= r <=> x * r <= &1 * r`] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy equivalence. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("homotopy_equivalent",(12,"right"));; + +let homotopy_equivalent = new_definition + `(s:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> + ?f g. f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + homotopic_with (\x. T) (s,s) (g o f) I /\ + homotopic_with (\x. T) (t,t) (f o g) I`;; + +let HOMOTOPY_EQUIVALENT = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t <=> + ?f g h. f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + h continuous_on t /\ IMAGE h t SUBSET s /\ + homotopic_with (\x. T) (s,s) (g o f) I /\ + homotopic_with (\x. T) (t,t) (f o h) I`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN + MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((?x. P x) <=> (?x. Q x))`) THEN + X_GEN_TAC `f:real^M->real^N` THEN + EQ_TAC THENL [MESON_TAC[]; STRIP_TAC] THEN + EXISTS_TAC `(g:real^N->real^M) o f o (h:real^N->real^M)` THEN + ASM_REWRITE_TAC[IMAGE_o] THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC) THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + ASM SET_TAC[]; + TRANS_TAC HOMOTOPIC_WITH_TRANS + `((g:real^N->real^M) o I) o (f:real^M->real^N)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; + TRANS_TAC HOMOTOPIC_WITH_TRANS + `(f:real^M->real^N) o I o (h:real^N->real^M)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> s homotopy_equivalent t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[homeomorphic; homotopy_equivalent; homeomorphism] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_EQUAL THEN + ASM_SIMP_TAC[CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM; I_THM; SUBSET_REFL]);; + +let HOMOTOPY_EQUIVALENT_REFL = prove + (`!s:real^N->bool. s homotopy_equivalent s`, + SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_REFL]);; + +let HOMOTOPY_EQUIVALENT_SYM = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t <=> t homotopy_equivalent s`, + REPEAT GEN_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);; + +let HOMOTOPY_EQUIVALENT_TRANS = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t /\ t homotopy_equivalent u + ==> s homotopy_equivalent u`, + REPEAT GEN_TAC THEN + SIMP_TAC[homotopy_equivalent; LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`f1:real^M->real^N`; `g1:real^N->real^M`; + `f2:real^N->real^P`; `g2:real^P->real^N`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(f2:real^N->real^P) o (f1:real^M->real^N)`; + `(g1:real^N->real^M) o (g2:real^P->real^N)`] THEN + REWRITE_TAC[IMAGE_o] THEN + REPLICATE_TAC 2 + (CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_COMPOSE; CONTINUOUS_ON_SUBSET];ALL_TAC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THENL + [EXISTS_TAC `(g1:real^N->real^M) o I o (f1:real^M->real^N)`; + EXISTS_TAC `(f2:real^N->real^P) o I o (g2:real^P->real^N)`] THEN + (CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[I_O_ID]]) THEN + REWRITE_TAC[GSYM o_ASSOC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]);; + +let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s) homotopy_equivalent s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN + MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF THEN + ASM_REWRITE_TAC[]);; + +let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((IMAGE f s) homotopy_equivalent t <=> s homotopy_equivalent t)`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o + MATCH_MP HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_SELF) THEN + EQ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMOTOPY_EQUIVALENT_SYM]); + POP_ASSUM MP_TAC] THEN + REWRITE_TAC[IMP_IMP; HOMOTOPY_EQUIVALENT_TRANS]);; + +let HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s homotopy_equivalent (IMAGE f t) <=> s homotopy_equivalent t)`, + ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN + REWRITE_TAC[HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);; + +add_linear_invariants + [HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; + HOMOTOPY_EQUIVALENT_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];; + +let HOMOTOPY_EQUIVALENT_TRANSLATION_SELF = prove + (`!a:real^N s. (IMAGE (\x. a + x) s) homotopy_equivalent s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_SELF]);; + +let HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ = prove + (`!a:real^N s t. + (IMAGE (\x. a + x) s) homotopy_equivalent t <=> s homotopy_equivalent t`, + MESON_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_SELF; + HOMOTOPY_EQUIVALENT_SYM; HOMOTOPY_EQUIVALENT_TRANS]);; + +let HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ = prove + (`!a:real^N s t. + s homotopy_equivalent (IMAGE (\x. a + x) t) <=> s homotopy_equivalent t`, + ONCE_REWRITE_TAC[HOMOTOPY_EQUIVALENT_SYM] THEN + REWRITE_TAC[HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ]);; + +add_translation_invariants + [HOMOTOPY_EQUIVALENT_TRANSLATION_LEFT_EQ; + HOMOTOPY_EQUIVALENT_TRANSLATION_RIGHT_EQ];; + +let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t + ==> ((!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ + g continuous_on u /\ IMAGE g u SUBSET s + ==> homotopic_with (\x. T) (u,s) f g) <=> + (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ + g continuous_on u /\ IMAGE g u SUBSET t + ==> homotopic_with (\x. T) (u,t) f g))`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t /\ + (!f g. f continuous_on u /\ IMAGE f u SUBSET s /\ + g continuous_on u /\ IMAGE g u SUBSET s + ==> homotopic_with (\x. T) (u,s) f g) + ==> (!f g. f continuous_on u /\ IMAGE f u SUBSET t /\ + g continuous_on u /\ IMAGE g u SUBSET t + ==> homotopic_with (\x. T) (u,t) f g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` + (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `homotopic_with (\x. T) (u,t) + ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N)) + (h o k o g)` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN + ASM_REWRITE_TAC[] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]; + MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM] + `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g' + ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN + CONJ_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN + REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN + ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; + +let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t + ==> ((!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ + g continuous_on s /\ IMAGE g s SUBSET u + ==> homotopic_with (\x. T) (s,u) f g) <=> + (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ + g continuous_on t /\ IMAGE g t SUBSET u + ==> homotopic_with (\x. T) (t,u) f g))`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t /\ + (!f g. f continuous_on s /\ IMAGE f s SUBSET u /\ + g continuous_on s /\ IMAGE g s SUBSET u + ==> homotopic_with (\x. T) (s,u) f g) + ==> (!f g. f continuous_on t /\ IMAGE f t SUBSET u /\ + g continuous_on t /\ IMAGE g t SUBSET u + ==> homotopic_with (\x. T) (t,u) f g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` + (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `homotopic_with (\x. T) (t,u) + (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((g o h) o k)` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IMAGE_o] THEN + REPEAT CONJ_TAC THEN TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE) THEN + ASM_REWRITE_TAC[] THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + ASM SET_TAC[]; + MATCH_MP_TAC(MESON[HOMOTOPIC_WITH_TRANS; HOMOTOPIC_WITH_SYM] + `homotopic_with P (u,t) f f' /\ homotopic_with P (u,t) g g' + ==> homotopic_with P (u,t) f g ==> homotopic_with P (u,t) f' g'`) THEN + CONJ_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN + REWRITE_TAC[GSYM o_ASSOC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN + ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; + +let HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY_NULL = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t + ==> ((!f. f continuous_on u /\ IMAGE f u SUBSET s + ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) <=> + (!f. f continuous_on u /\ IMAGE f u SUBSET t + ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c)))`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t /\ + (!f. f continuous_on u /\ IMAGE f u SUBSET s + ==> ?c. homotopic_with (\x. T) (u,s) f (\x. c)) + ==> (!f. f continuous_on u /\ IMAGE f u SUBSET t + ==> ?c. homotopic_with (\x. T) (u,t) f (\x. c))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` + (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(k:real^N->real^M) o (f:real^P->real^N)`) THEN + REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL + [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + DISCH_THEN(X_CHOOSE_TAC `c:real^M`) THEN + EXISTS_TAC `(h:real^M->real^N) c`] THEN + SUBGOAL_THEN + `homotopic_with (\x. T) (u,t) + ((h:real^M->real^N) o (k:real^N->real^M) o (f:real^P->real^N)) + (h o (\x. c))` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT1(SPEC_ALL I_O_ID))] THEN + REWRITE_TAC[o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[]]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN + ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; + +let HOMOTOPY_EQUIVALENT_COHOMOTOPIC_TRIVIALITY_NULL = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t + ==> ((!f. f continuous_on s /\ IMAGE f s SUBSET u + ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) <=> + (!f. f continuous_on t /\ IMAGE f t SUBSET u + ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c)))`, + let lemma = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homotopy_equivalent t /\ + (!f. f continuous_on s /\ IMAGE f s SUBSET u + ==> ?c. homotopic_with (\x. T) (s,u) f (\x. c)) + ==> (!f. f continuous_on t /\ IMAGE f t SUBSET u + ==> ?c. homotopic_with (\x. T) (t,u) f (\x. c))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopy_equivalent]) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^M->real^N` + (X_CHOOSE_THEN `k:real^N->real^M` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^N->real^P) o (h:real^M->real^N)`) THEN + REWRITE_TAC[IMAGE_o] THEN ANTS_TAC THENL + [CONJ_TAC THENL [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE; ASM SET_TAC[]] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^P` THEN DISCH_TAC] THEN + SUBGOAL_THEN + `homotopic_with (\x. T) (t,u) + (((f:real^N->real^P) o h) o (k:real^N->real^M)) ((\x. c) o k)` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [o_DEF] THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2(SPEC_ALL I_O_ID))] THEN + REWRITE_TAC[GSYM o_ASSOC] THEN ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[]]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] lemma) THEN + ASM_MESON_TAC[HOMOTOPY_EQUIVALENT_SYM]);; + +let HOMOTOPY_INVARIANT_CONNECTEDNESS = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + homotopic_with (\x. T) (t,t) (f o g) I /\ + connected s + ==> connected t`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + REWRITE_TAC[o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_PCROSS] THEN + ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_SYM] + `!a b. (connected_component t a a' /\ connected_component t b b') /\ + connected_component t a b + ==> connected_component t a' b'`) THEN + MAP_EVERY EXISTS_TAC + [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`; + `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[connected_component] THEN CONJ_TAC THENL + [EXISTS_TAC + `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1)) + (interval[vec 0,vec 1])`; + EXISTS_TAC + `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2)) + (interval[vec 0,vec 1])`] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + REWRITE_TAC[CONNECTED_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS]; + REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS]; + CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]); + ASM_REWRITE_TAC[connected_component] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN + REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);; + +let HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + homotopic_with (\x. T) (t,t) (f o g) I /\ + path_connected s + ==> path_connected t`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + REWRITE_TAC[o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `t = IMAGE (h:real^(1,N)finite_sum->real^N) (interval[vec 0,vec 1] PCROSS t)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_PCROSS] THEN + ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[PATH_CONNECTED_IFF_PATH_COMPONENT; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`t1:real^1`; `x1:real^N`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`t2:real^1`; `x2:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[PATH_COMPONENT_TRANS; PATH_COMPONENT_SYM] + `!a b. (path_component t a a' /\ path_component t b b') /\ + path_component t a b + ==> path_component t a' b'`) THEN + MAP_EVERY EXISTS_TAC + [`(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x1)`; + `(h:real^(1,N)finite_sum->real^N) (pastecart (vec 0) x2)`] THEN + CONJ_TAC THENL + [REWRITE_TAC[PATH_COMPONENT] THEN CONJ_TAC THENL + [EXISTS_TAC + `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x1)) + (interval[vec 0,vec 1])`; + EXISTS_TAC + `IMAGE ((h:real^(1,N)finite_sum->real^N) o (\s. pastecart s x2)) + (interval[vec 0,vec 1])`] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONNECTED_CONTINUOUS_IMAGE THEN + REWRITE_TAC[PATH_CONNECTED_INTERVAL] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS]; + REWRITE_TAC[IMAGE_o] THEN CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS]; + CONJ_TAC THEN MATCH_MP_TAC FUN_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE] THEN ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]]); + ASM_REWRITE_TAC[PATH_COMPONENT] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[PATH_CONNECTED_CONTINUOUS_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE] THEN + REWRITE_TAC[EXISTS_PASTECART; PASTECART_IN_PCROSS] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`vec 1:real^1`; `(f:real^M->real^N) y`] THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN ASM SET_TAC[]]);; + +let HOMOTOPY_EQUIVALENT_CONNECTEDNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t ==> (connected s <=> connected t)`, + REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN + EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_CONNECTEDNESS)) THEN + ASM_MESON_TAC[]);; + +let HOMOTOPY_EQUIVALENT_PATH_CONNECTEDNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t ==> (path_connected s <=> path_connected t)`, + REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN + EQ_TAC THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_INVARIANT_PATH_CONNECTEDNESS)) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Contractible sets. *) +(* ------------------------------------------------------------------------- *) + +let contractible = new_definition + `contractible s <=> ?a. homotopic_with (\x. T) (s,s) (\x. x) (\x. a)`;; + +let CONTRACTIBLE_IMP_SIMPLY_CONNECTED = prove + (`!s:real^N->bool. contractible s ==> simply_connected s`, + GEN_TAC THEN REWRITE_TAC[contractible] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SIMPLY_CONNECTED_EMPTY] THEN + ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_ALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[homotopic_loops; PCROSS] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; DISCH_TAC] THEN + X_GEN_TAC `p:real^1->real^N` THEN + REWRITE_TAC[path; path_image; pathfinish; pathstart] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + REWRITE_TAC[homotopic_with; SUBSET; FORALL_IN_IMAGE; PCROSS] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^(1,N)finite_sum->real^N` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(h o (\y. pastecart (fstcart y) (p(sndcart y):real^N))) + :real^(1,1)finite_sum->real^N` THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; linepath; o_THM] THEN + CONJ_TAC THENL [ALL_TAC; CONV_TAC VECTOR_ARITH] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE [IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[IN_ELIM_PASTECART_THM; FSTCART_PASTECART; SNDCART_PASTECART]);; + +let CONTRACTIBLE_IMP_CONNECTED = prove + (`!s:real^N->bool. contractible s ==> connected s`, + SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED; + SIMPLY_CONNECTED_IMP_CONNECTED]);; + +let CONTRACTIBLE_IMP_PATH_CONNECTED = prove + (`!s:real^N->bool. contractible s ==> path_connected s`, + SIMP_TAC[CONTRACTIBLE_IMP_SIMPLY_CONNECTED; + SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);; + +let NULLHOMOTOPIC_THROUGH_CONTRACTIBLE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + contractible t + ==> ?c. homotopic_with (\h. T) (s,u) (g o f) (\x. c)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [contractible]) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` MP_TAC) THEN + DISCH_THEN(MP_TAC o ISPECL [`g:real^N->real^P`; `u:real^P->bool`] o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_LEFT)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o ISPECL [`f:real^M->real^N`; `s:real^M->bool`] o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] HOMOTOPIC_COMPOSE_CONTINUOUS_RIGHT)) THEN + ASM_REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN + EXISTS_TAC `(g:real^N->real^P) b` THEN ASM_REWRITE_TAC[]);; + +let NULLHOMOTOPIC_INTO_CONTRACTIBLE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ contractible t + ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N) = (\x. x) o f` SUBST1_TAC THENL + [REWRITE_TAC[o_THM; FUN_EQ_THM]; + MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + SET_TAC[]]);; + +let NULLHOMOTOPIC_FROM_CONTRACTIBLE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ contractible s + ==> ?c. homotopic_with (\h. T) (s,t) f (\x. c)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N) = f o (\x. x)` SUBST1_TAC THENL + [REWRITE_TAC[o_THM; FUN_EQ_THM]; + MATCH_MP_TAC NULLHOMOTOPIC_THROUGH_CONTRACTIBLE THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + SET_TAC[]]);; + +let HOMOTOPIC_THROUGH_CONTRACTIBLE = prove + (`!f1:real^M->real^N g1:real^N->real^P f2 g2 s t u. + f1 continuous_on s /\ IMAGE f1 s SUBSET t /\ + g1 continuous_on t /\ IMAGE g1 t SUBSET u /\ + f2 continuous_on s /\ IMAGE f2 s SUBSET t /\ + g2 continuous_on t /\ IMAGE g2 t SUBSET u /\ + contractible t /\ path_connected u + ==> homotopic_with (\h. T) (s,u) (g1 o f1) (g2 o f2)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`f1:real^M->real^N`; `g1:real^N->real^P`; `s:real^M->bool`; + `t:real^N->bool`; `u:real^P->bool`] + NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c1:real^P` THEN + DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN + MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN MP_TAC(ISPECL + [`f2:real^M->real^N`; `g2:real^N->real^P`; `s:real^M->bool`; + `t:real^N->bool`; `u:real^P->bool`] + NULLHOMOTOPIC_THROUGH_CONTRACTIBLE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `c2:real^P` THEN + DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET th) THEN + MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_TRANS) THEN + REWRITE_TAC[HOMOTOPIC_CONSTANT_MAPS] THEN FIRST_X_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [PATH_CONNECTED_IFF_PATH_COMPONENT]) THEN + ASM SET_TAC[]);; + +let HOMOTOPIC_INTO_CONTRACTIBLE = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on s /\ IMAGE g s SUBSET t /\ + contractible t + ==> homotopic_with (\h. T) (s,t) f g`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `(f:real^M->real^N) = (\x. x) o f /\ (g:real^M->real^N) = (\x. x) o g` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + ASM_SIMP_TAC[IMAGE_ID; SUBSET_REFL; CONTRACTIBLE_IMP_PATH_CONNECTED]);; + +let HOMOTOPIC_FROM_CONTRACTIBLE = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on s /\ IMAGE g s SUBSET t /\ + contractible s /\ path_connected t + ==> homotopic_with (\h. T) (s,t) f g`, + REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `(f:real^M->real^N) = f o (\x. x) /\ (g:real^M->real^N) = g o (\x. x)` + (CONJUNCTS_THEN SUBST1_TAC) + THENL [REWRITE_TAC[o_THM; FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_THROUGH_CONTRACTIBLE THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[CONTINUOUS_ON_ID] THEN + ASM_REWRITE_TAC[IMAGE_ID; SUBSET_REFL]);; + +let HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS = prove + (`!s:real^M->bool t:real^N->bool. + contractible s /\ contractible t /\ (s = {} <=> t = {}) + ==> s homotopy_equivalent t`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT; HOMEOMORPHIC_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `b:real^N` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + STRIP_TAC THEN REWRITE_TAC[homotopy_equivalent] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^M` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `(\x. b):real^M->real^N` THEN + EXISTS_TAC `(\y. a):real^N->real^M` THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + CONJ_TAC THEN MATCH_MP_TAC HOMOTOPIC_INTO_CONTRACTIBLE THEN + ASM_REWRITE_TAC[o_DEF; IMAGE_ID; I_DEF; SUBSET_REFL; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + ASM SET_TAC[]);; + +let STARLIKE_IMP_CONTRACTIBLE_GEN = prove + (`!P s. + (!a t. a IN s /\ &0 <= t /\ t <= &1 ==> P(\x. (&1 - t) % x + t % a)) /\ + starlike s + ==> ?a:real^N. homotopic_with P (s,s) (\x. x) (\x. a)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[starlike] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + REWRITE_TAC[segment; SUBSET; FORALL_IN_GSPEC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + REWRITE_TAC[homotopic_with; PCROSS] THEN + EXISTS_TAC `\y:real^(1,N)finite_sum. + (&1 - drop(fstcart y)) % sndcart y + + drop(fstcart y) % a` THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; DROP_VEC; IN_INTERVAL_1; + SUBSET; FORALL_IN_IMAGE; REAL_SUB_RZERO; REAL_SUB_REFL; FORALL_IN_GSPEC; + VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID; VECTOR_ADD_RID] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[o_DEF; LIFT_DROP; ETA_AX; LIFT_SUB; CONTINUOUS_ON_SUB; + CONTINUOUS_ON_CONST; LINEAR_CONTINUOUS_ON; ETA_AX; + LINEAR_FSTCART; LINEAR_SNDCART]);; + +let STARLIKE_IMP_CONTRACTIBLE = prove + (`!s:real^N->bool. starlike s ==> contractible s`, + SIMP_TAC[contractible; STARLIKE_IMP_CONTRACTIBLE_GEN]);; + +let CONTRACTIBLE_UNIV = prove + (`contractible(:real^N)`, + SIMP_TAC[STARLIKE_IMP_CONTRACTIBLE; STARLIKE_UNIV]);; + +let STARLIKE_IMP_SIMPLY_CONNECTED = prove + (`!s:real^N->bool. starlike s ==> simply_connected s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTRACTIBLE_IMP_SIMPLY_CONNECTED THEN + MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN ASM_REWRITE_TAC[]);; + +let CONVEX_IMP_SIMPLY_CONNECTED = prove + (`!s:real^N->bool. convex s ==> simply_connected s`, + MESON_TAC[CONVEX_IMP_STARLIKE; STARLIKE_IMP_SIMPLY_CONNECTED; + SIMPLY_CONNECTED_EMPTY]);; + +let STARLIKE_IMP_PATH_CONNECTED = prove + (`!s:real^N->bool. starlike s ==> path_connected s`, + MESON_TAC[STARLIKE_IMP_SIMPLY_CONNECTED; + SIMPLY_CONNECTED_IMP_PATH_CONNECTED]);; + +let STARLIKE_IMP_CONNECTED = prove + (`!s:real^N->bool. starlike s ==> connected s`, + MESON_TAC[STARLIKE_IMP_PATH_CONNECTED; PATH_CONNECTED_IMP_CONNECTED]);; + +let IS_INTERVAL_SIMPLY_CONNECTED_1 = prove + (`!s:real^1->bool. is_interval s <=> simply_connected s`, + MESON_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1; + CONVEX_IMP_SIMPLY_CONNECTED; IS_INTERVAL_CONVEX_1]);; + +let CONTRACTIBLE_EMPTY = prove + (`contractible {}`, + SIMP_TAC[contractible; HOMOTOPIC_WITH; PCROSS_EMPTY; NOT_IN_EMPTY] THEN + REWRITE_TAC[CONTINUOUS_ON_EMPTY] THEN SET_TAC[]);; + +let CONTRACTIBLE_CONVEX_TWEAK_BOUNDARY_POINTS = prove + (`!s t:real^N->bool. + convex s /\ relative_interior s SUBSET t /\ t SUBSET closure s + ==> contractible t`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[SUBSET_EMPTY; CLOSURE_EMPTY; CONTRACTIBLE_EMPTY] THEN + STRIP_TAC THEN MATCH_MP_TAC STARLIKE_IMP_CONTRACTIBLE THEN + MATCH_MP_TAC STARLIKE_CONVEX_TWEAK_BOUNDARY_POINTS THEN ASM_MESON_TAC[]);; + +let CONVEX_IMP_CONTRACTIBLE = prove + (`!s:real^N->bool. convex s ==> contractible s`, + MESON_TAC[CONVEX_IMP_STARLIKE; CONTRACTIBLE_EMPTY; + STARLIKE_IMP_CONTRACTIBLE]);; + +let CONTRACTIBLE_SING = prove + (`!a:real^N. contractible {a}`, + SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_SING]);; + +let IS_INTERVAL_CONTRACTIBLE_1 = prove + (`!s:real^1->bool. is_interval s <=> contractible s`, + MESON_TAC[CONTRACTIBLE_IMP_PATH_CONNECTED; IS_INTERVAL_PATH_CONNECTED_1; + CONVEX_IMP_CONTRACTIBLE; IS_INTERVAL_CONVEX_1]);; + +let CONTRACTIBLE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + contractible s /\ contractible t ==> contractible(s PCROSS t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[contractible; homotopic_with] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `h:real^(1,M)finite_sum->real^M`] THEN + REPEAT DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`b:real^N`; `k:real^(1,N)finite_sum->real^N`] THEN + REPEAT DISCH_TAC THEN + EXISTS_TAC `pastecart (a:real^M) (b:real^N)` THEN + EXISTS_TAC `\z. pastecart + ((h:real^(1,M)finite_sum->real^M) + (pastecart (fstcart z) (fstcart(sndcart z)))) + ((k:real^(1,N)finite_sum->real^N) + (pastecart (fstcart z) (sndcart(sndcart z))))` THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART; CONTINUOUS_ON_ID; + GSYM o_DEF; CONTINUOUS_ON_COMPOSE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART] THEN + SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);; + +let CONTRACTIBLE_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + contractible(s PCROSS t) <=> + s = {} \/ t = {} \/ contractible s /\ contractible t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CONTRACTIBLE_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[CONTRACTIBLE_PCROSS] THEN + REWRITE_TAC[contractible; homotopic_with; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC + [`a:real^M`; `b:real^N`; + `h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(a:real^M) IN s /\ (b:real^N) IN t` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM PASTECART_IN_PCROSS] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[ENDS_IN_UNIT_INTERVAL]; + ALL_TAC] THEN + CONJ_TAC THENL + [EXISTS_TAC `a:real^M` THEN + EXISTS_TAC + `fstcart o + (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o + (\z. pastecart (fstcart z) (pastecart (sndcart z) b))`; + EXISTS_TAC `b:real^N` THEN + EXISTS_TAC + `sndcart o + (h:real^(1,(M,N)finite_sum)finite_sum->real^(M,N)finite_sum) o + (\z. pastecart (fstcart z) (pastecart a (sndcart z)))`] THEN + ASM_REWRITE_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; + SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; o_THM] THEN + (CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[PASTECART_FST_SND; PASTECART_IN_PCROSS]]) THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; + LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + ASM_SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS]);; + +let HOMOTOPY_EQUIVALENT_EMPTY = prove + (`(!s. (s:real^M->bool) homotopy_equivalent ({}:real^N->bool) <=> s = {}) /\ + (!t. ({}:real^M->bool) homotopy_equivalent (t:real^N->bool) <=> t = {})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + SIMP_TAC[HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS; CONTRACTIBLE_EMPTY] THEN + REWRITE_TAC[homotopy_equivalent] THEN SET_TAC[]);; + +let HOMOTOPY_DOMINATED_CONTRACTIBILITY = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ + IMAGE f s SUBSET t /\ + g continuous_on t /\ + IMAGE g t SUBSET s /\ + homotopic_with (\x. T) (t,t) (f o g) I /\ + contractible s + ==> contractible t`, + REPEAT GEN_TAC THEN SIMP_TAC[contractible; I_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`; `t:real^N->bool`] + NULLHOMOTOPIC_FROM_CONTRACTIBLE) THEN + ASM_REWRITE_TAC[contractible; I_DEF] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN DISCH_TAC THEN + MATCH_MP_TAC HOMOTOPIC_WITH_TRANS THEN + EXISTS_TAC `(f:real^M->real^N) o (g:real^N->real^M)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\x. (b:real^N)) = (\x. b) o (g:real^N->real^M)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `s:real^M->bool` THEN ASM_REWRITE_TAC[]);; + +let HOMOTOPY_EQUIVALENT_CONTRACTIBILITY = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t ==> (contractible s <=> contractible t)`, + REWRITE_TAC[homotopy_equivalent] THEN REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] HOMOTOPY_DOMINATED_CONTRACTIBILITY)) THEN + ASM_MESON_TAC[]);; + +let HOMOTOPY_EQUIVALENT_SING = prove + (`!s:real^M->bool a:real^N. + s homotopy_equivalent {a} <=> ~(s = {}) /\ contractible s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[HOMOTOPY_EQUIVALENT_EMPTY; NOT_INSERT_EMPTY] THEN + EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPY_EQUIVALENT_CONTRACTIBILITY) THEN + REWRITE_TAC[CONTRACTIBLE_SING]; + DISCH_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBLE_SETS THEN + ASM_REWRITE_TAC[CONTRACTIBLE_SING; NOT_INSERT_EMPTY]]);; + +let HOMEOMORPHIC_CONTRACTIBLE_EQ = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t ==> (contractible s <=> contractible t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMOTOPY_EQUIVALENT_CONTRACTIBILITY THEN + ASM_SIMP_TAC[HOMEOMORPHIC_IMP_HOMOTOPY_EQUIVALENT]);; + +let HOMEOMORPHIC_CONTRACTIBLE = prove + (`!s:real^M->bool t:real^N->bool. + s homeomorphic t /\ contractible s ==> contractible t`, + MESON_TAC[HOMEOMORPHIC_CONTRACTIBLE_EQ]);; + +let CONTRACTIBLE_TRANSLATION = prove + (`!a:real^N s. contractible (IMAGE (\x. a + x) s) <=> contractible s`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION]);; + +add_translation_invariants [CONTRACTIBLE_TRANSLATION];; + +let CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (contractible (IMAGE f s) <=> contractible s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_CONTRACTIBLE_EQ THEN + ASM_MESON_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; + HOMEOMORPHIC_REFL]);; + +add_linear_invariants [CONTRACTIBLE_INJECTIVE_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphisms between punctured spheres and affine sets. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE = prove + (`!a r b t:real^N->bool p:real^M->bool. + &0 < r /\ b IN sphere(a,r) /\ affine t /\ a IN t /\ b IN t /\ + affine p /\ aff_dim t = aff_dim p + &1 + ==> ((sphere(a:real^N,r) INTER t) DELETE b) homeomorphic p`, + GEOM_ORIGIN_TAC `a:real^N` THEN REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REWRITE_TAC[sphere; DIST_0; IN_ELIM_THM] THEN + SIMP_TAC[CONJ_ASSOC; NORM_ARITH + `&0 < r /\ norm(b:real^N) = r <=> norm(b) = r /\ ~(b = vec 0)`] THEN + GEOM_NORMALIZE_TAC `b:real^N` THEN REWRITE_TAC[] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN + SIMP_TAC[NORM_MUL; real_abs; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[REAL_MUL_RID; VECTOR_MUL_EQ_0] THEN + DISCH_THEN(K ALL_TAC) THEN DISCH_THEN SUBST1_TAC THEN + REPEAT GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LID] THEN + ASM_CASES_TAC `r = &1` THEN ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN STRIP_TAC THEN + SUBGOAL_THEN `subspace(t:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_EQ_SUBSPACE]; ALL_TAC] THEN + TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0} INTER t` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HOMEOMORPHIC_AFFINE_SETS THEN + ASM_SIMP_TAC[AFFINE_INTER; AFFINE_STANDARD_HYPERPLANE] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + MP_TAC(ISPECL [`basis 1:real^N`; `&0`; `t:real^N->bool`] + AFF_DIM_AFFINE_INTER_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `~(t INTER {x:real^N | x$1 = &0} = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_ELIM_THM] THEN + EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[VEC_COMPONENT]; + ALL_TAC] THEN + SUBGOAL_THEN `~(t SUBSET {v:real^N | v$1 = &0})` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `basis 1:real^N`) THEN + ASM_SIMP_TAC[IN_ELIM_THM; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]] THEN + SUBGOAL_THEN + `({x:real^N | norm x = &1} INTER t) DELETE (basis 1) = + {x | norm x = &1 /\ ~(x$1 = &1)} INTER t` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s DELETE a = s' ==> (s INTER t) DELETE a = s' INTER t`) THEN + MATCH_MP_TAC(SET_RULE + `Q a /\ (!x. P x /\ Q x ==> x = a) + ==> {x | P x} DELETE a = {x | P x /\ ~Q x}`) THEN + SIMP_TAC[BASIS_COMPONENT; CART_EQ; DIMINDEX_GE_1; LE_REFL] THEN + REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[dot; SUM_CLAUSES_LEFT; DIMINDEX_GE_1] THEN + REWRITE_TAC[REAL_ARITH `&1 * &1 + s = &1 <=> s = &0`] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + SUM_POS_EQ_0_NUMSEG)) THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY ABBREV_TAC + [`f = \x:real^N. &2 % basis 1 + &2 / (&1 - x$1) % (x - basis 1)`; + `g = \y:real^N. + basis 1 + &4 / (norm y pow 2 + &4) % (y - &2 % basis 1)`] THEN + MAP_EVERY EXISTS_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET] + `f continuous_on s ==> f continuous_on (s INTER t)`) THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[REAL_SUB_0; IN_ELIM_THM] THEN + REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1]; + MATCH_MP_TAC(SET_RULE + `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t + ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN + EXPAND_TAC "f" THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB] THEN + REWRITE_TAC[IN_ELIM_THM; IN_DELETE] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; + LE_REFL; DIMINDEX_GE_1; VECTOR_SUB_COMPONENT] THEN + CONV_TAC REAL_FIELD; + MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET; INTER_SUBSET] + `f continuous_on s ==> f continuous_on (s INTER t)`) THEN + EXPAND_TAC "g" THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[o_DEF; real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + SIMP_TAC[LIFT_ADD; REAL_POW_LE; NORM_POS_LE; REAL_ARITH + `&0 <= x ==> ~(x + &4 = &0)`] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_POW_2; LIFT_CMUL; CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_NORM; GSYM o_DEF]; + MATCH_MP_TAC(SET_RULE + `IMAGE f s SUBSET s' /\ IMAGE f t SUBSET t + ==> IMAGE f (s INTER t) SUBSET (s' INTER t)`) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS] THEN EXPAND_TAC "g" THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SUBSPACE_ADD; SUBSPACE_MUL; SUBSPACE_SUB]] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_ARITH + `b + a % (y - &2 % b):real^N = (&1 - &2 * a) % b + a % y`] THEN + REWRITE_TAC[NORM_POW_2; VECTOR_ARITH + `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN + ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; LE_REFL; + VECTOR_ADD_COMPONENT; DIMINDEX_GE_1; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; GSYM REAL_POW_2] THEN + SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` MP_TAC THENL + [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`]; + CONV_TAC REAL_FIELD]; + SUBGOAL_THEN + `!x. norm x = &1 /\ ~(x$1 = &1) + ==> norm((f:real^N->real^N) x) pow 2 = &4 * (&1 + x$1) / (&1 - x$1)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "f" THEN + REWRITE_TAC[VECTOR_ARITH + `a % b + m % (x - b):real^N = (a - m) % b + m % x`] THEN + REWRITE_TAC[NORM_POW_2; VECTOR_ARITH + `(a + b:real^N) dot (a + b) = (a dot a + b dot b) + &2 * a dot b`] THEN + SIMP_TAC[DOT_LMUL; DOT_RMUL; DOT_BASIS; BASIS_COMPONENT; + DIMINDEX_GE_1; LE_REFL; VECTOR_MUL_COMPONENT] THEN + ASM_REWRITE_TAC[GSYM NORM_POW_2; GSYM REAL_POW_2; REAL_MUL_RID; + REAL_POW_ONE] THEN + UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + EXPAND_TAC "g" THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_FIELD + `~(x = &1) + ==> &4 * (&1 + x) / (&1 - x) + &4 = &8 / (&1 - x)`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN + REWRITE_TAC[REAL_ARITH `&4 * inv(&8) * x = x / &2`] THEN + EXPAND_TAC "f" THEN + REWRITE_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH + `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN DISJ1_TAC THEN + UNDISCH_TAC `~((x:real^N)$1 = &1)` THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + DISCH_TAC THEN + SUBGOAL_THEN `~((y:real^N) dot y + &4 = &0)` ASSUME_TAC THENL + [MESON_TAC[DOT_POS_LE; REAL_ARITH `&0 <= x ==> ~(x + &4 = &0)`]; + ALL_TAC] THEN + SUBGOAL_THEN `((g:real^N->real^N) y)$1 = + (y dot y - &4) / (y dot y + &4)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN + REWRITE_TAC[VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[BASIS_COMPONENT; LE_REFL; NORM_POW_2; DIMINDEX_GE_1] THEN + UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN + CONV_TAC REAL_FIELD; + ALL_TAC] THEN + EXPAND_TAC "f" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "g" THEN SIMP_TAC[VECTOR_ARITH `(a + x) - a:real^N = x`] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; VECTOR_ARITH + `b + a % (x - b):real^N = x <=> (&1 - a) % (x - b) = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; NORM_POW_2] THEN DISJ1_TAC THEN + UNDISCH_TAC `~((y:real^N) dot y + &4 = &0)` THEN CONV_TAC REAL_FIELD]);; + +let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN = prove + (`!s:real^N->bool t:real^M->bool a. + convex s /\ bounded s /\ a IN relative_frontier s /\ + affine t /\ aff_dim s = aff_dim t + &1 + ==> (relative_frontier s DELETE a) homeomorphic t`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; AFF_DIM_GE; INT_ARITH + `--(&1):int <= s ==> ~(--(&1) = s + &1)`] THEN + MP_TAC(ISPECL [`(:real^N)`; `aff_dim(s:real^N->bool)`] + CHOOSE_AFFINE_SUBSET) THEN REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[AFF_DIM_GE; AFF_DIM_LE_UNIV; AFF_DIM_UNIV; AFFINE_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(t:real^N->bool = {})` MP_TAC THENL + [ASM_MESON_TAC[AFF_DIM_EQ_MINUS1]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `ball(z:real^N,&1) INTER t`] + HOMEOMORPHIC_RELATIVE_FRONTIERS_CONVEX_BOUNDED_SETS) THEN + MP_TAC(ISPECL [`t:real^N->bool`; `ball(z:real^N,&1)`] + (ONCE_REWRITE_RULE[INTER_COMM] AFF_DIM_CONVEX_INTER_OPEN)) THEN + MP_TAC(ISPECL [`ball(z:real^N,&1)`; `t:real^N->bool`] + RELATIVE_FRONTIER_CONVEX_INTER_AFFINE) THEN + ASM_SIMP_TAC[CONVEX_INTER; BOUNDED_INTER; BOUNDED_BALL; CONVEX_BALL; + AFFINE_IMP_CONVEX; INTERIOR_OPEN; OPEN_BALL; + FRONTIER_BALL; REAL_LT_01] THEN + SUBGOAL_THEN `~(ball(z:real^N,&1) INTER t = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_01]; + ASM_REWRITE_TAC[] THEN REPEAT(DISCH_THEN SUBST1_TAC) THEN SIMP_TAC[]] THEN + REWRITE_TAC[homeomorphic; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM homeomorphic] THEN + TRANS_TAC HOMEOMORPHIC_TRANS + `(sphere(z,&1) INTER t) DELETE (h:real^N->real^N) a` THEN + CONJ_TAC THENL + [REWRITE_TAC[homeomorphic] THEN + MAP_EVERY EXISTS_TAC [`h:real^N->real^N`; `k:real^N->real^N`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN + REWRITE_TAC[HOMEOMORPHISM] THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET]; + ASM SET_TAC[]; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; DELETE_SUBSET]; + ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]]; + MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_AFFINE_SPHERE_AFFINE THEN + ASM_REWRITE_TAC[REAL_LT_01; GSYM IN_INTER] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHISM]) THEN + ASM SET_TAC[]]);; + +let HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE = prove + (`!a r b:real^N t:real^M->bool. + &0 < r /\ b IN sphere(a,r) /\ affine t /\ aff_dim(t) + &1 = &(dimindex(:N)) + ==> (sphere(a:real^N,r) DELETE b) homeomorphic t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cball(a:real^N,r)`; `t:real^M->bool`; `b:real^N`] + HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE_GEN) THEN + ASM_SIMP_TAC[RELATIVE_FRONTIER_CBALL; REAL_LT_IMP_NZ; AFF_DIM_CBALL; + CONVEX_CBALL; BOUNDED_CBALL]);; + +let HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE = prove + (`!a r b c d. + &0 < r /\ b IN sphere(a,r) /\ ~(c = vec 0) + ==> (sphere(a:real^N,r) DELETE b) homeomorphic + {x:real^N | c dot x = d}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE THEN + ASM_SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE] THEN INT_ARITH_TAC);; + +let HOMEOMORPHIC_PUNCTURED_SPHERE_UNIV = prove + (`!a r b. + &0 < r /\ b IN sphere(a,r) /\ dimindex(:N) = dimindex(:M) + 1 + ==> (sphere(a:real^N,r) DELETE b) homeomorphic (:real^M)`, + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | basis 1 dot x = &0}` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANE_UNIV; BASIS_NONZERO; LE_REFL; + DIMINDEX_GE_1; HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE]);; + +let CONTRACTIBLE_PUNCTURED_SPHERE = prove + (`!a r b:real^N. + &0 < r /\ b IN sphere(a,r) ==> contractible(sphere(a,r) DELETE b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `contractible {x:real^N | basis 1 dot x = &0}` MP_TAC THENL + [SIMP_TAC[CONVEX_IMP_CONTRACTIBLE; CONVEX_HYPERPLANE]; + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMEOMORPHIC_CONTRACTIBLE) THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + MATCH_MP_TAC HOMEOMORPHIC_PUNCTURED_SPHERE_HYPERPLANE THEN + ASM_SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1]]);; + +(* ------------------------------------------------------------------------- *) +(* When dealing with AR, ANR and ANR later, it's useful to know that any set *) +(* at all is homeomorphic to a closed subset of a convex set, and if the *) +(* set is locally compact we can take the convex set to be the universe. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_CLOSED_IN_CONVEX = prove + (`!s:real^M->bool. + aff_dim s < &(dimindex(:N)) + ==> ?u t:real^N->bool. + convex u /\ + ~(u = {}) /\ + closed_in (subtopology euclidean u) t /\ + s homeomorphic t`, + GEN_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THENL + [REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN + REWRITE_TAC[CONVEX_UNIV; UNIV_NOT_EMPTY; CLOSED_IN_EMPTY] THEN + ASM_REWRITE_TAC[HOMEOMORPHIC_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY])] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M` MP_TAC) THEN + GEOM_ORIGIN_TAC `a:real^M` THEN + SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_LT] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{x:real^N | x$1 = &0}`; `dim(s:real^M->bool)`] + CHOOSE_SUBSPACE_OF_SUBSPACE) THEN + SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_GE_1; LE_REFL; SUBSET; IN_ELIM_THM; + SPAN_OF_SUBSPACE; SUBSPACE_SPECIAL_HYPERPLANE] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`span s:real^M->bool`; `t:real^N->bool`] + ISOMETRIES_SUBSPACES) THEN + ASM_REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`h:real^M->real^N`; `k:real^N->real^M`] THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`vec 0:real^N`; `&1`; `basis 1:real^N`; + `{x:real^N | basis 1 dot x = &0}`] + HOMEOMORPHIC_PUNCTURED_SPHERE_AFFINE) THEN + SIMP_TAC[AFFINE_HYPERPLANE; AFF_DIM_HYPERPLANE; BASIS_NONZERO; + DIMINDEX_GE_1; LE_REFL; REAL_LT_01; IN_SPHERE_0; NORM_BASIS] THEN + ANTS_TAC THENL [INT_ARITH_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN + SIMP_TAC[DOT_BASIS; DIMINDEX_GE_1; LE_REFL; homeomorphic] THEN + REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM; IN_ELIM_THM; + SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real^N`; `g:real^N->real^N`] THEN + STRIP_TAC THEN + EXISTS_TAC `ball(vec 0,&1) UNION + IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN + EXISTS_TAC `IMAGE ((f:real^N->real^N) o (h:real^M->real^N)) s` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_INTERMEDIATE_BALL THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN + REWRITE_TAC[SUBSET_UNION; UNION_SUBSET; BALL_SUBSET_CBALL] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_CBALL_0] THEN + ASM_MESON_TAC[SPAN_SUPERSET; REAL_LE_REFL]; + REWRITE_TAC[NOT_IN_EMPTY; IMAGE_o] THEN ASM SET_TAC[]; + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `sphere(vec 0:real^N,&1)` THEN + REWRITE_TAC[CLOSED_SPHERE] THEN MATCH_MP_TAC(SET_RULE + `b INTER t = {} /\ s SUBSET t ==> s = (b UNION s) INTER t`) THEN + REWRITE_TAC[GSYM CBALL_DIFF_SPHERE] THEN + CONJ_TAC THENL [SET_TAC[]; REWRITE_TAC[SUBSET]] THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_SPHERE_0] THEN + ASM_MESON_TAC[SPAN_SUPERSET]; + MAP_EVERY EXISTS_TAC + [`(k:real^N->real^M) o (g:real^N->real^N)`; + `(f:real^N->real^N) o (h:real^M->real^N)`] THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IMAGE_o] THEN + REPEAT CONJ_TAC THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON]) THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET))) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; IN_DELETE] THEN + MP_TAC(ISPEC `s:real^M->bool` SPAN_INC) THEN ASM SET_TAC[]]);; + +let LOCALLY_COMPACT_HOMEOMORPHIC_CLOSED = prove + (`!s:real^M->bool. + locally compact s /\ dimindex(:M) < dimindex(:N) + ==> ?t:real^N->bool. closed t /\ s homeomorphic t`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?t:real^(M,1)finite_sum->bool h. + closed t /\ homeomorphism (s,t) (h,fstcart)` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[LOCALLY_COMPACT_HOMEOMORPHISM_PROJECTION_CLOSED]; + ALL_TAC] THEN + ABBREV_TAC + `f:real^(M,1)finite_sum->real^N = + \x. lambda i. if i <= dimindex(:M) then x$i + else x$(dimindex(:M)+1)` THEN + ABBREV_TAC + `g:real^N->real^(M,1)finite_sum = (\x. lambda i. x$i)` THEN + EXISTS_TAC `IMAGE (f:real^(M,1)finite_sum->real^N) t` THEN + SUBGOAL_THEN `linear(f:real^(M,1)finite_sum->real^N)` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN REWRITE_TAC[linear; CART_EQ] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `linear(g:real^N->real^(M,1)finite_sum)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[linear; CART_EQ] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. (g:real^N->real^(M,1)finite_sum)((f:real^(M,1)finite_sum->real^N) x) = + x` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["f"; "g"] THEN FIRST_ASSUM(MP_TAC o MATCH_MP + (ARITH_RULE `m < n ==> !i. i <= m + 1 ==> i <= n`)) THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; DIMINDEX_1] THEN + REWRITE_TAC[ARITH_RULE `i <= n + 1 <=> i <= n \/ i = n + 1`] THEN + MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]; ALL_TAC] THEN + TRANS_TAC HOMEOMORPHIC_TRANS `t:real^(M,1)finite_sum->bool` THEN + CONJ_TAC THENL [ASM_MESON_TAC[homeomorphic]; ALL_TAC] THEN + REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN MAP_EVERY EXISTS_TAC + [`f:real^(M,1)finite_sum->real^N`; `g:real^N->real^(M,1)finite_sum`] THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Simple connectedness of a union. This is essentially a stripped-down *) +(* version of the Seifert - Van Kampen theorem. *) +(* ------------------------------------------------------------------------- *) + +let SIMPLY_CONNECTED_UNION = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t /\ + simply_connected s /\ simply_connected t /\ + path_connected (s INTER t) /\ ~(s INTER t = {}) + ==> simply_connected (s UNION t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real^N->bool` + (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `v:real^N->bool` + (STRIP_ASSUME_TAC o GSYM)) MP_TAC) THEN + SIMP_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH; PATH_CONNECTED_UNION] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(pathstart p:real^N) IN s UNION t` MP_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; REWRITE_TAC[IN_UNION]] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN + MAP_EVERY (fun s -> let x = mk_var(s,`:real^N->bool`) in SPEC_TAC(x,x)) + ["v"; "u"; "t"; "s"] THEN + MATCH_MP_TAC(MESON[] + `(!s t u v. x IN s ==> P x s t u v) /\ + (!x s t u v. P x s t u v ==> P x t s v u) + ==> (!s t u v. x IN s \/ x IN t ==> P x s t u v)`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC; + REPEAT GEN_TAC THEN REWRITE_TAC[UNION_COMM; INTER_COMM] THEN + MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[]] THEN + SUBGOAL_THEN + `?e. &0 < e /\ + !x y. x IN interval[vec 0,vec 1] /\ y IN interval[vec 0,vec 1] /\ + norm(x - y) < e + ==> path_image(subpath x y p) SUBSET (s:real^N->bool) \/ + path_image(subpath x y p) SUBSET t` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `path_image(p:real^1->real^N)` HEINE_BOREL_LEMMA) THEN + ASM_SIMP_TAC[COMPACT_PATH_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `{u:real^N->bool,v}`) THEN + SIMP_TAC[UNIONS_2; EXISTS_IN_INSERT; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`p:real^1->real^N`; `interval[vec 0:real^1,vec 1]`] + COMPACT_UNIFORMLY_CONTINUOUS) THEN + ASM_REWRITE_TAC[GSYM path; COMPACT_INTERVAL; uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^1`; `y:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^1->real^N) x`) THEN + ANTS_TAC THENL [REWRITE_TAC[path_image] THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!p'. p SUBSET b /\ + (s UNION t) INTER u = s /\ (s UNION t) INTER v = t /\ + p SUBSET p' /\ p' SUBSET s UNION t + ==> (b SUBSET u \/ b SUBSET v) ==> p SUBSET s \/ p SUBSET t`) THEN + EXISTS_TAC `path_image(p:real^1->real^N)` THEN + ASM_SIMP_TAC[PATH_IMAGE_SUBPATH_SUBSET] THEN + REWRITE_TAC[PATH_IMAGE_SUBPATH_GEN; SUBSET; FORALL_IN_IMAGE] THEN + SUBGOAL_THEN `segment[x,y] SUBSET ball(x:real^1,d)` MP_TAC THENL + [REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + ASM_REWRITE_TAC[INSERT_SUBSET; CENTRE_IN_BALL] THEN + ASM_REWRITE_TAC[IN_BALL; EMPTY_SUBSET; CONVEX_BALL; dist]; + REWRITE_TAC[IN_BALL; dist; SUBSET] THEN STRIP_TAC THEN + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SEGMENT_1]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + ASM_REAL_ARITH_TAC]; + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `N:num` THEN STRIP_TAC] THEN + SUBGOAL_THEN + `!n. n <= N /\ p(lift(&n / &N)) IN s + ==> ?q. path(q:real^1->real^N) /\ path_image q SUBSET s /\ + homotopic_paths (s UNION t) + (subpath (vec 0) (lift(&n / &N)) p) q` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `N:num`) THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LE_REFL; LIFT_NUM] THEN + ANTS_TAC THENL [ASM_MESON_TAC[pathfinish]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` MP_TAC) THEN + REWRITE_TAC[SUBPATH_TRIVIAL] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_PATHS_TRANS) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_MESON_TAC[SUBSET_UNION]] THEN + SUBGOAL_THEN + `!n. n < N + ==> path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p) + SUBSET (s:real^N->bool) \/ + path_image(subpath (lift(&n / &N)) (lift(&(SUC n) / &N)) p) + SUBSET t` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; GSYM LIFT_SUB; DROP_VEC; + NORM_REAL; GSYM drop; + REAL_ARITH `abs(a / c - b / c) = abs((b - a) / c)`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; + REAL_OF_NUM_LT; LE_1; REAL_ARITH `(x + &1) - x = &1`] THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LZERO; REAL_ABS_INV; + REAL_ABS_NUM; REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM] THEN + EXISTS_TAC `linepath((p:real^1->real^N)(vec 0),p(vec 0))` THEN + REWRITE_TAC[SUBPATH_REFL; HOMOTOPIC_PATHS_REFL] THEN + REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + UNDISCH_TAC `(pathstart p:real^N) IN s` THEN REWRITE_TAC[pathstart] THEN + SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC `\m. m < n /\ (p(lift(&m / &N)):real^N) IN s` num_MAX) THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL + [CONJ_TAC THENL [EXISTS_TAC `0`; MESON_TAC[LT_IMP_LE]] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 / x = &0`; LIFT_NUM; LE_1] THEN + ASM_MESON_TAC[pathstart]; + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `?q. path q /\ + path_image(q:real^1->real^N) SUBSET s /\ + homotopic_paths (s UNION t) (subpath (vec 0) (lift (&m / &N)) p) q` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. m < i /\ i <= n + ==> path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET s \/ + path_image(subpath (lift(&m / &N)) (lift(&i / &N)) p) SUBSET + (t:real^N->bool)` + MP_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[CONJUNCT1 LT] THEN + X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_CASES_TAC `i:num = m` THENL + [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN + SUBGOAL_THEN + `p(lift(&i / &N)) IN t /\ ~((p(lift(&i / &N)):real^N) IN s)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SET_RULE + `x IN s UNION t /\ ~(x IN s) ==> x IN t /\ ~(x IN s)`) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s SUBSET t ==> x IN s ==> x IN t`)) THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + SUBGOAL_THEN `i < n /\ ~(i:num <= m)` MP_TAC THENL + [ASM_ARITH_TAC; ASM_MESON_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET s \/ + path_image(subpath (lift(&i / &N)) (lift (&(SUC i) / &N)) p) SUBSET + (t:real^N->bool)` + MP_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(x IN s) + ==> (x IN p /\ x IN q) /\ (q UNION p = r) + ==> p SUBSET s \/ p SUBSET t + ==> q SUBSET s \/ q SUBSET t + ==> r SUBSET s \/ r SUBSET t`)) THEN + SIMP_TAC[PATH_IMAGE_SUBPATH_GEN; FUN_IN_IMAGE; ENDS_IN_SEGMENT] THEN + REWRITE_TAC[GSYM IMAGE_UNION] THEN AP_TERM_TAC THEN + MATCH_MP_TAC UNION_SEGMENT THEN + ASM_SIMP_TAC[SEGMENT_1; LIFT_DROP; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; + LE_1; REAL_OF_NUM_LE; LT_IMP_LE; IN_INTERVAL_1] THEN + ASM_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[LE_REFL]] THEN + STRIP_TAC THENL + [EXISTS_TAC `(q:real^1->real^N) ++ + subpath (lift(&m / &N)) (lift (&n / &N)) p` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PATH_JOIN_IMP THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN + ASM_SIMP_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + DISCH_TAC THEN MATCH_MP_TAC PATH_SUBPATH THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++ + subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]; + MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION] THEN + ASM_REWRITE_TAC[HOMOTOPIC_PATHS_REFL] THEN + MATCH_MP_TAC PATH_SUBPATH] THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC]; + SUBGOAL_THEN + `(p(lift(&m / &N)):real^N) IN t /\ (p(lift(&n / &N)):real^N) IN t` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; PATHFINISH_IN_PATH_IMAGE; + PATHSTART_SUBPATH; PATHFINISH_SUBPATH; SUBSET]; + ALL_TAC] THEN + UNDISCH_TAC `path_connected(s INTER t:real^N->bool)` THEN + REWRITE_TAC[path_connected] THEN DISCH_THEN(MP_TAC o SPECL + [`p(lift(&m / &N)):real^N`; `p(lift(&n / &N)):real^N`]) THEN + ASM_REWRITE_TAC[IN_INTER; SUBSET_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^N` STRIP_ASSUME_TAC) THEN + UNDISCH_THEN + `!p. path p /\ path_image p SUBSET t /\ pathfinish p:real^N = pathstart p + ==> homotopic_paths t p (linepath (pathstart p,pathstart p))` + (MP_TAC o SPEC `subpath (lift(&m / &N)) (lift(&n / &N)) p ++ + reversepath(r:real^1->real^N)`) THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN + MATCH_MP_TAC PATH_JOIN_IMP THEN + ASM_SIMP_TAC[PATH_REVERSEPATH; PATHFINISH_SUBPATH; + PATHSTART_REVERSEPATH] THEN + MATCH_MP_TAC PATH_SUBPATH THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_PATHS_IMP_HOMOTOPIC_LOOPS)) THEN + ASM_REWRITE_TAC[PATHFINISH_LINEPATH; PATHSTART_SUBPATH; + PATHSTART_JOIN; PATHFINISH_JOIN; PATHFINISH_REVERSEPATH] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HOMOTOPIC_PATHS_LOOP_PARTS)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHFINISH) THEN + REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + REPLICATE_TAC 2 (DISCH_THEN(ASSUME_TAC o SYM)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + EXISTS_TAC `(q:real^1->real^N) ++ r` THEN + ASM_SIMP_TAC[PATH_JOIN; PATH_IMAGE_JOIN; UNION_SUBSET] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_TRANS THEN + EXISTS_TAC `subpath (vec 0) (lift(&m / &N)) (p:real^1->real^N) ++ + subpath (lift(&m / &N)) (lift(&n / &N)) p` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN + MATCH_MP_TAC HOMOTOPIC_JOIN_SUBPATHS THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; + LE_1; REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC HOMOTOPIC_PATHS_JOIN THEN + ASM_REWRITE_TAC[PATHSTART_SUBPATH; PATHFINISH_SUBPATH] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_SUBSET THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_UNION]]]);; + +(* ------------------------------------------------------------------------- *) +(* Covering spaces and lifting results for them. *) +(* ------------------------------------------------------------------------- *) + +let covering_space = new_definition + `covering_space(c,(p:real^M->real^N)) s <=> + p continuous_on c /\ IMAGE p c = s /\ + !x. x IN s + ==> ?t. x IN t /\ open_in (subtopology euclidean s) t /\ + ?v. UNIONS v = {x | x IN c /\ p(x) IN t} /\ + (!u. u IN v ==> open_in (subtopology euclidean c) u) /\ + pairwise DISJOINT v /\ + (!u. u IN v ==> ?q. homeomorphism (u,t) (p,q))`;; + +let COVERING_SPACE_IMP_CONTINUOUS = prove + (`!p:real^M->real^N c s. covering_space (c,p) s ==> p continuous_on c`, + SIMP_TAC[covering_space]);; + +let COVERING_SPACE_IMP_SURJECTIVE = prove + (`!p:real^M->real^N c s. covering_space (c,p) s ==> IMAGE p c = s`, + SIMP_TAC[covering_space]);; + +let HOMEOMORPHISM_IMP_COVERING_SPACE = prove + (`!f:real^M->real^N g s t. + homeomorphism (s,t) (f,g) ==> covering_space (s,f) t`, + REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[covering_space] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `t:real^N->bool` THEN + ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN + EXISTS_TAC `{s:real^M->bool}` THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; UNIONS_1; PAIRWISE_SING] THEN + ASM_SIMP_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN + CONJ_TAC THENL [ASM SET_TAC[]; EXISTS_TAC `g:real^N->real^M`] THEN + ASM_REWRITE_TAC[homeomorphism]);; + +let COVERING_SPACE_LOCAL_HOMEOMORPHISM = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> !x. x IN c + ==> ?t u. x IN t /\ open_in (subtopology euclidean c) t /\ + p(x) IN u /\ open_in (subtopology euclidean s) u /\ + ?q. homeomorphism (t,u) (p,q)`, + REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) x`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `v:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(x:real^M) IN UNIONS v` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^M->bool` THEN + STRIP_TAC THEN EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[]);; + +let COVERING_SPACE_LOCAL_HOMEOMORPHISM_ALT = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> !y. y IN s + ==> ?x t u. p(x) = y /\ + x IN t /\ open_in (subtopology euclidean c) t /\ + y IN u /\ open_in (subtopology euclidean s) u /\ + ?q. homeomorphism (t,u) (p,q)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?x. x IN c /\ (p:real^M->real^N) x = y` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + ASM SET_TAC[]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^M` o MATCH_MP + COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN + ASM_MESON_TAC[]]);; + +let COVERING_SPACE_OPEN_MAP = prove + (`!p:real^M->real^N c s t. + covering_space (c,p) s /\ + open_in (subtopology euclidean c) t + ==> open_in (subtopology euclidean s) (IMAGE p t)`, + REWRITE_TAC[covering_space] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^N` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vs:(real^M->bool)->bool` + (STRIP_ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN + `?x. x IN {x | x IN c /\ (p:real^M->real^N) x IN u} /\ x IN t /\ p x = y` + MP_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_UNIONS]) THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool`)) THEN + ASM_REWRITE_TAC[homeomorphism] THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (p:real^M->real^N) (t INTER v)` THEN CONJ_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + SUBGOAL_THEN + `IMAGE (p:real^M->real^N) (t INTER v) = + {z | z IN u /\ q z IN (t INTER v)}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN + EXISTS_TAC `c:real^M->bool` THEN + CONJ_TAC THENL [MATCH_MP_TAC OPEN_IN_INTER; ASM_MESON_TAC[open_in]] THEN + ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; + +let COVERING_SPACE_QUOTIENT_MAP = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> !u. u SUBSET s + ==> (open_in (subtopology euclidean c) {x | x IN c /\ p x IN u} <=> + open_in (subtopology euclidean s) u)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + MATCH_MP_TAC OPEN_MAP_IMP_QUOTIENT_MAP THEN + CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);; + +let COVERING_SPACE_LOCALLY = prove + (`!P Q p:real^M->real^N c s. + covering_space (c,p) s /\ (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\ + locally P c + ==> locally Q s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + MATCH_MP_TAC LOCALLY_OPEN_MAP_IMAGE THEN + EXISTS_TAC `P:(real^M->bool)->bool` THEN + CONJ_TAC THENL [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]);; + +let COVERING_SPACE_LOCALLY_EQ = prove + (`!P Q p:real^M->real^N c s. + covering_space (c,p) s /\ + (!t. t SUBSET c /\ P t ==> Q(IMAGE p t)) /\ + (!q u. u SUBSET s /\ q continuous_on u /\ Q u ==> P(IMAGE q u)) + + ==> (locally Q s <=> locally P c)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[COVERING_SPACE_LOCALLY]] THEN + REWRITE_TAC[locally] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `x:real^M`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN + DISCH_THEN(MP_TAC o SPEC `(p:real^M->real^N) x` o last o CONJUNCTS) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[covering_space; FUN_IN_IMAGE; OPEN_IN_IMP_SUBSET; SUBSET]; + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` MP_TAC)] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `u:real^M->bool` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`IMAGE (p:real^M->real^N) (u INTER v)`; `(p:real^M->real^N) x`]) THEN + ASM_SIMP_TAC[FUN_IN_IMAGE; IN_INTER] THEN ANTS_TAC THENL + [ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP; OPEN_IN_INTER]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` + (X_CHOOSE_THEN `w':real^N->bool` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (q:real^N->real^M) w` THEN + EXISTS_TAC `IMAGE (q:real^N->real^M) w'` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `u:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`p:real^M->real^N`; `t:real^N->bool`] THEN + ASM_REWRITE_TAC[homeomorphism] THEN + + MATCH_MP_TAC OPEN_IN_SUBSET_TRANS THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET)) THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]]; + ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let COVERING_SPACE_LOCALLY_COMPACT_EQ = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> (locally compact s <=> locally compact c)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN + EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; COMPACT_CONTINUOUS_IMAGE]);; + +let COVERING_SPACE_LOCALLY_CONNECTED_EQ = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> (locally connected s <=> locally connected c)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN + EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CONNECTED_CONTINUOUS_IMAGE]);; + +let COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> (locally path_connected s <=> locally path_connected c)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LOCALLY_EQ THEN + EXISTS_TAC `p:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[covering_space]) THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; PATH_CONNECTED_CONTINUOUS_IMAGE]);; + +let COVERING_SPACE_LOCALLY_COMPACT = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ locally compact c + ==> locally compact s`, + MESON_TAC[COVERING_SPACE_LOCALLY_COMPACT_EQ]);; + +let COVERING_SPACE_LOCALLY_CONNECTED = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ locally connected c ==> locally connected s`, + MESON_TAC[COVERING_SPACE_LOCALLY_CONNECTED_EQ]);; + +let COVERING_SPACE_LOCALLY_PATH_CONNECTED = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ locally path_connected c + ==> locally path_connected s`, + MESON_TAC[COVERING_SPACE_LOCALLY_PATH_CONNECTED_EQ]);; + +let COVERING_SPACE_LIFT_UNIQUE_GEN = prove + (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t u a x. + covering_space (c,p) s /\ + f continuous_on t /\ IMAGE f t SUBSET s /\ + g1 continuous_on t /\ IMAGE g1 t SUBSET c /\ + (!x. x IN t ==> f(x) = p(g1 x)) /\ + g2 continuous_on t /\ IMAGE g2 t SUBSET c /\ + (!x. x IN t ==> f(x) = p(g2 x)) /\ + u IN components t /\ a IN u /\ g1(a) = g2(a) /\ x IN u + ==> g1(x) = g2(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + UNDISCH_TAC `(x:real^P) IN u` THEN SPEC_TAC(`x:real^P`,`x:real^P`) THEN + MATCH_MP_TAC(SET_RULE + `(?a. a IN u /\ g a = z) /\ + ({x | x IN u /\ g x = z} = {} \/ {x | x IN u /\ g x = z} = u) + ==> !x. x IN u ==> g x = z`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[VECTOR_SUB_EQ]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN + REWRITE_TAC[CONNECTED_CLOPEN] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_SUBSET) THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `x:real^P` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `(g1:real^P->real^M) x` o + MATCH_MP COVERING_SPACE_LOCAL_HOMEOMORPHISM) THEN + ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`v:real^M->bool`; `w:real^N->bool`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_SUB_EQ]) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[homeomorphism] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^N->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{x | x IN u /\ (g1:real^P->real^M) x IN v} INTER + {x | x IN u /\ (g2:real^P->real^M) x IN v}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTER THEN ONCE_REWRITE_TAC[SET_RULE + `{x | x IN u /\ g x IN v} = + {x | x IN u /\ g x IN (v INTER IMAGE g u)}`] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN + (CONJ_TAC THENL [ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; ALL_TAC]) THEN + UNDISCH_TAC `open_in (subtopology euclidean c) (v:real^M->bool)` THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER; VECTOR_SUB_EQ] THEN + ASM SET_TAC[]]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; + +let COVERING_SPACE_LIFT_UNIQUE = prove + (`!p:real^M->real^N f:real^P->real^N g1 g2 c s t a x. + covering_space (c,p) s /\ + f continuous_on t /\ IMAGE f t SUBSET s /\ + g1 continuous_on t /\ IMAGE g1 t SUBSET c /\ + (!x. x IN t ==> f(x) = p(g1 x)) /\ + g2 continuous_on t /\ IMAGE g2 t SUBSET c /\ + (!x. x IN t ==> f(x) = p(g2 x)) /\ + connected t /\ a IN t /\ g1(a) = g2(a) /\ x IN t + ==> g1(x) = g2(x)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`p:real^M->real^N`; `f:real^P->real^N`; + `g1:real^P->real^M`; `g2:real^P->real^M`; + `c:real^M->bool`; `s:real^N->bool`; `t:real^P->bool`; `t:real^P->bool`; + `a:real^P`; `x:real^P`] COVERING_SPACE_LIFT_UNIQUE_GEN) THEN + ASM_REWRITE_TAC[IN_COMPONENTS_SELF] THEN ASM SET_TAC[]);; + +let COVERING_SPACE_LIFT_UNIQUE_IDENTITY = prove + (`!p:real^M->real^N c f s a. + covering_space (c,p) s /\ + path_connected c /\ + f continuous_on c /\ IMAGE f c SUBSET c /\ + (!x. x IN c ==> p(f x) = p x) /\ + a IN c /\ f(a) = a + ==> !x. x IN c ==> f x = x`, + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^M`; `x:real^M`]) THEN + ASM_REWRITE_TAC[path; path_image; pathstart; pathfinish] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`p:real^M->real^N`; `(p:real^M->real^N) o (g:real^1->real^M)`; + `(f:real^M->real^M) o (g:real^1->real^M)`; `g:real^1->real^M`; + `c:real^M->bool`; `s:real^N->bool`; + `interval[vec 0:real^1,vec 1]`; + `vec 0:real^1`; `vec 1:real^1`] + COVERING_SPACE_LIFT_UNIQUE) THEN + ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [covering_space]) THEN + STRIP_TAC THEN FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE + `IMAGE p c = s ==> !x. x IN c ==> p(x) IN s`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);; + +let COVERING_SPACE_LIFT_HOMOTOPY = prove + (`!p:real^M->real^N c s (h:real^(1,P)finite_sum->real^N) f u. + covering_space (c,p) s /\ + h continuous_on (interval[vec 0,vec 1] PCROSS u) /\ + IMAGE h (interval[vec 0,vec 1] PCROSS u) SUBSET s /\ + (!y. y IN u ==> h (pastecart (vec 0) y) = p(f y)) /\ + f continuous_on u /\ IMAGE f u SUBSET c + ==> ?k. k continuous_on (interval[vec 0,vec 1] PCROSS u) /\ + IMAGE k (interval[vec 0,vec 1] PCROSS u) SUBSET c /\ + (!y. y IN u ==> k(pastecart (vec 0) y) = f y) /\ + (!z. z IN interval[vec 0,vec 1] PCROSS u ==> h z = p(k z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!y. y IN u + ==> ?v. open_in (subtopology euclidean u) v /\ y IN v /\ + ?k:real^(1,P)finite_sum->real^M. + k continuous_on (interval[vec 0,vec 1] PCROSS v) /\ + IMAGE k (interval[vec 0,vec 1] PCROSS v) SUBSET c /\ + (!y. y IN v ==> k(pastecart (vec 0) y) = f y) /\ + (!z. z IN interval[vec 0,vec 1] PCROSS v + ==> h z :real^N = p(k z))` + MP_TAC THENL + [ALL_TAC; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`v:real^P->real^P->bool`; `fs:real^P->real^(1,P)finite_sum->real^M`] THEN + DISCH_THEN(LABEL_TAC "*") THEN + MP_TAC(ISPECL + [`fs:real^P->real^(1,P)finite_sum->real^M`; + `(\x. interval[vec 0,vec 1] PCROSS (v x)) + :real^P->real^(1,P)finite_sum->bool`; + `(interval[vec 0,vec 1] PCROSS u):real^(1,P)finite_sum->bool`; + `u:real^P->bool`] + PASTING_LEMMA_EXISTS) THEN + ASM_SIMP_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^(1,P)finite_sum->real^M` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN + REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `t:real^1`) THEN + X_GEN_TAC `y:real^P` THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`pastecart (t:real^1) (y:real^P)`; `y:real^P`]); + FIRST_X_ASSUM(MP_TAC o SPECL + [`pastecart (vec 0:real^1) (y:real^P)`; `y:real^P`]); + FIRST_X_ASSUM(MP_TAC o SPECL + [`pastecart (t:real^1) (y:real^P)`; `y:real^P`])] THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_INTER; ENDS_IN_UNIT_INTERVAL] THEN + DISCH_THEN SUBST1_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; UNIONS_GSPEC; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `y:real^P`] THEN STRIP_TAC THEN + EXISTS_TAC `y:real^P` THEN ASM_SIMP_TAC[PASTECART_IN_PCROSS]; + X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^P->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(:real^1) PCROSS (t:real^P->bool)` THEN + ASM_SIMP_TAC[REWRITE_RULE[GSYM PCROSS] OPEN_PCROSS; OPEN_UNIV] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_INTER; IN_UNIV] THEN + REPEAT GEN_TAC THEN CONV_TAC TAUT; + REWRITE_TAC[FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC + [`x:real^P`; `z:real^P`; `t:real^1`; `y:real^P`] THEN + REWRITE_TAC[CONJ_ACI] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o + ISPECL [`h:real^(1,P)finite_sum->real^N`; + `(fs:real^P->real^(1,P)finite_sum->real^M) x`; + `(fs:real^P->real^(1,P)finite_sum->real^M) z`; + `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}`; + `pastecart (vec 0:real^1) (y:real^P)`; + `pastecart (t:real^1) (y:real^P)`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS; IN_SING; ENDS_IN_UNIT_INTERVAL] THEN + SIMP_TAC[REWRITE_RULE[GSYM PCROSS] CONNECTED_PCROSS; + CONNECTED_INTERVAL; CONNECTED_SING] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN + ASM_SIMP_TAC[IN_SING]; + ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS)) THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN + ASM_SIMP_TAC[IN_SING]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r /\ s <=> (p /\ q /\ r) /\ s`] THEN + CONJ_TAC THENL + [REMOVE_THEN "*" (MP_TAC o SPEC `x:real^P`); + REMOVE_THEN "*" (MP_TAC o SPEC `z:real^P`)] THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_SING] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_PASTECART; SUBSET; PASTECART_IN_PCROSS] THEN + ASM_SIMP_TAC[IN_SING]]] THEN + X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o last o CONJUNCTS o + GEN_REWRITE_RULE I [covering_space]) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uu:real^N->real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!t. t IN interval[vec 0,vec 1] + ==> ?k n i:real^N. + open_in (subtopology euclidean (interval[vec 0,vec 1])) k /\ + open_in (subtopology euclidean u) n /\ + t IN k /\ y IN n /\ i IN s /\ + IMAGE (h:real^(1,P)finite_sum->real^N) (k PCROSS n) SUBSET uu i` + MP_TAC THENL + [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `(h:real^(1,P)finite_sum->real^N) (pastecart t y) IN s` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o ONCE_REWRITE_RULE[FORALL_IN_IMAGE] o + GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; + ALL_TAC] THEN + SUBGOAL_THEN + `open_in (subtopology euclidean (interval[vec 0,vec 1] PCROSS u)) + {z | z IN (interval[vec 0,vec 1] PCROSS u) /\ + (h:real^(1,P)finite_sum->real^N) z IN + uu(h(pastecart t y))}` + MP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + PASTECART_IN_INTERIOR_SUBTOPOLOGY)) THEN + DISCH_THEN(MP_TAC o SPECL [`t:real^1`; `y:real^P`]) THEN + ASM_SIMP_TAC[IN_ELIM_THM; PASTECART_IN_PCROSS] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^1->bool` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^P->bool` THEN + STRIP_TAC THEN + EXISTS_TAC `(h:real^(1,P)finite_sum->real^N) (pastecart t y)` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [OPEN_IN_OPEN] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[MESON[] + `(?x y. (P y /\ x = f y) /\ Q x) <=> ?y. P y /\ Q(f y)`] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`kk:real^1->real^1->bool`; `nn:real^1->real^P->bool`; + `xx:real^1->real^N`] THEN + DISCH_THEN(LABEL_TAC "+") THEN + MP_TAC(ISPEC `interval[vec 0:real^1,vec 1] PCROSS {y:real^P}` + COMPACT_IMP_HEINE_BOREL) THEN + SIMP_TAC[COMPACT_PCROSS; COMPACT_INTERVAL; COMPACT_SING] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE ((\i. kk i PCROSS nn i):real^1->real^(1,P)finite_sum->bool) + (interval[vec 0,vec 1])`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; OPEN_PCROSS] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IN_SING] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `z:real^P`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN + ASM_MESON_TAC[IN_INTER]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `tk:real^1->bool` STRIP_ASSUME_TAC)] THEN + ABBREV_TAC `n = INTERS (IMAGE (nn:real^1->real^P->bool) tk)` THEN + SUBGOAL_THEN `(y:real^P) IN n /\ open n` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "n" THEN CONJ_TAC THENL + [REWRITE_TAC[INTERS_IMAGE; IN_ELIM_THM]; + MATCH_MP_TAC OPEN_INTERS THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE]] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN + (ANTS_TAC THENL [ASM SET_TAC[]; SIMP_TAC[IN_INTER]]); + ALL_TAC] THEN + MP_TAC(ISPECL + [`interval[vec 0:real^1,vec 1]`; `IMAGE (kk:real^1->real^1->bool) tk`] + LEBESGUE_COVERING_LEMMA) THEN + REWRITE_TAC[COMPACT_INTERVAL; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + MATCH_MP_TAC(TAUT + `q /\ (p ==> ~q) /\ (q ==> (r ==> s) ==> t) + ==> (~p /\ q /\ r ==> s) ==> t`) THEN + SIMP_TAC[UNIONS_0; IMAGE_CLAUSES; SUBSET_EMPTY; UNIT_INTERVAL_NONEMPTY] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN + REWRITE_TAC[SUBSET; FORALL_IN_PCROSS; IMP_CONJ; IN_SING] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; PASTECART_IN_PCROSS] THEN + MESON_TAC[]; + DISCH_TAC] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `d:real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!n. n <= N + ==> ?v k:real^(1,P)finite_sum->real^M. + open_in (subtopology euclidean u) v /\ + y IN v /\ + k continuous_on interval[vec 0,lift(&n / &N)] PCROSS v /\ + IMAGE k (interval[vec 0,lift(&n / &N)] PCROSS v) SUBSET c /\ + (!y. y IN v ==> k (pastecart (vec 0) y) = f y) /\ + (!z. z IN interval[vec 0,lift(&n / &N)] PCROSS v + ==> h z:real^N = p (k z))` + MP_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; LIFT_NUM]] THEN + MATCH_MP_TAC num_INDUCTION THEN CONJ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN + EXISTS_TAC `u:real^P->bool` THEN + EXISTS_TAC `(f o sndcart):real^(1,P)finite_sum->real^M` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; INTERVAL_SING] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_SING; o_THM] THEN + ASM_REWRITE_TAC[FORALL_UNWIND_THM2; SNDCART_PASTECART] THEN + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + SIMP_TAC[SNDCART_PASTECART]; + ALL_TAC] THEN + X_GEN_TAC `m:num` THEN ASM_CASES_TAC `SUC m <= N` THEN + ASM_SIMP_TAC[ARITH_RULE `SUC m <= N ==> m <= N`; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`v:real^P->bool`; `k:real^(1,P)finite_sum->real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPEC `interval[lift(&m / &N),lift(&(SUC m) / &N)]`) THEN + ANTS_TAC THENL + [REWRITE_TAC[DIAMETER_INTERVAL; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC; INTERVAL_EQ_EMPTY_1; + GSYM LIFT_SUB; NORM_LIFT] THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; LE_1; + REAL_FIELD `&0 < x ==> a / x - b / x = (a - b) / x`] THEN + SIMP_TAC[GSYM NOT_LE; ARITH_RULE `m <= SUC m`; REAL_OF_NUM_SUB] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_LE_DIV; REAL_POS; + REAL_ABS_NUM; ARITH_RULE `SUC m - m = 1`] THEN + ASM_SIMP_TAC[REAL_ARITH `&1 / n = inv(n)`; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^1` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "+" (MP_TAC o SPEC `t:real^1`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(xx:real^1->real^N) t`) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC + `(k:real^(1,P)finite_sum->real^M) (pastecart (lift(&m / &N)) y)`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC(TAUT + `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN + REPEAT(FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [IN_INTER])) THEN + SUBGOAL_THEN + `lift(&m / &N) IN interval[vec 0,lift (&m / &N)] /\ + lift(&m / &N) IN interval[lift(&m / &N),lift(&(SUC m) / &N)]` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; LE_1; REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + ARITH_TAC; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; + FIRST_X_ASSUM(MP_TAC o SPEC `pastecart(lift(&m / &N)) (y:real^P)`) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN + ASM_SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; REAL_LE_DIV; REAL_LE_LDIV_EQ; + REAL_POS; REAL_OF_NUM_LT; LE_1; DROP_VEC] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_OF_NUM_LE] THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC LAND_CONV [IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w:real^M->bool`) MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `w:real^M->bool` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN + DISCH_TAC THEN UNDISCH_THEN `(w:real^M->bool) IN vv` (K ALL_TAC)] THEN + ABBREV_TAC `w' = (uu:real^N->real^N->bool)(xx(t:real^1))` THEN + SUBGOAL_THEN + `?n'. open_in (subtopology euclidean u) n' /\ y IN n' /\ + IMAGE (k:real^(1,P)finite_sum->real^M) ({lift(&m / &N)} PCROSS n') + SUBSET w` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC + `{z | z IN v /\ ((k:real^(1,P)finite_sum->real^M) o + pastecart (lift(&m / &N))) z IN w}` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_SING; o_THM] THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^P->bool` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS]; + ALL_TAC] THEN + SUBGOAL_THEN + `?q q':real^P->bool. + open_in (subtopology euclidean u) q /\ + closed_in (subtopology euclidean u) q' /\ + y IN q /\ y IN q' /\ q SUBSET q' /\ + q SUBSET (u INTER nn(t:real^1)) INTER n' INTER v /\ + q' SUBSET (u INTER nn(t:real^1)) INTER n' INTER v` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SET_RULE + `y IN q /\ y IN q' /\ q SUBSET q' /\ q SUBSET s /\ q' SUBSET s <=> + y IN q /\ q SUBSET q' /\ q' SUBSET s`] THEN + UNDISCH_TAC `open_in (subtopology euclidean u) (v:real^P->bool)` THEN + UNDISCH_TAC `open_in (subtopology euclidean u) (n':real^P->bool)` THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `vo:real^P->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `vx:real^P->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `nn(t:real^1) INTER vo INTER vx:real^P->bool` + OPEN_CONTAINS_CBALL) THEN + ASM_SIMP_TAC[OPEN_INTER] THEN DISCH_THEN(MP_TAC o SPEC `y:real^P`) THEN + ASM_REWRITE_TAC[IN_INTER] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u INTER ball(y:real^P,e)` THEN + EXISTS_TAC `u INTER cball(y:real^P,e)` THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + CONJ_TAC THENL [MESON_TAC[OPEN_BALL]; ALL_TAC] THEN + CONJ_TAC THENL [MESON_TAC[CLOSED_CBALL]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL] THEN + MP_TAC(ISPECL [`y:real^P`; `e:real`] BALL_SUBSET_CBALL) THEN + ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homeomorphism]) THEN + EXISTS_TAC `q:real^P->bool` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`\x:real^(1,P)finite_sum. + x IN interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`; + `k:real^(1,P)finite_sum->real^M`; + `(p':real^N->real^M) o (h:real^(1,P)finite_sum->real^N)`; + `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool)`; + `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (q':real^P->bool)`] + CONTINUOUS_ON_CASES_LOCAL) THEN + REWRITE_TAC[TAUT `~(p /\ ~p)`] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `interval[vec 0,lift(&m / &N)] PCROSS (:real^P)` THEN + SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT; + REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC + `interval[lift(&m / &N),lift(&(SUC m) / &N)] PCROSS (:real^P)` THEN + SIMP_TAC[CLOSED_PCROSS; CLOSED_INTERVAL; CLOSED_UNIV] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; FORALL_PASTECART] THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV] THEN CONV_TAC TAUT; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) + THENL + [ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN + MATCH_MP_TAC PCROSS_MONO THEN + (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN + ASM_REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; + SUBSET_INTER] THEN + REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; + LE_1] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1; + REAL_MUL_LZERO; REAL_MUL_LID; REAL_OF_NUM_LE] THEN + DISJ2_TAC THEN ARITH_TAC; + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN + ASM_CASES_TAC `(z:real^P) IN q'` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN DISCH_THEN(MP_TAC o MATCH_MP + (REAL_ARITH `(b <= x /\ x <= c) /\ (a <= x /\ x <= b) ==> x = b`)) THEN + REWRITE_TAC[DROP_EQ; o_THM] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `(!x. x IN w ==> p' (p x) = x) + ==> h z = p(k z) /\ k z IN w + ==> k z = p' (h z)`)) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]]]; + SUBGOAL_THEN + `interval[vec 0,lift(&m / &N)] UNION + interval [lift(&m / &N),lift(&(SUC m) / &N)] = + interval[vec 0,lift(&(SUC m) / &N)]` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_INTERVAL_1] THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= c ==> + (a <= x /\ x <= b \/ b <= x /\ x <= c <=> a <= x /\ x <= c)`) THEN + SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_DIV; REAL_POS] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; REAL_OF_NUM_LE; LE_1] THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `interval[vec 0,lift(&m / &N)] PCROSS (q':real^P->bool) UNION + interval [lift(&m / &N),lift(&(SUC m) / &N)] PCROSS q' = + interval[vec 0,lift(&(SUC m) / &N)] PCROSS q'` + SUBST1_TAC THENL + [SIMP_TAC[EXTENSION; IN_UNION; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(MESON[CONTINUOUS_ON_SUBSET] + `t SUBSET s /\ (f continuous_on s ==> P f) + ==> f continuous_on s ==> ?g. g continuous_on t /\ P g`) THEN + ASM_SIMP_TAC[PCROSS_MONO; SUBSET_REFL] THEN DISCH_TAC THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_REWRITE_TAC[PASTECART_IN_PCROSS]] THEN + COND_CASES_TAC THEN REWRITE_TAC[o_THM] THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + MATCH_MP_TAC FUN_IN_IMAGE THEN + REWRITE_TAC[PASTECART_IN_PCROSS; IN_SING] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o + CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE p w' = w ==> x IN w' ==> p x IN w`))]; + X_GEN_TAC `z:real^P` THEN REWRITE_TAC[PASTECART_IN_PCROSS] THEN + DISCH_TAC THEN REWRITE_TAC[IN_INTERVAL_1; REAL_LE_REFL] THEN + SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_REWRITE_TAC[LIFT_DROP; DROP_VEC]] THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS] THEN ASM SET_TAC[]; + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`r:real^1`; `z:real^P`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(z:real^P) IN q'` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN ASM SET_TAC[]; + REWRITE_TAC[o_THM] THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM MATCH_MP_TAC]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (SET_RULE `IMAGE h s SUBSET t ==> x IN s ==> h x IN t`)) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTER] THEN + REPEAT(CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1]) THEN + REWRITE_TAC[IN_INTERVAL_1] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `a <= x /\ x <= b ==> b <= c ==> a <= x /\ x <= c`)) THEN + ASM_SIMP_TAC[LIFT_DROP; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_MUL_LID; REAL_OF_NUM_LE]]);; + +let COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION = prove + (`!p:real^M->real^N c s f f' g u:real^P->bool. + covering_space (c,p) s /\ + g continuous_on u /\ IMAGE g u SUBSET c /\ + (!y. y IN u ==> p(g y) = f y) /\ + homotopic_with (\x. T) (u,s) f f' + ==> ?g'. g' continuous_on u /\ IMAGE g' u SUBSET c /\ + (!y. y IN u ==> p(g' y) = f' y)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `h:real^(1,P)finite_sum->real^N` + STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [homotopic_with]) THEN + FIRST_ASSUM(MP_TAC o + ISPECL [`h:real^(1,P)finite_sum->real^N`; + `g:real^P->real^M`; `u:real^P->bool`] o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o + (\x. pastecart (vec 1) x)` THEN + ASM_REWRITE_TAC[IMAGE_o; o_THM] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; + ENDS_IN_UNIT_INTERVAL]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; + ENDS_IN_UNIT_INTERVAL]; + ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]]);; + +let COVERING_SPACE_LIFT_INESSENTIAL_FUNCTION = prove + (`!p:real^M->real^N c s f a u:real^P->bool. + covering_space (c,p) s /\ homotopic_with (\x. T) (u,s) f (\x. a) + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ + (!y. y IN u ==> p(g y) = f y)`, + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `u:real^P->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET; + CONTINUOUS_ON_EMPTY] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE + [TAUT `a /\ b /\ c /\ d /\ e ==> f <=> a /\ e ==> b /\ c /\ d ==> f`] + COVERING_SPACE_LIFT_HOMOTOPIC_FUNCTION)) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + SUBGOAL_THEN `?b. b IN c /\ (p:real^M->real^N) b = a` CHOOSE_TAC THENL + [ASM SET_TAC[]; + EXISTS_TAC `(\x. b):real^P->real^M`] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]);; + +let COVERING_SPACE_LIFT_HOMOTOPY_ALT = prove + (`!p:real^M->real^N c s (h:real^(P,1)finite_sum->real^N) f u. + covering_space (c,p) s /\ + h continuous_on (u PCROSS interval[vec 0,vec 1]) /\ + IMAGE h (u PCROSS interval[vec 0,vec 1]) SUBSET s /\ + (!y. y IN u ==> h (pastecart y (vec 0)) = p(f y)) /\ + f continuous_on u /\ IMAGE f u SUBSET c + ==> ?k. k continuous_on (u PCROSS interval[vec 0,vec 1]) /\ + IMAGE k (u PCROSS interval[vec 0,vec 1]) SUBSET c /\ + (!y. y IN u ==> k(pastecart y (vec 0)) = f y) /\ + (!z. z IN u PCROSS interval[vec 0,vec 1] ==> h z = p(k z))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPECL + [`(h:real^(P,1)finite_sum->real^N) o + (\z. pastecart (sndcart z) (fstcart z))`; + `f:real^P->real^M`; `u:real^P->bool`] o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN + ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`))] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART]; + DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o + (\z. pastecart (sndcart z) (fstcart z))` THEN + ASM_SIMP_TAC[o_THM; FSTCART_PASTECART; SNDCART_PASTECART; + FORALL_IN_PCROSS; PASTECART_IN_PCROSS] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + REWRITE_TAC[IMAGE_o] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)); + MAP_EVERY X_GEN_TAC [`x:real^P`; `t:real^1`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (x:real^P)`)] THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART; FORALL_IN_PCROSS]]);; + +let COVERING_SPACE_LIFT_PATH_STRONG = prove + (`!p:real^M->real^N c s g a. + covering_space (c,p) s /\ + path g /\ path_image g SUBSET s /\ pathstart g = p(a) /\ a IN c + ==> ?h. path h /\ path_image h SUBSET c /\ pathstart h = a /\ + !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`, + REWRITE_TAC[path_image; path; pathstart] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o + ISPECL [`(g:real^1->real^N) o (fstcart:real^(1,P)finite_sum->real^1)`; + `(\y. a):real^P->real^M`; `{arb:real^P}`] o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY)) THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; o_THM; FSTCART_PASTECART] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[IMAGE_o; CONTINUOUS_ON_CONST] THEN + ASM_REWRITE_TAC[SET_RULE `IMAGE (\y. a) {b} SUBSET s <=> a IN s`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + ALL_TAC] THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS] THEN + SIMP_TAC[FSTCART_PASTECART] THEN ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `k:real^(1,P)finite_sum->real^M` + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(k:real^(1,P)finite_sum->real^M) o (\t. pastecart t arb)` THEN + ASM_REWRITE_TAC[o_THM; IMAGE_o] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_SING]; + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (arb:real^P)`) THEN + ASM_SIMP_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; IN_SING]]]);; + +let COVERING_SPACE_LIFT_PATH = prove + (`!p:real^M->real^N c s g. + covering_space (c,p) s /\ path g /\ path_image g SUBSET s + ==> ?h. path h /\ path_image h SUBSET c /\ + !t. t IN interval[vec 0,vec 1] ==> p(h t) = g t`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `IMAGE g i SUBSET s ==> vec 0 IN i ==> g(vec 0) IN s`) o + GEN_REWRITE_RULE LAND_CONV [path_image]) THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + REWRITE_TAC[IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^M` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`; + `g:real^1->real^N`; `a:real^M`] + COVERING_SPACE_LIFT_PATH_STRONG) THEN + ASM_REWRITE_TAC[pathstart] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; + +let COVERING_SPACE_LIFT_HOMOTOPIC_PATHS = prove + (`!p:real^M->real^N c s g1 g2 h1 h2. + covering_space (c,p) s /\ + path g1 /\ path_image g1 SUBSET s /\ + path g2 /\ path_image g2 SUBSET s /\ + homotopic_paths s g1 g2 /\ + path h1 /\ path_image h1 SUBSET c /\ + (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\ + path h2 /\ path_image h2 SUBSET c /\ + (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\ + pathstart h1 = pathstart h2 + ==> homotopic_paths c h1 h2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMOTOPIC_PATHS] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homotopic_paths]) THEN + REWRITE_TAC[homotopic_with; pathstart; pathfinish] THEN + DISCH_THEN(X_CHOOSE_THEN + `h:real^(1,1)finite_sum->real^N` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o ISPECL + [`h:real^(1,1)finite_sum->real^N`; `(\x. pathstart h2):real^1->real^M`; + `interval[vec 0:real^1,vec 1]`] o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_HOMOTOPY_ALT)) THEN + ASM_SIMP_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_CONST; SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; PATHSTART_IN_PATH_IMAGE; + SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^(1,1)finite_sum->real^M` THEN + STRIP_TAC THEN ASM_SIMP_TAC[o_DEF] THEN + MATCH_MP_TAC(TAUT `(p /\ q) /\ (p /\ q ==> r) ==> p /\ q /\ r`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o + REWRITE_RULE[RIGHT_FORALL_IMP_THM] o + ONCE_REWRITE_RULE[IMP_CONJ] o + REWRITE_RULE[CONJ_ASSOC] o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THENL + [MAP_EVERY EXISTS_TAC [`g1:real^1->real^N`; `vec 0:real^1`]; + MAP_EVERY EXISTS_TAC [`g2:real^1->real^N`; `vec 0:real^1`]] THEN + ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[path_image; pathstart; pathfinish; path]) THEN + ASM_REWRITE_TAC[CONNECTED_INTERVAL; pathstart; pathfinish] THEN + REWRITE_TAC[CONJ_ASSOC] THEN + (REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)); + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE k s SUBSET c ==> t SUBSET s ==> IMAGE k t SUBSET c`)); + ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]); + STRIP_TAC THEN + REWRITE_TAC[TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL + [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL]; ALL_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o + REWRITE_RULE[RIGHT_FORALL_IMP_THM] o + ONCE_REWRITE_RULE[IMP_CONJ] o + REWRITE_RULE[CONJ_ASSOC] o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN + MAP_EVERY EXISTS_TAC + [`(\x. pathfinish g1):real^1->real^N`; `vec 0:real^1`] THEN + ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; CONNECTED_INTERVAL] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; pathfinish] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; FORALL_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART; ENDS_IN_UNIT_INTERVAL]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `pastecart (t:real^1) (vec 1:real^1)` o + REWRITE_RULE[FORALL_IN_IMAGE] o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; + ASM_MESON_TAC[PASTECART_IN_PCROSS; ENDS_IN_UNIT_INTERVAL]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[SUBSET; pathfinish; PATHFINISH_IN_PATH_IMAGE]]]);; + +let COVERING_SPACE_MONODROMY = prove + (`!p:real^M->real^N c s g1 g2 h1 h2. + covering_space (c,p) s /\ + path g1 /\ path_image g1 SUBSET s /\ + path g2 /\ path_image g2 SUBSET s /\ + homotopic_paths s g1 g2 /\ + path h1 /\ path_image h1 SUBSET c /\ + (!t. t IN interval[vec 0,vec 1] ==> p(h1 t) = g1 t) /\ + path h2 /\ path_image h2 SUBSET c /\ + (!t. t IN interval[vec 0,vec 1] ==> p(h2 t) = g2 t) /\ + pathstart h1 = pathstart h2 + ==> pathfinish h1 = pathfinish h2`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP COVERING_SPACE_LIFT_HOMOTOPIC_PATHS) THEN + REWRITE_TAC[HOMOTOPIC_PATHS_IMP_PATHFINISH]);; + +let COVERING_SPACE_LIFT_HOMOTOPIC_PATH = prove + (`!p:real^M->real^N c s f f' g a b. + covering_space (c,p) s /\ + homotopic_paths s f f' /\ + path g /\ path_image g SUBSET c /\ + pathstart g = a /\ pathfinish g = b /\ + (!t. t IN interval[vec 0,vec 1] ==> p(g t) = f t) + ==> ?g'. path g' /\ path_image g' SUBSET c /\ + pathstart g' = a /\ pathfinish g' = b /\ + (!t. t IN interval[vec 0,vec 1] ==> p(g' t) = f' t)`, + ONCE_REWRITE_TAC[HOMOTOPIC_PATHS_SYM] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATH) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN + FIRST_ASSUM(MP_TAC o ISPECL [`f':real^1->real^N`; `a:real^M`] o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_PATH_STRONG)) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[pathstart; ENDS_IN_UNIT_INTERVAL; + HOMOTOPIC_PATHS_IMP_PATHSTART]; + ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g':real^1->real^M` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(ASSUME `pathfinish g:real^M = b`)) THEN + FIRST_ASSUM(MATCH_MP_TAC o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_MONODROMY)) THEN + MAP_EVERY EXISTS_TAC [`f':real^1->real^N`; `f:real^1->real^N`] THEN + ASM_REWRITE_TAC[]]);; + +let COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP = prove + (`!p:real^M->real^N c s g h a. + covering_space (c,p) s /\ + path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ + homotopic_paths s g (linepath(a,a)) /\ + path h /\ path_image h SUBSET c /\ + (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t) + ==> pathfinish h = pathstart h`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_SUBSET) THEN + REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + REWRITE_TAC[PATHSTART_LINEPATH] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o + ISPECL [`g:real^1->real^N`; `linepath(a:real^N,a)`; + `h:real^1->real^M`; `linepath(pathstart h:real^M,pathstart h)`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_MONODROMY)) THEN + ASM_REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + ASM_REWRITE_TAC[SING_SUBSET; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[LINEPATH_REFL] THEN CONJ_TAC THENL + [ASM_MESON_TAC[PATHSTART_IN_PATH_IMAGE; SUBSET]; + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + REWRITE_TAC[pathstart] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[ENDS_IN_UNIT_INTERVAL]]);; + +let COVERING_SPACE_SIMPLY_CONNECTED_LOOP_LIFT_IS_LOOP = prove + (`!p:real^M->real^N c s g h. + covering_space (c,p) s /\ simply_connected s /\ + path g /\ path_image g SUBSET s /\ pathfinish g = pathstart g /\ + path h /\ path_image h SUBSET c /\ + (!t. t IN interval[vec 0,vec 1] ==> p(h t) = g t) + ==> pathfinish h = pathstart h`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_INESSENTIAL_LOOP_LIFT_IS_LOOP)) THEN + EXISTS_TAC `g:real^1->real^N` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_PATH]);; + +(* ------------------------------------------------------------------------- *) +(* Lifting of general functions to covering space *) +(* ------------------------------------------------------------------------- *) + +let COVERING_SPACE_LIFT_GENERAL = prove + (`!p:real^M->real^N c s f:real^P->real^N u a z. + covering_space (c,p) s /\ a IN c /\ z IN u /\ + path_connected u /\ locally path_connected u /\ + f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\ + (!r. path r /\ path_image r SUBSET u /\ + pathstart r = z /\ pathfinish r = z + ==> ?q. path q /\ path_image q SUBSET c /\ + pathstart q = a /\ pathfinish q = a /\ + homotopic_paths s (f o r) (p o q)) + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\ + (!y. y IN u ==> p(g y) = f y)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!y. y IN u + ==> ?g h. path g /\ path_image g SUBSET u /\ + pathstart g = z /\ pathfinish g = y /\ + path h /\ path_image h SUBSET c /\ pathstart h = a /\ + (!t. t IN interval[vec 0,vec 1] + ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t))` + (LABEL_TAC "*") + THENL + [X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + DISCH_THEN(MP_TAC o SPECL [`z:real^P`; `y:real^P`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `g:real^1->real^P` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[GSYM o_DEF] THEN + ASM_REWRITE_TAC[PATH_IMAGE_COMPOSE; PATHSTART_COMPOSE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `?l. !y g h. path g /\ path_image g SUBSET u /\ + pathstart g = z /\ pathfinish g = y /\ + path h /\ path_image h SUBSET c /\ pathstart h = a /\ + (!t. t IN interval[vec 0,vec 1] + ==> (p:real^M->real^N)(h t) = (f:real^P->real^N)(g t)) + ==> pathfinish h = l y` + MP_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `y:real^P` THEN + MATCH_MP_TAC(MESON[] + `(!g h g' h'. P g h /\ P g' h' ==> f h = f h') + ==> ?z. !g h. P g h ==> f h = z`) THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g ++ reversepath g'):real^1->real^P`) THEN + ASM_SIMP_TAC[PATH_JOIN; PATHSTART_JOIN; PATHFINISH_JOIN; + PATH_REVERSEPATH; PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH; + SUBSET_PATH_IMAGE_JOIN; PATH_IMAGE_REVERSEPATH] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^M` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o + ISPECL [`(p:real^M->real^N) o (q:real^1->real^M)`; + `(f:real^P->real^N) o (g ++ reversepath g')`; + `q:real^1->real^M`; `pathstart q:real^M`; `pathfinish q:real^M`] o + MATCH_MP(ONCE_REWRITE_RULE[IMP_CONJ] + (ONCE_REWRITE_RULE[HOMOTOPIC_PATHS_SYM] + COVERING_SPACE_LIFT_HOMOTOPIC_PATH))) THEN + ASM_REWRITE_TAC[o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `q':real^1->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `path(h ++ reversepath h':real^1->real^M)` MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[PATH_JOIN_EQ; PATH_REVERSEPATH; PATHSTART_REVERSEPATH]] THEN + MATCH_MP_TAC PATH_EQ THEN EXISTS_TAC `q':real^1->real^M` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + STRIP_TAC THEN REWRITE_TAC[joinpaths] THEN COND_CASES_TAC THENL + [FIRST_ASSUM(MP_TAC o + ISPECL [`(f:real^P->real^N) o (g:real^1->real^P) o (\t. &2 % t)`; + `q':real^1->real^M`; + `(h:real^1->real^M) o (\t. &2 % t)`; + `interval[vec 0,lift(&1 / &2)]`; + `vec 0:real^1`; `t:real^1`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN + REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN + CONJ_TAC THENL + [SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; joinpaths; o_THM]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path]; + REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN + CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) /\ s SUBSET t + ==> IMAGE f s SUBSET IMAGE g t`) THEN + REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC; IN_INTERVAL_1] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN SIMP_TAC[joinpaths; o_THM]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[GSYM path] THEN + REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `path_image(q':real^1->real^M)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC; + X_GEN_TAC `t':real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_SIMP_TAC[GSYM path] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `path_image(h:real^1->real^M)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[]] THEN + REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_VEC; DROP_CMUL; LIFT_DROP] THEN + REAL_ARITH_TAC; + X_GEN_TAC `t':real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN STRIP_TAC THEN + CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[CONNECTED_INTERVAL]; + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM pathstart] THEN + ASM_REWRITE_TAC[] THEN + SUBST1_TAC(SYM(ASSUME `pathstart h:real^M = a`)) THEN + REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN + REWRITE_TAC[VECTOR_MUL_RZERO]; + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC]; + FIRST_ASSUM(MP_TAC o + ISPECL [`(f:real^P->real^N) o reversepath(g':real^1->real^P) o + (\t. &2 % t - vec 1)`; + `q':real^1->real^M`; + `reversepath(h':real^1->real^M) o (\t. &2 % t - vec 1)`; + `{t | &1 / &2 < drop t /\ drop t <= &1}`; + `vec 1:real^1`; `t:real^1`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] COVERING_SPACE_LIFT_UNIQUE)) THEN + REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `(f:real^P->real^N) o (g ++ reversepath g')` THEN + CONJ_TAC THENL + [SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL + [ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_PATH; path]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `path_image ((f:real^P->real^N) o (g ++ reversepath g'))` THEN + CONJ_TAC THENL[ALL_TAC; ASM_MESON_TAC[HOMOTOPIC_PATHS_IMP_SUBSET]] THEN + REWRITE_TAC[path_image] THEN MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) /\ s SUBSET t + ==> IMAGE f s SUBSET IMAGE g t`) THEN + SIMP_TAC[IN_ELIM_THM; GSYM REAL_NOT_LE; joinpaths; o_THM] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_REWRITE_TAC[GSYM path] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC + `path_image(q':real^1->real^M)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[path_image] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTERVAL_1; DROP_VEC] THEN + REAL_ARITH_TAC; + X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) th o rand o snd)) THEN + ASM_SIMP_TAC[IN_INTERVAL_1; joinpaths; DROP_VEC; GSYM REAL_NOT_LT] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `interval[vec 0:real^1,vec 1]` THEN + ASM_SIMP_TAC[GSYM path; PATH_REVERSEPATH] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `path_image(reversepath h':real^1->real^M)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[PATH_IMAGE_REVERSEPATH]] THEN + REWRITE_TAC[path_image; IMAGE_o] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + REAL_ARITH_TAC; + X_GEN_TAC `t':real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[reversepath] THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; DROP_CMUL] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM IS_INTERVAL_CONNECTED_1; IS_INTERVAL_1] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; DROP_VEC] THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM pathfinish] THEN + ASM_REWRITE_TAC[reversepath] THEN + SUBST1_TAC(SYM(ASSUME `pathstart h':real^M = a`)) THEN + REWRITE_TAC[pathstart] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_SUB; DROP_CMUL; DROP_VEC] THEN + REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^P->real^M` THEN + DISCH_THEN(LABEL_TAC "+") THEN + MATCH_MP_TAC(TAUT `(q ==> p) /\ q ==> p /\ q`) THEN REPEAT CONJ_TAC THENL + [STRIP_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN + ASM_MESON_TAC[PATHFINISH_IN_PATH_IMAGE; SUBSET]; + FIRST_ASSUM(MP_TAC o SPECL + [`z:real^P`; `linepath(z:real^P,z)`; `linepath(a:real^M,a)`]) THEN + REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH; SEGMENT_REFL] THEN + REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_SIMP_TAC[LINEPATH_REFL; SING_SUBSET]; + X_GEN_TAC `y:real^P` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^P`; `h:real^1->real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`y:real^P`; `g:real^1->real^P`; `h:real^1->real^M`]) THEN + ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]] THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC I [MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN + X_GEN_TAC `n:real^M->bool` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN X_GEN_TAC `y:real^P` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + FIRST_ASSUM(MP_TAC o SPEC `(f:real^P->real^N) y` o last o CONJUNCTS o + GEN_REWRITE_RULE I [covering_space]) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^N->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `(l:real^P->real^M) y`) THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_UNIONS]] THEN + DISCH_THEN(X_CHOOSE_THEN `w':real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `w':real^M->bool`) MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `w':real^M->bool` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `p':real^N->real^M`) THEN + DISCH_TAC THEN UNDISCH_THEN `(w':real^M->bool) IN vv` (K ALL_TAC) THEN + SUBGOAL_THEN + `?v. y IN v /\ y IN u /\ IMAGE (f:real^P->real^N) v SUBSET w /\ + v SUBSET u /\ path_connected v /\ open_in (subtopology euclidean u) v` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LOCALLY_PATH_CONNECTED]) THEN + DISCH_THEN(MP_TAC o SPECL + [`{x | x IN u /\ (f:real^P->real^N) x IN w}`; `y:real^P`]) THEN + ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [homeomorphism]) THEN + SUBGOAL_THEN `(w':real^M->bool) SUBSET c /\ (w:real^N->bool) SUBSET s` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_in]; ALL_TAC] THEN + EXISTS_TAC + `v INTER + {x | x IN u /\ (f:real^P->real^N) x IN + {x | x IN w /\ (p':real^N->real^M) x IN w' INTER n}}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `w:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `w':real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + UNDISCH_TAC `open_in (subtopology euclidean c) (n:real^M->bool)` THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; + ASM SET_TAC[]; + ALL_TAC] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `y':real^P` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + DISCH_THEN(MP_TAC o SPECL [`y:real^P`; `y':real^P`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real^1->real^P` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `y:real^P`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`pp:real^1->real^P`; `qq:real^1->real^M`] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL + [`y':real^P`; `(pp:real^1->real^P) ++ r`; + `(qq:real^1->real^M) ++ ((p':real^N->real^M) o (f:real^P->real^N) o + (r:real^1->real^P))`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`y:real^P`; `pp:real^1->real^P`; `qq:real^1->real^M`]) THEN + ASM_SIMP_TAC[o_THM; PATHSTART_JOIN; PATHFINISH_JOIN] THEN DISCH_TAC THEN + SUBGOAL_THEN + `path_image ((pp:real^1->real^P) ++ r) SUBSET u` + ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM SET_TAC[]; ALL_TAC] THEN + ANTS_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[PATHFINISH_COMPOSE] THEN ASM_MESON_TAC[]] THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[PATH_JOIN]; + ASM_SIMP_TAC[SUBSET_PATH_IMAGE_JOIN]; + MATCH_MP_TAC PATH_JOIN_IMP THEN ASM_SIMP_TAC[PATHSTART_COMPOSE] THEN + CONJ_TAC THENL + [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + ASM SET_TAC[]; + REWRITE_TAC[pathfinish] THEN ASM SET_TAC[]]; + MATCH_MP_TAC SUBSET_PATH_IMAGE_JOIN THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[PATH_IMAGE_COMPOSE] THEN ASM SET_TAC[]; + X_GEN_TAC `tt:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; DROP_VEC] THEN + STRIP_TAC THEN REWRITE_TAC[joinpaths; o_THM] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THENL + [ABBREV_TAC `t:real^1 = &2 % tt`; + ABBREV_TAC `t:real^1 = &2 % tt - vec 1`] THEN + (SUBGOAL_THEN `t IN interval[vec 0:real^1,vec 1]` ASSUME_TAC THENL + [EXPAND_TAC "t" THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_VEC; DROP_CMUL; DROP_SUB] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC]) THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[path_image]) THEN ASM SET_TAC[]]);; + +let COVERING_SPACE_LIFT_STRONGER = prove + (`!p:real^M->real^N c s f:real^P->real^N u a z. + covering_space (c,p) s /\ a IN c /\ z IN u /\ + path_connected u /\ locally path_connected u /\ + f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a /\ + (!r. path r /\ path_image r SUBSET u /\ + pathstart r = z /\ pathfinish r = z + ==> ?b. homotopic_paths s (f o r) (linepath(b,b))) + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\ + (!y. y IN u ==> p(g y) = f y)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_LIFT_GENERAL)) THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `r:real^1->real^P`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_PATHS_IMP_PATHSTART) THEN + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + EXISTS_TAC `linepath(a:real^M,a)` THEN + REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF; LINEPATH_REFL]) THEN + ASM_REWRITE_TAC[o_DEF; LINEPATH_REFL]);; + +let COVERING_SPACE_LIFT_STRONG = prove + (`!p:real^M->real^N c s f:real^P->real^N u a z. + covering_space (c,p) s /\ a IN c /\ z IN u /\ + simply_connected u /\ locally path_connected u /\ + f continuous_on u /\ IMAGE f u SUBSET s /\ f z = p a + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ g z = a /\ + (!y. y IN u ==> p(g y) = f y)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_LIFT_STRONGER)) THEN + ASM_SIMP_TAC[SIMPLY_CONNECTED_IMP_PATH_CONNECTED] THEN + X_GEN_TAC `r:real^1->real^P` THEN STRIP_TAC THEN + EXISTS_TAC `(f:real^P->real^N) z` THEN + SUBGOAL_THEN + `linepath(f z,f z) = (f:real^P->real^N) o linepath(z,z)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LINEPATH_REFL]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_PATHS_CONTINUOUS_IMAGE THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o GEN_REWRITE_RULE I + [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN + ASM_REWRITE_TAC[PATH_LINEPATH; PATHSTART_LINEPATH; PATHFINISH_LINEPATH] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET]);; + +let COVERING_SPACE_LIFT = prove + (`!p:real^M->real^N c s f:real^P->real^N u. + covering_space (c,p) s /\ + simply_connected u /\ locally path_connected u /\ + f continuous_on u /\ IMAGE f u SUBSET s + ==> ?g. g continuous_on u /\ IMAGE g u SUBSET c /\ + (!y. y IN u ==> p(g y) = f y)`, + MP_TAC COVERING_SPACE_LIFT_STRONG THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th THEN ASM_REWRITE_TAC[]) THEN + ASM_CASES_TAC `u:real^P->bool = {}` THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; EMPTY_SUBSET; + NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^P`) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^P->real^N) a`) THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some additional lemmas about covering spaces. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_COVERING_MAP_FIBRES = prove + (`!p:real^M->real^N c s a b. + covering_space (c,p) s /\ path_connected s /\ a IN s /\ b IN s + ==> {x | x IN c /\ p(x) = a} =_c {x | x IN c /\ p(x) = b}`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; FORALL_AND_THM; + TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o LAND_CONV) + [CONJ_SYM] THEN + MATCH_MP_TAC(MESON[] + `(!a b. P a b) ==> (!a b. P a b) /\ (!a b. P b a)`) THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`] o + GEN_REWRITE_RULE I [path_connected]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^1->real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!z. ?h. z IN c /\ p z = a + ==> path h /\ path_image h SUBSET c /\ pathstart h = z /\ + !t. t IN interval[vec 0,vec 1] + ==> (p:real^M->real^N)(h t) = g t` + MP_TAC THENL + [REWRITE_TAC[RIGHT_EXISTS_IMP_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC COVERING_SPACE_LIFT_PATH_STRONG THEN + REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[]; + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h:real^M->real^1->real^M` THEN DISCH_TAC] THEN + REWRITE_TAC[le_c; IN_ELIM_THM] THEN + EXISTS_TAC `\z. pathfinish((h:real^M->real^1->real^M) z)` THEN + ASM_REWRITE_TAC[pathfinish] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[SUBSET; path_image; pathstart; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[pathfinish; ENDS_IN_UNIT_INTERVAL]; + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`p:real^M->real^N`; `c:real^M->bool`; `s:real^N->bool`; + `reversepath(g:real^1->real^N)`; `reversepath(g:real^1->real^N)`; + `reversepath((h:real^M->real^1->real^M) x)`; + `reversepath((h:real^M->real^1->real^M) y)`] + COVERING_SPACE_MONODROMY) THEN + ASM_SIMP_TAC[PATHSTART_REVERSEPATH; PATHFINISH_REVERSEPATH] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[PATH_REVERSEPATH; PATH_IMAGE_REVERSEPATH; + HOMOTOPIC_PATHS_REFL] THEN + ASM_REWRITE_TAC[pathfinish; reversepath; IN_INTERVAL_1; DROP_VEC] THEN + REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`); + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^M`)] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MATCH_MP_TAC o last o CONJUNCTS) THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC] THEN ASM_REAL_ARITH_TAC]);; + +let COVERING_SPACE_INJECTIVE = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ path_connected c /\ simply_connected s + ==> (!x y. x IN c /\ y IN c /\ p x = p y ==> x = y)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_CONTINUOUS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [path_connected]) THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^M`; `y:real^M`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^M` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_LIFT_PATH_STRONG)) THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `(p:real^M->real^N) o (g:real^1->real^M)` th) THEN + MP_TAC(SPEC `(p:real^M->real^N) o linepath(x:real^M,x)` th)) THEN + SUBGOAL_THEN + `(path ((p:real^M->real^N) o linepath(x,x)) /\ + path (p o g)) /\ + (path_image (p o linepath(x:real^M,x)) SUBSET s /\ + path_image (p o g) SUBSET s)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC PATH_CONTINUOUS_IMAGE THEN + REWRITE_TAC[PATH_LINEPATH; PATH_IMAGE_LINEPATH] THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_SING; SEGMENT_REFL] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[PATH_IMAGE_COMPOSE; PATH_IMAGE_LINEPATH] THEN + REWRITE_TAC[SEGMENT_REFL] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHSTART_LINEPATH] THEN + DISCH_THEN(X_CHOOSE_THEN `h1:real^1->real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `h2:real^1->real^M` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o + SPECL [`(p:real^M->real^N) o linepath(x:real^M,x)`; + `(p:real^M->real^N) o (g:real^1->real^M)`; + `h1:real^1->real^M`; `h2:real^1->real^M`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_MONODROMY)) THEN + ASM_SIMP_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT2 o + GEN_REWRITE_RULE I [SIMPLY_CONNECTED_EQ_HOMOTOPIC_PATHS]) THEN + ASM_REWRITE_TAC[PATHSTART_COMPOSE; PATHFINISH_COMPOSE] THEN + ASM_REWRITE_TAC[PATHSTART_LINEPATH; PATHFINISH_LINEPATH]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `pathfinish(linepath(x:real^M,x))` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[PATHFINISH_LINEPATH]]; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th])] THEN + REWRITE_TAC[pathfinish] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_LIFT_UNIQUE)) + THENL + [EXISTS_TAC `(p:real^M->real^N) o (h1:real^1->real^M)`; + EXISTS_TAC `(p:real^M->real^N) o (h2:real^1->real^M)`] THEN + MAP_EVERY EXISTS_TAC [`interval[vec 0:real^1,vec 1]`; `vec 0:real^1`] THEN + REWRITE_TAC[CONNECTED_INTERVAL; ENDS_IN_UNIT_INTERVAL] THEN + ASM_REWRITE_TAC[GSYM path; PATH_LINEPATH; GSYM path_image] THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_THM]) THEN ASM_REWRITE_TAC[o_THM] THEN + ASM_REWRITE_TAC[PATH_IMAGE_LINEPATH; SEGMENT_REFL; SING_SUBSET] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pathstart]) THEN + ASM_REWRITE_TAC[LINEPATH_REFL; PATH_IMAGE_COMPOSE] THEN + (CONJ_TAC THENL + [ASM_MESON_TAC[PATH_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; + ASM SET_TAC[]]));; + +let COVERING_SPACE_HOMEOMORPHISM = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ path_connected c /\ simply_connected s + ==> ?q. homeomorphism (c,s) (p,q)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; + ASM_MESON_TAC[COVERING_SPACE_IMP_SURJECTIVE]; + ASM_MESON_TAC[COVERING_SPACE_INJECTIVE]; + ASM_MESON_TAC[COVERING_SPACE_OPEN_MAP]]);; + +(* ------------------------------------------------------------------------- *) +(* Results on finiteness of the number of sheets in a covering space. *) +(* ------------------------------------------------------------------------- *) + +let COVERING_SPACE_FIBRE_NO_LIMPT = prove + (`!p:real^M->real^N c s a b. + covering_space (c,p) s /\ a IN c + ==> ~(a limit_point_of {x | x IN c /\ p x = b})`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [covering_space]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(p:real^M->real^N) a`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` MP_TAC) THEN + GEN_REWRITE_TAC I [IMP_CONJ] THEN + REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC) THEN + STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `t:real^M->bool`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `q:real^N->real^M` MP_TAC) THEN + REWRITE_TAC[homeomorphism] THEN STRIP_TAC THEN + UNDISCH_TAC `open_in (subtopology euclidean c) (t:real^M->bool)` THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `v:real^M->bool` o + GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[INFINITE]] THEN + MATCH_MP_TAC(MESON[FINITE_SING; FINITE_SUBSET] + `(?a. s SUBSET {a}) ==> FINITE s`) THEN + ASM SET_TAC[]);; + +let COVERING_SPACE_COUNTABLE_SHEETS = prove + (`!p:real^M->real^N c s b. + covering_space (c,p) s ==> COUNTABLE {x | x IN c /\ p x = b}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[] (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] + UNCOUNTABLE_CONTAINS_LIMIT_POINT)) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);; + +let COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE = prove + (`!p:real^M->real^N c s b. + covering_space (c,p) s + ==> (FINITE {x | x IN c /\ p x = b} <=> + compact {x | x IN c /\ p x = b})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[FINITE_IMP_COMPACT] THEN + DISCH_TAC THEN ASM_CASES_TAC `(b:real^N) IN s` THENL + [ONCE_REWRITE_TAC[TAUT `p <=> (~p ==> F)`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o + SPEC `{x | x IN c /\ (p:real^M->real^N) x = b}` o + GEN_REWRITE_RULE I [COMPACT_EQ_BOLZANO_WEIERSTRASS]) THEN + ASM_REWRITE_TAC[INFINITE; SUBSET_REFL; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^M`; `b:real^N`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] + COVERING_SPACE_FIBRE_NO_LIMPT)) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `{x | x IN c /\ (p:real^M->real^N) x = b} = {}` + (fun th -> REWRITE_TAC[th; FINITE_EMPTY]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + ASM SET_TAC[]]);; + +let COVERING_SPACE_CLOSED_MAP = prove + (`!p:real^M->real^N c s t. + covering_space (c,p) s /\ + (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) /\ + closed_in (subtopology euclidean c) t + ==> closed_in (subtopology euclidean s) (IMAGE p t)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN CONJ_TAC THENL + [ASM SET_TAC[]; ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN]] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `y:real^N` o last o CONJUNCTS o + GEN_REWRITE_RULE I [covering_space]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `v:real^N->bool` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `uu:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `uu:(real^M->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[UNIONS_0; NOT_IN_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `INTERS {IMAGE (p:real^M->real^N) (u DIFF t) | u IN uu}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTERS THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN + SUBGOAL_THEN + `!u. u IN uu ==> ?x. x IN u /\ (p:real^M->real^N) x = y` + ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `FINITE (IMAGE (\u. @x. x IN u /\ (p:real^M->real^N) x = y) uu)` + MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + FINITE_SUBSET)) THEN ASM SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN ASM SET_TAC[]]; + X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC OPEN_IN_TRANS THEN EXISTS_TAC `v:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN EXISTS_TAC `u:real^M->bool` THEN + ASM_SIMP_TAC[LEFT_EXISTS_AND_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^M->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN + EXISTS_TAC `(:real^M) DIFF k` THEN + ASM_REWRITE_TAC[GSYM closed] THEN ASM SET_TAC[]]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC] THEN + X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`)) THEN + ASM_REWRITE_TAC[homeomorphism] THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_IMAGE]] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `w:real^M`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `q /\ r /\ ~s ==> ~(s <=> q /\ r)`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[IN_UNIONS] THEN ASM SET_TAC[]]);; + +let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ (!b. b IN s ==> b limit_point_of s) + ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=> + (!t. closed_in (subtopology euclidean c) t + ==> closed_in (subtopology euclidean s) (IMAGE p t)))`, + let lemma = prove + (`!f:num->real^N. + (!n. ~(s = v n) ==> DISJOINT s (v n)) + ==> (!n. f n IN v n) /\ + (!m n. v m = v n <=> m = n) + ==> ?n. IMAGE f (:num) INTER s SUBSET {f n}`, + ASM_CASES_TAC `?n. s = (v:num->real^N->bool) n` THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(fun th -> + MP_TAC th THEN MATCH_MP_TAC MONO_EXISTS); + RULE_ASSUM_TAC(REWRITE_RULE[NOT_EXISTS_THM]) THEN + ASM_REWRITE_TAC[]] THEN + ASM SET_TAC[]) in + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC COVERING_SPACE_CLOSED_MAP THEN + EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[MESON[INFINITE] `FINITE s <=> ~INFINITE s`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `b:real^N` o last o CONJUNCTS o + GEN_REWRITE_RULE I [covering_space]) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `t:real^N->bool` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `vv:(real^M->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(b:real^N) limit_point_of t` MP_TAC THENL + [MATCH_MP_TAC LIMPT_OF_OPEN_IN THEN ASM_MESON_TAC[]; + PURE_REWRITE_TAC[LIMPT_SEQUENTIAL_INJ]] THEN + DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `INFINITE(vv:(real^M->bool)->bool)` MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CARD_LE_INFINITE)) THEN REWRITE_TAC[le_c] THEN + SUBGOAL_THEN + `!x. ?v. x IN c /\ (p:real^M->real^N) x = b ==> v IN vv /\ x IN v` + MP_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^M->bool` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN CONJ_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism]) THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[INFINITE_CARD_LE; le_c; INJECTIVE_ON_ALT] THEN + REWRITE_TAC[IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->real^M->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_THEN + `!u. u IN vv ==> ?q:real^N->real^M. homeomorphism (u,t) (p,q)` + (MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN + ASM_REWRITE_TAC[SKOLEM_THM; homeomorphism; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->real^N->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean s) + (IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)))` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[CLOSED_IN_LIMPT; SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `a:real^M`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(p:real^M->real^N) a = b` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC + `(p:real^M->real^N) o (\n:num. q n (y n :real^N)) o (r:num->num)` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MATCH_MP_TAC(GEN_ALL(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + (fst(EQ_IMP_RULE(SPEC_ALL CONTINUOUS_ON_SEQUENTIALLY))))) THEN + EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[COVERING_SPACE_IMP_CONTINUOUS]; + REWRITE_TAC[o_DEF] THEN ASM SET_TAC[]]; + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC LIM_SUBSEQUENCE THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] LIM_TRANSFORM_EVENTUALLY)) THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[o_DEF] THEN + ASM SET_TAC[]]; + SUBGOAL_THEN `?u. u IN vv /\ (a:real^M) IN u` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?w:real^M->bool. open w /\ u = c INTER w` + (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) + THENL [ASM_MESON_TAC[OPEN_IN_OPEN]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTER]) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN + DISCH_THEN(MP_TAC o SPEC `w:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP (MESON[] + `INFINITE s ==> !k. s INTER k = s ==> INFINITE(s INTER k)`)) THEN + DISCH_THEN(MP_TAC o SPEC `c:real^M->bool`) THEN ANTS_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[INTER_ASSOC]] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [pairwise]) THEN + DISCH_THEN(MP_TAC o SPEC `c INTER w:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(v:num->real^M->bool) n`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `\n. (q:num->real^N->real^M) n (y n)` o + MATCH_MP lemma) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MESON_TAC[FINITE_SUBSET; FINITE_SING; INTER_COMM]]; + SUBGOAL_THEN + `IMAGE (p:real^M->real^N) (IMAGE (\n. q n (y n:real^N)) (:num)) = + IMAGE y (:num)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CLOSED_IN_LIMPT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `b:real^N`)) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN + EXISTS_TAC `y:num->real^N` THEN ASM SET_TAC[]]);; + +let COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s /\ connected s /\ ~(?a. s = {a}) + ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=> + (!t. closed_in (subtopology euclidean c) t + ==> closed_in (subtopology euclidean s) (IMAGE p t)))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [SUBGOAL_THEN `c:real^M->bool = {}` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY]; + ASM_REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_EMPTY; CLOSED_IN_SUBTOPOLOGY_EMPTY; + IMAGE_EQ_EMPTY; NOT_IN_EMPTY]]; + MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS_EQ_CLOSED_MAP_STRONG THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_IMP_PERFECT THEN ASM SET_TAC[]]);; + +let COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> ((!b. b IN s ==> FINITE {x | x IN c /\ p x = b}) <=> + (!k. k SUBSET s /\ compact k + ==> compact {x | x IN c /\ p(x) IN k}))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP PROPER_MAP th]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC + [GSYM(MATCH_MP COVERING_SPACE_FINITE_EQ_COMPACT_FIBRE th)]) THEN + REWRITE_TAC[TAUT `(p <=> q /\ p) <=> (p ==> q)`] THEN + ASM_MESON_TAC[COVERING_SPACE_CLOSED_MAP]);; + +(* ------------------------------------------------------------------------- *) +(* Special cases where one or both of the sets is compact. *) +(* ------------------------------------------------------------------------- *) + +let COVERING_SPACE_FINITE_SHEETS = prove + (`!p:real^M->real^N c s b. + covering_space (c,p) s /\ compact c ==> FINITE {x | x IN c /\ p x = b}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOLZANO_WEIERSTRASS_CONTRAPOS THEN + EXISTS_TAC `c:real^M->bool` THEN ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN + ASM_MESON_TAC[COVERING_SPACE_FIBRE_NO_LIMPT]);; + +let COVERING_SPACE_COMPACT = prove + (`!p:real^M->real^N c s. + covering_space (c,p) s + ==> (compact c <=> + compact s /\ (!b. b IN s ==> FINITE {x | x IN c /\ p x = b}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[covering_space; COMPACT_CONTINUOUS_IMAGE]; + MATCH_MP_TAC COVERING_SPACE_FINITE_SHEETS THEN ASM_MESON_TAC[]; + FIRST_ASSUM(MP_TAC o + MATCH_MP COVERING_SPACE_FINITE_SHEETS_EQ_PROPER_MAP) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COVERING_SPACE_IMP_SURJECTIVE) THEN + SET_TAC[]]);; diff --git a/Multivariate/polytope.ml b/Multivariate/polytope.ml new file mode 100644 index 0000000..6473a85 --- /dev/null +++ b/Multivariate/polytope.ml @@ -0,0 +1,5855 @@ +(* ========================================================================= *) +(* Faces, extreme points, polytopes, polyhedra etc. *) +(* ========================================================================= *) + +needs "Multivariate/paths.ml";; + +(* ------------------------------------------------------------------------- *) +(* Faces of a (usually convex) set. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("face_of",(12,"right"));; + +let face_of = new_definition + `t face_of s <=> + t SUBSET s /\ convex t /\ + !a b x. a IN s /\ b IN s /\ x IN t /\ x IN segment(a,b) + ==> a IN t /\ b IN t`;; + +let FACE_OF_TRANSLATION_EQ = prove + (`!a f s:real^N->bool. + (IMAGE (\x. a + x) f) face_of (IMAGE (\x. a + x) s) <=> f face_of s`, + REWRITE_TAC[face_of] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [FACE_OF_TRANSLATION_EQ];; + +let FACE_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N c s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((IMAGE f c) face_of (IMAGE f s) <=> c face_of s)`, + REWRITE_TAC[face_of; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN MP_TAC(end_itlist CONJ + (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +add_linear_invariants [FACE_OF_LINEAR_IMAGE];; + +let FACE_OF_REFL = prove + (`!s. convex s ==> s face_of s`, + SIMP_TAC[face_of] THEN SET_TAC[]);; + +let FACE_OF_REFL_EQ = prove + (`!s. s face_of s <=> convex s`, + SIMP_TAC[face_of] THEN SET_TAC[]);; + +let EMPTY_FACE_OF = prove + (`!s. {} face_of s`, + REWRITE_TAC[face_of; CONVEX_EMPTY] THEN SET_TAC[]);; + +let FACE_OF_EMPTY = prove + (`!s. s face_of {} <=> s = {}`, + REWRITE_TAC[face_of; SUBSET_EMPTY; NOT_IN_EMPTY] THEN + MESON_TAC[CONVEX_EMPTY]);; + +let FACE_OF_TRANS = prove + (`!s t u. s face_of t /\ t face_of u + ==> s face_of u`, + REWRITE_TAC[face_of] THEN SET_TAC[]);; + +let FACE_OF_FACE = prove + (`!f s t. + t face_of s + ==> (f face_of t <=> f face_of s /\ f SUBSET t)`, + REWRITE_TAC[face_of] THEN SET_TAC[]);; + +let FACE_OF_SUBSET = prove + (`!f s t. f face_of s /\ f SUBSET t /\ t SUBSET s ==> f face_of t`, + REWRITE_TAC[face_of] THEN SET_TAC[]);; + +let FACE_OF_SLICE = prove + (`!f s t. + f face_of s /\ convex t + ==> (f INTER t) face_of (s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[face_of; IN_INTER] THEN STRIP_TAC THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM_MESON_TAC[CONVEX_INTER]; + ASM_MESON_TAC[]]);; + +let FACE_OF_INTER = prove + (`!s t1 t2. t1 face_of s /\ t2 face_of s + ==> (t1 INTER t2) face_of s`, + SIMP_TAC[face_of; CONVEX_INTER] THEN SET_TAC[]);; + +let FACE_OF_INTERS = prove + (`!P s. ~(P = {}) /\ (!t. t IN P ==> t face_of s) + ==> (INTERS P) face_of s`, + REWRITE_TAC[face_of] THEN REPEAT STRIP_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[CONVEX_INTERS]; ASM SET_TAC[]; ASM SET_TAC[]]);; + +let FACE_OF_INTER_INTER = prove + (`!f t f' t'. + f face_of t /\ f' face_of t' ==> (f INTER f') face_of (t INTER t')`, + REWRITE_TAC[face_of; SUBSET; IN_INTER] THEN MESON_TAC[CONVEX_INTER]);; + +let FACE_OF_STILLCONVEX = prove + (`!s t:real^N->bool. + convex s + ==> (t face_of s <=> + t SUBSET s /\ + convex(s DIFF t) /\ + t = (affine hull t) INTER s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[face_of] THEN + ASM_CASES_TAC `(t:real^N->bool) SUBSET s` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN STRIP_TAC THENL + [CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; open_segment; IN_DIFF] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; SUBSET_DIFF] THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [ASM MESON_TAC[HULL_INC; SUBSET; IN_INTER]; ALL_TAC] THEN + ASM_CASES_TAC `t:real^N -> bool = {}` THEN + ASM_REWRITE_TAC[IN_INTER; AFFINE_HULL_EMPTY; NOT_IN_EMPTY] THEN + MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SEGMENT_SYM] THEN + ASM_SIMP_TAC[LEFT_FORALL_IMP_THM; OPEN_SEGMENT_ALT] THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_SIMP_TAC[] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN + EXISTS_TAC `min (&1 / &2) (e / norm(x - y:real^N))` THEN + REWRITE_TAC[REAL_LT_MIN; REAL_MIN_LT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INTER; IN_CBALL; dist] THEN + CONJ_TAC THENL + [REWRITE_TAC[NORM_MUL; VECTOR_ARITH + `y - ((&1 - u) % y + u % x):real^N = u % (y - x)`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + REWRITE_TAC[NORM_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e ==> abs(min (&1 / &2) e) <= e`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + ASM_SIMP_TAC[HULL_INC]]; + CONJ_TAC THENL + [ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONVEX_INTER THEN + ASM_SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + SUBGOAL_THEN + `!a b x:real^N. a IN s /\ b IN s /\ x IN t /\ x IN segment(a,b) /\ + (a IN affine hull t ==> b IN affine hull t) + ==> a IN t /\ b IN t` + (fun th -> MESON_TAC[th; SEGMENT_SYM]) THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN affine hull t` THEN + ASM_REWRITE_TAC[] THENL [ASM SET_TAC[]; STRIP_TAC] THEN + ASM_CASES_TAC `a:real^N = b` THENL + [ASM_MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `(a:real^N) IN (s DIFF t) /\ b IN (s DIFF t)` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[IN_DIFF] THEN ONCE_ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[IN_INTER] THEN + UNDISCH_TAC `~((a:real^N) IN affine hull t)` THEN + UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN + ASM_SIMP_TAC[OPEN_SEGMENT_ALT; CONTRAPOS_THM; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv(&1 - u)) :real^N->real^N`) THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `x < &1 ==> ~(&1 - x = &0)`] THEN + REWRITE_TAC[VECTOR_ARITH + `x:real^N = &1 % a + u % b <=> a = x + --u % b`] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[affine] AFFINE_AFFINE_HULL) THEN + ASM_SIMP_TAC[HULL_INC] THEN + UNDISCH_TAC `u < &1` THEN CONV_TAC REAL_FIELD; + MP_TAC(ISPEC `s DIFF t:real^N->bool` CONVEX_CONTAINS_SEGMENT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[SUBSET; IN_DIFF] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_MESON_TAC[segment; IN_DIFF]]]);; + +let FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG = prove + (`!s a:real^N b. + convex(s INTER {x | a dot x = b}) /\ (!x. x IN s ==> a dot x <= b) + ==> (s INTER {x | a dot x = b}) face_of s`, + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `c:real^N`; `d:real`] THEN + SIMP_TAC[face_of; INTER_SUBSET] THEN + STRIP_TAC THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `a <= x /\ b <= x /\ ~(a < x) /\ ~(b < x) ==> a = x /\ b = x`) THEN + ASM_SIMP_TAC[] THEN UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + CONJ_TAC THEN DISCH_TAC THEN UNDISCH_TAC `(c:real^N) dot x = d` THEN + MATCH_MP_TAC(REAL_ARITH `x < a ==> x = a ==> F`) THEN + SUBST1_TAC(REAL_ARITH `d = (&1 - u) * d + u * d`) THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THENL + [MATCH_MP_TAC REAL_LTE_ADD2; MATCH_MP_TAC REAL_LET_ADD2] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ; REAL_SUB_LT]);; + +let FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG = prove + (`!s a:real^N b. + convex(s INTER {x | a dot x = b}) /\ (!x. x IN s ==> a dot x >= b) + ==> (s INTER {x | a dot x = b}) face_of s`, + REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`] + FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG) THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);; + +let FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove + (`!s a:real^N b. + convex s /\ (!x. x IN s ==> a dot x <= b) + ==> (s INTER {x | a dot x = b}) face_of s`, + SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG; + CONVEX_INTER; CONVEX_HYPERPLANE]);; + +let FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove + (`!s a:real^N b. + convex s /\ (!x. x IN s ==> a dot x >= b) + ==> (s INTER {x | a dot x = b}) face_of s`, + SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG; + CONVEX_INTER; CONVEX_HYPERPLANE]);; + +let FACE_OF_IMP_SUBSET = prove + (`!s t. t face_of s ==> t SUBSET s`, + SIMP_TAC[face_of]);; + +let FACE_OF_IMP_CONVEX = prove + (`!s t. t face_of s ==> convex t`, + SIMP_TAC[face_of]);; + +let FACE_OF_IMP_CLOSED = prove + (`!s t. convex s /\ closed s /\ t face_of s ==> closed t`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[FACE_OF_STILLCONVEX] THEN + STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[CLOSED_AFFINE; AFFINE_AFFINE_HULL; CLOSED_INTER]);; + +let FACE_OF_IMP_COMPACT = prove + (`!s t. convex s /\ compact s /\ t face_of s ==> compact t`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_MESON_TAC[BOUNDED_SUBSET; FACE_OF_IMP_SUBSET; FACE_OF_IMP_CLOSED]);; + +let FACE_OF_INTER_SUBFACE = prove + (`!c1 c2 d1 d2:real^N->bool. + (c1 INTER c2) face_of c1 /\ (c1 INTER c2) face_of c2 /\ + d1 face_of c1 /\ d2 face_of c2 + ==> (d1 INTER d2) face_of d1 /\ (d1 INTER d2) face_of d2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THENL + [EXISTS_TAC `c1:real^N->bool`; EXISTS_TAC `c2:real^N->bool`] THEN + ASM_SIMP_TAC[FACE_OF_IMP_SUBSET; INTER_SUBSET] THEN + TRANS_TAC FACE_OF_TRANS `c1 INTER c2:real^N->bool` THEN + ASM_SIMP_TAC[FACE_OF_INTER_INTER]);; + +let SUBSET_OF_FACE_OF = prove + (`!s t u:real^N->bool. + t face_of s /\ u SUBSET s /\ + ~(DISJOINT t (relative_interior u)) + ==> u SUBSET t`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN + REWRITE_TAC[IN_RELATIVE_INTERIOR_CBALL] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_INTER] THEN + ASM_CASES_TAC `c:real^N = b` THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `d:real^N = b + e / norm(b - c) % (b - c)` THEN + DISCH_THEN(MP_TAC o SPEC `d:real^N`) THEN ANTS_TAC THENL + [EXPAND_TAC "d" THEN CONJ_TAC THENL + [REWRITE_TAC[NORM_ARITH `dist(b:real^N,b + e) = norm e`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[VECTOR_ARITH + `b + u % (b - c):real^N = (&1 - --u) % b + --u % c`] THEN + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + ASM_SIMP_TAC[HULL_INC]]; + STRIP_TAC THEN + SUBGOAL_THEN `(d:real^N) IN t /\ c IN t` (fun th -> MESON_TAC[th]) THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `b:real^N` THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + SUBGOAL_THEN `~(b:real^N = d)` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN + REWRITE_TAC[VECTOR_ARITH `b:real^N = b + e <=> e = vec 0`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; + VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ]; + ASM_REWRITE_TAC[segment; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `(e / norm(b - c:real^N)) / (&1 + e / norm(b - c))` THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ; + REAL_ARITH `&0 < x ==> &0 < &1 + x`; + REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < n ==> (&1 + e / n) * n = n + e`; + NORM_POS_LT; VECTOR_SUB_EQ; REAL_LE_ADDL] THEN + ASM_SIMP_TAC[NORM_POS_LT; REAL_LT_IMP_LE; VECTOR_SUB_EQ] THEN + EXPAND_TAC "d" THEN REWRITE_TAC[VECTOR_ARITH + `b:real^N = (&1 - u) % (b + e % (b - c)) + u % c <=> + (u - e * (&1 - u)) % (b - c) = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < e ==> e / (&1 + e) - e * (&1 - e / (&1 + e)) = &0`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]]);; + +let FACE_OF_EQ = prove + (`!s t u:real^N->bool. + t face_of s /\ u face_of s /\ + ~(DISJOINT (relative_interior t) (relative_interior u)) + ==> t = u`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_OF_FACE_OF THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THENL + [MP_TAC(ISPEC `u:real^N->bool` RELATIVE_INTERIOR_SUBSET); + MP_TAC(ISPEC `t:real^N->bool` RELATIVE_INTERIOR_SUBSET)] THEN + ASM SET_TAC[]);; + +let FACE_OF_DISJOINT_RELATIVE_INTERIOR = prove + (`!f s:real^N->bool. + f face_of s /\ ~(f = s) ==> f INTER relative_interior s = {}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`; `s:real^N->bool`] + SUBSET_OF_FACE_OF) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + ASM SET_TAC[]);; + +let FACE_OF_DISJOINT_INTERIOR = prove + (`!f s:real^N->bool. + f face_of s /\ ~(f = s) ==> f INTER interior s = {}`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET_RELATIVE_INTERIOR) THEN + SET_TAC[]);; + +let AFFINE_HULL_FACE_OF_DISJOINT_RELATIVE_INTERIOR = prove + (`!s f:real^N->bool. + convex s /\ f face_of s /\ ~(f = s) + ==> affine hull f INTER relative_interior s = {}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `!s f. a INTER s = f /\ r SUBSET s /\ f INTER r = {} + ==> a INTER r = {}`) THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `f:real^N->bool`] THEN + ASM_SIMP_TAC[FACE_OF_DISJOINT_RELATIVE_INTERIOR; + RELATIVE_INTERIOR_SUBSET] THEN + UNDISCH_TAC `(f:real^N->bool) face_of s` THEN + ASM_SIMP_TAC[FACE_OF_STILLCONVEX] THEN MESON_TAC[]);; + +let FACE_OF_SUBSET_RELATIVE_BOUNDARY = prove + (`!s f:real^N->bool. + f face_of s /\ ~(f = s) ==> f SUBSET (s DIFF relative_interior s)`, + ASM_SIMP_TAC[SET_RULE `s SUBSET u DIFF t <=> s SUBSET u /\ s INTER t = {}`; + FACE_OF_DISJOINT_RELATIVE_INTERIOR; FACE_OF_IMP_SUBSET]);; + +let FACE_OF_SUBSET_RELATIVE_FRONTIER = prove + (`!s f:real^N->bool. + f face_of s /\ ~(f = s) ==> f SUBSET relative_frontier s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_SUBSET_RELATIVE_BOUNDARY) THEN + REWRITE_TAC[relative_frontier] THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; + +let FACE_OF_AFF_DIM_LT = prove + (`!f s:real^N->bool. + convex s /\ f face_of s /\ ~(f = s) ==> aff_dim f < aff_dim s`, + REPEAT GEN_TAC THEN + SIMP_TAC[INT_LT_LE; FACE_OF_IMP_SUBSET; AFF_DIM_SUBSET] THEN + REWRITE_TAC[IMP_CONJ; CONTRAPOS_THM] THEN + ASM_CASES_TAC `f:real^N->bool = {}` THENL + [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[AFF_DIM_EQ_MINUS1; AFF_DIM_EMPTY]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN + MATCH_MP_TAC(SET_RULE `~(f = {}) /\ f SUBSET s ==> ~DISJOINT f s`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN + MATCH_MP_TAC SUBSET_RELATIVE_INTERIOR THEN + ASM_MESON_TAC[FACE_OF_IMP_SUBSET; AFF_DIM_EQ_AFFINE_HULL; INT_LE_REFL]]);; + +let FACE_OF_CONVEX_HULLS = prove + (`!f s:real^N->bool. + FINITE s /\ f SUBSET s /\ + DISJOINT (affine hull f) (convex hull (s DIFF f)) + ==> (convex hull f) face_of (convex hull s)`, + let lemma = prove + (`!s x y:real^N. + affine s /\ ~(k = &0) /\ ~(k = &1) /\ x IN s /\ inv(&1 - k) % y IN s + ==> inv(k) % (x - y) IN s`, + REWRITE_TAC[AFFINE_ALT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `inv(k) % (x - y):real^N = (&1 - inv k) % inv(&1 - k) % y + inv(k) % x` + (fun th -> ASM_SIMP_TAC[th]) THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_ARITH + `k % (x - y):real^N = a % b % y + k % x <=> (a * b + k) % y = vec 0`] THEN + DISJ1_TAC THEN MAP_EVERY UNDISCH_TAC [`~(k = &0)`; `~(k = &1)`] THEN + CONV_TAC REAL_FIELD) in + REPEAT STRIP_TAC THEN REWRITE_TAC[face_of] THEN + SUBGOAL_THEN `FINITE(f:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_SIMP_TAC[HULL_MONO; CONVEX_CONVEX_HULL] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `w:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `(w:real^N) IN affine hull f` ASSUME_TAC THENL + [ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; ALL_TAC] THEN + MAP_EVERY UNDISCH_TAC + [`(y:real^N) IN convex hull s`; `(x:real^N) IN convex hull s`] THEN + REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N->real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `(c:real^N->real) = \x. (&1 - u) * a x + u * b x` THEN + SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= c x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "c" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `sum (s DIFF f:real^N->bool) c = &0` THENL + [SUBGOAL_THEN `!x:real^N. x IN (s DIFF f) ==> c x = &0` MP_TAC THENL + [MATCH_MP_TAC SUM_POS_EQ_0 THEN ASM_MESON_TAC[FINITE_DIFF; IN_DIFF]; + ALL_TAC] THEN + EXPAND_TAC "c" THEN + ASM_SIMP_TAC[IN_DIFF; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LT; + REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`; + REAL_ENTIRE; REAL_SUB_0; REAL_LT_IMP_NE] THEN + STRIP_TAC THEN CONJ_TAC THENL + [EXISTS_TAC `a:real^N->real`; EXISTS_TAC `b:real^N->real`] THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THEN FIRST_X_ASSUM(fun th g -> + (GEN_REWRITE_TAC RAND_CONV [GSYM th] THEN CONV_TAC SYM_CONV THEN + (MATCH_MP_TAC SUM_SUPERSET ORELSE MATCH_MP_TAC VSUM_SUPERSET)) g) THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO]; + ALL_TAC] THEN + ABBREV_TAC `k = sum (s DIFF f:real^N->bool) c` THEN + SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE] THEN EXPAND_TAC "k" THEN + MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_DIFF; IN_DIFF]; + ALL_TAC] THEN + ASM_CASES_TAC `k = &1` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DISJOINT]) THEN + MATCH_MP_TAC(TAUT `b ==> ~b ==> c`) THEN + EXISTS_TAC `w:real^N` THEN + ASM_REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN + EXISTS_TAC `c:real^N->real` THEN + ASM_SIMP_TAC[IN_DIFF; SUM_DIFF; VSUM_DIFF] THEN + SUBGOAL_THEN `vsum f (\x:real^N. c x % x) = vec 0` SUBST1_TAC THENL + [ALL_TAC; + EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[VSUM_ADD; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL] THEN + REWRITE_TAC[VECTOR_SUB_RZERO]] THEN + SUBGOAL_THEN `sum(s DIFF f) c = sum s c - sum f (c:real^N->real)` + MP_TAC THENL [ASM_MESON_TAC[SUM_DIFF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `sum s (c:real^N->real) = &1` SUBST1_TAC THENL + [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[SUM_ADD; GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&1 = &1 - x <=> x = &0`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`c:real^N->real`;`f:real^N->bool`] SUM_POS_EQ_0) THEN + ANTS_TAC THENL [ASM_MESON_TAC[FINITE_SUBSET; SUBSET]; ALL_TAC] THEN + SIMP_TAC[VECTOR_MUL_LZERO; VSUM_0]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_DISJOINT]) THEN + MATCH_MP_TAC(TAUT `b ==> ~b ==> c`) THEN + EXISTS_TAC `inv(k) % (w - vsum f (\x:real^N. c x % x))` THEN CONJ_TAC THENL + [ALL_TAC; + SUBGOAL_THEN `w = vsum f (\x:real^N. c x % x) + + vsum (s DIFF f) (\x:real^N. c x % x)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VSUM_DIFF; VECTOR_ARITH `a + b - a:real^N = b`] THEN + EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[VSUM_ADD; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL]; + REWRITE_TAC[VECTOR_ADD_SUB]] THEN + ASM_SIMP_TAC[GSYM VSUM_LMUL; FINITE_DIFF] THEN + REWRITE_TAC[CONVEX_HULL_FINITE; IN_ELIM_THM] THEN + EXISTS_TAC `\x. inv k * (c:real^N->real) x` THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[IN_DIFF; REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[SUM_LMUL; ETA_AX; REAL_MUL_LINV]] THEN + MATCH_MP_TAC lemma THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[AFFINE_AFFINE_HULL]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM VSUM_LMUL; AFFINE_HULL_FINITE; IN_ELIM_THM] THEN + EXISTS_TAC `(\x. inv(&1 - k) * c x):real^N->real` THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; SUM_LMUL] THEN + MATCH_MP_TAC(REAL_FIELD + `~(k = &1) /\ f = &1 - k ==> inv(&1 - k) * f = &1`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `sum(s DIFF f) c = sum s c - sum f (c:real^N->real)` + MP_TAC THENL [ASM_MESON_TAC[SUM_DIFF]; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `sum s (c:real^N->real) = &1` SUBST1_TAC THENL + [EXPAND_TAC "c" THEN REWRITE_TAC[VECTOR_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[SUM_ADD; GSYM REAL_MUL_ASSOC; SUM_LMUL]; + ALL_TAC] THEN + REAL_ARITH_TAC);; + +let FACE_OF_CONVEX_HULL_INSERT = prove + (`!f s a:real^N. + FINITE s /\ ~(a IN affine hull s) /\ f face_of (convex hull s) + ==> f face_of (convex hull (a INSERT s))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_TRANS THEN + EXISTS_TAC `convex hull s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN + ASM_REWRITE_TAC[FINITE_INSERT; SET_RULE `s SUBSET a INSERT s`] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `~(a IN s) ==> t SUBSET {a} ==> DISJOINT s t`)) THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_SING] THEN SET_TAC[]);; + +let FACE_OF_AFFINE_TRIVIAL = prove + (`!s f:real^N->bool. + affine s /\ f face_of s ==> f = {} \/ f = s`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `f:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `(b:real^N) IN f` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [face_of]) THEN + DISCH_THEN(MP_TAC o SPECL [`&2 % a - b:real^N`; `b:real^N`; `a:real^N`] o + CONJUNCT2 o CONJUNCT2) THEN + SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[IN_SEGMENT; VECTOR_ARITH `&2 % a - b:real^N = b <=> a = b`] THEN + CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `&2 % a - b:real^N = a + &1 % (a - b)`] THEN + MATCH_MP_TAC IN_AFFINE_ADD_MUL_DIFF THEN ASM SET_TAC[]; + EXISTS_TAC `&1 / &2` THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + VECTOR_ARITH_TAC]);; + +let FACE_OF_AFFINE_EQ = prove + (`!s:real^N->bool f. affine s ==> (f face_of s <=> f = {} \/ f = s)`, + MESON_TAC[FACE_OF_AFFINE_TRIVIAL; EMPTY_FACE_OF; FACE_OF_REFL; + AFFINE_IMP_CONVEX]);; + +let INTERS_FACES_FINITE_BOUND = prove + (`!s f:(real^N->bool)->bool. + convex s /\ (!c. c IN f ==> c face_of s) + ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 /\ + INTERS f' = INTERS f`, + SUBGOAL_THEN + `!s f:(real^N->bool)->bool. + convex s /\ (!c. c IN f ==> c face_of s /\ ~(c = s)) + ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 /\ + INTERS f' = INTERS f` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(s:real^N->bool) IN f` THENL + [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]] THEN + FIRST_ASSUM(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC o MATCH_MP (SET_RULE + `s IN f ==> f = {s} \/ ?t. ~(t = s) /\ t IN f`)) THENL + [EXISTS_TAC `{s:real^N->bool}` THEN + SIMP_TAC[FINITE_INSERT; FINITE_EMPTY; SUBSET_REFL; CARD_CLAUSES] THEN + ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC)] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `f DELETE + (s:real^N->bool)`]) THEN + ASM_SIMP_TAC[IN_DELETE; SUBSET_DELETE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `f = (s:real^N->bool) INSERT (f DELETE s)` MP_TAC THENL + [ASM SET_TAC[]; + DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 RAND_CONV) [th])] THEN + REWRITE_TAC[INTERS_INSERT] THEN + MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s INTER t`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_INTERS; IN_DELETE] THEN + ASM SET_TAC[]] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC + `!f':(real^N->bool)->bool. + FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 1 + ==> ?c. c IN f /\ c INTER (INTERS f') PSUBSET (INTERS f')` + THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[PSUBSET; INTER_SUBSET] THEN ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [RIGHT_IMP_EXISTS_THM]) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:((real^N->bool)->bool)->real^N->bool` THEN DISCH_TAC THEN + CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION + `d 0 = {c {} :real^N->bool} /\ !n. d(SUC n) = c(d n) INSERT d n`) THEN + SUBGOAL_THEN `!n:num. ~(d n:(real^N->bool)->bool = {})` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + 1 + ==> (d n) SUBSET (f:(real^N->bool)->bool) /\ + FINITE(d n) /\ CARD(d n) <= n + 1` + ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; + EMPTY_SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`] THEN + REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + ==> (INTERS(d(SUC n)):real^N->bool) PSUBSET INTERS(d n)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERS_INSERT] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN + ASM_SIMP_TAC[ARITH_RULE `n <= N ==> n <= N + 1`] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN(K ALL_TAC)) THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + 1 + ==> aff_dim(INTERS(d n):real^N->bool) < &(dimindex(:N)) - &n` + MP_TAC THENL + [INDUCT_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[INT_SUB_RZERO] THEN + MATCH_MP_TAC INT_LTE_TRANS THEN + EXISTS_TAC `aff_dim(s:real^N->bool)` THEN + REWRITE_TAC[AFF_DIM_LE_UNIV] THEN + MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] o + SPEC `0`) THEN + DISCH_THEN(X_CHOOSE_TAC `e:real^N->bool`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!t. t PSUBSET s /\ u SUBSET t ==> ~(u = s)`) THEN + EXISTS_TAC `e:real^N->bool` THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + ASM SET_TAC[]]; + DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN + MATCH_MP_TAC(INT_ARITH + `!d':int. d < d' /\ d' < m - n ==> d < m - (n + &1)`) THEN + EXISTS_TAC `aff_dim(INTERS(d(n:num)):real^N->bool)` THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= k + 1 ==> n <= k + 1`] THEN + MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= m + 1 ==> n <= m`; + SET_RULE `s PSUBSET t ==> ~(s = t)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_INTERS THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_IMP_CONVEX THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`]; + ALL_TAC] THEN + MP_TAC(ISPECL [`INTERS(d(SUC n)):real^N->bool`;`s:real^N->bool`; + `INTERS(d(n:num)):real^N->bool`] FACE_OF_FACE) THEN + ASM_SIMP_TAC[SET_RULE `s PSUBSET t ==> s SUBSET t`; + ARITH_RULE `SUC n <= m + 1 ==> n <= m`] THEN + MATCH_MP_TAC(TAUT `a /\ b ==> (a ==> (c <=> b)) ==> c`) THEN + CONJ_TAC THEN MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 1 ==> n <= m + 1`]]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 1`) THEN REWRITE_TAC[LE_REFL] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[INT_NOT_LT] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH `d - (d + &1):int = -- &1`] THEN + REWRITE_TAC[AFF_DIM_GE]);; + +let INTERS_FACES_FINITE_ALTBOUND = prove + (`!s f:(real^N->bool)->bool. + (!c. c IN f ==> c face_of s) + ==> ?f'. FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 2 /\ + INTERS f' = INTERS f`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC + `!f':(real^N->bool)->bool. + FINITE f' /\ f' SUBSET f /\ CARD f' <= dimindex(:N) + 2 + ==> ?c. c IN f /\ c INTER (INTERS f') PSUBSET (INTERS f')` + THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + SIMP_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[PSUBSET; INTER_SUBSET] THEN ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [RIGHT_IMP_EXISTS_THM]) THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:((real^N->bool)->bool)->real^N->bool` THEN DISCH_TAC THEN + CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION + `d 0 = {c {} :real^N->bool} /\ !n. d(SUC n) = c(d n) INSERT d n`) THEN + SUBGOAL_THEN `!n:num. ~(d n:(real^N->bool)->bool = {})` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + 2 + ==> (d n) SUBSET (f:(real^N->bool)->bool) /\ + FINITE(d n) /\ CARD(d n) <= n + 1` + ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; + EMPTY_SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`] THEN + REPEAT STRIP_TAC THEN TRY ASM_ARITH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; STRIP_TAC] THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + 1 + ==> (INTERS(d(SUC n)):real^N->bool) PSUBSET INTERS(d n)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERS_INSERT] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(d:num->(real^N->bool)->bool) n`) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN + ASM_SIMP_TAC[ARITH_RULE `n <= N + 1 ==> n <= N + 2`] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN(K ALL_TAC)) THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + 2 + ==> aff_dim(INTERS(d n):real^N->bool) <= &(dimindex(:N)) - &n` + MP_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[INT_SUB_RZERO; AFF_DIM_LE_UNIV] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN + MATCH_MP_TAC(INT_ARITH + `!d':int. d < d' /\ d' <= m - n ==> d <= m - (n + &1)`) THEN + EXISTS_TAC `aff_dim(INTERS(d(n:num)):real^N->bool)` THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= k + 2 ==> n <= k + 2`] THEN + MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN + ASM_SIMP_TAC[ARITH_RULE `SUC n <= m + 2 ==> n <= m + 1`; + SET_RULE `s PSUBSET t ==> ~(s = t)`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_INTERS THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC FACE_OF_IMP_CONVEX THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`]; + ALL_TAC] THEN + MP_TAC(ISPECL [`INTERS(d(SUC n)):real^N->bool`;`s:real^N->bool`; + `INTERS(d(n:num)):real^N->bool`] FACE_OF_FACE) THEN + ASM_SIMP_TAC[SET_RULE `s PSUBSET t ==> s SUBSET t`; + ARITH_RULE `SUC n <= m + 2 ==> n <= m + 1`] THEN + MATCH_MP_TAC(TAUT `a /\ b ==> (a ==> (c <=> b)) ==> c`) THEN + CONJ_TAC THEN MATCH_MP_TAC FACE_OF_INTERS THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SUBSET; ARITH_RULE `SUC n <= m + 2 ==> n <= m + 2`]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `dimindex(:N) + 2`) THEN REWRITE_TAC[LE_REFL] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN REWRITE_TAC[INT_NOT_LE] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_ARITH + `d - (d + &2):int < i <=> -- &1 <= i`] THEN + REWRITE_TAC[AFF_DIM_GE]);; + +let FACES_OF_TRANSLATION = prove + (`!s a:real^N. + {f | f face_of IMAGE (\x. a + x) s} = + IMAGE (IMAGE (\x. a + x)) {f | f face_of s}`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; FACE_OF_TRANSLATION_EQ] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + ONCE_REWRITE_TAC[TRANSLATION_GALOIS] THEN + REWRITE_TAC[EXISTS_REFL]);; + +let FACES_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> {t | t face_of (IMAGE f s)} = IMAGE (IMAGE f) {t | t face_of s}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[face_of; SUBSET_IMAGE; SET_RULE + `{y | (?x. P x /\ y = f x) /\ Q y} = {f x |x| P x /\ Q(f x)}`] THEN + REWRITE_TAC[SET_RULE `IMAGE f {x | P x} = {f x | P x}`] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP CONVEX_LINEAR_IMAGE_EQ th; + MATCH_MP OPEN_SEGMENT_LINEAR_IMAGE th; + MATCH_MP (SET_RULE + `(!x y. f x = f y ==> x = y) ==> (!s x. f x IN IMAGE f s <=> x IN s)`) + (CONJUNCT2 th)]));; + +let FACE_OF_CONIC = prove + (`!s f:real^N->bool. conic s /\ f face_of s ==> conic f`, + REPEAT GEN_TAC THEN REWRITE_TAC[face_of; conic] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `c:real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [ASM_MESON_TAC[VECTOR_MUL_RZERO]; ALL_TAC] THEN + ASM_CASES_TAC `c = &1` THENL + [ASM_MESON_TAC[VECTOR_MUL_LID]; ALL_TAC] THEN + SUBGOAL_THEN `?d e. &0 <= d /\ &0 <= e /\ d < &1 /\ &1 < e /\ d < e /\ + (d = c \/ e = c)` + MP_TAC THENL + [FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(c = &1) ==> c < &1 \/ &1 < c`)) + THENL + [MAP_EVERY EXISTS_TAC [`c:real`; `&2`] THEN ASM_REAL_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`&1 / &2`; `c:real`] THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(REPEAT_TCL CHOOSE_THEN + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`d % x :real^N`; `e % x:real^N`; `x:real^N`]) THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + SUBGOAL_THEN `(x:real^N) IN s` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[IN_SEGMENT]] THEN + ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; REAL_LT_IMP_NE] THEN + EXISTS_TAC `(&1 - d) / (e - d)` THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0] THEN + UNDISCH_TAC `d:real < e` THEN CONV_TAC REAL_FIELD]);; + +let FACE_OF_PCROSS = prove + (`!f s:real^M->bool f' s':real^N->bool. + f face_of s /\ f' face_of s' ==> (f PCROSS f') face_of (s PCROSS s')`, + REPEAT GEN_TAC THEN SIMP_TAC[face_of; CONVEX_PCROSS; PCROSS_MONO] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_SEGMENT; FORALL_IN_PCROSS] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[GSYM PASTECART_CMUL; PASTECART_ADD; PASTECART_INJ] THEN + REWRITE_TAC[PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC + [`a:real^M`; `a':real^N`; `b:real^M`; `b':real^N`] THEN + MAP_EVERY ASM_CASES_TAC [`b:real^M = a`; `b':real^N = a'`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN + ASM_MESON_TAC[]);; + +let FACE_OF_PCROSS_DECOMP = prove + (`!s:real^M->bool s':real^N->bool c. + c face_of (s PCROSS s') <=> + ?f f'. f face_of s /\ f' face_of s' /\ c = f PCROSS f'`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[FACE_OF_PCROSS]] THEN + ASM_CASES_TAC `c:real^(M,N)finite_sum->bool = {}` THENL + [ASM_MESON_TAC[EMPTY_FACE_OF; PCROSS_EMPTY]; DISCH_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN + MAP_EVERY EXISTS_TAC + [`IMAGE fstcart (c:real^(M,N)finite_sum->bool)`; + `IMAGE sndcart (c:real^(M,N)finite_sum->bool)`] THEN + MATCH_MP_TAC(TAUT `(p /\ q ==> r) /\ p /\ q ==> p /\ q /\ r`) THEN + CONJ_TAC THENL + [STRIP_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN + EXISTS_TAC `(s:real^M->bool) PCROSS (s':real^N->bool)` THEN + ASM_SIMP_TAC[FACE_OF_PCROSS; RELATIVE_INTERIOR_PCROSS] THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_LINEAR_IMAGE_CONVEX; + LINEAR_FSTCART; LINEAR_SNDCART] THEN + MATCH_MP_TAC(SET_RULE `~(s = {}) /\ s SUBSET t ==> ~DISJOINT s t`) THEN + ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN + REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_IMAGE] THEN + REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN + REWRITE_TAC[face_of] THEN + ASM_SIMP_TAC[CONVEX_LINEAR_IMAGE; LINEAR_FSTCART; LINEAR_SNDCART] THEN + FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o + MATCH_MP IMAGE_SUBSET) THEN + FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o + MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[IMAGE_FSTCART_PCROSS; IMAGE_SNDCART_PCROSS] THEN + REPEAT(DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE + `s SUBSET (if p then {} else t) ==> s SUBSET t`))) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN + REWRITE_TAC[EXISTS_PASTECART; FSTCART_PASTECART] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`pastecart (a:real^M) (y:real^N)`; + `pastecart (b:real^M) (y:real^N)`; + `pastecart (x:real^M) (y:real^N)`]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_IMAGE; EXISTS_PASTECART] THEN + REWRITE_TAC[FSTCART_PASTECART; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + UNDISCH_TAC `(c:real^(M,N)finite_sum->bool) SUBSET s PCROSS s'` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `pastecart (x:real^M) (y:real^N)`); + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_IMAGE]) THEN + REWRITE_TAC[EXISTS_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^M`) THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`pastecart (y:real^M) (a:real^N)`; + `pastecart (y:real^M) (b:real^N)`; + `pastecart (y:real^M) (x:real^N)`]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_IMAGE; EXISTS_PASTECART] THEN + REWRITE_TAC[SNDCART_PASTECART; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + UNDISCH_TAC `(c:real^(M,N)finite_sum->bool) SUBSET s PCROSS s'` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `pastecart (y:real^M) (x:real^N)`)] THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + REWRITE_TAC[IN_SEGMENT; PASTECART_INJ] THEN + REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; + VECTOR_ARITH `(&1 - u) % a + u % a:real^N = a`] THEN + MESON_TAC[]);; + +let FACE_OF_PCROSS_EQ = prove + (`!f s:real^M->bool f' s':real^N->bool. + (f PCROSS f') face_of (s PCROSS s') <=> + f = {} \/ f' = {} \/ f face_of s /\ f' face_of s'`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`f:real^M->bool = {}`; `f':real^N->bool = {}`] THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; EMPTY_FACE_OF] THEN + ASM_REWRITE_TAC[FACE_OF_PCROSS_DECOMP; PCROSS_EQ] THEN MESON_TAC[]);; + +let HYPERPLANE_FACE_OF_HALFSPACE_LE = prove + (`!a:real^N b. {x | a dot x = b} face_of {x | a dot x <= b}`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a:real = b <=> a <= b /\ a = b`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_LE]);; + +let HYPERPLANE_FACE_OF_HALFSPACE_GE = prove + (`!a:real^N b. {x | a dot x = b} face_of {x | a dot x >= b}`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a:real = b <=> a >= b /\ a = b`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN + REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_GE]);; + +let FACE_OF_HALFSPACE_LE = prove + (`!f a:real^N b. + f face_of {x | a dot x <= b} <=> + f = {} \/ f = {x | a dot x = b} \/ f = {x | a dot x <= b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[FACE_OF_EMPTY]) THEN + ASM_SIMP_TAC[FACE_OF_AFFINE_EQ; AFFINE_UNIV; DISJ_ACI] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[EMPTY_FACE_OF; FACE_OF_REFL; CONVEX_HALFSPACE_LE; + HYPERPLANE_FACE_OF_HALFSPACE_LE] THEN + MATCH_MP_TAC(TAUT `(~r ==> p \/ q) ==> p \/ q \/ r`) THEN DISCH_TAC THEN + SUBGOAL_THEN `f face_of {x:real^N | a dot x = b}` MP_TAC THENL + [ASM_SIMP_TAC[GSYM FRONTIER_HALFSPACE_LE] THEN + ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) + (SPEC_ALL RELATIVE_FRONTIER_NONEMPTY_INTERIOR); + INTERIOR_HALFSPACE_LE; HALFSPACE_EQ_EMPTY_LT] THEN + MATCH_MP_TAC FACE_OF_SUBSET THEN + EXISTS_TAC `{x:real^N | a dot x <= b}` THEN + ASM_SIMP_TAC[FACE_OF_SUBSET_RELATIVE_FRONTIER] THEN + ASM_SIMP_TAC[relative_frontier; CLOSURE_CLOSED; CLOSED_HALFSPACE_LE] THEN + SET_TAC[]; + ASM_SIMP_TAC[FACE_OF_AFFINE_EQ; AFFINE_HYPERPLANE]]);; + +let FACE_OF_HALFSPACE_GE = prove + (`!f a:real^N b. + f face_of {x | a dot x >= b} <=> + f = {} \/ f = {x | a dot x = b} \/ f = {x | a dot x >= b}`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:real^N->bool`; `--a:real^N`; `--b:real`] + FACE_OF_HALFSPACE_LE) THEN + REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);; + +(* ------------------------------------------------------------------------- *) +(* Exposed faces (faces that are intersection with supporting hyperplane). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("exposed_face_of",(12,"right"));; + +let exposed_face_of = new_definition + `t exposed_face_of s <=> + t face_of s /\ + ?a b. s SUBSET {x | a dot x <= b} /\ t = s INTER {x | a dot x = b}`;; + +let EMPTY_EXPOSED_FACE_OF = prove + (`!s:real^N->bool. {} exposed_face_of s`, + GEN_TAC THEN REWRITE_TAC[exposed_face_of; EMPTY_FACE_OF] THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1:real`] THEN + REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SET_TAC[]);; + +let EXPOSED_FACE_OF_REFL_EQ = prove + (`!s:real^N->bool. s exposed_face_of s <=> convex s`, + GEN_TAC THEN REWRITE_TAC[exposed_face_of; FACE_OF_REFL_EQ] THEN + ASM_CASES_TAC `convex(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&0:real`] THEN + REWRITE_TAC[DOT_LZERO] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN SET_TAC[]);; + +let EXPOSED_FACE_OF_REFL = prove + (`!s:real^N->bool. convex s ==> s exposed_face_of s`, + REWRITE_TAC[EXPOSED_FACE_OF_REFL_EQ]);; + +let EXPOSED_FACE_OF = prove + (`!s t. t exposed_face_of s <=> + t face_of s /\ + (t = {} \/ t = s \/ + ?a b. ~(a = vec 0) /\ + s SUBSET {x:real^N | a dot x <= b} /\ + t = s INTER {x | a dot x = b})`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF; EMPTY_FACE_OF] THEN + ASM_CASES_TAC `t:real^N->bool = s` THEN + ASM_REWRITE_TAC[EXPOSED_FACE_OF_REFL_EQ; FACE_OF_REFL_EQ] THEN + REWRITE_TAC[exposed_face_of] THEN AP_TERM_TAC THEN + EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; MESON_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN + ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[DOT_LZERO] THEN SET_TAC[]);; + +let EXPOSED_FACE_OF_TRANSLATION_EQ = prove + (`!a f s:real^N->bool. + (IMAGE (\x. a + x) f) exposed_face_of (IMAGE (\x. a + x) s) <=> + f exposed_face_of s`, + REPEAT GEN_TAC THEN REWRITE_TAC[exposed_face_of; FACE_OF_TRANSLATION_EQ] THEN + MP_TAC(ISPEC `\x:real^N. a + x` QUANTIFY_SURJECTION_THM) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [MESON_TAC[VECTOR_ARITH `y + (x - y):real^N = x`]; ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [last(CONJUNCTS th)]) THEN + REWRITE_TAC[end_itlist CONJ (!invariant_under_translation)] THEN + REWRITE_TAC[DOT_RADD] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM REAL_LE_SUB_LADD; GSYM REAL_EQ_SUB_LADD] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `c:real^N` THEN REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `b - (c:real^N) dot a`; + EXISTS_TAC `b + (c:real^N) dot a`] THEN + ASM_REWRITE_TAC[REAL_ARITH `(x + y) - y:real = x`]);; + +add_translation_invariants [EXPOSED_FACE_OF_TRANSLATION_EQ];; + +let EXPOSED_FACE_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N c s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> ((IMAGE f c) exposed_face_of (IMAGE f s) <=> c exposed_face_of s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[exposed_face_of] THEN + BINOP_TAC THENL [ASM_MESON_TAC[FACE_OF_LINEAR_IMAGE]; ALL_TAC] THEN + MP_TAC(ISPEC `f:real^M->real^N` QUANTIFY_SURJECTION_THM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [last(CONJUNCTS th)]) THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN ASM_SIMP_TAC[ADJOINT_WORKS] THEN + MP_TAC(end_itlist CONJ + (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `adjoint(f:real^M->real^N) a` THEN ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `adjoint(f:real^M->real^N)` + LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN + ASM_SIMP_TAC[ADJOINT_SURJECTIVE; ADJOINT_LINEAR] THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^M->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `(g:real^M->real^N) a` THEN ASM_REWRITE_TAC[]]);; + +let EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove + (`!s a:real^N b. + convex s /\ (!x. x IN s ==> a dot x <= b) + ==> (s INTER {x | a dot x = b}) exposed_face_of s`, + SIMP_TAC[FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE; exposed_face_of] THEN + SET_TAC[]);; + +let EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove + (`!s a:real^N b. + convex s /\ (!x. x IN s ==> a dot x >= b) + ==> (s INTER {x | a dot x = b}) exposed_face_of s`, + REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`] + EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE) THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);; + +let EXPOSED_FACE_OF_INTER = prove + (`!s t u:real^N->bool. + t exposed_face_of s /\ u exposed_face_of s + ==> (t INTER u) exposed_face_of s`, + REPEAT GEN_TAC THEN SIMP_TAC[exposed_face_of; FACE_OF_INTER] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`a':real^N`; `b':real`; `a:real^N`; `b:real`] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`a + a':real^N`; `b + b':real`] THEN + REWRITE_TAC[SET_RULE + `(s INTER t1) INTER (s INTER t2) = s INTER u <=> + !x. x IN s ==> (x IN t1 /\ x IN t2 <=> x IN u)`] THEN + ASM_SIMP_TAC[DOT_LADD; REAL_LE_ADD2; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`)) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let EXPOSED_FACE_OF_INTERS = prove + (`!P s:real^N->bool. + ~(P = {}) /\ (!t. t IN P ==> t exposed_face_of s) + ==> INTERS P exposed_face_of s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `P:(real^N->bool)->bool`] + INTERS_FACES_FINITE_ALTBOUND) THEN + ANTS_TAC THENL [ASM_MESON_TAC[exposed_face_of]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `Q:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SYM) THEN + ASM_CASES_TAC `Q:(real^N->bool)->bool = {}` THENL + [ASM_SIMP_TAC[INTERS_0] THEN + REWRITE_TAC[SET_RULE `INTERS s = UNIV <=> !t. t IN s ==> t = UNIV`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[]; + DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + SUBGOAL_THEN `!t:real^N->bool. t IN Q ==> t exposed_face_of s` MP_TAC THENL + [ASM SET_TAC[]; UNDISCH_TAC `FINITE(Q:(real^N->bool)->bool)`] THEN + SPEC_TAC(`Q:(real^N->bool)->bool`,`Q:(real^N->bool)->bool`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[FORALL_IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `P:(real^N->bool)->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTERS_INSERT] THEN + ASM_CASES_TAC `P:(real^N->bool)->bool = {}` THEN + ASM_SIMP_TAC[INTERS_0; INTER_UNIV; EXPOSED_FACE_OF_INTER]]);; + +let EXPOSED_FACE_OF_SUMS = prove + (`!s t f:real^N->bool. + convex s /\ convex t /\ + f exposed_face_of {x + y | x IN s /\ y IN t} + ==> ?k l. k exposed_face_of s /\ l exposed_face_of t /\ + f = {x + y | x IN k /\ y IN l}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXPOSED_FACE_OF]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `f:real^N->bool = {}` THENL + [DISCH_TAC THEN REPEAT (EXISTS_TAC `{}:real^N->bool`) THEN + ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF] THEN SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `f = {x + y :real^N | x IN s /\ y IN t}` THENL + [DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN + ASM_SIMP_TAC[EXPOSED_FACE_OF_REFL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `z:real`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM SUBSET_INTER_ABSORPTION]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[EXISTS_IN_GSPEC; IN_INTER] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a0:real^N`; `b0:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + EXISTS_TAC `s INTER {x:real^N | u dot x = u dot a0}` THEN + EXISTS_TAC `t INTER {y:real^N | u dot y = u dot b0}` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b0:real^N`]) THEN + ASM_REWRITE_TAC[DOT_RADD] THEN REAL_ARITH_TAC; + MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `b:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a0:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[DOT_RADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_INTER; IMP_CONJ] THENL + [ALL_TAC; SIMP_TAC[IN_INTER; IN_ELIM_THM; DOT_RADD] THEN MESON_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; DOT_RADD] THEN + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPECL [`a:real^N`; `b0:real^N`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a0:real^N`; `b:real^N`]) THEN + ASM_REWRITE_TAC[DOT_RADD] THEN ASM_REAL_ARITH_TAC);; + +let EXPOSED_FACE_OF_PARALLEL = prove + (`!t s. t exposed_face_of s <=> + t face_of s /\ + ?a b. s SUBSET {x:real^N | a dot x <= b} /\ + t = s INTER {x | a dot x = b} /\ + (~(t = {}) /\ ~(t = s) ==> ~(a = vec 0)) /\ + (!w. w IN affine hull s /\ ~(t = s) + ==> (w + a) IN affine hull s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[exposed_face_of] THEN + AP_TERM_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN SIMP_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`affine hull s:real^N->bool`; `--a:real^N`; `--b:real`] + AFFINE_PARALLEL_SLICE) THEN + SIMP_TAC[AFFINE_AFFINE_HULL; DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&1`] THEN + REWRITE_TAC[DOT_LZERO; REAL_POS; SET_RULE `{x | T} = UNIV`] THEN + SIMP_TAC[SUBSET_UNIV; VECTOR_ADD_RID; REAL_ARITH `~(&0 = &1)`] THEN + REWRITE_TAC[EMPTY_GSPEC] THEN ASM_REWRITE_TAC[INTER_EMPTY] THEN + MATCH_MP_TAC(TAUT `p ==> p /\ ~(~p /\ q)`) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s' INTER t' = {} + ==> s SUBSET s' /\ t SUBSET t' ==> s INTER t = {}`)) THEN + REWRITE_TAC[HULL_SUBSET] THEN SIMP_TAC[SUBSET; IN_ELIM_THM; REAL_LE_REFL]; + SUBGOAL_THEN `t:real^N->bool = s` SUBST1_TAC THENL + [FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + SUBGOAL_THEN `s SUBSET affine hull (s:real^N->bool)` MP_TAC THENL + [REWRITE_TAC[HULL_SUBSET]; ASM SET_TAC[]]; + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `&0`] THEN + REWRITE_TAC[DOT_LZERO; SET_RULE `{x | T} = UNIV`; REAL_LE_REFL] THEN + SET_TAC[]]; + FIRST_X_ASSUM(X_CHOOSE_THEN `a':real^N` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b':real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`--a':real^N`; `--b':real`] THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2] THEN + REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `b <= a <=> ~(a <= b) \/ a = b`] THEN + MATCH_MP_TAC(SET_RULE + `!s'. s SUBSET s' /\ + s SUBSET (UNIV DIFF (s' INTER {x | P x})) UNION + (s' INTER {x | Q x}) + ==> s SUBSET {x | ~P x \/ Q x}`) THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + ASM_REWRITE_TAC[HULL_SUBSET] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ s SUBSET (UNIV DIFF {x | P x}) UNION {x | Q x} + ==> s SUBSET (UNIV DIFF (s' INTER {x | P x})) UNION + (s' INTER {x | Q x})`) THEN + REWRITE_TAC[HULL_SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{x:real^N | a dot x <= b}` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_UNIV; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s' INTER a = s' INTER b + ==> s SUBSET s' ==> s INTER b = s INTER a`)) THEN + REWRITE_TAC[HULL_SUBSET]; + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0]; + ONCE_REWRITE_TAC[VECTOR_ARITH + `w + --a:real^N = w + &1 % (w - (w + a))`] THEN + ASM_SIMP_TAC[IN_AFFINE_ADD_MUL_DIFF; AFFINE_AFFINE_HULL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Extreme points of a set, which are its singleton faces. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("extreme_point_of",(12,"right"));; + +let extreme_point_of = new_definition + `x extreme_point_of s <=> + x IN s /\ !a b. a IN s /\ b IN s ==> ~(x IN segment(a,b))`;; + +let EXTREME_POINT_OF_STILLCONVEX = prove + (`!s x:real^N. + convex s ==> (x extreme_point_of s <=> x IN s /\ convex(s DELETE x))`, + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; extreme_point_of; open_segment] THEN + REWRITE_TAC[IN_DIFF; IN_DELETE; IN_INSERT; NOT_IN_EMPTY; SUBSET_DELETE] THEN + SET_TAC[]);; + +let FACE_OF_SING = prove + (`!x s. {x} face_of s <=> x extreme_point_of s`, + SIMP_TAC[face_of; extreme_point_of; SING_SUBSET; CONVEX_SING; IN_SING] THEN + MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]);; + +let EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR = prove + (`!s x:real^N. + x extreme_point_of s /\ ~(s = {x}) + ==> ~(x IN relative_interior s)`, + REPEAT GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + REWRITE_TAC[GSYM FACE_OF_SING] THEN + DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_DISJOINT_RELATIVE_INTERIOR) THEN + SET_TAC[]);; + +let EXTREME_POINT_NOT_IN_INTERIOR = prove + (`!s x:real^N. x extreme_point_of s ==> ~(x IN interior s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `s = {x:real^N}` THEN + ASM_SIMP_TAC[EMPTY_INTERIOR_FINITE; FINITE_SING; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + INTERIOR_SUBSET_RELATIVE_INTERIOR)) THEN + ASM_SIMP_TAC[EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR]);; + +let EXTREME_POINT_OF_FACE = prove + (`!f s v. f face_of s + ==> (v extreme_point_of f <=> v extreme_point_of s /\ v IN f)`, + REWRITE_TAC[GSYM FACE_OF_SING; GSYM SING_SUBSET; FACE_OF_FACE]);; + +let EXTREME_POINT_OF_MIDPOINT = prove + (`!s x:real^N. + convex s + ==> (x extreme_point_of s <=> + x IN s /\ + !a b. a IN s /\ b IN s /\ x = midpoint(a,b) ==> x = a /\ x = b)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[extreme_point_of] THEN + AP_TERM_TAC THEN EQ_TAC THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`a:real^N`; `b:real^N`]) THEN + ASM_SIMP_TAC[MIDPOINT_IN_SEGMENT; MIDPOINT_REFL]; + ALL_TAC] THEN + REWRITE_TAC[IN_SEGMENT] THEN DISCH_THEN(CONJUNCTS_THEN2 + ASSUME_TAC (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC `d = min (&1 - u) u` THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`x - d / &2 % (b - a):real^N`; `x + d / &2 % (b - a):real^N`]) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % a + u % b) - d / &2 % (b - a):real^N = + (&1 - (u - d / &2)) % a + (u - d / &2) % b`] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONVEX_ALT]) THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `((&1 - u) % a + u % b) + d / &2 % (b - a):real^N = + (&1 - (u + d / &2)) % a + (u + d / &2) % b`] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[VECTOR_ARITH `x:real^N = x - d <=> d = vec 0`; + VECTOR_ARITH `x:real^N = x + d <=> d = vec 0`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN ASM_REAL_ARITH_TAC]);; + +let EXTREME_POINT_OF_CONVEX_HULL = prove + (`!x:real^N s. x extreme_point_of (convex hull s) ==> x IN s`, + REPEAT GEN_TAC THEN + SIMP_TAC[EXTREME_POINT_OF_STILLCONVEX; CONVEX_CONVEX_HULL] THEN + MP_TAC(ISPECL [`convex:(real^N->bool)->bool`; `s:real^N->bool`; + `(convex hull s) DELETE (x:real^N)`] HULL_MINIMAL) THEN + MP_TAC(ISPECL [`convex:(real^N->bool)->bool`; `s:real^N->bool`] + HULL_SUBSET) THEN + ASM SET_TAC[]);; + +let EXTREME_POINTS_OF_CONVEX_HULL = prove + (`!s. {x | x extreme_point_of (convex hull s)} SUBSET s`, + REWRITE_TAC[SUBSET; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL]);; + +let EXTREME_POINT_OF_EMPTY = prove + (`!x. ~(x extreme_point_of {})`, + REWRITE_TAC[extreme_point_of; NOT_IN_EMPTY]);; + +let EXTREME_POINT_OF_SING = prove + (`!a x. x extreme_point_of {a} <=> x = a`, + REWRITE_TAC[extreme_point_of; IN_SING] THEN + MESON_TAC[SEGMENT_REFL; NOT_IN_EMPTY]);; + +let EXTREME_POINT_OF_TRANSLATION_EQ = prove + (`!a:real^N x s. + (a + x) extreme_point_of (IMAGE (\x. a + x) s) <=> + x extreme_point_of s`, + REWRITE_TAC[extreme_point_of] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [EXTREME_POINT_OF_TRANSLATION_EQ];; + +let EXTREME_POINT_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((f x) extreme_point_of (IMAGE f s) <=> x extreme_point_of s)`, + REWRITE_TAC[GSYM FACE_OF_SING] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [EXTREME_POINT_OF_LINEAR_IMAGE];; + +let EXTREME_POINTS_OF_TRANSLATION = prove + (`!a s. {x:real^N | x extreme_point_of (IMAGE (\x. a + x) s)} = + IMAGE (\x. a + x) {x | x extreme_point_of s}`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL] THEN + REWRITE_TAC[IN_ELIM_THM; EXTREME_POINT_OF_TRANSLATION_EQ]);; + +let EXTREME_POINT_OF_INTER = prove + (`!x s t. x extreme_point_of s /\ x extreme_point_of t + ==> x extreme_point_of (s INTER t)`, + REWRITE_TAC[extreme_point_of; IN_INTER] THEN MESON_TAC[]);; + +let EXTREME_POINTS_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> {y | y extreme_point_of (IMAGE f s)} = + IMAGE f {x | x extreme_point_of s}`, + + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_SEGMENT_LINEAR_IMAGE) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC; SUBSET; + extreme_point_of; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FUN_IN_IMAGE; IN_ELIM_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + ASM SET_TAC[]);; + +let EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove + (`!s a b c. (!x. x IN s ==> a dot x <= b) /\ + s INTER {x | a dot x = b} = {c} + ==> c extreme_point_of s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE_STRONG THEN + ASM_REWRITE_TAC[CONVEX_SING]);; + +let EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove + (`!s a b c. (!x. x IN s ==> a dot x >= b) /\ + s INTER {x | a dot x = b} = {c} + ==> c extreme_point_of s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE_STRONG THEN + ASM_REWRITE_TAC[CONVEX_SING]);; + +let EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE = prove + (`!s a b c:real^N. + (!x. x IN s ==> a dot x <= b) /\ + s INTER {x | a dot x = b} = {c} + ==> {c} exposed_face_of s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[exposed_face_of] THEN CONJ_TAC THENL + [REWRITE_TAC[FACE_OF_SING] THEN + MATCH_MP_TAC EXTREME_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM SET_TAC[]);; + +let EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_GE = prove + (`!s a b c:real^N. + (!x. x IN s ==> a dot x >= b) /\ + s INTER {x | a dot x = b} = {c} + ==> {c} exposed_face_of s`, + REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `--a:real^N`; `--b:real`; `c:real^N`] + EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE) THEN + ASM_REWRITE_TAC[DOT_LNEG; REAL_EQ_NEG2; REAL_LE_NEG2]);; + +let EXPOSED_POINT_OF_FURTHEST_POINT = prove + (`!s a b:real^N. + b IN s /\ (!x. x IN s ==> dist(a,x) <= dist(a,b)) + ==> {b} exposed_face_of s`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN + REWRITE_TAC[DIST_0; NORM_LE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC EXPOSED_POINT_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + MAP_EVERY EXISTS_TAC [`b:real^N`; `(b:real^N) dot b`] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[IN_INTER; SING_SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; IN_SING; IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[VECTOR_EQ] THEN + ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM] THEN + UNDISCH_TAC `(b:real^N) dot x = b dot b`] THEN + MP_TAC(ISPEC `b - x:real^N` DOT_POS_LE) THEN + REWRITE_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; + +let COLLINEAR_EXTREME_POINTS = prove + (`!s. collinear s + ==> FINITE {x:real^N | x extreme_point_of s} /\ + CARD {x | x extreme_point_of s} <= 2`, + REWRITE_TAC[GSYM NOT_LT; TAUT `a /\ ~b <=> ~(a ==> b)`] THEN + REWRITE_TAC[ARITH_RULE `2 < n <=> 3 <= n`] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSET_STRONG) THEN + CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`t:real^N->bool`; `a:real^N`; `b:real^N`; `c:real^N`] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN + `(a:real^N) extreme_point_of s /\ + b extreme_point_of s /\ c extreme_point_of s` + STRIP_ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(a:real^N) IN s /\ b IN s /\ c IN s` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[extreme_point_of]; ALL_TAC] THEN + SUBGOAL_THEN `collinear {a:real^N,b,c}` MP_TAC THENL + [MATCH_MP_TAC COLLINEAR_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN + ASM SET_TAC[]; + REWRITE_TAC[COLLINEAR_BETWEEN_CASES; BETWEEN_IN_SEGMENT] THEN + ASM_SIMP_TAC[SEGMENT_CLOSED_OPEN; IN_INSERT; NOT_IN_EMPTY; IN_UNION] THEN + ASM_MESON_TAC[extreme_point_of]]);; + +let EXTREME_POINT_OF_CONIC = prove + (`!s x:real^N. + conic s /\ x extreme_point_of s ==> x = vec 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN + DISCH_THEN(MP_TAC o MATCH_MP FACE_OF_CONIC) THEN + SIMP_TAC[conic; IN_SING; VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_ARITH + `c % x:real^N = x <=> (c - &1) % x = vec 0`] THEN + MESON_TAC[REAL_ARITH `&0 <= &0 /\ ~(&1 = &0)`]);; + +let EXTREME_POINT_OF_CONVEX_HULL_INSERT = prove + (`!s a:real^N. + FINITE s /\ ~(a IN convex hull s) + ==> a extreme_point_of (convex hull (a INSERT s))`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_SIMP_TAC[HULL_INC] THEN + STRIP_TAC THEN MP_TAC(ISPECL [`{a:real^N}`; `(a:real^N) INSERT s`] + FACE_OF_CONVEX_HULLS) THEN + ASM_REWRITE_TAC[FINITE_INSERT; AFFINE_HULL_SING; CONVEX_HULL_SING] THEN + REWRITE_TAC[FACE_OF_SING] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> a INSERT s DIFF {a} = s`] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Facets. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("facet_of",(12, "right"));; + +let facet_of = new_definition + `f facet_of s <=> f face_of s /\ ~(f = {}) /\ aff_dim f = aff_dim s - &1`;; + +let FACET_OF_EMPTY = prove + (`!s. ~(s facet_of {})`, + REWRITE_TAC[facet_of; FACE_OF_EMPTY] THEN CONV_TAC TAUT);; + +let FACET_OF_REFL = prove + (`!s. ~(s facet_of s)`, + REWRITE_TAC[facet_of; INT_ARITH `~(x:int = x - &1)`]);; + +let FACET_OF_IMP_FACE_OF = prove + (`!f s. f facet_of s ==> f face_of s`, + SIMP_TAC[facet_of]);; + +let FACET_OF_IMP_SUBSET = prove + (`!f s. f facet_of s ==> f SUBSET s`, + SIMP_TAC[FACET_OF_IMP_FACE_OF; FACE_OF_IMP_SUBSET]);; + +let FACET_OF_IMP_PROPER = prove + (`!f s. f facet_of s ==> ~(f = {}) /\ ~(f = s)`, + REWRITE_TAC[facet_of] THEN MESON_TAC[INT_ARITH `~(x - &1:int = x)`]);; + +let FACET_OF_TRANSLATION_EQ = prove + (`!a:real^N f s. + (IMAGE (\x. a + x) f) facet_of (IMAGE (\x. a + x) s) <=> f facet_of s`, + REWRITE_TAC[facet_of] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [FACET_OF_TRANSLATION_EQ];; + +let FACET_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N c s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((IMAGE f c) facet_of (IMAGE f s) <=> c facet_of s)`, + REWRITE_TAC[facet_of] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [FACET_OF_LINEAR_IMAGE];; + +let HYPERPLANE_FACET_OF_HALFSPACE_LE = prove + (`!a:real^N b. + ~(a = vec 0) ==> {x | a dot x = b} facet_of {x | a dot x <= b}`, + SIMP_TAC[facet_of; HYPERPLANE_FACE_OF_HALFSPACE_LE; HYPERPLANE_EQ_EMPTY; + AFF_DIM_HYPERPLANE; AFF_DIM_HALFSPACE_LE]);; + +let HYPERPLANE_FACET_OF_HALFSPACE_GE = prove + (`!a:real^N b. + ~(a = vec 0) ==> {x | a dot x = b} facet_of {x | a dot x >= b}`, + SIMP_TAC[facet_of; HYPERPLANE_FACE_OF_HALFSPACE_GE; HYPERPLANE_EQ_EMPTY; + AFF_DIM_HYPERPLANE; AFF_DIM_HALFSPACE_GE]);; + +let FACET_OF_HALFSPACE_LE = prove + (`!f a:real^N b. + f facet_of {x | a dot x <= b} <=> + ~(a = vec 0) /\ f = {x | a dot x = b}`, + REPEAT GEN_TAC THEN + EQ_TAC THEN ASM_SIMP_TAC[HYPERPLANE_FACET_OF_HALFSPACE_LE] THEN + SIMP_TAC[AFF_DIM_HALFSPACE_LE; facet_of; FACE_OF_HALFSPACE_LE] THEN + REWRITE_TAC[TAUT `(p \/ q) /\ ~p /\ r <=> (~p /\ q) /\ r`] THEN + ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_REWRITE_TAC[DOT_LZERO; SET_RULE + `{x | p} = if p then UNIV else {}`] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[TAUT `~(~p /\ p)`]) THEN + TRY ASM_REAL_ARITH_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[AFF_DIM_UNIV] THEN TRY INT_ARITH_TAC THEN ASM SET_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[AFF_DIM_HALFSPACE_LE] THEN INT_ARITH_TAC]);; + +let FACET_OF_HALFSPACE_GE = prove + (`!f a:real^N b. + f facet_of {x | a dot x >= b} <=> + ~(a = vec 0) /\ f = {x | a dot x = b}`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:real^N->bool`; `--a:real^N`; `--b:real`] + FACET_OF_HALFSPACE_LE) THEN + SIMP_TAC[DOT_LNEG; REAL_LE_NEG2; REAL_EQ_NEG2; VECTOR_NEG_EQ_0; real_ge]);; + +(* ------------------------------------------------------------------------- *) +(* Edges, i.e. faces of affine dimension 1. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("edge_of",(12, "right"));; + +let edge_of = new_definition + `e edge_of s <=> e face_of s /\ aff_dim e = &1`;; + +let EDGE_OF_TRANSLATION_EQ = prove + (`!a:real^N f s. + (IMAGE (\x. a + x) f) edge_of (IMAGE (\x. a + x) s) <=> f edge_of s`, + REWRITE_TAC[edge_of] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [EDGE_OF_TRANSLATION_EQ];; + +let EDGE_OF_LINEAR_IMAGE = prove + (`!f:real^M->real^N c s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((IMAGE f c) edge_of (IMAGE f s) <=> c edge_of s)`, + REWRITE_TAC[edge_of] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [EDGE_OF_LINEAR_IMAGE];; + +let EDGE_OF_IMP_SUBSET = prove + (`!s t. s edge_of t ==> s SUBSET t`, + SIMP_TAC[edge_of; face_of]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of extreme points. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENT_NORM_3_COLLINEAR_POINTS = prove + (`!a b x:real^N. + ~(x IN segment(a,b) /\ norm(a) = norm(b) /\ norm(x) = norm(b))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN + ASM_SIMP_TAC[SEGMENT_REFL; NOT_IN_EMPTY; OPEN_SEGMENT_ALT] THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) MP_TAC) THEN + ASM_REWRITE_TAC[NORM_EQ] THEN REWRITE_TAC[VECTOR_ARITH + `(x + y:real^N) dot (x + y) = x dot x + &2 * x dot y + y dot y`] THEN + REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN + UNDISCH_TAC `~(a:real^N = b)` THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM DOT_EQ_0; VECTOR_ARITH + `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * a dot b`] THEN + ASM_REWRITE_TAC[REAL_RING `a + a - &2 * ab = &0 <=> ab = a`] THEN + SIMP_TAC[REAL_RING + `(&1 - u) * (&1 - u) * a + &2 * (&1 - u) * u * x + u * u * a = a <=> + x = a \/ u = &0 \/ u = &1`] THEN + ASM_REAL_ARITH_TAC);; + +let EXTREME_POINT_EXISTS_CONVEX = prove + (`!s:real^N->bool. + compact s /\ convex s /\ ~(s = {}) ==> ?x. x extreme_point_of s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] DISTANCE_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[DIST_0; extreme_point_of] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real^N`; `b:real^N`; `x:real^N`] + DIFFERENT_NORM_3_COLLINEAR_POINTS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `a <= x /\ b <= x /\ (a < x ==> x < x) /\ (b < x ==> x < x) + ==> a = b /\ x = b`) THEN + ASM_SIMP_TAC[] THEN + UNDISCH_TAC `(x:real^N) IN segment(a,b)` THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + CONJ_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + MATCH_MP_TAC NORM_TRIANGLE_LT THEN REWRITE_TAC[NORM_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 < u /\ u < &1 ==> abs u = u /\ abs(&1 - u) = &1 - u`] THEN + SUBST1_TAC(REAL_RING `norm(x:real^N) = (&1 - u) * norm x + u * norm x`) THENL + [MATCH_MP_TAC REAL_LTE_ADD2; MATCH_MP_TAC REAL_LET_ADD2] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ; REAL_SUB_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Krein-Milman, the weaker form as in more general spaces first. *) +(* ------------------------------------------------------------------------- *) + +let KREIN_MILMAN = prove + (`!s:real^N->bool. + convex s /\ compact s + ==> s = closure(convex hull {x | x extreme_point_of s})`, + GEN_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[extreme_point_of; NOT_IN_EMPTY; EMPTY_GSPEC] THEN + REWRITE_TAC[CONVEX_HULL_EMPTY; CLOSURE_EMPTY]; + ALL_TAC] THEN + STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED] THEN + MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; extreme_point_of]] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `u:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`closure(convex hull {x:real^N | x extreme_point_of s})`; + `u:real^N`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + ASM_SIMP_TAC[CONVEX_CLOSURE; CLOSED_CLOSURE; CONVEX_CONVEX_HULL] THEN + REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. a dot x`; `s:real^N->bool`] + CONTINUOUS_ATTAINS_INF) THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_DOT] THEN + DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `t = {x:real^N | x IN s /\ a dot x = a dot m}` THEN + SUBGOAL_THEN `?x:real^N. x extreme_point_of t` (X_CHOOSE_TAC `v:real^N`) + THENL + [MATCH_MP_TAC EXTREME_POINT_EXISTS_CONVEX THEN + EXPAND_TAC "t" THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; COMPACT_INTER_CLOSED; + CLOSED_HYPERPLANE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(v:real^N) extreme_point_of s` ASSUME_TAC THENL + [REWRITE_TAC[GSYM FACE_OF_SING] THEN MATCH_MP_TAC FACE_OF_TRANS THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_SING] THEN + EXPAND_TAC "t" THEN + REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN + ASM_SIMP_TAC[real_ge]; + SUBGOAL_THEN `(a:real^N) dot v > b` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_ELIM_THM]; + ALL_TAC] THEN + REWRITE_TAC[real_gt; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:real^N) dot u` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:real^N) dot m` THEN + ASM_SIMP_TAC[] THEN + UNDISCH_TAC `(v:real^N) extreme_point_of t` THEN EXPAND_TAC "t" THEN + SIMP_TAC[extreme_point_of; IN_ELIM_THM; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Now the sharper form. *) +(* ------------------------------------------------------------------------- *) + +let KREIN_MILMAN_MINKOWSKI = prove + (`!s:real^N->bool. + convex s /\ compact s + ==> s = convex hull {x | x extreme_point_of s}`, + SUBGOAL_THEN + `!s:real^N->bool. + convex s /\ compact s /\ (vec 0) IN s + ==> (vec 0) IN convex hull {x | x extreme_point_of s}` + ASSUME_TAC THENL + [GEN_TAC THEN WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN + ASM_CASES_TAC `(vec 0:real^N) IN relative_interior s` THENL + [MP_TAC(ISPEC `s:real^N->bool` KREIN_MILMAN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + UNDISCH_TAC `(vec 0:real^N) IN relative_interior s` THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV o RAND_CONV) [th]) THEN + SIMP_TAC[CONVEX_RELATIVE_INTERIOR_CLOSURE; CONVEX_CONVEX_HULL] THEN + MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` ASSUME_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `vec 0:real^N`] + SUPPORTING_HYPERPLANE_RELATIVE_BOUNDARY) THEN + ASM_REWRITE_TAC[DOT_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `&0`] + FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE) THEN + ASM_REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(vec 0:real^N) IN convex hull + {x | x extreme_point_of (s INTER {x | a dot x = &0})}` + MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN + MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET] THEN + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; GSYM FACE_OF_SING] THEN + ASM_MESON_TAC[FACE_OF_TRANS]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_IMP]) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE; COMPACT_INTER_CLOSED; + CLOSED_HYPERPLANE; IN_INTER; IN_ELIM_THM; DOT_RZERO] THEN + REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`s INTER {x:real^N | a dot x = &0}`; `s:real^N->bool`] + DIM_EQ_SPAN) THEN + ASM_REWRITE_TAC[INTER_SUBSET; EXTENSION; NOT_FORALL_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `b /\ ~a ==> ~(a <=> b)`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; SPAN_INC; RELATIVE_INTERIOR_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN span (s INTER {x | a dot x = &0}) ==> a dot x = &0` + (fun th -> ASM_MESON_TAC[th; REAL_LT_REFL]) THEN + MATCH_MP_TAC SPAN_INDUCT THEN SIMP_TAC[IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[subspace; DOT_RZERO; DOT_RADD; DOT_RMUL; IN_ELIM_THM] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\x:real^N. --a + x) s`) THEN + ASM_SIMP_TAC[CONVEX_TRANSLATION_EQ; COMPACT_TRANSLATION_EQ] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + ASM_REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[EXTREME_POINTS_OF_TRANSLATION; CONVEX_HULL_TRANSLATION] THEN + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH `vec 0:real^N = --a + x <=> x = a`] THEN + REWRITE_TAC[UNWIND_THM2]; + MATCH_MP_TAC HULL_MINIMAL THEN + ASM_SIMP_TAC[SUBSET; extreme_point_of; IN_ELIM_THM]]);; + +(* ------------------------------------------------------------------------- *) +(* Applying it to convex hulls of explicitly indicated finite sets. *) +(* ------------------------------------------------------------------------- *) + +let KREIN_MILMAN_POLYTOPE = prove + (`!s. FINITE s + ==> convex hull s = + convex hull {x | x extreme_point_of (convex hull s)}`, + SIMP_TAC[KREIN_MILMAN_MINKOWSKI; CONVEX_CONVEX_HULL; + COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT]);; + +let EXTREME_POINTS_OF_CONVEX_HULL_EQ = prove + (`!s:real^N->bool. + compact s /\ + (!t. t PSUBSET s ==> ~(convex hull t = convex hull s)) + ==> {x | x extreme_point_of (convex hull s)} = s`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `{x:real^N | x extreme_point_of (convex hull s)}`) THEN + MATCH_MP_TAC(SET_RULE + `P /\ t SUBSET s ==> (t PSUBSET s ==> ~P) ==> t = s`) THEN + REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN + ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL]);; + +let EXTREME_POINT_OF_CONVEX_HULL_EQ = prove + (`!s x:real^N. + compact s /\ + (!t. t PSUBSET s ==> ~(convex hull t = convex hull s)) + ==> (x extreme_point_of (convex hull s) <=> x IN s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINTS_OF_CONVEX_HULL_EQ) THEN + SET_TAC[]);; + +let EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT = prove + (`!s x:real^N. + compact s /\ + (!a. a IN s ==> ~(a IN convex hull (s DELETE a))) + ==> (x extreme_point_of (convex hull s) <=> x IN s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_EQ THEN + ASM_REWRITE_TAC[PSUBSET_MEMBER] THEN X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `a:real^N`)) THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `s SUBSET convex hull (s DELETE (a:real^N))` MP_TAC THENL + [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `convex hull t:real^N->bool` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[HULL_SUBSET]; + MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]]);; + +let EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove + (`!s x. ~affine_dependent s + ==> (x extreme_point_of (convex hull s) <=> x IN s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_CONVEX_INDEPENDENT THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_IMP_COMPACT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN + MESON_TAC[SUBSET; CONVEX_HULL_SUBSET_AFFINE_HULL]);; + +let EXTREME_POINT_OF_CONVEX_HULL_2 = prove + (`!a b x. x extreme_point_of (convex hull {a,b}) <=> x = a \/ x = b`, + REWRITE_TAC[SET_RULE `x = a \/ x = b <=> x IN {a,b}`] THEN + SIMP_TAC[EXTREME_POINT_OF_CONVEX_HULL_AFFINE_INDEPENDENT; + AFFINE_INDEPENDENT_2]);; + +let EXTREME_POINT_OF_SEGMENT = prove + (`!a b x:real^N. x extreme_point_of segment[a,b] <=> x = a \/ x = b`, + REWRITE_TAC[SEGMENT_CONVEX_HULL; EXTREME_POINT_OF_CONVEX_HULL_2]);; + +let FACE_OF_CONVEX_HULL_SUBSET = prove + (`!s t:real^N->bool. + compact s /\ t face_of (convex hull s) + ==> ?s'. s' SUBSET s /\ t = convex hull s'`, + REPEAT STRIP_TAC THEN EXISTS_TAC `{x:real^N | x extreme_point_of t}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL THEN + ASM_MESON_TAC[FACE_OF_SING; FACE_OF_TRANS]; + MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN + ASM_MESON_TAC[FACE_OF_IMP_CONVEX; FACE_OF_IMP_COMPACT; + COMPACT_CONVEX_HULL; CONVEX_CONVEX_HULL]]);; + +let FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove + (`!s t:real^N->bool. + ~affine_dependent s + ==> (t face_of (convex hull s) <=> + ?c. c SUBSET s /\ t = convex hull c)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE; FINITE_IMP_COMPACT; + FACE_OF_CONVEX_HULL_SUBSET]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN + ASM_SIMP_TAC[AFFINE_INDEPENDENT_IMP_FINITE] THEN + MATCH_MP_TAC(SET_RULE ` + !t. u SUBSET t /\ DISJOINT s t ==> DISJOINT s u`) THEN + EXISTS_TAC `affine hull (s DIFF c:real^N->bool)` THEN + REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + MATCH_MP_TAC DISJOINT_AFFINE_HULL THEN + EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]]);; + +let FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT = prove + (`!s t:real^N->bool. + ~affine_dependent s + ==> (t facet_of (convex hull s) <=> + ~(t = {}) /\ ?u. u IN s /\ t = convex hull (s DELETE u))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[facet_of; FACE_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN + REWRITE_TAC[AFF_DIM_CONVEX_HULL] THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + UNDISCH_TAC + `aff_dim(convex hull c:real^N->bool) = aff_dim(s:real^N->bool) - &1` THEN + SUBGOAL_THEN `~affine_dependent(c:real^N->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET]; + ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT; AFF_DIM_CONVEX_HULL]] THEN + REWRITE_TAC[INT_ARITH `x - &1:int = y - &1 - &1 <=> y = x + &1`] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN DISCH_TAC THEN + SUBGOAL_THEN `(s DIFF c:real^N->bool) HAS_SIZE 1` MP_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; FINITE_DIFF; CARD_DIFF; + AFFINE_INDEPENDENT_IMP_FINITE] THEN ARITH_TAC; + CONV_TAC(LAND_CONV HAS_SIZE_CONV) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N` THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s DIFF t = {a} ==> t SUBSET s ==> s = a INSERT t`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `CARD((u:real^N) INSERT c) = CARD c + 1` THEN + ASM_SIMP_TAC[CARD_CLAUSES; AFFINE_INDEPENDENT_IMP_FINITE] THEN + COND_CASES_TAC THENL [ARITH_TAC; DISCH_THEN(K ALL_TAC)] THEN + CONJ_TAC THENL [ALL_TAC; AP_TERM_TAC] THEN ASM SET_TAC[]]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN + CONJ_TAC THENL [MESON_TAC[DELETE_SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[AFF_DIM_CONVEX_HULL] THEN + SUBGOAL_THEN `~affine_dependent(s DELETE (u:real^N))` ASSUME_TAC THENL + [ASM_MESON_TAC[AFFINE_INDEPENDENT_SUBSET; DELETE_SUBSET]; + ASM_SIMP_TAC[AFF_DIM_AFFINE_INDEPENDENT]] THEN + REWRITE_TAC[INT_ARITH `x - &1:int = y - &1 - &1 <=> y = x + &1`] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_EQ] THEN + ASM_SIMP_TAC[CARD_DELETE; AFFINE_INDEPENDENT_IMP_FINITE] THEN + MATCH_MP_TAC(ARITH_RULE `~(s = 0) ==> s = s - 1 + 1`) THEN + ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE] THEN + ASM SET_TAC[]]);; + +let FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT = prove + (`!s t:real^N->bool. + ~affine_dependent s + ==> (t facet_of (convex hull s) <=> + 2 <= CARD s /\ ?u. u IN s /\ t = convex hull (s DELETE u))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `u:real^N` THEN + ASM_CASES_TAC `t = convex hull (s DELETE (u:real^N))` THEN + ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN + ASM_CASES_TAC `(u:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `CARD s = 1 + CARD(s DELETE (u:real^N))` SUBST1_TAC THENL + [ASM_SIMP_TAC[CARD_DELETE; AFFINE_INDEPENDENT_IMP_FINITE] THEN + MATCH_MP_TAC(ARITH_RULE `~(s = 0) ==> s = 1 + s - 1`) THEN + ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE] THEN + ASM SET_TAC[]; + REWRITE_TAC[ARITH_RULE `2 <= 1 + x <=> ~(x = 0)`] THEN + ASM_SIMP_TAC[CARD_EQ_0; AFFINE_INDEPENDENT_IMP_FINITE; FINITE_DELETE]]);; + +let SEGMENT_FACE_OF = prove + (`!s a b:real^N. + segment[a,b] face_of s ==> a extreme_point_of s /\ b extreme_point_of s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN + MATCH_MP_TAC FACE_OF_TRANS THEN EXISTS_TAC `segment[a:real^N,b]` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[FACE_OF_SING; EXTREME_POINT_OF_SEGMENT]);; + +let SEGMENT_EDGE_OF = prove + (`!s a b:real^N. + segment[a,b] edge_of s + ==> ~(a = b) /\ a extreme_point_of s /\ b extreme_point_of s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[edge_of; SEGMENT_FACE_OF]] THEN + POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[SEGMENT_REFL; edge_of; AFF_DIM_SING] THEN INT_ARITH_TAC);; + +let COMPACT_CONVEX_COLLINEAR_SEGMENT = prove + (`!s:real^N->bool. + ~(s = {}) /\ compact s /\ convex s /\ collinear s + ==> ?a b. s = segment[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COLLINEAR_EXTREME_POINTS) THEN + REWRITE_TAC[ARITH_RULE `n <= 2 <=> n = 0 \/ n = 1 \/ n = 2`] THEN + REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN + CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; SEGMENT_CONVEX_HULL] THEN + DISCH_THEN SUBST1_TAC THEN MESON_TAC[SET_RULE `{a} = {a,a}`]);; + +let KREIN_MILMAN_RELATIVE_FRONTIER = prove + (`!s:real^N->bool. + convex s /\ compact s /\ ~(?a. s = {a}) + ==> s = convex hull (s DIFF relative_interior s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^N | x extreme_point_of s}` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; SUBSET_REFL]; + MATCH_MP_TAC HULL_MONO THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_DIFF] THEN + ASM_MESON_TAC[EXTREME_POINT_NOT_IN_RELATIVE_INTERIOR; extreme_point_of]]; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull s:real^N->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + ASM_SIMP_TAC[HULL_P; SUBSET_REFL]]]);; + +let KREIN_MILMAN_FRONTIER = prove + (`!s:real^N->bool. + convex s /\ compact s + ==> s = convex hull (frontier s)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[frontier; COMPACT_IMP_CLOSED; CLOSURE_CLOSED] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^N | x extreme_point_of s}` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; SUBSET_REFL]; + MATCH_MP_TAC HULL_MONO THEN SIMP_TAC[SUBSET; IN_ELIM_THM; IN_DIFF] THEN + ASM_MESON_TAC[EXTREME_POINT_NOT_IN_INTERIOR; extreme_point_of]]; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull s:real^N->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + ASM_SIMP_TAC[HULL_P; SUBSET_REFL]]]);; + +let EXTREME_POINT_OF_CONVEX_HULL_INSERT_EQ = prove + (`!s a x:real^N. + FINITE s /\ ~(a IN affine hull s) + ==> (x extreme_point_of (convex hull (a INSERT s)) <=> + x = a \/ x extreme_point_of (convex hull s))`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM AFFINE_HULL_CONVEX_HULL] THEN + STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + ONCE_REWRITE_TAC[HULL_UNION_RIGHT] THEN + MP_TAC(ISPEC `convex hull s:real^N->bool` KREIN_MILMAN_MINKOWSKI) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONVEX_CONVEX_HULL; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + DISCH_THEN(MP_TAC o SPEC + `{x:real^N | x extreme_point_of convex hull s}`) THEN + REWRITE_TAC[EXTREME_POINTS_OF_CONVEX_HULL] THEN + ABBREV_TAC `v = {x:real^N | x extreme_point_of (convex hull s)}` THEN + DISCH_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) + [AFFINE_HULL_CONVEX_HULL]) THEN + ASM_CASES_TAC `(a:real^N) IN v` THEN ASM_SIMP_TAC[HULL_INC] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM HULL_UNION_RIGHT] THEN + REWRITE_TAC[SET_RULE `{a} UNION s = a INSERT s`] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN + ASM SET_TAC[]; + STRIP_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_INSERT THEN + ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; + REWRITE_TAC[GSYM FACE_OF_SING] THEN + MATCH_MP_TAC FACE_OF_TRANS THEN + EXISTS_TAC `convex hull v:real^N->bool` THEN + ASM_REWRITE_TAC[FACE_OF_SING] THEN + MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN + ASM_SIMP_TAC[FINITE_INSERT; AFFINE_HULL_SING; CONVEX_HULL_SING; + SET_RULE `~(a IN s) ==> a INSERT s DIFF s = {a}`] THEN + ASM SET_TAC[]]]);; + +let FACE_OF_CONVEX_HULL_INSERT_EQ = prove + (`!f s a:real^N. + FINITE s /\ ~(a IN affine hull s) + ==> (f face_of (convex hull (a INSERT s)) <=> + f face_of (convex hull s) \/ + ?f'. f' face_of (convex hull s) /\ + f = convex hull (a INSERT f'))`, + let lemma = prove + (`!a b c p:real^N u v w x. + x % p = u % a + v % b + w % c + ==> !s. u + v + w = x /\ ~(x = &0) /\ affine s /\ + a IN s /\ b IN s /\ c IN s + ==> p IN s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv x):real^N->real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN + EXISTS_TAC `affine hull {a:real^N,b,c}` THEN + ASM_SIMP_TAC[HULL_MINIMAL; INSERT_SUBSET; EMPTY_SUBSET] THEN + REWRITE_TAC[AFFINE_HULL_3; IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC + [`inv x * u:real`; `inv x * v:real`; `inv x * w:real`] THEN + REWRITE_TAC[] THEN UNDISCH_TAC `u + v + w:real = x` THEN + UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD) in + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + FACE_OF_CONVEX_HULL_SUBSET)) THEN + ASM_SIMP_TAC[COMPACT_INSERT; FINITE_IMP_COMPACT] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_CASES_TAC `(a:real^N) IN t` THENL + [ALL_TAC; + DISJ1_TAC THEN MATCH_MP_TAC FACE_OF_SUBSET THEN + EXISTS_TAC `convex hull ((a:real^N) INSERT s)` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_MONO THEN + ASM SET_TAC[]] THEN + DISJ2_TAC THEN + EXISTS_TAC `(convex hull t) INTER (convex hull s):real^N->bool` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FACE_OF_SUBSET THEN + EXISTS_TAC `convex hull ((a:real^N) INSERT s)` THEN + SIMP_TAC[INTER_SUBSET; HULL_MONO; SET_RULE `s SUBSET (a INSERT s)`] THEN + MATCH_MP_TAC FACE_OF_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FACE_OF_CONVEX_HULL_INSERT THEN + ASM_REWRITE_TAC[FACE_OF_REFL_EQ; CONVEX_CONVEX_HULL]; + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN REWRITE_TAC[CONVEX_CONVEX_HULL] THEN + ASM_SIMP_TAC[INSERT_SUBSET; HULL_INC; INTER_SUBSET] THEN + REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_INC THEN + ASM_CASES_TAC `x:real^N = a` THEN ASM_REWRITE_TAC[IN_INSERT] THEN + REWRITE_TAC[IN_INTER] THEN CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MATCH_MP_TAC FACE_OF_CONVEX_HULL_INSERT THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(X_CHOOSE_THEN `f':real^N->bool` MP_TAC)] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC) THEN + SPEC_TAC(`f':real^N->bool`,`f:real^N->bool`) THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [UNDISCH_TAC `(f:real^N->bool) face_of convex hull s` THEN + ASM_SIMP_TAC[FACE_OF_EMPTY; CONVEX_HULL_EMPTY; FACE_OF_REFL_EQ] THEN + REWRITE_TAC[CONVEX_CONVEX_HULL]; + ALL_TAC] THEN + ASM_CASES_TAC `f:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[CONVEX_HULL_SING; FACE_OF_SING] THEN + MATCH_MP_TAC EXTREME_POINT_OF_CONVEX_HULL_INSERT THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL; SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[face_of; CONVEX_CONVEX_HULL] THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[INSERT_SUBSET; HULL_INC; IN_INSERT; CONVEX_CONVEX_HULL] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull s:real^N->bool` THEN + ASM_SIMP_TAC[HULL_MONO; SET_RULE `s SUBSET (a INSERT s)`] THEN + ASM_MESON_TAC[FACE_OF_IMP_SUBSET]; + ALL_TAC] THEN + ASM_REWRITE_TAC[CONVEX_HULL_INSERT_ALT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + X_GEN_TAC `ub:real` THEN STRIP_TAC THEN + X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + X_GEN_TAC `uc:real` THEN STRIP_TAC THEN + X_GEN_TAC `c:real^N` THEN STRIP_TAC THEN + X_GEN_TAC `ux:real` THEN STRIP_TAC THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [face_of]) THEN + SUBGOAL_THEN `convex hull f:real^N->bool = f` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[CONVEX_HULL_EQ]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `v:real` MP_TAC)) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[VECTOR_ARITH + `(&1 - ux) % a + ux % x:real^N = + (&1 - v) % ((&1 - ub) % a + ub % b) + v % ((&1 - uc) % a + uc % c) <=> + ((&1 - ux) - ((&1 - v) * (&1 - ub) + v * (&1 - uc))) % a + + (ux % x - (((&1 - v) * ub) % b + (v * uc) % c)) = vec 0`] THEN + ASM_CASES_TAC `&1 - ux - ((&1 - v) * (&1 - ub) + v * (&1 - uc)) = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_RING + `(&1 - ux) - ((&1 - v) * (&1 - ub) + v * (&1 - uc)) = &0 + ==> (&1 - v) * ub + v * uc = ux`)) THEN + ASM_CASES_TAC `uc = &0` THENL + [UNDISCH_THEN `uc = &0` SUBST_ALL_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH + `a + v * &0 = b ==> b = a`)) THEN + REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO; VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_LCANCEL; REAL_ENTIRE] THEN + STRIP_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_MESON_TAC[VECTOR_MUL_LZERO]; + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]; + ALL_TAC] THEN + ASM_CASES_TAC `ub = &0` THENL + [UNDISCH_THEN `ub = &0` SUBST_ALL_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o MATCH_MP (REAL_ARITH + `v * &0 + a = b ==> b = a`)) THEN + REWRITE_TAC[REAL_MUL_RZERO; VECTOR_MUL_LZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[VECTOR_SUB_EQ; VECTOR_MUL_LCANCEL; REAL_ENTIRE] THEN + STRIP_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_MESON_TAC[VECTOR_MUL_LZERO]; + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`&0`; `x:real^N`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC VECTOR_ARITH]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + SUBGOAL_THEN + `(b:real^N) IN f /\ (c:real^N) IN f` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MP_TAC th) THEN + ASM_CASES_TAC `ux = &0` THENL + [DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `&1 - ux - a = &0 ==> ux = &0 ==> ~(a < &1)`)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(&1 - v) * &1 + v * &1` THEN + CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= y /\ w <= z /\ ~(x = y /\ w = z) ==> x + w < y + z`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_SUB_LT; REAL_EQ_MUL_LCANCEL] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + ASM_SIMP_TAC[REAL_SUB_0; REAL_LT_IMP_NE] THEN + REWRITE_TAC[REAL_ARITH `&1 - x = &1 <=> x = &0`] THEN + DISCH_THEN(CONJUNCTS_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC[VECTOR_MUL_LZERO]; + ALL_TAC] THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN ASM_CASES_TAC `c:real^N = b` THENL + [ASM_REWRITE_TAC[GSYM VECTOR_ADD_RDISTRIB; VECTOR_MUL_LCANCEL] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_SEGMENT] THEN + EXISTS_TAC `(v * uc) / ux:real` THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_ARITH + `&0 <= x /\ ~(x = &0) ==> &0 < x`] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + EXPAND_TAC "ux" THEN REWRITE_TAC[REAL_ARITH `b < a + b <=> &0 < a`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o AP_TERM `(%) (inv ux) :real^N->real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ARITH `inv u * v * uc:real = (v * uc) / u`] THEN + UNDISCH_TAC `(&1 - v) * ub + v * uc = ux` THEN + UNDISCH_TAC `~(ux = &0)` THEN CONV_TAC REAL_FIELD]; + DISCH_THEN(MP_TAC o MATCH_MP (VECTOR_ARITH + `a + (b - c):real^N = vec 0 ==> a = c + --b`)) THEN + REWRITE_TAC[GSYM VECTOR_ADD_ASSOC; GSYM VECTOR_MUL_LNEG] THEN + DISCH_THEN(MP_TAC o SPEC `affine hull s:real^N->bool` o + MATCH_MP lemma) THEN + ASM_REWRITE_TAC[AFFINE_AFFINE_HULL] THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + CONJ_TAC THENL [CONV_TAC REAL_RING; REPEAT CONJ_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CONVEX_HULL_SUBSET_AFFINE_HULL) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Polytopes. *) +(* ------------------------------------------------------------------------- *) + +let polytope = new_definition + `polytope s <=> ?v. FINITE v /\ s = convex hull v`;; + +let POLYTOPE_TRANSLATION_EQ = prove + (`!a s. polytope (IMAGE (\x:real^N. a + x) s) <=> polytope s`, + REWRITE_TAC[polytope] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [POLYTOPE_TRANSLATION_EQ];; + +let POLYTOPE_LINEAR_IMAGE = prove + (`!f:real^M->real^N p. + linear f /\ polytope p ==> polytope(IMAGE f p)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[polytope] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^M->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[CONVEX_HULL_LINEAR_IMAGE; FINITE_IMAGE]);; + +let POLYTOPE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> (polytope (IMAGE f s) <=> polytope s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[polytope] THEN + MP_TAC(ISPEC `f:real^M->real^N` QUANTIFY_SURJECTION_THM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV)[th]) THEN + MP_TAC(end_itlist CONJ + (mapfilter (ISPEC `f:real^M->real^N`) (!invariant_under_linear))) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]);; + +let POLYTOPE_EMPTY = prove + (`polytope {}`, + REWRITE_TAC[polytope] THEN MESON_TAC[FINITE_EMPTY; CONVEX_HULL_EMPTY]);; + +let POLYTOPE_NEGATIONS = prove + (`!s:real^N->bool. polytope s ==> polytope(IMAGE (--) s)`, + SIMP_TAC[POLYTOPE_LINEAR_IMAGE; LINEAR_NEGATION]);; + +let POLYTOPE_CONVEX_HULL = prove + (`!s. FINITE s ==> polytope(convex hull s)`, + REWRITE_TAC[polytope] THEN MESON_TAC[]);; + +let POLYTOPE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + polytope s /\ polytope t ==> polytope(s PCROSS t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN + MESON_TAC[CONVEX_HULL_PCROSS; FINITE_PCROSS]);; + +let POLYTOPE_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + polytope(s PCROSS t) <=> + s = {} \/ t = {} \/ polytope s /\ polytope t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; POLYTOPE_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; POLYTOPE_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[POLYTOPE_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] + POLYTOPE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] + POLYTOPE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let FACE_OF_POLYTOPE_POLYTOPE = prove + (`!f s:real^N->bool. polytope s /\ f face_of s ==> polytope f`, + REWRITE_TAC[polytope] THEN + MESON_TAC[FINITE_SUBSET; FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);; + +let FINITE_POLYTOPE_FACES = prove + (`!s:real^N->bool. polytope s ==> FINITE {f | f face_of s}`, + GEN_TAC THEN REWRITE_TAC[polytope; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE ((hull) convex) {t:real^N->bool | t SUBSET v}` THEN + ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE] THEN + GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);; + +let FINITE_POLYTOPE_FACETS = prove + (`!s:real^N->bool. polytope s ==> FINITE {f | f facet_of s}`, + REWRITE_TAC[facet_of] THEN ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_POLYTOPE_FACES]);; + +let POLYTOPE_SCALING = prove + (`!c s:real^N->bool. polytope s ==> polytope (IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN DISCH_THEN + (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\x:real^N. c % x) u` THEN + ASM_SIMP_TAC[CONVEX_HULL_SCALING; FINITE_IMAGE]);; + +let POLYTOPE_SCALING_EQ = prove + (`!c s:real^N->bool. + ~(c = &0) ==> (polytope (IMAGE (\x. c % x) s) <=> polytope s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[POLYTOPE_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP POLYTOPE_SCALING) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; o_DEF; VECTOR_MUL_ASSOC; + REAL_MUL_LINV; VECTOR_MUL_LID; IMAGE_ID]);; + +let POLYTOPE_SUMS = prove + (`!s t:real^N->bool. + polytope s /\ polytope t ==> polytope {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[polytope] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `{x + y:real^N | x IN u /\ y IN v}` THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; CONVEX_HULL_SUMS]);; + +let POLYTOPE_IMP_COMPACT = prove + (`!s. polytope s ==> compact s`, + SIMP_TAC[polytope; LEFT_IMP_EXISTS_THM; COMPACT_CONVEX_HULL; + FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]);; + +let POLYTOPE_IMP_CONVEX = prove + (`!s. polytope s ==> convex s`, + SIMP_TAC[polytope; LEFT_IMP_EXISTS_THM; CONVEX_CONVEX_HULL]);; + +let POLYTOPE_IMP_CLOSED = prove + (`!s. polytope s ==> closed s`, + SIMP_TAC[POLYTOPE_IMP_COMPACT; COMPACT_IMP_CLOSED]);; + +let POLYTOPE_IMP_BOUNDED = prove + (`!s. polytope s ==> bounded s`, + SIMP_TAC[POLYTOPE_IMP_COMPACT; COMPACT_IMP_BOUNDED]);; + +let POLYTOPE_INTERVAL = prove + (`!a b. polytope(interval[a,b])`, + REWRITE_TAC[polytope] THEN MESON_TAC[CLOSED_INTERVAL_AS_CONVEX_HULL]);; + +let POLYTOPE_SING = prove + (`!a. polytope {a}`, + MESON_TAC[POLYTOPE_INTERVAL; INTERVAL_SING]);; + +(* ------------------------------------------------------------------------- *) +(* Approximation of bounded convex sets by polytopes. *) +(* ------------------------------------------------------------------------- *) + +let CONVEX_INNER_APPROXIMATION = prove + (`!s:real^N->bool e. + bounded s /\ convex s /\ &0 < e + ==> ?k. FINITE k /\ convex hull k SUBSET s /\ + hausdist(convex hull k,s) < e /\ + (k = {} ==> s = {})`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `{}:real^N->bool` THEN + ASM_SIMP_TAC[FINITE_EMPTY; CONVEX_HULL_EMPTY; HAUSDIST_REFL; SUBSET_REFL]; + ALL_TAC] THEN + MP_TAC(ISPEC `closure s:real^N->bool` COMPACT_EQ_HEINE_BOREL) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN + DISCH_THEN(MP_TAC o SPEC `{ball(x:real^N,e / &2) | x IN s}`) THEN + REWRITE_TAC[FORALL_IN_GSPEC; OPEN_BALL] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[IN_BALL; REAL_HALF]; + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN + ASM_CASES_TAC `k:real^N->bool = {}` THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; SUBSET_EMPTY; CLOSURE_EQ_EMPTY] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[HULL_MINIMAL]; DISCH_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&0 < e ==> x <= e / &2 ==> x < e`)) THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN UNDISCH_TAC + `closure s SUBSET UNIONS (IMAGE (\x:real^N. ball (x,e / &2)) k)` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN + ASM_SIMP_TAC[IN_SING; HULL_INC]);; + +let CONVEX_OUTER_APPROXIMATION = prove + (`!s:real^N->bool e. + bounded s /\ convex s /\ &0 < e + ==> ?k. FINITE k /\ s SUBSET convex hull k /\ + hausdist(convex hull k,s) < e`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `{}:real^N->bool` THEN + ASM_REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET; HAUSDIST_EMPTY; + CONVEX_HULL_EMPTY]; + ALL_TAC] THEN + MP_TAC(ISPECL [`{x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)}`; + `e / &2`] CONVEX_INNER_APPROXIMATION) THEN + ASM_SIMP_TAC[CONVEX_SUMS; CONVEX_BALL; BOUNDED_SUMS; BOUNDED_BALL] THEN + ASM_REWRITE_TAC[REAL_HALF; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; SET_RULE + `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[REAL_NOT_LE] + (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] REAL_LE_HAUSDIST))) THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; RIGHT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; LEFT_FORALL_IMP_THM] THEN + ASM_REWRITE_TAC[REAL_HALF; BALL_EQ_EMPTY; GSYM REAL_NOT_LT; SET_RULE + `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN + REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LT; FORALL_AND_THM] THEN ANTS_TAC THENL + [EXISTS_TAC `hausdist(convex hull k, + {x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)})` THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN + ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN + ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL]; + ALL_TAC] THEN + ANTS_TAC THENL + [EXISTS_TAC `hausdist(convex hull k, + {x + y:real^N | x IN s /\ y IN ball(vec 0,e / &2)})` THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[HAUSDIST_SYM] THEN + MATCH_MP_TAC SETDIST_SING_LE_HAUSDIST THEN + ASM_SIMP_TAC[BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED] THEN + ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_BALL]; + REWRITE_TAC[TAUT `~p \/ q <=> p ==> q`] THEN DISCH_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_SUMS_RCANCEL THEN + EXISTS_TAC `ball(vec 0:real^N,e / &2)` THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; FINITE_IMP_COMPACT; + CONVEX_CONVEX_HULL; BALL_EQ_EMPTY; BOUNDED_BALL; REAL_NOT_LE] THEN + ASM_REWRITE_TAC[REAL_HALF; SUBSET] THEN X_GEN_TAC `z:real^N` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ_ALT] (REWRITE_RULE[CONJ_ASSOC] + REAL_SETDIST_LT_EXISTS))) THEN + ASM_REWRITE_TAC[NOT_INSERT_EMPTY; CONVEX_HULL_EQ_EMPTY; IN_SING] THEN + REWRITE_TAC[IN_BALL_0; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `z - y:real^N` THEN + ASM_REWRITE_TAC[GSYM dist] THEN CONV_TAC VECTOR_ARITH; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&0 < e ==> x <= e / &2 ==> x < e`)) THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = z + y <=> x - z = y`] THEN + REWRITE_TAC[UNWIND_THM1; IN_BALL_0; GSYM dist] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC SETDIST_LE_DIST THEN + ASM_REWRITE_TAC[IN_SING]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o CONJUNCT2) THEN + ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[REAL_LT_IMP_LE]] THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `x:real^N` THEN + EXISTS_TAC `vec 0:real^N` THEN ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN + ASM_REWRITE_TAC[REAL_HALF; VECTOR_ADD_RID]]]);; + +let CONVEX_INNER_POLYTOPE = prove + (`!s:real^N->bool e. + bounded s /\ convex s /\ &0 < e + ==> ?p. polytope p /\ p SUBSET s /\ hausdist(p,s) < e /\ + (p = {} ==> s = {})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC o + MATCH_MP CONVEX_INNER_APPROXIMATION) THEN + EXISTS_TAC `convex hull k:real^N->bool` THEN + ASM_SIMP_TAC[CONVEX_HULL_EQ_EMPTY; POLYTOPE_CONVEX_HULL]);; + +let CONVEX_OUTER_POLYTOPE = prove + (`!s:real^N->bool e. + bounded s /\ convex s /\ &0 < e + ==> ?p. polytope p /\ s SUBSET p /\ hausdist(p,s) < e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC o + MATCH_MP CONVEX_OUTER_APPROXIMATION) THEN + EXISTS_TAC `convex hull k:real^N->bool` THEN + ASM_SIMP_TAC[CONVEX_HULL_EQ_EMPTY; POLYTOPE_CONVEX_HULL]);; + +(* ------------------------------------------------------------------------- *) +(* Polyhedra. *) +(* ------------------------------------------------------------------------- *) + +let polyhedron = new_definition + `polyhedron s <=> + ?f. FINITE f /\ + s = INTERS f /\ + (!h. h IN f ==> ?a b. ~(a = vec 0) /\ h = {x | a dot x <= b})`;; + +let POLYHEDRON_INTER = prove + (`!s t:real^N->bool. + polyhedron s /\ polyhedron t ==> polyhedron (s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[polyhedron] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `f:(real^N->bool)->bool`) + (X_CHOOSE_TAC `g:(real^N->bool)->bool`)) THEN + EXISTS_TAC `f UNION g:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[SET_RULE `INTERS(f UNION g) = INTERS f INTER INTERS g`] THEN + REWRITE_TAC[FINITE_UNION; IN_UNION] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]);; + +let POLYHEDRON_UNIV = prove + (`polyhedron(:real^N)`, + REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN + REWRITE_TAC[INTERS_0; NOT_IN_EMPTY; FINITE_RULES]);; + +let POLYHEDRON_POSITIVE_ORTHANT = prove + (`polyhedron {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`, + REWRITE_TAC[polyhedron] THEN + EXISTS_TAC `IMAGE (\i. {x:real^N | &0 <= x$i}) (1..dimindex(:N))` THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[INTERS_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_NUMSEG]; + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`--basis k:real^N`; `&0`] THEN + ASM_SIMP_TAC[VECTOR_NEG_EQ_0; DOT_LNEG; DOT_BASIS; BASIS_NONZERO] THEN + REWRITE_TAC[REAL_ARITH `--x <= &0 <=> &0 <= x`]]);; + +let POLYHEDRON_INTERS = prove + (`!f:(real^N->bool)->bool. + FINITE f /\ (!s. s IN f ==> polyhedron s) ==> polyhedron(INTERS f)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; POLYHEDRON_UNIV] THEN + ASM_SIMP_TAC[INTERS_INSERT; FORALL_IN_INSERT; POLYHEDRON_INTER]);; + +let POLYHEDRON_EMPTY = prove + (`polyhedron({}:real^N->bool)`, + REWRITE_TAC[polyhedron] THEN + EXISTS_TAC `{{x:real^N | basis 1 dot x <= -- &1}, + {x | --(basis 1) dot x <= -- &1}}` THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; INTERS_2; FORALL_IN_INSERT] THEN + REWRITE_TAC[NOT_IN_EMPTY; INTER; IN_ELIM_THM; DOT_LNEG] THEN + REWRITE_TAC[REAL_ARITH `~(a <= -- &1 /\ --a <= -- &1)`; EMPTY_GSPEC] THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`basis 1:real^N`; `-- &1`]; + MAP_EVERY EXISTS_TAC [`--(basis 1):real^N`; `-- &1`]] THEN + SIMP_TAC[VECTOR_NEG_EQ_0; BASIS_NONZERO; DOT_LNEG; + DIMINDEX_GE_1; LE_REFL]);; + +let POLYHEDRON_HALFSPACE_LE = prove + (`!a b. polyhedron {x:real^N | a dot x <= b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[POLYHEDRON_EMPTY; POLYHEDRON_UNIV]; + REWRITE_TAC[polyhedron] THEN EXISTS_TAC `{{x:real^N | a dot x <= b}}` THEN + REWRITE_TAC[FINITE_SING; INTERS_1; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real`] THEN ASM_REWRITE_TAC[]]);; + +let POLYHEDRON_HALFSPACE_GE = prove + (`!a b. polyhedron {x:real^N | a dot x >= b}`, + REWRITE_TAC[REAL_ARITH `a:real >= b <=> --a <= --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; POLYHEDRON_HALFSPACE_LE]);; + +let POLYHEDRON_HYPERPLANE = prove + (`!a b. polyhedron {x:real^N | a dot x = b}`, + REWRITE_TAC[REAL_ARITH `x:real = b <=> x <= b /\ x >= b`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[POLYHEDRON_INTER; POLYHEDRON_HALFSPACE_LE; + POLYHEDRON_HALFSPACE_GE]);; + +let AFFINE_IMP_POLYHEDRON = prove + (`!s:real^N->bool. affine s ==> polyhedron s`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` + AFFINE_HULL_FINITE_INTERSECTION_HYPERPLANES) THEN + ASM_SIMP_TAC[HULL_P; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN + REWRITE_TAC[POLYHEDRON_HYPERPLANE]);; + +let POLYHEDRON_IMP_CLOSED = prove + (`!s:real^N->bool. polyhedron s ==> closed s`, + REWRITE_TAC[polyhedron; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_INTERS THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN + REWRITE_TAC[CLOSED_HALFSPACE_LE]);; + +let POLYHEDRON_IMP_CONVEX = prove + (`!s:real^N->bool. polyhedron s ==> convex s`, + REWRITE_TAC[polyhedron; RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONVEX_INTERS THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN + REWRITE_TAC[CONVEX_HALFSPACE_LE]);; + +let POLYHEDRON_AFFINE_HULL = prove + (`!s. polyhedron(affine hull s)`, + SIMP_TAC[AFFINE_IMP_POLYHEDRON; AFFINE_AFFINE_HULL]);; + +(* ------------------------------------------------------------------------- *) +(* Canonical polyedron representation making facial structure explicit. *) +(* ------------------------------------------------------------------------- *) + +let POLYHEDRON_INTER_AFFINE = prove + (`!s. polyhedron s <=> + ?f. FINITE f /\ + s = (affine hull s) INTER (INTERS f) /\ + (!h. h IN f + ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b})`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[polyhedron] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN + TRY(FIRST_ASSUM ACCEPT_TAC) THEN + MATCH_MP_TAC(SET_RULE `s = t /\ s SUBSET u ==> s = u INTER t`) THEN + REWRITE_TAC[HULL_SUBSET] THEN ASM_REWRITE_TAC[]; + STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC POLYHEDRON_INTER THEN REWRITE_TAC[POLYHEDRON_AFFINE_HULL] THEN + MATCH_MP_TAC POLYHEDRON_INTERS THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[POLYHEDRON_HALFSPACE_LE]]);; + +let POLYHEDRON_INTER_AFFINE_PARALLEL = prove + (`!s:real^N->bool. + polyhedron s <=> + ?f. FINITE f /\ + s = (affine hull s) INTER (INTERS f) /\ + (!h. h IN f + ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b} /\ + (!x. x IN affine hull s + ==> (x + a) IN affine hull s))`, + GEN_TAC THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN EQ_TAC THENL + [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` MP_TAC) THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [DISCH_THEN(K ALL_TAC) THEN EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_SIMP_TAC[AFFINE_HULL_EMPTY; INTER_EMPTY; NOT_IN_EMPTY; FINITE_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; INTER_UNIV] THEN + DISCH_THEN(ASSUME_TAC o SYM o CONJUNCT2) THEN + EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; INTERS_0; INTER_UNIV; FINITE_EMPTY]; + ALL_TAC] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN + MAP_EVERY X_GEN_TAC + [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN + `!h. h IN f /\ ~(affine hull s SUBSET h) + ==> ?a' b'. ~(a' = vec 0) /\ + affine hull s INTER {x:real^N | a' dot x <= b'} = + affine hull s INTER h /\ + !w. w IN affine hull s ==> (w + a') IN affine hull s` + MP_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + REWRITE_TAC[ASSUME `(h:real^N->bool) IN f`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC o GSYM) THEN + MP_TAC(ISPECL [`affine hull s:real^N->bool`; + `(a:(real^N->bool)->real^N) h`; + `(b:(real^N->bool)->real) h`] + AFFINE_PARALLEL_SLICE) THEN + REWRITE_TAC[AFFINE_AFFINE_HULL] THEN MATCH_MP_TAC(TAUT + `~p /\ ~q /\ (r ==> r') ==> (p \/ q \/ r ==> r')`) THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_TAC THEN + UNDISCH_TAC `~(s:real^N->bool = {})` THEN + EXPAND_TAC "s" THEN REWRITE_TAC[GSYM INTERS_INSERT] THEN + MATCH_MP_TAC(SET_RULE + `!t. t SUBSET s /\ INTERS t = {} ==> INTERS s = {}`) THEN + EXISTS_TAC `{affine hull s,h:real^N->bool}` THEN + ASM_REWRITE_TAC[INTERS_2] THEN ASM SET_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + FIRST_X_ASSUM(K ALL_TAC o SPEC `{}:real^N->bool`) THEN + MAP_EVERY X_GEN_TAC + [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN + DISCH_TAC THEN + EXISTS_TAC `IMAGE (\h:real^N->bool. {x:real^N | a h dot x <= b h}) + {h | h IN f /\ ~(affine hull s SUBSET h)}` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `h:real^N->bool` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] THEN + ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[INTERS_IMAGE; IN_INTER; IN_ELIM_THM] THEN + ASM_CASES_TAC `(x:real^N) IN affine hull s` THEN + ASM_REWRITE_TAC[IN_INTERS] THEN AP_TERM_TAC THEN ABS_TAC THEN + ASM SET_TAC[]);; + +let POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL = prove + (`!s. polyhedron s <=> + ?f. FINITE f /\ + s = (affine hull s) INTER (INTERS f) /\ + (!h. h IN f + ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b} /\ + (!x. x IN affine hull s + ==> (x + a) IN affine hull s)) /\ + !f'. f' PSUBSET f ==> s PSUBSET (affine hull s) INTER (INTERS f')`, + GEN_TAC THEN REWRITE_TAC[POLYHEDRON_INTER_AFFINE_PARALLEL] THEN + EQ_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]] THEN + GEN_REWRITE_TAC LAND_CONV + [MESON[HAS_SIZE] + `(?f. FINITE f /\ P f) <=> (?n f. f HAS_SIZE n /\ P f)`] THEN + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[HAS_SIZE] THEN + X_GEN_TAC `f:(real^N->bool)->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + X_GEN_TAC `f':(real^N->bool)->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(f':(real^N->bool)->bool)`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CARD_PSUBSET]; ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM; HAS_SIZE] THEN + DISCH_THEN(MP_TAC o SPEC `f':(real^N->bool)->bool`) THEN + MATCH_MP_TAC(TAUT `a /\ c /\ (~b ==> d) ==> ~(a /\ b /\ c) ==> d`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[PSUBSET; FINITE_SUBSET]; ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = t) ==> s PSUBSET t`) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + ASM SET_TAC[]]);; + +let POLYHEDRON_INTER_AFFINE_MINIMAL = prove + (`!s. polyhedron s <=> + ?f. FINITE f /\ + s = (affine hull s) INTER (INTERS f) /\ + (!h. h IN f + ==> ?a b. ~(a = vec 0) /\ h = {x:real^N | a dot x <= b}) /\ + !f'. f' PSUBSET f ==> s PSUBSET (affine hull s) INTER (INTERS f')`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL]; + REWRITE_TAC[POLYHEDRON_INTER_AFFINE]] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN MESON_TAC[]);; + +let RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT = prove + (`!s:real^N->bool f a b. + FINITE f /\ + s = affine hull s INTER INTERS f /\ + (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ + (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') + ==> relative_interior s = + {x | x IN s /\ !h. h IN f ==> a h dot x < b h}`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [ALL_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[RELATIVE_INTERIOR; IN_ELIM_THM] THEN + EXISTS_TAC `INTERS {interior h | (h:real^N->bool) IN f}` THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; OPEN_INTERS; FINITE_IMAGE; OPEN_INTERIOR; + FORALL_IN_IMAGE; IN_INTERS] THEN + CONJ_TAC THENL + [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o CONJUNCT2) THEN + ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM]; + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + MATCH_MP_TAC(SET_RULE + `(!s. s IN f ==> i s SUBSET s) + ==> INTERS (IMAGE i f) INTER t SUBSET t INTER INTERS f`) THEN + REWRITE_TAC[INTERIOR_SUBSET]]] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:real^N->bool` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (i:real^N->bool)`) THEN ANTS_TAC THENL + [ASM SET_TAC[]; + REWRITE_TAC[PSUBSET_ALT; IN_INTER; IN_INTERS; IN_DELETE]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot z > b i` ASSUME_TAC THENL + [UNDISCH_TAC `~((z:real^N) IN s)` THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN + ASM_REWRITE_TAC[REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(z:real^N = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?l. &0 < l /\ l < &1 /\ (l % z + (&1 - l) % x:real^N) IN s` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(X_CHOOSE_THEN `e:real` MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_BALL; dist] THEN STRIP_TAC THEN + EXISTS_TAC `min (&1 / &2) (e / &2 / norm(z - x:real^N))` THEN + REWRITE_TAC[REAL_MIN_LT; REAL_LT_MIN] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH + `x - (l % z + (&1 - l) % x):real^N = --l % (z - x)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_NEG] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < a /\ &0 < b /\ b < c ==> abs(min a b) < c`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ] THEN + REWRITE_TAC[REAL_LT_01; real_div; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; + ONCE_REWRITE_TAC[VECTOR_ADD_SYM] THEN + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&1 - l` THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + REWRITE_TAC[REAL_ARITH `a < b * (&1 - l) <=> l * b + a < b`] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC + `l * (a:(real^N->bool)->real^N) i dot z + (a i dot x) * (&1 - l)` THEN + ASM_SIMP_TAC[REAL_LT_RADD; REAL_LT_LMUL_EQ; GSYM real_gt] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * (&1 - b) = (&1 - b) * a`] THEN + REWRITE_TAC[GSYM DOT_RMUL; GSYM DOT_RADD] THEN ASM SET_TAC[]);; + +let FACET_OF_POLYHEDRON_EXPLICIT = prove + (`!s:real^N->bool f a b. + FINITE f /\ + s = affine hull s INTER INTERS f /\ + (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ + (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') + ==> !c. c facet_of s <=> + ?h. h IN f /\ c = s INTER {x | a h dot x = b h}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[INTER_EMPTY; AFFINE_HULL_EMPTY; SET_RULE `~(s PSUBSET s)`; + FACET_OF_EMPTY] THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `h:real^N->bool`) THEN DISCH_THEN + (MP_TAC o SPEC `f DELETE (h:real^N->bool)` o last o CONJUNCTS) THEN + ASM SET_TAC[]; + STRIP_TAC] THEN + SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL + [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN + SUBGOAL_THEN + `!h:real^N->bool. + h IN f ==> (s INTER {x:real^N | a h dot x = b h}) facet_of s` + (LABEL_TAC "face") THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[facet_of] THEN CONJ_TAC THENL + [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + CONJ_TAC THENL + [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN + REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_EQ_EMPTY) THEN + ASM_SIMP_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_RELATIVE_INTERIOR]) THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `f DELETE (h:real^N->bool)`) THEN + ANTS_TAC THENL + [ASM SET_TAC[]; + REWRITE_TAC[PSUBSET_ALT; IN_INTER; IN_INTERS; IN_DELETE]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot z > b h` ASSUME_TAC THENL + [UNDISCH_TAC `~((z:real^N) IN s)` THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN + ASM_REWRITE_TAC[REAL_ARITH `a:real > b <=> ~(a <= b)`] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(z:real^N = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `h:real^N->bool` th) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN ASSUME_TAC th) THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot x < a h dot z` + ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `l = (b h - (a:(real^N->bool)->real^N) h dot x) / + (a h dot z - a h dot x)` THEN + SUBGOAL_THEN `&0 < l /\ l < &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "l" THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `w:real^N = (&1 - l) % x + l % z:real^N` THEN + SUBGOAL_THEN + `!i. i IN f /\ ~(i = h) ==> (a:(real^N->bool)->real^N) i dot w < b i` + ASSUME_TAC THENL + [X_GEN_TAC `i:real^N->bool` THEN STRIP_TAC THEN EXPAND_TAC "w" THEN + REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - l) * x < (&1 - l) * z /\ l * y <= l * z + ==> (&1 - l) * x + l * y < z`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_IMP_LE; + REAL_LT_LMUL_EQ; REAL_SUB_LT] THEN + UNDISCH_TAC `!t:real^N->bool. t IN f /\ ~(t = h) ==> z IN t` THEN + DISCH_THEN(MP_TAC o SPEC `i:real^N->bool`) THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) h dot w = b h` ASSUME_TAC THENL + [EXPAND_TAC "w" THEN REWRITE_TAC[VECTOR_ARITH + `(&1 - l) % x + l % z:real^N = x + l % (z - x)`] THEN + EXPAND_TAC "l" THEN REWRITE_TAC[DOT_RADD; DOT_RSUB; DOT_RMUL] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NE; REAL_SUB_0] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(w:real^N) IN s` ASSUME_TAC THENL + [FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN CONJ_TAC THENL + [EXPAND_TAC "w" THEN + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_INC THEN + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; SUBSET]; + ALL_TAC] THEN + X_GEN_TAC `i:real^N->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `i:real^N->bool = h` THENL + [ASM SET_TAC[REAL_LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN `convex(i:real^N->bool)` MP_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o C MATCH_MP + (ASSUME `(i:real^N->bool) IN f`))) THEN + REPEAT(DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th])) THEN + REWRITE_TAC[CONVEX_HALFSPACE_LE]; + ALL_TAC] THEN + REWRITE_TAC[CONVEX_ALT] THEN EXPAND_TAC "w" THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT1) THEN + FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM AFF_DIM_AFFINE_HULL] THEN + SUBGOAL_THEN + `affine hull (s INTER {x | (a:(real^N->bool)->real^N) h dot x = b h}) = + (affine hull s) INTER {x | a h dot x = b h}` + SUBST1_TAC THENL + [ALL_TAC; + SIMP_TAC[AFF_DIM_AFFINE_INTER_HYPERPLANE; AFFINE_AFFINE_HULL] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THENL [ASM SET_TAC[REAL_LT_REFL]; REFL_TAC]] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_INTER] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `s SUBSET affine hull t /\ affine hull t = t ==> s SUBSET t`) THEN + REWRITE_TAC[AFFINE_HULL_EQ; AFFINE_HYPERPLANE] THEN + MATCH_MP_TAC HULL_MONO THEN SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?t. &0 < t /\ + !j. j IN f /\ ~(j:real^N->bool = h) + ==> t * (a j dot y - a j dot w) <= b j - a j dot (w:real^N)` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `f DELETE (h:real^N->bool) = {}` THENL + [ASM_REWRITE_TAC[GSYM IN_DELETE; NOT_IN_EMPTY] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]; + ALL_TAC] THEN + EXISTS_TAC `inf (IMAGE + (\j. if &0 < a j dot y - a j dot (w:real^N) + then (b j - a j dot w) / (a j dot y - a j dot w) + else &1) (f DELETE (h:real^N->bool)))` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_DELETE; + IMAGE_EQ_EMPTY; FORALL_IN_IMAGE; IN_DELETE] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT; REAL_LT_01; COND_ID]; + REWRITE_TAC[REAL_SUB_LT] THEN DISCH_TAC] THEN + X_GEN_TAC `j:real^N->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC `a j dot (w:real^N) < a(j:real^N->bool) dot y` THENL + [ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_INF_LE_FINITE; REAL_SUB_LT; + FINITE_IMAGE; FINITE_DELETE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN EXISTS_TAC `j:real^N->bool` THEN + ASM_REWRITE_TAC[IN_DELETE; REAL_LE_REFL]; + MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ &0 < y ==> x <= y`) THEN + ASM_SIMP_TAC[REAL_SUB_LT; GSYM REAL_MUL_RNEG; REAL_LE_MUL_EQ] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + ABBREV_TAC `c:real^N = (&1 - t) % w + t % y` THEN + SUBGOAL_THEN `y:real^N = (&1 - inv t) % w + inv(t) % c` SUBST1_TAC THENL + [EXPAND_TAC "c" THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; + REAL_FIELD `&0 < x ==> inv x * (&1 - x) = inv x - &1`] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + CONJ_TAC THEN MATCH_MP_TAC HULL_INC THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [EXPAND_TAC "c" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RING; + DISCH_TAC] THEN + FIRST_ASSUM(fun t -> GEN_REWRITE_TAC RAND_CONV [t]) THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN CONJ_TAC THENL + [EXPAND_TAC "c" THEN + MATCH_MP_TAC(REWRITE_RULE[AFFINE_ALT] AFFINE_AFFINE_HULL) THEN + ASM_SIMP_TAC[HULL_INC]; + ALL_TAC] THEN + X_GEN_TAC `j:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o C MATCH_MP + (ASSUME `(j:real^N->bool) IN f`)) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC `j:real^N->bool = h` THEN ASM_SIMP_TAC[REAL_EQ_IMP_LE] THEN + EXPAND_TAC "c" THEN REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + REWRITE_TAC[REAL_ARITH + `(&1 - t) * x + t * y <= z <=> t * (y - x) <= z - x`] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `c:real^N->bool` THEN EQ_TAC THENL + [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[]] THEN + REWRITE_TAC[facet_of] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN + SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN `~(c:real^N->bool = s)` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH`~(i:int = i - &1)`]; ALL_TAC] THEN + SUBGOAL_THEN `~((x:real^N) IN relative_interior s)` ASSUME_TAC THENL + [UNDISCH_TAC `~(c:real^N->bool = s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(x:real^N) IN s` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP + FACE_OF_IMP_SUBSET) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN STRIP_TAC THEN + REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `i:real^N->bool` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot x = b i` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x <= y /\ ~(x < y) ==> x = y`) THEN + ASM_REWRITE_TAC[] THEN UNDISCH_THEN + `!t:real^N->bool. t IN f ==> x IN t` (MP_TAC o SPEC `i:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP + (ASSUME `(i:real^N->bool) IN f`)) THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `c SUBSET (s INTER {x:real^N | a(i:real^N->bool) dot x = b i})` + ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN + RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]; + ALL_TAC] THEN + SUBGOAL_THEN `c face_of (s INTER {x:real^N | a(i:real^N->bool) dot x = b i})` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`c:real^N->bool`; `s:real^N->bool`; + `s INTER {x:real^N | a(i:real^N->bool) dot x = b i}`] + FACE_OF_FACE) THEN + RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN + `aff_dim(c:real^N->bool) < + aff_dim(s INTER {x:real^N | a(i:real^N->bool) dot x = b i})` + MP_TAC THENL + [MATCH_MP_TAC FACE_OF_AFF_DIM_LT THEN + ASM_SIMP_TAC[CONVEX_INTER; CONVEX_HYPERPLANE]; + RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[INT_LT_REFL]]);; + +let FACE_OF_POLYHEDRON_SUBSET_EXPLICIT = prove + (`!s:real^N->bool f a b. + FINITE f /\ + s = affine hull s INTER INTERS f /\ + (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ + (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') + ==> !c. c face_of s /\ ~(c = {}) /\ ~(c = s) + ==> ?h. h IN f /\ c SUBSET (s INTER {x | a h dot x = b h})`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [DISCH_THEN(MP_TAC o SYM o CONJUNCT1 o CONJUNCT2) THEN + ASM_REWRITE_TAC[INTERS_0; INTER_UNIV; AFFINE_HULL_EQ] THEN + MESON_TAC[FACE_OF_AFFINE_TRIVIAL]; + ALL_TAC] THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP FACET_OF_POLYHEDRON_EXPLICIT) THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL + [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN + SUBGOAL_THEN + `!h:real^N->bool. + h IN f ==> (s INTER {x:real^N | a h dot x = b h}) face_of s` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN + REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^N`) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN `~((x:real^N) IN relative_interior s)` ASSUME_TAC THENL + [UNDISCH_TAC `~(c:real^N->bool = s)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC FACE_OF_EQ THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_SIMP_TAC[FACE_OF_REFL] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(x:real^N) IN s` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET] o MATCH_MP + FACE_OF_IMP_SUBSET) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + FIRST_ASSUM(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [t]) THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN STRIP_TAC THEN + REWRITE_TAC[NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `i:real^N->bool` THEN REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) i dot x = b i` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x <= y /\ ~(x < y) ==> x = y`) THEN + ASM_REWRITE_TAC[] THEN UNDISCH_THEN + `!t:real^N->bool. t IN f ==> x IN t` (MP_TAC o SPEC `i:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o C MATCH_MP + (ASSUME `(i:real^N->bool) IN f`)) THEN SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[FACE_OF_IMP_SUBSET] THEN + RULE_ASSUM_TAC(REWRITE_RULE[facet_of]) THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]);; + +let FACE_OF_POLYHEDRON_EXPLICIT = prove + (`!s:real^N->bool f a b. + FINITE f /\ + s = affine hull s INTER INTERS f /\ + (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ + (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') + ==> !c. c face_of s /\ ~(c = {}) /\ ~(c = s) + ==> c = INTERS {s INTER {x | a h dot x = b h} |h| + h IN f /\ + c SUBSET (s INTER {x | a h dot x = b h})}`, + let lemma = prove + (`!t s. (!a. P a ==> t SUBSET s INTER INTERS {f x | P x}) + ==> t SUBSET INTERS {s INTER f x | P x}`, + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP FACET_OF_POLYHEDRON_EXPLICIT) THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_CONVEX) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL + [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLYHEDRON_IMP_CONVEX) THEN + SUBGOAL_THEN + `!h:real^N->bool. + h IN f ==> (s INTER {x:real^N | a h dot x = b h}) face_of s` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC POLYHEDRON_IMP_CONVEX THEN + REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + X_GEN_TAC `x:real^N` THEN FIRST_X_ASSUM SUBST1_TAC THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `~(relative_interior(c:real^N->bool) = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `(z:real^N) IN s` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC FACE_OF_EQ THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC FACE_OF_INTERS THEN ASM_SIMP_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACE_OF_POLYHEDRON_SUBSET_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL[FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `{s INTER {x | a(h:real^N->bool) dot x = b h} |h| + h IN f /\ c SUBSET (s INTER {x:real^N | a h dot x = b h})} = + {s INTER {x | a(h:real^N->bool) dot x = b h} |h| + h IN f /\ z IN s INTER {x:real^N | a h dot x = b h}}` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. P x <=> Q x) ==> {f x | P x} = {f x | Q x}`) THEN + X_GEN_TAC `h:real^N->bool` THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] RELATIVE_INTERIOR_SUBSET) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUBSET_OF_FACE_OF THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[] THEN ASM SET_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `?e. &0 < e /\ !h. h IN f /\ a(h:real^N->bool) dot z < b h + ==> ball(z,e) SUBSET {w:real^N | a h dot w < b h}` + (CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THENL + [REWRITE_TAC[SET_RULE + `(!h. P h ==> s SUBSET t h) <=> s SUBSET INTERS (IMAGE t {h | P h})`] THEN + MATCH_MP_TAC(MESON[OPEN_CONTAINS_BALL] + `open s /\ x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s`) THEN + SIMP_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + MATCH_MP_TAC OPEN_INTERS THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_RESTRICT] THEN + REWRITE_TAC[OPEN_HALFSPACE_LT]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_RELATIVE_INTERIOR] THEN + ASM_SIMP_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_ELIM_THM; IN_INTER] THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC lemma THEN X_GEN_TAC `i:real^N->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [th]) THEN + MATCH_MP_TAC(SET_RULE + `ae SUBSET as /\ ae SUBSET hs /\ + b INTER hs SUBSET fs + ==> (b INTER ae) SUBSET (as INTER fs) INTER hs`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; + SIMP_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `j:real^N->bool` THEN + STRIP_TAC THEN MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[AFFINE_HYPERPLANE] THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_GSPEC] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN + X_GEN_TAC `j:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `(a:(real^N->bool)->real^N) j dot z <= b j` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[REAL_LE_LT]] THEN + STRIP_TAC THENL [ASM SET_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `(?s. s IN f /\ s SUBSET t) ==> u INTER INTERS f SUBSET t`) THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `j:real^N->bool` THEN + ASM SET_TAC[REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* More general corollaries from the explicit representation. *) +(* ------------------------------------------------------------------------- *) + +let FACET_OF_POLYHEDRON = prove + (`!s:real^N->bool c. + polyhedron s /\ c facet_of s + ==> ?a b. ~(a = vec 0) /\ + s SUBSET {x | a dot x <= b} /\ + c = s INTER {x | a dot x = b}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACET_OF_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `i:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(a:(real^N->bool)->real^N) i` THEN + EXISTS_TAC `(b:(real^N->bool)->real) i` THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + MATCH_MP_TAC(SET_RULE `t SUBSET u ==> (s INTER t) SUBSET u`) THEN + MATCH_MP_TAC(SET_RULE `t IN f ==> INTERS f SUBSET t`) THEN ASM_MESON_TAC[]);; + +let FACE_OF_POLYHEDRON = prove + (`!s:real^N->bool c. + polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s) + ==> c = INTERS {f | f facet_of s /\ c SUBSET f}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACET_OF_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACE_OF_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]);; + +let FACE_OF_POLYHEDRON_SUBSET_FACET = prove + (`!s:real^N->bool c. + polyhedron s /\ c face_of s /\ ~(c = {}) /\ ~(c = s) + ==> ?f. f facet_of s /\ c SUBSET f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FACE_OF_IMP_SUBSET) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `c:real^N->bool`] FACE_OF_POLYHEDRON) THEN + ASM_CASES_TAC `{f:real^N->bool | f facet_of s /\ c SUBSET f} = {}` THEN + ASM SET_TAC[]);; + +let EXPOSED_FACE_OF_POLYHEDRON = prove + (`!s f:real^N->bool. polyhedron s ==> (f exposed_face_of s <=> f face_of s)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL [SIMP_TAC[exposed_face_of]; ALL_TAC] THEN + DISCH_TAC THEN ASM_CASES_TAC `f:real^N->bool = {}` THEN + ASM_REWRITE_TAC[EMPTY_EXPOSED_FACE_OF] THEN + ASM_CASES_TAC `f:real^N->bool = s` THEN + ASM_SIMP_TAC[EXPOSED_FACE_OF_REFL; POLYHEDRON_IMP_CONVEX] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:real^N->bool`] FACE_OF_POLYHEDRON) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC EXPOSED_FACE_OF_INTERS THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[FACE_OF_POLYHEDRON_SUBSET_FACET; IN_ELIM_THM] THEN + ASM_SIMP_TAC[exposed_face_of; FACET_OF_IMP_FACE_OF] THEN + ASM_MESON_TAC[FACET_OF_POLYHEDRON]);; + +let FACE_OF_POLYHEDRON_POLYHEDRON = prove + (`!s:real^N->bool c. polyhedron s /\ c face_of s ==> polyhedron c`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACE_OF_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `c:real^N->bool = {}` THEN + ASM_REWRITE_TAC[POLYHEDRON_EMPTY] THEN + ASM_CASES_TAC `c:real^N->bool = s` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC POLYHEDRON_INTERS THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_ID] THEN + MATCH_MP_TAC POLYHEDRON_INTER THEN + ASM_REWRITE_TAC[POLYHEDRON_HYPERPLANE]);; + +let FINITE_POLYHEDRON_FACES = prove + (`!s:real^N->bool. polyhedron s ==> FINITE {f | f face_of s}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + STRIP_TAC THEN + MATCH_MP_TAC(MESON[FINITE_DELETE] + `!a b. FINITE (s DELETE a DELETE b) ==> FINITE s`) THEN + MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `s:real^N->bool`] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `{INTERS {s INTER {x:real^N | a(h:real^N->bool) dot x = b h} | h | h IN f'} + |f'| f' SUBSET f}` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FINITE_POWERSET; FINITE_IMAGE] THEN + GEN_REWRITE_TAC I [SUBSET] THEN REWRITE_TAC[IN_DELETE; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACE_OF_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `c:real^N->bool` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN EXISTS_TAC + `{h:real^N->bool | + h IN f /\ c SUBSET s INTER {x:real^N | a h dot x = b h}}` THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_ASSUM ACCEPT_TAC);; + +let FINITE_POLYHEDRON_EXPOSED_FACES = prove + (`!s:real^N->bool. polyhedron s ==> FINITE {f | f exposed_face_of s}`, + SIMP_TAC[EXPOSED_FACE_OF_POLYHEDRON; FINITE_POLYHEDRON_FACES]);; + +let FINITE_POLYHEDRON_EXTREME_POINTS = prove + (`!s:real^N->bool. polyhedron s ==> FINITE {v | v extreme_point_of s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FACE_OF_SING] THEN + ONCE_REWRITE_TAC[SET_RULE `{v} face_of s <=> {v} IN {f | f face_of s}`] THEN + MATCH_MP_TAC FINITE_FINITE_PREIMAGE THEN + ASM_SIMP_TAC[FINITE_POLYHEDRON_FACES] THEN X_GEN_TAC `f:real^N->bool` THEN + DISCH_TAC THEN ASM_CASES_TAC `!a:real^N. ~({a} = f)` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[SET_RULE `{v | {v} = {a}} = {a}`; FINITE_SING]);; + +let FINITE_POLYHEDRON_FACETS = prove + (`!s:real^N->bool. polyhedron s ==> FINITE {f | f facet_of s}`, + REWRITE_TAC[facet_of] THEN ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_POLYHEDRON_FACES]);; + +let RELATIVE_INTERIOR_OF_POLYHEDRON = prove + (`!s:real^N->bool. + polyhedron s + ==> relative_interior s = s DIFF UNIONS {f | f facet_of s}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_INTER_AFFINE_MINIMAL]) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + FACET_OF_POLYHEDRON_EXPLICIT) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `f:(real^N->bool)->bool`; + `a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] + RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> P x \/ x IN t) /\ (!x. x IN t ==> ~P x) + ==> {x | x IN s /\ P x} = s DIFF t`) THEN + REWRITE_TAC[FORALL_IN_UNIONS] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; TAUT `(a /\ b) /\ c <=> b /\ a /\ c`] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ASM_REWRITE_TAC[UNWIND_THM2; IN_ELIM_THM; IN_INTER] THEN + MATCH_MP_TAC(SET_RULE + `(!x. P x ==> Q x \/ R x) ==> (!x. P x ==> Q x) \/ (?x. P x /\ R x)`) THEN + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_LE_LT] THEN + SUBGOAL_THEN `(x:real^N) IN INTERS f` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN + SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` MP_TAC THENL + [ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN SET_TAC[]]; + X_GEN_TAC `h:real^N->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + ASM_MESON_TAC[REAL_LT_REFL]]);; + +let RELATIVE_BOUNDARY_OF_POLYHEDRON = prove + (`!s:real^N->bool. + polyhedron s + ==> s DIFF relative_interior s = UNIONS {f | f facet_of s}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RELATIVE_INTERIOR_OF_POLYHEDRON] THEN + MATCH_MP_TAC(SET_RULE `f SUBSET s ==> s DIFF (s DIFF f) = f`) THEN + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN + MESON_TAC[FACET_OF_IMP_SUBSET; SUBSET]);; + +let RELATIVE_FRONTIER_OF_POLYHEDRON = prove + (`!s:real^N->bool. + polyhedron s ==> relative_frontier s = UNIONS {f | f facet_of s}`, + SIMP_TAC[relative_frontier; POLYHEDRON_IMP_CLOSED; CLOSURE_CLOSED] THEN + REWRITE_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON]);; + +let RELATIVE_FRONTIER_OF_POLYHEDRON_ALT = prove + (`!s:real^N->bool. + polyhedron s + ==> relative_frontier s = UNIONS {f | f face_of s /\ ~(f = s)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ASM_SIMP_TAC[RELATIVE_FRONTIER_OF_POLYHEDRON; facet_of] THEN + MATCH_MP_TAC SUBSET_UNIONS THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN + MESON_TAC[INT_ARITH `~(f - &1:int = f)`]; + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM] THEN + MESON_TAC[REWRITE_RULE[SUBSET] FACE_OF_SUBSET_RELATIVE_FRONTIER]]);; + +let FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT = prove + (`!s:real^N->bool f a b. + FINITE f /\ + s = affine hull s INTER INTERS f /\ + (!h. h IN f ==> ~(a h = vec 0) /\ h = {x | a h dot x <= b h}) /\ + (!f'. f' PSUBSET f ==> s PSUBSET affine hull s INTER INTERS f') + ==> !h1 h2. h1 IN f /\ h2 IN f /\ + s INTER {x | a h1 dot x = b h1} = + s INTER {x | a h2 dot x = b h2} + ==> h1 = h2`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[AFFINE_HULL_EMPTY; INTER_EMPTY; PSUBSET_IRREFL] THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_MESON_TAC[SET_RULE `~(s = {}) ==> {} PSUBSET s`]; + STRIP_TAC] THEN + SUBGOAL_THEN `polyhedron(s:real^N->bool)` ASSUME_TAC THENL + [REWRITE_TAC[POLYHEDRON_INTER_AFFINE] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(relative_interior s:real^N->bool = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYHEDRON_IMP_CONVEX]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC)] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[PSUBSET_ALT]] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `x:real^N` MP_TAC)) THEN + REWRITE_TAC[IN_INTER; IN_INTERS; IN_DELETE] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`segment[x:real^N,z]`; `s:real^N->bool`] + CONNECTED_INTER_RELATIVE_FRONTIER) THEN + PURE_REWRITE_TAC[relative_frontier] THEN ANTS_TAC THENL + [REWRITE_TAC[CONNECTED_SEGMENT; GSYM MEMBER_NOT_EMPTY] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[CONVEX_CONTAINS_SEGMENT; AFFINE_AFFINE_HULL; + HULL_INC; AFFINE_IMP_CONVEX]; + EXISTS_TAC `z:real^N` THEN ASM_REWRITE_TAC[IN_INTER; ENDS_IN_SEGMENT]; + EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[IN_DIFF; ENDS_IN_SEGMENT]]; + ALL_TAC] THEN + PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; CLOSURE_CLOSED; + LEFT_IMP_EXISTS_THM; IN_INTER] THEN + X_GEN_TAC `y:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC(REWRITE_RULE[IN_DIFF] th) THEN + MP_TAC th) THEN + ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON] THEN + MP_TAC(ISPECL + [`s:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[] THEN ASM_MESON_TAC[]; + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[th])] THEN + REWRITE_TAC[SET_RULE `{y | ?x. x IN s /\ y = f x} = IMAGE f s`] THEN + REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?k:real^N->bool. k IN f /\ ~(k = h2) /\ a k dot (y:real^N) = b k` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `h:real^N->bool = h2` THENL + [EXISTS_TAC `h1:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `s INTER {x:real^N | a(h1:real^N->bool) dot x = b h1} = + s INTER {x | a h2 dot x = b h2}` THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(a:(real^N->bool)->real^N) k dot z < b k /\ a k dot x <= b k` + STRIP_ASSUME_TAC THENL [ASM_SIMP_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `y IN segment(x:real^N,z)` MP_TAC THENL + [ASM_REWRITE_TAC[IN_OPEN_SEGMENT_ALT] THEN ASM_MESON_TAC[]; + REWRITE_TAC[IN_SEGMENT] THEN STRIP_TAC] THEN + UNDISCH_TAC `(a:(real^N->bool)->real^N) k dot y = b k` THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `(&1 - u) * x <= (&1 - u) * b /\ u * y < u * b + ==> ~((&1 - u) * x + u * y = b)`) THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_SUB_LT]);; + +(* ------------------------------------------------------------------------- *) +(* A characterization of polyhedra as having finitely many faces. *) +(* ------------------------------------------------------------------------- *) + +let POLYHEDRON_EQ_FINITE_EXPOSED_FACES = prove + (`!s:real^N->bool. + polyhedron s <=> closed s /\ convex s /\ FINITE {f | f exposed_face_of s}`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX; + FINITE_POLYHEDRON_EXPOSED_FACES] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[POLYHEDRON_EMPTY] THEN + ABBREV_TAC + `f = {h:real^N->bool | h exposed_face_of s /\ ~(h = {}) /\ ~(h = s)}` THEN + SUBGOAL_THEN `FINITE(f:(real^N->bool)->bool)` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT]; + ALL_TAC] THEN + SUBGOAL_THEN + `!h:real^N->bool. + h IN f + ==> h face_of s /\ + ?a b. ~(a = vec 0) /\ + s SUBSET {x | a dot x <= b} /\ + h = s INTER {x | a dot x = b}` + MP_TAC THENL + [EXPAND_TAC "f" THEN REWRITE_TAC[EXPOSED_FACE_OF; IN_ELIM_THM] THEN + MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; FORALL_AND_THM; + TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a:(real^N->bool)->real^N` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b:(real^N->bool)->real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `s = affine hull s INTER + INTERS {{x:real^N | a(h:real^N->bool) dot x <= b h} | h IN f}` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC POLYHEDRON_INTER THEN REWRITE_TAC[POLYHEDRON_AFFINE_HULL] THEN + MATCH_MP_TAC POLYHEDRON_INTERS THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; POLYHEDRON_HALFSPACE_LE]] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET_INTER; HULL_SUBSET; + SET_RULE `s SUBSET INTERS f <=> !h. h IN f ==> s SUBSET h`] THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_INTERS; FORALL_IN_GSPEC] THEN + X_GEN_TAC `p:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + SUBGOAL_THEN `~(relative_interior(s:real^N->bool) = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY]; + GEN_REWRITE_TAC LAND_CONV [GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N`)] THEN + SUBGOAL_THEN + `?x:real^N. x IN segment[c,p] /\ x IN (s DIFF relative_interior s)` + MP_TAC THENL + [MP_TAC(ISPEC `segment[c:real^N,p]` CONNECTED_OPEN_IN) THEN + REWRITE_TAC[CONNECTED_SEGMENT; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPECL + [`segment[c:real^N,p] INTER relative_interior s`; + `segment[c:real^N,p] INTER (UNIV DIFF s)`]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[IN_DIFF; NOT_EXISTS_THM] THEN DISCH_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_SUBTOPOLOGY_INTER_SUBSET THEN + EXISTS_TAC `affine hull s:real^N->bool` THEN + SIMP_TAC[OPEN_IN_RELATIVE_INTERIOR; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; + OPEN_IN_SUBTOPOLOGY_REFL; SUBSET_UNIV; OPEN_IN_INTER; + TOPSPACE_EUCLIDEAN] THEN + REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN MATCH_MP_TAC HULL_MINIMAL THEN + SIMP_TAC[AFFINE_IMP_CONVEX; AFFINE_AFFINE_HULL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + ASM_MESON_TAC[RELATIVE_INTERIOR_SUBSET; HULL_INC; SUBSET]; + REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `(:real^N) DIFF s` THEN + ASM_REWRITE_TAC[GSYM closed]; + MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN ASM SET_TAC[]; + MP_TAC(ISPEC `s:real^N->bool` RELATIVE_INTERIOR_SUBSET) THEN SET_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + ASM_MESON_TAC[ENDS_IN_SEGMENT]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_DIFF; IN_INTER; IN_UNIV] THEN + ASM_MESON_TAC[ENDS_IN_SEGMENT]]; + REWRITE_TAC[IN_SEGMENT; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `l:real` MP_TAC) THEN + ASM_CASES_TAC `l = &0` THEN + ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_MUL_LZERO; REAL_SUB_RZERO; + VECTOR_MUL_LID; IN_DIFF] THEN + ASM_CASES_TAC `l = &1` THEN + ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; REAL_SUB_REFL; + VECTOR_MUL_LID; IN_DIFF] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC] THEN + ABBREV_TAC `x:real^N = (&1 - l) % c + l % p` THEN + SUBGOAL_THEN `?h:real^N->bool. h IN f /\ x IN h` STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `(&1 - l) % c + l % p:real^N`] + SUPPORTING_HYPERPLANE_RELATIVE_FRONTIER) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N` STRIP_ASSUME_TAC) THEN + EXPAND_TAC "f" THEN + EXISTS_TAC `s INTER {y:real^N | d dot y = d dot x}` THEN + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC EXPOSED_FACE_OF_INTER_SUPPORTING_HYPERPLANE_GE THEN + ASM_SIMP_TAC[real_ge; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; + ASM SET_TAC[]; + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN + ASM_MESON_TAC[SUBSET; REAL_LT_REFL; RELATIVE_INTERIOR_SUBSET]]; + ALL_TAC] THEN + SUBGOAL_THEN `{y:real^N | a(h:real^N->bool) dot y = b h} face_of + {y | a h dot y <= b h}` + MP_TAC THENL + [MATCH_MP_TAC(MESON[] + `(t INTER s) face_of t /\ t INTER s = s ==> s face_of t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC FACE_OF_INTER_SUPPORTING_HYPERPLANE_LE THEN + REWRITE_TAC[IN_ELIM_THM; CONVEX_HALFSPACE_LE]; + SET_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + REWRITE_TAC[face_of] THEN + DISCH_THEN(MP_TAC o SPECL [`c:real^N`; `p:real^N`; `x:real^N`] o + CONJUNCT2 o CONJUNCT2) THEN + ASM_SIMP_TAC[IN_ELIM_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + RELATIVE_INTERIOR_SUBSET)) THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM SET_TAC[]; + REWRITE_TAC[IN_SEGMENT] THEN ASM SET_TAC[]; + STRIP_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `h:real^N->bool`; `s:real^N->bool`] + SUBSET_OF_FACE_OF) THEN + ASM SET_TAC[]);; + +let POLYHEDRON_EQ_FINITE_FACES = prove + (`!s:real^N->bool. + polyhedron s <=> + closed s /\ convex s /\ FINITE {f | f face_of s}`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_IMP_CONVEX; + FINITE_POLYHEDRON_FACES] THEN + REWRITE_TAC[POLYHEDRON_EQ_FINITE_EXPOSED_FACES] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{f:real^N->bool | f face_of s}` THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; exposed_face_of]);; + +let POLYHEDRON_TRANSLATION_EQ = prove + (`!a s. polyhedron (IMAGE (\x:real^N. a + x) s) <=> polyhedron s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_FACES] THEN + REWRITE_TAC[CLOSED_TRANSLATION_EQ] THEN AP_TERM_TAC THEN + REWRITE_TAC[CONVEX_TRANSLATION_EQ] THEN AP_TERM_TAC THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. a + x)` QUANTIFY_SURJECTION_THM) THEN + REWRITE_TAC[SURJECTIVE_IMAGE; EXISTS_REFL; + VECTOR_ARITH `a + x:real^N = y <=> x = y - a`] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[FACE_OF_TRANSLATION_EQ] THEN + MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN + MATCH_MP_TAC(MESON[] + `(!x y. Q x y ==> R x y) ==> (!x y. P x /\ P y /\ Q x y ==> R x y)`) THEN + REWRITE_TAC[INJECTIVE_IMAGE] THEN VECTOR_ARITH_TAC);; + +add_translation_invariants [POLYHEDRON_TRANSLATION_EQ];; + +let POLYHEDRON_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> (polyhedron (IMAGE f s) <=> polyhedron s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[POLYHEDRON_EQ_FINITE_FACES] THEN + BINOP_TAC THENL + [ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]; ALL_TAC] THEN + BINOP_TAC THENL [ASM_MESON_TAC[CONVEX_LINEAR_IMAGE_EQ]; ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE (f:real^M->real^N)` QUANTIFY_SURJECTION_THM) THEN + ASM_REWRITE_TAC[SURJECTIVE_IMAGE] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + MP_TAC(ISPEC `f:real^M->real^N` FACE_OF_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I [GSYM INJECTIVE_IMAGE]) THEN + ASM_REWRITE_TAC[IMP_CONJ]);; + +add_linear_invariants [POLYHEDRON_LINEAR_IMAGE_EQ];; + +let POLYHEDRON_NEGATIONS = prove + (`!s:real^N->bool. polyhedron s ==> polyhedron(IMAGE (--) s)`, + GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE_EQ THEN + REWRITE_TAC[VECTOR_ARITH `--x:real^N = y <=> x = --y`; EXISTS_REFL] THEN + REWRITE_TAC[LINEAR_NEGATION] THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Relation between polytopes and polyhedra. *) +(* ------------------------------------------------------------------------- *) + +let POLYTOPE_EQ_BOUNDED_POLYHEDRON = prove + (`!s:real^N->bool. polytope s <=> polyhedron s /\ bounded s`, + GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[FINITE_POLYTOPE_FACES; POLYHEDRON_EQ_FINITE_FACES; + POLYTOPE_IMP_CLOSED; POLYTOPE_IMP_CONVEX; POLYTOPE_IMP_BOUNDED]; + STRIP_TAC THEN REWRITE_TAC[polytope] THEN + EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN + ASM_SIMP_TAC[FINITE_POLYHEDRON_EXTREME_POINTS] THEN + MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN + ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; POLYHEDRON_IMP_CLOSED; + POLYHEDRON_IMP_CONVEX]]);; + +let POLYTOPE_INTER = prove + (`!s t. polytope s /\ polytope t ==> polytope(s INTER t)`, + SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER; BOUNDED_INTER]);; + +let POLYTOPE_INTER_POLYHEDRON = prove + (`!s t:real^N->bool. polytope s /\ polyhedron t ==> polytope(s INTER t)`, + SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER] THEN + MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; + +let POLYHEDRON_INTER_POLYTOPE = prove + (`!s t:real^N->bool. polyhedron s /\ polytope t ==> polytope(s INTER t)`, + SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON; POLYHEDRON_INTER] THEN + MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; + +let POLYTOPE_IMP_POLYHEDRON = prove + (`!p. polytope p ==> polyhedron p`, + SIMP_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON]);; + +let POLYTOPE_FACET_EXISTS = prove + (`!p:real^N->bool. polytope p /\ &0 < aff_dim p ==> ?f. f facet_of p`, + GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN + MP_TAC(ISPEC `p:real^N->bool` EXTREME_POINT_EXISTS_CONVEX) THEN + ASM_SIMP_TAC[POLYTOPE_IMP_COMPACT; POLYTOPE_IMP_CONVEX] THEN + DISCH_THEN(X_CHOOSE_TAC `v:real^N`) THEN + MP_TAC(ISPECL [`p:real^N->bool`; `{v:real^N}`] + FACE_OF_POLYHEDRON_SUBSET_FACET) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON; FACE_OF_SING; NOT_INSERT_EMPTY] THEN + ASM_MESON_TAC[AFF_DIM_SING; INT_LT_REFL]);; + +let POLYHEDRON_INTERVAL = prove + (`!a b. polyhedron(interval[a,b])`, + MESON_TAC[POLYTOPE_IMP_POLYHEDRON; POLYTOPE_INTERVAL]);; + +let POLYHEDRON_CONVEX_HULL = prove + (`!s. FINITE s ==> polyhedron(convex hull s)`, + SIMP_TAC[POLYTOPE_CONVEX_HULL; POLYTOPE_IMP_POLYHEDRON]);; + +(* ------------------------------------------------------------------------- *) +(* Polytope is union of convex hulls of facets plus any point inside. *) +(* ------------------------------------------------------------------------- *) + +let POLYTOPE_UNION_CONVEX_HULL_FACETS = prove + (`!s p:real^N->bool. + polytope p /\ &0 < aff_dim p /\ ~(s = {}) /\ s SUBSET p + ==> p = UNIONS { convex hull (s UNION f) | f facet_of p}`, + let lemma = SET_RULE `{f x | p x} = {y | ?x. p x /\ y = f x}` in + MATCH_MP_TAC SET_PROVE_CASES THEN REWRITE_TAC[] THEN + X_GEN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[lemma] THEN + GEOM_ORIGIN_TAC `a:real^N` THEN ONCE_REWRITE_TAC[GSYM lemma] THEN + X_GEN_TAC `s:real^N->bool` THEN DISCH_THEN(K ALL_TAC) THEN + MP_TAC(SET_RULE `(vec 0:real^N) IN (vec 0 INSERT s)`) THEN + SPEC_TAC(`(vec 0:real^N) INSERT s`,`s:real^N->bool`) THEN + X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN + X_GEN_TAC `p:real^N->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [POLYTOPE_EQ_BOUNDED_POLYHEDRON]) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_GSPEC; RIGHT_FORALL_IMP_THM] THEN + X_GEN_TAC `f:real^N->bool` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull p:real^N->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FACET_OF_IMP_SUBSET) THEN ASM SET_TAC[]; + ASM_MESON_TAC[CONVEX_HULL_EQ; POLYHEDRON_IMP_CONVEX; SUBSET_REFL]]] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `v:real^N = vec 0` THENL + [MP_TAC(ISPEC `p:real^N->bool` POLYTOPE_FACET_EXISTS) THEN + ASM_REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[HULL_INC; IN_UNION]; + ALL_TAC] THEN + SUBGOAL_THEN `?t. &1 < t /\ ~((t % v:real^N) IN p)` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `max (&2) ((B + &1) / norm (v:real^N))` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o + GEN_REWRITE_RULE BINDER_CONV [GSYM CONTRAPOS_THM]) THEN + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LE_RDIV_EQ; NORM_POS_LT] THEN + MATCH_MP_TAC(REAL_ARITH `a < b ==> ~(abs(max (&2) b) <= a)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; NORM_POS_LT] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(vec 0:real^N) IN p` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`segment[vec 0,t % v:real^N] INTER p`; `vec 0:real^N`] + DISTANCE_ATTAINS_SUP) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[COMPACT_INTER_CLOSED; POLYHEDRON_IMP_CLOSED; COMPACT_SEGMENT; + GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + ASM_MESON_TAC[ENDS_IN_SEGMENT]; + REWRITE_TAC[IN_INTER; GSYM CONJ_ASSOC; IMP_CONJ] THEN + REWRITE_TAC[segment; FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; DIST_0] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; NORM_MUL; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; NORM_POS_LT; LEFT_IMP_EXISTS_THM; + REAL_ARITH `&1 < t ==> &0 < abs t`] THEN + X_GEN_TAC `u:real` THEN + ASM_CASES_TAC `u = &1` THEN ASM_REWRITE_TAC[VECTOR_MUL_LID] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[real_abs] THEN DISCH_TAC] THEN + SUBGOAL_THEN `inv(t) <= u` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_INV_LE_1; REAL_LT_IMP_LE; REAL_LE_INV_EQ; + REAL_ARITH `&1 < t ==> &0 <= t`] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; + REAL_ARITH `&1 < t ==> ~(t = &0)`]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH `&1 < t ==> &0 < t`)) THEN + SUBGOAL_THEN `&0 < u /\ u < &1` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE] THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + UNDISCH_TAC `inv t <= &0` THEN REWRITE_TAC[REAL_NOT_LE] THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN + EXISTS_TAC `convex hull {vec 0:real^N,u % t % v}` THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[CONVEX_HULL_2; VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`&1 - inv(u * t)`; `inv(u * t):real`] THEN + REWRITE_TAC[REAL_ARITH `&1 - x + x = &1`; REAL_SUB_LE; REAL_LE_INV_EQ] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_ENTIRE; REAL_MUL_LINV; + REAL_LT_IMP_NZ; VECTOR_MUL_LID] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LID]] THEN + SUBGOAL_THEN + `(u % t % v:real^N) IN (p DIFF relative_interior p)` + MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[RELATIVE_INTERIOR_OF_POLYHEDRON] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `x IN s DIFF (s DIFF t) ==> x IN t`)) THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `(?s. s IN f /\ t SUBSET s) ==> t SUBSET UNIONS f`) THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `f:real^N->bool` THEN + ASM_SIMP_TAC[SUBSET_HULL; CONVEX_CONVEX_HULL] THEN + ASM_SIMP_TAC[HULL_INC; IN_UNION; INSERT_SUBSET; EMPTY_SUBSET]] THEN + ASM_REWRITE_TAC[IN_DIFF; IN_RELATIVE_INTERIOR] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_INTER; dist] THEN + ABBREV_TAC `k = min (e / &2 / norm(t % v:real^N)) (&1 - u)` THEN + SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN REWRITE_TAC[REAL_LT_MIN] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN MATCH_MP_TAC REAL_LT_DIV THEN + ASM_SIMP_TAC[REAL_HALF; NORM_POS_LT; VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `(u + k) % t % v:real^N`) THEN + REWRITE_TAC[VECTOR_ARITH `u % x - (u + k) % x:real^N = --k % x`] THEN + ONCE_REWRITE_TAC[NORM_MUL] THEN REWRITE_TAC[REAL_ABS_NEG; NOT_IMP] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_MUL_EQ_0; + REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE] THEN + EXPAND_TAC "k" THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + REPEAT(MATCH_MP_TAC SPAN_MUL) THEN ASM_SIMP_TAC[SPAN_SUPERSET]; + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u + k:real`) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= u /\ &0 < x /\ x <= &1 - u + ==> (&0 <= u + x /\ u + x <= &1) /\ ~(u + x <= u)`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "k" THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Finitely generated cone is polyhedral, and hence closed. *) +(* ------------------------------------------------------------------------- *) + +let POLYHEDRON_CONVEX_CONE_HULL = prove + (`!s:real^N->bool. FINITE s ==> polyhedron(convex_cone hull s)`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN DISCH_TAC THENL + [ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY] THEN + ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON; POLYTOPE_SING]; + ALL_TAC] THEN + SUBGOAL_THEN + `polyhedron(convex hull ((vec 0:real^N) INSERT s))` + MP_TAC THENL + [MATCH_MP_TAC POLYTOPE_IMP_POLYHEDRON THEN + REWRITE_TAC[polytope] THEN ASM_MESON_TAC[FINITE_INSERT]; + REWRITE_TAC[polyhedron] THEN + DISCH_THEN(X_CHOOSE_THEN `f:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[SKOLEM_THM; RIGHT_IMP_EXISTS_THM]) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:(real^N->bool)->real^N` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `b:(real^N->bool)->real`)] THEN + SUBGOAL_THEN `~(f:(real^N->bool)->bool = {})` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE RAND_CONV [INTERS_0]) THEN + DISCH_THEN(MP_TAC o AP_TERM `bounded:(real^N->bool)->bool`) THEN + ASM_SIMP_TAC[NOT_BOUNDED_UNIV; BOUNDED_CONVEX_HULL; FINITE_IMP_BOUNDED; + FINITE_INSERT; FINITE_EMPTY]; + ALL_TAC] THEN + EXISTS_TAC `{h:real^N->bool | h IN f /\ b h = &0}` THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `h:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC + [`(a:(real^N->bool)->real^N) h`; `(b:(real^N->bool)->real) h`] THEN + ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull ((vec 0:real^N) INSERT s)` THEN CONJ_TAC THENL + [SIMP_TAC[SUBSET; HULL_INC; IN_INSERT]; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> INTERS t SUBSET INTERS s`) THEN + SET_TAC[]; + MATCH_MP_TAC CONVEX_CONE_INTERS THEN + X_GEN_TAC `h:real^N->bool` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN + REWRITE_TAC[CONVEX_CONE_HALFSPACE_LE]]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTERS; IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN + SUBGOAL_THEN `!h:real^N->bool. h IN f ==> ?t. &0 < t /\ (t % x) IN h` + MP_TAC THENL + [X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `(b:(real^N->bool)->real) h = &0` THENL + [EXISTS_TAC `&1` THEN ASM_SIMP_TAC[REAL_LT_01; VECTOR_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (b:(real^N->bool)->real) h` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_LE] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `vec 0:real^N`) THEN + SIMP_TAC[HULL_INC; IN_INSERT; IN_INTERS] THEN + DISCH_THEN(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) + THENL [ASM_MESON_TAC[]; REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]]; + ALL_TAC] THEN + SUBGOAL_THEN `(vec 0:real^N) IN interior h` MP_TAC THENL + [SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` SUBST1_TAC THENL + [ASM_MESON_TAC[]; + ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; IN_ELIM_THM; DOT_RZERO]]; + REWRITE_TAC[IN_INTERIOR; SUBSET; IN_BALL_0; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [EXISTS_TAC `&1` THEN + ASM_SIMP_TAC[VECTOR_MUL_RZERO; REAL_LT_01; NORM_0]; + EXISTS_TAC `e / &2 / norm(x:real^N)` THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:(real^N->bool)->real` THEN DISCH_TAC THEN + SUBGOAL_THEN `x:real^N = inv(inf(IMAGE t (f:(real^N->bool)->bool))) % + inf(IMAGE t f) % x` + SUBST1_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE]; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONVEX_CONE_HULL) THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LE_INF_FINITE; FINITE_IMAGE; + IMAGE_EQ_EMPTY; REAL_LT_IMP_LE; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(SET_RULE `!s t. s SUBSET t /\ x IN s ==> x IN t`) THEN + EXISTS_TAC `convex hull ((vec 0:real^N) INSERT s)` THEN CONJ_TAC THENL + [MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONVEX_CONE_HULL] THEN + ASM_SIMP_TAC[INSERT_SUBSET; HULL_SUBSET; CONVEX_CONE_HULL_CONTAINS_0]; + ASM_REWRITE_TAC[IN_INTERS] THEN X_GEN_TAC `h:real^N->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN `inf(IMAGE (t:(real^N->bool)->real) f) % x:real^N = + (&1 - inf(IMAGE t f) / t h) % vec 0 + + (inf(IMAGE t f) / t h) % t h % x` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_MUL_RZERO; VECTOR_ADD_LID; + REAL_DIV_RMUL; REAL_LT_IMP_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC IN_CONVEX_SET THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_INF_LE_FINITE; REAL_LE_INF_FINITE; + FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `h = {x:real^N | a h dot x <= b h}` SUBST1_TAC THENL + [ASM_MESON_TAC[]; ASM_SIMP_TAC[CONVEX_HALFSPACE_LE]]; + SUBGOAL_THEN `(vec 0:real^N) IN convex hull (vec 0 INSERT s)` MP_TAC + THENL [SIMP_TAC[HULL_INC; IN_INSERT]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_INTERS] THEN ASM_MESON_TAC[]; + ASM SET_TAC[REAL_LE_REFL]]]);; + +let CLOSED_CONVEX_CONE_HULL = prove + (`!s:real^N->bool. FINITE s ==> closed(convex_cone hull s)`, + MESON_TAC[POLYHEDRON_IMP_CLOSED; POLYHEDRON_CONVEX_CONE_HULL]);; + +(* ------------------------------------------------------------------------- *) +(* And conversely, a polyhedral cone is finitely generated. *) +(* ------------------------------------------------------------------------- *) + +let FINITELY_GENERATED_CONIC_POLYHEDRON = prove + (`!s:real^N->bool. + polyhedron s /\ conic s /\ ~(s = {}) + ==> ?c. FINITE c /\ s = convex_cone hull c`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?p:real^N->bool. polytope p /\ vec 0 IN interior p` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `interval[--vec 1:real^N,vec 1:real^N]` THEN + REWRITE_TAC[POLYTOPE_INTERVAL; INTERIOR_CLOSED_INTERVAL] THEN + SIMP_TAC[IN_INTERVAL; VECTOR_NEG_COMPONENT; VEC_COMPONENT] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `polytope(s INTER p:real^N->bool)` MP_TAC THENL + [REWRITE_TAC[POLYTOPE_EQ_BOUNDED_POLYHEDRON] THEN + ASM_SIMP_TAC[BOUNDED_INTER; POLYTOPE_IMP_BOUNDED]THEN + ASM_SIMP_TAC[POLYHEDRON_INTER; POLYTOPE_IMP_POLYHEDRON]; + REWRITE_TAC[polytope] THEN MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[SUBSET_HULL; POLYHEDRON_IMP_CONVEX; convex_cone] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `s INTER p:real^N->bool` THEN + REWRITE_TAC[INTER_SUBSET] THEN ASM_REWRITE_TAC[HULL_SUBSET]] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `?t. &0 < t /\ (t % x:real^N) IN p` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR]) THEN + REWRITE_TAC[SUBSET; IN_BALL_0; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[VECTOR_MUL_RZERO; REAL_LT_01] THEN + ASM_SIMP_TAC[NORM_0]; + EXISTS_TAC `e / &2 / norm(x:real^N)` THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; NORM_POS_LT] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `x:real^N = inv t % t % x` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; + REAL_LT_IMP_NZ]; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[conic] CONIC_CONVEX_CONE_HULL) THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN + EXISTS_TAC `convex hull c:real^N->bool` THEN + REWRITE_TAC[CONVEX_HULL_SUBSET_CONVEX_CONE_HULL] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[IN_INTER] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [conic]) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Decomposition of polyhedron into cone plus polytope and more corollaries. *) +(* ------------------------------------------------------------------------- *) + +let POLYHEDRON_POLYTOPE_SUMS = prove + (`!s t:real^N->bool. + polyhedron s /\ polytope t ==> polyhedron {x + y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[POLYHEDRON_EQ_FINITE_EXPOSED_FACES] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CLOSED_COMPACT_SUMS THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CLOSED; POLYTOPE_IMP_COMPACT]; + MATCH_MP_TAC CONVEX_SUMS THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX; POLYTOPE_IMP_CONVEX]; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{ {x + y:real^N | x IN k /\ y IN l} | + k exposed_face_of s /\ l exposed_face_of t}` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `k exposed_face_of s <=> + k IN {f | f exposed_face_of s}`] THEN + MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN + ASM_SIMP_TAC[FINITE_POLYHEDRON_EXPOSED_FACES; + POLYTOPE_IMP_POLYHEDRON]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC EXPOSED_FACE_OF_SUMS THEN + ASM_SIMP_TAC[POLYHEDRON_IMP_CONVEX; POLYTOPE_IMP_CONVEX]]]);; + +let POLYHEDRON_AS_CONE_PLUS_CONV = prove + (`!s:real^N->bool. + polyhedron s <=> ?t u. FINITE t /\ FINITE u /\ + s = {x + y | x IN convex_cone hull t /\ + y IN convex hull u}`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[polyhedron; LEFT_IMP_EXISTS_THM]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC POLYHEDRON_POLYTOPE_SUMS THEN + ASM_SIMP_TAC[POLYTOPE_CONVEX_HULL; POLYHEDRON_CONVEX_CONE_HULL]] THEN + REWRITE_TAC[polyhedron; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:(real^N->bool)->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o SYM) MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o REDEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`a:(real^N->bool)->real^N`; `b:(real^N->bool)->real`] THEN + ONCE_REWRITE_TAC[MESON[] `h = {x | P x} <=> {x | P x} = h`] THEN + DISCH_TAC THEN + ABBREV_TAC + `s':real^(N,1)finite_sum->bool = + {x | &0 <= drop(sndcart x) /\ + !h:real^N->bool. + h IN f ==> a h dot (fstcart x) <= b h * drop(sndcart x)}` THEN + SUBGOAL_THEN + `?t u. FINITE t /\ FINITE u /\ + (!y:real^(N,1)finite_sum. y IN t ==> drop(sndcart y) = &0) /\ + (!y. y IN u ==> drop(sndcart y) = &1) /\ + s' = convex_cone hull (t UNION u)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `s':real^(N,1)finite_sum->bool` + FINITELY_GENERATED_CONIC_POLYHEDRON) THEN + ANTS_TAC THENL + [EXPAND_TAC "s'" THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[polyhedron] THEN + EXISTS_TAC + `{ x:real^(N,1)finite_sum | + pastecart (vec 0) (--vec 1) dot x <= &0} INSERT + { {x | pastecart (a h) (--lift(b h)) dot x <= &0} | + (h:real^N->bool) IN f}` THEN + REWRITE_TAC[FINITE_INSERT; INTERS_INSERT; SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN + REPEAT CONJ_TAC THENL + [EXPAND_TAC "s'" THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; FORALL_PASTECART; IN_INTER; + DOT_PASTECART; INTERS_IMAGE; FSTCART_PASTECART; + SNDCART_PASTECART; DOT_1; GSYM drop; DROP_NEG; LIFT_DROP] THEN + REWRITE_TAC[DROP_VEC; DOT_LZERO; REAL_MUL_LNEG; GSYM real_sub] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_ARITH `x - y <= &0 <=> x <= y`]; + EXISTS_TAC `pastecart (vec 0) (--vec 1):real^(N,1)finite_sum` THEN + EXISTS_TAC `&0` THEN + REWRITE_TAC[PASTECART_EQ_VEC; VECTOR_NEG_EQ_0; VEC_EQ] THEN + ARITH_TAC; + X_GEN_TAC `h:real^N->bool` THEN DISCH_TAC THEN MAP_EVERY EXISTS_TAC + [`pastecart (a(h:real^N->bool)) (--lift(b h)):real^(N,1)finite_sum`; + `&0`] THEN + ASM_SIMP_TAC[PASTECART_EQ_VEC]]; + REWRITE_TAC[conic; IN_ELIM_THM; FSTCART_CMUL; SNDCART_CMUL] THEN + SIMP_TAC[DROP_CMUL; DOT_RMUL; REAL_LE_MUL] THEN + MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `vec 0:real^(N,1)finite_sum` THEN + REWRITE_TAC[IN_ELIM_THM; FSTCART_VEC; SNDCART_VEC] THEN + REWRITE_TAC[DROP_VEC; DOT_RZERO; REAL_LE_REFL; REAL_MUL_RZERO]]; + DISCH_THEN(X_CHOOSE_THEN `c:real^(N,1)finite_sum->bool` + STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC + [`{x:real^(N,1)finite_sum | x IN c /\ drop(sndcart x) = &0}`; + `IMAGE (\x. inv(drop(sndcart x)) % x) + {x:real^(N,1)finite_sum | x IN c /\ ~(drop(sndcart x) = &0)}`] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT; FORALL_IN_IMAGE] THEN + SIMP_TAC[IN_ELIM_THM; SNDCART_CMUL; DROP_CMUL; REAL_MUL_LINV] THEN + SUBGOAL_THEN + `!x:real^(N,1)finite_sum. x IN c ==> &0 <= drop(sndcart x)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(x:real^(N,1)finite_sum) IN s'` MP_TAC THENL + [ASM_MESON_TAC[HULL_INC]; EXPAND_TAC "s'"] THEN + SIMP_TAC[IN_ELIM_THM]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THEN + MATCH_MP_TAC HULL_MINIMAL THEN + REWRITE_TAC[CONVEX_CONE_CONVEX_CONE_HULL; UNION_SUBSET] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; HULL_INC; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^(N,1)finite_sum` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^(N,1)finite_sum`) THEN + ASM_SIMP_TAC[CONVEX_CONE_HULL_MUL; HULL_INC; REAL_LE_INV_EQ] THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + STRIP_TAC THENL + [MATCH_MP_TAC HULL_INC THEN ASM_REWRITE_TAC[IN_UNION; IN_ELIM_THM]; + SUBGOAL_THEN + `x:real^(N,1)finite_sum = + drop(sndcart x) % inv(drop(sndcart x)) % x` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_MUL_LID]; + MATCH_MP_TAC CONVEX_CONE_HULL_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC HULL_INC THEN + REWRITE_TAC[IN_UNION] THEN DISJ2_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real^(N,1)finite_sum` THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_LT_IMP_NZ]]]]; + EXISTS_TAC `IMAGE fstcart (t:real^(N,1)finite_sum->bool)` THEN + EXISTS_TAC `IMAGE fstcart (u:real^(N,1)finite_sum->bool)` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + SUBGOAL_THEN `s = {x:real^N | pastecart x (vec 1:real^1) IN s'}` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["s"; "s'"] THEN + REWRITE_TAC[IN_ELIM_THM; SNDCART_PASTECART; DROP_VEC; REAL_POS] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[FSTCART_PASTECART; IN_ELIM_THM; IN_INTERS; REAL_MUL_RID] THEN + ASM SET_TAC[]; + ASM_REWRITE_TAC[CONVEX_CONE_HULL_UNION]] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:real^N` THEN + SIMP_TAC[CONVEX_CONE_HULL_LINEAR_IMAGE; CONVEX_HULL_LINEAR_IMAGE; + LINEAR_FSTCART] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `a:real^(N,1)finite_sum` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `(p ==> (q <=> r)) ==> (p /\ q <=> p /\ r)`) THEN + DISCH_TAC THEN AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `b:real^(N,1)finite_sum` THEN REWRITE_TAC[PASTECART_EQ] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; FSTCART_ADD; + SNDCART_ADD] THEN + ASM_CASES_TAC `fstcart(a:real^(N,1)finite_sum) + + fstcart(b:real^(N,1)finite_sum) = z` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `sndcart(a:real^(N,1)finite_sum) = vec 0` SUBST1_TAC THENL + [UNDISCH_TAC `(a:real^(N,1)finite_sum) IN convex_cone hull t` THEN + SPEC_TAC(`a:real^(N,1)finite_sum`,`a:real^(N,1)finite_sum`) THEN + MATCH_MP_TAC HULL_INDUCT THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN + REWRITE_TAC[convex_cone; convex; conic; IN_ELIM_THM] THEN + SIMP_TAC[SNDCART_ADD; SNDCART_CMUL; DROP_ADD; DROP_CMUL] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `vec 0:real^(N,1)finite_sum` THEN + REWRITE_TAC[IN_ELIM_THM; SNDCART_VEC; DROP_VEC]; + REWRITE_TAC[VECTOR_ADD_LID]] THEN + ASM_CASES_TAC `u:real^(N,1)finite_sum->bool = {}` THENL + [ASM_REWRITE_TAC[CONVEX_CONE_HULL_EMPTY; CONVEX_HULL_EMPTY] THEN + REWRITE_TAC[IN_SING; NOT_IN_EMPTY] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[SNDCART_VEC; VEC_EQ] THEN ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CONVEX_CONE_HULL_CONVEX_HULL_NONEMPTY; IN_ELIM_THM] THEN + SUBGOAL_THEN + `!y:real^(N,1)finite_sum. y IN convex hull u ==> sndcart y = vec 1` + (LABEL_TAC "*") + THENL + [MATCH_MP_TAC HULL_INDUCT THEN ASM_SIMP_TAC[GSYM DROP_EQ; DROP_VEC] THEN + REWRITE_TAC[convex; IN_ELIM_THM] THEN + SIMP_TAC[SNDCART_ADD; SNDCART_CMUL; DROP_ADD; DROP_CMUL] THEN + SIMP_TAC[REAL_MUL_RID]; + ALL_TAC] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`c:real`; `d:real^(N,1)finite_sum`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[SNDCART_CMUL; VECTOR_MUL_EQ_0; VECTOR_ARITH + `x:real^N = c % x <=> (c - &1) % x = vec 0`] THEN + ASM_SIMP_TAC[REAL_SUB_0; VEC_EQ; ARITH_EQ; VECTOR_MUL_LID]; + DISCH_TAC THEN ASM_SIMP_TAC[] THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[REAL_POS; VECTOR_MUL_LID] THEN ASM_MESON_TAC[]]]);; + +let POLYHEDRON_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ polyhedron s ==> polyhedron(IMAGE f s)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[POLYHEDRON_AS_CONE_PLUS_CONV; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) u` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + ASM_SIMP_TAC[CONVEX_CONE_HULL_LINEAR_IMAGE; CONVEX_HULL_LINEAR_IMAGE] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_ADD) THEN MESON_TAC[]);; + +let POLYHEDRON_SUMS = prove + (`!s t:real^N->bool. + polyhedron s /\ polyhedron t ==> polyhedron {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[POLYHEDRON_AS_CONE_PLUS_CONV] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`t1:real^N->bool`; `u1:real^N->bool`; + `t2:real^N->bool`; `u2:real^N->bool`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `t1 UNION t2:real^N->bool` THEN + EXISTS_TAC `{u + v:real^N | u IN u1 /\ v IN u2}` THEN + REWRITE_TAC[CONVEX_CONE_HULL_UNION; CONVEX_HULL_SUMS] THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_UNION] THEN + REWRITE_TAC[SET_RULE + `{h x y | x IN {f a b | P a /\ Q b} /\ + y IN {g a b | R a /\ S b}} = + {h (f a b) (g c d) | P a /\ Q b /\ R c /\ S d}`] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_AC]);; + +let POLYHEDRAL_CONVEX_CONE = prove + (`!s:real^N->bool. + polyhedron s /\ convex_cone s <=> + ?k. FINITE k /\ s = convex_cone hull k`, + GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[POLYHEDRON_CONVEX_CONE_HULL; + CONVEX_CONE_CONVEX_CONE_HULL]] THEN + STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [POLYHEDRON_AS_CONE_PLUS_CONV]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `c:real^N->bool`] THEN + ASM_CASES_TAC `c:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[CONVEX_HULL_EMPTY; NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y | x,y | F} = {}`] THEN + ASM_MESON_TAC[CONVEX_CONE_NONEMPTY]; + DISCH_THEN(STRIP_ASSUME_TAC o GSYM)] THEN + EXISTS_TAC `k UNION c:real^N->bool` THEN + ASM_REWRITE_TAC[FINITE_UNION] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THENL + [EXPAND_TAC "s" THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONVEX_CONE_HULL_ADD THEN + CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)) THEN + MESON_TAC[HULL_MONO; SUBSET_UNION; SUBSET_TRANS; + CONVEX_HULL_SUBSET_CONVEX_CONE_HULL]; + MATCH_MP_TAC HULL_MINIMAL THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]]] THEN + REWRITE_TAC[UNION_SUBSET] THEN REWRITE_TAC[SUBSET] THEN + CONJ_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THENL + [ALL_TAC; + EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN + ASM_SIMP_TAC[HULL_INC; VECTOR_ADD_LID; CONVEX_CONE_HULL_CONTAINS_0]] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLYHEDRON_IMP_CLOSED) THEN + DISCH_THEN(MP_TAC o MATCH_MP CLOSED_APPROACHABLE) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e / (norm y + &1) % ((norm y + &1) / e % x + y):real^N` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_CONE_MUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; NORM_POS_LE; REAL_POS; + REAL_LT_IMP_LE] THEN + EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC + [`(norm(y:real^N) + &1) / e % x:real^N`; `y:real^N`] THEN + ASM_SIMP_TAC[HULL_INC] THEN MATCH_MP_TAC CONVEX_CONE_HULL_MUL THEN + ASM_SIMP_TAC[HULL_INC] THEN MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONV_TAC NORM_ARITH; + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[NORM_POS_LE; VECTOR_MUL_LID; REAL_FIELD + `&0 <= y /\ &0 < e ==> e / (y + &1) * (y + &1) / e = &1`] THEN + REWRITE_TAC[NORM_ARITH `dist(x + e:real^N,x) = norm e`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ e * z / y < e * &1 ==> abs e / y * z < e`) THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; + NORM_ARITH `&0 < abs(norm(y:real^N) + &1)`] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Farkas's lemma (2 variants) and stronger separation for polyhedra. *) +(* ------------------------------------------------------------------------- *) + +let FARKAS_LEMMA = prove + (`!A:real^N^M b. + (?x:real^N. + A ** x = b /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i)) <=> + ~(?y:real^M. + b dot y < &0 /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= (transp A ** y)$i))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT + `(q ==> ~p) /\ (~p ==> q) ==> (p <=> ~q)`) THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `y dot ((A:real^N^M) ** x - b) = &0` MP_TAC THENL + [ASM_REWRITE_TAC[VECTOR_SUB_REFL; DOT_RZERO]; ALL_TAC] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[DOT_SYM]) THEN + REWRITE_TAC[DOT_RSUB; REAL_SUB_0] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `y < &0 ==> &0 <= x ==> ~(x = y)`)) THEN + ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN + REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; dot] THEN + MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[REAL_LE_MUL; IN_NUMSEG; FINITE_NUMSEG]; + DISCH_TAC THEN MP_TAC(ISPECL + [`{(A:real^N^M) ** (x:real^N) | + !i. 1 <= i /\ i <= dimindex(:N) ==> &0 <= x$i}`; + `b:real^M`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[CONVEX_POSITIVE_ORTHANT; CONVEX_LINEAR_IMAGE; + MATRIX_VECTOR_MUL_LINEAR] THEN + MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN + MATCH_MP_TAC POLYHEDRON_LINEAR_IMAGE THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; POLYHEDRON_POSITIVE_ORTHANT]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N`) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO; DOT_RZERO] THEN + REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LE_REFL] THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `c / (transp(A:real^N^M) ** (y:real^M))$k % basis k:real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN + ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; VECTOR_MATRIX_MUL_TRANSP] THEN + ASM_SIMP_TAC[REAL_FIELD `y < &0 ==> x / y * y = x`] THEN + REWRITE_TAC[REAL_LT_REFL; real_gt] THEN + GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x / y:real = --x * -- inv y`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_ARITH `&0 <= --x <=> ~(&0 < x)`; REAL_LT_INV_EQ] THEN + ASM_REAL_ARITH_TAC]]);; + +let FARKAS_LEMMA_ALT = prove + (`!A:real^N^M b. + (?x:real^N. + (!i. 1 <= i /\ i <= dimindex(:M) ==> (A ** x)$i <= b$i)) <=> + ~(?y:real^M. + (!i. 1 <= i /\ i <= dimindex(:M) ==> &0 <= y$i) /\ + y ** A = vec 0 /\ b dot y < &0)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(TAUT `~(p /\ q) /\ (~p ==> q) ==> (p <=> ~q)`) THEN + REPEAT STRIP_TAC THENL + [SUBGOAL_THEN `&0 <= (b - (A:real^N^M) ** x) dot y` MP_TAC THENL + [REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_POS_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_SUB_LE]; + REWRITE_TAC[DOT_LSUB; REAL_SUB_LE] THEN REWRITE_TAC[REAL_NOT_LE] THEN + GEN_REWRITE_TAC RAND_CONV [DOT_SYM] THEN + REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN + ASM_REWRITE_TAC[DOT_LZERO]]; + MP_TAC(ISPECL + [`{(A:real^N^M) ** (x:real^N) + s |x,s| + !i. 1 <= i /\ i <= dimindex(:M) ==> &0 <= s$i}`; + `b:real^M`] SEPARATING_HYPERPLANE_CLOSED_POINT) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; CONJ_ASSOC] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE + `{f x + y | x,y | P y} = + {z + y | z,y | z IN IMAGE (f:real^M->real^N) (:real^M) /\ + y IN {w | P w}}`] THEN + SIMP_TAC[CONVEX_SUMS; CONVEX_POSITIVE_ORTHANT; CONVEX_LINEAR_IMAGE; + MATRIX_VECTOR_MUL_LINEAR; CONVEX_UNIV] THEN + MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN + MATCH_MP_TAC POLYHEDRON_SUMS THEN + ASM_SIMP_TAC[POLYHEDRON_LINEAR_IMAGE; POLYHEDRON_UNIV; + MATRIX_VECTOR_MUL_LINEAR; POLYHEDRON_POSITIVE_ORTHANT]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; REAL_LE_ADDR]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^M` THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN + FIRST_ASSUM(MP_TAC o SPECL [`vec 0:real^N`; `vec 0:real^M`]) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_ADD_RID; DOT_RZERO] THEN + REWRITE_TAC[real_gt; VEC_COMPONENT; REAL_LE_REFL] THEN + DISCH_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`vec 0:real^N`; `--c / --((y:real^M)$k) % basis k:real^M`]) THEN + ASM_SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; VECTOR_ADD_LID; + DOT_RMUL; DOT_BASIS; REAL_FIELD + `y < &0 ==> c / --y * y = --c`] THEN + SIMP_TAC[REAL_NEG_NEG; REAL_LT_REFL; VECTOR_MUL_COMPONENT; real_gt] THEN + ASM_SIMP_TAC[BASIS_COMPONENT] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPECL + [`c / norm((y:real^M) ** (A:real^N^M)) pow 2 % + (transp A ** y)`; `vec 0:real^M`]) THEN + SIMP_TAC[VEC_COMPONENT; REAL_LE_REFL; VECTOR_ADD_RID] THEN + ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN + REWRITE_TAC[GSYM VECTOR_MATRIX_MUL_TRANSP; DOT_RMUL] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_POW_2; DOT_EQ_0] THEN + REAL_ARITH_TAC]]]);; + +let SEPARATING_HYPERPLANE_POLYHEDRA = prove + (`!s t:real^N->bool. + polyhedron s /\ polyhedron t /\ ~(s = {}) /\ ~(t = {}) /\ DISJOINT s t + ==> ?a b. ~(a = vec 0) /\ + (!x. x IN s ==> a dot x < b) /\ + (!x. x IN t ==> a dot x > b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{x + y:real^N | x IN s /\ y IN IMAGE (--) t}` + SEPARATING_HYPERPLANE_CLOSED_0) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CONVEX_SUMS; CONVEX_NEGATIONS; POLYHEDRON_IMP_CONVEX] THEN + CONJ_TAC THENL + [MATCH_MP_TAC POLYHEDRON_IMP_CLOSED THEN + MATCH_MP_TAC POLYHEDRON_SUMS THEN ASM_SIMP_TAC[POLYHEDRON_NEGATIONS]; + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `y = --x:real^N <=> --y = x`] THEN + REWRITE_TAC[UNWIND_THM1] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = x + y <=> y = --x`] THEN + REWRITE_TAC[UNWIND_THM2; VECTOR_NEG_NEG] THEN ASM SET_TAC[]]; + REWRITE_TAC[FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE; GSYM VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `k:real`] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; DOT_RSUB] THEN STRIP_TAC THEN + EXISTS_TAC `--a:real^N` THEN ASM_REWRITE_TAC[VECTOR_NEG_EQ_0] THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. a dot x) s` INF) THEN + MP_TAC(ISPEC `IMAGE (\x:real^N. a dot x) t` SUP) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY ABBREV_TAC + [`u = inf(IMAGE (\x:real^N. a dot x) s)`; + `v = sup(IMAGE (\x:real^N. a dot x) t)`] THEN + ANTS_TAC THENL + [MP_TAC(GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] + (ASSUME `~(s:real^N->bool = {})`)) THEN + DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN + EXISTS_TAC `a dot (z:real^N) - k` THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`z:real^N`; `x:real^N`]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + STRIP_TAC] THEN + ANTS_TAC THENL + [MP_TAC(GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY] + (ASSUME `~(t:real^N->bool = {})`)) THEN + DISCH_THEN(X_CHOOSE_TAC `z:real^N`) THEN + EXISTS_TAC `a dot (z:real^N) + k` THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + STRIP_TAC] THEN + SUBGOAL_THEN `k <= u - v` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LE_SUB_LADD] THEN EXPAND_TAC "u" THEN + MATCH_MP_TAC REAL_LE_INF THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `k + v <= u <=> v <= u - k`] THEN + EXPAND_TAC "v" THEN MATCH_MP_TAC REAL_SUP_LE THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[REAL_ARITH `x - y > k ==> y <= x - k`]; + EXISTS_TAC `--((u + v) / &2)` THEN REWRITE_TAC[real_gt] THEN + REWRITE_TAC[DOT_LNEG; REAL_LT_NEG2] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `u:real`; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `v:real`] THEN + ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Relative and absolute frontier of a polytope. *) +(* ------------------------------------------------------------------------- *) + +let RELATIVE_BOUNDARY_OF_CONVEX_HULL = prove + (`!s:real^N->bool. + ~affine_dependent s + ==> (convex hull s) DIFF relative_interior(convex hull s) = + UNIONS { convex hull (s DELETE a) | a | a IN s}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + REPEAT_TCL DISJ_CASES_THEN MP_TAC (ARITH_RULE + `CARD(s:real^N->bool) = 0 \/ CARD s = 1 \/ 2 <= CARD s`) + THENL + [ASM_SIMP_TAC[CARD_EQ_0; CONVEX_HULL_EMPTY] THEN SET_TAC[]; + DISCH_TAC THEN MP_TAC(HAS_SIZE_CONV `(s:real^N->bool) HAS_SIZE 1`) THEN + ASM_SIMP_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM; CONVEX_HULL_SING] THEN + REWRITE_TAC[RELATIVE_INTERIOR_SING; DIFF_EQ_EMPTY] THEN + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[EMPTY_UNIONS] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_UNWIND_THM2] THEN + REWRITE_TAC[CONVEX_HULL_EQ_EMPTY] THEN SET_TAC[]; + DISCH_TAC THEN + ASM_SIMP_TAC[POLYHEDRON_CONVEX_HULL; RELATIVE_BOUNDARY_OF_POLYHEDRON] THEN + ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT] THEN + SET_TAC[]]);; + +let RELATIVE_FRONTIER_OF_CONVEX_HULL = prove + (`!s:real^N->bool. + ~affine_dependent s + ==> relative_frontier(convex hull s) = + UNIONS { convex hull (s DELETE a) | a | a IN s}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_INDEPENDENT_IMP_FINITE) THEN + ASM_SIMP_TAC[relative_frontier; GSYM RELATIVE_BOUNDARY_OF_CONVEX_HULL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_CLOSED THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);; + +let FRONTIER_OF_CONVEX_HULL = prove + (`!s:real^N->bool. + s HAS_SIZE (dimindex(:N) + 1) + ==> frontier(convex hull s) = + UNIONS { convex hull (s DELETE a) | a | a IN s}`, + REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `affine_dependent(s:real^N->bool)` THENL + [REWRITE_TAC[frontier] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(convex hull s:real^N->bool) DIFF {}` THEN CONJ_TAC THENL + [BINOP_TAC THEN + ASM_SIMP_TAC[INTERIOR_CONVEX_HULL_EQ_EMPTY; frontier; HAS_SIZE] THEN + MATCH_MP_TAC CLOSURE_CLOSED THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; + FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; + REWRITE_TAC[DIFF_EMPTY] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [CARATHEODORY_AFF_DIM] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + GEN_REWRITE_TAC I [SUBSET] THEN + REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `s:real^N->bool` AFFINE_INDEPENDENT_IFF_CARD) THEN + ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_ARITH `(x + &1) - &1:int = x`] THEN DISCH_TAC THEN + SUBGOAL_THEN `(t:real^N->bool) PSUBSET s` ASSUME_TAC THENL + [ASM_REWRITE_TAC[PSUBSET] THEN + DISCH_THEN(MP_TAC o AP_TERM `CARD:(real^N->bool)->num`) THEN + MATCH_MP_TAC(ARITH_RULE `t:num < s ==> t = s ==> F`) THEN + ASM_REWRITE_TAC[ARITH_RULE `x < n + 1 <=> x <= n`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `aff_dim(s:real^N->bool) + &1` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(INT_ARITH + `s:int <= n /\ ~(s = n) ==> s + &1 <= n`) THEN + ASM_REWRITE_TAC[AFF_DIM_LE_UNIV]; + SUBGOAL_THEN `?a:real^N. a IN s /\ ~(a IN t)` MP_TAC THENL + [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(convex hull t) SUBSET convex hull (s DELETE (a:real^N))` + MP_TAC THENL + [MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]; ASM SET_TAC[]]]; + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[UNIONS_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; GSYM SUBSET] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]]]; + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `(convex hull s) DIFF relative_interior(convex hull s):real^N->bool` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM RELATIVE_BOUNDARY_OF_CONVEX_HULL; frontier] THEN + BINOP_TAC THENL + [MATCH_MP_TAC CLOSURE_CLOSED THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; COMPACT_IMP_CLOSED; COMPACT_CONVEX_HULL; + FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC RELATIVE_INTERIOR_INTERIOR THEN + REWRITE_TAC[AFFINE_HULL_CONVEX_HULL] THEN + REWRITE_TAC[GSYM AFF_DIM_EQ_FULL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [AFFINE_INDEPENDENT_IFF_CARD]) THEN + ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_POLYHEDRON; + POLYHEDRON_CONVEX_HULL; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_SIMP_TAC[FACET_OF_CONVEX_HULL_AFFINE_INDEPENDENT_ALT] THEN + REWRITE_TAC[ARITH_RULE `2 <= n + 1 <=> 1 <= n`; DIMINDEX_GE_1] THEN + ASM SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Special case of a triangle. *) +(* ------------------------------------------------------------------------- *) + +let RELATIVE_BOUNDARY_OF_TRIANGLE = prove + (`!a b c:real^N. + ~collinear {a,b,c} + ==> convex hull {a,b,c} DIFF relative_interior(convex hull {a,b,c}) = + segment[a,b] UNION segment[b,c] UNION segment[c,a]`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = t UNION u UNION s`] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [COLLINEAR_3_EQ_AFFINE_DEPENDENT]) THEN + REWRITE_TAC[DE_MORGAN_THM; SEGMENT_CONVEX_HULL] THEN STRIP_TAC THEN + ASM_SIMP_TAC[RELATIVE_BOUNDARY_OF_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; UNIONS_0; UNION_EMPTY] THEN + REPEAT BINOP_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let RELATIVE_FRONTIER_OF_TRIANGLE = prove + (`!a b c:real^N. + ~collinear {a,b,c} + ==> relative_frontier(convex hull {a,b,c}) = + segment[a,b] UNION segment[b,c] UNION segment[c,a]`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM RELATIVE_BOUNDARY_OF_TRIANGLE; relative_frontier] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC CLOSURE_CLOSED THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL; + FINITE_INSERT; FINITE_EMPTY]);; + +let FRONTIER_OF_TRIANGLE = prove + (`!a b c:real^2. + frontier(convex hull {a,b,c}) = + segment[a,b] UNION segment[b,c] UNION segment[c,a]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SEGMENT_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SET_RULE `s UNION t UNION u = t UNION u UNION s`] THEN + MAP_EVERY (fun t -> ASM_CASES_TAC t THENL + [ASM_REWRITE_TAC[INSERT_AC; UNION_ACI] THEN + SIMP_TAC[GSYM SEGMENT_CONVEX_HULL; frontier; CLOSURE_SEGMENT; + INTERIOR_SEGMENT; DIMINDEX_2; LE_REFL; DIFF_EMPTY] THEN + REWRITE_TAC[CONVEX_HULL_SING] THEN + REWRITE_TAC[SET_RULE `s = s UNION {a} <=> a IN s`; + SET_RULE `s = {a} UNION s <=> a IN s`] THEN + REWRITE_TAC[ENDS_IN_SEGMENT]; + ALL_TAC]) + [`b:real^2 = a`; `c:real^2 = a`; `c:real^2 = b`] THEN + SUBGOAL_THEN `{a:real^2,b,c} HAS_SIZE (dimindex(:2) + 1)` ASSUME_TAC THENL + [SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DIMINDEX_2] THEN + CONV_TAC NUM_REDUCE_CONV; + ASM_SIMP_TAC[FRONTIER_OF_CONVEX_HULL] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT; UNIONS_0; UNION_EMPTY] THEN + REPEAT BINOP_TAC THEN REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +let INSIDE_OF_TRIANGLE = prove + (`!a b c:real^2. + inside(segment[a,b] UNION segment[b,c] UNION segment[c,a]) = + interior(convex hull {a,b,c})`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE] THEN + MATCH_MP_TAC INSIDE_FRONTIER_EQ_INTERIOR THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC BOUNDED_CONVEX_HULL THEN + MATCH_MP_TAC FINITE_IMP_BOUNDED THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]);; + +let INTERIOR_OF_TRIANGLE = prove + (`!a b c:real^2. + interior(convex hull {a,b,c}) = + (convex hull {a,b,c}) DIFF + (segment[a,b] UNION segment[b,c] UNION segment[c,a])`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FRONTIER_OF_TRIANGLE; frontier] THEN + MATCH_MP_TAC(SET_RULE `i SUBSET s /\ c = s ==> i = s DIFF (c DIFF i)`) THEN + REWRITE_TAC[INTERIOR_SUBSET] THEN MATCH_MP_TAC CLOSURE_CONVEX_HULL THEN + SIMP_TAC[FINITE_IMP_COMPACT; FINITE_INSERT; FINITE_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* A ridge is the intersection of precisely two facets. *) +(* ------------------------------------------------------------------------- *) + +let POLYHEDRON_RIDGE_TWO_FACETS = prove + (`!p:real^N->bool r. + polyhedron p /\ r face_of p /\ ~(r = {}) /\ aff_dim r = aff_dim p - &2 + ==> ?f1 f2. f1 face_of p /\ aff_dim f1 = aff_dim p - &1 /\ + f2 face_of p /\ aff_dim f2 = aff_dim p - &1 /\ + ~(f1 = f2) /\ r SUBSET f1 /\ r SUBSET f2 /\ f1 INTER f2 = r /\ + !f. f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f + ==> f = f1 \/ f = f2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:real^N->bool`; `r:real^N->bool`] FACE_OF_POLYHEDRON) THEN + ANTS_TAC THENL [ASM_MESON_TAC[INT_ARITH `~(p:int = p - &2)`]; ALL_TAC] THEN + SUBGOAL_THEN `&2 <= aff_dim(p:real^N->bool)` ASSUME_TAC THENL + [MP_TAC(ISPEC `r:real^N->bool` AFF_DIM_GE) THEN + MP_TAC(ISPEC `r:real^N->bool` AFF_DIM_EQ_MINUS1) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `{f:real^N->bool | f facet_of p /\ r SUBSET f} = + {f | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f}` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; facet_of] THEN + X_GEN_TAC `f:real^N->bool` THEN + ASM_CASES_TAC `f:real^N->bool = {}` THEN + ASM_REWRITE_TAC[AFF_DIM_EMPTY; GSYM CONJ_ASSOC] THEN ASM_INT_ARITH_TAC; + DISCH_THEN(MP_TAC o SYM)] THEN + ASM_CASES_TAC + `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f} + = {}` + THENL + [ASM_REWRITE_TAC[INTERS_0] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + UNDISCH_TAC `aff_dim(r:real^N->bool) = aff_dim(p:real^N->bool) - &2` THEN + ASM_REWRITE_TAC[AFF_DIM_UNIV; DIMINDEX_3] THEN + MP_TAC(ISPEC `p:real^N->bool` AFF_DIM_LE_UNIV) THEN INT_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + X_GEN_TAC `f1:real^N->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC + `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f} + = {f1}` + THENL + [ASM_REWRITE_TAC[INTERS_1] THEN + ASM_MESON_TAC[INT_ARITH `~(x - &2:int = x - &1)`]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f2:real^N->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC + `{f:real^N->bool | f face_of p /\ aff_dim f = aff_dim p - &1 /\ r SUBSET f} + = {f1,f2}` + THENL + [ASM_REWRITE_TAC[INTERS_2] THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`f1:real^N->bool`; `f2:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s = {a,b}) + ==> a IN s /\ b IN s ==> ?c. ~(c = a) /\ ~(c = b) /\ c IN s`)) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f3:real^N->bool` THEN STRIP_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `aff_dim(r:real^N->bool) = aff_dim(p:real^N->bool) - &2` THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + MATCH_MP_TAC(INT_ARITH `~(p - &2:int <= x:int) ==> ~(x = p - &2)`) THEN + DISCH_TAC THEN SUBGOAL_THEN + `~(f1:real^N->bool = {}) /\ + ~(f2:real^N->bool = {}) /\ + ~(f3:real^N->bool = {})` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[AFF_DIM_EMPTY]) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `p:real^N->bool` POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = v <=> v = vec 0`] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`p:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> + MP_TAC(SPEC `f1:real^N->bool` th) THEN + MP_TAC(SPEC `f2:real^N->bool` th) THEN + MP_TAC(SPEC `f3:real^N->bool` th)) THEN + ASM_REWRITE_TAC[facet_of] THEN + DISCH_THEN(X_CHOOSE_THEN `h3:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + DISCH_THEN(X_CHOOSE_THEN `h2:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + DISCH_THEN(X_CHOOSE_THEN `h1:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN `~((a:(real^N->bool)->real^N) h1 = a h2) /\ + ~(a h2 = a h3) /\ ~(a h1 = a h3)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [DISJ_CASES_TAC(REAL_ARITH + `b(h1:real^N->bool) <= b h2 \/ b h2 <= b h1`) + THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`); + FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + AP_TERM_TAC) + THENL + [SUBGOAL_THEN `f DELETE h2 = h1 INSERT (f DIFF {h1,h2}) /\ + f = (h2:real^N->bool) INSERT h1 INSERT (f DIFF {h1,h2})` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; + SUBGOAL_THEN `f DELETE h1 = h2 INSERT (f DIFF {h1,h2}) /\ + f = (h1:real^N->bool) INSERT h2 INSERT (f DIFF {h1,h2})` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN + REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE + `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `h1:real^N->bool` th) THEN + MP_TAC(SPEC `h2:real^N->bool` th)) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; + DISJ_CASES_TAC(REAL_ARITH + `b(h2:real^N->bool) <= b h3 \/ b h3 <= b h2`) + THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`); + FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`)] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + AP_TERM_TAC) + THENL + [SUBGOAL_THEN `f DELETE h3 = h2 INSERT (f DIFF {h2,h3}) /\ + f = (h3:real^N->bool) INSERT h2 INSERT (f DIFF {h2,h3})` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; + SUBGOAL_THEN `f DELETE h2 = h3 INSERT (f DIFF {h2,h3}) /\ + f = (h2:real^N->bool) INSERT h3 INSERT (f DIFF {h2,h3})` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN + REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE + `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `h2:real^N->bool` th) THEN + MP_TAC(SPEC `h3:real^N->bool` th)) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; + DISJ_CASES_TAC(REAL_ARITH + `b(h1:real^N->bool) <= b h3 \/ b h3 <= b h1`) + THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`); + FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `(p ==> s = t) ==> s PSUBSET t ==> ~p`) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + AP_TERM_TAC) + THENL + [SUBGOAL_THEN `f DELETE h3 = h1 INSERT (f DIFF {h1,h3}) /\ + f = (h3:real^N->bool) INSERT h1 INSERT (f DIFF {h1,h3})` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; + SUBGOAL_THEN `f DELETE h1 = h3 INSERT (f DIFF {h1,h3}) /\ + f = (h1:real^N->bool) INSERT h3 INSERT (f DIFF {h1,h3})` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN + REWRITE_TAC[INTERS_INSERT] THEN MATCH_MP_TAC(SET_RULE + `b SUBSET a ==> a INTER b INTER s = b INTER s`) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `h1:real^N->bool` th) THEN + MP_TAC(SPEC `h3:real^N->bool` th)) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `~({x | a h1 dot x <= b h1} INTER {x | a h2 dot x <= b h2} + SUBSET {x | a h3 dot x <= b h3}) /\ + ~({x | a h1 dot x <= b h1} INTER {x | a h3 dot x <= b h3} + SUBSET {x | a h2 dot x <= b h2}) /\ + ~({x | a h2 dot x <= b h2} INTER {x | a h3 dot x <= b h3} + SUBSET {x:real^N | a(h1:real^N->bool) dot x <= b h1})` + MP_TAC THENL + [ASM_SIMP_TAC[] THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h3:real^N->bool)`); + FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h2:real^N->bool)`); + FIRST_X_ASSUM(MP_TAC o SPEC `f DELETE (h1:real^N->bool)`)] THEN + (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC + (LAND_CONV o LAND_CONV) [SYM th]) THEN + MATCH_MP_TAC(SET_RULE `s = t ==> s PSUBSET t ==> F`) THEN + AP_TERM_TAC) + THENL + [SUBGOAL_THEN + `f DELETE (h3:real^N->bool) = h1 INSERT h2 INSERT (f DELETE h3) /\ + f = h1 INSERT h2 INSERT h3 INSERT (f DELETE h3)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; + SUBGOAL_THEN + `f DELETE (h2:real^N->bool) = h1 INSERT h3 INSERT (f DELETE h2) /\ + f = h2 INSERT h1 INSERT h3 INSERT (f DELETE h2)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]; + SUBGOAL_THEN + `f DELETE (h1:real^N->bool) = h2 INSERT h3 INSERT (f DELETE h1) /\ + f = h1 INSERT h2 INSERT h3 INSERT (f DELETE h1)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL [ASM SET_TAC[]; ALL_TAC]] THEN + REWRITE_TAC[INTERS_INSERT] THEN REWRITE_TAC[GSYM INTER_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?w. (a:(real^N->bool)->real^N) h1 dot w < b h1 /\ + a h2 dot w < b h2 /\ a h3 dot w < b h3` + (CHOOSE_THEN MP_TAC) + THENL + [SUBGOAL_THEN `~(relative_interior p :real^N->bool = {})` MP_TAC THENL + [ASM_SIMP_TAC[RELATIVE_INTERIOR_EQ_EMPTY; POLYHEDRON_IMP_CONVEX] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:real^N->bool`; `f:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] RELATIVE_INTERIOR_POLYHEDRON_EXPLICIT) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN r ==> (a h1) dot (x:real^N) = b h1 /\ + (a h2) dot x = b h2 /\ + (a (h3:real^N->bool)) dot x = b h3` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?z:real^N. z IN r` CHOOSE_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY UNDISCH_TAC + [`~((a:(real^N->bool)->real^N) h1 = a h2)`; + `~((a:(real^N->bool)->real^N) h1 = a h3)`; + `~((a:(real^N->bool)->real^N) h2 = a h3)`; + `aff_dim(p:real^N->bool) - &2 <= aff_dim(r:real^N->bool)`] THEN + MAP_EVERY (fun t -> + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC t th) THEN ASM_REWRITE_TAC[] THEN + ASSUME_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `z:real^N` o CONJUNCT2 o CONJUNCT2)) + [`h1:real^N->bool`; `h2:real^N->bool`; `h3:real^N->bool`] THEN + SUBGOAL_THEN `(z:real^N) IN (affine hull p)` ASSUME_TAC THENL + [MATCH_MP_TAC HULL_INC THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[]] THEN + UNDISCH_TAC `(z:real^N) IN (affine hull p)` THEN + SUBGOAL_THEN `(a h1) dot (z:real^N) = b h1 /\ + (a h2) dot z = b h2 /\ + (a (h3:real^N->bool)) dot z = b h3` + (REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) + THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(r:real^N->bool) SUBSET affine hull p` MP_TAC THENL + [ASM_MESON_TAC[FACE_OF_IMP_SUBSET; HULL_SUBSET; SUBSET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN + `~((a:(real^N->bool)->real^N) h1 = vec 0) /\ + ~((a:(real^N->bool)->real^N) h2 = vec 0) /\ + ~((a:(real^N->bool)->real^N) h3 = vec 0)` + MP_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `(z:real^N) IN r` THEN POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY SPEC_TAC + [`(a:(real^N->bool)->real^N) h1`,`a1:real^N`; + `(a:(real^N->bool)->real^N) h2`,`a2:real^N`; + `(a:(real^N->bool)->real^N) h3`,`a3:real^N`] THEN + REPEAT GEN_TAC THEN + GEN_GEOM_ORIGIN_TAC `z:real^N` ["a1"; "a2"; "a3"] THEN + REWRITE_TAC[VECTOR_ADD_RID; VECTOR_ADD_LID] THEN + REWRITE_TAC[DOT_RADD; IMAGE_CLAUSES; + REAL_ARITH `a + b:real <= a <=> b <= &0`; + REAL_ARITH `a + b:real < a <=> b < &0`; + REAL_ARITH `a + b:real = a <=> b = &0`] THEN + + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `aff_dim(p:real^N->bool) = &(dim p)` SUBST_ALL_TAC THENL + [ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]; ALL_TAC] THEN + SUBGOAL_THEN `aff_dim(r:real^N->bool) = &(dim r)` SUBST_ALL_TAC THENL + [ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INT_OF_NUM_ADD; INT_OF_NUM_LE; + INT_ARITH `p - &2:int <= q <=> p <= q + &2`]) THEN + MP_TAC(ISPECL + [`{a1:real^N,a2,a3}`; `r:real^N->bool`] DIM_ORTHOGONAL_SUM) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `p <= r + 2 ==> u <= p /\ 3 <= t ==> ~(u = t + r)`)) THEN + SUBGOAL_THEN `affine hull p :real^N->bool = span p` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[AFFINE_HULL_EQ_SPAN]; ALL_TAC] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN] THEN + MATCH_MP_TAC DIM_SUBSET THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC `{a1:real^N,a2,a3}` DEPENDENT_BIGGERSET_GENERAL) THEN + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[ARITH_RULE `~(3 > x) <=> 3 <= x`] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[dependent; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[DELETE_INSERT; EMPTY_DELETE] THEN + REWRITE_TAC[SPAN_2; IN_ELIM_THM; IN_UNIV] THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + W(fun (asl,w) -> let fv = frees w + and av = [`a1:real^N`; `a2:real^N`; `a3:real^N`] in + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (subtract fv av @ av)) THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM] THEN + MATCH_MP_TAC(MESON[] + `(!a1 a2 a3. P a1 a2 a3 ==> P a2 a1 a3 /\ P a3 a1 a2) /\ + (!a1 a2 a3. Q a1 a2 a3 ==> ~(P a1 a2 a3)) + ==> !a3 a2 a1. P a1 a2 a3 + ==> ~(Q a1 a2 a3 \/ Q a2 a1 a3 \/ Q a3 a1 a2)`) THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> q) /\ (p ==> r) ==> p ==> q /\ r`) THEN + CONJ_TAC THEN REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + REWRITE_TAC[CONJ_ACI] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN DISCH_THEN + (X_CHOOSE_THEN `u:real` (X_CHOOSE_TAC `v:real`)) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH + `v = &0 \/ &0 < v \/ &0 < --v`) + THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO]; + REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b <= &0 <=> &0 <= a * --b`] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN REAL_ARITH_TAC; + REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b < &0 <=> &0 < --a * b`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + ASM_CASES_TAC `v = &0` THENL + [ASM_REWRITE_TAC[VECTOR_ADD_RID; VECTOR_MUL_LZERO] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH + `u = &0 \/ &0 < u \/ &0 < --u`) + THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO]; + REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b <= &0 <=> &0 <= a * --b`] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN REAL_ARITH_TAC; + REWRITE_TAC[DOT_LMUL; REAL_ARITH `a * b < &0 <=> &0 < --a * b`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `&0 < u /\ &0 < v \/ &0 < u /\ &0 < --v \/ + &0 < --u /\ &0 < v \/ &0 < --u /\ &0 < --v` + STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + UNDISCH_TAC + `~({x | a2 dot x <= &0} INTER {x | a3 dot x <= &0} SUBSET + {x:real^N | a1 dot x <= &0})` THEN + ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN + REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`] THEN + REWRITE_TAC[REAL_NEG_ADD; GSYM REAL_MUL_RNEG] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_ADD; REAL_LT_IMP_LE]; + UNDISCH_TAC + `~({x | a1 dot x <= &0} INTER {x | a3 dot x <= &0} SUBSET + {x:real^N | a2 dot x <= &0})` THEN + ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 < u * a2 <=> &0 < a2) /\ (&0 < --v * a3 <=> &0 < a3) + ==> u * a2 + v * a3 <= &0 /\ a3 <= &0 ==> a2 <= &0`) THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ]; + UNDISCH_TAC + `~({x | a1 dot x <= &0} INTER {x | a2 dot x <= &0} SUBSET + {x:real^N | a3 dot x <= &0})` THEN + ASM_REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 < --u * a2 <=> &0 < a2) /\ (&0 < v * a3 <=> &0 < a3) + ==> u * a2 + v * a3 <= &0 /\ a2 <= &0 ==> a3 <= &0`) THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ]; + UNDISCH_TAC `(a1:real^N) dot w < &0` THEN + ASM_REWRITE_TAC[DOT_LADD; DOT_LMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < --u * --a /\ &0 < --v * --b ==> ~(u * a + v * b < &0)`) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Lower bounds on then number of 0 and n-1 dimensional faces. *) +(* ------------------------------------------------------------------------- *) + +let POLYTOPE_VERTEX_LOWER_BOUND = prove + (`!p:real^N->bool. + polytope p ==> aff_dim p + &1 <= &(CARD {v | v extreme_point_of p})`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `aff_dim(convex hull {v:real^N | v extreme_point_of p}) + &1` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM KREIN_MILMAN_MINKOWSKI; POLYTOPE_IMP_CONVEX; + POLYTOPE_IMP_COMPACT; INT_LE_REFL]; + REWRITE_TAC[AFF_DIM_CONVEX_HULL; GSYM INT_LE_SUB_LADD] THEN + MATCH_MP_TAC AFF_DIM_LE_CARD THEN + MATCH_MP_TAC FINITE_POLYHEDRON_EXTREME_POINTS THEN + ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON]]);; + +let POLYTOPE_FACET_LOWER_BOUND = prove + (`!p:real^N->bool. + polytope p /\ ~(aff_dim p = &0) + ==> aff_dim p + &1 <= &(CARD {f | f facet_of p})`, + GEN_TAC THEN ASM_CASES_TAC `p:real^N->bool = {}` THEN + ASM_SIMP_TAC[AFF_DIM_EMPTY; FACET_OF_EMPTY; EMPTY_GSPEC; CARD_CLAUSES] THEN + CONV_TAC INT_REDUCE_CONV THEN STRIP_TAC THEN + SUBGOAL_THEN + `?n. {f:real^N->bool | f facet_of p} HAS_SIZE n /\ aff_dim p + &1 <= &n` + (fun th -> MESON_TAC[th; HAS_SIZE]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + GEOM_ORIGIN_TAC `z:real^N` THEN REPEAT GEN_TAC THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `CARD {f:real^N->bool | f facet_of p}` THEN + ASM_SIMP_TAC[FINITE_POLYTOPE_FACETS; HAS_SIZE] THEN + UNDISCH_TAC `~(aff_dim(p:real^N->bool) = &0)` THEN + ASM_SIMP_TAC[AFF_DIM_DIM_0; HULL_INC; INT_OF_NUM_ADD; INT_OF_NUM_LE] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN DISCH_TAC THEN + MP_TAC(ISPEC `p:real^N->bool` POLYHEDRON_INTER_AFFINE_PARALLEL_MINIMAL) THEN + ASM_SIMP_TAC[POLYTOPE_IMP_POLYHEDRON] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC + [`H:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] THEN + ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0:real^N = v <=> v = vec 0`] THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN + STRIP_TAC THEN MP_TAC(ISPECL + [`p:real^N->bool`; `H:(real^N->bool)->bool`; `a:(real^N->bool)->real^N`; + `b:(real^N->bool)->real`] FACET_OF_POLYHEDRON_EXPLICIT) THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC] THEN DISCH_THEN(K ALL_TAC) THEN + SUBGOAL_THEN `!h:real^N->bool. h IN H ==> &0 <= b h` ASSUME_TAC THENL + [UNDISCH_TAC `(vec 0:real^N) IN p` THEN EXPAND_TAC "p" THEN + REWRITE_TAC[IN_INTER; IN_INTERS] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `h:real^N->bool` THEN + ASM_CASES_TAC `(h:real^N->bool) IN H` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun t -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM t]) THEN + REWRITE_TAC[IN_ELIM_THM; DOT_RZERO]; + ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(CARD(H:(real^N->bool)->bool))` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `~(h <= a) ==> a + 1 <= h`) THEN DISCH_TAC THEN + ASM_CASES_TAC `H:(real^N->bool)->bool = {}` THENL + [UNDISCH_THEN `H:(real^N->bool)->bool = {}` SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERS_0; INTER_UNIV]) THEN + UNDISCH_TAC `~(dim(p:real^N->bool) = 0)` THEN + REWRITE_TAC[DIM_EQ_0] THEN EXPAND_TAC "p" THEN + REWRITE_TAC[ASSUME `H:(real^N->bool)->bool = {}`; INTERS_0] THEN + REWRITE_TAC[INTER_UNIV] THEN + ASM_CASES_TAC `?n:real^N. n IN span p /\ ~(n = vec 0)` THENL + [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN DISCH_THEN(X_CHOOSE_THEN `B:real` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm n % n:real^N`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SPAN_MUL]; ALL_TAC] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `h:real^N->bool`) THEN + SUBGOAL_THEN + `span(IMAGE (a:(real^N->bool)->real^N) (H DELETE h)) + PSUBSET span(p)` + MP_TAC THENL + [REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN + REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_IMAGE; IN_DELETE] THEN + ASM_MESON_TAC[SPAN_ADD; SPAN_SUPERSET; VECTOR_ADD_LID]; + DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN + REWRITE_TAC[DIM_SPAN] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (ARITH_RULE `h <= p ==> h':num < h ==> ~(h' = p)`)) THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD(IMAGE (a:(real^N->bool)->real^N) (H DELETE h))` THEN + ASM_SIMP_TAC[DIM_LE_CARD; FINITE_DELETE; FINITE_IMAGE] THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD(H DELETE (h:real^N->bool))` THEN + ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN + ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN ASM SET_TAC[]]; + DISCH_THEN(MP_TAC o MATCH_MP ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN)] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLYTOPE_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISJ_CASES_TAC(REAL_ARITH + `&0 <= (a:(real^N->bool)->real^N) h dot n \/ + &0 <= --((a:(real^N->bool)->real^N) h dot n)`) + THENL + [DISCH_THEN(MP_TAC o SPEC `--(B + &1) / norm(n) % n:real^N`); + DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm(n) % n:real^N`)] THEN + (ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; + REAL_DIV_RMUL; NORM_EQ_0; REAL_ABS_NEG; + REAL_ARITH `~(abs(B + &1) <= B)`] THEN + EXPAND_TAC "p" THEN REWRITE_TAC[IN_INTER; IN_INTERS] THEN + ASM_SIMP_TAC[SPAN_MUL] THEN X_GEN_TAC `k:real^N->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN `k = {x:real^N | a k dot x <= b k}` SUBST1_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `k:real^N->bool = h` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; DOT_RMUL] THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH `x = &0 /\ &0 <= y ==> x <= y`) THEN + ASM_SIMP_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:(real^N->bool)->real^N) k`) THEN + REWRITE_TAC[orthogonal; DOT_SYM] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= --x * y /\ &0 <= z ==> x * y <= z`); + MATCH_MP_TAC(REAL_ARITH `&0 <= x * --y /\ &0 <= z ==> x * y <= z`)] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_ARITH `--a / b:real = --(a / b)`; REAL_NEG_NEG] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; NORM_POS_LT] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[SET_RULE `{f | ?h. h IN s /\ f = g h} = IMAGE g s`] THEN + MATCH_MP_TAC(ARITH_RULE `m:num = n ==> n <= m`) THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FACETS_OF_POLYHEDRON_EXPLICIT_DISTINCT THEN + ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN; HULL_INC]]);; + +(* ------------------------------------------------------------------------- *) +(* The notion of n-simplex where n is an integer >= -1. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("simplex",(12,"right"));; + +let simplex = new_definition + `n simplex s <=> ?c. ~(affine_dependent c) /\ + &(CARD c):int = n + &1 /\ + s = convex hull c`;; + +let SIMPLEX = prove + (`n simplex s <=> ?c. FINITE c /\ + ~(affine_dependent c) /\ + &(CARD c):int = n + &1 /\ + s = convex hull c`, + REWRITE_TAC[simplex] THEN MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);; + +let CONVEX_SIMPLEX = prove + (`!n s. n simplex s ==> convex s`, + REWRITE_TAC[simplex] THEN MESON_TAC[CONVEX_CONVEX_HULL]);; + +let COMPACT_SIMPLEX = prove + (`!n s. n simplex s ==> compact s`, + REWRITE_TAC[SIMPLEX] THEN + MESON_TAC[FINITE_IMP_COMPACT; COMPACT_CONVEX_HULL]);; + +let CLOSED_SIMPLEX = prove + (`!s n. n simplex s ==> closed s`, + MESON_TAC[COMPACT_SIMPLEX; COMPACT_IMP_CLOSED]);; + +let SIMPLEX_IMP_POLYTOPE = prove + (`!n s. n simplex s ==> polytope s`, + REWRITE_TAC[simplex; polytope] THEN + MESON_TAC[AFFINE_INDEPENDENT_IMP_FINITE]);; + +let SIMPLEX_DIM_GE = prove + (`!n s. n simplex s ==> -- &1 <= n`, + REWRITE_TAC[simplex] THEN INT_ARITH_TAC);; + +let SIMPLEX_EMPTY = prove + (`!n. n simplex {} <=> n = -- &1`, + GEN_TAC THEN REWRITE_TAC[SIMPLEX] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[CONVEX_HULL_EQ_EMPTY; CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[FINITE_EMPTY; CARD_CLAUSES; AFFINE_INDEPENDENT_EMPTY] THEN + INT_ARITH_TAC);; + +let SIMPLEX_MINUS_1 = prove + (`!s. (-- &1) simplex s <=> s = {}`, + GEN_TAC THEN REWRITE_TAC[SIMPLEX; INT_ADD_LINV; INT_OF_NUM_EQ] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b <=> ~(a ==> ~b)`] THEN + SIMP_TAC[CARD_EQ_0] THEN REWRITE_TAC[NOT_IMP] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> c /\ a /\ b /\ d`] THEN + REWRITE_TAC[UNWIND_THM2; FINITE_EMPTY; AFFINE_INDEPENDENT_EMPTY] THEN + REWRITE_TAC[CONVEX_HULL_EMPTY]);; + +let AFF_DIM_SIMPLEX = prove + (`!s n. n simplex s ==> aff_dim s = n`, + REWRITE_TAC[simplex; INT_ARITH `x:int = n + &1 <=> n = x - &1`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[AFF_DIM_CONVEX_HULL; AFF_DIM_AFFINE_INDEPENDENT]);; + +let SIMPLEX_EXTREME_POINTS = prove + (`!n s:real^N->bool. + n simplex s + ==> FINITE {v | v extreme_point_of s} /\ + ~(affine_dependent {v | v extreme_point_of s}) /\ + &(CARD {v | v extreme_point_of s}) = n + &1 /\ + s = convex hull {v | v extreme_point_of s}`, + REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLEX; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN `{v:real^N | v extreme_point_of s} = c` + (fun th -> ASM_REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t /\ ~(s PSUBSET t) ==> s = t`) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; EXTREME_POINT_OF_CONVEX_HULL] THEN + ABBREV_TAC `c' = {v:real^N | v extreme_point_of (convex hull c)}` THEN + DISCH_TAC THEN + SUBGOAL_THEN `convex hull c:real^N->bool = convex hull c'` ASSUME_TAC THENL + [EXPAND_TAC "c'" THEN MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN + REWRITE_TAC[CONVEX_CONVEX_HULL] THEN MATCH_MP_TAC COMPACT_CONVEX_HULL THEN + ASM_MESON_TAC[HAS_SIZE; FINITE_IMP_COMPACT]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_MEMBER]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN + REWRITE_TAC[] THEN EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:real^N) IN convex hull c'` MP_TAC THENL + [ASM_MESON_TAC[HULL_INC]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + CONVEX_HULL_SUBSET_AFFINE_HULL)) THEN + SUBGOAL_THEN `c' SUBSET (c DELETE (a:real^N))` MP_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[HULL_MONO; SUBSET]]]);; + +let SIMPLEX_FACE_OF_SIMPLEX = prove + (`!n s f:real^N->bool. + n simplex s /\ f face_of s ==> ?m. m <= n /\ m simplex f`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIMPLEX]) THEN + REWRITE_TAC[HAS_SIZE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN `?c':real^N->bool. c' SUBSET c /\ f = convex hull c'` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]; ALL_TAC] THEN + EXISTS_TAC `&(CARD(c':real^N->bool)) - &1:int` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] CARD_SUBSET)) THEN + ASM_REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN INT_ARITH_TAC; + REWRITE_TAC[simplex] THEN EXISTS_TAC `c':real^N->bool` THEN + ASM_REWRITE_TAC[INT_ARITH `a - &1 + &1:int = a`] THEN + ASM_MESON_TAC[AFFINE_DEPENDENT_MONO]]);; + +let FACE_OF_SIMPLEX_SUBSET = prove + (`!n s f:real^N->bool. + n simplex s /\ f face_of s + ==> ?c. c SUBSET {x | x extreme_point_of s} /\ f = convex hull c`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN + ABBREV_TAC `c = {x:real^N | x extreme_point_of s}` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_MESON_TAC[FACE_OF_CONVEX_HULL_SUBSET; FINITE_IMP_COMPACT]);; + +let SUBSET_FACE_OF_SIMPLEX = prove + (`!s n c:real^N->bool. + n simplex s /\ c SUBSET {x | x extreme_point_of s} + ==> (convex hull c) face_of s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN + REWRITE_TAC[HAS_SIZE] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC FACE_OF_CONVEX_HULLS THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE `!t. u SUBSET t /\ DISJOINT s t ==> DISJOINT s u`) THEN + EXISTS_TAC `affine hull ({v:real^N | v extreme_point_of s} DIFF c)` THEN + REWRITE_TAC[CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + MATCH_MP_TAC DISJOINT_AFFINE_HULL THEN + EXISTS_TAC `{v:real^N | v extreme_point_of s}` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let FACES_OF_SIMPLEX = prove + (`!n s. n simplex s + ==> {f | f face_of s} = + {convex hull c | c SUBSET {v | v extreme_point_of s}}`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[FACE_OF_SIMPLEX_SUBSET; SUBSET_FACE_OF_SIMPLEX]);; + +let HAS_SIZE_FACES_OF_SIMPLEX = prove + (`!n s:real^N->bool. + n simplex s + ==> {f | f face_of s} HAS_SIZE 2 EXP (num_of_int(n + &1))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP FACES_OF_SIMPLEX) THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o GSYM o MATCH_MP SIMPLEX_EXTREME_POINTS) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ]; + MATCH_MP_TAC HAS_SIZE_POWERSET THEN + ASM_REWRITE_TAC[HAS_SIZE; NUM_OF_INT_OF_NUM]] THEN + SUBGOAL_THEN + `!a b. a SUBSET {v:real^N | v extreme_point_of s} /\ + b SUBSET {v | v extreme_point_of s} /\ + convex hull a SUBSET convex hull b + ==> a SUBSET b` + (fun th -> MESON_TAC[th]) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [affine_dependent]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!s t u. x IN s /\ s SUBSET t /\ t SUBSET u /\ u SUBSET v ==> x IN v`) THEN + MAP_EVERY EXISTS_TAC + [`convex hull a:real^N->bool`; `convex hull b:real^N->bool`; + `affine hull b:real^N->bool`] THEN + ASM_SIMP_TAC[HULL_INC; CONVEX_HULL_SUBSET_AFFINE_HULL] THEN + MATCH_MP_TAC HULL_MONO THEN ASM SET_TAC[]);; + +let FINITE_FACES_OF_SIMPLEX = prove + (`!n s. n simplex s ==> FINITE {f | f face_of s}`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FACES_OF_SIMPLEX) THEN + SIMP_TAC[HAS_SIZE]);; + +let CARD_FACES_OF_SIMPLEX = prove + (`!n s. n simplex s ==> CARD {f | f face_of s} = 2 EXP (num_of_int(n + &1))`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FACES_OF_SIMPLEX) THEN + SIMP_TAC[HAS_SIZE]);; + +let CHOOSE_SIMPLEX = prove + (`!n. --(&1) <= n /\ n <= &(dimindex(:N)) ==> ?s:real^N->bool. n simplex s`, + X_GEN_TAC `d:int` THEN + REWRITE_TAC[INT_ARITH `--(&1):int <= n <=> n = --(&1) \/ &0 <= n`] THEN + DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC MP_TAC) THENL + [ASM_MESON_TAC[SIMPLEX_EMPTY]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM INT_OF_NUM_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + REWRITE_TAC[INT_OF_NUM_LE; GSYM DIM_UNIV] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CHOOSE_SUBSPACE_OF_SUBSPACE) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + EXISTS_TAC `convex hull ((vec 0:real^N) INSERT c)` THEN + REWRITE_TAC[simplex] THEN EXISTS_TAC `(vec 0:real^N) INSERT c` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP INDEPENDENT_NONZERO) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN + ASM_SIMP_TAC[CARD_CLAUSES; GSYM INT_OF_NUM_SUC] THEN + ASM_SIMP_TAC[INDEPENDENT_IMP_AFFINE_DEPENDENT_0] THEN + ASM_MESON_TAC[HAS_SIZE]);; + +let CHOOSE_POLYTOPE = prove + (`!n. --(&1) <= n /\ n <= &(dimindex(:N)) + ==> ?s:real^N->bool. polytope s /\ aff_dim s = n`, + MESON_TAC[CHOOSE_SIMPLEX; SIMPLEX_IMP_POLYTOPE; AFF_DIM_SIMPLEX]);; + +(* ------------------------------------------------------------------------- *) +(* Simplicial complexes and triangulations. *) +(* ------------------------------------------------------------------------- *) + +let simplicial_complex = new_definition + `simplicial_complex c <=> + FINITE c /\ + (!s. s IN c ==> ?n. n simplex s) /\ + (!f s. s IN c /\ f face_of s ==> f IN c) /\ + (!s s'. s IN c /\ s' IN c + ==> (s INTER s') face_of s /\ (s INTER s') face_of s')`;; + +let triangulation = new_definition + `triangulation(tr:(real^N->bool)->bool) <=> + FINITE tr /\ + (!t. t IN tr ==> ?n. n simplex t) /\ + (!t t'. t IN tr /\ t' IN tr + ==> (t INTER t') face_of t /\ (t INTER t') face_of t')`;; + +let SIMPLICIAL_COMPLEX_IMP_TRIANGULATION = prove + (`!tr. simplicial_complex tr ==> triangulation tr`, + REWRITE_TAC[triangulation; simplicial_complex] THEN MESON_TAC[]);; + +let TRIANGULATION_SUBSET = prove + (`!tr:(real^N->bool)->bool tr'. + triangulation tr /\ tr' SUBSET tr ==> triangulation tr'`, + REWRITE_TAC[triangulation] THEN + MESON_TAC[SUBSET; FINITE_SUBSET]);; + +let TRIANGULATION_UNION = prove + (`!tr1 tr2. + triangulation(tr1 UNION tr2) <=> + triangulation tr1 /\ triangulation tr2 /\ + (!s t. s IN tr1 /\ t IN tr2 + ==> s INTER t face_of s /\ s INTER t face_of t)`, + REWRITE_TAC[triangulation; FINITE_UNION; IN_UNION] THEN + MESON_TAC[INTER_COMM]);; + +let TRIANGULATION_INTER_SIMPLEX = prove + (`!tr t t':real^N->bool. + triangulation tr /\ t IN tr /\ t' IN tr + ==> t INTER t' = convex hull ({x | x extreme_point_of t} INTER + {x | x extreme_point_of t'})`, + REWRITE_TAC[triangulation] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`t:real^N->bool`; `t':real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> MAP_EVERY (MP_TAC o C SPEC th) + [`t:real^N->bool`; `t':real^N->bool`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`m:int`; `t':real^N->bool`; + `t INTER t':real^N->bool`] FACE_OF_SIMPLEX_SUBSET) THEN + MP_TAC(ISPECL [`n:int`; `t:real^N->bool`; + `t INTER t':real^N->bool`] FACE_OF_SIMPLEX_SUBSET) THEN + ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + DISCH_THEN(X_CHOOSE_THEN `d':real^N->bool` (STRIP_ASSUME_TAC o GSYM)) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HULL_MINIMAL THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[CONVEX_INTER; CONVEX_SIMPLEX]] THEN + SIMP_TAC[SUBSET; IN_INTER; IN_ELIM_THM; extreme_point_of]] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `convex hull {x:real^N | x extreme_point_of (t INTER t')}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE `s = t ==> s SUBSET t`) THEN + MATCH_MP_TAC KREIN_MILMAN_MINKOWSKI THEN + ASM_MESON_TAC[COMPACT_INTER; CONVEX_INTER; COMPACT_SIMPLEX; CONVEX_SIMPLEX]; + MATCH_MP_TAC HULL_MONO THEN REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THENL + [SUBST1_TAC(SYM(ASSUME `convex hull d:real^N->bool = t INTER t'`)); + SUBST1_TAC(SYM(ASSUME `convex hull d':real^N->bool = t INTER t'`))] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP EXTREME_POINT_OF_CONVEX_HULL) THEN + ASM SET_TAC[]]);; + +let TRIANGULATION_SIMPLICIAL_COMPLEX = prove + (`!tr. triangulation tr + ==> simplicial_complex {f:real^N->bool | ?t. t IN tr /\ f face_of t}`, + let lemma = prove + (`{f | ?t. t IN tr /\ P f t} = UNIONS (IMAGE (\t. {f | P f t}) tr)`, + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIONS; IN_IMAGE; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_ELIM_THM]) in + REWRITE_TAC[triangulation; simplicial_complex] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN GEN_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN STRIP_TAC THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[lemma] THEN ASM_SIMP_TAC[FINITE_UNIONS; FINITE_IMAGE] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[FINITE_FACES_OF_SIMPLEX]; + ASM_MESON_TAC[SIMPLEX_FACE_OF_SIMPLEX]; + ASM_MESON_TAC[FACE_OF_TRANS]; + ASM_MESON_TAC[FACE_OF_INTER_SUBFACE]]);; + +(* ------------------------------------------------------------------------- *) +(* Subdividing a cell complex (not necessarily simplicial). *) +(* ------------------------------------------------------------------------- *) + +let CELL_COMPLEX_SUBDIVISION_EXISTS = prove + (`!m:(real^N->bool)->bool d e. + &0 < e /\ + FINITE m /\ + (!c. c IN m ==> polytope c) /\ + (!c. c IN m ==> aff_dim c <= d) /\ + (!c1 c2. c1 IN m /\ c2 IN m + ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) + ==> ?m'. (!c. c IN m' ==> diameter c < e) /\ + UNIONS m' = UNIONS m /\ + FINITE m' /\ + (!c. c IN m' ==> polytope c) /\ + (!c. c IN m' ==> aff_dim c <= d) /\ + (!c1 c2. c1 IN m' /\ c2 IN m' + ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2)`, + let lemma1 = prove + (`a < abs(x - y) + ==> &0 < a + ==> ?n. integer n /\ (x < n * a /\ n * a < y \/ + y < n * a /\ n * a < x)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; GSYM REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC INTEGER_EXISTS_BETWEEN_ABS_LT THEN + REWRITE_TAC[real_div; GSYM REAL_SUB_RDISTRIB; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ABS_INV; REAL_ARITH `&0 < x ==> abs x = x`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; + REAL_MUL_LID; REAL_LT_IMP_LE]) + and lemma2 = prove + (`!m:(real^N->bool)->bool d. + FINITE m /\ + (!c. c IN m ==> polytope c) /\ + (!c. c IN m ==> aff_dim c <= d) /\ + (!c1 c2. c1 IN m /\ c2 IN m + ==> c1 INTER c2 face_of c1 /\ c1 INTER c2 face_of c2) + ==> !i. FINITE i + ==> ?m'. UNIONS m' = UNIONS m /\ + FINITE m' /\ + (!c. c IN m' ==> polytope c) /\ + (!c. c IN m' ==> aff_dim c <= d) /\ + (!c1 c2. c1 IN m' /\ c2 IN m' + ==> c1 INTER c2 face_of c1 /\ + c1 INTER c2 face_of c2) /\ + (!c x y. c IN m' /\ x IN c /\ y IN c + ==> !a b. (a,b) IN i + ==> a dot x <= b /\ a dot y <= b \/ + a dot x >= b /\ a dot y >= b)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY; FORALL_PAIR_THM] THEN CONJ_TAC THENL + [EXISTS_TAC `m:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real`; `i:(real^N#real)->bool`] THEN + GEN_REWRITE_TAC I [IMP_CONJ] THEN + DISCH_THEN(X_CHOOSE_THEN `n:(real^N->bool)->bool` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) MP_TAC) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `{c INTER {x:real^N | a dot x <= b} | c IN n} UNION + {c INTER {x:real^N | a dot x >= b} | c IN n}` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_UNION; GSYM INTER_UNIONS; GSYM UNION_OVER_INTER] THEN + MATCH_MP_TAC(SET_RULE `(!x. x IN s) ==> t INTER s = t`) THEN + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[FINITE_UNION; SIMPLE_IMAGE; FINITE_IMAGE]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[POLYTOPE_INTER_POLYHEDRON; POLYHEDRON_HALFSPACE_LE; + POLYHEDRON_HALFSPACE_GE]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[INT_LE_TRANS; AFF_DIM_SUBSET; INTER_SUBSET]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SET_RULE + `(s INTER t) INTER (s' INTER t') = (s INTER s') INTER (t INTER t')`] THEN + MATCH_MP_TAC FACE_OF_INTER_INTER THEN ASM_SIMP_TAC[] THEN + SIMP_TAC[SET_RULE `s INTER s = s`; FACE_OF_REFL; CONVEX_HALFSPACE_LE; + CONVEX_HALFSPACE_GE] THEN + REWRITE_TAC[INTER; IN_ELIM_THM; HYPERPLANE_FACE_OF_HALFSPACE_LE; + HYPERPLANE_FACE_OF_HALFSPACE_GE; + REAL_ARITH `a <= b /\ a >= b <=> a = b`; + REAL_ARITH `a >= b /\ a <= b <=> a = b`]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_UNION; FORALL_AND_THM; + IN_INSERT; + TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_INTER; IN_ELIM_THM; PAIR_EQ] THEN + SIMP_TAC[] THEN ASM_MESON_TAC[]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `bounded(UNIONS m:real^N->bool)` MP_TAC THENL + [ASM_SIMP_TAC[BOUNDED_UNIONS; POLYTOPE_IMP_BOUNDED]; ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS_LT; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`--B / (e / &2 / &(dimindex(:N)))`; + `B / (e / &2 / &(dimindex(:N)))`] FINITE_INTSEG) THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_HALF; + REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN + REWRITE_TAC[REAL_BOUNDS_LE] THEN ABBREV_TAC + `k = {i | integer i /\ abs(i * e / &2 / &(dimindex(:N))) <= B}` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`m:(real^N->bool)->bool`; `d:int`] lemma2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC + `{ (basis i:real^N,j * e / &2 / &(dimindex(:N))) | + i IN 1..dimindex(:N) /\ j IN k}`) THEN + ASM_SIMP_TAC[FINITE_PRODUCT_DEPENDENT; FINITE_NUMSEG] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:(real^N->bool)->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIAMETER_LE THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_BOUND_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY] THEN + REWRITE_TAC[NOT_LT; DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + DISCH_THEN(MP_TAC o MATCH_MP lemma1) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; + REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN + DISCH_THEN(X_CHOOSE_THEN `j:real` (CONJUNCTS_THEN ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^N->bool`; `x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o + SPECL [`basis i:real^N`; `j * e / &2 / &(dimindex(:N))`]) THEN + ASM_SIMP_TAC[DOT_BASIS; IN_ELIM_THM; NOT_IMP] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MAP_EVERY EXISTS_TAC [`i:num`; `j:real`] THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN + EXPAND_TAC "k" THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `a < x /\ x < b + ==> abs a <= c /\ abs b <= c ==> abs x <= c`)) THEN + CONJ_TAC THEN + W(MP_TAC o PART_MATCH lhand COMPONENT_LE_NORM o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM SET_TAC[]);; diff --git a/Multivariate/realanalysis.ml b/Multivariate/realanalysis.ml new file mode 100644 index 0000000..6581985 --- /dev/null +++ b/Multivariate/realanalysis.ml @@ -0,0 +1,15845 @@ +(* ========================================================================= *) +(* Some analytic concepts for R instead of R^1. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Library/binomial.ml";; +needs "Multivariate/measure.ml";; +needs "Multivariate/polytope.ml";; +needs "Multivariate/transcendentals.ml";; + +(* ------------------------------------------------------------------------- *) +(* Open-ness and closedness of a set of reals. *) +(* ------------------------------------------------------------------------- *) + +let real_open = new_definition + `real_open s <=> + !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`;; + +let real_closed = new_definition + `real_closed s <=> real_open((:real) DIFF s)`;; + +let euclideanreal = new_definition + `euclideanreal = topology real_open`;; + +let REAL_OPEN_EMPTY = prove + (`real_open {}`, + REWRITE_TAC[real_open; NOT_IN_EMPTY]);; + +let REAL_OPEN_UNIV = prove + (`real_open(:real)`, + REWRITE_TAC[real_open; IN_UNIV] THEN MESON_TAC[REAL_LT_01]);; + +let REAL_OPEN_INTER = prove + (`!s t. real_open s /\ real_open t ==> real_open (s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_open; AND_FORALL_THM; IN_INTER] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN + ASM_MESON_TAC[REAL_LT_TRANS]);; + +let REAL_OPEN_UNIONS = prove + (`(!s. s IN f ==> real_open s) ==> real_open(UNIONS f)`, + REWRITE_TAC[real_open; IN_UNIONS] THEN MESON_TAC[]);; + +let REAL_OPEN_IN = prove + (`!s. real_open s <=> open_in euclideanreal s`, + GEN_TAC THEN REWRITE_TAC[euclideanreal] THEN CONV_TAC SYM_CONV THEN + AP_THM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 topology_tybij)] THEN + REWRITE_TAC[REWRITE_RULE[IN] istopology] THEN + REWRITE_TAC[REAL_OPEN_EMPTY; REAL_OPEN_INTER; SUBSET] THEN + MESON_TAC[IN; REAL_OPEN_UNIONS]);; + +let TOPSPACE_EUCLIDEANREAL = prove + (`topspace euclideanreal = (:real)`, + REWRITE_TAC[topspace; EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN + MESON_TAC[REAL_OPEN_UNIV; IN_UNIV; REAL_OPEN_IN]);; + +let TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY = prove + (`!s. topspace (subtopology euclideanreal s) = s`, + REWRITE_TAC[TOPSPACE_EUCLIDEANREAL; TOPSPACE_SUBTOPOLOGY; INTER_UNIV]);; + +let REAL_CLOSED_IN = prove + (`!s. real_closed s <=> closed_in euclideanreal s`, + REWRITE_TAC[real_closed; closed_in; TOPSPACE_EUCLIDEANREAL; + REAL_OPEN_IN; SUBSET_UNIV]);; + +let REAL_OPEN_UNION = prove + (`!s t. real_open s /\ real_open t ==> real_open(s UNION t)`, + REWRITE_TAC[REAL_OPEN_IN; OPEN_IN_UNION]);; + +let REAL_OPEN_SUBREAL_OPEN = prove + (`!s. real_open s <=> !x. x IN s ==> ?t. real_open t /\ x IN t /\ t SUBSET s`, + REWRITE_TAC[REAL_OPEN_IN; GSYM OPEN_IN_SUBOPEN]);; + +let REAL_CLOSED_EMPTY = prove + (`real_closed {}`, + REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_EMPTY]);; + +let REAL_CLOSED_UNIV = prove + (`real_closed(:real)`, + REWRITE_TAC[REAL_CLOSED_IN; GSYM TOPSPACE_EUCLIDEANREAL; CLOSED_IN_TOPSPACE]);; + +let REAL_CLOSED_UNION = prove + (`!s t. real_closed s /\ real_closed t ==> real_closed(s UNION t)`, + REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_UNION]);; + +let REAL_CLOSED_INTER = prove + (`!s t. real_closed s /\ real_closed t ==> real_closed(s INTER t)`, + REWRITE_TAC[REAL_CLOSED_IN; CLOSED_IN_INTER]);; + +let REAL_CLOSED_INTERS = prove + (`!f. (!s. s IN f ==> real_closed s) ==> real_closed(INTERS f)`, + REWRITE_TAC[REAL_CLOSED_IN] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `f:(real->bool)->bool = {}` THEN + ASM_SIMP_TAC[CLOSED_IN_INTERS; INTERS_0] THEN + REWRITE_TAC[GSYM TOPSPACE_EUCLIDEANREAL; CLOSED_IN_TOPSPACE]);; + +let REAL_OPEN_REAL_CLOSED = prove + (`!s. real_open s <=> real_closed(UNIV DIFF s)`, + SIMP_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; TOPSPACE_EUCLIDEANREAL; SUBSET_UNIV; + OPEN_IN_CLOSED_IN_EQ]);; + +let REAL_OPEN_DIFF = prove + (`!s t. real_open s /\ real_closed t ==> real_open(s DIFF t)`, + REWRITE_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; OPEN_IN_DIFF]);; + +let REAL_CLOSED_DIFF = prove + (`!s t. real_closed s /\ real_open t ==> real_closed(s DIFF t)`, + REWRITE_TAC[REAL_OPEN_IN; REAL_CLOSED_IN; CLOSED_IN_DIFF]);; + +let REAL_OPEN_INTERS = prove + (`!s. FINITE s /\ (!t. t IN s ==> real_open t) ==> real_open(INTERS s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[INTERS_INSERT; INTERS_0; REAL_OPEN_UNIV; IN_INSERT] THEN + MESON_TAC[REAL_OPEN_INTER]);; + +let REAL_CLOSED_UNIONS = prove + (`!s. FINITE s /\ (!t. t IN s ==> real_closed t) ==> real_closed(UNIONS s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_INSERT; UNIONS_0; REAL_CLOSED_EMPTY; IN_INSERT] THEN + MESON_TAC[REAL_CLOSED_UNION]);; + +let REAL_OPEN = prove + (`!s. real_open s <=> open(IMAGE lift s)`, + REWRITE_TAC[real_open; open_def; FORALL_IN_IMAGE; FORALL_LIFT; DIST_LIFT; + LIFT_IN_IMAGE_LIFT]);; + +let REAL_CLOSED = prove + (`!s. real_closed s <=> closed(IMAGE lift s)`, + GEN_TAC THEN REWRITE_TAC[real_closed; REAL_OPEN; closed] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_UNIV] THEN + MESON_TAC[LIFT_DROP]);; + +let REAL_CLOSED_HALFSPACE_LE = prove + (`!a. real_closed {x | x <= a}`, + GEN_TAC THEN SUBGOAL_THEN `closed {x | drop x <= a}` MP_TAC THENL + [REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_CLOSED] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_CLOSED_HALFSPACE_GE = prove + (`!a. real_closed {x | x >= a}`, + GEN_TAC THEN SUBGOAL_THEN `closed {x | drop x >= a}` MP_TAC THENL + [REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_GE]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_CLOSED] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_OPEN_HALFSPACE_LT = prove + (`!a. real_open {x | x < a}`, + GEN_TAC THEN SUBGOAL_THEN `open {x | drop x < a}` MP_TAC THENL + [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_LT]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_OPEN] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_OPEN_HALFSPACE_GT = prove + (`!a. real_open {x | x > a}`, + GEN_TAC THEN SUBGOAL_THEN `open {x | drop x > a}` MP_TAC THENL + [REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_GT]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[REAL_OPEN] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Compactness of a set of reals. *) +(* ------------------------------------------------------------------------- *) + +let real_bounded = new_definition + `real_bounded s <=> ?B. !x. x IN s ==> abs(x) <= B`;; + +let REAL_BOUNDED = prove + (`real_bounded s <=> bounded(IMAGE lift s)`, + REWRITE_TAC[BOUNDED_LIFT; real_bounded]);; + +let REAL_BOUNDED_POS = prove + (`!s. real_bounded s <=> ?B. &0 < B /\ !x. x IN s ==> abs(x) <= B`, + REWRITE_TAC[real_bounded] THEN + MESON_TAC[REAL_ARITH `&0 < &1 + abs B /\ (x <= B ==> x <= &1 + abs B)`]);; + +let REAL_BOUNDED_POS_LT = prove + (`!s. real_bounded s <=> ?b. &0 < b /\ !x. x IN s ==> abs(x) < b`, + REWRITE_TAC[real_bounded] THEN + MESON_TAC[REAL_LT_IMP_LE; + REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);; + +let REAL_BOUNDED_SUBSET = prove + (`!s t. real_bounded t /\ s SUBSET t ==> real_bounded s`, + MESON_TAC[REAL_BOUNDED; BOUNDED_SUBSET; IMAGE_SUBSET]);; + +let REAL_BOUNDED_UNION = prove + (`!s t. real_bounded(s UNION t) <=> real_bounded s /\ real_bounded t`, + REWRITE_TAC[REAL_BOUNDED; IMAGE_UNION; BOUNDED_UNION]);; + +let real_compact = new_definition + `real_compact s <=> compact(IMAGE lift s)`;; + +let REAL_COMPACT_IMP_BOUNDED = prove + (`!s. real_compact s ==> real_bounded s`, + REWRITE_TAC[real_compact; REAL_BOUNDED; COMPACT_IMP_BOUNDED]);; + +let REAL_COMPACT_IMP_CLOSED = prove + (`!s. real_compact s ==> real_closed s`, + REWRITE_TAC[real_compact; REAL_CLOSED; COMPACT_IMP_CLOSED]);; + +let REAL_COMPACT_EQ_BOUNDED_CLOSED = prove + (`!s. real_compact s <=> real_bounded s /\ real_closed s`, + REWRITE_TAC[real_compact; REAL_BOUNDED; REAL_CLOSED] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; + +let REAL_COMPACT_UNION = prove + (`!s t. real_compact s /\ real_compact t ==> real_compact(s UNION t)`, + REWRITE_TAC[real_compact; IMAGE_UNION; COMPACT_UNION]);; + +let REAL_COMPACT_ATTAINS_INF = prove + (`!s. real_compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> x <= y`, + REWRITE_TAC[real_compact; COMPACT_ATTAINS_INF]);; + +let REAL_COMPACT_ATTAINS_SUP = prove + (`!s. real_compact s /\ ~(s = {}) ==> ?x. x IN s /\ !y. y IN s ==> y <= x`, + REWRITE_TAC[real_compact; COMPACT_ATTAINS_SUP]);; + +(* ------------------------------------------------------------------------- *) +(* Limits of functions with real range. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("--->",(12,"right"));; + +let tendsto_real = new_definition + `(f ---> l) net <=> !e. &0 < e ==> eventually (\x. abs(f(x) - l) < e) net`;; + +let reallim = new_definition + `reallim net f = @l. (f ---> l) net`;; + +let TENDSTO_REAL = prove + (`(s ---> l) = ((lift o s) --> lift l)`, + REWRITE_TAC[FUN_EQ_THM; tendsto; tendsto_real; o_THM; DIST_LIFT]);; + +let REAL_TENDSTO = prove + (`(s --> l) = (drop o s ---> drop l)`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP; ETA_AX]);; + +let REALLIM_COMPLEX = prove + (`(s ---> l) = ((Cx o s) --> Cx(l))`, + REWRITE_TAC[FUN_EQ_THM; tendsto; tendsto_real; o_THM; dist; + GSYM CX_SUB; COMPLEX_NORM_CX]);; + +let REALLIM_UNIQUE = prove + (`!net f l l'. + ~trivial_limit net /\ (f ---> l) net /\ (f ---> l') net ==> l = l'`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_UNIQUE) THEN REWRITE_TAC[LIFT_EQ]);; + +let REALLIM_CONST = prove + (`!net a. ((\x. a) ---> a) net`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIM_CONST]);; + +let REALLIM_LMUL = prove + (`!f l c. (f ---> l) net ==> ((\x. c * f x) ---> c * l) net`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_CMUL; LIM_CMUL]);; + +let REALLIM_RMUL = prove + (`!f l c. (f ---> l) net ==> ((\x. f x * c) ---> l * c) net`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_LMUL]);; + +let REALLIM_LMUL_EQ = prove + (`!net f l c. + ~(c = &0) ==> (((\x. c * f x) ---> c * l) net <=> (f ---> l) net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[REALLIM_LMUL] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP REALLIM_LMUL) THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID; ETA_AX]);; + +let REALLIM_RMUL_EQ = prove + (`!net f l c. + ~(c = &0) ==> (((\x. f x * c) ---> l * c) net <=> (f ---> l) net)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REALLIM_LMUL_EQ]);; + +let REALLIM_NEG = prove + (`!net f l. (f ---> l) net ==> ((\x. --(f x)) ---> --l) net`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NEG; LIM_NEG]);; + +let REALLIM_NEG_EQ = prove + (`!net f l. ((\x. --(f x)) ---> --l) net <=> (f ---> l) net`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NEG; LIM_NEG_EQ]);; + +let REALLIM_ADD = prove + (`!net:(A)net f g l m. + (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) + g(x)) ---> l + m) net`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_ADD; LIM_ADD]);; + +let REALLIM_SUB = prove + (`!net:(A)net f g l m. + (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) - g(x)) ---> l - m) net`, + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_SUB; LIM_SUB]);; + +let REALLIM_MUL = prove + (`!net:(A)net f g l m. + (f ---> l) net /\ (g ---> m) net ==> ((\x. f(x) * g(x)) ---> l * m) net`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_MUL; LIM_COMPLEX_MUL]);; + +let REALLIM_INV = prove + (`!net f l. + (f ---> l) net /\ ~(l = &0) ==> ((\x. inv(f x)) ---> inv l) net`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_COMPLEX_INV; GSYM CX_INJ]);; + +let REALLIM_DIV = prove + (`!net:(A)net f g l m. + (f ---> l) net /\ (g ---> m) net /\ ~(m = &0) + ==> ((\x. f(x) / g(x)) ---> l / m) net`, + SIMP_TAC[real_div; REALLIM_MUL; REALLIM_INV]);; + +let REALLIM_ABS = prove + (`!net f l. (f ---> l) net ==> ((\x. abs(f x)) ---> abs l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto_real] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let REALLIM_POW = prove + (`!net f l n. (f ---> l) net ==> ((\x. f x pow n) ---> l pow n) net`, + REPLICATE_TAC 3 GEN_TAC THEN + INDUCT_TAC THEN ASM_SIMP_TAC[real_pow; REALLIM_CONST; REALLIM_MUL]);; + +let REALLIM_MAX = prove + (`!net:(A)net f g l m. + (f ---> l) net /\ (g ---> m) net + ==> ((\x. max (f x) (g x)) ---> max l m) net`, + REWRITE_TAC[REAL_ARITH `max x y = inv(&2) * ((x + y) + abs(x - y))`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN + ASM_SIMP_TAC[REALLIM_ADD; REALLIM_ABS; REALLIM_SUB]);; + +let REALLIM_MIN = prove + (`!net:(A)net f g l m. + (f ---> l) net /\ (g ---> m) net + ==> ((\x. min (f x) (g x)) ---> min l m) net`, + REWRITE_TAC[REAL_ARITH `min x y = inv(&2) * ((x + y) - abs(x - y))`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN + ASM_SIMP_TAC[REALLIM_ADD; REALLIM_ABS; REALLIM_SUB]);; + +let REALLIM_NULL = prove + (`!net f l. (f ---> l) net <=> ((\x. f(x) - l) ---> &0) net`, + REWRITE_TAC[tendsto_real; REAL_SUB_RZERO]);; + +let REALLIM_NULL_ADD = prove + (`!net:(A)net f g. + (f ---> &0) net /\ (g ---> &0) net ==> ((\x. f(x) + g(x)) ---> &0) net`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REALLIM_ADD) THEN + REWRITE_TAC[REAL_ADD_LID]);; + +let REALLIM_NULL_LMUL = prove + (`!net f c. (f ---> &0) net ==> ((\x. c * f x) ---> &0) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP REALLIM_LMUL) THEN + REWRITE_TAC[REAL_MUL_RZERO]);; + +let REALLIM_NULL_RMUL = prove + (`!net f c. (f ---> &0) net ==> ((\x. f x * c) ---> &0) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP REALLIM_RMUL) THEN + REWRITE_TAC[REAL_MUL_LZERO]);; + +let REALLIM_NULL_POW = prove + (`!net f n. (f ---> &0) net /\ ~(n = 0) ==> ((\x. f x pow n) ---> &0) net`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `n:num` o MATCH_MP REALLIM_POW) ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_POW_ZERO]);; + +let REALLIM_NULL_LMUL_EQ = prove + (`!net f c. + ~(c = &0) ==> (((\x. c * f x) ---> &0) net <=> (f ---> &0) net)`, + MESON_TAC[REALLIM_LMUL_EQ; REAL_MUL_RZERO]);; + +let REALLIM_NULL_RMUL_EQ = prove + (`!net f c. + ~(c = &0) ==> (((\x. f x * c) ---> &0) net <=> (f ---> &0) net)`, + MESON_TAC[REALLIM_RMUL_EQ; REAL_MUL_LZERO]);; + +let REALLIM_NULL_NEG = prove + (`!net f. ((\x. --(f x)) ---> &0) net <=> (f ---> &0) net`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REAL_ARITH `--x = --(&1) * x`] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL_EQ THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let REALLIM_RE = prove + (`!net f l. (f --> l) net ==> ((Re o f) ---> Re l) net`, + REWRITE_TAC[REALLIM_COMPLEX] THEN + REWRITE_TAC[tendsto; dist; o_THM; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM RE_SUB; eventually] THEN + MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);; + +let REALLIM_IM = prove + (`!net f l. (f --> l) net ==> ((Im o f) ---> Im l) net`, + REWRITE_TAC[REALLIM_COMPLEX] THEN + REWRITE_TAC[tendsto; dist; o_THM; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM IM_SUB; eventually] THEN + MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]);; + +let REALLIM_TRANSFORM_EVENTUALLY = prove + (`!net f g l. + eventually (\x. f x = g x) net /\ (f ---> l) net ==> (g ---> l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + POP_ASSUM MP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + SIMP_TAC[o_THM]);; + +let REALLIM_TRANSFORM = prove + (`!net f g l. + ((\x. f x - g x) ---> &0) net /\ (f ---> l) net ==> (g ---> l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF; LIFT_NUM; LIFT_SUB; LIM_TRANSFORM]);; + +let REALLIM_TRANSFORM_EQ = prove + (`!net f:A->real g l. + ((\x. f x - g x) ---> &0) net ==> ((f ---> l) net <=> (g ---> l) net)`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF; LIFT_NUM; LIFT_SUB; LIM_TRANSFORM_EQ]);; + +let REAL_SEQ_OFFSET = prove + (`!f l k. (f ---> l) sequentially ==> ((\i. f (i + k)) ---> l) sequentially`, + REPEAT GEN_TAC THEN SIMP_TAC[TENDSTO_REAL; o_DEF] THEN + DISCH_THEN(MP_TAC o MATCH_MP SEQ_OFFSET) THEN SIMP_TAC[]);; + +let REAL_SEQ_OFFSET_REV = prove + (`!f l k. ((\i. f (i + k)) ---> l) sequentially ==> (f ---> l) sequentially`, + SIMP_TAC[TENDSTO_REAL; o_DEF] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SEQ_OFFSET_REV THEN EXISTS_TAC `k:num` THEN ASM_SIMP_TAC[]);; + +let REALLIM_TRANSFORM_STRADDLE = prove + (`!f g h a. + eventually (\n. f(n) <= g(n)) net /\ (f ---> a) net /\ + eventually (\n. g(n) <= h(n)) net /\ (h ---> a) net + ==> (g ---> a) net`, + REPEAT GEN_TAC THEN + REWRITE_TAC[RIGHT_AND_FORALL_THM; tendsto_real; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REAL_ARITH_TAC);; + +let REALLIM_TRANSFORM_BOUND = prove + (`!f g. eventually (\n. abs(f n) <= g n) net /\ (g ---> &0) net + ==> (f ---> &0) net`, + REPEAT GEN_TAC THEN + REWRITE_TAC[RIGHT_AND_FORALL_THM; tendsto_real; AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REAL_ARITH_TAC);; + +let REAL_CONVERGENT_IMP_BOUNDED = prove + (`!s l. (s ---> l) sequentially ==> real_bounded (IMAGE s (:num))`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_BOUNDED; TENDSTO_REAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[o_DEF; NORM_LIFT]);; + +let REALLIM = prove + (`(f ---> l) net <=> + trivial_limit net \/ + !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ + !x. netord(net) x y ==> abs(f(x) -l) < e`, + REWRITE_TAC[tendsto_real; eventually] THEN MESON_TAC[]);; + +let REALLIM_NULL_ABS = prove + (`!net f. ((\x. abs(f x)) ---> &0) net <=> (f ---> &0) net`, + REWRITE_TAC[REALLIM; REAL_SUB_RZERO; REAL_ABS_ABS]);; + +let REALLIM_WITHIN_LE = prove + (`!f:real^N->real l a s. + (f ---> l) (at a within s) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d + ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_WITHIN_LE]);; + +let REALLIM_WITHIN = prove + (`!f:real^N->real l a s. + (f ---> l) (at a within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d + ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; + +let REALLIM_AT = prove + (`!f l a:real^N. + (f ---> l) (at a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d + ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_AT] THEN MESON_TAC[]);; + +let REALLIM_AT_INFINITY = prove + (`!f l. (f ---> l) at_infinity <=> + !e. &0 < e ==> ?b. !x. norm(x) >= b ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);; + +let REALLIM_AT_INFINITY_COMPLEX_0 = prove + (`!f l. (f ---> l) at_infinity <=> ((f o inv) ---> l) (at(Cx(&0)))`, + REWRITE_TAC[REALLIM_COMPLEX; LIM_AT_INFINITY_COMPLEX_0] THEN + REWRITE_TAC[o_ASSOC]);; + +let REALLIM_SEQUENTIALLY = prove + (`!s l. (s ---> l) sequentially <=> + !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(n) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; + +let REALLIM_EVENTUALLY = prove + (`!net f l. eventually (\x. f x = l) net ==> (f ---> l) net`, + REWRITE_TAC[eventually; REALLIM] THEN + MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; + +let LIM_COMPONENTWISE = prove + (`!net f:A->real^N. + (f --> l) net <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> ((\x. (f x)$i) ---> l$i) net`, + ONCE_REWRITE_TAC[LIM_COMPONENTWISE_LIFT] THEN + REWRITE_TAC[TENDSTO_REAL; o_DEF]);; + +let REALLIM_UBOUND = prove + (`!(net:A net) f l b. + (f ---> l) net /\ + ~trivial_limit net /\ + eventually (\x. f x <= b) net + ==> l <= b`, + REWRITE_TAC[FORALL_DROP; TENDSTO_REAL; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `net:A net` LIM_DROP_UBOUND) THEN + EXISTS_TAC `lift o (f:A->real)` THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP]);; + +let REALLIM_LBOUND = prove + (`!(net:A net) f l b. + (f ---> l) net /\ + ~trivial_limit net /\ + eventually (\x. b <= f x) net + ==> b <= l`, + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `net:A net` REALLIM_UBOUND) THEN + EXISTS_TAC `\a:A. --(f a:real)` THEN + ASM_REWRITE_TAC[REALLIM_NEG_EQ]);; + +let REALLIM_LE = prove + (`!net f g l m. + (f ---> l) net /\ (g ---> m) net /\ + ~trivial_limit net /\ + eventually (\x. f x <= g x) net + ==> l <= m`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o MATCH_MP REALLIM_SUB o ONCE_REWRITE_RULE[CONJ_SYM]) MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + REWRITE_TAC[GSYM IMP_CONJ_ALT; GSYM CONJ_ASSOC] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP REALLIM_LBOUND));; + +let REALLIM_CONST_EQ = prove + (`!net:(A net) c d. ((\x. c) ---> d) net <=> trivial_limit net \/ c = d`, + REWRITE_TAC[TENDSTO_REAL; LIM_CONST_EQ; o_DEF; LIFT_EQ]);; + +let REALLIM_SUM = prove + (`!net f:A->B->real l s. + FINITE s /\ (!i. i IN s ==> ((f i) ---> (l i)) net) + ==> ((\x. sum s (\i. f i x)) ---> sum s l) net`, + REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; REALLIM_CONST; REALLIM_ADD; IN_INSERT; ETA_AX]);; + +let REALLIM_NULL_COMPARISON = prove + (`!net:(A)net f g. + eventually (\x. abs(f x) <= g x) net /\ (g ---> &0) net + ==> (f ---> &0) net`, + REWRITE_TAC[TENDSTO_REAL; LIFT_NUM; o_DEF] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC `g:A->real` THEN ASM_REWRITE_TAC[NORM_LIFT]);; + +(* ------------------------------------------------------------------------- *) +(* Real series. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("real_sums",(12,"right"));; + +let real_sums = new_definition + `(f real_sums l) s <=> ((\n. sum (s INTER (0..n)) f) ---> l) sequentially`;; + +let real_infsum = new_definition + `real_infsum s f = @l. (f real_sums l) s`;; + +let real_summable = new_definition + `real_summable s f = ?l. (f real_sums l) s`;; + +let REAL_SUMS = prove + (`(f real_sums l) = ((lift o f) sums (lift l))`, + REWRITE_TAC[FUN_EQ_THM; sums; real_sums; TENDSTO_REAL] THEN + SIMP_TAC[LIFT_SUM; FINITE_INTER_NUMSEG; o_DEF]);; + +let REAL_SUMS_RE = prove + (`!f l s. (f sums l) s ==> ((Re o f) real_sums (Re l)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; sums] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_RE) THEN + SIMP_TAC[o_DEF; RE_VSUM; FINITE_INTER_NUMSEG]);; + +let REAL_SUMS_IM = prove + (`!f l s. (f sums l) s ==> ((Im o f) real_sums (Im l)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; sums] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_IM) THEN + SIMP_TAC[o_DEF; IM_VSUM; FINITE_INTER_NUMSEG]);; + +let REAL_SUMS_COMPLEX = prove + (`!f l s. (f real_sums l) s <=> ((Cx o f) sums (Cx l)) s`, + REWRITE_TAC[real_sums; sums; REALLIM_COMPLEX] THEN + SIMP_TAC[o_DEF; VSUM_CX; FINITE_INTER; FINITE_NUMSEG]);; + +let REAL_SUMMABLE = prove + (`real_summable s f <=> summable s (lift o f)`, + REWRITE_TAC[real_summable; summable; REAL_SUMS; GSYM EXISTS_LIFT]);; + +let REAL_SUMMABLE_COMPLEX = prove + (`real_summable s f <=> summable s (Cx o f)`, + REWRITE_TAC[real_summable; summable; REAL_SUMS_COMPLEX] THEN + EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `l:complex`) THEN EXISTS_TAC `Re l` THEN + SUBGOAL_THEN `Cx(Re l) = l` (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[GSYM REAL] THEN MATCH_MP_TAC REAL_SERIES THEN + MAP_EVERY EXISTS_TAC [`Cx o (f:num->real)`; `s:num->bool`] THEN + ASM_REWRITE_TAC[o_THM; REAL_CX]);; + +let REAL_SERIES_CAUCHY = prove + (`(?l. (f real_sums l) s) <=> + (!e. &0 < e ==> ?N. !m n. m >= N ==> abs(sum(s INTER (m..n)) f) < e)`, + REWRITE_TAC[REAL_SUMS; SERIES_CAUCHY; GSYM EXISTS_LIFT] THEN + SIMP_TAC[NORM_REAL; GSYM drop; DROP_VSUM; FINITE_INTER_NUMSEG] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);; + +let REAL_SUMS_SUMMABLE = prove + (`!f l s. (f real_sums l) s ==> real_summable s f`, + REWRITE_TAC[real_summable] THEN MESON_TAC[]);; + +let REAL_SUMS_INFSUM = prove + (`!f s. (f real_sums (real_infsum s f)) s <=> real_summable s f`, + REWRITE_TAC[real_infsum; real_summable] THEN MESON_TAC[]);; + +let REAL_INFSUM_COMPLEX = prove + (`!f s. real_summable s f ==> real_infsum s f = Re(infsum s (Cx o f))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM REAL_SUMS_INFSUM; REAL_SUMS_COMPLEX] THEN + DISCH_THEN(MP_TAC o MATCH_MP INFSUM_UNIQUE) THEN + MESON_TAC[RE_CX]);; + +let REAL_SERIES_FROM = prove + (`!f l k. (f real_sums l) (from k) = ((\n. sum(k..n) f) ---> l) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);; + +let REAL_SERIES_UNIQUE = prove + (`!f l l' s. (f real_sums l) s /\ (f real_sums l') s ==> l = l'`, + REWRITE_TAC[real_sums] THEN + MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; REALLIM_UNIQUE]);; + +let REAL_INFSUM_UNIQUE = prove + (`!f l s. (f real_sums l) s ==> real_infsum s f = l`, + MESON_TAC[REAL_SERIES_UNIQUE; REAL_SUMS_INFSUM; real_summable]);; + +let REAL_SERIES_FINITE = prove + (`!f s. FINITE s ==> (f real_sums (sum s f)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `s INTER (0..m) = s` + (fun th -> ASM_REWRITE_TAC[th; REAL_SUB_REFL; REAL_ABS_NUM]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LE_TRANS]);; + +let REAL_SUMMABLE_IFF_EVENTUALLY = prove + (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) + ==> (real_summable k f <=> real_summable k g)`, + REWRITE_TAC[REAL_SUMMABLE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN REWRITE_TAC[o_THM] THEN + ASM_MESON_TAC[]);; + +let REAL_SUMMABLE_EQ_EVENTUALLY = prove + (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ real_summable k f + ==> real_summable k g`, + MESON_TAC[REAL_SUMMABLE_IFF_EVENTUALLY]);; + +let REAL_SUMMABLE_IFF_COFINITE = prove + (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) + ==> (real_summable s f <=> real_summable t f)`, + SIMP_TAC[REAL_SUMMABLE] THEN MESON_TAC[SUMMABLE_IFF_COFINITE]);; + +let REAL_SUMMABLE_EQ_COFINITE = prove + (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ real_summable s f + ==> real_summable t f`, + MESON_TAC[REAL_SUMMABLE_IFF_COFINITE]);; + +let REAL_SUMMABLE_FROM_ELSEWHERE = prove + (`!f m n. real_summable (from m) f ==> real_summable (from n) f`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_SUMMABLE_EQ_COFINITE) THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN + ARITH_TAC);; + +let REAL_SERIES_GOESTOZERO = prove + (`!s x. real_summable s x + ==> !e. &0 < e + ==> eventually (\n. n IN s ==> abs(x n) < e) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUMMABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP SERIES_GOESTOZERO) THEN + REWRITE_TAC[o_THM; NORM_LIFT]);; + +let REAL_SUMMABLE_IMP_TOZERO = prove + (`!f:num->real k. + real_summable k f + ==> ((\n. if n IN k then f(n) else &0) ---> &0) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SUMMABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN + REWRITE_TAC[TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF; GSYM LIFT_NUM; GSYM COND_RAND]);; + +let REAL_SUMMABLE_IMP_BOUNDED = prove + (`!f:num->real k. real_summable k f ==> real_bounded (IMAGE f k)`, + REWRITE_TAC[REAL_BOUNDED; REAL_SUMMABLE; GSYM IMAGE_o; + SUMMABLE_IMP_BOUNDED]);; + +let REAL_SUMMABLE_IMP_REAL_SUMS_BOUNDED = prove + (`!f:num->real k. + real_summable (from k) f ==> real_bounded { sum(k..n) f | n IN (:num) }`, + REWRITE_TAC[real_summable; real_sums; LEFT_IMP_EXISTS_THM] THEN + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);; + +let REAL_SERIES_0 = prove + (`!s. ((\n. &0) real_sums (&0)) s`, + REWRITE_TAC[real_sums; SUM_0; REALLIM_CONST]);; + +let REAL_SERIES_ADD = prove + (`!x x0 y y0 s. + (x real_sums x0) s /\ (y real_sums y0) s + ==> ((\n. x n + y n) real_sums (x0 + y0)) s`, + SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_ADD; REALLIM_ADD]);; + +let REAL_SERIES_SUB = prove + (`!x x0 y y0 s. + (x real_sums x0) s /\ (y real_sums y0) s + ==> ((\n. x n - y n) real_sums (x0 - y0)) s`, + SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_SUB; REALLIM_SUB]);; + +let REAL_SERIES_LMUL = prove + (`!x x0 c s. (x real_sums x0) s ==> ((\n. c * x n) real_sums (c * x0)) s`, + SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_LMUL; REALLIM_LMUL]);; + +let REAL_SERIES_RMUL = prove + (`!x x0 c s. (x real_sums x0) s ==> ((\n. x n * c) real_sums (x0 * c)) s`, + SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_RMUL; REALLIM_RMUL]);; + +let REAL_SERIES_NEG = prove + (`!x x0 s. (x real_sums x0) s ==> ((\n. --(x n)) real_sums (--x0)) s`, + SIMP_TAC[real_sums; FINITE_INTER_NUMSEG; SUM_NEG; REALLIM_NEG]);; + +let REAL_SUMS_IFF = prove + (`!f g k. (!x. x IN k ==> f x = g x) + ==> ((f real_sums l) k <=> (g real_sums l) k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);; + +let REAL_SUMS_EQ = prove + (`!f g k. (!x. x IN k ==> f x = g x) /\ (f real_sums l) k + ==> (g real_sums l) k`, + MESON_TAC[REAL_SUMS_IFF]);; + +let REAL_SERIES_FINITE_SUPPORT = prove + (`!f s k. + FINITE (s INTER k) /\ (!x. ~(x IN s INTER k) ==> f x = &0) + ==> (f real_sums sum(s INTER k) f) k`, + REWRITE_TAC[real_sums; REALLIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `sum (k INTER (0..n)) (f:num->real) = sum(s INTER k) f` + (fun th -> ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM; th]) THEN + MATCH_MP_TAC SUM_SUPERSET THEN + ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[IN_INTER; LE_TRANS]);; + +let REAL_SERIES_DIFFS = prove + (`!f k. (f ---> &0) sequentially + ==> ((\n. f(n) - f(n + 1)) real_sums f(k)) (from k)`, + REWRITE_TAC[real_sums; FROM_INTER_NUMSEG; SUM_DIFFS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. (f:num->real) k - f(n + 1)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN + SIMP_TAC[]; + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_RZERO] THEN + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REAL_SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);; + +let REAL_SERIES_TRIVIAL = prove + (`!f. (f real_sums &0) {}`, + REWRITE_TAC[real_sums; INTER_EMPTY; SUM_CLAUSES; REALLIM_CONST]);; + +let REAL_SERIES_RESTRICT = prove + (`!f k l:real. + ((\n. if n IN k then f(n) else &0) real_sums l) (:num) <=> + (f real_sums l) k`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN + MATCH_MP_TAC(MESON[] `sum s f = sum t f /\ sum t f = sum t g + ==> sum s f = sum t g`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]; + MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_INTER]]);; + +let REAL_SERIES_SUM = prove + (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = &0) /\ + sum s f = l ==> (f real_sums l) k`, + REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN + SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC [REAL_SERIES_FINITE_SUPPORT]]);; + +let REAL_SUMS_REINDEX = prove + (`!k a l n. + ((\x. a(x + k)) real_sums l) (from n) <=> (a real_sums l) (from(n + k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sums; FROM_INTER_NUMSEG] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_OFFSET] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; + ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; + +let REAL_INFSUM = prove + (`!f s. real_summable s f ==> real_infsum s f = drop(infsum s (lift o f))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM REAL_SUMS_INFSUM; REAL_SUMS] THEN + DISCH_THEN(MP_TAC o MATCH_MP INFSUM_UNIQUE) THEN + MESON_TAC[LIFT_DROP]);; + +let REAL_PARTIAL_SUMS_LE_INFSUM = prove + (`!f s n. + (!i. i IN s ==> &0 <= f i) /\ real_summable s f + ==> sum (s INTER (0..n)) f <= real_infsum s f`, + REPEAT GEN_TAC THEN SIMP_TAC[REAL_INFSUM] THEN + REWRITE_TAC[REAL_SUMMABLE] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINDER_CONV o RAND_CONV o RAND_CONV) + [GSYM LIFT_DROP] THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP + PARTIAL_SUMS_DROP_LE_INFSUM) THEN + SIMP_TAC[DROP_VSUM; FINITE_INTER; FINITE_NUMSEG; o_DEF; LIFT_DROP; ETA_AX]);; + +let REAL_PARTIAL_SUMS_LE_INFSUM_GEN = prove + (`!f s t. FINITE t /\ t SUBSET s /\ + (!i. i IN s ==> &0 <= f i) /\ real_summable s f + ==> sum t f <= real_infsum s f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..n)) f` THEN + ASM_SIMP_TAC[REAL_PARTIAL_SUMS_LE_INFSUM] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[IN_INTER; IN_DIFF; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; IN_INTER; LE_0] THEN ASM SET_TAC[]);; + +let REAL_SERIES_TERMS_TOZERO = prove + (`!f l n. (f real_sums l) (from n) ==> (f ---> &0) sequentially`, + REWRITE_TAC[REAL_SUMS; TENDSTO_REAL; LIFT_NUM; SERIES_TERMS_TOZERO]);; + +let REAL_SERIES_LE = prove + (`!f g s y z. + (f real_sums y) s /\ (g real_sums z) s /\ + (!i. i IN s ==> f(i) <= g(i)) + ==> y <= z`, + REWRITE_TAC[REAL_SUMS] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x = drop(lift x)`] THEN + MATCH_MP_TAC SERIES_DROP_LE THEN + MAP_EVERY EXISTS_TAC [`lift o (f:num->real)`; `lift o (g:num->real)`] THEN + ASM_SIMP_TAC[o_THM; LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let REAL_SERIES_POS = prove + (`!f s y. + (f real_sums y) s /\ (!i. i IN s ==> &0 <= f(i)) + ==> &0 <= y`, + REWRITE_TAC[REAL_SUMS] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM LIFT_DROP] THEN + MATCH_MP_TAC SERIES_DROP_POS THEN + EXISTS_TAC `lift o (f:num->real)` THEN + ASM_SIMP_TAC[o_THM; LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let REAL_SERIES_BOUND = prove + (`!f g s a b. + (f real_sums a) s /\ (g real_sums b) s /\ + (!i. i IN s ==> abs(f i) <= g i) + ==> abs(a) <= b`, + REWRITE_TAC[REAL_SUMS; GSYM NORM_LIFT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SERIES_BOUND THEN + EXISTS_TAC `lift o (f:num->real)` THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; + +let REAL_SERIES_COMPARISON_BOUND = prove + (`!f g s a. + (g real_sums a) s /\ (!i. i IN s ==> abs(f i) <= g i) + ==> ?l. (f real_sums l) s /\ abs(l) <= a`, + REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT; GSYM NORM_LIFT] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + MATCH_MP_TAC SERIES_COMPARISON_BOUND THEN + EXISTS_TAC `lift o (g:num->real)` THEN + ASM_SIMP_TAC[o_THM; LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Similar combining theorems just for summability. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SUMMABLE_0 = prove + (`!s. real_summable s (\n. &0)`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_0]);; + +let REAL_SUMMABLE_ADD = prove + (`!x y s. real_summable s x /\ real_summable s y + ==> real_summable s (\n. x n + y n)`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_ADD]);; + +let REAL_SUMMABLE_SUB = prove + (`!x y s. real_summable s x /\ real_summable s y + ==> real_summable s (\n. x n - y n)`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_SUB]);; + +let REAL_SUMMABLE_LMUL = prove + (`!s x c. real_summable s x ==> real_summable s (\n. c * x n)`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_LMUL]);; + +let REAL_SUMMABLE_RMUL = prove + (`!s x c. real_summable s x ==> real_summable s (\n. x n * c)`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_RMUL]);; + +let REAL_SUMMABLE_NEG = prove + (`!x s. real_summable s x ==> real_summable s (\n. --(x n))`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_NEG]);; + +let REAL_SUMMABLE_IFF = prove + (`!f g k. (!x. x IN k ==> f x = g x) + ==> (real_summable k f <=> real_summable k g)`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SUMS_IFF]);; + +let REAL_SUMMABLE_EQ = prove + (`!f g k. (!x. x IN k ==> f x = g x) /\ real_summable k f + ==> real_summable k g`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SUMS_EQ]);; + +let REAL_SERIES_SUBSET = prove + (`!x s t l. + s SUBSET t /\ + ((\i. if i IN s then x i else &0) real_sums l) t + ==> (x real_sums l) s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[real_sums] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + ASM_SIMP_TAC[GSYM SUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let REAL_SUMMABLE_SUBSET = prove + (`!x s t. + s SUBSET t /\ + real_summable t (\i. if i IN s then x i else &0) + ==> real_summable s x`, + REWRITE_TAC[real_summable] THEN MESON_TAC[REAL_SERIES_SUBSET]);; + +let REAL_SUMMABLE_TRIVIAL = prove + (`!f. real_summable {} f`, + GEN_TAC THEN REWRITE_TAC[real_summable] THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[REAL_SERIES_TRIVIAL]);; + +let REAL_SUMMABLE_RESTRICT = prove + (`!f k. + real_summable (:num) (\n. if n IN k then f(n) else &0) <=> + real_summable k f`, + REWRITE_TAC[real_summable; REAL_SERIES_RESTRICT]);; + +let REAL_SUMS_FINITE_DIFF = prove + (`!f t s l. + t SUBSET s /\ FINITE t /\ (f real_sums l) s + ==> (f real_sums (l - sum t f)) (s DIFF t)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o ISPEC `f:num->real` o MATCH_MP REAL_SERIES_FINITE) THEN + ONCE_REWRITE_TAC[GSYM REAL_SERIES_RESTRICT] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SERIES_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN + FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN + MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let REAL_SUMS_FINITE_UNION = prove + (`!f s t l. + FINITE t /\ (f real_sums l) s + ==> (f real_sums (l + sum (t DIFF s) f)) (s UNION t)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN + DISCH_THEN(MP_TAC o ISPEC `f:num->real` o MATCH_MP REAL_SERIES_FINITE) THEN + ONCE_REWRITE_TAC[GSYM REAL_SERIES_RESTRICT] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SERIES_ADD) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN + REWRITE_TAC[IN_DIFF; IN_UNION] THEN + MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let REAL_SUMS_OFFSET = prove + (`!f l m n. + (f real_sums l) (from m) /\ m < n + ==> (f real_sums (l - sum(m..(n-1)) f)) (from n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; + MATCH_MP_TAC REAL_SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; + +let REAL_SUMS_OFFSET_REV = prove + (`!f l m n. + (f real_sums l) (from m) /\ n < m + ==> (f real_sums (l + sum(n..m-1) f)) (from n)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real`; `from m`; `n..m-1`; `l:real`] + REAL_SUMS_FINITE_UNION) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN + BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Similar combining theorems for infsum. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INFSUM_0 = prove + (`real_infsum s (\i. &0) = &0`, + MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN REWRITE_TAC[REAL_SERIES_0]);; + +let REAL_INFSUM_ADD = prove + (`!x y s. real_summable s x /\ real_summable s y + ==> real_infsum s (\i. x i + y i) = + real_infsum s x + real_infsum s y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN + MATCH_MP_TAC REAL_SERIES_ADD THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; + +let REAL_INFSUM_SUB = prove + (`!x y s. real_summable s x /\ real_summable s y + ==> real_infsum s (\i. x i - y i) = + real_infsum s x - real_infsum s y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN + MATCH_MP_TAC REAL_SERIES_SUB THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; + +let REAL_INFSUM_LMUL = prove + (`!s x c. real_summable s x + ==> real_infsum s (\n. c * x n) = c * real_infsum s x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN + MATCH_MP_TAC REAL_SERIES_LMUL THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; + +let REAL_INFSUM_RMUL = prove + (`!s x c. real_summable s x + ==> real_infsum s (\n. x n * c) = real_infsum s x * c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN + MATCH_MP_TAC REAL_SERIES_RMUL THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; + +let REAL_INFSUM_NEG = prove + (`!s x. real_summable s x + ==> real_infsum s (\n. --(x n)) = --(real_infsum s x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN + MATCH_MP_TAC REAL_SERIES_NEG THEN ASM_REWRITE_TAC[REAL_SUMS_INFSUM]);; + +let REAL_INFSUM_EQ = prove + (`!f g k. real_summable k f /\ real_summable k g /\ + (!x. x IN k ==> f x = g x) + ==> real_infsum k f = real_infsum k g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_infsum] THEN AP_TERM_TAC THEN + ABS_TAC THEN ASM_MESON_TAC[REAL_SUMS_EQ; REAL_SUMS_INFSUM]);; + +let REAL_INFSUM_RESTRICT = prove + (`!k a. real_infsum (:num) (\n. if n IN k then a n else &0) = + real_infsum k a`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`a:num->real`; `k:num->bool`] REAL_SUMMABLE_RESTRICT) THEN + ASM_CASES_TAC `real_summable k a` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THENL + [MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN + ASM_REWRITE_TAC[REAL_SERIES_RESTRICT; REAL_SUMS_INFSUM]; + RULE_ASSUM_TAC(REWRITE_RULE[real_summable; NOT_EXISTS_THM]) THEN + ASM_REWRITE_TAC[real_infsum]]);; + +(* ------------------------------------------------------------------------- *) +(* Convergence tests for real series. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SERIES_CAUCHY_UNIFORM = prove + (`!P:A->bool f k. + (?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> abs(sum(k INTER (0..n)) (f x) - + l x) < e) <=> + (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x + ==> abs(sum(k INTER (m..n)) (f x)) < e)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:A->bool`; `\x:A n:num. lift(f x n)`; `k:num->bool`] + SERIES_CAUCHY_UNIFORM) THEN + SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[NORM_LIFT; o_DEF; LIFT_DROP; ETA_AX] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `l:A->real`) THEN + EXISTS_TAC `lift o (l:A->real)` THEN + ASM_SIMP_TAC[o_THM; DIST_LIFT]; + DISCH_THEN(X_CHOOSE_TAC `l:A->real^1`) THEN + EXISTS_TAC `drop o (l:A->real^1)` THEN + ASM_SIMP_TAC[SUM_VSUM; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[o_THM; GSYM DROP_SUB; GSYM ABS_DROP] THEN + SIMP_TAC[GSYM dist; VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; + +let REAL_SERIES_COMPARISON = prove + (`!f g s. (?l. (g real_sums l) s) /\ + (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n) + ==> ?l. (f real_sums l) s`, + REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `g:num->real` THEN + REWRITE_TAC[NORM_LIFT; o_THM] THEN ASM_MESON_TAC[]);; + +let REAL_SUMMABLE_COMPARISON = prove + (`!f g s. real_summable s g /\ + (?N. !n. n >= N /\ n IN s ==> abs(f n) <= g n) + ==> real_summable s f`, + REWRITE_TAC[real_summable; REAL_SERIES_COMPARISON]);; + +let REAL_SERIES_COMPARISON_UNIFORM = prove + (`!f g P s. (?l. (g real_sums l) s) /\ + (?N. !n x. N <= n /\ n IN s /\ P x ==> abs(f x n) <= g n) + ==> ?l:A->real. + !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> abs(sum(s INTER (0..n)) (f x) - + l x) < e`, + REPEAT GEN_TAC THEN + SIMP_TAC[GE; REAL_SERIES_CAUCHY; REAL_SERIES_CAUCHY_UNIFORM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs (sum (s INTER (m .. n)) g)` THEN CONJ_TAC THENL + [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN + MATCH_MP_TAC SUM_ABS_LE THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`]; + ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);; + +let REAL_SERIES_RATIO = prove + (`!c a s N. + c < &1 /\ + (!n. n >= N ==> abs(a(SUC n)) <= c * abs(a(n))) + ==> ?l:real. (a real_sums l) s`, + REWRITE_TAC[REAL_SUMS; GSYM EXISTS_LIFT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_RATIO THEN + REWRITE_TAC[o_THM; NORM_LIFT] THEN ASM_MESON_TAC[]);; + +let BOUNDED_PARTIAL_REAL_SUMS = prove + (`!f:num->real k. + real_bounded { sum(k..n) f | n IN (:num) } + ==> real_bounded { sum(m..n) f | m IN (:num) /\ n IN (:num) }`, + REWRITE_TAC[REAL_BOUNDED] THEN + REWRITE_TAC[SET_RULE `IMAGE f {g x | P x} = {f(g x) | P x}`; + SET_RULE `IMAGE f {g x y | P x /\ Q y} = {f(g x y) | P x /\ Q y}`] THEN + SIMP_TAC[LIFT_SUM; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[BOUNDED_PARTIAL_SUMS]);; + +let REAL_SERIES_DIRICHLET = prove + (`!f:num->real g N k m. + real_bounded { sum (m..n) f | n IN (:num)} /\ + (!n. N <= n ==> g(n + 1) <= g(n)) /\ + (g ---> &0) sequentially + ==> real_summable (from k) (\n. g(n) * f(n))`, + REWRITE_TAC[REAL_SUMMABLE; REAL_BOUNDED; TENDSTO_REAL] THEN + REWRITE_TAC[LIFT_NUM; LIFT_CMUL; o_DEF] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SERIES_DIRICHLET THEN + MAP_EVERY EXISTS_TAC [`N:num`; `m:num`] THEN + ASM_REWRITE_TAC[o_DEF] THEN + SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX] THEN + ASM_REWRITE_TAC[SET_RULE `{lift(f x) | P x} = IMAGE lift {f x | P x}`]);; + +let REAL_SERIES_ABSCONV_IMP_CONV = prove + (`!x:num->real k. real_summable k (\n. abs(x n)) ==> real_summable k x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN + EXISTS_TAC `\n:num. abs(x n)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; + +let REAL_SUMS_GP = prove + (`!n x. abs(x) < &1 + ==> ((\k. x pow k) real_sums (x pow n / (&1 - x))) (from n)`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL [`n:num`; `Cx x`] SUMS_GP) THEN + ASM_REWRITE_TAC[REAL_SUMS_COMPLEX; GSYM CX_SUB; GSYM CX_POW; GSYM CX_DIV; + o_DEF; COMPLEX_NORM_CX]);; + +let REAL_SUMMABLE_GP = prove + (`!x k. abs(x) < &1 ==> real_summable k (\n. x pow n)`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL [`Cx x`; `k:num->bool`] SUMMABLE_GP) THEN + ASM_REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; o_DEF; CX_POW]);; + +let REAL_SUMMABLE_ZETA_INTEGER = prove + (`!n m. 2 <= m ==> real_summable (from n) (\k. inv(&k pow m))`, + REWRITE_TAC[REAL_SUMMABLE_COMPLEX; CX_INV; CX_POW; + SUMMABLE_ZETA_INTEGER; o_DEF]);; + +let REAL_ABEL_LEMMA = prove + (`!a M r r0. + &0 <= r /\ r < r0 /\ + (!n. n IN k ==> abs(a n) * r0 pow n <= M) + ==> real_summable k (\n. abs(a(n)) * r pow n)`, + REWRITE_TAC[REAL_SUMMABLE_COMPLEX] THEN + REWRITE_TAC[o_DEF; CX_MUL; CX_ABS] THEN REWRITE_TAC[GSYM CX_MUL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABEL_LEMMA THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN ASM_MESON_TAC[]);; + +let REAL_POWER_SERIES_CONV_IMP_ABSCONV = prove + (`!a k w z. + real_summable k (\n. a(n) * z pow n) /\ abs(w) < abs(z) + ==> real_summable k (\n. abs(a(n) * w pow n))`, + REWRITE_TAC[REAL_SUMMABLE_COMPLEX; o_DEF; CX_MUL; CX_ABS; CX_POW] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV THEN + EXISTS_TAC `Cx z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);; + +let POWER_REAL_SERIES_CONV_IMP_ABSCONV_WEAK = prove + (`!a k w z. + real_summable k (\n. a(n) * z pow n) /\ abs(w) < abs(z) + ==> real_summable k (\n. abs(a n) * w pow n)`, + REWRITE_TAC[REAL_SUMMABLE_COMPLEX; o_DEF; CX_MUL; CX_ABS; CX_POW] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC POWER_SERIES_CONV_IMP_ABSCONV_WEAK THEN + EXISTS_TAC `Cx z` THEN ASM_REWRITE_TAC[COMPLEX_NORM_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Nets for real limit. *) +(* ------------------------------------------------------------------------- *) + +let atreal = new_definition + `atreal a = mk_net(\x y. &0 < abs(x - a) /\ abs(x - a) <= abs(y - a))`;; + +let ATREAL = prove + (`!a x y. + netord(atreal a) x y <=> &0 < abs(x - a) /\ abs(x - a) <= abs(y - a)`, + GEN_TAC THEN NET_PROVE_TAC[atreal] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);; + +let WITHINREAL_UNIV = prove + (`!x. atreal x within (:real) = atreal x`, + REWRITE_TAC[within; atreal; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);; + +let TRIVIAL_LIMIT_ATREAL = prove + (`!a. ~(trivial_limit (atreal a))`, + X_GEN_TAC `a:real` THEN SIMP_TAC[trivial_limit; ATREAL; DE_MORGAN_THM] THEN + CONJ_TAC THENL + [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`b:real`; `c:real`] THEN + ASM_CASES_TAC `b:real = c` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM NOT_EXISTS_THM] THEN + SUBGOAL_THEN `~(b:real = a) \/ ~(c = a)` DISJ_CASES_TAC THENL + [ASM_MESON_TAC[]; + EXISTS_TAC `(a + b) / &2` THEN ASM_REAL_ARITH_TAC; + EXISTS_TAC `(a + c) / &2` THEN ASM_REAL_ARITH_TAC]);; + +let NETLIMIT_WITHINREAL = prove + (`!a s. ~(trivial_limit (atreal a within s)) + ==> (netlimit (atreal a within s) = a)`, + REWRITE_TAC[trivial_limit; netlimit; ATREAL; WITHIN; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x. ~(&0 < abs(x - a) /\ abs(x - a) <= abs(a - a) /\ x IN s)` + ASSUME_TAC THENL [REAL_ARITH_TAC; ASM_MESON_TAC[]]);; + +let NETLIMIT_ATREAL = prove + (`!a. netlimit(atreal a) = a`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + MATCH_MP_TAC NETLIMIT_WITHINREAL THEN + SIMP_TAC[TRIVIAL_LIMIT_ATREAL; WITHINREAL_UNIV]);; + +let EVENTUALLY_WITHINREAL_LE = prove + (`!s a p. + eventually p (atreal a within s) <=> + ?d. &0 < d /\ + !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d ==> p(x)`, + REWRITE_TAC[eventually; ATREAL; WITHIN; trivial_limit] THEN + REWRITE_TAC[MESON[REAL_LT_01; REAL_LT_REFL] `~(!a b:real. a = b)`] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `b:real` MP_TAC)) THENL + [DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(b = c) ==> &0 < abs(b - a) \/ &0 < abs(c - a)`)) THEN + ASM_MESON_TAC[]; + MESON_TAC[REAL_LTE_TRANS]]; + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `?x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d` THENL + [DISJ2_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `b:real`) THEN + EXISTS_TAC `b:real` THEN ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; + DISJ1_TAC THEN MAP_EVERY EXISTS_TAC [`a + d:real`; `a:real`] THEN + ASM_SIMP_TAC[REAL_ADD_SUB; REAL_EQ_ADD_LCANCEL_0; REAL_LT_IMP_NZ] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN + ASM_CASES_TAC `(x:real) IN s` THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +let EVENTUALLY_WITHINREAL = prove + (`!s a p. + eventually p (atreal a within s) <=> + ?d. &0 < d /\ !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d ==> p(x)`, + REWRITE_TAC[EVENTUALLY_WITHINREAL_LE] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + REWRITE_TAC[APPROACHABLE_LT_LE]);; + +let EVENTUALLY_ATREAL = prove + (`!a p. eventually p (atreal a) <=> + ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d ==> p(x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[EVENTUALLY_WITHINREAL; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Usual limit results with real domain and either vector or real range. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHINREAL_LE = prove + (`!f:real->real^N l a s. + (f --> l) (atreal a within s) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_WITHINREAL_LE]);; + +let LIM_WITHINREAL = prove + (`!f:real->real^N l a s. + (f --> l) (atreal a within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_WITHINREAL] THEN MESON_TAC[]);; + +let LIM_ATREAL = prove + (`!f l:real^N a. + (f --> l) (atreal a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_ATREAL] THEN MESON_TAC[]);; + +let REALLIM_WITHINREAL_LE = prove + (`!f l a s. + (f ---> l) (atreal a within s) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) <= d + ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_WITHINREAL_LE]);; + +let REALLIM_WITHINREAL = prove + (`!f l a s. + (f ---> l) (atreal a within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < abs(x - a) /\ abs(x - a) < d + ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_WITHINREAL] THEN MESON_TAC[]);; + +let REALLIM_ATREAL = prove + (`!f l a. + (f ---> l) (atreal a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ !x. &0 < abs(x - a) /\ abs(x - a) < d + ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_ATREAL] THEN MESON_TAC[]);; + +let REALLIM_AT_POSINFINITY = prove + (`!f l. (f ---> l) at_posinfinity <=> + !e. &0 < e ==> ?b. !x. x >= b ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);; + +let REALLIM_AT_NEGINFINITY = prove + (`!f l. (f ---> l) at_neginfinity <=> + !e. &0 < e ==> ?b. !x. x <= b ==> abs(f(x) - l) < e`, + REWRITE_TAC[tendsto_real; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);; + +let LIM_ATREAL_WITHINREAL = prove + (`!f l a s. (f --> l) (atreal a) ==> (f --> l) (atreal a within s)`, + REWRITE_TAC[LIM_ATREAL; LIM_WITHINREAL] THEN MESON_TAC[]);; + +let REALLIM_ATREAL_WITHINREAL = prove + (`!f l a s. (f ---> l) (atreal a) ==> (f ---> l) (atreal a within s)`, + REWRITE_TAC[REALLIM_ATREAL; REALLIM_WITHINREAL] THEN MESON_TAC[]);; + +let REALLIM_WITHIN_SUBSET = prove + (`!f l a s t. (f ---> l) (at a within s) /\ t SUBSET s + ==> (f ---> l) (at a within t)`, + REWRITE_TAC[REALLIM_WITHIN; SUBSET] THEN MESON_TAC[]);; + +let REALLIM_WITHINREAL_SUBSET = prove + (`!f l a s t. (f ---> l) (atreal a within s) /\ t SUBSET s + ==> (f ---> l) (atreal a within t)`, + REWRITE_TAC[REALLIM_WITHINREAL; SUBSET] THEN MESON_TAC[]);; + +let LIM_WITHINREAL_SUBSET = prove + (`!f l a s t. (f --> l) (atreal a within s) /\ t SUBSET s + ==> (f --> l) (atreal a within t)`, + REWRITE_TAC[LIM_WITHINREAL; SUBSET] THEN MESON_TAC[]);; + +let REALLIM_ATREAL_ID = prove + (`((\x. x) ---> a) (atreal a)`, + REWRITE_TAC[REALLIM_ATREAL] THEN MESON_TAC[]);; + +let REALLIM_WITHINREAL_ID = prove + (`!a. ((\x. x) ---> a) (atreal a within s)`, + REWRITE_TAC[REALLIM_WITHINREAL] THEN MESON_TAC[]);; + +let LIM_TRANSFORM_WITHINREAL_SET = prove + (`!f a s t. + eventually (\x. x IN s <=> x IN t) (atreal a) + ==> ((f --> l) (atreal a within s) <=> (f --> l) (atreal a within t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_ATREAL; LIM_WITHINREAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +let REALLIM_TRANSFORM_WITHIN_SET = prove + (`!f a s t. + eventually (\x. x IN s <=> x IN t) (at a) + ==> ((f ---> l) (at a within s) <=> (f ---> l) (at a within t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; REALLIM_WITHIN] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +let REALLIM_TRANSFORM_WITHINREAL_SET = prove + (`!f a s t. + eventually (\x. x IN s <=> x IN t) (atreal a) + ==> ((f ---> l) (atreal a within s) <=> + (f ---> l) (atreal a within t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_ATREAL; REALLIM_WITHINREAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +let REALLIM_COMPOSE_WITHIN = prove + (`!net:A net f g s y z. + (f ---> y) net /\ + eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\ + (g ---> z) (atreal y within s) + ==> ((g o f) ---> z) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto_real; CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVENTUALLY_WITHINREAL; GSYM DIST_NZ; o_DEF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(f:A->real) x = y` THEN + ASM_MESON_TAC[REAL_ARITH `abs(x - y) = &0 <=> x = y`; + REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`]);; + +let REALLIM_COMPOSE_AT = prove + (`!net:A net f g y z. + (f ---> y) net /\ + eventually (\w. f w = y ==> g y = z) net /\ + (g ---> z) (atreal y) + ==> ((g o f) ---> z) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:A net`; `f:A->real`; `g:real->real`; + `(:real)`; `y:real`; `z:real`] + REALLIM_COMPOSE_WITHIN) THEN + ASM_REWRITE_TAC[IN_UNIV; WITHINREAL_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Some real limits involving transcendentals. *) +(* ------------------------------------------------------------------------- *) + +let REALLIM_1_OVER_N = prove + (`((\n. inv(&n)) ---> &0) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_INV_N]);; + +let REALLIM_1_OVER_POW = prove + (`!k. 1 <= k ==> ((\n. inv(&n pow k)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. inv(&n pow 1)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[REAL_ABS_NUM] THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_POW_LT; MATCH_MP_TAC REAL_POW_MONO] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1]; + REWRITE_TAC[REAL_POW_1; REALLIM_1_OVER_N]]);; + +let REALLIM_LOG_OVER_N = prove + (`((\n. log(&n) / &n) ---> &0) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX] THEN MP_TAC LIM_LOG_OVER_N THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[o_DEF; CX_DIV; CX_LOG; REAL_OF_NUM_LT; + ARITH_RULE `1 <= n ==> 0 < n`]);; + +let REALLIM_1_OVER_LOG = prove + (`((\n. inv(log(&n))) ---> &0) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX] THEN MP_TAC LIM_1_OVER_LOG THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[o_DEF; complex_div; COMPLEX_MUL_LID; CX_INV] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + SIMP_TAC[CX_LOG; REAL_OF_NUM_LT; ARITH_RULE `1 <= n ==> 0 < n`]);; + +let REALLIM_POWN = prove + (`!z. abs(z) < &1 ==> ((\n. z pow n) ---> &0) sequentially`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_POW] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POWN THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX]);; + +let REALLIM_X_TIMES_LOG = prove + (`((\x. x * log x) ---> &0) (atreal(&0) within {x | &0 <= x})`, + MP_TAC LIM_Z_TIMES_CLOG THEN + REWRITE_TAC[REALLIM_WITHINREAL; LIM_AT] THEN + REWRITE_TAC[IN_ELIM_THM; REAL_SUB_RZERO; dist; COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN X_GEN_TAC `x:real` THEN + ASM_CASES_TAC `x = &0` THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Cx x`) THEN + ASM_SIMP_TAC[COMPLEX_NORM_MUL; GSYM CX_LOG; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Relations between limits at real and complex limit points. *) +(* ------------------------------------------------------------------------- *) + +let TRIVIAL_LIMIT_WITHINREAL_WITHIN = prove + (`trivial_limit(atreal x within s) <=> + trivial_limit(at (lift x) within (IMAGE lift s))`, + REWRITE_TAC[trivial_limit; AT; WITHIN; ATREAL] THEN + REWRITE_TAC[FORALL_LIFT; EXISTS_LIFT; LIFT_EQ; DIST_LIFT] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; LIFT_DROP]);; + +let TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX = prove + (`trivial_limit(atreal x within s) <=> + trivial_limit(at (Cx x) within (real INTER IMAGE Cx s))`, + REWRITE_TAC[trivial_limit; AT; WITHIN; ATREAL] THEN + REWRITE_TAC[SET_RULE `x IN real INTER s <=> real x /\ x IN s`] THEN + REWRITE_TAC[TAUT `~(p /\ x /\ q) /\ ~(r /\ x /\ s) <=> + x ==> ~(p /\ q) /\ ~(r /\ s)`] THEN + REWRITE_TAC[FORALL_REAL; + MESON[IN_IMAGE; CX_INJ] `Cx x IN IMAGE Cx s <=> x IN s`] THEN + REWRITE_TAC[dist; GSYM CX_SUB; o_THM; RE_CX; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(TAUT `~p /\ ~q /\ (r <=> s) ==> (p \/ r <=> q \/ s)`) THEN + REPEAT CONJ_TAC THEN TRY EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN CONV_TAC REAL_RING; + DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(&1)`]) THEN + CONV_TAC COMPLEX_RING; + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`Cx a`; `Cx b`] THEN ASM_REWRITE_TAC[CX_INJ] THEN + ASM_REWRITE_TAC[GSYM CX_SUB; COMPLEX_NORM_CX]; + MAP_EVERY X_GEN_TAC [`a:complex`; `b:complex`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `?d. &0 < d /\ + !z. &0 < abs(z - x) /\ abs(z - x) <= d ==> ~(z IN s)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(MESON[] `!a b. P a \/ P b ==> ?x. P x`) THEN + MAP_EVERY EXISTS_TAC [`norm(a - Cx x)`; `norm(b - Cx x)`] THEN + ASM_REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN + UNDISCH_TAC `~(a:complex = b)` THEN NORM_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x + d:real`; `x - d:real`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < d ==> ~(x + d = x - d)`; + REAL_ARITH `&0 < d ==> abs((x + d) - x) = d`; + REAL_ARITH `&0 < d ==> abs(x - d - x) = d`] THEN + ASM_MESON_TAC[]]);; + +let LIM_WITHINREAL_WITHINCOMPLEX = prove + (`(f --> a) (atreal x within s) <=> + ((f o Re) --> a) (at(Cx x) within (real INTER IMAGE Cx s))`, + REWRITE_TAC[LIM_WITHINREAL; LIM_WITHIN] THEN + REWRITE_TAC[SET_RULE `x IN real INTER s <=> real x /\ x IN s`] THEN + REWRITE_TAC[IMP_CONJ; FORALL_REAL; + MESON[IN_IMAGE; CX_INJ] `Cx x IN IMAGE Cx s <=> x IN s`] THEN + REWRITE_TAC[dist; GSYM CX_SUB; o_THM; RE_CX; COMPLEX_NORM_CX]);; + +let LIM_ATREAL_ATCOMPLEX = prove + (`(f --> a) (atreal x) <=> ((f o Re) --> a) (at (Cx x) within real)`, + REWRITE_TAC[LIM_ATREAL; LIM_WITHIN] THEN + REWRITE_TAC[IMP_CONJ; FORALL_REAL; IN; dist; GSYM CX_SUB; COMPLEX_NORM_CX; + o_THM; RE_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Simpler theorems relating limits in real and real^1. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHINREAL_WITHIN = prove + (`(f --> a) (atreal x within s) <=> + ((f o drop) --> a) (at (lift x) within (IMAGE lift s))`, + REWRITE_TAC[LIM_WITHINREAL; LIM_WITHIN] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; + +let LIM_ATREAL_AT = prove + (`(f --> a) (atreal x) <=> ((f o drop) --> a) (at (lift x))`, + REWRITE_TAC[LIM_ATREAL; LIM_AT; FORALL_LIFT] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; + +let REALLIM_WITHINREAL_WITHIN = prove + (`(f ---> a) (atreal x within s) <=> + ((f o drop) ---> a) (at (lift x) within (IMAGE lift s))`, + REWRITE_TAC[REALLIM_WITHINREAL; REALLIM_WITHIN] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; + +let REALLIM_ATREAL_AT = prove + (`(f ---> a) (atreal x) <=> ((f o drop) ---> a) (at (lift x))`, + REWRITE_TAC[REALLIM_ATREAL; REALLIM_AT; FORALL_LIFT] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; DIST_LIFT; o_THM; LIFT_DROP]);; + +let REALLIM_WITHIN_OPEN = prove + (`!f:real^N->real l a s. + a IN s /\ open s + ==> ((f ---> l) (at a within s) <=> (f ---> l) (at a))`, + REWRITE_TAC[TENDSTO_REAL; LIM_WITHIN_OPEN]);; + +let LIM_WITHIN_REAL_OPEN = prove + (`!f:real->real^N l a s. + a IN s /\ real_open s + ==> ((f --> l) (atreal a within s) <=> (f --> l) (atreal a))`, + REWRITE_TAC[LIM_WITHINREAL_WITHIN; LIM_ATREAL_AT; REAL_OPEN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_WITHIN_OPEN THEN ASM SET_TAC[]);; + +let REALLIM_WITHIN_REAL_OPEN = prove + (`!f l a s. + a IN s /\ real_open s + ==> ((f ---> l) (atreal a within s) <=> (f ---> l) (atreal a))`, + REWRITE_TAC[TENDSTO_REAL; LIM_WITHIN_REAL_OPEN]);; + +(* ------------------------------------------------------------------------- *) +(* Additional congruence rules for simplifying limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CONG_WITHINREAL = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (atreal a within s) <=> + ((g --> l) (atreal a within s)))`, + SIMP_TAC[LIM_WITHINREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; + +let LIM_CONG_ATREAL = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (atreal a) <=> ((g --> l) (atreal a)))`, + SIMP_TAC[LIM_ATREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; + +extend_basic_congs [LIM_CONG_WITHINREAL; LIM_CONG_ATREAL];; + +let REALLIM_CONG_WITHIN = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) ---> l) (at a within s) <=> ((g ---> l) (at a within s)))`, + REWRITE_TAC[REALLIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);; + +let REALLIM_CONG_AT = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) ---> l) (at a) <=> ((g ---> l) (at a)))`, + REWRITE_TAC[REALLIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);; + +extend_basic_congs [REALLIM_CONG_WITHIN; REALLIM_CONG_AT];; + +let REALLIM_CONG_WITHINREAL = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) ---> l) (atreal a within s) <=> + ((g ---> l) (atreal a within s)))`, + SIMP_TAC[REALLIM_WITHINREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; + +let REALLIM_CONG_ATREAL = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) ---> l) (atreal a) <=> ((g ---> l) (atreal a)))`, + SIMP_TAC[REALLIM_ATREAL; GSYM REAL_ABS_NZ; REAL_SUB_0]);; + +extend_basic_congs [REALLIM_CONG_WITHINREAL; REALLIM_CONG_ATREAL];; + +(* ------------------------------------------------------------------------- *) +(* Real version of Abel limit theorem. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ABEL_LIMIT_THEOREM = prove + (`!s a. real_summable s a + ==> (!r. abs(r) < &1 ==> real_summable s (\i. a i * r pow i)) /\ + ((\r. real_infsum s (\i. a i * r pow i)) ---> real_infsum s a) + (atreal (&1) within {z | z <= &1})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`&1`; `s:num->bool`; `Cx o (a:num->real)`] + ABEL_LIMIT_THEOREM) THEN + ASM_REWRITE_TAC[GSYM REAL_SUMMABLE_COMPLEX; REAL_LT_01] THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [X_GEN_TAC `r:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Cx r`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; REAL_SUMMABLE_COMPLEX] THEN + REWRITE_TAC[o_DEF; CX_MUL; CX_POW]; + DISCH_TAC] THEN + REWRITE_TAC[REALLIM_COMPLEX; LIM_WITHINREAL_WITHINCOMPLEX] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + EXISTS_TAC `\z. infsum s (\i. (Cx o a) i * z pow i)` THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [REWRITE_TAC[IMP_CONJ; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN + REWRITE_TAC[IN; FORALL_REAL] THEN X_GEN_TAC `r:real` THEN + REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `r <= &1 ==> (&0 < abs(r - &1) <=> r < &1)`] THEN + REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs(r) < &1` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INFSUM_COMPLEX; o_THM; RE_CX] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM REAL; o_DEF; CX_MUL; CX_POW] THEN + MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN + EXISTS_TAC `\n. vsum(s INTER (0..n)) (\i. Cx(a i) * Cx r pow i)` THEN + REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN + SIMP_TAC[GSYM CX_POW; GSYM CX_MUL; REAL_VSUM; FINITE_INTER; FINITE_NUMSEG; + SUMS_INFSUM; REAL_CX; GE] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL]] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + ASM_SIMP_TAC[GSYM REAL_SUMMABLE_COMPLEX]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INFSUM_COMPLEX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_WITHIN]) THEN + REWRITE_TAC[LIM_WITHIN] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_LID; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*"))) THEN + EXISTS_TAC `min d (&1)` THEN ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN + REWRITE_TAC[IMP_CONJ; IN; FORALL_REAL] THEN + REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + X_GEN_TAC `r:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `r <= &1 ==> (&0 < abs(r - &1) <=> r < &1)`] THEN + REPEAT DISCH_TAC THEN SUBGOAL_THEN `abs(r) < &1` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `Cx r`) THEN + REWRITE_TAC[CX_INJ; UNWIND_THM1; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(NORM_ARITH `b = a ==> norm(x - a) < e ==> norm(x - b) < e`) THEN + REWRITE_TAC[GSYM REAL] THEN + MATCH_MP_TAC(ISPEC `sequentially` REAL_LIM) THEN + EXISTS_TAC `\n. vsum(s INTER (0..n)) (Cx o a)` THEN + REWRITE_TAC[SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY; GSYM sums] THEN + SIMP_TAC[GSYM CX_POW; GSYM CX_MUL; REAL_VSUM; FINITE_INTER; FINITE_NUMSEG; + SUMS_INFSUM; REAL_CX; GE; o_DEF] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[LE_REFL]] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + ASM_SIMP_TAC[GSYM REAL_SUMMABLE_COMPLEX]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of a function into the reals. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("real_continuous",(12,"right"));; + +let real_continuous = new_definition + `f real_continuous net <=> (f ---> f(netlimit net)) net`;; + +let REAL_CONTINUOUS_TRIVIAL_LIMIT = prove + (`!f net. trivial_limit net ==> f real_continuous net`, + SIMP_TAC[real_continuous; REALLIM]);; + +let REAL_CONTINUOUS_WITHIN = prove + (`!f x:real^N s. + f real_continuous (at x within s) <=> + (f ---> f(x)) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous] THEN + ASM_CASES_TAC `trivial_limit(at(x:real^N) within s)` THENL + [ASM_REWRITE_TAC[REALLIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; + +let REAL_CONTINUOUS_AT = prove + (`!f x. f real_continuous (at x) <=> (f ---> f(x)) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN; IN_UNIV]);; + +let REAL_CONTINUOUS_WITHINREAL = prove + (`!f x s. f real_continuous (atreal x within s) <=> + (f ---> f(x)) (atreal x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_continuous] THEN + ASM_CASES_TAC `trivial_limit(atreal x within s)` THENL + [ASM_REWRITE_TAC[REALLIM]; ASM_SIMP_TAC[NETLIMIT_WITHINREAL]]);; + +let REAL_CONTINUOUS_ATREAL = prove + (`!f x. f real_continuous (atreal x) <=> (f ---> f(x)) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; IN_UNIV]);; + +let CONTINUOUS_WITHINREAL = prove + (`!f x s. f continuous (atreal x within s) <=> + (f --> f(x)) (atreal x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN + ASM_CASES_TAC `trivial_limit(atreal x within s)` THENL + [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHINREAL]]);; + +let CONTINUOUS_ATREAL = prove + (`!f x. f continuous (atreal x) <=> (f --> f(x)) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[CONTINUOUS_WITHINREAL; IN_UNIV]);; + +let real_continuous_within = prove + (`f real_continuous (at x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. x' IN s /\ dist(x',x) < d ==> abs(f x' - f x) < e)`, + REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_WITHIN] THEN + REWRITE_TAC[GSYM DIST_NZ] THEN + EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN + ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; + +let real_continuous_at = prove + (`f real_continuous (at x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. dist(x',x) < d ==> abs(f x' - f x) < e)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[real_continuous_within; IN_UNIV]);; + +let real_continuous_withinreal = prove + (`f real_continuous (atreal x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. x' IN s /\ abs(x' - x) < d ==> abs(f x' - f x) < e)`, + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL] THEN + REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN + EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN + ASM_MESON_TAC[REAL_ARITH `abs(x - x) = &0`]);; + +let real_continuous_atreal = prove + (`f real_continuous (atreal x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. abs(x' - x) < d ==> abs(f x' - f x) < e)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[real_continuous_withinreal; IN_UNIV]);; + +let REAL_CONTINUOUS_AT_WITHIN = prove + (`!f s x. f real_continuous (at x) + ==> f real_continuous (at x within s)`, + REWRITE_TAC[real_continuous_within; real_continuous_at] THEN + MESON_TAC[]);; + +let REAL_CONTINUOUS_ATREAL_WITHINREAL = prove + (`!f s x. f real_continuous (atreal x) + ==> f real_continuous (atreal x within s)`, + REWRITE_TAC[real_continuous_withinreal; real_continuous_atreal] THEN + MESON_TAC[]);; + +let REAL_CONTINUOUS_WITHINREAL_SUBSET = prove + (`!f s t. f real_continuous (atreal x within s) /\ t SUBSET s + ==> f real_continuous (atreal x within t)`, + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL_SUBSET]);; + +let REAL_CONTINUOUS_WITHIN_SUBSET = prove + (`!f s t. f real_continuous (at x within s) /\ t SUBSET s + ==> f real_continuous (at x within t)`, + REWRITE_TAC[REAL_CONTINUOUS_WITHIN; REALLIM_WITHIN_SUBSET]);; + +let CONTINUOUS_WITHINREAL_SUBSET = prove + (`!f s t. f continuous (atreal x within s) /\ t SUBSET s + ==> f continuous (atreal x within t)`, + REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_WITHINREAL_SUBSET]);; + +let continuous_withinreal = prove + (`f continuous (atreal x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. x' IN s /\ abs(x' - x) < d ==> dist(f x',f x) < e)`, + REWRITE_TAC[CONTINUOUS_WITHINREAL; LIM_WITHINREAL] THEN + REWRITE_TAC[REAL_ARITH `&0 < abs(x - y) <=> ~(x = y)`] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `d:real` THEN + ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[DIST_REFL]);; + +let continuous_atreal = prove + (`f continuous (atreal x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. abs(x' - x) < d ==> dist(f x',f x) < e)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[continuous_withinreal; IN_UNIV]);; + +let CONTINUOUS_ATREAL_WITHINREAL = prove + (`!f x s. f continuous (atreal x) ==> f continuous (atreal x within s)`, + SIMP_TAC[continuous_atreal; continuous_withinreal] THEN MESON_TAC[]);; + +let CONTINUOUS_CX_ATREAL = prove + (`!x. Cx continuous (atreal x)`, + GEN_TAC THEN REWRITE_TAC[continuous_atreal; dist] THEN + REWRITE_TAC[COMPLEX_NORM_CX; GSYM CX_SUB] THEN MESON_TAC[]);; + +let CONTINUOUS_CX_WITHINREAL = prove + (`!s x. Cx continuous (atreal x within s)`, + SIMP_TAC[CONTINUOUS_ATREAL_WITHINREAL; CONTINUOUS_CX_ATREAL]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic combining theorems. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_CONST = prove + (`!net c. (\x. c) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_CONST]);; + +let REAL_CONTINUOUS_LMUL = prove + (`!f c net. f real_continuous net ==> (\x. c * f(x)) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_LMUL]);; + +let REAL_CONTINUOUS_RMUL = prove + (`!f c net. f real_continuous net ==> (\x. f(x) * c) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_RMUL]);; + +let REAL_CONTINUOUS_NEG = prove + (`!f net. f real_continuous net ==> (\x. --(f x)) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_NEG]);; + +let REAL_CONTINUOUS_ADD = prove + (`!f g net. f real_continuous net /\ g real_continuous net + ==> (\x. f(x) + g(x)) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_ADD]);; + +let REAL_CONTINUOUS_SUB = prove + (`!f g net. f real_continuous net /\ g real_continuous net + ==> (\x. f(x) - g(x)) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_SUB]);; + +let REAL_CONTINUOUS_MUL = prove + (`!net f g. + f real_continuous net /\ g real_continuous net + ==> (\x. f(x) * g(x)) real_continuous net`, + SIMP_TAC[real_continuous; REALLIM_MUL]);; + +let REAL_CONTINUOUS_INV = prove + (`!net f. + f real_continuous net /\ ~(f(netlimit net) = &0) + ==> (\x. inv(f x)) real_continuous net`, + SIMP_TAC[real_continuous; REALLIM_INV]);; + +let REAL_CONTINUOUS_DIV = prove + (`!net f g. + f real_continuous net /\ g real_continuous net /\ ~(g(netlimit net) = &0) + ==> (\x. f(x) / g(x)) real_continuous net`, + SIMP_TAC[real_continuous; REALLIM_DIV]);; + +let REAL_CONTINUOUS_POW = prove + (`!net f n. f real_continuous net ==> (\x. f(x) pow n) real_continuous net`, + SIMP_TAC[real_continuous; REALLIM_POW]);; + +let REAL_CONTINUOUS_ABS = prove + (`!net f. f real_continuous net ==> (\x. abs(f(x))) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_ABS]);; + +let REAL_CONTINUOUS_MAX = prove + (`!f g net. f real_continuous net /\ g real_continuous net + ==> (\x. max (f x) (g x)) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_MAX]);; + +let REAL_CONTINUOUS_MIN = prove + (`!f g net. f real_continuous net /\ g real_continuous net + ==> (\x. min (f x) (g x)) real_continuous net`, + REWRITE_TAC[real_continuous; REALLIM_MIN]);; + +(* ------------------------------------------------------------------------- *) +(* Some of these without netlimit, but with many different cases. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_WITHIN_ID = prove + (`!x s. (\x. x) real_continuous (atreal x within s)`, + REWRITE_TAC[real_continuous_withinreal] THEN MESON_TAC[]);; + +let REAL_CONTINUOUS_AT_ID = prove + (`!x. (\x. x) real_continuous (atreal x)`, + REWRITE_TAC[real_continuous_atreal] THEN MESON_TAC[]);; + +let REAL_CONTINUOUS_INV_WITHIN = prove + (`!f s a. f real_continuous (at a within s) /\ ~(f a = &0) + ==> (\x. inv(f x)) real_continuous (at a within s)`, + MESON_TAC[REAL_CONTINUOUS_INV; REAL_CONTINUOUS_TRIVIAL_LIMIT; + NETLIMIT_WITHIN]);; + +let REAL_CONTINUOUS_INV_AT = prove + (`!f a. f real_continuous (at a) /\ ~(f a = &0) + ==> (\x. inv(f x)) real_continuous (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_INV_WITHIN]);; + +let REAL_CONTINUOUS_INV_WITHINREAL = prove + (`!f s a. f real_continuous (atreal a within s) /\ ~(f a = &0) + ==> (\x. inv(f x)) real_continuous (atreal a within s)`, + MESON_TAC[REAL_CONTINUOUS_INV; REAL_CONTINUOUS_TRIVIAL_LIMIT; + NETLIMIT_WITHINREAL]);; + +let REAL_CONTINUOUS_INV_ATREAL = prove + (`!f a. f real_continuous (atreal a) /\ ~(f a = &0) + ==> (\x. inv(f x)) real_continuous (atreal a)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_INV_WITHINREAL]);; + +let REAL_CONTINUOUS_DIV_WITHIN = prove + (`!f s a. f real_continuous (at a within s) /\ + g real_continuous (at a within s) /\ ~(g a = &0) + ==> (\x. f x / g x) real_continuous (at a within s)`, + MESON_TAC[REAL_CONTINUOUS_DIV; REAL_CONTINUOUS_TRIVIAL_LIMIT; + NETLIMIT_WITHIN]);; + +let REAL_CONTINUOUS_DIV_AT = prove + (`!f a. f real_continuous (at a) /\ + g real_continuous (at a) /\ ~(g a = &0) + ==> (\x. f x / g x) real_continuous (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_DIV_WITHIN]);; + +let REAL_CONTINUOUS_DIV_WITHINREAL = prove + (`!f s a. f real_continuous (atreal a within s) /\ + g real_continuous (atreal a within s) /\ ~(g a = &0) + ==> (\x. f x / g x) real_continuous (atreal a within s)`, + MESON_TAC[REAL_CONTINUOUS_DIV; REAL_CONTINUOUS_TRIVIAL_LIMIT; + NETLIMIT_WITHINREAL]);; + +let REAL_CONTINUOUS_DIV_ATREAL = prove + (`!f a. f real_continuous (atreal a) /\ + g real_continuous (atreal a) /\ ~(g a = &0) + ==> (\x. f x / g x) real_continuous (atreal a)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_DIV_WITHINREAL]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real->real) o (real->real) functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_WITHINREAL_COMPOSE = prove + (`!f g x s. f real_continuous (atreal x within s) /\ + g real_continuous (atreal (f x) within IMAGE f s) + ==> (g o f) real_continuous (atreal x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_continuous_withinreal; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let REAL_CONTINUOUS_ATREAL_COMPOSE = prove + (`!f g x. f real_continuous (atreal x) /\ g real_continuous (atreal (f x)) + ==> (g o f) real_continuous (atreal x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_continuous_atreal; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real->real) o (real^N->real) functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_WITHIN_COMPOSE = prove + (`!f g x s. f real_continuous (at x within s) /\ + g real_continuous (atreal (f x) within IMAGE f s) + ==> (g o f) real_continuous (at x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_continuous_withinreal; real_continuous_within; + o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let REAL_CONTINUOUS_AT_COMPOSE = prove + (`!f g x. f real_continuous (at x) /\ + g real_continuous (atreal (f x) within IMAGE f (:real^N)) + ==> (g o f) real_continuous (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real^N->real) o (real^M->real^N) functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE = prove + (`!f g x s. f continuous (at x within s) /\ + g real_continuous (at (f x) within IMAGE f s) + ==> (g o f) real_continuous (at x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_continuous_within; continuous_within; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let REAL_CONTINUOUS_CONTINUOUS_AT_COMPOSE = prove + (`!f g x. f continuous (at x) /\ + g real_continuous (at (f x) within IMAGE f (:real^N)) + ==> (g o f) real_continuous (at x)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real^N->real) o (real->real^N) functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE = prove + (`!f g x s. f continuous (atreal x within s) /\ + g real_continuous (at (f x) within IMAGE f s) + ==> (g o f) real_continuous (atreal x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_continuous_within; continuous_withinreal; + real_continuous_withinreal; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let REAL_CONTINUOUS_CONTINUOUS_ATREAL_COMPOSE = prove + (`!f g x. f continuous (atreal x) /\ + g real_continuous (at (f x) within IMAGE f (:real)) + ==> (g o f) real_continuous (atreal x)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real->real^N) o (real->real) functions. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE = prove + (`!f g x s. f real_continuous (atreal x within s) /\ + g continuous (atreal (f x) within IMAGE f s) + ==> (g o f) continuous (atreal x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_continuous_within; continuous_withinreal; + real_continuous_withinreal; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_REAL_CONTINUOUS_ATREAL_COMPOSE = prove + (`!f g x. f real_continuous (atreal x) /\ + g continuous (atreal (f x) within IMAGE f (:real)) + ==> (g o f) continuous (atreal x)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN + REWRITE_TAC[CONTINUOUS_REAL_CONTINUOUS_WITHINREAL_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real^M->real^N) o (real->real^M) functions. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHINREAL_COMPOSE = prove + (`!f g x s. f continuous (atreal x within s) /\ + g continuous (at (f x) within IMAGE f s) + ==> (g o f) continuous (atreal x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[continuous_within; continuous_withinreal; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_ATREAL_COMPOSE = prove + (`!f g x. f continuous (atreal x) /\ + g continuous (at (f x) within IMAGE f (:real)) + ==> (g o f) continuous (atreal x)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN + REWRITE_TAC[CONTINUOUS_WITHINREAL_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of (real->real^N) o (real^M->real) functions. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE = prove + (`!f g x s. f real_continuous (at x within s) /\ + g continuous (atreal (f x) within IMAGE f s) + ==> (g o f) continuous (at x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[continuous_within; real_continuous_within; continuous_withinreal; + o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_REAL_CONTINUOUS_AT_COMPOSE = prove + (`!f g x. f real_continuous (at x) /\ + g continuous (atreal (f x) within IMAGE f (:real^M)) + ==> (g o f) continuous (at x)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[WITHIN_WITHIN; INTER_UNIV] THEN + REWRITE_TAC[CONTINUOUS_REAL_CONTINUOUS_WITHIN_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of a real->real function on a set. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("real_continuous_on",(12,"right"));; + +let real_continuous_on = new_definition + `f real_continuous_on s <=> + !x. x IN s ==> !e. &0 < e + ==> ?d. &0 < d /\ + !x'. x' IN s /\ abs(x' - x) < d + ==> abs(f(x') - f(x)) < e`;; + +let REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove + (`!f s. f real_continuous_on s <=> + !x. x IN s ==> f real_continuous (atreal x within s)`, + REWRITE_TAC[real_continuous_on; real_continuous_withinreal]);; + +let REAL_CONTINUOUS_ON_SUBSET = prove + (`!f s t. f real_continuous_on s /\ t SUBSET s ==> f real_continuous_on t`, + REWRITE_TAC[real_continuous_on; SUBSET] THEN MESON_TAC[]);; + +let REAL_CONTINUOUS_ON_COMPOSE = prove + (`!f g s. f real_continuous_on s /\ g real_continuous_on (IMAGE f s) + ==> (g o f) real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + MESON_TAC[IN_IMAGE; REAL_CONTINUOUS_WITHINREAL_COMPOSE]);; + +let REAL_CONTINUOUS_ON = prove + (`!f s. f real_continuous_on s <=> + (lift o f o drop) continuous_on (IMAGE lift s)`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHINREAL; CONTINUOUS_WITHIN; + FORALL_IN_IMAGE; REALLIM_WITHINREAL_WITHIN; TENDSTO_REAL] THEN + REWRITE_TAC[o_THM; LIFT_DROP]);; + +let REAL_CONTINUOUS_ON_CONST = prove + (`!s c. (\x. c) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_CONST]);; + +let REAL_CONTINUOUS_ON_ID = prove + (`!s. (\x. x) real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_ID]);; + +let REAL_CONTINUOUS_ON_LMUL = prove + (`!f c s. f real_continuous_on s ==> (\x. c * f(x)) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_LMUL]);; + +let REAL_CONTINUOUS_ON_RMUL = prove + (`!f c s. f real_continuous_on s ==> (\x. f(x) * c) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_RMUL]);; + +let REAL_CONTINUOUS_ON_NEG = prove + (`!f s. f real_continuous_on s + ==> (\x. --(f x)) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_NEG]);; + +let REAL_CONTINUOUS_ON_ADD = prove + (`!f g s. f real_continuous_on s /\ g real_continuous_on s + ==> (\x. f(x) + g(x)) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_ADD]);; + +let REAL_CONTINUOUS_ON_SUB = prove + (`!f g s. f real_continuous_on s /\ g real_continuous_on s + ==> (\x. f(x) - g(x)) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_SUB]);; + +let REAL_CONTINUOUS_ON_MUL = prove + (`!f g s. f real_continuous_on s /\ g real_continuous_on s + ==> (\x. f(x) * g(x)) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_MUL]);; + +let REAL_CONTINUOUS_ON_POW = prove + (`!f n s. f real_continuous_on s + ==> (\x. f(x) pow n) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REAL_CONTINUOUS_POW]);; + +let REAL_CONTINUOUS_ON_INV = prove + (`!f s. f real_continuous_on s /\ (!x. x IN s ==> ~(f x = &0)) + ==> (\x. inv(f x)) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_INV_WITHINREAL]);; + +let REAL_CONTINUOUS_ON_DIV = prove + (`!f g s. + f real_continuous_on s /\ + g real_continuous_on s /\ + (!x. x IN s ==> ~(g x = &0)) + ==> (\x. f x / g x) real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_DIV_WITHINREAL]);; + +let REAL_CONTINUOUS_ON_ABS = prove + (`!f s. f real_continuous_on s ==> (\x. abs(f x)) real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[REAL_CONTINUOUS_ABS]);; + +let REAL_CONTINUOUS_ON_EQ = prove + (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f real_continuous_on s + ==> g real_continuous_on s`, + SIMP_TAC[real_continuous_on; IMP_CONJ]);; + +let REAL_CONTINUOUS_ON_UNION = prove + (`!f s t. + real_closed s /\ real_closed t /\ + f real_continuous_on s /\ f real_continuous_on t + ==> f real_continuous_on (s UNION t)`, + REWRITE_TAC[REAL_CLOSED; REAL_CONTINUOUS_ON; IMAGE_UNION; + CONTINUOUS_ON_UNION]);; + +let REAL_CONTINUOUS_ON_UNION_OPEN = prove + (`!f s t. + real_open s /\ real_open t /\ + f real_continuous_on s /\ f real_continuous_on t + ==> f real_continuous_on (s UNION t)`, + REWRITE_TAC[REAL_OPEN; REAL_CONTINUOUS_ON; IMAGE_UNION; + CONTINUOUS_ON_UNION_OPEN]);; + +let REAL_CONTINUOUS_ON_CASES = prove + (`!P f g s t. + real_closed s /\ real_closed t /\ + f real_continuous_on s /\ g real_continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) real_continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_UNION THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let REAL_CONTINUOUS_ON_CASES_OPEN = prove + (`!P f g s t. + real_open s /\ real_open t /\ + f real_continuous_on s /\ g real_continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) real_continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_UNION_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let REAL_CONTINUOUS_ON_SUM = prove + (`!t f s. + FINITE s /\ (!a. a IN s ==> f a real_continuous_on t) + ==> (\x. sum s (\a. f a x)) real_continuous_on t`, + REPEAT GEN_TAC THEN SIMP_TAC[REAL_CONTINUOUS_ON; o_DEF; LIFT_SUM] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_ON_VSUM) THEN + REWRITE_TAC[]);; + +let REALLIM_CONTINUOUS_FUNCTION = prove + (`!f net g l. + f continuous (atreal l) /\ (g ---> l) net + ==> ((\x. f(g x)) --> f l) net`, + REWRITE_TAC[tendsto_real; tendsto; continuous_atreal; eventually] THEN + MESON_TAC[]);; + +let LIM_REAL_CONTINUOUS_FUNCTION = prove + (`!f net g l. + f real_continuous (at l) /\ (g --> l) net + ==> ((\x. f(g x)) ---> f l) net`, + REWRITE_TAC[tendsto_real; tendsto; real_continuous_at; eventually] THEN + MESON_TAC[]);; + +let REALLIM_REAL_CONTINUOUS_FUNCTION = prove + (`!f net g l. + f real_continuous (atreal l) /\ (g ---> l) net + ==> ((\x. f(g x)) ---> f l) net`, + REWRITE_TAC[tendsto_real; real_continuous_atreal; eventually] THEN + MESON_TAC[]);; + +let REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT = prove + (`!f s. real_open s + ==> (f real_continuous_on s <=> + !x. x IN s ==> f real_continuous atreal x)`, + SIMP_TAC[REAL_CONTINUOUS_ATREAL; REAL_CONTINUOUS_WITHINREAL; + REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; REALLIM_WITHIN_REAL_OPEN]);; + +let REAL_CONTINUOUS_ATTAINS_SUP = prove + (`!f s. real_compact s /\ ~(s = {}) /\ f real_continuous_on s + ==> ?x. x IN s /\ (!y. y IN s ==> f y <= f x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`] + CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM real_compact] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_THM; LIFT_DROP]);; + +let REAL_CONTINUOUS_ATTAINS_INF = prove + (`!f s. real_compact s /\ ~(s = {}) /\ f real_continuous_on s + ==> ?x. x IN s /\ (!y. y IN s ==> f x <= f y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`] + CONTINUOUS_ATTAINS_INF) THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM real_compact] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_THM; LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Real version of uniform continuity. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("real_uniformly_continuous_on",(12,"right"));; + +let real_uniformly_continuous_on = new_definition + `f real_uniformly_continuous_on s <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x x'. x IN s /\ x' IN s /\ abs(x' - x) < d + ==> abs(f x' - f x) < e`;; + +let REAL_UNIFORMLY_CONTINUOUS_ON = prove + (`!f s. f real_uniformly_continuous_on s <=> + (lift o f o drop) uniformly_continuous_on (IMAGE lift s)`, + REWRITE_TAC[real_uniformly_continuous_on; uniformly_continuous_on] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_THM; DIST_LIFT; LIFT_DROP]);; + +let REAL_UNIFORMLY_CONTINUOUS_IMP_REAL_CONTINUOUS = prove + (`!f s. f real_uniformly_continuous_on s ==> f real_continuous_on s`, + REWRITE_TAC[real_uniformly_continuous_on; real_continuous_on] THEN + MESON_TAC[]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove + (`!f s. f real_uniformly_continuous_on s <=> + !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\ + ((\n. x(n) - y(n)) ---> &0) sequentially + ==> ((\n. f(x(n)) - f(y(n))) ---> &0) sequentially`, + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; REAL_TENDSTO] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP; DROP_SUB; DROP_VEC] THEN + REWRITE_TAC[FORALL_LIFT_FUN; o_THM; LIFT_DROP]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_SUBSET = prove + (`!f s t. f real_uniformly_continuous_on s /\ t SUBSET s + ==> f real_uniformly_continuous_on t`, + REWRITE_TAC[real_uniformly_continuous_on; SUBSET] THEN MESON_TAC[]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove + (`!f g s. f real_uniformly_continuous_on s /\ + g real_uniformly_continuous_on (IMAGE f s) + ==> (g o f) real_uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE f s) = IMAGE (lift o f o drop) (IMAGE lift s)` + SUBST1_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_ON_COMPOSE)] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_CONST = prove + (`!s c. (\x. c) real_uniformly_continuous_on s`, + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF; + REAL_SUB_REFL; REALLIM_CONST]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_LMUL = prove + (`!f c s. f real_uniformly_continuous_on s + ==> (\x. c * f(x)) real_uniformly_continuous_on s`, + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON] THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; UNIFORMLY_CONTINUOUS_ON_CMUL]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_RMUL = prove + (`!f c s. f real_uniformly_continuous_on s + ==> (\x. f(x) * c) real_uniformly_continuous_on s`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_LMUL]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_ID = prove + (`!s. (\x. x) real_uniformly_continuous_on s`, + REWRITE_TAC[real_uniformly_continuous_on] THEN MESON_TAC[]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_NEG = prove + (`!f s. f real_uniformly_continuous_on s + ==> (\x. --(f x)) real_uniformly_continuous_on s`, + ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON_LMUL]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_ADD = prove + (`!f g s. f real_uniformly_continuous_on s /\ + g real_uniformly_continuous_on s + ==> (\x. f(x) + g(x)) real_uniformly_continuous_on s`, + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_ADD] THEN + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_ADD]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_SUB = prove + (`!f g s. f real_uniformly_continuous_on s /\ + g real_uniformly_continuous_on s + ==> (\x. f(x) - g(x)) real_uniformly_continuous_on s`, + REWRITE_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_SUB] THEN + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SUB]);; + +let REAL_UNIFORMLY_CONTINUOUS_ON_SUM = prove + (`!t f s. + FINITE s /\ (!a. a IN s ==> f a real_uniformly_continuous_on t) + ==> (\x. sum s (\a. f a x)) real_uniformly_continuous_on t`, + REPEAT GEN_TAC THEN + SIMP_TAC[REAL_UNIFORMLY_CONTINUOUS_ON; o_DEF; LIFT_SUM] THEN + DISCH_THEN(MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_ON_VSUM) THEN + REWRITE_TAC[]);; + +let REAL_COMPACT_UNIFORMLY_CONTINUOUS = prove + (`!f s. f real_continuous_on s /\ real_compact s + ==> f real_uniformly_continuous_on s`, + REWRITE_TAC[real_compact; REAL_CONTINUOUS_ON; REAL_UNIFORMLY_CONTINUOUS_ON; + COMPACT_UNIFORMLY_CONTINUOUS]);; + +let REAL_COMPACT_CONTINUOUS_IMAGE = prove + (`!f s. f real_continuous_on s /\ real_compact s + ==> real_compact (IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_compact; REAL_CONTINUOUS_ON] THEN + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_CONTINUOUS_IMAGE) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP]);; + +let REAL_DINI = prove + (`!f g s. + real_compact s /\ (!n. (f n) real_continuous_on s) /\ + g real_continuous_on s /\ + (!x. x IN s ==> ((\n. (f n x)) ---> g x) sequentially) /\ + (!n x. x IN s ==> f n x <= f (n + 1) x) + ==> !e. &0 < e + ==> eventually (\n. !x. x IN s ==> abs(f n x - g x) < e) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. lift o f n o drop`; `lift o g o drop`; + `IMAGE lift s`] DINI) THEN + ASM_REWRITE_TAC[GSYM real_compact; GSYM REAL_CONTINUOUS_ON] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP; REAL_TENDSTO] THEN + ASM_SIMP_TAC[GSYM LIFT_SUB; NORM_LIFT]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity versus componentwise continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_COMPONENTWISE = prove + (`!net f:A->real^N. + f continuous net <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. (f x)$i) real_continuous net`, + REWRITE_TAC[real_continuous; continuous; LIM_COMPONENTWISE]);; + +let REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT = prove + (`!z. Re real_continuous (at z) /\ Im real_continuous (at z)`, + GEN_TAC THEN MP_TAC(ISPECL + [`at(z:complex)`; `\z:complex. z`] CONTINUOUS_COMPONENTWISE) THEN + REWRITE_TAC[CONTINUOUS_AT_ID; DIMINDEX_2; FORALL_2] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; ETA_AX]);; + +let REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN = prove + (`!s z. Re real_continuous (at z within s) /\ + Im real_continuous (at z within s)`, + MESON_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; + REAL_CONTINUOUS_AT_WITHIN]);; + +let REAL_CONTINUOUS_NORM_AT = prove + (`!z. norm real_continuous (at z)`, + REWRITE_TAC[real_continuous_at; dist] THEN + GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let REAL_CONTINUOUS_NORM_WITHIN = prove + (`!s z. norm real_continuous (at z within s)`, + MESON_TAC[REAL_CONTINUOUS_NORM_AT; REAL_CONTINUOUS_AT_WITHIN]);; + +let REAL_CONTINUOUS_DIST_AT = prove + (`!a z. (\x. dist(a,x)) real_continuous (at z)`, + REWRITE_TAC[real_continuous_at; dist] THEN + GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let REAL_CONTINUOUS_DIST_WITHIN = prove + (`!a s z. (\x. dist(a,x)) real_continuous (at z within s)`, + MESON_TAC[REAL_CONTINUOUS_DIST_AT; REAL_CONTINUOUS_AT_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Derivative of real->real function. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("has_real_derivative",(12,"right"));; +parse_as_infix ("real_differentiable",(12,"right"));; +parse_as_infix ("real_differentiable_on",(12,"right"));; + +let has_real_derivative = new_definition + `(f has_real_derivative f') net <=> + ((\x. inv(x - netlimit net) * + (f x - (f(netlimit net) + f' * (x - netlimit net)))) + ---> &0) net`;; + +let real_differentiable = new_definition + `f real_differentiable net <=> ?f'. (f has_real_derivative f') net`;; + +let real_derivative = new_definition + `real_derivative f x = @f'. (f has_real_derivative f') (atreal x)`;; + +let higher_real_derivative = define + `higher_real_derivative 0 f = f /\ + (!n. higher_real_derivative (SUC n) f = + real_derivative (higher_real_derivative n f))`;; + +let real_differentiable_on = new_definition + `f real_differentiable_on s <=> + !x. x IN s ==> ?f'. (f has_real_derivative f') (atreal x within s)`;; + +(* ------------------------------------------------------------------------- *) +(* Basic limit definitions in the useful cases. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_WITHINREAL = prove + (`(f has_real_derivative f') (atreal a within s) <=> + ((\x. (f x - f a) / (x - a)) ---> f') (atreal a within s)`, + REWRITE_TAC[has_real_derivative] THEN + ASM_CASES_TAC `trivial_limit(atreal a within s)` THENL + [ASM_REWRITE_TAC[REALLIM]; ALL_TAC] THEN + ASM_SIMP_TAC[NETLIMIT_WITHINREAL] THEN + GEN_REWRITE_TAC RAND_CONV [REALLIM_NULL] THEN + REWRITE_TAC[REALLIM_WITHINREAL; REAL_SUB_RZERO] THEN + SIMP_TAC[REAL_FIELD + `&0 < abs(x - a) ==> (fy - fa) / (x - a) - f' = + inv(x - a) * (fy - (fa + f' * (x - a)))`]);; + +let HAS_REAL_DERIVATIVE_ATREAL = prove + (`(f has_real_derivative f') (atreal a) <=> + ((\x. (f x - f a) / (x - a)) ---> f') (atreal a)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to Frechet derivative. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_FRECHET_DERIVATIVE_WITHIN = prove + (`(f has_real_derivative f') (atreal x within s) <=> + ((lift o f o drop) has_derivative (\x. f' % x)) + (at (lift x) within (IMAGE lift s))`, + REWRITE_TAC[has_derivative_within; HAS_REAL_DERIVATIVE_WITHINREAL] THEN + REWRITE_TAC[o_THM; LIFT_DROP; LIM_WITHIN; REALLIM_WITHINREAL] THEN + SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID; IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_IMAGE; DIST_LIFT; GSYM LIFT_SUB; LIFT_DROP; + NORM_ARITH `dist(x,vec 0) = norm x`; GSYM LIFT_CMUL; GSYM LIFT_ADD; + NORM_LIFT] THEN + SIMP_TAC[REAL_FIELD + `&0 < abs(y - x) + ==> fy - (fx + f' * (y - x)) = (y - x) * ((fy - fx) / (y - x) - f')`] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_MUL_ASSOC; REAL_ABS_INV; REAL_ABS_ABS] THEN + SIMP_TAC[REAL_LT_IMP_NZ; REAL_MUL_LINV; REAL_MUL_LID]);; + +let HAS_REAL_FRECHET_DERIVATIVE_AT = prove + (`(f has_real_derivative f') (atreal x) <=> + ((lift o f o drop) has_derivative (\x. f' % x)) (at (lift x))`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV; GSYM WITHIN_UNIV] THEN + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV]);; + +let HAS_REAL_VECTOR_DERIVATIVE_WITHIN = prove + (`(f has_real_derivative f') (atreal x within s) <=> + ((lift o f o drop) has_vector_derivative (lift f')) + (at (lift x) within (IMAGE lift s))`, + REWRITE_TAC[has_vector_derivative; HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; GSYM LIFT_CMUL] THEN + REWRITE_TAC[LIFT_DROP; LIFT_EQ; REAL_MUL_SYM]);; + +let HAS_REAL_VECTOR_DERIVATIVE_AT = prove + (`(f has_real_derivative f') (atreal x) <=> + ((lift o f o drop) has_vector_derivative (lift f')) (at (lift x))`, + REWRITE_TAC[has_vector_derivative; HAS_REAL_FRECHET_DERIVATIVE_AT] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; GSYM LIFT_CMUL] THEN + REWRITE_TAC[LIFT_DROP; LIFT_EQ; REAL_MUL_SYM]);; + +let REAL_DIFFERENTIABLE_AT = prove + (`!f a. f real_differentiable (atreal x) <=> + (lift o f o drop) differentiable (at(lift x))`, + REWRITE_TAC[real_differentiable; HAS_REAL_FRECHET_DERIVATIVE_AT] THEN + REWRITE_TAC[differentiable; has_derivative; LINEAR_SCALING] THEN + REWRITE_TAC[LINEAR_1; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2]);; + +let REAL_DIFFERENTIABLE_WITHIN = prove + (`!f a s. + f real_differentiable (atreal x within s) <=> + (lift o f o drop) differentiable (at(lift x) within IMAGE lift s)`, + REWRITE_TAC[real_differentiable; HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + REWRITE_TAC[differentiable; has_derivative; LINEAR_SCALING] THEN + REWRITE_TAC[LINEAR_1; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to complex derivative. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_COMPLEX_DERIVATIVE_WITHIN = prove + (`(f has_real_derivative f') (atreal a within s) <=> + ((Cx o f o Re) has_complex_derivative (Cx f')) + (at (Cx a) within {z | real z /\ Re z IN s})`, + REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_COMPLEX_DERIVATIVE_WITHIN; + LIM_WITHIN; IN_ELIM_THM; IMP_CONJ; FORALL_REAL] THEN + REWRITE_TAC[RE_CX; dist; GSYM CX_SUB; COMPLEX_NORM_CX; o_THM; GSYM CX_DIV; + REALLIM_WITHINREAL] THEN + MESON_TAC[]);; + +let HAS_REAL_COMPLEX_DERIVATIVE_AT = prove + (`(f has_real_derivative f') (atreal a) <=> + ((Cx o f o Re) has_complex_derivative (Cx f')) (at (Cx a) within real)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; + +let REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE = prove + (`!f s. f real_differentiable_on s <=> + !x. x IN s ==> f real_differentiable (atreal x within s)`, + REWRITE_TAC[real_differentiable_on; real_differentiable]);; + +let REAL_DIFFERENTIABLE_ON_REAL_OPEN = prove + (`!f s. real_open s + ==> (f real_differentiable_on s <=> + !x. x IN s ==> ?f'. (f has_real_derivative f') (atreal x))`, + REWRITE_TAC[real_differentiable_on; HAS_REAL_DERIVATIVE_WITHINREAL; + HAS_REAL_DERIVATIVE_ATREAL] THEN + SIMP_TAC[REALLIM_WITHIN_REAL_OPEN]);; + +let REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_WITHIN = prove + (`!f s x. f real_differentiable_on s /\ x IN s + ==> f real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE]);; + +let REAL_DIFFERENTIABLE_ON_IMP_DIFFERENTIABLE_ATREAL = prove + (`!f s x. f real_differentiable_on s /\ real_open s /\ x IN s + ==> f real_differentiable (atreal x)`, + MESON_TAC[REAL_DIFFERENTIABLE_ON_REAL_OPEN; real_differentiable]);; + +let HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN = prove + (`!f g h s d. + &0 < d /\ x IN s /\ + (h has_complex_derivative Cx(g)) + (at (Cx x) within {z | real z /\ Re(z) IN s}) /\ + (!y. y IN s /\ abs(y - x) < d ==> h(Cx y) = Cx(f y)) + ==> (f has_real_derivative g) (atreal x within s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`h:complex->complex`; `d:real`] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; o_THM; REAL_CX; RE_CX; dist] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Re w`) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CX_SUB; COMPLEX_NORM_CX]) THEN + ASM_REWRITE_TAC[RE_CX]);; + +let HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN = prove + (`!f g h d. + &0 < d /\ + (h has_complex_derivative Cx(g)) (at (Cx x) within real) /\ + (!y. abs(y - x) < d ==> h(Cx y) = Cx(f y)) + ==> (f has_real_derivative g) (atreal x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN THEN + MAP_EVERY EXISTS_TAC [`h:complex->complex`; `d:real`] THEN + ASM_REWRITE_TAC[IN_UNIV; ETA_AX; SET_RULE `{x | r x} = r`]);; + +let HAS_COMPLEX_REAL_DERIVATIVE_WITHIN = prove + (`!f g h s. + x IN s /\ + (h has_complex_derivative Cx(g)) + (at (Cx x) within {z | real z /\ Re(z) IN s}) /\ + (!y. y IN s ==> h(Cx y) = Cx(f y)) + ==> (f has_real_derivative g) (atreal x within s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN_GEN THEN + MAP_EVERY EXISTS_TAC [`h:complex->complex`; `&1`] THEN + ASM_SIMP_TAC[REAL_LT_01]);; + +let HAS_COMPLEX_REAL_DERIVATIVE_AT = prove + (`!f g h. + (h has_complex_derivative Cx(g)) (at (Cx x) within real) /\ + (!y. h(Cx y) = Cx(f y)) + ==> (f has_real_derivative g) (atreal x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_WITHIN THEN + EXISTS_TAC `h:complex->complex` THEN + ASM_REWRITE_TAC[IN_UNIV; ETA_AX; SET_RULE `{x | r x} = r`]);; + +(* ------------------------------------------------------------------------- *) +(* Caratheodory characterization. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL = prove + (`!f f' z. + (f has_real_derivative f') (atreal z) <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ + g real_continuous atreal z /\ g(z) = f'`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_RING `w' - z':real = a <=> w' = z' + a`] THEN + SIMP_TAC[GSYM FUN_EQ_THM; HAS_REAL_DERIVATIVE_ATREAL; + REAL_CONTINUOUS_ATREAL] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `\w. if w = z then f':real else (f(w) - f(z)) / (w - z)` THEN + ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; REAL_SUB_REFL] THEN + CONV_TAC REAL_FIELD; + FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN + ASM_SIMP_TAC[REAL_RING `(z + a) - (z + b * (w - w)):real = a`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REALLIM_TRANSFORM)) THEN + SIMP_TAC[REALLIM_CONST; REAL_FIELD + `~(w = z) ==> x - (x * (w - z)) / (w - z) = &0`]]);; + +let HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL = prove + (`!f f' z s. + (f has_real_derivative f') (atreal z within s) <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ + g real_continuous (atreal z within s) /\ g(z) = f'`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_RING `w' - z':real = a <=> w' = z' + a`] THEN + SIMP_TAC[GSYM FUN_EQ_THM; HAS_REAL_DERIVATIVE_WITHINREAL; + REAL_CONTINUOUS_WITHINREAL] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `\w. if w = z then f':real else (f(w) - f(z)) / (w - z)` THEN + ASM_SIMP_TAC[FUN_EQ_THM; COND_RAND; COND_RATOR; REAL_SUB_REFL] THEN + CONV_TAC REAL_FIELD; + FIRST_X_ASSUM SUBST_ALL_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN + ASM_SIMP_TAC[REAL_RING `(z + a) - (z + b * (w - w)):real = a`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REALLIM_TRANSFORM)) THEN + SIMP_TAC[REALLIM_CONST; REAL_FIELD + `~(w = z) ==> x - (x * (w - z)) / (w - z) = &0`]]);; + +let REAL_DIFFERENTIABLE_CARATHEODORY_ATREAL = prove + (`!f z. f real_differentiable atreal z <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ g real_continuous atreal z`, + SIMP_TAC[real_differentiable; HAS_REAL_DERIVATIVE_CARATHEODORY_ATREAL] THEN + MESON_TAC[]);; + +let REAL_DIFFERENTIABLE_CARATHEODORY_WITHINREAL = prove + (`!f z s. + f real_differentiable (atreal z within s) <=> + ?g. (!w. f(w) - f(z) = g(w) * (w - z)) /\ + g real_continuous (atreal z within s)`, + SIMP_TAC[real_differentiable; + HAS_REAL_DERIVATIVE_CARATHEODORY_WITHINREAL] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Property of being an interval (equivalent to convex or connected). *) +(* ------------------------------------------------------------------------- *) + +let is_realinterval = new_definition + `is_realinterval s <=> + !a b c. a IN s /\ b IN s /\ a <= c /\ c <= b ==> c IN s`;; + +let IS_REALINTERVAL_IS_INTERVAL = prove + (`!s. is_realinterval s <=> is_interval(IMAGE lift s)`, + REWRITE_TAC[IS_INTERVAL_1; is_realinterval] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[LIFT_DROP; IN_IMAGE; EXISTS_DROP; UNWIND_THM1] THEN + REWRITE_TAC[GSYM FORALL_DROP]);; + +let IS_REALINTERVAL_CONVEX = prove + (`!s. is_realinterval s <=> convex(IMAGE lift s)`, + REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_CONVEX_1]);; + +let IS_REALINTERVAL_CONNECTED = prove + (`!s. is_realinterval s <=> connected(IMAGE lift s)`, + REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_CONNECTED_1]);; + +let TRIVIAL_LIMIT_WITHIN_REALINTERVAL = prove + (`!s x. is_realinterval s /\ x IN s + ==> (trivial_limit(atreal x within s) <=> s = {x})`, + REWRITE_TAC[TRIVIAL_LIMIT_WITHINREAL_WITHIN; IS_REALINTERVAL_CONVEX] THEN + REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN + SIMP_TAC[TRIVIAL_LIMIT_WITHIN_CONVEX] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_SING] THEN + MESON_TAC[LIFT_DROP]);; + +let IS_REALINTERVAL_EMPTY = prove + (`is_realinterval {}`, + REWRITE_TAC[is_realinterval; NOT_IN_EMPTY]);; + +let IS_REALINTERVAL_UNION = prove + (`!s t. is_realinterval s /\ is_realinterval t /\ ~(s INTER t = {}) + ==> is_realinterval(s UNION t)`, + REWRITE_TAC[is_realinterval; IN_UNION; IN_INTER; + NOT_IN_EMPTY; EXTENSION] THEN + MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL]);; + +let IS_REALINTERVAL_UNIV = prove + (`is_realinterval (:real)`, + REWRITE_TAC[is_realinterval; IN_UNIV]);; + +let IS_REAL_INTERVAL_CASES = prove + (`!s. is_realinterval s <=> + s = {} \/ + s = (:real) \/ + (?a. s = {x | a < x}) \/ + (?a. s = {x | a <= x}) \/ + (?b. s = {x | x <= b}) \/ + (?b. s = {x | x < b}) \/ + (?a b. s = {x | a < x /\ x < b}) \/ + (?a b. s = {x | a < x /\ x <= b}) \/ + (?a b. s = {x | a <= x /\ x < b}) \/ + (?a b. s = {x | a <= x /\ x <= b})`, + REWRITE_TAC[IS_REALINTERVAL_IS_INTERVAL; IS_INTERVAL_1_CASES] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM FORALL_DROP; IN_UNIV; NOT_IN_EMPTY]);; + +let REAL_CONVEX = prove + (`!s. is_realinterval s <=> + !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> (u * x + v * y) IN s`, + REWRITE_TAC[IS_REALINTERVAL_CONVEX; convex] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; DROP_ADD; DROP_CMUL; LIFT_DROP]);; + +let REAL_CONVEX_ALT = prove + (`!s. is_realinterval s <=> + !x y u. x IN s /\ y IN s /\ &0 <= u /\ u <= &1 + ==> ((&1 - u) * x + u * y) IN s`, + REWRITE_TAC[IS_REALINTERVAL_CONVEX; CONVEX_ALT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; DROP_ADD; DROP_CMUL; LIFT_DROP]);; + +let REAL_MIDPOINT_IN_CONVEX = prove + (`!s x y. is_realinterval s /\ x IN s /\ y IN s ==> ((x + y) / &2) IN s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `(x + y) / &2 = inv(&2) * x + inv(&2) * y`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [REAL_CONVEX]) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some relations with the complex numbers can also be useful. *) +(* ------------------------------------------------------------------------- *) + +let IS_REALINTERVAL_CONVEX_COMPLEX = prove + (`!s. is_realinterval s <=> convex {z | real z /\ Re z IN s}`, + GEN_TAC THEN + REWRITE_TAC[GSYM IMAGE_CX; IS_REALINTERVAL_CONVEX] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o ISPEC `Cx o drop` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONVEX_LINEAR_IMAGE)) THEN + REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN + ONCE_REWRITE_TAC[IMAGE_o] THEN REWRITE_TAC[IMAGE_LIFT_DROP] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[linear; o_THM; CX_ADD; CX_MUL; DROP_ADD; DROP_CMUL; + COMPLEX_CMUL]; + DISCH_THEN(MP_TAC o ISPEC `lift o Re` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] CONVEX_LINEAR_IMAGE)) THEN + REWRITE_TAC[GSYM IMAGE_o; GSYM o_ASSOC] THEN + ONCE_REWRITE_TAC[IMAGE_o] THEN + REWRITE_TAC[o_DEF; RE_CX; SET_RULE `IMAGE (\x. x) s = s`] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[linear; o_THM; RE_CMUL; + RE_ADD; RE_MUL_CX; LIFT_ADD; LIFT_CMUL]]);; + +(* ------------------------------------------------------------------------- *) +(* The same tricks to define closed and open intervals. *) +(* ------------------------------------------------------------------------- *) + +let open_real_interval = new_definition + `open_real_interval(a:real,b:real) = {x:real | a < x /\ x < b}`;; + +let closed_real_interval = define + `closed_real_interval[a:real,b:real] = {x:real | a <= x /\ x <= b}`;; + +make_overloadable "real_interval" `:A`;; + +overload_interface("real_interval",`open_real_interval`);; +overload_interface("real_interval",`closed_real_interval`);; + +let real_interval = prove + (`real_interval(a,b) = {x | a < x /\ x < b} /\ + real_interval[a,b] = {x | a <= x /\ x <= b}`, + REWRITE_TAC[open_real_interval; closed_real_interval]);; + +let IN_REAL_INTERVAL = prove + (`!a b x. (x IN real_interval[a,b] <=> a <= x /\ x <= b) /\ + (x IN real_interval(a,b) <=> a < x /\ x < b)`, + REWRITE_TAC[real_interval; IN_ELIM_THM]);; + +let REAL_INTERVAL_INTERVAL = prove + (`real_interval[a,b] = IMAGE drop (interval[lift a,lift b]) /\ + real_interval(a,b) = IMAGE drop (interval(lift a,lift b))`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN + REWRITE_TAC[EXISTS_LIFT; LIFT_DROP; UNWIND_THM1]);; + +let INTERVAL_REAL_INTERVAL = prove + (`interval[a,b] = IMAGE lift (real_interval[drop a,drop b]) /\ + interval(a,b) = IMAGE lift (real_interval(drop a,drop b))`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN + REWRITE_TAC[EXISTS_DROP; LIFT_DROP; UNWIND_THM1]);; + +let EMPTY_AS_REAL_INTERVAL = prove + (`{} = real_interval[&1,&0]`, + REWRITE_TAC[REAL_INTERVAL_INTERVAL; LIFT_NUM; GSYM EMPTY_AS_INTERVAL] THEN + REWRITE_TAC[IMAGE_CLAUSES]);; + +let IMAGE_LIFT_REAL_INTERVAL = prove + (`IMAGE lift (real_interval[a,b]) = interval[lift a,lift b] /\ + IMAGE lift (real_interval(a,b)) = interval(lift a,lift b)`, + REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN + SET_TAC[]);; + +let IMAGE_DROP_INTERVAL = prove + (`IMAGE drop (interval[a,b]) = real_interval[drop a,drop b] /\ + IMAGE drop (interval(a,b)) = real_interval(drop a,drop b)`, + REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN + SET_TAC[]);; + +let SUBSET_REAL_INTERVAL = prove + (`!a b c d. + (real_interval[a,b] SUBSET real_interval[c,d] <=> + b < a \/ c <= a /\ a <= b /\ b <= d) /\ + (real_interval[a,b] SUBSET real_interval(c,d) <=> + b < a \/ c < a /\ a <= b /\ b < d) /\ + (real_interval(a,b) SUBSET real_interval[c,d] <=> + b <= a \/ c <= a /\ a < b /\ b <= d) /\ + (real_interval(a,b) SUBSET real_interval(c,d) <=> + b <= a \/ c <= a /\ a < b /\ b <= d)`, + let lemma = prove + (`IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`, + SET_TAC[LIFT_DROP]) in + REWRITE_TAC[REAL_INTERVAL_INTERVAL; lemma; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[LIFT_DROP]);; + +let REAL_INTERVAL_OPEN_SUBSET_CLOSED = prove + (`!a b. real_interval(a,b) SUBSET real_interval[a,b]`, + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; + +let REAL_INTERVAL_EQ_EMPTY = prove + (`(!a b. real_interval[a,b] = {} <=> b < a) /\ + (!a b. real_interval(a,b) = {} <=> b <= a)`, + REWRITE_TAC[REAL_INTERVAL_INTERVAL; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY_1; LIFT_DROP]);; + +let REAL_INTERVAL_NE_EMPTY = prove + (`(!a b. ~(real_interval[a,b] = {}) <=> a <= b) /\ + (!a b. ~(real_interval(a,b) = {}) <=> a < b)`, + REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT]);; + +let REAL_OPEN_CLOSED_INTERVAL = prove + (`!a b. real_interval(a,b) = real_interval[a,b] DIFF {a,b}`, + SIMP_TAC[EXTENSION; IN_DIFF; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC);; + +let REAL_CLOSED_OPEN_INTERVAL = prove + (`!a b. a <= b ==> real_interval[a,b] = real_interval(a,b) UNION {a,b}`, + SIMP_TAC[EXTENSION; IN_UNION; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC);; + +let REAL_CLOSED_REAL_INTERVAL = prove + (`!a b. real_closed(real_interval[a,b])`, + REWRITE_TAC[REAL_CLOSED; IMAGE_LIFT_REAL_INTERVAL; CLOSED_INTERVAL]);; + +let REAL_OPEN_REAL_INTERVAL = prove + (`!a b. real_open(real_interval(a,b))`, + REWRITE_TAC[REAL_OPEN; IMAGE_LIFT_REAL_INTERVAL; OPEN_INTERVAL]);; + +let REAL_INTERVAL_SING = prove + (`!a. real_interval[a,a] = {a} /\ real_interval(a,a) = {}`, + REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_REAL_INTERVAL] THEN + REAL_ARITH_TAC);; + +let REAL_COMPACT_INTERVAL = prove + (`!a b. real_compact(real_interval[a,b])`, + REWRITE_TAC[REAL_INTERVAL_INTERVAL; real_compact] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID; COMPACT_INTERVAL]);; + +let IS_REALINTERVAL_INTERVAL = prove + (`!a b. is_realinterval(real_interval(a,b)) /\ + is_realinterval(real_interval[a,b])`, + REWRITE_TAC[is_realinterval; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; + +let REAL_BOUNDED_REAL_INTERVAL = prove + (`(!a b. real_bounded(real_interval[a,b])) /\ + (!a b. real_bounded(real_interval(a,b)))`, + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; REAL_BOUNDED; BOUNDED_INTERVAL]);; + +let ENDS_IN_REAL_INTERVAL = prove + (`(!a b. a IN real_interval[a,b] <=> ~(real_interval[a,b] = {})) /\ + (!a b. b IN real_interval[a,b] <=> ~(real_interval[a,b] = {})) /\ + (!a b. ~(a IN real_interval(a,b))) /\ + (!a b. ~(b IN real_interval(a,b)))`, + REWRITE_TAC[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN REAL_ARITH_TAC);; + +let IMAGE_AFFINITY_REAL_INTERVAL = prove + (`!a b m c. + IMAGE (\x. m * x + c) (real_interval[a,b]) = + (if real_interval[a,b] = {} + then {} + else if &0 <= m + then real_interval[m * a + c,m * b + c] + else real_interval[m * b + c,m * a + c])`, + REWRITE_TAC[REAL_INTERVAL_INTERVAL; GSYM IMAGE_o; o_DEF; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_DROP; LIFT_DROP; GSYM DROP_CMUL; GSYM DROP_ADD] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[IMAGE_o; IMAGE_AFFINITY_INTERVAL] THEN + MESON_TAC[IMAGE_CLAUSES]);; + +let IMAGE_STRETCH_REAL_INTERVAL = prove + (`!a b m. + IMAGE (\x. m * x) (real_interval[a,b]) = + (if real_interval[a,b] = {} + then {} + else if &0 <= m + then real_interval[m * a,m * b] + else real_interval[m * b,m * a])`, + ONCE_REWRITE_TAC[REAL_ARITH `m * x = m * x + &0`] THEN + REWRITE_TAC[IMAGE_AFFINITY_REAL_INTERVAL]);; + +let REAL_INTERVAL_TRANSLATION = prove + (`(!c a b. real_interval[c + a,c + b] = + IMAGE (\x. c + x) (real_interval[a,b])) /\ + (!c a b. real_interval(c + a,c + b) = + IMAGE (\x. c + x) (real_interval(a,b)))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[REAL_ARITH `c + x:real = y <=> x = y - c`; EXISTS_REFL] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; + +let IN_REAL_INTERVAL_REFLECT = prove + (`(!a b x. --x IN real_interval[--b,--a] <=> x IN real_interval[a,b]) /\ + (!a b x. --x IN real_interval(--b,--a) <=> x IN real_interval(a,b))`, + REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; + +let REFLECT_REAL_INTERVAL = prove + (`(!a b. IMAGE (--) (real_interval[a,b]) = real_interval[--b,--a]) /\ + (!a b. IMAGE (--) (real_interval(a,b)) = real_interval(--b,--a))`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_REAL_INTERVAL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`] THEN + REWRITE_TAC[UNWIND_THM1] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Real continuity and differentiability. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_CONTINUOUS = prove + (`f real_continuous net <=> (Cx o f) continuous net`, + REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; o_THM]);; + +let REAL_CONTINUOUS_CONTINUOUS1 = prove + (`f real_continuous net <=> (lift o f) continuous net`, + REWRITE_TAC[real_continuous; continuous; TENDSTO_REAL; o_THM]);; + +let REAL_CONTINUOUS_CONTINUOUS_ATREAL = prove + (`f real_continuous (atreal x) <=> (lift o f o drop) continuous (at(lift x))`, + REWRITE_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL_AT; CONTINUOUS_AT; + TENDSTO_REAL; o_THM; LIFT_DROP]);; + +let REAL_CONTINUOUS_CONTINUOUS_WITHINREAL = prove + (`f real_continuous (atreal x within s) <=> + (lift o f o drop) continuous (at(lift x) within IMAGE lift s)`, + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL; REALLIM_WITHINREAL_WITHIN] THEN + REWRITE_TAC[TENDSTO_REAL; CONTINUOUS_WITHIN; o_THM; LIFT_DROP]);; + +let REAL_COMPLEX_CONTINUOUS_WITHINREAL = prove + (`f real_continuous (atreal x within s) <=> + (Cx o f o Re) continuous (at (Cx x) within (real INTER IMAGE Cx s))`, + REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; + LIM_WITHINREAL_WITHINCOMPLEX; NETLIMIT_WITHINREAL; GSYM o_ASSOC] THEN + ASM_CASES_TAC `trivial_limit(at(Cx x) within (real INTER IMAGE Cx s))` THENL + [ASM_REWRITE_TAC[LIM]; + ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHINREAL_WITHINCOMPLEX; + NETLIMIT_WITHIN; NETLIMIT_WITHINREAL; RE_CX; o_THM]]);; + +let REAL_COMPLEX_CONTINUOUS_ATREAL = prove + (`f real_continuous (atreal x) <=> + (Cx o f o Re) continuous (at (Cx x) within real)`, + REWRITE_TAC[real_continuous; continuous; REALLIM_COMPLEX; + LIM_ATREAL_ATCOMPLEX; NETLIMIT_ATREAL; GSYM o_ASSOC] THEN + ASM_CASES_TAC `trivial_limit(at(Cx x) within real)` THENL + [ASM_REWRITE_TAC[LIM]; + ASM_SIMP_TAC[NETLIMIT_WITHIN; RE_CX; o_THM]]);; + +let CONTINUOUS_CONTINUOUS_WITHINREAL = prove + (`!f x s. f continuous (atreal x within s) <=> + (f o drop) continuous (at (lift x) within IMAGE lift s)`, + REWRITE_TAC[REALLIM_WITHINREAL_WITHIN; CONTINUOUS_WITHIN; + CONTINUOUS_WITHINREAL; o_DEF; LIFT_DROP; LIM_WITHINREAL_WITHIN]);; + +let CONTINUOUS_CONTINUOUS_ATREAL = prove + (`!f x. f continuous (atreal x) <=> (f o drop) continuous (at (lift x))`, + REWRITE_TAC[REALLIM_ATREAL_AT; CONTINUOUS_AT; + CONTINUOUS_ATREAL; o_DEF; LIFT_DROP; LIM_ATREAL_AT]);; + +let REAL_CONTINUOUS_REAL_CONTINUOUS_WITHINREAL = prove + (`!f x s. f real_continuous (atreal x within s) <=> + (f o drop) real_continuous (at (lift x) within IMAGE lift s)`, + REWRITE_TAC[REALLIM_WITHINREAL_WITHIN; REAL_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHINREAL; o_DEF; LIFT_DROP; + LIM_WITHINREAL_WITHIN]);; + +let REAL_CONTINUOUS_REAL_CONTINUOUS_ATREAL = prove + (`!f x. f real_continuous (atreal x) <=> + (f o drop) real_continuous (at (lift x))`, + REWRITE_TAC[REALLIM_ATREAL_AT; REAL_CONTINUOUS_AT; + REAL_CONTINUOUS_ATREAL; o_DEF; LIFT_DROP; LIM_ATREAL_AT]);; +let HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL = prove + (`!f f' x s. (f has_real_derivative f') (atreal x within s) + ==> f real_continuous (atreal x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN; + REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN + DISCH_THEN(MP_TAC o + MATCH_MP HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN + MESON_TAC[REAL; RE_CX; REAL_CX; IN]);; + +let REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL = prove + (`!f x s. f real_differentiable (atreal x within s) + ==> f real_continuous (atreal x within s)`, + MESON_TAC[HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_WITHINREAL; + real_differentiable]);; + +let HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL = prove + (`!f f' x. (f has_real_derivative f') (atreal x) + ==> f real_continuous (atreal x)`, + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_AT; + REAL_COMPLEX_CONTINUOUS_ATREAL; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_WITHIN]);; + +let REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL = prove + (`!f x. f real_differentiable atreal x ==> f real_continuous atreal x`, + MESON_TAC[HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL; real_differentiable]);; + +let REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON = prove + (`!f s. f real_differentiable_on s ==> f real_continuous_on s`, + REWRITE_TAC[real_differentiable_on; + REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + MESON_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL; + real_differentiable]);; + +let REAL_CONTINUOUS_AT_COMPONENT = prove + (`!i a. 1 <= i /\ i <= dimindex(:N) + ==> (\x:real^N. x$i) real_continuous at a`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; + CONTINUOUS_AT_LIFT_COMPONENT]);; + +let REAL_CONTINUOUS_AT_TRANSLATION = prove + (`!a z f:real^N->real. + f real_continuous at (a + z) <=> (\x. f(a + x)) real_continuous at z`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; CONTINUOUS_AT_TRANSLATION]);; + +add_translation_invariants [REAL_CONTINUOUS_AT_TRANSLATION];; + +let REAL_CONTINUOUS_AT_LINEAR_IMAGE = prove + (`!h:real^N->real^N z f:real^N->real. + linear h /\ (!x. norm(h x) = norm x) + ==> (f real_continuous at (h z) <=> (\x. f(h x)) real_continuous at z)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF; + CONTINUOUS_AT_LINEAR_IMAGE]);; + +add_linear_invariants [REAL_CONTINUOUS_AT_LINEAR_IMAGE];; + +let REAL_CONTINUOUS_AT_ARG = prove + (`!z. ~(real z /\ &0 <= Re z) ==> Arg real_continuous (at z)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS; CONTINUOUS_AT_ARG]);; + +(* ------------------------------------------------------------------------- *) +(* More basics about real derivatives. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_WITHIN_SUBSET = prove + (`!f s t x. (f has_real_derivative f') (atreal x within s) /\ t SUBSET s + ==> (f has_real_derivative f') (atreal x within t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET) THEN ASM SET_TAC[]);; + +let REAL_DIFFERENTIABLE_ON_SUBSET = prove + (`!f s t. f real_differentiable_on s /\ t SUBSET s + ==> f real_differentiable_on t`, + REWRITE_TAC[real_differentiable_on] THEN + MESON_TAC[SUBSET; HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);; + +let REAL_DIFFERENTIABLE_WITHIN_SUBSET = prove + (`!f s t. f real_differentiable (atreal x within s) /\ t SUBSET s + ==> f real_differentiable (atreal x within t)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);; + +let HAS_REAL_DERIVATIVE_ATREAL_WITHIN = prove + (`!f f' x s. (f has_real_derivative f') (atreal x) + ==> (f has_real_derivative f') (atreal x within s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN; + HAS_REAL_COMPLEX_DERIVATIVE_AT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET) THEN ASM SET_TAC[]);; + +let HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN = prove + (`!f f' a s. + a IN s /\ real_open s + ==> ((f has_real_derivative f') (atreal a within s) <=> + (f has_real_derivative f') (atreal a))`, + REPEAT GEN_TAC THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_REAL_DERIVATIVE_ATREAL; + REALLIM_WITHIN_REAL_OPEN]);; + +let REAL_DIFFERENTIABLE_ATREAL_WITHIN = prove + (`!f s z. f real_differentiable (atreal z) + ==> f real_differentiable (atreal z within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN = prove + (`!f f' g x s d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\ + (f has_real_derivative f') (atreal x within s) + ==> (g has_real_derivative f') (atreal x within s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE + [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] + HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[IN_ELIM_THM; REAL_CX; RE_CX] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN AP_TERM_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (NORM_ARITH + `dist(a,b) < d ==> z <= norm(a - b) ==> z < d`)) THEN + W(MP_TAC o PART_MATCH (rand o rand) COMPLEX_NORM_GE_RE_IM o rand o snd) THEN + SIMP_TAC[RE_SUB; RE_CX]);; + +let HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL = prove + (`!f f' g x d. + &0 < d /\ (!x'. abs(x' - x) < d ==> f x' = g x') /\ + (f has_real_derivative f') (atreal x) + ==> (g has_real_derivative f') (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN; IN_UNIV]);; + +let HAS_REAL_DERIVATIVE_ZERO_CONSTANT = prove + (`!f s. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative (&0)) (atreal x within s)) + ==> ?c. !x. x IN s ==> f(x) = c`, + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`Cx o f o Re`; `{z | real z /\ Re z IN s}`] + HAS_COMPLEX_DERIVATIVE_ZERO_CONSTANT) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_REAL; RE_CX; o_THM] THEN + ASM_REWRITE_TAC[GSYM IS_REALINTERVAL_CONVEX_COMPLEX] THEN MESON_TAC[RE_CX]);; + +let HAS_REAL_DERIVATIVE_ZERO_UNIQUE = prove + (`!f s c a. + is_realinterval s /\ a IN s /\ f a = c /\ + (!x. x IN s ==> (f has_real_derivative (&0)) (atreal x within s)) + ==> !x. x IN s ==> f(x) = c`, + MESON_TAC[HAS_REAL_DERIVATIVE_ZERO_CONSTANT]);; + +let REAL_DIFF_CHAIN_WITHIN = prove + (`!f g f' g' x s. + (f has_real_derivative f') (atreal x within s) /\ + (g has_real_derivative g') (atreal (f x) within (IMAGE f s)) + ==> ((g o f) has_real_derivative (g' * f'))(atreal x within s)`, + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `Cx o (g o f) o Re = (Cx o g o Re) o (Cx o f o Re)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_DEF; RE_CX]; ALL_TAC] THEN + REWRITE_TAC[CX_MUL] THEN MATCH_MP_TAC COMPLEX_DIFF_CHAIN_WITHIN THEN + ASM_REWRITE_TAC[o_THM; RE_CX] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_COMPLEX_DERIVATIVE_WITHIN_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; o_THM; REAL_CX; RE_CX] THEN SET_TAC[]);; + +let REAL_DIFF_CHAIN_ATREAL = prove + (`!f g f' g' x. + (f has_real_derivative f') (atreal x) /\ + (g has_real_derivative g') (atreal (f x)) + ==> ((g o f) has_real_derivative (g' * f')) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + ASM_MESON_TAC[REAL_DIFF_CHAIN_WITHIN; SUBSET_UNIV; + HAS_REAL_DERIVATIVE_WITHIN_SUBSET]);; + +let HAS_REAL_DERIVATIVE_CHAIN = prove + (`!P f g. + (!x. P x ==> (g has_real_derivative g'(x)) (atreal x)) + ==> (!x s. (f has_real_derivative f') (atreal x within s) /\ P(f x) + ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) + (atreal x within s)) /\ + (!x. (f has_real_derivative f') (atreal x) /\ P(f x) + ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) + (atreal x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_MESON_TAC[REAL_DIFF_CHAIN_WITHIN; REAL_DIFF_CHAIN_ATREAL; + HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_CHAIN_UNIV = prove + (`!f g. (!x. (g has_real_derivative g'(x)) (atreal x)) + ==> (!x s. (f has_real_derivative f') (atreal x within s) + ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) + (atreal x within s)) /\ + (!x. (f has_real_derivative f') (atreal x) + ==> ((\x. g(f x)) has_real_derivative f' * g'(f x)) + (atreal x))`, + MP_TAC(SPEC `\x:real. T` HAS_REAL_DERIVATIVE_CHAIN) THEN SIMP_TAC[]);; + +let REAL_DERIVATIVE_UNIQUE_ATREAL = prove + (`!f z f' f''. + (f has_real_derivative f') (atreal z) /\ + (f has_real_derivative f'') (atreal z) + ==> f' = f''`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT] THEN + DISCH_THEN(MP_TAC o MATCH_MP FRECHET_DERIVATIVE_UNIQUE_AT) THEN + DISCH_THEN(MP_TAC o C AP_THM `vec 1:real^1`) THEN + REWRITE_TAC[VECTOR_MUL_RCANCEL; VEC_EQ; ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Some handy theorems about the actual differentition function. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_DERIVATIVE = prove + (`!f f' x. (f has_real_derivative f') (atreal x) + ==> real_derivative f x = f'`, + REWRITE_TAC[real_derivative] THEN + MESON_TAC[REAL_DERIVATIVE_UNIQUE_ATREAL]);; + +let HAS_REAL_DERIVATIVE_DIFFERENTIABLE = prove + (`!f x. (f has_real_derivative (real_derivative f x)) (atreal x) <=> + f real_differentiable atreal x`, + REWRITE_TAC[real_differentiable; real_derivative] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetical combining theorems. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_LMUL_WITHIN = prove + (`!f f' c x s. + (f has_real_derivative f') (atreal x within s) + ==> ((\x. c * f(x)) has_real_derivative (c * f')) (atreal x within s)`, + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + REWRITE_TAC[o_DEF; CX_MUL; HAS_COMPLEX_DERIVATIVE_LMUL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_LMUL_ATREAL = prove + (`!f f' c x. + (f has_real_derivative f') (atreal x) + ==> ((\x. c * f(x)) has_real_derivative (c * f')) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_RMUL_WITHIN = prove + (`!f f' c x s. + (f has_real_derivative f') (atreal x within s) + ==> ((\x. f(x) * c) has_real_derivative (f' * c)) (atreal x within s)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_RMUL_ATREAL = prove + (`!f f' c x. + (f has_real_derivative f') (atreal x) + ==> ((\x. f(x) * c) has_real_derivative (f' * c)) (atreal x)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_LMUL_ATREAL]);; + +let HAS_REAL_DERIVATIVE_CDIV_WITHIN = prove + (`!f f' c x s. + (f has_real_derivative f') (atreal x within s) + ==> ((\x. f(x) / c) has_real_derivative (f' / c)) (atreal x within s)`, + SIMP_TAC[real_div; HAS_REAL_DERIVATIVE_RMUL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_CDIV_ATREAL = prove + (`!f f' c x. + (f has_real_derivative f') (atreal x) + ==> ((\x. f(x) / c) has_real_derivative (f' / c)) (atreal x)`, + SIMP_TAC[real_div; HAS_REAL_DERIVATIVE_RMUL_ATREAL]);; + +let HAS_REAL_DERIVATIVE_ID = prove + (`!net. ((\x. x) has_real_derivative &1) net`, + REWRITE_TAC[has_real_derivative; TENDSTO_REAL; + REAL_ARITH `x - (a + &1 * (x - a)) = &0`] THEN + REWRITE_TAC[REAL_MUL_RZERO; LIM_CONST; o_DEF]);; + +let HAS_REAL_DERIVATIVE_CONST = prove + (`!c net. ((\x. c) has_real_derivative &0) net`, + REWRITE_TAC[has_real_derivative; REAL_MUL_LZERO; REAL_ADD_RID; REAL_SUB_REFL; + REAL_MUL_RZERO; REALLIM_CONST]);; + +let HAS_REAL_DERIVATIVE_NEG = prove + (`!f f' net. (f has_real_derivative f') net + ==> ((\x. --(f(x))) has_real_derivative (--f')) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_NEG) THEN + REWRITE_TAC[REAL_NEG_0; REAL_ARITH + `a * (--b - (--c + --d * e:real)) = --(a * (b - (c + d * e)))`]);; + +let HAS_REAL_DERIVATIVE_ADD = prove + (`!f f' g g' net. + (f has_real_derivative f') net /\ (g has_real_derivative g') net + ==> ((\x. f(x) + g(x)) has_real_derivative (f' + g')) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_derivative] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_ADD) THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH + `(fx - (fa + f' * (x - a))) + (gx - (ga + g' * (x - a))):real = + (fx + gx) - ((fa + ga) + (f' + g') * (x - a))`]);; + +let HAS_REAL_DERIVATIVE_SUB = prove + (`!f f' g g' net. + (f has_real_derivative f') net /\ (g has_real_derivative g') net + ==> ((\x. f(x) - g(x)) has_real_derivative (f' - g')) net`, + SIMP_TAC[real_sub; HAS_REAL_DERIVATIVE_ADD; HAS_REAL_DERIVATIVE_NEG]);; + +let HAS_REAL_DERIVATIVE_MUL_WITHIN = prove + (`!f f' g g' x s. + (f has_real_derivative f') (atreal x within s) /\ + (g has_real_derivative g') (atreal x within s) + ==> ((\x. f(x) * g(x)) has_real_derivative + (f(x) * g' + f' * g(x))) (atreal x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_COMPLEX_DERIVATIVE_MUL_WITHIN) THEN + REWRITE_TAC[o_DEF; CX_MUL; CX_ADD; RE_CX]);; + +let HAS_REAL_DERIVATIVE_MUL_ATREAL = prove + (`!f f' g g' x. + (f has_real_derivative f') (atreal x) /\ + (g has_real_derivative g') (atreal x) + ==> ((\x. f(x) * g(x)) has_real_derivative + (f(x) * g' + f' * g(x))) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN]);; + +let HAS_REAL_DERIVATIVE_POW_WITHIN = prove + (`!f f' x s n. (f has_real_derivative f') (atreal x within s) + ==> ((\x. f(x) pow n) has_real_derivative + (&n * f(x) pow (n - 1) * f')) (atreal x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o + MATCH_MP HAS_COMPLEX_DERIVATIVE_POW_WITHIN) THEN + REWRITE_TAC[o_DEF; CX_MUL; CX_POW; RE_CX]);; + +let HAS_REAL_DERIVATIVE_POW_ATREAL = prove + (`!f f' x n. (f has_real_derivative f') (atreal x) + ==> ((\x. f(x) pow n) has_real_derivative + (&n * f(x) pow (n - 1) * f')) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_POW_WITHIN]);; + +let HAS_REAL_DERIVATIVE_INV_BASIC = prove + (`!x. ~(x = &0) + ==> ((inv) has_real_derivative (--inv(x pow 2))) (atreal x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[HAS_REAL_COMPLEX_DERIVATIVE_AT] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_WITHIN THEN + EXISTS_TAC `inv:complex->complex` THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_INV_BASIC; CX_INJ; CX_NEG; CX_INV; + CX_POW; HAS_COMPLEX_DERIVATIVE_AT_WITHIN] THEN + SIMP_TAC[IN; FORALL_REAL; IMP_CONJ; o_DEF; REAL_CX; RE_CX; CX_INV] THEN + MESON_TAC[REAL_LT_01]);; + +let HAS_REAL_DERIVATIVE_INV_WITHIN = prove + (`!f f' x s. (f has_real_derivative f') (atreal x within s) /\ + ~(f x = &0) + ==> ((\x. inv(f(x))) has_real_derivative (--f' / f(x) pow 2)) + (atreal x within s)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(g = &0) ==> --f / g pow 2 = --inv(g pow 2) * f`] THEN + MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_INV_BASIC]);; + +let HAS_REAL_DERIVATIVE_INV_ATREAL = prove + (`!f f' x. (f has_real_derivative f') (atreal x) /\ + ~(f x = &0) + ==> ((\x. inv(f(x))) has_real_derivative (--f' / f(x) pow 2)) + (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_INV_WITHIN]);; + +let HAS_REAL_DERIVATIVE_DIV_WITHIN = prove + (`!f f' g g' x s. + (f has_real_derivative f') (atreal x within s) /\ + (g has_real_derivative g') (atreal x within s) /\ + ~(g(x) = &0) + ==> ((\x. f(x) / g(x)) has_real_derivative + (f' * g(x) - f(x) * g') / g(x) pow 2) (atreal x within s)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT2 th) THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_INV_WITHIN) THEN + UNDISCH_TAC `(f has_real_derivative f') (atreal x within s)` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_MUL_WITHIN) THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +let HAS_REAL_DERIVATIVE_DIV_ATREAL = prove + (`!f f' g g' x. + (f has_real_derivative f') (atreal x) /\ + (g has_real_derivative g') (atreal x) /\ + ~(g(x) = &0) + ==> ((\x. f(x) / g(x)) has_real_derivative + (f' * g(x) - f(x) * g') / g(x) pow 2) (atreal x)`, + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_DIV_WITHIN]);; + +let HAS_REAL_DERIVATIVE_SUM = prove + (`!f net s. + FINITE s /\ (!a. a IN s ==> (f a has_real_derivative f' a) net) + ==> ((\x. sum s (\a. f a x)) has_real_derivative (sum s f')) + net`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; SUM_CLAUSES] THEN + SIMP_TAC[HAS_REAL_DERIVATIVE_CONST; HAS_REAL_DERIVATIVE_ADD; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing just for real differentiability. *) +(* ------------------------------------------------------------------------- *) + +let REAL_DIFFERENTIABLE_CONST = prove + (`!c net. (\z. c) real_differentiable net`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_CONST]);; + +let REAL_DIFFERENTIABLE_ID = prove + (`!net. (\z. z) real_differentiable net`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_ID]);; + +let REAL_DIFFERENTIABLE_NEG = prove + (`!f net. + f real_differentiable net + ==> (\z. --(f z)) real_differentiable net`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_NEG]);; + +let REAL_DIFFERENTIABLE_ADD = prove + (`!f g net. + f real_differentiable net /\ + g real_differentiable net + ==> (\z. f z + g z) real_differentiable net`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_ADD]);; + +let REAL_DIFFERENTIABLE_SUB = prove + (`!f g net. + f real_differentiable net /\ + g real_differentiable net + ==> (\z. f z - g z) real_differentiable net`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_SUB]);; + +let REAL_DIFFERENTIABLE_INV_WITHIN = prove + (`!f z s. + f real_differentiable (atreal z within s) /\ ~(f z = &0) + ==> (\z. inv(f z)) real_differentiable (atreal z within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_INV_WITHIN]);; + +let REAL_DIFFERENTIABLE_MUL_WITHIN = prove + (`!f g z s. + f real_differentiable (atreal z within s) /\ + g real_differentiable (atreal z within s) + ==> (\z. f z * g z) real_differentiable (atreal z within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN]);; + +let REAL_DIFFERENTIABLE_DIV_WITHIN = prove + (`!f g z s. + f real_differentiable (atreal z within s) /\ + g real_differentiable (atreal z within s) /\ + ~(g z = &0) + ==> (\z. f z / g z) real_differentiable (atreal z within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_DIV_WITHIN]);; + +let REAL_DIFFERENTIABLE_POW_WITHIN = prove + (`!f n z s. + f real_differentiable (atreal z within s) + ==> (\z. f z pow n) real_differentiable (atreal z within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_POW_WITHIN]);; + +let REAL_DIFFERENTIABLE_TRANSFORM_WITHIN = prove + (`!f g x s d. + &0 < d /\ + x IN s /\ + (!x'. x' IN s /\ abs(x' - x) < d ==> f x' = g x') /\ + f real_differentiable (atreal x within s) + ==> g real_differentiable (atreal x within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_WITHIN]);; + +let REAL_DIFFERENTIABLE_TRANSFORM = prove + (`!f g s. (!x. x IN s ==> f x = g x) /\ f real_differentiable_on s + ==> g real_differentiable_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[real_differentiable_on; GSYM real_differentiable] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`f:real->real`; `&1`] THEN + ASM_SIMP_TAC[REAL_LT_01]);; + +let REAL_DIFFERENTIABLE_EQ = prove + (`!f g s. (!x. x IN s ==> f x = g x) + ==> (f real_differentiable_on s <=> g real_differentiable_on s)`, + MESON_TAC[REAL_DIFFERENTIABLE_TRANSFORM]);; + +let REAL_DIFFERENTIABLE_INV_ATREAL = prove + (`!f z. + f real_differentiable atreal z /\ ~(f z = &0) + ==> (\z. inv(f z)) real_differentiable atreal z`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_INV_ATREAL]);; + +let REAL_DIFFERENTIABLE_MUL_ATREAL = prove + (`!f g z. + f real_differentiable atreal z /\ + g real_differentiable atreal z + ==> (\z. f z * g z) real_differentiable atreal z`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_MUL_ATREAL]);; + +let REAL_DIFFERENTIABLE_DIV_ATREAL = prove + (`!f g z. + f real_differentiable atreal z /\ + g real_differentiable atreal z /\ + ~(g z = &0) + ==> (\z. f z / g z) real_differentiable atreal z`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_DIV_ATREAL]);; + +let REAL_DIFFERENTIABLE_POW_ATREAL = prove + (`!f n z. + f real_differentiable atreal z + ==> (\z. f z pow n) real_differentiable atreal z`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_POW_ATREAL]);; + +let REAL_DIFFERENTIABLE_TRANSFORM_ATREAL = prove + (`!f g x d. + &0 < d /\ + (!x'. abs(x' - x) < d ==> f x' = g x') /\ + f real_differentiable atreal x + ==> g real_differentiable atreal x`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL]);; + +let REAL_DIFFERENTIABLE_COMPOSE_WITHIN = prove + (`!f g x s. + f real_differentiable (atreal x within s) /\ + g real_differentiable (atreal (f x) within IMAGE f s) + ==> (g o f) real_differentiable (atreal x within s)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[REAL_DIFF_CHAIN_WITHIN]);; + +let REAL_DIFFERENTIABLE_COMPOSE_ATREAL = prove + (`!f g x. + f real_differentiable (atreal x) /\ + g real_differentiable (atreal (f x)) + ==> (g o f) real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[REAL_DIFF_CHAIN_ATREAL]);; + +(* ------------------------------------------------------------------------- *) +(* Same again for being differentiable on a set. *) +(* ------------------------------------------------------------------------- *) + +let REAL_DIFFERENTIABLE_ON_CONST = prove + (`!c s. (\z. c) real_differentiable_on s`, + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_CONST]);; + +let REAL_DIFFERENTIABLE_ON_ID = prove + (`!s. (\z. z) real_differentiable_on s`, + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_ID]);; + +let REAL_DIFFERENTIABLE_ON_COMPOSE = prove + (`!f g s. f real_differentiable_on s /\ g real_differentiable_on (IMAGE f s) + ==> (g o f) real_differentiable_on s`, + SIMP_TAC[real_differentiable_on; GSYM real_differentiable; + FORALL_IN_IMAGE] THEN + MESON_TAC[REAL_DIFFERENTIABLE_COMPOSE_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_NEG = prove + (`!f s. f real_differentiable_on s ==> (\z. --(f z)) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_NEG]);; + +let REAL_DIFFERENTIABLE_ON_ADD = prove + (`!f g s. + f real_differentiable_on s /\ g real_differentiable_on s + ==> (\z. f z + g z) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_ADD]);; + +let REAL_DIFFERENTIABLE_ON_SUB = prove + (`!f g s. + f real_differentiable_on s /\ g real_differentiable_on s + ==> (\z. f z - g z) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; REAL_DIFFERENTIABLE_SUB]);; + +let REAL_DIFFERENTIABLE_ON_MUL = prove + (`!f g s. + f real_differentiable_on s /\ g real_differentiable_on s + ==> (\z. f z * g z) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_MUL_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_INV = prove + (`!f s. f real_differentiable_on s /\ (!z. z IN s ==> ~(f z = &0)) + ==> (\z. inv(f z)) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_INV_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_DIV = prove + (`!f g s. + f real_differentiable_on s /\ g real_differentiable_on s /\ + (!z. z IN s ==> ~(g z = &0)) + ==> (\z. f z / g z) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_DIV_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_POW = prove + (`!f s n. f real_differentiable_on s + ==> (\z. (f z) pow n) real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_POW_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_SUM = prove + (`!f s k. FINITE k /\ (!a. a IN k ==> (f a) real_differentiable_on s) + ==> (\x. sum k (\a. f a x)) real_differentiable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[SUM_CLAUSES] THEN + SIMP_TAC[REAL_DIFFERENTIABLE_ON_CONST; IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_ADD THEN + ASM_SIMP_TAC[ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Derivative (and continuity) theorems for real transcendental functions. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_EXP = prove + (`!x. (exp has_real_derivative exp(x)) (atreal x)`, + GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN + EXISTS_TAC `cexp` THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; + HAS_COMPLEX_DERIVATIVE_CEXP; CX_EXP]);; + +let REAL_DIFFERENTIABLE_AT_EXP = prove + (`!x. exp real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_EXP]);; + +let REAL_DIFFERENTIABLE_WITHIN_EXP = prove + (`!s x. exp real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_EXP]);; + +let REAL_CONTINUOUS_AT_EXP = prove + (`!x. exp real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_EXP; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_EXP = prove + (`!s x. exp real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_EXP]);; + +let REAL_CONTINUOUS_ON_EXP = prove + (`!s. exp real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_EXP]);; + +let HAS_REAL_DERIVATIVE_SIN = prove + (`!x. (sin has_real_derivative cos(x)) (atreal x)`, + GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN + EXISTS_TAC `csin` THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; + HAS_COMPLEX_DERIVATIVE_CSIN; CX_SIN; CX_COS]);; + +let REAL_DIFFERENTIABLE_AT_SIN = prove + (`!x. sin real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_SIN]);; + +let REAL_DIFFERENTIABLE_WITHIN_SIN = prove + (`!s x. sin real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_SIN]);; + +let REAL_CONTINUOUS_AT_SIN = prove + (`!x. sin real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_SIN; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_SIN = prove + (`!s x. sin real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_SIN]);; + +let REAL_CONTINUOUS_ON_SIN = prove + (`!s. sin real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_SIN]);; + +let HAS_REAL_DERIVATIVE_COS = prove + (`!x. (cos has_real_derivative --sin(x)) (atreal x)`, + GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN + EXISTS_TAC `ccos` THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; + HAS_COMPLEX_DERIVATIVE_CCOS; CX_SIN; CX_COS; CX_NEG]);; + +let REAL_DIFFERENTIABLE_AT_COS = prove + (`!x. cos real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_COS]);; + +let REAL_DIFFERENTIABLE_WITHIN_COS = prove + (`!s x. cos real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_COS]);; + +let REAL_CONTINUOUS_AT_COS = prove + (`!x. cos real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_COS; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_COS = prove + (`!s x. cos real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_COS]);; + +let REAL_CONTINUOUS_ON_COS = prove + (`!s. cos real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_COS]);; + +let HAS_REAL_DERIVATIVE_TAN = prove + (`!x. ~(cos x = &0) + ==> (tan has_real_derivative inv(cos(x) pow 2)) (atreal x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN + EXISTS_TAC `ctan` THEN REWRITE_TAC[CX_INV; CX_POW; CX_COS] THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; + HAS_COMPLEX_DERIVATIVE_CTAN; GSYM CX_COS; CX_INJ; CX_TAN]);; + +let REAL_DIFFERENTIABLE_AT_TAN = prove + (`!x. ~(cos x = &0) ==> tan real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_TAN]);; + +let REAL_DIFFERENTIABLE_WITHIN_TAN = prove + (`!s x. ~(cos x = &0) ==> tan real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_TAN]);; + +let REAL_CONTINUOUS_AT_TAN = prove + (`!x. ~(cos x = &0) ==> tan real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_TAN; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_TAN = prove + (`!s x. ~(cos x = &0) ==> tan real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_TAN]);; + +let REAL_CONTINUOUS_ON_TAN = prove + (`!s. (!x. x IN s ==> ~(cos x = &0)) ==> tan real_continuous_on s`, + MESON_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_TAN]);; + +let HAS_REAL_DERIVATIVE_LOG = prove + (`!x. &0 < x ==> (log has_real_derivative inv(x)) (atreal x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN + MAP_EVERY EXISTS_TAC [`clog`; `x:real`] THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[CX_INV] THEN MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CLOG THEN ASM_REWRITE_TAC[RE_CX]; + MATCH_MP_TAC(GSYM CX_LOG) THEN ASM_REAL_ARITH_TAC]);; + +let REAL_DIFFERENTIABLE_AT_LOG = prove + (`!x. &0 < x ==> log real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_LOG]);; + +let REAL_DIFFERENTIABLE_WITHIN_LOG = prove + (`!s x. &0 < x ==> log real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_LOG]);; + +let REAL_CONTINUOUS_AT_LOG = prove + (`!x. &0 < x ==> log real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_LOG; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_LOG = prove + (`!s x. &0 < x ==> log real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_LOG]);; + +let REAL_CONTINUOUS_ON_LOG = prove + (`!s. (!x. x IN s ==> &0 < x) ==> log real_continuous_on s`, + MESON_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_LOG]);; + +let HAS_REAL_DERIVATIVE_SQRT = prove + (`!x. &0 < x ==> (sqrt has_real_derivative inv(&2 * sqrt x)) (atreal x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN + MAP_EVERY EXISTS_TAC [`csqrt`; `x:real`] THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[CX_INV; CX_MUL; CX_SQRT; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CSQRT THEN + ASM_SIMP_TAC[RE_CX]; + MATCH_MP_TAC(GSYM CX_SQRT) THEN ASM_REAL_ARITH_TAC]);; + +let REAL_DIFFERENTIABLE_AT_SQRT = prove + (`!x. &0 < x ==> sqrt real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_SQRT]);; + +let REAL_DIFFERENTIABLE_WITHIN_SQRT = prove + (`!s x. &0 < x ==> sqrt real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_SQRT]);; + +let REAL_CONTINUOUS_AT_SQRT = prove + (`!x. &0 < x ==> sqrt real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_SQRT; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_SQRT = prove + (`!s x. &0 < x ==> sqrt real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_SQRT]);; + +let REAL_CONTINUOUS_WITHIN_SQRT_COMPOSE = prove + (`!f s a:real^N. + f real_continuous (at a within s) /\ + (&0 < f a \/ !x. x IN s ==> &0 <= f x) + ==> (\x. sqrt(f x)) real_continuous (at a within s)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN + REWRITE_TAC[CONTINUOUS_WITHIN_SQRT_COMPOSE]);; + +let REAL_CONTINUOUS_AT_SQRT_COMPOSE = prove + (`!f a:real^N. + f real_continuous (at a) /\ + (&0 < f a \/ !x. &0 <= f x) + ==> (\x. sqrt(f x)) real_continuous (at a)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN + REWRITE_TAC[CONTINUOUS_AT_SQRT_COMPOSE]);; + +let CONTINUOUS_WITHINREAL_SQRT_COMPOSE = prove + (`!f s a. (\x. lift(f x)) continuous (atreal a within s) /\ + (&0 < f a \/ !x. x IN s ==> &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous (atreal a within s)`, + REWRITE_TAC[CONTINUOUS_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[o_DEF] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC CONTINUOUS_WITHIN_SQRT_COMPOSE THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP]);; + +let CONTINUOUS_ATREAL_SQRT_COMPOSE = prove + (`!f a. (\x. lift(f x)) continuous (atreal a) /\ (&0 < f a \/ !x. &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous (atreal a)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `(:real)`; `a:real`] + CONTINUOUS_WITHINREAL_SQRT_COMPOSE) THEN + REWRITE_TAC[WITHINREAL_UNIV; IN_UNIV]);; + +let REAL_CONTINUOUS_WITHINREAL_SQRT_COMPOSE = prove + (`!f s a. f real_continuous (atreal a within s) /\ + (&0 < f a \/ !x. x IN s ==> &0 <= f x) + ==> (\x. sqrt(f x)) real_continuous (atreal a within s)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN + REWRITE_TAC[CONTINUOUS_WITHINREAL_SQRT_COMPOSE]);; + +let REAL_CONTINUOUS_ATREAL_SQRT_COMPOSE = prove + (`!f a. f real_continuous (atreal a) /\ + (&0 < f a \/ !x. &0 <= f x) + ==> (\x. sqrt(f x)) real_continuous (atreal a)`, + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; o_DEF] THEN + REWRITE_TAC[CONTINUOUS_ATREAL_SQRT_COMPOSE]);; + +let HAS_REAL_DERIVATIVE_ATN = prove + (`!x. (atn has_real_derivative inv(&1 + x pow 2)) (atreal x)`, + GEN_TAC THEN MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT THEN + EXISTS_TAC `catn` THEN REWRITE_TAC[CX_INV; CX_ADD; CX_ATN; CX_POW] THEN + ASM_SIMP_TAC[HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CATN; + IM_CX; REAL_ABS_NUM; REAL_LT_01]);; + +let REAL_DIFFERENTIABLE_AT_ATN = prove + (`!x. atn real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_ATN]);; + +let REAL_DIFFERENTIABLE_WITHIN_ATN = prove + (`!s x. atn real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_ATN]);; + +let REAL_CONTINUOUS_AT_ATN = prove + (`!x. atn real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_ATN; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_ATN = prove + (`!s x. atn real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_ATN]);; + +let REAL_CONTINUOUS_ON_ATN = prove + (`!s. atn real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_WITHIN_ATN]);; + +let HAS_REAL_DERIVATIVE_ASN_COS = prove + (`!x. abs(x) < &1 ==> (asn has_real_derivative inv(cos(asn x))) (atreal x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN + MAP_EVERY EXISTS_TAC [`casn`; `&1 - abs x`] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[CX_INV; CX_COS; CX_ASN; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CASN THEN ASM_REWRITE_TAC[RE_CX]; + MATCH_MP_TAC(GSYM CX_ASN) THEN ASM_REAL_ARITH_TAC]);; + +let HAS_REAL_DERIVATIVE_ASN = prove + (`!x. abs(x) < &1 + ==> (asn has_real_derivative inv(sqrt(&1 - x pow 2))) (atreal x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_ASN_COS) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC COS_ASN THEN ASM_REAL_ARITH_TAC);; + +let REAL_DIFFERENTIABLE_AT_ASN = prove + (`!x. abs(x) < &1 ==> asn real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_ASN]);; + +let REAL_DIFFERENTIABLE_WITHIN_ASN = prove + (`!s x. abs(x) < &1 ==> asn real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_ASN]);; + +let REAL_CONTINUOUS_AT_ASN = prove + (`!x. abs(x) < &1 ==> asn real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_ASN; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_ASN = prove + (`!s x. abs(x) < &1 ==> asn real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_ASN]);; + +let HAS_REAL_DERIVATIVE_ACS_SIN = prove + (`!x. abs(x) < &1 ==> (acs has_real_derivative --inv(sin(acs x))) (atreal x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_REAL_DERIVATIVE_AT_GEN THEN + MAP_EVERY EXISTS_TAC [`cacs`; `&1 - abs x`] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[CX_INV; CX_SIN; CX_ACS; CX_NEG; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CACS THEN ASM_REWRITE_TAC[RE_CX]; + MATCH_MP_TAC(GSYM CX_ACS) THEN ASM_REAL_ARITH_TAC]);; + +let HAS_REAL_DERIVATIVE_ACS = prove + (`!x. abs(x) < &1 + ==> (acs has_real_derivative --inv(sqrt(&1 - x pow 2))) (atreal x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_ACS_SIN) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC SIN_ACS THEN ASM_REAL_ARITH_TAC);; + +let REAL_DIFFERENTIABLE_AT_ACS = prove + (`!x. abs(x) < &1 ==> acs real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_ACS]);; + +let REAL_DIFFERENTIABLE_WITHIN_ACS = prove + (`!s x. abs(x) < &1 ==> acs real_differentiable (atreal x within s)`, + MESON_TAC[REAL_DIFFERENTIABLE_ATREAL_WITHIN; + REAL_DIFFERENTIABLE_AT_ACS]);; + +let REAL_CONTINUOUS_AT_ACS = prove + (`!x. abs(x) < &1 ==> acs real_continuous (atreal x)`, + MESON_TAC[HAS_REAL_DERIVATIVE_ACS; + HAS_REAL_DERIVATIVE_IMP_CONTINUOUS_ATREAL]);; + +let REAL_CONTINUOUS_WITHIN_ACS = prove + (`!s x. abs(x) < &1 ==> acs real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_ACS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence differentiation of the norm. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_NORM_AT = prove + (`!a:real^N. ~(a = vec 0) ==> (\x. lift(norm x)) differentiable (at a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vector_norm] THEN + SUBGOAL_THEN + `(\x:real^N. lift(sqrt(x dot x))) = + (lift o sqrt o drop) o (\x. lift(x dot x))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN + REWRITE_TAC[DIFFERENTIABLE_SQNORM_AT; GSYM NORM_POW_2] THEN + MP_TAC(ISPEC `norm(a:real^N) pow 2` REAL_DIFFERENTIABLE_AT_SQRT) THEN + ASM_SIMP_TAC[REAL_POW_LT; NORM_POS_LT; REAL_DIFFERENTIABLE_AT]);; + +let DIFFERENTIABLE_ON_NORM = prove + (`!s:real^N->bool. ~(vec 0 IN s) ==> (\x. lift(norm x)) differentiable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_NORM_AT THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some somewhat sharper continuity theorems including endpoints. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_WITHIN_SQRT_STRONG = prove + (`!x. sqrt real_continuous (atreal x within {t | &0 <= t})`, + GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN + ASM_CASES_TAC `x IN {t | &0 <= t}` THENL + [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`csqrt`; `&1`] THEN + REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; REAL_LT_01; + CONTINUOUS_WITHIN_CSQRT_POSREAL; + SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN + SIMP_TAC[CX_SQRT]; + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL + [SUBGOAL_THEN `real INTER IMAGE Cx {t | &0 <= t} = + real INTER {t | Re t >= &0}` + (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; + CLOSED_HALFSPACE_RE_GE]) THEN + REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN + REWRITE_TAC[real_ge; IN; CONJ_ACI]; + MATCH_MP_TAC(SET_RULE + `(!x y. f x = f y ==> x = y) /\ ~(x IN s) + ==> ~(f x IN t INTER IMAGE f s)`) THEN + ASM_REWRITE_TAC[CX_INJ]]]);; + +let REAL_CONTINUOUS_ON_SQRT = prove + (`!s. (!x. x IN s ==> &0 <= x) ==> sqrt real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN + EXISTS_TAC `{x | &0 <= x}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_SQRT_STRONG]);; + +let REAL_CONTINUOUS_WITHIN_ASN_STRONG = prove + (`!x. asn real_continuous (atreal x within {t | abs(t) <= &1})`, + GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN + ASM_CASES_TAC `x IN {t | abs(t) <= &1}` THENL + [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`casn`; `&1`] THEN + REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; CONTINUOUS_WITHIN_CASN_REAL; REAL_LT_01; + SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN + SIMP_TAC[CX_ASN]; + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL + [SUBGOAL_THEN `real INTER IMAGE Cx {t | abs t <= &1} = + real INTER cball(Cx(&0),&1)` + (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_CBALL]) THEN + REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; IN] THEN + MESON_TAC[REAL_NORM]; + MATCH_MP_TAC(SET_RULE + `(!x y. f x = f y ==> x = y) /\ ~(x IN s) + ==> ~(f x IN t INTER IMAGE f s)`) THEN + ASM_REWRITE_TAC[CX_INJ]]]);; + +let REAL_CONTINUOUS_ON_ASN = prove + (`!s. (!x. x IN s ==> abs(x) <= &1) ==> asn real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN + EXISTS_TAC `{x | abs(x) <= &1}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_ASN_STRONG]);; + +let REAL_CONTINUOUS_WITHIN_ACS_STRONG = prove + (`!x. acs real_continuous (atreal x within {t | abs(t) <= &1})`, + GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_CONTINUOUS_WITHINREAL] THEN + ASM_CASES_TAC `x IN {t | abs(t) <= &1}` THENL + [MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`cacs`; `&1`] THEN + REWRITE_TAC[IMAGE_CX; IN_ELIM_THM; CONTINUOUS_WITHIN_CACS_REAL; REAL_LT_01; + SET_RULE `real INTER {z | real z /\ P z} = {z | real z /\ P z}`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[REAL_CX; RE_CX; IMP_CONJ; FORALL_REAL; o_THM] THEN + SIMP_TAC[CX_ACS]; + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN CONJ_TAC THENL + [SUBGOAL_THEN `real INTER IMAGE Cx {t | abs t <= &1} = + real INTER cball(Cx(&0),&1)` + (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_REAL; CLOSED_CBALL]) THEN + REWRITE_TAC[EXTENSION; IMAGE_CX; IN_ELIM_THM; IN_CBALL; IN_INTER] THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; IN] THEN + MESON_TAC[REAL_NORM]; + MATCH_MP_TAC(SET_RULE + `(!x y. f x = f y ==> x = y) /\ ~(x IN s) + ==> ~(f x IN t INTER IMAGE f s)`) THEN + ASM_REWRITE_TAC[CX_INJ]]]);; + +let REAL_CONTINUOUS_ON_ACS = prove + (`!s. (!x. x IN s ==> abs(x) <= &1) ==> acs real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN + EXISTS_TAC `{x | abs(x) <= &1}` THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM; REAL_CONTINUOUS_WITHIN_ACS_STRONG]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiation conversion. *) +(* ------------------------------------------------------------------------- *) + +let real_differentiation_theorems = ref [];; + +let add_real_differentiation_theorems = + let ETA_THM = prove + (`(f has_real_derivative f') net <=> + ((\x. f x) has_real_derivative f') net`, + REWRITE_TAC[ETA_AX]) in + let ETA_TWEAK = + PURE_REWRITE_RULE [IMP_CONJ] o + GEN_REWRITE_RULE (LAND_CONV o ONCE_DEPTH_CONV) [ETA_THM] o + SPEC_ALL in + fun l -> real_differentiation_theorems := + !real_differentiation_theorems @ map ETA_TWEAK l;; + +add_real_differentiation_theorems + ([HAS_REAL_DERIVATIVE_LMUL_WITHIN; HAS_REAL_DERIVATIVE_LMUL_ATREAL; + HAS_REAL_DERIVATIVE_RMUL_WITHIN; HAS_REAL_DERIVATIVE_RMUL_ATREAL; + HAS_REAL_DERIVATIVE_CDIV_WITHIN; HAS_REAL_DERIVATIVE_CDIV_ATREAL; + HAS_REAL_DERIVATIVE_ID; + HAS_REAL_DERIVATIVE_CONST; + HAS_REAL_DERIVATIVE_NEG; + HAS_REAL_DERIVATIVE_ADD; + HAS_REAL_DERIVATIVE_SUB; + HAS_REAL_DERIVATIVE_MUL_WITHIN; HAS_REAL_DERIVATIVE_MUL_ATREAL; + HAS_REAL_DERIVATIVE_DIV_WITHIN; HAS_REAL_DERIVATIVE_DIV_ATREAL; + HAS_REAL_DERIVATIVE_POW_WITHIN; HAS_REAL_DERIVATIVE_POW_ATREAL; + HAS_REAL_DERIVATIVE_INV_WITHIN; HAS_REAL_DERIVATIVE_INV_ATREAL] @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV + HAS_REAL_DERIVATIVE_EXP))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV + HAS_REAL_DERIVATIVE_SIN))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV + HAS_REAL_DERIVATIVE_COS))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + HAS_REAL_DERIVATIVE_TAN))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + HAS_REAL_DERIVATIVE_LOG))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + HAS_REAL_DERIVATIVE_SQRT))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV + HAS_REAL_DERIVATIVE_ATN))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + HAS_REAL_DERIVATIVE_ASN))) @ + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + HAS_REAL_DERIVATIVE_ACS))));; + +let rec REAL_DIFF_CONV = + let partfn tm = let l,r = dest_comb tm in mk_pair(lhand l,r) + and is_deriv = can (term_match [] `(f has_real_derivative f') net`) in + let rec REAL_DIFF_CONV tm = + try tryfind (fun th -> PART_MATCH partfn th (partfn tm)) + (!real_differentiation_theorems) + with Failure _ -> + let ith = tryfind (fun th -> + PART_MATCH (partfn o repeat (snd o dest_imp)) th (partfn tm)) + (!real_differentiation_theorems) in + REAL_DIFF_ELIM ith + and REAL_DIFF_ELIM th = + let tm = concl th in + if not(is_imp tm) then th else + let t = lhand tm in + if not(is_deriv t) then UNDISCH th + else REAL_DIFF_ELIM (MATCH_MP th (REAL_DIFF_CONV t)) in + REAL_DIFF_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Hence a tactic. *) +(* ------------------------------------------------------------------------- *) + +let REAL_DIFF_TAC = + let pth = MESON[] + `(f has_real_derivative f') net + ==> f' = g' + ==> (f has_real_derivative g') net` in + W(fun (asl,w) -> let th = MATCH_MP pth (REAL_DIFF_CONV w) in + MATCH_MP_TAC(repeat (GEN_REWRITE_RULE I [IMP_IMP]) (DISCH_ALL th)));; + +let REAL_DIFFERENTIABLE_TAC = + let DISCH_FIRST th = DISCH (hd(hyp th)) th in + GEN_REWRITE_TAC I [real_differentiable] THEN + W(fun (asl,w) -> + let th = REAL_DIFF_CONV(snd(dest_exists w)) in + let f' = rand(rator(concl th)) in + EXISTS_TAC f' THEN + (if hyp th = [] then MATCH_ACCEPT_TAC th else + let th' = repeat (GEN_REWRITE_RULE I [IMP_IMP] o DISCH_FIRST) + (DISCH_FIRST th) in + MATCH_MP_TAC th'));; + +(* ------------------------------------------------------------------------- *) +(* Analytic results for real power function. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_RPOW = prove + (`!x y. + &0 < x + ==> ((\x. x rpow y) has_real_derivative y * x rpow (y - &1)) (atreal x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN + EXISTS_TAC `\x. exp(y * log x)` THEN EXISTS_TAC `x:real` THEN + ASM_SIMP_TAC[rpow; REAL_ARITH + `&0 < x ==> (abs(y - x) < x <=> &0 < y /\ y < &2 * x)`] THEN + REAL_DIFF_TAC THEN + ASM_SIMP_TAC[REAL_SUB_RDISTRIB; REAL_EXP_SUB; REAL_MUL_LID; EXP_LOG] THEN + REAL_ARITH_TAC);; + +add_real_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (GEN `y:real` (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + (SPEC `y:real` + (ONCE_REWRITE_RULE[SWAP_FORALL_THM] HAS_REAL_DERIVATIVE_RPOW))))));; + +let HAS_REAL_DERIVATIVE_RPOW_RIGHT = prove + (`!a x. &0 < a + ==> ((\x. a rpow x) has_real_derivative log(a) * a rpow x) + (atreal x)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[rpow] THEN + REAL_DIFF_TAC THEN REAL_ARITH_TAC);; + +add_real_differentiation_theorems +(CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN + (SPEC `a:real` HAS_REAL_DERIVATIVE_RPOW_RIGHT))));; + +let REAL_DIFFERENTIABLE_AT_RPOW = prove + (`!x y. ~(x = &0) ==> (\x. x rpow y) real_differentiable atreal x`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `~(x = &0) <=> &0 < x \/ &0 < --x`] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_DIFFERENTIABLE_TRANSFORM_ATREAL THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `abs x` THENL + [EXISTS_TAC `\x. exp(y * log x)` THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> &0 < abs x`] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < z` (fun th -> REWRITE_TAC[rpow; th]) THEN + ASM_REAL_ARITH_TAC; + REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC]; + ASM_CASES_TAC `?m n. ODD m /\ ODD n /\ abs y = &m / &n` THENL + [EXISTS_TAC `\x. --(exp(y * log(--x)))`; + EXISTS_TAC `\x. exp(y * log(--x))`] THEN + (ASM_SIMP_TAC[REAL_ARITH `&0 < --x ==> &0 < abs x`] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&0 < z) /\ ~(z = &0)` + (fun th -> ASM_REWRITE_TAC[rpow; th]) THEN + ASM_REAL_ARITH_TAC; + REAL_DIFFERENTIABLE_TAC THEN ASM_REAL_ARITH_TAC])]);; + +let REAL_CONTINUOUS_AT_RPOW = prove + (`!x y. (x = &0 ==> &0 <= y) + ==> (\x. x rpow y) real_continuous (atreal x)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `y = &0` THEN + ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_CONTINUOUS_CONST] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[real_continuous_atreal; RPOW_ZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_RPOW] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e rpow inv(y)` THEN + ASM_SIMP_TAC[RPOW_POS_LT] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e rpow inv y rpow y` THEN CONJ_TAC THENL + [MATCH_MP_TAC RPOW_LT2 THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[RPOW_RPOW; REAL_LT_IMP_LE; REAL_MUL_LINV] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL]]; + ASM_SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; + REAL_DIFFERENTIABLE_AT_RPOW]]);; + +let REAL_CONTINUOUS_WITHIN_RPOW = prove + (`!s x y. (x = &0 ==> &0 <= y) + ==> (\x. x rpow y) real_continuous (atreal x within s)`, + MESON_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; + REAL_CONTINUOUS_AT_RPOW]);; + +let REAL_CONTINUOUS_ON_RPOW = prove + (`!s y. (&0 IN s ==> &0 <= y) ==> (\x. x rpow y) real_continuous_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN + ASM_MESON_TAC[]);; + +let REALLIM_RPOW = prove + (`!net f l n. + (f ---> l) net /\ (l = &0 ==> &0 <= n) + ==> ((\x. f x rpow n) ---> l rpow n) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REWRITE_RULE[] (ISPEC `\x. x rpow n` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_CONTINUOUS_AT_RPOW THEN + ASM_REWRITE_TAC[]);; + +let REALLIM_NULL_POW_EQ = prove + (`!net f n. + ~(n = 0) + ==> (((\x. f x pow n) ---> &0) net <=> (f ---> &0) net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[REALLIM_NULL_POW] THEN + DISCH_THEN(MP_TAC o ISPEC `(\x. x rpow (inv(&n))) o abs` o + MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN + REWRITE_TAC[o_THM] THEN + ASM_REWRITE_TAC[RPOW_ZERO; REAL_INV_EQ_0; REAL_OF_NUM_EQ; REAL_ABS_NUM] THEN + SIMP_TAC[GSYM RPOW_POW; RPOW_RPOW; REAL_ABS_POS; REAL_ABS_RPOW] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[REALLIM_NULL_ABS; RPOW_POW; REAL_POW_1] THEN + DISCH_THEN MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[GSYM WITHINREAL_UNIV] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ABS THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_RPOW THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]]);; + +let LIM_NULL_COMPLEX_POW_EQ = prove + (`!net f n. + ~(n = 0) + ==> (((\x. f x pow n) --> Cx(&0)) net <=> (f --> Cx(&0)) net)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + ONCE_REWRITE_TAC[LIM_NULL_NORM] THEN + REWRITE_TAC[COMPLEX_NORM_POW; REAL_TENDSTO; o_DEF; LIFT_DROP] THEN + ASM_SIMP_TAC[REALLIM_NULL_POW_EQ; DROP_VEC]);; + +(* ------------------------------------------------------------------------- *) +(* Analytic result for "frac". *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_FRAC = prove + (`!x. ~(integer x) ==> (frac has_real_derivative (&1)) (atreal x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN + EXISTS_TAC `\y. y - floor x` THEN + EXISTS_TAC `min (frac x) (floor x + &1 - x)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_FRAC_POS_LT] THEN + REWRITE_TAC[REAL_ARITH `&0 < x + &1 - y <=> y < x + &1`; FLOOR] THEN + CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REAL_ARITH_TAC] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[GSYM FRAC_UNIQUE; REAL_ARITH `y - (y - x):real = x`] THEN + MP_TAC(SPEC `x:real` FLOOR_FRAC) THEN SIMP_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let REAL_DIFFERENTIABLE_FRAC = prove + (`!x. ~(integer x) ==> frac real_differentiable (atreal x)`, + REWRITE_TAC[real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_FRAC]);; + +add_real_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN HAS_REAL_DERIVATIVE_FRAC)));; + +(* ------------------------------------------------------------------------- *) +(* Polynomials are differentiable and continuous. *) +(* ------------------------------------------------------------------------- *) + +let REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL = prove + (`!p x. polynomial_function p ==> p real_differentiable atreal x`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_INDUCT THEN + SIMP_TAC[REAL_DIFFERENTIABLE_CONST; REAL_DIFFERENTIABLE_ID; + REAL_DIFFERENTIABLE_ADD; REAL_DIFFERENTIABLE_MUL_ATREAL]);; + +let REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN = prove + (`!p s x. polynomial_function p ==> p real_differentiable atreal x within s`, + SIMP_TAC[REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL; + REAL_DIFFERENTIABLE_ATREAL_WITHIN]);; + +let REAL_DIFFERENTIABLE_ON_POLYNOMIAL_FUNCTION = prove + (`!p s. polynomial_function p ==> p real_differentiable_on s`, + SIMP_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN]);; + +let REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_ATREAL = prove + (`!p x. polynomial_function p ==> p real_continuous atreal x`, + SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL; + REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_ATREAL]);; + +let REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN = prove + (`!p s x. polynomial_function p ==> p real_continuous atreal x within s`, + SIMP_TAC[REAL_DIFFERENTIABLE_IMP_CONTINUOUS_WITHINREAL; + REAL_DIFFERENTIABLE_POLYNOMIAL_FUNCTION_WITHIN]);; + +let REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION = prove + (`!p s. polynomial_function p ==> p real_continuous_on s`, + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + REAL_CONTINUOUS_POLYNOMIAL_FUNCTION_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Intermediate Value Theorem. *) +(* ------------------------------------------------------------------------- *) + +let REAL_IVT_INCREASING = prove + (`!f a b y. + a <= b /\ f real_continuous_on real_interval[a,b] /\ + f a <= y /\ y <= f b + ==> ?x. x IN real_interval [a,b] /\ f x = y`, + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `y:real`; `1`] + IVT_INCREASING_COMPONENT_ON_1) THEN + ASM_REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP; DIMINDEX_1; LE_REFL] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; EXISTS_IN_IMAGE; LIFT_DROP]);; + +let REAL_IVT_DECREASING = prove + (`!f a b y. + a <= b /\ f real_continuous_on real_interval[a,b] /\ + f b <= y /\ y <= f a + ==> ?x. x IN real_interval [a,b] /\ f x = y`, + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`; `y:real`; `1`] + IVT_DECREASING_COMPONENT_ON_1) THEN + ASM_REWRITE_TAC[GSYM drop; o_THM; LIFT_DROP; DIMINDEX_1; LE_REFL] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; EXISTS_IN_IMAGE; LIFT_DROP]);; + +let IS_REALINTERVAL_CONTINUOUS_IMAGE = prove + (`!s. f real_continuous_on s /\ is_realinterval s + ==> is_realinterval(IMAGE f s)`, + GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; IS_REALINTERVAL_CONNECTED] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_CONTINUOUS_IMAGE) THEN + REWRITE_TAC[IMAGE_o; REWRITE_RULE[IMAGE_o] IMAGE_LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Zeroness (or sign at boundary) of derivative at local extremum. *) +(* ------------------------------------------------------------------------- *) + +let REAL_DERIVATIVE_POS_LEFT_MINIMUM = prove + (`!f f' a b e. + a < b /\ &0 < e /\ + (f has_real_derivative f') (atreal a within real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] /\ abs(x - a) < e ==> f a <= f x) + ==> &0 <= f'`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; + `lift a`; `interval[lift a,lift b]`; `e:real`] + DROP_DIFFERENTIAL_POS_AT_MINIMUM) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; + GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; + REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN + ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN + ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; + REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; + REAL_SUB_LT]);; + +let REAL_DERIVATIVE_NEG_LEFT_MAXIMUM = prove + (`!f f' a b e. + a < b /\ &0 < e /\ + (f has_real_derivative f') (atreal a within real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] /\ abs(x - a) < e ==> f x <= f a) + ==> f' <= &0`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; + `lift a`; `interval[lift a,lift b]`; `e:real`] + DROP_DIFFERENTIAL_NEG_AT_MAXIMUM) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; + GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; + REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN + ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN + ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; + REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; + REAL_SUB_LT; REAL_ARITH `f * ba <= &0 <=> &0 <= --f * ba`] THEN + REAL_ARITH_TAC);; + +let REAL_DERIVATIVE_POS_RIGHT_MAXIMUM = prove + (`!f f' a b e. + a < b /\ &0 < e /\ + (f has_real_derivative f') (atreal b within real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] /\ abs(x - b) < e ==> f x <= f b) + ==> &0 <= f'`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; + `lift b`; `interval[lift a,lift b]`; `e:real`] + DROP_DIFFERENTIAL_NEG_AT_MAXIMUM) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; + GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; + REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN + ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN + ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; + REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP; REAL_LE_MUL_EQ; REAL_SUB_LT; + REAL_ARITH `f * (a - b) <= &0 <=> &0 <= f * (b - a)`]);; + +let REAL_DERIVATIVE_NEG_RIGHT_MINIMUM = prove + (`!f f' a b e. + a < b /\ &0 < e /\ + (f has_real_derivative f') (atreal b within real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] /\ abs(x - b) < e ==> f b <= f x) + ==> f' <= &0`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; + `lift b`; `interval[lift a,lift b]`; `e:real`] + DROP_DIFFERENTIAL_POS_AT_MINIMUM) THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; CONVEX_INTERVAL; IN_INTER; IMP_CONJ] THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY; + GSYM HAS_REAL_FRECHET_DERIVATIVE_WITHIN] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; IN_BALL; DIST_LIFT; + REAL_INTERVAL_NE_EMPTY; REAL_LT_IMP_LE] THEN + ANTS_TAC THENL [ASM_MESON_TAC[REAL_ABS_SUB]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN + ASM_SIMP_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY; + REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[DROP_CMUL; DROP_SUB; LIFT_DROP] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&0 <= f * (a - b) <=> &0 <= --f * (b - a)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL_EQ; REAL_SUB_LT] THEN REAL_ARITH_TAC);; + +let REAL_DERIVATIVE_ZERO_MAXMIN = prove + (`!f f' x s. + x IN s /\ real_open s /\ + (f has_real_derivative f') (atreal x) /\ + ((!y. y IN s ==> f y <= f x) \/ (!y. y IN s ==> f x <= f y)) + ==> f' = &0`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1. f' % x`; + `lift x`; `IMAGE lift s`] + DIFFERENTIAL_ZERO_MAXMIN) THEN + ASM_REWRITE_TAC[GSYM HAS_REAL_FRECHET_DERIVATIVE_AT; GSYM REAL_OPEN] THEN + ASM_SIMP_TAC[FUN_IN_IMAGE; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(MP_TAC o C AP_THM `vec 1:real^1`) THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Rolle and Mean Value Theorem. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ROLLE = prove + (`!f f' a b. + a < b /\ f a = f b /\ + f real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) + ==> (f has_real_derivative f'(x)) (atreal x)) + ==> ?x. x IN real_interval(a,b) /\ f'(x) = &0`, + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN + REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP; has_vector_derivative] THEN + REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\x:real^1 h:real^1. f'(drop x) % h`; + `lift a`; `lift b`] ROLLE) THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN ANTS_TAC THENL + [X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^1`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_LIFT; LIFT_DROP; GSYM LIFT_CMUL] THEN + REWRITE_TAC[REAL_MUL_AC]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real^1` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o C AP_THM `lift(&1)`) THEN + REWRITE_TAC[GSYM LIFT_CMUL; GSYM LIFT_NUM; LIFT_EQ; REAL_MUL_RID]]);; + +let REAL_MVT = prove + (`!f f' a b. + a < b /\ + f real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) + ==> (f has_real_derivative f'(x)) (atreal x)) + ==> ?x. x IN real_interval(a,b) /\ f(b) - f(a) = f'(x) * (b - a)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\x:real. f(x) - (f b - f a) / (b - a) * x`; + `(\x. f'(x) - (f b - f a) / (b - a)):real->real`; + `a:real`; `b:real`] + REAL_ROLLE) THEN + ASM_SIMP_TAC[REAL_FIELD + `a < b ==> (fx - fba / (b - a) = &0 <=> fba = fx * (b - a))`] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_LMUL; + REAL_CONTINUOUS_ON_ID] THEN + CONJ_TAC THENL [UNDISCH_TAC `a < b` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN + ASM_SIMP_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_LMUL_ATREAL; HAS_REAL_DERIVATIVE_ID]);; + +let REAL_MVT_SIMPLE = prove + (`!f f' a b. + a < b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) + (atreal x within real_interval[a,b])) + ==> ?x. x IN real_interval(a,b) /\ f(b) - f(a) = f'(x) * (b - a)`, + MP_TAC REAL_MVT THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + ASM_MESON_TAC[real_differentiable_on; real_differentiable]; + ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN; REAL_OPEN_REAL_INTERVAL; + REAL_INTERVAL_OPEN_SUBSET_CLOSED; + HAS_REAL_DERIVATIVE_WITHIN_SUBSET; SUBSET]]);; + +let REAL_MVT_VERY_SIMPLE = prove + (`!f f' a b. + a <= b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) + (atreal x within real_interval[a,b])) + ==> ?x. x IN real_interval[a,b] /\ f(b) - f(a) = f'(x) * (b - a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real = a` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_INTERVAL_SING; IN_SING; EXISTS_REFL]; + ASM_REWRITE_TAC[REAL_LE_LT] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_MVT_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[REWRITE_RULE[SUBSET] REAL_INTERVAL_OPEN_SUBSET_CLOSED]]);; + +let REAL_ROLLE_SIMPLE = prove + (`!f f' a b. + a < b /\ f a = f b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) + (atreal x within real_interval[a,b])) + ==> ?x. x IN real_interval(a,b) /\ f'(x) = &0`, + MP_TAC REAL_MVT_SIMPLE THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[REAL_RING `a - a = b * (c - d) <=> b = &0 \/ c = d`] THEN + ASM_MESON_TAC[REAL_LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy MVT and l'Hospital's rule. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MVT_CAUCHY = prove + (`!f g f' g' a b. + a < b /\ + f real_continuous_on real_interval[a,b] /\ + g real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) + ==> (f has_real_derivative f' x) (atreal x) /\ + (g has_real_derivative g' x) (atreal x)) + ==> ?x. x IN real_interval(a,b) /\ + (f b - f a) * g'(x) = (g b - g a) * f'(x)`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL + [`\x. (f:real->real)(x) * (g(b:real) - g(a)) - g(x) * (f(b) - f(a))`; + `\x. (f':real->real)(x) * (g(b:real) - g(a)) - g'(x) * (f(b) - f(a))`; + `a:real`; `b:real`] REAL_MVT) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ON_SUB; REAL_CONTINUOUS_ON_RMUL; + HAS_REAL_DERIVATIVE_SUB; HAS_REAL_DERIVATIVE_RMUL_ATREAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + UNDISCH_TAC `a < b` THEN CONV_TAC REAL_FIELD);; + +let LHOSPITAL = prove + (`!f g f' g' c l d. + &0 < d /\ + (!x. &0 < abs(x - c) /\ abs(x - c) < d + ==> (f has_real_derivative f'(x)) (atreal x) /\ + (g has_real_derivative g'(x)) (atreal x) /\ + ~(g'(x) = &0)) /\ + (f ---> &0) (atreal c) /\ (g ---> &0) (atreal c) /\ + ((\x. f'(x) / g'(x)) ---> l) (atreal c) + ==> ((\x. f(x) / g(x)) ---> l) (atreal c)`, + SUBGOAL_THEN + `!f g f' g' c l d. + &0 < d /\ + (!x. &0 < abs(x - c) /\ abs(x - c) < d + ==> (f has_real_derivative f'(x)) (atreal x) /\ + (g has_real_derivative g'(x)) (atreal x) /\ + ~(g'(x) = &0)) /\ + f(c) = &0 /\ g(c) = &0 /\ + (f ---> &0) (atreal c) /\ (g ---> &0) (atreal c) /\ + ((\x. f'(x) / g'(x)) ---> l) (atreal c) + ==> ((\x. f(x) / g(x)) ---> l) (atreal c)` + ASSUME_TAC THENL + [REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(!x. abs(x - c) < d ==> f real_continuous atreal x) /\ + (!x. abs(x - c) < d ==> g real_continuous atreal x)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `x:real` THEN + DISJ_CASES_TAC(REAL_ARITH `x = c \/ &0 < abs(x - c)`) THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REWRITE_TAC[real_differentiable] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. &0 < abs(x - c) /\ abs(x - c) < d ==> ~(g x = &0)` + STRIP_ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `c < x \/ x < c` DISJ_CASES_TAC THENL + [ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`g:real->real`; `g':real->real`; `c:real`; `x:real`] + REAL_ROLLE); + MP_TAC(ISPECL [`g:real->real`; `g':real->real`; `x:real`; `c:real`] + REAL_ROLLE)] THEN + ASM_REWRITE_TAC[NOT_IMP; NOT_EXISTS_THM] THEN + (REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC; + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC); + ALL_TAC] THEN + UNDISCH_TAC `((\x. f' x / g' x) ---> l) (atreal c)` THEN + REWRITE_TAC[REALLIM_ATREAL] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?y. &0 < abs(y - c) /\ abs(y - c) < abs(x - c) /\ + (f:real->real) x / g x = f' y / g' y` + STRIP_ASSUME_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[REAL_LT_TRANS]] THEN + SUBGOAL_THEN `c < x \/ x < c` DISJ_CASES_TAC THENL + [ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL + [`f:real->real`; `g:real->real`; `f':real->real`; `g':real->real`; + `c:real`; `x:real`] REAL_MVT_CAUCHY); + MP_TAC(ISPECL + [`f:real->real`; `g:real->real`; `f':real->real`; `g':real->real`; + `x:real`; `c:real`] REAL_MVT_CAUCHY)] THEN + (ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL + [REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL; + REPEAT STRIP_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + GEN_TAC THEN STRIP_TAC THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC(REAL_FIELD + `f * g' = g * f' /\ ~(g = &0) /\ ~(g' = &0) ==> f / g = f' / g'`) THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; CONJ_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]); + REPEAT GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`\x:real. if x = c then &0 else f(x)`; + `\x:real. if x = c then &0 else g(x)`; + `f':real->real`; `g':real->real`; + `c:real`; `l:real`; `d:real`]) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_IMP THEN CONJ_TAC THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN + TRY(SIMP_TAC[REALLIM_ATREAL;REAL_ARITH `&0 < abs(x - c) ==> ~(x = c)`] THEN + NO_TAC) THEN + DISCH_TAC THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL) THEN + EXISTS_TAC `abs(x - c)` THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Darboux's theorem (intermediate value property for derivatives). *) +(* ------------------------------------------------------------------------- *) + +let REAL_DERIVATIVE_IVT_INCREASING = prove + (`!f f' a b. + a <= b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) + ==> !t. f'(a) <= t /\ t <= f'(b) + ==> ?x. x IN real_interval[a,b] /\ f' x = t`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + ASM_CASES_TAC `(f':real->real) a = t` THENL + [ASM_MESON_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `(f':real->real) b = t` THENL + [ASM_MESON_TAC[ENDS_IN_REAL_INTERVAL; REAL_INTERVAL_NE_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `b:real = a` THEN ASM_REWRITE_TAC[REAL_LE_ANTISYM] THEN + SUBGOAL_THEN `a < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_LE_LT] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. f x - t * x`; `real_interval[a,b]`] + REAL_CONTINUOUS_ATTAINS_INF) THEN + ASM_REWRITE_TAC[REAL_INTERVAL_NE_EMPTY; REAL_COMPACT_INTERVAL] THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_SUB THEN + SIMP_TAC[REAL_DIFFERENTIABLE_ON_MUL; REAL_DIFFERENTIABLE_ON_ID; + REAL_DIFFERENTIABLE_ON_CONST] THEN + ASM_MESON_TAC[real_differentiable_on]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL + [`\x:real. f x - t * x`; `(f':real->real) x - t:real`; + `x:real`; `real_interval(a,b)`] + REAL_DERIVATIVE_ZERO_MAXMIN) THEN + ASM_REWRITE_TAC[REAL_SUB_0] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_OPEN_REAL_INTERVAL] THEN + ASM_SIMP_TAC[REAL_OPEN_CLOSED_INTERVAL; IN_DIFF] THEN + ASM_CASES_TAC `x:real = a` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(ISPECL[`\x:real. f x - t * x`; `(f':real->real) a - t:real`; + `a:real`; `b:real`; `&1`] + REAL_DERIVATIVE_POS_LEFT_MINIMUM) THEN + ASM_SIMP_TAC[REAL_LT_01; REAL_SUB_LE] THEN + MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN + ASM_REWRITE_TAC[REAL_NOT_LE] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN + CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY]; + ALL_TAC] THEN + ASM_CASES_TAC `x:real = b` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(ISPECL[`\x:real. f x - t * x`; `(f':real->real) b - t:real`; + `a:real`; `b:real`; `&1`] + REAL_DERIVATIVE_NEG_RIGHT_MINIMUM) THEN + ASM_SIMP_TAC[REAL_LT_01; REAL_SUB_LE] THEN + MATCH_MP_TAC(TAUT `~q /\ p ==> (p ==> q) ==> r`) THEN + ASM_REWRITE_TAC[REAL_NOT_LE; REAL_SUB_LT] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN + CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY]; + ALL_TAC] THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUB THEN + CONJ_TAC THENL [ALL_TAC; REAL_DIFF_TAC THEN REWRITE_TAC[REAL_MUL_RID]] THEN + SUBGOAL_THEN + `(f has_real_derivative f' x) (atreal x within real_interval(a,b))` + MP_TAC THENL + [MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[a,b]` THEN + ASM_SIMP_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED]; + MATCH_MP_TAC EQ_IMP THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN THEN + REWRITE_TAC[REAL_OPEN_REAL_INTERVAL] THEN + ASM_REWRITE_TAC[REAL_OPEN_CLOSED_INTERVAL] THEN ASM SET_TAC[]]);; + +let REAL_DERIVATIVE_IVT_DECREASING = prove + (`!f f' a b t. + a <= b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) (atreal x within real_interval[a,b])) + ==> !t. f'(b) <= t /\ t <= f'(a) + ==> ?x. x IN real_interval[a,b] /\ f' x = t`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL + [`\x. --((f:real->real) x)`; `\x. --((f':real->real) x)`; + `a:real`; `b:real`] REAL_DERIVATIVE_IVT_INCREASING) THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG] THEN + DISCH_THEN(MP_TAC o SPEC `--t:real`) THEN + ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity and differentiability of inverse functions. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_INVERSE_BASIC = prove + (`!f g f' t y. + (f has_real_derivative f') (atreal (g y)) /\ + ~(f' = &0) /\ + g real_continuous atreal y /\ + real_open t /\ + y IN t /\ + (!z. z IN t ==> f (g z) = z) + ==> (g has_real_derivative inv(f')) (atreal y)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN; + REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_DERIVATIVE_INVERSE_BASIC THEN + MAP_EVERY EXISTS_TAC + [`lift o f o drop`; `\x:real^1. f' % x`; `IMAGE lift t`] THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; LIFT_DROP; LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN + REWRITE_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]);; + +let HAS_REAL_DERIVATIVE_INVERSE_STRONG = prove + (`!f g f' s x. + real_open s /\ + x IN s /\ + f real_continuous_on s /\ + (!x. x IN s ==> g (f x) = x) /\ + (f has_real_derivative f') (atreal x) /\ + ~(f' = &0) + ==> (g has_real_derivative inv(f')) (atreal (f x))`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN; + REAL_CONTINUOUS_ON] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `lift o f o drop` HAS_DERIVATIVE_INVERSE_STRONG) THEN + REWRITE_TAC[FORALL_LIFT; o_THM; LIFT_DROP] THEN + DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`\x:real^1. f' % x`; `IMAGE lift s`] THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN + ASM_SIMP_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]);; + +let HAS_REAL_DERIVATIVE_INVERSE_STRONG_X = prove + (`!f g f' s y. + real_open s /\ (g y) IN s /\ f real_continuous_on s /\ + (!x. x IN s ==> (g(f(x)) = x)) /\ + (f has_real_derivative f') (atreal (g y)) /\ ~(f' = &0) /\ + f(g y) = y + ==> (g has_real_derivative inv(f')) (atreal y)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_AT; REAL_OPEN; + REAL_CONTINUOUS_ON] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `lift o f o drop` HAS_DERIVATIVE_INVERSE_STRONG_X) THEN + REWRITE_TAC[FORALL_LIFT; o_THM; LIFT_DROP] THEN + DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`\x:real^1. f' % x`; `IMAGE lift s`] THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP; LIFT_IN_IMAGE_LIFT] THEN + ASM_SIMP_TAC[FUN_EQ_THM; I_THM; o_THM; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Real differentiation of sequences and series. *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_DERIVATIVE_SEQUENCE = prove + (`!s f f' g'. + is_realinterval s /\ + (!n x. x IN s + ==> (f n has_real_derivative f' n x) (atreal x within s)) /\ + (!e. &0 < e + ==> ?N. !n x. n >= N /\ x IN s ==> abs(f' n x - g' x) <= e) /\ + (?x l. x IN s /\ ((\n. f n x) ---> l) sequentially) + ==> ?g. !x. x IN s + ==> ((\n. f n x) ---> g x) sequentially /\ + (g has_real_derivative g' x) (atreal x within s)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; IS_REALINTERVAL_CONVEX; + TENDSTO_REAL] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE lift s`; + `\n:num. lift o f n o drop`; + `\n:num x:real^1 h:real^1. f' n (drop x) % h`; + `\x:real^1 h:real^1. g' (drop x) % h`] + HAS_DERIVATIVE_SEQUENCE) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN ANTS_TAC THENL + [REWRITE_TAC[IMP_CONJ; RIGHT_EXISTS_AND_THM; RIGHT_FORALL_IMP_THM; + EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[EXISTS_LIFT; o_THM; LIFT_DROP] THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN + ASM_MESON_TAC[REAL_LE_RMUL; NORM_POS_LE]; + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `g:real^1->real^1`) THEN + EXISTS_TAC `drop o g o lift` THEN + RULE_ASSUM_TAC(REWRITE_RULE[ETA_AX]) THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; + +let HAS_REAL_DERIVATIVE_SERIES = prove + (`!s f f' g' k. + is_realinterval s /\ + (!n x. x IN s + ==> (f n has_real_derivative f' n x) (atreal x within s)) /\ + (!e. &0 < e + ==> ?N. !n x. n >= N /\ x IN s + ==> abs(sum (k INTER (0..n)) (\i. f' i x) - g' x) + <= e) /\ + (?x l. x IN s /\ ((\n. f n x) real_sums l) k) + ==> ?g. !x. x IN s + ==> ((\n. f n x) real_sums g x) k /\ + (g has_real_derivative g' x) (atreal x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_sums] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_SEQUENCE THEN EXISTS_TAC + `\n:num x:real. sum(k INTER (0..n)) (\n. f' n x):real` THEN + ASM_SIMP_TAC[ETA_AX; FINITE_INTER_NUMSEG; HAS_REAL_DERIVATIVE_SUM]);; + +let REAL_DIFFERENTIABLE_BOUND = prove + (`!f f' s B. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s) /\ + abs(f' x) <= B) + ==> !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * abs(x - y)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; IS_REALINTERVAL_CONVEX; + o_DEF] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o f o drop`; `\x h:real^1. f' (drop x) % h`; + `IMAGE lift s`; `B:real`] + DIFFERENTIABLE_BOUND) THEN + ASM_SIMP_TAC[o_DEF; FORALL_IN_IMAGE; LIFT_DROP] THEN ANTS_TAC THENL + [X_GEN_TAC `v:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `\h:real^1. f' (v:real) % h` ONORM) THEN + SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID] THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN + ASM_SIMP_TAC[NORM_MUL; REAL_LE_RMUL; NORM_POS_LE]; + SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; LIFT_DROP] THEN + ASM_SIMP_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM LIFT_SUB; NORM_LIFT]]);; + +let REAL_TAYLOR_MVT_POS = prove + (`!f a x n. + a < x /\ + (!i t. t IN real_interval[a,x] /\ i <= n + ==> ((f i) has_real_derivative f (i + 1) t) + (atreal t within real_interval[a,x])) + ==> ?t. t IN real_interval(a,x) /\ + f 0 x = + sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) + + f (n + 1) t * (x - a) pow (n + 1) / &(FACT(n + 1))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?B. sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) + + B * (x - a) pow (n + 1) = f 0 x` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(MESON[] + `a + (y - a) / x * x:real = y ==> ?b. a + b * x = y`) THEN + MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> a + (y - a) / x * x = y`) THEN + ASM_REWRITE_TAC[REAL_POW_EQ_0; REAL_SUB_0] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`\t. sum(0..n) (\i. f i t * (x - t) pow i / &(FACT i)) + + B * (x - t) pow (n + 1)`; + `\t. (f (n + 1) t * (x - t) pow n / &(FACT n)) - + B * &(n + 1) * (x - t) pow n`; + `a:real`; `x:real`] + REAL_ROLLE_SIMPLE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[GSYM ADD1; real_pow; REAL_SUB_REFL; REAL_POW_ZERO; + REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_ADD_RID] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[NOT_SUC; REAL_MUL_RZERO; REAL_DIV_1; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `x = (x + y) + &0 <=> y = &0`] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN + SIMP_TAC[ARITH; ARITH_RULE `1 <= i ==> ~(i = 0)`] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO]; + ALL_TAC] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[real_sub] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ADD THEN CONJ_TAC THENL + [ALL_TAC; + REAL_DIFF_TAC THEN REWRITE_TAC[ADD_SUB] THEN CONV_TAC REAL_RING] THEN + REWRITE_TAC[GSYM real_sub] THEN + MATCH_MP_TAC(MESON[] + `!g'. f' = g' /\ (f has_real_derivative g') net + ==> (f has_real_derivative f') net`) THEN + EXISTS_TAC + `sum (0..n) (\i. f i t * --(&i * (x - t) pow (i - 1)) / &(FACT i) + + f (i + 1) t * (x - t) pow i / &(FACT i))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_MUL_WITHIN THEN + ASM_SIMP_TAC[ETA_AX] THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH; FACT; REAL_DIV_1; + real_pow; REAL_MUL_LZERO; REAL_NEG_0; REAL_MUL_RZERO; + REAL_MUL_RID; REAL_ADD_LID] THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; FACT] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[SPECL [`f:num->real`; `1`] SUM_OFFSET_0; LE_1] THEN + REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[GSYM ADD1; FACT; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `--(n * x) * (inv n * inv y):real = + --(n / n) * x / y`] THEN + REWRITE_TAC[REAL_FIELD `--((&n + &1) / (&n + &1)) * x = --x`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_OF_NUM_MUL; REAL_OF_NUM_SUC] THEN + REWRITE_TAC[GSYM(CONJUNCT2 FACT)] THEN + REWRITE_TAC[REAL_ARITH `a * --b + c:real = c - a * b`] THEN + REWRITE_TAC[ADD1; GSYM real_div; SUM_DIFFS_ALT; LE_0] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`; FACT] THEN + REWRITE_TAC[ADD_CLAUSES] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + REWRITE_TAC[REAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[REAL_ARITH `a * b / c:real = a / c * b`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `a * x / f - B * k * x = &0 ==> (B * k - a / f) * x = &0`)) THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_SUB_0] THEN + ASM_CASES_TAC `x:real = t` THENL + [ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LT_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM ADD1; FACT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; ADD1] THEN + SUBGOAL_THEN `~(&(FACT n) = &0)` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ]; CONV_TAC REAL_FIELD]);; + +let REAL_TAYLOR_MVT_NEG = prove + (`!f a x n. + x < a /\ + (!i t. t IN real_interval[x,a] /\ i <= n + ==> ((f i) has_real_derivative f (i + 1) t) + (atreal t within real_interval[x,a])) + ==> ?t. t IN real_interval(x,a) /\ + f 0 x = + sum (0..n) (\i. f i a * (x - a) pow i / &(FACT i)) + + f (n + 1) t * (x - a) pow (n + 1) / &(FACT(n + 1))`, + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[REAL_NEG_NEG] `(?x:real. P x) <=> (?x. P(--x))`] THEN + MP_TAC(SPECL [`\n x. (-- &1) pow n * (f:num->real->real) n (--x)`; + `--a:real`; ` --x:real`; `n:num`] + REAL_TAYLOR_MVT_POS) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(x * y) * z / w:real = y * (x * z) / w`] THEN + REWRITE_TAC[GSYM REAL_POW_MUL] THEN + REWRITE_TAC[REAL_ARITH `-- &1 * (--x - --a) = x - a`] THEN + REWRITE_TAC[IN_REAL_INTERVAL; real_pow; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `--a < t /\ t < --x <=> x < --t /\ --t < a`] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LT_NEG2] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `t:real`] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_WITHIN THEN + ONCE_REWRITE_TAC[REAL_ARITH `y pow 1 * x:real = x * y`] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REAL_DIFF_TAC THEN REFL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `IMAGE (--) (real_interval[--a,--x]) = real_interval[x,a]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_ARITH `x:real = --y <=> --x = y`; UNWIND_THM1] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +let REAL_TAYLOR = prove + (`!f n s B. + is_realinterval s /\ + (!i x. x IN s /\ i <= n + ==> ((f i) has_real_derivative f (i + 1) x) (atreal x within s)) /\ + (!x. x IN s ==> abs(f (n + 1) x) <= B) + ==> !w z. w IN s /\ z IN s + ==> abs(f 0 z - + sum (0..n) (\i. f i w * (z - w) pow i / &(FACT i))) + <= B * abs(z - w) pow (n + 1) / &(FACT(n + 1))`, + REPEAT STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `w = z \/ w < z \/ z < w`) + THENL + [ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; REAL_SUB_REFL; REAL_POW_ZERO; + REAL_ABS_0; ARITH; ADD_EQ_0; real_div] THEN + REWRITE_TAC[REAL_MUL_LZERO; FACT; REAL_INV_1; REAL_MUL_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `y = &0 ==> abs(x - (x * &1 * &1 + y)) <= &0`) THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN + SIMP_TAC[ARITH; LE_1; REAL_MUL_RZERO; REAL_MUL_LZERO]; + MP_TAC(ISPECL [`f:num->real->real`; `w:real`; `z:real`; `n:num`] + REAL_TAYLOR_MVT_POS) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `real_interval[w,z] SUBSET s` ASSUME_TAC THENL + [SIMP_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[is_realinterval]; + ALL_TAC]; + MP_TAC(ISPECL [`f:num->real->real`; `w:real`; `z:real`; `n:num`] + REAL_TAYLOR_MVT_NEG) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `real_interval[z,w] SUBSET s` ASSUME_TAC THENL + [SIMP_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_MESON_TAC[is_realinterval]; + ALL_TAC]] THEN + (ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `t:real`] THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[SUBSET]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[REAL_ADD_SUB; REAL_ABS_MUL; REAL_ABS_DIV] THEN + REWRITE_TAC[REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_POW_LE; REAL_ABS_POS] THEN + ASM_MESON_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED; SUBSET]));; + +(* ------------------------------------------------------------------------- *) +(* Comparing sums and "integrals" via real antiderivatives. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SUM_INTEGRAL_UBOUND_INCREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN real_interval[&m,&n + &1] + ==> (g has_real_derivative f(x)) + (atreal x within real_interval[&m,&n + &1])) /\ + (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> f x <= f y) + ==> sum(m..n) (\k. f(&k)) <= g(&n + &1) - g(&m)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. g(&(k + 1)) - g(&k))` THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[SUM_DIFFS_ALT; REAL_OF_NUM_ADD; REAL_LE_REFL]] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->real`; `f:real->real`; `&k`; `&(k + 1)`] + REAL_MVT_SIMPLE) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; ARITH_RULE `k < k + 1`] THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_SUB] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[&m,&n + &1]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]); + REWRITE_TAC[SUBSET] THEN GEN_TAC] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[REAL_MUL_RID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]);; + +let REAL_SUM_INTEGRAL_UBOUND_DECREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN real_interval[&m - &1,&n] + ==> (g has_real_derivative f(x)) + (atreal x within real_interval[&m - &1,&n])) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> f y <= f x) + ==> sum(m..n) (\k. f(&k)) <= g(&n) - g(&m - &1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. g(&(k + 1) - &1) - g(&k - &1))` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[SUM_DIFFS_ALT] THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(x + &1) - &1 = x`] THEN + REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->real`; `f:real->real`; `&k - &1`; `&k`] + REAL_MVT_SIMPLE) THEN + ASM_REWRITE_TAC[REAL_ARITH `k - &1 < k`] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[&m - &1,&n]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]); + REWRITE_TAC[SUBSET] THEN GEN_TAC] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(a + &1) - &1 = a`] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[REAL_ARITH `a * (x - (x - &1)) = a`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]);; + +let REAL_SUM_INTEGRAL_LBOUND_INCREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN real_interval[&m - &1,&n] + ==> (g has_real_derivative f(x)) + (atreal x within real_interval[&m - &1,&n])) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n ==> f x <= f y) + ==> g(&n) - g(&m - &1) <= sum(m..n) (\k. f(&k))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. --((f:real->real) z)`; + `\z. --((g:real->real) z)`; + `m:num`; `n:num`] REAL_SUM_INTEGRAL_UBOUND_DECREASING) THEN + REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; + REAL_ARITH `--x - --y:real = --(x - y)`] THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG]);; + +let REAL_SUM_INTEGRAL_LBOUND_DECREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN real_interval[&m,&n + &1] + ==> (g has_real_derivative f(x)) + (atreal x within real_interval[&m,&n + &1])) /\ + (!x y. &m <= x /\ x <= y /\ y <= &n + &1 ==> f y <= f x) + ==> g(&n + &1) - g(&m) <= sum(m..n) (\k. f(&k))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. --((f:real->real) z)`; + `\z. --((g:real->real) z)`; + `m:num`; `n:num`] REAL_SUM_INTEGRAL_UBOUND_INCREASING) THEN + REWRITE_TAC[RE_NEG; RE_SUB; SUM_NEG; REAL_LE_NEG2; + REAL_ARITH `--x - --y:real = --(x - y)`] THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_NEG]);; + +let REAL_SUM_INTEGRAL_BOUNDS_INCREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN real_interval[&m - &1,&n + &1] + ==> (g has_real_derivative f x) + (atreal x within real_interval[&m - &1,&n + &1])) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> f x <= f y) + ==> g(&n) - g(&m - &1) <= sum(m..n) (\k. f(&k)) /\ + sum (m..n) (\k. f(&k)) <= g(&n + &1) - g(&m)`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_SUM_INTEGRAL_LBOUND_INCREASING; + MATCH_MP_TAC REAL_SUM_INTEGRAL_UBOUND_INCREASING] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + TRY(MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[&m - &1,&n + &1]` THEN CONJ_TAC) THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN + TRY(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL])) THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; + +let REAL_SUM_INTEGRAL_BOUNDS_DECREASING = prove + (`!f g m n. + m <= n /\ + (!x. x IN real_interval[&m - &1,&n + &1] + ==> (g has_real_derivative f(x)) + (atreal x within real_interval[&m - &1,&n + &1])) /\ + (!x y. &m - &1 <= x /\ x <= y /\ y <= &n + &1 ==> f y <= f x) + ==> g(&n + &1) - g(&m) <= sum(m..n) (\k. f(&k)) /\ + sum(m..n) (\k. f(&k)) <= g(&n) - g(&m - &1)`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_SUM_INTEGRAL_LBOUND_DECREASING; + MATCH_MP_TAC REAL_SUM_INTEGRAL_UBOUND_DECREASING] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + TRY(MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[&m - &1,&n + &1]` THEN CONJ_TAC) THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN + TRY(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL])) THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Relating different kinds of real limits. *) +(* ------------------------------------------------------------------------- *) + +let REALLIM_POSINFINITY_SEQUENTIALLY = prove + (`!f l. (f ---> l) at_posinfinity ==> ((\n. f(&n)) ---> l) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[o_DEF]);; + +let LIM_ZERO_POSINFINITY = prove + (`!f l. ((\x. f(&1 / x)) --> l) (atreal (&0)) ==> (f --> l) at_posinfinity`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL; LIM_AT_POSINFINITY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[dist; REAL_SUB_RZERO; real_ge] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&2 / d` THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(z):real`) THEN + REWRITE_TAC[real_div; REAL_MUL_LINV; REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_ABS_INV; REAL_LT_INV_EQ] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `a <= z ==> &0 < a ==> &0 < abs z`)); + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `&2 / d <= z ==> &0 < &2 / d ==> inv d < abs z`))] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]);; + +let LIM_ZERO_NEGINFINITY = prove + (`!f l. ((\x. f(&1 / x)) --> l) (atreal (&0)) ==> (f --> l) at_neginfinity`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_ATREAL; LIM_AT_NEGINFINITY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[dist; REAL_SUB_RZERO; real_ge] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--(&2 / d)` THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(z):real`) THEN + REWRITE_TAC[real_div; REAL_MUL_LINV; REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_ABS_INV; REAL_LT_INV_EQ] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `z <= --a ==> &0 < a ==> &0 < abs z`)); + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `z <= --(&2 / d) ==> &0 < &2 / d ==> inv d < abs z`))] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]);; + +let REALLIM_ZERO_POSINFINITY = prove + (`!f l. ((\x. f(&1 / x)) ---> l) (atreal (&0)) ==> (f ---> l) at_posinfinity`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF; LIM_ZERO_POSINFINITY]);; + +let REALLIM_ZERO_NEGINFINITY = prove + (`!f l. ((\x. f(&1 / x)) ---> l) (atreal (&0)) ==> (f ---> l) at_neginfinity`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF; LIM_ZERO_NEGINFINITY]);; + +(* ------------------------------------------------------------------------- *) +(* Real segments (bidirectional intervals). *) +(* ------------------------------------------------------------------------- *) + +let closed_real_segment = define + `closed_real_segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1}`;; + +let open_real_segment = new_definition + `open_real_segment(a,b) = closed_real_segment[a,b] DIFF {a,b}`;; + +make_overloadable "real_segment" `:A`;; + +overload_interface("real_segment",`open_real_segment`);; +overload_interface("real_segment",`closed_real_segment`);; + +let real_segment = prove + (`real_segment[a,b] = {(&1 - u) * a + u * b | &0 <= u /\ u <= &1} /\ + real_segment(a,b) = real_segment[a,b] DIFF {a,b}`, + REWRITE_TAC[open_real_segment; closed_real_segment]);; + +let REAL_SEGMENT_SEGMENT = prove + (`(!a b. real_segment[a,b] = IMAGE drop (segment[lift a,lift b])) /\ + (!a b. real_segment(a,b) = IMAGE drop (segment(lift a,lift b)))`, + REWRITE_TAC[segment; real_segment] THEN + SIMP_TAC[IMAGE_DIFF_INJ; DROP_EQ; IMAGE_CLAUSES; LIFT_DROP] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP]);; + +let SEGMENT_REAL_SEGMENT = prove + (`(!a b. segment[a,b] = IMAGE lift (real_segment[drop a,drop b])) /\ + (!a b. segment(a,b) = IMAGE lift (real_segment(drop a,drop b)))`, + REWRITE_TAC[REAL_SEGMENT_SEGMENT; GSYM IMAGE_o] THEN + REWRITE_TAC[o_DEF; IMAGE_ID; LIFT_DROP]);; + +let IMAGE_LIFT_REAL_SEGMENT = prove + (`(!a b. IMAGE lift (real_segment[a,b]) = segment[lift a,lift b]) /\ + (!a b. IMAGE lift (real_segment(a,b)) = segment(lift a,lift b))`, + REWRITE_TAC[SEGMENT_REAL_SEGMENT; LIFT_DROP]);; + +let REAL_SEGMENT_INTERVAL = prove + (`(!a b. real_segment[a,b] = + if a <= b then real_interval[a,b] else real_interval[b,a]) /\ + (!a b. real_segment(a,b) = + if a <= b then real_interval(a,b) else real_interval(b,a))`, + REWRITE_TAC[REAL_SEGMENT_SEGMENT; SEGMENT_1; LIFT_DROP] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL] THEN + CONJ_TAC THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[]);; + +let REAL_CONTINUOUS_INJECTIVE_IFF_MONOTONIC = prove + (`!f s. + f real_continuous_on s /\ is_realinterval s + ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> + (!x y. x IN s /\ y IN s /\ x < y ==> f x < f y) \/ + (!x y. x IN s /\ y IN s /\ x < y ==> f y < f x))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IS_REALINTERVAL_IS_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONTINUOUS_INJECTIVE_IFF_MONOTONIC) THEN + REWRITE_TAC[FORALL_LIFT; LIFT_IN_IMAGE_LIFT; o_THM; LIFT_DROP; LIFT_EQ]);; + +let ENDS_IN_REAL_SEGMENT = prove + (`!a b. a IN real_segment[a,b] /\ b IN real_segment[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC);; + +let IS_REAL_INTERVAL_CONTAINS_SEGMENT = prove + (`!s. is_realinterval s <=> + !a b. a IN s /\ b IN s ==> real_segment[a,b] SUBSET s`, + REWRITE_TAC[CONVEX_CONTAINS_SEGMENT; IS_REALINTERVAL_CONVEX] THEN + REWRITE_TAC[REAL_SEGMENT_SEGMENT; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_IMAGE_LIFT_DROP]);; + +let IS_REALINTERVAL_CONTAINS_SEGMENT_EQ = prove + (`!s. is_realinterval s <=> + !a b. real_segment [a,b] SUBSET s <=> a IN s /\ b IN s`, + MESON_TAC[IS_REAL_INTERVAL_CONTAINS_SEGMENT; + SUBSET; ENDS_IN_REAL_SEGMENT]);; + +let IS_REALINTERVAL_CONTAINS_SEGMENT_IMP = prove + (`!s a b. is_realinterval s + ==> (real_segment [a,b] SUBSET s <=> a IN s /\ b IN s)`, + MESON_TAC[IS_REALINTERVAL_CONTAINS_SEGMENT_EQ]);; + +let IS_REALINTERVAL_SEGMENT = prove + (`(!a b. is_realinterval(real_segment[a,b])) /\ + (!a b. is_realinterval(real_segment(a,b)))`, + REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN + MESON_TAC[IS_REALINTERVAL_INTERVAL]);; + +let IN_REAL_SEGMENT = prove + (`(!a b x. x IN real_segment[a,b] <=> a <= x /\ x <= b \/ b <= x /\ x <= a) /\ + (!a b x. x IN real_segment(a,b) <=> a < x /\ x < b \/ b < x /\ x < a)`, + REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Convex real->real functions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("real_convex_on",(12,"right"));; + +let real_convex_on = new_definition + `(f:real->real) real_convex_on s <=> + !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ (u + v = &1) + ==> f(u * x + v * y) <= u * f(x) + v * f(y)`;; + +let REAL_CONVEX_ON = prove + (`!f s. f real_convex_on s <=> (f o drop) convex_on (IMAGE lift s)`, + REWRITE_TAC[real_convex_on; convex_on] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_THM; LIFT_DROP; DROP_ADD; DROP_CMUL]);; + +let REAL_CONVEX_ON_SUBSET = prove + (`!f s t. f real_convex_on t /\ s SUBSET t ==> f real_convex_on s`, + REWRITE_TAC[REAL_CONVEX_ON] THEN + MESON_TAC[CONVEX_ON_SUBSET; IMAGE_SUBSET]);; + +let REAL_CONVEX_ADD = prove + (`!s f g. f real_convex_on s /\ g real_convex_on s + ==> (\x. f(x) + g(x)) real_convex_on s`, + REWRITE_TAC[REAL_CONVEX_ON; o_DEF; CONVEX_ADD]);; + +let REAL_CONVEX_LMUL = prove + (`!s c f. &0 <= c /\ f real_convex_on s ==> (\x. c * f(x)) real_convex_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONVEX_ON; o_DEF] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVEX_CMUL) THEN REWRITE_TAC[]);; + +let REAL_CONVEX_RMUL = prove + (`!s c f. &0 <= c /\ f real_convex_on s ==> (\x. f(x) * c) real_convex_on s`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_CONVEX_LMUL]);; + +let REAL_CONVEX_CONVEX_COMPOSE = prove + (`!f g s:real^N->bool t. + f convex_on s /\ g real_convex_on t /\ + convex s /\ is_realinterval t /\ IMAGE f s SUBSET t /\ + (!x y. x IN t /\ y IN t /\ x <= y ==> g x <= g y) + ==> (g o f) convex_on s`, + REWRITE_TAC[convex_on; convex; IS_REALINTERVAL_CONVEX; + real_convex_on; SUBSET] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; o_DEF] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; DROP_ADD; DROP_CMUL; LIFT_DROP] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + ASM_MESON_TAC[REAL_LE_TRANS]);; + +let REAL_CONVEX_COMPOSE = prove + (`!f g. f real_convex_on s /\ g real_convex_on t /\ + is_realinterval s /\ is_realinterval t /\ IMAGE f s SUBSET t /\ + (!x y. x IN t /\ y IN t /\ x <= y ==> g x <= g y) + ==> (g o f) real_convex_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONVEX_ON; GSYM o_ASSOC] THEN + MATCH_MP_TAC REAL_CONVEX_CONVEX_COMPOSE THEN EXISTS_TAC `t:real->bool` THEN + ASM_REWRITE_TAC[GSYM REAL_CONVEX_ON; GSYM IMAGE_o; o_DEF; LIFT_DROP; + ETA_AX; GSYM IS_REALINTERVAL_CONVEX]);; + +let REAL_CONVEX_LOWER = prove + (`!f s x y. f real_convex_on s /\ + x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> f(u * x + v * y) <= max (f(x)) (f(y))`, + REWRITE_TAC[REAL_CONVEX_ON] THEN + REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP] THEN + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONVEX_LOWER) THEN + REWRITE_TAC[o_THM; DROP_ADD; DROP_CMUL]);; + +let REAL_CONVEX_LOCAL_GLOBAL_MINIMUM = prove + (`!f s t x. + f real_convex_on s /\ x IN t /\ real_open t /\ t SUBSET s /\ + (!y. y IN t ==> f(x) <= f(y)) + ==> !y. y IN s ==> f(x) <= f(y)`, + REWRITE_TAC[REAL_CONVEX_ON; REAL_OPEN] THEN + REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP] THEN + REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`(f:real->real) o drop`; `IMAGE lift s`; + `IMAGE lift t`; `x:real^1`] CONVEX_LOCAL_GLOBAL_MINIMUM) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_THM; IMAGE_SUBSET]);; + +let REAL_CONVEX_DISTANCE = prove + (`!s a. (\x. abs(a - x)) real_convex_on s`, + REWRITE_TAC[REAL_CONVEX_ON; o_DEF; FORALL_DROP; GSYM DROP_SUB] THEN + REWRITE_TAC[drop; GSYM NORM_REAL; GSYM dist; CONVEX_DISTANCE]);; + +let REAL_CONVEX_ON_JENSEN = prove + (`!f s. is_realinterval s + ==> (f real_convex_on s <=> + !k u x. + (!i:num. 1 <= i /\ i <= k ==> &0 <= u(i) /\ x(i) IN s) /\ + (sum (1..k) u = &1) + ==> f(sum (1..k) (\i. u(i) * x(i))) + <= sum (1..k) (\i. u(i) * f(x(i))))`, + REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONVEX_ON] THEN + SIMP_TAC[CONVEX_ON_JENSEN] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[o_DEF; DROP_VSUM; FINITE_NUMSEG] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `u:num->real` THEN REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `x:num->real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `lift o (x:num->real)`) THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP] THEN + REWRITE_TAC[DROP_CMUL; LIFT_DROP]; + X_GEN_TAC `x:num->real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop o (x:num->real^1)`) THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; IN_IMAGE_LIFT_DROP] THEN + ASM_REWRITE_TAC[DROP_CMUL; LIFT_DROP; GSYM IN_IMAGE_LIFT_DROP]]);; + +let REAL_CONVEX_ON_IMP_JENSEN = prove + (`!f s k:A->bool u x. + f real_convex_on s /\ is_realinterval s /\ FINITE k /\ + (!i. i IN k ==> &0 <= u i /\ x i IN s) /\ sum k u = &1 + ==> f(sum k (\i. u i * x i)) <= sum k (\i. u i * f(x i))`, + REWRITE_TAC[REAL_CONVEX_ON; IS_REALINTERVAL_IS_INTERVAL] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPECL [`k:A->bool`; `u:A->real`; `\i:A. lift(x i)`] o + MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] CONVEX_ON_IMP_JENSEN)) THEN + ASM_REWRITE_TAC[LIFT_IN_IMAGE_LIFT; o_DEF; LIFT_DROP; DROP_VSUM; DROP_CMUL; + GSYM IS_INTERVAL_CONVEX_1]);; + +let REAL_CONVEX_ON_CONTINUOUS = prove + (`!f s. real_open s /\ f real_convex_on s ==> f real_continuous_on s`, + REWRITE_TAC[REAL_CONVEX_ON; REAL_OPEN; REAL_CONTINUOUS_ON] THEN + REWRITE_TAC[CONVEX_ON_CONTINUOUS]);; + +let REAL_CONVEX_ON_LEFT_SECANT_MUL = prove + (`!f s. f real_convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN real_segment[a,b] + ==> (f x - f a) * abs(b - a) <= (f b - f a) * abs(x - a)`, + REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_LEFT_SECANT_MUL] THEN + REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_RIGHT_SECANT_MUL = prove + (`!f s. f real_convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN real_segment[a,b] + ==> (f b - f a) * abs(b - x) <= (f b - f x) * abs(b - a)`, + REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_RIGHT_SECANT_MUL] THEN + REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_LEFT_SECANT = prove + (`!f s. + f real_convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN real_segment(a,b) + ==> (f x - f a) / abs(x - a) <= (f b - f a) / abs(b - a)`, + REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_LEFT_SECANT] THEN + REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_RIGHT_SECANT = prove + (`!f s. + f real_convex_on s <=> + !a b x. a IN s /\ b IN s /\ x IN real_segment(a,b) + ==> (f b - f a) / abs(b - a) <= (f b - f x) / abs(b - x)`, + REWRITE_TAC[REAL_CONVEX_ON; CONVEX_ON_RIGHT_SECANT] THEN + REWRITE_TAC[REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_DERIVATIVE_SECANT_IMP = prove + (`!f f' s x y. + f real_convex_on s /\ real_segment[x,y] SUBSET s /\ + (f has_real_derivative f') (atreal x within s) + ==> f' * (y - x) <= f y - f x`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; + REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN + REWRITE_TAC[LIFT_DROP] THEN + REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP] + `\x. lift(drop(f % x))`)] THEN + REWRITE_TAC[GSYM o_DEF] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT_IMP) THEN + REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_SECANT_DERIVATIVE_IMP = prove + (`!f f' s x y. + f real_convex_on s /\ real_segment[x,y] SUBSET s /\ + (f has_real_derivative f') (atreal y within s) + ==> f y - f x <= f' * (y - x)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; + REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN + REWRITE_TAC[LIFT_DROP] THEN + REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP] + `\x. lift(drop(f % x))`)] THEN + REWRITE_TAC[GSYM o_DEF] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_SECANT_DERIVATIVE_IMP) THEN + REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_DERIVATIVES_IMP = prove + (`!f f'x f'y s x y. + f real_convex_on s /\ real_segment[x,y] SUBSET s /\ + (f has_real_derivative f'x) (atreal x within s) /\ + (f has_real_derivative f'y) (atreal y within s) + ==> f'x * (y - x) <= f'y * (y - x)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; + REAL_CONVEX_ON; REAL_SEGMENT_SEGMENT] THEN + REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_DROP] THEN + REWRITE_TAC[LIFT_DROP] THEN + REWRITE_TAC[GSYM IN_IMAGE_LIFT_DROP; GSYM SUBSET] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP] + `\x. lift(drop(f % x))`)] THEN + REWRITE_TAC[GSYM o_DEF] THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVEX_ON_DERIVATIVES_IMP) THEN + REWRITE_TAC[o_THM; DROP_CMUL; DROP_SUB; LIFT_DROP]);; + +let REAL_CONVEX_ON_DERIVATIVE_INCREASING_IMP = prove + (`!f f'x f'y s x y. + f real_convex_on s /\ real_interval[x,y] SUBSET s /\ + (f has_real_derivative f'x) (atreal x within s) /\ + (f has_real_derivative f'y) (atreal y within s) /\ + x < y + ==> f'x <= f'y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `f'x:real`; `f'y:real`; `s:real->bool`; + `x:real`; `y:real`] REAL_CONVEX_ON_DERIVATIVES_IMP) THEN + ASM_REWRITE_TAC[REAL_SEGMENT_INTERVAL] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_RMUL_EQ; REAL_SUB_LT]);; + +let REAL_CONVEX_ON_DERIVATIVE_SECANT = prove + (`!f f' s. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) + ==> (f real_convex_on s <=> + !x y. x IN s /\ y IN s ==> f'(x) * (y - x) <= f y - f x)`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; + REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN + REPEAT GEN_TAC THEN + REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF] + `lift o (\x. drop(f % x))`)] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVE_SECANT) THEN + REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);; + +let REAL_CONVEX_ON_SECANT_DERIVATIVE = prove + (`!f f' s. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) + ==> (f real_convex_on s <=> + !x y. x IN s /\ y IN s ==> f y - f x <= f'(y) * (y - x))`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; + REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN + REPEAT GEN_TAC THEN + REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF] + `lift o (\x. drop(f % x))`)] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_SECANT_DERIVATIVE) THEN + REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);; + +let REAL_CONVEX_ON_DERIVATIVES = prove + (`!f f' s. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) + ==> (f real_convex_on s <=> + !x y. x IN s /\ y IN s ==> f'(x) * (y - x) <= f'(y) * (y - x))`, + REWRITE_TAC[HAS_REAL_FRECHET_DERIVATIVE_WITHIN; + REAL_CONVEX_ON; IS_REALINTERVAL_CONVEX] THEN + REPEAT GEN_TAC THEN + REWRITE_TAC[FORALL_DROP; GSYM IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[LIFT_DROP; o_DEF] + `lift o (\x. drop(f % x))`)] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP CONVEX_ON_DERIVATIVES) THEN + REWRITE_TAC[DROP_CMUL; DROP_SUB; o_THM]);; + +let REAL_CONVEX_ON_DERIVATIVE_INCREASING = prove + (`!f f' s. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) + ==> (f real_convex_on s <=> + !x y. x IN s /\ y IN s /\ x <= y ==> f'(x) <= f'(y))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_CONVEX_ON_DERIVATIVES) THEN + EQ_TAC THEN DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN + ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE]; + DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y <= x`) THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `x:real`])] THEN + ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * (y - x) <= b * (y - x) <=> b * (x - y) <= a * (x - y)`] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_SUB_LT; REAL_LT_LE]]);; + +let HAS_REAL_DERIVATIVE_INCREASING_IMP = prove + (`!f f' s a b. + is_realinterval s /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) /\ + (!x. x IN s ==> &0 <= f'(x)) /\ + a IN s /\ b IN s /\ a <= b + ==> f(a) <= f(b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_interval[a,b] SUBSET s` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [is_realinterval]) THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `f':real->real`; `a:real`; `b:real`] + REAL_MVT_VERY_SIMPLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `s:real->bool` THEN ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC) THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_SUB_LE] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [ASM SET_TAC[]; ASM_REAL_ARITH_TAC]]);; + +let HAS_REAL_DERIVATIVE_INCREASING = prove + (`!f f' s. is_realinterval s /\ ~(?a. s = {a}) /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) + ==> ((!x. x IN s ==> &0 <= f'(x)) <=> + (!x y. x IN s /\ y IN s /\ x <= y ==> f(x) <= f(y)))`, + REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[HAS_REAL_DERIVATIVE_INCREASING_IMP]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `atreal x within s` REALLIM_LBOUND) THEN + EXISTS_TAC `\y:real. (f y - f x) / (y - x)` THEN + ASM_SIMP_TAC[GSYM HAS_REAL_DERIVATIVE_WITHINREAL] THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_WITHIN_REALINTERVAL] THEN + REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `y:real` THEN + REWRITE_TAC[REAL_ARITH `&0 < abs(y - x) <=> ~(y = x)`] THEN STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(y:real = x) ==> x < y \/ y < x`)) + THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN + REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_NEG; GSYM real_div]] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE]);; + +let HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP = prove + (`!f f' a b. + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) + + (atreal x within real_interval[a,b])) /\ + (!x. x IN real_interval(a,b) ==> &0 < f'(x)) /\ + a < b + ==> f(a) < f(b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `f':real->real`; `a:real`; `b:real`] + REAL_MVT) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_SUB_LT; REAL_LT_MUL]] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; + real_differentiable_on]; + ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET; SUBSET; + REAL_INTERVAL_OPEN_SUBSET_CLOSED; REAL_OPEN_REAL_INTERVAL; + HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN]]);; + +let REAL_CONVEX_ON_SECOND_DERIVATIVE = prove + (`!f f' f'' s. + is_realinterval s /\ ~(?a. s = {a}) /\ + (!x. x IN s ==> (f has_real_derivative f'(x)) (atreal x within s)) /\ + (!x. x IN s ==> (f' has_real_derivative f''(x)) (atreal x within s)) + ==> (f real_convex_on s <=> !x. x IN s ==> &0 <= f''(x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `!x y. x IN s /\ y IN s /\ x <= y ==> (f':real->real)(x) <= f'(y)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONVEX_ON_DERIVATIVE_INCREASING; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_INCREASING] THEN + ASM_REWRITE_TAC[]);; + +let REAL_CONVEX_ON_ASYM = prove + (`!s f. f real_convex_on s <=> + !x y u v. + x IN s /\ y IN s /\ x < y /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> f (u * x + v * y) <= u * f x + v * f y`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_convex_on] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_WLOG_LT THEN + SIMP_TAC[GSYM REAL_ADD_RDISTRIB; REAL_MUL_LID; REAL_LE_REFL] THEN + ASM_MESON_TAC[REAL_ADD_SYM]);; + +let REAL_CONVEX_ON_EXP = prove + (`!s. exp real_convex_on s`, + GEN_TAC THEN MATCH_MP_TAC REAL_CONVEX_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + MP_TAC(ISPECL [`exp`; `exp`; `exp`; `(:real)`] + REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN + SIMP_TAC[HAS_REAL_DERIVATIVE_EXP; REAL_EXP_POS_LE; + HAS_REAL_DERIVATIVE_ATREAL_WITHIN; IS_REALINTERVAL_UNIV] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC(SET_RULE + `&0 IN s /\ &1 IN s /\ ~(&1 = &0) ==> ~(?a. s = {a})`) THEN + REWRITE_TAC[IN_UNIV] THEN REAL_ARITH_TAC);; + +let REAL_CONVEX_ON_RPOW = prove + (`!s t. s SUBSET {x | &0 <= x} /\ &1 <= t + ==> (\x. x rpow t) real_convex_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONVEX_ON_SUBSET THEN + EXISTS_TAC `{x | &0 <= x}` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\x. x rpow t) real_convex_on {x | &0 < x}` MP_TAC THENL + [MP_TAC(ISPECL + [`\x. x rpow t`; `\x. t * x rpow (t - &1)`; + `\x. t * (t - &1) * x rpow (t - &2)`; `{x | &0 < x}`] + REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(SET_RULE + `&1 IN s /\ &2 IN s /\ ~(&1 = &2) ==> ~(?a. s = {a})`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + ASM_REWRITE_TAC[REAL_ARITH `t - &1 - &1 = t - &2`] THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REPEAT STRIP_TAC THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC RPOW_POS_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]; + REWRITE_TAC[REAL_CONVEX_ON_ASYM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_CASES_TAC `x = &0` THENL + [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[RPOW_ZERO; REAL_ARITH `&1 <= t ==> ~(t = &0)`] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN + ASM_CASES_TAC `v = &0` THEN + ASM_SIMP_TAC[RPOW_ZERO; REAL_ARITH `&1 <= t ==> ~(t = &0)`; + REAL_MUL_LZERO; REAL_LE_REFL] THEN + ASM_SIMP_TAC[RPOW_MUL; REAL_LT_LE] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[RPOW_POS_LE; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `exp(&1 * log v)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[rpow; REAL_LT_LE; REAL_EXP_MONO_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * l <= b * l <=> --l * b <= --l * a`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM LOG_INV; REAL_LT_LE] THEN MATCH_MP_TAC LOG_POS THEN + MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_MUL_LID; EXP_LOG; REAL_LT_LE; REAL_LE_REFL]]; + ASM_MESON_TAC[REAL_LT_LE; REAL_LET_TRANS]]]);; + +let REAL_CONVEX_ON_LOG = prove + (`!s. s SUBSET {x | &0 < x} ==> (\x. --log x) real_convex_on s`, + GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_CONVEX_ON_SUBSET) THEN + MP_TAC(ISPECL [`\x. --log x`; `\x:real. --inv(x)`; `\x:real. inv(x pow 2)`; + `{x | &0 < x}`] + REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN + REWRITE_TAC[IN_ELIM_THM; REAL_LE_INV_EQ; REAL_LE_POW_2] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + MESON_TAC[REAL_ARITH `&0 < a ==> &0 < a + &1 /\ ~(a + &1 = a)`]; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN ASM_REAL_ARITH_TAC]);; + +let REAL_CONTINUOUS_MIDPOINT_CONVEX = prove + (`!f s. f real_continuous_on s /\ is_realinterval s /\ + (!x y. x IN s /\ y IN s ==> f ((x + y) / &2) <= (f x + f y) / &2) + ==> f real_convex_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONVEX_ON] THEN + MATCH_MP_TAC CONTINUOUS_MIDPOINT_CONVEX THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IS_REALINTERVAL_CONVEX] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[midpoint; LIFT_DROP; o_THM; DROP_CMUL; DROP_ADD] THEN + ASM_SIMP_TAC[REAL_ARITH `inv(&2) * x = x / &2`]);; + +(* ------------------------------------------------------------------------- *) +(* Some convexity-derived inequalities including AGM and Young's inequality. *) +(* ------------------------------------------------------------------------- *) + +let AGM_GEN = prove + (`!a x k:A->bool. + FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 <= a i /\ &0 <= x i) + ==> product k (\i. x i rpow a i) <= sum k (\i. a i * x i)`, + let version1 = prove + (`!a x k:A->bool. + FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 < a i /\ &0 < x i) + ==> product k (\i. x i rpow a i) <= sum k (\i. a i * x i)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `k:A->bool = {}` THEN + ASM_REWRITE_TAC[SUM_CLAUSES; REAL_OF_NUM_EQ; ARITH_EQ] THEN STRIP_TAC THEN + MATCH_MP_TAC LOG_MONO_LE_REV THEN + ASM_SIMP_TAC[PRODUCT_POS_LT; RPOW_POS_LT; LOG_PRODUCT; LOG_RPOW; + SUM_POS_LT_ALL; REAL_LT_MUL] THEN + MP_TAC(ISPECL [`\x. --log x`; `{x | &0 < x}`; `k:A->bool`; `a:A->real`; + `x:A->real`] REAL_CONVEX_ON_IMP_JENSEN) THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_CONVEX_ON_LOG; SUBSET_REFL; REAL_LT_IMP_LE; + is_realinterval] THEN + REWRITE_TAC[REAL_MUL_RNEG; SUM_NEG; REAL_LE_NEG2] THEN + DISCH_THEN MATCH_MP_TAC THEN REAL_ARITH_TAC) in + let version2 = prove + (`!a x k:A->bool. + FINITE k /\ sum k a = &1 /\ (!i. i IN k ==> &0 < a i /\ &0 <= x i) + ==> product k (\i. x i rpow a i) <= sum k (\i. a i * x i)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `?i:A. i IN k /\ x i = &0` THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ x = &0 ==> x <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0] THEN + ASM_MESON_TAC[REAL_LT_IMP_NZ]]; + MATCH_MP_TAC version1 THEN ASM_MESON_TAC[REAL_LT_LE]]) in + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `product {i:A | i IN k /\ ~(a i = &0)} (\i. x i rpow a i) + <= sum {i:A | i IN k /\ ~(a i = &0)} (\i. a i * x i)` + MP_TAC THENL + [MATCH_MP_TAC version2 THEN + ASM_SIMP_TAC[FINITE_RESTRICT; REAL_LT_LE; IN_ELIM_THM] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD]; + MATCH_MP_TAC EQ_IMP THEN CONV_TAC SYM_CONV THEN BINOP_TAC THENL + [MATCH_MP_TAC PRODUCT_SUPERSET; + MATCH_MP_TAC SUM_SUPERSET] THEN + SIMP_TAC[IN_ELIM_THM; SUBSET_RESTRICT; IMP_CONJ; RPOW_0] THEN + REWRITE_TAC[REAL_MUL_LZERO]]);; + +let AGM_RPOW = prove + (`!k:A->bool x n. + k HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN k ==> &0 <= x(i)) + ==> product k (\i. x(i) rpow (&1 / &n)) <= sum k (\i. x(i) / &n)`, + REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\i:A. &1 / &n`; `x:A->real`; `k:A->bool`] + AGM_GEN) THEN + ASM_SIMP_TAC[SUM_CONST; REAL_LE_DIV; REAL_OF_NUM_LT; LE_1; ARITH; + REAL_DIV_LMUL; REAL_OF_NUM_EQ; REAL_POS] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_AC]);; + +let AGM_ROOT = prove + (`!k:A->bool x n. + k HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN k ==> &0 <= x(i)) + ==> root n (product k x) <= sum k x / &n`, + REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ROOT_PRODUCT; real_div; GSYM SUM_RMUL] THEN + ASM_SIMP_TAC[REAL_ROOT_RPOW; GSYM real_div] THEN + REWRITE_TAC[REAL_ARITH `inv(x) = &1 / x`] THEN + MATCH_MP_TAC AGM_RPOW THEN ASM_REWRITE_TAC[HAS_SIZE]);; + +let AGM_SQRT = prove + (`!x y. &0 <= x /\ &0 <= y ==> sqrt(x * y) <= (x + y) / &2`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPECL [`{0,1}`; `\n. if n = 0 then (x:real) else y`; `2`] AGM_ROOT) THEN + SIMP_TAC[SUM_CLAUSES; PRODUCT_CLAUSES; FINITE_RULES] THEN + REWRITE_TAC[ARITH_EQ; IN_INSERT; NOT_IN_EMPTY; + HAS_SIZE_CONV`s HAS_SIZE 2 `] THEN + ASM_SIMP_TAC[ROOT_2; REAL_MUL_RID; REAL_ADD_RID; + REAL_ARITH `x / &2 + y / &2 = (x + y) / &2`] THEN + ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`]);; + +let AGM = prove + (`!k:A->bool x n. + k HAS_SIZE n /\ ~(n = 0) /\ (!i. i IN k ==> &0 <= x(i)) + ==> product k x <= (sum k x / &n) pow n`, + REWRITE_TAC[HAS_SIZE] THEN REPEAT STRIP_TAC THEN + TRANS_TAC REAL_LE_TRANS `root n (product (k:A->bool) x) pow n` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_POW_ROOT; PRODUCT_POS_LE; REAL_LE_REFL]; + MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[AGM_ROOT; HAS_SIZE; ROOT_LE_0; PRODUCT_POS_LE]]);; + +let AGM_2 = prove + (`!x y u v. + &0 <= x /\ &0 <= y /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> x rpow u * y rpow v <= u * x + v * y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\i. if i = 0 then u:real else v`; + `\i. if i = 0 then x:real else y`; `0..SUC 0`] + AGM_GEN) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; PRODUCT_CLAUSES_NUMSEG; ARITH] THEN + REWRITE_TAC[FINITE_NUMSEG] THEN ASM_MESON_TAC[]);; + +let YOUNG_INEQUALITY = prove + (`!a b p q. &0 <= a /\ &0 <= b /\ &0 < p /\ &0 < q /\ inv(p) + inv(q) = &1 + ==> a * b <= a rpow p / p + b rpow q / q`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a rpow p`; `b rpow q`; `inv p:real`; `inv q:real`] + AGM_2) THEN + ASM_SIMP_TAC[RPOW_RPOW; RPOW_POS_LE; REAL_LE_INV_EQ; REAL_LT_IMP_LE; + REAL_MUL_RINV; RPOW_POW; REAL_POW_1; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC);; + +let HOELDER = prove + (`!k:A->bool a x y. + FINITE k /\ sum k a = &1 /\ + (!i. i IN k ==> &0 <= a i /\ &0 <= x i /\ &0 <= y i) + ==> product k (\i. x i rpow a i) + product k (\i. y i rpow a i) + <= product k (\i. (x i + y i) rpow a i)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= product (k:A->bool) (\i. (x i + y i) rpow a i)` + MP_TAC THENL + [MATCH_MP_TAC PRODUCT_POS_LE THEN ASM_SIMP_TAC[REAL_LE_ADD; RPOW_POS_LE]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0; TAUT `p /\ q <=> ~(p ==> ~q)`; + REAL_ARITH `&0 <= x /\ &0 <= y ==> (x + y = &0 <=> x = &0 /\ y = &0)`] THEN + REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `x = &0 /\ y = &0 /\ z = &0 ==> x + y <= z`) THEN + ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0] THEN ASM_MESON_TAC[REAL_ADD_LID]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID]] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; GSYM PRODUCT_DIV; GSYM RPOW_DIV; + REAL_ARITH `(x + y) / z:real = x / z + y / z`] THEN + ASM_SIMP_TAC[GSYM RPOW_PRODUCT] THEN + TRANS_TAC REAL_LE_TRANS + `sum k (\i:A. a i * (x i / (x i + y i))) + + sum k (\i. a i * (y i / (x i + y i)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN MATCH_MP_TAC AGM_GEN THEN + ASM_SIMP_TAC[REAL_LE_ADD; REAL_LE_DIV]; + ASM_SIMP_TAC[GSYM SUM_ADD]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `s = &1 ==> p = s ==> p <= &1`)) THEN + MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `i:A` THEN DISCH_TAC THEN + ASM_CASES_TAC `(a:A->real) i = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN + ASM_SIMP_TAC[PRODUCT_EQ_0; RPOW_EQ_0; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `i:A`) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Some other inequalities where it's handy just to use calculus. *) +(* ------------------------------------------------------------------------- *) + +let RPOW_MINUS1_QUOTIENT_LT = prove + (`!a x y. &0 < a /\ ~(a = &1) /\ &0 < x /\ x < y + ==> (a rpow x - &1) / x < (a rpow y - &1) / y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. (a rpow x - &1) / x`; + `\x. log a * a rpow x / x - (a rpow x - &1) / x pow 2`; + `x:real`; `y:real`] + HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[rpow] THEN REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < z` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `(z:real) pow 2` THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_MUL_RZERO; REAL_FIELD + `&0 < x ==> x pow 2 * (a * b / x - c / x pow 2) = a * b * x - c`] THEN + REWRITE_TAC[REAL_ARITH `l * a * z - (a - &1) = a * (l * z - &1) + &1`] THEN + MP_TAC(ISPECL [`\x. a rpow x * (log a * x - &1) + &1`; + `\x. log(a) pow 2 * x * a rpow x`; + `&0`; `z:real`] + HAS_REAL_DERIVATIVE_STRICTLY_INCREASING_IMP) THEN + ASM_REWRITE_TAC[RPOW_0] THEN + ANTS_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + ASM_SIMP_TAC[RPOW_POS_LT; REAL_LT_POW_2] THEN + ASM_SIMP_TAC[GSYM LOG_1; LOG_INJ; REAL_LT_01]]);; + +let RPOW_MINUS1_QUOTIENT_LE = prove + (`!a x y. &0 < a /\ &0 < x /\ x <= y + ==> (a rpow x - &1) / x <= (a rpow y - &1) / y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:real = y` THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_CASES_TAC `a = &1` THEN + ASM_REWRITE_TAC[real_div; RPOW_ONE; REAL_SUB_REFL; REAL_MUL_LZERO; + REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LE_LT; GSYM real_div; RPOW_MINUS1_QUOTIENT_LT]);; + +let REAL_EXP_LIMIT_RPOW_LT = prove + (`!x r s. &0 < r /\ r < s /\ ~(x = &0) /\ x < r + ==> (&1 - x / r) rpow r < (&1 - x / s) rpow s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < s` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &1 - x / s` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(&1 - x / s) rpow (inv r)`; `r:real`; `s:real`] + RPOW_MINUS1_QUOTIENT_LT) THEN + ASM_SIMP_TAC[RPOW_RPOW; REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_LT_IMP_LE; + RPOW_POW; REAL_POW_1; RPOW_POS_LT] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[rpow; GSYM REAL_EXP_0; REAL_EXP_INJ] THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_INV_EQ_0; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[REAL_EXP_0] THEN + ASM_SIMP_TAC[GSYM LOG_1; LOG_INJ; REAL_LT_01] THEN + REWRITE_TAC[REAL_ARITH `a - x = a <=> x = &0`; REAL_DIV_EQ_0] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `(&1 - x / s - &1) / r = --(x / r) / s`] THEN + ASM_SIMP_TAC[REAL_LT_DIV2_EQ; REAL_ARITH + `--x < a - &1 <=> &1 - x < a`] THEN + DISCH_THEN(MP_TAC o SPEC `r:real` o MATCH_MP(MESON[RPOW_LT2] + `x < y ==> !z. &0 <= x /\ &0 < z ==> x rpow z < y rpow z`)) THEN + ASM_SIMP_TAC[RPOW_RPOW; REAL_LT_IMP_LE; REAL_FIELD + `&0 < r ==> (inv r * s) * r = s`] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC]);; + +let REAL_EXP_LIMIT_RPOW_LE = prove + (`!x r s. &0 <= r /\ r <= s /\ x <= r + ==> (&1 - x / r) rpow r <= (&1 - x / s) rpow s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_SUB_RZERO; RPOW_ONE]; + ALL_TAC] THEN + ASM_CASES_TAC `r:real = s` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_CASES_TAC `r:real = x` THENL + [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_SUB_REFL; RPOW_ZERO] THEN + STRIP_TAC THEN MATCH_MP_TAC RPOW_POS_LE THEN + REWRITE_TAC[REAL_SUB_LE] THEN + SUBGOAL_THEN `&0 < s` (fun th -> SIMP_TAC[th; REAL_LE_LDIV_EQ]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[REAL_LE_LT; REAL_EXP_LIMIT_RPOW_LT] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_LT; RPOW_POW; real_pow] THEN + ASM_SIMP_TAC[rpow; REAL_SUB_LT; REAL_LT_LDIV_EQ] THEN COND_CASES_TAC THENL + [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_REAL_ARITH_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_0] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC LOG_POS THEN + REWRITE_TAC[REAL_ARITH `&1 <= &1 - x / y <=> &0 <= --x / y`] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC);; + +let REAL_LE_X_SINH = prove + (`!x. &0 <= x ==> x <= (exp x - inv(exp x)) / &2`, + SUBGOAL_THEN + `!a b. a <= b + ==> exp a - inv(exp a) - &2 * a <= exp b - inv(exp b) - &2 * b` + (MP_TAC o SPEC `&0`) + THENL + [MP_TAC(ISPECL + [`\x. exp x - exp(--x) - &2 * x`; `\x. exp x + exp(--x) - &2`; `(:real)`] + HAS_REAL_DERIVATIVE_INCREASING) THEN + REWRITE_TAC[IN_ELIM_THM; IS_REALINTERVAL_UNIV; IN_UNIV] THEN ANTS_TAC THENL + [CONJ_TAC THENL [SET_TAC[REAL_ARITH `~(&1 = &0)`]; ALL_TAC] THEN + GEN_TAC THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC; + SIMP_TAC[REAL_EXP_NEG] THEN DISCH_THEN(fun th -> SIMP_TAC[GSYM th]) THEN + X_GEN_TAC `x:real` THEN + SIMP_TAC[REAL_EXP_NZ; REAL_FIELD + `~(e = &0) ==> e + inv e - &2 = (e - &1) pow 2 / e`] THEN + SIMP_TAC[REAL_EXP_POS_LE; REAL_LE_DIV; REAL_LE_POW_2]]; + MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[REAL_EXP_0] THEN + REAL_ARITH_TAC]);; + +let REAL_LE_ABS_SINH = prove + (`!x. abs x <= abs((exp x - inv(exp x)) / &2)`, + GEN_TAC THEN ASM_CASES_TAC `&0 <= x` THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN + ASM_SIMP_TAC[REAL_LE_X_SINH]; + MATCH_MP_TAC(REAL_ARITH `~(&0 <= x) /\ --x <= --y ==> abs x <= abs y`) THEN + ASM_REWRITE_TAC[REAL_ARITH `--((a - b) / &2) = (b - a) / &2`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(exp(--x) - inv(exp(--x))) / &2` THEN + ASM_SIMP_TAC[REAL_LE_X_SINH; REAL_ARITH `~(&0 <= x) ==> &0 <= --x`] THEN + REWRITE_TAC[REAL_EXP_NEG; REAL_INV_INV] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Log-convex functions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("log_convex_on",(12,"right"));; + +let log_convex_on = new_definition + `f log_convex_on (s:real^N->bool) <=> + (!x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> &0 <= f(u % x + v % y) /\ + f(u % x + v % y) <= f(x) rpow u * f(y) rpow v)`;; + +let LOG_CONVEX_ON_SUBSET = prove + (`!f s t. f log_convex_on t /\ s SUBSET t ==> f log_convex_on s`, + REWRITE_TAC[log_convex_on] THEN SET_TAC[]);; + +let LOG_CONVEX_IMP_POS = prove + (`!f s x:real^N. + f log_convex_on s /\ x IN s ==> &0 <= f x`, + REWRITE_TAC[log_convex_on] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `x:real^N`; `&0`; `&1`]) THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_MESON_TAC[]);; + +let LOG_CONVEX_ON_CONVEX = prove + (`!f s:real^N->bool. + convex s + ==> (f log_convex_on s <=> + (!x. x IN s ==> &0 <= f x) /\ + !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> f(u % x + v % y) <= f(x) rpow u * f(y) rpow v)`, + REWRITE_TAC[convex] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [ASM_MESON_TAC[LOG_CONVEX_IMP_POS]; + ASM_MESON_TAC[log_convex_on]; + ASM_SIMP_TAC[log_convex_on] THEN ASM_MESON_TAC[]]);; + +let LOG_CONVEX_ON = prove + (`!f s:real^N->bool. + convex s /\ (!x. x IN s ==> &0 < f x) + ==> (f log_convex_on s <=> (log o f) convex_on s)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOG_CONVEX_ON_CONVEX; REAL_LT_IMP_LE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[convex]) THEN REWRITE_TAC[convex_on; o_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o funpow 4 BINDER_CONV o RAND_CONV) + [GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; rpow; REAL_EXP_ADD]);; + +let LOG_CONVEX_IMP_CONVEX = prove + (`!f s:real^N->bool. f log_convex_on s ==> f convex_on s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + LOG_CONVEX_IMP_POS)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[log_convex_on]) THEN REWRITE_TAC[convex_on] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`x:real^N`; `y:real^N`; `u:real`; `v:real`]) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC AGM_2 THEN ASM_SIMP_TAC[]);; + +let LOG_CONVEX_ADD = prove + (`!f g s:real^N->bool. + f log_convex_on s /\ g log_convex_on s + ==> (\x. f x + g x) log_convex_on s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(CONJUNCTS_THEN(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + LOG_CONVEX_IMP_POS))) THEN + REWRITE_TAC[log_convex_on] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (ASSUME_TAC o REWRITE_RULE[log_convex_on])) THEN + REWRITE_TAC[log_convex_on] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `u:real`; `v:real`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_ADD] THEN + MP_TAC(ISPEC `0..SUC 0` HOELDER) THEN + SIMP_TAC[PRODUCT_CLAUSES_NUMSEG; + FINITE_NUMSEG; SUM_CLAUSES_NUMSEG; ARITH] THEN + DISCH_THEN(MP_TAC o SPECL + [`\i. if i = 0 then u:real else v`; + `\i. if i = 0 then (f:real^N->real) x else f y`; + `\i. if i = 0 then (g:real^N->real) x else g y`]) THEN + REWRITE_TAC[ARITH] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_MESON_TAC[]);; + +let LOG_CONVEX_MUL = prove + (`!f g s:real^N->bool. + f log_convex_on s /\ g log_convex_on s + ==> (\x. f x * g x) log_convex_on s`, + REWRITE_TAC[log_convex_on] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_MUL; RPOW_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a * b) * (c * d):real = (a * c) * (b * d)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL2]);; + +let MIDPOINT_LOG_CONVEX = prove + (`!f s:real^N->bool. + (lift o f) continuous_on s /\ convex s /\ + (!x. x IN s ==> &0 < f x) /\ + (!x y. x IN s /\ y IN s ==> f(midpoint(x,y)) pow 2 <= f(x) * f(y)) + ==> f log_convex_on s`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LOG_CONVEX_ON] THEN + MATCH_MP_TAC CONTINUOUS_MIDPOINT_CONVEX THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `lift o log o (f:real^N->real) = + (lift o log o drop) o (lift o f)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; IMAGE_o] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LOG THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE]; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + REWRITE_TAC[o_DEF; REAL_ARITH `x <= y / &2 <=> &2 * x <= y`] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_EXP_ADD; MIDPOINT_IN_CONVEX]]);; + +let LOG_CONVEX_CONST = prove + (`!s a. &0 <= a ==> (\x. a) log_convex_on s`, + SIMP_TAC[log_convex_on; GSYM RPOW_ADD] THEN + IMP_REWRITE_TAC[GSYM RPOW_ADD_ALT] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL] THEN REAL_ARITH_TAC);; + +let LOG_CONVEX_PRODUCT = prove + (`!f s k. FINITE k /\ (!i. i IN k ==> (\x. f x i) log_convex_on s) + ==> (\x. product k (f x)) log_convex_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; LOG_CONVEX_CONST; REAL_POS] THEN + SIMP_TAC[FORALL_IN_INSERT; LOG_CONVEX_MUL]);; + +(* ------------------------------------------------------------------------- *) +(* Real log-convex functions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("real_log_convex_on",(12,"right"));; + +let real_log_convex_on = new_definition + `(f:real->real) real_log_convex_on s <=> + (!x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> &0 <= f(u * x + v * y) /\ + f(u * x + v * y) <= f(x) rpow u * f(y) rpow v)`;; + +let REAL_LOG_CONVEX_ON_SUBSET = prove + (`!f s t. f real_log_convex_on t /\ s SUBSET t ==> f real_log_convex_on s`, + REWRITE_TAC[real_log_convex_on] THEN SET_TAC[]);; + +let REAL_LOG_CONVEX_LOG_CONVEX = prove + (`!f s. f real_log_convex_on s <=> (f o drop) log_convex_on (IMAGE lift s)`, + REWRITE_TAC[real_log_convex_on; log_convex_on] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP]);; + +let REAL_LOG_CONVEX_IMP_POS = prove + (`!f s x. + f real_log_convex_on s /\ x IN s ==> &0 <= f x`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; REAL_LOG_CONVEX_LOG_CONVEX] THEN + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] LOG_CONVEX_IMP_POS)) THEN + REWRITE_TAC[o_DEF; FORALL_IN_IMAGE; LIFT_DROP]);; + +let REAL_LOG_CONVEX_ON_CONVEX = prove + (`!f s. + is_realinterval s + ==> (f real_log_convex_on s <=> + (!x. x IN s ==> &0 <= f x) /\ + !x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> f(u * x + v * y) <= f(x) rpow u * f(y) rpow v)`, + REWRITE_TAC[REAL_CONVEX] THEN REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [ASM_MESON_TAC[REAL_LOG_CONVEX_IMP_POS]; + ASM_MESON_TAC[real_log_convex_on]; + ASM_SIMP_TAC[real_log_convex_on] THEN ASM_MESON_TAC[]]);; + +let REAL_LOG_CONVEX_ON = prove + (`!f s:real->bool. + is_realinterval s /\ (!x. x IN s ==> &0 < f x) + ==> (f real_log_convex_on s <=> (log o f) real_convex_on s)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LOG_CONVEX_ON_CONVEX; REAL_LT_IMP_LE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_CONVEX]) THEN + REWRITE_TAC[real_convex_on; o_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o funpow 4 BINDER_CONV o RAND_CONV) + [GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; rpow; REAL_EXP_ADD]);; + +let REAL_LOG_CONVEX_IMP_CONVEX = prove + (`!f s:real->bool. f real_log_convex_on s ==> f real_convex_on s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LOG_CONVEX_IMP_POS)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_log_convex_on]) THEN + REWRITE_TAC[real_convex_on] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `u:real`; `v:real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o SPECL [`x:real`; `y:real`; `u:real`; `v:real`]) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC AGM_2 THEN ASM_SIMP_TAC[]);; + +let REAL_LOG_CONVEX_ADD = prove + (`!f g s:real->bool. + f real_log_convex_on s /\ g real_log_convex_on s + ==> (\x. f x + g x) real_log_convex_on s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(CONJUNCTS_THEN(ASSUME_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LOG_CONVEX_IMP_POS))) THEN + REWRITE_TAC[real_log_convex_on] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN + (ASSUME_TAC o REWRITE_RULE[real_log_convex_on])) THEN + REWRITE_TAC[real_log_convex_on] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `u:real`; `v:real`] THEN + STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_ADD] THEN + MP_TAC(ISPEC `0..SUC 0` HOELDER) THEN + SIMP_TAC[PRODUCT_CLAUSES_NUMSEG; + FINITE_NUMSEG; SUM_CLAUSES_NUMSEG; ARITH] THEN + DISCH_THEN(MP_TAC o SPECL + [`\i. if i = 0 then u:real else v`; + `\i. if i = 0 then (f:real->real) x else f y`; + `\i. if i = 0 then (g:real->real) x else g y`]) THEN + REWRITE_TAC[ARITH] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_MESON_TAC[]);; + +let REAL_LOG_CONVEX_MUL = prove + (`!f g s:real->bool. + f real_log_convex_on s /\ g real_log_convex_on s + ==> (\x. f x * g x) real_log_convex_on s`, + REWRITE_TAC[real_log_convex_on] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_MUL; RPOW_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a * b) * (c * d):real = (a * c) * (b * d)`] THEN + ASM_SIMP_TAC[REAL_LE_MUL2]);; + +let MIDPOINT_REAL_LOG_CONVEX = prove + (`!f s:real->bool. + f real_continuous_on s /\ is_realinterval s /\ + (!x. x IN s ==> &0 < f x) /\ + (!x y. x IN s /\ y IN s ==> f((x + y) / &2) pow 2 <= f(x) * f(y)) + ==> f real_log_convex_on s`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_LOG_CONVEX_ON] THEN + MATCH_MP_TAC REAL_CONTINUOUS_MIDPOINT_CONVEX THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LOG THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE]; + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN + REWRITE_TAC[o_DEF; REAL_ARITH `x <= y / &2 <=> &2 * x <= y`] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_EXP_ADD; REAL_MIDPOINT_IN_CONVEX]]);; + +let REAL_LOG_CONVEX_CONST = prove + (`!s a. &0 <= a ==> (\x. a) real_log_convex_on s`, + SIMP_TAC[real_log_convex_on; GSYM RPOW_ADD] THEN + IMP_REWRITE_TAC[GSYM RPOW_ADD_ALT] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1; REAL_LE_REFL] THEN REAL_ARITH_TAC);; + +let REAL_LOG_CONVEX_PRODUCT = prove + (`!f s k. FINITE k /\ (!i. i IN k ==> (\x. f x i) real_log_convex_on s) + ==> (\x. product k (f x)) real_log_convex_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_LOG_CONVEX_CONST; REAL_POS] THEN + SIMP_TAC[FORALL_IN_INSERT; REAL_LOG_CONVEX_MUL]);; + +let REAL_LOG_CONVEX_RPOW_RIGHT = prove + (`!s a. &0 < a ==> (\x. a rpow x) real_log_convex_on s`, + SIMP_TAC[real_log_convex_on; RPOW_POS_LE; REAL_LT_IMP_LE] THEN + SIMP_TAC[DROP_ADD; DROP_CMUL; RPOW_ADD; RPOW_RPOW; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_MUL_AC; REAL_LE_REFL]);; + +let REAL_LOG_CONVEX_LIM = prove + (`!net:A net f g s. + ~(trivial_limit net) /\ + (!x y u v. x IN s /\ y IN s /\ &0 <= u /\ &0 <= v /\ u + v = &1 + ==> ((\i. f i (u * x + v * y)) ---> g(u * x + v * y)) net) /\ + eventually (\i. (f i) real_log_convex_on s) net + ==> g real_log_convex_on s`, + REWRITE_TAC[real_log_convex_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_SUB_LE] THEN + CONJ_TAC THEN MATCH_MP_TAC(ISPEC `net:A net` REALLIM_LBOUND) THENL + [EXISTS_TAC `\i. (f:A->real->real) i (u * x + v * y)`; + EXISTS_TAC `\i. (f:A->real->real) i x rpow u * f i y rpow v - + f i (u * x + v * y)`] THEN + ASM_SIMP_TAC[] THEN TRY CONJ_TAC THEN + TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + EVENTUALLY_MONO))) THEN + ASM_SIMP_TAC[REAL_SUB_LE] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[] (ISPEC `\x. x rpow y` + REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RPOW] THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `x:real`; `&1`; `&0`]); + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `y:real`; `&1`; `&0`])] THEN + ASM_REWRITE_TAC[REAL_POS; REAL_ADD_RID; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Integrals of real->real functions; measures of real sets. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_real_integral",(12,"right"));; +parse_as_infix("real_integrable_on",(12,"right"));; +parse_as_infix("absolutely_real_integrable_on",(12,"right"));; +parse_as_infix("has_real_measure",(12,"right"));; + +let has_real_integral = new_definition + `(f has_real_integral y) s <=> + ((lift o f o drop) has_integral (lift y)) (IMAGE lift s)`;; + +let real_integrable_on = new_definition + `f real_integrable_on i <=> ?y. (f has_real_integral y) i`;; + +let real_integral = new_definition + `real_integral i f = @y. (f has_real_integral y) i`;; + +let real_negligible = new_definition + `real_negligible s <=> negligible (IMAGE lift s)`;; + +let absolutely_real_integrable_on = new_definition + `f absolutely_real_integrable_on s <=> + f real_integrable_on s /\ (\x. abs(f x)) real_integrable_on s`;; + +let has_real_measure = new_definition + `s has_real_measure m <=> ((\x. &1) has_real_integral m) s`;; + +let real_measurable = new_definition + `real_measurable s <=> ?m. s has_real_measure m`;; + +let real_measure = new_definition + `real_measure s = @m. s has_real_measure m`;; + +let HAS_REAL_INTEGRAL = prove + (`(f has_real_integral y) (real_interval[a,b]) <=> + ((lift o f o drop) has_integral (lift y)) (interval[lift a,lift b])`, + REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL]);; + +let REAL_INTEGRABLE_INTEGRAL = prove + (`!f i. f real_integrable_on i + ==> (f has_real_integral (real_integral i f)) i`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_integrable_on; real_integral] THEN + CONV_TAC(RAND_CONV SELECT_CONV) THEN REWRITE_TAC[]);; + +let HAS_REAL_INTEGRAL_INTEGRABLE = prove + (`!f i s. (f has_real_integral i) s ==> f real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[]);; + +let HAS_REAL_INTEGRAL_INTEGRAL = prove + (`!f s. f real_integrable_on s <=> + (f has_real_integral (real_integral s f)) s`, + MESON_TAC[REAL_INTEGRABLE_INTEGRAL; HAS_REAL_INTEGRAL_INTEGRABLE]);; + +let HAS_REAL_INTEGRAL_UNIQUE = prove + (`!f i k1 k2. + (f has_real_integral k1) i /\ (f has_real_integral k2) i ==> k1 = k2`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[LIFT_EQ]);; + +let REAL_INTEGRAL_UNIQUE = prove + (`!f y k. + (f has_real_integral y) k ==> real_integral k f = y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]);; + +let HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL = prove + (`!f i s. + (f has_real_integral i) s <=> + f real_integrable_on s /\ real_integral s f = i`, + MESON_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_INTEGRAL_UNIQUE; + real_integrable_on]);; + +let REAL_INTEGRAL_EQ_HAS_INTEGRAL = prove + (`!s f y. f real_integrable_on s + ==> (real_integral s f = y <=> (f has_real_integral y) s)`, + MESON_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_INTEGRAL_UNIQUE]);; + +let REAL_INTEGRABLE_ON = prove + (`f real_integrable_on s <=> + (lift o f o drop) integrable_on (IMAGE lift s)`, + REWRITE_TAC[real_integrable_on; has_real_integral; EXISTS_DROP; + integrable_on; LIFT_DROP]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ON = prove + (`f absolutely_real_integrable_on s <=> + (lift o f o drop) absolutely_integrable_on (IMAGE lift s)`, + REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_ON; + absolutely_integrable_on] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT]);; + +let REAL_INTEGRAL = prove + (`f real_integrable_on s + ==> real_integral s f = drop(integral (IMAGE lift s) (lift o f o drop))`, + REWRITE_TAC[REAL_INTEGRABLE_ON] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + REWRITE_TAC[has_real_integral; LIFT_DROP] THEN + ASM_REWRITE_TAC[GSYM HAS_INTEGRAL_INTEGRAL]);; + +let HAS_REAL_INTEGRAL_ALT = prove + (`!f s i. + (f has_real_integral i) s <=> + (!a b. (\x. if x IN s then f x else &0) real_integrable_on + real_interval [a,b]) /\ + (!e. &0 < e + ==> (?B. &0 < B /\ + (!a b. + real_interval(--B,B) SUBSET real_interval[a,b] + ==> abs + (real_integral (real_interval[a,b]) + (\x. if x IN s then f x else &0) - + i) < e)))`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [has_real_integral] THEN + GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[GSYM FORALL_LIFT; COND_RAND; LIFT_NUM; IN_IMAGE_LIFT_DROP] THEN + MATCH_MP_TAC(TAUT `(p ==> (q <=> q')) ==> (p /\ q <=> p /\ q')`) THEN + DISCH_TAC THEN REWRITE_TAC[BALL_1] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_LIFT; VECTOR_ADD_LID; VECTOR_SUB_LZERO] THEN + REWRITE_TAC[GSYM LIFT_NEG; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[SUBSET_LIFT_IMAGE; NORM_REAL; GSYM drop] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `b:real` THEN + ASM_CASES_TAC `real_interval(--B,B) SUBSET real_interval[a,b]` THEN + ASM_REWRITE_TAC[DROP_SUB; LIFT_DROP] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN IMP_REWRITE_TAC[REAL_INTEGRAL] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; COND_RAND] THEN + ASM_REWRITE_TAC[LIFT_NUM; IMAGE_LIFT_REAL_INTERVAL]);; + +let HAS_REAL_INTEGRAL_IS_0 = prove + (`!f s. (!x. x IN s ==> f(x) = &0) ==> (f has_real_integral &0) s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; LIFT_NUM] THEN + MATCH_MP_TAC HAS_INTEGRAL_IS_0 THEN + ASM_REWRITE_TAC[LIFT_EQ; FORALL_IN_IMAGE; o_THM; LIFT_DROP; GSYM LIFT_NUM]);; + +let HAS_REAL_INTEGRAL_0 = prove + (`!s. ((\x. &0) has_real_integral &0) s`, + SIMP_TAC[HAS_REAL_INTEGRAL_IS_0]);; + +let HAS_REAL_INTEGRAL_0_EQ = prove + (`!i s. ((\x. &0) has_real_integral i) s <=> i = &0`, + MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_0]);; + +let HAS_REAL_INTEGRAL_LINEAR = prove + (`!f:real->real y s h:real->real. + (f has_real_integral y) s /\ linear(lift o h o drop) + ==> ((h o f) has_real_integral h(y)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_LINEAR) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let HAS_REAL_INTEGRAL_LMUL = prove + (`!(f:real->real) k s c. + (f has_real_integral k) s + ==> ((\x. c * f(x)) has_real_integral (c * k)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_INTEGRAL_CMUL) THEN + REWRITE_TAC[GSYM LIFT_CMUL; o_DEF]);; + +let HAS_REAL_INTEGRAL_RMUL = prove + (`!(f:real->real) k s c. + (f has_real_integral k) s + ==> ((\x. f(x) * c) has_real_integral (k * c)) s`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_LMUL]);; + +let HAS_REAL_INTEGRAL_NEG = prove + (`!f k s. (f has_real_integral k) s + ==> ((\x. --(f x)) has_real_integral (--k)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_NEG) THEN + REWRITE_TAC[o_DEF; LIFT_NEG]);; + +let HAS_REAL_INTEGRAL_ADD = prove + (`!f:real->real g k l s. + (f has_real_integral k) s /\ (g has_real_integral l) s + ==> ((\x. f(x) + g(x)) has_real_integral (k + l)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_ADD) THEN + REWRITE_TAC[o_DEF; LIFT_ADD]);; + +let HAS_REAL_INTEGRAL_SUB = prove + (`!f:real->real g k l s. + (f has_real_integral k) s /\ (g has_real_integral l) s + ==> ((\x. f(x) - g(x)) has_real_integral (k - l)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_SUB) THEN + REWRITE_TAC[o_DEF; LIFT_SUB]);; + +let REAL_INTEGRAL_0 = prove + (`!s. real_integral s (\x. &0) = &0`, + MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_0]);; + +let REAL_INTEGRAL_ADD = prove + (`!f:real->real g s. + f real_integrable_on s /\ g real_integrable_on s + ==> real_integral s (\x. f x + g x) = + real_integral s f + real_integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRAL_LMUL = prove + (`!f:real->real c s. + f real_integrable_on s + ==> real_integral s (\x. c * f(x)) = c * real_integral s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRAL_RMUL = prove + (`!f:real->real c s. + f real_integrable_on s + ==> real_integral s (\x. f(x) * c) = real_integral s f * c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRAL_NEG = prove + (`!f:real->real s. + f real_integrable_on s + ==> real_integral s (\x. --f(x)) = --real_integral s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_NEG THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRAL_SUB = prove + (`!f:real->real g s. + f real_integrable_on s /\ g real_integrable_on s + ==> real_integral s (\x. f x - g x) = + real_integral s f - real_integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRABLE_0 = prove + (`!s. (\x. &0) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_0]);; + +let REAL_INTEGRABLE_ADD = prove + (`!f:real->real g s. + f real_integrable_on s /\ g real_integrable_on s + ==> (\x. f x + g x) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_ADD]);; + +let REAL_INTEGRABLE_LMUL = prove + (`!f:real->real c s. + f real_integrable_on s + ==> (\x. c * f(x)) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_LMUL]);; + +let REAL_INTEGRABLE_RMUL = prove + (`!f:real->real c s. + f real_integrable_on s + ==> (\x. f(x) * c) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_RMUL]);; + +let REAL_INTEGRABLE_LMUL_EQ = prove + (`!f s c. + (\x. c * f x) real_integrable_on s <=> + c = &0 \/ f real_integrable_on s`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_LMUL; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_INTEGRABLE_0] THEN + ASM_CASES_TAC `c = &0` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv c:real` o + MATCH_MP REAL_INTEGRABLE_LMUL) THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LID; REAL_MUL_LINV; ETA_AX]);; + +let REAL_INTEGRABLE_RMUL_EQ = prove + (`!f s c. + (\x. f x * c) real_integrable_on s <=> + c = &0 \/ f real_integrable_on s`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_INTEGRABLE_LMUL_EQ]);; + +let REAL_INTEGRABLE_NEG = prove + (`!f:real->real s. + f real_integrable_on s ==> (\x. --f(x)) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_NEG]);; + +let REAL_INTEGRABLE_SUB = prove + (`!f:real->real g s. + f real_integrable_on s /\ g real_integrable_on s + ==> (\x. f x - g x) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SUB]);; + +let REAL_INTEGRABLE_LINEAR = prove + (`!f h s. f real_integrable_on s /\ + linear(lift o h o drop) ==> (h o f) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_LINEAR]);; + +let REAL_INTEGRAL_LINEAR = prove + (`!f:real->real s h:real->real. + f real_integrable_on s /\ linear(lift o h o drop) + ==> real_integral s (h o f) = h(real_integral s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + MAP_EVERY EXISTS_TAC + [`(h:real->real) o (f:real->real)`; `s:real->bool`] THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC HAS_REAL_INTEGRAL_LINEAR] THEN + ASM_SIMP_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL; REAL_INTEGRABLE_LINEAR]);; + +let HAS_REAL_INTEGRAL_SUM = prove + (`!f:A->real->real s t. + FINITE t /\ + (!a. a IN t ==> ((f a) has_real_integral (i a)) s) + ==> ((\x. sum t (\a. f a x)) has_real_integral (sum t i)) s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; HAS_REAL_INTEGRAL_0; IN_INSERT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN + ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]);; + +let REAL_INTEGRAL_SUM = prove + (`!f:A->real->real s t. + FINITE t /\ + (!a. a IN t ==> (f a) real_integrable_on s) + ==> real_integral s (\x. sum t (\a. f a x)) = + sum t (\a. real_integral s (f a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRABLE_SUM = prove + (`!f:A->real->real s t. + FINITE t /\ + (!a. a IN t ==> (f a) real_integrable_on s) + ==> (\x. sum t (\a. f a x)) real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_SUM]);; + +let HAS_REAL_INTEGRAL_EQ = prove + (`!f:real->real g k s. + (!x. x IN s ==> (f(x) = g(x))) /\ + (f has_real_integral k) s + ==> (g has_real_integral k) s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_IS_0) MP_TAC) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN + (MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB) THEN + SIMP_TAC[REAL_ARITH `x - (x - y:real) = y`; ETA_AX; REAL_SUB_RZERO]);; + +let REAL_INTEGRABLE_EQ = prove + (`!f:real->real g s. + (!x. x IN s ==> (f(x) = g(x))) /\ + f real_integrable_on s + ==> g real_integrable_on s`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_EQ]);; + +let HAS_REAL_INTEGRAL_EQ_EQ = prove + (`!f:real->real g k s. + (!x. x IN s ==> (f(x) = g(x))) + ==> ((f has_real_integral k) s <=> (g has_real_integral k) s)`, + MESON_TAC[HAS_REAL_INTEGRAL_EQ]);; + +let HAS_REAL_INTEGRAL_NULL = prove + (`!f:real->real a b. + b <= a ==> (f has_real_integral &0) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_real_integral; REAL_INTERVAL_INTERVAL] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `IMAGE (\x. x) s = s`] THEN + MATCH_MP_TAC HAS_INTEGRAL_NULL THEN + ASM_REWRITE_TAC[CONTENT_EQ_0_1; LIFT_DROP]);; + +let HAS_REAL_INTEGRAL_NULL_EQ = prove + (`!f a b i. b <= a + ==> ((f has_real_integral i) (real_interval[a,b]) <=> i = &0)`, + ASM_MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_NULL]);; + +let REAL_INTEGRAL_NULL = prove + (`!f a b. b <= a + ==> real_integral(real_interval[a,b]) f = &0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_MESON_TAC[HAS_REAL_INTEGRAL_NULL]);; + +let REAL_INTEGRABLE_ON_NULL = prove + (`!f a b. b <= a + ==> f real_integrable_on real_interval[a,b]`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_NULL]);; + +let HAS_REAL_INTEGRAL_EMPTY = prove + (`!f. (f has_real_integral &0) {}`, + GEN_TAC THEN REWRITE_TAC[EMPTY_AS_REAL_INTERVAL] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_NULL THEN REWRITE_TAC[REAL_POS]);; + +let HAS_REAL_INTEGRAL_EMPTY_EQ = prove + (`!f i. (f has_real_integral i) {} <=> i = &0`, + MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_EMPTY]);; + +let REAL_INTEGRABLE_ON_EMPTY = prove + (`!f. f real_integrable_on {}`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_EMPTY]);; + +let REAL_INTEGRAL_EMPTY = prove + (`!f. real_integral {} f = &0`, + MESON_TAC[EMPTY_AS_REAL_INTERVAL; REAL_INTEGRAL_UNIQUE; + HAS_REAL_INTEGRAL_EMPTY]);; + +let HAS_REAL_INTEGRAL_REFL = prove + (`!f a. (f has_real_integral &0) (real_interval[a,a])`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_NULL THEN + REWRITE_TAC[REAL_LE_REFL]);; + +let REAL_INTEGRABLE_ON_REFL = prove + (`!f a. f real_integrable_on real_interval[a,a]`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_REFL]);; + +let REAL_INTEGRAL_REFL = prove + (`!f a. real_integral (real_interval[a,a]) f = &0`, + MESON_TAC[REAL_INTEGRAL_UNIQUE; HAS_REAL_INTEGRAL_REFL]);; + +let HAS_REAL_INTEGRAL_CONST = prove + (`!a b c. + a <= b + ==> ((\x. c) has_real_integral (c * (b - a))) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL] THEN + MP_TAC(ISPECL [`lift a`; `lift b`; `lift c`] HAS_INTEGRAL_CONST) THEN + ASM_SIMP_TAC[o_DEF; CONTENT_1; LIFT_DROP; LIFT_CMUL]);; + +let REAL_INTEGRABLE_CONST = prove + (`!a b c. (\x. c) real_integrable_on real_interval[a,b]`, + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL; + o_DEF; INTEGRABLE_CONST]);; + +let REAL_INTEGRAL_CONST = prove + (`!a b c. + a <= b + ==> real_integral (real_interval [a,b]) (\x. c) = c * (b - a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);; + +let HAS_REAL_INTEGRAL_BOUND = prove + (`!f:real->real a b i B. + &0 <= B /\ a <= b /\ + (f has_real_integral i) (real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] ==> abs(f x) <= B) + ==> abs i <= B * (b - a)`, + REWRITE_TAC[HAS_REAL_INTEGRAL; REAL_INTERVAL_INTERVAL; GSYM NORM_LIFT] THEN + REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN + ASM_SIMP_TAC[GSYM CONTENT_1; LIFT_DROP] THEN + MATCH_MP_TAC HAS_INTEGRAL_BOUND THEN + EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[o_THM]);; + +let HAS_REAL_INTEGRAL_LE = prove + (`!f g s i j. + (f has_real_integral i) s /\ (g has_real_integral j) s /\ + (!x. x IN s ==> f x <= g x) + ==> i <= j`, + REWRITE_TAC[has_real_integral] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM LIFT_DROP] THEN + REWRITE_TAC[drop] THEN MATCH_MP_TAC + (ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`] + HAS_INTEGRAL_COMPONENT_LE) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; DIMINDEX_1; LE_REFL; o_THM; LIFT_DROP; + GSYM drop]);; + +let REAL_INTEGRAL_LE = prove + (`!f:real->real g:real->real s. + f real_integrable_on s /\ g real_integrable_on s /\ + (!x. x IN s ==> f x <= g x) + ==> real_integral s f <= real_integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN + ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let HAS_REAL_INTEGRAL_POS = prove + (`!f:real->real s i. + (f has_real_integral i) s /\ + (!x. x IN s ==> &0 <= f x) + ==> &0 <= i`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\x. &0):real->real`; `f:real->real`; + `s:real->bool`; `&0:real`; + `i:real`] HAS_REAL_INTEGRAL_LE) THEN + ASM_SIMP_TAC[HAS_REAL_INTEGRAL_0]);; + +let REAL_INTEGRAL_POS = prove + (`!f:real->real s. + f real_integrable_on s /\ + (!x. x IN s ==> &0 <= f x) + ==> &0 <= real_integral s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_POS THEN + ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let HAS_REAL_INTEGRAL_ISNEG = prove + (`!f:real->real s i. + (f has_real_integral i) s /\ + (!x. x IN s ==> f x <= &0) + ==> i <= &0`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `(\x. &0):real->real`; + `s:real->bool`; `i:real`; `&0:real`; + ] HAS_REAL_INTEGRAL_LE) THEN + ASM_SIMP_TAC[HAS_REAL_INTEGRAL_0]);; + +let HAS_REAL_INTEGRAL_LBOUND = prove + (`!f:real->real a b i. + a <= b /\ + (f has_real_integral i) (real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] ==> B <= f(x)) + ==> B * (b - a) <= i`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\x. B):real->real`; `f:real->real`; + `real_interval[a,b]`; + `B * (b - a):real`; + `i:real`] + HAS_REAL_INTEGRAL_LE) THEN + ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);; + +let HAS_REAL_INTEGRAL_UBOUND = prove + (`!f:real->real a b i. + a <= b /\ + (f has_real_integral i) (real_interval[a,b]) /\ + (!x. x IN real_interval[a,b] ==> f(x) <= B) + ==> i <= B * (b - a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `(\x. B):real->real`; + `real_interval[a,b]`; `i:real`; + `B * (b - a):real`] + HAS_REAL_INTEGRAL_LE) THEN + ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]);; + +let REAL_INTEGRAL_LBOUND = prove + (`!f:real->real a b. + a <= b /\ + f real_integrable_on real_interval[a,b] /\ + (!x. x IN real_interval[a,b] ==> B <= f(x)) + ==> B * (b - a) <= real_integral(real_interval[a,b]) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LBOUND THEN + EXISTS_TAC `f:real->real` THEN + ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);; + +let REAL_INTEGRAL_UBOUND = prove + (`!f:real->real a b. + a <= b /\ + f real_integrable_on real_interval[a,b] /\ + (!x. x IN real_interval[a,b] ==> f(x) <= B) + ==> real_integral(real_interval[a,b]) f <= B * (b - a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UBOUND THEN + EXISTS_TAC `f:real->real` THEN + ASM_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL]);; + +let REAL_INTEGRABLE_UNIFORM_LIMIT = prove + (`!f a b. (!e. &0 < e + ==> ?g. (!x. x IN real_interval[a,b] ==> abs(f x - g x) <= e) /\ + g real_integrable_on real_interval[a,b] ) + ==> f real_integrable_on real_interval[a,b]`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[GSYM integrable_on] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_UNIFORM_LIMIT THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]);; + +let HAS_REAL_INTEGRAL_NEGLIGIBLE = prove + (`!f s t. + real_negligible s /\ (!x. x IN (t DIFF s) ==> f x = &0) + ==> (f has_real_integral (&0)) t`, + REWRITE_TAC[has_real_integral; real_negligible; LIFT_NUM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN + EXISTS_TAC `IMAGE lift s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[LIFT_IN_IMAGE_LIFT; LIFT_DROP] THEN ASM SET_TAC[LIFT_NUM]);; + +let HAS_REAL_INTEGRAL_SPIKE = prove + (`!f g s t y. + real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ + (f has_real_integral y) t + ==> (g has_real_integral y) t`, + REWRITE_TAC[has_real_integral; real_negligible] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC [`lift o f o drop`; `IMAGE lift s`] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN + REWRITE_TAC[LIFT_IN_IMAGE_LIFT; LIFT_DROP] THEN ASM SET_TAC[LIFT_NUM]);; + +let HAS_REAL_INTEGRAL_SPIKE_EQ = prove + (`!f g s t y. + real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> ((f has_real_integral y) t <=> (g has_real_integral y) t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THENL + [EXISTS_TAC `f:real->real`; EXISTS_TAC `g:real->real`] THEN + EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_ABS_SUB]);; + +let REAL_INTEGRABLE_SPIKE = prove + (`!f g s t. + real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> f real_integrable_on t ==> g real_integrable_on t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE) THEN ASM_REWRITE_TAC[]);; + +let REAL_INTEGRABLE_SPIKE_EQ = prove + (`!f g s t. + real_negligible s /\ (!x. x IN t DIFF s ==> g x = f x) + ==> (f real_integrable_on t <=> g real_integrable_on t)`, + MESON_TAC[REAL_INTEGRABLE_SPIKE]);; + +let REAL_INTEGRAL_SPIKE = prove + (`!f:real->real g s t. + real_negligible s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> real_integral t f = real_integral t g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN + AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_EQ THEN + ASM_MESON_TAC[]);; + +let REAL_NEGLIGIBLE_SUBSET = prove + (`!s:real->bool t:real->bool. + real_negligible s /\ t SUBSET s ==> real_negligible t`, + REWRITE_TAC[real_negligible] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `IMAGE lift s` THEN ASM_SIMP_TAC[IMAGE_SUBSET]);; + +let REAL_NEGLIGIBLE_DIFF = prove + (`!s t:real->bool. real_negligible s ==> real_negligible(s DIFF t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[SUBSET_DIFF]);; + +let REAL_NEGLIGIBLE_INTER = prove + (`!s t. real_negligible s \/ real_negligible t ==> real_negligible(s INTER t)`, + MESON_TAC[REAL_NEGLIGIBLE_SUBSET; INTER_SUBSET]);; + +let REAL_NEGLIGIBLE_UNION = prove + (`!s t:real->bool. + real_negligible s /\ real_negligible t ==> real_negligible (s UNION t)`, + SIMP_TAC[NEGLIGIBLE_UNION; IMAGE_UNION; real_negligible]);; + +let REAL_NEGLIGIBLE_UNION_EQ = prove + (`!s t:real->bool. + real_negligible (s UNION t) <=> real_negligible s /\ real_negligible t`, + MESON_TAC[REAL_NEGLIGIBLE_UNION; SUBSET_UNION; REAL_NEGLIGIBLE_SUBSET]);; + +let REAL_NEGLIGIBLE_SING = prove + (`!a:real. real_negligible {a}`, + REWRITE_TAC[real_negligible; NEGLIGIBLE_SING; IMAGE_CLAUSES]);; + +let REAL_NEGLIGIBLE_INSERT = prove + (`!a:real s. real_negligible(a INSERT s) <=> real_negligible s`, + REWRITE_TAC[real_negligible; NEGLIGIBLE_INSERT; IMAGE_CLAUSES]);; + +let REAL_NEGLIGIBLE_EMPTY = prove + (`real_negligible {}`, + REWRITE_TAC[real_negligible; NEGLIGIBLE_EMPTY; IMAGE_CLAUSES]);; + +let REAL_NEGLIGIBLE_FINITE = prove + (`!s. FINITE s ==> real_negligible s`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[REAL_NEGLIGIBLE_EMPTY; REAL_NEGLIGIBLE_INSERT]);; + +let REAL_NEGLIGIBLE_UNIONS = prove + (`!s. FINITE s /\ (!t. t IN s ==> real_negligible t) + ==> real_negligible(UNIONS s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; REAL_NEGLIGIBLE_EMPTY; IN_INSERT] THEN + SIMP_TAC[REAL_NEGLIGIBLE_UNION]);; + +let HAS_REAL_INTEGRAL_SPIKE_FINITE = prove + (`!f:real->real g s t y. + FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) /\ + (f has_real_integral y) t + ==> (g has_real_integral y) t`, + MESON_TAC[HAS_REAL_INTEGRAL_SPIKE; REAL_NEGLIGIBLE_FINITE]);; + +let HAS_REAL_INTEGRAL_SPIKE_FINITE_EQ = prove + (`!f:real->real g s y. + FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> ((f has_real_integral y) t <=> (g has_real_integral y) t)`, + MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_FINITE]);; + +let REAL_INTEGRABLE_SPIKE_FINITE = prove + (`!f:real->real g s. + FINITE s /\ (!x. x IN (t DIFF s) ==> g x = f x) + ==> f real_integrable_on t + ==> g real_integrable_on t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE_FINITE) THEN ASM_REWRITE_TAC[]);; + +let REAL_NEGLIGIBLE_FRONTIER_INTERVAL = prove + (`!a b:real. real_negligible(real_interval[a,b] DIFF real_interval(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_interval; DIFF; IN_ELIM_THM] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{(a:real),b}` THEN + ASM_SIMP_TAC[REAL_NEGLIGIBLE_FINITE; FINITE_RULES] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC);; + +let HAS_REAL_INTEGRAL_SPIKE_INTERIOR = prove + (`!f:real->real g a b y. + (!x. x IN real_interval(a,b) ==> g x = f x) /\ + (f has_real_integral y) (real_interval[a,b]) + ==> (g has_real_integral y) (real_interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] + HAS_REAL_INTEGRAL_SPIKE) THEN + EXISTS_TAC `real_interval[a:real,b] DIFF real_interval(a,b)` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_FRONTIER_INTERVAL] THEN ASM SET_TAC[]);; + +let HAS_REAL_INTEGRAL_SPIKE_INTERIOR_EQ = prove + (`!f:real->real g a b y. + (!x. x IN real_interval(a,b) ==> g x = f x) + ==> ((f has_real_integral y) (real_interval[a,b]) <=> + (g has_real_integral y) (real_interval[a,b]))`, + MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_INTERIOR]);; + +let REAL_INTEGRABLE_SPIKE_INTERIOR = prove + (`!f:real->real g a b. + (!x. x IN real_interval(a,b) ==> g x = f x) + ==> f real_integrable_on (real_interval[a,b]) + ==> g real_integrable_on (real_interval[a,b])`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_integrable_on] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MP_TAC(SPEC_ALL HAS_REAL_INTEGRAL_SPIKE_INTERIOR) THEN ASM_REWRITE_TAC[]);; + +let REAL_INTEGRAL_EQ = prove + (`!f g s. + (!x. x IN s ==> f x = g x) ==> real_integral s f = real_integral s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{}:real->bool` THEN + ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF]);; + +let REAL_INTEGRAL_EQ_0 = prove + (`!f s. (!x. x IN s ==> f x = &0) ==> real_integral s f = &0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `real_integral s (\x. &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_INTEGRAL_0]]);; + +let REAL_INTEGRABLE_CONTINUOUS = prove + (`!f a b. + f real_continuous_on real_interval[a,b] + ==> f real_integrable_on real_interval[a,b]`, + REWRITE_TAC[REAL_CONTINUOUS_ON; real_integrable_on; has_real_integral; + GSYM integrable_on; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; INTEGRABLE_CONTINUOUS]);; + +let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS = prove + (`!f f' a b. + a <= b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) + (atreal x within real_interval[a,b])) + ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, + REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let REAL_INTEGRABLE_SUBINTERVAL = prove + (`!f:real->real a b c d. + f real_integrable_on real_interval[a,b] /\ + real_interval[c,d] SUBSET real_interval[a,b] + ==> f real_integrable_on real_interval[c,d]`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL] THEN + REWRITE_TAC[EXISTS_DROP; GSYM integrable_on; LIFT_DROP] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`lift a`; `lift b`] THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + ASM_SIMP_TAC[IMAGE_SUBSET]);; + +let HAS_REAL_INTEGRAL_COMBINE = prove + (`!f i j a b c. + a <= c /\ c <= b /\ + (f has_real_integral i) (real_interval[a,c]) /\ + (f has_real_integral j) (real_interval[c,b]) + ==> (f has_real_integral (i + j)) (real_interval[a,b])`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL; LIFT_ADD] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_COMBINE THEN + EXISTS_TAC `lift c` THEN ASM_REWRITE_TAC[LIFT_DROP]);; + +let REAL_INTEGRAL_COMBINE = prove + (`!f a b c. + a <= c /\ c <= b /\ f real_integrable_on (real_interval[a,b]) + ==> real_integral(real_interval[a,c]) f + + real_integral(real_interval[c,b]) f = + real_integral(real_interval[a,b]) f`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; REAL_LE_REFL]);; + +let REAL_INTEGRABLE_COMBINE = prove + (`!f a b c. + a <= c /\ c <= b /\ + f real_integrable_on real_interval[a,c] /\ + f real_integrable_on real_interval[c,b] + ==> f real_integrable_on real_interval[a,b]`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_COMBINE]);; + +let REAL_INTEGRABLE_ON_LITTLE_SUBINTERVALS = prove + (`!f:real->real a b. + (!x. x IN real_interval[a,b] + ==> ?d. &0 < d /\ + !u v. x IN real_interval[u,v] /\ + (!y. y IN real_interval[u,v] + ==> abs(y - x) < d /\ y IN real_interval[a,b]) + ==> f real_integrable_on real_interval[u,v]) + ==> f real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL; EXISTS_DROP; + GSYM integrable_on; LIFT_DROP] THEN + DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_LITTLE_SUBINTERVALS THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM EXISTS_DROP; FORALL_LIFT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL + [ASM_MESON_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_IN_IMAGE_LIFT]; + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE] THEN + X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1` o REWRITE_RULE[SUBSET])) THEN + ASM_SIMP_TAC[IN_BALL; FUN_IN_IMAGE; dist; NORM_REAL] THEN + REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP] THEN SIMP_TAC[REAL_ABS_SUB]]);; + +let REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE = prove + (`!f a b x. + f real_integrable_on real_interval[a,b] /\ x IN real_interval[a,b] /\ + f real_continuous (atreal x within real_interval[a,b]) + ==> ((\u. real_integral(real_interval[a,u]) f) + has_real_derivative f(x)) + (atreal x within real_interval[a,b])`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1; IMAGE_LIFT_REAL_INTERVAL; + REAL_INTEGRABLE_ON; CONTINUOUS_CONTINUOUS_WITHINREAL; + HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL; IN_IMAGE_LIFT_DROP; GSYM o_ASSOC] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRAL_HAS_VECTOR_DERIVATIVE_POINTWISE) THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT + `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] + HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN) THEN + EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[REAL_LT_01] THEN + X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN + REWRITE_TAC[LIFT_DROP] THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; LIFT_DROP; o_DEF] THEN + REWRITE_TAC[GSYM o_DEF; SET_RULE `IMAGE (\x. x) s = s`] THEN + MATCH_MP_TAC REAL_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1])) THEN + REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);; + +let REAL_INTEGRAL_HAS_REAL_DERIVATIVE = prove + (`!f:real->real a b. + f real_continuous_on real_interval[a,b] + ==> !x. x IN real_interval[a,b] + ==> ((\u. real_integral(real_interval[a,u]) f) + has_real_derivative f(x)) + (atreal x within real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE THEN + ASM_MESON_TAC[REAL_INTEGRABLE_CONTINUOUS; + REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]);; + +let REAL_ANTIDERIVATIVE_CONTINUOUS = prove + (`!f a b. + (f real_continuous_on real_interval[a,b]) + ==> ?g. !x. x IN real_interval[a,b] + ==> (g has_real_derivative f(x)) + (atreal x within real_interval[a,b])`, + MESON_TAC[REAL_INTEGRAL_HAS_REAL_DERIVATIVE]);; + +let REAL_ANTIDERIVATIVE_INTEGRAL_CONTINUOUS = prove + (`!f a b. + (f real_continuous_on real_interval[a,b]) + ==> ?g. !u v. u IN real_interval[a,b] /\ + v IN real_interval[a,b] /\ u <= v + ==> (f has_real_integral (g(v) - g(u))) + (real_interval[u,v])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_ANTIDERIVATIVE_CONTINUOUS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real->real` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN + STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[a:real,b]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC);; + +let HAS_REAL_INTEGRAL_AFFINITY = prove + (`!f:real->real i a b m c. + (f has_real_integral i) (real_interval[a,b]) /\ ~(m = &0) + ==> ((\x. f(m * x + c)) has_real_integral (inv(abs(m)) * i)) + (IMAGE (\x. inv m * (x - c)) (real_interval[a,b]))`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL] THEN + DISCH_THEN(MP_TAC o SPEC `lift c` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1; has_real_integral] THEN + REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP; LIFT_CMUL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[INTERVAL_REAL_INTERVAL; GSYM IMAGE_o; LIFT_DROP] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_CMUL; LIFT_SUB] THEN VECTOR_ARITH_TAC);; + +let REAL_INTEGRABLE_AFFINITY = prove + (`!f a b m c. + f real_integrable_on real_interval[a,b] /\ ~(m = &0) + ==> (\x. f(m * x + c)) real_integrable_on + (IMAGE (\x. inv m * (x - c)) (real_interval[a,b]))`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_AFFINITY]);; + +let HAS_REAL_INTEGRAL_STRETCH = prove + (`!f:real->real i a b m. + (f has_real_integral i) (real_interval[a,b]) /\ ~(m = &0) + ==> ((\x. f(m * x)) has_real_integral (inv(abs(m)) * i)) + (IMAGE (\x. inv m * x) (real_interval[a,b]))`, + MP_TAC HAS_REAL_INTEGRAL_AFFINITY THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `&0`) THEN + REWRITE_TAC[REAL_ADD_RID; REAL_SUB_RZERO]);; + +let REAL_INTEGRABLE_STRETCH = prove + (`!f a b m. + f real_integrable_on real_interval[a,b] /\ ~(m = &0) + ==> (\x. f(m * x)) real_integrable_on + (IMAGE (\x. inv m * x) (real_interval[a,b]))`, + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[HAS_REAL_INTEGRAL_STRETCH]);; + +let HAS_REAL_INTEGRAL_REFLECT_LEMMA = prove + (`!f:real->real i a b. + (f has_real_integral i) (real_interval[a,b]) + ==> ((\x. f(--x)) has_real_integral i) (real_interval[--b,--a])`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_REFLECT_LEMMA) THEN + REWRITE_TAC[LIFT_NEG; o_DEF; DROP_NEG]);; + +let HAS_REAL_INTEGRAL_REFLECT = prove + (`!f:real->real i a b. + ((\x. f(--x)) has_real_integral i) (real_interval[--b,--a]) <=> + (f has_real_integral i) (real_interval[a,b])`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_REFLECT_LEMMA) THEN + REWRITE_TAC[REAL_NEG_NEG; ETA_AX]);; + +let REAL_INTEGRABLE_REFLECT = prove + (`!f:real->real a b. + (\x. f(--x)) real_integrable_on (real_interval[--b,--a]) <=> + f real_integrable_on (real_interval[a,b])`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_REFLECT]);; + +let REAL_INTEGRAL_REFLECT = prove + (`!f:real->real a b. + real_integral (real_interval[--b,--a]) (\x. f(--x)) = + real_integral (real_interval[a,b]) f`, + REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_REFLECT]);; + +let HAS_REAL_INTEGRAL_REFLECT_GEN = prove + (`!f i s. ((\x. f(--x)) has_real_integral i) s <=> + (f has_real_integral i) (IMAGE (--) s)`, + REWRITE_TAC[has_real_integral; o_DEF; GSYM DROP_NEG; + HAS_INTEGRAL_REFLECT_GEN; GSYM IMAGE_o; GSYM LIFT_NEG]);; + +let REAL_INTEGRABLE_REFLECT_GEN = prove + (`!f s. (\x. f(--x)) real_integrable_on s <=> + f real_integrable_on (IMAGE (--) s)`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_REFLECT_GEN]);; + +let REAL_INTEGRAL_REFLECT_GEN = prove + (`!f s. real_integral s (\x. f(--x)) = real_integral (IMAGE (--) s) f`, + REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_REFLECT_GEN]);; + +let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR = prove + (`!f:real->real f' a b. + a <= b /\ f real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) + ==> (f has_real_derivative f'(x)) (atreal x)) + ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, + REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o BINOP_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG = prove + (`!f f' s a b. + COUNTABLE s /\ + a <= b /\ f real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) DIFF s + ==> (f has_real_derivative f'(x)) (atreal x)) + ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, + REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_AT] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN + SUBGOAL_THEN `!x. drop x IN s <=> x IN IMAGE lift s` + (fun th -> REWRITE_TAC[th]) THENL [SET_TAC[LIFT_DROP]; ALL_TAC] THEN + SUBGOAL_THEN `COUNTABLE s <=> COUNTABLE(IMAGE lift s)` SUBST1_TAC THENL + [EQ_TAC THEN SIMP_TAC[COUNTABLE_IMAGE] THEN + DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP COUNTABLE_IMAGE) THEN + REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP; GSYM IN_DIFF; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + REWRITE_TAC[LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o BINOP_CONV) + [GSYM LIFT_DROP] THEN + DISCH_THEN(MP_TAC o + MATCH_MP FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_STRONG = prove + (`!f f' s a b. + COUNTABLE s /\ + a <= b /\ f real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval[a,b] DIFF s + ==> (f has_real_derivative f'(x)) (atreal x)) + ==> (f' has_real_integral (f(b) - f(a))) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG THEN + EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN GEN_TAC THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM MATCH_MP_TAC THEN MP_TAC th) THEN + SIMP_TAC[IN_REAL_INTERVAL; IN_DIFF] THEN REAL_ARITH_TAC);; + +let REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT = prove + (`!f:real->real a b. + f real_integrable_on real_interval[a,b] + ==> (\x. real_integral (real_interval[a,x]) f) + real_continuous_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTEGRABLE_ON]) THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN + GEN_REWRITE_TAC I [GSYM DROP_EQ] THEN + REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP; GSYM o_DEF] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);; + +let REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT = prove + (`!f:real->real a b. + f real_integrable_on real_interval[a,b] + ==> (\x. real_integral (real_interval[x,b]) f) + real_continuous_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTEGRABLE_ON]) THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CONTINUOUS_ON_EQ) THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[o_DEF] THEN + GEN_REWRITE_TAC I [GSYM DROP_EQ] THEN + REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP; GSYM o_DEF] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERVAL_1]) THEN + REWRITE_TAC[LIFT_DROP] THEN REAL_ARITH_TAC);; + +let HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL = prove + (`!f:real->real a b k y. + COUNTABLE k /\ f real_continuous_on real_interval[a,b] /\ f a = y /\ + (!x. x IN (real_interval[a,b] DIFF k) + ==> (f has_real_derivative &0) + (atreal x within real_interval[a,b])) + ==> !x. x IN real_interval[a,b] ==> f x = y`, + REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMP_IMP; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + REWRITE_TAC[GSYM IMP_CONJ; LIFT_DROP; has_vector_derivative] THEN + REWRITE_TAC[LIFT_NUM; VECTOR_MUL_RZERO] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o f o drop`; `lift a`; `lift b`; `IMAGE lift k`; `lift y`] + HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_INTERVAL) THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; o_THM; LIFT_DROP; LIFT_EQ; IN_DIFF] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[LIFT_DROP]);; + +let HAS_REAL_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX = prove + (`!f:real->real s k c y. + is_realinterval s /\ COUNTABLE k /\ f real_continuous_on s /\ + c IN s /\ f c = y /\ + (!x. x IN (s DIFF k) ==> (f has_real_derivative &0) (atreal x within s)) + ==> !x. x IN s ==> f x = y`, + REWRITE_TAC[has_real_integral; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN + REWRITE_TAC[IS_REALINTERVAL_CONVEX; REAL_CONTINUOUS_ON] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_SUB] THEN + REWRITE_TAC[REAL_INTERVAL_INTERVAL; FORALL_IN_IMAGE; IMP_CONJ; IN_DIFF] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMP_IMP; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + REWRITE_TAC[GSYM IMP_CONJ; LIFT_DROP; has_vector_derivative] THEN + REWRITE_TAC[LIFT_NUM; VECTOR_MUL_RZERO] THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o f o drop`; `IMAGE lift s`; `IMAGE lift k`; `lift c`; `lift y`] + HAS_DERIVATIVE_ZERO_UNIQUE_STRONG_CONVEX) THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; o_THM; LIFT_DROP; LIFT_EQ; IN_DIFF] THEN + ASM_REWRITE_TAC[LIFT_IN_IMAGE_LIFT; FORALL_IN_IMAGE; LIFT_DROP] THEN + ASM_SIMP_TAC[IMP_CONJ; FORALL_IN_IMAGE; LIFT_IN_IMAGE_LIFT]);; + +let HAS_REAL_DERIVATIVE_INDEFINITE_INTEGRAL = prove + (`!f a b. + f real_integrable_on real_interval[a,b] + ==> ?k. real_negligible k /\ + !x. x IN real_interval[a,b] DIFF k + ==> ((\x. real_integral(real_interval[a,x]) f) + has_real_derivative + f(x)) (atreal x within real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] + HAS_VECTOR_DERIVATIVE_INDEFINITE_INTEGRAL) THEN + ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[IN_DIFF; FORALL_IN_IMAGE; IMP_CONJ] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE drop k` THEN + ASM_REWRITE_TAC[real_negligible; HAS_REAL_VECTOR_DERIVATIVE_WITHIN] THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + REWRITE_TAC[IN_IMAGE; GSYM LIFT_EQ; LIFT_DROP; UNWIND_THM1] THEN + X_GEN_TAC `x:real` THEN REPEAT DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_THM; LIFT_DROP] THEN MATCH_MP_TAC(REWRITE_RULE + [TAUT `a /\ b /\ c /\ d ==> e <=> a /\ b /\ c ==> d ==> e`] + HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN) THEN + EXISTS_TAC `&1` THEN ASM_SIMP_TAC[FUN_IN_IMAGE; REAL_LT_01] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE] THEN + X_GEN_TAC `y:real` THEN REPEAT DISCH_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP; o_THM] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC);; + +let HAS_REAL_INTEGRAL_RESTRICT = prove + (`!f:real->real s t. + s SUBSET t + ==> (((\x. if x IN s then f x else &0) has_real_integral i) t <=> + (f has_real_integral i) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral; o_DEF] THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`; `IMAGE lift t`; `lift i`] + HAS_INTEGRAL_RESTRICT) THEN + ASM_SIMP_TAC[IMAGE_SUBSET; IN_IMAGE_LIFT_DROP; o_DEF] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[LIFT_NUM]);; + +let HAS_REAL_INTEGRAL_RESTRICT_UNIV = prove + (`!f:real->real s i. + ((\x. if x IN s then f x else &0) has_real_integral i) (:real) <=> + (f has_real_integral i) s`, + SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT; SUBSET_UNIV]);; + +let HAS_REAL_INTEGRAL_SPIKE_SET_EQ = prove + (`!f s t y. + real_negligible(s DIFF t UNION t DIFF s) + ==> ((f has_real_integral y) s <=> (f has_real_integral y) t)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_EQ THEN + EXISTS_TAC `s DIFF t UNION t DIFF s:real->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let HAS_REAL_INTEGRAL_SPIKE_SET = prove + (`!f s t y. + real_negligible(s DIFF t UNION t DIFF s) /\ + (f has_real_integral y) s + ==> (f has_real_integral y) t`, + MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_SET_EQ]);; + +let REAL_INTEGRABLE_SPIKE_SET = prove + (`!f s t. + real_negligible(s DIFF t UNION t DIFF s) + ==> f real_integrable_on s ==> f real_integrable_on t`, + REWRITE_TAC[real_integrable_on] THEN + MESON_TAC[HAS_REAL_INTEGRAL_SPIKE_SET_EQ]);; + +let REAL_INTEGRABLE_SPIKE_SET_EQ = prove + (`!f s t. + real_negligible(s DIFF t UNION t DIFF s) + ==> (f real_integrable_on s <=> f real_integrable_on t)`, + MESON_TAC[REAL_INTEGRABLE_SPIKE_SET; UNION_COMM]);; + +let REAL_INTEGRAL_SPIKE_SET = prove + (`!f s t. + real_negligible(s DIFF t UNION t DIFF s) + ==> real_integral s f = real_integral t f`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integral] THEN + AP_TERM_TAC THEN ABS_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_SET_EQ THEN + ASM_MESON_TAC[]);; + +let HAS_REAL_INTEGRAL_OPEN_INTERVAL = prove + (`!f a b y. (f has_real_integral y) (real_interval(a,b)) <=> + (f has_real_integral y) (real_interval[a,b])`, + REWRITE_TAC[has_real_integral; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[HAS_INTEGRAL_OPEN_INTERVAL]);; + +let REAL_INTEGRABLE_ON_OPEN_INTERVAL = prove + (`!f a b. f real_integrable_on real_interval(a,b) <=> + f real_integrable_on real_interval[a,b]`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_OPEN_INTERVAL]);; + +let REAL_INTEGRAL_OPEN_INTERVAL = prove + (`!f a b. real_integral(real_interval(a,b)) f = + real_integral(real_interval[a,b]) f`, + REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_OPEN_INTERVAL]);; + +let HAS_REAL_INTEGRAL_ON_SUPERSET = prove + (`!f s t. + (!x. ~(x IN s) ==> f x = &0) /\ s SUBSET t /\ (f has_real_integral i) s + ==> (f has_real_integral i) t`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[]);; + +let REAL_INTEGRABLE_ON_SUPERSET = prove + (`!f s t. + (!x. ~(x IN s) ==> f x = &0) /\ s SUBSET t /\ f real_integrable_on s + ==> f real_integrable_on t`, + REWRITE_TAC[real_integrable_on] THEN + MESON_TAC[HAS_REAL_INTEGRAL_ON_SUPERSET]);; + +let REAL_INTEGRABLE_RESTRICT_UNIV = prove + (`!f s. (\x. if x IN s then f x else &0) real_integrable_on (:real) <=> + f real_integrable_on s`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_RESTRICT_UNIV]);; + +let REAL_INTEGRAL_RESTRICT_UNIV = prove + (`!f s. + real_integral (:real) (\x. if x IN s then f x else &0) = + real_integral s f`, + REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT_UNIV]);; + +let REAL_INTEGRAL_RESTRICT = prove + (`!f s t. + s SUBSET t + ==> real_integral t (\x. if x IN s then f x else &0) = + real_integral s f`, + SIMP_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT]);; + +let HAS_REAL_INTEGRAL_RESTRICT_INTER = prove + (`!f s t. + ((\x. if x IN s then f x else &0) has_real_integral i) t <=> + (f has_real_integral i) (s INTER t)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[IN_INTER] THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[]);; + +let REAL_INTEGRAL_RESTRICT_INTER = prove + (`!f s t. + real_integral t (\x. if x IN s then f x else &0) = + real_integral (s INTER t) f`, + REWRITE_TAC[real_integral; HAS_REAL_INTEGRAL_RESTRICT_INTER]);; + +let REAL_INTEGRABLE_RESTRICT_INTER = prove + (`!f s t. + (\x. if x IN s then f x else &0) real_integrable_on t <=> + f real_integrable_on (s INTER t)`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_RESTRICT_INTER]);; + +let REAL_NEGLIGIBLE_ON_INTERVALS = prove + (`!s. real_negligible s <=> + !a b:real. real_negligible(s INTER real_interval[a,b])`, + GEN_TAC THEN REWRITE_TAC[real_negligible] THEN + GEN_REWRITE_TAC LAND_CONV [NEGLIGIBLE_ON_INTERVALS] THEN + REWRITE_TAC[FORALL_LIFT; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; + +let HAS_REAL_INTEGRAL_SUBSET_LE = prove + (`!f:real->real s t i j. + s SUBSET t /\ (f has_real_integral i) s /\ (f has_real_integral j) t /\ + (!x. x IN t ==> &0 <= f x) + ==> i <= j`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN + MAP_EVERY EXISTS_TAC + [`\x:real. if x IN s then f(x) else &0`; + `\x:real. if x IN t then f(x) else &0`; `(:real)`] THEN + ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; IN_UNIV] THEN + X_GEN_TAC `x:real` THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_LE_REFL]) THEN + ASM SET_TAC[]);; + +let REAL_INTEGRAL_SUBSET_LE = prove + (`!f:real->real s t. + s SUBSET t /\ f real_integrable_on s /\ f real_integrable_on t /\ + (!x. x IN t ==> &0 <= f(x)) + ==> real_integral s f <= real_integral t f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SUBSET_LE THEN + ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; + +let REAL_INTEGRABLE_ON_SUBINTERVAL = prove + (`!f:real->real s a b. + f real_integrable_on s /\ real_interval[a,b] SUBSET s + ==> f real_integrable_on real_interval[a,b]`, + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `IMAGE lift s` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + ASM_SIMP_TAC[IMAGE_SUBSET]);; + +let REAL_INTEGRABLE_STRADDLE = prove + (`!f s. + (!e. &0 < e + ==> ?g h i j. (g has_real_integral i) s /\ + (h has_real_integral j) s /\ + abs(i - j) < e /\ + !x. x IN s ==> g x <= f x /\ f x <= h x) + ==> f real_integrable_on s`, + REWRITE_TAC[REAL_INTEGRABLE_ON; has_real_integral] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_STRADDLE THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXISTS_DROP; FORALL_IN_IMAGE] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; GSYM DROP_SUB; LIFT_DROP; GSYM ABS_DROP] THEN + MAP_EVERY X_GEN_TAC + [`g:real->real`; `h:real->real`; `i:real^1`; `j:real^1`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`lift o g o drop`; `lift o h o drop`; `i:real^1`; `j:real^1`] THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP]);; + +let HAS_REAL_INTEGRAL_STRADDLE_NULL = prove + (`!f g s. (!x. x IN s ==> &0 <= f x /\ f x <= g x) /\ + (g has_real_integral &0) s + ==> (f has_real_integral &0) s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_STRADDLE THEN + GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC + [`(\x. &0):real->real`; `g:real->real`; + `&0:real`; `&0:real`] THEN + ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_0; REAL_SUB_REFL; REAL_ABS_NUM]; + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL [`f:real->real`; `g:real->real`] + HAS_REAL_INTEGRAL_LE); + MATCH_MP_TAC(ISPECL [`(\x. &0):real->real`; `f:real->real`] + HAS_REAL_INTEGRAL_LE)] THEN + EXISTS_TAC `s:real->bool` THEN + ASM_SIMP_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL; HAS_REAL_INTEGRAL_0]]);; + +let HAS_REAL_INTEGRAL_UNION = prove + (`!f i j s t. + (f has_real_integral i) s /\ (f has_real_integral j) t /\ + real_negligible(s INTER t) + ==> (f has_real_integral (i + j)) (s UNION t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_real_integral; real_negligible; LIFT_ADD; IMAGE_UNION] THEN + DISCH_TAC THEN MATCH_MP_TAC HAS_INTEGRAL_UNION THEN POP_ASSUM MP_TAC THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; + +let HAS_REAL_INTEGRAL_UNIONS = prove + (`!f:real->real i t. + FINITE t /\ + (!s. s IN t ==> (f has_real_integral (i s)) s) /\ + (!s s'. s IN t /\ s' IN t /\ ~(s = s') ==> real_negligible(s INTER s')) + ==> (f has_real_integral (sum t i)) (UNIONS t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_real_integral; real_negligible; LIFT_ADD; IMAGE_UNIONS] THEN + SIMP_TAC[LIFT_SUM] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `\s. lift(i(IMAGE drop s))`; + `IMAGE (IMAGE lift) t`] + HAS_INTEGRAL_UNIONS) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM; + IMAGE_LIFT_DROP; GSYM IMAGE_o] THEN + ASM_SIMP_TAC[LIFT_EQ; SET_RULE + `(!x y. f x = f y <=> x = y) + ==> (IMAGE f s = IMAGE f t <=> s = t) /\ + (IMAGE f s INTER IMAGE f t = IMAGE f (s INTER t))`] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN + ANTS_TAC THENL [ASM SET_TAC[LIFT_DROP]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[o_DEF; GSYM IMAGE_o; IMAGE_LIFT_DROP]);; + +let REAL_MONOTONE_CONVERGENCE_INCREASING = prove + (`!f:num->real->real g s. + (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f k x <= f (SUC k) x) /\ + (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `lift o g o drop`; `IMAGE lift s`] + MONOTONE_CONVERGENCE_INCREASING) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; + +let REAL_MONOTONE_CONVERGENCE_DECREASING = prove + (`!f:num->real->real g s. + (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f (SUC k) x <= f k x) /\ + (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `lift o g o drop`; `IMAGE lift s`] + MONOTONE_CONVERGENCE_DECREASING) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; + +let REAL_BEPPO_LEVI_INCREASING = prove + (`!f s. (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f k x <= f (SUC k) x) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> ?g k. real_negligible k /\ + !x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `IMAGE lift s`] + BEPPO_LEVI_INCREASING) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN + REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN + ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP]);; + +let REAL_BEPPO_LEVI_DECREASING = prove + (`!f s. (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f (SUC k) x <= f k x) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> ?g k. real_negligible k /\ + !x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `IMAGE lift s`] + BEPPO_LEVI_DECREASING) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN + REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN + ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP]);; + +let REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING = prove + (`!f s. + (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f k x <= f (SUC k) x) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> ?g k. real_negligible k /\ + (!x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially) /\ + g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) + sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `IMAGE lift s`] + BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN + REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN + ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP; ETA_AX] THEN + SUBGOAL_THEN + `real_integral s (drop o g o lift) = + drop(integral (IMAGE lift s) (lift o (drop o g o lift) o drop))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX]; + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; + +let REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING = prove + (`!f s. + (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f (SUC k) x <= f k x) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> ?g k. real_negligible k /\ + (!x. x IN (s DIFF k) ==> ((\k. f k x) ---> g x) sequentially) /\ + g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) + sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `IMAGE lift s`] + BEPPO_LEVI_MONOTONE_CONVERGENCE_DECREASING) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV; GSYM ABS_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN ANTS_TAC THENL + [REWRITE_TAC[bounded] THEN EXISTS_TAC `B:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_DIFF; IMP_CONJ; FORALL_IN_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `k:real^1->bool`] THEN + REWRITE_TAC[IMP_IMP; LIFT_DROP] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`drop o g o lift`; `IMAGE drop k`] THEN + ASM_REWRITE_TAC[real_negligible; GSYM IMAGE_o; IMAGE_LIFT_DROP] THEN + ASM_REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM; LIFT_DROP; ETA_AX] THEN + SUBGOAL_THEN + `real_integral s (drop o g o lift) = + drop(integral (IMAGE lift s) (lift o (drop o g o lift) o drop))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; ETA_AX]; + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]]);; + +let REAL_INTEGRAL_ABS_BOUND_INTEGRAL = prove + (`!f:real->real g s. + f real_integrable_on s /\ g real_integrable_on s /\ + (!x. x IN s ==> abs(f x) <= g x) + ==> abs(real_integral s f) <= real_integral s g`, + SIMP_TAC[REAL_INTEGRAL; GSYM ABS_DROP] THEN + SIMP_TAC[REAL_INTEGRABLE_ON; INTEGRAL_NORM_BOUND_INTEGRAL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);; + +let ABSOLUTELY_REAL_INTEGRABLE_LE = prove + (`!f:real->real s. + f absolutely_real_integrable_on s + ==> abs(real_integral s f) <= real_integral s (\x. abs(f x))`, + SIMP_TAC[absolutely_real_integrable_on] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_LE_REFL]);; + +let ABSOLUTELY_REAL_INTEGRABLE_0 = prove + (`!s. (\x. &0) absolutely_real_integrable_on s`, + REWRITE_TAC[absolutely_real_integrable_on; REAL_ABS_NUM; + REAL_INTEGRABLE_0]);; + +let ABSOLUTELY_REAL_INTEGRABLE_CONST = prove + (`!a b c. (\x. c) absolutely_real_integrable_on real_interval[a,b]`, + REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_CONST]);; + +let ABSOLUTELY_REAL_INTEGRABLE_LMUL = prove + (`!f s c. f absolutely_real_integrable_on s + ==> (\x. c * f(x)) absolutely_real_integrable_on s`, + SIMP_TAC[absolutely_real_integrable_on; + REAL_INTEGRABLE_LMUL; REAL_ABS_MUL]);; + +let ABSOLUTELY_REAL_INTEGRABLE_RMUL = prove + (`!f s c. f absolutely_real_integrable_on s + ==> (\x. f(x) * c) absolutely_real_integrable_on s`, + SIMP_TAC[absolutely_real_integrable_on; + REAL_INTEGRABLE_RMUL; REAL_ABS_MUL]);; + +let ABSOLUTELY_REAL_INTEGRABLE_NEG = prove + (`!f s. f absolutely_real_integrable_on s + ==> (\x. --f(x)) absolutely_real_integrable_on s`, + SIMP_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_NEG; REAL_ABS_NEG]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ABS = prove + (`!f s. f absolutely_real_integrable_on s + ==> (\x. abs(f x)) absolutely_real_integrable_on s`, + SIMP_TAC[absolutely_real_integrable_on; REAL_ABS_ABS]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL = prove + (`!f:real->real s a b. + f absolutely_real_integrable_on s /\ real_interval[a,b] SUBSET s + ==> f absolutely_real_integrable_on real_interval[a,b]`, + REWRITE_TAC[absolutely_real_integrable_on] THEN + MESON_TAC[REAL_INTEGRABLE_ON_SUBINTERVAL]);; + +let ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV = prove + (`!f s. (\x. if x IN s then f x else &0) + absolutely_real_integrable_on (:real) <=> + f absolutely_real_integrable_on s`, + REWRITE_TAC[absolutely_real_integrable_on; REAL_INTEGRABLE_RESTRICT_UNIV; + COND_RAND; REAL_ABS_NUM]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ADD = prove + (`!f:real->real g s. + f absolutely_real_integrable_on s /\ + g absolutely_real_integrable_on s + ==> (\x. f(x) + g(x)) absolutely_real_integrable_on s`, + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + SIMP_TAC[o_DEF; LIFT_ADD; ABSOLUTELY_INTEGRABLE_ADD]);; + +let ABSOLUTELY_REAL_INTEGRABLE_SUB = prove + (`!f:real->real g s. + f absolutely_real_integrable_on s /\ + g absolutely_real_integrable_on s + ==> (\x. f(x) - g(x)) absolutely_real_integrable_on s`, + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + SIMP_TAC[o_DEF; LIFT_SUB; ABSOLUTELY_INTEGRABLE_SUB]);; + +let ABSOLUTELY_REAL_INTEGRABLE_LINEAR = prove + (`!f h s. + f absolutely_real_integrable_on s /\ linear(lift o h o drop) + ==> (h o f) absolutely_real_integrable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_LINEAR) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let ABSOLUTELY_REAL_INTEGRABLE_SUM = prove + (`!f:A->real->real s t. + FINITE t /\ + (!a. a IN t ==> (f a) absolutely_real_integrable_on s) + ==> (\x. sum t (\a. f a x)) absolutely_real_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; ABSOLUTELY_REAL_INTEGRABLE_0; IN_INSERT; + ABSOLUTELY_REAL_INTEGRABLE_ADD; ETA_AX]);; + +let ABSOLUTELY_REAL_INTEGRABLE_MAX = prove + (`!f:real->real g:real->real s. + f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s + ==> (\x. max (f x) (g x)) + absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `max a b = &1 / &2 * ((a + b) + abs(a - b))`] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_ABS]);; + +let ABSOLUTELY_REAL_INTEGRABLE_MIN = prove + (`!f:real->real g:real->real s. + f absolutely_real_integrable_on s /\ g absolutely_real_integrable_on s + ==> (\x. min (f x) (g x)) + absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `min a b = &1 / &2 * ((a + b) - abs(a - b))`] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[ABSOLUTELY_REAL_INTEGRABLE_SUB; ABSOLUTELY_REAL_INTEGRABLE_ADD; + ABSOLUTELY_REAL_INTEGRABLE_ABS]);; + +let ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f s. f absolutely_real_integrable_on s ==> f real_integrable_on s`, + SIMP_TAC[absolutely_real_integrable_on]);; + +let ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS = prove + (`!f a b. + f real_continuous_on real_interval[a,b] + ==> f absolutely_real_integrable_on real_interval[a,b]`, + REWRITE_TAC[REAL_CONTINUOUS_ON; ABSOLUTELY_REAL_INTEGRABLE_ON; + has_real_integral; + GSYM integrable_on; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; ABSOLUTELY_INTEGRABLE_CONTINUOUS]);; + +let NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE = prove + (`!f s. + (!x. x IN s ==> &0 <= f(x)) /\ + f real_integrable_on s + ==> f absolutely_real_integrable_on s`, + SIMP_TAC[absolutely_real_integrable_on] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN + EXISTS_TAC `f:real->real` THEN ASM_SIMP_TAC[real_abs]);; + +let ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND = prove + (`!f:real->real g s. + (!x. x IN s ==> abs(f x) <= g x) /\ + f real_integrable_on s /\ g real_integrable_on s + ==> f absolutely_real_integrable_on s`, + REWRITE_TAC[REAL_INTEGRABLE_ON; ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_BOUND = prove + (`!f:real->real g:real->real s. + (!x. x IN s ==> abs(f x) <= abs(g x)) /\ + f real_integrable_on s /\ g absolutely_real_integrable_on s + ==> f absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INTEGRABLE_BOUND THEN + EXISTS_TAC `\x:real. abs(g x)` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[absolutely_real_integrable_on]) THEN + ASM_REWRITE_TAC[]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_UBOUND = prove + (`!f:real->real g:real->real s. + (!x. x IN s ==> f x <= g x) /\ + f real_integrable_on s /\ g absolutely_real_integrable_on s + ==> g absolutely_real_integrable_on s`, + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_INTEGRABLE_ON] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_UBOUND THEN + EXISTS_TAC `lift o g o drop` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; o_THM; LIFT_DROP; + GSYM drop]);; + +let ABSOLUTELY_REAL_INTEGRABLE_ABSOLUTELY_REAL_INTEGRABLE_LBOUND = prove + (`!f:real->real g:real->real s. + (!x. x IN s ==> f x <= g x) /\ + f absolutely_real_integrable_on s /\ g real_integrable_on s + ==> g absolutely_real_integrable_on s`, + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; REAL_INTEGRABLE_ON] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + ABSOLUTELY_INTEGRABLE_ABSOLUTELY_INTEGRABLE_COMPONENT_LBOUND THEN + EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[IMP_IMP; DIMINDEX_1; FORALL_1; o_THM; LIFT_DROP; + GSYM drop]);; + +let ABSOLUTELY_REAL_INTEGRABLE_INF = prove + (`!fs s:real->bool k:A->bool. + FINITE k /\ ~(k = {}) /\ + (!i. i IN k ==> (\x. fs x i) absolutely_real_integrable_on s) + ==> (\x. inf (IMAGE (fs x) k)) absolutely_real_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN + SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN + ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MIN THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INSERT]);; + +let ABSOLUTELY_REAL_INTEGRABLE_SUP = prove + (`!fs s:real->bool k:A->bool. + FINITE k /\ ~(k = {}) /\ + (!i. i IN k ==> (\x. fs x i) absolutely_real_integrable_on s) + ==> (\x. sup (IMAGE (fs x) k)) absolutely_real_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN + SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `k:A->bool`] THEN + ASM_CASES_TAC `k:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_INSERT]);; + +let REAL_DOMINATED_CONVERGENCE = prove + (`!f:num->real->real g h s. + (!k. (f k) real_integrable_on s) /\ h real_integrable_on s /\ + (!k x. x IN s ==> abs(f k x) <= h x) /\ + (!x. x IN s ==> ((\k. f k x) ---> g x) sequentially) + ==> g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `lift o g o drop`; `lift o h o drop`; `IMAGE lift s`] + DOMINATED_CONVERGENCE) THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF; NORM_LIFT] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; + +let HAS_REAL_MEASURE_HAS_MEASURE = prove + (`!s m. s has_real_measure m <=> (IMAGE lift s) has_measure m`, + REWRITE_TAC[has_real_measure; has_measure; has_real_integral] THEN + REWRITE_TAC[o_DEF; LIFT_NUM]);; + +let REAL_MEASURABLE_MEASURABLE = prove + (`!s. real_measurable s <=> measurable(IMAGE lift s)`, + REWRITE_TAC[real_measurable; measurable; HAS_REAL_MEASURE_HAS_MEASURE]);; + +let REAL_MEASURE_MEASURE = prove + (`!s. real_measure s = measure (IMAGE lift s)`, + REWRITE_TAC[real_measure; measure; HAS_REAL_MEASURE_HAS_MEASURE]);; + +let HAS_REAL_MEASURE_MEASURE = prove + (`!s. real_measurable s <=> s has_real_measure (real_measure s)`, + REWRITE_TAC[real_measure; real_measurable] THEN MESON_TAC[]);; + +let HAS_REAL_MEASURE_UNIQUE = prove + (`!s m1 m2. s has_real_measure m1 /\ s has_real_measure m2 ==> m1 = m2`, + REWRITE_TAC[has_real_measure] THEN MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]);; + +let REAL_MEASURE_UNIQUE = prove + (`!s m. s has_real_measure m ==> real_measure s = m`, + MESON_TAC[HAS_REAL_MEASURE_UNIQUE; HAS_REAL_MEASURE_MEASURE; + real_measurable]);; + +let HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE = prove + (`!s m. s has_real_measure m <=> real_measurable s /\ real_measure s = m`, + REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN MESON_TAC[REAL_MEASURE_UNIQUE]);; + +let HAS_REAL_MEASURE_IMP_REAL_MEASURABLE = prove + (`!s m. s has_real_measure m ==> real_measurable s`, + REWRITE_TAC[real_measurable] THEN MESON_TAC[]);; + +let HAS_REAL_MEASURE = prove + (`!s m. s has_real_measure m <=> + ((\x. if x IN s then &1 else &0) has_real_integral m) (:real)`, + SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV; has_real_measure]);; + +let REAL_MEASURABLE = prove + (`!s. real_measurable s <=> (\x. &1) real_integrable_on s`, + REWRITE_TAC[real_measurable; real_integrable_on; + has_real_measure; EXISTS_DROP; LIFT_DROP]);; + +let REAL_MEASURABLE_REAL_INTEGRABLE = prove + (`real_measurable s <=> + (\x. if x IN s then &1 else &0) real_integrable_on UNIV`, + REWRITE_TAC[real_measurable; real_integrable_on; HAS_REAL_MEASURE]);; + +let REAL_MEASURE_REAL_INTEGRAL = prove + (`!s. real_measurable s ==> real_measure s = real_integral s (\x. &1)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_REWRITE_TAC[GSYM has_real_measure; GSYM HAS_REAL_MEASURE_MEASURE]);; + +let REAL_MEASURE_REAL_INTEGRAL_UNIV = prove + (`!s. real_measurable s + ==> real_measure s = + real_integral UNIV (\x. if x IN s then &1 else &0)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE; GSYM HAS_REAL_MEASURE_MEASURE]);; + +let REAL_INTEGRAL_REAL_MEASURE = prove + (`!s. real_measurable s ==> real_integral s (\x. &1) = real_measure s`, + SIMP_TAC[GSYM DROP_EQ; LIFT_DROP; REAL_MEASURE_REAL_INTEGRAL]);; + +let REAL_INTEGRAL_REAL_MEASURE_UNIV = prove + (`!s. real_measurable s + ==> real_integral UNIV (\x. if x IN s then &1 else &0) = + real_measure s`, + SIMP_TAC[REAL_MEASURE_REAL_INTEGRAL_UNIV]);; + +let HAS_REAL_MEASURE_REAL_INTERVAL = prove + (`(!a b. real_interval[a,b] has_real_measure (max (b - a) (&0))) /\ + (!a b. real_interval(a,b) has_real_measure (max (b - a) (&0)))`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[HAS_MEASURE_MEASURABLE_MEASURE; MEASURABLE_INTERVAL; + MEASURE_INTERVAL] THEN + REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES; DIMINDEX_1; FORALL_1] THEN + REWRITE_TAC[PRODUCT_1; GSYM drop; LIFT_DROP] THEN REAL_ARITH_TAC);; + +let REAL_MEASURABLE_REAL_INTERVAL = prove + (`(!a b. real_measurable (real_interval[a,b])) /\ + (!a b. real_measurable (real_interval(a,b)))`, + REWRITE_TAC[real_measurable] THEN + MESON_TAC[HAS_REAL_MEASURE_REAL_INTERVAL]);; + +let REAL_MEASURE_REAL_INTERVAL = prove + (`(!a b. real_measure(real_interval[a,b]) = max (b - a) (&0)) /\ + (!a b. real_measure(real_interval(a,b)) = max (b - a) (&0))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + REWRITE_TAC[HAS_REAL_MEASURE_REAL_INTERVAL]);; + +let REAL_MEASURABLE_INTER = prove + (`!s t. real_measurable s /\ real_measurable t + ==> real_measurable (s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_INTER) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_UNION = prove + (`!s t. real_measurable s /\ real_measurable t + ==> real_measurable (s UNION t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_UNION) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[LIFT_DROP]);; + +let HAS_REAL_MEASURE_DISJOINT_UNION = prove + (`!s1 s2 m1 m2. s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ + DISJOINT s1 s2 + ==> (s1 UNION s2) has_real_measure (m1 + m2)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; IMAGE_UNION] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_DISJOINT_UNION THEN + ASM SET_TAC[LIFT_DROP]);; + +let REAL_MEASURE_DISJOINT_UNION = prove + (`!s t. real_measurable s /\ real_measurable t /\ DISJOINT s t + ==> real_measure(s UNION t) = real_measure s + real_measure t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNION; + GSYM HAS_REAL_MEASURE_MEASURE]);; + +let HAS_REAL_MEASURE_POS_LE = prove + (`!m s. s has_real_measure m ==> &0 <= m`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; HAS_MEASURE_POS_LE]);; + +let REAL_MEASURE_POS_LE = prove + (`!s. real_measurable s ==> &0 <= real_measure s`, + REWRITE_TAC[HAS_REAL_MEASURE_MEASURE; HAS_REAL_MEASURE_POS_LE]);; + +let HAS_REAL_MEASURE_SUBSET = prove + (`!s1 s2 m1 m2. + s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ s1 SUBSET s2 + ==> m1 <= m2`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPECL [`IMAGE lift s1`; `IMAGE lift s2`] + HAS_MEASURE_SUBSET) THEN + ASM SET_TAC[HAS_MEASURE_SUBSET]);; + +let REAL_MEASURE_SUBSET = prove + (`!s t. real_measurable s /\ real_measurable t /\ s SUBSET t + ==> real_measure s <= real_measure t`, + REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN + MESON_TAC[HAS_REAL_MEASURE_SUBSET]);; + +let HAS_REAL_MEASURE_0 = prove + (`!s. s has_real_measure &0 <=> real_negligible s`, + REWRITE_TAC[real_negligible; HAS_REAL_MEASURE_HAS_MEASURE] THEN + REWRITE_TAC[HAS_MEASURE_0]);; + +let REAL_MEASURE_EQ_0 = prove + (`!s. real_negligible s ==> real_measure s = &0`, + MESON_TAC[REAL_MEASURE_UNIQUE; HAS_REAL_MEASURE_0]);; + +let HAS_REAL_MEASURE_EMPTY = prove + (`{} has_real_measure &0`, + REWRITE_TAC[HAS_REAL_MEASURE_0; REAL_NEGLIGIBLE_EMPTY]);; + +let REAL_MEASURE_EMPTY = prove + (`real_measure {} = &0`, + SIMP_TAC[REAL_MEASURE_EQ_0; REAL_NEGLIGIBLE_EMPTY]);; + +let REAL_MEASURABLE_EMPTY = prove + (`real_measurable {}`, + REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_EMPTY]);; + +let REAL_MEASURABLE_REAL_MEASURE_EQ_0 = prove + (`!s. real_measurable s ==> (real_measure s = &0 <=> real_negligible s)`, + REWRITE_TAC[HAS_REAL_MEASURE_MEASURE; GSYM HAS_REAL_MEASURE_0] THEN + MESON_TAC[REAL_MEASURE_UNIQUE]);; + +let REAL_MEASURABLE_REAL_MEASURE_POS_LT = prove + (`!s. real_measurable s ==> (&0 < real_measure s <=> ~real_negligible s)`, + SIMP_TAC[REAL_LT_LE; REAL_MEASURE_POS_LE; + GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0] THEN + REWRITE_TAC[EQ_SYM_EQ]);; + +let REAL_NEGLIGIBLE_REAL_INTERVAL = prove + (`(!a b. real_negligible(real_interval[a,b]) <=> real_interval(a,b) = {}) /\ + (!a b. real_negligible(real_interval(a,b)) <=> real_interval(a,b) = {})`, + REWRITE_TAC[real_negligible; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[NEGLIGIBLE_INTERVAL] THEN + REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; INTERVAL_EQ_EMPTY_1; LIFT_DROP]);; + +let REAL_MEASURABLE_UNIONS = prove + (`!f. FINITE f /\ (!s. s IN f ==> real_measurable s) + ==> real_measurable (UNIONS f)`, + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; IMAGE_UNIONS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]);; + +let HAS_REAL_MEASURE_DIFF_SUBSET = prove + (`!s1 s2 m1 m2. + s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ s2 SUBSET s1 + ==> (s1 DIFF s2) has_real_measure (m1 - m2)`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN REPEAT STRIP_TAC THEN + SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN + MATCH_MP_TAC HAS_MEASURE_DIFF_SUBSET THEN + ASM_SIMP_TAC[IMAGE_SUBSET]);; + +let REAL_MEASURABLE_DIFF = prove + (`!s t. real_measurable s /\ real_measurable t + ==> real_measurable (s DIFF t)`, + SIMP_TAC[REAL_MEASURABLE_MEASURABLE; IMAGE_DIFF_INJ; LIFT_EQ] THEN + REWRITE_TAC[MEASURABLE_DIFF]);; + +let REAL_MEASURE_DIFF_SUBSET = prove + (`!s t. real_measurable s /\ real_measurable t /\ t SUBSET s + ==> real_measure(s DIFF t) = real_measure s - real_measure t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_DIFF_SUBSET; GSYM HAS_REAL_MEASURE_MEASURE]);; + +let HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE = prove + (`!s t m. + s has_real_measure m /\ real_negligible t + ==> (s UNION t) has_real_measure m`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN + REWRITE_TAC[HAS_MEASURE_UNION_NEGLIGIBLE]);; + +let HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE = prove + (`!s t m. + s has_real_measure m /\ real_negligible t + ==> (s DIFF t) has_real_measure m`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible] THEN + SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN + REWRITE_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE]);; + +let HAS_REAL_MEASURE_UNION_REAL_NEGLIGIBLE_EQ = prove + (`!s t m. + real_negligible t + ==> ((s UNION t) has_real_measure m <=> s has_real_measure m)`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN + REWRITE_TAC[HAS_MEASURE_UNION_NEGLIGIBLE_EQ]);; + +let HAS_REAL_MEASURE_DIFF_REAL_NEGLIGIBLE_EQ = prove + (`!s t m. + real_negligible t + ==> ((s DIFF t) has_real_measure m <=> s has_real_measure m)`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible] THEN + SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN + REWRITE_TAC[HAS_MEASURE_DIFF_NEGLIGIBLE_EQ]);; + +let HAS_REAL_MEASURE_ALMOST = prove + (`!s s' t m. s has_real_measure m /\ real_negligible t /\ + s UNION t = s' UNION t + ==> s' has_real_measure m`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_MEASURE_ALMOST THEN + MAP_EVERY EXISTS_TAC [`IMAGE lift s`; `IMAGE lift t`] THEN ASM SET_TAC[]);; + +let HAS_REAL_MEASURE_ALMOST_EQ = prove + (`!s s' t. real_negligible t /\ s UNION t = s' UNION t + ==> (s has_real_measure m <=> s' has_real_measure m)`, + MESON_TAC[HAS_REAL_MEASURE_ALMOST]);; + +let REAL_MEASURABLE_ALMOST = prove + (`!s s' t. real_measurable s /\ real_negligible t /\ s UNION t = s' UNION t + ==> real_measurable s'`, + REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_ALMOST]);; + +let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION = prove + (`!s1 s2 m1 m2. + s1 has_real_measure m1 /\ s2 has_real_measure m2 /\ + real_negligible(s1 INTER s2) + ==> (s1 UNION s2) has_real_measure (m1 + m2)`, + REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE; real_negligible; IMAGE_UNION] THEN + SIMP_TAC[IMAGE_INTER_INJ; LIFT_EQ] THEN + REWRITE_TAC[HAS_MEASURE_NEGLIGIBLE_UNION]);; + +let REAL_MEASURE_REAL_NEGLIGIBLE_UNION = prove + (`!s t. real_measurable s /\ real_measurable t /\ real_negligible(s INTER t) + ==> real_measure(s UNION t) = real_measure s + real_measure t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION; + GSYM HAS_REAL_MEASURE_MEASURE]);; + +let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF = prove + (`!s t m. + s has_real_measure m /\ + real_negligible((s DIFF t) UNION (t DIFF s)) + ==> t has_real_measure m`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_ALMOST THEN + MAP_EVERY EXISTS_TAC + [`s:real->bool`; `(s DIFF t) UNION (t DIFF s):real->bool`] THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF = prove + (`!s t. real_measurable s /\ real_negligible((s DIFF t) UNION (t DIFF s)) + ==> real_measurable t`, + REWRITE_TAC[real_measurable] THEN + MESON_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF]);; + +let REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF = prove + (`!s t. (real_measurable s \/ real_measurable t) /\ + real_negligible((s DIFF t) UNION (t DIFF s)) + ==> real_measure s = real_measure t`, + MESON_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF; REAL_MEASURE_UNIQUE; + UNION_COMM; HAS_REAL_MEASURE_MEASURE]);; + +let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS = prove + (`!m f. FINITE f /\ + (!s. s IN f ==> s has_real_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> real_negligible(s INTER t)) + ==> (UNIONS f) has_real_measure (sum f m)`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; UNIONS_0; UNIONS_INSERT; HAS_REAL_MEASURE_EMPTY] THEN + REWRITE_TAC[IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`s:real->bool`; `f:(real->bool)->bool`] THEN + STRIP_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNION THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[INTER_UNIONS] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_UNIONS THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS = prove + (`!m f. FINITE f /\ + (!s. s IN f ==> s has_real_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> real_negligible(s INTER t)) + ==> real_measure(UNIONS f) = sum f m`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS]);; + +let HAS_REAL_MEASURE_DISJOINT_UNIONS = prove + (`!m f. FINITE f /\ + (!s. s IN f ==> s has_real_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) + ==> (UNIONS f) has_real_measure (sum f m)`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS THEN + ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);; + +let REAL_MEASURE_DISJOINT_UNIONS = prove + (`!m f:(real->bool)->bool. + FINITE f /\ + (!s. s IN f ==> s has_real_measure (m s)) /\ + (!s t. s IN f /\ t IN f /\ ~(s = t) ==> DISJOINT s t) + ==> real_measure(UNIONS f) = sum f m`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS]);; + +let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE = prove + (`!f:A->(real->bool) s. + FINITE s /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> real_negligible((f x) INTER (f y))) + ==> (UNIONS (IMAGE f s)) has_real_measure + (sum s (\x. real_measure(f x)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum s (\x. real_measure(f x)) = + sum (IMAGE (f:A->real->bool) s) real_measure` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC SUM_IMAGE_NONZERO THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `y:A`]) THEN + ASM_SIMP_TAC[INTER_ACI; REAL_MEASURABLE_REAL_MEASURE_EQ_0]; + MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS THEN + ASM_SIMP_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[FINITE_IMAGE; HAS_REAL_MEASURE_MEASURE]]);; + +let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE = prove + (`!f:A->real->bool s. + FINITE s /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> real_negligible((f x) INTER (f y))) + ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE]);; + +let HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE = prove + (`!f:A->real->bool s. + FINITE s /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> (UNIONS (IMAGE f s)) has_real_measure + (sum s (\x. real_measure(f x)))`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE THEN + ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);; + +let REAL_MEASURE_DISJOINT_UNIONS_IMAGE = prove + (`!f:A->real->bool s. + FINITE s /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE]);; + +let HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove + (`!f:A->real->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> real_negligible((f x) INTER (f y))) + ==> (UNIONS (IMAGE f s)) has_real_measure + (sum s (\x. real_measure(f x)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->real->bool`; + `{x | x IN s /\ ~((f:A->real->bool) x = {})}`] + HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE) THEN + ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[NOT_IN_EMPTY]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; TAUT `a /\ ~(a /\ b) <=> a /\ ~b`] THEN + REWRITE_TAC[REAL_MEASURE_EMPTY]]);; + +let REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG = prove + (`!f:A->real->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> real_negligible((f x) INTER (f y))) + ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG]);; + +let HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove + (`!f:A->real->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> (UNIONS (IMAGE f s)) has_real_measure + (sum s (\x. real_measure(f x)))`, + REWRITE_TAC[DISJOINT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE_STRONG THEN + ASM_SIMP_TAC[REAL_NEGLIGIBLE_EMPTY]);; + +let REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG = prove + (`!f:A->real->bool s. + FINITE {x | x IN s /\ ~(f x = {})} /\ + (!x. x IN s ==> real_measurable(f x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> real_measure(UNIONS (IMAGE f s)) = sum s (\x. real_measure(f x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_DISJOINT_UNIONS_IMAGE_STRONG]);; + +let REAL_MEASURE_UNION = prove + (`!s t. real_measurable s /\ real_measurable t + ==> real_measure(s UNION t) = + real_measure(s) + real_measure(t) - real_measure(s INTER t)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `s UNION t = (s INTER t) UNION (s DIFF t) UNION (t DIFF s)`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + b - c:real = c + (a - c) + (b - c)`] THEN + MP_TAC(ISPECL [`s DIFF t:real->bool`; `t DIFF s:real->bool`] + REAL_MEASURE_DISJOINT_UNION) THEN + ASM_SIMP_TAC[REAL_MEASURABLE_DIFF] THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s INTER t:real->bool`; + `(s DIFF t) UNION (t DIFF s):real->bool`] + REAL_MEASURE_DISJOINT_UNION) THEN + ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; + REAL_MEASURABLE_UNION; REAL_MEASURABLE_INTER] THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + REPEAT(DISCH_THEN SUBST1_TAC) THEN AP_TERM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[REAL_EQ_SUB_LADD] THEN MATCH_MP_TAC EQ_TRANS THENL + [EXISTS_TAC `real_measure((s DIFF t) UNION (s INTER t):real->bool)`; + EXISTS_TAC `real_measure((t DIFF s) UNION (s INTER t):real->bool)`] THEN + (CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MEASURE_DISJOINT_UNION THEN + ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; REAL_MEASURABLE_INTER]; + AP_TERM_TAC] THEN + SET_TAC[]));; + +let REAL_MEASURE_UNION_LE = prove + (`!s t. real_measurable s /\ real_measurable t + ==> real_measure(s UNION t) <= real_measure s + real_measure t`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_MEASURE_UNION] THEN + REWRITE_TAC[REAL_ARITH `a + b - c <= a + b <=> &0 <= c`] THEN + MATCH_MP_TAC REAL_MEASURE_POS_LE THEN ASM_SIMP_TAC[REAL_MEASURABLE_INTER]);; + +let REAL_MEASURE_UNIONS_LE = prove + (`!f. FINITE f /\ (!s. s IN f ==> real_measurable s) + ==> real_measure(UNIONS f) <= sum f (\s. real_measure s)`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES] THEN + REWRITE_TAC[REAL_MEASURE_EMPTY; REAL_LE_REFL] THEN + MAP_EVERY X_GEN_TAC [`s:real->bool`; `f:(real->bool)->bool`] THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_measure(s) + real_measure(UNIONS f)` THEN + ASM_SIMP_TAC[REAL_MEASURE_UNION_LE; REAL_MEASURABLE_UNIONS] THEN + REWRITE_TAC[REAL_LE_LADD] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[]);; + +let REAL_MEASURE_UNIONS_LE_IMAGE = prove + (`!f:A->bool s:A->(real->bool). + FINITE f /\ (!a. a IN f ==> real_measurable(s a)) + ==> real_measure(UNIONS (IMAGE s f)) <= sum f (\a. real_measure(s a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE s (f:A->bool)) (\k:real->bool. real_measure k)` THEN + ASM_SIMP_TAC[REAL_MEASURE_UNIONS_LE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SUM_IMAGE_LE THEN + ASM_SIMP_TAC[REAL_MEASURE_POS_LE]);; + +let REAL_NEGLIGIBLE_OUTER = prove + (`!s. real_negligible s <=> + !e. &0 < e + ==> ?t. s SUBSET t /\ real_measurable t /\ real_measure t < e`, + REWRITE_TAC[real_negligible; REAL_MEASURABLE_MEASURABLE; + REAL_MEASURE_MEASURE; SUBSET_LIFT_IMAGE; + NEGLIGIBLE_OUTER; EXISTS_LIFT_IMAGE]);; + +let REAL_NEGLIGIBLE_OUTER_LE = prove + (`!s. real_negligible s <=> + !e. &0 < e + ==> ?t. s SUBSET t /\ real_measurable t /\ real_measure t <= e`, + REWRITE_TAC[real_negligible; REAL_MEASURABLE_MEASURABLE; + REAL_MEASURE_MEASURE; SUBSET_LIFT_IMAGE; + NEGLIGIBLE_OUTER_LE; EXISTS_LIFT_IMAGE]);; + +let REAL_MEASURABLE_INNER_OUTER = prove + (`!s. real_measurable s <=> + !e. &0 < e + ==> ?t u. t SUBSET s /\ s SUBSET u /\ + real_measurable t /\ real_measurable u /\ + abs(real_measure t - real_measure u) < e`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN REPEAT(EXISTS_TAC `s:real->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL; REAL_SUB_REFL; REAL_ABS_NUM]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTEGRABLE] THEN + MATCH_MP_TAC REAL_INTEGRABLE_STRADDLE THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real->bool`; `u:real->bool`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(\x. if x IN t then &1 else &0):real->real`; + `(\x. if x IN u then &1 else &0):real->real`; + `real_measure(t:real->bool)`; + `real_measure(u:real->bool)`] THEN + ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE; GSYM HAS_REAL_MEASURE_MEASURE] THEN + ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[DROP_VEC; REAL_POS; REAL_LE_REFL]) THEN + ASM SET_TAC[]);; + +let HAS_REAL_MEASURE_INNER_OUTER = prove + (`!s m. s has_real_measure m <=> + (!e. &0 < e ==> ?t. t SUBSET s /\ real_measurable t /\ + m - e < real_measure t) /\ + (!e. &0 < e ==> ?u. s SUBSET u /\ real_measurable u /\ + real_measure u < m + e)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV + [HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE] THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `s:real->bool` THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "t") (LABEL_TAC "u")) THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [GEN_REWRITE_TAC I [REAL_MEASURABLE_INNER_OUTER] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "u" (MP_TAC o SPEC `e / &2`) THEN + REMOVE_THEN "t" (MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ t <= u /\ m - e / &2 < t /\ u < m + e / &2 + ==> abs(t - u) < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `~(&0 < x - y) /\ ~(&0 < y - x) ==> x = y`) THEN + CONJ_TAC THEN DISCH_TAC THENL + [REMOVE_THEN "u" (MP_TAC o SPEC `real_measure(s:real->bool) - m`) THEN + ASM_REWRITE_TAC[REAL_SUB_ADD2; GSYM REAL_NOT_LE]; + REMOVE_THEN "t" (MP_TAC o SPEC `m - real_measure(s:real->bool)`) THEN + ASM_REWRITE_TAC[REAL_SUB_SUB2; GSYM REAL_NOT_LE]] THEN + ASM_MESON_TAC[REAL_MEASURE_SUBSET]]);; + +let HAS_REAL_MEASURE_INNER_OUTER_LE = prove + (`!s:real->bool m. + s has_real_measure m <=> + (!e. &0 < e ==> ?t. t SUBSET s /\ real_measurable t /\ + m - e <= real_measure t) /\ + (!e. &0 < e ==> ?u. s SUBSET u /\ real_measurable u /\ + real_measure u <= m + e)`, + REWRITE_TAC[HAS_REAL_MEASURE_INNER_OUTER] THEN + MESON_TAC[REAL_ARITH `&0 < e /\ m - e / &2 <= t ==> m - e < t`; + REAL_ARITH `&0 < e /\ u <= m + e / &2 ==> u < m + e`; + REAL_ARITH `&0 < e <=> &0 < e / &2`; REAL_LT_IMP_LE]);; + +let HAS_REAL_MEASURE_AFFINITY = prove + (`!s m c y. s has_real_measure y + ==> (IMAGE (\x. m * x + c) s) has_real_measure abs(m) * y`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_HAS_MEASURE] THEN + DISCH_THEN(MP_TAC o SPECL [`m:real`; `lift c`] o MATCH_MP + HAS_MEASURE_AFFINITY) THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1; GSYM IMAGE_o] THEN + MATCH_MP_TAC EQ_IMP THEN REPEAT(AP_THM_TAC THEN AP_TERM_TAC) THEN + SIMP_TAC[FUN_EQ_THM; FORALL_DROP; o_THM; LIFT_DROP; LIFT_ADD; LIFT_CMUL]);; + +let HAS_REAL_MEASURE_SCALING = prove + (`!s m y. s has_real_measure y + ==> (IMAGE (\x. m * x) s) has_real_measure abs(m) * y`, + ONCE_REWRITE_TAC[REAL_ARITH `m * x = m * x + &0`] THEN + REWRITE_TAC[REAL_ARITH `abs m * x + &0 = abs m * x`] THEN + REWRITE_TAC[HAS_REAL_MEASURE_AFFINITY]);; + +let HAS_REAL_MEASURE_TRANSLATION = prove + (`!s m a. s has_real_measure m ==> (IMAGE (\x. a + x) s) has_real_measure m`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a + x = &1 * x + a`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [REAL_ARITH `m = abs(&1) * m`] THEN + REWRITE_TAC[HAS_REAL_MEASURE_AFFINITY]);; + +let REAL_NEGLIGIBLE_TRANSLATION = prove + (`!s a. real_negligible s ==> real_negligible (IMAGE (\x. a + x) s)`, + SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION]);; + +let HAS_REAL_MEASURE_TRANSLATION_EQ = prove + (`!s m. (IMAGE (\x. a + x) s) has_real_measure m <=> s has_real_measure m`, + REPEAT GEN_TAC THEN EQ_TAC THEN + REWRITE_TAC[HAS_REAL_MEASURE_TRANSLATION] THEN + DISCH_THEN(MP_TAC o SPEC `--a:real` o + MATCH_MP HAS_REAL_MEASURE_TRANSLATION) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; REAL_ARITH `--a + a + b:real = b`] THEN + SET_TAC[]);; + +let REAL_NEGLIGIBLE_TRANSLATION_REV = prove + (`!s a. real_negligible (IMAGE (\x. a + x) s) ==> real_negligible s`, + SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION_EQ]);; + +let REAL_NEGLIGIBLE_TRANSLATION_EQ = prove + (`!s a. real_negligible (IMAGE (\x. a + x) s) <=> real_negligible s`, + SIMP_TAC[GSYM HAS_REAL_MEASURE_0; HAS_REAL_MEASURE_TRANSLATION_EQ]);; + +let REAL_MEASURABLE_TRANSLATION = prove + (`!s. real_measurable (IMAGE (\x. a + x) s) <=> real_measurable s`, + REWRITE_TAC[real_measurable; HAS_REAL_MEASURE_TRANSLATION_EQ]);; + +let REAL_MEASURE_TRANSLATION = prove + (`!s. real_measurable s + ==> real_measure(IMAGE (\x. a + x) s) = real_measure s`, + REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_REWRITE_TAC[HAS_REAL_MEASURE_TRANSLATION_EQ]);; + +let HAS_REAL_MEASURE_SCALING_EQ = prove + (`!s m c. ~(c = &0) + ==> ((IMAGE (\x. c * x) s) has_real_measure (abs(c) * m) <=> + s has_real_measure m)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[HAS_REAL_MEASURE_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv(c:real)` o + MATCH_MP HAS_REAL_MEASURE_SCALING) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN + REWRITE_TAC[GSYM REAL_POW_MUL; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[GSYM REAL_ABS_MUL; REAL_MUL_LINV] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_ABS_NUM; REAL_MUL_LID] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; + +let REAL_MEASURABLE_SCALING = prove + (`!s c. real_measurable s ==> real_measurable (IMAGE (\x. c * x) s)`, + REWRITE_TAC[real_measurable] THEN MESON_TAC[HAS_REAL_MEASURE_SCALING]);; + +let REAL_MEASURABLE_SCALING_EQ = prove + (`!s c. ~(c = &0) + ==> (real_measurable (IMAGE (\x. c * x) s) <=> real_measurable s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REWRITE_TAC[REAL_MEASURABLE_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP REAL_MEASURABLE_SCALING) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; GSYM REAL_ABS_MUL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID] THEN + SET_TAC[]);; + +let REAL_MEASURE_SCALING = prove + (`!s. real_measurable s + ==> real_measure(IMAGE (\x. c * x) s) = abs(c) * real_measure s`, + REWRITE_TAC[HAS_REAL_MEASURE_MEASURE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_SCALING]);; + +let HAS_REAL_MEASURE_NESTED_UNIONS = prove + (`!s B. (!n. real_measurable(s n)) /\ + (!n. real_measure(s n) <= B) /\ + (!n. s(n) SUBSET s(SUC n)) + ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\ + ((\n. real_measure(s n)) + ---> real_measure(UNIONS { s(n) | n IN (:num) })) + sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[REAL_MEASURE_MEASURE] THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN + MP_TAC(ISPECL [`IMAGE lift o (s:num->real->bool)`; `B:real`] + HAS_MEASURE_NESTED_UNIONS) THEN + ASM_SIMP_TAC[o_THM; IMAGE_SUBSET] THEN + REWRITE_TAC[SET_RULE `{IMAGE f (s n) | P n} = IMAGE (IMAGE f) {s n | P n}`; + GSYM IMAGE_UNIONS] THEN + SIMP_TAC[REAL_MEASURE_MEASURE; REAL_MEASURABLE_MEASURABLE]);; + +let REAL_MEASURABLE_NESTED_UNIONS = prove + (`!s B. (!n. real_measurable(s n)) /\ + (!n. real_measure(s n) <= B) /\ + (!n. s(n) SUBSET s(SUC n)) + ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_MEASURE_NESTED_UNIONS) THEN + SIMP_TAC[]);; + +let HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS = prove + (`!s:num->real->bool B. + (!n. real_measurable(s n)) /\ + (!m n. ~(m = n) ==> real_negligible(s m INTER s n)) /\ + (!n. sum (0..n) (\k. real_measure(s k)) <= B) + ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\ + ((\n. real_measure(s n)) real_sums + real_measure(UNIONS { s(n) | n IN (:num) })) (from 0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real->bool`; `B:real`] + HAS_REAL_MEASURE_NESTED_UNIONS) THEN + REWRITE_TAC[real_sums; FROM_0; INTER_UNIV] THEN + SUBGOAL_THEN + `!n. (UNIONS (IMAGE s (0..n)):real->bool) has_real_measure + (sum(0..n) (\k. real_measure(s k)))` + MP_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_REAL_NEGLIGIBLE_UNIONS_IMAGE THEN + ASM_SIMP_TAC[FINITE_NUMSEG]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN + ASSUME_TAC(GEN `n:num` (MATCH_MP REAL_MEASURE_UNIQUE + (SPEC `n:num` th)))) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[real_measurable]; ALL_TAC] THEN + GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN + SUBGOAL_THEN + `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real->bool = + UNIONS (IMAGE s (:num))` + (fun th -> REWRITE_TAC[th] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[]) THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]);; + +let REAL_NEGLIGIBLE_COUNTABLE_UNIONS = prove + (`!s:num->real->bool. + (!n. real_negligible(s n)) + ==> real_negligible(UNIONS {s(n) | n IN (:num)})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:num->real->bool`; `&0`] + HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS) THEN + ASM_SIMP_TAC[REAL_MEASURE_EQ_0; SUM_0; REAL_LE_REFL; LIFT_NUM] THEN + ANTS_TAC THENL + [ASM_MESON_TAC[HAS_REAL_MEASURE_0; real_measurable; INTER_SUBSET; + REAL_NEGLIGIBLE_SUBSET]; + ALL_TAC] THEN + SIMP_TAC[GSYM REAL_MEASURABLE_REAL_MEASURE_EQ_0] THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN REWRITE_TAC[LIFT_NUM] THEN + MAP_EVERY EXISTS_TAC [`(\k. &0):num->real`; `from 0`] THEN + ASM_REWRITE_TAC[REAL_SERIES_0]);; + +let REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG = prove + (`!s:num->real->bool B. + (!n. real_measurable(s n)) /\ + (!n. real_measure(UNIONS {s k | k <= n}) <= B) + ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n. UNIONS (IMAGE s (0..n)):real->bool`; `B:real`] + REAL_MEASURABLE_NESTED_UNIONS) THEN + SUBGOAL_THEN + `UNIONS {UNIONS (IMAGE s (0..n)) | n IN (:num)}:real->bool = + UNIONS (IMAGE s (:num))` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_UNIONS] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; EXISTS_IN_UNIONS; IN_UNIV] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN MESON_TAC[LE_REFL]; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE; FINITE_NUMSEG]; + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + ASM_REWRITE_TAC[IN_NUMSEG; LE_0]; + GEN_TAC THEN MATCH_MP_TAC SUBSET_UNIONS THEN + MATCH_MP_TAC IMAGE_SUBSET THEN + REWRITE_TAC[SUBSET; IN_NUMSEG; LE_0] THEN ARITH_TAC]);; + +let HAS_REAL_MEASURE_COUNTABLE_REAL_NEGLIGIBLE_UNIONS_BOUNDED = prove + (`!s. (!n. real_measurable(s n)) /\ + (!m n. ~(m = n) ==> real_negligible(s m INTER s n)) /\ + real_bounded(UNIONS { s(n) | n IN (:num) }) + ==> real_measurable(UNIONS { s(n) | n IN (:num) }) /\ + ((\n. real_measure(s n)) real_sums + real_measure(UNIONS { s(n) | n IN (:num) })) (from 0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN + REWRITE_TAC[REAL_BOUNDED] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[REAL_MEASURE_MEASURE] THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; real_negligible] THEN + REPEAT(DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC)) THEN + MP_TAC(ISPEC `IMAGE lift o (s:num->real->bool)` + HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN + ASM_SIMP_TAC[o_THM; IMAGE_SUBSET] THEN + REWRITE_TAC[SET_RULE `{IMAGE f (s n) | P n} = IMAGE (IMAGE f) {s n | P n}`; + GSYM IMAGE_UNIONS] THEN + ASM_SIMP_TAC[GSYM IMAGE_INTER_INJ; LIFT_EQ] THEN + SIMP_TAC[REAL_SUMS; o_DEF; REAL_MEASURE_MEASURE; + REAL_MEASURABLE_MEASURABLE]);; + +let REAL_MEASURABLE_COUNTABLE_UNIONS = prove + (`!s B. (!n. real_measurable(s n)) /\ + (!n. sum (0..n) (\k. real_measure(s k)) <= B) + ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN + EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k. real_measure(s k:real->bool))` THEN + ASM_REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (rand o rand) REAL_MEASURE_UNIONS_LE_IMAGE o + rand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + REWRITE_TAC[IN_NUMSEG; LE_0]);; + +let REAL_MEASURABLE_COUNTABLE_UNIONS_BOUNDED = prove + (`!s. (!n. real_measurable(s n)) /\ + real_bounded(UNIONS { s(n) | n IN (:num) }) + ==> real_measurable(UNIONS { s(n) | n IN (:num) })`, + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; REAL_BOUNDED] THEN + SIMP_TAC[IMAGE_INTER_INJ; LIFT_EQ; IMAGE_UNIONS] THEN + REWRITE_TAC[SET_RULE `IMAGE f {g x | x IN s} = {f(g x) | x IN s}`] THEN + REWRITE_TAC[MEASURABLE_COUNTABLE_UNIONS_BOUNDED]);; + +let REAL_MEASURABLE_COUNTABLE_INTERS = prove + (`!s. (!n. real_measurable(s n)) + ==> real_measurable(INTERS { s(n) | n IN (:num) })`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `INTERS { s(n):real->bool | n IN (:num) } = + s 0 DIFF (UNIONS {s 0 DIFF s n | n IN (:num)})` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTERS; IN_DIFF; IN_UNIONS] THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN + EXISTS_TAC `real_measure(s 0:real->bool)` THEN + ASM_SIMP_TAC[REAL_MEASURABLE_DIFF; LE_0] THEN + GEN_TAC THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_UNIONS; IN_ELIM_THM; IN_DIFF] THEN + MESON_TAC[IN_DIFF]] THEN + ONCE_REWRITE_TAC[GSYM IN_NUMSEG_0] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; FINITE_IMAGE; FINITE_NUMSEG; + REAL_MEASURABLE_DIFF; REAL_MEASURABLE_UNIONS]);; + +let REAL_NEGLIGIBLE_COUNTABLE = prove + (`!s. COUNTABLE s ==> real_negligible s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_negligible] THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN ASM_SIMP_TAC[COUNTABLE_IMAGE]);; + +let REAL_MEASURABLE_COMPACT = prove + (`!s. real_compact s ==> real_measurable s`, + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; real_compact; MEASURABLE_COMPACT]);; + +let REAL_MEASURABLE_OPEN = prove + (`!s. real_bounded s /\ real_open s ==> real_measurable s`, + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE; REAL_OPEN; REAL_BOUNDED; + MEASURABLE_OPEN]);; + +let HAS_REAL_INTEGRAL_NEGLIGIBLE_EQ = prove + (`!f s. (!x. x IN s ==> &0 <= f(x)) + ==> ((f has_real_integral &0) s <=> + real_negligible {x | x IN s /\ ~(f x = &0)})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [ALL_TAC; + MATCH_MP_TAC HAS_REAL_INTEGRAL_NEGLIGIBLE THEN + EXISTS_TAC `{x | x IN s /\ ~((f:real->real) x = &0)}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN MESON_TAC[]] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC + `UNIONS {{x:real | x IN s /\ abs(f x) >= &1 / (&n + &1)} | + n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM HAS_REAL_MEASURE_0] THEN + REWRITE_TAC[HAS_REAL_MEASURE] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_STRADDLE_NULL THEN + EXISTS_TAC `\x:real. if x IN s then (&n + &1) * f(x) else &0` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN + X_GEN_TAC `x:real` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_POS] THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ a <= abs x ==> a <= x`) THEN + ASM_SIMP_TAC[]; + COND_CASES_TAC THEN REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_MUL; REAL_LE_ADD]]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBST1_TAC(REAL_ARITH `&0 = (&n + &1) * &0`) THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[REAL_ABS_NZ] THEN ONCE_REWRITE_TAC[REAL_ARCH_INV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `n:num` + STRIP_ASSUME_TAC)) THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC] THEN + EXISTS_TAC `n - 1` THEN ASM_SIMP_TAC[IN_UNIV; IN_ELIM_THM; real_ge] THEN + ASM_SIMP_TAC[REAL_OF_NUM_ADD; SUB_ADD; LE_1] THEN + ASM_SIMP_TAC[real_div; REAL_MUL_LID; REAL_LT_IMP_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* Integration by parts. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INTEGRATION_BY_PARTS = prove + (`!f g f' g' a b c. + a <= b /\ COUNTABLE c /\ + (\x. f x * g x) real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) DIFF c + ==> (f has_real_derivative f'(x)) (atreal x) /\ + (g has_real_derivative g'(x)) (atreal x)) /\ + ((\x. f(x) * g'(x)) has_real_integral ((f b * g b - f a * g a) - y)) + (real_interval[a,b]) + ==> ((\x. f'(x) * g(x)) has_real_integral y) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. (f:real->real)(x) * g(x)`; + `\x. (f:real->real)(x) * g'(x) + f'(x) * g(x)`; + `c:real->bool`; `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_MUL_ATREAL] THEN + FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB)) THEN + REWRITE_TAC[REAL_ARITH `b - a - (b - a - y):real = y`; REAL_ADD_SUB]);; + +let REAL_INTEGRATION_BY_PARTS_SIMPLE = prove + (`!f g f' g' a b. + a <= b /\ + (!x. x IN real_interval[a,b] + ==> (f has_real_derivative f'(x)) + (atreal x within real_interval[a,b]) /\ + (g has_real_derivative g'(x)) + (atreal x within real_interval[a,b])) /\ + ((\x. f(x) * g'(x)) has_real_integral ((f b * g b - f a * g a) - y)) + (real_interval[a,b]) + ==> ((\x. f'(x) * g(x)) has_real_integral y) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. (f:real->real)(x) * g(x)`; + `\x. (f:real->real)(x) * g'(x) + f'(x) * g(x)`; + `a:real`; `b:real`] REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_MUL_WITHIN] THEN + FIRST_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_SUB)) THEN + REWRITE_TAC[REAL_ARITH `b - a - (b - a - y):real = y`; REAL_ADD_SUB]);; + +let REAL_INTEGRABLE_BY_PARTS = prove + (`!f g f' g' a b c. + COUNTABLE c /\ + (\x. f x * g x) real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) DIFF c + ==> (f has_real_derivative f'(x)) (atreal x) /\ + (g has_real_derivative g'(x)) (atreal x)) /\ + (\x. f(x) * g'(x)) real_integrable_on real_interval[a,b] + ==> (\x. f'(x) * g(x)) real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b <= a \/ a <= b`) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[real_integrable_on] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `((f:real->real) b * g b - f a * g a) - y` THEN + MATCH_MP_TAC REAL_INTEGRATION_BY_PARTS THEN MAP_EVERY EXISTS_TAC + [`f:real->real`; `g':real->real`; `c:real->bool`] THEN + ASM_REWRITE_TAC[REAL_ARITH `b - a - ((b - a) - y):real = y`]);; + +let REAL_INTEGRABLE_BY_PARTS_EQ = prove + (`!f g f' g' a b c. + COUNTABLE c /\ + (\x. f x * g x) real_continuous_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) DIFF c + ==> (f has_real_derivative f'(x)) (atreal x) /\ + (g has_real_derivative g'(x)) (atreal x)) + ==> ((\x. f(x) * g'(x)) real_integrable_on real_interval[a,b] <=> + (\x. f'(x) * g(x)) real_integrable_on real_interval[a,b])`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[REAL_INTEGRABLE_BY_PARTS]; DISCH_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_INTEGRABLE_BY_PARTS THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Change of variable in real integral (one that we know exists). *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG = prove + (`!f g g' a b c d k. + COUNTABLE k /\ + f real_integrable_on real_interval[c,d] /\ + g real_continuous_on real_interval[a,b] /\ + IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ + (!x. x IN real_interval[a,b] DIFF k + ==> (g has_real_derivative g'(x)) + (atreal x within real_interval[a,b]) /\ + f real_continuous + (atreal(g x)) within real_interval[c,d]) /\ + a <= b /\ c <= d /\ g a <= g b + ==> ((\x. f(g x) * g'(x)) has_real_integral + real_integral (real_interval[g a,g b]) f) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `ff = \x. real_integral (real_interval[c,x]) f` THEN + MP_TAC(ISPECL + [`(ff:real->real) o (g:real->real)`; + `\x:real. (f:real->real)(g x) * g'(x)`; `k:real->bool`; `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval [c,d]` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "ff" THEN + MATCH_MP_TAC REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + REAL_INTERVAL_OPEN_SUBSET_CLOSED)) THEN + SUBGOAL_THEN `(ff o g has_real_derivative f (g x:real) * g' x) + (atreal x within real_interval[a,b])` + MP_TAC THENL + [MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN + ASM_SIMP_TAC[HAS_REAL_DERIVATIVE_ATREAL_WITHIN; IN_DIFF] THEN + MP_TAC(ISPECL [`f:real->real`; `c:real`; `d:real`; `(g:real->real) x`] + REAL_INTEGRAL_HAS_REAL_DERIVATIVE_POINTWISE) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ATREAL_WITHINREAL; IN_DIFF] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[HAS_REAL_DERIVATIVE_WITHIN_SUBSET]; + DISCH_THEN(MP_TAC o SPEC `real_interval(a,b)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_REAL_DERIVATIVE_WITHIN_SUBSET)) THEN + REWRITE_TAC[REAL_INTERVAL_OPEN_SUBSET_CLOSED] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL] THEN + ASM_SIMP_TAC[REALLIM_WITHIN_REAL_OPEN; REAL_OPEN_REAL_INTERVAL] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ATREAL]]]; + EXPAND_TAC "ff" THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF] THEN MATCH_MP_TAC(REAL_ARITH + `z + w:real = y ==> y - z = w`) THEN + MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_INTEGRABLE_SUBINTERVAL))] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_REAL_INTERVAL; SUBSET] THEN + ASM_MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS]]);; + +let HAS_REAL_INTEGRAL_SUBSTITUTION = prove + (`!f g g' a b c d k. + COUNTABLE k /\ + f real_continuous_on real_interval[c,d] /\ + g real_continuous_on real_interval[a,b] /\ + IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ + (!x. x IN real_interval[a,b] DIFF k + ==> (g has_real_derivative g'(x)) (atreal x)) /\ + a <= b /\ c <= d /\ g a <= g b + ==> ((\x. f(g x) * g'(x)) has_real_integral + real_integral (real_interval[g a,g b]) f) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `c:real`; `d:real`] + REAL_INTEGRAL_HAS_REAL_DERIVATIVE) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `h = \u. real_integral (real_interval[c,u]) f` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`(h:real->real) o (g:real->real)`; + `\x:real. (f:real->real)(g x) * g' x`; + `k:real->bool`; `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS_INTERIOR_STRONG) THEN + MP_TAC(ISPECL + [`h:real->real`; `f:real->real`; + `(g:real->real) a`; `(g:real->real) b`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `x:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)); + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_REAL_DERIVATIVE_WITHIN_SUBSET)] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN DISJ2_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `(c <= ga /\ ga <= d) /\ (c <= gb /\ gb <= d) /\ ga <= gb + ==> c <= ga /\ ga <= gb /\ gb <= d`) THEN + ASM_REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN CONJ_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL; REAL_LE_REFL]; + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "h" THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_CONTINUOUS_ON_SUBSET)) THEN + MATCH_MP_TAC REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_CONTINUOUS]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REWRITE_RULE[SUBSET] + REAL_INTERVAL_OPEN_SUBSET_CLOSED)) THEN + SUBGOAL_THEN + `(h o (g:real->real) has_real_derivative f(g x) * g' x) + (atreal x within real_interval[a,b])` + MP_TAC THENL + [MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN + ASM_SIMP_TAC[IN_DIFF; HAS_REAL_DERIVATIVE_ATREAL_WITHIN] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g:real->real) x`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_REAL_DERIVATIVE_WITHIN_SUBSET) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[HAS_REAL_DERIVATIVE_WITHINREAL; HAS_REAL_DERIVATIVE_ATREAL; + REALLIM_WITHINREAL_WITHIN; REALLIM_ATREAL_AT] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; TENDSTO_REAL] THEN + MATCH_MP_TAC EQ_IMP THEN MATCH_MP_TAC LIM_WITHIN_INTERIOR THEN + REWRITE_TAC[INTERIOR_INTERVAL; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + ASM_SIMP_TAC[FUN_IN_IMAGE]]]]);; + +let REAL_INTEGRAL_SUBSTITUTION = prove + (`!f g g' a b c d k. + COUNTABLE k /\ + f real_continuous_on real_interval[c,d] /\ + g real_continuous_on real_interval[a,b] /\ + IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ + (!x. x IN real_interval[a,b] DIFF k + ==> (g has_real_derivative g'(x)) (atreal x)) /\ + a <= b /\ c <= d /\ g a <= g b + ==> real_integral (real_interval[a,b]) (\x. f(g x) * g'(x)) = + real_integral (real_interval[g a,g b]) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_MESON_TAC[HAS_REAL_INTEGRAL_SUBSTITUTION]);; + +let HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE = prove + (`!f g g' a b c d. + f real_continuous_on real_interval[c,d] /\ + (!x. x IN real_interval[a,b] + ==> (g has_real_derivative g'(x)) + (atreal x within real_interval[a,b])) /\ + IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ + a <= b /\ c <= d /\ g a <= g b + ==> ((\x. f(g x) * g'(x)) has_real_integral + real_integral (real_interval[g a,g b]) f) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRAL_HAS_REAL_DERIVATIVE) THEN + ABBREV_TAC `h = \u. real_integral (real_interval[c,u]) f` THEN + DISCH_TAC THEN + MP_TAC(ISPECL + [`(h:real->real) o (g:real->real)`; + `\x:real. (f:real->real)(g x) * g' x`; + `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + MP_TAC(ISPECL + [`h:real->real`; `f:real->real`; `(g:real->real) a`; `(g:real->real) b`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `x:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)); + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_REAL_DERIVATIVE_WITHIN_SUBSET)] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN DISJ2_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `(c <= ga /\ ga <= d) /\ (c <= gb /\ gb <= d) /\ ga <= gb + ==> c <= ga /\ ga <= gb /\ gb <= d`) THEN + ASM_REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN CONJ_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL; REAL_LE_REFL]; + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_DIFF_CHAIN_WITHIN THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g:real->real) x`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_REAL_DERIVATIVE_WITHIN_SUBSET) THEN + ASM_REWRITE_TAC[]]);; + +let REAL_INTEGRAL_SUBSTITUTION_SIMPLE = prove + (`!f g g' a b c d. + f real_continuous_on real_interval[c,d] /\ + (!x. x IN real_interval[a,b] + ==> (g has_real_derivative g'(x)) + (atreal x within real_interval[a,b])) /\ + IMAGE g (real_interval[a,b]) SUBSET real_interval[c,d] /\ + a <= b /\ c <= d /\ g a <= g b + ==> real_integral (real_interval[a,b]) (\x. f(g x) * g'(x)) = + real_integral (real_interval[g a,g b]) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_MESON_TAC[HAS_REAL_INTEGRAL_SUBSTITUTION_SIMPLE]);; + +(* ------------------------------------------------------------------------- *) +(* Drop the k'th coordinate, or insert t at the k'th coordinate. *) +(* ------------------------------------------------------------------------- *) + +let dropout = new_definition + `(dropout:num->real^N->real^M) k x = + lambda i. if i < k then x$i else x$(i + 1)`;; + +let pushin = new_definition + `pushin k t x = lambda i. if i < k then x$i + else if i = k then t + else x$(i - 1)`;; + +let DROPOUT_PUSHIN = prove + (`!k t x. + dimindex(:M) + 1 = dimindex(:N) + ==> (dropout k:real^N->real^M) (pushin k t x) = x`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + ASM_SIMP_TAC[CART_EQ; dropout; pushin; LAMBDA_BETA; + ARITH_RULE `1 <= n + 1`; ADD_SUB; + ARITH_RULE `m <= n ==> m <= n + 1 /\ m + 1 <= n + 1`] THEN + ARITH_TAC);; + +let PUSHIN_DROPOUT = prove + (`!k x. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> pushin k (x$k) ((dropout k:real^N->real^M) x) = x`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(ASSUME_TAC o GSYM)) THEN + ASM_SIMP_TAC[CART_EQ; dropout; pushin; LAMBDA_BETA; + ARITH_RULE `i <= n + 1 ==> i - 1 <= n`] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[LT_REFL] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(i:num = k) ==> i < k \/ k < i`)) THEN + ASM_SIMP_TAC[ARITH_RULE `i:num < k ==> ~(k < i)`] THEN + W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o lhand o snd) THEN + (ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC]) THEN + ASM_SIMP_TAC[ARITH_RULE `k < i ==> ~(i - 1 < k)`] THEN + AP_TERM_TAC THEN ASM_ARITH_TAC);; + +let DROPOUT_GALOIS = prove + (`!k x:real^N y:real^M. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (y = dropout k x <=> (?t. x = pushin k t y))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN SUBST1_TAC THEN + EXISTS_TAC `(x:real^N)$k` THEN ASM_SIMP_TAC[PUSHIN_DROPOUT]; + DISCH_THEN(X_CHOOSE_THEN `t:real` SUBST1_TAC) THEN + ASM_SIMP_TAC[DROPOUT_PUSHIN]]);; + +let IN_IMAGE_DROPOUT = prove + (`!x s. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (x IN IMAGE (dropout k:real^N->real^M) s <=> + ?t. (pushin k t x) IN s)`, + SIMP_TAC[IN_IMAGE; DROPOUT_GALOIS] THEN MESON_TAC[]);; + +let CLOSED_INTERVAL_DROPOUT = prove + (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + a$k <= b$k + ==> interval[dropout k a,dropout k b] = + IMAGE (dropout k:real^N->real^M) (interval[a,b])`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[EXTENSION; IN_IMAGE_DROPOUT; IN_INTERVAL] THEN + X_GEN_TAC `x:real^M` THEN + SIMP_TAC[pushin; dropout; LAMBDA_BETA] THEN EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `(a:real^N)$k` THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]]; + DISCH_THEN(X_CHOOSE_TAC `t:real`) THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `i + 1`) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[ADD_SUB]]]);; + +let IMAGE_DROPOUT_CLOSED_INTERVAL = prove + (`!k a b. dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) + ==> IMAGE (dropout k:real^N->real^M) (interval[a,b]) = + if a$k <= b$k then interval[dropout k a,dropout k b] + else {}`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[CLOSED_INTERVAL_DROPOUT; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY; GSYM REAL_NOT_LE] THEN ASM_MESON_TAC[]);; + +let LINEAR_DROPOUT = prove + (`!k. dimindex(:M) < dimindex(:N) + ==> linear(dropout k :real^N->real^M)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (ARITH_RULE + `m < n ==> !i:num. i <= m ==> i <= n /\ i + 1 <= n`)) THEN + SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + dropout; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + ARITH_RULE `1 <= i + 1`]);; + +let DROPOUT_EQ = prove + (`!x y k. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ + x$k = y$k /\ (dropout k:real^N->real^M) x = dropout k y + ==> x = y`, + SIMP_TAC[CART_EQ; dropout; VEC_COMPONENT; LAMBDA_BETA; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`; `k:num`] THEN + STRIP_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(i:num = k) ==> i < k \/ k < i`)) + THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_SIMP_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN + ASM_SIMP_TAC[SUB_ADD; ARITH_RULE `k < i ==> ~(i - 1 < k)`]] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +let DROPOUT_0 = prove + (`dropout k (vec 0:real^N) = vec 0`, + SIMP_TAC[dropout; VEC_COMPONENT; CART_EQ; COND_ID; LAMBDA_BETA]);; + +let DOT_DROPOUT = prove + (`!k x y:real^N. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (dropout k x:real^M) dot (dropout k y) = x dot y - x$k * y$k`, + REPEAT STRIP_TAC THEN SIMP_TAC[dot; dropout; LAMBDA_BETA] THEN + REWRITE_TAC[TAUT `(if p then x else y:real) * (if p then a else b) = + (if p then x * a else y * b)`] THEN + SIMP_TAC[SUM_CASES; FINITE_NUMSEG] THEN + SUBGOAL_THEN + `(!i. i IN 1..dimindex(:M) /\ i < k <=> i IN 1..k-1) /\ + (!i. i IN 1..dimindex(:M) /\ ~(i < k) <=> i IN k..dimindex(:M))` + (fun th -> REWRITE_TAC[th]) + THENL [REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SIMPLE_IMAGE; IMAGE_ID] THEN + REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET)] THEN + W(MP_TAC o PART_MATCH (rhs o rand) SUM_UNION o lhs o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG; DISJOINT_NUMSEG] THEN ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MP_TAC(ISPECL [`\i. (x:real^N)$i * (y:real^N)$i`; + `1..dimindex(:N)`; + `k:num`] SUM_DELETE) THEN + ASM_REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_UNION; IN_DELETE] THEN ASM_ARITH_TAC);; + +let DOT_PUSHIN = prove + (`!k a b x y:real^M. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (pushin k a x:real^N) dot (pushin k b y) = x dot y + a * b`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(dropout k (pushin k a (x:real^M):real^N):real^M) dot + (dropout k (pushin k b (y:real^M):real^N):real^M) + + a * b` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[DROPOUT_PUSHIN]] THEN + ASM_SIMP_TAC[DOT_DROPOUT] THEN + MATCH_MP_TAC(REAL_RING + `a':real = a /\ b' = b ==> x = x - a' * b' + a * b`) THEN + ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL]);; + +let DROPOUT_ADD = prove + (`!k x y:real^N. dropout k (x + y) = dropout k x + dropout k y`, + SIMP_TAC[dropout; VECTOR_ADD_COMPONENT; CART_EQ; LAMBDA_BETA] THEN + MESON_TAC[]);; + +let DROPOUT_SUB = prove + (`!k x y:real^N. dropout k (x - y) = dropout k x - dropout k y`, + SIMP_TAC[dropout; VECTOR_SUB_COMPONENT; CART_EQ; LAMBDA_BETA] THEN + MESON_TAC[]);; + +let DROPOUT_MUL = prove + (`!k c x:real^N. dropout k (c % x) = c % dropout k x`, + SIMP_TAC[dropout; VECTOR_MUL_COMPONENT; CART_EQ; LAMBDA_BETA] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Take slice of set s at x$k = t and drop the k'th coordinate. *) +(* ------------------------------------------------------------------------- *) + +let slice = new_definition + `slice k t s = IMAGE (dropout k) (s INTER {x | x$k = t})`;; + +let IN_SLICE = prove + (`!s:real^N->bool y:real^M. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (y IN slice k t s <=> pushin k t y IN s)`, + SIMP_TAC[slice; IN_IMAGE_DROPOUT; IN_INTER; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[pushin] THEN + ASM_SIMP_TAC[LAMBDA_BETA; LT_REFL] THEN MESON_TAC[]);; + +let INTERVAL_INTER_HYPERPLANE = prove + (`!k t a b:real^N. + 1 <= k /\ k <= dimindex(:N) + ==> interval[a,b] INTER {x | x$k = t} = + if a$k <= t /\ t <= b$k + then interval[(lambda i. if i = k then t else a$i), + (lambda i. if i = k then t else b$i)] + else {}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; ASM_MESON_TAC[NOT_IN_EMPTY]] THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA] THEN + EQ_TAC THEN STRIP_TAC THENL [ASM_MESON_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_ANTISYM]] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let SLICE_INTERVAL = prove + (`!k a b t. dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) + ==> slice k t (interval[a,b]) = + if a$k <= t /\ t <= b$k + then interval[(dropout k:real^N->real^M) a,dropout k b] + else {}`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[slice; INTERVAL_INTER_HYPERPLANE] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN + ASM_SIMP_TAC[IMAGE_DROPOUT_CLOSED_INTERVAL; LAMBDA_BETA; REAL_LE_REFL] THEN + MATCH_MP_TAC(MESON[] + `a = a' /\ b = b' ==> interval[a,b] = interval[a',b']`) THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; dropout] THEN + SUBGOAL_THEN + `!i. i <= dimindex(:M) ==> i <= dimindex(:N) /\ i + 1 <= dimindex(:N)` + MP_TAC THENL + [ASM_ARITH_TAC; + ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `1 <= i + 1`] THEN ARITH_TAC]);; + +let SLICE_DIFF = prove + (`!k a s t. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (slice k a:(real^N->bool)->(real^M->bool)) (s DIFF t) = + (slice k a s) DIFF (slice k a t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN + SIMP_TAC[SET_RULE `(s DIFF t) INTER u = (s INTER u) DIFF (t INTER u)`] THEN + MATCH_MP_TAC(SET_RULE + `(!x y. x IN a /\ y IN a /\ f x = f y ==> x = y) + ==> IMAGE f ((s INTER a) DIFF (t INTER a)) = + IMAGE f (s INTER a) DIFF IMAGE f (t INTER a)`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DROPOUT_EQ]);; + +let SLICE_UNIV = prove + (`!k a. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> slice k a (:real^N) = (:real^M)`, + REPEAT STRIP_TAC THEN + SIMP_TAC[EXTENSION; IN_UNIV; IN_IMAGE; slice; INTER_UNIV; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^M` THEN EXISTS_TAC `(pushin k a:real^M->real^N) y` THEN + ASM_SIMP_TAC[DROPOUT_PUSHIN] THEN + ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL]);; + +let SLICE_EMPTY = prove + (`!k a. slice k a {} = {}`, + REWRITE_TAC[slice; INTER_EMPTY; IMAGE_CLAUSES]);; + +let SLICE_SUBSET = prove + (`!s t k a. s SUBSET t ==> slice k a s SUBSET slice k a t`, + REWRITE_TAC[slice] THEN SET_TAC[]);; + +let SLICE_UNIONS = prove + (`!s k a. slice k a (UNIONS s) = UNIONS (IMAGE (slice k a) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[slice; INTER_UNIONS; IMAGE_UNIONS] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; slice]);; + +let SLICE_UNION = prove + (`!k a s t. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (slice k a:(real^N->bool)->(real^M->bool)) (s UNION t) = + (slice k a s) UNION (slice k a t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[slice; IMAGE_UNION; + SET_RULE `(s UNION t) INTER u = (s INTER u) UNION (t INTER u)`] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; slice]);; + +let SLICE_INTER = prove + (`!k a s t. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (slice k a:(real^N->bool)->(real^M->bool)) (s INTER t) = + (slice k a s) INTER (slice k a t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN + MATCH_MP_TAC(SET_RULE + `(!x y. x IN u /\ y IN u /\ f x = f y ==> x = y) + ==> IMAGE f ((s INTER t) INTER u) = + IMAGE f (s INTER u) INTER IMAGE f (t INTER u)`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[DROPOUT_EQ]);; + +let CONVEX_SLICE = prove + (`!k t s. dimindex(:M) < dimindex(:N) /\ convex s + ==> convex((slice k t:(real^N->bool)->(real^M->bool)) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN + MATCH_MP_TAC CONVEX_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_DROPOUT] THEN + MATCH_MP_TAC CONVEX_INTER THEN ASM_REWRITE_TAC[CONVEX_STANDARD_HYPERPLANE]);; + +let COMPACT_SLICE = prove + (`!k t s. dimindex(:M) < dimindex(:N) /\ compact s + ==> compact((slice k t:(real^N->bool)->(real^M->bool)) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN + MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN ASM_SIMP_TAC[LINEAR_DROPOUT] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_INTER THEN ASM_SIMP_TAC[COMPACT_IMP_BOUNDED]; + MATCH_MP_TAC CLOSED_INTER THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; CLOSED_STANDARD_HYPERPLANE]]);; + +let CLOSED_SLICE = prove + (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ + closed s + ==> closed((slice k t:(real^N->bool)->(real^M->bool)) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN + SUBGOAL_THEN + `closed(IMAGE (dropout k:real^N->real^M) + (IMAGE (\x. x - t % basis k) + (s INTER {x | x$k = t})))` + MP_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM IMAGE_o] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; dropout] THEN + SUBGOAL_THEN + `!i. i <= dimindex(:M) ==> i <= dimindex(:N) /\ i + 1 <= dimindex(:N)` + MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; CART_EQ; + LAMBDA_BETA; BASIS_COMPONENT; ARITH_RULE `1 <= i + 1`] THEN + SIMP_TAC[ARITH_RULE `i:num < k ==> ~(i = k)`; + ARITH_RULE `~(i < k) ==> ~(i + 1 = k)`] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO]] THEN + MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE THEN + EXISTS_TAC `{x:real^N | x$k = &0}` THEN + ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE; LINEAR_DROPOUT; + ARITH_RULE `m + 1 = n ==> m < n`] THEN + REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[VECTOR_ARITH `x - t % b:real^N = --(t % b) + x`] THEN + ASM_SIMP_TAC[CLOSED_TRANSLATION_EQ; CLOSED_INTER; + CLOSED_STANDARD_HYPERPLANE]; + MATCH_MP_TAC(SET_RULE + `IMAGE f t SUBSET u ==> IMAGE f (s INTER t) SUBSET u`) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; + REAL_MUL_RID; REAL_SUB_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC DROPOUT_EQ THEN EXISTS_TAC `k:num` THEN + ASM_REWRITE_TAC[DROPOUT_0; VEC_COMPONENT]]);; + +let OPEN_SLICE = prove + (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ + open s + ==> open((slice k t:(real^N->bool)->(real^M->bool)) s)`, + REWRITE_TAC[OPEN_CLOSED] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `closed(slice k t ((:real^N) DIFF s):real^M->bool)` + MP_TAC THENL + [ASM_SIMP_TAC[CLOSED_SLICE]; + ASM_SIMP_TAC[SLICE_DIFF; SLICE_UNIV]]);; + +let BOUNDED_SLICE = prove + (`!k t s. dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ + bounded s + ==> bounded((slice k t:(real^N->bool)->(real^M->bool)) s)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `(slice k t:(real^N->bool)->(real^M->bool)) (interval[a,b])` THEN + ASM_SIMP_TAC[SLICE_SUBSET] THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN + MESON_TAC[BOUNDED_EMPTY; BOUNDED_INTERVAL]);; + +let SLICE_CBALL = prove + (`!k t x r. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (slice k t:(real^N->bool)->(real^M->bool)) (cball(x,r)) = + if abs(t - x$k) <= r + then cball(dropout k x,sqrt(r pow 2 - (t - x$k) pow 2)) + else {}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN COND_CASES_TAC THENL + [ALL_TAC; + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; IN_CBALL] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `~(a <= r) ==> a <= b ==> b <= r ==> F`)) THEN + ASM_MESON_TAC[VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM; NORM_SUB]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `abs(x) <= r ==> &0 <= r`)) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL] THEN X_GEN_TAC `y:real^M` THEN + ASM_SIMP_TAC[DROPOUT_GALOIS; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[IN_CBALL; IN_INTER; IN_ELIM_THM] THEN + ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN + ASM_REWRITE_TAC[dist; NORM_LE_SQUARE; GSYM pushin] THEN + ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LE; REAL_SUB_LE; GSYM REAL_LE_SQUARE_ABS; + REAL_ARITH `abs(x) <= r ==> abs(x) <= abs(r)`] THEN + REWRITE_TAC[VECTOR_ARITH + `(x - y:real^N) dot (x - y) = x dot x + y dot y - &2 * x dot y`] THEN + ASM_SIMP_TAC[DOT_DROPOUT; DOT_PUSHIN] THEN MATCH_MP_TAC(REAL_FIELD + `a = t * k + b + ==> (xx + (yy + t * t) - &2 * a <= r pow 2 <=> + xx - k * k + yy - &2 * b <= r pow 2 - (t - k) pow 2)`) THEN + SUBGOAL_THEN + `y:real^M = dropout k (pushin k t y:real^N)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC DROPOUT_PUSHIN THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[DOT_DROPOUT] THEN + ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN REAL_ARITH_TAC]);; + +let SLICE_BALL = prove + (`!k t x r. + dimindex(:M) + 1 = dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) + ==> (slice k t:(real^N->bool)->(real^M->bool)) (ball(x,r)) = + if abs(t - x$k) < r + then ball(dropout k x,sqrt(r pow 2 - (t - x$k) pow 2)) + else {}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[slice] THEN COND_CASES_TAC THENL + [ALL_TAC; + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; IN_BALL] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[dist] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `~(a < r) ==> a <= b ==> b < r ==> F`)) THEN + ASM_MESON_TAC[VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM; NORM_SUB]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(REAL_ARITH `abs(x) < r ==> &0 < r`)) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL] THEN X_GEN_TAC `y:real^M` THEN + ASM_SIMP_TAC[DROPOUT_GALOIS; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + REWRITE_TAC[IN_BALL; IN_INTER; IN_ELIM_THM] THEN + ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN + ASM_REWRITE_TAC[dist; NORM_LT_SQUARE; GSYM pushin] THEN + ASM_SIMP_TAC[SQRT_POW_2; SQRT_POS_LT; REAL_SUB_LT; GSYM REAL_LT_SQUARE_ABS; + REAL_LT_IMP_LE; REAL_ARITH `abs(x) < r ==> abs(x) < abs(r)`] THEN + REWRITE_TAC[VECTOR_ARITH + `(x - y:real^N) dot (x - y) = x dot x + y dot y - &2 * x dot y`] THEN + ASM_SIMP_TAC[DOT_DROPOUT; DOT_PUSHIN] THEN MATCH_MP_TAC(REAL_FIELD + `a = t * k + b + ==> (xx + (yy + t * t) - &2 * a < r pow 2 <=> + xx - k * k + yy - &2 * b < r pow 2 - (t - k) pow 2)`) THEN + SUBGOAL_THEN + `y:real^M = dropout k (pushin k t y:real^N)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC DROPOUT_PUSHIN THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[DOT_DROPOUT] THEN + ASM_SIMP_TAC[pushin; LAMBDA_BETA; LT_REFL] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Weak but useful versions of Fubini's theorem. *) +(* ------------------------------------------------------------------------- *) + +let FUBINI_CLOSED_INTERVAL = prove + (`!k a b:real^N. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + a$k <= b$k + ==> ((\t. measure (slice k t (interval[a,b]) :real^M->bool)) + has_real_integral + (measure(interval[a,b]))) (:real)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SLICE_INTERVAL] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[MEASURE_EMPTY; MEASURE_INTERVAL] THEN + REWRITE_TAC[GSYM IN_REAL_INTERVAL] THEN + SIMP_TAC[HAS_REAL_INTEGRAL_RESTRICT; SUBSET_UNIV] THEN + SUBGOAL_THEN + `content(interval[a:real^N,b]) = + content(interval[dropout k a:real^M,dropout k b]) * (b$k - a$k)` + SUBST1_TAC THEN ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST] THEN + REWRITE_TAC[CONTENT_CLOSED_INTERVAL_CASES] THEN + GEN_REWRITE_TAC (RAND_CONV o RATOR_CONV) [COND_RAND] THEN + GEN_REWRITE_TAC RAND_CONV [COND_RATOR] THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN MATCH_MP_TAC(TAUT + `(p <=> p') /\ x = x' + ==> (if p then x else y) = (if p' then x' else y)`) THEN + CONJ_TAC THENL + [SIMP_TAC[dropout; LAMBDA_BETA] THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THENL + [COND_CASES_TAC THEN REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_ARITH_TAC; + ASM_CASES_TAC `i:num = k` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i:num < k` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `i - 1`) THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_SIMP_TAC[SUB_ADD]]] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `1..dimindex(:N) = + (1..(k-1)) UNION + (k INSERT (IMAGE (\x. x + 1) (k..dimindex(:M))))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_UNION; IN_INSERT; IN_IMAGE] THEN + ASM_SIMP_TAC[ARITH_RULE + `1 <= k + ==> (x = y + 1 /\ k <= y /\ y <= n <=> + y = x - 1 /\ k + 1 <= x /\ x <= n + 1)`] THEN + REWRITE_TAC[CONJ_ASSOC; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s UNION (x INSERT t) = x INSERT (s UNION t)`] THEN + SIMP_TAC[PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_UNION; FINITE_IMAGE] THEN + ASM_SIMP_TAC[IN_NUMSEG; IN_UNION; IN_IMAGE; ARITH_RULE + `1 <= k ==> ~(k <= k - 1)`] THEN + COND_CASES_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`1`; `k - 1`; `dimindex(:M)`] NUMSEG_COMBINE_R) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + W(MP_TAC o PART_MATCH (lhs o rand) PRODUCT_UNION o lhand o snd) THEN + SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG; SET_RULE + `DISJOINT s (IMAGE f t) <=> !x. x IN t ==> ~(f x IN s)`] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) PRODUCT_UNION o rand o snd) THEN + SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; IN_NUMSEG; SET_RULE + `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + ASM_SIMP_TAC[PRODUCT_IMAGE; EQ_ADD_RCANCEL; SUB_ADD] THEN + BINOP_TAC THEN MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + SIMP_TAC[dropout; LAMBDA_BETA; o_THM] THEN + REPEAT STRIP_TAC THEN BINOP_TAC THEN + (W(MP_TAC o PART_MATCH (lhs o rand) LAMBDA_BETA o rand o snd) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC));; + +let MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL = prove + (`!s a b e. + 2 <= dimindex(:N) /\ 1 <= k /\ k <= dimindex(:N) /\ + measurable s /\ s SUBSET interval[a,b] /\ &0 < e + ==> ?f:num->real^N->bool. + (!i. (f i) SUBSET interval[a,b] /\ + ?c d. c$k <= d$k /\ f i = interval[c,d]) /\ + (!i j. ~(i = j) ==> negligible(f i INTER f j)) /\ + s SUBSET UNIONS {f n | n IN (:num)} /\ + measurable(UNIONS {f n | n IN (:num)}) /\ + measure(UNIONS {f n | n IN (:num)}) <= measure s + e`, + let lemma = prove + (`UNIONS {if n IN s then f n else {} | n IN (:num)} = + UNIONS (IMAGE f s)`, + SIMP_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM; IN_UNIV; EXISTS_IN_IMAGE] THEN + MESON_TAC[NOT_IN_EMPTY]) in + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP MEASURABLE_OUTER_INTERVALS_BOUNDED) THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `FINITE(d:(real^N->bool)->bool)` THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N->bool` + (fun th -> SUBST_ALL_TAC(CONJUNCT2 th) THEN ASSUME_TAC(CONJUNCT1 th))) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM; IN_UNIV]) THEN + EXISTS_TAC `\k. if k IN 1..CARD(d:(real^N->bool)->bool) then f k + else ({}:real^N->bool)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[REAL_NOT_LT; IN_NUMSEG; REAL_NOT_LE; INTERVAL_EQ_EMPTY]; + REWRITE_TAC[EMPTY_SUBSET] THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + EXISTS_TAC `(lambda i. if i = k then &0 else &1):real^N` THEN + EXISTS_TAC `(lambda i. if i = k then &1 else &0):real^N` THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN CONJ_TAC THENL + [SIMP_TAC[LAMBDA_BETA; ASSUME `1 <= k`; ASSUME `k <= dimindex(:N)`; + REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ ~(j = k)` MP_TAC THENL + [MATCH_MP_TAC(MESON[] `P(k - 1) \/ P(k + 1) ==> ?i. P i`) THEN + ASM_ARITH_TAC; + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LAMBDA_BETA] THEN + REAL_ARITH_TAC]]; + ALL_TAC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[lemma]] THEN + REPEAT GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]); + MP_TAC(ISPEC `d:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ASM_REWRITE_TAC[INFINITE] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `f:num->real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IMP_CONJ; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM; IN_UNIV]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM SIMPLE_IMAGE]) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_NOT_LT; IN_NUMSEG; REAL_NOT_LE; INTERVAL_EQ_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`]] THEN + (DISCH_TAC THEN + SUBGOAL_THEN `negligible(interior((f:num->real^N->bool) i) INTER + interior(f j))` + MP_TAC THENL [ASM_MESON_TAC[NEGLIGIBLE_EMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM INTERIOR_INTER] THEN + REWRITE_TAC[GSYM HAS_MEASURE_0] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_MEASURE_NEGLIGIBLE_SYMDIFF) THEN + SIMP_TAC[INTERIOR_SUBSET; SET_RULE + `interior(s) SUBSET s + ==> (interior s DIFF s) UNION (s DIFF interior s) = + s DIFF interior s`] THEN + SUBGOAL_THEN `(?c d. (f:num->real^N->bool) i = interval[c,d]) /\ + (?c d. (f:num->real^N->bool) j = interval[c,d])` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[INTER_INTERVAL; NEGLIGIBLE_FRONTIER_INTERVAL; + INTERIOR_CLOSED_INTERVAL]));; + +let REAL_MONOTONE_CONVERGENCE_INCREASING_AE = prove + (`!f:num->real->real g s. + (!k. (f k) real_integrable_on s) /\ + (!k x. x IN s ==> f k x <= f (SUC k) x) /\ + (?t. real_negligible t /\ + !x. x IN (s DIFF t) ==> ((\k. f k x) ---> g x) sequentially) /\ + real_bounded {real_integral s (f k) | k IN (:num)} + ==> g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `g real_integrable_on (s DIFF t) /\ + ((\k. real_integral (s DIFF t) (f k)) ---> real_integral (s DIFF t) g) + sequentially` + MP_TAC THENL + [MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `!k:num. f k real_integrable_on s` THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_SET; + ASM_SIMP_TAC[IN_DIFF]; + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_bounded]) THEN + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET]; + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_SPIKE_SET_EQ THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + AP_THM_TAC THEN BINOP_TAC THENL + [ABS_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET]] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let FUBINI_SIMPLE_LEMMA = prove + (`!k s:real^N->bool e. + &0 < e /\ + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ measurable s /\ + (!t. measurable(slice k t s:real^M->bool)) /\ + (\t. measure (slice k t s:real^M->bool)) real_integrable_on (:real) + ==> real_integral(:real) (\t. measure (slice k t s :real^M->bool)) + <= measure s + e`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`; `e:real`] + MEASURABLE_OUTER_INTERVALS_BOUNDED_EXPLICIT_SPECIAL) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [SUBGOAL_THEN `1 <= dimindex(:M)` MP_TAC THENL + [REWRITE_TAC[DIMINDEX_GE_1]; ASM_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->(real^N->bool)` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!t n:num. measurable((slice k t:(real^N->bool)->real^M->bool) + (d n))` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`t:real`; `n:num`] THEN + FIRST_X_ASSUM(STRIP_ASSUME_TAC o CONJUNCT2 o SPEC `n:num`) THEN + ASM_SIMP_TAC[SLICE_INTERVAL] THEN + MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(UNIONS {d n | n IN (:num)}:real^N->bool)` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`\n t. sum(0..n) + (\m. measure((slice k t:(real^N->bool)->real^M->bool) + (d m)))`; + `\t. measure((slice k t:(real^N->bool)->real^M->bool) + (UNIONS {d n | n IN (:num)}))`; `(:real)`] + REAL_MONOTONE_CONVERGENCE_INCREASING_AE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN MATCH_MP_TAC REAL_INTEGRABLE_SUM THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o SPEC `j:num`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`k:num`; `u:real^N`; `v:real^N`] + FUBINI_CLOSED_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[real_integrable_on]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + REWRITE_TAC[REAL_LE_ADDR] THEN MATCH_MP_TAC MEASURE_POS_LE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `measure(interval[a:real^N,b])` THEN X_GEN_TAC `i:num` THEN + W(MP_TAC o PART_MATCH (lhand o rand) REAL_INTEGRAL_SUM o + rand o lhand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v. u$k <= v$k /\ + (d:num->real^N->bool) j = interval[u,v]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `measure(interval[u:real^N,v])` THEN + MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sum(0..i) (\m. measure(d m:real^N->bool)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `?u v. u$k <= v$k /\ + (d:num->real^N->bool) j = interval[u,v]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= a ==> abs x <= a`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + ASM_MESON_TAC[MEASURE_POS_LE; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rhs o rand) MEASURE_NEGLIGIBLE_UNIONS_IMAGE o + lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_NUMSEG] THEN ASM_MESON_TAC[MEASURABLE_INTERVAL]; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_INTERVAL] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_NUMSEG; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[MEASURABLE_INTERVAL]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]]] THEN + EXISTS_TAC + `(IMAGE (\i. (interval_lowerbound(d i):real^N)$k) (:num)) UNION + (IMAGE (\i. (interval_upperbound(d i):real^N)$k) (:num))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + SIMP_TAC[COUNTABLE_UNION; COUNTABLE_IMAGE; NUM_COUNTABLE]; + ALL_TAC] THEN + X_GEN_TAC `t:real` THEN + REWRITE_TAC[IN_DIFF; IN_UNION; IN_IMAGE] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [IN_UNIV] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM] THEN DISCH_TAC THEN + MP_TAC(ISPEC `\n:num. (slice k t:(real^N->bool)->real^M->bool) + (d n)` + HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN + ASM_REWRITE_TAC[SLICE_UNIONS] THEN ANTS_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[GSYM REAL_SUMS; real_sums; FROM_INTER_NUMSEG] THEN + REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF]] THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `(slice k t:(real^N->bool)->real^M->bool) (interval[a,b])` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SLICE_INTERVAL] THEN + MESON_TAC[BOUNDED_INTERVAL; BOUNDED_EMPTY]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[SLICE_SUBSET]]] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(d:num->real^N->bool) i = {}` THENL + [ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY; SLICE_EMPTY]; + UNDISCH_TAC `~((d:num->real^N->bool) i = {})`] THEN + ASM_CASES_TAC `(d:num->real^N->bool) j = {}` THENL + [ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY; SLICE_EMPTY]; + UNDISCH_TAC `~((d:num->real^N->bool) j = {})`] THEN + FIRST_ASSUM(fun th -> + MAP_EVERY (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) + [SPEC `i:num` th; SPEC `j:num` th]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`w:real^N`; `x:real^N`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[SLICE_INTERVAL; INTERVAL_NE_EMPTY] THEN + DISCH_TAC THEN DISCH_TAC THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[INTER_EMPTY; NEGLIGIBLE_EMPTY]) THEN + REWRITE_TAC[INTER_INTERVAL; NEGLIGIBLE_INTERVAL; INTERVAL_EQ_EMPTY] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + SIMP_TAC[LAMBDA_BETA] THEN REWRITE_TAC[NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(l:num = k)` ASSUME_TAC THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN + (fun th -> MP_TAC(SPEC `i:num` th) THEN MP_TAC(SPEC `j:num` th))) THEN + ASM_SIMP_TAC[INTERVAL_LOWERBOUND; INTERVAL_UPPERBOUND] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `~(l:num = k) ==> l < k \/ k < l`)) + THENL + [EXISTS_TAC `l:num` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[dropout; LAMBDA_BETA]] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `l - 1` THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + CONJ_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[dropout; LAMBDA_BETA]] THEN + ASM_SIMP_TAC[ARITH_RULE `k < l ==> ~(l - 1 < k)`] THEN + ASM_SIMP_TAC[SUB_ADD]; + ALL_TAC] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `real_integral (:real) + (\t. measure ((slice k t :(real^N->bool)->real^M->bool) + (UNIONS {d n | n IN (:num)})))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[SLICE_SUBSET; SLICE_UNIONS] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN REWRITE_TAC[GSYM IMAGE_o] THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + MATCH_MP_TAC MEASURABLE_COUNTABLE_UNIONS_BOUNDED THEN + ASM_REWRITE_TAC[o_THM] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `(slice k t:(real^N->bool)->real^M->bool) (interval[a,b])` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SLICE_INTERVAL] THEN + MESON_TAC[BOUNDED_INTERVAL; BOUNDED_EMPTY]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[SLICE_SUBSET]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\n. real_integral (:real) + (\t. sum (0..n) (\m. measure((slice k t:(real^N->bool)->real^M->bool) + + (d m))))` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MP_TAC(ISPEC `d:num->(real^N->bool)` + HAS_MEASURE_COUNTABLE_NEGLIGIBLE_UNIONS_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[MEASURABLE_INTERVAL]; ALL_TAC] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[a:real^N,b]` THEN + REWRITE_TAC[BOUNDED_INTERVAL; UNIONS_SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[GSYM REAL_SUMS] THEN + REWRITE_TAC[real_sums; FROM_INTER_NUMSEG] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhand o rand) REAL_INTEGRAL_SUM o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `?u v. u$k <= v$k /\ + (d:num->real^N->bool) j = interval[u,v]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `measure(interval[u:real^N,v])` THEN + MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `?u v. u$k <= v$k /\ + (d:num->real^N->bool) j = interval[u,v]` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FUBINI_CLOSED_INTERVAL THEN ASM_REWRITE_TAC[]]);; + +let FUBINI_SIMPLE = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ + measurable s /\ + (!t. measurable(slice k t s :real^M->bool)) /\ + (\t. measure (slice k t s :real^M->bool)) real_integrable_on (:real) + ==> measure s = + real_integral(:real)(\t. measure (slice k t s :real^M->bool))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[SLICE_EMPTY; MEASURE_EMPTY; REAL_INTEGRAL_0]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(interval[a:real^N,b] = {})` MP_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[INTERVAL_NE_EMPTY] THEN DISCH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < b - a) /\ ~(&0 < a - b) ==> a:real = b`) THEN + CONJ_TAC THEN MATCH_MP_TAC(MESON[] + `(!e. x - y = e ==> ~(&0 < e)) ==> ~(&0 < x - y)`) THEN + X_GEN_TAC `e:real` THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`k:num`; `s:real^N->bool`; `e / &2`] + FUBINI_SIMPLE_LEMMA) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`k:num`; `interval[a:real^N,b] DIFF s`; `e / &2`] + FUBINI_SIMPLE_LEMMA) THEN + ASM_REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [SIMP_TAC[BOUNDED_DIFF; BOUNDED_INTERVAL]; ALL_TAC] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_DIFF; MEASURABLE_INTERVAL]; ALL_TAC] THEN + ASM_SIMP_TAC[SLICE_DIFF] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN MATCH_MP_TAC MEASURABLE_DIFF THEN + ASM_SIMP_TAC[SLICE_INTERVAL] THEN + MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL]; + DISCH_TAC] THEN + SUBGOAL_THEN + `!t. measure(slice k t (interval[a:real^N,b]) DIFF + slice k t (s:real^N->bool) :real^M->bool) = + measure(slice k t (interval[a:real^N,b]):real^M->bool) - + measure(slice k t s :real^M->bool)` + (fun th -> REWRITE_TAC[th]) + THENL + [X_GEN_TAC `t:real` THEN MATCH_MP_TAC MEASURE_DIFF_SUBSET THEN + ASM_SIMP_TAC[SLICE_SUBSET] THEN + ASM_SIMP_TAC[SLICE_INTERVAL] THEN + MESON_TAC[MEASURABLE_EMPTY; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`k:num`; `a:real^N`; `b:real^N`] FUBINI_CLOSED_INTERVAL) THEN + ASM_SIMP_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN ASM_MESON_TAC[real_integrable_on]; + ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LE] THEN + ASM_SIMP_TAC[MEASURE_DIFF_SUBSET; MEASURABLE_INTERVAL] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL_SUB o rand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[real_integrable_on]; DISCH_THEN SUBST1_TAC] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + ASM_REAL_ARITH_TAC);; + +let FUBINI_SIMPLE_ALT = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ + measurable s /\ + (!t. measurable(slice k t s :real^M->bool)) /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measure s = B`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `real_integral (:real) + (\t. measure (slice k t (s:real^N->bool) :real^M->bool))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FUBINI_SIMPLE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[real_integrable_on]; + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]]);; + +let FUBINI_SIMPLE_COMPACT_STRONG = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + compact s /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measurable s /\ measure s = B`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_COMPACT] THEN + MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN + EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; MEASURABLE_COMPACT] THEN + GEN_TAC THEN MATCH_MP_TAC MEASURABLE_COMPACT THEN + MATCH_MP_TAC COMPACT_SLICE THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let FUBINI_SIMPLE_COMPACT = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + compact s /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measure s = B`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_COMPACT_STRONG) THEN SIMP_TAC[]);; + +let FUBINI_SIMPLE_CONVEX_STRONG = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ convex s /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measurable s /\ measure s = B`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN + MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN + EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[MEASURABLE_CONVEX] THEN + GEN_TAC THEN MATCH_MP_TAC MEASURABLE_CONVEX THEN CONJ_TAC THENL + [MATCH_MP_TAC CONVEX_SLICE; MATCH_MP_TAC BOUNDED_SLICE] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let FUBINI_SIMPLE_CONVEX = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ convex s /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measure s = B`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_CONVEX_STRONG) THEN SIMP_TAC[]);; + +let FUBINI_SIMPLE_OPEN_STRONG = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ open s /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measurable s /\ measure s = B`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[MEASURABLE_OPEN] THEN + MATCH_MP_TAC FUBINI_SIMPLE_ALT THEN + EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[MEASURABLE_OPEN] THEN + GEN_TAC THEN MATCH_MP_TAC MEASURABLE_OPEN THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SLICE; MATCH_MP_TAC OPEN_SLICE] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let FUBINI_SIMPLE_OPEN = prove + (`!k s:real^N->bool. + dimindex(:M) + 1 = dimindex(:N) /\ + 1 <= k /\ k <= dimindex(:N) /\ + bounded s /\ open s /\ + ((\t. measure (slice k t s :real^M->bool)) has_real_integral B) (:real) + ==> measure s = B`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_SIMPLE_OPEN_STRONG) THEN SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Scaled integer, and hence rational, values are dense in the reals. *) +(* ------------------------------------------------------------------------- *) + +let REAL_OPEN_SET_RATIONAL = prove + (`!s. real_open s /\ ~(s = {}) ==> ?x. rational x /\ x IN s`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + MP_TAC(ISPEC `IMAGE lift s` OPEN_SET_RATIONAL_COORDINATES) THEN + ASM_REWRITE_TAC[GSYM REAL_OPEN; IMAGE_EQ_EMPTY; EXISTS_IN_IMAGE] THEN + SIMP_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP]);; + +let REAL_OPEN_RATIONAL = prove + (`!P. real_open {x | P x} /\ (?x. P x) ==> ?x. rational x /\ P x`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `{x:real | P x}` REAL_OPEN_SET_RATIONAL) THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[]);; + +let REAL_OPEN_SET_EXISTS_RATIONAL = prove + (`!s. real_open s ==> ((?x. rational x /\ x IN s) <=> (?x. x IN s))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_MESON_TAC[REAL_OPEN_SET_RATIONAL; GSYM MEMBER_NOT_EMPTY]);; + +let REAL_OPEN_EXISTS_RATIONAL = prove + (`!P. real_open {x | P x} ==> ((?x. rational x /\ P x) <=> (?x. P x))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_OPEN_SET_EXISTS_RATIONAL) THEN + REWRITE_TAC[IN_ELIM_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a criterion for two functions to agree. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CONST_DYADIC_RATIONALS = prove + (`!f:real^M->real^N a. + f continuous_on (:real^M) /\ + (!x. (!i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i)) ==> f(x) = a) /\ + (!x. f(x) = a ==> f(inv(&2) % x) = a) + ==> !x. f(x) = a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; + `{ inv(&2 pow n) % x:real^M |n,x| + !i. 1 <= i /\ i <= dimindex(:M) ==> integer(x$i) }`; + `a:real^N`] CONTINUOUS_CONSTANT_ON_CLOSURE) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; CLOSURE_DYADIC_RATIONALS; IN_UNIV] THEN + DISCH_THEN MATCH_MP_TAC THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_INV_1; VECTOR_MUL_LID] THEN + ASM_SIMP_TAC[REAL_INV_MUL; GSYM VECTOR_MUL_ASSOC]);; + +let REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS = prove + (`!f a. + f real_continuous_on (:real) /\ + (!x. integer(x) ==> f(x) = a) /\ + (!x. f(x) = a ==> f(x / &2) = a) + ==> !x. f(x) = a`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`] + CONTINUOUS_ON_CONST_DYADIC_RATIONALS) THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IMAGE_LIFT_UNIV] THEN + ASM_SIMP_TAC[o_THM; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_EQ; DROP_CMUL; + REAL_ARITH `inv(&2) * x = x / &2`] THEN + ASM_MESON_TAC[LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Various sufficient conditions for additivity to imply linearity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ADDITIVE_IMP_LINEAR = prove + (`!f:real^M->real^N. + f continuous_on (:real^M) /\ + (!x y. f(x + y) = f(x) + f(y)) + ==> linear f`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N) (vec 0) = vec 0` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o repeat (SPEC `vec 0:real^M`)) THEN + REWRITE_TAC[VECTOR_ADD_LID] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[linear] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN X_GEN_TAC `x:real^M` THEN + MP_TAC(ISPECL [`\c. norm((f:real^M->real^N)(c % x) - c % f(x))`; `&0`] + REAL_CONTINUOUS_ON_CONST_DYADIC_RATIONALS) THEN + REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_UNIV; WITHIN_UNIV]) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_UNIV] THEN + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHINREAL_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_NORM_WITHIN] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN + ASM_SIMP_TAC[REWRITE_RULE[GSYM REAL_CONTINUOUS_CONTINUOUS1]CONTINUOUS_VMUL; + REAL_CONTINUOUS_WITHIN_ID; CONTINUOUS_AT_WITHIN; + REWRITE_RULE[o_DEF] CONTINUOUS_WITHINREAL_COMPOSE]; + MATCH_MP_TAC FORALL_INTEGER THEN CONJ_TAC THENL + [INDUCT_TAC THEN ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM REAL_OF_NUM_SUC] THEN + ASM_REWRITE_TAC[VECTOR_ADD_RDISTRIB; VECTOR_MUL_LID]; + X_GEN_TAC `c:real` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`c % x:real^M`; `--(c % x):real^M`]) THEN + ASM_REWRITE_TAC[VECTOR_ADD_RINV; VECTOR_MUL_LNEG; IMP_IMP] THEN + VECTOR_ARITH_TAC]; + X_GEN_TAC `c:real` THEN + FIRST_X_ASSUM(MP_TAC o funpow 2 (SPEC `c / &2 % x:real^M`)) THEN + REWRITE_TAC[VECTOR_ARITH `c / &2 % x + c / &2 % x:real^N = c % x`] THEN + REWRITE_TAC[IMP_IMP] THEN VECTOR_ARITH_TAC]);; + +let OSTROWSKI_THEOREM = prove + (`!f:real^M->real^N B s. + (!x y. f(x + y) = f(x) + f(y)) /\ + (!x. x IN s ==> norm(f x) <= B) /\ + measurable s /\ &0 < measure s + ==> linear f`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC o + MATCH_MP STEINHAUS) THEN + SUBGOAL_THEN `!x y. (f:real^M->real^N)(x - y) = f x - f y` ASSUME_TAC THENL + [ASM_MESON_TAC[VECTOR_ARITH `x - y:real^M = z <=> x = y + z`]; + ALL_TAC] THEN + SUBGOAL_THEN `!n x. &n % (f:real^M->real^N) x = f(&n % x)` ASSUME_TAC THENL + [INDUCT_TAC THENL + [ASM_MESON_TAC[VECTOR_SUB_REFL; VECTOR_MUL_LZERO]; + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; VECTOR_ADD_RDISTRIB] THEN + REWRITE_TAC[VECTOR_MUL_LID]]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ADDITIVE_IMP_LINEAR THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!x. norm(x) < d ==> norm((f:real^M->real^N) x) <= &2 * B` + ASSUME_TAC THENL + [X_GEN_TAC `z:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_BALL_0] THEN SPEC_TAC(`z:real^M`,`z:real^M`) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN(ANTE_RES_THEN MP_TAC)) THEN + CONV_TAC NORM_ARITH; + ALL_TAC] THEN + REWRITE_TAC[continuous_on; IN_UNIV; dist] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `e:real`] THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC o SPEC `max (&1) (&2 * B)`) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [REAL_ARITH_TAC; DISCH_TAC] THEN + EXISTS_TAC `d / &n` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1] THEN + X_GEN_TAC `y:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN `norm(&n % (f:real^M->real^N)(y - x)) <= &2 * B` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SIMP_TAC[NORM_MUL; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; LE_1]; + SIMP_TAC[NORM_MUL; REAL_ABS_NUM] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ASM_REAL_ARITH_TAC]);; + +let MEASURABLE_ADDITIVE_IMP_LINEAR = prove + (`!f:real^M->real^N. + f measurable_on (:real^M) /\ (!x y. f(x + y) = f(x) + f(y)) + ==> linear f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC OSTROWSKI_THEOREM THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP MEASURABLE_ON_NORM) THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + DISCH_TAC THEN + ASM_CASES_TAC `!b. negligible {x | norm((f:real^M->real^N) x) <= b}` THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP NEGLIGIBLE_COUNTABLE_UNIONS o + GEN `n:num` o SPEC `&n:real`) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; REAL_ARCH_SIMPLE] THEN + SIMP_TAC[SET_RULE `{x | T} = (:real^M)`; OPEN_NOT_NEGLIGIBLE; + OPEN_UNIV; UNIV_NOT_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + ONCE_REWRITE_TAC[NEGLIGIBLE_ON_INTERVALS] THEN + REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`] THEN DISCH_TAC THEN + EXISTS_TAC `{x:real^M | norm(f x:real^N) <= B} INTER interval[a,b]` THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_INTER] THEN + MATCH_MP_TAC(MESON[MEASURABLE_MEASURE_POS_LT] + `measurable s /\ ~negligible s ==> measurable s /\ &0 < measure s`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE THEN + ASM_REWRITE_TAC[MEASURABLE_INTERVAL]]);; + +let REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR = prove + (`!f. f real_continuous_on (:real) /\ + (!x y. f(x + y) = f(x) + f(y)) + ==> !a x. f(a * x) = a * f(x)`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `lift o f o drop` CONTINUOUS_ADDITIVE_IMP_LINEAR) THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; GSYM IMAGE_LIFT_UNIV] THEN + ASM_REWRITE_TAC[linear; GSYM FORALL_DROP; o_THM; DROP_ADD; LIFT_DROP; + DROP_CMUL; GSYM LIFT_ADD; GSYM LIFT_CMUL; LIFT_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Extending a continuous function in a periodic way. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_FLOOR = prove + (`!x. ~(integer x) ==> floor real_continuous (atreal x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_continuous_atreal] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `min (x - floor x) ((floor x + &1) - x)` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT; REAL_FLOOR_LT; FLOOR] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x = y ==> abs(x - y) < e`) THEN + ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN + MP_TAC(ISPEC `x:real` FLOOR) THEN ASM_REAL_ARITH_TAC);; + +let REAL_CONTINUOUS_FRAC = prove + (`!x. ~(integer x) ==> frac real_continuous (atreal x)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[FRAC_FLOOR] THEN MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_FLOOR; REAL_CONTINUOUS_AT_ID]);; + +let REAL_CONTINUOUS_ON_COMPOSE_FRAC = prove + (`!f. f real_continuous_on real_interval[&0,&1] /\ f(&1) = f(&0) + ==> (f o frac) real_continuous_on (:real)`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC `f real_continuous_on real_interval[&0,&1]` THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHINREAL_UNIV] THEN + DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `integer x` THENL + [ALL_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_FRAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [IN_REAL_INTERVAL] o + SPEC `frac x`) THEN + ASM_SIMP_TAC[FLOOR_FRAC; REAL_LT_IMP_LE] THEN + REWRITE_TAC[real_continuous_atreal; real_continuous_withinreal] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (min (frac x) (&1 - frac x))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FLOOR_FRAC; REAL_FRAC_POS_LT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[real_continuous_atreal; REAL_FRAC_ZERO; REAL_FLOOR_REFL] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o LAND_CONV) + [IN_REAL_INTERVAL]) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `&0` th)) THEN + REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN + REWRITE_TAC[IMP_IMP; real_continuous_withinreal; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `min (&1) (min d1 d2)` THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_MIN; o_DEF] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y < x`) THENL + [SUBGOAL_THEN `floor y = floor x` ASSUME_TAC THENL + [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN + ASM_SIMP_TAC[REAL_FLOOR_REFL] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL; REAL_SUB_REFL] THEN + FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_REAL_ARITH_TAC)]; + SUBGOAL_THEN `floor y = floor x - &1` ASSUME_TAC THENL + [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN + ASM_SIMP_TAC[REAL_FLOOR_REFL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL; REAL_SUB_REFL] THEN + FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th THEN ASM_REAL_ARITH_TAC)]]);; + +let REAL_TIETZE_PERIODIC_INTERVAL = prove + (`!f a b. + f real_continuous_on real_interval[a,b] /\ f(a) = f(b) + ==> ?g. g real_continuous_on (:real) /\ + (!x. x IN real_interval[a,b] ==> g(x) = f(x)) /\ + (!x. g(x + (b - a)) = g x)`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `b:real <= a \/ a < b`) THENL + [EXISTS_TAC `\x:real. (f:real->real) a` THEN + REWRITE_TAC[IN_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_ANTISYM]; + EXISTS_TAC `(f:real->real) o (\y. a + (b - a) * y) o frac o + (\x. (x - a) / (b - a))` THEN + REWRITE_TAC[o_THM] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[real_div; REAL_CONTINUOUS_ON_RMUL; REAL_CONTINUOUS_ON_SUB; + REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE_FRAC THEN + ASM_SIMP_TAC[o_THM; REAL_MUL_RZERO; REAL_MUL_RID; REAL_SUB_ADD2; + REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ADD; + REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LT] THEN + REWRITE_TAC[REAL_ARITH + `a + (b - a) * x <= b <=> &0 <= (b - a) * (&1 - x)`] THEN + ASM_SIMP_TAC[REAL_LE_ADDR; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN ASM_CASES_TAC `x:real = b` THENL + [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_SUB_LT] THEN + ASM_REWRITE_TAC[FRAC_NUM; REAL_MUL_RZERO; REAL_ADD_RID]; + SUBGOAL_THEN `frac((x - a) / (b - a)) = (x - a) / (b - a)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_FRAC_EQ] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN + ASM_REAL_ARITH_TAC; + AP_TERM_TAC THEN UNDISCH_TAC `a:real < b` THEN CONV_TAC REAL_FIELD]]; + ASM_SIMP_TAC[REAL_FIELD + `a < b ==> ((x + b - a) - a) / (b - a) = &1 + (x - a) / (b - a)`] THEN + REWRITE_TAC[REAL_FRAC_ADD; FRAC_NUM; FLOOR_FRAC; REAL_ADD_LID]]]);; + +(* ------------------------------------------------------------------------- *) +(* A variant of REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR for intervals. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_ADDITIVE_EXTEND = prove + (`!f. f real_continuous_on real_interval[&0,&1] /\ + (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 + ==> f(x + y) = f(x) + f(y)) + ==> ?g. g real_continuous_on (:real) /\ + (!x y. g(x + y) = g(x) + g(y)) /\ + (!x. x IN real_interval[&0,&1] ==> g x = f x)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `f(&0) = &0` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o ISPECL [`&0`; `&0`]) THEN + REWRITE_TAC[REAL_ADD_LID] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `\x. f(&1) * floor(x) + f(frac x)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `f real_continuous_on real_interval[&0,&1]` THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; WITHINREAL_UNIV] THEN + DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `integer x` THENL + [ALL_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN CONJ_TAC THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_LMUL; REAL_CONTINUOUS_FLOOR; ETA_AX] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ATREAL_COMPOSE) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_FRAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [IN_REAL_INTERVAL] o + SPEC `frac x`) THEN + ASM_SIMP_TAC[FLOOR_FRAC; REAL_LT_IMP_LE] THEN + REWRITE_TAC[real_continuous_atreal; real_continuous_withinreal] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (min (frac x) (&1 - frac x))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_SUB_LT; FLOOR_FRAC; REAL_FRAC_POS_LT] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[real_continuous_atreal; REAL_FRAC_ZERO; REAL_FLOOR_REFL] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (BINDER_CONV o LAND_CONV) + [IN_REAL_INTERVAL]) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `&1` th) THEN MP_TAC(SPEC `&0` th)) THEN + REWRITE_TAC[REAL_LE_REFL; REAL_POS] THEN + REWRITE_TAC[IMP_IMP; real_continuous_withinreal; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `min (&1) (min d1 d2)` THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_LT_MIN] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `x <= y \/ y < x`) THENL + [SUBGOAL_THEN `floor y = floor x` ASSUME_TAC THENL + [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN + ASM_SIMP_TAC[REAL_FLOOR_REFL] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL] THEN + REWRITE_TAC[REAL_ARITH `(a + x) - (a + &0) = x - &0`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `floor y = floor x - &1` ASSUME_TAC THENL + [REWRITE_TAC[GSYM FLOOR_UNIQUE; FLOOR] THEN + ASM_SIMP_TAC[REAL_FLOOR_REFL; INTEGER_CLOSED] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[FRAC_FLOOR; REAL_FLOOR_REFL] THEN + REWRITE_TAC[REAL_ARITH `(f1 * (x - &1) + f) - (f1 * x + &0) = + f - f1`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]]; + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_FLOOR_ADD; REAL_FRAC_ADD] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; FLOOR_FRAC; REAL_LE_ADD] THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `f1 * ((x + y) + &1) + g = (f1 * x + z) + f1 * y + h <=> + f1 / &2 + g / &2 = z / &2 + h / &2`] THEN + SUBGOAL_THEN + `!t. &0 <= t /\ t <= &1 ==> f(t) / &2 = f(t / &2)` + ASSUME_TAC THENL + [GEN_TAC THEN FIRST_ASSUM(MP_TAC o ISPECL [`t / &2`; `t / &2`]) THEN + REWRITE_TAC[REAL_HALF] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_POS; REAL_LE_REFL; FLOOR_FRAC; REAL_LT_IMP_LE; + REAL_ARITH `~(x + y < &1) ==> &0 <= (x + y) - &1`; + REAL_ARITH `x < &1 /\ y < &1 ==> (x + y) - &1 <= &1`] THEN + MATCH_MP_TAC(MESON[] + `f(a + b) = f a + f b /\ f(c + d) = f(c) + f(d) /\ a + b = c + d + ==> (f:real->real)(a) + f(b) = f(c) + f(d)`) THEN + REPEAT CONJ_TAC THEN TRY REAL_ARITH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY (MP_TAC o C SPEC FLOOR_FRAC) [`x:real`; `y:real`] THEN + ASM_REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_CASES_TAC `x = &1` THEN + ASM_REWRITE_TAC[FLOOR_NUM; FRAC_NUM; REAL_MUL_RID; REAL_ADD_RID] THEN + STRIP_TAC THEN SUBGOAL_THEN `floor x = &0` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED]; + ASM_REWRITE_TAC[FRAC_FLOOR; REAL_SUB_RZERO]] THEN + ASM_REAL_ARITH_TAC]);; + +let REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR_INTERVAL = prove + (`!f b. (f ---> &0) (atreal (&0) within {x | &0 <= x}) /\ + (!x y. &0 <= x /\ &0 <= y /\ x + y <= b ==> f(x + y) = f(x) + f(y)) + ==> !a x. &0 <= x /\ x <= b /\ + &0 <= a * x /\ a * x <= b + ==> f(a * x) = a * f(x)`, + SUBGOAL_THEN + `!f. (f ---> &0) (atreal (&0) within {x | &0 <= x}) /\ + (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y)) + ==> !a x. &0 <= x /\ x <= &1 /\ &0 <= a * x /\ a * x <= &1 + ==> f(a * x) = a * f(x)` + ASSUME_TAC THENL + [SUBGOAL_THEN + `!f. f real_continuous_on real_interval[&0,&1] /\ + (!x y. &0 <= x /\ &0 <= y /\ x + y <= &1 ==> f(x + y) = f(x) + f(y)) + ==> !a x. &0 <= x /\ x <= &1 /\ &0 <= a * x /\ a * x <= &1 + ==> f(a * x) = a * f(x)` + (fun th -> GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC th) THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real->real` REAL_CONTINUOUS_ADDITIVE_EXTEND) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `g:real->real` REAL_CONTINUOUS_ADDITIVE_IMP_LINEAR) THEN + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[real_continuous_on; IN_REAL_INTERVAL] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `y = x \/ y < x \/ x < y`) THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM]; + SUBGOAL_THEN `(f:real->real)(y + (x - y)) = f(y) + f(x - y)` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_ADD_SUB2; REAL_ABS_NEG] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `(f:real->real)(x + (y - x)) = f(x) + f(y - x)` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_SUB_ADD2] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_ADD_SUB] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC]]]; + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `b < &0 \/ b = &0 \/ &0 < b`) + THENL + [ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ARITH + `a <= x /\ x <= a /\ a <= y /\ y <= a <=> x = a /\ y = a`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`&0`; `&0`]) THEN + ASM_REWRITE_TAC[REAL_ADD_LID; REAL_LE_REFL] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o ISPEC `(\x. f(b * x)):real->real`) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `a:real` THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MP_TAC(ISPEC `x / b:real` th)) THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < b ==> b * a * x / b = a * x`; + REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_ARITH `a * x / b:real = (a * x) / b`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `b * x + b * y <= b <=> &0 <= b * (&1 - (x + y))`; + REAL_LE_MUL; REAL_LT_IMP_LE; REAL_SUB_LE]] THEN + REWRITE_TAC[REALLIM_WITHINREAL] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_WITHINREAL]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + REWRITE_TAC[REAL_SUB_RZERO; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / b:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < b ==> abs b * x = x * b`] THEN + ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_LT_RDIV_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* More Steinhaus variants. *) +(* ------------------------------------------------------------------------- *) + +let STEINHAUS_TRIVIAL = prove + (`!s e. ~(negligible s) /\ &0 < e + ==> ?x y:real^N. x IN s /\ y IN s /\ ~(x = y) /\ norm(x - y) < e`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC DISCRETE_IMP_COUNTABLE THEN + ASM_MESON_TAC[REAL_NOT_LT]);; + +let REAL_STEINHAUS = prove + (`!s. real_measurable s /\ &0 < real_measure s + ==> ?d. &0 < d /\ + real_interval(--d,d) SUBSET {x - y | x IN s /\ y IN s}`, + GEN_TAC THEN SIMP_TAC[IMP_CONJ; REAL_MEASURE_MEASURE] THEN + REWRITE_TAC[IMP_IMP; REAL_MEASURABLE_MEASURABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP STEINHAUS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + REWRITE_TAC[SUBSET; BALL_INTERVAL; IN_INTERVAL_1; IN_REAL_INTERVAL] THEN + REWRITE_TAC[SET_RULE `{g x y | x IN IMAGE f s /\ y IN IMAGE f t} = + {g (f x) (f y) | x IN s /\ y IN t}`] THEN + REWRITE_TAC[GSYM LIFT_SUB] THEN + REWRITE_TAC[SET_RULE `{lift(f x y) | P x y} = IMAGE lift {f x y | P x y}`; + IN_IMAGE_LIFT_DROP; GSYM FORALL_DROP] THEN + REWRITE_TAC[DROP_SUB; DROP_VEC; LIFT_DROP; DROP_ADD] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Bernstein polynomials. *) +(* ------------------------------------------------------------------------- *) + +let bernstein = new_definition + `bernstein n k x = &(binom(n,k)) * x pow k * (&1 - x) pow (n - k)`;; + +let BERNSTEIN_CONV = + GEN_REWRITE_CONV I [bernstein] THENC + COMB2_CONV (RAND_CONV(RAND_CONV NUM_BINOM_CONV)) + (RAND_CONV(RAND_CONV NUM_SUB_CONV)) THENC + REAL_POLY_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about Bernstein polynomials. *) +(* ------------------------------------------------------------------------- *) + +let BERNSTEIN_POS = prove + (`!n k x. &0 <= x /\ x <= &1 ==> &0 <= bernstein n k x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[bernstein] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_POW_LE THEN ASM_REAL_ARITH_TAC);; + +let SUM_BERNSTEIN = prove + (`!n. sum (0..n) (\k. bernstein n k x) = &1`, + REWRITE_TAC[bernstein; GSYM REAL_BINOMIAL_THEOREM] THEN + REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE]);; + +let BERNSTEIN_LEMMA = prove + (`!n x. sum(0..n) (\k. (&k - &n * x) pow 2 * bernstein n k x) = + &n * x * (&1 - x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x y. sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k)) = + (x + y) pow n` + (LABEL_TAC "0") THENL [ASM_REWRITE_TAC[REAL_BINOMIAL_THEOREM]; ALL_TAC] THEN + SUBGOAL_THEN + `!x y. sum(0..n) (\k. &k * &(binom(n,k)) * x pow (k - 1) * y pow (n - k)) = + &n * (x + y) pow (n - 1)` + (LABEL_TAC "1") THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_DERIVATIVE_UNIQUE_ATREAL THEN + MAP_EVERY EXISTS_TAC + [`\x. sum(0..n) (\k. &(binom(n,k)) * x pow k * y pow (n - k))`; + `x:real`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG]; + ASM_REWRITE_TAC[]] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. sum(0..n) + (\k. &k * &(k - 1) * &(binom(n,k)) * x pow (k - 2) * y pow (n - k)) = + &n * &(n - 1) * (x + y) pow (n - 2)` + (LABEL_TAC "2") THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_DERIVATIVE_UNIQUE_ATREAL THEN + MAP_EVERY EXISTS_TAC + [`\x. sum(0..n) (\k. &k * &(binom(n,k)) * x pow (k - 1) * y pow (n - k))`; + `x:real`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN REWRITE_TAC[FINITE_NUMSEG]; + ASM_REWRITE_TAC[]] THEN + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[ARITH_RULE `n - 1 - 1 = n - 2`] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `(a - b) pow 2 * x = + a * (a - &1) * x + (&1 - &2 * b) * a * x + b * b * x`] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; SUM_LMUL; SUM_BERNSTEIN] THEN + SUBGOAL_THEN `sum(0..n) (\k. &k * bernstein n k x) = &n * x` SUBST1_TAC THENL + [REMOVE_THEN "1" (MP_TAC o SPECL [`x:real`; `&1 - x`]) THEN + REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE; bernstein; REAL_MUL_RID] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH + `(k * b * xk * y) * x:real = k * b * (x * xk) * y`] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + DISJ_CASES_TAC(ARITH_RULE `k = 0 \/ SUC(k - 1) = k`) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum(0..n) (\k. &k * (&k - &1) * bernstein n k x) = &n * (&n - &1) * x pow 2` + SUBST1_TAC THENL [ALL_TAC; CONV_TAC REAL_RING] THEN + REMOVE_THEN "2" (MP_TAC o SPECL [`x:real`; `&1 - x`]) THEN + REWRITE_TAC[REAL_SUB_ADD2; REAL_POW_ONE; bernstein; REAL_MUL_RID] THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[SUM_SING_NUMSEG; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; LE_1; REAL_MUL_ASSOC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[GSYM SUM_RMUL] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `((((k * k1) * b) * xk) * y) * x2:real = + k * k1 * b * y * (x2 * xk)`] THEN + REWRITE_TAC[GSYM REAL_POW_ADD; GSYM REAL_MUL_ASSOC] THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (ARITH_RULE `k = 0 \/ k = 1 \/ 1 <= k /\ 2 + k - 2 = k`) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; SUB_REFL; REAL_SUB_REFL] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit Bernstein version of 1D Weierstrass approximation theorem *) +(* ------------------------------------------------------------------------- *) + +let BERNSTEIN_WEIERSTRASS = prove + (`!f e. + f real_continuous_on real_interval[&0,&1] /\ &0 < e + ==> ?N. !n x. N <= n /\ x IN real_interval[&0,&1] + ==> abs(f x - + sum(0..n) (\k. f(&k / &n) * bernstein n k x)) < e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_bounded(IMAGE f (real_interval[&0,&1]))` MP_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + REWRITE_TAC[REAL_BOUNDED_POS; LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN X_GEN_TAC `M:real` THEN STRIP_TAC] THEN + SUBGOAL_THEN `f real_uniformly_continuous_on real_interval[&0,&1]` + MP_TAC THENL + [ASM_SIMP_TAC[REAL_COMPACT_UNIFORMLY_CONTINUOUS; REAL_COMPACT_INTERVAL]; + REWRITE_TAC[real_uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `!n x. 0 < n /\ &0 <= x /\ x <= &1 + ==> abs(f x - sum(0..n) (\k. f(&k / &n) * bernstein n k x)) + <= e / &2 + (&2 * M) / (d pow 2 * &n)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sum(0..n) (\k. (f x - f(&k / &n)) * bernstein n k x))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG; SUM_LMUL] THEN + REWRITE_TAC[SUM_BERNSTEIN; REAL_MUL_RID; REAL_LE_REFL]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[BERNSTEIN_POS; REAL_ARITH `&0 <= x ==> abs x = x`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum(0..n) (\k. (e / &2 + &2 * M / d pow 2 * (x - &k / &n) pow 2) * + bernstein n k x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[BERNSTEIN_POS] THEN + SUBGOAL_THEN `&0 <= &k / &n /\ &k / &n <= &1` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_LE; MULT_CLAUSES]; + ALL_TAC] THEN + DISJ_CASES_TAC(REAL_ARITH + `abs(x - &k / &n) < d \/ d <= abs(x - &k / &n)`) + THENL + [MATCH_MP_TAC(REAL_ARITH `x < e /\ &0 <= d ==> x <= e + d`) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= &2 * x <=> &0 <= x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_DIV; REAL_POW_2; REAL_LE_SQUARE; + REAL_LT_IMP_LE]; + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= d ==> x <= e / &2 + d`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(x) <= M /\ abs(y) <= M /\ M * &1 <= M * b / d + ==> abs(x - y) <= &2 * M / d * b`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_POW_LT; REAL_LE_RDIV_EQ] THEN + REWRITE_TAC[REAL_MUL_LID; GSYM REAL_LE_SQUARE_ABS] THEN + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG; SUM_LMUL] THEN + REWRITE_TAC[SUM_BERNSTEIN; REAL_MUL_RID; REAL_LE_LADD] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_OF_NUM_LT; ARITH; REAL_POW_LT; + REAL_LT_INV_EQ] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&n pow 2` THEN + ASM_SIMP_TAC[GSYM SUM_LMUL; REAL_POW_LT; REAL_OF_NUM_LT; REAL_FIELD + `&0 < n ==> n pow 2 * inv(n) = n`] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_MUL] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; REAL_FIELD + `&0 < n ==> n * (x - k * inv n) = n * x - k`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(x - y:real) pow 2 = (y - x) pow 2`] THEN + REWRITE_TAC[BERNSTEIN_LEMMA; REAL_ARITH + `&n * x <= &n <=> &n * x <= &n * &1 * &1`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REAL_ARITH_TAC]; + MP_TAC(ISPEC `(e / &4 * d pow 2) / (&2 * M)` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_LT_MUL] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_POW_LT; REAL_MUL_LZERO] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `(x * &2 * m) * i = (&2 * m) * (i * x)`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:real`]) THEN ASM_SIMP_TAC[] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ k < e / &4 ==> x <= e / &2 + k ==> x < e`) THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < e ==> y <= x ==> y < e`)) THEN + ASM_SIMP_TAC[real_div; REAL_LE_LMUL_EQ; REAL_LT_MUL; + REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_MUL; REAL_POW_LT; + REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* General Stone-Weierstrass theorem. *) +(* ------------------------------------------------------------------------- *) + +let STONE_WEIERSTRASS_ALT = prove + (`!(P:(real^N->real)->bool) (s:real^N->bool). + compact s /\ + (!c. P(\x. c)) /\ + (!f g. P(f) /\ P(g) ==> P(\x. f x + g x)) /\ + (!f g. P(f) /\ P(g) ==> P(\x. f x * g x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> ?f. (!x. x IN s ==> f real_continuous (at x within s)) /\ + P(f) /\ ~(f x = f y)) + ==> !f e. (!x. x IN s ==> f real_continuous (at x within s)) /\ &0 < e + ==> ?g. P(g) /\ !x. x IN s ==> abs(f x - g x) < e`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY ABBREV_TAC + [`C = \f. !x:real^N. x IN s ==> f real_continuous at x within s`; + `A = \f. C f /\ + !e. &0 < e + ==> ?g. P(g) /\ !x:real^N. x IN s ==> abs(f x - g x) < e`] THEN + SUBGOAL_THEN `!f:real^N->real. C(f) ==> A(f)` MP_TAC THENL + [ALL_TAC; MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[]] THEN + SUBGOAL_THEN `!c:real. A(\x:real^N. c)` (LABEL_TAC "const") THENL + [MAP_EVERY EXPAND_TAC ["A"; "C"] THEN X_GEN_TAC `c:real` THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN EXISTS_TAC `(\x. c):real^N->real` THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0]; + ALL_TAC] THEN + SUBGOAL_THEN `!f g:real^N->real. A(f) /\ A(g) ==> A(\x. f x + g x)` + (LABEL_TAC "add") THENL + [MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[REAL_CONTINUOUS_ADD] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2` o CONJUNCT2)) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g':real^N->real` THEN STRIP_TAC THEN + X_GEN_TAC `f':real^N->real` THEN STRIP_TAC THEN + EXISTS_TAC `(\x. f' x + g' x):real^N->real` THEN + ASM_SIMP_TAC[REAL_ARITH + `abs(f - f') < e / &2 /\ abs(g - g') < e / &2 + ==> abs((f + g) - (f' + g')) < e`]; + ALL_TAC] THEN + SUBGOAL_THEN `!f:real^N->real. A(f) ==> C(f)` (LABEL_TAC "AC") THENL + [EXPAND_TAC "A" THEN SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!f:real^N->real. C(f) ==> real_bounded(IMAGE f s)` + (LABEL_TAC "bound") THENL + [GEN_TAC THEN EXPAND_TAC "C" THEN + REWRITE_TAC[REAL_BOUNDED; GSYM IMAGE_o] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1] THEN + REWRITE_TAC[GSYM CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE]; + ALL_TAC] THEN + SUBGOAL_THEN `!f g:real^N->real. A(f) /\ A(g) ==> A(\x. f x * g x)` + (LABEL_TAC "mul") THENL + [MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN + DISCH_THEN(fun th -> STRIP_ASSUME_TAC th THEN MP_TAC th) THEN + MAP_EVERY EXPAND_TAC ["A"; "C"] THEN SIMP_TAC[REAL_CONTINUOUS_MUL] THEN + REWRITE_TAC[IMP_CONJ] THEN + MAP_EVERY (DISCH_THEN o LABEL_TAC) ["cf"; "af"; "cg"; "ag"] THEN + SUBGOAL_THEN + `real_bounded(IMAGE (f:real^N->real) s) /\ + real_bounded(IMAGE (g:real^N->real) s)` + MP_TAC THENL + [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `Bf:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `Bg:real` STRIP_ASSUME_TAC)) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "ag" (MP_TAC o SPEC `e / &2 / Bf`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g':real^N->real` THEN STRIP_TAC THEN + REMOVE_THEN "af" (MP_TAC o SPEC `e / &2 / (Bg + e / &2 / Bf)`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_ADD] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\x. f'(x) * g'(x)):real^N->real` THEN + ASM_SIMP_TAC[REAL_ARITH + `f * g - f' * g':real = f * (g - g') + g' * (f - f')`] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `e = Bf * e / &2 / Bf + + (Bg + e / &2 / Bf) * e / &2 / (Bg + e / &2 / Bf)` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `a = e / &2 /\ b = e / &2 ==> e = a + b`) THEN + CONJ_TAC THEN MAP_EVERY MATCH_MP_TAC [REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_ADD; REAL_HALF]; + MATCH_MP_TAC(REAL_ARITH + `abs a < c /\ abs b < d ==> abs(a + b) < c + d`) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_SIMP_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH + `!g. abs(g) < Bg /\ abs(g - g') < e ==> abs(g') < Bg + e`) THEN + EXISTS_TAC `(g:real^N->real) x` THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y. x IN s /\ y IN s /\ ~(x = y) + ==> ?f:real^N->real. A(f) /\ ~(f x = f y)` + (LABEL_TAC "sep") THENL + [MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + MAP_EVERY EXPAND_TAC ["A"; "C"] THEN + ASM_MESON_TAC[REAL_SUB_REFL; REAL_ABS_0]; + ALL_TAC] THEN + SUBGOAL_THEN `!f. A(f) ==> A(\x:real^N. abs(f x))` (LABEL_TAC "abs") THENL + [SUBGOAL_THEN `!f. A(f) /\ (!x. x IN s ==> abs(f x) <= &1 / &4) + ==> A(\x:real^N. abs(f x))` + ASSUME_TAC THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_bounded(IMAGE (f:real^N->real) s)` MP_TAC THENL + [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_BOUNDED_POS_LT; FORALL_IN_IMAGE]] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `A(\x:real^N. (&4 * B) * abs(inv(&4 * B) * f x)):bool` + MP_TAC THENL + [USE_THEN "mul" MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> abs(B) = B`; + REAL_LT_INV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_LT_MUL; + REAL_OF_NUM_LT; ARITH; REAL_MUL_ASSOC] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_MUL_LID; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ARITH `&0 < B ==> abs(B) = B`; + REAL_LT_INV_EQ; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID; + REAL_ARITH `&0 < B ==> ~(&4 * B = &0)`]]] THEN + X_GEN_TAC `f:real^N->real` THEN MAP_EVERY EXPAND_TAC ["A"; "C"] THEN + DISCH_THEN(fun th -> CONJ_TAC THEN MP_TAC th) THENL + [DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT1) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT; o_DEF] + REAL_CONTINUOUS_WITHIN_COMPOSE) THEN + REWRITE_TAC[real_continuous_withinreal] THEN + MESON_TAC[ARITH_RULE `abs(x - y) < d ==> abs(abs x - abs y) < d`]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun t -> X_GEN_TAC `e:real` THEN DISCH_TAC THEN MP_TAC t) THEN + DISCH_THEN(MP_TAC o SPEC `min (e / &2) (&1 / &4)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_LT_MIN; FORALL_AND_THM; + TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^N->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`\x. abs(x - &1 / &2)`; `e / &2`] + BERNSTEIN_WEIERSTRASS) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[real_continuous_on; REAL_HALF] THEN + MESON_TAC[ARITH_RULE + `abs(x - y) < d ==> abs(abs(x - a) - abs(y - a)) < d`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN + EXISTS_TAC `\x:real^N. sum(0..n) (\k. abs(&k / &n - &1 / &2) * + bernstein n k (&1 / &2 + p x))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [SUBGOAL_THEN + `!m c z. P(\x:real^N. + sum(0..m) (\k. c k * bernstein (z m) k (&1 / &2 + p x)))` + (fun th -> REWRITE_TAC[th]) THEN + SUBGOAL_THEN + `!m k. P(\x:real^N. bernstein m k (&1 / &2 + p x))` + ASSUME_TAC THENL + [ALL_TAC; INDUCT_TAC THEN ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0]] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[bernstein] THEN + REWRITE_TAC[REAL_ARITH `&1 - (&1 / &2 + p) = &1 / &2 + -- &1 * p`] THEN + REPEAT(FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]) THEN + SUBGOAL_THEN + `!f:real^N->real k. P(f) ==> P(\x. f(x) pow k)` + (fun th -> ASM_SIMP_TAC[th]) THEN + GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[real_pow]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `!p. abs(abs(p x) - s) < e / &2 /\ + abs(f x - p x) < e / &2 + ==> abs(abs(f x) - s) < e`) THEN + EXISTS_TAC `p:real^N->real` THEN ASM_SIMP_TAC[] THEN + GEN_REWRITE_TAC (PAT_CONV `\x. abs(abs x - a) < e`) + [REAL_ARITH `x = (&1 / &2 + x) - &1 / &2`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + MATCH_MP_TAC(REAL_ARITH + `!f. abs(f) <= &1 / &4 /\ abs(f - p) < &1 / &4 + ==> &0 <= &1 / &2 + p /\ &1 / &2 + p <= &1`) THEN + EXISTS_TAC `(f:real^N->real) x` THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `!f:real^N->real g. A(f) /\ A(g) ==> A(\x. max (f x) (g x))` + (LABEL_TAC "max") THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ARITH + `max a b = inv(&2) * (a + b + abs(a + -- &1 * b))`] THEN + REPEAT(FIRST_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]); + ALL_TAC] THEN + SUBGOAL_THEN `!f:real^N->real g. A(f) /\ A(g) ==> A(\x. min (f x) (g x))` + (LABEL_TAC "min") THENL + [ASM_SIMP_TAC[REAL_ARITH `min a b = -- &1 * (max(-- &1 * a) (-- &1 * b))`]; + ALL_TAC] THEN + SUBGOAL_THEN + `!t. FINITE t /\ (!f. f IN t ==> A(f)) ==> A(\x:real^N. sup {f(x) | f IN t})` + (LABEL_TAC "sup") THENL + [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[FORALL_IN_INSERT; SIMPLE_IMAGE; IMAGE_CLAUSES] THEN + ASM_SIMP_TAC[SUP_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real`; `t:(real^N->real)->bool`] THEN + ASM_CASES_TAC `t:(real^N->real)->bool = {}` THEN ASM_SIMP_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!t. FINITE t /\ (!f. f IN t ==> A(f)) ==> A(\x:real^N. inf {f(x) | f IN t})` + (LABEL_TAC "inf") THENL + [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[FORALL_IN_INSERT; SIMPLE_IMAGE; IMAGE_CLAUSES] THEN + ASM_SIMP_TAC[INF_INSERT_FINITE; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real`; `t:(real^N->real)->bool`] THEN + ASM_CASES_TAC `t:(real^N->real)->bool = {}` THEN ASM_SIMP_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!f:real^N->real e. + C(f) /\ &0 < e ==> ?g. A(g) /\ !x. x IN s ==> abs(f x - g x) < e` + ASSUME_TAC THENL + [ALL_TAC; + X_GEN_TAC `f:real^N->real` THEN DISCH_TAC THEN EXPAND_TAC "A" THEN + CONJ_TAC THENL [FIRST_X_ASSUM ACCEPT_TAC; ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`f:real^N->real`; `e / &2`]) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `h:real^N->real` THEN EXPAND_TAC "A" THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2` o CONJUNCT2) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[REAL_ARITH + `abs(f - h) < e / &2 /\ abs(h - g) < e / &2 ==> abs(f - g) < e`]] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real`; `e:real`] THEN EXPAND_TAC "C" THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!x y. x IN s /\ y IN s + ==> ?h:real^N->real. A(h) /\ h(x) = f(x) /\ h(y) = f(y)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `y:real^N = x` THENL + [EXISTS_TAC `\z:real^N. (f:real^N->real) x` THEN ASM_SIMP_TAC[]; + SUBGOAL_THEN `?h:real^N->real. A(h) /\ ~(h x = h y)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `\z. (f y - f x) / (h y - h x) * (h:real^N->real)(z) + + (f x - (f y - f x) / (h y - h x) * h(x))` THEN + ASM_SIMP_TAC[] THEN + UNDISCH_TAC `~((h:real^N->real) x = h y)` THEN CONV_TAC REAL_FIELD]; + ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f2:real^N->real^N->real^N->real` THEN DISCH_TAC THEN + ABBREV_TAC `G = \x y. + {z | z IN s /\ (f2:real^N->real^N->real^N->real) x y z < f(z) + e}` THEN + SUBGOAL_THEN `!x y:real^N. x IN s /\ y IN s ==> x IN G x y /\ y IN G x y` + ASSUME_TAC THENL + [EXPAND_TAC "G" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[REAL_LT_ADDR]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x. x IN s ==> ?f1. A(f1) /\ f1 x = f x /\ + !y:real^N. y IN s ==> f1 y < f y + e` + MP_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + DISCH_THEN(MP_TAC o SPEC + `{(G:real^N->real^N->real^N->bool) x y | y IN s}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE; ETA_AX] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + EXPAND_TAC "G" THEN REWRITE_TAC[] THEN X_GEN_TAC `w:real^N` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`lift o (\z:real^N. f2 (x:real^N) (w:real^N) z - f z)`; + `s:real^N->bool`; + `{x:real^1 | x$1 < e}`] CONTINUOUS_OPEN_IN_PREIMAGE) THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM drop; LIFT_DROP; o_DEF] THEN + REWRITE_TAC[LIFT_SUB; GSYM REAL_CONTINUOUS_CONTINUOUS1; + REAL_ARITH `x < y + e <=> x - y < e`] THEN + DISCH_THEN MATCH_MP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1; ETA_AX] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:real^N. inf {f2 (x:real^N) (y:real^N) z | y IN t}` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `x = min x x`] THEN + REWRITE_TAC[REAL_MIN_INF; INSERT_AC] THEN AP_TERM_TAC THEN ASM SET_TAC[]; + REMOVE_THEN "inf" (MP_TAC o SPEC + `IMAGE (\y z. (f2:real^N->real^N->real^N->real) x y z) t`) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF]; + SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INF_LT_FINITE; SIMPLE_IMAGE; + FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + UNDISCH_TAC + `s SUBSET {y:real^N | ?z:real^N. z IN t /\ y IN G (x:real^N) z}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "G" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f1:real^N->real^N->real` THEN DISCH_TAC] THEN + ABBREV_TAC `H = \x:real^N. {z:real^N | z IN s /\ f z - e < f1 x z}` THEN + SUBGOAL_THEN `!x:real^N. x IN s ==> x IN (H x)` ASSUME_TAC THENL + [EXPAND_TAC "H" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[REAL_ARITH `x - e < x <=> &0 < e`]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + DISCH_THEN(MP_TAC o SPEC + `{(H:real^N->real^N->bool) x | x IN s}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; FORALL_IN_IMAGE; ETA_AX] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN EXPAND_TAC "H" THEN + REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`lift o (\z:real^N. f z - f1 (x:real^N) z)`; + `s:real^N->bool`; + `{x:real^1 | x$1 < e}`] CONTINUOUS_OPEN_IN_PREIMAGE) THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM drop; LIFT_DROP; o_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `x - y < z <=> x - z < y`] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[LIFT_SUB; GSYM REAL_CONTINUOUS_CONTINUOUS1; + REAL_ARITH `x < y + e <=> x - y < e`] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS1; ETA_AX] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:real^N. sup {f1 (x:real^N) z | x IN t}` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REMOVE_THEN "sup" (MP_TAC o SPEC `IMAGE (f1:real^N->real^N->real) t`) THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SIMPLE_IMAGE; ETA_AX] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF]; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(t:real^N->bool = {})` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SIMPLE_IMAGE; REAL_ARITH + `abs(f - s) < e <=> f - e < s /\ s < f + e`] THEN + ASM_SIMP_TAC[REAL_SUP_LT_FINITE; REAL_LT_SUP_FINITE; + FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + UNDISCH_TAC `s SUBSET {y:real^N | ?x:real^N. x IN t /\ y IN H x}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "H" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]);; + +let STONE_WEIERSTRASS = prove + (`!(P:(real^N->real)->bool) (s:real^N->bool). + compact s /\ + (!f. P(f) ==> !x. x IN s ==> f real_continuous (at x within s)) /\ + (!c. P(\x. c)) /\ + (!f g. P(f) /\ P(g) ==> P(\x. f x + g x)) /\ + (!f g. P(f) /\ P(g) ==> P(\x. f x * g x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P(f) /\ ~(f x = f y)) + ==> !f e. (!x. x IN s ==> f real_continuous (at x within s)) /\ &0 < e + ==> ?g. P(g) /\ !x. x IN s ==> abs(f x - g x) < e`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Real and complex versions of Stone-Weierstrass theorem. *) +(* ------------------------------------------------------------------------- *) + +let REAL_STONE_WEIERSTRASS_ALT = prove + (`!P s. real_compact s /\ + (!c. P (\x. c)) /\ + (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ + (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> ?f. f real_continuous_on s /\ P f /\ ~(f x = f y)) + ==> !f e. f real_continuous_on s /\ &0 < e + ==> ?g. P g /\ !x. x IN s ==> abs(f x - g x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\f. (P:(real->real)->bool)(f o lift)`; + `IMAGE lift s`] STONE_WEIERSTRASS_ALT) THEN + ASM_SIMP_TAC[GSYM real_compact; o_DEF] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[LIFT_EQ] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:real->real) o drop` THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP; ETA_AX] THEN + UNDISCH_TAC `g real_continuous_on s` THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[real_continuous_within; continuous_within] THEN + REWRITE_TAC[o_THM; LIFT_DROP; DIST_LIFT]; + DISCH_THEN(MP_TAC o SPEC `(f:real->real) o drop`) THEN ANTS_TAC THENL + [UNDISCH_TAC `f real_continuous_on s` THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[real_continuous_within; continuous_within] THEN + REWRITE_TAC[o_THM; LIFT_DROP; DIST_LIFT]; + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(g:real^1->real) o lift` THEN ASM_REWRITE_TAC[o_DEF]]]);; + +let REAL_STONE_WEIERSTRASS = prove + (`!P s. real_compact s /\ + (!f. P f ==> f real_continuous_on s) /\ + (!c. P (\x. c)) /\ + (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ + (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ ~(f x = f y)) + ==> !f e. f real_continuous_on s /\ &0 < e + ==> ?g. P g /\ !x. x IN s ==> abs(f x - g x) < e`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `y:real`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; + +let COMPLEX_STONE_WEIERSTRASS_ALT = prove + (`!P s. compact s /\ + (!c. P (\x. c)) /\ + (!f. P f ==> P(\x. cnj(f x))) /\ + (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ + (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) + ==> ?f. P f /\ f continuous_on s /\ ~(f x = f y)) + ==> !f:real^N->complex e. + f continuous_on s /\ &0 < e + ==> ?g. P g /\ !x. x IN s ==> norm(f x - g x) < e`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!f. P f ==> P(\x:real^N. Cx(Re(f x)))` ASSUME_TAC THENL + [ASM_SIMP_TAC[CX_RE_CNJ; SIMPLE_COMPLEX_ARITH + `x / Cx(&2) = inv(Cx(&2)) * x`]; + ALL_TAC] THEN + SUBGOAL_THEN `!f. P f ==> P(\x:real^N. Cx(Im(f x)))` ASSUME_TAC THENL + [ASM_SIMP_TAC[CX_IM_CNJ; SIMPLE_COMPLEX_ARITH + `x - y = x + --Cx(&1) * y /\ x / Cx(&2) = inv(Cx(&2)) * x`] THEN + REPEAT STRIP_TAC THEN REPEAT(FIRST_ASSUM MATCH_MP_TAC ORELSE CONJ_TAC) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\x. x IN {Re o f | P (f:real^N->complex)}`; `s:real^N->bool`] + STONE_WEIERSTRASS_ALT) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[EXISTS_IN_GSPEC; IMP_IMP; GSYM CONJ_ASSOC] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM; IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^N. Cx(c)` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; RE_CX]; + MAP_EVERY X_GEN_TAC [`f:real^N->complex`; `g:real^N->complex`] THEN + DISCH_TAC THEN EXISTS_TAC `(\x. f x + g x):real^N->complex` THEN + ASM_SIMP_TAC[o_THM; RE_ADD; FUN_EQ_THM]; + MAP_EVERY X_GEN_TAC [`f:real^N->complex`; `g:real^N->complex`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x:real^N. Cx(Re(f x)) * Cx(Re(g x))` THEN + ASM_SIMP_TAC[FUN_EQ_THM; RE_CX; o_THM; RE_MUL_CX]; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:real^N->complex` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EQ] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THENL + [EXISTS_TAC `\x:real^N. Re(f x)` THEN ASM_REWRITE_TAC[o_DEF] THEN + CONJ_TAC THENL + [ALL_TAC; EXISTS_TAC `f:real^N->complex` THEN ASM_REWRITE_TAC[]]; + EXISTS_TAC `\x:real^N. Im(f x)` THEN ASM_REWRITE_TAC[o_DEF] THEN + CONJ_TAC THENL + [ALL_TAC; + EXISTS_TAC `\x:real^N. Cx(Im(f x))` THEN ASM_SIMP_TAC[RE_CX]]] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; + REAL_CONTINUOUS_AT_WITHIN] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]]; + DISCH_THEN(LABEL_TAC "*") THEN X_GEN_TAC `f:real^N->complex` THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REMOVE_THEN "*" + (fun th -> MP_TAC(ISPEC `Re o (f:real^N->complex)` th) THEN + MP_TAC(ISPEC `Im o (f:real^N->complex)` th)) THEN + MATCH_MP_TAC(TAUT `(p1 /\ p2) /\ (q1 /\ q2 ==> r) + ==> (p1 ==> q1) ==> (p2 ==> q2) ==> r`) THEN + CONJ_TAC THENL + [CONJ_TAC THEN X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_CONTINUOUS_WITHIN_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; + REAL_CONTINUOUS_AT_WITHIN] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]; + ALL_TAC] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; o_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `g:real^N->complex` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `h:real^N->complex` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\x:real^N. Cx(Re(h x)) + ii * Cx(Re(g x))` THEN + ASM_SIMP_TAC[] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [COMPLEX_EXPAND] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x1 - x2) < e / &2 /\ norm(y1 - y2) < e / &2 + ==> norm((x1 + y1) - (x2 + y2)) < e`) THEN + ASM_SIMP_TAC[GSYM CX_SUB; COMPLEX_NORM_CX; GSYM COMPLEX_SUB_LDISTRIB; + COMPLEX_NORM_MUL; COMPLEX_NORM_II; REAL_MUL_LID]]);; + +let COMPLEX_STONE_WEIERSTRASS = prove + (`!P s. compact s /\ + (!f. P f ==> f continuous_on s) /\ + (!c. P (\x. c)) /\ + (!f. P f ==> P(\x. cnj(f x))) /\ + (!f g. P f /\ P g ==> P (\x. f x + g x)) /\ + (!f g. P f /\ P g ==> P (\x. f x * g x)) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> ?f. P f /\ ~(f x = f y)) + ==> !f:real^N->complex e. + f continuous_on s /\ &0 < e + ==> ?g. P g /\ !x. x IN s ==> norm(f x - g x) < e`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC COMPLEX_STONE_WEIERSTRASS_ALT THEN ASM_SIMP_TAC[] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Stone-Weierstrass for R^n -> R polynomials. *) +(* ------------------------------------------------------------------------- *) + +let real_polynomial_function_RULES, + real_polynomial_function_INDUCT, + real_polynomial_function_CASES = new_inductive_definition + `(!i. 1 <= i /\ i <= dimindex(:N) + ==> real_polynomial_function(\x:real^N. x$i)) /\ + (!c. real_polynomial_function(\x:real^N. c)) /\ + (!f g. real_polynomial_function f /\ real_polynomial_function g + ==> real_polynomial_function(\x:real^N. f x + g x)) /\ + (!f g. real_polynomial_function f /\ real_polynomial_function g + ==> real_polynomial_function(\x:real^N. f x * g x))`;; + +let REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION = prove + (`!f x:real^N. + real_polynomial_function f ==> f real_continuous at x`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC real_polynomial_function_INDUCT THEN + SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_MUL; + REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_AT_COMPONENT]);; + +let STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION = prove + (`!f:real^N->real s e. + compact s /\ + (!x. x IN s ==> f real_continuous at x within s) /\ + &0 < e + ==> ?g. real_polynomial_function g /\ + !x. x IN s ==> abs(f x - g x) < e`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + STONE_WEIERSTRASS) THEN + ASM_REWRITE_TAC[real_polynomial_function_RULES] THEN + SIMP_TAC[REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION; + REAL_CONTINUOUS_AT_WITHIN] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [CART_EQ] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN EXISTS_TAC `\x:real^N. x$i` THEN + ASM_SIMP_TAC[real_polynomial_function_RULES]);; + +(* ------------------------------------------------------------------------- *) +(* Stone-Weierstrass for real^M->real^N polynomials. *) +(* ------------------------------------------------------------------------- *) + +let vector_polynomial_function = new_definition + `vector_polynomial_function (f:real^M->real^N) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> real_polynomial_function(\x. f(x)$i)`;; + +let REAL_POLYNOMIAL_FUNCTION_DROP = prove + (`!f. real_polynomial_function(drop o f) <=> vector_polynomial_function f`, + REWRITE_TAC[vector_polynomial_function; DIMINDEX_1; FORALL_1] THEN + REWRITE_TAC[o_DEF; drop]);; + +let VECTOR_POLYNOMIAL_FUNCTION_LIFT = prove + (`!f. vector_polynomial_function(lift o f) <=> real_polynomial_function f`, + REWRITE_TAC[GSYM REAL_POLYNOMIAL_FUNCTION_DROP; o_DEF; LIFT_DROP; ETA_AX]);; + +let VECTOR_POLYNOMIAL_FUNCTION_CONST = prove + (`!c. vector_polynomial_function(\x. c)`, + SIMP_TAC[vector_polynomial_function; real_polynomial_function_RULES]);; + +let VECTOR_POLYNOMIAL_FUNCTION_ID = prove + (`vector_polynomial_function(\x. x)`, + SIMP_TAC[vector_polynomial_function; real_polynomial_function_RULES]);; + +let VECTOR_POLYNOMIAL_FUNCTION_COMPONENT = prove + (`!f:real^M->real^N i. + 1 <= i /\ i <= dimindex(:N) /\ vector_polynomial_function f + ==> vector_polynomial_function(\x. lift(f x$i))`, + SIMP_TAC[vector_polynomial_function; FORALL_1; DIMINDEX_1; GSYM drop; + LIFT_DROP]);; + +let VECTOR_POLYNOMIAL_FUNCTION_ADD = prove + (`!f g:real^M->real^N. + vector_polynomial_function f /\ vector_polynomial_function g + ==> vector_polynomial_function (\x. f x + g x)`, + + REWRITE_TAC[vector_polynomial_function] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; real_polynomial_function_RULES]);; + +let VECTOR_POLYNOMIAL_FUNCTION_MUL = prove + (`!f g:real^M->real^N. + vector_polynomial_function(lift o f) /\ vector_polynomial_function g + ==> vector_polynomial_function (\x. f x % g x)`, + REWRITE_TAC[vector_polynomial_function; o_DEF; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[FORALL_1; DIMINDEX_1; GSYM drop; LIFT_DROP; ETA_AX] THEN + SIMP_TAC[real_polynomial_function_RULES]);; + +let VECTOR_POLYNOMIAL_FUNCTION_CMUL = prove + (`!f:real^M->real^N c. + vector_polynomial_function f + ==> vector_polynomial_function (\x. c % f x)`, + SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; VECTOR_POLYNOMIAL_FUNCTION_MUL; + ETA_AX; o_DEF]);; + +let VECTOR_POLYNOMIAL_FUNCTION_NEG = prove + (`!f:real^M->real^N. + vector_polynomial_function f + ==> vector_polynomial_function (\x. --(f x))`, + REWRITE_TAC[VECTOR_ARITH `--x:real^N = --(&1) % x`] THEN + REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CMUL]);; + +let VECTOR_POLYNOMIAL_FUNCTION_SUB = prove + (`!f g:real^M->real^N. + vector_polynomial_function f /\ vector_polynomial_function g + ==> vector_polynomial_function (\x. f x - g x)`, + SIMP_TAC[VECTOR_SUB; VECTOR_POLYNOMIAL_FUNCTION_ADD; + VECTOR_POLYNOMIAL_FUNCTION_NEG]);; + +let VECTOR_POLYNOMIAL_FUNCTION_VSUM = prove + (`!f:real^M->A->real^N s. + FINITE s /\ (!i. i IN s ==> vector_polynomial_function (\x. f x i)) + ==> vector_polynomial_function (\x. vsum s (f x))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; FORALL_IN_INSERT; VECTOR_POLYNOMIAL_FUNCTION_CONST; + VECTOR_POLYNOMIAL_FUNCTION_ADD]);; + +let REAL_VECTOR_POLYNOMIAL_FUNCTION_o = prove + (`!f:real^M->real^N g. + vector_polynomial_function f /\ real_polynomial_function g + ==> real_polynomial_function(g o f)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC real_polynomial_function_INDUCT THEN + REWRITE_TAC[o_DEF; real_polynomial_function_RULES] THEN + ASM_REWRITE_TAC[GSYM vector_polynomial_function]);; + +let VECTOR_POLYNOMIAL_FUNCTION_o = prove + (`!f:real^M->real^N g:real^N->real^P. + vector_polynomial_function f /\ vector_polynomial_function g + ==> vector_polynomial_function(g o f)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_VECTOR_POLYNOMIAL_FUNCTION_o)) THEN + SIMP_TAC[vector_polynomial_function; o_DEF]);; + +let REAL_POLYNOMIAL_FUNCTION_1 = prove + (`!f. real_polynomial_function f <=> + ?a n. f = \x. sum(0..n) (\i. a i * drop x pow i)`, + REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC real_polynomial_function_INDUCT THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; FUN_EQ_THM] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`\i. if i = 1 then &1 else &0`; `1`] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ARITH_EQ; REAL_MUL_LZERO; drop] THEN + SIMP_TAC[ARITH; SUM_SING_NUMSEG] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `c:real` THEN + MAP_EVERY EXISTS_TAC [`(\i. c):num->real`; `0`] THEN + REWRITE_TAC[SUM_SING_NUMSEG; real_pow] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num->real`; `m:num`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`b:num->real`; `n:num`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXISTS_TAC + [`\i:num. (if i <= m then a i else &0) + (if i <= n then b i else &0)`; + `MAX m n`] THEN + GEN_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN BINOP_TAC THEN + BINOP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN ARITH_TAC; + REWRITE_TAC[GSYM SUM_RMUL] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + SIMP_TAC[SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN + EXISTS_TAC `\k. sum {x | x IN {i,j | i IN 0..m /\ j IN 0..n} /\ + FST x + SND x = k} + (\(i,j). a i * b j)` THEN + EXISTS_TAC `m + n:num` THEN X_GEN_TAC `x:real^1` THEN + MP_TAC(ISPECL + [`\(i:num,j). i + j`; + `\(i,j). (a i * drop x pow i) * (b j * drop x pow j)`; + `{i,j | i IN 0..m /\ j IN 0..n}`; `0..m+n`] SUM_GROUP) THEN + SIMP_TAC[FINITE_PRODUCT; FINITE_NUMSEG; FORALL_IN_IMAGE; + FORALL_IN_GSPEC; SUBSET; IN_NUMSEG; LE_0; LE_ADD2] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM SUM_RMUL] THEN + MATCH_MP_TAC(MESON[SUM_EQ] `s = t /\ (!x. x IN t ==> f x = g x) + ==> sum s f = sum t g`) THEN + SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_GSPEC; IMP_CONJ] THEN + SIMP_TAC[IN_ELIM_PAIR_THM; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_POW_ADD] THEN REAL_ARITH_TAC]; + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM VECTOR_POLYNOMIAL_FUNCTION_LIFT] THEN + SIMP_TAC[LIFT_SUM; o_DEF; FINITE_NUMSEG; FORALL_1; DIMINDEX_1] THEN + MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; LIFT_CMUL] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_MUL THEN + REWRITE_TAC[GSYM REAL_POLYNOMIAL_FUNCTION_DROP; o_DEF; LIFT_DROP] THEN + REWRITE_TAC[real_polynomial_function_RULES] THEN + SPEC_TAC(`i:num`,`k:num`) THEN REWRITE_TAC[drop] THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[real_polynomial_function_RULES; real_pow; DIMINDEX_1; + ARITH]]);; + +let CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!f:real^M->real^N x. + vector_polynomial_function f ==> f continuous at x`, + REWRITE_TAC[vector_polynomial_function; CONTINUOUS_COMPONENTWISE] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_REAL_POLYMONIAL_FUNCTION THEN + ASM_SIMP_TAC[]);; + +let CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!f:real^M->real^N s. + vector_polynomial_function f ==> f continuous_on s`, + SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; + CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION]);; + +let HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!p:real^1->real^N. + vector_polynomial_function p + ==> ?p'. vector_polynomial_function p' /\ + !x. (p has_vector_derivative p'(x)) (at x)`, + let lemma = prove + (`!p:real^1->real. + real_polynomial_function p + ==> ?p'. real_polynomial_function p' /\ + !x. ((p o lift) has_real_derivative (p'(lift x))) (atreal x)`, + MATCH_MP_TAC + (derive_strong_induction(real_polynomial_function_RULES, + real_polynomial_function_INDUCT)) THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; o_DEF; GSYM drop; LIFT_DROP] THEN + CONJ_TAC THENL + [EXISTS_TAC `\x:real^1. &1` THEN + REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ID]; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^1. &0` THEN + REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_CONST]; + ALL_TAC] THEN + CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `f':real^1->real` STRIP_ASSUME_TAC)) + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `g':real^1->real` STRIP_ASSUME_TAC))) + THENL + [EXISTS_TAC `\x. (f':real^1->real) x + g' x`; + EXISTS_TAC `\x. (f:real^1->real) x * g' x + f' x * g x`] THEN + ASM_SIMP_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ADD; + HAS_REAL_DERIVATIVE_MUL_ATREAL]) in + GEN_TAC THEN REWRITE_TAC[vector_polynomial_function] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?q. real_polynomial_function q /\ + (!x. ((\x. lift(((p x):real^N)$i)) has_vector_derivative + lift(q x)) (at x))` + MP_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + REWRITE_TAC[HAS_REAL_VECTOR_DERIVATIVE_AT] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; FORALL_DROP]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `q:num->real^1->real` THEN DISCH_TAC THEN + EXISTS_TAC `(\x. lambda i. (q:num->real^1->real) i x):real^1->real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA; ETA_AX] THEN + REWRITE_TAC[has_vector_derivative; has_derivative_at] THEN + ONCE_REWRITE_TAC[LIM_COMPONENTWISE] THEN X_GEN_TAC `x:real^1` THEN + SIMP_TAC[LINEAR_VMUL_DROP; LINEAR_ID] THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN + REWRITE_TAC[has_vector_derivative; has_derivative_at] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; VEC_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_ADD_COMPONENT; LAMBDA_BETA; REAL_TENDSTO] THEN + SIMP_TAC[DROP_ADD; DROP_VEC; LIFT_DROP; DROP_CMUL; DROP_SUB; o_DEF]]);; + +let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!f:real^M->real^N s e. + compact s /\ f continuous_on s /\ &0 < e + ==> ?g. vector_polynomial_function g /\ + !x. x IN s ==> norm(f x - g x) < e`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN]) THEN + REWRITE_TAC[CONTINUOUS_COMPONENTWISE] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?g. real_polynomial_function g /\ + !x. x IN s ==> abs((f:real^M->real^N) x$i - g x) < + e / &(dimindex(:N))` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC STONE_WEIERSTRASS_REAL_POLYNOMIAL_FUNCTION THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:num->real^M->real` THEN DISCH_TAC THEN + EXISTS_TAC `(\x. lambda i. g i x):real^M->real^N` THEN + ASM_SIMP_TAC[vector_polynomial_function; LAMBDA_BETA; ETA_AX] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; CARD_NUMSEG_1; NUMSEG_EMPTY; NOT_LT] THEN + ASM_SIMP_TAC[IN_NUMSEG; DIMINDEX_GE_1; LAMBDA_BETA; + VECTOR_SUB_COMPONENT]]);; + +let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE = prove + (`!f:real^M->real^N s e t. + compact s /\ f continuous_on s /\ &0 < e /\ + subspace t /\ IMAGE f s SUBSET t + ==> ?g. vector_polynomial_function g /\ IMAGE g s SUBSET t /\ + !x. x IN s ==> norm(f x - g x) < e`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHONORMAL_BASIS_SUBSPACE) THEN + DISCH_THEN(X_CHOOSE_THEN `bas:real^N->bool` MP_TAC) THEN + ASM_CASES_TAC `FINITE(bas:real^N->bool)` THENL + [ALL_TAC; ASM_MESON_TAC[HAS_SIZE]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ABBREV_TAC `n = CARD(bas:real^N->bool)` THEN + REWRITE_TAC[INJECTIVE_ON_ALT; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b:num->real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN + ASM_SIMP_TAC[REWRITE_RULE[INJECTIVE_ON_ALT] HAS_SIZE_IMAGE_INJ_EQ] THEN + REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG_1] THEN + ASM_CASES_TAC `dim(t:real^N->bool) = n` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN STRIP_TAC THEN + MP_TAC(ISPEC `t:real^N->bool` DIM_SUBSET_UNIV) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MP_TAC(ISPECL + [`(\x. lambda i. (f x:real^N) dot (b i)):real^M->real^N`; + `s:real^M->bool`; `e:real`] + STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST]; + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `(\x. vsum(1..n) (\i. (g x:real^N)$i % b i)):real^M->real^N` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_MUL THEN + REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; o_DEF] THEN + MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_COMPONENT THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_VSUM THEN + ASM_SIMP_TAC[SUBSPACE_MUL; FINITE_NUMSEG]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + SUBGOAL_THEN + `vsum(IMAGE b (1..n)) (\v. (v dot f x) % v) = (f:real^M->real^N) x` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SYM th]) + THENL + [MATCH_MP_TAC ORTHONORMAL_BASIS_EXPAND THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[REWRITE_RULE[INJECTIVE_ON_ALT] VSUM_IMAGE; + FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM VSUM_SUB_NUMSEG; o_DEF; GSYM VECTOR_SUB_RDISTRIB] THEN + REWRITE_TAC[NORM_LE; GSYM NORM_POW_2] THEN + W(MP_TAC o PART_MATCH (lhs o rand) NORM_VSUM_PYTHAGOREAN o + lhand o snd) THEN + RULE_ASSUM_TAC(REWRITE_RULE[PAIRWISE_IMAGE]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; ORTHOGONAL_MUL; FINITE_NUMSEG] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_MUL] THEN + REWRITE_TAC[NORM_POW_2] THEN GEN_REWRITE_TAC RAND_CONV [dot] THEN + SIMP_TAC[GSYM REAL_POW_2; VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_LE_INCLUDED THEN EXISTS_TAC `\n:num. n` THEN + REWRITE_TAC[FINITE_NUMSEG; REAL_LE_POW_2] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[UNWIND_THM2] THEN + ONCE_REWRITE_TAC[TAUT `p ==> q /\ r <=> p ==> q /\ (q ==> r)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN + ASM_SIMP_TAC[LAMBDA_BETA; UNWIND_THM2; IN_NUMSEG] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_POW2_ABS; REAL_LE_REFL] THEN + ASM_ARITH_TAC]]);; + +let STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_AFFINE = prove + (`!f:real^M->real^N s e t. + compact s /\ f continuous_on s /\ &0 < e /\ + affine t /\ IMAGE f s SUBSET t + ==> ?g. vector_polynomial_function g /\ IMAGE g s SUBSET t /\ + !x. x IN s ==> norm(f x - g x) < e`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SUBSET_EMPTY; IMAGE_EQ_EMPTY] THENL + [MESON_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST; NOT_IN_EMPTY]; + STRIP_TAC] THEN + MP_TAC(ISPEC `t:real^N->bool` AFFINE_TRANSLATION_SUBSPACE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `u:real^N->bool`] THEN STRIP_TAC THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(ISPECL + [`(\x. f x - a):real^M->real^N`; `s:real^M->bool`; `e:real`; + `u:real^N->bool`] STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION_SUBSPACE) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST] THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. x - a` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_SUB; IMAGE_ID] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(\x. g x + a):real^M->real^N` THEN + ASM_SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_ADD; + VECTOR_POLYNOMIAL_FUNCTION_CONST; + VECTOR_ARITH `a - (b + c):real^N = a - c - b`] THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:real^N. a + x` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ADD_AC]);; + +(* ------------------------------------------------------------------------- *) +(* One application is to pick a smooth approximation to a path, or just pick *) +(* a smooth path anyway in an open connected set. *) +(* ------------------------------------------------------------------------- *) + +let PATH_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!g:real^1->real^N. vector_polynomial_function g ==> path g`, + SIMP_TAC[path; CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION]);; + +let PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!g:real^1->real^N e. + path g /\ &0 < e + ==> ?p. vector_polynomial_function p /\ + pathstart p = pathstart g /\ + pathfinish p = pathfinish g /\ + !t. t IN interval[vec 0,vec 1] ==> norm(p t - g t) < e`, + REWRITE_TAC[path] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^1->real^N`; `interval[vec 0:real^1,vec 1]`; `e / &4`] + STONE_WEIERSTRASS_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL; REAL_ARITH `&0 < x / &4 <=> &0 < x`] THEN + DISCH_THEN(X_CHOOSE_THEN `q:real^1->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\t. (q:real^1->real^N)(t) + (g(vec 0:real^1) - q(vec 0)) + + drop t % ((g(vec 1) - q(vec 1)) - (g(vec 0) - q(vec 0)))` THEN + REWRITE_TAC[pathstart; pathfinish; DROP_VEC] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[vector_polynomial_function; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT] THEN + REPEAT STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[vector_polynomial_function]) THEN + MATCH_MP_TAC(el 2 (CONJUNCTS real_polynomial_function_RULES)) THEN + ASM_SIMP_TAC[real_polynomial_function_RULES; drop; DIMINDEX_1; ARITH]; + VECTOR_ARITH_TAC; + VECTOR_ARITH_TAC; + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x - a) < e / &4 /\ norm b < e / &4 /\ norm c <= &1 * e / &4 /\ + norm d <= &1 * e / &4 + ==> norm((a + b + c - d) - x:real^N) < e`) THEN + ASM_SIMP_TAC[NORM_MUL; IN_INTERVAL_1; DROP_VEC; REAL_POS] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; IN_INTERVAL_1; DROP_VEC; REAL_POS; + REAL_LE_REFL; NORM_POS_LE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_INTERVAL_1; DROP_VEC]) THEN + ASM_REAL_ARITH_TAC]);; + +let CONNECTED_OPEN_VECTOR_POLYNOMIAL_CONNECTED = prove + (`!s:real^N->bool. + open s /\ connected s + ==> !x y. x IN s /\ y IN s + ==> ?g. vector_polynomial_function g /\ + path_image g SUBSET s /\ + pathstart g = x /\ + pathfinish g = y`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `path_connected(s:real^N->bool)` MP_TAC THENL + [ASM_SIMP_TAC[CONNECTED_OPEN_PATH_CONNECTED]; + REWRITE_TAC[path_connected]] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^1->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?e. &0 < e /\ !x. x IN path_image p ==> ball(x:real^N,e) SUBSET s` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `s = (:real^N)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THENL + [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + EXISTS_TAC `setdist(path_image p,(:real^N) DIFF s)` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_COMPACT_CLOSED; + COMPACT_PATH_IMAGE; GSYM OPEN_CLOSED] THEN + ASM_SIMP_TAC[PATH_IMAGE_NONEMPTY] THEN ASM SET_TAC[]; + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `w:real^N` THEN REWRITE_TAC[IN_BALL; GSYM REAL_NOT_LE] THEN + MATCH_MP_TAC(SET_RULE + `(w IN (UNIV DIFF s) ==> p) ==> (~p ==> w IN s)`) THEN + ASM_SIMP_TAC[SETDIST_LE_DIST]]; + MP_TAC(ISPECL [`p:real^1->real^N`; `e:real`] + PATH_APPROX_VECTOR_POLYNOMIAL_FUNCTION) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `q:real^1->real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[path_image; FORALL_IN_IMAGE; SUBSET] THEN RULE_ASSUM_TAC + (REWRITE_RULE[SUBSET; path_image; FORALL_IN_IMAGE;IN_BALL; dist]) THEN + ASM_MESON_TAC[NORM_SUB]]);; + +(* ------------------------------------------------------------------------- *) +(* Lipschitz property for real and vector polynomials. *) +(* ------------------------------------------------------------------------- *) + +let LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION = prove + (`!f:real^N->real s. + real_polynomial_function f /\ bounded s + ==> ?B. &0 < B /\ + !x y. x IN s /\ y IN s ==> abs(f x - f y) <= B * norm(x - y)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `bounded(s:real^N->bool)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + MATCH_MP_TAC real_polynomial_function_INDUCT THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + ASM_SIMP_TAC[REAL_MUL_LID; GSYM VECTOR_SUB_COMPONENT; COMPONENT_LE_NORM]; + GEN_TAC THEN EXISTS_TAC `&1` THEN + SIMP_TAC[REAL_LT_01; REAL_SUB_REFL; REAL_ABS_NUM; REAL_MUL_LID; + NORM_POS_LE]; + ALL_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`f:real^N->real`; `g:real^N->real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC)) + THENL + [EXISTS_TAC `B1 + B2:real` THEN ASM_SIMP_TAC[REAL_LT_ADD] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `abs(f - f') <= B1 * n /\ abs(g - g') <= B2 * n + ==> abs((f + g) - (f' + g')) <= (B1 + B2) * n`) THEN + ASM_SIMP_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B1 * (abs(g(a:real^N)) + B2 * &2 * B) + + B2 * (abs(f a) + B1 * &2 * B)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_ADD THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `&0 < x ==> &0 < abs a + x`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `abs((f - f') * g) <= a * n /\ abs((g - g') * f') <= b * n + ==> abs(f * g - f' * g') <= (a + b) * n`) THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = (a * c) * b`] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC(REAL_ARITH + `abs(g x - g a) <= C * norm(x - a) /\ + C * norm(x - a:real^N) <= C * B ==> abs(g x) <= abs(g a) + C * B`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN MATCH_MP_TAC(NORM_ARITH + `norm x <= B /\ norm a <= B ==> norm(x - a:real^N) <= &2 * B`) THEN + ASM_SIMP_TAC[]]]);; + +let LIPSCHITZ_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!f:real^M->real^N s. + vector_polynomial_function f /\ bounded s + ==> ?B. &0 < B /\ + !x y. x IN s /\ y IN s ==> norm(f x - f y) <= B * norm(x - y)`, + REWRITE_TAC[vector_polynomial_function] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?b. !i. 1 <= i /\ i <= dimindex(:N) + ==> &0 < (b:real^N)$i /\ + !x y. x IN s /\ y IN s + ==> abs((f:real^M->real^N) x$i - f y$i) <= + b$i * norm(x - y)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION THEN + ASM_SIMP_TAC[LIPSCHITZ_REAL_POLYNOMIAL_FUNCTION]; + EXISTS_TAC `&1 + sum(1..dimindex(:N)) (\i. (b:real^N)$i)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < &1 + x`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; GSYM SUM_RMUL; REAL_MUL_LID] THEN + MATCH_MP_TAC(NORM_ARITH `x <= y ==> x <= norm(a:real^N) + y`) THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT]]]);; + +(* ------------------------------------------------------------------------- *) +(* Differentiability of real and vector polynomial functions. *) +(* ------------------------------------------------------------------------- *) + +let DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT = prove + (`!f:real^N->real a. + real_polynomial_function f ==> (lift o f) differentiable (at a)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC real_polynomial_function_INDUCT THEN + REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_CMUL] THEN + REWRITE_TAC[DIFFERENTIABLE_LIFT_COMPONENT; DIFFERENTIABLE_CONST] THEN + SIMP_TAC[DIFFERENTIABLE_ADD] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_MUL_AT THEN + ASM_REWRITE_TAC[o_DEF]);; + +let DIFFERENTIABLE_ON_REAL_POLYNOMIAL_FUNCTION = prove + (`!f:real^N->real s. + real_polynomial_function f ==> (lift o f) differentiable_on s`, + SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; + DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT]);; + +let DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!f:real^M->real^N a. + vector_polynomial_function f ==> f differentiable (at a)`, + REWRITE_TAC[vector_polynomial_function] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[DIFFERENTIABLE_COMPONENTWISE_AT] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC DIFFERENTIABLE_REAL_POLYNOMIAL_FUNCTION_AT THEN + ASM_SIMP_TAC[]);; + +let DIFFERENTIABLE_ON_VECTOR_POLYNOMIAL_FUNCTION = prove + (`!f:real^M->real^N s. + vector_polynomial_function f ==> f differentiable_on s`, + SIMP_TAC[DIFFERENTIABLE_AT_IMP_DIFFERENTIABLE_ON; + DIFFERENTIABLE_VECTOR_POLYNOMIAL_FUNCTION]);; + +(* ------------------------------------------------------------------------- *) +(* Non-trivial algebraic variety has empty interior. *) +(* ------------------------------------------------------------------------- *) + +let NOWHERE_DENSE_ALGEBRAIC_VARIETY = prove + (`!f c. real_polynomial_function f /\ ~(!x. f x = c) + ==> interior {x:real^N | f(x) = c} = {}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[IN_INTERIOR] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?a n. !t. f(x + t % (y - x):real^N) - c = sum(0..n) (\i. a i * t pow i)` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[FORALL_DROP; + GSYM(REWRITE_RULE[FUN_EQ_THM] REAL_POLYNOMIAL_FUNCTION_1)] THEN + REWRITE_TAC[real_sub] THEN + MATCH_MP_TAC(el 2 (CONJUNCTS real_polynomial_function_RULES)) THEN + REWRITE_TAC[real_polynomial_function_RULES] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_VECTOR_POLYNOMIAL_FUNCTION_o THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_ADD THEN + REWRITE_TAC[VECTOR_POLYNOMIAL_FUNCTION_CONST] THEN + MATCH_MP_TAC VECTOR_POLYNOMIAL_FUNCTION_MUL THEN + SIMP_TAC[o_DEF; LIFT_DROP; VECTOR_POLYNOMIAL_FUNCTION_SUB; + VECTOR_POLYNOMIAL_FUNCTION_ID; VECTOR_POLYNOMIAL_FUNCTION_CONST]; + FIRST_X_ASSUM(MP_TAC o GEN `t:real` o SPEC + `x + t % (y - x):real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_BALL; IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN + SIMP_TAC[SET_RULE `(!x. P x ==> Q x) <=> {x | P x} SUBSET {x | Q x}`] THEN + MATCH_MP_TAC(MESON[FINITE_SUBSET; INFINITE] + `FINITE t /\ INFINITE s ==> ~(s SUBSET t)`) THEN + REWRITE_TAC[REAL_POLYFUN_FINITE_ROOTS] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[NOT_EXISTS_THM; TAUT `~(p /\ ~q) <=> p ==> q`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_MUL_LZERO; SUM_0] THEN + ASM_REWRITE_TAC[REAL_SUB_0; VECTOR_ARITH `x + &1 % (y - x):real^N = y`]; + ASM_CASES_TAC `y:real^N = x` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_SUB_REFL; NORM_0] THEN + REWRITE_TAC[UNIV_GSPEC; real_INFINITE]; + ASM_SIMP_TAC[NORM_MUL; GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; + VECTOR_SUB_EQ; GSYM NORM_LIFT] THEN + MATCH_MP_TAC INFINITE_SUPERSET THEN EXISTS_TAC + `IMAGE drop (ball(vec 0:real^1,e / norm(y - x:real^N)))` THEN + CONJ_TAC THENL + [MP_TAC(ISPEC `drop` INFINITE_IMAGE_INJ) THEN + SIMP_TAC[DROP_EQ] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[INFINITE; FINITE_BALL; REAL_NOT_LE] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL_0; + IN_ELIM_THM; LIFT_DROP]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Bernoulli polynomials, defined recursively. We don't explicitly introduce *) +(* a definition for Bernoulli numbers, but use "bernoulli n (&0)" for that. *) +(* ------------------------------------------------------------------------- *) + +let bernoulli = define + `(!x. bernoulli 0 x = &1) /\ + (!n x. bernoulli (n + 1) x = + x pow (n + 1) - + sum(0..n) (\k. &(binom(n+2,k)) * bernoulli k x) / (&n + &2))`;; + +let BERNOULLI_CONV = + let btm = `bernoulli` in + let rec bernoullis n = + if n < 0 then [] else + if n = 0 then [CONJUNCT1 bernoulli] else + let ths = bernoullis (n - 1) in + let th1 = SPEC(mk_small_numeral (n - 1)) (CONJUNCT2 bernoulli) in + let th2 = + CONV_RULE(BINDER_CONV (COMB2_CONV (RAND_CONV(LAND_CONV NUM_ADD_CONV)) + (RAND_CONV(LAND_CONV EXPAND_SUM_CONV) THENC + NUM_REDUCE_CONV THENC + ONCE_DEPTH_CONV NUM_BINOM_CONV THENC + REWRITE_CONV ths THENC + REAL_POLY_CONV))) th1 in + th2::ths in + fun tm -> match tm with + Comb(Comb(b,n),x) when b = btm -> + let th = hd(bernoullis(dest_small_numeral n)) in + (REWR_CONV th THENC REAL_POLY_CONV) tm + | _ -> failwith "BERNOULLI_CONV";; + +let BERNOULLI,BERNOULLI_EXPANSION = (CONJ_PAIR o prove) + (`(!n x. sum(0..n) (\k. &(binom(n,k)) * bernoulli k x) - bernoulli n x = + &n * x pow (n - 1)) /\ + (!n x. bernoulli n x = + sum(0..n) (\k. &(binom(n,k)) * bernoulli k (&0) * x pow (n - k)))`, + let lemma = prove + (`(!n x. sum (0..n) (\k. &(binom(n,k)) * B k x) - B n x = + &n * x pow (n - 1)) <=> + (!x. B 0 x = &1) /\ + (!n x. B (n + 1) x = + x pow (n + 1) - + sum(0..n) (\k. &(binom(n+2,k)) * B k x) / (&n + &2))`, + let cth = MESON[num_CASES] `(!n. P n) <=> P 0 /\ (!n. P(SUC n))` in + GEN_REWRITE_TAC LAND_CONV [cth] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [cth] THEN + SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; BINOM_REFL; BINOM_PENULT; SUC_SUB1] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_LZERO; REAL_SUB_REFL] THEN + SIMP_TAC[ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`; GSYM REAL_OF_NUM_ADD] THEN + BINOP_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + CONV_TAC REAL_FIELD) in + REWRITE_TAC[lemma; bernoulli] THEN + SUBGOAL_THEN + `!n x. sum(0..n) (\k. &(binom(n,k)) * + sum (0..k) + (\l. &(binom(k,l)) * + bernoulli l (&0) * x pow (k - l))) - + sum(0..n) (\k. &(binom(n,k)) * bernoulli k (&0) * x pow (n - k)) = + &n * x pow (n - 1)` + MP_TAC THENL + [REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`\n. bernoulli n (&0)`; `n:num`; `x:real`; `&1`] APPELL_SEQUENCE) THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x + &1 = &1 + x`] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM APPELL_SEQUENCE] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID; GSYM SUM_SUB_NUMSEG] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + REWRITE_TAC[REWRITE_RULE[GSYM lemma] bernoulli] THEN + REWRITE_TAC[REAL_POW_ZERO; COND_RAND; COND_RATOR] THEN + REWRITE_TAC[ARITH_RULE `i - 1 = 0 <=> i = 0 \/ i = 1`] THEN + REWRITE_TAC[MESON[] + `(if p \/ q then x else y) = if q then x else if p then x else y`] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; COND_ID; SUM_DELTA] THEN + REWRITE_TAC[IN_NUMSEG; LE_0; BINOM_1] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[LE_1] THEN REAL_ARITH_TAC; + REWRITE_TAC[lemma] THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN MATCH_MP_TAC num_INDUCTION THEN + ASM_SIMP_TAC[ADD1; bernoulli; + ARITH_RULE `m < n + 1 <=> m <= n`]]);; + +let BERNOULLI_ALT = prove + (`!n x. sum(0..n) (\k. &(binom(n+1,k)) * bernoulli k x) = + (&n + &1) * x pow n`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`SUC n`; `x:real`] BERNOULLI) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; SUC_SUB1; BINOM_REFL] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC);; + +let BERNOULLI_ADD = prove + (`!n x y. bernoulli n (x + y) = + sum(0..n) (\k. &(binom(n,k)) * bernoulli k x * y pow (n - k))`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BERNOULLI_EXPANSION] THEN + REWRITE_TAC[APPELL_SEQUENCE]);; + +let bernoulli_number = prove + (`bernoulli 0 (&0) = &1 /\ + (!n. bernoulli (n + 1) (&0) = + --sum(0..n) (\k. &(binom(n+2,k)) * bernoulli k (&0)) / (&n + &2))`, + REWRITE_TAC[bernoulli; REAL_POW_ADD] THEN REAL_ARITH_TAC);; + +let BERNOULLI_NUMBER = prove + (`!n. sum (0..n) (\k. &(binom (n,k)) * bernoulli k (&0)) - bernoulli n (&0) = + if n = 1 then &1 else &0`, + REWRITE_TAC[BERNOULLI] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[ARITH; REAL_MUL_LZERO] THEN + MATCH_MP_TAC num_INDUCTION THEN REWRITE_TAC[SUC_SUB1] THEN + REWRITE_TAC[ARITH_RULE `SUC n = 1 <=> n = 0`] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[real_pow; REAL_MUL_LID] THEN + REWRITE_TAC[NOT_SUC; REAL_MUL_LZERO; REAL_MUL_RZERO]);; + +let BERNOULLI_NUMBER_ALT = prove + (`!n. sum(0..n) (\k. &(binom(n+1,k)) * bernoulli k (&0)) = + if n = 0 then &1 else &0`, + REWRITE_TAC[BERNOULLI_ALT] THEN INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_MUL_RZERO; NOT_SUC] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_RID]);; + +let BERNOULLI_SUB_ADD1 = prove + (`!n x. bernoulli n (x + &1) - bernoulli n x = &n * x pow (n - 1)`, + REWRITE_TAC[BERNOULLI_ADD; REAL_POW_ONE; REAL_MUL_RID] THEN + REWRITE_TAC[BERNOULLI]);; + +let BERNOULLI_1 = prove + (`!n. bernoulli n (&1) = + if n = 1 then bernoulli n (&0) + &1 else bernoulli n (&0)`, + GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_ADD_LID] THEN + COND_CASES_TAC THENL + [REWRITE_TAC[REAL_ARITH `x = y + &1 <=> x - y = &1`]; + ONCE_REWRITE_TAC[GSYM REAL_SUB_0]] THEN + REWRITE_TAC[BERNOULLI_SUB_ADD1; REAL_POW_ZERO] THEN + ASM_REWRITE_TAC[SUB_REFL; REAL_MUL_RID] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let SUM_OF_POWERS = prove + (`!m n. sum(0..n) (\k. &k pow m) = + (bernoulli (m + 1) (&n + &1) - bernoulli (m + 1) (&0)) / (&m + &1)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV o RAND_CONV) + [GSYM SUC_SUB1] THEN + REWRITE_TAC[REAL_FIELD `x = y / (&m + &1) <=> (&m + &1) * x = y`] THEN + REWRITE_TAC[GSYM SUM_LMUL; REAL_OF_NUM_SUC; GSYM BERNOULLI_SUB_ADD1] THEN + REWRITE_TAC[ADD1; SUM_DIFFS_ALT; LE_0]);; + +let HAS_REAL_DERIVATIVE_BERNOULLI = prove + (`!n x. ((bernoulli n) has_real_derivative (&n * bernoulli (n - 1) x)) + (atreal x)`, + INDUCT_TAC THEN GEN_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + ONCE_REWRITE_TAC[BERNOULLI_EXPANSION] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; SUB_REFL; CONJUNCT1 real_pow] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_CONST; REAL_MUL_LZERO; LE_0] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_CONST; SUC_SUB1; GSYM SUM_LMUL] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUB; ARITH_RULE + `k <= n ==> ~(k = n + 1) /\ (n + 1) - k - 1 = n - k /\ k <= n + 1`] THEN + UNDISCH_TAC `k:num <= n` THEN REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + CONV_TAC REAL_FIELD);; + +add_real_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_REAL_DERIVATIVE_CHAIN_UNIV + (SPEC `n:num` HAS_REAL_DERIVATIVE_BERNOULLI))));; + +let REAL_DIFFERENTIABLE_ON_BERNOULLI = prove + (`!n s. (bernoulli n) real_differentiable_on s`, + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; real_differentiable] THEN + MESON_TAC[HAS_REAL_DERIVATIVE_BERNOULLI; + HAS_REAL_DERIVATIVE_ATREAL_WITHIN]);; + +let REAL_CONTINUOUS_ON_BERNOULLI = prove + (`!n s. (bernoulli n) real_continuous_on s`, + MESON_TAC[REAL_DIFFERENTIABLE_ON_BERNOULLI; + REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON]);; + +let HAS_REAL_INTEGRAL_BERNOULLI = prove + (`!n. ((bernoulli n) has_real_integral (if n = 0 then &1 else &0)) + (real_interval[&0,&1])`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL + [`\x. bernoulli (n + 1) x / (&n + &1)`; `bernoulli n`; `&0`; `&1`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[REAL_POS] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[ADD_SUB; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[BERNOULLI_1; ARITH_RULE `n + 1 = 1 <=> n = 0`] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_SUB_REFL] THEN + REWRITE_TAC[REAL_ADD_LID; ADD_CLAUSES; REAL_DIV_1; REAL_ADD_SUB]]);; + +let POLYNOMIAL_FUNCTION_BERNOULLI = prove + (`!n. polynomial_function(bernoulli n)`, + GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN + ONCE_REWRITE_TAC[BERNOULLI_EXPANSION] THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_SUM THEN + SIMP_TAC[FINITE_NUMSEG; POLYNOMIAL_FUNCTION_MUL; POLYNOMIAL_FUNCTION_POW; + POLYNOMIAL_FUNCTION_ID; POLYNOMIAL_FUNCTION_CONST]);; + +let BERNOULLI_UNIQUE = prove + (`!p n. polynomial_function p /\ + (!x. p(x + &1) - p(x) = &n * x pow (n - 1)) /\ + (real_integral (real_interval[&0,&1]) p = if n = 0 then &1 else &0) + ==> p = bernoulli n`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + MP_TAC(SPECL [`\x. p x - bernoulli n x`; `p(&0) - bernoulli n (&0)`] + POLYNOMIAL_FUNCTION_FINITE_ROOTS) THEN + ASM_SIMP_TAC[POLYNOMIAL_FUNCTION_SUB; + POLYNOMIAL_FUNCTION_BERNOULLI; ETA_AX] THEN + MATCH_MP_TAC(TAUT `~p /\ (q ==> r) ==> (p <=> ~q) ==> r`) THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM INFINITE] THEN + MATCH_MP_TAC INFINITE_SUPERSET THEN + EXISTS_TAC `IMAGE (&) (:num)` THEN + SIMP_TAC[INFINITE_IMAGE_INJ; REAL_OF_NUM_EQ; num_INFINITE; + SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN + CONV_TAC(BINDER_CONV SYM_CONV) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + ASM_MESON_TAC[BERNOULLI_SUB_ADD1; REAL_ARITH + `p - b:real = p' - b' <=> p' - p = b' - b`]; + DISCH_TAC THEN X_GEN_TAC `x:real` THEN ONCE_ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `\x. p x - bernoulli n x` THEN + EXISTS_TAC `real_interval[&0,&1]` THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `x = x * (&1 - &0)`] THEN + ONCE_ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN REWRITE_TAC[REAL_POS]; + GEN_REWRITE_TAC LAND_CONV + [GSYM(SPEC `if n = 0 then &1 else &0` REAL_SUB_REFL)] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN + REWRITE_TAC[ETA_AX; HAS_REAL_INTEGRAL_BERNOULLI] THEN + ASM_REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION]]]);; + +let BERNOULLI_RAABE_2 = prove + (`!n x. bernoulli n ((x + &1) / &2) + bernoulli n (x / &2) = + &2 / &2 pow n * bernoulli n x`, + GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[bernoulli] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[REAL_LT_POW2; REAL_FIELD + `&0 < p ==> (x = &2 / p * y <=> p / &2 * x = y)`] THEN + GEN_REWRITE_TAC I [GSYM FUN_EQ_THM] THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC BERNOULLI_UNIQUE THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC POLYNOMIAL_FUNCTION_LMUL THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] POLYNOMIAL_FUNCTION_o) THEN + REWRITE_TAC[POLYNOMIAL_FUNCTION_BERNOULLI; real_div] THEN + SIMP_TAC[POLYNOMIAL_FUNCTION_ADD; POLYNOMIAL_FUNCTION_CONST; + POLYNOMIAL_FUNCTION_ID; POLYNOMIAL_FUNCTION_RMUL]; + REWRITE_TAC[REAL_ARITH `((x + &1) + &1) / &2 = x / &2 + &1`] THEN + REWRITE_TAC[REAL_ARITH `a * (x + y) - a * (y + z):real = a * (x - z)`] THEN + REWRITE_TAC[BERNOULLI_SUB_ADD1; REAL_POW_DIV] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `a / b * c * d / e:real = c * (a / b / e) * d`] THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + MATCH_MP_TAC(REAL_RING `b = &1 ==> a * b * c = a * c`) THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; GSYM REAL_INV_MUL] THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> SUC(n - 1) = n`] THEN + REWRITE_TAC[GSYM real_div] THEN MATCH_MP_TAC REAL_DIV_REFL THEN + REWRITE_TAC[REAL_POW_EQ_0] THEN REAL_ARITH_TAC; + SUBGOAL_THEN + `(bernoulli n) real_integrable_on real_interval[&0,&1 / &2] /\ + (bernoulli n) real_integrable_on real_interval[&1 / &2,&1]` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + SIMP_TAC[REAL_CONTINUOUS_ON_POLYNOMIAL_FUNCTION; + POLYNOMIAL_FUNCTION_BERNOULLI]; + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY) o + MATCH_MP REAL_INTEGRABLE_INTEGRAL))] THEN + REWRITE_TAC[REAL_ARITH `m * (x - c):real = m * x + m * --c`] THEN + REWRITE_TAC[IMAGE_AFFINITY_REAL_INTERVAL; IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`inv(&2)`; `inv(&2)`]) + (MP_TAC o SPECL [`inv(&2)`; `&0`])) THEN + REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_ADD) THEN + DISCH_THEN(MP_TAC o SPEC `&2 pow n / &2` o + MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 * x + &1 / &2 = (x + &1) / &2`; + REAL_ARITH `&1 / &2 * x + &0 = x / &2`] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + ASM_REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + REWRITE_TAC[REAL_ARITH `&2 * x + &2 * y = &0 <=> y + x = &0`] THEN + IMP_REWRITE_TAC[REAL_INTEGRAL_COMBINE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN + ASM_MESON_TAC[HAS_REAL_INTEGRAL_BERNOULLI]]);; + +let BERNOULLI_HALF = prove + (`!n. bernoulli n (&1 / &2) = (&2 / &2 pow n - &1) * bernoulli n (&0)`, + GEN_TAC THEN + MP_TAC(ISPECL [`n:num`; `&1`] BERNOULLI_RAABE_2) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `a + b:real = c * a <=> b = (c - &1) * a`] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[BERNOULLI_1] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let BERNOULLI_REFLECT = prove + (`!n x. bernoulli n (&1 - x) = --(&1) pow n * bernoulli n x`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + SUBGOAL_THEN + `!n. sum(0..n) (\k. &(binom(n + 1,k)) * + (bernoulli k (&1 - x) - --(&1) pow k * bernoulli k x)) = + &0` + ASSUME_TAC THENL + [REWRITE_TAC[SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[REAL_SUB_0; BERNOULLI_ALT] THEN + TRANS_TAC EQ_TRANS + `--(&1) pow n * (bernoulli (n + 1) x - bernoulli (n + 1) (x - &1))` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`n + 1`; `x - &1`] BERNOULLI_SUB_ADD1) THEN + REWRITE_TAC[REAL_ARITH `x - a + a:real = x`] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[ADD_SUB; REAL_ARITH `&1 - x = --(&1) * (x - &1)`] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_MUL_AC; GSYM REAL_OF_NUM_ADD]; + MATCH_MP_TAC(REAL_FIELD + `z pow 2 = &1 /\ z * x = y ==> z * y = x`) THEN + REWRITE_TAC[REAL_POW_POW] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_NEG; EVEN_MULT; ARITH; REAL_POW_ONE]; + REWRITE_TAC[GSYM SUM_LMUL]] THEN + MP_TAC(ISPECL [`SUC n`; `x:real`; `--(&1)`] BERNOULLI_ADD) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; BINOM_REFL; SUB_REFL] THEN + REWRITE_TAC[GSYM real_sub; ADD1; REAL_MUL_LID; CONJUNCT1 real_pow] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `--s' = s ==> s = b - (s' + b * &1)`) THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_RING + `--(&1) pow 1 * p = q * r ==> --(b * k * p) = q * b * r * k`) THEN + REWRITE_TAC[GSYM REAL_POW_ADD] THEN REWRITE_TAC[REAL_POW_NEG] THEN + REWRITE_TAC[EVEN_ADD; EVEN_SUB; REAL_POW_ONE; ARITH] THEN + ASM_SIMP_TAC[ARITH_RULE `k <= n ==> ~(n + 1 <= k)`] THEN + REWRITE_TAC[TAUT `~(~p <=> q) <=> (p <=> q)`]]; + MATCH_MP_TAC num_WF THEN MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[bernoulli; CONJUNCT1 real_pow; REAL_MUL_LID] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN + REWRITE_TAC[LT_SUC_LE] THEN DISCH_THEN + (fun th -> FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN ASSUME_TAC th) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0; REAL_ADD_LID] THEN + REWRITE_TAC[GSYM ADD1; BINOM_PENULT; GSYM REAL_OF_NUM_SUC] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_SUB_0] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +let BERNOULLI_1_0 = prove + (`!n. bernoulli n (&1) = --(&1) pow n * bernoulli n (&0)`, + GEN_TAC THEN SUBST1_TAC(REAL_ARITH `&0 = &1 - &1`) THEN + REWRITE_TAC[BERNOULLI_REFLECT; REAL_MUL_ASSOC; GSYM REAL_POW_MUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID]);; + +let BERNOULLI_NUMBER_ZERO = prove + (`!n. ODD n /\ ~(n = 1) ==> bernoulli n (&0) = &0`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` BERNOULLI_1) THEN + MP_TAC(SPEC `n:num` BERNOULLI_1_0) THEN + ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE; GSYM NOT_ODD] THEN + REAL_ARITH_TAC);; + +let BERNOULLI_EVEN_BOUND = prove + (`!n x. EVEN n /\ x IN real_interval[&0,&1] + ==> abs(bernoulli n x) <= abs(bernoulli n (&0))`, + let lemma = prove + (`(!n x. x IN real_interval(&0,&1 / &2) + ==> ~(bernoulli (2 * n + 1) x = &0)) /\ + (!n x y. x IN real_interval(&0,&1 / &2) /\ + y IN real_interval(&0,&1 / &2) /\ + bernoulli (2 * n) x = &0 /\ bernoulli (2 * n) y = &0 + ==> x = y)`, + REWRITE_TAC[AND_FORALL_THM; IN_REAL_INTERVAL] THEN INDUCT_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV BERNOULLI_CONV) THEN REAL_ARITH_TAC; + POP_ASSUM MP_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_WLOG_LT THEN REWRITE_TAC[] THEN + CONJ_TAC THENL [REWRITE_TAC[CONJ_ACI; EQ_SYM_EQ]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. bernoulli (2 * SUC n) x / (&2 * &n + &2)`; + `bernoulli (2 * n + 1)`; `x:real`; `y:real`] + REAL_ROLLE_SIMPLE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_SUC; + ARITH_RULE `2 * SUC n - 1 = 2 * n + 1`] THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[IN_REAL_INTERVAL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC]; + POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN + X_GEN_TAC `x:real` THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. bernoulli (2 * SUC n + 1) x / (&2 * &n + &3)`; + `bernoulli (2 * SUC n)`; `&0`; `x:real`] + REAL_ROLLE_SIMPLE) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_ENTIRE] THEN DISJ1_TAC THEN + MATCH_MP_TAC BERNOULLI_NUMBER_ZERO THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ADD1; ARITH] THEN ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + SIMP_TAC[ADD_SUB; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; ADD1] THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[IN_REAL_INTERVAL; NOT_EXISTS_THM] THEN + X_GEN_TAC `u:real` THEN STRIP_TAC] THEN + MP_TAC(ISPECL + [`\x. bernoulli (2 * SUC n + 1) x / (&2 * &n + &3)`; + `bernoulli (2 * SUC n)`; `x:real`; `&1 / &2`] + REAL_ROLLE_SIMPLE) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[BERNOULLI_HALF] THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ2_TAC THEN + MATCH_MP_TAC BERNOULLI_NUMBER_ZERO THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ADD1; ARITH] THEN ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + SIMP_TAC[ADD_SUB; GSYM REAL_OF_NUM_MUL; + GSYM REAL_OF_NUM_ADD; ADD1] THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[IN_REAL_INTERVAL; NOT_EXISTS_THM] THEN + X_GEN_TAC `v:real` THEN STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real`; `v:real`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]) in + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[bernoulli; REAL_LE_REFL] THEN + MP_TAC(ISPECL [`\x. abs(bernoulli n x)`; `real_interval[&0,&1]`] + REAL_CONTINUOUS_ATTAINS_SUP) THEN + REWRITE_TAC[REAL_COMPACT_INTERVAL; REAL_INTERVAL_NE_EMPTY; REAL_POS] THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ABS THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` MP_TAC)] THEN + ASM_CASES_TAC `z = &0` THEN ASM_SIMP_TAC[] THEN + ASM_CASES_TAC `z = &1` THEN ASM_REWRITE_TAC[BERNOULLI_1_0] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NEG; REAL_POW_ONE; + REAL_ABS_NUM; REAL_MUL_LID] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`bernoulli n`; `&n * bernoulli (n - 1) z`; + `z:real`; `real_interval(&0,&1)`] + REAL_DERIVATIVE_ZERO_MAXMIN) THEN + REWRITE_TAC[REAL_OPEN_REAL_INTERVAL; IN_REAL_INTERVAL] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_BERNOULLI] THEN + ASM_CASES_TAC `&0 <= bernoulli n z` THENL + [DISJ1_TAC; DISJ2_TAC] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ENTIRE; REAL_OF_NUM_EQ] THEN DISCH_TAC THEN + ASM_CASES_TAC `z = &1 / &2` THENL + [MATCH_MP_TAC(REAL_ARITH `!z. x <= z /\ z <= &1 * y ==> x <= y`) THEN + EXISTS_TAC `abs(bernoulli n (&1 / &2))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[BERNOULLI_HALF; REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 ==> abs(x - &1) <= &1`) THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; REAL_LT_POW2] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_POS] THEN + MATCH_MP_TAC(REAL_ARITH `&2 pow 1 <= x ==> &2 <= x`) THEN + MATCH_MP_TAC REAL_POW_MONO THEN REWRITE_TAC[REAL_OF_NUM_LE] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 < z /\ z < &1 / &2 \/ &1 / &2 < z /\ z < &1` + STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`(n - 2) DIV 2`; `z:real`] (CONJUNCT1 lemma)) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL]; + MP_TAC(ISPECL [`(n - 2) DIV 2`; `&1 - z`] (CONJUNCT1 lemma)) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[BERNOULLI_REFLECT]] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + SUBGOAL_THEN `2 * (n - 2) DIV 2 + 1 = n - 1` + (fun th -> ASM_REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN + UNDISCH_TAC `~(2 * m = 0)` THEN SPEC_TAC(`m:num`,`m:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_SUB2] THEN + SIMP_TAC[DIV_MULT; ARITH_EQ] THEN ARITH_TAC);; + +let BERNOULLI_NUMBER_EQ_0 = prove + (`!n. bernoulli n (&0) = &0 <=> ODD n /\ ~(n = 1)`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BERNOULLI_NUMBER_ZERO] THEN + ASM_CASES_TAC `n = 1` THEN + ASM_REWRITE_TAC[BERNOULLI_CONV `bernoulli 1 (&0)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN DISCH_TAC THEN + DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`n:num`; `\k. &(binom(n,n - k)) * bernoulli (n - k) (&0)`] + REAL_POLYFUN_FINITE_ROOTS) THEN + MATCH_MP_TAC(TAUT `q /\ ~p ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL + [EXISTS_TAC `n:num` THEN SIMP_TAC[IN_NUMSEG; LE_0; LE_REFL; SUB_REFL] THEN + REWRITE_TAC[binom; REAL_MUL_RID; bernoulli] THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM INFINITE] THEN MATCH_MP_TAC INFINITE_SUPERSET THEN + EXISTS_TAC `real_interval[&0,&1]` THEN + REWRITE_TAC[real_interval; INFINITE; FINITE_REAL_INTERVAL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `x:real`] BERNOULLI_EVEN_BOUND) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL; + REAL_ARITH `abs x <= abs(&0) <=> x = &0`] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN + GEN_REWRITE_TAC RAND_CONV [BERNOULLI_EXPANSION] THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC `\k:num. n - k`) THEN + SIMP_TAC[IN_NUMSEG; ARITH_RULE `k:num <= n ==> n - (n - k) = k`] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* This is a simple though sub-optimal bound (we can actually get *) +(* |B_{2n+1}(x)| <= (2n + 1) / (2 pi) * |B_{2n}(0)| with more work). *) +(* ------------------------------------------------------------------------- *) + +let BERNOULLI_BOUND = prove + (`!n x. x IN real_interval[&0,&1] + ==> abs(bernoulli n x) + <= max (&n / &2) (&1) * abs(bernoulli (2 * n DIV 2) (&0))`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]); + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ODD_EXISTS])] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THENL + [REWRITE_TAC[ARITH_RULE `(2 * m) DIV 2 = m`] THEN + MATCH_MP_TAC(REAL_ARITH + `&1 * y <= max x (&1) * y /\ a <= y ==> a <= max x (&1) * y`) THEN + SIMP_TAC[REAL_LE_RMUL; REAL_ABS_POS; REAL_ARITH `y <= max x y`] THEN + MATCH_MP_TAC BERNOULLI_EVEN_BOUND THEN ASM_REWRITE_TAC[EVEN_MULT; ARITH]; + POP_ASSUM MP_TAC THEN SPEC_TAC(`x:real`,`x:real`) THEN + MATCH_MP_TAC(MESON[] + `!Q. ((!x. P x /\ Q x ==> R x) ==> (!x. P x ==> R x)) /\ + (!x. P x /\ Q x ==> R x) + ==> !x. P x ==> R x`) THEN + EXISTS_TAC `\x. x IN real_interval[&0,&1 / &2]` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `x <= &1 / &2` THEN ASM_SIMP_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `&1 - x`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[BERNOULLI_REFLECT; REAL_ABS_MUL; REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_MUL_LID; REAL_POW_ONE]; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * m) DIV 2 = m`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[ADD1; REAL_ARITH `(x + &1) + &1 = x + &2`] THEN + ASM_CASES_TAC `m = 0` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + CONV_TAC(ONCE_DEPTH_CONV BERNOULLI_CONV) THEN ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`\x. bernoulli (2 * m + 1) x / &(2 * m + 1)`; + `bernoulli (2 * m)`; `&0`; `x:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[BERNOULLI_NUMBER_ZERO; ODD_ADD; ODD_MULT; ARITH; + ARITH_RULE `2 * m + 1 = 1 <=> m = 0`] THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN REWRITE_TAC[ADD_SUB] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + CONV_TAC REAL_FIELD; + DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_FIELD + `i = b / (&2 * &m + &1) - &0 / (&2 * &m + &1) <=> + b = (&2 * &m + &1) * i`] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[real_max; REAL_ARITH `(x + &1) / &2 <= &1 <=> x <= &1`; + REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + ASM_REWRITE_TAC[ARITH_RULE `2 * m <= 1 <=> m = 0`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ARITH + `abs(&2 * &n + &1) = &2 * &n + &1`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS + `real_integral (real_interval [&0,x]) + (\x. abs(bernoulli (2 * m) (&0)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + SIMP_TAC[REAL_INTEGRABLE_CONST; REAL_INTEGRABLE_CONTINUOUS; + REAL_CONTINUOUS_ON_BERNOULLI] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BERNOULLI_EVEN_BOUND THEN + REWRITE_TAC[EVEN_MULT; ARITH; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN + REWRITE_TAC[REAL_ARITH `a * (x - &0) = x * a`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_REAL_ARITH_TAC]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Absolutely integrable functions remain so modified by Bernolli sawtooth. *) +(* ------------------------------------------------------------------------- *) + +let ABSOLUTELY_INTEGRABLE_ON_MUL_BERNOULLI_FRAC = prove + (`!f:real^1->real^N s n. + f absolutely_integrable_on s + ==> (\x. bernoulli n (frac(drop x)) % f x) + absolutely_integrable_on s`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + DISCH_TAC THEN MP_TAC(ISPECL + [`\x y:real^N. drop(x) % y`; + `\x:real^1. lift(bernoulli n (frac (drop x)))`; + `\x. if x IN s then (f:real^1->real^N) x else vec 0`; `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + ASM_REWRITE_TAC[LIFT_DROP; BILINEAR_DROP_MUL] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[VECTOR_MUL_RZERO] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\x. lift(bernoulli n (frac (drop x)))) = + (lift o bernoulli n o drop) o (lift o frac o drop)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN CONJ_TAC THENL + [MATCH_MP_TAC + CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `IMAGE lift integer` THEN + SIMP_TAC[LEBESGUE_MEASURABLE_UNIV; NEGLIGIBLE_COUNTABLE; + COUNTABLE_IMAGE; COUNTABLE_INTEGER] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[FORALL_LIFT; IN_DIFF; IN_UNIV; LIFT_IN_IMAGE_LIFT] THEN + REWRITE_TAC[IN] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_FRAC]; + MP_TAC(SPECL [`n:num`; `(:real)`] REAL_CONTINUOUS_ON_BERNOULLI) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV]]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV; NORM_LIFT] THEN + SUBGOAL_THEN `real_compact (IMAGE (bernoulli n) (real_interval[&0,&1]))` + MP_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_BERNOULLI; REAL_COMPACT_INTERVAL]; + DISCH_THEN(MP_TAC o MATCH_MP REAL_COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + MESON_TAC[FLOOR_FRAC; REAL_LT_IMP_LE]]]);; + +(* ------------------------------------------------------------------------- *) +(* The Euler-Maclaurin summation formula for real and complex functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_EULER_MACLAURIN = prove + (`!f m n p. + m <= n /\ + (!k x. k <= 2 * p + 1 /\ x IN real_interval[&m,&n] + ==> ((f k) has_real_derivative f (k + 1) x) + (atreal x within real_interval [&m,&n])) + ==> (\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 1) x) + real_integrable_on real_interval[&m,&n] /\ + sum(m..n) (\i. f 0 (&i)) = + real_integral (real_interval [&m,&n]) (f 0) + + (f 0 (&m) + f 0 (&n)) / &2 + + sum (1..p) (\k. bernoulli (2 * k) (&0) / &(FACT(2 * k)) * + (f (2 * k - 1) (&n) - f (2 * k - 1) (&m))) + + real_integral (real_interval [&m,&n]) + (\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 1) x) / + &(FACT(2 * p + 1))`, + let lemma = prove + (`!f k m n. + f real_continuous_on real_interval[&m,&n] /\ m < n + ==> ((\x. bernoulli k (frac x) * f x) has_real_integral + sum(m..n-1) (\j. real_integral (real_interval[&j,&j + &1]) + (\x. bernoulli k (x - &j) * f x))) + (real_interval[&m,&n])`, + REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[CONJUNCT1 LT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; LT_SUC_LE; SUC_SUB1] THEN STRIP_TAC THEN + ASM_CASES_TAC `m:num = n` THENL + [ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN (**** one ***) ALL_TAC; + SUBGOAL_THEN `0 < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES_RIGHT] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_COMBINE THEN EXISTS_TAC `&n` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_ARITH `x <= x + &1`] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LT_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_ARITH `x <= x + &1`; LE_REFL]; + ALL_TAC]] THEN + MATCH_MP_TAC(MESON[REAL_INTEGRAL_SPIKE; HAS_REAL_INTEGRAL_INTEGRAL; + REAL_INTEGRABLE_SPIKE] + `!t. g real_integrable_on s /\ real_negligible t /\ + (!x. x IN s DIFF t ==> f x = g x) + ==> (f has_real_integral (real_integral s g)) s`) THEN + EXISTS_TAC `{&n + &1}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; + REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM FRAC_UNIQUE] THEN + REWRITE_TAC[REAL_ARITH `x - (x - &n) = &n`; INTEGER_CLOSED] THEN + ASM_REAL_ARITH_TAC])) in + let step = prove + (`!f f' k m n. + m < n /\ + (!x. x IN real_interval[&m,&n] + ==> (f has_real_derivative f' x) + (atreal x within real_interval[&m,&n])) /\ + f' real_continuous_on real_interval[&m,&n] + ==> real_integral (real_interval[&m,&n]) + (\x. bernoulli (k + 1) (frac x) * f' x) = + (bernoulli (k + 1) (&0) * (f(&n) - f(&m)) + + (if k = 0 then sum(m+1..n) (\i. f(&i)) else &0)) - + (&k + &1) * + real_integral (real_interval[&m,&n]) + (\x. bernoulli k (frac x) * f x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `f real_continuous_on real_interval[&m,&n]` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE; + real_differentiable; + REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON]; + ASM_SIMP_TAC[REWRITE_RULE[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] + lemma]] THEN + TRANS_TAC EQ_TRANS + `sum(m..n-1) + (\j. (bernoulli (k + 1) (&0) * (f (&j + &1) - f (&j)) + + (if k = 0 then f (&j + &1) else &0)) - + (&k + &1) * + real_integral (real_interval[&j,&j + &1]) + (\x. bernoulli k (x - &j) * f x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[REAL_MUL_SYM] + REAL_INTEGRATION_BY_PARTS_SIMPLE) THEN + MAP_EVERY EXISTS_TAC + [`f:real->real`; `\x. (&k + &1) * bernoulli k (x - &j)`] THEN + REWRITE_TAC[REAL_ADD_SUB; REAL_SUB_REFL; BERNOULLI_1] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `x IN s ==> s SUBSET t ==> x IN t`)); + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] + HAS_REAL_DERIVATIVE_WITHIN_SUBSET)] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; + REAL_DIFF_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD; ADD_SUB] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[ARITH_RULE `k + 1 = 1 <=> k = 0`] THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[REAL_ARITH + `(b + &1) * f1 - b * f0 - ((b * (f1 - f0) + f1) - w):real = w`]; + REWRITE_TAC[REAL_ARITH + `b * f1 - b * f0 - ((b * (f1 - f0) + &0) - w) = w`]] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + REPEAT STRIP_TAC THEN REAL_DIFFERENTIABLE_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC])]; + REWRITE_TAC[SUM_ADD_NUMSEG; SUM_LMUL; SUM_SUB_NUMSEG] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; SUM_DIFFS_ALT] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_ARITH_TAC; + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[SUM_0] THEN + REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET); REAL_OF_NUM_ADD] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC]]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (ARITH_RULE + `m:num <= n ==> m = n \/ m < n`)) + THENL + [ASM_SIMP_TAC[REAL_INTEGRABLE_ON_NULL; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[SUM_SING_NUMSEG; REAL_SUB_REFL; REAL_MUL_LZERO] THEN + SIMP_TAC[REAL_INTEGRAL_NULL; REAL_LE_REFL; REAL_ARITH `(x + x) / &2 = x`; + REAL_MUL_RZERO; SUM_0; real_div; REAL_MUL_LZERO] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[real_integrable_on] THEN + MP_TAC(ISPECL [`f (2 * p + 1):real->real`; `2 * p + 1`; `m:num`; `n:num`] + lemma) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_ON_DIFFERENTIABLE] THEN + REWRITE_TAC[real_differentiable] THEN ASM_MESON_TAC[LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LT_IMP_LE] THEN + SUBGOAL_THEN + `!k:num. k <= 2 * p + 1 + ==> (f k) real_differentiable_on real_interval[&m,&n]` + ASSUME_TAC THENL [ASM_MESON_TAC[real_differentiable_on]; ALL_TAC] THEN + MP_TAC(ISPECL [`(f:num->real->real) 0`; `(f:num->real->real) (0 + 1)`; + `0`; `m:num`; `n:num`] step) THEN + ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; + ARITH_RULE `0 + 1 <= 2 * p + 1`; LE_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[CONJUNCT1 bernoulli] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_MUL_LID; ETA_AX] THEN + REWRITE_TAC[BERNOULLI_CONV `bernoulli 1 (&0)`] THEN + MATCH_MP_TAC(REAL_ARITH + `i' = r ==> i' = (-- &1 / &2 * (n - m) + s) - i + ==> m + s = i + (m + n) / &2 + r`) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + SPEC_TAC(`p:num`,`p:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REAL_ARITH_TAC; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [ARITH_RULE `2 * SUC p + 1 = 2 * p + 3`] THEN + FIRST_X_ASSUM(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[ARITH_RULE `k <= 2 * p + 1 ==> k <= 2 * p + 3`] THEN + DISCH_TAC] THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`(f:num->real->real) (2 * p + 1)`; + `(f:num->real->real) ((2 * p + 1) + 1)`; + `2 * p + 1`; `m:num`; `n:num`] step) THEN + ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; + ARITH_RULE `(2 * p + 1) + 1 <= 2 * p + 3`; + ARITH_RULE `2 * p + 1 <= 2 * p + 3`] THEN + REWRITE_TAC[ADD_EQ_0; ARITH_EQ; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_FIELD + `x = y - ((&2 * &p + &1) + &1) * z <=> z = (y - x) / (&2 * &p + &2)`] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[ARITH_RULE `2 * SUC p - 1 = 2 * p + 1`] THEN + REWRITE_TAC[ARITH_RULE `(2 * p + 1) + 1 = 2 * SUC p`] THEN + REWRITE_TAC[ARITH_RULE `2 * SUC p = SUC(2 * p + 1)`] THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * p + 1) + 1 = SUC(SUC(2 * p + 1))`] THEN + REWRITE_TAC[FACT; GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC(REAL_FIELD + `~(t = &0) /\ + i2 = &0 - (&2 * &p + &3) * i1 + ==> (b * (fn - fm) - i1) / (&2 * &p + &2) / t = + b / (((&2 * &p + &1) + &1) * t) * (fn - fm) + + i2 / ((((&2 * &p + &1) + &1) + &1) * ((&2 * &p + &1) + &1) * t)`) THEN + REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ] THEN + MP_TAC(ISPECL [`(f:num->real->real) (SUC(2 * p + 1))`; + `(f:num->real->real) (SUC(2 * p + 1) + 1)`; + `SUC(2 * p + 1)`; `m:num`; `n:num`] step) THEN + ASM_SIMP_TAC[REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON; NOT_SUC; + ARITH_RULE `SUC(2 * p + 1) + 1 <= 2 * p + 3`; + ARITH_RULE `SUC(2 * p + 1) <= 2 * p + 3`] THEN + REWRITE_TAC[ADD1; GSYM ADD_ASSOC; REAL_OF_NUM_ADD] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_RID; GSYM REAL_OF_NUM_MUL] THEN + DISCH_THEN SUBST1_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN + REWRITE_TAC[BERNOULLI_NUMBER_EQ_0] THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ARITH_TAC);; + +let REAL_EULER_MACLAURIN_ANTIDERIVATIVE = prove + (`!f m n p. + m <= n /\ + (!k x. k <= 2 * p + 2 /\ x IN real_interval[&m,&n] + ==> ((f k) has_real_derivative f (k + 1) x) + (atreal x within real_interval [&m,&n])) + ==> ((\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 2) x) + real_integrable_on real_interval[&m,&n]) /\ + sum(m..n) (\i. f 1 (&i)) = + (f 0 (&n) - f 0 (&m)) + + (f 1 (&m) + f 1 (&n)) / &2 + + sum (1..p) (\k. bernoulli (2 * k) (&0) / &(FACT(2 * k)) * + (f (2 * k) (&n) - f (2 * k) (&m))) + + real_integral (real_interval [&m,&n]) + (\x. bernoulli (2 * p + 1) (frac x) * f (2 * p + 2) x) / + &(FACT(2 * p + 1))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n. (f:num->real->real)(SUC n)`; `m:num`; `n:num`; `p:num`] + REAL_EULER_MACLAURIN) THEN + ASM_SIMP_TAC[ARITH_RULE `k <= 2 * p + 1 ==> SUC k <= 2 * p + 2`; + ARITH_RULE `SUC(k + 1) = SUC k + 1`; + ARITH_RULE `SUC(2 * p) + 1 = 2 * p + 2`] THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_THEN(SUBST1_TAC o CONJUNCT2) THEN + MP_TAC(ISPECL + [`f 0:real->real`; `f (0 + 1):real->real`; `&m`; `&n`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; LE_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * p) + 1 = 2 * p + 2`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + SIMP_TAC[ARITH_RULE `1 <= k ==> SUC(2 * k - 1) = 2 * k`]);; + +let COMPLEX_EULER_MACLAURIN_ANTIDERIVATIVE = prove + (`!f m n p. + m <= n /\ + (!k x. k <= 2 * p + 2 /\ &m <= x /\ x <= &n + ==> ((f k) has_complex_derivative f (k + 1) (Cx x)) (at(Cx x))) + ==> (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * + f (2 * p + 2) (Cx(drop x))) + integrable_on interval[lift(&m),lift(&n)] /\ + vsum(m..n) (\i. f 1 (Cx(&i))) = + (f 0 (Cx(&n)) - f 0 (Cx(&m))) + + (f 1 (Cx(&m)) + f 1 (Cx(&n))) / Cx(&2) + + vsum (1..p) (\k. Cx(bernoulli (2 * k) (&0) / &(FACT(2 * k))) * + (f (2 * k) (Cx(&n)) - f (2 * k) (Cx(&m)))) + + integral (interval[lift(&m),lift(&n)]) + (\x. Cx(bernoulli (2 * p + 1) (frac(drop x))) * + f (2 * p + 2) (Cx(drop x))) / + Cx(&(FACT(2 * p + 1)))`, + let lemma_re,lemma_im = (CONJ_PAIR o prove) + (`((f has_complex_derivative f') (at (Cx x)) + ==> ((Re o f o Cx) has_real_derivative (Re f')) (atreal x)) /\ + ((f has_complex_derivative f') (at (Cx x)) + ==> ((Im o f o Cx) has_real_derivative (Im f')) (atreal x))`, + REPEAT GEN_TAC THEN CONJ_TAC THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; HAS_REAL_DERIVATIVE_ATREAL] THEN + REWRITE_TAC[LIM_AT; REALLIM_ATREAL; o_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx y`) THEN + ASM_REWRITE_TAC[DIST_CX; dist] THEN + REWRITE_TAC[GSYM RE_SUB; GSYM IM_SUB; CX_SUB; + GSYM RE_DIV_CX; GSYM IM_SUB; GSYM IM_DIV_CX] THEN + MESON_TAC[COMPLEX_NORM_GE_RE_IM; REAL_LET_TRANS]) + and ilemma = prove + (`f integrable_on interval[lift a,lift b] + ==> Re(integral (interval[lift a,lift b]) f) = + real_integral (real_interval[a,b]) (\x. Re(f(lift x))) /\ + Im(integral (interval[lift a,lift b]) f) = + real_integral (real_interval[a,b]) (\x. Im(f(lift x)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF; IM_DEF] THEN + ASM_SIMP_TAC[INTEGRAL_COMPONENT] THEN + IMP_REWRITE_TAC[REAL_INTEGRAL] THEN + REWRITE_TAC[o_DEF; IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[o_DEF; IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTEGRABLE_COMPONENTWISE]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[DIMINDEX_2; ARITH]) in + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_EQ] THEN + MAP_EVERY (MP_TAC o C SPEC REAL_EULER_MACLAURIN_ANTIDERIVATIVE) + [`\n:num. (Im o f n o Cx)`; `\n:num. (Re o f n o Cx)`] THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`; `p:num`]) THEN + ASM_SIMP_TAC[lemma_re; lemma_im; HAS_REAL_DERIVATIVE_ATREAL_WITHIN; + o_THM; IN_REAL_INTERVAL] THEN + SIMP_TAC[RE_VSUM; IM_VSUM; FINITE_NUMSEG] THEN + DISCH_THEN(CONJUNCTS_THEN(ASSUME_TAC o CONJUNCT1)) THEN + SIMP_TAC[RE_DIV_CX; IM_DIV_CX; RE_VSUM; IM_VSUM; FINITE_NUMSEG; RE_ADD; + RE_SUB;IM_ADD; IM_SUB; RE_MUL_CX; IM_MUL_CX; RE_CX; IM_CX] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[INTEGRABLE_COMPONENTWISE] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX] THEN + ASM_REWRITE_TAC[REWRITE_RULE[o_DEF] (GSYM REAL_INTEGRABLE_ON); + GSYM IMAGE_LIFT_REAL_INTERVAL]; + SIMP_TAC[ilemma] THEN REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; LIFT_DROP]]);; + +(* ------------------------------------------------------------------------- *) +(* Specific properties of complex measurable functions. *) +(* ------------------------------------------------------------------------- *) + +let MEASURABLE_ON_COMPLEX_MUL = prove + (`!f g:real^N->complex s. + f measurable_on s /\ g measurable_on s + ==> (\x. f x * g x) measurable_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMBINE THEN + ASM_REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let MEASURABLE_ON_COMPLEX_INV = prove + (`!f:real^N->real^2. + f measurable_on (:real^N) /\ negligible {x | f x = Cx(&0)} + ==> (\x. inv(f x)) measurable_on (:real^N)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[measurable_on; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:real^N->bool`; `g:num->real^N->complex`] THEN + STRIP_TAC THEN EXISTS_TAC `k UNION {x:real^N | f x = Cx(&0)}` THEN + ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN + SUBGOAL_THEN + `!n. ?h. h continuous_on (:real^N) /\ + !x. x IN {x | g n x IN (:complex) DIFF ball(Cx(&0),inv(&n + &1))} + ==> (h:real^N->complex) x = inv(g n x)` + + MP_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC TIETZE_UNBOUNDED THEN CONJ_TAC THENL + [REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM CLOSED_IN] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; ETA_AX] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_INV_AT THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_UNIV; IN_DIFF]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [IN_BALL]) THEN + SIMP_TAC[CONTRAPOS_THM; DIST_REFL; REAL_LT_INV_EQ] THEN + REAL_ARITH_TAC]]; + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `h:num->real^N->complex` THEN + REWRITE_TAC[FORALL_AND_THM; IN_ELIM_THM; IN_DIFF; IN_UNION; IN_UNIV] THEN + REWRITE_TAC[IN_BALL; DE_MORGAN_THM; REAL_NOT_LT] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^N` THEN + STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THEN + EXISTS_TAC `\n. inv((g:num->real^N->complex) n x)` THEN + ASM_SIMP_TAC[o_DEF; LIM_COMPLEX_INV] THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + SUBGOAL_THEN `&0 < norm((f:real^N->complex) x)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_NORM_NZ]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `norm((f:real^N->complex) x) / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "*")) THEN + MP_TAC(SPEC `norm((f:real^N->complex) x) / &2` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N1 + N2 + 1` THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[VECTOR_SUB_EQ] THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; DIST_0] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (NORM_ARITH + `dist(g,f) < norm(f) / &2 ==> norm(f) / &2 <= norm g`)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x < y ==> z <= x ==> z <= y`)) THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC]);; + +let MEASURABLE_ON_COMPLEX_DIV = prove + (`!f g:real^N->complex s. + f measurable_on s /\ g measurable_on (:real^N) /\ + negligible {x | g(x) = Cx(&0)} + ==> (\x. f(x) / g(x)) measurable_on s`, + let lemma = prove + (`!f g:real^N->complex. + f measurable_on (:real^N) /\ g measurable_on (:real^N) /\ + negligible {x | g(x) = Cx(&0)} + ==> (\x. f(x) / g(x)) measurable_on (:real^N)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[complex_div] THEN + ASM_SIMP_TAC[MEASURABLE_ON_COMPLEX_MUL; MEASURABLE_ON_COMPLEX_INV]) in + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[IN_UNIV; ETA_AX] THEN DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; complex_div; COMPLEX_VEC_0] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Measurable real->real functions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("real_measurable_on",(12,"right"));; + +let real_measurable_on = new_definition + `f real_measurable_on s <=> + (lift o f o drop) measurable_on (IMAGE lift s)`;; + +let real_lebesgue_measurable = new_definition + `real_lebesgue_measurable s <=> + (\x. if x IN s then &1 else &0) real_measurable_on (:real)`;; + +let REAL_MEASURABLE_ON_UNIV = prove + (`(\x. if x IN s then f(x) else &0) real_measurable_on (:real) <=> + f real_measurable_on s`, + REWRITE_TAC[real_measurable_on; o_DEF; IMAGE_LIFT_UNIV] THEN + SIMP_TAC[COND_RAND; LIFT_NUM; MEASURABLE_ON_UNIV; GSYM IN_IMAGE_LIFT_DROP]);; + +let REAL_LEBESGUE_MEASURABLE = prove + (`!s. real_lebesgue_measurable s <=> lebesgue_measurable (IMAGE lift s)`, + REWRITE_TAC[real_lebesgue_measurable; lebesgue_measurable; COND_RAND; + COND_RAND; real_measurable_on; indicator; IMAGE_LIFT_UNIV; o_DEF] THEN + REWRITE_TAC[LIFT_NUM; IN_IMAGE_LIFT_DROP]);; + +let REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f g s. + f real_measurable_on s /\ + g real_integrable_on s /\ + (!x. x IN s ==> abs(f x) <= g x) + ==> f real_integrable_on s`, + REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `lift o g o drop` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);; + +let REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE = prove + (`!f g s k. + f real_measurable_on s /\ g real_integrable_on s /\ real_negligible k /\ + (!x. x IN s DIFF k ==> abs(f x) <= g x) + ==> f real_integrable_on s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC + `\x. if x IN k then abs(f x) else (g:real->real) x` THEN + ASM_SIMP_TAC[COND_RAND; IN_DIFF; LIFT_DROP; REAL_LE_REFL; COND_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC [`g:real->real`; `k:real->bool`] THEN + ASM_SIMP_TAC[IN_DIFF]);; + +let REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE = prove + (`!f g s. + f real_measurable_on s /\ + g real_integrable_on s /\ + (!x. x IN s ==> abs(f x) <= g x) + ==> f absolutely_real_integrable_on s`, + REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; + ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `lift o g o drop` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; NORM_LIFT]);; + +let INTEGRABLE_SUBINTERVALS_IMP_REAL_MEASURABLE = prove + (`!f. (!a b. f real_integrable_on real_interval[a,b]) + ==> f real_measurable_on (:real)`, + REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_SUBINTERVALS_IMP_MEASURABLE THEN + ASM_REWRITE_TAC[FORALL_LIFT]);; + +let INTEGRABLE_IMP_REAL_MEASURABLE = prove + (`!f:real->real s. + f real_integrable_on s ==> f real_measurable_on s`, + REWRITE_TAC[real_measurable_on; REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[INTEGRABLE_IMP_MEASURABLE]);; + +let ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE = prove + (`!f s. f absolutely_real_integrable_on s <=> + f real_measurable_on s /\ (\x. abs(f x)) real_integrable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[absolutely_real_integrable_on] THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (b /\ c ==> a) ==> (a /\ c <=> b /\ c)`) THEN + REWRITE_TAC[INTEGRABLE_IMP_REAL_MEASURABLE] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. abs((f:real->real) x)` THEN ASM_REWRITE_TAC[REAL_LE_REFL]);; + +let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS = prove + (`!f g. f real_measurable_on (:real) /\ g real_continuous_on (:real) + ==> (g o f) real_measurable_on (:real)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; real_measurable_on] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0 = prove + (`!f:real->real g:real->real s. + f real_measurable_on s /\ g real_continuous_on (:real) /\ g(&0) = &0 + ==> (g o f) real_measurable_on s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + DISCH_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_DEF] THEN ASM_MESON_TAC[]);; + +let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL = prove + (`!f:real->real g:real->real a b. + f real_measurable_on (:real) /\ + (!x. f(x) IN real_interval(a,b)) /\ + g real_continuous_on real_interval(a,b) + ==> (g o f) real_measurable_on (:real)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `lift a`; `lift b`] + MEASURABLE_ON_COMPOSE_CONTINUOUS_OPEN_INTERVAL) THEN + REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP] THEN ASM SET_TAC[]);; + +let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET = prove + (`!f:real->real g:real->real s. + real_closed s /\ + f real_measurable_on (:real) /\ + (!x. f(x) IN s) /\ + g real_continuous_on s + ==> (g o f) real_measurable_on (:real)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; `IMAGE lift s`] + MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET) THEN + REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON; REAL_CLOSED] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[INTERVAL_REAL_INTERVAL; LIFT_DROP] THEN ASM SET_TAC[]);; + +let REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0 = prove + (`!f:real->real g:real->real s t. + real_closed s /\ + f real_measurable_on t /\ + (!x. f(x) IN s) /\ + g real_continuous_on s /\ + &0 IN s /\ g(&0) = &0 + ==> (g o f) real_measurable_on t`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift o g o drop`; + `IMAGE lift s`; `IMAGE lift t`] + MEASURABLE_ON_COMPOSE_CONTINUOUS_CLOSED_SET_0) THEN + REWRITE_TAC[real_measurable_on; REAL_CONTINUOUS_ON; REAL_CLOSED] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM FORALL_DROP] THEN + ASM_SIMP_TAC[FUN_IN_IMAGE; LIFT_DROP; GSYM LIFT_NUM]);; + +let CONTINUOUS_IMP_REAL_MEASURABLE_ON = prove + (`!f. f real_continuous_on (:real) ==> f real_measurable_on (:real)`, + REWRITE_TAC[REAL_CONTINUOUS_ON; real_measurable_on] THEN + REWRITE_TAC[CONTINUOUS_IMP_MEASURABLE_ON; IMAGE_LIFT_UNIV]);; + +let REAL_MEASURABLE_ON_CONST = prove + (`!k:real. (\x. k) real_measurable_on (:real)`, + SIMP_TAC[real_measurable_on; o_DEF; MEASURABLE_ON_CONST; IMAGE_LIFT_UNIV]);; + +let REAL_MEASURABLE_ON_0 = prove + (`!s. (\x. &0) real_measurable_on s`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[REAL_MEASURABLE_ON_CONST; COND_ID]);; + +let REAL_MEASURABLE_ON_LMUL = prove + (`!c f s. f real_measurable_on s ==> (\x. c * f x) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP MEASURABLE_ON_CMUL) THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_RMUL = prove + (`!c f s. f real_measurable_on s ==> (\x. f x * c) real_measurable_on s`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MEASURABLE_ON_LMUL]);; + +let REAL_MEASURABLE_ON_NEG = prove + (`!f s. f real_measurable_on s ==> (\x. --(f x)) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NEG) THEN + REWRITE_TAC[o_DEF; LIFT_NEG; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_NEG_EQ = prove + (`!f s. (\x. --(f x)) real_measurable_on s <=> f real_measurable_on s`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_NEG) THEN + REWRITE_TAC[REAL_NEG_NEG; ETA_AX]);; + +let REAL_MEASURABLE_ON_ABS = prove + (`!f s. f real_measurable_on s ==> (\x. abs(f x)) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_NORM) THEN + REWRITE_TAC[o_DEF; NORM_LIFT]);; + +let REAL_MEASURABLE_ON_ADD = prove + (`!f g s. f real_measurable_on s /\ g real_measurable_on s + ==> (\x. f x + g x) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_ADD) THEN + REWRITE_TAC[o_DEF; LIFT_ADD; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_SUB = prove + (`!f g s. + f real_measurable_on s /\ g real_measurable_on s + ==> (\x. f x - g x) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_SUB) THEN + REWRITE_TAC[o_DEF; LIFT_SUB; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_MAX = prove + (`!f g s. + f real_measurable_on s /\ g real_measurable_on s + ==> (\x. max (f x) (g x)) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; o_THM; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN + REWRITE_TAC[GSYM drop; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_MIN = prove + (`!f g s. + f real_measurable_on s /\ g real_measurable_on s + ==> (\x. min (f x) (g x)) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_MIN) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[FUN_EQ_THM; o_THM; CART_EQ; LAMBDA_BETA; DIMINDEX_1; FORALL_1] THEN + REWRITE_TAC[GSYM drop; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_MUL = prove + (`!f g s. + f real_measurable_on s /\ g real_measurable_on s + ==> (\x. f x * g x) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_DROP_MUL) THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);; + +let REAL_MEASURABLE_ON_SPIKE_SET = prove + (`!f:real->real s t. + real_negligible (s DIFF t UNION t DIFF s) + ==> f real_measurable_on s + ==> f real_measurable_on t`, + REWRITE_TAC[real_measurable_on; real_negligible] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_SPIKE_SET THEN POP_ASSUM MP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] NEGLIGIBLE_SUBSET) THEN + SET_TAC[]);; + +let REAL_MEASURABLE_ON_RESTRICT = prove + (`!f s. f real_measurable_on (:real) /\ + real_lebesgue_measurable s + ==> (\x. if x IN s then f(x) else &0) real_measurable_on (:real)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; + IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[o_DEF; COND_RAND; LIFT_NUM; GSYM IN_IMAGE_LIFT_DROP] THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURABLE_ON_RESTRICT) THEN + REWRITE_TAC[]);; + +let REAL_MEASURABLE_ON_LIMIT = prove + (`!f g s k. + (!n. (f n) real_measurable_on s) /\ + real_negligible k /\ + (!x. x IN s DIFF k ==> ((\n. f n x) ---> g x) sequentially) + ==> g real_measurable_on s`, + REWRITE_TAC[real_measurable_on; real_negligible; TENDSTO_REAL] THEN + REWRITE_TAC[o_DEF] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN MAP_EVERY EXISTS_TAC + [`\n:num. lift o f n o drop`; `IMAGE lift k`] THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[LIFT_DROP; SET_RULE `(!x. drop(lift x) = x) + ==> IMAGE lift s DIFF IMAGE lift t = IMAGE lift (s DIFF t)`] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]);; + +let ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT = prove + (`!f g s. f real_measurable_on s /\ real_bounded (IMAGE f s) /\ + g absolutely_real_integrable_on s + ==> (\x. f x * g x) absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_BOUNDED_POS]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN MATCH_MP_TAC + REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x. B * abs((g:real->real) x)` THEN + ASM_SIMP_TAC[REAL_MEASURABLE_ON_MUL; INTEGRABLE_IMP_REAL_MEASURABLE; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; REAL_INTEGRABLE_LMUL; + ABSOLUTELY_REAL_INTEGRABLE_ABS] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LE_RMUL; REAL_ABS_POS]);; + +let REAL_COMPLEX_MEASURABLE_ON = prove + (`!f s. f real_measurable_on s <=> + (Cx o f o drop) measurable_on (IMAGE lift s)`, + ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV; + GSYM MEASURABLE_ON_UNIV] THEN + ONCE_REWRITE_TAC[MEASURABLE_ON_COMPONENTWISE] THEN + REWRITE_TAC[FORALL_2; DIMINDEX_2; GSYM RE_DEF; GSYM IM_DEF] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[o_DEF; IN_IMAGE_LIFT_DROP] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; LIFT_NUM; COMPLEX_VEC_0] THEN + REWRITE_TAC[RE_CX; IM_CX; COND_ID; MEASURABLE_ON_CONST; LIFT_NUM]);; + +let REAL_MEASURABLE_ON_INV = prove + (`!f. f real_measurable_on (:real) /\ real_negligible {x | f x = &0} + ==> (\x. inv(f x)) real_measurable_on (:real)`, + GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_MEASURABLE_ON] THEN + REWRITE_TAC[o_DEF; CX_INV; IMAGE_LIFT_UNIV] THEN STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_INV THEN ASM_REWRITE_TAC[CX_INJ] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_negligible]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_DIV = prove + (`!f g. f real_measurable_on s /\ g real_measurable_on (:real) /\ + real_negligible {x | g(x) = &0} + ==> (\x. f(x) / g(x)) real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_COMPLEX_MEASURABLE_ON] THEN + REWRITE_TAC[o_DEF; CX_DIV; IMAGE_LIFT_UNIV] THEN STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_DIV THEN ASM_REWRITE_TAC[CX_INJ] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_negligible]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; LIFT_DROP] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_RPOW = prove + (`!f r s. f real_measurable_on s /\ &0 < r + ==> (\x. f x rpow r) real_measurable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. f x rpow r) = (\x. x rpow r) o (f:real->real)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ON_RPOW; RPOW_ZERO; + REAL_LT_IMP_LE; REAL_LT_IMP_NZ]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of real Lebesgue measurable sets. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE = prove + (`!s. real_measurable s ==> real_lebesgue_measurable s`, + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_MEASURABLE_MEASURABLE; + MEASURABLE_IMP_LEBESGUE_MEASURABLE]);; + +let REAL_LEBESGUE_MEASURABLE_EMPTY = prove + (`real_lebesgue_measurable {}`, + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; IMAGE_CLAUSES; + LEBESGUE_MEASURABLE_EMPTY]);; + +let REAL_LEBESGUE_MEASURABLE_UNIV = prove + (`real_lebesgue_measurable (:real)`, + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + LEBESGUE_MEASURABLE_UNIV]);; + +let REAL_LEBESGUE_MEASURABLE_COMPACT = prove + (`!s. real_compact s ==> real_lebesgue_measurable s`, + SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE; + REAL_MEASURABLE_COMPACT]);; + +let REAL_LEBESGUE_MEASURABLE_INTERVAL = prove + (`(!a b. real_lebesgue_measurable(real_interval[a,b])) /\ + (!a b. real_lebesgue_measurable(real_interval(a,b)))`, + SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE; + REAL_MEASURABLE_REAL_INTERVAL]);; + +let REAL_LEBESGUE_MEASURABLE_INTER = prove + (`!s t. real_lebesgue_measurable s /\ real_lebesgue_measurable t + ==> real_lebesgue_measurable(s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_INTER) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_UNION = prove + (`!s t:real->bool. + real_lebesgue_measurable s /\ real_lebesgue_measurable t + ==> real_lebesgue_measurable(s UNION t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN + DISCH_THEN(MP_TAC o MATCH_MP LEBESGUE_MEASURABLE_UNION) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_COMPL = prove + (`!s. real_lebesgue_measurable((:real) DIFF s) <=> + real_lebesgue_measurable s`, + GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN + GEN_REWRITE_TAC (RAND_CONV) [GSYM LEBESGUE_MEASURABLE_COMPL] THEN + AP_TERM_TAC THEN MP_TAC LIFT_DROP THEN SET_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_DIFF = prove + (`!s t:real->bool. + real_lebesgue_measurable s /\ real_lebesgue_measurable t + ==> real_lebesgue_measurable(s DIFF t)`, + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + SIMP_TAC[REAL_LEBESGUE_MEASURABLE_COMPL; REAL_LEBESGUE_MEASURABLE_INTER]);; + +let REAL_LEBESGUE_MEASURABLE_ON_SUBINTERVALS = prove + (`!s. real_lebesgue_measurable s <=> + !a b. real_lebesgue_measurable(s INTER real_interval[a,b])`, + GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN + GEN_REWRITE_TAC LAND_CONV [LEBESGUE_MEASURABLE_ON_SUBINTERVALS] THEN + REWRITE_TAC[FORALL_DROP; GSYM IMAGE_DROP_INTERVAL] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN + MP_TAC LIFT_DROP THEN SET_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_CLOSED = prove + (`!s. real_closed s ==> real_lebesgue_measurable s`, + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_CLOSED; + LEBESGUE_MEASURABLE_CLOSED]);; + +let REAL_LEBESGUE_MEASURABLE_OPEN = prove + (`!s. real_open s ==> real_lebesgue_measurable s`, + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE; REAL_OPEN; + LEBESGUE_MEASURABLE_OPEN]);; + +let REAL_LEBESGUE_MEASURABLE_UNIONS = prove + (`!f. FINITE f /\ (!s. s IN f ==> real_lebesgue_measurable s) + ==> real_lebesgue_measurable (UNIONS f)`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[UNIONS_0; UNIONS_INSERT; REAL_LEBESGUE_MEASURABLE_EMPTY] THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_UNION THEN ASM_SIMP_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT = prove + (`!s:num->real->bool. + (!n. real_lebesgue_measurable(s n)) + ==> real_lebesgue_measurable(UNIONS {s n | n IN (:num)})`, + GEN_TAC THEN REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN DISCH_THEN(MP_TAC o + MATCH_MP LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT) THEN + REWRITE_TAC[IMAGE_UNIONS; SIMPLE_IMAGE] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS = prove + (`!f:(real->bool)->bool. + COUNTABLE f /\ (!s. s IN f ==> real_lebesgue_measurable s) + ==> real_lebesgue_measurable (UNIONS f)`, + GEN_TAC THEN ASM_CASES_TAC `f:(real->bool)->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0; REAL_LEBESGUE_MEASURABLE_EMPTY] THEN STRIP_TAC THEN + MP_TAC(ISPEC `f:(real->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS_EXPLICIT THEN + GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);; + +let REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS = prove + (`!f:(real->bool)->bool. + COUNTABLE f /\ (!s. s IN f ==> real_lebesgue_measurable s) + ==> real_lebesgue_measurable (INTERS f)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INTERS_UNIONS; REAL_LEBESGUE_MEASURABLE_COMPL] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; + REAL_LEBESGUE_MEASURABLE_COMPL]);; + +let REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS_EXPLICIT = prove + (`!s:num->real->bool. + (!n. real_lebesgue_measurable(s n)) + ==> real_lebesgue_measurable(INTERS {s n | n IN (:num)})`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]);; + +let REAL_LEBESGUE_MEASURABLE_INTERS = prove + (`!f:(real->bool)->bool. + FINITE f /\ (!s. s IN f ==> real_lebesgue_measurable s) + ==> real_lebesgue_measurable (INTERS f)`, + SIMP_TAC[REAL_LEBESGUE_MEASURABLE_COUNTABLE_INTERS; FINITE_IMP_COUNTABLE]);; + +let REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE = prove + (`!s. real_bounded s ==> (real_lebesgue_measurable s <=> real_measurable s)`, + REWRITE_TAC[REAL_BOUNDED; REAL_LEBESGUE_MEASURABLE; + REAL_MEASURABLE_MEASURABLE] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_IFF_MEASURABLE]);; + +let REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove + (`!f s t. s SUBSET t /\ f real_measurable_on t /\ + real_lebesgue_measurable s + ==> f real_measurable_on s`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_MEASURABLE_ON_RESTRICT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM SET_TAC[]);; + +let REAL_MEASURABLE_ON_MEASURABLE_SUBSET = prove + (`!f s t. s SUBSET t /\ f real_measurable_on t /\ real_measurable s + ==> f real_measurable_on s`, + MESON_TAC[REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET; + REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE]);; + +let REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET = prove + (`!f s. f real_continuous_on s /\ real_closed s ==> f real_measurable_on s`, + REWRITE_TAC[REAL_CONTINUOUS_ON; REAL_CLOSED; real_measurable_on] THEN + REWRITE_TAC[CONTINUOUS_IMP_MEASURABLE_ON_CLOSED_SUBSET]);; + +let REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET = prove + (`!f s m. + f real_continuous_on s DIFF m /\ + real_lebesgue_measurable s /\ + real_negligible m + ==> f real_measurable_on s`, + REWRITE_TAC[real_measurable_on; real_negligible; REAL_LEBESGUE_MEASURABLE; + REAL_CONTINUOUS_ON] THEN + SIMP_TAC[IMAGE_DIFF_INJ; LIFT_EQ] THEN + REWRITE_TAC[CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET]);; + +let REAL_MEASURABLE_ON_CASES = prove + (`!P f g s. + real_lebesgue_measurable {x | P x} /\ + f real_measurable_on s /\ g real_measurable_on s + ==> (\x. if P x then f x else g x) real_measurable_on s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x. (if x IN s then if P x then f x else g x else &0) = + (if x IN {x | P x} then if x IN s then f x else &0 else &0) + + (if x IN (:real) DIFF {x | P x} + then if x IN s then g x else &0 else &0)` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN REWRITE_TAC[IN_UNIV; IN_ELIM_THM; IN_DIFF] THEN + MESON_TAC[REAL_ADD_LID; REAL_ADD_RID]; + MATCH_MP_TAC REAL_MEASURABLE_ON_ADD THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN + ASM_REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_COMPL]]);; + +(* ------------------------------------------------------------------------- *) +(* Various common equivalent forms of function measurability. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT = prove + (`!f. f real_measurable_on (:real) <=> + !a. real_lebesgue_measurable {x | f(x) < a}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LT] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE = prove + (`!f. f real_measurable_on (:real) <=> + !a. real_lebesgue_measurable {x | f(x) <= a}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT = prove + (`!f. f real_measurable_on (:real) <=> + !a. real_lebesgue_measurable {x | f(x) > a}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE = prove + (`!f. f real_measurable_on (:real) <=> + !a. real_lebesgue_measurable {x | f(x) >= a}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE] THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; o_DEF; LIFT_DROP] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL = prove + (`!f. f real_measurable_on (:real) <=> + !a b. real_lebesgue_measurable {x | f(x) IN real_interval(a,b)}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_OPEN_INTERVAL; FORALL_DROP] THEN + GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; o_DEF; GSYM IMAGE_DROP_INTERVAL; LIFT_DROP; + FORALL_DROP; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL = prove + (`!f. f real_measurable_on (:real) <=> + !a b. real_lebesgue_measurable {x | f(x) IN real_interval[a,b]}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_CLOSED_INTERVAL; FORALL_DROP] THEN + GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; o_DEF; GSYM IMAGE_DROP_INTERVAL; LIFT_DROP; + FORALL_DROP; IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_OPEN = prove + (`!f. f real_measurable_on (:real) <=> + !t. real_open t ==> real_lebesgue_measurable {x | f(x) IN t}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_OPEN; REAL_OPEN] THEN + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `t:real->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE lift t`) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE drop t`) THEN + ASM_REWRITE_TAC[IMAGE_LIFT_DROP; GSYM IMAGE_o]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THENL + [CONV_TAC SYM_CONV; ALL_TAC] THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_IMAGE; o_DEF; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_PREIMAGE_CLOSED = prove + (`!f. f real_measurable_on (:real) <=> + !t. real_closed t ==> real_lebesgue_measurable {x | f(x) IN t}`, + REWRITE_TAC[real_measurable_on; REAL_LEBESGUE_MEASURABLE; IMAGE_LIFT_UNIV; + MEASURABLE_ON_PREIMAGE_CLOSED; REAL_CLOSED] THEN + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `t:real->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE lift t`) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `t:real^1->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE drop t`) THEN + ASM_REWRITE_TAC[IMAGE_LIFT_DROP; GSYM IMAGE_o]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THENL + [CONV_TAC SYM_CONV; ALL_TAC] THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_IMAGE; o_DEF; IN_ELIM_THM] THEN MESON_TAC[LIFT_DROP]);; + +let REAL_MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT = prove + (`!f. f real_measurable_on (:real) <=> + ?g. (!n. (g n) real_measurable_on (:real)) /\ + (!n. FINITE(IMAGE (g n) (:real))) /\ + (!x. ((\n. g n x) ---> f x) sequentially)`, + GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN + GEN_REWRITE_TAC LAND_CONV [MEASURABLE_ON_SIMPLE_FUNCTION_LIMIT] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `g:num->real^1->real^1` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n:num. drop o g n o lift` THEN + REWRITE_TAC[TENDSTO_REAL] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; + GEN_TAC THEN REWRITE_TAC[IMAGE_o; IMAGE_LIFT_UNIV] THEN + MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[TENDSTO_REAL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `lift x`) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]]; + DISCH_THEN(X_CHOOSE_THEN `g:num->real->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n:num. lift o g n o drop` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[IMAGE_o; IMAGE_DROP_UNIV] THEN + MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^1` THEN FIRST_X_ASSUM(MP_TAC o SPEC `drop x`) THEN + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP]]]);; + +let REAL_LEBESGUE_MEASURABLE_PREIMAGE_OPEN = prove + (`!f t. f real_measurable_on (:real) /\ real_open t + ==> real_lebesgue_measurable {x | f(x) IN t}`, + SIMP_TAC[REAL_MEASURABLE_ON_PREIMAGE_OPEN]);; + +let REAL_LEBESGUE_MEASURABLE_PREIMAGE_CLOSED = prove + (`!f t. f real_measurable_on (:real) /\ real_closed t + ==> real_lebesgue_measurable {x | f(x) IN t}`, + SIMP_TAC[REAL_MEASURABLE_ON_PREIMAGE_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of measure within a halfspace w.r.t. to the boundary. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_MEASURE_IN_HALFSPACE_LE = prove + (`!(s:real^N->bool) a i. + measurable s /\ 1 <= i /\ i <= dimindex(:N) + ==> (\a. measure(s INTER {x | x$i <= a})) real_continuous atreal a`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS1] THEN + REWRITE_TAC[continuous_atreal; o_THM] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?u v:real^N. abs(measure(s INTER interval[u,v]) - measure s) < e / &2 /\ + ~(interval(u,v) = {}) /\ u$i < a /\ a < v$i` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `e / &2`] MEASURE_LIMIT) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `ball(vec 0:real^N,B)` BOUNDED_SUBSET_CLOSED_INTERVAL) THEN + REWRITE_TAC[BOUNDED_BALL; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `v:real^N`] THEN DISCH_TAC THEN + EXISTS_TAC `(lambda j. min (a - &1) ((u:real^N)$j)):real^N` THEN + EXISTS_TAC `(lambda j. max (a + &1) ((v:real^N)$j)):real^N` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN FIRST_X_ASSUM + (MATCH_MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + SIMP_TAC[SUBSET_INTERVAL; LAMBDA_BETA] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[INTERVAL_NE_EMPTY; LAMBDA_BETA] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`indicator(s:real^N->bool)`; `u:real^N`; `v:real^N`; `u:real^N`; + `(lambda j. if j = i then min ((v:real^N)$i) a else v$j):real^N`; + `e / &2`] + INDEFINITE_INTEGRAL_CONTINUOUS) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN ANTS_TAC THENL + [ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[indicator; MESON[] + `(if P then if Q then x else y else y) = + (if P /\ Q then x else y)`] THEN + REWRITE_TAC[GSYM IN_INTER; GSYM MEASURABLE_INTEGRABLE] THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_LE_REFL; REAL_LT_IMP_LE] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (min (a - (u:real^N)$i) ((v:real^N)$i - a))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_SUB_LT] THEN + X_GEN_TAC `b:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N`; + `(lambda j. if j = i then min ((v:real^N)$i) b else v$j):real^N`]) THEN + REWRITE_TAC[dist] THEN ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_LE_REFL; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; NORM_0; REAL_LT_IMP_LE] THEN CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[NORM_LE_SQUARE; dot; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `sum(1..dimindex(:N)) (\j. if j = i then d pow 2 else &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS] THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG; REAL_LE_REFL]]]; + SUBGOAL_THEN + `!b. integral + (interval[u:real^N, + (lambda j. if j = i then min (v$i) b else (v:real^N)$j)]) + (indicator s) = + lift(measure(s INTER interval[u,v] INTER {x | x$i <= b}))` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN + ASM_SIMP_TAC[MEASURE_INTEGRAL; MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTER; MEASURABLE_INTERVAL; LIFT_DROP] THEN + ONCE_REWRITE_TAC[GSYM INTEGRAL_RESTRICT_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_SIMP_TAC[INTERVAL_SPLIT; indicator] THEN + REWRITE_TAC[IN_INTER] THEN MESON_TAC[]; + REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN + SUBGOAL_THEN + `!b. measure(s INTER {x:real^N | x$i <= b}) = + measure((s INTER interval[u,v]) INTER {x | x$i <= b}) + + measure((s DIFF interval[u,v]) INTER {x | x$i <= b})` + (fun th -> REWRITE_TAC[th]) + THENL + [GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTERVAL; MEASURABLE_DIFF] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN + SET_TAC[]; + REWRITE_TAC[GSYM INTER_ASSOC] THEN MATCH_MP_TAC(REAL_ARITH + `abs(nub - nua) < e / &2 + ==> abs(mub - mua) < e / &2 + ==> abs((mub + nub) - (mua + nua)) < e`) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `y < e ==> x <= y ==> x < e`)) THEN + SUBGOAL_THEN + `abs(measure(s INTER interval [u,v]) - measure s) = + measure(s DIFF interval[u:real^N,v])` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `x + z = y /\ &0 <= z ==> abs(x - y) = z`) THEN + ASM_SIMP_TAC[MEASURE_POS_LE; MEASURABLE_DIFF; + MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC MEASURE_NEGLIGIBLE_UNION_EQ THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_DIFF; + MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(MESON[NEGLIGIBLE_EMPTY] `s = {} ==> negligible s`) THEN + SET_TAC[]; + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= a /\ &0 <= y /\ y <= a ==> abs(x - y) <= a`) THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTERVAL; MEASURABLE_DIFF; MEASURE_POS_LE] THEN + CONJ_TAC THEN MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_SIMP_TAC[MEASURABLE_INTER; MEASURABLE_INTER_HALFSPACE_LE; + MEASURABLE_INTERVAL; MEASURABLE_DIFF; MEASURE_POS_LE] THEN + SET_TAC[]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Second mean value theorem and monotone integrability. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SECOND_MEAN_VALUE_THEOREM_FULL = prove + (`!f g a b. + ~(real_interval[a,b] = {}) /\ + f real_integrable_on real_interval[a,b] /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) + ==> ?c. c IN real_interval[a,b] /\ + ((\x. g x * f x) has_real_integral + (g(a) * real_integral (real_interval[a,c]) f + + g(b) * real_integral (real_interval[c,b]) f)) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; + `lift a`; `lift b`] + SECOND_MEAN_VALUE_THEOREM_FULL) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN + ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN + BINOP_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN + REWRITE_TAC[LIFT_DROP] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN + ASM_REAL_ARITH_TAC);; + +let REAL_SECOND_MEAN_VALUE_THEOREM = prove + (`!f g a b. + ~(real_interval[a,b] = {}) /\ + f real_integrable_on real_interval[a,b] /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) + ==> ?c. c IN real_interval[a,b] /\ + real_integral (real_interval[a,b]) (\x. g x * f x) = + g(a) * real_integral (real_interval[a,c]) f + + g(b) * real_integral (real_interval[c,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_FULL) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[]);; + +let REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL = prove + (`!f g a b u v. + ~(real_interval[a,b] = {}) /\ + f real_integrable_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) ==> u <= g x /\ g x <= v) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) + ==> ?c. c IN real_interval[a,b] /\ + ((\x. g x * f x) has_real_integral + (u * real_integral (real_interval[a,c]) f + + v * real_integral (real_interval[c,b]) f)) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; + `lift a`; `lift b`; `u:real`; `v:real`] + SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN + ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN + BINOP_TAC THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN + REWRITE_TAC[LIFT_DROP] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN + ASM_REAL_ARITH_TAC);; + +let REAL_SECOND_MEAN_VALUE_THEOREM_GEN = prove + (`!f g a b u v. + ~(real_interval[a,b] = {}) /\ + f real_integrable_on real_interval[a,b] /\ + (!x. x IN real_interval(a,b) ==> u <= g x /\ g x <= v) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) + ==> ?c. c IN real_interval[a,b] /\ + real_integral (real_interval[a,b]) (\x. g x * f x) = + u * real_integral (real_interval[a,c]) f + + v * real_integral (real_interval[c,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_GEN_FULL) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[]);; + +let REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL = prove + (`!f g a b. + ~(real_interval[a,b] = {}) /\ + f real_integrable_on real_interval[a,b] /\ + (!x. x IN real_interval[a,b] ==> &0 <= g x) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) + ==> ?c. c IN real_interval[a,b] /\ + ((\x. g x * f x) has_real_integral + (g(b) * real_integral (real_interval[c,b]) f)) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; + `lift a`; `lift b`] + SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN + ASM_REWRITE_TAC[GSYM REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_ADD] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN + REWRITE_TAC[LIFT_DROP] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL o rand o snd) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THEN SIMP_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_INTEGRABLE_ON_SUBINTERVAL)) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY]) THEN + ASM_REAL_ARITH_TAC);; + +let REAL_SECOND_MEAN_VALUE_THEOREM_BONNET = prove + (`!f g a b. + ~(real_interval[a,b] = {}) /\ + f real_integrable_on real_interval[a,b] /\ + (!x. x IN real_interval[a,b] ==> &0 <= g x) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) + ==> ?c. c IN real_interval[a,b] /\ + real_integral (real_interval[a,b]) (\x. g x * f x) = + g(b) * real_integral (real_interval[c,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SECOND_MEAN_VALUE_THEOREM_BONNET_FULL) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + REWRITE_TAC[]);; + +let REAL_INTEGRABLE_INCREASING_PRODUCT = prove + (`!f g a b. + f real_integrable_on real_interval[a,b] /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g(x) <= g(y)) + ==> (\x. g(x) * f(x)) real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; + `lift a`; `lift b`] + INTEGRABLE_INCREASING_PRODUCT) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; + GSYM REAL_INTEGRABLE_ON] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; + +let REAL_INTEGRABLE_INCREASING_PRODUCT_UNIV = prove + (`!f g B. + f real_integrable_on (:real) /\ + (!x y. x <= y ==> g x <= g y) /\ + (!x. abs(g x) <= B) + ==> (\x. g x * f x) real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `B:real`] + INTEGRABLE_INCREASING_PRODUCT_UNIV) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV; + GSYM REAL_INTEGRABLE_ON] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; + +let REAL_INTEGRABLE_INCREASING = prove + (`!f a b. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f(x) <= f(y)) + ==> f real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] + INTEGRABLE_INCREASING_1) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; + GSYM REAL_INTEGRABLE_ON] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; + +let REAL_INTEGRABLE_DECREASING_PRODUCT = prove + (`!f g a b. + f real_integrable_on real_interval[a,b] /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g(y) <= g(x)) + ==> (\x. g(x) * f(x)) real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; + `lift a`; `lift b`] + INTEGRABLE_DECREASING_PRODUCT) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; + GSYM REAL_INTEGRABLE_ON] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; + +let REAL_INTEGRABLE_DECREASING_PRODUCT_UNIV = prove + (`!f g B. + f real_integrable_on (:real) /\ + (!x y. x <= y ==> g y <= g x) /\ + (!x. abs(g x) <= B) + ==> (\x. g x * f x) real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `(g:real->real) o drop`; `B:real`] + INTEGRABLE_DECREASING_PRODUCT_UNIV) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_UNIV; + GSYM REAL_INTEGRABLE_ON] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; + +let REAL_INTEGRABLE_DECREASING = prove + (`!f a b. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f(y) <= f(x)) + ==> f real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] + INTEGRABLE_DECREASING_1) THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; + GSYM REAL_INTEGRABLE_ON] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[o_DEF; LIFT_DROP; REAL_INTEGRABLE_ON; LIFT_CMUL]);; + +(* ------------------------------------------------------------------------- *) +(* Measurability and absolute integrability of monotone functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MEASURABLE_ON_INCREASING_UNIV = prove + (`!f. (!x y. x <= y ==> f x <= f y) ==> f real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LE] THEN + X_GEN_TAC `y:real` THEN + REPEAT_TCL STRIP_THM_THEN ASSUME_TAC + (SET_RULE `{x | (f:real->real) x <= y} = {} \/ + {x | (f:real->real) x <= y} = UNIV \/ + ?a b. f a <= y /\ ~(f b <= y)`) THEN + ASM_REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_EMPTY; + REAL_LEBESGUE_MEASURABLE_UNIV] THEN + MP_TAC(ISPEC `{x | (f:real->real) x <= y}` SUP) THEN + REWRITE_TAC[IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]; ALL_TAC] THEN + ABBREV_TAC `s = sup {x | (f:real->real) x <= y}` THEN STRIP_TAC THEN + SUBGOAL_THEN + `(!x. (f:real->real) x <= y <=> x < s) \/ + (!x. (f:real->real) x <= y <=> x <= s)` + STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `(f:real->real) s <= y` THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE; REAL_LE_ANTISYM; REAL_LE_TOTAL]; + ASM_SIMP_TAC[REAL_OPEN_HALFSPACE_LT; REAL_LEBESGUE_MEASURABLE_OPEN]; + ASM_SIMP_TAC[REAL_CLOSED_HALFSPACE_LE; REAL_LEBESGUE_MEASURABLE_CLOSED]]);; + +let REAL_MEASURABLE_ON_INCREASING = prove + (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) + ==> f real_measurable_on real_interval[a,b]`, + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `real_interval[a,b] = {}` THENL + [ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_MEASURABLE_ON_0]; + RULE_ASSUM_TAC(REWRITE_RULE[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT])] THEN + ABBREV_TAC `g = \x. if x < a then f(a) + else if b < x then f(b) + else (f:real->real) x` THEN + SUBGOAL_THEN `g real_measurable_on real_interval[a,b]` MP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN EXPAND_TAC "g" THEN + SIMP_TAC[IN_REAL_INTERVAL; GSYM REAL_NOT_LT]] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING_UNIV THEN EXPAND_TAC "g" THEN + ASM_MESON_TAC[REAL_LT_LE; REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM; + REAL_NOT_LT; REAL_LT_IMP_LE; REAL_LE_REFL]);; + +let REAL_MEASURABLE_ON_DECREASING_UNIV = prove + (`!f. (!x y. x <= y ==> f y <= f x) ==> f real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_MEASURABLE_ON_NEG_EQ] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING_UNIV THEN + ASM_SIMP_TAC[REAL_LE_NEG2]);; + +let REAL_MEASURABLE_ON_DECREASING = prove + (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f y <= f x) + ==> f real_measurable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_MEASURABLE_ON_NEG_EQ] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_INCREASING THEN + ASM_SIMP_TAC[REAL_LE_NEG2]);; + +let ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT = prove + (`!f g a b. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) /\ + g absolutely_real_integrable_on real_interval[a,b] + ==> (\x. f x * g x) absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_SIMP_TAC[REAL_MEASURABLE_ON_INCREASING] THEN + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN + EXISTS_TAC `abs((f:real->real) a) + abs((f:real->real) b)` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REAL_ARITH `a <= x /\ x <= b ==> abs x <= abs a + abs b`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LE_TRANS; REAL_LE_REFL]);; + +let ABSOLUTELY_REAL_INTEGRABLE_INCREASING = prove + (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) + ==> f absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INCREASING_PRODUCT THEN + ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]);; + +let ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT = prove + (`!f g a b. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f y <= f x) /\ + g absolutely_real_integrable_on real_interval[a,b] + ==> (\x. f x * g x) absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_SIMP_TAC[REAL_MEASURABLE_ON_DECREASING] THEN + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN + EXISTS_TAC `abs((f:real->real) a) + abs((f:real->real) b)` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (REAL_ARITH `b <= x /\ x <= a ==> abs x <= abs a + abs b`) THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[IN_REAL_INTERVAL; REAL_LE_TRANS; REAL_LE_REFL]);; + +let ABSOLUTELY_REAL_INTEGRABLE_DECREASING = prove + (`!f a b. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f y <= f x) + ==> f absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + GEN_REWRITE_TAC (LAND_CONV o ABS_CONV) [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_DECREASING_PRODUCT THEN + ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_CONST]);; + +(* ------------------------------------------------------------------------- *) +(* Real functions of bounded variation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("has_bounded_real_variation_on",(12,"right"));; + +let has_bounded_real_variation_on = new_definition + `f has_bounded_real_variation_on s <=> + (lift o f o drop) has_bounded_variation_on (IMAGE lift s)`;; + +let real_variation = new_definition + `real_variation s f = vector_variation (IMAGE lift s) (lift o f o drop)`;; + +let HAS_BOUNDED_REAL_VARIATION_ON_EQ = prove + (`!f g s. + (!x. x IN s ==> f x = g x) /\ f has_bounded_real_variation_on s + + + ==> g has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[IMP_CONJ; has_bounded_real_variation_on] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HAS_BOUNDED_VARIATION_ON_EQ) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_SUBSET = prove + (`!f s t. f has_bounded_real_variation_on s /\ t SUBSET s + ==> f has_bounded_real_variation_on t`, + REWRITE_TAC[has_bounded_real_variation_on] THEN + MESON_TAC[HAS_BOUNDED_VARIATION_ON_SUBSET; IMAGE_SUBSET]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_LMUL = prove + (`!f c s. f has_bounded_real_variation_on s + ==> (\x. c * f x) has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; HAS_BOUNDED_VARIATION_ON_CMUL]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_RMUL = prove + (`!f c s. f has_bounded_real_variation_on s + ==> (\x. f x * c) has_bounded_real_variation_on s`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_ON_LMUL]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_NEG = prove + (`!f s. f has_bounded_real_variation_on s + ==> (\x. --f x) has_bounded_real_variation_on s`, + REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_NEG] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_NEG]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_ADD = prove + (`!f g s. f has_bounded_real_variation_on s /\ + g has_bounded_real_variation_on s + ==> (\x. f x + g x) has_bounded_real_variation_on s`, + REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_ADD] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_ADD]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_SUB = prove + (`!f g s. f has_bounded_real_variation_on s /\ + g has_bounded_real_variation_on s + ==> (\x. f x - g x) has_bounded_real_variation_on s`, + REWRITE_TAC[has_bounded_real_variation_on; o_DEF; LIFT_SUB] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_SUB]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_NULL = prove + (`!f a b. b <= a ==> f has_bounded_real_variation_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC HAS_BOUNDED_VARIATION_ON_NULL THEN + ASM_REWRITE_TAC[BOUNDED_INTERVAL; CONTENT_EQ_0_1; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_EMPTY = prove + (`!f. f has_bounded_real_variation_on {}`, + REWRITE_TAC[IMAGE_CLAUSES; has_bounded_real_variation_on] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_ON_EMPTY]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_ABS = prove + (`!f s. f has_bounded_real_variation_on s + ==> (\x. abs(f x)) has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_NORM) THEN + REWRITE_TAC[o_DEF; NORM_REAL; GSYM drop; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_MAX = prove + (`!f g s. f has_bounded_real_variation_on s /\ + g has_bounded_real_variation_on s + ==> (\x. max (f x) (g x)) has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MAX) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_MIN = prove + (`!f g s. f has_bounded_real_variation_on s /\ + g has_bounded_real_variation_on s + ==> (\x. min (f x) (g x)) has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MIN) THEN + REWRITE_TAC[o_DEF; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL = prove + (`!f a b. f has_bounded_real_variation_on real_interval[a,b] + ==> real_bounded(IMAGE f (real_interval[a,b]))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_real_variation_on; REAL_BOUNDED] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP + HAS_BOUNDED_VARIATION_ON_IMP_BOUNDED_ON_INTERVAL) THEN + REWRITE_TAC[IMAGE_o; IMAGE_DROP_INTERVAL; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_MUL = prove + (`!f g a b. + f has_bounded_real_variation_on real_interval[a,b] /\ + g has_bounded_real_variation_on real_interval[a,b] + ==> (\x. f x * g x) has_bounded_real_variation_on real_interval[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_BOUNDED_VARIATION_ON_MUL) THEN + REWRITE_TAC[o_DEF; LIFT_CMUL; LIFT_DROP]);; + +let REAL_VARIATION_POS_LE = prove + (`!f s. f has_bounded_real_variation_on s ==> &0 <= real_variation s f`, + REWRITE_TAC[real_variation; has_bounded_real_variation_on] THEN + REWRITE_TAC[VECTOR_VARIATION_POS_LE]);; + +let REAL_VARIATION_GE_ABS_FUNCTION = prove + (`!f s a b. + f has_bounded_real_variation_on s /\ real_segment[a,b] SUBSET s + ==> abs(f b - f a) <= real_variation s f`, + REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o f o drop`; `IMAGE lift s`; `lift a`; `lift b`] + VECTOR_VARIATION_GE_NORM_FUNCTION) THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_SEGMENT; + IMAGE_EQ_EMPTY; IMAGE_SUBSET] THEN + REWRITE_TAC[real_variation; o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]);; + +let REAL_VARIATION_GE_FUNCTION = prove + (`!f s a b. + f has_bounded_real_variation_on s /\ real_segment[a,b] SUBSET s + ==> f b - f a <= real_variation s f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN + ASM_MESON_TAC[REAL_VARIATION_GE_ABS_FUNCTION]);; + +let REAL_VARIATION_MONOTONE = prove + (`!f s t. f has_bounded_real_variation_on s /\ t SUBSET s + ==> real_variation t f <= real_variation s f`, + REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC VECTOR_VARIATION_MONOTONE THEN + ASM_SIMP_TAC[IMAGE_SUBSET]);; + +let REAL_VARIATION_NEG = prove + (`!f s. real_variation s (\x. --(f x)) = real_variation s f`, + SIMP_TAC[real_variation; o_DEF; LIFT_NEG; VECTOR_VARIATION_NEG]);; + +let REAL_VARIATION_TRIANGLE = prove + (`!f g s. f has_bounded_real_variation_on s /\ + g has_bounded_real_variation_on s + ==> real_variation s (\x. f x + g x) + <= real_variation s f + real_variation s g`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN + DISCH_THEN(MP_TAC o MATCH_MP VECTOR_VARIATION_TRIANGLE) THEN + REWRITE_TAC[o_DEF; LIFT_ADD]);; + +let HAS_BOUNDED_REAL_VARIATION_ON_COMBINE = prove + (`!f a b c. + a <= c /\ c <= b + ==> (f has_bounded_real_variation_on real_interval[a,b] <=> + f has_bounded_real_variation_on real_interval[a,c] /\ + f has_bounded_real_variation_on real_interval[c,b])`, + REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`lift o f o drop`; `lift a`; `lift b`; `lift c`] + HAS_BOUNDED_VARIATION_ON_COMBINE) THEN + ASM_REWRITE_TAC[LIFT_DROP; has_bounded_real_variation_on; + IMAGE_LIFT_REAL_INTERVAL]);; + +let REAL_VARIATION_COMBINE = prove + (`!f a b c. + a <= c /\ c <= b /\ + f has_bounded_real_variation_on real_interval[a,b] + ==> real_variation (real_interval[a,c]) f + + real_variation (real_interval[c,b]) f = + real_variation (real_interval[a,b]) f`, + REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`lift o f o drop`; `lift a`; `lift b`; `lift c`] + VECTOR_VARIATION_COMBINE) THEN + ASM_REWRITE_TAC[LIFT_DROP; real_variation; IMAGE_LIFT_REAL_INTERVAL]);; + +let REAL_VARIATION_MINUS_FUNCTION_MONOTONE = prove + (`!f a b c d. + f has_bounded_real_variation_on real_interval[a,b] /\ + real_interval[c,d] SUBSET real_interval[a,b] /\ + ~(real_interval[c,d] = {}) + ==> real_variation (real_interval[c,d]) f - (f d - f c) <= + real_variation (real_interval[a,b]) f - (f b - f a)`, + REWRITE_TAC[has_bounded_real_variation_on; IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o f o drop`; `lift a`; `lift b`; `lift c`; `lift d`] + VECTOR_VARIATION_MINUS_FUNCTION_MONOTONE) THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; real_variation; + IMAGE_EQ_EMPTY; IMAGE_SUBSET] THEN + REWRITE_TAC[o_THM; LIFT_DROP; DROP_SUB]);; + +let INCREASING_BOUNDED_REAL_VARIATION = prove + (`!f a b. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) + ==> f has_bounded_real_variation_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC INCREASING_BOUNDED_VARIATION THEN + REWRITE_TAC[IN_INTERVAL_1; GSYM FORALL_DROP; o_THM; LIFT_DROP] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_MESON_TAC[]);; + +let INCREASING_REAL_VARIATION = prove + (`!f a b. + ~(real_interval[a,b] = {}) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) + ==> real_variation (real_interval[a,b]) f = f b - f a`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[real_variation; IMAGE_LIFT_REAL_INTERVAL] THEN + MP_TAC(ISPECL [`lift o f o drop`; `lift a`; `lift b`] + INCREASING_VECTOR_VARIATION) THEN + REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + REWRITE_TAC[LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let HAS_BOUNDED_REAL_VARIATION_AFFINITY2_EQ = prove + (`!m c f s. + (\x. f (m * x + c)) has_bounded_real_variation_on + + + IMAGE (\x. inv m * x + --(inv m * c)) s <=> + m = &0 \/ f has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] + HAS_BOUNDED_VARIATION_AFFINITY2_EQ) THEN + REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; + DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; + +let REAL_VARIATION_AFFINITY2 = prove + (`!m c f s. + real_variation (IMAGE (\x. inv m * x + --(inv m * c)) s) + (\x. f (m * x + c)) = + if m = &0 then &0 else real_variation s f`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] + VECTOR_VARIATION_AFFINITY2) THEN + REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; + DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_AFFINITY_EQ = prove + (`!m c f s. + (\x. f (m * x + c)) has_bounded_real_variation_on s <=> + m = &0 \/ f has_bounded_real_variation_on IMAGE (\x. m * x + c) s`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] + HAS_BOUNDED_VARIATION_AFFINITY_EQ) THEN + REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; + DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; + +let REAL_VARIATION_AFFINITY = prove + (`!m c f s. + real_variation s (\x. f (m * x + c)) = + if m = &0 then &0 else real_variation (IMAGE (\x. m * x + c) s) f`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`m:real`; `lift c`; `lift o f o drop`; `IMAGE lift s`] + VECTOR_VARIATION_AFFINITY) THEN + REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; + DROP_ADD; DROP_CMUL; LIFT_ADD; LIFT_CMUL; LIFT_NEG; LIFT_DROP]);; + +let HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ = prove + (`!a f s. + (\x. f(a + x)) has_bounded_real_variation_on (IMAGE (\x. --a + x) s) <=> + f has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] + HAS_BOUNDED_VARIATION_TRANSLATION2_EQ) THEN + REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; + DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; + +let REAL_VARIATION_TRANSLATION2 = prove + (`!a f s. real_variation (IMAGE (\x. --a + x) s) (\x. f(a + x)) = + real_variation s f`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] + VECTOR_VARIATION_TRANSLATION2) THEN + REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; + DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; + +let HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ = prove + (`!a f s. (\x. f(a + x)) has_bounded_real_variation_on s <=> + f has_bounded_real_variation_on (IMAGE (\x. a + x) s)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] + HAS_BOUNDED_VARIATION_TRANSLATION_EQ) THEN + REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; + DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; + +let REAL_VARIATION_TRANSLATION = prove + (`!a f s. real_variation s (\x. f(a + x)) = + real_variation (IMAGE (\x. a + x) s) f`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift a`; `lift o f o drop`; `IMAGE lift s`] + VECTOR_VARIATION_TRANSLATION) THEN + REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; + DROP_ADD; LIFT_DROP; LIFT_ADD; LIFT_NEG]);; + +let HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ_INTERVAL = prove + (`!a f u v. + (\x. f(a + x)) has_bounded_real_variation_on real_interval[u,v] <=> + f has_bounded_real_variation_on real_interval[a+u,a+v]`, + REWRITE_TAC[REAL_INTERVAL_TRANSLATION; + HAS_BOUNDED_REAL_VARIATION_TRANSLATION_EQ]);; + +let REAL_VARIATION_TRANSLATION_INTERVAL = prove + (`!a f u v. + real_variation (real_interval[u,v]) (\x. f(a + x)) = + real_variation (real_interval[a+u,a+v]) f`, + REWRITE_TAC[REAL_INTERVAL_TRANSLATION; + REAL_VARIATION_TRANSLATION]);; + +let HAS_BOUNDED_REAL_VARIATION_TRANSLATION = prove + (`!f s a. f has_bounded_real_variation_on s + ==> (\x. f(a + x)) has_bounded_real_variation_on + (IMAGE (\x. --a + x) s)`, + REWRITE_TAC[HAS_BOUNDED_REAL_VARIATION_TRANSLATION2_EQ]);; + +let HAS_BOUNDED_REAL_VARIATION_REFLECT2_EQ = prove + (`!f s. (\x. f(--x)) has_bounded_real_variation_on (IMAGE (--) s) <=> + f has_bounded_real_variation_on s`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] + HAS_BOUNDED_VARIATION_REFLECT2_EQ) THEN + REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; + DROP_NEG; LIFT_DROP; LIFT_NEG]);; + +let REAL_VARIATION_REFLECT2 = prove + (`!f s. real_variation (IMAGE (--) s) (\x. f(--x)) = + real_variation s f`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] + VECTOR_VARIATION_REFLECT2) THEN + REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; + DROP_NEG; LIFT_DROP; LIFT_NEG]);; + +let HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ = prove + (`!f s. (\x. f(--x)) has_bounded_real_variation_on s <=> + f has_bounded_real_variation_on (IMAGE (--) s)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] + HAS_BOUNDED_VARIATION_REFLECT_EQ) THEN + REWRITE_TAC[o_DEF; has_bounded_real_variation_on; GSYM IMAGE_o; + DROP_NEG; LIFT_DROP; LIFT_NEG]);; + +let REAL_VARIATION_REFLECT = prove + (`!f s. real_variation s (\x. f(--x)) = + real_variation (IMAGE (--) s) f`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`lift o f o drop`; `IMAGE lift s`] + VECTOR_VARIATION_REFLECT) THEN + REWRITE_TAC[o_DEF; real_variation; GSYM IMAGE_o; + DROP_NEG; LIFT_DROP; LIFT_NEG]);; + +let HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ_INTERVAL = prove + (`!f u v. (\x. f(--x)) has_bounded_real_variation_on real_interval[u,v] <=> + f has_bounded_real_variation_on real_interval[--v,--u]`, + REWRITE_TAC[GSYM REFLECT_REAL_INTERVAL; + HAS_BOUNDED_REAL_VARIATION_REFLECT_EQ]);; + +let REAL_VARIATION_REFLECT_INTERVAL = prove + (`!f u v. real_variation (real_interval[u,v]) (\x. f(--x)) = + real_variation (real_interval[--v,--u]) f`, + REWRITE_TAC[GSYM REFLECT_REAL_INTERVAL; REAL_VARIATION_REFLECT]);; + +let HAS_BOUNDED_REAL_VARIATION_DARBOUX = prove + (`!f a b. + f has_bounded_real_variation_on real_interval[a,b] <=> + ?g h. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> h x <= h y) /\ + (!x. f x = g x - h x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; + GSYM IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THENL + [MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`drop o g o lift`; `drop o h o lift`] THEN + ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM LIFT_EQ; FORALL_DROP] THEN + ASM_REWRITE_TAC[LIFT_DROP; LIFT_SUB]; + MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`] THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[LIFT_SUB]]);; + +let HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRICT = prove + (`!f a b. + f has_bounded_real_variation_on real_interval[a,b] <=> + ?g h. (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y + ==> g x < g y) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y + ==> h x < h y) /\ + (!x. f x = g x - h x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[HAS_BOUNDED_VARIATION_DARBOUX_STRICT; + IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; + GSYM IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM; o_THM] THENL + [MAP_EVERY X_GEN_TAC [`g:real^1->real^1`; `h:real^1->real^1`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`drop o g o lift`; `drop o h o lift`] THEN + ASM_REWRITE_TAC[o_THM] THEN REWRITE_TAC[GSYM LIFT_EQ; FORALL_DROP] THEN + ASM_REWRITE_TAC[LIFT_DROP; LIFT_SUB]; + MAP_EVERY X_GEN_TAC [`g:real->real`; `h:real->real`] THEN + STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`lift o g o drop`; `lift o h o drop`] THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN REWRITE_TAC[LIFT_SUB]]);; + +let INCREASING_LEFT_LIMIT = prove + (`!f a b c. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) /\ + c IN real_interval[a,b] + ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC INCREASING_LEFT_LIMIT_1 THEN EXISTS_TAC `lift b` THEN + SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; + +let DECREASING_LEFT_LIMIT = prove + (`!f a b c. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f y <= f x) /\ + c IN real_interval[a,b] + ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC DECREASING_LEFT_LIMIT_1 THEN EXISTS_TAC `lift b` THEN + SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; + +let INCREASING_RIGHT_LIMIT = prove + (`!f a b c. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f x <= f y) /\ + c IN real_interval[a,b] + ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC INCREASING_RIGHT_LIMIT_1 THEN EXISTS_TAC `lift a` THEN + SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; + +let DECREASING_RIGHT_LIMIT = prove + (`!f a b c. + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> f y <= f x) /\ + c IN real_interval[a,b] + ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC DECREASING_RIGHT_LIMIT_1 THEN EXISTS_TAC `lift a` THEN + SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP; FUN_IN_IMAGE]);; + +let HAS_BOUNDED_REAL_VARIATION_LEFT_LIMIT = prove + (`!f a b c. + f has_bounded_real_variation_on real_interval[a,b] /\ + c IN real_interval[a,b] + ==> ?l. (f ---> l) (atreal c within real_interval[a,c])`, + REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_LEFT_LIMIT THEN + EXISTS_TAC `lift b` THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM o_ASSOC; FUN_IN_IMAGE]);; + +let HAS_BOUNDED_REAL_VARIATION_RIGHT_LIMIT = prove + (`!f a b c. + f has_bounded_real_variation_on real_interval[a,b] /\ + c IN real_interval[a,b] + ==> ?l. (f ---> l) (atreal c within real_interval[c,b])`, + REWRITE_TAC[has_bounded_real_variation_on] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[TENDSTO_REAL; GSYM EXISTS_LIFT] THEN + REWRITE_TAC[LIM_WITHINREAL_WITHIN; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC HAS_BOUNDED_VECTOR_VARIATION_RIGHT_LIMIT THEN + EXISTS_TAC `lift a` THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM o_ASSOC; FUN_IN_IMAGE]);; + +let REAL_VARIATION_CONTINUOUS_LEFT = prove + (`!f a b c. + f has_bounded_real_variation_on real_interval[a,b] /\ + c IN real_interval[a,b] + ==> ((\x. real_variation(real_interval[a,x]) f) + real_continuous (atreal c within real_interval[a,c]) <=> + f real_continuous (atreal c within real_interval[a,c]))`, + REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; + REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS_LEFT THEN + EXISTS_TAC `lift b` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);; + +let REAL_VARIATION_CONTINUOUS_RIGHT = prove + (`!f a b c. + f has_bounded_real_variation_on real_interval[a,b] /\ + c IN real_interval[a,b] + ==> ((\x. real_variation(real_interval[a,x]) f) + real_continuous (atreal c within real_interval[c,b]) <=> + f real_continuous (atreal c within real_interval[c,b]))`, + REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; + REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS_RIGHT THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);; + +let REAL_VARIATION_CONTINUOUS = prove + (`!f a b c. + f has_bounded_real_variation_on real_interval[a,b] /\ + c IN real_interval[a,b] + ==> ((\x. real_variation(real_interval[a,x]) f) + real_continuous (atreal c within real_interval[a,b]) <=> + f real_continuous (atreal c within real_interval[a,b]))`, + REWRITE_TAC[has_bounded_real_variation_on; real_variation] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; + REAL_CONTINUOUS_CONTINUOUS_WITHINREAL] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_VARIATION_CONTINUOUS THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; FUN_IN_IMAGE]);; + +let HAS_BOUNDED_REAL_VARIATION_DARBOUX_STRONG = prove + (`!f a b. + f has_bounded_real_variation_on real_interval[a,b] + ==> ?g h. + (!x. f x = g x - h x) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> g x <= g y) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x <= y + ==> h x <= h y) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y + ==> g x < g y) /\ + (!x y. x IN real_interval[a,b] /\ y IN real_interval[a,b] /\ x < y + ==> h x < h y) /\ + (!x. x IN real_interval[a,b] /\ + f real_continuous (atreal x within real_interval[a,x]) + ==> g real_continuous (atreal x within real_interval[a,x]) /\ + h real_continuous (atreal x within real_interval[a,x])) /\ + (!x. x IN real_interval[a,b] /\ + f real_continuous (atreal x within real_interval[x,b]) + ==> g real_continuous (atreal x within real_interval[x,b]) /\ + h real_continuous (atreal x within real_interval[x,b])) /\ + (!x. x IN real_interval[a,b] /\ + f real_continuous (atreal x within real_interval[a,b]) + ==> g real_continuous (atreal x within real_interval[a,b]) /\ + h real_continuous (atreal x within real_interval[a,b]))`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`\x. x + real_variation (real_interval[a,x]) f`; + `\x. x + real_variation (real_interval[a,x]) f - f x`] THEN + REWRITE_TAC[REAL_ARITH `(x + l) - (x + l - f):real = f`] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_VARIATION_MONOTONE; + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN + EXISTS_TAC `(f:real->real) a` THEN + MATCH_MP_TAC REAL_VARIATION_MINUS_FUNCTION_MONOTONE; + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_VARIATION_MONOTONE; + MATCH_MP_TAC REAL_LTE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `!x. a - (b - x) <= c - (d - x) ==> a - b <= c - d`) THEN + EXISTS_TAC `(f:real->real) a` THEN + MATCH_MP_TAC REAL_VARIATION_MINUS_FUNCTION_MONOTONE; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] + REAL_VARIATION_CONTINUOUS_LEFT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] + REAL_VARIATION_CONTINUOUS_LEFT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] + REAL_VARIATION_CONTINUOUS_RIGHT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] + REAL_VARIATION_CONTINUOUS_RIGHT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] + REAL_VARIATION_CONTINUOUS) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `x:real`] + REAL_VARIATION_CONTINUOUS) THEN + ASM_REWRITE_TAC[]] THEN + (CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + HAS_BOUNDED_REAL_VARIATION_ON_SUBSET)); + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL; REAL_INTERVAL_EQ_EMPTY] THEN + ASM_REAL_ARITH_TAC));; + +let HAS_BOUNDED_REAL_VARIATION_COUNTABLE_DISCONTINUITIES = prove + (`!f a b. f has_bounded_real_variation_on real_interval[a,b] + ==> COUNTABLE {x | x IN real_interval[a,b] /\ + ~(f real_continuous atreal x)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_bounded_real_variation_on] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN DISCH_THEN(MP_TAC o + MATCH_MP HAS_BOUNDED_VARIATION_COUNTABLE_DISCONTINUITIES) THEN + DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP COUNTABLE_IMAGE) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_LIFT; LIFT_DROP; UNWIND_THM1] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IN_ELIM_THM] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; GSYM CONJ_ASSOC; EXISTS_DROP; LIFT_DROP] THEN + MESON_TAC[LIFT_DROP]);; + +let REAL_INTEGRABLE_REAL_BOUNDED_VARIATION_PRODUCT = prove + (`!f g a b. + f real_integrable_on real_interval[a,b] /\ + g has_bounded_real_variation_on real_interval[a,b] + ==> (\x. g x * f x) real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN + REWRITE_TAC[has_bounded_real_variation_on; REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; o_DEF; LIFT_CMUL] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRABLE_BOUNDED_VARIATION_PRODUCT) THEN + REWRITE_TAC[LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Lebesgue density theorem. This isn't about R specifically, but it's most *) +(* naturally stated as a real limit so it ends up here in this file. *) +(* ------------------------------------------------------------------------- *) + +let LEBESGUE_DENSITY_THEOREM = prove + (`!s:real^N->bool. + lebesgue_measurable s + ==> ?k. negligible k /\ + !x. ~(x IN k) + ==> ((\e. measure(s INTER cball(x,e)) / measure(cball(x,e))) + ---> (if x IN s then &1 else &0)) + (atreal(&0) within {e | &0 < e})`, + REPEAT STRIP_TAC THEN MP_TAC (ISPEC + `indicator(s:real^N->bool)` ABSOLUTELY_INTEGRABLE_LEBESGUE_POINTS) THEN + ANTS_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[indicator] THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN CONJ_TAC THENL + [MESON_TAC[VEC_COMPONENT; REAL_POS]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_INTER] THEN + ONCE_REWRITE_TAC[GSYM INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE] THEN + MATCH_MP_TAC MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE THEN + ASM_REWRITE_TAC[MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REALLIM_WITHINREAL; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`x:real^N`; `e / &(dimindex(:N)) pow dimindex(:N)`]) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_POW_LT; + REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN X_GEN_TAC `h:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_POW_LT; + REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) THEN + ASM_SIMP_TAC[MEASURE_CBALL_POS; REAL_FIELD + `&0 < y ==> x / y - a = inv(y) * (x - a * y)`] THEN + REWRITE_TAC[REAL_ABS_MUL; NORM_MUL] THEN ONCE_REWRITE_TAC + [REAL_ARITH `x <= (abs a * b) * c <=> x <= (abs(a) * c) * b`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_POW_LT; + REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + REWRITE_TAC[REAL_ABS_INV; real_div; GSYM REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_NZ; CONTENT_EQ_0] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC; + SIMP_TAC[real_abs; CONTENT_POS_LE; MEASURE_POS_LE; MEASURABLE_CBALL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `measure(interval[x - h / &(dimindex(:N)) % vec 1:real^N, + x + h / &(dimindex(:N)) % vec 1]) * + &(dimindex (:N)) pow dimindex (:N)` THEN + CONJ_TAC THENL + [REWRITE_TAC[MEASURE_INTERVAL; CONTENT_CLOSED_INTERVAL_CASES] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + VECTOR_SUB_COMPONENT; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH `x - h <= x + h <=> &0 <= h`; + REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `(x + h) - (x - h) = &2 * h`; + PRODUCT_CONST_NUMSEG_1; REAL_POW_DIV; REAL_POW_MUL] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> y <= x`) THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_DIV_RMUL THEN + REWRITE_TAC[REAL_POW_EQ_0; REAL_OF_NUM_EQ; DIMINDEX_NONZERO]; + MATCH_MP_TAC REAL_LE_RMUL THEN SIMP_TAC[REAL_POS; REAL_POW_LE] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + REWRITE_TAC[MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN + X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH + `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN + STRIP_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN + ASM_REWRITE_TAC[CARD_NUMSEG_1; VECTOR_SUB_COMPONENT; IN_NUMSEG] THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]]; + REWRITE_TAC[NORM_REAL; GSYM drop] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (cball(x:real^N,h)) + (\t. lift(norm(indicator s t - indicator s x))))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURE_INTEGRAL; MEASURABLE_CBALL; + MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN + REWRITE_TAC[GSYM INTEGRAL_RESTRICT_INTER; GSYM DROP_CMUL] THEN + SIMP_TAC[GSYM INTEGRAL_CMUL; GSYM MEASURABLE; MEASURABLE_CBALL] THEN + REWRITE_TAC[GSYM DROP_SUB; COND_RATOR; COND_RAND] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_LID] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_SUB; INTEGRABLE_RESTRICT_INTER; + GSYM MEASURABLE; MEASURABLE_CBALL; INTEGRABLE_ON_CONST; + MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN + REWRITE_TAC[GSYM NORM_REAL; drop] THEN REWRITE_TAC[GSYM drop] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_SIMP_TAC[INTEGRABLE_SUB; INTEGRABLE_RESTRICT_INTER; + GSYM MEASURABLE; MEASURABLE_CBALL; INTEGRABLE_ON_CONST; + MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE] THEN + CONJ_TAC THENL + [ALL_TAC; + GEN_TAC THEN DISCH_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[indicator]) THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_VEC] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[NORM_REAL; GSYM drop; LIFT_DROP] THEN + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_CBALL; IN_INTERVAL] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + VECTOR_SUB_COMPONENT; REAL_MUL_RID; REAL_ARITH + `x - h <= y /\ y <= x + h <=> abs(x - y) <= h`] THEN + REWRITE_TAC[dist; GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM]; + ALL_TAC; + ALL_TAC; + REWRITE_TAC[LIFT_DROP; REAL_ABS_POS]]]] THEN + REWRITE_TAC[GSYM NORM_REAL; drop] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC(INST_TYPE [`:1`,`:P`] + ABSOLUTELY_INTEGRABLE_INTEGRABLE_BOUND) THEN + EXISTS_TAC `(\x. vec 1):real^N->real^1` THEN + + REWRITE_TAC[DROP_VEC; GSYM MEASURABLE; MEASURABLE_INTERVAL; + MEASURABLE_CBALL] THEN + (CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[indicator] THEN + REPEAT(COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB; DROP_VEC]) THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC]) THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[INTEGRABLE_ON_CONST; MEASURABLE_INTERVAL; MEASURABLE_CBALL] THEN + REWRITE_TAC[indicator; INTEGRABLE_RESTRICT_INTER] THEN + REWRITE_TAC[GSYM MEASURABLE] THEN + ASM_SIMP_TAC[MEASURABLE_CBALL; MEASURABLE_INTERVAL; + MEASURABLE_LEGESGUE_MEASURABLE_INTER_MEASURABLE]);; diff --git a/Multivariate/tarski.ml b/Multivariate/tarski.ml new file mode 100644 index 0000000..8e9d031 --- /dev/null +++ b/Multivariate/tarski.ml @@ -0,0 +1,261 @@ +(* ========================================================================= *) +(* Proof that Tarski's axioms for geometry hold in Euclidean space. *) +(* ========================================================================= *) + +needs "Multivariate/convex.ml";; + +(* ------------------------------------------------------------------------- *) +(* Axiom 1 (reflexivity for equidistance). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_1_EUCLIDEAN = prove + (`!a b:real^2. dist(a,b) = dist(b,a)`, + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 2 (transitivity for equidistance). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_2_EUCLIDEAN = prove + (`!a b p q r s. + dist(a,b) = dist(p,q) /\ dist(a,b) = dist(r,s) + ==> dist(p,q) = dist(r,s)`, + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 3 (identity for equidistance). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_3_EUCLIDEAN = prove + (`!a b c. dist(a,b) = dist(c,c) ==> a = b`, + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 4 (segment construction). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_4_EUCLIDEAN = prove + (`!a q b c:real^2. ?x:real^2. between a (q,x) /\ dist(a,x) = dist(b,c)`, + GEOM_ORIGIN_TAC `a:real^2` THEN REPEAT GEN_TAC THEN + REWRITE_TAC[DIST_0] THEN ASM_CASES_TAC `q:real^2 = vec 0` THENL + [ASM_SIMP_TAC[BETWEEN_REFL; VECTOR_CHOOSE_SIZE; DIST_POS_LE]; + EXISTS_TAC `--(dist(b:real^2,c) / norm(q) % q):real^2` THEN + REWRITE_TAC[between; DIST_0] THEN + REWRITE_TAC[dist; NORM_MUL; NORM_NEG; REAL_ABS_DIV; REAL_ABS_NORM; + VECTOR_ARITH `q - --(a % q) = (&1 + a) % q`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_RING `a = &1 + b ==> a * q = q + b * q`) THEN + SIMP_TAC[REAL_ABS_REFL; REAL_POS; REAL_LE_ADD; REAL_LE_DIV; NORM_POS_LE]; + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0]]]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 5 (five-segments axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_5_EUCLIDEAN = prove + (`!a b c x:real^2 a' b' c' x':real^2. + ~(a = b) /\ + dist(a,b) = dist(a',b') /\ + dist(a,c) = dist(a',c') /\ + dist(b,c) = dist(b',c') /\ + between b (a,x) /\ between b' (a',x') /\ dist(b,x) = dist(b',x') + ==> dist(c,x) = dist(c',x')`, + let lemma = prove + (`!a b x y:real^N. + ~(b = a) /\ between b (a,x) /\ between b (a,y) /\ dist(b,x) = dist(b,y) + ==> x = y`, + REPEAT STRIP_TAC THEN REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE + [IMP_CONJ] BETWEEN_EXISTS_EXTENSION))) THEN ASM_SIMP_TAC[] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `dist(b:real^N,x) = dist(b,y)` THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(b:real^N,b + x) = norm x`; NORM_MUL] THEN + ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; NORM_EQ_0; real_abs; VECTOR_SUB_EQ]) in + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`a:real^2`; `b:real^2`; `c:real^2`; `a':real^2`; `b':real^2`; `c':real^2`] + RIGID_TRANSFORMATION_BETWEEN_3) THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_EQ_0; DIST_SYM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^2` + (X_CHOOSE_THEN `f:real^2->real^2` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN SUBST_ALL_TAC) THEN + SUBGOAL_THEN `x' = k + (f:real^2->real^2) x` SUBST1_TAC THENL + [MATCH_MP_TAC lemma THEN MAP_EVERY EXISTS_TAC + [`k + (f:real^2->real^2) a`; `k + (f:real^2->real^2) b`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`; + BETWEEN_TRANSLATION; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + ASM_MESON_TAC[BETWEEN_TRANSLATION; orthogonal_transformation; + NORM_ARITH `dist(a + x:real^N,a + y) = dist(x,y)`; + ORTHOGONAL_TRANSFORMATION_ISOMETRY; BETWEEN_LINEAR_IMAGE_EQ; + DIST_EQ_0; ORTHOGONAL_TRANSFORMATION_INJECTIVE]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 6 (identity for between-ness). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_6_EUCLIDEAN = prove + (`!a b. between b (a,a) ==> a = b`, + SIMP_TAC[BETWEEN_REFL_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 7 (Pasch's axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_7_EUCLIDEAN = prove + (`!a b c p q:real^2. + between p (a,c) /\ between q (b,c) + ==> ?x. between x (p,b) /\ between x (q,a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `q:real^2 = c` THENL + [ASM_MESON_TAC[BETWEEN_REFL; BETWEEN_SYM]; POP_ASSUM MP_TAC] THEN + ASM_CASES_TAC `p:real^2 = a /\ b:real^2 = q` THENL + [ASM_MESON_TAC[BETWEEN_REFL; BETWEEN_SYM]; POP_ASSUM MP_TAC] THEN + GEOM_ORIGIN_TAC `a:real^2` THEN GEOM_NORMALIZE_TAC `q:real^2` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[BETWEEN_REFL_EQ] THEN + REWRITE_TAC[UNWIND_THM2; between; DIST_0] THEN NORM_ARITH_TAC; + ALL_TAC] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `q:real^2` THEN SIMP_TAC + [NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_2; ARITH; REAL_MUL_RID] THEN + GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN SIMP_TAC[VECTOR_MUL_LID] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN DISCH_TAC THEN + DISCH_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC o + REWRITE_RULE[BETWEEN_IN_SEGMENT; IN_SEGMENT]) + (MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] BETWEEN_EXISTS_EXTENSION))) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + SUBGOAL_THEN `&0 < &1 - d + e` ASSUME_TAC THENL + [ASM_CASES_TAC `d = &1 /\ e = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (is_eq o concl))) THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN + ASM_REWRITE_TAC[VECTOR_ADD_RID; IMP_IMP]; + EXISTS_TAC `(&1 - d + e - d * e) / (&1 - d + e) % basis 1:real^2` THEN + CONJ_TAC THENL + [EXISTS_TAC `e / (&1 - d + e)` THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; BASIS_COMPONENT; VEC_COMPONENT; + ARITH; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT] THEN + UNDISCH_TAC `&0 < &1 - d + e` THEN CONV_TAC REAL_FIELD; + EXISTS_TAC `(&1 - d + e - d * e) / (&1 - d + e)` THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + SUBGOAL_THEN `&0 <= (&1 - d) * (&1 + e) /\ &0 <= d * e` MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 8 (lower 2-dimensional axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_8_EUCLIDEAN = prove + (`?a b c:real^2. ~between b (a,c) /\ ~between c (b,a) /\ ~between a (c,b)`, + REWRITE_TAC[GSYM DE_MORGAN_THM] THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN + REWRITE_TAC[GSYM COLLINEAR_BETWEEN_CASES; COLLINEAR_3_2D] THEN + MAP_EVERY EXISTS_TAC + [`vec 0:real^2`; `basis 1:real^2`; `basis 2:real^2`] THEN + SIMP_TAC[BASIS_COMPONENT; VEC_COMPONENT; DIMINDEX_2; ARITH] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 9 (upper 2-dimensional axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_9_EUCLIDEAN = prove + (`!p q a b c:real^2. + ~(p = q) /\ + dist(a,p) = dist(a,q) /\ dist(b,p) = dist(b,q) /\ dist(c,p) = dist(c,q) + ==> between b (a,c) \/ between c (b,a) \/ between a (c,b)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[BETWEEN_SYM] THEN + REWRITE_TAC[GSYM COLLINEAR_BETWEEN_CASES] THEN + REWRITE_TAC[dist; NORM_EQ; NORM_ARITH + `~(p = q) <=> ~(norm(p - q) = &0)`] THEN + ONCE_REWRITE_TAC[REAL_RING `~(x = &0) <=> ~(x pow 2 = &0)`] THEN + REWRITE_TAC[NORM_POW_2; COLLINEAR_3_2D] THEN + REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN + CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 10 (Euclidean axiom). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_10_EUCLIDEAN = prove + (`!a b c d t:real^N. + between d (a,t) /\ between d (b,c) /\ ~(a = d) + ==> ?x y. between b (a,x) /\ between c (a,y) /\ between t (x,y)`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`vec 0:real^N`; `d:real^N`; `t:real^N`] + BETWEEN_EXISTS_EXTENSION) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; VECTOR_ARITH + `d + u % (d - vec 0):real^N = (&1 + u) % d`] THEN + X_GEN_TAC `u:real` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`(&1 + u) % b:real^N`; `(&1 + u) % c:real^N`] THEN + ASM_REWRITE_TAC[between; dist; GSYM VECTOR_SUB_LDISTRIB] THEN + ASM_REWRITE_TAC[VECTOR_SUB_LZERO; NORM_NEG; + VECTOR_ARITH `b - (&1 + u) % b:real^N = --(u % b)`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_LE_ADD; REAL_POS; real_abs] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; REAL_EQ_MUL_LCANCEL] THEN + ASM_REWRITE_TAC[GSYM dist; GSYM between] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Axiom 11 (Continuity). *) +(* ------------------------------------------------------------------------- *) + +let TARSKI_AXIOM_11_EUCLIDEAN = prove + (`!X Y:real^2->bool. + (?a. !x y. x IN X /\ y IN Y ==> between x (a,y)) + ==> (?b. !x y. x IN X /\ y IN Y ==> between b (x,y))`, + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN GEOM_ORIGIN_TAC `a:real^2` THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `!x:real^2. x IN X ==> x = vec 0` THENL + [ASM_MESON_TAC[BETWEEN_REFL]; POP_ASSUM MP_TAC] THEN + ASM_CASES_TAC `Y:real^2->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + SUBGOAL_THEN `?c:real^2. c IN Y` (CHOOSE_THEN MP_TAC) THENL + [ASM SET_TAC[]; REPEAT(POP_ASSUM MP_TAC)] THEN + GEOM_BASIS_MULTIPLE_TAC 1 `c:real^2` THEN + X_GEN_TAC `c:real` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN DISCH_TAC THEN REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^2` STRIP_ASSUME_TAC) THEN + DISCH_THEN(LABEL_TAC "*") THEN + SUBGOAL_THEN `X SUBSET IMAGE (\c. c % basis 1:real^2) {c | &0 <= c} /\ + Y SUBSET IMAGE (\c. c % basis 1:real^2) {c | &0 <= c}` + MP_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^2` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`x:real^2`; `c % basis 1:real^2`]) THEN + ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN + ASM_MESON_TAC[VECTOR_MUL_ASSOC; REAL_LE_MUL]; + DISCH_THEN(MP_TAC o SPEC `z:real^2`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `~(z:real^2 = vec 0)` THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM] THEN + STRIP_TAC THEN X_GEN_TAC `y:real^2` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPECL [`z:real^2`; `y:real^2`]) THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[BETWEEN_IN_SEGMENT; IN_SEGMENT] THEN + REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` MP_TAC) THEN + ASM_CASES_TAC `u = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_MUL_EQ_0] THEN + STRIP_TAC THEN EXISTS_TAC `inv(u) * d:real` THEN + ASM_REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]]; + REWRITE_TAC[SUBSET_IMAGE] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t:real->bool` STRIP_ASSUME_TAC)) THEN + REMOVE_THEN "*" MP_TAC THEN + ASM_REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + DISCH_THEN(fun th -> + EXISTS_TAC `sup s % basis 1 :real^2` THEN MP_TAC th) THEN + REWRITE_TAC[between; dist; NORM_ARITH `norm(vec 0 - x) = norm x`] THEN + REWRITE_TAC[GSYM VECTOR_SUB_RDISTRIB; NORM_MUL] THEN + SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_ARITH + `&0 <= x /\ &0 <= y ==> (abs y = abs x + abs(x - y) <=> x <= y)`] THEN + DISCH_TAC THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `x <= s /\ s <= y ==> abs(x - y) = abs(x - s) + abs(s - y)`) THEN + MP_TAC(SPEC `s:real->bool` SUP) THEN + ASM_MESON_TAC[IMAGE_EQ_EMPTY; MEMBER_NOT_EMPTY]]);; diff --git a/Multivariate/topology.ml b/Multivariate/topology.ml new file mode 100644 index 0000000..409fe07 --- /dev/null +++ b/Multivariate/topology.ml @@ -0,0 +1,20293 @@ +(* ========================================================================= *) +(* Elementary topology in Euclidean space. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "Library/card.ml";; +needs "Multivariate/determinants.ml";; + +(* ------------------------------------------------------------------------- *) +(* General notion of a topology. *) +(* ------------------------------------------------------------------------- *) + +let istopology = new_definition + `istopology L <=> + {} IN L /\ + (!s t. s IN L /\ t IN L ==> (s INTER t) IN L) /\ + (!k. k SUBSET L ==> (UNIONS k) IN L)`;; + +let topology_tybij_th = prove + (`?t:(A->bool)->bool. istopology t`, + EXISTS_TAC `UNIV:(A->bool)->bool` THEN REWRITE_TAC[istopology; IN_UNIV]);; + +let topology_tybij = + new_type_definition "topology" ("topology","open_in") topology_tybij_th;; + +let ISTOPOLOGY_OPEN_IN = prove + (`istopology(open_in top)`, + MESON_TAC[topology_tybij]);; + +let TOPOLOGY_EQ = prove + (`!top1 top2. top1 = top2 <=> !s. open_in top1 s <=> open_in top2 s`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM FUN_EQ_THM] THEN + REWRITE_TAC[ETA_AX] THEN MESON_TAC[topology_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* Infer the "universe" from union of all sets in the topology. *) +(* ------------------------------------------------------------------------- *) + +let topspace = new_definition + `topspace top = UNIONS {s | open_in top s}`;; + +(* ------------------------------------------------------------------------- *) +(* Main properties of open sets. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_CLAUSES = prove + (`!top:(A)topology. + open_in top {} /\ + (!s t. open_in top s /\ open_in top t ==> open_in top (s INTER t)) /\ + (!k. (!s. s IN k ==> open_in top s) ==> open_in top (UNIONS k))`, + SIMP_TAC[IN; SUBSET; SIMP_RULE[istopology; IN; SUBSET] ISTOPOLOGY_OPEN_IN]);; + +let OPEN_IN_SUBSET = prove + (`!top s. open_in top s ==> s SUBSET (topspace top)`, + REWRITE_TAC[topspace] THEN SET_TAC[]);; + +let OPEN_IN_EMPTY = prove + (`!top. open_in top {}`, + REWRITE_TAC[OPEN_IN_CLAUSES]);; + +let OPEN_IN_INTER = prove + (`!top s t. open_in top s /\ open_in top t ==> open_in top (s INTER t)`, + REWRITE_TAC[OPEN_IN_CLAUSES]);; + +let OPEN_IN_UNIONS = prove + (`!top k. (!s. s IN k ==> open_in top s) ==> open_in top (UNIONS k)`, + REWRITE_TAC[OPEN_IN_CLAUSES]);; + +let OPEN_IN_UNION = prove + (`!top s t. open_in top s /\ open_in top t ==> open_in top (s UNION t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN + MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[]);; + +let OPEN_IN_TOPSPACE = prove + (`!top. open_in top (topspace top)`, + SIMP_TAC[topspace; OPEN_IN_UNIONS; IN_ELIM_THM]);; + +let OPEN_IN_INTERS = prove + (`!top s:(A->bool)->bool. + FINITE s /\ ~(s = {}) /\ (!t. t IN s ==> open_in top t) + ==> open_in top (INTERS s)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[INTERS_INSERT; IMP_IMP; NOT_INSERT_EMPTY; FORALL_IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`s:A->bool`; `f:(A->bool)->bool`] THEN + ASM_CASES_TAC `f:(A->bool)->bool = {}` THEN + ASM_SIMP_TAC[INTERS_0; INTER_UNIV] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC OPEN_IN_INTER THEN ASM_SIMP_TAC[]);; + +let OPEN_IN_SUBOPEN = prove + (`!top s:A->bool. + open_in top s <=> + !x. x IN s ==> ?t. open_in top t /\ x IN t /\ t SUBSET s`, + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + REWRITE_TAC[TAUT `a ==> b /\ c <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[FORALL_AND_THM; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[GSYM FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_UNIONS) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Closed sets. *) +(* ------------------------------------------------------------------------- *) + +let closed_in = new_definition + `closed_in top s <=> + s SUBSET (topspace top) /\ open_in top (topspace top DIFF s)`;; + +let CLOSED_IN_SUBSET = prove + (`!top s. closed_in top s ==> s SUBSET (topspace top)`, + MESON_TAC[closed_in]);; + +let CLOSED_IN_EMPTY = prove + (`!top. closed_in top {}`, + REWRITE_TAC[closed_in; EMPTY_SUBSET; DIFF_EMPTY; OPEN_IN_TOPSPACE]);; + +let CLOSED_IN_TOPSPACE = prove + (`!top. closed_in top (topspace top)`, + REWRITE_TAC[closed_in; SUBSET_REFL; DIFF_EQ_EMPTY; OPEN_IN_EMPTY]);; + +let CLOSED_IN_UNION = prove + (`!top s t. closed_in top s /\ closed_in top t ==> closed_in top (s UNION t)`, + SIMP_TAC[closed_in; UNION_SUBSET; OPEN_IN_INTER; + SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`]);; + +let CLOSED_IN_INTERS = prove + (`!top k:(A->bool)->bool. + ~(k = {}) /\ (!s. s IN k ==> closed_in top s) + ==> closed_in top (INTERS k)`, + REPEAT GEN_TAC THEN REWRITE_TAC[closed_in] THEN REPEAT STRIP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `topspace top DIFF INTERS k :A->bool = + UNIONS {topspace top DIFF s | s IN k}` SUBST1_TAC + THENL [ALL_TAC; MATCH_MP_TAC OPEN_IN_UNIONS THEN ASM SET_TAC[]] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + REWRITE_TAC[IN_UNIONS; IN_INTERS; IN_DIFF; EXISTS_IN_IMAGE] THEN + MESON_TAC[]);; + +let CLOSED_IN_INTER = prove + (`!top s t. closed_in top s /\ closed_in top t ==> closed_in top (s INTER t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN + MATCH_MP_TAC CLOSED_IN_INTERS THEN ASM SET_TAC[]);; + +let OPEN_IN_CLOSED_IN_EQ = prove + (`!top s. open_in top s <=> + s SUBSET topspace top /\ closed_in top (topspace top DIFF s)`, + REWRITE_TAC[closed_in; SET_RULE `(u DIFF s) SUBSET u`] THEN + REWRITE_TAC[SET_RULE `u DIFF (u DIFF s) = u INTER s`] THEN + MESON_TAC[OPEN_IN_SUBSET; SET_RULE `s SUBSET t ==> t INTER s = s`]);; + +let OPEN_IN_CLOSED_IN = prove + (`!s. s SUBSET topspace top + ==> (open_in top s <=> closed_in top (topspace top DIFF s))`, + SIMP_TAC[OPEN_IN_CLOSED_IN_EQ]);; + +let OPEN_IN_DIFF = prove + (`!top s t:A->bool. + open_in top s /\ closed_in top t ==> open_in top (s DIFF t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `s DIFF t :A->bool = s INTER (topspace top DIFF t)` + SUBST1_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN SET_TAC[]; + MATCH_MP_TAC OPEN_IN_INTER THEN ASM_MESON_TAC[closed_in]]);; + +let CLOSED_IN_DIFF = prove + (`!top s t:A->bool. + closed_in top s /\ open_in top t ==> closed_in top (s DIFF t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `s DIFF t :A->bool = s INTER (topspace top DIFF t)` + SUBST1_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_INTER THEN ASM_MESON_TAC[OPEN_IN_CLOSED_IN_EQ]]);; + +let CLOSED_IN_UNIONS = prove + (`!top s. FINITE s /\ (!t. t IN s ==> closed_in top t) + ==> closed_in top (UNIONS s)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_INSERT; UNIONS_0; CLOSED_IN_EMPTY; IN_INSERT] THEN + MESON_TAC[CLOSED_IN_UNION]);; + +(* ------------------------------------------------------------------------- *) +(* Subspace topology. *) +(* ------------------------------------------------------------------------- *) + +let subtopology = new_definition + `subtopology top u = topology {s INTER u | open_in top s}`;; + +let ISTOPLOGY_SUBTOPOLOGY = prove + (`!top u:A->bool. istopology {s INTER u | open_in top s}`, + REWRITE_TAC[istopology; SET_RULE + `{s INTER u | open_in top s} = + IMAGE (\s. s INTER u) {s | open_in top s}`] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[SUBSET_IMAGE; IN_IMAGE; IN_ELIM_THM; SUBSET] THEN + REPEAT GEN_TAC THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `{}:A->bool` THEN REWRITE_TAC[OPEN_IN_EMPTY; INTER_EMPTY]; + SIMP_TAC[SET_RULE `(s INTER u) INTER t INTER u = (s INTER t) INTER u`] THEN + ASM_MESON_TAC[OPEN_IN_INTER]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:(A->bool)->bool`; `g:(A->bool)->bool`] THEN + STRIP_TAC THEN EXISTS_TAC `UNIONS g :A->bool` THEN + ASM_SIMP_TAC[OPEN_IN_UNIONS; INTER_UNIONS] THEN SET_TAC[]]);; + +let OPEN_IN_SUBTOPOLOGY = prove + (`!top u s. open_in (subtopology top u) s <=> + ?t. open_in top t /\ s = t INTER u`, + REWRITE_TAC[subtopology] THEN + SIMP_TAC[REWRITE_RULE[CONJUNCT2 topology_tybij] ISTOPLOGY_SUBTOPOLOGY] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM]);; + +let TOPSPACE_SUBTOPOLOGY = prove + (`!top u. topspace(subtopology top u) = topspace top INTER u`, + REWRITE_TAC[topspace; OPEN_IN_SUBTOPOLOGY; INTER_UNIONS] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM]);; + +let CLOSED_IN_SUBTOPOLOGY = prove + (`!top u s. closed_in (subtopology top u) s <=> + ?t:A->bool. closed_in top t /\ s = t INTER u`, + REWRITE_TAC[closed_in; TOPSPACE_SUBTOPOLOGY] THEN + REWRITE_TAC[SUBSET_INTER; OPEN_IN_SUBTOPOLOGY; RIGHT_AND_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `topspace top DIFF t :A->bool` THEN + ASM_SIMP_TAC[CLOSED_IN_TOPSPACE; OPEN_IN_DIFF; CLOSED_IN_DIFF; + OPEN_IN_TOPSPACE] THEN + ASM SET_TAC[]);; + +let OPEN_IN_SUBTOPOLOGY_EMPTY = prove + (`!top s. open_in (subtopology top {}) s <=> s = {}`, + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; INTER_EMPTY] THEN + MESON_TAC[OPEN_IN_EMPTY]);; + +let CLOSED_IN_SUBTOPOLOGY_EMPTY = prove + (`!top s. closed_in (subtopology top {}) s <=> s = {}`, + REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY; INTER_EMPTY] THEN + MESON_TAC[CLOSED_IN_EMPTY]);; + +let OPEN_IN_SUBTOPOLOGY_REFL = prove + (`!top u:A->bool. open_in (subtopology top u) u <=> u SUBSET topspace top`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN + ASM_SIMP_TAC[OPEN_IN_SUBSET]; + DISCH_TAC THEN EXISTS_TAC `topspace top:A->bool` THEN + REWRITE_TAC[OPEN_IN_TOPSPACE] THEN ASM SET_TAC[]]);; + +let CLOSED_IN_SUBTOPOLOGY_REFL = prove + (`!top u:A->bool. closed_in (subtopology top u) u <=> u SUBSET topspace top`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY] THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN ONCE_ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET u ==> s INTER t SUBSET u`) THEN + ASM_SIMP_TAC[CLOSED_IN_SUBSET]; + DISCH_TAC THEN EXISTS_TAC `topspace top:A->bool` THEN + REWRITE_TAC[CLOSED_IN_TOPSPACE] THEN ASM SET_TAC[]]);; + +let SUBTOPOLOGY_SUPERSET = prove + (`!top s:A->bool. topspace top SUBSET s ==> subtopology top s = top`, + REPEAT GEN_TAC THEN SIMP_TAC[TOPOLOGY_EQ; OPEN_IN_SUBTOPOLOGY] THEN + DISCH_TAC THEN X_GEN_TAC `u:A->bool` THEN EQ_TAC THENL + [DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN + DISCH_THEN(fun th -> MP_TAC th THEN + ASSUME_TAC(MATCH_MP OPEN_IN_SUBSET th)) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; + DISCH_TAC THEN EXISTS_TAC `u:A->bool` THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN ASM SET_TAC[]]);; + +let SUBTOPOLOGY_TOPSPACE = prove + (`!top. subtopology top (topspace top) = top`, + SIMP_TAC[SUBTOPOLOGY_SUPERSET; SUBSET_REFL]);; + +let SUBTOPOLOGY_UNIV = prove + (`!top. subtopology top UNIV = top`, + SIMP_TAC[SUBTOPOLOGY_SUPERSET; SUBSET_UNIV]);; + +let OPEN_IN_IMP_SUBSET = prove + (`!top s t. open_in (subtopology top s) t ==> t SUBSET s`, + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN SET_TAC[]);; + +let CLOSED_IN_IMP_SUBSET = prove + (`!top s t. closed_in (subtopology top s) t ==> t SUBSET s`, + REWRITE_TAC[closed_in; TOPSPACE_SUBTOPOLOGY] THEN SET_TAC[]);; + +let OPEN_IN_SUBTOPOLOGY_UNION = prove + (`!top s t u:A->bool. + open_in (subtopology top t) s /\ open_in (subtopology top u) s + ==> open_in (subtopology top (t UNION u)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s':A->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t':A->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `s' INTER t':A->bool` THEN ASM_SIMP_TAC[OPEN_IN_INTER] THEN + ASM SET_TAC[]);; + +let CLOSED_IN_SUBTOPOLOGY_UNION = prove + (`!top s t u:A->bool. + closed_in (subtopology top t) s /\ closed_in (subtopology top u) s + ==> closed_in (subtopology top (t UNION u)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s':A->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t':A->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `s' INTER t':A->bool` THEN ASM_SIMP_TAC[CLOSED_IN_INTER] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The universal Euclidean versions are what we use most of the time. *) +(* ------------------------------------------------------------------------- *) + +let open_def = new_definition + `open s <=> !x. x IN s ==> ?e. &0 < e /\ !x'. dist(x',x) < e ==> x' IN s`;; + +let closed = new_definition + `closed(s:real^N->bool) <=> open(UNIV DIFF s)`;; + +let euclidean = new_definition + `euclidean = topology open`;; + +let OPEN_EMPTY = prove + (`open {}`, + REWRITE_TAC[open_def; NOT_IN_EMPTY]);; + +let OPEN_UNIV = prove + (`open(:real^N)`, + REWRITE_TAC[open_def; IN_UNIV] THEN MESON_TAC[REAL_LT_01]);; + +let OPEN_INTER = prove + (`!s t. open s /\ open t ==> open (s INTER t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def; AND_FORALL_THM; IN_INTER] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN + ASM_MESON_TAC[REAL_LT_TRANS]);; + +let OPEN_UNIONS = prove + (`(!s. s IN f ==> open s) ==> open(UNIONS f)`, + REWRITE_TAC[open_def; IN_UNIONS] THEN MESON_TAC[]);; + +let OPEN_EXISTS_IN = prove + (`!P Q:A->real^N->bool. + (!a. P a ==> open {x | Q a x}) ==> open {x | ?a. P a /\ Q a x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `open(UNIONS {{x | Q (a:A) (x:real^N)} | P a})` MP_TAC THENL + [MATCH_MP_TAC OPEN_UNIONS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[UNIONS_GSPEC] THEN + SET_TAC[]]);; + +let OPEN_EXISTS = prove + (`!Q:A->real^N->bool. (!a. open {x | Q a x}) ==> open {x | ?a. Q a x}`, + MP_TAC(ISPEC `\x:A. T` OPEN_EXISTS_IN) THEN REWRITE_TAC[]);; + +let OPEN_IN = prove + (`!s:real^N->bool. open s <=> open_in euclidean s`, + GEN_TAC THEN REWRITE_TAC[euclidean] THEN CONV_TAC SYM_CONV THEN + AP_THM_TAC THEN REWRITE_TAC[GSYM(CONJUNCT2 topology_tybij)] THEN + REWRITE_TAC[REWRITE_RULE[IN] istopology] THEN + REWRITE_TAC[OPEN_EMPTY; OPEN_INTER; SUBSET] THEN + MESON_TAC[IN; OPEN_UNIONS]);; + +let TOPSPACE_EUCLIDEAN = prove + (`topspace euclidean = (:real^N)`, + REWRITE_TAC[topspace; EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN + MESON_TAC[OPEN_UNIV; IN_UNIV; OPEN_IN]);; + +let TOPSPACE_EUCLIDEAN_SUBTOPOLOGY = prove + (`!s. topspace (subtopology euclidean s) = s`, + REWRITE_TAC[TOPSPACE_EUCLIDEAN; TOPSPACE_SUBTOPOLOGY; INTER_UNIV]);; + +let OPEN_IN_REFL = prove + (`!s:real^N->bool. open_in (subtopology euclidean s) s`, + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; + +let CLOSED_IN_REFL = prove + (`!s:real^N->bool. closed_in (subtopology euclidean s) s`, + REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV]);; + +let CLOSED_IN = prove + (`!s:real^N->bool. closed s <=> closed_in euclidean s`, + REWRITE_TAC[closed; closed_in; TOPSPACE_EUCLIDEAN; OPEN_IN; SUBSET_UNIV]);; + +let OPEN_UNION = prove + (`!s t. open s /\ open t ==> open(s UNION t)`, + REWRITE_TAC[OPEN_IN; OPEN_IN_UNION]);; + +let OPEN_SUBOPEN = prove + (`!s. open s <=> !x. x IN s ==> ?t. open t /\ x IN t /\ t SUBSET s`, + REWRITE_TAC[OPEN_IN; GSYM OPEN_IN_SUBOPEN]);; + +let CLOSED_EMPTY = prove + (`closed {}`, + REWRITE_TAC[CLOSED_IN; CLOSED_IN_EMPTY]);; + +let CLOSED_UNIV = prove + (`closed(UNIV:real^N->bool)`, + REWRITE_TAC[CLOSED_IN; GSYM TOPSPACE_EUCLIDEAN; CLOSED_IN_TOPSPACE]);; + +let CLOSED_UNION = prove + (`!s t. closed s /\ closed t ==> closed(s UNION t)`, + REWRITE_TAC[CLOSED_IN; CLOSED_IN_UNION]);; + +let CLOSED_INTER = prove + (`!s t. closed s /\ closed t ==> closed(s INTER t)`, + REWRITE_TAC[CLOSED_IN; CLOSED_IN_INTER]);; + +let CLOSED_INTERS = prove + (`!f. (!s:real^N->bool. s IN f ==> closed s) ==> closed(INTERS f)`, + REWRITE_TAC[CLOSED_IN] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_SIMP_TAC[CLOSED_IN_INTERS; INTERS_0] THEN + REWRITE_TAC[GSYM TOPSPACE_EUCLIDEAN; CLOSED_IN_TOPSPACE]);; + +let CLOSED_FORALL_IN = prove + (`!P Q:A->real^N->bool. + (!a. P a ==> closed {x | Q a x}) ==> closed {x | !a. P a ==> Q a x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `closed(INTERS {{x | Q (a:A) (x:real^N)} | P a})` MP_TAC THENL + [MATCH_MP_TAC CLOSED_INTERS THEN ASM_REWRITE_TAC[FORALL_IN_GSPEC]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[INTERS_GSPEC] THEN + SET_TAC[]]);; + +let CLOSED_FORALL = prove + (`!Q:A->real^N->bool. (!a. closed {x | Q a x}) ==> closed {x | !a. Q a x}`, + MP_TAC(ISPEC `\x:A. T` CLOSED_FORALL_IN) THEN REWRITE_TAC[]);; + +let OPEN_CLOSED = prove + (`!s:real^N->bool. open s <=> closed(UNIV DIFF s)`, + SIMP_TAC[OPEN_IN; CLOSED_IN; TOPSPACE_EUCLIDEAN; SUBSET_UNIV; + OPEN_IN_CLOSED_IN_EQ]);; + +let OPEN_DIFF = prove + (`!s t. open s /\ closed t ==> open(s DIFF t)`, + REWRITE_TAC[OPEN_IN; CLOSED_IN; OPEN_IN_DIFF]);; + +let CLOSED_DIFF = prove + (`!s t. closed s /\ open t ==> closed(s DIFF t)`, + REWRITE_TAC[OPEN_IN; CLOSED_IN; CLOSED_IN_DIFF]);; + +let OPEN_INTERS = prove + (`!s. FINITE s /\ (!t. t IN s ==> open t) ==> open(INTERS s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[INTERS_INSERT; INTERS_0; OPEN_UNIV; IN_INSERT] THEN + MESON_TAC[OPEN_INTER]);; + +let CLOSED_UNIONS = prove + (`!s. FINITE s /\ (!t. t IN s ==> closed t) ==> closed(UNIONS s)`, + REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_INSERT; UNIONS_0; CLOSED_EMPTY; IN_INSERT] THEN + MESON_TAC[CLOSED_UNION]);; + +(* ------------------------------------------------------------------------- *) +(* Open and closed balls and spheres. *) +(* ------------------------------------------------------------------------- *) + +let ball = new_definition + `ball(x,e) = { y | dist(x,y) < e}`;; + +let cball = new_definition + `cball(x,e) = { y | dist(x,y) <= e}`;; + +let sphere = new_definition + `sphere(x,e) = { y | dist(x,y) = e}`;; + +let IN_BALL = prove + (`!x y e. y IN ball(x,e) <=> dist(x,y) < e`, + REWRITE_TAC[ball; IN_ELIM_THM]);; + +let IN_CBALL = prove + (`!x y e. y IN cball(x,e) <=> dist(x,y) <= e`, + REWRITE_TAC[cball; IN_ELIM_THM]);; + +let IN_SPHERE = prove + (`!x y e. y IN sphere(x,e) <=> dist(x,y) = e`, + REWRITE_TAC[sphere; IN_ELIM_THM]);; + +let IN_BALL_0 = prove + (`!x e. x IN ball(vec 0,e) <=> norm(x) < e`, + REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let IN_CBALL_0 = prove + (`!x e. x IN cball(vec 0,e) <=> norm(x) <= e`, + REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let IN_SPHERE_0 = prove + (`!x e. x IN sphere(vec 0,e) <=> norm(x) = e`, + REWRITE_TAC[IN_SPHERE; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let BALL_TRIVIAL = prove + (`!x. ball(x,&0) = {}`, + REWRITE_TAC[EXTENSION; IN_BALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; + +let CBALL_TRIVIAL = prove + (`!x. cball(x,&0) = {x}`, + REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; + +let CENTRE_IN_CBALL = prove + (`!x e. x IN cball(x,e) <=> &0 <= e`, + MESON_TAC[IN_CBALL; DIST_REFL]);; + +let BALL_SUBSET_CBALL = prove + (`!x e. ball(x,e) SUBSET cball(x,e)`, + REWRITE_TAC[IN_BALL; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);; + +let SPHERE_SUBSET_CBALL = prove + (`!x e. sphere(x,e) SUBSET cball(x,e)`, + REWRITE_TAC[IN_SPHERE; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);; + +let SUBSET_BALL = prove + (`!x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)`, + REWRITE_TAC[SUBSET; IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]);; + +let SUBSET_CBALL = prove + (`!x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)`, + REWRITE_TAC[SUBSET; IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]);; + +let BALL_MAX_UNION = prove + (`!a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)`, + REWRITE_TAC[IN_BALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; + +let BALL_MIN_INTER = prove + (`!a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)`, + REWRITE_TAC[IN_BALL; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC);; + +let CBALL_MAX_UNION = prove + (`!a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)`, + REWRITE_TAC[IN_CBALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; + +let CBALL_MIN_INTER = prove + (`!x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_CBALL] THEN REAL_ARITH_TAC);; + +let BALL_TRANSLATION = prove + (`!a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))`, + REWRITE_TAC[ball] THEN GEOM_TRANSLATE_TAC[]);; + +let CBALL_TRANSLATION = prove + (`!a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))`, + REWRITE_TAC[cball] THEN GEOM_TRANSLATE_TAC[]);; + +let SPHERE_TRANSLATION = prove + (`!a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))`, + REWRITE_TAC[sphere] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants + [BALL_TRANSLATION; CBALL_TRANSLATION; SPHERE_TRANSLATION];; + +let BALL_LINEAR_IMAGE = prove + (`!f:real^M->real^N x r. + linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) + ==> ball(f x,r) = IMAGE f (ball(x,r))`, + REWRITE_TAC[ball] THEN GEOM_TRANSFORM_TAC[]);; + +let CBALL_LINEAR_IMAGE = prove + (`!f:real^M->real^N x r. + linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) + ==> cball(f x,r) = IMAGE f (cball(x,r))`, + REWRITE_TAC[cball] THEN GEOM_TRANSFORM_TAC[]);; + +let SPHERE_LINEAR_IMAGE = prove + (`!f:real^M->real^N x r. + linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) + ==> sphere(f x,r) = IMAGE f (sphere(x,r))`, + REWRITE_TAC[sphere] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants + [BALL_LINEAR_IMAGE; CBALL_LINEAR_IMAGE; SPHERE_LINEAR_IMAGE];; + +let BALL_SCALING = prove + (`!c. &0 < c ==> !x r. ball(c % x,c * r) = IMAGE (\x. c % x) (ball(x,r))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN + REWRITE_TAC[IN_BALL; DIST_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LT_LMUL_EQ]);; + +let CBALL_SCALING = prove + (`!c. &0 < c ==> !x r. cball(c % x,c * r) = IMAGE (\x. c % x) (cball(x,r))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN + REWRITE_TAC[IN_CBALL; DIST_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LE_LMUL_EQ]);; + +add_scaling_theorems [BALL_SCALING; CBALL_SCALING];; + +let CBALL_DIFF_BALL = prove + (`!a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)`, + REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let BALL_UNION_SPHERE = prove + (`!a r. ball(a,r) UNION sphere(a,r) = cball(a,r)`, + REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let SPHERE_UNION_BALL = prove + (`!a r. sphere(a,r) UNION ball(a,r) = cball(a,r)`, + REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let CBALL_DIFF_SPHERE = prove + (`!a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)`, + REWRITE_TAC[EXTENSION; IN_DIFF; IN_SPHERE; IN_BALL; IN_CBALL] THEN + REAL_ARITH_TAC);; + +let OPEN_BALL = prove + (`!x e. open(ball(x,e))`, + REWRITE_TAC[open_def; ball; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + MESON_TAC[REAL_SUB_LT; REAL_LT_SUB_LADD; REAL_ADD_SYM; REAL_LET_TRANS; + DIST_TRIANGLE_ALT]);; + +let CENTRE_IN_BALL = prove + (`!x e. x IN ball(x,e) <=> &0 < e`, + MESON_TAC[IN_BALL; DIST_REFL]);; + +let OPEN_CONTAINS_BALL = prove + (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ ball(x,e) SUBSET s`, + REWRITE_TAC[open_def; SUBSET; IN_BALL] THEN REWRITE_TAC[DIST_SYM]);; + +let OPEN_CONTAINS_BALL_EQ = prove + (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)`, + MESON_TAC[OPEN_CONTAINS_BALL; SUBSET; CENTRE_IN_BALL]);; + +let BALL_EQ_EMPTY = prove + (`!x e. (ball(x,e) = {}) <=> e <= &0`, + REWRITE_TAC[EXTENSION; IN_BALL; NOT_IN_EMPTY; REAL_NOT_LT] THEN + MESON_TAC[DIST_POS_LE; REAL_LE_TRANS; DIST_REFL]);; + +let BALL_EMPTY = prove + (`!x e. e <= &0 ==> ball(x,e) = {}`, + REWRITE_TAC[BALL_EQ_EMPTY]);; + +let OPEN_CONTAINS_CBALL = prove + (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s`, + GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + SUBGOAL_THEN `e / &2 < e` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS]) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +let OPEN_CONTAINS_CBALL_EQ = prove + (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)`, + MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET; REAL_LT_IMP_LE; CENTRE_IN_CBALL]);; + +let SPHERE_EQ_EMPTY = prove + (`!a:real^N r. sphere(a,r) = {} <=> r < &0`, + REWRITE_TAC[sphere; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN + MESON_TAC[VECTOR_CHOOSE_DIST; REAL_NOT_LE]);; + +let SPHERE_EMPTY = prove + (`!a:real^N r. r < &0 ==> sphere(a,r) = {}`, + REWRITE_TAC[SPHERE_EQ_EMPTY]);; + +let NEGATIONS_BALL = prove + (`!r. IMAGE (--) (ball(vec 0:real^N,r)) = ball(vec 0,r)`, + GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_BALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let NEGATIONS_CBALL = prove + (`!r. IMAGE (--) (cball(vec 0:real^N,r)) = cball(vec 0,r)`, + GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_CBALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let NEGATIONS_SPHERE = prove + (`!r. IMAGE (--) (sphere(vec 0:real^N,r)) = sphere(vec 0,r)`, + GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_SPHERE_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let ORTHOGONAL_TRANSFORMATION_BALL = prove + (`!f:real^N->real^N r. + orthogonal_transformation f ==> IMAGE f (ball(vec 0,r)) = ball(vec 0,r)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL_0] THEN + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; + +let ORTHOGONAL_TRANSFORMATION_CBALL = prove + (`!f:real^N->real^N r. + orthogonal_transformation f ==> IMAGE f (cball(vec 0,r)) = cball(vec 0,r)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL_0] THEN + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; + +let ORTHOGONAL_TRANSFORMATION_SPHERE = prove + (`!f:real^N->real^N r. + orthogonal_transformation f + ==> IMAGE f (sphere(vec 0,r)) = sphere(vec 0,r)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPHERE_0] THEN + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; + +(* ------------------------------------------------------------------------- *) +(* Basic "localization" results are handy for connectedness. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_OPEN = prove + (`!s:real^N->bool u. + open_in (subtopology euclidean u) s <=> ?t. open t /\ (s = u INTER t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN] THEN + REWRITE_TAC[INTER_ACI]);; + +let OPEN_IN_INTER_OPEN = prove + (`!s t u:real^N->bool. + open_in (subtopology euclidean u) s /\ open t + ==> open_in (subtopology euclidean u) (s INTER t)`, + REWRITE_TAC[OPEN_IN_OPEN] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[INTER_ASSOC] THEN ASM_MESON_TAC[OPEN_INTER]);; + +let OPEN_IN_OPEN_INTER = prove + (`!u s. open s ==> open_in (subtopology euclidean u) (u INTER s)`, + REWRITE_TAC[OPEN_IN_OPEN] THEN MESON_TAC[]);; + +let OPEN_OPEN_IN_TRANS = prove + (`!s t. open s /\ open t /\ t SUBSET s + ==> open_in (subtopology euclidean s) t`, + MESON_TAC[OPEN_IN_OPEN_INTER; SET_RULE `t SUBSET s ==> t = s INTER t`]);; + +let OPEN_SUBSET = prove + (`!s t:real^N->bool. + s SUBSET t /\ open s ==> open_in (subtopology euclidean t) s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN + EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]);; + +let CLOSED_IN_CLOSED = prove + (`!s:real^N->bool u. + closed_in (subtopology euclidean u) s <=> ?t. closed t /\ (s = u INTER t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY; GSYM CLOSED_IN] THEN + REWRITE_TAC[INTER_ACI]);; + +let CLOSED_SUBSET_EQ = prove + (`!u s:real^N->bool. + closed s ==> (closed_in (subtopology euclidean u) s <=> s SUBSET u)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; + REWRITE_TAC[CLOSED_IN_CLOSED] THEN EXISTS_TAC `s:real^N->bool` THEN + ASM SET_TAC[]]);; + +let CLOSED_IN_INTER_CLOSED = prove + (`!s t u:real^N->bool. + closed_in (subtopology euclidean u) s /\ closed t + ==> closed_in (subtopology euclidean u) (s INTER t)`, + REWRITE_TAC[CLOSED_IN_CLOSED] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[INTER_ASSOC] THEN ASM_MESON_TAC[CLOSED_INTER]);; + +let CLOSED_IN_CLOSED_INTER = prove + (`!u s. closed s ==> closed_in (subtopology euclidean u) (u INTER s)`, + REWRITE_TAC[CLOSED_IN_CLOSED] THEN MESON_TAC[]);; + +let CLOSED_SUBSET = prove + (`!s t:real^N->bool. + s SUBSET t /\ closed s ==> closed_in (subtopology euclidean t) s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `s:real^N->bool` THEN ASM SET_TAC[]);; + +let OPEN_IN_SUBSET_TRANS = prove + (`!s t u:real^N->bool. + open_in (subtopology euclidean u) s /\ s SUBSET t /\ t SUBSET u + ==> open_in (subtopology euclidean t) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let CLOSED_IN_SUBSET_TRANS = prove + (`!s t u:real^N->bool. + closed_in (subtopology euclidean u) s /\ s SUBSET t /\ t SUBSET u + ==> closed_in (subtopology euclidean t) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let open_in = prove + (`!u s:real^N->bool. + open_in (subtopology euclidean u) s <=> + s SUBSET u /\ + !x. x IN s ==> ?e. &0 < e /\ + !x'. x' IN u /\ dist(x',x) < e ==> x' IN s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; GSYM OPEN_IN] THEN EQ_TAC THENL + [REWRITE_TAC[open_def] THEN ASM SET_TAC[INTER_SUBSET; IN_INTER]; + ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `d:real^N->real`) THEN + EXISTS_TAC `UNIONS {b | ?x:real^N. (b = ball(x,d x)) /\ x IN s}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC OPEN_UNIONS THEN + ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM; OPEN_BALL]; + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTER; IN_UNIONS; IN_ELIM_THM] THEN + ASM_MESON_TAC[SUBSET; DIST_REFL; DIST_SYM; IN_BALL]]);; + +let OPEN_IN_CONTAINS_BALL = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean t) s <=> + s SUBSET t /\ + !x. x IN s ==> ?e. &0 < e /\ ball(x,e) INTER t SUBSET s`, + REWRITE_TAC[open_in; INTER; SUBSET; IN_ELIM_THM; IN_BALL] THEN + MESON_TAC[DIST_SYM]);; + +let OPEN_IN_CONTAINS_CBALL = prove + (`!s t:real^N->bool. + open_in (subtopology euclidean t) s <=> + s SUBSET t /\ + !x. x IN s ==> ?e. &0 < e /\ cball(x,e) INTER t SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_CONTAINS_BALL] THEN + AP_TERM_TAC THEN REWRITE_TAC[IN_BALL; IN_INTER; SUBSET; IN_CBALL] THEN + MESON_TAC[REAL_ARITH `&0 < e ==> &0 < e / &2 /\ (x <= e / &2 ==> x < e)`; + REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* These "transitivity" results are handy too. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_TRANS = prove + (`!s t u. open_in (subtopology euclidean t) s /\ + open_in (subtopology euclidean u) t + ==> open_in (subtopology euclidean u) s`, + ASM_MESON_TAC[OPEN_IN_OPEN; OPEN_IN; OPEN_INTER; INTER_ASSOC]);; + +let OPEN_IN_TRANS_EQ = prove + (`!s t:real^N->bool. + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) t) + <=> open_in (subtopology euclidean s) t`, + MESON_TAC[OPEN_IN_TRANS; OPEN_IN_REFL]);; + +let OPEN_IN_OPEN_TRANS = prove + (`!s t. open_in (subtopology euclidean t) s /\ open t ==> open s`, + REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] OPEN_IN] THEN + REWRITE_TAC[OPEN_IN_TRANS]);; + +let CLOSED_IN_TRANS = prove + (`!s t u. closed_in (subtopology euclidean t) s /\ + closed_in (subtopology euclidean u) t + ==> closed_in (subtopology euclidean u) s`, + ASM_MESON_TAC[CLOSED_IN_CLOSED; CLOSED_IN; CLOSED_INTER; INTER_ASSOC]);; + +let CLOSED_IN_TRANS_EQ = prove + (`!s t:real^N->bool. + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) t) + <=> closed_in (subtopology euclidean s) t`, + MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_REFL]);; + +let CLOSED_IN_CLOSED_TRANS = prove + (`!s t. closed_in (subtopology euclidean t) s /\ closed t ==> closed s`, + REWRITE_TAC[ONCE_REWRITE_RULE[GSYM SUBTOPOLOGY_UNIV] CLOSED_IN] THEN + REWRITE_TAC[CLOSED_IN_TRANS]);; + +let OPEN_IN_SUBTOPOLOGY_INTER_SUBSET = prove + (`!s u v. open_in (subtopology euclidean u) (u INTER s) /\ v SUBSET u + ==> open_in (subtopology euclidean v) (v INTER s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN; LEFT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let OPEN_IN_OPEN_EQ = prove + (`!s t. open s + ==> (open_in (subtopology euclidean s) t <=> open t /\ t SUBSET s)`, + MESON_TAC[OPEN_OPEN_IN_TRANS; OPEN_IN_OPEN_TRANS; open_in]);; + +let CLOSED_IN_CLOSED_EQ = prove + (`!s t. closed s + ==> (closed_in (subtopology euclidean s) t <=> + closed t /\ t SUBSET s)`, + MESON_TAC[CLOSED_SUBSET; CLOSED_IN_CLOSED_TRANS; closed_in; + TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]);; + +(* ------------------------------------------------------------------------- *) +(* Also some invariance theorems for relative topology. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_TRANSLATION_EQ = prove + (`!a s t. open_in (subtopology euclidean (IMAGE (\x. a + x) t)) + (IMAGE (\x. a + x) s) <=> + open_in (subtopology euclidean t) s`, + REWRITE_TAC[open_in] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [OPEN_IN_TRANSLATION_EQ];; + +let CLOSED_IN_TRANSLATION_EQ = prove + (`!a s t. closed_in (subtopology euclidean (IMAGE (\x. a + x) t)) + (IMAGE (\x. a + x) s) <=> + closed_in (subtopology euclidean t) s`, + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [CLOSED_IN_TRANSLATION_EQ];; + +let OPEN_IN_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (open_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) <=> + open_in (subtopology euclidean t) s)`, + REWRITE_TAC[open_in; FORALL_IN_IMAGE; IMP_CONJ; SUBSET] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (SET_RULE + `(!x y. f x = f y ==> x = y) ==> (!x s. f x IN IMAGE f s <=> x IN s)`)) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS) THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B2:real` THEN STRIP_TAC THEN + X_GEN_TAC `B1:real` THEN STRIP_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP LINEAR_SUB) THEN + ASM_REWRITE_TAC[dist; IMP_IMP] THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `e / B1:real`; EXISTS_TAC `e * B2:real`] THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC(REAL_ARITH + `norm(f x) <= B1 * norm(x) /\ norm(x) * B1 < e ==> norm(f x) < e`) THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]; + MATCH_MP_TAC(REAL_ARITH + `norm x <= norm (f x :real^N) / B2 /\ norm(f x) / B2 < e + ==> norm x < e`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ]]);; + +add_linear_invariants [OPEN_IN_INJECTIVE_LINEAR_IMAGE];; + +let CLOSED_IN_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (closed_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) <=> + closed_in (subtopology euclidean t) s)`, + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [CLOSED_IN_INJECTIVE_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Connectedness. *) +(* ------------------------------------------------------------------------- *) + +let connected = new_definition + `connected s <=> + ~(?e1 e2. open e1 /\ open e2 /\ s SUBSET (e1 UNION e2) /\ + (e1 INTER e2 INTER s = {}) /\ + ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`;; + +let CONNECTED_CLOSED = prove + (`!s:real^N->bool. + connected s <=> + ~(?e1 e2. closed e1 /\ closed e2 /\ s SUBSET (e1 UNION e2) /\ + (e1 INTER e2 INTER s = {}) /\ + ~(e1 INTER s = {}) /\ ~(e2 INTER s = {}))`, + GEN_TAC THEN REWRITE_TAC[connected] THEN AP_TERM_TAC THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`(:real^N) DIFF v`; `(:real^N) DIFF u`] THEN + ASM_REWRITE_TAC[GSYM closed; GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; + +let CONNECTED_OPEN_IN = prove + (`!s. connected s <=> + ~(?e1 e2. + open_in (subtopology euclidean s) e1 /\ + open_in (subtopology euclidean s) e2 /\ + s SUBSET e1 UNION e2 /\ + e1 INTER e2 = {} /\ + ~(e1 = {}) /\ + ~(e2 = {}))`, + GEN_TAC THEN REWRITE_TAC[connected; OPEN_IN_OPEN] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN + AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + SET_TAC[]);; + +let CONNECTED_OPEN_IN_EQ = prove + (`!s. connected s <=> + ~(?e1 e2. + open_in (subtopology euclidean s) e1 /\ + open_in (subtopology euclidean s) e2 /\ + e1 UNION e2 = s /\ e1 INTER e2 = {} /\ + ~(e1 = {}) /\ ~(e2 = {}))`, + GEN_TAC THEN REWRITE_TAC[CONNECTED_OPEN_IN] THEN + AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[OPEN_IN_CLOSED_IN_EQ; + TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THEN + ASM SET_TAC[]);; + +let CONNECTED_CLOSED_IN = prove + (`!s. connected s <=> + ~(?e1 e2. + closed_in (subtopology euclidean s) e1 /\ + closed_in (subtopology euclidean s) e2 /\ + s SUBSET e1 UNION e2 /\ + e1 INTER e2 = {} /\ + ~(e1 = {}) /\ + ~(e2 = {}))`, + GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOSED; CLOSED_IN_CLOSED] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + CONV_TAC(ONCE_DEPTH_CONV UNWIND_CONV) THEN + AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + SET_TAC[]);; + +let CONNECTED_CLOSED_IN_EQ = prove + (`!s. connected s <=> + ~(?e1 e2. + closed_in (subtopology euclidean s) e1 /\ + closed_in (subtopology euclidean s) e2 /\ + + e1 UNION e2 = s /\ e1 INTER e2 = {} /\ + ~(e1 = {}) /\ ~(e2 = {}))`, + GEN_TAC THEN REWRITE_TAC[CONNECTED_CLOSED_IN] THEN + AP_TERM_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]) THEN + ASM SET_TAC[]);; + +let CONNECTED_CLOPEN = prove + (`!s. connected s <=> + !t. open_in (subtopology euclidean s) t /\ + closed_in (subtopology euclidean s) t ==> t = {} \/ t = s`, + GEN_TAC THEN REWRITE_TAC[connected; OPEN_IN_OPEN; CLOSED_IN_CLOSED] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o BINDER_CONV) [GSYM EXISTS_DIFF] THEN + ONCE_REWRITE_TAC[TAUT `(~a <=> b) <=> (a <=> ~b)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c /\ d <=> b /\ a /\ c /\ d`] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN REWRITE_TAC[GSYM closed] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[TAUT `(a /\ b) /\ (c /\ d) /\ e <=> a /\ c /\ b /\ d /\ e`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; + +let CONNECTED_CLOSED_SET = prove + (`!s:real^N->bool. + closed s + ==> (connected s <=> + ~(?e1 e2. closed e1 /\ closed e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\ + e1 UNION e2 = s /\ e1 INTER e2 = {}))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[CONNECTED_CLOSED; CONTRAPOS_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[] THEN SET_TAC[]; + REWRITE_TAC[CONNECTED_CLOSED_IN; CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[CLOSED_IN_CLOSED; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN + MAP_EVERY X_GEN_TAC + [`e1:real^N->bool`; `e2:real^N->bool`; + `u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN MAP_EVERY (C UNDISCH_THEN SUBST_ALL_TAC) + [`e1:real^N->bool = s INTER u`; + `e2:real^N->bool = s INTER v`] THEN + MAP_EVERY EXISTS_TAC + [`s INTER u:real^N->bool`; `s INTER v:real^N->bool`] THEN + ASM_SIMP_TAC[CLOSED_INTER] THEN ASM SET_TAC[]]);; + +let CONNECTED_OPEN_SET = prove + (`!s:real^N->bool. + open s + ==> (connected s <=> + ~(?e1 e2. open e1 /\ open e2 /\ ~(e1 = {}) /\ ~(e2 = {}) /\ + e1 UNION e2 = s /\ e1 INTER e2 = {}))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[connected; CONTRAPOS_THM] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + SIMP_TAC[] THEN SET_TAC[]; + REWRITE_TAC[CONNECTED_OPEN_IN; CONTRAPOS_THM; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[OPEN_IN_OPEN; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REWRITE_TAC[IMP_IMP] THEN + MAP_EVERY X_GEN_TAC + [`e1:real^N->bool`; `e2:real^N->bool`; + `u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN MAP_EVERY (C UNDISCH_THEN SUBST_ALL_TAC) + [`e1:real^N->bool = s INTER u`; + `e2:real^N->bool = s INTER v`] THEN + MAP_EVERY EXISTS_TAC + [`s INTER u:real^N->bool`; `s INTER v:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]]);; + +let CONNECTED_EMPTY = prove + (`connected {}`, + REWRITE_TAC[connected; INTER_EMPTY]);; + +let CONNECTED_SING = prove + (`!a. connected{a}`, + REWRITE_TAC[connected] THEN SET_TAC[]);; + +let CONNECTED_UNIONS = prove + (`!P:(real^N->bool)->bool. + (!s. s IN P ==> connected s) /\ ~(INTERS P = {}) + ==> connected(UNIONS P)`, + GEN_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`e1:real^N->bool`; `e2:real^N->bool`] THEN + STRIP_TAC THEN UNDISCH_TAC `~(INTERS P :real^N->bool = {})` THEN + PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTERS] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(a:real^N) IN e1 \/ a IN e2` STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; + UNDISCH_TAC `~(e2 INTER UNIONS P:real^N->bool = {})`; + UNDISCH_TAC `~(e1 INTER UNIONS P:real^N->bool = {})`] THEN + PURE_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `!t:real^N->bool. t IN P ==> a IN t` THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`e1:real^N->bool`; `e2:real^N->bool`]) THEN + ASM SET_TAC[]);; + +let CONNECTED_UNION = prove + (`!s t:real^N->bool. + connected s /\ connected t /\ ~(s INTER t = {}) + ==> connected (s UNION t)`, + REWRITE_TAC[GSYM UNIONS_2; GSYM INTERS_2] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN + ASM SET_TAC[]);; + +let CONNECTED_DIFF_OPEN_FROM_CLOSED = prove + (`!s t u:real^N->bool. + s SUBSET t /\ t SUBSET u /\ + open s /\ closed t /\ connected u /\ connected(t DIFF s) + ==> connected(u DIFF s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN STRIP_TAC THEN + UNDISCH_TAC `connected(t DIFF s:real^N->bool)` THEN SIMP_TAC[connected] THEN + MAP_EVERY EXISTS_TAC [`v:real^N->bool`; `w:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`v:real^N->bool`; `w:real^N->bool`] THEN + MATCH_MP_TAC(MESON[] + `(!v w. P v w ==> P w v) /\ (!w v. P v w /\ Q w ==> F) + ==> !w v. P v w ==> ~(Q v) /\ ~(Q w)`) THEN + CONJ_TAC THENL [SIMP_TAC[CONJ_ACI; INTER_ACI; UNION_ACI]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN SIMP_TAC[] THEN + MAP_EVERY EXISTS_TAC [`v UNION s:real^N->bool`; `w DIFF t:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_UNION; OPEN_DIFF] THEN ASM SET_TAC[]);; + +let CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE = prove + (`!f:(real^N->bool)->bool f'. + pairwise DISJOINT f /\ pairwise DISJOINT f' /\ + (!s. s IN f ==> open s /\ connected s /\ ~(s = {})) /\ + (!s. s IN f' ==> open s /\ connected s /\ ~(s = {})) /\ + UNIONS f = UNIONS f' + ==> f = f'`, + GEN_REWRITE_TAC (funpow 2 BINDER_CONV o RAND_CONV) [EXTENSION] THEN + MATCH_MP_TAC(MESON[] + `(!s t. P s t ==> P t s) /\ (!s t x. P s t /\ x IN s ==> x IN t) + ==> (!s t. P s t ==> (!x. x IN s <=> x IN t))`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?t a:real^N. t IN f' /\ a IN s /\ a IN t` STRIP_ASSUME_TAC + THENL [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) + [`s:real^N->bool`; `t:real^N->bool`; + `f:(real^N->bool)->bool`; `f':(real^N->bool)->bool`] THEN + MATCH_MP_TAC(MESON[] + `(!f f' s t. P f f' s t ==> P f' f t s) /\ + (!f f' s t x. P f f' s t /\ x IN s ==> x IN t) + ==> (!f' f t s. P f f' s t ==> (!x. x IN s <=> x IN t))`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REPLICATE_TAC 4 GEN_TAC THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + UNDISCH_TAC + `!s:real^N->bool. s IN f ==> open s /\ connected s /\ ~(s = {})` THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_CASES_TAC `(b:real^N) IN t` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `connected(s:real^N->bool)` THEN + REWRITE_TAC[connected] THEN + MAP_EVERY EXISTS_TAC + [`t:real^N->bool`; `UNIONS(f' DELETE (t:real^N->bool))`] THEN + REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[]; + MATCH_MP_TAC OPEN_UNIONS THEN ASM_SIMP_TAC[IN_DELETE]; + REWRITE_TAC[GSYM UNIONS_INSERT] THEN ASM SET_TAC[]; + MATCH_MP_TAC(SET_RULE `t INTER u = {} ==> t INTER u INTER s = {}`) THEN + REWRITE_TAC[INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_DELETE; GSYM DISJOINT] THEN ASM_MESON_TAC[pairwise]; + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let CONNECTED_FROM_CLOSED_UNION_AND_INTER = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ connected(s UNION t) /\ connected(s INTER t) + ==> connected s /\ connected t`, + MATCH_MP_TAC(MESON[] + `(!s t. P s t ==> P t s) /\ (!s t. P s t ==> Q s) + ==> !s t. P s t ==> Q s /\ Q t`) THEN + CONJ_TAC THENL [SIMP_TAC[UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC] THEN + ASM_SIMP_TAC[CONNECTED_CLOSED_SET] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN ASM_CASES_TAC + `~(s INTER t SUBSET (u:real^N->bool)) /\ ~(s INTER t SUBSET v)` + THENL + [UNDISCH_TAC `connected(s INTER t:real^N->bool)` THEN + ASM_SIMP_TAC[CONNECTED_CLOSED] THEN + MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + UNDISCH_TAC `connected(s UNION t:real^N->bool)` THEN + ASM_SIMP_TAC[CONNECTED_CLOSED] THENL + [MAP_EVERY EXISTS_TAC [`t UNION u:real^N->bool`; `v:real^N->bool`] THEN + ASM_SIMP_TAC[CLOSED_UNION] THEN ASM SET_TAC[]; + MAP_EVERY EXISTS_TAC [`t UNION v:real^N->bool`; `u:real^N->bool`] THEN + ASM_SIMP_TAC[CLOSED_UNION] THEN ASM SET_TAC[]]]);; + +let CONNECTED_FROM_OPEN_UNION_AND_INTER = prove + (`!s t:real^N->bool. + open s /\ open t /\ connected(s UNION t) /\ connected(s INTER t) + ==> connected s /\ connected t`, + MATCH_MP_TAC(MESON[] + `(!s t. P s t ==> P t s) /\ (!s t. P s t ==> Q s) + ==> !s t. P s t ==> Q s /\ Q t`) THEN + CONJ_TAC THENL [SIMP_TAC[UNION_COMM; INTER_COMM]; REPEAT STRIP_TAC] THEN + ASM_SIMP_TAC[CONNECTED_OPEN_SET] THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + STRIP_TAC THEN ASM_CASES_TAC + `~(s INTER t SUBSET (u:real^N->bool)) /\ ~(s INTER t SUBSET v)` + THENL + [UNDISCH_TAC `connected(s INTER t:real^N->bool)` THEN + ASM_SIMP_TAC[connected] THEN + MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + UNDISCH_TAC `connected(s UNION t:real^N->bool)` THEN + ASM_SIMP_TAC[connected] THENL + [MAP_EVERY EXISTS_TAC [`t UNION u:real^N->bool`; `v:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_UNION] THEN ASM SET_TAC[]; + MAP_EVERY EXISTS_TAC [`t UNION v:real^N->bool`; `u:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_UNION] THEN ASM SET_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Sort of induction principle for connected sets. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_INDUCTION = prove + (`!P Q s:real^N->bool. + connected s /\ + (!t a. open_in (subtopology euclidean s) t /\ a IN t + ==> ?z. z IN t /\ P z) /\ + (!a. a IN s + ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ + !x y. x IN t /\ y IN t /\ P x /\ P y /\ Q x ==> Q y) + ==> !a b. a IN s /\ b IN s /\ P a /\ P b /\ Q a ==> Q b`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`{b:real^N | ?t. open_in (subtopology euclidean s) t /\ b IN t /\ + !x. x IN t /\ P x ==> Q x}`; + `{b:real^N | ?t. open_in (subtopology euclidean s) t /\ b IN t /\ + !x. x IN t /\ P x ==> ~(Q x)}`] THEN + REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `c:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `c:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN + X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ASM SET_TAC[]; + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_ELIM_THM] THEN + X_GEN_TAC `c:real^N` THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`t INTER u:real^N->bool`; `c:real^N`]) THEN + ASM_SIMP_TAC[OPEN_IN_INTER] THEN ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let CONNECTED_EQUIVALENCE_RELATION_GEN = prove + (`!P R s:real^N->bool. + connected s /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!t a. open_in (subtopology euclidean s) t /\ a IN t + ==> ?z. z IN t /\ P z) /\ + (!a. a IN s + ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ + !x y. x IN t /\ y IN t /\ P x /\ P y ==> R x y) + ==> !a b. a IN s /\ b IN s /\ P a /\ P b ==> R a b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!a:real^N. a IN s /\ P a + ==> !b c. b IN s /\ c IN s /\ P b /\ P c /\ R a b ==> R a c` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION THEN + ASM_MESON_TAC[]);; + +let CONNECTED_INDUCTION_SIMPLE = prove + (`!P s:real^N->bool. + connected s /\ + (!a. a IN s + ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ + !x y. x IN t /\ y IN t /\ P x ==> P y) + ==> !a b. a IN s /\ b IN s /\ P a ==> P b`, + MP_TAC(ISPEC `\x:real^N. T` CONNECTED_INDUCTION) THEN + REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN MESON_TAC[]);; + +let CONNECTED_EQUIVALENCE_RELATION = prove + (`!R s:real^N->bool. + connected s /\ + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!a. a IN s + ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ + !x. x IN t ==> R a x) + ==> !a b. a IN s /\ b IN s ==> R a b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!a:real^N. a IN s ==> !b c. b IN s /\ c IN s /\ R a b ==> R a c` + MP_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CONNECTED_INDUCTION_SIMPLE THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Limit points. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("limit_point_of",(12,"right"));; + +let limit_point_of = new_definition + `x limit_point_of s <=> + !t. x IN t /\ open t ==> ?y. ~(y = x) /\ y IN s /\ y IN t`;; + +let LIMPT_SUBSET = prove + (`!x s t. x limit_point_of s /\ s SUBSET t ==> x limit_point_of t`, + REWRITE_TAC[limit_point_of; SUBSET] THEN MESON_TAC[]);; + +let LIMPT_APPROACHABLE = prove + (`!x s. x limit_point_of s <=> + !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN + MESON_TAC[open_def; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; IN_BALL]);; + +let LIMPT_APPROACHABLE_LE = prove + (`!x s. x limit_point_of s <=> + !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`; APPROACHABLE_LT_LE]);; + +let LIMPT_UNIV = prove + (`!x:real^N. x limit_point_of UNIV`, + GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `?c:real^N. norm(c) = e / &2` CHOOSE_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE; REAL_HALF; REAL_LT_IMP_LE]; + ALL_TAC] THEN + EXISTS_TAC `x + c:real^N` THEN + REWRITE_TAC[dist; VECTOR_EQ_ADDR] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB] THEN + SUBGOAL_THEN `&0 < e / &2 /\ e / &2 < e` + (fun th -> ASM_MESON_TAC[th; NORM_0; REAL_LT_REFL]) THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +let CLOSED_LIMPT = prove + (`!s. closed s <=> !x. x limit_point_of s ==> x IN s`, + REWRITE_TAC[closed] THEN ONCE_REWRITE_TAC[OPEN_SUBOPEN] THEN + REWRITE_TAC[limit_point_of; IN_DIFF; IN_UNIV; SUBSET] THEN MESON_TAC[]);; + +let LIMPT_EMPTY = prove + (`!x. ~(x limit_point_of {})`, + REWRITE_TAC[LIMPT_APPROACHABLE; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);; + +let NO_LIMIT_POINT_IMP_CLOSED = prove + (`!s. ~(?x. x limit_point_of s) ==> closed s`, + MESON_TAC[CLOSED_LIMPT]);; + +let CLOSED_POSITIVE_ORTHANT = prove + (`closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> &0 <= x$i}`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `--(x:real^N $ i)`) THEN + ASM_REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; NOT_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `!b. abs x <= b /\ b <= a ==> ~(a + x < &0)`) THEN + EXISTS_TAC `abs((y - x :real^N)$i)` THEN + ASM_SIMP_TAC[dist; COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH + `x < &0 /\ &0 <= y ==> abs(x) <= abs(y - x)`]);; + +let FINITE_SET_AVOID = prove + (`!a:real^N s. FINITE s + ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `x:real^N = a` THEN REWRITE_TAC[IN_INSERT] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `min d (dist(a:real^N,x))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_MIN_LE] THEN + ASM_MESON_TAC[REAL_LE_REFL]);; + +let LIMIT_POINT_FINITE = prove + (`!s a. FINITE s ==> ~(a limit_point_of s)`, + REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LE] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LE; + REAL_NOT_LT; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + MESON_TAC[FINITE_SET_AVOID; DIST_SYM]);; + +let LIMPT_SING = prove + (`!x y:real^N. ~(x limit_point_of {y})`, + SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING]);; + +let LIMIT_POINT_UNION = prove + (`!s t x:real^N. x limit_point_of (s UNION t) <=> + x limit_point_of s \/ x limit_point_of t`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[LIMPT_SUBSET; SUBSET_UNION]] THEN + REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNION] THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `(~a ==> b) ==> a \/ b`) THEN + REWRITE_TAC[NOT_FORALL_THM; LEFT_IMP_EXISTS_THM; NOT_IMP] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min d e`) THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +let LIMPT_INSERT = prove + (`!s x y:real^N. x limit_point_of (y INSERT s) <=> x limit_point_of s`, + ONCE_REWRITE_TAC[SET_RULE `y INSERT s = {y} UNION s`] THEN + REWRITE_TAC[LIMIT_POINT_UNION] THEN + SIMP_TAC[FINITE_SING; LIMIT_POINT_FINITE]);; + +let LIMPT_OF_LIMPTS = prove + (`!x:real^N s. + x limit_point_of {y | y limit_point_of s} ==> x limit_point_of s`, + REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `dist(y:real^N,x)`) THEN + ASM_SIMP_TAC[DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let CLOSED_LIMPTS = prove + (`!s. closed {x:real^N | x limit_point_of s}`, + REWRITE_TAC[CLOSED_LIMPT; IN_ELIM_THM; LIMPT_OF_LIMPTS]);; + +let DISCRETE_IMP_CLOSED = prove + (`!s:real^N->bool e. + &0 < e /\ + (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) + ==> closed s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!x:real^N. ~(x limit_point_of s)` + (fun th -> MESON_TAC[th; CLOSED_LIMPT]) THEN + GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN + REWRITE_TAC[REAL_HALF; ASSUME `&0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min (e / &2) (dist(x:real^N,y))`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; DIST_POS_LT; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[] THEN ASM_NORM_ARITH_TAC);; + +let LIMPT_OF_UNIV = prove + (`!x. x limit_point_of (:real^N)`, + GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `e / &2`] VECTOR_CHOOSE_DIST) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH);; + +let LIMPT_OF_OPEN_IN = prove + (`!s t x:real^N. + open_in (subtopology euclidean s) t /\ x limit_point_of s /\ x IN t + ==> x limit_point_of t`, + REWRITE_TAC[open_in; SUBSET; LIMPT_APPROACHABLE] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +let LIMPT_OF_OPEN = prove + (`!s x:real^N. open s /\ x IN s ==> x limit_point_of s`, + REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + MESON_TAC[LIMPT_OF_OPEN_IN; LIMPT_OF_UNIV]);; + +let OPEN_IN_SING = prove + (`!s a. open_in (subtopology euclidean s) {a} <=> + a IN s /\ ~(a limit_point_of s)`, + REWRITE_TAC[open_in; LIMPT_APPROACHABLE; SING_SUBSET; IN_SING] THEN + REWRITE_TAC[FORALL_UNWIND_THM2] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Interior of a set. *) +(* ------------------------------------------------------------------------- *) + +let interior = new_definition + `interior s = {x | ?t. open t /\ x IN t /\ t SUBSET s}`;; + +let INTERIOR_EQ = prove + (`!s. (interior s = s) <=> open s`, + GEN_TAC THEN REWRITE_TAC[EXTENSION; interior; IN_ELIM_THM] THEN + GEN_REWRITE_TAC RAND_CONV [OPEN_SUBOPEN] THEN MESON_TAC[SUBSET]);; + +let INTERIOR_OPEN = prove + (`!s. open s ==> (interior s = s)`, + MESON_TAC[INTERIOR_EQ]);; + +let INTERIOR_EMPTY = prove + (`interior {} = {}`, + SIMP_TAC[INTERIOR_OPEN; OPEN_EMPTY]);; + +let INTERIOR_UNIV = prove + (`interior(:real^N) = (:real^N)`, + SIMP_TAC[INTERIOR_OPEN; OPEN_UNIV]);; + +let OPEN_INTERIOR = prove + (`!s. open(interior s)`, + GEN_TAC THEN REWRITE_TAC[interior] THEN GEN_REWRITE_TAC I [OPEN_SUBOPEN] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INTERIOR_INTERIOR = prove + (`!s. interior(interior s) = interior s`, + MESON_TAC[INTERIOR_EQ; OPEN_INTERIOR]);; + +let INTERIOR_SUBSET = prove + (`!s. (interior s) SUBSET s`, + REWRITE_TAC[SUBSET; interior; IN_ELIM_THM] THEN MESON_TAC[]);; + +let SUBSET_INTERIOR = prove + (`!s t. s SUBSET t ==> (interior s) SUBSET (interior t)`, + REWRITE_TAC[interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INTERIOR_MAXIMAL = prove + (`!s t. t SUBSET s /\ open t ==> t SUBSET (interior s)`, + REWRITE_TAC[interior; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INTERIOR_MAXIMAL_EQ = prove + (`!s t:real^N->bool. open s ==> (s SUBSET interior t <=> s SUBSET t)`, + MESON_TAC[INTERIOR_MAXIMAL; SUBSET_TRANS; INTERIOR_SUBSET]);; + +let INTERIOR_UNIQUE = prove + (`!s t. t SUBSET s /\ open t /\ (!t'. t' SUBSET s /\ open t' ==> t' SUBSET t) + ==> (interior s = t)`, + MESON_TAC[SUBSET_ANTISYM; INTERIOR_MAXIMAL; INTERIOR_SUBSET; + OPEN_INTERIOR]);; + +let IN_INTERIOR = prove + (`!x s. x IN interior s <=> ?e. &0 < e /\ ball(x,e) SUBSET s`, + REWRITE_TAC[interior; IN_ELIM_THM] THEN + MESON_TAC[OPEN_CONTAINS_BALL; SUBSET_TRANS; CENTRE_IN_BALL; OPEN_BALL]);; + +let OPEN_SUBSET_INTERIOR = prove + (`!s t. open s ==> (s SUBSET interior t <=> s SUBSET t)`, + MESON_TAC[INTERIOR_MAXIMAL; INTERIOR_SUBSET; SUBSET_TRANS]);; + +let INTERIOR_INTER = prove + (`!s t:real^N->bool. interior(s INTER t) = interior s INTER interior t`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET_INTER] THEN CONJ_TAC THEN + MATCH_MP_TAC SUBSET_INTERIOR THEN REWRITE_TAC[INTER_SUBSET]; + MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_INTER; OPEN_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' ==> s INTER t SUBSET s' INTER t'`) THEN + REWRITE_TAC[INTERIOR_SUBSET]]);; + +let INTERIOR_FINITE_INTERS = prove + (`!s:(real^N->bool)->bool. + FINITE s ==> interior(INTERS s) = INTERS(IMAGE interior s)`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[INTERS_0; INTERS_INSERT; INTERIOR_UNIV; IMAGE_CLAUSES] THEN + SIMP_TAC[INTERIOR_INTER]);; + +let INTERIOR_INTERS_SUBSET = prove + (`!f. interior(INTERS f) SUBSET INTERS (IMAGE interior f)`, + REWRITE_TAC[SUBSET; IN_INTERIOR; IN_INTERS; FORALL_IN_IMAGE] THEN + MESON_TAC[]);; + +let UNION_INTERIOR_SUBSET = prove + (`!s t:real^N->bool. + interior s UNION interior t SUBSET interior(s UNION t)`, + SIMP_TAC[INTERIOR_MAXIMAL_EQ; OPEN_UNION; OPEN_INTERIOR] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t SUBSET t' ==> (s UNION t) SUBSET (s' UNION t')`) THEN + REWRITE_TAC[INTERIOR_SUBSET]);; + +let INTERIOR_EQ_EMPTY = prove + (`!s:real^N->bool. interior s = {} <=> !t. open t /\ t SUBSET s ==> t = {}`, + MESON_TAC[INTERIOR_MAXIMAL_EQ; SUBSET_EMPTY; + OPEN_INTERIOR; INTERIOR_SUBSET]);; + +let INTERIOR_EQ_EMPTY_ALT = prove + (`!s:real^N->bool. + interior s = {} <=> + !t. open t /\ ~(t = {}) ==> ~(t DIFF s = {})`, + GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN SET_TAC[]);; + +let INTERIOR_LIMIT_POINT = prove + (`!s x:real^N. x IN interior s ==> x limit_point_of s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IN_INTERIOR; IN_ELIM_THM; SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `d:real` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `min d e / &2`] VECTOR_CHOOSE_DIST) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC; + CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM DIST_EQ_0]; + ONCE_REWRITE_TAC[DIST_SYM]] THEN + ASM_REAL_ARITH_TAC);; + +let INTERIOR_SING = prove + (`!a:real^N. interior {a} = {}`, + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + MESON_TAC[INTERIOR_LIMIT_POINT; LIMPT_SING]);; + +let INTERIOR_CLOSED_UNION_EMPTY_INTERIOR = prove + (`!s t:real^N->bool. + closed(s) /\ interior(t) = {} + ==> interior(s UNION t) = interior(s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET_INTERIOR; SUBSET_UNION] THEN + REWRITE_TAC[SUBSET; IN_INTERIOR; IN_INTER; IN_UNION] THEN + X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `(y:real^N) limit_point_of s` + (fun th -> ASM_MESON_TAC[CLOSED_LIMPT; th]) THEN + REWRITE_TAC[IN_INTERIOR; NOT_IN_EMPTY; LIMPT_APPROACHABLE] THEN + X_GEN_TAC `d:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?z:real^N. ~(z IN t) /\ ~(z = y) /\ dist(z,y) < d /\ dist(x,z) < e` + (fun th -> ASM_MESON_TAC[th; IN_BALL]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[IN_INTERIOR; NOT_IN_EMPTY; NOT_EXISTS_THM] THEN + ABBREV_TAC `k = min d (e - dist(x:real^N,y))` THEN + SUBGOAL_THEN `&0 < k` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `?w:real^N. dist(y,w) = k / &2` CHOOSE_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_HALF; REAL_LT_IMP_LE]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`w:real^N`; `k / &4`]) THEN + ASM_SIMP_TAC[SUBSET; NOT_FORALL_THM; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; + NOT_IMP; IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_NORM_ARITH_TAC);; + +let INTERIOR_UNION_EQ_EMPTY = prove + (`!s t:real^N->bool. + closed s \/ closed t + ==> (interior(s UNION t) = {} <=> + interior s = {} /\ interior t = {})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[SUBSET_UNION; SUBSET_INTERIOR; SUBSET_EMPTY]; + ASM_MESON_TAC[UNION_COMM; INTERIOR_CLOSED_UNION_EMPTY_INTERIOR]]);; + +let INTERIOR_UNIONS_OPEN_SUBSETS = prove + (`!s:real^N->bool. UNIONS {t | open t /\ t SUBSET s} = interior s`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN + SIMP_TAC[OPEN_UNIONS; IN_ELIM_THM] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Closure of a set. *) +(* ------------------------------------------------------------------------- *) + +let closure = new_definition + `closure s = s UNION {x | x limit_point_of s}`;; + +let CLOSURE_INTERIOR = prove + (`!s:real^N->bool. closure s = UNIV DIFF (interior (UNIV DIFF s))`, + REWRITE_TAC[EXTENSION; closure; IN_UNION; IN_DIFF; IN_UNIV; interior; + IN_ELIM_THM; limit_point_of; SUBSET] THEN + MESON_TAC[]);; + +let INTERIOR_CLOSURE = prove + (`!s:real^N->bool. interior s = UNIV DIFF (closure (UNIV DIFF s))`, + let lemma = prove(`!s t. UNIV DIFF (UNIV DIFF t) = t`,SET_TAC[]) in + REWRITE_TAC[CLOSURE_INTERIOR; lemma]);; + +let CLOSED_CLOSURE = prove + (`!s. closed(closure s)`, + let lemma = prove(`UNIV DIFF (UNIV DIFF s) = s`,SET_TAC[]) in + REWRITE_TAC[closed; CLOSURE_INTERIOR; lemma; OPEN_INTERIOR]);; + +let CLOSURE_HULL = prove + (`!s. closure s = closed hull s`, + GEN_TAC THEN MATCH_MP_TAC(GSYM HULL_UNIQUE) THEN + REWRITE_TAC[CLOSED_CLOSURE; SUBSET] THEN + REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; CLOSED_LIMPT] THEN + MESON_TAC[limit_point_of]);; + +let CLOSURE_EQ = prove + (`!s. (closure s = s) <=> closed s`, + SIMP_TAC[CLOSURE_HULL; HULL_EQ; CLOSED_INTERS]);; + +let CLOSURE_CLOSED = prove + (`!s. closed s ==> (closure s = s)`, + MESON_TAC[CLOSURE_EQ]);; + +let CLOSURE_CLOSURE = prove + (`!s. closure(closure s) = closure s`, + REWRITE_TAC[CLOSURE_HULL; HULL_HULL]);; + +let CLOSURE_SUBSET = prove + (`!s. s SUBSET (closure s)`, + REWRITE_TAC[CLOSURE_HULL; HULL_SUBSET]);; + +let SUBSET_CLOSURE = prove + (`!s t. s SUBSET t ==> (closure s) SUBSET (closure t)`, + REWRITE_TAC[CLOSURE_HULL; HULL_MONO]);; + +let CLOSURE_UNION = prove + (`!s t:real^N->bool. closure(s UNION t) = closure s UNION closure t`, + REWRITE_TAC[LIMIT_POINT_UNION; closure] THEN SET_TAC[]);; + +let CLOSURE_INTER_SUBSET = prove + (`!s t. closure(s INTER t) SUBSET closure(s) INTER closure(t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET_INTER] THEN + CONJ_TAC THEN MATCH_MP_TAC SUBSET_CLOSURE THEN SET_TAC[]);; + +let CLOSURE_INTERS_SUBSET = prove + (`!f. closure(INTERS f) SUBSET INTERS(IMAGE closure f)`, + REWRITE_TAC[SET_RULE `s SUBSET INTERS f <=> !t. t IN f ==> s SUBSET t`] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN ASM SET_TAC[]);; + +let CLOSURE_MINIMAL = prove + (`!s t. s SUBSET t /\ closed t ==> (closure s) SUBSET t`, + REWRITE_TAC[HULL_MINIMAL; CLOSURE_HULL]);; + +let CLOSURE_MINIMAL_EQ = prove + (`!s t:real^N->bool. closed t ==> (closure s SUBSET t <=> s SUBSET t)`, + MESON_TAC[SUBSET_TRANS; CLOSURE_SUBSET; CLOSURE_MINIMAL]);; + +let CLOSURE_UNIQUE = prove + (`!s t. s SUBSET t /\ closed t /\ + (!t'. s SUBSET t' /\ closed t' ==> t SUBSET t') + ==> (closure s = t)`, + REWRITE_TAC[CLOSURE_HULL; HULL_UNIQUE]);; + +let CLOSURE_EMPTY = prove + (`closure {} = {}`, + SIMP_TAC[CLOSURE_CLOSED; CLOSED_EMPTY]);; + +let CLOSURE_UNIV = prove + (`closure(:real^N) = (:real^N)`, + SIMP_TAC[CLOSURE_CLOSED; CLOSED_UNIV]);; + +let CLOSURE_UNIONS = prove + (`!f. FINITE f ==> closure(UNIONS f) = UNIONS {closure s | s IN f}`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; SET_RULE `{f x | x IN {}} = {}`; + SET_RULE `{f x | x IN a INSERT s} = (f a) INSERT {f x | x IN s}`] THEN + SIMP_TAC[CLOSURE_EMPTY; CLOSURE_UNION]);; + +let CLOSURE_EQ_EMPTY = prove + (`!s. closure s = {} <=> s = {}`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CLOSURE_EMPTY] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> t = {} ==> s = {}`) THEN + REWRITE_TAC[CLOSURE_SUBSET]);; + +let CLOSURE_SUBSET_EQ = prove + (`!s:real^N->bool. closure s SUBSET s <=> closed s`, + GEN_TAC THEN REWRITE_TAC[GSYM CLOSURE_EQ] THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]);; + +let OPEN_INTER_CLOSURE_EQ_EMPTY = prove + (`!s t:real^N->bool. + open s ==> (s INTER (closure t) = {} <=> s INTER t = {})`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MP_TAC(ISPEC `t:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s INTER (UNIV DIFF t) = {}`) THEN + ASM_SIMP_TAC[OPEN_SUBSET_INTERIOR] THEN ASM SET_TAC[]);; + +let OPEN_INTER_CLOSURE_SUBSET = prove + (`!s t:real^N->bool. + open s ==> (s INTER (closure t)) SUBSET closure(s INTER t)`, + REPEAT STRIP_TAC THEN + SIMP_TAC[SUBSET; IN_INTER; closure; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + DISJ2_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN + DISCH_THEN(MP_TAC o SPEC `min d e`) THEN + ASM_REWRITE_TAC[REAL_LT_MIN; IN_INTER] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_MESON_TAC[]);; + +let CLOSURE_OPEN_INTER_SUPERSET = prove + (`!s t:real^N->bool. + open s /\ s SUBSET closure t ==> closure(s INTER t) = closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN REWRITE_TAC[CLOSED_CLOSURE] THEN + W(MP_TAC o PART_MATCH (rand o rand) + OPEN_INTER_CLOSURE_SUBSET o rand o snd) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUBSET_TRANS) THEN ASM SET_TAC[]);; + +let CLOSURE_COMPLEMENT = prove + (`!s:real^N->bool. closure(UNIV DIFF s) = UNIV DIFF interior(s)`, + REWRITE_TAC[SET_RULE `s = UNIV DIFF t <=> UNIV DIFF s = t`] THEN + REWRITE_TAC[GSYM INTERIOR_CLOSURE]);; + +let INTERIOR_COMPLEMENT = prove + (`!s:real^N->bool. interior(UNIV DIFF s) = UNIV DIFF closure(s)`, + REWRITE_TAC[SET_RULE `s = UNIV DIFF t <=> UNIV DIFF s = t`] THEN + REWRITE_TAC[GSYM CLOSURE_INTERIOR]);; + +let CONNECTED_INTERMEDIATE_CLOSURE = prove + (`!s t:real^N->bool. + connected s /\ s SUBSET t /\ t SUBSET closure s ==> connected t`, + REPEAT GEN_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN + STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `v:real^N->bool`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^N->bool`; `v:real^N->bool`]) THEN + ASM_REWRITE_TAC[] THEN ASSUME_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[GSYM DE_MORGAN_THM] THEN STRIP_TAC THENL + [SUBGOAL_THEN `(closure s) SUBSET ((:real^N) DIFF u)` MP_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; + ALL_TAC]; + SUBGOAL_THEN `(closure s) SUBSET ((:real^N) DIFF v)` MP_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN ASM_REWRITE_TAC[GSYM OPEN_CLOSED]; + ALL_TAC]] THEN + ASM SET_TAC[]);; + +let CONNECTED_CLOSURE = prove + (`!s:real^N->bool. connected s ==> connected(closure s)`, + MESON_TAC[CONNECTED_INTERMEDIATE_CLOSURE; CLOSURE_SUBSET; SUBSET_REFL]);; + +let CONNECTED_UNION_STRONG = prove + (`!s t:real^N->bool. + connected s /\ connected t /\ ~(closure s INTER t = {}) + ==> connected(s UNION t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `p:real^N`) THEN + SUBGOAL_THEN `s UNION t = ((p:real^N) INSERT s) UNION t` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_UNION THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `s:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let INTERIOR_DIFF = prove + (`!s t. interior(s DIFF t) = interior(s) DIFF closure(t)`, + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + REWRITE_TAC[INTERIOR_INTER; CLOSURE_INTERIOR] THEN SET_TAC[]);; + +let LIMPT_OF_CLOSURE = prove + (`!x:real^N s. x limit_point_of closure s <=> x limit_point_of s`, + REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; LIMIT_POINT_UNION] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN + REWRITE_TAC[LIMPT_OF_LIMPTS]);; + +let CLOSED_IN_LIMPT = prove + (`!s t. closed_in (subtopology euclidean t) s <=> + s SUBSET t /\ !x:real^N. x limit_point_of s /\ x IN t ==> x IN s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[IN_INTER] THEN + ASM_MESON_TAC[CLOSED_LIMPT; LIMPT_SUBSET; INTER_SUBSET]; + STRIP_TAC THEN EXISTS_TAC `closure s :real^N->bool` THEN + REWRITE_TAC[CLOSED_CLOSURE] THEN REWRITE_TAC[closure] THEN + ASM SET_TAC[]]);; + +let CLOSED_IN_INTER_CLOSURE = prove + (`!s t:real^N->bool. + closed_in (subtopology euclidean s) t <=> s INTER closure t = t`, + REWRITE_TAC[closure; CLOSED_IN_LIMPT] THEN SET_TAC[]);; + +let INTERIOR_CLOSURE_IDEMP = prove + (`!s:real^N->bool. + interior(closure(interior(closure s))) = interior(closure s)`, + GEN_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN + ASM_MESON_TAC[OPEN_INTERIOR; CLOSURE_SUBSET; CLOSURE_CLOSURE; SUBSET_TRANS; + OPEN_SUBSET_INTERIOR;SUBSET_CLOSURE; INTERIOR_SUBSET]);; + +let CLOSURE_INTERIOR_IDEMP = prove + (`!s:real^N->bool. + closure(interior(closure(interior s))) = closure(interior s)`, + GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s = t <=> UNIV DIFF s = UNIV DIFF t`] THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; GSYM CLOSURE_COMPLEMENT] THEN + REWRITE_TAC[INTERIOR_CLOSURE_IDEMP]);; + +let NOWHERE_DENSE_UNION = prove + (`!s t:real^N->bool. + interior(closure(s UNION t)) = {} <=> + interior(closure s) = {} /\ interior(closure t) = {}`, + SIMP_TAC[CLOSURE_UNION; INTERIOR_UNION_EQ_EMPTY; CLOSED_CLOSURE]);; + +let NOWHERE_DENSE = prove + (`!s:real^N->bool. + interior(closure s) = {} <=> + !t. open t /\ ~(t = {}) + ==> ?u. open u /\ ~(u = {}) /\ u SUBSET t /\ u INTER s = {}`, + GEN_TAC THEN REWRITE_TAC[INTERIOR_EQ_EMPTY_ALT] THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THENL + [EXISTS_TAC `t DIFF closure s:real^N->bool` THEN + ASM_SIMP_TAC[OPEN_DIFF; CLOSED_CLOSURE] THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] + OPEN_INTER_CLOSURE_EQ_EMPTY) THEN + ASM SET_TAC[]]);; + +let INTERIOR_CLOSURE_INTER_OPEN = prove + (`!s t:real^N->bool. + open s /\ open t + ==> interior(closure(s INTER t)) = + interior(closure s) INTER interior(closure t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE + `u = s INTER t <=> s INTER t SUBSET u /\ u SUBSET s /\ u SUBSET t`] THEN + SIMP_TAC[SUBSET_INTERIOR; SUBSET_CLOSURE; INTER_SUBSET] THEN + MATCH_MP_TAC INTERIOR_MAXIMAL THEN SIMP_TAC[OPEN_INTER; OPEN_INTERIOR] THEN + REWRITE_TAC[SET_RULE `s SUBSET t <=> s INTER (UNIV DIFF t) = {}`; + GSYM INTERIOR_COMPLEMENT] THEN + REWRITE_TAC[GSYM INTERIOR_INTER] THEN + REWRITE_TAC[INTERIOR_EQ_EMPTY] THEN + X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`u INTER s:real^N->bool`; `t:real^N->bool`] + OPEN_INTER_CLOSURE_EQ_EMPTY) THEN + MP_TAC(ISPECL [`u:real^N->bool`; `s:real^N->bool`] + OPEN_INTER_CLOSURE_EQ_EMPTY) THEN + ASM_SIMP_TAC[OPEN_INTER] THEN ASM SET_TAC[]);; + +let CLOSURE_INTERIOR_UNION_CLOSED = prove + (`!s t:real^N->bool. + closed s /\ closed t + ==> closure(interior(s UNION t)) = + closure(interior s) UNION closure(interior t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[closed] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTERIOR_CLOSURE_INTER_OPEN) THEN + REWRITE_TAC[CLOSURE_COMPLEMENT; INTERIOR_COMPLEMENT; + SET_RULE `(UNIV DIFF s) INTER (UNIV DIFF t) = + UNIV DIFF (s UNION t)`] THEN + SET_TAC[]);; + +let REGULAR_OPEN_INTER = prove + (`!s t:real^N->bool. + interior(closure s) = s /\ interior(closure t) = t + ==> interior(closure(s INTER t)) = s INTER t`, + MESON_TAC[INTERIOR_CLOSURE_INTER_OPEN; OPEN_INTERIOR]);; + +let REGULAR_CLOSED_UNION = prove + (`!s t:real^N->bool. + closure(interior s) = s /\ closure(interior t) = t + ==> closure(interior(s UNION t)) = s UNION t`, + MESON_TAC[CLOSURE_INTERIOR_UNION_CLOSED; CLOSED_CLOSURE]);; + +let DIFF_CLOSURE_SUBSET = prove + (`!s t:real^N->bool. closure(s) DIFF closure t SUBSET closure(s DIFF t)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`(:real^N) DIFF closure t`; `s:real^N->bool`] + OPEN_INTER_CLOSURE_SUBSET) THEN + REWRITE_TAC[SET_RULE `(UNIV DIFF t) INTER s = s DIFF t`] THEN + REWRITE_TAC[GSYM closed; CLOSED_CLOSURE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUBSET_TRANS) THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN + MATCH_MP_TAC(SET_RULE `t SUBSET u ==> s DIFF u SUBSET s DIFF t`) THEN + REWRITE_TAC[CLOSURE_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Frontier (aka boundary). *) +(* ------------------------------------------------------------------------- *) + +let frontier = new_definition + `frontier s = (closure s) DIFF (interior s)`;; + +let FRONTIER_CLOSED = prove + (`!s. closed(frontier s)`, + SIMP_TAC[frontier; CLOSED_DIFF; CLOSED_CLOSURE; OPEN_INTERIOR]);; + +let FRONTIER_CLOSURES = prove + (`!s:real^N->bool. frontier s = (closure s) INTER (closure(UNIV DIFF s))`, + let lemma = prove(`s DIFF (UNIV DIFF t) = s INTER t`,SET_TAC[]) in + REWRITE_TAC[frontier; INTERIOR_CLOSURE; lemma]);; + +let FRONTIER_STRADDLE = prove + (`!a:real^N s. + a IN frontier s <=> + !e. &0 < e ==> (?x. x IN s /\ dist(a,x) < e) /\ + (?x. ~(x IN s) /\ dist(a,x) < e)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FRONTIER_CLOSURES; IN_INTER] THEN + REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; limit_point_of; + IN_UNIV; IN_DIFF] THEN + ASM_MESON_TAC[IN_BALL; SUBSET; OPEN_CONTAINS_BALL; + CENTRE_IN_BALL; OPEN_BALL; DIST_REFL]);; + +let FRONTIER_SUBSET_CLOSED = prove + (`!s. closed s ==> (frontier s) SUBSET s`, + MESON_TAC[frontier; CLOSURE_CLOSED; SUBSET_DIFF]);; + +let FRONTIER_EMPTY = prove + (`frontier {} = {}`, + REWRITE_TAC[frontier; CLOSURE_EMPTY; EMPTY_DIFF]);; + +let FRONTIER_UNIV = prove + (`frontier(:real^N) = {}`, + REWRITE_TAC[frontier; CLOSURE_UNIV; INTERIOR_UNIV] THEN SET_TAC[]);; + +let FRONTIER_SUBSET_EQ = prove + (`!s:real^N->bool. (frontier s) SUBSET s <=> closed s`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[FRONTIER_SUBSET_CLOSED] THEN + REWRITE_TAC[frontier] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s DIFF t SUBSET u ==> t SUBSET u ==> s SUBSET u`)) THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET_EQ]);; + +let FRONTIER_COMPLEMENT = prove + (`!s:real^N->bool. frontier(UNIV DIFF s) = frontier s`, + REWRITE_TAC[frontier; CLOSURE_COMPLEMENT; INTERIOR_COMPLEMENT] THEN + SET_TAC[]);; + +let FRONTIER_DISJOINT_EQ = prove + (`!s. (frontier s) INTER s = {} <=> open s`, + ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT; OPEN_CLOSED] THEN + REWRITE_TAC[GSYM FRONTIER_SUBSET_EQ] THEN SET_TAC[]);; + +let FRONTIER_INTER_SUBSET = prove + (`!s t. frontier(s INTER t) SUBSET frontier(s) UNION frontier(t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTER] THEN + MATCH_MP_TAC(SET_RULE + `cst SUBSET cs INTER ct + ==> cst DIFF (s INTER t) SUBSET (cs DIFF s) UNION (ct DIFF t)`) THEN + REWRITE_TAC[CLOSURE_INTER_SUBSET]);; + +let FRONTIER_UNION_SUBSET = prove + (`!s t:real^N->bool. frontier(s UNION t) SUBSET frontier s UNION frontier t`, + ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN + REWRITE_TAC[SET_RULE `u DIFF (s UNION t) = (u DIFF s) INTER (u DIFF t)`] THEN + REWRITE_TAC[FRONTIER_INTER_SUBSET]);; + +let FRONTIER_INTERIORS = prove + (`!s. frontier s = (:real^N) DIFF interior(s) DIFF interior((:real^N) DIFF s)`, + REWRITE_TAC[frontier; CLOSURE_INTERIOR] THEN SET_TAC[]);; + +let FRONTIER_FRONTIER_SUBSET = prove + (`!s:real^N->bool. frontier(frontier s) SUBSET frontier s`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [frontier] THEN + SIMP_TAC[CLOSURE_CLOSED; FRONTIER_CLOSED] THEN SET_TAC[]);; + +let INTERIOR_FRONTIER = prove + (`!s:real^N->bool. + interior(frontier s) = interior(closure s) DIFF closure(interior s)`, + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT; GSYM INTERIOR_INTER; frontier] THEN + GEN_TAC THEN AP_TERM_TAC THEN SET_TAC[]);; + +let INTERIOR_FRONTIER_EMPTY = prove + (`!s:real^N->bool. open s \/ closed s ==> interior(frontier s) = {}`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INTERIOR_FRONTIER] THEN + ASM_SIMP_TAC[CLOSURE_CLOSED; INTERIOR_OPEN] THEN + REWRITE_TAC[SET_RULE `s DIFF t = {} <=> s SUBSET t`] THEN + REWRITE_TAC[INTERIOR_SUBSET; CLOSURE_SUBSET]);; + +let FRONTIER_FRONTIER = prove + (`!s:real^N->bool. open s \/ closed s ==> frontier(frontier s) = frontier s`, + GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [frontier] THEN + SIMP_TAC[INTERIOR_FRONTIER_EMPTY; CLOSURE_CLOSED; FRONTIER_CLOSED] THEN + REWRITE_TAC[DIFF_EMPTY]);; + +let FRONTIER_FRONTIER_FRONTIER = prove + (`!s:real^N->bool. frontier(frontier(frontier s)) = frontier(frontier s)`, + SIMP_TAC[FRONTIER_FRONTIER; FRONTIER_CLOSED]);; + +let UNION_FRONTIER = prove + (`!s t:real^N->bool. + frontier(s) UNION frontier(t) = + frontier(s UNION t) UNION + frontier(s INTER t) UNION + frontier(s) INTER frontier(t)`, + let lemma = prove + (`!s t x. x IN frontier s /\ x IN interior t ==> x IN frontier(s INTER t)`, + REWRITE_TAC[FRONTIER_STRADDLE; IN_INTER; IN_INTERIOR; SUBSET; IN_BALL] THEN + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `d:real`)) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min d e:real`) THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN ASM_MESON_TAC[]) in + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; UNION_SUBSET; + FRONTIER_UNION_SUBSET; FRONTIER_INTER_SUBSET; + SET_RULE `s INTER t SUBSET s UNION t`] THEN + REWRITE_TAC[GSYM UNION_SUBSET] THEN REWRITE_TAC[SUBSET; IN_UNION] THEN + MATCH_MP_TAC(MESON[] + `(!s t x. P s x ==> R x s t) /\ (!s t x. R x s t <=> R x t s) + ==> (!s t x. P s x \/ P t x ==> R x s t)`) THEN + CONJ_TAC THENL [REPEAT STRIP_TAC; REWRITE_TAC[UNION_COMM; INTER_COMM]] THEN + ASM_CASES_TAC `(x:real^N) IN frontier t` THEN ASM_REWRITE_TAC[IN_INTER] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) + [FRONTIER_INTERIORS]) THEN + REWRITE_TAC[DE_MORGAN_THM; IN_DIFF; IN_UNIV] THEN + GEN_REWRITE_TAC RAND_CONV [DISJ_SYM] THEN MATCH_MP_TAC MONO_OR THEN + ASM_SIMP_TAC[lemma] THEN + POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM FRONTIER_COMPLEMENT] THEN + SIMP_TAC[lemma; SET_RULE + `UNIV DIFF (s UNION t) = (UNIV DIFF s) INTER (UNIV DIFF t)`]);; + +let CONNECTED_INTER_FRONTIER = prove + (`!s t:real^N->bool. + connected s /\ ~(s INTER t = {}) /\ ~(s DIFF t = {}) + ==> ~(s INTER frontier t = {})`, + REWRITE_TAC[FRONTIER_INTERIORS] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_OPEN_IN]) THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`s INTER interior t:real^N->bool`; + `s INTER (interior((:real^N) DIFF t))`] THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_INTERIOR] THEN + MAP_EVERY (MP_TAC o C ISPEC INTERIOR_SUBSET) + [`t:real^N->bool`; `(:real^N) DIFF t`] THEN + ASM SET_TAC[]);; + +let INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER = prove + (`!s:real^N->bool. + closed s /\ interior s = {} <=> ?t. open t /\ s = frontier t`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `(:real^N) DIFF s` THEN + ASM_SIMP_TAC[OPEN_DIFF; OPEN_UNIV; FRONTIER_COMPLEMENT] THEN + ASM_SIMP_TAC[frontier; CLOSURE_CLOSED; DIFF_EMPTY]; + ASM_SIMP_TAC[FRONTIER_CLOSED; INTERIOR_FRONTIER_EMPTY]]);; + +let FRONTIER_UNION = prove + (`!s t:real^N->bool. + closure s INTER closure t = {} + ==> frontier(s UNION t) = frontier(s) UNION frontier(t)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[FRONTIER_UNION_SUBSET] THEN + GEN_REWRITE_TAC RAND_CONV [frontier] THEN + REWRITE_TAC[CLOSURE_UNION] THEN MATCH_MP_TAC(SET_RULE + `(fs SUBSET cs /\ ft SUBSET ct) /\ k INTER fs = {} /\ k INTER ft = {} + ==> (fs UNION ft) SUBSET (cs UNION ct) DIFF k`) THEN + CONJ_TAC THENL [REWRITE_TAC[frontier] THEN SET_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[UNION_COMM] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[INTER_COMM])] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `s INTER t = {} ==> s' SUBSET s /\ s' INTER u INTER (UNIV DIFF t) = {} + ==> u INTER s' = {}`)) THEN + REWRITE_TAC[frontier; SUBSET_DIFF; GSYM INTERIOR_COMPLEMENT] THEN + REWRITE_TAC[GSYM INTERIOR_INTER; SET_RULE + `(s UNION t) INTER (UNIV DIFF t) = s DIFF t`] THEN + MATCH_MP_TAC(SET_RULE + `ti SUBSET si ==> (c DIFF si) INTER ti = {}`) THEN + SIMP_TAC[SUBSET_INTERIOR; SUBSET_DIFF]);; + +let CLOSURE_UNION_FRONTIER = prove + (`!s:real^N->bool. closure s = s UNION frontier s`, + GEN_TAC THEN REWRITE_TAC[frontier] THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + SET_TAC[]);; + +let FRONTIER_INTERIOR_SUBSET = prove + (`!s:real^N->bool. frontier(interior s) SUBSET frontier s`, + GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTERIOR] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> s DIFF u SUBSET t DIFF u`) THEN + SIMP_TAC[SUBSET_CLOSURE; INTERIOR_SUBSET]);; + +let FRONTIER_CLOSURE_SUBSET = prove + (`!s:real^N->bool. frontier(closure s) SUBSET frontier s`, + GEN_TAC THEN REWRITE_TAC[frontier; CLOSURE_CLOSURE] THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> u DIFF t SUBSET u DIFF s`) THEN + SIMP_TAC[SUBSET_INTERIOR; CLOSURE_SUBSET]);; + +let SET_DIFF_FRONTIER = prove + (`!s:real^N->bool. s DIFF frontier s = interior s`, + GEN_TAC THEN REWRITE_TAC[frontier] THEN + MP_TAC(ISPEC `s:real^N->bool` INTERIOR_SUBSET) THEN + MP_TAC(ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN + SET_TAC[]);; + +let FRONTIER_INTER_SUBSET_INTER = prove + (`!s t:real^N->bool. + frontier(s INTER t) SUBSET closure s INTER frontier t UNION + frontier s INTER closure t`, + REPEAT GEN_TAC THEN REWRITE_TAC[frontier; INTERIOR_INTER] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + CLOSURE_INTER_SUBSET) THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A variant of nets (slightly non-standard but good for our purposes). *) +(* ------------------------------------------------------------------------- *) + +let net_tybij = new_type_definition "net" ("mk_net","netord") + (prove + (`?g:A->A->bool. !x y. (!z. g z x ==> g z y) \/ (!z. g z y ==> g z x)`, + EXISTS_TAC `\x:A y:A. F` THEN REWRITE_TAC[]));; + +let NET = prove + (`!n x y. (!z. netord n z x ==> netord n z y) \/ + (!z. netord n z y ==> netord n z x)`, + REWRITE_TAC[net_tybij; ETA_AX]);; + +let OLDNET = prove + (`!n x y. netord n x x /\ netord n y y + ==> ?z. netord n z z /\ + !w. netord n w z ==> netord n w x /\ netord n w y`, + MESON_TAC[NET]);; + +let NET_DILEMMA = prove + (`!net. (?a. (?x. netord net x a) /\ (!x. netord net x a ==> P x)) /\ + (?b. (?x. netord net x b) /\ (!x. netord net x b ==> Q x)) + ==> ?c. (?x. netord net x c) /\ (!x. netord net x c ==> P x /\ Q x)`, + MESON_TAC[NET]);; + +(* ------------------------------------------------------------------------- *) +(* Common nets and the "within" modifier for nets. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("within",(14,"right"));; +parse_as_infix("in_direction",(14,"right"));; + +let at = new_definition + `at a = mk_net(\x y. &0 < dist(x,a) /\ dist(x,a) <= dist(y,a))`;; + +let at_infinity = new_definition + `at_infinity = mk_net(\x y. norm(x) >= norm(y))`;; + +let at_posinfinity = new_definition + `at_posinfinity = mk_net(\x y:real. x >= y)`;; + +let at_neginfinity = new_definition + `at_neginfinity = mk_net(\x y:real. x <= y)`;; + +let sequentially = new_definition + `sequentially = mk_net(\m:num n. m >= n)`;; + +let within = new_definition + `net within s = mk_net(\x y. netord net x y /\ x IN s)`;; + +let in_direction = new_definition + `a in_direction v = (at a) within {b | ?c. &0 <= c /\ (b - a = c % v)}`;; + +(* ------------------------------------------------------------------------- *) +(* Prove that they are all nets. *) +(* ------------------------------------------------------------------------- *) + +let NET_PROVE_TAC[def] = + REWRITE_TAC[GSYM FUN_EQ_THM; def] THEN + REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[GSYM(CONJUNCT2 net_tybij)];; + +let AT = prove + (`!a:real^N x y. + netord(at a) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a)`, + GEN_TAC THEN NET_PROVE_TAC[at] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);; + +let AT_INFINITY = prove + (`!x y. netord at_infinity x y <=> norm(x) >= norm(y)`, + NET_PROVE_TAC[at_infinity] THEN + REWRITE_TAC[real_ge; REAL_LE_REFL] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; + +let AT_POSINFINITY = prove + (`!x y. netord at_posinfinity x y <=> x >= y`, + NET_PROVE_TAC[at_posinfinity] THEN + REWRITE_TAC[real_ge; REAL_LE_REFL] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; + +let AT_NEGINFINITY = prove + (`!x y. netord at_neginfinity x y <=> x <= y`, + NET_PROVE_TAC[at_neginfinity] THEN + REWRITE_TAC[real_ge; REAL_LE_REFL] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; + +let SEQUENTIALLY = prove + (`!m n. netord sequentially m n <=> m >= n`, + NET_PROVE_TAC[sequentially] THEN REWRITE_TAC[GE; LE_REFL] THEN + MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; + +let WITHIN = prove + (`!n s x y. netord(n within s) x y <=> netord n x y /\ x IN s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[within; GSYM FUN_EQ_THM] THEN + REWRITE_TAC[GSYM(CONJUNCT2 net_tybij); ETA_AX] THEN + MESON_TAC[NET]);; + +let IN_DIRECTION = prove + (`!a v x y. netord(a in_direction v) x y <=> + &0 < dist(x,a) /\ dist(x,a) <= dist(y,a) /\ + ?c. &0 <= c /\ (x - a = c % v)`, + REWRITE_TAC[WITHIN; AT; in_direction; IN_ELIM_THM; CONJ_ACI]);; + +let WITHIN_UNIV = prove + (`!x:real^N. at x within UNIV = at x`, + REWRITE_TAC[within; at; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);; + +let WITHIN_WITHIN = prove + (`!net s t. (net within s) within t = net within (s INTER t)`, + ONCE_REWRITE_TAC[within] THEN + REWRITE_TAC[WITHIN; IN_INTER; GSYM CONJ_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Identify trivial limits, where we can't approach arbitrarily closely. *) +(* ------------------------------------------------------------------------- *) + +let trivial_limit = new_definition + `trivial_limit net <=> + (!a:A b. a = b) \/ + ?a:A b. ~(a = b) /\ !x. ~(netord(net) x a) /\ ~(netord(net) x b)`;; + +let TRIVIAL_LIMIT_WITHIN = prove + (`!a:real^N. trivial_limit (at a within s) <=> ~(a limit_point_of s)`, + REWRITE_TAC[trivial_limit; LIMPT_APPROACHABLE_LE; WITHIN; AT; DIST_NZ] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [MESON_TAC[REAL_LT_01; REAL_LT_REFL; VECTOR_CHOOSE_DIST; + DIST_REFL; REAL_LT_IMP_LE]; + DISCH_THEN(X_CHOOSE_THEN `b:real^N` (X_CHOOSE_THEN `c:real^N` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `&0 < dist(a,b:real^N) \/ &0 < dist(a,c:real^N)` MP_TAC THEN + ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM; GSYM DIST_NZ; GSYM DIST_EQ_0; + REAL_ARITH `x <= &0 + &0 ==> ~(&0 < x)`]]; + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `a:real^N` THEN + SUBGOAL_THEN `?b:real^N. dist(a,b) = e` MP_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]]);; + +let TRIVIAL_LIMIT_AT = prove + (`!a. ~(trivial_limit (at a))`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_UNIV]);; + +let TRIVIAL_LIMIT_AT_INFINITY = prove + (`~(trivial_limit at_infinity)`, + REWRITE_TAC[trivial_limit; AT_INFINITY; real_ge] THEN + MESON_TAC[REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_LT_01; REAL_LT_LE]);; + +let TRIVIAL_LIMIT_AT_POSINFINITY = prove + (`~(trivial_limit at_posinfinity)`, + REWRITE_TAC[trivial_limit; AT_POSINFINITY; DE_MORGAN_THM] THEN + CONJ_TAC THENL + [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; real_ge; REAL_NOT_LE] THEN + MESON_TAC[REAL_LT_TOTAL; REAL_LT_ANTISYM]);; + +let TRIVIAL_LIMIT_AT_NEGINFINITY = prove + (`~(trivial_limit at_neginfinity)`, + REWRITE_TAC[trivial_limit; AT_NEGINFINITY; DE_MORGAN_THM] THEN + CONJ_TAC THENL + [DISCH_THEN(MP_TAC o SPECL [`&0`; `&1`]) THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; real_ge; REAL_NOT_LE] THEN + MESON_TAC[REAL_LT_TOTAL; REAL_LT_ANTISYM]);; + +let TRIVIAL_LIMIT_SEQUENTIALLY = prove + (`~(trivial_limit sequentially)`, + REWRITE_TAC[trivial_limit; SEQUENTIALLY] THEN + MESON_TAC[GE_REFL; NOT_SUC]);; + +let LIM_WITHIN_CLOSED_TRIVIAL = prove + (`!a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)`, + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]);; + +let NONTRIVIAL_LIMIT_WITHIN = prove + (`!net s. trivial_limit net ==> trivial_limit(net within s)`, + REWRITE_TAC[trivial_limit; WITHIN] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some property holds "sufficiently close" to the limit point. *) +(* ------------------------------------------------------------------------- *) + +let eventually = new_definition + `eventually p net <=> + trivial_limit net \/ + ?y. (?x. netord net x y) /\ (!x. netord net x y ==> p x)`;; + +let EVENTUALLY_HAPPENS = prove + (`!net p. eventually p net ==> trivial_limit net \/ ?x. p x`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_WITHIN_LE = prove + (`!s a:real^M p. + eventually p (at a within s) <=> + ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)`, + REWRITE_TAC[eventually; AT; WITHIN; TRIVIAL_LIMIT_WITHIN] THEN + REWRITE_TAC[LIMPT_APPROACHABLE_LE; DIST_NZ] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LTE_TRANS]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(TAUT `(a ==> b) ==> ~a \/ b`) THEN DISCH_TAC THEN + SUBGOAL_THEN `?b:real^M. dist(a,b) = d` MP_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^M` THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]);; + +let EVENTUALLY_WITHIN = prove + (`!s a:real^M p. + eventually p (at a within s) <=> + ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, + REWRITE_TAC[EVENTUALLY_WITHIN_LE] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + REWRITE_TAC[APPROACHABLE_LT_LE]);; + +let EVENTUALLY_AT = prove + (`!a p. eventually p (at a) <=> + ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[EVENTUALLY_WITHIN; IN_UNIV]);; + +let EVENTUALLY_SEQUENTIALLY = prove + (`!p. eventually p sequentially <=> ?N. !n. N <= n ==> p n`, + REWRITE_TAC[eventually; SEQUENTIALLY; GE; LE_REFL; + TRIVIAL_LIMIT_SEQUENTIALLY] THEN MESON_TAC[LE_REFL]);; + +let EVENTUALLY_AT_INFINITY = prove + (`!p. eventually p at_infinity <=> ?b. !x. norm(x) >= b ==> p x`, + REWRITE_TAC[eventually; AT_INFINITY; TRIVIAL_LIMIT_AT_INFINITY] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + MESON_TAC[real_ge; REAL_LE_REFL; VECTOR_CHOOSE_SIZE; + REAL_ARITH `&0 <= b \/ (!x. x >= &0 ==> x >= b)`]);; + +let EVENTUALLY_AT_POSINFINITY = prove + (`!p. eventually p at_posinfinity <=> ?b. !x. x >= b ==> p x`, + REWRITE_TAC[eventually; TRIVIAL_LIMIT_AT_POSINFINITY; AT_POSINFINITY] THEN + MESON_TAC[REAL_ARITH `x >= x`]);; + +let EVENTUALLY_AT_NEGINFINITY = prove + (`!p. eventually p at_neginfinity <=> ?b. !x. x <= b ==> p x`, + REWRITE_TAC[eventually; TRIVIAL_LIMIT_AT_NEGINFINITY; AT_NEGINFINITY] THEN + MESON_TAC[REAL_LE_REFL]);; + +let EVENTUALLY_AT_INFINITY_POS = prove + (`!p:real^N->bool. + eventually p at_infinity <=> ?b. &0 < b /\ !x. norm x >= b ==> p x`, + GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN + MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (abs b + &1 <= x ==> b <= x)`]);; + +let ALWAYS_EVENTUALLY = prove + (`(!x. p x) ==> eventually p net`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[eventually; trivial_limit] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems for "eventually". *) +(* ------------------------------------------------------------------------- *) + +let EVENTUALLY_AND = prove + (`!net:(A net) p q. + eventually (\x. p x /\ q x) net <=> + eventually p net /\ eventually q net`, + REPEAT GEN_TAC THEN REWRITE_TAC[eventually] THEN + ASM_CASES_TAC `trivial_limit(net:(A net))` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN SIMP_TAC[NET_DILEMMA] THEN MESON_TAC[]);; + +let EVENTUALLY_MONO = prove + (`!net:(A net) p q. + (!x. p x ==> q x) /\ eventually p net + ==> eventually q net`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_MP = prove + (`!net:(A net) p q. + eventually (\x. p x ==> q x) net /\ eventually p net + ==> eventually q net`, + REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_FALSE = prove + (`!net. eventually (\x. F) net <=> trivial_limit net`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_TRUE = prove + (`!net. eventually (\x. T) net <=> T`, + REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);; + +let NOT_EVENTUALLY = prove + (`!net p. (!x. ~(p x)) /\ ~(trivial_limit net) ==> ~(eventually p net)`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_FORALL = prove + (`!net:(A net) p s:B->bool. + FINITE s /\ ~(s = {}) + ==> (eventually (\x. !a. a IN s ==> p a x) net <=> + !a. a IN s ==> eventually (p a) net)`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[FORALL_IN_INSERT; EVENTUALLY_AND; ETA_AX] THEN + MAP_EVERY X_GEN_TAC [`b:B`; `t:B->bool`] THEN + ASM_CASES_TAC `t:B->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE]);; + +let FORALL_EVENTUALLY = prove + (`!net:(A net) p s:B->bool. + FINITE s /\ ~(s = {}) + ==> ((!a. a IN s ==> eventually (p a) net) <=> + eventually (\x. !a. a IN s ==> p a x) net)`, + SIMP_TAC[EVENTUALLY_FORALL]);; + +(* ------------------------------------------------------------------------- *) +(* Limits, defined as vacuously true when the limit is trivial. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-->",(12,"right"));; + +let tendsto = new_definition + `(f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net`;; + +let lim = new_definition + `lim net f = @l. (f --> l) net`;; + +let LIM = prove + (`(f --> l) net <=> + trivial_limit net \/ + !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ + !x. netord(net) x y ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; eventually] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Show that they yield usual definitions in the various cases. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_LE = prove + (`!f:real^M->real^N l a s. + (f --> l)(at a within s) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LE]);; + +let LIM_WITHIN = prove + (`!f:real^M->real^N l a s. + (f --> l) (at a within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; + +let LIM_AT_LE = prove + (`!f l a. (f --> l) (at a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. &0 < dist(x,a) /\ dist(x,a) <= d + ==> dist (f x,l) < e`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[LIM_WITHIN_LE; IN_UNIV]);; + +let LIM_AT = prove + (`!f l:real^N a:real^M. + (f --> l) (at a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_AT] THEN MESON_TAC[]);; + +let LIM_AT_INFINITY = prove + (`!f l. (f --> l) at_infinity <=> + !e. &0 < e ==> ?b. !x. norm(x) >= b ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);; + +let LIM_AT_INFINITY_POS = prove + (`!f l. (f --> l) at_infinity <=> + !e. &0 < e ==> ?b. &0 < b /\ !x. norm x >= b ==> dist(f x,l) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY] THEN + MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);; + +let LIM_AT_POSINFINITY = prove + (`!f l. (f --> l) at_posinfinity <=> + !e. &0 < e ==> ?b. !x. x >= b ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_AT_POSINFINITY] THEN MESON_TAC[]);; + +let LIM_AT_NEGINFINITY = prove + (`!f l. (f --> l) at_neginfinity <=> + !e. &0 < e ==> ?b. !x. x <= b ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_AT_NEGINFINITY] THEN MESON_TAC[]);; + +let LIM_SEQUENTIALLY = prove + (`!s l. (s --> l) sequentially <=> + !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; + +let LIM_EVENTUALLY = prove + (`!net f l. eventually (\x. f x = l) net ==> (f --> l) net`, + REWRITE_TAC[eventually; LIM] THEN MESON_TAC[DIST_REFL]);; + +let LIM_POSINFINITY_SEQUENTIALLY = prove + (`!f l. (f --> l) at_posinfinity ==> ((\n. f(&n)) --> l) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[LIM_AT_POSINFINITY; LIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + MP_TAC(ISPEC `B:real` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; + +let LIM_INFINITY_POSINFINITY_LIFT = prove + (`!f l:real^N. (f --> l) at_infinity ==> ((f o lift) --> l) at_posinfinity`, + REWRITE_TAC[LIM_AT_INFINITY; LIM_AT_POSINFINITY; o_THM] THEN + REWRITE_TAC[FORALL_DROP; NORM_REAL; GSYM drop; LIFT_DROP] THEN + MESON_TAC[REAL_ARITH `x >= b ==> abs(x) >= b`]);; + +(* ------------------------------------------------------------------------- *) +(* The expected monotonicity property. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_EMPTY = prove + (`!f l x. (f --> l) (at x within {})`, + REWRITE_TAC[LIM_WITHIN; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);; + +let LIM_WITHIN_SUBSET = prove + (`!f l a s. + (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)`, + REWRITE_TAC[LIM_WITHIN; SUBSET] THEN MESON_TAC[]);; + +let LIM_UNION = prove + (`!f x l s t. + (f --> l) (at x within s) /\ (f --> l) (at x within t) + ==> (f --> l) (at x within (s UNION t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; IN_UNION] THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN + EXISTS_TAC `min d1 d2` THEN ASM_MESON_TAC[REAL_LT_MIN]);; + +let LIM_UNION_UNIV = prove + (`!f x l s t. + (f --> l) (at x within s) /\ (f --> l) (at x within t) /\ + s UNION t = (:real^N) + ==> (f --> l) (at x)`, + MESON_TAC[LIM_UNION; WITHIN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPOSE_WITHIN = prove + (`!net f:A->real^N g:real^N->real^P s y z. + (f --> y) net /\ + eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\ + (g --> z) (at y within s) + ==> ((g o f) --> z) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; o_DEF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + ASM_MESON_TAC[DIST_REFL]);; + +let LIM_COMPOSE_AT = prove + (`!net f:A->real^N g:real^N->real^P y z. + (f --> y) net /\ + eventually (\w. f w = y ==> g y = z) net /\ + (g --> z) (at y) + ==> ((g o f) --> z) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `f:A->real^N`; `g:real^N->real^P`; + `(:real^N)`; `y:real^N`; `z:real^P`] + LIM_COMPOSE_WITHIN) THEN + ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Interrelations between restricted and unrestricted limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_AT_WITHIN = prove + (`!f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)`, + REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MESON_TAC[]);; + +let LIM_WITHIN_OPEN = prove + (`!f l a:real^M s. + a IN s /\ open s ==> ((f --> l)(at a within s) <=> (f --> l)(at a))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_AT_WITHIN] THEN + REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o GEN_REWRITE_RULE I [open_def]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LT_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* More limit point characterizations. *) +(* ------------------------------------------------------------------------- *) + +let LIMPT_SEQUENTIAL_INJ = prove + (`!x:real^N s. + x limit_point_of s <=> + ?f. (!n. f(n) IN (s DELETE x)) /\ + (!m n. f m = f n <=> m = n) /\ + (f --> x) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[GE; LE_REFL]] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real->real^N` THEN DISCH_TAC THEN + (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) + `(z 0 = y (&1)) /\ + (!n. z (SUC n):real^N = y(min (inv(&2 pow (SUC n))) (dist(z n,x))))` THEN + EXISTS_TAC `z:num->real^N` THEN + SUBGOAL_THEN + `!n. z(n) IN s /\ ~(z n:real^N = x) /\ dist(z n,x) < inv(&2 pow n)` + ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LT_01] THEN FIRST_X_ASSUM(MP_TAC o SPEC + `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT]; + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_SYM_EQ] THEN + SUBGOAL_THEN `!m n:num. m < n ==> dist(z n:real^N,x) < dist(z m,x)` + (fun th -> MESON_TAC[th; REAL_LT_REFL; LT_REFL]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN + CONJ_TAC THENL [REAL_ARITH_TAC; GEN_TAC THEN ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LT_TRANS)) THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&2 pow n)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]);; + +let LIMPT_SEQUENTIAL = prove + (`!x:real^N s. + x limit_point_of s <=> + ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN MESON_TAC[]; + REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN + MESON_TAC[GE; LE_REFL]]);; + +let [LIMPT_INFINITE_OPEN; LIMPT_INFINITE_BALL; LIMPT_INFINITE_CBALL] = + (CONJUNCTS o prove) + (`(!s x:real^N. + x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\ + (!s x:real^N. + x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\ + (!s x:real^N. + x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(q ==> p) /\ (r ==> s) /\ (s ==> q) /\ (p ==> r) + ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[limit_point_of; INFINITE; SET_RULE + `(?y. ~(y = x) /\ y IN s /\ y IN t) <=> ~(s INTER t SUBSET {x})`] THEN + MESON_TAC[FINITE_SUBSET; FINITE_SING]; + MESON_TAC[INFINITE_SUPERSET; BALL_SUBSET_CBALL; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; + MESON_TAC[INFINITE_SUPERSET; OPEN_CONTAINS_CBALL; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; + REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MATCH_MP_TAC INFINITE_SUPERSET THEN + EXISTS_TAC `IMAGE (f:num->real^N) (from N)` THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_FROM; IN_INTER] THEN + ASM_MESON_TAC[INFINITE_IMAGE_INJ; INFINITE_FROM]]);; + +let INFINITE_OPEN_IN = prove + (`!u s:real^N->bool. + open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u) + ==> INFINITE s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o + GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Condensation points. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("condensation_point_of",(12,"right"));; + +let condensation_point_of = new_definition + `x condensation_point_of s <=> + !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)`;; + +let CONDENSATION_POINT_OF_SUBSET = prove + (`!x:real^N s t. + x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[condensation_point_of] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + ASM SET_TAC[]);; + +let CONDENSATION_POINT_IMP_LIMPT = prove + (`!x s. x condensation_point_of s ==> x limit_point_of s`, + REWRITE_TAC[condensation_point_of; LIMPT_INFINITE_OPEN; INFINITE] THEN + MESON_TAC[FINITE_IMP_COUNTABLE]);; + +let CONDENSATION_POINT_INFINITE_BALL,CONDENSATION_POINT_INFINITE_CBALL = + (CONJ_PAIR o prove) + (`(!s x:real^N. + x condensation_point_of s <=> + !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\ + (!s x:real^N. + x condensation_point_of s <=> + !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) + ==> (p <=> q) /\ (p <=> r)`) THEN + REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL + [MESON_TAC[OPEN_BALL; CENTRE_IN_BALL]; + MESON_TAC[BALL_SUBSET_CBALL; COUNTABLE_SUBSET; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; + MESON_TAC[COUNTABLE_SUBSET; OPEN_CONTAINS_CBALL; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]]);; + +(* ------------------------------------------------------------------------- *) +(* Basic arithmetical combining theorems for limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_LINEAR = prove + (`!net:(A)net h f l. + (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_BOUNDED_POS) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; dist; GSYM LINEAR_SUB; REAL_LT_RDIV_EQ] THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_MUL_SYM]);; + +let LIM_CONST = prove + (`!net a:real^N. ((\x. a) --> a) net`, + SIMP_TAC[LIM; DIST_REFL; trivial_limit] THEN MESON_TAC[]);; + +let LIM_CMUL = prove + (`!f l c. (f --> l) net ==> ((\x. c % f x) --> c % l) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN + ASM_REWRITE_TAC[REWRITE_RULE[ETA_AX] + (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)]);; + +let LIM_CMUL_EQ = prove + (`!net f l c. + ~(c = &0) ==> (((\x. c % f x) --> c % l) net <=> (f --> l) net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_CMUL] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP LIM_CMUL) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; + +let LIM_NEG = prove + (`!net f l:real^N. (f --> l) net ==> ((\x. --(f x)) --> --l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM; dist] THEN + REWRITE_TAC[VECTOR_ARITH `--x - --y = --(x - y:real^N)`; NORM_NEG]);; + +let LIM_NEG_EQ = prove + (`!net f l:real^N. ((\x. --(f x)) --> --l) net <=> (f --> l) net`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let LIM_ADD = prove + (`!net:(A)net f g l m. + (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> l + m) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN + ASM_REWRITE_TAC[AND_FORALL_THM] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN + MESON_TAC[REAL_HALF; DIST_TRIANGLE_ADD; REAL_LT_ADD2; REAL_LET_TRANS]);; + +let LIM_ABS = prove + (`!net:(A)net f:A->real^N l. + (f --> l) net + ==> ((\x. lambda i. (abs(f(x)$i))) --> (lambda i. abs(l$i)):real^N) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x - y) <= norm(a - b) ==> dist(a,b) < e ==> dist(x,y) < e`) THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN + REAL_ARITH_TAC);; + +let LIM_SUB = prove + (`!net:(A)net f g l m. + (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> l - m) net`, + REWRITE_TAC[real_sub; VECTOR_SUB] THEN ASM_SIMP_TAC[LIM_ADD; LIM_NEG]);; + +let LIM_MAX = prove + (`!net:(A)net f g l:real^N m:real^N. + (f --> l) net /\ (g --> m) net + ==> ((\x. lambda i. max (f(x)$i) (g(x)$i)) + --> (lambda i. max (l$i) (m$i)):real^N) net`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP LIM_CMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + REAL_ARITH_TAC);; + +let LIM_MIN = prove + (`!net:(A)net f g l:real^N m:real^N. + (f --> l) net /\ (g --> m) net + ==> ((\x. lambda i. min (f(x)$i) (g(x)$i)) + --> (lambda i. min (l$i) (m$i)):real^N) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN + REAL_ARITH_TAC);; + +let LIM_NORM = prove + (`!net f:A->real^N l. + (f --> l) net ==> ((\x. lift(norm(f x))) --> lift(norm l)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; DIST_LIFT] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let LIM_NULL = prove + (`!net f l. (f --> l) net <=> ((\x. f(x) - l) --> vec 0) net`, + REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO]);; + +let LIM_NULL_NORM = prove + (`!net f. (f --> vec 0) net <=> ((\x. lift(norm(f x))) --> vec 0) net`, + REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO; REAL_ABS_NORM; NORM_LIFT]);; + +let LIM_NULL_CMUL_EQ = prove + (`!net f c. + ~(c = &0) ==> (((\x. c % f x) --> vec 0) net <=> (f --> vec 0) net)`, + MESON_TAC[LIM_CMUL_EQ; VECTOR_MUL_RZERO]);; + +let LIM_NULL_CMUL = prove + (`!net f c. (f --> vec 0) net ==> ((\x. c % f x) --> vec 0) net`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN + ASM_SIMP_TAC[LIM_NULL_CMUL_EQ; VECTOR_MUL_LZERO; LIM_CONST]);; + +let LIM_NULL_ADD = prove + (`!net f g:A->real^N. + (f --> vec 0) net /\ (g --> vec 0) net + ==> ((\x. f x + g x) --> vec 0) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + REWRITE_TAC[VECTOR_ADD_LID]);; + +let LIM_NULL_SUB = prove + (`!net f g:A->real^N. + (f --> vec 0) net /\ (g --> vec 0) net + ==> ((\x. f x - g x) --> vec 0) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + REWRITE_TAC[VECTOR_SUB_RZERO]);; + +let LIM_NULL_COMPARISON = prove + (`!net f g. eventually (\x. norm(f x) <= g x) net /\ + ((\x. lift(g x)) --> vec 0) net + ==> (f --> vec 0) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN REAL_ARITH_TAC);; + +let LIM_COMPONENT = prove + (`!net f i l:real^N. (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) + ==> ((\a. lift(f(a)$i)) --> lift(l$i)) net`, + REWRITE_TAC[LIM; dist; GSYM LIFT_SUB; NORM_LIFT] THEN + SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);; + +let LIM_TRANSFORM_BOUND = prove + (`!f g. eventually (\n. norm(f n) <= norm(g n)) net /\ (g --> vec 0) net + ==> (f --> vec 0) net`, + REPEAT GEN_TAC THEN + REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REAL_ARITH_TAC);; + +let LIM_NULL_CMUL_BOUNDED = prove + (`!f g:A->real^N B. + eventually (\a. g a = vec 0 \/ abs(f a) <= B) net /\ + (g --> vec 0) net + ==> ((\n. f n % g n) --> vec 0) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN + UNDISCH_TAC `eventually (\a. g a:real^N = vec 0 \/ abs(f a) <= B) + (net:(A net))` THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(g:A->real^N) x = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * e / (abs B + &1)` THEN + ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `c * (a / b) = (c * a) / b`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN + MATCH_MP_TAC(REAL_ARITH + `e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; + +let LIM_NULL_VMUL_BOUNDED = prove + (`!f g:A->real^N B. + ((lift o f) --> vec 0) net /\ + eventually (\a. f a = &0 \/ norm(g a) <= B) net + ==> ((\n. f n % g n) --> vec 0) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN + UNDISCH_TAC `eventually(\a. f a = &0 \/ norm((g:A->real^N) a) <= B) net` THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(f:A->real) x = &0` THEN + ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / (abs B + &1) * B` THEN + ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `(a / b) * c = (a * c) / b`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN + MATCH_MP_TAC(REAL_ARITH + `e * B <= e * abs B /\ &0 < e ==> e * B < e * (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; + +let LIM_VSUM = prove + (`!net f:A->B->real^N l s. + FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net) + ==> ((\x. vsum s (\i. f i x)) --> vsum s l) net`, + REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; LIM_CONST; LIM_ADD; IN_INSERT; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Deducing things about the limit from the elements. *) +(* ------------------------------------------------------------------------- *) + +let LIM_IN_CLOSED_SET = prove + (`!net f:A->real^N s l. + closed s /\ eventually (\x. f(x) IN s) net /\ + ~(trivial_limit net) /\ (f --> l) net + ==> l IN s`, + REWRITE_TAC[closed] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `~(x IN (UNIV DIFF s)) ==> x IN s`) THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `l:real^N` o GEN_REWRITE_RULE I + [OPEN_CONTAINS_BALL]) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_UNION] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [tendsto]) THEN + UNDISCH_TAC `eventually (\x. (f:A->real^N) x IN s) net` THEN + ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; TAUT `a ==> ~b <=> ~(a /\ b)`] THEN + MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Need to prove closed(cball(x,e)) before deducing this as a corollary. *) +(* ------------------------------------------------------------------------- *) + +let LIM_NORM_UBOUND = prove + (`!net:(A)net f (l:real^N) b. + ~(trivial_limit net) /\ + (f --> l) net /\ + eventually (\x. norm(f x) <= b) net + ==> norm(l) <= b`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[eventually] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x:A. dist(f(x):real^N,l) < norm(l:real^N) - b /\ norm(f x) <= b` + (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN + NORM_ARITH_TAC);; + +let LIM_NORM_LBOUND = prove + (`!net:(A)net f (l:real^N) b. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. b <= norm(f x)) net + ==> b <= norm(l)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[eventually] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x:A. dist(f(x):real^N,l) < b - norm(l:real^N) /\ b <= norm(f x)` + (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Uniqueness of the limit, when nontrivial. *) +(* ------------------------------------------------------------------------- *) + +let LIM_UNIQUE = prove + (`!net:(A)net f l:real^N l'. + ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(ASSUME_TAC o REWRITE_RULE[VECTOR_SUB_REFL] o MATCH_MP LIM_SUB) THEN + SUBGOAL_THEN `!e. &0 < e ==> norm(l:real^N - l') <= e` MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_NORM_UBOUND THEN + MAP_EVERY EXISTS_TAC [`net:(A)net`; `\x:A. vec 0 : real^N`] THEN + ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE; eventually] THEN + ASM_MESON_TAC[trivial_limit]; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DIST_NZ; dist] THEN + DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(l - l':real^N) / &2`) THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < norm(l - l':real^N)` THEN REAL_ARITH_TAC]);; + +let TENDSTO_LIM = prove + (`!net f l. ~(trivial_limit net) /\ (f --> l) net ==> lim net f = l`, + REWRITE_TAC[lim] THEN MESON_TAC[LIM_UNIQUE]);; + +let LIM_CONST_EQ = prove + (`!net:(A net) c d:real^N. + ((\x. c) --> d) net <=> trivial_limit net \/ c = d`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `trivial_limit (net:A net)` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[LIM]; ALL_TAC] THEN + EQ_TAC THEN SIMP_TAC[LIM_CONST] THEN DISCH_TAC THEN + MATCH_MP_TAC(SPEC `net:A net` LIM_UNIQUE) THEN + EXISTS_TAC `(\x. c):A->real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);; + +(* ------------------------------------------------------------------------- *) +(* Some unwieldy but occasionally useful theorems about uniform limits. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORM_LIM_ADD = prove + (`!net:(A)net P f g l m. + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm((f n x + g n x) - (l n + m n)) < e) + net`, + REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN + ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NORM_ARITH);; + +let UNIFORM_LIM_SUB = prove + (`!net:(A)net P f g l m. + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm((f n x - g n x) - (l n - m n)) < e) + net`, + REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN + ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NORM_ARITH);; + +(* ------------------------------------------------------------------------- *) +(* Limit under bilinear function, uniform version first. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORM_LIM_BILINEAR = prove + (`!net:(A)net P (h:real^M->real^N->real^P) f g l m b1 b2. + bilinear h /\ + eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ + eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm(h (f n x) (g n x) - h (l n) (m n)) < e) + net`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP + BILINEAR_BOUNDED_POS) THEN + REWRITE_TAC[AND_FORALL_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `min (abs b2 + &1) (e / &2 / (B * (abs b1 + abs b2 + &2)))`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_LT_MIN; + REAL_ARITH `&0 < abs x + &1`; + REAL_ARITH `&0 < abs x + abs y + &2`] THEN + REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `x:A` THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN + ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `h a b - h c d :real^N = (h a b - h a d) + (h a d - h c d)`] THEN + ASM_SIMP_TAC[GSYM BILINEAR_LSUB; GSYM BILINEAR_RSUB] THEN + MATCH_MP_TAC NORM_TRIANGLE_LT THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (MESON[REAL_LE_ADD2; REAL_LET_TRANS] + `(!x y. norm(h x y:real^P) <= B * norm x * norm y) + ==> B * norm a * norm b + B * norm c * norm d < e + ==> norm(h a b) + norm(h c d) < e`)) THEN + MATCH_MP_TAC(REAL_ARITH + `x * B < e / &2 /\ y * B < e / &2 ==> B * x + B * y < e`) THEN + CONJ_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / &2 / (B * (abs b1 + abs b2 + &2)) * + (abs b1 + abs b2 + &1)` THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b2 ==> a <= abs b1 + abs b2 + &1`] THEN + ASM_MESON_TAC[NORM_ARITH + `norm(f - l:real^P) < abs b2 + &1 /\ norm(l) <= b1 + ==> norm(f) <= abs b1 + abs b2 + &1`]; + ONCE_REWRITE_TAC[real_div] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_HALF; GSYM REAL_MUL_ASSOC; + REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `B * inv x * y < B <=> B * y / x < B * &1`] THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < abs x + abs y + &2`] THEN + REAL_ARITH_TAC]));; + +let LIM_BILINEAR = prove + (`!net:(A)net (h:real^M->real^N->real^P) f g l m. + (f --> l) net /\ (g --> m) net /\ bilinear h + ==> ((\x. h (f x) (g x)) --> (h l m)) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`net:(A)net`; `\x:one. T`; `h:real^M->real^N->real^P`; + `\n:one. (f:A->real^M)`; `\n:one. (g:A->real^N)`; + `\n:one. (l:real^M)`; `\n:one. (m:real^N)`; + `norm(l:real^M)`; `norm(m:real^N)`] + UNIFORM_LIM_BILINEAR) THEN + ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN + ASM_REWRITE_TAC[GSYM dist; GSYM tendsto]);; + +(* ------------------------------------------------------------------------- *) +(* These are special for limits out of the same vector space. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_ID = prove + (`!a s. ((\x. x) --> a) (at a within s)`, + REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]);; + +let LIM_AT_ID = prove + (`!a. ((\x. x) --> a) (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]);; + +let LIM_AT_ZERO = prove + (`!f:real^M->real^N l a. + (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(vec 0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_SUB_RZERO]; + FIRST_X_ASSUM(MP_TAC o SPEC `x - a:real^M`) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_ADD2]]);; + +(* ------------------------------------------------------------------------- *) +(* It's also sometimes useful to extract the limit point from the net. *) +(* ------------------------------------------------------------------------- *) + +let netlimit = new_definition + `netlimit net = @a. !x. ~(netord net x a)`;; + +let NETLIMIT_WITHIN = prove + (`!a:real^N s. ~(trivial_limit (at a within s)) + ==> (netlimit (at a within s) = a)`, + REWRITE_TAC[trivial_limit; netlimit; AT; WITHIN; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x:real^N. ~(&0 < dist(x,a) /\ dist(x,a) <= dist(a,a) /\ x IN s)` + ASSUME_TAC THENL + [ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT]; ASM_MESON_TAC[]]);; + +let NETLIMIT_AT = prove + (`!a. netlimit(at a) = a`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MATCH_MP_TAC NETLIMIT_WITHIN THEN + SIMP_TAC[TRIVIAL_LIMIT_AT; WITHIN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Transformation of limit. *) +(* ------------------------------------------------------------------------- *) + +let LIM_TRANSFORM = prove + (`!net f g l. + ((\x. f x - g x) --> vec 0) net /\ (f --> l) net ==> (g --> l) net`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + VECTOR_ARITH_TAC);; + +let LIM_TRANSFORM_EVENTUALLY = prove + (`!net f g l. + eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP LIM_EVENTUALLY) MP_TAC) THEN + MESON_TAC[LIM_TRANSFORM]);; + +let LIM_TRANSFORM_WITHIN = prove + (`!f g x s d. + &0 < d /\ + (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ + (f --> l) (at x within s) + ==> (g --> l) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + DISCH_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `d:real` THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; DIST_REFL]);; + +let LIM_TRANSFORM_AT = prove + (`!f g x d. + &0 < d /\ + (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ + (f --> l) (at x) + ==> (g --> l) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]);; + +let LIM_TRANSFORM_EQ = prove + (`!net f:A->real^N g l. + ((\x. f x - g x) --> vec 0) net ==> ((f --> l) net <=> (g --> l) net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL + [EXISTS_TAC `f:A->real^N` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `g:A->real^N` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN + ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]]);; + +let LIM_TRANSFORM_WITHIN_SET = prove + (`!f a s t. + eventually (\x. x IN s <=> x IN t) (at a) + ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; LIM_WITHIN] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Common case assuming being away from some crucial point like 0. *) +(* ------------------------------------------------------------------------- *) + +let LIM_TRANSFORM_AWAY_WITHIN = prove + (`!f:real^M->real^N g a b s. + ~(a = b) /\ + (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ + (f --> l) (at a within s) + ==> (g --> l) (at a within s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `dist(a:real^M,b)`] THEN + ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `y:real^M` THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]);; + +let LIM_TRANSFORM_AWAY_AT = prove + (`!f:real^M->real^N g a b. + ~(a = b) /\ + (!x. ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ + (f --> l) (at a) + ==> (g --> l) (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Alternatively, within an open set. *) +(* ------------------------------------------------------------------------- *) + +let LIM_TRANSFORM_WITHIN_OPEN = prove + (`!f g:real^M->real^N s a l. + open s /\ a IN s /\ + (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ + (f --> l) (at a) + ==> (g --> l) (at a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN + EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL] THEN + ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; + +let LIM_TRANSFORM_WITHIN_OPEN_IN = prove + (`!f g:real^M->real^N s t a l. + open_in (subtopology euclidean t) s /\ a IN s /\ + (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ + (f --> l) (at a within t) + ==> (g --> l) (at a within t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN + ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Another quite common idiom of an explicit conditional in a sequence. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CASES_FINITE_SEQUENTIALLY = prove + (`!f g l. FINITE {n | P n} + ==> (((\n. if P n then f n else g n) --> l) sequentially <=> + (g --> l) sequentially)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `N + 1` THEN + ASM_MESON_TAC[ARITH_RULE `~(x <= n /\ n + 1 <= x)`]);; + +let LIM_CASES_COFINITE_SEQUENTIALLY = prove + (`!f g l. FINITE {n | ~P n} + ==> (((\n. if P n then f n else g n) --> l) sequentially <=> + (f --> l) sequentially)`, + ONCE_REWRITE_TAC[TAUT `(if p then x else y) = (if ~p then y else x)`] THEN + REWRITE_TAC[LIM_CASES_FINITE_SEQUENTIALLY]);; + +let LIM_CASES_SEQUENTIALLY = prove + (`!f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=> + (f --> l) sequentially) /\ + (((\n. if m < n then f n else g n) --> l) sequentially <=> + (f --> l) sequentially) /\ + (((\n. if n <= m then f n else g n) --> l) sequentially <=> + (g --> l) sequentially) /\ + (((\n. if n < m then f n else g n) --> l) sequentially <=> + (g --> l) sequentially)`, + SIMP_TAC[LIM_CASES_FINITE_SEQUENTIALLY; LIM_CASES_COFINITE_SEQUENTIALLY; + NOT_LE; NOT_LT; FINITE_NUMSEG_LT; FINITE_NUMSEG_LE]);; + +(* ------------------------------------------------------------------------- *) +(* A congruence rule allowing us to transform limits assuming not at point. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CONG_WITHIN = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))`, + REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);; + +let LIM_CONG_AT = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))`, + REWRITE_TAC[LIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);; + +extend_basic_congs [LIM_CONG_WITHIN; LIM_CONG_AT];; + +(* ------------------------------------------------------------------------- *) +(* Useful lemmas on closure and set of possible sequential limits. *) +(* ------------------------------------------------------------------------- *) + +let CLOSURE_SEQUENTIAL = prove + (`!s l:real^N. + l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially`, + REWRITE_TAC[closure; IN_UNION; LIMPT_SEQUENTIAL; IN_ELIM_THM; IN_DELETE] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + EXISTS_TAC `\n:num. l:real^N` THEN + ASM_REWRITE_TAC[LIM_CONST]);; + +let CLOSED_CONTAINS_SEQUENTIAL_LIMIT = prove + (`!s x l:real^N. + closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s`, + MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED]);; + +let CLOSED_SEQUENTIAL_LIMITS = prove + (`!s. closed s <=> + !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s`, + MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED; + CLOSED_LIMPT; LIMPT_SEQUENTIAL; IN_DELETE]);; + +let CLOSURE_APPROACHABLE = prove + (`!x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e`, + REWRITE_TAC[closure; LIMPT_APPROACHABLE; IN_UNION; IN_ELIM_THM] THEN + MESON_TAC[DIST_REFL]);; + +let CLOSED_APPROACHABLE = prove + (`!x s. closed s + ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)`, + MESON_TAC[CLOSURE_CLOSED; CLOSURE_APPROACHABLE]);; + +let IN_CLOSURE_DELETE = prove + (`!s x:real^N. x IN closure(s DELETE x) <=> x limit_point_of s`, + SIMP_TAC[CLOSURE_APPROACHABLE; LIMPT_APPROACHABLE; IN_DELETE; CONJ_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Some other lemmas about sequences. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_OFFSET = prove + (`!f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N <= n ==> N <= n + k:num`]);; + +let SEQ_OFFSET_NEG = prove + (`!f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k:num`]);; + +let SEQ_OFFSET_REV = prove + (`!f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k /\ (n - k) + k = n:num`]);; + +let SEQ_HARMONIC = prove + (`((\n. lift(inv(&n))) --> vec 0) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN + ASM_REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_NZ]);; + +(* ------------------------------------------------------------------------- *) +(* More properties of closed balls. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_CBALL = prove + (`!x:real^N e. closed(cball(x,e))`, + REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_CBALL; dist] THEN + GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:num->real^N` THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. x - (s:num->real^N) n` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + ASM_SIMP_TAC[LIM_SUB; LIM_CONST; SEQUENTIALLY] THEN MESON_TAC[GE_REFL]);; + +let IN_INTERIOR_CBALL = prove + (`!x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s`, + REWRITE_TAC[interior; IN_ELIM_THM] THEN + MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET_TRANS; + BALL_SUBSET_CBALL; CENTRE_IN_BALL; OPEN_BALL]);; + +let LIMPT_BALL = prove + (`!x:real^N y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < e` THENL + [ALL_TAC; ASM_MESON_TAC[LIMPT_EMPTY; REAL_NOT_LT; BALL_EQ_EMPTY]] THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [MESON_TAC[CLOSED_CBALL; CLOSED_LIMPT; LIMPT_SUBSET; BALL_SUBSET_CBALL]; + REWRITE_TAC[IN_CBALL; LIMPT_APPROACHABLE; IN_BALL]] THEN + DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[DIST_NZ] THENL + [MP_TAC(SPECL [`d:real`; `e:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + GEN_MESON_TAC 0 40 1 [VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MP_TAC(SPECL [`norm(y:real^N - x)`; `d:real`] REAL_DOWN2) THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ; dist]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(y:real^N) - (k / dist(y,x)) % (y - x)` THEN + REWRITE_TAC[dist; VECTOR_ARITH `(y - c % z) - y = --c % z`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NEG] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `x - (y - k % (y - x)) = (&1 - k) % (x - y)`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> &0 < abs k`; NORM_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < k /\ k < d ==> abs k < d`] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(x:real^N - y)` THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[NORM_SUB]] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < k /\ k < &1 ==> abs(&1 - k) < &1`) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO; + REAL_MUL_LID]);; + +let CLOSURE_BALL = prove + (`!x:real^N e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))`, + SIMP_TAC[EXTENSION; closure; IN_ELIM_THM; IN_UNION; LIMPT_BALL] THEN + REWRITE_TAC[IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; + +let INTERIOR_BALL = prove + (`!a r. interior(ball(a,r)) = ball(a,r)`, + SIMP_TAC[INTERIOR_OPEN; OPEN_BALL]);; + +let INTERIOR_CBALL = prove + (`!x:real^N e. interior(cball(x,e)) = ball(x,e)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL + [ALL_TAC; + SUBGOAL_THEN `cball(x:real^N,e) = {} /\ ball(x:real^N,e) = {}` + (fun th -> REWRITE_TAC[th; INTERIOR_EMPTY]) THEN + REWRITE_TAC[IN_BALL; IN_CBALL; EXTENSION; NOT_IN_EMPTY] THEN + CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN + MP_TAC(ISPECL [`x:real^N`; `y:real^N`] DIST_POS_LE) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC INTERIOR_UNIQUE THEN + REWRITE_TAC[BALL_SUBSET_CBALL; OPEN_BALL] THEN + X_GEN_TAC `t:real^N->bool` THEN + SIMP_TAC[SUBSET; IN_CBALL; IN_BALL; REAL_LT_LE] THEN STRIP_TAC THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [open_def]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `z:real^N = x` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `k:real` o MATCH_MP REAL_DOWN) THEN + SUBGOAL_THEN `?w:real^N. dist(w,x) = k` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; + ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_SYM]]; + RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN + DISCH_THEN(MP_TAC o SPEC `z + ((d / &2) / dist(z,x)) % (z - x:real^N)`) THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; + REAL_ABS_NORM; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; GSYM dist; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + ASM_REWRITE_TAC[REAL_ARITH `abs d < d * &2 <=> &0 < d`] THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN + REWRITE_TAC[VECTOR_ARITH `x - (z + k % (z - x)) = (&1 + k) % (x - z)`] THEN + REWRITE_TAC[REAL_NOT_LE; NORM_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; GSYM dist] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]);; + +let FRONTIER_BALL = prove + (`!a e. &0 < e ==> frontier(ball(a,e)) = sphere(a,e)`, + SIMP_TAC[frontier; sphere; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL; + REAL_LT_IMP_LE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN + REAL_ARITH_TAC);; + +let FRONTIER_CBALL = prove + (`!a e. frontier(cball(a,e)) = sphere(a,e)`, + SIMP_TAC[frontier; sphere; INTERIOR_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; + REAL_LT_IMP_LE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN + REAL_ARITH_TAC);; + +let CBALL_EQ_EMPTY = prove + (`!x e. (cball(x,e) = {}) <=> e < &0`, + REWRITE_TAC[EXTENSION; IN_CBALL; NOT_IN_EMPTY; REAL_NOT_LE] THEN + MESON_TAC[DIST_POS_LE; DIST_REFL; REAL_LTE_TRANS]);; + +let CBALL_EMPTY = prove + (`!x e. e < &0 ==> cball(x,e) = {}`, + REWRITE_TAC[CBALL_EQ_EMPTY]);; + +let CBALL_EQ_SING = prove + (`!x:real^N e. (cball(x,e) = {x}) <=> e = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[DIST_LE_0]] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `x + (e / &2) % basis 1:real^N` th) THEN + MP_TAC(SPEC `x:real^N` th)) THEN + REWRITE_TAC[dist; VECTOR_ARITH `x - (x + e):real^N = --e`; + VECTOR_ARITH `x + e = x <=> e:real^N = vec 0`] THEN + REWRITE_TAC[NORM_NEG; NORM_MUL; VECTOR_MUL_EQ_0; NORM_0; VECTOR_SUB_REFL] THEN + SIMP_TAC[NORM_BASIS; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN + REAL_ARITH_TAC);; + +let CBALL_SING = prove + (`!x e. e = &0 ==> cball(x,e) = {x}`, + REWRITE_TAC[CBALL_EQ_SING]);; + +let SPHERE_SING = prove + (`!x e. e = &0 ==> sphere(x,e) = {x}`, + SIMP_TAC[sphere; DIST_EQ_0; SING_GSPEC]);; + +let SPHERE_EQ_SING = prove + (`!a:real^N r x. sphere(a,r) = {x} <=> x = a /\ r = &0`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPHERE_SING] THEN + ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_INSERT_EMPTY] THEN + ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})`) THEN + EXISTS_TAC `a - (x - a):real^N` THEN REWRITE_TAC[IN_SPHERE] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH);; + +(* ------------------------------------------------------------------------- *) +(* For points in the interior, localization of limits makes no difference. *) +(* ------------------------------------------------------------------------- *) + +let EVENTUALLY_WITHIN_INTERIOR = prove + (`!p s x. + x IN interior s + ==> (eventually p (at x within s) <=> eventually p (at x))`, + REWRITE_TAC[EVENTUALLY_WITHIN; EVENTUALLY_AT; IN_INTERIOR] THEN + REPEAT GEN_TAC THEN SIMP_TAC[SUBSET; IN_BALL; LEFT_IMP_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[DIST_SYM]);; + +let LIM_WITHIN_INTERIOR = prove + (`!f l s x. + x IN interior s + ==> ((f --> l) (at x within s) <=> (f --> l) (at x))`, + SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR]);; + +let NETLIMIT_WITHIN_INTERIOR = prove + (`!s x:real^N. x IN interior s ==> netlimit(at x within s) = x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[OPEN_CONTAINS_BALL] + (SPEC_ALL OPEN_INTERIOR))) THEN + ASM_MESON_TAC[LIMPT_SUBSET; LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE; + SUBSET_TRANS; INTERIOR_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A non-singleton connected set is perfect (i.e. has no isolated points). *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_IMP_PERFECT = prove + (`!s x:real^N. + connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I + [OPEN_CONTAINS_CBALL]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N}` o + GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `t:real^N->bool` THEN + ASM SET_TAC[]; + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `cball(x:real^N,e)` THEN REWRITE_TAC[CLOSED_CBALL] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_SING] THEN + ASM_MESON_TAC[CENTRE_IN_CBALL; SUBSET; REAL_LT_IMP_LE]; + ASM SET_TAC[]]);; + +let CONNECTED_IMP_PERFECT_CLOSED = prove + (`!s x. connected s /\ closed s /\ ~(?a. s = {a}) + ==> (x limit_point_of s <=> x IN s)`, + MESON_TAC[CONNECTED_IMP_PERFECT; CLOSED_LIMPT]);; + +(* ------------------------------------------------------------------------- *) +(* Boundedness. *) +(* ------------------------------------------------------------------------- *) + +let bounded = new_definition + `bounded s <=> ?a. !x:real^N. x IN s ==> norm(x) <= a`;; + +let BOUNDED_EMPTY = prove + (`bounded {}`, + REWRITE_TAC[bounded; NOT_IN_EMPTY]);; + +let BOUNDED_SUBSET = prove + (`!s t. bounded t /\ s SUBSET t ==> bounded s`, + MESON_TAC[bounded; SUBSET]);; + +let BOUNDED_INTERIOR = prove + (`!s:real^N->bool. bounded s ==> bounded(interior s)`, + MESON_TAC[BOUNDED_SUBSET; INTERIOR_SUBSET]);; + +let BOUNDED_CLOSURE = prove + (`!s:real^N->bool. bounded s ==> bounded(closure s)`, + REWRITE_TAC[bounded; CLOSURE_SEQUENTIAL] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MESON_TAC[REWRITE_RULE[eventually] LIM_NORM_UBOUND; + TRIVIAL_LIMIT_SEQUENTIALLY; trivial_limit]);; + +let BOUNDED_CLOSURE_EQ = prove + (`!s:real^N->bool. bounded(closure s) <=> bounded s`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN + MESON_TAC[BOUNDED_SUBSET; CLOSURE_SUBSET]);; + +let BOUNDED_CBALL = prove + (`!x:real^N e. bounded(cball(x,e))`, + REPEAT GEN_TAC THEN REWRITE_TAC[bounded] THEN + EXISTS_TAC `norm(x:real^N) + e` THEN REWRITE_TAC[IN_CBALL; dist] THEN + NORM_ARITH_TAC);; + +let BOUNDED_BALL = prove + (`!x e. bounded(ball(x,e))`, + MESON_TAC[BALL_SUBSET_CBALL; BOUNDED_CBALL; BOUNDED_SUBSET]);; + +let FINITE_IMP_BOUNDED = prove + (`!s:real^N->bool. FINITE s ==> bounded s`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[BOUNDED_EMPTY] THEN + REWRITE_TAC[bounded; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) STRIP_ASSUME_TAC) THEN + EXISTS_TAC `norm(x:real^N) + abs B` THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH + `(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b`]);; + +let BOUNDED_UNION = prove + (`!s t. bounded (s UNION t) <=> bounded s /\ bounded t`, + REWRITE_TAC[bounded; IN_UNION] THEN MESON_TAC[REAL_LE_MAX]);; + +let BOUNDED_UNIONS = prove + (`!f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(UNIONS f)`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; BOUNDED_EMPTY; IN_INSERT; UNIONS_INSERT] THEN + MESON_TAC[BOUNDED_UNION]);; + +let BOUNDED_POS = prove + (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) <= b`, + REWRITE_TAC[bounded] THEN + MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);; + +let BOUNDED_POS_LT = prove + (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) < b`, + REWRITE_TAC[bounded] THEN + MESON_TAC[REAL_LT_IMP_LE; + REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);; + +let BOUNDED_INTER = prove + (`!s t. bounded s \/ bounded t ==> bounded (s INTER t)`, + MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; + +let BOUNDED_DIFF = prove + (`!s t. bounded s ==> bounded (s DIFF t)`, + MESON_TAC[BOUNDED_SUBSET; SUBSET_DIFF]);; + +let BOUNDED_INSERT = prove + (`!x s. bounded(x INSERT s) <=> bounded s`, + ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN + SIMP_TAC[BOUNDED_UNION; FINITE_IMP_BOUNDED; FINITE_RULES]);; + +let BOUNDED_SING = prove + (`!a. bounded {a}`, + REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY]);; + +let BOUNDED_INTERS = prove + (`!f:(real^N->bool)->bool. + (?s:real^N->bool. s IN f /\ bounded s) ==> bounded(INTERS f)`, + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + ASM SET_TAC[]);; + +let NOT_BOUNDED_UNIV = prove + (`~(bounded (:real^N))`, + REWRITE_TAC[BOUNDED_POS; NOT_FORALL_THM; NOT_EXISTS_THM; IN_UNIV; + DE_MORGAN_THM; REAL_NOT_LE] THEN + X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `B + &1` VECTOR_CHOOSE_SIZE) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> &0 <= B + &1`] THEN + MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC);; + +let COBOUNDED_IMP_UNBOUNDED = prove + (`!s. bounded((:real^N) DIFF s) ==> ~bounded s`, + GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN + REWRITE_TAC[GSYM BOUNDED_UNION; SET_RULE `UNIV DIFF s UNION s = UNIV`] THEN + REWRITE_TAC[NOT_BOUNDED_UNIV]);; + +let BOUNDED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. bounded s /\ linear f ==> bounded(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `B2:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN + EXISTS_TAC `B2 * B1` THEN ASM_SIMP_TAC[REAL_LT_MUL; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm(x:real^M)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);; + +let BOUNDED_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (bounded (IMAGE f s) <=> bounded s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE BOUNDED_LINEAR_IMAGE));; + +add_linear_invariants [BOUNDED_LINEAR_IMAGE_EQ];; + +let BOUNDED_SCALING = prove + (`!c s. bounded s ==> bounded (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN + ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID]);; + +let BOUNDED_NEGATIONS = prove + (`!s. bounded s ==> bounded (IMAGE (--) s)`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `-- &1` o MATCH_MP BOUNDED_SCALING) THEN + REWRITE_TAC[bounded; IN_IMAGE; VECTOR_MUL_LNEG; VECTOR_MUL_LID]);; + +let BOUNDED_TRANSLATION = prove + (`!a:real^N s. bounded s ==> bounded (IMAGE (\x. a + x) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + EXISTS_TAC `B + norm(a:real^N)` THEN POP_ASSUM MP_TAC THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let BOUNDED_TRANSLATION_EQ = prove + (`!a s. bounded (IMAGE (\x:real^N. a + x) s) <=> bounded s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN + DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP BOUNDED_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [BOUNDED_TRANSLATION_EQ];; + +let BOUNDED_DIFFS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN + EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH + `norm x <= a /\ norm y <= b ==> norm(x - y) <= a + b`) THEN + ASM_SIMP_TAC[]);; + +let BOUNDED_SUMS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN + EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH + `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN + ASM_SIMP_TAC[]);; + +let BOUNDED_SUMS_IMAGE = prove + (`!f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t} + ==> bounded {f x + g x | x IN t}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + SET_TAC[]);; + +let BOUNDED_SUMS_IMAGES = prove + (`!f:A->B->real^N t s. + FINITE s /\ + (!a. a IN s ==> bounded {f x a | x IN t}) + ==> bounded { vsum s (f x) | x IN t}`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `{vec 0:real^N}` THEN + SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_RULES] THEN SET_TAC[]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGE THEN + ASM_SIMP_TAC[IN_INSERT]);; + +let BOUNDED_SUBSET_BALL = prove + (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&2 * B + norm(x:real^N)` THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH + `&0 < B /\ &0 <= x ==> &0 < &2 * B + x`] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[IN_BALL] THEN + UNDISCH_TAC `&0 < B` THEN NORM_ARITH_TAC);; + +let BOUNDED_SUBSET_CBALL = prove + (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)`, + MESON_TAC[BOUNDED_SUBSET_BALL; SUBSET_TRANS; BALL_SUBSET_CBALL]);; + +let UNBOUNDED_INTER_COBOUNDED = prove + (`!s t. ~bounded s /\ bounded((:real^N) DIFF t) ==> ~(s INTER t = {})`, + REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (:real^N) DIFF t`] THEN + MESON_TAC[BOUNDED_SUBSET]);; + +let COBOUNDED_INTER_UNBOUNDED = prove + (`!s t. bounded((:real^N) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})`, + REWRITE_TAC[SET_RULE `s INTER t = {} <=> t SUBSET (:real^N) DIFF s`] THEN + MESON_TAC[BOUNDED_SUBSET]);; + +let SUBSPACE_BOUNDED_EQ_TRIVIAL = prove + (`!s:real^N->bool. subspace s ==> (bounded s <=> s = {vec 0})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SING] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN + ASM_SIMP_TAC[SUBSPACE_0] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN + DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm v % v:real^N`) THEN + ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC);; + +let BOUNDED_COMPONENTWISE = prove + (`!s:real^N->bool. + bounded s <=> !i. 1 <= i /\ i <= dimindex(:N) + ==> bounded (IMAGE (\x. lift(x$i)) s)`, + GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; NORM_LIFT] THEN + EQ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real` THEN + DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) b` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. &0)` THEN + SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POS] THEN + MATCH_MP_TAC SUM_LT_ALL THEN + ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY] THEN + REWRITE_TAC[NOT_LT; DIMINDEX_GE_1]; + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG]]);; + +(* ------------------------------------------------------------------------- *) +(* Some theorems on sups and infs using the notion "bounded". *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_LIFT = prove + (`!s. bounded(IMAGE lift s) <=> ?a. !x. x IN s ==> abs(x) <= a`, + REWRITE_TAC[bounded; FORALL_LIFT; NORM_LIFT; LIFT_IN_IMAGE_LIFT]);; + +let BOUNDED_HAS_SUP = prove + (`!s. bounded(IMAGE lift s) /\ ~(s = {}) + ==> (!x. x IN s ==> x <= sup s) /\ + (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)`, + REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN + MESON_TAC[SUP; REAL_ARITH `abs(x) <= a ==> x <= a`]);; + +let SUP_INSERT = prove + (`!x s. bounded (IMAGE lift s) + ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL + [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_LE_MAX; REAL_LT_MAX; IN_INSERT] THEN + MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; + +let BOUNDED_HAS_INF = prove + (`!s. bounded(IMAGE lift s) /\ ~(s = {}) + ==> (!x. x IN s ==> inf s <= x) /\ + (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)`, + REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN + MESON_TAC[INF; REAL_ARITH `abs(x) <= a ==> --a <= x`]);; + +let INF_INSERT = prove + (`!x s. bounded (IMAGE lift s) + ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL + [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_MIN_LE; REAL_MIN_LT; IN_INSERT] THEN + MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Subset and overlapping relations on balls. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_BALLS = prove + (`(!a a':real^N r r'. + ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ + (!a a':real^N r r'. + ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ + (!a a':real^N r r'. + cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\ + (!a a':real^N r r'. + cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)`, + let lemma = prove + (`(!a':real^N r r'. + cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\ + (!a':real^N r r'. + cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)`, + CONJ_TAC THEN + (GEOM_ORIGIN_TAC `a':real^N` THEN + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN + EQ_TAC THENL [REWRITE_TAC[DIST_0]; NORM_ARITH_TAC] THEN + DISJ_CASES_TAC(REAL_ARITH `r < &0 \/ &0 <= r`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN + ASM_CASES_TAC `a:real^N = vec 0` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `r % basis 1:real^N`) THEN + ASM_SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; + FIRST_X_ASSUM(MP_TAC o SPEC `(&1 + r / norm(a)) % a:real^N`) THEN + SIMP_TAC[dist; VECTOR_ARITH `a - (&1 + x) % a:real^N = --(x % a)`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_NEG; REAL_POS; + REAL_LE_DIV; NORM_POS_LE; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; + NORM_EQ_0; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`]] THEN + UNDISCH_TAC `&0 <= r` THEN NORM_ARITH_TAC)) + and tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN + ASM_SIMP_TAC[CLOSED_CBALL; CLOSURE_CLOSED; CLOSURE_BALL] in + REWRITE_TAC[AND_FORALL_THM] THEN GEOM_ORIGIN_TAC `a':real^N` THEN + REPEAT STRIP_TAC THEN + (EQ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THEN + MATCH_MP_TAC(SET_RULE + `(s = {} <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p) + ==> s SUBSET t ==> p \/ q`) THEN + REWRITE_TAC[BALL_EQ_EMPTY; CBALL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL + [tac; tac; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let INTER_BALLS_EQ_EMPTY = prove + (`(!a b:real^N r s. ball(a,r) INTER ball(b,s) = {} <=> + r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ + (!a b:real^N r s. ball(a,r) INTER cball(b,s) = {} <=> + r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\ + (!a b:real^N r s. cball(a,r) INTER ball(b,s) = {} <=> + r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ + (!a b:real^N r s. cball(a,r) INTER cball(b,s) = {} <=> + r < &0 \/ s < &0 \/ r + s < dist(a,b))`, + REPEAT STRIP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_CBALL; IN_BALL] THEN + (EQ_TAC THENL + [ALL_TAC; + SPEC_TAC(`b % basis 1:real^N`,`v:real^N`) THEN CONV_TAC NORM_ARITH]) THEN + DISCH_THEN(MP_TAC o GEN `c:real` o SPEC `c % basis 1:real^N`) THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1; dist; NORM_NEG; + VECTOR_SUB_LZERO; GSYM VECTOR_SUB_RDISTRIB; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `min b r:real` th) THEN + MP_TAC(SPEC `max (&0) (b - s:real)` th) THEN + MP_TAC(SPEC `(r + (b - s)) / &2` th)) THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Every closed set is a G_Delta. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_AS_GDELTA = prove + (`!s:real^N->bool. + closed s + ==> ?g. COUNTABLE g /\ + (!u. u IN g ==> open u) /\ + INTERS g = s`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `{ UNIONS { ball(x:real^N,inv(&n + &1)) | x IN s} | n IN (:num)}` THEN + SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN + SIMP_TAC[FORALL_IN_IMAGE; OPEN_UNIONS; OPEN_BALL] THEN + MATCH_MP_TAC(SET_RULE + `closure s = s /\ s SUBSET t /\ t SUBSET closure s + ==> t = s`) THEN + ASM_REWRITE_TAC[CLOSURE_EQ] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; INTERS_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LT_TRANS)) THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Compactness (the definition is the one based on convegent subsequences). *) +(* ------------------------------------------------------------------------- *) + +let compact = new_definition + `compact s <=> + !f:num->real^N. + (!n. f(n) IN s) + ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\ + ((f o r) --> l) sequentially`;; + +let MONOTONE_BIGGER = prove + (`!r. (!m n. m < n ==> r(m) < r(n)) ==> !n:num. n <= r(n)`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN + ASM_MESON_TAC[LE_0; ARITH_RULE `n <= m /\ m < p ==> SUC n <= p`; LT]);; + +let LIM_SUBSEQUENCE = prove + (`!s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially + ==> (s o r --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);; + +let MONOTONE_SUBSEQUENCE = prove + (`!s:num->real. ?r:num->num. + (!m n. m < n ==> r(m) < r(n)) /\ + ((!m n. m <= n ==> s(r(m)) <= s(r(n))) \/ + (!m n. m <= n ==> s(r(n)) <= s(r(m))))`, + GEN_TAC THEN + ASM_CASES_TAC `!n:num. ?p. n < p /\ !m. p <= m ==> s(m) <= s(p)` THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; NOT_IMP; DE_MORGAN_THM] THEN + REWRITE_TAC[RIGHT_OR_EXISTS_THM; SKOLEM_THM; REAL_NOT_LE; REAL_NOT_LT] THENL + [ABBREV_TAC `N = 0`; DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC)] THEN + DISCH_THEN(X_CHOOSE_THEN `next:num->num` STRIP_ASSUME_TAC) THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `(r 0 = next(SUC N)) /\ (!n. r(SUC n) = next(r n))` THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THENL + [SUBGOAL_THEN `!m:num n:num. r n <= m ==> s(m) <= s(r n):real` + ASSUME_TAC THEN TRY CONJ_TAC THEN TRY DISJ2_TAC THEN + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL; LT_IMP_LE; LT_TRANS]; + SUBGOAL_THEN `!n. N < (r:num->num) n` ASSUME_TAC THEN + TRY(CONJ_TAC THENL [GEN_TAC; DISJ1_TAC THEN GEN_TAC]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN + TRY STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LT_REFL; LT_LE; LTE_TRANS; REAL_LE_REFL; + REAL_LT_LE; REAL_LE_TRANS; LT]]);; + +let CONVERGENT_BOUNDED_INCREASING = prove + (`!s:num->real b. (!m n. m <= n ==> s m <= s n) /\ (!n. abs(s n) <= b) + ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x. ?n. (s:num->real) n = x` REAL_COMPLETE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `abs(x) <= b ==> x <= b`]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `l - e`) THEN + ASM_MESON_TAC[REAL_ARITH `&0 < e ==> ~(l <= l - e)`; + REAL_ARITH `x <= y /\ y <= l /\ ~(x <= l - e) ==> abs(y - l) < e`]);; + +let CONVERGENT_BOUNDED_MONOTONE = prove + (`!s:num->real b. (!n. abs(s n) <= b) /\ + ((!m n. m <= n ==> s m <= s n) \/ + (!m n. m <= n ==> s n <= s m)) + ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[CONVERGENT_BOUNDED_INCREASING]; ALL_TAC] THEN + MP_TAC(SPEC `\n. --((s:num->real) n)` CONVERGENT_BOUNDED_INCREASING) THEN + ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG] THEN + ASM_MESON_TAC[REAL_ARITH `abs(x - --l) = abs(--x - l)`]);; + +let COMPACT_REAL_LEMMA = prove + (`!s b. (!n:num. abs(s n) <= b) + ==> ?l r. (!m n:num. m < n ==> r(m) < r(n)) /\ + !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(r n) - l) < e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MP_TAC(SPEC `s:num->real` MONOTONE_SUBSEQUENCE) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN ASM_MESON_TAC[]);; + +let COMPACT_LEMMA = prove + (`!s. bounded s /\ (!n. (x:num->real^N) n IN s) + ==> !d. d <= dimindex(:N) + ==> ?l:real^N r. (!m n. m < n ==> r m < (r:num->num) n) /\ + !e. &0 < e + ==> ?N. !n i. 1 <= i /\ i <= d + ==> N <= n + ==> abs(x(r n)$i - l$i) < e`, + GEN_TAC THEN REWRITE_TAC[bounded] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; CONJ_ASSOC] THEN + DISCH_TAC THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN STRIP_TAC THEN + MP_TAC(SPECL [`\n:num. (x:num->real^N) (r n) $ (SUC d)`; `b:real`] + COMPACT_REAL_LEMMA) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; ARITH_RULE `1 <= SUC n`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` (X_CHOOSE_THEN `s:num->num` + STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC + [`(lambda k. if k = SUC d then y else (l:real^N)$k):real^N`; + `(r:num->num) o (s:num->num)`] THEN + ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REPEAT(FIRST_ASSUM(C UNDISCH_THEN (MP_TAC o SPEC `e:real`) o concl)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN + FIRST_ASSUM(fun th -> SIMP_TAC[LAMBDA_BETA; MATCH_MP(ARITH_RULE + `SUC d <= n ==> !i. 1 <= i /\ i <= SUC d ==> 1 <= i /\ i <= n`) th]) THEN + REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN TRY COND_CASES_TAC THEN + ASM_MESON_TAC[MONOTONE_BIGGER; LE_TRANS; + ARITH_RULE `N1 + N2 <= n ==> N2 <= n:num /\ N1 <= n`; + ARITH_RULE `1 <= i /\ i <= d /\ SUC d <= n + ==> ~(i = SUC d) /\ 1 <= SUC d /\ d <= n /\ i <= n`]);; + +let BOUNDED_CLOSED_IMP_COMPACT = prove + (`!s:real^N->bool. bounded s /\ closed s ==> compact s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[compact] THEN + X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` COMPACT_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN + REWRITE_TAC[LE_REFL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN ASM_SIMP_TAC[] THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN + REPEAT STRIP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_SEQUENTIAL_LIMITS]) THEN + EXISTS_TAC `(x:num->real^N) o (r:num->num)` THEN + ASM_REWRITE_TAC[o_THM]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / &(dimindex(:N))`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_NONZERO; + REAL_HALF; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`) + (SPEC_ALL NORM_LE_L1)) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (1..dimindex(:N)) + (\k. e / &2 / &(dimindex(:N)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN + SIMP_TAC[o_THM; LAMBDA_BETA; vector_sub] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; LE_TRANS]; + ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_DIV_LMUL; REAL_OF_NUM_EQ; + DIMINDEX_NONZERO; REAL_LE_REFL; REAL_LT_LDIV_EQ; ARITH; + REAL_OF_NUM_LT; REAL_ARITH `x < x * &2 <=> &0 < x`]]);; + +(* ------------------------------------------------------------------------- *) +(* Completeness. *) +(* ------------------------------------------------------------------------- *) + +let cauchy = new_definition + `cauchy (s:num->real^N) <=> + !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e`;; + +let complete = new_definition + `complete s <=> + !f:num->real^N. (!n. f n IN s) /\ cauchy f + ==> ?l. l IN s /\ (f --> l) sequentially`;; + +let CAUCHY = prove + (`!s:num->real^N. + cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL + [MESON_TAC[LE_REFL]; DISCH_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MESON_TAC[DIST_TRIANGLE_HALF_L]);; + +let CONVERGENT_IMP_CAUCHY = prove + (`!s l. (s --> l) sequentially ==> cauchy s`, + REWRITE_TAC[LIM_SEQUENTIALLY; cauchy] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + ASM_MESON_TAC[GE; LE_REFL; DIST_TRIANGLE_HALF_L]);; + +let CAUCHY_IMP_BOUNDED = prove + (`!s:num->real^N. cauchy s ==> bounded {y | ?n. y = s n}`, + REWRITE_TAC[cauchy; bounded; IN_ELIM_THM] THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[GE_REFL] THEN DISCH_TAC THEN + SUBGOAL_THEN `!n:num. N <= n ==> norm(s n :real^N) <= norm(s N) + &1` + ASSUME_TAC THENL + [ASM_MESON_TAC[GE; dist; DIST_SYM; NORM_TRIANGLE_SUB; + REAL_ARITH `a <= b + c /\ c < &1 ==> a <= b + &1`]; + MP_TAC(ISPECL [`\n:num. norm(s n :real^N)`; `0..N`] + UPPER_BOUND_FINITE_SET_REAL) THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LEFT_IMP_EXISTS_THM] THEN + ASM_MESON_TAC[LE_CASES; + REAL_ARITH `x <= a \/ x <= b ==> x <= abs a + abs b`]]);; + +let COMPACT_IMP_COMPLETE = prove + (`!s:real^N->bool. compact s ==> complete s`, + GEN_TAC THEN REWRITE_TAC[complete; compact] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:num->real^N` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_ADD)) THEN + DISCH_THEN(MP_TAC o SPEC `\n. (f:num->real^N)(n) - f(r n)`) THEN + DISCH_THEN(MP_TAC o SPEC `vec 0: real^N`) THEN ASM_REWRITE_TAC[o_THM] THEN + REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_ADD2; ETA_AX] THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cauchy]) THEN + REWRITE_TAC[GE; LIM; SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN + SUBGOAL_THEN `!n:num. n <= r(n)` MP_TAC THENL [INDUCT_TAC; ALL_TAC] THEN + ASM_MESON_TAC[ LE_TRANS; LE_REFL; LT; LET_TRANS; LE_0; LE_SUC_LT]);; + +let COMPLETE_UNIV = prove + (`complete(:real^N)`, + REWRITE_TAC[complete; IN_UNIV] THEN X_GEN_TAC `x:num->real^N` THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN + MP_TAC(ISPEC `closure {y:real^N | ?n:num. y = x n}` + COMPACT_IMP_COMPLETE) THEN + ASM_SIMP_TAC[BOUNDED_CLOSED_IMP_COMPACT; CLOSED_CLOSURE; complete] THEN + DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + ASM_REWRITE_TAC[closure; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]);; + +let COMPLETE_EQ_CLOSED = prove + (`!s:real^N->bool. complete s <=> closed s`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[complete; CLOSED_LIMPT; LIMPT_SEQUENTIAL] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[CONVERGENT_IMP_CAUCHY; IN_DELETE; LIM_UNIQUE; + TRIVIAL_LIMIT_SEQUENTIALLY]; + REWRITE_TAC[complete; CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN + X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN + MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN + DISCH_THEN(MP_TAC o SPEC `f:num->real^N`) THEN + ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]);; + +let CONVERGENT_EQ_CAUCHY = prove + (`!s. (?l. (s --> l) sequentially) <=> cauchy s`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONVERGENT_IMP_CAUCHY]; + REWRITE_TAC[REWRITE_RULE[complete; IN_UNIV] COMPLETE_UNIV]]);; + +let CONVERGENT_IMP_BOUNDED = prove + (`!s l. (s --> l) sequentially ==> bounded (IMAGE s (:num))`, + REWRITE_TAC[LEFT_FORALL_IMP_THM; CONVERGENT_EQ_CAUCHY] THEN + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN + REWRITE_TAC[IMAGE; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Total boundedness. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_IMP_TOTALLY_BOUNDED = prove + (`!s:real^N->bool. + compact s + ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\ + s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`; SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?x:num->real^N. !n. x(n) IN s /\ !m. m < n ==> ~(dist(x(m),x(n)) < e)` + MP_TAC THENL + [SUBGOAL_THEN + `?x:num->real^N. + !n. x(n) = @y. y IN s /\ !m. m < n ==> ~(dist(x(m),y) < e)` + MP_TAC THENL + [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(SUBST1_TAC o SPEC `n:num`) THEN STRIP_TAC THEN + CONV_TAC SELECT_CONV THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^N) {m | m < n}`) THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; NOT_FORALL_THM; NOT_IMP] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_BALL]; + ALL_TAC] THEN + REWRITE_TAC[compact; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:num->real^N` THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN + REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[o_THM; NOT_EXISTS_THM; NOT_IMP; NOT_FORALL_THM; NOT_IMP] THEN + X_GEN_TAC `N:num` THEN MAP_EVERY EXISTS_TAC [`N:num`; `SUC N`] THEN + CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[LT]]);; + +(* ------------------------------------------------------------------------- *) +(* Heine-Borel theorem (following Burkill & Burkill vol. 2) *) +(* ------------------------------------------------------------------------- *) + +let HEINE_BOREL_LEMMA = prove + (`!s:real^N->bool. + compact s + ==> !t. s SUBSET (UNIONS t) /\ (!b. b IN t ==> open b) + ==> ?e. &0 < e /\ + !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_ARITH `x <= y ==> x < y + &1`; + FORALL_AND_THM; REAL_POS; NOT_FORALL_THM; NOT_IMP; SKOLEM_THM; compact] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?b:real^N->bool. l IN b /\ b IN t` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_UNIONS]; ALL_TAC] THEN + SUBGOAL_THEN `?e. &0 < e /\ !z:real^N. dist(z,l) < e ==> z IN b` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_def]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + SUBGOAL_THEN `&0 < e / &2` (fun th -> + REWRITE_TAC[th; o_THM] THEN MP_TAC(GEN_REWRITE_RULE I [REAL_ARCH_INV] th)) + THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(r:num->num)(N1 + N2)`; `b:real^N->bool`]) THEN + ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_R THEN + EXISTS_TAC `(f:num->real^N)(r(N1 + N2:num))` THEN CONJ_TAC THENL + [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_MESON_TAC[ARITH_RULE `(~(n = 0) ==> 0 < n)`; LE_ADD; MONOTONE_BIGGER; + LT_IMP_LE; LE_TRANS]);; + +let COMPACT_IMP_HEINE_BOREL = prove + (`!s. compact (s:real^N->bool) + ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `f:(real^N->bool)->bool` o + MATCH_MP HEINE_BOREL_LEMMA) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real^N->real^N->bool`) THEN + FIRST_ASSUM(MP_TAC o SPEC `e:real` o + MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[IN_UNIONS; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (B:real^N->real^N->bool) k` THEN + ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN + ASM_MESON_TAC[IN_BALL]);; + +(* ------------------------------------------------------------------------- *) +(* Bolzano-Weierstrass property. *) +(* ------------------------------------------------------------------------- *) + +let HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. + (!f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')) + ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM; limit_point_of] THEN REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> c ==> ~d ==> a ==> ~b`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; RIGHT_AND_FORALL_THM] THEN + DISCH_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `f:real^N->real^N->bool`) THEN + DISCH_THEN(MP_TAC o SPEC + `{t:real^N->bool | ?x:real^N. x IN s /\ (t = f x)}`) THEN + REWRITE_TAC[INFINITE; SUBSET; IN_ELIM_THM; IN_UNIONS; NOT_IMP] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:real^N | x IN t /\ (f(x):real^N->bool) IN g}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ_GENERAL THEN ASM_MESON_TAC[SUBSET]; + SIMP_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN + DISCH_TAC THEN SUBGOAL_THEN `(u:real^N) IN s` ASSUME_TAC THEN + ASM_MESON_TAC[SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Complete the chain of compactness variants. *) +(* ------------------------------------------------------------------------- *) + +let BOLZANO_WEIERSTRASS_IMP_BOUNDED = prove + (`!s:real^N->bool. + (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t) + ==> bounded s`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[compact; bounded] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; SKOLEM_THM; NOT_IMP] THEN + REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `beyond:real->real^N`) THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `(f(0) = beyond(&0)) /\ + (!n. f(SUC n) = beyond(norm(f n) + &1):real^N)` THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (x:num->real^N) UNIV` THEN + SUBGOAL_THEN + `!m n. m < n ==> norm((x:num->real^N) m) + &1 < norm(x n)` + ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN + ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `b < b + &1`]; + ALL_TAC] THEN + SUBGOAL_THEN `!m n. ~(m = n) ==> &1 < dist((x:num->real^N) m,x n)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`m:num`; `n:num`] LT_CASES) THEN + ASM_MESON_TAC[dist; LT_CASES; NORM_TRIANGLE_SUB; NORM_SUB; + REAL_ARITH `x + &1 < y /\ y <= x + d ==> &1 < d`]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[INFINITE_IMAGE_INJ; num_INFINITE; DIST_REFL; + REAL_ARITH `~(&1 < &0)`]; + REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + REWRITE_TAC[IN_IMAGE; IN_UNIV; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `dist((x:num->real^N) k,l)`) THEN + ASM_SIMP_TAC[DIST_POS_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `m:num = k` THEN + ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; REAL_LT_TRANS; REAL_LT_REFL]);; + +let SEQUENCE_INFINITE_LEMMA = prove + (`!f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially + ==> INFINITE {y:real^N | ?n. y = f n}`, + REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC + `IMAGE (\y:real^N. dist(y,l)) {y | ?n:num. y = f n}` INF_FINITE) THEN + ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE; FINITE_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[LIM_SEQUENTIALLY; LE_REFL; REAL_NOT_LE; DIST_POS_LT]);; + +let LIMPT_OF_SEQUENCE_SUBSEQUENCE = prove + (`!f:num->real^N l. + l limit_point_of (IMAGE f (:num)) + ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC + `inf((inv(&n + &1)) INSERT + IMAGE (\k. dist((f:num->real^N) k,l)) + {k | k IN 0..n /\ ~(f k = l)})`) THEN + SIMP_TAC[REAL_LT_INF_FINITE; FINITE_INSERT; NOT_INSERT_EMPTY; + FINITE_RESTRICT; FINITE_NUMSEG; FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + SIMP_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; GSYM DIST_NZ; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `nn:num->num` STRIP_ASSUME_TAC) THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `r 0 = nn 0 /\ (!n. r (SUC n) = nn(r n))` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN + STRIP_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[LT_TRANS] THEN + X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(r:num->num) n`; `(nn:num->num)(r(n:num))`]) THEN + ASM_REWRITE_TAC[IN_NUMSEG; LE_0; REAL_LT_REFL] THEN ARITH_TAC; + DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LE] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN + ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `inv(&((r:num->num) n) + &1)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(ARITH_RULE `N <= SUC n /\ n <= r n ==> N <= r n + 1`) THEN + ASM_REWRITE_TAC[]);; + +let SEQUENCE_UNIQUE_LIMPT = prove + (`!f l l':real^N. + (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n} + ==> l' = l`, + REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f (:num)`] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `(f:num->real^N) o (r:num->num)` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUBSEQUENCE]);; + +let BOLZANO_WEIERSTRASS_IMP_CLOSED = prove + (`!s:real^N->bool. + (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t) + ==> closed s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN + MAP_EVERY X_GEN_TAC [`f:num->real^N`; `l:real^N`] THEN + DISCH_TAC THEN + MAP_EVERY (MP_TAC o ISPECL [`f:num->real^N`; `l:real^N`]) + [SEQUENCE_UNIQUE_LIMPT; SEQUENCE_INFINITE_LEMMA] THEN + MATCH_MP_TAC(TAUT + `(~d ==> a /\ ~(b /\ c)) ==> (a ==> b) ==> c ==> d`) THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | ?n:num. y = f n}`) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM]; + ABBREV_TAC `t = {y:real^N | ?n:num. y = f n}`] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence express everything as an equivalence. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_EQ_HEINE_BOREL = prove + (`!s:real^N->bool. + compact s <=> + !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[COMPACT_IMP_HEINE_BOREL] THEN + DISCH_THEN(MP_TAC o MATCH_MP HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS) THEN + DISCH_TAC THEN MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN + ASM_MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; + BOLZANO_WEIERSTRASS_IMP_CLOSED]);; + +let COMPACT_EQ_BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. + compact s <=> + !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, + GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[COMPACT_EQ_HEINE_BOREL; HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS]; + MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED; + BOUNDED_CLOSED_IMP_COMPACT]]);; + +let COMPACT_EQ_BOUNDED_CLOSED = prove + (`!s:real^N->bool. compact s <=> bounded s /\ closed s`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSED_IMP_COMPACT] THEN + MESON_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; BOLZANO_WEIERSTRASS_IMP_BOUNDED; + BOLZANO_WEIERSTRASS_IMP_CLOSED]);; + +let COMPACT_IMP_BOUNDED = prove + (`!s. compact s ==> bounded s`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; + +let COMPACT_IMP_CLOSED = prove + (`!s. compact s ==> closed s`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; + +let COMPACT_SEQUENCE_WITH_LIMIT = prove + (`!f l:real^N. + (f --> l) sequentially ==> compact (l INSERT IMAGE f (:num))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + REWRITE_TAC[BOUNDED_INSERT] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONVERGENT_IMP_BOUNDED]; + SIMP_TAC[CLOSED_LIMPT; LIMPT_INSERT; IN_INSERT] THEN + REWRITE_TAC[IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN + MATCH_MP_TAC SEQUENCE_UNIQUE_LIMPT THEN ASM_MESON_TAC[]]);; + +let CLOSED_IN_COMPACT = prove + (`!s t:real^N->bool. + compact s /\ closed_in (subtopology euclidean s) t + ==> compact t`, + SIMP_TAC[IMP_CONJ; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_EQ] THEN + MESON_TAC[BOUNDED_SUBSET]);; + +let CLOSED_IN_COMPACT_EQ = prove + (`!s t. compact s + ==> (closed_in (subtopology euclidean s) t <=> + compact t /\ t SUBSET s)`, + MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A version of Heine-Borel for subtopology. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY = prove + (`!s:real^N->bool. + compact s <=> + (!f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\ + s SUBSET UNIONS f + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET UNIONS f')`, + GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `f:(real^N->bool)->bool` THENL + [REWRITE_TAC[OPEN_IN_OPEN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `m:(real^N->bool)->(real^N->bool)`) ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `IMAGE (m:(real^N->bool)->(real^N->bool)) f`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\t:real^N->bool. s INTER t) f'` THEN + ASM_SIMP_TAC[FINITE_IMAGE; UNIONS_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_IMAGE]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET]; + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{s INTER t:real^N->bool | t IN f}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_IN_OPEN; UNIONS_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More easy lemmas. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_CLOSURE = prove + (`!s. compact(closure s) <=> bounded s`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE_EQ]);; + +let BOLZANO_WEIERSTRASS_CONTRAPOS = prove + (`!s t:real^N->bool. + compact s /\ t SUBSET s /\ + (!x. x IN s ==> ~(x limit_point_of t)) + ==> FINITE t`, + REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; INFINITE] THEN MESON_TAC[]);; + +let DISCRETE_BOUNDED_IMP_FINITE = prove + (`!s:real^N->bool e. + &0 < e /\ + (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) /\ + bounded s + ==> FINITE s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `compact(s:real^N->bool)` MP_TAC THENL + [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_MESON_TAC[DISCRETE_IMP_CLOSED]; + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. ball(x,e)) s`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; UNIONS_IMAGE; IN_ELIM_THM] THEN + ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_BALL; dist] THEN ASM_MESON_TAC[SUBSET]);; + +let BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP NO_LIMIT_POINT_IMP_CLOSED) THEN + STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` COMPACT_EQ_BOLZANO_WEIERSTRASS) THEN + ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]);; + +let BOUNDED_EQ_BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. + bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t`, + MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS; + BOUNDED_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, some common special cases. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_EMPTY = prove + (`compact {}`, + REWRITE_TAC[compact; NOT_IN_EMPTY]);; + +let COMPACT_UNION = prove + (`!s t. compact s /\ compact t ==> compact (s UNION t)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_UNION; CLOSED_UNION]);; + +let COMPACT_INTER = prove + (`!s t. compact s /\ compact t ==> compact (s INTER t)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; CLOSED_INTER]);; + +let COMPACT_INTER_CLOSED = prove + (`!s t. compact s /\ closed t ==> compact (s INTER t)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER] THEN + MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; + +let CLOSED_INTER_COMPACT = prove + (`!s t. closed s /\ compact t ==> compact (s INTER t)`, + MESON_TAC[COMPACT_INTER_CLOSED; INTER_COMM]);; + +let COMPACT_INTERS = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> compact s) /\ ~(f = {}) + ==> compact(INTERS f)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTERS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_INTERS THEN ASM SET_TAC[]);; + +let FINITE_IMP_CLOSED = prove + (`!s. FINITE s ==> closed s`, + MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED; INFINITE; FINITE_SUBSET]);; + +let FINITE_IMP_CLOSED_IN = prove + (`!s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s`, + SIMP_TAC[CLOSED_SUBSET_EQ; FINITE_IMP_CLOSED]);; + +let FINITE_IMP_COMPACT = prove + (`!s. FINITE s ==> compact s`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; FINITE_IMP_CLOSED; FINITE_IMP_BOUNDED]);; + +let COMPACT_SING = prove + (`!a. compact {a}`, + SIMP_TAC[FINITE_IMP_COMPACT; FINITE_RULES]);; + +let COMPACT_INSERT = prove + (`!a s. compact s ==> compact(a INSERT s)`, + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + SIMP_TAC[COMPACT_UNION; COMPACT_SING]);; + +let CLOSED_SING = prove + (`!a. closed {a}`, + MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_SING]);; + +let CLOSED_IN_SING = prove + (`!u x:real^N. closed_in (subtopology euclidean u) {x} <=> x IN u`, + SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_SING] THEN SET_TAC[]);; + +let CLOSURE_SING = prove + (`!x:real^N. closure {x} = {x}`, + SIMP_TAC[CLOSURE_CLOSED; CLOSED_SING]);; + +let CLOSED_INSERT = prove + (`!a s. closed s ==> closed(a INSERT s)`, + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + SIMP_TAC[CLOSED_UNION; CLOSED_SING]);; + +let COMPACT_CBALL = prove + (`!x e. compact(cball(x,e))`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_CBALL; CLOSED_CBALL]);; + +let COMPACT_FRONTIER_BOUNDED = prove + (`!s. bounded s ==> compact(frontier s)`, + SIMP_TAC[frontier; COMPACT_EQ_BOUNDED_CLOSED; + CLOSED_DIFF; OPEN_INTERIOR; CLOSED_CLOSURE] THEN + MESON_TAC[SUBSET_DIFF; BOUNDED_SUBSET; BOUNDED_CLOSURE]);; + +let COMPACT_FRONTIER = prove + (`!s. compact s ==> compact (frontier s)`, + MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_FRONTIER_BOUNDED]);; + +let BOUNDED_FRONTIER = prove + (`!s:real^N->bool. bounded s ==> bounded(frontier s)`, + MESON_TAC[COMPACT_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);; + +let FRONTIER_SUBSET_COMPACT = prove + (`!s. compact s ==> frontier s SUBSET s`, + MESON_TAC[FRONTIER_SUBSET_CLOSED; COMPACT_EQ_BOUNDED_CLOSED]);; + +let OPEN_DELETE = prove + (`!s x. open s ==> open(s DELETE x)`, + let lemma = prove(`s DELETE x = s DIFF {x}`,SET_TAC[]) in + SIMP_TAC[lemma; OPEN_DIFF; CLOSED_SING]);; + +let OPEN_IN_DELETE = prove + (`!u s a:real^N. + open_in (subtopology euclidean u) s + ==> open_in (subtopology euclidean u) (s DELETE a)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL + [ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]]);; + +let CLOSED_INTERS_COMPACT = prove + (`!s:real^N->bool. + closed s <=> !e. compact(cball(vec 0,e) INTER s)`, + GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_CBALL; + BOUNDED_INTER; BOUNDED_CBALL]; + ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `norm(x:real^N) + &1`) THEN + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN + REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &2)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `y:real^N` THEN SIMP_TAC[IN_INTER; IN_CBALL] THEN NORM_ARITH_TAC);; + +let COMPACT_UNIONS = prove + (`!s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(UNIONS s)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_UNIONS; BOUNDED_UNIONS]);; + +let COMPACT_DIFF = prove + (`!s t. compact s /\ open t ==> compact(s DIFF t)`, + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + SIMP_TAC[COMPACT_INTER_CLOSED; GSYM OPEN_CLOSED]);; + +let COMPACT_SPHERE = prove + (`!a:real^N r. compact(sphere(a,r))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN + REWRITE_TAC[COMPACT_CBALL]);; + +let BOUNDED_SPHERE = prove + (`!a:real^N r. bounded(sphere(a,r))`, + SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_BOUNDED]);; + +let CLOSED_SPHERE = prove + (`!a r. closed(sphere(a,r))`, + SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED]);; + +let FRONTIER_SING = prove + (`!a:real^N. frontier {a} = {a}`, + REWRITE_TAC[frontier; CLOSURE_SING; INTERIOR_SING; DIFF_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Finite intersection property. I could make it an equivalence in fact. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_IMP_FIP = prove + (`!s:real^N->bool f. + compact s /\ + (!t. t IN f ==> closed t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) + ==> ~(s INTER (INTERS f) = {})`, + let lemma = prove(`(s = UNIV DIFF t) <=> (UNIV DIFF s = t)`,SET_TAC[]) in + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) f`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[OPEN_DIFF; CLOSED_DIFF; OPEN_UNIV; CLOSED_UNIV; NOT_IMP] THEN + CONJ_TAC THENL + [UNDISCH_TAC `(s:real^N->bool) INTER INTERS f = {}` THEN + ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) g`) THEN + ASM_CASES_TAC `FINITE(g:(real^N->bool)->bool)` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER; IN_INTERS; IN_IMAGE; IN_DIFF; + IN_UNIV; NOT_IN_EMPTY; lemma; UNWIND_THM1; IN_UNIONS] THEN + SET_TAC[]]);; + +let CLOSED_IMP_FIP = prove + (`!s:real^N->bool f. + closed s /\ + (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) + ==> ~(s INTER (INTERS f) = {})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})`) THEN + MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CLOSED_INTER_COMPACT; COMPACT_EQ_BOUNDED_CLOSED]; + REWRITE_TAC[INTER_ASSOC] THEN ONCE_REWRITE_TAC[GSYM INTERS_INSERT]] THEN + GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[FINITE_INSERT; INSERT_SUBSET]);; + +let CLOSED_IMP_FIP_COMPACT = prove + (`!s:real^N->bool f. + closed s /\ (!t. t IN f ==> compact t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) + ==> ~(s INTER (INTERS f) = {})`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_SIMP_TAC[SUBSET_EMPTY; INTERS_0; INTER_UNIV] THENL + [MESON_TAC[FINITE_EMPTY]; ALL_TAC] THEN + STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; MEMBER_NOT_EMPTY]);; + +let CLOSED_FIP = prove + (`!f. (!t:real^N->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN + MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; + +let COMPACT_FIP = prove + (`!f. (!t:real^N->bool. t IN f ==> compact t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN + MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN + ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Bounded closed nest property (proof does not use Heine-Borel). *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_CLOSED_NEST = prove + (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ + (!m n. m <= n ==> s(n) SUBSET s(m)) /\ + bounded(s 0) + ==> ?a:real^N. !n:num. a IN s(n)`, + GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `compact(s 0:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT]; ALL_TAC] THEN + REWRITE_TAC[compact] THEN + DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_0]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~(~p)`] THEN + GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + MP_TAC(ISPECL [`l:real^N`; `(s:num->real^N->bool) N`] + CLOSED_APPROACHABLE) THEN + ASM_MESON_TAC[SUBSET; LE_REFL; LE_TRANS; LE_CASES; MONOTONE_BIGGER]);; + +(* ------------------------------------------------------------------------- *) +(* Decreasing case does not even need compactness, just completeness. *) +(* ------------------------------------------------------------------------- *) + +let DECREASING_CLOSED_NEST = prove + (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ + (!m n. m <= n ==> s(n) SUBSET s(m)) /\ + (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) + ==> ?a:real^N. !n:num. a IN s(n)`, + GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?l:real^N. (a --> l) sequentially` MP_TAC THENL + [ASM_MESON_TAC[cauchy; GE; SUBSET; LE_TRANS; LE_REFL; + complete; COMPLETE_UNIV; IN_UNIV]; + ASM_MESON_TAC[LIM_SEQUENTIALLY; CLOSED_APPROACHABLE; + SUBSET; LE_REFL; LE_TRANS; LE_CASES]]);; + +(* ------------------------------------------------------------------------- *) +(* Strengthen it to the intersection actually being a singleton. *) +(* ------------------------------------------------------------------------- *) + +let DECREASING_CLOSED_NEST_SING = prove + (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ + (!m n. m <= n ==> s(n) SUBSET s(m)) /\ + (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) + ==> ?a:real^N. INTERS {t | ?n:num. t = s n} = {a}`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERS; IN_SING; IN_ELIM_THM] THEN + ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL; SUBSET; LE_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* A version for a more general chain, not indexed by N. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_CLOSED_CHAIN = prove + (`!f b:real^N->bool. + (!s. s IN f ==> closed s /\ ~(s = {})) /\ + (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\ + b IN f /\ bounded b + ==> ~(INTERS f = {})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `~(b INTER (INTERS f):real^N->bool = {})` MP_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC COMPACT_IMP_FIP THEN + ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `?s:real^N->bool. s IN f /\ !t. t IN u ==> s SUBSET t` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + UNDISCH_TAC `(u:(real^N->bool)->bool) SUBSET f` THEN + UNDISCH_TAC `FINITE(u:(real^N->bool)->bool)` THEN + SPEC_TAC(`u:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:(real^N->bool)->bool`] THEN + REWRITE_TAC[INSERT_SUBSET] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Analogous things directly for compactness. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_CHAIN = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> compact s /\ ~(s = {})) /\ + (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) + ==> ~(INTERS f = {})`, + GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[INTERS_0] THEN SET_TAC[]; + MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM SET_TAC[]]);; + +let COMPACT_NEST = prove + (`!s. (!n. compact(s n) /\ ~(s n = {})) /\ + (!m n. m <= n ==> s n SUBSET s m) + ==> ~(INTERS {s n | n IN (:num)} = {})`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy-type criteria for *uniform* convergence. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONVERGENT_EQ_CAUCHY = prove + (`!P s:num->A->real^N. + (?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=> + (!e. &0 < e + ==> ?N. !m n x. N <= m /\ N <= n /\ P x + ==> dist(s m x,s n x) < e)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `l:A->real^N`) THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x:A. P x ==> cauchy (\n. s n x :real^N)` MP_TAC THENL + [REWRITE_TAC[cauchy; GE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `l:A->real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `N + M:num`; `x:A`]) THEN + ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN + ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; + +let UNIFORMLY_CONVERGENT_EQ_CAUCHY_ALT = prove + (`!P s:num->A->real^N. + (?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=> + (!e. &0 < e + ==> ?N. !m n x. N <= m /\ N <= n /\ m < n /\ P x + ==> dist(s m x,s n x) < e)`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC WLOG_LT THEN + ASM_SIMP_TAC[DIST_REFL] THEN MESON_TAC[DIST_SYM]);; + +let UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT = prove + (`!P (s:num->A->real^N) l. + (!e. &0 < e + ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\ + (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e) + ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `l':A->real^N`) ASSUME_TAC) THEN + SUBGOAL_THEN `!x. P x ==> (l:A->real^N) x = l' x` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n. (s:num->A->real^N) n x` THEN + REWRITE_TAC[LIM_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Define continuity over a net to take in restrictions of the set. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("continuous",(12,"right"));; + +let continuous = new_definition + `f continuous net <=> (f --> f(netlimit net)) net`;; + +let CONTINUOUS_TRIVIAL_LIMIT = prove + (`!f net. trivial_limit net ==> f continuous net`, + SIMP_TAC[continuous; LIM]);; + +let CONTINUOUS_WITHIN = prove + (`!f x:real^M. f continuous (at x within s) <=> (f --> f(x)) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN + ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL + [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; + +let CONTINUOUS_AT = prove + (`!f (x:real^N). f continuous (at x) <=> (f --> f(x)) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; IN_UNIV]);; + +let CONTINUOUS_AT_WITHIN = prove + (`!f:real^M->real^N x s. + f continuous (at x) ==> f continuous (at x within s)`, + SIMP_TAC[LIM_AT_WITHIN; CONTINUOUS_AT; CONTINUOUS_WITHIN]);; + +let CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL = prove + (`!a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)`, + ASM_SIMP_TAC[continuous; LIM; LIM_WITHIN_CLOSED_TRIVIAL]);; + +let CONTINUOUS_TRANSFORM_WITHIN = prove + (`!f g:real^M->real^N s x d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ dist(x',x) < d ==> f(x') = g(x')) /\ + f continuous (at x within s) + ==> g continuous (at x within s)`, + REWRITE_TAC[CONTINUOUS_WITHIN] THEN + MESON_TAC[LIM_TRANSFORM_WITHIN; DIST_REFL]);; + +let CONTINUOUS_TRANSFORM_AT = prove + (`!f g:real^M->real^N x d. + &0 < d /\ (!x'. dist(x',x) < d ==> f(x') = g(x')) /\ + f continuous (at x) + ==> g continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT] THEN + MESON_TAC[LIM_TRANSFORM_AT; DIST_REFL]);; + +let CONTINUOUS_TRANSFORM_WITHIN_OPEN = prove + (`!f g:real^M->real^N s a. + open s /\ a IN s /\ + (!x. x IN s ==> f x = g x) /\ + f continuous at a + ==> g continuous at a`, + MESON_TAC[CONTINUOUS_AT; LIM_TRANSFORM_WITHIN_OPEN]);; + +let CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN = prove + (`!f g:real^M->real^N s t a. + open_in (subtopology euclidean t) s /\ a IN s /\ + (!x. x IN s ==> f x = g x) /\ + f continuous (at a within t) + ==> g continuous (at a within t)`, + MESON_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_OPEN_IN]);; + +(* ------------------------------------------------------------------------- *) +(* Derive the epsilon-delta forms, which we often use as "definitions" *) +(* ------------------------------------------------------------------------- *) + +let continuous_within = prove + (`f continuous (at x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`, + REWRITE_TAC[CONTINUOUS_WITHIN; LIM_WITHIN] THEN + REWRITE_TAC[GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]);; + +let continuous_at = prove + (`f continuous (at x) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[continuous_within; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Versions in terms of open balls. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_BALL = prove + (`!f s x. f continuous (at x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)`, + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_within; IN_INTER] THEN + MESON_TAC[DIST_SYM]);; + +let CONTINUOUS_AT_BALL = prove + (`!f x. f continuous (at x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + IMAGE f (ball(x,d)) SUBSET ball(f x,e)`, + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_at] THEN + MESON_TAC[DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* For setwise continuity, just start from the epsilon-delta definitions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("continuous_on",(12,"right"));; +parse_as_infix ("uniformly_continuous_on",(12,"right"));; + +let continuous_on = new_definition + `f continuous_on s <=> + !x. x IN s ==> !e. &0 < e + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x',x) < d + ==> dist(f(x'),f(x)) < e`;; + +let uniformly_continuous_on = new_definition + `f uniformly_continuous_on s <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x x'. x IN s /\ x' IN s /\ dist(x',x) < d + ==> dist(f(x'),f(x)) < e`;; + +(* ------------------------------------------------------------------------- *) +(* Some simple consequential lemmas. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS = prove + (`!f s. f uniformly_continuous_on s ==> f continuous_on s`, + REWRITE_TAC[uniformly_continuous_on; continuous_on] THEN MESON_TAC[]);; + +let CONTINUOUS_AT_IMP_CONTINUOUS_ON = prove + (`!f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s`, + REWRITE_TAC[continuous_at; continuous_on] THEN MESON_TAC[]);; + +let CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove + (`!f s. f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)`, + REWRITE_TAC[continuous_on; continuous_within]);; + +let CONTINUOUS_ON = prove + (`!f (s:real^N->bool). + f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN]);; + +let CONTINUOUS_ON_EQ_CONTINUOUS_AT = prove + (`!f:real^M->real^N s. + open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))`, + SIMP_TAC[CONTINUOUS_ON; CONTINUOUS_AT; LIM_WITHIN_OPEN]);; + +let CONTINUOUS_WITHIN_SUBSET = prove + (`!f s t x. f continuous (at x within s) /\ t SUBSET s + ==> f continuous (at x within t)`, + REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]);; + +let CONTINUOUS_ON_SUBSET = prove + (`!f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t`, + REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; + +let UNIFORMLY_CONTINUOUS_ON_SUBSET = prove + (`!f s t. f uniformly_continuous_on s /\ t SUBSET s + ==> f uniformly_continuous_on t`, + REWRITE_TAC[uniformly_continuous_on] THEN + MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; + +let CONTINUOUS_ON_INTERIOR = prove + (`!f:real^M->real^N s x. + f continuous_on s /\ x IN interior(s) ==> f continuous at x`, + REWRITE_TAC[interior; IN_ELIM_THM] THEN + MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; CONTINUOUS_ON_SUBSET]);; + +let CONTINUOUS_ON_EQ = prove + (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f continuous_on s + ==> g continuous_on s`, + SIMP_TAC[continuous_on; IMP_CONJ]);; + +let UNIFORMLY_CONTINUOUS_ON_EQ = prove + (`!f g s. + (!x. x IN s ==> f x = g x) /\ f uniformly_continuous_on s + ==> g uniformly_continuous_on s`, + SIMP_TAC[uniformly_continuous_on; IMP_CONJ]);; + +let CONTINUOUS_ON_SING = prove + (`!f:real^M->real^N a. f continuous_on {a}`, + SIMP_TAC[continuous_on; IN_SING; FORALL_UNWIND_THM2; DIST_REFL] THEN + MESON_TAC[]);; + +let CONTINUOUS_ON_EMPTY = prove + (`!f:real^M->real^N. f continuous_on {}`, + MESON_TAC[CONTINUOUS_ON_SING; EMPTY_SUBSET; CONTINUOUS_ON_SUBSET]);; + +let CONTINUOUS_ON_NO_LIMPT = prove + (`!f:real^M->real^N s. + ~(?x. x limit_point_of s) ==> f continuous_on s`, + REWRITE_TAC[continuous_on; LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]);; + +let CONTINUOUS_ON_FINITE = prove + (`!f:real^M->real^N s. FINITE s ==> f continuous_on s`, + MESON_TAC[CONTINUOUS_ON_NO_LIMPT; LIMIT_POINT_FINITE]);; + +let CONTRACTION_IMP_CONTINUOUS_ON = prove + (`!f:real^M->real^N. + (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y)) + ==> f continuous_on s`, + SIMP_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);; + +let ISOMETRY_ON_IMP_CONTINUOUS_ON = prove + (`!f:real^M->real^N. + (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) + ==> f continuous_on s`, + SIMP_TAC[CONTRACTION_IMP_CONTINUOUS_ON; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Characterization of various kinds of continuity in terms of sequences. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_SEQUENTIALLY = prove + (`!f a:real^N. + f continuous (at a within s) <=> + !x. (!n. x(n) IN s) /\ (x --> a) sequentially + ==> ((f o x) --> f(a)) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL + [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; + REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN + X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; + REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]);; + +let CONTINUOUS_AT_SEQUENTIALLY = prove + (`!f a:real^N. + f continuous (at a) <=> + !x. (x --> a) sequentially + ==> ((f o x) --> f(a)) sequentially`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_UNIV]);; + +let CONTINUOUS_ON_SEQUENTIALLY = prove + (`!f s:real^N->bool. + f continuous_on s <=> + !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially + ==> ((f o x) --> f(a)) sequentially`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; + +let UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove + (`!f s:real^N->bool. + f uniformly_continuous_on s <=> + !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\ + ((\n. x(n) - y(n)) --> vec 0) sequentially + ==> ((\n. f(x(n)) - f(y(n))) --> vec 0) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN + EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; + REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N` THEN + REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN CONJ_TAC THENL + [MATCH_MP_TAC FORALL_POS_MONO_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; + REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]; + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `\x:num. x` THEN ASM_REWRITE_TAC[LE_REFL]]);; + +let LIM_CONTINUOUS_FUNCTION = prove + (`!f net g l. + f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net`, + REWRITE_TAC[tendsto; continuous_at; eventually] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combination results for pointwise continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_CONST = prove + (`!net c. (\x. c) continuous net`, + REWRITE_TAC[continuous; LIM_CONST]);; + +let CONTINUOUS_CMUL = prove + (`!f c net. f continuous net ==> (\x. c % f(x)) continuous net`, + REWRITE_TAC[continuous; LIM_CMUL]);; + +let CONTINUOUS_NEG = prove + (`!f net. f continuous net ==> (\x. --(f x)) continuous net`, + REWRITE_TAC[continuous; LIM_NEG]);; + +let CONTINUOUS_ADD = prove + (`!f g net. f continuous net /\ g continuous net + ==> (\x. f(x) + g(x)) continuous net`, + REWRITE_TAC[continuous; LIM_ADD]);; + +let CONTINUOUS_SUB = prove + (`!f g net. f continuous net /\ g continuous net + ==> (\x. f(x) - g(x)) continuous net`, + REWRITE_TAC[continuous; LIM_SUB]);; + +let CONTINUOUS_ABS = prove + (`!(f:A->real^N) net. + f continuous net + ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous net`, + REWRITE_TAC[continuous; LIM_ABS]);; + +let CONTINUOUS_MAX = prove + (`!(f:A->real^N) (g:A->real^N) net. + f continuous net /\ g continuous net + ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous net`, + REWRITE_TAC[continuous; LIM_MAX]);; + +let CONTINUOUS_MIN = prove + (`!(f:A->real^N) (g:A->real^N) net. + f continuous net /\ g continuous net + ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous net`, + REWRITE_TAC[continuous; LIM_MIN]);; + +let CONTINUOUS_VSUM = prove + (`!net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net) + ==> (\x. vsum s (\a. f a x)) continuous net`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; + CONTINUOUS_CONST; CONTINUOUS_ADD; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing for setwise continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CONST = prove + (`!s c. (\x. c) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CONST]);; + +let CONTINUOUS_ON_CMUL = prove + (`!f c s. f continuous_on s ==> (\x. c % f(x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CMUL]);; + +let CONTINUOUS_ON_NEG = prove + (`!f s. f continuous_on s + ==> (\x. --(f x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_NEG]);; + +let CONTINUOUS_ON_ADD = prove + (`!f g s. f continuous_on s /\ g continuous_on s + ==> (\x. f(x) + g(x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ADD]);; + +let CONTINUOUS_ON_SUB = prove + (`!f g s. f continuous_on s /\ g continuous_on s + ==> (\x. f(x) - g(x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SUB]);; + +let CONTINUOUS_ON_ABS = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ABS]);; + +let CONTINUOUS_ON_MAX = prove + (`!f:real^M->real^N g:real^M->real^N s. + f continuous_on s /\ g continuous_on s + ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) + continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MAX]);; + +let CONTINUOUS_ON_MIN = prove + (`!f:real^M->real^N g:real^M->real^N s. + f continuous_on s /\ g continuous_on s + ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) + continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MIN]);; + +let CONTINUOUS_ON_VSUM = prove + (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t) + ==> (\x. vsum s (\a. f a x)) continuous_on t`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_VSUM]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing for uniform continuity, using sequential formulations. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_ON_CONST = prove + (`!s c. (\x. c) uniformly_continuous_on s`, + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF; + VECTOR_SUB_REFL; LIM_CONST]);; + +let LINEAR_UNIFORMLY_CONTINUOUS_ON = prove + (`!f:real^M->real^N s. linear f ==> f uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[uniformly_continuous_on; dist; GSYM LINEAR_SUB] THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_BOUNDED_POS) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * norm(y - x:real^M)` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LT_RDIV_EQ; REAL_MUL_SYM]);; + +let UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove + (`!f g s. f uniformly_continuous_on s /\ + g uniformly_continuous_on (IMAGE f s) + ==> (g o f) uniformly_continuous_on s`, + let lemma = prove + (`(!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=> + (!x. P x /\ Q (f x) ==> R (f x))`, + MESON_TAC[]) in + REPEAT GEN_TAC THEN + REWRITE_TAC[uniformly_continuous_on; o_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +let BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove + (`!f:real^M->real^N g (h:real^N->real^P->real^Q) s. + f uniformly_continuous_on s /\ g uniformly_continuous_on s /\ + bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s) + ==> (\x. h (f x) (g x)) uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!a b c d. (h:real^N->real^P->real^Q) a b - h c d = + h (a - c) b + h c (b - d)` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP BILINEAR_BOUNDED_POS) THEN + UNDISCH_TAC `bounded(IMAGE (g:real^M->real^P) s)` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(g:real^M->real^P) uniformly_continuous_on s` THEN + UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on s` THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B1`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`])) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `norm(x) <= a /\ norm(y) <= b ==> norm(x + y:real^N) <= a + b`) THEN + CONJ_TAC THEN + FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + ASM_REAL_ARITH_TAC]);; + +let UNIFORMLY_CONTINUOUS_ON_MUL = prove + (`!f g:real^M->real^N s. + (lift o f) uniformly_continuous_on s /\ g uniformly_continuous_on s /\ + bounded(IMAGE (lift o f) s) /\ bounded(IMAGE g s) + ==> (\x. f x % g x) uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o (f:real^M->real)`; `g:real^M->real^N`; + `\c (v:real^N). drop c % v`; `s:real^M->bool`] + BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; + +let UNIFORMLY_CONTINUOUS_ON_CMUL = prove + (`!f c s. f uniformly_continuous_on s + ==> (\x. c % f(x)) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN + ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_RZERO]);; + +let UNIFORMLY_CONTINUOUS_ON_VMUL = prove + (`!s:real^M->bool c v:real^N. + (lift o c) uniformly_continuous_on s + ==> (\x. c x % v) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o ISPEC `\x. (drop x % v:real^N)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN + MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);; + +let UNIFORMLY_CONTINUOUS_ON_NEG = prove + (`!f s. f uniformly_continuous_on s + ==> (\x. --(f x)) uniformly_continuous_on s`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]);; + +let UNIFORMLY_CONTINUOUS_ON_ADD = prove + (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s + ==> (\x. f(x) + g(x)) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[VECTOR_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; + +let UNIFORMLY_CONTINUOUS_ON_SUB = prove + (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s + ==> (\x. f(x) - g(x)) uniformly_continuous_on s`, + REWRITE_TAC[VECTOR_SUB] THEN + SIMP_TAC[UNIFORMLY_CONTINUOUS_ON_NEG; UNIFORMLY_CONTINUOUS_ON_ADD]);; + +let UNIFORMLY_CONTINUOUS_ON_VSUM = prove + (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t) + ==> (\x. vsum s (\a. f a x)) uniformly_continuous_on t`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; + UNIFORMLY_CONTINUOUS_ON_CONST; UNIFORMLY_CONTINUOUS_ON_ADD; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Identity function is continuous in every sense. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_ID = prove + (`!a s. (\x. x) continuous (at a within s)`, + REWRITE_TAC[continuous_within] THEN MESON_TAC[]);; + +let CONTINUOUS_AT_ID = prove + (`!a. (\x. x) continuous (at a)`, + REWRITE_TAC[continuous_at] THEN MESON_TAC[]);; + +let CONTINUOUS_ON_ID = prove + (`!s. (\x. x) continuous_on s`, + REWRITE_TAC[continuous_on] THEN MESON_TAC[]);; + +let UNIFORMLY_CONTINUOUS_ON_ID = prove + (`!s. (\x. x) uniformly_continuous_on s`, + REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of all kinds is preserved under composition. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_COMPOSE = prove + (`!f g x s. f continuous (at x within s) /\ + g continuous (at (f x) within IMAGE f s) + ==> (g o f) continuous (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_AT_COMPOSE = prove + (`!f g x. f continuous (at x) /\ g continuous (at (f x)) + ==> (g o f) continuous (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MESON_TAC[CONTINUOUS_WITHIN_COMPOSE; IN_IMAGE; CONTINUOUS_WITHIN_SUBSET; + SUBSET_UNIV; IN_UNIV]);; + +let CONTINUOUS_ON_COMPOSE = prove + (`!f g s. f continuous_on s /\ g continuous_on (IMAGE f s) + ==> (g o f) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + MESON_TAC[IN_IMAGE; CONTINUOUS_WITHIN_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity in terms of open preimages. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_OPEN = prove + (`!f:real^M->real^N x u. + f continuous (at x within u) <=> + !t. open t /\ f(x) IN t + ==> ?s. open s /\ x IN s /\ + !x'. x' IN s /\ x' IN u ==> f(x') IN t`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [open_def] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; DIST_SYM]; + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; + +let CONTINUOUS_AT_OPEN = prove + (`!f:real^M->real^N x. + f continuous (at x) <=> + !t. open t /\ f(x) IN t + ==> ?s. open s /\ x IN s /\ + !x'. x' IN s ==> f(x') IN t`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [open_def] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL]; + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; + +let CONTINUOUS_ON_OPEN_GEN = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> (f continuous_on s <=> + !u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL + [REWRITE_TAC[open_in; SUBSET; IN_ELIM_THM] THEN + DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM SET_TAC[]; + DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o + SPEC `ball((f:real^M->real^N) x,e) INTER t`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[OPEN_IN_OPEN; INTER_COMM; OPEN_BALL]; ALL_TAC] THEN + REWRITE_TAC[open_in; SUBSET; IN_INTER; IN_ELIM_THM; IN_BALL; IN_IMAGE] THEN + REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_MESON_TAC[DIST_REFL; DIST_SYM]]);; + +let CONTINUOUS_ON_OPEN = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. open_in (subtopology euclidean (IMAGE f s)) t + ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN + REWRITE_TAC[SUBSET_REFL]);; + +let CONTINUOUS_OPEN_IN_PREIMAGE_GEN = prove + (`!f:real^M->real^N s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, + MESON_TAC[CONTINUOUS_ON_OPEN_GEN]);; + +let CONTINUOUS_ON_IMP_OPEN_IN = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ + open_in (subtopology euclidean (IMAGE f s)) t + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + MESON_TAC[CONTINUOUS_ON_OPEN]);; + +(* ------------------------------------------------------------------------- *) +(* Similarly in terms of closed sets. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CLOSED_GEN = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> (f continuous_on s <=> + !u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN u})`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> + ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THENL + [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let CONTINUOUS_ON_CLOSED = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. closed_in (subtopology euclidean (IMAGE f s)) t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN + REWRITE_TAC[SUBSET_REFL]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE_GEN = prove + (`!f:real^M->real^N s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, + MESON_TAC[CONTINUOUS_ON_CLOSED_GEN]);; + +let CONTINUOUS_ON_IMP_CLOSED_IN = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ + closed_in (subtopology euclidean (IMAGE f s)) t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + MESON_TAC[CONTINUOUS_ON_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Half-global and completely global cases. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_OPEN_IN_PREIMAGE = prove + (`!f s t. + f continuous_on s /\ open t + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + ASM_REWRITE_TAC[]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE = prove + (`!f s t. + f continuous_on s /\ closed t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN + ASM_REWRITE_TAC[]);; + +let CONTINUOUS_OPEN_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ open s /\ open t + ==> open {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + REWRITE_TAC [OPEN_IN_OPEN] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN + ANTS_TAC THENL + [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; + STRIP_TAC THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = + s INTER t'` SUBST1_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [OPEN_INTER]]]);; + +let CONTINUOUS_CLOSED_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ closed s /\ closed t + ==> closed {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_CLOSED]) THEN + REWRITE_TAC [CLOSED_IN_CLOSED] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN + ANTS_TAC THENL + [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; + STRIP_TAC THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = + s INTER t'` SUBST1_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [CLOSED_INTER]]]);; + +let CONTINUOUS_OPEN_PREIMAGE_UNIV = prove + (`!f:real^M->real^N s. + (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] + CONTINUOUS_OPEN_PREIMAGE) THEN + ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let CONTINUOUS_CLOSED_PREIMAGE_UNIV = prove + (`!f:real^M->real^N s. + (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] + CONTINUOUS_CLOSED_PREIMAGE) THEN + ASM_SIMP_TAC[CLOSED_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let CONTINUOUS_OPEN_IN_PREIMAGE_EQ = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_OPEN_IN_PREIMAGE] THEN + REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN + X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE_EQ = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. closed t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE] THEN + REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN + X_GEN_TAC `t:real^N->bool` THEN + GEN_REWRITE_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Linear functions are (uniformly) continuous on any set. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_LIM_0 = prove + (`!f. linear f ==> (f --> vec 0) (at (vec 0))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B` THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN + ASM_MESON_TAC[REAL_MUL_SYM; REAL_LET_TRANS; REAL_LT_RDIV_EQ]);; + +let LINEAR_CONTINUOUS_AT = prove + (`!f:real^M->real^N a. linear f ==> f continuous (at a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\x. (f:real^M->real^N) (a + x) - f(a)` LINEAR_LIM_0) THEN + ANTS_TAC THENL + [POP_ASSUM MP_TAC THEN SIMP_TAC[linear] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM LIM_NULL; CONTINUOUS_AT] THEN + GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC[]);; + +let LINEAR_CONTINUOUS_WITHIN = prove + (`!f:real^M->real^N s x. linear f ==> f continuous (at x within s)`, + SIMP_TAC[CONTINUOUS_AT_WITHIN; LINEAR_CONTINUOUS_AT]);; + +let LINEAR_CONTINUOUS_ON = prove + (`!f:real^M->real^N s. linear f ==> f continuous_on s`, + MESON_TAC[LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let LINEAR_CONTINUOUS_COMPOSE = prove + (`!net f:A->real^N g:real^N->real^P. + f continuous net /\ linear g ==> (\x. g(f x)) continuous net`, + REWRITE_TAC[continuous; LIM_LINEAR]);; + +let LINEAR_CONTINUOUS_ON_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s. + f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + LINEAR_CONTINUOUS_COMPOSE]);; + +let CONTINUOUS_LIFT_COMPONENT_COMPOSE = prove + (`!net f:A->real^N i. f continuous net ==> (\x. lift(f x$i)) continuous net`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `linear(\x:real^N. lift (x$i))` MP_TAC THENL + [REWRITE_TAC[LINEAR_LIFT_COMPONENT]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN + REWRITE_TAC[LINEAR_CONTINUOUS_COMPOSE]);; + +let CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> (\x. lift (f x$i)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_LIFT_COMPONENT_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Also bilinear functions, in composition form. *) +(* ------------------------------------------------------------------------- *) + +let BILINEAR_CONTINUOUS_COMPOSE = prove + (`!net f:A->real^M g:A->real^N h:real^M->real^N->real^P. + f continuous net /\ g continuous net /\ bilinear h + ==> (\x. h (f x) (g x)) continuous net`, + REWRITE_TAC[continuous; LIM_BILINEAR]);; + +let BILINEAR_CONTINUOUS_ON_COMPOSE = prove + (`!f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h + ==> (\x. h (f x) (g x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + BILINEAR_CONTINUOUS_COMPOSE]);; + +let BILINEAR_DOT = prove + (`bilinear (\x y:real^N. lift(x dot y))`, + REWRITE_TAC[bilinear; linear; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; + +let CONTINUOUS_LIFT_DOT2 = prove + (`!net f g:A->real^N. + f continuous net /\ g continuous net + ==> (\x. lift(f x dot g x)) continuous net`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +let CONTINUOUS_ON_LIFT_DOT2 = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on s + ==> (\x. lift(f x dot g x)) continuous_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of compactness and connectedness under continuous function. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ compact s ==> compact(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; compact] THEN + STRIP_TAC THEN X_GEN_TAC `y:num->real^N` THEN + REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `r:num->num` THEN + DISCH_THEN(X_CHOOSE_THEN `l:real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:real^M->real^N) l` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `l:real^M`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[o_THM] THEN + ASM_MESON_TAC[]);; + +let COMPACT_TRANSLATION = prove + (`!s a:real^N. compact s ==> compact (IMAGE (\x. a + x) s)`, + SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_ADD; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; + +let COMPACT_TRANSLATION_EQ = prove + (`!a s. compact (IMAGE (\x:real^N. a + x) s) <=> compact s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN + DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP COMPACT_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [COMPACT_TRANSLATION_EQ];; + +let COMPACT_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. compact s /\ linear f ==> compact(IMAGE f s)`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; COMPACT_CONTINUOUS_IMAGE]);; + +let COMPACT_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (compact (IMAGE f s) <=> compact s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COMPACT_LINEAR_IMAGE));; + +add_linear_invariants [COMPACT_LINEAR_IMAGE_EQ];; + +let CONNECTED_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ connected s ==> connected(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[CONNECTED_CLOPEN; NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `t:real^N->bool` th) THEN + MP_TAC(SPEC `IMAGE (f:real^M->real^N) s DIFF t` th)) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN IMAGE f s DIFF t} = + s DIFF {x | x IN s /\ f x IN t}` + SUBST1_TAC THENL + [UNDISCH_TAC `t SUBSET IMAGE (f:real^M->real^N) s` THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_ELIM_THM; SUBSET] THEN + MESON_TAC[]; + REPEAT STRIP_TAC THEN + EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN t}` THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[IN_IMAGE; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; EXTENSION] THEN + MESON_TAC[]]);; + +let CONNECTED_TRANSLATION = prove + (`!a s. connected s ==> connected (IMAGE (\x:real^N. a + x) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; + +let CONNECTED_TRANSLATION_EQ = prove + (`!a s. connected (IMAGE (\x:real^N. a + x) s) <=> connected s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN + DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP CONNECTED_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [CONNECTED_TRANSLATION_EQ];; + +let CONNECTED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. connected s /\ linear f ==> connected(IMAGE f s)`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CONTINUOUS_IMAGE]);; + +let CONNECTED_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (connected (IMAGE f s) <=> connected s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONNECTED_LINEAR_IMAGE));; + +add_linear_invariants [CONNECTED_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Preservation properties for pasted sets (Cartesian products). *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + bounded (s PCROSS t) <=> + s = {} \/ t = {} \/ bounded s /\ bounded t`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; BOUNDED_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[bounded; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS; NORM_PASTECART_LE; + REAL_LE_ADD2]);; + +let BOUNDED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + bounded s /\ bounded t ==> bounded (s PCROSS t)`, + SIMP_TAC[BOUNDED_PCROSS_EQ]);; + +let CLOSED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + closed (s PCROSS t) <=> + s = {} \/ t = {} \/ closed s /\ closed t`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN MAP_EVERY ASM_CASES_TAC + [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; CLOSED_EMPTY; SET_RULE + `{f x y |x,y| F} = {}`] THEN + REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; LIM_SEQUENTIALLY] THEN + REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[IN_ELIM_THM; SKOLEM_THM; FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[TAUT `((p /\ q) /\ r) /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN + ONCE_REWRITE_TAC[MESON[] + `(!a b c d e. P a b c d e) <=> (!d e b c a. P a b c d e)`] THEN + REWRITE_TAC[FORALL_UNWIND_THM2] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; FORALL_AND_THM] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM]] THEN + MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(MESON[] + `(?x. P x (\n. x)) ==> (?s x. P x s)`) THEN + ASM_MESON_TAC[DIST_PASTECART_CANCEL]; + ONCE_REWRITE_TAC[MESON[] + `(!x l. P x l) /\ (!y m. Q y m) <=> (!x y l m. P x l /\ Q y m)`] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[dist; PASTECART_SUB] THEN + ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]]);; + +let CLOSED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + closed s /\ closed t ==> closed (s PCROSS t)`, + SIMP_TAC[CLOSED_PCROSS_EQ]);; + +let COMPACT_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + compact (s PCROSS t) <=> + s = {} \/ t = {} \/ compact s /\ compact t`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_PCROSS_EQ; + BOUNDED_PCROSS_EQ] THEN + MESON_TAC[]);; + +let COMPACT_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + compact s /\ compact t ==> compact (s PCROSS t)`, + SIMP_TAC[COMPACT_PCROSS_EQ]);; + +let OPEN_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + open (s PCROSS t) <=> + s = {} \/ t = {} \/ open s /\ open t`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; OPEN_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + EQ_TAC THENL + [REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + ASM_MESON_TAC[DIST_PASTECART_CANCEL]; + REWRITE_TAC[OPEN_CLOSED] THEN STRIP_TAC THEN + SUBGOAL_THEN + `UNIV DIFF {pastecart x y | x IN s /\ y IN t} = + {pastecart x y | x IN ((:real^M) DIFF s) /\ y IN (:real^N)} UNION + {pastecart x y | x IN (:real^M) /\ y IN ((:real^N) DIFF t)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; FORALL_PASTECART; IN_UNIV] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; + SNDCART_PASTECART] THEN MESON_TAC[]; + SIMP_TAC[GSYM PCROSS] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN + MATCH_MP_TAC CLOSED_PCROSS THEN ASM_REWRITE_TAC[CLOSED_UNIV]]]);; + +let OPEN_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + open s /\ open t ==> open (s PCROSS t)`, + SIMP_TAC[OPEN_PCROSS_EQ]);; + +let OPEN_IN_PCROSS = prove + (`!s s':real^M->bool t t':real^N->bool. + open_in (subtopology euclidean s) s' /\ + open_in (subtopology euclidean t) t' + ==> open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN + ASM_SIMP_TAC[OPEN_PCROSS; EXTENSION; FORALL_PASTECART] THEN + REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; + +let PASTECART_IN_INTERIOR_SUBTOPOLOGY = prove + (`!s t u x:real^M y:real^N. + pastecart x y IN u /\ open_in (subtopology euclidean (s PCROSS t)) u + ==> ?v w. open_in (subtopology euclidean s) v /\ x IN v /\ + open_in (subtopology euclidean t) w /\ y IN w /\ + (v PCROSS w) SUBSET u`, + REWRITE_TAC[open_in; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(x:real^M,e / &2) INTER s` THEN + EXISTS_TAC `ball(y:real^N,e / &2) INTER t` THEN + SUBGOAL_THEN `(x:real^M) IN s /\ (y:real^N) IN t` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; PASTECART_IN_PCROSS]; ALL_TAC] THEN + ASM_SIMP_TAC[INTER_SUBSET; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN + REWRITE_TAC[IN_BALL] THEN REPEAT(CONJ_TAC THENL + [MESON_TAC[REAL_SUB_LT; NORM_ARITH + `dist(x,y) < e /\ dist(z,y) < e - dist(x,y) + ==> dist(x:real^N,z) < e`]; + ALL_TAC]) THEN + REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[IN_BALL; IN_INTER] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN + W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN + ASM_REAL_ARITH_TAC);; + +let OPEN_IN_PCROSS_EQ = prove + (`!s s':real^M->bool t t':real^N->bool. + open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> + s' = {} \/ t' = {} \/ + open_in (subtopology euclidean s) s' /\ + open_in (subtopology euclidean t) t'`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s':real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN + ASM_CASES_TAC `t':real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[OPEN_IN_PCROSS] THEN REPEAT STRIP_TAC THENL + [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + UNDISCH_TAC `~(t':real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`); + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + UNDISCH_TAC `~(s':real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^M`)] THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `t:real^N->bool`; + `(s':real^M->bool) PCROSS (t':real^N->bool)`; + `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MESON_TAC[]);; + +let INTERIOR_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + interior (s PCROSS t) = (interior s) PCROSS (interior t)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`; + `interior((s:real^M->bool) PCROSS (t:real^N->bool))`; + `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + REWRITE_TAC[UNIV_PCROSS_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; SUBSET_TRANS] + `s SUBSET interior t ==> s SUBSET t`)) THEN + REWRITE_TAC[SUBSET_PCROSS] THEN + ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_MAXIMAL; SUBSET]; + MATCH_MP_TAC INTERIOR_MAXIMAL THEN + SIMP_TAC[OPEN_PCROSS; OPEN_INTERIOR; PCROSS_MONO; INTERIOR_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Quotient maps are occasionally useful. *) +(* ------------------------------------------------------------------------- *) + +let QUASICOMPACT_OPEN_CLOSED = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. u SUBSET t + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} + ==> open_in (subtopology euclidean t) u)) <=> + (!u. u SUBSET t + ==> (closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} + ==> closed_in (subtopology euclidean t) u)))`, + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^N->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN + (ANTS_TAC THENL [SET_TAC[]; REPEAT STRIP_TAC]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `open_in top x ==> x = y ==> open_in top y`)) THEN + ASM SET_TAC[]);; + +let QUOTIENT_MAP_IMP_CONTINUOUS_OPEN = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) + ==> f continuous_on s`, + MESON_TAC[OPEN_IN_IMP_SUBSET; CONTINUOUS_ON_OPEN_GEN]);; + +let QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + closed_in (subtopology euclidean t) u)) + ==> f continuous_on s`, + MESON_TAC[CLOSED_IN_IMP_SUBSET; CONTINUOUS_ON_CLOSED_GEN]);; + +let OPEN_MAP_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!t. open_in (subtopology euclidean s) t + ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) + ==> !t. t SUBSET IMAGE f s + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> + open_in (subtopology euclidean (IMAGE f s)) t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN + `t = IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN t}` + SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + ASM_SIMP_TAC[]]);; + +let CLOSED_MAP_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!t. closed_in (subtopology euclidean s) t + ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) + ==> !t. t SUBSET IMAGE f s + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> + open_in (subtopology euclidean (IMAGE f s)) t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC + `s DIFF {x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CLOSED_IN_DIFF THEN + ASM_SIMP_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; + TOPSPACE_EUCLIDEAN; SUBSET_UNIV]; + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN ASM SET_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + ASM_SIMP_TAC[]]);; + +let CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + (!y. y IN t ==> f(g y) = y) + ==> (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u))`, + REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(IMAGE (g:real^N->real^M) t) + INTER + {x | x IN s /\ (f:real^M->real^N) x IN u}`) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]; + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = t` + (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM SET_TAC[]]);; + +let CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + (!x. x IN s ==> g(f x) = x) + ==> (!u. u SUBSET (IMAGE f s) + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean (IMAGE f s)) u))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `g:real^N->real^M` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let QUOTIENT_MAP_OPEN_CLOSED = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. u SUBSET t + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) <=> + (!u. u SUBSET t + ==> (closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} <=> + closed_in (subtopology euclidean t) u)))`, + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^N->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN + (ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN + REWRITE_TAC[SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let CONTINUOUS_ON_COMPOSE_QUOTIENT = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ + (!v. v SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean t) v)) /\ + (g o f) continuous_on s + ==> g continuous_on t`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN + SUBGOAL_THEN + `IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) s SUBSET u` + (fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) + THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_TAC] THEN + X_GEN_TAC `v:real^P->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN + ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN v}`) THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `open_in top s ==> s = t ==> open_in top t`)) THEN + ASM SET_TAC[]);; + +let LIFT_TO_QUOTIENT_SPACE = prove + (`!f:real^M->real^N h:real^M->real^P s t u. + IMAGE f s = t /\ + (!v. v SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean t) v)) /\ + h continuous_on s /\ IMAGE h s = u /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> h x = h y) + ==> ?g. g continuous_on t /\ IMAGE g t = u /\ + !x. x IN s ==> h(x) = g(f x)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[FUNCTION_FACTORS_LEFT_GEN] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^P` THEN + DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`] THEN + ASM_SIMP_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + CONTINUOUS_ON_EQ)) THEN + ASM_REWRITE_TAC[o_THM]);; + +let QUOTIENT_MAP_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ + (!v. v SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean t) v)) /\ + (!v. v SUBSET u + ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=> + open_in (subtopology euclidean u) v)) + ==> !v. v SUBSET u + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ (g o f) x IN v} <=> + open_in (subtopology euclidean u) v)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + SUBGOAL_THEN + `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = + {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` + SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_RESTRICT]]);; + +let QUOTIENT_MAP_FROM_COMPOSITION = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!v. v SUBSET u + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ (g o f) x IN v} <=> + open_in (subtopology euclidean u) v)) + ==> !v. v SUBSET u + ==> (open_in (subtopology euclidean t) + {x | x IN t /\ g x IN v} <=> + open_in (subtopology euclidean u) v)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN + ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = + {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[]]);; + +let QUOTIENT_MAP_FROM_SUBSET = prove + (`!f:real^M->real^N s t u. + f continuous_on t /\ IMAGE f t SUBSET u /\ + s SUBSET t /\ IMAGE f s = u /\ + (!v. v SUBSET u + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean u) v)) + ==> !v. v SUBSET u + ==> (open_in (subtopology euclidean t) + {x | x IN t /\ f x IN v} <=> + open_in (subtopology euclidean u) v)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION THEN + MAP_EVERY EXISTS_TAC [`\x:real^M. x`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; o_THM]);; + +let QUOTIENT_MAP_RESTRICT = prove + (`!f:real^M->real^N s t c. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) /\ + (open_in (subtopology euclidean t) c \/ + closed_in (subtopology euclidean t) c) + ==> !u. u SUBSET c + ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c}) + {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=> + open_in (subtopology euclidean c) u)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC (MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) {x | x IN s /\ f x IN c} SUBSET c` + ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET); + ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + (MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC(MESON[] `t = s /\ (P s <=> Q s) ==> (P s <=> Q t)`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]]; + ALL_TAC]) THEN + (EQ_TAC THENL + [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS); + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN + (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC[]) THEN + ASM SET_TAC[]);; + +let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ + connected t + ==> connected s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN + UNDISCH_TAC `connected(t:real^N->bool)` THEN SIMP_TAC[CONNECTED_OPEN_IN] THEN + MAP_EVERY EXISTS_TAC + [`IMAGE (f:real^M->real^N) (s INTER u)`; + `IMAGE (f:real^M->real^N) (s INTER v)`] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) (s INTER u) INTER IMAGE f (s INTER v) = {}` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected]] THEN + MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [CONJ_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (rand o rand) th o snd)) THEN + (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN + MATCH_MP_TAC(MESON[] + `{x | x IN s /\ f x IN IMAGE f u} = u /\ open_in top u + ==> open_in top {x | x IN s /\ f x IN IMAGE f u}`) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ASM SET_TAC[]);; + +let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN = prove + (`!f:real^M->real^N s t c. + IMAGE f s = t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ + (open_in (subtopology euclidean t) c \/ + closed_in (subtopology euclidean t) c) /\ + connected c + ==> connected {x | x IN s /\ f x IN c}`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] CONNECTED_MONOTONE_QUOTIENT_PREIMAGE)) THEN + SUBGOAL_THEN `(c:real^N->bool) SUBSET t` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN + EXISTS_TAC `f:real^M->real^N` THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + QUOTIENT_MAP_IMP_CONTINUOUS_OPEN)) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + REWRITE_TAC[SUBSET_RESTRICT]; + ASM SET_TAC[]; + MATCH_MP_TAC QUOTIENT_MAP_RESTRICT THEN + ASM_MESON_TAC[SUBSET_REFL]; + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN + AP_TERM_TAC THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More properties of open and closed maps. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_MAP_RESTRICT = prove + (`!f:real^M->real^N s t t'. + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ + t' SUBSET t + ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u + ==> open_in (subtopology euclidean t') (IMAGE f u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +let CLOSED_MAP_RESTRICT = prove + (`!f:real^M->real^N s t t'. + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ + t' SUBSET t + ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u + ==> closed_in (subtopology euclidean t') (IMAGE f u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +let QUOTIENT_MAP_OPEN_MAP_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) + ==> ((!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f k}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let QUOTIENT_MAP_CLOSED_MAP_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) + ==> ((!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f k}))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let CLOSED_MAP_IMP_OPEN_MAP = prove + (`!f:real^M->real^N s t. + IMAGE f s = t /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f u}) + ==> (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) u = + t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + ASM_SIMP_TAC[CLOSED_IN_REFL]]);; + +let OPEN_MAP_IMP_CLOSED_MAP = prove + (`!f:real^M->real^N s t. + IMAGE f s = t /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f u}) + ==> (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) u = + t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + ASM_SIMP_TAC[OPEN_IN_REFL]]);; + +let OPEN_MAP_FROM_COMPOSITION_SURJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. open_in (subtopology euclidean t) k + ==> open_in (subtopology euclidean u) (IMAGE g k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) + {x | x IN s /\ f(x) IN k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; + +let CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. closed_in (subtopology euclidean t) k + ==> closed_in (subtopology euclidean u) (IMAGE g k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) + {x | x IN s /\ f(x) IN k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; + +let OPEN_MAP_FROM_COMPOSITION_INJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ + g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE f k = {x | x IN t /\ + g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; + +let CLOSED_MAP_FROM_COMPOSITION_INJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ + g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE f k = {x | x IN t /\ + g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; + +let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE = prove + (`!f:real^M->real^N s t u w. + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k)) /\ + closed_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. closed_in (subtopology euclidean t) v /\ + w SUBSET v /\ + {x | x IN s /\ f(x) IN v} SUBSET u`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);; + +let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> + (!u w. closed_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. closed_in (subtopology euclidean t) v /\ + w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[OPEN_MAP_CLOSED_SUPERSET_PREIMAGE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]]);; + +let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE = prove + (`!f:real^M->real^N s t u w. + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ + open_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. open_in (subtopology euclidean t) v /\ + w SUBSET v /\ + {x | x IN s /\ f(x) IN v} SUBSET u`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]);; + +let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> + (!u w. open_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. open_in (subtopology euclidean t) v /\ + w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);; + +let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> + (!u y. open_in (subtopology euclidean s) u /\ + y IN t /\ {x | x IN s /\ f(x) = y} SUBSET u + ==> ?v. open_in (subtopology euclidean t) v /\ + y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ] THEN + EQ_TAC THEN DISCH_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `y:real^N`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `{y:real^N}`]) THEN + ASM_REWRITE_TAC[SING_SUBSET; IN_SING]; + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `w:real^N->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN + EXISTS_TAC `UNIONS {(vv:real^N->real^N->bool) y | y IN w}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM SET_TAC[]; + REWRITE_TAC[UNIONS_GSPEC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; RIGHT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM SET_TAC[]]]);; + +let CONNECTED_OPEN_MONOTONE_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!c. open_in (subtopology euclidean s) c + ==> open_in (subtopology euclidean t) (IMAGE f c)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) + ==> !c. connected c /\ c SUBSET t + ==> connected {x | x IN s /\ f x IN c}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_MAP_RESTRICT)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] + OPEN_MAP_IMP_QUOTIENT_MAP) THEN + SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` + ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + SIMP_TAC[SET_RULE + `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = + {x | x IN s /\ f x = y}`] THEN + ASM SET_TAC[]]);; + +let CONNECTED_CLOSED_MONOTONE_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!c. closed_in (subtopology euclidean s) c + ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) + ==> !c. connected c /\ c SUBSET t + ==> connected {x | x IN s /\ f x IN c}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_MAP_RESTRICT)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] + CLOSED_MAP_IMP_QUOTIENT_MAP) THEN + SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` + ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + SIMP_TAC[SET_RULE + `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = + {x | x IN s /\ f x = y}`] THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Proper maps, including projections out of compact sets. *) +(* ------------------------------------------------------------------------- *) + +let PROPER_MAP = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ + (!a. a IN t ==> compact {x | x IN s /\ f x = a}))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[SET_RULE `x = a <=> x IN {a}`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[CLOSED_IN_LIMPT] THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `y:real^N`] THEN + REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE] THEN + REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; SKOLEM_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[UNWIND_THM2; FUN_EQ_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `~(INTERS {{a | a IN k /\ + (f:real^M->real^N) a IN + (y INSERT IMAGE (\i. f(x(n + i))) (:num))} | + n IN (:num)} = {})` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_FIP THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[SET_RULE + `{x | x IN s INTER k /\ P x} = k INTER {x | x IN s /\ P x}`] THEN + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP SEQ_OFFSET) THEN + REWRITE_TAC[ADD_SYM]; + REWRITE_TAC[SIMPLE_IMAGE; FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o MATCH_MP + UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `(x:num->real^M) m` THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISJ2_TAC THEN + EXISTS_TAC `m - p:num` THEN + ASM_MESON_TAC[ARITH_RULE `p <= m ==> p + m - p:num = m`]]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(fun th -> LABEL_TAC "*" th THEN MP_TAC(SPEC `0` th)) THEN + REWRITE_TAC[ADD_CLAUSES; IN_INSERT; IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN MP_TAC)) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `i + 1`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN ARITH_TAC]; + STRIP_TAC THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN + X_GEN_TAC `c:(real^M->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!a. a IN k + ==> ?g. g SUBSET c /\ FINITE g /\ + {x | x IN s /\ (f:real^M->real^N) x = a} SUBSET UNIONS g` + MP_TAC THENL + [X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN UNDISCH_THEN + `!a. a IN t ==> compact {x | x IN s /\ (f:real^M->real^N) x = a}` + (MP_TAC o SPEC `a:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[COMPACT_EQ_HEINE_BOREL]] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uu:real^N->(real^M->bool)->bool` THEN + DISCH_THEN(LABEL_TAC "*")] THEN + SUBGOAL_THEN + `!a. a IN k + ==> ?v. open v /\ a IN v /\ + {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET UNIONS(uu a)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + UNDISCH_THEN + `!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) + (IMAGE (f:real^M->real^N) k)` + (MP_TAC o SPEC `(s:real^M->bool) DIFF UNIONS(uu(a:real^N))`) THEN + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ANTS_TAC THENL + [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN + MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + MATCH_MP_TAC OPEN_UNIONS THEN ASM SET_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT + ((ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) ORELSE STRIP_TAC) + THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM SET_TAC[]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `vv:real^N->(real^N->bool)` THEN + DISCH_THEN(LABEL_TAC "+")] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (vv:real^N->(real^N->bool)) k`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `j:real^N->bool` THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `UNIONS(IMAGE (uu:real^N->(real^M->bool)->bool) j)` THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM_SIMP_TAC[FINITE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE] THEN + ASM SET_TAC[]; + REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + ASM SET_TAC[]]]);; + +let COMPACT_CONTINUOUS_IMAGE_EQ = prove + (`!f:real^M->real^N s. + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> (f continuous_on s <=> + !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; DISCH_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `g:real^N->real^M` o + GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN + X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`; + `s:real^M->bool`] PROPER_MAP) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(q ==> s) /\ p ==> (p <=> q /\ r) ==> s`) THEN + REPEAT STRIP_TAC THENL + [SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN u} = IMAGE g u` + (fun th -> ASM_MESON_TAC[th]); + SUBGOAL_THEN + `{x | x IN IMAGE f s /\ (g:real^N->real^M) x IN k} = IMAGE f k` + (fun th -> ASM_SIMP_TAC[th])] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]);; + +let PROPER_MAP_FROM_COMPACT = prove + (`!f:real^M->real^N s k. + f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\ + closed_in (subtopology euclidean t) k + ==> compact {x | x IN s /\ f x IN k}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]);; + +let PROPER_MAP_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ + (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ + (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}) + ==> !k. k SUBSET u /\ compact k + ==> compact {x | x IN s /\ (g o f) x IN k}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN k}`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN + AP_TERM_TAC THEN ASM SET_TAC[]);; + +let PROPER_MAP_FROM_COMPOSITION_LEFT = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!k. k SUBSET u /\ compact k + ==> compact {x | x IN s /\ (g o f) x IN k}) + ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}`, + REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let PROPER_MAP_FROM_COMPOSITION_RIGHT = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!k. k SUBSET u /\ compact k + ==> compact {x | x IN s /\ (g o f) x IN k}) + ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, + let lemma = prove + (`!s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t`, + MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; + CLOSED_IN_CLOSED_EQ]) in + REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^P) k`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + MATCH_MP_TAC lemma THEN + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `s:real^M->bool` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);; + +let PROPER_MAP_FSTCART = prove + (`!s:real^M->bool t:real^N->bool k. + compact t /\ k SUBSET s /\ compact k + ==> compact {z | z IN s PCROSS t /\ fstcart z IN k}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{z | z IN s PCROSS t /\ fstcart z IN k} = + (k:real^M->bool) PCROSS (t:real^N->bool)` + (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; + PASTECART_IN_PCROSS; FSTCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CLOSED_MAP_FSTCART = prove + (`!s:real^M->bool t:real^N->bool c. + compact t /\ closed_in (subtopology euclidean (s PCROSS t)) c + ==> closed_in (subtopology euclidean s) (IMAGE fstcart c)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`; + `s:real^M->bool`] + PROPER_MAP) THEN + ASM_SIMP_TAC[PROPER_MAP_FSTCART; IMAGE_FSTCART_PCROSS] THEN + ASM SET_TAC[]);; + +let PROPER_MAP_SNDCART = prove + (`!s:real^M->bool t:real^N->bool k. + compact s /\ k SUBSET t /\ compact k + ==> compact {z | z IN s PCROSS t /\ sndcart z IN k}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{z | z IN s PCROSS t /\ sndcart z IN k} = + (s:real^M->bool) PCROSS (k:real^N->bool)` + (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; + PASTECART_IN_PCROSS; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CLOSED_MAP_SNDCART = prove + (`!s:real^M->bool t:real^N->bool c. + compact s /\ closed_in (subtopology euclidean (s PCROSS t)) c + ==> closed_in (subtopology euclidean t) (IMAGE sndcart c)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`; + `t:real^N->bool`] + PROPER_MAP) THEN + ASM_SIMP_TAC[PROPER_MAP_SNDCART; IMAGE_SNDCART_PCROSS] THEN + ASM SET_TAC[]);; + +let CLOSED_IN_COMPACT_PROJECTION = prove + (`!s:real^M->bool t:real^N->bool u. + compact s /\ closed_in (subtopology euclidean (s PCROSS t)) u + ==> closed_in (subtopology euclidean t) + {y | ?x. x IN s /\ pastecart x y IN u}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_MAP_SNDCART) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET o CONJUNCT2) THEN + REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART; + PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN + SET_TAC[]);; + +let CLOSED_COMPACT_PROJECTION = prove + (`!s:real^M->bool t:real^(M,N)finite_sum->bool. + compact s /\ closed t ==> closed {y | ?x. x IN s /\ pastecart x y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{y | ?x:real^M. x IN s /\ pastecart x y IN t} = + {y | ?x. x IN s /\ pastecart x y IN ((s PCROSS (:real^N)) INTER t)}` + SUBST1_TAC THENL + [REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_INTER] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[CLOSED_UNIV] THEN + MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED; + INTER_SUBSET]]);; + +let TUBE_LEMMA = prove + (`!s:real^M->bool t:real^N->bool u a. + compact s /\ ~(s = {}) /\ {pastecart x a | x IN s} SUBSET u /\ + open_in(subtopology euclidean (s PCROSS t)) u + ==> ?v. open_in (subtopology euclidean t) v /\ a IN v /\ + (s PCROSS v) SUBSET u`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; PCROSS] + CLOSED_IN_COMPACT_PROJECTION)) THEN + ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] + `(closed_in top t ==> s DIFF (s DIFF t) = t) /\ + s DIFF t SUBSET s /\ P(s DIFF t) + ==> closed_in top t + ==> ?v. v SUBSET s /\ closed_in top (s DIFF v) /\ P v`) THEN + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = t <=> t SUBSET s`] THEN + REWRITE_TAC[SUBSET_DIFF] THEN + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; + +let TUBE_LEMMA_GEN = prove + (`!s t t' u:real^(M,N)finite_sum->bool. + compact s /\ ~(s = {}) /\ t SUBSET t' /\ + s PCROSS t SUBSET u /\ + open_in (subtopology euclidean (s PCROSS t')) u + ==> ?v. open_in (subtopology euclidean t') v /\ + t SUBSET v /\ + s PCROSS v SUBSET u`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a. a IN t ==> ?v. open_in (subtopology euclidean t') v /\ a IN v /\ + (s:real^M->bool) PCROSS (v:real^N->bool) SUBSET u` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC TUBE_LEMMA THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN + EXISTS_TAC `UNIONS (IMAGE (vv:real^N->real^N->bool) t)` THEN + ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; FORALL_IN_PCROSS] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real^N`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Pasting functions together on open sets. *) +(* ------------------------------------------------------------------------- *) + +let PASTING_LEMMA = prove + (`!f:A->real^M->real^N g t s k. + (!i. i IN k + ==> open_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) /\ + (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) + ==> g continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN + STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ g x IN u} = + UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | + i IN k}` + SUBST1_TAC THENL + [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` + ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; + MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[OPEN_IN_TRANS]]);; + +let PASTING_LEMMA_EXISTS = prove + (`!f:A->real^M->real^N t s k. + s SUBSET UNIONS {t i | i IN k} /\ + (!i. i IN k + ==> open_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) + ==> ?g. g continuous_on s /\ + (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA THEN + MAP_EVERY EXISTS_TAC + [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN + ASM SET_TAC[]);; + +let CONTINUOUS_ON_UNION_LOCAL_OPEN = prove + (`!f:real^M->real^N s. + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\i:(real^M->bool). (f:real^M->real^N)`; `f:real^M->real^N`; + `\i:(real^M->bool). i`; `s UNION t:real^M->bool`; `{s:real^M->bool,t}`] + PASTING_LEMMA) THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_UNION]);; + +let CONTINUOUS_ON_UNION_OPEN = prove + (`!f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN + ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; + +let CONTINUOUS_ON_CASES_LOCAL_OPEN = prove + (`!P f g:real^M->real^N s t. + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_CASES_OPEN = prove + (`!P f g s t. + open s /\ + open t /\ + f continuous_on s /\ + g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on s UNION t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN + ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Likewise on closed sets, with a finiteness assumption. *) +(* ------------------------------------------------------------------------- *) + +let PASTING_LEMMA_CLOSED = prove + (`!f:A->real^M->real^N g t s k. + FINITE k /\ + (!i. i IN k + ==> closed_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) /\ + (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) + ==> g continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN + STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ g x IN u} = + UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | + i IN k}` + SUBST1_TAC THENL + [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` + ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; + MATCH_MP_TAC CLOSED_IN_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_TRANS]]);; + +let PASTING_LEMMA_EXISTS_CLOSED = prove + (`!f:A->real^M->real^N t s k. + FINITE k /\ + s SUBSET UNIONS {t i | i IN k} /\ + (!i. i IN k + ==> closed_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) + ==> ?g. g continuous_on s /\ + (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC PASTING_LEMMA_CLOSED THEN + MAP_EVERY EXISTS_TAC + [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Closure of halflines, halfspaces and hyperplanes. *) +(* ------------------------------------------------------------------------- *) + +let LIM_LIFT_DOT = prove + (`!f:real^M->real^N a. + (f --> l) net ==> ((lift o (\y. a dot f(y))) --> lift(a dot l)) net`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = vec 0:real^N` THENL + [ASM_REWRITE_TAC[DOT_LZERO; LIFT_NUM; o_DEF; LIM_CONST]; ALL_TAC] THEN + REWRITE_TAC[LIM] THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / norm(a:real^N)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[dist; o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; NORM_LIFT] THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN + MESON_TAC[NORM_CAUCHY_SCHWARZ_ABS; REAL_MUL_SYM; REAL_LET_TRANS]);; + +let CONTINUOUS_AT_LIFT_DOT = prove + (`!a:real^N x. (lift o (\y. a dot y)) continuous at x`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_AT; o_THM] THEN + MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN MESON_TAC[]);; + +let CONTINUOUS_ON_LIFT_DOT = prove + (`!s. (lift o (\y. a dot y)) continuous_on s`, + SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_DOT]);; + +let CLOSED_INTERVAL_LEFT = prove + (`!b:real^N. + closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i <= b$i}`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dist; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; + +let CLOSED_INTERVAL_RIGHT = prove + (`!a:real^N. + closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i}`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dist; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`]);; + +let CLOSED_HALFSPACE_LE = prove + (`!a:real^N b. closed {x | a dot x <= b}`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `(:real^N)` CONTINUOUS_ON_LIFT_DOT) THEN + REWRITE_TAC[CONTINUOUS_ON_CLOSED; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE lift {r | ?x:real^N. (a dot x = r) /\ r <= b}`) THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[o_DEF] THEN MESON_TAC[LIFT_DROP]] THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `{x | !i. 1 <= i /\ i <= dimindex(:1) + ==> (x:real^1)$i <= (lift b)$i}` THEN + REWRITE_TAC[CLOSED_INTERVAL_LEFT] THEN + SIMP_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_INTER; + VEC_COMPONENT; DIMINDEX_1; LAMBDA_BETA; o_THM] THEN + SIMP_TAC[ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN + REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + MESON_TAC[LIFT_DROP]);; + +let CLOSED_HALFSPACE_GE = prove + (`!a:real^N b. closed {x | a dot x >= b}`, + REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; CLOSED_HALFSPACE_LE]);; + +let CLOSED_HYPERPLANE = prove + (`!a b. closed {x | a dot x = b}`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + REWRITE_TAC[REAL_ARITH `b <= a dot x <=> a dot x >= b`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_LE; CLOSED_HALFSPACE_GE]);; + +let CLOSED_STANDARD_HYPERPLANE = prove + (`!k a. closed {x:real^N | x$k = a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CLOSED_HALFSPACE_COMPONENT_LE = prove + (`!a k. closed {x:real^N | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_LE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CLOSED_HALFSPACE_COMPONENT_GE = prove + (`!a k. closed {x:real^N | x$k >= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_GE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +(* ------------------------------------------------------------------------- *) +(* Openness of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_HALFSPACE_LT = prove + (`!a b. open {x | a dot x < b}`, + REWRITE_TAC[GSYM REAL_NOT_LE] THEN + REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN + REWRITE_TAC[GSYM closed; GSYM real_ge; CLOSED_HALFSPACE_GE]);; + +let OPEN_HALFSPACE_COMPONENT_LT = prove + (`!a k. open {x:real^N | x$k < a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_LT) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let OPEN_HALFSPACE_GT = prove + (`!a b. open {x | a dot x > b}`, + REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN + REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN + REWRITE_TAC[GSYM closed; CLOSED_HALFSPACE_LE]);; + +let OPEN_HALFSPACE_COMPONENT_GT = prove + (`!a k. open {x:real^N | x$k > a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_GT) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let OPEN_POSITIVE_MULTIPLES = prove + (`!s:real^N->bool. open s ==> open {c % x | &0 < c /\ x IN s}`, + REWRITE_TAC[open_def; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(c) % y:real^N`) THEN ANTS_TAC THENL + [SUBGOAL_THEN `x:real^N = inv c % c % x` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; + REAL_LT_IMP_NZ]; + ASM_SIMP_TAC[DIST_MUL; real_abs; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv c * x:real = x / c`] THEN + ASM_MESON_TAC[REAL_LT_LDIV_EQ; REAL_MUL_SYM]]; + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `c:real` THEN EXISTS_TAC `inv(c) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + VECTOR_ARITH_TAC]);; + +let OPEN_INTERVAL_LEFT = prove + (`!b:real^N. open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i < b$i}`, + GEN_TAC THEN + SUBGOAL_THEN + `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i < b$i} = + INTERS{{x | x$i < (b:real^N)$i} | i IN 1..dimindex(:N)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_NUMSEG] THEN SET_TAC[]; + MATCH_MP_TAC OPEN_INTERS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_IN_IMAGE; OPEN_HALFSPACE_COMPONENT_LT]]);; + +let OPEN_INTERVAL_RIGHT = prove + (`!a:real^N. open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i}`, + GEN_TAC THEN + SUBGOAL_THEN + `{x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < x$i} = + INTERS{{x | (a:real^N)$i < x$i} | i IN 1..dimindex(:N)}` + SUBST1_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_NUMSEG] THEN SET_TAC[]; + MATCH_MP_TAC OPEN_INTERS THEN + SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_IN_IMAGE; GSYM real_gt; OPEN_HALFSPACE_COMPONENT_GT]]);; + +let OPEN_POSITIVE_ORTHANT = prove + (`open {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> &0 < x$i}`, + MP_TAC(ISPEC `vec 0:real^N` OPEN_INTERVAL_RIGHT) THEN + REWRITE_TAC[VEC_COMPONENT]);; + +(* ------------------------------------------------------------------------- *) +(* Closures and interiors of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_HALFSPACE_LE = prove + (`!a:real^N b. + ~(a = vec 0) ==> interior {x | a dot x <= b} = {x | a dot x < b}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN + SIMP_TAC[OPEN_HALFSPACE_LT; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN + X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[SUBSET; IN_CBALL] THEN + DISCH_THEN(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN + REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; + NORM_EQ_0; REAL_ARITH `&0 < x ==> abs x <= x`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e ==> ~(b + e <= b)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]);; + +let INTERIOR_HALFSPACE_GE = prove + (`!a:real^N b. + ~(a = vec 0) ==> interior {x | a dot x >= b} = {x | a dot x > b}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; + REAL_ARITH `a > b <=> --a < --b`] THEN + ASM_SIMP_TAC[GSYM DOT_LNEG; INTERIOR_HALFSPACE_LE; VECTOR_NEG_EQ_0]);; + +let INTERIOR_HALFSPACE_COMPONENT_LE = prove + (`!a k. interior {x:real^N | x$k <= a} = {x | x$k < a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_LE) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let INTERIOR_HALFSPACE_COMPONENT_GE = prove + (`!a k. interior {x:real^N | x$k >= a} = {x | x$k > a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_GE) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let CLOSURE_HALFSPACE_LT = prove + (`!a:real^N b. + ~(a = vec 0) ==> closure {x | a dot x < b} = {x | a dot x <= b}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN + ASM_SIMP_TAC[REAL_ARITH `~(x < b) <=> x >= b`; INTERIOR_HALFSPACE_GE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CLOSURE_HALFSPACE_GT = prove + (`!a:real^N b. + ~(a = vec 0) ==> closure {x | a dot x > b} = {x | a dot x >= b}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; + REAL_ARITH `a > b <=> --a < --b`] THEN + ASM_SIMP_TAC[GSYM DOT_LNEG; CLOSURE_HALFSPACE_LT; VECTOR_NEG_EQ_0]);; + +let CLOSURE_HALFSPACE_COMPONENT_LT = prove + (`!a k. closure {x:real^N | x$k < a} = {x | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_LT) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let CLOSURE_HALFSPACE_COMPONENT_GT = prove + (`!a k. closure {x:real^N | x$k > a} = {x | x$k >= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_GT) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let INTERIOR_HYPERPLANE = prove + (`!a b. ~(a = vec 0) ==> interior {x | a dot x = b} = {}`, + REWRITE_TAC[REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN + REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN + REWRITE_TAC[INTERIOR_INTER] THEN + ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC);; + +let FRONTIER_HALFSPACE_LE = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x <= b} = {x | a dot x = b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_SIMP_TAC[DOT_LZERO] THENL + [ASM_CASES_TAC `&0 <= b` THEN + ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; + ASM_SIMP_TAC[frontier; INTERIOR_HALFSPACE_LE; CLOSURE_CLOSED; + CLOSED_HALFSPACE_LE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; + +let FRONTIER_HALFSPACE_GE = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x >= b} = {x | a dot x = b}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LE) THEN + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN + REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);; + +let FRONTIER_HALFSPACE_LT = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x < b} = {x | a dot x = b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_SIMP_TAC[DOT_LZERO] THENL + [ASM_CASES_TAC `&0 < b` THEN + ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; + ASM_SIMP_TAC[frontier; CLOSURE_HALFSPACE_LT; INTERIOR_OPEN; + OPEN_HALFSPACE_LT] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; + +let FRONTIER_HALFSPACE_GT = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x > b} = {x | a dot x = b}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LT) THEN + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN + REWRITE_TAC[REAL_LT_NEG2; REAL_EQ_NEG2; real_gt]);; + +let INTERIOR_STANDARD_HYPERPLANE = prove + (`!k a. interior {x:real^N | x$k = a} = {}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let EMPTY_INTERIOR_LOWDIM = prove + (`!s:real^N->bool. dim(s) < dimindex(:N) ==> interior s = {}`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `!t u. s SUBSET t /\ t SUBSET u /\ u = {} ==> s = {}`) THEN + MAP_EVERY EXISTS_TAC + [`interior(span(s):real^N->bool)`; + `interior({x:real^N | a dot x = &0})`] THEN + ASM_SIMP_TAC[SUBSET_INTERIOR; SPAN_INC; INTERIOR_HYPERPLANE]);; + +(* ------------------------------------------------------------------------- *) +(* Unboundedness of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let UNBOUNDED_HALFSPACE_COMPONENT_LE = prove + (`!a k. ~bounded {x:real^N | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !z:real^N. z$k = z$i` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + EXISTS_TAC `--(&1 + max (abs B) (abs a)) % basis i:real^N` THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; BASIS_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC);; + +let UNBOUNDED_HALFSPACE_COMPONENT_GE = prove + (`!a k. ~bounded {x:real^N | x$k >= a}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN + MP_TAC(SPECL [`--a:real`; `k:num`] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN + REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL + [MESON_TAC[VECTOR_NEG_NEG]; + REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC]);; + +let UNBOUNDED_HALFSPACE_COMPONENT_LT = prove + (`!a k. ~bounded {x:real^N | x$k < a}`, + ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN + REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT; + UNBOUNDED_HALFSPACE_COMPONENT_LE]);; + +let UNBOUNDED_HALFSPACE_COMPONENT_GT = prove + (`!a k. ~bounded {x:real^N | x$k > a}`, + ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN + REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT; + UNBOUNDED_HALFSPACE_COMPONENT_GE]);; + +let BOUNDED_HALFSPACE_LE = prove + (`!a:real^N b. bounded {x | a dot x <= b} <=> a = vec 0 /\ b < &0`, + GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN + SIMP_TAC[DOT_LMUL; DOT_BASIS; VECTOR_MUL_EQ_0; DIMINDEX_GE_1; LE_REFL; + BASIS_NONZERO] THEN + X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN X_GEN_TAC `b:real` THENL + [REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO; GSYM REAL_NOT_LE] THEN + ASM_CASES_TAC `&0 <= b` THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; + SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE; + UNBOUNDED_HALFSPACE_COMPONENT_LE]]);; + +let BOUNDED_HALFSPACE_GE = prove + (`!a:real^N b. bounded {x | a dot x >= b} <=> a = vec 0 /\ &0 < b`, + REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LE] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b < &0 <=> &0 < b`]);; + +let BOUNDED_HALFSPACE_LT = prove + (`!a:real^N b. bounded {x | a dot x < b} <=> a = vec 0 /\ b <= &0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `b <= &0` THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; + SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; + ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN + ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; BOUNDED_HALFSPACE_LE]]);; + +let BOUNDED_HALFSPACE_GT = prove + (`!a:real^N b. bounded {x | a dot x > b} <=> a = vec 0 /\ &0 <= b`, + REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LT] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b <= &0 <=> &0 <= b`]);; + +(* ------------------------------------------------------------------------- *) +(* Equality of continuous functions on closure and related results. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_IN_CLOSURE = prove + (`!f:real^M->real^N s t. + closed t /\ f continuous_on (closure s) /\ + (!x. x IN s ==> f x IN t) + ==> (!x. x IN closure s ==> f x IN t)`, + REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> + s SUBSET {x | x IN s /\ f x IN t}`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE]]);; + +let FORALL_IN_CLOSURE_EQ = prove + (`!f s t. + closed t /\ f continuous_on closure s + ==> ((!x. x IN closure s ==> f x IN t) <=> + (!x. x IN s ==> f x IN t))`, + MESON_TAC[FORALL_IN_CLOSURE; CLOSURE_SUBSET; SUBSET]);; + +let SUP_CLOSURE = prove + (`!s. sup(IMAGE drop (closure s)) = sup(IMAGE drop s)`, + GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN + REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_LE]);; + +let INF_CLOSURE = prove + (`!s. inf(IMAGE drop (closure s)) = inf(IMAGE drop s)`, + GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `b <= drop x <=> x IN {x | b <= drop x}`] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN + REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_GE; + GSYM real_ge]);; + +let CONTINUOUS_LE_ON_CLOSURE = prove + (`!f:real^M->real s a. + (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a) + ==> !x. x IN closure(s) ==> f(x) <= a`, + let lemma = prove + (`x IN s ==> f x <= a <=> x IN s ==> (lift o f) x IN {y | y$1 <= a}`, + REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; LIFT_DROP]) in + REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_LE]);; + +let CONTINUOUS_GE_ON_CLOSURE = prove + (`!f:real^M->real s a. + (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x)) + ==> !x. x IN closure(s) ==> a <= f(x)`, + let lemma = prove + (`x IN s ==> a <= f x <=> x IN s ==> (lift o f) x IN {y | y$1 >= a}`, + REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; real_ge; LIFT_DROP]) in + REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_GE]);; + +let CONTINUOUS_CONSTANT_ON_CLOSURE = prove + (`!f:real^M->real^N s a. + f continuous_on closure(s) /\ (!x. x IN s ==> f(x) = a) + ==> !x. x IN closure(s) ==> f(x) = a`, + REWRITE_TAC[SET_RULE + `x IN s ==> f x = a <=> x IN s ==> f x IN {a}`] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[CLOSED_SING]);; + +let CONTINUOUS_AGREE_ON_CLOSURE = prove + (`!g h:real^M->real^N. + g continuous_on closure s /\ h continuous_on closure s /\ + (!x. x IN s ==> g x = h x) + ==> !x. x IN closure s ==> g x = h x`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_CLOSURE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT = prove + (`!f:real^M->real^N s a. + f continuous_on s + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x = a}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_SING]);; + +let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove + (`!f:real^M->real^N s. + f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN + ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE + `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_SING] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Theorems relating continuity and uniform continuity to closures. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CLOSURE = prove + (`!f:real^M->real^N s. + f continuous_on closure s <=> + !x e. x IN closure s /\ &0 < e + ==> ?d. &0 < d /\ + !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on] THEN + EQ_TAC THENL [MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `e / &2`]) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min k (d / &2)`) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN + ASM_MESON_TAC[DIST_SYM; NORM_ARITH + `dist(a,b) < e / &2 /\ dist(b,c) < e / &2 ==> dist(a,c) < e`]);; + +let CONTINUOUS_ON_CLOSURE_SEQUENTIALLY = prove + (`!f:real^M->real^N s. + f continuous_on closure s <=> + !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially + ==> ((f o x) --> f a) sequentially`, + REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM continuous_within] THEN + REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; + +let UNIFORMLY_CONTINUOUS_ON_CLOSURE = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s /\ f continuous_on closure s + ==> f uniformly_continuous_on closure s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[uniformly_continuous_on] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPECL [`x:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d1 (d / &3)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN + DISCH_THEN(X_CHOOSE_THEN `x':real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `x':real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d2 (d / &3)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN + DISCH_THEN(X_CHOOSE_THEN `y':real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `y':real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x':real^M`; `y':real^M`]) THEN + ASM_MESON_TAC[DIST_SYM; NORM_ARITH + `dist(y,x) < d / &3 /\ dist(x',x) < d / &3 /\ dist(y',y) < d / &3 + ==> dist(y',x') < d`]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity properties for square roots. We get other forms of this *) +(* later (transcendentals.ml and realanalysis.ml) but it's nice to have *) +(* them around earlier. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_AT_SQRT = prove + (`!a s. &0 < drop a ==> (lift o sqrt o drop) continuous (at a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `min (drop a) (e * sqrt(drop a))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; SQRT_POS_LT; REAL_LT_MUL; DIST_REAL] THEN + X_GEN_TAC `b:real^1` THEN REWRITE_TAC[GSYM drop] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH + `abs(b - a) < a ==> &0 < b`)) THEN + SUBGOAL_THEN + `sqrt(drop b) - sqrt(drop a) = + (drop b - drop a) / (sqrt(drop a) + sqrt(drop b))` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD + `sa pow 2 = a /\ sb pow 2 = b /\ &0 < sa /\ &0 < sb + ==> sb - sa = (b - a) / (sa + sb)`) THEN + ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_ABS_DIV; SQRT_POS_LT; REAL_LT_ADD; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < x ==> abs x = x`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LTE_TRANS)) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_ADDR; SQRT_POS_LE; + REAL_LT_IMP_LE]]);; + +let CONTINUOUS_WITHIN_LIFT_SQRT = prove + (`!a s. (!x. x IN s ==> &0 <= drop x) + ==> (lift o sqrt o drop) continuous (at a within s)`, + REPEAT STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `drop a < &0 \/ drop a = &0 \/ &0 < drop a`) + THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN + EXISTS_TAC `{x | &0 <= drop x}` THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM] THEN + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN + ASM_REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LE] THEN + REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]) THEN + ASM_REWRITE_TAC[continuous_within; o_THM; DROP_VEC; SQRT_0; LIFT_NUM] THEN + REWRITE_TAC[DIST_0; NORM_LIFT; NORM_REAL; GSYM drop] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `(e:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT] THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN + SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL + [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; + MATCH_MP_TAC SQRT_MONO_LT THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[]]);; + +let CONTINUOUS_WITHIN_SQRT_COMPOSE = prove + (`!f s a:real^N. + (\x. lift(f x)) continuous (at a within s) /\ + (&0 < f a \/ !x. x IN s ==> &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous (at a within s)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + (MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF]; ALL_TAC]) + THENL + [MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP]; + MATCH_MP_TAC CONTINUOUS_WITHIN_LIFT_SQRT THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]]);; + +let CONTINUOUS_AT_SQRT_COMPOSE = prove + (`!f a:real^N. + (\x. lift(f x)) continuous (at a) /\ (&0 < f a \/ !x. &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous (at a)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:real^N->real`; `(:real^N)`; `a:real^N`] + CONTINUOUS_WITHIN_SQRT_COMPOSE) THEN + REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; + +let CONTINUOUS_ON_LIFT_SQRT = prove + (`!s. (!x. x IN s ==> &0 <= drop x) + ==> (lift o sqrt o drop) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_LIFT_SQRT]);; + +let CONTINUOUS_ON_LIFT_SQRT_COMPOSE = prove + (`!f:real^N->real s. + (lift o f) continuous_on s /\ (!x. x IN s ==> &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; LIFT_DROP]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_SQRT THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy continuity, and the extension of functions to closures. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s + ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; cauchy; o_DEF] THEN + MESON_TAC[]);; + +let CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS = prove + (`!f:real^M->real^N s. + f continuous_on s /\ closed s + ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, + REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; CONTINUOUS_ON_SEQUENTIALLY] THEN + REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]);; + +let CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA = prove + (`!f:real^M->real^N s. + (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) + ==> !a x. (!n. (x n) IN s) /\ (x --> a) sequentially + ==> ?l. ((f o x) --> l) sequentially /\ + !y. (!n. (y n) IN s) /\ (y --> a) sequentially + ==> ((f o y) --> l) sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:num->real^M` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `y:num->real^M`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN + DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `l:real^N = m` (fun th -> ASM_REWRITE_TAC[th]) THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (f:real^M->real^N)(x n) - f(y n)` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `\n. if EVEN n then x(n DIV 2):real^M else y(n DIV 2)`) THEN + REWRITE_TAC[cauchy; o_THM; LIM_SEQUENTIALLY] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC + [`((y:num->real^M) --> a) sequentially`; + `((x:num->real^M) --> a) sequentially`] THEN + REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `2 * (N1 + N2)` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `m DIV 2` th) THEN MP_TAC(SPEC `n DIV 2` th))) THEN + REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN + CONV_TAC NORM_ARITH; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`2 * n`; `2 * n + 1`]) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n /\ (2 * n + 1) DIV 2 = n`] THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO]]);; + +let CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove + (`!f:real^M->real^N s. + (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) + ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a:real^M. ?x. + a IN closure s ==> (!n. x n IN s) /\ (x --> a) sequentially` + MP_TAC THENL [MESON_TAC[CLOSURE_SEQUENTIAL]; ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `X:real^M->num->real^M` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA) THEN + DISCH_THEN(MP_TAC o GEN `a:real^M` o + SPECL [`a:real^M`; `(X:real^M->num->real^M) a`]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `(!a. P a ==> Q a) ==> ((!a. P a ==> R a) ==> p) + ==> ((!a. Q a ==> R a) ==> p)`)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN + STRIP_TAC THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `(\n. a):num->real^M` o CONJUNCT2) THEN + ASM_SIMP_TAC[LIM_CONST_EQ; o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY]; + STRIP_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`x:num->real^M`; `a:real^M`] THEN STRIP_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M)` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[o_THM]);; + +let UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s + ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> g x = f x) /\ + !h. h continuous_on closure s /\ (!x. x IN s ==> h x = f x) + ==> !x. x IN closure s ==> h x = g x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o + MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE; UNIFORMLY_CONTINUOUS_ON_EQ]; + ASM_MESON_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]);; + +let CAUCHY_CONTINUOUS_IMP_CONTINUOUS = prove + (`!f:real^M->real^N s. + (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) + ==> f continuous_on s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CLOSURE_SUBSET; CONTINUOUS_ON_EQ]);; + +let BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `IMAGE (g:real^M->real^N) (closure s)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[COMPACT_CLOSURE; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; + COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE]; + MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Occasionally useful invariance properties. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_AT_COMPOSE_EQ = prove + (`!f:real^M->real^N g:real^M->real^M h:real^M->real^M. + g continuous at x /\ h continuous at (g x) /\ + (!y. g(h y) = y) /\ h(g x) = x + ==> (f continuous at (g x) <=> (\x. f(g x)) continuous at x)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `((f:real^M->real^N) o (g:real^M->real^M) o (h:real^M->real^M)) + continuous at (g(x:real^M))` + MP_TAC THENL + [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + ASM_REWRITE_TAC[o_DEF]; + + ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; + +let CONTINUOUS_AT_TRANSLATION = prove + (`!a z f:real^M->real^N. + f continuous at (a + z) <=> (\x. f(a + x)) continuous at z`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN + EXISTS_TAC `\x:real^M. x - a` THEN + SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_SUB; + CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN + VECTOR_ARITH_TAC);; + +add_translation_invariants [CONTINUOUS_AT_TRANSLATION];; + +let CONTINUOUS_AT_LINEAR_IMAGE = prove + (`!h:real^M->real^M z f:real^M->real^N. + linear h /\ (!x. norm(h x) = norm x) + ==> (f continuous at (h z) <=> (\x. f(h x)) continuous at z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I + [GSYM ORTHOGONAL_TRANSFORMATION]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `g:real^M->real^M` o MATCH_MP + ORTHOGONAL_TRANSFORMATION_INVERSE) THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN + EXISTS_TAC `g:real^M->real^M` THEN + RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_TRANSFORMATION]) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; + +add_linear_invariants [CONTINUOUS_AT_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Interior of an injective image. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_IMAGE_SUBSET = prove + (`!f:real^M->real^N s. + (!x. f continuous at x) /\ (!x y. f x = f y ==> x = y) + ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN + REWRITE_TAC[interior; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + SUBGOAL_THEN `y IN IMAGE (f:real^M->real^N) s` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + EXISTS_TAC `{x | (f:real^M->real^N)(x) IN t}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[]; + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Making a continuous function avoid some value in a neighbourhood. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_AVOID = prove + (`!f:real^M->real^N x s a. + f continuous (at x within s) /\ x IN s /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN + DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x - a)`) THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC);; + +let CONTINUOUS_AT_AVOID = prove + (`!f:real^M->real^N x a. + f continuous (at x) /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, + MP_TAC CONTINUOUS_WITHIN_AVOID THEN + REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(:real^M)`) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; + +let CONTINUOUS_ON_AVOID = prove + (`!f:real^M->real^N x s a. + f continuous_on s /\ x IN s /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN + ASM_SIMP_TAC[]);; + +let CONTINUOUS_ON_OPEN_AVOID = prove + (`!f:real^M->real^N x s a. + f continuous_on s /\ open s /\ x IN s /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `open(s:real^M->bool)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Proving a function is constant by proving open-ness of level set. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_LEVELSET_OPEN_IN_CASES = prove + (`!f:real^M->real^N s a. + connected s /\ + f continuous_on s /\ + open_in (subtopology euclidean s) {x | x IN s /\ f x = a} + ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> f x = a)`, + REWRITE_TAC[SET_RULE `(!x. x IN s ==> ~(f x = a)) <=> + {x | x IN s /\ f x = a} = {}`; + SET_RULE `(!x. x IN s ==> f x = a) <=> + {x | x IN s /\ f x = a} = s`] THEN + REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]);; + +let CONTINUOUS_LEVELSET_OPEN_IN = prove + (`!f:real^M->real^N s a. + connected s /\ + f continuous_on s /\ + open_in (subtopology euclidean s) {x | x IN s /\ f x = a} /\ + (?x. x IN s /\ f x = a) + ==> (!x. x IN s ==> f x = a)`, + MESON_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]);; + +let CONTINUOUS_LEVELSET_OPEN = prove + (`!f:real^M->real^N s a. + connected s /\ + f continuous_on s /\ + open {x | x IN s /\ f x = a} /\ + (?x. x IN s /\ f x = a) + ==> (!x. x IN s ==> f x = a)`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN + ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN + EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x = a}` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some arithmetical combinations (more to prove). *) +(* ------------------------------------------------------------------------- *) + +let OPEN_SCALING = prove + (`!s:real^N->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e * abs(c)` THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `inv(c) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN `x = inv(c) % c % x:real^N` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; + REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN + ASM_REWRITE_TAC[GSYM dist]]);; + +let OPEN_NEGATIONS = prove + (`!s:real^N->bool. open s ==> open (IMAGE (--) s)`, + SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x` + (fun th -> SIMP_TAC[th; OPEN_SCALING; REAL_ARITH `~(--(&1) = &0)`]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; + +let OPEN_TRANSLATION = prove + (`!s a:real^N. open s ==> open(IMAGE (\x. a + x) s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. x - a`; `s:real^N->bool`] + CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN + ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + ASM_MESON_TAC[VECTOR_ARITH `(a + x) - a = x:real^N`; + VECTOR_ARITH `a + (x - a) = x:real^N`]);; + +let OPEN_TRANSLATION_EQ = prove + (`!a s. open (IMAGE (\x:real^N. a + x) s) <=> open s`, + REWRITE_TAC[open_def] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [OPEN_TRANSLATION_EQ];; + +let OPEN_AFFINITY = prove + (`!s a:real^N c. + open s /\ ~(c = &0) ==> open (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; OPEN_TRANSLATION; OPEN_SCALING]);; + +let INTERIOR_TRANSLATION = prove + (`!a:real^N s. + interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)`, + REWRITE_TAC[interior] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [INTERIOR_TRANSLATION];; + +let OPEN_SUMS = prove + (`!s t:real^N->bool. + open s \/ open t ==> open {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`); + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VECTOR_ADD_SYM; VECTOR_ARITH `(z - y) + y:real^N = z`; + NORM_ARITH `dist(z:real^N,x + y) < e ==> dist(z - y,x) < e`]);; + +(* ------------------------------------------------------------------------- *) +(* Upper and lower hemicontinuous functions, relation in the case of *) +(* preimage map to open and closed maps, and fact that upper and lower *) +(* hemicontinuity together imply continuity in the sense of the Hausdorff *) +(* metric (at points where the function gives a bounded and nonempty set). *) +(* ------------------------------------------------------------------------- *) + +let UPPER_HEMICONTINUOUS = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) + ==> ((!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) <=> + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ ~(f(x) INTER u = {})}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + MATCH_MP_TAC MONO_IMP THEN + SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL + [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]; REWRITE_TAC[closed_in]] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let LOWER_HEMICONTINUOUS = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) + ==> ((!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) <=> + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ ~(f(x) INTER u = {})}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + MATCH_MP_TAC MONO_IMP THEN + SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL + [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) + {y | y IN t /\ + {x | x IN s /\ f x = y} SUBSET u}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; + X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=> + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) + {y | y IN t /\ + {x | x IN s /\ f x = y} SUBSET u}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; + X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let UPPER_LOWER_HEMICONTINUOUS_EXPLICIT = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) /\ + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) /\ + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) + ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {}) + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x,x') < d + ==> (!y. y IN f x + ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\ + (!y'. y' IN f x' + ==> ?y. y IN f x /\ dist(y',y) < e)`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC + `!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN + DISCH_THEN(MP_TAC o SPEC + `t INTER + {a + b | a IN (f:real^M->real^N->bool) x /\ b IN ball(vec 0,e)}`) THEN + SIMP_TAC[OPEN_SUMS; OPEN_BALL; OPEN_IN_OPEN_INTER] THEN + REWRITE_TAC[open_in; SUBSET_RESTRICT] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_SIMP_TAC[IN_ELIM_THM; SUBSET_INTER] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1")))] THEN + UNDISCH_TAC + `!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN + ASM_SIMP_TAC[LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o + GEN `a:real^N` o SPEC `t INTER ball(a:real^N,e / &2)`) THEN + SIMP_TAC[OPEN_BALL; OPEN_IN_OPEN_INTER] THEN + + MP_TAC(SPEC `closure((f:real^M->real^N->bool) x)` + COMPACT_EQ_HEINE_BOREL) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC + `{ball(a:real^N,e / &2) | a IN (f:real^M->real^N->bool) x}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_BALL] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL + [REWRITE_TAC[CLOSURE_APPROACHABLE; SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC[REAL_HALF]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP + (MESON[CLOSURE_SUBSET; SUBSET_TRANS] + `closure s SUBSET t ==> s SUBSET t`)) THEN + SUBGOAL_THEN + `open_in (subtopology euclidean s) + (INTERS {{x | x IN s /\ + ~((f:real^M->real^N->bool) x INTER t INTER ball(a,e / &2) = {})} | + a IN c})` + MP_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTERS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[open_in] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ANTS_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `a:real^N` THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `d2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))] THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; + REMOVE_THEN "1" (MP_TAC o SPEC `x':real^M`) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = a + b <=> x - a = b`; + DIST_0; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[dist]] THEN + REMOVE_THEN "2" (MP_TAC o SPEC `x':real^M`) THEN + ASM_REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + DISCH_THEN(LABEL_TAC "3") THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + UNDISCH_TAC `(f:real^M->real^N->bool) x SUBSET + UNIONS (IMAGE (\a. ball (a,e / &2)) c)` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "3" (MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Connected components, considered as a "connectedness" relation or a set. *) +(* ------------------------------------------------------------------------- *) + +let connected_component = new_definition + `connected_component s x y <=> + ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t`;; + +let CONNECTED_COMPONENT_IN = prove + (`!s x y. connected_component s x y ==> x IN s /\ y IN s`, + REWRITE_TAC[connected_component] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_REFL = prove + (`!s x:real^N. x IN s ==> connected_component s x x`, + REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[CONNECTED_SING] THEN + ASM SET_TAC[]);; + +let CONNECTED_COMPONENT_REFL_EQ = prove + (`!s x:real^N. connected_component s x x <=> x IN s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN + REWRITE_TAC[connected_component] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_SYM = prove + (`!s x y:real^N. connected_component s x y ==> connected_component s y x`, + REWRITE_TAC[connected_component] THEN MESON_TAC[]);; + +let CONNECTED_COMPONENT_TRANS = prove + (`!s x y:real^N. + connected_component s x y /\ connected_component s y z + ==> connected_component s x z`, + REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `t:real^N->bool`) + (X_CHOOSE_TAC `u:real^N->bool`)) THEN + EXISTS_TAC `t UNION u:real^N->bool` THEN + ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN + MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);; + +let CONNECTED_COMPONENT_OF_SUBSET = prove + (`!s t x. s SUBSET t /\ connected_component s x y + ==> connected_component t x y`, + REWRITE_TAC[connected_component] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_SET = prove + (`!s x. connected_component s x = + { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}`, + REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN + REWRITE_TAC[IN; connected_component] THEN MESON_TAC[]);; + +let CONNECTED_COMPONENT_UNIONS = prove + (`!s x. connected_component s x = + UNIONS {t | connected t /\ x IN t /\ t SUBSET s}`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_SUBSET = prove + (`!s x. (connected_component s x) SUBSET s`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_CONNECTED_COMPONENT_SET = prove + (`!s. connected s <=> !x:real^N. x IN s ==> connected_component s x = s`, + GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN EQ_TAC THENL + [SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_UNIONS THEN + ASM SET_TAC[]);; + +let CONNECTED_COMPONENT_EQ_SELF = prove + (`!s x. connected s /\ x IN s ==> connected_component s x = s`, + MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]);; + +let CONNECTED_IFF_CONNECTED_COMPONENT = prove + (`!s. connected s <=> + !x y. x IN s /\ y IN s ==> connected_component s x y`, + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN + REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN; CONNECTED_COMPONENT_IN]);; + +let CONNECTED_COMPONENT_MAXIMAL = prove + (`!s t x:real^N. + x IN t /\ connected t /\ t SUBSET s + ==> t SUBSET (connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_MONO = prove + (`!s t x. s SUBSET t + ==> (connected_component s x) SUBSET (connected_component t x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_CONNECTED_COMPONENT = prove + (`!s x. connected(connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_EQ_EMPTY = prove + (`!s x:real^N. connected_component s x = {} <=> ~(x IN s)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]);; + +let CONNECTED_COMPONENT_EMPTY = prove + (`!x. connected_component {} x = {}`, + REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);; + +let CONNECTED_COMPONENT_EQ = prove + (`!s x y. y IN connected_component s x + ==> (connected_component s y = connected_component s x)`, + REWRITE_TAC[EXTENSION; IN] THEN + MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; + +let CLOSED_CONNECTED_COMPONENT = prove + (`!s x:real^N. closed s ==> closed(connected_component s x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(x:real^N) IN s` THENL + [ALL_TAC; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CLOSED_EMPTY]] THEN + REWRITE_TAC[GSYM CLOSURE_EQ] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + SIMP_TAC[CONNECTED_CLOSURE; CONNECTED_CONNECTED_COMPONENT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; + +let CONNECTED_COMPONENT_DISJOINT = prove + (`!s a b. DISJOINT (connected_component s a) (connected_component s b) <=> + ~(a IN connected_component s b)`, + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN] THEN + MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; + +let CONNECTED_COMPONENT_NONOVERLAP = prove + (`!s a b:real^N. + (connected_component s a) INTER (connected_component s b) = {} <=> + ~(a IN s) \/ ~(b IN s) \/ + ~(connected_component s a = connected_component s b)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[INTER_EMPTY] THEN + ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC + `connected_component s (a:real^N) = connected_component s b` THEN + ASM_REWRITE_TAC[INTER_IDEMPOT; CONNECTED_COMPONENT_EQ_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DISJOINT]) THEN + REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]);; + +let CONNECTED_COMPONENT_OVERLAP = prove + (`!s a b:real^N. + ~((connected_component s a) INTER (connected_component s b) = {}) <=> + a IN s /\ b IN s /\ + connected_component s a = connected_component s b`, + REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP; DE_MORGAN_THM]);; + +let CONNECTED_COMPONENT_SYM_EQ = prove + (`!s x y. connected_component s x y <=> connected_component s y x`, + MESON_TAC[CONNECTED_COMPONENT_SYM]);; + +let CONNECTED_COMPONENT_EQ_EQ = prove + (`!s x y:real^N. + connected_component s x = connected_component s y <=> + ~(x IN s) /\ ~(y IN s) \/ + x IN s /\ y IN s /\ connected_component s x y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL + [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[FUN_EQ_THM] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_REFL; + CONNECTED_COMPONENT_SYM]; + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN + ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN + ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]);; + +let CONNECTED_EQ_CONNECTED_COMPONENT_EQ = prove + (`!s. connected s <=> + !x y. x IN s /\ y IN s + ==> connected_component s x = connected_component s y`, + SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);; + +let CONNECTED_COMPONENT_IDEMP = prove + (`!s x:real^N. connected_component (connected_component s x) x = + connected_component s x`, + REWRITE_TAC[FUN_EQ_THM; connected_component] THEN + REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL; SUBSET_TRANS; + CONNECTED_COMPONENT_SUBSET]);; + +let CONNECTED_COMPONENT_UNIQUE = prove + (`!s c x:real^N. + x IN c /\ c SUBSET s /\ connected c /\ + (!c'. x IN c' /\ c' SUBSET s /\ connected c' + ==> c' SUBSET c) + ==> connected_component s x = c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN + REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; + +let JOINABLE_CONNECTED_COMPONENT_EQ = prove + (`!s t x y:real^N. + connected t /\ t SUBSET s /\ + ~(connected_component s x INTER t = {}) /\ + ~(connected_component s y INTER t = {}) + ==> connected_component s x = connected_component s y`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN + REWRITE_TAC[IN] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `w:real^N` THEN CONJ_TAC THENL + [REWRITE_TAC[connected_component] THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[IN; CONNECTED_COMPONENT_SYM]]);; + +let CONNECTED_COMPONENT_TRANSLATION = prove + (`!a s x. connected_component (IMAGE (\x. a + x) s) (a + x) = + IMAGE (\x. a + x) (connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [CONNECTED_COMPONENT_TRANSLATION];; + +let CONNECTED_COMPONENT_LINEAR_IMAGE = prove + (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> connected_component (IMAGE f s) (f x) = + IMAGE f (connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN + GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [CONNECTED_COMPONENT_LINEAR_IMAGE];; + +let UNIONS_CONNECTED_COMPONENT = prove + (`!s:real^N->bool. UNIONS {connected_component s x |x| x IN s} = s`, + GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; CONNECTED_COMPONENT_SUBSET] THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]);; + +let COMPLEMENT_CONNECTED_COMPONENT_UNIONS = prove + (`!s x:real^N. + s DIFF connected_component s x = + UNIONS({connected_component s y | y | y IN s} DELETE + (connected_component s x))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM UNIONS_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s DELETE a ==> DISJOINT a x) + ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN + SIMP_TAC[CONNECTED_COMPONENT_DISJOINT; CONNECTED_COMPONENT_EQ_EQ] THEN + MESON_TAC[IN; SUBSET; CONNECTED_COMPONENT_SUBSET]);; + +let CLOSED_IN_CONNECTED_COMPONENT = prove + (`!s x:real^N. closed_in (subtopology euclidean s) (connected_component s x)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN + ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `closure(connected_component s x):real^N->bool` THEN + REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_INTER] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `connected_component s (x:real^N)` THEN + REWRITE_TAC[INTER_SUBSET; CONNECTED_CONNECTED_COMPONENT; + SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET]]);; + +let OPEN_IN_CONNECTED_COMPONENT = prove + (`!s x:real^N. + FINITE {connected_component s x |x| x IN s} + ==> open_in (subtopology euclidean s) (connected_component s x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `connected_component s (x:real^N) = + s DIFF (UNIONS {connected_component s y |y| y IN s} DIFF + connected_component s x)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s DIFF (s DIFF t)`) THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; + MATCH_MP_TAC OPEN_IN_DIFF THEN + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN + REWRITE_TAC[UNIONS_DIFF] THEN + MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN + `connected_component s y DIFF connected_component s x = + connected_component s y \/ + connected_component s (y:real^N) DIFF connected_component s x = {}` + (DISJ_CASES_THEN SUBST1_TAC) + THENL + [MATCH_MP_TAC(SET_RULE + `(~(s INTER t = {}) ==> s = t) ==> s DIFF t = s \/ s DIFF t = {}`) THEN + SIMP_TAC[CONNECTED_COMPONENT_OVERLAP]; + REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT]; + REWRITE_TAC[CLOSED_IN_EMPTY]]]);; + +let CONNECTED_COMPONENT_EQUIVALENCE_RELATION = prove + (`!R s:real^N->bool. + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!a. a IN s + ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ + !x. x IN t ==> R a x) + ==> !a b. connected_component s a b ==> R a b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`R:real^N->real^N->bool`; `connected_component s (a:real^N)`] + CONNECTED_EQUIVALENCE_RELATION) THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL + [X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t INTER connected_component s (a:real^N)` THEN + ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + CONNECTED_COMPONENT_SUBSET) THEN + SET_TAC[]; + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]);; + +let CONNECTED_COMPONENT_INTERMEDIATE_SUBSET = prove + (`!t u a:real^N. + connected_component u a SUBSET t /\ t SUBSET u + ==> connected_component t a = connected_component u a`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM SET_TAC[]; + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* The set of connected components of a set. *) +(* ------------------------------------------------------------------------- *) + +let components = new_definition + `components s = {connected_component s x | x | x:real^N IN s}`;; + +let COMPONENTS_TRANSLATION = prove + (`!a s. components(IMAGE (\x. a + x) s) = + IMAGE (IMAGE (\x. a + x)) (components s)`, + REWRITE_TAC[components] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);; + +add_translation_invariants [COMPONENTS_TRANSLATION];; + +let COMPONENTS_LINEAR_IMAGE = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> components(IMAGE f s) = IMAGE (IMAGE f) (components s)`, + REWRITE_TAC[components] THEN GEOM_TRANSFORM_TAC[] THEN SET_TAC[]);; + +add_linear_invariants [COMPONENTS_LINEAR_IMAGE];; + +let IN_COMPONENTS = prove + (`!u:real^N->bool s. s IN components u + <=> ?x. x IN u /\ s = connected_component u x`, + REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC + THENL [SET_TAC[];STRIP_TAC THEN ASM_SIMP_TAC[] THEN + UNDISCH_TAC `x:real^N IN u` THEN SET_TAC[]]);; + +let UNIONS_COMPONENTS = prove + (`!u:real^N->bool. u = UNIONS (components u)`, + REWRITE_TAC[EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC + THENL[DISCH_TAC THEN REWRITE_TAC[IN_UNIONS] THEN + EXISTS_TAC `connected_component (u:real^N->bool) x` THEN CONJ_TAC THENL + [REWRITE_TAC[components] THEN SET_TAC[ASSUME `x:real^N IN u`]; + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SUBGOAL_THEN + `?s:real^N->bool. connected s /\ s SUBSET u /\ x IN s` MP_TAC + THENL[EXISTS_TAC `{x:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN + POP_ASSUM MP_TAC THEN SET_TAC[]; SET_TAC[]]]; + REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN + MATCH_MP_TAC (SET_RULE `!x:real^N s u. x IN s /\ s SUBSET u ==> x IN u`) THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_ASSUME_TAC + (MESON[IN_COMPONENTS;ASSUME `t:real^N->bool IN components u`] + `?y. t:real^N->bool = connected_component u y`) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; + +let PAIRWISE_DISJOINT_COMPONENTS = prove + (`!u:real^N->bool. pairwise DISJOINT (components u)`, + GEN_TAC THEN REWRITE_TAC[pairwise;DISJOINT] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN + ASSERT_TAC `(?a. s:real^N->bool = connected_component u a) /\ + ?b. t:real^N->bool = connected_component u b` + THENL [ASM_MESON_TAC[IN_COMPONENTS]; + ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]);; + +let IN_COMPONENTS_NONEMPTY = prove + (`!s c. c IN components s ==> ~(c = {})`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; + +let IN_COMPONENTS_SUBSET = prove + (`!s c. c IN components s ==> c SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; + +let IN_COMPONENTS_CONNECTED = prove + (`!s c. c IN components s ==> connected c`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);; + +let IN_COMPONENTS_MAXIMAL = prove + (`!s c:real^N->bool. + c IN components s <=> + ~(c = {}) /\ c SUBSET s /\ connected c /\ + !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c' + ==> c' = c`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_SUBSET; + CONNECTED_CONNECTED_COMPONENT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN; SUBSET]; + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]]);; + +let JOINABLE_COMPONENTS_EQ = prove + (`!s t c1 c2. + connected t /\ t SUBSET s /\ + c1 IN components s /\ c2 IN components s /\ + ~(c1 INTER t = {}) /\ ~(c2 INTER t = {}) + ==> c1 = c2`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN + MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]);; + +let CLOSED_IN_COMPONENT = prove + (`!s c:real^N->bool. + c IN components s ==> closed_in (subtopology euclidean s) c`, + REWRITE_TAC[components; FORALL_IN_GSPEC; CLOSED_IN_CONNECTED_COMPONENT]);; + +let CLOSED_COMPONENTS = prove + (`!s c. closed s /\ c IN components s ==> closed c`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN + SIMP_TAC[CLOSED_CONNECTED_COMPONENT]);; + +let COMPACT_COMPONENTS = prove + (`!s c:real^N->bool. compact s /\ c IN components s ==> compact c`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + MESON_TAC[CLOSED_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET]);; + +let CONTINUOUS_ON_COMPONENTS_GEN = prove + (`!f:real^M->real^N s. + (!c. c IN components s + ==> open_in (subtopology euclidean s) c /\ f continuous_on c) + ==> f continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN + DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN t} = + UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` + SUBST1_TAC THENL + [CONV_TAC(LAND_CONV(SUBS_CONV + [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; + MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[OPEN_IN_TRANS]]);; + +let CONTINUOUS_ON_COMPONENTS_FINITE = prove + (`!f:real^M->real^N s. + FINITE(components s) /\ + (!c. c IN components s ==> f continuous_on c) + ==> f continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN + DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN t} = + UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` + SUBST1_TAC THENL + [CONV_TAC(LAND_CONV(SUBS_CONV + [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_COMPONENT]]);; + +let COMPONENTS_NONOVERLAP = prove + (`!s c c'. c IN components s /\ c' IN components s + ==> (c INTER c' = {} <=> ~(c = c'))`, + REWRITE_TAC[components; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CONNECTED_COMPONENT_NONOVERLAP]);; + +let COMPONENTS_EQ = prove + (`!s c c'. c IN components s /\ c' IN components s + ==> (c = c' <=> ~(c INTER c' = {}))`, + MESON_TAC[COMPONENTS_NONOVERLAP]);; + +let COMPONENTS_EQ_EMPTY = prove + (`!s. components s = {} <=> s = {}`, + GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[components; connected_component; IN_ELIM_THM] THEN + SET_TAC[]);; + +let COMPONENTS_EMPTY = prove + (`components {} = {}`, + REWRITE_TAC[COMPONENTS_EQ_EMPTY]);; + +let CONNECTED_EQ_CONNECTED_COMPONENTS_EQ = prove + (`!s. connected s <=> + !c c'. c IN components s /\ c' IN components s ==> c = c'`, + REWRITE_TAC[components; IN_ELIM_THM] THEN + MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]);; + +let COMPONENTS_EQ_SING,COMPONENTS_EQ_SING_EXISTS = (CONJ_PAIR o prove) + (`(!s:real^N->bool. components s = {s} <=> connected s /\ ~(s = {})) /\ + (!s:real^N->bool. (?a. components s = {a}) <=> connected s /\ ~(s = {}))`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN + MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) + ==> (p <=> r) /\ (q <=> r)`) THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN + ASM_MESON_TAC[IN_SING; COMPONENTS_EQ_EMPTY; NOT_INSERT_EMPTY]; + STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[IN_SING] THEN + REWRITE_TAC[components; IN_ELIM_THM] THEN + ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; MEMBER_NOT_EMPTY]]);; + +let CONNECTED_EQ_COMPONENTS_SUBSET_SING = prove + (`!s:real^N->bool. connected s <=> components s SUBSET {s}`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN + REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN + ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING]);; + +let CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS = prove + (`!s:real^N->bool. connected s <=> ?a. components s SUBSET {a}`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN + REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN + ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING_EXISTS]);; + +let IN_COMPONENTS_SELF = prove + (`!s:real^N->bool. s IN components s <=> connected s /\ ~(s = {})`, + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED]; + SIMP_TAC[GSYM COMPONENTS_EQ_SING; IN_SING]]);; + +let COMPONENTS_MAXIMAL = prove + (`!s t c:real^N->bool. + c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {}) + ==> t SUBSET c`, + REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]);; + +let COMPONENTS_UNIQUE = prove + (`!s:real^N->bool k. + UNIONS k = s /\ + (!c. c IN k + ==> connected c /\ ~(c = {}) /\ + !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c) + ==> components s = k`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `connected_component s (x:real^N) = c` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_UNION; ASM SET_TAC[]] THEN + ASM SET_TAC[]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +let COMPONENTS_UNIQUE_EQ = prove + (`!s:real^N->bool k. + components s = k <=> + UNIONS k = s /\ + (!c. c IN k + ==> connected c /\ ~(c = {}) /\ + !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM); REWRITE_TAC[COMPONENTS_UNIQUE]] THEN + REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; + RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN + ASM_MESON_TAC[SUBSET_EMPTY]]);; + +let EXISTS_COMPONENT_SUPERSET = prove + (`!s t:real^N->bool. + t SUBSET s /\ ~(s = {}) /\ connected t + ==> ?c. c IN components s /\ t SUBSET c`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN + ASM_MESON_TAC[COMPONENTS_EQ_EMPTY; MEMBER_NOT_EMPTY]; + FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `connected_component s (a:real^N)` THEN + REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]);; + +let COMPONENTS_INTERMEDIATE_SUBSET = prove + (`!s t u:real^N->bool. + s IN components u /\ s SUBSET t /\ t SUBSET u + ==> s IN components t`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN + MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; SUBSET; + CONNECTED_COMPONENT_REFL; IN; CONNECTED_COMPONENT_SUBSET]);; + +let IN_COMPONENTS_UNIONS_COMPLEMENT = prove + (`!s c:real^N->bool. + c IN components s + ==> s DIFF c = UNIONS(components s DELETE c)`, + REWRITE_TAC[components; FORALL_IN_GSPEC; + COMPLEMENT_CONNECTED_COMPONENT_UNIONS]);; + +let CONNECTED_SUBSET_CLOPEN = prove + (`!u s c:real^N->bool. + closed_in (subtopology euclidean u) s /\ + open_in (subtopology euclidean u) s /\ + connected c /\ c SUBSET u /\ ~(c INTER s = {}) + ==> c SUBSET s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o + SPECL [`c INTER s:real^N->bool`; `c DIFF s:real^N->bool`]) THEN + ASM_REWRITE_TAC[CONJ_ASSOC; SET_RULE `c DIFF s = {} <=> c SUBSET s`] THEN + MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]); + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN])] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[OPEN_IN_OPEN; CLOSED_IN_CLOSED] THENL + [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `(:real^N) DIFF t`] THEN + ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; + +let CLOPEN_UNIONS_COMPONENTS = prove + (`!u s:real^N->bool. + closed_in (subtopology euclidean u) s /\ + open_in (subtopology euclidean u) s + ==> ?k. k SUBSET components u /\ s = UNIONS k`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `{c:real^N->bool | c IN components u /\ ~(c INTER s = {})}` THEN + REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THENL + [MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]]);; + +let CLOPEN_IN_COMPONENTS = prove + (`!u s:real^N->bool. + closed_in (subtopology euclidean u) s /\ + open_in (subtopology euclidean u) s /\ + connected s /\ ~(s = {}) + ==> s IN components u`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_UNIONS_COMPONENTS) THEN + DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `k:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN + ASM_CASES_TAC `k = {c:real^N->bool}` THENL + [ASM_MESON_TAC[UNIONS_1; GSYM SING_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN + SUBGOAL_THEN `?c':real^N->bool. c' IN k /\ ~(c = c')` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SET_RULE + `a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)`]; + REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN + DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `c':real^N->bool`]) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN + MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN + EXISTS_TAC `u:real^N->bool` THEN + MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity implies uniform continuity on a compact domain. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_UNIFORMLY_EQUICONTINUOUS = prove + (`!(fs:(real^M->real^N)->bool) s. + (!x e. x IN s /\ &0 < e + ==> ?d. &0 < d /\ + (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d + ==> dist (f x',f x) < e)) /\ + compact s + ==> !e. &0 < e + ==> ?d. &0 < d /\ + !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d + ==> dist(f x',f x) < e`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real^M->real->real` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN + DISCH_THEN(MP_TAC o SPEC + `{ ball(x:real^M,d x (e / &2)) | x IN s}`) THEN + SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CENTRE_IN_BALL; REAL_HALF]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `u:real^M`; `v:real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^M` th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN + ASM_REWRITE_TAC[DIST_REFL] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (CONJUNCTS_THEN2 ASSUME_TAC + SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `e / &2`]) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o CONJUNCT2) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN + MP_TAC(SPEC `v:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; + +let COMPACT_UNIFORMLY_CONTINUOUS = prove + (`!f:real^M->real^N s. + f continuous_on s /\ compact s ==> f uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; uniformly_continuous_on] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`{f:real^M->real^N}`; `s:real^M->bool`] + COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; IN_SING; FORALL_UNWIND_THM2] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A uniformly convergent limit of continuous functions is continuous. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_UNIFORM_LIMIT = prove + (`!net f:A->real^M->real^N g s. + ~(trivial_limit net) /\ + eventually (\n. (f n) continuous_on s) net /\ + (!e. &0 < e + ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) net) + ==> g continuous_on s`, + REWRITE_TAC[continuous_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN + DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:A` THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^M`) ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `w <= x + y + z + ==> x < e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`) THEN + REWRITE_TAC[dist] THEN + SUBST1_TAC(VECTOR_ARITH + `(g:real^M->real^N) y - g x = + --(f (a:A) y - g y) + (f a x - g x) + (f a y - f a x)`) THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_LADD] THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Topological stuff lifted from and dropped to R *) +(* ------------------------------------------------------------------------- *) + +let OPEN_LIFT = prove + (`!s. open(IMAGE lift s) <=> + !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`, + REWRITE_TAC[open_def; FORALL_LIFT; LIFT_IN_IMAGE_LIFT; DIST_LIFT]);; + +let LIMPT_APPROACHABLE_LIFT = prove + (`!x s. (lift x) limit_point_of (IMAGE lift s) <=> + !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e`, + REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT; + LIFT_EQ; DIST_LIFT]);; + +let CLOSED_LIFT = prove + (`!s. closed (IMAGE lift s) <=> + !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e) + ==> x IN s`, + GEN_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN + ONCE_REWRITE_TAC[FORALL_LIFT] THEN + REWRITE_TAC[LIMPT_APPROACHABLE_LIFT; LIFT_EQ; DIST_LIFT; + EXISTS_LIFT; LIFT_IN_IMAGE_LIFT]);; + +let CONTINUOUS_AT_LIFT_RANGE = prove + (`!f x. (lift o f) continuous (at x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. norm(x' - x) < d + ==> abs(f x' - f x) < e)`, + REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; + +let CONTINUOUS_ON_LIFT_RANGE = prove + (`!f s. (lift o f) continuous_on s <=> + !x. x IN s + ==> !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. x' IN s /\ norm(x' - x) < d + ==> abs(f x' - f x) < e)`, + REWRITE_TAC[continuous_on; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; + +let CONTINUOUS_LIFT_NORM_COMPOSE = prove + (`!net f:A->real^N. + f continuous net + ==> (\x. lift(norm(f x))) continuous net`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous; tendsto] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + NORM_ARITH_TAC);; + +let CONTINUOUS_ON_LIFT_NORM_COMPOSE = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> (\x. lift(norm(f x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_NORM_COMPOSE]);; + +let CONTINUOUS_AT_LIFT_NORM = prove + (`!x. (lift o norm) continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE; NORM_LIFT] THEN + MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_LIFT_NORM = prove + (`!s. (lift o norm) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE; NORM_LIFT] THEN + MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; + +let CONTINUOUS_AT_LIFT_COMPONENT = prove + (`!i a. 1 <= i /\ i <= dimindex(:N) + ==> (\x:real^N. lift(x$i)) continuous (at a)`, + SIMP_TAC[continuous_at; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; + +let CONTINUOUS_ON_LIFT_COMPONENT = prove + (`!i s. 1 <= i /\ i <= dimindex(:N) + ==> (\x:real^N. lift(x$i)) continuous_on s`, + SIMP_TAC[continuous_on; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; + +let CONTINUOUS_AT_LIFT_INFNORM = prove + (`!x:real^N. (lift o infnorm) continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT; LIM_AT; o_THM; DIST_LIFT] THEN + MESON_TAC[REAL_LET_TRANS; dist; REAL_ABS_SUB_INFNORM; INFNORM_LE_NORM]);; + +let CONTINUOUS_AT_LIFT_DIST = prove + (`!a:real^N x. (lift o (\x. dist(a,x))) continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN + MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; + REAL_LET_TRANS]);; + +let CONTINUOUS_ON_LIFT_DIST = prove + (`!a s. (lift o (\x. dist(a,x))) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN + MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; + REAL_LET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence some handy theorems on distance, diameter etc. of/from a set. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_ATTAINS_SUP = prove + (`!s. compact (IMAGE lift s) /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> y <= x`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN EXISTS_TAC `sup s` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s <= s - e <=> ~(&0 < e)`; + REAL_ARITH `x <= s /\ ~(x <= s - e) ==> abs(x - s) < e`]);; + +let COMPACT_ATTAINS_INF = prove + (`!s. compact (IMAGE lift s) /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> x <= y`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN EXISTS_TAC `inf s` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s + e <= s <=> ~(&0 < e)`; + REAL_ARITH `s <= x /\ ~(s + e <= x) ==> abs(x - s) < e`]);; + +let CONTINUOUS_ATTAINS_SUP = prove + (`!f:real^N->real s. + compact s /\ ~(s = {}) /\ (lift o f) continuous_on s + ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_SUP) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN + MESON_TAC[IN_IMAGE]);; + +let CONTINUOUS_ATTAINS_INF = prove + (`!f:real^N->real s. + compact s /\ ~(s = {}) /\ (lift o f) continuous_on s + ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_INF) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN + MESON_TAC[IN_IMAGE]);; + +let DISTANCE_ATTAINS_SUP = prove + (`!s a. compact s /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN REWRITE_TAC[dist] THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; + VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]);; + +(* ------------------------------------------------------------------------- *) +(* For *minimal* distance, we only need closure, not compactness. *) +(* ------------------------------------------------------------------------- *) + +let DISTANCE_ATTAINS_INF = prove + (`!s a:real^N. + closed s /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN + MP_TAC(ISPECL [`\x:real^N. dist(a,x)`; `cball(a:real^N,dist(b,a)) INTER s`] + CONTINUOUS_ATTAINS_INF) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; BOUNDED_INTER; + BOUNDED_CBALL; CLOSED_CBALL; GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[dist; CONTINUOUS_ON_LIFT_RANGE; IN_INTER; IN_CBALL] THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; REAL_LE_REFL; + NORM_SUB; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]; + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN + ASM_MESON_TAC[DIST_SYM; REAL_LE_TOTAL; REAL_LE_TRANS]]);; + +(* ------------------------------------------------------------------------- *) +(* We can now extend limit compositions to consider the scalar multiplier. *) +(* ------------------------------------------------------------------------- *) + +let LIM_MUL = prove + (`!net:(A)net f l:real^N c d. + ((lift o c) --> lift d) net /\ (f --> l) net + ==> ((\x. c(x) % f(x)) --> (d % l)) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `\x (y:real^N). drop x % y`; + `lift o (c:A->real)`; `f:A->real^N`; `lift d`; `l:real^N`] LIM_BILINEAR) THEN + ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LIM_VMUL = prove + (`!net:(A)net c d v:real^N. + ((lift o c) --> lift d) net ==> ((\x. c(x) % v) --> d % v) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]);; + +let CONTINUOUS_VMUL = prove + (`!net c v. (lift o c) continuous net ==> (\x. c(x) % v) continuous net`, + REWRITE_TAC[continuous; LIM_VMUL; o_THM]);; + +let CONTINUOUS_MUL = prove + (`!net f c. (lift o c) continuous net /\ f continuous net + ==> (\x. c(x) % f(x)) continuous net`, + REWRITE_TAC[continuous; LIM_MUL; o_THM]);; + +let CONTINUOUS_ON_VMUL = prove + (`!s c v. (lift o c) continuous_on s ==> (\x. c(x) % v) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_VMUL]);; + +let CONTINUOUS_ON_MUL = prove + (`!s c f. (lift o c) continuous_on s /\ f continuous_on s + ==> (\x. c(x) % f(x)) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_MUL]);; + +let CONTINUOUS_LIFT_POW = prove + (`!net f:A->real n. + (\x. lift(f x)) continuous net + ==> (\x. lift(f x pow n)) continuous net`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_CONST] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[o_DEF]);; + +let CONTINUOUS_ON_LIFT_POW = prove + (`!f:real^N->real s n. + (\x. lift(f x)) continuous_on s + ==> (\x. lift(f x pow n)) continuous_on s`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF]);; + +let CONTINUOUS_LIFT_PRODUCT = prove + (`!net:(A)net f (t:B->bool). + FINITE t /\ + (!i. i IN t ==> (\x. lift(f x i)) continuous net) + ==> (\x. lift(product t (f x))) continuous net`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN + REWRITE_TAC[CONTINUOUS_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + ASM_SIMP_TAC[o_DEF]);; + +let CONTINUOUS_ON_LIFT_PRODUCT = prove + (`!f:real^N->A->real s t. + FINITE t /\ + + (!i. i IN t ==> (\x. lift(f x i)) continuous_on s) + ==> (\x. lift(product t (f x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_PRODUCT]);; + +(* ------------------------------------------------------------------------- *) +(* And so we have continuity of inverse. *) +(* ------------------------------------------------------------------------- *) + +let LIM_INV = prove + (`!net:(A)net f l. + ((lift o f) --> lift l) net /\ ~(l = &0) + ==> ((lift o inv o f) --> lift(inv l)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_THM; DIST_LIFT] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min (abs(l) / &2) ((l pow 2 * e) / &2)`) THEN + REWRITE_TAC[REAL_LT_MIN] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:A` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH + `abs(x - l) * &2 < abs l ==> ~(x = &0)`)) THEN + ASM_SIMP_TAC[REAL_SUB_INV; REAL_ABS_DIV; REAL_LT_LDIV_EQ; + GSYM REAL_ABS_NZ; REAL_ENTIRE] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - y) * &2 < b * c ==> c * b <= d * &2 ==> abs(y - x) < d`)) THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_POW_2; REAL_MUL_ASSOC; GSYM REAL_ABS_NZ; + REAL_LE_RMUL_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `abs(x - y) * &2 < abs y ==> abs y <= &2 * abs x`]);; + +let CONTINUOUS_INV = prove + (`!net f. (lift o f) continuous net /\ ~(f(netlimit net) = &0) + ==> (lift o inv o f) continuous net`, + REWRITE_TAC[continuous; LIM_INV; o_THM]);; + +let CONTINUOUS_AT_WITHIN_INV = prove + (`!f s a:real^N. + (lift o f) continuous (at a within s) /\ ~(f a = &0) + ==> (lift o inv o f) continuous (at a within s)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `trivial_limit (at (a:real^N) within s)` THENL + [ASM_REWRITE_TAC[continuous; LIM]; + ASM_SIMP_TAC[NETLIMIT_WITHIN; CONTINUOUS_INV]]);; + +let CONTINUOUS_AT_INV = prove + (`!f a. (lift o f) continuous at a /\ ~(f a = &0) + ==> (lift o inv o f) continuous at a`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]);; + +let CONTINUOUS_ON_INV = prove + (`!f s. (lift o f) continuous_on s /\ (!x. x IN s ==> ~(f x = &0)) + ==> (lift o inv o f) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN_INV]);; + +(* ------------------------------------------------------------------------- *) +(* More preservation properties for pasted sets (Cartesian products). *) +(* ------------------------------------------------------------------------- *) + +let LIM_PASTECART = prove + (`!net f:A->real^M g:A->real^N. + (f --> a) net /\ (g --> b) net + ==> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + REWRITE_TAC[dist; PASTECART_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `z <= x + y ==> x < e / &2 /\ y < e / &2 ==> z < e`) THEN + REWRITE_TAC[NORM_PASTECART_LE]);; + +let LIM_PASTECART_EQ = prove + (`!net f:A->real^M g:A->real^N. + ((\x. pastecart (f x) (g x)) --> pastecart a b) net <=> + (f --> a) net /\ (g --> b) net`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LIM_PASTECART] THEN + REPEAT STRIP_TAC THENL + [FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN + REWRITE_TAC[LINEAR_FSTCART; FSTCART_PASTECART; ETA_AX]; + FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN + REWRITE_TAC[LINEAR_SNDCART; SNDCART_PASTECART; ETA_AX]]);; + +let CONTINUOUS_PASTECART = prove + (`!net f:A->real^M g:A->real^N. + f continuous net /\ g continuous net + ==> (\x. pastecart (f x) (g x)) continuous net`, + REWRITE_TAC[continuous; LIM_PASTECART]);; + +let CONTINUOUS_ON_PASTECART = prove + (`!f:real^M->real^N g:real^M->real^P s. + f continuous_on s /\ g continuous_on s + ==> (\x. pastecart (f x) (g x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON; LIM_PASTECART]);; + +let CONNECTED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + connected s /\ connected t + ==> connected (s PCROSS t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[PCROSS; CONNECTED_IFF_CONNECTED_COMPONENT] THEN + DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`]) + (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; connected_component] THEN + X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `c1:real^M->bool` THEN STRIP_TAC THEN + EXISTS_TAC + `IMAGE (\x:real^M. pastecart x y1) c1 UNION + IMAGE (\y:real^N. pastecart x2 y) c2` THEN + REWRITE_TAC[IN_UNION] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_UNION THEN + ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_PASTECART; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN + EXISTS_TAC `x2:real^M` THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_UNION; FORALL_AND_THM; FORALL_IN_IMAGE; + TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let CONNECTED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + connected (s PCROSS t) <=> + s = {} \/ t = {} \/ connected s /\ connected t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[PCROSS_EMPTY; CONNECTED_EMPTY] THEN + EQ_TAC THEN SIMP_TAC[CONNECTED_PCROSS] THEN + REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THENL + [SUBGOAL_THEN `connected (IMAGE fstcart + {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` + MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]; + SUBGOAL_THEN `connected (IMAGE sndcart + {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` + MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]] THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; IN_ELIM_PASTECART_THM; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CLOSURE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + closure (s PCROSS t) = (closure s) PCROSS (closure t)`, + REWRITE_TAC[EXTENSION; PCROSS; FORALL_PASTECART] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; EXISTS_PASTECART; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[dist; PASTECART_SUB] THEN EQ_TAC THENL + [MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; DISCH_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN + ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH + `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; + +let LIMPT_PCROSS = prove + (`!s:real^M->bool t:real^N->bool x y. + x limit_point_of s /\ y limit_point_of t + ==> (pastecart x y) limit_point_of (s PCROSS t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[PCROSS; LIMPT_APPROACHABLE; EXISTS_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ; dist; PASTECART_SUB] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN + ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH + `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; + +let CLOSED_IN_PCROSS = prove + (`!s:real^M->bool s' t:real^N->bool t'. + closed_in (subtopology euclidean s) s' /\ + closed_in (subtopology euclidean t) t' + ==> closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN + ASM_SIMP_TAC[CLOSED_PCROSS; EXTENSION; FORALL_PASTECART] THEN + REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; + +let CLOSED_IN_PCROSS_EQ = prove + (`!s s':real^M->bool t t':real^N->bool. + closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> + s' = {} \/ t' = {} \/ + closed_in (subtopology euclidean s) s' /\ + closed_in (subtopology euclidean t) t'`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s':real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN + ASM_CASES_TAC `t':real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[CLOSED_IN_PCROSS] THEN + ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_PCROSS; INTER_PCROSS; + PCROSS_EQ; PCROSS_EQ_EMPTY]);; + +let FRONTIER_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + frontier(s PCROSS t) = frontier s PCROSS closure t UNION + closure s PCROSS frontier t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[frontier; CLOSURE_PCROSS; INTERIOR_PCROSS; PCROSS_DIFF] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; IN_UNION; + PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence some useful properties follow quite easily. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_SCALING = prove + (`!s:real^N->bool c. connected s ==> connected (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let CONNECTED_NEGATIONS = prove + (`!s:real^N->bool. connected s ==> connected (IMAGE (--) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let CONNECTED_SUMS = prove + (`!s t:real^N->bool. + connected s /\ connected t ==> connected {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_PCROSS) THEN + DISCH_THEN(MP_TAC o ISPEC + `\z. (fstcart z + sndcart z:real^N)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN + SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; + LINEAR_SNDCART; PCROSS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN + REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MESON_TAC[]);; + +let COMPACT_SCALING = prove + (`!s:real^N->bool c. compact s ==> compact (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let COMPACT_NEGATIONS = prove + (`!s:real^N->bool. compact s ==> compact (IMAGE (--) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let COMPACT_SUMS = prove + (`!s:real^N->bool t. + compact s /\ compact t ==> compact {x + y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x + y | x IN s /\ y IN t} = + IMAGE (\z. fstcart z + sndcart z :real^N) (s PCROSS t)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; PCROSS] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_FST_SND]; + ALL_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[COMPACT_PCROSS] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; + SNDCART_CMUL] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let COMPACT_DIFFERENCES = prove + (`!s:real^N->bool t. + compact s /\ compact t ==> compact {x - y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = + {x + y | x IN s /\ y IN (IMAGE (--) t)}` + (fun th -> ASM_SIMP_TAC[th; COMPACT_SUMS; COMPACT_NEGATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN + SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN + MESON_TAC[VECTOR_NEG_NEG]);; + +let COMPACT_AFFINITY = prove + (`!s a:real^N c. + compact s ==> compact (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; COMPACT_TRANSLATION; COMPACT_SCALING]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get the following. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_SUP_MAXDISTANCE = prove + (`!s:real^N->bool. + compact s /\ ~(s = {}) + ==> ?x y. x IN s /\ y IN s /\ + !u v. u IN s /\ v IN s ==> norm(u - v) <= norm(x - y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN s}`; `vec 0:real^N`] + DISTANCE_ATTAINS_SUP) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[COMPACT_DIFFERENCES] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; + NORM_NEG] THEN + MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* We can state this in terms of diameter of a set. *) +(* ------------------------------------------------------------------------- *) + +let diameter = new_definition + `diameter s = + if s = {} then &0 + else sup {norm(x - y) | x IN s /\ y IN s}`;; + +let DIAMETER_BOUNDED = prove + (`!s. bounded s + ==> (!x:real^N y. x IN s /\ y IN s ==> norm(x - y) <= diameter s) /\ + (!d. &0 <= d /\ d < diameter s + ==> ?x y. x IN s /\ y IN s /\ norm(x - y) > d)`, + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[diameter; NOT_IN_EMPTY; REAL_LET_ANTISYM] THEN + MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN + ABBREV_TAC `b = sup {norm(x - y:real^N) | x IN s /\ y IN s}` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_IN_EMPTY; real_gt] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC]; + MESON_TAC[REAL_NOT_LE]] THEN + SIMP_TAC[VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + MESON_TAC[REAL_ARITH `x <= y + z /\ y <= b /\ z<= b ==> x <= b + b`; + NORM_TRIANGLE; NORM_NEG]);; + +let DIAMETER_BOUNDED_BOUND = prove + (`!s x y. bounded s /\ x IN s /\ y IN s ==> norm(x - y) <= diameter s`, + MESON_TAC[DIAMETER_BOUNDED]);; + +let DIAMETER_COMPACT_ATTAINED = prove + (`!s:real^N->bool. + compact s /\ ~(s = {}) + ==> ?x y. x IN s /\ y IN s /\ (norm(x - y) = diameter s)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_SUP_MAXDISTANCE) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `s:real^N->bool` DIAMETER_BOUNDED) THEN + RULE_ASSUM_TAC(REWRITE_RULE[COMPACT_EQ_BOUNDED_CLOSED]) THEN + ASM_REWRITE_TAC[real_gt] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_NOT_LT]);; + +let DIAMETER_TRANSLATION = prove + (`!a s. diameter (IMAGE (\x. a + x) s) = diameter s`, + REWRITE_TAC[diameter] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [DIAMETER_TRANSLATION];; + +let DIAMETER_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x. norm(f x) = norm x) + ==> diameter(IMAGE f s) = diameter s`, + REWRITE_TAC[diameter] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[diameter; IMAGE_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN + ASM_MESON_TAC[LINEAR_SUB]);; + +add_linear_invariants [DIAMETER_LINEAR_IMAGE];; + +let DIAMETER_EMPTY = prove + (`diameter {} = &0`, + REWRITE_TAC[diameter]);; + +let DIAMETER_SING = prove + (`!a. diameter {a} = &0`, + REWRITE_TAC[diameter; NOT_INSERT_EMPTY; IN_SING] THEN + REWRITE_TAC[SET_RULE `{f x y | x = a /\ y = a} = {f a a }`] THEN + REWRITE_TAC[SUP_SING; VECTOR_SUB_REFL; NORM_0]);; + +let DIAMETER_POS_LE = prove + (`!s:real^N->bool. bounded s ==> &0 <= diameter s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + EXISTS_TAC `&2 * B` THEN + ASM_SIMP_TAC[NORM_ARITH + `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a:real^N`] o CONJUNCT1) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]]);; + +let DIAMETER_SUBSET = prove + (`!s t:real^N->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[DIAMETER_EMPTY; DIAMETER_POS_LE] THEN + ASM_REWRITE_TAC[diameter] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + EXISTS_TAC `&2 * B` THEN + ASM_SIMP_TAC[NORM_ARITH + `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]);; + +let DIAMETER_CLOSURE = prove + (`!s:real^N->bool. bounded s ==> diameter(closure s) = diameter s`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_CLOSURE; CLOSURE_SUBSET] THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_BOUNDED) THEN + ABBREV_TAC `d = diameter(closure s) - diameter(s:real^N->bool)` THEN + ASM_SIMP_TAC[BOUNDED_CLOSURE] THEN DISCH_THEN(MP_TAC o + SPEC `diameter(closure(s:real^N->bool)) - d / &2` o CONJUNCT2) THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; NOT_EXISTS_THM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; CONJ_ASSOC; AND_FORALL_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `d / &4`) ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < d / &4 <=> &0 < d`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) + (X_CHOOSE_THEN `v:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN + DISCH_THEN(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o CONJUNCT1) THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let DIAMETER_SUBSET_CBALL_NONEMPTY = prove + (`!s:real^N->bool. + bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN + ASM_MESON_TAC[DIAMETER_BOUNDED]);; + +let DIAMETER_SUBSET_CBALL = prove + (`!s:real^N->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY; EMPTY_SUBSET]);; + +let DIAMETER_EQ_0 = prove + (`!s:real^N->bool. + bounded s ==> (diameter s = &0 <=> s = {} \/ ?a. s = {a})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[DIAMETER_EMPTY; DIAMETER_SING] THEN + REWRITE_TAC[SET_RULE + `s = {} \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] + DIAMETER_BOUNDED_BOUND) THEN + ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let DIAMETER_LE = prove + (`!s:real^N->bool. + (~(s = {}) \/ &0 <= d) /\ + (!x y. x IN s /\ y IN s ==> norm(x - y) <= d) ==> diameter s <= d`, + GEN_TAC THEN REWRITE_TAC[diameter] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN + CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_GSPEC]]);; + +let DIAMETER_CBALL = prove + (`!a:real^N r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_MESON_TAC[CBALL_EQ_EMPTY; DIAMETER_EMPTY]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIAMETER_LE THEN + ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LE_MUL; REAL_POS; REAL_NOT_LT] THEN + REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm((a + r % basis 1) - (a - r % basis 1):real^N)` THEN + CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `(a + r % b) - (a - r % b:real^N) = + (&2 * r) % b`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN + REWRITE_TAC[BOUNDED_CBALL; IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH + `dist(a:real^N,a + b) = norm b /\ dist(a,a - b) = norm b`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC]]);; + +let DIAMETER_BALL = prove + (`!a:real^N r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; DIAMETER_EMPTY]; ALL_TAC] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; DIAMETER_EMPTY; REAL_MUL_RZERO] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `diameter(cball(a:real^N,r))` THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CLOSURE_BALL; DIAMETER_CLOSURE; BOUNDED_BALL]; + ASM_SIMP_TAC[DIAMETER_CBALL]]);; + +let DIAMETER_SUMS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t + ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; + DIAMETER_EMPTY; REAL_ADD_LID; DIAMETER_POS_LE] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; + DIAMETER_EMPTY; REAL_ADD_RID; DIAMETER_POS_LE] THEN + MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH + `norm(x - x') <= s /\ norm(y - y') <= t + ==> norm((x + y) - (x' + y'):real^N) <= s + t`) THEN + ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND]);; + +let LEBESGUE_COVERING_LEMMA = prove + (`!s:real^N->bool c. + compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open b) + ==> ?d. &0 < d /\ + !t. t SUBSET s /\ diameter t <= d + ==> ?b. b IN c /\ t SUBSET b`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN + DISCH_THEN(MP_TAC o SPEC `c:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `t:real^N->bool` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `cball(x:real^N,diameter(t:real^N->bool))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN + MAP_EVERY UNDISCH_TAC [`&0 < e`; `diameter(t:real^N->bool) <= e / &2`] THEN + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Related results with closure as the conclusion. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_SCALING = prove + (`!s:real^N->bool c. closed s ==> closed (IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s :real^N->bool = {}` THEN + ASM_REWRITE_TAC[CLOSED_EMPTY; IMAGE_CLAUSES] THEN + ASM_CASES_TAC `c = &0` THENL + [SUBGOAL_THEN `IMAGE (\x:real^N. c % x) s = {(vec 0)}` + (fun th -> REWRITE_TAC[th; CLOSED_SING]) THEN + ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING; VECTOR_MUL_LZERO] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + ALL_TAC] THEN + REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_IMAGE; SKOLEM_THM] THEN + STRIP_TAC THEN X_GEN_TAC `x:num->real^N` THEN X_GEN_TAC `l:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` MP_TAC) THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + EXISTS_TAC `inv(c) % l :real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. inv(c) % x n:real^N` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; + MATCH_MP_TAC LIM_CMUL THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[SYM(SPEC_ALL th)]) THEN + ASM_REWRITE_TAC[ETA_AX]]);; + +let CLOSED_NEGATIONS = prove + (`!s:real^N->bool. closed s ==> closed (IMAGE (--) s)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x:real^N. --(&1) % x) s` + SUBST1_TAC THEN SIMP_TAC[CLOSED_SCALING] THEN + REWRITE_TAC[VECTOR_ARITH `--(&1) % x = --x`] THEN REWRITE_TAC[ETA_AX]);; + +let COMPACT_CLOSED_SUMS = prove + (`!s:real^N->bool t. + compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[compact; IN_ELIM_THM; CLOSED_SEQUENTIAL_LIMITS] THEN + STRIP_TAC THEN X_GEN_TAC `f:num->real^N` THEN X_GEN_TAC `l:real^N` THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check(is_imp o concl) o SPEC `a:num->real^N`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `la:real^N` (X_CHOOSE_THEN `sub:num->num` + STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`la:real^N`; `l - la:real^N`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + (b - a) = b:real^N`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `\n. (f o (sub:num->num)) n - (a o sub) n:real^N` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[VECTOR_ADD_SUB; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; ETA_AX]);; + +let CLOSED_COMPACT_SUMS = prove + (`!s:real^N->bool t. + closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `{x + y:real^N | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}` + SUBST1_TAC THEN SIMP_TAC[COMPACT_CLOSED_SUMS] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);; + +let CLOSURE_SUMS = prove + (`!s t:real^N->bool. + bounded s \/ bounded t + ==> closure {x + y | x IN s /\ y IN t} = + {x + y | x IN closure s /\ y IN closure t}`, + REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN + MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN + SIMP_TAC[] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; CLOSURE_SEQUENTIAL] THEN + X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; IN_DELETE; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN + ONCE_REWRITE_TAC[MESON[] `(?f x y. P f x y) <=> (?x y f. P f x y)`] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[ETA_AX; UNWIND_THM2] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPEC `closure s:real^N->bool` compact) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN + DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `r:num->num`] THEN STRIP_TAC THEN + EXISTS_TAC `z - u:real^N` THEN + EXISTS_TAC `(a:num->real^N) o (r:num->num)` THEN EXISTS_TAC `u:real^N` THEN + ASM_REWRITE_TAC[o_THM] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + EXISTS_TAC `(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n) + :num->real^N` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(a + b) - a:real^N = b`]; + MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`x:real^N`; `y:real^N`; `a:num->real^N`; `b:num->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `(\n. a n + b n):num->real^N` THEN + ASM_SIMP_TAC[LIM_ADD] THEN ASM_MESON_TAC[]]);; + +let COMPACT_CLOSED_DIFFERENCES = prove + (`!s:real^N->bool t. + compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = + {x + y | x IN s /\ y IN (IMAGE (--) t)}` + (fun th -> ASM_SIMP_TAC[th; COMPACT_CLOSED_SUMS; CLOSED_NEGATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN + SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN + MESON_TAC[VECTOR_NEG_NEG]);; + +let CLOSED_COMPACT_DIFFERENCES = prove + (`!s:real^N->bool t. + closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = + {x + y | x IN s /\ y IN (IMAGE (--) t)}` + (fun th -> ASM_SIMP_TAC[th; CLOSED_COMPACT_SUMS; COMPACT_NEGATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN + SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN + MESON_TAC[VECTOR_NEG_NEG]);; + +let CLOSED_TRANSLATION_EQ = prove + (`!a s. closed (IMAGE (\x:real^N. a + x) s) <=> closed s`, + REWRITE_TAC[closed] THEN GEOM_TRANSLATE_TAC[]);; + +let CLOSED_TRANSLATION = prove + (`!s a:real^N. closed s ==> closed (IMAGE (\x. a + x) s)`, + REWRITE_TAC[CLOSED_TRANSLATION_EQ]);; + +add_translation_invariants [CLOSED_TRANSLATION_EQ];; + +let COMPLETE_TRANSLATION_EQ = prove + (`!a s. complete(IMAGE (\x:real^N. a + x) s) <=> complete s`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_TRANSLATION_EQ]);; + +add_translation_invariants [COMPLETE_TRANSLATION_EQ];; + +let TRANSLATION_UNIV = prove + (`!a. IMAGE (\x. a + x) (:real^N) = (:real^N)`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEOM_TRANSLATE_TAC[]);; + +let TRANSLATION_DIFF = prove + (`!s t:real^N->bool. + IMAGE (\x. a + x) (s DIFF t) = + (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)`, + REWRITE_TAC[EXTENSION; IN_DIFF; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = a + y <=> y = x - a`] THEN + REWRITE_TAC[UNWIND_THM2]);; + +let CLOSURE_TRANSLATION = prove + (`!a s. closure(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (closure s)`, + REWRITE_TAC[CLOSURE_INTERIOR] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [CLOSURE_TRANSLATION];; + +let FRONTIER_TRANSLATION = prove + (`!a s. frontier(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (frontier s)`, + REWRITE_TAC[frontier] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [FRONTIER_TRANSLATION];; + +(* ------------------------------------------------------------------------- *) +(* Separation between points and sets. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATE_POINT_CLOSED = prove + (`!s a:real^N. + closed s /\ ~(a IN s) + ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01]; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] DISTANCE_ATTAINS_INF) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN + STRIP_TAC THEN EXISTS_TAC `dist(a:real^N,b)` THEN + ASM_MESON_TAC[DIST_POS_LT]);; + +let SEPARATE_COMPACT_CLOSED = prove + (`!s t:real^N->bool. + compact s /\ closed t /\ s INTER t = {} + ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] + SEPARATE_POINT_CLOSED) THEN + ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0 = x - y <=> x = y`] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MESON_TAC[NORM_ARITH `dist(vec 0,x - y) = dist(x,y)`]);; + +let SEPARATE_CLOSED_COMPACT = prove + (`!s t:real^N->bool. + closed s /\ compact t /\ s INTER t = {} + ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, + ONCE_REWRITE_TAC[DIST_SYM; INTER_COMM] THEN + MESON_TAC[SEPARATE_COMPACT_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Representing sets as the union of a chain of compact sets. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_UNION_COMPACT_SUBSETS = prove + (`!s. closed s + ==> ?f:num->real^N->bool. + (!n. compact(f n)) /\ + (!n. (f n) SUBSET s) /\ + (!n. (f n) SUBSET f(n + 1)) /\ + UNIONS {f n | n IN (:num)} = s /\ + (!k. compact k /\ k SUBSET s + ==> ?N. !n. n >= N ==> k SUBSET (f n))`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\n. s INTER cball(vec 0:real^N,&n)` THEN + ASM_SIMP_TAC[INTER_SUBSET; COMPACT_CBALL; CLOSED_INTER_COMPACT] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL_0] THEN + MESON_TAC[REAL_ARCH_SIMPLE]; + X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN + (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN + + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]);; + +let OPEN_UNION_COMPACT_SUBSETS = prove + (`!s. open s + ==> ?f:num->real^N->bool. + (!n. compact(f n)) /\ + (!n. (f n) SUBSET s) /\ + (!n. (f n) SUBSET interior(f(n + 1))) /\ + UNIONS {f n | n IN (:num)} = s /\ + (!k. compact k /\ k SUBSET s + ==> ?N. !n. n >= N ==> k SUBSET (f n))`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [DISCH_TAC THEN EXISTS_TAC `(\n. {}):num->real^N->bool` THEN + ASM_SIMP_TAC[EMPTY_SUBSET; SUBSET_EMPTY; COMPACT_EMPTY] THEN + REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC] THEN + MATCH_MP_TAC(MESON[] + `(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\ + (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f)) + ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f`) THEN + CONJ_TAC THENL + [X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `{interior(f n):real^N->bool | n IN (:num)}`) THEN + REWRITE_TAC[FORALL_IN_GSPEC; OPEN_INTERIOR] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[]; + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[SUBSET_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o + MATCH_MP UPPER_BOUND_FINITE_SET) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `(f:num->real^N->bool) m` THEN + REWRITE_TAC[INTERIOR_SUBSET] THEN + SUBGOAL_THEN `!m n. m <= n ==> (f:num->real^N->bool) m SUBSET f n` + (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_MESON_TAC[SUBSET; ADD1; INTERIOR_SUBSET]]; + EXISTS_TAC + `\n. cball(a,&n) DIFF + {x + e | x IN (:real^N) DIFF s /\ e IN ball(vec 0,inv(&n + &1))}` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC COMPACT_DIFF THEN + SIMP_TAC[COMPACT_CBALL; OPEN_SUMS; OPEN_BALL]; + GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s`) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN + REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')`) THEN + CONJ_TAC THENL + [REWRITE_TAC[INTERIOR_CBALL; SUBSET; IN_BALL; IN_CBALL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{x + e | x IN (:real^N) DIFF s /\ + e IN cball(vec 0,inv(&n + &2))}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL; + GSYM OPEN_CLOSED] THEN + MATCH_MP_TAC(SET_RULE + `t SUBSET t' + ==> {f x y | x IN s /\ y IN t} SUBSET + {f x y | x IN s /\ y IN t'}`) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(SET_RULE + `t SUBSET t' + ==> {f x y | x IN s /\ y IN t} SUBSET + {f x y | x IN s /\ y IN t'}`) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN + GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH + `a < b ==> x <= a ==> x < b`) THEN + MATCH_MP_TAC REAL_LT_INV2 THEN REAL_ARITH_TAC]]; + DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_BALL_0] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = y + e <=> e = x - y`] THEN + REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`; UNWIND_THM2] THEN + REWRITE_TAC[MESON[] `~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `norm(x - a:real^N)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + UNDISCH_TAC `norm(x - a:real^N) <= &N2` THEN + REWRITE_TAC[dist; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN `inv(&(N1 + N2) + &1) <= inv(&N1)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Closed-graph characterization of continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_CLOSED_GRAPH_GEN = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t + ==> closed_in (subtopology euclidean (s PCROSS t)) + {pastecart x (f x) | x IN s}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{pastecart (x:real^M) (f x:real^N) | x IN s} = + {z | z IN s PCROSS t /\ f(fstcart z) - sndcart z IN {vec 0}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_SING; + PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + PASTECART_INJ; VECTOR_SUB_EQ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + SIMP_TAC[GSYM o_DEF; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]]);; + +let CONTINUOUS_CLOSED_GRAPH_EQ = prove + (`!f:real^M->real^N s t. + compact t /\ IMAGE f s SUBSET t + ==> (f continuous_on s <=> + closed_in (subtopology euclidean (s PCROSS t)) + {pastecart x (f x) | x IN s})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_GRAPH_GEN] THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP CONTINUOUS_ON_CLOSED_GEN th]) THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN c} = + IMAGE fstcart ({pastecart x (f x) | x IN s} INTER + (s PCROSS c))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART; + FSTCART_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM; + PASTECART_IN_PCROSS; PASTECART_INJ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_MAP_FSTCART THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL]]);; + +let CONTINUOUS_CLOSED_GRAPH = prove + (`!f:real^M->real^N s. + closed s /\ f continuous_on s ==> closed {pastecart x (f x) | x IN s}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `(s:real^M->bool) PCROSS (:real^N)` THEN + ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_GRAPH_GEN THEN + ASM_REWRITE_TAC[SUBSET_UNIV]);; + +let CONTINUOUS_FROM_CLOSED_GRAPH = prove + (`!f:real^M->real^N s t. + compact t /\ IMAGE f s SUBSET t /\ + closed {pastecart x (f x) | x IN s} + ==> f continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONTINUOUS_CLOSED_GRAPH_EQ) THEN + MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A cute way of denoting open and closed intervals using overloading. *) +(* ------------------------------------------------------------------------- *) + +let open_interval = new_definition + `open_interval(a:real^N,b:real^N) = + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i < x$i /\ x$i < b$i}`;; + +let closed_interval = new_definition + `closed_interval(l:(real^N#real^N)list) = + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> FST(HD l)$i <= x$i /\ x$i <= SND(HD l)$i}`;; + +make_overloadable "interval" `:A`;; + +overload_interface("interval",`open_interval`);; +overload_interface("interval",`closed_interval`);; + +let interval = prove + (`(interval (a,b) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i < x$i /\ x$i < b$i}) /\ + (interval [a,b] = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i <= x$i /\ x$i <= b$i})`, + REWRITE_TAC[open_interval; closed_interval; HD; FST; SND]);; + +let IN_INTERVAL = prove + (`(!x:real^N. + x IN interval (a,b) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i < x$i /\ x$i < b$i) /\ + (!x:real^N. + x IN interval [a,b] <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i <= x$i /\ x$i <= b$i)`, + REWRITE_TAC[interval; IN_ELIM_THM]);; + +let IN_INTERVAL_REFLECT = prove + (`(!a b x. (--x) IN interval[--b,--a] <=> x IN interval[a,b]) /\ + (!a b x. (--x) IN interval(--b,--a) <=> x IN interval(a,b))`, + SIMP_TAC[IN_INTERVAL; REAL_LT_NEG2; REAL_LE_NEG2; VECTOR_NEG_COMPONENT] THEN + MESON_TAC[]);; + +let REFLECT_INTERVAL = prove + (`(!a b:real^N. IMAGE (--) (interval[a,b]) = interval[--b,--a]) /\ + (!a b:real^N. IMAGE (--) (interval(a,b)) = interval(--b,--a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_INTERVAL_REFLECT] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let INTERVAL_EQ_EMPTY = prove + (`((interval [a:real^N,b] = {}) <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i < a$i) /\ + ((interval (a:real^N,b) = {}) <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i)`, + REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN + CONJ_TAC THEN EQ_TAC THENL + [MESON_TAC[REAL_LE_REFL; REAL_NOT_LE]; + MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE]; + ALL_TAC; + MESON_TAC[REAL_LT_TRANS; REAL_NOT_LT]] THEN + SUBGOAL_THEN `!a b. ?c. a < b ==> a < c /\ c < b` + (MP_TAC o REWRITE_RULE[SKOLEM_THM]) THENL + [MESON_TAC[REAL_LT_BETWEEN]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `mid:real->real->real`) THEN + DISCH_THEN(MP_TAC o SPEC + `(lambda i. mid ((a:real^N)$i) ((b:real^N)$i)):real^N`) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_NOT_LT]);; + +let INTERVAL_NE_EMPTY = prove + (`(~(interval [a:real^N,b] = {}) <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) /\ + (~(interval (a:real^N,b) = {}) <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i)`, + REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN MESON_TAC[REAL_NOT_LE]);; + +let SUBSET_INTERVAL_IMP = prove + (`((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) + ==> interval[c,d] SUBSET interval[a:real^N,b]) /\ + ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i) + ==> interval[c,d] SUBSET interval(a:real^N,b)) /\ + ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) + ==> interval(c,d) SUBSET interval[a:real^N,b]) /\ + ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) + ==> interval(c,d) SUBSET interval(a:real^N,b))`, + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN REPEAT CONJ_TAC THEN + DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let INTERVAL_SING = prove + (`interval[a,a] = {a} /\ interval(a,a) = {}`, + REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_INTERVAL] THEN + REWRITE_TAC[REAL_LE_ANTISYM; REAL_LT_ANTISYM; CART_EQ; EQ_SYM_EQ] THEN + MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; + +let SUBSET_INTERVAL = prove + (`(interval[c,d] SUBSET interval[a:real^N,b] <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ + (interval[c,d] SUBSET interval(a:real^N,b) <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i)) /\ + (interval(c,d) SUBSET interval[a:real^N,b] <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ + (interval(c,d) SUBSET interval(a:real^N,b) <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i))`, + let lemma = prove + (`(!x:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> Q i (x$i)) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> R i (x$i))) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> ?y. Q i y) + ==> !i y. 1 <= i /\ i <= dimindex(:N) /\ Q i y ==> R i y`, + DISCH_TAC THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real` STRIP_ASSUME_TAC) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPEC `(lambda j. if j = i then y else f j):real^N`) THEN + SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[]) in + REPEAT STRIP_TAC THEN + (MATCH_MP_TAC(TAUT + `(~q ==> p) /\ (q ==> (p <=> r)) ==> (p <=> q ==> r)`) THEN + CONJ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET t`) THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_NOT_LT]; + ALL_TAC] THEN + DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_IMP] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_BETWEEN; REAL_LE_BETWEEN]; ALL_TAC] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC) + THENL + [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; + ALL_TAC; ALL_TAC] THEN + (REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC + `((c:real^N)$i + min ((a:real^N)$i) ((d:real^N)$i)) / &2`) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC + `(max ((b:real^N)$i) ((c:real^N)$i) + (d:real^N)$i) / &2`) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]));; + +let DISJOINT_INTERVAL = prove + (`!a b c d:real^N. + (interval[a,b] INTER interval[c,d] = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i < a$i \/ d$i < c$i \/ b$i < c$i \/ d$i < a$i)) /\ + (interval[a,b] INTER interval(c,d) = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i < a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ + (interval(a,b) INTER interval[c,d] = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i <= a$i \/ d$i < c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ + (interval(a,b) INTER interval(c,d) = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i <= a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i))`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN + REWRITE_TAC[AND_FORALL_THM; NOT_FORALL_THM] THEN + REWRITE_TAC[TAUT `~((p ==> q) /\ (p ==> r)) <=> p /\ (~q \/ ~r)`] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + (EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC + `(lambda i. (max ((a:real^N)$i) ((c:real^N)$i) + + min ((b:real^N)$i) ((d:real^N)$i)) / &2):real^N`) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; + DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN + REAL_ARITH_TAC]));; + +let ENDS_IN_INTERVAL = prove + (`(!a b. a IN interval[a,b] <=> ~(interval[a,b] = {})) /\ + (!a b. b IN interval[a,b] <=> ~(interval[a,b] = {})) /\ + (!a b. ~(a IN interval(a,b))) /\ + (!a b. ~(b IN interval(a,b)))`, + REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[REAL_LE_REFL; REAL_LT_REFL] THEN + MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; + +let ENDS_IN_UNIT_INTERVAL = prove + (`vec 0 IN interval[vec 0,vec 1] /\ + vec 1 IN interval[vec 0,vec 1] /\ + ~(vec 0 IN interval(vec 0,vec 1)) /\ + ~(vec 1 IN interval(vec 0,vec 1))`, + REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY; VEC_COMPONENT] THEN + REWRITE_TAC[REAL_POS]);; + +let INTER_INTERVAL = prove + (`interval[a,b] INTER interval[c,d] = + interval[(lambda i. max (a$i) (c$i)),(lambda i. min (b$i) (d$i))]`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL] THEN + SIMP_TAC[LAMBDA_BETA; REAL_MAX_LE; REAL_LE_MIN] THEN MESON_TAC[]);; + +let INTERVAL_OPEN_SUBSET_CLOSED = prove + (`!a b. interval(a,b) SUBSET interval[a,b]`, + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN MESON_TAC[REAL_LT_IMP_LE]);; + +let OPEN_INTERVAL_LEMMA = prove + (`!a b x. a < x /\ x < b + ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `min (x - a) (b - x)` THEN REWRITE_TAC[REAL_LT_MIN] THEN + ASM_REAL_ARITH_TAC);; + +let OPEN_INTERVAL = prove + (`!a:real^N b. open(interval (a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def; interval; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?d. &0 < d /\ + !x'. abs(x' - (x:real^N)$i) < d + ==> (a:real^N)$i < x' /\ x' < (b:real^N)$i` + MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTERVAL_LEMMA]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inf (IMAGE d (1..dimindex(:N)))` THEN + SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NOT_INSERT_EMPTY; NUMSEG_EMPTY; + ARITH_RULE `n < 1 <=> (n = 0)`; DIMINDEX_NONZERO] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; dist] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; VECTOR_SUB_COMPONENT]);; + +let CLOSED_INTERVAL = prove + (`!a:real^N b. closed(interval [a,b])`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_INTERVAL] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`); + FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`)] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dist; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`; + REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; + +let INTERIOR_CLOSED_INTERVAL = prove + (`!a:real^N b. interior(interval [a,b]) = interval (a,b)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC INTERIOR_MAXIMAL THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL]] THEN + REWRITE_TAC[interior; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LT_LE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL + [(let t = `x - (e / &2) % basis i :real^N` in + DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t)); + (let t = `x + (e / &2) % basis i :real^N` in + DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t))] THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_ARITH `x - y - x = --y:real^N`] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; NORM_NEG; REAL_MUL_RID; + REAL_ARITH `&0 < e ==> abs(e / &2) < e`] THEN + MATCH_MP_TAC(TAUT `~b ==> (a ==> b) ==> ~a`) THEN + REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `i:num` THEN + ASM_SIMP_TAC[DE_MORGAN_THM; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THENL + [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `a <= a - b <=> ~(&0 < b)`]; + DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `a + b <= a <=> ~(&0 < b)`]] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; basis; LAMBDA_BETA; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[REAL_HALF]);; + +let INTERIOR_INTERVAL = prove + (`(!a b. interior(interval[a,b]) = interval(a,b)) /\ + (!a b. interior(interval(a,b)) = interval(a,b))`, + SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);; + +let BOUNDED_CLOSED_INTERVAL = prove + (`!a b:real^N. bounded (interval [a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; interval] THEN + EXISTS_TAC `sum(1..dimindex(:N)) + (\i. abs((a:real^N)$i) + abs((b:real^N)$i))` THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ARITH + `a <= x /\ x <= b ==> abs(x) <= abs(a) + abs(b)`]);; + +let BOUNDED_INTERVAL = prove + (`(!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))`, + MESON_TAC[BOUNDED_CLOSED_INTERVAL; BOUNDED_SUBSET; + INTERVAL_OPEN_SUBSET_CLOSED]);; + +let NOT_INTERVAL_UNIV = prove + (`(!a b. ~(interval[a,b] = UNIV)) /\ + (!a b. ~(interval(a,b) = UNIV))`, + MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; + +let COMPACT_INTERVAL = prove + (`!a b. compact (interval [a,b])`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL; CLOSED_INTERVAL]);; + +let OPEN_INTERVAL_MIDPOINT = prove + (`!a b:real^N. + ~(interval(a,b) = {}) ==> (inv(&2) % (a + b)) IN interval(a,b)`, + REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let OPEN_CLOSED_INTERVAL_CONVEX = prove + (`!a b x y:real^N e. + x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1 + ==> (e % x + (&1 - e) % y) IN interval(a,b)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN + STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBST1_TAC(REAL_ARITH `(a:real^N)$i = e * a$i + (&1 - e) * a$i`) THEN + SUBST1_TAC(REAL_ARITH `(b:real^N)$i = e * b$i + (&1 - e) * b$i`) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL; REAL_SUB_LE]);; + +let CLOSURE_OPEN_INTERVAL = prove + (`!a b:real^N. + ~(interval(a,b) = {}) ==> closure(interval(a,b)) = interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CLOSED_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; closure; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM; LIMPT_SEQUENTIAL] THEN + ABBREV_TAC `(c:real^N) = inv(&2) % (a + b)` THEN + EXISTS_TAC `\n. (x:real^N) + inv(&n + &1) % (c - x)` THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DELETE] THEN + REWRITE_TAC[VECTOR_ARITH `x + a = x <=> a = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0] THEN + REWRITE_TAC[VECTOR_SUB_EQ; REAL_ARITH `~(&n + &1 = &0)`] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN + REWRITE_TAC[VECTOR_ARITH `x + a % (y - x) = a % y + (&1 - a) % x`] THEN + MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN + CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = x + &0 % (c - x)`] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; DIST_LIFT; REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `N:num <= n` THEN + UNDISCH_TAC `~(N = 0)` THEN + REWRITE_TAC[GSYM LT_NZ; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT] THEN + REAL_ARITH_TAC);; + +let CLOSURE_INTERVAL = prove + (`(!a b. closure(interval[a,b]) = interval[a,b]) /\ + (!a b. closure(interval(a,b)) = + if interval(a,b) = {} then {} else interval[a,b])`, + SIMP_TAC[CLOSURE_CLOSED; CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; CLOSURE_EMPTY]);; + +let BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC = prove + (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval(--a,a)`, + REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `B:real`] THEN STRIP_TAC THEN + EXISTS_TAC `(lambda i. B + &1):real^N` THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_BOUNDS_LT; VECTOR_NEG_COMPONENT] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; + REAL_ARITH `x <= y ==> a <= x ==> a < y + &1`]);; + +let BOUNDED_SUBSET_OPEN_INTERVAL = prove + (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval(a,b)`, + MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]);; + +let BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC = prove + (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval[--a,a]`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[IN_BALL; IN_INTERVAL; SUBSET; REAL_LT_IMP_LE]);; + +let BOUNDED_SUBSET_CLOSED_INTERVAL = prove + (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval[a,b]`, + MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]);; + +let FRONTIER_CLOSED_INTERVAL = prove + (`!a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)`, + SIMP_TAC[frontier; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED; + CLOSED_INTERVAL]);; + +let FRONTIER_OPEN_INTERVAL = prove + (`!a b. frontier(interval(a,b)) = + if interval(a,b) = {} then {} + else interval[a,b] DIFF interval(a,b)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN + ASM_SIMP_TAC[frontier; CLOSURE_OPEN_INTERVAL; INTERIOR_OPEN; + OPEN_INTERVAL]);; + +let INTER_INTERVAL_MIXED_EQ_EMPTY = prove + (`!a b c d:real^N. + ~(interval(c,d) = {}) + ==> (interval(a,b) INTER interval[c,d] = {} <=> + interval(a,b) INTER interval(c,d) = {})`, + SIMP_TAC[GSYM CLOSURE_OPEN_INTERVAL; OPEN_INTER_CLOSURE_EQ_EMPTY; + OPEN_INTERVAL]);; + +let INTERVAL_TRANSLATION = prove + (`(!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\ + (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))`, + REWRITE_TAC[interval] THEN CONJ_TAC THEN GEOM_TRANSLATE_TAC[] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; + +add_translation_invariants + [CONJUNCT1 INTERVAL_TRANSLATION; CONJUNCT2 INTERVAL_TRANSLATION];; + +let EMPTY_AS_INTERVAL = prove + (`{} = interval[vec 1,vec 0]`, + SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTERVAL; VEC_COMPONENT] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);; + +let UNIT_INTERVAL_NONEMPTY = prove + (`~(interval[vec 0:real^N,vec 1] = {}) /\ + ~(interval(vec 0:real^N,vec 1) = {})`, + SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01; REAL_POS]);; + +let IMAGE_STRETCH_INTERVAL = prove + (`!a b:real^N m. + IMAGE (\x. lambda k. m(k) * x$k) (interval[a,b]) = + if interval[a,b] = {} then {} + else interval[(lambda k. min (m(k) * a$k) (m(k) * b$k)):real^N, + (lambda k. max (m(k) * a$k) (m(k) * b$k))]`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES] THEN + ASM_SIMP_TAC[EXTENSION; IN_IMAGE; CART_EQ; IN_INTERVAL; AND_FORALL_THM; + TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; + LAMBDA_BETA; GSYM LAMBDA_SKOLEM] THEN + X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(MESON[] + `(!x. p x ==> (q x <=> r x)) + ==> ((!x. p x ==> q x) <=> (!x. p x ==> r x))`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(m:num->real) k = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MAX_ACI; REAL_MIN_ACI] THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(m = &0) ==> (x = m * y <=> y = x / m)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP + (REAL_ARITH `~(z = &0) ==> &0 < z \/ &0 < --z`)) + THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_ARITH `--(max a b) = min (--a) (--b)`; + REAL_ARITH `--(min a b) = max (--a) (--b)`; real_div; + GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN + REWRITE_TAC[GSYM real_div]] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + ASM_SIMP_TAC[real_min; real_max; REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ] THEN + REAL_ARITH_TAC);; + +let INTERVAL_IMAGE_STRETCH_INTERVAL = prove + (`!a b:real^N m. ?u v:real^N. + IMAGE (\x. lambda k. m k * x$k) (interval[a,b]) = interval[u,v]`, + REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);; + +let CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL = prove + (`!a b:real^N. + ~(interval[a,b] = {}) + ==> interval[a,b] = IMAGE (\x:real^N. a + x) + (IMAGE (\x. (lambda i. (b$i - a$i) * x$i)) + (interval[vec 0:real^N,vec 1]))`, + REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[IMAGE_STRETCH_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN + REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN + REWRITE_TAC[EXTENSION; IN_INTERVAL] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN + GEN_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN + MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((!x. P x) <=> (!x. Q x))`) THEN + POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let SUMS_INTERVALS = prove + (`(!a b c d:real^N. + ~(interval[a,b] = {}) /\ ~(interval[c,d] = {}) + ==> {x + y | x IN interval[a,b] /\ y IN interval[c,d]} = + interval[a+c,b+d]) /\ + (!a b c d:real^N. + ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) + ==> {x + y | x IN interval(a,b) /\ y IN interval(c,d)} = + interval(a+c,b+d))`, + CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN + STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN + REWRITE_TAC[UNWIND_THM2; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN + (X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC); + DISCH_TAC THEN + REWRITE_TAC[AND_FORALL_THM; GSYM LAMBDA_SKOLEM; + TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + REWRITE_TAC[REAL_ARITH + `((a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=> + max a (x - d) <= y /\ y <= min b (x - c)) /\ + ((a < y /\ y < b) /\ c < x - y /\ x - y < d <=> + max a (x - d) < y /\ y < min b (x - c))`] THEN + REWRITE_TAC[GSYM REAL_LE_BETWEEN; GSYM REAL_LT_BETWEEN]] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));; + +let PCROSS_INTERVAL = prove + (`!a b:real^M c d:real^N. + interval[a,b] PCROSS interval[c,d] = + interval[pastecart a c,pastecart b d]`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + SIMP_TAC[IN_INTERVAL; pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THEN STRIP_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB] THENL + [ASM_ARITH_TAC; + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);; + +let OPEN_CONTAINS_INTERVAL,OPEN_CONTAINS_OPEN_INTERVAL = (CONJ_PAIR o prove) + (`(!s:real^N->bool. + open s <=> + !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\ + (!s:real^N->bool. + open s <=> + !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(TAUT + `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; + DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + MP_TAC(ISPEC `interval(a:real^N,b)` OPEN_CONTAINS_BALL) THEN + REWRITE_TAC[OPEN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; + DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o + GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x - e / &(dimindex(:N)) % vec 1:real^N` THEN + EXISTS_TAC `x + e / &(dimindex(:N)) % vec 1:real^N` THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s`)) THEN + SIMP_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; IN_CBALL; + VEC_COMPONENT; VECTOR_ADD_COMPONENT; SUBSET; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `x - e < x /\ x < x + e <=> &0 < e`; + REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(x - y) <= e`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + DISCH_TAC THEN REWRITE_TAC[dist] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN + ASM_SIMP_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);; + +let DIAMETER_INTERVAL = prove + (`(!a b:real^N. + diameter(interval[a,b]) = + if interval[a,b] = {} then &0 else norm(b - a)) /\ + (!a b:real^N. + diameter(interval(a,b)) = + if interval(a,b) = {} then &0 else norm(b - a))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_EMPTY; DIAMETER_EMPTY]; + ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND; + ENDS_IN_INTERVAL; BOUNDED_INTERVAL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `diameter(cball(inv(&2) % (a + b):real^N,norm(b - a) / &2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN + REWRITE_TAC[GSYM NORM_MUL; REAL_ARITH `x / &2 = abs(inv(&2)) * x`] THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC; + REWRITE_TAC[DIAMETER_CBALL] THEN NORM_ARITH_TAC]; + DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN + SUBGOAL_THEN `interval[a:real^N,b] = closure(interval(a,b))` + SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN + ASM_MESON_TAC[DIAMETER_CLOSURE; BOUNDED_INTERVAL]]);; + +let IMAGE_TWIZZLE_INTERVAL = prove + (`!p a b. dimindex(:M) = dimindex(:N) /\ p permutes 1..dimindex(:N) + ==> IMAGE ((\x. lambda i. x$(p i)):real^M->real^N) (interval[a,b]) = + interval[(lambda i. a$(p i)),(lambda i. b$(p i))]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + SIMP_TAC[IN_INTERVAL; CART_EQ; LAMBDA_BETA] THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `(lambda i. (y:real^N)$(inverse p i)):real^M` THEN + IMP_REWRITE_TAC[LAMBDA_BETA] THEN + ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSE_EQ; PERMUTES_IN_IMAGE]; + REWRITE_TAC[GSYM IN_NUMSEG] THEN + ASM_MESON_TAC[PERMUTES_INVERSES; PERMUTES_IN_IMAGE]]);; + +(* ------------------------------------------------------------------------- *) +(* Some special cases for intervals in R^1. *) +(* ------------------------------------------------------------------------- *) + +let INTERVAL_CASES_1 = prove + (`!x:real^1. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)`, + REWRITE_TAC[CART_EQ; IN_INTERVAL; FORALL_DIMINDEX_1] THEN REAL_ARITH_TAC);; + +let IN_INTERVAL_1 = prove + (`!a b x:real^1. + (x IN interval[a,b] <=> drop a <= drop x /\ drop x <= drop b) /\ + (x IN interval(a,b) <=> drop a < drop x /\ drop x < drop b)`, + REWRITE_TAC[IN_INTERVAL; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN + MESON_TAC[]);; + +let INTERVAL_EQ_EMPTY_1 = prove + (`!a b:real^1. + (interval[a,b] = {} <=> drop b < drop a) /\ + (interval(a,b) = {} <=> drop b <= drop a)`, + REWRITE_TAC[INTERVAL_EQ_EMPTY; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN + MESON_TAC[]);; + +let INTERVAL_NE_EMPTY_1 = prove + (`(!a b:real^1. ~(interval[a,b] = {}) <=> drop a <= drop b) /\ + (!a b:real^1. ~(interval(a,b) = {}) <=> drop a < drop b)`, + REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REAL_ARITH_TAC);; + +let SUBSET_INTERVAL_1 = prove + (`!a b c d. + (interval[a,b] SUBSET interval[c,d] <=> + drop b < drop a \/ + drop c <= drop a /\ drop a <= drop b /\ drop b <= drop d) /\ + (interval[a,b] SUBSET interval(c,d) <=> + drop b < drop a \/ + drop c < drop a /\ drop a <= drop b /\ drop b < drop d) /\ + (interval(a,b) SUBSET interval[c,d] <=> + drop b <= drop a \/ + drop c <= drop a /\ drop a < drop b /\ drop b <= drop d) /\ + (interval(a,b) SUBSET interval(c,d) <=> + drop b <= drop a \/ + drop c <= drop a /\ drop a < drop b /\ drop b <= drop d)`, + REWRITE_TAC[SUBSET_INTERVAL; FORALL_1; DIMINDEX_1; drop] THEN + REAL_ARITH_TAC);; + +let EQ_INTERVAL_1 = prove + (`!a b c d:real^1. + (interval[a,b] = interval[c,d] <=> + drop b < drop a /\ drop d < drop c \/ + drop a = drop c /\ drop b = drop d)`, + REWRITE_TAC[SET_RULE `s = t <=> s SUBSET t /\ t SUBSET s`] THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC);; + +let DISJOINT_INTERVAL_1 = prove + (`!a b c d:real^1. + (interval[a,b] INTER interval[c,d] = {} <=> + drop b < drop a \/ drop d < drop c \/ + drop b < drop c \/ drop d < drop a) /\ + (interval[a,b] INTER interval(c,d) = {} <=> + drop b < drop a \/ drop d <= drop c \/ + drop b <= drop c \/ drop d <= drop a) /\ + (interval(a,b) INTER interval[c,d] = {} <=> + drop b <= drop a \/ drop d < drop c \/ + drop b <= drop c \/ drop d <= drop a) /\ + (interval(a,b) INTER interval(c,d) = {} <=> + drop b <= drop a \/ drop d <= drop c \/ + drop b <= drop c \/ drop d <= drop a)`, + REWRITE_TAC[DISJOINT_INTERVAL; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM; + UNWIND_THM1; drop]);; + +let OPEN_CLOSED_INTERVAL_1 = prove + (`!a b:real^1. interval(a,b) = interval[a,b] DIFF {a,b}`, + REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; + +let CLOSED_OPEN_INTERVAL_1 = prove + (`!a b:real^1. drop a <= drop b ==> interval[a,b] = interval(a,b) UNION {a,b}`, + REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; + +let BALL_1 = prove + (`!x:real^1 r. cball(x,r) = interval[x - lift r,x + lift r] /\ + ball(x,r) = interval(x - lift r,x + lift r)`, + REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL; IN_INTERVAL_1] THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_ADD] THEN + REAL_ARITH_TAC);; + +let SPHERE_1 = prove + (`!a:real^1 r. sphere(a,r) = if r < &0 then {} else {a - lift r,a + lift r}`, + REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN + REWRITE_TAC[DIST_REAL; GSYM drop; FORALL_DROP] THEN + REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC);; + +let FINITE_SPHERE_1 = prove + (`!a:real^1 r. FINITE(sphere(a,r))`, + REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE_1] THEN + MESON_TAC[FINITE_INSERT; FINITE_EMPTY]);; + +let FINITE_INTERVAL_1 = prove + (`(!a b. FINITE(interval[a,b]) <=> drop b <= drop a) /\ + (!a b. FINITE(interval(a,b)) <=> drop b <= drop a)`, + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN + REWRITE_TAC[SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN + REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN + SUBGOAL_THEN `interval[a,b] = IMAGE lift {x | drop a <= x /\ x <= drop b}` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP]; + SIMP_TAC[FINITE_IMAGE_INJ_EQ; LIFT_EQ; FINITE_REAL_INTERVAL]]);; + +let BALL_INTERVAL = prove + (`!x:real^1 e. ball(x,e) = interval(x - lift e,x + lift e)`, + REWRITE_TAC[EXTENSION; IN_BALL; IN_INTERVAL_1; DIST_REAL] THEN + REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; + +let CBALL_INTERVAL = prove + (`!x:real^1 e. cball(x,e) = interval[x - lift e,x + lift e]`, + REWRITE_TAC[EXTENSION; IN_CBALL; IN_INTERVAL_1; DIST_REAL] THEN + REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; + +let BALL_INTERVAL_0 = prove + (`!e. ball(vec 0:real^1,e) = interval(--lift e,lift e)`, + GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN + BINOP_TAC THEN VECTOR_ARITH_TAC);; + +let CBALL_INTERVAL_0 = prove + (`!e. cball(vec 0:real^1,e) = interval[--lift e,lift e]`, + GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; + +let INTER_INTERVAL_1 = prove + (`!a b c d:real^1. + interval[a,b] INTER interval[c,d] = + interval[lift(max (drop a) (drop c)),lift(min (drop b) (drop d))]`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; real_max; real_min] THEN + REPEAT GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN + ASM_REAL_ARITH_TAC);; + +let CLOSED_DIFF_OPEN_INTERVAL_1 = prove + (`!a b:real^1. + interval[a,b] DIFF interval(a,b) = + if interval[a,b] = {} then {} else {a,b}`, + REWRITE_TAC[EXTENSION; IN_DIFF; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Intervals in general, including infinite and mixtures of open and closed. *) +(* ------------------------------------------------------------------------- *) + +let is_interval = new_definition + `is_interval(s:real^N->bool) <=> + !a b x. a IN s /\ b IN s /\ + (!i. 1 <= i /\ i <= dimindex(:N) + ==> (a$i <= x$i /\ x$i <= b$i) \/ + (b$i <= x$i /\ x$i <= a$i)) + ==> x IN s`;; + +let IS_INTERVAL_INTERVAL = prove + (`!a:real^N b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])`, + REWRITE_TAC[is_interval; IN_INTERVAL] THEN + MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]);; + +let IS_INTERVAL_EMPTY = prove + (`is_interval {}`, + REWRITE_TAC[is_interval; NOT_IN_EMPTY]);; + +let IS_INTERVAL_UNIV = prove + (`is_interval(UNIV:real^N->bool)`, + REWRITE_TAC[is_interval; IN_UNIV]);; + +let IS_INTERVAL_TRANSLATION_EQ = prove + (`!a:real^N s. is_interval(IMAGE (\x. a + x) s) <=> is_interval s`, + REWRITE_TAC[is_interval] THEN GEOM_TRANSLATE_TAC[] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; + +add_translation_invariants [IS_INTERVAL_TRANSLATION_EQ];; + +let IS_INTERVAL_TRANSLATION = prove + (`!s a:real^N. is_interval s ==> is_interval(IMAGE (\x. a + x) s)`, + REWRITE_TAC[IS_INTERVAL_TRANSLATION_EQ]);; + +let IS_INTERVAL_POINTWISE = prove + (`!s:real^N->bool x. + is_interval s /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. a IN s /\ a$i = x$i) + ==> x IN s`, + REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. ?y:real^N. (!i. 1 <= i /\ i <= n ==> y$i = (x:real^N)$i) /\ y IN s` + MP_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THENL + [ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN + ASM_CASES_TAC `SUC n <= dimindex(:N)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(lambda i. if i <= n then (y:real^N)$i else (z:real^N)$i):real^N` THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `i = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_ARITH_TAC; + FIRST_X_ASSUM(ASSUME_TAC o CONJUNCT2) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]; + EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `y:real^N = x` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[CART_EQ] THEN + ASM_MESON_TAC[ARITH_RULE `i <= N /\ ~(SUC n <= N) ==> i <= n`]]; + DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN + REWRITE_TAC[GSYM CART_EQ] THEN MESON_TAC[]]);; + +let IS_INTERVAL_COMPACT = prove + (`!s:real^N->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; COMPACT_INTERVAL] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN + EXISTS_TAC `(lambda i. inf { (x:real^N)$i | x IN s}):real^N` THEN + EXISTS_TAC `(lambda i. sup { (x:real^N)$i | x IN s}):real^N` THEN + SIMP_TAC[EXTENSION; IN_INTERVAL; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN + EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` INF) THEN + MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` SUP) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[bounded] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; + REAL_ARITH `abs(x) <= B ==> --B <= x /\ x <= B`]; + DISCH_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?a b:real^N. a IN s /\ b IN s /\ a$i <= (x:real^N)$i /\ x$i <= b$i` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] + CONTINUOUS_ATTAINS_INF) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] + CONTINUOUS_ATTAINS_SUP) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `inf {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_INF THEN ASM SET_TAC[]; + EXISTS_TAC `sup {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_SUP_LE THEN ASM SET_TAC[]]; + EXISTS_TAC + `(lambda j. if j = i then (x:real^N)$i else (a:real^N)$j):real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN + MAP_EVERY EXISTS_TAC + [`a:real^N`; + `(lambda j. if j = i then (b:real^N)$i else (a:real^N)$j):real^N`] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN + ASM_SIMP_TAC[LAMBDA_BETA]; + ALL_TAC] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +let IS_INTERVAL_1 = prove + (`!s:real^1->bool. + is_interval s <=> + !a b x. a IN s /\ b IN s /\ drop a <= drop x /\ drop x <= drop b + ==> x IN s`, + REWRITE_TAC[is_interval; DIMINDEX_1; FORALL_1; GSYM drop] THEN + REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MESON_TAC[]);; + +let IS_INTERVAL_1_CASES = prove + (`!s:real^1->bool. + is_interval s <=> + s = {} \/ + s = (:real^1) \/ + (?a. s = {x | a < drop x}) \/ + (?a. s = {x | a <= drop x}) \/ + (?b. s = {x | drop x <= b}) \/ + (?b. s = {x | drop x < b}) \/ + (?a b. s = {x | a < drop x /\ drop x < b}) \/ + (?a b. s = {x | a < drop x /\ drop x <= b}) \/ + (?a b. s = {x | a <= drop x /\ drop x < b}) \/ + (?a b. s = {x | a <= drop x /\ drop x <= b})`, + GEN_TAC THEN REWRITE_TAC[IS_INTERVAL_1] THEN EQ_TAC THENL + [DISCH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC] THEN + ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `IMAGE drop s` SUP) THEN + MP_TAC(ISPEC `IMAGE drop s` INF) THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + ASM_CASES_TAC `?a. !x. x IN s ==> a <= drop x` THEN + ASM_CASES_TAC `?b. !x. x IN s ==> drop x <= b` THEN + ASM_REWRITE_TAC[] THENL + [STRIP_TAC THEN STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`inf(IMAGE drop s) IN IMAGE drop s`; `sup(IMAGE drop s) IN IMAGE drop s`] + THENL + [REPLICATE_TAC 8 DISJ2_TAC; + REPLICATE_TAC 7 DISJ2_TAC THEN DISJ1_TAC; + REPLICATE_TAC 6 DISJ2_TAC THEN DISJ1_TAC; + REPLICATE_TAC 5 DISJ2_TAC THEN DISJ1_TAC] THEN + MAP_EVERY EXISTS_TAC [`inf(IMAGE drop s)`; `sup(IMAGE drop s)`]; + STRIP_TAC THEN ASM_CASES_TAC `inf(IMAGE drop s) IN IMAGE drop s` THENL + [REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC; + DISJ2_TAC THEN DISJ1_TAC] THEN + EXISTS_TAC `inf(IMAGE drop s)`; + STRIP_TAC THEN ASM_CASES_TAC `sup(IMAGE drop s) IN IMAGE drop s` THENL + [REPLICATE_TAC 3 DISJ2_TAC THEN DISJ1_TAC; + REPLICATE_TAC 4 DISJ2_TAC THEN DISJ1_TAC] THEN + EXISTS_TAC `sup(IMAGE drop s)`; + DISJ1_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN + REWRITE_TAC[GSYM REAL_NOT_LE] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM]);; + +let IS_INTERVAL_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + is_interval s /\ is_interval t ==> is_interval(s PCROSS t)`, + REWRITE_TAC[is_interval; DIMINDEX_FINITE_SUM] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + REPEAT GEN_TAC THEN + MATCH_MP_TAC(MESON[] + `(!a b a' b' x x'. P a b x /\ Q a' b' x' ==> R a b x a' b' x') + ==> (!a b x. P a b x) /\ (!a' b' x'. Q a' b' x') + ==> (!a a' b b' x x'. R a b x a' b' x')`) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `x:num <= m ==> x <= m + n`]; + FIRST_X_ASSUM(MP_TAC o SPEC `dimindex(:M) + i`) THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `x:num <= n ==> m + x <= m + n`; + ARITH_RULE `1 <= x ==> 1 <= m + x`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN ASM_ARITH_TAC]);; + +let IS_INTERVAL_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + is_interval(s PCROSS t) <=> + s = {} \/ t = {} \/ is_interval s /\ is_interval t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_PCROSS] THEN + REWRITE_TAC[is_interval] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + STRIP_TAC THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN + STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a:real^M`; `y:real^N`; `b:real^M`; + `y:real^N`; `x:real^M`; `y:real^N`]); + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `w:real^M`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`w:real^M`; `a:real^N`; `w:real^M`; + `b:real^N`; `w:real^M`; `x:real^N`])] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[pastecart; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_MESON_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE + `1 <= i /\ i <= m + n /\ ~(i <= m) ==> 1 <= i - m /\ i - m <= n`]);; + +let IS_INTERVAL_INTER = prove + (`!s t:real^N->bool. + is_interval s /\ is_interval t ==> is_interval(s INTER t)`, + REWRITE_TAC[is_interval; IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[]);; + +let INTERVAL_SUBSET_IS_INTERVAL = prove + (`!s a b:real^N. + is_interval s + ==> (interval[a,b] SUBSET s <=> interval[a,b] = {} \/ a IN s /\ b IN s)`, + REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET] THEN + EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[]);; + +let INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD = prove + (`!s x:real^N. + is_interval s /\ x IN s + ==> ?a b d. &0 < d /\ x IN interval[a,b] /\ + interval[a,b] SUBSET s /\ + ball(x,d) INTER s SUBSET interval[a,b]`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?a. (?y. y IN s /\ y$i = a) /\ + (a < x$i \/ a = (x:real^N)$i /\ + !y:real^N. y IN s ==> a <= y$i)` + MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?b. (?y. y IN s /\ y$i = b) /\ + (x$i < b \/ b = (x:real^N)$i /\ + !y:real^N. y IN s ==> y$i <= b)` + MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + EXISTS_TAC `min (inf (IMAGE (\i. if a$i < x$i + then (x:real^N)$i - (a:real^N)$i else &1) + (1..dimindex(:N)))) + (inf (IMAGE (\i. if x$i < b$i + then (b:real^N)$i - x$i else &1) + (1..dimindex(:N))))` THEN + REWRITE_TAC[REAL_LT_MIN; SUBSET; IN_BALL; IN_INTER] THEN + SIMP_TAC[REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE; + FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL] THEN REPEAT CONJ_TAC THENL + [MESON_TAC[REAL_SUB_LT; REAL_LT_01]; + MESON_TAC[REAL_SUB_LT; REAL_LT_01]; + ASM_MESON_TAC[REAL_LE_LT]; + DISJ2_TAC THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN + ASM_MESON_TAC[]; + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + (COND_CASES_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]]) THEN + DISCH_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`] + COMPONENT_LE_NORM) THEN + ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);; + +let IS_INTERVAL_SUMS = prove + (`!s t:real^N->bool. + is_interval s /\ is_interval t + ==> is_interval {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + MAP_EVERY X_GEN_TAC + [`a:real^N`; `a':real^N`; `b:real^N`; `b':real^N`; `y:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`a:real^N`; `b:real^N`]) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`a':real^N`; `b':real^N`]) STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IMP_IMP; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `z:real^N = x + y <=> y = z - x`] THEN + REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[] + `(?x. P x /\ Q(f x)) + ==> (!x. P x ==> x IN s) /\ (!x. Q x ==> x IN t) + ==> ?x. x IN s /\ f x IN t`) THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; AND_FORALL_THM; + TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH + `c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c`] THEN + REWRITE_TAC[REAL_ARITH + `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`] THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN + REWRITE_TAC[GSYM REAL_LE_MIN; GSYM REAL_MAX_LE] THEN + REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN REAL_ARITH_TAC);; + +let IS_INTERVAL_SING = prove + (`!a:real^N. is_interval {a}`, + SIMP_TAC[is_interval; IN_SING; IMP_CONJ; CART_EQ; REAL_LE_ANTISYM]);; + +let IS_INTERVAL_SCALING = prove + (`!s:real^N->bool c. is_interval s ==> is_interval(IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ + IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` + STRIP_ASSUME_TAC THENL + [SET_TAC[]; + ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; + ASM_REWRITE_TAC[IS_INTERVAL_SING]]; + REWRITE_TAC[is_interval; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + GEN_REWRITE_TAC (BINOP_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; VECTOR_MUL_COMPONENT] THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) + [`a:real^N`; `b:real^N`] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + MP_TAC(SPEC `inv(c) % x:real^N` th)) THEN + ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_IMAGE] THEN ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(c = &0) ==> &0 < c \/ &0 < --c`)) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_LE_RDIV_EQ; GSYM + REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `inv c % x:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]);; + +let IS_INTERVAL_SCALING_EQ = prove + (`!s:real^N->bool c. + is_interval(IMAGE (\x. c % x) s) <=> c = &0 \/ is_interval s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ + IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` + STRIP_ASSUME_TAC THENL + [SET_TAC[]; + ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; + ASM_REWRITE_TAC[IS_INTERVAL_SING]]; + ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP IS_INTERVAL_SCALING) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; VECTOR_MUL_ASSOC; o_DEF; REAL_MUL_LINV; + VECTOR_MUL_LID; IMAGE_ID]]);; + +let lemma = prove + (`!c. &0 < c + ==> !s:real^N->bool. is_interval(IMAGE (\x. c % x) s) <=> + is_interval s`, + SIMP_TAC[IS_INTERVAL_SCALING_EQ; REAL_LT_IMP_NZ]) in +add_scaling_theorems [lemma];; + +(* ------------------------------------------------------------------------- *) +(* Line segments, with same open/closed overloading as for intervals. *) +(* ------------------------------------------------------------------------- *) + +let closed_segment = define + `closed_segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1}`;; + +let open_segment = new_definition + `open_segment(a,b) = closed_segment[a,b] DIFF {a,b}`;; + +let OPEN_SEGMENT_ALT = prove + (`!a b:real^N. + ~(a = b) + ==> open_segment(a,b) = {(&1 - u) % a + u % b | &0 < u /\ u < &1}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment; closed_segment] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `u:real` THEN ASM_CASES_TAC `x:real^N = (&1 - u) % a + u % b` THEN + ASM_REWRITE_TAC[REAL_LE_LT; + VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`; + VECTOR_ARITH `(&1 - u) % a + u % b = b <=> (&1 - u) % (b - a) = vec 0`; + VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ] THEN + REAL_ARITH_TAC);; + +make_overloadable "segment" `:A`;; + +overload_interface("segment",`open_segment`);; +overload_interface("segment",`closed_segment`);; + +let segment = prove + (`segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1} /\ + segment(a,b) = segment[a,b] DIFF {a,b}`, + REWRITE_TAC[open_segment; closed_segment]);; + +let SEGMENT_REFL = prove + (`(!a. segment[a,a] = {a}) /\ + (!a. segment(a,a) = {})`, + REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % a = a`] THEN + SET_TAC[REAL_POS]);; + +let IN_SEGMENT = prove + (`!a b x:real^N. + (x IN segment[a,b] <=> + ?u. &0 <= u /\ u <= &1 /\ x = (&1 - u) % a + u % b) /\ + (x IN segment(a,b) <=> + ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ x = (&1 - u) % a + u % b)`, + REPEAT STRIP_TAC THENL + [REWRITE_TAC[segment; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM; CONJ_ASSOC]);; + +let SEGMENT_SYM = prove + (`(!a b:real^N. segment[a,b] = segment[b,a]) /\ + (!a b:real^N. segment(a,b) = segment(b,a))`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + SIMP_TAC[open_segment] THEN + CONJ_TAC THENL [ALL_TAC; SIMP_TAC[INSERT_AC]] THEN + REWRITE_TAC[EXTENSION; IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN + ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN VECTOR_ARITH_TAC);; + +let ENDS_IN_SEGMENT = prove + (`!a b. a IN segment[a,b] /\ b IN segment[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THENL + [EXISTS_TAC `&0`; EXISTS_TAC `&1`] THEN + (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]));; + +let ENDS_NOT_IN_SEGMENT = prove + (`!a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))`, + REWRITE_TAC[open_segment] THEN SET_TAC[]);; + +let SEGMENT_CLOSED_OPEN = prove + (`!a b. segment[a,b] = segment(a,b) UNION {a,b}`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE + `a IN s /\ b IN s ==> s = (s DIFF {a,b}) UNION {a,b}`) THEN + REWRITE_TAC[ENDS_IN_SEGMENT]);; + +let MIDPOINT_IN_SEGMENT = prove + (`(!a b:real^N. midpoint(a,b) IN segment[a,b]) /\ + (!a b:real^N. midpoint(a,b) IN segment(a,b) <=> ~(a = b))`, + REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[]] THEN + EXISTS_TAC `&1 / &2` THEN REWRITE_TAC[midpoint] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC);; + +let BETWEEN_IN_SEGMENT = prove + (`!x a b:real^N. between x (a,b) <=> x IN segment[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING] THENL [NORM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[segment; IN_ELIM_THM] THEN EQ_TAC THENL + [DISCH_THEN(ASSUME_TAC o SYM) THEN + EXISTS_TAC `dist(a:real^N,x) / dist(a,b)` THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC + THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `dist(a:real^N,b)` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB; + REAL_DIV_LMUL; DIST_EQ_0] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN + VECTOR_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN + REWRITE_TAC[VECTOR_ARITH `a - ((&1 - u) % a + u % b) = u % (a - b)`; + VECTOR_ARITH `((&1 - u) % a + u % b) - b = (&1 - u) % (a - b)`; + NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; + +let IN_SEGMENT_COMPONENT = prove + (`!a b x:real^N i. + x IN segment[a,b] /\ 1 <= i /\ i <= dimindex(:N) + ==> min (a$i) (b$i) <= x$i /\ x$i <= max (a$i) (b$i)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[REAL_ARITH `c <= u * a + t * b <=> u * --a + t * --b <= --c`] THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REAL_ARITH_TAC);; + +let SEGMENT_1 = prove + (`(!a b. segment[a,b] = + if drop a <= drop b then interval[a,b] else interval[b,a]) /\ + (!a b. segment(a,b) = + if drop a <= drop b then interval(a,b) else interval(b,a))`, + CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN + COND_CASES_TAC THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; + EXTENSION; GSYM BETWEEN_IN_SEGMENT; between; IN_INTERVAL_1] THEN + REWRITE_TAC[GSYM DROP_EQ; DIST_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC);; + +let OPEN_SEGMENT_1 = prove + (`!a b:real^1. open(segment(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1] THEN + COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]);; + +let SEGMENT_TRANSLATION = prove + (`(!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\ + (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))`, + REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (c + a) + u % (c + b) = + c + (&1 - u) % a + u % b`] THEN + REWRITE_TAC[VECTOR_ARITH `c + a:real^N = c + b <=> a = b`] THEN + MESON_TAC[]);; + +add_translation_invariants + [CONJUNCT1 SEGMENT_TRANSLATION; CONJUNCT2 SEGMENT_TRANSLATION];; + +let CLOSED_SEGMENT_LINEAR_IMAGE = prove + (`!f a b. linear f + ==> segment[f a,f b] = IMAGE f (segment[a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SEGMENT] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN + MESON_TAC[]);; + +add_linear_invariants [CLOSED_SEGMENT_LINEAR_IMAGE];; + +let OPEN_SEGMENT_LINEAR_IMAGE = prove + (`!f:real^M->real^N a b. + linear f /\ (!x y. f x = f y ==> x = y) + ==> segment(f a,f b) = IMAGE f (segment(a,b))`, + REWRITE_TAC[open_segment] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [OPEN_SEGMENT_LINEAR_IMAGE];; + +let IN_OPEN_SEGMENT = prove + (`!a b x:real^N. + x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]);; + +let IN_OPEN_SEGMENT_ALT = prove + (`!a b x:real^N. + x IN segment(a,b) <=> + x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[IN_OPEN_SEGMENT]);; + +let COLLINEAR_DIST_IN_CLOSED_SEGMENT = prove + (`!a b x. collinear {x,a,b} /\ + dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b) + ==> x IN segment[a,b]`, + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; COLLINEAR_DIST_BETWEEN]);; + +let COLLINEAR_DIST_IN_OPEN_SEGMENT = prove + (`!a b x. collinear {x,a,b} /\ + dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b) + ==> x IN segment(a,b)`, + REWRITE_TAC[IN_OPEN_SEGMENT] THEN + MESON_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT; REAL_LT_LE; DIST_SYM]);; + +let SEGMENT_SCALAR_MULTIPLE = prove + (`(!a b v. segment[a % v,b % v] = + {x % v:real^N | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\ + (!a b v. ~(v = vec 0) + ==> segment(a % v,b % v) = + {x % v:real^N | a < x /\ x < b \/ b < x /\ x < a})`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL + [REPEAT GEN_TAC THEN + MP_TAC(SPECL [`a % basis 1:real^1`; `b % basis 1:real^1`] + (CONJUNCT1 SEGMENT_1)) THEN + REWRITE_TAC[segment; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN + REWRITE_TAC[SET_RULE `{f x % b | p x} = IMAGE (\a. a % b) {f x | p x}`] THEN + DISCH_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE drop`) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_CMUL] THEN + SIMP_TAC[drop; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN + REWRITE_TAC[REAL_MUL_RID; IMAGE_ID] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + SIMP_TAC[drop; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; + LE_REFL; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[open_segment] THEN + ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; SET_RULE + `(!x y. x % v = y % v <=> x = y) + ==> {x % v | P x} DIFF {a % v,b % v} = + {x % v | P x /\ ~(x = a) /\ ~(x = b)}`] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; + +let FINITE_INTER_COLLINEAR_OPEN_SEGMENTS = prove + (`!a b c d:real^N. + collinear{a,b,c} + ==> (FINITE(segment(a,b) INTER segment(c,d)) <=> + segment(a,b) INTER segment(c,d) = {})`, + REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = b - a` THEN POP_ASSUM MP_TAC THEN + GEOM_NORMALIZE_TAC `m:real^N` THEN + SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; INTER_EMPTY; FINITE_EMPTY] THEN + X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN + GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN + X_GEN_TAC `b:real` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM(K ALL_TAC) THEN + ASM_CASES_TAC `collinear{vec 0:real^N,&1 % basis 1,y}` THENL + [POP_ASSUM MP_TAC THEN + SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN + MATCH_MP_TAC(TAUT + `~a /\ (b ==> c ==> d) ==> a \/ b ==> a \/ c ==> d`) THEN + CONJ_TAC THENL + [SIMP_TAC[VECTOR_MUL_LID; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN + X_GEN_TAC `a:real` THEN DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN + SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; + VECTOR_MUL_RCANCEL; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; SET_RULE + `(!x y. x % v = y % v <=> x = y) + ==> {x % v | P x} INTER {x % v | Q x} = + IMAGE (\x. x % v) {x | P x /\ Q x}`] THEN + REWRITE_TAC[REAL_ARITH `(&0 < x /\ x < &1 \/ &1 < x /\ x < &0) /\ + (b < x /\ x < a \/ a < x /\ x < b) <=> + max (&0) (min a b) < x /\ x < min (&1) (max a b)`] THEN + SIMP_TAC[FINITE_REAL_INTERVAL; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN + SIMP_TAC[GSYM REAL_LT_BETWEEN; GSYM NOT_EXISTS_THM] THEN REAL_ARITH_TAC; + DISCH_TAC THEN ASM_CASES_TAC + `segment(vec 0:real^N,&1 % basis 1) INTER segment (x,y) = {}` THEN + ASM_REWRITE_TAC[FINITE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[open_segment; IN_DIFF; NOT_IN_EMPTY; + DE_MORGAN_THM; IN_INTER; IN_INSERT] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `~collinear{vec 0:real^N,&1 % basis 1, y}` THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_LID]) THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN + MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `{p,x:real^N, y, vec 0, basis 1}` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MP_TAC(ISPECL [`{y:real^N,vec 0,basis 1}`; `p:real^N`; `x:real^N`] + COLLINEAR_TRIPLES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{p,x,y} = {x,p,y}`] THEN + MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN + ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM COLLINEAR_4_3] THEN + ONCE_REWRITE_TAC[SET_RULE `{p,x,z,w} = {w,z,p,x}`] THEN + SIMP_TAC[COLLINEAR_4_3; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o + GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);; + +let DIST_IN_CLOSED_SEGMENT,DIST_IN_OPEN_SEGMENT = (CONJ_PAIR o prove) + (`(!a b x:real^N. + x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\ + (!a b x:real^N. + x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))`, + SIMP_TAC[IN_SEGMENT; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; dist; + VECTOR_ARITH + `((&1 - u) % a + u % b) - a:real^N = u % (b - a) /\ + ((&1 - u) % a + u % b) - b = --(&1 - u) % (b - a)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; NORM_SUB] THEN CONJ_TAC THEN + REPEAT GEN_TAC THEN STRIP_TAC THENL + [REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `x * y < y <=> x * y < &1 * y`] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let DIST_DECREASES_OPEN_SEGMENT = prove + (`!a b c x:real^N. + x IN segment(a,b) ==> dist(c,x) < dist(c,a) \/ dist(c,x) < dist(c,b)`, + GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_NORMALIZE_TAC `b:real^N` THEN + REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN X_GEN_TAC `b:real^N` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_GE_1; LE_REFL; + REAL_MUL_RID; VECTOR_MUL_LID] THEN + REPEAT(DISCH_THEN(K ALL_TAC)) THEN REPEAT GEN_TAC THEN + REWRITE_TAC[IN_SEGMENT; dist] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + SUBGOAL_THEN + `norm((c$1 - u) % basis 1:real^N) < norm((c:real^N)$1 % basis 1:real^N) \/ + norm((c$1 - u) % basis 1:real^N) < norm((c$1 - &1) % basis 1:real^N)` + MP_TAC THENL + [SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[NORM_LT; DOT_LMUL; DOT_RMUL; DOT_BASIS; DIMINDEX_GE_1; + DOT_LSUB; DOT_RSUB; LE_REFL; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + BASIS_COMPONENT; DOT_LZERO; DOT_RZERO; VECTOR_SUB_COMPONENT] THEN + ASM_REAL_ARITH_TAC]);; + +let DIST_DECREASES_CLOSED_SEGMENT = prove + (`!a b c x:real^N. + x IN segment[a,b] ==> dist(c,x) <= dist(c,a) \/ dist(c,x) <= dist(c,b)`, + REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[DIST_DECREASES_OPEN_SEGMENT; REAL_LE_REFL; REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Limit component bounds. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPONENT_UBOUND = prove + (`!net:(A)net f (l:real^N) b k. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. (f x)$k <= b) net /\ + 1 <= k /\ k <= dimindex(:N) + ==> l$k <= b`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`net:(A)net`; `f:A->real^N`; `{y:real^N | basis k dot y <= b}`; `l:real^N`] + LIM_IN_CLOSED_SET) THEN + ASM_SIMP_TAC[CLOSED_HALFSPACE_LE; IN_ELIM_THM; DOT_BASIS]);; + +let LIM_COMPONENT_LBOUND = prove + (`!net:(A)net f (l:real^N) b k. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. b <= (f x)$k) net /\ + 1 <= k /\ k <= dimindex(:N) + ==> b <= l$k`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`net:(A)net`; `f:A->real^N`; `{y:real^N | b <= basis k dot y}`; `l:real^N`] + LIM_IN_CLOSED_SET) THEN + ASM_SIMP_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_GE; + IN_ELIM_THM; DOT_BASIS]);; + +let LIM_COMPONENT_EQ = prove + (`!net f:A->real^N i l b. + (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) /\ + ~(trivial_limit net) /\ eventually (\x. f(x)$i = b) net + ==> l$i = b`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; EVENTUALLY_AND] THEN + MESON_TAC[LIM_COMPONENT_UBOUND; LIM_COMPONENT_LBOUND]);; + +let LIM_COMPONENT_LE = prove + (`!net:(A)net f:A->real^N g:A->real^N k l m. + ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ + eventually (\x. (f x)$k <= (g x)$k) net /\ + 1 <= k /\ k <= dimindex(:N) + ==> l$k <= m$k`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; LIM_COMPONENT_LBOUND] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; LIM_COMPONENT_LBOUND]);; + +let LIM_DROP_LE = prove + (`!net:(A)net f g l m. + ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ + eventually (\x. drop(f x) <= drop(g x)) net + ==> drop l <= drop m`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `net:(A)net` LIM_COMPONENT_LE) THEN + MAP_EVERY EXISTS_TAC [`f:A->real^1`; `g:A->real^1`] THEN + ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; + +let LIM_DROP_UBOUND = prove + (`!net f:A->real^1 l b. + (f --> l) net /\ + ~(trivial_limit net) /\ eventually (\x. drop(f x) <= b) net + ==> drop l <= b`, + SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN + REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; + +let LIM_DROP_LBOUND = prove + (`!net f:A->real^1 l b. + (f --> l) net /\ + ~(trivial_limit net) /\ eventually (\x. b <= drop(f x)) net + ==> b <= drop l`, + SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN + REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Also extending closed bounds to closures. *) +(* ------------------------------------------------------------------------- *) + +let IMAGE_CLOSURE_SUBSET = prove + (`!f (s:real^N->bool) (t:real^M->bool). + f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t + ==> IMAGE f (closure s) SUBSET t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `closure s SUBSET {x | (f:real^N->real^M) x IN t}` MP_TAC + THENL [MATCH_MP_TAC SUBSET_TRANS; SET_TAC []] THEN + EXISTS_TAC `{x | x IN closure s /\ (f:real^N->real^M) x IN t}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL; SET_TAC[]] THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CLOSURE] THEN + MP_TAC (ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; + +let CLOSURE_IMAGE_CLOSURE = prove + (`!f:real^M->real^N s. + f continuous_on closure s + ==> closure(IMAGE f (closure s)) = closure(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + SIMP_TAC[SUBSET_CLOSURE; IMAGE_SUBSET; CLOSURE_SUBSET] THEN + SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_CLOSURE] THEN + MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET]);; + +let CLOSURE_IMAGE_BOUNDED = prove + (`!f:real^M->real^N s. + f continuous_on closure s /\ bounded s + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS `closure(IMAGE (f:real^M->real^N) (closure s))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE]; ALL_TAC] THEN + MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE]);; + +let CONTINUOUS_ON_CLOSURE_NORM_LE = prove + (`!f:real^N->real^M s x b. + f continuous_on (closure s) /\ + (!y. y IN s ==> norm(f y) <= b) /\ + x IN (closure s) + ==> norm(f x) <= b`, + REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET cball(vec 0,b)` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN + ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM SET_TAC []);; + +let CONTINUOUS_ON_CLOSURE_COMPONENT_LE = prove + (`!f:real^N->real^M s x b k. + f continuous_on (closure s) /\ + (!y. y IN s ==> (f y)$k <= b) /\ + x IN (closure s) + ==> (f x)$k <= b`, + REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k <= b}` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM SET_TAC[]);; + +let CONTINUOUS_ON_CLOSURE_COMPONENT_GE = prove + (`!f:real^N->real^M s x b k. + f continuous_on (closure s) /\ + (!y. y IN s ==> b <= (f y)$k) /\ + x IN (closure s) + ==> b <= (f x)$k`, + REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k >= b}` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC [real_ge]] THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM SET_TAC[real_ge]);; + +(* ------------------------------------------------------------------------- *) +(* Limits relative to a union. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_UNION = prove + (`(f --> l) (at x within (s UNION t)) <=> + (f --> l) (at x within s) /\ (f --> l) (at x within t)`, + REWRITE_TAC[LIM_WITHIN; IN_UNION; AND_FORALL_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `k:real`)) THEN + EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_UNION = prove + (`!f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REWRITE_TAC[CONTINUOUS_ON; CLOSED_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN + MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; + +let CONTINUOUS_ON_CASES = prove + (`!P f g:real^M->real^N s t. + closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_UNION_LOCAL = prove + (`!f:real^M->real^N s. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REWRITE_TAC[CONTINUOUS_ON; CLOSED_IN_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN + MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; + +let CONTINUOUS_ON_CASES_LOCAL = prove + (`!P f g:real^M->real^N s t. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_CASES_LE = prove + (`!f g:real^M->real^N h s a. + f continuous_on {t | t IN s /\ h t <= a} /\ + g continuous_on {t | t IN s /\ a <= h t} /\ + (lift o h) continuous_on s /\ + (!t. t IN s /\ h t = a ==> f t = g t) + ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC + `{t | t IN s /\ (h:real^M->real) t <= a} UNION + {t | t IN s /\ a <= h t}` THEN + CONJ_TAC THENL + [ALL_TAC; SIMP_TAC[SUBSET; IN_UNION; IN_ELIM_THM; REAL_LE_TOTAL]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `{t | t IN s /\ (h:real^M->real) t <= a} = + {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ + (lift o h) t IN {x | x$1 <= a}}` + (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) + THENL + [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; + IN_UNION] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SET_TAC[]]; + SUBGOAL_THEN + `{t | t IN s /\ a <= (h:real^M->real) t} = + {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ + (lift o h) t IN {x | x$1 >= a}}` + (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) + THENL + [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; + IN_UNION] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SET_TAC[]]]);; + +let CONTINUOUS_ON_CASES_1 = prove + (`!f g:real^1->real^N s a. + f continuous_on {t | t IN s /\ drop t <= a} /\ + g continuous_on {t | t IN s /\ a <= drop t} /\ + (lift a IN s ==> f(lift a) = g(lift a)) + ==> (\t. if drop t <= a then f(t) else g(t)) continuous_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let EXTENSION_FROM_CLOPEN = prove + (`!f:real^M->real^N s t u. + open_in (subtopology euclidean s) t /\ + closed_in (subtopology euclidean s) t /\ + f continuous_on t /\ IMAGE f t SUBSET u /\ (u = {} ==> s = {}) + ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ + !x. x IN t ==> g x = f x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; SUBSET_EMPTY; + IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else a` THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + SUBGOAL_THEN `s:real^M->bool = t UNION (s DIFF t)` SUBST1_TAC THENL + [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; IN_DIFF] THEN + CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF; MESON_TAC[]] THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Componentwise limits and continuity. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPONENTWISE_LIFT = prove + (`!net f:A->real^N. + (f --> l) net <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> ((\x. lift((f x)$i)) --> lift(l$i)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH + `y <= x ==> x < e ==> y < e`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM LIFT_SUB; NORM_LIFT; + GSYM VECTOR_SUB_COMPONENT]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_FORALL_THM] THEN + ONCE_REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[GSYM IN_NUMSEG; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_EVENTUALLY; FINITE_NUMSEG; NUMSEG_EMPTY; + GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `x:A` THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist] THEN + DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1; + CARD_NUMSEG_1; GSYM IN_NUMSEG]]);; + +let CONTINUOUS_COMPONENTWISE_LIFT = prove + (`!net f:A->real^N. + f continuous net <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift((f x)$i)) continuous net`, + REWRITE_TAC[continuous; GSYM LIM_COMPONENTWISE_LIFT]);; + +let CONTINUOUS_ON_COMPONENTWISE_LIFT = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift((f x)$i)) continuous_on s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [CONTINUOUS_COMPONENTWISE_LIFT] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some more convenient intermediate-value theorem formulations. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_IVT_HYPERPLANE = prove + (`!s x y:real^N a b. + connected s /\ + x IN s /\ y IN s /\ a dot x <= b /\ b <= a dot y + ==> ?z. z IN s /\ a dot z = b`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL + [`{x:real^N | a dot x < b}`; `{x:real^N | a dot x > b}`]) THEN + REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; SUBSET; + IN_UNION; REAL_LT_LE; real_gt] THEN + ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]);; + +let CONNECTED_IVT_COMPONENT = prove + (`!s x y:real^N a k. + connected s /\ x IN s /\ y IN s /\ + 1 <= k /\ k <= dimindex(:N) /\ x$k <= a /\ a <= y$k + ==> ?z. z IN s /\ z$k = a`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`s:real^N->bool`; `x:real^N`; `y:real^N`; `(basis k):real^N`; + `a:real`] CONNECTED_IVT_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +(* ------------------------------------------------------------------------- *) +(* Rather trivial observation that we can map any connected set on segment. *) +(* ------------------------------------------------------------------------- *) + +let MAPPING_CONNECTED_ONTO_SEGMENT = prove + (`!s:real^M->bool a b:real^N. + connected s /\ ~(?a. s SUBSET {a}) + ==> ?f. f continuous_on s /\ IMAGE f s = segment[a,b]`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN EXISTS_TAC + `\x:real^M. a + dist(u,x) / (dist(u,x) + dist(v,x)) % (b - a:real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST]; + REWRITE_TAC[segment; VECTOR_ARITH + `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN + MATCH_MP_TAC(SET_RULE + `IMAGE f s = {x | P x} + ==> IMAGE (\x. a + f x % b) s = {a + u % b:real^N | P u}`) THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; + NORM_ARITH `~(u:real^N = v) ==> &0 < dist(u,x) + dist(v,x)`] THEN + CONJ_TAC THENL [CONV_TAC NORM_ARITH; REWRITE_TAC[IN_IMAGE]] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`IMAGE (\x:real^M. lift(dist(u,x) / (dist(u,x) + dist(v,x)))) s`; + `vec 0:real^1`; `vec 1:real^1`; `t:real`; `1`] + CONNECTED_IVT_COMPONENT) THEN + ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH_LE] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; GSYM drop; LIFT_DROP] THEN + ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE]; MESON_TAC[]] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[DIST_REFL; real_div] THEN + REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN REAL_ARITH_TAC; + EXISTS_TAC `v:real^M` THEN ASM_REWRITE_TAC[DIST_REFL] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; DIST_EQ_0; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]]] THEN + REWRITE_TAC[real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_DIST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[LIFT_ADD; NORM_ARITH + `~(u:real^N = v) ==> ~(dist(u,x) + dist(v,x) = &0)`] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);; + +(* ------------------------------------------------------------------------- *) +(* Also more convenient formulations of monotone convergence. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_INCREASING_CONVERGENT = prove + (`!s:num->real^1. + bounded {s n | n IN (:num)} /\ (!n. drop(s n) <= drop(s(SUC n))) + ==> ?l. (s --> l) sequentially`, + GEN_TAC THEN + REWRITE_TAC[bounded; IN_ELIM_THM; ABS_DROP; LIM_SEQUENTIALLY; dist; + DROP_SUB; IN_UNIV; GSYM EXISTS_DROP] THEN + DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; + +let BOUNDED_DECREASING_CONVERGENT = prove + (`!s:num->real^1. + bounded {s n | n IN (:num)} /\ (!n. drop(s(SUC n)) <= drop(s(n))) + ==> ?l. (s --> l) sequentially`, + GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MP_TAC(ISPEC `\n. --((s:num->real^1) n)` BOUNDED_INCREASING_CONVERGENT) THEN + ASM_SIMP_TAC[bounded; FORALL_IN_GSPEC; NORM_NEG; DROP_NEG; REAL_LE_NEG2] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Since we'll use some cardinality reasoning, add invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let card_translation_invariants = (CONJUNCTS o prove) + (`(!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s =_c t <=> s =_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s =_c IMAGE (\x. a + x) t <=> s =_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s <_c t <=> s <_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s <_c IMAGE (\x. a + x) t <=> s <_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s <=_c t <=> s <=_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s <=_c IMAGE (\x. a + x) t <=> s <=_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s >_c t <=> s >_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s >_c IMAGE (\x. a + x) t <=> s >_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s >=_c t <=> s >=_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s >=_c IMAGE (\x. a + x) t <=> s >=_c t)`, + REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG] THEN + REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN + SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]) in +add_translation_invariants card_translation_invariants;; + +let card_linear_invariants = (CONJUNCTS o prove) + (`(!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s =_c t <=> s =_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s =_c IMAGE f t <=> s =_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s <_c t <=> s <_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s <_c IMAGE f t <=> s <_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s <=_c t <=> s <=_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s <=_c IMAGE f t <=> s <=_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s >_c t <=> s >_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s >_c IMAGE f t <=> s >_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s >=_c t <=> s >=_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s >=_c IMAGE f t <=> s >=_c t))`, + REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG] THEN + REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN + ASM_MESON_TAC[]) in +add_linear_invariants card_linear_invariants;; + +(* ------------------------------------------------------------------------- *) +(* Basic homeomorphism definitions. *) +(* ------------------------------------------------------------------------- *) + +let homeomorphism = new_definition + `homeomorphism (s,t) (f,g) <=> + (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\ + (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t`;; + +parse_as_infix("homeomorphic",(12,"right"));; + +let homeomorphic = new_definition + `s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)`;; + +let HOMEOMORPHISM = prove + (`!s:real^M->bool t:real^N->bool f g. + homeomorphism (s,t) (f,g) <=> + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + (!x. x IN s ==> g (f x) = x) /\ + (!y. y IN t ==> f (g y) = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN + EQ_TAC THEN SIMP_TAC[] THEN SET_TAC[]);; + +let HOMEOMORPHISM_OF_SUBSETS = prove + (`!f g s t s' t'. + homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ IMAGE f s' = t' + ==> homeomorphism (s',t') (f,g)`, + REWRITE_TAC[homeomorphism] THEN + REPEAT STRIP_TAC THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]);; + +let HOMEOMORPHISM_ID = prove + (`!s:real^N->bool. homeomorphism (s,s) ((\x. x),(\x. x))`, + REWRITE_TAC[homeomorphism; IMAGE_ID; CONTINUOUS_ON_ID]);; + +let HOMEOMORPHISM_I = prove + (`!s:real^N->bool. homeomorphism (s,s) (I,I)`, + REWRITE_TAC[I_DEF; HOMEOMORPHISM_ID]);; + +let HOMEOMORPHIC_REFL = prove + (`!s:real^N->bool. s homeomorphic s`, + REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_I]);; + +let HOMEOMORPHISM_SYM = prove + (`!f:real^M->real^N g s t. + homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)`, + REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_SYM = prove + (`!s t. s homeomorphic t <=> t homeomorphic s`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);; + +let HOMEOMORPHISM_COMPOSE = prove + (`!f:real^M->real^N g h:real^N->real^P k s t u. + homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k) + ==> homeomorphism (s,u) (h o f,g o k)`, + SIMP_TAC[homeomorphism; CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM] THEN + SET_TAC[]);; + +let HOMEOMORPHIC_TRANS = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u`, + REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]);; + +let HOMEOMORPHIC_IMP_CARD_EQ = prove + (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s =_c t`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism; eq_c] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let HOMEOMORPHIC_EMPTY = prove + (`(!s. (s:real^N->bool) homeomorphic ({}:real^M->bool) <=> s = {}) /\ + (!s. ({}:real^M->bool) homeomorphic (s:real^N->bool) <=> s = {})`, + REWRITE_TAC[homeomorphic; homeomorphism; IMAGE_CLAUSES; IMAGE_EQ_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[continuous_on; NOT_IN_EMPTY]);; + +let HOMEOMORPHIC_MINIMAL = prove + (`!s t. s homeomorphic t <=> + ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\ + (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\ + f continuous_on s /\ g continuous_on t`, + REWRITE_TAC[homeomorphic; homeomorphism; EXTENSION; IN_IMAGE] THEN + REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]);; + +let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s) homeomorphic s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; FORALL_IN_IMAGE; FUN_IN_IMAGE] THEN + ASM_SIMP_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e * B:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB] THEN + DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; + +let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o + MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN + EQ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]); + POP_ASSUM MP_TAC] THEN + REWRITE_TAC[IMP_IMP; HOMEOMORPHIC_TRANS]);; + +let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)`, + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);; + +add_linear_invariants + [HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; + HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];; + +let HOMEOMORPHIC_TRANSLATION_SELF = prove + (`!a:real^N s. (IMAGE (\x. a + x) s) homeomorphic s`, + REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `\x:real^N. x - a` THEN + EXISTS_TAC `\x:real^N. a + x` THEN + SIMP_TAC[FORALL_IN_IMAGE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD; VECTOR_ADD_SUB] THEN + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_TRANSLATION_LEFT_EQ = prove + (`!a:real^N s t. + (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t`, + MESON_TAC[HOMEOMORPHIC_TRANSLATION_SELF; + HOMEOMORPHIC_SYM; HOMEOMORPHIC_TRANS]);; + +let HOMEOMORPHIC_TRANSLATION_RIGHT_EQ = prove + (`!a:real^N s t. + s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t`, + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]);; + +add_translation_invariants + [HOMEOMORPHIC_TRANSLATION_LEFT_EQ; + HOMEOMORPHIC_TRANSLATION_RIGHT_EQ];; + +let HOMEOMORPHISM_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N g s t. + homeomorphism (s,t) (f,g) + ==> !u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN + STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_REFL]);; + +let HOMEOMORPHIC_PCROSS = prove + (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool. + s homeomorphic s' /\ t homeomorphic t' + ==> (s PCROSS t) homeomorphic (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `f:real^M->real^P` + (X_CHOOSE_THEN `f':real^P->real^M` STRIP_ASSUME_TAC)) + (X_CHOOSE_THEN `g:real^N->real^Q` + (X_CHOOSE_THEN `g':real^Q->real^N` STRIP_ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC + [`(\z. pastecart (f(fstcart z)) (g(sndcart z))) + :real^(M,N)finite_sum->real^(P,Q)finite_sum`; + `(\z. pastecart (f'(fstcart z)) (g'(sndcart z))) + :real^(P,Q)finite_sum->real^(M,N)finite_sum`] THEN + ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; + +let HOMEOMORPHIC_PCROSS_SYM = prove + (`!s:real^M->bool t:real^N->bool. (s PCROSS t) homeomorphic (t PCROSS s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN + EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) + :real^(M,N)finite_sum->real^(N,M)finite_sum` THEN + EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) + :real^(N,M)finite_sum->real^(M,N)finite_sum` THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART] THEN + REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; PASTECART_IN_PCROSS] THEN + MESON_TAC[]);; + +let HOMEOMORPHIC_PCROSS_ASSOC = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + (s PCROSS (t PCROSS u)) homeomorphic ((s PCROSS t) PCROSS u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + MAP_EVERY EXISTS_TAC + [`\z:real^(M,(N,P)finite_sum)finite_sum. + pastecart (pastecart (fstcart z) (fstcart(sndcart z))) + (sndcart(sndcart z))`; + `\z:real^((M,N)finite_sum,P)finite_sum. + pastecart (fstcart(fstcart z)) + (pastecart (sndcart(fstcart z)) (sndcart z))`] THEN + REWRITE_TAC[FORALL_IN_PCROSS; SUBSET; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN + CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN + TRY(GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC LINEAR_COMPOSE) THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let HOMEOMORPHIC_SCALING_LEFT = prove + (`!c. &0 < c + ==> !s t. (IMAGE (\x. c % x) s) homeomorphic t <=> s homeomorphic t`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; + +let HOMEOMORPHIC_SCALING_RIGHT = prove + (`!c. &0 < c + ==> !s t. s homeomorphic (IMAGE (\x. c % x) t) <=> s homeomorphic t`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; + +let HOMEOMORPHIC_SUBSPACES = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t /\ dim s = dim t ==> s homeomorphic t`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; + +let HOMEOMORPHIC_FINITE = prove + (`!s:real^M->bool t:real^N->bool. + FINITE s /\ FINITE t ==> (s homeomorphic t <=> CARD s = CARD t)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN + ASM_SIMP_TAC[CARD_EQ_CARD]; + STRIP_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] + CARD_EQ_BIJECTIONS) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_FINITE] THEN ASM SET_TAC[]]);; + +let HOMEOMORPHIC_FINITE_STRONG = prove + (`!s:real^M->bool t:real^N->bool. + FINITE s \/ FINITE t + ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ CARD s = CARD t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN + SIMP_TAC[HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP + HOMEOMORPHIC_IMP_CARD_EQ) THEN + FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);; + +let HOMEOMORPHIC_SING = prove + (`!a:real^M b:real^N. {a} homeomorphic {b}`, + SIMP_TAC[HOMEOMORPHIC_FINITE; FINITE_SING; CARD_SING]);; + +let HOMEOMORPHIC_PCROSS_SING = prove + (`(!s:real^M->bool a:real^N. s homeomorphic (s PCROSS {a})) /\ + (!s:real^M->bool a:real^N. s homeomorphic ({a} PCROSS s))`, + MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL + [MESON_TAC[HOMEOMORPHIC_PCROSS_SYM; HOMEOMORPHIC_TRANS]; ALL_TAC] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + EXISTS_TAC `\x. (pastecart x a:real^(M,N)finite_sum)` THEN + EXISTS_TAC `fstcart:real^(M,N)finite_sum->real^M` THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN + SIMP_TAC[FSTCART_PASTECART]);; + +(* ------------------------------------------------------------------------- *) +(* Inverse function property for open/closed maps. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_INVERSE_OPEN_MAP = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) + ==> g continuous_on t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] + CONTINUOUS_ON_OPEN_GEN) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + ASM SET_TAC[]);; + +let CONTINUOUS_ON_INVERSE_CLOSED_MAP = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) + ==> g continuous_on t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] + CONTINUOUS_ON_CLOSED_GEN) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]);; + +let HOMEOMORPHISM_INJECTIVE_OPEN_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) + ==> ?g. homeomorphism (s,t) (f,g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]);; + +let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) + ==> ?g. homeomorphism (s,t) (f,g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);; + +let HOMEOMORPHISM_IMP_OPEN_MAP = prove + (`!f:real^M->real^N g s t u. + homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)`, + REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = + {y | y IN t /\ g(y) IN u}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHISM_IMP_CLOSED_MAP = prove + (`!f:real^M->real^N g s t u. + homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)`, + REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = + {y | y IN t /\ g(y) IN u}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((?g. homeomorphism (s,t) (f,g)) <=> + !u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((?g. homeomorphism (s,t) (f,g)) <=> + !u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN + ASM_REWRITE_TAC[]]);; + +let INJECTIVE_MAP_OPEN_IFF_CLOSED = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `?g:real^N->real^M. homeomorphism (s,t) (f,g)` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; + MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Relatively weak hypotheses if the domain of the function is compact. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_IMP_CLOSED_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s + ==> !u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)`, + SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN + EXPAND_TAC "t" THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; + BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]);; + +let CONTINUOUS_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s + ==> !u. u SUBSET t + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP THEN + ASM_REWRITE_TAC[]);; + +let CONTINUOUS_ON_INVERSE = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x)) + ==> g continuous_on (IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN + SUBGOAL_THEN `IMAGE g (IMAGE (f:real^M->real^N) s) = s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; + BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET]]);; + +let HOMEOMORPHISM_COMPACT = prove + (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> ?g. homeomorphism(s,t) (f,g)`, + REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[EXTENSION; homeomorphism] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[CONTINUOUS_ON_INVERSE; IN_IMAGE]);; + +let HOMEOMORPHIC_COMPACT = prove + (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> s homeomorphic t`, + REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPACT]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about composition of homeomorphisms. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (?h. homeomorphism (s,u) (g o f,h)) + ==> (?f'. homeomorphism (s,t) (f,f')) /\ + (?g'. homeomorphism (t,u) (g,g'))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[homeomorphism; o_THM]; + REWRITE_TAC[homeomorphism; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g':real^P->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(h:real^P->real^M) o (g:real^N->real^P)` THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; + +let HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ + (?h. homeomorphism (s,u) (g o f,h)) + ==> (?f'. homeomorphism (s,t) (f,f')) /\ + (?g'. homeomorphism (t,u) (g,g'))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN + MAP_EVERY EXISTS_TAC [`g:real^N->real^P`; `u:real^P->bool`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[homeomorphism; o_THM]; + REWRITE_TAC[homeomorphism; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:real^M->real^N) o (h:real^P->real^M)` THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of topological properties. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_COMPACTNESS = prove + (`!s t. s homeomorphic t ==> (compact s <=> compact t)`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN + MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);; + +let HOMEOMORPHIC_CONNECTEDNESS = prove + (`!s t. s homeomorphic t ==> (connected s <=> connected t)`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN + MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Results on translation, scaling etc. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_SCALING = prove + (`!s:real^N->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MAP_EVERY EXISTS_TAC [`\x:real^N. c % x`; `\x:real^N. inv(c) % x`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN + SIMP_TAC[VECTOR_MUL_LID; IN_IMAGE; REAL_MUL_LID] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_TRANSLATION = prove + (`!s a:real^N. s homeomorphic (IMAGE (\x. a + x) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MAP_EVERY EXISTS_TAC [`\x:real^N. a + x`; `\x:real^N. --a + x`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + SIMP_TAC[VECTOR_ADD_ASSOC; VECTOR_ADD_LINV; VECTOR_ADD_RINV; + FORALL_IN_IMAGE; VECTOR_ADD_LID] THEN + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_AFFINITY = prove + (`!s a:real^N c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_TRANS THEN + EXISTS_TAC `IMAGE (\x:real^N. c % x) s` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_SCALING] THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_o; HOMEOMORPHIC_TRANSLATION]);; + +let [HOMEOMORPHIC_BALLS; HOMEOMORPHIC_CBALLS; HOMEOMORPHIC_SPHERES] = + (CONJUNCTS o prove) + (`(!a:real^N b:real^N d e. + &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\ + (!a:real^N b:real^N d e. + &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\ + (!a:real^N b:real^N d e. + &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `\x:real^N. b + (e / d) % (x - a)` THEN + EXISTS_TAC `\x:real^N. a + (d / e) % (x - b)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IN_BALL; IN_CBALL; IN_SPHERE] THEN + REWRITE_TAC[dist; VECTOR_ARITH `a - (a + b) = --b:real^N`; NORM_NEG] THEN + REWRITE_TAC[real_div; VECTOR_ARITH + `a + d % ((b + e % (x - a)) - b) = (&1 - d * e) % a + (d * e) % x`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(e * d') * (d * e') = (d * d') * (e * e')`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_SUB_REFL] THEN + REWRITE_TAC[NORM_MUL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH + `&0 < x ==> (abs x = x)`] THEN + GEN_REWRITE_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV) + [GSYM REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID; + GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_SUB] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphism of one-point compactifications. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS = prove + (`!s:real^M->bool t:real^N->bool a b. + compact s /\ compact t /\ a IN s /\ b IN t /\ + (s DELETE a) homeomorphic (t DELETE b) + ==> s homeomorphic t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x. if x = a then b else (f:real^M->real^N) x` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^M = a` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`b:real^N`; `e:real`] CENTRE_IN_BALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean s) + { x | x IN (s DELETE a) /\ + (f:real^M->real^N)(x) IN t DIFF ball(b,e)}` + MP_TAC THENL + [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN + `{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} = + IMAGE (g:real^N->real^M) (t DIFF ball (b,e))` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[COMPACT_DIFF; OPEN_BALL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + REWRITE_TAC[closed_in; open_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M` o last o CONJUNCTS) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF; IN_DELETE] THEN + SIMP_TAC[IMP_CONJ; DE_MORGAN_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM SET_TAC[]]; + UNDISCH_TAC `(f:real^M->real^N) continuous_on (s DELETE a)` THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN + REWRITE_TAC[continuous_within] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (dist(a:real^M,x))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ] THEN + ASM_MESON_TAC[REAL_LT_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphisms between open intervals in real^1 and then in real^N. *) +(* Could prove similar things for closed intervals, but they drop out of *) +(* later stuff in "convex.ml" even more easily. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_OPEN_INTERVALS_1 = prove + (`!a b c d. + drop a < drop b /\ drop c < drop d + ==> interval(a,b) homeomorphic interval(c,d)`, + SUBGOAL_THEN + `!a b. drop a < drop b + ==> interval(vec 0:real^1,vec 1) homeomorphic interval(a,b)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `(\x. a + drop x % (b - a)):real^1->real^1` THEN + EXISTS_TAC `(\x. inv(drop b - drop a) % (x - a)):real^1->real^1` THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; DROP_SUB] THEN + REWRITE_TAC[REAL_ARITH `inv b * a:real = a / b`] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT; + REAL_LT_ADDR; REAL_EQ_LDIV_EQ; REAL_DIV_RMUL; REAL_LT_IMP_NZ; + REAL_LT_MUL; REAL_MUL_LZERO; REAL_ADD_SUB; REAL_LT_RMUL_EQ; + REAL_ARITH `a + x < b <=> x < &1 * (b - a)`] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `d:real^1`]) THEN + ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_TRANS]]);; + +let HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1 = prove + (`!a b. drop a < drop b ==> interval(a,b) homeomorphic (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real^1`; `b:real^1`; `--vec 1:real^1`; `vec 1:real^1`] + HOMEOMORPHIC_OPEN_INTERVALS_1) THEN + ASM_REWRITE_TAC[DROP_VEC; DROP_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_UNIV] THEN + EXISTS_TAC `\x:real^1. inv(&1 - norm x) % x` THEN + EXISTS_TAC `\y. if &0 <= drop y then inv(&1 + drop y) % y + else inv(&1 - drop y) % y` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_NEG; DROP_VEC; DROP_CMUL; NORM_REAL; GSYM drop] THEN + SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LE_MUL_EQ; REAL_ARITH + `--a < x /\ x < a ==> &0 < a - abs x`] THEN + SIMP_TAC[real_abs; VECTOR_MUL_ASSOC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^1` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; REAL_BOUNDS_LT] THEN + REWRITE_TAC[DROP_CMUL; REAL_ABS_MUL; REAL_ABS_INV] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < abs(&1 + x)`; + REAL_ARITH `~(&0 <= x) ==> &0 < abs(&1 - x)`] THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[NORM_REAL; VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[GSYM drop; DROP_CMUL; REAL_ABS_MUL] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_INV_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 <= &1 + x`; + REAL_ARITH `~(&0 <= x) ==> &0 <= &1 - x`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC] THEN + DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[CONTINUOUS_AT_ID] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN + REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_SUB; LIFT_DROP] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_SUB THEN + SIMP_TAC[CONTINUOUS_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]; + REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `(:real^1) = {x | x$1 >= &0} UNION {x | x$1 <= &0}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE; + IN_ELIM_THM] THEN + REWRITE_TAC[GSYM drop; REAL_NOT_LE; real_ge; REAL_LET_ANTISYM] THEN + SIMP_TAC[REAL_LE_ANTISYM; REAL_SUB_RZERO; REAL_ADD_RID] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN + DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[CONTINUOUS_AT_ID] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN + REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_ADD; LIFT_SUB; LIFT_DROP] THEN + ASM_SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_SUB; + CONTINUOUS_CONST] THEN + ASM_REAL_ARITH_TAC]]);; + +let HOMEOMORPHIC_OPEN_INTERVALS = prove + (`!a b:real^N c d:real^N. + (interval(a,b) = {} <=> interval(c,d) = {}) + ==> interval(a,b) homeomorphic interval(c,d)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(c:real^N,d) = {}` THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic + interval(lift((c:real^N)$i),lift((d:real^N)$i))` + MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVALS_1; LIFT_DROP]; + ALL_TAC] THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN + DISCH_TAC THEN + EXISTS_TAC + `(\x. lambda i. + drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + EXISTS_TAC + `(\x. lambda i. + drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP] THEN + ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL + [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; + EXISTS_TAC `interval(lift((c:real^N)$i),lift((d:real^N)$i))`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; + +let HOMEOMORPHIC_OPEN_INTERVAL_UNIV = prove + (`!a b:real^N. + ~(interval(a,b) = {}) + ==> interval(a,b) homeomorphic (:real^N)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic + (:real^1)` + MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; LIFT_DROP]; + ALL_TAC] THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN + DISCH_TAC THEN + EXISTS_TAC + `(\x. lambda i. + drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + EXISTS_TAC + `(\x. lambda i. + drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP; IN_UNIV] THEN + ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL + [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; + EXISTS_TAC `(:real^1)`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; IN_UNIV] THEN + ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; + +let HOMEOMORPHIC_BALL_UNIV = prove + (`!a:real^N r. &0 < r ==> ball(a,r) homeomorphic (:real^N)`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?y:real^N. r = norm(y)` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_LT_IMP_LE]; POP_ASSUM MP_TAC] THEN + REWRITE_TAC[NORM_POS_LT] THEN GEOM_NORMALIZE_TAC `y:real^N` THEN + SIMP_TAC[] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `\z:real^N. inv(&1 - norm(z)) % z` THEN + EXISTS_TAC `\z:real^N. inv(&1 + norm(z)) % z` THEN + REWRITE_TAC[IN_BALL; IN_UNIV; DIST_0; VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0; + VECTOR_ARITH `a % x:real^N = x <=> (a - &1) % x = vec 0`] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ1_TAC THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> abs(&1 - x) = &1 - x`] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH + `&0 <= y ==> inv(abs(&1 + y)) * z = z / (&1 + y)`] THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_LDIV_EQ; REAL_ARITH + `&0 <= y ==> &0 < &1 + y`] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; DISJ1_TAC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN + MP_TAC(ISPEC `y:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_INV THEN + SIMP_TAC[IN_BALL_0; REAL_SUB_0; REAL_ARITH `x < &1 ==> ~(&1 = x)`] THEN + REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_INV THEN + SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`] THEN + REWRITE_TAC[o_DEF; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinalities of various useful sets. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_EUCLIDEAN = prove + (`(:real^N) =_c (:real)`, + MATCH_MP_TAC CARD_EQ_CART THEN REWRITE_TAC[real_INFINITE]);; + +let UNCOUNTABLE_EUCLIDEAN = prove + (`~COUNTABLE(:real^N)`, + MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]);; + +let CARD_EQ_INTERVAL = prove + (`(!a b:real^N. ~(interval(a,b) = {}) ==> interval[a,b] =_c (:real)) /\ + (!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) =_c (:real))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + TRANS_TAC CARD_LE_TRANS `interval(a:real^N,b)` THEN + SIMP_TAC[CARD_LE_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; + TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE; + CARD_EQ_EUCLIDEAN] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN + MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);; + +let UNCOUNTABLE_INTERVAL = prove + (`(!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\ + (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))`, + SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_INTERVAL]);; + +let COUNTABLE_OPEN_INTERVAL = prove + (`!a b. COUNTABLE(interval(a,b)) <=> interval(a,b) = {}`, + MESON_TAC[COUNTABLE_EMPTY; UNCOUNTABLE_INTERVAL]);; + +let CARD_EQ_OPEN = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> s =_c (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `interval[a:real^N,b]` THEN + ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_INTERVAL]]);; + +let UNCOUNTABLE_OPEN = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)`, + SIMP_TAC[CARD_EQ_OPEN; CARD_EQ_REAL_IMP_UNCOUNTABLE]);; + +let CARD_EQ_BALL = prove + (`!a:real^N r. &0 < r ==> ball(a,r) =_c (:real)`, + SIMP_TAC[CARD_EQ_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT]);; + +let CARD_EQ_CBALL = prove + (`!a:real^N r. &0 < r ==> cball(a,r) =_c (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + TRANS_TAC CARD_LE_TRANS `ball(a:real^N,r)` THEN + SIMP_TAC[CARD_LE_SUBSET; BALL_SUBSET_CBALL] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_BALL]]);; + +let FINITE_IMP_NOT_OPEN = prove + (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ~(open s)`, + MESON_TAC[UNCOUNTABLE_OPEN; FINITE_IMP_COUNTABLE]);; + +let OPEN_IMP_INFINITE = prove + (`!s. open s ==> s = {} \/ INFINITE s`, + MESON_TAC[FINITE_IMP_NOT_OPEN; INFINITE]);; + +let EMPTY_INTERIOR_FINITE = prove + (`!s:real^N->bool. FINITE s ==> interior s = {}`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_INTERIOR) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN) THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[INTERIOR_SUBSET]);; + +let CARD_EQ_CONNECTED = prove + (`!s a b:real^N. + connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, + GEOM_ORIGIN_TAC `b:real^N` THEN GEOM_NORMALIZE_TAC `a:real^N` THEN + REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE]; + TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN + SIMP_TAC[UNIT_INTERVAL_NONEMPTY; CARD_EQ_INTERVAL]; + REWRITE_TAC[LE_C] THEN EXISTS_TAC `\x:real^N. lift(a dot x)` THEN + SIMP_TAC[FORALL_LIFT; LIFT_EQ; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real^N`] THEN + ASM_REWRITE_TAC[DOT_RZERO]]]);; + +let UNCOUNTABLE_CONNECTED = prove + (`!s a b:real^N. + connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN + MATCH_MP_TAC CARD_EQ_CONNECTED THEN + ASM_MESON_TAC[]);; + +let CARD_LT_IMP_DISCONNECTED = prove + (`!s x:real^N. s <_c (:real) /\ x IN s ==> connected_component s x = {x}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE + `s = {a} <=> a IN s /\ !a b. a IN s /\ b IN s /\ ~(a = b) ==> F`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + MP_TAC(ISPECL [`connected_component s (x:real^N)`; `a:real^N`; `b:real^N`] + CARD_EQ_CONNECTED) THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) <_c (:real)` THEN + REWRITE_TAC[CARD_NOT_LT] THEN + TRANS_TAC CARD_LE_TRANS `connected_component s (x:real^N)` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE] THEN + MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; + +let COUNTABLE_IMP_DISCONNECTED = prove + (`!s x:real^N. COUNTABLE s /\ x IN s ==> connected_component s x = {x}`, + SIMP_TAC[CARD_LT_IMP_DISCONNECTED; COUNTABLE_IMP_CARD_LT_REAL]);; + +let CONNECTED_CARD_EQ_IFF_NONTRIVIAL = prove + (`!s:real^N->bool. + connected s ==> (s =_c (:real) <=> ~(?a. s SUBSET {a}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ALL_TAC; MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN + REWRITE_TAC[FINITE_SING] THEN + ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_IMP_COUNTABLE]);; + +(* ------------------------------------------------------------------------- *) +(* "Iff" forms of constancy of function from connected set into a set that *) +(* is smaller than R, or countable, or finite, or disconnected, or discrete. *) +(* ------------------------------------------------------------------------- *) + +let [CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; + CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; + CONTINUOUS_FINITE_RANGE_CONSTANT_EQ] = (CONJUNCTS o prove) + (`(!s. connected s <=> + !f:real^M->real^N t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!y. y IN t ==> connected_component t y = {y}) + ==> ?a. !x. x IN s ==> f x = a) /\ + (!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ + (!x. x IN s + ==> ?e. &0 < e /\ + !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) + ==> ?a. !x. x IN s ==> f x = a) /\ + (!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ FINITE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a)`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^M->bool` THEN + MATCH_MP_TAC(TAUT + `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s) + ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^M` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `(f:real^M->real^N) x` THEN + MATCH_MP_TAC(SET_RULE + `IMAGE f s SUBSET {a} ==> !y. y IN s ==> f y = a`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN ASM SET_TAC[]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_REFL] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> f y = a) /\ + connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\ + connected_component (IMAGE f s) a a + ==> connected_component (IMAGE f s) a = {a}`) THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_SIMP_TAC[FUN_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MP_TAC(ISPEC `connected_component (IMAGE (f:real^M->real^N) s) (f x)` + CONNECTED_CLOSED) THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`cball((f:real^M->real^N) x,e / &2)`; + `(:real^N) DIFF ball((f:real^M->real^N) x,e)`] THEN + REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; CLOSED_CBALL] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_CBALL; IN_UNION; IN_DIFF; IN_BALL; IN_UNIV] THEN + MATCH_MP_TAC(MESON[SUBSET; CONNECTED_COMPONENT_SUBSET] + `(!x. x IN s ==> P x) + ==> (!x. x IN connected_component s y ==> P x)`) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; + MATCH_MP_TAC(SET_RULE + `(!x. x IN s /\ x IN t ==> F) ==> s INTER t INTER u = {}`) THEN + REWRITE_TAC[IN_BALL; IN_CBALL; IN_DIFF; IN_UNIV] THEN + UNDISCH_TAC `&0 < e` THEN CONV_TAC NORM_ARITH; + EXISTS_TAC `(f:real^M->real^N) x` THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_HALF; REAL_LT_IMP_LE; IN_INTER] THEN + REWRITE_TAC[IN] THEN + ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL_EQ; FUN_IN_IMAGE]; + EXISTS_TAC `(f:real^M->real^N) y` THEN + ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist]]; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MATCH_MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `IMAGE (f:real^M->real^N) s DELETE (f x) = {}` THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; + ALL_TAC] THEN + EXISTS_TAC + `inf{norm(z - f x) |z| z IN IMAGE (f:real^M->real^N) s DELETE (f x)}` THEN + REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_DELETE; + FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_DELETE; NORM_POS_LT; VECTOR_SUB_EQ; IN_IMAGE] THEN + MESON_TAC[REAL_LE_REFL]; + REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC + `(\x. if x IN t then vec 0 else basis 1):real^M->real^N`) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^N,basis 1}` THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[]; + SUBGOAL_THEN `?a b:real^M. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)` + STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN MP_TAC)] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^M` th) THEN + MP_TAC(SPEC `b:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_LE_REFL]]]);; + +let CONTINUOUS_DISCONNECTED_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!y. y IN t ==> connected_component t y = {y}) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_DISCRETE_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ + f continuous_on s /\ + (!x. x IN s + ==> ?e. &0 < e /\ + !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) + ==> ?a. !x. x IN s ==> f x = a`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + REWRITE_TAC[IMP_IMP; GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_FINITE_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ + f continuous_on s /\ + FINITE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ = prove + (`!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ COUNTABLE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; + REWRITE_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[COUNTABLE_IMP_DISCONNECTED; SUBSET_REFL]);; + +let CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ = prove + (`!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ (IMAGE f s) <_c (:real) + ==> ?a. !x. x IN s ==> f x = a`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; + REWRITE_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[CARD_LT_IMP_DISCONNECTED; SUBSET_REFL]);; + +let CONTINUOUS_COUNTABLE_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ f continuous_on s /\ COUNTABLE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_CARD_LT_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ f continuous_on s /\ (IMAGE f s) <_c (:real) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphism of hyperplanes. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_HYPERPLANES = prove + (`!a:real^N b c:real^N d. + ~(a = vec 0) /\ ~(c = vec 0) + ==> {x | a dot x = b} homeomorphic {x | c dot x = d}`, + let lemma = prove + (`~(a = vec 0) + ==> {x:real^N | a dot x = b} homeomorphic {x:real^N | x$1 = &0}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. a dot c = b` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b / (a:real^N)$k % basis k:real^N` THEN + ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; REAL_DIV_RMUL]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ABBREV_TAC `p = {x:real^N | x$1 = &0}` THEN + GEOM_ORIGIN_TAC `c:real^N` THEN + REWRITE_TAC[VECTOR_ADD_RID; DOT_RADD; DOT_RZERO; REAL_EQ_ADD_LCANCEL_0; + REAL_ADD_RID] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN + SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_ENTIRE] THEN + SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + EXPAND_TAC "p" THEN REWRITE_TAC[HOMEOMORPHIC_REFL]]) in + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0}` THEN + ASM_SIMP_TAC[lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + ASM_SIMP_TAC[lemma]);; + +let HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE = prove + (`!a:real^N b k c. + ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) + ==> {x | a dot x = b} homeomorphic {x:real^N | x$k = c}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x:real^N | x$k = c} = {x | basis k dot x = c}` SUBST1_TAC + THENL [ASM_SIMP_TAC[DOT_BASIS]; MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN + ASM_SIMP_TAC[BASIS_NONZERO]);; + +let HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE = prove + (`!a:real^N b k c. + ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) + ==> {x:real^N | x$k = c} homeomorphic {x | a dot x = b}`, + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]);; + +let HOMEOMORPHIC_HYPERPLANE_UNIV = prove + (`!a b. ~(a = vec 0) /\ dimindex(:N) = dimindex(:M) + 1 + ==> {x:real^N | a dot x = b} homeomorphic (:real^M)`, + REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS + `{x:real^N | basis(dimindex(:N)) dot x = &0}` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANES; BASIS_NONZERO; + LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN + EXISTS_TAC `(\x. lambda i. if i <= dimindex(:M) then x$i else &0) + :real^M->real^N` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]; + REWRITE_TAC[SUBSET_UNIV]; + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + ASM_SIMP_TAC[DOT_BASIS; LAMBDA_BETA; LE_REFL; ARITH_RULE `1 <= n + 1`; + ARITH_RULE `~(m + 1 <= m)`]; + ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; LE_REFL; CART_EQ; + ARITH_RULE `1 <= n + 1`] THEN + GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `i = dimindex(:M) + 1` THEN ASM_REWRITE_TAC[COND_ID] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; IN_UNIV; LE_REFL; + ARITH_RULE `i <= n ==> i <= n + 1`]]);; + +(* ------------------------------------------------------------------------- *) +(* "Isometry" (up to constant bounds) of injective linear map etc. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_ISOMETRIC = prove + (`!f s e x. + &0 < e /\ subspace s /\ + linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ + (!n. x(n) IN s) /\ cauchy(f o x) + ==> cauchy x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[CAUCHY; dist; o_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN + DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `d * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_MUL_SYM; REAL_LET_TRANS; SUBSPACE_SUB; + REAL_LT_LDIV_EQ]);; + +let COMPLETE_ISOMETRIC_IMAGE = prove + (`!f:real^M->real^N s e. + &0 < e /\ subspace s /\ + linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ + complete s + ==> complete(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[complete; EXISTS_IN_IMAGE] THEN + STRIP_TAC THEN X_GEN_TAC `g:num->real^N` THEN + REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN + REWRITE_TAC[GSYM o_DEF] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN + ASM_MESON_TAC[CAUCHY_ISOMETRIC; LINEAR_CONTINUOUS_AT; + CONTINUOUS_AT_SEQUENTIALLY]);; + +let INJECTIVE_IMP_ISOMETRIC = prove + (`!f:real^M->real^N s. + closed s /\ subspace s /\ + linear f /\ (!x. x IN s /\ (f x = vec 0) ==> (x = vec 0)) + ==> ?e. &0 < e /\ !x. x IN s ==> norm(f x) >= e * norm(x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s SUBSET {vec 0 :real^M}` THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; real_ge] THEN + ASM_MESON_TAC[SUBSET; IN_SING; NORM_0; LINEAR_0; REAL_LE_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`{(f:real^M->real^N) x | x IN s /\ norm(x) = norm(a:real^M)}`; + `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + SUBST1_TAC(SET_RULE + `{f x | x IN s /\ norm(x) = norm(a:real^M)} = + IMAGE (f:real^M->real^N) (s INTER {x | norm x = norm a})`) THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real^M | norm x = norm(a:real^M)} = frontier(cball(vec 0,norm a))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[FRONTIER_CBALL; NORM_POS_LT; dist; VECTOR_SUB_LZERO; + NORM_NEG; sphere]; + ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL]]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M` MP_TAC) THEN + REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG] THEN + STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN + EXISTS_TAC `norm((f:real^M->real^N) b) / norm(b)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LT_DIV; NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^M = vec 0` THENL + [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN + REWRITE_TAC[NORM_0; REAL_MUL_RZERO; real_ge; REAL_LE_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(norm(a:real^M) / norm(x)) % x:real^M`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_MESON_TAC[subspace]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN + ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; real_ge] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT] THEN + REWRITE_TAC[real_div; REAL_MUL_AC]);; + +let CLOSED_INJECTIVE_IMAGE_SUBSPACE = prove + (`!f s. subspace s /\ + linear f /\ + (!x. x IN s /\ f(x) = vec 0 ==> x = vec 0) /\ + closed s + ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN + MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN + ASM_REWRITE_TAC[COMPLETE_EQ_CLOSED] THEN + MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Relating linear images to open/closed/interior/closure. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!y. ?x. f x = y) + ==> !s. open s ==> open(IMAGE f s)`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(MP_TAC o GEN `k:num` o SPEC `basis k:real^N`) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `bounded(IMAGE (b:num->real^M) (1..dimindex(:N)))` MP_TAC THENL + [SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / B / &(dimindex(:N))` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + ABBREV_TAC `u = y - (f:real^M->real^N) x` THEN + EXISTS_TAC `x + vsum(1..dimindex(:N)) (\i. (u:real^N)$i % b i):real^M` THEN + ASM_SIMP_TAC[LINEAR_ADD; LINEAR_VSUM; FINITE_NUMSEG; o_DEF; + LINEAR_CMUL; BASIS_EXPANSION] THEN + CONJ_TAC THENL [EXPAND_TAC "u" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NORM_ARITH `dist(x + y,x) = norm y`] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(dist(y,(f:real^M->real^N) x) * &(dimindex(:N))) * B` THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN + MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN + GEN_REWRITE_TAC(RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; dist] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]);; + +let OPEN_BIJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> (open(IMAGE f s) <=> open s)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC; ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN + SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; + +add_linear_invariants [OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];; + +let CLOSED_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> !s. closed s ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (:real^M)` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) (:real^M)`; + `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s)`] + CONTINUOUS_CLOSED_IN_PREIMAGE) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_I]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + REWRITE_TAC[EXTENSION; o_THM; I_THM] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN + ASM_REWRITE_TAC[IN_UNIV; SUBSPACE_UNIV; CLOSED_UNIV] THEN + X_GEN_TAC `x:real^M` THEN + DISCH_THEN(MP_TAC o AP_TERM `g:real^N->real^M`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM]) THEN + ASM_MESON_TAC[LINEAR_0]]);; + +let CLOSED_INJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (closed(IMAGE f s) <=> closed s)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC; ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN + SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; + +add_linear_invariants [CLOSED_INJECTIVE_LINEAR_IMAGE_EQ];; + +let CLOSURE_LINEAR_IMAGE_SUBSET = prove + (`!f:real^M->real^N s. + linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN + ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; LINEAR_CONTINUOUS_ON]);; + +let CLOSURE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN + ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE; CLOSED_CLOSURE]);; + +add_linear_invariants [CLOSURE_INJECTIVE_LINEAR_IMAGE];; + +let CLOSURE_BOUNDED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ bounded s + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE]);; + +let LINEAR_INTERIOR_IMAGE_SUBSET = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, + MESON_TAC[INTERIOR_IMAGE_SUBSET; LINEAR_CONTINUOUS_AT]);; + +let LINEAR_IMAGE_SUBSET_INTERIOR = prove + (`!f:real^M->real^N s. + linear f /\ (!y. ?x. f x = y) + ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN + ASM_SIMP_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE; OPEN_INTERIOR; + IMAGE_SUBSET; INTERIOR_SUBSET]);; + +let INTERIOR_BIJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> interior(IMAGE f s) = IMAGE f (interior s)`, + REWRITE_TAC[interior] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [INTERIOR_BIJECTIVE_LINEAR_IMAGE];; + +let FRONTIER_BIJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, + REWRITE_TAC[frontier] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [FRONTIER_BIJECTIVE_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Corollaries, reformulations and special cases for M = N. *) +(* ------------------------------------------------------------------------- *) + +let IN_INTERIOR_LINEAR_IMAGE = prove + (`!f:real^M->real^N g s x. + linear f /\ linear g /\ (f o g = I) /\ x IN interior s + ==> (f x) IN interior (IMAGE f s)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] + LINEAR_IMAGE_SUBSET_INTERIOR) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[]);; + +let LINEAR_OPEN_MAPPING = prove + (`!f:real^M->real^N g. + linear f /\ linear g /\ (f o g = I) + ==> !s. open s ==> open(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[]);; + +let INTERIOR_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> interior(IMAGE f s) = IMAGE f (interior s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; + +let INTERIOR_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!y. ?x. f x = y) + ==> interior(IMAGE f s) = IMAGE f (interior s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let CLOSURE_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!y. ?x. f x = y) + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let FRONTIER_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; + +let FRONTIER_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N. + linear f /\ (!y. ?x. f x = y) + ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let COMPLETE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> !s. complete s ==> complete(IMAGE f s)`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE]);; + +let COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (complete(IMAGE f s) <=> complete s)`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ];; + +let LIMPT_INJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)`, + REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THENL + [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS); + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `e * B:real`); + FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`)] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; dist; GSYM LINEAR_SUB] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; + +add_linear_invariants [LIMPT_INJECTIVE_LINEAR_IMAGE_EQ];; + +let LIMPT_TRANSLATION_EQ = prove + (`!a s x. (a + x) limit_point_of (IMAGE (\y. a + y) s) <=> x limit_point_of s`, + REWRITE_TAC[limit_point_of] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [LIMPT_TRANSLATION_EQ];; + +let OPEN_OPEN_LEFT_PROJECTION = prove + (`!s t:real^(M,N)finite_sum->bool. + open s /\ open t ==> open {x | x IN s /\ ?y. pastecart x y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ ?y. (pastecart x y:real^(M,N)finite_sum) IN t} = + s INTER IMAGE fstcart t` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN + MESON_TAC[FSTCART_PASTECART; PASTECART_FST_SND]; + MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] + OPEN_SURJECTIVE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART] THEN MESON_TAC[FSTCART_PASTECART]]);; + +let OPEN_OPEN_RIGHT_PROJECTION = prove + (`!s t:real^(M,N)finite_sum->bool. + open s /\ open t ==> open {y | y IN s /\ ?x. pastecart x y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{y | y IN s /\ ?x. (pastecart x y:real^(M,N)finite_sum) IN t} = + s INTER IMAGE sndcart t` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN + MESON_TAC[SNDCART_PASTECART; PASTECART_FST_SND]; + MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] + OPEN_SURJECTIVE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART] THEN MESON_TAC[SNDCART_PASTECART]]);; + +(* ------------------------------------------------------------------------- *) +(* Even more special cases. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_NEGATIONS = prove + (`!s. interior(IMAGE (--) s) = IMAGE (--) (interior s)`, + GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let SYMMETRIC_INTERIOR = prove + (`!s:real^N->bool. + (!x. x IN s ==> --x IN s) + ==> !x. x IN interior s ==> (--x) IN interior s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN + REWRITE_TAC[GSYM INTERIOR_NEGATIONS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; + +let CLOSURE_NEGATIONS = prove + (`!s. closure(IMAGE (--) s) = IMAGE (--) (closure s)`, + GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let SYMMETRIC_CLOSURE = prove + (`!s:real^N->bool. + (!x. x IN s ==> --x IN s) + ==> !x. x IN closure s ==> (--x) IN closure s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN + REWRITE_TAC[GSYM CLOSURE_NEGATIONS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Some properties of a canonical subspace. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_SUBSTANDARD = prove + (`!d. subspace + {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, + GEN_TAC THEN ASM_CASES_TAC `d <= dimindex(:N)` THENL + [MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN + SIMP_TAC[subspace; IN_ELIM_THM; REAL_MUL_RZERO; REAL_ADD_LID; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT]; + ASM_SIMP_TAC[ARITH_RULE `~(d:num <= e) ==> (d < i /\ i <= e <=> F)`] THEN + REWRITE_TAC[SET_RULE `{x | T} = UNIV`; SUBSPACE_UNIV]]);; + +let CLOSED_SUBSTANDARD = prove + (`!d. closed + {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, + GEN_TAC THEN + SUBGOAL_THEN + `{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} = + INTERS {{x | basis i dot x = &0} | d < i /\ i <= dimindex(:N)}` + SUBST1_TAC THENL + [ALL_TAC; + SIMP_TAC[CLOSED_INTERS; CLOSED_HYPERPLANE; IN_ELIM_THM; + LEFT_IMP_EXISTS_THM]] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN + SIMP_TAC[DOT_BASIS] THEN MESON_TAC[]);; + +let DIM_SUBSTANDARD = prove + (`!d. d <= dimindex(:N) + ==> (dim {x:real^N | !i. d < i /\ i <= dimindex(:N) + ==> x$i = &0} = + d)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `IMAGE (basis:num->real^N) (1..d)` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + MESON_TAC[BASIS_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`; NOT_LT]; + ALL_TAC; + MATCH_MP_TAC INDEPENDENT_MONO THEN + EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN + REWRITE_TAC[INDEPENDENT_STDBASIS]THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + ASM_MESON_TAC[LE_TRANS]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN + REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS; BASIS_INJ]] THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`; SPAN_STDBASIS] THEN + SUBGOAL_THEN `IMAGE basis (1 .. 0) :real^N->bool = {}` SUBST1_TAC THENL + [REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; ARITH]; ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[SPAN_EMPTY; SUBSET; IN_ELIM_THM; IN_SING] THEN + SIMP_TAC[CART_EQ; VEC_COMPONENT]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x - (x$(SUC d)) % basis(SUC d) :real^N`) THEN + ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `d < i ==> 1 <= i`)) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN + ASM_MESON_TAC[ARITH_RULE `d < i /\ ~(i = SUC d) ==> SUC d < i`]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBST1_TAC(VECTOR_ARITH + `x = (x - (x$(SUC d)) % basis(SUC d)) + + x$(SUC d) % basis(SUC d) :real^N`) THEN + MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_MONO; SUBSET_IMAGE; SUBSET; SUBSET_NUMSEG; LE_REFL; LE]; + MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN + MESON_TAC[LE_REFL; ARITH_RULE `1 <= SUC d`]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence closure and completeness of all subspaces. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_SUBSPACE = prove + (`!s:real^N->bool. subspace s ==> closed s`, + REPEAT STRIP_TAC THEN ABBREV_TAC `d = dim(s:real^N->bool)` THEN + MP_TAC(MATCH_MP DIM_SUBSTANDARD + (ISPEC `s:real^N->bool` DIM_SUBSET_UNIV)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`{x:real^N | !i. d < i /\ i <= dimindex(:N) + ==> x$i = &0}`; + `s:real^N->bool`] SUBSPACE_ISOMORPHISM) THEN + ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(ISPEC `f:real^N->real^N` CLOSED_INJECTIVE_IMAGE_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD; CLOSED_SUBSTANDARD] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VEC_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`]);; + +let COMPLETE_SUBSPACE = prove + (`!s:real^N->bool. subspace s ==> complete s`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_SUBSPACE]);; + +let CLOSED_SPAN = prove + (`!s. closed(span s)`, + SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]);; + +let DIM_CLOSURE = prove + (`!s:real^N->bool. dim(closure s) = dim s`, + GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN]; ALL_TAC] THEN + MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN; SPAN_INC]);; + +let CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + closed s /\ f continuous_on s /\ + (!e. bounded {x | x IN s /\ norm(f x) <= e}) + ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_INTERS_COMPACT] THEN + REWRITE_TAC[SET_RULE + `cball(vec 0,e) INTER IMAGE (f:real^M->real^N) s = + IMAGE f (s INTER {x | x IN s /\ f x IN cball(vec 0,e)})`] THEN + X_GEN_TAC `e:real` THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_CBALL_0]; + ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CBALL]]]);; + +let CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE = prove + (`!f:real^M->real^N s t. + closed s /\ s SUBSET t /\ subspace t /\ + linear f /\ + (!x. x IN t /\ f(x) = vec 0 ==> x = vec 0) + ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] + INJECTIVE_IMP_ISOMETRIC) THEN + ASM_SIMP_TAC[CLOSED_SUBSPACE; real_ge] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(vec 0:real^M,e / B)` THEN + REWRITE_TAC[BOUNDED_CBALL] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0; REAL_LE_RDIV_EQ] THEN + ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);; + +let BASIS_COORDINATES_LIPSCHITZ = prove + (`!b:real^N->bool. + independent b + ==> ?B. &0 < B /\ + !c v. v IN b + ==> abs(c v) <= B * norm(vsum b (\v. c(v) % v))`, + X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP INDEPENDENT_BOUND) THEN + FIRST_ASSUM(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ABBREV_TAC `n = CARD(k:real^N->bool)` THEN + MP_TAC(ISPECL + [`(\x. vsum(1..n) (\i. x$i % b i)):real^N->real^N`; + `span(IMAGE basis (1..n)):real^N->bool`] + INJECTIVE_IMP_ISOMETRIC) THEN + REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL + [CONJ_TAC THENL [SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LINEAR_VMUL_COMPONENT THEN + SIMP_TAC[LINEAR_ID] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN + REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N->num`) THEN + SUBGOAL_THEN + `vsum(1..n) (\i. (x:real^N)$i % b i:real^N) = vsum k (\v. x$(c v) % v)` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN + MAP_EVERY EXISTS_TAC [`b:num->real^N`; `c:real^N->num`] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN + DISCH_THEN(MP_TAC o SPEC `\v:real^N. (x:real^N)$(c v)` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CART_EQ; FORALL_IN_IMAGE; VEC_COMPONENT] THEN + ASM_MESON_TAC[IN_NUMSEG]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(B:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN + MAP_EVERY X_GEN_TAC [`c:real^N->real`; `j:num`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rand o rand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`) THEN + SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA] THEN + ANTS_TAC THENL [MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = v /\ u <= y ==> x >= y ==> u <= v`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC)] THEN + REWRITE_TAC[o_THM]; + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN + MP_TAC(ISPECL + [`(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`; + `j:num`] COMPONENT_LE_NORM) THEN + SUBGOAL_THEN `1 <= j /\ j <= dimindex(:N)` MP_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[]]]);; + +let BASIS_COORDINATES_CONTINUOUS = prove + (`!b:real^N->bool e. + independent b /\ &0 < e + ==> ?d. &0 < d /\ + !c. norm(vsum b (\v. c(v) % v)) < d + ==> !v. v IN b ==> abs(c v) < e`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN + X_GEN_TAC `c:real^N->real` THEN DISCH_TAC THEN + X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * norm(vsum b (\v:real^N. c v % v))` THEN + ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Affine transformations of intervals. *) +(* ------------------------------------------------------------------------- *) + +let AFFINITY_INVERSES = prove + (`!m c. ~(m = &0) + ==> (\x. m % x + c) o (\x. inv(m) % x + (--(inv(m) % c))) = I /\ + (\x. inv(m) % x + (--(inv(m) % c))) o (\x. m % x + c) = I`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_RNEG] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let REAL_AFFINITY_LE = prove + (`!m c x y. &0 < m ==> (m * x + c <= y <=> x <= inv(m) * y + --(c / m))`, + REWRITE_TAC[REAL_ARITH `m * x + c <= y <=> x * m <= y - c`] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC);; + +let REAL_LE_AFFINITY = prove + (`!m c x y. &0 < m ==> (y <= m * x + c <=> inv(m) * y + --(c / m) <= x)`, + REWRITE_TAC[REAL_ARITH `y <= m * x + c <=> y - c <= x * m`] THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC);; + +let REAL_AFFINITY_LT = prove + (`!m c x y. &0 < m ==> (m * x + c < y <=> x < inv(m) * y + --(c / m))`, + SIMP_TAC[REAL_LE_AFFINITY; GSYM REAL_NOT_LE]);; + +let REAL_LT_AFFINITY = prove + (`!m c x y. &0 < m ==> (y < m * x + c <=> inv(m) * y + --(c / m) < x)`, + SIMP_TAC[REAL_AFFINITY_LE; GSYM REAL_NOT_LE]);; + +let REAL_AFFINITY_EQ = prove + (`!m c x y. ~(m = &0) ==> (m * x + c = y <=> x = inv(m) * y + --(c / m))`, + CONV_TAC REAL_FIELD);; + +let REAL_EQ_AFFINITY = prove + (`!m c x y. ~(m = &0) ==> (y = m * x + c <=> inv(m) * y + --(c / m) = x)`, + CONV_TAC REAL_FIELD);; + +let VECTOR_AFFINITY_EQ = prove + (`!m c x y. ~(m = &0) + ==> (m % x + c = y <=> x = inv(m) % y + --(inv(m) % c))`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + real_div; VECTOR_NEG_COMPONENT; REAL_AFFINITY_EQ] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let VECTOR_EQ_AFFINITY = prove + (`!m c x y. ~(m = &0) + ==> (y = m % x + c <=> inv(m) % y + --(inv(m) % c) = x)`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + real_div; VECTOR_NEG_COMPONENT; REAL_EQ_AFFINITY] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let IMAGE_AFFINITY_INTERVAL = prove + (`!a b:real^N m c. + IMAGE (\x. m % x + c) (interval[a,b]) = + if interval[a,b] = {} then {} + else if &0 <= m then interval[m % a + c,m % b + c] + else interval[m % b + c,m % a + c]`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN + ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; COND_ID] THEN + REWRITE_TAC[INTERVAL_SING] THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN + ASM_SIMP_TAC[EXTENSION; IN_IMAGE; REAL_ARITH `&0 < --x ==> ~(&0 < x)`] THENL + [ALL_TAC; + ONCE_REWRITE_TAC[VECTOR_ARITH `x = m % y + c <=> c = (--m) % y + x`]] THEN + ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; REAL_LT_IMP_NZ; UNWIND_THM1] THEN + SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_NEG_COMPONENT] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_INV_EQ]) THEN + SIMP_TAC[REAL_AFFINITY_LE; REAL_LE_AFFINITY; real_div] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_NEGNEG] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> (inv m * x) * m = x`] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existence of eigenvectors. The proof is only in this file because it uses *) +(* a few simple results about continuous functions (at least *) +(* CONTINUOUS_ON_LIFT_DOT2, CONTINUOUS_ATTAINS_SUP and CLOSED_SUBSPACE). *) +(* ------------------------------------------------------------------------- *) + +let SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE = prove + (`!f:real^N->real^N s. + linear f /\ adjoint f = f /\ + subspace s /\ ~(s = {vec 0}) /\ (!x. x IN s ==> f x IN s) + ==> ?v c. v IN s /\ norm(v) = &1 /\ f(v) = c % v`, + let lemma = prove + (`!a b. (!x. a * x <= b * x pow 2) ==> &0 <= b ==> a = &0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(fun t -> MP_TAC(SPEC `&1` t) THEN + MP_TAC(SPEC `-- &1` t)) THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a / &2 / b`) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < b ==> (b * (a / b) pow 2) = a pow 2 / b`] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN + REWRITE_TAC[REAL_LT_SQUARE; REAL_ARITH + `(a * a) / &2 <= (a / &2) pow 2 <=> ~(&0 < a * a)`]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. (f x) dot x`; + `s INTER sphere(vec 0:real^N,&1)`] + CONTINUOUS_ATTAINS_SUP) THEN + REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; o_DEF] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; LINEAR_CONTINUOUS_ON; + CONTINUOUS_ON_ID] THEN + ASM_SIMP_TAC[COMPACT_SPHERE; CLOSED_INTER_COMPACT; CLOSED_SUBSPACE] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN + ASM_SIMP_TAC[SUBSPACE_0; IN_SPHERE_0; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(norm x) % x:real^N` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_SUB_RZERO; NORM_MUL] THEN + ASM_SIMP_TAC[SUBSPACE_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN + REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN + ABBREV_TAC `c = (f:real^N->real^N) v dot v` THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]] THEN + ABBREV_TAC `p = \x y:real^N. c * (x dot y) - (f x) dot y` THEN + SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= p x x` (LABEL_TAC "POSDEF") THENL + [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "p" THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; REAL_SUB_LE; REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(norm x) % x:real^N`) THEN + ASM_SIMP_TAC[SUBSPACE_MUL] THEN + ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; REAL_ABS_INV; DOT_RMUL] THEN + ASM_SIMP_TAC[REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; DOT_LMUL] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; DOT_POS_LT] THEN + REWRITE_TAC[GSYM NORM_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!y:real^N. y IN s ==> !a. p v y * a <= p y y * a pow 2` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + REMOVE_THEN "POSDEF" (MP_TAC o SPEC `v - (&2 * a) % y:real^N`) THEN + EXPAND_TAC "p" THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN + ASM_SIMP_TAC[LINEAR_SUB; LINEAR_CMUL] THEN + REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN + REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN + SUBGOAL_THEN `f y dot (v:real^N) = f v dot y` SUBST1_TAC THENL + [ASM_MESON_TAC[ADJOINT_CLAUSES; DOT_SYM]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[NORM_POW_2] THEN + MATCH_MP_TAC(REAL_ARITH + `&4 * (z - y) = x ==> &0 <= x ==> y <= z`) THEN + REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING; + DISCH_THEN(MP_TAC o GEN `y:real^N` o DISCH `(y:real^N) IN s` o + MATCH_MP lemma o C MP (ASSUME `(y:real^N) IN s`) o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[] THEN EXPAND_TAC "p" THEN + REWRITE_TAC[GSYM DOT_LMUL; GSYM DOT_LSUB] THEN + DISCH_THEN(MP_TAC o SPEC `c % v - f v:real^N`) THEN + ASM_SIMP_TAC[SUBSPACE_MUL; SUBSPACE_SUB; DOT_EQ_0; VECTOR_SUB_EQ]]);; + +let SELF_ADJOINT_HAS_EIGENVECTOR = prove + (`!f:real^N->real^N. + linear f /\ adjoint f = f ==> ?v c. norm(v) = &1 /\ f(v) = c % v`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] + SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC(SET_RULE `!a. ~(a IN s) ==> ~(UNIV = s)`) THEN + EXISTS_TAC `vec 1:real^N` THEN + REWRITE_TAC[IN_SING; VEC_EQ; ARITH_EQ]);; + +let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE = prove + (`!f:real^N->real^N s. + linear f /\ adjoint f = f /\ + subspace s /\ (!x. x IN s ==> f x IN s) + ==> ?b. b SUBSET s /\ + pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ + independent b /\ + span b = s /\ + b HAS_SIZE dim s`, + let lemma = prove + (`!f:real^N->real^N s. + linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s) + ==> ?b. b SUBSET s /\ b HAS_SIZE dim s /\ + pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN + GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN + ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL + [EXISTS_TAC `{}:real^N->bool` THEN + ASM_SIMP_TAC[HAS_SIZE_CLAUSES; NOT_IN_EMPTY; + PAIRWISE_EMPTY; EMPTY_SUBSET]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE + `~(s SUBSET {a}) ==> ~(s = {a})`)) THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] + SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N` MP_TAC) THEN + ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | y IN s /\ orthogonal v y}`) THEN + REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`span {v:real^N}`; `s:real^N->bool`] + DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN + ASM_REWRITE_TAC[SUBSPACE_SPAN; IN_SING; FORALL_UNWIND_THM2] THEN + ANTS_TAC THENL + [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + ASM_REWRITE_TAC[DIM_SPAN; DIM_SING; ARITH_RULE `n < n + 1`] THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN + REWRITE_TAC[orthogonal] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(f:real^N->real^N) v dot x` THEN CONJ_TAC THENL + [ASM_MESON_TAC[ADJOINT_CLAUSES]; + ASM_MESON_TAC[DOT_LMUL; REAL_MUL_RZERO]]; + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(v:real^N) INSERT b` THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[PAIRWISE_INSERT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE; SUBSET; IN_ELIM_THM]) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD1] THEN + ASM_MESON_TAC[ORTHOGONAL_REFL]; + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN + ASM_MESON_TAC[ORTHOGONAL_SYM]]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] lemma) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `b:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; + DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_SUBSET_SUBSPACE]; + MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_REWRITE_TAC[LE_REFL]]]);; + +let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS = prove + (`!f:real^N->real^N. + linear f /\ adjoint f = f + ==> ?b. pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ + independent b /\ + span b = (:real^N) /\ + b HAS_SIZE (dimindex(:N))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] + SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonalization of symmetric matrix. *) +(* ------------------------------------------------------------------------- *) + +let SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT = prove + (`!A:real^N^N. + transp A = A + ==> ?P d. orthogonal_matrix P /\ + transp P ** A ** P = (lambda i j. if i = j then d i else &0)`, + let lemma1 = prove + (`!A:real^N^N P:real^N^N d. + A ** P = P ** (lambda i j. if i = j then d i else &0) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> A ** column i P = d i % column i P`, + SIMP_TAC[CART_EQ; matrix_mul; matrix_vector_mul; LAMBDA_BETA; + column; VECTOR_MUL_COMPONENT] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN + SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[REAL_MUL_SYM]) in + let lemma2 = prove + (`!A:real^N^N P:real^N^N d. + orthogonal_matrix P /\ + transp P ** A ** P = (lambda i j. if i = j then d i else &0) <=> + orthogonal_matrix P /\ + !i. 1 <= i /\ i <= dimindex(:N) + ==> A ** column i P = d i % column i P`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM lemma1; orthogonal_matrix] THEN + ABBREV_TAC `D:real^N^N = lambda i j. if i = j then d i else &0` THEN + MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]) in + REPEAT STRIP_TAC THEN + REWRITE_TAC[lemma2] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[GSYM SKOLEM_THM] THEN + MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` + SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN + ASM_SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR; + MATRIX_OF_MATRIX_VECTOR_MUL] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN + REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN + REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ASM_REWRITE_TAC[IN_NUMSEG; TAUT + `p /\ q /\ x = y ==> a = b <=> p /\ q /\ ~(a = b) ==> ~(x = y)`] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[pairwise; IN_NUMSEG] THEN STRIP_TAC THEN + EXISTS_TAC `transp(lambda i. f i):real^N^N` THEN + SIMP_TAC[COLUMN_TRANSP; ORTHOGONAL_MATRIX_TRANSP] THEN + SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; row] THEN + SIMP_TAC[LAMBDA_ETA; LAMBDA_BETA; pairwise; IN_NUMSEG] THEN + ASM_MESON_TAC[]);; + +let SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE = prove + (`!A:real^N^N. + transp A = A + ==> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[diagonal_matrix; LAMBDA_BETA]);; + +let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE = prove + (`!A:real^N^N. + transp A = A <=> + ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, + GEN_TAC THEN EQ_TAC THEN + REWRITE_TAC[SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE] THEN + REWRITE_TAC[orthogonal_matrix] THEN + DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `D:real^N^N = transp P ** (A:real^N^N) ** P` THEN + SUBGOAL_THEN `A:real^N^N = P ** (D:real^N^N) ** transp P` SUBST1_TAC THENL + [EXPAND_TAC "D" THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN + ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN + ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]; + REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC] THEN + ASM_MESON_TAC[TRANSP_DIAGONAL_MATRIX]]);; + +(* ------------------------------------------------------------------------- *) +(* Some matrix identities are easier to deduce for invertible matrices. We *) +(* can then extend by continuity, which is why this material needs to be *) +(* here after basic topological notions have been defined. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_LIFT_DET = prove + (`!(A:A->real^N^N) net. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (\x. lift(A x$i$j)) continuous net) + ==> (\x. lift(det(A x))) continuous net`, + REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN + SIMP_TAC[LIFT_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_VSUM THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; LIFT_CMUL; IN_ELIM_THM] THEN + X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN + MATCH_MP_TAC CONTINUOUS_CMUL THEN + MATCH_MP_TAC CONTINUOUS_LIFT_PRODUCT THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG]);; + +let CONTINUOUS_ON_LIFT_DET = prove + (`!A:real^M->real^N^N s. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (\x. lift(A x$i$j)) continuous_on s) + ==> (\x. lift(det(A x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_DET]);; + +let NEARBY_INVERTIBLE_MATRIX = prove + (`!A:real^N^N. + ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% mat 1)`, + GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`dimindex(:N)`; `a:num->real`] REAL_POLYFUN_FINITE_ROOTS) THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL + [EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP FINITE_IMAGE) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIMIT_POINT_FINITE) THEN + DISCH_THEN(MP_TAC o SPEC `lift(&0)`) THEN + REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[DIST_LIFT; LIFT_EQ; REAL_SUB_RZERO; NOT_FORALL_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MP_TAC(SPEC `--x:real` th)) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `--x:real`) THEN + ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_ABS_NEG] THEN + ONCE_REWRITE_TAC[GSYM INVERTIBLE_NEG] THEN + REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN + REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN + ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN + REWRITE_TAC[GSYM MATRIX_CMUL_ADD_LDISTRIB; GSYM MATRIX_CMUL_ASSOC] THEN + REWRITE_TAC[MATRIX_CMUL_LID; MATRIX_ADD_SYM]);; + +let MATRIX_WLOG_INVERTIBLE = prove + (`!P. (!A:real^N^N. invertible A ==> P A) /\ + (!A:real^N^N. ?d. &0 < d /\ + closed {x | x IN cball(vec 0,d) /\ + P(A + drop x %% mat 1)}) + ==> !A:real^N^N. P A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^1` o + GEN_REWRITE_RULE I [CLOSED_LIMPT]) THEN + ASM_SIMP_TAC[IN_ELIM_THM; DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN + ANTS_TAC THENL [ALL_TAC; CONV_TAC TAUT] THEN + MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `k:real` THEN + DISCH_TAC THEN REWRITE_TAC[EXISTS_LIFT; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM LIFT_NUM; IN_CBALL_0; NORM_LIFT; DIST_LIFT] THEN + REWRITE_TAC[REAL_SUB_RZERO; LIFT_EQ; LIFT_DROP] THEN + EXISTS_TAC `min d ((min e k) / &2)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; + +let SYLVESTER_DETERMINANT_IDENTITY = prove + (`!A:real^N^M B:real^M^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, + let lemma1 = prove + (`!A:real^N^N B:real^N^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `det((mat 1 + A ** B) ** A:real^N^N) = + det(A ** (mat 1 + B ** A))` + MP_TAC THENL + [REWRITE_TAC[MATRIX_ADD_RDISTRIB; MATRIX_ADD_LDISTRIB] THEN + REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID; MATRIX_MUL_ASSOC]; + REWRITE_TAC[DET_MUL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INVERTIBLE_DET_NZ]) THEN + CONV_TAC REAL_RING]; + X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN + ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; CONTINUOUS_CONST] THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN + DISCH_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN + REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_CMUL THEN + REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID]]) in + let lemma2 = prove + (`!A:real^N^M B:real^M^N. + dimindex(:M) <= dimindex(:N) + ==> det(mat 1 + A ** B) = det(mat 1 + B ** A)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ABBREV_TAC + [`A':real^N^N = + lambda i j. if i <= dimindex(:M) then (A:real^N^M)$i$j + else &0`; + `B':real^N^N = + lambda i j. if j <= dimindex(:M) then (B:real^M^N)$i$j + else &0`] THEN + MP_TAC(ISPECL [`A':real^N^N`; `B':real^N^N`] lemma1) THEN + SUBGOAL_THEN + `(B':real^N^N) ** (A':real^N^N) = (B:real^M^N) ** (A:real^N^M)` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; FINITE_NUMSEG; SUBSET_NUMSEG; + LE_REFL; TAUT `(p /\ q) /\ ~(p /\ r) <=> p /\ q /\ ~r`]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {p | p permutes 1..dimindex(:N) /\ !i. dimindex(:M) < i ==> p i = i} + (\p. sign p * product (1..dimindex(:N)) + (\i. (mat 1 + (A':real^N^N) ** (B':real^N^N))$i$p i))` THEN + CONJ_TAC THENL + [ALL_TAC; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + CONJ_TAC THENL [SET_TAC[]; SIMP_TAC[IN_ELIM_THM; IMP_CONJ]] THEN + X_GEN_TAC `p:num->num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE; PRODUCT_EQ_0_NUMSEG] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `k:num` o CONJUNCT1 o + GEN_REWRITE_RULE I [permutes]) THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; REAL_ADD_LID] THEN + ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN + ASM_SIMP_TAC[LAMBDA_BETA; GSYM NOT_LT]] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN + EXISTS_TAC `\f:num->num. f` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THENL + [REWRITE_TAC[MESON[] `(?!x. P x /\ x = y) <=> P y`] THEN CONJ_TAC THENL + [MATCH_MP_TAC PERMUTES_SUBSET THEN + EXISTS_TAC `1..dimindex(:M)` THEN + ASM_REWRITE_TAC[SUBSET_NUMSEG; LE_REFL]; + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT1 o + GEN_REWRITE_RULE I [permutes]) THEN + ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; NOT_LE]]; + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PERMUTES_SUPERSET THEN + EXISTS_TAC `1..dimindex(:N)` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_NUMSEG] THEN ASM_MESON_TAC[NOT_LE]; + DISCH_TAC] THEN + AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `m:num <= n ==> n = m + (n - m)`)) THEN + SIMP_TAC[PRODUCT_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN + MATCH_MP_TAC(REAL_RING `x = y /\ z = &1 ==> x = y * z`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->num`; `1..dimindex(:M)`] PERMUTES_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:num->num) i <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN + MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN + ASM_SIMP_TAC[LAMBDA_BETA]; + MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG THEN + ASM_SIMP_TAC[ARITH_RULE `n + 1 <= i ==> n < i`] THEN + ASM_SIMP_TAC[ARITH_RULE `m:num <= n ==> m + (n - m) = n`] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN + ASM_SIMP_TAC[REAL_EQ_ADD_LCANCEL_0; matrix_mul; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN + ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `m + 1 <= i ==> ~(i <= m)`]]]) in + REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE + `dimindex(:M) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:M)`) + THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN + MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[]);; + +let COFACTOR_MATRIX_MUL = prove + (`!A B:real^N^N. cofactor(A ** B) = cofactor(A) ** cofactor(B)`, + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[COFACTOR_MATRIX_INV; GSYM INVERTIBLE_DET_NZ; + INVERTIBLE_MATRIX_MUL] THEN + REWRITE_TAC[DET_MUL; MATRIX_MUL_LMUL] THEN + REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_CMUL_ASSOC; + GSYM MATRIX_TRANSP_MUL] THEN + ASM_SIMP_TAC[MATRIX_INV_MUL]; + GEN_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]]; + X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN + MATCH_MP_TAC CLOSED_FORALL THEN GEN_TAC] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + REWRITE_TAC[CART_EQ] THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; cofactor; LIFT_SUM; + FINITE_NUMSEG; o_DEF] THEN + (MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CONTINUOUS_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[o_DEF] THEN CONJ_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; CONTINUOUS_CONST] THEN + REPEAT(W(fun (asl,w) -> + let t = find_term is_cond w in + ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN + TRY(MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN + REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC) THEN + REWRITE_TAC[LIFT_CMUL] THEN + TRY(MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[o_DEF; CONTINUOUS_CONST]) THEN + REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[CONTINUOUS_CONST; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; + +let DET_COFACTOR = prove + (`!A:real^N^N. det(cofactor A) = det(A) pow (dimindex(:N) - 1)`, + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN + X_GEN_TAC `A:real^N^N` THENL + [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_FIELD + `~(a = &0) ==> a * x = a * y ==> x = y`)) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN + REWRITE_TAC[GSYM DET_MUL; MATRIX_MUL_RIGHT_COFACTOR] THEN + REWRITE_TAC[DET_CMUL; GSYM(CONJUNCT2 real_pow); DET_I; REAL_MUL_RID] THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`]; + ALL_TAC] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_LIFT_POW] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; + LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; + CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID] THEN + ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + REPEAT(W(fun (asl,w) -> + let t = find_term is_cond w in + ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; + LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; + CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; + +let INVERTIBLE_COFACTOR = prove + (`!A:real^N^N. invertible(cofactor A) <=> dimindex(:N) = 1 \/ invertible A`, + SIMP_TAC[DET_COFACTOR; INVERTIBLE_DET_NZ; REAL_POW_EQ_0; DE_MORGAN_THM; + DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`; + DISJ_ACI]);; + +let COFACTOR_COFACTOR = prove + (`!A:real^N^N. + 2 <= dimindex(:N) + ==> cofactor(cofactor A) = (det(A) pow (dimindex(:N) - 2)) %% A`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN + X_GEN_TAC `A:real^N^N` THENL + [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] + COFACTOR_MATRIX_MUL) THEN + REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; COFACTOR_CMUL; COFACTOR_I] THEN + REWRITE_TAC[COFACTOR_TRANSP] THEN + DISCH_THEN(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN + REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; TRANSP_MATRIX_CMUL] THEN + REWRITE_TAC[TRANSP_MAT] THEN + DISCH_THEN(MP_TAC o AP_TERM `(\x. x ** A):real^N^N->real^N^N`) THEN + REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LEFT_COFACTOR] THEN + REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN + REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^N^N. inv(det(A:real^N^N)) %% x`) THEN + ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_LINV; MATRIX_CMUL_LID] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN + REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; + POP_ASSUM(K ALL_TAC)] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + REWRITE_TAC[CART_EQ] THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [REPLICATE_TAC 2 + (ONCE_REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + REPEAT(W(fun (asl,w) -> + let t = find_term is_cond w in + ASM_CASES_TAC (lhand(rator t)) THEN + ASM_REWRITE_TAC[CONTINUOUS_CONST]))); + REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_LIFT_POW THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC; + ALL_TAC]] THEN + REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_CMUL; + CONTINUOUS_AT_ID]);; + +let RANK_COFACTOR_EQ_FULL = prove + (`!A:real^N^N. rank(cofactor A) = dimindex(:N) <=> + dimindex(:N) = 1 \/ rank A = dimindex(:N)`, + REWRITE_TAC[RANK_EQ_FULL_DET; DET_COFACTOR; REAL_POW_EQ_0] THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN + CONV_TAC TAUT);; + +let COFACTOR_EQ_0 = prove + (`!A:real^N^N. cofactor A = mat 0 <=> rank(A) < dimindex(:N) - 1`, + let lemma1 = prove + (`!A:real^N^N. rank(A) < dimindex(:N) - 1 ==> cofactor A = mat 0`, + GEN_TAC THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN + SIMP_TAC[CART_EQ; cofactor; MAT_COMPONENT; LAMBDA_BETA; COND_ID] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[DET_EQ_0_RANK] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (ARITH_RULE `r < n - 1 ==> s <= r + 1 ==> s < n`)) THEN + REWRITE_TAC[RANK_ROW; rows] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC + `dim (basis n INSERT + {row i ((lambda k l. if l = n then &0 else (A:real^N^N)$k$l) + :real^N^N) + | i IN (1..dimindex(:N)) DELETE m})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN + MATCH_MP_TAC(SET_RULE + `m IN s /\ (!i. i IN s DELETE m ==> f i = g i) /\ f m = a + ==> {f i | i IN s} SUBSET a INSERT {g i | i IN s DELETE m}`) THEN + ASM_SIMP_TAC[IN_NUMSEG; IN_DELETE; row; LAMBDA_BETA; basis; LAMBDA_ETA]; + REWRITE_TAC[DIM_INSERT] THEN MATCH_MP_TAC(ARITH_RULE + `n <= k ==> (if p then n else n + 1) <= k + 1`) THEN + MATCH_MP_TAC(MESON[DIM_LINEAR_IMAGE_LE; DIM_SUBSET; LE_TRANS] + `(?f. linear f /\ t SUBSET IMAGE f s) ==> dim t <= dim s`) THEN + EXISTS_TAC `(\x. lambda i. if i = n then &0 else x$i) + :real^N->real^N` THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DELETE] THEN + STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `i:num` THEN + ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA]]]) + and lemma2 = prove + (`!A:real^N^N. + rank A < dimindex(:N) + ==> ?n x. 1 <= n /\ n <= dimindex(:N) /\ + rank A < + rank((lambda i. if i = n then x else row i A):real^N^N)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?n. 1 <= n /\ n <= dimindex(:N) /\ + row n (A:real^N^N) IN + span {row j A | j IN (1..dimindex(:N)) DELETE n}` + MP_TAC THENL + [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN + ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_TRANSP] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + SIMP_TAC[matrix_vector_mul; transp; VEC_COMPONENT; LAMBDA_BETA] THEN + DISCH_TAC THEN + SUBGOAL_THEN `row n A = vsum ((1..dimindex(:N)) DELETE n) + (\i. --((c:real^N)$i / c$n) % row i (A:real^N^N))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; REAL_DIV_REFL] THEN + REWRITE_TAC[VECTOR_ARITH `n = x - -- &1 % n <=> x:real^N = vec 0`] THEN + SIMP_TAC[VSUM_COMPONENT; row; VECTOR_MUL_COMPONENT; LAMBDA_BETA; + CART_EQ; REAL_ARITH `--(x / y) * z:real = --(inv y) * z * x`] THEN + ASM_SIMP_TAC[SUM_LMUL; VEC_COMPONENT; REAL_MUL_RZERO]; + MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN + STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `span {row j (A:real^N^N) | j IN (1..dimindex(:N)) DELETE n} + PSUBSET (:real^N)` + MP_TAC THENL + [REWRITE_TAC[PSUBSET; SUBSET_UNIV] THEN + DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN + REWRITE_TAC[DIM_UNIV] THEN + MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n - 1 ==> ~(x = n)`) THEN + REWRITE_TAC[DIMINDEX_GE_1; DIM_SPAN] THEN + W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN + W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN + SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN + ASM_SIMP_TAC[CARD_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN + REWRITE_TAC[CARD_NUMSEG_1; LE_REFL]; + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s PSUBSET UNIV ==> ?x. ~(x IN s)`)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!A:real^N^N. rows A = row n A INSERT + {row j A | j IN (1..dimindex (:N)) DELETE n}` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[rows; IN_DELETE; IN_NUMSEG] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[DIM_INSERT]] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `x IN span s ==> x = y /\ s = t ==> ~(y IN span t) ==> q`)) THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA]; + MATCH_MP_TAC(ARITH_RULE `s = t ==> s < t + 1`) THEN + AP_TERM_TAC THEN REWRITE_TAC[row]] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN + ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA; CART_EQ]]]) in + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `r <= n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC; + REWRITE_TAC[RANK_EQ_FULL_DET] THEN + MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN + ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN + REWRITE_TAC[MAT_EQ; ARITH_EQ]; + DISCH_TAC] THEN + MP_TAC(ISPEC `A:real^N^N` lemma2) THEN + ASM_REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `n - 1 < n <=> 1 <= n`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `x:real^N` + STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `n - 1 < k ==> k <= MIN n n ==> k = n`)) THEN + REWRITE_TAC[RANK_BOUND; RANK_EQ_FULL_DET] THEN + MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `n:num`] + DET_COFACTOR_EXPANSION)) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_0 THEN + X_GEN_TAC `m:num` THEN SIMP_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN + DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[CART_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `m:num`) THEN + ASM_SIMP_TAC[MAT_COMPONENT; COND_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN + ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA]) THEN + ASM_MESON_TAC[]);; + +let RANK_COFACTOR_EQ_1 = prove + (`!A:real^N^N. rank(cofactor A) = 1 <=> + dimindex(:N) = 1 \/ rank A = dimindex(:N) - 1`, + GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [ASM_MESON_TAC[RANK_COFACTOR_EQ_FULL]; ASM_REWRITE_TAC[]] THEN + EQ_TAC THENL + [ASM_CASES_TAC `cofactor A:real^N^N = mat 0` THEN + ASM_REWRITE_TAC[RANK_0; ARITH_EQ] THEN DISCH_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `~(r < n - 1) /\ ~(r = n) /\ r <= MIN n n ==> r = n - 1`) THEN + ASM_REWRITE_TAC[RANK_BOUND; GSYM COFACTOR_EQ_0] THEN + MP_TAC(ISPEC `A:real^N^N` RANK_COFACTOR_EQ_FULL) THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE + `~(n = 0) /\ n <= 1 ==> n = 1`) THEN + ASM_REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0; LT_REFL] THEN + MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] + RANK_SYLVESTER) THEN + ASM_REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; RANK_TRANSP] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `a = n - 1 ==> 1 <= n ==> a < n`)) THEN + ASM_SIMP_TAC[GSYM DET_EQ_0_RANK; DIMINDEX_GE_1] THEN + DISCH_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN + ARITH_TAC]);; + +let RANK_COFACTOR = prove + (`!A:real^N^N. + rank(cofactor A) = if rank(A) = dimindex(:N) then dimindex(:N) + else if rank(A) = dimindex(:N) - 1 then 1 + else 0`, + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_FULL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_1] THEN + REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0] THEN + MATCH_MP_TAC(ARITH_RULE + `r <= MIN n n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN + ASM_REWRITE_TAC[RANK_BOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Not in so many words, but combining this with intermediate value theorem *) +(* implies the determinant is an open map. *) +(* ------------------------------------------------------------------------- *) + +let DET_OPEN_MAP = prove + (`!A:real^N^N e. + &0 < e + ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < det A) /\ + (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > det A)`, + let lemma1 = prove + (`!A:real^N^N i e. + 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 /\ &0 < e + ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < &0) /\ + (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > &0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `det(A:real^N^N) = &0` ASSUME_TAC THENL + [ASM_MESON_TAC[DET_ZERO_ROW]; ALL_TAC] THEN + MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[INVERTIBLE_DET_NZ]] THEN + DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> x < &0 \/ &0 < x`)) + THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN + (CONJ_TAC THENL + [EXISTS_TAC `A + min d e / &2 %% mat 1:real^N^N`; + EXISTS_TAC `(lambda j. if j = i then + --(&1) % row i (A + min d e / &2 %% mat 1:real^N^N) + else row j (A + min d e / &2 %% mat 1:real^N^N)) + :real^N^N`]) THEN + ASM_SIMP_TAC[DET_ROW_MUL; MESON[] + `(if j = i then f i else f j) = f j`] THEN + REWRITE_TAC[row; LAMBDA_ETA] THEN + ASM_REWRITE_TAC[real_gt; GSYM row] THEN + TRY(CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN + (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + DISCH_THEN(MP_TAC o SPEC `l:num`) THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; VEC_COMPONENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC) + and lemma2 = prove + (`!A:real^N^N x:real^N i. + 1 <= i /\ i <= dimindex(:N) /\ x$i = &1 + ==> det(lambda k. if k = i then transp A ** x else row k A) = det A`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `det(lambda k. if k = i + then row i (A:real^N^N) + (transp A ** x - row i A) + else row k A)` THEN + CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `r + (x - r):real^N = x`]; ALL_TAC] THEN + MATCH_MP_TAC DET_ROW_SPAN THEN + SUBGOAL_THEN + `transp(A:real^N^N) ** x - row i A = + vsum ((1..dimindex(:N)) DELETE i) (\k. x$k % row k A)` + SUBST1_TAC THENL + [SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_SUB_COMPONENT; row; transp; + LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_AC]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN + REWRITE_TAC[FINITE_DELETE; IN_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `cofactor(A:real^N^N) = mat 0` THENL + [MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN + ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN + REWRITE_TAC[MAT_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?c i. 1 <= i /\ i <= dimindex(:N) /\ c$i = &1 /\ + transp(A:real^N^N) ** c = vec 0` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN + ASM_REWRITE_TAC[DET_TRANSP] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[VEC_COMPONENT; NOT_IMP; NOT_FORALL_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + EXISTS_TAC `inv(c$i) % c:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV] THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_RZERO]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(lambda k. if k = i then transp A ** c else row k (A:real^N^N)):real^N^N`; + `i:num`; `min e (e / &(dimindex(:N)) / + (&1 + norm(&2 % basis i - c:real^N)))`] lemma1) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; + NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[row; CART_EQ; VEC_COMPONENT; LAMBDA_BETA]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + ABBREV_TAC `A':real^N^N = + lambda k. if k = i then vec 0 else row k (A:real^N^N)` THEN + DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(lambda k. if k = i then transp(B:real^N^N) ** + (&2 % basis i - c) + else row k B):real^N^N` THEN + ASM_SIMP_TAC[lemma2; BASIS_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; REAL_ARITH `&2 * x - x = x`] THEN + (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN + EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + (COND_CASES_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN + EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; row]] THEN + SUBGOAL_THEN + `(A:real^N^N)$k$l = (transp(A':real^N^N) ** (&2 % basis i - c:real^N))$l` + SUBST1_TAC THENL + [ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN + EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + REWRITE_TAC[COND_RAND; COND_RATOR] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; + VEC_COMPONENT; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_0; REAL_ADD_LID] THEN + ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN + UNDISCH_TAC `transp(A:real^N^N) ** (c:real^N) = vec 0` THEN + ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT; matrix_vector_mul; LAMBDA_BETA; + row; transp] THEN + DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_MUL_RNEG; SUM_NEG] THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM TRANSP_MATRIX_SUB; + GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]] THEN + ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN + W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; + GSYM NOT_LE; DIMINDEX_GE_1] THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN + STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + TRANS_TAC REAL_LET_TRANS + `abs((B - A':real^N^N)$r$l) * (&1 + norm(&2 % basis i - c:real^N))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= &1 + b`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]; + ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; GSYM REAL_LT_RDIV_EQ; + NORM_ARITH `&0 < &1 + norm(x:real^N)`]]); + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + SIMP_TAC[CART_EQ; MAT_COMPONENT; COND_ID] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC + (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ x < &0`)) + THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN + (CONJ_TAC THENL + [EXISTS_TAC `(lambda m n. if m = i /\ n = j + then (A:real^N^N)$i$j - + e / (&1 + abs(cofactor A$i$j)) + else A$m$n):real^N^N`; + EXISTS_TAC `(lambda m n. if m = i /\ n = j + then (A:real^N^N)$i$j + + e / (&1 + abs(cofactor A$i$j)) + else A$m$n):real^N^N`]) THEN + (CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `abs(a - e - a) = abs e`; + REAL_ARITH `abs((a + e) - a) = abs e`] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_ABS] THEN + ASM_SIMP_TAC[REAL_ARITH `abs(&1 + abs x) = &1 + abs x`; + REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ &0 < e * x ==> abs e < e * (&1 + x)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC]) THEN + MP_TAC(GEN `A:real^N^N` (SPECL [`A:real^N^N`; `i:num`] + DET_COFACTOR_EXPANSION)) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ASM_SIMP_TAC[GSYM SUM_SUB_NUMSEG; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `p - A$i$j * cofactor A$i$j = + --(A$i$j * cofactor A$i$j - p)`] THEN + REWRITE_TAC[SUM_NEG; REAL_ARITH + `a * b - c * d:real = b * (a - c) + c * (b - d)`] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; REAL_NEG_ADD] THEN MATCH_MP_TAC(REAL_ARITH + `b = &0 /\ &0 < a ==> &0 < a + b`) THEN + (CONJ_TAC THENL + [REWRITE_TAC[REAL_NEG_EQ_0] THEN + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN + REWRITE_TAC[REAL_SUB_0] THEN REWRITE_TAC[cofactor] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]; + ALL_TAC]) THEN + REWRITE_TAC[GSYM SUM_NEG; GSYM REAL_MUL_RNEG] THEN + MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[FINITE_NUMSEG] THEN + MATCH_MP_TAC(MESON[REAL_LT_IMP_LE; REAL_LE_REFL] + `(?i. P i /\ &0 < f i /\ (!j. P j /\ ~(j = i) ==> f j = &0)) + ==> (!j. P j ==> &0 <= f j) /\ (?j. P j /\ &0 < f j)`) THEN + EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; IN_NUMSEG; REAL_NEG_0] THEN + REWRITE_TAC[REAL_ARITH `a - (a + e):real = --e`; + REAL_ARITH `a - (a - e):real = e`; REAL_NEG_NEG] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN + REWRITE_TAC[REAL_ARITH `&0 < a * --b <=> &0 < --a * b`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_NEG_GT0] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Infinite sums of vectors. Allow general starting point (and more). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("sums",(12,"right"));; + +let sums = new_definition + `(f sums l) s = ((\n. vsum(s INTER (0..n)) f) --> l) sequentially`;; + +let infsum = new_definition + `infsum s f = @l. (f sums l) s`;; + +let summable = new_definition + `summable s f = ?l. (f sums l) s`;; + +let SUMS_SUMMABLE = prove + (`!f l s. (f sums l) s ==> summable s f`, + REWRITE_TAC[summable] THEN MESON_TAC[]);; + +let SUMS_INFSUM = prove + (`!f s. (f sums (infsum s f)) s <=> summable s f`, + REWRITE_TAC[infsum; summable] THEN MESON_TAC[]);; + +let SUMS_LIM = prove + (`!f:num->real^N s. + (f sums lim sequentially (\n. vsum (s INTER (0..n)) f)) s + <=> summable s f`, + GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable]; + REWRITE_TAC[summable; sums] THEN STRIP_TAC THEN REWRITE_TAC[lim] THEN + ASM_MESON_TAC[]]);; + +let FINITE_INTER_NUMSEG = prove + (`!s m n. FINITE(s INTER (m..n))`, + MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG; INTER_SUBSET]);; + +let SERIES_FROM = prove + (`!f l k. (f sums l) (from k) = ((\n. vsum(k..n) f) --> l) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);; + +let SERIES_UNIQUE = prove + (`!f:num->real^N l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')`, + REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_UNIQUE]);; + +let INFSUM_UNIQUE = prove + (`!f:num->real^N l s. (f sums l) s ==> infsum s f = l`, + MESON_TAC[SERIES_UNIQUE; SUMS_INFSUM; summable]);; + +let SERIES_TERMS_TOZERO = prove + (`!f l n. (f sums l) (from n) ==> (f --> vec 0) sequentially`, + REPEAT GEN_TAC THEN SIMP_TAC[sums; LIM_SEQUENTIALLY; FROM_INTER_NUMSEG] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N + n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `m - 1` th) THEN MP_TAC(SPEC `m:num` th)) THEN + SUBGOAL_THEN `0 < m /\ n <= m` (fun th -> SIMP_TAC[VSUM_CLAUSES_RIGHT; th]) + THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let SERIES_FINITE = prove + (`!f s. FINITE s ==> (f sums (vsum s f)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `s INTER (0..m) = s` + (fun th -> ASM_REWRITE_TAC[th; DIST_REFL]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LE_TRANS]);; + +let SERIES_LINEAR = prove + (`!f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s`, + SIMP_TAC[sums; LIM_LINEAR; FINITE_INTER; FINITE_NUMSEG; + GSYM(REWRITE_RULE[o_DEF] LINEAR_VSUM)]);; + +let SERIES_0 = prove + (`!s. ((\n. vec 0) sums (vec 0)) s`, + REWRITE_TAC[sums; VSUM_0; LIM_CONST]);; + +let SERIES_ADD = prove + (`!x x0 y y0 s. + (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_ADD; LIM_ADD]);; + +let SERIES_SUB = prove + (`!x x0 y y0 s. + (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_SUB; LIM_SUB]);; + +let SERIES_CMUL = prove + (`!x x0 c s. (x sums x0) s ==> ((\n. c % x n) sums (c % x0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_LMUL; LIM_CMUL]);; + +let SERIES_NEG = prove + (`!x x0 s. (x sums x0) s ==> ((\n. --(x n)) sums (--x0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_NEG; LIM_NEG]);; + +let SUMS_IFF = prove + (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f sums l) k <=> (g sums l) k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);; + +let SUMS_EQ = prove + (`!f g k. (!x. x IN k ==> f x = g x) /\ (f sums l) k ==> (g sums l) k`, + MESON_TAC[SUMS_IFF]);; + +let SUMS_0 = prove + (`!f:num->real^N s. (!n. n IN s ==> f n = vec 0) ==> (f sums vec 0) s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\n:num. vec 0:real^N` THEN ASM_SIMP_TAC[SERIES_0]);; + +let SERIES_FINITE_SUPPORT = prove + (`!f:num->real^N s k. + FINITE (s INTER k) /\ (!x. x IN k /\ ~(x IN s) ==> f x = vec 0) + ==> (f sums vsum (s INTER k) f) k`, + REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `vsum (k INTER (0..n)) (f:num->real^N) = vsum(s INTER k) f` + (fun th -> ASM_REWRITE_TAC[DIST_REFL; th]) THEN + MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[IN_INTER; LE_TRANS]);; + +let SERIES_COMPONENT = prove + (`!f s l:real^N k. (f sums l) s /\ 1 <= k /\ k <= dimindex(:N) + ==> ((\i. lift(f(i)$k)) sums lift(l$k)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + ASM_SIMP_TAC[GSYM LIFT_SUM; GSYM VSUM_COMPONENT; + FINITE_INTER; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[o_DEF; LIM_COMPONENT]);; + +let SERIES_DIFFS = prove + (`!f:num->real^N k. + (f --> vec 0) sequentially + ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)`, + REWRITE_TAC[sums; FROM_INTER_NUMSEG; VSUM_DIFFS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. (f:num->real^N) k - f(n + 1)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN + SIMP_TAC[]; + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);; + +let SERIES_TRIVIAL = prove + (`!f. (f sums vec 0) {}`, + REWRITE_TAC[sums; INTER_EMPTY; VSUM_CLAUSES; LIM_CONST]);; + +let SERIES_RESTRICT = prove + (`!f k l:real^N. + ((\n. if n IN k then f(n) else vec 0) sums l) (:num) <=> + (f sums l) k`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN + MATCH_MP_TAC(MESON[] `vsum s f = vsum t f /\ vsum t f = vsum t g + ==> vsum s f = vsum t g`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[]; + MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_INTER]]);; + +let SERIES_VSUM = prove + (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = vec 0) /\ + vsum s f = l ==> (f sums l) k`, + REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN + SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]);; + +let SUMS_REINDEX = prove + (`!k a l:real^N n. + ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VSUM_OFFSET] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; + ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; + +let SUMS_REINDEX_GEN = prove + (`!k a l:real^N s. + ((\x. a(x + k)) sums l) s <=> (a sums l) (IMAGE (\i. i + k) s)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN + MP_TAC(ISPECL + [`k:num`; + `\i. if i IN IMAGE (\i. i + k) s then (a:num->real^N) i else vec 0`; + `l:real^N`; `0`] SUMS_REINDEX) THEN + REWRITE_TAC[FROM_0] THEN + SIMP_TAC[EQ_ADD_RCANCEL; SET_RULE + `(!x y:num. x + k = y + k <=> x = y) + ==> ((x + k) IN IMAGE (\i. i + k) s <=> x IN s)`] THEN + DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; IN_FROM; ADD_CLAUSES] THEN + SUBGOAL_THEN `!x:num. x IN IMAGE (\i. i + k) s ==> k <= x` MP_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN ARITH_TAC; SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Similar combining theorems just for summability. *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_LINEAR = prove + (`!f h s. summable s f /\ linear h ==> summable s (\n. h(f n))`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_LINEAR]);; + +let SUMMABLE_0 = prove + (`!s. summable s (\n. vec 0)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]);; + +let SUMMABLE_ADD = prove + (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_ADD]);; + +let SUMMABLE_SUB = prove + (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUB]);; + +let SUMMABLE_CMUL = prove + (`!s x c. summable s x ==> summable s (\n. c % x n)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_CMUL]);; + +let SUMMABLE_NEG = prove + (`!x s. summable s x ==> summable s (\n. --(x n))`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_NEG]);; + +let SUMMABLE_IFF = prove + (`!f g k. (!x. x IN k ==> f x = g x) ==> (summable k f <=> summable k g)`, + REWRITE_TAC[summable] THEN MESON_TAC[SUMS_IFF]);; + +let SUMMABLE_EQ = prove + (`!f g k. (!x. x IN k ==> f x = g x) /\ summable k f ==> summable k g`, + REWRITE_TAC[summable] THEN MESON_TAC[SUMS_EQ]);; + +let SUMMABLE_COMPONENT = prove + (`!f:num->real^N s k. + summable s f /\ 1 <= k /\ k <= dimindex(:N) + ==> summable s (\i. lift(f(i)$k))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^N` o REWRITE_RULE[summable]) THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `lift((l:real^N)$k)` THEN + ASM_SIMP_TAC[SERIES_COMPONENT]);; + +let SERIES_SUBSET = prove + (`!x s t l. + s SUBSET t /\ + ((\i. if i IN s then x i else vec 0) sums l) t + ==> (x sums l) s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let SUMMABLE_SUBSET = prove + (`!x s t. + s SUBSET t /\ + summable t (\i. if i IN s then x i else vec 0) + ==> summable s x`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUBSET]);; + +let SUMMABLE_TRIVIAL = prove + (`!f:num->real^N. summable {} f`, + GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `vec 0:real^N` THEN + REWRITE_TAC[SERIES_TRIVIAL]);; + +let SUMMABLE_RESTRICT = prove + (`!f:num->real^N k. + summable (:num) (\n. if n IN k then f(n) else vec 0) <=> + summable k f`, + REWRITE_TAC[summable; SERIES_RESTRICT]);; + +let SUMS_FINITE_DIFF = prove + (`!f:num->real^N t s l. + t SUBSET s /\ FINITE t /\ (f sums l) s + ==> (f sums (l - vsum t f)) (s DIFF t)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN + ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN + FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN + MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let SUMS_FINITE_UNION = prove + (`!f:num->real^N s t l. + FINITE t /\ (f sums l) s + ==> (f sums (l + vsum (t DIFF s) f)) (s UNION t)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN + DISCH_THEN(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN + ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN + REWRITE_TAC[IN_DIFF; IN_UNION] THEN + MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let SUMS_OFFSET = prove + (`!f l:real^N m n. + (f sums l) (from m) /\ 0 < n /\ m <= n + ==> (f sums l - vsum (m..n - 1) f) (from n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; + MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; + +let SUMS_OFFSET_REV = prove + (`!f:num->real^N l m n. + (f sums l) (from m) /\ 0 < m /\ n <= m + + ==> (f sums (l + vsum(n..m-1) f)) (from n)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `from m`; `n..m-1`; `l:real^N`] + SUMS_FINITE_UNION) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN + BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN + ASM_ARITH_TAC);; + +let SUMMABLE_REINDEX = prove + (`!k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a`, + REWRITE_TAC[summable; GSYM SUMS_REINDEX]);; + +let SERIES_DROP_LE = prove + (`!f g s a b. + (f sums a) s /\ (g sums b) s /\ + (!x. x IN s ==> drop(f x) <= drop(g x)) + ==> drop a <= drop b`, + REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^1)` THEN + EXISTS_TAC `\n. vsum (s INTER (0..n)) (g:num->real^1)` THEN + ASM_REWRITE_TAC[DROP_VSUM] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; o_THM; IN_INTER; IN_NUMSEG]);; + +let SERIES_DROP_POS = prove + (`!f s a. + (f sums a) s /\ (!x. x IN s ==> &0 <= drop(f x)) + ==> &0 <= drop a`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\n. vec 0):num->real^1`; `f:num->real^1`; `s:num->bool`; + `vec 0:real^1`; `a:real^1`] SERIES_DROP_LE) THEN + ASM_SIMP_TAC[SUMS_0; DROP_VEC]);; + +let SERIES_BOUND = prove + (`!f:num->real^N g s a b. + (f sums a) s /\ ((lift o g) sums (lift b)) s /\ + (!i. i IN s ==> norm(f i) <= g i) + ==> norm(a) <= b`, + REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^N)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..m)) g` THEN CONJ_TAC THEN + ASM_SIMP_TAC[VSUM_NORM_LE; IN_INTER; FINITE_NUMSEG; FINITE_INTER] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN + UNDISCH_TAC `((lift o g) sums lift b) s` THEN + GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN + REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC `m + 1` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `0 < m + 1`; o_DEF; ADD_SUB] THEN + REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN + REWRITE_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SERIES_DROP_POS)) THEN + REWRITE_TAC[DROP_SUB; LIFT_DROP; ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER); + REAL_SUB_LE] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_REFL] THEN + ASM_MESON_TAC[NORM_ARITH `norm(x:real^N) <= y ==> &0 <= y`]);; + +(* ------------------------------------------------------------------------- *) +(* Similar combining theorems for infsum. *) +(* ------------------------------------------------------------------------- *) + +let INFSUM_LINEAR = prove + (`!f h s. summable s f /\ linear h + ==> infsum s (\n. h(f n)) = h(infsum s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_0 = prove + (`infsum s (\i. vec 0) = vec 0`, + MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]);; + +let INFSUM_ADD = prove + (`!x y s. summable s x /\ summable s y + ==> infsum s (\i. x i + y i) = infsum s x + infsum s y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_SUB = prove + (`!x y s. summable s x /\ summable s y + ==> infsum s (\i. x i - y i) = infsum s x - infsum s y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_CMUL = prove + (`!s x c. summable s x ==> infsum s (\n. c % x n) = c % infsum s x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_NEG = prove + (`!s x. summable s x ==> infsum s (\n. --(x n)) = --(infsum s x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_EQ = prove + (`!f g k. summable k f /\ summable k g /\ (!x. x IN k ==> f x = g x) + ==> infsum k f = infsum k g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN + AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ; SUMS_INFSUM]);; + +let INFSUM_RESTRICT = prove + (`!k a:num->real^N. + infsum (:num) (\n. if n IN k then a n else vec 0) = infsum k a`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`a:num->real^N`; `k:num->bool`] SUMMABLE_RESTRICT) THEN + ASM_CASES_TAC `summable k (a:num->real^N)` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THENL + [MATCH_MP_TAC INFSUM_UNIQUE THEN + ASM_REWRITE_TAC[SERIES_RESTRICT; SUMS_INFSUM]; + RULE_ASSUM_TAC(REWRITE_RULE[summable; NOT_EXISTS_THM]) THEN + ASM_REWRITE_TAC[infsum]]);; + +let PARTIAL_SUMS_COMPONENT_LE_INFSUM = prove + (`!f:num->real^N s k n. + 1 <= k /\ k <= dimindex(:N) /\ + (!i. i IN s ==> &0 <= (f i)$k) /\ + summable s f + ==> (vsum (s INTER (0..n)) f)$k <= (infsum s f)$k`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `vsum (s INTER (0..n)) (f:num->real^N)$k - (infsum s f)$k`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N + n:num`)) THEN + REWRITE_TAC[LE_ADD; REAL_NOT_LT; dist] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((vsum (s INTER (0..N + n)) f - infsum s f:real^N)$k)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REAL_ARITH `s < a /\ a <= b ==> a - s <= abs(b - s)`) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + SIMP_TAC[NUMSEG_ADD_SPLIT; LE_0; UNION_OVER_INTER] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhand o rand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; DISJOINT; EXTENSION] THEN + REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_LE_ADDR; VECTOR_ADD_COMPONENT] THEN + ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);; + +let PARTIAL_SUMS_DROP_LE_INFSUM = prove + (`!f s n. + (!i. i IN s ==> &0 <= drop(f i)) /\ + summable s f + ==> drop(vsum (s INTER (0..n)) f) <= drop(infsum s f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[drop] THEN + MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN + ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL; GSYM drop]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy criterion for series. *) +(* ------------------------------------------------------------------------- *) + +let SEQUENCE_CAUCHY_WLOG = prove + (`!P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=> + (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)`, + MESON_TAC[DIST_SYM; LE_CASES]);; + +let VSUM_DIFF_LEMMA = prove + (`!f:num->real^N k m n. + m <= n + ==> vsum(k INTER (0..n)) f - vsum(k INTER (0..m)) f = + vsum(k INTER (m+1..n)) f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `k INTER (0..n)`; `k INTER (0..m)`] + VSUM_DIFF) THEN + ANTS_TAC THENL + [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC + (SET_RULE `s SUBSET t ==> (u INTER s SUBSET u INTER t)`) THEN + REWRITE_TAC[SUBSET; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)`] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_NUMSEG] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC]);; + +let NORM_VSUM_TRIVIAL_LEMMA = prove + (`!e. &0 < e ==> (P ==> norm(vsum(s INTER (m..n)) f) < e <=> + P ==> n < m \/ norm(vsum(s INTER (m..n)) f) < e)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n:num < m` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [GSYM NUMSEG_EMPTY]) THEN + ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0; INTER_EMPTY]);; + +let SERIES_CAUCHY = prove + (`!f s. (?l. (f sums l) s) = + !e. &0 < e + ==> ?N. !m n. m >= N + ==> norm(vsum(s INTER (m..n)) f) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums; CONVERGENT_EQ_CAUCHY; cauchy] THEN + REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN + REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN + REWRITE_TAC[NOT_LT; ARITH_RULE + `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> + N + 1 <= m + 1 /\ m + 1 <= n`] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL + [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN + SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL + [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN + ASM_ARITH_TAC);; + +let SUMMABLE_CAUCHY = prove + (`!f s. summable s f <=> + !e. &0 < e + ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`, + REWRITE_TAC[summable; GSYM SERIES_CAUCHY]);; + +let SUMMABLE_IFF_EVENTUALLY = prove + (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) + ==> (summable k f <=> summable k g)`, + REWRITE_TAC[summable; SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + AP_TERM_TAC THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` + (fun th -> EXISTS_TAC `N0 + N1:num` THEN MP_TAC th)) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER; IN_NUMSEG] THEN + REPEAT STRIP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC);; + +let SUMMABLE_EQ_EVENTUALLY = prove + (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ summable k f + ==> summable k g`, + MESON_TAC[SUMMABLE_IFF_EVENTUALLY]);; + +let SUMMABLE_IFF_COFINITE = prove + (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) + ==> (summable s f <=> summable t f)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN + MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:num.x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN + DISCH_TAC THEN EXISTS_TAC `N + 1` THEN + REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`] THEN ASM SET_TAC[]);; + +let SUMMABLE_EQ_COFINITE = prove + (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f + ==> summable t f`, + MESON_TAC[SUMMABLE_IFF_COFINITE]);; + +let SUMMABLE_FROM_ELSEWHERE = prove + (`!f m n. summable (from m) f ==> summable (from n) f`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ_COFINITE) THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Uniform vesion of Cauchy criterion. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_CAUCHY_UNIFORM = prove + (`!P f:A->num->real^N k. + (?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> dist(vsum(k INTER (0..n)) (f x), + l x) < e) <=> + (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x + ==> norm(vsum(k INTER (m..n)) (f x)) < e)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[sums; UNIFORMLY_CONVERGENT_EQ_CAUCHY; cauchy] THEN + ONCE_REWRITE_TAC[MESON[] + `(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=> + (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)`] THEN + REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN + REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN + REWRITE_TAC[NOT_LT; ARITH_RULE + `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> + N + 1 <= m + 1 /\ m + 1 <= n`] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL + [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN + SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL + [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* So trivially, terms of a convergent series go to zero. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_GOESTOZERO = prove + (`!s x. summable s x + ==> !e. &0 < e + ==> eventually (\n. n IN s ==> norm(x n) < e) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`]) THEN + ASM_SIMP_TAC[NUMSEG_SING; GE; SET_RULE `n IN s ==> s INTER {n} = {n}`] THEN + REWRITE_TAC[VSUM_SING]);; + +let SUMMABLE_IMP_TOZERO = prove + (`!f:num->real^N k. + summable k f + ==> ((\n. if n IN k then f(n) else vec 0) --> vec 0) sequentially`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN + REWRITE_TAC[summable; LIM_SEQUENTIALLY; INTER_UNIV; sums] THEN + DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN + ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> N <= n /\ N <= n - 1`] THEN + ABBREV_TAC `m = n - 1` THEN + SUBGOAL_THEN `n = SUC m` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN + REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC NORM_ARITH);; + +let SUMMABLE_IMP_BOUNDED = prove + (`!f:num->real^N k. summable k f ==> bounded (IMAGE f k)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE; NORM_0]);; + +let SUMMABLE_IMP_SUMS_BOUNDED = prove + (`!f:num->real^N k. + summable (from k) f ==> bounded { vsum(k..n) f | n IN (:num) }`, + REWRITE_TAC[summable; sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Comparison test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_COMPARISON = prove + (`!f g s. (?l. ((lift o g) sums l) s) /\ + (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) + ==> ?l:real^N. (f sums l) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL + [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num /\ m <= x ==> x >= N1`]; + ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num ==> m >= N2`]]);; + +let SUMMABLE_COMPARISON = prove + (`!f g s. summable s (lift o g) /\ + (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) + ==> summable s f`, + REWRITE_TAC[summable; SERIES_COMPARISON]);; + +let SERIES_LIFT_ABSCONV_IMP_CONV = prove + (`!x:num->real^N k. summable k (\n. lift(norm(x n))) ==> summable k x`, + REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\n:num. norm(x n:real^N)` THEN + ASM_REWRITE_TAC[o_DEF; REAL_LE_REFL] THEN ASM_MESON_TAC[]);; + +let SUMMABLE_SUBSET_ABSCONV = prove + (`!x:num->real^N s t. + summable s (\n. lift(norm(x n))) /\ t SUBSET s + ==> summable t (\n. lift(norm(x n)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN + EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\n:num. norm(x n:real^N)` THEN + ASM_REWRITE_TAC[o_DEF; GSYM summable] THEN + EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_LE_REFL; NORM_LIFT; REAL_ABS_NORM; NORM_0; NORM_POS_LE]);; + +let SERIES_COMPARISON_BOUND = prove + (`!f:num->real^N g s a. + (g sums a) s /\ (!i. i IN s ==> norm(f i) <= drop(g i)) + ==> ?l. (f sums l) s /\ norm(l) <= drop a`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] + SUMMABLE_COMPARISON) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; GE; ETA_AX; summable] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[FROM_0; INTER_UNIV; sums]) THEN + MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC + [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] THEN + ASM_REWRITE_TAC[sums; o_DEF; LIFT_DROP; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Uniform version of comparison test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_COMPARISON_UNIFORM = prove + (`!f g P s. (?l. ((lift o g) sums l) s) /\ + (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= g n) + ==> ?l:A->real^N. + !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> dist(vsum(s INTER (0..n)) (f x), + l x) < e`, + REPEAT GEN_TAC THEN SIMP_TAC[GE; SERIES_CAUCHY; SERIES_CAUCHY_UNIFORM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL + [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`]; + ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);; + +(* ------------------------------------------------------------------------- *) +(* Ratio test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_RATIO = prove + (`!c a s N. + c < &1 /\ + (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n))) + ==> ?l:real^N. (a sums l) s`, + REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SERIES_COMPARISON THEN + DISJ_CASES_TAC(REAL_ARITH `c <= &0 \/ &0 < c`) THENL + [EXISTS_TAC `\n:num. &0` THEN REWRITE_TAC[o_DEF; LIFT_NUM] THEN + CONJ_TAC THENL [MESON_TAC[SERIES_0]; ALL_TAC] THEN + EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm(a(n - 1):real^N)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `N + 1 <= n ==> SUC(n - 1) = n /\ N <= n - 1`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --c * x ==> c * x <= &0`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN + UNDISCH_TAC `c <= &0` THEN REAL_ARITH_TAC; + ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`))] THEN + EXISTS_TAC `\n. norm(a(N):real^N) * c pow (n - N)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + EXISTS_TAC `N:num` THEN + SIMP_TAC[GE; LE_EXISTS; IMP_CONJ; ADD_SUB2; LEFT_IMP_EXISTS_THM] THEN + SUBGOAL_THEN `!d:num. norm(a(N + d):real^N) <= norm(a N) * c pow d` + (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_RID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `c * norm((a:num->real^N) (N + d))` THEN + ASM_SIMP_TAC[LE_ADD] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]] THEN + GEN_REWRITE_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC `e:real` THEN + SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER; NORM_LIFT; FINITE_NUMSEG] THEN + DISCH_TAC THEN SIMP_TAC[SUM_LMUL; FINITE_INTER; FINITE_NUMSEG] THEN + ASM_CASES_TAC `(a:num->real^N) N = vec 0` THENL + [ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_ABS_NUM]; ALL_TAC] THEN + MP_TAC(SPECL [`c:real`; `((&1 - c) * e) / norm((a:num->real^N) N)`] + REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_SUB_LT; NORM_POS_LT; GE] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `N + M:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(norm((a:num->real^N) N) * + sum(m..n) (\i. c pow (i - N)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_INTER_NUMSEG; REAL_POW_LE] THEN + MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[REAL_POW_LE] THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_INTER; IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN + DISJ_CASES_TAC(ARITH_RULE `n:num < m \/ m <= n`) THENL + [ASM_SIMP_TAC[SUM_TRIV_NUMSEG; REAL_ABS_NUM; REAL_MUL_RZERO]; ALL_TAC] THEN + SUBGOAL_THEN `m = 0 + m /\ n = (n - m) + m` (CONJUNCTS_THEN SUBST1_TAC) THENL + [UNDISCH_TAC `m:num <= n` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_OFFSET] THEN UNDISCH_TAC `N + M:num <= m` THEN + SIMP_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `(i + (N + M) + d) - N:num = (M + d) + i`] THEN + ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN + ASM_SIMP_TAC[LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ABS_DIV; REAL_POW_LT; REAL_ARITH + `&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c)`; REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x <= &1 /\ &1 <= e ==> abs(c pow 0 - x) < e`) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_1_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `c < &1 ==> x * abs(&1 - c) = (&1 - c) * x`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH + `(((a * b) * c) * d) * e = (e * ((a * b) * c)) * d`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_MUL_LID; + REAL_ARITH `&0 < c ==> abs c = c`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e`)) THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_LE; GSYM REAL_POW_INV] THEN + MATCH_MP_TAC REAL_POW_LE_1 THEN + MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT]]);; + +(* ------------------------------------------------------------------------- *) +(* Ostensibly weaker versions of the boundedness of partial sums. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_PARTIAL_SUMS = prove + (`!f:num->real^N k. + bounded { vsum(k..n) f | n IN (:num) } + ==> bounded { vsum(m..n) f | m IN (:num) /\ n IN (:num) }`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `bounded { vsum(0..n) f:real^N | n IN (:num) }` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[bounded] THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `sum { i:num | i < k} (\i. norm(f i:real^N)) + B` THEN + X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num < k` THENL + [MATCH_MP_TAC(REAL_ARITH + `!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b`) THEN + EXISTS_TAC `sum (0..i) (\i. norm(f i:real^N))` THEN + ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_SUBSET THEN + REWRITE_TAC[FINITE_NUMSEG; FINITE_NUMSEG_LT; NORM_POS_LE] THEN + REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `k = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH + `x <= B /\ &0 <= b ==> x <= b + B`) THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG_LT; NORM_POS_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:num->real^N`; `0`; `k:num`; `i:num`] + VSUM_COMBINE_L) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x) <= a /\ norm(y) <= b ==> norm(x + y) <= a + b`) THEN + ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN + REWRITE_TAC[IMP_IMP; GSYM BOUNDED_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + BOUNDED_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `m:num`; `n:num`] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `n:num < m` THENL + [DISJ2_TAC THEN REPEAT(EXISTS_TAC `vsum(0..0) (f:num->real^N)`) THEN + ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; VECTOR_SUB_REFL] THEN MESON_TAC[]; + ALL_TAC] THEN + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC + [`vsum(0..n) (f:num->real^N)`; `vsum(0..(m-1)) (f:num->real^N)`] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:num->real^N`; `0`; `m:num`; `n:num`] + VSUM_COMBINE_L) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* General Dirichlet convergence test (could make this uniform on a set). *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_BILINEAR_PARTIAL_PRE = prove + (`!f g h:real^M->real^N->real^P l k. + bilinear h /\ + ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\ + summable (from k) (\n. h (f(n + 1) - f(n)) (g(n))) + ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE th]) THEN + DISCH_THEN(X_CHOOSE_TAC `l':real^P`) THEN + EXISTS_TAC `l - (h:real^M->real^N->real^P) (f k) (g(k - 1)) - l'` THEN + REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN + REPEAT(MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]));; + +let SERIES_DIRICHLET_BILINEAR = prove + (`!f g h:real^M->real^N->real^P k m p l. + bilinear h /\ + bounded { vsum (m..n) f | n IN (:num)} /\ + summable (from p) (\n. lift(norm(g(n + 1) - g(n)))) /\ + ((\n. h (g(n + 1)) (vsum(1..n) f)) --> l) sequentially + ==> summable (from k) (\n. h (g n) (f n))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN + EXISTS_TAC `1` THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC SUMMABLE_EQ THEN + EXISTS_TAC `\n. (h:real^M->real^N->real^P) + (g n) (vsum (1..n) f - vsum (1..n-1) f)` THEN + SIMP_TAC[IN_FROM; GSYM NUMSEG_RREC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; + ARITH_RULE `1 <= n ==> ~(n <= n - 1)`] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RSUB] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `p:num` THEN + MP_TAC(ISPECL [`g:num->real^M`; `\n. vsum(1..n) f:real^N`; + `h:real^M->real^N->real^P`; `l:real^P`; `p:num`] + SUMMABLE_BILINEAR_PARTIAL_PRE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `summable (from p) (lift o (\n. C * B * norm(g(n + 1) - g(n):real^M)))` + MP_TAC THENL [ASM_SIMP_TAC[o_DEF; LIFT_CMUL; SUMMABLE_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN + EXISTS_TAC `0` THEN REWRITE_TAC[IN_FROM; GE; LE_0] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `C * norm(g(n + 1) - g(n):real^M) * norm(vsum (1..n) f:real^N)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);; + +let SERIES_DIRICHLET = prove + (`!f:num->real^N g N k m. + bounded { vsum (m..n) f | n IN (:num)} /\ + (!n. N <= n ==> g(n + 1) <= g(n)) /\ + ((lift o g) --> vec 0) sequentially + ==> summable (from k) (\n. g(n) % f(n))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `lift o (g:num->real)`; + `\x y:real^N. drop x % y`] SERIES_DIRICHLET_BILINEAR) THEN + REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`m:num`; `N:num`; `vec 0:real^N`] THEN CONJ_TAC THENL + [REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN + FIRST_ASSUM(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN + REWRITE_TAC[o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN + EXISTS_TAC `\n. lift(g(n) - g(n + 1))` THEN REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `b <= a ==> abs(b - a) = a - b`]; + REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG; VSUM_DIFFS; LIFT_SUB] THEN + REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN + EXISTS_TAC `lift(g(N:num)) - vec 0` THEN + MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]]; + MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN ASM_REWRITE_TAC[o_DEF] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Rearranging absolutely convergent series. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_INJECTIVE_IMAGE_STRONG = prove + (`!x:num->real^N s f. + summable (IMAGE f s) (\n. lift(norm(x n))) /\ + (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) + ==> ((\n. vsum (IMAGE f s INTER (0..n)) x - + vsum (s INTER (0..n)) (x o f)) --> vec 0) + sequentially`, + let lemma = prove + (`!f:A->real^N s t. + FINITE s /\ FINITE t + ==> vsum s f - vsum t f = vsum (s DIFF t) f - vsum (t DIFF s) f`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN + ASM_SIMP_TAC[VSUM_DIFF; INTER_SUBSET] THEN + REWRITE_TAC[INTER_COMM] THEN VECTOR_ARITH_TAC) in + REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUMMABLE_CAUCHY]) THEN + SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN + REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN + SIMP_TAC[real_abs; SUM_POS_LE; NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[dist; GE; VECTOR_SUB_RZERO; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `g:num->num`) THEN + MP_TAC(ISPECL [`g:num->num`; `0..N`] UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + DISCH_THEN(X_CHOOSE_TAC `P:num`) THEN + EXISTS_TAC `MAX N P` THEN X_GEN_TAC `n:num` THEN + SIMP_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE o rand o + rand o lhand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN + SIMP_TAC[FINITE_INTER; FINITE_IMAGE; FINITE_NUMSEG] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(NORM_ARITH + `norm a < e / &2 /\ norm b < e / &2 ==> norm(a - b:real^N) < e`) THEN + CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + SIMP_TAC[FINITE_DIFF; FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC REAL_LET_TRANS THENL + [EXISTS_TAC + `sum(IMAGE (f:num->num) s INTER (N..n)) (\i. norm(x i :real^N))` THEN + ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t) + ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET + IMAGE f s INTER t`) THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_0; NOT_LE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM NOT_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [GSYM CONTRAPOS_THM]) THEN + ASM_SIMP_TAC[] THEN ASM_ARITH_TAC; + MP_TAC(ISPECL [`f:num->num`; `0..n`] UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN + EXISTS_TAC + `sum(IMAGE (f:num->num) s INTER (N..p)) (\i. norm(x i :real^N))` THEN + ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t) + ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET + (IMAGE f s INTER t)`) THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN ASM_ARITH_TAC]);; + +let SERIES_INJECTIVE_IMAGE = prove + (`!x:num->real^N s f l. + summable (IMAGE f s) (\n. lift(norm(x n))) /\ + (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) + ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN + MATCH_MP_TAC LIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN + ASM_REWRITE_TAC[]);; + +let SERIES_REARRANGE_EQ = prove + (`!x:num->real^N s p l. + summable s (\n. lift(norm(x n))) /\ p permutes s + ==> (((x o p) sums l) s <=> (x sums l) s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`x:num->real^N`; `s:num->bool`; `p:num->num`; `l:real^N`] + SERIES_INJECTIVE_IMAGE) THEN + ASM_SIMP_TAC[PERMUTES_IMAGE] THEN + ASM_MESON_TAC[PERMUTES_INJECTIVE]);; + +let SERIES_REARRANGE = prove + (`!x:num->real^N s p l. + summable s (\n. lift(norm(x n))) /\ p permutes s /\ (x sums l) s + ==> ((x o p) sums l) s`, + MESON_TAC[SERIES_REARRANGE_EQ]);; + +let SUMMABLE_REARRANGE = prove + (`!x s p. + summable s (\n. lift(norm(x n))) /\ p permutes s + ==> summable s (x o p)`, + MESON_TAC[SERIES_LIFT_ABSCONV_IMP_CONV; summable; SERIES_REARRANGE]);; + +(* ------------------------------------------------------------------------- *) +(* Banach fixed point theorem (not really topological...) *) +(* ------------------------------------------------------------------------- *) + +let BANACH_FIX = prove + (`!f s c. complete s /\ ~(s = {}) /\ + &0 <= c /\ c < &1 /\ + (IMAGE f s) SUBSET s /\ + (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y)) + ==> ?!x:real^N. x IN s /\ (f x = x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + SUBGOAL_THEN `dist((f:real^N->real^N) x,f y) <= c * dist(x,y)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ARITH `a <= c * a <=> &0 <= --a * (&1 - c)`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; real_div] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ARITH `&0 <= --x <=> ~(&0 < x)`] THEN + MESON_TAC[DIST_POS_LT]] THEN + STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION + `(z 0 = @x:real^N. x IN s) /\ (!n. z(SUC n) = f(z n))`) THEN + SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_IMAGE]; + ALL_TAC] THEN + UNDISCH_THEN `z 0 = @x:real^N. x IN s` (K ALL_TAC) THEN + SUBGOAL_THEN `?x:real^N. x IN s /\ (z --> x) sequentially` MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `e = dist(f(a:real^N),a)` THEN + SUBGOAL_THEN `~(&0 < e)` (fun th -> ASM_MESON_TAC[th; DIST_POS_LT]) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + SUBGOAL_THEN + `dist(f(z N),a:real^N) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2` + (fun th -> ASM_MESON_TAC[th; DIST_TRIANGLE_HALF_R; REAL_LT_REFL]) THEN + CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N <= SUC N`]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `c * dist((z:num->real^N) N,a)` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x < y /\ c * x <= &1 * x ==> c * x < y`) THEN + ASM_SIMP_TAC[LE_REFL; REAL_LE_RMUL; DIST_POS_LE; REAL_LT_IMP_LE]] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [complete]) THEN + ASM_REWRITE_TAC[CAUCHY] THEN + SUBGOAL_THEN `!n. dist(z(n):real^N,z(SUC n)) <= c pow n * dist(z(0),z(1))` + ASSUME_TAC THENL + [INDUCT_TAC THEN + REWRITE_TAC[real_pow; ARITH; REAL_MUL_LID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `c * dist(z(n):real^N,z(SUC n))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n:num. (&1 - c) * dist(z(m):real^N,z(m+n)) + <= c pow m * dist(z(0),z(1)) * (&1 - c pow n)` + ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_SUB_LE; + REAL_POW_1_LE; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `(&1 - c) * (dist(z m:real^N,z(m + n)) + dist(z(m + n),z(m + SUC n)))` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE; DIST_TRIANGLE] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y'`)) THEN + REWRITE_TAC[REAL_ARITH + `q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y)`] THEN + REWRITE_TAC[ADD_CLAUSES; real_pow] THEN + REWRITE_TAC[REAL_ARITH `a * b * (d - c * d) = (&1 - c) * a * d * b`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM REAL_POW_ADD; REAL_MUL_ASSOC] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `(z:num->real^N) 0 = z 1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `0` THEN + REWRITE_TAC[GE; LE_0] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `n:num`]) THEN + REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ASM_CASES_TAC `(z:num->real^N) 0 = z n` THEN + ASM_REWRITE_TAC[DIST_REFL; REAL_NOT_LE] THEN + ASM_SIMP_TAC[REAL_LT_MUL; DIST_POS_LT; REAL_SUB_LT]; + ALL_TAC] THEN + MP_TAC(SPECL [`c:real`; `e * (&1 - c) / dist((z:num->real^N) 0,z 1)`] + REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_SUB_LT; DIST_POS_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[real_div; GE; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM real_div; DIST_POS_LT] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_TAC THEN + REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST_ALL_TAC THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH + `d < e ==> x <= d ==> x < e`)) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `d:num`]) THEN + MATCH_MP_TAC(REAL_ARITH + `(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_ARITH + `&0 <= x ==> &1 - x <= &1`]);; + +(* ------------------------------------------------------------------------- *) +(* Edelstein fixed point theorem. *) +(* ------------------------------------------------------------------------- *) + +let EDELSTEIN_FIX = prove + (`!f s. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(f(x),f(y)) < dist(x,y)) + ==> ?!x:real^N. x IN s /\ f x = x`, + MAP_EVERY X_GEN_TAC [`g:real^N->real^N`; `s:real^N->bool`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]] THEN + SUBGOAL_THEN + `!x y. x IN s /\ y IN s ==> dist((g:real^N->real^N)(x),g(y)) <= dist(x,y)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN + ASM_SIMP_TAC[DIST_REFL; REAL_LE_LT]; + ALL_TAC] THEN + ASM_CASES_TAC `?x:real^N. x IN s /\ ~(g x = x)` THENL + [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `y = (g:real^N->real^N) x` THEN + SUBGOAL_THEN `(y:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_PCROSS o W CONJ) THEN + REWRITE_TAC[compact; PCROSS] THEN + (STRIP_ASSUME_TAC o prove_general_recursive_function_exists) + `?f:num->real^N->real^N. + (!z. f 0 z = z) /\ (!z n. f (SUC n) z = g(f n z))` THEN + SUBGOAL_THEN `!n z. z IN s ==> (f:num->real^N->real^N) n z IN s` + STRIP_ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!m n w z. m <= n /\ w IN s /\ z IN s + ==> dist((f:num->real^N->real^N) n w,f n z) <= dist(f m w,f m z)` + ASSUME_TAC THENL + [REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_SIMP_TAC[REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC + `\n:num. pastecart (f n (x:real^N)) (f n y:real^N)`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`l:real^(N,N)finite_sum`; `s:num->num`] THEN + REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `(\x:real^(N,N)finite_sum. fstcart x) continuous_on UNIV /\ + (\x:real^(N,N)finite_sum. sndcart x) continuous_on UNIV` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART]; + ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th))) THEN + REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; IMP_IMP] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(fun th -> CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B") th THEN + MP_TAC(MATCH_MP LIM_SUB th)) THEN + REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "AB") THEN + SUBGOAL_THEN + `!n. dist(a:real^N,b) <= dist((f:num->real^N->real^N) n x,f n y)` + STRIP_ASSUME_TAC THENL + [X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + USE_THEN "AB" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o MATCH_MP th)) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN + DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN + MATCH_MP_TAC(NORM_ARITH + `dist(fx,fy) <= dist(x,y) + ==> ~(dist(fx - fy,a - b) < dist(a,b) - dist(x,y))`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num` o MATCH_MP MONOTONE_BIGGER) THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL + [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + ABBREV_TAC `e = dist(a,b) - dist((g:real^N->real^N) a,g b)` THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_SUB_LT]; ALL_TAC] THEN + SUBGOAL_THEN + `?n. dist((f:num->real^N->real^N) n x,a) < e / &2 /\ + dist(f n y,b) < e / &2` + STRIP_ASSUME_TAC THENL + [MAP_EVERY (fun s -> USE_THEN s (MP_TAC o SPEC `e / &2` o + REWRITE_RULE[LIM_SEQUENTIALLY])) ["A"; "B"] THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `(s:num->num) (M + N)` THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `dist(f (SUC n) x,(g:real^N->real^N) a) + + dist((f:num->real^N->real^N) (SUC n) y,g b) < e` + MP_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN + CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `dist(x,y) < e + ==> dist(g x,g y) <= dist(x,y) ==> dist(g x,g y) < e`)) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `SUC n` (ASSUME + `!n. dist (a:real^N,b) <= + dist ((f:num->real^N->real^N) n x,f n y)`)) THEN + EXPAND_TAC "e" THEN NORM_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (f:num->real^N->real^N) (SUC(s n)) x` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(g:real^N->real^N) continuous_on s` MP_TAC THENL + [REWRITE_TAC[continuous_on] THEN ASM_MESON_TAC[REAL_LET_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; o_DEF] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[]; + SUBGOAL_THEN `!n. (f:num->real^N->real^N) (SUC n) x = f n y` + (fun th -> ASM_SIMP_TAC[th]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Dini's theorem. *) +(* ------------------------------------------------------------------------- *) + +let DINI = prove + (`!f:num->real^N->real^1 g s. + compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\ + (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\ + (!n x. x IN s ==> drop(f n x) <= drop(f (n + 1) x)) + ==> !e. &0 < e + ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^N m n:num. x IN s /\ m <= n ==> drop(f m x) <= drop(f n x)` + ASSUME_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[ADD1] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num x:real^N. x IN s ==> drop(f n x) <= drop(g x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN + EXISTS_TAC `\m:num. (f:num->real^N->real^1) n x` THEN + EXISTS_TAC `\m:num. (f:num->real^N->real^1) m x` THEN + ASM_SIMP_TAC[LIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY; dist]) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\n. { x | x IN s /\ norm((f:num->real^N->real^1) n x - g x) < e}) + (:num)`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; SUBSET_UNION; UNIONS_IMAGE] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY] THEN + SIMP_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN + ASM_SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_SUB; ETA_AX]; + + DISCH_THEN(X_CHOOSE_THEN `k:num->bool` (CONJUNCTS_THEN2 + (MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) + (LABEL_TAC "*"))) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e`) THEN + ASM_MESON_TAC[LE_TRANS]]);; + +(* ------------------------------------------------------------------------- *) +(* Closest point of a (closed) set to a point. *) +(* ------------------------------------------------------------------------- *) + +let closest_point = new_definition + `closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`;; + +let CLOSEST_POINT_EXISTS = prove + (`!s a. closed s /\ ~(s = {}) + ==> (closest_point s a) IN s /\ + !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)`, + REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN + REWRITE_TAC[DISTANCE_ATTAINS_INF]);; + +let CLOSEST_POINT_IN_SET = prove + (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s`, + MESON_TAC[CLOSEST_POINT_EXISTS]);; + +let CLOSEST_POINT_LE = prove + (`!s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)`, + MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; + +let CLOSEST_POINT_SELF = prove + (`!s x:real^N. x IN s ==> closest_point s x = x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_SIMP_TAC[DIST_LE_0; DIST_REFL]; + STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_POS_LE]]);; + +let CLOSEST_POINT_REFL = prove + (`!s x:real^N. closed s /\ ~(s = {}) ==> (closest_point s x = x <=> x IN s)`, + MESON_TAC[CLOSEST_POINT_IN_SET; CLOSEST_POINT_SELF]);; + +let DIST_CLOSEST_POINT_LIPSCHITZ = prove + (`!s x y:real^N. + closed s /\ ~(s = {}) + ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y)) + <= dist(x,y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN + DISCH_THEN(fun th -> + CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `closest_point s (y:real^N)`) (SPEC `x:real^N` th) THEN + CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `closest_point s (x:real^N)`) (SPEC `y:real^N` th)) THEN + ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let CONTINUOUS_AT_DIST_CLOSEST_POINT = prove + (`!s x:real^N. + closed s /\ ~(s = {}) + ==> (\x. lift(dist(x,closest_point s x))) continuous (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN + ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_DIST_CLOSEST_POINT = prove + (`!s t. closed s /\ ~(s = {}) + ==> (\x. lift(dist(x,closest_point s x))) continuous_on t`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; + CONTINUOUS_AT_DIST_CLOSEST_POINT]);; + +let UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT = prove + (`!s t:real^N->bool. + closed s /\ ~(s = {}) + ==> (\x. lift(dist(x,closest_point s x))) uniformly_continuous_on t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN + ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; + +let SEGMENT_TO_CLOSEST_POINT = prove + (`!s a:real^N. + closed s /\ ~(s = {}) + ==> segment(a,closest_point s a) INTER s = {}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN + MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN + ASM_MESON_TAC[CLOSEST_POINT_EXISTS; REAL_NOT_LT; DIST_SYM]);; + +let SEGMENT_TO_POINT_EXISTS = prove + (`!s a:real^N. + closed s /\ ~(s = {}) ==> ?b. b IN s /\ segment(a,b) INTER s = {}`, + MESON_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]);; + +let CLOSEST_POINT_IN_INTERIOR = prove + (`!s x:real^N. + closed s /\ ~(s = {}) + ==> ((closest_point s x) IN interior s <=> x IN interior s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN + ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN + MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `closest_point s (x:real^N) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; + `closest_point s x - + (min (&1) (e / norm(closest_point s x - x))) % + (closest_point s x - x):real^N`] + CLOSEST_POINT_LE) THEN + ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH + `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE]; + REWRITE_TAC[NORM_MUL; REAL_ARITH + `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN + REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; + +let CLOSEST_POINT_IN_FRONTIER = prove + (`!s x:real^N. + closed s /\ ~(s = {}) /\ ~(x IN interior s) + ==> (closest_point s x) IN frontier s`, + SIMP_TAC[frontier; IN_DIFF; CLOSEST_POINT_IN_INTERIOR] THEN + SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSURE_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* More general infimum of distance between two sets. *) +(* ------------------------------------------------------------------------- *) + +let setdist = new_definition + `setdist(s,t) = + if s = {} \/ t = {} then &0 + else inf {dist(x,y) | x IN s /\ y IN t}`;; + +let SETDIST_EMPTY = prove + (`(!t. setdist({},t) = &0) /\ (!s. setdist(s,{}) = &0)`, + REWRITE_TAC[setdist]);; + +let SETDIST_POS_LE = prove + (`!s t. &0 <= setdist(s,t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_INF THEN + REWRITE_TAC[FORALL_IN_GSPEC; DIST_POS_LE] THEN ASM SET_TAC[]);; + +let REAL_LE_SETDIST = prove + (`!s t:real^N->bool d. + ~(s = {}) /\ ~(t = {}) /\ + (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) + ==> d <= setdist(s,t)`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[setdist] THEN + MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN + ASM_MESON_TAC[]);; + +let SETDIST_LE_DIST = prove + (`!s t x y:real^N. x IN s /\ y IN t ==> setdist(s,t) <= dist(x,y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN + ASM_MESON_TAC[]);; + +let REAL_LE_SETDIST_EQ = prove + (`!d s t:real^N->bool. + d <= setdist(s,t) <=> + (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) /\ + (s = {} \/ t = {} ==> d <= &0)`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[REAL_LE_SETDIST; SETDIST_LE_DIST; REAL_LE_TRANS]);; + +let REAL_SETDIST_LT_EXISTS = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ setdist(s,t) < b + ==> ?x y. x IN s /\ y IN t /\ dist(x,y) < b`, + REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SETDIST_EQ] THEN MESON_TAC[]);; + +let SETDIST_REFL = prove + (`!s:real^N->bool. setdist(s,s) = &0`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[setdist; REAL_LE_REFL]; ALL_TAC] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; MEMBER_NOT_EMPTY; DIST_REFL]);; + +let SETDIST_SYM = prove + (`!s t. setdist(s,t) = setdist(t,s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist; DISJ_SYM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[DIST_SYM]);; + +let SETDIST_TRIANGLE = prove + (`!s a t:real^N->bool. + setdist(s,t) <= setdist(s,{a}) + setdist({a},t)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_LID; SETDIST_POS_LE] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_RID; SETDIST_POS_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN + MATCH_MP_TAC REAL_LE_SETDIST THEN + ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; + RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN + MATCH_MP_TAC REAL_LE_SETDIST THEN + ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; + RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `dist(x:real^N,y)` THEN + ASM_SIMP_TAC[SETDIST_LE_DIST] THEN CONV_TAC NORM_ARITH);; + +let SETDIST_SINGS = prove + (`!x y. setdist({x},{y}) = dist(x,y)`, + REWRITE_TAC[setdist; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y | x IN {a} /\ y IN {b}} = {f a b}`] THEN + SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);; + +let SETDIST_LIPSCHITZ = prove + (`!s t x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN + REWRITE_TAC[REAL_ARITH + `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN + MESON_TAC[SETDIST_TRIANGLE; SETDIST_SYM]);; + +let CONTINUOUS_AT_LIFT_SETDIST = prove + (`!s x:real^N. (\y. lift(setdist({y},s))) continuous (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN + ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_LIFT_SETDIST = prove + (`!s t:real^N->bool. (\y. lift(setdist({y},s))) continuous_on t`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; + CONTINUOUS_AT_LIFT_SETDIST]);; + +let UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST = prove + (`!s t:real^N->bool. + (\y. lift(setdist({y},s))) uniformly_continuous_on t`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN + ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; + +let SETDIST_DIFFERENCES = prove + (`!s t. setdist(s,t) = setdist({vec 0},{x - y:real^N | x IN s /\ y IN t})`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist; NOT_INSERT_EMPTY; + SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2; DIST_0] THEN + REWRITE_TAC[dist] THEN MESON_TAC[]);; + +let SETDIST_SUBSET_RIGHT = prove + (`!s t u:real^N->bool. + ~(t = {}) /\ t SUBSET u ==> setdist(s,u) <= setdist(s,t)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; SETDIST_POS_LE; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MESON_TAC[DIST_POS_LE]);; + +let SETDIST_SUBSET_LEFT = prove + (`!s t u:real^N->bool. + ~(s = {}) /\ s SUBSET t ==> setdist(t,u) <= setdist(s,u)`, + MESON_TAC[SETDIST_SUBSET_RIGHT; SETDIST_SYM]);; + +let SETDIST_CLOSURE = prove + (`(!s t:real^N->bool. setdist(closure s,t) = setdist(s,t)) /\ + (!s t:real^N->bool. setdist(s,closure t) = setdist(s,t))`, + GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN + REWRITE_TAC[] THEN + REWRITE_TAC[MESON[REAL_LE_ANTISYM] + `x:real = y <=> !d. d <= x <=> d <= y`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; CLOSURE_EMPTY; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET c /\ + (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y)) + ==> ((!x y. x IN c /\ Q y ==> P x y) <=> + (!x y. x IN s /\ Q y ==> P x y))`) THEN + REWRITE_TAC[CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN + ASM_REWRITE_TAC[o_DEF; dist] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; + +let SETDIST_COMPACT_CLOSED = prove + (`!s t:real^N->bool. + compact s /\ closed t /\ ~(s = {}) /\ ~(t = {}) + ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + MATCH_MP_TAC(MESON[] + `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) + ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN + SIMP_TAC[SETDIST_LE_DIST] THEN + ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] + DISTANCE_ATTAINS_INF) THEN + ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; + DIST_0; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let SETDIST_CLOSED_COMPACT = prove + (`!s t:real^N->bool. + closed s /\ compact t /\ ~(s = {}) /\ ~(t = {}) + ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + MATCH_MP_TAC(MESON[] + `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) + ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN + SIMP_TAC[SETDIST_LE_DIST] THEN + ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] + DISTANCE_ATTAINS_INF) THEN + ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; + DIST_0; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let SETDIST_EQ_0_COMPACT_CLOSED = prove + (`!s t:real^N->bool. + compact s /\ closed t + ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0]; + REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + MESON_TAC[SETDIST_LE_DIST; DIST_EQ_0]]);; + +let SETDIST_EQ_0_CLOSED_COMPACT = prove + (`!s t:real^N->bool. + closed s /\ compact t + ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, + ONCE_REWRITE_TAC[SETDIST_SYM] THEN + SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]);; + +let SETDIST_EQ_0_BOUNDED = prove + (`!s t:real^N->bool. + (bounded s \/ bounded t) + ==> (setdist(s,t) = &0 <=> + s = {} \/ t = {} \/ ~(closure(s) INTER closure(t) = {}))`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] + `setdist(s,t) = setdist(closure s,closure t)`] THEN + ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; SETDIST_EQ_0_CLOSED_COMPACT; + COMPACT_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY]);; + + +let SETDIST_TRANSLATION = prove + (`!a:real^N s t. + setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = + {f (g x) (g y) | x IN s /\ y IN t}`] THEN + REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; + +add_translation_invariants [SETDIST_TRANSLATION];; + +let SETDIST_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x. norm(f x) = norm x) + ==> setdist(IMAGE f s,IMAGE f t) = setdist(s,t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = + {f (g x) (g y) | x IN s /\ y IN t}`] THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN + ASM_REWRITE_TAC[]);; + +add_linear_invariants [SETDIST_LINEAR_IMAGE];; + +let SETDIST_UNIQUE = prove + (`!s t a b:real^N d. + a IN s /\ b IN t /\ dist(a,b) = d /\ + (!x y. x IN s /\ y IN t ==> dist(a,b) <= dist(x,y)) + ==> setdist(s,t) = d`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SETDIST_LE_DIST]; + MATCH_MP_TAC REAL_LE_SETDIST THEN ASM SET_TAC[]]);; + +let SETDIST_CLOSEST_POINT = prove + (`!a:real^N s. + closed s /\ ~(s = {}) ==> setdist({a},s) = dist(a,closest_point s a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; IN_SING; UNWIND_THM2] THEN + EXISTS_TAC `closest_point s (a:real^N)` THEN + ASM_MESON_TAC[CLOSEST_POINT_EXISTS; DIST_SYM]);; + +let SETDIST_EQ_0_SING = prove + (`(!s x:real^N. setdist({x},s) = &0 <=> s = {} \/ x IN closure s) /\ + (!s x:real^N. setdist(s,{x}) = &0 <=> s = {} \/ x IN closure s)`, + SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_SING; CLOSURE_SING] THEN SET_TAC[]);; + +let SETDIST_EQ_0_CLOSED = prove + (`!s x. closed s ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, + SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_SING] THEN SET_TAC[]);; + +let SETDIST_EQ_0_CLOSED_IN = prove + (`!u s x. closed_in (subtopology euclidean u) s /\ x IN u + ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, + REWRITE_TAC[SETDIST_EQ_0_SING; CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]);; + +let SETDIST_SING_IN_SET = prove + (`!x s. x IN s ==> setdist({x},s) = &0`, + SIMP_TAC[SETDIST_EQ_0_SING; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);; + +let SETDIST_SING_TRIANGLE = prove + (`!s x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_SUB_REFL; REAL_ABS_NUM; DIST_POS_LE] THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_NEG_SUB] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a - b <= c <=> a - c <= b`; + REAL_ARITH `--a <= b - c <=> c - a <= b`] THEN + MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN + SIMP_TAC[IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `a <= dist(y:real^N,z) ==> a - dist(x,y) <= dist(x,z)`); + MATCH_MP_TAC(NORM_ARITH + `a <= dist(x:real^N,z) ==> a - dist(x,y) <= dist(y,z)`)] THEN + MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; + +let SETDIST_LE_SING = prove + (`!s t x:real^N. x IN s ==> setdist(s,t) <= setdist({x},t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_LEFT THEN ASM SET_TAC[]);; + +let SETDIST_BALLS = prove + (`(!a b:real^N r s. + setdist(ball(a,r),ball(b,s)) = + if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ + (!a b:real^N r s. + setdist(ball(a,r),cball(b,s)) = + if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ + (!a b:real^N r s. + setdist(cball(a,r),ball(b,s)) = + if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ + (!a b:real^N r s. + setdist(cball(a,r),cball(b,s)) = + if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))`, + REWRITE_TAC[MESON[] + `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN + SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; SETDIST_EMPTY; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] + `setdist(s,t) = setdist(closure s,closure t)`] THEN + SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN + REWRITE_TAC[SETDIST_CLOSURE] THEN + MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT GEN_TAC] THEN + REWRITE_TAC[real_max; REAL_SUB_LE] THEN COND_CASES_TAC THEN + SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; + CBALL_EQ_EMPTY; INTER_BALLS_EQ_EMPTY] + THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_CASES_TAC `b:real^N = a` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN + ASM_CASES_TAC `r = &0 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[CBALL_SING; SETDIST_SINGS] THEN REAL_ARITH_TAC; + STRIP_TAC] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_SETDIST THEN + ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; IN_CBALL] THEN + CONV_TAC NORM_ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `dist(a + r / dist(a,b) % (b - a):real^N, + b - s / dist(a,b) % (b - a))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SETDIST_LE_DIST THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a + x) = norm x`; + NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[dist; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[dist; VECTOR_ARITH + `(a + d % (b - a)) - (b - e % (b - a)):real^N = + (&1 - d - e) % (a - b)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ARITH + `&1 - r / y - s / y = &1 - (r + s) / y`] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; NORM_EQ_0; REAL_FIELD + `~(n = &0) ==> (&1 - x / n) * n = n - x`] THEN + REWRITE_TAC[GSYM dist] THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Use set distance for an easy proof of separation properties etc. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATION_CLOSURES = prove + (`!s t:real^N->bool. + s INTER closure(t) = {} /\ t INTER closure(s) = {} + ==> ?u v. DISJOINT u v /\ open u /\ open v /\ + s SUBSET u /\ t SUBSET v`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `(:real^N)`] THEN + ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN + ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `{x | x IN (:real^N) /\ + lift(setdist({x},t) - setdist({x},s)) IN + {x | &0 < x$1}}` THEN + EXISTS_TAC `{x | x IN (:real^N) /\ + lift(setdist({x},t) - setdist({x},s)) IN + {x | x$1 < &0}}` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN + SIMP_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN + SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN + SIMP_TAC[OPEN_HALFSPACE_COMPONENT_LT; OPEN_UNIV] THEN + SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ y = &0 /\ ~(x = &0) ==> &0 < x - y`); + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ x = &0 /\ ~(y = &0) ==> x - y < &0`)] THEN + ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_BOUNDED; BOUNDED_SING] THEN + ASM_SIMP_TAC[CLOSED_SING; CLOSURE_CLOSED; NOT_INSERT_EMPTY; + REWRITE_RULE[SUBSET] CLOSURE_SUBSET; + SET_RULE `{a} INTER s = {} <=> ~(a IN s)`] THEN + ASM SET_TAC[]);; + +let SEPARATION_NORMAL = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ s INTER t = {} + ==> ?u v. open u /\ open v /\ + s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN + MATCH_MP_TAC SEPARATION_CLOSURES THEN + ASM_SIMP_TAC[CLOSURE_CLOSED] THEN ASM SET_TAC[]);; + +let SEPARATION_NORMAL_LOCAL = prove + (`!s t u:real^N->bool. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} + ==> ?s' t'. open_in (subtopology euclidean u) s' /\ + open_in (subtopology euclidean u) t' /\ + s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `u:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN + ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `{}:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN + ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; + ALL_TAC] THEN + EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},s) < setdist({x},t)}` THEN + EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},t) < setdist({x},s)}` THEN + SIMP_TAC[EXTENSION; SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; IN_INTER; + NOT_IN_EMPTY; SETDIST_POS_LE; CONJ_ASSOC; + REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_ANTISYM]] THEN + ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[SETDIST_EQ_0_CLOSED_IN; CLOSED_IN_IMP_SUBSET; SUBSET; + MEMBER_NOT_EMPTY; IN_INTER]] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 < x <=> &0 < drop(lift x)`] THEN + REWRITE_TAC[SET_RULE + `{x | x IN u /\ &0 < drop(f x)} = + {x | x IN u /\ f x IN {x | &0 < drop x}}`] THEN + REWRITE_TAC[drop] THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; LIFT_SUB; + REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]);; + +let SEPARATION_NORMAL_COMPACT = prove + (`!s t:real^N->bool. + compact s /\ closed t /\ s INTER t = {} + ==> ?u v. open u /\ compact(closure u) /\ open v /\ + s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t UNION ((:real^N) DIFF ball(vec 0,r))`] + SEPARATION_NORMAL) THEN + ASM_SIMP_TAC[CLOSED_UNION; GSYM OPEN_CLOSED; OPEN_BALL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE; ASM SET_TAC[]] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN + REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]);; + +let SEPARATION_HAUSDORFF = prove + (`!x:real^N y. + ~(x = y) + ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`{x:real^N}`; `{y:real^N}`] SEPARATION_NORMAL) THEN + REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let SEPARATION_T2 = prove + (`!x:real^N y. + ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ + (u INTER v = {})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SEPARATION_HAUSDORFF] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let SEPARATION_T1 = prove + (`!x:real^N y. + ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\ + ~(x IN v) /\ y IN v`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_SIMP_TAC[SEPARATION_T2; EXTENSION; NOT_IN_EMPTY; IN_INTER]; + ALL_TAC] THEN MESON_TAC[]);; + +let SEPARATION_T0 = prove + (`!x:real^N y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)`, + MESON_TAC[SEPARATION_T1]);; + +(* ------------------------------------------------------------------------- *) +(* Hausdorff distance between sets. *) +(* ------------------------------------------------------------------------- *) + +let hausdist = new_definition + `hausdist(s:real^N->bool,t:real^N->bool) = + let ds = {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} in + if ~(ds = {}) /\ (?b. !d. d IN ds ==> d <= b) then sup ds + else &0`;; + +let HAUSDIST_POS_LE = prove + (`!s t:real^N->bool. &0 <= hausdist(s,t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y`) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE]);; + +let HAUSDIST_REFL = prove + (`!s:real^N->bool. hausdist(s,s) = &0`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE] THEN + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_SUP_LE THEN + REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET; REAL_LE_REFL]);; + +let HAUSDIST_SYM = prove + (`!s t:real^N->bool. hausdist(s,t) = hausdist(t,s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN + REWRITE_TAC[]);; + +let HAUSDIST_EMPTY = prove + (`(!t:real^N->bool. hausdist ({},t) = &0) /\ + (!s:real^N->bool. hausdist (s,{}) = &0)`, + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`; UNION_EMPTY] THEN + REWRITE_TAC[SET_RULE `{c |x| x IN s} = {} <=> s = {}`] THEN + X_GEN_TAC `s:real^N->bool` THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> {c |x| x IN s} = {c}`] THEN + REWRITE_TAC[SUP_SING; COND_ID]);; + +let HAUSDIST_SINGS = prove + (`!x y:real^N. hausdist({x},{y}) = dist(x,y)`, + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN + REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`] THEN + REWRITE_TAC[DIST_SYM; UNION_IDEMPOT; SUP_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN + MESON_TAC[REAL_LE_REFL]);; + +let HAUSDIST_EQ = prove + (`!s t:real^M->bool s' t':real^N->bool. + (!b. (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= b) <=> + (!x. x IN s' ==> setdist({x},t') <= b) /\ + (!y. y IN t' ==> setdist({y},s') <= b)) + ==> hausdist(s,t) = hausdist(s',t')`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + MATCH_MP_TAC(MESON[] + `(p <=> p') /\ s = s' + ==> (if p then s else &0) = (if p' then s' else &0)`) THEN + CONJ_TAC THENL + [BINOP_TAC THENL + [PURE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`]; + AP_TERM_TAC THEN ABS_TAC]; + MATCH_MP_TAC SUP_EQ] THEN + PURE_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `--(&1):real`) THEN + SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> ~(x <= --(&1))`] THEN + SET_TAC[]);; + +let HAUSDIST_TRANSLATION = prove + (`!a s t:real^N->bool. + hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN + REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN + REWRITE_TAC[SET_RULE `{a + x:real^N} = IMAGE (\x. a + x) {x}`] THEN + REWRITE_TAC[SETDIST_TRANSLATION]);; + +add_translation_invariants [HAUSDIST_TRANSLATION];; + +let HAUSDIST_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x. norm(f x) = norm x) + ==> hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t)`, + REPEAT STRIP_TAC THEN + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN + REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN + ONCE_REWRITE_TAC[SET_RULE `{(f:real^M->real^N) x} = IMAGE f {x}`] THEN + ASM_SIMP_TAC[SETDIST_LINEAR_IMAGE]);; + +add_linear_invariants [HAUSDIST_LINEAR_IMAGE];; + +let HAUSDIST_CLOSURE = prove + (`(!s t:real^N->bool. hausdist(closure s,t) = hausdist(s,t)) /\ + (!s t:real^N->bool. hausdist(s,closure t) = hausdist(s,t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN + GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN + PURE_ONCE_REWRITE_TAC[SET_RULE + `(!x. P x ==> Q x) <=> (!x. P x ==> x IN {x | Q x})`] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN + REWRITE_TAC[EMPTY_GSPEC; CONTINUOUS_ON_ID; CLOSED_EMPTY] THEN + ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x <= b <=> drop(lift x) <= b`] THEN + REWRITE_TAC[SET_RULE + `{x | drop(lift(f x)) <= b} = + {x | x IN UNIV /\ lift(f x) IN {x | drop x <= b}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_LIFT_SETDIST] THEN + REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]);; + +let REAL_HAUSDIST_LE = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ + (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= b) + ==> hausdist(s,t) <= b`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN + ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC REAL_SUP_LE THEN + ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]);; + +let REAL_HAUSDIST_LE_SUMS = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ + s SUBSET {y + z | y IN t /\ z IN cball(vec 0,b)} /\ + t SUBSET {y + z | y IN s /\ z IN cball(vec 0,b)} + ==> hausdist(s,t) <= b`, + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_MESON_TAC[SETDIST_LE_DIST; REAL_LE_TRANS; IN_SING]);; + +let REAL_LE_HAUSDIST = prove + (`!s t:real^N->bool a b c z. + ~(s = {}) /\ ~(t = {}) /\ + (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= c) /\ + (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s)) + ==> a <= hausdist(s,t)`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN + ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LE_SUP THEN + ASM_SIMP_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[NOT_FORALL_THM]] THEN + EXISTS_TAC `max b c:real` THEN + ASM_SIMP_TAC[REAL_LE_MAX] THEN ASM SET_TAC[]);; + +let SETDIST_LE_HAUSDIST = prove + (`!s t:real^N->bool. + bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SETDIST_LE_SING; MEMBER_NOT_EMPTY]] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + CONJ_TAC THEN EXISTS_TAC `b:real` THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[REAL_LE_TRANS; SETDIST_LE_DIST; MEMBER_NOT_EMPTY; IN_SING; + DIST_SYM]);; + +let SETDIST_SING_LE_HAUSDIST = prove + (`!s t x:real^N. + bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_OR_THM; CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM dist] THEN GEN_TAC THENL + [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN + REPEAT STRIP_TAC THENL + [UNDISCH_TAC `~(t:real^N->bool = {})`; + UNDISCH_TAC `~(s:real^N->bool = {})`] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THENL + [ALL_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN + MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; + +let UPPER_LOWER_HEMICONTINUOUS = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) /\ + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) /\ + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) + ==> !x e. x IN s /\ &0 < e /\ bounded(f x) + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x,x') < d + ==> hausdist(f x,f x') < e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(f:real^M->real^N->bool) x = {}` THENL + [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`] o MATCH_MP + UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `t INTER ball(vec 0:real^N,r)` o + CONJUNCT1 o CONJUNCT2) THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[open_in] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN + ASM_SIMP_TAC[SUBSET_INTER; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x':real^M`)) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `(f:real^M->real^N->bool) x' = {}` THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; + IN_SING; REAL_LT_IMP_LE]);; + +let HAUSDIST_NONTRIVIAL = prove + (`!s t:real^N->bool. + bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = + sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + ASM_SIMP_TAC[EMPTY_UNION; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_NONTRIVIAL_ALT = prove + (`!s t:real^N->bool. + bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = max (sup {setdist ({x},t) | x IN s}) + (sup {setdist ({y},s) | y IN t})`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL] THEN + MATCH_MP_TAC SUP_UNION THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + CONJ_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let REAL_HAUSDIST_LE_EQ = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t + ==> (hausdist(s,t) <= b <=> + (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= b))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL_ALT; REAL_MAX_LE] THEN + BINOP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x <= b) <=> + (!y. y IN {f x | x IN s} ==> y <= b)`] THEN + MATCH_MP_TAC REAL_SUP_LE_EQ THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_COMPACT_EXISTS = prove + (`!s t:real^N->bool. + bounded s /\ compact t /\ ~(t = {}) + ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`] + SETDIST_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[COMPACT_SING; COMPACT_IMP_CLOSED; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; UNWIND_THM2; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_HAUSDIST THEN + ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN + REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_COMPACT_SUMS = prove + (`!s t:real^N->bool. + bounded s /\ compact t /\ ~(t = {}) + ==> s SUBSET {y + z | y IN t /\ z IN cball(vec 0,hausdist(s,t))}`, + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[GSYM dist; HAUSDIST_COMPACT_EXISTS]);; + +let HAUSDIST_TRANS = prove + (`!s t u:real^N->bool. + bounded s /\ bounded t /\ bounded u /\ ~(t = {}) + ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`, + let lemma = prove + (`!s t u:real^N->bool. + bounded s /\ bounded t /\ bounded u /\ + ~(s = {}) /\ ~(t = {}) /\ ~(u = {}) + ==> !x. x IN s ==> setdist({x},u) <= hausdist(s,t) + hausdist(t,u)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`closure s:real^N->bool`; `closure t:real^N->bool`] + HAUSDIST_COMPACT_EXISTS) THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`closure t:real^N->bool`; `closure u:real^N->bool`] + HAUSDIST_COMPACT_EXISTS) THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[SETDIST_CLOSURE; SETDIST_LE_DIST; IN_SING]; ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y) + dist(y,z)` THEN + REWRITE_TAC[DIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_LID; HAUSDIST_POS_LE] THEN + ASM_CASES_TAC `u:real^N->bool = {}` THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_RID; HAUSDIST_POS_LE] THEN + ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ] THEN + ASM_MESON_TAC[lemma; HAUSDIST_SYM; SETDIST_SYM; REAL_ADD_SYM]);; + +let HAUSDIST_EQ_0 = prove + (`!s t:real^N->bool. + bounded s /\ bounded t + ==> (hausdist(s,t) = &0 <=> s = {} \/ t = {} \/ closure s = closure t)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN + ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE; REAL_HAUSDIST_LE_EQ] THEN + SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN + ASM_REWRITE_TAC[SETDIST_EQ_0_SING; GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN + SIMP_TAC[FORALL_IN_CLOSURE_EQ; CLOSED_CLOSURE; CONTINUOUS_ON_ID]);; + +let HAUSDIST_COMPACT_NONTRIVIAL = prove + (`!s t:real^N->bool. + compact s /\ compact t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = + inf {e | &0 <= e /\ + s SUBSET {x + y | x IN t /\ norm y <= e} /\ + t SUBSET {x + y | x IN s /\ norm y <= e}}`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INF_UNIQUE THEN + REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; + IN_SING; REAL_LT_IMP_LE]; + REPEAT STRIP_TAC THEN EXISTS_TAC `hausdist(s:real^N->bool,t)` THEN + ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN + ASM_MESON_TAC[DIST_SYM; HAUSDIST_SYM; + HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]]);; + +let HAUSDIST_BALLS = prove + (`(!a b:real^N r s. + hausdist(ball(a,r),ball(b,s)) = + if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ + (!a b:real^N r s. + hausdist(ball(a,r),cball(b,s)) = + if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\ + (!a b:real^N r s. + hausdist(cball(a,r),ball(b,s)) = + if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ + (!a b:real^N r s. + hausdist(cball(a,r),cball(b,s)) = + if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))`, + REWRITE_TAC[MESON[] + `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN + SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; HAUSDIST_EMPTY; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] + `hausdist(s,t) = hausdist(closure s,closure t)`] THEN + SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN + REWRITE_TAC[HAUSDIST_CLOSURE] THEN + MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC] THEN + ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; BOUNDED_CBALL; CBALL_EQ_EMPTY; + REAL_NOT_LT] THEN + MATCH_MP_TAC SUP_UNIQUE THEN + REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN + REWRITE_TAC[MESON[CBALL_SING] `{a} = cball(a:real^N,&0)`] THEN + ASM_REWRITE_TAC[SETDIST_BALLS; REAL_LT_REFL] THEN + X_GEN_TAC `c:real` THEN REWRITE_TAC[IN_CBALL] THEN + EQ_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN + ASM_CASES_TAC `b:real^N = a` THENL + [ASM_REWRITE_TAC[DIST_SYM; DIST_REFL; REAL_MAX_LE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `a + r % basis 1:real^N`) + (MP_TAC o SPEC `a + s % basis 1:real^N`)) THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `a - r / dist(a,b) % (b - a):real^N`) + (MP_TAC o SPEC `b - s / dist(a,b) % (a - b):real^N`)) THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH + `b - e % (a - b) - a:real^N = (&1 + e) % (b - a)`] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN + REWRITE_TAC[NORM_SUB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let HAUSDIST_ALT = prove + (`!s t:real^N->bool. + bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = + sup {abs(setdist({x},s) - setdist({x},t)) | x IN (:real^N)}`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM(CONJUNCT2 SETDIST_CLOSURE); + GSYM CLOSURE_EQ_EMPTY; MESON[HAUSDIST_CLOSURE] + `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN + SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN + SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; COMPACT_IMP_BOUNDED] THEN + MATCH_MP_TAC SUP_EQ THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC; IN_UNIV] THEN + REWRITE_TAC[REAL_ARITH `abs(y - x) <= b <=> x <= y + b /\ y <= x + b`] THEN + GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN BINOP_TAC THEN + (EQ_TAC THENL [ALL_TAC; MESON_TAC[SETDIST_SING_IN_SET; REAL_ADD_LID]]) THEN + DISCH_TAC THEN X_GEN_TAC `z:real^N` THENL + [MP_TAC(ISPECL[`{z:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT); + MP_TAC(ISPECL[`{z:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN + ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL + [MP_TAC(ISPECL[`{y:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT); + MP_TAC(ISPECL[`{y:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN + ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + TRANS_TAC REAL_LE_TRANS `dist(z:real^N,x)` THEN + ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN + UNDISCH_TAC `dist(y:real^N,x) <= b` THEN CONV_TAC NORM_ARITH);; + +let CONTINUOUS_DIAMETER = prove + (`!s:real^N->bool e. + bounded s /\ ~(s = {}) /\ &0 < e + ==> ?d. &0 < d /\ + !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d + ==> abs(diameter s - diameter t) < e`, + REPEAT STRIP_TAC THEN EXISTS_TAC `e / &2` THEN + ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `diameter(s:real^N->bool) - diameter(t:real^N->bool) = + diameter(closure s) - diameter(closure t)` + SUBST1_TAC THENL [ASM_MESON_TAC[DIAMETER_CLOSURE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&2 * hausdist(s:real^N->bool,t)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MP_TAC(ISPECL [`vec 0:real^N`; `hausdist(s:real^N->bool,t)`] + DIAMETER_CBALL) THEN + ASM_SIMP_TAC[HAUSDIST_POS_LE; GSYM REAL_NOT_LE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH + `x <= y + e /\ y <= x + e ==> abs(x - y) <= e`) THEN + CONJ_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN + ASM_SIMP_TAC[BOUNDED_CBALL; BOUNDED_CLOSURE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC DIAMETER_SUBSET THEN + ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL; BOUNDED_CLOSURE] THEN + ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] + `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] + THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN + MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Isometries are embeddings, and even surjective in the compact case. *) +(* ------------------------------------------------------------------------- *) + +let ISOMETRY_IMP_OPEN_MAP = prove + (`!f:real^M->real^N s t u. + IMAGE f s = t /\ + (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\ + open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)`, + REWRITE_TAC[open_in; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + ASM_SIMP_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]);; + +let ISOMETRY_IMP_EMBEDDING = prove + (`!f:real^M->real^N s t. + IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) + ==> ?g. homeomorphism (s,t) (f,g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + ASM_SIMP_TAC[ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; REPEAT STRIP_TAC] THEN + MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);; + +let ISOMETRY_IMP_HOMEOMORPHISM_COMPACT = prove + (`!f s:real^N->bool. + compact s /\ IMAGE f s SUBSET s /\ + (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) + ==> ?g. homeomorphism (s,s) (f,g)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s` + (fun th -> ASM_MESON_TAC[th; ISOMETRY_IMP_EMBEDDING]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `setdist({x},IMAGE (f:real^N->real^N) s) = &0` MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN + REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN + (X_CHOOSE_THEN `z:num->real^N` STRIP_ASSUME_TAC o + prove_recursive_functions_exist num_RECURSION) + `z 0 = (x:real^N) /\ !n. z(SUC n) = f(z n)` THEN + SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN + DISCH_THEN(MP_TAC o SPEC `z:num->real^N`) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN + REWRITE_TAC[cauchy] THEN + DISCH_THEN(MP_TAC o SPEC `setdist({x},IMAGE (f:real^N->real^N) s)`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` + (MP_TAC o SPECL [`N:num`; `N + 1`])) THEN + ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[REAL_NOT_LT; o_THM]] THEN + SUBGOAL_THEN `(r:num->num) N < r (N + 1)` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z(SUC d))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SPEC_TAC(`(r:num->num) N`,`m:num`) THEN + INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES]; + REWRITE_TAC[SETDIST_EQ_0_SING; IMAGE_EQ_EMPTY] THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED; NOT_IN_EMPTY; + COMPACT_CONTINUOUS_IMAGE; CLOSURE_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* Urysohn's lemma (for real^N, where the proof is easy using distances). *) +(* ------------------------------------------------------------------------- *) + +let URYSOHN_LOCAL_STRONG = prove + (`!s t u a b. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} /\ ~(a = b) + ==> ?f:real^N->real^M. + f continuous_on u /\ + (!x. x IN u ==> f(x) IN segment[a,b]) /\ + (!x. x IN u ==> (f x = a <=> x IN s)) /\ + (!x. x IN u ==> (f x = b <=> x IN t))`, + let lemma = prove + (`!s t u a b. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b) + ==> ?f:real^N->real^M. + f continuous_on u /\ + (!x. x IN u ==> f(x) IN segment[a,b]) /\ + (!x. x IN u ==> (f x = a <=> x IN s)) /\ + (!x. x IN u ==> (f x = b <=> x IN t))`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `\x:real^N. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) % + (b - a:real^M)` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `(!x:real^N. x IN u ==> (setdist({x},s) = &0 <=> x IN s)) /\ + (!x:real^N. x IN u ==> (setdist({x},t) = &0 <=> x IN t))` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `s:real^N->bool` CLOSED_IN_CLOSED); + MP_TAC(ISPEC `t:real^N->bool` CLOSED_IN_CLOSED)] THEN + DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + ASM_MESON_TAC[CLOSURE_CLOSED; INTER_SUBSET; SUBSET_CLOSURE; SUBSET; + IN_INTER; CLOSURE_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:real^N. x IN u ==> &0 < setdist({x},s) + setdist({x},t)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN + REWRITE_TAC[SETDIST_POS_LE] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC) THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF] THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[segment; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; LEFT_OR_DISTRIB; VECTOR_ARITH + `a + x % (b - a):real^N = (&1 - u) % a + u % b <=> + (x - u) % (b - a) = vec 0`; + EXISTS_OR_THM] THEN + DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[REAL_SUB_0; UNWIND_THM1] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; SETDIST_POS_LE; REAL_LE_LDIV_EQ; + REAL_ARITH `a <= &1 * (a + b) <=> &0 <= b`]; + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`]; + REWRITE_TAC[VECTOR_ARITH `a + x % (b - a):real^N = b <=> + (x - &1) % (b - a) = vec 0`]] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[REAL_SUB_0; REAL_EQ_LDIV_EQ; + REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `x:real = x + y <=> y = &0`] THEN + ASM_REWRITE_TAC[]) in + MATCH_MP_TAC(MESON[] + `(!s t. P s t <=> P t s) /\ + (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\ + P {} {} /\ (!t. ~(t = {}) ==> P {} t) + ==> !s t. P s t`) THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + REWRITE_TAC[SEGMENT_SYM; INTER_COMM; CONJ_ACI; EQ_SYM_EQ]; + SIMP_TAC[lemma]; + REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. midpoint(a,b)):real^N->real^M` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_CONST; MIDPOINT_IN_SEGMENT] THEN + REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `~(a:real^M = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + VECTOR_ARITH_TAC; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = u` THENL + [EXISTS_TAC `(\x. b):real^N->real^M` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; ENDS_IN_SEGMENT; IN_UNIV; + CONTINUOUS_ON_CONST]; + SUBGOAL_THEN `?c:real^N. c IN u /\ ~(c IN t)` STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`{c:real^N}`; `t:real^N->bool`; `u:real^N->bool`; + `midpoint(a,b):real^M`; `b:real^M`] lemma) THEN + ASM_REWRITE_TAC[CLOSED_IN_SING; MIDPOINT_EQ_ENDPOINT] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IN_EMPTY] THEN + X_GEN_TAC `f:real^N->real^M` THEN STRIP_TAC THEN CONJ_TAC THENL + [SUBGOAL_THEN + `segment[midpoint(a,b):real^M,b] SUBSET segment[a,b]` MP_TAC + THENL + [REWRITE_TAC[SUBSET; IN_SEGMENT; midpoint] THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(&1 + u) / &2` THEN ASM_REWRITE_TAC[] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + VECTOR_ARITH_TAC; + ASM SET_TAC[]]; + SUBGOAL_THEN `~(a IN segment[midpoint(a,b):real^M,b])` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN + REWRITE_TAC[DIST_MIDPOINT] THEN + UNDISCH_TAC `~(a:real^M = b)` THEN NORM_ARITH_TAC]]]);; + +let URYSOHN_LOCAL = prove + (`!s t u a b. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} + ==> ?f:real^N->real^M. + f continuous_on u /\ + (!x. x IN u ==> f(x) IN segment[a,b]) /\ + (!x. x IN s ==> f x = a) /\ + (!x. x IN t ==> f x = b)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL + [EXISTS_TAC `(\x. b):real^N->real^M` THEN + ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONTINUOUS_ON_CONST]; + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`; + `a:real^M`; `b:real^M`] URYSOHN_LOCAL_STRONG) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]);; + +let URYSOHN_STRONG = prove + (`!s t a b. + closed s /\ closed t /\ s INTER t = {} /\ ~(a = b) + ==> ?f:real^N->real^M. + f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ + (!x. f x = a <=> x IN s) /\ (!x. f x = b <=> x IN t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN + REWRITE_TAC[IN_UNIV]);; + +let URYSOHN = prove + (`!s t a b. + closed s /\ closed t /\ s INTER t = {} + ==> ?f:real^N->real^M. + f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ + (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN + (MP_TAC o ISPECL [`a:real^M`; `b:real^M`] o MATCH_MP URYSOHN_LOCAL) THEN + REWRITE_TAC[IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Countability of some relevant sets. *) +(* ------------------------------------------------------------------------- *) + +let COUNTABLE_INTEGER = prove + (`COUNTABLE integer`, + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC + `IMAGE (\n. (&n:real)) (:num) UNION IMAGE (\n. --(&n)) (:num)` THEN + SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_UNION; NUM_COUNTABLE] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[IN; INTEGER_CASES]);; + +let CARD_EQ_INTEGER = prove + (`integer =_c (:num)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_INTEGER] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN + REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[IN; INTEGER_CLOSED]);; + +let COUNTABLE_RATIONAL = prove + (`COUNTABLE rational`, + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\(x,y). x / y) (integer CROSS integer)` THEN + SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_INTEGER] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS] THEN + REWRITE_TAC[rational; IN] THEN MESON_TAC[]);; + +let CARD_EQ_RATIONAL = prove + (`rational =_c (:num)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_RATIONAL] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN + REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[IN; RATIONAL_CLOSED]);; + +let COUNTABLE_INTEGER_COORDINATES = prove + (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }`, + MATCH_MP_TAC COUNTABLE_CART THEN + REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_INTEGER]);; + +let COUNTABLE_RATIONAL_COORDINATES = prove + (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`, + MATCH_MP_TAC COUNTABLE_CART THEN + REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_RATIONAL]);; + +(* ------------------------------------------------------------------------- *) +(* Density of points with rational, or just dyadic rational, coordinates. *) +(* ------------------------------------------------------------------------- *) + +let CLOSURE_DYADIC_RATIONALS = prove + (`closure { inv(&2 pow n) % x |n,x| + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) } = (:real^N)`, + REWRITE_TAC[EXTENSION; CLOSURE_APPROACHABLE; IN_UNIV; EXISTS_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; + REAL_POW_INV; REAL_LT_RDIV_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA; FLOOR; dist; NORM_MUL] THEN + MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) + (SPEC_ALL NORM_LE_L1)) THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&(dimindex(:N)) * inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + SIMP_TAC[REAL_ABS_MUL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH; + REAL_FIELD `~(a = &0) ==> inv a * b - x = inv a * (b - a * x)`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_LE_REFL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NUM] THEN + MP_TAC(SPEC `&2 pow n * (x:real^N)$k` FLOOR) THEN REAL_ARITH_TAC);; + +let CLOSURE_RATIONAL_COORDINATES = prove + (`closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } = + (:real^N)`, + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC + `closure { inv(&2 pow n) % x:real^N |n,x| + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }` THEN + + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSURE_DYADIC_RATIONALS]] THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[RATIONAL_CLOSED]);; + +let CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET = prove + (`!s:real^N->bool. + open s + ==> closure(s INTER + { inv(&2 pow n) % x | n,x | + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = + closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN + ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; + +let CLOSURE_RATIONALS_IN_OPEN_SET = prove + (`!s:real^N->bool. + open s + ==> closure(s INTER + { inv(&2 pow n) % x | n,x | + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = + closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN + ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Various separability-type properties. *) +(* ------------------------------------------------------------------------- *) + +let UNIV_SECOND_COUNTABLE = prove + (`?b. COUNTABLE b /\ (!c. c IN b ==> open c) /\ + !s:real^N->bool. open s ==> ?u. u SUBSET b /\ s = UNIONS u`, + EXISTS_TAC + `IMAGE (\(v:real^N,q). ball(v,q)) + ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS + rational)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[COUNTABLE_RATIONAL] THEN MATCH_MP_TAC COUNTABLE_CART THEN + REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | P x} = P`]; + REWRITE_TAC[FORALL_IN_IMAGE; CROSS; FORALL_IN_GSPEC; OPEN_BALL]; + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[UNIONS_0; EMPTY_SUBSET]; + ALL_TAC] THEN + EXISTS_TAC `{c | c IN IMAGE (\(v:real^N,q). ball(v,q)) + ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS + rational) /\ c SUBSET s}` THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[CROSS; EXISTS_PAIR_THM; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + MP_TAC(REWRITE_RULE[EXTENSION; IN_UNIV] CLOSURE_RATIONAL_COORDINATES) THEN + REWRITE_TAC[CLOSURE_APPROACHABLE] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `e / &4`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `?x. rational x /\ e / &3 < x /\ x < e / &2` + (X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC) + THENL + [MP_TAC(ISPECL [`&5 / &12 * e`; `e / &12`] RATIONAL_APPROXIMATION) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + SIMP_TAC[] THEN REAL_ARITH_TAC; + EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[IN]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]);; + +let UNIV_SECOND_COUNTABLE_SEQUENCE = prove + (`?b:num->real^N->bool. + (!m n. b m = b n <=> m = n) /\ + (!n. open(b n)) /\ + (!s. open s ==> ?k. s = UNIONS {b n | n IN k})`, + X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + MP_TAC(ISPEC `bb:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN + SUBGOAL_THEN + `INFINITE {ball(vec 0:real^N,inv(&n + &1)) | n IN (:num)}` + MP_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE + [RIGHT_IMP_FORALL_THM; IMP_IMP] INFINITE_IMAGE_INJ) THEN + REWRITE_TAC[num_INFINITE] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) % basis 1:real^N`) THEN + REWRITE_TAC[IN_BALL; DIST_0; NORM_MUL; REAL_ABS_INV] THEN + SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_REFL] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; + REWRITE_TAC[INFINITE; SIMPLE_IMAGE] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE UNIONS {u | u SUBSET bb} :(real^N->bool)->bool` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET] THEN + GEN_REWRITE_TAC I [SUBSET] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[OPEN_BALL]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_IMAGE; LEFT_AND_EXISTS_THM; SUBSET_UNIV] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLE_IMAGE]]);; + +let SUBSET_SECOND_COUNTABLE = prove + (`!s:real^N->bool. + ?b. COUNTABLE b /\ + (!c. c IN b ==> ~(c = {}) /\ open_in(subtopology euclidean s) c) /\ + !t. open_in(subtopology euclidean s) t + ==> ?u. u SUBSET b /\ t = UNIONS u`, + GEN_TAC THEN + SUBGOAL_THEN + `?b. COUNTABLE b /\ + (!c:real^N->bool. c IN b ==> open_in(subtopology euclidean s) c) /\ + !t. open_in(subtopology euclidean s) t + ==> ?u. u SUBSET b /\ t = UNIONS u` + STRIP_ASSUME_TAC THENL + [X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + EXISTS_TAC `{s INTER c :real^N->bool | c IN B}` THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; OPEN_IN_OPEN_INTER] THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN `?b. b SUBSET B /\ u:real^N->bool = UNIONS b` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + EXISTS_TAC `b:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTER_UNIONS] THEN AP_TERM_TAC THEN SET_TAC[]; + EXISTS_TAC `b DELETE ({}:real^N->bool)` THEN + ASM_SIMP_TAC[COUNTABLE_DELETE; IN_DELETE; SUBSET_DELETE] THEN + X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u DELETE ({}:real^N->bool)` THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNIONS] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[IN_DELETE] THEN SET_TAC[]]);; + +let SEPARABLE = prove + (`!s:real^N->bool. + ?t. COUNTABLE t /\ t SUBSET s /\ s SUBSET closure t`, + MP_TAC SUBSET_SECOND_COUNTABLE THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_AND_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `B:(real^N->bool)->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:(real^N->bool)->real^N` THEN DISCH_TAC THEN + EXISTS_TAC `IMAGE (f:(real^N->bool)->real^N) B` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN + REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_THEN + `!t:real^N->bool. + open_in (subtopology euclidean s) t + ==> (?u. u SUBSET B /\ t = UNIONS u)` + (MP_TAC o SPEC `s INTER ball(x:real^N,e)`) THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b:(real^N->bool)->bool` THEN + ASM_CASES_TAC `b:(real^N->bool)->bool = {}` THENL + [MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN + ASM_REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; UNIONS_0] THEN + ASM_MESON_TAC[CENTRE_IN_BALL]; + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `(f:(real^N->bool)->real^N) c`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN + MATCH_MP_TAC(TAUT `a /\ c ==> (a /\ b <=> c) ==> b`) THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN + REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN + ASM SET_TAC[]]]);; + +let OPEN_SET_RATIONAL_COORDINATES = prove + (`!s. open s /\ ~(s = {}) + ==> ?x:real^N. x IN s /\ + !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `~(closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } INTER + (s:real^N->bool) = {})` + MP_TAC THENL + [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; INTER_UNIV]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CLOSURE_APPROACHABLE; IN_INTER; + IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[open_def]) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let OPEN_COUNTABLE_UNION_OPEN_INTERVALS, + OPEN_COUNTABLE_UNION_CLOSED_INTERVALS = (CONJ_PAIR o prove) + (`(!s:real^N->bool. + open s + ==> ?D. COUNTABLE D /\ + (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval(a,b)) /\ + UNIONS D = s) /\ + (!s:real^N->bool. + open s + ==> ?D. COUNTABLE D /\ + (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval[a,b]) /\ + UNIONS D = s)`, + REPEAT STRIP_TAC THENL + [EXISTS_TAC + `{i | i IN IMAGE (\(a:real^N,b). interval(a,b)) + ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS + {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ + i SUBSET s}`; + EXISTS_TAC + `{i | i IN IMAGE (\(a:real^N,b). interval[a,b]) + ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS + {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ + i SUBSET s}`] THEN + (SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_CROSS; + COUNTABLE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; IMP_CONJ; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_ELIM_THM] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SET_TAC[]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[open_def]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?a b. rational a /\ rational b /\ + a < (x:real^N)$i /\ (x:real^N)$i < b /\ + abs(b - a) < e / &(dimindex(:N))` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; + REWRITE_TAC[LAMBDA_SKOLEM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN + DISCH_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTERVAL; REAL_LT_IMP_LE] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[dist] THEN MP_TAC(ISPEC `y - x:real^N` NORM_LE_L1) THEN + MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; CARD_NUMSEG_1] THEN + REWRITE_TAC[DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC));; + +let LINDELOF = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> open s) + ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?b. COUNTABLE b /\ + (!c:real^N->bool. c IN b ==> open c) /\ + (!s. open s ==> ?u. u SUBSET b /\ s = UNIONS u)` + STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[UNIV_SECOND_COUNTABLE]; ALL_TAC] THEN + ABBREV_TAC + `d = {s:real^N->bool | s IN b /\ ?u. u IN f /\ s SUBSET u}` THEN + SUBGOAL_THEN + `COUNTABLE d /\ UNIONS f :real^N->bool = UNIONS d` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "d" THEN ASM_SIMP_TAC[COUNTABLE_RESTRICT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!s:real^N->bool. ?u. s IN d ==> u IN f /\ s SUBSET u` + MP_TAC THENL [EXPAND_TAC "d" THEN SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:(real^N->bool)->(real^N->bool)` THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (g:(real^N->bool)->(real^N->bool)) d` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; UNIONS_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; + +let LINDELOF_OPEN_IN = prove + (`!f u:real^N->bool. + (!s. s IN f ==> open_in (subtopology euclidean u) s) + ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `v:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE (v:(real^N->bool)->real^N->bool) f` LINDELOF) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!f'. f' SUBSET f ==> UNIONS f' = (u:real^N->bool) INTER UNIONS (IMAGE v f')` + MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]]);; + +let COUNTABLE_DISJOINT_OPEN_SUBSETS = prove + (`!f. (!s:real^N->bool. s IN f ==> open s) /\ pairwise DISJOINT f + ==> COUNTABLE f`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINDELOF) THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `({}:real^N->bool) INSERT g` THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN + REWRITE_TAC[SUBSET; IN_INSERT] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[EXTENSION; SUBSET] THEN + REWRITE_TAC[IN_UNIONS; pairwise] THEN + REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let CARD_EQ_OPEN_SETS = prove + (`{s:real^N->bool | open s} =_c (:real)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + TRANS_TAC CARD_LE_TRANS `{s:(real^N->bool)->bool | s SUBSET b}` THEN + CONJ_TAC THENL + [REWRITE_TAC[LE_C] THEN + EXISTS_TAC `UNIONS:((real^N->bool)->bool)->real^N->bool` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + TRANS_TAC CARD_LE_TRANS `{s | s SUBSET (:num)}` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_LE_POWERSET THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT]; + REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC] THEN + MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM; CARD_EQ_REAL]]]; + REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN + EXISTS_TAC `\x. ball(x % basis 1:real^N,&1)` THEN + REWRITE_TAC[OPEN_BALL; GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[NORM_ARITH `dist(p:real^N,q) + &1 <= &1 <=> p = q`] THEN + REWRITE_TAC[VECTOR_MUL_RCANCEL; EQ_SYM_EQ] THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; + +let CARD_EQ_CLOSED_SETS = prove + (`{s:real^N->bool | closed s} =_c (:real)`, + SUBGOAL_THEN + `{s:real^N->bool | closed s} = + IMAGE (\s. (:real^N) DIFF s) {s | open s}` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; GSYM OPEN_CLOSED] THEN + MESON_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]; + TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | open s}` THEN + REWRITE_TAC[CARD_EQ_OPEN_SETS] THEN + MATCH_MP_TAC CARD_EQ_IMAGE THEN SET_TAC[]]);; + +let CARD_EQ_COMPACT_SETS = prove + (`{s:real^N->bool | compact s} =_c (:real)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN + SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_CLOSED_SETS] THEN + MATCH_MP_TAC CARD_LE_SUBSET THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_CLOSED]; + REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN + EXISTS_TAC `\x. {x % basis 1:real^N}` THEN + REWRITE_TAC[COMPACT_SING; SET_RULE `{x} = {y} <=> x = y`] THEN + SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; + +let COUNTABLE_NON_CONDENSATION_POINTS = prove + (`!s:real^N->bool. COUNTABLE(s DIFF {x | x condensation_point_of s})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[condensation_point_of] THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + EXISTS_TAC + `s INTER UNIONS { u:real^N->bool | u IN b /\ COUNTABLE(s INTER u)}` THEN + REWRITE_TAC[INTER_UNIONS; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT]; + SIMP_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_DIFF] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `?u:real^N->bool. x IN u /\ u IN b /\ u SUBSET t` MP_TAC THENL + [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `s INTER t:real^N->bool` THEN ASM SET_TAC[]]);; + +let CARD_EQ_CONDENSATION_POINTS_IN_SET = prove + (`!s:real^N->bool. + ~(COUNTABLE s) ==> {x | x IN s /\ x condensation_point_of s} =_c s`, + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_EQ_TRANS + `(s DIFF {x | x condensation_point_of s}) +_c + {x:real^N | x IN s /\ x condensation_point_of s}` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_ADD_ABSORB THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o CONJ (SPEC `s:real^N->bool` + COUNTABLE_NON_CONDENSATION_POINTS) o MATCH_MP FINITE_IMP_COUNTABLE) THEN + REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN SET_TAC[]; + REWRITE_TAC[INFINITE_CARD_LE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN + REWRITE_TAC[GSYM COUNTABLE_ALT; COUNTABLE_NON_CONDENSATION_POINTS]]; + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o rand o snd) THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]]);; + +let LIMPT_OF_CONDENSATION_POINTS,CONDENSATION_POINT_OF_CONDENSATION_POINTS = + (CONJ_PAIR o prove) + (`(!x:real^N s. + x limit_point_of {y | y condensation_point_of s} <=> + x condensation_point_of s) /\ + (!x:real^N s. + x condensation_point_of {y | y condensation_point_of s} <=> + x condensation_point_of s)`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(r ==> q) /\ (q ==> p) /\ (p ==> r) + ==> (q <=> p) /\ (r <=> p)`) THEN + REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT] THEN CONJ_TAC THENL + [REWRITE_TAC[LIMPT_APPROACHABLE; CONDENSATION_POINT_INFINITE_BALL] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + SIMP_TAC[SUBSET; IN_INTER; IN_BALL] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + ONCE_REWRITE_TAC[CONDENSATION_POINT_INFINITE_BALL] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP + (MESON[CARD_EQ_CONDENSATION_POINTS_IN_SET; CARD_COUNTABLE_CONG] + `~COUNTABLE s + ==> ~COUNTABLE {x | x IN s /\ x condensation_point_of s}`)) THEN + REWRITE_TAC[UNCOUNTABLE_REAL; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[CONDENSATION_POINT_OF_SUBSET; INTER_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN + EXISTS_TAC `closure(s INTER ball(x:real^N,e / &2))` THEN CONJ_TAC THENL + [REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN + ASM_SIMP_TAC[CONDENSATION_POINT_IMP_LIMPT]; + TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; SUBSET_BALLS; DIST_REFL] THEN + ASM_REAL_ARITH_TAC]]);; + +let CLOSED_CONDENSATION_POINTS = prove + (`!s:real^N->bool. closed {x | x condensation_point_of s}`, + SIMP_TAC[CLOSED_LIMPT; LIMPT_OF_CONDENSATION_POINTS; IN_ELIM_THM]);; + +let CANTOR_BENDIXSON = prove + (`!s:real^N->bool. + closed s + ==> ?t u. closed t /\ (!x. x IN t ==> x limit_point_of t) /\ + COUNTABLE u /\ s = t UNION u`, + REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`{x:real^N | x condensation_point_of s}`; + `s DIFF {x:real^N | x condensation_point_of s}`] THEN + REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS; CLOSED_CONDENSATION_POINTS; + IN_ELIM_THM; LIMPT_OF_CONDENSATION_POINTS] THEN + REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[CLOSED_LIMPT]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[CONDENSATION_POINT_IMP_LIMPT]);; + +(* ------------------------------------------------------------------------- *) +(* A discrete set is countable, and an uncountable set has a limit point. *) +(* ------------------------------------------------------------------------- *) + +let DISCRETE_IMP_COUNTABLE = prove + (`!s:real^N->bool. + (!x. x IN s ==> ?e. &0 < e /\ + !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)) + ==> COUNTABLE s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN s + ==> ?q. (!i. 1 <= i /\ i <= dimindex(:N) ==> rational(q$i)) /\ + !y:real^N. y IN s /\ ~(y = x) ==> norm(x - q) < norm(y - q)` + MP_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SET_RULE `x IN (:real^N)`) THEN + REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `q:real^N->real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; + `{ x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`; + `(:num)`] CARD_LE_TRANS) THEN + REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[REWRITE_RULE[COUNTABLE; ge_c] COUNTABLE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `q:real^N->real^N` THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_ANTISYM]]);; + +let UNCOUNTABLE_CONTAINS_LIMIT_POINT = prove + (`!s. ~(COUNTABLE s) ==> ?x. x IN s /\ x limit_point_of s`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DISCRETE_IMP_COUNTABLE)) THEN + REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LT; dist] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The Brouwer reduction theorem. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_REDUCTION_THEOREM_GEN = prove + (`!P s:real^N->bool. + (!f. (!n. closed(f n) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n)) + ==> P(INTERS {f n | n IN (:num)})) /\ + closed s /\ P s + ==> ?t. t SUBSET s /\ closed t /\ P t /\ + (!u. u SUBSET s /\ closed u /\ P u ==> ~(u PSUBSET t))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?b:num->real^N->bool. + (!m n. b m = b n <=> m = n) /\ + (!n. open (b n)) /\ + (!s. open s ==> (?k. s = UNIONS {b n | n IN k}))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[UNIV_SECOND_COUNTABLE_SEQUENCE]; ALL_TAC] THEN + X_CHOOSE_THEN `a:num->real^N->bool` MP_TAC + (prove_recursive_functions_exist num_RECURSION + `a 0 = (s:real^N->bool) /\ + (!n. a(SUC n) = + if ?u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} + then @u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} + else a(n))`) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "base") (LABEL_TAC "step")) THEN + EXISTS_TAC `INTERS {a n :real^N->bool | n IN (:num)}` THEN + SUBGOAL_THEN `!n. (a:num->real^N->bool)(SUC n) SUBSET a(n)` ASSUME_TAC THENL + [GEN_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. (a:num->real^N->bool) n SUBSET s` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!n. closed((a:num->real^N->bool) n) /\ P(a n)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_INTERS THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[PSUBSET_ALT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[INTERS_GSPEC; EXISTS_IN_GSPEC; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?n. x IN (b:num->real^N->bool)(n) /\ t INTER b n = {}` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `(:real^N) DIFF t` OPEN_CONTAINS_BALL) THEN + ASM_REWRITE_TAC[GSYM closed] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> t INTER s = {}`] THEN + X_GEN_TAC `e:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ball(x:real^N,e)`) THEN + ASM_REWRITE_TAC[OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:num->bool` THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[IN_UNIONS; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN + SET_TAC[]; + REMOVE_THEN "step" (MP_TAC o SPEC `n:num`) THEN + COND_CASES_TAC THENL + [DISCH_THEN(ASSUME_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]]]);; + +let BROUWER_REDUCTION_THEOREM = prove + (`!P s:real^N->bool. + (!f. (!n. compact(f n) /\ ~(f n = {}) /\ P(f n)) /\ + (!n. f(SUC n) SUBSET f(n)) + ==> P(INTERS {f n | n IN (:num)})) /\ + compact s /\ ~(s = {}) /\ P s + ==> ?t. t SUBSET s /\ compact t /\ ~(t = {}) /\ P t /\ + (!u. u SUBSET s /\ closed u /\ ~(u = {}) /\ P u + ==> ~(u PSUBSET t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t:real^N->bool. ~(t = {}) /\ t SUBSET s /\ P t`; + `s:real^N->bool`] + BROUWER_REDUCTION_THEOREM_GEN) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_REFL] THEN ANTS_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. compact((f:num->real^N->bool) n)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[] THEN SET_TAC[]; + ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* The Arzela-Ascoli theorem. *) +(* ------------------------------------------------------------------------- *) + +let SUBSEQUENCE_DIAGONALIZATION_LEMMA = prove + (`!P:num->(num->A)->bool. + (!i r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ P i (r o k)) /\ + (!i r:num->A k1 k2 N. + P i (r o k1) /\ (!j. N <= j ==> ?j'. j <= j' /\ k2 j = k1 j') + ==> P i (r o k2)) + ==> !r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ (!i. P i (r o k))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SKOLEM_THM] THEN + REWRITE_TAC[FORALL_AND_THM; TAUT + `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN + DISCH_THEN(X_CHOOSE_THEN + `kk:num->(num->A)->num->num` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `r:num->A` THEN + (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) + `(rr 0 = (kk:num->(num->A)->num->num) 0 r) /\ + (!n. rr(SUC n) = rr n o kk (SUC n) (r o rr n))` THEN + EXISTS_TAC `\n. (rr:num->num->num) n n` THEN REWRITE_TAC[ETA_AX] THEN + SUBGOAL_THEN + `(!i. (!m n. m < n ==> (rr:num->num->num) i m < rr i n)) /\ + (!i. (P:num->(num->A)->bool) i (r o rr i))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[AND_FORALL_THM] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[o_ASSOC] THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!i j n. i <= j ==> (rr:num->num->num) i n <= rr j n` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`j:num`,`j:num`) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[FORALL_UNWIND_THM2] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] LE_TRANS)) THEN REWRITE_TAC[o_THM] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (MESON[LE_LT] + `!f:num->num. + (!m n. m < n ==> f m < f n) ==> (!m n. m <= n ==> f m <= f n)`) o + SPEC `i + d:num`) THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `(rr:num->num->num) n m` THEN + ASM_MESON_TAC[LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n i. n <= m ==> ?j. i <= j /\ (rr:num->num->num) m i = rr n j` + ASSUME_TAC THENL + [ALL_TAC; + X_GEN_TAC `i:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(rr:num->num->num) i` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `i:num` THEN ASM_MESON_TAC[]] THEN + SUBGOAL_THEN + `!p d i. ?j. i <= j /\ (rr:num->num->num) (p + d) i = rr p j` + (fun th -> MESON_TAC[LE_EXISTS; th]) THEN + X_GEN_TAC `p:num` THEN MATCH_MP_TAC num_INDUCTION THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN CONJ_TAC THENL + [MESON_TAC[LE_REFL]; ALL_TAC] THEN + X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "+") THEN + X_GEN_TAC `i:num` THEN ASM_REWRITE_TAC[o_THM] THEN + REMOVE_THEN "+" (MP_TAC o SPEC + `(kk:num->(num->A)->num->num) (SUC(p + d)) + ((r:num->A) o (rr:num->num->num) (p + d)) i`) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN + SPEC_TAC(`i:num`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN + ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; + +let FUNCTION_CONVERGENT_SUBSEQUENCE = prove + (`!f:num->real^M->real^N s M. + COUNTABLE s /\ (!n x. x IN s ==> norm(f n x) <= M) + ==> ?k. (!m n:num. m < n ==> k m < k n) /\ + !x. x IN s ==> ?l. ((\n. f (k n) x) --> l) sequentially`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [EXISTS_TAC `\n:num. n` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + MP_TAC(ISPEC `s:real^M->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `X:num->real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(ISPEC + `\i r. ?l. ((\n. ((f:num->real^M->real^N) o (r:num->num)) n + ((X:num->real^M) i)) --> l) sequentially` + SUBSEQUENCE_DIAGONALIZATION_LEMMA) THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_UNIV] THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_ACCEPT_TAC] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN + MAP_EVERY X_GEN_TAC [`i:num`; `r:num->num`] THEN + MP_TAC(ISPEC `cball(vec 0:real^N,M)` compact) THEN + REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC + `\n. (f:num->real^M->real^N) ((r:num->num) n) (X(i:num))`) THEN + ASM_REWRITE_TAC[IN_CBALL_0; o_DEF] THEN MESON_TAC[]; + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY; GE] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[LE_TRANS; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`]]);; + +let ARZELA_ASCOLI = prove + (`!f:num->real^M->real^N s M. + compact s /\ + (!n x. x IN s ==> norm(f n x) <= M) /\ + (!x e. x IN s /\ &0 < e + ==> ?d. &0 < d /\ + !n y. y IN s /\ norm(x - y) < d + ==> norm(f n x - f n y) < e) + ==> ?g. g continuous_on s /\ + ?r. (!m n:num. m < n ==> r m < r n) /\ + !e. &0 < e + ==> ?N. !n x. n >= N /\ x IN s + ==> norm(f(r n) x - g x) < e`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GE] THEN + MATCH_MP_TAC(MESON[] + `(!k g. V k g ==> N g) /\ (?k. M k /\ ?g. V k g) + ==> ?g. N g /\ ?k. M k /\ V k g`) THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:num->num`; `g:real^M->real^N`] THEN + STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` + CONTINUOUS_UNIFORM_LIMIT) THEN + EXISTS_TAC `(f:num->real^M->real^N) o (k:num->num)` THEN + ASM_SIMP_TAC[EVENTUALLY_SEQUENTIALLY; o_THM; TRIVIAL_LIMIT_SEQUENTIALLY; + RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[continuous_on; dist] THEN + ASM_MESON_TAC[NORM_SUB]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`IMAGE (f:num->real^M->real^N) (:num)`; + `s:real^M->bool`] + COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN + ANTS_TAC THENL + [REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`)] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; dist] THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[NORM_SUB]) THEN + REWRITE_TAC[GSYM dist; UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN + X_CHOOSE_THEN `r:real^M->bool` STRIP_ASSUME_TAC + (ISPEC `s:real^M->bool` SEPARABLE) THEN + MP_TAC(ISPECL [`f:num->real^M->real^N`; `r:real^M->bool`; `M:real`] + FUNCTION_CONVERGENT_SUBSEQUENCE) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num->num` THEN + REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^M. ball(x,d)) r`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure r:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL]; + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN + REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `M:real^M->num` THEN DISCH_THEN(LABEL_TAC "*") THEN + MP_TAC(ISPECL [`M:real^M->num`; `t:real^M->bool`] + UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^M`] THEN STRIP_TAC THEN + UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^M. ball (x,d)) t)` THEN + REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; dist] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `norm(f (k(m:num)) y - f (k m) x) < e / &3 /\ + norm(f (k n) y - f (k n) x) < e / &3 /\ + norm(f (k m) y - f (k n) y) < e / &3 + ==> norm(f (k m) x - f (k n) x :real^M) < e`) THEN + ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN + ASM_REWRITE_TAC[dist; GE] THEN ASM_MESON_TAC[SUBSET; LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Two forms of the Baire propery of dense sets. *) +(* ------------------------------------------------------------------------- *) + +let BAIRE = prove + (`!g s:real^N->bool. + closed s /\ COUNTABLE g /\ + (!t. t IN g + ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t) + ==> s SUBSET closure(INTERS g)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN + MP_TAC(ISPEC `g:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) + [`COUNTABLE(g:(real^N->bool)->bool)`; + `~(g:(real^N->bool)->bool = {})`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real^N->bool` SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[GSYM IN_BALL; GSYM IN_INTER; MEMBER_NOT_EMPTY] THEN + SUBGOAL_THEN + `?t:num->real^N->bool. + (!n. open_in (subtopology euclidean s) (t n) /\ ~(t n = {}) /\ + s INTER closure(t n) SUBSET g n /\ + closure(t n) SUBSET ball(x,e)) /\ + (!n. t(SUC n) SUBSET t n)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `!u n. open_in (subtopology euclidean s) u /\ ~(u = {}) /\ + closure u SUBSET ball(x,e) + ==> ?y. open_in (subtopology euclidean s) y /\ + ~(y = {}) /\ + s INTER closure y SUBSET (g:num->real^N->bool) n /\ + closure y SUBSET ball(x,e) /\ + y SUBSET u` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `n:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `?y:real^N. y IN u /\ y IN g(n:num)` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `open_in (subtopology euclidean s) (u INTER g(n:num):real^N->bool)` + MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_INTER]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN + ASM_REWRITE_TAC[IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s INTER ball(y:real^N,d / &2)` THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^N` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b SUBSET u INTER g ==> !s. s SUBSET b ==> s SUBSET g`)) THEN + MATCH_MP_TAC(SET_RULE + `closure(s INTER b) SUBSET closure b /\ closure b SUBSET c + ==> s INTER closure(s INTER b) SUBSET c INTER s`) THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN MATCH_MP_TAC SUBSET_CLOSURE; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b INTER s SUBSET u INTER g ==> c SUBSET b + ==> s INTER c SUBSET u`)) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC DEPENDENT_CHOICE THEN ASM_SIMP_TAC[GSYM CONJ_ASSOC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER ball(x:real^N,e / &2)`; `0`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; GSYM MEMBER_NOT_EMPTY] THEN + ANTS_TAC THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM]; MESON_TAC[]] THEN + EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN + TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN + ASM_REAL_ARITH_TAC]; + MP_TAC(ISPEC + `(\n. s INTER closure(t n)):num->real^N->bool` COMPACT_NEST) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; COMPACT_EQ_BOUNDED_CLOSED; + CLOSED_CLOSURE]; + GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `~(t = {}) /\ t SUBSET s /\ t SUBSET closure t + ==> ~(s INTER closure t = {})`) THEN + ASM_MESON_TAC[CLOSURE_SUBSET; OPEN_IN_IMP_SUBSET]; + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_SIMP_TAC[SUBSET_CLOSURE; SET_RULE + `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN + SET_TAC[]]; + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`) THEN + REWRITE_TAC[SUBSET_INTER] THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ASM SET_TAC[]]]);; + +let BAIRE_ALT = prove + (`!g s:real^N->bool. + closed s /\ ~(s = {}) /\ COUNTABLE g /\ UNIONS g = s + ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\ + u SUBSET (closure t)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`IMAGE (\t:real^N->bool. s DIFF closure t) g`; `s:real^N->bool`] BAIRE) THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ (t = {} ==> closure t = {}) /\ t = {} + ==> ~(s SUBSET closure t)`) THEN + ASM_SIMP_TAC[CLOSURE_EMPTY] THEN + MATCH_MP_TAC(SET_RULE `i SUBSET s /\ s DIFF i = s ==> i = {}`) THEN + CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[DIFF_INTERS] THEN + REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN + REWRITE_TAC[SET_RULE `{s INTER closure t | t IN g} = + {s INTER t | t IN IMAGE closure g}`] THEN + SIMP_TAC[GSYM INTER_UNIONS; SET_RULE `s INTER t = s <=> s SUBSET t`] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN + MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[CLOSURE_SUBSET]; + REWRITE_TAC[NOT_EXISTS_THM] THEN STRIP_TAC THEN + X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE; OPEN_IN_REFL]; + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`t:real^N->bool`; `s INTER ball(x:real^N,e)`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; SUBSET; IN_INTER; IN_BALL; + IN_DIFF] THEN + MESON_TAC[DIST_SYM]]]);; + +(* ------------------------------------------------------------------------- *) +(* Several variants of paracompactness. *) +(* ------------------------------------------------------------------------- *) + +let PARACOMPACT = prove + (`!s c. (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c + ==> ?c'. s SUBSET UNIONS c' /\ + (!u. u IN c' + ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ + (!x. x IN s + ==> ?v. open v /\ x IN v /\ + FINITE {u | u IN c' /\ ~(u INTER v = {})})`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN s + ==> ?t u. x IN u /\ open u /\ closure u SUBSET t /\ t IN c` + MP_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [OPEN_CONTAINS_CBALL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(x:real^N,e)` THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; CLOSURE_BALL]; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:real^N->real^N->bool`; `e:real^N->real^N->bool`] THEN + STRIP_TAC] THEN + MP_TAC(ISPEC `IMAGE (e:real^N->real^N->bool) s` LINDELOF) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_CASES_TAC `k:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `k:real^N->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` SUBST_ALL_TAC) THEN + STRIP_TAC THEN EXISTS_TAC + `{ f(a n:real^N) DIFF UNIONS {closure(e(a m)):real^N->bool | m < n} | + n IN (:num)}` THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_DIFF THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CLOSED_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; + EXISTS_TAC `f((a:num->real^N) n):real^N->bool` THEN ASM SET_TAC[]]; + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `?n. x IN (f((a:num->real^N) n):real^N->bool)` MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:num->real^N) n`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]; + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `e((a:num->real^N) n):real^N->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE + `{u | (?n. u = f n) /\ P u} = IMAGE f {n |n| P(f n) /\ n IN (:num)}`] THEN + MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE `u SUBSET t ==> (s DIFF t) INTER u = {}`) THEN + REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC] THEN + ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]);; + +let PARACOMPACT_CLOSED_IN = prove + (`!u:real^N->bool s c. + closed_in (subtopology euclidean u) s /\ + (!t:real^N->bool. t IN c ==> open_in (subtopology euclidean u) t) /\ + s SUBSET UNIONS c + ==> ?c'. s SUBSET UNIONS c' /\ + (!v. v IN c' + ==> open_in (subtopology euclidean u) v /\ + ?t. t IN c /\ v SUBSET t) /\ + (!x. x IN u + ==> ?v. open_in (subtopology euclidean u) v /\ x IN v /\ + FINITE {n | n IN c' /\ ~(n INTER v = {})})`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uu:(real^N->bool)->(real^N->bool)` THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + MP_TAC(ISPECL + [`u:real^N->bool`; + `((:real^N) DIFF k) INSERT IMAGE (uu:(real^N->bool)->(real^N->bool)) c`] + PARACOMPACT) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; UNIONS_INSERT; FORALL_IN_INSERT; + EXISTS_IN_IMAGE; EXISTS_IN_INSERT; GSYM closed] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{u INTER v:real^N->bool | v IN d /\ ~(v INTER k = {})}` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u INTER v:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE + `{y | y IN {f x | P x} /\ Q y} = IMAGE f {x | P x /\ Q(f x)}`] THEN + MATCH_MP_TAC FINITE_IMAGE THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);; + +let PARACOMPACT_CLOSED = prove + (`!s:real^N->bool c. + closed s /\ (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c + ==> ?c'. s SUBSET UNIONS c' /\ + (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ + (!x. ?v. open v /\ x IN v /\ + FINITE {u | u IN c' /\ ~(u INTER v = {})})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`; `c:(real^N->bool)->bool`] + PARACOMPACT_CLOSED_IN) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Partitions of unity subordinate to locally finite open coverings. *) +(* ------------------------------------------------------------------------- *) + +let SUBORDINATE_PARTITION_OF_UNITY = prove + (`!c s. s SUBSET UNIONS c /\ (!u. u IN c ==> open u) /\ + (!x. x IN s + ==> ?v. open v /\ x IN v /\ + FINITE {u | u IN c /\ ~(u INTER v = {})}) + ==> ?f:(real^N->bool)->real^N->real. + (!u. u IN c + ==> (lift o f u) continuous_on s /\ + !x. x IN s ==> &0 <= f u x) /\ + (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> f u x = &0) /\ + (!x. x IN s ==> sum c (\u. f u x) = &1) /\ + (!x. x IN s + ==> ?n. open n /\ x IN n /\ + FINITE {u | u IN c /\ + ~(!x. x IN n ==> f u x = &0)})`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?u:real^N->bool. u IN c /\ s SUBSET u` THENL + [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\v:real^N->bool x:real^N. if v = u then &1 else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; o_DEF; REAL_POS; + REAL_OF_NUM_EQ; ARITH_EQ; + MESON[] `(if p then q else T) <=> p ==> q`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST; COND_ID; SUM_DELTA] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `ball(x:real^N,&1)` THEN + REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N->bool}` THEN + REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `v:real^N->bool` THEN + ASM_CASES_TAC `v:real^N->bool = u` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `\u:real^N->bool x:real^N. + if x IN s + then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)) + else &0` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + SIMP_TAC[SUM_POS_LE; SETDIST_POS_LE; REAL_LE_DIV] THEN + SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN + ASM_CASES_TAC `(u:real^N->bool) IN c` THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[real_div; REAL_ENTIRE] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(y:real^N) IN u` THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_MUL_LZERO] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!v x:real^N. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF v:real^N->bool`; `x:real^N`] + SETDIST_EQ_0_CLOSED_IN) THEN + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNION] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN + MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[SETDIST_POS_LE] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN + ASM_CASES_TAC `(x:real^N) IN u` THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIONS] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[REAL_LT_IMP_NZ]]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_REFL; o_DEF] THEN + X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `\x:real^N. + lift(setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)))` THEN + SIMP_TAC[] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_LIFT_SETDIST; o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)) THEN + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN + MAP_EVERY EXISTS_TAC + [`\x:real^N. lift(sum {v | v IN c /\ ~(v INTER n = {})} + (\v. setdist({x},s DIFF v)))`; + `s INTER n:real^N->bool`] THEN + ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `v:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM SET_TAC[]; + ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN + ASM_SIMP_TAC[CONTINUOUS_AT_LIFT_SETDIST; CONTINUOUS_AT_WITHIN]]);; diff --git a/Multivariate/transcendentals.ml b/Multivariate/transcendentals.ml new file mode 100644 index 0000000..fe5e63a --- /dev/null +++ b/Multivariate/transcendentals.ml @@ -0,0 +1,6981 @@ +(* ========================================================================= *) +(* Complex transcendentals and their real counterparts. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Multivariate/determinants.ml";; +needs "Multivariate/canal.ml";; + +prioritize_complex();; + +(* ------------------------------------------------------------------------- *) +(* The complex exponential function. *) +(* ------------------------------------------------------------------------- *) + +let cexp = new_definition + `cexp z = infsum (from 0) (\n. z pow n / Cx(&(FACT n)))`;; + +let CEXP_0 = prove + (`cexp(Cx(&0)) = Cx(&1)`, + REWRITE_TAC[cexp] THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MP_TAC(ISPECL [`\i. Cx(&0) pow i / Cx(&(FACT i))`; `{0}`; `from 0`] + SERIES_FINITE_SUPPORT) THEN + SIMP_TAC[FROM_0; INTER_UNIV; FINITE_INSERT; FINITE_RULES] THEN ANTS_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[IN_SING; NOT_SUC] THEN + REWRITE_TAC[complex_div; complex_pow; COMPLEX_MUL_LZERO; COMPLEX_VEC_0]; + REWRITE_TAC[VSUM_SING; FACT; COMPLEX_DIV_1; complex_pow]]);; + +let CEXP_CONVERGES_UNIFORMLY_CAUCHY = prove + (`!R e. &0 < e /\ &0 < R + ==> ?N. !m n z. m >= N /\ norm(z) <= R + ==> norm(vsum(m..n) (\i. z pow i / Cx(&(FACT i)))) + < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`&1 / &2`; `\i. Cx(R) pow i / Cx(&(FACT i))`; + `from 0`] SERIES_RATIO) THEN + REWRITE_TAC[SERIES_CAUCHY; LEFT_FORALL_IMP_THM] THEN + MP_TAC(SPEC `&2 * norm(Cx(R))` REAL_ARCH_SIMPLE) THEN + REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_DIV; COMPLEX_NORM_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (c ==> d) ==> a ==> (b ==> c) ==> d`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + SIMP_TAC[FACT; real_pow; GSYM REAL_OF_NUM_MUL; real_div; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH + `(z * zn) * (is * ik) <= (&1 * inv(&2)) * zn * ik <=> + &0 <= (&1 - (&2 * z) * is) * zn * ik`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_POW_LE; REAL_SUB_LE; + REAL_LE_INV_EQ; REAL_ABS_POS] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_OF_NUM_LT; LT_0] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[FROM_0; INTER_UNIV] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[GSYM CX_DIV; GSYM CX_POW; VSUM_CX_NUMSEG; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> y < e ==> x < e`) THEN + SUBGOAL_THEN `abs (sum (m..n) (\i. R pow i / &(FACT i))) = + sum (m..n) (\i. R pow i / &(FACT i))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE;REAL_LT_DIV; REAL_OF_NUM_LT; + FACT_LT; REAL_POW_LT]; + ALL_TAC] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN REWRITE_TAC[IN_NUMSEG; FINITE_NUMSEG] THEN + X_GEN_TAC `i:num` THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN + SIMP_TAC[REAL_ABS_NUM; REAL_LE_DIV2_EQ; REAL_OF_NUM_LT; FACT_LT] THEN + ASM_SIMP_TAC[REAL_POW_LE2; NORM_POS_LE]]);; + +let CEXP_CONVERGES = prove + (`!z. ((\n. z pow n / Cx(&(FACT n))) sums cexp(z)) (from 0)`, + GEN_TAC THEN REWRITE_TAC[cexp; SUMS_INFSUM; summable; SERIES_CAUCHY] THEN + REWRITE_TAC[FROM_0; INTER_UNIV] THEN + MP_TAC(SPEC `norm(z:complex) + &1` CEXP_CONVERGES_UNIFORMLY_CAUCHY) THEN + SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 < x + &1`; NORM_POS_LE] THEN + MESON_TAC[REAL_ARITH `x <= x + &1`]);; + +let CEXP_CONVERGES_UNIQUE = prove + (`!w z. ((\n. z pow n / Cx(&(FACT n))) sums w) (from 0) <=> w = cexp(z)`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CEXP_CONVERGES] THEN + DISCH_THEN(MP_TAC o C CONJ (SPEC `z:complex` CEXP_CONVERGES)) THEN + REWRITE_TAC[SERIES_UNIQUE]);; + +let CEXP_CONVERGES_UNIFORMLY = prove + (`!R e. &0 < R /\ &0 < e + ==> ?N. !n z. n >= N /\ norm(z) < R + ==> norm(vsum(0..n) (\i. z pow i / Cx(&(FACT i))) - + cexp(z)) <= e`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`R:real`; `e / &2`] CEXP_CONVERGES_UNIFORMLY_CAUCHY) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`n:num`; `z:complex`] THEN STRIP_TAC THEN + MP_TAC(SPEC `z:complex` CEXP_CONVERGES) THEN + REWRITE_TAC[sums; LIM_SEQUENTIALLY; FROM_0; INTER_UNIV; dist] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `n + M + 1`)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n + 1`; `n + M + 1`; `z:complex`]) THEN + ASM_SIMP_TAC[ARITH_RULE `(n >= N ==> n + 1 >= N) /\ M <= n + M + 1`] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; VSUM_ADD_SPLIT; LE_0] THEN + CONV_TAC(ONCE_DEPTH_CONV(ALPHA_CONV `i:num`)) THEN NORM_ARITH_TAC);; + +let HAS_COMPLEX_DERIVATIVE_CEXP = prove + (`!z. (cexp has_complex_derivative cexp(z)) (at z)`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`ball(Cx(&0),norm(z:complex) + &1)`; + `\n z. z pow n / Cx(&(FACT n))`; + `\n z. if n = 0 then Cx(&0) else z pow (n-1) / Cx(&(FACT(n-1)))`; + `cexp:complex->complex`; + `(from 0)`] + HAS_COMPLEX_DERIVATIVE_SERIES) THEN + REWRITE_TAC[CONVEX_BALL; OPEN_BALL; IN_BALL; dist] THEN + SIMP_TAC[HAS_COMPLEX_DERIVATIVE_WITHIN_OPEN; OPEN_BALL; IN_BALL; + dist; COMPLEX_SUB_LZERO; COMPLEX_SUB_RZERO; NORM_NEG] THEN + ANTS_TAC THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN COMPLEX_DIFF_TAC THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ARITH; complex_div; COMPLEX_MUL_LZERO] THEN + MP_TAC(SPECL [`&n + &1`; `&0`] CX_INJ) THEN + REWRITE_TAC[NOT_SUC; SUC_SUB1; GSYM REAL_OF_NUM_SUC; FACT; + CX_ADD; CX_MUL; GSYM REAL_OF_NUM_MUL; COMPLEX_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `~(&n + &1 = &0)`] THEN + ABBREV_TAC `a = inv(Cx(&(FACT n)))` THEN CONV_TAC COMPLEX_FIELD; + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`norm(z:complex) + &1`; `e:real`] + CEXP_CONVERGES_UNIFORMLY) THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> &0 < x + &1`] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN + MAP_EVERY X_GEN_TAC [`n:num`; `w:complex`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n - 1`; `w:complex`]) THEN + ASM_SIMP_TAC[ARITH_RULE `n >= m + 1 ==> n - 1 >= m`] THEN + REWRITE_TAC[FROM_0; INTER_UNIV] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `0..n = 0 INSERT (IMAGE SUC (0..n-1))` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_IMAGE; IN_NUMSEG] THEN + INDUCT_TAC THEN REWRITE_TAC[LE_0; NOT_SUC; SUC_INJ; UNWIND_THM1] THEN + UNDISCH_TAC `n >= N + 1` THEN ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_IMAGE; NOT_SUC; COMPLEX_ADD_LID] THEN + SIMP_TAC[VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ] THEN + MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_NUMSEG; NOT_SUC; o_THM; SUC_SUB1]; + MAP_EVERY EXISTS_TAC [`Cx(&0)`; `cexp(Cx(&0))`] THEN + REWRITE_TAC[CEXP_CONVERGES; COMPLEX_NORM_0] THEN + SIMP_TAC[REAL_ARITH `&0 <= z ==> &0 < z + &1`; NORM_POS_LE]; + DISCH_THEN(X_CHOOSE_THEN `g:complex->complex` MP_TAC) THEN + REWRITE_TAC[CEXP_CONVERGES_UNIQUE] THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`g:complex->complex`; `&1`] THEN + REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; SIMP_TAC[]]] THEN + POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `w:complex` THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN + NORM_ARITH_TAC]);; + +let COMPLEX_DIFFERENTIABLE_AT_CEXP = prove + (`!z. cexp complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CEXP]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CEXP = prove + (`!s z. cexp complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CEXP]);; + +let CONTINUOUS_AT_CEXP = prove + (`!z. cexp continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CEXP; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CEXP = prove + (`!s z. cexp continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CEXP]);; + +let CONTINUOUS_ON_CEXP = prove + (`!s. cexp continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CEXP]);; + +let HOLOMORPHIC_ON_CEXP = prove + (`!s. cexp holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP]);; + +(* ------------------------------------------------------------------------- *) +(* Add it to the database. *) +(* ------------------------------------------------------------------------- *) + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV + HAS_COMPLEX_DERIVATIVE_CEXP)));; + +(* ------------------------------------------------------------------------- *) +(* Hence the main results. *) +(* ------------------------------------------------------------------------- *) + +let CEXP_ADD_MUL = prove + (`!w z. cexp(w + z) * cexp(--z) = cexp(w)`, + GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `(!x. P x) <=> (!x. x IN UNIV ==> P x)`] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_ZERO_UNIQUE THEN + EXISTS_TAC `Cx(&0)` THEN REWRITE_TAC[OPEN_UNIV; CONVEX_UNIV; IN_UNIV] THEN + REWRITE_TAC[COMPLEX_ADD_RID; COMPLEX_NEG_0; CEXP_0; COMPLEX_MUL_RID] THEN + GEN_TAC THEN COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; + +let CEXP_NEG_RMUL = prove + (`!z. cexp(z) * cexp(--z) = Cx(&1)`, + MP_TAC(SPEC `Cx(&0)` CEXP_ADD_MUL) THEN MATCH_MP_TAC MONO_FORALL THEN + SIMP_TAC[COMPLEX_ADD_LID; CEXP_0]);; + +let CEXP_NEG_LMUL = prove + (`!z. cexp(--z) * cexp(z) = Cx(&1)`, + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN REWRITE_TAC[CEXP_NEG_RMUL]);; + +let CEXP_NEG = prove + (`!z. cexp(--z) = inv(cexp z)`, + MP_TAC CEXP_NEG_LMUL THEN MATCH_MP_TAC MONO_FORALL THEN + CONV_TAC COMPLEX_FIELD);; + +let CEXP_ADD = prove + (`!w z. cexp(w + z) = cexp(w) * cexp(z)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`w:complex`; `z:complex`] CEXP_ADD_MUL) THEN + MP_TAC(SPEC `z:complex` CEXP_NEG_LMUL) THEN CONV_TAC COMPLEX_FIELD);; + +let CEXP_SUB = prove + (`!w z. cexp(w - z) = cexp(w) / cexp(z)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[complex_sub; complex_div; CEXP_ADD; CEXP_NEG]);; + +let CEXP_NZ = prove + (`!z. ~(cexp(z) = Cx(&0))`, + MP_TAC CEXP_NEG_LMUL THEN MATCH_MP_TAC MONO_FORALL THEN + CONV_TAC COMPLEX_FIELD);; + +let CEXP_N = prove + (`!n x. cexp(Cx(&n) * x) = cexp(x) pow n`, + INDUCT_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC; CX_ADD] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; complex_pow; CEXP_0] THEN + ASM_REWRITE_TAC[COMPLEX_ADD_RDISTRIB; CEXP_ADD; COMPLEX_MUL_LID] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +let CEXP_VSUM = prove + (`!f s. FINITE s ==> cexp(vsum s f) = cproduct s (\x. cexp(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; CPRODUCT_CLAUSES; CEXP_ADD; COMPLEX_VEC_0; CEXP_0]);; + +let LIM_CEXP_MINUS_1 = prove + (`((\z. (cexp(z) - Cx(&1)) / z) --> Cx(&1)) (at (Cx(&0)))`, + MP_TAC(COMPLEX_DIFF_CONV + `((\z. cexp(z) - Cx(&1)) has_complex_derivative f') (at(Cx(&0)))`) THEN + REWRITE_TAC[HAS_COMPLEX_DERIVATIVE_AT; CEXP_0; COMPLEX_SUB_REFL] THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_SUB_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Crude bounds on complex exponential function, usable to get tighter ones. *) +(* ------------------------------------------------------------------------- *) + +let CEXP_BOUND_BLEMMA = prove + (`!B. (!z. norm(z) <= &1 / &2 ==> norm(cexp z) <= B) + ==> !z. norm(z) <= &1 / &2 ==> norm(cexp z) <= &1 + B / &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cexp`; `cexp`; `cball(Cx(&0),&1 / &2)`; `B:real`] + COMPLEX_DIFFERENTIABLE_BOUND) THEN + ASM_SIMP_TAC[CONVEX_CBALL; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG; + HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP] THEN + DISCH_THEN(MP_TAC o SPECL [`z:complex`; `Cx(&0)`]) THEN + REWRITE_TAC[COMPLEX_NORM_0; CEXP_0; COMPLEX_SUB_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(y) = &1 /\ d <= e ==> norm(x - y) <= d ==> norm(x) <= &1 + e`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; real_div; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN FIRST_X_ASSUM(MP_TAC o SPEC `Cx(&0)`) THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN POP_ASSUM MP_TAC THEN + NORM_ARITH_TAC);; + +let CEXP_BOUND_HALF = prove + (`!z. norm(z) <= &1 / &2 ==> norm(cexp z) <= &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE cexp (cball(Cx(&0),&1 / &2))`; `Cx(&0)`] + DISTANCE_ATTAINS_SUP) THEN + SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; COMPACT_CBALL; CONTINUOUS_ON_CEXP; + IMAGE_EQ_EMPTY; CBALL_EQ_EMPTY; FORALL_IN_IMAGE; EXISTS_IN_IMAGE; + IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `w:complex` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `w:complex` o MATCH_MP CEXP_BOUND_BLEMMA) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:complex`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let CEXP_BOUND_LEMMA = prove + (`!z. norm(z) <= &1 / &2 ==> norm(cexp z) <= &1 + &2 * norm(z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cexp`; `cexp`; `cball(Cx(&0),&1 / &2)`; `&2`] + COMPLEX_DIFFERENTIABLE_BOUND) THEN + ASM_SIMP_TAC[CONVEX_CBALL; IN_CBALL; dist; COMPLEX_SUB_LZERO; NORM_NEG; + HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CEXP; + CEXP_BOUND_HALF] THEN + DISCH_THEN(MP_TAC o SPECL [`z:complex`; `Cx(&0)`]) THEN + REWRITE_TAC[COMPLEX_NORM_0; CEXP_0; COMPLEX_SUB_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(y) = &1 ==> norm(x - y) <= d ==> norm(x) <= &1 + d`) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM]);; + +(* ------------------------------------------------------------------------- *) +(* Complex trig functions. *) +(* ------------------------------------------------------------------------- *) + +let ccos = new_definition + `ccos z = (cexp(ii * z) + cexp(--ii * z)) / Cx(&2)`;; + +let csin = new_definition + `csin z = (cexp(ii * z) - cexp(--ii * z)) / (Cx(&2) * ii)`;; + +let CSIN_0 = prove + (`csin(Cx(&0)) = Cx(&0)`, + REWRITE_TAC[csin; COMPLEX_MUL_RZERO; COMPLEX_SUB_REFL] THEN + CONV_TAC COMPLEX_FIELD);; + +let CCOS_0 = prove + (`ccos(Cx(&0)) = Cx(&1)`, + REWRITE_TAC[ccos; COMPLEX_MUL_RZERO; CEXP_0] THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_CIRCLE = prove + (`!z. csin(z) pow 2 + ccos(z) pow 2 = Cx(&1)`, + GEN_TAC THEN REWRITE_TAC[csin; ccos] THEN + MP_TAC(SPEC `ii * z` CEXP_NEG_LMUL) THEN + REWRITE_TAC[COMPLEX_MUL_LNEG] THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_ADD = prove + (`!w z. csin(w + z) = csin(w) * ccos(z) + ccos(w) * csin(z)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + CONV_TAC COMPLEX_FIELD);; + +let CCOS_ADD = prove + (`!w z. ccos(w + z) = ccos(w) * ccos(z) - csin(w) * csin(z)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[csin; ccos; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_NEG = prove + (`!z. csin(--z) = --(csin(z))`, + REWRITE_TAC[csin; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN + CONV_TAC COMPLEX_FIELD);; + +let CCOS_NEG = prove + (`!z. ccos(--z) = ccos(z)`, + REWRITE_TAC[ccos; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_DOUBLE = prove + (`!z. csin(Cx(&2) * z) = Cx(&2) * csin(z) * ccos(z)`, + REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CSIN_ADD] THEN + CONV_TAC COMPLEX_RING);; + +let CCOS_DOUBLE = prove + (`!z. ccos(Cx(&2) * z) = (ccos(z) pow 2) - (csin(z) pow 2)`, + REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN + CONV_TAC COMPLEX_RING);; + +let CSIN_SUB = prove + (`!w z. csin(w - z) = csin(w) * ccos(z) - ccos(w) * csin(z)`, + REWRITE_TAC[complex_sub; COMPLEX_MUL_RNEG; CSIN_ADD; CSIN_NEG; CCOS_NEG]);; + +let CCOS_SUB = prove + (`!w z. ccos(w - z) = ccos(w) * ccos(z) + csin(w) * csin(z)`, + REWRITE_TAC[complex_sub; CCOS_ADD; CSIN_NEG; CCOS_NEG; + COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]);; + +let COMPLEX_MUL_CSIN_CSIN = prove + (`!w z. csin(w) * csin(z) = (ccos(w - z) - ccos(w + z)) / Cx(&2)`, + REWRITE_TAC[CCOS_ADD; CCOS_SUB] THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_MUL_CSIN_CCOS = prove + (`!w z. csin(w) * ccos(z) = (csin(w + z) + csin(w - z)) / Cx(&2)`, + REWRITE_TAC[CSIN_ADD; CSIN_SUB] THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_MUL_CCOS_CSIN = prove + (`!w z. ccos(w) * csin(z) = (csin(w + z) - csin(w - z)) / Cx(&2)`, + REWRITE_TAC[CSIN_ADD; CSIN_SUB] THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_MUL_CCOS_CCOS = prove + (`!w z. ccos(w) * ccos(z) = (ccos(w - z) + ccos(w + z)) / Cx(&2)`, + REWRITE_TAC[CCOS_ADD; CCOS_SUB] THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_ADD_CSIN = prove + (`!w z. csin(w) + csin(z) = + Cx(&2) * csin((w + z) / Cx(&2)) * ccos((w - z) / Cx(&2))`, + SIMP_TAC[COMPLEX_MUL_CSIN_CCOS; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN + REPEAT GEN_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_SUB_CSIN = prove + (`!w z. csin(w) - csin(z) = + Cx(&2) * csin((w - z) / Cx(&2)) * ccos((w + z) / Cx(&2))`, + SIMP_TAC[COMPLEX_MUL_CSIN_CCOS; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[complex_sub; GSYM CSIN_NEG] THEN + BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_ADD_CCOS = prove + (`!w z. ccos(w) + ccos(z) = + Cx(&2) * ccos((w + z) / Cx(&2)) * ccos((w - z) / Cx(&2))`, + SIMP_TAC[COMPLEX_MUL_CCOS_CCOS; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [COMPLEX_ADD_SYM] THEN + BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_SUB_CCOS = prove + (`!w z. ccos(w) - ccos(z) = + Cx(&2) * csin((w + z) / Cx(&2)) * csin((z - w) / Cx(&2))`, + SIMP_TAC[COMPLEX_MUL_CSIN_CSIN; COMPLEX_RING `Cx(&2) * x / Cx(&2) = x`] THEN + REPEAT GEN_TAC THEN BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC COMPLEX_RING);; + +let CCOS_DOUBLE_CCOS = prove + (`!z. ccos(Cx(&2) * z) = Cx(&2) * ccos z pow 2 - Cx(&1)`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN + MP_TAC(SPEC `z:complex` CSIN_CIRCLE) THEN CONV_TAC COMPLEX_RING);; + +let CCOS_DOUBLE_CSIN = prove + (`!z. ccos(Cx(&2) * z) = Cx(&1) - Cx(&2) * csin z pow 2`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `Cx(&2) * x = x + x`; CCOS_ADD] THEN + MP_TAC(SPEC `z:complex` CSIN_CIRCLE) THEN CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* Euler and de Moivre formulas. *) +(* ------------------------------------------------------------------------- *) + +let CEXP_EULER = prove + (`!z. cexp(ii * z) = ccos(z) + ii * csin(z)`, + REWRITE_TAC[ccos; csin] THEN CONV_TAC COMPLEX_FIELD);; + +let DEMOIVRE = prove + (`!z n. (ccos z + ii * csin z) pow n = + ccos(Cx(&n) * z) + ii * csin(Cx(&n) * z)`, + REWRITE_TAC[GSYM CEXP_EULER; GSYM CEXP_N] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Real exponential function. Same names as old Library/transc.ml. *) +(* ------------------------------------------------------------------------- *) + +let exp = new_definition `exp(x) = Re(cexp(Cx x))`;; + +let CNJ_CEXP = prove + (`!z. cnj(cexp z) = cexp(cnj z)`, + GEN_TAC THEN MATCH_MP_TAC SERIES_UNIQUE THEN + MAP_EVERY EXISTS_TAC [`\n. cnj(z pow n / Cx(&(FACT n)))`; `from 0`] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUMS_CNJ; CEXP_CONVERGES]; + REWRITE_TAC[CNJ_DIV; CNJ_CX; CNJ_POW; CEXP_CONVERGES]]);; + +let REAL_EXP = prove + (`!z. real z ==> real(cexp z)`, + SIMP_TAC[REAL_CNJ; CNJ_CEXP]);; + +let CX_EXP = prove + (`!x. Cx(exp x) = cexp(Cx x)`, + REWRITE_TAC[exp] THEN MESON_TAC[REAL; REAL_CX; REAL_EXP]);; + +let REAL_EXP_ADD = prove + (`!x y. exp(x + y) = exp(x) * exp(y)`, + REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_ADD; CEXP_ADD]);; + +let REAL_EXP_0 = prove + (`exp(&0) = &1`, + REWRITE_TAC[GSYM CX_INJ; CX_EXP; CEXP_0]);; + +let REAL_EXP_ADD_MUL = prove + (`!x y. exp(x + y) * exp(--x) = exp(y)`, + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_ADD; CX_NEG; CEXP_ADD_MUL]);; + +let REAL_EXP_NEG_MUL = prove + (`!x. exp(x) * exp(--x) = &1`, + REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_NEG; CEXP_NEG_RMUL]);; + +let REAL_EXP_NEG_MUL2 = prove + (`!x. exp(--x) * exp(x) = &1`, + REWRITE_TAC[GSYM CX_INJ; CX_MUL; CX_EXP; CX_NEG; CEXP_NEG_LMUL]);; + +let REAL_EXP_NEG = prove + (`!x. exp(--x) = inv(exp(x))`, + REWRITE_TAC[GSYM CX_INJ; CX_INV; CX_EXP; CX_NEG; CEXP_NEG]);; + +let REAL_EXP_N = prove + (`!n x. exp(&n * x) = exp(x) pow n`, + REWRITE_TAC[GSYM CX_INJ; CX_EXP; CX_POW; CX_MUL; CEXP_N]);; + +let REAL_EXP_SUB = prove + (`!x y. exp(x - y) = exp(x) / exp(y)`, + REWRITE_TAC[GSYM CX_INJ; CX_SUB; CX_DIV; CX_EXP; CEXP_SUB]);; + +let REAL_EXP_NZ = prove + (`!x. ~(exp(x) = &0)`, + REWRITE_TAC[GSYM CX_INJ; CX_EXP; CEXP_NZ]);; + +let REAL_EXP_POS_LE = prove + (`!x. &0 <= exp(x)`, + GEN_TAC THEN SUBST1_TAC(REAL_ARITH `x = x / &2 + x / &2`) THEN + REWRITE_TAC[REAL_EXP_ADD; REAL_LE_SQUARE]);; + +let REAL_EXP_POS_LT = prove + (`!x. &0 < exp(x)`, + REWRITE_TAC[REAL_LT_LE; REAL_EXP_NZ; REAL_EXP_POS_LE]);; + +let REAL_EXP_LE_X = prove + (`!x. &1 + x <= exp(x)`, + GEN_TAC THEN ASM_CASES_TAC `&1 + x < &0` THENL + [MP_TAC(SPEC `x:real` REAL_EXP_POS_LT) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[exp; RE_DEF] THEN + MATCH_MP_TAC(MATCH_MP + (ONCE_REWRITE_RULE[TAUT `a /\ b /\ c ==> d <=> b ==> a /\ c ==> d`] + LIM_COMPONENT_LBOUND) + (REWRITE_RULE[sums] (SPEC `Cx x` CEXP_CONVERGES))) THEN + SIMP_TAC[DIMINDEX_2; ARITH; TRIVIAL_LIMIT_SEQUENTIALLY; + VSUM_COMPONENT; EVENTUALLY_SEQUENTIALLY; FROM_0; INTER_UNIV] THEN + REWRITE_TAC[GSYM CX_DIV; GSYM RE_DEF; RE_CX; GSYM CX_POW] THEN + EXISTS_TAC `1` THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SIMP_TAC[real_pow; REAL_POW_1; REAL_DIV_1; REAL_LE_ADDR; REAL_ADD_ASSOC] THEN + SUBGOAL_THEN + `!n. &0 <= sum(2*1..2*n+1) (\k. x pow k / &(FACT k))` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[SUM_PAIR] THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM ADD1; real_pow; FACT; GSYM REAL_OF_NUM_MUL] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; FACT_NZ; NOT_SUC; REAL_FIELD + `~(k = &0) /\ ~(f = &0) + ==> p / f + (x * p) / (k * f) = p / f * (&1 + x / k)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[REAL_ARITH `&0 <= a + b <=> --a <= b`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; LT_0; REAL_OF_NUM_LT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_REAL_ARITH_TAC]; + RULE_ASSUM_TAC(REWRITE_RULE[MULT_CLAUSES]) THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MP_TAC(SPEC `n - 1` EVEN_OR_ODD) THEN + ASM_SIMP_TAC[EVEN_EXISTS; ODD_EXISTS; + ARITH_RULE `1 <= n ==> (n - 1 = d <=> n = SUC d)`] THEN + STRIP_TAC THENL [ASM_MESON_TAC[ADD1]; ALL_TAC] THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC(2 * n) = 2 * n + 1`] THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_ADD THEN + ASM_REWRITE_TAC[ARITH_RULE `SUC(2 * m + 1) = 2 * (m + 1)`]] THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[GSYM REAL_POW_POW; REAL_POW_LE; REAL_LE_POW_2]);; + +let REAL_EXP_LT_1 = prove + (`!x. &0 < x ==> &1 < exp(x)`, + MP_TAC REAL_EXP_LE_X THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let REAL_EXP_MONO_IMP = prove + (`!x y. x < y ==> exp(x) < exp(y)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_LT] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_EXP_LT_1) THEN + SIMP_TAC[REAL_EXP_SUB; REAL_LT_RDIV_EQ; REAL_EXP_POS_LT; REAL_MUL_LID]);; + +let REAL_EXP_MONO_LT = prove + (`!x y. exp(x) < exp(y) <=> x < y`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH + `(x < y ==> f < g) /\ (x = y ==> f = g) /\ (y < x ==> g < f) + ==> (f < g <=> x < y)`) THEN + SIMP_TAC[REAL_EXP_MONO_IMP]);; + +let REAL_EXP_MONO_LE = prove + (`!x y. exp(x) <= exp(y) <=> x <= y`, + REWRITE_TAC[GSYM REAL_NOT_LT; REAL_EXP_MONO_LT]);; + +let REAL_EXP_INJ = prove + (`!x y. (exp(x) = exp(y)) <=> (x = y)`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_EXP_MONO_LE]);; + +let REAL_EXP_EQ_1 = prove + (`!x. exp(x) = &1 <=> x = &0`, + ONCE_REWRITE_TAC[GSYM REAL_EXP_0] THEN REWRITE_TAC[REAL_EXP_INJ]);; + +let REAL_ABS_EXP = prove + (`!x. abs(exp x) = exp x`, + REWRITE_TAC[real_abs; REAL_EXP_POS_LE]);; + +let REAL_EXP_SUM = prove + (`!f s. FINITE s ==> exp(sum s f) = product s (\x. exp(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; PRODUCT_CLAUSES; REAL_EXP_ADD; REAL_EXP_0]);; + +let REAL_EXP_BOUND_LEMMA = prove + (`!x. &0 <= x /\ x <= inv(&2) ==> exp(x) <= &1 + &2 * x`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `Cx x` CEXP_BOUND_LEMMA) THEN + REWRITE_TAC[GSYM CX_EXP; COMPLEX_NORM_CX; RE_CX] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Real trig functions, their reality, derivatives of complex versions. *) +(* ------------------------------------------------------------------------- *) + +let sin = new_definition `sin(x) = Re(csin(Cx x))`;; + +let cos = new_definition `cos(x) = Re(ccos(Cx x))`;; + +let CNJ_CSIN = prove + (`!z. cnj(csin z) = csin(cnj z)`, + REWRITE_TAC[csin; CNJ_DIV; CNJ_SUB; CNJ_MUL; CNJ_CX; CNJ_CEXP; + CNJ_NEG; CNJ_II; COMPLEX_NEG_NEG] THEN + CONV_TAC COMPLEX_FIELD);; + +let CNJ_CCOS = prove + (`!z. cnj(ccos z) = ccos(cnj z)`, + REWRITE_TAC[ccos; CNJ_DIV; CNJ_ADD; CNJ_MUL; CNJ_CX; CNJ_CEXP; + CNJ_NEG; CNJ_II; COMPLEX_NEG_NEG; COMPLEX_ADD_AC]);; + +let REAL_SIN = prove + (`!z. real z ==> real(csin z)`, + SIMP_TAC[REAL_CNJ; CNJ_CSIN]);; + +let REAL_COS = prove + (`!z. real z ==> real(ccos z)`, + SIMP_TAC[REAL_CNJ; CNJ_CCOS]);; + +let CX_SIN = prove + (`!x. Cx(sin x) = csin(Cx x)`, + REWRITE_TAC[sin] THEN MESON_TAC[REAL; REAL_CX; REAL_SIN]);; + +let CX_COS = prove + (`!x. Cx(cos x) = ccos(Cx x)`, + REWRITE_TAC[cos] THEN MESON_TAC[REAL; REAL_CX; REAL_COS]);; + +let HAS_COMPLEX_DERIVATIVE_CSIN = prove + (`!z. (csin has_complex_derivative ccos z) (at z)`, + GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[csin; ccos] THEN COMPLEX_DIFF_TAC THEN + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIFFERENTIABLE_AT_CSIN = prove + (`!z. csin complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSIN]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CSIN = prove + (`!s z. csin complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CSIN]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV + HAS_COMPLEX_DERIVATIVE_CSIN)));; + +let HAS_COMPLEX_DERIVATIVE_CCOS = prove + (`!z. (ccos has_complex_derivative --csin z) (at z)`, + GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[csin; ccos] THEN COMPLEX_DIFF_TAC THEN + CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIFFERENTIABLE_AT_CCOS = prove + (`!z. ccos complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CCOS]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CCOS = prove + (`!s z. ccos complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CCOS]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV + HAS_COMPLEX_DERIVATIVE_CCOS)));; + +let CONTINUOUS_AT_CSIN = prove + (`!z. csin continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSIN; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CSIN = prove + (`!s z. csin continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CSIN]);; + +let CONTINUOUS_ON_CSIN = prove + (`!s. csin continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CSIN]);; + +let HOLOMORPHIC_ON_CSIN = prove + (`!s. csin holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CSIN]);; + +let CONTINUOUS_AT_CCOS = prove + (`!z. ccos continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CCOS; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CCOS = prove + (`!s z. ccos continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CCOS]);; + +let CONTINUOUS_ON_CCOS = prove + (`!s. ccos continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CCOS]);; + +let HOLOMORPHIC_ON_CCOS = prove + (`!s. ccos holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CCOS]);; + +(* ------------------------------------------------------------------------- *) +(* Slew of theorems for compatibility with old transc.ml file. *) +(* ------------------------------------------------------------------------- *) + +let SIN_0 = prove + (`sin(&0) = &0`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CSIN_0]);; + +let COS_0 = prove + (`cos(&0) = &1`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CCOS_0]);; + +let SIN_CIRCLE = prove + (`!x. (sin(x) pow 2) + (cos(x) pow 2) = &1`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_POW; CSIN_CIRCLE]);; + +let SIN_ADD = prove + (`!x y. sin(x + y) = sin(x) * cos(y) + cos(x) * sin(y)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_MUL; CSIN_ADD]);; + +let COS_ADD = prove + (`!x y. cos(x + y) = cos(x) * cos(y) - sin(x) * sin(y)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CCOS_ADD]);; + +let SIN_NEG = prove + (`!x. sin(--x) = --(sin(x))`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_NEG; CSIN_NEG]);; + +let COS_NEG = prove + (`!x. cos(--x) = cos(x)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_NEG; CCOS_NEG]);; + +let SIN_DOUBLE = prove + (`!x. sin(&2 * x) = &2 * sin(x) * cos(x)`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_MUL; CSIN_DOUBLE]);; + +let COS_DOUBLE = prove + (`!x. cos(&2 * x) = (cos(x) pow 2) - (sin(x) pow 2)`, + SIMP_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_SUB; CX_MUL; CX_POW; CCOS_DOUBLE]);; + +let COS_DOUBLE_COS = prove + (`!x. cos(&2 * x) = &2 * cos(x) pow 2 - &1`, + MP_TAC SIN_CIRCLE THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[COS_DOUBLE] THEN REAL_ARITH_TAC);; + +let (SIN_BOUND,COS_BOUND) = (CONJ_PAIR o prove) + (`(!x. abs(sin x) <= &1) /\ (!x. abs(cos x) <= &1)`, + CONJ_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[REAL_LE_SQUARE_ABS] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN + MAP_EVERY (MP_TAC o C SPEC REAL_LE_SQUARE) [`sin x`; `cos x`] THEN + REAL_ARITH_TAC);; + +let SIN_BOUNDS = prove + (`!x. --(&1) <= sin(x) /\ sin(x) <= &1`, + MP_TAC SIN_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let COS_BOUNDS = prove + (`!x. --(&1) <= cos(x) /\ cos(x) <= &1`, + MP_TAC COS_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let COS_ABS = prove + (`!x. cos(abs x) = cos(x)`, + REWRITE_TAC[real_abs] THEN MESON_TAC[COS_NEG]);; + +let SIN_SUB = prove + (`!w z. sin(w - z) = sin(w) * cos(z) - cos(w) * sin(z)`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_SUB; CX_MUL; CSIN_SUB]);; + +let COS_SUB = prove + (`!w z. cos(w - z) = cos(w) * cos(z) + sin(w) * sin(z)`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CX_COS; CX_SUB; CX_ADD; CX_MUL; CCOS_SUB]);; + +let REAL_MUL_SIN_SIN = prove + (`!x y. sin(x) * sin(y) = (cos(x - y) - cos(x + y)) / &2`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_MUL_CSIN_CSIN]);; + +let REAL_MUL_SIN_COS = prove + (`!x y. sin(x) * cos(y) = (sin(x + y) + sin(x - y)) / &2`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_MUL_CSIN_CCOS]);; + +let REAL_MUL_COS_SIN = prove + (`!x y. cos(x) * sin(y) = (sin(x + y) - sin(x - y)) / &2`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_MUL_CCOS_CSIN]);; + +let REAL_MUL_COS_COS = prove + (`!x y. cos(x) * cos(y) = (cos(x - y) + cos(x + y)) / &2`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_MUL_CCOS_CCOS]);; + +let REAL_ADD_SIN = prove + (`!x y. sin(x) + sin(y) = &2 * sin((x + y) / &2) * cos((x - y) / &2)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_ADD_CSIN]);; + +let REAL_SUB_SIN = prove + (`!x y. sin(x) - sin(y) = &2 * sin((x - y) / &2) * cos((x + y) / &2)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_SUB_CSIN]);; + +let REAL_ADD_COS = prove + (`!x y. cos(x) + cos(y) = &2 * cos((x + y) / &2) * cos((x - y) / &2)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_ADD_CCOS]);; + +let REAL_SUB_COS = prove + (`!x y. cos(x) - cos(y) = &2 * sin((x + y) / &2) * sin((y - x) / &2)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CX_SIN; CX_ADD; CX_SUB; CX_MUL; CX_DIV] THEN + REWRITE_TAC[COMPLEX_SUB_CCOS]);; + +let COS_DOUBLE_SIN = prove + (`!x. cos(&2 * x) = &1 - &2 * sin x pow 2`, + GEN_TAC THEN REWRITE_TAC[REAL_RING `&2 * x = x + x`; COS_ADD] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Get a nice real/imaginary separation in Euler's formula. *) +(* ------------------------------------------------------------------------- *) + +let EULER = prove + (`!z. cexp(z) = Cx(exp(Re z)) * (Cx(cos(Im z)) + ii * Cx(sin(Im z)))`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EXPAND] THEN + REWRITE_TAC[CEXP_ADD; CEXP_EULER; GSYM CX_SIN; GSYM CX_COS; GSYM CX_EXP]);; + +let RE_CEXP = prove + (`!z. Re(cexp z) = exp(Re z) * cos(Im z)`, + REWRITE_TAC[EULER; RE_ADD; RE_MUL_CX; RE_MUL_II; IM_CX; RE_CX] THEN + REAL_ARITH_TAC);; + +let IM_CEXP = prove + (`!z. Im(cexp z) = exp(Re z) * sin(Im z)`, + REWRITE_TAC[EULER; IM_ADD; IM_MUL_CX; IM_MUL_II; IM_CX; RE_CX] THEN + REAL_ARITH_TAC);; + +let RE_CSIN = prove + (`!z. Re(csin z) = (exp(Im z) + exp(--(Im z))) / &2 * sin(Re z)`, + GEN_TAC THEN REWRITE_TAC[csin] THEN + SIMP_TAC[COMPLEX_FIELD `x / (Cx(&2) * ii) = ii * --(x / Cx(&2))`] THEN + REWRITE_TAC[IM_MUL_II; IM_DIV_CX; RE_NEG; IM_SUB; IM_CEXP; + RE_MUL_II; COMPLEX_MUL_LNEG; IM_NEG] THEN + REWRITE_TAC[REAL_NEG_NEG; SIN_NEG] THEN CONV_TAC REAL_RING);; + +let IM_CSIN = prove + (`!z. Im(csin z) = (exp(Im z) - exp(--(Im z))) / &2 * cos(Re z)`, + GEN_TAC THEN REWRITE_TAC[csin] THEN + SIMP_TAC[COMPLEX_FIELD `x / (Cx(&2) * ii) = ii * --(x / Cx(&2))`] THEN + REWRITE_TAC[IM_MUL_II; RE_DIV_CX; RE_NEG; RE_SUB; RE_CEXP; + RE_MUL_II; COMPLEX_MUL_LNEG; IM_NEG] THEN + REWRITE_TAC[REAL_NEG_NEG; COS_NEG] THEN CONV_TAC REAL_RING);; + +let RE_CCOS = prove + (`!z. Re(ccos z) = (exp(Im z) + exp(--(Im z))) / &2 * cos(Re z)`, + GEN_TAC THEN REWRITE_TAC[ccos] THEN + REWRITE_TAC[RE_DIV_CX; RE_ADD; RE_CEXP; COMPLEX_MUL_LNEG; + RE_MUL_II; IM_MUL_II; RE_NEG; IM_NEG; COS_NEG] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN CONV_TAC REAL_RING);; + +let IM_CCOS = prove + (`!z. Im(ccos z) = (exp(--(Im z)) - exp(Im z)) / &2 * sin(Re z)`, + GEN_TAC THEN REWRITE_TAC[ccos] THEN + REWRITE_TAC[IM_DIV_CX; IM_ADD; IM_CEXP; COMPLEX_MUL_LNEG; + RE_MUL_II; IM_MUL_II; RE_NEG; IM_NEG; SIN_NEG] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Some special intermediate value theorems over the reals. *) +(* ------------------------------------------------------------------------- *) + +let IVT_INCREASING_RE = prove + (`!f a b y. + a <= b /\ + (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ + Re(f(Cx a)) <= y /\ y <= Re(f(Cx b)) + ==> ?x. a <= x /\ x <= b /\ Re(f(Cx x)) = y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(f:complex->complex) o Cx o drop`; + `lift a`; `lift b`; `y:real`; `1`] + IVT_INCREASING_COMPONENT_1) THEN + REWRITE_TAC[EXISTS_DROP; GSYM drop; LIFT_DROP; o_THM; GSYM RE_DEF] THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM CONJ_ASSOC; LIFT_DROP] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[DIMINDEX_2; ARITH] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + ASM_SIMP_TAC[o_THM] THEN REWRITE_TAC[continuous_at; o_THM] THEN + REWRITE_TAC[dist; GSYM CX_SUB; GSYM DROP_SUB; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM ABS_DROP] THEN MESON_TAC[]);; + +let IVT_DECREASING_RE = prove + (`!f a b y. + a <= b /\ + (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ + Re(f(Cx b)) <= y /\ y <= Re(f(Cx a)) + ==> ?x. a <= x /\ x <= b /\ Re(f(Cx x)) = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN + REWRITE_TAC[GSYM RE_NEG] THEN MATCH_MP_TAC IVT_INCREASING_RE THEN + ASM_SIMP_TAC[CONTINUOUS_NEG; RE_NEG; REAL_LE_NEG2]);; + +let IVT_INCREASING_IM = prove + (`!f a b y. + a <= b /\ + (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ + Im(f(Cx a)) <= y /\ y <= Im(f(Cx b)) + ==> ?x. a <= x /\ x <= b /\ Im(f(Cx x)) = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN + REWRITE_TAC[SYM(CONJUNCT2(SPEC_ALL RE_MUL_II))] THEN + MATCH_MP_TAC IVT_DECREASING_RE THEN + ASM_SIMP_TAC[CONTINUOUS_COMPLEX_MUL; ETA_AX; CONTINUOUS_CONST] THEN + ASM_REWRITE_TAC[RE_MUL_II; REAL_LE_NEG2]);; + +let IVT_DECREASING_IM = prove + (`!f a b y. + a <= b /\ + (!x. a <= x /\ x <= b ==> f continuous at (Cx x)) /\ + Im(f(Cx b)) <= y /\ y <= Im(f(Cx a)) + ==> ?x. a <= x /\ x <= b /\ Im(f(Cx x)) = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EQ_NEG2] THEN + REWRITE_TAC[GSYM IM_NEG] THEN MATCH_MP_TAC IVT_INCREASING_IM THEN + ASM_SIMP_TAC[CONTINUOUS_NEG; IM_NEG; REAL_LE_NEG2]);; + +(* ------------------------------------------------------------------------- *) +(* Some minimal properties of real logs help to define complex logs. *) +(* ------------------------------------------------------------------------- *) + +let log_def = new_definition + `log y = @x. exp(x) = y`;; + +let EXP_LOG = prove + (`!x. &0 < x ==> exp(log x) = x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[log_def] THEN CONV_TAC SELECT_CONV THEN + SUBGOAL_THEN `?y. --inv(x) <= y /\ y <= x /\ Re(cexp(Cx y)) = x` + MP_TAC THENL [ALL_TAC; MESON_TAC[CX_EXP; RE_CX]] THEN + MATCH_MP_TAC IVT_INCREASING_RE THEN + SIMP_TAC[GSYM CX_EXP; RE_CX; CONTINUOUS_AT_CEXP] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < x /\ &0 < y ==> --y <= x`) THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ]; + ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_EXP_NEG; REAL_INV_INV; REAL_LT_INV_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&1 + x <= y ==> x <= y`) THEN + ASM_SIMP_TAC[REAL_EXP_LE_X; REAL_LE_INV_EQ; REAL_LT_IMP_LE]);; + +let LOG_EXP = prove + (`!x. log(exp x) = x`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + SIMP_TAC[EXP_LOG; REAL_EXP_POS_LT]);; + +let REAL_EXP_LOG = prove + (`!x. (exp(log x) = x) <=> &0 < x`, + MESON_TAC[EXP_LOG; REAL_EXP_POS_LT]);; + +let LOG_MUL = prove + (`!x y. &0 < x /\ &0 < y ==> (log(x * y) = log(x) + log(y))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + ASM_SIMP_TAC[REAL_EXP_ADD; REAL_LT_MUL; EXP_LOG]);; + +let LOG_INJ = prove + (`!x y. &0 < x /\ &0 < y ==> (log(x) = log(y) <=> x = y)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_INJ] THEN + ASM_SIMP_TAC[EXP_LOG]);; + +let LOG_1 = prove + (`log(&1) = &0`, + ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + REWRITE_TAC[REAL_EXP_0; REAL_EXP_LOG; REAL_LT_01]);; + +let LOG_INV = prove + (`!x. &0 < x ==> (log(inv x) = --(log x))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + ASM_SIMP_TAC[REAL_EXP_NEG; EXP_LOG; REAL_LT_INV_EQ]);; + +let LOG_DIV = prove + (`!x y. &0 < x /\ &0 < y ==> log(x / y) = log(x) - log(y)`, + SIMP_TAC[real_div; real_sub; LOG_MUL; LOG_INV; REAL_LT_INV_EQ]);; + +let LOG_MONO_LT = prove + (`!x y. &0 < x /\ &0 < y ==> (log(x) < log(y) <=> x < y)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LT] THEN + ASM_SIMP_TAC[EXP_LOG]);; + +let LOG_MONO_LT_IMP = prove + (`!x y. &0 < x /\ x < y ==> log(x) < log(y)`, + MESON_TAC[LOG_MONO_LT; REAL_LT_TRANS]);; + +let LOG_MONO_LT_REV = prove + (`!x y. &0 < x /\ &0 < y /\ log x < log y ==> x < y`, + MESON_TAC[LOG_MONO_LT]);; + +let LOG_MONO_LE = prove + (`!x y. &0 < x /\ &0 < y ==> (log(x) <= log(y) <=> x <= y)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG]);; + +let LOG_MONO_LE_IMP = prove + (`!x y. &0 < x /\ x <= y ==> log(x) <= log(y)`, + MESON_TAC[LOG_MONO_LE; REAL_LT_IMP_LE; REAL_LTE_TRANS]);; + +let LOG_MONO_LE_REV = prove + (`!x y. &0 < x /\ &0 < y /\ log x <= log y ==> x <= y`, + MESON_TAC[LOG_MONO_LE]);; + +let LOG_POW = prove + (`!n x. &0 < x ==> (log(x pow n) = &n * log(x))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_INJ] THEN + ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_POW_LT]);; + +let LOG_LE_STRONG = prove + (`!x. &0 < &1 + x ==> log(&1 + x) <= x`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_EXP_LE_X]);; + +let LOG_LE = prove + (`!x. &0 <= x ==> log(&1 + x) <= x`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_ARITH `&0 <= x ==> &0 < &1 + x`; REAL_EXP_LE_X]);; + +let LOG_LT_X = prove + (`!x. &0 < x ==> log(x) < x`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LT] THEN + ASM_SIMP_TAC[EXP_LOG] THEN MP_TAC(SPEC `x:real` REAL_EXP_LE_X) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let LOG_POS = prove + (`!x. &1 <= x ==> &0 <= log(x)`, + REWRITE_TAC[GSYM LOG_1] THEN + SIMP_TAC[LOG_MONO_LE; ARITH_RULE `&1 <= x ==> &0 < x`; REAL_LT_01]);; + +let LOG_POS_LT = prove + (`!x. &1 < x ==> &0 < log(x)`, + REWRITE_TAC[GSYM LOG_1] THEN + SIMP_TAC[LOG_MONO_LT; ARITH_RULE `&1 < x ==> &0 < x`; REAL_LT_01]);; + +let LOG_PRODUCT = prove + (`!f:A->real s. + FINITE s /\ (!x. x IN s ==> &0 < f x) + ==> log(product s f) = sum s (\x. log(f x))`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; SUM_CLAUSES; LOG_1; FORALL_IN_INSERT; LOG_MUL; + PRODUCT_POS_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Deduce periodicity just from derivative and zero values. *) +(* ------------------------------------------------------------------------- *) + +let SIN_NEARZERO = prove + (`?x. &0 < x /\ !y. &0 < y /\ y <= x ==> &0 < sin(y)`, + MP_TAC(SPEC `&1 / &2` (CONJUNCT2 + (REWRITE_RULE[has_complex_derivative; HAS_DERIVATIVE_AT_ALT] + (ISPEC `Cx(&0)` HAS_COMPLEX_DERIVATIVE_CSIN)))) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[CSIN_0; COMPLEX_SUB_RZERO; CCOS_0; COMPLEX_MUL_LZERO; + COMPLEX_MUL_LID] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Cx y`) THEN + ASM_REWRITE_TAC[GSYM CX_SIN; COMPLEX_NORM_CX; GSYM CX_SUB] THEN + ASM_REAL_ARITH_TAC);; + +let SIN_NONTRIVIAL = prove + (`?x. &0 < x /\ ~(sin x = &0)`, + MESON_TAC[REAL_LE_REFL; REAL_LT_REFL; SIN_NEARZERO]);; + +let COS_NONTRIVIAL = prove + (`?x. &0 < x /\ ~(cos x = &1)`, + MP_TAC SIN_NONTRIVIAL THEN MATCH_MP_TAC MONO_EXISTS THEN + MP_TAC SIN_CIRCLE THEN MATCH_MP_TAC MONO_FORALL THEN + CONV_TAC REAL_FIELD);; + +let COS_DOUBLE_BOUND = prove + (`!x. &0 <= cos x ==> &2 * (&1 - cos x) <= &1 - cos(&2 * x)`, + REWRITE_TAC[COS_DOUBLE_COS] THEN REWRITE_TAC[REAL_ARITH + `&2 * (&1 - a) <= &1 - (&2 * b - &1) <=> b <= &1 * a`] THEN + SIMP_TAC[REAL_POW_2; REAL_LE_RMUL; COS_BOUNDS]);; + +let COS_GOESNEGATIVE_LEMMA = prove + (`!x. cos(x) < &1 ==> ?n. cos(&2 pow n * x) < &0`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~p ==> p) ==> p`) THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `!n. &2 pow n * (&1 - cos x) <= &1 - cos(&2 pow n * x)` + ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * (&1 - cos(&2 pow n * x))` THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL; REAL_POS; COS_DOUBLE_BOUND]; + MP_TAC(ISPEC `&1 / (&1 - cos(x))` REAL_ARCH_POW2) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN REAL_ARITH_TAC]);; + +let COS_GOESNEGATIVE = prove + (`?x. &0 < x /\ cos(x) < &0`, + X_CHOOSE_TAC `x:real` COS_NONTRIVIAL THEN + MP_TAC(SPEC `x:real` COS_GOESNEGATIVE_LEMMA) THEN ANTS_TAC THENL + [MP_TAC(SPEC `x:real` COS_BOUNDS) THEN + ASM_REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_ARITH `&0 < &2`]]);; + +let COS_HASZERO = prove + (`?x. &0 < x /\ cos(x) = &0`, + X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC COS_GOESNEGATIVE THEN + SUBGOAL_THEN `?x. &0 <= x /\ x <= z /\ Re(ccos(Cx x)) = &0` MP_TAC THENL + [MATCH_MP_TAC IVT_DECREASING_RE THEN + ASM_SIMP_TAC[GSYM CX_COS; RE_CX; REAL_LT_IMP_LE; COS_0; REAL_POS] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT; + HAS_COMPLEX_DERIVATIVE_CCOS]; + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM CX_COS; RE_CX] THEN + MESON_TAC[COS_0; REAL_LE_LT; REAL_ARITH `~(&1 = &0)`]]);; + +let SIN_HASZERO = prove + (`?x. &0 < x /\ sin(x) = &0`, + X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC COS_HASZERO THEN + EXISTS_TAC `&2 * x` THEN ASM_SIMP_TAC[SIN_DOUBLE] THEN + ASM_REAL_ARITH_TAC);; + +let SIN_HASZERO_MINIMAL = prove + (`?p. &0 < p /\ sin p = &0 /\ !x. &0 < x /\ x < p ==> ~(sin x = &0)`, + X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC SIN_NEARZERO THEN + MP_TAC(ISPECL + [`{z | z IN IMAGE Cx {x | x >= e} /\ csin z IN {Cx(&0)}}`; `Cx(&0)`] + DISTANCE_ATTAINS_INF) THEN + ANTS_TAC THENL + [ALL_TAC; + REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; IMP_CONJ] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM; IN_SING; real_ge; GSYM CX_COS; CX_INJ] THEN + REWRITE_TAC[dist; GSYM CX_SUB; GSYM CX_SIN; CX_INJ; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(&0 - x) = abs x`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + X_GEN_TAC `x:real` THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real`))] THEN + ASM_REAL_ARITH_TAC] THEN + X_CHOOSE_TAC `a:real` SIN_HASZERO THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `Cx a` THEN + ASM_REWRITE_TAC[IN_SING; IN_IMAGE; IN_ELIM_THM; GSYM CX_SIN] THEN + ASM_MESON_TAC[REAL_ARITH `x >= w \/ x <= w`; REAL_LT_REFL]] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + REWRITE_TAC[CONTINUOUS_ON_CSIN; CLOSED_SING] THEN + SUBGOAL_THEN + `IMAGE Cx {x | x >= e} = {z | Im(z) = &0} INTER {z | Re(z) >= e}` + (fun th -> SIMP_TAC[th; CLOSED_INTER; CLOSED_HALFSPACE_IM_EQ; + CLOSED_HALFSPACE_RE_GE]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[FORALL_COMPLEX; COMPLEX_EQ; RE; IM; RE_CX; IM_CX] THEN + MESON_TAC[]);; + +let pi = new_definition + `pi = @p. &0 < p /\ sin(p) = &0 /\ !x. &0 < x /\ x < p ==> ~(sin(x) = &0)`;; + +let PI_WORKS = prove + (`&0 < pi /\ sin(pi) = &0 /\ !x. &0 < x /\ x < pi ==> ~(sin x = &0)`, + REWRITE_TAC[pi] THEN CONV_TAC SELECT_CONV THEN + REWRITE_TAC[SIN_HASZERO_MINIMAL]);; + +(* ------------------------------------------------------------------------- *) +(* Now more relatively easy consequences. *) +(* ------------------------------------------------------------------------- *) + +let PI_POS = prove + (`&0 < pi`, + REWRITE_TAC[PI_WORKS]);; + +let PI_POS_LE = prove + (`&0 <= pi`, + REWRITE_TAC[REAL_LE_LT; PI_POS]);; + +let PI_NZ = prove + (`~(pi = &0)`, + SIMP_TAC[PI_POS; REAL_LT_IMP_NZ]);; + +let REAL_ABS_PI = prove + (`abs pi = pi`, + REWRITE_TAC[real_abs; PI_POS_LE]);; + +let SIN_PI = prove + (`sin(pi) = &0`, + REWRITE_TAC[PI_WORKS]);; + +let SIN_POS_PI = prove + (`!x. &0 < x /\ x < pi ==> &0 < sin(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN + X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC SIN_NEARZERO THEN + MP_TAC(ISPECL [`csin`; `e:real`; `x:real`; `&0`] IVT_DECREASING_RE) THEN + ASM_SIMP_TAC[NOT_IMP; CONTINUOUS_AT_CSIN; GSYM CX_SIN; RE_CX; SIN_0] THEN + ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LET_ANTISYM; PI_WORKS; REAL_LET_TRANS; + REAL_LTE_TRANS]);; + +let COS_PI2 = prove + (`cos(pi / &2) = &0`, + MP_TAC(SYM(SPEC `pi / &2` SIN_DOUBLE)) THEN + REWRITE_TAC[REAL_HALF; SIN_PI; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < y ==> y = &0 \/ z = &0 ==> z = &0`) THEN + MATCH_MP_TAC SIN_POS_PI THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let COS_PI = prove + (`cos(pi) = -- &1`, + ONCE_REWRITE_TAC[REAL_ARITH `pi = &2 * pi / &2`] THEN + REWRITE_TAC[COS_DOUBLE_COS; COS_PI2] THEN REAL_ARITH_TAC);; + +let SIN_PI2 = prove + (`sin(pi / &2) = &1`, + MP_TAC(SPEC `pi / &2` SIN_CIRCLE) THEN + REWRITE_TAC[COS_PI2; REAL_POW_2; REAL_ADD_RID; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_RING `x * x = &1 <=> x = &1 \/ x = -- &1`] THEN + MP_TAC(SPEC `pi / &2` SIN_POS_PI) THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let SIN_COS = prove + (`!x. sin(x) = cos(pi / &2 - x)`, + REWRITE_TAC[COS_SUB; COS_PI2; SIN_PI2] THEN REAL_ARITH_TAC);; + +let COS_SIN = prove + (`!x. cos(x) = sin(pi / &2 - x)`, + REWRITE_TAC[SIN_SUB; COS_PI2; SIN_PI2] THEN REAL_ARITH_TAC);; + +let SIN_PERIODIC_PI = prove + (`!x. sin(x + pi) = --(sin(x))`, + REWRITE_TAC[SIN_ADD; SIN_PI; COS_PI] THEN REAL_ARITH_TAC);; + +let COS_PERIODIC_PI = prove + (`!x. cos(x + pi) = --(cos(x))`, + REWRITE_TAC[COS_ADD; SIN_PI; COS_PI] THEN REAL_ARITH_TAC);; + +let SIN_PERIODIC = prove + (`!x. sin(x + &2 * pi) = sin(x)`, + REWRITE_TAC[REAL_MUL_2; REAL_ADD_ASSOC; SIN_PERIODIC_PI; REAL_NEG_NEG]);; + +let COS_PERIODIC = prove + (`!x. cos(x + &2 * pi) = cos(x)`, + REWRITE_TAC[REAL_MUL_2; REAL_ADD_ASSOC; COS_PERIODIC_PI; REAL_NEG_NEG]);; + +let SIN_NPI = prove + (`!n. sin(&n * pi) = &0`, + INDUCT_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_MUL_LID; REAL_ADD_RDISTRIB; + REAL_NEG_0; SIN_PERIODIC_PI; REAL_MUL_LZERO; SIN_0]);; + +let COS_NPI = prove + (`!n. cos(&n * pi) = --(&1) pow n`, + INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LZERO; COS_0; COS_PERIODIC_PI; + REAL_MUL_LID; REAL_MUL_LNEG; GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB]);; + +let COS_POS_PI2 = prove + (`!x. &0 < x /\ x < pi / &2 ==> &0 < cos(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`ccos`; `&0`; `x:real`; `&0`] IVT_DECREASING_RE) THEN + ASM_SIMP_TAC[CONTINUOUS_AT_CCOS; REAL_LT_IMP_LE; GSYM CX_COS; RE_CX] THEN + REWRITE_TAC[COS_0; REAL_POS] THEN DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN + MP_TAC(SPEC `y:real` SIN_DOUBLE) THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + MATCH_MP_TAC(last(CONJUNCTS PI_WORKS)) THEN REPEAT(POP_ASSUM MP_TAC) THEN + ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[COS_0] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let SIN_POS_PI2 = prove + (`!x. &0 < x /\ x < pi / &2 ==> &0 < sin(x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN + ASM_REAL_ARITH_TAC);; + +let COS_POS_PI = prove + (`!x. --(pi / &2) < x /\ x < pi / &2 ==> &0 < cos(x)`, + GEN_TAC THEN MP_TAC(SPEC `abs x` COS_POS_PI2) THEN REWRITE_TAC[COS_ABS] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[COS_0] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let COS_POS_PI_LE = prove + (`!x. --(pi / &2) <= x /\ x <= pi / &2 ==> &0 <= cos(x)`, + REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[COS_PI2; COS_NEG; COS_POS_PI]);; + +let SIN_POS_PI_LE = prove + (`!x. &0 <= x /\ x <= pi ==> &0 <= sin(x)`, + REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[SIN_0; SIN_PI; SIN_POS_PI]);; + +let SIN_PIMUL_EQ_0 = prove + (`!n. sin(n * pi) = &0 <=> integer(n)`, + SUBGOAL_THEN `!n. integer n ==> sin(n * pi) = &0 /\ ~(cos(n * pi) = &0)` + ASSUME_TAC THENL + [REWRITE_TAC[INTEGER_CASES] THEN GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THEN + ASM_SIMP_TAC[REAL_MUL_LNEG; COS_NPI; SIN_NPI; + SIN_NEG; COS_NEG; REAL_POW_EQ_0] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN + SUBST1_TAC(last(CONJUNCTS(SPEC `n:real` FLOOR_FRAC))) THEN + ASM_SIMP_TAC[REAL_ADD_RDISTRIB; FLOOR; SIN_ADD; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[REAL_ADD_LID; REAL_ENTIRE; FLOOR] THEN + DISCH_TAC THEN MP_TAC(SPEC `frac n * pi` SIN_POS_PI) THEN + ASM_SIMP_TAC[REAL_LT_REFL; GSYM REAL_LT_RDIV_EQ; GSYM REAL_LT_LDIV_EQ; + PI_POS; REAL_DIV_REFL; REAL_LT_IMP_NZ] THEN + MP_TAC(SPEC `n:real` FLOOR_FRAC) THEN ASM_CASES_TAC `frac n = &0` THEN + ASM_REWRITE_TAC[FLOOR; REAL_ADD_RID] THEN + ASM_REAL_ARITH_TAC);; + +let SIN_EQ_0 = prove + (`!x. sin(x) = &0 <=> ?n. integer n /\ x = n * pi`, + GEN_TAC THEN MP_TAC(SPEC `x / pi` SIN_PIMUL_EQ_0) THEN + SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; GSYM REAL_EQ_LDIV_EQ; PI_POS] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM1]);; + +let COS_EQ_0 = prove + (`!x. cos(x) = &0 <=> ?n. integer n /\ x = (n + &1 / &2) * pi`, + GEN_TAC THEN REWRITE_TAC[COS_SIN; SIN_EQ_0] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--n:real` THEN ASM_REWRITE_TAC[INTEGER_NEG] THEN + ASM_REAL_ARITH_TAC);; + +let SIN_ZERO_PI = prove + (`!x. sin(x) = &0 <=> (?n. x = &n * pi) \/ (?n. x = --(&n * pi))`, + REWRITE_TAC[SIN_EQ_0; INTEGER_CASES] THEN MESON_TAC[REAL_MUL_LNEG]);; + +let COS_ZERO_PI = prove + (`!x. cos(x) = &0 <=> + (?n. x = (&n + &1 / &2) * pi) \/ (?n. x = --((&n + &1 / &2) * pi))`, + GEN_TAC THEN REWRITE_TAC[COS_EQ_0; INTEGER_CASES; RIGHT_OR_DISTRIB] THEN + REWRITE_TAC[EXISTS_OR_THM; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN SIMP_TAC[UNWIND_THM2] THEN EQ_TAC THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `n:num` SUBST1_TAC)) THENL + [DISJ1_TAC THEN EXISTS_TAC `n:num`; + ASM_CASES_TAC `n = 0` THENL + [DISJ1_TAC THEN EXISTS_TAC `0`; + DISJ2_TAC THEN EXISTS_TAC `n - 1`]; + DISJ1_TAC THEN EXISTS_TAC `n:num`; + DISJ2_TAC THEN EXISTS_TAC `n + 1`] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB; GSYM REAL_OF_NUM_ADD; + ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + REAL_ARITH_TAC);; + +let SIN_ZERO = prove + (`!x. (sin(x) = &0) <=> (?n. EVEN n /\ x = &n * (pi / &2)) \/ + (?n. EVEN n /\ x = --(&n * (pi / &2)))`, + REWRITE_TAC[SIN_ZERO_PI; EVEN_EXISTS; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL; REAL_ARITH `(&2 * x) * y / &2 = x * y`]);; + +let COS_ZERO = prove + (`!x. cos(x) = &0 <=> (?n. ~EVEN n /\ (x = &n * (pi / &2))) \/ + (?n. ~EVEN n /\ (x = --(&n * (pi / &2))))`, + REWRITE_TAC[COS_ZERO_PI; NOT_EVEN; ODD_EXISTS; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_SUC; + REAL_ARITH `(&2 * x + &1) * y / &2 = (x + &1 / &2) * y`]);; + +let COS_ONE_2PI = prove + (`!x. (cos(x) = &1) <=> (?n. x = &n * &2 * pi) \/ (?n. x = --(&n * &2 * pi))`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `sin(x)` o MATCH_MP (REAL_RING + `c = &1 ==> !s. s pow 2 + c pow 2 = &1 ==> s = &0`)) THEN + REWRITE_TAC[SIN_ZERO_PI; SIN_CIRCLE] THEN + DISCH_THEN(DISJ_CASES_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC)) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[COS_NEG; COS_NPI; REAL_POW_NEG] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_POW_ONE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[EVEN_EXISTS]) THEN + REWRITE_TAC[OR_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[GSYM REAL_OF_NUM_MUL] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM (DISJ_CASES_THEN CHOOSE_TAC) THEN + ASM_REWRITE_TAC[COS_NEG; REAL_MUL_ASSOC; REAL_OF_NUM_MUL; COS_NPI; + REAL_POW_NEG; EVEN_MULT; ARITH; REAL_POW_ONE]]);; + +let SIN_COS_SQRT = prove + (`!x. &0 <= sin(x) ==> (sin(x) = sqrt(&1 - (cos(x) pow 2)))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE THEN + ASM_REWRITE_TAC[SIN_CIRCLE; REAL_EQ_SUB_LADD]);; + +let SIN_EQ_0_PI = prove + (`!x. --pi < x /\ x < pi /\ sin(x) = &0 ==> x = &0`, + GEN_TAC THEN REWRITE_TAC[SIN_EQ_0; CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC + (X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[REAL_ARITH + `--p < n * p /\ n * p < p <=> -- &1 * p < n * p /\ n * p < &1 * p`] THEN + SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ; REAL_LT_RMUL_EQ; PI_POS] THEN + MP_TAC(SPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let COS_TREBLE_COS = prove + (`!x. cos(&3 * x) = &4 * cos(x) pow 3 - &3 * cos x`, + GEN_TAC THEN REWRITE_TAC[COS_ADD; REAL_ARITH `&3 * x = &2 * x + x`] THEN + REWRITE_TAC[SIN_DOUBLE; COS_DOUBLE_COS] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +let COS_PI6 = prove + (`cos(pi / &6) = sqrt(&3) / &2`, + MP_TAC(ISPEC `pi / &6` COS_TREBLE_COS) THEN + REWRITE_TAC[REAL_ARITH `&3 * x / &6 = x / &2`; COS_PI2] THEN + REWRITE_TAC[REAL_RING `&0 = &4 * c pow 3 - &3 * c <=> + c = &0 \/ (&2 * c) pow 2 = &3`] THEN + SUBGOAL_THEN `&0 < cos(pi / &6)` ASSUME_TAC THENL + [MATCH_MP_TAC COS_POS_PI THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [ASM_MESON_TAC[REAL_LT_REFL]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o AP_TERM `sqrt`) THEN + ASM_SIMP_TAC[POW_2_SQRT; REAL_LE_MUL; REAL_LT_IMP_LE; REAL_POS] THEN + REAL_ARITH_TAC]);; + +let SIN_PI6 = prove + (`sin(pi / &6) = &1 / &2`, + MP_TAC(SPEC `pi / &6` SIN_CIRCLE) THEN REWRITE_TAC[COS_PI6] THEN + SIMP_TAC[REAL_POW_DIV; SQRT_POW_2; REAL_POS] THEN MATCH_MP_TAC(REAL_FIELD + `~(s + &1 / &2 = &0) ==> s pow 2 + &3 / &2 pow 2 = &1 ==> s = &1 / &2`) THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x + &1 / &2 = &0)`) THEN + MATCH_MP_TAC SIN_POS_PI THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let SIN_POS_PI_REV = prove + (`!x. &0 <= x /\ x <= &2 * pi /\ &0 < sin x ==> &0 < x /\ x < pi`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[SIN_0; REAL_LT_REFL] THEN + ASM_CASES_TAC `x = pi` THEN + ASM_REWRITE_TAC[SIN_PI; REAL_LT_REFL] THEN + ASM_CASES_TAC `x = &2 * pi` THEN + ASM_REWRITE_TAC[SIN_NPI; REAL_LT_REFL] THEN + REPEAT STRIP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_NOT_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < sin(&2 * pi - x)` MP_TAC THENL + [MATCH_MP_TAC SIN_POS_PI THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[SIN_SUB; SIN_NPI; COS_NPI] THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Prove totality of trigs. *) +(* ------------------------------------------------------------------------- *) + +let SIN_TOTAL_POS = prove + (`!y. &0 <= y /\ y <= &1 + ==> ?x. &0 <= x /\ x <= pi / &2 /\ sin(x) = y`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`csin`; `&0`; `pi / &2`; `y:real`] IVT_INCREASING_RE) THEN + ASM_REWRITE_TAC[GSYM CX_SIN; RE_CX; SIN_0; SIN_PI2] THEN + SIMP_TAC[CONTINUOUS_AT_CSIN; PI_POS; REAL_ARITH `&0 < x ==> &0 <= x / &2`]);; + +let SINCOS_TOTAL_PI2 = prove + (`!x y. &0 <= x /\ &0 <= y /\ x pow 2 + y pow 2 = &1 + ==> ?t. &0 <= t /\ t <= pi / &2 /\ x = cos t /\ y = sin t`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `y:real` SIN_TOTAL_POS) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `x pow 2 + y pow 2 = &1 + ==> (&1 < y ==> &1 pow 2 < y pow 2) /\ &0 <= x * x + ==> y <= &1`)) THEN + SIMP_TAC[REAL_LE_SQUARE; REAL_POW_LT2; REAL_POS; ARITH]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `t:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `x = cos t \/ x = --(cos t)` MP_TAC THENL + [MP_TAC(SPEC `t:real` SIN_CIRCLE); + MP_TAC(SPEC `t:real` COS_POS_PI_LE)] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; + +let SINCOS_TOTAL_PI = prove + (`!x y. &0 <= y /\ x pow 2 + y pow 2 = &1 + ==> ?t. &0 <= t /\ t <= pi /\ x = cos t /\ y = sin t`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= x \/ &0 <= --x`) THENL + [MP_TAC(SPECL [`x:real`; `y:real`] SINCOS_TOTAL_PI2); + MP_TAC(SPECL [`--x:real`; `y:real`] SINCOS_TOTAL_PI2)] THEN + ASM_REWRITE_TAC[REAL_POW_NEG; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `t:real`; EXISTS_TAC `pi - t`] THEN + ASM_REWRITE_TAC[SIN_SUB; COS_SUB; SIN_PI; COS_PI] THEN + ASM_REAL_ARITH_TAC);; + +let SINCOS_TOTAL_2PI = prove + (`!x y. x pow 2 + y pow 2 = &1 + ==> ?t. &0 <= t /\ t < &2 * pi /\ x = cos t /\ y = sin t`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &1 /\ y = &0` THENL + [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[SIN_0; COS_0] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISJ_CASES_TAC(REAL_ARITH `&0 <= y \/ &0 <= --y`) THENL + [MP_TAC(SPECL [`x:real`; `y:real`] SINCOS_TOTAL_PI); + MP_TAC(SPECL [`x:real`; `--y:real`] SINCOS_TOTAL_PI)] THEN + ASM_REWRITE_TAC[REAL_POW_NEG; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `t:real`; EXISTS_TAC `&2 * pi - t`] THEN + ASM_REWRITE_TAC[SIN_SUB; COS_SUB; SIN_NPI; COS_NPI] THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN ASM_CASES_TAC `t = &0` THEN + ASM_REWRITE_TAC[SIN_0; COS_0] THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let CIRCLE_SINCOS = prove + (`!x y. x pow 2 + y pow 2 = &1 ==> ?t. x = cos(t) /\ y = sin(t)`, + MESON_TAC[SINCOS_TOTAL_2PI]);; + +(* ------------------------------------------------------------------------- *) +(* Polar representation. *) +(* ------------------------------------------------------------------------- *) + +let CX_PI_NZ = prove + (`~(Cx pi = Cx(&0))`, + SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; PI_POS]);; + +let COMPLEX_UNIMODULAR_POLAR = prove + (`!z. (norm z = &1) ==> ?x. z = complex(cos(x),sin(x))`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o C AP_THM `2` o AP_TERM `(pow):real->num->real`) THEN + REWRITE_TAC[complex_norm] THEN + SIMP_TAC[REAL_POW_2; REWRITE_RULE[REAL_POW_2] SQRT_POW_2; + REAL_LE_SQUARE; REAL_LE_ADD] THEN + REWRITE_TAC[GSYM REAL_POW_2; REAL_MUL_LID] THEN + DISCH_THEN(X_CHOOSE_TAC `t:real` o MATCH_MP CIRCLE_SINCOS) THEN + EXISTS_TAC `t:real` THEN ASM_REWRITE_TAC[COMPLEX_EQ; RE; IM]);; + +let SIN_INTEGER_2PI = prove + (`!n. integer n ==> sin((&2 * pi) * n) = &0`, + REWRITE_TAC[SIN_EQ_0; REAL_ARITH `(&2 * pi) * n = (&2 * n) * pi`] THEN + MESON_TAC[INTEGER_CLOSED]);; + +let SIN_INTEGER_PI = prove + (`!n. integer n ==> sin (n * pi) = &0`, + REWRITE_TAC[INTEGER_CASES] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LNEG; SIN_NPI; SIN_NEG; REAL_NEG_0]);; + +let COS_INTEGER_2PI = prove + (`!n. integer n ==> cos((&2 * pi) * n) = &1`, + REWRITE_TAC[INTEGER_CASES; REAL_ARITH `(&2 * pi) * n = (&2 * n) * pi`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_OF_NUM_MUL] THEN + SIMP_TAC[COS_NEG; COS_NPI; REAL_POW_NEG; REAL_MUL_LNEG; + ARITH; EVEN_MULT; REAL_POW_ONE]);; + +let SINCOS_PRINCIPAL_VALUE = prove + (`!x. ?y. (--pi < y /\ y <= pi) /\ (sin(y) = sin(x) /\ cos(y) = cos(x))`, + GEN_TAC THEN EXISTS_TAC `pi - (&2 * pi) * frac((pi - x) / (&2 * pi))` THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_ARITH `--p < p - x <=> x < (&2 * p) * &1`; + REAL_ARITH `p - x <= p <=> (&2 * p) * &0 <= x`; + REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ; REAL_LT_MUL; + PI_POS; REAL_OF_NUM_LT; ARITH; FLOOR_FRAC]; + REWRITE_TAC[FRAC_FLOOR; REAL_SUB_LDISTRIB] THEN + SIMP_TAC[REAL_DIV_LMUL; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH; REAL_LT_IMP_NZ; + PI_POS; REAL_ARITH `a - (a - b - c):real = b + c`; SIN_ADD; COS_ADD] THEN + SIMP_TAC[FLOOR_FRAC; SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN + CONV_TAC REAL_RING]);; + +let CEXP_COMPLEX = prove + (`!r t. cexp(complex(r,t)) = Cx(exp r) * complex(cos t,sin t)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EXPAND] THEN + REWRITE_TAC[RE; IM; CEXP_ADD; CEXP_EULER; CX_EXP] THEN + REWRITE_TAC[COMPLEX_TRAD; CX_SIN; CX_COS]);; + +let NORM_COSSIN = prove + (`!t. norm(complex(cos t,sin t)) = &1`, + REWRITE_TAC[complex_norm; RE; IM] THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[SIN_CIRCLE; SQRT_1]);; + +let NORM_CEXP = prove + (`!z. norm(cexp z) = exp(Re z)`, + REWRITE_TAC[FORALL_COMPLEX; CEXP_COMPLEX; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[NORM_COSSIN; RE; COMPLEX_NORM_CX] THEN + MP_TAC REAL_EXP_POS_LT THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let NORM_CEXP_II = prove + (`!t. norm (cexp (ii * Cx t)) = &1`, + REWRITE_TAC [NORM_CEXP; RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0]);; + +let NORM_CEXP_IMAGINARY = prove + (`!z. norm(cexp z) = &1 ==> Re(z) = &0`, + REWRITE_TAC[NORM_CEXP; REAL_EXP_EQ_1]);; + +let CEXP_EQ_1 = prove + (`!z. cexp z = Cx(&1) <=> Re(z) = &0 /\ ?n. integer n /\ Im(z) = &2 * n * pi`, + REWRITE_TAC[FORALL_COMPLEX; CEXP_COMPLEX; RE; IM] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `norm:complex->real`) THEN + SIMP_TAC[COMPLEX_NORM_MUL; CX_EXP; NORM_CEXP; RE_CX; COMPLEX_NORM_CX] THEN + REWRITE_TAC[NORM_COSSIN; REAL_ABS_NUM; REAL_ABS_EXP; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_EXP_EQ_1] THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_EXP_0; COMPLEX_MUL_LID] THEN + REWRITE_TAC[COMPLEX_EQ; RE; IM; RE_CX; IM_CX] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SIN_EQ_0]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + EXISTS_TAC `m / &2` THEN CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + ONCE_REWRITE_TAC[GSYM INTEGER_ABS] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE LAND_CONV [GSYM COS_ABS]) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_DIV; REAL_ABS_NUM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [integer]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + SIMP_TAC[real_abs; PI_POS; REAL_LT_IMP_LE; COS_NPI] THEN + REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN + COND_CASES_TAC THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[EVEN_EXISTS]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_ARITH `(&2 * x) / &2 = x`] THEN + REWRITE_TAC[INTEGER_CLOSED]; + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC (X_CHOOSE_TAC `n:real`)) THEN + ASM_SIMP_TAC[REAL_EXP_0; COMPLEX_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 * x * y = (&2 * y) * x`] THEN + ASM_SIMP_TAC[SIN_INTEGER_2PI; COS_INTEGER_2PI] THEN + SIMPLE_COMPLEX_ARITH_TAC]);; + +let CEXP_EQ = prove + (`!w z. cexp w = cexp z <=> ?n. integer n /\ w = z + Cx(&2 * n * pi) * ii`, + SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(z = Cx(&0)) ==> (w = z <=> w / z = Cx(&1))`] THEN + REWRITE_TAC[GSYM CEXP_SUB; CEXP_EQ_1; RE_SUB; IM_SUB; REAL_SUB_0] THEN + SIMP_TAC[COMPLEX_EQ; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_NEG_0; REAL_ADD_RID; REAL_EQ_SUB_RADD] THEN + MESON_TAC[REAL_ADD_SYM]);; + +let COMPLEX_EQ_CEXP = prove + (`!w z. abs(Im w - Im z) < &2 * pi /\ cexp w = cexp z ==> w = z`, + SIMP_TAC[CEXP_NZ; GSYM CEXP_SUB; CEXP_EQ_1; COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> (a = b <=> a / b = Cx(&1))`] THEN + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `abs(Im w - Im z) < &2 * pi` THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[GSYM IM_SUB; REAL_ABS_MUL; REAL_ABS_PI; REAL_ABS_NUM] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_LT_RMUL_EQ; PI_POS] THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= x ==> ~(&2 * x < &2)`) THEN + MATCH_MP_TAC REAL_ABS_INTEGER_LEMMA THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `~(w:complex = z)` THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[GSYM COMPLEX_SUB_0] THEN + ASM_REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX; REAL_MUL_LZERO; REAL_MUL_RZERO]);; + +let CEXP_INTEGER_2PI = prove + (`!n. integer n ==> cexp(Cx(&2 * n * pi) * ii) = Cx(&1)`, + REWRITE_TAC[CEXP_EQ_1; IM_MUL_II; RE_MUL_II; RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_NEG_0] THEN MESON_TAC[]);; + +let SIN_COS_EQ = prove + (`!x y. sin y = sin x /\ cos y = cos x <=> + ?n. integer n /\ y = x + &2 * n * pi`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL [`ii * Cx y`; `ii * Cx x`] CEXP_EQ) THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[COMPLEX_RING `ii * y = ii * x + z * ii <=> y = x + z`] THEN + REWRITE_TAC[GSYM CX_ADD; CX_INJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[COMPLEX_EQ; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; + REAL_NEG_0; REAL_ADD_LID; REAL_ADD_RID] THEN + MESON_TAC[]);; + +let SIN_COS_INJ = prove + (`!x y. sin x = sin y /\ cos x = cos y /\ abs(x - y) < &2 * pi ==> x = y`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN + MATCH_MP_TAC(COMPLEX_RING `ii * x = ii * y ==> x = y`) THEN + MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + ASM_REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN + ASM_REWRITE_TAC[IM_MUL_II; RE_CX]);; + +let CEXP_II_NE_1 = prove + (`!x. &0 < x /\ x < &2 * pi ==> ~(cexp(ii * Cx x) = Cx(&1))`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[CEXP_EQ_1] THEN + REWRITE_TAC[RE_MUL_II; IM_CX; IM_MUL_II; IM_CX; REAL_NEG_0; RE_CX] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + UNDISCH_TAC `&0 < &2 * n * pi` THEN ASM_CASES_TAC `n = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL] THEN + MP_TAC(ISPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `&2 * n * pi < &2 * pi ==> &0 < (&1 - n) * &2 * pi`)) THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; PI_POS; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + ASM_REAL_ARITH_TAC);; + +let CSIN_EQ_0 = prove + (`!z. csin z = Cx(&0) <=> ?n. integer n /\ z = Cx(n * pi)`, + GEN_TAC THEN REWRITE_TAC[csin; COMPLEX_MUL_LNEG; CEXP_NEG] THEN + SIMP_TAC[CEXP_NZ; COMPLEX_FIELD `~(z = Cx(&0)) + ==> ((z - inv z) / (Cx(&2) * ii) = Cx(&0) <=> z pow 2 = Cx(&1))`] THEN + REWRITE_TAC[GSYM CEXP_N; CEXP_EQ_1] THEN + REWRITE_TAC[RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II] THEN + REWRITE_TAC[COMPLEX_EQ; IM_CX; RE_CX; RIGHT_AND_EXISTS_THM] THEN + EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN REAL_ARITH_TAC);; + +let CCOS_EQ_0 = prove + (`!z. ccos z = Cx(&0) <=> ?n. integer n /\ z = Cx((n + &1 / &2) * pi)`, + GEN_TAC THEN MP_TAC(SPEC `z - Cx(pi / &2)` CSIN_EQ_0) THEN + REWRITE_TAC[CSIN_SUB; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2] THEN + SIMP_TAC[COMPLEX_RING `s * Cx(&0) - c * Cx(&1) = Cx(&0) <=> c = Cx(&0)`] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; COMPLEX_EQ_SUB_RADD; CX_ADD] THEN + REWRITE_TAC[REAL_ARITH `&1 / &2 * x = x / &2`]);; + +let CCOS_EQ_1 = prove + (`!z. ccos z = Cx(&1) <=> ?n. integer n /\ z = Cx(&2 * n * pi)`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) + [COMPLEX_RING `z = Cx(&2) * z / Cx(&2)`] THEN + REWRITE_TAC[CCOS_DOUBLE_CSIN; COMPLEX_RING + `a - Cx(&2) * s pow 2 = a <=> s = Cx(&0)`] THEN + REWRITE_TAC[CSIN_EQ_0; CX_MUL] THEN + EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + CONV_TAC COMPLEX_RING);; + +let CSIN_EQ_1 = prove + (`!z. csin z = Cx(&1) <=> ?n. integer n /\ z = Cx((&2 * n + &1 / &2) * pi)`, + GEN_TAC THEN MP_TAC(SPEC `z - Cx(pi / &2)` CCOS_EQ_1) THEN + REWRITE_TAC[CCOS_SUB; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2] THEN + SIMP_TAC[COMPLEX_RING `s * Cx(&0) + c * Cx(&1) = Cx(&1) <=> c = Cx(&1)`] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; COMPLEX_EQ_SUB_RADD; CX_ADD] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_ARITH `&1 / &2 * x = x / &2`]);; + +let CSIN_EQ_MINUS1 = prove + (`!z. csin z = --Cx(&1) <=> + ?n. integer n /\ z = Cx((&2 * n + &3 / &2) * pi)`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `z:complex = --w <=> --z = w`] THEN + REWRITE_TAC[GSYM CSIN_NEG; CSIN_EQ_1] THEN + REWRITE_TAC[COMPLEX_RING `--z:complex = w <=> z = --w`] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[GSYM CX_NEG; CX_INJ] THEN + EXISTS_TAC `--(n + &1)` THEN + ASM_SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let CCOS_EQ_MINUS1 = prove + (`!z. ccos z = --Cx(&1) <=> + ?n. integer n /\ z = Cx((&2 * n + &1) * pi)`, + GEN_TAC THEN MP_TAC(SPEC `z - Cx(pi / &2)` CSIN_EQ_1) THEN + REWRITE_TAC[CSIN_SUB; GSYM CX_SIN; GSYM CX_COS; SIN_PI2; COS_PI2] THEN + SIMP_TAC[COMPLEX_RING + `s * Cx(&0) - c * Cx(&1) = Cx(&1) <=> c = --Cx(&1)`] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; COMPLEX_EQ_SUB_RADD; GSYM CX_ADD] THEN + DISCH_TAC THEN EQ_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[CX_INJ] THEN REAL_ARITH_TAC);; + +let COS_EQ_1 = prove + (`!x. cos x = &1 <=> ?n. integer n /\ x = &2 * n * pi`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CCOS_EQ_1]);; + +let SIN_EQ_1 = prove + (`!x. sin x = &1 <=> ?n. integer n /\ x = (&2 * n + &1 / &2) * pi`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CSIN_EQ_1]);; + +let SIN_EQ_MINUS1 = prove + (`!x. sin x = --(&1) <=> ?n. integer n /\ x = (&2 * n + &3 / &2) * pi`, + REWRITE_TAC[GSYM CX_INJ; CX_NEG; CX_SIN; CSIN_EQ_MINUS1]);; + +let COS_EQ_MINUS1 = prove + (`!x. cos x = --(&1) <=> + ?n. integer n /\ x = (&2 * n + &1) * pi`, + REWRITE_TAC[GSYM CX_INJ; CX_NEG; CX_COS; CCOS_EQ_MINUS1]);; + +let DIST_CEXP_II_1 = prove + (`!z. norm(cexp(ii * Cx t) - Cx(&1)) = &2 * abs(sin(t / &2))`, + GEN_TAC THEN REWRITE_TAC[NORM_EQ_SQUARE] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[GSYM NORM_POW_2]] THEN + REWRITE_TAC[CEXP_EULER; COMPLEX_SQNORM; GSYM CX_COS; GSYM CX_SIN] THEN + REWRITE_TAC[IM_ADD; RE_ADD; IM_SUB; RE_SUB; IM_MUL_II; RE_MUL_II] THEN + REWRITE_TAC[RE_CX; IM_CX; REAL_POW2_ABS; REAL_POW_MUL] THEN + MP_TAC(ISPEC `t / &2` COS_DOUBLE_SIN) THEN + REWRITE_TAC[REAL_ARITH `&2 * t / &2 = t`] THEN + MP_TAC(SPEC `t:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +let CX_SINH = prove + (`Cx((exp x - inv(exp x)) / &2) = --ii * csin(ii * Cx x)`, + REWRITE_TAC[csin; COMPLEX_RING `--ii * ii * z = z /\ ii * ii * z = --z`] THEN + REWRITE_TAC[CEXP_NEG; GSYM CX_EXP; GSYM CX_INV; CX_SUB; CX_DIV] THEN + CONV_TAC COMPLEX_FIELD);; + +let CX_COSH = prove + (`Cx((exp x + inv(exp x)) / &2) = ccos(ii * Cx x)`, + REWRITE_TAC[ccos; COMPLEX_RING `--ii * ii * z = z /\ ii * ii * z = --z`] THEN + REWRITE_TAC[CEXP_NEG; GSYM CX_EXP; GSYM CX_INV; CX_ADD; CX_DIV] THEN + CONV_TAC COMPLEX_FIELD);; + +let NORM_CCOS_POW_2 = prove + (`!z. norm(ccos z) pow 2 = + cos(Re z) pow 2 + (exp(Im z) - inv(exp(Im z))) pow 2 / &4`, + REWRITE_TAC[FORALL_COMPLEX; RE; IM] THEN + REWRITE_TAC[COMPLEX_TRAD; CCOS_ADD; COMPLEX_SQNORM] THEN + SIMP_TAC[RE_SUB; IM_SUB; GSYM CX_COS; GSYM CX_SIN; IM_MUL_CX; RE_MUL_CX] THEN + REWRITE_TAC[ccos; csin; CEXP_NEG; COMPLEX_FIELD + `--ii * ii * z = z /\ ii * ii * z = --z /\ + z / (Cx(&2) * ii) = --(ii * z / Cx(&2))`] THEN + REWRITE_TAC[RE_ADD; RE_SUB; IM_ADD; IM_SUB; RE_MUL_II; IM_MUL_II; + RE_DIV_CX; IM_DIV_CX; RE_NEG; IM_NEG] THEN + REWRITE_TAC[GSYM CX_EXP; GSYM CX_INV; IM_CX; RE_CX] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN MP_TAC(SPEC `y:real` REAL_EXP_NZ) THEN + CONV_TAC REAL_FIELD);; + +let NORM_CSIN_POW_2 = prove + (`!z. norm(csin z) pow 2 = + (exp(&2 * Im z) + inv(exp(&2 * Im z)) - &2 * cos(&2 * Re z)) / &4`, + REWRITE_TAC[FORALL_COMPLEX; RE; IM] THEN + REWRITE_TAC[COMPLEX_TRAD; CSIN_ADD; COMPLEX_SQNORM] THEN + SIMP_TAC[RE_ADD; IM_ADD; GSYM CX_SIN; GSYM CX_SIN; IM_MUL_CX; RE_MUL_CX; + GSYM CX_COS] THEN + REWRITE_TAC[ccos; csin; CEXP_NEG; COMPLEX_FIELD + `--ii * ii * z = z /\ ii * ii * z = --z /\ + z / (Cx(&2) * ii) = --(ii * z / Cx(&2))`] THEN + REWRITE_TAC[RE_ADD; RE_SUB; IM_ADD; IM_SUB; RE_MUL_II; IM_MUL_II; + RE_DIV_CX; IM_DIV_CX; RE_NEG; IM_NEG] THEN + REWRITE_TAC[GSYM CX_EXP; GSYM CX_INV; IM_CX; RE_CX] THEN + REWRITE_TAC[REAL_EXP_N; COS_DOUBLE] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN MP_TAC(SPEC `y:real` REAL_EXP_NZ) THEN + CONV_TAC REAL_FIELD);; + +let CSIN_EQ = prove + (`!w z. csin w = csin z <=> + ?n. integer n /\ + (w = z + Cx(&2 * n * pi) \/ w = --z + Cx((&2 * n + &1) * pi))`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_0] THEN + REWRITE_TAC[COMPLEX_SUB_CSIN; COMPLEX_ENTIRE; CSIN_EQ_0; CCOS_EQ_0] THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; OR_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:real` THEN + ASM_CASES_TAC `integer(n)` THEN + ASM_REWRITE_TAC[COMPLEX_FIELD `a / Cx(&2) = b <=> a = Cx(&2) * b`] THEN + REWRITE_TAC[GSYM CX_MUL; REAL_ARITH + `&2 * (n + &1 / &2) * pi = (&2 * n + &1) * pi`] THEN + CONV_TAC COMPLEX_RING);; + +let CCOS_EQ = prove + (`!w z. ccos(w) = ccos(z) <=> + ?n. integer n /\ + (w = z + Cx(&2 * n * pi) \/ w = --z + Cx(&2 * n * pi))`, + REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV SYM_CONV) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_SUB_0] THEN + REWRITE_TAC[COMPLEX_SUB_CCOS; COMPLEX_ENTIRE; CSIN_EQ_0] THEN + REWRITE_TAC[CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; OR_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:real` THEN + ASM_CASES_TAC `integer(n)` THEN ASM_REWRITE_TAC[CX_MUL] THEN + CONV_TAC COMPLEX_RING);; + +let SIN_EQ = prove + (`!x y. sin x = sin y <=> + ?n. integer n /\ + (x = y + &2 * n * pi \/ x = --y + (&2 * n + &1) * pi)`, + REWRITE_TAC[GSYM CX_INJ; CX_SIN; CSIN_EQ] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG; CX_INJ]);; + +let COS_EQ = prove + (`!x y. cos x = cos y <=> + ?n. integer n /\ + (x = y + &2 * n * pi \/ x = --y + &2 * n * pi)`, + REWRITE_TAC[GSYM CX_INJ; CX_COS; CCOS_EQ] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_NEG; CX_INJ]);; + +let NORM_CCOS_LE = prove + (`!z. norm(ccos z) <= exp(norm z)`, + GEN_TAC THEN REWRITE_TAC[ccos] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(a) + norm(b) <= d ==> norm(a + b) <= d`) THEN + REWRITE_TAC[NORM_CEXP; COMPLEX_MUL_LNEG; RE_NEG; REAL_EXP_NEG] THEN + REWRITE_TAC[COMPLEX_NORM_CX; RE_MUL_II; REAL_ABS_NUM] THEN + MATCH_MP_TAC(REAL_ARITH + `exp(&0) = &1 /\ (exp(&0) <= w \/ exp(&0) <= z) /\ (w <= u /\ z <= u) + ==> w + z <= &2 * u`) THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[REAL_EXP_0] THEN + MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REAL_ARITH_TAC);; + +let NORM_CCOS_PLUS1_LE = prove + (`!z. norm(Cx(&1) + ccos z) <= &2 * exp(norm z)`, + GEN_TAC THEN REWRITE_TAC[ccos] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM; COMPLEX_RING + `Cx(&1) + (z + z') / Cx(&2) = (Cx(&2) + z + z') / Cx(&2)`] THEN + REWRITE_TAC[REAL_ARITH `x / &2 <= &2 * y <=> x <= &4 * y`] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(a) + norm(b) + norm(c) <= d ==> norm(a + b + c) <= d`) THEN + REWRITE_TAC[NORM_CEXP; COMPLEX_MUL_LNEG; RE_NEG; REAL_EXP_NEG] THEN + REWRITE_TAC[COMPLEX_NORM_CX; RE_MUL_II; REAL_ABS_NUM] THEN + MATCH_MP_TAC(REAL_ARITH + `exp(&0) = &1 /\ (exp(&0) <= w \/ exp(&0) <= z) /\ (w <= u /\ z <= u) + ==> &2 + w + z <= &4 * u`) THEN + REWRITE_TAC[GSYM REAL_EXP_NEG; REAL_EXP_MONO_LE] THEN + REWRITE_TAC[REAL_EXP_0] THEN + MP_TAC(SPEC `z:complex` COMPLEX_NORM_GE_RE_IM) THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Taylor series for complex exponential. *) +(* ------------------------------------------------------------------------- *) + +let TAYLOR_CEXP = prove + (`!n z. norm(cexp z - vsum(0..n) (\k. z pow k / Cx(&(FACT k)))) + <= exp(abs(Re z)) * (norm z) pow (n + 1) / &(FACT n)`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`\k:num. cexp`; `n:num`; `segment[Cx(&0),z]`; `exp(abs(Re z))`] + COMPLEX_TAYLOR) THEN + REWRITE_TAC[CONVEX_SEGMENT; NORM_CEXP; REAL_EXP_MONO_LE] THEN ANTS_TAC THENL + [REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL + [GEN_REWRITE_TAC(RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]; + ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0; VECTOR_MUL_RZERO] THEN + REWRITE_TAC[VECTOR_ADD_LID; COMPLEX_CMUL; COMPLEX_NORM_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= a ==> x <= a`) THEN + REWRITE_TAC[RE_MUL_CX; REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `z:complex`]) THEN + SIMP_TAC[ENDS_IN_SEGMENT; COMPLEX_SUB_RZERO; CEXP_0; COMPLEX_MUL_LID]]);; + +(* ------------------------------------------------------------------------- *) +(* Approximation to e. *) +(* ------------------------------------------------------------------------- *) + +let E_APPROX_32 = prove + (`abs(exp(&1) - &5837465777 / &2147483648) <= inv(&2 pow 32)`, + MP_TAC(ISPECL [`14`; `Cx(&1)`] TAYLOR_CEXP) THEN + SIMP_TAC[RE_CX; REAL_ABS_NUM; GSYM CX_EXP; GSYM CX_DIV; GSYM CX_SUB; + COMPLEX_POW_ONE; COMPLEX_NORM_CX] THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_VSUM_CONV) THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Taylor series for complex sine and cosine. *) +(* ------------------------------------------------------------------------- *) + +let TAYLOR_CSIN_RAW = prove + (`!n z. norm(csin z - + vsum(0..n) (\k. if ODD k + then --ii * (ii * z) pow k / Cx(&(FACT k)) + else Cx(&0))) + <= exp(abs(Im z)) * (norm z) pow (n + 1) / &(FACT n)`, + MP_TAC TAYLOR_CEXP THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[csin] THEN + REWRITE_TAC[COMPLEX_FIELD + `a / (Cx(&2) * ii) - b = (a - Cx(&2) * ii * b) / (Cx(&2) * ii)`] THEN + FIRST_ASSUM(fun th -> + MP_TAC(SPEC `ii * z` th) THEN MP_TAC(SPEC `--ii * z` th)) THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; RE_NEG; REAL_ABS_NEG; RE_MUL_II] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; NORM_NEG; + COMPLEX_NORM_II; REAL_ABS_NUM; REAL_MUL_RID; REAL_MUL_LID; + REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN + MATCH_MP_TAC(NORM_ARITH + `sp - sn = s2 + ==> norm(en - sn) <= d + ==> norm(ep - sp) <= d ==> norm(ep - en - s2) <= &2 * d`) THEN + SIMP_TAC[GSYM VSUM_SUB; GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_POW_NEG; GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN k` THEN + ASM_REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[COMPLEX_RING `Cx(&2) * ii * --(ii * z) = Cx(&2) * z`] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let TAYLOR_CSIN = prove + (`!n z. norm(csin z - + vsum(0..n) (\k. --Cx(&1) pow k * + z pow (2 * k + 1) / Cx(&(FACT(2 * k + 1))))) + <= exp(abs(Im z)) * norm(z) pow (2 * n + 3) / &(FACT(2 * n + 2))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`SUC(2 * n + 1)`; `z:complex`] TAYLOR_CSIN_RAW) THEN + SIMP_TAC[VSUM_CLAUSES_NUMSEG; VSUM_PAIR_0; ODD_ADD; ODD_MULT; ARITH_ODD; + LE_0; ODD; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN + SIMP_TAC[ARITH_RULE `SUC(2 * n + 1) = 2 * n + 2`; GSYM ADD_ASSOC; ARITH] THEN + MATCH_MP_TAC(NORM_ARITH + `s = t ==> norm(x - s) <= e ==> norm(x - t) <= e`) THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_POW_MUL; complex_div; COMPLEX_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_POW_ADD; GSYM COMPLEX_POW_POW] THEN + REWRITE_TAC[COMPLEX_POW_II_2] THEN CONV_TAC COMPLEX_RING);; + +let CSIN_CONVERGES = prove + (`!z. ((\n. --Cx(&1) pow n * z pow (2 * n + 1) / Cx(&(FACT(2 * n + 1)))) + sums csin(z)) (from 0)`, + GEN_TAC THEN REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN + ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC + `\n. exp(abs(Im z)) * norm z pow (2 * n + 3) / &(FACT(2 * n + 2))` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[TAYLOR_CSIN] THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN + REWRITE_TAC[ARITH_RULE `2 * n + 3 = SUC(2 * n + 2)`; real_div] THEN + REWRITE_TAC[LIFT_CMUL; real_pow] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC LIM_NULL_CMUL THEN + MP_TAC(MATCH_MP SERIES_TERMS_TOZERO (SPEC `z:complex` CEXP_CONVERGES)) THEN + GEN_REWRITE_TAC LAND_CONV [LIM_NULL_NORM] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NUM; GSYM LIFT_CMUL; GSYM real_div] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +let TAYLOR_CCOS_RAW = prove + (`!n z. norm(ccos z - + vsum(0..n) (\k. if EVEN k + then (ii * z) pow k / Cx(&(FACT k)) + else Cx(&0))) + <= exp(abs(Im z)) * (norm z) pow (n + 1) / &(FACT n)`, + MP_TAC TAYLOR_CEXP THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN X_GEN_TAC `z:complex` THEN REWRITE_TAC[ccos] THEN + REWRITE_TAC[COMPLEX_FIELD + `a / Cx(&2) - b = (a - Cx(&2) * b) / Cx(&2)`] THEN + FIRST_ASSUM(fun th -> + MP_TAC(SPEC `ii * z` th) THEN MP_TAC(SPEC `--ii * z` th)) THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; RE_NEG; REAL_ABS_NEG; RE_MUL_II] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; NORM_NEG; + COMPLEX_NORM_II; REAL_ABS_NUM; REAL_MUL_RID; REAL_MUL_LID; + REAL_ARITH `x / &2 <= y <=> x <= &2 * y`] THEN + MATCH_MP_TAC(NORM_ARITH + `sp + sn = s2 + ==> norm(en - sn) <= d + ==> norm(ep - sp) <= d ==> norm((ep + en) - s2) <= &2 * d`) THEN + SIMP_TAC[GSYM VSUM_ADD; GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_POW_NEG; GSYM NOT_EVEN] THEN ASM_CASES_TAC `EVEN k` THEN + ASM_REWRITE_TAC[COMPLEX_ADD_RINV; COMPLEX_MUL_RZERO] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let TAYLOR_CCOS = prove + (`!n z. norm(ccos z - + vsum(0..n) (\k. --Cx(&1) pow k * + z pow (2 * k) / Cx(&(FACT(2 * k))))) + <= exp(abs(Im z)) * norm(z) pow (2 * n + 2) / &(FACT(2 * n + 1))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`2 * n + 1`; `z:complex`] TAYLOR_CCOS_RAW) THEN + SIMP_TAC[VSUM_PAIR_0; EVEN_ADD; EVEN_MULT; ARITH_EVEN; + LE_0; EVEN; COMPLEX_ADD_LID; COMPLEX_ADD_RID] THEN + SIMP_TAC[ARITH_RULE `(2 * n + 1) + 1 = 2 * n + 2`] THEN + MATCH_MP_TAC(NORM_ARITH + `s = t ==> norm(x - s) <= e ==> norm(x - t) <= e`) THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_POW_MUL; complex_div; COMPLEX_MUL_ASSOC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM COMPLEX_POW_POW; COMPLEX_POW_II_2]);; + +let CCOS_CONVERGES = prove + (`!z. ((\n. --Cx(&1) pow n * z pow (2 * n) / Cx(&(FACT(2 * n)))) + sums ccos(z)) (from 0)`, + GEN_TAC THEN REWRITE_TAC[sums; FROM_0; INTER_UNIV] THEN + ONCE_REWRITE_TAC[LIM_NULL] THEN MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC + `\n. exp(abs(Im z)) * norm z pow (2 * n + 2) / &(FACT(2 * n + 1))` THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN REWRITE_TAC[TAYLOR_CCOS] THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC LIM_NULL_CMUL THEN + REWRITE_TAC[ARITH_RULE `2 * n + 2 = SUC(2 * n + 1)`; real_div] THEN + REWRITE_TAC[LIFT_CMUL; real_pow] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC LIM_NULL_CMUL THEN + MP_TAC(MATCH_MP SERIES_TERMS_TOZERO (SPEC `z:complex` CEXP_CONVERGES)) THEN + GEN_REWRITE_TAC LAND_CONV [LIM_NULL_NORM] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NUM; GSYM LIFT_CMUL; GSYM real_div] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The argument of a complex number, where 0 <= arg(z) < 2 pi *) +(* ------------------------------------------------------------------------- *) + +let Arg_DEF = new_definition + `Arg z = if z = Cx(&0) then &0 + else @t. &0 <= t /\ t < &2 * pi /\ + z = Cx(norm(z)) * cexp(ii * Cx t)`;; + +let ARG_0 = prove + (`Arg(Cx(&0)) = &0`, + REWRITE_TAC[Arg_DEF]);; + +let ARG = prove + (`!z. &0 <= Arg(z) /\ Arg(z) < &2 * pi /\ + z = Cx(norm z) * cexp(ii * Cx(Arg z))`, + GEN_TAC THEN REWRITE_TAC[Arg_DEF] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_NORM_0; COMPLEX_MUL_LZERO] THEN + SIMP_TAC[REAL_LE_REFL; REAL_LT_MUL; PI_POS; REAL_ARITH `&0 < &2`] THEN + CONV_TAC SELECT_CONV THEN + MP_TAC(SPECL [`Re(z) / norm z`; `Im(z) / norm z`] + SINCOS_TOTAL_2PI) THEN + ASM_SIMP_TAC[COMPLEX_SQNORM; COMPLEX_NORM_ZERO; REAL_FIELD + `~(z = &0) /\ x pow 2 + y pow 2 = z pow 2 + ==> (x / z) pow 2 + (y / z) pow 2 = &1`] THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_SIMP_TAC[COMPLEX_NORM_ZERO; REAL_FIELD + `~(z = &0) ==> (x / z = y <=> x = z * y)`] THEN + REWRITE_TAC[COMPLEX_EQ; RE_MUL_CX; IM_MUL_CX; CEXP_EULER; RE_ADD; IM_ADD; + RE_MUL_II; IM_MUL_II; GSYM CX_SIN; GSYM CX_COS; RE_CX; IM_CX] THEN + REAL_ARITH_TAC);; + +let COMPLEX_NORM_EQ_1_CEXP = prove + (`!z. norm z = &1 <=> (?t. z = cexp(ii * Cx t))`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC [NORM_CEXP; RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0] THEN + MP_TAC (SPEC `z:complex` ARG) THEN ASM_REWRITE_TAC [COMPLEX_MUL_LID] THEN + MESON_TAC[]);; + +let ARG_UNIQUE = prove + (`!a r z. &0 < r /\ Cx r * cexp(ii * Cx a) = z /\ &0 <= a /\ a < &2 * pi + ==> Arg z = a`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM CX_INJ] THEN + MATCH_MP_TAC(COMPLEX_RING `ii * x = ii * y ==> x = y`) THEN + MATCH_MP_TAC COMPLEX_EQ_CEXP THEN CONJ_TAC THENL + [REWRITE_TAC[IM_MUL_II; RE_CX] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < p /\ &0 <= y /\ y < p + ==> abs(x - y) < p`) THEN + ASM_SIMP_TAC[ARG]; + MATCH_MP_TAC(COMPLEX_RING + `!a b. Cx a = Cx b /\ ~(Cx b = Cx(&0)) /\ + Cx a * w = Cx b * z ==> w = z`) THEN + MAP_EVERY EXISTS_TAC [`norm(z:complex)`; `r:real`] THEN + ASM_REWRITE_TAC[GSYM ARG] THEN ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ] THEN + EXPAND_TAC "z" THEN + REWRITE_TAC[NORM_CEXP_II; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_REAL_ARITH_TAC]);; + +let ARG_MUL_CX = prove + (`!r z. &0 < r ==> Arg(Cx r * z) = Arg(z)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO] THEN + MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `r * norm(z:complex)` THEN + ASM_REWRITE_TAC[CX_MUL; GSYM COMPLEX_MUL_ASSOC; GSYM ARG] THEN + ASM_SIMP_TAC[REAL_LT_MUL; COMPLEX_NORM_NZ]);; + +let ARG_DIV_CX = prove + (`!r z. &0 < r ==> Arg(z / Cx r) = Arg(z)`, + REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] complex_div] THEN + SIMP_TAC[GSYM CX_INV; ARG_MUL_CX; REAL_LT_INV_EQ]);; + +let ARG_LT_NZ = prove + (`!z. &0 < Arg z <=> ~(Arg z = &0)`, + MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let ARG_LE_PI = prove + (`!z. Arg z <= pi <=> &0 <= Im z`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[Arg_DEF; IM_CX; REAL_LE_REFL; PI_POS_LE]; ALL_TAC] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN + ASM_SIMP_TAC[IM_MUL_CX; CEXP_EULER; REAL_LE_MUL_EQ; COMPLEX_NORM_NZ] THEN + REWRITE_TAC[IM_ADD; GSYM CX_SIN; GSYM CX_COS; IM_CX; IM_MUL_II; RE_CX] THEN + REWRITE_TAC[REAL_ADD_LID] THEN EQ_TAC THEN SIMP_TAC[ARG; SIN_POS_PI_LE] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < sin(&2 * pi - Arg z)` MP_TAC THENL + [MATCH_MP_TAC SIN_POS_PI THEN MP_TAC(SPEC `z:complex` ARG) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SIN_SUB; SIN_NPI; COS_NPI] THEN REAL_ARITH_TAC]);; + +let ARG_LT_PI = prove + (`!z. &0 < Arg z /\ Arg z < pi <=> &0 < Im z`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[Arg_DEF; IM_CX; REAL_LT_REFL; PI_POS_LE]; ALL_TAC] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [ARG] THEN + ASM_SIMP_TAC[IM_MUL_CX; CEXP_EULER; REAL_LT_MUL_EQ; COMPLEX_NORM_NZ] THEN + REWRITE_TAC[IM_ADD; GSYM CX_SIN; GSYM CX_COS; IM_CX; IM_MUL_II; RE_CX] THEN + REWRITE_TAC[REAL_ADD_LID] THEN EQ_TAC THEN SIMP_TAC[SIN_POS_PI] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ASM_CASES_TAC `Arg z = &0` THEN + ASM_REWRITE_TAC[SIN_0; REAL_LT_REFL] THEN + ASM_SIMP_TAC[ARG; REAL_ARITH `~(x = &0) ==> (&0 < x <=> &0 <= x)`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 <= sin(&2 * pi - Arg z)` MP_TAC THENL + [MATCH_MP_TAC SIN_POS_PI_LE THEN MP_TAC(SPEC `z:complex` ARG) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SIN_SUB; SIN_NPI; COS_NPI] THEN REAL_ARITH_TAC]);; + +let ARG_EQ_0 = prove + (`!z. Arg z = &0 <=> real z /\ &0 <= Re z`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[REAL_CX; RE_CX; Arg_DEF; REAL_LE_REFL]; ALL_TAC] THEN + CONV_TAC(RAND_CONV(SUBS_CONV[last(CONJUNCTS(SPEC `z:complex` ARG))])) THEN + ASM_SIMP_TAC[RE_MUL_CX; REAL_MUL_CX; REAL_LE_MUL_EQ; COMPLEX_NORM_NZ] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_ZERO; CEXP_EULER] THEN + REWRITE_TAC[real; RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; + GSYM CX_SIN; GSYM CX_COS; RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_ADD_RID; REAL_ADD_LID; REAL_NEG_0] THEN + EQ_TAC THEN SIMP_TAC[SIN_0; COS_0; REAL_POS] THEN + ASM_CASES_TAC `Arg z = pi` THENL + [ASM_REWRITE_TAC[COS_PI] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `z:complex` ARG) THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP + (REAL_ARITH `&0 <= x /\ x < &2 * pi + ==> --pi < x /\ x < pi \/ --pi < x - pi /\ x - pi < pi`)) THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SIN_EQ_0_PI] THEN + UNDISCH_TAC `~(Arg z = pi)` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `x = pi <=> x - pi = &0`] THEN + MATCH_MP_TAC SIN_EQ_0_PI THEN ASM_REWRITE_TAC[SIN_SUB; SIN_PI] THEN + REAL_ARITH_TAC);; + +let ARG_NUM = prove + (`!n. Arg(Cx(&n)) = &0`, + REWRITE_TAC[ARG_EQ_0; REAL_CX; RE_CX; REAL_POS]);; + +let ARG_EQ_PI = prove + (`!z. Arg z = pi <=> real z /\ Re z < &0`, + SIMP_TAC[ARG; PI_POS; REAL_ARITH + `&0 < pi /\ &0 <= z + ==> (z = pi <=> z <= pi /\ ~(z = &0) /\ ~(&0 < z /\ z < pi))`] THEN + REWRITE_TAC[ARG_EQ_0; ARG; ARG_LT_PI; ARG_LE_PI; real] THEN + REAL_ARITH_TAC);; + +let ARG_EQ_0_PI = prove + (`!z. Arg z = &0 \/ Arg z = pi <=> real z`, + REWRITE_TAC[ARG_EQ_0; ARG_EQ_PI; real] THEN REAL_ARITH_TAC);; + +let ARG_INV = prove + (`!z. ~(real z /\ &0 <= Re z) ==> Arg(inv z) = &2 * pi - Arg z`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[REAL_CX; RE_CX; REAL_LE_REFL] THEN + REWRITE_TAC[real] THEN STRIP_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN + EXISTS_TAC `inv(norm(z:complex))` THEN + ASM_SIMP_TAC[COMPLEX_NORM_NZ; REAL_LT_INV_EQ] THEN + REWRITE_TAC[CX_SUB; CX_MUL; COMPLEX_SUB_LDISTRIB; CEXP_SUB] THEN + SUBST1_TAC(SPEC `Cx(&2) * Cx pi` CEXP_EULER) THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[SIN_NPI; COS_NPI; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[complex_div; COMPLEX_MUL_LID; CX_INV; GSYM COMPLEX_INV_MUL] THEN + REWRITE_TAC[GSYM ARG] THEN + MP_TAC(SPEC `z:complex` ARG_EQ_0) THEN ASM_REWRITE_TAC[real] THEN + MP_TAC(SPEC `z:complex` ARG) THEN REAL_ARITH_TAC);; + +let ARG_EQ = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> (Arg w = Arg z <=> ?x. &0 < x /\ w = Cx(x) * z)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; STRIP_TAC THEN ASM_SIMP_TAC[ARG_MUL_CX]] THEN + DISCH_TAC THEN + MAP_EVERY (MP_TAC o CONJUNCT2 o CONJUNCT2 o C SPEC ARG) + [`z:complex`; `w:complex`] THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> CONV_TAC(SUBS_CONV(CONJUNCTS th))) THEN + EXISTS_TAC `norm(w:complex) / norm(z:complex)` THEN + ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_NORM_NZ; CX_DIV] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[COMPLEX_DIV_RMUL; COMPLEX_NORM_ZERO; CX_INJ]);; + +let ARG_INV_EQ_0 = prove + (`!z. Arg(inv z) = &0 <=> Arg z = &0`, + GEN_TAC THEN REWRITE_TAC[ARG_EQ_0; REAL_INV_EQ] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> c)) ==> (a /\ b <=> a /\ c)`) THEN + REWRITE_TAC[real] THEN DISCH_TAC THEN ASM_REWRITE_TAC[complex_inv; RE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_RID] THEN + ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> x * inv(x pow 2) = inv x`] THEN + REWRITE_TAC[REAL_LE_INV_EQ]);; + +let ARG_LE_DIV_SUM = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) /\ Arg(w) <= Arg(z) + ==> Arg(z) = Arg(w) + Arg(z / w)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a:real = b + c <=> c = a - b`] THEN + MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `norm(z / w)`THEN + ASM_SIMP_TAC[ARG; REAL_ARITH + `&0 <= a /\ a < &2 * pi /\ &0 <= b /\ b <= a ==> a - b < &2 * pi`] THEN + ASM_REWRITE_TAC[REAL_SUB_LE] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; CX_DIV] THEN + ASM_SIMP_TAC[REAL_LT_DIV; COMPLEX_NORM_NZ] THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB; CEXP_SUB; CX_SUB] THEN + REWRITE_TAC[complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `(a * b) * (c * d):complex = (a * c) * (b * d)`] THEN + REWRITE_TAC[GSYM COMPLEX_INV_MUL] THEN ASM_SIMP_TAC[GSYM ARG]);; + +let ARG_LE_DIV_SUM_EQ = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> (Arg(w) <= Arg(z) <=> Arg(z) = Arg(w) + Arg(z / w))`, + MESON_TAC[ARG_LE_DIV_SUM; REAL_LE_ADDR; ARG]);; + +let REAL_SUB_ARG = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> Arg w - Arg z = if Arg(z) <= Arg(w) then Arg(w / z) + else Arg(w / z) - &2 * pi`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [MP_TAC(ISPECL [`z:complex`; `w:complex`] ARG_LE_DIV_SUM) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MP_TAC(ISPECL [`w:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[REAL_ARITH `a - (a + b):real = --b`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM COMPLEX_INV_DIV] THEN + MATCH_MP_TAC(REAL_ARITH `x = &2 * pi - y ==> --x = y - &2 * pi`) THEN + MATCH_MP_TAC ARG_INV THEN REWRITE_TAC[GSYM ARG_EQ_0] THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_INV_DIV] THEN + REWRITE_TAC[ARG_INV_EQ_0] THEN + MP_TAC(ISPECL [`w:complex`; `z:complex`] ARG_LE_DIV_SUM) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +let REAL_ADD_ARG = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> Arg(w) + Arg(z) = + if Arg w + Arg z < &2 * pi + then Arg(w * z) + else Arg(w * z) + &2 * pi`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`w * z:complex`; `z:complex`] REAL_SUB_ARG) THEN + MP_TAC(SPECL [`z:complex`; `w * z:complex`] ARG_LE_DIV_SUM_EQ) THEN + ASM_SIMP_TAC[COMPLEX_ENTIRE; COMPLEX_FIELD + `~(z = Cx(&0)) ==> (w * z) / z = w`] THEN + ASM_CASES_TAC `Arg (w * z) = Arg z + Arg w` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[ARG; REAL_ADD_SYM]; + SIMP_TAC[REAL_ARITH `wz - z = w - &2 * pi <=> w + z = wz + &2 * pi`] THEN + REWRITE_TAC[REAL_ARITH `w + p < p <=> ~(&0 <= w)`; ARG]]);; + +let ARG_MUL = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> Arg(w * z) = if Arg w + Arg z < &2 * pi + then Arg w + Arg z + else (Arg w + Arg z) - &2 * pi`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_ADD_ARG) THEN + REAL_ARITH_TAC);; + +let ARG_CNJ = prove + (`!z. Arg(cnj z) = if real z /\ &0 <= Re z then Arg z else &2 * pi - Arg z`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[CNJ_CX; ARG_0; REAL_CX; RE_CX; REAL_LE_REFL] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_IMP_CNJ] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Arg(inv z)` THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_INV_CNJ] THEN + ASM_SIMP_TAC[GSYM CX_POW; ARG_DIV_CX; REAL_POW_LT; COMPLEX_NORM_NZ]; + ASM_SIMP_TAC[ARG_INV]]);; + +let ARG_REAL = prove + (`!z. real z ==> Arg z = if &0 <= Re z then &0 else pi`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[ARG_EQ_PI; ARG_EQ_0] THEN ASM_REAL_ARITH_TAC);; + +let ARG_CEXP = prove + (`!z. &0 <= Im z /\ Im z < &2 * pi ==> Arg(cexp(z)) = Im z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN + EXISTS_TAC `exp(Re z)` THEN + ASM_REWRITE_TAC[CX_EXP; GSYM CEXP_ADD; REAL_EXP_POS_LT] THEN + REWRITE_TAC[GSYM COMPLEX_EXPAND]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of 2-D rotations, and their interpretation using cexp. *) +(* ------------------------------------------------------------------------- *) + +let rotate2d = new_definition + `(rotate2d:real->real^2->real^2) t x = + vector[x$1 * cos(t) - x$2 * sin(t); + x$1 * sin(t) + x$2 * cos(t)]`;; + +let LINEAR_ROTATE2D = prove + (`!t. linear(rotate2d t)`, + SIMP_TAC[linear; CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; rotate2d] THEN + REAL_ARITH_TAC);; + +let ROTATE2D_ADD_VECTORS = prove + (`!t w z. rotate2d t (w + z) = rotate2d t w + rotate2d t z`, + SIMP_TAC[LINEAR_ADD; LINEAR_ROTATE2D]);; + +let ROTATE2D_SUB = prove + (`!t w z. rotate2d t (w - z) = rotate2d t w - rotate2d t z`, + SIMP_TAC[LINEAR_SUB; LINEAR_ROTATE2D]);; + +let NORM_ROTATE2D = prove + (`!t z. norm(rotate2d t z) = norm z`, + REWRITE_TAC[NORM_EQ; rotate2d; DIMINDEX_2; DOT_2; VECTOR_2] THEN + REPEAT GEN_TAC THEN MP_TAC(ISPEC `t:real` SIN_CIRCLE) THEN + CONV_TAC REAL_RING);; + +let ROTATE2D_0 = prove + (`!t. rotate2d t (Cx(&0)) = Cx(&0)`, + REWRITE_TAC[GSYM COMPLEX_NORM_ZERO; NORM_ROTATE2D; COMPLEX_NORM_0]);; + +let ROTATE2D_EQ_0 = prove + (`!t z. rotate2d t z = Cx(&0) <=> z = Cx(&0)`, + REWRITE_TAC[GSYM COMPLEX_NORM_ZERO; NORM_ROTATE2D]);; + +let ROTATE2D_ZERO = prove + (`!z. rotate2d (&0) z = z`, + REWRITE_TAC[rotate2d; SIN_0; COS_0] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN + REAL_ARITH_TAC);; + +let ORTHOGONAL_TRANSFORMATION_ROTATE2D = prove + (`!t. orthogonal_transformation(rotate2d t)`, + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; LINEAR_ROTATE2D; NORM_ROTATE2D]);; + +let ROTATE2D_POLAR = prove + (`!r t s. rotate2d t (vector[r * cos(s); r * sin(s)]) = + vector[r * cos(t + s); r * sin(t + s)]`, + SIMP_TAC[rotate2d; DIMINDEX_2; VECTOR_2; CART_EQ; FORALL_2] THEN + REWRITE_TAC[SIN_ADD; COS_ADD] THEN REAL_ARITH_TAC);; + +let MATRIX_ROTATE2D = prove + (`!t. matrix(rotate2d t) = vector[vector[cos t;--(sin t)]; + vector[sin t; cos t]]`, + SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_ROTATE2D] THEN + SIMP_TAC[matrix_vector_mul; rotate2d; CART_EQ; DIMINDEX_2; FORALL_2; + LAMBDA_BETA; VECTOR_2; ARITH; SUM_2] THEN + REAL_ARITH_TAC);; + +let DET_MATRIX_ROTATE2D = prove + (`!t. det(matrix(rotate2d t)) = &1`, + GEN_TAC THEN REWRITE_TAC[MATRIX_ROTATE2D; DET_2; VECTOR_2] THEN + MP_TAC(SPEC `t:real` SIN_CIRCLE) THEN REAL_ARITH_TAC);; + +let ROTATION_ROTATE2D = prove + (`!f. orthogonal_transformation f /\ det(matrix f) = &1 + ==> ?t. &0 <= t /\ t < &2 * pi /\ f = rotate2d t`, + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_MATRIX] THEN + REWRITE_TAC[matrix_mul; orthogonal_matrix; transp] THEN + SIMP_TAC[DIMINDEX_2; SUM_2; FORALL_2; LAMBDA_BETA; ARITH; + CART_EQ; mat; DET_2] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(matrix f)$1$1 pow 2 + (matrix f)$2$1 pow 2 = &1 /\ + (matrix f)$1$2 = --((matrix f)$2$1) /\ + (matrix f:real^2^2)$2$2 = (matrix f)$1$1` + STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN CONV_TAC REAL_RING; + FIRST_X_ASSUM(MP_TAC o MATCH_MP SINCOS_TOTAL_2PI) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LINEAR_EQ_MATRIX THEN + ASM_REWRITE_TAC[LINEAR_ROTATE2D; MATRIX_ROTATE2D] THEN + ASM_SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2]]);; + +let ROTATE2D_ADD = prove + (`!s t x. rotate2d (s + t) x = rotate2d s (rotate2d t x)`, + SIMP_TAC[CART_EQ; rotate2d; LAMBDA_BETA; DIMINDEX_2; ARITH; + FORALL_2; VECTOR_2] THEN + REWRITE_TAC[SIN_ADD; COS_ADD] THEN REAL_ARITH_TAC);; + +let ROTATE2D_COMPLEX = prove + (`!t z. rotate2d t z = cexp(ii * Cx t) * z`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [complex_mul] THEN + REWRITE_TAC[CEXP_EULER; rotate2d; GSYM CX_SIN; GSYM CX_COS; + RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; IM_CX; RE_CX] THEN + REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2] THEN + REWRITE_TAC[GSYM RE_DEF; GSYM IM_DEF; RE; IM] THEN + REAL_ARITH_TAC);; + +let ROTATE2D_PI2 = prove + (`!z. rotate2d (pi / &2) z = ii * z`, + REWRITE_TAC[ROTATE2D_COMPLEX; CEXP_EULER; SIN_PI2; COS_PI2; GSYM CX_SIN; + GSYM CX_COS] THEN + CONV_TAC COMPLEX_RING);; + +let ROTATE2D_PI = prove + (`!z. rotate2d pi z = --z`, + REWRITE_TAC[ROTATE2D_COMPLEX; CEXP_EULER; SIN_PI; COS_PI; GSYM CX_SIN; + GSYM CX_COS] THEN + CONV_TAC COMPLEX_RING);; + +let ROTATE2D_NPI = prove + (`!n z. rotate2d (&n * pi) z = --Cx(&1) pow n * z`, + REWRITE_TAC[ROTATE2D_COMPLEX; CEXP_EULER; SIN_NPI; COS_NPI; GSYM CX_SIN; + GSYM CX_COS; CX_NEG; CX_POW] THEN + CONV_TAC COMPLEX_RING);; + +let ROTATE2D_2PI = prove + (`!z. rotate2d (&2 * pi) z = z`, + REWRITE_TAC[ROTATE2D_NPI] THEN CONV_TAC COMPLEX_RING);; + +let ARG_ROTATE2D = prove + (`!t z. ~(z = Cx(&0)) /\ &0 <= t + Arg z /\ t + Arg z < &2 * pi + ==> Arg(rotate2d t z) = t + Arg z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ARG_UNIQUE THEN + EXISTS_TAC `norm(z:complex)` THEN + ASM_SIMP_TAC[ARG; ROTATE2D_COMPLEX; REAL_LE_ADD; COMPLEX_NORM_NZ] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ARG] THEN + REWRITE_TAC[CX_ADD; COMPLEX_ADD_LDISTRIB; CEXP_ADD] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +let ARG_ROTATE2D_UNIQUE = prove + (`!t a z. ~(z = Cx(&0)) /\ Arg(rotate2d t z) = a + ==> ?n. integer n /\ t = &2 * n * pi + (a - Arg z)`, + REPEAT STRIP_TAC THEN + MP_TAC(last(CONJUNCTS(ISPEC `rotate2d t z` ARG))) THEN + ASM_REWRITE_TAC[NORM_ROTATE2D] THEN + REWRITE_TAC[ROTATE2D_COMPLEX] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) [ARG] THEN + ASM_REWRITE_TAC[COMPLEX_RING `a * z * b = z * c <=> z = Cx(&0) \/ a * b = c`; + CX_INJ; COMPLEX_NORM_ZERO; GSYM CEXP_ADD; CEXP_EQ] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; CX_INJ; COMPLEX_RING + `ii * t + ii * z = ii * a + n * ii <=> t = n + (a - z)`]);; + +let ARG_ROTATE2D_UNIQUE_2PI = prove + (`!s t z. ~(z = Cx(&0)) /\ + &0 <= s /\ s < &2 * pi /\ &0 <= t /\ t < &2 * pi /\ + Arg(rotate2d s z) = Arg(rotate2d t z) + ==> s = t`, + REPEAT STRIP_TAC THEN ABBREV_TAC `a = Arg(rotate2d t z)` THEN + MP_TAC(ISPECL [`s:real`; `a:real`; `z:complex`] ARG_ROTATE2D_UNIQUE) THEN + MP_TAC(ISPECL [`t:real`; `a:real`; `z:complex`] ARG_ROTATE2D_UNIQUE) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC SIN_COS_INJ THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[SIN_COS_EQ; REAL_RING + `x + az:real = (y + az) + z <=> x - y = z`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + ASM_MESON_TAC[INTEGER_CLOSED]; + ASM_REAL_ARITH_TAC]);; + +let COMPLEX_DIV_ROTATION = prove + (`!f w z. orthogonal_transformation f /\ det(matrix f) = &1 + ==> f w / f z = w / z`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP ROTATION_ROTATE2D) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[ROTATE2D_COMPLEX] THEN + SIMP_TAC[complex_div; COMPLEX_INV_MUL; CEXP_NZ; COMPLEX_FIELD + `~(a = Cx(&0)) ==> (a * w) * (inv a * z) = w * z`]);; + +let th = prove + (`!f w z. linear f /\ (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:2) ==> det(matrix f) = &1) + ==> f w / f z = w / z`, + REWRITE_TAC[CONJ_ASSOC; GSYM ORTHOGONAL_TRANSFORMATION; + DIMINDEX_2; LE_REFL; COMPLEX_DIV_ROTATION]) in +add_linear_invariants [th];; + +let th = prove + (`!f t z. linear f /\ (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:2) ==> det(matrix f) = &1) + ==> rotate2d t (f z) = f(rotate2d t z)`, + REWRITE_TAC[DIMINDEX_2; LE_REFL] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `f:complex->complex` ROTATION_ROTATE2D) THEN + ASM_REWRITE_TAC[ORTHOGONAL_TRANSFORMATION] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[GSYM ROTATE2D_ADD] THEN REWRITE_TAC[REAL_ADD_SYM]) in +add_linear_invariants [th];; + +let ROTATION_ROTATE2D_EXISTS_GEN = prove + (`!x y. ?t. &0 <= t /\ t < &2 * pi /\ norm(y) % rotate2d t x = norm(x) % y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`norm(y:real^2) % x:real^2`; `norm(x:real^2) % y:real^2`] + ROTATION_EXISTS) THEN + ASM_REWRITE_TAC[DIMINDEX_2; NORM_MUL; ARITH; REAL_ABS_NORM; + EQT_INTRO(SPEC_ALL REAL_MUL_SYM); CONJ_ASSOC] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^2->real^2` (CONJUNCTS_THEN ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ROTATION_ROTATE2D) THEN + MATCH_MP_TAC MONO_EXISTS THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LINEAR_CMUL; LINEAR_ROTATE2D]);; + +let ROTATION_ROTATE2D_EXISTS = prove + (`!x y. norm x = norm y ==> ?t. &0 <= t /\ t < &2 * pi /\ rotate2d t x = y`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `norm(y:complex) = &0` THENL + [ASM_REWRITE_TAC[] THEN DISCH_TAC THEN EXISTS_TAC `&0` THEN + SIMP_TAC[REAL_LT_MUL; PI_POS; REAL_OF_NUM_LT; ARITH; REAL_LE_REFL] THEN + ASM_MESON_TAC[COMPLEX_NORM_ZERO; ROTATE2D_0]; + DISCH_TAC THEN + MP_TAC(ISPECL [`x:complex`; `y:complex`] ROTATION_ROTATE2D_EXISTS_GEN) THEN + ASM_REWRITE_TAC[VECTOR_MUL_LCANCEL]]);; + +let ROTATION_ROTATE2D_EXISTS_ORTHOGONAL = prove + (`!e1 e2. norm(e1) = &1 /\ norm(e2) = &1 /\ orthogonal e1 e2 + ==> e1 = rotate2d (pi / &2) e2 \/ e2 = rotate2d (pi / &2) e1`, + REWRITE_TAC[NORM_EQ_1; orthogonal] THEN + SIMP_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; rotate2d; VECTOR_2] THEN + REWRITE_TAC[COS_PI2; SIN_PI2; REAL_MUL_RZERO; REAL_ADD_RID; + REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_MUL_RID] THEN + CONV_TAC REAL_RING);; + +let ROTATION_ROTATE2D_EXISTS_ORTHOGONAL_ORIENTED = prove + (`!e1 e2. norm(e1) = &1 /\ norm(e2) = &1 /\ orthogonal e1 e2 /\ + &0 < e1$1 * e2$2 - e1$2 * e2$1 + ==> e2 = rotate2d (pi / &2) e1`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN DISCH_TAC THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST_ALL_TAC o MATCH_MP + ROTATION_ROTATE2D_EXISTS_ORTHOGONAL) THEN + REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_THEN(K ALL_TAC) THEN + SIMP_TAC[DOT_2; CART_EQ; FORALL_2; DIMINDEX_2; rotate2d; VECTOR_2] THEN + REWRITE_TAC[COS_PI2; SIN_PI2; REAL_MUL_RZERO; REAL_ADD_RID; + REAL_SUB_LZERO; REAL_SUB_RZERO; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `--x * x - y * y <= &0 <=> &0 <= x * x + y * y`] THEN + MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_LE_SQUARE]);; + +let ROTATE2D_EQ = prove + (`!t x y. rotate2d t x = rotate2d t y <=> x = y`, + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE; + ORTHOGONAL_TRANSFORMATION_ROTATE2D]);; + +let ROTATE2D_SUB_ARG = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> rotate2d(Arg w - Arg z) = rotate2d(Arg(w / z))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_SUB_ARG] THEN + COND_CASES_TAC THEN REWRITE_TAC[real_sub; ROTATE2D_ADD; FUN_EQ_THM] THEN + GEN_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[ROTATE2D_COMPLEX] THEN + REWRITE_TAC[EULER; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; COS_NEG; SIN_NEG] THEN + REWRITE_TAC[SIN_NPI; COS_NPI; REAL_EXP_NEG; REAL_EXP_0; CX_NEG] THEN + REWRITE_TAC[COMPLEX_NEG_0; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[COMPLEX_MUL_LID]);; + +let ROTATION_MATRIX_ROTATE2D = prove + (`!t. rotation_matrix(matrix(rotate2d t))`, + SIMP_TAC[ROTATION_MATRIX_2; MATRIX_ROTATE2D; VECTOR_2] THEN + MESON_TAC[SIN_CIRCLE; REAL_ADD_SYM]);; + +let ROTATION_MATRIX_ROTATE2D_EQ = prove + (`!A:real^2^2. rotation_matrix A <=> ?t. A = matrix(rotate2d t)`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; ROTATION_MATRIX_ROTATE2D] THEN + REWRITE_TAC[ROTATION_MATRIX_2; MATRIX_ROTATE2D] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP SINCOS_TOTAL_2PI) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Homotopy staying within the set of orthogonal transformations *) +(* ------------------------------------------------------------------------- *) + +let NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION = prove + (`!f:real^N->real^N. + orthogonal_transformation f /\ det(matrix f) = &1 + ==> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) f I`, + let lemma0 = prove + (`!a x:real^N. + 2 <= dimindex(:N) /\ a IN span {basis 1,basis 2} + ==> reflect_along (vector[a$1; a$2]:real^2) (lambda i. x$i) = + (lambda i. reflect_along a x$i)`, + REPEAT STRIP_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; reflect_along; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT; DIMINDEX_2; FORALL_2; VECTOR_2; ARITH] THEN + CONJ_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN BINOP_TAC THEN REWRITE_TAC[dot] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; FORALL_2; DIMINDEX_2; LAMBDA_BETA; + ARITH; VECTOR_2; SUBSET_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE + `(1 <= i /\ i <= n) /\ ~(1 <= i /\ i <= 2) <=> + 1 <= i /\ 3 <= i /\ i <= n`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SPAN_2]) THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[BASIS_COMPONENT] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO]) THEN + ASM_ARITH_TAC) in + let lemma1 = prove + (`!a b:real^2 r. + ~(a = vec 0) /\ ~(b = vec 0) + ==> homotopic_with orthogonal_transformation ((:real^2),(:real^2)) + (reflect_along a o reflect_along b) I`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `reflect_along (a:real^2) o reflect_along b` + ROTATION_ROTATE2D) THEN + ANTS_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o + MATCH_MP ROTOINVERSION_MATRIX_REFLECT_ALONG)) THEN + REWRITE_TAC[rotoinversion_matrix] THEN + SIMP_TAC[ORTHOGONAL_MATRIX_MATRIX; + ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG; + ORTHOGONAL_TRANSFORMATION_COMPOSE; MATRIX_COMPOSE; + LINEAR_REFLECT_ALONG; DET_MUL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[HOMOTOPIC_WITH_SYM] THEN + ASM_REWRITE_TAC[homotopic_with] THEN + EXISTS_TAC `\z. rotate2d (drop(fstcart z) * t) (sndcart z)` THEN + SIMP_TAC[ORTHOGONAL_TRANSFORMATION_ROTATE2D; SNDCART_PASTECART; + ETA_AX; FSTCART_PASTECART; DROP_VEC; I_THM; NORM_ROTATE2D; + REAL_MUL_LZERO; REAL_MUL_LID; SUBSET; FORALL_IN_IMAGE; IN_UNIV; + FORALL_IN_PCROSS; IN_SPHERE_0; ROTATE2D_ZERO] THEN + REWRITE_TAC[ROTATE2D_COMPLEX] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP; CX_MUL] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `ii * x * t = (ii * t) * x`] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART]]) in + let lemma2 = prove + (`!a b:real^N r. + 2 <= dimindex(:N) /\ + ~(a = vec 0) /\ ~(b = vec 0) /\ + {a,b} SUBSET span {basis 1,basis 2} + ==> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) + (reflect_along a o reflect_along b) I`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `homotopic_with orthogonal_transformation + ((:real^N),(:real^N)) + ((\z. (lambda i. if i <= 2 then (fstcart z)$i + else (sndcart z)$i):real^N) o + (\z. pastecart + (((reflect_along (vector [(a:real^N)$1; a$2]) o + reflect_along (vector [(b:real^N)$1; b$2])) + :real^2->real^2)(fstcart z)) + (sndcart z)) o + (\z:real^N. pastecart ((lambda i. z$i) :real^2) z)) + ((\z. (lambda i. if i <= 2 then (fstcart z)$i + else (sndcart z)$i):real^N) o + I o + (\z:real^N. pastecart ((lambda i. z$i) :real^2) z))` + MP_TAC THENL + [MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `(:real^2) PCROSS (:real^N)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + ONCE_REWRITE_TAC[LINEAR_COMPONENTWISE] THEN + SIMP_TAC[LAMBDA_BETA] THEN X_GEN_TAC `i:num` THEN + STRIP_TAC THEN ASM_CASES_TAC `i <= 2` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; + SNDCART_ADD; SNDCART_CMUL] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `(:real^2) PCROSS (:real^N)` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; PASTECART_IN_PCROSS] THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + MATCH_MP_TAC LINEAR_PASTECART THEN REWRITE_TAC[LINEAR_ID] THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]] THEN + SUBGOAL_THEN + `I = \z:real^(2,N)finite_sum. pastecart (fstcart z) (sndcart z)` + SUBST1_TAC THENL + [REWRITE_TAC[PASTECART_FST_SND; I_DEF]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_PCROSS THEN + EXISTS_TAC `orthogonal_transformation:(real^2->real^2)->bool` THEN + EXISTS_TAC `\f:real^N->real^N. f = I` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM I_DEF; ETA_AX] THEN MATCH_MP_TAC lemma1 THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INSERT_SUBSET]) THEN + REWRITE_TAC[SING_SUBSET; SPAN_2; IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(REPEAT_TCL STRIP_THM_THEN SUBST_ALL_TAC) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ o rev) THEN + REWRITE_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + DIMINDEX_2; FORALL_2; VECTOR_2] THEN + SIMP_TAC[BASIS_COMPONENT; ARITH; DIMINDEX_2; VEC_COMPONENT; + DIMINDEX_GE_1; LE_REFL] THEN + MATCH_MP_TAC(TAUT + `(r ==> q) /\ (s ==> p) ==> a /\ ~p /\ ~q ==> ~s /\ ~r`) THEN + SIMP_TAC[REAL_MUL_RZERO; REAL_MUL_LZERO; REAL_MUL_RID; + REAL_ADD_LID; REAL_ADD_RID]; + REWRITE_TAC[HOMOTOPIC_WITH_REFL; SUBSET_UNIV; I_DEF] THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + SIMP_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; + LAMBDA_BETA; DIMINDEX_2; ARITH; I_THM] THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION; NORM_EQ] THEN + X_GEN_TAC `f:real^2->real^2` THEN GEN_TAC THEN STRIP_TAC THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [linear]) THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN GEN_TAC THEN + GEN_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]; + X_GEN_TAC `v:real^N` THEN REWRITE_TAC[dot; GSYM REAL_POW_2] THEN + SUBGOAL_THEN `dimindex(:N) = 2 + (dimindex(:N) - 2)` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN + BINOP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[dot; DIMINDEX_2; GSYM REAL_POW_2]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (v:real^N)$i):real^2`) THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `2 <= n ==> !i. i <= 2 ==> i <= n`)) THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_2]; + ASM_SIMP_TAC[ARITH_RULE `2 <= n ==> 2 + n - 2 = n`] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + SIMP_TAC[ARITH_RULE `2 + 1 <= i ==> 1 <= i`; + LAMBDA_BETA; DIMINDEX_2] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]]]; + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + REWRITE_TAC[IN_UNIV; GSYM FUN_EQ_THM] THEN + SIMP_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; + LAMBDA_BETA; DIMINDEX_2; ARITH; I_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INSERT_SUBSET; EMPTY_SUBSET]) THEN + ASM_SIMP_TAC[lemma0] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; DIMINDEX_2; ARITH; COND_ID] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `i:num`] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:real^N)$i = &0 /\ (b:real^N)$i = &0` ASSUME_TAC THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN MP_TAC) THEN + REWRITE_TAC[SPAN_2; IN_ELIM_THM; IN_UNIV] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + (REAL_ARITH_TAC ORELSE ASM_ARITH_TAC); + ASM_REWRITE_TAC[reflect_along; VECTOR_SUB_COMPONENT; REAL_MUL_RZERO; + VECTOR_MUL_COMPONENT; REAL_SUB_RZERO]]]) in + let lemma3 = prove + (`!a b:real^N r. + ~(a = vec 0) /\ ~(b = vec 0) + ==> homotopic_with orthogonal_transformation ((:real^N),(:real^N)) + (reflect_along a o reflect_along b) I`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [ASM_SIMP_TAC[o_DEF; I_DEF; REFLECT_ALONG_1D; VECTOR_NEG_NEG] THEN + REWRITE_TAC[HOMOTOPIC_WITH_REFL; SUBSET_UNIV; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[ORTHOGONAL_TRANSFORMATION_ID]; + FIRST_X_ASSUM(MP_TAC o MATCH_MP(ARITH_RULE + `~(n = 1) ==> 1 <= n ==> 2 <= n`)) THEN + REWRITE_TAC[DIMINDEX_GE_1] THEN DISCH_TAC] THEN + MP_TAC(ISPECL [`span{a:real^N,b}`; `span{basis 1:real^N,basis 2}`] + ORTHOGONAL_TRANSFORMATION_INTO_SUBSPACE) THEN + REWRITE_TAC[SUBSPACE_SPAN; DIM_SPAN] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[DIM_INSERT; SPAN_SING; SPAN_EMPTY; + IN_SING; DIM_EMPTY] THEN + MATCH_MP_TAC(ARITH_RULE `m <= 2 /\ n = 2 ==> m <= n`) THEN + CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[BASIS_NONZERO; ARITH] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(CHOOSE_THEN (MP_TAC o AP_TERM `(\x:real^N. x$1)`)) THEN + ASM_SIMP_TAC[BASIS_COMPONENT; VECTOR_MUL_COMPONENT; + ARITH; DIMINDEX_GE_1] THEN + REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `f:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^N` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `homotopic_with orthogonal_transformation ((:real^N),(:real^N)) + (g o (f o (reflect_along a o reflect_along b) o (g:real^N->real^N)) o f) + (g o (f o I o (g:real^N->real^N)) o f)` + MP_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[o_ASSOC] THEN ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID]] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_CONTINUOUS_ON] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_CONTINUOUS_ON] THEN + ASM_REWRITE_TAC[I_O_ID] THEN + MP_TAC(ISPEC `f:real^N->real^N` REFLECT_ALONG_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[GSYM ORTHOGONAL_TRANSFORMATION] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN + `!h:real^N->real^N. + orthogonal_transformation (g o h o (f:real^N->real^N)) <=> + orthogonal_transformation h` + (fun th -> REWRITE_TAC[th; ETA_AX]) + THENL + [GEN_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN + DISCH_TAC THEN + SUBGOAL_THEN `h:real^N->real^N = f o (g o h o f) o (g:real^N->real^N)` + SUBST1_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE]] THEN + ASM_REWRITE_TAC[o_ASSOC] THEN ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID]; + ALL_TAC] THEN + SUBGOAL_THEN + `(f:real^N->real^N) o (reflect_along a o reflect_along b) o g = + reflect_along (f a) o reflect_along (f b)` + SUBST1_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; o_THM; I_THM]) THEN + ASM_REWRITE_TAC[o_DEF]; + MATCH_MP_TAC lemma2 THEN RULE_ASSUM_TAC + (REWRITE_RULE[GSYM NORM_EQ_0; ORTHOGONAL_TRANSFORMATION]) THEN + ASM_REWRITE_TAC[GSYM NORM_EQ_0] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE; IMAGE_CLAUSES] THEN + REWRITE_TAC[SPAN_INC]]) in + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `dimindex(:N)`] + ORTHOGONAL_TRANSFORMATION_GENERATED_BY_REFLECTIONS) THEN + ASM_REWRITE_TAC[ARITH_RULE `n:num <= a + n`] THEN + DISCH_THEN(X_CHOOSE_THEN `l:(real^N)list` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `ALL (\v:real^N. ~(v = vec 0)) l` THEN + UNDISCH_TAC `orthogonal_transformation(f:real^N->real^N)` THEN + MATCH_MP_TAC(TAUT `r /\ (p /\ q ==> s) ==> r ==> p ==> q ==> s`) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + SPEC_TAC(`l:(real^N)list`,`l:(real^N)list`) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN GEN_TAC THEN + WF_INDUCT_TAC `LENGTH(l:(real^N)list)` THEN POP_ASSUM MP_TAC THEN + SPEC_TAC(`l:(real^N)list`,`l:(real^N)list`) THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[ALL; ITLIST; HOMOTOPIC_WITH_REFL] THEN + REWRITE_TAC[REWRITE_RULE[GSYM I_DEF] CONTINUOUS_ON_ID; + ORTHOGONAL_TRANSFORMATION_I; SUBSET_UNIV] THEN + X_GEN_TAC `a:real^N` THEN MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[ALL; ITLIST; I_O_ID; DET_MATRIX_REFLECT_ALONG] THEN + REWRITE_TAC[ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG] THEN + CONJ_TAC THENL [MESON_TAC[REAL_ARITH `~(-- &1 = &1)`]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`b:real^N`; `l:(real^N)list`] THEN + REPLICATE_TAC 2 (DISCH_THEN(K ALL_TAC)) THEN + DISCH_THEN(MP_TAC o SPEC `l:(real^N)list`) THEN + REWRITE_TAC[LENGTH; ARITH_RULE `n < SUC(SUC n)`] THEN + SIMP_TAC[LINEAR_COMPOSE; LINEAR_REFLECT_ALONG; MATRIX_COMPOSE; + ORTHGOONAL_TRANSFORMATION_REFLECT_ALONG; + ORTHOGONAL_TRANSFORMATION_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + DISCH_THEN(fun th -> + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN MP_TAC th) THEN + ASM_SIMP_TAC[DET_MUL; DET_MATRIX_REFLECT_ALONG; REAL_ARITH + `-- &1 * -- &1 * x = x`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_WITH_TRANS) THEN + GEN_REWRITE_TAC RAND_CONV [MESON[I_O_ID] `f = I o f`] THEN + REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + ABBREV_TAC `g = ITLIST (\v:real^N h. reflect_along v o h) l I` THEN + SUBGOAL_THEN + `(\f:real^N->real^N. + orthogonal_transformation (f o g)) = orthogonal_transformation` + SUBST1_TAC THENL [ALL_TAC; MATCH_MP_TAC lemma3 THEN ASM_REWRITE_TAC[]] THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `f:real^N->real^N` THEN + EQ_TAC THEN ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN + DISCH_TAC THEN + MP_TAC(ISPEC `g:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `h:real^N->real^N` THEN + STRIP_TAC THEN + SUBGOAL_THEN `f = ((f:real^N->real^N) o (g:real^N->real^N)) o h` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[GSYM o_ASSOC; I_O_ID]; + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE]]);; + +let HOMOTOPIC_SPECIAL_ORTHOGONAL_TRANSFORMATIONS, + HOMOTOPIC_ORTHOGONAL_TRANSFORMATIONS = (CONJ_PAIR o prove) + (`(!f g. homotopic_with + (\h. orthogonal_transformation h /\ det(matrix h) = det(matrix f)) + ((:real^N),(:real^N)) f g <=> + homotopic_with + orthogonal_transformation ((:real^N),(:real^N)) f g) /\ + !f g. homotopic_with orthogonal_transformation ((:real^N),(:real^N)) f g <=> + orthogonal_transformation f /\ orthogonal_transformation g /\ + det(matrix f) = det(matrix g)`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(u ==> s) /\ (s ==> t) /\ (t ==> u) + ==> (u <=> t) /\ (t <=> s)`) THEN + REPEAT CONJ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_PROPERTY) THEN MESON_TAC[]; + STRIP_TAC THEN + MP_TAC(ISPEC `g:real^N->real^N` ORTHOGONAL_TRANSFORMATION_INVERSE_o) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `h:real^N->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(f:real^N->real^N) = g o (h:real^N->real^N) o f /\ g = g o I` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL [ASM_REWRITE_TAC[o_ASSOC; I_O_ID]; ALL_TAC] THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_LEFT THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR; LINEAR_CONTINUOUS_ON] THEN + SUBGOAL_THEN + `!k:real^N->real^N. + orthogonal_transformation (g o k) <=> orthogonal_transformation k` + (fun th -> REWRITE_TAC[th; ETA_AX]) + THENL + [GEN_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_COMPOSE] THEN DISCH_THEN + (MP_TAC o SPEC `h:real^N->real^N` o MATCH_MP (ONCE_REWRITE_RULE + [IMP_CONJ_ALT] ORTHOGONAL_TRANSFORMATION_COMPOSE)) THEN + ASM_SIMP_TAC[o_ASSOC; I_O_ID]; + MATCH_MP_TAC NULLHOMOTOPIC_ORTHOGONAL_TRANSFORMATION THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o AP_TERM + `\f:real^N->real^N. det(matrix f)`)) THEN + ASM_SIMP_TAC[MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR; + ORTHOGONAL_TRANSFORMATION_COMPOSE; DET_MUL; + MATRIX_I; DET_I]]; + REWRITE_TAC[homotopic_with] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `k:real^(1,N)finite_sum->real^N` THEN + STRIP_TAC THEN ASM_SIMP_TAC[] THEN MP_TAC(ISPECL + [`\t. lift( + det(matrix((k:real^(1,N)finite_sum->real^N) o pastecart t)))`; + `interval[vec 0:real^1,vec 1]`] + CONTINUOUS_DISCRETE_RANGE_CONSTANT) THEN + REWRITE_TAC[CONNECTED_INTERVAL] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_LIFT_DET THEN + SIMP_TAC[matrix; LAMBDA_BETA; o_DEF] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; + CONTINUOUS_ON_ID] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS; IN_UNIV]; + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN X_GEN_TAC `u:real^1` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT; LIFT_EQ] THEN + SUBGOAL_THEN + `orthogonal_transformation + ((k:real^(1,N)finite_sum->real^N) o pastecart t) /\ + orthogonal_transformation (k o pastecart u)` + MP_TAC THENL [ASM_SIMP_TAC[o_DEF]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN + (STRIP_ASSUME_TAC o MATCH_MP DET_ORTHOGONAL_MATRIX o + MATCH_MP ORTHOGONAL_MATRIX_MATRIX)) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; + REWRITE_TAC[o_DEF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^1` THEN DISCH_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM FUN_EQ_THM])) THEN + REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN + ASM_SIMP_TAC[ENDS_IN_UNIT_INTERVAL; GSYM LIFT_EQ]]]);; + +(* ------------------------------------------------------------------------- *) +(* Complex tangent function. *) +(* ------------------------------------------------------------------------- *) + +let ctan = new_definition + `ctan z = csin z / ccos z`;; + +let CTAN_0 = prove + (`ctan(Cx(&0)) = Cx(&0)`, + REWRITE_TAC[ctan; CSIN_0; CCOS_0; COMPLEX_DIV_1]);; + +let CTAN_NEG = prove + (`!z. ctan(--z) = --(ctan z)`, + REWRITE_TAC[ctan; CSIN_NEG; CCOS_NEG; complex_div; COMPLEX_MUL_LNEG]);; + +let CTAN_ADD = prove + (`!w z. ~(ccos(w) = Cx(&0)) /\ + ~(ccos(z) = Cx(&0)) /\ + ~(ccos(w + z) = Cx(&0)) + ==> ctan(w + z) = (ctan w + ctan z) / (Cx(&1) - ctan(w) * ctan(z))`, + REPEAT GEN_TAC THEN REWRITE_TAC[ctan; CSIN_ADD; CCOS_ADD] THEN + CONV_TAC COMPLEX_FIELD);; + +let CTAN_DOUBLE = prove + (`!z. ~(ccos(z) = Cx(&0)) /\ ~(ccos(Cx(&2) * z) = Cx(&0)) + ==> ctan(Cx(&2) * z) = + (Cx(&2) * ctan z) / (Cx(&1) - ctan(z) pow 2)`, + SIMP_TAC[COMPLEX_MUL_2; CTAN_ADD; COMPLEX_POW_2]);; + +let CTAN_SUB = prove + (`!w z. ~(ccos(w) = Cx(&0)) /\ + ~(ccos(z) = Cx(&0)) /\ + ~(ccos(w - z) = Cx(&0)) + ==> ctan(w - z) = (ctan w - ctan z) / (Cx(&1) + ctan(w) * ctan(z))`, + SIMP_TAC[complex_sub; CTAN_ADD; CCOS_NEG; CTAN_NEG] THEN + REWRITE_TAC[COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]);; + +let COMPLEX_ADD_CTAN = prove + (`!w z. ~(ccos(w) = Cx(&0)) /\ + ~(ccos(z) = Cx(&0)) + ==> ctan(w) + ctan(z) = csin(w + z) / (ccos(w) * ccos(z))`, + REWRITE_TAC[ctan; CSIN_ADD] THEN CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_SUB_CTAN = prove + (`!w z. ~(ccos(w) = Cx(&0)) /\ + ~(ccos(z) = Cx(&0)) + ==> ctan(w) - ctan(z) = csin(w - z) / (ccos(w) * ccos(z))`, + REWRITE_TAC[ctan; CSIN_SUB] THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Analytic properties of tangent function. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_CTAN = prove + (`!z. ~(ccos z = Cx(&0)) + ==> (ctan has_complex_derivative (inv(ccos(z) pow 2))) (at z)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[ctan] THEN COMPLEX_DIFF_TAC THEN + MP_TAC(SPEC `z:complex` CSIN_CIRCLE) THEN + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; + +let COMPLEX_DIFFERENTIABLE_AT_CTAN = prove + (`!z. ~(ccos z = Cx(&0)) ==> ctan complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CTAN]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CTAN = prove + (`!s z. ~(ccos z = Cx(&0)) + ==> ctan complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CTAN]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + HAS_COMPLEX_DERIVATIVE_CTAN)));; + +let CONTINUOUS_AT_CTAN = prove + (`!z. ~(ccos z = Cx(&0)) ==> ctan continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CTAN; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CTAN = prove + (`!s z. ~(ccos z = Cx(&0)) ==> ctan continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CTAN]);; + +let CONTINUOUS_ON_CTAN = prove + (`!s. (!z. z IN s ==> ~(ccos z = Cx(&0))) ==> ctan continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CTAN]);; + +let HOLOMORPHIC_ON_CTAN = prove + (`!s. (!z. z IN s ==> ~(ccos z = Cx(&0))) ==> ctan holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CTAN]);; + +(* ------------------------------------------------------------------------- *) +(* Real tangent function. *) +(* ------------------------------------------------------------------------- *) + +let tan_def = new_definition + `tan(x) = Re(ctan(Cx x))`;; + +let CNJ_CTAN = prove + (`!z. cnj(ctan z) = ctan(cnj z)`, + REWRITE_TAC[ctan; CNJ_DIV; CNJ_CSIN; CNJ_CCOS]);; + +let REAL_TAN = prove + (`!z. real z ==> real(ctan z)`, + SIMP_TAC[REAL_CNJ; CNJ_CTAN]);; + +let CX_TAN = prove + (`!x. Cx(tan x) = ctan(Cx x)`, + REWRITE_TAC[tan_def] THEN MESON_TAC[REAL; REAL_CX; REAL_TAN]);; + +let tan = prove + (`!x. tan x = sin x / cos x`, + REWRITE_TAC[GSYM CX_INJ; CX_DIV; CX_TAN; CX_SIN; CX_COS; ctan]);; + +let TAN_0 = prove + (`tan(&0) = &0`, + REWRITE_TAC[GSYM CX_INJ; CX_TAN; CTAN_0]);; + +let TAN_PI = prove + (`tan(pi) = &0`, + REWRITE_TAC[tan; SIN_PI; real_div; REAL_MUL_LZERO]);; + +let TAN_NPI = prove + (`!n. tan(&n * pi) = &0`, + REWRITE_TAC[tan; SIN_NPI; real_div; REAL_MUL_LZERO]);; + +let TAN_NEG = prove + (`!x. tan(--x) = --(tan x)`, + REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_NEG; CTAN_NEG]);; + +let TAN_PERIODIC_PI = prove + (`!x. tan(x + pi) = tan(x)`, + REWRITE_TAC[tan; SIN_PERIODIC_PI; COS_PERIODIC_PI; real_div] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_INV_NEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let TAN_PERIODIC_NPI = prove + (`!x n. tan(x + &n * pi) = tan(x)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_REWRITE_TAC[REAL_ADD_ASSOC; TAN_PERIODIC_PI]);; + +let TAN_ADD = prove + (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x + y) = &0) + ==> tan(x + y) = (tan(x) + tan(y)) / (&1 - tan(x) * tan(y))`, + REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CTAN_ADD; + CX_DIV; CX_ADD; CX_SUB; CX_MUL]);; + +let TAN_SUB = prove + (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) /\ ~(cos(x - y) = &0) + ==> tan(x - y) = (tan(x) - tan(y)) / (&1 + tan(x) * tan(y))`, + REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CX_ADD; CTAN_SUB; + CX_DIV; CX_ADD; CX_SUB; CX_MUL]);; + +let TAN_DOUBLE = prove + (`!x. ~(cos(x) = &0) /\ ~(cos(&2 * x) = &0) + ==> tan(&2 * x) = (&2 * tan(x)) / (&1 - (tan(x) pow 2))`, + SIMP_TAC[REAL_MUL_2; TAN_ADD; REAL_POW_2]);; + +let REAL_ADD_TAN = prove + (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) + ==> tan(x) + tan(y) = sin(x + y) / (cos(x) * cos(y))`, + REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CX_MUL; CX_ADD; CX_DIV] THEN + REWRITE_TAC[COMPLEX_ADD_CTAN]);; + +let REAL_SUB_TAN = prove + (`!x y. ~(cos(x) = &0) /\ ~(cos(y) = &0) + ==> tan(x) - tan(y) = sin(x - y) / (cos(x) * cos(y))`, + REWRITE_TAC[GSYM CX_INJ; CX_TAN; CX_SIN; CX_COS; CX_MUL; CX_SUB; CX_DIV] THEN + REWRITE_TAC[COMPLEX_SUB_CTAN]);; + +let TAN_PI4 = prove + (`tan(pi / &4) = &1`, + REWRITE_TAC[tan; SIN_COS; REAL_ARITH `p / &2 - p / &4 = p / &4`] THEN + MATCH_MP_TAC REAL_DIV_REFL THEN REWRITE_TAC[COS_EQ_0; PI_NZ; REAL_FIELD + `p / &4 = (n + &1 / &2) * p <=> p = &0 \/ n = -- &1 / &4`] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[UNWIND_THM2] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_ABS_INTEGER_LEMMA)) THEN + REAL_ARITH_TAC);; + +let TAN_POS_PI2 = prove + (`!x. &0 < x /\ x < pi / &2 ==> &0 < tan x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[tan] THEN + MATCH_MP_TAC REAL_LT_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC SIN_POS_PI; MATCH_MP_TAC COS_POS_PI] THEN + ASM_REAL_ARITH_TAC);; + +let TAN_POS_PI2_LE = prove + (`!x. &0 <= x /\ x < pi / &2 ==> &0 <= tan x`, + REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[TAN_0; TAN_POS_PI2]);; + +let COS_TAN = prove + (`!x. abs(x) < pi / &2 ==> cos(x) = &1 / sqrt(&1 + tan(x) pow 2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_FIELD + `sqrt(s) pow 2 = s /\ c pow 2 * s = &1 /\ ~(&1 + c * sqrt s = &0) + ==> c = &1 / sqrt s`) THEN + SUBGOAL_THEN `&0 < &1 + tan x pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `tan x` REAL_LE_SQUARE) THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE] THEN CONJ_TAC THENL + [REWRITE_TAC[tan] THEN + MATCH_MP_TAC(REAL_FIELD + `s pow 2 + c pow 2 = &1 /\ &0 < c + ==> c pow 2 * (&1 + (s / c) pow 2) = &1`) THEN + ASM_SIMP_TAC[SIN_CIRCLE; COS_POS_PI; REAL_BOUNDS_LT]; + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(&1 + x = &0)`) THEN + ASM_SIMP_TAC[SIN_CIRCLE; COS_POS_PI; REAL_BOUNDS_LT; SQRT_POS_LT; + REAL_LT_MUL]]);; + +let SIN_TAN = prove + (`!x. abs(x) < pi / &2 ==> sin(x) = tan(x) / sqrt(&1 + tan(x) pow 2)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a / b = a * &1 / b`] THEN + ASM_SIMP_TAC[GSYM COS_TAN] THEN + ASM_SIMP_TAC[tan; REAL_DIV_RMUL; REAL_LT_IMP_NZ; COS_POS_PI; + REAL_BOUNDS_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Monotonicity theorems for the basic trig functions. *) +(* ------------------------------------------------------------------------- *) + +let SIN_MONO_LT = prove + (`!x y. --(pi / &2) <= x /\ x < y /\ y <= pi / &2 ==> sin(x) < sin(y)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[REAL_SUB_SIN; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SIN_POS_PI; MATCH_MP_TAC COS_POS_PI] THEN + ASM_REAL_ARITH_TAC);; + +let SIN_MONO_LE = prove + (`!x y. --(pi / &2) <= x /\ x <= y /\ y <= pi / &2 ==> sin(x) <= sin(y)`, + MESON_TAC[SIN_MONO_LT; REAL_LE_LT]);; + +let SIN_MONO_LT_EQ = prove + (`!x y. --(pi / &2) <= x /\ x <= pi / &2 /\ --(pi / &2) <= y /\ y <= pi / &2 + ==> (sin(x) < sin(y) <=> x < y)`, + MESON_TAC[REAL_NOT_LE; SIN_MONO_LT; SIN_MONO_LE]);; + +let SIN_MONO_LE_EQ = prove + (`!x y. --(pi / &2) <= x /\ x <= pi / &2 /\ --(pi / &2) <= y /\ y <= pi / &2 + ==> (sin(x) <= sin(y) <=> x <= y)`, + MESON_TAC[REAL_NOT_LE; SIN_MONO_LT; SIN_MONO_LE]);; + +let SIN_INJ_PI = prove + (`!x y. --(pi / &2) <= x /\ x <= pi / &2 /\ + --(pi / &2) <= y /\ y <= pi / &2 /\ + sin(x) = sin(y) + ==> x = y`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[SIN_MONO_LE_EQ]);; + +let COS_MONO_LT = prove + (`!x y. &0 <= x /\ x < y /\ y <= pi ==> cos(y) < cos(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[REAL_SUB_COS; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN MATCH_MP_TAC SIN_POS_PI THEN + ASM_REAL_ARITH_TAC);; + +let COS_MONO_LE = prove + (`!x y. &0 <= x /\ x <= y /\ y <= pi ==> cos(y) <= cos(x)`, + MESON_TAC[COS_MONO_LT; REAL_LE_LT]);; + +let COS_MONO_LT_EQ = prove + (`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi + ==> (cos(x) < cos(y) <=> y < x)`, + MESON_TAC[REAL_NOT_LE; COS_MONO_LT; COS_MONO_LE]);; + +let COS_MONO_LE_EQ = prove + (`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi + ==> (cos(x) <= cos(y) <=> y <= x)`, + MESON_TAC[REAL_NOT_LE; COS_MONO_LT; COS_MONO_LE]);; + +let COS_INJ_PI = prove + (`!x y. &0 <= x /\ x <= pi /\ &0 <= y /\ y <= pi /\ cos(x) = cos(y) + ==> x = y`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[COS_MONO_LE_EQ]);; + +let TAN_MONO_LT = prove + (`!x y. --(pi / &2) < x /\ x < y /\ y < pi / &2 ==> tan(x) < tan(y)`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM REAL_SUB_LT] THEN + SUBGOAL_THEN `&0 < cos(x) /\ &0 < cos(y)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC COS_POS_PI; + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_SUB_TAN] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + MATCH_MP_TAC SIN_POS_PI] THEN + ASM_REAL_ARITH_TAC);; + +let TAN_MONO_LE = prove + (`!x y. --(pi / &2) < x /\ x <= y /\ y < pi / &2 ==> tan(x) <= tan(y)`, + REWRITE_TAC[REAL_LE_LT] THEN MESON_TAC[TAN_MONO_LT]);; + +let TAN_MONO_LT_EQ = prove + (`!x y. --(pi / &2) < x /\ x < pi / &2 /\ --(pi / &2) < y /\ y < pi / &2 + ==> (tan(x) < tan(y) <=> x < y)`, + MESON_TAC[REAL_NOT_LE; TAN_MONO_LT; TAN_MONO_LE]);; + +let TAN_MONO_LE_EQ = prove + (`!x y. --(pi / &2) < x /\ x < pi / &2 /\ --(pi / &2) < y /\ y < pi / &2 + ==> (tan(x) <= tan(y) <=> x <= y)`, + MESON_TAC[REAL_NOT_LE; TAN_MONO_LT; TAN_MONO_LE]);; + +let TAN_BOUND_PI2 = prove + (`!x. abs(x) < pi / &4 ==> abs(tan x) < &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM TAN_PI4] THEN + REWRITE_TAC[GSYM TAN_NEG; REAL_ARITH `abs(x) < a <=> --a < x /\ x < a`] THEN + CONJ_TAC THEN MATCH_MP_TAC TAN_MONO_LT THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let TAN_COT = prove + (`!x. tan(pi / &2 - x) = inv(tan x)`, + REWRITE_TAC[tan; SIN_SUB; COS_SUB; SIN_PI2; COS_PI2; REAL_INV_DIV] THEN + GEN_TAC THEN BINOP_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Approximation to pi. *) +(* ------------------------------------------------------------------------- *) + +let SIN_PI6_STRADDLE = prove + (`!a b. &0 <= a /\ a <= b /\ b <= &4 /\ + sin(a / &6) <= &1 / &2 /\ &1 / &2 <= sin(b / &6) + ==> a <= pi /\ pi <= b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`pi / &6`; `b / &6`] SIN_MONO_LE_EQ) THEN + MP_TAC(SPECL [`a / &6`; `pi / &6`] SIN_MONO_LE_EQ) THEN + ASM_REWRITE_TAC[SIN_PI6] THEN + SUBGOAL_THEN `!x. &0 < x /\ x < &7 / &5 ==> &0 < sin x` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`0`; `Cx(x)`] TAYLOR_CSIN) THEN + REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[COMPLEX_DIV_1; COMPLEX_POW_1; complex_pow] THEN + REWRITE_TAC[COMPLEX_MUL_LID; GSYM CX_SIN; GSYM CX_SUB] THEN + REWRITE_TAC[IM_CX; COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_EXP_0] THEN + MATCH_MP_TAC(REAL_ARITH + `e + d < a ==> abs(s - a) <= d ==> e < s`) THEN + ASM_SIMP_TAC[real_abs; real_pow; REAL_MUL_LID; REAL_LT_IMP_LE] THEN + SIMP_TAC[REAL_ARITH `&0 + x pow 3 / &2 < x <=> x * x pow 2 < x * &2`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ] THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `(&7 / &5) pow 2` THEN + ASM_SIMP_TAC[REAL_POW_LT2; ARITH_EQ; REAL_LT_IMP_LE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + DISCH_THEN(MP_TAC o SPEC `pi`) THEN + SIMP_TAC[SIN_PI; REAL_LT_REFL; PI_POS; REAL_NOT_LT] THEN + ASM_REAL_ARITH_TAC]);; + +let PI_APPROX_32 = prove + (`abs(pi - &13493037705 / &4294967296) <= inv(&2 pow 32)`, + REWRITE_TAC[REAL_ARITH `abs(x - a) <= e <=> a - e <= x /\ x <= a + e`] THEN + MATCH_MP_TAC SIN_PI6_STRADDLE THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + CONJ_TAC THENL + [MP_TAC(SPECL [`5`; `Cx(&1686629713 / &3221225472)`] TAYLOR_CSIN); + MP_TAC(SPECL [`5`; `Cx(&6746518853 / &12884901888)`] TAYLOR_CSIN)] THEN + SIMP_TAC[COMPLEX_NORM_CX; GSYM CX_POW; GSYM CX_DIV; GSYM CX_MUL; + GSYM CX_NEG; VSUM_CX; FINITE_NUMSEG; GSYM CX_SIN; GSYM CX_SUB] THEN + REWRITE_TAC[IM_CX; REAL_ABS_NUM; REAL_EXP_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; GSYM REAL_POW_POW] THEN + REWRITE_TAC[REAL_MUL_ASSOC; GSYM REAL_POW_MUL; real_div] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + CONV_TAC(ONCE_DEPTH_CONV HORNER_SUM_CONV) THEN REAL_ARITH_TAC);; + +let PI2_BOUNDS = prove + (`&0 < pi / &2 /\ pi / &2 < &2`, + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Complex logarithms (the conventional principal value). *) +(* ------------------------------------------------------------------------- *) + +let clog = new_definition + `clog z = @w. cexp(w) = z /\ --pi < Im(w) /\ Im(w) <= pi`;; + +let EXISTS_COMPLEX' = prove + (`!P. (?z. P (Re z) (Im z)) <=> ?x y. P x y`, + MESON_TAC[RE; IM; COMPLEX]);; + +let CLOG_WORKS = prove + (`!z. ~(z = Cx(&0)) + ==> cexp(clog z) = z /\ --pi < Im(clog z) /\ Im(clog z) <= pi`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[clog] THEN CONV_TAC SELECT_CONV THEN + MP_TAC(SPEC `z / Cx(norm z)` COMPLEX_UNIMODULAR_POLAR) THEN ANTS_TAC THENL + [ASM_SIMP_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ABS_NORM; REAL_DIV_REFL; COMPLEX_NORM_ZERO]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `x:real` SINCOS_PRINCIPAL_VALUE) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `complex(log(norm(z:complex)),y)` THEN + ASM_REWRITE_TAC[RE; IM; CEXP_COMPLEX] THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM)) THEN + ASM_SIMP_TAC[EXP_LOG; COMPLEX_NORM_NZ; COMPLEX_DIV_LMUL; + COMPLEX_NORM_ZERO; CX_INJ]);; + +let CEXP_CLOG = prove + (`!z. ~(z = Cx(&0)) ==> cexp(clog z) = z`, + SIMP_TAC[CLOG_WORKS]);; + +let CLOG_CEXP = prove + (`!z. --pi < Im(z) /\ Im(z) <= pi ==> clog(cexp z) = z`, + REPEAT STRIP_TAC THEN REWRITE_TAC[clog] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `w:complex` THEN + EQ_TAC THEN ASM_SIMP_TAC[] THEN REWRITE_TAC[CEXP_EQ] THEN + REWRITE_TAC[IMP_CONJ] THEN DISCH_THEN(X_CHOOSE_THEN `n:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_MUL_RZERO; COMPLEX_ADD_RID; COMPLEX_MUL_LZERO] THEN + SUBGOAL_THEN `abs(n * pi) < &1 * pi` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_RMUL_EQ; PI_POS; REAL_ABS_PI] THEN + ASM_MESON_TAC[REAL_ABS_INTEGER_LEMMA; REAL_NOT_LT]);; + +let CLOG_EQ = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> (clog w = clog z <=> w = z)`, + MESON_TAC[CEXP_CLOG]);; + +let CLOG_UNIQUE = prove + (`!w z. --pi < Im(z) /\ Im(z) <= pi /\ cexp(z) = w ==> clog w = z`, + MESON_TAC[CLOG_CEXP]);; + +let RE_CLOG = prove + (`!z. ~(z = Cx(&0)) ==> Re(clog z) = log(norm z)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM + (MP_TAC o AP_TERM `norm:complex->real` o MATCH_MP CEXP_CLOG) THEN + REWRITE_TAC[NORM_CEXP] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[LOG_EXP]);; + +let EXISTS_COMPLEX_ROOT = prove + (`!a n. ~(n = 0) ==> ?z. z pow n = a`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a = Cx(&0)` THENL + [EXISTS_TAC `Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_POW_ZERO]; + EXISTS_TAC `cexp(clog(a) / Cx(&n))` THEN REWRITE_TAC[GSYM CEXP_N] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ; CEXP_CLOG]]);; + +(* ------------------------------------------------------------------------- *) +(* Derivative of clog away from the branch cut. *) +(* ------------------------------------------------------------------------- *) + +let HAS_COMPLEX_DERIVATIVE_CLOG = prove + (`!z. (Im(z) = &0 ==> &0 < Re(z)) + ==> (clog has_complex_derivative inv(z)) (at z)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INVERSE_STRONG_X THEN + EXISTS_TAC `cexp` THEN + EXISTS_TAC `{w | --pi < Im(w) /\ Im(w) < pi}` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_CASES_TAC `z = Cx(&0)` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN + ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CEXP; CEXP_CLOG; CLOG_CEXP; REAL_LT_IMP_LE] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN + MATCH_MP_TAC OPEN_INTER THEN + REWRITE_TAC[REAL_ARITH `--x < w <=> w > --x`] THEN + REWRITE_TAC[OPEN_HALFSPACE_IM_LT; OPEN_HALFSPACE_IM_GT]; + ASM_SIMP_TAC[CLOG_WORKS]; + ASM_SIMP_TAC[CLOG_WORKS; REAL_LT_LE] THEN + DISCH_THEN(fun th -> + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o MATCH_MP CEXP_CLOG) THEN + POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN + ASM_REWRITE_TAC[EULER; COS_PI; SIN_PI; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[COMPLEX_ADD_RID; CX_NEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[COMPLEX_MUL_RID; IM_NEG; IM_CX; RE_NEG; RE_CX] THEN + MP_TAC(SPEC `Re(clog z)` REAL_EXP_POS_LT) THEN REAL_ARITH_TAC; + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_CEXP; CEXP_CLOG]]);; + +let COMPLEX_DIFFERENTIABLE_AT_CLOG = prove + (`!z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CLOG]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CLOG = prove + (`!s z. (Im(z) = &0 ==> &0 < Re(z)) + ==> clog complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CLOG]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + HAS_COMPLEX_DERIVATIVE_CLOG)));; + +let CONTINUOUS_AT_CLOG = prove + (`!z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CLOG; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CLOG = prove + (`!s z. (Im(z) = &0 ==> &0 < Re(z)) ==> clog continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CLOG]);; + +let CONTINUOUS_ON_CLOG = prove + (`!s. (!z. z IN s /\ Im(z) = &0 ==> &0 < Re(z)) ==> clog continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CLOG]);; + +let HOLOMORPHIC_ON_CLOG = prove + (`!s. (!z. z IN s /\ Im(z) = &0 ==> &0 < Re(z)) ==> clog holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CLOG]);; + +(* ------------------------------------------------------------------------- *) +(* Relation to real log. *) +(* ------------------------------------------------------------------------- *) + +let CX_LOG = prove + (`!z. &0 < z ==> Cx(log z) = clog(Cx z)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [SYM(MATCH_MP EXP_LOG th)]) THEN + REWRITE_TAC[CX_EXP] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_CX] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Quadrant-type results for clog. *) +(* ------------------------------------------------------------------------- *) + +let RE_CLOG_POS_LT = prove + (`!z. ~(z = Cx(&0)) ==> (abs(Im(clog z)) < pi / &2 <=> &0 < Re(z))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) + MP_TAC) THEN + SIMP_TAC[RE_CEXP; REAL_LT_MUL_EQ; REAL_EXP_POS_LT] THEN + SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `--p < x /\ x <= p + ==> --(p / &2) < x /\ x < p / &2 \/ + --(p / &2) <= p + x /\ p + x <= p / &2 \/ + --(p / &2) <= x - p /\ x - p <= p / &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI) ORELSE + FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI_LE)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[COS_ADD; COS_SUB; COS_PI; SIN_PI] THEN + REAL_ARITH_TAC);; + +let RE_CLOG_POS_LE = prove + (`!z. ~(z = Cx(&0)) ==> (abs(Im(clog z)) <= pi / &2 <=> &0 <= Re(z))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) + MP_TAC) THEN + SIMP_TAC[RE_CEXP; REAL_LE_MUL_EQ; REAL_EXP_POS_LT] THEN + SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `--p < x /\ x <= p + ==> --(p / &2) <= x /\ x <= p / &2 \/ + --(p / &2) < p + x /\ p + x < p / &2 \/ + --(p / &2) < x - p /\ x - p < p / &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI) ORELSE + FIRST_ASSUM(MP_TAC o MATCH_MP COS_POS_PI_LE)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[COS_ADD; COS_SUB; COS_PI; SIN_PI] THEN + REAL_ARITH_TAC);; + +let IM_CLOG_POS_LT = prove + (`!z. ~(z = Cx(&0)) ==> (&0 < Im(clog z) /\ Im(clog z) < pi <=> &0 < Im(z))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) + MP_TAC) THEN + SIMP_TAC[IM_CEXP; REAL_LT_MUL_EQ; REAL_EXP_POS_LT] THEN + SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `--p < x /\ x <= p + ==> &0 < x /\ x < p \/ + &0 <= x + p /\ x + p <= p \/ + &0 <= x - p /\ x - p <= p`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI) ORELSE + FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI_LE)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[SIN_ADD; SIN_SUB; COS_PI; SIN_PI] THEN + REAL_ARITH_TAC);; + +let IM_CLOG_POS_LE = prove + (`!z. ~(z = Cx(&0)) ==> (&0 <= Im(clog z) <=> &0 <= Im(z))`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CLOG_WORKS) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SYM th]) + MP_TAC) THEN + SIMP_TAC[IM_CEXP; REAL_LE_MUL_EQ; REAL_EXP_POS_LT] THEN + SPEC_TAC(`clog z`,`z:complex`) THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `--p < x /\ x <= p + ==> &0 <= x /\ x <= p \/ + &0 < x + p /\ x + p < p \/ + &0 < p - x /\ p - x < p`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI) ORELSE + FIRST_ASSUM(MP_TAC o MATCH_MP SIN_POS_PI_LE)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[SIN_ADD; SIN_SUB; COS_PI; SIN_PI] THEN + REAL_ARITH_TAC);; + +let RE_CLOG_POS_LT_IMP = prove + (`!z. &0 < Re(z) ==> abs(Im(clog z)) < pi / &2`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_SIMP_TAC[RE_CLOG_POS_LT; RE_CX; REAL_LT_REFL]);; + +let IM_CLOG_POS_LT_IMP = prove + (`!z. &0 < Im(z) ==> &0 < Im(clog z) /\ Im(clog z) < pi`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_SIMP_TAC[IM_CLOG_POS_LT; IM_CX; REAL_LT_REFL]);; + +let IM_CLOG_EQ_0 = prove + (`!z. ~(z = Cx(&0)) ==> (Im(clog z) = &0 <=> &0 < Re(z) /\ Im(z) = &0)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [REAL_ARITH `z = &0 <=> &0 <= z /\ ~(&0 < z)`] THEN + ASM_SIMP_TAC[GSYM RE_CLOG_POS_LT; GSYM IM_CLOG_POS_LE; + GSYM IM_CLOG_POS_LT] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let IM_CLOG_EQ_PI = prove + (`!z. ~(z = Cx(&0)) ==> (Im(clog z) = pi <=> Re(z) < &0 /\ Im(z) = &0)`, + SIMP_TAC[PI_POS; RE_CLOG_POS_LE; IM_CLOG_POS_LE; IM_CLOG_POS_LT; CLOG_WORKS; + REAL_ARITH `&0 < pi ==> (x = pi <=> (&0 <= x /\ x <= pi) /\ + ~(abs x <= pi / &2) /\ ~(&0 < x /\ x < pi))`] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Various properties. *) +(* ------------------------------------------------------------------------- *) + +let CNJ_CLOG = prove + (`!z. (Im z = &0 ==> &0 < Re z) ==> cnj(clog z) = clog(cnj z)`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL] THEN + DISCH_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + REWRITE_TAC[GSYM CNJ_CEXP] THEN + ASM_SIMP_TAC[CEXP_CLOG; CNJ_EQ_CX; IM_CNJ] THEN + MATCH_MP_TAC(REAL_ARITH + `(--p < x /\ x <= p) /\ (--p < y /\ y <= p) /\ + ~(x = p /\ y = p) + ==> abs(--x - y) < &2 * p`) THEN + ASM_SIMP_TAC[IM_CLOG_EQ_PI; CNJ_EQ_CX; CLOG_WORKS] THEN + ASM_REAL_ARITH_TAC);; + +let CLOG_INV = prove + (`!z. (Im(z) = &0 ==> &0 < Re z) ==> clog(inv z) = --(clog z)`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL] THEN + STRIP_TAC THEN MATCH_MP_TAC COMPLEX_EQ_CEXP THEN + ASM_SIMP_TAC[CEXP_CLOG; CEXP_NEG; COMPLEX_INV_EQ_0] THEN + REWRITE_TAC[IM_NEG; REAL_SUB_RNEG] THEN + MATCH_MP_TAC(REAL_ARITH + `--pi < x /\ x <= pi /\ --pi < y /\ y <= pi /\ + ~(x = pi /\ y = pi) ==> abs(x + y) < &2 * pi`) THEN + ASM_SIMP_TAC[CLOG_WORKS; COMPLEX_INV_EQ_0; IM_CLOG_EQ_PI] THEN + UNDISCH_TAC `Im z = &0 ==> &0 < Re z` THEN + ASM_CASES_TAC `Im z = &0` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let CLOG_1 = prove + (`clog(Cx(&1)) = Cx(&0)`, + REWRITE_TAC[GSYM CEXP_0] THEN MATCH_MP_TAC CLOG_CEXP THEN + REWRITE_TAC[IM_CX] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let CLOG_NEG_1 = prove + (`clog(--Cx(&1)) = ii * Cx pi`, + MATCH_MP_TAC COMPLEX_EQ_CEXP THEN REWRITE_TAC[GSYM CX_NEG] THEN + SIMP_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN; IM_MUL_II; IM_CX; RE_CX] THEN + REWRITE_TAC[COS_PI; SIN_PI; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID] THEN + SIMP_TAC[CLOG_WORKS; COMPLEX_RING `~(Cx(-- &1) = Cx(&0))`; + REAL_ARITH `--pi < x /\ x <= pi ==> abs(x - pi) < &2 * pi`]);; + +let CLOG_II = prove + (`clog ii = ii * Cx(pi / &2)`, + MP_TAC(SPEC `ii * Cx(pi / &2)` CLOG_CEXP) THEN + SIMP_TAC[CEXP_EULER; GSYM CX_COS; GSYM CX_SIN; IM_MUL_II; IM_CX; RE_CX] THEN + REWRITE_TAC[COS_PI2; SIN_PI2] THEN ANTS_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_ADD_LID; COMPLEX_MUL_RID]]);; + +let CLOG_NEG_II = prove + (`clog(--ii) = --ii * Cx(pi / &2)`, + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_FIELD `--ii = inv ii`] THEN + SIMP_TAC[CLOG_INV; RE_II; IM_II; REAL_OF_NUM_EQ; ARITH; CLOG_II] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG]);; + +(* ------------------------------------------------------------------------- *) +(* Relation between square root and exp/log, and hence its derivative. *) +(* ------------------------------------------------------------------------- *) + +let CSQRT_CEXP_CLOG = prove + (`!z. ~(z = Cx(&0)) ==> csqrt z = cexp(clog(z) / Cx(&2))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CSQRT_UNIQUE THEN + REWRITE_TAC[GSYM CEXP_N; RE_CEXP; IM_CEXP] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; CX_INJ; REAL_OF_NUM_EQ; ARITH; CEXP_CLOG] THEN + SIMP_TAC[REAL_LT_MUL_EQ; REAL_EXP_POS_LT; REAL_LE_MUL_EQ] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_EXP_NZ; IM_DIV_CX] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o CONJUNCT2 o MATCH_MP CLOG_WORKS) THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o REWRITE_RULE[REAL_LE_LT]) THENL + [DISJ1_TAC THEN MATCH_MP_TAC COS_POS_PI THEN + ASM_REAL_ARITH_TAC; + DISJ2_TAC THEN ASM_REWRITE_TAC[COS_PI2; SIN_PI2; REAL_POS]]);; + +let CNJ_CSQRT = prove + (`!z. (Im z = &0 ==> &0 <= Re(z)) ==> cnj(csqrt z) = csqrt(cnj z)`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[CSQRT_0; CNJ_CX] THEN DISCH_TAC THEN + SUBGOAL_THEN `Im z = &0 ==> &0 < Re(z)` ASSUME_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[COMPLEX_EQ; IM_CX; RE_CX] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_LT_REFL] THEN + ASM_SIMP_TAC[CSQRT_CEXP_CLOG; CNJ_CEXP; CNJ_CLOG; + CNJ_DIV; CNJ_EQ_CX; CNJ_CX]]);; + +let HAS_COMPLEX_DERIVATIVE_CSQRT = prove + (`!z. (Im z = &0 ==> &0 < Re(z)) + ==> (csqrt has_complex_derivative inv(Cx(&2) * csqrt z)) (at z)`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[IM_CX; RE_CX; REAL_LT_REFL] THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`\z. cexp(clog(z) / Cx(&2))`; `norm(z:complex)`] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CSQRT_CEXP_CLOG THEN REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + COMPLEX_DIFF_TAC THEN ASM_SIMP_TAC[GSYM CSQRT_CEXP_CLOG] THEN + UNDISCH_TAC `~(z = Cx(&0))` THEN MP_TAC(SPEC `z:complex` CSQRT) THEN + CONV_TAC COMPLEX_FIELD]);; + +let COMPLEX_DIFFERENTIABLE_AT_CSQRT = prove + (`!z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSQRT]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CSQRT = prove + (`!s z. (Im z = &0 ==> &0 < Re(z)) + ==> csqrt complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CSQRT]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + HAS_COMPLEX_DERIVATIVE_CSQRT)));; + +let CONTINUOUS_AT_CSQRT = prove + (`!z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CSQRT; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CSQRT = prove + (`!s z. (Im z = &0 ==> &0 < Re(z)) ==> csqrt continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CSQRT]);; + +let CONTINUOUS_ON_CSQRT = prove + (`!s. (!z. z IN s /\ Im z = &0 ==> &0 < Re(z)) ==> csqrt continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CSQRT]);; + +let HOLOMORPHIC_ON_CSQRT = prove + (`!s. (!z. z IN s /\ Im(z) = &0 ==> &0 < Re(z)) ==> csqrt holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CSQRT]);; + +let CONTINUOUS_WITHIN_CSQRT_POSREAL = prove + (`!z. csqrt continuous (at z within {w | real w /\ &0 <= Re(w)})`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `Im z = &0 ==> &0 < Re(z)` THENL + [ASM_SIMP_TAC[CONTINUOUS_WITHIN_CSQRT]; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NOT_IMP; REAL_NOT_LT] THEN + REWRITE_TAC[REAL_ARITH `x <= &0 <=> x < &0 \/ x = &0`] THEN STRIP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_REAL_SET; CLOSED_INTER; IN_INTER; IN_ELIM_THM; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `z = Cx(&0)` SUBST_ALL_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX]; ALL_TAC] THEN + REWRITE_TAC[continuous_within] THEN + REWRITE_TAC[IN_ELIM_THM; IMP_CONJ; FORALL_REAL; RE_CX] THEN + SIMP_TAC[GSYM CX_SQRT; REAL_LE_REFL] THEN + SIMP_TAC[dist; GSYM CX_SUB; COMPLEX_NORM_CX; SQRT_0; REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN EXISTS_TAC `(e:real) pow 2` THEN + ASM_SIMP_TAC[REAL_POW_LT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL + [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[real_abs; SQRT_POS_LE]] THEN + MATCH_MP_TAC SQRT_MONO_LT THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Complex powers. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("cpow",(24,"left"));; + +let cpow = new_definition + `w cpow z = if w = Cx(&0) then Cx(&0) + else cexp(z * clog w)`;; + +let CPOW_0 = prove + (`!z. Cx(&0) cpow z = Cx(&0)`, + REWRITE_TAC[cpow]);; + +let CPOW_N = prove + (`!z. z cpow (Cx(&n)) = if z = Cx(&0) then Cx(&0) else z pow n`, + GEN_TAC THEN REWRITE_TAC[cpow] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[CEXP_N; CEXP_CLOG]);; + +let CPOW_1 = prove + (`!z. Cx(&1) cpow z = Cx(&1)`, + REWRITE_TAC[cpow; CX_INJ; REAL_OF_NUM_EQ; ARITH_EQ; CLOG_1] THEN + REWRITE_TAC[CEXP_0; COMPLEX_MUL_RZERO]);; + +let CPOW_ADD = prove + (`!w z1 z2. w cpow (z1 + z2) = w cpow z1 * w cpow z2`, + REPEAT GEN_TAC THEN REWRITE_TAC[cpow] THEN + ASM_CASES_TAC `w = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[COMPLEX_ADD_RDISTRIB; CEXP_ADD]);; + +let CPOW_SUC = prove + (`!w z. w cpow (z + Cx(&1)) = w * w cpow z`, + REPEAT GEN_TAC THEN REWRITE_TAC[CPOW_ADD; CPOW_N] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[COMPLEX_POW_1; COMPLEX_MUL_SYM]);; + +let CPOW_NEG = prove + (`!w z. w cpow (--z) = inv(w cpow z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cpow] THEN ASM_CASES_TAC `w = Cx(&0)` THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_INV_0] THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; CEXP_NEG]);; + +let CPOW_SUB = prove + (`!w z1 z2. w cpow (z1 - z2) = w cpow z1 / w cpow z2`, + REWRITE_TAC[complex_sub; complex_div; CPOW_ADD; CPOW_NEG]);; + +let CEXP_MUL_CPOW = prove + (`!w z. --pi < Im w /\ Im w <= pi ==> cexp(w * z) = cexp(w) cpow z`, + SIMP_TAC[cpow; CEXP_NZ; CLOG_CEXP] THEN + REWRITE_TAC[COMPLEX_MUL_SYM]);; + +let CPOW_EQ_0 = prove + (`!w z. w cpow z = Cx(&0) <=> w = Cx(&0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cpow] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[CEXP_NZ]);; + +let NORM_CPOW_REAL = prove + (`!w z. real w /\ &0 < Re w ==> norm(w cpow z) = exp(Re z * log(Re w))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[RE_CX]) THEN + ASM_SIMP_TAC[cpow; CX_INJ; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[NORM_CEXP; GSYM CX_LOG; RE_MUL_CX; RE_CX]);; + +let CPOW_REAL_REAL = prove + (`!w z. real w /\ real z /\ &0 < Re w + ==> w cpow z = Cx(exp(Re z * log(Re w)))`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL])) THEN + RULE_ASSUM_TAC(REWRITE_RULE[RE_CX]) THEN + ASM_SIMP_TAC[cpow; CX_INJ; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[NORM_CEXP; GSYM CX_LOG; RE_MUL_CX; RE_CX; CX_EXP; CX_MUL]);; + +let NORM_CPOW_REAL_MONO = prove + (`!w z1 z2. real w /\ &1 < Re w + ==> (norm(w cpow z1) <= norm(w cpow z2) <=> Re(z1) <= Re(z2))`, + SIMP_TAC[NORM_CPOW_REAL; REAL_ARITH `&1 < x ==> &0 < x`] THEN + SIMP_TAC[REAL_EXP_MONO_LE; REAL_LE_RMUL_EQ; LOG_POS_LT]);; + +let CPOW_MUL_REAL = prove + (`!x y z. real x /\ real y /\ &0 <= Re x /\ &0 <= Re y + ==> (x * y) cpow z = x cpow z * y cpow z`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o GEN_REWRITE_RULE I [REAL])) THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; CPOW_0] THEN + ASM_SIMP_TAC[cpow; COMPLEX_ENTIRE; CX_INJ; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[GSYM CEXP_ADD; GSYM COMPLEX_ADD_LDISTRIB] THEN + ASM_SIMP_TAC[GSYM CX_LOG; GSYM CX_ADD; GSYM CX_MUL; REAL_LT_MUL] THEN + ASM_SIMP_TAC[LOG_MUL]);; + +let HAS_COMPLEX_DERIVATIVE_CPOW = prove + (`!s z. (Im z = &0 ==> &0 < Re z) + ==> ((\z. z cpow s) has_complex_derivative + (s * z cpow (s - Cx(&1)))) (at z)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[IM_CX; RE_CX; REAL_LT_REFL] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[cpow] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_TRANSFORM_AT THEN + MAP_EVERY EXISTS_TAC [`\z. cexp (s * clog z)`; `norm(z:complex)`] THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN + REWRITE_TAC[COMPLEX_SUB_LZERO; NORM_NEG; REAL_LT_REFL]; + COMPLEX_DIFF_TAC THEN ASM_REWRITE_TAC[CEXP_SUB; COMPLEX_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_MUL_LID] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (GEN `s:complex` + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + (SPEC `s:complex` HAS_COMPLEX_DERIVATIVE_CPOW)))));; + +let HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT = prove + (`!w z. ~(w = Cx(&0)) + ==> ((\z. w cpow z) has_complex_derivative clog(w) * w cpow z) (at z)`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[cpow] THEN + COMPLEX_DIFF_TAC THEN REWRITE_TAC[COMPLEX_MUL_LID]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (GEN `s:complex` + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + (SPEC `s:complex` HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT)))));; + +let COMPLEX_DIFFERENTIABLE_CPOW_RIGHT = prove + (`!w z. (\z. w cpow z) complex_differentiable (at z)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `w = Cx(&0)` THENL + [ASM_REWRITE_TAC[cpow; COMPLEX_DIFFERENTIABLE_CONST]; + REWRITE_TAC[complex_differentiable] THEN + ASM_MESON_TAC[HAS_COMPLEX_DERIVATIVE_CPOW_RIGHT]]);; + +let HOLOMORPHIC_ON_CPOW_RIGHT = prove + (`!w f s. f holomorphic_on s + ==> (\z. w cpow (f z)) holomorphic_on s`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC HOLOMORPHIC_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[holomorphic_on; GSYM complex_differentiable] THEN + ASM_SIMP_TAC[COMPLEX_DIFFERENTIABLE_CPOW_RIGHT; + COMPLEX_DIFFERENTIABLE_AT_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Product rule. *) +(* ------------------------------------------------------------------------- *) + +let CLOG_MUL = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> clog(w * z) = + if Im(clog w + clog z) <= --pi then + (clog(w) + clog(z)) + ii * Cx(&2 * pi) + else if Im(clog w + clog z) > pi then + (clog(w) + clog(z)) - ii * Cx(&2 * pi) + else clog(w) + clog(z)`, + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC CLOG_UNIQUE THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_SUB; CEXP_EULER; CEXP_CLOG; CONJ_ASSOC; + GSYM CX_SIN; GSYM CX_COS; COS_NPI; SIN_NPI] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + TRY(CONJ_TAC THENL [ALL_TAC; CONV_TAC COMPLEX_FIELD]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOG_WORKS)) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[IM_ADD; IM_SUB; IM_MUL_II; RE_CX] THEN + REAL_ARITH_TAC);; + +let CLOG_MUL_SIMPLE = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) /\ + --pi < Im(clog(w)) + Im(clog(z)) /\ + Im(clog(w)) + Im(clog(z)) <= pi + ==> clog(w * z) = clog(w) + clog(z)`, + SIMP_TAC[CLOG_MUL; IM_ADD] THEN REAL_ARITH_TAC);; + +let CLOG_MUL_CX = prove + (`(!x z. &0 < x /\ ~(z = Cx(&0)) ==> clog(Cx x * z) = Cx(log x) + clog z) /\ + (!x z. &0 < x /\ ~(z = Cx(&0)) ==> clog(z * Cx x) = clog z + Cx(log x))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CX_LOG] THEN + MATCH_MP_TAC CLOG_MUL_SIMPLE THEN + ASM_SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; GSYM CX_LOG] THEN + ASM_SIMP_TAC[IM_CX; REAL_ADD_LID; REAL_ADD_RID; CLOG_WORKS]);; + +let CLOG_NEG = prove + (`!z. ~(z = Cx(&0)) + ==> clog(--z) = if Im(z) <= &0 /\ ~(Re(z) < &0 /\ Im(z) = &0) + then clog(z) + ii * Cx(pi) + else clog(z) - ii * Cx(pi)`, + REPEAT STRIP_TAC THEN + SUBST1_TAC(SIMPLE_COMPLEX_ARITH `--z = --Cx(&1) * z`) THEN + ASM_SIMP_TAC[CLOG_MUL; COMPLEX_RING `~(--Cx(&1) = Cx(&0))`] THEN + REWRITE_TAC[CLOG_NEG_1; IM_ADD; IM_MUL_II; RE_CX] THEN + ASM_SIMP_TAC[CLOG_WORKS; REAL_ARITH + `--p < x /\ x <= p ==> ~(p + x <= --p)`] THEN + REWRITE_TAC[REAL_ARITH `p + x > p <=> &0 < x`] THEN + ASM_SIMP_TAC[GSYM IM_CLOG_EQ_PI] THEN + ONCE_REWRITE_TAC[REAL_ARITH `Im z <= &0 <=> ~(&0 < Im z)`] THEN + ASM_SIMP_TAC[GSYM IM_CLOG_POS_LT] THEN + ASM_SIMP_TAC[CLOG_WORKS; REAL_ARITH `x <= p ==> (x < p <=> ~(x = p))`] THEN + REWRITE_TAC[TAUT `~(a /\ ~b) /\ ~b <=> ~a /\ ~b`] THEN + ASM_CASES_TAC `Im(clog z) = pi` THEN ASM_REWRITE_TAC[PI_POS] THEN + ASM_CASES_TAC `&0 < Im(clog z)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING);; + +let CLOG_MUL_II = prove + (`!z. ~(z = Cx(&0)) + ==> clog(ii * z) = if &0 <= Re(z) \/ Im(z) < &0 + then clog(z) + ii * Cx(pi / &2) + else clog(z) - ii * Cx(&3 * pi / &2)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOG_MUL; II_NZ; CLOG_II] THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX] THEN + ASM_SIMP_TAC[CLOG_WORKS; REAL_ARITH + `--p < x /\ x <= p ==> ~(p / &2 + x <= --p)`] THEN + REWRITE_TAC[REAL_ARITH `p / &2 + x > p <=> p / &2 < x`] THEN + REWRITE_TAC[REAL_ARITH `Im z < &0 <=> ~(&0 <= Im z)`] THEN + ASM_SIMP_TAC[GSYM RE_CLOG_POS_LE; GSYM IM_CLOG_POS_LE] THEN + MATCH_MP_TAC(MESON[] + `(p <=> ~q) /\ x = a /\ y = b + ==> ((if p then x else y) = (if q then b else a))`) THEN + CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + REWRITE_TAC[CX_MUL; CX_DIV] THEN CONV_TAC COMPLEX_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Unwinding number gives another version of log-product formula. *) +(* Note that in this special case the unwinding number is -1, 0 or 1. *) +(* ------------------------------------------------------------------------- *) + +let unwinding = new_definition + `unwinding(z) = (z - clog(cexp z)) / (Cx(&2 * pi) * ii)`;; + +let UNWINDING_2PI = prove + (`Cx(&2 * pi) * ii * unwinding(z) = z - clog(cexp z)`, + REWRITE_TAC[unwinding; COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC COMPLEX_DIV_LMUL THEN + REWRITE_TAC[COMPLEX_ENTIRE; CX_INJ; II_NZ] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let CLOG_MUL_UNWINDING = prove + (`!w z. ~(w = Cx(&0)) /\ ~(z = Cx(&0)) + ==> clog(w * z) = + clog(w) + clog(z) - + Cx(&2 * pi) * ii * unwinding(clog w + clog z)`, + REWRITE_TAC[UNWINDING_2PI; + COMPLEX_RING `w + z - ((w + z) - c) = c:complex`] THEN + ASM_SIMP_TAC[CEXP_ADD; CEXP_CLOG]);; + +(* ------------------------------------------------------------------------- *) +(* Complex arctangent (branch cut gives standard bounds in real case). *) +(* ------------------------------------------------------------------------- *) + +let catn = new_definition + `catn z = (ii / Cx(&2)) * clog((Cx(&1) - ii * z) / (Cx(&1) + ii * z))`;; + +let CATN_0 = prove + (`catn(Cx(&0)) = Cx(&0)`, + REWRITE_TAC[catn; COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO; COMPLEX_ADD_RID] THEN + REWRITE_TAC[COMPLEX_DIV_1; CLOG_1; COMPLEX_MUL_RZERO]);; + +let IM_COMPLEX_DIV_LEMMA = prove + (`!z. Im((Cx(&1) - ii * z) / (Cx(&1) + ii * z)) = &0 <=> Re z = &0`, + REWRITE_TAC[IM_COMPLEX_DIV_EQ_0] THEN + REWRITE_TAC[complex_mul; IM; RE; IM_CNJ; RE_CNJ; RE_CX; IM_CX; RE_II; IM_II; + RE_SUB; RE_ADD; IM_SUB; IM_ADD] THEN + REAL_ARITH_TAC);; + +let RE_COMPLEX_DIV_LEMMA = prove + (`!z. &0 < Re((Cx(&1) - ii * z) / (Cx(&1) + ii * z)) <=> norm(z) < &1`, + REWRITE_TAC[RE_COMPLEX_DIV_GT_0; NORM_LT_SQUARE; REAL_LT_01] THEN + REWRITE_TAC[GSYM NORM_POW_2; COMPLEX_SQNORM] THEN + REWRITE_TAC[complex_mul; IM; RE; IM_CNJ; RE_CNJ; RE_CX; IM_CX; RE_II; IM_II; + RE_SUB; RE_ADD; IM_SUB; IM_ADD] THEN + REAL_ARITH_TAC);; + +let CTAN_CATN = prove + (`!z. ~(z pow 2 = --Cx(&1)) ==> ctan(catn z) = z`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[catn; ctan; csin; ccos; + COMPLEX_RING `--i * i / Cx(&2) * z = --(i * i) / Cx(&2) * z`; + COMPLEX_RING `i * i / Cx(&2) * z = (i * i) / Cx(&2) * z`] THEN + REWRITE_TAC[COMPLEX_POW_II_2; GSYM COMPLEX_POW_2] THEN + REWRITE_TAC[COMPLEX_RING `--Cx(&1) / Cx(&2) * x = --(Cx(&1) / Cx(&2) * x)`; + CEXP_NEG] THEN + SUBGOAL_THEN + `~(cexp(Cx(&1) / Cx(&2) * + (clog((Cx(&1) - ii * z) / (Cx(&1) + ii * z)))) pow 2 = --Cx(&1))` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM CEXP_N; CEXP_SUB; COMPLEX_RING + `Cx(&2) * Cx(&1) / Cx(&2) * z = z`] THEN + ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_POW_II_2; + COMPLEX_FIELD `~(w = Cx(&0)) /\ ~(z = Cx(&0)) ==> ~(w / z = Cx(&0))`; + COMPLEX_FIELD `~(w = Cx(&0)) ==> (x / w = y <=> x = y * w)`; + COMPLEX_FIELD + `ii pow 2 = --Cx(&1) /\ ~(z pow 2 = --Cx(&1)) + ==> ~(Cx(&1) - ii * z = Cx(&0)) /\ ~(Cx(&1) + ii * z = Cx(&0))`] THEN + POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_RING `-- --Cx (&1) / Cx (&2) = Cx(&1) / Cx(&2)`] THEN + ASM_SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(z = Cx(&0)) /\ ~(z pow 2 = --Cx(&1)) + ==> ((inv(z) - z) / (Cx(&2) * ii)) / ((inv(z) + z) / Cx(&2)) = + inv ii * ((Cx(&1) - z pow 2) / (Cx(&1) + z pow 2))`] THEN + ASM_SIMP_TAC[GSYM CEXP_N; CEXP_SUB; + COMPLEX_RING `Cx(&2) * Cx(&1) / Cx(&2) * z = z`] THEN + ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_FIELD + `~(z pow 2 = --Cx(&1)) + ==> ~((Cx(&1) - ii * z) / (Cx(&1) + ii * z) = Cx(&0))`] THEN + UNDISCH_TAC `~(z pow 2 = --Cx(&1))` THEN CONV_TAC COMPLEX_FIELD);; + +let CATN_CTAN = prove + (`!z. abs(Re z) < pi / &2 ==> catn(ctan z) = z`, + REPEAT STRIP_TAC THEN REWRITE_TAC[catn; ctan; csin; ccos] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `ii * (a / (Cx(&2) * ii)) / (b / Cx(&2)) = a / b`] THEN + SIMP_TAC[COMPLEX_FIELD + `ii / Cx(&2) * x = y <=> x = Cx(&2) * --(ii * y)`] THEN + SUBGOAL_THEN `~(cexp(ii * z) pow 2 = --Cx(&1))` ASSUME_TAC THENL + [SUBGOAL_THEN `--Cx(&1) = cexp(ii * Cx pi)` SUBST1_TAC THENL + [REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + REWRITE_TAC[GSYM CEXP_N; CEXP_EQ] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `Im`) THEN + REWRITE_TAC[IM_MUL_CX; IM_MUL_II; IM_ADD; RE_CX; IM_II; REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(z) < p / &2 /\ (w = &0 \/ abs(w) >= &2 * p) + ==> ~(&2 * z = p + w)`) THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_PI; REAL_ABS_NUM] THEN + SIMP_TAC[real_ge; REAL_MUL_ASSOC; REAL_LE_RMUL_EQ; PI_POS] THEN + REWRITE_TAC[REAL_ENTIRE; PI_NZ] THEN + MP_TAC(SPEC `n:real` REAL_ABS_INTEGER_LEMMA) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[CEXP_NEG; CEXP_NZ; COMPLEX_MUL_LNEG; COMPLEX_FIELD + `~(w = Cx(&0)) /\ ~(w pow 2 = --Cx(&1)) + ==> (Cx(&1) - (w - inv w) / (w + inv w)) / + (Cx(&1) + (w - inv w) / (w + inv w)) = + inv(w) pow 2`] THEN + REWRITE_TAC[GSYM CEXP_N; GSYM CEXP_NEG] THEN + MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_MUL_CX; IM_NEG; IM_MUL_II] THEN + ASM_REAL_ARITH_TAC]);; + +let RE_CATN_BOUNDS = prove + (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> abs(Re(catn z)) < pi / &2`, + REWRITE_TAC[catn; complex_div; GSYM CX_INV; GSYM COMPLEX_MUL_ASSOC] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[RE_MUL_II; IM_MUL_CX] THEN + MATCH_MP_TAC(REAL_ARITH `abs x < p ==> abs(--(inv(&2) * x)) < p / &2`) THEN + MATCH_MP_TAC(REAL_ARITH `(--p < x /\ x <= p) /\ ~(x = p) ==> abs x < p`) THEN + SUBGOAL_THEN `~(z = ii) /\ ~(z = --ii)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN SUBST1_TAC th) THEN + REWRITE_TAC[RE_II; IM_II; RE_NEG; IM_NEG] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM complex_div] THEN CONJ_TAC THENL + [SUBGOAL_THEN `~((Cx(&1) - ii * z) / (Cx(&1) + ii * z) = Cx(&0))` + (fun th -> MESON_TAC[th; CLOG_WORKS]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPEC `clog((Cx(&1) - ii * z) / (Cx(&1) + ii * z))` EULER) THEN + ASM_REWRITE_TAC[SIN_PI; COS_PI; CX_NEG] THEN + REWRITE_TAC[COMPLEX_RING + `x = y * (--Cx(&1) + z * Cx(&0)) <=> x + y = Cx(&0)`] THEN + REWRITE_TAC[CX_EXP] THEN + ASM_SIMP_TAC[CEXP_CLOG; COMPLEX_FIELD + `~(z = ii) /\ ~(z = --ii) + ==> ~((Cx(&1) - ii * z) / (Cx(&1) + ii * z) = Cx(&0))`] THEN + REWRITE_TAC[GSYM CX_EXP] THEN DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN + REWRITE_TAC[IM_ADD; IM_CX; REAL_ADD_RID; IM_COMPLEX_DIV_LEMMA] THEN + DISCH_TAC THEN UNDISCH_TAC `Re z = &0 ==> abs (Im z) < &1` THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `ii * z = --Cx(Im z)` SUBST_ALL_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_EQ; RE_NEG; IM_NEG; RE_MUL_II; IM_MUL_II; + RE_CX; IM_CX; REAL_NEG_0]; + ALL_TAC] THEN + UNDISCH_TAC + `Im(clog((Cx(&1) - --Cx(Im z)) / (Cx(&1) + --Cx(Im z)))) = pi` THEN + REWRITE_TAC[COMPLEX_SUB_RNEG; GSYM complex_sub] THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; GSYM CX_DIV] THEN + SUBGOAL_THEN `&0 < (&1 + Im z) / (&1 - Im z)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[GSYM CX_LOG; IM_CX; PI_NZ]]);; + +let HAS_COMPLEX_DERIVATIVE_CATN = prove + (`!z. (Re z = &0 ==> abs(Im z) < &1) + ==> (catn has_complex_derivative inv(Cx(&1) + z pow 2)) (at z)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(z = ii) /\ ~(z = --ii)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN SUBST1_TAC th) THEN + REWRITE_TAC[RE_II; IM_II; RE_NEG; IM_NEG] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o LAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[catn] THEN COMPLEX_DIFF_TAC THEN + REWRITE_TAC[RE_SUB; RE_ADD; IM_SUB; IM_ADD; + RE_CX; RE_MUL_II; IM_CX; IM_MUL_II] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[IM_COMPLEX_DIV_LEMMA; RE_COMPLEX_DIV_LEMMA] THEN + SIMP_TAC[complex_norm] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REWRITE_TAC[REAL_ADD_LID; POW_2_SQRT_ABS]; + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC COMPLEX_FIELD]);; + +let COMPLEX_DIFFERENTIABLE_AT_CATN = prove + (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> catn complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CATN]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CATN = prove + (`!s z. (Re z = &0 ==> abs(Im z) < &1) + ==> catn complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CATN]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + HAS_COMPLEX_DERIVATIVE_CATN)));; + +let CONTINUOUS_AT_CATN = prove + (`!z. (Re z = &0 ==> abs(Im z) < &1) ==> catn continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CATN; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CATN = prove + (`!s z. (Re z = &0 ==> abs(Im z) < &1) ==> catn continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CATN]);; + +let CONTINUOUS_ON_CATN = prove + (`!s. (!z. z IN s /\ Re z = &0 ==> abs(Im z) < &1) ==> catn continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CATN]);; + +let HOLOMORPHIC_ON_CATN = prove + (`!s. (!z. z IN s /\ Re z = &0 ==> abs(Im z) < &1) ==> catn holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CATN]);; + +(* ------------------------------------------------------------------------- *) +(* Real arctangent. *) +(* ------------------------------------------------------------------------- *) + +let atn = new_definition + `atn(x) = Re(catn(Cx x))`;; + +let CX_ATN = prove + (`!x. Cx(atn x) = catn(Cx x)`, + GEN_TAC THEN REWRITE_TAC[atn; catn; GSYM REAL; real] THEN + REWRITE_TAC[complex_div; IM_MUL_II; GSYM CX_INV; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[RE_MUL_CX; REAL_ARITH `inv(&2) * x = &0 <=> x = &0`] THEN + MATCH_MP_TAC NORM_CEXP_IMAGINARY THEN + SUBGOAL_THEN `~(Cx(&1) - ii * Cx(x) = Cx(&0)) /\ + ~(Cx(&1) + ii * Cx(x) = Cx(&0))` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN + REWRITE_TAC[RE_ADD; RE_SUB; RE_MUL_II; IM_CX; RE_CX] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + ASM_SIMP_TAC[CEXP_SUB; CEXP_CLOG; COMPLEX_FIELD + `~(a = Cx(&0)) /\ ~(b = Cx(&0)) ==> ~(a * inv b = Cx(&0))`] THEN + REWRITE_TAC[GSYM complex_div; COMPLEX_NORM_DIV] THEN + MATCH_MP_TAC(REAL_FIELD `~(b = &0) /\ a = b ==> a / b = &1`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_ZERO] THEN + MATCH_MP_TAC(MESON[COMPLEX_NORM_CNJ] `cnj a = b ==> norm a = norm b`) THEN + REWRITE_TAC[CNJ_SUB; CNJ_MUL; CNJ_MUL; CNJ_II; CNJ_CX] THEN + CONV_TAC COMPLEX_RING);; + +let ATN_TAN = prove + (`!y. tan(atn y) = y`, + GEN_TAC THEN REWRITE_TAC[tan_def; atn] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Re(ctan(catn(Cx y)))` THEN + CONJ_TAC THENL [REWRITE_TAC[GSYM CX_ATN; RE_CX]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM RE_CX] THEN AP_TERM_TAC THEN + MATCH_MP_TAC CTAN_CATN THEN MATCH_MP_TAC(COMPLEX_RING + `~(z = ii) /\ ~(z = --ii) ==> ~(z pow 2 = --Cx(&1))`) THEN + CONJ_TAC THEN DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN + REWRITE_TAC[IM_II; IM_CX; IM_NEG] THEN REAL_ARITH_TAC);; + +let ATN_BOUND = prove + (`!y. abs(atn y) < pi / &2`, + GEN_TAC THEN REWRITE_TAC[atn] THEN MATCH_MP_TAC RE_CATN_BOUNDS THEN + REWRITE_TAC[IM_CX] THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let ATN_BOUNDS = prove + (`!y. --(pi / &2) < atn(y) /\ atn(y) < (pi / &2)`, + MP_TAC ATN_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let TAN_ATN = prove + (`!x. --(pi / &2) < x /\ x < pi / &2 ==> atn(tan(x)) = x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[tan_def; atn] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Re(catn(ctan(Cx x)))` THEN + CONJ_TAC THENL [REWRITE_TAC[GSYM CX_TAN; RE_CX]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM RE_CX] THEN AP_TERM_TAC THEN + MATCH_MP_TAC CATN_CTAN THEN REWRITE_TAC[RE_CX] THEN + ASM_REAL_ARITH_TAC);; + +let ATN_0 = prove + (`atn(&0) = &0`, + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [SYM TAN_0] THEN + MATCH_MP_TAC TAN_ATN THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let ATN_1 = prove + (`atn(&1) = pi / &4`, + MP_TAC(AP_TERM `atn` TAN_PI4) THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC TAN_ATN THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let ATN_NEG = prove + (`!x. atn(--x) = --(atn x)`, + GEN_TAC THEN MP_TAC(SPEC `atn(x)` TAN_NEG) THEN REWRITE_TAC[ATN_TAN] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TAN_ATN THEN + MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN REAL_ARITH_TAC);; + +let ATN_MONO_LT = prove + (`!x y. x < y ==> atn(x) < atn(y)`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [GSYM ATN_TAN] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[REAL_NOT_LT] THEN + SIMP_TAC[TAN_MONO_LE; ATN_BOUNDS]);; + +let ATN_MONO_LT_EQ = prove + (`!x y. atn(x) < atn(y) <=> x < y`, + MESON_TAC[REAL_NOT_LE; REAL_LE_LT; ATN_MONO_LT]);; + +let ATN_MONO_LE_EQ = prove + (`!x y. atn(x) <= atn(y) <=> x <= y`, + REWRITE_TAC[GSYM REAL_NOT_LT; ATN_MONO_LT_EQ]);; + +let ATN_INJ = prove + (`!x y. (atn x = atn y) <=> (x = y)`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; ATN_MONO_LE_EQ]);; + +let ATN_POS_LT = prove + (`&0 < atn(x) <=> &0 < x`, + MESON_TAC[ATN_0; ATN_MONO_LT_EQ]);; + +let ATN_POS_LE = prove + (`&0 <= atn(x) <=> &0 <= x`, + MESON_TAC[ATN_0; ATN_MONO_LE_EQ]);; + +let ATN_LT_PI4_POS = prove + (`!x. x < &1 ==> atn(x) < pi / &4`, + SIMP_TAC[GSYM ATN_1; ATN_MONO_LT]);; + +let ATN_LT_PI4_NEG = prove + (`!x. --(&1) < x ==> --(pi / &4) < atn(x)`, + SIMP_TAC[GSYM ATN_1; GSYM ATN_NEG; ATN_MONO_LT]);; + +let ATN_LT_PI4 = prove + (`!x. abs(x) < &1 ==> abs(atn x) < pi / &4`, + GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `(&0 < x ==> &0 < y) /\ + (x < &0 ==> y < &0) /\ + ((x = &0) ==> (y = &0)) /\ + (x < a ==> y < b) /\ + (--a < x ==> --b < y) + ==> abs(x) < a ==> abs(y) < b`) THEN + SIMP_TAC[ATN_LT_PI4_POS; ATN_LT_PI4_NEG; ATN_0] THEN CONJ_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM ATN_0] THEN + SIMP_TAC[ATN_MONO_LT]);; + +let ATN_LE_PI4 = prove + (`!x. abs(x) <= &1 ==> abs(atn x) <= pi / &4`, + REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ATN_LT_PI4] THEN DISJ2_TAC THEN + FIRST_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP + (REAL_ARITH `(abs(x) = a) ==> (x = a) \/ (x = --a)`)) THEN + ASM_REWRITE_TAC[ATN_1; ATN_NEG] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_NEG] THEN + SIMP_TAC[real_abs; REAL_LT_IMP_LE; PI_POS]);; + +let COS_ATN_NZ = prove + (`!x. ~(cos(atn(x)) = &0)`, + GEN_TAC THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC COS_POS_PI THEN REWRITE_TAC[ATN_BOUNDS]);; + +let TAN_SEC = prove + (`!x. ~(cos(x) = &0) ==> (&1 + (tan(x) pow 2) = inv(cos x) pow 2)`, + MP_TAC SIN_CIRCLE THEN MATCH_MP_TAC MONO_FORALL THEN REWRITE_TAC[tan] THEN + CONV_TAC REAL_FIELD);; + +let COS_ATN = prove + (`!x. cos(atn x) = &1 / sqrt(&1 + x pow 2)`, + SIMP_TAC[COS_TAN; ATN_BOUND; ATN_TAN]);; + +let SIN_ATN = prove + (`!x. sin(atn x) = x / sqrt(&1 + x pow 2)`, + SIMP_TAC[SIN_TAN; ATN_BOUND; ATN_TAN]);; + +let ATN_ABS = prove + (`!x. atn(abs x) = abs(atn x)`, + GEN_TAC THEN REWRITE_TAC[real_abs; ATN_POS_LE] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ATN_NEG]);; + +let ATN_ADD = prove + (`!x y. abs(atn x + atn y) < pi / &2 + ==> atn(x) + atn(y) = atn((x + y) / (&1 - x * y))`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS `atn((tan(atn x) + tan(atn y)) / + (&1 - tan(atn x) * tan(atn y)))` THEN + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[ATN_TAN]] THEN + W(MP_TAC o PART_MATCH (rand o rand) TAN_ADD o rand o rand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[COS_ATN_NZ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC COS_POS_PI THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC TAN_ATN THEN ASM_REAL_ARITH_TAC]);; + +let ATN_INV = prove + (`!x. &0 < x ==> atn(inv x) = pi / &2 - atn x`, + REPEAT STRIP_TAC THEN TRANS_TAC EQ_TRANS `atn(inv(tan(atn x)))` THEN + CONJ_TAC THENL [REWRITE_TAC[ATN_TAN]; REWRITE_TAC[GSYM TAN_COT]] THEN + MATCH_MP_TAC TAN_ATN THEN REWRITE_TAC[ATN_BOUNDS; REAL_ARITH + `--(p / &2) < p / &2 - x /\ p / &2 - x < p / &2 <=> &0 < x /\ x < p`] THEN + ASM_REWRITE_TAC[ATN_POS_LT] THEN MP_TAC(SPEC `x:real` ATN_BOUNDS) THEN + ASM_REAL_ARITH_TAC);; + +let ATN_ADD_SMALL = prove + (`!x y. abs(x * y) < &1 + ==> (atn(x) + atn(y) = atn((x + y) / (&1 - x * y)))`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`x = &0`; `y = &0`] THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_SUB_RZERO; + REAL_DIV_1; REAL_ADD_LID; REAL_ADD_RID; ATN_0] THEN + MATCH_MP_TAC ATN_ADD THEN MATCH_MP_TAC(REAL_ARITH + `abs(x) < p - abs(y) \/ abs(y) < p - abs(x) ==> abs(x + y) < p`) THEN + REWRITE_TAC[GSYM ATN_ABS] THEN + ASM_SIMP_TAC[GSYM ATN_INV; REAL_ARITH `~(x = &0) ==> &0 < abs x`; + ATN_MONO_LT_EQ; REAL_ARITH `inv x = &1 / x`; REAL_LT_RDIV_EQ] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Machin-like formulas for pi. *) +(* ------------------------------------------------------------------------- *) + +let [MACHIN; MACHIN_EULER; MACHIN_GAUSS] = (CONJUNCTS o prove) + (`(&4 * atn(&1 / &5) - atn(&1 / &239) = pi / &4) /\ + (&5 * atn(&1 / &7) + &2 * atn(&3 / &79) = pi / &4) /\ + (&12 * atn(&1 / &18) + &8 * atn(&1 / &57) - &5 * atn(&1 / &239) = pi / &4)`, + REPEAT CONJ_TAC THEN CONV_TAC(ONCE_DEPTH_CONV(fun tm -> + if is_binop `( * ):real->real->real` tm + then LAND_CONV(RAND_CONV(TOP_DEPTH_CONV num_CONV)) tm + else failwith "")) THEN + REWRITE_TAC[real_sub; GSYM REAL_MUL_RNEG; GSYM ATN_NEG] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; REAL_ADD_LID] THEN + CONV_TAC(DEPTH_CONV (fun tm -> + let th1 = PART_MATCH (lhand o rand) ATN_ADD_SMALL tm in + let th2 = MP th1 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th1)))) in + CONV_RULE(RAND_CONV(RAND_CONV REAL_RAT_REDUCE_CONV)) th2)) THEN + REWRITE_TAC[ATN_1]);; + +(* ------------------------------------------------------------------------- *) +(* Some bound theorems where a bit of simple calculus is handy. *) +(* ------------------------------------------------------------------------- *) + +let ATN_ABS_LE_X = prove + (`!x. abs(atn x) <= abs x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`catn`; `\z. inv(Cx(&1) + z pow 2)`; `real`; `&1`] + COMPLEX_MVT) THEN + REWRITE_TAC[CONVEX_REAL; IN] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[real] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_AT_WITHIN THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_CATN THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[REAL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_ADD; GSYM CX_INV; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + MP_TAC(SPEC `Re z` REAL_LE_SQUARE) THEN REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o SPECL [`Cx(&0)`; `Cx(x)`]) THEN + REWRITE_TAC[GSYM CX_ATN; COMPLEX_SUB_RZERO; REAL_CX; ATN_0] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_MUL_LID]]);; + +let ATN_LE_X = prove + (`!x. &0 <= x ==> atn(x) <= x`, + MP_TAC ATN_ABS_LE_X THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let TAN_ABS_GE_X = prove + (`!x. abs(x) < pi / &2 ==> abs(x) <= abs(tan x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(atn(tan x))` THEN REWRITE_TAC[ATN_ABS_LE_X] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC TAN_ATN THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Probably not very useful, but for compatibility with old analysis theory. *) +(* ------------------------------------------------------------------------- *) + +let TAN_TOTAL = prove + (`!y. ?!x. --(pi / &2) < x /\ x < (pi / &2) /\ tan(x) = y`, + MESON_TAC[TAN_ATN; ATN_TAN; ATN_BOUNDS]);; + +let TAN_TOTAL_POS = prove + (`!y. &0 <= y ==> ?x. &0 <= x /\ x < pi / &2 /\ tan(x) = y`, + MESON_TAC[ATN_TAN; ATN_BOUNDS; ATN_POS_LE]);; + +let TAN_TOTAL_LEMMA = prove + (`!y. &0 < y ==> ?x. &0 < x /\ x < pi / &2 /\ y < tan(x)`, + REPEAT STRIP_TAC THEN EXISTS_TAC `atn(y + &1)` THEN + REWRITE_TAC[ATN_TAN; ATN_BOUNDS; ATN_POS_LT] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some slightly ad hoc lemmas useful here. *) +(* ------------------------------------------------------------------------- *) + +let RE_POW_2 = prove + (`Re(z pow 2) = Re(z) pow 2 - Im(z) pow 2`, + REWRITE_TAC[COMPLEX_POW_2; complex_mul; RE] THEN REAL_ARITH_TAC);; + +let IM_POW_2 = prove + (`Im(z pow 2) = &2 * Re(z) * Im(z)`, + REWRITE_TAC[COMPLEX_POW_2; complex_mul; IM] THEN REAL_ARITH_TAC);; + +let ABS_SQUARE_LT_1 = prove + (`!x. x pow 2 < &1 <=> abs(x) < &1`, + ONCE_REWRITE_TAC[GSYM REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_LT_SQUARE_ABS] THEN REAL_ARITH_TAC);; + +let ABS_SQUARE_LE_1 = prove + (`!x. x pow 2 <= &1 <=> abs(x) <= &1`, + ONCE_REWRITE_TAC[GSYM REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_LT_SQUARE_ABS; GSYM REAL_NOT_LT] THEN REAL_ARITH_TAC);; + +let ABS_SQUARE_EQ_1 = prove + (`!x. x pow 2 = &1 <=> abs(x) = &1`, + REWRITE_TAC[REAL_RING `x pow 2 = &1 <=> x = &1 \/ x = -- &1`] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Inverse sine. *) +(* ------------------------------------------------------------------------- *) + +let casn = new_definition + `casn z = --ii * clog(ii * z + csqrt(Cx(&1) - z pow 2))`;; + +let CASN_BODY_LEMMA = prove + (`!z. ~(ii * z + csqrt(Cx(&1) - z pow 2) = Cx(&0))`, + GEN_TAC THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN + CONV_TAC COMPLEX_FIELD);; + +let CSIN_CASN = prove + (`!z. csin(casn z) = z`, + GEN_TAC THEN REWRITE_TAC[csin; casn; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[COMPLEX_POW_II_2; GSYM COMPLEX_POW_2] THEN + REWRITE_TAC[COMPLEX_NEG_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN + REWRITE_TAC[CEXP_NEG] THEN + ASM_SIMP_TAC[CASN_BODY_LEMMA; CEXP_CLOG; COMPLEX_FIELD + `~(z = Cx(&0)) + ==> ((z - inv z) / (Cx(&2) * ii) = c <=> + z pow 2 - Cx(&1) = Cx(&2) * ii * c * z)`] THEN + MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_FIELD);; + +let CASN_CSIN = prove + (`!z. abs(Re z) < pi / &2 \/ (abs(Re z) = pi / &2 /\ Im z = &0) + ==> casn(csin z) = z`, + GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[csin; casn; COMPLEX_MUL_LNEG; CEXP_NEG] THEN + SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(z = Cx(&0)) + ==> Cx(&1) - ((z - inv z) / (Cx(&2) * ii)) pow 2 = + ((z + inv z) / Cx(&2)) pow 2`] THEN + SUBGOAL_THEN + `csqrt(((cexp(ii * z) + inv(cexp(ii * z))) / Cx(&2)) pow 2) = + (cexp(ii * z) + inv(cexp(ii * z))) / Cx(&2)` + SUBST1_TAC THENL + [MATCH_MP_TAC POW_2_CSQRT THEN REWRITE_TAC[GSYM CEXP_NEG] THEN + REWRITE_TAC[complex_div; GSYM CX_INV; RE_MUL_CX; IM_MUL_CX] THEN + REWRITE_TAC[REAL_ARITH + `&0 < r * inv(&2) \/ r * inv(&2) = &0 /\ &0 <= i * inv(&2) <=> + &0 < r \/ r = &0 /\ &0 <= i`] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_CEXP; IM_CEXP] THEN + REWRITE_TAC[RE_MUL_II; RE_NEG; IM_MUL_II; IM_NEG] THEN + REWRITE_TAC[SIN_NEG; COS_NEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_MUL_RNEG; GSYM real_sub] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_ADD; REAL_EXP_POS_LT] THEN + MATCH_MP_TAC COS_POS_PI THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + DISJ2_TAC THEN ASM_REWRITE_TAC[SIN_PI2; COS_PI2] THEN + REWRITE_TAC[REAL_EXP_NEG; REAL_EXP_0; REAL_INV_1; REAL_SUB_REFL] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_LE_REFL; REAL_ENTIRE] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH + `abs(x) = p ==> x = p \/ x = --p`)) THEN + REWRITE_TAC[COS_PI2; COS_NEG] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SIMP_TAC[COMPLEX_FIELD + `ii * (a - b) / (Cx(&2) * ii) + (a + b) / Cx(&2) = a`] THEN + SIMP_TAC[COMPLEX_FIELD `--(ii * w) = z <=> w = ii * z`] THEN + MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_MUL_II] THEN + MP_TAC PI_POS THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC);; + +let CASN_UNIQUE = prove + (`!w z. csin(z) = w /\ + (abs(Re z) < pi / &2 \/ (abs(Re z) = pi / &2 /\ Im z = &0)) + ==> casn w = z`, + MESON_TAC[CASN_CSIN]);; + +let CASN_0 = prove + (`casn(Cx(&0)) = Cx(&0)`, + REWRITE_TAC[casn; COMPLEX_MUL_RZERO; COMPLEX_ADD_LID; COMPLEX_POW_2; + COMPLEX_SUB_RZERO; CSQRT_1; CLOG_1; COMPLEX_MUL_RZERO]);; + +let CASN_1 = prove + (`casn(Cx(&1)) = Cx(pi / &2)`, + REWRITE_TAC[casn; GSYM CX_POW; GSYM CX_SUB] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[CSQRT_0; COMPLEX_MUL_RID; COMPLEX_ADD_RID] THEN + REWRITE_TAC[CLOG_II] THEN CONV_TAC COMPLEX_RING);; + +let CASN_NEG_1 = prove + (`casn(--Cx(&1)) = --Cx(pi / &2)`, + REWRITE_TAC[casn; GSYM CX_NEG; GSYM CX_POW; GSYM CX_SUB] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[CSQRT_0; COMPLEX_MUL_RID; COMPLEX_ADD_RID] THEN + REWRITE_TAC[CX_NEG; COMPLEX_MUL_RID; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[CLOG_NEG_II] THEN CONV_TAC COMPLEX_RING);; + +let HAS_COMPLEX_DERIVATIVE_CASN = prove + (`!z. (Im z = &0 ==> abs(Re z) < &1) + ==> (casn has_complex_derivative inv(ccos(casn z))) (at z)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC THEN + EXISTS_TAC `csin` THEN + REWRITE_TAC[CSIN_CASN; HAS_COMPLEX_DERIVATIVE_CSIN; CONTINUOUS_AT_CSIN] THEN + EXISTS_TAC `ball(z:complex,&1)` THEN + REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN CONJ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING + `ccos z = Cx(&0) ==> csin(z) pow 2 + ccos(z) pow 2 = Cx(&1) + ==> csin(z) pow 2 = Cx(&1)`)) THEN + REWRITE_TAC[CSIN_CASN; CSIN_CIRCLE] THEN + REWRITE_TAC[COMPLEX_RING + `z pow 2 = Cx(&1) <=> z = Cx(&1) \/ z = --Cx(&1)`] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[RE_CX; IM_CX; RE_NEG; IM_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[casn] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ADD THEN + SIMP_TAC[CONTINUOUS_COMPLEX_MUL; CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + SIMP_TAC[CONTINUOUS_COMPLEX_POW; CONTINUOUS_SUB; + CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC CONTINUOUS_AT_CSQRT THEN + REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN + REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO; + REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN + ASM_SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN + REWRITE_TAC[REAL_ARITH `&0 < &1 - x * x <=> x pow 2 < &1 pow 2`] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_ABS_NUM; ARITH]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; RE_ADD; RE_MUL_II] THEN + ASM_CASES_TAC `Im z = &0` THENL + [DISCH_THEN(K ALL_TAC) THEN ASM_REWRITE_TAC[csqrt] THEN + ASM_REWRITE_TAC[IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2; + REAL_MUL_RZERO; REAL_SUB_REFL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - (z pow 2 - &0) <=> z pow 2 <= &1 pow 2`; + GSYM REAL_LE_SQUARE_ABS] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_NUM; RE; REAL_ADD_LID] THEN + MATCH_MP_TAC SQRT_POS_LT THEN + REWRITE_TAC[REAL_ARITH `&0 < &1 - (z pow 2 - &0) <=> z pow 2 < &1 pow 2`; + GSYM REAL_LT_SQUARE_ABS] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[csqrt; IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2] THEN + REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN + ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[RE; IM] THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN + SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; REAL_POS] THEN + REWRITE_TAC[RE; IM; REAL_ADD_LID; REAL_ARITH `&0 < --x + y <=> x < y`] THEN + MATCH_MP_TAC REAL_LT_RSQRT THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_ARITH `&0 < --x + y <=> x < y`] THEN + MATCH_MP_TAC REAL_LT_RSQRT THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `a < (n + &1 - (b - a)) / &2 <=> (a + b) - &1 < n`] THEN + REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN + REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN + REAL_ARITH_TAC);; + +let COMPLEX_DIFFERENTIABLE_AT_CASN = prove + (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> casn complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CASN]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CASN = prove + (`!s z. (Im z = &0 ==> abs(Re z) < &1) + ==> casn complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CASN]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + HAS_COMPLEX_DERIVATIVE_CASN)));; + +let CONTINUOUS_AT_CASN = prove + (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> casn continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CASN; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CASN = prove + (`!s z. (Im z = &0 ==> abs(Re z) < &1) ==> casn continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CASN]);; + +let CONTINUOUS_ON_CASN = prove + (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> casn continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CASN]);; + +let HOLOMORPHIC_ON_CASN = prove + (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> casn holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CASN]);; + +(* ------------------------------------------------------------------------- *) +(* Inverse cosine. *) +(* ------------------------------------------------------------------------- *) + +let cacs = new_definition + `cacs z = --ii * clog(z + ii * csqrt(Cx(&1) - z pow 2))`;; + +let CACS_BODY_LEMMA = prove + (`!z. ~(z + ii * csqrt(Cx(&1) - z pow 2) = Cx(&0))`, + GEN_TAC THEN MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN + CONV_TAC COMPLEX_FIELD);; + +let CCOS_CACS = prove + (`!z. ccos(cacs z) = z`, + GEN_TAC THEN REWRITE_TAC[ccos; cacs; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[COMPLEX_POW_II_2; GSYM COMPLEX_POW_2] THEN + REWRITE_TAC[COMPLEX_NEG_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_LID] THEN + REWRITE_TAC[CEXP_NEG] THEN + ASM_SIMP_TAC[CACS_BODY_LEMMA; CEXP_CLOG; COMPLEX_POW_II_2; COMPLEX_FIELD + `~(z = Cx(&0)) + ==> ((z + inv z) / Cx(&2) = c <=> + z pow 2 + Cx(&1) = Cx(&2) * c * z)`] THEN + MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_FIELD);; + +let CACS_CCOS = prove + (`!z. &0 < Re z /\ Re z < pi \/ + Re(z) = &0 /\ &0 <= Im(z) \/ + Re(z) = pi /\ Im(z) <= &0 + ==> cacs(ccos z) = z`, + GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[ccos; cacs; COMPLEX_MUL_LNEG; CEXP_NEG] THEN + SIMP_TAC[CEXP_NZ; COMPLEX_FIELD + `~(z = Cx(&0)) + ==> Cx(&1) - ((z + inv z) / Cx(&2)) pow 2 = + --(((z - inv z) / Cx(&2)) pow 2)`] THEN + SUBGOAL_THEN + `csqrt(--(((cexp(ii * z) - inv(cexp(ii * z))) / Cx(&2)) pow 2)) = + --ii * (cexp(ii * z) - inv(cexp(ii * z))) / Cx(&2)` + SUBST1_TAC THENL + [SIMP_TAC[COMPLEX_FIELD `--(x pow 2) = (--ii * x) pow 2`] THEN + MATCH_MP_TAC POW_2_CSQRT THEN REWRITE_TAC[GSYM CEXP_NEG] THEN + REWRITE_TAC[complex_div; GSYM CX_INV; RE_MUL_CX; IM_MUL_CX; RE_NEG; IM_NEG; + COMPLEX_MUL_LNEG; RE_MUL_II; IM_MUL_II; RE_SUB; IM_SUB] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_NEG_EQ_0] THEN + REWRITE_TAC[REAL_ARITH + `&0 < r * inv(&2) \/ r * inv(&2) = &0 /\ &0 <= --(i * inv(&2)) <=> + &0 < r \/ r = &0 /\ &0 <= --i`] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_CEXP; IM_CEXP] THEN + REWRITE_TAC[RE_MUL_II; RE_NEG; IM_MUL_II; IM_NEG] THEN + REWRITE_TAC[SIN_NEG; COS_NEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_MUL_RNEG; GSYM real_sub; REAL_SUB_RNEG; REAL_NEG_SUB] THEN + REWRITE_TAC[GSYM REAL_ADD_RDISTRIB; GSYM REAL_SUB_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_LT_ADD; REAL_EXP_POS_LT; REAL_LT_MUL_EQ] THEN + POP_ASSUM(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[SIN_POS_PI] THEN DISJ2_TAC THEN + REWRITE_TAC[SIN_PI; REAL_MUL_RZERO; COS_PI; SIN_0; COS_0] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_SUB; REAL_SUB_LE; REAL_EXP_MONO_LE] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[COMPLEX_FIELD + `(e + e') / Cx(&2) + ii * --ii * (e - e') / Cx(&2) = e`] THEN + SIMP_TAC[COMPLEX_FIELD `--(ii * w) = z <=> w = ii * z`] THEN + MATCH_MP_TAC CLOG_CEXP THEN REWRITE_TAC[IM_MUL_II] THEN + MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC);; + +let CACS_UNIQUE = prove + (`!w z. + ccos z = w /\ + (&0 < Re z /\ Re z < pi \/ + Re(z) = &0 /\ &0 <= Im(z) \/ + Re(z) = pi /\ Im(z) <= &0) + ==> cacs(w) = z`, + MESON_TAC[CACS_CCOS]);; + +let CACS_0 = prove + (`cacs(Cx(&0)) = Cx(pi / &2)`, + MATCH_MP_TAC CACS_UNIQUE THEN + REWRITE_TAC[RE_CX; IM_CX; GSYM CX_COS; COS_PI2] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let CACS_1 = prove + (`cacs(Cx(&1)) = Cx(&0)`, + MATCH_MP_TAC CACS_UNIQUE THEN + REWRITE_TAC[RE_CX; IM_CX; GSYM CX_COS; COS_0; REAL_LE_REFL]);; + +let CACS_NEG_1 = prove + (`cacs(--Cx(&1)) = Cx pi`, + MATCH_MP_TAC CACS_UNIQUE THEN + REWRITE_TAC[RE_CX; IM_CX; GSYM CX_COS; COS_PI; CX_NEG; REAL_LE_REFL]);; + +let HAS_COMPLEX_DERIVATIVE_CACS = prove + (`!z. (Im z = &0 ==> abs(Re z) < &1) + ==> (cacs has_complex_derivative --inv(csin(cacs z))) (at z)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NEG_INV] THEN + MATCH_MP_TAC HAS_COMPLEX_DERIVATIVE_INVERSE_BASIC THEN + EXISTS_TAC `ccos` THEN + REWRITE_TAC[CCOS_CACS; HAS_COMPLEX_DERIVATIVE_CCOS; CONTINUOUS_AT_CCOS] THEN + EXISTS_TAC `ball(z:complex,&1)` THEN + REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN CONJ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP (COMPLEX_RING + `--(csin z) = Cx(&0) ==> csin(z) pow 2 + ccos(z) pow 2 = Cx(&1) + ==> ccos(z) pow 2 = Cx(&1)`)) THEN + REWRITE_TAC[CCOS_CACS; CSIN_CIRCLE] THEN + REWRITE_TAC[COMPLEX_RING + `z pow 2 = Cx(&1) <=> z = Cx(&1) \/ z = --Cx(&1)`] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[RE_CX; IM_CX; RE_NEG; IM_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[cacs] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_MUL THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + SIMP_TAC[CONTINUOUS_COMPLEX_POW; CONTINUOUS_SUB; + CONTINUOUS_CONST; CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC CONTINUOUS_AT_CSQRT THEN + REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN + REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_SUB_RZERO; + REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN + ASM_SIMP_TAC[REAL_LE_SQUARE; REAL_ARITH `&0 <= x ==> &0 < &1 + x`] THEN + REWRITE_TAC[REAL_ARITH `&0 < &1 - x * x <=> x pow 2 < &1 pow 2`] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_ABS_NUM; ARITH]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; RE_ADD; RE_MUL_II] THEN + ASM_CASES_TAC `Im z = &0` THENL + [ASM_REWRITE_TAC[csqrt] THEN + ASM_REWRITE_TAC[IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2; + REAL_MUL_RZERO; REAL_SUB_REFL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - (z pow 2 - &0) <=> z pow 2 <= &1 pow 2`; + GSYM REAL_LE_SQUARE_ABS] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ABS_NUM; RE; REAL_ADD_LID] THEN + REWRITE_TAC[GSYM real_sub; IM; REAL_SUB_LT; REAL_SUB_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> x = &0 ==> &0 < y`) THEN + MATCH_MP_TAC SQRT_POS_LT THEN + ASM_SIMP_TAC[REAL_SUB_LT; ABS_SQUARE_LT_1]; + ALL_TAC] THEN + REWRITE_TAC[csqrt; IM_SUB; RE_SUB; IM_CX; RE_CX; IM_POW_2; RE_POW_2] THEN + REWRITE_TAC[REAL_RING `&0 - &2 * x * y = &0 <=> x = &0 \/ y = &0`] THEN + ASM_CASES_TAC `Re z = &0` THEN ASM_REWRITE_TAC[RE; IM] THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_ARITH `&1 - (&0 - x) = &1 + x`] THEN + SIMP_TAC[REAL_POW_2; REAL_LE_ADD; REAL_LE_SQUARE; REAL_POS] THEN + REWRITE_TAC[RE; IM; REAL_ADD_LID] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a + b = &0 ==> a = --b`)) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN + SIMP_TAC[SQRT_POW_2; REAL_POW_NEG; ARITH; REAL_LE_SQUARE; REAL_LE_ADD; + REAL_POS] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH `a + b = &0 ==> a = --b`)) THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN + SUBGOAL_THEN `&0 < (norm(Cx (&1) - z pow 2) + + &1 - (Re z pow 2 - Im z pow 2)) / &2` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH `&0 < (x + y - z) / &2 <=> z - y < x`] THEN + REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN + REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX; RE_POW_2; IM_POW_2] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_POW_NEG; ARITH; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `a = (n + &1 - (b - a)) / &2 <=> (a + b) - &1 = n`] THEN + REWRITE_TAC[complex_norm] THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real. x pow 2`) THEN + SIMP_TAC[SQRT_POW_2; REWRITE_RULE[GSYM REAL_POW_2] REAL_LE_SQUARE; + REAL_LE_ADD] THEN + REWRITE_TAC[RE_SUB; RE_CX; RE_POW_2; IM_SUB; IM_CX; IM_POW_2] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN + REAL_ARITH_TAC);; + +let COMPLEX_DIFFERENTIABLE_AT_CACS = prove + (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs complex_differentiable at z`, + REWRITE_TAC[complex_differentiable] THEN + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CACS]);; + +let COMPLEX_DIFFERENTIABLE_WITHIN_CACS = prove + (`!s z. (Im z = &0 ==> abs(Re z) < &1) + ==> cacs complex_differentiable (at z within s)`, + MESON_TAC[COMPLEX_DIFFERENTIABLE_AT_WITHIN; + COMPLEX_DIFFERENTIABLE_AT_CACS]);; + +add_complex_differentiation_theorems + (CONJUNCTS(REWRITE_RULE[FORALL_AND_THM] + (MATCH_MP HAS_COMPLEX_DERIVATIVE_CHAIN + HAS_COMPLEX_DERIVATIVE_CACS)));; + +let CONTINUOUS_AT_CACS = prove + (`!z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs continuous at z`, + MESON_TAC[HAS_COMPLEX_DERIVATIVE_CACS; + HAS_COMPLEX_DERIVATIVE_IMP_CONTINUOUS_AT]);; + +let CONTINUOUS_WITHIN_CACS = prove + (`!s z. (Im z = &0 ==> abs(Re z) < &1) ==> cacs continuous (at z within s)`, + MESON_TAC[CONTINUOUS_AT_WITHIN; CONTINUOUS_AT_CACS]);; + +let CONTINUOUS_ON_CACS = prove + (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> cacs continuous_on s`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_CACS]);; + +let HOLOMORPHIC_ON_CACS = prove + (`!s. (!z. z IN s /\ Im z = &0 ==> abs(Re z) < &1) ==> cacs holomorphic_on s`, + REWRITE_TAC [holomorphic_on] THEN + MESON_TAC [HAS_COMPLEX_DERIVATIVE_AT_WITHIN; HAS_COMPLEX_DERIVATIVE_CACS]);; + +(* ------------------------------------------------------------------------- *) +(* Some crude range theorems (could be sharpened). *) +(* ------------------------------------------------------------------------- *) + +let CASN_RANGE_LEMMA = prove + (`!z. abs (Re z) < &1 ==> &0 < Re(ii * z + csqrt(Cx(&1) - z pow 2))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RE_ADD; RE_MUL_II] THEN + REWRITE_TAC[REAL_ARITH `&0 < --i + r <=> i < r`] THEN + REWRITE_TAC[csqrt; IM_SUB; RE_SUB; COMPLEX_POW_2; RE_CX; IM_CX] THEN + REWRITE_TAC[complex_mul; RE; IM] THEN REWRITE_TAC[GSYM complex_mul] THEN + REWRITE_TAC[REAL_ARITH `r * i + i * r = &2 * r * i`] THEN + REWRITE_TAC[REAL_SUB_LZERO; REAL_NEG_EQ_0; REAL_ABS_NEG] THEN + REWRITE_TAC[REAL_NEG_SUB; REAL_ENTIRE; REAL_OF_NUM_EQ; ARITH] THEN + MAP_EVERY ASM_CASES_TAC [`Re z = &0`; `Im z = &0`] THEN + ASM_REWRITE_TAC[REAL_SUB_LZERO; REAL_SUB_RZERO] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[RE; SQRT_1] THEN CONV_TAC REAL_RAT_REDUCE_CONV THENL + [REWRITE_TAC[REAL_ARITH `&1 - (&0 - z) = &1 + z`] THEN + SIMP_TAC[REAL_LE_ADD; REAL_POS; REAL_LE_SQUARE; RE] THEN + MATCH_MP_TAC REAL_LT_RSQRT THEN REAL_ARITH_TAC; + SUBGOAL_THEN `Re(z) pow 2 < &1 pow 2` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN MATCH_MP_TAC REAL_POW_LT2 THEN + ASM_REWRITE_TAC[REAL_ABS_POS; REAL_ABS_NUM; ARITH]; + REWRITE_TAC[REAL_POW_ONE] THEN STRIP_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[RE] THEN + TRY(MATCH_MP_TAC SQRT_POS_LT) THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_RSQRT THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH + `a < (n + &1 - (b - a)) / &2 <=> (a + b) - &1 < n`] THEN + REWRITE_TAC[complex_norm] THEN MATCH_MP_TAC REAL_LT_RSQRT THEN + REWRITE_TAC[RE_SUB; IM_SUB; RE_CX; IM_CX] THEN + REWRITE_TAC[complex_mul; RE; IM] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [GSYM REAL_LT_SQUARE])) THEN + REAL_ARITH_TAC]);; + +let CACS_RANGE_LEMMA = prove + (`!z. abs(Re z) < &1 ==> &0 < Im(z + ii * csqrt(Cx(&1) - z pow 2))`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `--z:complex` CASN_RANGE_LEMMA) THEN + ASM_SIMP_TAC[IM_NEG; RE_NEG; IM_ADD; RE_ADD; IM_MUL_II; RE_MUL_II; + COMPLEX_POW_NEG; ARITH; REAL_ABS_NEG] THEN + REAL_ARITH_TAC);; + +let RE_CASN = prove + (`!z. Re(casn z) = Im(clog(ii * z + csqrt(Cx(&1) - z pow 2)))`, + REWRITE_TAC[casn; COMPLEX_MUL_LNEG; RE_NEG; RE_MUL_II; REAL_NEGNEG]);; + +let RE_CACS = prove + (`!z. Re(cacs z) = Im(clog(z + ii * csqrt(Cx(&1) - z pow 2)))`, + REWRITE_TAC[cacs; COMPLEX_MUL_LNEG; RE_NEG; RE_MUL_II; REAL_NEGNEG]);; + +let CASN_BOUNDS = prove + (`!z. abs(Re z) < &1 ==> abs(Re(casn z)) < pi / &2`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[RE_CASN] THEN + MATCH_MP_TAC RE_CLOG_POS_LT_IMP THEN ASM_SIMP_TAC[CASN_RANGE_LEMMA]);; + +let CACS_BOUNDS = prove + (`!z. abs(Re z) < &1 ==> &0 < Re(cacs z) /\ Re(cacs z) < pi`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[RE_CACS] THEN + MATCH_MP_TAC IM_CLOG_POS_LT_IMP THEN ASM_SIMP_TAC[CACS_RANGE_LEMMA]);; + +let RE_CACS_BOUNDS = prove + (`!z. --pi < Re(cacs z) /\ Re(cacs z) <= pi`, + REWRITE_TAC[RE_CACS] THEN SIMP_TAC[CLOG_WORKS; CACS_BODY_LEMMA]);; + +let RE_CACS_BOUND = prove + (`!z. abs(Re(cacs z)) <= pi`, + MP_TAC RE_CACS_BOUNDS THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +let RE_CASN_BOUNDS = prove + (`!z. --pi < Re(casn z) /\ Re(casn z) <= pi`, + REWRITE_TAC[RE_CASN] THEN SIMP_TAC[CLOG_WORKS; CASN_BODY_LEMMA]);; + +let RE_CASN_BOUND = prove + (`!z. abs(Re(casn z)) <= pi`, + MP_TAC RE_CASN_BOUNDS THEN MATCH_MP_TAC MONO_FORALL THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Interrelations between the two functions. *) +(* ------------------------------------------------------------------------- *) + +let CCOS_CASN_NZ = prove + (`!z. ~(z pow 2 = Cx(&1)) ==> ~(ccos(casn z) = Cx(&0))`, + REWRITE_TAC[ccos; casn; CEXP_NEG; COMPLEX_RING `ii * --ii * z = z`; + COMPLEX_RING `--ii * --ii * z = --z`] THEN + SIMP_TAC[CEXP_CLOG; CASN_BODY_LEMMA; + COMPLEX_FIELD `~(x = Cx(&0)) + ==> ((x + inv(x)) / Cx(&2) = Cx(&0) <=> + x pow 2 = --Cx(&1))`] THEN + SIMP_TAC[CSQRT; COMPLEX_FIELD + `s pow 2 = Cx(&1) - z pow 2 + ==> ((ii * z + s) pow 2 = --Cx(&1) <=> + ii * s * z = Cx(&1) - z pow 2)`] THEN + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(COMPLEX_RING + `~(x pow 2 + y pow 2 = Cx(&0)) ==> ~(ii * x = y)`) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_RING);; + +let CSIN_CACS_NZ = prove + (`!z. ~(z pow 2 = Cx(&1)) ==> ~(csin(cacs z) = Cx(&0))`, + REWRITE_TAC[csin; cacs; CEXP_NEG; COMPLEX_RING `ii * --ii * z = z`; + COMPLEX_RING `--ii * --ii * z = --z`] THEN + SIMP_TAC[CEXP_CLOG; CACS_BODY_LEMMA; + COMPLEX_FIELD `~(x = Cx(&0)) + ==> ((x - inv(x)) / (Cx(&2) * ii) = Cx(&0) <=> + x pow 2 = Cx(&1))`] THEN + SIMP_TAC[CSQRT; COMPLEX_FIELD + `s pow 2 = Cx(&1) - z pow 2 + ==> ((z + ii * s) pow 2 = Cx(&1) <=> + ii * s * z = Cx(&1) - z pow 2)`] THEN + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(COMPLEX_RING + `~(x pow 2 + y pow 2 = Cx(&0)) ==> ~(ii * x = y)`) THEN + REPEAT(POP_ASSUM MP_TAC) THEN + MP_TAC(SPEC `Cx(&1) - z pow 2` CSQRT) THEN CONV_TAC COMPLEX_RING);; + +let CCOS_CSIN_CSQRT = prove + (`!z. &0 < cos(Re z) \/ cos(Re z) = &0 /\ Im(z) * sin(Re z) <= &0 + ==> ccos(z) = csqrt(Cx(&1) - csin(z) pow 2)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CSQRT_UNIQUE THEN + REWRITE_TAC[COMPLEX_EQ_SUB_LADD] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + REWRITE_TAC[CSIN_CIRCLE] THEN REWRITE_TAC[RE_CCOS; IM_CCOS] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_HALF; REAL_LT_ADD; REAL_EXP_POS_LT] THEN + DISJ2_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REAL_ARITH + `x * y <= &0 ==> &0 <= --x * y`)) THEN + REWRITE_TAC[REAL_MUL_POS_LE] THEN + SIMP_TAC[REAL_ARITH `x / &2 = &0 <=> x = &0`; REAL_LT_RDIV_EQ; REAL_ADD_LID; + REAL_SUB_LT; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_MUL_LZERO; + REAL_SUB_0; REAL_EXP_MONO_LT; REAL_LT_SUB_RADD; REAL_EXP_INJ] THEN + REAL_ARITH_TAC);; + +let CSIN_CCOS_CSQRT = prove + (`!z. &0 < sin(Re z) \/ sin(Re z) = &0 /\ &0 <= Im(z) * cos(Re z) + ==> csin(z) = csqrt(Cx(&1) - ccos(z) pow 2)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CSQRT_UNIQUE THEN + REWRITE_TAC[COMPLEX_EQ_SUB_LADD] THEN ONCE_REWRITE_TAC[COMPLEX_ADD_SYM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_ADD_SYM] CSIN_CIRCLE] THEN + REWRITE_TAC[RE_CSIN; IM_CSIN] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_HALF; REAL_LT_ADD; REAL_EXP_POS_LT] THEN + DISJ2_TAC THEN REWRITE_TAC[REAL_MUL_RZERO] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[REAL_MUL_POS_LE] THEN + SIMP_TAC[REAL_ARITH `x / &2 = &0 <=> x = &0`; REAL_LT_RDIV_EQ; REAL_ADD_LID; + REAL_SUB_LT; REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH; REAL_MUL_LZERO; + + REAL_SUB_0; REAL_EXP_MONO_LT; REAL_LT_SUB_RADD; REAL_EXP_INJ] THEN + REAL_ARITH_TAC);; + +let CASN_CACS_SQRT_POS = prove + (`!z. (&0 < Re z \/ Re z = &0 /\ &0 <= Im z) + ==> casn(z) = cacs(csqrt(Cx(&1) - z pow 2))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[casn; cacs] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(COMPLEX_RING `w = z ==> ii * z + s = s + ii * w`) THEN + MATCH_MP_TAC CSQRT_UNIQUE THEN + ASM_REWRITE_TAC[CSQRT] THEN CONV_TAC COMPLEX_RING);; + +let CACS_CASN_SQRT_POS = prove + (`!z. (&0 < Re z \/ Re z = &0 /\ &0 <= Im z) + ==> cacs(z) = casn(csqrt(Cx(&1) - z pow 2))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[casn; cacs] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(COMPLEX_RING `w = z ==> z + ii * s = ii * s + w`) THEN + MATCH_MP_TAC CSQRT_UNIQUE THEN + ASM_REWRITE_TAC[CSQRT] THEN CONV_TAC COMPLEX_RING);; + +let CSIN_CACS = prove + (`!z. &0 < Re z \/ Re(z) = &0 /\ &0 <= Im z + ==> csin(cacs z) = csqrt(Cx(&1) - z pow 2)`, + GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CSIN_CASN] THEN + AP_TERM_TAC THEN MATCH_MP_TAC CACS_CASN_SQRT_POS THEN + ASM_REWRITE_TAC[]);; + +let CCOS_CASN = prove + (`!z. &0 < Re z \/ Re(z) = &0 /\ &0 <= Im z + ==> ccos(casn z) = csqrt(Cx(&1) - z pow 2)`, + GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CCOS_CACS] THEN + AP_TERM_TAC THEN MATCH_MP_TAC CASN_CACS_SQRT_POS THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Real arcsin. *) +(* ------------------------------------------------------------------------- *) + +let asn = new_definition `asn(x) = Re(casn(Cx x))`;; + +let REAL_ASN = prove + (`!z. real z /\ abs(Re z) <= &1 ==> real(casn z)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + GEN_REWRITE_TAC LAND_CONV [REAL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN SPEC_TAC(`Re z`,`x:real`) THEN + REWRITE_TAC[real; casn; COMPLEX_MUL_LNEG; IM_NEG; IM_MUL_II] THEN + GEN_TAC THEN REWRITE_TAC[RE_CX; REAL_NEG_EQ_0] THEN DISCH_TAC THEN + MATCH_MP_TAC NORM_CEXP_IMAGINARY THEN + SIMP_TAC[CEXP_CLOG; CASN_BODY_LEMMA; NORM_EQ_SQUARE] THEN + REWRITE_TAC[DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + ASM_SIMP_TAC[GSYM CX_POW; GSYM CX_SUB; GSYM CX_SQRT; REAL_SUB_LE; + ABS_SQUARE_LE_1; RE_CX; IM_CX; REAL_NEG_0; REAL_ADD_LID; + SQRT_POW_2] THEN + REAL_ARITH_TAC);; + +let CX_ASN = prove + (`!x. abs(x) <= &1 ==> Cx(asn x) = casn(Cx x)`, + REWRITE_TAC[asn] THEN MESON_TAC[REAL; RE_CX; REAL_CX; REAL_ASN]);; + +let SIN_ASN = prove + (`!y. --(&1) <= y /\ y <= &1 ==> sin(asn(y)) = y`, + REWRITE_TAC[REAL_ARITH `--(&1) <= y /\ y <= &1 <=> abs(y) <= &1`] THEN + ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ASN; CX_SIN; CSIN_CASN]);; + +let ASN_SIN = prove + (`!x. --(pi / &2) <= x /\ x <= pi / &2 ==> asn(sin(x)) = x`, + ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ASN; SIN_BOUND; CX_SIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CASN_CSIN THEN + REWRITE_TAC[IM_CX; RE_CX] THEN REPEAT(POP_ASSUM MP_TAC) THEN + REAL_ARITH_TAC);; + +let ASN_BOUNDS_LT = prove + (`!y. --(&1) < y /\ y < &1 ==> --(pi / &2) < asn(y) /\ asn(y) < pi / &2`, + GEN_TAC THEN REWRITE_TAC[asn] THEN + MP_TAC(SPEC `Cx y` CASN_BOUNDS) THEN + REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC);; + +let ASN_0 = prove + (`asn(&0) = &0`, + REWRITE_TAC[asn; CASN_0; RE_CX]);; + +let ASN_1 = prove + (`asn(&1) = pi / &2`, + REWRITE_TAC[asn; CASN_1; RE_CX]);; + +let ASN_NEG_1 = prove + (`asn(-- &1) = --(pi / &2)`, + REWRITE_TAC[asn; CX_NEG; CASN_NEG_1; RE_CX; RE_NEG]);; + +let ASN_BOUNDS = prove + (`!y. --(&1) <= y /\ y <= &1 ==> --(pi / &2) <= asn(y) /\ asn(y) <= pi / &2`, + REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + MAP_EVERY MP_TAC [ASN_1; ASN_NEG_1; SPEC `y:real` ASN_BOUNDS_LT] THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let ASN_BOUNDS_PI2 = prove + (`!x. &0 <= x /\ x <= &1 ==> &0 <= asn x /\ asn x <= pi / &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`&0`; `asn x`] SIN_MONO_LE_EQ) THEN + ASM_SIMP_TAC[SIN_0; SIN_ASN; REAL_ARITH `&0 <= x ==> --(&1) <= x`] THEN + MP_TAC(SPEC `x:real` ASN_BOUNDS) THEN MP_TAC PI_POS THEN + ASM_REAL_ARITH_TAC);; + +let ASN_NEG = prove + (`!x. -- &1 <= x /\ x <= &1 ==> asn(--x) = --asn(x)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) + [GSYM(MATCH_MP SIN_ASN th)]) THEN + REWRITE_TAC[GSYM SIN_NEG] THEN MATCH_MP_TAC ASN_SIN THEN + REWRITE_TAC[REAL_ARITH `--a <= --x /\ --x <= a <=> --a <= x /\ x <= a`] THEN + ASM_SIMP_TAC[ASN_BOUNDS]);; + +let COS_ASN_NZ = prove + (`!x. --(&1) < x /\ x < &1 ==> ~(cos(asn(x)) = &0)`, + ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ASN; CX_COS; + REAL_ARITH `--(&1) < x /\ x < &1 ==> abs(x) <= &1`] THEN + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CCOS_CASN_NZ THEN + SIMP_TAC[COMPLEX_RING `x pow 2 = Cx(&1) <=> x = Cx(&1) \/ x = --Cx(&1)`] THEN + REWRITE_TAC[GSYM CX_NEG; CX_INJ] THEN + ASM_REAL_ARITH_TAC);; + +let ASN_MONO_LT_EQ = prove + (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (asn(x) < asn(y) <=> x < y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sin(asn(x)) < sin(asn(y))` THEN CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SIN_MONO_LT_EQ THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC ASN_BOUNDS; + BINOP_TAC THEN MATCH_MP_TAC SIN_ASN] THEN + ASM_REAL_ARITH_TAC);; + +let ASN_MONO_LE_EQ = prove + (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (asn(x) <= asn(y) <=> x <= y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ASM_SIMP_TAC[ASN_MONO_LT_EQ]);; + +let ASN_MONO_LT = prove + (`!x y. --(&1) <= x /\ x < y /\ y <= &1 ==> asn(x) < asn(y)`, + MP_TAC ASN_MONO_LT_EQ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REAL_ARITH_TAC);; + +let ASN_MONO_LE = prove + (`!x y. --(&1) <= x /\ x <= y /\ y <= &1 ==> asn(x) <= asn(y)`, + MP_TAC ASN_MONO_LE_EQ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REAL_ARITH_TAC);; + +let COS_ASN = prove + (`!x. --(&1) <= x /\ x <= &1 ==> cos(asn x) = sqrt(&1 - x pow 2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM SQRT_UNIQUE) THEN + ASM_SIMP_TAC[ASN_BOUNDS; COS_POS_PI_LE; REAL_EQ_SUB_RADD] THEN + ASM_MESON_TAC[SIN_ASN; SIN_CIRCLE; REAL_ADD_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Real arccosine. *) +(* ------------------------------------------------------------------------- *) + +let acs = new_definition `acs(x) = Re(cacs(Cx x))`;; + +let REAL_ACS = prove + (`!z. real z /\ abs(Re z) <= &1 ==> real(cacs z)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + GEN_REWRITE_TAC LAND_CONV [REAL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN SPEC_TAC(`Re z`,`x:real`) THEN + REWRITE_TAC[real; cacs; COMPLEX_MUL_LNEG; IM_NEG; IM_MUL_II] THEN + GEN_TAC THEN REWRITE_TAC[RE_CX; REAL_NEG_EQ_0] THEN DISCH_TAC THEN + MATCH_MP_TAC NORM_CEXP_IMAGINARY THEN + SIMP_TAC[CEXP_CLOG; CACS_BODY_LEMMA; NORM_EQ_SQUARE] THEN + REWRITE_TAC[DOT_SQUARE_NORM; COMPLEX_SQNORM] THEN + REWRITE_TAC[RE_ADD; IM_ADD; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + ASM_SIMP_TAC[GSYM CX_POW; GSYM CX_SUB; GSYM CX_SQRT; REAL_SUB_LE; + ABS_SQUARE_LE_1; RE_CX; IM_CX; REAL_NEG_0; REAL_ADD_LID; + SQRT_POW_2] THEN + REAL_ARITH_TAC);; + +let CX_ACS = prove + (`!x. abs(x) <= &1 ==> Cx(acs x) = cacs(Cx x)`, + REWRITE_TAC[acs] THEN MESON_TAC[REAL; RE_CX; REAL_CX; REAL_ACS]);; + +let COS_ACS = prove + (`!y. --(&1) <= y /\ y <= &1 ==> cos(acs(y)) = y`, + REWRITE_TAC[REAL_ARITH `--(&1) <= y /\ y <= &1 <=> abs(y) <= &1`] THEN + ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ACS; CX_COS; CCOS_CACS]);; + +let ACS_COS = prove + (`!x. &0 <= x /\ x <= pi ==> acs(cos(x)) = x`, + ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ACS; COS_BOUND; CX_COS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CACS_CCOS THEN + REWRITE_TAC[IM_CX; RE_CX] THEN ASM_REAL_ARITH_TAC);; + +let ACS_BOUNDS_LT = prove + (`!y. --(&1) < y /\ y < &1 ==> &0 < acs(y) /\ acs(y) < pi`, + GEN_TAC THEN REWRITE_TAC[acs] THEN + MP_TAC(SPEC `Cx y` CACS_BOUNDS) THEN + REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC);; + +let ACS_0 = prove + (`acs(&0) = pi / &2`, + REWRITE_TAC[acs; CACS_0; RE_CX]);; + +let ACS_1 = prove + (`acs(&1) = &0`, + REWRITE_TAC[acs; CACS_1; RE_CX]);; + +let ACS_NEG_1 = prove + (`acs(-- &1) = pi`, + REWRITE_TAC[acs; CX_NEG; CACS_NEG_1; RE_CX; RE_NEG]);; + +let ACS_BOUNDS = prove + (`!y. --(&1) <= y /\ y <= &1 ==> &0 <= acs(y) /\ acs(y) <= pi`, + REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + MAP_EVERY MP_TAC [ACS_1; ACS_NEG_1; SPEC `y:real` ACS_BOUNDS_LT] THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let ACS_NEG = prove + (`!x. -- &1 <= x /\ x <= &1 ==> acs(--x) = pi - acs(x)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) + [GSYM(MATCH_MP COS_ACS th)]) THEN + ONCE_REWRITE_TAC[GSYM COS_NEG] THEN REWRITE_TAC[GSYM COS_PERIODIC_PI] THEN + REWRITE_TAC[REAL_ARITH `--x + y:real = y - x`] THEN MATCH_MP_TAC ACS_COS THEN + SIMP_TAC[REAL_ARITH `&0 <= p - x /\ p - x <= p <=> &0 <= x /\ x <= p`] THEN + ASM_SIMP_TAC[ACS_BOUNDS]);; + +let SIN_ACS_NZ = prove + (`!x. --(&1) < x /\ x < &1 ==> ~(sin(acs(x)) = &0)`, + ONCE_REWRITE_TAC[GSYM CX_INJ] THEN SIMP_TAC[CX_ACS; CX_SIN; + REAL_ARITH `--(&1) < x /\ x < &1 ==> abs(x) <= &1`] THEN + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CSIN_CACS_NZ THEN + SIMP_TAC[COMPLEX_RING `x pow 2 = Cx(&1) <=> x = Cx(&1) \/ x = --Cx(&1)`] THEN + REWRITE_TAC[GSYM CX_NEG; CX_INJ] THEN + ASM_REAL_ARITH_TAC);; + +let ACS_MONO_LT_EQ = prove + (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (acs(x) < acs(y) <=> y < x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `cos(acs(y)) < cos(acs(x))` THEN CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC COS_MONO_LT_EQ THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THEN MATCH_MP_TAC ACS_BOUNDS; + BINOP_TAC THEN MATCH_MP_TAC COS_ACS] THEN + ASM_REAL_ARITH_TAC);; + +let ACS_MONO_LE_EQ = prove + (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (acs(x) <= acs(y) <=> y <= x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ASM_SIMP_TAC[ACS_MONO_LT_EQ]);; + +let ACS_MONO_LT = prove + (`!x y. --(&1) <= x /\ x < y /\ y <= &1 ==> acs(y) < acs(x)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`y:real`; `x:real`] ACS_MONO_LT_EQ) THEN + REAL_ARITH_TAC);; + +let ACS_MONO_LE = prove + (`!x y. --(&1) <= x /\ x <= y /\ y <= &1 ==> acs(y) <= acs(x)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`y:real`; `x:real`] ACS_MONO_LE_EQ) THEN + REAL_ARITH_TAC);; + +let SIN_ACS = prove + (`!x. --(&1) <= x /\ x <= &1 ==> sin(acs x) = sqrt(&1 - x pow 2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(GSYM SQRT_UNIQUE) THEN + ASM_SIMP_TAC[ACS_BOUNDS; SIN_POS_PI_LE; REAL_EQ_SUB_RADD] THEN + ASM_MESON_TAC[COS_ACS; SIN_CIRCLE]);; + +let ACS_INJ = prove + (`!x y. abs(x) <= &1 /\ abs(y) <= &1 ==> (acs x = acs y <=> x = y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_SIMP_TAC[ACS_MONO_LE_EQ] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Some interrelationships among the real inverse trig functions. *) +(* ------------------------------------------------------------------------- *) + +let ACS_ATN = prove + (`!x. -- &1 < x /\ x < &1 ==> acs(x) = pi / &2 - atn(x / sqrt(&1 - x pow 2))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x:real = p - y <=> y - (p - x) = &0`] THEN + MATCH_MP_TAC SIN_EQ_0_PI THEN + ASM_SIMP_TAC[ATN_BOUND; ACS_BOUNDS; REAL_LT_IMP_LE; REAL_ARITH + `abs(x) < pi / &2 /\ &0 <= y /\ y <= pi + ==> --pi < x - (pi / &2 - y) /\ x - (pi / &2 - y) < pi`] THEN + SUBGOAL_THEN `tan(atn(x / sqrt(&1 - x pow 2))) = tan(pi / &2 - acs x)` + MP_TAC THENL + [REWRITE_TAC[TAN_COT; ATN_TAN] THEN REWRITE_TAC[tan] THEN + ASM_SIMP_TAC[SIN_ACS; COS_ACS; REAL_LT_IMP_LE; REAL_INV_DIV]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_SUB_0] THEN + ASM_SIMP_TAC[SIN_ACS_NZ; GSYM SIN_COS; COS_ATN_NZ; REAL_SUB_TAN; REAL_FIELD + `~(y = &0) /\ ~(z = &0) ==> (x / (y * z) = &0 <=> x = &0)`]);; + +let ASN_PLUS_ACS = prove + (`!x. -- &1 <= x /\ x <= &1 ==> asn(x) + acs(x) = pi / &2`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x + y:real = p <=> x = p - y`] THEN + MATCH_MP_TAC SIN_INJ_PI THEN + ASM_SIMP_TAC[SIN_PI2; COS_PI2; SIN_SUB; REAL_MUL_LZERO; REAL_SUB_RZERO] THEN + ASM_SIMP_TAC[SIN_ASN; COS_ACS; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `--p <= p - x <=> x <= &2 * p`; + REAL_ARITH `p - x <= p <=> &0 <= x`] THEN + ASM_SIMP_TAC[ASN_BOUNDS; ACS_BOUNDS; REAL_ARITH `&2 * x / &2 = x`]);; + +let ASN_ACS = prove + (`!x. -- &1 <= x /\ x <= &1 ==> asn(x) = pi / &2 - acs(x)`, + SIMP_TAC[REAL_EQ_SUB_LADD; ASN_PLUS_ACS]);; + +let ACS_ASN = prove + (`!x. -- &1 <= x /\ x <= &1 ==> acs(x) = pi / &2 - asn(x)`, + SIMP_TAC[ASN_ACS] THEN REAL_ARITH_TAC);; + +let ASN_ATN = prove + (`!x. -- &1 < x /\ x < &1 ==> asn(x) = atn(x / sqrt(&1 - x pow 2))`, + SIMP_TAC[ASN_ACS; REAL_LT_IMP_LE; ACS_ATN] THEN REAL_ARITH_TAC);; + +let ASN_ACS_SQRT_POS = prove + (`!x. &0 <= x /\ x <= &1 ==> asn(x) = acs(sqrt(&1 - x pow 2))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[asn; acs] THEN + ASM_SIMP_TAC[CX_SQRT; REAL_SUB_LE; REAL_POW_1_LE; CX_SUB; CX_POW] THEN + AP_TERM_TAC THEN MATCH_MP_TAC CASN_CACS_SQRT_POS THEN + ASM_REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC);; + +let ASN_ACS_SQRT_NEG = prove + (`!x. -- &1 <= x /\ x <= &0 ==> asn(x) = --acs(sqrt(&1 - x pow 2))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x = --y <=> (--x:real) = y`] THEN + ASM_SIMP_TAC[GSYM ASN_NEG; REAL_ARITH `x <= &0 ==> x <= &1`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(x:real) pow 2 = (--x) pow 2`] THEN + MATCH_MP_TAC ASN_ACS_SQRT_POS THEN ASM_REAL_ARITH_TAC);; + +let ACS_ASN_SQRT_POS = prove + (`!x. &0 <= x /\ x <= &1 ==> acs(x) = asn(sqrt(&1 - x pow 2))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[asn; acs] THEN + ASM_SIMP_TAC[CX_SQRT; REAL_SUB_LE; REAL_POW_1_LE; CX_SUB; CX_POW] THEN + AP_TERM_TAC THEN MATCH_MP_TAC CACS_CASN_SQRT_POS THEN + ASM_REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC);; + +let ACS_ASN_SQRT_NEG = prove + (`!x. -- &1 <= x /\ x <= &0 ==> acs(x) = pi - asn(sqrt(&1 - x pow 2))`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `--x:real` ACS_ASN_SQRT_POS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[REAL_POW_NEG; ARITH]] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_NEG_NEG] THEN + MATCH_MP_TAC ACS_NEG THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* More delicate continuity results for arcsin and arccos. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CASN_REAL = prove + (`casn continuous_on {w | real w /\ abs(Re w) <= &1}`, + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `IMAGE csin {z | real z /\ abs(Re z) <= pi / &2}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN + REWRITE_TAC[CONTINUOUS_ON_CSIN] THEN CONJ_TAC THENL + [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(Cx(&0),pi / &2)` THEN + REWRITE_TAC[BOUNDED_CBALL; SUBSET; IN_ELIM_THM; IN_CBALL] THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; real] THEN + X_GEN_TAC `z:complex` THEN + MP_TAC(SPEC `z:complex` COMPLEX_NORM_LE_RE_IM) THEN REAL_ARITH_TAC; + SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`; + GSYM REAL_BOUNDS_LE] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]; + SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CASN_CSIN THEN + REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC]; + SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX; IN_IMAGE] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXISTS_TAC `Cx(asn x)` THEN + ASM_SIMP_TAC[RE_CX; ASN_BOUNDS; REAL_BOUNDS_LE; REAL_CX; SIN_ASN; + GSYM CX_SIN] THEN + ASM_MESON_TAC[REAL_BOUNDS_LE; ASN_BOUNDS]]);; + +let CONTINUOUS_WITHIN_CASN_REAL = prove + (`!z. casn continuous (at z within {w | real w /\ abs(Re w) <= &1})`, + GEN_TAC THEN ASM_CASES_TAC `z IN {w | real w /\ abs(Re w) <= &1}` THENL + [ASM_SIMP_TAC[REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] + CONTINUOUS_ON_CASN_REAL]; + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN + ASM_SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]);; + +let CONTINUOUS_ON_CACS_REAL = prove + (`cacs continuous_on {w | real w /\ abs(Re w) <= &1}`, + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `IMAGE ccos {z | real z /\ &0 <= Re z /\ Re z <= pi}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_INVERSE THEN + REWRITE_TAC[CONTINUOUS_ON_CCOS] THEN CONJ_TAC THENL + [REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(Cx(&0),&2 * pi)` THEN + REWRITE_TAC[BOUNDED_CBALL; SUBSET; IN_ELIM_THM; IN_CBALL] THEN + REWRITE_TAC[dist; COMPLEX_SUB_LZERO; NORM_NEG; real] THEN + X_GEN_TAC `z:complex` THEN + MP_TAC(SPEC `z:complex` COMPLEX_NORM_LE_RE_IM) THEN REAL_ARITH_TAC; + SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]; + SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CACS_CCOS THEN + REWRITE_TAC[RE_CX; IM_CX] THEN ASM_REAL_ARITH_TAC]; + SIMP_TAC[SUBSET; IMP_CONJ; FORALL_REAL; IN_ELIM_THM; RE_CX; IN_IMAGE] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXISTS_TAC `Cx(acs x)` THEN + ASM_SIMP_TAC[RE_CX; ACS_BOUNDS; REAL_BOUNDS_LE; REAL_CX; COS_ACS; + GSYM CX_COS]]);; + +let CONTINUOUS_WITHIN_CACS_REAL = prove + (`!z. cacs continuous (at z within {w | real w /\ abs(Re w) <= &1})`, + GEN_TAC THEN ASM_CASES_TAC `z IN {w | real w /\ abs(Re w) <= &1}` THENL + [ASM_SIMP_TAC[REWRITE_RULE[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] + CONTINUOUS_ON_CACS_REAL]; + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN + ASM_SIMP_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_REAL_SET; CLOSED_HALFSPACE_RE_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_RE_GE]]);; + +(* ------------------------------------------------------------------------- *) +(* Some limits, most involving sequences of transcendentals. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CX_OVER_CEXP = prove + (`((\x. Cx x / cexp(Cx x)) --> Cx(&0)) at_posinfinity`, + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX_NORM] THEN + REWRITE_TAC[LIM_AT_POSINFINITY; real_ge] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `max (&1) (&1 + &2 * log (&2 / e))` THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO; COMPLEX_NORM_CX; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[COMPLEX_NORM_DIV; NORM_CEXP; COMPLEX_NORM_CX; RE_CX] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_EXP_POS_LT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN GEN_REWRITE_TAC + (RAND_CONV o RAND_CONV) [REAL_ARITH `x = x / &2 + x / &2`] THEN + REWRITE_TAC[REAL_EXP_ADD; REAL_ARITH + `x / e < y * y <=> x / &2 * &2 / e < y * y`] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `&1 <= x /\ &1 + x / &2 <= y ==> abs x / &2 < y`) THEN + ASM_REWRITE_TAC[REAL_EXP_LE_X]; + ASM_SIMP_TAC[REAL_LE_DIV; REAL_POS; REAL_LT_IMP_LE]; + MATCH_MP_TAC LOG_MONO_LT_REV THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH; LOG_EXP; + REAL_ARITH `&1 <= x ==> &0 < x`; REAL_EXP_POS_LT] THEN + ASM_REAL_ARITH_TAC]);; + +let LIM_Z_TIMES_CLOG = prove + (`((\z. z * clog z) --> Cx(&0)) (at (Cx(&0)))`, + ONCE_REWRITE_TAC[SPEC `clog z` COMPLEX_EXPAND] THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_ADD THEN CONJ_TAC THENL + [SIMP_TAC[RE_CLOG] THEN MP_TAC LIM_CX_OVER_CEXP THEN + REWRITE_TAC[LIM_AT_POSINFINITY; LIM_AT; dist; COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[real_ge] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_CEXP; RE_CX] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + EXISTS_TAC `inv(exp b)` THEN SIMP_TAC[REAL_LT_INV_EQ; REAL_EXP_POS_LT] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `log(inv(norm(z:complex)))`) THEN + ASM_SIMP_TAC[LOG_INV; EXP_LOG; REAL_LT_INV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[real_div; REAL_INV_INV; REAL_ABS_NEG] THEN + DISCH_THEN MATCH_MP_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_EXP_NEG] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN + REWRITE_TAC[LIM_AT_ID] THEN EXISTS_TAC `pi` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_II; COMPLEX_NORM_CX] THEN + REWRITE_TAC[EVENTUALLY_AT; dist; COMPLEX_SUB_0; COMPLEX_NORM_NZ] THEN + SIMP_TAC[CLOG_WORKS; REAL_MUL_LID; REAL_ABS_BOUNDS; REAL_LT_IMP_LE] THEN + MESON_TAC[REAL_LT_01]]);; + +let LIM_LOG_OVER_Z = prove + (`((\z. clog z / z) --> Cx(&0)) at_infinity`, + SIMP_TAC[LIM_AT_INFINITY_COMPLEX_0; o_DEF; complex_div; COMPLEX_INV_INV; + CLOG_INV] THEN + ONCE_REWRITE_TAC[COMPLEX_RING + `clog(inv z) * z = z * (clog z + clog(inv z)) - z * clog z`] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_SUB THEN + REWRITE_TAC[LIM_Z_TIMES_CLOG] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_RMUL_BOUNDED THEN + REWRITE_TAC[LIM_AT_ID] THEN EXISTS_TAC `&2 * pi` THEN + REWRITE_TAC[EVENTUALLY_AT; dist; COMPLEX_SUB_RZERO; COMPLEX_NORM_NZ] THEN + EXISTS_TAC `&1` THEN SIMP_TAC[REAL_LT_01] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [COMPLEX_EXPAND] THEN + ASM_SIMP_TAC[RE_ADD; RE_CLOG; REAL_LT_INV_EQ; COMPLEX_INV_EQ_0; + COMPLEX_NORM_INV; LOG_INV; COMPLEX_NORM_NZ] THEN + REWRITE_TAC[REAL_ADD_RINV; COMPLEX_ADD_LID; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[COMPLEX_NORM_II; COMPLEX_NORM_CX; IM_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `--pi < x /\ x <= pi /\ --pi < y /\ y <= pi + ==> &1 * abs(x + y) <= &2 * pi`) THEN + ASM_SIMP_TAC[CLOG_WORKS; COMPLEX_INV_EQ_0]);; + +let LIM_LOG_OVER_POWER = prove + (`!s. &0 < Re s + ==> ((\x. clog(Cx x) / (Cx x) cpow s) --> Cx(&0)) at_posinfinity`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[real_ge] THEN + MP_TAC(REWRITE_RULE[LIM_AT_POSINFINITY] LIM_CX_OVER_CEXP) THEN + DISCH_THEN(MP_TAC o SPEC `Re s * e`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; real_ge; dist; COMPLEX_SUB_RZERO] THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; NORM_CEXP; RE_CX] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + EXISTS_TAC `max (&1) (exp((abs B + &1) / Re s))` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[REAL_MAX_LE] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[NORM_CPOW_REAL; COMPLEX_NORM_DIV; REAL_CX; RE_CX; + GSYM CX_LOG; COMPLEX_NORM_CX; real_abs; LOG_POS] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `Re s` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Re s * log x`) THEN + ASM_SIMP_TAC[real_abs; REAL_LE_MUL; LOG_POS; REAL_LT_IMP_LE] THEN + REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs b + &1 <= x * y ==> b <= y * x`) THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG]);; + +let LIM_LOG_OVER_X = prove + (`((\x. clog(Cx x) / Cx x) --> Cx(&0)) at_posinfinity`, + MP_TAC(SPEC `Cx(&1)` LIM_LOG_OVER_POWER) THEN + REWRITE_TAC[CPOW_N; RE_CX; REAL_LT_01; COMPLEX_POW_1] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY; CX_INJ] THEN + EXISTS_TAC `&1` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let LIM_LOG_OVER_POWER_N = prove + (`!s. &0 < Re s + ==> ((\n. clog(Cx(&n)) / Cx(&n) cpow s) --> Cx(&0)) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + ASM_SIMP_TAC[LIM_LOG_OVER_POWER]);; + +let LIM_LOG_OVER_N = prove + (`((\n. clog(Cx(&n)) / Cx(&n)) --> Cx(&0)) sequentially`, + MP_TAC(SPEC `Cx(&1)` LIM_LOG_OVER_POWER_N) THEN + SIMP_TAC[RE_CX; REAL_LT_01] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; CPOW_N; CX_INJ] THEN EXISTS_TAC `1` THEN + SIMP_TAC[COMPLEX_POW_1; REAL_OF_NUM_EQ; ARITH_RULE `1 <= n <=> ~(n = 0)`]);; + +let LIM_1_OVER_POWER = prove + (`!s. &0 < Re s + ==> ((\n. Cx(&1) / Cx(&n) cpow s) --> Cx(&0)) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_COMPLEX_BOUND THEN + EXISTS_TAC `\n. clog(Cx(&n)) / Cx(&n) cpow s` THEN + ASM_SIMP_TAC[LIM_LOG_OVER_POWER_N] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(ISPEC `exp(&1)` REAL_ARCH_SIMPLE) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + ASM_CASES_TAC `N = 0` THENL + [ASM_SIMP_TAC[GSYM REAL_NOT_LT; REAL_EXP_POS_LT]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[complex_div; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN `~(n = 0)` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LT_NZ; + COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs y`) THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; LT_NZ] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN ASM_REAL_ARITH_TAC);; + +let LIM_INV_Z_OFFSET = prove + (`!z. ((\w. inv(w + z)) --> Cx(&0)) at_infinity`, + GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY_COMPLEX_0; o_DEF] THEN + SIMP_TAC[COMPLEX_INV_DIV; COMPLEX_FIELD + `~(w = Cx(&0)) ==> inv w + z = (Cx(&1) + w * z) / w`] THEN + GEN_REWRITE_TAC LAND_CONV + [COMPLEX_FIELD `Cx(&0) = Cx(&0) / (Cx(&1) + Cx(&0) * z)`] THEN + MATCH_MP_TAC LIM_COMPLEX_DIV THEN + REWRITE_TAC[COMPLEX_RING `~(Cx(&1) + Cx(&0) * z = Cx(&0))`] THEN + CONJ_TAC THEN LIM_TAC);; + +let LIM_INV_Z = prove + (`((\z. inv(z)) --> Cx(&0)) at_infinity`, + ONCE_REWRITE_TAC[MESON[COMPLEX_ADD_RID] `inv z = inv(z + Cx(&0))`] THEN + REWRITE_TAC[LIM_INV_Z_OFFSET]);; + +let LIM_INV_X_OFFSET = prove + (`!z. ((\x. inv(Cx x + z)) --> Cx(&0)) at_posinfinity`, + GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN + REWRITE_TAC[LIM_INV_Z_OFFSET]);; + +let LIM_INV_X = prove + (`((\x. inv(Cx x)) --> Cx(&0)) at_posinfinity`, + MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] LIM_INV_Z]);; + +let LIM_INV_N_OFFSET = prove + (`!z. ((\n. inv(Cx(&n) + z)) --> Cx(&0)) sequentially`, + GEN_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + REWRITE_TAC[LIM_INV_X_OFFSET]);; + +let LIM_1_OVER_N = prove + (`((\n. Cx(&1) / Cx(&n)) --> Cx(&0)) sequentially`, + MP_TAC(SPEC `Cx(&1)` LIM_1_OVER_POWER) THEN SIMP_TAC[RE_CX; REAL_LT_01] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; CPOW_N; CX_INJ] THEN EXISTS_TAC `1` THEN + SIMP_TAC[COMPLEX_POW_1; REAL_OF_NUM_EQ; ARITH_RULE `1 <= n <=> ~(n = 0)`]);; + +let LIM_INV_N = prove + (`((\n. inv(Cx(&n))) --> Cx(&0)) sequentially`, + MP_TAC LIM_1_OVER_N THEN REWRITE_TAC[complex_div; COMPLEX_MUL_LID]);; + +let LIM_INV_Z_POW_OFFSET = prove + (`!z n. 1 <= n ==> ((\w. inv(w + z) pow n) --> Cx(&0)) at_infinity`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `Cx(&0) = Cx(&0) pow n` SUBST1_TAC THENL + [ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1]; + MATCH_MP_TAC LIM_COMPLEX_POW THEN REWRITE_TAC[LIM_INV_Z_OFFSET]]);; + +let LIM_INV_Z_POW = prove + (`!n. 1 <= n ==> ((\z. inv(z) pow n) --> Cx(&0)) at_infinity`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `Cx(&0) = Cx(&0) pow n` SUBST1_TAC THENL + [ASM_SIMP_TAC[COMPLEX_POW_ZERO; LE_1]; + MATCH_MP_TAC LIM_COMPLEX_POW THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] LIM_INV_Z]]);; + +let LIM_INV_X_POW_OFFSET = prove + (`!z n. 1 <= n ==> ((\x. inv(Cx x + z) pow n) --> Cx(&0)) at_posinfinity`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN + ASM_SIMP_TAC[LIM_INV_Z_POW_OFFSET]);; + +let LIM_INV_X_POW = prove + (`!n. 1 <= n ==> ((\x. inv(Cx x) pow n) --> Cx(&0)) at_posinfinity`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] LIM_INFINITY_POSINFINITY_CX) THEN + ASM_SIMP_TAC[LIM_INV_Z_POW]);; + +let LIM_INV_N_POW_OFFSET = prove + (`!z m. 1 <= m ==> ((\n. inv(Cx(&n) + z) pow m) --> Cx(&0)) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + ASM_SIMP_TAC[LIM_INV_X_POW_OFFSET]);; + +let LIM_INV_N_POW = prove + (`!m. 1 <= m ==> ((\n. inv(Cx(&n)) pow m) --> Cx(&0)) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + ASM_SIMP_TAC[LIM_INV_X_POW]);; + +let LIM_1_OVER_LOG = prove + (`((\n. Cx(&1) / clog(Cx(&n))) --> Cx(&0)) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN X_CHOOSE_TAC `N:num` (SPEC `exp(inv e)` REAL_ARCH_SIMPLE) THEN + EXISTS_TAC `N + 1` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO; COMPLEX_MUL_LID; complex_div] THEN + SUBGOAL_THEN `0 < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD]) THEN + ASM_SIMP_TAC[GSYM CX_LOG; COMPLEX_NORM_CX; COMPLEX_NORM_INV] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `a < x ==> a < abs x`) THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LT] THEN + ASM_SIMP_TAC[EXP_LOG] THEN ASM_REAL_ARITH_TAC);; + +let LIM_N_TIMES_POWN = prove + (`!z. norm(z) < &1 ==> ((\n. Cx(&n) * z pow n) --> Cx(&0)) sequentially`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_SIMP_TAC[COMPLEX_POW_ZERO; LIM_CASES_FINITE_SEQUENTIALLY; LIM_CONST; + COND_RAND; FINITE_SING; SING_GSPEC; COMPLEX_MUL_RZERO] THEN + MP_TAC LIM_LOG_OVER_N THEN + REWRITE_TAC[LIM_SEQUENTIALLY; dist; COMPLEX_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `log(inv(norm(z:complex))) / &2`) THEN + ASM_SIMP_TAC[LOG_POS_LT; REAL_INV_1_LT; COMPLEX_NORM_NZ; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "+")) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + EXISTS_TAC `MAX 1 (MAX N1 N2)` THEN + REWRITE_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ASM_SIMP_TAC[GSYM CX_LOG; REAL_OF_NUM_LT; LE_1; GSYM CX_DIV; + COMPLEX_NORM_CX; REAL_ABS_DIV; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH; real_abs; + LOG_POS; REAL_OF_NUM_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a / b * &2 = (&2 * a) / b`] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [REAL_MUL_SYM] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_EXP_MONO_LT] THEN + ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG; REAL_OF_NUM_LT; LE_1; + REAL_LT_INV_EQ; COMPLEX_NORM_NZ] THEN + REWRITE_TAC[REAL_POW_INV] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_MUL_LID] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_RDIV_EQ; REAL_POW_LT; COMPLEX_NORM_NZ; + COMPLEX_NORM_MUL; COMPLEX_NORM_NUM; COMPLEX_NORM_POW] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N2)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&n)` THEN + ASM_SIMP_TAC[REAL_LE_INV2; REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&n` THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_OF_NUM_LT; LE_1] THEN + ASM_REAL_ARITH_TAC);; + +let LIM_N_OVER_POWN = prove + (`!z. &1 < norm(z) ==> ((\n. Cx(&n) / z pow n) --> Cx(&0)) sequentially`, + ASM_SIMP_TAC[complex_div; GSYM COMPLEX_POW_INV; COMPLEX_NORM_INV; + REAL_INV_LT_1; LIM_N_TIMES_POWN]);; + +let LIM_POWN = prove + (`!z. norm(z) < &1 ==> ((\n. z pow n) --> Cx(&0)) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\n. Cx(&n) * z pow n` THEN ASM_SIMP_TAC[LIM_N_TIMES_POWN] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `a <= n * a <=> &0 <= (n - &1) * a`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[NORM_POS_LE; REAL_SUB_LE; REAL_OF_NUM_LE]);; + +let LIM_CSIN_OVER_X = prove + (`((\z. csin z / z) --> Cx(&1)) (at (Cx(&0)))`, + ONCE_REWRITE_TAC[LIM_NULL_COMPLEX] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON_COMPLEX THEN + EXISTS_TAC `\z. cexp(Cx(abs(Im z))) * z pow 2 / Cx(&2)` THEN + REWRITE_TAC[EVENTUALLY_AT] THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; dist; COMPLEX_SUB_RZERO] THEN + X_GEN_TAC `z:complex` THEN SIMP_TAC[COMPLEX_NORM_NZ] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `norm(z:complex)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ; GSYM COMPLEX_NORM_MUL] THEN + ASM_SIMP_TAC[COMPLEX_FIELD + `~(z = Cx(&0)) ==> z * (s / z - Cx(&1)) = s - z`] THEN + REWRITE_TAC[GSYM CX_EXP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[real_abs; REAL_EXP_POS_LE] THEN REWRITE_TAC[GSYM real_abs] THEN + MP_TAC(ISPECL [`0`; `z:complex`] TAYLOR_CSIN) THEN + REWRITE_TAC[VSUM_SING_NUMSEG] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[COMPLEX_NORM_POW] THEN REAL_ARITH_TAC; + LIM_TAC THEN TRY(CONV_TAC COMPLEX_RING) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN + REWRITE_TAC[CONTINUOUS_AT; LIM_AT; dist; COMPLEX_SUB_RZERO; + IM_CX; REAL_ABS_NUM; COMPLEX_NORM_CX; REAL_ABS_ABS] THEN + MESON_TAC[REAL_LET_TRANS; COMPLEX_NORM_GE_RE_IM]]);; + +(* ------------------------------------------------------------------------- *) +(* Roots of unity. *) +(* ------------------------------------------------------------------------- *) + +let COMPLEX_ROOT_POLYFUN = prove + (`!n z a. + 1 <= n + ==> (z pow n = a <=> + vsum(0..n) (\i. (if i = 0 then --a else if i = n then Cx(&1) + else Cx(&0)) * z pow i) = Cx(&0))`, + ASM_SIMP_TAC[VSUM_CLAUSES_RIGHT; LE_1; LE_0] THEN + SIMP_TAC[VSUM_CLAUSES_LEFT; LE_0; ADD_CLAUSES] THEN + ASM_SIMP_TAC[LE_1; ARITH_RULE `1 <= n /\ 1 <= i /\ i <= n - 1 + ==> ~(i = n)`] THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; complex_pow; COMPLEX_MUL_RID] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; VSUM_0; VECTOR_ADD_RID] THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_RING);; + +let COMPLEX_ROOT_UNITY = prove + (`!n j. ~(n = 0) + ==> cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) pow n = Cx(&1)`, + REWRITE_TAC[GSYM CEXP_N; CX_DIV] THEN + ASM_SIMP_TAC[CX_INJ; complex_div; REAL_OF_NUM_EQ; COMPLEX_FIELD + `~(n = Cx(&0)) ==> n * t * p * ii * j * inv(n) = j * (ii * t * p)`] THEN + REWRITE_TAC[CEXP_N; GSYM CX_MUL] THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[COS_NPI; SIN_NPI; REAL_POW_NEG; COMPLEX_MUL_RZERO; + REAL_POW_ONE; ARITH_EVEN; COMPLEX_ADD_RID; COMPLEX_POW_ONE]);; + +let COMPLEX_ROOT_UNITY_EQ = prove + (`!n j k. ~(n = 0) + ==> (cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) = + cexp(Cx(&2) * Cx pi * ii * Cx(&k / &n)) <=> (j == k) (mod n))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CEXP_EQ; num_congruent; CX_MUL] THEN + REWRITE_TAC[COMPLEX_RING + `t * p * ii * j = t * p * ii * k + (t * n * p) * ii <=> + (t * p * ii = Cx(&0)) \/ j - k = n`] THEN + SIMP_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ; PI_NZ; REAL_OF_NUM_EQ; ARITH] THEN + REWRITE_TAC[GSYM CX_SUB; CX_INJ] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `~(n = &0) ==> (j / n - k / n = m <=> j - k = n * m)`] THEN + REWRITE_TAC[int_congruent] THEN + REWRITE_TAC[int_eq; int_sub_th; int_mul_th; int_of_num_th] THEN + MESON_TAC[int_abstr; int_rep]);; + +let COMPLEX_ROOT_UNITY_EQ_1 = prove + (`!n j. ~(n = 0) + ==> (cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) = Cx(&1) <=> + n divides j)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `Cx(&1) = cexp(Cx(&2) * Cx pi * ii * Cx(&n / &n))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_DIV_REFL; REAL_OF_NUM_EQ; COMPLEX_MUL_RID] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `t * p * ii = ii * t * p`] THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_MUL; GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[COS_NPI; SIN_NPI] THEN SIMPLE_COMPLEX_ARITH_TAC; + ASM_SIMP_TAC[COMPLEX_ROOT_UNITY_EQ] THEN CONV_TAC NUMBER_RULE]);; + +let FINITE_CARD_COMPLEX_ROOTS_UNITY = prove + (`!n. 1 <= n + ==> FINITE {z | z pow n = Cx(&1)} /\ CARD {z | z pow n = Cx(&1)} <= n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[COMPLEX_ROOT_POLYFUN] THEN + MATCH_MP_TAC COMPLEX_POLYFUN_ROOTBOUND THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_1; LE_0; LE_REFL] THEN CONV_TAC COMPLEX_RING);; + +let FINITE_COMPLEX_ROOTS_UNITY = prove + (`!n. ~(n = 0) ==> FINITE {z | z pow n = Cx(&1)}`, + SIMP_TAC[FINITE_CARD_COMPLEX_ROOTS_UNITY; LE_1]);; + +let FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT = prove + (`!n. 1 <= n + ==> FINITE {cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) | j | j < n} /\ + CARD {cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) | j | j < n} = n`, + let lemma = prove (* So we don't need to load number theories yet *) + (`!x y n:num. (x == y) (mod n) /\ x < y + n /\ y < x + n ==> x = y`, + REWRITE_TAC[num_congruent; GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_LT] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + REWRITE_TAC[INT_ARITH `x < y + n /\ y < x + n <=> abs(x - y:int) < n`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[int_congruent] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:int`) MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM INT_SUB_0] THEN + ASM_SIMP_TAC[INT_ABS_MUL; INT_ENTIRE; INT_ABS_NUM; + INT_ARITH `n * x:int < n <=> n * x < n * &1`] THEN + DISJ_CASES_TAC(INT_ARITH `&n:int = &0 \/ &0:int < &n`) THEN + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC) in + REWRITE_TAC[GSYM HAS_SIZE] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [SIMPLE_IMAGE_GEN] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[HAS_SIZE_NUMSEG_LT; COMPLEX_ROOT_UNITY_EQ; LE_1] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC lemma THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let COMPLEX_ROOTS_UNITY = prove + (`!n. 1 <= n + ==> {z | z pow n = Cx(&1)} = + {cexp(Cx(&2) * Cx pi * ii * Cx(&j / &n)) | j | j < n}`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_SUBSET_LE THEN + ASM_SIMP_TAC[FINITE_CARD_COMPLEX_ROOTS_UNITY; + FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT] THEN + GEN_REWRITE_TAC LAND_CONV [SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_SIMP_TAC[COMPLEX_ROOT_UNITY; LE_1]);; + +let CARD_COMPLEX_ROOTS_UNITY = prove + (`!n. 1 <= n ==> CARD {z | z pow n = Cx(&1)} = n`, + SIMP_TAC[COMPLEX_ROOTS_UNITY; FINITE_CARD_COMPLEX_ROOTS_UNITY_EXPLICIT]);; + +let HAS_SIZE_COMPLEX_ROOTS_UNITY = prove + (`!n. 1 <= n ==> {z | z pow n = Cx(&1)} HAS_SIZE n`, + SIMP_TAC[HAS_SIZE; CARD_COMPLEX_ROOTS_UNITY; FINITE_COMPLEX_ROOTS_UNITY; + LE_1]);; + +let COMPLEX_NOT_ROOT_UNITY = prove + (`!n. 1 <= n ==> ?u. norm u = &1 /\ ~(u pow n = Cx(&1))`, + GEN_TAC THEN DISCH_TAC THEN + ABBREV_TAC `u = cexp (Cx pi * ii * Cx (&1 / &n))` THEN + EXISTS_TAC `u : complex` THEN CONJ_TAC THEN EXPAND_TAC "u" THEN + REWRITE_TAC [NORM_CEXP; RE_MUL_CX; RE_II; REAL_MUL_LZERO; + REAL_MUL_RZERO; REAL_EXP_0] THEN + EXPAND_TAC "u" THEN REWRITE_TAC[GSYM CEXP_N] THEN + ASM_SIMP_TAC[CX_DIV; LE_1; CX_INJ; REAL_OF_NUM_EQ; COMPLEX_FIELD + `~(n = Cx(&0)) ==> n * p * i * Cx(&1) / n = i * p`] THEN + REWRITE_TAC[CEXP_EULER; RE_CX; IM_CX; GSYM CX_COS; GSYM CX_SIN] THEN + REWRITE_TAC[COS_PI; SIN_PI] THEN CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* Relation between clog and Arg, and hence continuity of Arg. *) +(* ------------------------------------------------------------------------- *) + +let ARG_CLOG = prove + (`!z. &0 < Arg z ==> Arg z = Im(clog(--z)) + pi`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [ASM_REWRITE_TAC[Arg_DEF; REAL_LT_REFL]; ALL_TAC] THEN + DISCH_TAC THEN MP_TAC(last(CONJUNCTS(SPEC `z:complex` ARG))) THEN + ASM_SIMP_TAC[CX_INJ; COMPLEX_NORM_ZERO; COMPLEX_FIELD + `~(z = Cx(&0)) ==> (w = z * a <=> a = w / z)`] THEN + DISCH_THEN(MP_TAC o AP_TERM `( * ) (cexp(--(ii * Cx pi)))`) THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN DISCH_THEN(MP_TAC o AP_TERM `clog`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) CLOG_CEXP o lhand o lhand o snd) THEN + REWRITE_TAC[IM_ADD; IM_MUL_II; RE_CX; IM_NEG] THEN + ASM_SIMP_TAC[REAL_LT_ADDR; ARG; REAL_ARITH + `z < &2 * pi ==> --pi + z <= pi`] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CEXP_NEG; CEXP_EULER] THEN + REWRITE_TAC[GSYM CX_SIN; GSYM CX_COS; SIN_PI; COS_PI] THEN + REWRITE_TAC[CX_NEG; COMPLEX_MUL_RZERO; COMPLEX_ADD_RID; + SIMPLE_COMPLEX_ARITH `inv(--Cx(&1)) * z / w = --z / w`] THEN + DISCH_THEN(MP_TAC o AP_TERM `Im`) THEN + REWRITE_TAC[IM_ADD; IM_NEG; IM_MUL_II; RE_CX] THEN + MATCH_MP_TAC(REAL_RING `w = z ==> --pi + x = w ==> x = z + pi`) THEN + REWRITE_TAC[complex_div] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CLOG_MUL_SIMPLE o rand o lhand o snd) THEN + ASM_SIMP_TAC[CX_INJ; REAL_INV_EQ_0; COMPLEX_NORM_ZERO; COMPLEX_NEG_EQ_0; + GSYM CX_INV; GSYM CX_LOG; REAL_LT_INV_EQ; COMPLEX_NORM_NZ; IM_CX] THEN + ASM_SIMP_TAC[REAL_ADD_RID; CLOG_WORKS; COMPLEX_NEG_EQ_0] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[IM_ADD; IM_CX; REAL_ADD_RID]);; + +let CONTINUOUS_AT_ARG = prove + (`!z. ~(real z /\ &0 <= Re z) ==> (Cx o Arg) continuous (at z)`, + let lemma = prove + (`(\z. Cx(Im(f z) + pi)) = (Cx o Im) o (\z. f z + ii * Cx pi)`, + REWRITE_TAC[FUN_EQ_THM; o_DEF; IM_ADD; IM_CX; IM_MUL_II; RE_CX]) in + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_AT] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN_OPEN THEN + EXISTS_TAC `\z. Cx(Im(clog(--z)) + pi)` THEN + EXISTS_TAC `(:complex) DIFF {z | real z /\ &0 <= Re z}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM; GSYM closed] THEN + ASM_SIMP_TAC[o_THM; ARG_CLOG; ARG_LT_NZ; ARG_EQ_0] THEN CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = P INTER {z | Q z}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN + REWRITE_TAC[CLOSED_REAL; GSYM real_ge; CLOSED_HALFSPACE_RE_GE]; + REWRITE_TAC[GSYM CONTINUOUS_AT; lemma] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_AT_CX_IM] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM ETA_AX] THEN + SIMP_TAC[CONTINUOUS_NEG; CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC CONTINUOUS_AT_CLOG THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[real; IM_NEG; RE_NEG] THEN REAL_ARITH_TAC]);; + +let CONTINUOUS_WITHIN_UPPERHALF_ARG = prove + (`!z. ~(z = Cx(&0)) + ==> (Cx o Arg) continuous (at z) within {z | &0 <= Im z}`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `real z /\ &0 <= Re z` THEN + ASM_SIMP_TAC[CONTINUOUS_AT_ARG; CONTINUOUS_AT_WITHIN] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 + (ASSUME_TAC o GEN_REWRITE_RULE I [real]) MP_TAC) THEN + SUBGOAL_THEN `~(Re z = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~(z = Cx(&0))` THEN + ASM_REWRITE_TAC[COMPLEX_EQ; RE_CX; IM_CX]; + GEN_REWRITE_TAC LAND_CONV [REAL_LE_LT]] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPEC `rotate2d (pi / &2) z` CONTINUOUS_AT_ARG) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[ROTATE2D_PI2; real; IM_MUL_II]; ALL_TAC] THEN + REWRITE_TAC[continuous_at; continuous_within] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + REWRITE_TAC[o_THM; dist; GSYM CX_SUB; COMPLEX_NORM_CX] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `w:complex` THEN STRIP_TAC THEN + SUBGOAL_THEN `Arg z = &0` ASSUME_TAC THENL + [ASM_SIMP_TAC[ARG_EQ_0; real; REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_CASES_TAC `Arg w = &0` THEN + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + SUBGOAL_THEN `&0 < Arg w` ASSUME_TAC THENL + [ASM_REWRITE_TAC[ARG; REAL_LT_LE]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `rotate2d (pi / &2) w`) THEN + ASM_REWRITE_TAC[GSYM ROTATE2D_SUB; NORM_ROTATE2D] THEN + MP_TAC(ISPECL [`pi / &2`; `z:complex`] ARG_ROTATE2D) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[REAL_ADD_RID] THEN + MATCH_MP_TAC(REAL_ARITH + `w' = p + w ==> abs(w' - p) < e ==> abs(w - &0) < e`) THEN + MATCH_MP_TAC ARG_ROTATE2D THEN CONJ_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `&0 < Arg w` THEN + ASM_REWRITE_TAC[Arg_DEF; REAL_LT_REFL]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM ARG_LE_PI]) THEN + MP_TAC(SPEC `w:complex` ARG) THEN REAL_ARITH_TAC]);; + +let CONTINUOUS_ON_UPPERHALF_ARG = prove + (`(Cx o Arg) continuous_on ({z | &0 <= Im z} DIFF {Cx(&0)})`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `z:complex` THEN REWRITE_TAC[IN_DIFF; IN_SING; IN_ELIM_THM] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o + MATCH_MP CONTINUOUS_WITHIN_UPPERHALF_ARG) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_WITHIN_SUBSET) THEN + SET_TAC[]);; + +let CONTINUOUS_ON_COMPOSE_ARG = prove + (`!s p:real->real^N. + (p o drop) continuous_on interval[vec 0,lift(&2 * pi)] /\ + p(&2 * pi) = p(&0) /\ ~(Cx(&0) IN s) + ==> (\z. p(Arg z)) continuous_on s`, + let ulemma = prove + (`!s. s INTER {z | &0 <= Im z} UNION s INTER {z | Im z <= &0} = s`, + SET_TAC[REAL_LE_TOTAL]) in + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC + `\z. if &0 <= Im z then p(Arg z) + else p(&2 * pi - Arg(cnj z)):real^N` THEN + REWRITE_TAC[IN_UNIV; IN_SING; IN_DIFF] THEN CONJ_TAC THENL + [X_GEN_TAC `z:complex` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARG_CNJ] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_SUB2] THEN + SUBGOAL_THEN `Arg z = &0` + (fun th -> ASM_REWRITE_TAC[REAL_SUB_RZERO; th]) THEN + ASM_REWRITE_TAC[ARG_EQ_0]; + GEN_REWRITE_TAC RAND_CONV [GSYM ulemma] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[ulemma] THEN + SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HALFSPACE_IM_LE; + REWRITE_RULE[real_ge] CLOSED_HALFSPACE_IM_GE] THEN + REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_SING; IN_ELIM_THM] THEN + SIMP_TAC[GSYM CONJ_ASSOC; REAL_LE_ANTISYM; TAUT `~(p /\ ~p)`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV) [GSYM o_DEF] THEN + SUBGOAL_THEN `(p:real->real^N) = (p o drop) o lift` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM o_ASSOC] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN + MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; o_THM; DROP_VEC] THEN + SIMP_TAC[ARG; REAL_LT_IMP_LE]; + REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CNJ; o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN + MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM; IN_DIFF] THEN + SIMP_TAC[IN_SING; CNJ_EQ_0; IM_CNJ; REAL_NEG_GE0] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; o_THM; DROP_VEC] THEN + X_GEN_TAC `z:complex` THEN STRIP_TAC THEN + MP_TAC(SPEC `cnj z` ARG) THEN REAL_ARITH_TAC]; + REWRITE_TAC[GSYM ARG_EQ_0_PI; GSYM real; ARG_CNJ] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_SUB2; REAL_SUB_RZERO] THEN + ASM_REWRITE_TAC[REAL_ARITH `&2 * x - x = x`]]]);; + +let OPEN_ARG_LTT = prove + (`!s t. &0 <= s /\ t <= &2 * pi ==> open {z | s < Arg z /\ Arg z < t}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`Cx o Arg`; `(:complex) DIFF {z | real z /\ &0 <= Re z}`; + `{z | Re(z) > s} INTER {z | Re(z) < t}`] + CONTINUOUS_OPEN_PREIMAGE) THEN + ASM_SIMP_TAC[OPEN_INTER; OPEN_HALFSPACE_RE_GT; OPEN_HALFSPACE_RE_LT] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM; CONTINUOUS_AT_ARG]; + REWRITE_TAC[GSYM closed] THEN + REWRITE_TAC[SET_RULE `{z | P z /\ Q z} = P INTER {z | Q z}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN + REWRITE_TAC[CLOSED_REAL; GSYM real_ge; CLOSED_HALFSPACE_RE_GE]]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION] THEN + ASM_SIMP_TAC[IN_DIFF; IN_INTER; IN_UNIV; IN_ELIM_THM; o_THM; RE_CX; + GSYM ARG_EQ_0] THEN + ASM_REAL_ARITH_TAC]);; + +let OPEN_ARG_GT = prove + (`!t. open {z | t < Arg z}`, + GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `t < &0 \/ &0 <= t`) THENL + [SUBGOAL_THEN `{z | t < Arg z} = (:complex)` + (fun th -> SIMP_TAC[th; OPEN_UNIV]) THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_ELIM_THM] THEN + MP_TAC ARG THEN MATCH_MP_TAC MONO_FORALL THEN ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`t:real`; `&2 * pi`] OPEN_ARG_LTT) THEN + ASM_REWRITE_TAC[ARG; REAL_LE_REFL]]);; + +let CLOSED_ARG_LE = prove + (`!t. closed {z | Arg z <= t}`, + REWRITE_TAC[closed; DIFF; IN_UNIV; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_NOT_LE; OPEN_ARG_GT]);; + +(* ------------------------------------------------------------------------- *) +(* Relation between Arg and arctangent in upper halfplane. *) +(* ------------------------------------------------------------------------- *) + +let ARG_ATAN_UPPERHALF = prove + (`!z. &0 < Im z ==> Arg(z) = pi / &2 - atn(Re z / Im z)`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THEN + ASM_REWRITE_TAC[IM_CX; REAL_LT_REFL] THEN DISCH_TAC THEN + MATCH_MP_TAC ARG_UNIQUE THEN EXISTS_TAC `norm(z:complex)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_NZ] THEN CONJ_TAC THENL + [ALL_TAC; MP_TAC(ISPEC `Re z / Im z` ATN_BOUNDS) THEN REAL_ARITH_TAC] THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[SIN_SUB; COS_SUB; SIN_PI2; COS_PI2] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; SIN_ATN; COS_ATN] THEN + SUBGOAL_THEN `sqrt(&1 + (Re z / Im z) pow 2) = norm(z) / Im z` + SUBST1_TAC THENL + [MATCH_MP_TAC SQRT_UNIQUE THEN + ASM_SIMP_TAC[REAL_LE_DIV; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_POW_DIV; COMPLEX_SQNORM] THEN + UNDISCH_TAC `&0 < Im z` THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[REAL_ADD_LID; REAL_SUB_RZERO; real_div] THEN + REWRITE_TAC[COMPLEX_EQ; RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II; + RE_ADD; IM_ADD; RE_CX; IM_CX] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM COMPLEX_NORM_NZ]) THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD]);; + +(* ------------------------------------------------------------------------- *) +(* Real n'th roots. Regardless of whether n is odd or even, we totalize by *) +(* setting root_n(-x) = -root_n(x), which makes some convenient facts hold. *) +(* ------------------------------------------------------------------------- *) + +let root = new_definition + `root(n) x = real_sgn(x) * exp(log(abs x) / &n)`;; + +let ROOT_0 = prove + (`!n. root n (&0) = &0`, + REWRITE_TAC[root; REAL_SGN_0; REAL_MUL_LZERO]);; + +let ROOT_1 = prove + (`!n. root n (&1) = &1`, + REWRITE_TAC[root; REAL_ABS_NUM; LOG_1; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[real_sgn; REAL_EXP_0] THEN REAL_ARITH_TAC);; + +let ROOT_2 = prove + (`!x. root 2 x = sqrt x`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN + REWRITE_TAC[root; REAL_SGN_MUL; REAL_POW_MUL; REAL_SGN_REAL_SGN] THEN + REWRITE_TAC[REAL_SGN_POW_2; GSYM REAL_SGN_POW] THEN + SIMP_TAC[real_sgn; REAL_EXP_POS_LT; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `(&0 < abs x <=> ~(x = &0)) /\ ~(abs x < &0)`] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ABS_NUM; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_EXP_N; REAL_ARITH `&2 * x / &2 = x`] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_ARITH `&0 < abs x <=> ~(x = &0)`]);; + +let ROOT_NEG = prove + (`!n x. root n (--x) = --(root n x)`, + REWRITE_TAC[root; REAL_SGN_NEG; REAL_ABS_NEG; REAL_MUL_LNEG]);; + +let ROOT_WORKS = prove + (`!n x. real_sgn(root n x) = real_sgn x /\ + (root n x) pow n = if n = 0 then &1 + else real_sgn(x) pow n * abs x`, + REWRITE_TAC[root; REAL_SGN_MUL; REAL_POW_MUL; GSYM REAL_EXP_N] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_INV_0; + REAL_EXP_0; REAL_MUL_RID; real_pow; REAL_SGN_REAL_SGN] THEN + REWRITE_TAC[real_sgn; REAL_LT_01; REAL_MUL_RID] THEN + ASM_SIMP_TAC[REAL_EXP_POS_LT; REAL_MUL_RID; GSYM REAL_ABS_NZ; + GSYM real_div; REAL_DIV_LMUL; REAL_OF_NUM_EQ] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_POW_ZERO; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[EXP_LOG; GSYM REAL_ABS_NZ]);; + +let REAL_POW_ROOT = prove + (`!n x. ODD n \/ ~(n = 0) /\ &0 <= x ==> (root n x) pow n = x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[ARITH] THEN STRIP_TAC THEN ASM_REWRITE_TAC[ROOT_WORKS] THENL + [FIRST_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [ODD_EXISTS]) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] real_pow] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_SGN_ABS] THEN + REWRITE_TAC[GSYM REAL_POW_POW] THEN + REWRITE_TAC[REWRITE_RULE[REAL_SGN_POW] REAL_SGN_POW_2] THEN + REWRITE_TAC[real_sgn; GSYM REAL_ABS_NZ] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_LT_REFL; REAL_POW_ONE] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[real_sgn; REAL_LT_LE] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_POW_ZERO; REAL_POW_ONE] THEN + ASM_REAL_ARITH_TAC]);; + +let ROOT_POS_LT = prove + (`!n x. &0 < x ==> &0 < root n x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[root] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_EXP_POS_LT; REAL_SGN_INEQS]);; + +let ROOT_POS_LE = prove + (`!n x. &0 <= x ==> &0 <= root n x`, + MESON_TAC[REAL_LE_LT; ROOT_POS_LT; ROOT_0; REAL_LT_REFL]);; + +let ROOT_LT_0 = prove + (`!n x. &0 < root n x <=> &0 < x`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ROOT_POS_LT] THEN + REWRITE_TAC[GSYM REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_ARITH `x <= &0 <=> &0 <= --x`; GSYM ROOT_NEG] THEN + REWRITE_TAC[ROOT_POS_LE]);; + +let ROOT_LE_0 = prove + (`!n x. &0 <= root n x <=> &0 <= x`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[ROOT_POS_LE] THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_ARITH `x < &0 <=> &0 < --x`; GSYM ROOT_NEG] THEN + REWRITE_TAC[ROOT_POS_LT]);; + +let ROOT_EQ_0 = prove + (`!n x. root n x = &0 <=> x = &0`, + REWRITE_TAC[root; REAL_ENTIRE; REAL_EXP_NZ; REAL_SGN_INEQS]);; + +let REAL_ROOT_MUL = prove + (`!n x y. root n (x * y) = root n x * root n y`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; ROOT_0] THEN + ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; ROOT_0] THEN + REWRITE_TAC[root; REAL_SGN_MUL; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[LOG_MUL; GSYM REAL_ABS_NZ; real_div] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_EXP_ADD] THEN + REAL_ARITH_TAC);; + +let REAL_ROOT_POW_GEN = prove + (`!m n x y. root n (x pow m) = (root n x) pow m`, + INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_ROOT_MUL; ROOT_1; real_pow]);; + +let REAL_ROOT_POW = prove + (`!n x. ODD n \/ ~(n = 0) /\ &0 <= x ==> root n (x pow n) = x`, + SIMP_TAC[REAL_ROOT_POW_GEN; REAL_POW_ROOT]);; + +let ROOT_UNIQUE = prove + (`!n x y. y pow n = x /\ (ODD n \/ ~(n = 0) /\ &0 <= y) ==> root n x = y`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + UNDISCH_THEN `(y:real) pow n = x` (SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC REAL_ROOT_POW THEN ASM_REWRITE_TAC[]);; + +let REAL_ROOT_INV = prove + (`!n x. root n (inv x) = inv(root n x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[root; REAL_SGN_INV; REAL_INV_SGN] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_SGN_0; REAL_MUL_LZERO; REAL_INV_0] THEN + REWRITE_TAC[REAL_INV_MUL; REAL_INV_SGN; REAL_ABS_INV] THEN + ASM_SIMP_TAC[GSYM REAL_EXP_NEG; LOG_INV; GSYM REAL_ABS_NZ] THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG]);; + +let REAL_ROOT_DIV = prove + (`!n x y. root n (x / y) = root n x / root n y`, + SIMP_TAC[real_div; REAL_ROOT_MUL; REAL_ROOT_INV]);; + +let ROOT_MONO_LT = prove + (`!n x y. ~(n = 0) /\ x < y ==> root n x < root n y`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x y. &0 <= x /\ x < y ==> root n x < root n y` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[ROOT_WORKS; ROOT_LE_0] THEN + ASM_REWRITE_TAC[real_sgn] THEN REPEAT + (COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_ONE; REAL_POW_ZERO]) THEN + ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= x` THEN ASM_SIMP_TAC[] THEN + ASM_CASES_TAC `&0 <= y` THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LE; ROOT_LE_0]; + FIRST_X_ASSUM(MP_TAC o SPECL [`--y:real`; `--x:real`]) THEN + REWRITE_TAC[ROOT_NEG] THEN ASM_REAL_ARITH_TAC]]);; + +let ROOT_MONO_LE = prove + (`!n x y. x <= y ==> root n x <= root n y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[root; real_div; REAL_INV_0; REAL_MUL_RZERO; + REAL_EXP_0; REAL_MUL_RID] THEN + REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_LE_LT; ROOT_0; ROOT_MONO_LT]]);; + +let ROOT_MONO_LT_EQ = prove + (`!n x y. ~(n = 0) ==> (root n x < root n y <=> x < y)`, + MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; + +let ROOT_MONO_LE_EQ = prove + (`!n x y. ~(n = 0) ==> (root n x <= root n y <=> x <= y)`, + MESON_TAC[ROOT_MONO_LT; REAL_NOT_LT; ROOT_MONO_LE]);; + +let ROOT_INJ = prove + (`!n x y. ~(n = 0) ==> (root n x = root n y <=> x = y)`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; ROOT_MONO_LE_EQ]);; + +let REAL_ROOT_LE = prove + (`!n x y. ~(n = 0) /\ &0 <= y + ==> (root n x <= y <=> x <= y pow n)`, + MESON_TAC[REAL_ROOT_POW; REAL_POW_LE; ROOT_MONO_LE_EQ]);; + +let REAL_LE_ROOT = prove + (`!n x y. ~(n = 0) /\ &0 <= x + ==> (x <= root n y <=> x pow n <= y)`, + MESON_TAC[REAL_ROOT_POW; REAL_POW_LE; ROOT_MONO_LE_EQ]);; + +let LOG_ROOT = prove + (`!n x. ~(n = 0) /\ &0 < x ==> log(root n x) = log x / &n`, + SIMP_TAC[REAL_EQ_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[GSYM LOG_POW; ROOT_POS_LT; REAL_POW_ROOT; REAL_LT_IMP_LE]);; + +let ROOT_EXP_LOG = prove + (`!n x. ~(n = 0) /\ &0 < x ==> root n x = exp(log x / &n)`, + SIMP_TAC[root; real_sgn; real_abs; REAL_LT_IMP_LE; REAL_MUL_LID]);; + +let ROOT_PRODUCT = prove + (`!n f s. FINITE s ==> root n (product s f) = product s (\i. root n (f i))`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; REAL_ROOT_MUL; ROOT_1]);; + +let SQRT_PRODUCT = prove + (`!f s. FINITE s ==> sqrt(product s f) = product s (\i. sqrt(f i))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[PRODUCT_CLAUSES; SQRT_MUL; SQRT_1]);; + +(* ------------------------------------------------------------------------- *) +(* Real power function. This involves a few arbitrary choices. *) +(* *) +(* The value of x^y is unarguable when x > 0. *) +(* *) +(* We make 0^0 = 1 to agree with "pow", but otherwise 0^y = 0. *) +(* *) +(* There is a sensible real value for (-x)^(p/q) where q is odd and either *) +(* p is even [(-x)^y = x^y] or odd [(-x)^y = -x^y]. *) +(* *) +(* In all other cases, we return (-x)^y = -x^y. This is meaningless but at *) +(* least it covers half the cases above without another case split. *) +(* *) +(* As for laws of indices, we do have x^-y = 1/x^y. Of course we can't have *) +(* x^(yz) = x^y^z or x^(y+z) = x^y x^z since then (-1)^(1/2)^2 = -1. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("rpow",(24,"left"));; + +let rpow = new_definition + `x rpow y = if &0 < x then exp(y * log x) + else if x = &0 then if y = &0 then &1 else &0 + else if ?m n. ODD(m) /\ ODD(n) /\ (abs y = &m / &n) + then --(exp(y * log(--x))) + else exp(y * log(--x))`;; + +let RPOW_POW = prove + (`!x n. x rpow &n = x pow n`, + REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_EXP_N; EXP_LOG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_ZERO; REAL_OF_NUM_EQ] THEN + ASM_SIMP_TAC[EXP_LOG; REAL_ARITH `~(&0 < x) /\ ~(x = &0) ==> &0 < --x`] THEN + REWRITE_TAC[REAL_POW_NEG; REAL_ABS_NUM] THEN + SUBGOAL_THEN `(?p q. ODD(p) /\ ODD(q) /\ &n = &p / &q) <=> ODD n` + (fun th -> SIMP_TAC[th; GSYM NOT_ODD; REAL_NEG_NEG; COND_ID]) THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [REPEAT GEN_TAC THEN ASM_CASES_TAC `q = 0` THEN + ASM_REWRITE_TAC[ARITH_ODD] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `~(q = &0) ==> (n = p / q <=> q * n = p)`] THEN + REWRITE_TAC[REAL_OF_NUM_MUL; REAL_OF_NUM_EQ] THEN + ASM_MESON_TAC[ODD_MULT]; + DISCH_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `1`] THEN + ASM_REWRITE_TAC[REAL_DIV_1; ARITH_ODD]]);; + +let RPOW_0 = prove + (`!x. x rpow &0 = &1`, + REWRITE_TAC[RPOW_POW; real_pow]);; + +let RPOW_NEG = prove + (`!x y. x rpow (--y) = inv(x rpow y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_LNEG; REAL_EXP_NEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0] THENL + [COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_INV_1]; + REWRITE_TAC[REAL_ABS_NEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_NEG]]);; + +let RPOW_ZERO = prove + (`!y. &0 rpow y = if y = &0 then &1 else &0`, + REWRITE_TAC[rpow; REAL_LT_REFL]);; + +let RPOW_POS_LT = prove + (`!x y. &0 < x ==> &0 < x rpow y`, + SIMP_TAC[rpow; REAL_EXP_POS_LT]);; + +let RPOW_POS_LE = prove + (`!x y. &0 <= x ==> &0 <= x rpow y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[RPOW_ZERO] THEN MESON_TAC[REAL_POS]; + ASM_SIMP_TAC[RPOW_POS_LT; REAL_LE_LT]]);; + +let RPOW_LT2 = prove + (`!x y z. &0 <= x /\ x < y /\ &0 < z ==> x rpow z < y rpow z`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_SIMP_TAC[RPOW_ZERO; REAL_LT_IMP_NZ; RPOW_POS_LT] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[rpow] THEN + ASM_CASES_TAC `&0 < x /\ &0 < y` THENL + [ALL_TAC; MATCH_MP_TAC(TAUT `F ==> p`) THEN ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[REAL_EXP_MONO_LT; REAL_LT_LMUL_EQ] THEN + MATCH_MP_TAC LOG_MONO_LT_IMP THEN ASM_REAL_ARITH_TAC);; + +let RPOW_LE2 = prove + (`!x y z. &0 <= x /\ x <= y /\ &0 <= z ==> x rpow z <= y rpow z`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `z = &0` THEN + ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_LE_REFL] THEN + ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_MESON_TAC[RPOW_LT2; REAL_LE_LT]);; + +let REAL_ABS_RPOW = prove + (`!x y. abs(x rpow y) = abs(x) rpow y`, + REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_LT_REFL] THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; REAL_ABS_ZERO] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_ABS_EXP; REAL_ARITH `&0 < x ==> abs x = x`] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_EXP] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC);; + +let RPOW_ONE = prove + (`!z. &1 rpow z = &1`, + REWRITE_TAC[rpow; REAL_LT_01; LOG_1; REAL_MUL_RZERO; REAL_EXP_0]);; + +let RPOW_RPOW = prove + (`!x y z. &0 <= x ==> x rpow y rpow z = x rpow (y * z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[RPOW_ZERO; REAL_ENTIRE] THEN + ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[RPOW_ZERO; RPOW_ONE]; + SIMP_TAC[rpow; REAL_EXP_POS_LT; LOG_EXP] THEN + REWRITE_TAC[REAL_MUL_AC]]);; + +let RPOW_LNEG = prove + (`!x y. --x rpow y = + if ?m n. ODD m /\ ODD n /\ abs y = &m / &n + then --(x rpow y) else x rpow y`, + REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_NEG_0; REAL_ABS_NUM; REAL_LT_REFL] THENL + [ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0; COND_ID] THEN + REWRITE_TAC[REAL_ARITH `abs(&0) = m / n <=> m * inv n = &0`] THEN + SIMP_TAC[REAL_ENTIRE; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN MESON_TAC[ODD]; + ASM_SIMP_TAC[REAL_ARITH `~(x = &0) ==> (&0 < --x <=> ~(&0 < x))`] THEN + ASM_REWRITE_TAC[REAL_NEG_EQ_0] THEN + ASM_CASES_TAC `&0 < x` THEN ASM_REWRITE_TAC[REAL_NEG_NEG; COND_ID]]);; + +let RPOW_EQ_0 = prove + (`!x y. x rpow y = &0 <=> x = &0 /\ ~(y = &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[rpow] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_EXP_NZ]) THEN + REAL_ARITH_TAC);; + +let RPOW_MUL = prove + (`!x y z. (x * y) rpow z = x rpow z * y rpow z`, + SUBGOAL_THEN + `!x y z. &0 <= x /\ &0 <= y ==> (x * y) rpow z = x rpow z * y rpow z` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `z = &0` THEN + ASM_REWRITE_TAC[RPOW_POW; real_pow; REAL_MUL_LID] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO; RPOW_ZERO] THEN + ASM_CASES_TAC `y = &0` THEN ASM_REWRITE_TAC[REAL_MUL_RZERO; RPOW_ZERO] THEN + SIMP_TAC[rpow; REAL_LT_MUL; LOG_MUL; REAL_ADD_LDISTRIB; REAL_EXP_ADD]; + REPEAT GEN_TAC THEN + REPEAT_TCL DISJ_CASES_THEN (ANTE_RES_THEN (MP_TAC o SPEC `z:real`)) + (REAL_ARITH `&0 <= x /\ &0 <= y \/ &0 <= x /\ &0 <= --y \/ + &0 <= --x /\ &0 <= y \/ &0 <= --x /\ &0 <= --y`) THEN + REWRITE_TAC[RPOW_LNEG; REAL_MUL_RNEG; REAL_MUL_LNEG] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_EQ_NEG2]]);; + +let RPOW_INV = prove + (`!x y. inv(x) rpow y = inv(x rpow y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[rpow; REAL_LT_INV_EQ] THEN + SIMP_TAC[LOG_INV; REAL_MUL_RNEG; REAL_EXP_NEG] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_INV_EQ_0] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_INV_1; REAL_INV_0]) THEN + ASM_SIMP_TAC[GSYM REAL_INV_NEG; LOG_INV; + REAL_ARITH `~(&0 < x) /\ ~(x = &0) ==> &0 < --x`] THEN + REWRITE_TAC[REAL_MUL_RNEG; REAL_EXP_NEG; REAL_INV_NEG]);; + +let REAL_INV_RPOW = prove + (`!x y. inv(x rpow y) = inv(x) rpow y`, + REWRITE_TAC[RPOW_INV]);; + +let RPOW_DIV = prove + (`!x y z. (x / y) rpow z = x rpow z / y rpow z`, + REWRITE_TAC[real_div; RPOW_MUL; RPOW_INV]);; + +let RPOW_PRODUCT = prove + (`!s:A->bool x y. + FINITE s ==> (product s x) rpow y = product s (\i. x i rpow y)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[PRODUCT_CLAUSES; RPOW_MUL; RPOW_ONE]);; + +let RPOW_ADD = prove + (`!x y z. &0 < x ==> x rpow (y + z) = x rpow y * x rpow z`, + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[rpow; REAL_ADD_RDISTRIB; REAL_EXP_ADD]);; + +let RPOW_ADD_ALT = prove + (`!x y z. &0 <= x /\ (x = &0 /\ y + z = &0 ==> y = &0 \/ z = &0) + ==> x rpow (y + z) = x rpow y * x rpow z`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `x = &0` THEN ASM_SIMP_TAC[REAL_LE_LT; RPOW_ADD] THEN + REWRITE_TAC[RPOW_ZERO] THEN + ASM_CASES_TAC `y = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_ADD_LID] THEN + ASM_CASES_TAC `y + z = &0` THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +let RPOW_SQRT = prove + (`!x. &0 <= x ==> x rpow (&1 / &2) = sqrt x`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_RING + `x pow 2 = y pow 2 /\ (x + y = &0 ==> x = &0 /\ y = &0) + ==> x = y`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[SQRT_POW_2] THEN + ASM_SIMP_TAC[GSYM RPOW_POW; RPOW_RPOW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1]; + MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &0 <= y ==> x + y = &0 ==> x = &0 /\ y = &0`) THEN + ASM_SIMP_TAC[SQRT_POS_LE; RPOW_POS_LE]]);; + +let RPOW_MONO = prove + (`!a b x. &1 <= x /\ a <= b ==> x rpow a <= x rpow b`, + SIMP_TAC[rpow; REAL_ARITH `&1 <= x ==> &0 < x`] THEN + SIMP_TAC[REAL_EXP_MONO_LE; LOG_POS; REAL_LE_RMUL]);; + +let RPOW_MONO_INV = prove + (`!a b x. &0 < x /\ x <= &1 /\ b <= a ==> x rpow a <= x rpow b`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; RPOW_POS_LT; GSYM RPOW_INV] THEN + MATCH_MP_TAC RPOW_MONO THEN + ASM_SIMP_TAC[REAL_INV_1_LE]);; + +let RPOW_1_LE = prove + (`!a x. &0 <= x /\ x <= &1 /\ &0 <= a ==> x rpow a <= &1`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 rpow a` THEN CONJ_TAC THENL + [MATCH_MP_TAC RPOW_LE2 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[RPOW_ONE; REAL_LE_REFL]]);; + +let REAL_ROOT_RPOW = prove + (`!n x. ~(n = 0) /\ (&0 <= x \/ ODD n) ==> root n x = x rpow (inv(&n))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_SIMP_TAC[ROOT_0; RPOW_ZERO; REAL_INV_EQ_0; REAL_OF_NUM_EQ] THEN + ASM_CASES_TAC `&0 <= x` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [ASM_SIMP_TAC[ROOT_EXP_LOG; rpow; REAL_LT_LE] THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[rpow] THEN COND_CASES_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[ARITH]] THEN + MATCH_MP_TAC ROOT_UNIQUE THEN + ASM_REWRITE_TAC[REAL_POW_NEG; GSYM REAL_EXP_N; GSYM NOT_ODD] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `~(n = &0) ==> n * &1 / n * x = x`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `--x:real = y <=> x = --y`] THEN + MATCH_MP_TAC EXP_LOG THEN ASM_REAL_ARITH_TAC]);; + +let LOG_RPOW = prove + (`!x y. &0 < x ==> log(x rpow y) = y * log x`, + SIMP_TAC[rpow; LOG_EXP]);; + +let LOG_SQRT = prove + (`!x. &0 < x ==> log(sqrt x) = log x / &2`, + SIMP_TAC[GSYM RPOW_SQRT; LOG_RPOW; REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Formulation of loop homotopy in terms of maps out of S^1 *) +(* ------------------------------------------------------------------------- *) + +let HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS = prove + (`!f:complex->real^N g s. + homotopic_with (\h. T) (sphere(vec 0,&1),s) f g + ==> homotopic_loops s (f o cexp o (\t. Cx(&2 * pi * drop t) * ii)) + (g o cexp o (\t. Cx(&2 * pi * drop t) * ii))`, + REWRITE_TAC[homotopic_loops; sphere; DIST_0] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMOTOPIC_WITH_COMPOSE_CONTINUOUS_RIGHT THEN + EXISTS_TAC `{z:complex | norm z = &1}` THEN + REWRITE_TAC[pathstart; pathfinish; o_THM; DROP_VEC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 * pi * n = &2 * n * pi`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM; IN_ELIM_THM] THEN + ASM_SIMP_TAC[CEXP_INTEGER_2PI; INTEGER_CLOSED] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[COMPLEX_MUL_SYM] NORM_CEXP_II] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + REWRITE_TAC[CX_MUL] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST]) THEN + SIMP_TAC[CONTINUOUS_ON_CX_DROP; CONTINUOUS_ON_ID]);; + +let HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS = prove + (`!p q s:real^N->bool. + homotopic_loops s p q + ==> homotopic_with (\h. T) (sphere(vec 0,&1),s) + (p o (\z. lift(Arg z / (&2 * pi)))) + (q o (\z. lift(Arg z / (&2 * pi))))`, + let ulemma = prove + (`!s. s INTER (UNIV PCROSS {z | &0 <= Im z}) UNION + s INTER (UNIV PCROSS {z | Im z <= &0}) = s`, + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; IN_UNION; + PASTECART_IN_PCROSS] THEN + SET_TAC[REAL_LE_TOTAL]) in + REPEAT GEN_TAC THEN REWRITE_TAC[homotopic_loops; sphere; DIST_0] THEN + GEN_REWRITE_TAC LAND_CONV [homotopic_with] THEN + SIMP_TAC[pathstart; pathfinish; LEFT_IMP_EXISTS_THM; HOMOTOPIC_WITH] THEN + X_GEN_TAC `h:real^(1,1)finite_sum->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `\w. (h:real^(1,1)finite_sum->real^N) + (pastecart (fstcart w) + (lift(Arg(sndcart w) / (&2 * pi))))` THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; o_THM] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC + `(\z. if &0 <= Im(sndcart z) + then h (pastecart (fstcart z) (lift(Arg(sndcart z) / (&2 * pi)))) + else h (pastecart (fstcart z) + (vec 1 - lift(Arg(cnj(sndcart z)) / (&2 * pi))))) + :real^(1,2)finite_sum->real^N` THEN + REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`t:real^1`; `z:complex`] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARG_CNJ] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[real; REAL_LE_REFL]; ALL_TAC] THEN + SIMP_TAC[PI_POS; LIFT_SUB; LIFT_NUM; REAL_FIELD + `&0 < pi ==> (&2 * pi - z) / (&2 * pi) = &1 - z / (&2 * pi)`] THEN + REWRITE_TAC[VECTOR_ARITH `a - (a - b):real^N = b`]; + GEN_REWRITE_TAC RAND_CONV [GSYM ulemma] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN REWRITE_TAC[ulemma] THEN + SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_HALFSPACE_IM_LE; CLOSED_UNIV; + CLOSED_PCROSS; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_IM_GE] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS; IN_INTER; IN_DIFF; + FSTCART_PASTECART; SNDCART_PASTECART; IN_UNIV; IN_SING; IN_ELIM_THM; + GSYM CONJ_ASSOC; REAL_LE_ANTISYM; TAUT `~(p /\ ~p)`] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM ARG_EQ_0_PI; GSYM real; ARG_CNJ] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_ARITH `&2 * x - x = x`; COND_ID; GSYM LIFT_NUM; PI_POS; + GSYM LIFT_SUB; REAL_FIELD + `&0 < pi ==> &1 - pi / (&2 * pi) = pi / (&2 * pi)`] THEN + COND_CASES_TAC THEN + SIMP_TAC[REAL_SUB_RZERO; REAL_DIV_REFL; REAL_ENTIRE; REAL_OF_NUM_EQ; + ARITH_EQ; PI_NZ] THEN + SIMP_TAC[real_div; REAL_MUL_LZERO; REAL_SUB_REFL; REAL_SUB_RZERO] THEN + ASM_SIMP_TAC[LIFT_NUM]] THEN + GEN_REWRITE_TAC (BINOP_CONV o LAND_CONV) [GSYM o_DEF] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + REWRITE_TAC[real_div; REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN + MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; + PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `z:complex`] THEN + SIMP_TAC[IN_DIFF; IN_ELIM_THM; IN_SING] THEN + ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; + PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART; + FSTCART_PASTECART] THEN + SIMP_TAC[IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_MUL_LZERO; + REAL_MUL_LID; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN + SIMP_TAC[ARG; REAL_LT_IMP_LE]; + MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[real_div; REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM o_DEF] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART; CONTINUOUS_ON_COMPOSE; + CONTINUOUS_ON_CNJ] THEN + REWRITE_TAC[o_DEF; GSYM CONTINUOUS_ON_CX_LIFT] THEN + MP_TAC CONTINUOUS_ON_UPPERHALF_ARG THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; + PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN + MAP_EVERY X_GEN_TAC [`t:real^1`; `z:complex`] THEN + SIMP_TAC[IN_DIFF; IN_ELIM_THM; IN_SING] THEN + SIMP_TAC[IM_CNJ; REAL_NEG_GE0; CNJ_EQ_0] THEN + ASM_CASES_TAC `z = Cx(&0)` THEN ASM_REWRITE_TAC[COMPLEX_NORM_0] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_PASTECART; IN_INTER; + PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART; + FSTCART_PASTECART] THEN + SIMP_TAC[IN_INTERVAL_1; DROP_SUB; DROP_VEC; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `&0 <= &1 - x /\ &1 - x <= &1 <=> + &0 <= x /\ x <= &1`] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; REAL_MUL_LZERO; + REAL_MUL_LID; REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN + SIMP_TAC[ARG; REAL_LT_IMP_LE]]]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; FORALL_IN_PCROSS; IN_ELIM_THM] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `IMAGE h s SUBSET t ==> y IN s ==> h y IN t`)) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS; IN_INTERVAL_1; LIFT_DROP] THEN + SIMP_TAC[DROP_VEC; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; PI_POS; + REAL_ARITH `&0 < &2 * x <=> &0 < x`] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; ARG; REAL_LT_IMP_LE]]);; + +let SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS, + SIMPLY_CONNECTED_EQ_CONTRACTIBLE_CIRCLEMAP = + (CONJ_PAIR o prove) + (`(!s:real^N->bool. + simply_connected s <=> + !f g:complex->real^N. + f continuous_on sphere(vec 0,&1) /\ + IMAGE f (sphere(vec 0,&1)) SUBSET s /\ + g continuous_on sphere(vec 0,&1) /\ + IMAGE g (sphere(vec 0,&1)) SUBSET s + ==> homotopic_with (\h. T) (sphere(vec 0,&1),s) f g) /\ + (!s:real^N->bool. + simply_connected s <=> + path_connected s /\ + !f:real^2->real^N. + f continuous_on sphere(vec 0,&1) /\ + IMAGE f (sphere(vec 0,&1)) SUBSET s + ==> ?a. homotopic_with (\h. T) (sphere(vec 0,&1),s) f (\x. a))`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[simply_connected] THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`f:complex->real^N`; `g:complex->real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`(f:complex->real^N) o cexp o (\t. Cx(&2 * pi * drop t) * ii)`; + `(g:complex->real^N) o cexp o (\t. Cx(&2 * pi * drop t) * ii)`]) THEN + ONCE_REWRITE_TAC[TAUT `p1 /\ q1 /\ r1 /\ p2 /\ q2 /\ r2 <=> + (p1 /\ r1 /\ q1) /\ (p2 /\ r2 /\ q2)`] THEN + REWRITE_TAC[GSYM HOMOTOPIC_LOOPS_REFL] THEN + ASM_SIMP_TAC[HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS; + HOMOTOPIC_WITH_REFL] THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] HOMOTOPIC_WITH_EQ) THEN + REWRITE_TAC[IN_SPHERE_0; LIFT_DROP; o_DEF] THEN X_GEN_TAC `z:complex` THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN MP_TAC(SPEC `z:complex` ARG) THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LID] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN SIMP_TAC[PI_POS; + REAL_FIELD `&0 < pi ==> &2 * pi * x / (&2 * pi) = x`] THEN + ASM_MESON_TAC[COMPLEX_MUL_SYM]; + DISCH_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[PATH_CONNECTED_EQ_HOMOTOPIC_POINTS] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(\x. a):complex->real^N`; `(\x. b):complex->real^N`]) THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN DISCH_THEN + (MP_TAC o MATCH_MP HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS) THEN + REWRITE_TAC[o_DEF; LINEPATH_REFL]; + X_GEN_TAC `f:complex->real^N` THEN STRIP_TAC THEN + EXISTS_TAC `f(Cx(&1)):real^N` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0]) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN REAL_ARITH_TAC]; + STRIP_TAC THEN + ASM_REWRITE_TAC[SIMPLY_CONNECTED_EQ_CONTRACTIBLE_LOOP_SOME] THEN + X_GEN_TAC `p:real^1->real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(p:real^1->real^N) o (\z. lift(Arg z / (&2 * pi)))`) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `p:real^1->real^N`] + HOMOTOPIC_LOOPS_REFL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP + HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS) THEN + SIMP_TAC[HOMOTOPIC_WITH_REFL]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP HOMOTOPIC_CIRCLEMAPS_IMP_HOMOTOPIC_LOOPS) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HOMOTOPIC_WITH_IMP_SUBSET) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_SPHERE_0; o_DEF] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(&1)` o CONJUNCT2) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[LINEPATH_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] HOMOTOPIC_LOOPS_TRANS) THEN + MATCH_MP_TAC HOMOTOPIC_LOOPS_EQ THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTERVAL_1; FORALL_LIFT; LIFT_DROP; DROP_VEC] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_CASES_TAC `t = &1` THENL + [ASM_REWRITE_TAC[REAL_ARITH `&2 * pi * &1 = &2 * &1 * pi`] THEN + SIMP_TAC[CEXP_INTEGER_2PI; INTEGER_CLOSED; ARG_NUM] THEN + REWRITE_TAC[real_div; REAL_MUL_LZERO; LIFT_NUM] THEN + ASM_MESON_TAC[pathstart; pathfinish]; + AP_TERM_TAC THEN AP_TERM_TAC THEN SIMP_TAC[PI_POS; REAL_FIELD + `&0 < pi ==> (t = x / (&2 * pi) <=> x = &2 * pi * t)`] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `Im(Cx (&2 * pi * t) * ii)` THEN + CONJ_TAC THENL [MATCH_MP_TAC ARG_CEXP; ALL_TAC] THEN + SIMP_TAC[IM_MUL_II; RE_CX; REAL_ARITH + `a < &2 * pi <=> a < &2 * pi * &1`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_LMUL_EQ; REAL_OF_NUM_LT; ARITH; + PI_POS; REAL_LT_IMP_LE; REAL_POS; REAL_LE_MUL] THEN + ASM_REWRITE_TAC[REAL_LT_LE]]]]);; + +let HOMOTOPY_EQUIVALENT_SIMPLE_CONNECTEDNESS = prove + (`!s:real^M->bool t:real^N->bool. + s homotopy_equivalent t + ==> (simply_connected s <=> simply_connected t)`, + REWRITE_TAC[SIMPLY_CONNECTED_EQ_HOMOTOPIC_CIRCLEMAPS] THEN + REWRITE_TAC[HOMOTOPY_EQUIVALENT_HOMOTOPIC_TRIVIALITY]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphism of simple closed curves to circles. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE = prove + (`!g:real^1->real^N a:real^2 r. + simple_path g /\ pathfinish g = pathstart g /\ &0 < r + ==> (path_image g) homeomorphic sphere(a,r)`, + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `sphere(vec 0:real^2,&1)` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_SPHERES; REAL_LT_01] THEN MP_TAC(ISPECL + [`g:real^1->real^N`; `g:real^1->real^N`; `path_image(g:real^1->real^N)`] + HOMOTOPIC_LOOPS_IMP_HOMOTOPIC_CIRCLEMAPS) THEN + REWRITE_TAC[HOMOTOPIC_LOOPS_REFL; HOMOTOPIC_WITH_REFL; SUBSET_REFL] THEN + ASM_SIMP_TAC[SIMPLE_PATH_IMP_PATH] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN REWRITE_TAC[homeomorphic] THEN + EXISTS_TAC `(g:real^1->real^N) o (\z. lift(Arg z / (&2 * pi)))` THEN + MATCH_MP_TAC HOMEOMORPHISM_COMPACT THEN + ASM_REWRITE_TAC[COMPACT_SPHERE] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; path_image; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[DROP_VEC] THEN STRIP_TAC THEN + REWRITE_TAC[IN_IMAGE; o_THM; IN_SPHERE_0] THEN + ASM_CASES_TAC `t:real^1 = vec 1` THENL + [EXISTS_TAC `Cx(&1)` THEN + ASM_REWRITE_TAC[ARG_NUM; COMPLEX_NORM_CX; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[LIFT_NUM; REAL_ABS_NUM] THEN + ASM_MESON_TAC[pathstart; pathfinish]; + EXISTS_TAC `cexp(ii * Cx(&2 * pi * drop t))` THEN + REWRITE_TAC[NORM_CEXP_II] THEN AP_TERM_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) ARG_CEXP o + lhand o rand o rand o snd) THEN + REWRITE_TAC[IM_MUL_II; RE_CX] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LE_MUL; PI_POS_LE; REAL_POS] THEN + SIMP_TAC[REAL_ARITH `&2 * pi * x < &2 * pi <=> pi * x < pi * &1`; + REAL_LT_LMUL_EQ; PI_POS] THEN + ASM_REWRITE_TAC[REAL_LT_LE] THEN + ASM_REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN + MP_TAC PI_POS THEN CONV_TAC REAL_FIELD]]; + MAP_EVERY X_GEN_TAC [`w:complex`; `z:complex`] THEN + REWRITE_TAC[IN_SPHERE_0] THEN STRIP_TAC THEN + MAP_EVERY (SUBST1_TAC o last o CONJUNCTS o C SPEC ARG) + [`w:complex`; `z:complex`] THEN + FIRST_X_ASSUM(MP_TAC o SYM o SYM) THEN + ASM_REWRITE_TAC[o_DEF; COMPLEX_MUL_LID] THEN DISCH_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < pi /\ x / (&2 * pi) = y / (&2 * pi) ==> x = y`) THEN + REWRITE_TAC[PI_POS; GSYM LIFT_EQ] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [simple_path]) THEN + DISCH_THEN(MP_TAC o SPECL + [`lift(Arg w / (&2 * pi))`; `lift(Arg z / (&2 * pi))`] o CONJUNCT2) THEN + ASM_REWRITE_TAC[GSYM LIFT_NUM; IN_INTERVAL_1; LIFT_DROP; LIFT_EQ] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; PI_POS; + REAL_ARITH `&0 < &2 * x <=> &0 < x`; + REAL_FIELD `&0 < y ==> (x / y = &1 <=> x = y)`] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_LID; ARG; REAL_LT_IMP_LE; + REAL_LT_IMP_NE]]);; + +let HOMEOMORPHIC_SIMPLE_PATH_IMAGES = prove + (`!g:real^1->real^M h:real^1->real^N. + simple_path g /\ pathfinish g = pathstart g /\ + simple_path h /\ pathfinish h = pathstart h + ==> (path_image g) homeomorphic (path_image h)`, + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `sphere(vec 0:real^2,&1)` THEN + CONJ_TAC THENL [ALL_TAC; ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM]] THEN + MATCH_MP_TAC HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE THEN + ASM_REWRITE_TAC[REAL_LT_01]);; + +let ENR_PATH_IMAGE_SIMPLE_PATH = prove + (`!g:real^1->real^N. simple_path g ==> ENR(path_image g)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `pathfinish g:real^N = pathstart g` THENL + [MP_TAC(ISPECL [`g:real^1->real^N`; `vec 0:real^2`; `&1`] + HOMEOMORPHIC_SIMPLE_PATH_IMAGE_CIRCLE) THEN + ASM_REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP HOMEOMORPHIC_ENRNESS) THEN + REWRITE_TAC[ENR_SPHERE]; + REWRITE_TAC[ENR] THEN EXISTS_TAC `(:real^N)` THEN + REWRITE_TAC[OPEN_UNIV] THEN + MATCH_MP_TAC ABSOLUTE_RETRACT_PATH_IMAGE_ARC THEN + ASM_REWRITE_TAC[ARC_SIMPLE_PATH; SUBSET_UNIV]]);; + +let ANR_PATH_IMAGE_SIMPLE_PATH = prove + (`!g:real^1->real^N. simple_path g ==> ANR(path_image g)`, + SIMP_TAC[ENR_PATH_IMAGE_SIMPLE_PATH; ENR_IMP_ANR]);; diff --git a/Multivariate/vectors.ml b/Multivariate/vectors.ml new file mode 100644 index 0000000..1358cc3 --- /dev/null +++ b/Multivariate/vectors.ml @@ -0,0 +1,8658 @@ +(* ========================================================================= *) +(* Real vectors in Euclidean space, and elementary linear algebra. *) +(* *) +(* (c) Copyright, John Harrison 1998-2008 *) +(* ========================================================================= *) + +needs "Multivariate/misc.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some common special cases. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_1 = prove + (`(!i. 1 <= i /\ i <= 1 ==> P i) <=> P 1`, + MESON_TAC[LE_ANTISYM]);; + +let FORALL_2 = prove + (`!P. (!i. 1 <= i /\ i <= 2 ==> P i) <=> P 1 /\ P 2`, + MESON_TAC[ARITH_RULE `1 <= i /\ i <= 2 <=> i = 1 \/ i = 2`]);; + +let FORALL_3 = prove + (`!P. (!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`, + MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> i = 1 \/ i = 2 \/ i = 3`]);; + +let FORALL_4 = prove + (`!P. (!i. 1 <= i /\ i <= 4 ==> P i) <=> P 1 /\ P 2 /\ P 3 /\ P 4`, + MESON_TAC[ARITH_RULE `1 <= i /\ i <= 4 <=> + i = 1 \/ i = 2 \/ i = 3 \/ i = 4`]);; + +let SUM_1 = prove + (`sum(1..1) f = f(1)`, + REWRITE_TAC[SUM_SING_NUMSEG]);; + +let SUM_2 = prove + (`!t. sum(1..2) t = t(1) + t(2)`, + REWRITE_TAC[num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; + +let SUM_3 = prove + (`!t. sum(1..3) t = t(1) + t(2) + t(3)`, + REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; + +let SUM_4 = prove + (`!t. sum(1..4) t = t(1) + t(2) + t(3) + t(4)`, + SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Basic componentwise operations on vectors. *) +(* ------------------------------------------------------------------------- *) + +let vector_add = new_definition + `(vector_add:real^N->real^N->real^N) x y = lambda i. x$i + y$i`;; + +let vector_sub = new_definition + `(vector_sub:real^N->real^N->real^N) x y = lambda i. x$i - y$i`;; + +let vector_neg = new_definition + `(vector_neg:real^N->real^N) x = lambda i. --(x$i)`;; + +overload_interface ("+",`(vector_add):real^N->real^N->real^N`);; +overload_interface ("-",`(vector_sub):real^N->real^N->real^N`);; +overload_interface ("--",`(vector_neg):real^N->real^N`);; + +prioritize_real();; + +let prioritize_vector = let ty = `:real^N` in + fun () -> prioritize_overload ty;; + +(* ------------------------------------------------------------------------- *) +(* Also the scalar-vector multiplication. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("%",(21,"right"));; + +let vector_mul = new_definition + `((%):real->real^N->real^N) c x = lambda i. c * x$i`;; + +(* ------------------------------------------------------------------------- *) +(* Vectors corresponding to small naturals. Perhaps should overload "&"? *) +(* ------------------------------------------------------------------------- *) + +let vec = new_definition + `(vec:num->real^N) n = lambda i. &n`;; + +(* ------------------------------------------------------------------------- *) +(* Dot products. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("dot",(20,"right"));; + +let dot = new_definition + `(x:real^N) dot (y:real^N) = sum(1..dimindex(:N)) (\i. x$i * y$i)`;; + +let DOT_1 = prove + (`(x:real^1) dot (y:real^1) = x$1 * y$1`, + REWRITE_TAC[dot; DIMINDEX_1; SUM_1]);; + +let DOT_2 = prove + (`(x:real^2) dot (y:real^2) = x$1 * y$1 + x$2 * y$2`, + REWRITE_TAC[dot; DIMINDEX_2; SUM_2]);; + +let DOT_3 = prove + (`(x:real^3) dot (y:real^3) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3`, + REWRITE_TAC[dot; DIMINDEX_3; SUM_3]);; + +let DOT_4 = prove + (`(x:real^4) dot (y:real^4) = x$1 * y$1 + x$2 * y$2 + x$3 * y$3 + x$4 * y$4`, + REWRITE_TAC[dot; DIMINDEX_4; SUM_4]);; + +(* ------------------------------------------------------------------------- *) +(* A naive proof procedure to lift really trivial arithmetic stuff from R. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_ARITH_TAC = + let RENAMED_LAMBDA_BETA th = + if fst(dest_fun_ty(type_of(funpow 3 rand (concl th)))) = aty + then INST_TYPE [aty,bty; bty,aty] LAMBDA_BETA else LAMBDA_BETA in + POP_ASSUM_LIST(K ALL_TAC) THEN + REPEAT(GEN_TAC ORELSE CONJ_TAC ORELSE DISCH_TAC ORELSE EQ_TAC) THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[dot; GSYM SUM_ADD_NUMSEG; GSYM SUM_SUB_NUMSEG; + GSYM SUM_LMUL; GSYM SUM_RMUL; GSYM SUM_NEG] THEN + (MATCH_MP_TAC SUM_EQ_NUMSEG ORELSE MATCH_MP_TAC SUM_EQ_0_NUMSEG ORELSE + GEN_REWRITE_TAC ONCE_DEPTH_CONV [CART_EQ]) THEN + REWRITE_TAC[AND_FORALL_THM] THEN TRY EQ_TAC THEN + TRY(MATCH_MP_TAC MONO_FORALL) THEN GEN_TAC THEN + REWRITE_TAC[TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; + TAUT `(a ==> b) \/ (a ==> c) <=> a ==> b \/ c`] THEN + TRY(MATCH_MP_TAC(TAUT `(a ==> b ==> c) ==> (a ==> b) ==> (a ==> c)`)) THEN + REWRITE_TAC[vector_add; vector_sub; vector_neg; vector_mul; vec] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP(RENAMED_LAMBDA_BETA th) th]) THEN + REAL_ARITH_TAC;; + +let VECTOR_ARITH tm = prove(tm,VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Obvious "component-pushing". *) +(* ------------------------------------------------------------------------- *) + +let VEC_COMPONENT = prove + (`!k i. (vec k :real^N)$i = &k`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL + [REWRITE_TAC[FINITE_INDEX_INRANGE]; + ASM_SIMP_TAC[vec; CART_EQ; LAMBDA_BETA]]);; + +let VECTOR_ADD_COMPONENT = prove + (`!x:real^N y i. (x + y)$i = x$i + y$i`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL + [REWRITE_TAC[FINITE_INDEX_INRANGE]; + ASM_SIMP_TAC[vector_add; CART_EQ; LAMBDA_BETA]]);; + +let VECTOR_SUB_COMPONENT = prove + (`!x:real^N y i. (x - y)$i = x$i - y$i`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL + [REWRITE_TAC[FINITE_INDEX_INRANGE]; + ASM_SIMP_TAC[vector_sub; CART_EQ; LAMBDA_BETA]]);; + +let VECTOR_NEG_COMPONENT = prove + (`!x:real^N i. (--x)$i = --(x$i)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL + [REWRITE_TAC[FINITE_INDEX_INRANGE]; + ASM_SIMP_TAC[vector_neg; CART_EQ; LAMBDA_BETA]]);; + +let VECTOR_MUL_COMPONENT = prove + (`!c x:real^N i. (c % x)$i = c * x$i`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !z:real^N. z$i = z$k` + CHOOSE_TAC THENL + [REWRITE_TAC[FINITE_INDEX_INRANGE]; + ASM_SIMP_TAC[vector_mul; CART_EQ; LAMBDA_BETA]]);; + +let COND_COMPONENT = prove + (`(if b then x else y)$i = if b then x$i else y$i`, + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some frequently useful arithmetic lemmas over vectors. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_ADD_SYM = VECTOR_ARITH `!x y:real^N. x + y = y + x`;; + +let VECTOR_ADD_LID = VECTOR_ARITH `!x. vec 0 + x = x`;; + +let VECTOR_ADD_RID = VECTOR_ARITH `!x. x + vec 0 = x`;; + +let VECTOR_SUB_REFL = VECTOR_ARITH `!x. x - x = vec 0`;; + +let VECTOR_ADD_LINV = VECTOR_ARITH `!x. --x + x = vec 0`;; + +let VECTOR_ADD_RINV = VECTOR_ARITH `!x. x + --x = vec 0`;; + +let VECTOR_SUB_RADD = VECTOR_ARITH `!x y. x - (x + y) = --y:real^N`;; + +let VECTOR_NEG_SUB = VECTOR_ARITH `!x:real^N y. --(x - y) = y - x`;; + +let VECTOR_SUB_EQ = VECTOR_ARITH `!x y. (x - y = vec 0) <=> (x = y)`;; + +let VECTOR_MUL_ASSOC = VECTOR_ARITH `!a b x. a % (b % x) = (a * b) % x`;; + +let VECTOR_MUL_LID = VECTOR_ARITH `!x. &1 % x = x`;; + +let VECTOR_MUL_LZERO = VECTOR_ARITH `!x. &0 % x = vec 0`;; + +let VECTOR_SUB_ADD = VECTOR_ARITH `(x - y) + y = x:real^N`;; + +let VECTOR_SUB_ADD2 = VECTOR_ARITH `y + (x - y) = x:real^N`;; + +let VECTOR_ADD_LDISTRIB = VECTOR_ARITH `c % (x + y) = c % x + c % y`;; + +let VECTOR_SUB_LDISTRIB = VECTOR_ARITH `c % (x - y) = c % x - c % y`;; + +let VECTOR_ADD_RDISTRIB = VECTOR_ARITH `(a + b) % x = a % x + b % x`;; + +let VECTOR_SUB_RDISTRIB = VECTOR_ARITH `(a - b) % x = a % x - b % x`;; + +let VECTOR_ADD_SUB = VECTOR_ARITH `(x + y:real^N) - x = y`;; + +let VECTOR_EQ_ADDR = VECTOR_ARITH `(x + y = x) <=> (y = vec 0)`;; + +let VECTOR_SUB = VECTOR_ARITH `x - y = x + --(y:real^N)`;; + +let VECTOR_SUB_RZERO = VECTOR_ARITH `x - vec 0 = x`;; + +let VECTOR_MUL_RZERO = VECTOR_ARITH `c % vec 0 = vec 0`;; + +let VECTOR_NEG_MINUS1 = VECTOR_ARITH `--x = (--(&1)) % x`;; + +let VECTOR_ADD_ASSOC = VECTOR_ARITH `(x:real^N) + y + z = (x + y) + z`;; + +let VECTOR_SUB_LZERO = VECTOR_ARITH `vec 0 - x = --x`;; + +let VECTOR_NEG_NEG = VECTOR_ARITH `--(--(x:real^N)) = x`;; + +let VECTOR_MUL_LNEG = VECTOR_ARITH `--c % x = --(c % x)`;; + +let VECTOR_MUL_RNEG = VECTOR_ARITH `c % --x = --(c % x)`;; + +let VECTOR_NEG_0 = VECTOR_ARITH `--(vec 0) = vec 0`;; + +let VECTOR_NEG_EQ_0 = VECTOR_ARITH `--x = vec 0 <=> x = vec 0`;; + +let VECTOR_EQ_NEG2 = VECTOR_ARITH `!x y:real^N. --x = --y <=> x = y`;; + +let VECTOR_ADD_AC = VECTOR_ARITH + `(m + n = n + m:real^N) /\ + ((m + n) + p = m + n + p) /\ + (m + n + p = n + m + p)`;; + +let VEC_EQ = prove + (`!m n. (vec m = vec n) <=> (m = n)`, + SIMP_TAC[CART_EQ; VEC_COMPONENT; REAL_OF_NUM_EQ] THEN + MESON_TAC[LE_REFL; DIMINDEX_GE_1]);; + +(* ------------------------------------------------------------------------- *) +(* Analogous theorems for set-sums. *) +(* ------------------------------------------------------------------------- *) + +let SUMS_SYM = prove + (`!s t:real^N->bool. + {x + y | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);; + +let SUMS_ASSOC = prove + (`!s t u:real^N->bool. + {w + z | w IN {x + y | x IN s /\ y IN t} /\ z IN u} = + {x + v | x IN s /\ v IN {y + z | y IN t /\ z IN u}}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Infinitude of Euclidean space. *) +(* ------------------------------------------------------------------------- *) + +let EUCLIDEAN_SPACE_INFINITE = prove + (`INFINITE(:real^N)`, + REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `vec:num->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] FINITE_IMAGE_INJ)) THEN + REWRITE_TAC[VEC_EQ; SET_RULE `{x | f x IN UNIV} = UNIV`] THEN + REWRITE_TAC[GSYM INFINITE; num_INFINITE]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of the dot product. *) +(* ------------------------------------------------------------------------- *) + +let DOT_SYM = VECTOR_ARITH `!x y. x dot y = y dot x`;; + +let DOT_LADD = VECTOR_ARITH `!x y z. (x + y) dot z = (x dot z) + (y dot z)`;; + +let DOT_RADD = VECTOR_ARITH `!x y z. x dot (y + z) = (x dot y) + (x dot z)`;; + +let DOT_LSUB = VECTOR_ARITH `!x y z. (x - y) dot z = (x dot z) - (y dot z)`;; + +let DOT_RSUB = VECTOR_ARITH `!x y z. x dot (y - z) = (x dot y) - (x dot z)`;; + +let DOT_LMUL = VECTOR_ARITH `!c x y. (c % x) dot y = c * (x dot y)`;; + +let DOT_RMUL = VECTOR_ARITH `!c x y. x dot (c % y) = c * (x dot y)`;; + +let DOT_LNEG = VECTOR_ARITH `!x y. (--x) dot y = --(x dot y)`;; + +let DOT_RNEG = VECTOR_ARITH `!x y. x dot (--y) = --(x dot y)`;; + +let DOT_LZERO = VECTOR_ARITH `!x. (vec 0) dot x = &0`;; + +let DOT_RZERO = VECTOR_ARITH `!x. x dot (vec 0) = &0`;; + +let DOT_POS_LE = prove + (`!x. &0 <= x dot x`, + SIMP_TAC[dot; SUM_POS_LE_NUMSEG; REAL_LE_SQUARE]);; + +let DOT_EQ_0 = prove + (`!x:real^N. ((x dot x = &0) <=> (x = vec 0))`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[DOT_LZERO]] THEN + SIMP_TAC[dot; CART_EQ; vec; LAMBDA_BETA] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM(REWRITE_CONV[REAL_ENTIRE] `x * x = &0`)] THEN + MATCH_MP_TAC SUM_POS_EQ_0_NUMSEG THEN ASM_REWRITE_TAC[REAL_LE_SQUARE]);; + +let DOT_POS_LT = prove + (`!x. (&0 < x dot x) <=> ~(x = vec 0)`, + REWRITE_TAC[REAL_LT_LE; DOT_POS_LE] THEN MESON_TAC[DOT_EQ_0]);; + +let FORALL_DOT_EQ_0 = prove + (`(!y. (!x. x dot y = &0) <=> y = vec 0) /\ + (!x. (!y. x dot y = &0) <=> x = vec 0)`, + MESON_TAC[DOT_LZERO; DOT_RZERO; DOT_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* Introduce norms, but defer many properties till we get square roots. *) +(* ------------------------------------------------------------------------- *) + +make_overloadable "norm" `:A->real`;; +overload_interface("norm",`vector_norm:real^N->real`);; + +let vector_norm = new_definition + `norm x = sqrt(x dot x)`;; + +(* ------------------------------------------------------------------------- *) +(* Useful for the special cases of 1 dimension. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_DIMINDEX_1 = prove + (`(!i. 1 <= i /\ i <= dimindex(:1) ==> P i) <=> P 1`, + MESON_TAC[DIMINDEX_1; LE_ANTISYM]);; + +(* ------------------------------------------------------------------------- *) +(* The collapse of the general concepts to the real line R^1. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_ONE = prove + (`!x:real^1. x = lambda i. x$1`, + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[DIMINDEX_1; LE_ANTISYM]);; + +let FORALL_REAL_ONE = prove + (`(!x:real^1. P x) <=> (!x. P(lambda i. x))`, + EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^1)$1`) THEN + REWRITE_TAC[GSYM VECTOR_ONE]);; + +let NORM_REAL = prove + (`!x:real^1. norm(x) = abs(x$1)`, + REWRITE_TAC[vector_norm; dot; DIMINDEX_1; SUM_SING_NUMSEG; + GSYM REAL_POW_2; POW_2_SQRT_ABS]);; + +(* ------------------------------------------------------------------------- *) +(* Metric function. *) +(* ------------------------------------------------------------------------- *) + +override_interface("dist",`distance:real^N#real^N->real`);; + +let dist = new_definition + `dist(x,y) = norm(x - y)`;; + +let DIST_REAL = prove + (`!x:real^1 y. dist(x,y) = abs(x$1 - y$1)`, + SIMP_TAC[dist; NORM_REAL; vector_sub; LAMBDA_BETA; LE_REFL; DIMINDEX_1]);; + +(* ------------------------------------------------------------------------- *) +(* A connectedness or intermediate value lemma with several applications. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_REAL_LEMMA = prove + (`!f:real->real^N a b e1 e2. + a <= b /\ f(a) IN e1 /\ f(b) IN e2 /\ + (!e x. a <= x /\ x <= b /\ &0 < e + ==> ?d. &0 < d /\ + !y. abs(y - x) < d ==> dist(f(y),f(x)) < e) /\ + (!y. y IN e1 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e1) /\ + (!y. y IN e2 ==> ?e. &0 < e /\ !y'. dist(y',y) < e ==> y' IN e2) /\ + ~(?x. a <= x /\ x <= b /\ f(x) IN e1 /\ f(x) IN e2) + ==> ?x. a <= x /\ x <= b /\ ~(f(x) IN e1) /\ ~(f(x) IN e2)`, + let tac = ASM_MESON_TAC[REAL_LT_IMP_LE; REAL_LE_TOTAL; REAL_LE_ANTISYM] in + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\c. !x. a <= x /\ x <= c ==> (f(x):real^N) IN e1` + REAL_COMPLETE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL [tac; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `a <= x /\ x <= b` STRIP_ASSUME_TAC THENL [tac; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!z. a <= z /\ z < x ==> (f(z):real^N) IN e1` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_NOT_LT; REAL_LT_IMP_LE]; ALL_TAC] THEN + REPEAT STRIP_TAC THENL + [SUBGOAL_THEN + `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e1` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[REAL_ARITH `z <= x + e /\ e < d ==> z < x \/ abs(z - x) < d`; + REAL_ARITH `&0 < e ==> ~(x + e <= x)`; REAL_DOWN]; + SUBGOAL_THEN + `?d. &0 < d /\ !y. abs(y - x) < d ==> (f(y):real^N) IN e2` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`x - a`; `d:real`] REAL_DOWN2) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_LE; REAL_SUB_LT]; ALL_TAC] THEN + ASM_MESON_TAC[REAL_ARITH `e < x - a ==> a <= x - e`; + REAL_ARITH `&0 < e /\ x <= b ==> x - e <= b`; + REAL_ARITH `&0 < e /\ e < d ==> x - e < x /\ abs((x - e) - x) < d`]]);; + +(* ------------------------------------------------------------------------- *) +(* One immediately useful corollary is the existence of square roots! *) +(* ------------------------------------------------------------------------- *) + +let SQUARE_BOUND_LEMMA = prove + (`!x. x < (&1 + x) * (&1 + x)`, + GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN + MAP_EVERY (fun t -> MP_TAC(SPEC t REAL_LE_SQUARE)) [`x:real`; `&1 + x`] THEN + REAL_ARITH_TAC);; + +let SQUARE_CONTINUOUS = prove + (`!x e. &0 < e + ==> ?d. &0 < d /\ !y. abs(y - x) < d ==> abs(y * y - x * x) < e`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO] THEN + EXISTS_TAC `inv(&1 + inv(e))` THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_ADD; REAL_LT_01] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `inv(&1 + inv(e)) * inv(&1 + inv(e))` THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_LT_MUL2; REAL_ABS_POS] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; SQUARE_BOUND_LEMMA; REAL_LT_INV_EQ]; + MP_TAC(SPECL [`abs(x)`; `e / (&3 * abs(x))`] REAL_DOWN2)THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; + ARITH; REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[REAL_ARITH `x * x - y * y = (x - y) * (x + y)`] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `d * &3 * abs(x)` THEN ASM_REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_LT_IMP_LE] THEN + MAP_EVERY UNDISCH_TAC [`abs (y - x) < d`; `d < abs(x)`] THEN + REAL_ARITH_TAC]);; + +let SQRT_WORKS_GEN = prove + (`!x. real_sgn(sqrt x) = real_sgn x /\ sqrt(x) pow 2 = abs x`, + GEN_TAC THEN REWRITE_TAC[sqrt] THEN CONV_TAC SELECT_CONV THEN + SUBGOAL_THEN `!x. &0 < x ==> ?y. &0 < y /\ y pow 2 = x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\u. lambda i. u):real->real^1`; `&0`; `&1 + x`; + `{u:real^1 | u$1 * u$1 < x}`; `{u:real^1 | u$1 * u$1 > x}`] + CONNECTED_REAL_LEMMA) THEN + SIMP_TAC[LAMBDA_BETA; LE_REFL; DIMINDEX_1; DIST_REAL; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_POW_2; REAL_ARITH `~(x < y) /\ ~(x > y) <=> x = y`] THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LT_LE; REAL_ENTIRE]] THEN + ASM_REWRITE_TAC[real_gt; SQUARE_BOUND_LEMMA; REAL_MUL_LZERO] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_ANTISYM]] THEN + MESON_TAC[SQUARE_CONTINUOUS; REAL_SUB_LT; + REAL_ARITH `abs(z2 - x2) < y - x2 ==> z2 < y`; + REAL_ARITH `abs(z2 - x2) < x2 - y ==> y < z2`]; + ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_SGN_0; REAL_SGN_EQ; UNWIND_THM2] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC o SPEC `abs x`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `real_sgn x * y` THEN + ASM_REWRITE_TAC[REAL_POW_MUL; GSYM REAL_SGN_POW; REAL_SGN_POW_2] THEN + REWRITE_TAC[REAL_SGN_MUL; REAL_SGN_REAL_SGN] THEN + ASM_SIMP_TAC[real_sgn; REAL_ARITH `&0 < abs x <=> ~(x = &0)`] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]]);; + +let SQRT_UNIQUE_GEN = prove + (`!x y. real_sgn y = real_sgn x /\ y pow 2 = abs x ==> sqrt x = y`, + REPEAT GEN_TAC THEN + MP_TAC(GSYM(SPEC `x:real` SQRT_WORKS_GEN)) THEN + SIMP_TAC[REAL_RING `x pow 2 = y pow 2 <=> x:real = y \/ x = --y`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[IMP_CONJ_ALT] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_SGN_NEG] THEN + SIMP_TAC[REAL_ARITH `--x = x <=> x = &0`; REAL_SGN_EQ; REAL_NEG_0; SQRT_0]);; + +let SQRT_NEG = prove + (`!x. sqrt(--x) = --sqrt(x)`, + GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN + REWRITE_TAC[REAL_SGN_NEG; REAL_POW_NEG; REAL_ABS_NEG; ARITH] THEN + REWRITE_TAC[SQRT_WORKS_GEN]);; + +let REAL_SGN_SQRT = prove + (`!x. real_sgn(sqrt x) = real_sgn x`, + REWRITE_TAC[SQRT_WORKS_GEN]);; + +let SQRT_WORKS = prove + (`!x. &0 <= x ==> &0 <= sqrt(x) /\ sqrt(x) pow 2 = x`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` SQRT_WORKS_GEN) THEN + REWRITE_TAC[real_sgn] THEN ASM_REAL_ARITH_TAC);; + +let SQRT_POS_LE = prove + (`!x. &0 <= x ==> &0 <= sqrt(x)`, + MESON_TAC[SQRT_WORKS]);; + +let SQRT_POW_2 = prove + (`!x. &0 <= x ==> sqrt(x) pow 2 = x`, + MESON_TAC[SQRT_WORKS]);; + +let SQRT_POW2 = prove + (`!x. sqrt(x) pow 2 = x <=> &0 <= x`, + MESON_TAC[REAL_POW_2; REAL_LE_SQUARE; SQRT_POW_2]);; + +let SQRT_MUL = prove + (`!x y. sqrt(x * y) = sqrt x * sqrt y`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN + REWRITE_TAC[REAL_SGN_MUL; REAL_POW_MUL; SQRT_WORKS_GEN; REAL_ABS_MUL]);; + +let SQRT_INV = prove + (`!x. sqrt (inv x) = inv(sqrt x)`, + GEN_TAC THEN MATCH_MP_TAC SQRT_UNIQUE_GEN THEN + REWRITE_TAC[REAL_SGN_INV; REAL_POW_INV; REAL_ABS_INV; SQRT_WORKS_GEN]);; + +let SQRT_DIV = prove + (`!x y. sqrt (x / y) = sqrt x / sqrt y`, + REWRITE_TAC[real_div; SQRT_MUL; SQRT_INV]);; + +let SQRT_LT_0 = prove + (`!x. &0 < sqrt x <=> &0 < x`, + REWRITE_TAC[GSYM real_gt; GSYM REAL_SGN_EQ; REAL_SGN_SQRT]);; + +let SQRT_EQ_0 = prove + (`!x. sqrt x = &0 <=> x = &0`, + ONCE_REWRITE_TAC[GSYM REAL_SGN_EQ] THEN REWRITE_TAC[REAL_SGN_SQRT]);; + +let SQRT_LE_0 = prove + (`!x. &0 <= sqrt x <=> &0 <= x`, + REWRITE_TAC[REAL_ARITH `&0 <= x <=> &0 < x \/ x = &0`] THEN + REWRITE_TAC[SQRT_LT_0; SQRT_EQ_0]);; + +let SQRT_MONO_LT = prove + (`!x y. x < y ==> sqrt(x) < sqrt(y)`, + SUBGOAL_THEN `!x y. &0 <= x /\ x < y ==> sqrt x < sqrt y` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LT2_REV THEN + EXISTS_TAC `2` THEN ASM_REWRITE_TAC[SQRT_WORKS_GEN; SQRT_LE_0] THEN + ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 <= x` THEN ASM_SIMP_TAC[] THEN + ASM_CASES_TAC `&0 <= y` THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[GSYM REAL_NOT_LE; SQRT_LE_0]; + FIRST_X_ASSUM(MP_TAC o SPECL [`--y:real`; `--x:real`]) THEN + REWRITE_TAC[SQRT_NEG] THEN ASM_REAL_ARITH_TAC]]);; + +let SQRT_MONO_LE = prove + (`!x y. x <= y ==> sqrt(x) <= sqrt(y)`, + MESON_TAC[REAL_LE_LT; SQRT_MONO_LT]);; + +let SQRT_MONO_LT_EQ = prove + (`!x y. sqrt(x) < sqrt(y) <=> x < y`, + MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);; + +let SQRT_MONO_LE_EQ = prove + (`!x y. sqrt(x) <= sqrt(y) <=> x <= y`, + MESON_TAC[REAL_NOT_LT; SQRT_MONO_LT; SQRT_MONO_LE]);; + +let SQRT_INJ = prove + (`!x y. sqrt(x) = sqrt(y) <=> x = y`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; SQRT_MONO_LE_EQ]);; + +let SQRT_POS_LT = prove + (`!x. &0 < x ==> &0 < sqrt(x)`, + MESON_TAC[REAL_LT_LE; SQRT_POS_LE; SQRT_EQ_0]);; + +let REAL_LE_LSQRT = prove + (`!x y. &0 <= y /\ x <= y pow 2 ==> sqrt(x) <= y`, + MESON_TAC[SQRT_MONO_LE; REAL_POW_LE; POW_2_SQRT]);; + +let REAL_LE_RSQRT = prove + (`!x y. x pow 2 <= y ==> x <= sqrt(y)`, + MESON_TAC[REAL_LE_TOTAL; SQRT_MONO_LE; SQRT_POS_LE; REAL_POW_2; + REAL_LE_SQUARE; REAL_LE_TRANS; POW_2_SQRT]);; + +let REAL_LT_LSQRT = prove + (`!x y. &0 <= y /\ x < y pow 2 ==> sqrt x < y`, + MESON_TAC[SQRT_MONO_LT; REAL_POW_LE; POW_2_SQRT]);; + +let REAL_LT_RSQRT = prove + (`!x y. x pow 2 < y ==> x < sqrt(y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs x < a ==> x < a`) THEN + REWRITE_TAC[GSYM POW_2_SQRT_ABS] THEN MATCH_MP_TAC SQRT_MONO_LT THEN + ASM_REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; + +let SQRT_EVEN_POW2 = prove + (`!n. EVEN n ==> (sqrt(&2 pow n) = &2 pow (n DIV 2))`, + SIMP_TAC[EVEN_EXISTS; LEFT_IMP_EXISTS_THM; DIV_MULT; ARITH_EQ] THEN + MESON_TAC[SQRT_UNIQUE; REAL_POW_POW; MULT_SYM; REAL_POW_LE; REAL_POS]);; + +let REAL_DIV_SQRT = prove + (`!x. &0 <= x ==> x / sqrt(x) = sqrt(x)`, + REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SQRT_0; real_div; REAL_MUL_LZERO]] THEN + ASM_SIMP_TAC[REAL_EQ_LDIV_EQ; SQRT_POS_LT; GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]);; + +let REAL_RSQRT_LE = prove + (`!x y. &0 <= x /\ &0 <= y /\ x <= sqrt y ==> x pow 2 <= y`, + MESON_TAC[REAL_POW_LE2; SQRT_POW_2]);; + +let REAL_LSQRT_LE = prove + (`!x y. &0 <= x /\ sqrt x <= y ==> x <= y pow 2`, + MESON_TAC[REAL_POW_LE2; SQRT_POS_LE; REAL_LE_TRANS; SQRT_POW_2]);; + +let REAL_SQRT_POW_2 = prove + (`!x. sqrt x pow 2 = abs x`, + REWRITE_TAC[SQRT_WORKS_GEN]);; + +(* ------------------------------------------------------------------------- *) +(* Hence derive more interesting properties of the norm. *) +(* ------------------------------------------------------------------------- *) + +let NORM_0 = prove + (`norm(vec 0) = &0`, + REWRITE_TAC[vector_norm; DOT_LZERO; SQRT_0]);; + +let NORM_POS_LE = prove + (`!x. &0 <= norm x`, + GEN_TAC THEN SIMP_TAC[DOT_POS_LE; vector_norm; SQRT_POS_LE]);; + +let NORM_NEG = prove + (`!x. norm(--x) = norm x`, + REWRITE_TAC[vector_norm; DOT_LNEG; DOT_RNEG; REAL_NEG_NEG]);; + +let NORM_SUB = prove + (`!x y. norm(x - y) = norm(y - x)`, + MESON_TAC[NORM_NEG; VECTOR_NEG_SUB]);; + +let NORM_MUL = prove + (`!a x. norm(a % x) = abs(a) * norm x`, + REWRITE_TAC[vector_norm; DOT_LMUL; DOT_RMUL; REAL_MUL_ASSOC] THEN + REWRITE_TAC[SQRT_MUL; GSYM REAL_POW_2; REAL_SQRT_POW_2]);; + +let NORM_EQ_0_DOT = prove + (`!x. (norm x = &0) <=> (x dot x = &0)`, + SIMP_TAC[vector_norm; SQRT_EQ_0; DOT_POS_LE]);; + +let NORM_EQ_0 = prove + (`!x. (norm x = &0) <=> (x = vec 0)`, + SIMP_TAC[vector_norm; DOT_EQ_0; SQRT_EQ_0; DOT_POS_LE]);; + +let NORM_POS_LT = prove + (`!x. &0 < norm x <=> ~(x = vec 0)`, + MESON_TAC[REAL_LT_LE; NORM_POS_LE; NORM_EQ_0]);; + +let NORM_POW_2 = prove + (`!x. norm(x) pow 2 = x dot x`, + SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);; + +let NORM_EQ_0_IMP = prove + (`!x. (norm x = &0) ==> (x = vec 0)`, + MESON_TAC[NORM_EQ_0]);; + +let NORM_LE_0 = prove + (`!x. norm x <= &0 <=> (x = vec 0)`, + MESON_TAC[REAL_LE_ANTISYM; NORM_EQ_0; NORM_POS_LE]);; + +let VECTOR_MUL_EQ_0 = prove + (`!a x. (a % x = vec 0) <=> (a = &0) \/ (x = vec 0)`, + REWRITE_TAC[GSYM NORM_EQ_0; NORM_MUL; REAL_ABS_ZERO; REAL_ENTIRE]);; + +let VECTOR_MUL_LCANCEL = prove + (`!a x y. (a % x = a % y) <=> (a = &0) \/ (x = y)`, + MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_LDISTRIB; VECTOR_SUB_EQ]);; + +let VECTOR_MUL_RCANCEL = prove + (`!a b x. (a % x = b % x) <=> (a = b) \/ (x = vec 0)`, + MESON_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_RDISTRIB; REAL_SUB_0; VECTOR_SUB_EQ]);; + +let VECTOR_MUL_LCANCEL_IMP = prove + (`!a x y. ~(a = &0) /\ (a % x = a % y) ==> (x = y)`, + MESON_TAC[VECTOR_MUL_LCANCEL]);; + +let VECTOR_MUL_RCANCEL_IMP = prove + (`!a b x. ~(x = vec 0) /\ (a % x = b % x) ==> (a = b)`, + MESON_TAC[VECTOR_MUL_RCANCEL]);; + +let NORM_CAUCHY_SCHWARZ = prove + (`!(x:real^N) y. x dot y <= norm(x) * norm(y)`, + REPEAT STRIP_TAC THEN MAP_EVERY ASM_CASES_TAC + [`norm(x:real^N) = &0`; `norm(y:real^N) = &0`] THEN + ASM_SIMP_TAC[NORM_EQ_0_IMP; DOT_LZERO; DOT_RZERO; + REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_POS_LE) THEN + REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2; + REAL_POW_2; REAL_LE_REFL] THEN + REWRITE_TAC[DOT_SYM; REAL_ARITH + `&0 <= y * (y * x * x - x * d) - x * (y * d - x * y * y) <=> + x * y * d <= x * y * x * y`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LE; NORM_POS_LE]);; + +let NORM_CAUCHY_SCHWARZ_ABS = prove + (`!x:real^N y. abs(x dot y) <= norm(x) * norm(y)`, + REPEAT GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_CAUCHY_SCHWARZ) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `y:real^N` th) THEN + MP_TAC(SPEC `--(y:real^N)` th)) THEN + REWRITE_TAC[DOT_RNEG; NORM_NEG] THEN REAL_ARITH_TAC);; + +let REAL_ABS_NORM = prove + (`!x. abs(norm x) = norm x`, + REWRITE_TAC[NORM_POS_LE; REAL_ABS_REFL]);; + +let NORM_CAUCHY_SCHWARZ_DIV = prove + (`!x:real^N y. abs((x dot y) / (norm x * norm y)) <= &1`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN + ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; real_div; + REAL_INV_1; DOT_LZERO; DOT_RZERO; REAL_ABS_NUM; REAL_POS] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_ABS_DIV; REAL_LE_LDIV_EQ; REAL_LT_MUL; + REAL_ABS_INV; NORM_POS_LT; REAL_ABS_MUL; REAL_ABS_NORM] THEN + REWRITE_TAC[REAL_MUL_LID; NORM_CAUCHY_SCHWARZ_ABS]);; + +let NORM_TRIANGLE = prove + (`!x y. norm(x + y) <= norm(x) + norm(y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN + SIMP_TAC[GSYM vector_norm; DOT_POS_LE; NORM_POS_LE; REAL_LE_ADD] THEN + REWRITE_TAC[DOT_LADD; DOT_RADD; REAL_POW_2; GSYM NORM_POW_2] THEN + SIMP_TAC[NORM_CAUCHY_SCHWARZ; DOT_SYM; REAL_ARITH + `d <= x * y ==> (x * x + d) + (d + y * y) <= (x + y) * (x + y)`]);; + +let NORM_TRIANGLE_SUB = prove + (`!x y:real^N. norm(x) <= norm(y) + norm(x - y)`, + MESON_TAC[NORM_TRIANGLE; VECTOR_SUB_ADD2]);; + +let NORM_TRIANGLE_LE = prove + (`!x y. norm(x) + norm(y) <= e ==> norm(x + y) <= e`, + MESON_TAC[REAL_LE_TRANS; NORM_TRIANGLE]);; + +let NORM_TRIANGLE_LT = prove + (`!x y. norm(x) + norm(y) < e ==> norm(x + y) < e`, + MESON_TAC[REAL_LET_TRANS; NORM_TRIANGLE]);; + +let COMPONENT_LE_NORM = prove + (`!x:real^N i. abs(x$i) <= norm x`, + REPEAT GEN_TAC THEN SUBGOAL_THEN + `?k. 1 <= k /\ k <= dimindex(:N) /\ !x:real^N. x$i = x$k` + STRIP_ASSUME_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[vector_norm] THEN + MATCH_MP_TAC REAL_LE_RSQRT THEN REWRITE_TAC[GSYM REAL_ABS_POW] THEN + REWRITE_TAC[real_abs; REAL_POW_2; REAL_LE_SQUARE] THEN + SUBGOAL_THEN + `x$k * (x:real^N)$k = + sum(1..dimindex(:N)) (\i. if i = k then x$k * x$k else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[SUM_DELTA] THEN ASM_REWRITE_TAC[IN_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_LE THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LE_SQUARE]);; + +let NORM_BOUND_COMPONENT_LE = prove + (`!x:real^N e. norm(x) <= e + ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= e`, + MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]);; + +let NORM_BOUND_COMPONENT_LT = prove + (`!x:real^N e. norm(x) < e + ==> !i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) < e`, + MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);; + +let NORM_LE_L1 = prove + (`!x:real^N. norm x <= sum(1..dimindex(:N)) (\i. abs(x$i))`, + REPEAT GEN_TAC THEN REWRITE_TAC[vector_norm; dot] THEN + MATCH_MP_TAC REAL_LE_LSQRT THEN REWRITE_TAC[REAL_POW_2] THEN + SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; REAL_LE_SQUARE; REAL_ABS_POS] THEN + SPEC_TAC(`dimindex(:N)`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; ARITH_RULE `1 <= SUC n`] THEN + SIMP_TAC[REAL_MUL_LZERO; REAL_LE_REFL] THEN + MATCH_MP_TAC(REAL_ARITH + `a2 <= a * a /\ &0 <= a * b /\ b2 <= b * b + ==> a2 + b2 <= (a + b) * (a + b)`) THEN + ASM_SIMP_TAC[SUM_POS_LE; REAL_LE_MUL; REAL_ABS_POS; FINITE_NUMSEG] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REAL_ARITH_TAC);; + +let REAL_ABS_SUB_NORM = prove + (`abs(norm(x) - norm(y)) <= norm(x - y)`, + REWRITE_TAC[REAL_ARITH `abs(x - y) <= a <=> x <= y + a /\ y <= x + a`] THEN + MESON_TAC[NORM_TRIANGLE_SUB; NORM_SUB]);; + +let NORM_LE = prove + (`!x y. norm(x) <= norm(y) <=> x dot x <= y dot y`, + REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE]);; + +let NORM_LT = prove + (`!x y. norm(x) < norm(y) <=> x dot x < y dot y`, + REWRITE_TAC[vector_norm] THEN MESON_TAC[SQRT_MONO_LT_EQ; DOT_POS_LE]);; + +let NORM_EQ = prove + (`!x y. (norm x = norm y) <=> (x dot x = y dot y)`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; NORM_LE]);; + +let NORM_EQ_1 = prove + (`!x. norm(x) = &1 <=> x dot x = &1`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM SQRT_1] THEN + SIMP_TAC[vector_norm; SQRT_INJ; DOT_POS_LE; REAL_POS]);; + +let NORM_LE_COMPONENTWISE = prove + (`!x:real^N y:real^N. + (!i. 1 <= i /\ i <= dimindex(:N) ==> abs(x$i) <= abs(y$i)) + ==> norm(x) <= norm(y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_LE; dot] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; GSYM REAL_LE_SQUARE_ABS]);; + +let L1_LE_NORM = prove + (`!x:real^N. + sum(1..dimindex(:N)) (\i. abs(x$i)) <= sqrt(&(dimindex(:N))) * norm x`, + let lemma = prove + (`!x n. &n * sum(1..n) (\i. x i pow 2) - (sum(1..n) x) pow 2 = + sum(1..n) (\i. sum(i+1..n) (\j. (x i - x j) pow 2))`, + GEN_TAC THEN CONV_TAC(BINDER_CONV SYM_CONV) THEN INDUCT_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH; ARITH_RULE `1 <= SUC n`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + SIMP_TAC[ARITH_RULE `i <= n ==> i + 1 <= SUC n`; SUM_TRIV_NUMSEG; + ARITH_RULE `~(n + 1 <= n)`; ARITH_RULE `n < SUC n + 1`] THEN + ASM_REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH + `(x - y) pow 2 = (x pow 2 + y pow 2) - &2 * x * y`] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; SUM_SUB_NUMSEG; SUM_LMUL; SUM_RMUL; + GSYM REAL_OF_NUM_SUC; SUM_CONST_NUMSEG; ADD_SUB] THEN + REAL_ARITH_TAC) in + GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y /\ abs x <= abs y ==> x <= y`) THEN + SIMP_TAC[REAL_LE_MUL; NORM_POS_LE; SQRT_POS_LE; REAL_POS] THEN + REWRITE_TAC[REAL_LE_SQUARE_ABS; REAL_POW_MUL] THEN + SIMP_TAC[SQRT_POW_2; REAL_POS; NORM_POW_2; dot] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_POW2_ABS] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN REWRITE_TAC[lemma] THEN + SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_LE_POW_2]);; + +(* ------------------------------------------------------------------------- *) +(* Squaring equations and inequalities involving norms. *) +(* ------------------------------------------------------------------------- *) + +let DOT_SQUARE_NORM = prove + (`!x. x dot x = norm(x) pow 2`, + SIMP_TAC[vector_norm; SQRT_POW_2; DOT_POS_LE]);; + +let NORM_EQ_SQUARE = prove + (`!x:real^N. norm(x) = a <=> &0 <= a /\ x dot x = a pow 2`, + REWRITE_TAC[DOT_SQUARE_NORM] THEN + ONCE_REWRITE_TAC[REAL_RING `x pow 2 = a pow 2 <=> x = a \/ x + a = &0`] THEN + GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);; + +let NORM_LE_SQUARE = prove + (`!x:real^N. norm(x) <= a <=> &0 <= a /\ x dot x <= a pow 2`, + REWRITE_TAC[DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN + GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);; + +let NORM_GE_SQUARE = prove + (`!x:real^N. norm(x) >= a <=> a <= &0 \/ x dot x >= a pow 2`, + REWRITE_TAC[real_ge; DOT_SQUARE_NORM; GSYM REAL_LE_SQUARE_ABS] THEN + GEN_TAC THEN MP_TAC(ISPEC `x:real^N` NORM_POS_LE) THEN REAL_ARITH_TAC);; + +let NORM_LT_SQUARE = prove + (`!x:real^N. norm(x) < a <=> &0 < a /\ x dot x < a pow 2`, + REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN + REAL_ARITH_TAC);; + +let NORM_GT_SQUARE = prove + (`!x:real^N. norm(x) > a <=> a < &0 \/ x dot x > a pow 2`, + REWRITE_TAC[REAL_ARITH `x > a <=> ~(x <= a)`; NORM_LE_SQUARE] THEN + REAL_ARITH_TAC);; + +let NORM_LT_SQUARE_ALT = prove + (`!x:real^N. norm(x) < a <=> &0 <= a /\ x dot x < a pow 2`, + REWRITE_TAC[REAL_ARITH `x < a <=> ~(x >= a)`; NORM_GE_SQUARE] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THENL + [ASM_REWRITE_TAC[real_ge] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[DOT_POS_LE]; + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* General linear decision procedure for normed spaces. *) +(* ------------------------------------------------------------------------- *) + +let NORM_ARITH = + let find_normedterms = + let augment_norm b tm acc = + match tm with + Comb(Const("vector_norm",_),v) -> insert (b,v) acc + | _ -> acc in + let rec find_normedterms tm acc = + match tm with + Comb(Comb(Const("real_add",_),l),r) -> + find_normedterms l (find_normedterms r acc) + | Comb(Comb(Const("real_mul",_),c),n) -> + if not (is_ratconst c) then acc else + augment_norm (rat_of_term c >=/ Int 0) n acc + | _ -> augment_norm true tm acc in + find_normedterms in + let lincomb_neg t = mapf minus_num t in + let lincomb_cmul c t = if c =/ Int 0 then undefined else mapf (( */ ) c) t in + let lincomb_add l r = combine (+/) (fun x -> x =/ Int 0) l r in + let lincomb_sub l r = lincomb_add l (lincomb_neg r) in + let lincomb_eq l r = lincomb_sub l r = undefined in + let rec vector_lincomb tm = + match tm with + Comb(Comb(Const("vector_add",_),l),r) -> + lincomb_add (vector_lincomb l) (vector_lincomb r) + | Comb(Comb(Const("vector_sub",_),l),r) -> + lincomb_sub (vector_lincomb l) (vector_lincomb r) + | Comb(Comb(Const("%",_),l),r) -> + lincomb_cmul (rat_of_term l) (vector_lincomb r) + | Comb(Const("vector_neg",_),t) -> + lincomb_neg (vector_lincomb t) + | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 -> + undefined + | _ -> (tm |=> Int 1) in + let vector_lincombs tms = + itlist (fun t fns -> + if can (assoc t) fns then fns else + let f = vector_lincomb t in + try let _,f' = find (fun (_,f') -> lincomb_eq f f') fns in + (t,f')::fns + with Failure _ -> (t,f)::fns) tms [] in + let rec replacenegnorms fn tm = + match tm with + Comb(Comb(Const("real_add",_),l),r) -> + BINOP_CONV (replacenegnorms fn) tm + | Comb(Comb(Const("real_mul",_),c),n) when rat_of_term c + RAND_CONV fn tm + | _ -> REFL tm in + let flip v eq = + if defined eq v then (v |-> minus_num(apply eq v)) eq else eq in + let rec allsubsets s = + match s with + [] -> [[]] + | (a::t) -> let res = allsubsets t in + map (fun b -> a::b) res @ res in + let evaluate env lin = + foldr (fun x c s -> s +/ c */ apply env x) lin (Int 0) in + let rec solve (vs,eqs) = + match (vs,eqs) with + [],[] -> (0 |=> Int 1) + | _,eq::oeqs -> + let v = hd(intersect vs (dom eq)) in + let c = apply eq v in + let vdef = lincomb_cmul (Int(-1) // c) eq in + let eliminate eqn = + if not(defined eqn v) then eqn else + lincomb_add (lincomb_cmul (apply eqn v) vdef) eqn in + let soln = solve (subtract vs [v],map eliminate oeqs) in + (v |-> evaluate soln (undefine v vdef)) soln in + let rec combinations k l = + if k = 0 then [[]] else + match l with + [] -> [] + | h::t -> map (fun c -> h::c) (combinations (k - 1) t) @ + combinations k t in + let vertices vs eqs = + let vertex cmb = + let soln = solve(vs,cmb) in + map (fun v -> tryapplyd soln v (Int 0)) vs in + let rawvs = mapfilter vertex (combinations (length vs) eqs) in + let unset = filter (forall (fun c -> c >=/ Int 0)) rawvs in + itlist (insert' (forall2 (=/))) unset [] in + let subsumes l m = forall2 (fun x y -> abs_num x <=/ abs_num y) l m in + let rec subsume todo dun = + match todo with + [] -> dun + | v::ovs -> let dun' = if exists (fun w -> subsumes w v) dun then dun + else v::(filter (fun w -> not(subsumes v w)) dun) in + subsume ovs dun' in + let NORM_CMUL_RULE = + let MATCH_pth = (MATCH_MP o prove) + (`!b x. b >= norm(x) ==> !c. abs(c) * b >= norm(c % x)`, + SIMP_TAC[NORM_MUL; real_ge; REAL_LE_LMUL; REAL_ABS_POS]) in + fun c th -> ISPEC(term_of_rat c) (MATCH_pth th) in + let NORM_ADD_RULE = + let MATCH_pth = (MATCH_MP o prove) + (`!b1 b2 x1 x2. b1 >= norm(x1) /\ b2 >= norm(x2) + ==> b1 + b2 >= norm(x1 + x2)`, + REWRITE_TAC[real_ge] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN ASM_SIMP_TAC[REAL_LE_ADD2]) in + fun th1 th2 -> MATCH_pth (CONJ th1 th2) in + let INEQUALITY_CANON_RULE = + CONV_RULE(LAND_CONV REAL_POLY_CONV) o + CONV_RULE(LAND_CONV REAL_RAT_REDUCE_CONV) o + GEN_REWRITE_RULE I [REAL_ARITH `s >= t <=> s - t >= &0`] in + let NORM_CANON_CONV = + let APPLY_pth1 = GEN_REWRITE_CONV I + [VECTOR_ARITH `x:real^N = &1 % x`] + and APPLY_pth2 = GEN_REWRITE_CONV I + [VECTOR_ARITH `x - y:real^N = x + --y`] + and APPLY_pth3 = GEN_REWRITE_CONV I + [VECTOR_ARITH `--x:real^N = -- &1 % x`] + and APPLY_pth4 = GEN_REWRITE_CONV I + [VECTOR_ARITH `&0 % x:real^N = vec 0`; + VECTOR_ARITH `c % vec 0:real^N = vec 0`] + and APPLY_pth5 = GEN_REWRITE_CONV I + [VECTOR_ARITH `c % (d % x) = (c * d) % x`] + and APPLY_pth6 = GEN_REWRITE_CONV I + [VECTOR_ARITH `c % (x + y) = c % x + c % y`] + and APPLY_pth7 = GEN_REWRITE_CONV I + [VECTOR_ARITH `vec 0 + x = x`; + VECTOR_ARITH `x + vec 0 = x`] + and APPLY_pth8 = + GEN_REWRITE_CONV I [VECTOR_ARITH `c % x + d % x = (c + d) % x`] THENC + LAND_CONV REAL_RAT_ADD_CONV THENC + GEN_REWRITE_CONV TRY_CONV [VECTOR_ARITH `&0 % x = vec 0`] + and APPLY_pth9 = + GEN_REWRITE_CONV I + [VECTOR_ARITH `(c % x + z) + d % x = (c + d) % x + z`; + VECTOR_ARITH `c % x + (d % x + z) = (c + d) % x + z`; + VECTOR_ARITH `(c % x + w) + (d % x + z) = (c + d) % x + (w + z)`] THENC + LAND_CONV(LAND_CONV REAL_RAT_ADD_CONV) + and APPLY_ptha = + GEN_REWRITE_CONV I [VECTOR_ARITH `&0 % x + y = y`] + and APPLY_pthb = + GEN_REWRITE_CONV I + [VECTOR_ARITH `c % x + d % y = c % x + d % y`; + VECTOR_ARITH `(c % x + z) + d % y = c % x + (z + d % y)`; + VECTOR_ARITH `c % x + (d % y + z) = c % x + (d % y + z)`; + VECTOR_ARITH `(c % x + w) + (d % y + z) = c % x + (w + (d % y + z))`] + and APPLY_pthc = + GEN_REWRITE_CONV I + [VECTOR_ARITH `c % x + d % y = d % y + c % x`; + VECTOR_ARITH `(c % x + z) + d % y = d % y + (c % x + z)`; + VECTOR_ARITH `c % x + (d % y + z) = d % y + (c % x + z)`; + VECTOR_ARITH `(c % x + w) + (d % y + z) = d % y + ((c % x + w) + z)`] + and APPLY_pthd = + GEN_REWRITE_CONV TRY_CONV + [VECTOR_ARITH `x + vec 0 = x`] in + let headvector tm = + match tm with + Comb(Comb(Const("vector_add",_),Comb(Comb(Const("%",_),l),v)),r) -> v + | Comb(Comb(Const("%",_),l),v) -> v + | _ -> failwith "headvector: non-canonical term" in + let rec VECTOR_CMUL_CONV tm = + ((APPLY_pth5 THENC LAND_CONV REAL_RAT_MUL_CONV) ORELSEC + (APPLY_pth6 THENC BINOP_CONV VECTOR_CMUL_CONV)) tm + and VECTOR_ADD_CONV tm = + try APPLY_pth7 tm with Failure _ -> + try APPLY_pth8 tm with Failure _ -> + match tm with + Comb(Comb(Const("vector_add",_),lt),rt) -> + let l = headvector lt and r = headvector rt in + if l < r then (APPLY_pthb THENC + RAND_CONV VECTOR_ADD_CONV THENC + APPLY_pthd) tm + else if r < l then (APPLY_pthc THENC + RAND_CONV VECTOR_ADD_CONV THENC + APPLY_pthd) tm else + (APPLY_pth9 THENC + ((APPLY_ptha THENC VECTOR_ADD_CONV) ORELSEC + RAND_CONV VECTOR_ADD_CONV THENC + APPLY_pthd)) tm + | _ -> REFL tm in + let rec VECTOR_CANON_CONV tm = + match tm with + Comb(Comb(Const("vector_add",_),l),r) -> + let lth = VECTOR_CANON_CONV l and rth = VECTOR_CANON_CONV r in + let th = MK_COMB(AP_TERM (rator(rator tm)) lth,rth) in + CONV_RULE (RAND_CONV VECTOR_ADD_CONV) th + | Comb(Comb(Const("%",_),l),r) -> + let rth = AP_TERM (rator tm) (VECTOR_CANON_CONV r) in + CONV_RULE (RAND_CONV(APPLY_pth4 ORELSEC VECTOR_CMUL_CONV)) rth + | Comb(Comb(Const("vector_sub",_),l),r) -> + (APPLY_pth2 THENC VECTOR_CANON_CONV) tm + | Comb(Const("vector_neg",_),t) -> + (APPLY_pth3 THENC VECTOR_CANON_CONV) tm + | Comb(Const("vec",_),n) when is_numeral n & dest_numeral n =/ Int 0 -> + REFL tm + | _ -> APPLY_pth1 tm in + fun tm -> + match tm with + Comb(Const("vector_norm",_),e) -> RAND_CONV VECTOR_CANON_CONV tm + | _ -> failwith "NORM_CANON_CONV" in + let REAL_VECTOR_COMBO_PROVER = + let pth_zero = prove(`norm(vec 0:real^N) = &0`,REWRITE_TAC[NORM_0]) + and tv_n = mk_vartype "N" in + fun translator (nubs,ges,gts) -> + let sources = map (rand o rand o concl) nubs + and rawdests = itlist (find_normedterms o lhand o concl) (ges @ gts) [] in + if not (forall fst rawdests) then failwith "Sanity check" else + let dests = setify (map snd rawdests) in + let srcfuns = map vector_lincomb sources + and destfuns = map vector_lincomb dests in + let vvs = itlist (union o dom) (srcfuns @ destfuns) [] in + let n = length srcfuns in + let nvs = 1--n in + let srccombs = zip srcfuns nvs in + let consider d = + let coefficients x = + let inp = if defined d x then 0 |=> minus_num(apply d x) + else undefined in + itlist (fun (f,v) g -> if defined f x then (v |-> apply f x) g else g) + srccombs inp in + let equations = map coefficients vvs + and inequalities = map (fun n -> (n |=> Int 1)) nvs in + let plausiblevertices f = + let flippedequations = map (itlist flip f) equations in + let constraints = flippedequations @ inequalities in + let rawverts = vertices nvs constraints in + let check_solution v = + let f = itlist2 (|->) nvs v (0 |=> Int 1) in + forall (fun e -> evaluate f e =/ Int 0) flippedequations in + let goodverts = filter check_solution rawverts in + let signfixups = map (fun n -> if mem n f then -1 else 1) nvs in + map (map2 (fun s c -> Int s */ c) signfixups) goodverts in + let allverts = itlist (@) (map plausiblevertices (allsubsets nvs)) [] in + subsume allverts [] in + let compute_ineq v = + let ths = mapfilter (fun (v,t) -> if v =/ Int 0 then fail() + else NORM_CMUL_RULE v t) + (zip v nubs) in + INEQUALITY_CANON_RULE (end_itlist NORM_ADD_RULE ths) in + let ges' = mapfilter compute_ineq (itlist ((@) o consider) destfuns []) @ + map INEQUALITY_CANON_RULE nubs @ ges in + let zerodests = filter + (fun t -> dom(vector_lincomb t) = []) (map snd rawdests) in + REAL_LINEAR_PROVER translator + (map (fun t -> INST_TYPE [last(snd(dest_type(type_of t))),tv_n] pth_zero) + zerodests, + map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC + LAND_CONV REAL_POLY_CONV)) ges', + map (CONV_RULE(ONCE_DEPTH_CONV NORM_CANON_CONV THENC + LAND_CONV REAL_POLY_CONV)) gts) in + let REAL_VECTOR_INEQ_PROVER = + let pth = prove + (`norm(x) = n ==> norm(x) >= &0 /\ n >= norm(x)`, + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + REWRITE_TAC[real_ge; NORM_POS_LE] THEN REAL_ARITH_TAC) in + let NORM_MP = MATCH_MP pth in + fun translator (ges,gts) -> + let ntms = itlist find_normedterms (map (lhand o concl) (ges @ gts)) [] in + let lctab = vector_lincombs (map snd (filter (not o fst) ntms)) in + let asl = map (fun (t,_) -> + ASSUME(mk_eq(mk_icomb(mk_const("vector_norm",[]),t), + genvar `:real`))) lctab in + let replace_conv = GEN_REWRITE_CONV TRY_CONV asl in + let replace_rule = CONV_RULE (LAND_CONV (replacenegnorms replace_conv)) in + let ges' = + itlist (fun th ths -> CONJUNCT1(NORM_MP th)::ths) + asl (map replace_rule ges) + and gts' = map replace_rule gts + and nubs = map (CONJUNCT2 o NORM_MP) asl in + let th1 = REAL_VECTOR_COMBO_PROVER translator (nubs,ges',gts') in + let th2 = INST + (map (fun th -> let l,r = dest_eq(concl th) in (l,r)) asl) th1 in + itlist PROVE_HYP (map (REFL o lhand o concl) asl) th2 in + let REAL_VECTOR_PROVER = + let rawrule = + GEN_REWRITE_RULE I [REAL_ARITH `x = &0 <=> x >= &0 /\ --x >= &0`] in + let splitequation th acc = + let th1,th2 = CONJ_PAIR(rawrule th) in + th1::CONV_RULE(LAND_CONV REAL_POLY_NEG_CONV) th2::acc in + fun translator (eqs,ges,gts) -> + REAL_VECTOR_INEQ_PROVER translator + (itlist splitequation eqs ges,gts) in + let pth = prove + (`(!x y:real^N. x = y <=> norm(x - y) <= &0) /\ + (!x y:real^N. ~(x = y) <=> ~(norm(x - y) <= &0))`, + REWRITE_TAC[NORM_LE_0; VECTOR_SUB_EQ]) in + let conv1 = GEN_REWRITE_CONV TRY_CONV [pth] in + let conv2 tm = (conv1 tm,conv1(mk_neg tm)) in + let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] THENC + REAL_RAT_REDUCE_CONV THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV [dist] THENC + GEN_NNF_CONV true (conv1,conv2) + and pure = GEN_REAL_ARITH REAL_VECTOR_PROVER in + fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; + +let NORM_ARITH_TAC = CONV_TAC NORM_ARITH;; + +let ASM_NORM_ARITH_TAC = + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN + NORM_ARITH_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Dot product in terms of the norm rather than conversely. *) +(* ------------------------------------------------------------------------- *) + +let DOT_NORM = prove + (`!x y. x dot y = (norm(x + y) pow 2 - norm(x) pow 2 - norm(y) pow 2) / &2`, + REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_SYM] THEN REAL_ARITH_TAC);; + +let DOT_NORM_NEG = prove + (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`, + REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN + REAL_ARITH_TAC);; + +let DOT_NORM_SUB = prove + (`!x y. x dot y = ((norm(x) pow 2 + norm(y) pow 2) - norm(x - y) pow 2) / &2`, + REWRITE_TAC[NORM_POW_2; DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Equality of vectors in terms of dot products. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_EQ = prove + (`!x y. (x = y) <=> (x dot x = x dot y) /\ (y dot y = x dot x)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM DOT_EQ_0] THEN + SIMP_TAC[DOT_LSUB; DOT_RSUB; DOT_SYM] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence more metric properties. *) +(* ------------------------------------------------------------------------- *) + +let DIST_REFL = prove + (`!x. dist(x,x) = &0`, + NORM_ARITH_TAC);; + +let DIST_SYM = prove + (`!x y. dist(x,y) = dist(y,x)`, + NORM_ARITH_TAC);; + +let DIST_POS_LE = prove + (`!x y. &0 <= dist(x,y)`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE = prove + (`!x:real^N y z. dist(x,z) <= dist(x,y) + dist(y,z)`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE_ALT = prove + (`!x y z. dist(y,z) <= dist(x,y) + dist(x,z)`, + NORM_ARITH_TAC);; + +let DIST_EQ_0 = prove + (`!x y. (dist(x,y) = &0) <=> (x = y)`, + NORM_ARITH_TAC);; + +let DIST_POS_LT = prove + (`!x y. ~(x = y) ==> &0 < dist(x,y)`, + NORM_ARITH_TAC);; + +let DIST_NZ = prove + (`!x y. ~(x = y) <=> &0 < dist(x,y)`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE_LE = prove + (`!x y z e. dist(x,z) + dist(y,z) <= e ==> dist(x,y) <= e`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE_LT = prove + (`!x y z e. dist(x,z) + dist(y,z) < e ==> dist(x,y) < e`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE_HALF_L = prove + (`!x1 x2 y. dist(x1,y) < e / &2 /\ dist(x2,y) < e / &2 ==> dist(x1,x2) < e`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE_HALF_R = prove + (`!x1 x2 y. dist(y,x1) < e / &2 /\ dist(y,x2) < e / &2 ==> dist(x1,x2) < e`, + NORM_ARITH_TAC);; + +let DIST_TRIANGLE_ADD = prove + (`!x x' y y'. dist(x + y,x' + y') <= dist(x,x') + dist(y,y')`, + NORM_ARITH_TAC);; + +let DIST_MUL = prove + (`!x y c. dist(c % x,c % y) = abs(c) * dist(x,y)`, + REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL]);; + +let DIST_TRIANGLE_ADD_HALF = prove + (`!x x' y y':real^N. + dist(x,x') < e / &2 /\ dist(y,y') < e / &2 ==> dist(x + y,x' + y') < e`, + NORM_ARITH_TAC);; + +let DIST_LE_0 = prove + (`!x y. dist(x,y) <= &0 <=> x = y`, + NORM_ARITH_TAC);; + +let DIST_EQ = prove + (`!w x y z. dist(w,x) = dist(y,z) <=> dist(w,x) pow 2 = dist(y,z) pow 2`, + REWRITE_TAC[dist; NORM_POW_2; NORM_EQ]);; + +let DIST_0 = prove + (`!x. dist(x,vec 0) = norm(x) /\ dist(vec 0,x) = norm(x)`, + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Sums of vectors. *) +(* ------------------------------------------------------------------------- *) + +let NEUTRAL_VECTOR_ADD = prove + (`neutral(+) = vec 0:real^N`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + REWRITE_TAC[VECTOR_ARITH `x + y = y <=> x = vec 0`; + VECTOR_ARITH `x + y = x <=> y = vec 0`]);; + +let MONOIDAL_VECTOR_ADD = prove + (`monoidal((+):real^N->real^N->real^N)`, + REWRITE_TAC[monoidal; NEUTRAL_VECTOR_ADD] THEN + REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let vsum = new_definition + `(vsum:(A->bool)->(A->real^N)->real^N) s f = lambda i. sum s (\x. f(x)$i)`;; + +let VSUM_CLAUSES = prove + (`(!f. vsum {} f = vec 0) /\ + (!x f s. FINITE s + ==> (vsum (x INSERT s) f = + if x IN s then vsum s f else f(x) + vsum s f))`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CLAUSES] THEN + SIMP_TAC[VEC_COMPONENT] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT]);; + +let VSUM = prove + (`!f s. FINITE s ==> vsum s f = iterate (+) s f`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[VSUM_CLAUSES; ITERATE_CLAUSES; MONOIDAL_VECTOR_ADD] THEN + REWRITE_TAC[NEUTRAL_VECTOR_ADD]);; + +let VSUM_EQ_0 = prove + (`!f s. (!x:A. x IN s ==> (f(x) = vec 0)) ==> (vsum s f = vec 0)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; vec; SUM_EQ_0]);; + +let VSUM_0 = prove + (`vsum s (\x. vec 0) = vec 0`, + SIMP_TAC[VSUM_EQ_0]);; + +let VSUM_LMUL = prove + (`!f c s. vsum s (\x. c % f(x)) = c % vsum s f`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_LMUL]);; + +let VSUM_RMUL = prove + (`!c s v. vsum s (\x. c x % v) = (sum s c) % v`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_MUL_COMPONENT; SUM_RMUL]);; + +let VSUM_ADD = prove + (`!f g s. FINITE s ==> (vsum s (\x. f x + g x) = vsum s f + vsum s g)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_ADD]);; + +let VSUM_SUB = prove + (`!f g s. FINITE s ==> (vsum s (\x. f x - g x) = vsum s f - vsum s g)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_SUB_COMPONENT; SUM_SUB]);; + +let VSUM_CONST = prove + (`!c s. FINITE s ==> (vsum s (\n. c) = &(CARD s) % c)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_CONST; VECTOR_MUL_COMPONENT]);; + +let VSUM_COMPONENT = prove + (`!s f i. 1 <= i /\ i <= dimindex(:N) + ==> ((vsum s (f:A->real^N))$i = sum s (\x. f(x)$i))`, + SIMP_TAC[vsum; LAMBDA_BETA]);; + +let VSUM_IMAGE = prove + (`!f g s. FINITE s /\ (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> (vsum (IMAGE f s) g = vsum s (g o f))`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN + ASM_REWRITE_TAC[o_DEF]);; + +let VSUM_UNION = prove + (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t + ==> (vsum (s UNION t) f = vsum s f + vsum t f)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_UNION; VECTOR_ADD_COMPONENT]);; + +let VSUM_DIFF = prove + (`!f s t. FINITE s /\ t SUBSET s + ==> (vsum (s DIFF t) f = vsum s f - vsum t f)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DIFF; VECTOR_SUB_COMPONENT]);; + +let VSUM_DELETE = prove + (`!f s a. FINITE s /\ a IN s + ==> vsum (s DELETE a) f = vsum s f - f a`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_DELETE; VECTOR_SUB_COMPONENT]);; + +let VSUM_INCL_EXCL = prove + (`!s t (f:A->real^N). + FINITE s /\ FINITE t + ==> vsum s f + vsum t f = vsum (s UNION t) f + vsum (s INTER t) f`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN + SIMP_TAC[SUM_INCL_EXCL]);; + +let VSUM_NEG = prove + (`!f s. vsum s (\x. --f x) = --vsum s f`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_NEG; VECTOR_NEG_COMPONENT]);; + +let VSUM_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (vsum s f = vsum s g)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);; + +let VSUM_SUPERSET = prove + (`!f:A->real^N u v. + u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0)) + ==> (vsum v f = vsum u f)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_SUPERSET]);; + +let VSUM_SUPPORT = prove + (`!f:A->real^N s. vsum {x | x IN s /\ ~(f x = vec 0)} f = vsum s f`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + SET_TAC[]);; + +let VSUM_EQ_SUPERSET = prove + (`!f s t:A->bool. + FINITE t /\ t SUBSET s /\ + (!x. x IN t ==> (f x = g x)) /\ + (!x. x IN s /\ ~(x IN t) ==> f(x) = vec 0) + ==> vsum s f = vsum t g`, + MESON_TAC[VSUM_SUPERSET; VSUM_EQ]);; + +let VSUM_UNION_RZERO = prove + (`!f:A->real^N u v. + (!x. x IN v /\ ~(x IN u) ==> (f(x) = vec 0)) + ==> (vsum (u UNION v) f = vsum u f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM SET_TAC[]);; + +let VSUM_UNION_LZERO = prove + (`!f:A->real^N u v. + (!x. x IN u /\ ~(x IN v) ==> (f(x) = vec 0)) + ==> (vsum (u UNION v) f = vsum v f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN ASM SET_TAC[]);; + +let VSUM_RESTRICT = prove + (`!f s. vsum s (\x. if x IN s then f(x) else vec 0) = vsum s f`, + REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[]);; + +let VSUM_RESTRICT_SET = prove + (`!P s f. vsum {x | x IN s /\ P x} f = + vsum s (\x. if P x then f x else vec 0)`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_RESTRICT_SET; + COND_COMPONENT]);; + +let VSUM_CASES = prove + (`!s P f g. FINITE s + ==> vsum s (\x:A. if P x then (f x):real^N else g x) = + vsum {x | x IN s /\ P x} f + vsum {x | x IN s /\ ~P x} g`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; SUM_CASES; + COND_COMPONENT]);; + +let VSUM_SING = prove + (`!f x. vsum {x} f = f(x)`, + SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; VECTOR_ADD_RID]);; + +let VSUM_NORM = prove + (`!f s. FINITE s ==> norm(vsum s f) <= sum s (\x. norm(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; NORM_0; REAL_LE_REFL] THEN + NORM_ARITH_TAC);; + +let VSUM_NORM_LE = prove + (`!s f:A->real^N g. + FINITE s /\ (!x. x IN s ==> norm(f x) <= g(x)) + ==> norm(vsum s f) <= sum s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum s (\x:A. norm(f x :real^N))` THEN + ASM_SIMP_TAC[VSUM_NORM; SUM_LE]);; + +let VSUM_NORM_TRIANGLE = prove + (`!s f b. FINITE s /\ sum s (\a. norm(f a)) <= b ==> norm(vsum s f) <= b`, + MESON_TAC[VSUM_NORM; REAL_LE_TRANS]);; + +let VSUM_NORM_BOUND = prove + (`!s f b. FINITE s /\ (!x:A. x IN s ==> norm(f(x)) <= b) + ==> norm(vsum s f) <= &(CARD s) * b`, + SIMP_TAC[GSYM SUM_CONST; VSUM_NORM_LE]);; + +let VSUM_CLAUSES_NUMSEG = prove + (`(!m. vsum(m..0) f = if m = 0 then f(0) else vec 0) /\ + (!m n. vsum(m..SUC n) f = if m <= SUC n then vsum(m..n) f + f(SUC n) + else vsum(m..n) f)`, + REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[VSUM_SING; VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_AC]);; + +let VSUM_CLAUSES_RIGHT = prove + (`!f m n. 0 < n /\ m <= n ==> vsum(m..n) f = vsum(m..n-1) f + (f n):real^N`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LT_REFL; VSUM_CLAUSES_NUMSEG; SUC_SUB1]);; + +let VSUM_CMUL_NUMSEG = prove + (`!f c m n. vsum (m..n) (\x. c % f x) = c % vsum (m..n) f`, + SIMP_TAC[VSUM_LMUL; FINITE_NUMSEG]);; + +let VSUM_EQ_NUMSEG = prove + (`!f g m n. + (!x. m <= x /\ x <= n ==> (f x = g x)) + ==> (vsum(m .. n) f = vsum(m .. n) g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG]);; + +let VSUM_IMAGE_GEN = prove + (`!f:A->B g s. + FINITE s + ==> (vsum s g = + vsum (IMAGE f s) (\y. vsum {x | x IN s /\ (f(x) = y)} g))`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_IMAGE_GEN]);; + +let VSUM_GROUP = prove + (`!f:A->B g s t. + FINITE s /\ IMAGE f s SUBSET t + ==> vsum t (\y. vsum {x | x IN s /\ f(x) = y} g) = vsum s g`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; SUM_GROUP]);; + +let VSUM_VMUL = prove + (`!f v s. (sum s f) % v = vsum s (\x. f(x) % v)`, + REWRITE_TAC[VSUM_RMUL]);; + +let VSUM_DELTA = prove + (`!s a. vsum s (\x. if x = a then b else vec 0) = + if a IN s then b else vec 0`, + SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN + SIMP_TAC[VEC_COMPONENT; SUM_DELTA]);; + +let VSUM_ADD_NUMSEG = prove + (`!f g m n. vsum(m..n) (\i. f i + g i) = vsum(m..n) f + vsum(m..n) g`, + SIMP_TAC[VSUM_ADD; FINITE_NUMSEG]);; + +let VSUM_SUB_NUMSEG = prove + (`!f g m n. vsum(m..n) (\i. f i - g i) = vsum(m..n) f - vsum(m..n) g`, + SIMP_TAC[VSUM_SUB; FINITE_NUMSEG]);; + +let VSUM_ADD_SPLIT = prove + (`!f m n p. + m <= n + 1 ==> vsum(m..n + p) f = vsum(m..n) f + vsum(n + 1..n + p) f`, + SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; + SUM_ADD_SPLIT]);; + +let VSUM_VSUM_PRODUCT = prove + (`!s:A->bool t:A->B->bool x. + FINITE s /\ (!i. i IN s ==> FINITE(t i)) + ==> vsum s (\i. vsum (t i) (x i)) = + vsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, + SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; COND_COMPONENT] THEN + SIMP_TAC[SUM_SUM_PRODUCT] THEN REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; + +let VSUM_IMAGE_NONZERO = prove + (`!d:B->real^N i:A->B s. + FINITE s /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = vec 0) + ==> vsum (IMAGE i s) d = vsum s (d o i)`, + GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[IMAGE_CLAUSES; VSUM_CLAUSES; FINITE_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `vsum s ((d:B->real^N) o (i:A->B)) = vsum (IMAGE i s) d` + SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN + REWRITE_TAC[VECTOR_ARITH `a = x + a <=> x = vec 0`] THEN + ASM_MESON_TAC[IN_IMAGE]);; + +let VSUM_UNION_NONZERO = prove + (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = vec 0) + ==> vsum (s UNION t) f = vsum s f + vsum t f`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN + SIMP_TAC[VEC_COMPONENT; SUM_UNION_NONZERO]);; + +let VSUM_UNIONS_NONZERO = prove + (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\ + (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 + ==> f x = vec 0) + ==> vsum (UNIONS s) f = vsum s (\t. vsum t f)`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; VSUM_CLAUSES; IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN + STRIP_TAC THEN MATCH_MP_TAC VSUM_UNION_NONZERO THEN + ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);; + +let VSUM_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> vsum(m..n) f = f m + vsum(m + 1..n) f`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN + SIMP_TAC[VEC_COMPONENT; SUM_CLAUSES_LEFT]);; + +let VSUM_DIFFS = prove + (`!m n. vsum(m..n) (\k. f(k) - f(k + 1)) = + if m <= n then f(m) - f(n + 1) else vec 0`, + GEN_TAC THEN INDUCT_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE] THEN + ASM_CASES_TAC `m = SUC n` THEN + ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; VECTOR_ADD_LID] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM ADD1] THEN VECTOR_ARITH_TAC);; + +let VSUM_DIFFS_ALT = prove + (`!m n. vsum(m..n) (\k. f(k + 1) - f(k)) = + if m <= n then f(n + 1) - f(m) else vec 0`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_NEG_SUB] THEN + SIMP_TAC[VSUM_NEG; VSUM_DIFFS] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]);; + +let VSUM_DELETE_CASES = prove + (`!x f s. + FINITE(s:A->bool) + ==> vsum(s DELETE x) f = if x IN s then vsum s f - f x else vsum s f`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SET_RULE `~(x IN s) ==> s DELETE x = s`] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [MATCH_MP (SET_RULE `x IN s ==> s = x INSERT (s DELETE x)`) th]) THEN + ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN VECTOR_ARITH_TAC);; + +let VSUM_EQ_GENERAL = prove + (`!s:A->bool t:B->bool (f:A->real^N) g h. + (!y. y IN t ==> ?!x. x IN s /\ h x = y) /\ + (!x. x IN s ==> h x IN t /\ g(h x) = f x) + ==> vsum s f = vsum t g`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN + EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);; + +let VSUM_EQ_GENERAL_INVERSES = prove + (`!s t (f:A->real^N) (g:B->real^N) h k. + (!y. y IN t ==> k y IN s /\ h (k y) = y) /\ + (!x. x IN s ==> h x IN t /\ k (h x) = x /\ g (h x) = f x) + ==> vsum s f = vsum t g`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + MAP_EVERY EXISTS_TAC [`h:A->B`; `k:B->A`] THEN ASM_MESON_TAC[]);; + +let VSUM_NORM_ALLSUBSETS_BOUND = prove + (`!f:A->real^N p e. + FINITE p /\ + (!q. q SUBSET p ==> norm(vsum q f) <= e) + ==> sum p (\x. norm(f x)) <= &2 * &(dimindex(:N)) * e`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum p (\x:A. sum (1..dimindex(:N)) (\i. abs((f x:real^N)$i)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[NORM_LE_L1]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_SWAP o lhand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 * &n * e = &n * &2 * e`] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) + [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {x:A | x IN p /\ &0 <= (f x:real^N)$k} (\x. abs((f x)$k)) + + sum {x | x IN p /\ (f x)$k < &0} (\x. abs((f x)$k))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= a`) THEN + MATCH_MP_TAC SUM_UNION_EQ THEN + ASM_SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_UNION; IN_ELIM_THM] THEN + CONJ_TAC THEN X_GEN_TAC `x:A` THEN ASM_CASES_TAC `(x:A) IN p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x <= e /\ y <= e ==> x + y <= &2 * e`) THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_ABS_NEG] THEN + CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH + `!g. sum s g = sum s f /\ sum s g <= e ==> sum s f <= e`) + THENL + [EXISTS_TAC `\x. ((f:A->real^N) x)$k`; + EXISTS_TAC `\x. --(((f:A->real^N) x)$k)`] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC]) THEN + ASM_SIMP_TAC[GSYM VSUM_COMPONENT; SUM_NEG; FINITE_RESTRICT] THEN + MATCH_MP_TAC(REAL_ARITH `abs(x) <= e ==> x <= e`) THEN + REWRITE_TAC[REAL_ABS_NEG] THEN + MATCH_MP_TAC(REAL_ARITH + `abs((vsum q f)$k) <= norm(vsum q f) /\ + norm(vsum q f) <= e + ==> abs((vsum q f)$k) <= e`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN SET_TAC[]);; + +let DOT_LSUM = prove + (`!s f y. FINITE s ==> (vsum s f) dot y = sum s (\x. f(x) dot y)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_LZERO; DOT_LADD]);; + +let DOT_RSUM = prove + (`!s f x. FINITE s ==> x dot (vsum s f) = sum s (\y. x dot f(y))`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; DOT_RZERO; DOT_RADD]);; + +let VSUM_OFFSET = prove + (`!p f m n. vsum(m + p..n + p) f = vsum(m..n) (\i. f (i + p))`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET]);; + +let VSUM_OFFSET_0 = prove + (`!f m n. m <= n ==> vsum(m..n) f = vsum(0..n - m) (\i. f (i + m))`, + SIMP_TAC[vsum; CART_EQ; LAMBDA_BETA; VEC_COMPONENT; SUM_OFFSET_0]);; + +let VSUM_TRIV_NUMSEG = prove + (`!f m n. n < m ==> vsum(m..n) f = vec 0`, + SIMP_TAC[GSYM NUMSEG_EMPTY; VSUM_CLAUSES]);; + +let VSUM_CONST_NUMSEG = prove + (`!c m n. vsum(m..n) (\n. c) = &((n + 1) - m) % c`, + SIMP_TAC[VSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);; + +let VSUM_SUC = prove + (`!f m n. vsum (SUC n..SUC m) f = vsum (n..m) (f o SUC)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `SUC n..SUC m = IMAGE SUC (n..m)` SUBST1_TAC THENL + [REWRITE_TAC [ADD1; NUMSEG_OFFSET_IMAGE] THEN + REWRITE_TAC [ONE; ADD_SUC; ADD_0; ETA_AX]; + SIMP_TAC [VSUM_IMAGE; FINITE_NUMSEG; SUC_INJ]]);; + +let VSUM_BIJECTION = prove + (`!f:A->real^N p s:A->bool. + (!x. x IN s ==> p(x) IN s) /\ + (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) + ==> vsum s f = vsum s (f o p)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC VSUM_EQ_GENERAL THEN EXISTS_TAC `p:A->A` THEN + ASM_REWRITE_TAC[o_THM]);; + +let VSUM_PARTIAL_SUC = prove + (`!f g:num->real^N m n. + vsum (m..n) (\k. f(k) % (g(k + 1) - g(k))) = + if m <= n then f(n + 1) % g(n + 1) - f(m) % g(m) - + vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k + 1)) + else vec 0`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN + ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL + [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL + [VECTOR_ARITH_TAC; ASM_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN + ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN VECTOR_ARITH_TAC);; + +let VSUM_PARTIAL_PRE = prove + (`!f g:num->real^N m n. + vsum (m..n) (\k. f(k) % (g(k) - g(k - 1))) = + if m <= n then f(n + 1) % g(n) - f(m) % g(m - 1) - + vsum (m..n) (\k. (f(k + 1) - f(k)) % g(k)) + else vec 0`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real^N)(k - 1)`; + `m:num`; `n:num`] VSUM_PARTIAL_SUC) THEN + REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]);; + +let VSUM_COMBINE_L = prove + (`!f m n p. + 0 < n /\ m <= n /\ n <= p + 1 + ==> vsum(m..n - 1) f + vsum(n..p) f = vsum(m..p) f`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_L]);; + +let VSUM_COMBINE_R = prove + (`!f m n p. + m <= n + 1 /\ n <= p + ==> vsum(m..n) f + vsum(n + 1..p) f = vsum(m..p) f`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VSUM_COMPONENT; SUM_COMBINE_R]);; + +let VSUM_INJECTION = prove + (`!f p s. + FINITE s /\ + (!x. x IN s ==> p x IN s) /\ + (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) + ==> vsum s (f o p) = vsum s f`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SUM_INJECTION) THEN + SIMP_TAC[CART_EQ; VSUM_COMPONENT; o_DEF]);; + +let VSUM_SWAP = prove + (`!f s t. + FINITE s /\ FINITE t + ==> vsum s (\i. vsum t (f i)) = vsum t (\j. vsum s (\i. f i j))`, + SIMP_TAC[CART_EQ; VSUM_COMPONENT] THEN REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_SWAP o lhs o snd) THEN + ASM_REWRITE_TAC[]);; + +let VSUM_SWAP_NUMSEG = prove + (`!a b c d f. + vsum (a..b) (\i. vsum (c..d) (f i)) = + vsum (c..d) (\j. vsum (a..b) (\i. f i j))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);; + +let VSUM_ADD_GEN = prove + (`!f g s. + FINITE {x | x IN s /\ ~(f x = vec 0)} /\ + FINITE {x | x IN s /\ ~(g x = vec 0)} + ==> vsum s (\x. f x + g x) = vsum s f + vsum s g`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SIMP_TAC[CART_EQ; vsum; LAMBDA_BETA; VECTOR_ADD_COMPONENT] THEN + REPEAT GEN_TAC THEN DISCH_THEN(K ALL_TAC) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_ADD_GEN THEN + POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DE_MORGAN_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[VEC_COMPONENT]);; + +let VSUM_CASES_1 = prove + (`!s a. FINITE s /\ a IN s + ==> vsum s (\x. if x = a then y else f(x)) = vsum s f + (y - f a)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_CASES] THEN + ASM_SIMP_TAC[GSYM DELETE; VSUM_DELETE] THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN + REWRITE_TAC[VSUM_SING] THEN VECTOR_ARITH_TAC);; + +let VSUM_SING_NUMSEG = prove + (`vsum(n..n) f = f n`, + REWRITE_TAC[NUMSEG_SING; VSUM_SING]);; + +let VSUM_1 = prove + (`vsum(1..1) f = f(1)`, + REWRITE_TAC[VSUM_SING_NUMSEG]);; + +let VSUM_2 = prove + (`!t. vsum(1..2) t = t(1) + t(2)`, + REWRITE_TAC[num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; + +let VSUM_3 = prove + (`!t. vsum(1..3) t = t(1) + t(2) + t(3)`, + REWRITE_TAC[num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);; + +let VSUM_4 = prove + (`!t. vsum(1..4) t = t(1) + t(2) + t(3) + t(4)`, + SIMP_TAC[num_CONV `4`; num_CONV `3`; num_CONV `2`; VSUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[VSUM_SING_NUMSEG; ARITH; VECTOR_ADD_ASSOC]);; + +let VSUM_PAIR = prove + (`!f:num->real^N m n. + vsum(2*m..2*n+1) f = vsum(m..n) (\i. f(2*i) + f(2*i+1))`, + SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_ADD_COMPONENT; SUM_PAIR]);; + +let VSUM_PAIR_0 = prove + (`!f:num->real^N n. vsum(0..2*n+1) f = vsum(0..n) (\i. f(2*i) + f(2*i+1))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `0`; `n:num`] VSUM_PAIR) THEN + ASM_REWRITE_TAC[ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Add useful congruences to the simplifier. *) +(* ------------------------------------------------------------------------- *) + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> vsum s (\i. f(i)) = vsum s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> vsum(a..b) (\i. f(i)) = vsum(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> vsum {y | p y} (\i. f(i)) = vsum {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; + +(* ------------------------------------------------------------------------- *) +(* A conversion for evaluation of `vsum(m..n) f` for numerals m and n. *) +(* ------------------------------------------------------------------------- *) + +let EXPAND_VSUM_CONV = + let [pth_0; pth_1; pth_2] = (CONJUNCTS o prove) + (`(n < m ==> vsum(m..n) (f:num->real^N) = vec 0) /\ + vsum(m..m) (f:num->real^N) = f m /\ + (m <= n ==> vsum (m..n) (f:num->real^N) = f m + vsum (m + 1..n) f)`, + REWRITE_TAC[VSUM_CLAUSES_LEFT; VSUM_SING_NUMSEG; VSUM_TRIV_NUMSEG]) + and ns_tm = `..` and f_tm = `f:num->real^N` + and m_tm = `m:num` and n_tm = `n:num` + and n_ty = `:N` in + let rec conv tm = + let smn,ftm = dest_comb tm in + let s,mn = dest_comb smn in + if not(is_const s & fst(dest_const s) = "vsum") + then failwith "EXPAND_VSUM_CONV" else + let mtm,ntm = dest_binop ns_tm mn in + let m = dest_numeral mtm and n = dest_numeral ntm in + let nty = hd(tl(snd(dest_type(snd(dest_fun_ty(type_of ftm)))))) in + let ilist = [nty,n_ty] in + let ifn = inst ilist and tfn = INST_TYPE ilist in + if n < m then + let th1 = INST [ftm,ifn f_tm; mtm,m_tm; ntm,n_tm] (tfn pth_0) in + MP th1 (EQT_ELIM(NUM_LT_CONV(lhand(concl th1)))) + else if n = m then CONV_RULE (RAND_CONV(TRY_CONV BETA_CONV)) + (INST [ftm,ifn f_tm; mtm,m_tm] (tfn pth_1)) + else + let th1 = INST [ftm,ifn f_tm; mtm,m_tm; ntm,n_tm] (tfn pth_2) in + let th2 = MP th1 (EQT_ELIM(NUM_LE_CONV(lhand(concl th1)))) in + CONV_RULE (RAND_CONV(COMB2_CONV (RAND_CONV(TRY_CONV BETA_CONV)) + (LAND_CONV(LAND_CONV NUM_ADD_CONV) THENC conv))) th2 in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Basis vectors in coordinate directions. *) +(* ------------------------------------------------------------------------- *) + +let basis = new_definition + `basis k = lambda i. if i = k then &1 else &0`;; + +let NORM_BASIS = prove + (`!k. 1 <= k /\ k <= dimindex(:N) + ==> (norm(basis k :real^N) = &1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[basis; dot; vector_norm] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SQRT_1] THEN AP_TERM_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum (1..dimindex(:N)) (\i. if i = k then &1 else &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN + ASM_SIMP_TAC[LAMBDA_BETA; IN_NUMSEG; EQ_SYM_EQ] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[SUM_DELTA; IN_NUMSEG]]);; + +let NORM_BASIS_1 = prove + (`norm(basis 1) = &1`, + SIMP_TAC[NORM_BASIS; ARITH_EQ; ARITH_RULE `1 <= k <=> ~(k = 0)`; + DIMINDEX_NONZERO]);; + +let VECTOR_CHOOSE_SIZE = prove + (`!c. &0 <= c ==> ?x:real^N. norm(x) = c`, + REPEAT STRIP_TAC THEN EXISTS_TAC `c % basis 1 :real^N` THEN + ASM_REWRITE_TAC[NORM_MUL; real_abs; NORM_BASIS_1; REAL_MUL_RID]);; + +let VECTOR_CHOOSE_DIST = prove + (`!x e. &0 <= e ==> ?y:real^N. dist(x,y) = e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?c:real^N. norm(c) = e` CHOOSE_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE]; ALL_TAC] THEN + EXISTS_TAC `x - c:real^N` THEN REWRITE_TAC[dist] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `x - (x - c) = c:real^N`]);; + +let BASIS_INJ = prove + (`!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ + (basis i :real^N = basis j) + ==> (i = j)`, + SIMP_TAC[basis; CART_EQ; LAMBDA_BETA] THEN REPEAT GEN_TAC THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; ARITH_EQ]);; + +let BASIS_INJ_EQ = prove + (`!i j. 1 <= i /\ i <= dimindex(:N) /\ 1 <= j /\ j <= dimindex(:N) + ==> (basis i:real^N = basis j <=> i = j)`, + MESON_TAC[BASIS_INJ]);; + +let BASIS_NE = prove + (`!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) /\ + ~(i = j) + ==> ~(basis i :real^N = basis j)`, + MESON_TAC[BASIS_INJ]);; + +let BASIS_COMPONENT = prove + (`!k i. 1 <= i /\ i <= dimindex(:N) + ==> ((basis k :real^N)$i = if i = k then &1 else &0)`, + SIMP_TAC[basis; LAMBDA_BETA] THEN MESON_TAC[]);; + +let BASIS_EXPANSION = prove + (`!x:real^N. vsum(1..dimindex(:N)) (\i. x$i % basis i) = x`, + SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[REAL_MUL_RZERO] THEN + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_RID]);; + +let BASIS_EXPANSION_UNIQUE = prove + (`!f x:real^N. (vsum(1..dimindex(:N)) (\i. f(i) % basis i) = x) <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> f(i) = x$i)`, + SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[COND_RAND; REAL_MUL_RZERO; REAL_MUL_RID] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o + ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + SIMP_TAC[SUM_DELTA; IN_NUMSEG]);; + +let DOT_BASIS = prove + (`!x:real^N i. + 1 <= i /\ i <= dimindex(:N) + ==> ((basis i) dot x = x$i) /\ (x dot (basis i) = x$i)`, + SIMP_TAC[dot; basis; LAMBDA_BETA] THEN + REWRITE_TAC[COND_RATOR; COND_RAND] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID; REAL_MUL_RID]);; + +let DOT_BASIS_BASIS = prove + (`!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (basis i:real^N) dot (basis j) = if i = j then &1 else &0`, + SIMP_TAC[DOT_BASIS; BASIS_COMPONENT]);; + +let DOT_BASIS_BASIS_UNEQUAL = prove + (`!i j. ~(i = j) ==> (basis i) dot (basis j) = &0`, + SIMP_TAC[basis; dot; LAMBDA_BETA] THEN ONCE_REWRITE_TAC[COND_RAND] THEN + SIMP_TAC[SUM_0; REAL_MUL_RZERO; REAL_MUL_LZERO; COND_ID]);; + +let BASIS_EQ_0 = prove + (`!i. (basis i :real^N = vec 0) <=> ~(i IN 1..dimindex(:N))`, + SIMP_TAC[CART_EQ; BASIS_COMPONENT; VEC_COMPONENT; IN_NUMSEG] THEN + MESON_TAC[REAL_ARITH `~(&1 = &0)`]);; + +let BASIS_NONZERO = prove + (`!k. 1 <= k /\ k <= dimindex(:N) + ==> ~(basis k :real^N = vec 0)`, + REWRITE_TAC[BASIS_EQ_0; IN_NUMSEG]);; + +let VECTOR_EQ_LDOT = prove + (`!y z. (!x. x dot y = x dot z) <=> y = z`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);; + +let VECTOR_EQ_RDOT = prove + (`!x y. (!z. x dot z = y dot z) <=> x = y`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN + REWRITE_TAC[CART_EQ] THEN MESON_TAC[DOT_BASIS]);; + +(* ------------------------------------------------------------------------- *) +(* Orthogonality. *) +(* ------------------------------------------------------------------------- *) + +let orthogonal = new_definition + `orthogonal x y <=> (x dot y = &0)`;; + +let ORTHOGONAL_0 = prove + (`!x. orthogonal (vec 0) x /\ orthogonal x (vec 0)`, + REWRITE_TAC[orthogonal; DOT_LZERO; DOT_RZERO]);; + +let ORTHOGONAL_REFL = prove + (`!x. orthogonal x x <=> x = vec 0`, + REWRITE_TAC[orthogonal; DOT_EQ_0]);; + +let ORTHOGONAL_SYM = prove + (`!x y. orthogonal x y <=> orthogonal y x`, + REWRITE_TAC[orthogonal; DOT_SYM]);; + +let ORTHOGONAL_LNEG = prove + (`!x y. orthogonal (--x) y <=> orthogonal x y`, + REWRITE_TAC[orthogonal; DOT_LNEG; REAL_NEG_EQ_0]);; + +let ORTHOGONAL_RNEG = prove + (`!x y. orthogonal x (--y) <=> orthogonal x y`, + REWRITE_TAC[orthogonal; DOT_RNEG; REAL_NEG_EQ_0]);; + +let ORTHOGONAL_MUL = prove + (`(!a x y:real^N. orthogonal (a % x) y <=> a = &0 \/ orthogonal x y) /\ + (!a x y:real^N. orthogonal x (a % y) <=> a = &0 \/ orthogonal x y)`, + REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE]);; + +let ORTHOGONAL_BASIS = prove + (`!x:real^N i. 1 <= i /\ i <= dimindex(:N) + ==> (orthogonal (basis i) x <=> (x$i = &0))`, + REPEAT STRIP_TAC THEN SIMP_TAC[orthogonal; dot; basis; LAMBDA_BETA] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[SUM_DELTA; IN_NUMSEG; REAL_MUL_LID]);; + +let ORTHOGONAL_BASIS_BASIS = prove + (`!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (orthogonal (basis i :real^N) (basis j) <=> ~(i = j))`, + ASM_SIMP_TAC[ORTHOGONAL_BASIS] THEN ASM_SIMP_TAC[BASIS_COMPONENT] THEN + MESON_TAC[REAL_ARITH `~(&1 = &0)`]);; + +let ORTHOGONAL_CLAUSES = prove + (`(!a. orthogonal a (vec 0)) /\ + (!a x c. orthogonal a x ==> orthogonal a (c % x)) /\ + (!a x. orthogonal a x ==> orthogonal a (--x)) /\ + (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x + y)) /\ + (!a x y. orthogonal a x /\ orthogonal a y ==> orthogonal a (x - y)) /\ + (!a. orthogonal (vec 0) a) /\ + (!a x c. orthogonal x a ==> orthogonal (c % x) a) /\ + (!a x. orthogonal x a ==> orthogonal (--x) a) /\ + (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x + y) a) /\ + (!a x y. orthogonal x a /\ orthogonal y a ==> orthogonal (x - y) a)`, + REWRITE_TAC[orthogonal; DOT_RNEG; DOT_RMUL; DOT_RADD; DOT_RSUB; + DOT_LZERO; DOT_RZERO; DOT_LNEG; DOT_LMUL; DOT_LADD; DOT_LSUB] THEN + SIMP_TAC[] THEN REAL_ARITH_TAC);; + +let ORTHOGONAL_RVSUM = prove + (`!f:A->real^N s x. + FINITE s /\ + (!y. y IN s ==> orthogonal x (f y)) + ==> orthogonal x (vsum s f)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);; + +let ORTHOGONAL_LVSUM = prove + (`!f:A->real^N s y. + FINITE s /\ + (!x. x IN s ==> orthogonal (f x) y) + ==> orthogonal (vsum s f) y`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NOT_IN_EMPTY; FORALL_IN_INSERT; ORTHOGONAL_CLAUSES; VSUM_CLAUSES]);; + +let NORM_ADD_PYTHAGOREAN = prove + (`!a b:real^N. + orthogonal a b + ==> norm(a + b) pow 2 = norm(a) pow 2 + norm(b) pow 2`, + SIMP_TAC[NORM_POW_2; orthogonal; DOT_LADD; DOT_RADD; DOT_SYM] THEN + REAL_ARITH_TAC);; + +let NORM_VSUM_PYTHAGOREAN = prove + (`!k u:A->real^N. + FINITE k /\ pairwise (\i j. orthogonal (u i) (u j)) k + ==> norm(vsum k u) pow 2 = sum k (\i. norm(u i) pow 2)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES; NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[PAIRWISE_INSERT] THEN + REWRITE_TAC[pairwise] THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NORM_ADD_PYTHAGOREAN THEN MATCH_MP_TAC ORTHOGONAL_RVSUM THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit vector construction from lists. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_1 = prove + (`(vector[x]:A^1)$1 = x`, + SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_1; ARITH; LENGTH; EL; HD; TL]);; + +let VECTOR_2 = prove + (`(vector[x;y]:A^2)$1 = x /\ + (vector[x;y]:A^2)$2 = y`, + SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_2; ARITH; LENGTH; EL] THEN + REWRITE_TAC[num_CONV `1`; HD; TL; EL]);; + +let VECTOR_3 = prove + (`(vector[x;y;z]:A^3)$1 = x /\ + (vector[x;y;z]:A^3)$2 = y /\ + (vector[x;y;z]:A^3)$3 = z`, + SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; ARITH; LENGTH; EL] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; HD; TL; EL]);; + +let VECTOR_4 = prove + (`(vector[w;x;y;z]:A^4)$1 = w /\ + (vector[w;x;y;z]:A^4)$2 = x /\ + (vector[w;x;y;z]:A^4)$3 = y /\ + (vector[w;x;y;z]:A^4)$4 = z`, + SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_4; ARITH; LENGTH; EL] THEN + REWRITE_TAC[num_CONV `3`; num_CONV `2`; num_CONV `1`; HD; TL; EL]);; + +let FORALL_VECTOR_1 = prove + (`(!v:A^1. P v) <=> !x. P(vector[x])`, + EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(v:A^1)$1`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[CART_EQ; FORALL_1; VECTOR_1; DIMINDEX_1]);; + +let FORALL_VECTOR_2 = prove + (`(!v:A^2. P v) <=> !x y. P(vector[x;y])`, + EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`(v:A^2)$1`; `(v:A^2)$2`]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[CART_EQ; FORALL_2; VECTOR_2; DIMINDEX_2]);; + +let FORALL_VECTOR_3 = prove + (`(!v:A^3. P v) <=> !x y z. P(vector[x;y;z])`, + EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(v:A^3)$1`; `(v:A^3)$2`; `(v:A^3)$3`]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[CART_EQ; FORALL_3; VECTOR_3; DIMINDEX_3]);; + +let FORALL_VECTOR_4 = prove + (`(!v:A^4. P v) <=> !w x y z. P(vector[w;x;y;z])`, + EQ_TAC THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(v:A^4)$1`; `(v:A^4)$2`; `(v:A^4)$3`; `(v:A^4)$4`]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[CART_EQ; FORALL_4; VECTOR_4; DIMINDEX_4]);; + +let EXISTS_VECTOR_1 = prove + (`(?v:A^1. P v) <=> ?x. P(vector[x])`, + REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_VECTOR_1]);; + +let EXISTS_VECTOR_2 = prove + (`(?v:A^2. P v) <=> ?x y. P(vector[x;y])`, + REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_VECTOR_2]);; + +let EXISTS_VECTOR_3 = prove + (`(?v:A^3. P v) <=> ?x y z. P(vector[x;y;z])`, + REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_VECTOR_3]);; + +let EXISTS_VECTOR_4 = prove + (`(?v:A^4. P v) <=> ?w x y z. P(vector[w;x;y;z])`, + REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_VECTOR_4]);; + +let VECTOR_EXPAND_1 = prove + (`!x:real^1. x = vector[x$1]`, + SIMP_TAC[CART_EQ; DIMINDEX_1; FORALL_1; VECTOR_1]);; + +let VECTOR_EXPAND_2 = prove + (`!x:real^2. x = vector[x$1;x$2]`, + SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2]);; + +let VECTOR_EXPAND_3 = prove + (`!x:real^3. x = vector[x$1;x$2;x$3]`, + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3]);; + +let VECTOR_EXPAND_4 = prove + (`!x:real^4. x = vector[x$1;x$2;x$3;x$4]`, + SIMP_TAC[CART_EQ; DIMINDEX_4; FORALL_4; VECTOR_4]);; + +(* ------------------------------------------------------------------------- *) +(* Linear functions. *) +(* ------------------------------------------------------------------------- *) + +let linear = new_definition + `linear (f:real^M->real^N) <=> + (!x y. f(x + y) = f(x) + f(y)) /\ + (!c x. f(c % x) = c % f(x))`;; + +let LINEAR_COMPOSE_CMUL = prove + (`!f c. linear f ==> linear (\x. c % f(x))`, + SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LINEAR_COMPOSE_NEG = prove + (`!f. linear f ==> linear (\x. --(f(x)))`, + SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LINEAR_COMPOSE_ADD = prove + (`!f g. linear f /\ linear g ==> linear (\x. f(x) + g(x))`, + SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LINEAR_COMPOSE_SUB = prove + (`!f g. linear f /\ linear g ==> linear (\x. f(x) - g(x))`, + SIMP_TAC[linear] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LINEAR_COMPOSE = prove + (`!f g. linear f /\ linear g ==> linear (g o f)`, + SIMP_TAC[linear; o_THM]);; + +let LINEAR_ID = prove + (`linear (\x. x)`, + REWRITE_TAC[linear]);; + +let LINEAR_I = prove + (`linear I`, + REWRITE_TAC[I_DEF; LINEAR_ID]);; + +let LINEAR_ZERO = prove + (`linear (\x. vec 0)`, + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let LINEAR_NEGATION = prove + (`linear(--)`, + REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; + +let LINEAR_COMPOSE_VSUM = prove + (`!f s. FINITE s /\ (!a. a IN s ==> linear(f a)) + ==> linear(\x. vsum s (\a. f a x))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; LINEAR_ZERO] THEN + ASM_SIMP_TAC[ETA_AX; IN_INSERT; LINEAR_COMPOSE_ADD]);; + +let LINEAR_VMUL_COMPONENT = prove + (`!f:real^M->real^N v k. + linear f /\ 1 <= k /\ k <= dimindex(:N) + ==> linear (\x. f(x)$k % v)`, + SIMP_TAC[linear; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LINEAR_0 = prove + (`!f. linear f ==> (f(vec 0) = vec 0)`, + MESON_TAC[VECTOR_MUL_LZERO; linear]);; + +let LINEAR_CMUL = prove + (`!f c x. linear f ==> (f(c % x) = c % f(x))`, + SIMP_TAC[linear]);; + +let LINEAR_NEG = prove + (`!f x. linear f ==> (f(--x) = --(f x))`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[LINEAR_CMUL]);; + +let LINEAR_ADD = prove + (`!f x y. linear f ==> (f(x + y) = f(x) + f(y))`, + SIMP_TAC[linear]);; + +let LINEAR_SUB = prove + (`!f x y. linear f ==> (f(x - y) = f(x) - f(y))`, + SIMP_TAC[VECTOR_SUB; LINEAR_ADD; LINEAR_NEG]);; + +let LINEAR_VSUM = prove + (`!f g s. linear f /\ FINITE s ==> (f(vsum s g) = vsum s (f o g))`, + GEN_TAC THEN GEN_TAC THEN SIMP_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES] THEN FIRST_ASSUM(fun th -> + SIMP_TAC[MATCH_MP LINEAR_0 th; MATCH_MP LINEAR_ADD th; o_THM]));; + +let LINEAR_VSUM_MUL = prove + (`!f s c v. + linear f /\ FINITE s + ==> f(vsum s (\i. c i % v i)) = vsum s (\i. c(i) % f(v i))`, + SIMP_TAC[LINEAR_VSUM; o_DEF; LINEAR_CMUL]);; + +let LINEAR_INJECTIVE_0 = prove + (`!f. linear f + ==> ((!x y. (f(x) = f(y)) ==> (x = y)) <=> + (!x. (f(x) = vec 0) ==> (x = vec 0)))`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN MESON_TAC[VECTOR_SUB_RZERO]);; + +let LINEAR_BOUNDED = prove + (`!f:real^M->real^N. linear f ==> ?B. !x. norm(f x) <= B * norm(x)`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `sum(1..dimindex(:M)) (\i. norm((f:real^M->real^N)(basis i)))` THEN + GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM BASIS_EXPANSION] THEN + ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_SIMP_TAC[o_DEF; NORM_MUL; LINEAR_CMUL] THEN + ASM_SIMP_TAC[REAL_LE_RMUL; NORM_POS_LE; COMPONENT_LE_NORM]);; + +let LINEAR_BOUNDED_POS = prove + (`!f:real^M->real^N. linear f ==> ?B. &0 < B /\ !x. norm(f x) <= B * norm(x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP LINEAR_BOUNDED) THEN + EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + REAL_ARITH_TAC);; + +let SYMMETRIC_LINEAR_IMAGE = prove + (`!f s. (!x. x IN s ==> --x IN s) /\ linear f + ==> !x. x IN (IMAGE f s) ==> --x IN (IMAGE f s)`, + REWRITE_TAC[FORALL_IN_IMAGE] THEN + SIMP_TAC[GSYM LINEAR_NEG] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Bilinear functions. *) +(* ------------------------------------------------------------------------- *) + +let bilinear = new_definition + `bilinear f <=> (!x. linear(\y. f x y)) /\ (!y. linear(\x. f x y))`;; + +let BILINEAR_LADD = prove + (`!h x y z. bilinear h ==> h (x + y) z = (h x z) + (h y z)`, + SIMP_TAC[bilinear; linear]);; + +let BILINEAR_RADD = prove + (`!h x y z. bilinear h ==> h x (y + z) = (h x y) + (h x z)`, + SIMP_TAC[bilinear; linear]);; + +let BILINEAR_LMUL = prove + (`!h c x y. bilinear h ==> h (c % x) y = c % (h x y)`, + SIMP_TAC[bilinear; linear]);; + +let BILINEAR_RMUL = prove + (`!h c x y. bilinear h ==> h x (c % y) = c % (h x y)`, + SIMP_TAC[bilinear; linear]);; + +let BILINEAR_LNEG = prove + (`!h x y. bilinear h ==> h (--x) y = --(h x y)`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_LMUL]);; + +let BILINEAR_RNEG = prove + (`!h x y. bilinear h ==> h x (--y) = --(h x y)`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN SIMP_TAC[BILINEAR_RMUL]);; + +let BILINEAR_LZERO = prove + (`!h x. bilinear h ==> h (vec 0) x = vec 0`, + ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN + SIMP_TAC[GSYM BILINEAR_LADD; VECTOR_ADD_LID]);; + +let BILINEAR_RZERO = prove + (`!h x. bilinear h ==> h x (vec 0) = vec 0`, + ONCE_REWRITE_TAC[VECTOR_ARITH `x = vec 0 <=> x + x = x`] THEN + SIMP_TAC[GSYM BILINEAR_RADD; VECTOR_ADD_LID]);; + +let BILINEAR_LSUB = prove + (`!h x y z. bilinear h ==> h (x - y) z = (h x z) - (h y z)`, + SIMP_TAC[VECTOR_SUB; BILINEAR_LNEG; BILINEAR_LADD]);; + +let BILINEAR_RSUB = prove + (`!h x y z. bilinear h ==> h x (y - z) = (h x y) - (h x z)`, + SIMP_TAC[VECTOR_SUB; BILINEAR_RNEG; BILINEAR_RADD]);; + +let BILINEAR_VSUM = prove + (`!h:real^M->real^N->real^P. + bilinear h /\ FINITE s /\ FINITE t + ==> h (vsum s f) (vsum t g) = vsum (s CROSS t) (\(i,j). h (f i) (g j))`, + REPEAT GEN_TAC THEN SIMP_TAC[bilinear; ETA_AX] THEN + ONCE_REWRITE_TAC[TAUT `(a /\ b) /\ c /\ d <=> (a /\ d) /\ (b /\ c)`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_ALL o MATCH_MP LINEAR_VSUM o SPEC_ALL) THEN + SIMP_TAC[] THEN ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; VSUM_VSUM_PRODUCT] THEN + REWRITE_TAC[GSYM CROSS]);; + +let BILINEAR_BOUNDED = prove + (`!h:real^M->real^N->real^P. + bilinear h ==> ?B. !x y. norm(h x y) <= B * norm(x) * norm(y)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `sum ((1..dimindex(:M)) CROSS (1..dimindex(:N))) + (\(i,j). norm((h:real^M->real^N->real^P) + (basis i) (basis j)))` THEN + REPEAT GEN_TAC THEN GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV o BINOP_CONV) [GSYM BASIS_EXPANSION] THEN + ASM_SIMP_TAC[BILINEAR_VSUM; FINITE_NUMSEG] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + SIMP_TAC[FINITE_CROSS; FINITE_NUMSEG; FORALL_PAIR_THM; IN_CROSS] THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[BILINEAR_LMUL; NORM_MUL] THEN + ASM_SIMP_TAC[BILINEAR_RMUL; NORM_MUL; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM; REAL_ABS_POS; REAL_LE_MUL2]);; + +let BILINEAR_BOUNDED_POS = prove + (`!h. bilinear h + ==> ?B. &0 < B /\ !x y. norm(h x y) <= B * norm(x) * norm(y)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP BILINEAR_BOUNDED) THEN + EXISTS_TAC `abs(B) + &1` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x <= a ==> x <= b`) THEN + REPEAT(MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[NORM_POS_LE; REAL_LE_MUL]) THEN + REAL_ARITH_TAC);; + +let BILINEAR_VSUM_PARTIAL_SUC = prove + (`!f g h:real^M->real^N->real^P m n. + bilinear h + ==> vsum (m..n) (\k. h (f k) (g(k + 1) - g(k))) = + if m <= n then h (f(n + 1)) (g(n + 1)) - h (f m) (g m) - + vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k + 1))) + else vec 0`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + GEN_TAC THEN INDUCT_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; GSYM NOT_LE] THEN + ASM_REWRITE_TAC[VSUM_CLAUSES_NUMSEG] THENL + [COND_CASES_TAC THEN ASM_SIMP_TAC[ARITH] THENL + [ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC; + ASM_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[GSYM NOT_LT; VSUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN + ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN + ASM_SIMP_TAC[BILINEAR_RSUB; BILINEAR_LSUB] THEN VECTOR_ARITH_TAC);; + +let BILINEAR_VSUM_PARTIAL_PRE = prove + (`!f g h:real^M->real^N->real^P m n. + bilinear h + ==> vsum (m..n) (\k. h (f k) (g(k) - g(k - 1))) = + if m <= n then h (f(n + 1)) (g(n)) - h (f m) (g(m - 1)) - + vsum (m..n) (\k. h (f(k + 1) - f(k)) (g(k))) + else vec 0`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPECL [`f:num->real^M`; `\k. (g:num->real^N)(k - 1)`; + `m:num`; `n:num`] o MATCH_MP BILINEAR_VSUM_PARTIAL_SUC) THEN + REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Adjoints. *) +(* ------------------------------------------------------------------------- *) + +let adjoint = new_definition + `adjoint(f:real^M->real^N) = @f'. !x y. f(x) dot y = x dot f'(y)`;; + +let ADJOINT_WORKS = prove + (`!f:real^M->real^N. linear f ==> !x y. f(x) dot y = x dot (adjoint f)(y)`, + GEN_TAC THEN DISCH_TAC THEN SIMP_TAC[adjoint] THEN CONV_TAC SELECT_CONV THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN ONCE_REWRITE_TAC[GSYM SKOLEM_THM] THEN + X_GEN_TAC `y:real^N` THEN + EXISTS_TAC `(lambda i. (f:real^M->real^N) (basis i) dot y):real^M` THEN + X_GEN_TAC `x:real^M` THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN + ASM_SIMP_TAC[LINEAR_VSUM; FINITE_NUMSEG] THEN + SIMP_TAC[dot; LAMBDA_BETA; VSUM_COMPONENT; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN + ASM_SIMP_TAC[o_THM; VECTOR_MUL_COMPONENT; LINEAR_CMUL; REAL_MUL_ASSOC]);; + +let ADJOINT_LINEAR = prove + (`!f:real^M->real^N. linear f ==> linear(adjoint f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[linear; GSYM VECTOR_EQ_LDOT] THEN + ASM_SIMP_TAC[DOT_RMUL; DOT_RADD; GSYM ADJOINT_WORKS]);; + +let ADJOINT_CLAUSES = prove + (`!f:real^M->real^N. + linear f ==> (!x y. x dot (adjoint f)(y) = f(x) dot y) /\ + (!x y. (adjoint f)(y) dot x = y dot f(x))`, + MESON_TAC[ADJOINT_WORKS; DOT_SYM]);; + +let ADJOINT_ADJOINT = prove + (`!f:real^M->real^N. linear f ==> adjoint(adjoint f) = f`, + SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_LDOT; ADJOINT_CLAUSES; ADJOINT_LINEAR]);; + +let ADJOINT_UNIQUE = prove + (`!f f'. linear f /\ (!x y. f'(x) dot y = x dot f(y)) + ==> f' = adjoint f`, + SIMP_TAC[FUN_EQ_THM; GSYM VECTOR_EQ_RDOT; ADJOINT_CLAUSES]);; + +let ADJOINT_COMPOSE = prove + (`!f g:real^N->real^N. + linear f /\ linear g ==> adjoint(f o g) = adjoint g o adjoint f`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN + ASM_SIMP_TAC[LINEAR_COMPOSE; o_THM; ADJOINT_CLAUSES]);; + +let SELF_ADJOINT_COMPOSE = prove + (`!f g:real^N->real^N. + linear f /\ linear g /\ adjoint f = f /\ adjoint g = g + ==> (adjoint(f o g) = f o g <=> f o g = g o f)`, + SIMP_TAC[ADJOINT_COMPOSE] THEN MESON_TAC[]);; + +let SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS = prove + (`!f:real^N->real^N v w a b. + linear f /\ adjoint f = f /\ f v = a % v /\ f w = b % w /\ ~(a = b) + ==> orthogonal v w`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPECL [`v:real^N`; `w:real^N`] o + MATCH_MP ADJOINT_WORKS) THEN + ASM_REWRITE_TAC[DOT_LMUL; DOT_RMUL; orthogonal; REAL_EQ_MUL_RCANCEL]);; + +(* ------------------------------------------------------------------------- *) +(* Matrix notation. NB: an MxN matrix is of type real^N^M, not real^M^N. *) +(* We could define a special type if we're going to use them a lot. *) +(* ------------------------------------------------------------------------- *) + +overload_interface ("--",`(matrix_neg):real^N^M->real^N^M`);; +overload_interface ("+",`(matrix_add):real^N^M->real^N^M->real^N^M`);; +overload_interface ("-",`(matrix_sub):real^N^M->real^N^M->real^N^M`);; + +make_overloadable "**" `:A->B->C`;; + +overload_interface ("**",`(matrix_mul):real^N^M->real^P^N->real^P^M`);; +overload_interface ("**",`(matrix_vector_mul):real^N^M->real^N->real^M`);; +overload_interface ("**",`(vector_matrix_mul):real^M->real^N^M->real^N`);; + +parse_as_infix("%%",(21,"right"));; + +prioritize_real();; + +let matrix_cmul = new_definition + `((%%):real->real^N^M->real^N^M) c A = lambda i j. c * A$i$j`;; + +let matrix_neg = new_definition + `!A:real^N^M. --A = lambda i j. --(A$i$j)`;; + +let matrix_add = new_definition + `!A:real^N^M B:real^N^M. A + B = lambda i j. A$i$j + B$i$j`;; + +let matrix_sub = new_definition + `!A:real^N^M B:real^N^M. A - B = lambda i j. A$i$j - B$i$j`;; + +let matrix_mul = new_definition + `!A:real^N^M B:real^P^N. + A ** B = + lambda i j. sum(1..dimindex(:N)) (\k. A$i$k * B$k$j)`;; + +let matrix_vector_mul = new_definition + `!A:real^N^M x:real^N. + A ** x = lambda i. sum(1..dimindex(:N)) (\j. A$i$j * x$j)`;; + +let vector_matrix_mul = new_definition + `!A:real^N^M x:real^M. + x ** A = lambda j. sum(1..dimindex(:M)) (\i. A$i$j * x$i)`;; + +let mat = new_definition + `(mat:num->real^N^M) k = lambda i j. if i = j then &k else &0`;; + +let transp = new_definition + `(transp:real^N^M->real^M^N) A = lambda i j. A$j$i`;; + +let row = new_definition + `(row:num->real^N^M->real^N) i A = lambda j. A$i$j`;; + +let column = new_definition + `(column:num->real^N^M->real^M) j A = lambda i. A$i$j`;; + +let rows = new_definition + `rows(A:real^N^M) = { row i A | 1 <= i /\ i <= dimindex(:M)}`;; + +let columns = new_definition + `columns(A:real^N^M) = { column i A | 1 <= i /\ i <= dimindex(:N)}`;; + +let MATRIX_CMUL_COMPONENT = prove + (`!c A:real^N^M i. (c %% A)$i$j = c * A$i$j`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[matrix_cmul; CART_EQ; LAMBDA_BETA]);; + +let MATRIX_ADD_COMPONENT = prove + (`!A B:real^N^M i j. (A + B)$i$j = A$i$j + B$i$j`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[matrix_add; LAMBDA_BETA]);; + +let MATRIX_SUB_COMPONENT = prove + (`!A B:real^N^M i j. (A - B)$i$j = A$i$j - B$i$j`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[matrix_sub; LAMBDA_BETA]);; + +let MATRIX_NEG_COMPONENT = prove + (`!A:real^N^M i j. (--A)$i$j = --(A$i$j)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[matrix_neg; LAMBDA_BETA]);; + +let TRANSP_COMPONENT = prove + (`!A:real^N^M i j. (transp A)$i$j = A$j$i`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ + (!A:real^M^N. A$i = A$k) /\ (!z:real^N. z$i = z$k)` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:M) /\ + (!A:real^N^M. A$j = A$l) /\ (!z:real^M. z$j = z$l)` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE_2]; ALL_TAC] THEN + ASM_SIMP_TAC[transp; LAMBDA_BETA]);; + +let MAT_COMPONENT = prove + (`!n i j. + 1 <= i /\ i <= dimindex(:M) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (mat n:real^N^M)$i$j = if i = j then &n else &0`, + SIMP_TAC[mat; LAMBDA_BETA]);; + +let MAT_0_COMPONENT = prove + (`!i j. (mat 0:real^N^M)$i$j = &0`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[mat; COND_ID; LAMBDA_BETA]);; + +let MATRIX_CMUL_ASSOC = prove + (`!a b X:real^M^N. a %% (b %% X) = (a * b) %% X`, + SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_ASSOC]);; + +let MATRIX_CMUL_LID = prove + (`!X:real^M^N. &1 %% X = X`, + SIMP_TAC[CART_EQ; matrix_cmul; LAMBDA_BETA; REAL_MUL_LID]);; + +let MATRIX_ADD_SYM = prove + (`!A:real^N^M B. A + B = B + A`, + SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);; + +let MATRIX_ADD_ASSOC = prove + (`!A:real^N^M B C. A + (B + C) = (A + B) + C`, + SIMP_TAC[matrix_add; CART_EQ; LAMBDA_BETA; REAL_ADD_AC]);; + +let MATRIX_ADD_LID = prove + (`!A. mat 0 + A = A`, + SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_LID]);; + +let MATRIX_ADD_RID = prove + (`!A. A + mat 0 = A`, + SIMP_TAC[matrix_add; mat; COND_ID; CART_EQ; LAMBDA_BETA; REAL_ADD_RID]);; + +let MATRIX_ADD_LNEG = prove + (`!A. --A + A = mat 0`, + SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID; + CART_EQ; LAMBDA_BETA; REAL_ADD_LINV]);; + +let MATRIX_ADD_RNEG = prove + (`!A. A + --A = mat 0`, + SIMP_TAC[matrix_neg; matrix_add; mat; COND_ID; + CART_EQ; LAMBDA_BETA; REAL_ADD_RINV]);; + +let MATRIX_SUB = prove + (`!A:real^N^M B. A - B = A + --B`, + SIMP_TAC[matrix_neg; matrix_add; matrix_sub; CART_EQ; LAMBDA_BETA; + real_sub]);; + +let MATRIX_SUB_REFL = prove + (`!A. A - A = mat 0`, + REWRITE_TAC[MATRIX_SUB; MATRIX_ADD_RNEG]);; + +let MATRIX_ADD_LDISTRIB = prove + (`!A:real^N^M B:real^P^N C. A ** (B + C) = A ** B + A ** C`, + SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA; + GSYM SUM_ADD_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + ASM_SIMP_TAC[LAMBDA_BETA; REAL_ADD_LDISTRIB]);; + +let MATRIX_MUL_LID = prove + (`!A:real^N^M. mat 1 ** A = A`, + REWRITE_TAC[matrix_mul; + GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] + (SPEC_ALL mat)] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);; + +let MATRIX_MUL_RID = prove + (`!A:real^N^M. A ** mat 1 = A`, + REWRITE_TAC[matrix_mul; mat] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_NUMSEG; REAL_MUL_RID]);; + +let MATRIX_MUL_ASSOC = prove + (`!A:real^N^M B:real^P^N C:real^Q^P. A ** B ** C = (A ** B) ** C`, + REPEAT GEN_TAC THEN + SIMP_TAC[matrix_mul; CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);; + +let MATRIX_MUL_LZERO = prove + (`!A. (mat 0:real^N^M) ** (A:real^P^N) = mat 0`, + SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO] THEN + REWRITE_TAC[SUM_0]);; + +let MATRIX_MUL_RZERO = prove + (`!A. (A:real^N^M) ** (mat 0:real^P^N) = mat 0`, + SIMP_TAC[matrix_mul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO] THEN + REWRITE_TAC[SUM_0]);; + +let MATRIX_ADD_RDISTRIB = prove + (`!A:real^N^M B C:real^P^N. (A + B) ** C = A ** C + B ** C`, + SIMP_TAC[matrix_mul; matrix_add; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);; + +let MATRIX_SUB_LDISTRIB = prove + (`!A:real^N^M B C:real^P^N. A ** (B - C) = A ** B - A ** C`, + SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB; SUM_SUB_NUMSEG]);; + +let MATRIX_SUB_RDISTRIB = prove + (`!A:real^N^M B C:real^P^N. (A - B) ** C = A ** C - B ** C`, + SIMP_TAC[matrix_mul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);; + +let MATRIX_MUL_LMUL = prove + (`!A:real^N^M B:real^P^N c. (c %% A) ** B = c %% (A ** B)`, + SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; SUM_LMUL]);; + +let MATRIX_MUL_RMUL = prove + (`!A:real^N^M B:real^P^N c. A ** (c %% B) = c %% (A ** B)`, + SIMP_TAC[matrix_mul; matrix_cmul; CART_EQ; LAMBDA_BETA] THEN + ONCE_REWRITE_TAC[REAL_ARITH `A * c * B:real = c * A * B`] THEN + REWRITE_TAC[SUM_LMUL]);; + +let MATRIX_CMUL_ADD_LDISTRIB = prove + (`!A:real^N^M B c. c %% (A + B) = c %% A + c %% B`, + SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB]);; + +let MATRIX_CMUL_SUB_LDISTRIB = prove + (`!A:real^N^M B c. c %% (A - B) = c %% A - c %% B`, + SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB]);; + +let MATRIX_CMUL_ADD_RDISTRIB = prove + (`!A:real^N^M b c. (b + c) %% A = b %% A + c %% A`, + SIMP_TAC[matrix_cmul; matrix_add; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB]);; + +let MATRIX_CMUL_SUB_RDISTRIB = prove + (`!A:real^N^M b c. (b - c) %% A = b %% A - c %% A`, + SIMP_TAC[matrix_cmul; matrix_sub; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB]);; + +let MATRIX_CMUL_RZERO = prove + (`!c. c %% mat 0 = mat 0`, + SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_RZERO]);; + +let MATRIX_CMUL_LZERO = prove + (`!A. &0 %% A = mat 0`, + SIMP_TAC[matrix_cmul; mat; CART_EQ; LAMBDA_BETA; COND_ID; REAL_MUL_LZERO]);; + +let MATRIX_NEG_MINUS1 = prove + (`!A:real^N^M. --A = --(&1) %% A`, + REWRITE_TAC[matrix_cmul; matrix_neg; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[GSYM REAL_NEG_MINUS1]);; + +let MATRIX_ADD_AC = prove + (`(A:real^N^M) + B = B + A /\ + (A + B) + C = A + (B + C) /\ + A + (B + C) = B + (A + C)`, + MESON_TAC[MATRIX_ADD_ASSOC; MATRIX_ADD_SYM]);; + +let MATRIX_NEG_ADD = prove + (`!A B:real^N^M. --(A + B) = --A + --B`, + SIMP_TAC[matrix_neg; matrix_add; CART_EQ; LAMBDA_BETA; REAL_NEG_ADD]);; + +let MATRIX_NEG_SUB = prove + (`!A B:real^N^M. --(A - B) = B - A`, + SIMP_TAC[matrix_neg; matrix_sub; CART_EQ; LAMBDA_BETA; REAL_NEG_SUB]);; + +let MATRIX_NEG_0 = prove + (`--(mat 0) = mat 0`, + SIMP_TAC[CART_EQ; mat; matrix_neg; LAMBDA_BETA; REAL_NEG_0; COND_ID]);; + +let MATRIX_SUB_RZERO = prove + (`!A:real^N^M. A - mat 0 = A`, + SIMP_TAC[CART_EQ; mat; matrix_sub; LAMBDA_BETA; REAL_SUB_RZERO; COND_ID]);; + +let MATRIX_SUB_LZERO = prove + (`!A:real^N^M. mat 0 - A = --A`, + SIMP_TAC[CART_EQ; mat; matrix_sub; matrix_neg; + LAMBDA_BETA; REAL_SUB_LZERO; COND_ID]);; + +let MATRIX_NEG_EQ_0 = prove + (`!A:real^N^M. --A = mat 0 <=> A = mat 0`, + SIMP_TAC[CART_EQ; matrix_neg; mat; LAMBDA_BETA; REAL_NEG_EQ_0; COND_ID]);; + +let MATRIX_VECTOR_MUL_ASSOC = prove + (`!A:real^N^M B:real^P^N x:real^P. A ** B ** x = (A ** B) ** x`, + REPEAT GEN_TAC THEN + SIMP_TAC[matrix_mul; matrix_vector_mul; + CART_EQ; LAMBDA_BETA; GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[]);; + +let MATRIX_VECTOR_MUL_LID = prove + (`!x:real^N. mat 1 ** x = x`, + REWRITE_TAC[matrix_vector_mul; + GEN_REWRITE_RULE (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] + (SPEC_ALL mat)] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN REWRITE_TAC[COND_RATOR; COND_RAND] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_LZERO; IN_NUMSEG; REAL_MUL_LID]);; + +let MATRIX_VECTOR_MUL_LZERO = prove + (`!x:real^N. mat 0 ** x = vec 0`, + SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA; + COND_ID; REAL_MUL_LZERO; SUM_0]);; + +let MATRIX_VECTOR_MUL_RZERO = prove + (`!A:real^M^N. A ** vec 0 = vec 0`, + SIMP_TAC[mat; matrix_vector_mul; CART_EQ; VEC_COMPONENT; LAMBDA_BETA; + COND_ID; REAL_MUL_RZERO; SUM_0]);; + +let MATRIX_VECTOR_MUL_ADD_LDISTRIB = prove + (`!A:real^M^N x:real^M y. A ** (x + y) = A ** x + A ** y`, + SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_ADD_COMPONENT; LAMBDA_BETA; + SUM_ADD_NUMSEG; REAL_ADD_LDISTRIB]);; + +let MATRIX_VECTOR_MUL_SUB_LDISTRIB = prove + (`!A:real^M^N x:real^M y. A ** (x - y) = A ** x - A ** y`, + SIMP_TAC[CART_EQ; matrix_vector_mul; VECTOR_SUB_COMPONENT; LAMBDA_BETA; + SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB]);; + +let MATRIX_VECTOR_MUL_ADD_RDISTRIB = prove + (`!A:real^M^N B x. (A + B) ** x = (A ** x) + (B ** x)`, + SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_add; LAMBDA_BETA; + VECTOR_ADD_COMPONENT; REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG]);; + +let MATRIX_VECTOR_MUL_SUB_RDISTRIB = prove + (`!A:real^M^N B x. (A - B) ** x = (A ** x) - (B ** x)`, + SIMP_TAC[CART_EQ; matrix_vector_mul; matrix_sub; LAMBDA_BETA; + VECTOR_SUB_COMPONENT; REAL_SUB_RDISTRIB; SUM_SUB_NUMSEG]);; + +let MATRIX_VECTOR_MUL_RMUL = prove + (`!A:real^M^N x:real^M c. A ** (c % x) = c % (A ** x)`, + SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; matrix_vector_mul; LAMBDA_BETA] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_AC]);; + +let MATRIX_MUL_LNEG = prove + (`!A:real^N^M B:real^P^N. (--A) ** B = --(A ** B)`, + REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_LMUL]);; + +let MATRIX_MUL_RNEG = prove + (`!A:real^N^M B:real^P^N. A ** --B = --(A ** B)`, + REWRITE_TAC[MATRIX_NEG_MINUS1; MATRIX_MUL_RMUL]);; + +let MATRIX_NEG_NEG = prove + (`!A:real^N^N. --(--A) = A`, + SIMP_TAC[CART_EQ; MATRIX_NEG_COMPONENT; REAL_NEG_NEG]);; + +let MATRIX_TRANSP_MUL = prove + (`!A B. transp(A ** B) = transp(B) ** transp(A)`, + SIMP_TAC[matrix_mul; transp; CART_EQ; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let SYMMETRIC_MATRIX_MUL = prove + (`!A B:real^N^N. + transp(A) = A /\ transp(B) = B + ==> (transp(A ** B) = A ** B <=> A ** B = B ** A)`, + SIMP_TAC[MATRIX_TRANSP_MUL] THEN MESON_TAC[]);; + +let MATRIX_EQ = prove + (`!A:real^N^M B. (A = B) = !x:real^N. A ** x = B ** x`, + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o GEN `i:num` o SPEC `(basis i):real^N`) THEN + SIMP_TAC[CART_EQ; matrix_vector_mul; LAMBDA_BETA; basis] THEN + SIMP_TAC[SUM_DELTA; COND_RAND; REAL_MUL_RZERO] THEN + REWRITE_TAC[TAUT `(if p then b else T) <=> p ==> b`] THEN + SIMP_TAC[REAL_MUL_RID; IN_NUMSEG]);; + +let MATRIX_VECTOR_MUL_COMPONENT = prove + (`!A:real^N^M x k. + 1 <= k /\ k <= dimindex(:M) ==> ((A ** x)$k = (A$k) dot x)`, + SIMP_TAC[matrix_vector_mul; LAMBDA_BETA; dot]);; + +let DOT_LMUL_MATRIX = prove + (`!A:real^N^M x:real^M y:real^N. (x ** A) dot y = x dot (A ** y)`, + SIMP_TAC[dot; matrix_vector_mul; vector_matrix_mul; dot; LAMBDA_BETA] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + REWRITE_TAC[GSYM SUM_RMUL] THEN + GEN_REWRITE_TAC RAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);; + +let TRANSP_MATRIX_CMUL = prove + (`!A:real^M^N c. transp(c %% A) = c %% transp A`, + SIMP_TAC[CART_EQ; transp; MATRIX_CMUL_COMPONENT; LAMBDA_BETA]);; + +let TRANSP_MATRIX_ADD = prove + (`!A B:real^N^M. transp(A + B) = transp A + transp B`, + SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_add]);; + +let TRANSP_MATRIX_SUB = prove + (`!A B:real^N^M. transp(A - B) = transp A - transp B`, + SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_sub]);; + +let TRANSP_MATRIX_NEG = prove + (`!A:real^N^M. transp(--A) = --(transp A)`, + SIMP_TAC[CART_EQ; transp; LAMBDA_BETA; matrix_neg]);; + +let TRANSP_MAT = prove + (`!n. transp(mat n) = mat n`, + SIMP_TAC[transp; mat; LAMBDA_BETA; CART_EQ; EQ_SYM_EQ]);; + +let TRANSP_TRANSP = prove + (`!A:real^N^M. transp(transp A) = A`, + SIMP_TAC[CART_EQ; transp; LAMBDA_BETA]);; + +let SYMMETRIX_MATRIX_CONJUGATE = prove + (`!A B:real^N^N. transp B = B + ==> transp(transp A ** B ** A) = transp A ** B ** A`, + SIMP_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC]);; + +let TRANSP_EQ = prove + (`!A B:real^M^N. transp A = transp B <=> A = B`, + MESON_TAC[TRANSP_TRANSP]);; + +let ROW_TRANSP = prove + (`!A:real^N^M i. + 1 <= i /\ i <= dimindex(:N) ==> row i (transp A) = column i A`, + SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);; + +let COLUMN_TRANSP = prove + (`!A:real^N^M i. + 1 <= i /\ i <= dimindex(:M) ==> column i (transp A) = row i A`, + SIMP_TAC[row; column; transp; CART_EQ; LAMBDA_BETA]);; + +let ROWS_TRANSP = prove + (`!A:real^N^M. rows(transp A) = columns A`, + REWRITE_TAC[rows; columns; EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[ROW_TRANSP]);; + +let COLUMNS_TRANSP = prove + (`!A:real^N^M. columns(transp A) = rows A`, + MESON_TAC[TRANSP_TRANSP; ROWS_TRANSP]);; + +let VECTOR_MATRIX_MUL_TRANSP = prove + (`!A:real^M^N x:real^N. x ** A = transp A ** x`, + REWRITE_TAC[matrix_vector_mul; vector_matrix_mul; transp] THEN + SIMP_TAC[LAMBDA_BETA; CART_EQ]);; + +let MATRIX_VECTOR_MUL_TRANSP = prove + (`!A:real^M^N x:real^M. A ** x = x ** transp A`, + REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP]);; + +let FINITE_ROWS = prove + (`!A:real^N^M. FINITE(rows A)`, + REWRITE_TAC[rows] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);; + +let FINITE_COLUMNS = prove + (`!A:real^N^M. FINITE(columns A)`, + REWRITE_TAC[columns] THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[GSYM numseg; FINITE_IMAGE; FINITE_NUMSEG]);; + +let MATRIX_EQUAL_ROWS = prove + (`!A B:real^N^M. + A = B <=> !i. 1 <= i /\ i <= dimindex(:M) ==> row i A = row i B`, + SIMP_TAC[row; CART_EQ; LAMBDA_BETA]);; + +let MATRIX_EQUAL_COLUMNS = prove + (`!A B:real^N^M. + A = B <=> !i. 1 <= i /\ i <= dimindex(:N) ==> column i A = column i B`, + SIMP_TAC[column; CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]);; + +let MATRIX_CMUL_EQ_0 = prove + (`!A:real^M^N c. c %% A = mat 0 <=> c = &0 \/ A = mat 0`, + SIMP_TAC[CART_EQ; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; COND_ID] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN + ASM_REWRITE_TAC[REAL_ENTIRE]);; + +let MAT_EQ = prove + (`!m n. mat m = mat n <=> m = n`, + SIMP_TAC[CART_EQ; MAT_COMPONENT] THEN REPEAT STRIP_TAC THEN + MESON_TAC[REAL_OF_NUM_EQ; DIMINDEX_GE_1; LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Two sometimes fruitful ways of looking at matrix-vector multiplication. *) +(* ------------------------------------------------------------------------- *) + +let MATRIX_MUL_DOT = prove + (`!A:real^N^M x. A ** x = lambda i. A$i dot x`, + REWRITE_TAC[matrix_vector_mul; dot] THEN SIMP_TAC[CART_EQ; LAMBDA_BETA]);; + +let MATRIX_MUL_VSUM = prove + (`!A:real^N^M x. A ** x = vsum(1..dimindex(:N)) (\i. x$i % column i A)`, + SIMP_TAC[matrix_vector_mul; CART_EQ; VSUM_COMPONENT; LAMBDA_BETA; + VECTOR_MUL_COMPONENT; column; REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Slightly gruesome lemmas: better to define sums over vectors really... *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_COMPONENTWISE = prove + (`!x:real^N. + x = lambda j. sum(1..dimindex(:N)) + (\i. x$i * (basis i :real^N)$j)`, + SIMP_TAC[CART_EQ; LAMBDA_BETA; basis] THEN + ONCE_REWRITE_TAC[ARITH_RULE `(m:num = n) <=> (n = m)`] THEN + SIMP_TAC[COND_RAND; REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN + REWRITE_TAC[REAL_MUL_RID; COND_ID]);; + +let LINEAR_COMPONENTWISE_EXPANSION = prove + (`!f:real^M->real^N. + linear(f) + ==> !x j. 1 <= j /\ j <= dimindex(:N) + ==> (f x $j = + sum(1..dimindex(:M)) (\i. x$i * f(basis i)$j))`, + REWRITE_TAC[linear] THEN REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) + [VECTOR_COMPONENTWISE] THEN + SPEC_TAC(`dimindex(:M)`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THENL + [REWRITE_TAC[GSYM vec] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV) + [GSYM VECTOR_MUL_LZERO] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[vec; LAMBDA_BETA]; + REWRITE_TAC[ARITH_RULE `1 <= SUC n`] THEN + ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN + SIMP_TAC[GSYM VECTOR_MUL_COMPONENT; + ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN + ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN + SIMP_TAC[GSYM VECTOR_ADD_COMPONENT; + ASSUME `1 <= j`; ASSUME `j <= dimindex(:N)`] THEN + ASSUM_LIST(fun thl -> REWRITE_TAC(map GSYM thl)) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; LAMBDA_BETA] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT]]);; + +(* ------------------------------------------------------------------------- *) +(* Inverse matrices (not necessarily square, but it's vacuous otherwise). *) +(* ------------------------------------------------------------------------- *) + +let invertible = new_definition + `invertible(A:real^N^M) <=> + ?A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;; + +let matrix_inv = new_definition + `matrix_inv(A:real^N^M) = + @A':real^M^N. (A ** A' = mat 1) /\ (A' ** A = mat 1)`;; + +let MATRIX_INV = prove + (`!A:real^N^M. + invertible A ==> A ** matrix_inv A = mat 1 /\ matrix_inv A ** A = mat 1`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[matrix_inv; invertible] THEN + CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[GSYM invertible]);; + +let MATRIX_INV_UNIQUE = prove + (`!A:real^N^M B. A ** B = mat 1 /\ B ** A = mat 1 ==> matrix_inv A = B`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `A:real^N^M` MATRIX_INV) THEN + ANTS_TAC THENL [ASM_MESON_TAC[invertible]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o + AP_TERM `(( ** ):real^M^N->real^M^M->real^M^N) B` o CONJUNCT1) THEN + ASM_REWRITE_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID; MATRIX_MUL_RID]);; + +let INVERTIBLE_NEG = prove + (`!A:real^N^M. invertible(--A) <=> invertible A`, + REWRITE_TAC[invertible] THEN + MESON_TAC[MATRIX_MUL_LNEG; MATRIX_MUL_RNEG; MATRIX_NEG_NEG]);; + +let MATRIX_INV_I = prove + (`matrix_inv(mat 1:real^N^N) = mat 1`, + MATCH_MP_TAC MATRIX_INV_UNIQUE THEN + REWRITE_TAC[MATRIX_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Correspondence between matrices and linear operators. *) +(* ------------------------------------------------------------------------- *) + +let matrix = new_definition + `(matrix:(real^M->real^N)->real^M^N) f = lambda i j. f(basis j)$i`;; + +let MATRIX_VECTOR_MUL_LINEAR = prove + (`!A:real^N^M. linear(\x. A ** x)`, + REWRITE_TAC[linear; matrix_vector_mul] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[GSYM SUM_ADD_NUMSEG; GSYM SUM_LMUL; REAL_ADD_LDISTRIB] THEN + REWRITE_TAC[REAL_ADD_AC; REAL_MUL_AC]);; + +let MATRIX_WORKS = prove + (`!f:real^M->real^N. linear f ==> !x. matrix f ** x = f(x)`, + REWRITE_TAC[matrix; matrix_vector_mul] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN GEN_TAC THEN DISCH_TAC THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM LINEAR_COMPONENTWISE_EXPANSION]);; + +let MATRIX_VECTOR_MUL = prove + (`!f:real^M->real^N. linear f ==> f = \x. matrix f ** x`, + SIMP_TAC[FUN_EQ_THM; MATRIX_WORKS]);; + +let MATRIX_OF_MATRIX_VECTOR_MUL = prove + (`!A:real^N^M. matrix(\x. A ** x) = A`, + SIMP_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LINEAR; MATRIX_WORKS]);; + +let MATRIX_COMPOSE = prove + (`!f g. linear f /\ linear g ==> (matrix(g o f) = matrix g ** matrix f)`, + SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; LINEAR_COMPOSE; + GSYM MATRIX_VECTOR_MUL_ASSOC; o_THM]);; + +let MATRIX_VECTOR_COLUMN = prove + (`!A:real^N^M x. + A ** x = vsum(1..dimindex(:N)) (\i. x$i % (transp A)$i)`, + REWRITE_TAC[matrix_vector_mul; transp] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; VSUM_COMPONENT; VECTOR_MUL_COMPONENT] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let MATRIX_MUL_COMPONENT = prove + (`!i. 1 <= i /\ i <= dimindex(:N) + ==> ((A:real^N^N) ** (B:real^N^N))$i = transp B ** A$i`, + SIMP_TAC[matrix_mul; LAMBDA_BETA; matrix_vector_mul; vector_matrix_mul; + transp; CART_EQ] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let ADJOINT_MATRIX = prove + (`!A:real^N^M. adjoint(\x. A ** x) = (\x. transp A ** x)`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC ADJOINT_UNIQUE THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN REPEAT GEN_TAC THEN + SIMP_TAC[transp; dot; LAMBDA_BETA; matrix_vector_mul; + GSYM SUM_LMUL; GSYM SUM_RMUL] THEN + GEN_REWRITE_TAC LAND_CONV [SUM_SWAP_NUMSEG] THEN REWRITE_TAC[REAL_MUL_AC]);; + +let MATRIX_ADJOINT = prove + (`!f. linear f ==> matrix(adjoint f) = transp(matrix f)`, + GEN_TAC THEN DISCH_THEN + (fun th -> GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) + [MATCH_MP MATRIX_VECTOR_MUL th]) THEN + REWRITE_TAC[ADJOINT_MATRIX; MATRIX_OF_MATRIX_VECTOR_MUL]);; + +let MATRIX_ID = prove + (`matrix(\x. x) = mat 1`, + SIMP_TAC[MATRIX_EQ; LINEAR_ID; MATRIX_WORKS; MATRIX_VECTOR_MUL_LID]);; + +let MATRIX_I = prove + (`matrix I = mat 1`, + REWRITE_TAC[I_DEF; MATRIX_ID]);; + +let LINEAR_EQ_MATRIX = prove + (`!f g. linear f /\ linear g /\ matrix f = matrix g ==> f = g`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP MATRIX_VECTOR_MUL)) THEN + ASM_REWRITE_TAC[]);; + +let MATRIX_SELF_ADJOINT = prove + (`!f. linear f ==> (adjoint f = f <=> transp(matrix f) = matrix f)`, + SIMP_TAC[GSYM MATRIX_ADJOINT] THEN + MESON_TAC[LINEAR_EQ_MATRIX; ADJOINT_LINEAR]);; + +let LINEAR_MATRIX_EXISTS = prove + (`!f:real^M->real^N. linear f <=> ?A:real^M^N. f = \x. A ** x`, + GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[MATRIX_VECTOR_MUL_LINEAR; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN EXISTS_TAC `matrix(f:real^M->real^N)` THEN + ASM_SIMP_TAC[GSYM MATRIX_VECTOR_MUL]);; + +let LINEAR_1 = prove + (`!f:real^1->real^1. linear f <=> ?c. f = \x. c % x`, + SIMP_TAC[LINEAR_MATRIX_EXISTS; EXISTS_VECTOR_1] THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; FORALL_1; DIMINDEX_1; VECTOR_1; + matrix_vector_mul; SUM_1; CART_EQ; LAMBDA_BETA; + VECTOR_MUL_COMPONENT]);; + +let SYMMETRIC_MATRIX = prove + (`!A:real^N^N. transp A = A <=> adjoint(\x. A ** x) = \x. A ** x`, + SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR] THEN + REWRITE_TAC[MATRIX_OF_MATRIX_VECTOR_MUL]);; + +let SYMMETRIC_MATRIX_ORTHOGONAL_EIGENVECTORS = prove + (`!A:real^N^N v w a b. + transp A = A /\ A ** v = a % v /\ A ** w = b % w /\ ~(a = b) + ==> orthogonal v w`, + REPEAT GEN_TAC THEN REWRITE_TAC[SYMMETRIC_MATRIX] THEN + DISCH_THEN(MATCH_MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ_ALT] + SELF_ADJOINT_ORTHOGONAL_EIGENVECTORS)) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; + +(* ------------------------------------------------------------------------- *) +(* Operator norm. *) +(* ------------------------------------------------------------------------- *) + +let onorm = new_definition + `onorm (f:real^M->real^N) = sup { norm(f x) | norm(x) = &1 }`;; + +let NORM_BOUND_GENERALIZE = prove + (`!f:real^M->real^N b. + linear f + ==> ((!x. (norm(x) = &1) ==> norm(f x) <= b) <=> + (!x. norm(f x) <= b * norm(x)))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_MUL_RID]] THEN + X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `x:real^M = vec 0` THENL + [ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN + ASM_MESON_TAC[LINEAR_0; NORM_0; REAL_LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; NORM_POS_LT; real_div] THEN + MATCH_MP_TAC(REAL_ARITH `abs(a * b) <= c ==> b * a <= c`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM; GSYM NORM_MUL] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM; REAL_MUL_LINV; + NORM_EQ_0]);; + +let ONORM = prove + (`!f:real^M->real^N. + linear f + ==> (!x. norm(f x) <= onorm f * norm(x)) /\ + (!b. (!x. norm(f x) <= b * norm(x)) ==> onorm f <= b)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `{ norm((f:real^M->real^N) x) | norm(x) = &1 }` SUP) THEN + SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN + ASM_SIMP_TAC[NORM_BOUND_GENERALIZE; GSYM onorm; GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; LINEAR_BOUNDED; REAL_POS]);; + +let ONORM_POS_LE = prove + (`!f. linear f ==> &0 <= onorm f`, + MESON_TAC[ONORM; VECTOR_CHOOSE_SIZE; REAL_POS; REAL_MUL_RID; NORM_POS_LE; + REAL_LE_TRANS]);; + +let ONORM_EQ_0 = prove + (`!f:real^M->real^N. linear f ==> ((onorm f = &0) <=> (!x. f x = vec 0))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `f:real^M->real^N` ONORM) THEN + ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; ONORM_POS_LE; NORM_0; REAL_MUL_LZERO; + NORM_LE_0; REAL_LE_REFL]);; + +let ONORM_CONST = prove + (`!y:real^N. onorm(\x:real^M. y) = norm(y)`, + GEN_TAC THEN REWRITE_TAC[onorm] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `sup {norm(y:real^N)}` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC(SET_RULE + `(?x. P x) ==> {f y | x | P x} = {f y}`) THEN + EXISTS_TAC `basis 1 :real^M` THEN + SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; + MATCH_MP_TAC REAL_SUP_UNIQUE THEN SET_TAC[REAL_LE_REFL]]);; + +let ONORM_POS_LT = prove + (`!f. linear f ==> (&0 < onorm f <=> ~(!x. f x = vec 0))`, + SIMP_TAC[GSYM ONORM_EQ_0; ONORM_POS_LE; + REAL_ARITH `(&0 < x <=> ~(x = &0)) <=> &0 <= x`]);; + +let ONORM_COMPOSE = prove + (`!f g. linear f /\ linear g ==> onorm(f o g) <= onorm f * onorm g`, + MESON_TAC[ONORM; LINEAR_COMPOSE; o_THM; REAL_MUL_ASSOC; REAL_LE_TRANS; ONORM; + REAL_LE_LMUL; ONORM_POS_LE]);; + +let ONORM_NEG_LEMMA = prove + (`!f. linear f ==> onorm(\x. --(f x)) <= onorm f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP ONORM o + MATCH_MP LINEAR_COMPOSE_NEG) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[NORM_NEG; ONORM]);; + +let ONORM_NEG = prove + (`!f:real^M->real^N. linear f ==> (onorm(\x. --(f x)) = onorm f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_SIMP_TAC[ONORM_NEG_LEMMA] THEN + SUBGOAL_THEN `f:real^M->real^N = \x. --(--(f x))` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + ASM_SIMP_TAC[ONORM_NEG_LEMMA; LINEAR_COMPOSE_NEG] THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let ONORM_TRIANGLE = prove + (`!f:real^M->real^N g. + linear f /\ linear g ==> onorm(\x. f x + g x) <= onorm f + onorm g`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2 o MATCH_MP ONORM o MATCH_MP + LINEAR_COMPOSE_ADD) THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + ASM_MESON_TAC[REAL_LE_ADD2; REAL_LE_TRANS; NORM_TRIANGLE; ONORM]);; + +let ONORM_TRIANGLE_LE = prove + (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) <= e + ==> onorm(\x. f x + g x) <= e`, + MESON_TAC[REAL_LE_TRANS; ONORM_TRIANGLE]);; + +let ONORM_TRIANGLE_LT = prove + (`!f g. linear f /\ linear g /\ onorm(f) + onorm(g) < e + ==> onorm(\x. f x + g x) < e`, + MESON_TAC[REAL_LET_TRANS; ONORM_TRIANGLE]);; + +let ONORM_ID = prove + (`onorm(\x:real^N. x) = &1`, + REWRITE_TAC[onorm] THEN + SUBGOAL_THEN `{norm(x:real^N) | norm x = &1} = {&1}` + (fun th -> REWRITE_TAC[th; SUP_SING]) THEN + SUBGOAL_THEN `norm(basis 1:real^N) = &1` MP_TAC THENL + [SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; SET_TAC[]]);; + +let ONORM_I = prove + (`onorm(I:real^N->real^N) = &1`, + REWRITE_TAC[I_DEF; ONORM_ID]);; + +(* ------------------------------------------------------------------------- *) +(* It's handy to "lift" from R to R^1 and "drop" from R^1 to R. *) +(* ------------------------------------------------------------------------- *) + +let lift = new_definition + `(lift:real->real^1) x = lambda i. x`;; + +let drop = new_definition + `(drop:real^1->real) x = x$1`;; + +let LIFT_COMPONENT = prove + (`!x. (lift x)$1 = x`, + SIMP_TAC[lift; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);; + +let LIFT_DROP = prove + (`(!x. lift(drop x) = x) /\ (!x. drop(lift x) = x)`, + SIMP_TAC[lift; drop; CART_EQ; LAMBDA_BETA; DIMINDEX_1; LE_ANTISYM]);; + +let IMAGE_LIFT_DROP = prove + (`(!s. IMAGE (lift o drop) s = s) /\ (!s. IMAGE (drop o lift) s = s)`, + REWRITE_TAC[o_DEF; LIFT_DROP] THEN SET_TAC[]);; + +let IN_IMAGE_LIFT_DROP = prove + (`(!x s. x IN IMAGE lift s <=> drop x IN s) /\ + (!x s. x IN IMAGE drop s <=> lift x IN s)`, + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; + +let FORALL_LIFT = prove + (`(!x. P x) = (!x. P(lift x))`, + MESON_TAC[LIFT_DROP]);; + +let EXISTS_LIFT = prove + (`(?x. P x) = (?x. P(lift x))`, + MESON_TAC[LIFT_DROP]);; + +let FORALL_DROP = prove + (`(!x. P x) = (!x. P(drop x))`, + MESON_TAC[LIFT_DROP]);; + +let EXISTS_DROP = prove + (`(?x. P x) = (?x. P(drop x))`, + MESON_TAC[LIFT_DROP]);; + +let FORALL_LIFT_FUN = prove + (`!P:(A->real^1)->bool. (!f. P f) <=> (!f. P(lift o f))`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + X_GEN_TAC `f:A->real^1` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop o (f:A->real^1)`) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]);; + +let FORALL_DROP_FUN = prove + (`!P:(A->real)->bool. (!f. P f) <=> (!f. P(drop o f))`, + REWRITE_TAC[FORALL_LIFT_FUN; o_DEF; LIFT_DROP; ETA_AX]);; + +let EXISTS_LIFT_FUN = prove + (`!P:(A->real^1)->bool. (?f. P f) <=> (?f. P(lift o f))`, + ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_LIFT_FUN]);; + +let EXISTS_DROP_FUN = prove + (`!P:(A->real)->bool. (?f. P f) <=> (?f. P(drop o f))`, + ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_DROP_FUN]);; + +let LIFT_EQ = prove + (`!x y. (lift x = lift y) <=> (x = y)`, + MESON_TAC[LIFT_DROP]);; + +let DROP_EQ = prove + (`!x y. (drop x = drop y) <=> (x = y)`, + MESON_TAC[LIFT_DROP]);; + +let LIFT_IN_IMAGE_LIFT = prove + (`!x s. (lift x) IN (IMAGE lift s) <=> x IN s`, + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; + +let FORALL_LIFT_IMAGE = prove + (`!P. (!s. P s) <=> (!s. P(IMAGE lift s))`, + MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; + +let EXISTS_LIFT_IMAGE = prove + (`!P. (?s. P s) <=> (?s. P(IMAGE lift s))`, + MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; + +let SUBSET_LIFT_IMAGE = prove + (`!s t. IMAGE lift s SUBSET IMAGE lift t <=> s SUBSET t`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN + DISCH_THEN(MP_TAC o ISPEC `drop` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);; + +let FORALL_DROP_IMAGE = prove + (`!P. (!s. P s) <=> (!s. P(IMAGE drop s))`, + MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; + +let EXISTS_DROP_IMAGE = prove + (`!P. (?s. P s) <=> (?s. P(IMAGE drop s))`, + MESON_TAC[IMAGE_LIFT_DROP; IMAGE_o]);; + +let SUBSET_DROP_IMAGE = prove + (`!s t. IMAGE drop s SUBSET IMAGE drop t <=> s SUBSET t`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[IMAGE_SUBSET] THEN + DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP IMAGE_SUBSET) THEN + REWRITE_TAC[GSYM IMAGE_o; IMAGE_LIFT_DROP]);; + +let DROP_IN_IMAGE_DROP = prove + (`!x s. (drop x) IN (IMAGE drop s) <=> x IN s`, + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[LIFT_DROP]);; + +let LIFT_NUM = prove + (`!n. lift(&n) = vec n`, + SIMP_TAC[CART_EQ; lift; vec; LAMBDA_BETA]);; + +let LIFT_ADD = prove + (`!x y. lift(x + y) = lift x + lift y`, + SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_ADD_COMPONENT]);; + +let LIFT_SUB = prove + (`!x y. lift(x - y) = lift x - lift y`, + SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_SUB_COMPONENT]);; + +let LIFT_CMUL = prove + (`!x c. lift(c * x) = c % lift(x)`, + SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_MUL_COMPONENT]);; + +let LIFT_NEG = prove + (`!x. lift(--x) = --(lift x)`, + SIMP_TAC[CART_EQ; lift; LAMBDA_BETA; VECTOR_NEG_COMPONENT]);; + +let LIFT_EQ_CMUL = prove + (`!x. lift x = x % vec 1`, + REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]);; + +let SUM_VSUM = prove + (`!f s. sum s f = drop(vsum s(lift o f))`, + SIMP_TAC[vsum; drop; LAMBDA_BETA; DIMINDEX_1; ARITH] THEN + REWRITE_TAC[o_THM; GSYM drop; LIFT_DROP; ETA_AX]);; + +let VSUM_REAL = prove + (`!f s. vsum s f = lift(sum s (drop o f))`, + REWRITE_TAC[o_DEF; SUM_VSUM; LIFT_DROP; ETA_AX]);; + +let LIFT_SUM = prove + (`!k x. lift(sum k x) = vsum k (lift o x)`, + REWRITE_TAC[SUM_VSUM; LIFT_DROP]);; + +let DROP_VSUM = prove + (`!k x. drop(vsum k x) = sum k (drop o x)`, + REWRITE_TAC[VSUM_REAL; LIFT_DROP]);; + +let DROP_LAMBDA = prove + (`!x. drop(lambda i. x i) = x 1`, + SIMP_TAC[drop; LAMBDA_BETA; DIMINDEX_1; LE_REFL]);; + +let DROP_VEC = prove + (`!n. drop(vec n) = &n`, + MESON_TAC[LIFT_DROP; LIFT_NUM]);; + +let DROP_ADD = prove + (`!x y. drop(x + y) = drop x + drop y`, + MESON_TAC[LIFT_DROP; LIFT_ADD]);; + +let DROP_SUB = prove + (`!x y. drop(x - y) = drop x - drop y`, + MESON_TAC[LIFT_DROP; LIFT_SUB]);; + +let DROP_CMUL = prove + (`!x c. drop(c % x) = c * drop(x)`, + MESON_TAC[LIFT_DROP; LIFT_CMUL]);; + +let DROP_NEG = prove + (`!x. drop(--x) = --(drop x)`, + MESON_TAC[LIFT_DROP; LIFT_NEG]);; + +let NORM_1 = prove + (`!x. norm x = abs(drop x)`, + REWRITE_TAC[drop; NORM_REAL]);; + +let NORM_1_POS = prove + (`!x. &0 <= drop x ==> norm x = drop x`, + SIMP_TAC[NORM_1; real_abs]);; + +let NORM_LIFT = prove + (`!x. norm(lift x) = abs(x)`, + SIMP_TAC[lift; NORM_REAL; LIFT_COMPONENT]);; + +let DIST_LIFT = prove + (`!x y. dist(lift x,lift y) = abs(x - y)`, + REWRITE_TAC[DIST_REAL; LIFT_COMPONENT]);; + +let ABS_DROP = prove + (`!x. norm x = abs(drop x)`, + REWRITE_TAC[FORALL_LIFT; LIFT_DROP; NORM_LIFT]);; + +let LINEAR_VMUL_DROP = prove + (`!f v. linear f ==> linear (\x. drop(f x) % v)`, + SIMP_TAC[drop; LINEAR_VMUL_COMPONENT; DIMINDEX_1; LE_REFL]);; + +let LINEAR_FROM_REALS = prove + (`!f:real^1->real^N. linear f ==> f = \x. drop x % column 1 (matrix f)`, + GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN + SIMP_TAC[CART_EQ; matrix_vector_mul; vector_mul; LAMBDA_BETA; + DIMINDEX_1; SUM_SING_NUMSEG; drop; column] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let LINEAR_TO_REALS = prove + (`!f:real^N->real^1. linear f ==> f = \x. lift(row 1 (matrix f) dot x)`, + GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM(MATCH_MP MATRIX_WORKS th)]) THEN + SIMP_TAC[CART_EQ; matrix_vector_mul; dot; LAMBDA_BETA; + DIMINDEX_1; SUM_SING_NUMSEG; lift; row; LE_ANTISYM]);; + +let DROP_EQ_0 = prove + (`!x. drop x = &0 <=> x = vec 0`, + REWRITE_TAC[GSYM DROP_EQ; DROP_VEC]);; + +let DROP_WLOG_LE = prove + (`(!x y. P x y <=> P y x) /\ (!x y. drop x <= drop y ==> P x y) + ==> (!x y. P x y)`, + MESON_TAC[REAL_LE_TOTAL]);; + +let IMAGE_LIFT_UNIV = prove + (`IMAGE lift (:real) = (:real^1)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);; + +let IMAGE_DROP_UNIV = prove + (`IMAGE drop (:real^1) = (:real)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]);; + +let LINEAR_LIFT_DOT = prove + (`!a. linear(\x. lift(a dot x))`, + REWRITE_TAC[linear; DOT_RMUL; DOT_RADD; LIFT_ADD; LIFT_CMUL]);; + +let LINEAR_LIFT_COMPONENT = prove + (`!k. linear(\x:real^N. lift(x$k))`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?j. 1 <= j /\ j <= dimindex(:N) /\ !z:real^N. z$k = z$j` + CHOOSE_TAC THENL + [REWRITE_TAC[FINITE_INDEX_INRANGE]; + MP_TAC(ISPEC `basis j:real^N` LINEAR_LIFT_DOT) THEN + ASM_SIMP_TAC[DOT_BASIS]]);; + +let BILINEAR_DROP_MUL = prove + (`bilinear (\x y:real^N. drop x % y)`, + REWRITE_TAC[bilinear; linear] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; + +let LINEAR_COMPONENTWISE = prove + (`!f:real^M->real^N. + linear f <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> linear(\x. lift(f(x)$i))`, + REPEAT GEN_TAC THEN REWRITE_TAC[linear] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN + SIMP_TAC[GSYM LIFT_CMUL; GSYM LIFT_ADD; LIFT_EQ] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Pasting vectors. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_FSTCART = prove + (`linear fstcart`, + SIMP_TAC[linear; fstcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM; + ARITH_RULE `x <= a ==> x <= a + b:num`]);; + +let LINEAR_SNDCART = prove + (`linear sndcart`, + SIMP_TAC[linear; sndcart; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; DIMINDEX_FINITE_SUM; + ARITH_RULE `x <= a ==> x <= a + b:num`; + ARITH_RULE `x <= b ==> x + a <= a + b:num`]);; + +let FSTCART_VEC = prove + (`!n. fstcart(vec n) = vec n`, + SIMP_TAC[vec; fstcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM; + ARITH_RULE `m <= n:num ==> m <= n + p`]);; + +let FSTCART_ADD = prove + (`!x:real^(M,N)finite_sum y. fstcart(x + y) = fstcart(x) + fstcart(y)`, + REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);; + +let FSTCART_CMUL = prove + (`!x:real^(M,N)finite_sum c. fstcart(c % x) = c % fstcart(x)`, + REWRITE_TAC[REWRITE_RULE[linear] LINEAR_FSTCART]);; + +let FSTCART_NEG = prove + (`!x:real^(M,N)finite_sum. --(fstcart x) = fstcart(--x)`, + ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN + REWRITE_TAC[FSTCART_CMUL]);; + +let FSTCART_SUB = prove + (`!x:real^(M,N)finite_sum y. fstcart(x - y) = fstcart(x) - fstcart(y)`, + REWRITE_TAC[VECTOR_SUB; FSTCART_NEG; FSTCART_ADD]);; + +let FSTCART_VSUM = prove + (`!k x. FINITE k ==> (fstcart(vsum k x) = vsum k (\i. fstcart(x i)))`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; FSTCART_ADD; FSTCART_VEC]);; + +let SNDCART_VEC = prove + (`!n. sndcart(vec n) = vec n`, + SIMP_TAC[vec; sndcart; LAMBDA_BETA; CART_EQ; DIMINDEX_FINITE_SUM; + ARITH_RULE `x <= a ==> x <= a + b:num`; + ARITH_RULE `x <= b ==> x + a <= a + b:num`]);; + +let SNDCART_ADD = prove + (`!x:real^(M,N)finite_sum y. sndcart(x + y) = sndcart(x) + sndcart(y)`, + REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);; + +let SNDCART_CMUL = prove + (`!x:real^(M,N)finite_sum c. sndcart(c % x) = c % sndcart(x)`, + REWRITE_TAC[REWRITE_RULE[linear] LINEAR_SNDCART]);; + +let SNDCART_NEG = prove + (`!x:real^(M,N)finite_sum. --(sndcart x) = sndcart(--x)`, + ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN + REWRITE_TAC[SNDCART_CMUL]);; + +let SNDCART_SUB = prove + (`!x:real^(M,N)finite_sum y. sndcart(x - y) = sndcart(x) - sndcart(y)`, + REWRITE_TAC[VECTOR_SUB; SNDCART_NEG; SNDCART_ADD]);; + +let SNDCART_VSUM = prove + (`!k x. FINITE k ==> (sndcart(vsum k x) = vsum k (\i. sndcart(x i)))`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_RULES; SNDCART_ADD; SNDCART_VEC]);; + +let PASTECART_VEC = prove + (`!n. pastecart (vec n) (vec n) = vec n`, + REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC; + FSTCART_PASTECART; SNDCART_PASTECART]);; + +let PASTECART_ADD = prove + (`!x1 y1 x2:real^M y2:real^N. + pastecart x1 y1 + pastecart x2 y2 = pastecart (x1 + x2) (y1 + y2)`, + REWRITE_TAC[PASTECART_EQ; FSTCART_ADD; SNDCART_ADD; + FSTCART_PASTECART; SNDCART_PASTECART]);; + +let PASTECART_CMUL = prove + (`!x1 y1 c. pastecart (c % x1) (c % y1) = c % pastecart x1 y1`, + REWRITE_TAC[PASTECART_EQ; FSTCART_CMUL; SNDCART_CMUL; + FSTCART_PASTECART; SNDCART_PASTECART]);; + +let PASTECART_NEG = prove + (`!x:real^M y:real^N. pastecart (--x) (--y) = --(pastecart x y)`, + ONCE_REWRITE_TAC[VECTOR_ARITH `--x = --(&1) % x`] THEN + REWRITE_TAC[PASTECART_CMUL]);; + +let PASTECART_SUB = prove + (`!x1 y1 x2:real^M y2:real^N. + pastecart x1 y1 - pastecart x2 y2 = pastecart (x1 - x2) (y1 - y2)`, + REWRITE_TAC[VECTOR_SUB; GSYM PASTECART_NEG; PASTECART_ADD]);; + +let PASTECART_VSUM = prove + (`!k x y. FINITE k ==> (pastecart (vsum k x) (vsum k y) = + vsum k (\i. pastecart (x i) (y i)))`, + SIMP_TAC[PASTECART_EQ; FSTCART_VSUM; SNDCART_VSUM; + FSTCART_PASTECART; SNDCART_PASTECART; ETA_AX]);; + +let PASTECART_EQ_VEC = prove + (`!x y n. pastecart x y = vec n <=> x = vec n /\ y = vec n`, + REWRITE_TAC[PASTECART_EQ; FSTCART_VEC; SNDCART_VEC; + FSTCART_PASTECART; SNDCART_PASTECART]);; + +let NORM_FSTCART = prove + (`!x. norm(fstcart x) <= norm x`, + GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN + SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN + SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO; + SUM_ADD_SPLIT; REAL_LE_ADDR; SUM_POS_LE; FINITE_NUMSEG; + REAL_LE_SQUARE; ARITH_RULE `x <= a ==> x <= a + b:num`; + ARITH_RULE `~(d = 0) ==> 1 <= d + 1`]);; + +let DIST_FSTCART = prove + (`!x y. dist(fstcart x,fstcart y) <= dist(x,y)`, + REWRITE_TAC[dist; GSYM FSTCART_SUB; NORM_FSTCART]);; + +let NORM_SNDCART = prove + (`!x. norm(sndcart x) <= norm x`, + GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM PASTECART_FST_SND] THEN + SIMP_TAC[SQRT_MONO_LE_EQ; DOT_POS_LE; vector_norm] THEN + SIMP_TAC[pastecart; dot; DIMINDEX_FINITE_SUM; LAMBDA_BETA; DIMINDEX_NONZERO; + SUM_ADD_SPLIT; ARITH_RULE `x <= a ==> x <= a + b:num`; + ARITH_RULE `~(d = 0) ==> 1 <= d + 1`] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN + SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN + SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; SUM_POS_LE; FINITE_NUMSEG; + REAL_LE_ADDL; REAL_LE_SQUARE]);; + +let DIST_SNDCART = prove + (`!x y. dist(sndcart x,sndcart y) <= dist(x,y)`, + REWRITE_TAC[dist; GSYM SNDCART_SUB; NORM_SNDCART]);; + +let DOT_PASTECART = prove + (`!x1 x2 y1 y2. (pastecart x1 x2) dot (pastecart y1 y2) = + x1 dot y1 + x2 dot y2`, + SIMP_TAC[pastecart; dot; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN + SIMP_TAC[SUM_ADD_SPLIT; ARITH_RULE `~(d = 0) ==> 1 <= d + 1`; + DIMINDEX_NONZERO; REAL_LE_LADD] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[NUMSEG_OFFSET_IMAGE] THEN + SIMP_TAC[SUM_IMAGE; FINITE_NUMSEG; EQ_ADD_RCANCEL; o_DEF; ADD_SUB] THEN + SIMP_TAC[ARITH_RULE `1 <= x ==> ~(x + a <= a)`; REAL_LE_REFL]);; + +let SQNORM_PASTECART = prove + (`!x y. norm(pastecart x y) pow 2 = norm(x) pow 2 + norm(y) pow 2`, + REWRITE_TAC[NORM_POW_2; DOT_PASTECART]);; + +let NORM_PASTECART = prove + (`!x y. norm(pastecart x y) = sqrt(norm(x) pow 2 + norm(y) pow 2)`, + REWRITE_TAC[NORM_EQ_SQUARE] THEN + SIMP_TAC[SQRT_POS_LE; SQRT_POW_2; REAL_LE_ADD; REAL_LE_POW_2] THEN + REWRITE_TAC[DOT_PASTECART; NORM_POW_2]);; + +let NORM_PASTECART_LE = prove + (`!x y. norm(pastecart x y) <= norm(x) + norm(y)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC TRIANGLE_LEMMA THEN + REWRITE_TAC[NORM_POS_LE; NORM_POW_2; DOT_PASTECART; REAL_LE_REFL]);; + +let NORM_LE_PASTECART = prove + (`!x:real^M y:real^N. + norm(x) <= norm(pastecart x y) /\ + norm(y) <= norm(pastecart x y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[NORM_PASTECART] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_RSQRT THEN + REWRITE_TAC[REAL_LE_ADDL; REAL_LE_ADDR; REAL_LE_POW_2]);; + +let NORM_PASTECART_0 = prove + (`(!x. norm(pastecart x (vec 0)) = norm x) /\ + (!y. norm(pastecart (vec 0) y) = norm y)`, + REWRITE_TAC[NORM_EQ_SQUARE; NORM_POW_2; NORM_POS_LE] THEN + REWRITE_TAC[DOT_PASTECART; DOT_LZERO; REAL_ADD_LID; REAL_ADD_RID]);; + +let DIST_PASTECART_CANCEL = prove + (`(!x x' y. dist(pastecart x y,pastecart x' y) = dist(x,x')) /\ + (!x y y'. dist(pastecart x y,pastecart x y') = dist(y,y'))`, + REWRITE_TAC[dist; PASTECART_SUB; VECTOR_SUB_REFL; NORM_PASTECART_0]);; + +let LINEAR_PASTECART = prove + (`!f:real^M->real^N g:real^M->real^P. + linear f /\ linear g ==> linear (\x. pastecart (f x) (g x))`, + SIMP_TAC[linear; PASTECART_ADD; GSYM PASTECART_CMUL]);; + +(* ------------------------------------------------------------------------- *) +(* A bit of linear algebra. *) +(* ------------------------------------------------------------------------- *) + +let subspace = new_definition + `subspace s <=> + vec(0) IN s /\ + (!x y. x IN s /\ y IN s ==> (x + y) IN s) /\ + (!c x. x IN s ==> (c % x) IN s)`;; + +let span = new_definition + `span s = subspace hull s`;; + +let dependent = new_definition + `dependent s <=> ?a. a IN s /\ a IN span(s DELETE a)`;; + +let independent = new_definition + `independent s <=> ~(dependent s)`;; + +(* ------------------------------------------------------------------------- *) +(* Closure properties of subspaces. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_UNIV = prove + (`subspace(UNIV:real^N->bool)`, + REWRITE_TAC[subspace; IN_UNIV]);; + +let SUBSPACE_IMP_NONEMPTY = prove + (`!s. subspace s ==> ~(s = {})`, + REWRITE_TAC[subspace] THEN SET_TAC[]);; + +let SUBSPACE_0 = prove + (`subspace s ==> vec(0) IN s`, + SIMP_TAC[subspace]);; + +let SUBSPACE_ADD = prove + (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x + y) IN s`, + SIMP_TAC[subspace]);; + +let SUBSPACE_MUL = prove + (`!x c s. subspace s /\ x IN s ==> (c % x) IN s`, + SIMP_TAC[subspace]);; + +let SUBSPACE_NEG = prove + (`!x s. subspace s /\ x IN s ==> (--x) IN s`, + SIMP_TAC[VECTOR_ARITH `--x = --(&1) % x`; SUBSPACE_MUL]);; + +let SUBSPACE_SUB = prove + (`!x y s. subspace s /\ x IN s /\ y IN s ==> (x - y) IN s`, + SIMP_TAC[VECTOR_SUB; SUBSPACE_ADD; SUBSPACE_NEG]);; + +let SUBSPACE_VSUM = prove + (`!s f t. subspace s /\ FINITE t /\ (!x. x IN t ==> f(x) IN s) + ==> (vsum t f) IN s`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[VSUM_CLAUSES; SUBSPACE_0; IN_INSERT; SUBSPACE_ADD]);; + +let SUBSPACE_LINEAR_IMAGE = prove + (`!f s. linear f /\ subspace s ==> subspace(IMAGE f s)`, + REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN + MESON_TAC[linear; LINEAR_0]);; + +let SUBSPACE_LINEAR_PREIMAGE = prove + (`!f s. linear f /\ subspace s ==> subspace {x | f(x) IN s}`, + REWRITE_TAC[subspace; IN_ELIM_THM] THEN + MESON_TAC[linear; LINEAR_0]);; + +let SUBSPACE_TRIVIAL = prove + (`subspace {vec 0}`, + SIMP_TAC[subspace; IN_SING] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let SUBSPACE_INTER = prove + (`!s t. subspace s /\ subspace t ==> subspace (s INTER t)`, + REWRITE_TAC[subspace; IN_INTER] THEN MESON_TAC[]);; + +let SUBSPACE_INTERS = prove + (`!f. (!s. s IN f ==> subspace s) ==> subspace(INTERS f)`, + SIMP_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM; IN_INTERS]);; + +let LINEAR_INJECTIVE_0_SUBSPACE = prove + (`!f:real^M->real^N s. + linear f /\ subspace s + ==> ((!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) <=> + (!x. x IN s /\ f x = vec 0 ==> x = vec 0))`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[GSYM LINEAR_SUB] THEN + ASM_MESON_TAC[VECTOR_SUB_RZERO; SUBSPACE_SUB; SUBSPACE_0]);; + +let SUBSPACE_UNION_CHAIN = prove + (`!s t:real^N->bool. + subspace s /\ subspace t /\ subspace(s UNION t) + ==> s SUBSET t \/ t SUBSET s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE + `s SUBSET t \/ t SUBSET s <=> + ~(?x y. x IN s /\ ~(x IN t) /\ y IN t /\ ~(y IN s))`] THEN + STRIP_TAC THEN SUBGOAL_THEN `(x + y:real^N) IN s UNION t` MP_TAC THENL + [MATCH_MP_TAC SUBSPACE_ADD THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN + ASM_MESON_TAC[SUBSPACE_SUB; VECTOR_ARITH + `(x + y) - x:real^N = y /\ (x + y) - y = x`]]);; + +let SUBSPACE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t ==> subspace(s PCROSS t)`, + REWRITE_TAC[subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_PCROSS; GSYM PASTECART_CMUL; PASTECART_ADD] THEN + REWRITE_TAC[GSYM PASTECART_VEC; PASTECART_IN_PCROSS] THEN SIMP_TAC[]);; + +let SUBSPACE_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + subspace(s PCROSS t) <=> subspace s /\ subspace t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_MESON_TAC[PCROSS_EMPTY; SUBSPACE_IMP_NONEMPTY]; ALL_TAC] THEN + EQ_TAC THEN REWRITE_TAC[SUBSPACE_PCROSS] THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART]; + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`] SUBSPACE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART]] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; PASTECART_IN_PCROSS; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_SPAN = prove + (`!s. span(span s) = span s`, + REWRITE_TAC[span; HULL_HULL]);; + +let SPAN_MONO = prove + (`!s t. s SUBSET t ==> span s SUBSET span t`, + REWRITE_TAC[span; HULL_MONO]);; + +let SUBSPACE_SPAN = prove + (`!s. subspace(span s)`, + GEN_TAC THEN REWRITE_TAC[span] THEN MATCH_MP_TAC P_HULL THEN + SIMP_TAC[subspace; IN_INTERS]);; + +let SPAN_CLAUSES = prove + (`(!a s. a IN s ==> a IN span s) /\ + (vec(0) IN span s) /\ + (!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s) /\ + (!x c s. x IN span s ==> (c % x) IN span s)`, + MESON_TAC[span; HULL_SUBSET; SUBSET; SUBSPACE_SPAN; subspace]);; + +let SPAN_INDUCT = prove + (`!s h. (!x. x IN s ==> x IN h) /\ subspace h ==> !x. x IN span(s) ==> h(x)`, + REWRITE_TAC[span] THEN MESON_TAC[SUBSET; HULL_MINIMAL; IN]);; + +let SPAN_EMPTY = prove + (`span {} = {vec 0}`, + REWRITE_TAC[span] THEN MATCH_MP_TAC HULL_UNIQUE THEN + SIMP_TAC[subspace; SUBSET; IN_SING; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let INDEPENDENT_EMPTY = prove + (`independent {}`, + REWRITE_TAC[independent; dependent; NOT_IN_EMPTY]);; + +let INDEPENDENT_NONZERO = prove + (`!s. independent s ==> ~(vec 0 IN s)`, + REWRITE_TAC[independent; dependent] THEN MESON_TAC[SPAN_CLAUSES]);; + +let INDEPENDENT_MONO = prove + (`!s t. independent t /\ s SUBSET t ==> independent s`, + REWRITE_TAC[independent; dependent] THEN + ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);; + +let DEPENDENT_MONO = prove + (`!s t:real^N->bool. dependent s /\ s SUBSET t ==> dependent t`, + ONCE_REWRITE_TAC[TAUT `p /\ q ==> r <=> ~r /\ q ==> ~p`] THEN + REWRITE_TAC[GSYM independent; INDEPENDENT_MONO]);; + +let SPAN_SUBSPACE = prove + (`!b s. b SUBSET s /\ s SUBSET (span b) /\ subspace s ==> (span b = s)`, + MESON_TAC[SUBSET_ANTISYM; span; HULL_MINIMAL]);; + +let SPAN_INDUCT_ALT = prove + (`!s h. h(vec 0) /\ + (!c x y. x IN s /\ h(y) ==> h(c % x + y)) + ==> !x:real^N. x IN span(s) ==> h(x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o prove_inductive_relations_exist o concl) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!x:real^N. x IN span(s) ==> g(x)` + (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN + REWRITE_TAC[IN; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REPEAT CONJ_TAC THEN TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_MESON_TAC[IN; VECTOR_ADD_LID; VECTOR_ADD_ASSOC; VECTOR_ADD_SYM; + VECTOR_MUL_LID; VECTOR_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Individual closure properties. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_SUPERSET = prove + (`!x. x IN s ==> x IN span s`, + MESON_TAC[SPAN_CLAUSES]);; + +let SPAN_INC = prove + (`!s. s SUBSET span s`, + REWRITE_TAC[SUBSET; SPAN_SUPERSET]);; + +let SPAN_UNION_SUBSET = prove + (`!s t. span s UNION span t SUBSET span(s UNION t)`, + REWRITE_TAC[span; HULL_UNION_SUBSET]);; + +let SPAN_UNIV = prove + (`span(:real^N) = (:real^N)`, + SIMP_TAC[SPAN_INC; SET_RULE `UNIV SUBSET s ==> s = UNIV`]);; + +let SPAN_0 = prove + (`vec(0) IN span s`, + MESON_TAC[SUBSPACE_SPAN; SUBSPACE_0]);; + +let SPAN_ADD = prove + (`!x y s. x IN span s /\ y IN span s ==> (x + y) IN span s`, + MESON_TAC[SUBSPACE_SPAN; SUBSPACE_ADD]);; + +let SPAN_MUL = prove + (`!x c s. x IN span s ==> (c % x) IN span s`, + MESON_TAC[SUBSPACE_SPAN; SUBSPACE_MUL]);; + +let SPAN_MUL_EQ = prove + (`!x:real^N c s. ~(c = &0) ==> ((c % x) IN span s <=> x IN span s)`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN ASM_SIMP_TAC[SPAN_MUL] THEN + SUBGOAL_THEN `(inv(c) % c % x:real^N) IN span s` MP_TAC THENL + [ASM_SIMP_TAC[SPAN_MUL]; + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]]);; + +let SPAN_NEG = prove + (`!x s. x IN span s ==> (--x) IN span s`, + MESON_TAC[SUBSPACE_SPAN; SUBSPACE_NEG]);; + +let SPAN_NEG_EQ = prove + (`!x s. --x IN span s <=> x IN span s`, + MESON_TAC[SPAN_NEG; VECTOR_NEG_NEG]);; + +let SPAN_SUB = prove + (`!x y s. x IN span s /\ y IN span s ==> (x - y) IN span s`, + MESON_TAC[SUBSPACE_SPAN; SUBSPACE_SUB]);; + +let SPAN_VSUM = prove + (`!s f t. FINITE t /\ (!x. x IN t ==> f(x) IN span(s)) + ==> (vsum t f) IN span(s)`, + MESON_TAC[SUBSPACE_SPAN; SUBSPACE_VSUM]);; + +let SPAN_ADD_EQ = prove + (`!s x y. x IN span s ==> ((x + y) IN span s <=> y IN span s)`, + MESON_TAC[SPAN_ADD; SPAN_SUB; VECTOR_ARITH `(x + y) - x:real^N = y`]);; + +let SPAN_EQ_SELF = prove + (`!s. span s = s <=> subspace s`, + GEN_TAC THEN EQ_TAC THENL [MESON_TAC[SUBSPACE_SPAN]; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC SPAN_SUBSPACE THEN + ASM_REWRITE_TAC[SUBSET_REFL; SPAN_INC]);; + +let SPAN_OF_SUBSPACE = prove + (`!s:real^N->bool. subspace s ==> span s = s`, + REWRITE_TAC[SPAN_EQ_SELF]);; + +let SPAN_SUBSET_SUBSPACE = prove + (`!s t:real^N->bool. s SUBSET t /\ subspace t ==> span s SUBSET t`, + MESON_TAC[SPAN_MONO; SPAN_EQ_SELF]);; + +let SUBSPACE_TRANSLATION_SELF = prove + (`!s a. subspace s /\ a IN s ==> IMAGE (\x. a + x) s = s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + FIRST_ASSUM(SUBST1_TAC o SYM o GEN_REWRITE_RULE I [GSYM SPAN_EQ_SELF]) THEN + ASM_SIMP_TAC[SPAN_ADD_EQ; SPAN_CLAUSES] THEN + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]);; + +let SUBSPACE_TRANSLATION_SELF_EQ = prove + (`!s a:real^N. subspace s ==> (IMAGE (\x. a + x) s = s <=> a IN s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[SUBSPACE_TRANSLATION_SELF] THEN + DISCH_THEN(MP_TAC o AP_TERM `\s. (a:real^N) IN s`) THEN + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `vec 0:real^N` THEN + ASM_MESON_TAC[subspace; VECTOR_ADD_RID]);; + +let SUBSPACE_SUMS = prove + (`!s t. subspace s /\ subspace t + ==> subspace {x + y | x IN s /\ y IN t}`, + REWRITE_TAC[subspace; FORALL_IN_GSPEC; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[VECTOR_ADD_LID]; + ONCE_REWRITE_TAC[VECTOR_ARITH + `(x + y) + (x' + y'):real^N = (x + x') + (y + y')`] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[VECTOR_ADD_LDISTRIB] THEN ASM_MESON_TAC[]]);; + +let SPAN_UNION = prove + (`!s t. span(s UNION t) = {x + y:real^N | x IN span s /\ y IN span t}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN + SIMP_TAC[SUBSPACE_SUMS; SUBSPACE_SPAN] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_RID]; + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN + ASM_SIMP_TAC[SPAN_SUPERSET; SPAN_0; VECTOR_ADD_LID]]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_ADD THEN + ASM_MESON_TAC[SPAN_MONO; SUBSET_UNION; SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Mapping under linear image. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. linear f ==> (span(IMAGE f s) = IMAGE f (span s))`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN + ASM_SIMP_TAC[SUBSPACE_SPAN; SUBSPACE_LINEAR_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE] THEN + MESON_TAC[SPAN_SUPERSET; SUBSET]; + SPEC_TAC(`x:real^N`,`x:real^N`) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[SET_RULE `(\x. f x IN span(s)) = {x | f(x) IN span s}`] THEN + ASM_SIMP_TAC[SUBSPACE_LINEAR_PREIMAGE; SUBSPACE_SPAN] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MESON_TAC[SPAN_SUPERSET; SUBSET; IN_IMAGE]]);; + +let DEPENDENT_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (dependent(IMAGE f s) <=> dependent s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^M` THEN + ASM_CASES_TAC `(a:real^M) IN s` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(f:real^M->real^N) a IN span(IMAGE f (s DELETE a))` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN AP_TERM_TAC THEN ASM SET_TAC[]; + ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN ASM SET_TAC[]]);; + +let DEPENDENT_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + dependent(s) + ==> dependent(IMAGE f s)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dependent; EXISTS_IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^M` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) s DELETE f a = IMAGE f (s DELETE a)` + (fun th -> ASM_SIMP_TAC[FUN_IN_IMAGE; SPAN_LINEAR_IMAGE; th]) THEN + ASM SET_TAC[]);; + +let INDEPENDENT_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (independent(IMAGE f s) <=> independent s)`, + REWRITE_TAC[independent; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN + REWRITE_TAC[DEPENDENT_LINEAR_IMAGE_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* The key breakdown property. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_BREAKDOWN = prove + (`!b s a:real^N. + b IN s /\ a IN span s ==> ?k. (a - k % b) IN span(s DELETE b)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[subspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `a:real^N = b`; ALL_TAC] THEN + ASM_MESON_TAC[SPAN_CLAUSES; IN_DELETE; VECTOR_ARITH + `(a - &1 % a = vec 0) /\ (a - &0 % b = a) /\ + ((x + y) - (k1 + k2) % b = (x - k1 % b) + (y - k2 % b)) /\ + (c % x - (c * k) % y = c % (x - k % y))`]);; + +let SPAN_BREAKDOWN_EQ = prove + (`!a:real^N s. (x IN span(a INSERT s) <=> (?k. (x - k % a) IN span s))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o CONJ(SET_RULE `(a:real^N) IN (a INSERT s)`)) THEN + DISCH_THEN(MP_TAC o MATCH_MP SPAN_BREAKDOWN) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN + SPEC_TAC(`x - k % a:real^N`,`y:real^N`) THEN + REWRITE_TAC[GSYM SUBSET] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN + SUBST1_TAC(VECTOR_ARITH `x = (x - k % a) + k % a:real^N`) THEN + MATCH_MP_TAC SPAN_ADD THEN + ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; SPAN_CLAUSES]]);; + +let SPAN_INSERT_0 = prove + (`!s. span(vec 0 INSERT s) = span s`, + SIMP_TAC[EXTENSION; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]);; + +let SPAN_SING = prove + (`!a. span {a} = {u % a | u IN (:real)}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN + REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ]);; + +let SPAN_2 = prove + (`!a b. span {a,b} = {u % a + v % b | u IN (:real) /\ v IN (:real)}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN + REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN + REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);; + +let SPAN_3 = prove + (`!a b c. span {a,b,c} = + {u % a + v % b + w % c | u IN (:real) /\ v IN (:real) /\ w IN (:real)}`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; SPAN_BREAKDOWN_EQ; SPAN_EMPTY] THEN + REWRITE_TAC[IN_UNIV; IN_SING; VECTOR_SUB_EQ] THEN + REWRITE_TAC[VECTOR_ARITH `x - y:real^N = z <=> x = y + z`]);; + +(* ------------------------------------------------------------------------- *) +(* Hence some "reversal" results. *) +(* ------------------------------------------------------------------------- *) + +let IN_SPAN_INSERT = prove + (`!a b:real^N s. + a IN span(b INSERT s) /\ ~(a IN span s) ==> b IN span(a INSERT s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`b:real^N`; `(b:real^N) INSERT s`; `a:real^N`] + SPAN_BREAKDOWN) THEN ASM_REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` MP_TAC) THEN ASM_CASES_TAC `k = &0` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a - &0 % b = a`; DELETE_INSERT] THENL + [ASM_MESON_TAC[SPAN_MONO; SUBSET; DELETE_SUBSET]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `inv(k)` o MATCH_MP SPAN_MUL) THEN + ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN + DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH + `b:real^N = inv(k) % a - (inv(k) % a - &1 % b)`) THEN + MATCH_MP_TAC SPAN_SUB THEN + ASM_MESON_TAC[SPAN_CLAUSES; IN_INSERT; SUBSET; IN_DELETE; SPAN_MONO]);; + +let IN_SPAN_DELETE = prove + (`!a b s. + a IN span s /\ ~(a IN span (s DELETE b)) + ==> b IN span (a INSERT (s DELETE b))`, + ASM_MESON_TAC[IN_SPAN_INSERT; SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);; + +let EQ_SPAN_INSERT_EQ = prove + (`!s x y:real^N. (x - y) IN span s ==> span(x INSERT s) = span(y INSERT s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_BREAKDOWN_EQ; EXTENSION] THEN + ASM_MESON_TAC[SPAN_ADD; SPAN_SUB; SPAN_MUL; + VECTOR_ARITH `(z - k % y) - k % (x - y) = z - k % x`; + VECTOR_ARITH `(z - k % x) + k % (x - y) = z - k % y`]);; + +(* ------------------------------------------------------------------------- *) +(* Transitivity property. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_TRANS = prove + (`!x y:real^N s. x IN span(s) /\ y IN span(x INSERT s) ==> y IN span(s)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real^N`; `(x:real^N) INSERT s`; `y:real^N`] + SPAN_BREAKDOWN) THEN + ASM_REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + SUBST1_TAC(VECTOR_ARITH `y:real^N = (y - k % x) + k % x`) THEN + MATCH_MP_TAC SPAN_ADD THEN ASM_SIMP_TAC[SPAN_MUL] THEN + ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_INSERT; IN_DELETE]);; + +(* ------------------------------------------------------------------------- *) +(* An explicit expansion is sometimes needed. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_EXPLICIT = prove + (`!(p:real^N -> bool). + span p = + {y | ?s u. FINITE s /\ s SUBSET p /\ + vsum s (\v. u v % v) = y}`, + GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SPAN_SUPERSET; SPAN_MUL]] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + MATCH_MP_TAC SPAN_INDUCT_ALT THEN CONJ_TAC THENL + [EXISTS_TAC `{}:real^N->bool` THEN + REWRITE_TAC[FINITE_RULES; VSUM_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`; `y:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`] THEN + STRIP_TAC THEN EXISTS_TAC `(x:real^N) INSERT s` THEN + EXISTS_TAC `\y. if y = x then (if x IN s then (u:real^N->real) y + c else c) + else u y` THEN + ASM_SIMP_TAC[FINITE_INSERT; IN_INSERT; VSUM_CLAUSES] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `x IN s ==> s = x INSERT (s DELETE x)`)) THEN + ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; FINITE_DELETE; IN_DELETE] THEN + MATCH_MP_TAC(VECTOR_ARITH + `y = z ==> (c + d) % x + y = d % x + c % x + z`); + AP_TERM_TAC] THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_MESON_TAC[IN_DELETE]);; + +let DEPENDENT_EXPLICIT = prove + (`!p. dependent (p:real^N -> bool) <=> + ?s u. FINITE s /\ s SUBSET p /\ + (?v. v IN s /\ ~(u v = &0)) /\ + vsum s (\v. u v % v) = vec 0`, + GEN_TAC THEN REWRITE_TAC[dependent; SPAN_EXPLICIT; IN_ELIM_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`a:real^N`; `s:real^N->bool`; `u:real^N->real`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(a:real^N) INSERT s`; + `\y. if y = a then -- &1 else (u:real^N->real) y`; + `a:real^N`] THEN + ASM_REWRITE_TAC[IN_INSERT; INSERT_SUBSET; FINITE_INSERT] THEN + CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC REAL_RAT_REDUCE_CONV] THEN + ASM_SIMP_TAC[VSUM_CLAUSES] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH `-- &1 % a + s = vec 0 <=> a = s`] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC VSUM_EQ THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `u:real^N->real`; `a:real^N`] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`a:real^N`; `s DELETE (a:real^N)`; + `\i. --((u:real^N->real) i) / (u a)`] THEN + ASM_SIMP_TAC[VSUM_DELETE; FINITE_DELETE] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LNEG; GSYM VECTOR_MUL_ASSOC; VSUM_LMUL; + VSUM_NEG; VECTOR_MUL_RNEG; VECTOR_MUL_RZERO] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV] THEN VECTOR_ARITH_TAC]);; + +let DEPENDENT_FINITE = prove + (`!s:real^N->bool. + FINITE s + ==> (dependent s <=> ?u. (?v. v IN s /\ ~(u v = &0)) /\ + vsum s (\v. u(v) % v) = vec 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[DEPENDENT_EXPLICIT] THEN EQ_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + EXISTS_TAC `\v:real^N. if v IN t then u(v) else &0` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[VECTOR_MUL_LZERO; GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]; + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN + ASM_REWRITE_TAC[SUBSET_REFL]]);; + +let SPAN_FINITE = prove + (`!s:real^N->bool. + FINITE s ==> span s = {y | ?u. vsum s (\v. u v % v) = y}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + EXISTS_TAC `\x:real^N. if x IN t then u(x) else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; VECTOR_MUL_LZERO] THEN + ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> {x | x IN s /\ x IN t} = t`]; + X_GEN_TAC `u:real^N->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MAP_EVERY EXISTS_TAC [`s:real^N->bool`; `u:real^N->real`] THEN + ASM_REWRITE_TAC[SUBSET_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Standard bases are a spanning set, and obviously finite. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_STDBASIS = prove + (`span {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = UNIV`, + REWRITE_TAC[EXTENSION; IN_UNIV] THEN X_GEN_TAC `x:real^N` THEN + GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +let HAS_SIZE_STDBASIS = prove + (`{basis i :real^N | 1 <= i /\ i <= dimindex(:N)} HAS_SIZE + dimindex(:N)`, + ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + REWRITE_TAC[GSYM numseg; HAS_SIZE_NUMSEG_1; IN_NUMSEG] THEN + MESON_TAC[BASIS_INJ]);; + +let FINITE_STDBASIS = prove + (`FINITE {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`, + MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);; + +let CARD_STDBASIS = prove + (`CARD {basis i :real^N | 1 <= i /\ i <= dimindex(:N)} = + dimindex(:N)`, + MESON_TAC[HAS_SIZE_STDBASIS; HAS_SIZE]);; + +let IN_SPAN_IMAGE_BASIS = prove + (`!x:real^N s. + x IN span(IMAGE basis s) <=> + !i. 1 <= i /\ i <= dimindex(:N) /\ ~(i IN s) ==> x$i = &0`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [SPEC_TAC(`x:real^N`,`x:real^N`) THEN MATCH_MP_TAC SPAN_INDUCT THEN + SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN + SIMP_TAC[FORALL_IN_IMAGE; BASIS_COMPONENT] THEN MESON_TAC[]; + DISCH_TAC THEN REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM] THEN + EXISTS_TAC `(IMAGE basis ((1..dimindex(:N)) INTER s)):real^N->bool` THEN + SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + EXISTS_TAC `\v:real^N. x dot v` THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_INTER; IN_NUMSEG] THEN MESON_TAC[BASIS_INJ]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]] THEN + REWRITE_TAC[o_DEF] THEN + SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_MUL_COMPONENT; + BASIS_COMPONENT] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + ONCE_REWRITE_TAC[MESON[] + `(if x = y then p else q) = (if y = x then p else q)`] THEN + SIMP_TAC[SUM_DELTA; REAL_MUL_RZERO; IN_INTER; IN_NUMSEG; DOT_BASIS] THEN + ASM_MESON_TAC[REAL_MUL_RID]]);; + +let INDEPENDENT_STDBASIS = prove + (`independent {basis i :real^N | 1 <= i /\ i <= dimindex(:N)}`, + REWRITE_TAC[independent; dependent] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN + `IMAGE basis {i | 1 <= i /\ i <= dimindex(:N)} DELETE + (basis k:real^N) = + IMAGE basis ({i | 1 <= i /\ i <= dimindex(:N)} DELETE k)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_ELIM_THM] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[BASIS_INJ]; + ALL_TAC] THEN + REWRITE_TAC[IN_SPAN_IMAGE_BASIS] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + ASM_SIMP_TAC[IN_DELETE; BASIS_COMPONENT; REAL_OF_NUM_EQ; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* This is useful for building a basis step-by-step. *) +(* ------------------------------------------------------------------------- *) + +let INDEPENDENT_INSERT = prove + (`!a:real^N s. independent(a INSERT s) <=> + if a IN s then independent s + else independent s /\ ~(a IN span s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THEN + ASM_SIMP_TAC[SET_RULE `x IN s ==> (x INSERT s = s)`] THEN + EQ_TAC THENL + [DISCH_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET; IN_INSERT]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[independent; dependent] THEN + ASM_MESON_TAC[IN_INSERT; SET_RULE + `~(a IN s) ==> ((a INSERT s) DELETE a = s)`]]; + ALL_TAC] THEN + REWRITE_TAC[independent; dependent; NOT_EXISTS_THM] THEN + STRIP_TAC THEN X_GEN_TAC `b:real^N` THEN + REWRITE_TAC[IN_INSERT] THEN ASM_CASES_TAC `b:real^N = a` THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> ((a INSERT s) DELETE a = s)`] THEN + ASM_SIMP_TAC[SET_RULE + `~(a IN s) /\ ~(b = a) + ==> ((a INSERT s) DELETE b = a INSERT (s DELETE b))`] THEN + ASM_MESON_TAC[IN_SPAN_INSERT; SET_RULE + `b IN s ==> (b INSERT (s DELETE b) = s)`]);; + +(* ------------------------------------------------------------------------- *) +(* The degenerate case of the Exchange Lemma. *) +(* ------------------------------------------------------------------------- *) + +let SPANNING_SUBSET_INDEPENDENT = prove + (`!s t:real^N->bool. + t SUBSET s /\ independent s /\ s SUBSET span(t) ==> (s = t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN + REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SPAN_MONO; SUBSET; IN_DELETE]);; + +(* ------------------------------------------------------------------------- *) +(* The general case of the Exchange Lemma, the key to what follows. *) +(* ------------------------------------------------------------------------- *) + +let EXCHANGE_LEMMA = prove + (`!s t:real^N->bool. + FINITE t /\ independent s /\ s SUBSET span t + ==> ?t'. t' HAS_SIZE (CARD t) /\ + s SUBSET t' /\ t' SUBSET (s UNION t) /\ s SUBSET (span t')`, + REPEAT GEN_TAC THEN + WF_INDUCT_TAC `CARD(t DIFF s :real^N->bool)` THEN + ASM_CASES_TAC `(s:real^N->bool) SUBSET t` THENL + [ASM_MESON_TAC[HAS_SIZE; SUBSET_UNION]; ALL_TAC] THEN + ASM_CASES_TAC `t SUBSET (s:real^N->bool)` THENL + [ASM_MESON_TAC[SPANNING_SUBSET_INDEPENDENT; HAS_SIZE]; ALL_TAC] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[SUBSET] o check(is_neg o concl)) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `s SUBSET span(t DELETE (b:real^N))` THENL + [FIRST_X_ASSUM(MP_TAC o + SPECL [`t DELETE (b:real^N)`; `s:real^N->bool`]) THEN + ASM_REWRITE_TAC[SET_RULE `s DELETE a DIFF t = (s DIFF t) DELETE a`] THEN + ASM_SIMP_TAC[CARD_DELETE; FINITE_DIFF; IN_DIFF; FINITE_DELETE; + CARD_EQ_0; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + ANTS_TAC THENL + [UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(b:real^N) INSERT u` THEN + ASM_SIMP_TAC[SUBSET_INSERT; INSERT_SUBSET; IN_UNION] THEN CONJ_TAC THENL + [UNDISCH_TAC `(u:real^N->bool) HAS_SIZE CARD(t:real^N->bool) - 1` THEN + SIMP_TAC[HAS_SIZE; FINITE_RULES; CARD_CLAUSES] THEN STRIP_TAC THEN + COND_CASES_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_UNION; IN_DELETE]; ALL_TAC] THEN + ASM_MESON_TAC[ARITH_RULE `~(n = 0) ==> (SUC(n - 1) = n)`; + CARD_EQ_0; MEMBER_NOT_EMPTY]; + ALL_TAC] THEN + CONJ_TAC THENL + [UNDISCH_TAC `u SUBSET s UNION t DELETE (b:real^N)` THEN SET_TAC[]; + ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT]]; + ALL_TAC] THEN + UNDISCH_TAC `~(s SUBSET span (t DELETE (b:real^N)))` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [SUBSET] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `~(a:real^N = b)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~((a:real^N) IN t)` ASSUME_TAC THENL + [ASM_MESON_TAC[IN_DELETE; SPAN_CLAUSES]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(a:real^N) INSERT (t DELETE b)`; `s:real^N->bool`]) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[SET_RULE + `a IN s ==> ((a INSERT (t DELETE b) DIFF s) = (t DIFF s) DELETE b)`] THEN + ASM_SIMP_TAC[CARD_DELETE; FINITE_DELETE; FINITE_DIFF; IN_DIFF] THEN + ASM_SIMP_TAC[ARITH_RULE `n - 1 < n <=> ~(n = 0)`; CARD_EQ_0; + FINITE_DIFF] THEN + UNDISCH_TAC `~((s:real^N->bool) SUBSET t)` THEN ASM SET_TAC[]; + ALL_TAC] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_RULES; FINITE_DELETE] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `b:real^N` THEN + ASM_MESON_TAC[IN_SPAN_DELETE; SUBSET; SPAN_MONO; + SET_RULE `t SUBSET (b INSERT (a INSERT (t DELETE b)))`]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `u:real^N->bool` THEN + ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; CARD_DELETE; FINITE_DELETE; IN_DELETE; + ARITH_RULE `(SUC(n - 1) = n) <=> ~(n = 0)`; + CARD_EQ_0] THEN + UNDISCH_TAC `(b:real^N) IN t` THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* This implies corresponding size bounds. *) +(* ------------------------------------------------------------------------- *) + +let INDEPENDENT_SPAN_BOUND = prove + (`!s t. FINITE t /\ independent s /\ s SUBSET span(t) + ==> FINITE s /\ CARD(s) <= CARD(t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP EXCHANGE_LEMMA) THEN + ASM_MESON_TAC[HAS_SIZE; CARD_SUBSET; FINITE_SUBSET]);; + +let INDEPENDENT_BOUND = prove + (`!s:real^N->bool. + independent s ==> FINITE s /\ CARD(s) <= dimindex(:N)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM CARD_STDBASIS] THEN + MATCH_MP_TAC INDEPENDENT_SPAN_BOUND THEN + ASM_REWRITE_TAC[FINITE_STDBASIS; SPAN_STDBASIS; SUBSET_UNIV]);; + +let DEPENDENT_BIGGERSET = prove + (`!s:real^N->bool. (FINITE s ==> CARD(s) > dimindex(:N)) ==> dependent s`, + MP_TAC INDEPENDENT_BOUND THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);; + +let INDEPENDENT_IMP_FINITE = prove + (`!s:real^N->bool. independent s ==> FINITE s`, + SIMP_TAC[INDEPENDENT_BOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit formulation of independence. *) +(* ------------------------------------------------------------------------- *) + +let INDEPENDENT_EXPLICIT = prove + (`!b:real^N->bool. + independent b <=> + FINITE b /\ + !c. vsum b (\v. c(v) % v) = vec 0 ==> !v. v IN b ==> c(v) = &0`, + GEN_TAC THEN + ASM_CASES_TAC `FINITE(b:real^N->bool)` THENL + [ALL_TAC; ASM_MESON_TAC[INDEPENDENT_BOUND]] THEN + ASM_SIMP_TAC[independent; DEPENDENT_FINITE] THEN MESON_TAC[]);; + +let INDEPENDENT_SING = prove + (`!x. independent {x} <=> ~(x = vec 0)`, + REWRITE_TAC[INDEPENDENT_INSERT; NOT_IN_EMPTY; SPAN_EMPTY] THEN + REWRITE_TAC[INDEPENDENT_EMPTY] THEN SET_TAC[]);; + +let DEPENDENT_SING = prove + (`!x. dependent {x} <=> x = vec 0`, + MESON_TAC[independent; INDEPENDENT_SING]);; + +let DEPENDENT_2 = prove + (`!a b:real^N. + dependent {a,b} <=> + if a = b then a = vec 0 + else ?x y. x % a + y % b = vec 0 /\ ~(x = &0 /\ y = &0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[DEPENDENT_SING; SET_RULE `{x,x} = {x}`] THEN + SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; EXISTS_IN_INSERT] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`(u:real^N->real) a`; `(u:real^N->real) b`] THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN DISCH_TAC THEN EXISTS_TAC + `\v:real^N. if v = a then x else if v = b then y else z:real` THEN + ASM_MESON_TAC[]]);; + +let DEPENDENT_3 = prove + (`!a b c:real^N. + ~(a = b) /\ ~(a = c) /\ ~(b = c) + ==> (dependent {a,b,c} <=> + ?x y z. x % a + y % b + z % c = vec 0 /\ + ~(x = &0 /\ y = &0 /\ z = &0))`, + REPEAT STRIP_TAC THEN + SIMP_TAC[DEPENDENT_FINITE; VSUM_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN + ASM_REWRITE_TAC[IN_SING; NOT_IN_EMPTY; VECTOR_ADD_RID; IN_INSERT] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [X_GEN_TAC `u:real^N->real` THEN STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(u:real^N->real) a`; `(u:real^N->real) b`; `(u:real^N->real) c`]; + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`; `z:real`] THEN DISCH_TAC THEN + EXISTS_TAC + `\v:real^N. if v = a then x else if v = b then y else z:real`] THEN + ASM_MESON_TAC[]);; + +let INDEPENDENT_2 = prove + (`!a b:real^N x y. + independent{a,b} /\ ~(a = b) + ==> (x % a + y % b = vec 0 <=> x = &0 /\ y = &0)`, + SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_2] THEN + MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);; + +let INDEPENDENT_3 = prove + (`!a b c:real^N x y z. + independent{a,b,c} /\ ~(a = b) /\ ~(a = c) /\ ~(b = c) + ==> (x % a + y % b + z % c = vec 0 <=> x = &0 /\ y = &0 /\ z = &0)`, + SIMP_TAC[IMP_CONJ_ALT; independent; DEPENDENT_3] THEN + MESON_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we can create a maximal independent subset. *) +(* ------------------------------------------------------------------------- *) + +let MAXIMAL_INDEPENDENT_SUBSET_EXTEND = prove + (`!s v:real^N->bool. + s SUBSET v /\ independent s + ==> ?b. s SUBSET b /\ b SUBSET v /\ independent b /\ + v SUBSET (span b)`, + REPEAT GEN_TAC THEN + WF_INDUCT_TAC `dimindex(:N) - CARD(s:real^N->bool)` THEN + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `v SUBSET (span(s:real^N->bool))` THENL + [ASM_MESON_TAC[SUBSET_REFL]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N) INSERT s`) THEN + REWRITE_TAC[IMP_IMP] THEN ANTS_TAC THENL + [ALL_TAC; MESON_TAC[INSERT_SUBSET]] THEN + SUBGOAL_THEN `independent ((a:real^N) INSERT s)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[INDEPENDENT_INSERT; COND_ID]; ALL_TAC] THEN + ASM_REWRITE_TAC[INSERT_SUBSET] THEN + MATCH_MP_TAC(ARITH_RULE `(b = a + 1) /\ b <= n ==> n - b < n - a`) THEN + ASM_SIMP_TAC[CARD_CLAUSES; INDEPENDENT_BOUND] THEN + ASM_MESON_TAC[SPAN_SUPERSET; ADD1]);; + +let MAXIMAL_INDEPENDENT_SUBSET = prove + (`!v:real^N->bool. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b)`, + MP_TAC(SPEC `EMPTY:real^N->bool` MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN + REWRITE_TAC[EMPTY_SUBSET; INDEPENDENT_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* A kind of closed graph property for linearity. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_SUBSPACE_GRAPH = prove + (`!f:real^M->real^N. + linear f <=> subspace {pastecart x (f x) | x IN (:real^M)}`, + REWRITE_TAC[linear; subspace; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC; GSYM(SPEC `0` PASTECART_VEC); IN_UNIV] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_INJ; UNWIND_THM1; PASTECART_ADD; + GSYM PASTECART_CMUL] THEN + MESON_TAC[VECTOR_MUL_LZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Notion of dimension. *) +(* ------------------------------------------------------------------------- *) + +let dim = new_definition + `dim v = @n. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\ + b HAS_SIZE n`;; + +let BASIS_EXISTS = prove + (`!v. ?b. b SUBSET v /\ independent b /\ v SUBSET (span b) /\ + b HAS_SIZE (dim v)`, + GEN_TAC THEN REWRITE_TAC[dim] THEN CONV_TAC SELECT_CONV THEN + MESON_TAC[MAXIMAL_INDEPENDENT_SUBSET; HAS_SIZE; INDEPENDENT_BOUND]);; + +let BASIS_EXISTS_FINITE = prove + (`!v. ?b. FINITE b /\ + b SUBSET v /\ + independent b /\ + v SUBSET (span b) /\ + b HAS_SIZE (dim v)`, + MESON_TAC[BASIS_EXISTS; INDEPENDENT_IMP_FINITE]);; + +let BASIS_SUBSPACE_EXISTS = prove + (`!s:real^N->bool. + subspace s + ==> ?b. FINITE b /\ + b SUBSET s /\ + independent b /\ + span b = s /\ + b HAS_SIZE dim s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + ASM_MESON_TAC[SPAN_EQ_SELF; SPAN_MONO; INDEPENDENT_IMP_FINITE]);; + +(* ------------------------------------------------------------------------- *) +(* Consequences of independence or spanning for cardinality. *) +(* ------------------------------------------------------------------------- *) + +let INDEPENDENT_CARD_LE_DIM = prove + (`!v b:real^N->bool. + b SUBSET v /\ independent b ==> FINITE b /\ CARD(b) <= dim v`, + MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);; + +let SPAN_CARD_GE_DIM = prove + (`!v b:real^N->bool. + v SUBSET (span b) /\ FINITE b ==> dim(v) <= CARD(b)`, + MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; HAS_SIZE;SUBSET_TRANS]);; + +let BASIS_CARD_EQ_DIM = prove + (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b + ==> FINITE b /\ (CARD b = dim v)`, + MESON_TAC[LE_ANTISYM; INDEPENDENT_CARD_LE_DIM; SPAN_CARD_GE_DIM]);; + +let BASIS_HAS_SIZE_DIM = prove + (`!v b. independent b /\ span b = v ==> b HAS_SIZE (dim v)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN + MATCH_MP_TAC BASIS_CARD_EQ_DIM THEN ASM_REWRITE_TAC[SUBSET_REFL] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[SPAN_INC]);; + +let DIM_UNIQUE = prove + (`!v b. b SUBSET v /\ v SUBSET (span b) /\ independent b /\ b HAS_SIZE n + ==> (dim v = n)`, + MESON_TAC[BASIS_CARD_EQ_DIM; HAS_SIZE]);; + +let DIM_LE_CARD = prove + (`!s. FINITE s ==> dim s <= CARD s`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN + ASM_REWRITE_TAC[SPAN_INC; SUBSET_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* More lemmas about dimension. *) +(* ------------------------------------------------------------------------- *) + +let DIM_UNIV = prove + (`dim(:real^N) = dimindex(:N)`, + MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN + REWRITE_TAC[SUBSET_UNIV; SPAN_STDBASIS; HAS_SIZE_STDBASIS; + INDEPENDENT_STDBASIS]);; + +let DIM_SUBSET = prove + (`!s t:real^N->bool. s SUBSET t ==> dim(s) <= dim(t)`, + MESON_TAC[BASIS_EXISTS; INDEPENDENT_SPAN_BOUND; SUBSET; HAS_SIZE]);; + +let DIM_SUBSET_UNIV = prove + (`!s:real^N->bool. dim(s) <= dimindex(:N)`, + GEN_TAC THEN REWRITE_TAC[GSYM DIM_UNIV] THEN + MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; + +let BASIS_HAS_SIZE_UNIV = prove + (`!b. independent b /\ span b = (:real^N) ==> b HAS_SIZE (dimindex(:N))`, + REWRITE_TAC[GSYM DIM_UNIV; BASIS_HAS_SIZE_DIM]);; + +(* ------------------------------------------------------------------------- *) +(* Converses to those. *) +(* ------------------------------------------------------------------------- *) + +let CARD_GE_DIM_INDEPENDENT = prove + (`!v b:real^N->bool. + b SUBSET v /\ independent b /\ dim v <= CARD(b) + ==> v SUBSET (span b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!a:real^N. ~(a IN v /\ ~(a IN span b))` MP_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `independent((a:real^N) INSERT b)` ASSUME_TAC THENL + [ASM_MESON_TAC[INDEPENDENT_INSERT]; ALL_TAC] THEN + MP_TAC(ISPECL [`v:real^N->bool`; `(a:real^N) INSERT b`] + INDEPENDENT_CARD_LE_DIM) THEN + ASM_SIMP_TAC[INSERT_SUBSET; CARD_CLAUSES; INDEPENDENT_BOUND] THEN + ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; ARITH_RULE + `x <= y ==> ~(SUC y <= x)`]);; + +let CARD_LE_DIM_SPANNING = prove + (`!v b:real^N->bool. + v SUBSET (span b) /\ FINITE b /\ CARD(b) <= dim v + ==> independent b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[independent; dependent] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `dim(v:real^N->bool) <= CARD(b DELETE (a:real^N))` MP_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[CARD_DELETE] THEN MATCH_MP_TAC + (ARITH_RULE `b <= n /\ ~(b = 0) ==> ~(n <= b - 1)`) THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]] THEN + MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_SIMP_TAC[FINITE_DELETE] THEN + REWRITE_TAC[SUBSET] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SPAN_TRANS THEN EXISTS_TAC `a:real^N` THEN + ASM_SIMP_TAC[SET_RULE `a IN b ==> (a INSERT (b DELETE a) = b)`] THEN + ASM_MESON_TAC[SUBSET]);; + +let CARD_EQ_DIM = prove + (`!v b. b SUBSET v /\ b HAS_SIZE (dim v) + ==> (independent b <=> v SUBSET (span b))`, + REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN + MESON_TAC[CARD_LE_DIM_SPANNING; CARD_GE_DIM_INDEPENDENT]);; + +(* ------------------------------------------------------------------------- *) +(* More general size bound lemmas. *) +(* ------------------------------------------------------------------------- *) + +let INDEPENDENT_BOUND_GENERAL = prove + (`!s:real^N->bool. independent s ==> FINITE s /\ CARD(s) <= dim(s)`, + MESON_TAC[INDEPENDENT_CARD_LE_DIM; INDEPENDENT_BOUND; SUBSET_REFL]);; + +let DEPENDENT_BIGGERSET_GENERAL = prove + (`!s:real^N->bool. (FINITE s ==> CARD(s) > dim(s)) ==> dependent s`, + MP_TAC INDEPENDENT_BOUND_GENERAL THEN MATCH_MP_TAC MONO_FORALL THEN + REWRITE_TAC[GT; GSYM NOT_LE; independent] THEN MESON_TAC[]);; + +let DIM_SPAN = prove + (`!s:real^N->bool. dim(span s) = dim s`, + GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC DIM_SUBSET THEN MESON_TAC[SUBSET; SPAN_SUPERSET]] THEN + MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN + REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SPAN_CARD_GE_DIM THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN + MATCH_MP_TAC SPAN_MONO THEN ASM_REWRITE_TAC[]);; + +let DIM_INSERT_0 = prove + (`!s:real^N->bool. dim(vec 0 INSERT s) = dim s`, + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + REWRITE_TAC[SPAN_INSERT_0]);; + +let DIM_EQ_CARD = prove + (`!s:real^N->bool. independent s ==> dim s = CARD s`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPECL [`span s:real^N->bool`; `s:real^N->bool`] BASIS_CARD_EQ_DIM) THEN + ASM_SIMP_TAC[SUBSET_REFL; SPAN_INC; DIM_SPAN]);; + +let SUBSET_LE_DIM = prove + (`!s t:real^N->bool. s SUBSET (span t) ==> dim s <= dim t`, + MESON_TAC[DIM_SPAN; DIM_SUBSET]);; + +let SPAN_EQ_DIM = prove + (`!s t. span s = span t ==> dim s = dim t`, + MESON_TAC[DIM_SPAN]);; + +let SPANS_IMAGE = prove + (`!f b v. linear f /\ v SUBSET (span b) + ==> (IMAGE f v) SUBSET span(IMAGE f b)`, + SIMP_TAC[SPAN_LINEAR_IMAGE; IMAGE_SUBSET]);; + +let DIM_LINEAR_IMAGE_LE = prove + (`!f:real^M->real^N s. linear f ==> dim(IMAGE f s) <= dim s`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^M->bool` BASIS_EXISTS) THEN + REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN FIRST_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `CARD(IMAGE (f:real^M->real^N) b)` THEN + ASM_SIMP_TAC[CARD_IMAGE_LE] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN + ASM_MESON_TAC[SPAN_LINEAR_IMAGE; SPANS_IMAGE; SUBSET_IMAGE; FINITE_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Some stepping theorems. *) +(* ------------------------------------------------------------------------- *) + +let DIM_EMPTY = prove + (`dim({}:real^N->bool) = 0`, + MATCH_MP_TAC DIM_UNIQUE THEN EXISTS_TAC `{}:real^N->bool` THEN + REWRITE_TAC[SUBSET_REFL; SPAN_EMPTY; INDEPENDENT_EMPTY; HAS_SIZE_0; + EMPTY_SUBSET]);; + +let DIM_INSERT = prove + (`!x:real^N s. dim(x INSERT s) = if x IN span s then dim s else dim s + 1`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [MATCH_MP_TAC SPAN_EQ_DIM THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_MESON_TAC[SPAN_TRANS; SUBSET; SPAN_MONO; IN_INSERT]; + ALL_TAC] THEN + X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC + (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `(x:real^N) INSERT b` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[INSERT_SUBSET] THEN + ASM_MESON_TAC[SUBSET; SPAN_MONO; IN_INSERT; SPAN_SUPERSET]; + REWRITE_TAC[SUBSET; SPAN_BREAKDOWN_EQ] THEN + ASM_MESON_TAC[SUBSET]; + REWRITE_TAC[INDEPENDENT_INSERT] THEN + ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]; + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; ADD1] THEN + ASM_MESON_TAC[SUBSET; SPAN_SUPERSET; SPAN_MONO; SPAN_SPAN]]);; + +let DIM_SING = prove + (`!x. dim{x} = if x = vec 0 then 0 else 1`, + REWRITE_TAC[DIM_INSERT; DIM_EMPTY; SPAN_EMPTY; IN_SING; ARITH]);; + +let DIM_EQ_0 = prove + (`!s:real^N->bool. dim s = 0 <=> s SUBSET {vec 0}`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MATCH_MP_TAC(SET_RULE + `~(?b. ~(b = a) /\ {b} SUBSET s) ==> s SUBSET {a}`) THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DIM_SUBSET); + MATCH_MP_TAC(ARITH_RULE `!m. m = 0 /\ n <= m ==> n = 0`) THEN + EXISTS_TAC `dim{vec 0:real^N}` THEN ASM_SIMP_TAC[DIM_SUBSET]] THEN + ASM_REWRITE_TAC[DIM_SING; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* Choosing a subspace of a given dimension. *) +(* ------------------------------------------------------------------------- *) + +let CHOOSE_SUBSPACE_OF_SUBSPACE = prove + (`!s:real^N->bool n. + n <= dim s ==> ?t. subspace t /\ t SUBSET span s /\ dim t = n`, + GEN_TAC THEN INDUCT_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `{vec 0:real^N}` THEN + REWRITE_TAC[SUBSPACE_TRIVIAL; DIM_SING; SING_SUBSET; SPAN_0]; + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `span (s:real^N->bool) SUBSET span t` THENL + [SUBGOAL_THEN `dim(s:real^N->bool) = dim(t:real^N->bool)` MP_TAC THENL + [ALL_TAC; ASM_ARITH_TAC] THEN MATCH_MP_TAC SPAN_EQ_DIM THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM_REWRITE_TAC[SUBSPACE_SPAN]; + FIRST_ASSUM(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC o MATCH_MP(SET_RULE + `~(s SUBSET t) ==> ?a. a IN s /\ ~(a IN t)`)) THEN + EXISTS_TAC `span((y:real^N) INSERT t)` THEN + REWRITE_TAC[SUBSPACE_SPAN] THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN + ASM_REWRITE_TAC[SUBSPACE_SPAN] THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[DIM_SPAN; DIM_INSERT; ADD1]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Relation between bases and injectivity/surjectivity of map. *) +(* ------------------------------------------------------------------------- *) + +let SPANNING_SURJECTIVE_IMAGE = prove + (`!f:real^M->real^N s. + UNIV SUBSET (span s) /\ linear f /\ (!y. ?x. f(x) = y) + ==> UNIV SUBSET span(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) UNIV` THEN + ASM_SIMP_TAC[SPANS_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN ASM_MESON_TAC[]);; + +let INDEPENDENT_INJECTIVE_IMAGE_GEN = prove + (`!f:real^M->real^N s. + independent s /\ linear f /\ + (!x y. x IN span s /\ y IN span s /\ f(x) = f(y) ==> x = y) + ==> independent (IMAGE f s)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[independent; DEPENDENT_EXPLICIT] THEN + REWRITE_TAC[CONJ_ASSOC; FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[MESON[] + `(?s u. ((?t. p t /\ s = f t) /\ q s u) /\ r s u) <=> + (?t u. p t /\ q (f t) u /\ r (f t) u)`] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^N->real`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC + [`t:real^M->bool`; `(u:real^N->real) o (f:real^M->real^N)`] THEN + ASM_REWRITE_TAC[o_THM] THEN + FIRST_ASSUM MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; + REWRITE_TAC[SPAN_0]; + ASM_SIMP_TAC[LINEAR_VSUM] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP LINEAR_0) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN CONV_TAC SYM_CONV THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN + ASM_SIMP_TAC[o_DEF; LINEAR_CMUL] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[SPAN_SUPERSET; SUBSET]]);; + +let INDEPENDENT_INJECTIVE_IMAGE = prove + (`!f:real^M->real^N s. + independent s /\ linear f /\ (!x y. (f(x) = f(y)) ==> (x = y)) + ==> independent (IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Picking an orthogonal replacement for a spanning set. *) +(* ------------------------------------------------------------------------- *) + +let VECTOR_SUB_PROJECT_ORTHOGONAL = prove + (`!b:real^N x. b dot (x - ((b dot x) / (b dot b)) % b) = &0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `b = vec 0 :real^N` THENL + [ASM_REWRITE_TAC[DOT_LZERO]; ALL_TAC] THEN + ASM_SIMP_TAC[DOT_RSUB; DOT_RMUL] THEN + ASM_SIMP_TAC[REAL_SUB_REFL; REAL_DIV_RMUL; DOT_EQ_0]);; + +let BASIS_ORTHOGONAL = prove + (`!b:real^N->bool. + FINITE b + ==> ?c. FINITE c /\ CARD c <= CARD b /\ + span c = span b /\ pairwise orthogonal c`, + REWRITE_TAC[pairwise; orthogonal] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + CONJ_TAC THENL + [EXISTS_TAC `{}:real^N->bool` THEN + REWRITE_TAC[FINITE_RULES; NOT_IN_EMPTY; LE_REFL]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) + STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(a - vsum c (\x. ((x dot a) / (x dot x)) % x):real^N) + INSERT c` THEN + ASM_SIMP_TAC[FINITE_RULES; CARD_CLAUSES] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[EXTENSION; SPAN_BREAKDOWN_EQ] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN GEN_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN + REWRITE_TAC[VECTOR_ARITH `a - (x - y):real^N = y + (a - x)`] THEN + MATCH_MP_TAC SPAN_ADD_EQ THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_VSUM THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + ASM_SIMP_TAC[SPAN_SUPERSET]; + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[]; + FIRST_X_ASSUM SUBST_ALL_TAC; + FIRST_X_ASSUM SUBST_ALL_TAC; + ASM_MESON_TAC[]] THEN + REWRITE_TAC[DOT_LSUB; DOT_RSUB; REAL_SUB_0] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SET_RULE + `x IN s ==> s = x INSERT (s DELETE x)`)) THEN + ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + REWRITE_TAC[DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN + MATCH_MP_TAC(REAL_ARITH `s = &0 /\ a = b ==> b = a + s`) THEN + ASM_SIMP_TAC[DOT_LSUM; DOT_RSUM; FINITE_DELETE] THEN + (CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ_0 THEN + ASM_SIMP_TAC[DOT_LMUL; DOT_RMUL; IN_DELETE; + REAL_MUL_RZERO; REAL_MUL_LZERO]; + W(MP_TAC o PART_MATCH (lhand o rand) REAL_DIV_RMUL o lhand o snd) THEN + REWRITE_TAC[DOT_SYM] THEN + MATCH_MP_TAC(TAUT `(p ==> q) ==> (~p ==> q) ==> q`) THEN + SIMP_TAC[] THEN SIMP_TAC[DOT_EQ_0; DOT_RZERO; DOT_LZERO] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]])]);; + +let ORTHOGONAL_BASIS_EXISTS = prove + (`!v:real^N->bool. + ?b. independent b /\ + b SUBSET span v /\ + v SUBSET span b /\ + b HAS_SIZE dim v /\ + pairwise orthogonal b`, + GEN_TAC THEN MP_TAC(ISPEC `v:real^N->bool` BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `b:real^N->bool` BASIS_ORTHOGONAL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[HAS_SIZE]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `span(v):real^N->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO]; + ASM_MESON_TAC[LE_TRANS; HAS_SIZE; DIM_SPAN]]; + ASM_MESON_TAC[SUBSET_TRANS; SPAN_INC; SPAN_SPAN; SPAN_MONO]; + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_REWRITE_TAC[HAS_SIZE; GSYM LE_ANTISYM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[LE_TRANS]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN MATCH_MP_TAC SPAN_CARD_GE_DIM THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SPAN_SPAN; SPAN_MONO; SUBSET_TRANS; SPAN_INC]]);; + +let SPAN_EQ = prove + (`!s t. span s = span t <=> s SUBSET span t /\ t SUBSET span s`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + MESON_TAC[SUBSET_TRANS; SPAN_SPAN; SPAN_MONO; SPAN_INC]);; + +let SPAN_EQ_INSERT = prove + (`!s x. span(x INSERT s) = span s <=> x IN span s`, + REWRITE_TAC[SPAN_EQ; INSERT_SUBSET] THEN + MESON_TAC[SPAN_INC; SUBSET; SET_RULE `s SUBSET (x INSERT s)`]);; + +let SPAN_SPECIAL_SCALE = prove + (`!s a x:real^N. + span((a % x) INSERT s) = if a = &0 then span s else span(x INSERT s)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; SPAN_INSERT_0] THEN + REWRITE_TAC[SPAN_EQ; SUBSET; FORALL_IN_INSERT] THEN + SIMP_TAC[SPAN_MUL; SPAN_SUPERSET; IN_INSERT] THEN + REWRITE_TAC[SPAN_BREAKDOWN_EQ] THEN EXISTS_TAC `inv a:real` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID] THEN + REWRITE_TAC[SPAN_0; VECTOR_SUB_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* We can extend a linear basis-basis injection to the whole set. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INDEP_IMAGE_LEMMA = prove + (`!f b. linear(f:real^M->real^N) /\ + FINITE b /\ + independent (IMAGE f b) /\ + (!x y. x IN b /\ y IN b /\ (f x = f y) ==> (x = y)) + ==> !x. x IN span b ==> (f(x) = vec 0) ==> (x = vec 0)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC (BINDER_CONV o RAND_CONV) [IMP_IMP] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + CONJ_TAC THENL [SIMP_TAC[IN_SING; SPAN_EMPTY]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN STRIP_TAC THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[INDEPENDENT_MONO; IMAGE_CLAUSES; SUBSET; IN_INSERT]; + ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:real^M`; `(a:real^M) INSERT b`; `x:real^M`] + SPAN_BREAKDOWN) THEN + ASM_REWRITE_TAC[IN_INSERT] THEN + SIMP_TAC[ASSUME `~((a:real^M) IN b)`; SET_RULE + `~(a IN b) ==> ((a INSERT b) DELETE a = b)`] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N)(x - k % a) IN span(IMAGE f b)` MP_TAC THENL + [ASM_MESON_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_SUB th]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN + ASM_REWRITE_TAC[VECTOR_ARITH `vec 0 - k % x = (--k) % x`] THEN + ASM_CASES_TAC `k = &0` THENL + [ASM_MESON_TAC[VECTOR_ARITH `x - &0 % y = x`]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `--inv(k)` o MATCH_MP SPAN_MUL) THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG; REAL_MUL_RNEG] THEN + SIMP_TAC[REAL_NEGNEG; REAL_MUL_LINV; ASSUME `~(k = &0)`] THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [independent]) THEN + REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) a`) THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) (a INSERT b) DELETE f a = + IMAGE f ((a INSERT b) DELETE a)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE; IN_INSERT] THEN + ASM_MESON_TAC[IN_INSERT]; + ALL_TAC] THEN + ASM_REWRITE_TAC[DELETE_INSERT] THEN + SIMP_TAC[SET_RULE `~(a IN b) ==> (b DELETE a = b)`; + ASSUME `~(a:real^M IN b)`] THEN + SIMP_TAC[IMAGE_CLAUSES; IN_INSERT]);; + +(* ------------------------------------------------------------------------- *) +(* We can extend a linear mapping from basis. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INDEPENDENT_EXTEND_LEMMA = prove + (`!f b. FINITE b + ==> independent b + ==> ?g:real^M->real^N. + (!x y. x IN span b /\ y IN span b + ==> (g(x + y) = g(x) + g(y))) /\ + (!x c. x IN span b ==> (g(c % x) = c % g(x))) /\ + (!x. x IN b ==> (g x = f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY; INDEPENDENT_INSERT] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. vec 0):real^M->real^N` THEN + SIMP_TAC[SPAN_EMPTY] THEN REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `h = \z:real^M. @k. (z - k % a) IN span b` THEN + SUBGOAL_THEN `!z:real^M. z IN span(a INSERT b) + ==> (z - h(z) % a) IN span(b) /\ + !k. (z - k % a) IN span(b) ==> (k = h(z))` + MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [EXPAND_TAC "h" THEN CONV_TAC SELECT_CONV THEN + ASM_MESON_TAC[SPAN_BREAKDOWN_EQ]; + ALL_TAC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SPAN_SUB) THEN + REWRITE_TAC[VECTOR_ARITH `(z - a % v) - (z - b % v) = (b - a) % v`] THEN + ASM_CASES_TAC `k = (h:real^M->real) z` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `inv(k - (h:real^M->real) z)` o + MATCH_MP SPAN_MUL) THEN + ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_ASSOC; REAL_SUB_0] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LID]; + ALL_TAC] THEN + REWRITE_TAC[TAUT `(a ==> b /\ c) <=> (a ==> b) /\ (a ==> c)`] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + GEN_REWRITE_TAC LAND_CONV [FORALL_AND_THM] THEN STRIP_TAC THEN + EXISTS_TAC `\z:real^M. h(z) % (f:real^M->real^N)(a) + g(z - h(z) % a)` THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(h:real^M->real)(x + y) = h(x) + h(y)` ASSUME_TAC THENL + [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_ARITH + `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN + CONJ_TAC THEN MATCH_MP_TAC SPAN_ADD THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `(x + y) - (k + l) % a = (x - k % a) + (y - l % a)`] THEN + ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`x:real^M`; `c:real`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(h:real^M->real)(c % x) = c * h(x)` ASSUME_TAC THENL + [CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[VECTOR_ARITH + `c % x - (c * k) % a = c % (x - k % a)`] THEN + CONJ_TAC THEN MATCH_MP_TAC SPAN_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `c % x - (c * k) % a = c % (x - k % a)`] THEN + ASM_SIMP_TAC[] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN REWRITE_TAC[IN_INSERT] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THENL + [SUBGOAL_THEN `&1 = h(a:real^M)` (SUBST1_TAC o SYM) THENL + [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH `a - &1 % a = vec 0`; SPAN_0] THENL + [ASM_MESON_TAC[SPAN_SUPERSET; SUBSET; IN_INSERT]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`vec 0:real^M`; `vec 0:real^M`]) THEN + REWRITE_TAC[SPAN_0; VECTOR_ADD_LID] THEN + REWRITE_TAC[VECTOR_ARITH `(a = a + a) <=> (a = vec 0)`] THEN + DISCH_THEN SUBST1_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 = h(x:real^M)` (SUBST1_TAC o SYM) THENL + [FIRST_X_ASSUM MATCH_MP_TAC; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ADD_LID; VECTOR_MUL_LZERO; VECTOR_SUB_RZERO] THEN + ASM_MESON_TAC[SUBSET; IN_INSERT; SPAN_SUPERSET]);; + +let LINEAR_INDEPENDENT_EXTEND = prove + (`!f b. independent b + ==> ?g:real^M->real^N. linear g /\ (!x. x IN b ==> (g x = f x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`b:real^M->bool`; `(:real^M)`] + MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN + ASM_REWRITE_TAC[SUBSET_UNIV; UNIV_SUBSET] THEN + REWRITE_TAC[EXTENSION; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`] + LINEAR_INDEPENDENT_EXTEND_LEMMA) THEN + ASM_SIMP_TAC[INDEPENDENT_BOUND; linear] THEN + ASM_MESON_TAC[SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Linear functions are equal on a subspace if they are on a spanning set. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_KERNEL = prove + (`!f. linear f ==> subspace {x | f(x) = vec 0}`, + REWRITE_TAC[subspace; IN_ELIM_THM] THEN + SIMP_TAC[LINEAR_ADD; LINEAR_CMUL; VECTOR_ADD_LID; VECTOR_MUL_RZERO] THEN + MESON_TAC[LINEAR_0]);; + +let LINEAR_EQ_0_SPAN = prove + (`!f:real^M->real^N b. + linear f /\ (!x. x IN b ==> f(x) = vec 0) + ==> !x. x IN span(b) ==> f(x) = vec 0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN]) THEN + MATCH_MP_TAC SPAN_INDUCT THEN ASM_REWRITE_TAC[IN] THEN + MP_TAC(ISPEC `f:real^M->real^N` SUBSPACE_KERNEL) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);; + +let LINEAR_EQ_0 = prove + (`!f b s. linear f /\ s SUBSET (span b) /\ (!x. x IN b ==> f(x) = vec 0) + ==> !x. x IN s ==> f(x) = vec 0`, + MESON_TAC[LINEAR_EQ_0_SPAN; SUBSET]);; + +let LINEAR_EQ = prove + (`!f g b s. linear f /\ linear g /\ s SUBSET (span b) /\ + (!x. x IN b ==> f(x) = g(x)) + ==> !x. x IN s ==> f(x) = g(x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + STRIP_TAC THEN MATCH_MP_TAC LINEAR_EQ_0 THEN + ASM_MESON_TAC[LINEAR_COMPOSE_SUB]);; + +let LINEAR_EQ_STDBASIS = prove + (`!f:real^M->real^N g. + linear f /\ linear g /\ + (!i. 1 <= i /\ i <= dimindex(:M) + ==> f(basis i) = g(basis i)) + ==> f = g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!x. x IN UNIV ==> (f:real^M->real^N) x = g x` + (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN + MATCH_MP_TAC LINEAR_EQ THEN + EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN + ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +let SUBSPACE_LINEAR_FIXED_POINTS = prove + (`!f:real^N->real^N. linear f ==> subspace {x | f(x) = x}`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + MATCH_MP_TAC SUBSPACE_KERNEL THEN + ASM_SIMP_TAC[LINEAR_COMPOSE_SUB; LINEAR_ID]);; + +(* ------------------------------------------------------------------------- *) +(* Similar results for bilinear functions. *) +(* ------------------------------------------------------------------------- *) + +let BILINEAR_EQ = prove + (`!f:real^M->real^N->real^P g b c s. + bilinear f /\ bilinear g /\ + s SUBSET (span b) /\ t SUBSET (span c) /\ + (!x y. x IN b /\ y IN c ==> f x y = g x y) + ==> !x y. x IN s /\ y IN t ==> f x y = g x y`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `!x:real^M. x IN span b + ==> !y:real^N. y IN span c ==> (f x y :real^P = g x y)` + (fun th -> ASM_MESON_TAC[th; SUBSET]) THEN + MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN + CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC; + ASM_SIMP_TAC[BILINEAR_LADD; BILINEAR_LMUL] THEN + ASM_MESON_TAC[BILINEAR_LZERO]] THEN + MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[subspace; IN_ELIM_THM] THEN + ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RMUL] THEN + ASM_MESON_TAC[BILINEAR_RZERO]);; + +let BILINEAR_EQ_STDBASIS = prove + (`!f:real^M->real^N->real^P g. + bilinear f /\ bilinear g /\ + (!i j. 1 <= i /\ i <= dimindex(:M) /\ 1 <= j /\ j <= dimindex(:N) + ==> f (basis i) (basis j) = g (basis i) (basis j)) + ==> f = g`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `!x y. x IN UNIV /\ y IN UNIV ==> (f:real^M->real^N->real^P) x y = g x y` + (fun th -> MP_TAC th THEN REWRITE_TAC[FUN_EQ_THM; IN_UNIV]) THEN + MATCH_MP_TAC BILINEAR_EQ THEN + EXISTS_TAC `{basis i :real^M | 1 <= i /\ i <= dimindex(:M)}` THEN + EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN + ASM_REWRITE_TAC[SPAN_STDBASIS; SUBSET_REFL; IN_ELIM_THM] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Detailed theorems about left and right invertibility in general case. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_INVERTIBLE_TRANSP = prove + (`!A:real^N^M. + (?B:real^N^M. B ** transp A = mat 1) <=> (?B:real^M^N. A ** B = mat 1)`, + MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);; + +let RIGHT_INVERTIBLE_TRANSP = prove + (`!A:real^N^M. + (?B:real^N^M. transp A ** B = mat 1) <=> (?B:real^M^N. B ** A = mat 1)`, + MESON_TAC[MATRIX_TRANSP_MUL; TRANSP_MAT; TRANSP_TRANSP]);; + +let INVERTIBLE_TRANSP = prove + (`!A:real^N^M. invertible(transp A) <=> invertible A`, + GEN_TAC THEN REWRITE_TAC[invertible] THEN + GEN_REWRITE_TAC LAND_CONV [MESON[TRANSP_TRANSP] + `(?A:real^M^N. P A) <=> (?A:real^N^M. P(transp A))`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM TRANSP_MAT] THEN + REWRITE_TAC[GSYM MATRIX_TRANSP_MUL; TRANSP_EQ] THEN MESON_TAC[]);; + +let LINEAR_INJECTIVE_LEFT_INVERSE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ?g. linear g /\ g o f = I`, + REWRITE_TAC[INJECTIVE_LEFT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?h. linear(h:real^N->real^M) /\ + !x. x IN IMAGE (f:real^M->real^N) + {basis i | 1 <= i /\ i <= dimindex(:M)} ==> h x = g x` + MP_TAC THENL + [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN + MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE THEN + ASM_MESON_TAC[INJECTIVE_LEFT_INVERSE; INDEPENDENT_STDBASIS]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN + ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN + ASM_MESON_TAC[]]);; + +let LINEAR_SURJECTIVE_RIGHT_INVERSE = prove + (`!f:real^M->real^N. + linear f /\ (!y. ?x. f x = y) ==> ?g. linear g /\ f o g = I`, + REWRITE_TAC[SURJECTIVE_RIGHT_INVERSE] THEN REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?h. linear(h:real^N->real^M) /\ + !x. x IN {basis i | 1 <= i /\ i <= dimindex(:N)} ==> h x = g x` + MP_TAC THENL + [MATCH_MP_TAC LINEAR_INDEPENDENT_EXTEND THEN + REWRITE_TAC[INDEPENDENT_STDBASIS]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `h:real^N->real^M` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LINEAR_EQ_STDBASIS THEN + ASM_SIMP_TAC[I_DEF; LINEAR_COMPOSE; LINEAR_ID; o_THM] THEN + ASM_MESON_TAC[]]);; + +let MATRIX_LEFT_INVERTIBLE_INJECTIVE = prove + (`!A:real^N^M. + (?B:real^M^N. B ** A = mat 1) <=> + !x y:real^N. A ** x = A ** y ==> x = y`, + GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^M. (B:real^M^N) ** x`) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; + DISCH_TAC THEN MP_TAC(ISPEC + `\x:real^N. (A:real^N^M) ** x` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `matrix(g):real^M^N` THEN + REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN + ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);; + +let MATRIX_LEFT_INVERTIBLE_KER = prove + (`!A:real^N^M. + (?B:real^M^N. B ** A = mat 1) <=> !x. A ** x = vec 0 ==> x = vec 0`, + GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN + MATCH_MP_TAC LINEAR_INJECTIVE_0 THEN REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; + +let MATRIX_RIGHT_INVERTIBLE_SURJECTIVE = prove + (`!A:real^N^M. + (?B:real^M^N. A ** B = mat 1) <=> !y. ?x. A ** x = y`, + GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN X_GEN_TAC `y:real^M` THEN + EXISTS_TAC `(B:real^M^N) ** (y:real^M)` THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; + DISCH_TAC THEN MP_TAC(ISPEC + `\x:real^N. (A:real^N^M) ** x` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; FUN_EQ_THM; I_THM; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `matrix(g):real^M^N` THEN + REWRITE_TAC[MATRIX_EQ; MATRIX_VECTOR_MUL_LID] THEN + ASM_MESON_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_WORKS]]);; + +let MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS = prove + (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> + !c. vsum(1..dimindex(:N)) (\i. c(i) % column i A) = vec 0 ==> + !i. 1 <= i /\ i <= dimindex(:N) ==> c(i) = &0`, + GEN_TAC THEN REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_KER; MATRIX_MUL_VSUM] THEN + EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `c:num->real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. c(i)):real^N`); + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\i. (x:real^N)$i`)] THEN + ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; VEC_COMPONENT]);; + +let MATRIX_RIGHT_INVERTIBLE_INDEPENDENT_ROWS = prove + (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> + !c. vsum(1..dimindex(:M)) (\i. c(i) % row i A) = vec 0 ==> + !i. 1 <= i /\ i <= dimindex(:M) ==> c(i) = &0`, + ONCE_REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN + REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INDEPENDENT_COLUMNS] THEN + SIMP_TAC[COLUMN_TRANSP]);; + +let MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS = prove + (`!A:real^N^M. (?B:real^M^N. A ** B = mat 1) <=> span(columns A) = (:real^M)`, + GEN_TAC THEN REWRITE_TAC[MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN + REWRITE_TAC[MATRIX_MUL_VSUM; EXTENSION; IN_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^M` THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM)) THEN + MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC(CONJUNCT1 SPAN_CLAUSES) THEN + REWRITE_TAC[columns; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SPEC_TAC(`y:real^M`,`y:real^M`) THEN MATCH_MP_TAC SPAN_INDUCT_ALT THEN + CONJ_TAC THENL + [EXISTS_TAC `vec 0 :real^N` THEN + SIMP_TAC[VEC_COMPONENT; VECTOR_MUL_LZERO; VSUM_0]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`c:real`; `y1:real^M`; `y2:real^M`] THEN + REWRITE_TAC[columns; IN_ELIM_THM] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `x:real^N` (SUBST1_TAC o SYM))) THEN + EXISTS_TAC `(lambda j. if j = i then c + (x:real^N)$i else x$j):real^N` THEN + SUBGOAL_THEN `1..dimindex(:N) = i INSERT ((1..dimindex(:N)) DELETE i)` + SUBST1_TAC THENL [ASM_MESON_TAC[INSERT_DELETE; IN_NUMSEG]; ALL_TAC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_DELETE; FINITE_NUMSEG; IN_DELETE] THEN + ASM_SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_RDISTRIB; VECTOR_ADD_ASSOC] THEN + AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + SIMP_TAC[FINITE_DELETE; IN_DELETE; FINITE_NUMSEG; LAMBDA_BETA; IN_NUMSEG]);; + +let MATRIX_LEFT_INVERTIBLE_SPAN_ROWS = prove + (`!A:real^N^M. (?B:real^M^N. B ** A = mat 1) <=> span(rows A) = (:real^N)`, + MESON_TAC[RIGHT_INVERTIBLE_TRANSP; COLUMNS_TRANSP; + MATRIX_RIGHT_INVERTIBLE_SPAN_COLUMNS]);; + +(* ------------------------------------------------------------------------- *) +(* An injective map real^N->real^N is also surjective. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INJECTIVE_IMP_SURJECTIVE = prove + (`!f:real^N->real^N. + linear f /\ (!x y. (f(x) = f(y)) ==> (x = y)) + ==> !y. ?x. f(x) = y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN + REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `UNIV SUBSET span(IMAGE (f:real^N->real^N) b)` MP_TAC THENL + [MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + ASM_MESON_TAC[INDEPENDENT_INJECTIVE_IMAGE; LE_REFL; + SUBSET_UNIV; CARD_IMAGE_INJ]; + ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE; IN_UNIV]]);; + +(* ------------------------------------------------------------------------- *) +(* And vice versa. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_SURJECTIVE_IMP_INJECTIVE = prove + (`!f:real^N->real^N. + linear f /\ (!y. ?x. f(x) = y) + ==> !x y. (f(x) = f(y)) ==> (x = y)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `(:real^N)` BASIS_EXISTS) THEN + REWRITE_TAC[SUBSET_UNIV; HAS_SIZE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!x. x IN span b ==> (f:real^N->real^N) x = vec 0 ==> x = vec 0` + (fun th -> ASM_MESON_TAC[th; LINEAR_INJECTIVE_0; SUBSET; IN_UNIV]) THEN + MATCH_MP_TAC LINEAR_INDEP_IMAGE_LEMMA THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_LE_DIM_SPANNING THEN + EXISTS_TAC `(:real^N)` THEN + ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE; SPAN_LINEAR_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_UNIV; IN_IMAGE] THEN + ASM_MESON_TAC[CARD_IMAGE_LE; SUBSET; IN_UNIV]; + ALL_TAC] THEN + SUBGOAL_THEN `dim(:real^N) <= CARD(IMAGE (f:real^N->real^N) b)` + MP_TAC THENL + [MATCH_MP_TAC SPAN_CARD_GE_DIM THEN + ASM_SIMP_TAC[SUBSET_UNIV; FINITE_IMAGE] THEN + ASM_SIMP_TAC[SPAN_LINEAR_IMAGE] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (f:real^N->real^N) UNIV` THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN + ASM_REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o ISPEC `f:real^N->real^N` o + MATCH_MP CARD_IMAGE_LE) THEN + ASM_REWRITE_TAC[IMP_IMP; LE_ANTISYM] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`b:real^N->bool`; `IMAGE (f:real^N->real^N) b`; `f:real^N->real^N`] + SURJECTIVE_IFF_INJECTIVE_GEN) THEN + ASM_SIMP_TAC[FINITE_IMAGE; INDEPENDENT_BOUND; SUBSET_REFL] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN MESON_TAC[]);; + +let LINEAR_SURJECTIVE_IFF_INJECTIVE = prove + (`!f:real^N->real^N. + linear f ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`, + MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE; + LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence either is enough for isomorphism. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_RIGHT_INVERSE_EQ = prove + (`!f:A->A g h. f o g = I /\ g o h = I ==> f = h`, + MESON_TAC[o_ASSOC; I_O_ID]);; + +let ISOMORPHISM_EXPAND = prove + (`!f g. f o g = I /\ g o f = I <=> (!x. f(g x) = x) /\ (!x. g(f x) = x)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; + +let LINEAR_INJECTIVE_ISOMORPHISM = prove + (`!f:real^N->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_IMP_SURJECTIVE) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);; + +let LINEAR_SURJECTIVE_ISOMORPHISM = prove + (`!f:real^N->real^N. + linear f /\ (!y. ?x. f x = y) + ==> ?f'. linear f' /\ (!x. f'(f x) = x) /\ (!x. f(f' x) = x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM ISOMORPHISM_EXPAND] THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_IMP_INJECTIVE) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN MESON_TAC[LEFT_RIGHT_INVERSE_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Left and right inverses are the same for R^N->R^N. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INVERSE_LEFT = prove + (`!f:real^N->real^N f'. + linear f /\ linear f' ==> ((f o f' = I) <=> (f' o f = I))`, + SUBGOAL_THEN + `!f:real^N->real^N f'. + linear f /\ linear f' /\ (f o f' = I) ==> (f' o f = I)` + (fun th -> MESON_TAC[th]) THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real^N->real^N` LINEAR_SURJECTIVE_ISOMORPHISM) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Moreover, a one-sided inverse is automatically linear. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_INVERSE_LINEAR = prove + (`!f g:real^N->real^N. linear f /\ (g o f = I) ==> linear g`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + STRIP_TAC THEN SUBGOAL_THEN + `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)` + CHOOSE_TAC THENL + [MATCH_MP_TAC LINEAR_INJECTIVE_ISOMORPHISM THEN ASM_MESON_TAC[]; + SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);; + +let RIGHT_INVERSE_LINEAR = prove + (`!f g:real^N->real^N. linear f /\ (f o g = I) ==> linear g`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + STRIP_TAC THEN SUBGOAL_THEN + `?h:real^N->real^N. linear h /\ (!x. h(f x) = x) /\ (!x. f(h x) = x)` + CHOOSE_TAC THENL [ASM_MESON_TAC[LINEAR_SURJECTIVE_ISOMORPHISM]; ALL_TAC] THEN + SUBGOAL_THEN `g:real^N->real^N = h` (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Without (ostensible) constraints on types, though dimensions must match. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_RIGHT_INVERSE_LINEAR = prove + (`!f g:real^M->real^N. + linear f /\ g o f = I /\ f o g = I ==> linear g`, + REWRITE_TAC[linear; FUN_EQ_THM; o_THM; I_THM] THEN MESON_TAC[]);; + +let LINEAR_BIJECTIVE_LEFT_RIGHT_INVERSE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> ?g. linear g /\ (!x. g(f x) = x) /\ (!y. f(g y) = y)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BIJECTIVE_LEFT_RIGHT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LEFT_RIGHT_INVERSE_LINEAR THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM]);; + +(* ------------------------------------------------------------------------- *) +(* The same result in terms of square matrices. *) +(* ------------------------------------------------------------------------- *) + +let MATRIX_LEFT_RIGHT_INVERSE = prove + (`!A:real^N^N A':real^N^N. (A ** A' = mat 1) <=> (A' ** A = mat 1)`, + SUBGOAL_THEN + `!A:real^N^N A':real^N^N. (A ** A' = mat 1) ==> (A' ** A = mat 1)` + (fun th -> MESON_TAC[th]) THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\x:real^N. A:(real^N^N) ** x` + LINEAR_SURJECTIVE_ISOMORPHISM) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN ANTS_TAC THENL + [X_GEN_TAC `x:real^N` THEN EXISTS_TAC `(A':real^N^N) ** (x:real^N)` THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_ASSOC; MATRIX_VECTOR_MUL_LID]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `matrix (f':real^N->real^N) ** (A:real^N^N) = mat 1` + MP_TAC THENL + [ASM_SIMP_TAC[MATRIX_EQ; MATRIX_WORKS; GSYM MATRIX_VECTOR_MUL_ASSOC; + MATRIX_VECTOR_MUL_LID]; + ALL_TAC] THEN + DISCH_THEN(fun th -> ASSUME_TAC th THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o AP_TERM `(\m:real^N^N. m ** (A':real^N^N))`) THEN + REWRITE_TAC[GSYM MATRIX_MUL_ASSOC] THEN + ASM_REWRITE_TAC[MATRIX_MUL_RID; MATRIX_MUL_LID] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Invertibility of matrices and corresponding linear functions. *) +(* ------------------------------------------------------------------------- *) + +let MATRIX_LEFT_INVERTIBLE = prove + (`!f:real^M->real^N. + linear f ==> ((?B:real^N^M. B ** matrix f = mat 1) <=> + (?g. linear g /\ g o f = I))`, + GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [MATCH_MP MATRIX_VECTOR_MUL th]) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC; + MATRIX_VECTOR_MUL_LID]; + EXISTS_TAC `matrix(g:real^N->real^M)` THEN + ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);; + +let MATRIX_RIGHT_INVERTIBLE = prove + (`!f:real^M->real^N. + linear f ==> ((?B:real^N^M. matrix f ** B = mat 1) <=> + (?g. linear g /\ f o g = I))`, + GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `\y:real^N. (B:real^N^M) ** y` THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [MATCH_MP MATRIX_VECTOR_MUL th]) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; MATRIX_VECTOR_MUL_ASSOC; + MATRIX_VECTOR_MUL_LID]; + EXISTS_TAC `matrix(g:real^N->real^M)` THEN + ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; MATRIX_I]]);; + +let INVERTIBLE_LEFT_INVERSE = prove + (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. B ** A = mat 1`, + MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);; + +let INVERTIBLE_RIGHT_INVERSE = prove + (`!A:real^N^N. invertible(A) <=> ?B:real^N^N. A ** B = mat 1`, + MESON_TAC[invertible; MATRIX_LEFT_RIGHT_INVERSE]);; + +let MATRIX_INVERTIBLE = prove + (`!f:real^N->real^N. + linear f + ==> (invertible(matrix f) <=> + ?g. linear g /\ f o g = I /\ g o f = I)`, + SIMP_TAC[INVERTIBLE_LEFT_INVERSE; MATRIX_LEFT_INVERTIBLE] THEN + MESON_TAC[LINEAR_INVERSE_LEFT]);; + +let MATRIX_INV_UNIQUE_LEFT = prove + (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv B = A`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN + ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);; + +let MATRIX_INV_UNIQUE_RIGHT = prove + (`!A:real^N^N B. A ** B = mat 1 ==> matrix_inv A = B`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_INV_UNIQUE THEN + ASM_MESON_TAC[MATRIX_LEFT_RIGHT_INVERSE]);; + +(* ------------------------------------------------------------------------- *) +(* Left-invertible linear transformation has a lower bound. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INVERTIBLE_BOUNDED_BELOW_POS = prove + (`!f:real^M->real^N g. + linear f /\ linear g /\ (g o f = I) + ==> ?B. &0 < B /\ !x. B * norm(x) <= norm(f x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `g:real^N->real^M` LINEAR_BOUNDED_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv B:real` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + X_GEN_TAC `x:real^M` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(B) * norm(((g:real^N->real^M) o (f:real^M->real^N)) x)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[I_THM; REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN + ASM_SIMP_TAC[o_THM; REAL_LE_LDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);; + +let LINEAR_INVERTIBLE_BOUNDED_BELOW = prove + (`!f:real^M->real^N g. + linear f /\ linear g /\ (g o f = I) + ==> ?B. !x. B * norm(x) <= norm(f x)`, + MESON_TAC[LINEAR_INVERTIBLE_BOUNDED_BELOW_POS]);; + +let LINEAR_INJECTIVE_BOUNDED_BELOW_POS = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ?B. &0 < B /\ !x. norm(x) * B <= norm(f x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC LINEAR_INVERTIBLE_BOUNDED_BELOW_POS THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_LEFT_INVERSE]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of dimension by injective map. *) +(* ------------------------------------------------------------------------- *) + +let DIM_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) ==> dim(IMAGE f s) = dim s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIM_LINEAR_IMAGE_LE]; ALL_TAC] THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `dim(IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s))` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; LE_REFL]; + MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN ASM_REWRITE_TAC[]]);; + +let LINEAR_INJECTIVE_DIMINDEX_LE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> dimindex(:M) <= dimindex(:N)`, + REWRITE_TAC[GSYM DIM_UNIV] THEN REPEAT GEN_TAC THEN DISCH_THEN + (SUBST1_TAC o SYM o SPEC `(:real^M)` o + MATCH_MP DIM_INJECTIVE_LINEAR_IMAGE) THEN + MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[SUBSET_UNIV]);; + +let LINEAR_SURJECTIVE_DIMINDEX_LE = prove + (`!f:real^M->real^N. + linear f /\ (!y. ?x. f x = y) + ==> dimindex(:N) <= dimindex(:M)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP LINEAR_SURJECTIVE_RIGHT_INVERSE) THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:real^N->real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE THEN + EXISTS_TAC `g:real^N->real^M` THEN ASM_MESON_TAC[]);; + +let LINEAR_BIJECTIVE_DIMINDEX_EQ = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> dimindex(:M) = dimindex(:N)`, + REWRITE_TAC[GSYM LE_ANTISYM] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC LINEAR_INJECTIVE_DIMINDEX_LE; + MATCH_MP_TAC LINEAR_SURJECTIVE_DIMINDEX_LE] THEN + EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[]);; + +let INVERTIBLE_IMP_SQUARE_MATRIX = prove + (`!A:real^N^M. invertible A ==> dimindex(:M) = dimindex(:N)`, + GEN_TAC THEN REWRITE_TAC[invertible; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `B:real^M^N` THEN STRIP_TAC THEN + MATCH_MP_TAC LINEAR_BIJECTIVE_DIMINDEX_EQ THEN + EXISTS_TAC `\x:real^M. (B:real^M^N) ** x` THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR; + GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE; + GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Considering an n-element vector as an n-by-1 or 1-by-n matrix. *) +(* ------------------------------------------------------------------------- *) + +let rowvector = new_definition + `(rowvector:real^N->real^N^1) v = lambda i j. v$j`;; + +let columnvector = new_definition + `(columnvector:real^N->real^1^N) v = lambda i j. v$i`;; + +let TRANSP_COLUMNVECTOR = prove + (`!v. transp(columnvector v) = rowvector v`, + SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);; + +let TRANSP_ROWVECTOR = prove + (`!v. transp(rowvector v) = columnvector v`, + SIMP_TAC[transp; columnvector; rowvector; CART_EQ; LAMBDA_BETA]);; + +let DOT_ROWVECTOR_COLUMNVECTOR = prove + (`!A:real^N^M v:real^N. columnvector(A ** v) = A ** columnvector v`, + REWRITE_TAC[rowvector; columnvector; matrix_mul; matrix_vector_mul] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA]);; + +let DOT_MATRIX_PRODUCT = prove + (`!x y:real^N. x dot y = (rowvector x ** columnvector y)$1$1`, + REWRITE_TAC[matrix_mul; columnvector; rowvector; dot] THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_1; LE_REFL]);; + +let DOT_MATRIX_VECTOR_MUL = prove + (`!A:real^N^N B:real^N^N x:real^N y:real^N. + (A ** x) dot (B ** y) = + ((rowvector x) ** (transp(A) ** B) ** (columnvector y))$1$1`, + REWRITE_TAC[DOT_MATRIX_PRODUCT] THEN + ONCE_REWRITE_TAC[GSYM TRANSP_COLUMNVECTOR] THEN + REWRITE_TAC[DOT_ROWVECTOR_COLUMNVECTOR; MATRIX_TRANSP_MUL] THEN + REWRITE_TAC[MATRIX_MUL_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Rank of a matrix. Equivalence of row and column rank is taken from *) +(* George Mackiw's paper, Mathematics Magazine 1995, p. 285. *) +(* ------------------------------------------------------------------------- *) + +let MATRIX_VECTOR_MUL_IN_COLUMNSPACE = prove + (`!A:real^M^N x:real^M. (A ** x) IN span(columns A)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MATRIX_VECTOR_COLUMN; columns] THEN + MATCH_MP_TAC SPAN_VSUM THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; transp; LAMBDA_BETA] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN + REWRITE_TAC[IN_ELIM_THM; column] THEN EXISTS_TAC `k:num` THEN + ASM_REWRITE_TAC[]);; + +let SUBSPACE_ORTHOGONAL_TO_VECTOR = prove + (`!x. subspace {y | orthogonal x y}`, + SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);; + +let SUBSPACE_ORTHOGONAL_TO_VECTORS = prove + (`!s. subspace {y | (!x. x IN s ==> orthogonal x y)}`, + SIMP_TAC[subspace; IN_ELIM_THM; ORTHOGONAL_CLAUSES]);; + +let ORTHOGONAL_TO_SPAN = prove + (`!s x. (!y. y IN s ==> orthogonal x y) + ==> !y. y IN span(s) ==> orthogonal x y`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN + ASM_SIMP_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM]);; + +let ORTHOGONAL_TO_SPAN_EQ = prove + (`!s x. (!y. y IN span(s) ==> orthogonal x y) <=> + (!y. y IN s ==> orthogonal x y)`, + MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_TO_SPAN]);; + +let ORTHOGONAL_TO_SPANS_EQ = prove + (`!s t. (!x y. x IN span(s) /\ y IN span(t) ==> orthogonal x y) <=> + (!x y. x IN s /\ y IN t ==> orthogonal x y)`, + MESON_TAC[ORTHOGONAL_TO_SPAN_EQ; ORTHOGONAL_SYM]);; + +let ORTHOGONAL_NULLSPACE_ROWSPACE = prove + (`!A:real^M^N x y:real^M. + A ** x = vec 0 /\ y IN span(rows A) ==> orthogonal x y`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[SET_RULE `(\y. orthogonal x y) = {y | orthogonal x y}`] THEN + REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; rows; FORALL_IN_GSPEC] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\y:real^N. y$k`) THEN + ASM_SIMP_TAC[MATRIX_VECTOR_MUL_COMPONENT; VEC_COMPONENT; row; dot; + orthogonal; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_MUL_SYM]);; + +let NULLSPACE_INTER_ROWSPACE = prove + (`!A:real^M^N x:real^M. A ** x = vec 0 /\ x IN span(rows A) <=> x = vec 0`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[ORTHOGONAL_NULLSPACE_ROWSPACE; ORTHOGONAL_REFL]; + SIMP_TAC[MATRIX_VECTOR_MUL_RZERO; SPAN_0]]);; + +let MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE = prove + (`!A:real^M^N x y:real^M. + x IN span(rows A) /\ y IN span(rows A) /\ A ** x = A ** y ==> x = y`, + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_SUB_LDISTRIB] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NULLSPACE_INTER_ROWSPACE] THEN + ASM_SIMP_TAC[SPAN_SUB]);; + +let DIM_ROWS_LE_DIM_COLUMNS = prove + (`!A:real^M^N. dim(rows A) <= dim(columns A)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC + (ISPEC `span(rows(A:real^M^N))` BASIS_EXISTS) THEN + SUBGOAL_THEN `FINITE(IMAGE (\x:real^M. (A:real^M^N) ** x) b) /\ + CARD (IMAGE (\x:real^M. (A:real^M^N) ** x) b) <= + dim(span(columns A))` + MP_TAC THENL + [MATCH_MP_TAC INDEPENDENT_CARD_LE_DIM THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; MATRIX_VECTOR_MUL_IN_COLUMNSPACE] THEN + MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN + SUBGOAL_THEN `span(b) = span(rows(A:real^M^N))` SUBST1_TAC THENL + [ALL_TAC; ASM_MESON_TAC[MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE]] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN + ASM_SIMP_TAC[SPAN_MONO]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (SUBST1_TAC o SYM) o + GEN_REWRITE_RULE I [HAS_SIZE]) THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC + (ISPEC `A:real^M^N` MATRIX_VECTOR_MUL_INJECTIVE_ON_ROWSPACE) THEN + ASM SET_TAC[]]);; + +let rank = new_definition + `rank(A:real^M^N) = dim(columns A)`;; + +let RANK_ROW = prove + (`!A:real^M^N. rank(A) = dim(rows A)`, + GEN_TAC THEN REWRITE_TAC[rank] THEN + MP_TAC(ISPEC `A:real^M^N` DIM_ROWS_LE_DIM_COLUMNS) THEN + MP_TAC(ISPEC `transp(A:real^M^N)` DIM_ROWS_LE_DIM_COLUMNS) THEN + REWRITE_TAC[ROWS_TRANSP; COLUMNS_TRANSP] THEN ARITH_TAC);; + +let RANK_TRANSP = prove + (`!A:real^M^N. rank(transp A) = rank A`, + GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [RANK_ROW] THEN + REWRITE_TAC[rank; COLUMNS_TRANSP]);; + +let MATRIX_VECTOR_MUL_BASIS = prove + (`!A:real^M^N k. 1 <= k /\ k <= dimindex(:M) + ==> A ** (basis k) = column k A`, + SIMP_TAC[CART_EQ; column; MATRIX_VECTOR_MUL_COMPONENT; DOT_BASIS; + LAMBDA_BETA]);; + +let COLUMNS_IMAGE_BASIS = prove + (`!A:real^M^N. + columns A = IMAGE (\x. A ** x) {basis i | 1 <= i /\ i <= dimindex(:M)}`, + GEN_TAC THEN REWRITE_TAC[columns] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> IMAGE f s = IMAGE g s`) THEN + SIMP_TAC[IN_ELIM_THM; MATRIX_VECTOR_MUL_BASIS]);; + +let RANK_DIM_IM = prove + (`!A:real^M^N. rank A = dim(IMAGE (\x. A ** x) (:real^M))`, + GEN_TAC THEN REWRITE_TAC[rank] THEN + MATCH_MP_TAC SPAN_EQ_DIM THEN REWRITE_TAC[COLUMNS_IMAGE_BASIS] THEN + SIMP_TAC[SPAN_LINEAR_IMAGE; MATRIX_VECTOR_MUL_LINEAR] THEN + AP_TERM_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SPAN_SPAN] THEN + REWRITE_TAC[SPAN_STDBASIS]);; + +let DIM_EQ_SPAN = prove + (`!s t:real^N->bool. s SUBSET t /\ dim t <= dim s ==> span s = span t`, + REPEAT STRIP_TAC THEN + X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC + (ISPEC `span s:real^N->bool` BASIS_EXISTS) THEN + MP_TAC(ISPECL [`span t:real^N->bool`; `b:real^N->bool`] + CARD_GE_DIM_INDEPENDENT) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_REWRITE_TAC[DIM_SPAN] THEN + ASM_MESON_TAC[SPAN_MONO; SPAN_SPAN; SUBSET_TRANS; SUBSET_ANTISYM]);; + +let DIM_EQ_FULL = prove + (`!s:real^N->bool. dim s = dimindex(:N) <=> span s = (:real^N)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN EQ_TAC THEN + SIMP_TAC[DIM_UNIV] THEN DISCH_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_UNIV] THEN MATCH_MP_TAC DIM_EQ_SPAN THEN + ASM_REWRITE_TAC[SUBSET_UNIV; DIM_UNIV] THEN + ASM_MESON_TAC[LE_REFL; DIM_SPAN]);; + +let DIM_PSUBSET = prove + (`!s t. (span s) PSUBSET (span t) ==> dim s < dim t`, + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + SIMP_TAC[PSUBSET; DIM_SUBSET; LT_LE] THEN + MESON_TAC[EQ_IMP_LE; DIM_EQ_SPAN; SPAN_SPAN]);; + +let RANK_BOUND = prove + (`!A:real^M^N. rank(A) <= MIN (dimindex(:M)) (dimindex(:N))`, + GEN_TAC THEN REWRITE_TAC[ARITH_RULE `x <= MIN a b <=> x <= a /\ x <= b`] THEN + CONJ_TAC THENL + [REWRITE_TAC[DIM_SUBSET_UNIV; RANK_ROW]; + REWRITE_TAC[DIM_SUBSET_UNIV; rank]]);; + +let FULL_RANK_INJECTIVE = prove + (`!A:real^M^N. + rank A = dimindex(:M) <=> + (!x y:real^M. A ** x = A ** y ==> x = y)`, + REWRITE_TAC[GSYM MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN + REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_SPAN_ROWS] THEN + REWRITE_TAC[RANK_ROW; DIM_EQ_FULL]);; + +let FULL_RANK_SURJECTIVE = prove + (`!A:real^M^N. + rank A = dimindex(:N) <=> (!y:real^N. ?x:real^M. A ** x = y)`, + REWRITE_TAC[GSYM MATRIX_RIGHT_INVERTIBLE_SURJECTIVE] THEN + REWRITE_TAC[GSYM LEFT_INVERTIBLE_TRANSP] THEN + REWRITE_TAC[MATRIX_LEFT_INVERTIBLE_INJECTIVE] THEN + REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; RANK_TRANSP]);; + +let RANK_I = prove + (`rank(mat 1:real^N^N) = dimindex(:N)`, + REWRITE_TAC[FULL_RANK_INJECTIVE; MATRIX_VECTOR_MUL_LID]);; + +let MATRIX_FULL_LINEAR_EQUATIONS = prove + (`!A:real^M^N b:real^N. + rank A = dimindex(:N) ==> ?x. A ** x = b`, + SIMP_TAC[FULL_RANK_SURJECTIVE]);; + +let MATRIX_NONFULL_LINEAR_EQUATIONS_EQ = prove + (`!A:real^M^N. + (?x. ~(x = vec 0) /\ A ** x = vec 0) <=> ~(rank A = dimindex(:M))`, + REPEAT GEN_TAC THEN REWRITE_TAC[FULL_RANK_INJECTIVE] THEN + SIMP_TAC[LINEAR_INJECTIVE_0; MATRIX_VECTOR_MUL_LINEAR] THEN + MESON_TAC[]);; + +let MATRIX_NONFULL_LINEAR_EQUATIONS = prove + (`!A:real^M^N. + ~(rank A = dimindex(:M)) ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`, + REWRITE_TAC[MATRIX_NONFULL_LINEAR_EQUATIONS_EQ]);; + +let MATRIX_TRIVIAL_LINEAR_EQUATIONS = prove + (`!A:real^M^N. + dimindex(:N) < dimindex(:M) + ==> ?x. ~(x = vec 0) /\ A ** x = vec 0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MATRIX_NONFULL_LINEAR_EQUATIONS THEN + MATCH_MP_TAC(ARITH_RULE + `!a. x <= MIN b a /\ a < b ==> ~(x = b)`) THEN + EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[RANK_BOUND]);; + +let RANK_EQ_0 = prove + (`!A:real^M^N. rank A = 0 <=> A = mat 0`, + REWRITE_TAC[RANK_DIM_IM; DIM_EQ_0; SUBSET; FORALL_IN_IMAGE; IN_SING; + IN_UNIV] THEN + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [CART_EQ] THEN + SIMP_TAC[CART_EQ; MATRIX_MUL_DOT; VEC_COMPONENT; LAMBDA_BETA; mat] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_DOT_EQ_0; COND_ID] THEN + REWRITE_TAC[CART_EQ; VEC_COMPONENT]);; + +let RANK_0 = prove + (`rank(mat 0) = 0`, + REWRITE_TAC[RANK_EQ_0]);; + +let RANK_MUL_LE_RIGHT = prove + (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(B)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `dim(IMAGE (\y. (A:real^N^M) ** y) + (IMAGE (\x. (B:real^P^N) ** x) (:real^P)))` THEN + REWRITE_TAC[RANK_DIM_IM] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; MATRIX_VECTOR_MUL_ASSOC; LE_REFL]; + MATCH_MP_TAC DIM_LINEAR_IMAGE_LE THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]]);; + +let RANK_MUL_LE_LEFT = prove + (`!A:real^N^M B:real^P^N. rank(A ** B) <= rank(A)`, + ONCE_REWRITE_TAC[GSYM RANK_TRANSP] THEN + REWRITE_TAC[MATRIX_TRANSP_MUL] THEN + REWRITE_TAC[RANK_MUL_LE_RIGHT]);; + +(* ------------------------------------------------------------------------- *) +(* Some bounds on components etc. relative to operator norm. *) +(* ------------------------------------------------------------------------- *) + +let NORM_COLUMN_LE_ONORM = prove + (`!A:real^N^M i. norm(column i A) <= onorm(\x. A ** x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[column] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$i = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPEC `\x:real^N. (A:real^N^M) ** x` ONORM) THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR] THEN + DISCH_THEN(MP_TAC o SPEC `basis l:real^N` o CONJUNCT1) THEN + ASM_SIMP_TAC[MATRIX_VECTOR_MUL_BASIS; NORM_BASIS; column; REAL_MUL_RID]);; + +let MATRIX_COMPONENT_LE_ONORM = prove + (`!A:real^N^M i j. abs(A$i$j) <= onorm(\x. A ** x)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:M) /\ !A:real^N^M. A$i = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$j = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(column l (A:real^N^M))` THEN + REWRITE_TAC[NORM_COLUMN_LE_ONORM] THEN + MP_TAC(ISPECL [`column l (A:real^N^M)`; `k:num`] + COMPONENT_LE_NORM) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + ASM_SIMP_TAC[column; LAMBDA_BETA; REAL_LE_REFL]);; + +let COMPONENT_LE_ONORM = prove + (`!f:real^M->real^N i j. linear f ==> abs(matrix f$i$j) <= onorm f`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) + [MATCH_MP MATRIX_VECTOR_MUL th]) THEN + REWRITE_TAC[MATRIX_COMPONENT_LE_ONORM]);; + +(* ------------------------------------------------------------------------- *) +(* Basic lemmas about hyperplanes and halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let HYPERPLANE_EQ_EMPTY = prove + (`!a:real^N b. {x | a dot x = b} = {} <=> a = vec 0 /\ ~(b = &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL + [MESON_TAC[]; + DISCH_THEN(MP_TAC o SPEC `b / (a dot a) % a:real^N`) THEN + ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0]]);; + +let HYPERPLANE_EQ_UNIV = prove + (`!a b. {x | a dot x = b} = (:real^N) <=> a = vec 0 /\ b = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + ASM_CASES_TAC `a:real^N = vec 0` THEN ASM_REWRITE_TAC[DOT_LZERO] THENL + [MESON_TAC[]; + DISCH_THEN(MP_TAC o SPEC `(b + &1) / (a dot a) % a:real^N`) THEN + ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN REAL_ARITH_TAC]);; + +let HALFSPACE_EQ_EMPTY_LT = prove + (`!a:real^N b. {x | a dot x < b} = {} <=> a = vec 0 /\ b <= &0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN + COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN + ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN + REAL_ARITH_TAC]);; + +let HALFSPACE_EQ_EMPTY_GT = prove + (`!a:real^N b. {x | a dot x > b} = {} <=> a = vec 0 /\ b >= &0`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LT) THEN + SIMP_TAC[real_gt; DOT_LNEG; REAL_LT_NEG2; VECTOR_NEG_EQ_0] THEN + DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let HALFSPACE_EQ_EMPTY_LE = prove + (`!a:real^N b. {x | a dot x <= b} = {} <=> a = vec 0 /\ b < &0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THENL + [ASM_SIMP_TAC[DOT_LZERO; SET_RULE `{x | p} = if p then UNIV else {}`] THEN + COND_CASES_TAC THEN REWRITE_TAC[UNIV_NOT_EMPTY] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(b - &1) / (a dot a) % a:real^N` THEN + ASM_SIMP_TAC[DOT_RMUL; REAL_DIV_RMUL; DOT_EQ_0] THEN + REAL_ARITH_TAC]);; + +let HALFSPACE_EQ_EMPTY_GE = prove + (`!a:real^N b. {x | a dot x >= b} = {} <=> a = vec 0 /\ b > &0`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] HALFSPACE_EQ_EMPTY_LE) THEN + SIMP_TAC[real_ge; DOT_LNEG; REAL_LE_NEG2; VECTOR_NEG_EQ_0] THEN + DISCH_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A non-injective linear function maps into a hyperplane. *) +(* ------------------------------------------------------------------------- *) + +let ADJOINT_INJECTIVE = prove + (`!f:real^M->real^N. + linear f + ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=> + (!y. ?x. f x = y))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS o MATCH_MP + ADJOINT_LINEAR) THEN + FIRST_ASSUM(ASSUME_TAC o GSYM o MATCH_MP MATRIX_WORKS) THEN + ASM_REWRITE_TAC[GSYM FULL_RANK_INJECTIVE; GSYM FULL_RANK_SURJECTIVE] THEN + ASM_SIMP_TAC[MATRIX_ADJOINT; RANK_TRANSP]);; + +let ADJOINT_SURJECTIVE = prove + (`!f:real^M->real^N. + linear f + ==> ((!y. ?x. adjoint f x = y) <=> (!x y. f x = f y ==> x = y))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) + [GSYM(MATCH_MP ADJOINT_ADJOINT th)]) THEN + ASM_SIMP_TAC[ADJOINT_INJECTIVE; ADJOINT_LINEAR]);; + +let ADJOINT_INJECTIVE_INJECTIVE = prove + (`!f:real^N->real^N. + linear f + ==> ((!x y. adjoint f x = adjoint f y ==> x = y) <=> + (!x y. f x = f y ==> x = y))`, + SIMP_TAC[ADJOINT_INJECTIVE] THEN + MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE; + LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let ADJOINT_INJECTIVE_INJECTIVE_0 = prove + (`!f:real^N->real^N. + linear f + ==> ((!x. adjoint f x = vec 0 ==> x = vec 0) <=> + (!x. f x = vec 0 ==> x = vec 0))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ADJOINT_INJECTIVE_INJECTIVE) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ADJOINT_LINEAR) THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_0]);; + +let LINEAR_SINGULAR_INTO_HYPERPLANE = prove + (`!f:real^N->real^N. + linear f + ==> (~(!x y. f(x) = f(y) ==> x = y) <=> + ?a. ~(a = vec 0) /\ !x. a dot f(x) = &0)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[DOT_SYM] THEN + ASM_SIMP_TAC[ADJOINT_WORKS; FORALL_DOT_EQ_0] THEN + REWRITE_TAC[MESON[] `(?a. ~p a /\ q a) <=> ~(!a. q a ==> p a)`] THEN + ASM_SIMP_TAC[ADJOINT_INJECTIVE_INJECTIVE_0; LINEAR_INJECTIVE_0]);; + +let LINEAR_SINGULAR_IMAGE_HYPERPLANE = prove + (`!f:real^N->real^N. + linear f /\ ~(!x y. f(x) = f(y) ==> x = y) + ==> ?a. ~(a = vec 0) /\ !s. IMAGE f s SUBSET {x | a dot x = &0}`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[LINEAR_SINGULAR_INTO_HYPERPLANE] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; + +let LOWDIM_EXPAND_DIMENSION = prove + (`!s:real^N->bool n. + dim s <= n /\ n <= dimindex(:N) + ==> ?t. dim(t) = n /\ span s SUBSET span t`, + GEN_TAC THEN + GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV o LAND_CONV) [LE_EXISTS] THEN + SIMP_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + INDUCT_TAC THENL [MESON_TAC[ADD_CLAUSES; SUBSET_REFL]; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `s + SUC d <= n <=> s + d < n`] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[LT_IMP_LE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[ADD_CLAUSES] THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN `~(span t = (:real^N))` MP_TAC THENL + [REWRITE_TAC[GSYM DIM_EQ_FULL] THEN ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_UNIV; NOT_FORALL_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `(a:real^N) INSERT t` THEN ASM_REWRITE_TAC[DIM_INSERT; ADD1] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `span(t:real^N->bool)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]);; + +let LOWDIM_EXPAND_BASIS = prove + (`!s:real^N->bool n. + dim s <= n /\ n <= dimindex(:N) + ==> ?b. b HAS_SIZE n /\ independent b /\ span s SUBSET span b`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC o + MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN + MP_TAC(ISPEC `t:real^N->bool` BASIS_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SPAN_SPAN; SUBSET_TRANS; SPAN_MONO]);; + +(* ------------------------------------------------------------------------- *) +(* Orthogonal bases, Gram-Schmidt process, and related theorems. *) +(* ------------------------------------------------------------------------- *) + +let SPAN_DELETE_0 = prove + (`!s:real^N->bool. span(s DELETE vec 0) = span s`, + GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[DELETE_SUBSET; SPAN_MONO] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `span((vec 0:real^N) INSERT (s DELETE vec 0))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_MONO THEN SET_TAC[]; + SIMP_TAC[SUBSET; SPAN_BREAKDOWN_EQ; VECTOR_MUL_RZERO; VECTOR_SUB_RZERO]]);; + +let SPAN_IMAGE_SCALE = prove + (`!c s. FINITE s /\ (!x. x IN s ==> ~(c x = &0)) + ==> span (IMAGE (\x:real^N. c(x) % x) s) = span s`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[IMAGE_CLAUSES; SPAN_BREAKDOWN_EQ; EXTENSION; FORALL_IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `t:real^N->bool`] THEN + STRIP_TAC THEN STRIP_TAC THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN + EXISTS_TAC `k / (c:real^N->real) x` THEN + ASM_SIMP_TAC[REAL_DIV_RMUL]);; + +let PAIRWISE_ORTHOGONAL_INDEPENDENT = prove + (`!s:real^N->bool. + pairwise orthogonal s /\ ~(vec 0 IN s) ==> independent s`, + REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[independent; dependent] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[SPAN_EXPLICIT; IN_ELIM_THM; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:real^N->real`] THEN + REWRITE_TAC[SUBSET; IN_DELETE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\x:real^N. a dot x`) THEN + ASM_SIMP_TAC[DOT_RSUM; DOT_RMUL; REAL_MUL_RZERO; SUM_0] THEN + ASM_MESON_TAC[DOT_EQ_0]);; + +let PAIRWISE_ORTHOGONAL_IMP_FINITE = prove + (`!s:real^N->bool. pairwise orthogonal s ==> FINITE s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `independent (s DELETE (vec 0:real^N))` MP_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + REWRITE_TAC[IN_DELETE] THEN MATCH_MP_TAC PAIRWISE_MONO THEN + EXISTS_TAC `s:real^N->bool` THEN + ASM_SIMP_TAC[SUBSET; IN_DELETE]; + DISCH_THEN(MP_TAC o MATCH_MP INDEPENDENT_IMP_FINITE) THEN + REWRITE_TAC[FINITE_DELETE]]);; + +let GRAM_SCHMIDT_STEP = prove + (`!s a x. + pairwise orthogonal s /\ x IN span s + ==> orthogonal x (a - vsum s (\b:real^N. (b dot a) / (b dot b) % b))`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN + X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `x:real^N`] THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN + REWRITE_TAC[orthogonal; DOT_RSUB] THEN ASM_SIMP_TAC[DOT_RSUM] THEN + REWRITE_TAC[REAL_SUB_0; DOT_RMUL] THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum s (\y:real^N. if y = x then y dot a else &0)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[SUM_DELTA; DOT_SYM]; ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN + ASM_CASES_TAC `x:real^N = y` THEN ASM_SIMP_TAC[DOT_LMUL; REAL_MUL_RZERO] THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; DOT_EQ_0; DOT_LZERO; REAL_MUL_RZERO]);; + +let ORTHOGONAL_EXTENSION = prove + (`!s t:real^N->bool. + pairwise orthogonal s + ==> ?u. pairwise orthogonal (s UNION u) /\ + span (s UNION u) = span (s UNION t)`, + let lemma = prove + (`!t s:real^N->bool. + FINITE t /\ FINITE s /\ pairwise orthogonal s + ==> ?u. pairwise orthogonal (s UNION u) /\ + span (s UNION u) = span (s UNION t)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `{}:real^N->bool` THEN + ASM_REWRITE_TAC[UNION_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `t:real^N->bool`] THEN + REWRITE_TAC[pairwise; orthogonal] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC `a' = a - vsum s (\b:real^N. (b dot a) / (b dot b) % b)` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a':real^N) INSERT s`) THEN + ASM_REWRITE_TAC[FINITE_INSERT] THEN ANTS_TAC THENL + [SUBGOAL_THEN `!x:real^N. x IN s ==> a' dot x = &0` + (fun th -> REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[DOT_SYM; th]) THEN + REPEAT STRIP_TAC THEN EXPAND_TAC "a'" THEN + REWRITE_TAC[GSYM orthogonal] THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN + MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN + ASM_SIMP_TAC[pairwise; orthogonal; SPAN_CLAUSES]; + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(a':real^N) INSERT u` THEN + ASM_REWRITE_TAC[SET_RULE `s UNION a INSERT u = a INSERT s UNION u`] THEN + REWRITE_TAC[SET_RULE `(x INSERT s) UNION t = x INSERT (s UNION t)`] THEN + MATCH_MP_TAC EQ_SPAN_INSERT_EQ THEN EXPAND_TAC "a'" THEN + REWRITE_TAC[VECTOR_ARITH `a - x - a:real^N = --x`] THEN + MATCH_MP_TAC SPAN_NEG THEN MATCH_MP_TAC SPAN_VSUM THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SPAN_MUL THEN ASM_SIMP_TAC[SPAN_SUPERSET; IN_UNION]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `span t:real^N->bool` BASIS_SUBSPACE_EXISTS) THEN + REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] lemma) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[HAS_SIZE; PAIRWISE_ORTHOGONAL_IMP_FINITE]; + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[SPAN_UNION]]);; + +let ORTHOGONAL_EXTENSION_STRONG = prove + (`!s t:real^N->bool. + pairwise orthogonal s + ==> ?u. DISJOINT u (vec 0 INSERT s) /\ + pairwise orthogonal (s UNION u) /\ + span (s UNION u) = span (s UNION t)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u DIFF ((vec 0:real^N) INSERT s)` THEN REPEAT CONJ_TAC THENL + [SET_TAC[]; + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + PAIRWISE_MONO)) THEN SET_TAC[]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC BINOP_CONV [GSYM SPAN_DELETE_0] THEN + AP_TERM_TAC THEN SET_TAC[]]);; + +let ORTHONORMAL_EXTENSION = prove + (`!s t:real^N->bool. + pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1) + ==> ?u. DISJOINT u s /\ + pairwise orthogonal (s UNION u) /\ + (!x. x IN u ==> norm x = &1) /\ + span(s UNION u) = span(s UNION t)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPEC `t:real^N->bool` o MATCH_MP ORTHOGONAL_EXTENSION_STRONG) THEN + REWRITE_TAC[SET_RULE `DISJOINT u s <=> !x. x IN u ==> ~(x IN s)`] THEN + REWRITE_TAC[IN_INSERT; DE_MORGAN_THM; pairwise] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) u` THEN + REWRITE_TAC[FORALL_IN_IMAGE; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ASM_CASES_TAC `norm(x:real^N) = &1` THEN + ASM_SIMP_TAC[REAL_INV_1; VECTOR_MUL_LID] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^N`; `inv(norm x) % x:real^N`]) THEN + ASM_REWRITE_TAC[IN_UNION; VECTOR_MUL_EQ_0; REAL_SUB_0; REAL_INV_EQ_1; + VECTOR_ARITH `x:real^N = a % x <=> (a - &1) % x = vec 0`] THEN + ASM_CASES_TAC `x:real^N = vec 0` THENL + [ASM_MESON_TAC[VECTOR_MUL_RZERO]; + ASM_REWRITE_TAC[orthogonal; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0] THEN + ASM_REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0]]; + REWRITE_TAC[IN_UNION; IN_IMAGE] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[orthogonal; DOT_LMUL; DOT_RMUL; REAL_ENTIRE; DOT_EQ_0; + REAL_INV_EQ_0; NORM_EQ_0] THEN + REWRITE_TAC[GSYM orthogonal] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_UNION] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[NORM_MUL; REAL_MUL_LINV; NORM_EQ_0; REAL_ABS_INV; + REAL_ABS_NORM]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[SPAN_EQ; UNION_SUBSET] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; SPAN_SUPERSET; SPAN_MUL; IN_UNION] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `x:real^N = norm(x) % inv(norm x) % x` + (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) + THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; NORM_EQ_0; VECTOR_MUL_LID]; + MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN + REWRITE_TAC[IN_UNION; IN_IMAGE] THEN ASM_MESON_TAC[]]]);; + +let VECTOR_IN_ORTHOGONAL_SPANNINGSET = prove + (`!a. ?s. a IN s /\ pairwise orthogonal s /\ span s = (:real^N)`, + GEN_TAC THEN + MP_TAC(ISPECL [`{a:real^N}`; `(IMAGE basis (1..dimindex(:N))):real^N->bool`] + ORTHOGONAL_EXTENSION) THEN + REWRITE_TAC[PAIRWISE_SING] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{a:real^N} UNION u` THEN ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN + MATCH_MP_TAC(SET_RULE `!s. s = UNIV /\ s SUBSET t ==> t = UNIV`) THEN + EXISTS_TAC `span {basis i:real^N | 1 <= i /\ i <= dimindex (:N)}` THEN + CONJ_TAC THENL [REWRITE_TAC[SPAN_STDBASIS]; MATCH_MP_TAC SPAN_MONO] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM IN_NUMSEG] THEN SET_TAC[]);; + +let VECTOR_IN_ORTHOGONAL_BASIS = prove + (`!a. ~(a = vec 0) + ==> ?s. a IN s /\ ~(vec 0 IN s) /\ + pairwise orthogonal s /\ + independent s /\ + s HAS_SIZE (dimindex(:N)) /\ + span s = (:real^N)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `a:real^N` VECTOR_IN_ORTHOGONAL_SPANNINGSET) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; IN_DELETE]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_DELETE_0]; + DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]]);; + +let VECTOR_IN_ORTHONORMAL_BASIS = prove + (`!a. norm a = &1 + ==> ?s. a IN s /\ + pairwise orthogonal s /\ + (!x. x IN s ==> norm x = &1) /\ + independent s /\ + s HAS_SIZE (dimindex(:N)) /\ + span s = (:real^N)`, + GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; REAL_OF_NUM_EQ; ARITH_EQ] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP VECTOR_IN_ORTHOGONAL_BASIS) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) s` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `a:real^N` THEN + ASM_REWRITE_TAC[REAL_INV_1; VECTOR_MUL_LID]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_MESON_TAC[ORTHOGONAL_CLAUSES]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_UNIV]] THEN + UNDISCH_THEN `span s = (:real^N)` (SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SPAN_IMAGE_SCALE THEN + REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN + ASM_MESON_TAC[HAS_SIZE]);; + +let BESSEL_INEQUALITY = prove + (`!s x:real^N. + pairwise orthogonal s /\ (!x. x IN s ==> norm x = &1) + ==> sum s (\e. (e dot x) pow 2) <= norm(x) pow 2`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN + MP_TAC(ISPEC `x - vsum s (\e. (e dot x) % e):real^N` DOT_POS_LE) THEN + REWRITE_TAC[NORM_POW_2; VECTOR_ARITH + `(a - b:real^N) dot (a - b) = a dot a + b dot b - &2 * b dot a`] THEN + ASM_SIMP_TAC[DOT_LSUM; REAL_POW_2; DOT_LMUL] THEN + MATCH_MP_TAC(REAL_ARITH `t = s ==> &0 <= x + t - &2 * s ==> s <= x`) THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `e:real^N` THEN DISCH_TAC THEN + ASM_SIMP_TAC[DOT_RSUM] THEN AP_TERM_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum s (\k:real^N. if k = e then e dot x else &0)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[DOT_RMUL] THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[REAL_RING `a * x = a <=> a = &0 \/ x = &1`] THEN + DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real^N`) THEN + ASM_REWRITE_TAC[NORM_EQ_SQUARE] THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN + ASM_SIMP_TAC[REAL_ENTIRE]]);; + +(* ------------------------------------------------------------------------- *) +(* Analogous theorems for existence of orthonormal basis for a subspace. *) +(* ------------------------------------------------------------------------- *) + +let ORTHOGONAL_SPANNINGSET_SUBSPACE = prove + (`!s:real^N->bool. + subspace s + ==> ?b. b SUBSET s /\ pairwise orthogonal b /\ span b = s`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL[`{}:real^N->bool`; `b:real^N->bool`] ORTHOGONAL_EXTENSION) THEN + REWRITE_TAC[PAIRWISE_EMPTY; UNION_EMPTY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_SUBSPACE THEN ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_MESON_TAC[SPAN_INC]]);; + +let ORTHOGONAL_BASIS_SUBSPACE = prove + (`!s:real^N->bool. + subspace s + ==> ?b. ~(vec 0 IN b) /\ + b SUBSET s /\ + pairwise orthogonal b /\ + independent b /\ + b HAS_SIZE (dim s) /\ + span b = s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_SPANNINGSET_SUBSPACE) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b DELETE (vec 0:real^N)` THEN ASM_REWRITE_TAC[IN_DELETE] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; IN_DELETE]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_SIMP_TAC[IN_DELETE]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_DELETE_0]; + DISCH_TAC THEN ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]]);; + +let ORTHONORMAL_BASIS_SUBSPACE = prove + (`!s:real^N->bool. + subspace s + ==> ?b. b SUBSET s /\ + pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1) /\ + independent b /\ + b HAS_SIZE (dim s) /\ + span b = s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_BASIS_SUBSPACE) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\x:real^N. inv(norm x) % x) b` THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[SPAN_MUL; SPAN_INC; SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_MESON_TAC[ORTHOGONAL_CLAUSES]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE; NORM_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_MESON_TAC[REAL_MUL_LINV; NORM_EQ_0]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_IMAGE] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + SIMP_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0; NORM_EQ_0] THEN ASM_MESON_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[BASIS_HAS_SIZE_DIM]] THEN + UNDISCH_THEN `span b = (s:real^N->bool)` (SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SPAN_IMAGE_SCALE THEN + REWRITE_TAC[REAL_INV_EQ_0; NORM_EQ_0] THEN + ASM_MESON_TAC[HAS_SIZE]);; + +let ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN = prove + (`!s t:real^N->bool. + span s PSUBSET span t + ==> ?x. ~(x = vec 0) /\ x IN span t /\ + (!y. y IN span s ==> orthogonal x y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN + REWRITE_TAC[SUBSPACE_SPAN] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [PSUBSET_ALT]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `u:real^N` STRIP_ASSUME_TAC)) THEN + MP_TAC(ISPECL [`b:real^N->bool`; `{u:real^N}`] ORTHOGONAL_EXTENSION) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `ns:real^N->bool` MP_TAC) THEN + ASM_CASES_TAC `ns SUBSET (vec 0:real^N) INSERT b` THENL + [DISCH_THEN(MP_TAC o AP_TERM `(IN) (u:real^N)` o CONJUNCT2) THEN + SIMP_TAC[SPAN_SUPERSET; IN_UNION; IN_SING] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + SUBGOAL_THEN `~(u IN span (b UNION {vec 0:real^N}))` MP_TAC THENL + [ASM_REWRITE_TAC[SET_RULE `s UNION {a} = a INSERT s`; SPAN_INSERT_0]; + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(x IN t) ==> ~(x IN s)`) THEN + MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s SUBSET t) ==> ?z. z IN s /\ ~(z IN t)`)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IN_INSERT; DE_MORGAN_THM] THEN + X_GEN_TAC `n:real^N` THEN STRIP_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + DISCH_THEN(MP_TAC o SPEC `n:real^N`) THEN ASM_REWRITE_TAC[IN_UNION] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_TAC THEN EXISTS_TAC `n:real^N` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(n:real^N) IN span (b UNION ns)` MP_TAC THENL + [MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]; + ASM_REWRITE_TAC[] THEN SPEC_TAC(`n:real^N`,`n:real^N`) THEN + REWRITE_TAC[GSYM SUBSET] THEN + MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN + ASM_REWRITE_TAC[SET_RULE + `s UNION {a} SUBSET t <=> s SUBSET t /\ a IN t`] THEN + ASM_MESON_TAC[SPAN_INC; SUBSET_TRANS]]; + MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[SET_RULE `(\y. orthogonal n y) = {y | orthogonal n y}`] THEN + REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN ASM SET_TAC[]]);; + +let ORTHOGONAL_TO_SUBSPACE_EXISTS = prove + (`!s:real^N->bool. dim s < dimindex(:N) + ==> ?x. ~(x = vec 0) /\ !y. y IN s ==> orthogonal x y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `(:real^N)`] + ORTHOGONAL_TO_SUBSPACE_EXISTS_GEN) THEN + ANTS_TAC THENL [REWRITE_TAC[PSUBSET]; MESON_TAC[SPAN_SUPERSET]] THEN + REWRITE_TAC[SPAN_UNIV; SUBSET_UNIV] THEN + ASM_MESON_TAC[DIM_SPAN; DIM_UNIV; LT_REFL]);; + +let ORTHOGONAL_TO_VECTOR_EXISTS = prove + (`!x:real^N. 2 <= dimindex(:N) ==> ?y. ~(y = vec 0) /\ orthogonal x y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{x:real^N}` ORTHOGONAL_TO_SUBSPACE_EXISTS) THEN + SIMP_TAC[DIM_SING; IN_SING; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; MESON_TAC[ORTHOGONAL_SYM]]);; + +let SPAN_NOT_UNIV_ORTHOGONAL = prove + (`!s. ~(span s = (:real^N)) + ==> ?a. ~(a = vec 0) /\ !x. x IN span s ==> a dot x = &0`, + REWRITE_TAC[GSYM DIM_EQ_FULL; GSYM LE_ANTISYM; DIM_SUBSET_UNIV; + NOT_LE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM orthogonal] THEN + MATCH_MP_TAC ORTHOGONAL_TO_SUBSPACE_EXISTS THEN ASM_REWRITE_TAC[DIM_SPAN]);; + +let SPAN_NOT_UNIV_SUBSET_HYPERPLANE = prove + (`!s. ~(span s = (:real^N)) + ==> ?a. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`, + REWRITE_TAC[SUBSET; IN_ELIM_THM; SPAN_NOT_UNIV_ORTHOGONAL]);; + +let LOWDIM_SUBSET_HYPERPLANE = prove + (`!s. dim s < dimindex(:N) + ==> ?a:real^N. ~(a = vec 0) /\ span s SUBSET {x | a dot x = &0}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SPAN_NOT_UNIV_SUBSET_HYPERPLANE THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIM_SUBSET) THEN + ASM_REWRITE_TAC[NOT_LE; DIM_SPAN; DIM_UNIV]);; + +let VECTOR_EQ_DOT_SPAN = prove + (`!b x y:real^N. + (!v. v IN b ==> v dot x = v dot y) /\ x IN span b /\ y IN span b + ==> x = y`, + ONCE_REWRITE_TAC[GSYM REAL_SUB_0; GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM DOT_RSUB; GSYM ORTHOGONAL_REFL; GSYM orthogonal] THEN + MESON_TAC[ORTHOGONAL_TO_SPAN; SPAN_SUB; ORTHOGONAL_SYM]);; + +let ORTHONORMAL_BASIS_EXPAND = prove + (`!b x:real^N. + pairwise orthogonal b /\ (!v. v IN b ==> norm v = &1) /\ x IN span b + ==> vsum b (\v. (v dot x) % v) = x`, + REWRITE_TAC[NORM_EQ_1] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC VECTOR_EQ_DOT_SPAN THEN EXISTS_TAC `b:real^N->bool` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PAIRWISE_ORTHOGONAL_IMP_FINITE) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise; orthogonal]) THEN + ASM_SIMP_TAC[SPAN_VSUM; SPAN_MUL; DOT_RSUM; DOT_RMUL; SPAN_SUPERSET] THEN + X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN + TRANS_TAC EQ_TRANS `sum b (\w:real^N. if w = v then v dot x else &0)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_SIMP_TAC[SUM_DELTA]] THEN + MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `w:real^N` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[REAL_MUL_RID; REAL_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Decomposing a vector into parts in orthogonal subspaces. *) +(* ------------------------------------------------------------------------- *) + +let ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE = prove + (`!s t x y x' y':real^N. + (!a b. a IN s /\ b IN t ==> orthogonal a b) /\ + x IN span s /\ x' IN span s /\ y IN span t /\ y' IN span t /\ + x + y = x' + y' + ==> x = x' /\ y = y'`, + REWRITE_TAC[VECTOR_ARITH `x + y:real^N = x' + y' <=> x - x' = y' - y`] THEN + ONCE_REWRITE_TAC[GSYM ORTHOGONAL_TO_SPANS_EQ] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[VECTOR_ARITH + `x:real^N = x' /\ y:real^N = y' <=> x - x' = vec 0 /\ y' - y = vec 0`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[GSYM ORTHOGONAL_REFL] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + ASM_MESON_TAC[ORTHOGONAL_CLAUSES; ORTHOGONAL_SYM]);; + +let ORTHOGONAL_SUBSPACE_DECOMP_EXISTS = prove + (`!s x:real^N. ?y z. y IN span s /\ (!w. w IN span s ==> orthogonal z w) /\ + x = y + z`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `span s:real^N->bool` ORTHOGONAL_BASIS_SUBSPACE) THEN + REWRITE_TAC[SUBSPACE_SPAN; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + EXISTS_TAC `vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN + EXISTS_TAC `x - vsum t (\b:real^N. (b dot x) / (b dot b) % b)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SPAN_VSUM THEN + ASM_SIMP_TAC[INDEPENDENT_IMP_FINITE; SPAN_CLAUSES]; + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ORTHOGONAL_SYM] THEN + MATCH_MP_TAC GRAM_SCHMIDT_STEP THEN ASM_SIMP_TAC[]; + VECTOR_ARITH_TAC]);; + +let ORTHOGONAL_SUBSPACE_DECOMP = prove + (`!s x. ?!(y,z). y IN span s /\ + z IN {z:real^N | !x. x IN span s ==> orthogonal z x} /\ + x = y + z`, + REWRITE_TAC[EXISTS_UNIQUE_DEF; IN_ELIM_THM] THEN + REWRITE_TAC[EXISTS_PAIRED_THM; FORALL_PAIRED_THM] THEN + REWRITE_TAC[FORALL_PAIR_THM; ORTHOGONAL_SUBSPACE_DECOMP_EXISTS] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[PAIR_EQ] THEN + MATCH_MP_TAC ORTHOGONAL_SUBSPACE_DECOMP_UNIQUE THEN + MAP_EVERY EXISTS_TAC + [`s:real^N->bool`; `{z:real^N | !x. x IN span s ==> orthogonal z x}`] THEN + ASM_SIMP_TAC[SPAN_CLAUSES; IN_ELIM_THM] THEN + ASM_MESON_TAC[SPAN_CLAUSES; ORTHOGONAL_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of isometry between subspaces of same dimension. *) +(* ------------------------------------------------------------------------- *) + +let ISOMETRY_SUBSET_SUBSPACE = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t /\ dim s <= dim t + ==> ?f. linear f /\ IMAGE f s SUBSET t /\ + (!x. x IN s ==> norm(f x) = norm(x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN + MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN + ASM_REWRITE_TAC[HAS_SIZE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_LE_INJ) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; INJECTIVE_ON_ALT] THEN + X_GEN_TAC `fb:real^M->real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`] + LINEAR_INDEPENDENT_EXTEND) THEN + ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM; INJECTIVE_ON_ALT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN + REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN + MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]; + UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[SPAN_FINITE] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN + REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN + ASM_SIMP_TAC[LINEAR_CMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o rand o snd) THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[]; + REPEAT(DISCH_THEN SUBST1_TAC) THEN ASM_SIMP_TAC[NORM_MUL] THEN + MATCH_MP_TAC SUM_EQ THEN ASM SET_TAC[]]]);; + +let ISOMETRIES_SUBSPACES = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t /\ dim s = dim t + ==> ?f g. linear f /\ linear g /\ + IMAGE f s = t /\ IMAGE g t = s /\ + (!x. x IN s ==> norm(f x) = norm x) /\ + (!y. y IN t ==> norm(g y) = norm y) /\ + (!x. x IN s ==> g(f x) = x) /\ + (!y. y IN t ==> f(g y) = y)`, + REPEAT STRIP_TAC THEN ABBREV_TAC `n = dim(t:real^N->bool)` THEN + MP_TAC(ISPEC `t:real^N->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN + MP_TAC(ISPEC `s:real^M->bool` ORTHONORMAL_BASIS_SUBSPACE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`b:real^M->bool`; `c:real^N->bool`] CARD_EQ_BIJECTIONS) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`fb:real^M->real^N`; `gb:real^N->real^M`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`gb:real^N->real^M`; `c:real^N->bool`] + LINEAR_INDEPENDENT_EXTEND) THEN + MP_TAC(ISPECL [`fb:real^M->real^N`; `b:real^M->bool`] + LINEAR_INDEPENDENT_EXTEND) THEN + ASM_REWRITE_TAC[IMP_IMP; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN + REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN + AP_TERM_TAC THEN ASM SET_TAC[]; + REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN + REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN + AP_TERM_TAC THEN ASM SET_TAC[]; + UNDISCH_THEN `span b:real^M->bool = s` (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[SPAN_FINITE] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:real^M`; `u:real^M->real`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN + REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN + ASM_SIMP_TAC[LINEAR_CMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o rand o snd) THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[]; + REPEAT(DISCH_THEN SUBST1_TAC) THEN + ASM_SIMP_TAC[NORM_MUL]]; + UNDISCH_THEN `span c:real^N->bool = t` (SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[SPAN_FINITE] THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`z:real^N`; `u:real^N->real`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_SIMP_TAC[LINEAR_VSUM] THEN + REWRITE_TAC[o_DEF; NORM_EQ_SQUARE; NORM_POS_LE; GSYM NORM_POW_2] THEN + ASM_SIMP_TAC[LINEAR_CMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o rand o snd) THEN + W(MP_TAC o PART_MATCH (lhand o rand) + NORM_VSUM_PYTHAGOREAN o lhand o rand o snd) THEN + RULE_ASSUM_TAC(REWRITE_RULE[pairwise]) THEN + ASM_SIMP_TAC[pairwise; ORTHOGONAL_CLAUSES] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[ORTHOGONAL_MUL] THEN ASM SET_TAC[]; + REPEAT(DISCH_THEN SUBST1_TAC) THEN + ASM_SIMP_TAC[NORM_MUL]]; + REWRITE_TAC[SYM(ASSUME `span b:real^M->bool = s`)] THEN + MATCH_MP_TAC SPAN_INDUCT THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN + REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0]; + REWRITE_TAC[SYM(ASSUME `span c:real^N->bool = t`)] THEN + MATCH_MP_TAC SPAN_INDUCT THEN + CONJ_TAC THENL [ASM_MESON_TAC[SUBSET; IN]; ALL_TAC] THEN + REWRITE_TAC[subspace; IN] THEN ASM_MESON_TAC[linear; LINEAR_0]]);; + +let ISOMETRY_SUBSPACES = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t /\ dim s = dim t + ==> ?f:real^M->real^N. linear f /\ IMAGE f s = t /\ + (!x. x IN s ==> norm(f x) = norm(x))`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; + +let ISOMETRY_UNIV_SUBSPACE = prove + (`!s. subspace s /\ dimindex(:M) = dim s + ==> ?f:real^M->real^N. + linear f /\ IMAGE f (:real^M) = s /\ + (!x. norm(f x) = norm(x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^M)`; `s:real^N->bool`] ISOMETRY_SUBSPACES) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);; + +let ISOMETRY_UNIV_SUPERSET_SUBSPACE = prove + (`!s. subspace s /\ dim s <= dimindex(:M) /\ dimindex(:M) <= dimindex(:N) + ==> ?f:real^M->real^N. + linear f /\ s SUBSET (IMAGE f (:real^M)) /\ + (!x. norm(f x) = norm(x))`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LOWDIM_EXPAND_DIMENSION) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`(:real^M)`; `span t:real^N->bool`] ISOMETRY_SUBSPACES) THEN + ASM_REWRITE_TAC[SUBSPACE_SPAN; SUBSPACE_UNIV; DIM_UNIV; DIM_SPAN] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[IN_UNIV] THEN + ASM_MESON_TAC[SUBSET; SPAN_INC]);; + +let ISOMETRY_UNIV_UNIV = prove + (`dimindex(:M) <= dimindex(:N) + ==> ?f:real^M->real^N. linear f /\ (!x. norm(f x) = norm(x))`, + DISCH_TAC THEN + MP_TAC(ISPEC `{vec 0:real^N}`ISOMETRY_UNIV_SUPERSET_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_TRIVIAL] THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC(ARITH_RULE `x = 0 /\ 1 <= y ==> x <= y`) THEN + ASM_REWRITE_TAC[DIM_EQ_0; DIMINDEX_GE_1] THEN SET_TAC[]);; + +let SUBSPACE_ISOMORPHISM = prove + (`!s t. subspace s /\ subspace t /\ dim(s) = dim(t) + ==> ?f:real^M->real^N. + linear f /\ (IMAGE f s = t) /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> (x = y))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ISOMETRY_SUBSPACES) THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE] THEN MESON_TAC[NORM_EQ_0]);; + +let ISOMORPHISMS_UNIV_UNIV = prove + (`dimindex(:M) = dimindex(:N) + ==> ?f:real^M->real^N g. + linear f /\ linear g /\ + (!x. norm(f x) = norm x) /\ (!y. norm(g y) = norm y) /\ + (!x. g(f x) = x) /\ (!y. f(g y) = y)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `(\x. lambda i. x$i):real^M->real^N` THEN + EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN + SIMP_TAC[vector_norm; dot; LAMBDA_BETA] THEN + SIMP_TAC[linear; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA] THEN + FIRST_ASSUM SUBST1_TAC THEN SIMP_TAC[LAMBDA_BETA] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN SIMP_TAC[LAMBDA_BETA]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of special hyperplanes. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_HYPERPLANE = prove + (`!a. subspace {x:real^N | a dot x = &0}`, + SIMP_TAC[subspace; DOT_RADD; DOT_RMUL; IN_ELIM_THM; REAL_ADD_LID; + REAL_MUL_RZERO; DOT_RZERO]);; + +let SUBSPACE_SPECIAL_HYPERPLANE = prove + (`!k. subspace {x:real^N | x$k = &0}`, + SIMP_TAC[subspace; IN_ELIM_THM; VEC_COMPONENT; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN REAL_ARITH_TAC);; + +let SPECIAL_HYPERPLANE_SPAN = prove + (`!k. 1 <= k /\ k <= dimindex(:N) + ==> {x:real^N | x$k = &0} = + span(IMAGE basis ((1..dimindex(:N)) DELETE k))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SPAN_SUBSPACE THEN + ASM_SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_SIMP_TAC[BASIS_COMPONENT; IN_DELETE]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + SIMP_TAC[SPAN_FINITE; FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `\v:real^N. x dot v` THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhs o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN + MESON_TAC[BASIS_INJ]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; DOT_BASIS] THEN + REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_SUB_RZERO]]]);; + +let DIM_SPECIAL_HYPERPLANE = prove + (`!k. 1 <= k /\ k <= dimindex(:N) + ==> dim {x:real^N | x$k = &0} = dimindex(:N) - 1`, + SIMP_TAC[SPECIAL_HYPERPLANE_SPAN] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DELETE k)` THEN + REWRITE_TAC[SUBSET_REFL; SPAN_INC] THEN CONJ_TAC THENL + [MATCH_MP_TAC INDEPENDENT_MONO THEN + EXISTS_TAC `{basis i:real^N | 1 <= i /\ i <= dimindex(:N)}` THEN + REWRITE_TAC[INDEPENDENT_STDBASIS; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_DELETE; IN_NUMSEG; IN_ELIM_THM] THEN MESON_TAC[]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[FINITE_DELETE; FINITE_NUMSEG; IN_NUMSEG; IN_DELETE] THEN + MESON_TAC[BASIS_INJ]; + ASM_SIMP_TAC[HAS_SIZE; FINITE_DELETE; FINITE_NUMSEG; CARD_DELETE; + FINITE_IMAGE; IN_NUMSEG; CARD_NUMSEG_1]]]);; + +(* ------------------------------------------------------------------------- *) +(* More theorems about dimensions of different subspaces. *) +(* ------------------------------------------------------------------------- *) + +let DIM_IMAGE_KERNEL_GEN = prove + (`!f:real^M->real^N s. + linear f /\ subspace s + ==> dim(IMAGE f s) + dim {x | x IN s /\ f x = vec 0} = dim(s)`, + REPEAT STRIP_TAC THEN MP_TAC + (ISPEC `{x | x IN s /\ (f:real^M->real^N) x = vec 0}` BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`v:real^M->bool`; `s:real^M->bool`] + MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `span(w:real^M->bool) = s` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th] THEN + ASSUME_TAC th) + THENL [ASM_SIMP_TAC[SPAN_SUBSPACE]; ALL_TAC] THEN + SUBGOAL_THEN `subspace {x | x IN s /\ (f:real^M->real^N) x = vec 0}` + ASSUME_TAC THENL + [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_KERNEL]; + ALL_TAC] THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x = vec 0} = span v` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET_ANTISYM; SPAN_SUBSET_SUBSPACE; SUBSPACE_KERNEL]; + ALL_TAC] THEN + ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN + SUBGOAL_THEN + `!x. x IN span(w DIFF v) /\ (f:real^M->real^N) x = vec 0 ==> x = vec 0` + (LABEL_TAC "*") THENL + [MATCH_MP_TAC(SET_RULE + `!t. s SUBSET t /\ (!x. x IN s /\ x IN t /\ P x ==> Q x) + ==> (!x. x IN s /\ P x ==> Q x)`) THEN + EXISTS_TAC `s:real^M->bool` THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_MONO; SUBSET_DIFF]; ALL_TAC] THEN + ASM_SIMP_TAC[SPAN_FINITE; IN_ELIM_THM; IMP_CONJ; FINITE_DIFF; + INDEPENDENT_IMP_FINITE; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN X_GEN_TAC `u:real^M->real` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IMP_IMP] THEN + ONCE_REWRITE_TAC[SET_RULE + `y IN s /\ f y = a <=> y IN {x | x IN s /\ f x = a}`] THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `t:real^M->real`) THEN + MP_TAC(ISPEC `w:real^M->bool` INDEPENDENT_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC + `(\x. if x IN w DIFF v then --u x else t x):real^M->real`) THEN + ASM_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[VSUM_CASES; INDEPENDENT_IMP_FINITE] THEN + REWRITE_TAC[SET_RULE `{x | x IN w /\ x IN (w DIFF v)} = w DIFF v`] THEN + SIMP_TAC[ASSUME `(v:real^M->bool) SUBSET w`; SET_RULE + `v SUBSET w ==> {x | x IN w /\ ~(x IN (w DIFF v))} = v`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_LNEG; VSUM_NEG; VECTOR_ADD_LINV] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC VSUM_EQ_0 THEN MP_TAC th) THEN + REWRITE_TAC[REAL_NEG_EQ_0; VECTOR_MUL_EQ_0; IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x y. x IN (w DIFF v) /\ y IN (w DIFF v) /\ + (f:real^M->real^N) x = f y ==> x = y` + ASSUME_TAC THENL + [REMOVE_THEN "*" MP_TAC THEN + ASM_SIMP_TAC[GSYM LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN + MP_TAC(ISPEC `w DIFF v:real^M->bool` SPAN_INC) THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = span(IMAGE f (w DIFF v))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[SUBSPACE_LINEAR_IMAGE; SPAN_MONO; IMAGE_SUBSET; + SUBSET_TRANS; SUBSET_DIFF; SPAN_EQ_SELF]] THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN UNDISCH_TAC `span w:real^M->bool = s` THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[] THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real^M`) THEN + (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [IN_UNIV; SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM; + FINITE_IMAGE; FINITE_DIFF; ASSUME `independent(w:real^M->bool)`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN DISCH_TAC THEN + X_GEN_TAC `u:real^M->real` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `g:real^N->real^M`) THEN + EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE; LINEAR_VSUM] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[o_DEF] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_EQ_SUPERSET THEN + SIMP_TAC[SUBSET_DIFF; FINITE_DIFF; INDEPENDENT_IMP_FINITE; + LINEAR_CMUL; IN_DIFF; TAUT `a /\ ~(a /\ ~b) <=> a /\ b`; + ASSUME `independent(w:real^M->bool)`; + ASSUME `linear(f:real^M->real^N)`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0] THEN ASM SET_TAC[]; + SUBGOAL_THEN `independent(IMAGE (f:real^M->real^N) (w DIFF v))` + ASSUME_TAC THENL + [MATCH_MP_TAC INDEPENDENT_INJECTIVE_IMAGE_GEN THEN + ASM_SIMP_TAC[LINEAR_INJECTIVE_0_SUBSPACE; SUBSPACE_SPAN] THEN + ASM_MESON_TAC[INDEPENDENT_MONO; SUBSET_DIFF]; + ASM_SIMP_TAC[DIM_SPAN; DIM_EQ_CARD] THEN + W(MP_TAC o PART_MATCH (lhs o rand) CARD_IMAGE_INJ o + lhand o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[FINITE_DIFF; CARD_DIFF; INDEPENDENT_IMP_FINITE] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUB_ADD THEN + ASM_MESON_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]]]);; + +let DIM_IMAGE_KERNEL = prove + (`!f:real^M->real^N. + linear f + ==> dim(IMAGE f (:real^M)) + dim {x | f x = vec 0} = dimindex(:M)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `(:real^M)`] DIM_IMAGE_KERNEL_GEN) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV]);; + +let DIM_SUMS_INTER = prove + (`!s t:real^N->bool. + subspace s /\ subspace t + ==> dim {x + y | x IN s /\ y IN t} + dim(s INTER t) = dim(s) + dim(t)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s INTER t:real^N->bool` BASIS_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`b:real^N->bool`; `s:real^N->bool`] + MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`b:real^N->bool`; `t:real^N->bool`] + MAXIMAL_INDEPENDENT_SUBSET_EXTEND) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(c:real^N->bool) INTER d = b` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[SUBSET_INTER] THEN + REWRITE_TAC[SUBSET; IN_INTER] THEN X_GEN_TAC `x:real^N` THEN + STRIP_TAC THEN MP_TAC(ISPEC `c:real^N->bool` independent) THEN + ASM_REWRITE_TAC[dependent; NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:real^N) IN span b` MP_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_INTER; SPAN_INC]; + MP_TAC(ISPECL [`b:real^N->bool`; `c DELETE (x:real^N)`] SPAN_MONO) THEN + ASM SET_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `dim (s INTER t:real^N->bool) = CARD(b:real^N->bool) /\ + dim s = CARD c /\ dim t = CARD d /\ + dim {x + y:real^N | x IN s /\ y IN t} = CARD(c UNION d:real^N->bool)` + (REPEAT_TCL CONJUNCTS_THEN SUBST1_TAC) THENL + [ALL_TAC; + ASM_SIMP_TAC[CARD_UNION_GEN; INDEPENDENT_IMP_FINITE] THEN + MATCH_MP_TAC(ARITH_RULE `b:num <= c ==> (c + d) - b + b = c + d`) THEN + ASM_SIMP_TAC[CARD_SUBSET; INDEPENDENT_IMP_FINITE]] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC DIM_UNIQUE THENL + [EXISTS_TAC `b:real^N->bool`; + EXISTS_TAC `c:real^N->bool`; + EXISTS_TAC `d:real^N->bool`; + EXISTS_TAC `c UNION d:real^N->bool`] THEN + ASM_SIMP_TAC[HAS_SIZE; INDEPENDENT_IMP_FINITE; FINITE_UNION] THEN + REWRITE_TAC[UNION_SUBSET; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; FORALL_IN_GSPEC] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_RID] THEN ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `x:real^N`] THEN + ASM_SIMP_TAC[SUBSPACE_0; VECTOR_ADD_LID] THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL + [MP_TAC(ISPECL[`c:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO); + MP_TAC(ISPECL[`d:real^N->bool`; `c UNION d:real^N->bool`] SPAN_MONO)] THEN + REWRITE_TAC[SUBSET_UNION] THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[INDEPENDENT_EXPLICIT; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN + X_GEN_TAC `a:real^N->real` THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN + ASM_SIMP_TAC[VSUM_UNION; SET_RULE `DISJOINT c (d DIFF c)`; + INDEPENDENT_IMP_FINITE; FINITE_DIFF; FINITE_UNION] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(vsum (d DIFF c) (\v:real^N. a v % v)) IN span b` + MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH + `a + b = vec 0 ==> b = --a`)) THEN + MATCH_MP_TAC SUBSPACE_NEG THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSPACE_VSUM THEN + ASM_SIMP_TAC[FINITE_DIFF; INDEPENDENT_IMP_FINITE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSPACE_MUL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SPAN_FINITE; INDEPENDENT_IMP_FINITE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `e:real^N->real`) THEN + MP_TAC(ISPEC `c:real^N->bool` INDEPENDENT_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `(\x. if x IN b then a x + e x else a x):real^N->real`)) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN + ONCE_REWRITE_TAC[COND_RATOR] THEN ASM_SIMP_TAC[VSUM_CASES] THEN + REWRITE_TAC[VECTOR_ADD_RDISTRIB; GSYM DIFF] THEN + ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> {x | x IN c /\ x IN b} = b`] THEN + ASM_SIMP_TAC[VSUM_ADD; INDEPENDENT_IMP_FINITE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(a + b) + c:real^N = (a + c) + b`] THEN + ASM_SIMP_TAC[GSYM VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE; + SET_RULE `DISJOINT b (c DIFF b)`] THEN + ASM_SIMP_TAC[SET_RULE `b SUBSET c ==> b UNION (c DIFF b) = c`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!v:real^N. v IN (c DIFF b) ==> a v = &0` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `d:real^N->bool` INDEPENDENT_EXPLICIT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `a:real^N->real`)) THEN + SUBGOAL_THEN `d:real^N->bool = b UNION (d DIFF c)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [ASM SET_TAC[]; ALL_TAC] THEN + ANTS_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_SIMP_TAC[VSUM_UNION; FINITE_DIFF; INDEPENDENT_IMP_FINITE; + SET_RULE `c INTER d = b ==> DISJOINT b (d DIFF c)`] THEN + SUBGOAL_THEN `vsum b (\x:real^N. a x % x) = vsum c (\x. a x % x)` + (fun th -> ASM_REWRITE_TAC[th]) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0] THEN ASM_MESON_TAC[]);; + +let DIM_KERNEL_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P. + linear f /\ linear g + ==> dim {x | (g o f) x = vec 0} <= + dim {x | f(x) = vec 0} + + dim {y | g(y) = vec 0}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{x | (f:real^M->real^N) x = vec 0}` BASIS_EXISTS_FINITE) THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?c. FINITE c /\ + IMAGE f c SUBSET {y | g(y):real^P = vec 0} /\ + independent (IMAGE (f:real^M->real^N) c) /\ + IMAGE f (:real^M) INTER {y | g(y) = vec 0} SUBSET span(IMAGE f c) /\ + (!x y. x IN c /\ y IN c ==> (f x = f y <=> x = y)) /\ + (IMAGE f c) HAS_SIZE dim (IMAGE f (:real^M) INTER {y | g(y) = vec 0})` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `IMAGE (f:real^M->real^N) (:real^M) INTER + {x | (g:real^N->real^P) x = vec 0}` BASIS_EXISTS_FINITE) THEN + REWRITE_TAC[SUBSET_INTER; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `c:real^M->bool`] + IMAGE_INJECTIVE_IMAGE_OF_SUBSET) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real^M->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[FINITE_SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `dim(span(b UNION c:real^M->bool))` THEN CONJ_TAC THENL + [MATCH_MP_TAC DIM_SUBSET THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; o_THM] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:real^M->real^N) x IN span(IMAGE f c)` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SPAN_LINEAR_IMAGE; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + SUBST1_TAC(VECTOR_ARITH `x:real^M = y + (x - y)`) THEN + MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET_UNION; SPAN_MONO; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN + EXISTS_TAC `{x | (f:real^M->real^N) x = vec 0}` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LINEAR_SUB; VECTOR_SUB_EQ]; + ASM_MESON_TAC[SUBSET_TRANS; SUBSET_UNION; SPAN_MONO]]; + REWRITE_TAC[DIM_SPAN] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD(b UNION c:real^M->bool)` THEN + ASM_SIMP_TAC[DIM_LE_CARD; FINITE_UNION; INDEPENDENT_IMP_FINITE] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD(b:real^M->bool) + CARD(c:real^M->bool)` THEN + ASM_SIMP_TAC[CARD_UNION_LE] THEN MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `dim(IMAGE (f:real^M->real^N) c)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[DIM_EQ_CARD] THEN + ASM_MESON_TAC[CARD_IMAGE_INJ; LE_REFL]; + ASM_SIMP_TAC[GSYM DIM_EQ_CARD; DIM_SUBSET]]]);; + +let DIM_ORTHOGONAL_SUM = prove + (`!s t:real^N->bool. + (!x y. x IN s /\ y IN t ==> x dot y = &0) + ==> dim(s UNION t) = dim(s) + dim(t)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + REWRITE_TAC[SPAN_UNION] THEN + SIMP_TAC[GSYM DIM_SUMS_INTER; SUBSPACE_SPAN] THEN + REWRITE_TAC[ARITH_RULE `x = x + y <=> y = 0`] THEN + REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER] THEN + SUBGOAL_THEN + `!x:real^N. x IN span s ==> !y:real^N. y IN span t ==> x dot y = &0` + MP_TAC THENL + [MATCH_MP_TAC SPAN_INDUCT THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC SPAN_INDUCT THEN ASM_SIMP_TAC[IN_ELIM_THM] THEN + SIMP_TAC[subspace; IN_ELIM_THM; DOT_RMUL; DOT_RADD; DOT_RZERO] THEN + REAL_ARITH_TAC; + SIMP_TAC[subspace; IN_ELIM_THM; DOT_LMUL; DOT_LADD; DOT_LZERO] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[IN_SING] THEN MESON_TAC[DOT_EQ_0]]);; + +let DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS = prove + (`!s t:real^N->bool. + subspace s /\ subspace t /\ s SUBSET t + ==> dim {y | y IN t /\ !x. x IN s ==> orthogonal x y} + dim s = dim t`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) DIM_ORTHOGONAL_SUM o lhand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[IN_ELIM_THM; orthogonal] THEN MESON_TAC[DOT_SYM]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC SPAN_MONO THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN REWRITE_TAC[SUBSPACE_SPAN] THEN + REWRITE_TAC[SPAN_UNION; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`] + ORTHOGONAL_SUBSPACE_DECOMP_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[VECTOR_ADD_SYM] THEN + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (VECTOR_ARITH + `x:real^N = y + z ==> z = x - y`)) THEN + MATCH_MP_TAC SUBSPACE_SUB THEN + ASM_MESON_TAC[SUBSET; SPAN_EQ_SELF]; + ASM_MESON_TAC[SPAN_SUPERSET; ORTHOGONAL_SYM]]);; + +let DIM_SPECIAL_SUBSPACE = prove + (`!k. dim {x:real^N | + !i. 1 <= i /\ i <= dimindex(:N) /\ i IN k ==> x$i = &0} = + CARD((1..dimindex(:N)) DIFF k)`, + GEN_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `IMAGE (basis:num->real^N) ((1..dimindex(:N)) DIFF k)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + SIMP_TAC[BASIS_COMPONENT; IN_DIFF; IN_NUMSEG] THEN MESON_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + MATCH_MP_TAC SPAN_VSUM THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(x:real^N)$j = &0` THEN + ASM_REWRITE_TAC[SPAN_0; VECTOR_MUL_LZERO] THEN + MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `j:num` THEN + REWRITE_TAC[IN_NUMSEG; IN_DIFF] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + REWRITE_TAC[pairwise; IMP_CONJ; RIGHT_FORALL_IMP_THM; + SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN + SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ; + IN_DIFF; IN_NUMSEG; BASIS_NONZERO]; + SIMP_TAC[HAS_SIZE; FINITE_IMAGE; FINITE_DIFF; FINITE_NUMSEG] THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN + SIMP_TAC[FINITE_DIFF; FINITE_NUMSEG; IMP_CONJ; RIGHT_FORALL_IMP_THM; + SET_RULE `~(a IN IMAGE f s) <=> (!x. x IN s ==> ~(f x = a))`] THEN + SIMP_TAC[FORALL_IN_IMAGE; ORTHOGONAL_BASIS_BASIS; BASIS_INJ_EQ; + IN_DIFF; IN_NUMSEG; BASIS_NONZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* More injective/surjective versus dimension variants. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INJECTIVE_IFF_DIM = prove + (`!f:real^M->real^N. + linear f + ==> ((!x y. f x = f y ==> x = y) <=> + dim(IMAGE f (:real^M)) = dimindex(:M))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` DIM_IMAGE_KERNEL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP (ARITH_RULE + `x + y:num = m ==> (x = m <=> y = 0)`)) THEN + REWRITE_TAC[DIM_EQ_0; SUBSET; IN_ELIM_THM; IN_SING] THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_0]);; + +let LINEAR_SURJECTIVE_IFF_DIM = prove + (`!f:real^M->real^N. + linear f + ==> ((!y. ?x. f x = y) <=> + dim(IMAGE f (:real^M)) = dimindex(:N))`, + SIMP_TAC[DIM_EQ_FULL; SPAN_LINEAR_IMAGE; SPAN_UNIV] THEN SET_TAC[]);; + +let LINEAR_SURJECTIVE_IFF_INJECTIVE_GEN = prove + (`!f:real^M->real^N. + dimindex(:M) = dimindex(:N) /\ linear f + ==> ((!y. ?x. f x = y) <=> (!x y. f x = f y ==> x = y))`, + SIMP_TAC[LINEAR_INJECTIVE_IFF_DIM; LINEAR_SURJECTIVE_IFF_DIM] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* More about product spaces. *) +(* ------------------------------------------------------------------------- *) + +let PASTECART_AS_ORTHOGONAL_SUM = prove + (`!x:real^M y:real^N. + pastecart x y = pastecart x (vec 0) + pastecart (vec 0) y`, + REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID; VECTOR_ADD_RID]);; + +let PCROSS_AS_ORTHOGONAL_SUM = prove + (`!s:real^M->bool t:real^N->bool. + s PCROSS t = + {u + v | u IN IMAGE (\x. pastecart x (vec 0)) s /\ + v IN IMAGE (\y. pastecart (vec 0) y) t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [PASTECART_AS_ORTHOGONAL_SUM] THEN + SET_TAC[]);; + +let DIM_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t ==> dim(s PCROSS t) = dim s + dim t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[PCROSS_AS_ORTHOGONAL_SUM] THEN + W(MP_TAC o PART_MATCH (lhand o lhand o rand) DIM_SUMS_INTER o + lhand o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC SUBSPACE_LINEAR_IMAGE; + MATCH_MP_TAC(ARITH_RULE `c = d /\ b = 0 ==> a + b = c ==> a = d`) THEN + CONJ_TAC THENL + [BINOP_TAC THEN MATCH_MP_TAC DIM_INJECTIVE_LINEAR_IMAGE THEN + SIMP_TAC[PASTECART_INJ]; + REWRITE_TAC[DIM_EQ_0; SUBSET; IN_INTER; IN_IMAGE; IN_SING] THEN + REWRITE_TAC[PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MESON_TAC[FSTCART_VEC; SNDCART_VEC]]] THEN + ASM_REWRITE_TAC[linear; GSYM PASTECART_VEC] THEN + REWRITE_TAC[PASTECART_ADD; GSYM PASTECART_CMUL; PASTECART_INJ] THEN + VECTOR_ARITH_TAC);; + +let SPAN_PCROSS_SUBSET = prove + (`!s:real^M->bool t:real^N->bool. + span(s PCROSS t) SUBSET (span s) PCROSS (span t)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN + SIMP_TAC[SUBSPACE_PCROSS; SUBSPACE_SPAN; PCROSS_MONO; SPAN_INC]);; + +let SPAN_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t) + ==> span(s PCROSS t) = (span s) PCROSS (span t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SPAN_PCROSS_SUBSET] THEN + REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN + ONCE_REWRITE_TAC[PASTECART_AS_ORTHOGONAL_SUM] THEN + SUBGOAL_THEN + `(!x:real^M. x IN span s ==> pastecart x (vec 0) IN span(s PCROSS t)) /\ + (!y:real^N. y IN span t ==> pastecart (vec 0) y IN span(s PCROSS t))` + (fun th -> ASM_MESON_TAC[th; SPAN_ADD]) THEN + CONJ_TAC THEN MATCH_MP_TAC SPAN_INDUCT THEN REWRITE_TAC[IN_ELIM_THM] THEN + (CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]; + REWRITE_TAC[subspace; IN_ELIM_THM; PASTECART_VEC; SPAN_0] THEN + CONJ_TAC THEN REPEAT GEN_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP SPAN_ADD) THEN + REWRITE_TAC[PASTECART_ADD; VECTOR_ADD_LID]; + DISCH_THEN(MP_TAC o MATCH_MP SPAN_MUL) THEN + SIMP_TAC[GSYM PASTECART_CMUL; VECTOR_MUL_RZERO]]]) + THENL + [X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + SUBGOAL_THEN + `pastecart x (vec 0) = + pastecart (x:real^M) (y:real^N) - pastecart (vec 0) y` + SUBST1_TAC THENL + [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC SPAN_SUB THEN + ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]]; + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^M`) THEN + SUBGOAL_THEN + `pastecart (vec 0) y = + pastecart (x:real^M) (y:real^N) - pastecart x (vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[PASTECART_SUB; PASTECART_INJ] THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC SPAN_SUB THEN + ASM_SIMP_TAC[SPAN_SUPERSET; PASTECART_IN_PCROSS]]]);; + +let DIM_PCROSS_STRONG = prove + (`!s:real^M->bool t:real^N->bool. + ~(s = {}) /\ ~(t = {}) /\ (vec 0 IN s \/ vec 0 IN t) + ==> dim(s PCROSS t) = dim s + dim t`, + ONCE_REWRITE_TAC[GSYM DIM_SPAN] THEN + SIMP_TAC[SPAN_PCROSS; DIM_PCROSS; SUBSPACE_SPAN]);; + +let SPAN_SUMS = prove + (`!s t:real^N->bool. + ~(s = {}) /\ ~(t = {}) /\ vec 0 IN (s UNION t) + ==> span {x + y | x IN s /\ y IN t} = + {x + y | x IN span s /\ y IN span t}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SPAN_UNION] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THEN MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN + REWRITE_TAC[SUBSPACE_SPAN; SUBSET; FORALL_IN_GSPEC] THEN + SIMP_TAC[SPAN_ADD; IN_UNION; SPAN_SUPERSET] THEN + X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [IN_UNION]) THENL + [UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + SUBST1_TAC(VECTOR_ARITH `x:real^N = (x + y) - (vec 0 + y)`) THEN + MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN + ASM SET_TAC[]; + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VECTOR_ADD_RID]; + MATCH_MP_TAC SPAN_SUPERSET THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VECTOR_ADD_LID]; + UNDISCH_TAC `~(s:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + SUBST1_TAC(VECTOR_ARITH `x:real^N = (y + x) - (y + vec 0)`) THEN + MATCH_MP_TAC SPAN_SUB THEN CONJ_TAC THEN MATCH_MP_TAC SPAN_SUPERSET THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More about rank from the rank/nullspace formula. *) +(* ------------------------------------------------------------------------- *) + +let RANK_NULLSPACE = prove + (`!A:real^M^N. rank A + dim {x | A ** x = vec 0} = dimindex(:M)`, + GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN + MATCH_MP_TAC DIM_IMAGE_KERNEL THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; + +let RANK_SYLVESTER = prove + (`!A:real^N^M B:real^P^N. + rank(A) + rank(B) <= rank(A ** B) + dimindex(:N)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE + `!ia ib iab p:num. + ra + ia = n /\ + rb + ib = p /\ + rab + iab = p /\ + iab <= ia + ib + ==> ra + rb <= rab + n`) THEN + MAP_EVERY EXISTS_TAC + [`dim {x | (A:real^N^M) ** x = vec 0}`; + `dim {x | (B:real^P^N) ** x = vec 0}`; + `dim {x | ((A:real^N^M) ** (B:real^P^N)) ** x = vec 0}`; + `dimindex(:P)`] THEN + REWRITE_TAC[RANK_NULLSPACE] THEN + REWRITE_TAC[GSYM MATRIX_VECTOR_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] DIM_KERNEL_COMPOSE) THEN + CONJ_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[MATRIX_VECTOR_MUL_LINEAR]);; + +let RANK_GRAM = prove + (`!A:real^M^N. rank(transp A ** A) = rank A`, + GEN_TAC THEN MATCH_MP_TAC(ARITH_RULE + `!n n' k. r + n:num = k /\ r' + n' = k /\ n = n' ==> r = r'`) THEN + MAP_EVERY EXISTS_TAC + [`dim {x | (transp A ** (A:real^M^N)) ** x = vec 0}`; + `dim {x | (A:real^M^N) ** x = vec 0}`; + `dimindex(:M)`] THEN + REWRITE_TAC[RANK_NULLSPACE] THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; GSYM MATRIX_VECTOR_MUL_ASSOC; + MATRIX_VECTOR_MUL_RZERO] THEN + X_GEN_TAC `x:real^M` THEN + DISCH_THEN(MP_TAC o AP_TERM `(dot) (x:real^M)`) THEN + ONCE_REWRITE_TAC[GSYM DOT_LMUL_MATRIX] THEN + REWRITE_TAC[VECTOR_MATRIX_MUL_TRANSP; TRANSP_TRANSP; DOT_RZERO] THEN + REWRITE_TAC[DOT_EQ_0]);; + +let RANK_TRIANGLE = prove + (`!A B:real^M^N. rank(A + B) <= rank(A) + rank(B)`, + REPEAT GEN_TAC THEN REWRITE_TAC[RANK_DIM_IM] THEN + MP_TAC(ISPECL [`IMAGE (\x. (A:real^M^N) ** x) (:real^M)`; + `IMAGE (\x. (B:real^M^N) ** x) (:real^M)`] + DIM_SUMS_INTER) THEN + ASM_SIMP_TAC[SUBSPACE_LINEAR_IMAGE; SUBSPACE_UNIV; + MATRIX_VECTOR_MUL_LINEAR] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC(ARITH_RULE `x:num <= y ==> x <= y + z`) THEN + MATCH_MP_TAC DIM_SUBSET THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; + MATRIX_VECTOR_MUL_ADD_RDISTRIB] THEN + REWRITE_TAC[IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Infinity norm. *) +(* ------------------------------------------------------------------------- *) + +let infnorm = define + `infnorm (x:real^N) = sup { abs(x$i) | 1 <= i /\ i <= dimindex(:N) }`;; + +let NUMSEG_DIMINDEX_NONEMPTY = prove + (`?i. i IN 1..dimindex(:N)`, + REWRITE_TAC[MEMBER_NOT_EMPTY; NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);; + +let INFNORM_SET_IMAGE = prove + (`{abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = + IMAGE (\i. abs(x$i)) (1..dimindex(:N))`, + REWRITE_TAC[numseg] THEN SET_TAC[]);; + +let INFNORM_SET_LEMMA = prove + (`FINITE {abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N)} /\ + ~({abs(x$i) | 1 <= i /\ i <= dimindex(:N)} = {})`, + SIMP_TAC[INFNORM_SET_IMAGE; FINITE_NUMSEG; FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]);; + +let INFNORM_POS_LE = prove + (`!x. &0 <= infnorm x`, + REWRITE_TAC[infnorm] THEN + SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN + REWRITE_TAC[INFNORM_SET_IMAGE; NUMSEG_DIMINDEX_NONEMPTY; + EXISTS_IN_IMAGE; REAL_ABS_POS]);; + +let INFNORM_TRIANGLE = prove + (`!x y. infnorm(x + y) <= infnorm x + infnorm y`, + REWRITE_TAC[infnorm] THEN + SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN + SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN + ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN + SIMP_TAC[REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN + REWRITE_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; GSYM IN_NUMSEG] THEN + MESON_TAC[NUMSEG_DIMINDEX_NONEMPTY; + REAL_ARITH `abs(x + y) - abs(x) <= abs(y)`]);; + +let INFNORM_EQ_0 = prove + (`!x. infnorm x = &0 <=> x = vec 0`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_POS_LE] THEN + SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN + SIMP_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE; CART_EQ; VEC_COMPONENT] THEN + REWRITE_TAC[IN_NUMSEG; REAL_ARITH `abs(x) <= &0 <=> x = &0`]);; + +let INFNORM_0 = prove + (`infnorm(vec 0) = &0`, + REWRITE_TAC[INFNORM_EQ_0]);; + +let INFNORM_NEG = prove + (`!x. infnorm(--x) = infnorm x`, + GEN_TAC THEN REWRITE_TAC[infnorm] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[REAL_ABS_NEG; VECTOR_NEG_COMPONENT]);; + +let INFNORM_SUB = prove + (`!x y. infnorm(x - y) = infnorm(y - x)`, + MESON_TAC[INFNORM_NEG; VECTOR_NEG_SUB]);; + +let REAL_ABS_SUB_INFNORM = prove + (`abs(infnorm x - infnorm y) <= infnorm(x - y)`, + MATCH_MP_TAC(REAL_ARITH + `nx <= n + ny /\ ny <= n + nx ==> abs(nx - ny) <= n`) THEN + MESON_TAC[INFNORM_SUB; VECTOR_SUB_ADD2; INFNORM_TRIANGLE; VECTOR_ADD_SYM]);; + +let REAL_ABS_INFNORM = prove + (`!x. abs(infnorm x) = infnorm x`, + REWRITE_TAC[real_abs; INFNORM_POS_LE]);; + +let COMPONENT_LE_INFNORM = prove + (`!x:real^N i. 1 <= i /\ i <= dimindex (:N) ==> abs(x$i) <= infnorm x`, + REPEAT GEN_TAC THEN REWRITE_TAC[infnorm] THEN + MP_TAC(SPEC `{ abs((x:real^N)$i) | 1 <= i /\ i <= dimindex(:N) }` + SUP_FINITE) THEN + REWRITE_TAC[INFNORM_SET_LEMMA] THEN + SIMP_TAC[INFNORM_SET_IMAGE; FORALL_IN_IMAGE; IN_NUMSEG]);; + +let INFNORM_MUL_LEMMA = prove + (`!a x. infnorm(a % x) <= abs a * infnorm x`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC LAND_CONV [infnorm] THEN + SIMP_TAC[REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN + REWRITE_TAC[FORALL_IN_IMAGE; INFNORM_SET_IMAGE] THEN + SIMP_TAC[REAL_ABS_MUL; VECTOR_MUL_COMPONENT; IN_NUMSEG] THEN + SIMP_TAC[COMPONENT_LE_INFNORM; REAL_LE_LMUL; REAL_ABS_POS]);; + +let INFNORM_MUL = prove + (`!a x:real^N. infnorm(a % x) = abs a * infnorm x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = &0` THEN + ASM_REWRITE_TAC[VECTOR_MUL_LZERO; INFNORM_0; REAL_ABS_0; REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM; INFNORM_MUL_LEMMA] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM VECTOR_MUL_LID] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(a) * abs(inv a) * infnorm(a % x:real^N)` THEN + ASM_SIMP_TAC[INFNORM_MUL_LEMMA; REAL_LE_LMUL; REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; GSYM REAL_ABS_MUL; REAL_MUL_RINV] THEN + REAL_ARITH_TAC);; + +let INFNORM_POS_LT = prove + (`!x. &0 < infnorm x <=> ~(x = vec 0)`, + MESON_TAC[REAL_LT_LE; INFNORM_POS_LE; INFNORM_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* Prove that it differs only up to a bound from Euclidean norm. *) +(* ------------------------------------------------------------------------- *) + +let INFNORM_LE_NORM = prove + (`!x. infnorm(x) <= norm(x)`, + SIMP_TAC[infnorm; REAL_SUP_LE_FINITE; INFNORM_SET_LEMMA] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[COMPONENT_LE_NORM]);; + +let NORM_LE_INFNORM = prove + (`!x:real^N. norm(x) <= sqrt(&(dimindex(:N))) * infnorm(x)`, + GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o funpow 2 RAND_CONV) + [GSYM CARD_NUMSEG_1] THEN + REWRITE_TAC[vector_norm] THEN MATCH_MP_TAC REAL_LE_LSQRT THEN + SIMP_TAC[DOT_POS_LE; SQRT_POS_LE; REAL_POS; REAL_LE_MUL; INFNORM_POS_LE; + SQRT_POW_2; REAL_POW_MUL] THEN + REWRITE_TAC[dot] THEN MATCH_MP_TAC SUM_BOUND THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x <= abs(y)`) THEN + SIMP_TAC[infnorm; REAL_LE_SUP_FINITE; INFNORM_SET_LEMMA] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Equality in Cauchy-Schwarz and triangle inequalities. *) +(* ------------------------------------------------------------------------- *) + +let NORM_CAUCHY_SCHWARZ_EQ = prove + (`!x:real^N y. x dot y = norm(x) * norm(y) <=> norm(x) % y = norm(y) % x`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN + ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_MUL_RZERO; + DOT_LZERO; DOT_RZERO; VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN + MP_TAC(ISPEC `norm(y:real^N) % x - norm(x:real^N) % y` DOT_EQ_0) THEN + REWRITE_TAC[DOT_RSUB; DOT_LSUB; DOT_LMUL; DOT_RMUL; GSYM NORM_POW_2; + REAL_POW_2; VECTOR_SUB_EQ] THEN + REWRITE_TAC[DOT_SYM; REAL_ARITH + `y * (y * x * x - x * d) - x * (y * d - x * y * y) = + &2 * x * y * (x * y - d)`] THEN + ASM_SIMP_TAC[REAL_ENTIRE; NORM_EQ_0; REAL_SUB_0; REAL_OF_NUM_EQ; ARITH] THEN + REWRITE_TAC[EQ_SYM_EQ]);; + +let NORM_CAUCHY_SCHWARZ_ABS_EQ = prove + (`!x:real^N y. abs(x dot y) = norm(x) * norm(y) <=> + norm(x) % y = norm(y) % x \/ norm(x) % y = --norm(y) % x`, + SIMP_TAC[REAL_ARITH `&0 <= a ==> (abs x = a <=> x = a \/ --x = a)`; + REAL_LE_MUL; NORM_POS_LE; GSYM DOT_RNEG] THEN + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 3 RAND_CONV) [GSYM NORM_NEG] THEN + REWRITE_TAC[NORM_CAUCHY_SCHWARZ_EQ] THEN REWRITE_TAC[NORM_NEG] THEN + BINOP_TAC THEN VECTOR_ARITH_TAC);; + +let NORM_TRIANGLE_EQ = prove + (`!x y:real^N. norm(x + y) = norm(x) + norm(y) <=> norm(x) % y = norm(y) % x`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQ] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `norm(x + y:real^N) pow 2 = (norm(x) + norm(y)) pow 2` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_RING `x pow 2 = y pow 2 <=> x = y \/ x + y = &0`] THEN + MAP_EVERY (MP_TAC o C ISPEC NORM_POS_LE) + [`x + y:real^N`; `x:real^N`; `y:real^N`] THEN + REAL_ARITH_TAC; + REWRITE_TAC[NORM_POW_2; DOT_LADD; DOT_RADD; REAL_ARITH + `(x + y) pow 2 = x pow 2 + y pow 2 + &2 * x * y`] THEN + REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC]);; + +let DIST_TRIANGLE_EQ = prove + (`!x y z. dist(x,z) = dist(x,y) + dist(y,z) <=> + norm (x - y) % (y - z) = norm (y - z) % (x - y)`, + REWRITE_TAC[GSYM NORM_TRIANGLE_EQ] THEN NORM_ARITH_TAC);; + +let NORM_CROSS_MULTIPLY = prove + (`!a b x y:real^N. + a % x = b % y /\ &0 < a /\ &0 < b + ==> norm y % x = norm x % y`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `y:real^N = vec 0` THEN + ASM_SIMP_TAC[VECTOR_MUL_EQ_0; REAL_LT_IMP_NZ; VECTOR_MUL_RZERO] THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^N. inv(a) % x`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID; + NORM_MUL; REAL_ABS_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Collinearity. *) +(* ------------------------------------------------------------------------- *) + +let collinear = new_definition + `collinear s <=> ?u. !x y. x IN s /\ y IN s ==> ?c. x - y = c % u`;; + +let COLLINEAR_SUBSET = prove + (`!s t. collinear t /\ s SUBSET t ==> collinear s`, + REWRITE_TAC[collinear] THEN SET_TAC[]);; + +let COLLINEAR_EMPTY = prove + (`collinear {}`, + REWRITE_TAC[collinear; NOT_IN_EMPTY]);; + +let COLLINEAR_SING = prove + (`!x. collinear {x}`, + SIMP_TAC[collinear; IN_SING; VECTOR_SUB_REFL] THEN + MESON_TAC[VECTOR_MUL_LZERO]);; + +let COLLINEAR_2 = prove + (`!x y:real^N. collinear {x,y}`, + REPEAT GEN_TAC THEN REWRITE_TAC[collinear; IN_INSERT; NOT_IN_EMPTY] THEN + EXISTS_TAC `x - y:real^N` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `&0`; EXISTS_TAC `&1`; EXISTS_TAC `-- &1`; EXISTS_TAC `&0`] THEN + VECTOR_ARITH_TAC);; + +let COLLINEAR_SMALL = prove + (`!s. FINITE s /\ CARD s <= 2 ==> collinear s`, + REWRITE_TAC[ARITH_RULE `s <= 2 <=> s = 0 \/ s = 1 \/ s = 2`] THEN + REWRITE_TAC[LEFT_OR_DISTRIB; GSYM HAS_SIZE] THEN + CONV_TAC(ONCE_DEPTH_CONV HAS_SIZE_CONV) THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[COLLINEAR_EMPTY; COLLINEAR_SING; COLLINEAR_2]);; + +let COLLINEAR_3 = prove + (`!x y z. collinear {x,y,z} <=> collinear {vec 0,x - y,z - y}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[collinear; FORALL_IN_INSERT; IMP_CONJ; RIGHT_FORALL_IMP_THM; + NOT_IN_EMPTY] THEN + AP_TERM_TAC THEN ABS_TAC THEN + MESON_TAC[VECTOR_ARITH `x - y = (x - y) - vec 0`; + VECTOR_ARITH `y - x = vec 0 - (x - y)`; + VECTOR_ARITH `x - z:real^N = (x - y) - (z - y)`]);; + +let COLLINEAR_LEMMA = prove + (`!x y:real^N. collinear {vec 0,x,y} <=> + x = vec 0 \/ y = vec 0 \/ ?c. y = c % x`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN + TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2] THEN NO_TAC) THEN + ASM_REWRITE_TAC[collinear] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real^N` + (fun th -> MP_TAC(SPECL [`x:real^N`; `vec 0:real^N`] th) THEN + MP_TAC(SPECL [`y:real^N`; `vec 0:real^N`] th))) THEN + REWRITE_TAC[IN_INSERT; VECTOR_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` SUBST_ALL_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` SUBST_ALL_TAC) THEN + EXISTS_TAC `e / d` THEN REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_EQ_0; DE_MORGAN_THM]) THEN + ASM_SIMP_TAC[REAL_DIV_RMUL]; + STRIP_TAC THEN EXISTS_TAC `x:real^N` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `&0`; EXISTS_TAC `-- &1`; EXISTS_TAC `--c`; + EXISTS_TAC `&1`; EXISTS_TAC `&0`; EXISTS_TAC `&1 - c`; + EXISTS_TAC `c:real`; EXISTS_TAC `c - &1`; EXISTS_TAC `&0`] THEN + VECTOR_ARITH_TAC]);; + +let COLLINEAR_LEMMA_ALT = prove + (`!x y. collinear {vec 0,x,y} <=> x = vec 0 \/ ?c. y = c % x`, + REWRITE_TAC[COLLINEAR_LEMMA] THEN MESON_TAC[VECTOR_MUL_LZERO]);; + +let NORM_CAUCHY_SCHWARZ_EQUAL = prove + (`!x y:real^N. abs(x dot y) = norm(x) * norm(y) <=> collinear {vec 0,x,y}`, + REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CAUCHY_SCHWARZ_ABS_EQ] THEN + MAP_EVERY ASM_CASES_TAC [`x:real^N = vec 0`; `y:real^N = vec 0`] THEN + TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_SING; COLLINEAR_2; NORM_0; + VECTOR_MUL_LZERO; VECTOR_MUL_RZERO] THEN NO_TAC) THEN + ASM_REWRITE_TAC[COLLINEAR_LEMMA] THEN EQ_TAC THENL + [STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o AP_TERM + `(%) (inv(norm(x:real^N))):real^N->real^N`); + FIRST_X_ASSUM(MP_TAC o AP_TERM + `(%) (--inv(norm(x:real^N))):real^N->real^N`)] THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LNEG] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0; VECTOR_MUL_LNEG; VECTOR_MUL_LID; + VECTOR_ARITH `--x = --y <=> x:real^N = y`] THEN + MESON_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[NORM_MUL; VECTOR_MUL_ASSOC] THEN + MATCH_MP_TAC(MESON[] + `t = a \/ t = b ==> t % x = a % x \/ t % x = b % x`) THEN + REWRITE_TAC[GSYM REAL_MUL_LNEG; + REAL_ARITH `x * c = d * x <=> x * (c - d) = &0`] THEN + ASM_REWRITE_TAC[REAL_ENTIRE; NORM_EQ_0] THEN REAL_ARITH_TAC]);; + +let DOT_CAUCHY_SCHWARZ_EQUAL = prove + (`!x y:real^N. + (x dot y) pow 2 = (x dot x) * (y dot y) <=> + collinear {vec 0,x,y}`, + REWRITE_TAC[GSYM NORM_CAUCHY_SCHWARZ_EQUAL] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ (u:real = v <=> x = abs y) ==> (u = v <=> x = y)`) THEN + SIMP_TAC[NORM_POS_LE; REAL_LE_MUL] THEN + REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN REWRITE_TAC[REAL_POW_MUL; NORM_POW_2]);; + +let COLLINEAR_3_EXPAND = prove + (`!a b c:real^N. collinear{a,b,c} <=> a = c \/ ?u. b = u % a + (&1 - u) % c`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `{a,b,c} = {a,c,b}`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[COLLINEAR_LEMMA; VECTOR_SUB_EQ] THEN + ASM_CASES_TAC `a:real^N = c` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `b:real^N = c` THEN + ASM_REWRITE_TAC[VECTOR_ARITH `u % c + (&1 - u) % c = c`] THENL + [EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC; + AP_TERM_TAC THEN ABS_TAC THEN VECTOR_ARITH_TAC]);; + +let COLLINEAR_TRIPLES = prove + (`!s a b:real^N. + ~(a = b) + ==> (collinear(a INSERT b INSERT s) <=> + !x. x IN s ==> collinear{a,b,x})`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] COLLINEAR_SUBSET)) THEN + ASM SET_TAC[]; + ONCE_REWRITE_TAC[SET_RULE `{a,b,x} = {a,x,b}`] THEN + ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!x:real^N. x IN (a INSERT b INSERT s) ==> ?u. x = u % a + (&1 - u) % b` + MP_TAC THENL + [ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN CONJ_TAC THENL + [EXISTS_TAC `&1` THEN VECTOR_ARITH_TAC; + EXISTS_TAC `&0` THEN VECTOR_ARITH_TAC]; + POP_ASSUM_LIST(K ALL_TAC) THEN DISCH_TAC THEN + REWRITE_TAC[collinear] THEN EXISTS_TAC `b - a:real^N` THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:real^N` th) THEN MP_TAC(SPEC + `y:real^N` th)) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_ARITH + `(u % a + (&1 - u) % b) - (v % a + (&1 - v) % b):real^N = + (v - u) % (b - a)`] THEN + MESON_TAC[]]]);; + +let COLLINEAR_4_3 = prove + (`!a b c d:real^N. + ~(a = b) + ==> (collinear {a,b,c,d} <=> collinear{a,b,c} /\ collinear{a,b,d})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{c:real^N,d}`; `a:real^N`; `b:real^N`] + COLLINEAR_TRIPLES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY]);; + +let COLLINEAR_3_TRANS = prove + (`!a b c d:real^N. + collinear{a,b,c} /\ collinear{b,c,d} /\ ~(b = c) ==> collinear{a,b,d}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `{b:real^N,c,a,d}` THEN ASM_SIMP_TAC[COLLINEAR_4_3] THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]);; + +let ORTHOGONAL_TO_ORTHOGONAL_2D = prove + (`!x y z:real^2. + ~(x = vec 0) /\ orthogonal x y /\ orthogonal x z + ==> collinear {vec 0,y,z}`, + REWRITE_TAC[orthogonal; GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN + REWRITE_TAC[DOT_2] THEN CONV_TAC REAL_RING);; + +let COLLINEAR_3_2D = prove + (`!x y z:real^2. collinear{x,y,z} <=> + (z$1 - x$1) * (y$2 - x$2) = (y$1 - x$1) * (z$2 - x$2)`, + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL] THEN + REWRITE_TAC[DOT_2; VECTOR_SUB_COMPONENT] THEN CONV_TAC REAL_RING);; + +let COLLINEAR_3_DOT_MULTIPLES = prove + (`!a b c:real^N. + collinear {a,b,c} <=> + ((b - a) dot (b - a)) % (c - a) = ((c - a) dot (b - a)) % (b - a)`, + REWRITE_TAC[VECTOR_SUB_RZERO] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `b:real^N = a` THENL + [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC; DOT_RZERO; VECTOR_MUL_LZERO; + VECTOR_SUB_REFL]; + ONCE_REWRITE_TAC[COLLINEAR_3] THEN + POP_ASSUM MP_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + REWRITE_TAC[GSYM DOT_CAUCHY_SCHWARZ_EQUAL; GSYM DOT_EQ_0] THEN + REWRITE_TAC[GSYM DOT_EQ_0; DOT_RSUB; DOT_LSUB; DOT_RMUL; DOT_LMUL] THEN + REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Between-ness. *) +(* ------------------------------------------------------------------------- *) + +let between = new_definition + `between x (a,b) <=> dist(a,b) = dist(a,x) + dist(x,b)`;; + +let BETWEEN_REFL = prove + (`!a b. between a (a,b) /\ between b (a,b) /\ between a (a,a)`, + REWRITE_TAC[between] THEN NORM_ARITH_TAC);; + +let BETWEEN_REFL_EQ = prove + (`!a x. between x (a,a) <=> x = a`, + REWRITE_TAC[between] THEN NORM_ARITH_TAC);; + +let BETWEEN_SYM = prove + (`!a b x. between x (a,b) <=> between x (b,a)`, + REWRITE_TAC[between] THEN NORM_ARITH_TAC);; + +let BETWEEN_ANTISYM = prove + (`!a b c. between a (b,c) /\ between b (a,c) ==> a = b`, + REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);; + +let BETWEEN_TRANS = prove + (`!a b c d. between a (b,c) /\ between d (a,c) ==> between d (b,c)`, + REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);; + +let BETWEEN_TRANS_2 = prove + (`!a b c d. between a (b,c) /\ between d (a,b) ==> between a (c,d)`, + REWRITE_TAC[between; DIST_SYM] THEN NORM_ARITH_TAC);; + +let BETWEEN_NORM = prove + (`!a b x:real^N. + between x (a,b) <=> norm(x - a) % (b - x) = norm(b - x) % (x - a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[between; DIST_TRIANGLE_EQ] THEN + REWRITE_TAC[NORM_SUB] THEN VECTOR_ARITH_TAC);; + +let BETWEEN_DOT = prove + (`!a b x:real^N. + between x (a,b) <=> (x - a) dot (b - x) = norm(x - a) * norm(b - x)`, + REWRITE_TAC[BETWEEN_NORM; NORM_CAUCHY_SCHWARZ_EQ]);; + +let BETWEEN_EXISTS_EXTENSION = prove + (`!a b x:real^N. + between b (a,x) /\ ~(b = a) ==> ?d. &0 <= d /\ x = b + d % (b - a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BETWEEN_NORM] THEN STRIP_TAC THEN + EXISTS_TAC `norm(x - b:real^N) / norm(b - a)` THEN + SIMP_TAC[REAL_LE_DIV; NORM_POS_LE] THEN FIRST_X_ASSUM + (MP_TAC o AP_TERM `(%) (inv(norm(b - a:real^N))):real^N->real^N`) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; NORM_EQ_0; VECTOR_SUB_EQ] THEN + VECTOR_ARITH_TAC);; + +let BETWEEN_IMP_COLLINEAR = prove + (`!a b x:real^N. between x (a,b) ==> collinear {a,x,b}`, + REPEAT GEN_TAC THEN MAP_EVERY + (fun t -> ASM_CASES_TAC t THEN + TRY(ASM_REWRITE_TAC[INSERT_AC; COLLINEAR_2] THEN NO_TAC)) + [`x:real^N = a`; `x:real^N = b`; `a:real^N = b`] THEN + ONCE_REWRITE_TAC[COLLINEAR_3; BETWEEN_NORM] THEN + DISCH_TAC THEN REWRITE_TAC[COLLINEAR_LEMMA] THEN + REPEAT DISJ2_TAC THEN EXISTS_TAC `--(norm(b - x:real^N) / norm(x - a))` THEN + MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `norm(x - a:real^N)` THEN + ASM_REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RNEG] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + VECTOR_ARITH_TAC);; + +let COLLINEAR_BETWEEN_CASES = prove + (`!a b c:real^N. + collinear {a,b,c} <=> + between a (b,c) \/ between b (c,a) \/ between c (a,b)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[COLLINEAR_3_EXPAND] THEN + ASM_CASES_TAC `c:real^N = a` THEN ASM_REWRITE_TAC[BETWEEN_REFL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[between; dist] THEN + REWRITE_TAC[VECTOR_ARITH `(u % a + (&1 - u) % c) - c = --u % (c - a)`; + VECTOR_ARITH `(u % a + (&1 - u) % c) - a = (&1 - u) % (c - a)`; + VECTOR_ARITH `c - (u % a + (&1 - u) % c) = u % (c - a)`; + VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (u - &1) % (c - a)`] THEN + REWRITE_TAC[NORM_MUL] THEN + SUBST1_TAC(NORM_ARITH `norm(a - c:real^N) = norm(c - a)`) THEN + REWRITE_TAC[REAL_ARITH `a * c + c = (a + &1) * c`; GSYM REAL_ADD_RDISTRIB; + REAL_ARITH `c + a * c = (a + &1) * c`] THEN + ASM_REWRITE_TAC[REAL_EQ_MUL_RCANCEL; + REAL_RING `n = x * n <=> n = &0 \/ x = &1`] THEN + ASM_REWRITE_TAC[NORM_EQ_0; VECTOR_SUB_EQ] THEN REAL_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (MP_TAC o MATCH_MP + BETWEEN_IMP_COLLINEAR)) THEN + REWRITE_TAC[INSERT_AC]]);; + +let COLLINEAR_DIST_BETWEEN = prove + (`!a b x. collinear {x,a,b} /\ + dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b) + ==> between x (a,b)`, + SIMP_TAC[COLLINEAR_BETWEEN_CASES; between; DIST_SYM] THEN NORM_ARITH_TAC);; + +let BETWEEN_COLLINEAR_DIST_EQ = prove + (`!a b x:real^N. + between x (a,b) <=> + collinear {a, x, b} /\ + dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[BETWEEN_IMP_COLLINEAR] THEN REWRITE_TAC[between] THEN + NORM_ARITH_TAC; + MESON_TAC[COLLINEAR_DIST_BETWEEN; INSERT_AC]]);; + +let COLLINEAR_1 = prove + (`!s:real^1->bool. collinear s`, + GEN_TAC THEN MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `(vec 0:real^1) INSERT (vec 1) INSERT s` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + W(MP_TAC o PART_MATCH (lhs o rand) COLLINEAR_TRIPLES o snd) THEN + REWRITE_TAC[VEC_EQ; ARITH_EQ] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COLLINEAR_BETWEEN_CASES] THEN + REWRITE_TAC[between; DIST_REAL; GSYM drop; DROP_VEC; REAL_ABS_NUM] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Midpoint between two points. *) +(* ------------------------------------------------------------------------- *) + +let midpoint = new_definition + `midpoint(a,b) = inv(&2) % (a + b)`;; + +let MIDPOINT_REFL = prove + (`!x. midpoint(x,x) = x`, + REWRITE_TAC[midpoint] THEN VECTOR_ARITH_TAC);; + +let MIDPOINT_SYM = prove + (`!a b. midpoint(a,b) = midpoint(b,a)`, + REWRITE_TAC[midpoint; VECTOR_ADD_SYM]);; + +let DIST_MIDPOINT = prove + (`!a b. dist(a,midpoint(a,b)) = dist(a,b) / &2 /\ + dist(b,midpoint(a,b)) = dist(a,b) / &2 /\ + dist(midpoint(a,b),a) = dist(a,b) / &2 /\ + dist(midpoint(a,b),b) = dist(a,b) / &2`, + REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);; + +let MIDPOINT_EQ_ENDPOINT = prove + (`!a b. (midpoint(a,b) = a <=> a = b) /\ + (midpoint(a,b) = b <=> a = b) /\ + (a = midpoint(a,b) <=> a = b) /\ + (b = midpoint(a,b) <=> a = b)`, + REWRITE_TAC[midpoint] THEN NORM_ARITH_TAC);; + +let BETWEEN_MIDPOINT = prove + (`!a b. between (midpoint(a,b)) (a,b) /\ between (midpoint(a,b)) (b,a)`, + REWRITE_TAC[between; midpoint] THEN NORM_ARITH_TAC);; + +let MIDPOINT_LINEAR_IMAGE = prove + (`!f a b. linear f ==> midpoint(f a,f b) = f(midpoint(a,b))`, + SIMP_TAC[midpoint; LINEAR_ADD; LINEAR_CMUL]);; + +let COLLINEAR_MIDPOINT = prove + (`!a b. collinear{a,midpoint(a,b),b}`, + REPEAT GEN_TAC THEN REWRITE_TAC[COLLINEAR_3_EXPAND; midpoint] THEN + DISJ2_TAC THEN EXISTS_TAC `&1 / &2` THEN VECTOR_ARITH_TAC);; + +let MIDPOINT_COLLINEAR = prove + (`!a b c:real^N. + ~(a = c) + ==> (b = midpoint(a,c) <=> collinear{a,b,c} /\ dist(a,b) = dist(b,c))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(a ==> b) /\ (b ==> (a <=> c)) ==> (a <=> b /\ c)`) THEN + SIMP_TAC[COLLINEAR_MIDPOINT] THEN ASM_REWRITE_TAC[COLLINEAR_3_EXPAND] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[midpoint; dist] THEN + REWRITE_TAC + [VECTOR_ARITH `a - (u % a + (&1 - u) % c) = (&1 - u) % (a - c)`; + VECTOR_ARITH `(u % a + (&1 - u) % c) - c = u % (a - c)`; + VECTOR_ARITH `u % a + (&1 - u) % c = inv (&2) % (a + c) <=> + (u - &1 / &2) % (a - c) = vec 0`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_EQ_MUL_RCANCEL; NORM_EQ_0; VECTOR_SUB_EQ; + VECTOR_MUL_EQ_0] THEN + REAL_ARITH_TAC);; + +let MIDPOINT_BETWEEN = prove + (`!a b c:real^N. + b = midpoint (a,c) <=> between b (a,c) /\ dist (a,b) = dist (b,c)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = c` THENL + [ASM_SIMP_TAC[BETWEEN_REFL_EQ; MIDPOINT_REFL; DIST_SYM]; ALL_TAC] THEN + EQ_TAC THEN SIMP_TAC[BETWEEN_MIDPOINT; DIST_MIDPOINT] THEN + ASM_MESON_TAC[MIDPOINT_COLLINEAR; BETWEEN_IMP_COLLINEAR]);; + +(* ------------------------------------------------------------------------- *) +(* General "one way" lemma for properties preserved by injective map. *) +(* ------------------------------------------------------------------------- *) + +let WLOG_LINEAR_INJECTIVE_IMAGE_2 = prove + (`!P Q. (!f s. P s /\ linear f ==> Q(IMAGE f s)) /\ + (!g t. Q t /\ linear g ==> P(IMAGE g t)) + ==> !f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> !s. Q(IMAGE f s) <=> P s`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`]) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID]);; + +let WLOG_LINEAR_INJECTIVE_IMAGE_2_ALT = prove + (`!P Q f s. (!h u. P u /\ linear h ==> Q(IMAGE h u)) /\ + (!g t. Q t /\ linear g ==> P(IMAGE g t)) /\ + linear f /\ (!x y. f x = f y ==> x = y) + ==> (Q(IMAGE f s) <=> P s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + WLOG_LINEAR_INJECTIVE_IMAGE_2) THEN + ASM_REWRITE_TAC[]);; + +let WLOG_LINEAR_INJECTIVE_IMAGE = prove + (`!P. (!f s. P s /\ linear f ==> P(IMAGE f s)) + ==> !f:real^N->real^N. linear f /\ (!x y. f x = f y ==> x = y) + ==> !s. P(IMAGE f s) <=> P s`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WLOG_LINEAR_INJECTIVE_IMAGE_2 THEN + ASM_REWRITE_TAC[]);; + +let WLOG_LINEAR_INJECTIVE_IMAGE_ALT = prove + (`!P f s. (!g t. P t /\ linear g ==> P(IMAGE g t)) /\ + linear f /\ (!x y. f x = f y ==> x = y) + ==> (P(IMAGE f s) <=> P s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + WLOG_LINEAR_INJECTIVE_IMAGE) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Inference rule to apply it conveniently. *) +(* *) +(* |- !f s. P s /\ linear f ==> P(IMAGE f s) [or /\ commuted] *) +(* --------------------------------------------------------------- *) +(* |- !f s. linear f /\ (!x y. f x = f y ==> x = y) *) +(* ==> (Q(IMAGE f s) <=> P s) *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_INVARIANT_RULE th = + let [f;s] = fst(strip_forall(concl th)) in + let (rm,rn) = dest_fun_ty (type_of f) in + let m = last(snd(dest_type rm)) and n = last(snd(dest_type rn)) in + let th' = INST_TYPE [m,n; n,m] th in + let th0 = CONJ th th' in + let th1 = try MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 th0 + with Failure _ -> + MATCH_MP WLOG_LINEAR_INJECTIVE_IMAGE_2 + (GEN_REWRITE_RULE (BINOP_CONV o ONCE_DEPTH_CONV) [CONJ_SYM] th0) in + GEN_REWRITE_RULE BINDER_CONV [RIGHT_IMP_FORALL_THM] th1;; + +(* ------------------------------------------------------------------------- *) +(* Immediate application. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (subspace (IMAGE f s) <=> subspace s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE SUBSPACE_LINEAR_IMAGE));; + +(* ------------------------------------------------------------------------- *) +(* Storage of useful "invariance under linear map / translation" theorems. *) +(* ------------------------------------------------------------------------- *) + +let invariant_under_linear = ref([]:thm list);; + +let invariant_under_translation = ref([]:thm list);; + +let scaling_theorems = ref([]:thm list);; + +(* ------------------------------------------------------------------------- *) +(* Scaling theorems and derivation from linear invariance. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_SCALING = prove + (`!c. linear(\x:real^N. c % x)`, + REWRITE_TAC[linear] THEN VECTOR_ARITH_TAC);; + +let INJECTIVE_SCALING = prove + (`!c. (!x y:real^N. c % x = c % y ==> x = y) <=> ~(c = &0)`, + GEN_TAC THEN REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN + ASM_CASES_TAC `c:real = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`vec 0:real^N`; `vec 1:real^N`]) THEN + REWRITE_TAC[VEC_EQ; ARITH]);; + +let SURJECTIVE_SCALING = prove + (`!c. (!y:real^N. ?x. c % x = y) <=> ~(c = &0)`, + ASM_SIMP_TAC[LINEAR_SURJECTIVE_IFF_INJECTIVE; LINEAR_SCALING] THEN + REWRITE_TAC[INJECTIVE_SCALING]);; + +let SCALING_INVARIANT = + let pths = (CONJUNCTS o UNDISCH o prove) + (`&0 < c + ==> linear(\x:real^N. c % x) /\ + (!x y:real^N. c % x = c % y ==> x = y) /\ + (!y:real^N. ?x. c % x = y)`, + SIMP_TAC[REAL_LT_IMP_NZ; LINEAR_SCALING; + INJECTIVE_SCALING; SURJECTIVE_SCALING]) + and sc_tm = `\x:real^N. c % x` + and sa_tm = `&0:real < c` + and c_tm = `c:real` in + fun th -> + let ith = BETA_RULE(ISPEC sc_tm th) in + let avs,bod = strip_forall(concl ith) in + let cjs = conjuncts(lhand bod) in + let cths = map (fun t -> find(fun th -> aconv (concl th) t) pths) cjs in + let oth = MP (SPECL avs ith) (end_itlist CONJ cths) in + GEN c_tm (DISCH sa_tm (GENL avs oth));; + +let scaling_theorems = ref([]:thm list);; + +(* ------------------------------------------------------------------------- *) +(* Augmentation of the lists. The "add_linear_invariants" also updates *) +(* the scaling theorems automatically, so only a few of those will need *) +(* to be added explicitly. *) +(* ------------------------------------------------------------------------- *) + +let add_scaling_theorems thl = + (scaling_theorems := (!scaling_theorems) @ thl);; + +let add_linear_invariants thl = + ignore(mapfilter (fun th -> add_scaling_theorems[SCALING_INVARIANT th]) thl); + (invariant_under_linear := (!invariant_under_linear) @ thl);; + +let add_translation_invariants thl = + (invariant_under_translation := (!invariant_under_translation) @ thl);; + +(* ------------------------------------------------------------------------- *) +(* Start with some basic set equivalences. *) +(* We give them all an injectivity hypothesis even if it's not necessary. *) +(* For just the intersection theorem we add surjectivity (more manageable *) +(* than assuming that the set isn't empty). *) +(* ------------------------------------------------------------------------- *) + +let th_sets = prove + (`!f. (!x y. f x = f y ==> x = y) + ==> (if p then f x else f y) = f(if p then x else y) /\ + (if p then IMAGE f s else IMAGE f t) = + IMAGE f (if p then s else t) /\ + (f x) INSERT (IMAGE f s) = IMAGE f (x INSERT s) /\ + (IMAGE f s) DELETE (f x) = IMAGE f (s DELETE x) /\ + (IMAGE f s) INTER (IMAGE f t) = IMAGE f (s INTER t) /\ + (IMAGE f s) UNION (IMAGE f t) = IMAGE f (s UNION t) /\ + UNIONS(IMAGE (IMAGE f) u) = IMAGE f (UNIONS u) /\ + (IMAGE f s) DIFF (IMAGE f t) = IMAGE f (s DIFF t) /\ + (IMAGE f s (f x) <=> s x) /\ + ((f x) IN (IMAGE f s) <=> x IN s) /\ + ((f o xs) (n:num) = f(xs n)) /\ + ((f o pt) (tt:real^1) = f(pt tt)) /\ + (DISJOINT (IMAGE f s) (IMAGE f t) <=> DISJOINT s t) /\ + ((IMAGE f s) SUBSET (IMAGE f t) <=> s SUBSET t) /\ + ((IMAGE f s) PSUBSET (IMAGE f t) <=> s PSUBSET t) /\ + (IMAGE f s = IMAGE f t <=> s = t) /\ + ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n) /\ + (FINITE(IMAGE f s) <=> FINITE s) /\ + (INFINITE(IMAGE f s) <=> INFINITE s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_UNIONS] THEN + REWRITE_TAC[o_THM; MESON[IN] `IMAGE f s y <=> y IN IMAGE f s`] THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [MESON_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[INFINITE; TAUT `(~p <=> ~q) <=> (p <=> q)`] THEN + REPLICATE_TAC 11 (CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[HAS_SIZE] THEN + ASM_MESON_TAC[FINITE_IMAGE_INJ_EQ; CARD_IMAGE_INJ]) in +let f = `f:real^M->real^N` +and imf = `IMAGE (f:real^M->real^N)` +and a = `a:real^N` +and ima = `IMAGE (\x:real^N. a + x)` +and vth = VECTOR_ARITH `!x y. a + x:real^N = a + y ==> x = y` in +let th1 = UNDISCH(ISPEC f th_sets) +and th1' = UNDISCH + (GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC imf th_sets)) +and th2 = MATCH_MP th_sets vth +and th2' = MATCH_MP + (BETA_RULE(GEN_REWRITE_RULE LAND_CONV [INJECTIVE_IMAGE] (ISPEC ima th_sets))) + vth in +let fn a th = GENL (a::subtract (frees(concl th)) [a]) th in +add_linear_invariants(map (fn f o DISCH_ALL) (CONJUNCTS th1 @ CONJUNCTS th1')), +add_translation_invariants(map (fn a) (CONJUNCTS th2 @ CONJUNCTS th2'));; + +let th_set = prove + (`!f:A->B s. (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> INTERS (IMAGE (IMAGE f) s) = IMAGE f (INTERS s)`, + REWRITE_TAC[INTERS_IMAGE] THEN SET_TAC[]) in +let th_vec = prove + (`!a:real^N s. + INTERS (IMAGE (IMAGE (\x. a + x)) s) = IMAGE (\x. a + x) (INTERS s)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC th_set THEN + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = y <=> x = y - a`; EXISTS_REFL]) in +add_linear_invariants [th_set],add_translation_invariants[th_vec];; + +(* ------------------------------------------------------------------------- *) +(* Now add arithmetical equivalences. *) +(* ------------------------------------------------------------------------- *) + +let PRESERVES_NORM_PRESERVES_DOT = prove + (`!f:real^M->real^N x y. + linear f /\ (!x. norm(f x) = norm x) + ==> (f x) dot (f y) = x dot y`, + REWRITE_TAC[NORM_EQ] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x + y:real^M`) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_ADD th]) THEN + ASM_REWRITE_TAC[DOT_LADD; DOT_RADD] THEN + REWRITE_TAC[DOT_SYM] THEN REAL_ARITH_TAC);; + +let PRESERVES_NORM_INJECTIVE = prove + (`!f:real^M->real^N. + linear f /\ (!x. norm(f x) = norm x) + ==> !x y. f x = f y ==> x = y`, + SIMP_TAC[LINEAR_INJECTIVE_0; GSYM NORM_EQ_0]);; + +let ORTHOGONAL_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N x y. + linear f /\ (!x. norm(f x) = norm x) + ==> (orthogonal (f x) (f y) <=> orthogonal x y)`, + SIMP_TAC[orthogonal; PRESERVES_NORM_PRESERVES_DOT]);; + +add_linear_invariants + [GSYM LINEAR_ADD; + GSYM LINEAR_CMUL; + GSYM LINEAR_SUB; + GSYM LINEAR_NEG; + MIDPOINT_LINEAR_IMAGE; + MESON[] `!f:real^M->real^N x. + (!x. norm(f x) = norm x) ==> norm(f x) = norm x`; + PRESERVES_NORM_PRESERVES_DOT; + MESON[dist; LINEAR_SUB] + `!f:real^M->real^N x y. + linear f /\ (!x. norm(f x) = norm x) + ==> dist(f x,f y) = dist(x,y)`; + MESON[] `!f:real^M->real^N x y. + (!x y. f x = f y ==> x = y) ==> (f x = f y <=> x = y)`; + SUBSPACE_LINEAR_IMAGE_EQ; + ORTHOGONAL_LINEAR_IMAGE_EQ; + SPAN_LINEAR_IMAGE; + DEPENDENT_LINEAR_IMAGE_EQ; + INDEPENDENT_LINEAR_IMAGE_EQ; + DIM_INJECTIVE_LINEAR_IMAGE];; + +add_translation_invariants + [VECTOR_ARITH `!a x y. a + x:real^N = a + y <=> x = y`; + NORM_ARITH `!a x y. dist(a + x,a + y) = dist(x,y)`; + VECTOR_ARITH `!a x y. &1 / &2 % ((a + x) + (a + y)) = a + &1 / &2 % (x + y)`; + VECTOR_ARITH `!a x y. inv(&2) % ((a + x) + (a + y)) = a + inv(&2) % (x + y)`; + VECTOR_ARITH `!a x y. (a + x) - (a + y):real^N = x - y`; + (EQT_ELIM o (REWRITE_CONV[midpoint] THENC(EQT_INTRO o NORM_ARITH))) + `!a x y. midpoint(a + x,a + y) = a + midpoint(x,y)`; + (EQT_ELIM o (REWRITE_CONV[between] THENC(EQT_INTRO o NORM_ARITH))) + `!a x y z. between (a + x) (a + y,a + z) <=> between x (y,z)`];; + +let th = prove + (`!a s b c:real^N. (a + b) + c IN IMAGE (\x. a + x) s <=> (b + c) IN s`, + REWRITE_TAC[IN_IMAGE; VECTOR_ARITH + `(a + b) + c:real^N = a + x <=> x = b + c`] THEN + MESON_TAC[]) in +add_translation_invariants [th];; + +(* ------------------------------------------------------------------------- *) +(* A few for lists. *) +(* ------------------------------------------------------------------------- *) + +let MEM_TRANSLATION = prove + (`!a:real^N x l. MEM (a + x) (MAP (\x. a + x) l) <=> MEM x l`, + REWRITE_TAC[MEM_MAP; VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + MESON_TAC[]);; + +add_translation_invariants [MEM_TRANSLATION];; + +let MEM_LINEAR_IMAGE = prove + (`!f:real^M->real^N x l. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (MEM (f x) (MAP f l) <=> MEM x l)`, + REWRITE_TAC[MEM_MAP] THEN MESON_TAC[]);; + +add_linear_invariants [MEM_LINEAR_IMAGE];; + +let LENGTH_TRANSLATION = prove + (`!a:real^N l. LENGTH(MAP (\x. a + x) l) = LENGTH l`, + REWRITE_TAC[LENGTH_MAP]) in +add_translation_invariants [LENGTH_TRANSLATION];; + +let LENGTH_LINEAR_IMAGE = prove + (`!f:real^M->real^N l. linear f ==> LENGTH(MAP f l) = LENGTH l`, + REWRITE_TAC[LENGTH_MAP]) in +add_linear_invariants [LENGTH_LINEAR_IMAGE];; + +let CONS_TRANSLATION = prove + (`!a:real^N h t. + CONS ((\x. a + x) h) (MAP (\x. a + x) t) = MAP (\x. a + x) (CONS h t)`, + REWRITE_TAC[MAP]) in +add_translation_invariants [CONS_TRANSLATION];; + +let CONS_LINEAR_IMAGE = prove + (`!f:real^M->real^N h t. + linear f ==> CONS (f h) (MAP f t) = MAP f (CONS h t)`, + REWRITE_TAC[MAP]) in +add_linear_invariants [CONS_LINEAR_IMAGE];; + +let APPEND_TRANSLATION = prove + (`!a:real^N l1 l2. + APPEND (MAP (\x. a + x) l1) (MAP (\x. a + x) l2) = + MAP (\x. a + x) (APPEND l1 l2)`, + REWRITE_TAC[MAP_APPEND]) in +add_translation_invariants [APPEND_TRANSLATION];; + +let APPEND_LINEAR_IMAGE = prove + (`!f:real^M->real^N l1 l2. + linear f ==> APPEND (MAP f l1) (MAP f l2) = MAP f (APPEND l1 l2)`, + REWRITE_TAC[MAP_APPEND]) in +add_linear_invariants [APPEND_LINEAR_IMAGE];; + +let REVERSE_TRANSLATION = prove + (`!a:real^N l. REVERSE(MAP (\x. a + x) l) = MAP (\x. a + x) (REVERSE l)`, + REWRITE_TAC[MAP_REVERSE]) in +add_translation_invariants [REVERSE_TRANSLATION];; + +let REVERSE_LINEAR_IMAGE = prove + (`!f:real^M->real^N l. linear f ==> REVERSE(MAP f l) = MAP f (REVERSE l)`, + REWRITE_TAC[MAP_REVERSE]) in +add_linear_invariants [REVERSE_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* A few scaling theorems that don't come from invariance theorems. Most are *) +(* artificially weak with 0 < c hypotheses, so we don't bind them to names. *) +(* ------------------------------------------------------------------------- *) + +let DOT_SCALING = prove + (`!c. &0 < c ==> !x y. (c % x) dot (c % y) = c pow 2 * (x dot y)`, + REWRITE_TAC[DOT_LMUL; DOT_RMUL] THEN REAL_ARITH_TAC) in +add_scaling_theorems [DOT_SCALING];; + +let DIST_SCALING = prove + (`!c. &0 < c ==> !x y. dist(c % x,c % y) = c * dist(x,y)`, + SIMP_TAC[DIST_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in +add_scaling_theorems [DIST_SCALING];; + +let ORTHOGONAL_SCALING = prove + (`!c. &0 < c ==> !x y. orthogonal (c % x) (c % y) <=> orthogonal x y`, + REWRITE_TAC[orthogonal; DOT_LMUL; DOT_RMUL] THEN CONV_TAC REAL_FIELD) in +add_scaling_theorems [ORTHOGONAL_SCALING];; + +let NORM_SCALING = prove + (`!c. &0 < c ==> !x. norm(c % x) = c * norm x`, + SIMP_TAC[NORM_MUL; REAL_ARITH `&0 < c ==> abs c = c`]) in +add_scaling_theorems [NORM_SCALING];; + +add_scaling_theorems + [REAL_ARITH `!c. &0 < c ==> !a b. a * c * b = c * a * b`; + REAL_ARITH `!c. &0 < c ==> !a b. c * a + c * b = c * (a + b)`; + REAL_ARITH `!c. &0 < c ==> !a b. c * a - c * b = c * (a - b)`; + REAL_FIELD `!c. &0 < c ==> !a b. c * a = c * b <=> a = b`; + MESON[REAL_LT_LMUL_EQ] `!c. &0 < c ==> !a b. c * a < c * b <=> a < b`; + MESON[REAL_LE_LMUL_EQ] `!c. &0 < c ==> !a b. c * a <= c * b <=> a <= b`; + MESON[REAL_LT_LMUL_EQ; real_gt] + `!c. &0 < c ==> !a b. c * a > c * b <=> a > b`; + MESON[REAL_LE_LMUL_EQ; real_ge] + `!c. &0 < c ==> !a b. c * a >= c * b <=> a >= b`; + MESON[REAL_POW_MUL] + `!c. &0 < c ==> !a n. (c * a) pow n = c pow n * a pow n`; + REAL_ARITH `!c. &0 < c ==> !a b n. a * c pow n * b = c pow n * a * b`; + REAL_ARITH + `!c. &0 < c ==> !a b n. c pow n * a + c pow n * b = c pow n * (a + b)`; + REAL_ARITH + `!c. &0 < c ==> !a b n. c pow n * a - c pow n * b = c pow n * (a - b)`; + MESON[REAL_POW_LT; REAL_EQ_LCANCEL_IMP; REAL_LT_IMP_NZ] + `!c. &0 < c ==> !a b n. c pow n * a = c pow n * b <=> a = b`; + MESON[REAL_LT_LMUL_EQ; REAL_POW_LT] + `!c. &0 < c ==> !a b n. c pow n * a < c pow n * b <=> a < b`; + MESON[REAL_LE_LMUL_EQ; REAL_POW_LT] + `!c. &0 < c ==> !a b n. c pow n * a <= c pow n * b <=> a <= b`; + MESON[REAL_LT_LMUL_EQ; real_gt; REAL_POW_LT] + `!c. &0 < c ==> !a b n. c pow n * a > c pow n * b <=> a > b`; + MESON[REAL_LE_LMUL_EQ; real_ge; REAL_POW_LT] + `!c. &0 < c ==> !a b n. c pow n * a >= c pow n * b <=> a >= b`];; + +(* ------------------------------------------------------------------------- *) +(* Theorem deducing quantifier mappings from surjectivity. *) +(* ------------------------------------------------------------------------- *) + +let QUANTIFY_SURJECTION_THM = prove + (`!f:A->B. + (!y. ?x. f x = y) + ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\ + (!P. (?x. P x) <=> (?x. P (f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\ + (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s)))) /\ + (!P. {x | P x} = IMAGE f {x | P(f x)})`, + GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [SURJECTIVE_RIGHT_INVERSE] THEN + DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN + SUBGOAL_THEN `!s. IMAGE (f:A->B) (IMAGE g s) = s` ASSUME_TAC THENL + [ASM SET_TAC[]; CONJ_TAC THENL [ASM MESON_TAC[]; ASM SET_TAC[]]]);; + +let QUANTIFY_SURJECTION_HIGHER_THM = prove + (`!f:A->B. + (!y. ?x. f x = y) + ==> ((!P. (!x. P x) <=> (!x. P (f x))) /\ + (!P. (?x. P x) <=> (?x. P (f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q(IMAGE f s))) /\ + (!Q. (?s. Q s) <=> (?s. Q(IMAGE f s))) /\ + (!Q. (!s. Q s) <=> (!s. Q(IMAGE (IMAGE f) s))) /\ + (!Q. (?s. Q s) <=> (?s. Q(IMAGE (IMAGE f) s))) /\ + (!P. (!g:real^1->B. P g) <=> (!g. P(f o g))) /\ + (!P. (?g:real^1->B. P g) <=> (?g. P(f o g))) /\ + (!P. (!g:num->B. P g) <=> (!g. P(f o g))) /\ + (!P. (?g:num->B. P g) <=> (?g. P(f o g))) /\ + (!Q. (!l. Q l) <=> (!l. Q(MAP f l))) /\ + (!Q. (?l. Q l) <=> (?l. Q(MAP f l)))) /\ + ((!P. {x | P x} = IMAGE f {x | P(f x)}) /\ + (!Q. {s | Q s} = IMAGE (IMAGE f) {s | Q(IMAGE f s)}) /\ + (!R. {l | R l} = IMAGE (MAP f) {l | R(MAP f l)}))`, + GEN_TAC THEN DISCH_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + ASM_REWRITE_TAC[GSYM SURJECTIVE_FORALL_THM; GSYM SURJECTIVE_EXISTS_THM; + GSYM SURJECTIVE_IMAGE_THM; SURJECTIVE_IMAGE; SURJECTIVE_MAP] THEN + REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Apply such quantifier and set expansions once per level at depth. *) +(* In the PARTIAL version, avoid expanding named variables in list. *) +(* ------------------------------------------------------------------------- *) + +let PARTIAL_EXPAND_QUANTS_CONV avoid th = + let ath,sth = CONJ_PAIR th in + let conv1 = GEN_REWRITE_CONV I [ath] + and conv2 = GEN_REWRITE_CONV I [sth] in + let conv1' tm = + let th = conv1 tm in + if mem (fst(dest_var(fst(dest_abs(rand tm))))) avoid + then failwith "Not going to expand this variable" else th in + let rec conv tm = + ((conv1' THENC BINDER_CONV conv) ORELSEC + (conv2 THENC + RAND_CONV(RAND_CONV(ABS_CONV(BINDER_CONV(LAND_CONV conv))))) ORELSEC + SUB_CONV conv) tm in + conv;; + +let EXPAND_QUANTS_CONV = PARTIAL_EXPAND_QUANTS_CONV [];; diff --git a/Multivariate/wlog.ml b/Multivariate/wlog.ml new file mode 100644 index 0000000..14c6104 --- /dev/null +++ b/Multivariate/wlog.ml @@ -0,0 +1,389 @@ +(* ========================================================================= *) +(* Geometric "without loss of generality" tactics to pick convenient coords. *) +(* ========================================================================= *) + +needs "Multivariate/determinants.ml";; +needs "Multivariate/convex.ml";; + +(* ------------------------------------------------------------------------- *) +(* Flyspeck definition of plane, and its invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let plane = new_definition + `plane x = (?u v w. ~(collinear {u,v,w}) /\ x = affine hull {u,v,w})`;; + +let PLANE_TRANSLATION_EQ = prove + (`!a:real^N s. plane(IMAGE (\x. a + x) s) <=> plane s`, + REWRITE_TAC[plane] THEN GEOM_TRANSLATE_TAC[]);; + +let PLANE_TRANSLATION = prove + (`!a:real^N s. plane s ==> plane(IMAGE (\x. a + x) s)`, + REWRITE_TAC[PLANE_TRANSLATION_EQ]);; + +add_translation_invariants [PLANE_TRANSLATION_EQ];; + +let PLANE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N p. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (plane(IMAGE f p) <=> plane p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[plane] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `?u. u IN IMAGE f (:real^M) /\ + ?v. v IN IMAGE f (:real^M) /\ + ?w. w IN IMAGE (f:real^M->real^N) (:real^M) /\ + ~collinear {u, v, w} /\ IMAGE f p = affine hull {u, v, w}` THEN + CONJ_TAC THENL + [REWRITE_TAC[RIGHT_AND_EXISTS_THM; IN_IMAGE; IN_UNIV] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{u,v,w} SUBSET IMAGE (f:real^M->real^N) p` MP_TAC THENL + [ASM_REWRITE_TAC[HULL_SUBSET]; SET_TAC[]]; + REWRITE_TAC[EXISTS_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[SET_RULE `{f a,f b,f c} = IMAGE f {a,b,c}`] THEN + ASM_SIMP_TAC[AFFINE_HULL_LINEAR_IMAGE] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN BINOP_TAC THENL + [ASM_MESON_TAC[COLLINEAR_LINEAR_IMAGE_EQ]; ASM SET_TAC[]]]);; + +let PLANE_LINEAR_IMAGE = prove + (`!f:real^M->real^N p. + linear f /\ plane p /\ (!x y. f x = f y ==> x = y) + ==> plane(IMAGE f p)`, + MESON_TAC[PLANE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [PLANE_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Rotating and translating so a given plane in R^3 becomes {x | x$3 = &0}. *) +(* ------------------------------------------------------------------------- *) + +let ROTATION_PLANE_HORIZONTAL = prove + (`!s. plane s + ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ + IMAGE f (IMAGE (\x. a + x) s) = {z:real^3 | z$3 = &0}`, + let lemma = prove + (`span {z:real^3 | z$3 = &0} = {z:real^3 | z$3 = &0}`, + REWRITE_TAC[SPAN_EQ_SELF; subspace; IN_ELIM_THM] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + DIMINDEX_3; ARITH] THEN REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^3`; `b:real^3`; `c:real^3`] THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[COLLINEAR_2; INSERT_AC]; + ALL_TAC]) + [`a:real^3 = b`; `a:real^3 = c`; `b:real^3 = c`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) THEN + ASM_SIMP_TAC[AFFINE_HULL_INSERT_SPAN; IN_INSERT; NOT_IN_EMPTY] THEN + EXISTS_TAC `--a:real^3` THEN + REWRITE_TAC[SET_RULE `IMAGE (\x:real^3. --a + x) {a + x | x | x IN s} = + IMAGE (\x. --a + a + x) s`] THEN + REWRITE_TAC[VECTOR_ARITH `--a + a + x:real^3 = x`; IMAGE_ID] THEN + REWRITE_TAC[SET_RULE `{x - a:real^x | x = b \/ x = c} = {b - a,c - a}`] THEN + MP_TAC(ISPEC `span{b - a:real^3,c - a}` + ROTATION_LOWDIM_HORIZONTAL) THEN + REWRITE_TAC[DIMINDEX_3] THEN ANTS_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD{b - a:real^3,c - a}` THEN + SIMP_TAC[DIM_SPAN; DIM_LE_CARD; FINITE_RULES] THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^3->real^3` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + ASM_SIMP_TAC[GSYM SPAN_LINEAR_IMAGE] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM lemma] THEN + MATCH_MP_TAC DIM_EQ_SPAN THEN CONJ_TAC THENL + [ASM_MESON_TAC[IMAGE_SUBSET; SPAN_INC; SUBSET_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `2` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`{z:real^3 | z$3 = &0}`; `(:real^3)`] DIM_EQ_SPAN) THEN + REWRITE_TAC[SUBSET_UNIV; DIM_UNIV; DIMINDEX_3; lemma] THEN + MATCH_MP_TAC(TAUT `~r /\ (~p ==> q) ==> (q ==> r) ==> p`) THEN + REWRITE_TAC[ARITH_RULE `~(x <= 2) <=> 3 <= x`] THEN + REWRITE_TAC[EXTENSION; SPAN_UNIV; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `vector[&0;&0;&1]:real^3`) THEN + REWRITE_TAC[IN_UNIV; VECTOR_3] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `dim {b - a:real^3,c - a}` THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[LE_REFL; DIM_INJECTIVE_LINEAR_IMAGE; + ORTHOGONAL_TRANSFORMATION_INJECTIVE]] THEN + MP_TAC(ISPEC `{b - a:real^3,c - a}` INDEPENDENT_BOUND_GENERAL) THEN + SIMP_TAC[CARD_CLAUSES; FINITE_RULES; IN_SING; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`; ARITH] THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) + [SET_RULE `{a,b,c} = {b,a,c}`]) THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COLLINEAR_3] THEN + REWRITE_TAC[independent; CONTRAPOS_THM; dependent] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; RIGHT_OR_DISTRIB] THEN + REWRITE_TAC[EXISTS_OR_THM; UNWIND_THM2] THEN + ASM_SIMP_TAC[SET_RULE `~(a = b) ==> {a,b} DELETE b = {a}`; + SET_RULE `~(a = b) ==> {a,b} DELETE a = {b}`; + VECTOR_ARITH `b - a:real^3 = c - a <=> b = c`] THEN + REWRITE_TAC[SPAN_BREAKDOWN_EQ; SPAN_EMPTY; IN_SING] THEN + ONCE_REWRITE_TAC[VECTOR_SUB_EQ] THEN MESON_TAC[COLLINEAR_LEMMA; INSERT_AC]);; + +let ROTATION_HORIZONTAL_PLANE = prove + (`!p. plane p + ==> ?a f. orthogonal_transformation f /\ det(matrix f) = &1 /\ + IMAGE (\x. a + x) (IMAGE f {z:real^3 | z$3 = &0}) = p`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP ROTATION_PLANE_HORIZONTAL) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^3` + (X_CHOOSE_THEN `f:real^3->real^3` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(X_CHOOSE_THEN `g:real^3->real^3` STRIP_ASSUME_TAC o MATCH_MP + ORTHOGONAL_TRANSFORMATION_INVERSE) THEN + MAP_EVERY EXISTS_TAC [`--a:real^3`; `g:real^3->real^3`] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^3 = x`] THEN + MATCH_MP_TAC(REAL_RING `!f. f * g = &1 /\ f = &1 ==> g = &1`) THEN + EXISTS_TAC `det(matrix(f:real^3->real^3))` THEN + REWRITE_TAC[GSYM DET_MUL] THEN + ASM_SIMP_TAC[GSYM MATRIX_COMPOSE; ORTHOGONAL_TRANSFORMATION_LINEAR] THEN + ASM_REWRITE_TAC[o_DEF; MATRIX_ID; DET_I]);; + +(* ------------------------------------------------------------------------- *) +(* Apply plane rotation to a goal. *) +(* ------------------------------------------------------------------------- *) + +let GEOM_HORIZONTAL_PLANE_RULE = + let ifn = MATCH_MP + (TAUT `(p ==> (x <=> x')) /\ (~p ==> (x <=> T)) ==> (x' ==> x)`) + and pth = prove + (`!a f. orthogonal_transformation (f:real^N->real^N) + ==> ((!P. (!x. P x) <=> (!x. P (a + f x))) /\ + (!P. (?x. P x) <=> (?x. P (a + f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE (\x. a + x) (IMAGE f s)))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE (\x. a + x) (IMAGE f s))))) /\ + (!P. {x | P x} = + IMAGE (\x. a + x) (IMAGE f {x | P(a + f x)}))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `(\x. a + x) o (f:real^N->real^N)` + QUANTIFY_SURJECTION_THM) THEN REWRITE_TAC[o_THM; IMAGE_o] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE; + VECTOR_ARITH `a + (x - a:real^N) = x`]) + and cth = prove + (`!a f. {} = IMAGE (\x:real^3. a + x) (IMAGE f {})`, + REWRITE_TAC[IMAGE_CLAUSES]) + and oth = prove + (`!f:real^3->real^3. + orthogonal_transformation f /\ det(matrix f) = &1 + ==> linear f /\ + (!x y. f x = f y ==> x = y) /\ + (!y. ?x. f x = y) /\ + (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:3) ==> det(matrix f) = &1)`, + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) + and fth = MESON[] + `(!a f. q a f ==> (p <=> p' a f)) + ==> ((?a f. q a f) ==> (p <=> !a f. q a f ==> p' a f))` in + fun tm -> + let x,bod = dest_forall tm in + let th1 = EXISTS_GENVAR_RULE + (UNDISCH(ISPEC x ROTATION_HORIZONTAL_PLANE)) in + let [a;f],tm1 = strip_exists(concl th1) in + let [th_orth;th_det;th_im] = CONJUNCTS(ASSUME tm1) in + let th2 = PROVE_HYP th_orth (UNDISCH(ISPECL [a;f] pth)) in + let th3 = (EXPAND_QUANTS_CONV(ASSUME(concl th2)) THENC + SUBS_CONV[GSYM th_im; ISPECL [a;f] cth]) bod in + let th4 = PROVE_HYP th2 th3 in + let th5 = TRANSLATION_INVARIANTS a in + let th6 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) + [ASSUME(concl th5)] th4 in + let th7 = PROVE_HYP th5 th6 in + let th8s = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in + let th9 = LINEAR_INVARIANTS f th8s in + let th10 = GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th9] th7 in + let th11 = if intersect (frees(concl th10)) [a;f] = [] + then PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th10) + else MP (MATCH_MP fth (GENL [a;f] (DISCH_ALL th10))) th1 in + let th12 = REWRITE_CONV[ASSUME(mk_neg(hd(hyp th11)))] bod in + let th13 = ifn(CONJ (DISCH_ALL th11) (DISCH_ALL th12)) in + let th14 = MATCH_MP MONO_FORALL (GEN x th13) in + GEN_REWRITE_RULE (TRY_CONV o LAND_CONV) [FORALL_SIMP] th14;; + +let GEOM_HORIZONTAL_PLANE_TAC p = + W(fun (asl,w) -> + let avs,bod = strip_forall w + and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in + let avs,bod = strip_forall w in + MAP_EVERY X_GEN_TAC avs THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [p])) THEN + SPEC_TAC(p,p) THEN + W(MATCH_MP_TAC o GEOM_HORIZONTAL_PLANE_RULE o snd));; + +(* ------------------------------------------------------------------------- *) +(* Injection from real^2 -> real^3 plane with zero last coordinate. *) +(* ------------------------------------------------------------------------- *) + +let pad2d3d = new_definition + `(pad2d3d:real^2->real^3) x = lambda i. if i < 3 then x$i else &0`;; + +let FORALL_PAD2D3D_THM = prove + (`!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))`, + GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[pad2d3d] THEN + SIMP_TAC[LAMBDA_BETA; DIMINDEX_3; ARITH; LT_REFL]; + FIRST_X_ASSUM(MP_TAC o SPEC `(lambda i. (y:real^3)$i):real^2`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + SIMP_TAC[CART_EQ; pad2d3d; DIMINDEX_3; ARITH; LAMBDA_BETA; DIMINDEX_2; + ARITH_RULE `i < 3 <=> i <= 2`] THEN + REWRITE_TAC[ARITH_RULE `i <= 3 <=> i <= 2 \/ i = 3`] THEN + ASM_MESON_TAC[]]);; + +let QUANTIFY_PAD2D3D_THM = prove + (`(!P. (!y:real^3. y$3 = &0 ==> P y) <=> (!x. P(pad2d3d x))) /\ + (!P. (?y:real^3. y$3 = &0 /\ P y) <=> (?x. P(pad2d3d x)))`, + REWRITE_TAC[MESON[] `(?y. P y) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[GSYM FORALL_PAD2D3D_THM] THEN MESON_TAC[]);; + +let LINEAR_PAD2D3D = prove + (`linear pad2d3d`, + REWRITE_TAC[linear; pad2d3d] THEN + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + LAMBDA_BETA; DIMINDEX_2; DIMINDEX_3; ARITH; + ARITH_RULE `i < 3 ==> i <= 2`] THEN + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REAL_ARITH_TAC);; + +let INJECTIVE_PAD2D3D = prove + (`!x y. pad2d3d x = pad2d3d y ==> x = y`, + SIMP_TAC[CART_EQ; pad2d3d; LAMBDA_BETA; DIMINDEX_3; DIMINDEX_2] THEN + REWRITE_TAC[ARITH_RULE `i < 3 <=> i <= 2`] THEN + MESON_TAC[ARITH_RULE `i <= 2 ==> i <= 3`]);; + +let NORM_PAD2D3D = prove + (`!x. norm(pad2d3d x) = norm x`, + SIMP_TAC[NORM_EQ; DOT_2; DOT_3; pad2d3d; LAMBDA_BETA; + DIMINDEX_2; DIMINDEX_3; ARITH] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Apply 3D->2D conversion to a goal. Take care to preserve variable names. *) +(* ------------------------------------------------------------------------- *) + +let PAD2D3D_QUANTIFY_CONV = + let gv = genvar `:real^2` in + let pth = CONV_RULE (BINOP_CONV(BINDER_CONV(RAND_CONV(GEN_ALPHA_CONV gv)))) + QUANTIFY_PAD2D3D_THM in + let conv1 = GEN_REWRITE_CONV I [pth] + and dest_quant tm = try dest_forall tm with Failure _ -> dest_exists tm in + fun tm -> + let th = conv1 tm in + let name = fst(dest_var(fst(dest_quant tm))) in + let ty = snd(dest_var(fst(dest_quant(rand(concl th))))) in + CONV_RULE(RAND_CONV(GEN_ALPHA_CONV(mk_var(name,ty)))) th;; + +let PAD2D3D_TAC = + let pad2d3d_tm = `pad2d3d` + and pths = [LINEAR_PAD2D3D; INJECTIVE_PAD2D3D; NORM_PAD2D3D] + and cth = prove + (`{} = IMAGE pad2d3d {} /\ + vec 0 = pad2d3d(vec 0)`, + REWRITE_TAC[IMAGE_CLAUSES] THEN MESON_TAC[LINEAR_PAD2D3D; LINEAR_0]) in + let lasttac = + GEN_REWRITE_TAC REDEPTH_CONV [LINEAR_INVARIANTS pad2d3d_tm pths] in + fun gl -> (GEN_REWRITE_TAC ONCE_DEPTH_CONV [cth] THEN + CONV_TAC(DEPTH_CONV PAD2D3D_QUANTIFY_CONV) THEN + lasttac) gl;; + +(* ------------------------------------------------------------------------- *) +(* Rotating so a given line from the origin becomes the x-axis. *) +(* ------------------------------------------------------------------------- *) + +let ROTATION_HORIZONTAL_LINE = prove + (`!a:real^N. + ?b f. orthogonal_transformation f /\ det(matrix f) = &1 /\ f b = a /\ + (!k. 1 < k /\ k <= dimindex(:N) ==> b$k = &0)`, + GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [MAP_EVERY EXISTS_TAC [`a:real^N`; `\x:real^N. x`] THEN + ASM_SIMP_TAC[DET_I; MATRIX_ID; ORTHOGONAL_TRANSFORMATION_ID; LTE_ANTISYM]; + EXISTS_TAC `norm(a:real^N) % (basis 1):real^N` THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; LT_IMP_LE; BASIS_COMPONENT] THEN + SIMP_TAC[ARITH_RULE `1 < k ==> ~(k = 1)`; REAL_MUL_RZERO] THEN + MATCH_MP_TAC ROTATION_EXISTS THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[REAL_ABS_NORM; REAL_MUL_RID] THEN + MATCH_MP_TAC(ARITH_RULE `~(n = 1) /\ 1 <= n ==> 2 <= n`) THEN + ASM_REWRITE_TAC[DIMINDEX_GE_1]]);; + +let GEOM_HORIZONTAL_LINE_RULE = + let pth = prove + (`!f. orthogonal_transformation (f:real^N->real^N) + ==> (vec 0 = f(vec 0) /\ {} = IMAGE f {}) /\ + ((!P. (!x. P x) <=> (!x. P (f x))) /\ + (!P. (?x. P x) <=> (?x. P (f x))) /\ + (!Q. (!s. Q s) <=> (!s. Q (IMAGE f s))) /\ + (!Q. (?s. Q s) <=> (?s. Q (IMAGE f s)))) /\ + (!P. {x | P x} = IMAGE f {x | P(f x)})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[IMAGE_CLAUSES] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP ORTHOGONAL_TRANSFORMATION_LINEAR) THEN + MESON_TAC[LINEAR_0]; + MATCH_MP_TAC QUANTIFY_SURJECTION_THM THEN + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]]) + and oth = prove + (`!f:real^N->real^N. + orthogonal_transformation f /\ det(matrix f) = &1 + ==> linear f /\ + (!x y. f x = f y ==> x = y) /\ + (!y. ?x. f x = y) /\ + (!x. norm(f x) = norm x) /\ + (2 <= dimindex(:N) ==> det(matrix f) = &1)`, + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[ORTHOGONAL_TRANSFORMATION_LINEAR]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_INJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION_SURJECTIVE]; + ASM_MESON_TAC[ORTHOGONAL_TRANSFORMATION]]) + and sth = prove + (`((!k. 1 < k /\ k <= dimindex(:2) ==> b$k = &0) <=> b$2 = &0) /\ + ((!k. 1 < k /\ k <= dimindex(:3) ==> b$k = &0) <=> b$2 = &0 /\ b$3 = &0)`, + REWRITE_TAC[DIMINDEX_2; DIMINDEX_3; + ARITH_RULE `k <= 3 <=> k = 3 \/ k <= 2`; + ARITH_RULE `k <= 2 <=> k = 2 \/ ~(1 < k)`] THEN + MESON_TAC[ARITH_RULE `1 < 2 /\ 1 < 3`]) in + let sfn = GEN_REWRITE_RULE ONCE_DEPTH_CONV [sth] in + fun tm -> + let x,bod = dest_forall tm in + let th1 = EXISTS_GENVAR_RULE + (sfn(ISPEC x ROTATION_HORIZONTAL_LINE)) in + let [a;f],tm1 = strip_exists(concl th1) in + let th_orth,th2 = CONJ_PAIR(ASSUME tm1) in + let th_det,th2a = CONJ_PAIR th2 in + let th_works,th_zero = CONJ_PAIR th2a in + let thc,thq = CONJ_PAIR(PROVE_HYP th2 (UNDISCH(ISPEC f pth))) in + let th3 = CONV_RULE(RAND_CONV(SUBS_CONV(GSYM th_works::CONJUNCTS thc))) + (EXPAND_QUANTS_CONV(ASSUME(concl thq)) bod) in + let th4 = PROVE_HYP thq th3 in + let thps = CONJUNCTS(MATCH_MP oth (CONJ th_orth th_det)) in + let th5 = LINEAR_INVARIANTS f thps in + let th6 = PROVE_HYP th_orth + (GEN_REWRITE_RULE (RAND_CONV o REDEPTH_CONV) [th5] th4) in + let ntm = mk_forall(a,mk_imp(concl th_zero,rand(concl th6))) in + let th7 = MP(SPEC a (ASSUME ntm)) th_zero in + let th8 = DISCH ntm (EQ_MP (SYM th6) th7) in + if intersect (frees(concl th8)) [a;f] = [] then + let th9 = PROVE_HYP th1 (itlist SIMPLE_CHOOSE [a;f] th8) in + let th10 = DISCH ntm (GEN x (UNDISCH th9)) in + CONV_RULE(LAND_CONV (GEN_ALPHA_CONV x)) th10 + else + let mtm = list_mk_forall([a;f],mk_imp(hd(hyp th8),rand(concl th6))) in + let th9 = EQ_MP (SYM th6) (UNDISCH(SPECL [a;f] (ASSUME mtm))) in + let th10 = itlist SIMPLE_CHOOSE [a;f] (DISCH mtm th9) in + let th11 = GEN x (PROVE_HYP th1 th10) in + MATCH_MP MONO_FORALL th11;; + +let GEOM_HORIZONTAL_LINE_TAC l (asl,w as gl) = + let avs,bod = strip_forall w + and avs' = subtract (frees w) (freesl(map (concl o snd) asl)) in + (MAP_EVERY X_GEN_TAC avs THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) (rev(subtract (avs@avs') [l])) THEN + SPEC_TAC(l,l) THEN + W(MATCH_MP_TAC o GEOM_HORIZONTAL_LINE_RULE o snd)) gl;; diff --git a/Multivariate/wlog_examples.ml b/Multivariate/wlog_examples.ml new file mode 100644 index 0000000..2b3deeb --- /dev/null +++ b/Multivariate/wlog_examples.ml @@ -0,0 +1,744 @@ +(* ========================================================================= *) +(* Examples of using the "without loss of generality" tactics. *) +(* ========================================================================= *) + +needs "Multivariate/wlog.ml";; + +(* ------------------------------------------------------------------------- *) +(* Example 1. *) +(* ------------------------------------------------------------------------- *) + +let lemma = prove + (`(?y. y pow 2 = a) <=> &0 <= a`, + MESON_TAC[SQRT_POW_2; REAL_LE_SQUARE; REAL_POW_2]);; + +let TRUONG_1 = prove + (`!u1:real^3 u2 p a b. + ~(u1 = u2) /\ + plane p /\ + {u1,u2} SUBSET p /\ + dist(u1,u2) <= a + b /\ + abs(a - b) < dist(u1,u2) /\ + &0 <= a /\ + &0 <= b + ==> (?d1 d2. + {d1, d2} SUBSET p /\ + &1 / &2 % (d1 + d2) IN affine hull {u1, u2} /\ + dist(d1,u1) = a /\ + dist(d1,u2) = b /\ + dist(d2,u1) = a /\ + dist(d2,u2) = b)`, + (*** First, rotate the plane p to the special case z$3 = &0 ***) + + GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN + + (*** Now reshuffle the goal to have explicit restricted quantifiers ***) + + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d ==> e <=> c /\ a /\ b /\ d ==> e`] THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + + (*** Now replace quantifiers over real^3 with those over real^2 ***) + + PAD2D3D_TAC THEN + + (*** Tidy the goal a little ***) + + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP; GSYM CONJ_ASSOC] THEN + + (*** Choose u1 as the origin ***) + + GEOM_ORIGIN_TAC `u1:real^2` THEN + + (*** Rotate the point u2 onto the x-axis ***) + + GEOM_HORIZONTAL_LINE_TAC `u2:real^2` THEN + + (*** Only now introduce coordinates ***) + + X_GEN_TAC `u2:real^2` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; NORM_NEG] THEN + SIMP_TAC[GSYM real_gt; NORM_GT_SQUARE; NORM_EQ_SQUARE; NORM_LE_SQUARE] THEN + REWRITE_TAC[real_gt; REAL_ARITH `~(abs x < &0)`] THEN + ASM_SIMP_TAC[DOT_2; REAL_MUL_RZERO; REAL_ADD_RID; CART_EQ; DIMINDEX_2; + FORALL_2; AFFINE_HULL_2; CART_EQ; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; VEC_COMPONENT; ARITH; IN_ELIM_THM; + VECTOR_ADD_COMPONENT; REAL_SUB_RZERO; REAL_ADD_LID; + REAL_POW2_ABS] THEN + DISCH_THEN(CONJUNCTS_THEN2 (ASSUME_TAC o GSYM) STRIP_ASSUME_TAC) THEN + REWRITE_TAC[EXISTS_VECTOR_2] THEN + MATCH_MP_TAC(MESON[] + `(?x y:real. P x y x (--y)) ==> (?x y x' y'. P x y x' y')`) THEN + SIMP_TAC[AFFINE_HULL_2; IN_ELIM_THM; CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT; ARITH] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RINV] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(a = &0) + ==> (u + v = &1 /\ b = v * a <=> u = &1 - b / a /\ v = b / a)`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM; EXISTS_REFL] THEN + ABBREV_TAC `u = (u2:real^2)$1` THEN + REWRITE_TAC[REAL_ARITH `x + --y * --y:real = x + y * y`] THEN + REWRITE_TAC[TAUT `a /\ b /\ a /\ b <=> a /\ b`] THEN + + (*** Now finally dive in and solve the algebraic problem ***) + + ASM_SIMP_TAC[REAL_FIELD + `~(u = &0) + ==> (x * x + y * y = a pow 2 /\ (x - u) * (x - u) + y * y = b pow 2 <=> + x = (u pow 2 + a pow 2 - b pow 2) / (&2 * u) /\ + y pow 2 = b pow 2 - (x - u) pow 2)`] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; UNWIND_THM2; lemma] THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_FIELD + `(u pow 2 + a - b) / (&2 * u) - u = (a - b - u pow 2) / (&2 * u)`] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_LE_LDIV_EQ; + REAL_ARITH `~(u = &0) ==> &0 < abs(&2 * u)`] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; REAL_LE_SQUARE_ABS] THEN + + (*** Can just use SOS: this proof was found by SOS_RULE ***) + + MAP_EVERY UNDISCH_TAC + [`u * u <= (a + b) pow 2`; `(a - b) pow 2 < u * u`] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_IMP_LE) THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + REWRITE_TAC[IMP_IMP] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_MUL) THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Definition of "opposite" for example 2, and its invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let opposite = new_definition + `opposite a b p <=> + (&1 / &2 % (a + b)) IN p /\ + (!x y:real^N. {x,y} SUBSET p ==> (x - y) dot (a - b) = &0)`;; + +let OPPOSITE_TRANSLATION_EQ = prove + (`!c a b p. opposite (c + a) (c + b) (IMAGE (\x. c + x) p) <=> + opposite a b p`, + REWRITE_TAC[opposite] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [OPPOSITE_TRANSLATION_EQ];; + +let OPPOSITE_LINEAR_IMAGE_EQ = prove + (`!f a b p. linear f /\ (!x. norm(f x) = norm x) + ==> (opposite (f a) (f b) (IMAGE f p) <=> opposite a b p)`, + SIMP_TAC[opposite; INSERT_SUBSET; EMPTY_SUBSET; GSYM orthogonal] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[GSYM LINEAR_ADD; GSYM LINEAR_SUB; ORTHOGONAL_LINEAR_IMAGE_EQ] THEN + SIMP_TAC[GSYM LINEAR_CMUL; IN_IMAGE] THEN + MESON_TAC[PRESERVES_NORM_INJECTIVE]);; + +add_linear_invariants [OPPOSITE_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Example 2. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_PLANE = prove + (`!p. plane p ==> affine p`, + SIMP_TAC[plane; LEFT_IMP_EXISTS_THM; AFFINE_AFFINE_HULL]);; + +let lemma = prove + (`!a b:real^2. + a$2 <= &0 /\ &0 <= b$2 ==> ?x. x IN convex hull {a,b} /\ x$2 = &0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `a <= &0 /\ &0 <= b ==> a = &0 /\ b = &0 \/ &0 < b - a`)) + THENL + [EXISTS_TAC `a:real^2` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT]; + REWRITE_TAC[CONVEX_HULL_2_ALT; EXISTS_IN_GSPEC] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_SUB_COMPONENT; + DIMINDEX_2; ARITH] THEN + EXISTS_TAC `--(a$2) / ((b:real^2)$2 - (a:real^2)$2)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_RMUL; + REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let TRUONG_OPPOSITE_LEMMA = prove + (`!p a b bb m x y:real^3. + plane p /\ + {a, b, bb, m, x, y} SUBSET p /\ + ~(x = y) /\ m IN affine hull {x,y} /\ midpoint(b,bb) = m + ==> ~(convex hull {a, b} INTER affine hull {x, y} = {}) \/ + ~(convex hull {a, bb} INTER affine hull {x, y} = {})`, + + (*** Make the plane p the xy-plane ***) + + GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN + + (*** Rewrite with explicit restricted quantifiers ***) + + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(K ALL_TAC) THEN + + (*** Now replace quantifiers over real^3 with those over real^2 ***) + + PAD2D3D_TAC THEN + + (*** Let x be the origin, and y on the x-axis ***) + + GEOM_ORIGIN_TAC `x:real^2` THEN + GEOM_HORIZONTAL_LINE_TAC `y:real^2` THEN + + (*** Make a few simplifications ***) + + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + ASM_SIMP_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VEC_COMPONENT] THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + SIMP_TAC[midpoint; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + DIMINDEX_2; ARITH] THEN + + (*** Show aff{x,y} is now exactly the x-axis ***) + + SUBGOAL_THEN `affine hull {vec 0,y} = {u:real^2 | u$2 = &0}` SUBST1_TAC THENL + [MATCH_MP_TAC HULL_UNIQUE THEN + REWRITE_TAC[affine; INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN + ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_2; ARITH; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT; REAL_MUL_RZERO; REAL_ADD_RID] THEN + X_GEN_TAC `s:real^2->bool` THEN STRIP_TAC THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `u:real^2` THEN + DISCH_TAC THEN + SUBGOAL_THEN `u = (&1 - u$1 / (y:real^2)$1) % vec 0 + + (u$1 / (y:real^2)$1) % y` + SUBST1_TAC THENL + [REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + ASM_SIMP_TAC[CART_EQ; VECTOR_MUL_COMPONENT; DIMINDEX_2; ARITH; + FORALL_2; REAL_MUL_RZERO; REAL_DIV_RMUL]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + + (*** Simplify a bit more ***) + + SIMP_TAC[IN_ELIM_THM; REAL_ARITH `inv(&2) * (x + y) = &0 <=> y = --x`] THEN + REPEAT STRIP_TAC THEN + + (*** Finally, make a 4-way case split then apply the lemma to each ***) + + REWRITE_TAC[SET_RULE `~(s INTER t = {}) <=> ?x. x IN s /\ x IN t`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + FIRST_ASSUM(MP_TAC o SPEC `(a:real^2)$2` o MATCH_MP (REAL_ARITH + `b' = --b ==> !a. a <= &0 /\ &0 <= b \/ a <= &0 /\ &0 <= b' \/ + b <= &0 /\ &0 <= a \/ b' <= &0 /\ &0 <= a`)) THEN + MESON_TAC[lemma; SET_RULE `{a,b} = {b,a}`]);; + +let TRUONG_OPPOSITE_THM = prove + (`!a b bb x y:real^3 p. + ~(x = y) /\ + plane p /\ + {a, b, x, y} SUBSET p /\ + opposite b bb (affine hull {x, y}) + ==> ~(convex hull {a, b} INTER affine hull {x, y} = {}) \/ + ~(convex hull {a, bb} INTER affine hull {x, y} = {})`, + REWRITE_TAC[opposite; INSERT_SUBSET; EMPTY_SUBSET] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC TRUONG_OPPOSITE_LEMMA THEN + MAP_EVERY EXISTS_TAC [`p:real^3->bool`; `&1 / &2 % (b + bb):real^3`] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; midpoint] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP AFFINE_PLANE) THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE `!t. x IN t /\ t SUBSET s ==> x IN s`) THEN + EXISTS_TAC `affine hull {x:real^3,y}` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HULL_MINIMAL THEN ASM_SIMP_TAC[INSERT_SUBSET; EMPTY_SUBSET]; + DISCH_TAC THEN SUBST1_TAC(VECTOR_ARITH + `bb:real^3 = -- &1 % b + &2 % &1 / &2 % (b + bb)`) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[affine]) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Affsign variants for example 3, and invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let lin_combo = new_definition + `lin_combo V f = vsum V (\v. f v % (v:real^N))`;; + +let affsign = new_definition + `affsign sgn s t (v:real^A) <=> + (?f. (v = lin_combo (s UNION t) f) /\ + (!w. t w ==> sgn (f w)) /\ + (sum (s UNION t) f = &1))`;; + +let sgn_gt = new_definition `sgn_gt = (\t. (&0 < t))`;; +let sgn_ge = new_definition `sgn_ge = (\t. (&0 <= t))`;; +let sgn_lt = new_definition `sgn_lt = (\t. (t < &0))`;; +let sgn_le = new_definition `sgn_le = (\t. (t <= &0))`;; + +let aff_gt_def = new_definition `aff_gt = affsign sgn_gt`;; +let aff_ge_def = new_definition `aff_ge = affsign sgn_ge`;; +let aff_lt_def = new_definition `aff_lt = affsign sgn_lt`;; +let aff_le_def = new_definition `aff_le = affsign sgn_le`;; + +let AFFSIGN = prove + (`affsign sgn s t = + {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\ + (!w. w IN t ==> sgn(f w)) /\ + sum (s UNION t) f = &1}`, + REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN + REWRITE_TAC[IN]);; + +let AFFSIGN_ALT = prove + (`affsign sgn s t = + {y | ?f. (!w. w IN (s UNION t) ==> w IN t ==> sgn(f w)) /\ + sum (s UNION t) f = &1 /\ + vsum (s UNION t) (\v. f v % v) = y}`, + REWRITE_TAC[SET_RULE `(w IN (s UNION t) ==> w IN t ==> P w) <=> + (w IN t ==> P w)`] THEN + REWRITE_TAC[AFFSIGN; EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; + +let IN_AFFSIGN = prove + (`y IN affsign sgn s t <=> + ?u. (!x. x IN t ==> sgn(u x)) /\ + sum (s UNION t) u = &1 /\ + vsum (s UNION t) (\x. u(x) % x) = y`, + REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);; + +let AFFSIGN_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N sgn s t v. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (affsign sgn (IMAGE f s) (IMAGE f t) = + IMAGE f (affsign sgn s t))`, + let lemma0 = prove + (`vsum s (\x. u x % x) = vsum {x | x IN s /\ ~(u x = &0)} (\x. u x % x)`, + MATCH_MP_TAC VSUM_SUPERSET THEN SIMP_TAC[SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `p /\ ~(p /\ ~q) <=> p /\ q`] THEN + SIMP_TAC[o_THM; VECTOR_MUL_LZERO]) in + let lemma1 = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (sum(IMAGE f s) u = &1 /\ vsum(IMAGE f s) (\x. u x % x) = y <=> + sum s (u o f) = &1 /\ f(vsum s (\x. (u o f) x % x)) = y)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o funpow 3 lhand o snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC(MESON[] `(p ==> z = x) ==> (p /\ x = y <=> p /\ z = y)`) THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[lemma0] THEN + SUBGOAL_THEN + `{y | y IN IMAGE (f:real^M->real^N) s /\ ~(u y = &0)} = + IMAGE f {x | x IN s /\ ~(u(f x) = &0)}` + SUBST1_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN + SUBGOAL_THEN `FINITE {x | x IN s /\ ~(u((f:real^M->real^N) x) = &0)}` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE + (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD; o_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o lhand o snd) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + ASM_SIMP_TAC[LINEAR_VSUM; o_DEF; GSYM LINEAR_CMUL]]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_AFFSIGN] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN REWRITE_TAC[IN_IMAGE; IN_AFFSIGN] THEN + REWRITE_TAC[GSYM IMAGE_UNION] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP lemma1 th]) THEN + X_GEN_TAC `y:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `u:real^N->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `vsum (s UNION t) (\x. (u o (f:real^M->real^N)) x % x)` THEN + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(u:real^N->real) o (f:real^M->real^N)` THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[o_THM]; + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^M` + (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^M->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(u:real^M->real) o (g:real^N->real^M)` THEN + ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; + +let AFF_GE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_ge (IMAGE f s) (IMAGE f t) = IMAGE f (aff_ge s t)`, + REWRITE_TAC[aff_ge_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +let AFF_GT_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_gt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_gt s t)`, + REWRITE_TAC[aff_gt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +let AFF_LE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_le (IMAGE f s) (IMAGE f t) = IMAGE f (aff_le s t)`, + REWRITE_TAC[aff_le_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +let AFF_LT_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> aff_lt (IMAGE f s) (IMAGE f t) = IMAGE f (aff_lt s t)`, + REWRITE_TAC[aff_lt_def; AFFSIGN_INJECTIVE_LINEAR_IMAGE]);; + +add_linear_invariants + [AFFSIGN_INJECTIVE_LINEAR_IMAGE; + AFF_GE_INJECTIVE_LINEAR_IMAGE; + AFF_GT_INJECTIVE_LINEAR_IMAGE; + AFF_LE_INJECTIVE_LINEAR_IMAGE; + AFF_LT_INJECTIVE_LINEAR_IMAGE];; + +let IN_AFFSIGN_TRANSLATION = prove + (`!sgn s t a v:real^N. + affsign sgn s t v + ==> affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) (a + v)`, + REPEAT GEN_TAC THEN REWRITE_TAC[affsign; lin_combo] THEN + ONCE_REWRITE_TAC[SET_RULE `(!x. s x ==> p x) <=> (!x. x IN s ==> p x)`] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real` + (CONJUNCTS_THEN2 SUBST_ALL_TAC STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\x. (f:real^N->real)(x - a)` THEN + ASM_REWRITE_TAC[GSYM IMAGE_UNION] THEN REPEAT CONJ_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[FORALL_IN_IMAGE; ETA_AX; + VECTOR_ARITH `(a + x) - a:real^N = x`]; + W(MP_TAC o PART_MATCH (lhs o rand) SUM_IMAGE o lhs o snd) THEN + SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + ASM_REWRITE_TAC[o_DEF; VECTOR_ADD_SUB; ETA_AX]] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `a + vsum {x | x IN s UNION t /\ ~(f x = &0)} (\v:real^N. f v % v)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_SUPERSET THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `vsum (IMAGE (\x:real^N. a + x) + {x | x IN s UNION t /\ ~(f x = &0)}) + (\v. f(v - a) % v)` THEN + CONJ_TAC THENL + [ALL_TAC; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC VSUM_SUPERSET THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[IMP_CONJ; FORALL_IN_IMAGE; VECTOR_MUL_EQ_0] THEN + REWRITE_TAC[VECTOR_ADD_SUB] THEN SET_TAC[]] THEN + SUBGOAL_THEN `FINITE {x:real^N | x IN s UNION t /\ ~(f x = &0)}` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE + (LAND_CONV o RATOR_CONV o RATOR_CONV) [sum]) THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + REWRITE_TAC[GSYM sum; support; NEUTRAL_REAL_ADD] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rhs o snd) THEN + ASM_SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[o_DEF; VECTOR_ADD_SUB] THEN + ASM_SIMP_TAC[VECTOR_ADD_LDISTRIB; VSUM_ADD] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[VSUM_RMUL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_SUPERSET THEN SET_TAC[]);; + +let AFFSIGN_TRANSLATION = prove + (`!a:real^N sgn s t. + affsign sgn (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (affsign sgn s t)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN] THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `--a:real^N` o + MATCH_MP IN_AFFSIGN_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; VECTOR_ARITH `--a + a + x:real^N = x`; + IMAGE_ID] THEN + DISCH_TAC THEN REWRITE_TAC[IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `--a + x:real^N` THEN ASM_REWRITE_TAC[IN] THEN VECTOR_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN GEN_TAC THEN REWRITE_TAC[IN] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N` o MATCH_MP IN_AFFSIGN_TRANSLATION) THEN + REWRITE_TAC[]]);; + +let AFF_GE_TRANSLATION = prove + (`!a:real^N s t. + aff_ge (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_ge s t)`, + REWRITE_TAC[aff_ge_def; AFFSIGN_TRANSLATION]);; + +let AFF_GT_TRANSLATION = prove + (`!a:real^N s t. + aff_gt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_gt s t)`, + REWRITE_TAC[aff_gt_def; AFFSIGN_TRANSLATION]);; + +let AFF_LE_TRANSLATION = prove + (`!a:real^N s t. + aff_le (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_le s t)`, + REWRITE_TAC[aff_le_def; AFFSIGN_TRANSLATION]);; + +let AFF_LT_TRANSLATION = prove + (`!a:real^N s t. + aff_lt (IMAGE (\x. a + x) s) (IMAGE (\x. a + x) t) = + IMAGE (\x. a + x) (aff_lt s t)`, + REWRITE_TAC[aff_lt_def; AFFSIGN_TRANSLATION]);; + +add_translation_invariants + [AFFSIGN_TRANSLATION; + AFF_GE_TRANSLATION; + AFF_GT_TRANSLATION; + AFF_LE_TRANSLATION; + AFF_LT_TRANSLATION];; + +(* ------------------------------------------------------------------------- *) +(* Example 3. *) +(* ------------------------------------------------------------------------- *) + +let NOT_COPLANAR_NOT_COLLINEAR = prove + (`!v1 v2 v3 w:real^N. ~coplanar {v1, v2, v3, w} ==> ~collinear {v1, v2, v3}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COLLINEAR_AFFINE_HULL; coplanar; CONTRAPOS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET] THEN STRIP_TAC THEN + EXISTS_TAC `w:real^N` THEN ASM_SIMP_TAC[HULL_INC; IN_INSERT] THEN + REPEAT CONJ_TAC THEN + MATCH_MP_TAC(SET_RULE `!t. t SUBSET s /\ x IN t ==> x IN s`) THEN + EXISTS_TAC `affine hull {x:real^N,y}` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC HULL_MONO THEN SET_TAC[]);; + +let AFFSIGN = prove + (`affsign sgn s t = + {y | ?f. y = vsum (s UNION t) (\v. f v % v) /\ + (!w. w IN t ==> sgn(f w)) /\ + sum (s UNION t) f = &1}`, + REWRITE_TAC[FUN_EQ_THM; affsign; lin_combo; IN_ELIM_THM] THEN + REWRITE_TAC[IN]);; + +let IN_AFFSIGN = prove + (`y IN affsign sgn s t <=> + ?u. (!x. x IN (s UNION t) ==> x IN t ==> sgn(u x)) /\ + sum (s UNION t) u = &1 /\ + vsum (s UNION t) (\x. u(x) % x) = y`, + REWRITE_TAC[AFFSIGN; IN_ELIM_THM] THEN SET_TAC[]);; + +let LEMMA = prove + (`!v1 v2 v3 w:real^3 p. + plane p /\ {v1, v2, v3} SUBSET p /\ + ~coplanar {v1, v2, v3, w} + ==> (?n n'. norm(n - n') = &1 /\ + (!x. x IN aff_ge {v1, v2, v3} {w} <=> + (?xx h. + xx IN affine hull {v1, v2, v3} /\ + &0 <= h /\ + x - xx = h % (n - n'))) /\ + (!x y. + {x, y} SUBSET affine hull {v1, v2, v3} + ==> (n - n') dot (x - y) = &0))`, + GEOM_HORIZONTAL_PLANE_TAC `p:real^3->bool` THEN + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM] THEN + MAP_EVERY (fun t -> + ASM_CASES_TAC t THENL [ASM_REWRITE_TAC[INSERT_AC; COPLANAR_3]; ALL_TAC]) + [`v1:real^3 = v2`; `v1:real^3 = v3`; `v2:real^3 = v3`; + `v1:real^3 = w`; `v2:real^3 = w`; `v3:real^3 = w`] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + EXISTS_TAC `vec 0:real^3` THEN REWRITE_TAC[VECTOR_SUB_RZERO] THEN + SUBGOAL_THEN `~((w:real^3)$3 = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~coplanar{v1:real^3,v2,v3,w}` THEN + REWRITE_TAC[coplanar] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [plane]) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + DISCH_THEN(SUBST1_TAC o SYM o CONJUNCT2) THEN + ASM_REWRITE_TAC[INSERT_SUBSET; EMPTY_SUBSET; IN_ELIM_THM]; + ALL_TAC] THEN + SUBGOAL_THEN `(vec 0:real^3) IN affine hull {v1,v2,v3}` ASSUME_TAC THENL + [MP_TAC(ISPEC `{v1:real^3,v2,v3}` DEPENDENT_BIGGERSET_GENERAL) THEN + ANTS_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[GT] THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `dim {z:real^3 | z$3 = &0}` THEN + CONJ_TAC THENL [MATCH_MP_TAC DIM_SUBSET THEN ASM SET_TAC[]; ALL_TAC] THEN + SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_3; ARITH] THEN + REWRITE_TAC[GSYM NOT_LE] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NOT_COPLANAR_NOT_COLLINEAR) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC COLLINEAR_SMALL THEN + ASM_REWRITE_TAC[FINITE_INSERT; FINITE_RULES]; + ALL_TAC] THEN + REWRITE_TAC[DEPENDENT_AFFINE_DEPENDENT_CASES] THEN + ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3; + NOT_COPLANAR_NOT_COLLINEAR]; + ALL_TAC] THEN + SUBGOAL_THEN `affine hull {v1,v2,v3} = {z:real^3 | z$3 = &0}` + ASSUME_TAC THENL + [ASM_SIMP_TAC[AFFINE_HULL_EQ_SPAN] THEN + MATCH_MP_TAC(SET_RULE + `!s. t SUBSET u /\ s SUBSET t /\ u SUBSET s ==> t = u`) THEN + EXISTS_TAC `span {x - v1:real^3 | x IN {v2,v3}}` THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET] THEN MATCH_MP_TAC SPAN_INDUCT THEN + REWRITE_TAC[SET_RULE `(\x. x IN s) = s`] THEN + SIMP_TAC[SUBSPACE_SPECIAL_HYPERPLANE; DIMINDEX_3; ARITH] THEN + ASM_SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM]; + ALL_TAC] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM SPAN_SPAN] THEN + MATCH_MP_TAC SPAN_MONO THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + MESON_TAC[SPAN_SUB; SPAN_INC; IN_INSERT; SUBSET]; + ALL_TAC] THEN + MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; + FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; DIMINDEX_3; ARITH; REAL_SUB_REFL]; + REWRITE_TAC[independent] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + DEPENDENT_IMP_AFFINE_DEPENDENT)) THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[AFFINE_DEPENDENT_IMP_COLLINEAR_3; + NOT_COPLANAR_NOT_COLLINEAR]; + SIMP_TAC[DIM_SPECIAL_HYPERPLANE; DIMINDEX_3; ARITH] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + SIMP_TAC[CARD_IMAGE_INJ; FINITE_INSERT; FINITE_RULES; + VECTOR_ARITH `x - a:real^N = y - a <=> x = y`] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_RULES; + IN_INSERT; NOT_IN_EMPTY; ARITH]]; + ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ &0 < --x`)) + THENL + [EXISTS_TAC `basis 3:real^3`; EXISTS_TAC `--(basis 3):real^3`] THEN + ASM_SIMP_TAC[NORM_BASIS; DIMINDEX_3; ARITH; IN_ELIM_THM; DOT_BASIS; + NORM_NEG; DOT_LNEG; DIMINDEX_3; ARITH; VECTOR_SUB_COMPONENT; + REAL_SUB_REFL; REAL_NEG_0] THEN + X_GEN_TAC `x:real^3` THEN + REWRITE_TAC[aff_ge_def; IN_AFFSIGN; sgn_ge] THEN + REWRITE_TAC[SET_RULE `{a,b,c} UNION {d} = {a,b,c,d}`] THEN + REWRITE_TAC[SET_RULE `x IN {a} <=> a = x`] THEN + SIMP_TAC[AFFINE_HULL_FINITE_STEP_GEN; REAL_LE_ADD; FINITE_INSERT; + CONJUNCT1 FINITE_RULES; REAL_ARITH `&0 <= x / &2 <=> &0 <= x`; + RIGHT_EXISTS_AND_THM] THEN + ASM_REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ARITH `x - y:real^3 = z <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ARITH `&1 = x + y <=> x + y = &1`] THEN + EQ_TAC THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THENL + [MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`; `h:real`] THEN + STRIP_TAC THEN + EXISTS_TAC `a % v1 + b % v2 + c % v3 + + h % ((w:real^3)$1 % basis 1 + w$2 % basis 2):real^3` THEN + EXISTS_TAC `h * (w:real^3)$3` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; + DIMINDEX_3; ARITH; REAL_MUL_RZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; + GSYM VECTOR_ADD_ASSOC] THEN + REPLICATE_TAC 4 AP_TERM_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID]; + + MAP_EVERY X_GEN_TAC [`y:real^3`; `h:real`] THEN STRIP_TAC THEN + UNDISCH_TAC `(vec 0:real^3) IN affine hull {v1,v2,v3}` THEN + SUBGOAL_THEN `(y - h / (w:real^3)$3 % (w$1 % basis 1 + w$2 % basis 2)) + IN affine hull {v1:real^3,v2,v3}` MP_TAC THENL + [ASM_SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; BASIS_COMPONENT; ARITH; DIMINDEX_3] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; CONJUNCT1 FINITE_RULES; + AFFINE_HULL_FINITE_STEP; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ARITH `x - y:real^3 = z <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `&1 = x + y <=> x + y = &1`] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`a':real`; `b':real`; `c':real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SYM)) THEN + MAP_EVERY EXISTS_TAC + [`a + (&1 - (a + b + c + h / (w:real^3)$3)) * a'`; + `b + (&1 - (a + b + c + h / (w:real^3)$3)) * b'`; + `c + (&1 - (a + b + c + h / (w:real^3)$3)) * c'`; `h / (w:real^3)$3`] THEN + ASM_REWRITE_TAC[REAL_ARITH + `(a + x * a') + (b + x * b') + (c + x * c') + h:real = + (a + b + c + h) + x * (a' + b' + c')`] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH + `(a + x * a') % v1 + (b + x * b') % v2 + (c + x * c') % v3 + h:real^N = + (a % v1 + b % v2 + c % v3) + x % (a' % v1 + b' % v2 + c' % v3) + h`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[VECTOR_ARITH `(x + a) + y:real^3 = a + z <=> x + y = z`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN + REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM VECTOR_ADD_ASSOC] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_RMUL; REAL_LT_IMP_NZ]; + + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`; `h:real`] THEN + STRIP_TAC THEN + EXISTS_TAC `a % v1 + b % v2 + c % v3 + + h % ((w:real^3)$1 % basis 1 + w$2 % basis 2):real^3` THEN + EXISTS_TAC `h * --((w:real^3)$3)` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN + REWRITE_TAC[VECTOR_ARITH `(x * --y) % --z:real^N = (x * y) % z`] THEN + ASM_SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; + DIMINDEX_3; ARITH; REAL_MUL_RZERO; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_LDISTRIB; + GSYM VECTOR_ADD_ASSOC] THEN + REPLICATE_TAC 4 AP_TERM_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM BASIS_EXPANSION] THEN + REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID]; + + MAP_EVERY X_GEN_TAC [`y:real^3`; `h:real`] THEN STRIP_TAC THEN + UNDISCH_TAC `(vec 0:real^3) IN affine hull {v1,v2,v3}` THEN + SUBGOAL_THEN `(y - h / --((w:real^3)$3) % (w$1 % basis 1 + w$2 % basis 2)) + IN affine hull {v1:real^3,v2,v3}` MP_TAC THENL + [ASM_SIMP_TAC[IN_ELIM_THM; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; BASIS_COMPONENT; ARITH; DIMINDEX_3] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SIMP_TAC[AFFINE_HULL_FINITE; FINITE_INSERT; CONJUNCT1 FINITE_RULES; + AFFINE_HULL_FINITE_STEP; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ARITH `x - y:real = z <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ARITH `x - y:real^3 = z <=> x = y + z`] THEN + REWRITE_TAC[VECTOR_ADD_RID; REAL_ADD_RID; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[REAL_ARITH `&1 = x + y <=> x + y = &1`] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`; `c:real`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`a':real`; `b':real`; `c':real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o SYM)) THEN + MAP_EVERY EXISTS_TAC + [`a + (&1 - (a + b + c + h / --((w:real^3)$3))) * a'`; + `b + (&1 - (a + b + c + h / --((w:real^3)$3))) * b'`; + `c + (&1 - (a + b + c + h / --((w:real^3)$3))) * c'`; + `h / --((w:real^3)$3)`] THEN + ASM_REWRITE_TAC[REAL_ARITH + `(a + x * a') + (b + x * b') + (c + x * c') + h:real = + (a + b + c + h) + x * (a' + b' + c')`] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[VECTOR_ARITH + `(a + x * a') % v1 + (b + x * b') % v2 + (c + x * c') % v3 + h:real^N = + (a % v1 + b % v2 + c % v3) + x % (a' % v1 + b' % v2 + c' % v3) + h`] THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + REWRITE_TAC[VECTOR_ARITH `(x + a) + y:real^3 = a + z <=> x + y = z`] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM BASIS_EXPANSION] THEN + REWRITE_TAC[DIMINDEX_3] THEN CONV_TAC(ONCE_DEPTH_CONV NUMSEG_CONV) THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_INSERT; CONJUNCT1 FINITE_RULES] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; ARITH_EQ; VECTOR_ADD_RID] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; GSYM VECTOR_ADD_ASSOC] THEN + REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG] THEN + REWRITE_TAC[VECTOR_MUL_RNEG; VECTOR_MUL_LNEG; GSYM real_div] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_DIV_RMUL; REAL_LT_IMP_NZ]]);; + +let THEOREM = prove + (`!v1 v2 v3 w:real^3. + ~coplanar {v1, v2, v3, w} + ==> (?nor. norm nor = &1 /\ + (!x. x IN aff_ge {v1, v2, v3} {w} <=> + (?xx h. + xx IN affine hull {v1, v2, v3} /\ + &0 <= h /\ + x = xx + h % nor)) /\ + (!x y. + {x, y} SUBSET affine hull {v1, v2, v3} + ==> nor dot (x - y) = &0))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^3 = y + h % z <=> x - y = h % z`] THEN + MATCH_MP_TAC(MESON[] `(?a b. P(a - b)) ==> ?a:real^3. P a`) THEN + MATCH_MP_TAC LEMMA THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `affine hull {v1:real^3,v2,v3}` THEN + REWRITE_TAC[HULL_SUBSET; plane] THEN + ASM_MESON_TAC[NOT_COPLANAR_NOT_COLLINEAR]);; diff --git a/Ntrie/ntrie.ml b/Ntrie/ntrie.ml new file mode 100644 index 0000000..6a705e3 --- /dev/null +++ b/Ntrie/ntrie.ml @@ -0,0 +1,370 @@ +(* ========================================================================= *) +(* Computations with finite sets of nums. *) +(* *) +(* (c) Copyright, Clelia Lomuto, Marco Maggesi, 2009. *) +(* Distributed with HOL Light under same license terms *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* This file defines some conversions that operate on finite sets of nums *) +(* represented literally in a trie-like structure (we call them `ntries'). *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* Example: *) +(* # NTRIE_COMPUTE NTRIE_REDUCE_CONV *) +(* `{10, 1001, 3} INTER {3, 7, 10} SUBSET {10, 10000} UNION {3, 33}`;; *) +(* val it : thm = *) +(* |- {10, 1001, 3} INTER {3, 7, 10} SUBSET {10, 10000} UNION {3, 33} <=> T *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* Constructors for the ntrie representation of a set of nums. *) +(* ------------------------------------------------------------------------- *) + +let NEMPTY = new_definition + `NEMPTY:num->bool = {}`;; + +let NZERO = new_definition + `NZERO = {_0}`;; + +let NNODE = new_definition + `!s t. NNODE s t = IMAGE BIT0 s UNION IMAGE BIT1 t`;; + +let NTRIE = new_definition + `!s:num->bool. NTRIE s = s`;; + +let NTRIE_RELATIONS = prove + (`NNODE NEMPTY NEMPTY = NEMPTY /\ + NNODE NZERO NEMPTY = NZERO`, + REWRITE_TAC[NEMPTY; NZERO; NNODE; EXTENSION; NOT_IN_EMPTY; + IN_INSERT; IN_UNION; IN_IMAGE] THEN + MESON_TAC[ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Membership. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_IN = prove + (`(!s n. NUMERAL n IN NTRIE s <=> n IN s) /\ + (!n. ~(n IN NEMPTY)) /\ + (!n. n IN NZERO <=> n = _0) /\ + (!s t. _0 IN NNODE s t <=> _0 IN s) /\ + (!s t n. BIT0 n IN NNODE s t <=> n IN s) /\ + (!s t n. BIT1 n IN NNODE s t <=> n IN t)`, + REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE; NOT_IN_EMPTY; IN_INSERT; + IN_UNION; IN_IMAGE; ARITH_EQ] THEN + MESON_TAC[]);; + +let NTRIE_IN_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_IN in + REWR_CONV tth THENC REWRITE_CONV[pths; CONJUNCT2 ARITH_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Inclusion. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_SUBSET = prove + (`(!s t. NTRIE s SUBSET NTRIE t <=> s SUBSET t) /\ + (!s. NEMPTY SUBSET s) /\ + (!s:num->bool. s SUBSET s) /\ + ~(NZERO SUBSET NEMPTY) /\ + (!s t. NNODE s t SUBSET NEMPTY <=> s SUBSET NEMPTY /\ t SUBSET NEMPTY) /\ + (!s t. NNODE s t SUBSET NZERO <=> s SUBSET NZERO /\ t SUBSET NEMPTY) /\ + (!s t. NZERO SUBSET NNODE s t <=> NZERO SUBSET s) /\ + (!s1 s2 t1 t2. + NNODE s1 t1 SUBSET NNODE s2 t2 <=> s1 SUBSET s2 /\ t1 SUBSET t2)`, + REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE; EMPTY_SUBSET; SUBSET_REFL; + SING_SUBSET; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[SUBSET; NOT_IN_EMPTY; IN_INSERT; IN_UNION; IN_IMAGE; + ARITH_EQ] THENL + [MESON_TAC[]; MESON_TAC[ARITH_EQ]; MESON_TAC[]; EQ_TAC] THENL + [ALL_TAC; MESON_TAC[ARITH_EQ]] THEN + STRIP_TAC THEN CONJ_TAC THEN GEN_TAC THENL + [POP_ASSUM (MP_TAC o SPEC `BIT0 x`); + POP_ASSUM (MP_TAC o SPEC `BIT1 x`)] THEN + REWRITE_TAC[ARITH_EQ] THEN MESON_TAC[]);; + +let NTRIE_SUBSET_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_SUBSET in + REWR_CONV tth THENC REWRITE_CONV[pths];; + +(* ------------------------------------------------------------------------- *) +(* Equality. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_EQ = prove + (`(!s t. NTRIE s = NTRIE t <=> s = t) /\ + (!s:num->bool. s = s) /\ + ~(NZERO = NEMPTY) /\ + ~(NEMPTY = NZERO) /\ + (!s t. NNODE s t = NEMPTY <=> s = NEMPTY /\ t = NEMPTY) /\ + (!s t. NEMPTY = NNODE s t <=> s = NEMPTY /\ t = NEMPTY) /\ + (!s t. NNODE s t = NZERO <=> s = NZERO /\ t = NEMPTY) /\ + (!s t. NZERO = NNODE s t <=> s = NZERO /\ t = NEMPTY) /\ + (!s1 s2 t1 t2. NNODE s1 t1 = NNODE s2 t2 <=> s1 = s2 /\ t1 = t2)`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; NTRIE_SUBSET; NEMPTY; NZERO] THEN + SET_TAC[]);; + +let NTRIE_EQ_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_EQ in + REWR_CONV tth THENC REWRITE_CONV[pths];; + +(* ------------------------------------------------------------------------- *) +(* Singleton. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_SING = prove + (`(!n. {NUMERAL n} = NTRIE {n}) /\ + {_0} = NZERO /\ + (!n. {BIT0 n} = if n = _0 then NZERO else NNODE {n} NEMPTY) /\ + (!n. {BIT1 n} = NNODE NEMPTY {n})`, + REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE; IMAGE_CLAUSES; + UNION_EMPTY] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH_ZERO]);; + +let NTRIE_SING_CONV = + let tth,pths = CONJ_PAIR NTRIE_SING in + REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; CONJUNCT2 ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Insertion. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_INSERT = prove + (`(!s n. NUMERAL n INSERT NTRIE s = NTRIE (n INSERT s)) /\ + (!n. n INSERT NEMPTY = {n}) /\ + _0 INSERT NZERO = NZERO /\ + (!s t n. _0 INSERT NNODE s t = NNODE (_0 INSERT s) t) /\ + (!n. BIT0 n INSERT NZERO = if n = _0 then NZERO else + NNODE (n INSERT NZERO) NEMPTY) /\ + (!n. BIT1 n INSERT NZERO = NNODE NZERO {n}) /\ + (!s t n. BIT0 n INSERT NNODE s t = NNODE (n INSERT s) t) /\ + (!s t n. BIT1 n INSERT NNODE s t = NNODE s (n INSERT t))`, + REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE] THEN + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN + REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_UNION; IN_IMAGE] THEN + ASM_MESON_TAC[ARITH_EQ]);; + +let NTRIE_INSERT_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_INSERT in + REWR_CONV tth THENC + RAND_CONV(REWRITE_CONV[pths; CONJUNCT2 NTRIE_SING; CONJUNCT2 ARITH_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Union. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_UNION = prove + (`(!s t. NTRIE s UNION NTRIE t = NTRIE (s UNION t)) /\ + (!s. s UNION NEMPTY = s) /\ + (!s. NEMPTY UNION s = s) /\ + NZERO UNION NZERO = NZERO /\ + (!s t. NNODE s t UNION NZERO = NNODE (s UNION NZERO) t) /\ + (!s t. NZERO UNION NNODE s t = NNODE (s UNION NZERO) t) /\ + (!s t r q. NNODE s t UNION NNODE r q = NNODE (s UNION r) (t UNION q))`, + REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE] THEN REPEAT STRIP_TAC THEN + TRY COND_CASES_TAC THEN + REWRITE_TAC[UNION_EMPTY; INSERT_UNION; NOT_IN_EMPTY; IN_INSERT; IN_UNION; + IN_IMAGE; EXTENSION] THEN + MESON_TAC[ARITH_EQ]);; + +let NTRIE_UNION_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_UNION in + REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths]);; + +(* ------------------------------------------------------------------------- *) +(* Intersection. *) +(* Warning: rewriting with this theorem generates ntries which are not *) +(* "minimal". It has to be used in conjuction with NTRIE_RELATIONS. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_INTER = prove + (`(!s t. NTRIE s INTER NTRIE t = NTRIE (s INTER t)) /\ + (!s. NEMPTY INTER s = NEMPTY) /\ + (!s. s INTER NEMPTY = NEMPTY) /\ + NZERO INTER NZERO = NZERO /\ + (!s t. NZERO INTER NNODE s t = NZERO INTER s) /\ + (!s t. NNODE s t INTER NZERO = NZERO INTER s) /\ + (!s1 s2 t1 t2. + NNODE s1 t1 INTER NNODE s2 t2 = NNODE (s1 INTER s2) (t1 INTER t2))`, + REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE; INTER_EMPTY; INSERT_INTER; + NOT_IN_EMPTY; IN_INSERT] THEN + REPEAT STRIP_TAC THENL + [REWRITE_TAC[IN_UNION; IN_IMAGE; ARITH_EQ] THEN ASM_MESON_TAC[]; + COND_CASES_TAC THEN + ASM_REWRITE_TAC[EXTENSION; IN_UNION; IN_INTER; IN_IMAGE; + IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[ARITH_EQ]; + REWRITE_TAC[EXTENSION; IN_INTER; IN_UNION; IN_IMAGE] THEN + MESON_TAC[ARITH_EQ]]);; + +let NTRIE_INTER_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_INTER in + REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; NTRIE_RELATIONS]);; + +(* ------------------------------------------------------------------------- *) +(* Deleting an element. *) +(* Warning: rewriting with this theorem generates ntries which are not *) +(* "minimal". It has to be used in conjuction with NTRIE_RELATIONS. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_DELETE = prove + (`(!s n. NTRIE s DELETE NUMERAL n = NTRIE (s DELETE n)) /\ + (!n. NEMPTY DELETE n = NEMPTY) /\ + (!n. NZERO DELETE n = if n = _0 then NEMPTY else NZERO) /\ + (!s t. NNODE s t DELETE _0 = NNODE (s DELETE _0) t) /\ + (!s t n. NNODE s t DELETE BIT0 n = NNODE (s DELETE n) t) /\ + (!s t n. NNODE s t DELETE BIT1 n = NNODE s (t DELETE n))`, + REWRITE_TAC[NUMERAL; NTRIE; NEMPTY; NZERO; NNODE] THEN REPEAT STRIP_TAC THEN + TRY COND_CASES_TAC THEN + ASM_REWRITE_TAC[EXTENSION; IN_DELETE; IN_UNION; IN_IMAGE; + NOT_IN_EMPTY; IN_INSERT] THEN + ASM_MESON_TAC[ARITH_EQ]);; + +let NTRIE_DELETE_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_DELETE in + REWR_CONV tth THENC RAND_CONV(REWRITE_CONV[pths; NTRIE_RELATIONS]);; + +(* ------------------------------------------------------------------------- *) +(* Disjoint. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_DISJOINT = prove + (`(!s t. DISJOINT (NTRIE s) (NTRIE t) <=> DISJOINT s t) /\ + (!s. DISJOINT s NEMPTY) /\ + (!s. DISJOINT NEMPTY s) /\ + ~DISJOINT NZERO NZERO /\ + (!s t. DISJOINT NZERO (NNODE s t) <=> DISJOINT s NZERO) /\ + (!s t. DISJOINT (NNODE s t) NZERO <=> DISJOINT s NZERO) /\ + (!s1 s2 t1 t2. DISJOINT (NNODE s1 t1) (NNODE s2 t2) <=> + DISJOINT s1 s2 /\ DISJOINT t1 t2)`, + REWRITE_TAC[NTRIE; DISJOINT; GSYM NEMPTY; + NTRIE_INTER; INTER_ACI; NTRIE_EQ]);; + +let NTRIE_DISJOINT_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_DISJOINT in + REWR_CONV tth THENC REWRITE_CONV[pths];; + +(* ------------------------------------------------------------------------- *) +(* Difference. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_DIFF = prove + (`(!s t. NTRIE s DIFF NTRIE t = NTRIE (s DIFF t)) /\ + (!s. NEMPTY DIFF s = NEMPTY) /\ + (!s. s DIFF NEMPTY = s) /\ + NZERO DIFF NZERO = NEMPTY /\ + (!s t. NZERO DIFF NNODE s t = NZERO DIFF s) /\ + (!s t. NNODE s t DIFF NZERO = NNODE (s DIFF NZERO) t) /\ + (!s1 t1 s2 t2. NNODE s1 t1 DIFF NNODE s2 t2 = + NNODE (s1 DIFF s2) (t1 DIFF t2))`, + REWRITE_TAC[NTRIE; NEMPTY; NZERO; NNODE; EMPTY_DIFF; DIFF_EMPTY; + DIFF_EQ_EMPTY; EXTENSION; NOT_IN_EMPTY; IN_INSERT; IN_DIFF; + IN_UNION; IN_IMAGE] THEN + MESON_TAC[ARITH_EQ]);; + +let NTRIE_DIFF_CONV : conv = + let tth,pths = CONJ_PAIR NTRIE_DIFF in + REWR_CONV tth THENC REWRITE_CONV[pths];; + +(* ------------------------------------------------------------------------- *) +(* Image. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_IMAGE_DEF = new_definition + `!f acc s. NTRIE_IMAGE f acc s = IMAGE f s UNION acc`;; + +let NTRIE_IMAGE = prove + (`(!f acc. NTRIE_IMAGE f acc NEMPTY = acc) /\ + (!f acc. NTRIE_IMAGE f acc NZERO = f _0 INSERT acc) /\ + (!f acc s t. NTRIE_IMAGE f acc (NNODE s t) = + NTRIE_IMAGE (\n. f (BIT1 n)) + (NTRIE_IMAGE (\n. f (BIT0 n)) acc s) + t)`, + REWRITE_TAC[NEMPTY; NZERO; NNODE; NTRIE_IMAGE_DEF; GSYM IMAGE_o; o_DEF; + IMAGE_UNION; IMAGE_CLAUSES; UNION_EMPTY; INSERT_UNION] THEN + REPEAT STRIP_TAC THENL [COND_CASES_TAC THEN ASM SET_TAC[]; SET_TAC[]]);; + +let IMAGE_EQ_NTRIE_IMAGE = prove + (`!f s. IMAGE f (NTRIE s) = NTRIE_IMAGE (\n. f (NUMERAL n)) {} s`, + REWRITE_TAC [NUMERAL; NTRIE; ETA_AX; NTRIE_IMAGE_DEF; UNION_EMPTY]);; + +let NTRIE_IMAGE_CONV : conv -> conv = + let [c1;c2;c3] = map REWR_CONV (CONJUNCTS NTRIE_IMAGE) in + fun cnv -> + let rec conv tm = + (c1 ORELSEC (c2 THENC LAND_CONV (TRY_CONV BETA_CONV THENC cnv)) ORELSEC + (c3 THENC + RATOR_CONV (ONCE_DEPTH_CONV BETA_CONV THENC RAND_CONV conv) THENC + conv)) tm in + REWR_CONV IMAGE_EQ_NTRIE_IMAGE THENC (ONCE_DEPTH_CONV BETA_CONV) THENC conv;; + +(* ------------------------------------------------------------------------- *) +(* Decoding of a set in ntrie form to the usual literal representation. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_DECODE_CONV : conv = + let NTRIE_DECODE_THM = prove + (`!s. NTRIE s = NTRIE_IMAGE NUMERAL {} s`, + REWRITE_TAC[NTRIE; NUMERAL; NTRIE_IMAGE_DEF; UNION_EMPTY; IMAGE] THEN + SET_TAC[]) + and [c1;c2;c3] = map REWR_CONV (CONJUNCTS NTRIE_IMAGE) in + let rec conv tm = + (c1 ORELSEC (c2 THENC LAND_CONV (TRY_CONV BETA_CONV)) ORELSEC + (c3 THENC + RATOR_CONV (ONCE_DEPTH_CONV BETA_CONV THENC RAND_CONV conv) THENC + conv)) tm in + REWR_CONV NTRIE_DECODE_THM THENC conv;; + +(* ------------------------------------------------------------------------- *) +(* Encoding of a set from the usual literal form to the ntrie form. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_ENCODE_CONV : conv= + let itm = `(INSERT):num->(num->bool)->num->bool` + and th = prove (`{} = NTRIE NEMPTY`, REWRITE_TAC[NTRIE; NEMPTY]) in + let cnv1 = REWR_CONV th + and cnv2 cnv tm = + let fn,arg = dest_comb tm in + if rator fn <> itm then fail () else + AP_TERM fn (cnv arg) in + let rec conv tm = (cnv1 ORELSEC (cnv2 conv THENC NTRIE_INSERT_CONV)) tm in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Final hack-together. *) +(* ------------------------------------------------------------------------- *) + +let NTRIE_REL_CONV : conv = + let gconv_net = itlist (uncurry net_of_conv) + [`NTRIE s = NTRIE t`, NTRIE_EQ_CONV; + `NTRIE s SUBSET NTRIE t`, NTRIE_SUBSET_CONV; + `DISJOINT (NTRIE s) (NTRIE t)`, NTRIE_DISJOINT_CONV; + `NUMERA n IN NTRIE s`, NTRIE_IN_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let NTRIE_RED_CONV : conv = + let gconv_net = itlist (uncurry net_of_conv) + [`NTRIE s = NTRIE t`, NTRIE_EQ_CONV; + `NTRIE s SUBSET NTRIE t`, NTRIE_SUBSET_CONV; + `DISJOINT (NTRIE s) (NTRIE t)`, NTRIE_DISJOINT_CONV; + `NUMERA n IN NTRIE s`, NTRIE_IN_CONV; + `NUMERAL n INSERT NTRIE s`, NTRIE_INSERT_CONV; + `NTRIE s UNION NTRIE t`, NTRIE_UNION_CONV; + `NTRIE s INTER NTRIE t`, NTRIE_INTER_CONV; + `NTRIE s DELETE NUMERAL n`, NTRIE_DELETE_CONV; + `NTRIE s DIFF NTRIE t`, NTRIE_DIFF_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let NTRIE_REDUCE_CONV = DEPTH_CONV NTRIE_RED_CONV;; + +let NTRIE_REDUCE_TAC = CONV_TAC NTRIE_REDUCE_CONV;; + +let NTRIE_COMPUTE (cnv : conv) : conv = + ONCE_DEPTH_CONV NTRIE_ENCODE_CONV THENC + cnv THENC + ONCE_DEPTH_CONV NTRIE_DECODE_CONV;; diff --git a/Ntrie/ntrie_tests.ml b/Ntrie/ntrie_tests.ml new file mode 100644 index 0000000..c08362e --- /dev/null +++ b/Ntrie/ntrie_tests.ml @@ -0,0 +1,181 @@ +(* -*- holl -*- *) + +(* ========================================================================= *) +(* Conversions for ntries. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* NTRIE_IN_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_IN_CONV `2 IN NTRIE NEMPTY`;; +NTRIE_IN_CONV `0 IN NTRIE NZERO`;; +NTRIE_IN_CONV `0 IN NTRIE (NNODE NZERO NZERO)`;; +NTRIE_IN_CONV `0 IN NTRIE (NNODE NZERO NZERO)`;; +NTRIE_IN_CONV `1 IN NTRIE NZERO`;; +NTRIE_IN_CONV `1 IN NTRIE (NNODE NEMPTY NZERO)`;; +NTRIE_IN_CONV `1 IN NTRIE (NNODE NZERO NEMPTY)`;; +NTRIE_IN_CONV `1 IN NTRIE (NNODE NZERO NZERO)`;; +NTRIE_IN_CONV `2 IN NTRIE (NNODE NZERO NZERO)`;; +NTRIE_IN_CONV `3 IN NTRIE (NNODE NZERO NZERO)`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_EQ_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_EQ_CONV `NTRIE NEMPTY = NTRIE NZERO`;; +NTRIE_EQ_CONV `NTRIE NZERO = NTRIE NZERO`;; +NTRIE_EQ_CONV `NTRIE (NNODE NZERO NEMPTY) = NTRIE NZERO`;; +NTRIE_EQ_CONV `NTRIE (NNODE NEMPTY NZERO) = NTRIE NZERO`;; +NTRIE_EQ_CONV `NTRIE (NNODE NZERO NEMPTY) = NTRIE (NNODE NZERO NZERO)`;; +NTRIE_EQ_CONV `NTRIE (NNODE NEMPTY NZERO) = NTRIE (NNODE NZERO NZERO)`;; +NTRIE_EQ_CONV `NTRIE (NNODE NEMPTY NEMPTY) = NTRIE NEMPTY`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_SUBSET_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_SUBSET_CONV `NTRIE NZERO SUBSET NTRIE NEMPTY`;; +NTRIE_SUBSET_CONV `NTRIE NEMPTY SUBSET NTRIE NZERO`;; +NTRIE_SUBSET_CONV + `NTRIE (NNODE NZERO NEMPTY) SUBSET NTRIE (NNODE NZERO NZERO)`;; +NTRIE_SUBSET_CONV + `NTRIE (NNODE NEMPTY NZERO) SUBSET NTRIE (NNODE NZERO NZERO)`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_DISJOINT_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_DISJOINT_CONV `DISJOINT (NTRIE NEMPTY) (NTRIE NEMPTY)`;; +NTRIE_DISJOINT_CONV + `DISJOINT (NTRIE (NNODE NEMPTY NZERO)) (NTRIE (NNODE NZERO NEMPTY))`;; +NTRIE_DISJOINT_CONV + `DISJOINT (NTRIE (NNODE NEMPTY NZERO)) (NTRIE (NNODE NEMPTY NZERO))`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_SING_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_SING_CONV `{10}`;; +NTRIE_SING_CONV `{1000}`;; +NTRIE_SING_CONV `{100000}`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_INSERT_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_INSERT_CONV `2 INSERT NTRIE NEMPTY`;; +NTRIE_INSERT_CONV `0 INSERT NTRIE NZERO`;; +NTRIE_INSERT_CONV `NUMERAL (BIT1 _0) INSERT NTRIE NZERO`;; +NTRIE_INSERT_CONV `NUMERAL (BIT0 _0) INSERT NTRIE (NNODE NZERO NZERO)`;; +NTRIE_INSERT_CONV `NUMERAL _0 INSERT NTRIE (NNODE NZERO NZERO)`;; +NTRIE_INSERT_CONV `NUMERAL (BIT1 _0) INSERT NTRIE (NNODE NZERO NZERO)`;; +NTRIE_INSERT_CONV `NUMERAL (BIT0 _0) INSERT NTRIE NZERO`;; +NTRIE_INSERT_CONV `NUMERAL (BIT0 (BIT1 (BIT1 _0))) INSERT NTRIE NZERO`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_UNION_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_UNION_CONV `NTRIE NEMPTY UNION NTRIE NEMPTY`;; +NTRIE_UNION_CONV `NTRIE NEMPTY UNION NTRIE NZERO`;; +NTRIE_UNION_CONV `NTRIE (NNODE NZERO NZERO) UNION NTRIE NZERO`;; +NTRIE_UNION_CONV `NTRIE (NNODE NEMPTY NZERO) UNION NTRIE NZERO`;; +NTRIE_UNION_CONV `NTRIE (NNODE NZERO NEMPTY) UNION NTRIE NZERO`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_INTER_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_INTER_CONV `NTRIE NEMPTY INTER NTRIE NEMPTY`;; +NTRIE_INTER_CONV `NTRIE NEMPTY INTER NTRIE NZERO`;; +NTRIE_INTER_CONV `NTRIE (NNODE NZERO NZERO) INTER NTRIE NZERO`;; +NTRIE_INTER_CONV `NTRIE (NNODE NEMPTY NZERO) INTER NTRIE NZERO`;; +NTRIE_INTER_CONV `NTRIE (NNODE NZERO NEMPTY) INTER NTRIE NZERO`;; +NTRIE_INTER_CONV + `NTRIE (NNODE NEMPTY NEMPTY) INTER NTRIE (NNODE NEMPTY NEMPTY)`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_DELETE_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_DELETE_CONV `NTRIE NEMPTY DELETE 0`;; +NTRIE_DELETE_CONV `NTRIE NZERO DELETE 0`;; +NTRIE_DELETE_CONV `NTRIE (NNODE NZERO NEMPTY) DELETE 0`;; +NTRIE_DELETE_CONV `NTRIE (NNODE NEMPTY NZERO) DELETE 0`;; +NTRIE_DELETE_CONV `NTRIE (NNODE NEMPTY NZERO) DELETE 1`;; +NTRIE_DELETE_CONV `NTRIE (NNODE NZERO NEMPTY) DELETE 1`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_DIFF_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_DIFF_CONV `NTRIE NEMPTY DIFF NTRIE NZERO`;; +NTRIE_DIFF_CONV `NTRIE NZERO DIFF NTRIE NZERO`;; +NTRIE_DIFF_CONV `NTRIE (NNODE NZERO NEMPTY) DIFF NTRIE (NNODE NZERO NEMPTY)`;; +NTRIE_DIFF_CONV `NTRIE (NNODE NEMPTY NZERO) DIFF NTRIE (NNODE NZERO NEMPTY)`;; +NTRIE_DIFF_CONV `NTRIE (NNODE NZERO NZERO) DIFF NTRIE (NNODE NEMPTY NZERO)`;; +NTRIE_DIFF_CONV `NTRIE (NNODE NZERO NZERO) DIFF NTRIE (NNODE NZERO NEMPTY)`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_IMAGE_CONV *) +(* ------------------------------------------------------------------------- *) + +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE NEMPTY)`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE NZERO)`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NZERO NEMPTY))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NZERO NZERO))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NEMPTY NZERO))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE NEMPTY NEMPTY))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE ((+) 2) (NTRIE (NNODE (NNODE NEMPTY NZERO) NEMPTY))`;; + +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE NEMPTY)`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE NZERO)`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NZERO NEMPTY))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NZERO NZERO))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NEMPTY NZERO))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NEMPTY NEMPTY))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE (NNODE NEMPTY NZERO) NEMPTY))`;; +NTRIE_IMAGE_CONV NUM_ADD_CONV `IMAGE (\n. n + 2) (NTRIE (NNODE NEMPTY (NNODE NEMPTY NZERO)))`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_DECODE *) +(* ------------------------------------------------------------------------- *) + +NTRIE_DECODE_CONV `NTRIE NEMPTY`;; +NTRIE_DECODE_CONV `NTRIE NZERO`;; +NTRIE_DECODE_CONV `NTRIE (NNODE NZERO NEMPTY)`;; +NTRIE_DECODE_CONV `NTRIE (NNODE NZERO NZERO)`;; +NTRIE_DECODE_CONV `NTRIE (NNODE NEMPTY NZERO)`;; +NTRIE_DECODE_CONV `NTRIE (NNODE NEMPTY NEMPTY)`;; +NTRIE_DECODE_CONV `NTRIE (NNODE (NNODE NEMPTY NZERO) NEMPTY)`;; + +(* ------------------------------------------------------------------------- *) +(* NTRIE_ENCODE *) +(* ------------------------------------------------------------------------- *) + +NTRIE_ENCODE_CONV `{}:num->bool`;; +NTRIE_ENCODE_CONV `{1,2,3}`;; +ONCE_DEPTH_CONV NTRIE_ENCODE_CONV `{1,2,3} UNION {3,4,5}`;; + +(* ------------------------------------------------------------------------- *) +(* Final hack-together. *) +(* ------------------------------------------------------------------------- *) + +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} UNION ({3,4} UNION {6,7} UNION {1,7})`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} INTER ({3,4} UNION {6,7} UNION {1,7})`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} DIFF ({3,4} UNION {6,7} UNION {1,7})`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{1,2,3} DIFF ({3,4} UNION {6,7} INTER {1,7})`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `3 IN {1,2,3} INTER ({3,4} UNION {6,7} UNION {1,7})`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `11 IN {1,2,3} INTER ({3,4} UNION {6,7} UNION {1,7})`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} = {3,2,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} = {3,2,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} = {3,2,1,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} DELETE 2 = {3,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} SUBSET {3,2,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,7} SUBSET {3,2,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3,2} SUBSET {3,2,1,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} PSUBSET {3,2,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `{5,2,3} PSUBSET {3,2,0,5}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `DISJOINT {12,3,2,1} {3,2,7,9}`;; +NTRIE_COMPUTE NTRIE_REDUCE_CONV `DISJOINT {12,3,1} {2,7,9}`;; diff --git a/Permutation/make.ml b/Permutation/make.ml new file mode 100644 index 0000000..1a576e0 --- /dev/null +++ b/Permutation/make.ml @@ -0,0 +1,14 @@ +(* ========================================================================= *) +(* Permuted lists, finite permutations and quick sort. *) +(* *) +(* Author: Marco Maggesi *) +(* University of Florence, Italy *) +(* http://www.math.unifi.it/~maggesi/ *) +(* *) +(* (c) Copyright, Marco Maggesi, 2005-2007 *) +(* ========================================================================= *) + +loadt "Permutation/morelist.ml";; +loadt "Permutation/permuted.ml";; +loadt "Permutation/permutation.ml";; +loadt "Permutation/qsort.ml";; diff --git a/Permutation/morelist.ml b/Permutation/morelist.ml new file mode 100644 index 0000000..fc0fb25 --- /dev/null +++ b/Permutation/morelist.ml @@ -0,0 +1,250 @@ +(* ========================================================================= *) +(* More definitions and theorems and tactics about lists. *) +(* *) +(* Author: Marco Maggesi *) +(* University of Florence, Italy *) +(* http://www.math.unifi.it/~maggesi/ *) +(* *) +(* (c) Copyright, Marco Maggesi, 2005-2007 *) +(* ========================================================================= *) + +parse_as_infix ("::",(23,"right"));; +override_interface("::",`CONS`);; + +(* ------------------------------------------------------------------------- *) +(* Some handy tactics. *) +(* ------------------------------------------------------------------------- *) + +let ASSERT_TAC tm = SUBGOAL_THEN tm ASSUME_TAC;; + +let SUFFICE_TAC thl tm = + SUBGOAL_THEN tm (fun th -> MESON_TAC (th :: thl));; + +let LIST_CASES_TAC = + let th = prove (`!P. P [] /\ (!h t. P (h :: t)) ==> !l. P l`, + GEN_TAC THEN STRIP_TAC THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC []) + in + MATCH_MP_TAC th THEN CONJ_TAC THENL + [ALL_TAC; GEN_TAC THEN GEN_TAC];; + +(* ------------------------------------------------------------------------- *) +(* Occasionally useful stuff. *) +(* ------------------------------------------------------------------------- *) + +let NULL_EQ_NIL = prove + (`!l. NULL l <=> l = []`, + LIST_CASES_TAC THEN REWRITE_TAC [NULL; NOT_CONS_NIL]);; + +let NULL_LENGTH = prove + (`!l. NULL l <=> LENGTH l = 0`, + LIST_CASES_TAC THEN REWRITE_TAC [NULL; LENGTH; NOT_SUC]);; + +let LENGTH_FILTER_LE = prove + (`!f l:A list. LENGTH (FILTER f l) <= LENGTH l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [FILTER; LENGTH; LE_0] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC [LENGTH; LE_SUC; ARITH_RULE `n<=m ==> n<= SUC m`]);; + +(* ------------------------------------------------------------------------- *) +(* Well-founded induction on lists. *) +(* ------------------------------------------------------------------------- *) + +let list_WF = prove + (`!P. (!l. (!l'. LENGTH l' < LENGTH l ==> P l') ==> P l) + ==> (!l:A list. P l)`, + MP_TAC (ISPEC `LENGTH:A list->num` WF_MEASURE) THEN + REWRITE_TAC [WF_IND; MEASURE]);; + +(* ------------------------------------------------------------------------- *) +(* Delete one element from a list. *) +(* ------------------------------------------------------------------------- *) + +let DELETE1 = define + `(!x. DELETE1 x [] = []) /\ + (!x h t. DELETE1 x (h :: t) = if x = h then t + else h :: DELETE1 x t)`;; + +let DELETE1_ID = prove + (`!x l. ~MEM x l ==> DELETE1 x l = l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC [NOT_CONS_NIL; CONS_11]);; + +let DELETE1_APPEND = prove + (`!x l1 l2. DELETE1 x (APPEND l1 l2) = + if MEM x l1 then APPEND (DELETE1 x l1) l2 + else APPEND l1 (DELETE1 x l2)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [APPEND; DELETE1; MEM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MEM; APPEND] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[]);; + +let FILTER_DELETE1 = prove + (`!P x l. FILTER P (DELETE1 x l) = + if P x then DELETE1 x (FILTER P l) else FILTER P l`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REPEAT (REWRITE_TAC [DELETE1; FILTER] THEN COND_CASES_TAC) THEN + ASM_MESON_TAC []);; + +let LENGTH_DELETE1 = prove + (`!l x:A. LENGTH (DELETE1 x l) = + if MEM x l then PRE (LENGTH l) else LENGTH l`, + LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; LENGTH; DELETE1] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[PRE; LENGTH] THEN COND_CASES_TAC THEN + REWRITE_TAC [ARITH_RULE `SUC (PRE n)=n <=> ~(n=0)`; LENGTH_EQ_NIL] THEN + ASM_MESON_TAC [MEM]);; + +let MEM_DELETE1_MEM_IMP = prove + (`!h t x. MEM x (DELETE1 h t) ==> MEM x t`, + GEN_TAC THEN LIST_INDUCT_TAC THEN GEN_TAC THEN + REWRITE_TAC [MEM; DELETE1] THEN COND_CASES_TAC THEN + REWRITE_TAC [MEM] THEN STRIP_TAC THEN ASM_SIMP_TAC []);; + +let NOT_MEM_DELETE1 = prove + (`!t h x. ~MEM x t ==> ~MEM x (DELETE1 h t)`, + LIST_INDUCT_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC [MEM; DELETE1] THEN + COND_CASES_TAC THEN REWRITE_TAC [MEM; DE_MORGAN_THM] THEN + STRIP_TAC THEN ASM_SIMP_TAC []);; + +let MEM_DELETE1 = prove + (`!l x y:A. MEM x l /\ ~(x = y) ==> MEM x (DELETE1 y l)`, + LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN + GEN_TAC THEN GEN_TAC THEN COND_CASES_TAC THENL + [EXPAND_TAC "h" THEN MESON_TAC []; + REWRITE_TAC [MEM] THEN ASM_MESON_TAC []]);; + +let ALL_DELETE1_ALL_IMP = prove + (`!P x l. P x /\ ALL P (DELETE1 x l) ==> ALL P l`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC [ALL; DELETE1] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC [ALL]);; + +(* ------------------------------------------------------------------------- *) +(* Counting occurrences of a given element in a list. *) +(* ------------------------------------------------------------------------- *) + +let COUNT = define + `(!x. COUNT x [] = 0) /\ + (!x h t. COUNT x (CONS h t) = if x=h then SUC (COUNT x t) else COUNT x t)`;; + +let COUNT_LENGTH_FILTER = prove + (`!x l. COUNT x l = LENGTH (FILTER ((=) x) l)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [COUNT; FILTER; LENGTH] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC [LENGTH]);; + +let COUNT_FILTER = prove + (`!P x l. COUNT x (FILTER P l) = + if P x then COUNT x l else 0`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REPEAT (ASM_REWRITE_TAC [COUNT; FILTER] THEN COND_CASES_TAC) THEN + ASM_MESON_TAC []);; + +let COUNT_APPEND = prove + (`!x l1 l2. COUNT x (APPEND l1 l2) = COUNT x l1 + COUNT x l2`, + REWRITE_TAC [COUNT_LENGTH_FILTER; LENGTH_APPEND; FILTER_APPEND]);; + +let COUNT_LE_LENGTH = prove + (`!x l. COUNT x l <= LENGTH l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [COUNT; LENGTH; LE_REFL] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC [LE_SUC; ARITH_RULE `n<=m ==> n <= SUC m`]);; + +let COUNT_ZERO = prove + (`!x l. COUNT x l = 0 <=> ~MEM x l`, + GEN_TAC THEN REWRITE_TAC [COUNT_LENGTH_FILTER; LENGTH_EQ_NIL] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC [FILTER; MEM] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC [NOT_CONS_NIL]);; + +let MEM_COUNT = prove + (`!x l. MEM x l <=> ~(COUNT x l = 0)`, + MESON_TAC [COUNT_ZERO]);; + +let COUNT_DELETE1 = prove + (`!y x l. COUNT y (DELETE1 (x:A) l) = + if y=x /\ MEM x l then PRE (COUNT y l) else COUNT y l`, + REWRITE_TAC [COUNT_LENGTH_FILTER; FILTER_DELETE1] THEN REPEAT GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MEM_FILTER; LENGTH_DELETE1]);; + +(* ------------------------------------------------------------------------- *) +(* Duplicates in a list. *) +(* ------------------------------------------------------------------------- *) + +let LIST_UNIQ_RULES, LIST_UNIQ_INDUCT, LIST_UNIQ_CASES = + new_inductive_definition + `LIST_UNIQ [] /\ + (!x xs. LIST_UNIQ xs /\ ~MEM x xs ==> LIST_UNIQ (x :: xs))`;; + +let LIST_UNIQ = prove + (`LIST_UNIQ [] /\ + (!x. LIST_UNIQ [x]) /\ + (!x xs. LIST_UNIQ (x :: xs) <=> ~MEM x xs /\ LIST_UNIQ xs)`, + SIMP_TAC [LIST_UNIQ_RULES; MEM] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL + [ONCE_REWRITE_TAC [ISPEC `h :: t` LIST_UNIQ_CASES] THEN + REWRITE_TAC [CONS_11; NOT_CONS_NIL] THEN + DISCH_THEN (CHOOSE_THEN CHOOSE_TAC) THEN ASM_REWRITE_TAC []; + SIMP_TAC [LIST_UNIQ_RULES]]);; + +(* !!! forse e' meglio con IMP? *) +(* Magari LIST_UNIQ_COUNT + COUNT_LIST_UNIQ *) +let LIST_UNIQ_COUNT = prove + (`!l. LIST_UNIQ l <=> (!x:A. COUNT x l = if MEM x l then 1 else 0)`, + let IFF_EXPAND = MESON [] `(p <=> q) <=> (p ==> q) /\ (q ==> p)` in + REWRITE_TAC [IFF_EXPAND; FORALL_AND_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC LIST_UNIQ_INDUCT THEN REWRITE_TAC [COUNT; MEM] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ONE]; + LIST_INDUCT_TAC THEN REWRITE_TAC [LIST_UNIQ; COUNT; MEM] THEN + DISCH_TAC THEN FIRST_ASSUM (MP_TAC o SPEC `h:A`) THEN + SIMP_TAC [MEM_COUNT; ONE; SUC_INJ] THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN + FIRST_ASSUM (MP_TAC o SPEC `x:A`) THEN + REWRITE_TAC [MEM_COUNT] THEN ARITH_TAC]);; + +let LIST_UNIQ_DELETE1 = prove + (`!l x. LIST_UNIQ l ==> LIST_UNIQ (DELETE1 x l)`, + LIST_INDUCT_TAC THEN GEN_TAC THEN + REWRITE_TAC [LIST_UNIQ; DELETE1] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC [LIST_UNIQ; NOT_MEM_DELETE1]);; + +let DELETE1_LIST_UNIQ = prove + (`!l x:A. ~MEM x (DELETE1 x l) /\ LIST_UNIQ (DELETE1 x l) + ==> LIST_UNIQ l`, + LIST_INDUCT_TAC THEN REWRITE_TAC [LIST_UNIQ; DELETE1; MEM] THEN + GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC [MEM; LIST_UNIQ] THEN STRIP_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC [MEM_DELETE1]; + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `x:A` THEN + ASM_REWRITE_TAC []]);; + +let LIST_UNIQ_APPEND = prove + (`!l m. LIST_UNIQ (APPEND l m) <=> + LIST_UNIQ l /\ LIST_UNIQ m /\ + !x. ~(MEM x l /\ MEM x m)`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; LIST_UNIQ; MEM; MEM_APPEND] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Lists and finite sets. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LENGTH = prove + (`!l:A list. CARD (set_of_list l) <= LENGTH l`, + LIST_INDUCT_TAC THEN + SIMP_TAC [set_of_list; CARD_CLAUSES; LENGTH; + FINITE_SET_OF_LIST; ARITH] THEN + COND_CASES_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `LENGTH (t:A list)` + THEN ASM_REWRITE_TAC [] THEN ARITH_TAC; + ASM_REWRITE_TAC [LE_SUC]]);; + +let LIST_UNIQ_CARD_LENGTH = prove + (`!l:A list. LIST_UNIQ l <=> CARD (set_of_list l) = LENGTH l`, + LIST_INDUCT_TAC THEN SIMP_TAC [LIST_UNIQ; set_of_list; FINITE_SET_OF_LIST; + LENGTH; CARD_CLAUSES; IN_SET_OF_LIST] THEN + FIRST_X_ASSUM SUBST1_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[SUC_INJ] THEN MP_TAC (SPEC `t:A list` CARD_LENGTH) THEN + ARITH_TAC);; + +let LIST_UNIQ_LIST_OF_SET = prove + (`!s. FINITE s ==> LIST_UNIQ(list_of_set s)`, + SIMP_TAC[LIST_UNIQ_CARD_LENGTH; SET_OF_LIST_OF_SET; LENGTH_LIST_OF_SET]);; diff --git a/Permutation/nummax.ml b/Permutation/nummax.ml new file mode 100644 index 0000000..9b72559 --- /dev/null +++ b/Permutation/nummax.ml @@ -0,0 +1,90 @@ +(* ========================================================================= *) +(* Maximum of two nums and of a list of nums. *) +(* *) +(* Author: Marco Maggesi *) +(* University of Florence, Italy *) +(* http://www.math.unifi.it/~maggesi/ *) +(* *) +(* (c) Copyright, Marco Maggesi, 2005-2007 *) +(* ========================================================================= *) + +needs "Permutation/morelist.ml";; + +(* ------------------------------------------------------------------------- *) +(* Maximum of two nums. *) +(* ------------------------------------------------------------------------- *) + +let MAX_LT = prove + (`!m n p. MAX m n < p <=> m < p /\ n < p`, + REWRITE_TAC [MAX] THEN ARITH_TAC);; + +let MAX_LE = prove + (`!m n p. MAX m n <= p <=> m <= p /\ n <= p`, + REWRITE_TAC [MAX] THEN ARITH_TAC);; + +let LT_MAX = prove + (`!m n p. p < MAX m n <=> p < m \/ p < n`, + REWRITE_TAC [MAX] THEN ARITH_TAC);; + +let LE_MAX = prove + (`!m n p. p <= MAX m n <=> p <= m \/ p <= n`, + REWRITE_TAC [MAX] THEN ARITH_TAC);; + +let MAX_SYM = prove + (`!m n. MAX n m = MAX m n`, + MATCH_MP_TAC WLOG_LE THEN CONJ_TAC THEN REPEAT GEN_TAC THENL + [EQ_TAC THEN SIMP_TAC []; SIMP_TAC [MAX] THEN ARITH_TAC]);; + +let MAX_ASSOC = prove + (`!m n p. MAX (MAX m n) p = MAX m (MAX n p)`, + REPEAT GEN_TAC THEN REWRITE_TAC [MAX] THEN + ASM_CASES_TAC `m <= n` THEN ASM_REWRITE_TAC [] THEN + ASM_CASES_TAC `n <= p` THEN ASM_REWRITE_TAC [] THENL + [SUBGOAL_THEN `m <= p` (fun th -> REWRITE_TAC [th]) THEN + MATCH_MP_TAC LE_TRANS THEN ASM_MESON_TAC []; + SUBGOAL_THEN `~(m <= p)` (fun th -> REWRITE_TAC [th]) THEN + FIRST_X_ASSUM MP_TAC THEN FIRST_X_ASSUM MP_TAC THEN ARITH_TAC]);; + +let MAX_ACI = prove + (`(!m n. MAX n m = MAX m n) /\ + (!m n p. MAX (MAX m n) p = MAX m (MAX n p)) /\ + (!m n p. MAX m (MAX n p) = MAX n (MAX m p)) /\ + (!m. MAX m m = m) /\ + (!m n. MAX m (MAX m n) = MAX m n)`, + SUBGOAL_THEN `!n. MAX n n = n` ASSUME_TAC THENL + [REWRITE_TAC [MAX] THEN ARITH_TAC; + ASM_MESON_TAC [MAX_SYM; MAX_ASSOC]]);; + +let MAX_0 = prove + (`(!n. MAX n 0 = n) /\ (!n. MAX 0 n = n)`, + REWRITE_TAC [MAX_SYM] THEN REWRITE_TAC [MAX] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Maximum of a list of nums. *) +(* ------------------------------------------------------------------------- *) + +let MAXL = define + `MAXL [] = 0 /\ + (!h t. MAXL (CONS h t) = MAX h (MAXL t))`;; + +let MAXL_LE = prove + (`!l n. MAXL l <= n <=> ALL (\m. m <= n) l`, + LIST_INDUCT_TAC THEN REWRITE_TAC [ALL; MAXL; LE_0] THEN + ASM_SIMP_TAC [MAX_LE]);; + +let LT_MAXL = prove + (`!l n. n < MAXL l <=> EX (\m. n < m) l`, + LIST_INDUCT_TAC THEN + ASM_SIMP_TAC [EX; MAXL; NOT_LT; LE_0; LT_MAX]);; + +let LE_MAXL = prove + (`!n l. MEM n l ==> n <= MAXL l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; MAXL] THEN + STRIP_TAC THEN ASM_SIMP_TAC [LE_REFL; LE_MAX]);; + +let MEM_MAXL = prove + (`!l. ~NULL l ==> MEM (MAXL l) l`, + REWRITE_TAC [NULL_EQ_NIL] THEN LIST_INDUCT_TAC THEN + REWRITE_TAC [MEM; MAXL; NOT_CONS_NIL] THEN + ASM_CASES_TAC `t:num list=[]` THEN ASM_REWRITE_TAC[MAXL; MAX_0] THEN + ASM_MESON_TAC [MAX]);; diff --git a/Permutation/permutation.ml b/Permutation/permutation.ml new file mode 100644 index 0000000..1201638 --- /dev/null +++ b/Permutation/permutation.ml @@ -0,0 +1,105 @@ +(* ========================================================================= *) +(* Permuted lists and finite permutations. *) +(* *) +(* Author: Marco Maggesi *) +(* University of Florence, Italy *) +(* http://www.math.unifi.it/~maggesi/ *) +(* *) +(* (c) Copyright, Marco Maggesi, 2005-2007 *) +(* ========================================================================= *) + +needs "Permutation/permuted.ml";; + +(* ------------------------------------------------------------------------- *) +(* Permutation that reverse a list. *) +(* ------------------------------------------------------------------------- *) + +let REVPERM = define + `REVPERM 0 = [] /\ + REVPERM (SUC n) = n :: REVPERM n`;; + +let MEM_REVPERM = prove + (`!n m. MEM m (REVPERM n) <=> m < n`, + INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; MEM; LT]);; + +let LIST_UNIQ_REVPERM = prove + (`!n. LIST_UNIQ (REVPERM n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; LIST_UNIQ; MEM_REVPERM] + THEN ARITH_TAC);; + +let DELETE1_REVPERM = prove + (`!n. DELETE1 n (REVPERM (SUC n)) = REVPERM n`, + INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; DELETE1; MEM]);; + +let COUNT_REVPERM = prove + (`!n i. COUNT i (REVPERM n) = if i < n then 1 else 0`, + INDUCT_TAC THEN ASM_REWRITE_TAC [REVPERM; COUNT] THEN ARITH_TAC);; + +let SET_OF_LIST_REVPERM = prove + (`!n. set_of_list (REVPERM n) = {m | m < n}`, + INDUCT_TAC THEN + ASM_REWRITE_TAC [REVPERM; set_of_list; LT; EMPTY_GSPEC; EXTENSION; + IN_INSERT; IN_ELIM_THM; NOT_IN_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Permutations. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTATION = new_definition + `!l. PERMUTATION l <=> REVPERM (LENGTH l) PERMUTED l`;; + +let PERMUTATION_NIL = prove + (`PERMUTATION []`, + REWRITE_TAC [PERMUTATION; LENGTH; REVPERM; PERMUTED_RULES]);; + +let PERMUTATION_LIST_UNIQ = prove + (`!l. PERMUTATION l ==> LIST_UNIQ l`, + MESON_TAC [PERMUTATION; PERMUTED_LIST_UNIQ; LIST_UNIQ_REVPERM]);; + +let PERMUTATION_MEM = prove + (`!l. PERMUTATION l ==> (!i. MEM i l <=> i < LENGTH l)`, + REWRITE_TAC [PERMUTATION] THEN + MESON_TAC [MEM_REVPERM; PERMUTED_MEM]);; + +let PERMUTATION_COUNT = prove + (`!l. PERMUTATION l <=> (!x. COUNT x l = if x < LENGTH l then 1 else 0)`, + REWRITE_TAC [PERMUTATION; PERMUTED_COUNT; COUNT_REVPERM] THEN + MESON_TAC[]);; + +let LIST_UNIQ_PERMUTED_SET_OF_LIST = prove + (`!l1 l2. LIST_UNIQ l1 /\ LIST_UNIQ l2 + ==> (l1 PERMUTED l2 <=> set_of_list l1 = set_of_list l2)`, + REWRITE_TAC [LIST_UNIQ_COUNT] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC [EXTENSION; IN_SET_OF_LIST; PERMUTED_COUNT; MEM_COUNT] THEN + ASM_REWRITE_TAC [] THEN MESON_TAC []);; + +let PERMUTATION_SET_OF_LIST = prove + (`!l. PERMUTATION l <=> set_of_list l = {n | n < LENGTH l}`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [REWRITE_TAC [GSYM SET_OF_LIST_REVPERM] THEN + ASM_MESON_TAC [LIST_UNIQ_PERMUTED_SET_OF_LIST; PERMUTATION; + PERMUTED_LIST_UNIQ; LIST_UNIQ_REVPERM]; + REWRITE_TAC [PERMUTATION] THEN ASSERT_TAC `LIST_UNIQ (l:num list)` THENL + [REWRITE_TAC [LIST_UNIQ_CARD_LENGTH] THEN FIRST_X_ASSUM SUBST1_TAC THEN + REWRITE_TAC [CARD_NUMSEG_LT]; + ASM_SIMP_TAC [SET_OF_LIST_REVPERM; LIST_UNIQ_REVPERM; + LIST_UNIQ_PERMUTED_SET_OF_LIST]]]);; + +let MEM_PERMUTATION = prove + (`!l. (!n. n < LENGTH l ==> MEM n l) ==> PERMUTATION l`, + REPEAT STRIP_TAC THEN REWRITE_TAC [PERMUTATION_SET_OF_LIST] THEN + MATCH_MP_TAC (GSYM CARD_SUBSET_LE) THEN + REWRITE_TAC [FINITE_SET_OF_LIST; CARD_NUMSEG_LT; CARD_LENGTH] THEN + ASM_SIMP_TAC [SUBSET; IN_ELIM_THM; IN_SET_OF_LIST]);; + +let LIST_UNIQ_MEM_PERMUTATION = prove + (`!l. LIST_UNIQ l /\ (!n. MEM n l ==> n < LENGTH l) ==> PERMUTATION l`, + REWRITE_TAC [LIST_UNIQ_CARD_LENGTH; PERMUTATION_SET_OF_LIST] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARD_SUBSET_LE THEN + ASM_REWRITE_TAC [FINITE_NUMSEG_LT; SUBSET; IN_ELIM_THM; IN_SET_OF_LIST; + CARD_NUMSEG_LT; LE_REFL]);; + +let PERMUTATION_UNIQ_LT = prove + (`!l. PERMUTATION l <=> LIST_UNIQ l /\ (!n. MEM n l ==> n < LENGTH l)`, + MESON_TAC [PERMUTATION_LIST_UNIQ; PERMUTATION_MEM; + LIST_UNIQ_MEM_PERMUTATION]);; diff --git a/Permutation/permuted.ml b/Permutation/permuted.ml new file mode 100644 index 0000000..aa2becd --- /dev/null +++ b/Permutation/permuted.ml @@ -0,0 +1,152 @@ +(* ========================================================================= *) +(* Permuted lists. *) +(* *) +(* Author: Marco Maggesi *) +(* University of Florence, Italy *) +(* http://www.math.unifi.it/~maggesi/ *) +(* *) +(* (c) Copyright, Marco Maggesi, 2005-2007 *) +(* ========================================================================= *) + +needs "Permutation/morelist.ml";; + +parse_as_infix("PERMUTED",(12,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Permuted lists. *) +(* ------------------------------------------------------------------------- *) + +let PERMUTED_RULES, PERMUTED_INDUCT, PERMUTED_CASES = + new_inductive_definition + `[] PERMUTED [] /\ + (!h t1 t2. t1 PERMUTED t2 ==> h :: t1 PERMUTED h :: t2) /\ + (!l1 l2 l3. l1 PERMUTED l2 /\ l2 PERMUTED l3 ==> l1 PERMUTED l3) /\ + (!x y t. x :: y :: t PERMUTED y :: x :: t)`;; + +let PERMUTED_INDUCT_STRONG = + derive_strong_induction(PERMUTED_RULES,PERMUTED_INDUCT);; + +let PERMUTED_RFL = prove + (`!l. l PERMUTED l`, + LIST_INDUCT_TAC THEN ASM_SIMP_TAC [PERMUTED_RULES]);; + +let PERMUTED_SYM = prove + (`!(xs:A list) l2. xs PERMUTED l2 <=> l2 PERMUTED xs`, + SUFFICE_TAC [] + `!(xs:A list) l2. xs PERMUTED l2 ==> l2 PERMUTED xs` THEN + MATCH_MP_TAC PERMUTED_INDUCT THEN ASM_MESON_TAC [PERMUTED_RULES]);; + +let PERMUTED_TRS = prove + (`!xs l2 l3. xs PERMUTED l2 /\ l2 PERMUTED l3 ==> xs PERMUTED l3`, + MESON_TAC [PERMUTED_RULES]);; + +let PERMUTED_TRS_TAC tm : tactic = + MATCH_MP_TAC PERMUTED_TRS THEN EXISTS_TAC tm THEN CONJ_TAC ;; + +let PERMUTED_TAIL_IMP = prove + (`!h t1 t2. t1 PERMUTED t2 ==> h :: t1 PERMUTED h :: t2`, + SIMP_TAC [PERMUTED_RULES]);; + +let PERMUTED_MAP = prove + (`!f l1 l2. l1 PERMUTED l2 ==> MAP f l1 PERMUTED MAP f l2`, + GEN_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT THEN + REWRITE_TAC [MAP; PERMUTED_RULES]);; + +let PERMUTED_LENGTH = prove + (`!l1 l2. l1 PERMUTED l2 ==> LENGTH l1 = LENGTH l2`, + MATCH_MP_TAC PERMUTED_INDUCT THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [LENGTH]);; + +let PERMUTED_SWAP_HEAD = prove + (`!a b l. a :: b :: l PERMUTED b :: a :: l`, + REWRITE_TAC [PERMUTED_RULES]);; + +let PERMUTED_MEM = prove + (`!(a:A) l1 l2. l1 PERMUTED l2 ==> (MEM a l1 <=> MEM a l2)`, + GEN_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT THEN + REWRITE_TAC [MEM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]);; + +let PERMUTED_ALL = prove + (`!P xs ys. xs PERMUTED ys ==> (ALL P xs <=> ALL P ys)`, + GEN_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT THEN + REWRITE_TAC [ALL] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[] THEN MESON_TAC[]);; + +let PERMUTED_NIL_EQ_NIL = prove + (`(!l:A list. [] PERMUTED l <=> l = []) /\ + (!l:A list. l PERMUTED [] <=> l = [])`, + SUFFICE_TAC [PERMUTED_SYM] `!l:A list. [] PERMUTED l <=> l = []` THEN + LIST_CASES_TAC THEN ASM_REWRITE_TAC [NOT_CONS_NIL; PERMUTED_RFL] THEN + MESON_TAC [PERMUTED_LENGTH; LENGTH; NOT_SUC]);; + +let PERMUTED_SINGLETON = prove + (`(!(x:A) l. [x] PERMUTED l <=> l = [x]) /\ + (!(x:A) l. l PERMUTED [x] <=> l = [x])`, + SUFFICE_TAC [PERMUTED_LENGTH; PERMUTED_RFL] + `!l1 l2. l1 PERMUTED l2 ==> LENGTH l1 = LENGTH l2 /\ + (!x. l1 = [x:A] <=> l2 = [x])` THEN + MATCH_MP_TAC PERMUTED_INDUCT THEN + SIMP_TAC [PERMUTED_NIL_EQ_NIL; LENGTH; NOT_CONS_NIL; CONS_11; + SUC_INJ; GSYM LENGTH_EQ_NIL]);; + +let PERMUTED_CONS_DELETE1 = prove + (`!(a:A) l. MEM a l ==> l PERMUTED a :: DELETE1 a l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC [MEM; DELETE1] THEN + COND_CASES_TAC THEN + ASM_MESON_TAC [PERMUTED_RFL; PERMUTED_TAIL_IMP; PERMUTED_SWAP_HEAD; + PERMUTED_TRS]);; + +let PERMUTED_COUNT = prove + (`!l1 l2. l1 PERMUTED l2 <=> (!x:A. COUNT x l1 = COUNT x l2)`, + let IFF_EXPAND = MESON [] `(p <=> q) <=> (p ==> q) /\ (q ==> p)` in + REWRITE_TAC [IFF_EXPAND; FORALL_AND_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC PERMUTED_INDUCT THEN REWRITE_TAC [COUNT] THEN + ASM_MESON_TAC []; ALL_TAC] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC [COUNT; PERMUTED_NIL_EQ_NIL] THENL + [LIST_CASES_TAC THEN REWRITE_TAC [COUNT; NOT_CONS_NIL] THEN + MESON_TAC [NOT_SUC]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN ASSERT_TAC `MEM (h:A) l2` THENL + [FIRST_X_ASSUM (MP_TAC o SPEC `h:A`) THEN REWRITE_TAC[MEM_COUNT] + THEN ARITH_TAC; ALL_TAC] THEN + ASSERT_TAC `(h:A) :: t PERMUTED h :: DELETE1 h l2` THENL + [MATCH_MP_TAC PERMUTED_TAIL_IMP THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC [COUNT_DELETE1] THEN GEN_TAC THEN + FIRST_X_ASSUM (MP_TAC o SPEC `x:A`) THEN ARITH_TAC; + ASM_MESON_TAC [PERMUTED_CONS_DELETE1; PERMUTED_SYM; PERMUTED_TRS]]);; + +let PERMUTED_TAIL = prove + (`!x t1 t2. x :: t1 PERMUTED x :: t2 <=> t1 PERMUTED t2`, + REPEAT GEN_TAC THEN REWRITE_TAC [PERMUTED_COUNT; COUNT] THEN + MESON_TAC [SUC_INJ]);; + +let PERMUTED_DELETE1_L = prove + (`!(h:A) t l. h :: t PERMUTED l <=> MEM h l /\ t PERMUTED DELETE1 h l`, + MESON_TAC [PERMUTED_MEM; MEM; PERMUTED_TAIL; PERMUTED_CONS_DELETE1; + PERMUTED_SYM; PERMUTED_TRS]);; + +let PERMUTED_DELETE1_R = prove + (`!(h:A) t l. l PERMUTED h :: t <=> MEM h l /\ DELETE1 h l PERMUTED t`, + MESON_TAC [PERMUTED_SYM; PERMUTED_DELETE1_L]);; + +let PERMUTED_LIST_UNIQ = prove + (`!xs ys. xs PERMUTED ys ==> (LIST_UNIQ xs <=> LIST_UNIQ ys)`, + SIMP_TAC [PERMUTED_COUNT; LIST_UNIQ_COUNT; MEM_COUNT]);; + +let PERMUTED_IMP_PAIRWISE = prove + (`!(P:A->A->bool) l l'. + (!x y. P x y ==> P y x) /\ l PERMUTED l' /\ PAIRWISE P l + ==> PAIRWISE P l'`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC PERMUTED_INDUCT_STRONG THEN + ASM_SIMP_TAC[PAIRWISE; ALL] THEN MESON_TAC[PERMUTED_ALL]);; + +let PERMUTED_PAIRWISE = prove + (`!(P:A->A->bool) l l. + (!x y. P x y ==> P y x) /\ l PERMUTED l' + ==> (PAIRWISE P l <=> PAIRWISE P l')`, + MESON_TAC[PERMUTED_IMP_PAIRWISE; PERMUTED_SYM]);; + +let PERMUTED_APPEND_SWAP = prove + (`!l1 l2. (APPEND l1 l2) PERMUTED (APPEND l2 l1)`, + REWRITE_TAC[PERMUTED_COUNT; COUNT_APPEND] THEN ARITH_TAC);; diff --git a/Permutation/qsort.ml b/Permutation/qsort.ml new file mode 100644 index 0000000..706c479 --- /dev/null +++ b/Permutation/qsort.ml @@ -0,0 +1,103 @@ +(* ========================================================================= *) +(* Quick sort algorithm. *) +(* *) +(* Author: Marco Maggesi *) +(* University of Florence, Italy *) +(* http://www.math.unifi.it/~maggesi/ *) +(* *) +(* (c) Copyright, Marco Maggesi, 2005-2007 *) +(* ========================================================================= *) + +needs "Permutation/permuted.ml";; + +(* ------------------------------------------------------------------------- *) +(* Ordered lists. *) +(* ------------------------------------------------------------------------- *) + +let ORDERED_RULES, ORDERED_INDUCT, ORDERED_CASES = new_inductive_definition + `(!le. ORDERED le []) /\ + (!le h t. ORDERED le t /\ ALL (le h) t ==> ORDERED le (CONS h t))`;; + +let ORDERED_CONS = prove + (`!le (h:A) t. ORDERED le (h :: t) <=> (ORDERED le t /\ ALL (le h) t)`, + SUBGOAL_THEN + `!le (h:A) t. ORDERED le (h :: t) ==> (ORDERED le t /\ ALL (le h) t)` + (fun th -> MESON_TAC [th; ORDERED_RULES]) THEN + REPEAT GEN_TAC THEN + DISCH_THEN (MP_TAC o ONCE_REWRITE_RULE [ORDERED_CASES]) THEN + REWRITE_TAC [NOT_CONS_NIL; CONS_11] THEN MESON_TAC []);; + +let ORDERED_APPEND = prove + (`!l1 l2:A list. + ORDERED le (APPEND l1 l2) <=> + ORDERED le l1 /\ ORDERED le l2 /\ ALL (\x. ALL (le x) l2) l1`, + SUBGOAL_THEN + `(!l1 l2:A list. + ORDERED le (APPEND l1 l2) + ==> ORDERED le l1 /\ ORDERED le l2 /\ ALL (\x. ALL (le x) l2) l1) /\ + (!l1 l2. ORDERED le l1 /\ ORDERED le l2 /\ ALL (\x. ALL (le x) l2) l1 + ==> ORDERED le (APPEND l1 l2))` + (fun th -> MESON_TAC [th]) THEN + CONJ_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND; ALL; ORDERED_RULES; ORDERED_CONS] THEN + ASM_SIMP_TAC [ORDERED_CONS; ALL_APPEND] THEN ASM_MESON_TAC [ALL_APPEND]);; + +(* ------------------------------------------------------------------------- *) +(* Quick Sort. *) +(* ------------------------------------------------------------------------- *) + +let QSORT = + let PROVE_RECURSIVE_FUNCTION_EXISTS_TAC : tactic = fun g -> + let th = pure_prove_recursive_function_exists (snd g) in + MATCH_MP_TAC (DISCH_ALL th) g in + new_specification ["QSORT"] (prove + (`?f. (!le. f le [] = [] : A list) /\ + (!le h t. f le (CONS h t) = + APPEND (f le (FILTER (\x. ~le h x) t)) + (CONS h (f le (FILTER (\x. le h x) t))))`, + REWRITE_TAC [GSYM SKOLEM_THM; AND_FORALL_THM] THEN GEN_TAC THEN + PROVE_RECURSIVE_FUNCTION_EXISTS_TAC THEN + EXISTS_TAC `MEASURE (LENGTH:A list -> num)` THEN + REWRITE_TAC [WF_MEASURE; MEASURE; LENGTH; FILTER] THEN + REWRITE_TAC [LT_SUC_LE; LENGTH_FILTER_LE]));; + +let COUNT_QSORT = prove + (`!le x l. COUNT x (QSORT le l) = COUNT x l`, + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC list_WF THEN LIST_INDUCT_TAC THEN + REWRITE_TAC [QSORT; COUNT; LENGTH; LT_SUC_LE; COUNT_APPEND] THEN + DISCH_TAC THEN ASM_SIMP_TAC [COUNT; LENGTH_FILTER_LE] THEN + REWRITE_TAC [COUNT_FILTER] THEN + REPEAT (ASM_REWRITE_TAC [ADD; ADD_SUC; ADD_0] THEN COND_CASES_TAC) THEN + ASM_MESON_TAC[ADD_SUC]);; + +let QSORT_PERMUTED = prove + (`!le (l:A list). QSORT le l PERMUTED l`, + REWRITE_TAC [PERMUTED_COUNT; COUNT_QSORT]);; + +let ALL_QSORT = prove + (`!P le l. ALL P (QSORT le l) <=> ALL P l`, + MESON_TAC [QSORT_PERMUTED; PERMUTED_ALL]);; + +let LENGTH_QSORT = prove + (`!le l. LENGTH (QSORT le l) = LENGTH l`, + MESON_TAC [QSORT_PERMUTED; PERMUTED_LENGTH]);; + +let MEM_QSORT = prove + (`!le l x. MEM x (QSORT le l) <=> MEM x l`, + MESON_TAC [QSORT_PERMUTED; PERMUTED_MEM]);; + +let ORDERED_QSORT = prove + (`!le (l:A list). + (!x y. le x y \/ le y x) /\ (!x y z. le x y \/ le y z ==> le x z) + ==> ORDERED le (QSORT le l)`, + REWRITE_TAC [GSYM RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC list_WF THEN LIST_CASES_TAC THEN + REWRITE_TAC [QSORT; LENGTH; ORDERED_RULES; LT_SUC_LE] THEN DISCH_TAC THEN + REWRITE_TAC [ORDERED_APPEND; ORDERED_CONS; ALL; ALL_QSORT; ALL_T] THEN + ASM_SIMP_TAC [LENGTH_FILTER_LE] THEN REWRITE_TAC [GSYM ALL_MEM] THEN + ASM_MESON_TAC[]);; + +(* Example: +REWRITE_CONV [QSORT; ARITH_LE; ARITH_LT; FILTER; APPEND] + `QSORT (<=) [12;3;5;1;23;2;1]`;; +*) diff --git a/Proofrecording/diffs/basics.ml b/Proofrecording/diffs/basics.ml new file mode 100644 index 0000000..ac7d5e1 --- /dev/null +++ b/Proofrecording/diffs/basics.ml @@ -0,0 +1,425 @@ +(* ========================================================================= *) +(* More syntax constructors, and prelogical utilities like matching. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Create probably-fresh variable *) +(* ------------------------------------------------------------------------- *) + +let genvar = + let gcounter = ref 0 in + fun ty -> let count = !gcounter in + (gcounter := count + 1; + mk_var("_"^(string_of_int count),ty));; + +(* ------------------------------------------------------------------------- *) +(* Convenient functions for manipulating types. *) +(* ------------------------------------------------------------------------- *) + +let dest_fun_ty ty = + match ty with + Tyapp("fun",[ty1;ty2]) -> (ty1,ty2) + | _ -> failwith "dest_fun_ty";; + +let rec occurs_in ty bigty = + bigty = ty or + is_type bigty & exists (occurs_in ty) (snd(dest_type bigty));; + +let rec tysubst alist ty = + try rev_assoc ty alist with Failure _ -> + if is_vartype ty then ty else + let tycon,tyvars = dest_type ty in + mk_type(tycon,map (tysubst alist) tyvars);; + +(* ------------------------------------------------------------------------- *) +(* A bit more syntax. *) +(* ------------------------------------------------------------------------- *) + +let bndvar tm = + try fst(dest_abs tm) + with Failure _ -> failwith "bndvar: Not an abstraction";; + +let body tm = + try snd(dest_abs tm) + with Failure _ -> failwith "body: Not an abstraction";; + +let list_mk_comb(h,t) = rev_itlist (C (curry mk_comb)) t h;; + +let list_mk_abs(vs,bod) = itlist (curry mk_abs) vs bod;; + +let strip_comb = rev_splitlist dest_comb;; + +let strip_abs = splitlist dest_abs;; + +(* ------------------------------------------------------------------------- *) +(* Generic syntax to deal with some binary operators. *) +(* *) +(* Note that "mk_binary" only works for monomorphic functions. *) +(* ------------------------------------------------------------------------- *) + +let is_binary s tm = + match tm with + Comb(Comb(Const(s',_),_),_) -> s' = s + | _ -> false;; + +let dest_binary s tm = + match tm with + Comb(Comb(Const(s',_),l),r) when s' = s -> (l,r) + | _ -> failwith "dest_binary";; + +let mk_binary s = + let c = mk_const(s,[]) in + fun (l,r) -> try mk_comb(mk_comb(c,l),r) + with Failure _ -> failwith "mk_binary";; + +(* ------------------------------------------------------------------------- *) +(* Produces a sequence of variants, considering previous inventions. *) +(* ------------------------------------------------------------------------- *) + +let rec variants av vs = + if vs = [] then [] else + let vh = variant av (hd vs) in vh::(variants (vh::av) (tl vs));; + +(* ------------------------------------------------------------------------- *) +(* Gets all variables (free and/or bound) in a term. *) +(* ------------------------------------------------------------------------- *) + +let variables = + let rec vars(acc,tm) = + if is_var tm then insert tm acc + else if is_const tm then acc + else if is_abs tm then + let v,bod = dest_abs tm in + vars(insert v acc,bod) + else + let l,r = dest_comb tm in + vars(vars(acc,l),r) in + fun tm -> vars([],tm);; + +(* ------------------------------------------------------------------------- *) +(* General substitution (for any free expression). *) +(* ------------------------------------------------------------------------- *) + +let subst = + let rec ssubst ilist tm = + if ilist = [] then tm else + try fst (find ((aconv tm) o snd) ilist) with Failure _ -> + match tm with + Comb(f,x) -> let f' = ssubst ilist f and x' = ssubst ilist x in + if f' == f & x' == x then tm else mk_comb(f',x') + | Abs(v,bod) -> + let ilist' = filter (not o (vfree_in v) o snd) ilist in + mk_abs(v,ssubst ilist' bod) + | _ -> tm in + fun ilist -> + let theta = filter (fun (s,t) -> Pervasives.compare s t <> 0) ilist in + if theta = [] then (fun tm -> tm) else + let ts,xs = unzip theta in + fun tm -> + let gs = variants (variables tm) (map (genvar o type_of) xs) in + let tm' = ssubst (zip gs xs) tm in + if tm' == tm then tm else vsubst (zip ts gs) tm';; + +(* ------------------------------------------------------------------------- *) +(* Alpha conversion term operation. *) +(* ------------------------------------------------------------------------- *) + +let alpha v tm = + let v0,bod = try dest_abs tm + with Failure _ -> failwith "alpha: Not an abstraction"in + if v = v0 then tm else + if type_of v = type_of v0 & not (vfree_in v bod) then + mk_abs(v,vsubst[v,v0]bod) + else failwith "alpha: Invalid new variable";; + +(* ------------------------------------------------------------------------- *) +(* Type matching. *) +(* ------------------------------------------------------------------------- *) + +let rec type_match vty cty sofar = + if is_vartype vty then + try if rev_assoc vty sofar = cty then sofar else failwith "type_match" + with Failure "find" -> (cty,vty)::sofar + else + let vop,vargs = dest_type vty and cop,cargs = dest_type cty in + if vop = cop then itlist2 type_match vargs cargs sofar + else failwith "type_match";; + +(* ------------------------------------------------------------------------- *) +(* Conventional matching version of mk_const (but with a sanity test). *) +(* ------------------------------------------------------------------------- *) + +let mk_mconst(c,ty) = + try let uty = get_const_type c in + let mat = type_match uty ty [] in + let con = mk_const(c,mat) in + if type_of con = ty then con else fail() + with Failure _ -> failwith "mk_const: generic type cannot be instantiated";; + +(* ------------------------------------------------------------------------- *) +(* Like mk_comb, but instantiates type variables in rator if necessary. *) +(* ------------------------------------------------------------------------- *) + +let mk_icomb(tm1,tm2) = + let "fun",[ty;_] = dest_type (type_of tm1) in + let tyins = type_match ty (type_of tm2) [] in + mk_comb(inst tyins tm1,tm2);; + +(* ------------------------------------------------------------------------- *) +(* Instantiates types for constant c and iteratively makes combination. *) +(* ------------------------------------------------------------------------- *) + +let list_mk_icomb cname args = + let atys,_ = nsplit dest_fun_ty args (get_const_type cname) in + let tyin = itlist2 (fun g a -> type_match g (type_of a)) atys args [] in + list_mk_comb(mk_const(cname,tyin),args);; + +(* ------------------------------------------------------------------------- *) +(* Free variables in assumption list and conclusion of a theorem. *) +(* ------------------------------------------------------------------------- *) + +let thm_frees th = + let asl,c = dest_thm th in + itlist (union o frees) asl (frees c);; + +(* ------------------------------------------------------------------------- *) +(* Is one term free in another? *) +(* ------------------------------------------------------------------------- *) + +let rec free_in tm1 tm2 = + if aconv tm1 tm2 then true + else if is_comb tm2 then + let l,r = dest_comb tm2 in free_in tm1 l or free_in tm1 r + else if is_abs tm2 then + let bv,bod = dest_abs tm2 in + not (vfree_in bv tm1) & free_in tm1 bod + else false;; + +(* ------------------------------------------------------------------------- *) +(* Searching for terms. *) +(* ------------------------------------------------------------------------- *) + +let rec find_term p tm = + if p tm then tm else + if is_abs tm then find_term p (body tm) else + if is_comb tm then + let l,r = dest_comb tm in + try find_term p l with Failure _ -> find_term p r + else failwith "find_term";; + +let find_terms = + let rec accum tl p tm = + let tl' = if p tm then insert tm tl else tl in + if is_abs tm then + accum tl' p (body tm) + else if is_comb tm then + accum (accum tl' p (rator tm)) p (rand tm) + else tl' in + accum [];; + +(* ------------------------------------------------------------------------- *) +(* General syntax for binders. *) +(* *) +(* NB! The "mk_binder" function expects polytype "A", which is the domain. *) +(* ------------------------------------------------------------------------- *) + +let is_binder s tm = + match tm with + Comb(Const(s',_),Abs(_,_)) -> s' = s + | _ -> false;; + +let dest_binder s tm = + match tm with + Comb(Const(s',_),Abs(x,t)) when s' = s -> (x,t) + | _ -> failwith "dest_binder";; + +let mk_binder op = + let c = mk_const(op,[]) in + fun (v,tm) -> mk_comb(inst [type_of v,aty] c,mk_abs(v,tm));; + +(* ------------------------------------------------------------------------- *) +(* Syntax for binary operators. *) +(* ------------------------------------------------------------------------- *) + +let is_binop op tm = + match tm with + Comb(Comb(op',_),_) -> op' = op + | _ -> false;; + +let dest_binop op tm = + match tm with + Comb(Comb(op',l),r) when op' = op -> (l,r) + | _ -> failwith "dest_binop";; + +let mk_binop op tm1 = + let f = mk_comb(op,tm1) in + fun tm2 -> mk_comb(f,tm2);; + +let list_mk_binop op = end_itlist (mk_binop op);; + +let binops op = striplist (dest_binop op);; + +(* ------------------------------------------------------------------------- *) +(* Some common special cases *) +(* ------------------------------------------------------------------------- *) + +let is_conj = is_binary "/\\";; +let dest_conj = dest_binary "/\\";; +let conjuncts = striplist dest_conj;; + +let is_imp = is_binary "==>";; +let dest_imp = dest_binary "==>";; + +let is_forall = is_binder "!";; +let dest_forall = dest_binder "!";; +let strip_forall = splitlist dest_forall;; + +let is_exists = is_binder "?";; +let dest_exists = dest_binder "?";; +let strip_exists = splitlist dest_exists;; + +let is_disj = is_binary "\\/";; +let dest_disj = dest_binary "\\/";; +let disjuncts = striplist dest_disj;; + +let is_neg tm = + try fst(dest_const(rator tm)) = "~" + with Failure _ -> false;; + +let dest_neg tm = + try let n,p = dest_comb tm in + if fst(dest_const n) = "~" then p else fail() + with Failure _ -> failwith "dest_neg";; + +let is_uexists = is_binder "?!";; +let dest_uexists = dest_binder "?!";; + +let dest_cons = dest_binary "CONS";; +let is_cons = is_binary "CONS";; +let dest_list tm = + try let tms,nil = splitlist dest_cons tm in + if fst(dest_const nil) = "NIL" then tms else fail() + with Failure _ -> failwith "dest_list";; +let is_list = can dest_list;; + +(* ------------------------------------------------------------------------- *) +(* Syntax for numerals. *) +(* ------------------------------------------------------------------------- *) + +let dest_numeral = + let rec dest_num tm = + if try fst(dest_const tm) = "_0" with Failure _ -> false then num_0 else + let l,r = dest_comb tm in + let n = num_2 */ dest_num r in + let cn = fst(dest_const l) in + if cn = "BIT0" then n + else if cn = "BIT1" then n +/ num_1 + else fail() in + fun tm -> try let l,r = dest_comb tm in + if fst(dest_const l) = "NUMERAL" then dest_num r else fail() + with Failure _ -> failwith "dest_numeral";; + +(* ------------------------------------------------------------------------- *) +(* Syntax for generalized abstractions. *) +(* *) +(* These are here because they are used by the preterm->term translator; *) +(* preterms regard generalized abstractions as an atomic notion. This is *) +(* slightly unclean --- for example we need locally some operations on *) +(* universal quantifiers --- but probably simplest. It has to go somewhere! *) +(* ------------------------------------------------------------------------- *) + +let dest_gabs = + let dest_geq = dest_binary "GEQ" in + fun tm -> + try if is_abs tm then dest_abs tm else + let l,r = dest_comb tm in + if not (fst(dest_const l) = "GABS") then fail() else + let ltm,rtm = dest_geq(snd(strip_forall(body r))) in + rand ltm,rtm + with Failure _ -> failwith "dest_gabs: Not a generalized abstraction";; + +let is_gabs = can dest_gabs;; + +let mk_gabs = + let mk_forall(v,t) = + let cop = mk_const("!",[type_of v,aty]) in + mk_comb(cop,mk_abs(v,t)) in + let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in + let mk_geq(t1,t2) = + let p = mk_const("GEQ",[type_of t1,aty]) in + mk_comb(mk_comb(p,t1),t2) in + fun (tm1,tm2) -> + if is_var tm1 then mk_abs(tm1,tm2) else + let fvs = frees tm1 in + let fty = mk_fun_ty (type_of tm1) (type_of tm2) in + let f = variant (frees tm1 @ frees tm2) (mk_var("f",fty)) in + let bod = mk_abs(f,list_mk_forall(fvs,mk_geq(mk_comb(f,tm1),tm2))) in + mk_comb(mk_const("GABS",[fty,aty]),bod);; + +let list_mk_gabs(vs,bod) = itlist (curry mk_gabs) vs bod;; + +let strip_gabs = splitlist dest_gabs;; + +(* ------------------------------------------------------------------------- *) +(* Syntax for let terms. *) +(* ------------------------------------------------------------------------- *) + +let dest_let tm = + try let l,aargs = strip_comb tm in + if fst(dest_const l) <> "LET" then fail() else + let vars,lebod = strip_gabs (hd aargs) in + let eqs = zip vars (tl aargs) in + let le,bod = dest_comb lebod in + if fst(dest_const le) = "LET_END" then eqs,bod else fail() + with Failure _ -> failwith "dest_let: not a let-term";; + +let is_let = can dest_let;; + +let mk_let(assigs,bod) = + let lefts,rights = unzip assigs in + let lend = mk_comb(mk_const("LET_END",[type_of bod,aty]),bod) in + let lbod = list_mk_gabs(lefts,lend) in + let ty1,ty2 = dest_fun_ty(type_of lbod) in + let ltm = mk_const("LET",[ty1,aty; ty2,bty]) in + list_mk_comb(ltm,lbod::rights);; + +(* ------------------------------------------------------------------------- *) +(* Useful function to create stylized arguments using numbers. *) +(* ------------------------------------------------------------------------- *) + +let make_args = + let rec margs n s avoid tys = + if tys = [] then [] else + let v = variant avoid (mk_var(s^(string_of_int n),hd tys)) in + v::(margs (n + 1) s (v::avoid) (tl tys)) in + fun s avoid tys -> + if length tys = 1 then + [variant avoid (mk_var(s,hd tys))] + else + margs 0 s avoid tys;; + +(* ------------------------------------------------------------------------- *) +(* Director strings down a term. *) +(* ------------------------------------------------------------------------- *) + +let find_path = + let rec find_path p tm = + if p tm then [] else + if is_abs tm then "b"::(find_path p (body tm)) else + try "r"::(find_path p (rand tm)) + with Failure _ -> "l"::(find_path p (rator tm)) in + fun p tm -> implode(find_path p tm);; + +let follow_path = + let rec follow_path s tm = + match s with + [] -> tm + | "l"::t -> follow_path t (rator tm) + | "r"::t -> follow_path t (rand tm) + | _::t -> follow_path t (body tm) in + fun s tm -> follow_path (explode s) tm;; diff --git a/Proofrecording/diffs/bool.ml b/Proofrecording/diffs/bool.ml new file mode 100644 index 0000000..46b649b --- /dev/null +++ b/Proofrecording/diffs/bool.ml @@ -0,0 +1,451 @@ +(* ========================================================================= *) +(* Boolean theory including (intuitionistic) defs of logical connectives. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2006 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Set up parse status of basic and derived logical constants. *) +(* ------------------------------------------------------------------------- *) + +parse_as_prefix "~";; + +map parse_as_binder ["\\"; "!"; "?"; "?!"];; + +map parse_as_infix ["==>",(4,"right"); "\\/",(6,"right"); "/\\",(8,"right")];; + +(* ------------------------------------------------------------------------- *) +(* Set up more orthodox notation for equations and equivalence. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("<=>",(2,"right"));; +override_interface ("<=>",`(=):bool->bool->bool`);; +parse_as_infix("=",(12,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Special syntax for Boolean equations (IFF). *) +(* ------------------------------------------------------------------------- *) + +let is_iff tm = + match tm with + Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> true + | _ -> false;; + +let dest_iff tm = + match tm with + Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> (l,r) + | _ -> failwith "dest_iff";; + +let mk_iff = + let eq_tm = `(<=>)` in + fun (l,r) -> mk_comb(mk_comb(eq_tm,l),r);; + +(* ------------------------------------------------------------------------- *) +(* Rule allowing easy instantiation of polymorphic proformas. *) +(* ------------------------------------------------------------------------- *) + +let PINST tyin tmin = + let iterm_fn = INST (map (I F_F (inst tyin)) tmin) + and itype_fn = INST_TYPE tyin in + fun th -> try iterm_fn (itype_fn th) + with Failure _ -> failwith "PINST";; + +(* ------------------------------------------------------------------------- *) +(* Useful derived deductive rule. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_HYP ath bth = + if exists (aconv (concl ath)) (hyp bth) + then EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath + else bth;; + +(* ------------------------------------------------------------------------- *) +(* Rules for T *) +(* ------------------------------------------------------------------------- *) + +let T_DEF = new_basic_definition + `T = ((\p:bool. p) = (\p:bool. p))`;; + +let TRUTH = EQ_MP (SYM T_DEF) (REFL `\p:bool. p`);; + +let EQT_ELIM th = + try EQ_MP (SYM th) TRUTH + with Failure _ -> failwith "EQT_ELIM";; + +let EQT_INTRO = + let t = `t:bool` and T = `T` in + let pth = + let th1 = DEDUCT_ANTISYM_RULE (ASSUME t) TRUTH in + let th2 = EQT_ELIM(ASSUME(concl th1)) in + DEDUCT_ANTISYM_RULE th2 th1 in + fun th -> EQ_MP (INST[concl th,t] pth) th;; + +(* ------------------------------------------------------------------------- *) +(* Rules for /\ *) +(* ------------------------------------------------------------------------- *) + +let AND_DEF = new_basic_definition + `(/\) = \p q. (\f:bool->bool->bool. f p q) = (\f. f T T)`;; + +let mk_conj = mk_binary "/\\";; +let list_mk_conj = end_itlist (curry mk_conj);; + +let CONJ = + let f = `f:bool->bool->bool` + and p = `p:bool` + and q = `q:bool` in + let pth = + let pth = ASSUME p + and qth = ASSUME q in + let th1 = MK_COMB(AP_TERM f (EQT_INTRO pth),EQT_INTRO qth) in + let th2 = ABS f th1 in + let th3 = BETA_RULE (AP_THM (AP_THM AND_DEF p) q) in + EQ_MP (SYM th3) th2 in + fun th1 th2 -> substitute_proof ( + let th = INST [concl th1,p; concl th2,q] pth in + PROVE_HYP th2 (PROVE_HYP th1 th)) + (proof_CONJ (proof_of th1) (proof_of th2));; + +let CONJUNCT1 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = EQ_MP th2 (ASSUME `P /\ Q`) in + EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). p`)) in + fun th -> substitute_proof ( + try let l,r = dest_conj(concl th) in + PROVE_HYP th (INST [l,P; r,Q] pth) + with Failure _ -> failwith "CONJUNCT1") (proof_CONJUNCT1 (proof_of th));; + +let CONJUNCT2 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = EQ_MP th2 (ASSUME `P /\ Q`) in + EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). q`)) in + fun th -> substitute_proof ( + try let l,r = dest_conj(concl th) in + PROVE_HYP th (INST [l,P; r,Q] pth) + with Failure _ -> failwith "CONJUNCT2") (proof_CONJUNCT2 (proof_of th));; + +let CONJ_PAIR th = + try CONJUNCT1 th,CONJUNCT2 th + with Failure _ -> failwith "CONJ_PAIR: Not a conjunction";; + +let CONJUNCTS = striplist CONJ_PAIR;; + +(* ------------------------------------------------------------------------- *) +(* Rules for ==> *) +(* ------------------------------------------------------------------------- *) + +let IMP_DEF = new_basic_definition + `(==>) = \p q. p /\ q <=> p`;; + +let mk_imp = mk_binary "==>";; + +let MP = + let p = `p:bool` + and q = `q:bool` in + let pth = + let th1 = BETA_RULE (AP_THM (AP_THM IMP_DEF p) q) in + let th2 = EQ_MP th1 (ASSUME `p ==> q`) in + CONJUNCT2 (EQ_MP (SYM th2) (ASSUME `p:bool`)) in + fun ith th -> + let ant,con = dest_imp (concl ith) in + if aconv ant (concl th) then + PROVE_HYP th (PROVE_HYP ith (INST [ant,p; con,q] pth)) + else failwith "MP: theorems do not agree";; + +let DISCH = + let p = `p:bool` + and q = `q:bool` in + let pth = SYM(BETA_RULE (AP_THM (AP_THM IMP_DEF p) q)) in + fun a th -> substitute_proof ( + let th1 = CONJ (ASSUME a) th in + let th2 = CONJUNCT1 (ASSUME (concl th1)) in + let th3 = DEDUCT_ANTISYM_RULE th1 th2 in + let th4 = INST [a,p; concl th,q] pth in + EQ_MP th4 th3) (proof_DISCH (proof_of th) a);; + +let rec DISCH_ALL th = + try DISCH_ALL (DISCH (hd (hyp th)) th) + with Failure _ -> th;; + +let UNDISCH th = + try MP th (ASSUME(rand(rator(concl th)))) + with Failure _ -> failwith "UNDISCH";; + +let rec UNDISCH_ALL th = + if is_imp (concl th) then UNDISCH_ALL (UNDISCH th) + else th;; + +let IMP_ANTISYM_RULE th1 th2 = + substitute_proof (DEDUCT_ANTISYM_RULE (UNDISCH th2) (UNDISCH th1)) + (proof_IMPAS (proof_of th2) (proof_of th1));; + +let ADD_ASSUM tm th = MP (DISCH tm th) (ASSUME tm);; + +let EQ_IMP_RULE th = + try let l,r = dest_eq(concl th) in + DISCH l (EQ_MP th (ASSUME l)), DISCH r (EQ_MP(SYM th)(ASSUME r)) + with Failure _ -> failwith "EQ_IMP_RULE";; + +let IMP_TRANS th1 th2 = + try let ant = rand(rator(concl th1)) in + DISCH ant (MP th2 (MP th1 (ASSUME ant))) + with Failure _ -> failwith "IMP_TRANS";; + +(* ------------------------------------------------------------------------- *) +(* Rules for ! *) +(* ------------------------------------------------------------------------- *) + +let FORALL_DEF = new_basic_definition + `(!) = \P:A->bool. P = \x. T`;; + +let mk_forall = mk_binder "!";; +let list_mk_forall(vs,bod) = itlist (curry mk_forall) vs bod;; + +let SPEC = + let P = `P:A->bool` + and x = `x:A` in + let pth = + let th1 = EQ_MP(AP_THM FORALL_DEF `P:A->bool`) (ASSUME `(!)(P:A->bool)`) in + let th2 = AP_THM (CONV_RULE BETA_CONV th1) `x:A` in + let th3 = CONV_RULE (RAND_CONV BETA_CONV) th2 in + DISCH_ALL (EQT_ELIM th3) in + fun tm th -> + (substitute_proof (try let abs = rand(concl th) in + CONV_RULE BETA_CONV + (MP (PINST [snd(dest_var(bndvar abs)),aty] [abs,P; tm,x] pth) th) + with Failure _ -> failwith "SPEC") (proof_SPEC tm (proof_of th)));; + +let SPECL tms th = + try rev_itlist SPEC tms th + with Failure _ -> failwith "SPECL";; + +let SPEC_VAR th = + let bv = variant (thm_frees th) (bndvar(rand(concl th))) in + bv,SPEC bv th;; + +let rec SPEC_ALL th = + if is_forall(concl th) then SPEC_ALL(snd(SPEC_VAR th)) else th;; + +let ISPEC t th = + let x,_ = try dest_forall(concl th) with Failure _ -> + failwith "ISPEC: input theorem not universally quantified" in + let tyins = try type_match (snd(dest_var x)) (type_of t) [] with Failure _ -> + failwith "ISPEC can't type-instantiate input theorem" in + try SPEC t (INST_TYPE tyins th) + with Failure _ -> failwith "ISPEC: type variable(s) free in assumptions";; + +let ISPECL tms th = + try if tms = [] then th else + let avs = fst (chop_list (length tms) (fst(strip_forall(concl th)))) in + let tyins = itlist2 type_match (map (snd o dest_var) avs) + (map type_of tms) [] in + SPECL tms (INST_TYPE tyins th) + with Failure _ -> failwith "ISPECL";; + +let GEN = + let P = `P:A->bool` and true_tm = `T` in + let pth = + let th1 = ASSUME `P = \x:A. T` in + let th2 = AP_THM FORALL_DEF `P:A->bool` in + DISCH_ALL (EQ_MP (SYM(CONV_RULE(RAND_CONV BETA_CONV) th2)) th1) in + fun x th -> substitute_proof ( + try let th1 = ABS x (EQT_INTRO th) in + let tm1 = mk_abs(mk_var("x",type_of x),true_tm) in + let th2 = TRANS th1 (REFL tm1) in + let th3 = PINST [snd(dest_var x),aty] [rand(rator(concl th1)),P] pth in + MP th3 th2 + with Failure _ -> failwith "GEN") (proof_GEN (proof_of th) x);; + +let GENL = itlist GEN;; + +let GEN_ALL th = + let asl,c = dest_thm th in + let vars = subtract (frees c) (freesl asl) in + GENL vars th;; + +(* ------------------------------------------------------------------------- *) +(* Rules for ? *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_DEF = new_basic_definition + `(?) = \P:A->bool. !q. (!x. P x ==> q) ==> q`;; + +let mk_exists = mk_binder "?";; +let list_mk_exists(vs,bod) = itlist (curry mk_exists) vs bod;; + +let EXISTS = + let P = `P:A->bool` and x = `x:A` and PX = `(P:A->bool) x` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in + let th2 = SPEC `x:A` (ASSUME `!x:A. P x ==> Q`) in + let th3 = DISCH `!x:A. P x ==> Q` (MP th2 (ASSUME `(P:A->bool) x`)) in + DISCH_ALL (EQ_MP (SYM th1) (GEN `Q:bool` th3)) in + fun (etm,stm) th -> substitute_proof ( + try let qf,abs = dest_comb etm in + let bth = BETA_CONV(mk_comb(abs,stm)) in + let cth = PINST [type_of stm,aty] [abs,P; stm,x] pth in + MP cth (EQ_MP (SYM bth) th) + with Failure _ -> failwith "EXISTS") (proof_EXISTS etm stm (proof_of th));; + +let SIMPLE_EXISTS v th = + EXISTS (mk_exists(v,concl th),v) th;; + +let CHOOSE = + let P = `P:A->bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in + let th2 = SPEC `Q:bool` (UNDISCH(fst(EQ_IMP_RULE th1))) in + DISCH_ALL (DISCH `(?) (P:A->bool)` (UNDISCH th2)) in + fun (v,th1) th2 -> substitute_proof ( + try let abs = rand(concl th1) in + let bv,bod = dest_abs abs in + let cmb = mk_comb(abs,v) in + let pat = vsubst[v,bv] bod in + let th3 = CONV_RULE BETA_CONV (ASSUME cmb) in + let th4 = GEN v (DISCH cmb (MP (DISCH pat th2) th3)) in + let th5 = PINST [snd(dest_var v),aty] [abs,P; concl th2,Q] pth in + MP (MP th5 th4) th1 + with Failure _ -> failwith "CHOOSE") + (proof_CHOOSE v (proof_of th1) (proof_of th2));; + +let SIMPLE_CHOOSE v th = + CHOOSE(v,ASSUME (mk_exists(v,hd(hyp th)))) th;; + +(* ------------------------------------------------------------------------- *) +(* Rules for \/ *) +(* ------------------------------------------------------------------------- *) + +let OR_DEF = new_basic_definition + `(\/) = \p q. !r. (p ==> r) ==> (q ==> r) ==> r`;; + +let mk_disj = mk_binary "\\/";; +let list_mk_disj = end_itlist (curry mk_disj);; + +let DISJ1 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = MP (ASSUME `P ==> t`) (ASSUME `P:bool`) in + let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in + DISCH_ALL (EQ_MP (SYM th2) th4) in + fun th tm -> substitute_proof ( + try MP (INST [concl th,P; tm,Q] pth) th + with Failure _ -> failwith "DISJ1") (proof_DISJ1 (proof_of th) tm);; + +let DISJ2 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = MP (ASSUME `Q ==> t`) (ASSUME `Q:bool`) in + let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in + DISCH_ALL (EQ_MP (SYM th2) th4) in + fun tm th -> substitute_proof ( + try MP (INST [tm,P; concl th,Q] pth) th + with Failure _ -> failwith "DISJ2") (proof_DISJ2 (proof_of th) tm);; + +let DISJ_CASES = + let P = `P:bool` and Q = `Q:bool` and R = `R:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = SPEC `R:bool` (EQ_MP th2 (ASSUME `P \/ Q`)) in + UNDISCH (UNDISCH th3) in + fun th0 th1 th2 -> substitute_proof ( + try let c1 = concl th1 and c2 = concl th2 in + if not (aconv c1 c2) then failwith "DISJ_CASES" else + let l,r = dest_disj (concl th0) in + let th = INST [l,P; r,Q; c1,R] pth in + PROVE_HYP (DISCH r th2) (PROVE_HYP (DISCH l th1) (PROVE_HYP th0 th)) + with Failure _ -> failwith "DISJ_CASES") + (proof_DISJCASES (proof_of th0) (proof_of th1) (proof_of th2));; + +let SIMPLE_DISJ_CASES th1 th2 = + DISJ_CASES (ASSUME(mk_disj(hd(hyp th1),hd(hyp th2)))) th1 th2;; + +(* ------------------------------------------------------------------------- *) +(* Rules for negation and falsity. *) +(* ------------------------------------------------------------------------- *) + +let F_DEF = new_basic_definition + `F = !p:bool. p`;; + +let NOT_DEF = new_basic_definition + `(~) = \p. p ==> F`;; + +let mk_neg = + let neg_tm = `(~)` in + fun tm -> try mk_comb(neg_tm,tm) + with Failure _ -> failwith "mk_neg";; + +let NOT_ELIM = + let P = `P:bool` in + let pth = CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P) in + fun th -> substitute_proof ( + try EQ_MP (INST [rand(concl th),P] pth) th + with Failure _ -> failwith "NOT_ELIM") (proof_NOTE (proof_of th));; + +let NOT_INTRO = + let P = `P:bool` in + let pth = SYM(CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P)) in + fun th -> substitute_proof ( + try EQ_MP (INST [rand(rator(concl th)),P] pth) th + with Failure _ -> failwith "NOT_ELIM") (proof_NOTI (proof_of th));; + +let EQF_INTRO = + let P = `P:bool` in + let pth = + let th1 = NOT_ELIM (ASSUME `~ P`) + and th2 = DISCH `F` (SPEC P (EQ_MP F_DEF (ASSUME `F`))) in + DISCH_ALL (IMP_ANTISYM_RULE th1 th2) in + fun th -> + try MP (INST [rand(concl th),P] pth) th + with Failure _ -> failwith "EQF_INTRO";; + +let EQF_ELIM = + let P = `P:bool` in + let pth = + let th1 = EQ_MP (ASSUME `P = F`) (ASSUME `P:bool`) in + let th2 = DISCH P (SPEC `F` (EQ_MP F_DEF th1)) in + DISCH_ALL (NOT_INTRO th2) in + fun th -> + try MP (INST [rand(rator(concl th)),P] pth) th + with Failure _ -> failwith "EQF_ELIM";; + +let CONTR = + let P = `P:bool` and f_tm = `F` in + let pth = SPEC P (EQ_MP F_DEF (ASSUME `F`)) in + fun tm th -> substitute_proof ( + if concl th <> f_tm then failwith "CONTR" + else PROVE_HYP th (INST [tm,P] pth)) (proof_CONTR (proof_of th) tm);; + +(* ------------------------------------------------------------------------- *) +(* Rules for unique existence. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_UNIQUE_DEF = new_basic_definition + `(?!) = \P:A->bool. ((?) P) /\ (!x y. P x /\ P y ==> x = y)`;; + +let mk_uexists = mk_binder "?!";; + +let EXISTENCE = + let P = `P:A->bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_UNIQUE_DEF P) in + let th2 = UNDISCH (fst(EQ_IMP_RULE th1)) in + DISCH_ALL (CONJUNCT1 th2) in + fun th -> + try let abs = rand(concl th) in + let ty = snd(dest_var(bndvar abs)) in + MP (PINST [ty,aty] [abs,P] pth) th + with Failure _ -> failwith "EXISTENCE";; diff --git a/Proofrecording/diffs/depgraph.ml b/Proofrecording/diffs/depgraph.ml new file mode 100644 index 0000000..b6a6ee6 --- /dev/null +++ b/Proofrecording/diffs/depgraph.ml @@ -0,0 +1,115 @@ +module Label = struct + + type t = string + + let compare = String.compare + + let hash s = + let n = String.length s in + let p = 9 in + if n >= p then + try + int_of_string (String.sub s p (n-p)) + with | Failure _ -> n + else + n + + let equal a b = a = b + +end + + +module Dep = struct + + include Graph.Imperative.Digraph.ConcreteBidirectional(Label) + + let graph_attributes _ = [] + + let default_vertex_attributes _ = [] + + let vertex_name v = V.label v + + let vertex_attributes _ = [] + + let get_subgraph _ = None + + let default_edge_attributes _ = [] + + let edge_attributes _ = [] + + let add_thm dep thm = add_vertex dep (V.create thm) + + let add_dep dep thm1 thm2 = + let v1 = V.create thm1 in + let v2 = V.create thm2 in + if ((mem_vertex dep v1) && (mem_vertex dep v2)) then + add_edge dep v1 v2 + + let min_max_moy_in_deg dep = + let max = ref 0 in + let lab_max = ref "" in + let min = ref 1073741823 in + let lab_min = ref "" in + let nb = ref 0 in + let sum = ref 0 in + let calc v = + let deg = in_degree dep v in + if deg < !min then ( + min := deg; + lab_min := V.label v + ); + if deg > !max then ( + max := deg; + lab_max := V.label v + ); + incr nb; + sum := !sum + deg in + iter_vertex calc dep; + let moy = (float_of_int !sum) /. (float_of_int !nb) in + (!min, !lab_min, !max, !lab_max, moy) + + let min_max_moy_out_deg dep = + let max = ref 0 in + let lab_max = ref "" in + let min = ref 1073741823 in + let lab_min = ref "" in + let nb = ref 0 in + let sum = ref 0 in + let calc v = + let deg = out_degree dep v in + if deg < !min then ( + min := deg; + lab_min := V.label v + ); + if deg > !max then ( + max := deg; + lab_max := V.label v + ); + incr nb; + sum := !sum + deg in + iter_vertex calc dep; + let moy = (float_of_int !sum) /. (float_of_int !nb) in + (!min, !lab_min, !max, !lab_max, moy) + +end + + +module Dep_top = struct + + include Graph.Topological.Make(Dep) + + let iter_top f dep = iter (fun v -> f (Dep.V.label v)) dep + +end + + +module Dep_dot = struct + + include Graph.Graphviz.Dot(Dep) + + let output_dot name dep = + let file = open_out name in + output_graph file dep; + close_out file + +end diff --git a/Proofrecording/diffs/equal.ml b/Proofrecording/diffs/equal.ml new file mode 100644 index 0000000..e54b686 --- /dev/null +++ b/Proofrecording/diffs/equal.ml @@ -0,0 +1,309 @@ +(* ========================================================================= *) +(* Basic equality reasoning including conversionals. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* ========================================================================= *) + +type conv = term->thm;; + +(* ------------------------------------------------------------------------- *) +(* A bit more syntax. *) +(* ------------------------------------------------------------------------- *) + +let lhand = rand o rator;; + +let lhs = fst o dest_eq;; + +let rhs = snd o dest_eq;; + +(* ------------------------------------------------------------------------- *) +(* Similar to variant, but even avoids constants, and ignores types. *) +(* ------------------------------------------------------------------------- *) + +let mk_primed_var = + let rec svariant avoid s = + if mem s avoid or (can get_const_type s & not(is_hidden s)) then + svariant avoid (s^"'") + else s in + fun avoid v -> + let s,ty = dest_var v in + let s' = svariant (mapfilter (fst o dest_var) avoid) s in + mk_var(s',ty);; + +(* ------------------------------------------------------------------------- *) +(* General case of beta-conversion. *) +(* ------------------------------------------------------------------------- *) + +let BETA_CONV tm = + try BETA tm with Failure _ -> + try let f,arg = dest_comb tm in + let v = bndvar f in + INST [arg,v] (BETA (mk_comb(f,v))) + with Failure _ -> failwith "BETA_CONV: Not a beta-redex";; + +(* ------------------------------------------------------------------------- *) +(* A few very basic derived equality rules. *) +(* ------------------------------------------------------------------------- *) + +let AP_TERM tm th = + try MK_COMB(REFL tm,th) + with Failure _ -> failwith "AP_TERM";; + +let AP_THM th tm = + try MK_COMB(th,REFL tm) + with Failure _ -> failwith "AP_THM";; + +let SYM th = + substitute_proof (let tm = concl th in + let l,r = dest_eq tm in + let lth = REFL l in + EQ_MP (MK_COMB(AP_TERM (rator (rator tm)) th,lth)) lth) (proof_SYM (proof_of th));; + +let ALPHA tm1 tm2 = + try TRANS (REFL tm1) (REFL tm2) + with Failure _ -> failwith "ALPHA";; + +let ALPHA_CONV v tm = + let res = alpha v tm in + ALPHA tm res;; + +let GEN_ALPHA_CONV v tm = + if is_abs tm then ALPHA_CONV v tm else + let b,abs = dest_comb tm in + AP_TERM b (ALPHA_CONV v abs);; + +let MK_BINOP op (lth,rth) = + MK_COMB(AP_TERM op lth,rth);; + +(* ------------------------------------------------------------------------- *) +(* Terminal conversion combinators. *) +(* ------------------------------------------------------------------------- *) + +let (NO_CONV:conv) = fun tm -> failwith "NO_CONV";; + +let (ALL_CONV:conv) = REFL;; + +(* ------------------------------------------------------------------------- *) +(* Combinators for sequencing, trying, repeating etc. conversions. *) +(* ------------------------------------------------------------------------- *) + +let ((THENC):conv -> conv -> conv) = + fun conv1 conv2 t -> + let th1 = conv1 t in + let th2 = conv2 (rand(concl th1)) in + TRANS th1 th2;; + +let ((ORELSEC):conv -> conv -> conv) = + fun conv1 conv2 t -> + try conv1 t with Failure _ -> conv2 t;; + +let (FIRST_CONV:conv list -> conv) = end_itlist (fun c1 c2 -> c1 ORELSEC c2);; + +let (EVERY_CONV:conv list -> conv) = + fun l -> itlist (fun c1 c2 -> c1 THENC c2) l ALL_CONV;; + +let REPEATC = + let rec REPEATC conv t = + ((conv THENC (REPEATC conv)) ORELSEC ALL_CONV) t in + (REPEATC:conv->conv);; + +let (CHANGED_CONV:conv->conv) = + fun conv tm -> + let th = conv tm in + let l,r = dest_eq (concl th) in + if aconv l r then failwith "CHANGED_CONV" else th;; + +let TRY_CONV conv = conv ORELSEC ALL_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Subterm conversions. *) +(* ------------------------------------------------------------------------- *) + +let (RATOR_CONV:conv->conv) = + fun conv tm -> + let l,r = dest_comb tm in AP_THM (conv l) r;; + +let (RAND_CONV:conv->conv) = + fun conv tm -> + let l,r = dest_comb tm in AP_TERM l (conv r);; + +let LAND_CONV = RATOR_CONV o RAND_CONV;; + +let (COMB2_CONV: conv->conv->conv) = + fun lconv rconv tm -> let l,r = dest_comb tm in MK_COMB(lconv l,rconv r);; + +let COMB_CONV = W COMB2_CONV;; + +let (ABS_CONV:conv->conv) = + fun conv tm -> + let v,bod = dest_abs tm in + let th = conv bod in + try ABS v th with Failure _ -> + let gv = genvar(type_of v) in + let gbod = vsubst[gv,v] bod in + let gth = ABS gv (conv gbod) in + let gtm = concl gth in + let l,r = dest_eq gtm in + let v' = variant (frees gtm) v in + let l' = alpha v' l and r' = alpha v' r in + EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth;; + +let BINDER_CONV conv tm = + try ABS_CONV conv tm + with Failure _ -> RAND_CONV(ABS_CONV conv) tm;; + +let SUB_CONV = + fun conv -> (COMB_CONV conv) ORELSEC (ABS_CONV conv) ORELSEC REFL;; + +let BINOP_CONV conv tm = + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + MK_COMB(AP_TERM op (conv l),conv r);; + +(* ------------------------------------------------------------------------- *) +(* Depth conversions; internal use of a failure-propagating `Boultonized' *) +(* version to avoid a great deal of reuilding of terms. *) +(* ------------------------------------------------------------------------- *) + +let (ONCE_DEPTH_CONV: conv->conv), + (DEPTH_CONV: conv->conv), + (REDEPTH_CONV: conv->conv), + (TOP_DEPTH_CONV: conv->conv), + (TOP_SWEEP_CONV: conv->conv) = + let THENQC conv1 conv2 tm = + try let th1 = conv1 tm in + try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 + with Failure _ -> th1 + with Failure _ -> conv2 tm + and THENCQC conv1 conv2 tm = + let th1 = conv1 tm in + try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 + with Failure _ -> th1 + and COMB_QCONV conv tm = + let l,r = dest_comb tm in + try let th1 = conv l in + try let th2 = conv r in MK_COMB(th1,th2) + with Failure _ -> AP_THM th1 r + with Failure _ -> AP_TERM l (conv r) in + let rec REPEATQC conv tm = THENCQC conv (REPEATQC conv) tm in + let SUB_QCONV conv tm = + if is_abs tm then ABS_CONV conv tm + else COMB_QCONV conv tm in + let rec ONCE_DEPTH_QCONV conv tm = + (conv ORELSEC (SUB_QCONV (ONCE_DEPTH_QCONV conv))) tm + and DEPTH_QCONV conv tm = + THENQC (SUB_QCONV (DEPTH_QCONV conv)) + (REPEATQC conv) tm + and REDEPTH_QCONV conv tm = + THENQC (SUB_QCONV (REDEPTH_QCONV conv)) + (THENCQC conv (REDEPTH_QCONV conv)) tm + and TOP_DEPTH_QCONV conv tm = + THENQC (REPEATQC conv) + (THENCQC (SUB_QCONV (TOP_DEPTH_QCONV conv)) + (THENCQC conv (TOP_DEPTH_QCONV conv))) tm + and TOP_SWEEP_QCONV conv tm = + THENQC (REPEATQC conv) + (SUB_QCONV (TOP_SWEEP_QCONV conv)) tm in + (fun c -> TRY_CONV (ONCE_DEPTH_QCONV c)), + (fun c -> TRY_CONV (DEPTH_QCONV c)), + (fun c -> TRY_CONV (REDEPTH_QCONV c)), + (fun c -> TRY_CONV (TOP_DEPTH_QCONV c)), + (fun c -> TRY_CONV (TOP_SWEEP_QCONV c));; + +(* ------------------------------------------------------------------------- *) +(* Apply at leaves of op-tree; NB any failures at leaves cause failure. *) +(* ------------------------------------------------------------------------- *) + +let rec DEPTH_BINOP_CONV op conv tm = + try let l,r = dest_binop op tm in + let lth = DEPTH_BINOP_CONV op conv l + and rth = DEPTH_BINOP_CONV op conv r in + MK_COMB(AP_TERM op lth,rth) + with Failure "dest_binop" -> conv tm;; + +(* ------------------------------------------------------------------------- *) +(* Follow a path. *) +(* ------------------------------------------------------------------------- *) + +let PATH_CONV = + let rec path_conv s cnv = + match s with + [] -> cnv + | "l"::t -> RATOR_CONV (path_conv t cnv) + | "r"::t -> RAND_CONV (path_conv t cnv) + | _::t -> ABS_CONV (path_conv t cnv) in + fun s cnv -> path_conv (explode s) cnv;; + +(* ------------------------------------------------------------------------- *) +(* Follow a pattern *) +(* ------------------------------------------------------------------------- *) + +let PAT_CONV = + let rec PCONV xs pat conv = + if mem pat xs then conv + else if not(exists (fun x -> free_in x pat) xs) then ALL_CONV + else if is_comb pat then + COMB2_CONV (PCONV xs (rator pat) conv) (PCONV xs (rand pat) conv) + else + ABS_CONV (PCONV xs (body pat) conv) in + fun pat -> let xs,pbod = strip_abs pat in PCONV xs pbod;; + +(* ------------------------------------------------------------------------- *) +(* Symmetry conversion. *) +(* ------------------------------------------------------------------------- *) + +let SYM_CONV tm = + try let th1 = SYM(ASSUME tm) in + let tm' = concl th1 in + let th2 = SYM(ASSUME tm') in + DEDUCT_ANTISYM_RULE th2 th1 + with Failure _ -> failwith "SYM_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Conversion to a rule. *) +(* ------------------------------------------------------------------------- *) + +let CONV_RULE (conv:conv) th = + EQ_MP (conv(concl th)) th;; + +(* ------------------------------------------------------------------------- *) +(* Substitution conversion. *) +(* ------------------------------------------------------------------------- *) + +let SUBS_CONV ths tm = + try if ths = [] then REFL tm else + let lefts = map (lhand o concl) ths in + let gvs = map (genvar o type_of) lefts in + let pat = subst (zip gvs lefts) tm in + let abs = list_mk_abs(gvs,pat) in + let th = rev_itlist + (fun y x -> CONV_RULE (RAND_CONV BETA_CONV THENC LAND_CONV BETA_CONV) + (MK_COMB(x,y))) ths (REFL abs) in + if rand(concl th) = tm then REFL tm else th + with Failure _ -> failwith "SUBS_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Get a few rules. *) +(* ------------------------------------------------------------------------- *) + +let BETA_RULE = CONV_RULE(REDEPTH_CONV BETA_CONV);; + +let GSYM = CONV_RULE(ONCE_DEPTH_CONV SYM_CONV);; + +let SUBS ths = CONV_RULE (SUBS_CONV ths);; + +(* ------------------------------------------------------------------------- *) +(* A cacher for conversions. *) +(* ------------------------------------------------------------------------- *) + +let CACHE_CONV = + let ALPHA_HACK tm th = + let tm' = lhand(concl th) in + if tm' = tm then th else TRANS (ALPHA tm tm') th in + fun conv -> + let net = ref empty_net in + fun tm -> try tryfind (ALPHA_HACK tm) (lookup tm (!net)) + with Failure _ -> + let th = conv tm in (net := enter [] (tm,th) (!net); th);; diff --git a/Proofrecording/diffs/hol.ml b/Proofrecording/diffs/hol.ml new file mode 100644 index 0000000..1e2f438 --- /dev/null +++ b/Proofrecording/diffs/hol.ml @@ -0,0 +1,163 @@ +(* ========================================================================= *) +(* HOL LIGHT *) +(* *) +(* Modern OCaml version of the HOL theorem prover *) +(* *) +(* John Harrison *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +let hol_version = "2.20++";; + +let hol_dir = ref + (try Sys.getenv "HOLLIGHT_DIR" with Not_found -> Sys.getcwd());; + +(* ------------------------------------------------------------------------- *) +(* Should eventually change to "ref(Filename.temp_dir_name)". *) +(* However that's not available in 3.08, which is still the default *) +(* in Cygwin, and I don't want to force people to upgrade Ocaml. *) +(* ------------------------------------------------------------------------- *) + +let temp_path = ref "/tmp";; + +(* ------------------------------------------------------------------------- *) +(* Load in parsing extensions. *) +(* For Ocaml < 3.10, use the built-in camlp4 *) +(* and for Ocaml >= 3.10, use camlp5 instead. *) +(* ------------------------------------------------------------------------- *) + +if let v = String.sub Sys.ocaml_version 0 4 in + v = "3.10" or v = "3.11" +then (Topdirs.dir_directory "+camlp5"; + Topdirs.dir_load Format.std_formatter "camlp5o.cma") +else (Topdirs.dir_load Format.std_formatter "camlp4o.cma");; + +Topdirs.dir_load Format.std_formatter (Filename.concat (!hol_dir) "pa_j.cmo");; + +(* ------------------------------------------------------------------------- *) +(* Load files from system and/or user-settable directories. *) +(* Paths map initial "$/" to !hol_dir dynamically; use $$ to get the actual *) +(* $ character at the start of a directory. *) +(* ------------------------------------------------------------------------- *) + +let use_file s = + if Toploop.use_file Format.std_formatter s then () + else (Format.print_string("Error in included file "^s); + Format.print_newline());; + +let hol_expand_directory s = + if s = "$" or s = "$/" then !hol_dir + else if s = "$$" then "$" + else if String.length s <= 2 then s + else if String.sub s 0 2 = "$$" then (String.sub s 1 (String.length s - 1)) + else if String.sub s 0 2 = "$/" + then Filename.concat (!hol_dir) (String.sub s 2 (String.length s - 2)) + else s;; + +let load_path = ref ["."; "$"];; + +let loaded_files = ref [];; + +let file_on_path p s = + if not (Filename.is_relative s) then s else + let p' = List.map hol_expand_directory p in + let d = List.find (fun d -> Sys.file_exists(Filename.concat d s)) p' in + Filename.concat (if d = "." then Sys.getcwd() else d) s;; + +let load_on_path p s = + let s' = file_on_path p s in + let fileid = (Filename.basename s',Digest.file s') in + (use_file s'; loaded_files := fileid::(!loaded_files));; + +let loads s = load_on_path ["$"] s;; + +let loadt s = load_on_path (!load_path) s;; + +let needs s = + let s' = file_on_path (!load_path) s in + let fileid = (Filename.basename s',Digest.file s') in + if List.mem fileid (!loaded_files) + then Format.print_string("File \""^s^"\" already loaded\n") else loadt s;; + +(* ------------------------------------------------------------------------- *) +(* Various tweaks to OCaml and general library functions. *) +(* ------------------------------------------------------------------------- *) + +loads "system.ml";; (* Set up proper parsing and load bignums *) +loads "lib.ml";; (* Various useful general library functions *) + +(* ------------------------------------------------------------------------- *) +(* The logical core. *) +(* ------------------------------------------------------------------------- *) + +loads "type.ml";; (* Abstract type of HOL types *) +loads "term.ml";; (* Abstract type of HOL terms *) +loads "proofobjects_init.ml";; (* Proof recording infrastructure *) +loads "thm.ml";; (* Abstract type of HOL theorems: deductive system! *) + +(* ------------------------------------------------------------------------- *) +(* Some extra support stuff needed outside the core. *) +(* ------------------------------------------------------------------------- *) + +loads "basics.ml";; (* Additional syntax operations and other utilities *) +loads "nets.ml";; (* Term nets for fast matchability-based lookup *) + +(* ------------------------------------------------------------------------- *) +(* The interface. *) +(* ------------------------------------------------------------------------- *) + +loads "preterm.ml";; (* Preterms and their interconversion with terms *) +loads "parser.ml";; (* Lexer and parser *) +loads "printer.ml";; (* Crude prettyprinter *) + +(* ------------------------------------------------------------------------- *) +(* Higher level deductive system. *) +(* ------------------------------------------------------------------------- *) + +loads "equal.ml";; (* Basic equality reasoning and conversionals *) +loads "bool.ml";; (* Boolean theory and basic derived rules *) +loads "drule.ml";; (* Additional derived rules *) +loads "tactics.ml";; (* Tactics, tacticals and goal stack *) +loads "itab.ml";; (* Toy prover for intuitionistic logic *) +loads "simp.ml";; (* Basic rewriting and simplification tools. *) +loads "theorems.ml";; (* Additional theorems (mainly for quantifiers) etc. *) +loads "ind_defs.ml";; (* Derived rules for inductive definitions *) +loads "class.ml";; (* Classical reasoning: Choice and Extensionality *) +loads "trivia.ml";; (* Some very basic theories, e.g. type ":1" *) +loads "canon.ml";; (* Tools for putting terms in canonical forms *) +loads "meson.ml";; (* First order automation: MESON (model elimination) *) +loads "quot.ml";; (* Derived rules for defining quotient types *) +loads "recursion.ml";; (* Tools for primitive recursion on inductive types *) + +(* ------------------------------------------------------------------------- *) +(* Mathematical theories and additional proof tools. *) +(* ------------------------------------------------------------------------- *) + +loads "pair.ml";; (* Theory of pairs *) +loads "nums.ml";; (* Axiom of Infinity, definition of natural numbers *) +loads "arith.ml";; (* Natural number arithmetic *) +loads "wf.ml";; (* Theory of wellfounded relations *) +loads "calc_num.ml";; (* Calculation with natural numbers *) +loads "normalizer.ml";; (* Polynomial normalizer for rings and semirings *) +loads "grobner.ml";; (* Groebner basis procedure for most semirings. *) +loads "ind_types.ml";; (* Tools for defining inductive types *) +loads "lists.ml";; (* Theory of lists *) +loads "realax.ml";; (* Definition of real numbers *) +loads "calc_int.ml";; (* Calculation with integer-valued reals *) +loads "realarith.ml";; (* Universal linear real decision procedure *) +loads "real.ml";; (* Derived properties of reals *) +loads "calc_rat.ml";; (* Calculation with rational-valued reals *) +loads "int.ml";; (* Definition of integers *) +loads "sets.ml";; (* Basic set theory. *) +loads "iterate.ml"; (* Iterated operations *) +loads "cart.ml";; (* Finite Cartesian products *) +loads "define.ml";; (* Support for general recursive definitions *) + +(* ------------------------------------------------------------------------- *) +(* The help system. *) +(* ------------------------------------------------------------------------- *) + +loads "help.ml";; (* Online help using the entries in Help directory *) +loads "database.ml";; (* List of name-theorem pairs for search system *) diff --git a/Proofrecording/diffs/proofobjects_coq.ml b/Proofrecording/diffs/proofobjects_coq.ml new file mode 100644 index 0000000..ffc792a --- /dev/null +++ b/Proofrecording/diffs/proofobjects_coq.ml @@ -0,0 +1,1894 @@ +(* ======================================================================================== *) +(* Proof-objects for HOL-light, exportation to Coq *) +(* *) +(* Steven Obua, TU Mnchen, December 2004 *) +(* Chantal Keller, Laboratoire d'Informatique de Polytechnique (France), January 2010 *) +(* *) +(* based on Sebastian Skalberg's HOL4 proof-objects *) +(* ======================================================================================== *) + +#load "unix.cma";; +#load "depgraph.cma";; + + +module type Proofobject_primitives = + sig + + type proof + + val proof_REFL : term -> proof + val proof_TRANS : proof * proof -> proof + val proof_MK_COMB : proof * proof -> proof + val proof_ASSUME : term -> proof + val proof_EQ_MP : proof -> proof -> proof + val proof_IMPAS : proof -> proof -> proof + val proof_DISCH : proof -> term -> proof + val proof_DEDUCT_ANTISYM_RULE : proof * term -> proof * term -> proof + val proof_BETA : term -> proof + val proof_ABS : term -> proof -> proof + val proof_INST_TYPE : (hol_type * hol_type) list -> proof -> proof + val proof_INST : (term * term) list -> proof -> proof + val proof_new_definition : string -> hol_type -> term -> proof + val proof_CONJ : proof -> proof -> proof + val proof_CONJUNCT1 : proof -> proof + val proof_CONJUNCT2 : proof -> proof + val proof_new_basic_type_definition : + string -> string * string -> term * term -> proof -> proof + val proof_SPEC : term -> proof -> proof + val proof_SYM : proof -> proof + val proof_GEN : proof -> term -> proof + val proof_DISJ1 : proof -> term -> proof + val proof_DISJ2 : proof -> term -> proof + val proof_NOTI : proof -> proof + val proof_NOTE : proof -> proof + val proof_CONTR : proof -> term -> proof + val proof_DISJCASES : proof -> proof -> proof -> proof + val proof_CHOOSE : term -> proof -> proof -> proof + val proof_EXISTS : term -> term -> proof -> proof + + val new_axiom_name : string -> string + val proof_new_axiom : string -> term -> proof + + val save_proof : string -> proof -> (term option) -> unit + val proof_database : unit -> ((string * proof * (term option)) list) + + val export_saved_proofs : unit -> unit + val export_one_proof : string -> unit + val export_list : string list -> unit + end;; + + +module Proofobjects : Proofobject_primitives = struct + + + let THEORY_NAME = "hollight";; + + + + (****** Utilities ******) + + (* this is a little bit dangerous, because the function is not injective, + but I guess one can live with that *) + let modify = function + | "/" -> "_slash_" + | "\\" -> "_backslash_" + | "=" -> "_equal_" + | ">" -> "_greaterthan_" + | "<" -> "_lessthan_" + | "?" -> "_questionmark_" + | "!" -> "_exclamationmark_" + | "*" -> "_star_" + | "~" -> "_tilde_" + | "," -> "_comma_" + | "@" -> "_at_" + | "+" -> "_plus_" + | "-" -> "_minus_" + | "%" -> "_percent_" + | "$" -> "_dollar_" + | "." -> "_dot_" + | "'" -> "_quote_" + | "|" -> "_pipe_" + | ":" -> "_colon_" + | s -> s;; + + let mfc s = implode (map modify (explode s));; + + let ensure_export_directory thyname = + let dir = Sys.getenv "HOLPROOFEXPORTDIR" in + let dirsub = Filename.concat dir "hollight" in + let dirsubsub = Filename.concat dirsub thyname in + let mk d = if Sys.file_exists d then () else Unix.mkdir d 509 + in mk dir; mk dirsub; mk dirsubsub; dirsubsub;; + + + (****** Proofs ******) + + type proof_info_rec = + {disk_info: (string * string) option ref; + status: int ref; + references: int ref; + queued: bool ref};; + + type proof_info = Info of proof_info_rec;; + + type proof = + | Proof of (proof_info * proof_content * (unit -> unit)) + and proof_content = + | Prefl of term + | Pbeta of string * hol_type * term + | Pinstt of proof * (string * hol_type) list + | Pabs of proof * string * hol_type + | Pdisch of proof * term + | Phyp of term + | Pspec of proof * term + | Pinst of proof * (string * hol_type * term) list + | Pgen of proof * string * hol_type + | Psym of proof + | Ptrans of proof * proof + | Pcomb of proof * proof + | Peqmp of proof * proof + | Pexists of proof * term * term + | Pchoose of string * hol_type * proof * proof + | Pconj of proof * proof + | Pconjunct1 of proof + | Pconjunct2 of proof + | Pdisj1 of proof * term + | Pdisj2 of proof * term + | Pdisjcases of proof * proof * proof + | Pnoti of proof + | Pnote of proof + | Pcontr of proof * term + | Pimpas of proof * proof + | Paxm of string * term + | Pdef of string * hol_type * term + | Ptyintro of hol_type * string * hol_type list * string * string * term;; + + let content_of (Proof (_,p,_)) = p;; + + let inc_references (Proof(Info{references=r},_,_) as p) = incr r; p;; + + let mk_proof p = Proof(Info {disk_info = ref None; status = ref 0; references = ref 0; queued = ref false}, p, fun () -> ());; + + let global_ax_counter = let counter = ref 1 in let f = fun () -> (incr counter; !counter - 1) in f;; + + let new_axiom_name n = "ax_"^n^"_"^(string_of_int (global_ax_counter () ));; + + + (* corresponds to REFL *) + + let proof_REFL t = mk_proof (Prefl t);; + + + (* corresponds to TRANS, with a simple improvment *) + + let proof_TRANS (p,q) = + match (content_of p, content_of q) with + | (Prefl _,_) -> q + | (_, Prefl _) -> p + | _ -> mk_proof (Ptrans (inc_references p, inc_references q));; + + + (* corresponds to MK_COMB -> Pcomb *) + + let proof_MK_COMB (p1,p2) = + match (content_of p1, content_of p2) with + | (Prefl tm1, Prefl tm2) -> mk_proof (Prefl (mk_comb (tm1, tm2))) + | _ -> mk_proof (Pcomb (inc_references p1, inc_references p2));; + + + (* corresponds to ASSUME -> Phyp *) + + let proof_ASSUME t = mk_proof (Phyp t);; + + + (* corresponds to EQ_MP, with a simple improvment *) + + let proof_EQ_MP p q = + match content_of p with + | Prefl _ -> q + | _ -> mk_proof (Peqmp(inc_references p, inc_references q));; + + + (* corresponds to IMP_ANTISYM_RULE th1 th2 + not a base rule + used only in the extended mode *) + + (* A1 |- t1 ==> t2 A2 |- t2 ==> t1 *) + (* ------------------------------------- IMP_ANTISYM_RULE *) + (* A1 u A2 |- t1 <=> t2 *) + + let proof_IMPAS p1 p2 = mk_proof (Pimpas (inc_references p1, inc_references p2));; + + + (* corresponds to DISCH + not a base rule + used only in the extended mode *) + + (* A |- t *) + (* -------------------- DISCH `u` *) + (* A - {u} |- u ==> t *) + + let proof_DISCH p t = mk_proof (Pdisch(inc_references p, t));; + + + (* corresponds to DEDUCT_ANTISYM_RULE *) + (* made with IMPAS and DISCH (whereas in HOL-Light IMPAS is made with DAR and UNDISCH...) *) + + (* A |- p B |- q *) + (* ---------------------------------- *) + (* (A - {q}) u (B - {p}) |- p <=> q *) + + let proof_DEDUCT_ANTISYM_RULE (p1,t1) (p2,t2) = + proof_IMPAS (proof_DISCH p1 t2) (proof_DISCH p2 t1);; + + + (* BETA is a base rule *) + + let proof_BETA tm = + try + let f,_ = dest_comb tm in + let v,bod = dest_abs f in + let (x, ty) = dest_var v in + mk_proof (Pbeta (x, ty, bod)) + with + | _ -> failwith "proof_BETA" + + + (* corresponds to ABS, with a simple improvment *) + + let proof_ABS x p = + match x with + | Var(s, ty) -> + mk_proof (Pabs(inc_references p, s, ty)) + | _ -> failwith "proof_ABS: not a variable";; + + + (* corresponds to INST_TYPE -> Pinstt *) + + let proof_INST_TYPE s p = + mk_proof (Pinstt(inc_references p, List.map ( + fun (ty1, ty2) -> match ty2 with + | Tyvar s -> (s, ty1) + | _ -> failwith "proof_INST_TYPE: some redex is not a type variable" + ) s));; + + + (* corresponds to INST *) + + let proof_INST s p = + mk_proof (Pinst(inc_references p, List.map ( + fun (t1, t2) -> match t2 with + | Var(s, ty) -> + (s, ty, t1) + | _ -> failwith "proof_INST: some redex is not a term variable" + ) s));; + + + (* proof_new_definition is called in Thm.new_basic_definition. This + latter helps to define basic concepts such as T, AND... (almost + everything in Bool)... and to define derived rules!! -> Pdef *) + + let proof_new_definition cname ty t = + mk_proof (Pdef (cname, ty, t));; + + + (* proof_new_axiom is called in Thm.new_axiom. This latter transforms + a term of type bool into a theorem. The main three axioms are + ETA_AX, SELECT_AX and INFINITY_AX. The other axiom is ax (in + drule.ml) -> Paxm *) + + let proof_new_axiom axname t = mk_proof (Paxm (axname, t));; + + + (* corresponds to CONJ + not a base rule + used only in the extended mode *) + + let proof_CONJ p1 p2 = mk_proof (Pconj (inc_references p1, inc_references p2));; + + + (* corresponds to CONJUNCT1 + not a base rule + used only in the extended mode + also used in Thm.new_basic_definition *) + + let proof_CONJUNCT1 p = mk_proof (Pconjunct1 (inc_references p));; + + + (* corresponds to CONJUNCT2 + not a base rule + used only in the extended mode + also used in Thm.new_basic_definition *) + + let proof_CONJUNCT2 p = mk_proof (Pconjunct2 (inc_references p));; + + + (* used only in Thm.new_basic_definition for the same purpose as for + CONJUNCTi -> Ptyintro *) + + let proof_new_basic_type_definition tyname (absname, repname) (pt,tt) _ = + let rty = type_of tt in + let tyvars = sort (<=) (type_vars_in_term pt) in + + mk_proof(Ptyintro(rty, tyname, tyvars, absname, repname, pt));; + + + (* ---- used only in substitute_proof calls ---- *) + + (* corresponds to Bool.SPEC, the !-elimination rule *) + + let proof_SPEC s p = mk_proof (Pspec(inc_references p, s));; + + + (* corresponds to Equal.SYM, the symmetry rule *) + + let proof_SYM p = mk_proof (Psym(inc_references p));; + + + (* corresponds to Bool.GEN, the !-introduction rule *) + + let proof_GEN p a = + match a with + | Var(s, ty) -> + mk_proof (Pgen(inc_references p, s, ty)) + | _ -> failwith "proof_GEN: not a term variable";; + + + (* corresponds to Bool.DISJ1, the \/-left introduction rule *) + + let proof_DISJ1 p a = mk_proof (Pdisj1 (inc_references p, a));; + + + (* corresponds to Bool.DISJ2, the \/-right introduction rule *) + + let proof_DISJ2 p a = mk_proof (Pdisj2 (inc_references p, a));; + + + (* corresponds to Bool.NOT_INTRO, the following rule: *) + (* A |- t ==> F *) + (* -------------- NOT_INTRO *) + (* A |- ~t *) + + let proof_NOTI p = mk_proof (Pnoti (inc_references p));; + + + (* corresponds to Bool.NOT_ELIM, the following rule: *) + (* A |- ~t *) + (* -------------- NOT_ELIM *) + (* A |- t ==> F *) + + let proof_NOTE p = mk_proof (Pnote (inc_references p));; + + + (* corresponds to Bool.CONTR, the intuitionistic F-elimination rule: *) + (* A |- F *) + (* -------- CONTR `t` *) + (* A |- t *) + + let proof_CONTR p a = mk_proof (Pcontr (inc_references p, a));; + + + (* corresponds to Bool.DISJ_CASES, the \/-elimination rule: *) + (* A |- t1 \/ t2 A1 u {t1} |- t A2 u {t2} |- t *) + (* ------------------------------------------------------ DISJ_CASES *) + (* A u A1 u A2 |- t *) + + let proof_DISJCASES p q r = + mk_proof (Pdisjcases (inc_references p, inc_references q, inc_references r));; + + + (* corresponds to Bool.CHOOSE, the ?-elimination rule: *) + (* A1 |- ?x. s[x] A2 |- t *) + (* ------------------------------- CHOOSE (`v`,(A1 |- ?x. s)) *) + (* A1 u (A2 - {s[v/x]}) |- t *) + (* Where v is not free in A2 - {s[v/x]} or t. *) + + let proof_CHOOSE a p q = + let (x,ty) = dest_var a in + mk_proof (Pchoose (x, ty, inc_references p, inc_references q));; + + + (* corresponds to Bool.EXISTS, the ?-introduction rule: *) + (* A |- p[u/x] *) + (* ------------- EXISTS (`?x. p`,`u`) *) + (* A |- ?x. p *) + (* x is p, y is u *) + + let proof_EXISTS etm y p = + let _,x = dest_comb etm in + mk_proof (Pexists (inc_references p, x, y));; + + + (****** Utilities for exportation ******) + + let content_of (Proof (_,x,_)) = x;; + + + let disk_info_of (Proof(Info {disk_info=di},_,_)) = !di;; + + + let set_disk_info_of (Proof(Info {disk_info=di},_,_)) thyname thmname = + di := Some (thyname,thmname);; + + let reset_disk_info_of1 ((Proof(Info {disk_info=di}, _, _)) as p) = + di := None; p;; + let reset_disk_info_of2 (Proof(Info {disk_info=di}, _, _)) = + di := None;; + + + let references (Proof (Info info,_,_)) = !(info.references);; + + + let glob_counter = ref 0;; + + + let get_counter () = incr glob_counter; !glob_counter;; + + + let get_iname = string_of_int o get_counter;; + + + let next_counter () = !glob_counter;; + + + let trivial p = + match (content_of p) with + | Prefl _ -> true + | Pbeta _ -> true + | Paxm _ -> true + | Phyp _ -> true + | _ -> false;; + + + let do_share p = references p > 1 & not (trivial p);; + + + (****** Types and terms modification ******) + + let idT = Hashtbl.create 17;; + let defT = Hashtbl.create 17;; + + let idT_ref = ref 1;; + let defT_ref = ref 1;; + + let make_idT x = + try Hashtbl.find idT x with | Not_found -> let n = !idT_ref in incr idT_ref; Hashtbl.add idT x n; n;; + + let make_defT x = + try Hashtbl.find defT x with | Not_found -> let n = !defT_ref in incr defT_ref; Hashtbl.add defT x n; n;; + + + type ntype = + | Ntvar of int + | Nbool + | Nnum + | Narrow of ntype * ntype + | Ntdef of int * ntype list;; + + + let rec hol_type2ntype = function + | Tyvar x -> Ntvar (make_idT x) + | Tyapp (s, _) when s = "bool" -> Nbool + (* | Tyapp (s, _) when s = "ind" -> Nnum *) + | Tyapp (s, l) when s = "fun" -> + (match l with + | [a;b] -> Narrow (hol_type2ntype a, hol_type2ntype b) + | _ -> failwith "hol_type2ntype: wrong number of arguments for fun") + | Tyapp (s, l) -> Ntdef (make_defT s, List.map hol_type2ntype l);; + + + let idV = Hashtbl.create 17;; + let defV = Hashtbl.create 17;; + + let idV_ref = ref 1;; + let defV_ref = ref 1;; + + let make_idV x X = + try + fst (Hashtbl.find idV x) + with | Not_found -> + let n = !idV_ref in incr idV_ref; Hashtbl.add idV x (n,X); n;; + + let make_defV x X f = + try let (a,_,_) = (Hashtbl.find defV x) in a with | Not_found -> let n = !defV_ref in incr defV_ref; Hashtbl.add defV x (n,X,f); n;; + + + type ncst = + | Heq of ntype + | Heps of ntype + | Hand + | Hor + | Hnot + | Himp + | Htrue + | Hfalse + | Hforall of ntype + | Hexists of ntype;; + + + type nterm = + | Ndbr of int + | Nvar of int * ntype + | Ncst of ncst + | Ndef of int * ntype + | Napp of nterm * nterm + | Nabs of ntype * nterm;; + + + let rec ext_var x (ty: ntype) i = function + | [] -> Nvar (make_idV x ty, ty) + | (y,typ)::l -> if ((x = y) && (ty = typ)) then Ndbr i else ext_var x ty (i+1) l;; + + + let rec term2nterm l = function + | Var (x, ty) -> ext_var x (hol_type2ntype ty) 0 l + | Comb (t1, t2) -> Napp (term2nterm l t1, term2nterm l t2) + | Abs (t1, t2) -> + (match t1 with + | Var (x, ty) -> + let typ = hol_type2ntype ty in + Nabs (typ, term2nterm ((x,typ)::l) t2) + | _ -> failwith "term2nterm: first argument of an abstraction is not a variable") + | Const (s, ty) when s = "=" -> + (match hol_type2ntype ty with + | Narrow(a, _) -> Ncst (Heq a) + | _ -> failwith "term2nterm: constant = must have arrow type") + | Const (s, ty) when s = "@" -> + (match hol_type2ntype ty with + | Narrow(_, a) -> Ncst (Heps a) + | _ -> failwith "term2nterm: constant @ must have arrow type") + | Const (s, ty) when s = "/\\" -> Ncst Hand + | Const (s, ty) when s = "\\/" -> Ncst Hor + | Const (s, ty) when s = "~" -> Ncst Hnot + | Const (s, ty) when s = "==>" -> Ncst Himp + | Const (s, ty) when s = "T" -> Ncst Htrue + | Const (s, ty) when s = "F" -> Ncst Hfalse + | Const (s, ty) when s = "_FALSITY_" -> Ncst Hfalse + | Const (s, ty) when s = "!" -> + (match hol_type2ntype ty with + | Narrow(Narrow (a, _), _) -> Ncst (Hforall a) + | _ -> failwith "term2nterm: constant ! must have arrow type") + | Const (s, ty) when s = "?" -> + (match hol_type2ntype ty with + | Narrow(Narrow (a, _), _) -> Ncst (Hexists a) + | _ -> failwith "term2nterm: constant ? must have arrow type") + | Const (s, ty) -> + let typ = hol_type2ntype ty in + Ndef(make_defV s typ true, typ);; + + let term2nterm t = term2nterm [] t;; + + + (****** Proof exportation ******) + + let rec print_list out str snil scons = function + | [] -> out snil + | t::q -> out "("; out scons; out " "; str t; out " "; print_list out str snil scons q; out ")";; + + + let print_names out x = out (string_of_int x); out "%positive";; + + + let print_type (out: string -> unit) ty = + + let rec print_ntype = function + | Ntvar x -> out "(TVar "; print_names out x; out ")" + | Nbool -> out "Bool" + | Nnum -> out "Num" + | Narrow(a, b) -> out "("; print_ntype a; out " --> "; print_ntype b; out ")" + | Ntdef(s, l) -> out "(TDef "; print_names out s; out " "; print_list out print_ntype "Tnil" "Tcons" l; out ")" in + + print_ntype ty;; + + + let print_cst out = function + | Heq ty -> out "(Heq "; print_type out ty; out ")" + | Heps ty -> out "(Heps "; print_type out ty; out ")" + | Hand -> out "Hand" + | Hor -> out "Hor" + | Hnot -> out "Hnot" + | Himp -> out "Himp" + | Htrue -> out "Htrue" + | Hfalse -> out "Hfalse" + | Hforall ty -> out "(Hforall "; print_type out ty; out ")" + | Hexists ty -> out "(Hexists "; print_type out ty; out ")";; + + + let print_term out t = + + let rec print_nterm = function + | Ndbr n -> out "(Dbr "; out (string_of_int n); out ")" + | Nvar(x, ty) -> out "(Var "; print_names out x; out " "; print_type out ty; out ")" + | Ncst c -> out "(Cst "; print_cst out c; out ")" + | Ndef(a, ty) -> out "(Def "; print_names out a; out " "; print_type out ty; out ")" + | Napp(t1, t2) -> out "(App "; print_nterm t1; out " "; print_nterm t2; out ")" + | Nabs(ty, t) -> out "(Abs "; print_type out ty; out " "; print_nterm t; out ")" in + + print_nterm t;; + + + (* Exportation *) + + let total = ref 0;; + + type nproof_content = + | Nprefl of nterm + | Npbeta of int * ntype * nterm + | Npinstt of nproof_content * (int * ntype) list + | Npabs of nproof_content * int * ntype + | Npdisch of nproof_content * nterm + | Nphyp of nterm + | Npspec of nproof_content * nterm + | Npinst of nproof_content * (int * ntype * nterm) list + | Npgen of nproof_content * int * ntype + | Npsym of nproof_content + | Nptrans of nproof_content * nproof_content + | Npcomb of nproof_content * nproof_content + | Npeqmp of nproof_content * nproof_content + | Npexists of nproof_content * nterm * nterm + | Npchoose of int * ntype * nproof_content * nproof_content + | Npconj of nproof_content * nproof_content + | Npconjunct1 of nproof_content + | Npconjunct2 of nproof_content + | Npdisj1 of nproof_content * nterm + | Npdisj2 of nproof_content * nterm + | Npdisjcases of nproof_content * nproof_content * nproof_content + | Npnoti of nproof_content + | Npnote of nproof_content + | Npcontr of nproof_content * nterm + | Npimpas of nproof_content * nproof_content + | Npaxm of string * nterm + | Npdef of int * ntype * nterm + | Nptyintro of ntype * ntype * int * int * nterm + | Nfact of string;; + + + let the_types = Hashtbl.create 17;; + let count_types = ref (-1);; + + let share_types out ty = + + let rec share_types ty = + try Hashtbl.find the_types ty with + | Not_found -> + incr count_types; + let name = THEORY_NAME^"_type_"^(string_of_int !count_types) in + (match ty with + | Narrow(a,b) -> + let n1 = share_types a in + let n2 = share_types b in + out "\nDefinition "; out name; out " := "; out n1; out " --> "; out n2; out "." + | Ntdef(i,l) -> + let names = List.map share_types l in + out "\nDefinition "; out name; out " := TDef "; print_names out i; out " "; print_list out out "Tnil" "Tcons" names; out "." + | t -> out "\nDefinition "; out name; out " := "; print_type out t; out "."); + Hashtbl.add the_types ty name; + name in + + share_types ty;; + + + let the_terms = Hashtbl.create 17;; + let count_terms = ref (-1);; + + let share_csts out out_types name = function + | Heq a -> + let n = share_types out_types a in + out "\nDefinition "; out name; out " := Cst (Heq "; out n; out ")." + | Heps a -> + let n = share_types out_types a in + out "\nDefinition "; out name; out " := Cst (Heps "; out n; out ")." + | Hand -> out "\nDefinition "; out name; out " := Cst Hand." + | Hor -> out "\nDefinition "; out name; out " := Cst Hor." + | Hnot -> out "\nDefinition "; out name; out " := Cst Hnot." + | Himp -> out "\nDefinition "; out name; out " := Cst Himp." + | Htrue -> out "\nDefinition "; out name; out " := Cst Htrue." + | Hfalse -> out "\nDefinition "; out name; out " := Cst Hfalse." + | Hforall a -> + let n = share_types out_types a in + out "\nDefinition "; out name; out " := Cst (Hforall "; out n; out ")." + | Hexists a -> + let n = share_types out_types a in + out "\nDefinition "; out name; out " := Cst (Hexists "; out n; out ")." + + let share_terms out out_types tm = + + let rec share_terms tm = + try Hashtbl.find the_terms tm with + | Not_found -> + incr count_terms; + let name = THEORY_NAME^"_term_"^(string_of_int !count_terms) in + (match tm with + | Napp(t1,t2) -> + let n1 = share_terms t1 in + let n2 = share_terms t2 in + out "\nDefinition "; out name; out " := App "; out n1; out " "; out n2; out "." + | Nabs(ty,t) -> + let n = share_terms t in + let ny = share_types out_types ty in + out "\nDefinition "; out name; out " := Abs "; out ny; out " "; out n; out "." + | Nvar(i,ty) -> + let ny = share_types out_types ty in + out "\nDefinition "; out name; out " := Var "; print_names out i; out " "; out ny; out "." + | Ndef(i,ty) -> + let ny = share_types out_types ty in + out "\nDefinition "; out name; out " := Def "; print_names out i; out " "; out ny; out "." + | Ncst c -> share_csts out out_types name c + | t -> out "\nDefinition "; out name; out " := "; print_term out t; out "."); + Hashtbl.add the_terms tm name; + name in + + share_terms tm;; + + + let export_proof out share_type share_term p = + + let rec wp = function + | Nprefl tm -> + let tm2 = share_term tm in + out "(Prefl "; out tm2; out ")" + | Npbeta (n, ty, tm) -> + let tm2 = share_term tm in + let ty2 = share_type ty in + out "(Pbeta "; print_names out n; out " "; out ty2; out " "; out tm2; out ")" + | Npinstt(p,lambda) -> + out "(Pinstt "; + wp p; + out " "; print_list out (fun (s, ty) -> + let ty2 = share_type ty in + out "("; print_names out s; out ", "; out ty2; out ")") "nil" "cons" lambda; out ")" + | Npabs(p,x,ty) -> + let ty2 = share_type ty in + out "(Pabs "; + wp p; + out " "; print_names out x; + out " "; out ty2; out ")" + | Npdisch(p,tm) -> + let tm2 = share_term tm in + out "(Pdisch "; + wp p; + out " "; out tm2; out ")" + | Nphyp tm -> + let tm2 = share_term tm in + out "(Phyp "; out tm2; out ")" + | Npaxm(_, _) -> () + | Npdef(_, _, _) -> () + | Nptyintro(_, _, _, _, _) -> () + | Npspec(p,t) -> + let t2 = share_term t in + out "(Pspec "; + wp p; + out " "; out t2; out ")" + | Npinst(p,theta) -> + out "(Pinst "; + wp p; + out " "; print_list out (fun (s, ty, t) -> + let t2 = share_term t in + let ty2 = share_type ty in + out "("; print_names out s; out ", "; out ty2; out ", "; out t2; out ")") "nil" "cons" theta; out ")" + | Npgen(p,x,ty) -> + let ty2 = share_type ty in + out "(Pgen "; + wp p; + out " "; print_names out x; out " "; out ty2; out ")" + | Npsym p -> + out "(Psym "; + wp p; + out ")" + | Nptrans(p1,p2) -> + out "(Ptrans "; + wp p1; + out " "; + wp p2; + out ")" + | Npcomb(p1,p2) -> + out "(Pcomb "; + wp p1; + out " "; + wp p2; + out ")" + | Npeqmp(p1,p2) -> + out "(Peqmp "; + wp p1; + out " "; + wp p2; + out ")" + | Npexists(p,ex,w) -> + let ex2 = share_term ex in + let w2 = share_term w in + out "(Pexists "; + wp p; + out " "; out ex2; out " "; out w2; out ")" + | Npchoose(x,ty,p1,p2) -> + let ty2 = share_type ty in + out "(Pchoose "; print_names out x; out " "; out ty2; out " "; + wp p1; + out " "; + wp p2; + out ")" + | Npconj(p1,p2) -> + out "(Pconj "; + wp p1; + out " "; + wp p2; + out ")" + | Npimpas(p1,p2) -> + out "(Pimpas "; + wp p1; + out " "; + wp p2; + out ")" + | Npconjunct1 p -> + out "(Pconjunct1 "; + wp p; + out ")" + | Npconjunct2 p -> + out "(Pconjunct2 "; + wp p; + out ")" + | Npdisj1(p,tm) -> + let tm2 = share_term tm in + out "(Pdisj1 "; + wp p; + out " "; out tm2; out ")" + | Npdisj2(p,tm) -> + let tm2 = share_term tm in + out "(Pdisj2 "; + wp p; + out " "; out tm2; out ")" + | Npdisjcases(p1,p2,p3) -> + out "(Pdisjcases "; + wp p1; + out " "; + wp p2; + out " "; + wp p3; + out ")" + | Npnoti p -> + out "(Pnoti "; + wp p; + out ")" + | Npnote p -> + out "(Pnote "; + wp p; + out ")" + | Npcontr(p,tm) -> + let tm2 = share_term tm in + out "(Pcontr "; + wp p; + out " "; out tm2; out ")" + | Nfact(thm) -> out "(Poracle "; out thm; out "_def)" in + + wp p;; + + + let export_ht out share_term h t thmname = + out "\n\n\nDefinition "; out thmname; out "_h := "; + (match h with + | [] -> out "hyp_empty" + | _ -> print_list out (fun tm -> + let tm2 = share_term tm in + out tm2) "nil" "cons" h); + out ".\n\nDefinition "; out thmname; out "_t := "; + let t2 = share_term t in + out t2; out ".";; + + + let export_lemma out share_type share_term p thmname = + out "\n\nLemma "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; + out "_t.\nProof.\n vm_cast_no_check (proof2deriv_correct "; export_proof out share_type share_term p; out ").\nQed.";; + + + let export_lemma_def out tree thmname = + out "\n\nLemma "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; + out "_t.\nProof.\n vm_cast_no_check (proof2deriv_correct "; out tree; out ").\nQed.";; + + + let export_sig out thmname = + out "\n\nDefinition "; out thmname; out "_def := my_exist "; out thmname; out "_lemma.";; + + + let export_def out thmname = + out "\n\nParameter "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.";; + + + let export_tdef out thmname = + out "\n\nParameter "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.";; + + + let export_axiom out thmname = + out "\n\nAxiom "; out thmname; out "_lemma : deriv "; out thmname; out "_h "; out thmname; out "_t.";; + + + (* Transforming a proof into a derivation *) + + let rec opt_nth n l = + match (n, l) with + | 0, (x::_) -> Some x + | 0, [] -> None + | p, (_::l) -> opt_nth (p-1) l + | _, _ -> None;; + + + let type_cst = function + | Heq a -> Narrow(a, Narrow(a, Nbool)) + | Heps a -> Narrow(Narrow(a, Nbool), a) + | Hand -> Narrow(Nbool, Narrow(Nbool, Nbool)) + | Hor -> Narrow(Nbool, Narrow(Nbool, Nbool)) + | Hnot -> Narrow(Nbool, Nbool) + | Himp -> Narrow(Nbool, Narrow(Nbool, Nbool)) + | Htrue -> Nbool + | Hfalse -> Nbool + | Hforall a -> Narrow(Narrow(a, Nbool), Nbool) + | Hexists a -> Narrow(Narrow(a, Nbool), Nbool);; + + + let rec infer g = function + | Ndbr n -> opt_nth n g + | Nvar (_, a) -> Some a + | Ncst c -> Some (type_cst c) + | Ndef (_, a) -> Some a + | Napp (t1, t2) -> + (match infer g t1, infer g t2 with + | Some (Narrow (u1, u2)), Some v -> if u1 = v then Some u2 else None + | _, _ -> None) + | Nabs (a, u) -> + (match infer (a::g) u with + | Some b -> Some (Narrow (a, b)) + | None -> None);; + + + let rec close_aux t x a i = + match t with + | Ndbr n -> Ndbr (if n < i then n else n+1) + | Nvar (y, b) -> if ((x = y) && (a = b)) then Ndbr i else Nvar (y, b) + | Napp (t1, t2) -> Napp (close_aux t1 x a i, close_aux t2 x a i) + | Nabs (b, u) -> Nabs(b, close_aux u x a (i+1)) + | u -> u;; + + let close t x a = close_aux t x a 0;; + + + let rec subst_idt_type_aux x = function + | [] -> Ntvar x + | (y,a)::q -> if x = y then a else subst_idt_type_aux x q;; + + let rec subst_idt_type t s = + match t with + | Ntvar x -> subst_idt_type_aux x s + | Ntdef (a, l) -> Ntdef (a, subst_idt_list_type l s) + | Narrow (a, b) -> Narrow (subst_idt_type a s, subst_idt_type b s) + | u -> u + + and subst_idt_list_type l s = List.map (fun t -> subst_idt_type t s) l;; + + let rec subst_idt t s = + match t with + | Nvar (x, y) -> Nvar (x, subst_idt_type y s) + | Ncst (Heq a) -> Ncst (Heq (subst_idt_type a s)) + | Ncst (Heps a) -> Ncst (Heps (subst_idt_type a s)) + | Ncst (Hforall a) -> Ncst (Hforall (subst_idt_type a s)) + | Ncst (Hexists a) -> Ncst (Hexists(subst_idt_type a s)) + | Ndef (c, d) -> Ndef (c, subst_idt_type d s) + | Napp (t1, t2) -> Napp (subst_idt t1 s, subst_idt t2 s) + | Nabs (a, t) -> Nabs (subst_idt_type a s, subst_idt t s) + | u -> u;; + + let subst_idt_context g s = List.map (fun a -> subst_idt_type a s) g;; + + let rec subst_idv_aux x y s = + match s with + | [] -> Nvar (x, y) + | (z, t, u)::q -> if ((x = z) && (y = t)) then u else subst_idv_aux x y q;; + + let rec subst_idv t s = + match t with + | Nvar (x, y) -> subst_idv_aux x y s + | Napp (t1, t2) -> Napp (subst_idv t1 s, subst_idv t2 s) + | Nabs (a, t) -> Nabs (a, subst_idv t s) + | u -> u;; + + let rec wf_substitution_idv = function + | [] -> true + | (_,y,t)::q -> + match infer [] t with + | Some z -> if (y = z) then wf_substitution_idv q else false + | None -> false;; + + + let rec is_not_free x y = function + | Nvar (z, t) -> (x != z) or (not (y = t)) + | Napp (t1, t2) -> (is_not_free x y t1) && (is_not_free x y t2) + | Nabs (_, u) -> is_not_free x y u + | _ -> true;; + + + let rec lift_term u i j = + match u with + | Ndbr n -> if n >= i then Ndbr (j + n) else Ndbr n + | Napp (u1, u2) -> Napp (lift_term u1 i j, lift_term u2 i j) + | Nabs (a, t) -> Nabs (a, lift_term t (i+1) j) + | u -> u;; + + let rec subst_db t n u = + match t with + | Ndbr i -> if i < n then Ndbr i else if i = n then u else Ndbr (i-1) + | Napp (t1, t2) -> Napp (subst_db t1 n u, subst_db t2 n u) + | Nabs (a, t) -> Nabs (a, subst_db t (n+1) (lift_term u 0 1)) + | u -> u;; + + let nopen t u = subst_db t 0 u;; + + + let heq a t u = Napp (Napp (Ncst (Heq a), t), u);; + let hequiv t u = Napp (Napp (Ncst (Heq Nbool), t), u);; + let himp t u = Napp (Napp (Ncst Himp, t), u);; + let hand t u = Napp (Napp (Ncst Hand, t), u);; + let hor t u = Napp (Napp (Ncst Hor, t), u);; + let hnot t = Napp (Ncst Hnot, t);; + let htrue = Ncst Htrue;; + let hfalse = Ncst Hfalse;; + let hforall a p = Napp (Ncst (Hforall a), Nabs (a, p));; + let hexists a p = Napp (Ncst (Hexists a), Nabs (a, p));; + + + let hyp_empty = [];; + + let rec hyp_remove e = function + | [] -> [] + | t::q -> if (e = t) then q else t::(hyp_remove e q);; + + let rec hyp_add e = function + | [] -> [e] + | t::q -> if (e = t) then t::q else t::(hyp_add e q);; + + let hyp_union l m = List.fold_left (fun n e -> hyp_add e n) m l;; + + let hyp_map f l = List.fold_left (fun m e -> hyp_add (f e) m) [] l;; + + let hyp_singl e = [e];; + + let rec hyp_is_not_free x y = function + | [] -> true + | t::q -> (is_not_free x y t) && (hyp_is_not_free x y q);; + + let hyp_subst_idt h s = hyp_map (fun t -> subst_idt t s) h;; + + let hyp_subst_idv h s = hyp_map (fun t -> subst_idv t s) h;; + + + let rec eq_type a b = match (a,b) with + | Ntvar i, Ntvar j -> i = j + | Nbool, Nbool -> true + | Nnum, Nnum -> true + | Narrow(a1, b1), Narrow(a2, b2) -> (eq_type a1 a2) && (eq_type b1 b2) + | Ntdef(i,l), Ntdef(j,m) -> (i = j) && (eq_list_type l m) + | _, _ -> false + + and eq_list_type l m = match (l,m) with + | [], [] -> true + | t1::q1, t2::q2 -> (eq_type t1 t2) && (eq_list_type q1 q2) + | _, _ -> false;; + + + let eq_cst a b = match (a,b) with + | Heq a, Heq b -> eq_type a b + | Heps a, Heps b -> eq_type a b + | Hand, Hand -> true + | Hor, Hor -> true + | Hnot, Hnot -> true + | Himp, Himp -> true + | Htrue, Htrue -> true + | Hfalse, Hfalse -> true + | Hforall a, Hforall b -> eq_type a b + | Hexists a, Hexists b -> eq_type a b + | _, _ -> false;; + + + let rec eq_term a b = match (a,b) with + | Ndbr i, Ndbr j -> i = j + | Nvar(i,a), Nvar(j,b) -> (i = j) && (eq_type a b) + | Ncst c, Ncst d -> eq_cst c d + | Ndef(i,a), Ndef(j,b) -> (i = j) && (eq_type a b) + | Napp(a1,b1), Napp(a2,b2) -> (eq_term a1 a2) && (eq_term b1 b2) + | Nabs(t1,a1), Nabs(t2,a2) -> (eq_type t1 t2) && (eq_term a1 a2) + | _, _ -> false;; + + + let derivs = Hashtbl.create 17;; + + + let rec proof2deriv = function + + | Nprefl t -> + (match infer [] t with + | Some a -> Some (hyp_empty, heq a t t) + | None -> (print_string "Nprefl\n"); None) + + | Npbeta (x, y, t) -> + (match infer [] t with + | Some a -> Some (hyp_empty, + heq a (Napp (Nabs (y, close t x y), Nvar (x, y))) t) + | None -> (print_string "Npbeta\n"); None) + + | Npinstt (q, l) -> + (match proof2deriv q with + | Some (h,v) -> Some (hyp_subst_idt h l, subst_idt v l) + | None -> (print_string "Npinstt\n"); None) + + | Npabs (q, x, y) -> + (match proof2deriv q with + | Some (h, t) -> + (match t with + | Napp (Napp (Ncst (Heq a), t1), t2) -> + if hyp_is_not_free x y h then + Some (h, heq (Narrow (y, a)) (Nabs (y, close t1 x y)) (Nabs (y, close t2 x y))) + else ((print_string "Npabs\n"); None) + | _ -> (print_string "Npabs\n"); None) + | None -> (print_string "Npabs\n"); None) + + | Npdisch (q, t) -> + (match proof2deriv q, infer [] t with + | Some (h, u), Some Nbool -> Some (hyp_remove t h, himp t u) + | _, _ -> (print_string "Npdisch\n"); None) + + | Nphyp t -> + (match infer [] t with + | Some Nbool -> Some (hyp_singl t, t) + | _ -> (print_string "Nphyp\n"); None) + + | Npspec (q, t) -> + (match proof2deriv q, infer [] t with + | Some (h, u), Some a -> + (match u with + | Napp (Ncst (Hforall b), Nabs (c, v)) -> + if ((eq_type a b) && (eq_type b c)) then + Some (h, nopen v t) + else ((print_string "Npspec\n"); None) + | _ -> (print_string "Npspec\n"); None) + | _, _ -> (print_string "Npspec\n"); None) + + | Npinst (q, l) -> + (match proof2deriv q, wf_substitution_idv l with + | Some (h, v), true -> Some (hyp_subst_idv h l, subst_idv v l) + | _, _ -> (print_string "Npinst\n"); None) + + | Npgen (q, x, y) -> + (match proof2deriv q with + | Some (h, t) -> + if hyp_is_not_free x y h then + Some (h, hforall y (close t x y)) + else ((print_string "Npgen\n"); None) + | None -> (print_string "Npgen\n"); None) + + | Npsym q -> + (match proof2deriv q with + | Some (h, t) -> + (match t with + | Napp (Napp (Ncst (Heq a), u), v) -> Some (h, heq a v u) + | _ -> (print_string "Npsym\n"); None) + | None -> (print_string "Npsym\n"); None) + + | Nptrans (q1, q2) -> + (match proof2deriv q1, proof2deriv q2 with + | Some (h1, t1), Some (h2, t2) -> + (match t1, t2 with + | Napp (Napp (Ncst (Heq a), u1), u2), + Napp (Napp (Ncst (Heq b), v2), v3) -> + if ((eq_type a b) && (eq_term u2 v2)) then + Some (hyp_union h1 h2, heq a u1 v3) + else ((print_string "Nptrans\n"); None) + | _, _ -> (print_string "Nptrans\n"); None) + | _, _ -> (print_string "Nptrans\n"); None) + + | Npcomb (q1, q2) -> + (match proof2deriv q1, proof2deriv q2 with + | Some (h1, t1), Some (h2, t2) -> + (match t1, t2 with + | Napp (Napp (Ncst (Heq (Narrow (a, b))), f), g), + Napp (Napp (Ncst (Heq c), u), v) -> + if (eq_type a c) then + Some (hyp_union h1 h2, heq b (Napp (f, u)) (Napp (g, v))) + else ((print_string "Npcomb\n"); None) + | _, _ -> (print_string "Npcomb\n"); None) + | _, _ -> (print_string "Npcomb\n"); None) + + | Npeqmp (q1, q2) -> + (match proof2deriv q1, proof2deriv q2 with + | Some (h1, t1), Some (h2, t2) -> + (match t1 with + | Napp (Napp (Ncst (Heq Nbool), a), b) -> + if (eq_term a t2) then + Some (hyp_union h1 h2, b) + else ((print_string "Npeqmp\n"); None) + | _ -> (print_string "Npeqmp\n"); None) + | _, _ -> (print_string "Npeqmp\n"); None) + + | Npexists (q, b, t) -> + (match proof2deriv q, b, infer [] t with + | Some (h, u), Nabs (bb, a), Some aa -> + if ((eq_type aa bb) && (eq_term (nopen a t) u)) then + Some (h, hexists aa a) + else ((print_string "Npexists\n"); None) + | _, _, _ -> (print_string "Npexists\n"); None) + + | Npchoose (v, aa, q1, q2) -> + (match proof2deriv q1, proof2deriv q2 with + | Some (h1, t), Some (h2, c) -> + (match t with + | Napp (Ncst (Hexists bb), Nabs (cc, a)) -> + let s = hyp_remove (nopen a (Nvar (v, aa))) h2 in + if ((eq_type aa bb) && (eq_type bb cc) && (hyp_is_not_free v aa s) && (is_not_free v aa c) + && (is_not_free v aa a)) then + Some (hyp_union h1 s, c) + else ((print_string "Npchoose\n"); None) + | _ -> (print_string "Npchoose\n"); None) + | _, _ -> (print_string "Npchoose\n"); None) + + | Npconj (q1, q2) -> + (match proof2deriv q1, proof2deriv q2 with + | Some (h1, a), Some (h2, b) -> + Some (hyp_union h1 h2, hand a b) + | _, _ -> (print_string "Npconj\n"); None) + + | Npconjunct1 q -> + (match proof2deriv q with + | Some (h, v) -> + (match v with + | Napp (Napp (Ncst Hand, t), u) -> + Some (h, t) + | _ -> (print_string "Npconjunct1\n"); None) + | _ -> (print_string "Npconjunct1\n"); None) + + | Npconjunct2 q -> + (match proof2deriv q with + | Some (h, v) -> + (match v with + | Napp (Napp (Ncst Hand, t), u) -> + Some (h, u) + | _ -> (print_string "Npconjunct2\n"); None) + | _ -> (print_string "Npconjunct2\n"); None) + + | Npdisj1 (q, b) -> + (match proof2deriv q, infer [] b with + | Some (h, a), Some Nbool -> Some (h, hor a b) + | _, _ -> (print_string "Npdisj1\n"); None) + + | Npdisj2 (q, a) -> + (match proof2deriv q, infer [] a with + | Some (h, b), Some Nbool -> Some (h, hor a b) + | _, _ -> (print_string "Npdisj1\n"); None) + + | Npdisjcases (q1, q2, q3) -> + (match proof2deriv q1, proof2deriv q2, proof2deriv q3 with + | Some (h1, t), Some (h2, c1), Some (h3, c2) -> + (match t with + | Napp (Napp (Ncst Hor, a), b) -> + if (eq_term c1 c2) then + Some (hyp_union h1 (hyp_union (hyp_remove a h2) (hyp_remove b h3)), c1) + else ((print_string "Npdisjcases\n"); None) + | _ -> (print_string "Npdisjcases\n"); None) + | _, _, _ -> (print_string "Npisjcases\n"); None) + + | Npnoti q -> + (match proof2deriv q with + | Some (h, t) -> + (match t with + | Napp (Napp (Ncst Himp, a), Ncst Hfalse) -> Some (h, hnot a) + | _ -> (print_string "Npnoti\n"); None) + | _ -> (print_string "Npnoti\n"); None) + + | Npnote q -> + (match proof2deriv q with + | Some (h, t) -> + (match t with + | Napp (Ncst Hnot, a) -> Some (h, himp a hfalse) + | _ -> (print_string "Npnote\n"); None) + | _ -> (print_string "Npnote\n"); None) + + | Npcontr (q, a) -> + (match proof2deriv q, infer [] a with + | Some (h, t), Some Nbool -> + (match t with + | Ncst Hfalse -> Some (hyp_remove (hnot a) h, a) + | _ -> (print_string "Npcontr\n"); None) + | _, _ -> (print_string "Npcontr\n"); None) + + | Npimpas (q1, q2) -> + (match proof2deriv q1, proof2deriv q2 with + | Some (h1, t), Some (h2, u) -> + (match t, u with + | Napp (Napp (Ncst Himp, a1), b1), + Napp (Napp (Ncst Himp, b2), a2) -> + if ((eq_term a1 a2) && (eq_term b1 b2)) then + Some (hyp_union h1 h2, hequiv b1 a1) + else ((print_string ("Npimpas1; 1: "^(string_of_bool (eq_term a1 a2))^"; 2: "^(string_of_bool (eq_term b1 b2))^"\n")); + let out = print_string in + print_term out a1; out "\n"; print_term out a2; out "\n"; print_term out b1; out "\n"; print_term out b2; out "\n"; None) + | _, _ -> (print_string "Npimpas2\n"); None) + | _, _ -> (print_string "Npimpas3\n"); None) + + | Nfact thm -> + (try Some (Hashtbl.find derivs thm) with + | Not_found -> (print_string ("Nfact "^thm^"\n")); None) + + | Npdef (i, a, t) -> Some (hyp_empty, heq a (Ndef (i, a)) t) + + | Npaxm (_, t) -> Some (hyp_empty, t) + + | Nptyintro (rty, aty, mk_name, dest_name, p) -> + + let mk_type = Narrow(rty, aty) in + let dest_type = Narrow(aty, rty) in + + let a_name = make_idV "a" aty in + let a = Nvar(a_name, aty) in + let r_name = make_idV "r" rty in + let r = Nvar(r_name, rty) in + + Some (hyp_empty, hand (heq aty (Napp (Ndef (mk_name, mk_type), Napp (Ndef (dest_name, dest_type), a))) a) + (hequiv (Napp (p, r)) (heq rty (Napp (Ndef (dest_name, dest_type), Napp (Ndef (mk_name, mk_type), r))) r)));; + + + (* Dealing with dependencies *) + + let rec make_dependencies_aux dep_graph proof_of_thm = function + | [] -> () + | (thmname, p, c_opt)::il -> + + incr total; + + let wdi thm = + Depgraph.Dep.add_dep dep_graph thm thmname; + Nfact thm in + + let write_proof p il = + + let rec share_info_of p il = + match (disk_info_of p) with + | Some (thyname,thmname) -> Some(thyname,thmname,il) + | None -> + if do_share p then + let name = THEORY_NAME^"_"^(get_iname ()) in + set_disk_info_of p THEORY_NAME name; + Depgraph.Dep.add_thm dep_graph name; + Some(THEORY_NAME,name,(name,p,None)::il) + else + None + + and wp' il = function + | Prefl tm -> Nprefl (term2nterm tm), il + | Pbeta(x, ty, tm) -> + let typ = hol_type2ntype ty in + Npbeta(make_idV x typ , typ, term2nterm tm), il + | Pinstt(p,lambda) -> + let p', res = wp il p in + Npinstt(p', List.map ( + fun (s,ty) -> (make_idT s, hol_type2ntype ty) + ) lambda), res + | Pabs(p,x,ty) -> + let p', res = wp il p in + let typ = hol_type2ntype ty in + Npabs(p',make_idV x typ,typ), res + | Pdisch(p,tm) -> + let p', res = wp il p in + Npdisch(p', term2nterm tm), res + | Phyp tm -> Nphyp (term2nterm tm), il + | Paxm(th,tm) -> Npaxm(th, term2nterm tm), il + | Pdef(name,ty,tm) -> + let typ = hol_type2ntype ty in + Npdef(make_defV name typ true, typ, term2nterm tm), il + | Ptyintro(rty2, tyname, tyvars, absname, repname, pt) -> + let rty = hol_type2ntype rty2 in + let new_name = make_defT tyname in + + let ntyvars = List.map hol_type2ntype tyvars in + let aty = Ntdef(new_name, ntyvars) in + + let mk_name = make_defV absname (Narrow(rty, aty)) false in + let dest_name = make_defV repname (Narrow(aty, rty)) false in + + Nptyintro(rty, aty, mk_name, dest_name, term2nterm pt), il + | Pspec(p,t) -> + let p', res = wp il p in + Npspec(p', term2nterm t), res + | Pinst(p,theta) -> + let p', res = wp il p in + Npinst(p', List.map ( + fun (s,ty,te) -> + let typ = hol_type2ntype ty in + (make_idV s typ, typ, term2nterm te) + ) theta), res + | Pgen(p,x,ty) -> + let p', res = wp il p in + let typ = hol_type2ntype ty in + Npgen(p', make_idV x typ, typ), res + | Psym p -> + let p', res = wp il p in + Npsym p', res + | Ptrans(p1,p2) -> + let p1', il' = wp il p1 in + let p2', res = wp il' p2 in + Nptrans(p1', p2'), res + | Pcomb(p1,p2) -> + let p1', il' = wp il p1 in + let p2', res = wp il' p2 in + Npcomb(p1', p2'), res + | Peqmp(p1,p2) -> + let p1', il' = wp il p1 in + let p2', res = wp il' p2 in + Npeqmp(p1', p2'), res + | Pexists(p,ex,w) -> + let p', res = wp il p in + Npexists(p', term2nterm ex, term2nterm w), res + | Pchoose(x,ty,p1,p2) -> + let p1', il' = wp il p1 in + let p2', res = wp il' p2 in + let typ = hol_type2ntype ty in + Npchoose(make_idV x typ, typ, p1', p2'), res + | Pconj(p1,p2) -> + let p1', il' = wp il p1 in + let p2', res = wp il' p2 in + Npconj(p1', p2'), res + | Pimpas(p1,p2) -> + let p1', il' = wp il p1 in + let p2', res = wp il' p2 in + Npimpas(p1', p2'), res + | Pconjunct1 p -> + let p', res = wp il p in + Npconjunct1 p', res + | Pconjunct2 p -> + let p', res = wp il p in + Npconjunct2 p', res + | Pdisj1(p,tm) -> + let p', res = wp il p in + Npdisj1(p', term2nterm tm), res + | Pdisj2(p,tm) -> + let p', res = wp il p in + Npdisj2(p', term2nterm tm), res + | Pdisjcases(p1,p2,p3) -> + let p1', il' = wp il p1 in + let p2', il'' = wp il' p2 in + let p3', res = wp il'' p3 in + Npdisjcases(p1', p2', p3'), res + | Pnoti p -> + let p', res = wp il p in + Npnoti p', res + | Pnote p -> + let p', res = wp il p in + Npnote p', res + | Pcontr(p,tm) -> + let p', res = wp il p in + Npcontr(p', term2nterm tm), res + + and wp il p = + match share_info_of p il with + | Some(_, thmname, il') -> wdi thmname, il' + | None -> wp' il (content_of p) in + + match disk_info_of p with + | Some(_, thmname') -> if thmname' = thmname then wp' il (content_of p) else (wdi thmname', il) + | None -> wp' il (content_of p) in + + let p', il = write_proof p il in + set_disk_info_of p THEORY_NAME thmname; + Hashtbl.add proof_of_thm thmname p'; + make_dependencies_aux dep_graph proof_of_thm il;; + + + let make_dependencies out out_share out_sharet new_file count_thms path ((thmname, pr, _) as p) = + + let dep_graph = Depgraph.Dep.create () in + let proof_of_thm = Hashtbl.create (references pr) in + Depgraph.Dep.add_thm dep_graph thmname; + + make_dependencies_aux dep_graph proof_of_thm [p]; + + let share_type ty = share_types out_sharet ty in + let share_term ty = share_terms out_share out_sharet ty in + + + if thmname = (THEORY_NAME^"_DEF_T") then ( + match content_of pr with + | Pdef (_, _, t) -> + let tm = hequiv htrue (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_T" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__slash__backslash_") then ( + match content_of pr with + | Pdef (_, _, t) -> + let tm = heq (Narrow (Nbool, Narrow (Nbool, Nbool))) (Ncst Hand) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_AND" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__equal__equal__greaterthan_") then ( + match content_of pr with + | Pdef (_, _, t) -> + let tm = heq (Narrow (Nbool, Narrow (Nbool, Nbool))) (Ncst Himp) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_IMP" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__exclamationmark_") then ( + match content_of pr with + | Pdef (_, a, t) -> + let a2 = hol_type2ntype a in + (match a2 with + | Narrow (Narrow (b, _), _) -> + let tm = heq a2 (Ncst (Hforall b)) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_FORALL" thmname; + export_sig out thmname + | _ -> ()) + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__questionmark_") then ( + match content_of pr with + | Pdef (_, a, t) -> + let a2 = hol_type2ntype a in + (match a2 with + | Narrow (Narrow (b, _), _) -> + let tm = heq a2 (Ncst (Hexists b)) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_EXISTS" thmname; + export_sig out thmname + | _ -> ()) + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__backslash__slash_") then ( + match content_of pr with + | Pdef (_, _, t) -> + let tm = heq (Narrow (Nbool, Narrow (Nbool, Nbool))) (Ncst Hor) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_OR" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF_F") then ( + match content_of pr with + | Pdef (_, _, t) -> + let tm = hequiv (Ncst Hfalse) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_F" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__tilde_") then ( + match content_of pr with + | Pdef(_, _, t) -> + let tm = heq (Narrow (Nbool, Nbool)) (Ncst Hnot) (term2nterm t) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "DEF_NOT" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_DEF__FALSITY_") then ( + let tm = heq Nbool (Ncst Hfalse) (Ncst Hfalse) in + Hashtbl.add derivs thmname (hyp_empty, tm); + export_ht out share_term hyp_empty tm thmname; + export_lemma_def out "(Prefl (Cst Hfalse))" thmname; + export_sig out thmname + ) else if thmname = (THEORY_NAME^"_ax__1") then ( + match content_of pr with + | Paxm (_, tm) -> + let tm2 = term2nterm tm in + Hashtbl.add derivs thmname (hyp_empty, tm2); + export_ht out share_term hyp_empty tm2 thmname; + export_lemma_def out "ETA_AX" thmname; + export_sig out thmname + | _ -> () + ) else if thmname = (THEORY_NAME^"_ax__2") then ( + match content_of pr with + | Paxm (_, tm) -> + let tm2 = term2nterm tm in + Hashtbl.add derivs thmname (hyp_empty, tm2); + export_ht out share_term hyp_empty tm2 thmname; + export_lemma_def out "SELECT_AX" thmname; + export_sig out thmname + | _ -> () + + ) else ( + + Depgraph.Dep_top.iter_top ( + fun thm -> + incr count_thms; + if !count_thms = 1000 then (count_thms := 0; new_file ()); + (try + let p = Hashtbl.find proof_of_thm thm in + (match proof2deriv p with + | Some (h, t) -> + Hashtbl.add derivs thm (h, t); + export_ht out share_term h t thm; + (match p with + | Npdef _ -> export_def out thm + | Nptyintro _ -> export_tdef out thm + | Npaxm _ -> export_axiom out thm + | _ -> export_lemma out share_type share_term p thm); + export_sig out thm + | None -> failwith ("Erreur make_dependencies "^thm^" de "^thmname^": no derivation associated to the proof\n")) + with | Not_found -> failwith ("Erreur make_dependencies "^thm^": proof_of_thm not found\n")); + ) dep_graph + ); +;; + + + let the_proof_database = ref ([]:(string*proof*(term option)) list);; + + Random.self_init;; + + let rec search_proof_name n db = + match db with [] -> n | ((m, _, _)::db') -> if n=m then n^"_"^(string_of_int (Random.int 1073741823)) else search_proof_name n db' + + let save_proof name p c_opt = + let name' = search_proof_name name (!the_proof_database) in + the_proof_database := (name', p, c_opt)::(!the_proof_database);; + + let proof_database () = !the_proof_database;; + + + (* Utilities to define Coq interpretation functions *) + + let ut = Hashtbl.create 17;; + + let ask_ut () = + try ( + let filein = Pervasives.open_in "interpretation.txt" in + let line = ref 0 in + + try + while true do + incr line; + let s1 = input_line filein in + incr line; + let s2 = input_line filein in + Hashtbl.add ut s1 s2 + done + with + | End_of_file -> close_in filein + | _ -> failwith ("Error line "^(string_of_int !line)^".") + ) with | Sys_error _ -> () + ;; + + let tc_regexp = Str.regexp "\?[0-9]*";; + + let make_tc_parameter out x n = + if Str.string_match tc_regexp x 0 then ( + let i = Str.match_end () in + if i <> String.length x then ( + out "\nParameter "; out THEORY_NAME; out "_idT_"; out (mfc x); out " : Type.\nParameter "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); + out " : "; out THEORY_NAME; out "_idT_"; out (mfc x); out "." + ) + ) else ( + out "\nParameter "; out THEORY_NAME; out "_idT_"; out (mfc x); out " : Type.\nParameter "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); + out " : "; out THEORY_NAME; out "_idT_"; out (mfc x); out "." + );; + + let make_tc_list out x n = + if Str.string_match tc_regexp x 0 then ( + let i = Str.match_end () in + if i <> String.length x then ( + out "\n("; out (string_of_int n); out ", mkTT "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); out ")::" + ) + ) else ( + out "\n("; out (string_of_int n); out ", mkTT "; out THEORY_NAME; out "_idT_inhab_"; out (mfc x); out ")::" + );; + + + let defT_ut = Hashtbl.create 17;; + + let make_tdt_parameter out x _ = + try ( + let y = Hashtbl.find ut x in + Hashtbl.add defT_ut x y + ) with | Not_found -> ( + out "\nParameter "; out THEORY_NAME; out "_defT_"; out (mfc x); out " : Type."; + out "\nParameter "; out THEORY_NAME; out "_defT_inhab_"; out (mfc x); out " : "; out THEORY_NAME; out "_defT_"; out (mfc x); out ".\n"; + Hashtbl.add defT_ut x ("fun _ => mkTT "^THEORY_NAME^"_defT_inhab_"^(mfc x)) + );; + + let make_tdt_list out x n = + try ( + let s = Hashtbl.find defT_ut x in + out "\n("; out (string_of_int n); out ", "; out s; out ")::"; + ) with | Not_found -> ( + out "\n("; out (string_of_int n); out ", fun _ => mkTT tt)::" + );; + + + let se_regexp = Str.regexp "_[0-9]*";; + + let make_se_parameter out x (_,ty) = + if Str.string_match se_regexp x 0 then ( + let i = Str.match_end () in + if i <> String.length x then ( + out "\nParameter "; out THEORY_NAME; out "_idV_"; out (mfc x); out " : tr_type tc tdt "; print_type out ty; out "." + ) + ) else ( + out "\nParameter "; out THEORY_NAME; out "_idV_"; out (mfc x); out " : tr_type tc tdt "; print_type out ty; out "." + );; + + let make_se_list out x (n,ty) = + if Str.string_match se_regexp x 0 then ( + let i = Str.match_end () in + if i <> String.length x then ( + out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " "; out THEORY_NAME; out "_idV_"; out (mfc x); out ")::" + ) + ) else ( + out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " "; out THEORY_NAME; out "_idV_"; out (mfc x); out ")::" + );; + + + let defV_ut = Hashtbl.create 17;; + + let make_sdt_parameter out x (_,ty,_) = + if ((x <> "T") && (x <> "/\\") && (x <> "==>") && (x <> "!") && (x <> "?") && (x <> "\\/") && (x <> "F") && (x <> "~") && (x <> "_FALSITY_")) then ( + try ( + let y = Hashtbl.find ut x in + Hashtbl.add defV_ut x y + ) with | Not_found -> ( + out "\nParameter "; out THEORY_NAME; out "_defV_"; out (mfc x); out " : tr_type tc tdt "; print_type out ty; out "." + ) + );; + + let make_sdt_list out x (n,ty,_) = + try ( + let s = Hashtbl.find defV_ut x in + out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " ("; out s; out "))::" + ) with | Not_found -> ( + if ((x <> "T") && (x <> "/\\") && (x <> "==>") && (x <> "!") && (x <> "?") && (x <> "\\/") && (x <> "F") && (x <> "~") && (x <> "_FALSITY_")) then ( + out "\n("; print_names out n; out ", existT (fun (t: type) => tr_type tc tdt t) "; print_type out ty; out " "; out THEORY_NAME; out "_defV_"; out (mfc x); out ")::" + ) + );; + + + (* Main function: list of proofs exportation *) + + let export_list thmname_list = + + total := 0; + + let path = ensure_export_directory THEORY_NAME in + + + let rec proof_of_thm acc acc2 = function + | [] -> acc, acc2 + | (s,p,c)::q -> + if List.mem s thmname_list then + proof_of_thm ((THEORY_NAME^"_"^(mfc s), reset_disk_info_of1 p, c)::acc) (acc2+1) q + else match content_of p with + | Paxm _ | Pdef _ | Ptyintro _ -> proof_of_thm ((THEORY_NAME^"_"^(mfc s), reset_disk_info_of1 p, c)::acc) (acc2+1) q + | _ -> proof_of_thm acc acc2 q in + + let l, total_thms = proof_of_thm [] 0 (proof_database ()) in + + + let count_thms = ref 0 in + let count_files = ref 1 in + + (* Main file *) + + let file = ref (open_out (Filename.concat path (THEORY_NAME^"_1.v"))) in + let count_file = ref 0 in + let out s = (output_string !file s; incr count_file; if !count_file = 1000 then (count_file := 0; flush !file)) in + out "(*** This file has been automatically generated from HOL-Light source files. ***)\n\nRequire Export List NArith.\nRequire Export hol deriv proof.\n\n"; + + (* Temporary file *) + + let (file_temp_name, file_temp_aux) = Filename.open_temp_file (THEORY_NAME^"_") ".v" in + let file_temp = ref file_temp_aux in + let count_file_temp = ref 0 in + let out_temp s = (output_string !file_temp s; incr count_file_temp; if !count_file_temp = 1000 then (count_file_temp := 0; flush !file_temp)) in + + + let move_temp () = + (try + close_out !file_temp + with | Sys_error s -> raise (Sys_error ("move_temp1: "^s))); + + (try + let buf = Pervasives.open_in file_temp_name in + (try + while true do + out "\n"; + let l = input_line buf in + out l + done + with | End_of_file -> close_in buf) + with | Sys_error s -> raise (Sys_error ("move_temp3: "^s))) in + + + (* New file *) + + let new_file () = + + move_temp (); + file_temp := open_out file_temp_name; + + incr count_files; + close_out !file; + file := open_out (Filename.concat path (THEORY_NAME^"_"^(string_of_int !count_files)^".v")); + out "(*** This file has been automatically generated from HOL-Light source files. ***)\n\nRequire Export "; out THEORY_NAME; out "_"; out (string_of_int (!count_files-1)); out ".\n\n" in + + + (* Coq files generation *) + + let date1 = Unix.time () in + List.iter (make_dependencies out_temp out out new_file count_thms path) l; + let date2 = Unix.time () in + + + move_temp (); close_out !file; + + + (* Makefile *) + + let make = open_out (Filename.concat path "Makefile") in + let out = output_string make in + out "# This file has been automatically generated from HOL-Light source files.\n\nCOQ=ssrcoq\nFLAGS=-dont-load-proofs -dump-glob /dev/null -compile\n\nSRC="; + for i = 1 to !count_files do + out " "; out THEORY_NAME; out "_"; out (string_of_int i); out ".v"; + done; + out "\nOBJ=$(SRC:.v=.vo)\nGLOB=$(SRC:.v=.glob)\n\n\nall: $(OBJ)\n\n\n%.vo: %.v\n\t$(COQ) $(FLAGS) $(^:.v=)\n\n\nclean:\n\trm -f $(OBJ) $(GLOB) *~"; + close_out make; + + + (* Interpretation *) + + let interp = open_out (Filename.concat path "interpretation.v") in + let out = output_string interp in + out "(*** This file has been automatically generated from HOL-Light source files. ***)\n\nRequire Import ssreflect eqtype ssrnat ssrbool.\nRequire Import List NArith ZArith.ZOdiv_def.\nRequire Import hol cast typing translation axioms.\n\nOpen Local Scope positive_scope.\n\n"; + + ask_ut (); + + (* tc *) + Hashtbl.iter (make_tc_parameter out) idT; + out "\n\nDefinition tc_list :="; + Hashtbl.iter (make_tc_list out) idT; + out "\nnil.\n\nDefinition tc := list_tc2tc tc_list.\n\n"; + + (* tdt *) + Hashtbl.iter (make_tdt_parameter out) defT; + out "\n\nDefinition tdt_list : list_tdt :="; + Hashtbl.iter (make_tdt_list out) defT; + out "\nnil.\n\nDefinition tdt := list_tdt2tdt tdt_list.\n\n"; + + (* se *) + Hashtbl.iter (make_se_parameter out) idV; + out "\n\nDefinition se_list :="; + Hashtbl.iter (make_se_list out) idV; + out "\nnil.\n\nDefinition se := list_se2se se_list.\n\n"; + + (* sdt *) + Hashtbl.iter (make_sdt_parameter out) defV; + out "\n\nDefinition sdt_list :="; + Hashtbl.iter (make_sdt_list out) defV; + out "\nnil.\n\nDefinition sdt := list_sdt2sdt sdt_list."; + + close_out interp; + + + print_string "Generated "; print_int !total; print_string " facts for "; print_int total_thms; print_string " theorems.\n"; + print_string "Exportation duration: "; print_float (date2 -. date1); print_string "s.\n" + ;; + + + (* Main function: all proofs exportation *) + + let export_saved_proofs () = export_list (List.map (fun (s,_,_) -> s) (proof_database ()));; + + + (* Main function: one proof exportation *) + + let export_one_proof name = export_list [name];; + + +end;; + + +include Proofobjects;; diff --git a/Proofrecording/diffs/proofobjects_dummy.ml b/Proofrecording/diffs/proofobjects_dummy.ml new file mode 100644 index 0000000..db7751a --- /dev/null +++ b/Proofrecording/diffs/proofobjects_dummy.ml @@ -0,0 +1,101 @@ +(* ========================================================================= *) +(* Proof-objects for HOL-light *) +(* *) +(* Steven Obua, TU München, December 2004 *) +(* *) +(* based on Sebastian Skalberg's HOL4 proof-objects *) +(* *) +(* dummy proof objects, is used when proof objects are switched off, *) +(* the real thing can be found in proofobjects_trt.ml *) +(* ========================================================================= *) + +module type Proofobject_primitives = + sig + + type proof + + val proof_REFL : term -> proof + val proof_TRANS : proof * proof -> proof + val proof_MK_COMB : proof * proof -> proof + val proof_ASSUME : term -> proof + val proof_EQ_MP : proof -> proof -> proof + val proof_IMPAS : proof -> proof -> proof + val proof_DISCH : proof -> term -> proof + val proof_DEDUCT_ANTISYM_RULE : proof * term -> proof * term -> proof + val proof_BETA : term -> proof + val proof_ABS : term -> proof -> proof + val proof_INST_TYPE : (hol_type * hol_type) list -> proof -> proof + val proof_INST : (term * term) list -> proof -> proof + val proof_new_definition : string -> hol_type -> term -> proof + val proof_CONJ : proof -> proof -> proof + val proof_CONJUNCT1 : proof -> proof + val proof_CONJUNCT2 : proof -> proof + val proof_new_basic_type_definition : + string -> string * string -> term * term -> proof -> proof + val proof_SPEC : term -> proof -> proof + val proof_SYM : proof -> proof + val proof_GEN : proof -> term -> proof + val proof_DISJ1 : proof -> term -> proof + val proof_DISJ2 : proof -> term -> proof + val proof_NOTI : proof -> proof + val proof_NOTE : proof -> proof + val proof_CONTR : proof -> term -> proof + val proof_DISJCASES : proof -> proof -> proof -> proof + val proof_CHOOSE : term -> proof -> proof -> proof + val proof_EXISTS : term -> term -> proof -> proof + + val new_axiom_name : string -> string + val proof_new_axiom : string -> term -> proof + + val save_proof : string -> proof -> (term option) -> unit + val proof_database : unit -> ((string * proof * (term option)) list) + + val export_proofs : string option -> (string * proof * (term option)) list -> unit + val export_saved_proofs : string option -> unit + +end;; + +module Proofobjects : Proofobject_primitives = struct + + type proof = unit -> unit + + let dummy () x = x;; + + let proof_REFL _ = dummy () + let proof_TRANS _ = dummy () + let proof_MK_COMB _ = dummy () + let proof_ASSUME _ = dummy () + let proof_EQ_MP _ _ = dummy () + let proof_IMPAS _ _ = dummy () + let proof_DISCH _ _ = dummy () + let proof_DEDUCT_ANTISYM_RULE _ _ = dummy () + let proof_BETA _ = dummy () + let proof_ABS _ _ = dummy () + let proof_INST_TYPE _ _ = dummy () + let proof_INST _ _ = dummy () + let proof_new_definition _ _ _ = dummy () + let proof_CONJ _ _ = dummy () + let proof_CONJUNCT1 _ = dummy () + let proof_CONJUNCT2 _ = dummy () + let proof_new_basic_type_definition _ _ _ _ = dummy () + let proof_SPEC _ _ = dummy () + let proof_SYM _ = dummy () + let proof_GEN _ _ = dummy () + let proof_DISJ1 _ _ = dummy () + let proof_DISJ2 _ _ = dummy () + let proof_NOTI _ = dummy () + let proof_NOTE _ = dummy () + let proof_CONTR _ _ = dummy () + let proof_DISJCASES _ _ _ = dummy () + let proof_CHOOSE _ _ _ = dummy () + let proof_EXISTS _ _ _ = dummy () + let new_axiom_name _ = "" + let proof_new_axiom _ _ = dummy () + let save_proof _ _ _ = () + let proof_database _ = [] + let export_proofs _ _ = () + let export_saved_proofs _ = () + +end;; + +include Proofobjects;; diff --git a/Proofrecording/diffs/proofobjects_init.ml b/Proofrecording/diffs/proofobjects_init.ml new file mode 100644 index 0000000..d7df535 --- /dev/null +++ b/Proofrecording/diffs/proofobjects_init.ml @@ -0,0 +1,21 @@ +let (use_proofobjects, use_extended_proofobjects, use_coq) = + try + let n = Sys.getenv "HOLPROOFOBJECTS" in + if n = "BASIC" then + (true, false, false) + else if n = "EXTENDED" then + (true, true, false) + else if n = "COQ" then + (true, true, true) + else + (false, false, false) + with Not_found -> (false, false, false);; + +let _ = + if use_proofobjects then + if use_coq then + loads "proofobjects_coq.ml" + else + loads "proofobjects_trt.ml" + else + loads "proofobjects_dummy.ml";; diff --git a/Proofrecording/diffs/proofobjects_trt.ml b/Proofrecording/diffs/proofobjects_trt.ml new file mode 100644 index 0000000..f523454 --- /dev/null +++ b/Proofrecording/diffs/proofobjects_trt.ml @@ -0,0 +1,888 @@ +(* ========================================================================= *) +(* Proof-objects for HOL-light *) +(* *) +(* Steven Obua, TU München, December 2004 *) +(* *) +(* based on Sebastian Skalberg's HOL4 proof-objects *) +(* ========================================================================= *) + +#load "unix.cma";; + +module type Proofobject_primitives = + sig + + type proof + + val proof_REFL : term -> proof + val proof_TRANS : proof * proof -> proof + val proof_MK_COMB : proof * proof -> proof + val proof_ASSUME : term -> proof + val proof_EQ_MP : proof -> proof -> proof + val proof_IMPAS : proof -> proof -> proof + val proof_DISCH : proof -> term -> proof + val proof_DEDUCT_ANTISYM_RULE : proof * term -> proof * term -> proof + val proof_BETA : term -> proof + val proof_ABS : term -> proof -> proof + val proof_INST_TYPE : (hol_type * hol_type) list -> proof -> proof + val proof_INST : (term * term) list -> proof -> proof + val proof_new_definition : string -> hol_type -> term -> proof + val proof_CONJ : proof -> proof -> proof + val proof_CONJUNCT1 : proof -> proof + val proof_CONJUNCT2 : proof -> proof + val proof_new_basic_type_definition : + string -> string * string -> term * term -> proof -> proof + val proof_SPEC : term -> proof -> proof + val proof_SYM : proof -> proof + val proof_GEN : proof -> term -> proof + val proof_DISJ1 : proof -> term -> proof + val proof_DISJ2 : proof -> term -> proof + val proof_NOTI : proof -> proof + val proof_NOTE : proof -> proof + val proof_CONTR : proof -> term -> proof + val proof_DISJCASES : proof -> proof -> proof -> proof + val proof_CHOOSE : term -> proof -> proof -> proof + val proof_EXISTS : term -> term -> proof -> proof + + val new_axiom_name : string -> string + val proof_new_axiom : string -> term -> proof + + val save_proof : string -> proof -> (term option) -> unit + val proof_database : unit -> ((string * proof * (term option)) list) + + val export_proofs : string option -> (string * proof * (term option)) list -> unit + val export_saved_proofs : string option -> unit +end;; + +module Proofobjects : Proofobject_primitives = struct + + let writeln s p = p;; +(* let q = s^"\n" in + (output stdout q 0 (String.length q); p);;*) + + type tag = string + + type proof_info_rec = + {disk_info: (string * string) option ref; + status: int ref; + references: int ref; + queued: bool ref} + + type proof_info = Info of proof_info_rec + + type ('a, 'b) libsubst_rec = {redex:'a; residue:'b} + type ('a, 'b) libsubst = (('a,'b) libsubst_rec) list + + let pair2libsubstrec = + fun (a,b) -> {redex=b;residue=a} + +(* note: not all of the proof_content constructors are actually used, some are just legacy from the HOL4 proof objects *) + type proof = + Proof of (proof_info * proof_content * (unit -> unit)) + and proof_content = + Prefl of term + | Pinstt of proof * ((hol_type,hol_type) libsubst) + | Psubst of proof list * term * proof + | Pabs of proof * term + | Pdisch of proof * term + | Pmp of proof * proof + | Phyp of term + | Paxm of string * term + | Pdef of string * string * term + | Ptmspec of string * string list * proof + | Ptydef of string * string * proof + | Ptyintro of string * string * string * string * term * term * proof + | Poracle of tag * term list * term + | Pdisk + | Pspec of proof * term + | Pinst of proof * (term,term) libsubst + | Pgen of proof * term + | Pgenabs of proof * term option * term list + | Psym of proof + | Ptrans of proof * proof + | Pcomb of proof * proof + | Peqmp of proof * proof + | Peqimp of proof + | Pexists of proof * term * term + | Pchoose of term * proof * proof + | Pconj of proof * proof + | Pconjunct1 of proof + | Pconjunct2 of proof + | Pdisj1 of proof * term + | Pdisj2 of proof * term + | Pdisjcases of proof * proof * proof + | Pnoti of proof + | Pnote of proof + | Pcontr of proof * term + | Pimpas of proof * proof + + let THEORY_NAME = "hollight" + + let content_of (Proof (_,p,_)) = p + + let inc_references (Proof(Info{references=r},_,_) as p) = ( + let + old = !r + in + r := old + 1; + p) + + let concat = String.concat "" + + let dummy_fun () = () + + let mk_proof p = Proof(Info {disk_info = ref None; status = ref 0; references = ref 0; queued = ref false},p, dummy_fun) + + let global_ax_counter = let counter = ref 1 in let f = fun () -> (let x = !counter in counter := !counter+1; x) in f + + let new_axiom_name n = concat["ax_"; n; "_"; string_of_int(global_ax_counter())] + + let proof_REFL t = writeln "REFL" (mk_proof (Prefl t)) + + let proof_TRANS (p,q) = writeln "TRANS" ( + match (content_of p, content_of q) with + (Prefl _,_) -> q + | (_, Prefl _) -> p + | _ -> mk_proof (Ptrans (inc_references p, inc_references q))) + + let proof_MK_COMB (p1,p2) = writeln "MK_COMB" ( + (match (content_of p1, content_of p2) with + (Prefl tm1, Prefl tm2) -> proof_REFL (mk_comb (tm1, tm2)) + | _ -> mk_proof (Pcomb (inc_references p1, inc_references p2)))) + + let proof_ASSUME t = writeln "ASSUME "(mk_proof (Phyp t)) + + let proof_EQ_MP p q = writeln "EQ_MP" ( + (match content_of p with + Prefl _ -> q + | _ -> mk_proof (Peqmp(inc_references p, inc_references q)))) + + let proof_IMPAS p1 p2 = writeln "IMPAS" ( + mk_proof (Pimpas (inc_references p1, inc_references p2))) + + let proof_DISCH p t = writeln "DISCH" (mk_proof (Pdisch(inc_references p,t))) + + let proof_DEDUCT_ANTISYM_RULE (p1,t1) (p2,t2) = writeln "DEDUCT_ANTISYM_RULE" ( + proof_IMPAS (proof_DISCH p1 t2) (proof_DISCH p2 t1)) + + let proof_BETA t = writeln "BETA" (mk_proof (Prefl t)) + + let proof_ABS x p = writeln "ABS" ( + (match (content_of p) with + Prefl tm -> proof_REFL (mk_abs(x,tm)) + | _ -> mk_proof (Pabs(inc_references p,x)))) + + let proof_INST_TYPE s p = writeln "INST_TYPE" (mk_proof (Pinstt(inc_references p, map pair2libsubstrec s))) + + let proof_INST s p = writeln "INST" (mk_proof (Pinst(inc_references p, map pair2libsubstrec s))) + + let proof_new_definition cname _ t = writeln "new_definition" (mk_proof (Pdef (THEORY_NAME, cname, t))) + + let proof_new_axiom axname t = writeln "new_axiom" (mk_proof (Paxm (axname, t))) + + let proof_CONJ p1 p2 = writeln "CONJ" (mk_proof (Pconj (inc_references p1, inc_references p2))) + + let proof_CONJUNCT1 p = writeln "CONJUNCT1" (mk_proof (Pconjunct1 (inc_references p))) + + let proof_CONJUNCT2 p = writeln "CONJUNCT2" (mk_proof (Pconjunct2 (inc_references p))) + + let proof_new_basic_type_definition tyname (absname, repname) (pt,tt) p = writeln "new_basic_type_definition" ( + mk_proof(Ptyintro (THEORY_NAME, tyname, absname, repname, pt, tt,inc_references p))) + +(* ---- used only in substitute_proof calls ---- *) + + let proof_SPEC s p = writeln "SPEC" (mk_proof (Pspec(inc_references p, s))) + + let proof_SYM p = writeln "SYM" (mk_proof (Psym(inc_references p))) + + let proof_GEN p a = writeln "GEN" (mk_proof (Pgen(inc_references p, a))) + + let proof_DISJ1 p a = writeln "DISJ1" (mk_proof (Pdisj1 (inc_references p, a))) + + let proof_DISJ2 p a = writeln "DISJ2" (mk_proof (Pdisj2 (inc_references p, a))) + + let proof_NOTI p = writeln "NOTI" (mk_proof (Pnoti (inc_references p))) + + let proof_NOTE p = writeln "NOTE" (mk_proof (Pnote (inc_references p))) + + let proof_CONTR p a = writeln "CONTR" (mk_proof (Pcontr (inc_references p, a))) + + let proof_DISJCASES p q r = writeln "DISJCASES" (mk_proof (Pdisjcases (inc_references p, inc_references q, inc_references r))) + + let proof_CHOOSE a p q = writeln "CHOOSE" (mk_proof (Pchoose (a, inc_references p, inc_references q))) + + let proof_EXISTS x y p = writeln "EXISTS" (mk_proof (Pexists (inc_references p, x, y))) + +(* ---- formerly known as proofio.ml ---- *) + +let ensure_export_directory thyname = + let dir = Sys.getenv "HOLPROOFEXPORTDIR" in + let dirsub = Filename.concat dir "hollight" in + let dirsubsub = Filename.concat dirsub thyname in + let mk d = if Sys.file_exists d then () else Unix.mkdir d 509 + in + (mk dir; + mk dirsub; + mk dirsubsub; + dirsubsub);; + +(* ---- Useful functions on terms ---- *) +let rec types_of tm = + if is_var tm + then [type_of tm] + else if is_const tm + then [type_of tm] + else if is_comb tm + then + let + (f,a) = dest_comb tm + in + union (types_of f) (types_of a) + else + let + (x,a) = dest_abs tm + in + insert (type_of x) (types_of a);; + +let beta_conv tm = + try let (f,arg) = dest_comb tm in + let (v,bod) = dest_abs f in + vsubst [(arg,v)] bod + with Failure _ -> failwith "beta_conv: Not a beta-redex";; + +let eta_conv tm = + try + (let (v, bod) = dest_abs tm in + let (f, arg) = dest_comb bod in + if (arg = v && (not(vfree_in v f))) then + f + else failwith "") + with + Failure _ -> failwith "eta_conv: Not an eta-redex";; + +let rec be_contract tm = + let rec bec tm = try try Some (beta_conv tm) + with Failure _ -> + Some (eta_conv tm) + with Failure _ -> + if is_comb tm + then + (let + (f,x) = dest_comb tm + in + match bec f with + Some f' -> Some (mk_comb(f',x)) + | None -> (match bec x with + Some x' -> Some (mk_comb(f,x')) + | None -> None)) + else if is_abs tm + then + (let + (x,body) = dest_abs tm + in + (match bec body with + Some body' -> Some (mk_abs(x,body')) + | None -> None)) + else None + in + (match bec tm with + Some tm' -> be_contract tm' + | None -> tm);; + +let rec polymorphic x = + if is_vartype x then true else exists polymorphic (snd (dest_type x)) + +(* ---- From Lib etc. ---- *) + + +let rec append = fun xlist l -> + (match xlist with + [] -> l + | (x::xs) -> x::(append xs l));; + +let assoc1 item = + let rec assc = + (function (((key,_) as e)::rst) -> if item=key then Some e else assc rst + | [] -> None) + in + assc;; + + +let rec listconcat = + function [] -> [] + | (l::ls) -> append l (listconcat ls);; + +let listnull = + function [] -> true | _ -> false;; + +(* ---- exported ---- *) +let encodeXMLEntities m = m;;let encodeXMLEntities s = + let len = String.length s in + let encodeChar = function '<' -> "<" | '>' -> ">" | '&' -> "&" | '\'' -> "'" | '"' -> """ | c -> String.make 1 c in + let rec encodeStr i = if (i out (encodeXMLEntities x);; + + +let content_of (Proof (_,x,_)) = x;; + +let rec explode_subst = + function [] -> [] + | ({redex=x;residue=y}::rest) -> x::y::(explode_subst rest);; + +let rec app f = + function [] -> () + | (x::l) -> (f x; app f l);; + +let disk_info_of (Proof(Info {disk_info=di},_,_)) = !di;; + +let set_disk_info_of (Proof(Info {disk_info=di},_,_)) thyname thmname = + di := Some (thyname,thmname);; + +let references (Proof (Info info,_,_)) = !(info.references);; + +let wrap b e s = b^s^e;; + +let xml_empty_tag = wrap "<" "/>";; +let xml_start_tag = wrap "<" ">";; +let xml_end_tag = wrap "";; +let xml_attr attr = + itlist (function (tag,v) -> + function s -> + concat[" ";tag;"=\"";v;"\"";s] + ) + attr "";; +let xml_element tag attr children = + let + header = tag ^ (xml_attr attr) + in + (if listnull children + then xml_empty_tag header + else wrap (xml_start_tag header) (xml_end_tag tag) (concat children));; + +let id_to_atts curthy id = [("n", encodeXMLEntities id)];; (* There is only one theory in Hol-Light, therefore id_to_atts is superfluous *) + +let glob_counter = ref 1;; + +let get_counter () = + let + res = !glob_counter + in + glob_counter := res + 1; + res;; + +let get_iname = string_of_int o get_counter;; + +let next_counter () = !glob_counter;; + +let trivial p = + match (content_of p) with + Prefl _ -> true + | Paxm _ -> true + | Pdisk -> true + | Phyp _ -> true + | Poracle _ -> true + | _ -> false;; + +let do_share p = references p > 1 & not (trivial p);; + +exception Err of string*string;; + +(* ---- The General List Formerly Known As Net ---- *) + +type 'a exprnet = (('a list) ref) * ('a -> ('a list)) + +let empty_net f () = (ref [], f);; + +let rec lookup'_net net x = + match net with + [] -> raise Not_found + | (a::l) -> if (a = x) then 0 else 1+(lookup'_net l x);; + +let lookup_net (net,f) x = lookup'_net (!net) x;; + +let insert'_net (net,f) x = + try lookup'_net !net x; () with Not_found -> ((net := (!net)@[x]);());; + +let rec insert_net ((net,f) as n) x = + (app (insert_net n) (f x); insert'_net n x);; + +let to_list_net (net,f) = !net;; + +(* ---- The Type Net (it's not a net any more!) ---- *) + +type yy_net = hol_type exprnet;; + +let yy_empty = empty_net (function x -> if is_type x then snd (dest_type x) else []);; + +let yy_lookup = lookup_net;; + +let yy_output_types out thyname net = + let + all_types = to_list_net net in let rec + xml_index ty = xml_element "tyi" [("i",string_of_int (yy_lookup net ty))] [] + and xml_const id = xml_element "tyc" (id_to_atts thyname id) [] + and out_type ty = + if is_vartype ty then out (xml_element "tyv" [("n",encodeXMLEntities (dest_vartype ty))] []) + else ( + match dest_type ty with + (id, []) -> out (xml_const id) + | (id, tl) -> out (xml_element "tya" [] ((xml_const id)::(map xml_index tl))) + ) + in + out ""; + app out_type all_types; + out "";; + +let yy_insert = insert_net;; + +(* ---- The Term Net (it's not a net anymore!) ---- *) + +type mm_net = term exprnet;; + +let mm_empty = empty_net ( + function tm -> + if is_abs tm then + (let (x,b) = dest_abs tm in [x; b]) + else if is_comb tm then + (let (s,t) = dest_comb tm in [s; t]) + else + []) + +let mm_lookup net x = lookup_net net (be_contract x);; + +let mm_insert net x = insert_net net (be_contract x);; + +let mm_output_terms out thyname types net = + let all_terms = to_list_net net in + let xml_type ty = xml_element "tyi" [("i",string_of_int (yy_lookup types ty))] [] in + let xml_index tm = xml_element "tmi" [("i",string_of_int (mm_lookup net tm))] [] in + let out_term tm = + if is_var tm + then + let + (name,ty) = dest_var tm + in + out (xml_element "tmv" [("n",encodeXMLEntities name);("t", string_of_int (yy_lookup types ty))] []) + else if is_const tm + then + let (name, ty) = (dest_const tm) in + let general_ty = get_const_type name in + let atts = [("n",encodeXMLEntities name)] + in + if polymorphic general_ty then + out (xml_element "tmc" (atts@[("t",string_of_int (yy_lookup types ty))]) []) + else out (xml_element "tmc" atts []) + else if is_comb tm + then + let + (f,a) = dest_comb tm + in + out (xml_element "tma" [("f", string_of_int (mm_lookup net f));("a",string_of_int (mm_lookup net a))] []) + else + let + (x,a) = dest_abs tm + in + out (xml_element "tml" [("x", string_of_int (mm_lookup net x));("a",string_of_int (mm_lookup net a))] []) + in + out ""; + app out_term all_terms; + out "";; + + +(* ---- collect_types_terms ---- *) + +let collect_types_terms thyname out prf c_opt = + let + will_be_shared prf = ( + match disk_info_of prf with + Some _ -> true + | None -> do_share prf) in let + + types = yy_empty () in let + terms = mm_empty () in let + + insert_type ty = yy_insert types ty in let + + insert_term tm = (mm_insert terms tm; + app (yy_insert types) (types_of tm)) in let rec + + ct' prf = + (match content_of prf with + Pinstt(prf,tsubst) -> (app (function {redex=x;residue=u}->(insert_type x; insert_type u)) + tsubst; + ct prf) + | Psubst(prfs,tm,prf) -> (insert_term tm; + ct prf; + app ct prfs) + | Pabs(prf,tm) -> (insert_term tm; + ct prf) + | Pdisch(prf,tm) -> (insert_term tm; + ct prf) + | Pmp(prf1,prf2) -> (ct prf1; ct prf2) + | Poracle(_,tms,tm) -> (insert_term tm; + app insert_term tms) + | Pdef(_,_,tm) -> insert_term tm + | Ptmspec(_,_,prf) -> ct prf + | Ptydef(_,_,prf) -> ct prf + | Ptyintro(_,_,_,_,pt,tt,prf) -> (insert_term pt; insert_term tt;ct prf) + | Pspec(prf,tm) -> (insert_term tm; ct prf) + | Pinst(prf,subst) -> (app (fun{redex=x;residue=u}->(insert_term x; + insert_term u)) + subst; + ct prf) + | Pgen(prf,tm) -> (insert_term tm; ct prf) + | Pgenabs(prf,tm_opt,tms) -> (match tm_opt with + Some tm -> insert_term tm + | None -> (); + app insert_term tms; + ct prf) + | Psym prf -> ct prf + | Ptrans(prf1,prf2) -> (ct prf1; ct prf2) + | Pcomb(prf1,prf2) -> (ct prf1; ct prf2) + | Peqmp(prf1,prf2) -> (ct prf1; ct prf2) + | Peqimp prf -> ct prf + | Pexists(prf,ex,w) -> (insert_term ex; + insert_term w; + ct prf) + | Pchoose(v,prf1,prf2) -> (insert_term v; ct prf1; ct prf2) + | Pconj(prf1,prf2) -> (ct prf1; ct prf2) + | Pconjunct1 prf -> ct prf + | Pconjunct2 prf -> ct prf + | Pdisj1(prf,tm) -> (insert_term tm; + ct prf) + | Pdisj2(prf,tm) -> (insert_term tm; + ct prf) + | Pdisjcases(prf1,prf2,prf3) -> (ct prf1; ct prf2; ct prf3) + | Pnoti prf -> ct prf + | Pnote prf -> ct prf + | Pcontr(prf,tm) -> (insert_term tm; + ct prf) + | Prefl tm -> insert_term tm + | Phyp tm -> insert_term tm + | Pdisk -> () + | Paxm (_,tm) -> insert_term tm + | Pimpas (prf1,prf2) -> (ct prf1; ct prf2)) + and ct prf = + if will_be_shared prf + then () + else ct' prf in let + + _ = ct' prf in let + _ = (match c_opt with + Some c -> insert_term c + | None -> ()) in let + _ = yy_output_types out thyname types in let + _ = mm_output_terms out thyname types terms + in + (types,terms);; + +let rec export_proof path thyname thmname p c_opt il = + let outchannel = open_out (Filename.concat path (thmname^".prf")) in + let out = output_string outchannel in + let nout = encodeXMLEntitiesOut out in + let + _ = out "" in let + + (types,terms) = collect_types_terms thyname out p c_opt in let + + wti att tm = + (out " "; + out att; + out "=\""; + out (string_of_int (mm_lookup terms tm)); + out "\"") in let + + wt tm = try (out "") with Not_found -> raise (Err("export_proof","Term not found!")) in let + + wty ty = + try (out "") with Not_found -> raise (Err("export_proof","Type not found!")) in let + + wdi thy thm = + (out "") in let + + write_proof p il = + (let rec + share_info_of p il = + (match (disk_info_of p) with + Some (thyname,thmname) -> Some(thyname,thmname,il) + | None -> + if do_share p then + let name = get_iname() in set_disk_info_of p thyname name; Some(thyname,name,(name,p,None)::il) + else + None + ) + and + dump str il prfs = + (let + _ = out (xml_start_tag str) in let + res = rev_itlist (function p -> function il -> wp il p) prfs il in let + _ = out (xml_end_tag str) + in + res) + and + wp' il = + (function + (Prefl tm) -> (out ""; il) + | (Pinstt(p,lambda)) -> + (let + _ = out "" in let + res = wp il p in let + _ = app wty (explode_subst lambda) in let + _ = out "" + in + res) + | (Psubst(ps,t,p)) -> + (let + _ = (out "") in let + il' = wp il p in let + res = rev_itlist (function p -> function il -> wp il p) ps il' in let + _ = out "" + in + res) + | (Pabs(p,t)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pdisch(p,tm)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pmp(p1,p2)) -> dump "pmp" il [p1;p2] + | (Phyp tm) -> (out ""; il) + | (Paxm(name,tm)) -> + (out ""; + il) + | (Pdef(seg,name,tm)) -> + (out ""; + il) + | (Ptmspec(seg,names,p)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = app (function s -> (out "")) names in let + _ = out "" + in + res) + | (Ptydef(seg,name,p)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Ptyintro(seg,name,abs,rep,pt,tt,p)) -> + (let + _ = (out "") in let + + _ = wt pt in let + _ = wt tt in let + res = wp il p in let + _ = out "" + in + res) + | (Poracle(tg,asl,c)) -> raise (Err("export_proof", "sorry, oracle export is not implemented!")) +(* (out ""; + app (function s -> (out "")) (Tag.oracles_of tg); + wt c; + app wt asl; + out ""; + il)*) + | (Pspec(p,t)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pinst(p,theta)) -> + (let + _ = out "" in let + res = wp il p in let + _ = app wt (explode_subst theta) in let + _ = out "" + in + res) + | (Pgen(p,x)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pgenabs(p,opt,vl)) -> + (let + _ = out " wti "i" c + | None -> ()) in let + _ = out ">" in let + res = wp il p in let + _ = app wt vl in let + _ = out "" + in + res) + | (Psym p) -> dump "psym" il [p] + | (Ptrans(p1,p2)) -> dump "ptrans" il [p1;p2] + | (Pcomb(p1,p2)) -> dump "pcomb" il [p1;p2] + | (Peqmp(p1,p2)) -> dump "peqmp" il [p1;p2] + | (Peqimp p) -> dump "peqimp" il [p] + | (Pexists(p,ex,w)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pchoose(v,p1,p2)) -> + (let + _ = (out "") in let + il' = wp il p1 in let + res = wp il' p2 in let + _ = out "" + in + res) + | (Pconj(p1,p2)) -> dump "pconj" il [p1;p2] + | (Pimpas(p1,p2)) -> dump "pimpas" il [p1;p2] + | (Pconjunct1 p) -> dump "pconjunct1" il [p] + | (Pconjunct2 p) -> dump "pconjunct2" il [p] + | (Pdisj1(p,tm)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pdisj2(p,tm)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | (Pdisjcases(p1,p2,p3)) -> dump "pdisjcases" il [p1;p2;p3] + | (Pnoti p) -> dump "pnoti" il [p] + | (Pnote p) -> dump "pnote" il [p] + | (Pcontr(p,tm)) -> + (let + _ = (out "") in let + res = wp il p in let + _ = out "" + in + res) + | Pdisk -> raise (Err("wp'","shouldn't try to write pdisk")) + ) + and wp il p = + (let + res = match (share_info_of p il) with + Some(thyname',thmname,il') -> (wdi thyname' thmname; il') + | None -> wp' il (content_of p) + in res) in let + + res = (match disk_info_of p with + Some(thyname',thmname') -> + if thyname' = thyname & + thmname' = thmname + then + wp' il (content_of p) + else + (wdi thyname' thmname'; + il) + | None -> wp' il (content_of p)) + in res) in let + + il = write_proof p il in let + _ = (match c_opt with + Some c -> wt c + | None -> ()) in let + _ = (out "\n";(close_out outchannel)) in let + _ = set_disk_info_of p thyname thmname + in + match il with + [] -> () (* everything has been written *) + | ((thmname',prf,c_opt)::rest) -> export_proof path thyname thmname' prf c_opt rest;; + +let export_proofs theory_name l' = + let theory_name = match theory_name with None -> THEORY_NAME | Some n -> n in + let path = ensure_export_directory theory_name in + let ostrm = open_out (Filename.concat path "facts.lst") in + let out = output_string ostrm in + let _ = app (function (s,_,_) -> out (s^"\n")) l' in + let _ = flush ostrm in + let _ = + (match l' with + [] -> () + | ((thmname,p,c_opt)::rest) -> export_proof path theory_name thmname p c_opt rest) in + let num_int_thms = next_counter() - 1 in + let _ = out ((string_of_int num_int_thms)^"\n");(close_out ostrm) in + ();; + +let the_proof_database = ref ([]:(string*proof*(term option)) list);; + +exception Duplicate_proof_name;; + +let rec search_proof_name n db = + match db with [] -> () | ((m, a, b)::db') -> if n=m then (raise Duplicate_proof_name) else search_proof_name n db' + +let save_proof name p c_opt = + let _ = search_proof_name name (!the_proof_database) + in + (the_proof_database := + (name, p, c_opt)::(!the_proof_database));; + +let proof_database () = !the_proof_database;; + +(* this is a little bit dangerous, because the function is not injective, + but I guess one can live with that *) +let make_filesystem_compatible s = + let modify = function + | "/" -> "_slash_" + | "\\" -> "_backslash_" + | "=" -> "_equal_" + | ">" -> "_greaterthan_" + | "<" -> "_lessthan_" + | "?" -> "_questionmark_" + | "!" -> "_exclamationmark_" + | "*" -> "_star_" + | s -> s + in + implode (map modify (explode s));; + +let export_saved_proofs thy = + let context = rev (proof_database ()) in + export_proofs thy (map (function (s,p,c) -> (make_filesystem_compatible s,p,c)) context);; + +end;; + +include Proofobjects;; diff --git a/Proofrecording/diffs/tactics.ml b/Proofrecording/diffs/tactics.ml new file mode 100644 index 0000000..439afa7 --- /dev/null +++ b/Proofrecording/diffs/tactics.ml @@ -0,0 +1,869 @@ +(* ========================================================================= *) +(* System of tactics (slightly different from any traditional LCF method). *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2006 *) +(* ========================================================================= *) + +let null_inst = ([],[],[] :instantiation);; + +let null_meta = (([]:term list),null_inst);; + +(* ------------------------------------------------------------------------- *) +(* A goal has labelled assumptions, and the hyps are now thms. *) +(* ------------------------------------------------------------------------- *) + +type goal = (string * thm) list * term;; + +let equals_goal ((a,w):goal) ((a',w'):goal) = + forall2 (fun (s,th) (s',th') -> s = s' & equals_thm th th') a a' & w = w';; + +(* ------------------------------------------------------------------------- *) +(* A justification function for a goalstate [A1 ?- g1; ...; An ?- gn], *) +(* starting from an initial goal A ?- g, is a function f such that for any *) +(* instantiation @: *) +(* *) +(* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A@ |- g@ *) +(* ------------------------------------------------------------------------- *) + +type justification = instantiation -> thm list -> thm;; + +(* ------------------------------------------------------------------------- *) +(* The goalstate stores the subgoals, justification, current instantiation, *) +(* and a list of metavariables. *) +(* ------------------------------------------------------------------------- *) + +type goalstate = (term list * instantiation) * goal list * justification;; + +(* ------------------------------------------------------------------------- *) +(* A goalstack is just a list of goalstates. Could go for more... *) +(* ------------------------------------------------------------------------- *) + +type goalstack = goalstate list;; + +(* ------------------------------------------------------------------------- *) +(* A refinement, applied to a goalstate [A1 ?- g1; ...; An ?- gn] *) +(* yields a new goalstate with updated justification function, to *) +(* give a possibly-more-instantiated version of the initial goal. *) +(* ------------------------------------------------------------------------- *) + +type refinement = goalstate -> goalstate;; + +(* ------------------------------------------------------------------------- *) +(* A tactic, applied to a goal A ?- g, returns: *) +(* *) +(* o A list of new metavariables introduced *) +(* o An instantiation (%) *) +(* o A list of subgoals *) +(* o A justification f such that for any instantiation @ we have *) +(* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A(%;@) |- g(%;@) *) +(* ------------------------------------------------------------------------- *) + +type tactic = goal -> goalstate;; + +type thm_tactic = thm -> tactic;; + +type thm_tactical = thm_tactic -> thm_tactic;; + +(* ------------------------------------------------------------------------- *) +(* Apply instantiation to a goal. *) +(* ------------------------------------------------------------------------- *) + +let (inst_goal:instantiation->goal->goal) = + fun p (thms,w) -> + map (I F_F INSTANTIATE_ALL p) thms,instantiate p w;; + +(* ------------------------------------------------------------------------- *) +(* Perform a sequential composition (left first) of instantiations. *) +(* ------------------------------------------------------------------------- *) + +let (compose_insts :instantiation->instantiation->instantiation) = + fun ((pats1,tmin1,tyin1) as i1) ((pats2,tmin2,tyin2) as i2) -> + let tmin = map (instantiate i2 F_F inst tyin2) tmin1 + and tyin = map (type_subst tyin2 F_F I) tyin1 in + let tmin' = filter (fun (_,x) -> not (can (rev_assoc x) tmin)) tmin2 + and tyin' = filter (fun (_,a) -> not (can (rev_assoc a) tyin)) tyin2 in + pats1@pats2,tmin@tmin',tyin@tyin';; + +(* ------------------------------------------------------------------------- *) +(* Construct A,_FALSITY_ |- p; contortion so falsity is the last element. *) +(* ------------------------------------------------------------------------- *) + +let _FALSITY_ = new_definition `_FALSITY_ = F`;; + +let mk_fthm = + let pth = UNDISCH(fst(EQ_IMP_RULE _FALSITY_)) + and qth = ASSUME `_FALSITY_` in + fun (asl,c) -> PROVE_HYP qth (itlist ADD_ASSUM (rev asl) (CONTR c pth));; + +(* ------------------------------------------------------------------------- *) +(* Validity checking of tactics. This cannot be 100% accurate without making *) +(* arbitrary theorems, but "mk_fthm" brings us quite close. *) +(* ------------------------------------------------------------------------- *) + +let (VALID:tactic->tactic) = + let fake_thm (asl,w) = + let asms = itlist (union o hyp o snd) asl [] in + mk_fthm(asms,w) + and false_tm = `_FALSITY_` in + fun tac (asl,w) -> + let ((mvs,i),gls,just as res) = tac (asl,w) in + let ths = map fake_thm gls in + let asl',w' = dest_thm(just null_inst ths) in + let asl'',w'' = inst_goal i (asl,w) in + let maxasms = + itlist (fun (_,th) -> union (insert (concl th) (hyp th))) asl'' [] in + if aconv w' w'' & forall (C mem maxasms) (subtract asl' [false_tm]) + then res else failwith "VALID: Invalid tactic";; + +(* ------------------------------------------------------------------------- *) +(* Various simple combinators for tactics, identity tactic etc. *) +(* ------------------------------------------------------------------------- *) + +let (THEN),(THENL) = + let propagate_empty i [] = [] + and propagate_thm th i [] = INSTANTIATE_ALL i th in + let compose_justs n just1 just2 i ths = + let ths1,ths2 = chop_list n ths in + (just1 i ths1)::(just2 i ths2) in + let rec seqapply l1 l2 = match (l1,l2) with + ([],[]) -> null_meta,[],propagate_empty + | ((tac:tactic)::tacs),((goal:goal)::goals) -> + let ((mvs1,insts1),gls1,just1 as gstate1) = tac goal in + let goals' = map (inst_goal insts1) goals in + let ((mvs2,insts2),gls2,just2 as gstate2) = seqapply tacs goals' in + ((union mvs1 mvs2,compose_insts insts1 insts2), + gls1@gls2,compose_justs (length gls1) just1 just2) + | _,_ -> failwith "seqapply: Length mismatch" in + let justsequence just1 just2 insts2 i ths = + just1 (compose_insts insts2 i) (just2 i ths) in + let tacsequence ((mvs1,insts1),gls1,just1 as gstate1) tacl = + let ((mvs2,insts2),gls2,just2 as gstate2) = seqapply tacl gls1 in + let jst = justsequence just1 just2 insts2 in + let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in + ((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in + let (then_: tactic -> tactic -> tactic) = + fun tac1 tac2 g -> + let _,gls,_ as gstate = tac1 g in + tacsequence gstate (replicate tac2 (length gls)) + and (thenl_: tactic -> tactic list -> tactic) = + fun tac1 tac2l g -> + let _,gls,_ as gstate = tac1 g in + if gls = [] then tacsequence gstate [] + else tacsequence gstate tac2l in + then_,thenl_;; + +let ((ORELSE): tactic -> tactic -> tactic) = + fun tac1 tac2 g -> + try tac1 g with Failure _ -> tac2 g;; + +let (FAIL_TAC: string -> tactic) = + fun tok g -> failwith tok;; + +let (NO_TAC: tactic) = + FAIL_TAC "NO_TAC";; + +let (ALL_TAC:tactic) = + fun g -> null_meta,[g],fun _ [th] -> th;; + +let TRY tac = + tac ORELSE ALL_TAC;; + +let rec REPEAT tac g = + ((tac THEN REPEAT tac) ORELSE ALL_TAC) g;; + +let EVERY tacl = + itlist (fun t1 t2 -> t1 THEN t2) tacl ALL_TAC;; + +let (FIRST: tactic list -> tactic) = + fun tacl g -> end_itlist (fun t1 t2 -> t1 ORELSE t2) tacl g;; + +let MAP_EVERY tacf lst = + EVERY (map tacf lst);; + +let MAP_FIRST tacf lst = + FIRST (map tacf lst);; + +let (CHANGED_TAC: tactic -> tactic) = + fun tac g -> + let (meta,gl,_ as gstate) = tac g in + if meta = null_meta & length gl = 1 & equals_goal (hd gl) g + then failwith "CHANGED_TAC" else gstate;; + +let rec REPLICATE_TAC n tac = + if n <= 0 then ALL_TAC else tac THEN (REPLICATE_TAC (n - 1) tac);; + +(* ------------------------------------------------------------------------- *) +(* Combinators for theorem continuations / "theorem tacticals". *) +(* ------------------------------------------------------------------------- *) + +let ((THEN_TCL): thm_tactical -> thm_tactical -> thm_tactical) = + fun ttcl1 ttcl2 ttac -> ttcl1 (ttcl2 ttac);; + +let ((ORELSE_TCL): thm_tactical -> thm_tactical -> thm_tactical) = + fun ttcl1 ttcl2 ttac th -> + try ttcl1 ttac th with Failure _ -> ttcl2 ttac th;; + +let rec REPEAT_TCL ttcl ttac th = + ((ttcl THEN_TCL (REPEAT_TCL ttcl)) ORELSE_TCL I) ttac th;; + +let (REPEAT_GTCL: thm_tactical -> thm_tactical) = + let rec REPEAT_GTCL ttcl ttac th g = + try ttcl (REPEAT_GTCL ttcl ttac) th g with Failure _ -> ttac th g in + REPEAT_GTCL;; + +let (ALL_THEN: thm_tactical) = + I;; + +let (NO_THEN: thm_tactical) = + fun ttac th -> failwith "NO_THEN";; + +let EVERY_TCL ttcll = + itlist (fun t1 t2 -> t1 THEN_TCL t2) ttcll ALL_THEN;; + +let FIRST_TCL ttcll = + end_itlist (fun t1 t2 -> t1 ORELSE_TCL t2) ttcll;; + +(* ------------------------------------------------------------------------- *) +(* Tactics to augment assumption list. Note that to allow "ASSUME p" for *) +(* any assumption "p", these add a PROVE_HYP in the justification function, *) +(* just in case. *) +(* ------------------------------------------------------------------------- *) + +let (LABEL_TAC: string -> thm_tactic) = + fun s thm (asl,w) -> + null_meta,[(s,thm)::asl,w], + fun i [th] -> PROVE_HYP (INSTANTIATE_ALL i thm) th;; + +let ASSUME_TAC = LABEL_TAC "";; + +(* ------------------------------------------------------------------------- *) +(* Manipulation of assumption list. *) +(* ------------------------------------------------------------------------- *) + +let (FIND_ASSUM: thm_tactic -> term -> tactic) = + fun ttac t ((asl,w) as g) -> + ttac(snd(find (fun (_,th) -> concl th = t) asl)) g;; + +let (POP_ASSUM: thm_tactic -> tactic) = + fun ttac -> + function (((_,th)::asl),w) -> ttac th (asl,w) + | _ -> failwith "POP_ASSUM: No assumption to pop";; + +let (ASSUM_LIST: (thm list -> tactic) -> tactic) = + fun aslfun (asl,w) -> aslfun (map snd asl) (asl,w);; + +let (POP_ASSUM_LIST: (thm list -> tactic) -> tactic) = + fun asltac (asl,w) -> asltac (map snd asl) ([],w);; + +let (EVERY_ASSUM: thm_tactic -> tactic) = + fun ttac -> ASSUM_LIST (MAP_EVERY ttac);; + +let (FIRST_ASSUM: thm_tactic -> tactic) = + fun ttac (asl,w as g) -> tryfind (fun (_,th) -> ttac th g) asl;; + +let (RULE_ASSUM_TAC :(thm->thm)->tactic) = + fun rule (asl,w as gl) -> (POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY (fun (s,th) -> LABEL_TAC s (rule th)) + (rev asl)) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Operate on assumption identified by a label. *) +(* ------------------------------------------------------------------------- *) + +let (USE_THEN:string->thm_tactic->tactic) = + fun s ttac (asl,w as gl) -> + let th = try assoc s asl with Failure _ -> + failwith("USE_TAC: didn't find assumption "^s) in + ttac th gl;; + +let (REMOVE_THEN:string->thm_tactic->tactic) = + fun s ttac (asl,w as gl) -> + let th = try assoc s asl with Failure _ -> + failwith("USE_TAC: didn't find assumption "^s) in + let asl1,asl2 = chop_list(index s (map fst asl)) asl in + let asl' = asl1 @ tl asl2 in + ttac th (asl',w);; + +(* ------------------------------------------------------------------------- *) +(* General tool to augment a required set of theorems with assumptions. *) +(* ------------------------------------------------------------------------- *) + +let (ASM :(thm list -> tactic)->(thm list -> tactic)) = + fun tltac ths (asl,w as g) -> tltac (map snd asl @ ths) g;; + +(* ------------------------------------------------------------------------- *) +(* Basic tactic to use a theorem equal to the goal. Does *no* matching. *) +(* ------------------------------------------------------------------------- *) + +let (ACCEPT_TAC: thm_tactic) = + let propagate_thm th i [] = INSTANTIATE_ALL i th in + fun th (asl,w) -> + if aconv (concl th) w then + null_meta,[],propagate_thm th + else failwith "ACCEPT_TAC";; + +(* ------------------------------------------------------------------------- *) +(* Create tactic from a conversion. This allows the conversion to return *) +(* |- p rather than |- p = T on a term "p". It also eliminates any goals of *) +(* the form "T" automatically. *) +(* ------------------------------------------------------------------------- *) + +let (CONV_TAC: conv -> tactic) = + let t_tm = `T` in + fun conv ((asl,w) as g) -> + let th = conv w in + let tm = concl th in + if aconv tm w then ACCEPT_TAC th g else + let l,r = dest_eq tm in + if not(aconv l w) then failwith "CONV_TAC: bad equation" else + if r = t_tm then ACCEPT_TAC(EQT_ELIM th) g else + let th' = SYM th in + null_meta,[asl,r],fun i [th] -> EQ_MP (INSTANTIATE_ALL i th') th;; + +(* ------------------------------------------------------------------------- *) +(* Tactics for equality reasoning. *) +(* ------------------------------------------------------------------------- *) + +let (REFL_TAC: tactic) = + fun ((asl,w) as g) -> + try ACCEPT_TAC(REFL(rand w)) g + with Failure _ -> failwith "REFL_TAC";; + +let (ABS_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_eq w in + let lv,lb = dest_abs l + and rv,rb = dest_abs r in + let avoids = itlist (union o thm_frees o snd) asl (frees w) in + let v = mk_primed_var avoids lv in + null_meta,[asl,mk_eq(vsubst[v,lv] lb,vsubst[v,rv] rb)], + fun i [th] -> let ath = ABS v th in + EQ_MP (ALPHA (concl ath) (instantiate i w)) ath + with Failure _ -> failwith "ABS_TAC";; + +let (MK_COMB_TAC: tactic) = + fun (asl,gl) -> + try let l,r = dest_eq gl in + let f,x = dest_comb l + and g,y = dest_comb r in + null_meta,[asl,mk_eq(f,g); asl,mk_eq(x,y)], + fun _ [th1;th2] -> MK_COMB(th1,th2) + with Failure _ -> failwith "MK_COMB_TAC";; + +let (AP_TERM_TAC: tactic) = + let tac = MK_COMB_TAC THENL [REFL_TAC; ALL_TAC] in + fun gl -> try tac gl with Failure _ -> failwith "AP_TERM_TAC";; + +let (AP_THM_TAC: tactic) = + let tac = MK_COMB_TAC THENL [ALL_TAC; REFL_TAC] in + fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; + +let (BINOP_TAC: tactic) = + let tac = MK_COMB_TAC THENL [AP_TERM_TAC; ALL_TAC] in + fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; + +let (SUBST1_TAC: thm_tactic) = + fun th -> CONV_TAC(SUBS_CONV [th]);; + +let SUBST_ALL_TAC rth = + SUBST1_TAC rth THEN RULE_ASSUM_TAC (SUBS [rth]);; + +let BETA_TAC = CONV_TAC(REDEPTH_CONV BETA_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Just use an equation to substitute if possible and uninstantiable. *) +(* ------------------------------------------------------------------------- *) + +let SUBST_VAR_TAC th = + try let asm,eq = dest_thm th in + let l,r = dest_eq eq in + if aconv l r then ALL_TAC + else if not (subset (frees eq) (freesl asm)) then fail() + else if (is_const l or is_var l) & not(free_in l r) + then SUBST_ALL_TAC th + else if (is_const r or is_var r) & not(free_in r l) + then SUBST_ALL_TAC(SYM th) + else fail() + with Failure _ -> failwith "SUBST_VAR_TAC";; + +(* ------------------------------------------------------------------------- *) +(* Basic logical tactics. *) +(* ------------------------------------------------------------------------- *) + +let (DISCH_TAC: tactic) = + let f_tm = `F` in + fun (asl,w) -> + try let ant,c = dest_imp w in + let th1 = ASSUME ant in + null_meta,[("",th1)::asl,c], + fun i [th] -> DISCH (instantiate i ant) th + with Failure _ -> try + let ant = dest_neg w in + let th1 = ASSUME ant in + null_meta,[("",th1)::asl,f_tm], + fun i [th] -> NOT_INTRO(DISCH (instantiate i ant) th) + with Failure _ -> failwith "DISCH_TAC";; + +let (MP_TAC: thm_tactic) = + fun thm (asl,w) -> + null_meta,[asl,mk_imp(concl thm,w)], + fun i [th] -> MP th (INSTANTIATE_ALL i thm);; + +let (EQ_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_eq w in + null_meta,[asl, mk_imp(l,r); asl, mk_imp(r,l)], + fun _ [th1; th2] -> IMP_ANTISYM_RULE th1 th2 + with Failure _ -> failwith "EQ_TAC";; + +let (UNDISCH_TAC: term -> tactic) = + fun tm (asl,w) -> + try let sthm,asl' = remove (fun (_,asm) -> aconv (concl asm) tm) asl in + let thm = snd sthm in + null_meta,[asl',mk_imp(tm,w)], + fun i [th] -> MP th (INSTANTIATE_ALL i thm) + with Failure _ -> failwith "UNDISCH_TAC";; + +let (SPEC_TAC: term * term -> tactic) = + fun (t,x) (asl,w) -> + try null_meta,[asl, mk_forall(x,subst[x,t] w)], + fun i [th] -> SPEC (instantiate i t) th + with Failure _ -> failwith "SPEC_TAC";; + +let (X_GEN_TAC: term -> tactic) = + fun x' -> + if not(is_var x') then failwith "X_GEN_TAC" else + fun (asl,w) -> + try let x,bod = dest_forall w in + let avoids = itlist (union o thm_frees o snd) asl (frees w) in + if mem x' avoids then failwith "X_GEN_TAC" else + let afn = CONV_RULE(GEN_ALPHA_CONV x) in + null_meta,[asl,vsubst[x',x] bod], + fun i [th] -> afn (GEN x' th) + with Failure _ -> failwith "X_GEN_TAC";; + +let (GEN_TAC: tactic) = + fun (asl,w) -> + try let x = fst(dest_forall w) in + let avoids = itlist (union o thm_frees o snd) asl (frees w) in + let x' = mk_primed_var avoids x in + X_GEN_TAC x' (asl,w) + with Failure _ -> failwith "GEN_TAC";; + +let (EXISTS_TAC: term -> tactic) = + fun t (asl,w) -> + try let v,bod = dest_exists w in + null_meta,[asl,vsubst[t,v] bod], + fun i [th] -> EXISTS (instantiate i w,instantiate i t) th + with Failure _ -> failwith "EXISTS_TAC";; + +let (X_CHOOSE_TAC: term -> thm_tactic) = + fun x' xth -> + try let xtm = concl xth in + let x,bod = dest_exists xtm in + let pat = vsubst[x',x] bod in + let xth' = ASSUME pat in + fun (asl,w) -> + let avoids = itlist (union o frees o concl o snd) asl + (union (frees w) (thm_frees xth)) in + if mem x' avoids then failwith "X_CHOOSE_TAC" else + null_meta,[("",xth')::asl,w], + fun i [th] -> CHOOSE(x',INSTANTIATE_ALL i xth) th + with Failure _ -> failwith "X_CHOOSE_TAC";; + +let (CHOOSE_TAC: thm_tactic) = + fun xth -> + try let x = fst(dest_exists(concl xth)) in + fun (asl,w) -> + let avoids = itlist (union o thm_frees o snd) asl + (union (frees w) (thm_frees xth)) in + let x' = mk_primed_var avoids x in + X_CHOOSE_TAC x' xth (asl,w) + with Failure _ -> failwith "CHOOSE_TAC";; + +let (CONJ_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_conj w in + null_meta,[asl,l; asl,r],fun _ [th1;th2] -> CONJ th1 th2 + with Failure _ -> failwith "CONJ_TAC";; + +let (DISJ1_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_disj w in + null_meta,[asl,l],fun i [th] -> DISJ1 th (instantiate i r) + with Failure _ -> failwith "DISJ1_TAC";; + +let (DISJ2_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_disj w in + null_meta,[asl,r],fun i [th] -> DISJ2 (instantiate i l) th + with Failure _ -> failwith "DISJ2_TAC";; + +let (DISJ_CASES_TAC: thm_tactic) = + fun dth -> + try let dtm = concl dth in + let l,r = dest_disj dtm in + let thl = ASSUME l + and thr = ASSUME r in + fun (asl,w) -> + null_meta,[("",thl)::asl,w; ("",thr)::asl,w], + fun i [th1;th2] -> DISJ_CASES (INSTANTIATE_ALL i dth) th1 th2 + with Failure _ -> failwith "DISJ_CASES_TAC";; + +let (CONTR_TAC: thm_tactic) = + let propagate_thm th i [] = INSTANTIATE_ALL i th in + fun cth (asl,w) -> + try let th = CONTR w cth in + null_meta,[],propagate_thm th + with Failure _ -> failwith "CONTR_TAC";; + +let (MATCH_ACCEPT_TAC:thm_tactic) = + let propagate_thm th i [] = INSTANTIATE_ALL i th in + let rawtac th (asl,w) = + try let ith = PART_MATCH I th w in + null_meta,[],propagate_thm ith + with Failure _ -> failwith "ACCEPT_TAC" in + fun th -> REPEAT GEN_TAC THEN rawtac th;; + +let (MATCH_MP_TAC :thm_tactic) = + fun th -> + let sth = + try let tm = concl th in + let avs,bod = strip_forall tm in + let ant,con = dest_imp bod in + let th1 = SPECL avs (ASSUME tm) in + let th2 = UNDISCH th1 in + let evs = filter (fun v -> vfree_in v ant & not (vfree_in v con)) + avs in + let th3 = itlist SIMPLE_CHOOSE evs (DISCH tm th2) in + let tm3 = hd(hyp th3) in + MP (DISCH tm (GEN_ALL (DISCH tm3 (UNDISCH th3)))) th + with Failure _ -> failwith "MATCH_MP_TAC: Bad theorem" in + let match_fun = PART_MATCH (snd o dest_imp) sth in + fun (asl,w) -> try let xth = match_fun w in + let lant = fst(dest_imp(concl xth)) in + null_meta,[asl,lant], + fun i [th] -> MP (INSTANTIATE_ALL i xth) th + with Failure _ -> failwith "MATCH_MP_TAC: No match";; + +(* ------------------------------------------------------------------------- *) +(* Theorem continuations. *) +(* ------------------------------------------------------------------------- *) + +let (CONJUNCTS_THEN2:thm_tactic->thm_tactic->thm_tactic) = + fun ttac1 ttac2 cth -> + let c1,c2 = dest_conj(concl cth) in + fun gl -> let ti,gls,jfn = (ttac1(ASSUME c1) THEN ttac2(ASSUME c2)) gl in + let jfn' i ths = + let th1,th2 = CONJ_PAIR(INSTANTIATE_ALL i cth) in + PROVE_HYP th1 (PROVE_HYP th2 (jfn i ths)) in + ti,gls,jfn';; + +let (CONJUNCTS_THEN: thm_tactical) = + W CONJUNCTS_THEN2;; + +let (DISJ_CASES_THEN2:thm_tactic->thm_tactic->thm_tactic) = + fun ttac1 ttac2 cth -> + DISJ_CASES_TAC cth THENL [POP_ASSUM ttac1; POP_ASSUM ttac2];; + +let (DISJ_CASES_THEN: thm_tactical) = + W DISJ_CASES_THEN2;; + +let (DISCH_THEN: thm_tactic -> tactic) = + fun ttac -> DISCH_TAC THEN POP_ASSUM ttac;; + +let (X_CHOOSE_THEN: term -> thm_tactical) = + fun x ttac th -> X_CHOOSE_TAC x th THEN POP_ASSUM ttac;; + +let (CHOOSE_THEN: thm_tactical) = + fun ttac th -> CHOOSE_TAC th THEN POP_ASSUM ttac;; + +(* ------------------------------------------------------------------------- *) +(* Various derived tactics and theorem continuations. *) +(* ------------------------------------------------------------------------- *) + +let STRIP_THM_THEN = + FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN; CHOOSE_THEN];; + +let (ANTE_RES_THEN: thm_tactical) = + fun ttac ante -> + ASSUM_LIST (EVERY o (mapfilter (fun imp -> ttac (MATCH_MP imp ante))));; + +let (IMP_RES_THEN: thm_tactical) = + fun ttac imp -> + ASSUM_LIST (EVERY o (mapfilter (fun ante -> ttac (MATCH_MP imp ante))));; + +let STRIP_ASSUME_TAC = + let DISCARD_TAC th = + let tm = concl th in + fun (asl,w as g) -> + if exists (fun a -> aconv tm (concl(snd a))) asl then ALL_TAC g + else failwith "DISCARD_TAC: not already present" in + (REPEAT_TCL STRIP_THM_THEN) + (fun gth -> FIRST [CONTR_TAC gth; ACCEPT_TAC gth; + DISCARD_TAC gth; ASSUME_TAC gth]);; + +let STRUCT_CASES_TAC = + REPEAT_TCL STRIP_THM_THEN + (fun th -> SUBST1_TAC th ORELSE ASSUME_TAC th);; + +let STRIP_GOAL_THEN ttac = FIRST [GEN_TAC; CONJ_TAC; DISCH_THEN ttac];; + +let (STRIP_TAC: tactic) = + fun g -> + try STRIP_GOAL_THEN STRIP_ASSUME_TAC g + with Failure _ -> failwith "STRIP_TAC";; + +let (UNDISCH_THEN:term->thm_tactic->tactic) = + fun tm ttac (asl,w) -> + let thp,asl' = remove (fun (_,th) -> aconv (concl th) tm) asl in + ttac (snd thp) (asl',w);; + +let FIRST_X_ASSUM ttac = + FIRST_ASSUM(fun th -> UNDISCH_THEN (concl th) ttac);; + +(* ------------------------------------------------------------------------- *) +(* Subgoaling and freezing variables (latter is especially useful now). *) +(* ------------------------------------------------------------------------- *) + +let (SUBGOAL_THEN: term -> thm_tactic -> tactic) = + fun wa ttac (asl,w) -> + let meta,gl,just = ttac (ASSUME wa) (asl,w) in + meta,(asl,wa)::gl,fun i l -> PROVE_HYP (hd l) (just i (tl l));; + +let SUBGOAL_TAC s tm prfs = + match prfs with + p::ps -> (warn (ps <> []) "SUBGOAL_TAC: additional subproofs ignored"; + SUBGOAL_THEN tm (LABEL_TAC s) THENL [p; ALL_TAC]) + | [] -> failwith "SUBGOAL_TAC: no subproof given";; + +let (FREEZE_THEN :thm_tactical) = + fun ttac th -> + SUBGOAL_THEN (concl th) ttac THENL [ACCEPT_TAC th; ALL_TAC];; + +(* ------------------------------------------------------------------------- *) +(* Metavariable tactics. *) +(* ------------------------------------------------------------------------- *) + +let (X_META_EXISTS_TAC: term -> tactic) = + fun t (asl,w) -> + try if not (is_var t) then fail() else + let v,bod = dest_exists w in + ([t],null_inst),[asl,vsubst[t,v] bod], + fun i [th] -> EXISTS (instantiate i w,instantiate i t) th + with Failure _ -> failwith "X_META_EXISTS_TAC";; + +let META_EXISTS_TAC ((asl,w) as gl) = + let v = fst(dest_exists w) in + let avoids = itlist (union o frees o concl o snd) asl (frees w) in + let v' = mk_primed_var avoids v in + X_META_EXISTS_TAC v' gl;; + +let (META_SPEC_TAC: term -> thm -> tactic) = + fun t thm (asl,w) -> + let sth = SPEC t thm in + ([t],null_inst),[(("",sth)::asl),w], + fun i [th] -> PROVE_HYP (SPEC (instantiate i t) thm) th;; + +(* ------------------------------------------------------------------------- *) +(* If all else fails! *) +(* ------------------------------------------------------------------------- *) + +let (CHEAT_TAC:tactic) = + fun (asl,w) -> ACCEPT_TAC(mk_thm([],w)) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Intended for time-consuming rules; delays evaluation till it sees goal. *) +(* ------------------------------------------------------------------------- *) + +let RECALL_ACCEPT_TAC r a g = ACCEPT_TAC(time r a) g;; + +(* ------------------------------------------------------------------------- *) +(* Split off antecedent of antecedent as a subgoal. *) +(* ------------------------------------------------------------------------- *) + +let ANTS_TAC = + let tm1 = `p /\ (q ==> r)` + and tm2 = `p ==> q` in + let th1,th2 = CONJ_PAIR(ASSUME tm1) in + let th = itlist DISCH [tm1;tm2] (MP th2 (MP(ASSUME tm2) th1)) in + MATCH_MP_TAC th THEN CONJ_TAC;; + +(* ------------------------------------------------------------------------- *) +(* A printer for goals etc. *) +(* ------------------------------------------------------------------------- *) + +let (print_goal:goal->unit) = + let print_hyp n (s,th) = + open_hbox(); + print_string " "; + print_as 3 (string_of_int n); + print_string " ["; + print_qterm (concl th); + print_string "]"; + (if not (s = "") then (print_string (" ("^s^")")) else ()); + close_box(); + print_newline() in + let rec print_hyps n asl = + if asl = [] then () else + (print_hyp n (hd asl); + print_hyps (n + 1) (tl asl)) in + fun (asl,w) -> + print_newline(); + if asl <> [] then (print_hyps 0 (rev asl); print_newline()) else (); + print_qterm w; print_newline();; + +let (print_goalstack:goalstack->unit) = + let print_goalstate k gs = + let (_,gl,_) = gs in + let n = length gl in + let s = if n = 0 then "No subgoals" else + (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") + ^" ("^(string_of_int n)^" total)" in + print_string s; print_newline(); + if gl = [] then () else + do_list (print_goal o C el gl) (rev(0--(k-1))) in + fun l -> + if l = [] then print_string "Empty goalstack" + else if tl l = [] then + let (_,gl,_ as gs) = hd l in + print_goalstate 1 gs + else + let (_,gl,_ as gs) = hd l + and (_,gl0,_) = hd(tl l) in + let p = length gl - length gl0 in + let p' = if p < 1 then 1 else p + 1 in + print_goalstate p' gs;; + +(* ------------------------------------------------------------------------- *) +(* Convert a tactic into a refinement on head subgoal in current state. *) +(* ------------------------------------------------------------------------- *) + +let (by:tactic->refinement) = + fun tac ((mvs,inst),gls,just) -> + let g = hd gls + and ogls = tl gls in + let ((newmvs,newinst),subgls,subjust) = tac g in + let n = length subgls in + let mvs' = union newmvs mvs + and inst' = compose_insts inst newinst + and gls' = subgls @ map (inst_goal newinst) ogls in + let just' i ths = + let i' = compose_insts inst' i in + let cths,oths = chop_list n ths in + let sths = (subjust i cths) :: oths in + just i' sths in + (mvs',inst'),gls',just';; + +(* ------------------------------------------------------------------------- *) +(* Rotate the goalstate either way. *) +(* ------------------------------------------------------------------------- *) + +let (rotate:int->refinement) = + let rotate_p (meta,sgs,just) = + let sgs' = (tl sgs)@[hd sgs] in + let just' i ths = + let ths' = (last ths)::(butlast ths) in + just i ths' in + (meta,sgs',just') + and rotate_n (meta,sgs,just) = + let sgs' = (last sgs)::(butlast sgs) in + let just' i ths = + let ths' = (tl ths)@[hd ths] in + just i ths' in + (meta,sgs',just') in + fun n -> if n > 0 then funpow n rotate_p + else funpow (-n) rotate_n;; + +(* ------------------------------------------------------------------------- *) +(* Perform refinement proof, tactic proof etc. *) +(* ------------------------------------------------------------------------- *) + +let (mk_goalstate:goal->goalstate) = + fun (asl,w) -> + if type_of w = bool_ty then + null_meta,[asl,w], + (fun inst [th] -> INSTANTIATE_ALL inst th) + else failwith "mk_goalstate: Non-boolean goal";; + +let (TAC_PROOF : goal * tactic -> thm) = + fun (g,tac) -> + let gstate = mk_goalstate g in + let _,sgs,just = by tac gstate in + if sgs = [] then just null_inst [] + else failwith "TAC_PROOF: Unsolved goals";; + +let prove(t,tac) = + let th = TAC_PROOF(([],t),tac) in + let t' = concl th in + if t' = t then th else + try EQ_MP (ALPHA t' t) th + with Failure _ -> failwith "prove: justification generated wrong theorem";; + +let nprove n s = let th = prove s in save_thm n th;; + +(* ------------------------------------------------------------------------- *) +(* Interactive "subgoal package" stuff. *) +(* ------------------------------------------------------------------------- *) + +let current_goalstack = ref ([] :goalstack);; + +let (refine:refinement->goalstack) = + fun r -> + let l = !current_goalstack in + let h = hd l in + let res = r h :: l in + current_goalstack := res; + !current_goalstack;; + +let flush_goalstack() = + let l = !current_goalstack in + current_goalstack := [hd l];; + +let e tac = refine(by(VALID tac));; + +let r n = refine(rotate n);; + +let set_goal(asl,w) = + current_goalstack := + [mk_goalstate(map (fun t -> "",ASSUME t) asl,w)]; + !current_goalstack;; + +let g t = + let fvs = sort (<) (map (fst o dest_var) (frees t)) in + (if fvs <> [] then + let errmsg = end_itlist (fun s t -> s^", "^t) fvs in + warn true ("Free variables in goal: "^errmsg) + else ()); + set_goal([],t);; + +let b() = + let l = !current_goalstack in + if length l = 1 then failwith "Can't back up any more" else + current_goalstack := tl l; + !current_goalstack;; + +let p() = + !current_goalstack;; + +let top_realgoal() = + let (_,((asl,w)::_),_)::_ = !current_goalstack in + asl,w;; + +let top_goal() = + let asl,w = top_realgoal() in + map (concl o snd) asl,w;; + +let top_thm() = + let (_,[],f)::_ = !current_goalstack in + f null_inst [];; + +(* ------------------------------------------------------------------------- *) +(* Install the goal-related printers. *) +(* ------------------------------------------------------------------------- *) + +#install_printer print_goal;; +#install_printer print_goalstack;; diff --git a/Proofrecording/diffs/thm.ml b/Proofrecording/diffs/thm.ml new file mode 100644 index 0000000..d70580a --- /dev/null +++ b/Proofrecording/diffs/thm.ml @@ -0,0 +1,347 @@ +(* ========================================================================= *) +(* Abstract type of theorems and primitive inference rules. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* A few bits of general derived syntax. *) +(* ------------------------------------------------------------------------- *) + +let rator tm = + match tm with + Comb(l,r) -> l + | _ -> failwith "rator: Not a combination";; + +let rand tm = + match tm with + Comb(l,r) -> r + | _ -> failwith "rand: Not a combination";; + +(* ------------------------------------------------------------------------- *) +(* Syntax operations for equations. *) +(* ------------------------------------------------------------------------- *) + +let dest_eq tm = + match tm with + Comb(Comb(Const("=",_),l),r) -> l,r + | _ -> failwith "dest_eq";; + +let is_eq tm = + match tm with + Comb(Comb(Const("=",_),_),_) -> true + | _ -> false;; + +let mk_eq = + let eq = mk_const("=",[]) in + fun (l,r) -> + try let ty = type_of l in + let eq_tm = inst [ty,aty] eq in + mk_comb(mk_comb(eq_tm,l),r) + with Failure _ -> failwith "mk_eq";; + +(* ------------------------------------------------------------------------- *) +(* Useful to have term union modulo alpha-conversion for assumption lists. *) +(* ------------------------------------------------------------------------- *) + + let rec ordav env x1 x2 = + match env with + [] -> Pervasives.compare x1 x2 + | (t1,t2 as tp)::oenv -> if Pervasives.compare x1 t1 = 0 + then if Pervasives.compare x2 t2 = 0 + then 0 else -1 + else if Pervasives.compare x2 t2 = 0 then 1 + else ordav oenv x1 x2 + + let rec orda env tm1 tm2 = + if tm1 == tm2 & env = [] then 0 else + match (tm1,tm2) with + Var(x1,ty1),Var(x2,ty2) -> ordav env tm1 tm2 + | Const(x1,ty1),Const(x2,ty2) -> Pervasives.compare tm1 tm2 + | Comb(s1,t1),Comb(s2,t2) -> + let c = orda env s1 s2 in if c <> 0 then c else orda env t1 t2 + | Abs(Var(_,ty1) as x1,t1),Abs(Var(_,ty2) as x2,t2) -> + let c = Pervasives.compare ty1 ty2 in + if c <> 0 then c else orda ((x1,x2)::env) t1 t2 + | Const(_,_),_ -> -1 + | _,Const(_,_) -> 1 + | Var(_,_),_ -> -1 + | _,Var(_,_) -> 1 + | Comb(_,_),_ -> -1 + | _,Comb(_,_) -> 1 + + let alphaorder = orda [] + + let rec term_union l1 l2 = + match (l1,l2) with + ([],l2) -> l2 + | (l1,[]) -> l1 + | (h1::t1,h2::t2) -> let c = alphaorder h1 h2 in + if c = 0 then h1::(term_union t1 t2) + else if c < 0 then h1::(term_union t1 l2) + else h2::(term_union l1 t2) + + let rec term_remove t l = + match l with + s::ss -> let c = alphaorder t s in + if c > 0 then + let ss' = term_remove t ss in + if ss' == ss then l else s::ss' + else if c = 0 then ss else l + | [] -> l + + let rec term_image f l = + match l with + h::t -> let h' = f h and t' = term_image f t in + if h' == h & t' == t then l else term_union [h'] t' + | [] -> l + +(* ------------------------------------------------------------------------- *) +(* The abstract type of theorems. *) +(* ------------------------------------------------------------------------- *) + +module type Hol_thm_primitives = + sig type thm + val dest_thm : thm -> term list * term + val hyp : thm -> term list + val concl : thm -> term + val REFL : term -> thm + val TRANS : thm -> thm -> thm + val MK_COMB : thm * thm -> thm + val ABS : term -> thm -> thm + val BETA : term -> thm + val ASSUME : term -> thm + val EQ_MP : thm -> thm -> thm + val DEDUCT_ANTISYM_RULE : thm -> thm -> thm + val INST_TYPE : (hol_type * hol_type) list -> thm -> thm + val INST : (term * term) list -> thm -> thm + val axioms : unit -> thm list + val new_axiom : term -> thm + val new_basic_definition : term -> thm + val new_basic_type_definition : string -> string * string -> thm -> thm * thm + + val equals_thm : thm -> thm -> bool + val le_thm : thm -> thm -> bool + val less_thm : thm -> thm -> bool + + val proof_of : thm -> proof + val substitute_proof : thm -> proof -> thm + val save_thm : string -> thm -> thm +end;; + +(* ------------------------------------------------------------------------- *) +(* This is the implementation of those primitives. *) +(* ------------------------------------------------------------------------- *) + +module Hol : Hol_thm_primitives = struct + + type thm = Sequent of (term list * term * proof) + +(* ------------------------------------------------------------------------- *) +(* Basic theorem destructors. *) +(* ------------------------------------------------------------------------- *) + + let dest_thm (Sequent(asl,c,_)) = (asl,c) + + let hyp (Sequent(asl,c,_)) = asl + + let concl (Sequent(asl,c,_)) = c + +(* ------------------------------------------------------------------------- *) +(* Basic equality properties; TRANS is derivable but included for efficiency *) +(* ------------------------------------------------------------------------- *) + + let REFL tm = + Sequent([],mk_eq (tm, tm), proof_REFL tm) + + let TRANS (Sequent(asl1,c1,p1)) (Sequent(asl2,c2,p2)) = + match (c1,c2) with + Comb((Comb(Const("=",_),l) as eql),m1),Comb(Comb(Const("=",_),m2),r) + when alphaorder m1 m2 = 0 -> Sequent(term_union asl1 asl2,mk_comb (eql, r),proof_TRANS (p1,p2)) + | _ -> failwith "TRANS" + +(* ------------------------------------------------------------------------- *) +(* Congruence properties of equality. *) +(* ------------------------------------------------------------------------- *) + + let MK_COMB(Sequent(asl1,c1,p1),Sequent(asl2,c2,p2)) = + match (c1,c2) with + Comb(Comb(Const("=",_),l1),r1),Comb(Comb(Const("=",_),l2),r2) -> + (match type_of l1 with + Tyapp("fun",[ty;_]) when Pervasives.compare ty (type_of l2) = 0 + -> Sequent(term_union asl1 asl2, + mk_eq (mk_comb (l1, l2), mk_comb(r1, r2)), + proof_MK_COMB (p1,p2)) + | _ -> failwith "MK_COMB: types do not agree") + | _ -> failwith "MK_COMB: not both equations" + + let ABS v (Sequent(asl,c,p)) = + match (v,c) with + Var(_,_),Comb(Comb(Const("=",_),l),r) when not(exists (vfree_in v) asl) + -> Sequent(asl,mk_eq (mk_abs (v, l), mk_abs (v, r)),proof_ABS v p) + | _ -> failwith "ABS";; + +(* ------------------------------------------------------------------------- *) +(* Trivial case of lambda calculus beta-conversion. *) +(* ------------------------------------------------------------------------- *) + + let BETA tm = + match tm with + Comb(Abs(v,bod),arg) when Pervasives.compare arg v = 0 + -> Sequent([],mk_eq (tm, bod), proof_BETA tm) + | _ -> failwith "BETA: not a trivial beta-redex" + +(* ------------------------------------------------------------------------- *) +(* Rules connected with deduction. *) +(* ------------------------------------------------------------------------- *) + + let ASSUME tm = + if Pervasives.compare (type_of tm) bool_ty = 0 then Sequent([tm],tm, proof_ASSUME tm) + else failwith "ASSUME: not a proposition" + + let EQ_MP (Sequent(asl1,eq,p1)) (Sequent(asl2,c,p2)) = + match eq with + Comb(Comb(Const("=",_),l),r) when alphaorder l c = 0 + -> Sequent(term_union asl1 asl2,r, proof_EQ_MP p1 p2) + | _ -> failwith "EQ_MP" + + let DEDUCT_ANTISYM_RULE (Sequent(asl1,c1,p1)) (Sequent(asl2,c2,p2)) = + let asl1' = term_remove c2 asl1 and asl2' = term_remove c1 asl2 in + Sequent(term_union asl1' asl2',mk_eq (c1, c2), + proof_DEDUCT_ANTISYM_RULE (p1,c1) (p2,c2)) + +(* ------------------------------------------------------------------------- *) +(* Type and term instantiation. *) +(* ------------------------------------------------------------------------- *) + + let INST_TYPE theta (Sequent(asl,c,p)) = + let inst_fn = inst theta in + Sequent(term_image inst_fn asl,inst_fn c, proof_INST_TYPE theta p) + + let INST theta (Sequent(asl,c,p)) = + let inst_fun = vsubst theta in + Sequent(term_image inst_fun asl,inst_fun c, proof_INST theta p) + +(* ------------------------------------------------------------------------- *) +(* Handling of axioms. *) +(* ------------------------------------------------------------------------- *) + + let the_axioms = ref ([]:thm list) + + let axioms() = !the_axioms + + let new_axiom tm = + if Pervasives.compare (type_of tm) bool_ty = 0 then + let axname = new_axiom_name "" in + let p = proof_new_axiom (axname) tm in + let th = Sequent([],tm,p) in + (the_axioms := th::(!the_axioms); + save_proof axname p (Some tm); + th) + else failwith "new_axiom: Not a proposition" + +(* ------------------------------------------------------------------------- *) +(* Handling of (term) definitions. *) +(* ------------------------------------------------------------------------- *) + + let the_definitions = ref ([]:thm list) + + let definitions() = !the_definitions + + let new_basic_definition tm = + match tm with + Comb(Comb(Const("=",_),(Var(cname,ty) as l)),r) -> + if not(freesin [] r) then failwith "new_definition: term not closed" + else if not (subset (type_vars_in_term r) (tyvars ty)) + then failwith "new_definition: Type variables not reflected in constant" + else let c = new_constant(cname,ty); mk_const (cname, []) in + let p = proof_new_definition cname ty r in + let concl = mk_eq (c, r) in + save_proof ("DEF_"^cname) p (Some concl); + let dth = Sequent([],concl,p) in + the_definitions := dth::(!the_definitions); dth + | _ -> failwith "new_basic_definition" + +(* ------------------------------------------------------------------------- *) +(* Handling of type definitions. *) +(* *) +(* This function now involves no logical constants beyond equality. *) +(* *) +(* |- P t *) +(* --------------------------- *) +(* |- abs(rep a) = a *) +(* |- P r = (rep(abs r) = r) *) +(* *) +(* Where "abs" and "rep" are new constants with the nominated names. *) +(* ------------------------------------------------------------------------- *) + + let new_basic_type_definition tyname (absname,repname) (Sequent(asl,c,p)) = + if exists (can get_const_type) [absname; repname] then + failwith "new_basic_type_definition: Constant(s) already in use" else + if not (asl = []) then + failwith "new_basic_type_definition: Assumptions in theorem" else + let P,x = try dest_comb c + with Failure _ -> + failwith "new_basic_type_definition: Not a combination" in + if not(freesin [] P) then + failwith "new_basic_type_definition: Predicate is not closed" else + let tyvars = sort (<=) (type_vars_in_term P) in + let _ = try new_type(tyname,length tyvars) + with Failure _ -> + failwith "new_basic_type_definition: Type already defined" in + let aty = mk_type(tyname,tyvars) + and rty = type_of x in + let absty = mk_type("fun",[rty;aty]) and repty = mk_type("fun",[aty;rty]) in + let abs = (new_constant(absname,absty); mk_const(absname,[])) + and rep = (new_constant(repname,repty); mk_const(repname,[])) in + let a = mk_var("a",aty) and r = mk_var("r",rty) in + let ax1 = mk_eq (mk_comb(abs,mk_comb(rep,a)), a) in + let ax2 = mk_eq (mk_comb(P,r), + mk_eq (mk_comb(rep,mk_comb(abs,r)), r)) in + let tp = proof_new_basic_type_definition tyname (absname, repname) (P,x) p in + let tname = "TYDEF_"^tyname in + save_proof tname tp None; + Sequent([],ax1,proof_CONJUNCT1 tp), + Sequent([],ax2,proof_CONJUNCT2 tp) + +(* ------------------------------------------------------------------------- *) +(* Dealing with proof objects. *) +(* ------------------------------------------------------------------------- *) + + let substitute_proof = + if use_extended_proofobjects then + fun (Sequent (asl, c, p)) pnew -> Sequent (asl, c, pnew) + else + fun th p -> th;; + + let equals_thm (Sequent (p1,c1,_)) (Sequent (p2,c2,_)) = + (p1 = p2) & (c1 = c2) + + let le_thm (Sequent (p1,c1,_)) (Sequent (p2,c2,_)) = (p1, c1) <= (p2, c2) + + let less_thm (Sequent (p1, c1,_)) (Sequent (p2, c2,_)) = (p1, c1) < (p2, c2) + + let proof_of (Sequent(_,_,p)) = p + + let save_thm name th = + (save_proof name (proof_of th) (Some (concl th)); th) + +end;; + +include Hol;; + +(* ------------------------------------------------------------------------- *) +(* Tests for alpha-convertibility (equality ignoring names in abstractions). *) +(* ------------------------------------------------------------------------- *) + +let aconv s t = alphaorder s t = 0;; + +(* ------------------------------------------------------------------------- *) +(* Comparison function on theorems. Currently the same as equality, but *) +(* it's useful to separate because in the proof-recording version it isn't. *) +(* ------------------------------------------------------------------------- *) + +let equals_thm th th' = dest_thm th = dest_thm th';; diff --git a/Proofrecording/tools/init.ml b/Proofrecording/tools/init.ml new file mode 100644 index 0000000..befb0f2 --- /dev/null +++ b/Proofrecording/tools/init.ml @@ -0,0 +1,11 @@ +(* ------------------------------------------------------------------------- *) +(* Set up a quotation expander for my `...` quotes. *) +(* ------------------------------------------------------------------------- *) + +let quotexpander s = + if String.sub s 0 1 = ":" then + "parse_type \""^ + (String.escaped (String.sub s 1 (String.length s - 1)))^"\"" + else "parse_term \""^(String.escaped s)^"\"";; + +Quotation.add "tot" (Quotation.ExStr (fun x -> quotexpander));; diff --git a/Proofrecording/tools/startcore.ml b/Proofrecording/tools/startcore.ml new file mode 100644 index 0000000..bbdcee2 --- /dev/null +++ b/Proofrecording/tools/startcore.ml @@ -0,0 +1,8 @@ + +set_jrh_lexer;; (* Uppercase idents *) + +Gc.set { (Gc.get()) with Gc.stack_limit = 16777216 };; (* Up the stack size *) + +include Num;; + +Sys.catch_break true;; diff --git a/QBF/make.ml b/QBF/make.ml new file mode 100644 index 0000000..531c004 --- /dev/null +++ b/QBF/make.ml @@ -0,0 +1,10 @@ +(* ========================================================================= *) +(* Ondrej Kuncar's HOL Light QBF code. *) +(* ========================================================================= *) + +#load "ocamlgraph/graph.cma";; +#directory "+ocamlgraph";; +loads "Minisat/make.ml";; +loads "QBF/mygraph.ml";; +loads "QBF/qbfr.ml";; +loads "QBF/qbf.ml";; diff --git a/QBF/mygraph.ml b/QBF/mygraph.ml new file mode 100644 index 0000000..6d277f2 --- /dev/null +++ b/QBF/mygraph.ml @@ -0,0 +1,18 @@ +unset_jrh_lexer;; + +module Intvertex = struct + type t = int + let compare : t -> t -> int = Pervasives.compare + let hash = Hashtbl.hash + let equal = (=) + let default = 0 +end;; + +module Gr = Graph.Imperative.Digraph.ConcreteBidirectional(Intvertex);; + +module Topo = Graph.Topological.Make(Gr);; + +let make_vertex var_index = Gr.V.create var_index;; +let dest_vertex var_index = Gr.V.label var_index;; + +set_jrh_lexer;; diff --git a/QBF/qbf.ml b/QBF/qbf.ml new file mode 100644 index 0000000..ff257aa --- /dev/null +++ b/QBF/qbf.ml @@ -0,0 +1,1005 @@ +(* ====================================================== *) +(* Squolem proof reconstruction *) +(* (c) Copyright, Ondřej Kunčar 2010-11 *) +(* ====================================================== *) + + +set_jrh_lexer;; + +let show_progress = ref false;; +let show_timing = ref false;; +let delete_qbf_tempfiles = ref true;; + +type quantifier = Existential of term | Universal of term;; + +let make_variable index = + if index <= 0 then failwith "Variable of index 0 or lesser is not allowed" + else mk_var ("v_"^(string_of_int index), bool_ty) +;; + +let make_literal index = + if index < 0 then mk_neg (make_variable (-index)) + else make_variable index +;; + +let destroy_variable var = + let var_string = string_of_term var in + int_of_string (String.sub var_string 2 (String.length var_string -2)) +;; + +let destroy_literal lit = + match is_neg lit with + true -> - destroy_variable (dest_neg lit) + | false -> destroy_variable lit +;; + +let get_quant_var quantifier = + match quantifier with + Existential t -> t + | Universal t -> t +;; + +let has_quant tm = + Pervasives.(||) (is_exists tm) (is_forall tm) +;; + +let dest_quant tm = + if is_exists tm then dest_exists tm + else dest_forall tm +;; + +module type Qbfcontextsig = +sig + type variables = (int,unit) Hashtbl.t;; + type extensions = (int,term) Hashtbl.t;; + + type quantifiers = quantifier list;; + type aux_variables = int list;; + type q_levels = int array;; + type context = { + (** all variables, i.e, variables in a formula and auxiliary variables from extensions *) + variables:variables; + extensions:extensions; + mutable aux_variables:aux_variables; + (** quantifiers prefix in bottom-up ordering *) + mutable quantifiers:quantifiers; + mutable q_levels:q_levels; + mutable q_ordered_levels:q_levels };; + + val create_context : int -> context + (** quantifiers must be in bottom-up ordering *) + val set_quantifiers : context -> quantifiers -> unit + val check_variable : context -> int -> unit + val check_fresh_variable : context -> int -> unit + val add_universal_variable : context -> int -> unit + val add_existential_variable : context -> int -> unit + val add_extension : context -> int -> term -> unit + val add_conclusion_eq : context -> int -> term -> unit + val get_extensions : context -> (term * term) list + val get_extension : context -> int -> term + val get_quantifiers : context -> quantifiers + val get_aux_variables : context -> aux_variables + val make_quantifiers_levels : context -> unit + val make_ordered_quantifiers_levels : context -> unit + val lt_levels : context -> int -> int -> bool + val lt_ordered_levels : context -> int -> int -> bool +end;; + +module Qbfcontext : Qbfcontextsig = +struct + type variables = (int,unit) Hashtbl.t;; + type extensions = (int,term) Hashtbl.t;; + + type quantifiers = quantifier list;; + type aux_variables = int list;; + type q_levels = int array;; + type context = { + variables:variables; + extensions:extensions; + mutable aux_variables:aux_variables; + mutable quantifiers:quantifiers; + mutable q_levels:q_levels; + mutable q_ordered_levels:q_levels + };; + + let create_context var_count = + { variables = Hashtbl.create (2*var_count); + extensions = Hashtbl.create var_count; + aux_variables = []; + quantifiers = []; + q_levels = Array.make 0 0; + q_ordered_levels = Array.make 0 0 } + ;; + + let set_quantifiers context quants = + context.quantifiers <- quants + ;; + + let check_variable context var_index = + if not (Hashtbl.mem context.variables var_index) then failwith ((string_of_int var_index)^" is undefined variable") + ;; + + let check_fresh_variable context var_index = + if Hashtbl.mem context.variables var_index then failwith ((string_of_int var_index)^" is not a fresh variable") + ;; + + let add_universal_variable context var_index = + check_fresh_variable context var_index; + Hashtbl.add context.variables var_index () + ;; + + let add_existential_variable context var_index = + check_fresh_variable context var_index; + Hashtbl.add context.variables var_index (); + Hashtbl.add context.extensions var_index `T` + ;; + + let add_aux_variable context var_index = + check_fresh_variable context var_index; + Hashtbl.add context.variables var_index (); + context.aux_variables <- var_index::context.aux_variables + ;; + + let add_aux_quantifier context var_index free_variables = + let quantifier = Existential (make_variable var_index) in + let rec remove_from_list l ls = + match ls with + [] -> [] + | l'::ls' when l'=l -> ls' + | l'::ls'-> l'::remove_from_list l ls' + in + let rec insert_quantifier quantifiers free_variables = + match free_variables with + [] -> quantifier::quantifiers + | _ -> match quantifiers with + q::qs -> q::(insert_quantifier qs (remove_from_list (get_quant_var q) free_variables)) + | [] -> failwith "add_aux_quantifier: logic error" + in + context.quantifiers <- List.rev ((insert_quantifier (List.rev context.quantifiers) free_variables)) + ;; + + let add_extension context var_index formula = + add_aux_variable context var_index; + add_aux_quantifier context var_index (variables formula); + Hashtbl.add context.extensions var_index formula + ;; + + let add_conclusion_eq context var_index formula = + Hashtbl.replace context.extensions var_index formula + ;; + + let get_extension context var_index = + Hashtbl.find context.extensions var_index + ;; + + let get_extensions context = + Hashtbl.fold (fun f s l -> (make_variable f,s)::l) context.extensions [] + ;; + + let get_quantifiers context = + context.quantifiers + ;; + + let get_aux_variables context = + context.aux_variables + ;; + + let make_quantifiers_levels_inter context = + let quantifiers = context.quantifiers in + let rec loop arr quants level = + match quants with + [] -> arr + | q::qs -> + arr.(((destroy_variable o get_quant_var) q) - 1) <- level; + loop arr qs (level - 1) + in + let arr = Array.make (List.length quantifiers) 0 in + let arr' = loop arr quantifiers (List.length quantifiers) in + arr' + ;; + + let make_quantifiers_levels context = + context.q_levels <- make_quantifiers_levels_inter context + ;; + + let make_ordered_quantifiers_levels context = + context.q_ordered_levels <- make_quantifiers_levels_inter context + ;; + + let lt_levels context v1 v2 = + context.q_levels.(v1-1) < context.q_levels.(v2-1) + ;; + + let lt_ordered_levels context v1 v2 = + context.q_ordered_levels.(v1-1) < context.q_ordered_levels.(v2-1) + ;; + +end;; + + open Qbfcontext;; + +let rec strip_quantifiers tm = + if is_forall tm then + let (var,tm') = dest_forall tm in + let (q',body) = (strip_quantifiers tm') in + ((Universal var)::q',body) + else if is_exists tm then + let (var,tm') = dest_exists tm in + let (q',body) = (strip_quantifiers tm') in + ((Existential var)::q',body) + else ([],tm) +;; + +(** strip quantifiers in bottom-up ordering *) +let strip_quantifiers_r tm = + let rec loop tm acc = + if is_forall tm then + let (var,tm') = dest_forall tm in + loop tm' ((Universal var)::acc) + else if is_exists tm then + let (var,tm') = dest_exists tm in + loop tm' ((Existential var)::acc) + else (acc,tm) + in loop tm [] +;; + +(** strip quantifiers in bottom-up ordering *) +let strip_quantifiers_rx tm = + let rec loop tm acc = + if is_forall tm then + let (var,tm') = dest_forall tm in + loop tm' ((true, var)::acc) + else if is_exists tm then + let (var,tm') = dest_exists tm in + loop tm' ((false, var)::acc) + else (acc,tm) + in loop tm [] +;; + +let quantifiers_fold_left exist_fn universal_fn thm quantifiers = + let quant_fn thm quantifier = + match quantifier with + Universal var -> universal_fn var thm + | Existential var -> exist_fn var thm + in + List.fold_left quant_fn thm quantifiers +;; + +let is_negated lit_ind = lit_ind < 0;; + +let read_index token_stream = + let index_token = Stream.next token_stream in + match index_token with + Genlex.Int index -> index + | _ -> failwith "Bad index of variable" +;; + +let var = abs;; + +let read_extension_ite context new_var_index token_stream = + let x_v_i = read_index token_stream in + let y_v_i = read_index token_stream in + let z_v_i = read_index token_stream in + check_variable context (var x_v_i); + check_variable context (var y_v_i); + check_variable context (var z_v_i); + let x_v = make_literal x_v_i in + let y_v = make_literal y_v_i in + let z_v = make_literal z_v_i in + let formula = mk_disj (mk_conj (x_v,y_v),mk_conj(mk_neg x_v,z_v)) in + add_extension context new_var_index formula; +;; + +let read_extension_and context new_var_index token_stream = + let rec read_conjucts context token_stream = + let lit_ind = read_index token_stream in + if lit_ind = 0 then [] + else + begin + check_variable context (var lit_ind); + (make_literal lit_ind)::(read_conjucts context token_stream) + end + in + let conjucts = read_conjucts context token_stream in + let conjucts' = match conjucts with + [] -> `T` + | _ -> list_mk_conj conjucts + in + add_extension context new_var_index conjucts'; +;; + +let read_extension_line context token_stream = + let new_var_index = read_index token_stream in + let extension_type = Stream.next token_stream in + match extension_type with + Genlex.Kwd "I" -> read_extension_ite context new_var_index token_stream + | Genlex.Kwd "A" -> read_extension_and context new_var_index token_stream + | _ -> failwith "Unknown type of extension line" +;; + +let read_header context token_stream = + match Stream.next token_stream with + Genlex.Kwd "QBCertificate" -> () + | _ -> failwith "Missing header" +;; + +let read_resolution_line context token_stream = + failwith "Resolution line: not yet implemented!"; +() +;; + +let rec read_equalities context token_stream = + try + let exist_var_i = read_index token_stream in + check_variable context exist_var_i; + let extension_var_i = read_index token_stream in + check_variable context (var extension_var_i); + let extension_var = make_literal extension_var_i in + add_conclusion_eq context exist_var_i extension_var; + read_equalities context token_stream + with Stream.Failure -> () +;; + +let read_conlude_line context token_stream = + match Stream.next token_stream with + Genlex.Kwd "VALID" -> read_equalities context token_stream + | Genlex.Kwd "INVALID" -> failwith "INVALID formula: not yet implemted!" + | _ -> failwith "Unknown type of conclusion" +;; + +let read_certificate context token_stream = + read_header context token_stream; + let rec read_line context token_stream = + match Stream.next token_stream with + Genlex.Kwd "E" -> read_extension_line context token_stream; read_line context token_stream + | Genlex.Kwd "R" -> read_resolution_line context token_stream; read_line context token_stream + | Genlex.Kwd "CONCLUDE" -> read_conlude_line context token_stream + | _ -> failwith "Unknown type of line" + in + read_line context token_stream +;; + +let PROPAGATE_FORALL = + let MONO_FORALL_B = (UNDISCH o prove) + (`(!x:bool. A x ==> B x) ==> (!) A ==> (!) B`, + STRIP_TAC THEN + GEN_REWRITE_TAC (BINOP_CONV o RAND_CONV) [GSYM ETA_AX] THEN + ASM_MESON_TAC[]) in + let a_tm = rand(lhand(concl MONO_FORALL_B)) + and b_tm = rand(rand(concl MONO_FORALL_B)) + and h_tm = hd(hyp MONO_FORALL_B) in + fun v1 -> + let ath = GEN_ALPHA_CONV v1 h_tm in + let atm = rand(concl ath) in + let pth = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) MONO_FORALL_B in + fun thm -> + let tm = concl thm in + let ip,q = dest_comb tm in + let i,p = dest_comb ip in + let pabs = mk_abs(v1,p) + and qabs = mk_abs(v1,q) in + let th1 = AP_TERM i (BETA(mk_comb(pabs,v1))) in + let th2 = MK_COMB(th1,BETA(mk_comb(qabs,v1))) in + let th3 = GEN v1 (EQ_MP (SYM th2) thm) in + let th4 = INST [pabs,a_tm; qabs,b_tm] pth in + PROVE_HYP th3 th4;; + +let PROPAGATE_RIGHT = + let MONO_EXISTS_RIGHT_B = (UNDISCH o prove) + (`(A ==> B(x:bool)) ==> A ==> (?) B`, + ASM_CASES_TAC `A:bool` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + MESON_TAC[]) in + let a_tm = lhand(concl MONO_EXISTS_RIGHT_B) + and b_tm = rand(rand(concl MONO_EXISTS_RIGHT_B)) + and h_tm = hd(hyp MONO_EXISTS_RIGHT_B) in + let x_tm = rand(rand h_tm) in + fun v thm -> + let tm = concl thm in + let ip,q = dest_comb tm in + let qabs = mk_abs(v,q) in + let th1 = AP_TERM ip (BETA(mk_comb(qabs,v))) in + let th2 = EQ_MP (SYM th1) thm in + let th3 = INST [rand ip,a_tm; qabs,b_tm; v,x_tm] MONO_EXISTS_RIGHT_B in + PROVE_HYP th2 th3;; + +let PROPAGATE_LEFT = + let MONO_EXISTS_LEFT_B = (UNDISCH o prove) + (`(!x:bool. A x ==> B) ==> (?) A ==> B`, + ASM_CASES_TAC `B:bool` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (funpow 3 RAND_CONV) [GSYM ETA_AX] THEN + MESON_TAC[]) in + let a_tm = rand(lhand(concl MONO_EXISTS_LEFT_B)) + and b_tm = rand(concl MONO_EXISTS_LEFT_B) + and h_tm = hd(hyp MONO_EXISTS_LEFT_B) in + fun v -> + let ath = GEN_ALPHA_CONV v h_tm in + let atm = rand(concl ath) in + let pth = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) MONO_EXISTS_LEFT_B in + fun thm -> + let tm = concl thm in + let ip,q = dest_comb tm in + let i,p = dest_comb ip in + let pabs = mk_abs(v,p) in + let th1 = AP_THM (AP_TERM i (BETA(mk_comb(pabs,v)))) q in + let th2 = GEN v (EQ_MP (SYM th1) thm) in + let th3 = INST [pabs,a_tm; q,b_tm] pth in + PROVE_HYP th2 th3;; + +let PROPAGATE_QUANTIFIERS_R thm ext_quants quants = + let rec propagate_both thm ext_quants quants = + match (ext_quants,quants) with + | ((Universal v1)::ext_quantss,(Universal v2)::quantss) -> + propagate_both (PROPAGATE_FORALL v1 thm) ext_quantss quantss + | (_,_) -> (thm,ext_quants,quants) + in + let rec propagate_right thm quants = + match quants with + | (Existential v)::quantss -> + propagate_right (PROPAGATE_RIGHT v thm) quantss + | _ -> (thm,quants) + in + let rec propagate_left thm ext_quants = + match ext_quants with + | (Existential v)::ext_quantss -> + propagate_left (PROPAGATE_LEFT v thm) ext_quantss + | _ -> (thm,ext_quants) + in + let rec propagate thm ext_quants quants = + match (ext_quants,quants) with + | ([],[]) -> thm + | (_,((Existential _)::_)) -> + let (thm',quants') = propagate_right thm quants in + let (thm'',ext_quants') = propagate_left thm' ext_quants in + propagate thm'' ext_quants' quants' + | (((Existential _)::_),_) -> + let (thm',ext_quants') = propagate_left thm ext_quants in + propagate thm' ext_quants' quants + | ((Universal _)::_,(Universal _)::_) -> + let (thm',ext_quants',quants') = propagate_both thm ext_quants quants in + propagate thm' ext_quants' quants' + | _ -> failwith "PROPAGATE_QUANTIFIERS_R: logic error" + in + propagate thm ext_quants quants +;; + +let order_quantifiers context = + let add_var vertices graph var_index = + Gr.add_vertex graph (make_vertex var_index); + let extension_vars = variables (get_extension context var_index) in + let add_ext_var ext_var = + let ext_var_index = destroy_variable ext_var in + if Hashtbl.mem vertices ext_var_index then + Gr.add_edge graph (make_vertex ext_var_index) (make_vertex var_index) + in + List.iter add_ext_var extension_vars + in + let rec is_sorted var_index_list = + let is_sorted_var var_index = + let extension_vars = variables (get_extension context var_index) in + List.fold_left (fun ret var -> ret && lt_levels context (destroy_variable var) var_index) true extension_vars + in + match var_index_list with + [] -> true + | var::vars -> if is_sorted_var var then is_sorted vars + else false + in + (** exists is in up-bottom ordering *) + let rec order_exists quantifiers exists = + let order_exists' tail = + if is_sorted exists then + List.fold_left (fun tail var_index -> (Existential (make_variable var_index))::tail) tail exists + else + let graph = Gr.create () in + let vertices = Hashtbl.create (List.length exists) in + List.iter (fun var -> Hashtbl.add vertices var ()) exists; + List.iter (fun var -> add_var vertices graph var) exists; + Topo.fold (fun vertex tail -> (Existential (make_variable (dest_vertex vertex)))::tail) graph tail + in + match quantifiers with + [] -> order_exists' [] + | (Universal v)::qs -> order_exists' ((Universal v)::order qs) + | (Existential v)::qs -> + order_exists qs ((destroy_variable v)::exists) + and + order quantifiers = + match quantifiers with + [] -> [] + | (Universal v)::qs -> (Universal v)::order qs + | (Existential v)::qs -> + order_exists ((Existential v)::qs) [] + in + set_quantifiers context (order (get_quantifiers context)); + make_ordered_quantifiers_levels context +;; + +let match_time = ref 0.0;; +let lift_time = ref 0.0;; +let gen_time = ref 0.0;; +let test_time = ref 0.0;; + + +let timex label f x = + if not (!show_timing) then f x else + let start_time = Sys.time() in + try let result = f x in + let finish_time = Sys.time() in + report("CPU time (user): "^(string_of_float(finish_time -. start_time))^" ("^label^")"); + result + with e -> + let finish_time = Sys.time() in + Format.print_string("Failed after (user) CPU time of "^ + (string_of_float(finish_time -. start_time))^" ("^label^")"^": "); + raise e;; + +let my_time f x time_var = + if not (!show_timing) then f x else + let start_time = Sys.time() in + try let result = f x in + let finish_time = Sys.time() in + time_var := !time_var +. (finish_time -. start_time); + result + with e -> + let finish_time = Sys.time() in + time_var := !time_var +. (finish_time -. start_time); + raise e;; + +let report_time label time_var = + if !show_timing then + report("CPU time (user): "^(string_of_float(!time_var))^" ("^label^")"); +;; + +let FORALL_SIMP2 = prove + (`t = (!x:bool. t)`, + ITAUT_TAC);; + +let ADD_MISSING_UNIVERSALS th quants = + let rec add_u quants tm = + match quants with + | [] -> REFL tm + | q::qs -> + match q with + | Existential _ -> BINDER_CONV (add_u qs) tm + | Universal v -> + if Pervasives.(||) (not (has_quant tm)) (Pervasives.compare ((fst o dest_quant) tm) v != 0) then + let renamed_rewr = EQ_MP (ONCE_DEPTH_CONV (ALPHA_CONV v) (concl FORALL_SIMP2)) FORALL_SIMP2 in + (PURE_ONCE_REWRITE_CONV [renamed_rewr] THENC BINDER_CONV (add_u qs)) tm + else + BINDER_CONV (add_u qs) tm + in + EQ_MP (add_u (rev quants) (concl th)) th +;; + +let AX_UXU = (UNDISCH o prove) + (`(!x:bool. p x /\ q ==> r x) ==> (!) p /\ q ==> (!) r`, + let AX_UXU = MESON [] `(!x:bool. ((A x /\ B)==>C x))==>(((!x:bool. A x) /\ B)==> !x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_UXU) THEN REWRITE_TAC[ETA_AX]) +and AX_EXE = (UNDISCH o prove) + (`(!x:bool. p x /\ q ==> r x) ==> (?) p /\ q ==> (?) r`, + let AX_EXE = MESON [] `(!x:bool. ((A x /\ B)==>C x))==>(((?x:bool. A x) /\ B)==> ?x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_EXE) THEN REWRITE_TAC[ETA_AX]);; + +let LIFT_LEFT ax = + let p_tm = rand(lhand(lhand(concl ax))) + and q_tm = rand(lhand(concl ax)) + and r_tm = rand(rand(concl ax)) + and h_tm = hd(hyp ax) in + fun var -> + let ath = GEN_ALPHA_CONV var h_tm in + let atm = rand(concl ath) in + let ax' = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) ax in + fun th -> + let tm = concl th in + let ipq,r = dest_comb tm in + let i,pq = dest_comb ipq in + let ap,q = dest_comb pq in + let a,p = dest_comb ap in + let pabs = mk_abs(var,p) + and rabs = mk_abs(var,r) in + let th1 = AP_THM (AP_TERM a (BETA(mk_comb(pabs,var)))) q in + let th2 = MK_COMB(AP_TERM i th1,BETA(mk_comb(rabs,var))) in + let th3 = GEN var (EQ_MP (SYM th2) th) in + let th4 = INST [pabs,p_tm; q,q_tm; rabs,r_tm] ax' in + PROVE_HYP th3 th4;; + +let AX_XUU = (UNDISCH o prove) + (`(!x:bool. p /\ q x ==> r x) ==> p /\ (!) q ==> (!) r`, + let AX_XUU = MESON [] `(!x:bool. ((A /\ B x)==>C x))==>((A /\ !x:bool. B x)==> !x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_XUU) THEN REWRITE_TAC[ETA_AX]) +and AX_XEE = (UNDISCH o prove) + (`(!x:bool. p /\ q x ==> r x) ==> p /\ (?) q ==> (?) r`, + let AX_XEE = MESON [] `(!x:bool. ((A /\ B x)==>C x))==>((A /\ ?x:bool. B x)==> ?x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_XEE) THEN REWRITE_TAC[ETA_AX]);; + +let LIFT_RIGHT ax = + let p_tm = lhand(lhand(concl ax)) + and q_tm = rand(rand(lhand(concl ax))) + and r_tm = rand(rand(concl ax)) + and h_tm = hd(hyp ax) in + fun var -> + let ath = GEN_ALPHA_CONV var h_tm in + let atm = rand(concl ath) in + let ax' = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) ax in + fun th -> + let tm = concl th in + let ipq,r = dest_comb tm in + let i,pq = dest_comb ipq in + let ap,q = dest_comb pq in + let a,p = dest_comb ap in + let qabs = mk_abs(var,q) + and rabs = mk_abs(var,r) in + let th1 = AP_TERM ap (BETA(mk_comb(qabs,var))) in + let th2 = MK_COMB(AP_TERM i th1,BETA(mk_comb(rabs,var))) in + let th3 = GEN var (EQ_MP (SYM th2) th) in + let th4 = INST [p,p_tm; qabs,q_tm; rabs,r_tm] ax' in + PROVE_HYP th3 th4;; + +let AX_UUU = (UNDISCH o prove) + (`(!x:bool. p x /\ q x ==> r x) ==> (!) p /\ (!) q ==> (!) r`, + let AX_UUU = MESON [] `(!x:bool. ((A x /\ B x)==>C x))==>(((!x:bool. A x) /\ !x:bool. B x)==> !x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_UUU) THEN REWRITE_TAC[ETA_AX]) +and AX_EUE = (UNDISCH o prove) + (`(!x:bool. p x /\ q x ==> r x) ==> (?) p /\ (!) q ==> (?) r`, + let AX_EUE = MESON [] `(!x:bool. ((A x /\ B x)==>C x))==>(((?x:bool. A x) /\ !x:bool. B x)==> ?x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_EUE) THEN REWRITE_TAC[ETA_AX]) +and AX_UEE = (UNDISCH o prove) + (`(!x:bool. p x /\ q x ==> r x) ==> (!) p /\ (?) q ==> (?) r`, + let AX_UEE = MESON [] `(!x:bool. ((A x /\ B x)==>C x))==>(((!x:bool. A x) /\ ?x:bool. B x)==> ?x:bool. C x)` in + DISCH_THEN(MP_TAC o MATCH_MP AX_UEE) THEN REWRITE_TAC[ETA_AX]);; + +let LIFT_BOTH ax = + let p_tm = rand(lhand(lhand(concl ax))) + and q_tm = rand(rand(lhand(concl ax))) + and r_tm = rand(rand(concl ax)) + and h_tm = hd(hyp ax) in + fun var -> + let ath = GEN_ALPHA_CONV var h_tm in + let atm = rand(concl ath) in + let ax' = PROVE_HYP (EQ_MP (SYM ath) (ASSUME atm)) ax in + fun th -> + let tm = concl th in + let ipq,r = dest_comb tm in + let i,pq = dest_comb ipq in + let ap,q = dest_comb pq in + let a,p = dest_comb ap in + let pabs = mk_abs(var,p) + and qabs = mk_abs(var,q) + and rabs = mk_abs(var,r) in + let th0 = AP_TERM a (BETA(mk_comb(pabs,var))) in + let th1 = MK_COMB(th0,BETA(mk_comb(qabs,var))) in + let th2 = MK_COMB(AP_TERM i th1,BETA(mk_comb(rabs,var))) in + let th3 = GEN var (EQ_MP (SYM th2) th) in + let th4 = INST [pabs,p_tm; qabs,q_tm; rabs,r_tm] ax' in + PROVE_HYP th3 th4;; + +let solve_quantifiers context conjuction = + let solve_right_quantifier thm quant2 = + match quant2 with + | Universal v2 -> LIFT_RIGHT AX_XUU v2 thm + | Existential v2 -> LIFT_RIGHT AX_XEE v2 thm + in + let solve_left_quantifier thm quant1 = + match quant1 with + | Universal v1 -> LIFT_LEFT AX_UXU v1 thm + | Existential v1 -> LIFT_LEFT AX_EXE v1 thm + in + let solve_both_quantifiers thm quant1 quant2 = + match (quant1,quant2) with + (Universal v1, Universal v2) -> LIFT_BOTH AX_UUU v1 thm + | (Existential v1, Universal v2) -> LIFT_BOTH AX_EUE v1 thm + | (Universal v1, Existential v2) -> LIFT_BOTH AX_UEE v1 thm + | _ -> failwith "Logic error in solve_quantifier" + in + let rec loop thm quants1 quants2 = + match (quants1,quants2) with + | ([],[]) -> thm + | (qs1,[]) -> List.fold_left solve_left_quantifier thm qs1 + | ([],qs2) -> List.fold_left solve_right_quantifier thm qs2 + | (quant1::qs1,quant2::qs2) -> + let quant_var1 = get_quant_var quant1 in + let quant_var2 = get_quant_var quant2 in + if quant_var1 = quant_var2 then + let thm' = solve_both_quantifiers thm quant1 quant2 in + loop thm' qs1 qs2 + else + if lt_ordered_levels context (destroy_variable quant_var1) (destroy_variable quant_var2) then + let thm' = solve_right_quantifier thm quant2 in + loop thm' (quant1::qs1) qs2 + else + let thm' = solve_left_quantifier thm quant1 in + loop thm' qs1 (quant2::qs2) + in + let conclusion = concl conjuction in + let (conj1,conj2) = dest_conj conclusion in + let (quants1,body1) = strip_quantifiers_r conj1 in + let (quants2,body2) = strip_quantifiers_r conj2 in + + let rew_thm = loop (DISCH_ALL (ASSUME (mk_conj (body1,body2)))) quants1 quants2 in + (*print_thm rew_thm; + print_newline (); + print_thm conjuction; + print_newline ();*) + my_time (MP rew_thm) conjuction match_time +;; + +let make_quantified_model_equality = + let pth = MESON[] `?x:bool. x = t` in + let t_tm = rand(body(rand(concl pth))) in + fun quantifier_data (exist_var,right_side) -> + let free_vars = frees right_side in + let n = quantifier_data exist_var in + let quants = sort (decreasing quantifier_data) + (filter (fun v -> quantifier_data v > n) free_vars) in + let exist_eq_thm = INST[right_side,t_tm] (CONV_RULE(GEN_ALPHA_CONV exist_var) pth) in + let ret = GENL quants exist_eq_thm in + (* print_thm ret; + print_endline ""; *) + ret +;; + +let construct_model context equalities = + match equalities with + [] -> `T` + | (eq::eqs) -> List.fold_left (C (curry mk_conj)) eq eqs +;; + +let construct_model_thm context equalities = + let eq_length = List.length equalities in + let progress = ref 1 in + let print_progress () = + print_endline ((string_of_int o int_of_float) (((float_of_int !progress)/.(float_of_int eq_length))*.100.0)) + in + let construct model eq = + + let ret = solve_quantifiers context (CONJ eq model) in + + if !show_progress then + begin + progress := !progress + 1; + print_progress (); + end; + ret + in + let rec construct_recursively eqs = + match eqs with + [] -> failwith "Sanity check failure" + | [e] -> e + | [e1;e2] -> construct e1 e2 + | _ -> let n = length eqs in + let eqs1,eqs2 = chop_list (length eqs / 2) eqs in + construct (construct_recursively eqs1) (construct_recursively eqs2) + in + if equalities = [] then quantifiers_fold_left SIMPLE_EXISTS GEN TRUTH (get_quantifiers context) + else PURE_REWRITE_RULE[GSYM CONJ_ASSOC] (construct_recursively equalities);; + +let make_model context = + let model_equalities = get_extensions context in + let model = construct_model context (List.map mk_eq model_equalities) in + let quantifier_list = map (function Universal v -> v | Existential v -> v) + (get_quantifiers context) in + let quantifier_table = itlist2 (|->) quantifier_list (1--length quantifier_list) undefined in + let quantifier_data = apply quantifier_table in + let quantified_equalities = timex "make_quantified_equalities" (List.map (make_quantified_model_equality quantifier_data)) model_equalities in + let model_thm = + match_time := 0.0; + lift_time := 0.0; + gen_time := 0.0; + test_time := 0.0; + print_endline ("Number of extensions: "^ (string_of_int (List.length model_equalities))); + let ret = timex "construct_model_thm" (construct_model_thm context) quantified_equalities in + report_time "lift" lift_time; + report_time "match" match_time; + report_time "gen" gen_time; + report_time "test" test_time; + ret + in + (*let model_thm = construct_model_thm context (List.map (make_quantified_model_equality context) model_equalities) in*) + (model, model_thm) +;; + +let check_and_preprocess context formula = + match frees formula with + [ _ ] -> failwith "Formula has free variables" + | _ -> + let nnf_thm = NNF_CONV formula in + let prenex_thm = TRANS nnf_thm (PRENEX_CONV (rhs (concl nnf_thm))) in + let cnf_thm = TRANS prenex_thm (CNF_CONV (rhs (concl prenex_thm))) in + + let rec check_and_made_rename formula index rename = + let rename_quantifier constr destr add_fresh_variable = + let (var,destr_formula) = destr formula in + if type_of var <> bool_ty then failwith ((string_of_term var)^" is not of bool type"); + add_fresh_variable context index; + let formula2 = check_and_made_rename destr_formula (index+1) ((make_variable index,var)::rename) in + constr (make_variable index,formula2) + in + if is_forall formula then rename_quantifier mk_forall dest_forall add_universal_variable + else if is_exists formula then rename_quantifier mk_exists dest_exists add_existential_variable + else + vsubst rename formula + in + let prenex_formula = rhs (concl cnf_thm) in + let ret = TRANS cnf_thm (ALPHA prenex_formula (check_and_made_rename prenex_formula 1 [])) in + let (quantifiers',_) = strip_quantifiers_r (rhs (concl ret)) in + set_quantifiers context quantifiers'; + ret +;; + +let get_temp_file () = + Filename.open_temp_file "qbf" "" +;; + +let split_disjuncts body = + List.fold_right + (fun c d -> (disjuncts c) :: d) + (conjuncts body) [] +;; + +let string_of_literal lit = + string_of_int (destroy_literal lit); +;; + +type prefix = Exists of term list | Forall of term list;; + +let rec strip_quantifiers_as_prefix formula = + if is_forall formula then + let (quants,formula') = strip_forall formula in + let (quants',body) = strip_quantifiers_as_prefix formula' in + ((Forall quants)::quants',body) + else if is_exists formula then + let (quants,formula') = strip_exists formula in + let (quants',body) = strip_quantifiers_as_prefix formula' in + ((Exists quants)::quants',body) + else + ([],formula) +;; + +let make_input context formula var_count = + let (file_name,file_stream) = get_temp_file () in + try + let (quantifiers_list, body) = strip_quantifiers_as_prefix formula in + let clause_count = length(conjuncts body) in + + + let disjuncts_list = split_disjuncts body in + + let out s = output_string file_stream s in + let formula_string = Str.global_replace (Str.regexp_string "\n") "\nc " (string_of_term formula) in + out "c "; out formula_string;out "\n"; + out "c\n"; + out "p cnf "; + out (string_of_int var_count); out " "; + out (string_of_int clause_count); out "\n"; + + let print_quantifiers q = + let print_vars q = + List.iter (fun var -> (out(string_of_literal var); out " ")) q; + out "0\n" + in + match q with + Exists vars -> out "e "; print_vars vars + | Forall vars -> out "a "; print_vars vars + in + + List.iter + (fun q -> print_quantifiers q) + quantifiers_list; + + List.iter + (fun l -> (List.iter (fun lit -> + (out(string_of_literal lit); out " ")) l; + out "0\n")) + disjuncts_list; + close_out file_stream; + file_name + with x -> + close_out file_stream; + raise x +;; + +let execute_squolem input_file_name = + let exec_name = "squolem2 -c " ^ input_file_name in + let _ = Sys.command exec_name in + input_file_name ^ ".qbc" +;; + +let parse_certificate context certificate_file_name = + let file_channel = Pervasives.open_in certificate_file_name in + let token_stream = (Genlex.make_lexer ["I";"A";"QBCertificate";"VALID";"INVALID";"E";"R";"CONCLUDE"] (Stream.of_channel file_channel)) in + read_certificate context token_stream + +let print_model context = + let (model, model_thm) = make_model context in + print_endline (string_of_term model); + print_endline (string_of_thm model_thm) +;; + +let print_quantifiers context = + let print_quantifier quant = + match quant with + Existential v -> print_string "E "; print_term v; print_string " " + | Universal v -> print_string "F "; print_term v; print_string " " + in + List.iter print_quantifier (get_quantifiers context); + print_newline () +;; + +let ZSAT_PROVE' = + let ASSOC_EQ_CONV th = + let assoc_canon = ASSOC_CONV th in + fun tm -> let l,r = dest_eq tm in + TRANS (assoc_canon l) (SYM(assoc_canon r)) in + let opacs = [`\/`,ASSOC_EQ_CONV DISJ_ASSOC; + `/\`,ASSOC_EQ_CONV CONJ_ASSOC; + `<=>`,ASSOC_EQ_CONV(TAUT `(t1 <=> t2 <=> t3) <=> ((t1 <=> t2) <=> t3)`)] in + let rec ASSOC_BALANCE_CONV tm = + match tm with + Comb(Comb(op,l),r) when can (assoc op) opacs -> + let tms = striplist (dest_binop op) tm in + let n = length tms in + if n <= 1 then failwith "sanity check failure" else + if n = 2 then BINOP_CONV ASSOC_BALANCE_CONV tm else + let tms1,tms2 = chop_list (n / 2) tms in + let tm1 = list_mk_binop op tms1 + and tm2 = list_mk_binop op tms2 in + let th = assoc op opacs (mk_eq(tm,mk_binop op tm1 tm2)) in + CONV_RULE (RAND_CONV (BINOP_CONV ASSOC_BALANCE_CONV)) th + | _ -> REFL tm in + let conv = DEPTH_BINOP_CONV `(/\)` (NNFC_CONV THENC CNF_CONV) in + fun tm -> let th = COMB2_CONV (RAND_CONV conv) ASSOC_BALANCE_CONV tm in + let tm' = rand(concl th) in + EQ_MP (SYM th) (ZSAT_PROVE tm');; + +let build_proof context prenex_thm = + let formula = rhs (concl prenex_thm) in + let (quants,formula_body) = strip_quantifiers_r formula in + timex "make_q_levels" make_quantifiers_levels context; + (*print_quantifiers context;*) + timex "order_qs" order_quantifiers context; + (*print_quantifiers context;*) + let (model, model_thm) = timex "make_model" make_model context in + let sat_formula = mk_imp (model,formula_body) in + let proved_sat_formula = timex "sat" ZSAT_PROVE' sat_formula in + let q_propagated_formula = timex "propagate" (PROPAGATE_QUANTIFIERS_R proved_sat_formula (get_quantifiers context)) quants in + let (model_quantifiers,_) = strip_quantifiers_r (concl model_thm) in + let proved_formula = + if List.length model_quantifiers != List.length (get_quantifiers context) then + MP q_propagated_formula (timex "add_missing" (ADD_MISSING_UNIVERSALS model_thm) (get_quantifiers context)) + else + (*MP q_propagated_formula model_thm*) + MP q_propagated_formula (timex "add_missing" (ADD_MISSING_UNIVERSALS model_thm) (get_quantifiers context)) + in + EQ_MP (GSYM prenex_thm) proved_formula +;; + +let prove_qbf formula = + let var_count = length (variables formula) in + let context = create_context var_count in + let prenex_thm = timex "prep" (check_and_preprocess context) formula in + let input_file_name = timex "make_input" (make_input context (rand (concl prenex_thm))) var_count in + let output_file_name = timex "ex_squolem" execute_squolem input_file_name in + let _ = timex "parse_cert" (parse_certificate context) output_file_name in + let thm = timex "build_proof" (build_proof context) prenex_thm in + (if !delete_qbf_tempfiles + then (Sys.remove input_file_name; Sys.remove output_file_name) + else ()); + thm +;; + +let prove_all_qbf dir = + let filter_array f a = + let l = Array.to_list a in + let ll = List.filter f l in + Array.of_list ll + in + let raw_files = Sys.readdir dir in + let files = filter_array (fun name -> Filename.check_suffix name ".qdimacs") raw_files in + let run_prover file_name = + let name = Filename.chop_suffix file_name ".qdimacs" in + print_endline name; + let formula = readQDimacs (dir^"/"^file_name) in + let formula_thm = prove_qbf formula in + (name,formula_thm) + in + Array.map run_prover files +;; diff --git a/QBF/qbfr.ml b/QBF/qbfr.ml new file mode 100644 index 0000000..02cb161 --- /dev/null +++ b/QBF/qbfr.ml @@ -0,0 +1,106 @@ +(* Code for reading QDicams. *) +(* Based on Minisat/dimacs_tools.ml *) +(* from HOL Light distribution. *) + + +exception Read_dimacs_error;; + +let prefix = ref "v_" + +let intToPrefixedLiteral n = + if n >= 0 + then mk_var(((!prefix) ^ (string_of_int n)), bool_ty) + else mk_neg(mk_var((!prefix) ^ (string_of_int(abs n)), bool_ty)) + +let buildClause l = + List.fold_left + (fun t n -> mk_disj(intToPrefixedLiteral n, t)) + (intToPrefixedLiteral (hd l)) + (tl l) + +let rec dropLine ins = + match Stream.peek ins with + Some '\n' -> Stream.junk ins + | Some _ -> (Stream.junk ins; dropLine ins) + | None -> raise Read_dimacs_error + +let rec stripPreamble ins = + match Stream.peek ins with + Some 'c' -> (dropLine ins; stripPreamble ins) + | Some 'p' -> (dropLine ins; stripPreamble ins) + | Some _ -> Some () + | None -> None + +let rec getIntClause lex acc = + match + (try Stream.next lex with + Stream.Failure -> Genlex.Kwd "EOF" (* EOF *)) + with + (Genlex.Int 0) -> Some acc + | (Genlex.Int i) -> getIntClause lex (i::acc) + | (Genlex.Kwd "EOF") -> + if List.length acc = 0 + then None + else Some acc + | _ -> raise Read_dimacs_error + +let rec getIntClause2 lex acc = + match Stream.next lex with + (Genlex.Int 0) -> acc + | (Genlex.Int i) -> i::(getIntClause2 lex acc) + | _ -> raise Read_dimacs_error + +let getTerms lex start_acc = + let rec loop acc = + match getIntClause lex [] with + Some ns -> loop (mk_conj(buildClause ns,acc)) + | None -> Some acc in + match getIntClause lex start_acc with + Some ns -> loop (buildClause ns) + | None -> None + +type qs = Qe of int list | Qa of int list;; + +let read_quant lex = + let rec loop acc = + match Stream.next lex with + Genlex.Kwd "e" -> + let vars = getIntClause2 lex [] in + let (acc',var) = loop acc in + ((Qe vars)::acc',var) + | Genlex.Kwd "a" -> + let vars = getIntClause2 lex [] in + let (acc',var) = loop acc in + ((Qa vars)::acc',var) + | Genlex.Int i -> (acc,i) + | _ -> raise Read_dimacs_error + in + loop [] + +let var_map l = + List.map intToPrefixedLiteral l + +let add_quantifiers quant body = + List.fold_right (fun quants b -> match quants with + Qa l -> list_mk_forall (var_map l,b) + | Qe l -> list_mk_exists (var_map l,b) + ) + quant body + +let readTerms ins = + match stripPreamble ins with + Some _ -> + let lex = (Genlex.make_lexer ["EOF";"e";"a"] ins) in + let (quant,var) = read_quant lex in + ( match getTerms lex [var] with + Some body -> Some (add_quantifiers quant body) + | None -> None ) + | None -> None + +let readQDimacs filename = + let inf = open_in filename in + let ins = Stream.of_channel inf in + let term = readTerms ins in + (close_in inf; + match term with Some t -> t | None -> raise Read_dimacs_error) + \ No newline at end of file diff --git a/RichterHilbertAxiomGeometry/HilbertAxiom_read.ml b/RichterHilbertAxiomGeometry/HilbertAxiom_read.ml new file mode 100644 index 0000000..86189fc --- /dev/null +++ b/RichterHilbertAxiomGeometry/HilbertAxiom_read.ml @@ -0,0 +1,3373 @@ +(* ========================================================================= *) +(* HOL Light Hilbert geometry axiomatic proofs *) +(* *) +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* High school students can learn rigorous axiomatic geometry proofs, as in *) +(* http://www.math.northwestern.edu/~richter/hilbert.pdf, using Hilbert's *) +(* axioms, and code up readable formal proofs like these here. Thanks to the *) +(* Mizar folks for their influential language, Freek Wiedijk for his dialect *) +(* miz3 of HOL Light, John Harrison for explaining how to port Mizar code to *) +(* miz3 and writing the first 100+ lines of code here, the hol-info list for *) +(* explaining features of HOL, and Benjamin Kordesh for carefully reading *) +(* much of the paper and the code. Formal proofs are given for the first 7 *) +(* sections of the paper, the results cited there from Greenberg's book, and *) +(* most of Euclid's book I propositions up to Proposition I.29, following *) +(* Hartshorne, whose book seems the most exciting axiomatic geometry text. *) +(* A proof assistant is an invaluable tool to help read it, as Hartshorne's *) +(* proofs are often sketchy and even have gaps. *) +(* *) +(* M. Greenberg, Euclidean and non-Euclidean geometries, Freeman, 1974. *) +(* R. Hartshorne, Geometry, Euclid and Beyond, UTM series, Springer, 2000. *) +(* ========================================================================= *) + +needs "RichterHilbertAxiomGeometry/readable.ml";; + +new_type("point", 0);; +NewConstant("Between", `:point->point->point->bool`);; +NewConstant("Line", `:(point->bool)->bool`);; +NewConstant("≡", `:(point->bool)->(point->bool)->bool`);; + +ParseAsInfix("≅", (12, "right"));; +ParseAsInfix("same_side", (12, "right"));; +ParseAsInfix("≡", (12, "right"));; +ParseAsInfix("<__", (12, "right"));; +ParseAsInfix("<_ang", (12, "right"));; +ParseAsInfix("suppl", (12, "right"));; +ParseAsInfix("∉", (11, "right"));; +ParseAsInfix("∥", (12, "right"));; + +let NOTIN = NewDefinition `; + ∀a l. a ∉ l ⇔ ¬(a ∈ l)`;; + +let INTER_TENSOR = theorem `; + ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∩ t ⊂ s' ∩ t' + by set`;; + +let Interval_DEF = NewDefinition `; + ∀A B. Open (A, B) = {X | Between A X B}`;; + +let Collinear_DEF = NewDefinition `; + Collinear A B C ⇔ + ∃l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l`;; + +let SameSide_DEF = NewDefinition `; + A,B same_side l ⇔ + Line l ∧ ¬ ∃X. X ∈ l ∧ X ∈ Open (A, B)`;; + +let Ray_DEF = NewDefinition `; + ∀A B. ray A B = {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ Open (X, B)}`;; + +let Ordered_DEF = NewDefinition `; + ordered A B C D ⇔ + B ∈ Open (A, C) ∧ B ∈ Open (A, D) ∧ C ∈ Open (A, D) ∧ C ∈ Open (B, D)`;; + +let InteriorAngle_DEF = NewDefinition `; + ∀A O B. int_angle A O B = + {P | ¬Collinear A O B ∧ ∃a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b}`;; + +let InteriorTriangle_DEF = NewDefinition `; + ∀A B C. int_triangle A B C = + {P | P ∈ int_angle A B C ∧ + P ∈ int_angle B C A ∧ + P ∈ int_angle C A B}`;; + +let Tetralateral_DEF = NewDefinition `; + Tetralateral A B C D ⇔ + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B`;; + +let Quadrilateral_DEF = NewDefinition `; + Quadrilateral A B C D ⇔ + Tetralateral A B C D ∧ + Open (A, B) ∩ Open (C, D) = ∅ ∧ + Open (B, C) ∩ Open (D, A) = ∅`;; + +let ConvexQuad_DEF = NewDefinition `; + ConvexQuadrilateral A B C D ⇔ + Quadrilateral A B C D ∧ + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C`;; + +let Segment_DEF = NewDefinition `; + seg A B = {A, B} ∪ Open (A, B)`;; + +let SEGMENT = NewDefinition `; + Segment s ⇔ ∃A B. s = seg A B ∧ ¬(A = B)`;; + +let SegmentOrdering_DEF = NewDefinition `; + s <__ t ⇔ + Segment s ∧ + ∃C D X. t = seg C D ∧ X ∈ Open (C, D) ∧ s ≡ seg C X`;; + +let Angle_DEF = NewDefinition `; + ∡ A O B = ray O A ∪ ray O B`;; + +let ANGLE = NewDefinition `; + Angle α ⇔ ∃A O B. α = ∡ A O B ∧ ¬Collinear A O B`;; + +let AngleOrdering_DEF = NewDefinition `; + α <_ang β ⇔ + Angle α ∧ + ∃A O B G. ¬Collinear A O B ∧ β = ∡ A O B ∧ + G ∈ int_angle A O B ∧ α ≡ ∡ A O G`;; + +let RAY = NewDefinition `; + Ray r ⇔ ∃O A. ¬(O = A) ∧ r = ray O A`;; + +let TriangleCong_DEF = NewDefinition `; + ∀A B C A' B' C'. (A, B, C) ≅ (A', B', C') ⇔ + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' ∧ + ∡ B C A ≡ ∡ B' C' A' ∧ + ∡ C A B ≡ ∡ C' A' B'`;; + +let SupplementaryAngles_DEF = NewDefinition `; + ∀α β. α suppl β ⇔ + ∃A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ β = ∡ B O A'`;; + +let RightAngle_DEF = NewDefinition `; + ∀α. Right α ⇔ ∃β. α suppl β ∧ α ≡ β`;; + +let PlaneComplement_DEF = NewDefinition `; + ∀α. complement α = {P | P ∉ α}`;; + +let CONVEX = NewDefinition `; + Convex α ⇔ ∀A B. A ∈ α ∧ B ∈ α ⇒ Open (A, B) ⊂ α`;; + +let PARALLEL = NewDefinition `; + ∀l k. l ∥ k ⇔ + Line l ∧ Line k ∧ l ∩ k = ∅`;; + +let Parallelogram_DEF = NewDefinition `; + ∀A B C D. Parallelogram A B C D ⇔ + Quadrilateral A B C D ∧ ∃a b c d. + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line b ∧ B ∈ b ∧ C ∈ b ∧ + Line c ∧ C ∈ c ∧ D ∈ d ∧ + Line d ∧ D ∈ d ∧ A ∈ d ∧ + a ∥ c ∧ b ∥ d`;; + +let InteriorCircle_DEF = NewDefinition `; + ∀O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} +`;; + + +(* ------------------------------------------------------------------------- *) +(* Hilbert's geometry axioms, except the parallel axiom P, defined later. *) +(* ------------------------------------------------------------------------- *) + +let I1 = NewAxiom + `;∀A B. ¬(A = B) ⇒ ∃! l. Line l ∧ A ∈ l ∧ B ∈ l`;; + +let I2 = NewAxiom + `;∀l. Line l ⇒ ∃A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)`;; + +let I3 = NewAxiom + `;∃A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + ¬Collinear A B C`;; + +let B1 = NewAxiom + `;∀A B C. Between A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + Between C B A ∧ Collinear A B C`;; + +let B2 = NewAxiom + `;∀A B. ¬(A = B) ⇒ ∃C. Between A B C`;; + +let B3 = NewAxiom + `;∀A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C + ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ + ¬(Between A B C ∧ Between B C A) ∧ + ¬(Between A B C ∧ Between C A B) ∧ + ¬(Between B C A ∧ Between C A B)`;; + +let B4 = NewAxiom + `;∀l A B C. Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃X. X ∈ l ∧ Between A X C) ⇒ + (∃Y. Y ∈ l ∧ Between A Y B) ∨ (∃Y. Y ∈ l ∧ Between B Y C)`;; + +let C1 = NewAxiom + `;∀s O Z. Segment s ∧ ¬(O = Z) ⇒ + ∃! P. P ∈ ray O Z ━ {O} ∧ seg O P ≡ s`;; + +let C2Reflexive = NewAxiom + `;Segment s ⇒ s ≡ s`;; + +let C2Symmetric = NewAxiom + `;Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s`;; + +let C2Transitive = NewAxiom + `;Segment s ∧ Segment t ∧ Segment u ∧ + s ≡ t ∧ t ≡ u ⇒ s ≡ u`;; + +let C3 = NewAxiom + `;∀A B C A' B' C'. B ∈ Open (A, C) ∧ B' ∈ Open (A', C') ∧ + seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' ⇒ + seg A C ≡ seg A' C'`;; + +let C4 = NewAxiom + `;∀α O A l Y. Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l + ⇒ ∃! r. Ray r ∧ ∃B. ¬(O = B) ∧ r = ray O B ∧ + B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α`;; + +let C5Reflexive = NewAxiom + `;Angle α ⇒ α ≡ α`;; + +let C5Symmetric = NewAxiom + `;Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α`;; + +let C5Transitive = NewAxiom + `;Angle α ∧ Angle β ∧ Angle γ ∧ + α ≡ β ∧ β ≡ γ ⇒ α ≡ γ`;; + +let C6 = NewAxiom + `;∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' + ⇒ ∡ B C A ≡ ∡ B' C' A'`;; + + +(* ----------------------------------------------------------------- *) +(* Theorems. *) +(* ----------------------------------------------------------------- *) + +let IN_Interval = theorem `; + ∀A B X. X ∈ Open (A, B) ⇔ Between A X B + by rewrite Interval_DEF IN_ELIM_THM`;; + +let IN_Ray = theorem `; + ∀A B X. X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ Open (X, B) + by rewrite Ray_DEF IN_ELIM_THM`;; + +let IN_InteriorAngle = theorem `; + ∀A O B P. P ∈ int_angle A O B ⇔ + ¬Collinear A O B ∧ ∃a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b + by rewrite InteriorAngle_DEF IN_ELIM_THM`;; + +let IN_InteriorTriangle = theorem `; + ∀A B C P. P ∈ int_triangle A B C ⇔ + P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B + by rewrite InteriorTriangle_DEF IN_ELIM_THM`;; + +let IN_PlaneComplement = theorem `; + ∀α. ∀P. P ∈ complement α ⇔ P ∉ α + by rewrite PlaneComplement_DEF IN_ELIM_THM`;; + +let IN_InteriorCircle = theorem `; + ∀O R P. P ∈ int_circle O R ⇔ + ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) + by rewrite InteriorCircle_DEF IN_ELIM_THM`;; + +let B1' = theorem `; + ∀A B C. B ∈ Open (A, C) ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + B ∈ Open (C, A) ∧ Collinear A B C + by fol IN_Interval B1`;; + +let B2' = theorem `; + ∀A B. ¬(A = B) ⇒ ∃C. B ∈ Open (A, C) + by fol IN_Interval B2`;; + +let B3' = theorem `; + ∀A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C + ⇒ (B ∈ Open (A, C) ∨ C ∈ Open (B, A) ∨ A ∈ Open (C, B)) ∧ + ¬(B ∈ Open (A, C) ∧ C ∈ Open (B, A)) ∧ + ¬(B ∈ Open (A, C) ∧ A ∈ Open (C, B)) ∧ + ¬(C ∈ Open (B, A) ∧ A ∈ Open (C, B)) + by fol IN_Interval B3`;; + +let B4' = theorem `; + ∀l A B C. Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃X. X ∈ l ∧ X ∈ Open (A, C)) ⇒ + (∃Y. Y ∈ l ∧ Y ∈ Open (A, B)) ∨ (∃Y. Y ∈ l ∧ Y ∈ Open (B, C)) + by rewrite IN_Interval B4`;; + +let B4'' = theorem `; + ∀l A B C. + Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l + proof + rewrite SameSide_DEF; + fol B4'; + qed; +`;; + +let DisjointOneNotOther = theorem `; + ∀l m. (∀x:A. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ + by fol ∉ IN_INTER MEMBER_NOT_EMPTY`;; + +let EquivIntersectionHelp = theorem `; + ∀e x:A. ∀l m:A->bool. + (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m ━ {x} ⇒ e ∉ l + by fol ∉ IN_INTER IN_SING IN_DIFF`;; + +let CollinearSymmetry = theorem `; + ∀A B C. Collinear A B C ⇒ + Collinear A C B ∧ Collinear B A C ∧ Collinear B C A ∧ + Collinear C A B ∧ Collinear C B A + + proof + intro_TAC ∀A B C, H1; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [l_line] by fol H1 Collinear_DEF; + fol - Collinear_DEF; + qed; +`;; + +let ExistsNewPointOnLine = theorem `; + ∀P. Line l ∧ P ∈ l ⇒ ∃Q. Q ∈ l ∧ ¬(P = Q) + + proof + intro_TAC ∀P, H1; + consider A B such that + A ∈ l ∧ B ∈ l ∧ ¬(A = B) [l_line] by fol H1 I2; + fol - l_line; + qed; +`;; + +let ExistsPointOffLine = theorem `; + ∀l. Line l ⇒ ∃Q. Q ∉ l + + proof + intro_TAC ∀l, H1; + consider A B C such that + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C [Distinct] by fol I3; + assume (A ∈ l) ∧ (B ∈ l) ∧ (C ∈ l) [all_on] by fol ∉; + Collinear A B C [] by fol H1 - Collinear_DEF; + fol - Distinct; + qed; +`;; + +let BetweenLinear = theorem `; + ∀A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ + (B ∈ Open (A, C) ∨ C ∈ Open (B, A) ∨ A ∈ Open (C, B)) ⇒ B ∈ m + + proof + intro_TAC ∀A B C m, H1m H1A H1C H2; + ¬(A = C) ∧ + (Collinear A B C ∨ Collinear B C A ∨ Collinear C A B) [X1] by fol H2 B1'; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X2] by fol - Collinear_DEF; + l = m [] by fol X1 - H2 H1m H1A H1C I1; + fol - X2; + qed; +`;; + +let CollinearLinear = theorem `; + ∀A B C m. Line m ∧ A ∈ m ∧ C ∈ m ∧ + (Collinear A B C ∨ Collinear B C A ∨ Collinear C A B) ∧ + ¬(A = C) ⇒ B ∈ m + + proof + intro_TAC ∀A B C m, H1m H1A H1C H2 H3; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X1] by fol H2 Collinear_DEF; + l = m [] by fol H3 - H1m H1A H1C I1; + fol - X1; + qed; +`;; + +let NonCollinearImpliesDistinct = theorem `; + ∀A B C. ¬Collinear A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) + + proof + intro_TAC ∀A B C, H1; + assume A = B ∧ B = C [equal] by fol H1 I1 Collinear_DEF; + consider Q such that + ¬(Q = A) [notQA] by fol I3; + fol - equal H1 I1 Collinear_DEF; + qed; +`;; + +let NonCollinearRaa = theorem `; + ∀A B C l. ¬(A = C) ⇒ Line l ∧ A ∈ l ∧ C ∈ l ⇒ B ∉ l + ⇒ ¬Collinear A B C + + proof + intro_TAC ∀A B C l, Distinct, l_line, notBl; + assume Collinear A B C [ANCcol] by fol; + consider m such that Line m ∧ A ∈ m ∧ B ∈ m ∧ C ∈ m [m_line] by fol - Collinear_DEF; + m = l [] by fol - l_line Distinct I1; + B ∈ l [] by fol m_line -; + fol - notBl ∉; + qed; +`;; + +let TwoSidesTriangle1Intersection = theorem `; + ∀A B C Y. ¬Collinear A B C ∧ Collinear B C Y ∧ Collinear A C Y + ⇒ Y = C + + proof + intro_TAC ∀A B C Y, ABCcol BCYcol ACYcol; + assume ¬(C = Y) [notCY] by fol; + consider l such that + Line l ∧ C ∈ l ∧ Y ∈ l [l_line] by fol - I1; + B ∈ l ∧ A ∈ l [] by fol - BCYcol ACYcol Collinear_DEF notCY I1; + fol - l_line Collinear_DEF ABCcol; + qed; +`;; + +let OriginInRay = theorem `; + ∀O Q. ¬(Q = O) ⇒ O ∈ ray O Q + + proof + intro_TAC ∀O Q, H1; + O ∉ Open (O, Q) [OOQ] by fol B1' ∉; + Collinear O Q O [] by fol H1 I1 Collinear_DEF; + fol H1 - OOQ IN_Ray; + qed; +`;; + +let EndpointInRay = theorem `; + ∀O Q. ¬(Q = O) ⇒ Q ∈ ray O Q + + proof + intro_TAC ∀O Q, H1; + O ∉ Open (Q, Q) [notOQQ] by fol B1' ∉; + Collinear O Q Q [] by fol H1 I1 Collinear_DEF; + fol H1 - notOQQ IN_Ray; + qed; +`;; + +let I1Uniqueness = theorem `; + ∀X l m. Line l ∧ Line m ∧ ¬(l = m) ∧ X ∈ l ∧ X ∈ m + ⇒ l ∩ m = {X} + + proof + intro_TAC ∀X l m, H0l H0m H1 H2l H2m; + assume ¬(l ∩ m = {X}) [H3] by fol; + consider A such that + A ∈ l ∩ m ∧ ¬(A = X) [X1] by fol H2l H2m IN_INTER H3 EXTENSION IN_SING; + fol H0l H0m H2l H2m IN_INTER X1 I1 H1; + qed; +`;; + +let DisjointLinesImplySameSide = theorem `; + ∀l m A B. Line l ∧ Line m ∧ A ∈ m ∧ B ∈ m ∧ l ∩ m = ∅ ⇒ A,B same_side l + + proof + intro_TAC ∀l m A B, l_line m_line Am Bm lm0; + l ∩ Open (A,B) = ∅ [] by fol Am Bm m_line BetweenLinear SUBSET lm0 SUBSET_REFL INTER_TENSOR SUBSET_EMPTY; + fol l_line - SameSide_DEF SUBSET IN_INTER MEMBER_NOT_EMPTY; + qed; +`;; + +let EquivIntersection = theorem `; + ∀A B X l m. Line l ∧ Line m ∧ l ∩ m = {X} ∧ A ∈ m ━ {X} ∧ B ∈ m ━ {X} ∧ + X ∉ Open (A, B) ⇒ A,B same_side l + + proof + intro_TAC ∀A B X l m, l_line m_line H1 H2l H2m H3; + Open (A, B) ⊂ m [] by fol l_line m_line SUBSET_DIFF IN_DIFF IN_SING H2l H2m BetweenLinear SUBSET; + l ∩ Open (A, B) ⊂ {X} [] by fol - H1 SUBSET_REFL INTER_TENSOR; + l ∩ Open (A, B) ⊂ ∅ [] by fol - SUBSET IN_SING IN_INTER H3 ∉; + fol l_line - SameSide_DEF SUBSET IN_INTER NOT_IN_EMPTY; + qed; +`;; + +let RayLine = theorem `; + ∀O P l. Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l + by fol IN_Ray CollinearLinear SUBSET`;; + +let RaySameSide = theorem `; + ∀l O A P. Line l ∧ O ∈ l ∧ A ∉ l ∧ P ∈ ray O A ━ {O} + ⇒ P ∉ l ∧ P,A same_side l + + proof + intro_TAC ∀l O A P, l_line Ol notAl PrOA; + ¬(O = A) [notOA] by fol l_line Ol notAl ∉; + consider d such that + Line d ∧ O ∈ d ∧ A ∈ d [d_line] by fol notOA I1; + ¬(l = d) [] by fol - notAl ∉; + l ∩ d = {O} [ldO] by fol l_line Ol d_line - I1Uniqueness; + A ∈ d ━ {O} [Ad_O] by fol d_line notOA IN_DIFF IN_SING; + ray O A ⊂ d [] by fol d_line RayLine; + P ∈ d ━ {O} [Pd_O] by fol PrOA - SUBSET IN_DIFF IN_SING; + P ∉ l [notPl] by fol ldO - EquivIntersectionHelp; + O ∉ Open (P, A) [] by fol PrOA IN_DIFF IN_SING IN_Ray; + P,A same_side l [] by fol l_line Ol d_line ldO Ad_O Pd_O - EquivIntersection; + fol notPl -; + qed; +`;; + +let IntervalRayEZ = theorem `; + ∀A B C. B ∈ Open (A, C) ⇒ B ∈ ray A C ━ {A} ∧ C ∈ ray A B ━ {A} + + proof + intro_TAC ∀A B C, H1; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [ABC] by fol H1 B1'; + A ∉ Open (B, C) ∧ A ∉ Open (C, B) [] by fol - H1 B3' B1' ∉; + fol ABC - CollinearSymmetry IN_Ray ∉ IN_DIFF IN_SING; + qed; +`;; + +let NoncollinearityExtendsToLine = theorem `; + ∀A O B X. ¬Collinear A O B ⇒ Collinear O B X ∧ ¬(X = O) + ⇒ ¬Collinear A O X + + proof + intro_TAC ∀A O B X, H1, H2; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider b such that + Line b ∧ O ∈ b ∧ B ∈ b [b_line] by fol Distinct I1; + A ∉ b [notAb] by fol b_line H1 Collinear_DEF ∉; + X ∈ b [] by fol H2 b_line Distinct I1 Collinear_DEF; + fol b_line - H2 notAb I1 Collinear_DEF ∉; + qed; +`;; + +let SameSideReflexive = theorem `; + ∀l A. Line l ∧ A ∉ l ⇒ A,A same_side l + by fol B1' SameSide_DEF`;; + +let SameSideSymmetric = theorem `; + ∀l A B. Line l ∧ A ∉ l ∧ B ∉ l ⇒ + A,B same_side l ⇒ B,A same_side l + by fol SameSide_DEF B1'`;; + +let SameSideTransitive = theorem `; + ∀l A B C. Line l ⇒ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ A,B same_side l + ⇒ B,C same_side l ⇒ A,C same_side l + + proof + intro_TAC ∀l A B C, l_line, notABCl, Asim_lB, Bsim_lC; + assume Collinear A B C ∧ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol l_line notABCl Asim_lB Bsim_lC B4'' SameSideReflexive; + consider m such that + Line m ∧ A ∈ m ∧ C ∈ m [m_line] by fol Distinct I1; + B ∈ m [Bm] by fol - Distinct CollinearLinear; + assume ¬(m ∩ l = ∅) [Intersect] by fol m_line l_line BetweenLinear SameSide_DEF IN_INTER NOT_IN_EMPTY; + consider X such that + X ∈ l ∧ X ∈ m [Xlm] by fol - MEMBER_NOT_EMPTY IN_INTER; + Collinear A X B ∧ Collinear B A C ∧ Collinear A B C [ABXcol] by fol m_line Bm - Collinear_DEF; + consider E such that + E ∈ l ∧ ¬(E = X) [El_X] by fol l_line Xlm ExistsNewPointOnLine; + ¬Collinear E A X [EAXncol] by fol l_line El_X Xlm notABCl I1 Collinear_DEF ∉; + consider B' such that + ¬(B = E) ∧ B ∈ Open (E, B') [EBB'] by fol notABCl El_X ∉ B2'; + ¬(B' = E) ∧ ¬(B' = B) ∧ Collinear B E B' [EBB'col] by fol - B1' CollinearSymmetry; + ¬Collinear A B B' ∧ ¬Collinear B' B A ∧ ¬Collinear B' A B [ABB'ncol] by fol EAXncol ABXcol Distinct - NoncollinearityExtendsToLine CollinearSymmetry; + ¬Collinear B' B C ∧ ¬Collinear B' A C ∧ ¬Collinear A B' C [AB'Cncol] by fol ABB'ncol ABXcol Distinct NoncollinearityExtendsToLine CollinearSymmetry; + B' ∈ ray E B ━ {E} ∧ B ∈ ray E B' ━ {E} [] by fol EBB' IntervalRayEZ; + B' ∉ l ∧ B',B same_side l ∧ B,B' same_side l [notB'l] by fol l_line El_X notABCl - RaySameSide; + A,B' same_side l ∧ B',C same_side l [] by fol l_line ABB'ncol notABCl notB'l Asim_lB - AB'Cncol Bsim_lC B4''; + fol l_line AB'Cncol notABCl notB'l - B4''; + qed; +`;; + +let ConverseCrossbar = theorem `; + ∀O A B G. ¬Collinear A O B ∧ G ∈ Open (A, B) ⇒ G ∈ int_angle A O B + + proof + intro_TAC ∀O A B G, H1 H2; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol - I1; + consider b such that + Line b ∧ O ∈ b ∧ B ∈ b [b_line] by fol Distinct I1; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l [l_line] by fol Distinct I1; + B ∉ a ∧ A ∉ b [] by fol H1 a_line b_line Collinear_DEF ∉; + ¬(a = l) ∧ ¬(b = l) [] by fol - l_line ∉; + a ∩ l = {A} ∧ b ∩ l = {B} [alA] by fol - a_line l_line b_line I1Uniqueness; + ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [AGB] by fol H2 B1'; + A ∉ Open (G, B) ∧ B ∉ Open (G, A) [notGAB] by fol H2 B3' B1' ∉; + G ∈ l [Gl] by fol l_line H2 BetweenLinear; + G ∉ a ∧ G ∉ b [notGa] by fol alA Gl AGB IN_DIFF IN_SING EquivIntersectionHelp; + G ∈ l ━ {A} ∧ B ∈ l ━ {A} ∧ G ∈ l ━ {B} ∧ A ∈ l ━ {B} [] by fol Gl l_line AGB IN_DIFF IN_SING; + G,B same_side a ∧ G,A same_side b [] by fol a_line l_line alA - notGAB b_line EquivIntersection; + fol H1 a_line b_line notGa - IN_InteriorAngle; + qed; +`;; + +let InteriorUse = theorem `; + ∀A O B P a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ⇒ + P ∈ int_angle A O B ⇒ + P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b + + proof + intro_TAC ∀A O B P a b, aOAbOB, P_AOB; + consider α β such that ¬Collinear A O B ∧ + Line α ∧ O ∈ α ∧ A ∈ α ∧ + Line β ∧ O ∈ β ∧B ∈ β ∧ + P ∉ α ∧ P ∉ β ∧ + P,B same_side α ∧ P,A same_side β [exists] by fol P_AOB IN_InteriorAngle; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [] by fol - NonCollinearImpliesDistinct; + α = a ∧ β = b [] by fol - aOAbOB exists I1; + fol - exists; + qed; +`;; + +let InteriorEZHelp = theorem `; + ∀A O B P. P ∈ int_angle A O B ⇒ + ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P + + proof + intro_TAC ∀A O B P, P_AOB; + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧B ∈ b ∧ + P ∉ a ∧ P ∉ b [def_int] by fol P_AOB IN_InteriorAngle; + ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) [PnotAOB] by fol - ∉; + ¬(A = O) [] by fol def_int NonCollinearImpliesDistinct; + ¬Collinear A O P [] by fol def_int - NonCollinearRaa CollinearSymmetry; + fol PnotAOB -; + qed; +`;; + +let InteriorAngleSymmetry = theorem `; + ∀A O B P: point. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A + + proof rewrite IN_InteriorAngle; fol CollinearSymmetry; qed; +`;; + +let InteriorWellDefined = theorem `; + ∀A O B X P. P ∈ int_angle A O B ∧ X ∈ ray O B ━ {O} ⇒ P ∈ int_angle A O X + + proof + intro_TAC ∀A O B X P, H1 H2; + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ b ∧ + P,B same_side a ∧ P,A same_side b [def_int] by fol H1 IN_InteriorAngle; + ¬(X = O) ∧ ¬(O = B) ∧ Collinear O B X [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; + B ∉ a [notBa] by fol def_int Collinear_DEF ∉; + ¬Collinear A O X [AOXnoncol] by fol def_int H2' NoncollinearityExtendsToLine; + X ∈ b [Xb] by fol def_int H2' CollinearLinear; + X ∉ a ∧ B,X same_side a [] by fol def_int notBa H2 RaySameSide SameSideSymmetric; + P,X same_side a [] by fol def_int - notBa SameSideTransitive; + fol AOXnoncol def_int Xb - IN_InteriorAngle; + qed; +`;; + +let WholeRayInterior = theorem `; + ∀A O B X P. X ∈ int_angle A O B ∧ P ∈ ray O X ━ {O} ⇒ P ∈ int_angle A O B + + proof + intro_TAC ∀A O B X P, XintAOB PrOX; + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ X ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ X ∉ b ∧ + X,B same_side a ∧ X,A same_side b [def_int] by fol XintAOB IN_InteriorAngle; + P ∉ a ∧ P,X same_side a ∧ P ∉ b ∧ P,X same_side b [Psim_abX] by fol def_int PrOX RaySameSide; + P,B same_side a ∧ P,A same_side b [] by fol - def_int Collinear_DEF SameSideTransitive ∉; + fol def_int Psim_abX - IN_InteriorAngle; + qed; +`;; + +let AngleOrdering = theorem `; + ∀O A P Q a. ¬(O = A) ⇒ Line a ∧ O ∈ a ∧ A ∈ a ⇒ + P ∉ a ∧ Q ∉ a ⇒ P,Q same_side a ⇒ ¬Collinear P O Q ⇒ + P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A + + proof + intro_TAC ∀O A P Q a, H1, H2, H3, H4, H5; + ¬(P = O) ∧ ¬(P = Q) ∧ ¬(O = Q) [Distinct] by fol H5 NonCollinearImpliesDistinct; + consider q such that + Line q ∧ O ∈ q ∧ Q ∈ q [q_line] by fol Distinct I1; + P ∉ q [notPq] by fol - H5 Collinear_DEF ∉; + assume ¬(P ∈ int_angle Q O A) [notPintQOA] by fol; + ¬Collinear Q O A ∧ ¬Collinear P O A [POAncol] by fol H1 H2 H3 I1 Collinear_DEF ∉; +¬(P,A same_side q) [] by fol - H2 q_line H3 notPq H4 notPintQOA IN_InteriorAngle; + consider G such that + G ∈ q ∧ G ∈ Open (P, A) [existG] by fol q_line - SameSide_DEF; + G ∈ int_angle P O A [G_POA] by fol POAncol existG ConverseCrossbar; + G ∉ a ∧ G,P same_side a ∧ ¬(G = O) [Gsim_aP] by fol - H1 H2 IN_InteriorAngle I1 ∉; + G,Q same_side a [] by fol H2 Gsim_aP H3 H4 SameSideTransitive; + O ∉ Open (Q, G) [notQOG] by fol - H2 SameSide_DEF B1' ∉; + Collinear O G Q [] by fol q_line existG Collinear_DEF; + Q ∈ ray O G ━ {O} [] by fol Gsim_aP - notQOG Distinct IN_Ray IN_DIFF IN_SING; + fol G_POA - WholeRayInterior; + qed; +`;; + +let InteriorsDisjointSupplement = theorem `; + ∀A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ⇒ + int_angle B O A' ∩ int_angle A O B = ∅ + + proof + intro_TAC ∀A O B A', H1 H2; + ∀D. D ∈ int_angle A O B ⇒ D ∉ int_angle B O A' [] + proof + intro_TAC ∀D, H3; + ¬(A = O) ∧ ¬(O = B) [] by fol H1 NonCollinearImpliesDistinct; + consider a b such that + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ A' ∈ a [ab_line] by fol - H2 I1 BetweenLinear; + ¬Collinear B O A' [] by fol H1 H2 CollinearSymmetry B1' NoncollinearityExtendsToLine; + A ∉ b ∧ A' ∉ b [notAb] by fol ab_line H1 - Collinear_DEF ∉; + ¬(A',A same_side b) [A'nsim_bA] by fol ab_line H2 B1' SameSide_DEF; + D ∉ b ∧ D,A same_side b [DintAOB] by fol ab_line H3 InteriorUse; + ¬(D,A' same_side b) [] by fol ab_line notAb DintAOB A'nsim_bA SameSideSymmetric SameSideTransitive; + fol ab_line - InteriorUse ∉; + qed; + fol - DisjointOneNotOther; + qed; +`;; + +let InteriorReflectionInterior = theorem `; + ∀A O B D A'. O ∈ Open (A, A') ∧ D ∈ int_angle A O B ⇒ + B ∈ int_angle D O A' + + proof + intro_TAC ∀A O B D A', H1 H2; + consider a b such that + ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ D ∉ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b ∧ D ∉ b ∧ D,B same_side a [DintAOB] by fol H2 IN_InteriorAngle; + ¬(O = B) ∧ ¬(O = A') ∧ B ∉ a [Distinct] by fol - H1 NonCollinearImpliesDistinct B1' Collinear_DEF ∉; + ¬Collinear D O B [DOB_ncol] by fol DintAOB - NonCollinearRaa CollinearSymmetry; + A' ∈ a [A'a] by fol H1 DintAOB BetweenLinear; + D ∉ int_angle B O A' [] by fol DintAOB H1 H2 InteriorsDisjointSupplement DisjointOneNotOther; + fol Distinct DintAOB A'a DOB_ncol - AngleOrdering ∉; + qed; +`;; + +let Crossbar_THM = theorem `; + ∀O A B D. D ∈ int_angle A O B ⇒ ∃G. G ∈ Open (A, B) ∧ G ∈ ray O D ━ {O} + + proof + intro_TAC ∀O A B D, H1; + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b ∧ + D ∉ a ∧ D ∉ b ∧ D,B same_side a ∧ D,A same_side b [DintAOB] by fol H1 IN_InteriorAngle; + B ∉ a [notBa] by fol DintAOB Collinear_DEF ∉; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(D = O) [Distinct] by fol DintAOB NonCollinearImpliesDistinct ∉; + consider l such that + Line l ∧ O ∈ l ∧ D ∈ l [l_line] by fol - I1; + consider A' such that + O ∈ Open (A, A') [AOA'] by fol Distinct B2'; + A' ∈ a ∧ Collinear A O A' ∧ ¬(A' = O) [A'a] by fol DintAOB - BetweenLinear B1'; + ¬(A,A' same_side l) [Ansim_lA'] by fol l_line AOA' SameSide_DEF; + B ∈ int_angle D O A' [] by fol H1 AOA' InteriorReflectionInterior; + B,A' same_side l [Bsim_lA'] by fol l_line DintAOB A'a - InteriorUse; + ¬Collinear A O D ∧ ¬Collinear B O D [AODncol] by fol H1 InteriorEZHelp InteriorAngleSymmetry; + ¬Collinear D O A' [] by fol - A'a CollinearSymmetry NoncollinearityExtendsToLine; + A ∉ l ∧ B ∉ l ∧ A' ∉ l [] by fol l_line AODncol - Collinear_DEF ∉; + ¬(A,B same_side l) [] by fol l_line - Bsim_lA' Ansim_lA' SameSideTransitive; + consider G such that + G ∈ Open (A, B) ∧ G ∈ l [AGB] by fol l_line - SameSide_DEF; + Collinear O D G [ODGcol] by fol - l_line Collinear_DEF; + G ∈ int_angle A O B [] by fol DintAOB AGB ConverseCrossbar; + G ∉ a ∧ G,B same_side a ∧ ¬(G = O) [Gsim_aB] by fol DintAOB - InteriorUse ∉; + B,D same_side a [] by fol DintAOB notBa SameSideSymmetric; + G,D same_side a [Gsim_aD] by fol DintAOB Gsim_aB notBa - SameSideTransitive; + O ∉ Open (G, D) [] by fol DintAOB - SameSide_DEF ∉; + G ∈ ray O D ━ {O} [] by fol Distinct ODGcol - Gsim_aB IN_Ray IN_DIFF IN_SING; + fol AGB -; + qed; +`;; + +let AlternateConverseCrossbar = theorem `; + ∀O A B G. Collinear A G B ∧ G ∈ int_angle A O B ⇒ G ∈ Open (A, B) + + proof + intro_TAC ∀O A B G, H1; + consider a b such that + ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + G,B same_side a ∧ G,A same_side b [GintAOB] by fol H1 IN_InteriorAngle; + ¬(A = B) ∧ ¬(G = A) ∧ ¬(G = B) ∧ A ∉ Open (G, B) ∧ B ∉ Open (G, A) [] by fol - H1 NonCollinearImpliesDistinct InteriorEZHelp SameSide_DEF ∉; + fol - H1 B1' B3' ∉; + qed; +`;; + +let InteriorOpposite = theorem `; + ∀A O B P p. P ∈ int_angle A O B ⇒ Line p ∧ O ∈ p ∧ P ∈ p + ⇒ ¬(A,B same_side p) + + proof + intro_TAC ∀A O B P p, PintAOB, p_line; + consider G such that + G ∈ Open (A, B) ∧ G ∈ ray O P [Gexists] by fol PintAOB Crossbar_THM IN_DIFF; + fol p_line p_line - RayLine SUBSET Gexists SameSide_DEF; + qed; +`;; + +let IntervalTransitivity = theorem `; + ∀O P Q R m. Line m ∧ O ∈ m ⇒ P ∈ m ━ {O} ∧ Q ∈ m ━ {O} ∧ R ∈ m ━ {O} ⇒ + O ∉ Open (P, Q) ∧ O ∉ Open (Q, R) ⇒ O ∉ Open (P, R) + + proof + intro_TAC ∀O P Q R m, H0, H2, H3; + consider E such that + E ∉ m ∧ ¬(O = E) [notEm] by fol H0 ExistsPointOffLine ∉; + consider l such that + Line l ∧ O ∈ l ∧ E ∈ l [l_line] by fol - I1; + ¬(m = l) [] by fol notEm - ∉; + l ∩ m = {O} [lmO] by fol l_line H0 - l_line I1Uniqueness; + P ∉ l ∧ Q ∉ l ∧ R ∉ l [notPQRl] by fol - H2 EquivIntersectionHelp; + P,Q same_side l ∧ Q,R same_side l [] by fol l_line H0 lmO H2 H3 EquivIntersection; + P,R same_side l [Psim_lR] by fol l_line notPQRl - SameSideTransitive; + fol l_line - SameSide_DEF ∉; + qed; +`;; + +let RayWellDefinedHalfway = theorem `; + ∀O P Q. ¬(Q = O) ∧ P ∈ ray O Q ━ {O} ⇒ ray O P ⊂ ray O Q + + proof + intro_TAC ∀O P Q, H1 H2; + consider m such that + Line m ∧ O ∈ m ∧ Q ∈ m [OQm] by fol H1 I1; + P ∈ ray O Q ∧ ¬(P = O) ∧ O ∉ Open (P, Q) [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; + P ∈ m ∧ P ∈ m ━ {O} ∧ Q ∈ m ━ {O} [PQm_O] by fol OQm H2' RayLine SUBSET H2' OQm H1 IN_DIFF IN_SING; + O ∉ Open (P, Q) [notPOQ] by fol H2' IN_Ray; + rewrite SUBSET; + X_genl_TAC X; intro_TAC XrayOP; + X ∈ m ∧ O ∉ Open (X, P) [XrOP] by fol - SUBSET OQm PQm_O H2' RayLine IN_Ray; + Collinear O Q X [OQXcol] by fol OQm - Collinear_DEF; + assume ¬(X = O) [notXO] by fol H1 OriginInRay; + X ∈ m ━ {O} [] by fol XrOP - IN_DIFF IN_SING; + O ∉ Open (X, Q) [] by fol OQm - PQm_O XrOP H2' IntervalTransitivity; + fol H1 OQXcol - IN_Ray; + qed; +`;; + +let RayWellDefined = theorem `; + ∀O P Q. ¬(Q = O) ∧ P ∈ ray O Q ━ {O} ⇒ ray O P = ray O Q + + proof + intro_TAC ∀O P Q, H1 H2; + ray O P ⊂ ray O Q [PsubsetQ] by fol H1 H2 RayWellDefinedHalfway; + ¬(P = O) ∧ Collinear O Q P ∧ O ∉ Open (P, Q) [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; + Q ∈ ray O P ━ {O} [] by fol H2' B1' ∉ CollinearSymmetry IN_Ray H1 IN_DIFF IN_SING; + ray O Q ⊂ ray O P [QsubsetP] by fol H2' - RayWellDefinedHalfway; + fol PsubsetQ QsubsetP SUBSET_ANTISYM; + qed; +`;; + +let OppositeRaysIntersect1pointHelp = theorem `; + ∀A O B X. O ∈ Open (A, B) ∧ X ∈ ray O B ━ {O} + ⇒ X ∉ ray O A ∧ O ∈ Open (X, A) + + proof + intro_TAC ∀A O B X, H1 H2; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ Collinear A O B [AOB] by fol H1 B1'; + ¬(X = O) ∧ Collinear O B X ∧ O ∉ Open (X, B) [H2'] by fol H2 IN_Ray IN_DIFF IN_SING; + consider m such that + Line m ∧ A ∈ m ∧ B ∈ m [m_line] by fol AOB I1; + O ∈ m ∧ X ∈ m [Om] by fol m_line H2' AOB CollinearLinear; + A ∈ m ━ {O} ∧ X ∈ m ━ {O} ∧ B ∈ m ━ {O} [] by fol m_line - H2' AOB IN_DIFF IN_SING; + fol H1 m_line Om - H2' IntervalTransitivity ∉ B1' IN_Ray; + qed; +`;; + +let OppositeRaysIntersect1point = theorem `; + ∀A O B. O ∈ Open (A, B) ⇒ ray O A ∩ ray O B = {O} + + proof + intro_TAC ∀A O B, H1; + ¬(A = O) ∧ ¬(O = B) [] by fol H1 B1'; + rewrite GSYM SUBSET_ANTISYM_EQ SUBSET IN_INTER; + conj_tac [Right] by fol - OriginInRay IN_SING; + fol H1 OppositeRaysIntersect1pointHelp IN_DIFF IN_SING ∉; + qed; +`;; + +let IntervalRay = theorem `; + ∀A B C. B ∈ Open (A, C) ⇒ ray A B = ray A C + by fol B1' IntervalRayEZ RayWellDefined`;; + +let Reverse4Order = theorem `; + ∀A B C D. ordered A B C D ⇒ ordered D C B A + proof + rewrite Ordered_DEF; + fol B1'; + qed; +`;; + +let TransitivityBetweennessHelp = theorem `; + ∀A B C D. B ∈ Open (A, C) ∧ C ∈ Open (B, D) + ⇒ B ∈ Open (A, D) + + proof + intro_TAC ∀A B C D, H1; + D ∈ ray B C ━ {B} [] by fol H1 IntervalRayEZ; + fol H1 - OppositeRaysIntersect1pointHelp B1'; + qed; +`;; + +let TransitivityBetweenness = theorem `; + ∀A B C D. B ∈ Open (A, C) ∧ C ∈ Open (B, D) ⇒ ordered A B C D + + proof + intro_TAC ∀A B C D, H1; + B ∈ Open (A, D) [ABD] by fol H1 TransitivityBetweennessHelp; + C ∈ Open (D, B) ∧ B ∈ Open (C, A) [] by fol H1 B1'; + C ∈ Open (D, A) [] by fol - TransitivityBetweennessHelp; + fol H1 ABD - B1' Ordered_DEF; + qed; +`;; + +let IntervalsAreConvex = theorem `; + ∀A B C. B ∈ Open (A, C) ⇒ Open (A, B) ⊂ Open (A, C) + + proof + intro_TAC ∀A B C, H1; + ∀X. X ∈ Open (A, B) ⇒ X ∈ Open (A, C) [] + proof + intro_TAC ∀X, AXB; + X ∈ ray B A ━ {B} [] by fol AXB B1' IntervalRayEZ; + B ∈ Open (X, C) [] by fol H1 B1' - OppositeRaysIntersect1pointHelp; + fol AXB - TransitivityBetweennessHelp; + qed; + fol - SUBSET; + qed; +`;; + +let TransitivityBetweennessVariant = theorem `; + ∀A X B C. X ∈ Open (A, B) ∧ B ∈ Open (A, C) ⇒ ordered A X B C + + proof + intro_TAC ∀A X B C, H1; + X ∈ ray B A ━ {B} [] by fol H1 B1' IntervalRayEZ; + B ∈ Open (X, C) [] by fol H1 B1' - OppositeRaysIntersect1pointHelp; + fol H1 - TransitivityBetweenness; + qed; +`;; + +let Interval2sides2aLineHelp = theorem `; + ∀A B C X. B ∈ Open (A, C) ⇒ X ∉ Open (A, B) ∨ X ∉ Open (B, C) + + proof + intro_TAC ∀A B C X, H1; + assume ¬(X ∉ Open (A, B)) [AXB] by fol; + ordered A X B C [] by fol - ∉ H1 TransitivityBetweennessVariant; + fol MESON [-; Ordered_DEF] [B ∈ Open (X, C)] B1' B3' ∉; + qed; +`;; + +let Interval2sides2aLine = theorem `; + ∀A B C X. Collinear A B C + ⇒ X ∉ Open (A, B) ∨ X ∉ Open (A, C) ∨ X ∉ Open (B, C) + + proof + intro_TAC ∀A B C X, H1; + assume ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol B1' ∉; + B ∈ Open (A, C) ∨ C ∈ Open (B, A) ∨ A ∈ Open (C, B) [] by fol - H1 B3'; + fol - Interval2sides2aLineHelp B1' ∉; + qed; +`;; + +let TwosidesTriangle2aLine = theorem `; + ∀A B C l. Line l ∧ ¬Collinear A B C ⇒ A ∉ l ∧ B ∉ l ∧ C ∉ l ⇒ + ¬(A,B same_side l) ∧ ¬(B,C same_side l) ⇒ A,C same_side l + + proof + intro_TAC ∀ A B C l, H1, off_l, H2; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [ABCdistinct] by fol H1 NonCollinearImpliesDistinct; + consider m such that + Line m ∧ A ∈ m ∧ C ∈ m [m_line] by fol - I1; + assume ¬(l ∩ m = ∅) [lmIntersect] by fol H1 m_line DisjointLinesImplySameSide; + consider Y such that + Y ∈ l ∧ Y ∈ m [Ylm] by fol lmIntersect MEMBER_NOT_EMPTY IN_INTER; + consider X Z such that + X ∈ l ∧ X ∈ Open (A, B) ∧ Z ∈ l ∧ Z ∈ Open (C, B) [H2'] by fol H1 H2 SameSide_DEF B1'; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Y ∈ m ━ {A} ∧ Y ∈ m ━ {C} ∧ C ∈ m ━ {A} ∧ A ∈ m ━ {C} [Distinct] by fol H1 NonCollinearImpliesDistinct Ylm off_l ∉ m_line IN_DIFF IN_SING; + consider p such that + Line p ∧ B ∈ p ∧ A ∈ p [p_line] by fol Distinct I1; + consider q such that + Line q ∧ B ∈ q ∧ C ∈ q [q_line] by fol Distinct I1; + X ∈ p ∧ Z ∈ q [Xp] by fol p_line H2' BetweenLinear q_line H2'; + A ∉ q ∧ B ∉ m ∧ C ∉ p [vertex_off_line] by fol q_line m_line p_line H1 Collinear_DEF ∉; + X ∉ q ∧ X,A same_side q ∧ Z ∉ p ∧ Z,C same_side p [Xsim_qA] by fol q_line p_line - H2' B1' IntervalRayEZ RaySameSide; + ¬(m = p) ∧ ¬(m = q) [] by fol m_line vertex_off_line ∉; + p ∩ m = {A} ∧ q ∩ m = {C} [pmA] by fol p_line m_line q_line H1 - Xp H2' I1Uniqueness; + Y ∉ p ∧ Y ∉ q [notYpq] by fol - Distinct EquivIntersectionHelp; + X ∈ ray A B ━ {A} ∧ Z ∈ ray C B ━ {C} [] by fol H2' IntervalRayEZ H2' B1'; + X ∉ m ∧ Z ∉ m ∧ X,B same_side m ∧ B,Z same_side m [notXZm] by fol m_line vertex_off_line - RaySameSide SameSideSymmetric; + X,Z same_side m [] by fol m_line - vertex_off_line SameSideTransitive; + Collinear X Y Z ∧ Y ∉ Open (X, Z) ∧ ¬(Y = X) ∧ ¬(Y = Z) ∧ ¬(X = Z) [] by fol H1 H2' Ylm Collinear_DEF m_line - SameSide_DEF notXZm Xsim_qA Xp ∉; + Z ∈ Open (X, Y) ∨ X ∈ Open (Z, Y) [] by fol - B3' ∉ B1'; + case_split ZXY | XZY by fol -; + suppose X ∈ Open (Z, Y); + ¬(Z,Y same_side p) [] by fol p_line Xp - SameSide_DEF; + ¬(C,Y same_side p) [] by fol p_line Xsim_qA vertex_off_line notYpq - SameSideTransitive; + A ∈ Open (C, Y) [] by fol p_line m_line pmA Distinct - EquivIntersection ∉; + fol H1 Ylm off_l - B1' IntervalRayEZ RaySameSide; + end; + suppose Z ∈ Open (X, Y); + ¬(X,Y same_side q) [] by fol q_line Xp - SameSide_DEF; + ¬(A,Y same_side q) [] by fol q_line Xsim_qA vertex_off_line notYpq - SameSideTransitive; + C ∈ Open (Y, A) [] by fol q_line m_line pmA Distinct - EquivIntersection ∉ B1'; + fol H1 Ylm off_l - IntervalRayEZ RaySameSide; + end; + qed; +`;; + +let LineUnionOf2Rays = theorem `; + ∀A O B l. Line l ∧ A ∈ l ∧ B ∈ l ⇒ O ∈ Open (A, B) + ⇒ l = ray O A ∪ ray O B + + proof + intro_TAC ∀A O B l, H1, H2; + ¬(A = O) ∧ ¬(O = B) ∧ O ∈ l [Distinct] by fol H2 B1' H1 BetweenLinear; + ray O A ∪ ray O B ⊂ l [AOBsub_l] by fol H1 - RayLine UNION_SUBSET; + ∀X. X ∈ l ⇒ X ∈ ray O A ∨ X ∈ ray O B [] + proof + intro_TAC ∀X, Xl; + assume ¬(X ∈ ray O B) [notXrOB] by fol; + Collinear O B X ∧ Collinear X A B ∧ Collinear O A X [XABcol] by fol Distinct H1 Xl Collinear_DEF; + O ∈ Open (X, B) [] by fol notXrOB Distinct - IN_Ray ∉; + O ∉ Open (X, A) [] by fol ∉ B1' XABcol - H2 Interval2sides2aLine; + fol Distinct XABcol - IN_Ray; + qed; + l ⊂ ray O A ∪ ray O B [] by fol - IN_UNION SUBSET; + fol - AOBsub_l SUBSET_ANTISYM; + qed; +`;; + +let AtMost2Sides = theorem `; + ∀A B C l. Line l ⇒ A ∉ l ∧ B ∉ l ∧ C ∉ l + ⇒ A,B same_side l ∨ A,C same_side l ∨ B,C same_side l + + proof + intro_TAC ∀A B C l, l_line, H2; + assume ¬(A = C) [notAC] by fol l_line H2 SameSideReflexive; + assume Collinear A B C [ABCcol] by fol l_line H2 TwosidesTriangle2aLine; + consider m such that + Line m ∧ A ∈ m ∧ B ∈ m ∧ C ∈ m [m_line] by fol notAC - I1 Collinear_DEF; + assume ¬(m ∩ l = ∅) [m_lNot0] by fol m_line l_line BetweenLinear SameSide_DEF IN_INTER NOT_IN_EMPTY; + consider X such that + X ∈ l ∧ X ∈ m [Xlm] by fol - IN_INTER MEMBER_NOT_EMPTY; + A ∈ m ━ {X} ∧ B ∈ m ━ {X} ∧ C ∈ m ━ {X} [ABCm_X] by fol m_line - H2 ∉ IN_DIFF IN_SING; + X ∉ Open (A, B) ∨ X ∉ Open (A, C) ∨ X ∉ Open (B, C) [] by fol ABCcol Interval2sides2aLine; + fol l_line m_line m_line Xlm H2 ∉ I1Uniqueness ABCm_X - EquivIntersection; + qed; +`;; + +let FourPointsOrder = theorem `; + ∀A B C X l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l ⇒ + ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) ⇒ B ∈ Open (A, C) + ⇒ ordered X A B C ∨ ordered A X B C ∨ + ordered A B X C ∨ ordered A B C X + + proof + intro_TAC ∀A B C X l, H1, H2, H3; + A ∈ Open (X, B) ∨ X ∈ Open (A, B) ∨ X ∈ Open (B, C) ∨ C ∈ Open (B, X) [] + proof + ¬(A = B) ∧ ¬(B = C) [ABCdistinct] by fol H3 B1'; + Collinear A B X ∧ Collinear A C X ∧ Collinear C B X [ACXcol] by fol H1 Collinear_DEF; + A ∈ Open (X, B) ∨ X ∈ Open (A, B) ∨ B ∈ Open (A, X) [3pos] by fol H2 ABCdistinct - B3' B1'; + assume B ∈ Open (A, X) [ABX] by fol 3pos; + B ∉ Open (C, X) [] by fol ACXcol H3 - Interval2sides2aLine ∉; + fol H2 ABCdistinct ACXcol - B3' B1' ∉; + qed; + fol - H3 B1' TransitivityBetweenness TransitivityBetweennessVariant Reverse4Order; + qed; +`;; + +let HilbertAxiomRedundantByMoore = theorem `; + ∀A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l ⇒ + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) + ⇒ ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ ordered A B C D ∨ + ordered D A C B ∨ ordered A D C B ∨ ordered A C D B ∨ ordered A C B D ∨ + ordered D C A B ∨ ordered C D A B ∨ ordered C A D B ∨ ordered C A B D + + proof + intro_TAC ∀A B C D l, H1, H2; + Collinear A B C [] by fol H1 Collinear_DEF; + B ∈ Open (A, C) ∨ C ∈ Open (A, B) ∨ A ∈ Open (C, B) [] by fol H2 - B3' B1'; + fol - H1 H2 FourPointsOrder; + qed; +`;; + +let InteriorTransitivity = theorem `; + ∀A O B M G. G ∈ int_angle A O B ∧ M ∈ int_angle A O G + ⇒ M ∈ int_angle A O B + + proof + intro_TAC ∀A O B M G, GintAOB MintAOG; + ¬Collinear A O B [AOBncol] by fol GintAOB IN_InteriorAngle; + consider G' such that + G' ∈ Open (A, B) ∧ G' ∈ ray O G ━ {O} [CrossG] by fol GintAOB Crossbar_THM; + M ∈ int_angle A O G' [] by fol MintAOG - InteriorWellDefined; + consider M' such that + M' ∈ Open (A, G') ∧ M' ∈ ray O M ━ {O} [CrossM] by fol - Crossbar_THM; + ¬(M' = O) ∧ ¬(M = O) ∧ Collinear O M M' ∧ O ∉ Open (M', M) [] by fol - IN_Ray IN_DIFF IN_SING; + M ∈ ray O M' ━ {O} [MrOM'] by fol - CollinearSymmetry B1' ∉ IN_Ray IN_DIFF IN_SING; + Open (A, G') ⊂ Open (A, B) ∧ M' ∈ Open (A, B) [] by fol CrossG IntervalsAreConvex CrossM SUBSET; + M' ∈ int_angle A O B [] by fol AOBncol - ConverseCrossbar; + fol - MrOM' WholeRayInterior; + qed; +`;; + +let HalfPlaneConvexNonempty = theorem `; + ∀l H A. Line l ∧ A ∉ l ⇒ H = {X | X ∉ l ∧ X,A same_side l} + ⇒ ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H + + proof + intro_TAC ∀l H A, l_line, HalfPlane; + ∀X. X ∈ H ⇔ X ∉ l ∧ X,A same_side l [Hdef] by simplify HalfPlane IN_ELIM_THM; + H ⊂ complement l [Hsub] by fol - IN_PlaneComplement SUBSET; + A,A same_side l ∧ A ∈ H [] by fol l_line SameSideReflexive Hdef; + ¬(H = ∅) [Hnonempty] by fol - MEMBER_NOT_EMPTY; + ∀P Q X. P ∈ H ∧ Q ∈ H ∧ X ∈ Open (P, Q) ⇒ X ∈ H [] + proof + intro_TAC ∀P Q X, PXQ; + P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,A same_side l [PQinH] by fol - Hdef; + P,Q same_side l [Psim_lQ] by fol l_line - SameSideSymmetric SameSideTransitive; + X ∉ l [notXl] by fol - PXQ SameSide_DEF ∉; + Open (X, P) ⊂ Open (P, Q) [] by fol PXQ IntervalsAreConvex B1' SUBSET; + X,P same_side l [] by fol l_line - SUBSET Psim_lQ SameSide_DEF; + X,A same_side l [] by fol l_line notXl PQinH - Psim_lQ PQinH SameSideTransitive; + fol - notXl Hdef; + qed; + fol Hnonempty Hsub - SUBSET CONVEX; + qed; +`;; + +let PlaneSeparation = theorem `; + ∀l. Line l + ⇒ ∃H1 H2. H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ + Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ + ∀P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) + + proof + intro_TAC ∀l, l_line; + consider A such that + A ∉ l [notAl] by fol l_line ExistsPointOffLine; + consider E such that + E ∈ l ∧ ¬(A = E) [El] by fol l_line I2 - ∉; + consider B such that + E ∈ Open (A, B) ∧ ¬(E = B) ∧ Collinear A E B [AEB] by fol - B2' B1'; + B ∉ l [notBl] by fol - l_line El ∉ notAl NonCollinearRaa CollinearSymmetry; + ¬(A,B same_side l) [Ansim_lB] by fol l_line El AEB SameSide_DEF; + consider H1 H2 such that + H1 = {X | X ∉ l ∧ X,A same_side l} ∧ + H2 = {X | X ∉ l ∧ X,B same_side l} [H12sets] by fol; + ∀X. (X ∈ H1 ⇔ X ∉ l ∧ X,A same_side l) ∧ + (X ∈ H2 ⇔ X ∉ l ∧ X,B same_side l) [H12def] by simplify IN_ELIM_THM -; + H1 ∩ H2 = ∅ [H12disjoint] + proof + assume ¬(H1 ∩ H2 = ∅) [nonempty] by fol; + consider V such that + V ∈ H1 ∧ V ∈ H2 [VinH12] by fol - MEMBER_NOT_EMPTY IN_INTER; + V ∉ l ∧ V,A same_side l ∧ V ∉ l ∧ V,B same_side l [] by fol - H12def; + A,B same_side l [] by fol l_line - notAl notBl SameSideSymmetric SameSideTransitive; + fol - Ansim_lB; + qed; + ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ H1 ⊂ complement l ∧ H2 ⊂ complement l ∧ + Convex H1 ∧ Convex H2 [H12convex_nonempty] by fol l_line notAl notBl H12sets HalfPlaneConvexNonempty; + H1 ∪ H2 ⊂ complement l [H12sub] by fol H12convex_nonempty UNION_SUBSET; + ∀C. C ∈ complement l ⇒ C ∈ H1 ∪ H2 [] + proof + intro_TAC ∀C, compl; + C ∉ l [notCl] by fol - IN_PlaneComplement; + C,A same_side l ∨ C,B same_side l [] by fol l_line notAl notBl - Ansim_lB AtMost2Sides; + fol notCl - H12def IN_UNION; + qed; + complement l ⊂ H1 ∪ H2 [] by fol - SUBSET; + complement l = H1 ∪ H2 [compl_H1unionH2] by fol H12sub - SUBSET_ANTISYM; + ∀P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) [opp_sides] + proof + intro_TAC ∀P Q, both; + P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,B same_side l [PH1_QH2] by fol - H12def IN; + fol l_line - notAl SameSideSymmetric notBl Ansim_lB SameSideTransitive; + qed; + fol H12disjoint H12convex_nonempty compl_H1unionH2 opp_sides; + qed; +`;; + +let TetralateralSymmetry = theorem `; + ∀A B C D. Tetralateral A B C D + ⇒ Tetralateral B C D A ∧ Tetralateral A B D C + + proof + intro_TAC ∀A B C D, H1; + ¬Collinear A B D ∧ ¬Collinear B D C ∧ ¬Collinear D C A ∧ ¬Collinear C A B [TetraABCD] by fol H1 Tetralateral_DEF CollinearSymmetry; + simplify H1 - Tetralateral_DEF; + fol H1 Tetralateral_DEF; + qed; +`;; + +let EasyEmptyIntersectionsTetralateralHelp = theorem `; + ∀A B C D. Tetralateral A B C D ⇒ Open (A, B) ∩ Open (B, C) = ∅ + + proof + intro_TAC ∀A B C D, H1; + ∀X. X ∈ Open (B, C) ⇒ X ∉ Open (A, B) [] + proof + intro_TAC ∀X, BXC; + ¬Collinear A B C ∧ Collinear B X C ∧ ¬(X = B) [] by fol H1 Tetralateral_DEF - B1'; + ¬Collinear A X B [] by fol - CollinearSymmetry B1' NoncollinearityExtendsToLine; + fol - B1' ∉; + qed; + fol - DisjointOneNotOther; + qed; +`;; + +let EasyEmptyIntersectionsTetralateral = theorem `; + ∀A B C D. Tetralateral A B C D + ⇒ Open (A, B) ∩ Open (B, C) = ∅ ∧ Open (B, C) ∩ Open (C, D) = ∅ ∧ + Open (C, D) ∩ Open (D, A) = ∅ ∧ Open (D, A) ∩ Open (A, B) = ∅ + + proof + intro_TAC ∀A B C D, H1; + Tetralateral B C D A ∧ Tetralateral C D A B ∧ Tetralateral D A B C [] by fol H1 TetralateralSymmetry; + fol H1 - EasyEmptyIntersectionsTetralateralHelp; + qed; +`;; + +let SegmentSameSideOppositeLine = theorem `; + ∀A B C D a c. Quadrilateral A B C D ⇒ + Line a ∧ A ∈ a ∧ B ∈ a ⇒ Line c ∧ C ∈ c ∧ D ∈ c + ⇒ A,B same_side c ∨ C,D same_side a + + proof + intro_TAC ∀A B C D a c, H1, a_line, c_line; + assume ¬(C,D same_side a) [CDnsim_a] by fol; + consider G such that + G ∈ a ∧ G ∈ Open (C, D) [CGD] by fol - a_line SameSide_DEF; + G ∈ c ∧ Collinear G B A [Gc] by fol c_line - BetweenLinear a_line Collinear_DEF; + ¬Collinear B C D ∧ ¬Collinear C D A ∧ Open (A, B) ∩ Open (C, D) = ∅ [quadABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; + A ∉ c ∧ B ∉ c ∧ ¬(A = G) ∧ ¬(B = G) [Distinct] by fol - c_line Collinear_DEF ∉ Gc; + G ∉ Open (A, B) [] by fol quadABCD CGD DisjointOneNotOther; + A ∈ ray G B ━ {G} [] by fol Distinct Gc - IN_Ray IN_DIFF IN_SING; + fol c_line Gc Distinct - RaySameSide; + qed; +`;; + +let ConvexImpliesQuad = theorem `; + ∀A B C D. Tetralateral A B C D ⇒ + C ∈ int_angle D A B ∧ D ∈ int_angle A B C + ⇒ Quadrilateral A B C D + + proof + intro_TAC ∀A B C D, H1, H2; + ¬(A = B) ∧ ¬(B = C) ∧ ¬(A = D) [TetraABCD] by fol H1 Tetralateral_DEF; + consider a such that + Line a ∧ A ∈ a ∧ B ∈ a [a_line] by fol TetraABCD I1; + consider b such that + Line b ∧ B ∈ b ∧ C ∈ b [b_line] by fol TetraABCD I1; + consider d such that + Line d ∧ D ∈ d ∧ A ∈ d [d_line] by fol TetraABCD I1; + Open (B, C) ⊂ b ∧ Open (A, B) ⊂ a [BCbABa] by fol b_line a_line BetweenLinear SUBSET; + D,A same_side b ∧ C,D same_side a [] by fol H2 a_line b_line d_line InteriorUse; + b ∩ Open (D, A) = ∅ ∧ a ∩ Open (C, D) = ∅ [] by fol - b_line SameSide_DEF IN_INTER MEMBER_NOT_EMPTY; + fol H1 BCbABa - INTER_TENSOR SUBSET_REFL SUBSET_EMPTY Quadrilateral_DEF; + qed; +`;; + +let DiagonalsIntersectImpliesConvexQuad = theorem `; + ∀A B C D G. ¬Collinear B C D ⇒ + G ∈ Open (A, C) ∧ G ∈ Open (B, D) + ⇒ ConvexQuadrilateral A B C D + + proof + intro_TAC ∀A B C D G, BCDncol, DiagInt; + ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬(C = A) ∧ ¬(A = G) ∧ ¬(D = G) ∧ ¬(B = G) [Distinct] by fol BCDncol NonCollinearImpliesDistinct DiagInt B1'; + Collinear A G C ∧ Collinear B G D [Gcols] by fol DiagInt B1'; + ¬Collinear C D G ∧ ¬Collinear B C G [Gncols] by fol BCDncol CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; + ¬Collinear C D A [CDAncol] by fol - CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; + ¬Collinear A B C ∧ ¬Collinear D A G [ABCncol] by fol Gncols - CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; + ¬Collinear D A B [DABncol] by fol - CollinearSymmetry Distinct Gcols NoncollinearityExtendsToLine; + ¬(A = B) ∧ ¬(A = D) [] by fol DABncol NonCollinearImpliesDistinct; + Tetralateral A B C D [TetraABCD] by fol Distinct - BCDncol CDAncol DABncol ABCncol Tetralateral_DEF; + A ∈ ray C G ━ {C} ∧ B ∈ ray D G ━ {D} ∧ C ∈ ray A G ━ {A} ∧ D ∈ ray B G ━ {B} [ArCG] by fol DiagInt B1' IntervalRayEZ; + G ∈ int_angle B C D ∧ G ∈ int_angle C D A ∧ G ∈ int_angle D A B ∧ G ∈ int_angle A B C [] by fol BCDncol CDAncol DABncol ABCncol DiagInt B1' ConverseCrossbar; + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C [] by fol - ArCG WholeRayInterior; + fol TetraABCD - ConvexImpliesQuad ConvexQuad_DEF; + qed; +`;; + +let DoubleNotSimImpliesDiagonalsIntersect = theorem `; + ∀A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ⇒ Line m ∧ B ∈ m ∧ D ∈ m ⇒ + Tetralateral A B C D ⇒ ¬(B,D same_side l) ⇒ ¬(A,C same_side m) + ⇒ (∃G. G ∈ Open (A, C) ∩ Open (B, D)) ∧ ConvexQuadrilateral A B C D + + proof + intro_TAC ∀A B C D l m, l_line, m_line, H1, H2, H3; + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Tetralateral_DEF; + consider G such that + G ∈ Open (A, C) ∧ G ∈ m [AGC] by fol H3 m_line SameSide_DEF; + G ∈ l [Gl] by fol l_line - BetweenLinear; + A ∉ m ∧ B ∉ l ∧ D ∉ l [] by fol TetraABCD m_line l_line Collinear_DEF ∉; + ¬(l = m) ∧ B ∈ m ━ {G} ∧ D ∈ m ━ {G} [BDm_G] by fol - l_line ∉ m_line Gl IN_DIFF IN_SING; + l ∩ m = {G} [] by fol l_line m_line - Gl AGC I1Uniqueness; + G ∈ Open (B, D) [] by fol l_line m_line - BDm_G H2 EquivIntersection ∉; + fol AGC - IN_INTER TetraABCD DiagonalsIntersectImpliesConvexQuad; + qed; +`;; + +let ConvexQuadImpliesDiagonalsIntersect = theorem `; + ∀A B C D l m. Line l ∧ A ∈ l ∧ C ∈ l ⇒ Line m ∧ B ∈ m ∧ D ∈ m ⇒ + ConvexQuadrilateral A B C D + ⇒ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ + (∃G. G ∈ Open (A, C) ∩ Open (B, D)) ∧ ¬Quadrilateral A B D C + + proof + intro_TAC ∀A B C D l m, l_line, m_line, ConvQuadABCD; + Tetralateral A B C D ∧ A ∈ int_angle B C D ∧ D ∈ int_angle A B C [convquadABCD] by fol ConvQuadABCD ConvexQuad_DEF Quadrilateral_DEF; + ¬(B,D same_side l) ∧ ¬(A,C same_side m) [opp_sides] by fol convquadABCD l_line m_line InteriorOpposite; + consider G such that + G ∈ Open (A, C) ∩ Open (B, D) [Gexists] by fol l_line m_line convquadABCD opp_sides DoubleNotSimImpliesDiagonalsIntersect; + ¬(Open (B, D) ∩ Open (C, A) = ∅) [] by fol - IN_INTER B1' MEMBER_NOT_EMPTY; + ¬Quadrilateral A B D C [] by fol - Quadrilateral_DEF; + fol opp_sides Gexists -; + qed; +`;; + +let FourChoicesTetralateralHelp = theorem `; + ∀A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B + ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B + + proof + intro_TAC ∀A B C D, H1 CintDAB; + ¬(A = B) ∧ ¬(D = A) ∧ ¬(A = C) ∧ ¬(B = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Tetralateral_DEF; + consider a d such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line d ∧ D ∈ d ∧ A ∈ d [ad_line] by fol TetraABCD I1; + consider l m such that + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by fol TetraABCD I1; + C ∉ a ∧ C ∉ d ∧ B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m ∧ ¬Collinear A B D ∧ ¬Collinear B D A [tetra'] by fol TetraABCD ad_line lm_line Collinear_DEF ∉ CollinearSymmetry; + ¬(B,D same_side l) [Bsim_lD] by fol CintDAB lm_line InteriorOpposite - SameSideSymmetric; + assume A,C same_side m [same] by fol lm_line H1 Bsim_lD DoubleNotSimImpliesDiagonalsIntersect; + C,A same_side m [Csim_mA] by fol lm_line - tetra' SameSideSymmetric; + C,B same_side d ∧ C,D same_side a [] by fol ad_line CintDAB InteriorUse; + C ∈ int_angle A B D ∧ C ∈ int_angle B D A [] by fol tetra' ad_line lm_line Csim_mA - IN_InteriorAngle; + fol CintDAB - IN_InteriorTriangle; + qed; +`;; + +let FourChoicesTetralateralHelp = theorem `; + ∀A B C D. Tetralateral A B C D ∧ C ∈ int_angle D A B + ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B + + proof + intro_TAC ∀A B C D, H1 CintDAB; + ¬(A = B) ∧ ¬(D = A) ∧ ¬(A = C) ∧ ¬(B = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Tetralateral_DEF; + consider a d such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line d ∧ D ∈ d ∧ A ∈ d [ad_line] by fol TetraABCD I1; + consider l m such that + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by fol TetraABCD I1; + C ∉ a ∧ C ∉ d ∧ B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m ∧ ¬Collinear A B D ∧ ¬Collinear B D A [tetra'] by fol TetraABCD ad_line lm_line Collinear_DEF ∉ CollinearSymmetry; + ¬(B,D same_side l) [Bsim_lD] by fol CintDAB lm_line InteriorOpposite - SameSideSymmetric; + assume A,C same_side m [same] by fol lm_line H1 Bsim_lD DoubleNotSimImpliesDiagonalsIntersect; + C,A same_side m [Csim_mA] by fol lm_line - tetra' SameSideSymmetric; + C,B same_side d ∧ C,D same_side a [] by fol ad_line CintDAB InteriorUse; + C ∈ int_angle A B D ∧ C ∈ int_angle B D A [] by fol tetra' ad_line lm_line Csim_mA - IN_InteriorAngle; + fol CintDAB - IN_InteriorTriangle; + qed; +`;; + +let InteriorTriangleSymmetry = theorem `; + ∀A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A + by fol IN_InteriorTriangle`;; + +let FourChoicesTetralateral = theorem `; + ∀A B C D a. Tetralateral A B C D ⇒ + Line a ∧ A ∈ a ∧ B ∈ a ⇒ C,D same_side a + ⇒ ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ + D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B + + proof + intro_TAC ∀A B C D a, H1, a_line, Csim_aD; + ¬(A = B) ∧ ¬Collinear A B C ∧ ¬Collinear C D A ∧ ¬Collinear D A B ∧ Tetralateral A B D C [TetraABCD] by fol H1 Tetralateral_DEF TetralateralSymmetry; + ¬Collinear C A D ∧ C ∉ a ∧ D ∉ a [notCDa] by fol TetraABCD CollinearSymmetry a_line Collinear_DEF ∉; + C ∈ int_angle D A B ∨ D ∈ int_angle C A B [] by fol TetraABCD a_line - Csim_aD AngleOrdering; + case_split CintDAB | DintCAB by fol -; + suppose C ∈ int_angle D A B; + ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B [] by fol H1 - FourChoicesTetralateralHelp; + fol -; + end; + suppose D ∈ int_angle C A B; + ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B [] by fol TetraABCD - FourChoicesTetralateralHelp; + fol - InteriorTriangleSymmetry; + end; + qed; +`;; + +let QuadrilateralSymmetry = theorem `; + ∀A B C D. Quadrilateral A B C D ⇒ + Quadrilateral B C D A ∧ Quadrilateral C D A B ∧ Quadrilateral D A B C + by fol Quadrilateral_DEF INTER_COMM TetralateralSymmetry Quadrilateral_DEF`;; + +let FiveChoicesQuadrilateral = theorem `; + ∀A B C D l m. Quadrilateral A B C D ⇒ + Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m + ⇒ (ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ + B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ + D ∈ int_triangle A B C) ∧ + (¬(B,D same_side l) ∨ ¬(A,C same_side m)) + + proof + intro_TAC ∀A B C D l m, H1, lm_line; + Tetralateral A B C D [H1Tetra] by fol H1 Quadrilateral_DEF; + ¬(A = B) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(C = D) [Distinct] by fol H1Tetra Tetralateral_DEF; + consider a c such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by fol Distinct I1; + Quadrilateral C D A B ∧ Tetralateral C D A B [tetraCDAB] by fol H1 QuadrilateralSymmetry Quadrilateral_DEF; + ¬ConvexQuadrilateral A B D C ∧ ¬ConvexQuadrilateral C D B A [notconvquad] by fol Distinct I1 H1 - ConvexQuadImpliesDiagonalsIntersect; + ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ + B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ + D ∈ int_triangle A B C [5choices] + proof + A,B same_side c ∨ C,D same_side a [2pos] by fol H1 ac_line SegmentSameSideOppositeLine; + assume A,B same_side c [Asym_cB] by fol 2pos H1Tetra ac_line notconvquad FourChoicesTetralateral; + ConvexQuadrilateral C D A B ∨ B ∈ int_triangle C D A ∨ + A ∈ int_triangle B C D [X1] by fol tetraCDAB ac_line - notconvquad FourChoicesTetralateral; + fol - QuadrilateralSymmetry ConvexQuad_DEF; + qed; + ¬(B,D same_side l) ∨ ¬(A,C same_side m) [] by fol - lm_line ConvexQuadImpliesDiagonalsIntersect IN_InteriorTriangle InteriorAngleSymmetry InteriorOpposite; + fol 5choices -; + qed; +`;; + +let IntervalSymmetry = theorem `; + ∀A B. Open (A, B) = Open (B, A) + by fol B1' EXTENSION`;; + +let SegmentSymmetry = theorem `; + ∀A B. seg A B = seg B A + by fol Segment_DEF INSERT_COMM IntervalSymmetry`;; + +let C1OppositeRay = theorem `; + ∀O P s. Segment s ∧ ¬(O = P) ⇒ ∃Q. P ∈ Open (O, Q) ∧ seg P Q ≡ s + + proof + intro_TAC ∀O P s, H1; + consider Z such that + P ∈ Open (O, Z) ∧ ¬(P = Z) [OPZ] by fol H1 B2' B1'; + consider Q such that + Q ∈ ray P Z ━ {P} ∧ seg P Q ≡ s [PQeq] by fol H1 - C1; + P ∈ Open (Q, O) [] by fol OPZ - OppositeRaysIntersect1pointHelp; + fol - B1' PQeq; + qed; +`;; + +let OrderedCongruentSegments = theorem `; + ∀A B C D G. ¬(A = C) ∧ ¬(D = G) ⇒ seg A C ≡ seg D G ⇒ B ∈ Open (A, C) + ⇒ ∃E. E ∈ Open (D, G) ∧ seg A B ≡ seg D E + + proof + intro_TAC ∀A B C D G, H1, H2, H3; + Segment (seg A B) ∧ Segment (seg A C) ∧ Segment (seg B C) ∧ Segment (seg D G) [segs] by fol H3 B1' H1 SEGMENT; + seg D G ≡ seg A C [DGeqAC] by fol - H2 C2Symmetric; + consider E such that + E ∈ ray D G ━ {D} ∧ seg D E ≡ seg A B [DEeqAB] by fol segs H1 C1; + ¬(E = D) ∧ Collinear D E G ∧ D ∉ Open (G, E) [ErDG] by fol - IN_DIFF IN_SING IN_Ray B1' CollinearSymmetry ∉; + consider G' such that + E ∈ Open (D, G') ∧ seg E G' ≡ seg B C [DEG'] by fol segs - C1OppositeRay; + seg D G' ≡ seg A C [DG'eqAC] by fol DEG' H3 DEeqAB C3; + Segment (seg D G') ∧ Segment (seg D E) [] by fol DEG' B1' SEGMENT; + seg A C ≡ seg D G' ∧ seg A B ≡ seg D E [ABeqDE] by fol segs - DG'eqAC C2Symmetric DEeqAB; + G' ∈ ray D E ━ {D} ∧ G ∈ ray D E ━ {D} [] by fol DEG' IntervalRayEZ ErDG IN_Ray H1 IN_DIFF IN_SING; + G' = G [] by fol ErDG segs - DG'eqAC DGeqAC C1; + fol - DEG' ABeqDE; + qed; +`;; + +let SegmentSubtraction = theorem `; + ∀A B C A' B' C'. B ∈ Open (A, C) ∧ B' ∈ Open (A', C') ⇒ + seg A B ≡ seg A' B' ⇒ seg A C ≡ seg A' C' + ⇒ seg B C ≡ seg B' C' + + proof + intro_TAC ∀A B C A' B' C', H1, H2, H3; + ¬(A = B) ∧ ¬(A = C) ∧ Collinear A B C ∧ Segment (seg A' C') ∧ Segment (seg B' C') [Distinct] by fol H1 B1' SEGMENT; + consider Q such that + B ∈ Open (A, Q) ∧ seg B Q ≡ seg B' C' [defQ] by fol - C1OppositeRay; + seg A Q ≡ seg A' C' [AQ_A'C'] by fol H1 H2 - C3; + ¬(A = Q) ∧ Collinear A B Q ∧ A ∉ Open (C, B) ∧ A ∉ Open (Q, B) [] + proof simplify defQ B1' ∉; fol defQ B1' H1 B3'; qed; + C ∈ ray A B ━ {A} ∧ Q ∈ ray A B ━ {A} [] by fol Distinct - IN_Ray IN_DIFF IN_SING; + fol defQ Distinct - AQ_A'C' H3 C1; + qed; +`;; + +let SegmentOrderingUse = theorem `; + ∀A B s. Segment s ∧ ¬(A = B) ⇒ s <__ seg A B + ⇒ ∃G. G ∈ Open (A, B) ∧ s ≡ seg A G + + proof + intro_TAC ∀A B s, H1, H2; + consider A' B' G' such that + seg A B = seg A' B' ∧ G' ∈ Open (A', B') ∧ s ≡ seg A' G' [H2'] by fol H2 SegmentOrdering_DEF; + ¬(A' = G') ∧ ¬(A' = B') ∧ seg A' B' ≡ seg A B [A'notB'G'] by fol - B1' H1 SEGMENT C2Reflexive; + consider G such that + G ∈ Open (A, B) ∧ seg A' G' ≡ seg A G [AGB] by fol A'notB'G' H1 H2' - OrderedCongruentSegments; + s ≡ seg A G [] by fol H1 A'notB'G' - B1' SEGMENT H2' C2Transitive; + fol AGB -; + qed; +`;; + +let SegmentTrichotomy1 = theorem `; + ∀s t. s <__ t ⇒ ¬(s ≡ t) + + proof + intro_TAC ∀s t, H1; + consider A B G such that + Segment s ∧ t = seg A B ∧ G ∈ Open (A, B) ∧ s ≡ seg A G [H1'] by fol H1 SegmentOrdering_DEF; + ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [Distinct] by fol H1' B1'; + seg A B ≡ seg A B [ABrefl] by fol - SEGMENT C2Reflexive; + G ∈ ray A B ━ {A} ∧ B ∈ ray A B ━ {A} [] by fol H1' IntervalRay EndpointInRay Distinct IN_DIFF IN_SING; + ¬(seg A G ≡ seg A B) ∧ seg A G ≡ s [] by fol Distinct SEGMENT - ABrefl C1 H1' C2Symmetric; + fol Distinct H1' SEGMENT - C2Transitive; + qed; +`;; + +let SegmentTrichotomy2 = theorem `; + ∀s t u. s <__ t ∧ Segment u ∧ t ≡ u ⇒ s <__ u + + proof + intro_TAC ∀s t u, H1 H2; + consider A B P such that + Segment s ∧ t = seg A B ∧ P ∈ Open (A, B) ∧ s ≡ seg A P [H1'] by fol H1 SegmentOrdering_DEF; + ¬(A = B) ∧ ¬(A = P) [Distinct] by fol - B1'; + consider X Y such that + u = seg X Y ∧ ¬(X = Y) [uXY] by fol H2 SEGMENT; + consider Q such that + Q ∈ Open (X, Y) ∧ seg A P ≡ seg X Q [XQY] by fol Distinct - H1' H2 OrderedCongruentSegments; + ¬(X = Q) ∧ s ≡ seg X Q [] by fol - B1' H1' Distinct SEGMENT XQY C2Transitive; + fol H1' uXY XQY - SegmentOrdering_DEF; + qed; +`;; + +let SegmentOrderTransitivity = theorem `; + ∀s t u. s <__ t ∧ t <__ u ⇒ s <__ u + + proof + intro_TAC ∀s t u, H1; + consider A B G such that + u = seg A B ∧ G ∈ Open (A, B) ∧ t ≡ seg A G [H1'] by fol H1 SegmentOrdering_DEF; + ¬(A = B) ∧ ¬(A = G) ∧ Segment s [Distinct] by fol H1' B1' H1 SegmentOrdering_DEF; + s <__ seg A G [] by fol H1 H1' Distinct SEGMENT SegmentTrichotomy2; + consider F such that + F ∈ Open (A, G) ∧ s ≡ seg A F [AFG] by fol Distinct - SegmentOrderingUse; + F ∈ Open (A, B) [] by fol H1' IntervalsAreConvex - SUBSET; + fol Distinct H1' - AFG SegmentOrdering_DEF; + qed; +`;; + +let SegmentTrichotomy = theorem `; + ∀s t. Segment s ∧ Segment t + ⇒ (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ ¬(s ≡ t ∧ s <__ t) ∧ + ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) + + proof + intro_TAC ∀s t, H1; + ¬(s ≡ t ∧ s <__ t) [Not12] by fol - SegmentTrichotomy1; + ¬(s ≡ t ∧ t <__ s) [Not13] by fol H1 - SegmentTrichotomy1 C2Symmetric; + ¬(s <__ t ∧ t <__ s) [Not23] by fol H1 - SegmentOrderTransitivity SegmentTrichotomy1 H1 C2Reflexive; + consider O P such that + s = seg O P ∧ ¬(O = P) [sOP] by fol H1 SEGMENT; + consider Q such that + Q ∈ ray O P ━ {O} ∧ seg O Q ≡ t [QrOP] by fol H1 - C1; + O ∉ Open (Q, P) ∧ Collinear O P Q ∧ ¬(O = Q) [notQOP] by fol - IN_DIFF IN_SING IN_Ray; + s ≡ seg O P ∧ t ≡ seg O Q ∧ seg O Q ≡ t ∧ seg O P ≡ s [stOPQ] by fol H1 sOP - SEGMENT QrOP C2Reflexive C2Symmetric; + assume ¬(Q = P) [notQP] by fol stOPQ sOP QrOP Not12 Not13 Not23; + P ∈ Open (O, Q) ∨ Q ∈ Open (O, P) [] by fol sOP - notQOP B3' B1' ∉; + s <__ seg O Q ∨ t <__ seg O P [] by fol H1 - stOPQ SegmentOrdering_DEF; + s <__ t ∨ t <__ s [] by fol - H1 stOPQ SegmentTrichotomy2; + fol - Not12 Not13 Not23; + qed; +`;; + + +let C4Uniqueness = theorem `; + ∀O A B P l. Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) ⇒ + B ∉ l ∧ P ∉ l ∧ P,B same_side l ⇒ ∡ A O P ≡ ∡ A O B + ⇒ ray O B = ray O P + + proof + intro_TAC ∀O A B P l, H1, H2, H3; + ¬(O = B) ∧ ¬(O = P) ∧ Ray (ray O B) ∧ Ray (ray O P) [Distinct] by fol H2 H1 ∉ RAY; + ¬Collinear A O B ∧ B,B same_side l [Bsim_lB] by fol H1 H2 I1 Collinear_DEF ∉ SameSideReflexive; + Angle (∡ A O B) ∧ ∡ A O B ≡ ∡ A O B [] by fol - ANGLE C5Reflexive; + fol - H1 H2 Distinct Bsim_lB H3 C4; + qed; +`;; + +let AngleSymmetry = theorem `; + ∀A O B. ∡ A O B = ∡ B O A + by fol Angle_DEF UNION_COMM`;; + +let TriangleCongSymmetry = theorem `; + ∀A B C A' B' C'. A,B,C ≅ A',B',C' + ⇒ A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ + B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' + + proof + intro_TAC ∀A B C A' B' C', H1; + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B' [H1'] by fol H1 TriangleCong_DEF; + seg B A ≡ seg B' A' ∧ seg C A ≡ seg C' A' ∧ seg C B ≡ seg C' B' [segments] by fol H1' SegmentSymmetry; + ∡ C B A ≡ ∡ C' B' A' ∧ ∡ A C B ≡ ∡ A' C' B' ∧ ∡ B A C ≡ ∡ B' A' C' [] by fol H1' AngleSymmetry; + fol CollinearSymmetry H1' segments - TriangleCong_DEF; + qed; +`;; + +let SAS = theorem `; + ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ + seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ⇒ ∡ A B C ≡ ∡ A' B' C' + ⇒ A,B,C ≅ A',B',C' + + proof + intro_TAC ∀A B C A' B' C', H1, H2, H3; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A' = C') [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider c such that + Line c ∧ A ∈ c ∧ B ∈ c [c_line] by fol Distinct I1; + C ∉ c [notCc] by fol H1 c_line Collinear_DEF ∉; + ∡ B C A ≡ ∡ B' C' A' [BCAeq] by fol H1 H2 H3 C6; + ∡ B A C ≡ ∡ B' A' C' [BACeq] by fol H1 CollinearSymmetry H2 H3 AngleSymmetry C6; + consider Y such that + Y ∈ ray A C ━ {A} ∧ seg A Y ≡ seg A' C' [YrAC] by fol Distinct SEGMENT C1; + Y ∉ c ∧ Y,C same_side c [Ysim_cC] by fol c_line notCc - RaySameSide; + ¬Collinear Y A B [YABncol] by fol Distinct c_line - NonCollinearRaa CollinearSymmetry; + ray A Y = ray A C ∧ ∡ Y A B = ∡ C A B [] by fol Distinct YrAC RayWellDefined Angle_DEF; + ∡ Y A B ≡ ∡ C' A' B' [] by fol BACeq - AngleSymmetry; + ∡ A B Y ≡ ∡ A' B' C' [ABYeq] by fol YABncol H1 CollinearSymmetry H2 SegmentSymmetry YrAC - C6; + Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A B Y) [] by fol H1 CollinearSymmetry YABncol ANGLE; + ∡ A B Y ≡ ∡ A B C [ABYeqABC] by fol - ABYeq - H3 C5Symmetric C5Transitive; + ray B C = ray B Y ∧ ¬(Y = B) ∧ Y ∈ ray B C [] by fol c_line Distinct notCc Ysim_cC ABYeqABC C4Uniqueness ∉ - EndpointInRay; + Collinear B C Y ∧ Collinear A C Y [ABCYcol] by fol - YrAC IN_DIFF IN_SING IN_Ray; + C = Y [] by fol H1 ABCYcol TwoSidesTriangle1Intersection; + seg A C ≡ seg A' C' [] by fol - YrAC; + fol H1 H2 SegmentSymmetry - H3 BCAeq BACeq AngleSymmetry TriangleCong_DEF; + qed; +`;; + +let ASA = theorem `; + ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ + seg A C ≡ seg A' C' ⇒ ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' + ⇒ A,B,C ≅ A',B',C' + + proof + intro_TAC ∀A B C A' B' C', H1, H2, H3; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(A' = C') ∧ ¬(B' = C') ∧ + Segment (seg C' B') [Distinct] by fol H1 NonCollinearImpliesDistinct SEGMENT; + consider D such that + D ∈ ray C B ━ {C} ∧ seg C D ≡ seg C' B' ∧ ¬(D = C) [DrCB] by fol - C1 IN_DIFF IN_SING; + Collinear C B D [CBDcol] by fol - IN_DIFF IN_SING IN_Ray; + ¬Collinear D C A ∧ Angle (∡ C A D) ∧ Angle (∡ C' A' B') ∧ Angle (∡ C A B) [DCAncol] by fol H1 CollinearSymmetry - DrCB NoncollinearityExtendsToLine H1 ANGLE; + consider b such that + Line b ∧ A ∈ b ∧ C ∈ b [b_line] by fol Distinct I1; + B ∉ b ∧ ¬(D = A) [notBb] by fol H1 - Collinear_DEF ∉ DCAncol NonCollinearImpliesDistinct; + D ∉ b ∧ D,B same_side b [Dsim_bB] by fol b_line - DrCB RaySameSide; + ray C D = ray C B [] by fol Distinct DrCB RayWellDefined; + ∡ D C A ≡ ∡ B' C' A' [] by fol H3 - Angle_DEF; + D,C,A ≅ B',C',A' [] by fol DCAncol H1 CollinearSymmetry DrCB H2 SegmentSymmetry - SAS; + ∡ C A D ≡ ∡ C' A' B' [] by fol - TriangleCong_DEF; + ∡ C A D ≡ ∡ C A B [] by fol DCAncol - H3 C5Symmetric C5Transitive; + ray A B = ray A D ∧ D ∈ ray A B [] by fol b_line Distinct notBb Dsim_bB - C4Uniqueness notBb EndpointInRay; + Collinear A B D [ABDcol] by fol - IN_Ray; + D = B [] by fol H1 CBDcol ABDcol CollinearSymmetry TwoSidesTriangle1Intersection; + seg C B ≡ seg C' B' [] by fol - DrCB; + B,C,A ≅ B',C',A' [] by fol H1 CollinearSymmetry - H2 SegmentSymmetry H3 SAS; + fol - TriangleCongSymmetry; + qed; +`;; + +let AngleSubtraction = theorem `; + ∀A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ⇒ + ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' + ⇒ ∡ G O B ≡ ∡ G' O' B' + + proof + intro_TAC ∀A O B A' O' B' G G', H1, H2; + ¬Collinear A O B ∧ ¬Collinear A' O' B' [A'O'B'ncol] by fol H1 IN_InteriorAngle; + ¬(A = O) ∧ ¬(O = B) ∧ ¬(G = O) ∧ ¬(G' = O') ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by fol - NonCollinearImpliesDistinct H1 InteriorEZHelp SEGMENT; + consider X Y such that + X ∈ ray O A ━ {O} ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B ━ {O} ∧ seg O Y ≡ seg O' B' [XYexists] by fol - C1; + G ∈ int_angle X O Y [GintXOY] by fol H1 XYexists InteriorWellDefined InteriorAngleSymmetry; + consider H H' such that + H ∈ Open (X, Y) ∧ H ∈ ray O G ━ {O} ∧ + H' ∈ Open (A', B') ∧ H' ∈ ray O' G' ━ {O'} [Hexists] by fol - H1 Crossbar_THM; + H ∈ int_angle X O Y ∧ H' ∈ int_angle A' O' B' [HintXOY] by fol GintXOY H1 - WholeRayInterior; + ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G ∧ ray O' H' = ray O' G' [Orays] by fol Distinct XYexists Hexists RayWellDefined; + ∡ X O Y ≡ ∡ A' O' B' ∧ ∡ X O H ≡ ∡ A' O' H' [H2'] by fol H2 - Angle_DEF; + ¬Collinear X O Y [] by fol GintXOY IN_InteriorAngle; + X,O,Y ≅ A',O',B' [] by fol - A'O'B'ncol H2' XYexists SAS; + seg X Y ≡ seg A' B' ∧ ∡ O Y X ≡ ∡ O' B' A' ∧ ∡ Y X O ≡ ∡ B' A' O' [XOYcong] by fol - TriangleCong_DEF; + ¬Collinear O H X ∧ ¬Collinear O' H' A' ∧ ¬Collinear O Y H ∧ ¬Collinear O' B' H' [OHXncol] by fol HintXOY InteriorEZHelp InteriorAngleSymmetry CollinearSymmetry; + ray X H = ray X Y ∧ ray A' H' = ray A' B' ∧ ray Y H = ray Y X ∧ ray B' H' = ray B' A' [Hrays] by fol Hexists B1' IntervalRay; + ∡ H X O ≡ ∡ H' A' O' [] by fol XOYcong - Angle_DEF; + O,H,X ≅ O',H',A' [] by fol OHXncol XYexists - H2' ASA; + seg X H ≡ seg A' H' [] by fol - TriangleCong_DEF SegmentSymmetry; + seg H Y ≡ seg H' B' [] by fol Hexists XOYcong - SegmentSubtraction; + seg Y O ≡ seg B' O' ∧ seg Y H ≡ seg B' H' [YHeq] by fol XYexists - SegmentSymmetry; + ∡ O Y H ≡ ∡ O' B' H' [] by fol XOYcong Hrays Angle_DEF; + O,Y,H ≅ O',B',H' [] by fol OHXncol YHeq - SAS; + ∡ H O Y ≡ ∡ H' O' B' [] by fol - TriangleCong_DEF; + fol - Orays Angle_DEF; + qed; +`;; + +let OrderedCongruentAngles = theorem `; + ∀A O B A' O' B' G. ¬Collinear A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ G ∈ int_angle A O B + ⇒ ∃G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' + + proof + intro_TAC ∀A O B A' O' B' G, H1 H2 H3; + ¬Collinear A O B [AOBncol] by fol H3 IN_InteriorAngle; + ¬(A = O) ∧ ¬(O = B) ∧ ¬(A' = B') ∧ ¬(O = G) ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by fol AOBncol H1 NonCollinearImpliesDistinct H3 InteriorEZHelp SEGMENT; + consider X Y such that + X ∈ ray O A ━ {O} ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B ━ {O} ∧ seg O Y ≡ seg O' B' [defXY] by fol - C1; + G ∈ int_angle X O Y [GintXOY] by fol H3 - InteriorWellDefined InteriorAngleSymmetry; + ¬Collinear X O Y ∧ ¬(X = Y) [XOYncol] by fol - IN_InteriorAngle NonCollinearImpliesDistinct; + consider H such that + H ∈ Open (X, Y) ∧ H ∈ ray O G ━ {O} [defH] by fol GintXOY Crossbar_THM; + ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G [Orays] by fol Distinct defXY - RayWellDefined; + ∡ X O Y ≡ ∡ A' O' B' [] by fol H2 - Angle_DEF; + X,O,Y ≅ A',O',B' [] by fol XOYncol H1 defXY - SAS; + seg X Y ≡ seg A' B' ∧ ∡ O X Y ≡ ∡ O' A' B' [YXOcong] by fol - TriangleCong_DEF AngleSymmetry; + consider G' such that + G' ∈ Open (A', B') ∧ seg X H ≡ seg A' G' [A'G'B'] by fol XOYncol Distinct - defH OrderedCongruentSegments; + G' ∈ int_angle A' O' B' [G'intA'O'B'] by fol H1 - ConverseCrossbar; + ray X H = ray X Y ∧ ray A' G' = ray A' B' [] by fol defH A'G'B' IntervalRay; + ∡ O X H ≡ ∡ O' A' G' [HXOeq] by fol - Angle_DEF YXOcong; + H ∈ int_angle X O Y [] by fol GintXOY defH WholeRayInterior; + ¬Collinear O X H ∧ ¬Collinear O' A' G' [] by fol - G'intA'O'B' InteriorEZHelp CollinearSymmetry; + O,X,H ≅ O',A',G' [] by fol - A'G'B' defXY SegmentSymmetry HXOeq SAS; + ∡ X O H ≡ ∡ A' O' G' [] by fol - TriangleCong_DEF AngleSymmetry; + fol G'intA'O'B' - Orays Angle_DEF; + qed; +`;; + +let AngleAddition = theorem `; + ∀A O B A' O' B' G G'. G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ⇒ + ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' + ⇒ ∡ A O B ≡ ∡ A' O' B' + + proof + intro_TAC ∀A O B A' O' B' G G', H1, H2; + ¬Collinear A O B ∧ ¬Collinear A' O' B' [AOBncol] by fol H1 IN_InteriorAngle; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(A' = O') ∧ ¬(A' = B') ∧ ¬(O' = B') ∧ ¬(G = O) [Distinct] by fol - NonCollinearImpliesDistinct H1 InteriorEZHelp; + consider a b such that + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b [a_line] by fol Distinct I1; + consider g such that + Line g ∧ O ∈ g ∧ G ∈ g [g_line] by fol Distinct I1; + G ∉ a ∧ G,B same_side a [H1'] by fol a_line H1 InteriorUse; + ¬Collinear A O G ∧ ¬Collinear A' O' G' [AOGncol] by fol H1 InteriorEZHelp IN_InteriorAngle; + Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A O G) ∧ Angle (∡ A' O' G') [angles] by fol AOBncol - ANGLE; + ∃! r. Ray r ∧ ∃X. ¬(O = X) ∧ r = ray O X ∧ X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' [] by simplify C4 - angles Distinct a_line H1'; + consider X such that + X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' [Xexists] by fol -; + ¬Collinear A O X [AOXncol] by fol Distinct a_line Xexists NonCollinearRaa CollinearSymmetry; + ∡ A' O' B' ≡ ∡ A O X [] by fol - AOBncol ANGLE Xexists C5Symmetric; + consider Y such that + Y ∈ int_angle A O X ∧ ∡ A' O' G' ≡ ∡ A O Y [YintAOX] by fol AOXncol - H1 OrderedCongruentAngles; + ¬Collinear A O Y [] by fol - InteriorEZHelp; + ∡ A O Y ≡ ∡ A O G [AOGeq] by fol - angles - ANGLE YintAOX H2 C5Transitive C5Symmetric; + consider x such that + Line x ∧ O ∈ x ∧ X ∈ x [x_line] by fol Distinct I1; + Y ∉ a ∧ Y,X same_side a [] by fol a_line - YintAOX InteriorUse; + Y ∉ a ∧ Y,G same_side a [] by fol a_line - Xexists H1' SameSideTransitive; + ray O G = ray O Y [] by fol a_line Distinct H1' - AOGeq C4Uniqueness; + G ∈ ray O Y ━ {O} [] by fol Distinct - EndpointInRay IN_DIFF IN_SING; + G ∈ int_angle A O X [GintAOX] by fol YintAOX - WholeRayInterior; + ∡ G O X ≡ ∡ G' O' B' [GOXeq] by fol - H1 Xexists H2 AngleSubtraction; + ¬Collinear G O X ∧ ¬Collinear G O B ∧ ¬Collinear G' O' B' [GOXncol] by fol GintAOX H1 InteriorAngleSymmetry InteriorEZHelp CollinearSymmetry; + Angle (∡ G O X) ∧ Angle (∡ G O B) ∧ Angle (∡ G' O' B') [] by fol - ANGLE; + ∡ G O X ≡ ∡ G O B [G'O'Xeq] by fol angles - GOXeq C5Symmetric H2 C5Transitive; + ¬(A,X same_side g) ∧ ¬(A,B same_side g) [Ansim_aXB] by fol g_line GintAOX H1 InteriorOpposite; + A ∉ g ∧ B ∉ g ∧ X ∉ g [notABXg] by fol g_line AOGncol GOXncol Distinct I1 Collinear_DEF ∉; + X,B same_side g [] by fol g_line - Ansim_aXB AtMost2Sides; + ray O X = ray O B [] by fol g_line Distinct notABXg - G'O'Xeq C4Uniqueness; + fol - Xexists Angle_DEF; + qed; +`;; + +let AngleOrderingUse = theorem `; + ∀A O B α. Angle α ∧ ¬Collinear A O B ⇒ α <_ang ∡ A O B + ⇒ ∃G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G + + proof + intro_TAC ∀A O B α, H1, H3; + consider A' O' B' G' such that + ¬Collinear A' O' B' ∧ ∡ A O B = ∡ A' O' B' ∧ G' ∈ int_angle A' O' B' ∧ α ≡ ∡ A' O' G' [H3'] by fol H3 AngleOrdering_DEF; + Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A' O' G') [angles] by fol H1 - ANGLE InteriorEZHelp; + ∡ A' O' B' ≡ ∡ A O B [] by fol - H3' C5Reflexive; + consider G such that + G ∈ int_angle A O B ∧ ∡ A' O' G' ≡ ∡ A O G [GintAOB] by fol H1 H3' - OrderedCongruentAngles; + α ≡ ∡ A O G [] by fol H1 angles - InteriorEZHelp ANGLE H3' GintAOB C5Transitive; + fol - GintAOB; + qed; +`;; + +let AngleTrichotomy1 = theorem `; + ∀α β. α <_ang β ⇒ ¬(α ≡ β) + + proof + intro_TAC ∀α β, H1; + assume α ≡ β [Con] by fol; + consider A O B G such that + Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by fol H1 AngleOrdering_DEF; + ¬(A = O) ∧ ¬(O = B) ∧ ¬Collinear A O G [Distinct] by fol H1' NonCollinearImpliesDistinct InteriorEZHelp; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol Distinct I1; + consider b such that + Line b ∧ O ∈ b ∧ B ∈ b [b_line] by fol Distinct I1; + B ∉ a [notBa] by fol a_line H1' Collinear_DEF ∉; + G ∉ a ∧ G ∉ b ∧ G,B same_side a [GintAOB] by fol a_line b_line H1' InteriorUse; + ∡ A O G ≡ α [] by fol H1' Distinct ANGLE C5Symmetric; + ∡ A O G ≡ ∡ A O B [] by fol H1' Distinct ANGLE - Con C5Transitive; + ray O B = ray O G [] by fol a_line Distinct notBa GintAOB - C4Uniqueness; + G ∈ b [] by fol Distinct - EndpointInRay b_line RayLine SUBSET; + fol - GintAOB ∉; + qed; +`;; + +let AngleTrichotomy2 = theorem `; + ∀α β γ. α <_ang β ∧ Angle γ ∧ β ≡ γ ⇒ α <_ang γ + + proof + intro_TAC ∀α β γ, H1 H2 H3; + consider A O B G such that + Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by fol H1 AngleOrdering_DEF; + consider A' O' B' such that + γ = ∡ A' O' B' ∧ ¬Collinear A' O' B' [γA'O'B'] by fol H2 ANGLE; + consider G' such that + G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' [G'intA'O'B'] by fol γA'O'B' H1' H3 OrderedCongruentAngles; + ¬Collinear A O G ∧ ¬Collinear A' O' G' [ncol] by fol H1' - InteriorEZHelp; + α ≡ ∡ A' O' G' [] by fol H1' ANGLE - G'intA'O'B' C5Transitive; + fol H1' - ncol γA'O'B' G'intA'O'B' - AngleOrdering_DEF; + qed; +`;; + +let AngleOrderTransitivity = theorem `; + ∀α β γ. α <_ang β ∧ β <_ang γ ⇒ α <_ang γ + + proof + intro_TAC ∀α β γ, H1 H2; + consider A O B G such that + Angle β ∧ ¬Collinear A O B ∧ γ = ∡ A O B ∧ G ∈ int_angle A O B ∧ β ≡ ∡ A O G [H2'] by fol H2 AngleOrdering_DEF; + ¬Collinear A O G [AOGncol] by fol H2' InteriorEZHelp; + Angle α ∧ Angle (∡ A O G) ∧ Angle γ [angles] by fol H1 AngleOrdering_DEF H2' - ANGLE; + α <_ang ∡ A O G [] by fol H1 H2' - AngleTrichotomy2; + consider F such that + F ∈ int_angle A O G ∧ α ≡ ∡ A O F [FintAOG] by fol angles AOGncol - AngleOrderingUse; + F ∈ int_angle A O B [] by fol H2' - InteriorTransitivity; + fol angles H2' - FintAOG AngleOrdering_DEF; + qed; +`;; + +let AngleTrichotomy = theorem `; + ∀α β. Angle α ∧ Angle β + ⇒ (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ + ¬(α ≡ β ∧ α <_ang β) ∧ + ¬(α ≡ β ∧ β <_ang α) ∧ + ¬(α <_ang β ∧ β <_ang α) + + proof + intro_TAC ∀α β, H1; + ¬(α ≡ β ∧ α <_ang β) [Not12] by fol AngleTrichotomy1; + ¬(α ≡ β ∧ β <_ang α) [Not13] by fol H1 C5Symmetric AngleTrichotomy1; + ¬(α <_ang β ∧ β <_ang α) [Not23] by fol H1 AngleOrderTransitivity AngleTrichotomy1 C5Reflexive; + consider P O A such that + α = ∡ P O A ∧ ¬Collinear P O A [POA] by fol H1 ANGLE; + ¬(P = O) ∧ ¬(O = A) [Distinct] by fol - NonCollinearImpliesDistinct; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol - I1; + P ∉ a [notPa] by fol - Distinct I1 POA Collinear_DEF ∉; + ∃! r. Ray r ∧ ∃Q. ¬(O = Q) ∧ r = ray O Q ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β [] by simplify H1 Distinct a_line C4 -; + consider Q such that + ¬(O = Q) ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β [Qexists] by fol -; + O ∉ Open (Q, P) [notQOP] by fol a_line Qexists SameSide_DEF ∉; + ¬Collinear A O P [AOPncol] by fol POA CollinearSymmetry; + ¬Collinear A O Q [AOQncol] by fol a_line Distinct I1 Collinear_DEF Qexists ∉; + Angle (∡ A O P) ∧ Angle (∡ A O Q) [] by fol AOPncol - ANGLE; + α ≡ ∡ A O P ∧ β ≡ ∡ A O Q ∧ ∡ A O P ≡ α [flip] by fol H1 - POA AngleSymmetry C5Reflexive Qexists C5Symmetric; + case_split QOPcol | QOPcolncol by fol -; + suppose Collinear Q O P; + Collinear O P Q [] by fol - CollinearSymmetry; + Q ∈ ray O P ━ {O} [] by fol Distinct - notQOP IN_Ray Qexists IN_DIFF IN_SING; + ray O Q = ray O P [] by fol Distinct - RayWellDefined; + ∡ P O A = ∡ A O Q [] by fol - Angle_DEF AngleSymmetry; + fol - POA Qexists Not12 Not13 Not23; + end; + suppose ¬Collinear Q O P; + P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A [] by fol Distinct a_line Qexists notPa - AngleOrdering; + P ∈ int_angle A O Q ∨ Q ∈ int_angle A O P [] by fol - InteriorAngleSymmetry; + α <_ang ∡ A O Q ∨ β <_ang ∡ A O P [] by fol H1 AOQncol AOPncol - flip AngleOrdering_DEF; + α <_ang β ∨ β <_ang α [] by fol H1 - Qexists flip AngleTrichotomy2; + fol - Not12 Not13 Not23; + end; + qed; +`;; + +let SupplementExists = theorem `; + ∀α. Angle α ⇒ ∃α'. α suppl α' + + proof + intro_TAC ∀α, H1; + consider A O B such that + α = ∡ A O B ∧ ¬Collinear A O B ∧ ¬(A = O) [def_α] by fol H1 ANGLE NonCollinearImpliesDistinct; + consider A' such that + O ∈ Open (A, A') [AOA'] by fol - B2'; + ∡ A O B suppl ∡ A' O B [AOBsup] by fol def_α - SupplementaryAngles_DEF AngleSymmetry; + fol - def_α; + qed; +`;; + +let SupplementImpliesAngle = theorem `; + ∀α β. α suppl β ⇒ Angle α ∧ Angle β + + proof + intro_TAC ∀α β, H1; + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by fol H1 SupplementaryAngles_DEF; + ¬(O = A') ∧ Collinear A O A' [Distinct] by fol - NonCollinearImpliesDistinct B1'; + ¬Collinear B O A' [] by fol H1' CollinearSymmetry - NoncollinearityExtendsToLine; + fol H1' - ANGLE; + qed; +`;; + +let RightImpliesAngle = theorem `; + ∀α. Right α ⇒ Angle α + by fol RightAngle_DEF SupplementImpliesAngle`;; + +let SupplementSymmetry = theorem `; + ∀α β. α suppl β ⇒ β suppl α + + proof + intro_TAC ∀α β, H1; + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by fol H1 SupplementaryAngles_DEF; + ¬(O = A') ∧ Collinear A O A' [] by fol - NonCollinearImpliesDistinct B1'; + ¬Collinear A' O B [A'OBncol] by fol H1' CollinearSymmetry - NoncollinearityExtendsToLine; + O ∈ Open (A', A) ∧ β = ∡ A' O B ∧ α = ∡ B O A [] by fol H1' B1' AngleSymmetry; + fol A'OBncol - SupplementaryAngles_DEF; + qed; +`;; + +let SupplementsCongAnglesCong = theorem `; + ∀α β α' β'. α suppl α' ∧ β suppl β' ⇒ α ≡ β + ⇒ α' ≡ β' + + proof + intro_TAC ∀α β α' β', H1, H2; + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by fol H1 SupplementaryAngles_DEF; + ¬(A = O) ∧ ¬(O = B) ∧ ¬(A = A') ∧ ¬(O = A') ∧ Collinear A O A' [Distinctα] by fol - NonCollinearImpliesDistinct B1'; + ¬Collinear B A A' ∧ ¬Collinear O A' B [BAA'ncol] by fol def_α CollinearSymmetry - NoncollinearityExtendsToLine; + Segment (seg O A) ∧ Segment (seg O B) ∧ Segment (seg O A') [Osegments] by fol Distinctα SEGMENT; + consider C P D C' such that + ¬Collinear C P D ∧ P ∈ Open (C, C') ∧ β = ∡ C P D ∧ β' = ∡ D P C' [def_β] by fol H1 SupplementaryAngles_DEF; + ¬(C = P) ∧ ¬(P = D) ∧ ¬(P = C') [Distinctβ] by fol def_β NonCollinearImpliesDistinct B1'; + consider X such that + X ∈ ray P C ━ {P} ∧ seg P X ≡ seg O A [defX] by fol Osegments Distinctβ C1; + consider Y such that + Y ∈ ray P D ━ {P} ∧ seg P Y ≡ seg O B ∧ ¬(Y = P) [defY] by fol Osegments Distinctβ C1 IN_DIFF IN_SING; + consider X' such that + X' ∈ ray P C' ━ {P} ∧ seg P X' ≡ seg O A' [defX'] by fol Osegments Distinctβ C1; + P ∈ Open (X', C) ∧ P ∈ Open (X, X') [XPX'] by fol def_β - OppositeRaysIntersect1pointHelp defX; + ¬(X = P) ∧ ¬(X' = P) ∧ Collinear X P X' ∧ ¬(X = X') ∧ ray A' O = ray A' A ∧ ray X' P = ray X' X [XPX'line] by fol defX defX' IN_DIFF IN_SING - B1' def_α IntervalRay; + Collinear P D Y ∧ Collinear P C X [] by fol defY defX IN_DIFF IN_SING IN_Ray; + ¬Collinear C P Y ∧ ¬Collinear X P Y [XPYncol] by fol def_β - defY NoncollinearityExtendsToLine CollinearSymmetry XPX'line; + ¬Collinear Y X X' ∧ ¬Collinear P X' Y [YXX'ncol] by fol - CollinearSymmetry XPX' XPX'line NoncollinearityExtendsToLine; + ray P X = ray P C ∧ ray P Y = ray P D ∧ ray P X' = ray P C' [equalPrays] by fol Distinctβ defX defY defX' RayWellDefined; + β = ∡ X P Y ∧ β' = ∡ Y P X' ∧ ∡ A O B ≡ ∡ X P Y [AOBeqXPY] by fol def_β - Angle_DEF H2 def_α; + seg O A ≡ seg P X ∧ seg O B ≡ seg P Y ∧ seg A' O ≡ seg X' P [OAeq] by fol Osegments XPX'line SEGMENT defX defY defX' C2Symmetric SegmentSymmetry; + seg A A' ≡ seg X X' [AA'eq] by fol def_α XPX'line XPX' - SegmentSymmetry C3; + A,O,B ≅ X,P,Y [] by fol def_α XPYncol OAeq AOBeqXPY SAS; + seg A B ≡ seg X Y ∧ ∡ B A O ≡ ∡ Y X P [AOB≅] by fol - TriangleCong_DEF AngleSymmetry; + ray A O = ray A A' ∧ ray X P = ray X X' ∧ ∡ B A A' ≡ ∡ Y X X' [] by fol def_α XPX' IntervalRay - Angle_DEF; + B,A,A' ≅ Y,X,X' [] by fol BAA'ncol YXX'ncol AOB≅ - AA'eq - SAS; + seg A' B ≡ seg X' Y ∧ ∡ A A' B ≡ ∡ X X' Y [] by fol - TriangleCong_DEF SegmentSymmetry; + O,A',B ≅ P,X',Y [] by fol BAA'ncol YXX'ncol OAeq - XPX'line Angle_DEF SAS; + ∡ B O A' ≡ ∡ Y P X' [] by fol - TriangleCong_DEF; + fol - equalPrays def_β Angle_DEF def_α; + qed; +`;; + +let SupplementUnique = theorem `; + ∀α β β'. α suppl β ∧ α suppl β' ⇒ β ≡ β' + by fol SupplementaryAngles_DEF ANGLE C5Reflexive SupplementsCongAnglesCong`;; + +let CongRightImpliesRight = theorem `; + ∀α β. Angle α ∧ Right β ⇒ α ≡ β ⇒ Right α + + proof + intro_TAC ∀α β, H1, H2; + consider α' β' such that + α suppl α' ∧ β suppl β' ∧ β ≡ β' [suppl] by fol H1 SupplementExists H1 RightAngle_DEF; + α' ≡ β' [α'eqβ'] by fol suppl H2 SupplementsCongAnglesCong; + Angle β ∧ Angle α' ∧ Angle β' [] by fol suppl SupplementImpliesAngle; + α ≡ α' [] by fol H1 - H2 suppl α'eqβ' C5Symmetric C5Transitive; + fol suppl - RightAngle_DEF; + qed; +`;; + +let RightAnglesCongruentHelp = theorem `; + ∀A O B A' P a. ¬Collinear A O B ∧ O ∈ Open (A, A') ⇒ + Right (∡ A O B) ∧ Right (∡ A O P) + ⇒ P ∉ int_angle A O B + + proof + intro_TAC ∀A O B A' P a, H1, H2; + assume ¬(P ∉ int_angle A O B) [Con] by fol; + P ∈ int_angle A O B [PintAOB] by fol - ∉; + B ∈ int_angle P O A' ∧ B ∈ int_angle A' O P [BintA'OP] by fol H1 - InteriorReflectionInterior InteriorAngleSymmetry ; + ¬Collinear A O P ∧ ¬Collinear P O A' [AOPncol] by fol PintAOB InteriorEZHelp - IN_InteriorAngle; + ∡ A O B suppl ∡ B O A' ∧ ∡ A O P suppl ∡ P O A' [AOBsup] by fol H1 - SupplementaryAngles_DEF; + consider α' β' such that + ∡ A O B suppl α' ∧ ∡ A O B ≡ α' ∧ ∡ A O P suppl β' ∧ ∡ A O P ≡ β' [supplα'] by fol H2 RightAngle_DEF; + α' ≡ ∡ B O A' ∧ β' ≡ ∡ P O A' [α'eqA'OB] by fol - AOBsup SupplementUnique; + Angle (∡ A O B) ∧ Angle α' ∧ Angle (∡ B O A') ∧ Angle (∡ A O P) ∧ Angle β' ∧ Angle (∡ P O A') [angles] by fol AOBsup supplα' SupplementImpliesAngle AngleSymmetry; + ∡ A O B ≡ ∡ B O A' ∧ ∡ A O P ≡ ∡ P O A' [H2'] by fol - supplα' α'eqA'OB C5Transitive; + ∡ A O P ≡ ∡ A O P ∧ ∡ B O A' ≡ ∡ B O A' [refl] by fol angles C5Reflexive; + ∡ A O P <_ang ∡ A O B ∧ ∡ B O A' <_ang ∡ P O A' [BOA'lessPOA'] by fol angles H1 PintAOB - AngleOrdering_DEF AOPncol CollinearSymmetry BintA'OP AngleSymmetry; + ∡ A O P <_ang ∡ B O A' [] by fol - angles H2' AngleTrichotomy2; + ∡ A O P <_ang ∡ P O A' [] by fol - BOA'lessPOA' AngleOrderTransitivity; + fol - H2' AngleTrichotomy1; + qed; +`;; + +let RightAnglesCongruent = theorem `; + ∀α β. Right α ∧ Right β ⇒ α ≡ β + + proof + intro_TAC ∀α β, H1; + consider α' such that + α suppl α' ∧ α ≡ α' [αright] by fol H1 RightAngle_DEF; + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by fol - SupplementaryAngles_DEF; + ¬(A = O) ∧ ¬(O = B) [Distinct] by fol def_α NonCollinearImpliesDistinct B1'; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by fol Distinct I1; + B ∉ a [notBa] by fol - def_α Collinear_DEF ∉; + Angle β [] by fol H1 RightImpliesAngle; + ∃! r. Ray r ∧ ∃P. ¬(O = P) ∧ r = ray O P ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β [] by simplify C4 - Distinct a_line notBa; + consider P such that + ¬(O = P) ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β [defP] by fol -; + O ∉ Open (P, B) [notPOB] by fol a_line - SameSide_DEF ∉; + ¬Collinear A O P [AOPncol] by fol a_line Distinct defP NonCollinearRaa CollinearSymmetry; + Right (∡ A O P) [AOPright] by fol - ANGLE H1 defP CongRightImpliesRight; + P ∉ int_angle A O B ∧ B ∉ int_angle A O P [] by fol def_α H1 - AOPncol AOPright RightAnglesCongruentHelp; + Collinear P O B [] by fol Distinct a_line defP notBa - AngleOrdering InteriorAngleSymmetry ∉; + P ∈ ray O B ━ {O} [] by fol Distinct - CollinearSymmetry notPOB IN_Ray defP IN_DIFF IN_SING; + ray O P = ray O B ∧ ∡ A O P = ∡ A O B [] by fol Distinct - RayWellDefined Angle_DEF; + fol - defP def_α; + qed; +`;; + +let OppositeRightAnglesLinear = theorem `; + ∀A B O H h. ¬Collinear A O H ∧ ¬Collinear H O B ⇒ + Right (∡ A O H) ∧ Right (∡ H O B) ⇒ + Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) + ⇒ O ∈ Open (A, B) + + proof + intro_TAC ∀A B O H h, H0, H1, H2; + ¬(A = O) ∧ ¬(O = H) ∧ ¬(O = B) [Distinct] by fol H0 NonCollinearImpliesDistinct; + A ∉ h ∧ B ∉ h [notABh] by fol H0 H2 Collinear_DEF ∉; + consider E such that + O ∈ Open (A, E) ∧ ¬(E = O) [AOE] by fol Distinct B2' B1'; + ∡ A O H suppl ∡ H O E [AOHsupplHOE] by fol H0 - SupplementaryAngles_DEF; + E ∉ h [notEh] by fol H2 ∉ AOE BetweenLinear notABh; + ¬(A,E same_side h) [] by fol H2 AOE SameSide_DEF; + B,E same_side h [Bsim_hE] by fol H2 notABh notEh - H2 AtMost2Sides; + consider α' such that + ∡ A O H suppl α' ∧ ∡ A O H ≡ α' [AOHsupplα'] by fol H1 RightAngle_DEF; + Angle (∡ H O B) ∧ Angle (∡ A O H) ∧ Angle α' ∧ Angle (∡ H O E) [angα'] by fol H1 RightImpliesAngle - AOHsupplHOE SupplementImpliesAngle; + ∡ H O B ≡ ∡ A O H ∧ α' ≡ ∡ H O E [] by fol H1 RightAnglesCongruent AOHsupplα' AOHsupplHOE SupplementUnique; + ∡ H O B ≡ ∡ H O E [] by fol angα' - AOHsupplα' C5Transitive; + ray O B = ray O E [] by fol H2 Distinct notABh notEh Bsim_hE - C4Uniqueness; + B ∈ ray O E ━ {O} [] by fol Distinct EndpointInRay - IN_DIFF IN_SING; + fol AOE - OppositeRaysIntersect1pointHelp B1'; + qed; +`;; + +let RightImpliesSupplRight = theorem `; + ∀A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') ∧ Right (∡ A O B) + ⇒ Right (∡ B O A') + + proof + intro_TAC ∀A O B A', H1 H2 H3; + ∡ A O B suppl ∡ B O A' ∧ Angle (∡ A O B) ∧ Angle (∡ B O A') [AOBsuppl] by fol H1 H2 SupplementaryAngles_DEF SupplementImpliesAngle; + consider β such that + ∡ A O B suppl β ∧ ∡ A O B ≡ β [βsuppl] by fol H3 RightAngle_DEF; + Angle β ∧ β ≡ ∡ A O B [angβ] by fol - SupplementImpliesAngle C5Symmetric; + ∡ B O A' ≡ β [] by fol AOBsuppl βsuppl SupplementUnique; + ∡ B O A' ≡ ∡ A O B [] by fol AOBsuppl angβ - βsuppl C5Transitive; + fol AOBsuppl H3 - CongRightImpliesRight; + qed; +`;; + +let IsoscelesCongBaseAngles = theorem `; + ∀A B C. ¬Collinear A B C ∧ seg B A ≡ seg B C ⇒ ∡ C A B ≡ ∡ A C B + + proof + intro_TAC ∀A B C, H1 H2; + ¬(A = B) ∧ ¬(B = C) ∧ ¬Collinear C B A [CBAncol] by fol H1 NonCollinearImpliesDistinct CollinearSymmetry; + seg B C ≡ seg B A ∧ ∡ A B C ≡ ∡ C B A [] by fol - SEGMENT H2 C2Symmetric H1 ANGLE AngleSymmetry C5Reflexive; + fol H1 CBAncol H2 - SAS TriangleCong_DEF; + qed; +`;; + +let C4withC1 = theorem `; + ∀α l O A Y P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ⇒ + Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l ⇒ + ∃N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α + + proof + intro_TAC ∀α l O A Y P Q, H1, l_line; + ∃! r. Ray r ∧ ∃B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α [] by simplify C4 H1 l_line; + consider B such that + ¬(O = B) ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α [Bexists] by fol -; + consider N such that + N ∈ ray O B ━ {O} ∧ seg O N ≡ seg P Q [Nexists] by fol H1 - SEGMENT C1; + N ∉ l ∧ N,B same_side l [notNl] by fol l_line Bexists Nexists RaySameSide; + N,Y same_side l [Nsim_lY] by fol l_line - Bexists SameSideTransitive; + ray O N = ray O B [] by fol Bexists Nexists RayWellDefined; + ∡ A O N ≡ α [] by fol - Bexists Angle_DEF; + fol Nexists IN_DIFF IN_SING notNl Nsim_lY Nexists -; + qed; +`;; + +let C4OppositeSide = theorem `; + ∀α l O A Z P Q. Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ⇒ + Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l + ⇒ ∃N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ + seg O N ≡ seg P Q ∧ ∡ A O N ≡ α + + proof + intro_TAC ∀α l O A Z P Q, H1, l_line; + ¬(Z = O) [] by fol l_line ∉; + consider Y such that + O ∈ Open (Z, Y) [ZOY] by fol - B2'; + ¬(O = Y) ∧ Collinear O Z Y [notOY] by fol - B1' CollinearSymmetry; + Y ∉ l [notYl] by fol notOY l_line NonCollinearRaa ∉; + consider N such that + ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α [Nexists] by simplify C4withC1 H1 l_line -; + ¬(Z,Y same_side l) [] by fol l_line ZOY SameSide_DEF; + ¬(Z,N same_side l) [] by fol l_line Nexists notYl - SameSideTransitive; + fol - Nexists; + qed; +`;; + +let SSS = theorem `; + ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' + ⇒ A,B,C ≅ A',B',C' + + proof + intro_TAC ∀A B C A' B' C', H1, H2; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(B' = C') [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider h such that + Line h ∧ A ∈ h ∧ C ∈ h [h_line] by fol Distinct I1; + B ∉ h [notBh] by fol h_line H1 ∉ Collinear_DEF; + Segment (seg A B) ∧ Segment (seg C B) ∧ Segment (seg A' B') ∧ Segment (seg C' B') [segments] by fol Distinct - SEGMENT; + Angle (∡ C' A' B') [] by fol H1 CollinearSymmetry ANGLE; + consider N such that + ¬(A = N) ∧ N ∉ h ∧ ¬(B,N same_side h) ∧ seg A N ≡ seg A' B' ∧ ∡ C A N ≡ ∡ C' A' B' [Nexists] by simplify C4OppositeSide - Distinct h_line notBh; + ¬(C = N) [] by fol h_line Nexists ∉; + Segment (seg A N) ∧ Segment (seg C N) [segN] by fol Nexists - SEGMENT; + ¬Collinear A N C [ANCncol] by fol Distinct h_line Nexists NonCollinearRaa; + Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A N C) [angles] by fol H1 - ANGLE; + seg A B ≡ seg A N [ABeqAN] by fol segments segN Nexists H2 C2Symmetric C2Transitive; + C,A,N ≅ C',A',B' [] by fol ANCncol H1 CollinearSymmetry H2 Nexists SAS; + ∡ A N C ≡ ∡ A' B' C' ∧ seg C N ≡ seg C' B' [ANCeq] by fol - TriangleCong_DEF; + seg C B ≡ seg C N [CBeqCN] by fol segments segN - H2 SegmentSymmetry C2Symmetric C2Transitive; + consider G such that + G ∈ h ∧ G ∈ Open (B, N) [BGN] by fol Nexists h_line SameSide_DEF; + ¬(B = N) [notBN] by fol - B1'; + ray B G = ray B N ∧ ray N G = ray N B [Grays] by fol BGN B1' IntervalRay; + consider v such that + Line v ∧ B ∈ v ∧ N ∈ v [v_line] by fol notBN I1; + G ∈ v ∧ ¬(h = v) [] by fol v_line BGN BetweenLinear notBh ∉; + h ∩ v = {G} [hvG] by fol h_line v_line - BGN I1Uniqueness; + ¬(G = A) ⇒ ∡ A B G ≡ ∡ A N G [ABGeqANG] + proof + intro_TAC notGA; + A ∉ v [] by fol hvG h_line - EquivIntersectionHelp IN_DIFF IN_SING; + ¬Collinear B A N [] by fol v_line notBN I1 Collinear_DEF - ∉; + ∡ N B A ≡ ∡ B N A [] by fol - ABeqAN IsoscelesCongBaseAngles; + ∡ G B A ≡ ∡ G N A [] by fol - Grays Angle_DEF notGA; + fol - AngleSymmetry; + qed; + ¬(G = C) ⇒ ∡ G B C ≡ ∡ G N C [GBCeqGNC] + proof + intro_TAC notGC; + C ∉ v [] by fol hvG h_line - EquivIntersectionHelp IN_DIFF IN_SING; + ¬Collinear B C N [] by fol v_line notBN I1 Collinear_DEF - ∉; + ∡ N B C ≡ ∡ B N C [] by fol - CBeqCN IsoscelesCongBaseAngles AngleSymmetry; + fol - Grays Angle_DEF; + qed; + ∡ A B C ≡ ∡ A N C [] + proof + assume ¬(G = A) ∧ ¬(G = C) [AGCdistinct] by fol Distinct GBCeqGNC ABGeqANG; + ∡ A B G ≡ ∡ A N G ∧ ∡ G B C ≡ ∡ G N C [Gequivs] by fol - ABGeqANG GBCeqGNC; + ¬Collinear G B C ∧ ¬Collinear G N C ∧ ¬Collinear G B A ∧ ¬Collinear G N A [Gncols] by fol AGCdistinct h_line BGN notBh Nexists NonCollinearRaa; + Collinear A G C [] by fol h_line BGN Collinear_DEF; + G ∈ Open (A, C) ∨ C ∈ Open (G, A) ∨ A ∈ Open (C, G) [] by fol Distinct AGCdistinct - B3'; + case_split AGC | GAC | CAG by fol -; + suppose G ∈ Open (A, C); + G ∈ int_angle A B C ∧ G ∈ int_angle A N C [] by fol H1 ANCncol - ConverseCrossbar; + fol - Gequivs AngleAddition; + end; + suppose C ∈ Open (G, A); + C ∈ int_angle G B A ∧ C ∈ int_angle G N A [] by fol Gncols - B1' ConverseCrossbar; + fol - Gequivs AngleSubtraction AngleSymmetry; + end; + suppose A ∈ Open (C, G); + A ∈ int_angle G B C ∧ A ∈ int_angle G N C [] by fol Gncols - B1' ConverseCrossbar; + fol - Gequivs AngleSymmetry AngleSubtraction; + end; + qed; + ∡ A B C ≡ ∡ A' B' C' [] by fol angles - ANCeq C5Transitive; + fol H1 H2 SegmentSymmetry - SAS; + qed; +`;; + +let AngleBisector = theorem `; + ∀A B C. ¬Collinear B A C ⇒ ∃M. M ∈ int_angle B A C ∧ ∡ B A M ≡ ∡ M A C + + proof + intro_TAC ∀A B C, H1; + ¬(A = B) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider D such that + B ∈ Open (A, D) [ABD] by fol Distinct B2'; + ¬(A = D) ∧ Collinear A B D ∧ Segment (seg A D) [ABD'] by fol - B1' SEGMENT; + consider E such that + E ∈ ray A C ━ {A} ∧ seg A E ≡ seg A D ∧ ¬(A = E) [ErAC] by fol - Distinct C1 IN_Ray IN_DIFF IN_SING; + Collinear A C E ∧ D ∈ ray A B ━ {A} [notAE] by fol - IN_Ray ABD IntervalRayEZ IN_DIFF IN_SING; + ray A D = ray A B ∧ ray A E = ray A C [equalrays] by fol Distinct notAE ErAC RayWellDefined; + ¬Collinear D A E ∧ ¬Collinear E A D ∧ ¬Collinear A E D [EADncol] by fol H1 ABD' notAE ErAC CollinearSymmetry NoncollinearityExtendsToLine; + ∡ D E A ≡ ∡ E D A [DEAeq] by fol EADncol ErAC IsoscelesCongBaseAngles; + ¬Collinear E D A ∧ Angle (∡ E D A) ∧ ¬Collinear A D E ∧ ¬Collinear D E A [angEDA] by fol EADncol CollinearSymmetry ANGLE; + ¬(D = E) [notDE] by fol EADncol NonCollinearImpliesDistinct; + consider h such that + Line h ∧ D ∈ h ∧ E ∈ h [h_line] by fol - I1; + A ∉ h [notAh] by fol - Collinear_DEF EADncol ∉; + consider M such that + ¬(D = M) ∧ M ∉ h ∧ ¬(A,M same_side h) ∧ seg D M ≡ seg D A ∧ ∡ E D M ≡ ∡ E D A [Mexists] by simplify C4OppositeSide angEDA notDE ABD' h_line -; + ¬(A = M) [notAM] by fol h_line - SameSideReflexive; + ¬Collinear E D M ∧ ¬Collinear D E M ∧ ¬Collinear M E D [EDMncol] by fol notDE h_line Mexists NonCollinearRaa CollinearSymmetry; + seg D E ≡ seg D E ∧ seg M A ≡ seg M A [MArefl] by fol notDE notAM SEGMENT C2Reflexive; + E,D,M ≅ E,D,A [] by fol EDMncol angEDA - Mexists SAS; + seg M E ≡ seg A E ∧ ∡ M E D ≡ ∡ A E D ∧ ∡ D E M ≡ ∡ D E A [MED≅] by fol - TriangleCong_DEF SegmentSymmetry AngleSymmetry; + ∡ E D A ≡ ∡ D E A ∧ ∡ E D A ≡ ∡ E D M ∧ ∡ D E A ≡ ∡ D E M [EDAeqEDM] by fol EDMncol ANGLE angEDA Mexists MED≅ DEAeq C5Symmetric; + consider G such that + G ∈ h ∧ G ∈ Open (A, M) [AGM] by fol Mexists h_line SameSide_DEF; + M ∈ ray A G ━ {A} [MrAG] by fol - IntervalRayEZ; + consider v such that + Line v ∧ A ∈ v ∧ M ∈ v ∧ G ∈ v [v_line] by fol notAM I1 AGM BetweenLinear; + ¬(v = h) ∧ v ∩ h = {G} [vhG] by fol - notAh ∉ h_line AGM I1Uniqueness; + D ∉ v [notDv] + proof + assume ¬(D ∉ v) [Con] by fol; + D ∈ v ∧ D = G [DG] by fol h_line - ∉ vhG IN_INTER IN_SING; + D ∈ Open (A, M) [] by fol DG AGM; + ∡ E D A suppl ∡ E D M [EDAsuppl] by fol angEDA - SupplementaryAngles_DEF AngleSymmetry; + Right (∡ E D A) [] by fol EDAsuppl EDAeqEDM RightAngle_DEF; + Right (∡ A E D) [RightAED] by fol angEDA ANGLE - DEAeq CongRightImpliesRight AngleSymmetry; + Right (∡ D E M) [] by fol EDMncol ANGLE - MED≅ CongRightImpliesRight AngleSymmetry; + E ∈ Open (A, M) [] by fol EADncol EDMncol RightAED - h_line Mexists OppositeRightAnglesLinear; + E ∈ v ∧ E = G [] by fol v_line - BetweenLinear h_line vhG IN_INTER IN_SING; + fol - DG notDE; + qed; + E ∉ v [notEv] + proof + assume ¬(E ∉ v) [Con] by fol; + E ∈ v ∧ E = G [EG] by fol h_line - ∉ vhG IN_INTER IN_SING; + E ∈ Open (A, M) [] by fol - AGM; + ∡ D E A suppl ∡ D E M [DEAsuppl] by fol EADncol - SupplementaryAngles_DEF AngleSymmetry; + Right (∡ D E A) [RightDEA] by fol DEAsuppl EDAeqEDM RightAngle_DEF; + Right (∡ E D A) [RightEDA] by fol angEDA RightDEA EDAeqEDM CongRightImpliesRight; + Right (∡ E D M) [] by fol EDMncol ANGLE RightEDA Mexists CongRightImpliesRight; + D ∈ Open (A, M) [] by fol angEDA EDMncol RightEDA AngleSymmetry - h_line Mexists OppositeRightAnglesLinear; + D ∈ v ∧ D = G [] by fol v_line - BetweenLinear h_line vhG IN_INTER IN_SING; + fol - EG notDE; + qed; + ¬Collinear M A E ∧ ¬Collinear M A D ∧ ¬(M = E) [MAEncol] by fol notAM v_line notEv notDv NonCollinearRaa CollinearSymmetry NonCollinearImpliesDistinct; + seg M E ≡ seg A D [MEeqAD] by fol - ErAC ABD' SEGMENT MED≅ ErAC C2Transitive; + seg A D ≡ seg M D [] by fol SegmentSymmetry ABD' Mexists SEGMENT C2Symmetric; + seg M E ≡ seg M D [] by fol MAEncol ABD' Mexists SEGMENT MEeqAD - C2Transitive; + M,A,E ≅ M,A,D [] by fol MAEncol MArefl - ErAC SSS; + ∡ M A E ≡ ∡ M A D [MAEeq] by fol - TriangleCong_DEF; + ∡ D A M ≡ ∡ M A E [] by fol MAEncol ANGLE MAEeq C5Symmetric AngleSymmetry; + ∡ B A M ≡ ∡ M A C [BAMeqMAC] by fol - equalrays Angle_DEF; + ¬(E,D same_side v) [] + proof + assume E,D same_side v [Con] by fol; + ray A D = ray A E [] by fol v_line notAM notDv notEv - MAEeq C4Uniqueness; + fol ABD' EndpointInRay - IN_Ray EADncol; + qed; + consider H such that + H ∈ v ∧ H ∈ Open (E, D) [EHD] by fol v_line - SameSide_DEF; + H = G [] by fol - h_line BetweenLinear IN_INTER vhG IN_SING; + G ∈ int_angle E A D [GintEAD] by fol EADncol - EHD ConverseCrossbar; + M ∈ int_angle E A D [MintEAD] by fol GintEAD MrAG WholeRayInterior; + B ∈ ray A D ━ {A} ∧ C ∈ ray A E ━ {A} [] by fol equalrays Distinct EndpointInRay IN_DIFF IN_SING; + M ∈ int_angle B A C [] by fol MintEAD - InteriorWellDefined InteriorAngleSymmetry; + fol - BAMeqMAC; + qed; +`;; + +let EuclidPropositionI_6 = theorem `; + ∀A B C. ¬Collinear A B C ∧ ∡ B A C ≡ ∡ B C A ⇒ seg B A ≡ seg B C + + proof + intro_TAC ∀A B C, H1 H2; + ¬(A = C) [] by fol H1 NonCollinearImpliesDistinct; + seg C A ≡ seg A C [CAeqAC] by fol SegmentSymmetry - SEGMENT C2Reflexive; + ¬Collinear B C A ∧ ¬Collinear C B A ∧ ¬Collinear B A C [BCAncol] by fol H1 CollinearSymmetry; + ∡ A C B ≡ ∡ C A B [] by fol - ANGLE H2 C5Symmetric AngleSymmetry; + C,B,A ≅ A,B,C [] by fol H1 BCAncol CAeqAC H2 - ASA; + fol - TriangleCong_DEF; + qed; +`;; + +let IsoscelesExists = theorem `; + ∀A B. ¬(A = B) ⇒ ∃D. ¬Collinear A D B ∧ seg D A ≡ seg D B + + proof + intro_TAC ∀A B, H1; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l [l_line] by fol H1 I1; + consider C such that + C ∉ l [notCl] by fol - ExistsPointOffLine; + ¬Collinear C A B ∧ ¬Collinear C B A ∧ ¬Collinear A B C ∧ ¬Collinear A C B ∧ ¬Collinear B A C [CABncol] by fol l_line H1 I1 Collinear_DEF - ∉; + ∡ C A B ≡ ∡ C B A ∨ ∡ C A B <_ang ∡ C B A ∨ ∡ C B A <_ang ∡ C A B [] by fol - ANGLE AngleTrichotomy; + case_split cong | less | greater by fol -; + suppose ∡ C A B ≡ ∡ C B A; + fol - CABncol EuclidPropositionI_6; + end; + suppose ∡ C A B <_ang ∡ C B A; + ∡ C A B <_ang ∡ A B C [] by fol - AngleSymmetry; + consider E such that + E ∈ int_angle A B C ∧ ∡ C A B ≡ ∡ A B E [Eexists] by fol CABncol ANGLE - AngleOrderingUse; + ¬(B = E) [notBE] by fol - InteriorEZHelp; + consider D such that + D ∈ Open (A, C) ∧ D ∈ ray B E ━ {B} [Dexists] by fol Eexists Crossbar_THM; + D ∈ int_angle A B C [] by fol Eexists - WholeRayInterior; + ¬Collinear A D B [ADBncol] by fol - InteriorEZHelp CollinearSymmetry; + ray B D = ray B E ∧ ray A D = ray A C [] by fol notBE Dexists RayWellDefined IntervalRay; + ∡ D A B ≡ ∡ A B D [] by fol Eexists - Angle_DEF; + fol ADBncol - AngleSymmetry EuclidPropositionI_6; + end; + suppose ∡ C B A <_ang ∡ C A B; + ∡ C B A <_ang ∡ B A C [] by fol - AngleSymmetry; + consider E such that + E ∈ int_angle B A C ∧ ∡ C B A ≡ ∡ B A E [Eexists] by fol CABncol ANGLE - AngleOrderingUse; + ¬(A = E) [notAE] by fol - InteriorEZHelp; + consider D such that + D ∈ Open (B, C) ∧ D ∈ ray A E ━ {A} [Dexists] by fol Eexists Crossbar_THM; + D ∈ int_angle B A C [] by fol Eexists - WholeRayInterior; + ¬Collinear A D B ∧ ¬Collinear D A B ∧ ¬Collinear D B A [ADBncol] by fol - InteriorEZHelp CollinearSymmetry; + ray A D = ray A E ∧ ray B D = ray B C [] by fol notAE Dexists RayWellDefined IntervalRay; + ∡ D B A ≡ ∡ B A D [] by fol Eexists - Angle_DEF; + ∡ D A B ≡ ∡ D B A [] by fol AngleSymmetry ADBncol ANGLE - C5Symmetric; + fol ADBncol - EuclidPropositionI_6; + end; + qed; +`;; + +let MidpointExists = theorem `; + ∀A B. ¬(A = B) ⇒ ∃M. M ∈ Open (A, B) ∧ seg A M ≡ seg M B + + proof + intro_TAC ∀A B, H1; + consider D such that + ¬Collinear A D B ∧ seg D A ≡ seg D B [Dexists] by fol H1 IsoscelesExists; + consider F such that + F ∈ int_angle A D B ∧ ∡ A D F ≡ ∡ F D B [Fexists] by fol - AngleBisector; + ¬(D = F) [notDF] by fol - InteriorEZHelp; + consider M such that + M ∈ Open (A, B) ∧ M ∈ ray D F ━ {D} [Mexists] by fol Fexists Crossbar_THM; + ray D M = ray D F [] by fol notDF - RayWellDefined; + ∡ A D M ≡ ∡ M D B [ADMeqMDB] by fol Fexists - Angle_DEF; + M ∈ int_angle A D B [] by fol Fexists Mexists WholeRayInterior; + ¬(D = M) ∧ ¬Collinear A D M ∧ ¬Collinear B D M [ADMncol] by fol - InteriorEZHelp InteriorAngleSymmetry; + seg D M ≡ seg D M [] by fol - SEGMENT C2Reflexive; + A,D,M ≅ B,D,M [] by fol ADMncol Dexists - ADMeqMDB AngleSymmetry SAS; + fol Mexists - TriangleCong_DEF SegmentSymmetry; + qed; +`;; + +let EuclidPropositionI_7short = theorem `; + ∀A B C D a. ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ⇒ + ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ⇒ seg A C ≡ seg A D + ⇒ ¬(seg B C ≡ seg B D) + + proof + intro_TAC ∀A B C D a, a_line, Csim_aD, ACeqAD; + ¬(A = C) ∧ ¬(A = D) [AnotCD] by fol a_line Csim_aD ∉; + assume seg B C ≡ seg B D [Con] by fol; + seg C B ≡ seg D B ∧ seg A B ≡ seg A B ∧ seg A D ≡ seg A D [segeqs] by fol - SegmentSymmetry a_line AnotCD SEGMENT C2Reflexive; + ¬Collinear A C B ∧ ¬Collinear A D B [] by fol a_line I1 Csim_aD Collinear_DEF ∉; + A,C,B ≅ A,D,B [] by fol - ACeqAD segeqs SSS; + ∡ B A C ≡ ∡ B A D [] by fol - TriangleCong_DEF; + ray A D = ray A C [] by fol a_line Csim_aD - C4Uniqueness; + C ∈ ray A D ━ {A} ∧ D ∈ ray A D ━ {A} [] by fol AnotCD - EndpointInRay IN_DIFF IN_SING; + C = D [] by fol AnotCD SEGMENT - ACeqAD segeqs C1; + fol - Csim_aD; + qed; +`;; + +let EuclidPropositionI_7Help = theorem `; + ∀A B C D a. ¬(A = B) ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ + ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ⇒ seg A C ≡ seg A D ⇒ + C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D + ⇒ ¬(seg B C ≡ seg B D) + + proof + intro_TAC ∀A B C D a, notAB, a_line, Csim_aD, ACeqAD, Int_ConvQuad; + ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) [Distinct] by fol a_line Csim_aD ∉ SameSide_DEF; + case_split convex | CintDAB by fol Int_ConvQuad; + suppose ConvexQuadrilateral A B C D; + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ Tetralateral A B C D [ABint] by fol - ConvexQuad_DEF Quadrilateral_DEF; + ¬Collinear B C D ∧ ¬Collinear D C B ∧ ¬Collinear C B D ∧ ¬Collinear C D A ∧ ¬Collinear D A C ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) [angCDB] by fol - Tetralateral_DEF CollinearSymmetry ANGLE; + ∡ C D A ≡ ∡ D C A [CDAeqDCA] by fol angCDB Distinct SEGMENT ACeqAD C2Symmetric IsoscelesCongBaseAngles; + A ∈ int_angle D C B ∧ ∡ D C A ≡ ∡ D C A ∧ ∡ C D B ≡ ∡ C D B [] by fol ABint InteriorAngleSymmetry angCDB ANGLE C5Reflexive; + ∡ D C A <_ang ∡ D C B ∧ ∡ C D B <_ang ∡ C D A [] by fol angCDB ABint - AngleOrdering_DEF; + ∡ C D B <_ang ∡ D C B [] by fol - angCDB CDAeqDCA AngleTrichotomy2 AngleOrderTransitivity; + ¬(∡ D C B ≡ ∡ C D B) [] by fol - AngleTrichotomy1 angCDB ANGLE C5Symmetric; + fol angCDB - IsoscelesCongBaseAngles; + end; + suppose C ∈ int_triangle D A B; + C ∈ int_angle A D B ∧ C ∈ int_angle D A B [CintADB] by fol - IN_InteriorTriangle InteriorAngleSymmetry; + ¬Collinear A D C ∧ ¬Collinear B D C [ADCncol] by fol CintADB InteriorEZHelp InteriorAngleSymmetry; + ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by fol - CollinearSymmetry; + ¬Collinear B C D ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) ∧ ¬Collinear D C B [angCDB] by fol ADCncol - CollinearSymmetry ANGLE; + ∡ C D A ≡ ∡ D C A [CDAeqDCA] by fol DACncol Distinct ADCncol SEGMENT ACeqAD C2Symmetric IsoscelesCongBaseAngles; + consider E such that + D ∈ Open (A, E) ∧ ¬(D = E) ∧ Collinear A D E [ADE] by fol Distinct B2' B1'; + B ∈ int_angle C D E ∧ Collinear D A E [BintCDE] by fol CintADB - InteriorReflectionInterior CollinearSymmetry; + ¬Collinear C D E [CDEncol] by fol DACncol - ADE NoncollinearityExtendsToLine; + consider F such that + F ∈ Open (B, D) ∧ F ∈ ray A C ━ {A} [Fexists] by fol CintADB Crossbar_THM B1'; + F ∈ int_angle B C D [FintBCD] by fol ADCncol CollinearSymmetry - ConverseCrossbar; + ¬Collinear D C F [DCFncol] by fol Distinct ADCncol CollinearSymmetry Fexists B1' NoncollinearityExtendsToLine; + Collinear A C F ∧ F ∈ ray D B ━ {D} ∧ C ∈ int_angle A D F [] by fol Fexists IN_DIFF IN_SING IN_Ray B1' IntervalRayEZ CintADB InteriorWellDefined; + C ∈ Open (A, F) [] by fol - AlternateConverseCrossbar; + ∡ A D C suppl ∡ C D E ∧ ∡ A C D suppl ∡ D C F [] by fol ADE DACncol - SupplementaryAngles_DEF; + ∡ C D E ≡ ∡ D C F [CDEeqDCF] by fol - CDAeqDCA AngleSymmetry SupplementsCongAnglesCong; + ∡ C D B <_ang ∡ C D E [] by fol angCDB CDEncol BintCDE C5Reflexive AngleOrdering_DEF; + ∡ C D B <_ang ∡ D C F [CDBlessDCF] by fol - DCFncol ANGLE CDEeqDCF AngleTrichotomy2; + ∡ D C F <_ang ∡ D C B [] by fol DCFncol ANGLE angCDB FintBCD InteriorAngleSymmetry C5Reflexive AngleOrdering_DEF; + ∡ C D B <_ang ∡ D C B [] by fol CDBlessDCF - AngleOrderTransitivity; + ¬(∡ D C B ≡ ∡ C D B) [] by fol - AngleTrichotomy1 angCDB CollinearSymmetry ANGLE C5Symmetric; + fol Distinct ADCncol CollinearSymmetry - IsoscelesCongBaseAngles; + end; + qed; +`;; + +let EuclidPropositionI_7 = theorem `; + ∀A B C D a. ¬(A = B) ⇒ Line a ∧ A ∈ a ∧ B ∈ a ⇒ + ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a ⇒ + seg A C ≡ seg A D + ⇒ ¬(seg B C ≡ seg B D) + + proof + intro_TAC ∀A B C D a, notAB, a_line, Csim_aD, ACeqAD; + ¬Collinear A B C ∧ ¬Collinear D A B [ABCncol] by fol a_line notAB Csim_aD NonCollinearRaa CollinearSymmetry; + ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ A ∉ Open (C, D) [Distinct] by fol a_line Csim_aD ∉ SameSide_DEF; + ¬Collinear A D C [ADCncol] + proof + assume Collinear A D C [Con] by fol; + C ∈ ray A D ━ {A} ∧ D ∈ ray A D ━ {A} ∧ seg A D ≡ seg A D [] by fol Distinct - IN_Ray EndpointInRay IN_DIFF IN_SING SEGMENT C2Reflexive; + fol Distinct SEGMENT - ACeqAD C1 Csim_aD; + qed; + D,C same_side a [Dsim_aC] by fol a_line Csim_aD SameSideSymmetric; + seg A D ≡ seg A C ∧ seg B D ≡ seg B D [ADeqAC] by fol Distinct SEGMENT ACeqAD C2Symmetric C2Reflexive; + ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by fol ADCncol CollinearSymmetry; + ¬(seg B D ≡ seg B C) ⇒ ¬(seg B C ≡ seg B D) [BswitchDC] by fol Distinct SEGMENT C2Symmetric; + case_split BDCcol | BDCncol by fol -; + suppose Collinear B D C; + B ∉ Open (C, D) ∧ C ∈ ray B D ━ {B} ∧ D ∈ ray B D ━ {B} [] by fol a_line Csim_aD SameSide_DEF ∉ Distinct - IN_Ray Distinct IN_DIFF IN_SING EndpointInRay; + fol Distinct SEGMENT - ACeqAD ADeqAC C1 Csim_aD; + end; + suppose ¬Collinear B D C; + Tetralateral A B C D [] by fol notAB Distinct Csim_aD ABCncol - CollinearSymmetry DACncol Tetralateral_DEF; + ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B ∨ + ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B [] by fol - a_line Csim_aD FourChoicesTetralateral InteriorTriangleSymmetry; + fol notAB a_line Csim_aD Dsim_aC ACeqAD ADeqAC - EuclidPropositionI_7Help BswitchDC; + end; + qed; +`;; + +let EuclidPropositionI_11 = theorem `; + ∀A B. ¬(A = B) ⇒ ∃F. Right (∡ A B F) + + proof + intro_TAC ∀A B, notAB; + consider C such that + B ∈ Open (A, C) ∧ seg B C ≡ seg B A [ABC] by fol notAB SEGMENT C1OppositeRay; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [Distinct] by fol ABC B1'; + seg B A ≡ seg B C [BAeqBC] by fol - SEGMENT ABC C2Symmetric; + consider F such that + ¬Collinear A F C ∧ seg F A ≡ seg F C [Fexists] by fol Distinct IsoscelesExists; + ¬Collinear B F A ∧ ¬Collinear B F C [BFAncol] by fol - CollinearSymmetry Distinct NoncollinearityExtendsToLine; + ¬Collinear A B F ∧ Angle (∡ A B F) [angABF] by fol BFAncol CollinearSymmetry ANGLE; + ∡ A B F suppl ∡ F B C [ABFsuppl] by fol - ABC SupplementaryAngles_DEF; + ¬(B = F) ∧ seg B F ≡ seg B F [] by fol BFAncol NonCollinearImpliesDistinct SEGMENT C2Reflexive; + B,F,A ≅ B,F,C [] by fol BFAncol - BAeqBC Fexists SSS; + ∡ A B F ≡ ∡ F B C [] by fol - TriangleCong_DEF AngleSymmetry; + fol angABF ABFsuppl - RightAngle_DEF; + qed; +`;; + +let DropPerpendicularToLine = theorem `; + ∀P l. Line l ∧ P ∉ l ⇒ ∃E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) + + proof + intro_TAC ∀P l, l_line; + consider A B such that + A ∈ l ∧ B ∈ l ∧ ¬(A = B) [ABl] by fol l_line I2; + ¬Collinear B A P ∧ ¬Collinear P A B ∧ ¬(A = P) [BAPncol] by fol ABl l_line NonCollinearRaa CollinearSymmetry ∉; + Angle (∡ B A P) ∧ Angle (∡ P A B) [angBAP] by fol - ANGLE AngleSymmetry; + consider P' such that + ¬(A = P') ∧ P' ∉ l ∧ ¬(P,P' same_side l) ∧ seg A P' ≡ seg A P ∧ ∡ B A P' ≡ ∡ B A P [P'exists] by simplify C4OppositeSide - ABl BAPncol l_line; + consider Q such that + Q ∈ l ∧ Q ∈ Open (P, P') ∧ Collinear A B Q [Qexists] by fol l_line - SameSide_DEF ABl Collinear_DEF; + ¬Collinear B A P' [BAP'ncol] by fol l_line ABl I1 Collinear_DEF P'exists ∉; + ∡ B A P ≡ ∡ B A P' [BAPeqBAP'] by fol - ANGLE angBAP P'exists C5Symmetric; + ∃E. E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' [] + proof + assume ¬(A = Q) [notAQ] by fol ABl BAPncol BAPeqBAP' AngleSymmetry; + seg A Q ≡ seg A Q ∧ seg A P ≡ seg A P' [APeqAP'] by fol - SEGMENT C2Reflexive BAPncol P'exists C2Symmetric; + ¬Collinear Q A P' ∧ ¬Collinear Q A P [QAP'ncol] by fol notAQ l_line ABl Qexists P'exists NonCollinearRaa CollinearSymmetry; + ∡ Q A P ≡ ∡ Q A P' [] + proof + case_split QAB | notQAB by fol - ∉; + suppose A ∈ Open (Q, B); + ∡ B A P suppl ∡ P A Q ∧ ∡ B A P' suppl ∡ P' A Q [] by fol BAPncol BAP'ncol - B1' SupplementaryAngles_DEF; + fol - BAPeqBAP' SupplementsCongAnglesCong AngleSymmetry; + end; + suppose A ∉ Open (Q, B); + Q ∈ ray A B ━ {A} [QrayAB_A] by fol ABl Qexists notQAB IN_Ray notAQ IN_DIFF IN_SING; + ray A Q = ray A B [] by fol - ABl RayWellDefined; + fol notAQ QrayAB_A - BAPeqBAP' Angle_DEF; + end; + qed; + Q,A,P ≅ Q,A,P' [] by fol QAP'ncol APeqAP' - SAS; + fol - TriangleCong_DEF AngleSymmetry ABl QAP'ncol CollinearSymmetry; + qed; + consider E such that + E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' [Eexists] by fol -; + ∡ P Q E suppl ∡ E Q P' ∧ Right (∡ P Q E) [] by fol - Qexists SupplementaryAngles_DEF RightAngle_DEF; + fol Eexists Qexists -; + qed; +`;; + +let EuclidPropositionI_14 = theorem `; + ∀A B C D l. Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) ⇒ + C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) ⇒ ∡ C B A suppl ∡ A B D + ⇒ B ∈ Open (C, D) + + proof + intro_TAC ∀A B C D l, l_line, Cnsim_lD, CBAsupplABD; + ¬(B = C) ∧ ¬(B = D) ∧ ¬Collinear C B A [Distinct] by fol l_line Cnsim_lD ∉ I1 Collinear_DEF; + consider E such that + B ∈ Open (C, E) [CBE] by fol Distinct B2'; + E ∉ l ∧ ¬(C,E same_side l) [Csim_lE] by fol l_line ∉ - BetweenLinear Cnsim_lD SameSide_DEF; + D,E same_side l [Dsim_lE] by fol l_line Cnsim_lD - AtMost2Sides; + ∡ C B A suppl ∡ A B E [] by fol Distinct CBE SupplementaryAngles_DEF; + ∡ A B D ≡ ∡ A B E [] by fol CBAsupplABD - SupplementUnique; + ray B E = ray B D [] by fol l_line Csim_lE Cnsim_lD Dsim_lE - C4Uniqueness; + D ∈ ray B E ━ {B} [] by fol Distinct - EndpointInRay IN_DIFF IN_SING; + fol CBE - OppositeRaysIntersect1pointHelp B1'; + qed; +`;; + +(* Euclid's Proposition I.15 *) + +let VerticalAnglesCong = theorem `; + ∀A B O A' B'. ¬Collinear A O B ⇒ O ∈ Open (A, A') ∧ O ∈ Open (B, B') + ⇒ ∡ B O A' ≡ ∡ B' O A + + proof + intro_TAC ∀A B O A' B', H1, H2; + ∡ A O B suppl ∡ B O A' [AOBsupplBOA'] by fol H1 H2 SupplementaryAngles_DEF; + ∡ B O A suppl ∡ A O B' [] by fol H1 CollinearSymmetry H2 SupplementaryAngles_DEF; + fol AOBsupplBOA' - AngleSymmetry SupplementUnique; + qed; +`;; + +let EuclidPropositionI_16 = theorem `; + ∀A B C D. ¬Collinear A B C ∧ C ∈ Open (B, D) + ⇒ ∡ B A C <_ang ∡ D C A + + proof + intro_TAC ∀A B C D, H1 H2; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol Distinct I1; + consider m such that + Line m ∧ B ∈ m ∧ C ∈ m [m_line] by fol Distinct I1; + D ∈ m [Dm] by fol m_line H2 BetweenLinear; + consider E such that + E ∈ Open (A, C) ∧ seg A E ≡ seg E C [AEC] by fol Distinct MidpointExists; + ¬(A = E) ∧ ¬(E = C) ∧ Collinear A E C ∧ ¬(B = E) [AECcol] by fol - B1' H1; + E ∈ l [El] by fol l_line AEC BetweenLinear; + consider F such that + E ∈ Open (B, F) ∧ seg E F ≡ seg E B [BEF] by fol AECcol SEGMENT C1OppositeRay; + ¬(B = E) ∧ ¬(B = F) ∧ ¬(E = F) ∧ Collinear B E F [BEF'] by fol BEF B1'; + B ∉ l [notBl] by fol l_line Distinct I1 Collinear_DEF H1 ∉; + ¬Collinear A E B ∧ ¬Collinear C E B [AEBncol] by fol AECcol l_line El notBl NonCollinearRaa CollinearSymmetry; + Angle (∡ B A E) [angBAE] by fol - CollinearSymmetry ANGLE; + ¬Collinear C E F [CEFncol] by fol AEBncol BEF' CollinearSymmetry NoncollinearityExtendsToLine; + ∡ B E A ≡ ∡ F E C [BEAeqFEC] by fol AEBncol AEC B1' BEF VerticalAnglesCong; + seg E A ≡ seg E C ∧ seg E B ≡ seg E F [] by fol AEC SegmentSymmetry AECcol BEF' SEGMENT BEF C2Symmetric; + A,E,B ≅ C,E,F [] by fol AEBncol CEFncol - BEAeqFEC AngleSymmetry SAS; + ∡ B A E ≡ ∡ F C E [BAEeqFCE] by fol - TriangleCong_DEF; + ¬Collinear E C D [ECDncol] by fol AEBncol H2 B1' CollinearSymmetry NoncollinearityExtendsToLine; + F ∉ l ∧ D ∉ l [notFl] by fol l_line El Collinear_DEF CEFncol - ∉; + F ∈ ray B E ━ {B} ∧ E ∉ m [] by fol BEF IntervalRayEZ m_line Collinear_DEF AEBncol ∉; + F ∉ m ∧ F,E same_side m [Fsim_mE] by fol m_line - RaySameSide; + ¬(B,F same_side l) ∧ ¬(B,D same_side l) [] by fol El l_line BEF H2 SameSide_DEF; + F,D same_side l [] by fol l_line notBl notFl - AtMost2Sides; + F ∈ int_angle E C D [] by fol ECDncol l_line El m_line Dm notFl Fsim_mE - IN_InteriorAngle; + ∡ B A E <_ang ∡ E C D [BAElessECD] by fol angBAE ECDncol - BAEeqFCE AngleSymmetry AngleOrdering_DEF; + ray A E = ray A C ∧ ray C E = ray C A [] by fol AEC B1' IntervalRay; + ∡ B A C <_ang ∡ A C D [] by fol BAElessECD - Angle_DEF; + fol - AngleSymmetry; + qed; +`;; + +let ExteriorAngle = theorem `; + ∀A B C D. ¬Collinear A B C ∧ C ∈ Open (B, D) + ⇒ ∡ A B C <_ang ∡ A C D + + proof + intro_TAC ∀A B C D, H1 H2; + ¬(C = D) ∧ C ∈ Open (D, B) ∧ Collinear B C D [H2'] by fol H2 BetweenLinear B1'; + ¬Collinear B A C ∧ ¬(A = C) [BACncol] by fol H1 CollinearSymmetry NonCollinearImpliesDistinct; + consider E such that + C ∈ Open (A, E) [ACE] by fol - B2'; + ¬(C = E) ∧ C ∈ Open (E, A) ∧ Collinear A C E [ACE'] by fol - B1'; + ¬Collinear A C D ∧ ¬Collinear D C E [DCEncol] by fol H1 CollinearSymmetry H2' - NoncollinearityExtendsToLine; + ∡ A B C <_ang ∡ E C B [ABClessECB] by fol BACncol ACE EuclidPropositionI_16; + ∡ E C B ≡ ∡ A C D [] by fol DCEncol ACE' H2' VerticalAnglesCong; + fol ABClessECB DCEncol ANGLE - AngleTrichotomy2; + qed; +`;; + +let EuclidPropositionI_17 = theorem `; + ∀A B C α β γ. ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A ⇒ + β suppl γ + ⇒ α <_ang γ + + proof + intro_TAC ∀A B C α β γ, H1, H2; + Angle γ [angγ] by fol H2 SupplementImpliesAngle; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; + ¬Collinear B A C ∧ ¬Collinear A C B [BACncol] by fol H1 CollinearSymmetry; + consider D such that + C ∈ Open (A, D) [ACD] by fol Distinct B2'; + ∡ A B C <_ang ∡ D C B [ABClessDCB] by fol BACncol ACD EuclidPropositionI_16; + β suppl ∡ B C D [] by fol - H1 AngleSymmetry BACncol ACD SupplementaryAngles_DEF; + ∡ B C D ≡ γ [] by fol H2 - SupplementUnique; + fol ABClessDCB H1 AngleSymmetry angγ - AngleTrichotomy2; + qed; +`;; + +let EuclidPropositionI_18 = theorem `; + ∀A B C. ¬Collinear A B C ∧ seg A C <__ seg A B + ⇒ ∡ A B C <_ang ∡ B C A + + proof + intro_TAC ∀A B C, H1 H2; + ¬(A = B) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider D such that + D ∈ Open (A, B) ∧ seg A C ≡ seg A D [ADB] by fol Distinct SEGMENT H2 SegmentOrderingUse; + ¬(D = A) ∧ ¬(D = B) ∧ D ∈ Open (B, A) ∧ Collinear A D B ∧ ray B D = ray B A [ADB'] by fol - B1' IntervalRay; + D ∈ int_angle A C B ∧ ¬Collinear A C B [DintACB] by fol H1 CollinearSymmetry ADB ConverseCrossbar; + ¬Collinear D A C ∧ ¬Collinear C B D ∧ ¬Collinear C D A [DACncol] by fol H1 CollinearSymmetry ADB' NoncollinearityExtendsToLine; + seg A D ≡ seg A C [] by fol ADB' Distinct SEGMENT ADB C2Symmetric; + ∡ C D A ≡ ∡ A C D [] by fol DACncol - IsoscelesCongBaseAngles AngleSymmetry; + ∡ C D A <_ang ∡ A C B [CDAlessACB] by fol DACncol ANGLE H1 DintACB - AngleOrdering_DEF; + ∡ B D C suppl ∡ C D A [] by fol DACncol CollinearSymmetry ADB' SupplementaryAngles_DEF; + ∡ C B D <_ang ∡ C D A [] by fol DACncol - EuclidPropositionI_17; + ∡ C B D <_ang ∡ A C B [] by fol - CDAlessACB AngleOrderTransitivity; + fol - ADB' Angle_DEF AngleSymmetry; + qed; +`;; + +let EuclidPropositionI_19 = theorem `; + ∀A B C. ¬Collinear A B C ∧ ∡ A B C <_ang ∡ B C A + ⇒ seg A C <__ seg A B + + proof + intro_TAC ∀A B C, H1 H2; + ¬Collinear B A C ∧ ¬Collinear B C A ∧ ¬Collinear A C B [BACncol] by fol H1 CollinearSymmetry; + ¬(A = B) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; + assume ¬(seg A C <__ seg A B) [Con] by fol; + seg A B ≡ seg A C ∨ seg A B <__ seg A C [] by fol Distinct SEGMENT - SegmentTrichotomy; + case_split cong | less by fol -; + suppose seg A B ≡ seg A C; + ∡ C B A ≡ ∡ B C A [] by fol BACncol - IsoscelesCongBaseAngles; + fol - AngleSymmetry H2 AngleTrichotomy1; + end; + suppose seg A B <__ seg A C; + ∡ A C B <_ang ∡ C B A [] by fol BACncol - EuclidPropositionI_18; + fol H1 BACncol ANGLE - AngleSymmetry H2 AngleTrichotomy; + end; + qed; +`;; + +let EuclidPropositionI_20 = theorem `; + ∀A B C D. ¬Collinear A B C ⇒ A ∈ Open (B, D) ∧ seg A D ≡ seg A C + ⇒ seg B C <__ seg B D + + proof + intro_TAC ∀A B C D, H1, H2; + ¬(B = D) ∧ ¬(A = D) ∧ A ∈ Open (D, B) ∧ Collinear B A D ∧ ray D A = ray D B [BAD'] by fol H2 B1' IntervalRay; + ¬Collinear C A D [CADncol] by fol H1 CollinearSymmetry BAD' NoncollinearityExtendsToLine; + ¬Collinear D C B ∧ ¬Collinear B D C [DCBncol] by fol H1 CollinearSymmetry BAD' NoncollinearityExtendsToLine; + Angle (∡ C D A) [angCDA] by fol CADncol CollinearSymmetry ANGLE; + ∡ C D A ≡ ∡ D C A [CDAeqDCA] by fol CADncol CollinearSymmetry H2 IsoscelesCongBaseAngles; + A ∈ int_angle D C B [] by fol DCBncol BAD' ConverseCrossbar; + ∡ C D A <_ang ∡ D C B [] by fol angCDA DCBncol - CDAeqDCA AngleOrdering_DEF; + ∡ B D C <_ang ∡ D C B [] by fol - BAD' Angle_DEF AngleSymmetry; + fol DCBncol - EuclidPropositionI_19; + qed; +`;; + +let EuclidPropositionI_21 = theorem `; + ∀A B C D. ¬Collinear A B C ∧ D ∈ int_triangle A B C + ⇒ ∡ A B C <_ang ∡ C D A + + proof + intro_TAC ∀A B C D, H1 H2; + ¬(B = A) ∧ ¬(B = C) ∧ ¬(A = C) [Distinct] by fol H1 NonCollinearImpliesDistinct; + D ∈ int_angle B A C ∧ D ∈ int_angle C B A [DintTri] by fol H2 IN_InteriorTriangle InteriorAngleSymmetry; + consider E such that + E ∈ Open (B, C) ∧ E ∈ ray A D ━ {A} [BEC] by fol - Crossbar_THM; + ¬(B = E) ∧ ¬(E = C) ∧ Collinear B E C ∧ Collinear A D E [BEC'] by fol - B1' IN_Ray IN_DIFF IN_SING; + ray B E = ray B C ∧ E ∈ ray B C ━ {B} [rBErBC] by fol BEC IntervalRay IntervalRayEZ; + D ∈ int_angle A B E [DintABE] by fol DintTri - InteriorAngleSymmetry InteriorWellDefined; + D ∈ Open (A, E) [ADE] by fol BEC' - AlternateConverseCrossbar; + ray E D = ray E A [rEDrEA] by fol - B1' IntervalRay; + ¬Collinear A B E ∧ ¬Collinear B E A ∧ ¬Collinear C B D ∧ ¬(A = D) [ABEncol] by fol DintABE IN_InteriorAngle CollinearSymmetry DintTri InteriorEZHelp; + ¬Collinear E D C ∧ ¬Collinear C E D [EDCncol] by fol - CollinearSymmetry BEC' NoncollinearityExtendsToLine; + ∡ A B E <_ang ∡ A E C ∧ ∡ C E D = ∡ D E C [] by fol ABEncol BEC ExteriorAngle AngleSymmetry; + ∡ A B C <_ang ∡ C E D [ABClessAEC] by fol - rBErBC rEDrEA Angle_DEF; + ∡ C E D <_ang ∡ C D A [] by fol EDCncol ADE B1' ExteriorAngle; + fol ABClessAEC - AngleOrderTransitivity; + qed; +`;; + +let AngleTrichotomy3 = theorem `; + ∀α β γ. α <_ang β ∧ Angle γ ∧ γ ≡ α ⇒ γ <_ang β + + proof + intro_TAC ∀α β γ, H1; + consider A O B G such that + Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by fol H1 AngleOrdering_DEF; + ¬Collinear A O G [] by fol - InteriorEZHelp; + γ ≡ ∡ A O G [] by fol H1 H1' - ANGLE C5Transitive; + fol H1 H1' - AngleOrdering_DEF; + qed; +`;; + +let InteriorCircleConvexHelp = theorem `; + ∀O A B C. ¬Collinear A O C ⇒ B ∈ Open (A, C) ⇒ + seg O A <__ seg O C ∨ seg O A ≡ seg O C + ⇒ seg O B <__ seg O C + + proof + intro_TAC ∀O A B C, H1, H2, H3; + ¬Collinear O C A ∧ ¬Collinear C O A ∧ ¬(O = A) ∧ ¬(O = C) [H1'] by fol H1 CollinearSymmetry NonCollinearImpliesDistinct; + ray A B = ray A C ∧ ray C B = ray C A [equal_rays] by fol H2 IntervalRay B1'; + ∡ O C A <_ang ∡ C A O ∨ ∡ O C A ≡ ∡ C A O [] + proof + assume seg O A ≡ seg O C [seg_eq] by fol H3 H1' EuclidPropositionI_18; + seg O C ≡ seg O A [] by fol H1' SEGMENT - C2Symmetric; + fol H1' - IsoscelesCongBaseAngles AngleSymmetry; + qed; + ∡ O C B <_ang ∡ B A O ∨ ∡ O C B ≡ ∡ B A O [] by fol - equal_rays Angle_DEF; + ∡ B C O <_ang ∡ O A B ∨ ∡ B C O ≡ ∡ O A B [BCOlessOAB] by fol - AngleSymmetry; + ¬Collinear O A B ∧ ¬Collinear B C O ∧ ¬Collinear O C B [OABncol] by fol H1 CollinearSymmetry H2 B1' NoncollinearityExtendsToLine; + ∡ O A B <_ang ∡ O B C [] by fol - H2 ExteriorAngle; + ∡ B C O <_ang ∡ O B C [] by fol BCOlessOAB - AngleOrderTransitivity OABncol ANGLE - AngleTrichotomy3; + fol OABncol - AngleSymmetry EuclidPropositionI_19; + qed; +`;; + +let InteriorCircleConvex = theorem `; + ∀O R A B C. ¬(O = R) ⇒ B ∈ Open (A, C) ⇒ + A ∈ int_circle O R ∧ C ∈ int_circle O R + ⇒ B ∈ int_circle O R + + proof + intro_TAC ∀O R A B C, H1, H2, H3; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ Open (C, A) [H2'] by fol H2 B1'; + (A = O ∨ seg O A <__ seg O R) ∧ (C = O ∨ seg O C <__ seg O R) [ACintOR] by fol H3 H1 IN_InteriorCircle; + case_split OAC | OnotAC by fol -; + suppose O = A ∨ O = C; + B ∈ Open (O, C) ∨ B ∈ Open (O, A) [] by fol - H2 B1'; + seg O B <__ seg O A ∧ ¬(O = A) ∨ seg O B <__ seg O C ∧ ¬(O = C) [] by fol - B1' SEGMENT C2Reflexive SegmentOrdering_DEF; + seg O B <__ seg O R [] by fol - ACintOR SegmentOrderTransitivity; + fol - H1 IN_InteriorCircle; + end; + suppose ¬(O = A) ∧ ¬(O = C); + case_split AOCncol | AOCcol by fol -; + suppose ¬Collinear A O C; + seg O A <__ seg O C ∨ seg O A ≡ seg O C ∨ seg O C <__ seg O A [] by fol OnotAC SEGMENT SegmentTrichotomy; + seg O B <__ seg O C ∨ seg O B <__ seg O A [] by fol AOCncol H2 - InteriorCircleConvexHelp CollinearSymmetry B1'; + fol OnotAC ACintOR - SegmentOrderTransitivity H1 IN_InteriorCircle; + end; + suppose Collinear A O C; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol H2' I1; + Collinear B A O ∧ Collinear B C O [OABCcol] by fol - H2 BetweenLinear H2' AOCcol CollinearLinear Collinear_DEF; + B ∉ Open (O, A) ∧ B ∉ Open (O, C) ⇒ B = O [] + proof + intro_TAC Assumption; + O ∈ ray B A ∩ ray B C [] by fol H2' OABCcol - IN_Ray IN_INTER; + fol - H2 OppositeRaysIntersect1point IN_SING; + qed; + B ∈ Open (O, A) ∨ B ∈ Open (O, C) ∨ B = O [] by fol - ∉; + seg O B <__ seg O A ∨ seg O B <__ seg O C ∨ B = O [] by fol - B1' SEGMENT C2Reflexive SegmentOrdering_DEF; + seg O B <__ seg O R ∨ B = O [] by fol - ACintOR OnotAC SegmentOrderTransitivity; + fol - H1 IN_InteriorCircle; + end; + end; + qed; +`;; + +let SegmentTrichotomy3 = theorem `; + ∀s t u. s <__ t ∧ Segment u ∧ u ≡ s ⇒ u <__ t + + proof + intro_TAC ∀s t u, H1; + consider C D X such that + Segment s ∧ t = seg C D ∧ X ∈ Open (C, D) ∧ s ≡ seg C X ∧ ¬(C = X) [H1'] by fol H1 SegmentOrdering_DEF B1'; + u ≡ seg C X [] by fol H1 - SEGMENT C2Transitive; + fol H1 H1' - SegmentOrdering_DEF; + qed; +`;; + +let EuclidPropositionI_24Help = theorem `; + ∀O A C O' D M. ¬Collinear A O C ∧ ¬Collinear D O' M ⇒ + seg O' D ≡ seg O A ∧ seg O' M ≡ seg O C ⇒ ∡ D O' M <_ang ∡ A O C ⇒ + seg O A <__ seg O C ∨ seg O A ≡ seg O C + ⇒ seg D M <__ seg A C + + proof + intro_TAC ∀O A C O' D M, H1, H2, H3, H4; + consider K such that + K ∈ int_angle A O C ∧ ∡ D O' M ≡ ∡ A O K [KintAOC] by fol H1 ANGLE H3 AngleOrderingUse; + ¬(O = C) ∧ ¬(D = M) ∧ ¬(O' = M) ∧ ¬(O = K) [Distinct] by fol H1 NonCollinearImpliesDistinct - InteriorEZHelp; + consider B such that + B ∈ ray O K ━ {O} ∧ seg O B ≡ seg O C [BrOK] by fol Distinct SEGMENT - C1; + ray O B = ray O K [] by fol Distinct - RayWellDefined; + ∡ D O' M ≡ ∡ A O B [DO'MeqAOB] by fol KintAOC - Angle_DEF; + B ∈ int_angle A O C [BintAOC] by fol KintAOC BrOK WholeRayInterior; + ¬(B = O) ∧ ¬Collinear A O B [AOBncol] by fol - InteriorEZHelp; + seg O C ≡ seg O B [OCeqOB] by fol Distinct - SEGMENT BrOK C2Symmetric; + seg O' M ≡ seg O B [] by fol Distinct SEGMENT AOBncol H2 - C2Transitive; + D,O',M ≅ A,O,B [] by fol H1 AOBncol H2 - DO'MeqAOB SAS; + seg D M ≡ seg A B [DMeqAB] by fol - TriangleCong_DEF; + consider G such that + G ∈ Open (A, C) ∧ G ∈ ray O B ━ {O} ∧ ¬(G = O) [AGC] by fol BintAOC Crossbar_THM B1' IN_DIFF IN_SING; + Segment (seg O G) ∧ ¬(O = B) [notOB] by fol - SEGMENT BrOK IN_DIFF IN_SING; + seg O G <__ seg O C [] by fol H1 AGC H4 InteriorCircleConvexHelp; + seg O G <__ seg O B [] by fol - OCeqOB BrOK SEGMENT SegmentTrichotomy2 IN_DIFF IN_SING; + consider G' such that + G' ∈ Open (O, B) ∧ seg O G ≡ seg O G' [OG'B] by fol notOB - SegmentOrderingUse; + ¬(G' = O) ∧ seg O G' ≡ seg O G' ∧ Segment (seg O G') [notG'O] by fol - B1' SEGMENT C2Reflexive SEGMENT; + G' ∈ ray O B ━ {O} [] by fol OG'B IntervalRayEZ; + G' = G ∧ G ∈ Open (B, O) [] by fol notG'O notOB - AGC OG'B C1 B1'; + ConvexQuadrilateral B A O C [] by fol H1 - AGC DiagonalsIntersectImpliesConvexQuad; + A ∈ int_angle O C B ∧ O ∈ int_angle C B A ∧ Quadrilateral B A O C [OintCBA] by fol - ConvexQuad_DEF; + A ∈ int_angle B C O [AintBCO] by fol - InteriorAngleSymmetry; + Tetralateral B A O C [] by fol OintCBA Quadrilateral_DEF; + ¬Collinear C B A ∧ ¬Collinear B C O ∧ ¬Collinear C O B ∧ ¬Collinear C B O [BCOncol] by fol - Tetralateral_DEF CollinearSymmetry; + ∡ B C O ≡ ∡ C B O [BCOeqCBO] by fol - OCeqOB IsoscelesCongBaseAngles; + ¬Collinear B C A ∧ ¬Collinear A C B [ACBncol] by fol AintBCO InteriorEZHelp CollinearSymmetry; + ∡ B C A ≡ ∡ B C A ∧ Angle (∡ B C A) ∧ ∡ C B O ≡ ∡ C B O [CBOref] by fol - ANGLE BCOncol C5Reflexive; + ∡ B C A <_ang ∡ B C O [] by fol - BCOncol ANGLE AintBCO AngleOrdering_DEF; + ∡ B C A <_ang ∡ C B O [BCAlessCBO] by fol - BCOncol ANGLE BCOeqCBO AngleTrichotomy2; + ∡ C B O <_ang ∡ C B A [] by fol BCOncol ANGLE OintCBA CBOref AngleOrdering_DEF; + ∡ A C B <_ang ∡ C B A [] by fol BCAlessCBO - AngleOrderTransitivity AngleSymmetry; + seg A B <__ seg A C [] by fol ACBncol - EuclidPropositionI_19; + fol - Distinct SEGMENT DMeqAB SegmentTrichotomy3; + qed; +`;; + +let EuclidPropositionI_24 = theorem `; + ∀O A C O' D M. ¬Collinear A O C ∧ ¬Collinear D O' M ⇒ + seg O' D ≡ seg O A ∧ seg O' M ≡ seg O C ⇒ ∡ D O' M <_ang ∡ A O C + ⇒ seg D M <__ seg A C + + proof + intro_TAC ∀O A C O' D M, H1, H2, H3; + ¬(O = A) ∧ ¬(O = C) ∧ ¬Collinear C O A ∧ ¬Collinear M O' D [Distinct] by fol H1 NonCollinearImpliesDistinct CollinearSymmetry; + seg O A ≡ seg O C ∨ seg O A <__ seg O C ∨ seg O C <__ seg O A [3pos] by fol - SEGMENT SegmentTrichotomy; + assume seg O C <__ seg O A [H4] by fol 3pos H1 H2 H3 EuclidPropositionI_24Help; + ∡ M O' D <_ang ∡ C O A [] by fol H3 AngleSymmetry; + fol Distinct H3 AngleSymmetry H2 H4 EuclidPropositionI_24Help SegmentSymmetry; + qed; +`;; + +let EuclidPropositionI_25 = theorem `; + ∀O A C O' D M. ¬Collinear A O C ∧ ¬Collinear D O' M ⇒ + seg O' D ≡ seg O A ∧ seg O' M ≡ seg O C ⇒ seg D M <__ seg A C + ⇒ ∡ D O' M <_ang ∡ A O C + + proof + intro_TAC ∀O A C O' D M, H1, H2, H3; + ¬(O = A) ∧ ¬(O = C) ∧ ¬(A = C) ∧ ¬(D = M) ∧ ¬(O' = D) ∧ ¬(O' = M) [Distinct] by fol H1 NonCollinearImpliesDistinct; + assume ¬(∡ D O' M <_ang ∡ A O C) [Contradiction] by fol; + ∡ D O' M ≡ ∡ A O C ∨ ∡ A O C <_ang ∡ D O' M [] by fol H1 ANGLE - AngleTrichotomy; + case_split Cong | Con by fol -; + suppose ∡ D O' M ≡ ∡ A O C; + D,O',M ≅ A,O,C [] by fol H1 H2 - SAS; + seg D M ≡ seg A C [] by fol - TriangleCong_DEF; + fol Distinct SEGMENT - H3 SegmentTrichotomy; + end; + suppose ∡ A O C <_ang ∡ D O' M; + seg O A ≡ seg O' D ∧ seg O C ≡ seg O' M [H2'] by fol Distinct SEGMENT H2 C2Symmetric; + seg A C <__ seg D M [] by fol H1 - Con EuclidPropositionI_24; + fol Distinct SEGMENT - H3 SegmentTrichotomy; + end; + qed; +`;; + +let AAS = theorem `; + ∀A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ⇒ + ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ⇒ seg A B ≡ seg A' B' + ⇒ A,B,C ≅ A',B',C' + + proof + intro_TAC ∀A B C A' B' C', H1, H2, H3; + ¬(A = B) ∧ ¬(B = C) ∧ ¬(B' = C') [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider G such that + G ∈ ray B C ━ {B} ∧ seg B G ≡ seg B' C' [Gexists] by fol Distinct SEGMENT C1; + ¬(G = B) ∧ B ∉ Open (G, C) ∧ Collinear G B C [notGBC] by fol - IN_Ray CollinearSymmetry IN_DIFF IN_SING; + ¬Collinear A B G ∧ ¬Collinear B G A [ABGncol] by fol H1 notGBC CollinearSymmetry NoncollinearityExtendsToLine; + ray B G = ray B C [] by fol Distinct Gexists RayWellDefined; + ∡ A B G = ∡ A B C [] by fol Distinct - Angle_DEF; + A,B,G ≅ A',B',C' [ABG≅A'B'C'] by fol H1 ABGncol H3 SegmentSymmetry H2 - Gexists SAS; + ∡ B G A ≡ ∡ B' C' A' [BGAeqB'C'A'] by fol - TriangleCong_DEF; + ¬Collinear B C A ∧ ¬Collinear B' C' A' [BCAncol] by fol H1 CollinearSymmetry; + ∡ B' C' A' ≡ ∡ B C A ∧ ∡ B C A ≡ ∡ B C A [BCArefl] by fol - ANGLE H2 C5Symmetric C5Reflexive; + ∡ B G A ≡ ∡ B C A [BGAeqBCA] by fol ABGncol BCAncol ANGLE BGAeqB'C'A' - C5Transitive; + assume ¬(G = C) [notGC] by fol BGAeqBCA ABG≅A'B'C'; + ¬Collinear A C G ∧ ¬Collinear A G C [ACGncol] by fol H1 notGBC - CollinearSymmetry NoncollinearityExtendsToLine; + C ∈ Open (B, G) ∨ G ∈ Open (C, B) [] by fol notGBC notGC Distinct B3' ∉; + case_split BCG | CGB by fol -; + suppose C ∈ Open (B, G) ; + C ∈ Open (G, B) ∧ ray G C = ray G B [rGCrBG] by fol - B1' IntervalRay; + ∡ A G C <_ang ∡ A C B [] by fol ACGncol - ExteriorAngle; + ∡ B G A <_ang ∡ B C A [] by fol - rGCrBG Angle_DEF AngleSymmetry AngleSymmetry; + fol ABGncol BCAncol ANGLE - AngleSymmetry BGAeqBCA AngleTrichotomy; + end; + suppose G ∈ Open (C, B); + ray C G = ray C B ∧ ∡ A C G <_ang ∡ A G B [] by fol - IntervalRay ACGncol ExteriorAngle; + ∡ A C B <_ang ∡ B G A [] by fol - Angle_DEF AngleSymmetry; + ∡ B C A <_ang ∡ B C A [] by fol - BCAncol ANGLE BGAeqBCA AngleTrichotomy2 AngleSymmetry; + fol - BCArefl AngleTrichotomy1; + end; + qed; +`;; + +let ParallelSymmetry = theorem `; + ∀l k. l ∥ k ⇒ k ∥ l + by fol PARALLEL INTER_COMM`;; + +let AlternateInteriorAngles = theorem `; + ∀A B C E l m t. Line l ∧ A ∈ l ∧ E ∈ l ⇒ + Line m ∧ B ∈ m ∧ C ∈ m ⇒ Line t ∧ A ∈ t ∧ B ∈ t ⇒ + ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ⇒ + ¬(C,E same_side t) ⇒ ∡ E A B ≡ ∡ C B A + ⇒ l ∥ m + + proof + intro_TAC ∀A B C E l m t, l_line, m_line, t_line, Distinct, Cnsim_tE, AltIntAngCong; + ¬Collinear E A B ∧ ¬Collinear C B A [EABncol] by fol t_line Distinct NonCollinearRaa CollinearSymmetry; + B ∉ l ∧ A ∉ m [notAmBl] by fol l_line m_line Collinear_DEF - ∉; + assume ¬(l ∥ m) [Con] by fol; + ¬(l ∩ m = ∅) [] by fol - l_line m_line PARALLEL; + consider G such that + G ∈ l ∧ G ∈ m [Glm] by fol - MEMBER_NOT_EMPTY IN_INTER; + ¬(G = A) ∧ ¬(G = B) ∧ Collinear B G C ∧ Collinear B C G ∧ Collinear A E G ∧ Collinear A G E [GnotAB] by fol - notAmBl ∉ m_line l_line Collinear_DEF; + ¬Collinear A G B ∧ ¬Collinear B G A ∧ G ∉ t [AGBncol] by fol EABncol CollinearSymmetry - NoncollinearityExtendsToLine t_line Collinear_DEF ∉; + ¬(E,C same_side t) [Ensim_tC] by fol t_line - Distinct Cnsim_tE SameSideSymmetric; + E ∈ l ━ {A} ∧ G ∈ l ━ {A} [] by fol l_line Glm Distinct GnotAB IN_DIFF IN_SING; + ¬(G,E same_side t) [] + proof + assume G,E same_side t [Gsim_tE] by fol; + A ∉ Open (G, E) [notGAE] by fol t_line - SameSide_DEF ∉; + G ∈ ray A E ━ {A} [] by fol Distinct GnotAB notGAE IN_Ray GnotAB IN_DIFF IN_SING; + ray A G = ray A E [rAGrAE] by fol Distinct - RayWellDefined; + ¬(C,G same_side t) [Cnsim_tG] by fol t_line AGBncol Distinct Gsim_tE Cnsim_tE SameSideTransitive; + C ∉ ray B G [notCrBG] by fol - IN_Ray Distinct t_line AGBncol RaySameSide Cnsim_tG IN_DIFF IN_SING ∉; + B ∈ Open (C, G) [] by fol - GnotAB ∉ IN_Ray; + ∡ G A B <_ang ∡ C B A [] by fol AGBncol notCrBG - B1' EuclidPropositionI_16; + ∡ E A B <_ang ∡ C B A [] by fol - rAGrAE Angle_DEF; + fol EABncol ANGLE AltIntAngCong - AngleTrichotomy1; + qed; + G,C same_side t [Gsim_tC] by fol t_line AGBncol Distinct - Cnsim_tE AtMost2Sides; + B ∉ Open (G, C) [notGBC] by fol t_line - SameSide_DEF ∉; + G ∈ ray B C ━ {B} [] by fol Distinct GnotAB notGBC IN_Ray GnotAB IN_DIFF IN_SING; + ray B G = ray B C [rBGrBC] by fol Distinct - RayWellDefined; + ∡ C B A ≡ ∡ E A B [flipAltIntAngCong] by fol EABncol ANGLE AltIntAngCong C5Symmetric; + ¬(E,G same_side t) [Ensim_tG] by fol t_line AGBncol Distinct Gsim_tC Ensim_tC SameSideTransitive; + E ∉ ray A G [notErAG] by fol - IN_Ray Distinct t_line AGBncol RaySameSide Ensim_tG IN_DIFF IN_SING ∉; + A ∈ Open (E, G) [] by fol - GnotAB ∉ IN_Ray; + ∡ G B A <_ang ∡ E A B [] by fol AGBncol notErAG - B1' EuclidPropositionI_16; + ∡ C B A <_ang ∡ E A B [] by fol - rBGrBC Angle_DEF; + fol EABncol ANGLE flipAltIntAngCong - AngleTrichotomy1; + qed; +`;; + +let EuclidPropositionI_28 = theorem `; + ∀A B C D E F G H l m t. Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l ⇒ + Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m ⇒ + Line t ∧ G ∈ t ∧ H ∈ t ⇒ + G ∉ m ∧ H ∉ l ⇒ + G ∈ Open (A, B) ∧ H ∈ Open (C, D) ⇒ + G ∈ Open (E, H) ∧ H ∈ Open (F, G) ⇒ + ¬(D,A same_side t) ⇒ + ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D + ⇒ l ∥ m + + proof + intro_TAC ∀A B C D E F G H l m t, l_line, m_line, t_line, notGmHl, H1, H2, H3, H4; + ¬(A = G) ∧ ¬(G = B) ∧ ¬(H = D) ∧ ¬(E = G) ∧ ¬(G = H) ∧ Collinear A G B ∧ Collinear E G H [Distinct] by fol H1 H2 B1'; + ¬Collinear H G A ∧ ¬Collinear G H D ∧ A ∉ t ∧ D ∉ t [HGAncol] by fol Distinct l_line m_line notGmHl NonCollinearRaa CollinearSymmetry Collinear_DEF t_line ∉; + ¬Collinear B G H ∧ ¬Collinear A G E ∧ ¬Collinear E G B [BGHncol] by fol - Distinct CollinearSymmetry NoncollinearityExtendsToLine; + ∡ A G H ≡ ∡ D H G [] + proof + case_split EGBeqGHD | BGHeqGHD by fol H4; + suppose ∡ E G B ≡ ∡ G H D; + ∡ E G B ≡ ∡ H G A ∧ + Angle (∡ E G B) ∧ Angle (∡ H G A) ∧ Angle (∡ G H D) [boo] by fol BGHncol H1 H2 VerticalAnglesCong HGAncol ANGLE; + ∡ H G A ≡ ∡ E G B [] by fol - C5Symmetric; + ∡ H G A ≡ ∡ G H D [] by fol boo - EGBeqGHD C5Transitive; + fol - AngleSymmetry; + end; + suppose ∡ B G H suppl ∡ G H D; + ∡ B G H suppl ∡ H G A [] by fol BGHncol H1 B1' SupplementaryAngles_DEF; + fol - BGHeqGHD AngleSymmetry SupplementUnique AngleSymmetry; + end; + qed; + fol l_line m_line t_line Distinct HGAncol H3 - AlternateInteriorAngles; + qed; +`;; + +let OppositeSidesCongImpliesParallelogram = theorem `; + ∀A B C D. Quadrilateral A B C D ⇒ + seg A B ≡ seg C D ∧ seg B C ≡ seg D A + ⇒ Parallelogram A B C D + + proof + intro_TAC ∀A B C D, H1, H2; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; + consider a c such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by fol TetraABCD I1; + consider b d such that + Line b ∧ B ∈ b ∧ C ∈ b ∧ + Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by fol TetraABCD I1; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol TetraABCD I1; + consider m such that + Line m ∧ B ∈ m ∧ D ∈ m [m_line] by fol TetraABCD I1; + B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m [notBDlACm] by fol l_line m_line TetraABCD Collinear_DEF ∉; + seg A C ≡ seg C A ∧ seg B D ≡ seg D B [seg_refl] by fol TetraABCD SEGMENT C2Reflexive SegmentSymmetry; + A,B,C ≅ C,D,A [] by fol TetraABCD H2 - SSS; + ∡ B C A ≡ ∡ D A C ∧ ∡ C A B ≡ ∡ A C D [BCAeqDAC] by fol - TriangleCong_DEF; + seg C D ≡ seg A B [CDeqAB] by fol TetraABCD SEGMENT H2 C2Symmetric; + B,C,D ≅ D,A,B [] by fol TetraABCD H2 - seg_refl SSS; + ∡ C D B ≡ ∡ A B D ∧ ∡ D B C ≡ ∡ B D A ∧ ∡ C B D ≡ ∡ A D B [CDBeqABD] by fol - TriangleCong_DEF AngleSymmetry; + ¬(B,D same_side l) ∨ ¬(A,C same_side m) [] by fol H1 l_line m_line FiveChoicesQuadrilateral; + case_split Case1 | Ansim_mC by fol -; + suppose ¬(B,D same_side l); + ¬(D,B same_side l) [] by fol l_line notBDlACm - SameSideSymmetric; + a ∥ c ∧ b ∥ d [] by fol ac_line l_line TetraABCD notBDlACm - BCAeqDAC AngleSymmetry AlternateInteriorAngles bd_line BCAeqDAC; + fol H1 ac_line bd_line - Parallelogram_DEF; + end; + suppose ¬(A,C same_side m); + b ∥ d [b∥d] by fol bd_line m_line TetraABCD notBDlACm - CDBeqABD AlternateInteriorAngles; + c ∥ a [] by fol ac_line m_line TetraABCD notBDlACm Ansim_mC CDBeqABD AlternateInteriorAngles; + fol H1 ac_line bd_line b∥d - ParallelSymmetry Parallelogram_DEF; + end; + qed; +`;; + +let OppositeAnglesCongImpliesParallelogramHelp = theorem `; + ∀A B C D a c. Quadrilateral A B C D ⇒ + ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ⇒ + Line a ∧ A ∈ a ∧ B ∈ a ⇒ Line c ∧ C ∈ c ∧ D ∈ c + ⇒ a ∥ c + + proof + intro_TAC ∀A B C D a c, H1, H2, a_line, c_line; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; + ∡ C D A ≡ ∡ A B C ∧ ∡ B C D ≡ ∡ D A B [H2'] by fol TetraABCD ANGLE H2 C5Symmetric; + consider l m such that + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by fol TetraABCD I1; + consider b d such that + Line b ∧ B ∈ b ∧ C ∈ b ∧ Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by fol TetraABCD I1; + A ∉ c ∧ B ∉ c ∧ A ∉ b ∧ D ∉ b ∧ B ∉ d ∧ C ∉ d [point_off_line] by fol c_line bd_line Collinear_DEF TetraABCD ∉; + ¬(A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ + C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) [] + proof + assume A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ + C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C [Con] by fol; + ∡ B C D <_ang ∡ D A B ∨ ∡ C D A <_ang ∡ A B C ∨ + ∡ D A B <_ang ∡ B C D ∨ ∡ A B C <_ang ∡ C D A [] by fol TetraABCD - EuclidPropositionI_21; + fol - H2' H2 AngleTrichotomy1; + qed; + ConvexQuadrilateral A B C D [] by fol H1 lm_line - FiveChoicesQuadrilateral; + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ + C ∈ int_angle D A B ∧ D ∈ int_angle A B C [AintBCD] by fol - ConvexQuad_DEF; + B,A same_side c ∧ B,C same_side d [Bsim_cA] by fol c_line bd_line - InteriorUse; + A,D same_side b [Asim_bD] by fol bd_line c_line AintBCD InteriorUse; + assume ¬(a ∥ c) [Con] by fol; + consider G such that + G ∈ a ∧ G ∈ c [Gac] by fol - a_line c_line PARALLEL MEMBER_NOT_EMPTY IN_INTER; + Collinear A B G ∧ Collinear D G C ∧ Collinear C G D [ABGcol] by fol a_line - Collinear_DEF c_line; + ¬(G = A) ∧ ¬(G = B) ∧ ¬(G = C) ∧ ¬(G = D) [GnotABCD] by fol Gac ABGcol TetraABCD CollinearSymmetry Collinear_DEF; + ¬Collinear B G C ∧ ¬Collinear A D G [BGCncol] by fol c_line Gac GnotABCD point_off_line NonCollinearRaa CollinearSymmetry; + ¬Collinear B C G ∧ ¬Collinear G B C ∧ ¬Collinear G A D ∧ ¬Collinear A G D [BCGncol] by fol - CollinearSymmetry; + G ∉ b ∧ G ∉ d [notGb] by fol bd_line Collinear_DEF BGCncol ∉; + G ∉ Open (B, A) [notBGA] by fol Bsim_cA Gac SameSide_DEF ∉; + B ∉ Open (A, G) [notABG] + proof + assume ¬(B ∉ Open (A, G)) [Con] by fol; + B ∈ Open (A, G) [ABG] by fol - ∉; + ray A B = ray A G [rABrAG] by fol - IntervalRay; + ¬(A,G same_side b) [] by fol bd_line ABG SameSide_DEF; + ¬(D,G same_side b) [] by fol bd_line point_off_line notGb Asim_bD - SameSideTransitive; + D ∉ ray C G [] by fol bd_line notGb - RaySameSide TetraABCD IN_DIFF IN_SING ∉; + C ∈ Open (D, G) [DCG] by fol GnotABCD ABGcol - IN_Ray ∉; + consider M such that + D ∈ Open (C, M) [CDM] by fol TetraABCD B2'; + D ∈ Open (G, M) [GDM] by fol - B1' DCG TransitivityBetweennessHelp; + ∡ C D A suppl ∡ A D M ∧ ∡ A B C suppl ∡ C B G [] by fol TetraABCD CDM ABG SupplementaryAngles_DEF; + ∡ M D A ≡ ∡ G B C [MDAeqGBC] by fol - H2' SupplementsCongAnglesCong AngleSymmetry; + ∡ G A D <_ang ∡ M D A ∧ ∡ G B C <_ang ∡ D C B [] by fol BCGncol BGCncol GDM DCG B1' EuclidPropositionI_16; + ∡ G A D <_ang ∡ D C B [] by fol - BCGncol ANGLE MDAeqGBC AngleTrichotomy2 AngleOrderTransitivity; + ∡ D A B <_ang ∡ B C D [] by fol - rABrAG Angle_DEF AngleSymmetry; + fol - H2 AngleTrichotomy1; + qed; + A ∉ Open (G, B) [] + proof + assume ¬(A ∉ Open (G, B)) [Con] by fol; + A ∈ Open (B, G) [BAG] by fol - B1' ∉; + ray B A = ray B G [rBArBG] by fol - IntervalRay; + ¬(B,G same_side d) [] by fol bd_line BAG SameSide_DEF; + ¬(C,G same_side d) [] by fol bd_line point_off_line notGb Bsim_cA - SameSideTransitive; + C ∉ ray D G [] by fol bd_line notGb - RaySameSide TetraABCD IN_DIFF IN_SING ∉; + D ∈ Open (C, G) [CDG] by fol GnotABCD ABGcol - IN_Ray ∉; + consider M such that + C ∈ Open (D, M) [DCM] by fol B2' TetraABCD; + C ∈ Open (G, M) [GCM] by fol - B1' CDG TransitivityBetweennessHelp; + ∡ B C D suppl ∡ M C B ∧ ∡ D A B suppl ∡ G A D [] by fol TetraABCD CollinearSymmetry DCM BAG SupplementaryAngles_DEF AngleSymmetry; + ∡ M C B ≡ ∡ G A D [GADeqMCB] by fol - H2' SupplementsCongAnglesCong; + ∡ G B C <_ang ∡ M C B ∧ ∡ G A D <_ang ∡ C D A [] by fol BGCncol GCM BCGncol CDG B1' EuclidPropositionI_16; + ∡ G B C <_ang ∡ C D A [] by fol - BCGncol ANGLE GADeqMCB AngleTrichotomy2 AngleOrderTransitivity; + ∡ A B C <_ang ∡ C D A [] by fol - rBArBG Angle_DEF; + fol - H2 AngleTrichotomy1; + qed; + fol TetraABCD GnotABCD ABGcol notABG notBGA - B3' ∉; + qed; +`;; + +let OppositeAnglesCongImpliesParallelogram = theorem `; + ∀A B C D. Quadrilateral A B C D ⇒ + ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D + ⇒ Parallelogram A B C D + + proof + intro_TAC ∀A B C D, H1, H2; + Quadrilateral B C D A [QuadBCDA] by fol H1 QuadrilateralSymmetry; + ¬(A = B) ∧ ¬(B = C) ∧ ¬(C = D) ∧ ¬(D = A) ∧ ¬Collinear B C D ∧ ¬Collinear D A B [TetraABCD] by fol H1 Quadrilateral_DEF Tetralateral_DEF; + ∡ B C D ≡ ∡ D A B [H2'] by fol TetraABCD ANGLE H2 C5Symmetric; + consider a such that + Line a ∧ A ∈ a ∧ B ∈ a [a_line] by fol TetraABCD I1; + consider b such that + Line b ∧ B ∈ b ∧ C ∈ b [b_line] by fol TetraABCD I1; + consider c such that + Line c ∧ C ∈ c ∧ D ∈ c [c_line] by fol TetraABCD I1; + consider d such that + Line d ∧ D ∈ d ∧ A ∈ d [d_line] by fol TetraABCD I1; + fol H1 QuadBCDA H2 H2' a_line b_line c_line d_line OppositeAnglesCongImpliesParallelogramHelp Parallelogram_DEF; + qed; +`;; + +let P = NewAxiom + `;∀P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l`;; + +NewConstant("μ",`:(point->bool)->real`);; + +let AMa = NewAxiom + `;∀α. Angle α ⇒ &0 < μ α ∧ μ α < &180`;; + +let AMb = NewAxiom + `;∀α. Right α ⇒ μ α = &90`;; + +let AMc = NewAxiom + `;∀α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β`;; + +let AMd = NewAxiom + `;∀A O B P. P ∈ int_angle A O B ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B)`;; + +let ConverseAlternateInteriorAngles = theorem `; + ∀A B C E l m. Line l ∧ A ∈ l ∧ E ∈ l ⇒ + Line m ∧ B ∈ m ∧ C ∈ m ⇒ Line t ∧ A ∈ t ∧ B ∈ t ⇒ + ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ⇒ + ¬(C,E same_side t) ⇒ l ∥ m + ⇒ ∡ E A B ≡ ∡ C B A + + proof + intro_TAC ∀A B C E l m, l_line, m_line, t_line, Distinct, Cnsim_tE, para_lm; + ¬Collinear C B A [] by fol Distinct t_line NonCollinearRaa CollinearSymmetry; + A ∉ m ∧ Angle (∡ C B A) [notAm] by fol m_line - Collinear_DEF ∉ ANGLE; + consider D such that + ¬(A = D) ∧ D ∉ t ∧ ¬(C,D same_side t) ∧ seg A D ≡ seg A E ∧ ∡ B A D ≡ ∡ C B A [Dexists] by simplify C4OppositeSide - Distinct t_line; + consider k such that + Line k ∧ A ∈ k ∧ D ∈ k [k_line] by fol Distinct I1; + k ∥ m [] by fol - m_line t_line Dexists Distinct AngleSymmetry AlternateInteriorAngles; + k = l [] by fol m_line notAm l_line k_line - para_lm P; + D,E same_side t ∧ A ∉ Open (D, E) ∧ Collinear A E D [] by fol t_line Distinct Dexists Cnsim_tE AtMost2Sides SameSide_DEF ∉ - k_line l_line Collinear_DEF; + ray A D = ray A E [] by fol Distinct - IN_Ray Dexists RayWellDefined IN_DIFF IN_SING; + fol - Dexists AngleSymmetry Angle_DEF; + qed; +`;; + +let HilbertTriangleSum = theorem `; + ∀A B C. ¬Collinear A B C + ⇒ ∃E F. B ∈ Open (E, F) ∧ C ∈ int_angle A B F ∧ + ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A + + proof + intro_TAC ∀A B C, ABCncol; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear C A B [Distinct] by fol ABCncol NonCollinearImpliesDistinct CollinearSymmetry; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by fol Distinct I1; + consider x such that + Line x ∧ A ∈ x ∧ B ∈ x [x_line] by fol Distinct I1; + consider y such that + Line y ∧ B ∈ y ∧ C ∈ y [y_line] by fol Distinct I1; + C ∉ x [notCx] by fol x_line ABCncol Collinear_DEF ∉; + Angle (∡ C A B) [] by fol ABCncol CollinearSymmetry ANGLE; + consider E such that + ¬(B = E) ∧ E ∉ x ∧ ¬(C,E same_side x) ∧ seg B E ≡ seg A B ∧ ∡ A B E ≡ ∡ C A B [Eexists] by simplify C4OppositeSide - Distinct x_line notCx; + consider m such that + Line m ∧ B ∈ m ∧ E ∈ m [m_line] by fol - I1; + ∡ E B A ≡ ∡ C A B [EBAeqCAB] by fol Eexists AngleSymmetry; + m ∥ l [para_lm] by fol m_line l_line x_line Eexists Distinct notCx - AlternateInteriorAngles; + m ∩ l = ∅ [ml0] by fol - PARALLEL; + C ∉ m ∧ A ∉ m [notACm] by fol - l_line INTER_COMM DisjointOneNotOther; + consider F such that + B ∈ Open (E, F) [EBF] by fol Eexists B2'; + ¬(B = F) ∧ F ∈ m [EBF'] by fol - B1' m_line BetweenLinear; + ¬Collinear A B F ∧ F ∉ x [ABFncol] by fol EBF' m_line notACm NonCollinearRaa CollinearSymmetry Collinear_DEF x_line ∉; + ¬(E,F same_side x) ∧ ¬(E,F same_side y) [Ensim_yF] by fol EBF x_line y_line SameSide_DEF; + C,F same_side x [Csim_xF] by fol x_line notCx Eexists ABFncol Eexists - AtMost2Sides; + C,A same_side m [] by fol m_line l_line ml0 DisjointLinesImplySameSide; + C ∈ int_angle A B F [CintABF] by fol ABFncol x_line m_line EBF' notCx notACm Csim_xF - IN_InteriorAngle; + A ∈ int_angle C B E [] by fol EBF B1' - InteriorAngleSymmetry InteriorReflectionInterior; + A ∉ y ∧ A,E same_side y [Asim_yE] by fol y_line m_line - InteriorUse; + E ∉ y ∧ F ∉ y [notEFy] by fol y_line m_line EBF' Eexists EBF' I1 Collinear_DEF notACm ∉; + E,A same_side y [] by fol y_line - Asim_yE SameSideSymmetric; + ¬(A,F same_side y) [Ansim_yF] by fol y_line notEFy Asim_yE - Ensim_yF SameSideTransitive; + ∡ F B C ≡ ∡ A C B [] by fol m_line EBF' l_line y_line EBF' Distinct notEFy Asim_yE Ansim_yF para_lm ConverseAlternateInteriorAngles; + fol EBF CintABF EBAeqCAB - AngleSymmetry; + qed; +`;; + +let EuclidPropositionI_13 = theorem `; + ∀A O B A'. ¬Collinear A O B ∧ O ∈ Open (A, A') + ⇒ μ (∡ A O B) + μ (∡ B O A') = &180 + + proof + intro_TAC ∀A O B A', H1 H2; + case_split RightAOB | notRightAOB by fol -; + suppose Right (∡ A O B); + Right (∡ B O A') ∧ μ (∡ A O B) = &90 ∧ μ (∡ B O A') = &90 [] by fol H1 H2 - RightImpliesSupplRight AMb; + real_arithmetic -; + end; + suppose ¬Right (∡ A O B); + ¬(A = O) ∧ ¬(O = B) [Distinct] by fol H1 NonCollinearImpliesDistinct; + consider l such that + Line l ∧ O ∈ l ∧ A ∈ l ∧ A' ∈ l [l_line] by fol - I1 H2 BetweenLinear; + B ∉ l [notBl] by fol - Distinct I1 Collinear_DEF H1 ∉; + consider F such that + Right (∡ O A F) ∧ Angle (∡ O A F) [RightOAF] by fol Distinct EuclidPropositionI_11 RightImpliesAngle; + ∃! r. Ray r ∧ ∃E. ¬(O = E) ∧ r = ray O E ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F [] by simplify C4 - Distinct l_line notBl; + consider E such that + ¬(O = E) ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F [Eexists] by fol -; + ¬Collinear A O E [AOEncol] by fol Distinct l_line - NonCollinearRaa CollinearSymmetry; + Right (∡ A O E) [RightAOE] by fol - ANGLE RightOAF Eexists CongRightImpliesRight; + Right (∡ E O A') ∧ μ (∡ A O E) = &90 ∧ μ (∡ E O A') = &90 [RightEOA'] by fol AOEncol H2 - RightImpliesSupplRight AMb; + ¬(∡ A O B ≡ ∡ A O E) [] by fol notRightAOB H1 ANGLE RightAOE CongRightImpliesRight; + ¬(∡ A O B = ∡ A O E) [] by fol H1 AOEncol ANGLE - C5Reflexive; + ¬(ray O B = ray O E) [] by fol - Angle_DEF; + B ∉ ray O E ∧ O ∉ Open (B, E) [] by fol Distinct - Eexists RayWellDefined IN_DIFF IN_SING ∉ l_line B1' SameSide_DEF; + ¬Collinear O E B [] by fol - Eexists IN_Ray ∉; + E ∈ int_angle A O B ∨ B ∈ int_angle A O E [] by fol Distinct l_line Eexists notBl AngleOrdering - CollinearSymmetry InteriorAngleSymmetry; + case_split EintAOB | BintAOE by fol -; + suppose E ∈ int_angle A O B; + B ∈ int_angle E O A' [] by fol H2 - InteriorReflectionInterior; + μ (∡ A O B) = μ (∡ A O E) + μ (∡ E O B) ∧ + μ (∡ E O A') = μ (∡ E O B) + μ (∡ B O A') [] by fol EintAOB - AMd; + real_arithmetic - RightEOA'; + end; + suppose B ∈ int_angle A O E; + E ∈ int_angle B O A' [] by fol H2 - InteriorReflectionInterior; + μ (∡ A O E) = μ (∡ A O B) + μ (∡ B O E) ∧ + μ (∡ B O A') = μ (∡ B O E) + μ (∡ E O A') [] by fol BintAOE - AMd; + real_arithmetic - RightEOA'; + end; + end; + qed; +`;; + +let TriangleSum = theorem `; + ∀A B C. ¬Collinear A B C + ⇒ μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 + + proof + intro_TAC ∀A B C, ABCncol; + ¬Collinear C A B ∧ ¬Collinear B C A [CABncol] by fol ABCncol CollinearSymmetry; + consider E F such that + B ∈ Open (E, F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A [EBF] by fol ABCncol HilbertTriangleSum; + ¬Collinear C B F ∧ ¬Collinear A B F ∧ Collinear E B F ∧ ¬(B = E) [CBFncol] by fol - InteriorAngleSymmetry InteriorEZHelp IN_InteriorAngle B1' CollinearSymmetry; + ¬Collinear E B A [EBAncol] by fol CollinearSymmetry - NoncollinearityExtendsToLine; + μ (∡ A B F) = μ (∡ A B C) + μ (∡ C B F) [μCintABF] by fol EBF AMd; + μ (∡ E B A) + μ (∡ A B F) = &180 [suppl180] by fol EBAncol EBF EuclidPropositionI_13; + μ (∡ C A B) = μ (∡ E B A) ∧ μ (∡ B C A) = μ (∡ C B F) [] by fol CABncol EBAncol CBFncol ANGLE EBF AMc; + real_arithmetic suppl180 μCintABF -; + qed; +`;; + +let CircleConvex2_THM = theorem `; + ∀O A B C. ¬Collinear A O B ⇒ B ∈ Open (A, C) ⇒ + seg O A <__ seg O B ∨ seg O A ≡ seg O B + ⇒ seg O B <__ seg O C + + proof + intro_TAC ∀O A B C, H1, H2, H3; + ¬Collinear O B A ∧ ¬Collinear B O A ∧ ¬Collinear O A B ∧ ¬(O = A) ∧ ¬(O = B) [H1'] by fol H1 CollinearSymmetry NonCollinearImpliesDistinct; + B ∈ Open (C, A) ∧ ¬(C = A) ∧ ¬(C = B) ∧ Collinear A B C ∧ Collinear B A C [H2'] by fol H2 B1' CollinearSymmetry; + ¬Collinear O B C ∧ ¬Collinear O C B [OBCncol] by fol H1' - NoncollinearityExtendsToLine CollinearSymmetry; + ¬Collinear O A C [OABncol] by fol H1' H2' NoncollinearityExtendsToLine; + ∡ O C B <_ang ∡ O B A [OCBlessOBA] by fol OBCncol H2' ExteriorAngle; + ∡ O A B <_ang ∡ O B C [OABlessOBC] by fol H1' H2 ExteriorAngle; + ∡ O B A <_ang ∡ B A O ∨ ∡ O B A ≡ ∡ B A O [] + proof + assume seg O A ≡ seg O B [Cong] by fol H3 H1' EuclidPropositionI_18; + seg O B ≡ seg O A [] by fol H1' SEGMENT - C2Symmetric; + fol H1' - IsoscelesCongBaseAngles AngleSymmetry; + qed; + ∡ O B A <_ang ∡ O A B ∨ ∡ O B A ≡ ∡ O A B [OBAlessOAB] by fol - AngleSymmetry; + ∡ O C B <_ang ∡ O B C [] by fol OCBlessOBA - OABlessOBC OBCncol H1' OABncol OBCncol ANGLE - AngleOrderTransitivity AngleTrichotomy2; + fol OBCncol - AngleSymmetry EuclidPropositionI_19; + qed; +`;; diff --git a/RichterHilbertAxiomGeometry/Topology.ml b/RichterHilbertAxiomGeometry/Topology.ml new file mode 100644 index 0000000..33106bd --- /dev/null +++ b/RichterHilbertAxiomGeometry/Topology.ml @@ -0,0 +1,3538 @@ +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* An ongoing readable.ml port of Multivariate/topology.ml with 3 features: *) +(* 1) A topological space will be an ordered pair α = (X, L), where L is the *) +(* the set of open sets on X. topology.ml defines a topological space to be *) +(* just L, and the topspace X is defined as UNIONS L. *) +(* 2) Result about Connectiveness, limit points, interior and closure are *) +(* first proved for general topological spaces and then specialized to *) +(* Euclidean space. *) +(* 3)All general topology theorems using subtopology α u have antecedent *) +(* u ⊂ topspace α. *) +(* The math character ━ is used for DIFF. *) +(* This file, together with from_topology.ml, shows that all of *) +(* Multivariate/topology.ml is either ported/modified here, or else run on *) +(* top of this file. *) +(* Thanks to Vince Aravantinos for improving the proofs of OPEN_BALL, *) +(* CONNECTED_OPEN_IN_EQ, CONNECTED_CLOSED_IN_EQ and INTERIOR_EQ. *) + +needs "RichterHilbertAxiomGeometry/readable.ml";; +needs "Multivariate/determinants.ml";; + +ParseAsInfix("∉",(11, "right"));; + +let NOTIN = NewDefinition `; + ∀a l. a ∉ l ⇔ ¬(a ∈ l)`;; + +let DIFF_UNION = theorem `; + ∀u s t. u ━ (s ∪ t) = (u ━ s) ∩ (u ━ t) + by set`;; + +let DIFF_INTER = theorem `; + ∀u s t. u ━ (s ∩ t) = (u ━ s) ∪ (u ━ t) + by set`;; + +let DIFF_REFL = theorem `; + ∀u t. t ⊂ u ⇒ u ━ (u ━ t) = t + by set`;; + +let DIFF_SUBSET = theorem `; + ∀u s t. s ⊂ t ⇒ s ━ u ⊂ t ━ u + by set`;; + +let DOUBLE_DIFF_UNION = theorem `; + ∀A s t. A ━ s ━ t = A ━ (s ∪ t) + by set`;; + +let SUBSET_COMPLEMENT = theorem `; + ∀s t A. s ⊂ A ⇒ (s ⊂ A ━ t ⇔ s ∩ t = ∅) + by set`;; + +let COMPLEMENT_DISJOINT = theorem `; + ∀A s t. s ⊂ A ⇒ (s ⊂ t ⇔ s ∩ (A ━ t) = ∅) + by set`;; + +let COMPLEMENT_DUALITY = theorem `; + ∀A s t. s ⊂ A ∧ t ⊂ A ⇒ (s = t ⇔ A ━ s = A ━ t) + by set`;; + +let COMPLEMENT_DUALITY_UNION = theorem `; + ∀A s t. s ⊂ A ∧ t ⊂ A ∧ u ⊂ A ⇒ (s = t ∪ u ⇔ A ━ s = (A ━ t) ∩ (A ━ u)) + by set`;; + +let SUBSET_DUALITY = theorem `; + ∀s t u. t ⊂ u ⇒ s ━ u ⊂ s ━ t + by set`;; + +let COMPLEMENT_INTER_DIFF = theorem `; + ∀A s t. s ⊂ A ⇒ s ━ t = s ∩ (A ━ t) + by set`;; + +let INTERS_SUBSET = theorem `; + ∀f t. ¬(f = ∅) ∧ (∀s. s ∈ f ⇒ s ⊂ t) ⇒ INTERS f ⊂ t + by set`;; + +let IN_SET_FUNCTION_PREDICATE = theorem `; + ∀x f P. x ∈ {f y | P y} ⇔ ∃y. x = f y ∧ P y + by set`;; + +let INTER_TENSOR = theorem `; + ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∩ t ⊂ s' ∩ t' + by set`;; + +let UNION_TENSOR = theorem `; + ∀s s' t t'. s ⊂ s' ∧ t ⊂ t' ⇒ s ∪ t ⊂ s' ∪ t' + by set`;; + +let ExistsTensorInter = theorem `; + ∀F G H. (∀x y. F x ∧ G y ⇒ H (x ∩ y)) ⇒ + (∃x. F x) ∧ (∃y. G y) ⇒ (∃z. H z) + by fol`;; + +let istopology = NewDefinition `; + istopology (X, L) ⇔ + (∀U. U ∈ L ⇒ U ⊂ X) ∧ ∅ ∈ L ∧ X ∈ L ∧ + (∀s t. s ∈ L ∧ t ∈ L ⇒ s ∩ t ∈ L) ∧ ∀k. k ⊂ L ⇒ UNIONS k ∈ L`;; + +let UnderlyingSpace = NewDefinition `; + UnderlyingSpace α = FST α`;; + +let OpenSets = NewDefinition `; + OpenSets α = SND α`;; + +let ExistsTopology = theorem `; + ∀X. ∃α. istopology α ∧ UnderlyingSpace α = X + + proof + intro_TAC ∀X; + consider L such that L = {U | U ⊂ X} [Lexists] by fol; + exists_TAC (X, L); + rewrite istopology IN_ELIM_THM Lexists UnderlyingSpace; + set; + qed; +`;; + +let topology_tybij_th = theorem `; + ∃t. istopology t + by fol ExistsTopology`;; + +let topology_tybij = + new_type_definition "topology" ("mk_topology","dest_topology") + topology_tybij_th;; + +let ISTOPOLOGYdest_topology = theorem `; + ∀α. istopology (dest_topology α) + by fol topology_tybij`;; + +let OpenIn = NewDefinition `; + ∀α. open_in α = OpenSets (dest_topology α)`;; + +let topspace = NewDefinition `; + ∀α. topspace α = UnderlyingSpace (dest_topology α)`;; + +let TopologyPAIR = theorem `; + ∀α. dest_topology α = (topspace α, open_in α) + by rewrite PAIR_EQ OpenIn topspace UnderlyingSpace OpenSets`;; + +let Topology_Eq = theorem `; + ∀α β. topspace α = topspace β ∧ (∀U. open_in α U ⇔ open_in β U) + ⇔ α = β + + proof + intro_TAC ∀α β; + eq_tac [Right] by fol; + intro_TAC H1 H2; + dest_topology α = dest_topology β [] by simplify TopologyPAIR PAIR_EQ H1 H2 FUN_EQ_THM; + fol - topology_tybij; + qed; +`;; + +let OpenInCLAUSES = theorem `; + ∀α X. topspace α = X ⇒ + (∀U. open_in α U ⇒ U ⊂ X) ∧ open_in α ∅ ∧ open_in α X ∧ + (∀s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∩ t)) ∧ + ∀k. (∀s. s ∈ k ⇒ open_in α s) ⇒ open_in α (UNIONS k) + + proof + intro_TAC ∀α X, H1; + consider L such that L = open_in α [Ldef] by fol; + istopology (X, L) [] by fol H1 Ldef TopologyPAIR PAIR_EQ ISTOPOLOGYdest_topology; + fol Ldef - istopology IN SUBSET; + qed; +`;; + +let OPEN_IN_SUBSET = theorem `; + ∀α s. open_in α s ⇒ s ⊂ topspace α + by fol OpenInCLAUSES`;; + +let OPEN_IN_EMPTY = theorem `; + ∀α. open_in α ∅ + by fol OpenInCLAUSES`;; + +let OPEN_IN_INTER = theorem `; + ∀α s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∩ t) + by fol OpenInCLAUSES`;; + +let OPEN_IN_UNIONS = theorem `; + ∀α k. (∀s. s ∈ k ⇒ open_in α s) ⇒ open_in α (UNIONS k) + by fol OpenInCLAUSES`;; + +let OpenInTopspace = theorem `; + ∀α. open_in α (topspace α) + by fol OpenInCLAUSES`;; + +let OPEN_IN_UNION = theorem `; + ∀α s t. open_in α s ∧ open_in α t ⇒ open_in α (s ∪ t) + + proof + intro_TAC ∀α s t, H; + ∀x. x ∈ {s, t} ⇔ x = s ∨ x = t [] by fol IN_INSERT NOT_IN_EMPTY; + fol - UNIONS_2 H OPEN_IN_UNIONS; + qed; +`;; + +let OPEN_IN_TOPSPACE = theorem `; + ∀α. open_in α (topspace α) + by fol OpenInCLAUSES`;; + +let OPEN_IN_INTERS = theorem `; + ∀α s. FINITE s ∧ ¬(s = ∅) ∧ (∀t. t ∈ s ⇒ open_in α t) + ⇒ open_in α (INTERS s) + + proof + intro_TAC ∀α; + rewrite IMP_CONJ; + MATCH_MP_TAC FINITE_INDUCT; + rewrite INTERS_INSERT NOT_INSERT_EMPTY FORALL_IN_INSERT; + intro_TAC ∀x s, H1, xWorks sWorks; + assume ¬(s = ∅) [Nonempty] by simplify INTERS_0 INTER_UNIV xWorks; + fol xWorks Nonempty H1 sWorks OPEN_IN_INTER; + qed; +`;; + +let OPEN_IN_SUBOPEN = theorem `; + ∀α s. open_in α s ⇔ ∀x. x ∈ s ⇒ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s + + proof + intro_TAC ∀α s; + eq_tac [Left] by set; + intro_TAC ALLtExist; + consider f such that + ∀x. x ∈ s ⇒ open_in α (f x) ∧ x ∈ f x ∧ f x ⊂ s [fExists] by fol ALLtExist SKOLEM_THM_GEN; + s = UNIONS (IMAGE f s) [] by set -; + fol - fExists FORALL_IN_IMAGE OPEN_IN_UNIONS; + qed; +`;; + +let closed_in = NewDefinition `; + ∀α s. closed_in α s ⇔ + s ⊂ topspace α ∧ open_in α (topspace α ━ s)`;; + +let CLOSED_IN_SUBSET = theorem `; + ∀α s. closed_in α s ⇒ s ⊂ topspace α + by fol closed_in`;; + +let CLOSED_IN_EMPTY = theorem `; + ∀α. closed_in α ∅ + by fol closed_in EMPTY_SUBSET DIFF_EMPTY OPEN_IN_TOPSPACE`;; + +let CLOSED_IN_TOPSPACE = theorem `; + ∀α. closed_in α (topspace α) + by fol closed_in SUBSET_REFL DIFF_EQ_EMPTY OPEN_IN_EMPTY`;; + +let CLOSED_IN_UNION = theorem `; + ∀α s t. closed_in α s ∧ closed_in α t ⇒ closed_in α (s ∪ t) + + proof + intro_TAC ∀α s t, Hst; + fol Hst closed_in DIFF_UNION UNION_SUBSET OPEN_IN_INTER; + qed; +`;; + +let CLOSED_IN_INTERS = theorem `; + ∀α k. ¬(k = ∅) ∧ (∀s. s ∈ k ⇒ closed_in α s) ⇒ closed_in α (INTERS k) + + proof + intro_TAC ∀α k, H1 H2; + consider X such that X = topspace α [Xdef] by fol; + simplify GSYM Xdef closed_in DIFF_INTERS SIMPLE_IMAGE; + fol H1 H2 Xdef INTERS_SUBSET closed_in FORALL_IN_IMAGE OPEN_IN_UNIONS; + qed; +`;; + +let CLOSED_IN_FORALL_IN = theorem `; + ∀α P Q. ¬(P = ∅) ∧ (∀a. P a ⇒ closed_in α {x | Q a x}) ⇒ + closed_in α {x | ∀a. P a ⇒ Q a x} + + proof + intro_TAC ∀α P Q, Pnonempty H1; + consider f such that f = {{x | Q a x} | P a} [fDef] by fol; + ¬(f = ∅) [fNonempty] by set fDef Pnonempty; + (∀a. P a ⇒ closed_in α {x | Q a x}) ⇔ (∀s. s ∈ f ⇒ closed_in α s) [] by simplify fDef FORALL_IN_GSPEC; + closed_in α (INTERS f) [] by fol fNonempty H1 - CLOSED_IN_INTERS; + MP_TAC -; + {x | ∀a. P a ⇒ x ∈ {x | Q a x}} = {x | ∀a. P a ⇒ Q a x} [] by set; + simplify fDef INTERS_GSPEC -; + qed; +`;; + +let CLOSED_IN_INTER = theorem `; + ∀α s t. closed_in α s ∧ closed_in α t ⇒ closed_in α (s ∩ t) + + proof + intro_TAC ∀α s t, Hs Ht; + rewrite GSYM INTERS_2; + MATCH_MP_TAC CLOSED_IN_INTERS; + set Hs Ht; + qed; +`;; + +let OPEN_IN_CLOSED_IN_EQ = theorem `; + ∀α s. open_in α s ⇔ s ⊂ topspace α ∧ closed_in α (topspace α ━ s) + + proof + intro_TAC ∀α s; + simplify closed_in SUBSET_DIFF OPEN_IN_SUBSET; + fol SET_RULE [X ━ (X ━ s) = X ∩ s ∧ (s ⊂ X ⇒ X ∩ s = s)] OPEN_IN_SUBSET; + qed; +`;; + +let OPEN_IN_CLOSED_IN = theorem `; + ∀s. s ⊂ topspace α + ⇒ (open_in α s ⇔ closed_in α (topspace α ━ s)) + by fol OPEN_IN_CLOSED_IN_EQ`;; + +let OPEN_IN_DIFF = theorem `; + ∀α s t. open_in α s ∧ closed_in α t ⇒ open_in α (s ━ t) + + proof + intro_TAC ∀α s t, H1 H2; + consider X such that X = topspace α [Xdef] by fol; + fol COMPLEMENT_INTER_DIFF OPEN_IN_SUBSET - H1 H2 closed_in OPEN_IN_INTER; + qed; +`;; + +let CLOSED_IN_DIFF = theorem `; + ∀α s t. closed_in α s ∧ open_in α t ⇒ closed_in α (s ━ t) + + proof + intro_TAC ∀α s t, H1 H2; + consider X such that X = topspace α [Xdef] by fol; + fol COMPLEMENT_INTER_DIFF H1 - OPEN_IN_SUBSET SUBSET_DIFF DIFF_REFL H2 closed_in CLOSED_IN_INTER; + qed; +`;; + +let CLOSED_IN_UNIONS = theorem `; + ∀α s. FINITE s ∧ (∀t. t ∈ s ⇒ closed_in α t) + ⇒ closed_in α (UNIONS s) + + proof + intro_TAC ∀α; + rewrite IMP_CONJ; + MATCH_MP_TAC FINITE_INDUCT; + fol UNIONS_INSERT UNIONS_0 CLOSED_IN_EMPTY IN_INSERT CLOSED_IN_UNION; + qed; +`;; + +let subtopology = NewDefinition `; + ∀α u. subtopology α u = mk_topology (u, {s ∩ u | open_in α s})`;; + +let IstopologySubtopology = theorem `; + ∀α u:A->bool. u ⊂ topspace α ⇒ istopology (u, {s ∩ u | open_in α s}) + + proof + intro_TAC ∀α u, H1; + ∅ = ∅ ∩ u ∧ open_in α ∅ [emptysetOpen] by fol INTER_EMPTY OPEN_IN_EMPTY; + u = topspace α ∩ u ∧ open_in α (topspace α) [uOpen] by fol OPEN_IN_TOPSPACE H1 INTER_COMM SUBSET_INTER_ABSORPTION; + ∀s' s. open_in α s' ∧ open_in α s ⇒ open_in α (s' ∩ s) ∧ + (s' ∩ u) ∩ (s ∩ u) = (s' ∩ s) ∩ u [interOpen] + proof + intro_TAC ∀s' s, H1 H2; + set MESON [H1; H2; OPEN_IN_INTER] [open_in α (s' ∩ s)]; + qed; + ∀k. k ⊂ {s | open_in α s} ⇒ open_in α (UNIONS k) ∧ + UNIONS (IMAGE (λs. s ∩ u) k) = (UNIONS k) ∩ u [unionsOpen] + proof + intro_TAC ∀k, kProp; + open_in α (UNIONS k) [] by fol kProp SUBSET IN_ELIM_THM OPEN_IN_UNIONS; + simplify - UNIONS_IMAGE UNIONS_GSPEC INTER_UNIONS; + qed; + {s ∩ u | open_in α s} = IMAGE (λs. s ∩ u) {s | open_in α s} [] by set; + simplify istopology IN_SET_FUNCTION_PREDICATE LEFT_IMP_EXISTS_THM INTER_SUBSET - FORALL_SUBSET_IMAGE; + fol emptysetOpen uOpen interOpen unionsOpen; + qed; +`;; + +let OpenInSubtopology = theorem `; + ∀α u s. u ⊂ topspace α ⇒ + (open_in (subtopology α u) s ⇔ ∃t. open_in α t ∧ s = t ∩ u) + + proof + intro_TAC ∀α u s, H1; + open_in (subtopology α u) = OpenSets (u,{s ∩ u | open_in α s}) [] by fol subtopology H1 IstopologySubtopology topology_tybij OpenIn; + rewrite - OpenSets PAIR_EQ SND EXTENSION IN_ELIM_THM; + qed; +`;; + +let TopspaceSubtopology = theorem `; + ∀α u. u ⊂ topspace α ⇒ topspace (subtopology α u) = u + + proof + intro_TAC ∀α u , H1; + topspace (subtopology α u) = UnderlyingSpace (u,{s ∩ u | open_in α s}) [] by fol subtopology H1 IstopologySubtopology topology_tybij topspace; + rewrite - UnderlyingSpace PAIR_EQ FST; + fol INTER_COMM H1 SUBSET_INTER_ABSORPTION; + qed; +`;; + +let OpenInRefl = theorem `; + ∀α s. s ⊂ topspace α ⇒ open_in (subtopology α s) s + by fol TopspaceSubtopology OPEN_IN_TOPSPACE`;; + +let ClosedInRefl = theorem `; + ∀α s. s ⊂ topspace α ⇒ closed_in (subtopology α s) s + by fol TopspaceSubtopology CLOSED_IN_TOPSPACE`;; + +let ClosedInSubtopology = theorem `; + ∀α u C. u ⊂ topspace α ⇒ + (closed_in (subtopology α u) C ⇔ ∃D. closed_in α D ∧ C = D ∩ u) + + proof + intro_TAC ∀α u C, H1; + consider X such that + X = topspace α ∧ u ⊂ X [Xdef] by fol H1; + closed_in (subtopology α u) C ⇔ + ∃t. C ⊂ u ∧ t ⊂ X ∧ open_in α t ∧ u ━ C = t ∩ u [] by fol closed_in H1 Xdef OpenInSubtopology OPEN_IN_SUBSET TopspaceSubtopology; + closed_in (subtopology α u) C ⇔ + ∃D. C ⊂ u ∧ D ⊂ X ∧ open_in α (X ━ D) ∧ u ━ C = (X ━ D) ∩ u [] + proof + rewrite -; + eq_tac [Left] + proof + STRIP_TAC; exists_TAC X ━ t; + ASM_SIMP_TAC H1 OPEN_IN_SUBSET DIFF_REFL SUBSET_DIFF; + qed; + STRIP_TAC; exists_TAC X ━ D; + ASM_SIMP_TAC SUBSET_DIFF; + qed; + simplify - GSYM Xdef H1 closed_in; + ∀D C. C ⊂ u ∧ u ━ C = (X ━ D) ∩ u ⇔ C = D ∩ u [] by set Xdef DIFF_REFL INTER_SUBSET; + fol -; + qed; +`;; + +let OPEN_IN_SUBTOPOLOGY_EMPTY = theorem `; + ∀α s. open_in (subtopology α ∅) s ⇔ s = ∅ + + proof + simplify EMPTY_SUBSET OpenInSubtopology INTER_EMPTY; + fol OPEN_IN_EMPTY; + qed; +`;; + +let CLOSED_IN_SUBTOPOLOGY_EMPTY = theorem `; + ∀α s. closed_in (subtopology α ∅) s ⇔ s = ∅ + + proof + simplify EMPTY_SUBSET ClosedInSubtopology INTER_EMPTY; + fol CLOSED_IN_EMPTY; + qed; +`;; + +let SUBTOPOLOGY_TOPSPACE = theorem `; + ∀α. subtopology α (topspace α) = α + + proof + intro_TAC ∀α; + topspace (subtopology α (topspace α)) = topspace α [topXsub] by simplify SUBSET_REFL TopspaceSubtopology; + simplify topXsub GSYM Topology_Eq; + fol MESON [SUBSET_REFL] [topspace α ⊂ topspace α] OpenInSubtopology OPEN_IN_SUBSET SUBSET_INTER_ABSORPTION; + qed; +`;; + +let OpenInImpSubset = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + open_in (subtopology α s) t ⇒ t ⊂ s + by fol OpenInSubtopology INTER_SUBSET`;; + +let ClosedInImpSubset = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + closed_in (subtopology α s) t ⇒ t ⊂ s + by fol ClosedInSubtopology INTER_SUBSET`;; + +let OpenInSubtopologyUnion = theorem `; + ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ + open_in (subtopology α t) s ∧ open_in (subtopology α u) s + ⇒ open_in (subtopology α (t ∪ u)) s + + proof + intro_TAC ∀α s t u, Ht Hu; + simplify Ht Hu Ht Hu UNION_SUBSET OpenInSubtopology; + intro_TAC sOpenSub_t sOpenSub_u; + consider a b such that + open_in α a ∧ s = a ∩ t ∧ + open_in α b ∧ s = b ∩ u [abExist] by fol sOpenSub_t sOpenSub_u; + exists_TAC a ∩ b; + set MESON [abExist; OPEN_IN_INTER] [open_in α (a ∩ b)] abExist; + qed; +`;; + +let ClosedInSubtopologyUnion = theorem `; + ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ + closed_in (subtopology α t) s ∧ closed_in (subtopology α u) s + ⇒ closed_in (subtopology α (t ∪ u)) s + + proof + intro_TAC ∀α s t u, Ht Hu; + simplify Ht Hu Ht Hu UNION_SUBSET ClosedInSubtopology; + intro_TAC sClosedSub_t sClosedSub_u; + consider a b such that + closed_in α a ∧ s = a ∩ t ∧ + closed_in α b ∧ s = b ∩ u [abExist] by fol sClosedSub_t sClosedSub_u; + exists_TAC a ∩ b; + set MESON [abExist; CLOSED_IN_INTER] [closed_in α (a ∩ b)] abExist; + qed; +`;; + +let OpenInSubtopologyInterOpen = theorem `; + ∀α s t u. u ⊂ topspace α ⇒ + open_in (subtopology α u) s ∧ open_in α t + ⇒ open_in (subtopology α u) (s ∩ t) + + proof + intro_TAC ∀α s t u, H1, sOpenSub_t tOpen; + consider a b such that + open_in α a ∧ s = a ∩ u ∧ b = a ∩ t [aExists] by fol sOpenSub_t H1 OpenInSubtopology; + fol - tOpen OPEN_IN_INTER INTER_ACI H1 OpenInSubtopology; + qed; +`;; + +let OpenInOpenInter = theorem `; + ∀α u s. u ⊂ topspace α ⇒ open_in α s + ⇒ open_in (subtopology α u) (u ∩ s) + by fol INTER_COMM OpenInSubtopology`;; + +let OpenOpenInTrans = theorem `; + ∀α s t. open_in α s ∧ open_in α t ∧ t ⊂ s + ⇒ open_in (subtopology α s) t + by fol OPEN_IN_SUBSET SUBSET_INTER_ABSORPTION OpenInSubtopology`;; + +let ClosedClosedInTrans = theorem `; + ∀α s t. closed_in α s ∧ closed_in α t ∧ t ⊂ s + ⇒ closed_in (subtopology α s) t + by fol CLOSED_IN_SUBSET SUBSET_INTER_ABSORPTION ClosedInSubtopology`;; + +let OpenSubset = theorem `; + ∀α s t. t ⊂ topspace α ⇒ + s ⊂ t ∧ open_in α s ⇒ open_in (subtopology α t) s + by fol OpenInSubtopology SUBSET_INTER_ABSORPTION`;; + +let ClosedSubsetEq = theorem `; + ∀α u s. u ⊂ topspace α ⇒ + closed_in α s ⇒ (closed_in (subtopology α u) s ⇔ s ⊂ u) + by fol ClosedInSubtopology INTER_SUBSET SUBSET_INTER_ABSORPTION`;; + +let ClosedInInterClosed = theorem `; + ∀α s t u. u ⊂ topspace α ⇒ + closed_in (subtopology α u) s ∧ closed_in α t + ⇒ closed_in (subtopology α u) (s ∩ t) + + proof + intro_TAC ∀α s t u, H1, sClosedSub_t tClosed; + consider a b such that + closed_in α a ∧ s = a ∩ u ∧ b = a ∩ t [aExists] by fol sClosedSub_t H1 ClosedInSubtopology; + fol - tClosed CLOSED_IN_INTER INTER_ACI H1 ClosedInSubtopology; + qed; +`;; + +let ClosedInClosedInter = theorem `; + ∀α u s. u ⊂ topspace α ⇒ + closed_in α s ⇒ closed_in (subtopology α u) (u ∩ s) + by fol INTER_COMM ClosedInSubtopology`;; + +let ClosedSubset = theorem `; + ∀α s t. t ⊂ topspace α ⇒ + s ⊂ t ∧ closed_in α s ⇒ closed_in (subtopology α t) s + by fol ClosedInSubtopology SUBSET_INTER_ABSORPTION`;; + +let OpenInSubsetTrans = theorem `; + ∀α s t u. u ⊂ topspace α ∧ t ⊂ topspace α ⇒ + open_in (subtopology α u) s ∧ s ⊂ t ∧ t ⊂ u + ⇒ open_in (subtopology α t) s + + proof + intro_TAC ∀α s t u, uSubset tSubset; + simplify uSubset tSubset OpenInSubtopology; + intro_TAC sOpen_u s_t t_u; + consider a such that + open_in α a ∧ s = a ∩ u [aExists] by fol uSubset sOpen_u OpenInSubtopology; + set aExists s_t t_u; + qed; +`;; + +let ClosedInSubsetTrans = theorem `; + ∀α s t u. u ⊂ topspace α ∧ t ⊂ topspace α ⇒ + closed_in (subtopology α u) s ∧ s ⊂ t ∧ t ⊂ u + ⇒ closed_in (subtopology α t) s + + proof + intro_TAC ∀α s t u, uSubset tSubset; + simplify uSubset tSubset ClosedInSubtopology; + intro_TAC sClosed_u s_t t_u; + consider a such that + closed_in α a ∧ s = a ∩ u [aExists] by fol uSubset sClosed_u ClosedInSubtopology; + set aExists s_t t_u; + qed; +`;; + +let OpenInTrans = theorem `; + ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ + open_in (subtopology α t) s ∧ open_in (subtopology α u) t + ⇒ open_in (subtopology α u) s + + proof + intro_TAC ∀α s t u, H1 H2; + simplify H1 H2 OpenInSubtopology; + fol H1 H2 OpenInSubtopology OPEN_IN_INTER INTER_ASSOC; + qed; +`;; + +let OpenInTransEq = theorem `; + ∀α s t. t ⊂ topspace α ∧ s ⊂ topspace α ⇒ + ((∀u. open_in (subtopology α t) u ⇒ open_in (subtopology α s) t) + ⇔ open_in (subtopology α s) t) + by fol OpenInTrans OpenInRefl`;; + +let OpenInOpenTrans = theorem `; + ∀α u s. u ⊂ topspace α ⇒ + open_in (subtopology α u) s ∧ open_in α u ⇒ open_in α s + by fol OpenInSubtopology OPEN_IN_INTER`;; + +let OpenInSubtopologyTrans = theorem `; + ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ + open_in (subtopology α t) s ∧ open_in (subtopology α u) t + ⇒ open_in (subtopology α u) s + + proof + simplify OpenInSubtopology; + fol OPEN_IN_INTER INTER_ASSOC; + qed; +`;; + +let SubtopologyOpenInSubopen = theorem `; + ∀α u s. u ⊂ topspace α ⇒ + (open_in (subtopology α u) s ⇔ + s ⊂ u ∧ ∀x. x ∈ s ⇒ ∃t. open_in α t ∧ x ∈ t ∧ t ∩ u ⊂ s) + + proof + intro_TAC ∀α u s, H1; + rewriteL OPEN_IN_SUBOPEN; + simplify H1 OpenInSubtopology; + eq_tac [Right] by fol SUBSET IN_INTER; + intro_TAC H2; + conj_tac [Left] + proof simplify SUBSET; fol H2 IN_INTER; qed; + intro_TAC ∀x, xs; + consider t such that + open_in α t ∧ x ∈ t ∩ u ∧ t ∩ u ⊂ s [tExists] by fol H2 xs; + fol - IN_INTER; + qed; +`;; + +let ClosedInSubtopologyTrans = theorem `; + ∀α s t u. t ⊂ topspace α ∧ u ⊂ topspace α ⇒ + closed_in (subtopology α t) s ∧ closed_in (subtopology α u) t + ⇒ closed_in (subtopology α u) s + + proof + simplify ClosedInSubtopology; + fol CLOSED_IN_INTER INTER_ASSOC; + qed; +`;; + +let ClosedInSubtopologyTransEq = theorem `; + ∀α s t. t ⊂ topspace α ∧ s ⊂ topspace α ⇒ + ((∀u. closed_in (subtopology α t) u ⇒ closed_in (subtopology α s) t) + ⇔ closed_in (subtopology α s) t) + + proof + intro_TAC ∀α s t, H1 H2; + fol H1 H2 ClosedInSubtopologyTrans CLOSED_IN_TOPSPACE; + qed; +`;; + +let ClosedInClosedTrans = theorem `; + ∀α s t. u ⊂ topspace α ⇒ + closed_in (subtopology α u) s ∧ closed_in α u ⇒ closed_in α s + by fol ClosedInSubtopology CLOSED_IN_INTER`;; + +let OpenInSubtopologyInterSubset = theorem `; + ∀α s u v. u ⊂ topspace α ∧ v ⊂ topspace α ⇒ + open_in (subtopology α u) (u ∩ s) ∧ v ⊂ u + ⇒ open_in (subtopology α v) (v ∩ s) + + proof + simplify OpenInSubtopology; + set; + qed; +`;; + +let OpenInOpenEq = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + open_in α s ⇒ (open_in (subtopology α s) t ⇔ open_in α t ∧ t ⊂ s) + by fol OpenOpenInTrans OPEN_IN_SUBSET TopspaceSubtopology OpenInOpenTrans`;; + +let ClosedInClosedEq = theorem `; + ∀α s t. s ⊂ topspace α ⇒ closed_in α s ⇒ + (closed_in (subtopology α s) t ⇔ closed_in α t ∧ t ⊂ s) + by fol ClosedClosedInTrans CLOSED_IN_SUBSET TopspaceSubtopology ClosedInClosedTrans`;; + +let OpenImpliesSubtopologyInterOpen = theorem `; + ∀α u s. u ⊂ topspace α ⇒ + open_in α s ⇒ open_in (subtopology α u) (u ∩ s) + by fol OpenInSubtopology INTER_COMM`;; + +let OPEN_IN_EXISTS_IN = theorem `; + ∀α P Q. (∀a. P a ⇒ open_in α {x | Q a x}) ⇒ + open_in α {x | ∃a. P a ∧ Q a x} + + proof + intro_TAC ∀α P Q, H1; + consider f such that f = {{x | Q a x} | P a} [fDef] by fol; + (∀a. P a ⇒ open_in α {x | Q a x}) ⇔ (∀s. s ∈ f ⇒ open_in α s) [] by simplify fDef FORALL_IN_GSPEC; + MP_TAC MESON [H1; -; OPEN_IN_UNIONS] [open_in α (UNIONS f)]; + simplify fDef UNIONS_GSPEC; + set; + qed; +`;; + +let Connected_DEF = NewDefinition `; + ∀α. Connected α ⇔ + ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ topspace α = e1 ∪ e2 ∧ + e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))`;; + +let ConnectedClosedHelp = theorem `; + ∀α e1 e2. topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ⇒ + (closed_in α e1 ∧ closed_in α e2 ⇔ open_in α e1 ∧ open_in α e2) + + proof + intro_TAC ∀α e1 e2, H1 H2; + e1 = topspace α ━ e2 ∧ e2 = topspace α ━ e1 [e12Complements] by set H1 H2; + fol H1 SUBSET_UNION e12Complements OPEN_IN_CLOSED_IN_EQ; + qed; +`;; + +let ConnectedClosed = theorem `; + ∀α. Connected α ⇔ + ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ + topspace α = e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) + + proof + rewrite Connected_DEF; + fol ConnectedClosedHelp; + qed; +`;; + +let ConnectedOpenIn = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Connected (subtopology α s) ⇔ ¬(∃e1 e2. + open_in (subtopology α s) e1 ∧ open_in (subtopology α s) e2 ∧ + s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))) + + proof + simplify Connected_DEF TopspaceSubtopology; + fol SUBSET_REFL OpenInImpSubset UNION_SUBSET SUBSET_ANTISYM; + qed; +`;; + +let ConnectedClosedIn = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Connected (subtopology α s) ⇔ ¬(∃e1 e2. + closed_in (subtopology α s) e1 ∧ closed_in (subtopology α s) e2 ∧ + s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅))) + + proof + simplify ConnectedClosed TopspaceSubtopology; + fol SUBSET_REFL ClosedInImpSubset UNION_SUBSET SUBSET_ANTISYM; + qed; +`;; + +let ConnectedSubtopology = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Connected (subtopology α s) ⇔ + ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ + e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) + + proof + intro_TAC ∀α s, H1; + simplify H1 Connected_DEF OpenInSubtopology TopspaceSubtopology; + AP_TERM_TAC; + eq_tac [Left] + proof + intro_TAC H2; + consider t1 t2 such that + open_in α t1 ∧ open_in α t2 ∧ s = (t1 ∩ s) ∪ (t2 ∩ s) ∧ + (t1 ∩ s) ∩ (t2 ∩ s) = ∅ ∧ ¬(t1 ∩ s = ∅) ∧ ¬(t2 ∩ s = ∅) [t12Exist] by fol H2; + s ⊂ t1 ∪ t2 ∧ t1 ∩ t2 ∩ s = ∅ [] by set t12Exist; + fol t12Exist -; + qed; + rewrite LEFT_IMP_EXISTS_THM; + intro_TAC ∀e1 e2, e12Exist; + exists_TAC e1 ∩ s; + exists_TAC e2 ∩ s; + set e12Exist; + qed; +`;; + +let ConnectedSubtopology_ALT = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Connected (subtopology α s) ⇔ + ∀e1 e2. open_in α e1 ∧ open_in α e2 ∧ + s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ + ⇒ e1 ∩ s = ∅ ∨ e2 ∩ s = ∅) + + proof simplify ConnectedSubtopology; fol; qed; +`;; + +let ConnectedClosedSubtopology = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Connected (subtopology α s) ⇔ + ¬(∃e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ s ⊂ e1 ∪ e2 ∧ + e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅))) + + proof + intro_TAC ∀α s, H1; + simplify H1 ConnectedSubtopology; + AP_TERM_TAC; + eq_tac [Left] + proof + rewrite LEFT_IMP_EXISTS_THM; + intro_TAC ∀e1 e2, e12Exist; + exists_TAC topspace α ━ e2; + exists_TAC topspace α ━ e1; + simplify OPEN_IN_SUBSET H1 SUBSET_DIFF DIFF_REFL closed_in e12Exist; + set H1 e12Exist; + qed; + rewrite LEFT_IMP_EXISTS_THM; + intro_TAC ∀e1 e2, e12Exist; + exists_TAC topspace α ━ e2; + exists_TAC topspace α ━ e1; + e1 ⊂ topspace α ∧ e2 ⊂ topspace α [e12Top] by fol closed_in e12Exist; + simplify DIFF_REFL SUBSET_DIFF e12Top OPEN_IN_CLOSED_IN; + set H1 e12Exist; + qed; +`;; + +let ConnectedClosedSubtopology_ALT = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Connected (subtopology α s) ⇔ + ∀e1 e2. closed_in α e1 ∧ closed_in α e2 ∧ + s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 ∩ s = ∅ + ⇒ e1 ∩ s = ∅ ∨ e2 ∩ s = ∅) + + proof simplify ConnectedClosedSubtopology; fol; qed; +`;; + +let ConnectedClopen = theorem `; + ∀α. Connected α ⇔ + ∀t. open_in α t ∧ closed_in α t ⇒ t = ∅ ∨ t = topspace α + + proof + intro_TAC ∀α; + simplify Connected_DEF closed_in TAUT [(¬a ⇔ b) ⇔ (a ⇔ ¬b)] NOT_FORALL_THM NOT_IMP DE_MORGAN_THM; + eq_tac [Left] + proof + rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H1 H2 H3 H4 H5 H6; + exists_TAC e1; + e1 ⊂ topspace α ∧ e2 = topspace α ━ e1 ∧ ¬(e1 = topspace alpha) [] by set H3 H4 H6; + fol H1 - H2 H5; + qed; + rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀t, H1; + exists_TAC t; exists_TAC topspace α ━ t; + set H1; + qed; +`;; + +let ConnectedClosedSet = theorem `; + ∀α s. s ⊂ topspace α ⇒ closed_in α s ⇒ + (Connected (subtopology α s) ⇔ ¬(∃e1 e2. + closed_in α e1 ∧ closed_in α e2 ∧ + ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) + + proof + intro_TAC ∀α s, H1, H2; + simplify H1 ConnectedClosedSubtopology; + AP_TERM_TAC; + eq_tac [Left] + proof + rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; + exists_TAC e1 ∩ s; exists_TAC e2 ∩ s; + simplify H2 H3 H4 H7 H8 CLOSED_IN_INTER; + set H5 H6; + qed; + rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; + exists_TAC e1; exists_TAC e2; + set H3 H4 H7 H8 H5 H6; + qed; +`;; + +let ConnectedOpenSet = theorem `; + ∀α s. open_in α s ⇒ + (Connected (subtopology α s) ⇔ + ¬(∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ + ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) + + proof + intro_TAC ∀α s, H1; + simplify H1 OPEN_IN_SUBSET ConnectedSubtopology; + AP_TERM_TAC; + eq_tac [Left] + proof + rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; + exists_TAC e1 ∩ s; exists_TAC e2 ∩ s; + e1 ⊂ topspace α ∧ e2 ⊂ topspace α [e12Subsets] by fol H3 H4 OPEN_IN_SUBSET; + simplify H1 H3 H4 OPEN_IN_INTER H7 H8; + set e12Subsets H5 H6; + qed; + rewrite LEFT_IMP_EXISTS_THM; intro_TAC ∀e1 e2, H3 H4 H5 H6 H7 H8; + exists_TAC e1; exists_TAC e2; + set H3 H4 H7 H8 H5 H6; + qed; +`;; + +let ConnectedEmpty = theorem `; + ∀α. Connected (subtopology α ∅) + + proof + simplify Connected_DEF INTER_EMPTY EMPTY_SUBSET TopspaceSubtopology; + fol UNION_SUBSET SUBSET_EMPTY; + qed; +`;; + +let ConnectedSing = theorem `; + ∀α a. a ∈ topspace α ⇒ Connected (subtopology α {a}) + + proof + simplify Connected_DEF SING_SUBSET TopspaceSubtopology; + set; + qed; +`;; + +let ConnectedUnions = theorem `; + ∀α P. (∀s. s ∈ P ⇒ s ⊂ topspace α) ⇒ + (∀s. s ∈ P ⇒ Connected (subtopology α s)) ∧ ¬(INTERS P = ∅) + ⇒ Connected (subtopology α (UNIONS P)) + + proof + intro_TAC ∀α P, H1; + simplify H1 ConnectedSubtopology UNIONS_SUBSET NOT_EXISTS_THM; + intro_TAC allConnected PnotDisjoint, ∀[d/e1] [e/e2]; + consider a such that + ∀t. t ∈ P ⇒ a ∈ t [aInterP] by fol PnotDisjoint MEMBER_NOT_EMPTY IN_INTERS; + ONCE_REWRITE_TAC TAUT [∀p. ¬p ⇔ p ⇒ F]; + intro_TAC dOpen eOpen Pde deDisjoint dNonempty eNonempty; + a ∈ d ∨ a ∈ e [adORae] by set aInterP Pde dNonempty; + consider s x t y such that + s ∈ P ∧ x ∈ d ∩ s ∧ + t ∈ P ∧ y ∈ e ∩ t [xdsANDyet] by set dNonempty eNonempty; + d ∩ e ∩ s = ∅ ∧ d ∩ e ∩ t = ∅ [] by set - deDisjoint; + (d ∩ s = ∅ ∨ e ∩ s = ∅) ∧ + (d ∩ t = ∅ ∨ e ∩ t = ∅) [] by fol xdsANDyet allConnected dOpen eOpen Pde -; + set adORae xdsANDyet aInterP -; + qed; +`;; + +let ConnectedUnion = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ∧ ¬(s ∩ t = ∅) ∧ + Connected (subtopology α s) ∧ Connected (subtopology α t) + ⇒ Connected (subtopology α (s ∪ t)) + + proof + rewrite GSYM UNIONS_2 GSYM INTERS_2; + intro_TAC ∀α s t, H1 H2 H3 H4 H5; + ∀u. u ∈ {s, t} ⇒ u ⊂ topspace α [stEuclidean] by set H1 H2; + ∀u. u ∈ {s, t} ⇒ Connected (subtopology α u) [] by set H4 H5; + fol stEuclidean - H3 ConnectedUnions; + qed; +`;; + +let ConnectedDiffOpenFromClosed = theorem `; + ∀α s t u. u ⊂ topspace α ⇒ + s ⊂ t ∧ t ⊂ u ∧ open_in α s ∧ closed_in α t ∧ + Connected (subtopology α u) ∧ Connected (subtopology α (t ━ s)) + ⇒ Connected (subtopology α (u ━ s)) + + proof + ONCE_REWRITE_TAC TAUT + [∀a b c d e f g. (a ∧ b ∧ c ∧ d ∧ e ∧ f ⇒ g) ⇔ + (a ∧ b ∧ c ∧ d ⇒ ¬g ⇒ f ⇒ ¬e)]; + intro_TAC ∀α s t u, uSubset, st tu sOpen tClosed; + t ━ s ⊂ topspace α ∧ u ━ s ⊂ topspace α [] by fol uSubset sOpen OPEN_IN_SUBSET tClosed closed_in SUBSET_DIFF SUBSET_TRANS; + simplify uSubset - ConnectedSubtopology; + rewrite LEFT_IMP_EXISTS_THM; + intro_TAC ∀[v/e1] [w/e2]; + intro_TAC vOpen wOpen u_sDisconnected vwDisjoint vNonempty wNonempty; + rewrite NOT_EXISTS_THM; + intro_TAC t_sConnected; + t ━ s ⊂ v ∪ w ∧ v ∩ w ∩ (t ━ s) = ∅ [] by set tu u_sDisconnected vwDisjoint; + v ∩ (t ━ s) = ∅ ∨ w ∩ (t ━ s) = ∅ [] by fol t_sConnected vOpen wOpen -; + case_split vEmpty | wEmpty by fol -; + suppose v ∩ (t ━ s) = ∅; + exists_TAC w ∪ s; exists_TAC v ━ t; + simplify vOpen wOpen sOpen tClosed OPEN_IN_UNION OPEN_IN_DIFF; + set st tu u_sDisconnected vEmpty vwDisjoint wNonempty vNonempty; + end; + suppose w ∩ (t ━ s) = ∅; + exists_TAC v ∪ s; exists_TAC w ━ t; + simplify vOpen wOpen sOpen tClosed OPEN_IN_UNION OPEN_IN_DIFF; + set st tu u_sDisconnected wEmpty vwDisjoint wNonempty vNonempty; + end; + qed; +`;; + +let ConnectedDisjointUnionsOpenUniquePart1 = theorem `; + ∀α f f' s t a. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ + (∀s. s ∈ f ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ + (∀s. s ∈ f' ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ + UNIONS f = UNIONS f' ∧ s ∈ f ∧ t ∈ f' ∧ a ∈ s ∧ a ∈ t + ⇒ s ⊂ t + + proof + intro_TAC ∀α f f' s t a, pDISJf pDISJf' fConn f'Conn Uf_Uf' sf tf' a_s a_t; + ∀s. s ∈ f ⇒ s ⊂ topspace α [fTop] by fol fConn OPEN_IN_SUBSET; + ∀s. s ∈ f' ⇒ s ⊂ topspace α [f'Top] by fol f'Conn OPEN_IN_SUBSET; + rewrite SUBSET; + X_genl_TAC b; intro_TAC bs; + assume ¬(b ∈ t) [Contradiction] by fol; + ∃e1 e2. open_in α e1 ∧ open_in α e2 ∧ e1 ∩ e2 ∩ s = ∅ ∧ + s ⊂ e1 ∪ e2 ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅) [] + proof + exists_TAC t; exists_TAC UNIONS (f' DELETE t); + simplify tf' f'Conn IN_DELETE OPEN_IN_UNIONS; + conj_tac [Right] by set sf Uf_Uf' a_s a_t sf bs Contradiction; + MATCH_MP_TAC SET_RULE [∀s t u. t ∩ u = ∅ ⇒ t ∩ u ∩ s = ∅]; + rewrite INTER_UNIONS EMPTY_UNIONS FORALL_IN_GSPEC; + rewrite IN_DELETE GSYM DISJOINT; + fol pDISJf' tf' pairwise; + qed; + fol - sf fTop fConn ConnectedSubtopology; + qed; +`;; + +let ConnectedDisjointUnionsOpenUnique = theorem `; + ∀α f f'. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ + (∀s. s ∈ f ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ + (∀s. s ∈ f' ⇒ open_in α s ∧ Connected (subtopology α s) ∧ ¬(s = ∅)) ∧ + UNIONS f = UNIONS f' + ⇒ f = f' + + proof + MATCH_MP_TAC MESON [SUBSET_ANTISYM] + [(∀α s t. P α s t ⇒ P α t s) ∧ (∀α s t. P α s t ⇒ s ⊂ t) + ⇒ (∀α s t. P α s t ⇒ s = t)]; + conj_tac [Left] by fol; + intro_TAC ∀α f f', pDISJf pDISJf' fConn f'Conn Uf_Uf'; + rewrite SUBSET; X_genl_TAC s; intro_TAC sf; + consider t a such that + t ∈ f' ∧ a ∈ s ∧ a ∈ t [taExist] by set sf fConn Uf_Uf'; + MP_TAC ISPECL [α; f; f'; s; t] ConnectedDisjointUnionsOpenUniquePart1; + MP_TAC ISPECL [α; f'; f; t; s] ConnectedDisjointUnionsOpenUniquePart1; + fol pDISJf pDISJf' fConn f'Conn Uf_Uf' sf taExist SUBSET_ANTISYM taExist; + qed; +`;; + +let ConnectedFromClosedUnionAndInter = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ∧ closed_in α s ∧ closed_in α t ∧ + Connected (subtopology α (s ∪ t)) ∧ Connected (subtopology α (s ∩ t)) + ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) + + proof + MATCH_MP_TAC MESON [] [(∀α s t. P α s t ⇒ P α t s) ∧ + (∀α s t. P α s t ⇒ Q α s) ⇒ ∀α s t. P α s t ⇒ Q α s ∧ Q α t]; + conj_tac [Left] by fol UNION_COMM INTER_COMM; + ONCE_REWRITE_TAC TAUT + [∀a b c d e f. a ∧ b ∧ c ∧ d ∧ e ⇒ f ⇔ a ∧ b ∧ c ∧ e ∧ ¬f ⇒ ¬d]; + intro_TAC ∀α s t, stUnionTop sClosed tClosed stInterConn NOTsConn; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol stUnionTop UNION_SUBSET INTER_SUBSET SUBSET_TRANS; + simplify stUnionTop ConnectedClosedSubtopology; + consider u v such that closed_in α u ∧ closed_in α v ∧ + ¬(u = ∅) ∧ ¬(v = ∅) ∧ u ∪ v = s ∧ u ∩ v = ∅ [sDisConn] + proof + MP_TAC ISPECL [α; s] ConnectedClosedSet; + simplify stTop sClosed NOTsConn; + qed; + s ∩ t ⊂ u ∪ v ∧ u ∩ v ∩ (s ∩ t) = ∅ [stuvProps] by set sDisConn; + u ∩ (s ∩ t) = ∅ ∨ v ∩ (s ∩ t) = ∅ [] by fol stTop stInterConn sDisConn - ConnectedClosedSubtopology_ALT; + case_split vstEmpty | ustEmpty by fol -; + suppose v ∩ (s ∩ t) = ∅; + exists_TAC t ∪ u; exists_TAC v; + simplify tClosed sDisConn CLOSED_IN_UNION; + set stuvProps sDisConn vstEmpty; + end; + suppose u ∩ (s ∩ t) = ∅; + exists_TAC t ∪ v; exists_TAC u; + simplify tClosed sDisConn CLOSED_IN_UNION; + set stuvProps sDisConn ustEmpty; + end; + qed; +`;; + +let ConnectedFromOpenUnionAndInter = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ∧ open_in α s ∧ open_in α t ∧ + Connected (subtopology α (s ∪ t)) ∧ Connected (subtopology α (s ∩ t)) + ⇒ Connected (subtopology α s) ∧ Connected (subtopology α t) + + proof + MATCH_MP_TAC MESON [] [(∀α s t. P α s t ⇒ P α t s) ∧ + (∀α s t. P α s t ⇒ Q α s) ⇒ ∀α s t. P α s t ⇒ Q α s ∧ Q α t]; + conj_tac [Left] by fol UNION_COMM INTER_COMM; + ONCE_REWRITE_TAC TAUT + [∀a b c d e f. a ∧ b ∧ c ∧ d ∧ e ⇒ f ⇔ a ∧ b ∧ c ∧ e ∧ ¬f ⇒ ¬d]; + intro_TAC ∀α s t, stUnionTop sOpen tOpen stInterConn NOTsConn; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol stUnionTop UNION_SUBSET INTER_SUBSET SUBSET_TRANS; + simplify stUnionTop ConnectedSubtopology; + consider u v such that open_in α u ∧ open_in α v ∧ + ¬(u = ∅) ∧ ¬(v = ∅) ∧ u ∪ v = s ∧ u ∩ v = ∅ [sDisConn] + proof + MP_TAC ISPECL [α; s] ConnectedOpenSet; + simplify stTop sOpen NOTsConn; + qed; + s ∩ t ⊂ u ∪ v ∧ u ∩ v ∩ (s ∩ t) = ∅ [stuvProps] by set sDisConn; + u ∩ (s ∩ t) = ∅ ∨ v ∩ (s ∩ t) = ∅ [] by fol stTop stInterConn sDisConn - ConnectedSubtopology_ALT; + case_split vstEmpty | ustEmpty by fol -; + suppose v ∩ (s ∩ t) = ∅; + exists_TAC t ∪ u; exists_TAC v; + simplify tOpen sDisConn OPEN_IN_UNION; + set stuvProps sDisConn vstEmpty; + end; + suppose u ∩ (s ∩ t) = ∅; + exists_TAC t ∪ v; exists_TAC u; + simplify tOpen sDisConn OPEN_IN_UNION; + set stuvProps sDisConn ustEmpty; + end; + qed; +`;; + +let ConnectedInduction = theorem `; + ∀α P Q s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ + (∀t a. open_in (subtopology α s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ + (∀a. a ∈ s ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b + + proof + intro_TAC ∀α P Q s, sTop, sConn atOpenImplies_ztPz asImplies_atOpen_xytPxPyQxasImpliesQy, ∀a b, aINs bINs Pa Pb Qa; + assume ¬Q b [NotQb] by fol; + ¬Connected (subtopology α s) [] + proof + simplify sTop ConnectedOpenIn; + exists_TAC + {b | ∃t. open_in (subtopology α s) t ∧ b ∈ t ∧ ∀x. x ∈ t ∧ P x ⇒ Q x}; + exists_TAC + {b | ∃t. open_in (subtopology α s) t ∧ b ∈ t ∧ ∀x. x ∈ t ∧ P x ⇒ ¬(Q x)}; + conj_tac [Left] + proof + ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; + X_genl_TAC c; + rewrite IN_ELIM_THM; + MATCH_MP_TAC MONO_EXISTS; + set atOpenImplies_ztPz; + qed; + conj_tac [Left] + proof + ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; + X_genl_TAC c; + rewrite IN_ELIM_THM; + MATCH_MP_TAC MONO_EXISTS; + set atOpenImplies_ztPz; + qed; + conj_tac [Left] + proof + rewrite SUBSET IN_ELIM_THM IN_UNION; + X_genl_TAC c; intro_TAC cs; + MP_TAC SPECL [c] asImplies_atOpen_xytPxPyQxasImpliesQy; + set cs; + qed; + conj_tac [Right] by set aINs bINs Qa NotQb asImplies_atOpen_xytPxPyQxasImpliesQy Pa Pb; + rewrite EXTENSION IN_INTER NOT_IN_EMPTY IN_ELIM_THM; + X_genl_TAC c; + ONCE_REWRITE_TAC TAUT [∀p. ¬p ⇔ p ⇒ F]; + intro_TAC Qx NotQx; + consider t such that + open_in (subtopology α s) t ∧ c ∈ t ∧ (∀x. x ∈ t ∧ P x ⇒ Q x) [tExists] by fol Qx; + consider u such that + open_in (subtopology α s) u ∧ c ∈ u ∧ (∀x. x ∈ u ∧ P x ⇒ ¬Q x) [uExists] by fol NotQx; + MP_TAC SPECL [t ∩ u; c] atOpenImplies_ztPz; + simplify tExists uExists OPEN_IN_INTER; + set tExists uExists; + qed; + fol sConn -; + qed; +`;; + +let ConnectedEquivalenceRelationGen = theorem `; + ∀α P R s. s ⊂ topspace α ⇒ Connected (subtopology α s) ∧ + (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ + (∀t a. open_in (subtopology α s) t ∧ a ∈ t + ⇒ ∃z. z ∈ t ∧ P z) ∧ + (∀a. a ∈ s + ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b + + proof + intro_TAC ∀α P R s, sTop, sConn Rtrans atOpenImplies_ztPz asImplies_atOpen_xytPxPyImpliesRxy, ∀a b, aINs bINs Pa Pb; + ∀a. a ∈ s ∧ P a ⇒ ∀b c. b ∈ s ∧ c ∈ s ∧ P b ∧ P c ∧ R a b ⇒ R a c [] + proof + intro_TAC ∀[p/a], pINs Pp; + MP_TAC ISPECL [α; P; λx. R p x; s] ConnectedInduction; + rewrite sTop sConn atOpenImplies_ztPz; + fol asImplies_atOpen_xytPxPyImpliesRxy Rtrans; + qed; + fol aINs Pa bINs Pb asImplies_atOpen_xytPxPyImpliesRxy -; + qed; +`;; + +let ConnectedInductionSimple = theorem `; + ∀α P s. s ⊂ topspace α ⇒ + Connected (subtopology α s) ∧ + (∀a. a ∈ s + ⇒ ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b + + proof + intro_TAC ∀α P s, sTop; + MP_TAC ISPECL [α; (λx. T ∨ x ∈ s); P; s] ConnectedInduction; + fol sTop; + qed; +`;; + +let ConnectedEquivalenceRelation = theorem `; + ∀α R s. s ⊂ topspace α ⇒ Connected (subtopology α s)∧ + (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ + (∀a. a ∈ s ⇒ + ∃t. open_in (subtopology α s) t ∧ a ∈ t ∧ ∀x. x ∈ t ⇒ R a x) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ⇒ R a b + + proof + intro_TAC ∀α R s, sTop, sConn Rcomm Rtrans asImplies_atOpen_xtImpliesRax; + ∀a. a ∈ s ⇒ ∀b c. b ∈ s ∧ c ∈ s ∧ R a b ⇒ R a c [] + proof + intro_TAC ∀[p/a], pINs; + MP_TAC ISPECL [α; λx. R p x; s] ConnectedInductionSimple; + rewrite sTop sConn; + fol asImplies_atOpen_xtImpliesRax Rcomm Rtrans; + qed; + fol asImplies_atOpen_xtImpliesRax -; + qed; +`;; + +let LimitPointOf = NewDefinition `; + ∀α s. LimitPointOf α s = {x | s ⊂ topspace α ∧ x ∈ topspace α ∧ + ∀t. x ∈ t ∧ open_in α t ⇒ ∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t}`;; + +let IN_LimitPointOf = theorem `; + ∀α s x. s ⊂ topspace α ⇒ + (x ∈ LimitPointOf α s ⇔ x ∈ topspace α ∧ + ∀t. x ∈ t ∧ open_in α t ⇒ ∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t) + by simplify IN_ELIM_THM LimitPointOf`;; + +let NotLimitPointOf = theorem `; + ∀α s x. s ⊂ topspace α ∧ x ∈ topspace α ⇒ + (x ∉ LimitPointOf α s ⇔ + ∃t. x ∈ t ∧ open_in α t ∧ s ∩ (t ━ {x}) = ∅) + + proof + ONCE_REWRITE_TAC TAUT [∀a b. (a ⇔ b) ⇔ (¬a ⇔ ¬b)]; + simplify ∉ NOT_EXISTS_THM IN_LimitPointOf + TAUT [∀a b. ¬(a ∧ b ∧ c) ⇔ a ∧ b ⇒ ¬c] GSYM MEMBER_NOT_EMPTY IN_INTER IN_DIFF IN_SING; + fol; + qed; +`;; + +let LimptSubset = theorem `; + ∀α s t. t ⊂ topspace α ⇒ + s ⊂ t ⇒ LimitPointOf α s ⊂ LimitPointOf α t + + proof + intro_TAC ∀α s t, tTop, st; + s ⊂ topspace α [sTop] by fol tTop st SUBSET_TRANS; + simplify tTop sTop IN_LimitPointOf SUBSET; + fol st SUBSET; + qed; +`;; + +let ClosedLimpt = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (closed_in α s ⇔ LimitPointOf α s ⊂ s) + + proof + intro_TAC ∀α s, H1; + simplify H1 closed_in; + ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; + simplify H1 IN_LimitPointOf SUBSET IN_DIFF; + AP_TERM_TAC; + ABS_TAC; + fol OPEN_IN_SUBSET SUBSET; + qed; +`;; + +let LimptEmpty = theorem `; + ∀α x. x ∈ topspace α ⇒ x ∉ LimitPointOf α ∅ + by fol EMPTY_SUBSET IN_LimitPointOf OPEN_IN_TOPSPACE NOT_IN_EMPTY ∉`;; + +let NoLimitPointImpClosed = theorem `; + ∀α s. s ⊂ topspace α ⇒ (∀x. x ∉ LimitPointOf α s) ⇒ closed_in α s + by fol ClosedLimpt SUBSET ∉`;; + +let LimitPointUnion = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + LimitPointOf α (s ∪ t) = LimitPointOf α s ∪ LimitPointOf α t + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 UNION_SUBSET; + rewrite EXTENSION IN_UNION; + intro_TAC ∀x; + assume x ∈ topspace α [xTop] by fol H1 stTop IN_LimitPointOf; + ONCE_REWRITE_TAC TAUT [∀a b. (a ⇔ b) ⇔ (¬a ⇔ ¬b)]; + simplify GSYM NOTIN DE_MORGAN_THM H1 stTop NotLimitPointOf xTop; + eq_tac [Left] by set; + MATCH_MP_TAC ExistsTensorInter; + simplify IN_INTER OPEN_IN_INTER; + set; + qed; +`;; + +let Interior_DEF = NewDefinition `; + ∀α s. Interior α s = + {x | s ⊂ topspace α ∧ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s}`;; + +let Interior_THM = theorem `; + ∀α s. s ⊂ topspace α ⇒ Interior α s = + {x | s ⊂ topspace α ∧ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s} + by fol Interior_DEF`;; + +let IN_Interior = theorem `; + ∀α s x. s ⊂ topspace α ⇒ + (x ∈ Interior α s ⇔ ∃t. open_in α t ∧ x ∈ t ∧ t ⊂ s) + by simplify Interior_THM IN_ELIM_THM`;; + +let InteriorEq = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (open_in α s ⇔ s = Interior α s) + + proof + intro_TAC ∀α s, H1; + rewriteL OPEN_IN_SUBOPEN; + simplify EXTENSION H1 IN_Interior; + set; + qed; +`;; + +let InteriorOpen = theorem `; + ∀α s. open_in α s ⇒ Interior α s = s + by fol OPEN_IN_SUBSET InteriorEq`;; + +let InteriorEmpty = theorem `; + ∀α. Interior α ∅ = ∅ + by fol OPEN_IN_EMPTY EMPTY_SUBSET InteriorOpen`;; + +let InteriorUniv = theorem `; + ∀α. Interior α (topspace α) = topspace α + by simplify OpenInTopspace InteriorOpen`;; + +let OpenInterior = theorem `; + ∀α s. s ⊂ topspace α ⇒ open_in α (Interior α s) + + proof + ONCE_REWRITE_TAC OPEN_IN_SUBOPEN; + fol IN_Interior SUBSET; + qed; +`;; + +let InteriorInterior = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Interior α (Interior α s) = Interior α s + by fol OpenInterior InteriorOpen`;; + +let InteriorSubset = theorem `; + ∀α s. s ⊂ topspace α ⇒ Interior α s ⊂ s + + proof + intro_TAC ∀α s, H1; + simplify SUBSET Interior_DEF IN_ELIM_THM; + fol H1 SUBSET; + qed; +`;; + +let InteriorTopspace = theorem `; + ∀α s. s ⊂ topspace α ⇒ Interior α s ⊂ topspace α + by fol SUBSET_TRANS InteriorSubset`;; + +let SubsetInterior = theorem `; + ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ + Interior α s ⊂ Interior α t + by fol SUBSET_TRANS SUBSET IN_Interior SUBSET`;; + +let InteriorMaximal = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + t ⊂ s ∧ open_in α t ⇒ t ⊂ Interior α s + by fol SUBSET IN_Interior SUBSET`;; + +let InteriorMaximalEq = theorem `; + ∀s t. t ⊂ topspace α ⇒ + open_in α s ⇒ (s ⊂ Interior α t ⇔ s ⊂ t) + by fol InteriorMaximal SUBSET_TRANS InteriorSubset`;; + +let InteriorUnique = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + t ⊂ s ∧ open_in α t ∧ (∀t'. t' ⊂ s ∧ open_in α t' ⇒ t' ⊂ t) + ⇒ Interior α s = t + by fol SUBSET_ANTISYM InteriorSubset OpenInterior InteriorMaximal`;; + +let OpenSubsetInterior = theorem `; + ∀α s t. t ⊂ topspace α ⇒ + open_in α s ⇒ (s ⊂ Interior α t ⇔ s ⊂ t) + by fol InteriorMaximal InteriorSubset SUBSET_TRANS`;; + +let InteriorInter = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Interior α (s ∩ t) = Interior α s ∩ Interior α t + + proof + intro_TAC ∀α s t, sTop tTop; + rewrite GSYM SUBSET_ANTISYM_EQ SUBSET_INTER; + conj_tac [Left] by fol sTop tTop SubsetInterior INTER_SUBSET; + s ∩ t ⊂ topspace α [] by fol sTop INTER_SUBSET SUBSET_TRANS; + fol - sTop tTop OpenInterior OPEN_IN_INTER InteriorSubset InteriorMaximal INTER_TENSOR; + qed; +`;; + +let InteriorFiniteInters = theorem `; + ∀α s. FINITE s ⇒ ¬(s = ∅) ⇒ (∀t. t ∈ s ⇒ t ⊂ topspace α) ⇒ + Interior α (INTERS s) = INTERS (IMAGE (Interior α) s) + + proof + intro_TAC ∀α; + MATCH_MP_TAC FINITE_INDUCT; + rewrite INTERS_INSERT IMAGE_CLAUSES IN_INSERT; + intro_TAC ∀x s, sCase, xsNonempty, sSetOfSubsets; + assume ¬(s = ∅) [sNonempty] by simplify INTERS_0 INTER_UNIV IMAGE_CLAUSES; + simplify INTERS_SUBSET sSetOfSubsets InteriorInter sNonempty sSetOfSubsets sCase; + qed; +`;; + +let InteriorIntersSubset = theorem `; + ∀α f. ¬(f = ∅) ∧ (∀t. t ∈ f ⇒ t ⊂ topspace α) ⇒ + Interior α (INTERS f) ⊂ INTERS (IMAGE (Interior α) f) + + proof + intro_TAC ∀α f, H1 H2; + INTERS f ⊂ topspace α [] by set H1 H2; + simplify SUBSET IN_INTERS FORALL_IN_IMAGE - H2 IN_Interior; + fol; + qed; +`;; + +let UnionInteriorSubset = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Interior α s ∪ Interior α t ⊂ Interior α (s ∪ t) + + proof + intro_TAC ∀α s t, sTop tTop; + s ∪ t ⊂ topspace α [] by fol sTop tTop UNION_SUBSET; + fol sTop tTop - OpenInterior OPEN_IN_UNION InteriorMaximal UNION_TENSOR InteriorSubset; + qed; +`;; + +let InteriorEqEmpty = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Interior α s = ∅ ⇔ ∀t. open_in α t ∧ t ⊂ s ⇒ t = ∅) + by fol InteriorMaximal SUBSET_EMPTY OpenInterior SUBSET_REFL InteriorSubset`;; + +let InteriorEqEmptyAlt = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Interior α s = ∅ ⇔ ∀t. open_in α t ∧ ¬(t = ∅) ⇒ ¬(t ━ s = ∅)) + + proof + simplify InteriorEqEmpty; + set; + qed; +`;; + +let InteriorUnionsOpenSubsets = theorem `; + ∀α s. s ⊂ topspace α ⇒ UNIONS {t | open_in α t ∧ t ⊂ s} = Interior α s + + proof + intro_TAC ∀α s, H1; + consider t such that + t = UNIONS {f | open_in α f ∧ f ⊂ s} [tDef] by fol; + t ⊂ s ∧ ∀f. f ⊂ s ∧ open_in α f ⇒ f ⊂ t [] by set tDef; + simplify H1 tDef - OPEN_IN_UNIONS IN_ELIM_THM InteriorUnique; + qed; +`;; + +let InteriorClosedUnionEmptyInterior = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + closed_in α s ∧ Interior α t = ∅ ⇒ + Interior α (s ∪ t) = Interior α s + + proof + intro_TAC ∀α s t, H1 H2, H3 H4; + s ∪ t ⊂ topspace α [stTop] by fol H1 H2 UNION_SUBSET; + Interior α (s ∪ t) ⊂ s [] + proof + simplify SUBSET stTop IN_Interior LEFT_IMP_EXISTS_THM; + X_genl_TAC y O; intro_TAC openO yO Os_t; + consider O' such that O' = (topspace α ━ s) ∩ O [O'def] by fol -; + O' ⊂ t [O't] by set O'def Os_t; + assume y ∉ s [yNOTs] by fol ∉; + y ∈ topspace α ━ s [] by fol openO OPEN_IN_SUBSET yO SUBSET yNOTs IN_DIFF ∉; + y ∈ O' ∧ open_in α O' [] by fol O'def - yO IN_INTER H3 closed_in openO OPEN_IN_INTER; + fol O'def - O't H2 IN_Interior SUBSET MEMBER_NOT_EMPTY H4; + qed; + fol SUBSET_ANTISYM H1 stTop OpenInterior - InteriorMaximal SUBSET_UNION SubsetInterior; + qed; +`;; + +let InteriorUnionEqEmpty = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + closed_in α s ∨ closed_in α t + ⇒ (Interior α (s ∪ t) = ∅ ⇔ Interior α s = ∅ ∧ Interior α t = ∅) + + proof + intro_TAC ∀α s t, H1, H2; + s ⊂ topspace α ∧ t ⊂ topspace α [] by fol H1 UNION_SUBSET; + eq_tac [Left] by fol - H1 SUBSET_UNION SubsetInterior SUBSET_EMPTY; + fol UNION_COMM - H2 InteriorClosedUnionEmptyInterior; + qed; +`;; + +let Closure_DEF = NewDefinition `; + ∀α s. Closure α s = s ∪ LimitPointOf α s`;; + +let Closure_THM = theorem `; + ∀α s. s ⊂ topspace α ⇒ Closure α s = s ∪ LimitPointOf α s + by fol Closure_DEF`;; + +let IN_Closure = theorem `; + ∀α s x. s ⊂ topspace α ⇒ + (x ∈ Closure α s ⇔ x ∈ topspace α ∧ + ∀t. x ∈ t ∧ open_in α t ⇒ ∃y. y ∈ s ∧ y ∈ t) + + proof + intro_TAC ∀α s x, H1; + simplify H1 Closure_THM IN_UNION IN_LimitPointOf; + fol H1 SUBSET; + qed; +`;; + +let ClosureSubset = theorem `; + ∀α s. s ⊂ topspace α ⇒ s ⊂ Closure α s + by fol SUBSET IN_Closure`;; + +let ClosureTopspace = theorem `; + ∀α s. s ⊂ topspace α ⇒ Closure α s ⊂ topspace α + by fol SUBSET IN_Closure`;; + +let ClosureInterior = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Closure α s = topspace α ━ (Interior α (topspace α ━ s)) + + proof + intro_TAC ∀α s, H1; + simplify H1 EXTENSION IN_Closure IN_DIFF IN_Interior SUBSET; + fol OPEN_IN_SUBSET SUBSET; + qed; +`;; + +let InteriorClosure = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Interior α s = topspace α ━ (Closure α (topspace α ━ s)) + by fol SUBSET_DIFF InteriorTopspace DIFF_REFL ClosureInterior`;; + +let ClosedClosure = theorem `; + ∀α s. s ⊂ topspace α ⇒ closed_in α (Closure α s) + by fol closed_in ClosureInterior DIFF_REFL SUBSET_DIFF InteriorTopspace OpenInterior`;; + +let SubsetClosure = theorem `; + ∀α s t. t ⊂ topspace α ⇒ s ⊂ t ⇒ Closure α s ⊂ Closure α t + + proof + intro_TAC ∀α s t, tSubset, st; + s ⊂ topspace α [] by fol tSubset st SUBSET_TRANS; + simplify tSubset - Closure_THM st LimptSubset UNION_TENSOR; + qed; +`;; + +let ClosureHull = theorem `; + ∀α s. s ⊂ topspace α ⇒ Closure α s = (closed_in α) hull s + + proof + intro_TAC ∀α s, H1; + MATCH_MP_TAC GSYM HULL_UNIQUE; + simplify H1 ClosureSubset ClosedClosure Closure_THM UNION_SUBSET; + fol LimptSubset CLOSED_IN_SUBSET ClosedLimpt SUBSET_TRANS; + qed; +`;; + +let ClosureEq = theorem `; + ∀α s. s ⊂ topspace α ⇒ (Closure α s = s ⇔ closed_in α s) + by fol ClosedClosure ClosedLimpt Closure_THM SUBSET_UNION_ABSORPTION UNION_COMM`;; + +let ClosureClosed = theorem `; + ∀α s. closed_in α s ⇒ Closure α s = s + by fol closed_in ClosureEq`;; + +let ClosureClosure = theorem `; + ∀α s. s ⊂ topspace α ⇒ Closure α (Closure α s) = Closure α s + by fol ClosureTopspace ClosureHull HULL_HULL`;; + +let ClosureUnion = theorem `; + ∀α s t. s ∪ t ⊂ topspace α + ⇒ Closure α (s ∪ t) = Closure α s ∪ Closure α t + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 UNION_SUBSET; + simplify H1 stTop Closure_THM LimitPointUnion; + set; + qed; +`;; + +let ClosureInterSubset = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Closure α (s ∩ t) ⊂ Closure α s ∩ Closure α t + by fol SUBSET_INTER INTER_SUBSET SubsetClosure`;; + +let ClosureIntersSubset = theorem `; + ∀α f. (∀s. s ∈ f ⇒ s ⊂ topspace α) ⇒ + Closure α (INTERS f) ⊂ INTERS (IMAGE (Closure α) f) + + proof + intro_TAC ∀α f, H1; + rewrite SET_RULE [s ⊂ INTERS f ⇔ ∀t. t ∈ f ⇒ s ⊂ t] FORALL_IN_IMAGE; + X_genl_TAC s; + intro_TAC sf; + s ⊂ topspace α ∧ INTERS f ⊂ s ∧ INTERS f ⊂ topspace α [] by set H1 sf; + fol SubsetClosure -; + qed; +`;; + +let ClosureMinimal = theorem `; + ∀α s t. s ⊂ t ∧ closed_in α t ⇒ Closure α s ⊂ t + by fol closed_in SubsetClosure ClosureClosed`;; + +let ClosureMinimalEq = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + closed_in α t ⇒ (Closure α s ⊂ t ⇔ s ⊂ t) + by fol closed_in SUBSET_TRANS ClosureSubset ClosureMinimal`;; + +let ClosureUnique = theorem `; + ∀α s t. s ⊂ t ∧ closed_in α t ∧ (∀u. s ⊂ u ∧ closed_in α u ⇒ t ⊂ u) + ⇒ Closure α s = t + by fol closed_in SUBSET_ANTISYM_EQ ClosureMinimal SUBSET_TRANS ClosureSubset ClosedClosure`;; + +let ClosureUniv = theorem `; + ∀α. Closure α (topspace α) = topspace α + by simplify SUBSET_REFL CLOSED_IN_TOPSPACE ClosureEq`;; + +let ClosureEmpty = theorem `; + Closure α ∅ = ∅ + by fol EMPTY_SUBSET CLOSED_IN_EMPTY ClosureClosed`;; + +let ClosureUnions = theorem `; + ∀α f. FINITE f ⇒ (∀ t. t ∈ f ⇒ t ⊂ topspace α) ⇒ + Closure α (UNIONS f) = UNIONS {Closure α t | t ∈ f} + + proof + intro_TAC ∀α; + MATCH_MP_TAC FINITE_INDUCT; + rewrite UNIONS_0 SET_RULE [{f x | x ∈ ∅} = ∅] ClosureEmpty UNIONS_INSERT + SET_RULE [{f x | x ∈ a INSERT t} = (f a) INSERT {f x | x ∈ t}] IN_INSERT; + fol UNION_SUBSET UNIONS_SUBSET IN_UNIONS ClosureUnion; + qed; +`;; + +let ClosureEqEmpty = theorem `; + ∀α s. s ⊂ topspace α ⇒ (Closure α s = ∅ ⇔ s = ∅) + by fol ClosureEmpty ClosureSubset SUBSET_EMPTY`;; + +let ClosureSubsetEq = theorem `; + ∀α s. s ⊂ topspace α ⇒ (Closure α s ⊂ s ⇔ closed_in α s) + by fol ClosureEq ClosureSubset SUBSET_ANTISYM`;; + +let OpenInterClosureEqEmpty = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + open_in α s ⇒ (s ∩ Closure α t = ∅ ⇔ s ∩ t = ∅) + + proof + intro_TAC ∀α s t, H1 H2, H3; + eq_tac [Left] by fol H2 ClosureSubset INTER_TENSOR SUBSET_REFL SUBSET_EMPTY; + intro_TAC stDisjoint; + s ⊂ Interior α (topspace α ━ t) [] by fol H2 SUBSET_DIFF H3 H1 H2 stDisjoint SUBSET_COMPLEMENT OpenSubsetInterior; + fol H1 H2 InteriorTopspace - COMPLEMENT_DISJOINT H2 ClosureInterior; + qed; +`;; + +let OpenInterClosureSubset = theorem `; + ∀α s t. t ⊂ topspace α ⇒ + open_in α s ⇒ s ∩ Closure α t ⊂ Closure α (s ∩ t) + + proof + intro_TAC ∀α s t, tTop, sOpen; + s ⊂ topspace α [sTop] by fol OPEN_IN_SUBSET sOpen; + s ∩ t ⊂ topspace α [stTop] by fol sTop sTop INTER_SUBSET SUBSET_TRANS; + simplify tTop - Closure_THM UNION_OVER_INTER SUBSET_UNION SUBSET_UNION; + s ∩ LimitPointOf α t ⊂ LimitPointOf α (s ∩ t) [] + proof + simplify SUBSET IN_INTER tTop stTop IN_LimitPointOf; + X_genl_TAC x; intro_TAC xs xTop xLIMt; + X_genl_TAC O; intro_TAC xO Oopen; + x ∈ O ∩ s ∧ open_in α (O ∩ s) [xOsOpen] by fol xs xO IN_INTER Oopen sOpen OPEN_IN_INTER; + fol xOsOpen xLIMt IN_INTER; + qed; + simplify - UNION_TENSOR SUBSET_REFL; + qed; +`;; + +let ClosureOpenInterSuperset = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + open_in α s ∧ s ⊂ Closure α t ⇒ Closure α (s ∩ t) = Closure α s + + proof + intro_TAC ∀α s t, sTop tTop, sOpen sSUBtC; + s ∩ t ⊂ topspace α [stTop] by fol INTER_SUBSET sTop SUBSET_TRANS; + MATCH_MP_TAC SUBSET_ANTISYM; + conj_tac [Left] by fol sTop INTER_SUBSET SubsetClosure; + s ⊂ Closure α (s ∩ t) [] by fol tTop sOpen OpenInterClosureSubset SUBSET_REFL sSUBtC SUBSET_INTER SUBSET_TRANS; + fol stTop - ClosedClosure ClosureMinimal; + qed; +`;; + +let ClosureComplement = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Closure α (topspace α ━ s) = topspace α ━ Interior α s + by fol InteriorClosure SUBSET_DIFF ClosureTopspace DIFF_REFL`;; + +let InteriorComplement = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Interior α (topspace α ━ s) = topspace α ━ Closure α s + by fol SUBSET_DIFF InteriorTopspace DIFF_REFL ClosureInterior DIFF_REFL`;; + +let ClosureInteriorComplement = theorem `; + ∀α s. s ⊂ topspace α ⇒ + topspace α ━ Closure α (Interior α s) + = Interior α (Closure α (topspace α ━ s)) + by fol InteriorTopspace InteriorComplement ClosureComplement`;; + +let InteriorClosureComplement = theorem `; + ∀α s. s ⊂ topspace α ⇒ + topspace α ━ Interior α (Closure α s) + = Closure α (Interior α (topspace α ━ s)) + by fol ClosureTopspace SUBSET_TRANS InteriorComplement ClosureComplement`;; + +let ConnectedIntermediateClosure = theorem `; + ∀α s t. s ⊂ topspace α ⇒ + Connected (subtopology α s) ∧ s ⊂ t ∧ t ⊂ Closure α s + ⇒ Connected (subtopology α t) + + proof + intro_TAC ∀α s t, sTop, sCon st tCs; + t ⊂ topspace α [tTop] by fol tCs sTop ClosureTopspace SUBSET_TRANS; + simplify tTop ConnectedSubtopology_ALT; + X_genl_TAC u v; + intro_TAC uOpen vOpen t_uv uvtEmpty; + u ⊂ topspace α ∧ v ⊂ topspace α [uvTop] by fol uOpen vOpen OPEN_IN_SUBSET; + u ∩ s = ∅ ∨ v ∩ s = ∅ [] by fol sTop uvTop uOpen vOpen st t_uv uvtEmpty SUBSET_TRANS SUBSET_REFL INTER_TENSOR SUBSET_EMPTY sCon ConnectedSubtopology_ALT; + s ⊂ topspace α ━ u ∨ s ⊂ topspace α ━ v [] by fol - sTop uvTop INTER_COMM SUBSET_COMPLEMENT; + t ⊂ topspace α ━ u ∨ t ⊂ topspace α ━ v [] by fol SUBSET_DIFF - uvTop uOpen vOpen OPEN_IN_CLOSED_IN ClosureMinimal tCs SUBSET_TRANS; + fol tTop uvTop - SUBSET_COMPLEMENT INTER_COMM; + qed; +`;; + +let ConnectedClosure = theorem `; + ∀α s. s ⊂ topspace α ⇒ Connected (subtopology α s) ⇒ + Connected (subtopology α (Closure α s)) + by fol ClosureTopspace ClosureSubset SUBSET_REFL ConnectedIntermediateClosure`;; + +let ConnectedUnionStrong = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Connected (subtopology α s) ∧ Connected (subtopology α t) ∧ + ¬(Closure α s ∩ t = ∅) + ⇒ Connected (subtopology α (s ∪ t)) + + proof + intro_TAC ∀α s t, sTop tTop, H2 H3 H4; + consider p s' such that + p ∈ Closure α s ∧ p ∈ t ∧ s' = p ╪ s [pCst] by fol H4 MEMBER_NOT_EMPTY IN_INTER; + s ⊂ s' ∧ s' ⊂ Closure α s [s_ps_Cs] by fol IN_INSERT SUBSET pCst sTop ClosureSubset INSERT_SUBSET; + Connected (subtopology α (s')) [s'Con] by fol sTop H2 s_ps_Cs ConnectedIntermediateClosure; + s ∪ t = s' ∪ t ∧ ¬(s' ∩ t = ∅) [] by fol pCst INSERT_UNION IN_INSERT IN_INTER MEMBER_NOT_EMPTY; + fol s_ps_Cs sTop ClosureTopspace SUBSET_TRANS tTop - s'Con H3 ConnectedUnion; + qed; +`;; + +let InteriorDiff = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Interior α (s ━ t) = Interior α s ━ Closure α t + by fol ClosureTopspace InteriorTopspace COMPLEMENT_INTER_DIFF InteriorComplement SUBSET_DIFF InteriorInter`;; + +let ClosedInLimpt = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + (closed_in (subtopology α t) s ⇔ + s ⊂ t ∧ LimitPointOf α s ∩ t ⊂ s) + + proof + intro_TAC ∀α s t, H1 H2; + simplify H2 ClosedInSubtopology; + eq_tac [Right] + proof + intro_TAC sSUBt LIMstSUBs; + exists_TAC Closure α s; + simplify H1 ClosedClosure Closure_THM INTER_COMM UNION_OVER_INTER; + set sSUBt LIMstSUBs; + qed; + rewrite LEFT_IMP_EXISTS_THM; X_genl_TAC D; intro_TAC Dexists; + LimitPointOf α (D ∩ t) ⊂ D [] by fol Dexists CLOSED_IN_SUBSET INTER_SUBSET LimptSubset ClosedLimpt SUBSET_TRANS; + fol Dexists INTER_SUBSET - SUBSET_REFL INTER_TENSOR; + qed; +`;; + +let ClosedInLimpt_ALT = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + (closed_in (subtopology α t) s ⇔ + s ⊂ t ∧ ∀x. x ∈ LimitPointOf α s ∧ x ∈ t ⇒ x ∈ s) + by simplify SUBSET IN_INTER ClosedInLimpt`;; + +let ClosedInInterClosure = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + (closed_in (subtopology α s) t ⇔ s ∩ Closure α t = t) + + proof simplify Closure_THM ClosedInLimpt; set; qed; +`;; + +let InteriorClosureIdemp = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Interior α (Closure α (Interior α (Closure α s))) + = Interior α (Closure α s) + + proof + intro_TAC ∀α s, H1; + consider IC CIC such that + IC = Interior α (Closure α s) ∧ CIC = Closure α IC [CICdef] by fol; + Closure α s ⊂ topspace α [Ctop] by fol H1 ClosureTopspace; + IC ⊂ topspace α [ICtop] by fol CICdef - H1 InteriorTopspace; + CIC ⊂ topspace α [CICtop] by fol CICdef - ClosureTopspace; + IC ⊂ CIC [ICsubCIC] by fol CICdef ICtop ClosureSubset; + ∀u. u ⊂ CIC ∧ open_in α u ⇒ u ⊂ IC [] by fol CICdef Ctop InteriorSubset SubsetClosure H1 ClosureClosure SUBSET_TRANS OpenSubsetInterior; + fol CICdef CICtop ICsubCIC Ctop OpenInterior - InteriorUnique; + qed; +`;; + +let InteriorClosureIdemp = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Interior α (Closure α (Interior α (Closure α s))) + = Interior α (Closure α s) + + proof + intro_TAC ∀α s, H1; + Closure α s ⊂ topspace α [Ctop] by fol H1 ClosureTopspace; + consider IC CIC such that + IC = Interior α (Closure α s) ∧ CIC = Closure α IC [ICdefs] by fol; + IC ⊂ topspace α [] by fol - Ctop H1 InteriorTopspace; + CIC ⊂ topspace α ∧ IC ⊂ CIC ∧ ∀u. u ⊂ CIC ∧ open_in α u ⇒ u ⊂ IC [] by fol ICdefs Ctop - ClosureTopspace ClosureSubset InteriorSubset SubsetClosure H1 ClosureClosure SUBSET_TRANS OpenSubsetInterior; + fol ICdefs - Ctop OpenInterior InteriorUnique; + qed; +`;; + +let ClosureInteriorIdemp = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Closure α (Interior α (Closure α (Interior α s))) + = Closure α (Interior α s) + + proof + intro_TAC ∀α s, H1; + consider t such that t = topspace α ━ s [tDef] by fol; + t ⊂ topspace α ∧ s = topspace α ━ t [tProps] by fol - H1 SUBSET_DIFF DIFF_REFL; + Interior α (Closure α t) ⊂ topspace α [] by fol - ClosureTopspace InteriorTopspace; + simplify tProps - GSYM InteriorClosureComplement InteriorClosureIdemp; + qed; +`;; + +let InteriorClosureDiffSpaceEmpty = theorem `; + ∀α s. s ⊂ topspace α ⇒ Interior α (Closure α s ━ s) = ∅ + + proof + intro_TAC ∀α s, H1; + Closure α s ━ s ⊂ topspace α [Cs_sTop] by fol H1 ClosureTopspace SUBSET_DIFF SUBSET_TRANS; + assume ¬(Interior α (Closure α s ━ s) = ∅) [Contradiction] by fol; + consider x such that + x ∈ (Interior α (Closure α s ━ s)) [xExists] by fol - MEMBER_NOT_EMPTY; + consider t such that + open_in α t ∧ x ∈ t ∧ t ⊂ (s ∪ LimitPointOf α s) ━ s [tProps] by fol - Cs_sTop IN_Interior Closure_DEF; + t ⊂ LimitPointOf α s ∧ s ∩ (t ━ {x}) = ∅ [tSubLIMs] by set -; + x ∈ LimitPointOf α s ∧ x ∉ s [xLims] by fol tProps - SUBSET IN_DIFF ∉; + fol H1 xLims IN_LimitPointOf tProps tSubLIMs NotLimitPointOf ∉; + qed; +`;; + +let NowhereDenseUnion = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + (Interior α (Closure α (s ∪ t)) = ∅ ⇔ + Interior α (Closure α s) = ∅ ∧ Interior α (Closure α t) = ∅) + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α [] by fol H1 UNION_SUBSET; + simplify H1 - ClosureUnion ClosureTopspace UNION_SUBSET ClosedClosure InteriorUnionEqEmpty; + qed; +`;; + +let NowhereDense = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (Interior α (Closure α s) = ∅ ⇔ + ∀t. open_in α t ∧ ¬(t = ∅) ⇒ + ∃u. open_in α u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅) + + proof + intro_TAC ∀α s, H1; + simplify H1 ClosureTopspace InteriorEqEmptyAlt; + eq_tac [Left] + proof + intro_TAC H2; + X_genl_TAC t; + intro_TAC tOpen tNonempty; + exists_TAC t ━ Closure α s; + fol tOpen H1 ClosedClosure OPEN_IN_DIFF tOpen tNonempty H2 SUBSET_DIFF H1 ClosureSubset + SET_RULE [∀s t A. s ⊂ t ⇒ (A ━ t) ∩ s = ∅]; + qed; + intro_TAC H2; + X_genl_TAC t; + intro_TAC tOpen tNonempty; + consider u such that + open_in α u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅ [uExists] by simplify tOpen tNonempty H2; + MP_TAC ISPECL [α; u; s] OpenInterClosureEqEmpty; + simplify uExists OPEN_IN_SUBSET H1; + set uExists; + qed; +`;; + +let InteriorClosureInterOpen = theorem `; + ∀α s t. open_in α s ∧ open_in α t ⇒ + Interior α (Closure α (s ∩ t)) = + Interior α (Closure α s) ∩ Interior α (Closure α t) + + proof + intro_TAC ∀α s t, sOpen tOpen; + s ⊂ topspace α [sTop] by fol sOpen OPEN_IN_SUBSET; + t ⊂ topspace α [tTop] by fol tOpen OPEN_IN_SUBSET; + rewrite SET_RULE [∀s t u. u = s ∩ t ⇔ s ∩ t ⊂ u ∧ u ⊂ s ∧ u ⊂ t]; + simplify sTop tTop INTER_SUBSET SubsetClosure ClosureTopspace SubsetInterior; + s ∩ t ⊂ topspace α [stTop] by fol INTER_SUBSET sTop SUBSET_TRANS; + Closure α s ⊂ topspace α ∧ Closure α t ⊂ topspace α [CsCtTop] by fol sTop tTop ClosureTopspace; + Closure α s ∩ Closure α t ⊂ topspace α [CsIntCtTop] by fol - INTER_SUBSET SUBSET_TRANS; + Closure α s ━ s ∪ Closure α t ━ t ⊂ topspace α [Cs_sUNIONCt_tTop] by fol CsCtTop SUBSET_DIFF UNION_SUBSET SUBSET_TRANS; + simplify CsCtTop GSYM InteriorInter; + Interior α (Closure α s ∩ Closure α t) ⊂ Closure α (s ∩ t) [] + proof + simplify CsIntCtTop InteriorTopspace ISPECL [topspace α] COMPLEMENT_DISJOINT stTop ClosureTopspace GSYM ClosureComplement GSYM InteriorComplement CsIntCtTop SUBSET_DIFF GSYM InteriorInter; + closed_in α (Closure α s ━ s) ∧ closed_in α (Closure α t ━ t) [] by fol sTop tTop ClosedClosure sOpen tOpen CLOSED_IN_DIFF; + Interior α (Closure α s ━ s ∪ Closure α t ━ t) = ∅ [IntEmpty] by fol Cs_sUNIONCt_tTop - sTop tTop InteriorClosureDiffSpaceEmpty InteriorUnionEqEmpty; + Closure α s ∩ Closure α t ∩ (topspace α ━ (s ∩ t)) ⊂ + Closure α s ━ s ∪ Closure α t ━ t [] by set; + fol Cs_sUNIONCt_tTop - SubsetInterior IntEmpty INTER_ACI SUBSET_EMPTY; + qed; + fol stTop ClosureTopspace - CsIntCtTop OpenInterior InteriorMaximal; + qed; +`;; + +let ClosureInteriorUnionClosed = theorem `; + ∀α s t. closed_in α s ∧ closed_in α t ⇒ + Closure α (Interior α (s ∪ t)) = + Closure α (Interior α s) ∪ Closure α (Interior α t) + + proof + rewrite closed_in; + intro_TAC ∀α s t, sClosed tClosed; + simplify sClosed tClosed ClosureTopspace UNION_SUBSET InteriorTopspace ISPECL [topspace α] COMPLEMENT_DUALITY_UNION; + simplify sClosed tClosed UNION_SUBSET ClosureTopspace InteriorTopspace ClosureInteriorComplement DIFF_UNION SUBSET_DIFF InteriorClosureInterOpen; + qed; +`;; + +let RegularOpenInter = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Interior α (Closure α s) = s ∧ Interior α (Closure α t) = t + ⇒ Interior α (Closure α (s ∩ t)) = s ∩ t + by fol ClosureTopspace OpenInterior InteriorClosureInterOpen`;; + +let RegularClosedUnion = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Closure α (Interior α s) = s ∧ Closure α (Interior α t) = t + ⇒ Closure α (Interior α (s ∪ t)) = s ∪ t + by fol InteriorTopspace ClosureInteriorUnionClosed ClosedClosure`;; + +let DiffClosureSubset = theorem `; + ∀α s t. s ⊂ topspace α ∧ t ⊂ topspace α ⇒ + Closure α s ━ Closure α t ⊂ Closure α (s ━ t) + + proof + intro_TAC ∀α s t, sTop tTop; + Closure α s ━ Closure α t ⊂ Closure α (s ━ Closure α t) [] by fol sTop ClosureTopspace tTop ClosedClosure tTop closed_in OpenInterClosureSubset INTER_COMM COMPLEMENT_INTER_DIFF; + fol - tTop ClosureSubset SUBSET_DUALITY sTop SUBSET_DIFF SUBSET_TRANS SubsetClosure; + qed; +`;; + +let Frontier_DEF = NewDefinition `; + ∀α s. Frontier α s = Closure α s ━ Interior α s`;; + +let Frontier_THM = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α s = Closure α s ━ Interior α s + by fol Frontier_DEF`;; + +let FrontierTopspace = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α s ⊂ topspace α + by fol Frontier_THM SUBSET_DIFF ClosureTopspace SUBSET_TRANS`;; + +let FrontierClosed = theorem `; + ∀α s. s ⊂ topspace α ⇒ closed_in α (Frontier α s) + by simplify Frontier_THM ClosedClosure OpenInterior CLOSED_IN_DIFF`;; + +let FrontierClosures = theorem `; + ∀s. s ⊂ topspace α ⇒ + Frontier α s = (Closure α s) ∩ (Closure α (topspace α ━ s)) + by simplify SET_RULE [∀A s t. s ⊂ A ∧ t ⊂ A ⇒ s ━ (A ━ t) = s ∩ t] Frontier_THM InteriorClosure ClosureTopspace SUBSET_DIFF`;; + +let FrontierStraddle = theorem `; + ∀α a s. s ⊂ topspace α ⇒ (a ∈ Frontier α s ⇔ + a ∈ topspace α ∧ ∀t. open_in α t ∧ a ∈ t ⇒ + (∃x. x ∈ s ∧ x ∈ t) ∧ (∃x. ¬(x ∈ s) ∧ x ∈ t)) + + proof + simplify SUBSET_DIFF FrontierClosures IN_INTER SUBSET_DIFF IN_Closure IN_DIFF; + fol OPEN_IN_SUBSET SUBSET; + qed; +`;; + +let FrontierSubsetClosed = theorem `; + ∀α s. closed_in α s ⇒ (Frontier α s) ⊂ s + by fol closed_in Frontier_THM ClosureClosed SUBSET_DIFF`;; + +let FrontierEmpty = theorem `; + ∀α. Frontier α ∅ = ∅ + by fol Frontier_THM EMPTY_SUBSET ClosureEmpty EMPTY_DIFF`;; + +let FrontierUniv = theorem `; + ∀α. Frontier α (topspace α) = ∅ + by fol Frontier_DEF ClosureUniv InteriorUniv DIFF_EQ_EMPTY`;; + +let FrontierSubsetEq = theorem `; + ∀α s. s ⊂ topspace α ⇒ ((Frontier α s) ⊂ s ⇔ closed_in α s) + + proof + intro_TAC ∀α s, sTop; + eq_tac [Right] by fol FrontierSubsetClosed; + simplify sTop Frontier_THM ; + fol sTop InteriorSubset SET_RULE [∀s t u. s ━ t ⊂ u ∧ t ⊂ u ⇒ s ⊂ u] ClosureSubsetEq; + qed; +`;; + +let FrontierComplement = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α (topspace α ━ s) = Frontier α s + + proof + intro_TAC ∀α s, sTop; + simplify sTop SUBSET_DIFF Frontier_THM ClosureComplement InteriorComplement; + fol sTop InteriorTopspace ClosureTopspace SET_RULE [∀ Top Int Clo. + Int ⊂ Top ∧ Clo ⊂ Top ⇒ Top ━ Int ━ (Top ━ Clo) = Clo ━ Int]; + qed; +`;; + +let FrontierComplement = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α (topspace α ━ s) = Frontier α s + + proof + intro_TAC ∀α s, sTop; + simplify sTop SUBSET_DIFF Frontier_THM ClosureComplement InteriorComplement; + fol sTop InteriorTopspace ClosureTopspace SET_RULE [∀ Top Int Clo. + Int ⊂ Top ∧ Clo ⊂ Top ⇒ Top ━ Int ━ (Top ━ Clo) = Clo ━ Int]; + qed; +`;; + +let FrontierDisjointEq = theorem `; + ∀α s. s ⊂ topspace α ⇒ ((Frontier α s) ∩ s = ∅ ⇔ open_in α s) + + proof + intro_TAC ∀α s, sTop; + topspace α ━ s ⊂ topspace α [COMPsTop] by fol sTop SUBSET_DIFF; + simplify sTop GSYM FrontierComplement OPEN_IN_CLOSED_IN; + fol COMPsTop GSYM FrontierSubsetEq FrontierTopspace SUBSET_COMPLEMENT; + qed; +`;; + +let FrontierInterSubset = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ Frontier α (s ∩ t) ⊂ Frontier α s ∪ Frontier α t + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + simplify - Frontier_THM InteriorInter DIFF_INTER INTER_SUBSET SubsetClosure DIFF_SUBSET UNION_TENSOR; + qed; +`;; + +let FrontierUnionSubset = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + Frontier α (s ∪ t) ⊂ Frontier α s ∪ Frontier α t + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION SUBSET_TRANS; + simplify H1 - GSYM FrontierComplement DIFF_UNION; + topspace α ━ s ∪ topspace α ━ t ⊂ topspace α [] by fol SUBSET_DIFF UNION_SUBSET SUBSET_TRANS; + fol - FrontierInterSubset; + qed; +`;; + +let FrontierInteriors = theorem `; + ∀α s. s ⊂ topspace α ⇒ + Frontier α s = topspace α ━ Interior α s ━ Interior α (topspace α ━ s) + by simplify Frontier_THM ClosureInterior DOUBLE_DIFF_UNION UNION_COMM`;; + +let FrontierFrontierSubset = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α (Frontier α s) ⊂ Frontier α s + by fol FrontierTopspace Frontier_THM FrontierClosed ClosureClosed SUBSET_DIFF`;; + +let InteriorFrontier = theorem `; + ∀α s. s ⊂ topspace α ⇒ Interior α (Frontier α s) = + Interior α (Closure α s) ━ Closure α (Interior α s) + + proof + intro_TAC ∀α s, sTop; + Frontier α s = Closure α s ∩ (topspace α ━ Interior α s) [] by fol sTop Frontier_THM ClosureTopspace COMPLEMENT_INTER_DIFF; + Interior α (Frontier α s) = + Interior α (Closure α s) ∩ (topspace α ━ Closure α (Interior α s)) [] by fol - sTop ClosureTopspace InteriorTopspace SUBSET_DIFF InteriorInter InteriorComplement; + fol - sTop ClosureTopspace InteriorTopspace COMPLEMENT_INTER_DIFF; + qed; +`;; + +let InteriorFrontierEmpty = theorem `; + ∀α s. open_in α s ∨ closed_in α s ⇒ Interior α (Frontier α s) = ∅ + by fol InteriorFrontier SET_RULE [∀s t. s ━ t = ∅ ⇔ s ⊂ t] OPEN_IN_SUBSET closed_in + InteriorOpen ClosureTopspace InteriorSubset + ClosureClosed InteriorTopspace ClosureSubset`;; + +let FrontierFrontier = theorem `; + ∀α s. open_in α s ∨ closed_in α s ⇒ + Frontier α (Frontier α s) = Frontier α s + + proof + intro_TAC ∀α s, openORclosed; + s ⊂ topspace α [sTop] by fol openORclosed OPEN_IN_SUBSET closed_in; + Frontier α (Frontier α s) = Closure α (Frontier α s) [] by fol sTop FrontierTopspace Frontier_THM openORclosed InteriorFrontierEmpty DIFF_EMPTY; + fol - sTop FrontierClosed ClosureClosed; + qed; +`;; + +let UnionFrontierPart1 = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + Frontier α s ∩ Interior α t ⊂ Frontier α (s ∩ t) + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + rewrite SUBSET IN_INTER; + X_genl_TAC a; intro_TAC aFs aIt; + consider O such that + open_in α O ∧ a ∈ O ∧ O ⊂ t [aOs] by fol aIt stTop IN_Interior; + a ∈ topspace α [] by fol stTop aFs FrontierTopspace SUBSET; + simplify stTop FrontierStraddle -; + X_genl_TAC P; intro_TAC Popen aP; + a ∈ O ∩ P ∧ open_in α (O ∩ P) [aOPopen] by fol aOs aP IN_INTER Popen OPEN_IN_INTER; + consider x y such that + x ∈ s ∧ x ∈ O ∩ P ∧ ¬(y ∈ s) ∧ y ∈ O ∩ P [xExists] by fol aOs Popen OPEN_IN_INTER aOPopen stTop aFs FrontierStraddle; + fol xExists aOs IN_INTER SUBSET; + qed; +`;; + +let UnionFrontierPart2 = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + Frontier α s ━ Frontier α t ⊂ + Frontier α (s ∩ t) ∪ Frontier α (s ∪ t) + + proof + intro_TAC ∀α s t, stTop; + s ⊂ topspace α ∧ t ⊂ topspace α [] by fol stTop SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + Frontier α s ━ Frontier α t = Frontier α s ∩ Interior α t ∪ + Frontier α (topspace α ━ s) ∩ Interior α (topspace α ━ t) [] by fol - FrontierTopspace FrontierInteriors FrontierComplement + SET_RULE [∀A s t u. s ⊂ A ⇒ s ━ (A ━ t ━ u) = s ∩ t ∪ s ∩ u]; + Frontier α s ━ Frontier α t ⊂ + Frontier α (s ∩ t) ∪ Frontier α (topspace α ━ (s ∪ t)) [] by simplify - stTop UnionFrontierPart1 UNION_TENSOR SUBSET_DIFF UNION_SUBSET DIFF_UNION; + fol - stTop FrontierComplement; + qed; +`;; + +let UnionFrontierPart3 = theorem `; + ∀α s t a. s ∪ t ⊂ topspace α ⇒ + a ∈ Frontier α s ∧ a ∉ Frontier α t ⇒ + a ∈ Frontier α (s ∩ t) ∨ a ∈ Frontier α (s ∪ t) + + proof + intro_TAC ∀α s t a, H1; + rewrite ∉ GSYM IN_INTER GSYM IN_DIFF GSYM IN_UNION; + fol H1 UnionFrontierPart2 SUBSET; + qed; +`;; + +let UnionFrontier = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + Frontier α s ∪ Frontier α t = + Frontier α (s ∪ t) ∪ Frontier α (s ∩ t) ∪ Frontier α s ∩ Frontier α t + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + rewrite GSYM SUBSET_ANTISYM_EQ; + conj_tac [Right] by fol SET_RULE [∀s t. s ∩ t ⊂ s ∪ t] stTop FrontierUnionSubset UNION_SUBSET FrontierInterSubset; + rewrite SUBSET IN_INTER IN_UNION; + fol H1 UnionFrontierPart3 INTER_COMM UNION_COMM ∉; + qed; +`;; + +let ConnectedInterFrontier = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + Connected (subtopology α s) ∧ ¬(s ∩ t = ∅) ∧ ¬(s ━ t = ∅) + ⇒ ¬(s ∩ Frontier α t = ∅) + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION SUBSET_TRANS; + ONCE_REWRITE_TAC TAUT [∀a b c d. a ∧ b ∧ c ⇒ ¬d ⇔ b ∧ c ∧ d ⇒ ¬a]; + intro_TAC sINTERtNonempty sDIFFtNonempty sInterFtEmpty; + simplify stTop ConnectedOpenIn; + exists_TAC s ∩ Interior α t; + exists_TAC s ∩ Interior α (topspace α ━ t); + simplify stTop SUBSET_DIFF OpenInterior OpenInOpenInter; + Interior α t ⊂ t ∧ Interior α (topspace α ━ t) ⊂ topspace α ━ t [IntSubs] by fol stTop SUBSET_DIFF InteriorSubset; + s ⊂ Interior α t ∪ Interior α (topspace α ━ t) [] by fol stTop sInterFtEmpty FrontierInteriors DOUBLE_DIFF_UNION COMPLEMENT_DISJOINT; + set sDIFFtNonempty sINTERtNonempty IntSubs -; + qed; +`;; + +let InteriorClosedEqEmptyAsFrontier = theorem `; + ∀α s. s ⊂ topspace α ⇒ + (closed_in α s ∧ Interior α s = ∅ ⇔ ∃t. open_in α t ∧ s = Frontier α t) + + proof + intro_TAC ∀α s, sTop; + eq_tac [Right] by fol OPEN_IN_SUBSET FrontierClosed InteriorFrontierEmpty; + intro_TAC sClosed sEmptyInt; + exists_TAC topspace α ━ s; + fol sClosed closed_in sTop FrontierComplement Frontier_THM sEmptyInt DIFF_EMPTY ClosureClosed; + qed; +`;; + +let ClosureUnionFrontier = theorem `; + ∀α s. s ⊂ topspace α ⇒ Closure α s = s ∪ Frontier α s + + proof + intro_TAC ∀α s, sTop; + simplify sTop Frontier_THM; + s ⊂ Closure α s ∧ Interior α s ⊂ s [] by fol sTop ClosureSubset InteriorSubset; + set -; + qed; +`;; + +let FrontierInteriorSubset = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α (Interior α s) ⊂ Frontier α s + by simplify InteriorTopspace Frontier_THM InteriorInterior InteriorSubset SubsetClosure DIFF_SUBSET`;; + +let FrontierClosureSubset = theorem `; + ∀α s. s ⊂ topspace α ⇒ Frontier α (Closure α s) ⊂ Frontier α s + by simplify ClosureTopspace Frontier_THM ClosureClosure ClosureTopspace ClosureSubset SubsetInterior SUBSET_DUALITY`;; + +let SetDiffFrontier = theorem `; + ∀α s. s ⊂ topspace α ⇒ s ━ Frontier α s = Interior α s + + proof + intro_TAC ∀α s, sTop; + simplify sTop Frontier_THM; + s ⊂ Closure α s ∧ Interior α s ⊂ s [] by fol sTop ClosureSubset InteriorSubset; + set -; + qed; +`;; + +let FrontierInterSubsetInter = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ + Frontier α (s ∩ t) ⊂ + Closure α s ∩ Frontier α t ∪ Frontier α s ∩ Closure α t + + proof + intro_TAC ∀α s t, H1; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + simplify H1 stTop Frontier_THM InteriorInter; + Closure α (s ∩ t) ⊂ Closure α s ∩ Closure α t [] by fol stTop ClosureInterSubset; + set -; + qed; +`;; + +let FrontierUnionPart1 = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ + ⇒ Frontier α s ∩ Interior α (s ∪ t) = ∅ + + proof + intro_TAC ∀α s t, H1, CsCtDisjoint; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + Frontier α s ∩ Interior α (s ∪ t) ⊂ topspace α [FIstTop] by fol stTop FrontierTopspace INTER_SUBSET SUBSET_TRANS; + Frontier α s ∩ Interior α (s ∪ t) ∩ (topspace α ━ Closure α t) = ∅ [] + proof + simplify stTop GSYM InteriorComplement H1 SUBSET_DIFF InteriorInter Frontier_THM; + Interior α (s ∪ t) ∩ Interior α (topspace α ━ t) ⊂ Interior α s [] by + fol SET_RULE [∀A s t. s ⊂ A ⇒ (s ∪ t) ∩ (A ━ t) = s ━ t] H1 SUBSET_DIFF InteriorInter stTop SubsetInterior; + set -; + qed; + Frontier α s ∩ Interior α (s ∪ t) ⊂ Closure α t [] by fol H1 CsCtDisjoint - FIstTop COMPLEMENT_DISJOINT INTER_ACI; + fol SET_RULE [∀ s t F I. s ∩ t = ∅ ∧ F ⊂ s ∧ F ∩ I ⊂ t ⇒ F ∩ I = ∅] CsCtDisjoint stTop Frontier_THM SUBSET_DIFF -; + qed; +`;; + +let FrontierUnion = theorem `; + ∀α s t. s ∪ t ⊂ topspace α ⇒ Closure α s ∩ Closure α t = ∅ + ⇒ Frontier α (s ∪ t) = Frontier α s ∪ Frontier α t + + proof + intro_TAC ∀α s t, H1, CsCtDisjoint; + s ⊂ topspace α ∧ t ⊂ topspace α ∧ s ∩ t ⊂ topspace α [stTop] by fol H1 SUBSET_UNION INTER_SUBSET SUBSET_TRANS; + MATCH_MP_TAC SUBSET_ANTISYM; + simplify H1 FrontierUnionSubset Frontier_THM; + Frontier α s ∩ Interior α (s ∪ t) = ∅ ∧ + Frontier α t ∩ Interior α (s ∪ t) = ∅ [usePart1] by fol H1 CsCtDisjoint FrontierUnionPart1 INTER_COMM UNION_COMM; + Frontier α s ⊂ Closure α (s ∪ t) ∧ Frontier α t ⊂ Closure α (s ∪ t) [] by fol stTop Frontier_THM SUBSET_DIFF H1 SUBSET_UNION SubsetClosure SUBSET_TRANS; + set usePart1 -; + qed; +`;; + +(* ------------------------------------------------------------------------- *) +(* The universal Euclidean versions are what we use most of the time. *) +(* ------------------------------------------------------------------------- *) + +let open_def = NewDefinition `; + open s ⇔ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ∀x'. dist(x',x) < e ⇒ x' ∈ s`;; + +let closed = NewDefinition `; + closed s ⇔ open (UNIV ━ s)`;; + +let euclidean = new_definition + `euclidean = mk_topology (UNIV, open)`;; + +let OPEN_EMPTY = theorem `; + open ∅ + by rewrite open_def NOT_IN_EMPTY`;; + +let OPEN_UNIV = theorem `; + open UNIV + by fol open_def IN_UNIV REAL_LT_01`;; + +let OPEN_INTER = theorem `; + ∀s t. open s ∧ open t ⇒ open (s ∩ t) + + proof + intro_TAC ∀s t, sOpen tOpen; + rewrite open_def IN_INTER; + intro_TAC ∀x, xs xt; + consider d1 such that + &0 < d1 ∧ ∀x'. dist (x',x) < d1 ⇒ x' ∈ s [d1Exists] by fol sOpen xs open_def; + consider d2 such that + &0 < d2 ∧ ∀x'. dist (x',x) < d2 ⇒ x' ∈ t [d2Exists] by fol tOpen xt open_def; + consider e such that &0 < e /\ e < d1 /\ e < d2 [eExists] by fol d1Exists d2Exists REAL_DOWN2; + fol - d1Exists d2Exists REAL_LT_TRANS; + qed; +`;; + +let OPEN_UNIONS = theorem `; + (∀s. s ∈ f ⇒ open s) ⇒ open (UNIONS f) + by fol open_def IN_UNIONS`;; + +let IstopologyEuclidean = theorem `; + istopology (UNIV, open) + by simplify istopology IN IN_UNIV SUBSET OPEN_EMPTY OPEN_UNIV OPEN_INTER OPEN_UNIONS`;; + +let OPEN_IN = theorem `; + open = open_in euclidean + by fol euclidean topology_tybij IstopologyEuclidean TopologyPAIR PAIR_EQ`;; + +let TOPSPACE_EUCLIDEAN = theorem `; + topspace euclidean = UNIV + by fol euclidean IstopologyEuclidean topology_tybij TopologyPAIR PAIR_EQ`;; + +let OPEN_EXISTS_IN = theorem `; + ∀P Q. (∀a. P a ⇒ open {x | Q a x}) ⇒ open {x | ∃a. P a ∧ Q a x} + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OPEN_IN_EXISTS_IN`;; + +let OPEN_EXISTS = theorem `; + ∀Q. (∀a. open {x | Q a x}) ⇒ open {x | ∃a. Q a x} + + proof + intro_TAC ∀Q; + (∀a. T ⇒ open {x | Q a x}) ⇒ open {x | ∃a. T ∧ Q a x} [] by simplify OPEN_EXISTS_IN; + MP_TAC -; + fol; + qed; +`;; + +let TOPSPACE_EUCLIDEAN_SUBTOPOLOGY = theorem `; + ∀s. topspace (subtopology euclidean s) = s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN TopspaceSubtopology`;; + +let OPEN_IN_REFL = theorem `; + ∀s. open_in (subtopology euclidean s) s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInRefl`;; + +let CLOSED_IN_REFL = theorem `; + ∀s. closed_in (subtopology euclidean s) s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInRefl`;; + +let CLOSED_IN = theorem `; + ∀s. closed = closed_in euclidean + by fol closed closed_in TOPSPACE_EUCLIDEAN OPEN_IN SUBSET_UNIV EXTENSION IN`;; + +let OPEN_UNION = theorem `; + ∀s t. open s ∧ open t ⇒ open(s ∪ t) + by fol OPEN_IN OPEN_IN_UNION`;; + +let OPEN_SUBOPEN = theorem `; + ∀s. open s ⇔ ∀x. x ∈ s ⇒ ∃t. open t ∧ x ∈ t ∧ t ⊂ s + by fol OPEN_IN OPEN_IN_SUBOPEN`;; + +let CLOSED_EMPTY = theorem `; + closed ∅ + by fol CLOSED_IN CLOSED_IN_EMPTY`;; + +let CLOSED_UNIV = theorem `; + closed UNIV + by fol CLOSED_IN TOPSPACE_EUCLIDEAN CLOSED_IN_TOPSPACE`;; + +let CLOSED_UNION = theorem `; + ∀s t. closed s ∧ closed t ⇒ closed(s ∪ t) + by fol CLOSED_IN CLOSED_IN_UNION`;; + +let CLOSED_INTER = theorem `; + ∀s t. closed s ∧ closed t ⇒ closed(s ∩ t) + by fol CLOSED_IN CLOSED_IN_INTER`;; + +let CLOSED_INTERS = theorem `; + ∀f. (∀s. s ∈ f ⇒ closed s) ⇒ closed (INTERS f) + by fol CLOSED_IN CLOSED_IN_INTERS INTERS_0 CLOSED_UNIV`;; + +let CLOSED_FORALL_IN = theorem `; + ∀P Q. (∀a. P a ⇒ closed {x | Q a x}) + ⇒ closed {x | ∀a. P a ⇒ Q a x} + + proof + intro_TAC ∀P Q; + case_split Pnonempty | Pempty by fol; + suppose ¬(P = ∅); + simplify CLOSED_IN Pnonempty CLOSED_IN_FORALL_IN; + end; + suppose P = ∅; + {x | ∀a. P a ⇒ Q a x} = UNIV [] by set Pempty; + simplify - CLOSED_UNIV; + end; + qed; +`;; + +let CLOSED_FORALL = theorem `; + ∀Q. (∀a. closed {x | Q a x}) ⇒ closed {x | ∀a. Q a x} + + proof + intro_TAC ∀Q; + (∀a. T ⇒ closed {x | Q a x}) ⇒ closed {x | ∀a. T ⇒ Q a x} [] by simplify CLOSED_FORALL_IN; + MP_TAC -; + fol; + qed; +`;; + +let OPEN_CLOSED = theorem `; + ∀s. open s ⇔ closed(UNIV ━ s) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN CLOSED_IN OPEN_IN_CLOSED_IN`;; + +let OPEN_DIFF = theorem `; + ∀s t. open s ∧ closed t ⇒ open(s ━ t) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN CLOSED_IN OPEN_IN_DIFF`;; + +let CLOSED_DIFF = theorem `; + ∀s t. closed s ∧ open t ⇒ closed (s ━ t) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN CLOSED_IN CLOSED_IN_DIFF`;; + +let OPEN_INTERS = theorem `; + ∀s. FINITE s ∧ (∀t. t ∈ s ⇒ open t) ⇒ open (INTERS s) + by fol OPEN_IN OPEN_IN_INTERS INTERS_0 OPEN_UNIV`;; + +let CLOSED_UNIONS = theorem `; + ∀s. FINITE s ∧ (∀t. t ∈ s ⇒ closed t) ⇒ closed (UNIONS s) + by fol CLOSED_IN CLOSED_IN_UNIONS`;; + +(* ------------------------------------------------------------------------- *) +(* Open and closed balls and spheres. *) +(* ------------------------------------------------------------------------- *) + +let ball = new_definition + `ball(x,e) = {y | dist(x,y) < e}`;; + +let cball = new_definition + `cball(x,e) = {y | dist(x,y) <= e}`;; + +let IN_BALL = theorem `; + ∀x y e. y ∈ ball(x,e) ⇔ dist(x,y) < e + by rewrite ball IN_ELIM_THM`;; + +let IN_CBALL = theorem `; + ∀x y e. y ∈ cball(x, e) ⇔ dist(x, y) <= e + by rewrite cball IN_ELIM_THM`;; + +let BALL_SUBSET_CBALL = theorem `; + ∀x e. ball (x,e) ⊂ cball (x, e) + + proof + rewrite IN_BALL IN_CBALL SUBSET; + real_arithmetic; + qed; +`;; + +let OPEN_BALL = theorem `; + ∀x e. open (ball (x,e)) + + proof + rewrite open_def ball IN_ELIM_THM; + fol DIST_SYM REAL_SUB_LT REAL_LT_SUB_LADD REAL_ADD_SYM REAL_LET_TRANS DIST_TRIANGLE; + qed; +`;; + +let CENTRE_IN_BALL = theorem `; + ∀x e. x ∈ ball(x,e) ⇔ &0 < e + by fol IN_BALL DIST_REFL`;; + +let OPEN_CONTAINS_BALL = theorem `; + ∀s. open s ⇔ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ball(x,e) ⊂ s + by rewrite open_def SUBSET IN_BALL DIST_SYM`;; + +let HALF_CBALL_IN_BALL = theorem `; + ∀e. &0 < e ⇒ &0 < e/ &2 ∧ e / &2 < e ∧ cball (x, e/ &2) ⊂ ball (x, e) + + proof + intro_TAC ∀e, H1; + &0 < e/ &2 ∧ e / &2 < e [] by real_arithmetic H1; + fol - SUBSET IN_CBALL IN_BALL REAL_LET_TRANS; + qed; +`;; + +let OPEN_IN_CONTAINS_CBALL_LEMMA = theorem `; + ∀t s x. x ∈ s ⇒ + ((∃e. &0 < e ∧ ball (x, e) ∩ t ⊂ s) ⇔ + (∃e. &0 < e ∧ cball (x, e) ∩ t ⊂ s)) + by fol BALL_SUBSET_CBALL HALF_CBALL_IN_BALL INTER_TENSOR SUBSET_REFL SUBSET_TRANS`;; + +(* ------------------------------------------------------------------------- *) +(* Basic "localization" results are handy for connectedness. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_OPEN = theorem `; + ∀s u. open_in (subtopology euclidean u) s ⇔ ∃t. open t ∧ (s = u ∩ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenInSubtopology INTER_COMM`;; + +let OPEN_IN_INTER_OPEN = theorem `; + ∀s t u. open_in (subtopology euclidean u) s ∧ open t + ⇒ open_in (subtopology euclidean u) (s ∩ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenInSubtopologyInterOpen`;; + +let OPEN_IN_OPEN_INTER = theorem `; + ∀u s. open s ⇒ open_in (subtopology euclidean u) (u ∩ s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenInOpenInter`;; + +let OPEN_OPEN_IN_TRANS = theorem `; + ∀s t. open s ∧ open t ∧ t ⊂ s + ⇒ open_in (subtopology euclidean s) t + by fol OPEN_IN OpenOpenInTrans`;; + +let OPEN_SUBSET = theorem `; + ∀s t. s ⊂ t ∧ open s ⇒ open_in (subtopology euclidean t) s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN OpenSubset`;; + +let CLOSED_IN_CLOSED = theorem `; + ∀s u. + closed_in (subtopology euclidean u) s ⇔ ∃t. closed t ∧ (s = u ∩ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInSubtopology INTER_COMM`;; + +let CLOSED_SUBSET_EQ = theorem `; + ∀u s. closed s ⇒ (closed_in (subtopology euclidean u) s ⇔ s ⊂ u) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedSubsetEq`;; + +let CLOSED_IN_INTER_CLOSED = theorem `; + ∀s t u. closed_in (subtopology euclidean u) s ∧ closed t + ⇒ closed_in (subtopology euclidean u) (s ∩ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInInterClosed`;; + +let CLOSED_IN_CLOSED_INTER = theorem `; + ∀u s. closed s ⇒ closed_in (subtopology euclidean u) (u ∩ s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInClosedInter`;; + +let CLOSED_SUBSET = theorem `; + ∀s t. s ⊂ t ∧ closed s ⇒ closed_in (subtopology euclidean t) s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedSubset`;; + +let OPEN_IN_SUBSET_TRANS = theorem `; + ∀s t u. open_in (subtopology euclidean u) s ∧ s ⊂ t ∧ t ⊂ u + ⇒ open_in (subtopology euclidean t) s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN OpenInSubsetTrans`;; + +let CLOSED_IN_SUBSET_TRANS = theorem `; + ∀s t u. closed_in (subtopology euclidean u) s ∧ s ⊂ t ∧ t ⊂ u + ⇒ closed_in (subtopology euclidean t) s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN ClosedInSubsetTrans`;; + +let OPEN_IN_CONTAINS_BALL_LEMMA = theorem `; + ∀t s x. x ∈ s ⇒ + ((∃E. open E ∧ x ∈ E ∧ E ∩ t ⊂ s) ⇔ + (∃e. &0 < e ∧ ball (x,e) ∩ t ⊂ s)) + + proof + intro_TAC ∀ t s x, xs; + eq_tac [Right] by fol CENTRE_IN_BALL OPEN_BALL; + intro_TAC H2; + consider a such that + open a ∧ x ∈ a ∧ a ∩ t ⊂ s [aExists] by fol H2; + consider e such that + &0 < e ∧ ball(x,e) ⊂ a [eExists] by fol - OPEN_CONTAINS_BALL; + fol aExists - INTER_SUBSET GSYM SUBSET_INTER SUBSET_TRANS; + qed; +`;; + +let OPEN_IN_CONTAINS_BALL = theorem `; + ∀s t. open_in (subtopology euclidean t) s ⇔ + s ⊂ t ∧ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ ball(x,e) ∩ t ⊂ s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN SubtopologyOpenInSubopen GSYM OPEN_IN GSYM OPEN_IN_CONTAINS_BALL_LEMMA`;; + +let OPEN_IN_CONTAINS_CBALL = theorem `; + ∀s t. open_in (subtopology euclidean t) s ⇔ + s ⊂ t ∧ ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ cball(x,e) ∩ t ⊂ s + by fol OPEN_IN_CONTAINS_BALL OPEN_IN_CONTAINS_CBALL_LEMMA`;; + +let open_in = theorem `; + ∀u s. open_in (subtopology euclidean u) s ⇔ + s ⊂ u ∧ + ∀x. x ∈ s ⇒ ∃e. &0 < e ∧ + ∀x'. x' ∈ u ∧ dist(x',x) < e ⇒ x' ∈ s + by rewrite OPEN_IN_CONTAINS_BALL IN_INTER SUBSET IN_BALL CONJ_SYM DIST_SYM`;; + +(* ------------------------------------------------------------------------- *) +(* These "transitivity" results are handy too. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_TRANS = theorem `; + ∀s t u. open_in (subtopology euclidean t) s ∧ + open_in (subtopology euclidean u) t + ⇒ open_in (subtopology euclidean u) s + + proof + intro_TAC ∀s t u; + t ⊂ topspace euclidean ∧ u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - OPEN_IN OpenInTrans; + qed; +`;; + +let OPEN_IN_TRANS_EQ = theorem `; + ∀s t. (∀u. open_in (subtopology euclidean t) u + ⇒ open_in (subtopology euclidean s) t) + ⇔ open_in (subtopology euclidean s) t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInTransEq`;; + +let OPEN_IN_OPEN_TRANS = theorem `; + ∀u s. open_in (subtopology euclidean u) s ∧ open u ⇒ open s + + proof + intro_TAC ∀u s, H1; + u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - H1 OPEN_IN OpenInOpenTrans; + qed; +`;; + +let CLOSED_IN_TRANS = theorem `; + ∀s t u. closed_in (subtopology euclidean t) s ∧ + closed_in (subtopology euclidean u) t + ⇒ closed_in (subtopology euclidean u) s + + proof + intro_TAC ∀s t u; + t ⊂ topspace euclidean ∧ u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - ClosedInSubtopologyTrans; + qed; +`;; + +let CLOSED_IN_TRANS_EQ = theorem `; + ∀s t. + (∀u. closed_in (subtopology euclidean t) u ⇒ closed_in (subtopology euclidean s) t) + ⇔ closed_in (subtopology euclidean s) t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInSubtopologyTransEq`;; + +let CLOSED_IN_CLOSED_TRANS = theorem `; + ∀s u. closed_in (subtopology euclidean u) s ∧ closed u ⇒ closed s + + proof + intro_TAC ∀u s; + u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - CLOSED_IN ClosedInClosedTrans; + qed; +`;; + +let OPEN_IN_SUBTOPOLOGY_INTER_SUBSET = theorem `; + ∀s u v. open_in (subtopology euclidean u) (u ∩ s) ∧ v ⊂ u + ⇒ open_in (subtopology euclidean v) (v ∩ s) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInSubtopologyInterSubset`;; + +let OPEN_IN_OPEN_EQ = theorem `; + ∀s t. open s ⇒ (open_in (subtopology euclidean s) t ⇔ open t ∧ t ⊂ s) + by fol OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInOpenEq`;; + +let CLOSED_IN_CLOSED_EQ = theorem `; + ∀s t. closed s ⇒ + (closed_in (subtopology euclidean s) t ⇔ closed t ∧ t ⊂ s) + by fol CLOSED_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInClosedEq`;; + +(* ------------------------------------------------------------------------- *) +(* Also some invariance theorems for relative topology. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_INJECTIVE_LINEAR_IMAGE = theorem `; + ∀f s t. linear f ∧ (∀x y. f x = f y ⇒ x = y) ⇒ + (open_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) ⇔ + open_in (subtopology euclidean t) s) + + proof + rewrite open_in FORALL_IN_IMAGE IMP_CONJ SUBSET; + intro_TAC ∀f s t, H1, H2; + ∀x s. f x ∈ IMAGE f s ⇔ x ∈ s [fInjMap] by set H2; + rewrite -; + ∀x y. f x - f y = f (x - y) [fSubLinear] by fol H1 LINEAR_SUB; + consider B1 such that + &0 < B1 ∧ ∀x. norm (f x) <= B1 * norm x [B1exists] by fol H1 LINEAR_BOUNDED_POS; + consider B2 such that + &0 < B2 ∧ ∀x. norm x * B2 <= norm (f x) [B2exists] by fol H1 H2 LINEAR_INJECTIVE_BOUNDED_BELOW_POS; + AP_TERM_TAC; + eq_tac [Left] + proof + intro_TAC H3, ∀x, xs; + consider e such that + &0 < e ∧ ∀x'. x' ∈ t ⇒ dist (f x',f x) < e ⇒ x' ∈ s [eExists] by fol H3 xs; + exists_TAC e / B1; + simplify REAL_LT_DIV eExists B1exists; + intro_TAC ∀x', x't; + ∀x. norm(f x) <= B1 * norm(x) ∧ norm(x) * B1 < e ⇒ norm(f x) < e [normB1] by real_arithmetic; + simplify fSubLinear B1exists H3 eExists x't normB1 dist REAL_LT_RDIV_EQ; + qed; + intro_TAC H3, ∀x, xs; + consider e such that + &0 < e ∧ ∀x'. x' ∈ t ⇒ dist (x',x) < e ⇒ x' ∈ s [eExists] by fol H3 xs; + exists_TAC e * B2; + simplify REAL_LT_MUL eExists B2exists; + intro_TAC ∀x', x't; + ∀x. norm x <= norm (f x) / B2 ∧ norm(f x) / B2 < e ⇒ norm x < e [normB2] by real_arithmetic; + simplify fSubLinear B2exists H3 eExists x't normB2 dist REAL_LE_RDIV_EQ REAL_LT_LDIV_EQ; + qed; +`;; + +add_linear_invariants [OPEN_IN_INJECTIVE_LINEAR_IMAGE];; + +let CLOSED_IN_INJECTIVE_LINEAR_IMAGE = theorem `; + ∀f s t. linear f ∧ (∀x y. f x = f y ⇒ x = y) ⇒ + (closed_in (subtopology euclidean (IMAGE f t)) (IMAGE f s) ⇔ + closed_in (subtopology euclidean t) s) + + proof + rewrite closed_in TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; + GEOM_TRANSFORM_TAC[]; + qed; +`;; + +add_linear_invariants [CLOSED_IN_INJECTIVE_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Subspace topology results only proved for Euclidean space. *) +(* ------------------------------------------------------------------------- *) + +(* ISTOPLOGY_SUBTOPOLOGY can not be proved, as the definition of topology *) +(* there is different from the one here. *) + +let OPEN_IN_SUBTOPOLOGY = theorem `; + ∀u s. open_in (subtopology euclidean u) s ⇔ + ∃t. open_in euclidean t ∧ s = t ∩ u + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInSubtopology`;; + +let TOPSPACE_SUBTOPOLOGY = theorem `; + ∀u. topspace(subtopology euclidean u) = topspace euclidean ∩ u + + proof + intro_TAC ∀u; + u ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - TopspaceSubtopology INTER_COMM SUBSET_INTER_ABSORPTION; + qed; +`;; + +let CLOSED_IN_SUBTOPOLOGY = theorem `; + ∀u s. closed_in (subtopology euclidean u) s ⇔ + ∃t. closed_in euclidean t ∧ s = t ∩ u + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closed_in ClosedInSubtopology`;; + +let OPEN_IN_SUBTOPOLOGY_REFL = theorem `; + ∀u. open_in (subtopology euclidean u) u ⇔ u ⊂ topspace euclidean + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OPEN_IN_REFL`;; + +let CLOSED_IN_SUBTOPOLOGY_REFL = theorem `; + ∀u. closed_in (subtopology euclidean u) u ⇔ u ⊂ topspace euclidean + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN_REFL`;; + +let SUBTOPOLOGY_UNIV = theorem `; + subtopology euclidean UNIV = euclidean + + proof + rewrite GSYM Topology_Eq; + conj_tac [Left] by fol TOPSPACE_EUCLIDEAN TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; + rewrite GSYM OPEN_IN OPEN_IN_OPEN INTER_UNIV; + fol; + qed; +`;; + +let SUBTOPOLOGY_SUPERSET = theorem `; + ∀s. topspace euclidean ⊂ s ⇒ subtopology euclidean s = euclidean + by simplify TOPSPACE_EUCLIDEAN UNIV_SUBSET SUBTOPOLOGY_UNIV`;; + +let OPEN_IN_IMP_SUBSET = theorem `; + ∀s t. open_in (subtopology euclidean s) t ⇒ t ⊂ s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInImpSubset`;; + +let CLOSED_IN_IMP_SUBSET = theorem `; + ∀s t. closed_in (subtopology euclidean s) t ⇒ t ⊂ s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInImpSubset`;; + +let OPEN_IN_SUBTOPOLOGY_UNION = theorem `; + ∀s t u. open_in (subtopology euclidean t) s ∧ + open_in (subtopology euclidean u) s + ⇒ open_in (subtopology euclidean (t ∪ u)) s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInSubtopologyUnion`;; + +let CLOSED_IN_SUBTOPOLOGY_UNION = theorem `; + ∀s t u. closed_in (subtopology euclidean t) s ∧ + closed_in (subtopology euclidean u) s + ⇒ closed_in (subtopology euclidean (t ∪ u)) s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosedInSubtopologyUnion`;; + +(* ------------------------------------------------------------------------- *) +(* Connectedness. *) +(* ------------------------------------------------------------------------- *) + +let connected_DEF = NewDefinition `; + connected s ⇔ Connected (subtopology euclidean s)`;; + +let connected = theorem `; + ∀s. connected s ⇔ ¬(∃e1 e2. + open e1 ∧ open e2 ∧ s ⊂ e1 ∪ e2 ∧ + e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅)) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF OPEN_IN ConnectedSubtopology`;; + +let CONNECTED_CLOSED = theorem `; + ∀s. connected s ⇔ + ¬(∃e1 e2. closed e1 ∧ closed e2 ∧ s ⊂ e1 ∪ e2 ∧ + e1 ∩ e2 ∩ s = ∅ ∧ ¬(e1 ∩ s = ∅) ∧ ¬(e2 ∩ s = ∅)) + by simplify connected_DEF CLOSED_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF CLOSED_IN ConnectedClosedSubtopology`;; + +let CONNECTED_OPEN_IN = theorem `; + ∀s. connected s ⇔ ¬(∃e1 e2. + open_in (subtopology euclidean s) e1 ∧ + open_in (subtopology euclidean s) e2 ∧ + s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF OPEN_IN ConnectedOpenIn`;; + +let CONNECTED_OPEN_IN_EQ = theorem `; + ∀s. connected s ⇔ ¬(∃e1 e2. + open_in (subtopology euclidean s) e1 ∧ + open_in (subtopology euclidean s) e2 ∧ + e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅ ∧ + ¬(e1 = ∅) ∧ ¬(e2 = ∅)) + by simplify connected_DEF Connected_DEF SUBSET_UNIV TOPSPACE_EUCLIDEAN TopspaceSubtopology EQ_SYM_EQ`;; + +let CONNECTED_CLOSED_IN = theorem `; + ∀s. connected s ⇔ ¬(∃e1 e2. + closed_in (subtopology euclidean s) e1 ∧ + closed_in (subtopology euclidean s) e2 ∧ + s ⊂ e1 ∪ e2 ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF CLOSED_IN ConnectedClosedIn`;; + +let CONNECTED_CLOSED_IN_EQ = theorem `; + ∀s. connected s ⇔ ¬(∃e1 e2. + closed_in (subtopology euclidean s) e1 ∧ + closed_in (subtopology euclidean s) e2 ∧ + e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅ ∧ ¬(e1 = ∅) ∧ ¬(e2 = ∅)) + by simplify connected_DEF ConnectedClosed SUBSET_UNIV TOPSPACE_EUCLIDEAN TopspaceSubtopology EQ_SYM_EQ`;; + +let CONNECTED_CLOPEN = theorem `; + ∀s. connected s ⇔ + ∀t. open_in (subtopology euclidean s) t ∧ + closed_in (subtopology euclidean s) t ⇒ t = ∅ ∨ t = s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF ConnectedClopen TopspaceSubtopology`;; + +let CONNECTED_CLOSED_SET = theorem `; + ∀s. closed s ⇒ + (connected s ⇔ + ¬(∃e1 e2. closed e1 ∧ closed e2 ∧ + ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) + by simplify connected_DEF CLOSED_IN closed_in ConnectedClosedSet`;; + +let CONNECTED_OPEN_SET = theorem `; + ∀s. open s ⇒ + (connected s ⇔ + ¬(∃e1 e2. open e1 ∧ open e2 ∧ + ¬(e1 = ∅) ∧ ¬(e2 = ∅) ∧ e1 ∪ e2 = s ∧ e1 ∩ e2 = ∅)) + by simplify connected_DEF OPEN_IN ConnectedOpenSet`;; + +let CONNECTED_EMPTY = theorem `; + connected ∅ + by rewrite connected_DEF ConnectedEmpty`;; + +let CONNECTED_SING = theorem `; + ∀a. connected {a} + + proof + intro_TAC ∀a; + a ∈ topspace euclidean [] by fol IN_UNIV TOPSPACE_EUCLIDEAN; + fol - ConnectedSing connected_DEF; + qed; +`;; + +let CONNECTED_UNIONS = theorem `; + ∀P. (∀s. s ∈ P ⇒ connected s) ∧ ¬(INTERS P = ∅) + ⇒ connected(UNIONS P) + + proof + intro_TAC ∀P; + ∀s. s ∈ P ⇒ s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - connected_DEF ConnectedUnions; + qed; +`;; + +let CONNECTED_UNION = theorem `; + ∀s t. connected s ∧ connected t ∧ ¬(s ∩ t = ∅) + ⇒ connected (s ∪ t) + + proof + intro_TAC ∀s t; + s ⊂ topspace euclidean ∧ t ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - connected_DEF ConnectedUnion; + qed; +`;; + +let CONNECTED_DIFF_OPEN_FROM_CLOSED = theorem `; + ∀s t u. s ⊂ t ∧ t ⊂ u ∧ open s ∧ closed t ∧ + connected u ∧ connected(t ━ s) + ⇒ connected(u ━ s) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF OPEN_IN CLOSED_IN ConnectedDiffOpenFromClosed`;; + +let CONNECTED_DISJOINT_UNIONS_OPEN_UNIQUE = theorem `; + ∀f f'. pairwise DISJOINT f ∧ pairwise DISJOINT f' ∧ + (∀s. s ∈ f ⇒ open s ∧ connected s ∧ ¬(s = ∅)) ∧ + (∀s. s ∈ f' ⇒ open s ∧ connected s ∧ ¬(s = ∅)) ∧ + UNIONS f = UNIONS f' + ⇒ f = f' + by rewrite connected_DEF OPEN_IN ConnectedDisjointUnionsOpenUnique`;; + +let CONNECTED_FROM_CLOSED_UNION_AND_INTER = theorem `; + ∀s t. closed s ∧ closed t ∧ connected (s ∪ t) ∧ connected (s ∩ t) + ⇒ connected s ∧ connected t + + proof + intro_TAC ∀s t; + s ∪ t ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - connected_DEF CLOSED_IN ConnectedFromClosedUnionAndInter; + qed; +`;; + +let CONNECTED_FROM_OPEN_UNION_AND_INTER = theorem `; + ∀s t. open s ∧ open t ∧ connected (s ∪ t) ∧ connected (s ∩ t) + ⇒ connected s ∧ connected t + + proof + intro_TAC ∀s t; + s ∪ t ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + fol - connected_DEF OPEN_IN ConnectedFromOpenUnionAndInter; + qed; +`;; + +(* ------------------------------------------------------------------------- *) +(* Sort of induction principle for connected sets. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_INDUCTION = theorem `; + ∀P Q s. connected s ∧ + (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t ⇒ ∃z. z ∈ t ∧ P z) ∧ + (∀a. a ∈ s ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ∧ Q x ⇒ Q y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ∧ Q a ⇒ Q b + + proof + intro_TAC ∀P Q s; + s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + MP_TAC -; + rewrite connected_DEF ConnectedInduction; + qed; +`;; + +let CONNECTED_EQUIVALENCE_RELATION_GEN_LEMMA = theorem `; + ∀P R s. + connected s ∧ + (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ + (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t + ⇒ ∃z. z ∈ t ∧ P z) ∧ + (∀a. a ∈ s + ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b + + proof + intro_TAC ∀P R s; + s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + MP_TAC -; + rewrite connected_DEF ConnectedEquivalenceRelationGen; + qed; +`;; + +let CONNECTED_EQUIVALENCE_RELATION_GEN = theorem `; + ∀P R s. + connected s ∧ + (∀x y. R x y ⇒ R y x) ∧ + (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ + (∀t a. open_in (subtopology euclidean s) t ∧ a ∈ t + ⇒ ∃z. z ∈ t ∧ P z) ∧ + (∀a. a ∈ s + ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ∧ P y ⇒ R x y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ∧ P b ⇒ R a b + + proof + intro_TAC ∀P R s; + MP_TAC ISPECL [P; R; s] CONNECTED_EQUIVALENCE_RELATION_GEN_LEMMA; + fol; + qed; +`;; + +let CONNECTED_INDUCTION_SIMPLE = theorem `; + ∀P s. connected s ∧ (∀a. a ∈ s + ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ + ∀x y. x ∈ t ∧ y ∈ t ∧ P x ⇒ P y) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ∧ P a ⇒ P b + + proof + intro_TAC ∀P s; + s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + MP_TAC -; + rewrite connected_DEF ConnectedInductionSimple; + qed; +`;; + +let CONNECTED_EQUIVALENCE_RELATION = theorem `; + ∀R s. connected s ∧ + (∀x y. R x y ⇒ R y x) ∧ (∀x y z. R x y ∧ R y z ⇒ R x z) ∧ + (∀a. a ∈ s + ⇒ ∃t. open_in (subtopology euclidean s) t ∧ a ∈ t ∧ ∀x. x ∈ t ⇒ R a x) + ⇒ ∀a b. a ∈ s ∧ b ∈ s ⇒ R a b + + proof + intro_TAC ∀R s; + s ⊂ topspace euclidean [] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN; + MP_TAC -; + rewrite connected_DEF ConnectedEquivalenceRelation; + qed; +`;; + +(* ------------------------------------------------------------------------- *) +(* Limit points. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("limit_point_of",(12,"right"));; + +let limit_point_of_DEF = NewDefinition `; + x limit_point_of s ⇔ x ∈ LimitPointOf euclidean s`;; + +let limit_point_of = theorem `; + x limit_point_of s ⇔ + ∀t. x ∈ t ∧ open t ⇒ ∃y. ¬(y = x) ∧ y ∈ s ∧ y ∈ t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV IN_LimitPointOf limit_point_of_DEF OPEN_IN`;; + +let LIMPT_SUBSET = theorem `; + ∀x s t. x limit_point_of s ∧ s ⊂ t ⇒ x limit_point_of t + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN limit_point_of_DEF LimptSubset SUBSET`;; + +let CLOSED_LIMPT = theorem `; + ∀s. closed s ⇔ ∀x. x limit_point_of s ⇒ x ∈ s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF CLOSED_IN ClosedLimpt SUBSET`;; + +let LIMPT_EMPTY = theorem `; + ∀x. ¬(x limit_point_of ∅) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF GSYM ∉ LimptEmpty`;; + +let NO_LIMIT_POINT_IMP_CLOSED = theorem `; + ∀s. ¬(∃x. x limit_point_of s) ⇒ closed s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF CLOSED_IN NoLimitPointImpClosed NOT_EXISTS_THM ∉`;; + +let LIMIT_POINT_UNION = theorem `; + ∀s t x. x limit_point_of (s ∪ t) ⇔ + x limit_point_of s ∨ x limit_point_of t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF LimitPointUnion EXTENSION IN_UNION`;; + +let LimitPointOf_euclidean = theorem `; + ∀s. LimitPointOf euclidean s = {x | x limit_point_of s} + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN IN_UNIV limit_point_of_DEF LimitPointOf IN_ELIM_THM EXTENSION`;; + +(* ------------------------------------------------------------------------- *) +(* Interior of a set. *) +(* ------------------------------------------------------------------------- *) + +let interior_DEF = NewDefinition `; + interior = Interior euclidean`;; + +let interior = theorem `; + ∀s. interior s = {x | ∃t. open t ∧ x ∈ t ∧ t ⊂ s} + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF Interior_DEF OPEN_IN`;; + +let INTERIOR_EQ = theorem `; + ∀s. interior s = s ⇔ open s + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorEq EQ_SYM_EQ`;; + +let INTERIOR_OPEN = theorem `; + ∀s. open s ⇒ interior s = s + by fol interior_DEF OPEN_IN InteriorOpen`;; + +let INTERIOR_EMPTY = theorem `; + interior ∅ = ∅ + by fol interior_DEF OPEN_IN InteriorEmpty`;; + +let INTERIOR_UNIV = theorem `; + interior UNIV = UNIV + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF InteriorUniv`;; + +let OPEN_INTERIOR = theorem `; + ∀s. open (interior s) + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenInterior`;; + +let INTERIOR_INTERIOR = theorem `; + ∀s. interior (interior s) = interior s + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorInterior`;; + +let INTERIOR_SUBSET = theorem `; + ∀s. interior s ⊂ s + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorSubset`;; + +let SUBSET_INTERIOR = theorem `; + ∀s t. s ⊂ t ⇒ interior s ⊂ interior t + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN SubsetInterior`;; + +let INTERIOR_MAXIMAL = theorem `; + ∀s t. t ⊂ s ∧ open t ⇒ t ⊂ interior s + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorMaximal`;; + +let INTERIOR_MAXIMAL_EQ = theorem `; + ∀s t. open s ⇒ (s ⊂ interior t ⇔ s ⊂ t) + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorMaximalEq`;; + +let INTERIOR_UNIQUE = theorem `; + ∀s t. t ⊂ s ∧ open t ∧ (∀t'. t' ⊂ s ∧ open t' ⇒ t' ⊂ t) + ⇒ interior s = t + by simplify interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorUnique`;; + +let IN_INTERIOR = theorem `; + ∀x s. x ∈ interior s ⇔ ∃e. &0 < e ∧ ball(x,e) ⊂ s + + proof + simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF IN_Interior GSYM OPEN_IN; + fol OPEN_CONTAINS_BALL SUBSET_TRANS CENTRE_IN_BALL OPEN_BALL; + qed; +`;; + +let OPEN_SUBSET_INTERIOR = theorem `; + ∀s t. open s ⇒ (s ⊂ interior t ⇔ s ⊂ t) + by fol interior_DEF OPEN_IN SUBSET_UNIV TOPSPACE_EUCLIDEAN OpenSubsetInterior`;; + +let INTERIOR_INTER = theorem `; + ∀s t. interior (s ∩ t) = interior s ∩ interior t + by simplify interior_DEF SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorInter`;; + +let INTERIOR_FINITE_INTERS = theorem `; + ∀s. FINITE s ⇒ interior (INTERS s) = INTERS (IMAGE interior s) + + proof + intro_TAC ∀s, H1; + assume ¬(s = ∅) [sNonempty] by simplify INTERS_0 IMAGE_CLAUSES INTERIOR_UNIV; + simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN H1 sNonempty interior_DEF InteriorFiniteInters; + qed; +`;; + +let INTERIOR_FINITE_INTERS = theorem `; + ∀s. FINITE s ⇒ interior (INTERS s) = INTERS (IMAGE interior s) + + proof + intro_TAC ∀s, H1; + assume s = ∅ [sEmpty] by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN H1 interior_DEF InteriorFiniteInters; + rewrite INTERS_0 IMAGE_CLAUSES sEmpty INTERIOR_UNIV; + qed; +`;; + +let INTERIOR_INTERS_SUBSET = theorem `; + ∀f. interior (INTERS f) ⊂ INTERS (IMAGE interior f) + + proof + intro_TAC ∀f; + assume f = ∅ [fEmpty] by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF InteriorIntersSubset; + rewrite INTERS_0 IMAGE_CLAUSES - INTERIOR_UNIV SUBSET_REFL; + qed; +`;; + +let UNION_INTERIOR_SUBSET = theorem `; + ∀s t. interior s ∪ interior t ⊂ interior(s ∪ t) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF UnionInteriorSubset`;; + +let INTERIOR_EQ_EMPTY = theorem `; + ∀s. interior s = ∅ ⇔ ∀t. open t ∧ t ⊂ s ⇒ t = ∅ + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF OPEN_IN InteriorEqEmpty`;; + +let INTERIOR_EQ_EMPTY_ALT = theorem `; + ∀s. interior s = ∅ ⇔ ∀t. open t ∧ ¬(t = ∅) ⇒ ¬(t ━ s = ∅) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF OPEN_IN InteriorEqEmptyAlt`;; + +let INTERIOR_UNIONS_OPEN_SUBSETS = theorem `; + ∀s. UNIONS {t | open t ∧ t ⊂ s} = interior s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF OPEN_IN InteriorUnionsOpenSubsets`;; + +(* ------------------------------------------------------------------------- *) +(* Closure of a set. *) +(* ------------------------------------------------------------------------- *) + +let closure_DEF = NewDefinition `; + closure = Closure euclidean`;; + +let closure = theorem `; + ∀s. closure s = s UNION {x | x limit_point_of s} + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF LimitPointOf_euclidean Closure_THM`;; + +let CLOSURE_INTERIOR = theorem `; + ∀s. closure s = UNIV ━ interior (UNIV ━ s) + + proof + rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; + simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosureInterior; + qed; +`;; + +let INTERIOR_CLOSURE = theorem `; + ∀s. interior s = UNIV ━ (closure (UNIV ━ s)) + + proof + rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; + simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorClosure; + qed; +`;; + +let CLOSED_CLOSURE = theorem `; + ∀s. closed (closure s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosedClosure`;; + +let CLOSURE_SUBSET = theorem `; + ∀s. s ⊂ closure s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureSubset`;; + +let SUBSET_CLOSURE = theorem `; + ∀s t. s ⊂ t ⇒ closure s ⊂ closure t + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF SubsetClosure`;; + +let CLOSURE_HULL = theorem `; + ∀s. closure s = closed hull s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureHull`;; + +let CLOSURE_EQ = theorem `; + ∀s. closure s = s ⇔ closed s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureEq`;; + +let CLOSURE_CLOSED = theorem `; + ∀s. closed s ⇒ closure s = s + by fol CLOSED_IN closure_DEF ClosureClosed`;; + +let CLOSURE_CLOSURE = theorem `; + ∀s. closure (closure s) = closure s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureClosure`;; + +let CLOSURE_UNION = theorem `; + ∀s t. closure (s ∪ t) = closure s ∪ closure t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureUnion`;; + +let CLOSURE_INTER_SUBSET = theorem `; + ∀s t. closure (s ∩ t) ⊂ closure s ∩ closure t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureInterSubset`;; + +let CLOSURE_INTERS_SUBSET = theorem `; + ∀f. closure (INTERS f) ⊂ INTERS (IMAGE closure f) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureIntersSubset`;; + +let CLOSURE_MINIMAL = theorem `; + ∀s t. s ⊂ t ∧ closed t ⇒ closure s ⊂ t + by fol CLOSED_IN closure_DEF ClosureMinimal`;; + +let CLOSURE_MINIMAL_EQ = theorem `; + ∀s t. closed t ⇒ (closure s ⊂ t ⇔ s ⊂ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN closure_DEF ClosureMinimalEq`;; + +let CLOSURE_UNIQUE = theorem `; + ∀s t. s ⊂ t ∧ closed t ∧ (∀t'. s ⊂ t' ∧ closed t' ⇒ t ⊂ t') + ⇒ closure s = t + by fol CLOSED_IN closure_DEF ClosureUnique`;; + + +let CLOSURE_EMPTY = theorem `; + closure ∅ = ∅ + by fol closure_DEF ClosureEmpty`;; + +let CLOSURE_UNIV = theorem `; + closure UNIV = UNIV + by fol TOPSPACE_EUCLIDEAN closure_DEF ClosureUniv`;; + +let CLOSURE_UNIONS = theorem `; + ∀f. FINITE f ⇒ closure (UNIONS f) = UNIONS {closure s | s ∈ f} + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF ClosureUnions`;; + +let CLOSURE_EQ_EMPTY = theorem `; + ∀s. closure s = ∅ ⇔ s = ∅ + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF ClosureEqEmpty`;; + +let CLOSURE_SUBSET_EQ = theorem `; + ∀s. closure s ⊂ s ⇔ closed s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF CLOSED_IN ClosureSubsetEq`;; + +let OPEN_INTER_CLOSURE_EQ_EMPTY = theorem `; + ∀s t. open s ⇒ (s ∩ closure t = ∅ ⇔ s ∩ t = ∅) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF OPEN_IN OpenInterClosureEqEmpty`;; + +let OPEN_INTER_CLOSURE_SUBSET = theorem `; + ∀s t. open s ⇒ s ∩ closure t ⊂ closure (s ∩ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF OPEN_IN OpenInterClosureSubset`;; + +let CLOSURE_OPEN_INTER_SUPERSET = theorem `; + ∀s t. open s ∧ s ⊂ closure t ⇒ closure (s ∩ t) = closure s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF OPEN_IN ClosureOpenInterSuperset`;; + +let CLOSURE_COMPLEMENT = theorem `; + ∀s. closure (UNIV ━ s) = UNIV ━ interior s + + proof + rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; + simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN ClosureComplement; + qed; +`;; + +let INTERIOR_COMPLEMENT = theorem `; + ∀s. interior (UNIV ━ s) = UNIV ━ closure s + + proof + rewrite closure_DEF GSYM TOPSPACE_EUCLIDEAN interior_DEF; + simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN InteriorComplement; + qed; +`;; + +let CONNECTED_INTERMEDIATE_CLOSURE = theorem `; + ∀s t. connected s ∧ s ⊂ t ∧ t ⊂ closure s ⇒ connected t + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF connected_DEF ConnectedIntermediateClosure`;; + +let CONNECTED_CLOSURE = theorem `; + ∀s. connected s ⇒ connected (closure s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF connected_DEF ConnectedClosure`;; + +let CONNECTED_UNION_STRONG = theorem `; + ∀s t. connected s ∧ connected t ∧ ¬(closure s ∩ t = ∅) + ⇒ connected (s ∪ t) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF connected_DEF ConnectedUnionStrong`;; + +let INTERIOR_DIFF = theorem `; + ∀s t. interior (s ━ t) = interior s ━ closure t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF InteriorDiff`;; + +let CLOSED_IN_LIMPT = theorem `; + ∀s t. closed_in (subtopology euclidean t) s ⇔ + s ⊂ t ∧ ∀x. x limit_point_of s ∧ x ∈ t ⇒ x ∈ s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF limit_point_of_DEF ClosedInLimpt_ALT`;; + +let CLOSED_IN_INTER_CLOSURE = theorem `; + ∀s t. closed_in (subtopology euclidean s) t ⇔ s ∩ closure t = t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF limit_point_of_DEF ClosedInInterClosure`;; + +let INTERIOR_CLOSURE_IDEMP = theorem `; + ∀s. interior (closure (interior (closure s))) = interior (closure s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF InteriorClosureIdemp`;; + +let CLOSURE_INTERIOR_IDEMP = theorem `; + ∀s. closure (interior (closure (interior s))) = closure (interior s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF ClosureInteriorIdemp`;; + +let INTERIOR_CLOSED_UNION_EMPTY_INTERIOR = theorem `; + ∀s t. closed s ∧ interior t = ∅ ⇒ interior (s ∪ t) = interior s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN interior_DEF InteriorClosedUnionEmptyInterior`;; + +let INTERIOR_UNION_EQ_EMPTY = theorem `; + ∀s t. closed s ∨ closed t + ⇒ (interior (s ∪ t) = ∅ ⇔ interior s = ∅ ∧ interior t = ∅) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN interior_DEF InteriorUnionEqEmpty`;; + +let NOWHERE_DENSE_UNION = theorem `; + ∀s t. interior (closure (s ∪ t)) = ∅ ⇔ + interior (closure s) = ∅ ∧ interior (closure t) = ∅ + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF interior_DEF NowhereDenseUnion`;; + +let NOWHERE_DENSE = theorem `; + ∀s. interior (closure s) = ∅ ⇔ + ∀t. open t ∧ ¬(t = ∅) ⇒ ∃u. open u ∧ ¬(u = ∅) ∧ u ⊂ t ∧ u ∩ s = ∅ + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF closure_DEF OPEN_IN NowhereDense`;; + +let INTERIOR_CLOSURE_INTER_OPEN = theorem `; + ∀s t. open s ∧ open t ⇒ + interior (closure (s ∩ t)) = interior(closure s) ∩ interior (closure t) + by simplify interior_DEF closure_DEF OPEN_IN InteriorClosureInterOpen`;; + +let CLOSURE_INTERIOR_UNION_CLOSED = theorem `; + ∀s t. closed s ∧ closed t ⇒ + closure (interior (s ∪ t)) = closure (interior s) ∪ closure (interior t) + by simplify interior_DEF closure_DEF CLOSED_IN ClosureInteriorUnionClosed`;; + +let REGULAR_OPEN_INTER = theorem `; + ∀s t. interior (closure s) = s ∧ interior (closure t) = t + ⇒ interior (closure (s ∩ t)) = s ∩ t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF closure_DEF RegularOpenInter`;; + +let REGULAR_CLOSED_UNION = theorem `; + ∀s t. closure (interior s) = s ∧ closure (interior t) = t + ⇒ closure (interior (s ∪ t)) = s ∪ t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF closure_DEF RegularClosedUnion`;; + +let DIFF_CLOSURE_SUBSET = theorem `; + ∀s t. closure s ━ closure t ⊂ closure (s ━ t) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF DiffClosureSubset`;; + +(* ------------------------------------------------------------------------- *) +(* Frontier (aka boundary). *) +(* ------------------------------------------------------------------------- *) + +let frontier_DEF = NewDefinition `; + frontier = Frontier euclidean`;; + +let frontier = theorem `; + ∀s. frontier s = (closure s) DIFF (interior s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF interior_DEF Frontier_THM`;; + +let FRONTIER_CLOSED = theorem `; + ∀s. closed (frontier s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF CLOSED_IN FrontierClosed`;; + +let FRONTIER_CLOSURES = theorem `; + ∀s. frontier s = (closure s) ∩ (closure (UNIV ━ s)) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierClosures`;; + +let FRONTIER_STRADDLE = theorem `; + ∀a s. a ∈ frontier s ⇔ ∀e. &0 < e ⇒ + (∃x. x ∈ s ∧ dist(a,x) < e) ∧ (∃x. ¬(x ∈ s) ∧ dist(a,x) < e) + + proof + simplify SUBSET_UNIV IN_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierStraddle GSYM OPEN_IN; + fol IN_BALL SUBSET OPEN_CONTAINS_BALL CENTRE_IN_BALL OPEN_BALL; + qed; +`;; + +let FRONTIER_SUBSET_CLOSED = theorem `; + ∀s. closed s ⇒ (frontier s) ⊂ s + by fol frontier_DEF CLOSED_IN FrontierSubsetClosed`;; + +let FRONTIER_EMPTY = theorem `; + frontier ∅ = ∅ + by fol frontier_DEF FrontierEmpty`;; + +let FRONTIER_UNIV = theorem `; + frontier UNIV = ∅ + by fol frontier_DEF TOPSPACE_EUCLIDEAN FrontierUniv`;; + +let FRONTIER_SUBSET_EQ = theorem `; + ∀s. (frontier s) ⊂ s ⇔ closed s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF CLOSED_IN FrontierSubsetEq`;; + +let FRONTIER_COMPLEMENT = theorem `; + ∀s. frontier (UNIV ━ s) = frontier s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierComplement`;; + +let FRONTIER_DISJOINT_EQ = theorem `; + ∀s. (frontier s) ∩ s = ∅ ⇔ open s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF OPEN_IN FrontierDisjointEq`;; + +let FRONTIER_INTER_SUBSET = theorem `; + ∀s t. frontier (s ∩ t) ⊂ frontier s ∪ frontier t + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierInterSubset`;; + +let FRONTIER_UNION_SUBSET = theorem `; + ∀s t. frontier (s ∪ t) ⊂ frontier s ∪ frontier t + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierUnionSubset`;; + +let FRONTIER_INTERIORS = theorem `; + frontier s = UNIV ━ interior(s) ━ interior(UNIV ━ s) + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF interior_DEF FrontierInteriors`;; + +let FRONTIER_FRONTIER_SUBSET = theorem `; + ∀s. frontier (frontier s) ⊂ frontier s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF FrontierFrontierSubset`;; + +let INTERIOR_FRONTIER = theorem `; + ∀s. interior (frontier s) = interior (closure s) ━ closure (interior s) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN interior_DEF frontier_DEF closure_DEF InteriorFrontier`;; + +let INTERIOR_FRONTIER_EMPTY = theorem `; + ∀s. open s ∨ closed s ⇒ interior (frontier s) = ∅ + by fol OPEN_IN CLOSED_IN interior_DEF frontier_DEF InteriorFrontierEmpty`;; + +let UNION_FRONTIER = theorem `; + ∀s t. frontier s ∪ frontier t = + frontier (s ∪ t) ∪ frontier (s ∩ t) ∪ frontier s ∩ frontier t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF UnionFrontier`;; + +let CONNECTED_INTER_FRONTIER = theorem `; + ∀s t. connected s ∧ ¬(s ∩ t = ∅) ∧ ¬(s ━ t = ∅) + ⇒ ¬(s ∩ frontier t = ∅) + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN connected_DEF frontier_DEF ConnectedInterFrontier`;; + +let INTERIOR_CLOSED_EQ_EMPTY_AS_FRONTIER = theorem `; + ∀s. closed s ∧ interior s = ∅ ⇔ ∃t. open t ∧ s = frontier t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN CLOSED_IN interior_DEF OPEN_IN frontier_DEF InteriorClosedEqEmptyAsFrontier`;; + +let FRONTIER_UNION = theorem `; + ∀s t. closure s ∩ closure t = ∅ + ⇒ frontier (s ∪ t) = frontier s ∪ frontier t + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierUnion`;; + +let CLOSURE_UNION_FRONTIER = theorem `; + ∀s. closure s = s ∪ frontier s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN closure_DEF frontier_DEF ClosureUnionFrontier`;; + +let FRONTIER_INTERIOR_SUBSET = theorem `; + ∀s. frontier (interior s) ⊂ frontier s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF interior_DEF FrontierInteriorSubset`;; + +let FRONTIER_CLOSURE_SUBSET = theorem `; + ∀s. frontier (closure s) ⊂ frontier s + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierClosureSubset`;; + +let SET_DIFF_FRONTIER = theorem `; + ∀s. s ━ frontier s = interior s + by simplify SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF interior_DEF SetDiffFrontier`;; + +let FRONTIER_INTER_SUBSET_INTER = theorem `; + ∀s t. frontier (s ∩ t) ⊂ closure s ∩ frontier t ∪ frontier s ∩ closure t + by fol SUBSET_UNIV TOPSPACE_EUCLIDEAN frontier_DEF closure_DEF FrontierInterSubsetInter`;; diff --git a/RichterHilbertAxiomGeometry/UniversalPropCartProd.ml b/RichterHilbertAxiomGeometry/UniversalPropCartProd.ml new file mode 100644 index 0000000..80c38d5 --- /dev/null +++ b/RichterHilbertAxiomGeometry/UniversalPropCartProd.ml @@ -0,0 +1,271 @@ +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* Definitions of FunctionSpace and FunctionComposition. A proof that the *) +(* Cartesian product satisfies the universal property that given functions *) +(* α ∈ M → A and β ∈ M → B, there is a unique γ ∈ M → A ∏ B whose *) +(* projections to A and B are f and g. *) + +needs "RichterHilbertAxiomGeometry/readable.ml";; + +ParseAsInfix("∉",(11, "right"));; +ParseAsInfix("∏",(20, "right"));; +ParseAsInfix("∘",(20, "right"));; +ParseAsInfix("→",(13,"right"));; + +(* +∉ |- ∀a l. a ∉ l ⇔ ¬(a ∈ l) + +CartesianProduct + |- ∀X Y. X ∏ Y = {x,y | x ∈ X ∧ y ∈ Y} + +FUNCTION |- ∀α. FUNCTION α ⇔ + (∃f s t. α = t,f,s ∧ + (∀x. x ∈ s ⇒ f x ∈ t) ∧ (∀x. x ∉ s ⇒ f x = (@y. T))) + +SOURCE |- ∀α. SOURCE α = SND (SND α) + +FUN |- ∀α. FUN α = FST (SND α) + +TARGET |- ∀α. TARGET α = FST α + +FunctionSpace + |- ∀s t. s → t = {α | FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α} + +makeFunction + |- ∀t f s. makeFunction t f s = t,(λx. if x ∈ s then f x else @y. T),s + +Projection1Function + |- ∀X Y. Pi1 X Y = makeFunction X FST (X ∏ Y) + +Projection2Function + |- ∀X Y. Pi2 X Y = makeFunction Y SND (X ∏ Y) + +FunctionComposition + |- ∀α β. α ∘ β = makeFunction (TARGET α) (FUN α o FUN β) (SOURCE β) + +IN_CartesianProduct + |- ∀X Y x y. x,y ∈ X ∏ Y ⇔ x ∈ X ∧ y ∈ Y + +CartesianFstSnd + |- ∀pair. pair ∈ X ∏ Y ⇒ FST pair ∈ X ∧ SND pair ∈ Y + +FUNCTION_EQ + |- ∀α β. FUNCTION α ∧ FUNCTION β ∧ SOURCE α = SOURCE β ∧ FUN α = FUN β ∧ + TARGET α = TARGET β ⇒ α = β + +IN_FunctionSpace + |- ∀s t α. α ∈ s → t ⇔ + FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α + +makeFunction_EQ + |- ∀f g s t. (∀x. x ∈ s ⇒ f x = g x) + ⇒ makeFunction t f s = makeFunction t g s + +makeFunctionyieldsFUN + |- ∀α g t f s. α = makeFunction t f s ∧ g = FUN α + ⇒ ∀x. x ∈ s ⇒ f x = g x + +makeFunctionEq + |- ∀α β f g s t. + α = makeFunction t f s ∧ β = makeFunction t g s ∧ + (∀x. x ∈ s ⇒ f x = g x) ⇒ α = β + +FunctionSpaceOnSource + |- ∀α f s t. α ∈ s → t ∧ f = FUN α ⇒ (∀x. x ∈ s ⇒ f x ∈ t) + +FunctionSpaceOnOffSource + |- ∀α f s t. α ∈ s → t ∧ f = FUN α + ⇒ (∀x. x ∈ s ⇒ f x ∈ t) ∧ (∀x. x ∉ s ⇒ f x = (@y. T)) + +ImpliesTruncatedFunctionSpace + |- ∀α s t f. + α = makeFunction t f s ∧ (∀x. x ∈ s ⇒ f x ∈ t) + ⇒ α ∈ s → t + +FunFunctionSpaceImplyFunction + |- ∀α s t f. α ∈ s → t ∧ f = FUN α ⇒ α = makeFunction t f s + +UseFunctionComposition + |- ∀α β u f t g s. + α = makeFunction u f t ∧ β = makeFunction t g s ∧ β ∈ s → t + ⇒ α ∘ β = makeFunction u (f o g) s + +PairProjectionFunctions + |- ∀X Y. Pi1 X Y ∈ X ∏ Y → X ∧ Pi2 X Y ∈ X ∏ Y → Y + +UniversalPropertyProduct + |- ∀M A B α β. α ∈ M → A ∧ β ∈ M → B + ⇒ (∃!γ. γ ∈ M → A ∏ B ∧ + Pi1 A B ∘ γ = α ∧ Pi2 A B ∘ γ = β) + +*) + +let NOTIN = NewDefinition `; + ∀a l. a ∉ l ⇔ ¬(a ∈ l)`;; + +let CartesianProduct = NewDefinition `; + ∀X Y. X ∏ Y = {x,y | x ∈ X ∧ y ∈ Y}`;; + +let FUNCTION = NewDefinition `; + FUNCTION α ⇔ ∃f s t. α = (t, f, s) ∧ + (∀x. x IN s ⇒ f x IN t) ∧ ∀x. x ∉ s ⇒ f x = @y. T`;; + +let SOURCE = NewDefinition `; + SOURCE α = SND (SND α)`;; + +let FUN = NewDefinition `; + FUN α = FST (SND α)`;; + +let TARGET = NewDefinition `; + TARGET α = FST α`;; + +let FunctionSpace = NewDefinition `; + ∀s t. s → t = {α | FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α}`;; + +let makeFunction = NewDefinition `; + ∀t f s. makeFunction t f s = (t, (λx. if x ∈ s then f x else @y. T), s)`;; + +let Projection1Function = NewDefinition `; + Pi1 X Y = makeFunction X FST (X ∏ Y)`;; + +let Projection2Function = NewDefinition `; + Pi2 X Y = makeFunction Y SND (X ∏ Y)`;; + +let FunctionComposition = NewDefinition `; + ∀α β. α ∘ β = makeFunction (TARGET α) (FUN α o FUN β) (SOURCE β)`;; + +let IN_CartesianProduct = theorem `; + ∀X Y x y. x,y ∈ X ∏ Y ⇔ x ∈ X ∧ y ∈ Y + + proof + rewrite IN_ELIM_THM CartesianProduct; fol PAIR_EQ; qed; +`;; + +let IN_CartesianProduct = theorem `; + ∀X Y x y. x,y ∈ X ∏ Y ⇔ x ∈ X ∧ y ∈ Y + + proof + rewrite IN_ELIM_THM CartesianProduct; fol PAIR_EQ; qed; +`;; + +let CartesianFstSnd = theorem `; + ∀pair. pair ∈ X ∏ Y ⇒ FST pair ∈ X ∧ SND pair ∈ Y + by rewrite FORALL_PAIR_THM PAIR_EQ IN_CartesianProduct`;; + +let FUNCTION_EQ = theorem `; + ∀α β. FUNCTION α ∧ FUNCTION β ∧ SOURCE α = SOURCE β ∧ + FUN α = FUN β ∧ TARGET α = TARGET β + ⇒ α = β + by simplify FORALL_PAIR_THM FUNCTION SOURCE TARGET FUN PAIR_EQ`;; + +let IN_FunctionSpace = theorem `; + ∀s t α. α ∈ s → t + ⇔ FUNCTION α ∧ s = SOURCE α ∧ t = TARGET α + by rewrite IN_ELIM_THM FunctionSpace`;; + +let makeFunction_EQ = theorem `; + ∀f g s t. (∀x. x ∈ s ⇒ f x = g x) + ⇒ makeFunction t f s = makeFunction t g s + by simplify makeFunction ∉ FUN_EQ_THM`;; + +let makeFunctionyieldsFUN = theorem `; + ∀α g t f s. α = makeFunction t f s ∧ g = FUN α + ⇒ ∀x. x ∈ s ⇒ f x = g x + by simplify makeFunction FORALL_PAIR_THM FUN PAIR_EQ`;; + +let makeFunctionEq = theorem `; + ∀α β f g s t. α = makeFunction t f s ∧ β = makeFunction t g s ∧ + (∀x. x ∈ s ⇒ f x = g x) ⇒ α = β + by simplify FORALL_PAIR_THM makeFunction PAIR_EQ`;; + +let FunctionSpaceOnSource = theorem `; + ∀α f s t. α ∈ s → t ∧ f = FUN α + ⇒ ∀x. x ∈ s ⇒ f x ∈ t + + proof + rewrite FORALL_PAIR_THM IN_FunctionSpace FUNCTION SOURCE TARGET PAIR_EQ FUN; + fol; qed; +`;; + +let FunctionSpaceOnOffSource = theorem `; + ∀α f s t. α ∈ s → t ∧ f = FUN α + ⇒ (∀x. x ∈ s ⇒ f x ∈ t) ∧ ∀x. x ∉ s ⇒ f x = @y. T + + proof + rewrite FORALL_PAIR_THM IN_FunctionSpace FUNCTION SOURCE TARGET PAIR_EQ FUN; + fol; qed; +`;; + +let ImpliesTruncatedFunctionSpace = theorem `; + ∀α s t f. α = makeFunction t f s ∧ (∀x. x ∈ s ⇒ f x ∈ t) + ⇒ α ∈ s → t + + proof + rewrite FORALL_PAIR_THM IN_FunctionSpace makeFunction FUNCTION SOURCE TARGET NOTIN PAIR_EQ; + fol; + qed; +`;; + +let FunFunctionSpaceImplyFunction = theorem `; + ∀α s t f. α ∈ s → t ∧ f = FUN α ⇒ α = makeFunction t f s + + proof + rewrite FORALL_PAIR_THM IN_FunctionSpace makeFunction FUNCTION SOURCE TARGET FUN NOTIN PAIR_EQ; + fol FUN_EQ_THM; + qed; +`;; + +let UseFunctionComposition = theorem `; + ∀α β u f t g s. α = makeFunction u f t ∧ + β = makeFunction t g s ∧ β ∈ s → t + ⇒ α _o_ β = makeFunction u (f o g) s + + proof + rewrite FORALL_PAIR_THM makeFunction FunctionComposition SOURCE TARGET FUN BETA_THM o_THM IN_FunctionSpace FUNCTION SOURCE TARGET NOTIN PAIR_EQ; + X_genl_TAC u' f' t' t1 g1 s1 u f t g s; + intro_TAC Hα Hβ Hβ_st Hs Ht; + (∀x. x ∈ s ⇒ g x ∈ t) [g_st] by fol Hβ_st Hβ; + simplify Hα GSYM Hs Hβ g_st; + qed; +`;; + +let PairProjectionFunctions = theorem `; + ∀X Y. Pi1 X Y ∈ X ∏ Y → X ∧ Pi2 X Y ∈ X ∏ Y → Y + + proof + intro_TAC ∀X Y; + ∀pair. pair ∈ X ∏ Y ⇒ FST pair ∈ X ∧ SND pair ∈ Y [] by fol CartesianFstSnd; + fol Projection1Function Projection2Function - ImpliesTruncatedFunctionSpace; + qed; +`;; + +let UniversalPropertyProduct = theorem `; + ∀M A B α β. α ∈ M → A ∧ β ∈ M → B + ⇒ ∃!γ. γ ∈ M → A ∏ B ∧ Pi1 A B ∘ γ = α ∧ Pi2 A B ∘ γ = β + + proof + intro_TAC ∀M A B α β, H1; + consider f g such that f = FUN α ∧ g = FUN β [fgExist] by fol; + consider h such that h = λx. (f x,g x) [hExists] by fol; + ∀x. x ∈ M ⇒ h x ∈ A ∏ B [hProd] by fol hExists IN_CartesianProduct H1 fgExist FunctionSpaceOnSource; + consider γ such that γ = makeFunction (A ∏ B) h M [γExists] by fol; + γ ∈ M → A ∏ B [γFunSpace] by fol - hProd ImpliesTruncatedFunctionSpace; + ∀x. x ∈ M ⇒ (FST o h) x = f x ∧ (SND o h) x = g x [h_fg] by simplify hExists PAIR o_THM; + Pi1 A B ∘ γ = makeFunction A (FST o h) M ∧ + Pi2 A B ∘ γ = makeFunction B (SND o h) M [] by fol Projection1Function Projection2Function γExists γFunSpace UseFunctionComposition; + Pi1 A B ∘ γ = α ∧ Pi2 A B ∘ γ = β [γWorks] by fol - h_fg makeFunction_EQ H1 fgExist FunFunctionSpaceImplyFunction; + ∀θ. θ ∈ M → A ∏ B ∧ Pi1 A B ∘ θ = α ∧ Pi2 A B ∘ θ = β ⇒ θ = γ [] + proof + intro_TAC ∀θ, θWorks; + consider k such that k = FUN θ [kExists] by fol; + θ = makeFunction (A ∏ B) k M [θFUNk] by fol θWorks - FunFunctionSpaceImplyFunction; + α = makeFunction A (FST o k) M ∧ β = makeFunction B (SND o k) M [] by fol Projection1Function Projection2Function θFUNk θWorks UseFunctionComposition; + ∀x. x ∈ M ⇒ f x = (FST o k) x ∧ g x = (SND o k) x [fg_k] by fol ISPECL [α; f; A; (FST o k); M] makeFunctionyieldsFUN ISPECL [β; g; B; (SND o k); M] makeFunctionyieldsFUN - fgExist; + ∀x. x ∈ M ⇒ k x = ((FST o k) x, (SND o k) x) [] by fol PAIR o_THM; + ∀x. x ∈ M ⇒ k x = (f x, g x) [] by fol - fg_k PAIR_EQ; + fol hExists θFUNk γExists - makeFunctionEq; + qed; + fol γFunSpace γWorks - EXISTS_UNIQUE_THM; + qed; +`;; diff --git a/RichterHilbertAxiomGeometry/error-checking.ml b/RichterHilbertAxiomGeometry/error-checking.ml new file mode 100644 index 0000000..ec93475 --- /dev/null +++ b/RichterHilbertAxiomGeometry/error-checking.ml @@ -0,0 +1,358 @@ +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* Examples showing error messages displayed by readable.ml when raising the *) +(* exception Readable_fail, with some working examples interspersed. *) + +needs "RichterHilbertAxiomGeometry/readable.ml";; + +let s = "abc]edf" in Str.string_before s (FindMatch "\[" "\]" s);; + +let s = "123456[abc]lmn[op[abc]pq]rs!!!!!!!!!!]xyz" in + Str.string_before s (FindMatch "\[" "\]" s);; + +(* val it : string = "abc]" + val it : string = "123456[abc]lmn[op[abc]pq]rs!!!!!!!!!!]" *) + +let s = "123456[abc]lmn[op[abc]pq]rs!!!!!!!!!![]xyz" in Str.string_before s + (FindMatch "\[" "\]" s);; + +(* Exception: +No matching right bracket operator \] to left bracket operator \[ in xyz. *) + +let s = "123456[abc]lmn[op[a; b; c]pq]rs[];xyz" in + Str.string_before s (FindSemicolon s);; + +let s = "123456[abc]lmn[op[a; b; c]pq]rs![]xyz" in + Str.string_before s (FindSemicolon s);; + +(* val it : string = "123456[abc]lmn[op[a; b; c]pq]rs[]" + + Exception: No final semicolon in 123456[abc]lmn[op[a; b; c]pq]rs![]xyz. *) + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + intro_TAC !m n, H1; + MP_TAC ISPECL [m; n; 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +(* 0..0..3..6..solved at 21 +0..0..3..6..31..114..731..5973..solved at 6087 +val MOD_MOD_REFL : thm = |- !m n. ~(n = 0) ==> m MOD n MOD n = m MOD n *) + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + INTRO_TAC !m n, H1; + MP_TAC ISPECL [m; n; 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +(* Exception: Can't parse as a Proof: + + INTRO_TAC !m n, H1. *) + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + intro_TAC !m n, H1; + MP_TAC ISPECL [m; n; 1] mod_mod; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +(* Exception: Not a theorem: + mod_mod. *) + + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + intro_TAC !m n, H1; + MP_TAC ISPECL MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +(* Exception: termlist->thm->thm ISPECL + not followed by term list in + MOD_MOD. *) + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + intro_TAC !m n, H1; + MP_TAC ISPECL m n 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +(* Exception: +termlist->thm->thm ISPECL + not followed by term list in + m n 1] MOD_MOD. *) + +interactive_goal `;∀p q. p * p = 2 * q * q ⇒ q = 0 +`;; +interactive_proof `; + MATCH_MP_TAC ; + intro_TAC ∀p, A, ∀q, B; + EVEN(p * p) ⇔ EVEN(2 * q * q) [] proof qed; +`;; + +(* Exception: Empty theorem: + . *) + + +interactive_goal `;∀p q. p * p = 2 * q * q ⇒ q = 0 +`;; +interactive_proof `; + MATCH_MP_TAC num_WF num_WF ; + intro_TAC ∀p, A, ∀q, B; + EVEN(p * p) ⇔ EVEN(2 * q * q) [] proof qed; +`;; + +(* Exception: +thm_tactic MATCH_MP_TAC not followed by a theorem, but instead + num_WF num_WF . *) + +let EXP_2 = theorem `; + ∀n:num. n EXP 2 = n * n + by REWRITE BIT0_THM BIT1_THM EXP EXP_ADD MULT_CLAUSES ADD_CLAUSES`;; + +(* Exception: +Not a proof: + REWRITE BIT0_THM BIT1_THM EXP EXP_ADD MULT_CLAUSES ADD_CLAUSES. + +The problem is that REWRITE should be rewrite.*) + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + prooof + intro_TAC !m n, H1; + MP_TAC ISPECL [m; n; 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +(* Exception: +Missing initial "proof", "by", or final "qed;" in + + !m n. ~(n = 0) ==> ((m MOD n) MOD n = m MOD n) + + prooof + intro_TAC !m n, H1; + MP_TAC ISPECL [m; n; 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +. *) + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + intro_TAC !m n, H1; + MP_TAC ISPECL [m; n; 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +What me worry? +`;; + +(* Exception: Trailing garbage after the proof...qed: +What me worry? +. + + Two examples from the ocaml reference manual sec 1.4 to show the + handling of exceptions other than Readable_fail. *) + +exception Empty_list;; +let head l = + match l with + [] -> raise Empty_list + | hd :: tl -> hd;; +head [1;2];; +head [];; + +exception Unbound_variable of string;; + +type expression = + Const of float + | Var of string + | Sum of expression * expression + | Diff of expression * expression + | Prod of expression * expression + | Quot of expression * expression;; + +let rec eval env exp = + match exp with + Const c -> c + | Var v -> + (try List.assoc v env with Not_found -> raise(Unbound_variable v)) + | Sum(f, g) -> eval env f +. eval env g + | Diff(f, g) -> eval env f -. eval env g + | Prod(f, g) -> eval env f *. eval env g + | Quot(f, g) -> eval env f /. eval env g;; + +eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "x", Const 2.0), Var "y"));; + +eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "z", Const 2.0), Var "y"));; + + +(* The only difference caused by printReadExn is that + Exception: Unbound_variable "z". + is now + Exception: Unbound_variable("z"). *) + + +let binom = define + `(!n. binom(n,0) = 1) /\ + (!k. binom(0,SUC(k)) = 0) /\ + (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; + +let BINOM_LT = theorem `; + ∀n k. n < k ⇒ binom(n,k) = 0 + + proof + INDUCT_TAC; INDUCT_TAC; + rewrite binom ARITH LT_SUC LT; + ASM_SIMP_TAC ARITH_RULE [n < k ==> n < SUC(k)] ARITH; + qed; +`;; + +let BINOM_REFL = theorem `; + ∀n. binom(n,n) = 1 + + proof + INDUCT_TAC; + ASM_SIMP_TAC binom BINOM_LT LT ARITH; + qed; +`;; + +let BINOMIAL_THEOREM = theorem `; + ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) + + proof + ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; + MATCH_MP_TAC num_INDUCTION; + simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; + intro_TAC ∀n, nThm; + rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; + rewriteR ADD_SYM; + rewriteRLDepth SUB_SUC EXP; + rewrite MULT_AC EQ_ADD_LCANCEL MESON [binom] [1 = binom(n, 0)] GSYM Nsum0SUC; + simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; + simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; + qed; +`;; + +(* val binom : thm = + |- (!n. binom (n,0) = 1) /\ + (!k. binom (0,SUC k) = 0) /\ + (!n k. binom (SUC n,SUC k) = binom (n,SUC k) + binom (n,k)) + val BINOM_LT : thm = |- !n k. n < k ==> binom (n,k) = 0 + val BINOM_REFL : thm = |- !n. binom (n,n) = 1 + 0..0..1..2..solved at 6 +val BINOMIAL_THEOREM : thm = + |- !n. (x + y) EXP n = + nsum (0..n) (\k. binom (n,k) * x EXP k * y EXP (n - k)) *) + + +let BINOM_LT = theorem `; + ∀n k. n < k ⇒ binom(n,k) = 0 + + proof + INDUCT_TAC; INDUCT_TAC; + rewrite binom ARITH LT_SUC LT; + ASM_SIMP_TAC ARITH_RULE n < k ==> n < SUC(k)] ARITH; + qed; +`;; + +(* Exception: +term->thm ARITH_RULE not followed by term list, but instead +n < k ==> n < SUC(k)] ARITH. *) + + +let BINOM_LT = theorem `; + ∀n k. n < k ⇒ binom(n,k) = 0 + + proof + INDUCT_TAC; INDUCT_TAC; + rewrite binom ARITH LT_SUC LT; + ASM_SIMP_TAC ARITH_RULE [n < k; n < SUC(k)] ARITH; + qed; +`;; + +(* Exception: +term->thm ARITH_RULE not followed by length 1 term list, but instead the list +[n < k; n < SUC(k)]. *) + + +let BINOM_LT = theorem `; + ∀n k. n < k ⇒ binom(n,k) = 0 + + proof + INDUCT_TAC; INDUCT_TAC; + rewrite binom ARITH LT_SUC LT; + ASM_SIMP_TAC ARITH_RULE [ ] ARITH; + qed; +`;; + +(* Exception: +term->thm ARITH_RULE not followed by length 1 term list, but instead the list + []. *) + + +let BINOMIAL_THEOREM = theorem `; + ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) + + proof + ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; + MATCH_MP_TAC num_INDUCTION; + simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; + intro_TAC ∀n, nThm; + rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; + rewriteR ADD_SYM; + rewriteRLDepth SUB_SUC EXP; + rewrite MULT_AC EQ_ADD_LCANCEL MESON binom] [1 = binom(n, 0)] GSYM Nsum0SUC; + simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; + simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; + qed; +`;; + +(* Exception: +thmlist->term->thm MESON not followed by thm list in + binom] [1 = binom(n, 0)] GSYM Nsum0SUC. *) + + +let BINOMIAL_THEOREM = theorem `; + ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) + + proof + ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; + MATCH_MP_TAC num_INDUCTION; + simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; + intro_TAC ∀n, nThm; + rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; + rewriteR ADD_SYM; + rewriteRLDepth SUB_SUC EXP; + rewrite MULT_AC EQ_ADD_LCANCEL MESON [binom] 1 = binom(n, 0)] GSYM Nsum0SUC; + simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; + simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; + qed; +`;; + +(* Exception: +thmlist->term->thm MESON followed by list of theorems [binom] + not followed by term in + 1 = binom(n, 0)] GSYM Nsum0SUC. *) + diff --git a/RichterHilbertAxiomGeometry/from_topology.ml b/RichterHilbertAxiomGeometry/from_topology.ml new file mode 100644 index 0000000..1c016cc --- /dev/null +++ b/RichterHilbertAxiomGeometry/from_topology.ml @@ -0,0 +1,18336 @@ +(* (c) Copyright, John Harrison 1998-2014 *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* Theorems taken directly from Multivariate/topology.ml which run after *) +(* loading Topology.ml. *) + +needs "Library/card.ml";; +needs "Multivariate/determinants.ml";; +needs "RichterHilbertAxiomGeometry/Topology.ml";; + +(* ------------------------------------------------------------------------- *) +(* Open and closed balls and spheres. *) +(* ------------------------------------------------------------------------- *) + +let sphere = new_definition + `sphere(x,e) = { y | dist(x,y) = e}`;; + +let IN_SPHERE = prove + (`!x y e. y IN sphere(x,e) <=> dist(x,y) = e`, + REWRITE_TAC[sphere; IN_ELIM_THM]);; + +let IN_BALL_0 = prove + (`!x e. x IN ball(vec 0,e) <=> norm(x) < e`, + REWRITE_TAC[IN_BALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let IN_CBALL_0 = prove + (`!x e. x IN cball(vec 0,e) <=> norm(x) <= e`, + REWRITE_TAC[IN_CBALL; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let IN_SPHERE_0 = prove + (`!x e. x IN sphere(vec 0,e) <=> norm(x) = e`, + REWRITE_TAC[IN_SPHERE; dist; VECTOR_SUB_LZERO; NORM_NEG]);; + +let BALL_TRIVIAL = prove + (`!x. ball(x,&0) = {}`, + REWRITE_TAC[EXTENSION; IN_BALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; + +let CBALL_TRIVIAL = prove + (`!x. cball(x,&0) = {x}`, + REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING; NOT_IN_EMPTY] THEN NORM_ARITH_TAC);; + +let CENTRE_IN_CBALL = prove + (`!x e. x IN cball(x,e) <=> &0 <= e`, + MESON_TAC[IN_CBALL; DIST_REFL]);; + +let SPHERE_SUBSET_CBALL = prove + (`!x e. sphere(x,e) SUBSET cball(x,e)`, + REWRITE_TAC[IN_SPHERE; IN_CBALL; SUBSET] THEN REAL_ARITH_TAC);; + +let SUBSET_BALL = prove + (`!x d e. d <= e ==> ball(x,d) SUBSET ball(x,e)`, + REWRITE_TAC[SUBSET; IN_BALL] THEN MESON_TAC[REAL_LTE_TRANS]);; + +let SUBSET_CBALL = prove + (`!x d e. d <= e ==> cball(x,d) SUBSET cball(x,e)`, + REWRITE_TAC[SUBSET; IN_CBALL] THEN MESON_TAC[REAL_LE_TRANS]);; + +let BALL_MAX_UNION = prove + (`!a r s. ball(a,max r s) = ball(a,r) UNION ball(a,s)`, + REWRITE_TAC[IN_BALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; + +let BALL_MIN_INTER = prove + (`!a r s. ball(a,min r s) = ball(a,r) INTER ball(a,s)`, + REWRITE_TAC[IN_BALL; IN_INTER; EXTENSION] THEN REAL_ARITH_TAC);; + +let CBALL_MAX_UNION = prove + (`!a r s. cball(a,max r s) = cball(a,r) UNION cball(a,s)`, + REWRITE_TAC[IN_CBALL; IN_UNION; EXTENSION] THEN REAL_ARITH_TAC);; + +let CBALL_MIN_INTER = prove + (`!x d e. cball(x,min d e) = cball(x,d) INTER cball(x,e)`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_CBALL] THEN REAL_ARITH_TAC);; + +let BALL_TRANSLATION = prove + (`!a x r. ball(a + x,r) = IMAGE (\y. a + y) (ball(x,r))`, + REWRITE_TAC[ball] THEN GEOM_TRANSLATE_TAC[]);; + +let CBALL_TRANSLATION = prove + (`!a x r. cball(a + x,r) = IMAGE (\y. a + y) (cball(x,r))`, + REWRITE_TAC[cball] THEN GEOM_TRANSLATE_TAC[]);; + +let SPHERE_TRANSLATION = prove + (`!a x r. sphere(a + x,r) = IMAGE (\y. a + y) (sphere(x,r))`, + REWRITE_TAC[sphere] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants + [BALL_TRANSLATION; CBALL_TRANSLATION; SPHERE_TRANSLATION];; + +let BALL_LINEAR_IMAGE = prove + (`!f:real^M->real^N x r. + linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) + ==> ball(f x,r) = IMAGE f (ball(x,r))`, + REWRITE_TAC[ball] THEN GEOM_TRANSFORM_TAC[]);; + +let CBALL_LINEAR_IMAGE = prove + (`!f:real^M->real^N x r. + linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) + ==> cball(f x,r) = IMAGE f (cball(x,r))`, + REWRITE_TAC[cball] THEN GEOM_TRANSFORM_TAC[]);; + +let SPHERE_LINEAR_IMAGE = prove + (`!f:real^M->real^N x r. + linear f /\ (!y. ?x. f x = y) /\ (!x. norm(f x) = norm x) + ==> sphere(f x,r) = IMAGE f (sphere(x,r))`, + REWRITE_TAC[sphere] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants + [BALL_LINEAR_IMAGE; CBALL_LINEAR_IMAGE; SPHERE_LINEAR_IMAGE];; + +let BALL_SCALING = prove + (`!c. &0 < c ==> !x r. ball(c % x,c * r) = IMAGE (\x. c % x) (ball(x,r))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN + REWRITE_TAC[IN_BALL; DIST_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LT_LMUL_EQ]);; + +let CBALL_SCALING = prove + (`!c. &0 < c ==> !x r. cball(c % x,c * r) = IMAGE (\x. c % x) (cball(x,r))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SURJECTIVE_SCALING; REAL_LT_IMP_NZ]; ALL_TAC] THEN + REWRITE_TAC[IN_CBALL; DIST_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_LE_LMUL_EQ]);; + +add_scaling_theorems [BALL_SCALING; CBALL_SCALING];; + +let CBALL_DIFF_BALL = prove + (`!a r. cball(a,r) DIFF ball(a,r) = sphere(a,r)`, + REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let BALL_UNION_SPHERE = prove + (`!a r. ball(a,r) UNION sphere(a,r) = cball(a,r)`, + REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let SPHERE_UNION_BALL = prove + (`!a r. sphere(a,r) UNION ball(a,r) = cball(a,r)`, + REWRITE_TAC[ball; cball; sphere; EXTENSION; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC);; + +let CBALL_DIFF_SPHERE = prove + (`!a r. cball(a,r) DIFF sphere(a,r) = ball(a,r)`, + REWRITE_TAC[EXTENSION; IN_DIFF; IN_SPHERE; IN_BALL; IN_CBALL] THEN + REAL_ARITH_TAC);; + +let OPEN_CONTAINS_BALL_EQ = prove + (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ ball(x,e) SUBSET s)`, + MESON_TAC[OPEN_CONTAINS_BALL; SUBSET; CENTRE_IN_BALL]);; + +let BALL_EQ_EMPTY = prove + (`!x e. (ball(x,e) = {}) <=> e <= &0`, + REWRITE_TAC[EXTENSION; IN_BALL; NOT_IN_EMPTY; REAL_NOT_LT] THEN + MESON_TAC[DIST_POS_LE; REAL_LE_TRANS; DIST_REFL]);; + +let BALL_EMPTY = prove + (`!x e. e <= &0 ==> ball(x,e) = {}`, + REWRITE_TAC[BALL_EQ_EMPTY]);; + +let OPEN_CONTAINS_CBALL = prove + (`!s. open s <=> !x. x IN s ==> ?e. &0 < e /\ cball(x,e) SUBSET s`, + GEN_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SUBSET_TRANS; BALL_SUBSET_CBALL]] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + SUBGOAL_THEN `e / &2 < e` (fun th -> ASM_MESON_TAC[th; REAL_LET_TRANS]) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +let OPEN_CONTAINS_CBALL_EQ = prove + (`!s. open s ==> (!x. x IN s <=> ?e. &0 < e /\ cball(x,e) SUBSET s)`, + MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET; REAL_LT_IMP_LE; CENTRE_IN_CBALL]);; + +let SPHERE_EQ_EMPTY = prove + (`!a:real^N r. sphere(a,r) = {} <=> r < &0`, + REWRITE_TAC[sphere; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; CONV_TAC NORM_ARITH] THEN + MESON_TAC[VECTOR_CHOOSE_DIST; REAL_NOT_LE]);; + +let SPHERE_EMPTY = prove + (`!a:real^N r. r < &0 ==> sphere(a,r) = {}`, + REWRITE_TAC[SPHERE_EQ_EMPTY]);; + +let NEGATIONS_BALL = prove + (`!r. IMAGE (--) (ball(vec 0:real^N,r)) = ball(vec 0,r)`, + GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_BALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let NEGATIONS_CBALL = prove + (`!r. IMAGE (--) (cball(vec 0:real^N,r)) = cball(vec 0,r)`, + GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_CBALL_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let NEGATIONS_SPHERE = prove + (`!r. IMAGE (--) (sphere(vec 0:real^N,r)) = sphere(vec 0,r)`, + GEN_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_SPHERE_0; NORM_NEG] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let ORTHOGONAL_TRANSFORMATION_BALL = prove + (`!f:real^N->real^N r. + orthogonal_transformation f ==> IMAGE f (ball(vec 0,r)) = ball(vec 0,r)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_BALL_0] THEN + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; + +let ORTHOGONAL_TRANSFORMATION_CBALL = prove + (`!f:real^N->real^N r. + orthogonal_transformation f ==> IMAGE f (cball(vec 0,r)) = cball(vec 0,r)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_CBALL_0] THEN + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; + +let ORTHOGONAL_TRANSFORMATION_SPHERE = prove + (`!f:real^N->real^N r. + orthogonal_transformation f + ==> IMAGE f (sphere(vec 0,r)) = sphere(vec 0,r)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SPHERE_0] THEN + MESON_TAC[ORTHOGONAL_TRANSFORMATION_INVERSE; ORTHOGONAL_TRANSFORMATION]);; + +(* ------------------------------------------------------------------------- *) +(* Also some invariance theorems for relative topology. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_IN_TRANSLATION_EQ = prove + (`!a s t. open_in (subtopology euclidean (IMAGE (\x. a + x) t)) + (IMAGE (\x. a + x) s) <=> + open_in (subtopology euclidean t) s`, + REWRITE_TAC[open_in] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [OPEN_IN_TRANSLATION_EQ];; + +let CLOSED_IN_TRANSLATION_EQ = prove + (`!a s t. closed_in (subtopology euclidean (IMAGE (\x. a + x) t)) + (IMAGE (\x. a + x) s) <=> + closed_in (subtopology euclidean t) s`, + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [CLOSED_IN_TRANSLATION_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Limit points. *) +(* ------------------------------------------------------------------------- *) + +let LIMPT_APPROACHABLE = prove + (`!x s. x limit_point_of s <=> + !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[limit_point_of] THEN + MESON_TAC[open_def; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; IN_BALL]);; + +let LIMPT_APPROACHABLE_LE = prove + (`!x s. x limit_point_of s <=> + !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ dist(x',x) <= e`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + MATCH_MP_TAC(TAUT `(~a <=> ~b) ==> (a <=> b)`) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> c ==> ~(a /\ b)`; APPROACHABLE_LT_LE]);; + +let LIMPT_UNIV = prove + (`!x:real^N. x limit_point_of UNIV`, + GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `?c:real^N. norm(c) = e / &2` CHOOSE_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_SIZE; REAL_HALF; REAL_LT_IMP_LE]; + ALL_TAC] THEN + EXISTS_TAC `x + c:real^N` THEN + REWRITE_TAC[dist; VECTOR_EQ_ADDR] THEN ASM_REWRITE_TAC[VECTOR_ADD_SUB] THEN + SUBGOAL_THEN `&0 < e / &2 /\ e / &2 < e` + (fun th -> ASM_MESON_TAC[th; NORM_0; REAL_LT_REFL]) THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC);; + +let CLOSED_POSITIVE_ORTHANT = prove + (`closed {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> &0 <= x$i}`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `--(x:real^N $ i)`) THEN + ASM_REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; NOT_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC(TAUT `(a ==> ~c) ==> ~(a /\ b /\ c)`) THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `!b. abs x <= b /\ b <= a ==> ~(a + x < &0)`) THEN + EXISTS_TAC `abs((y - x :real^N)$i)` THEN + ASM_SIMP_TAC[dist; COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; REAL_ARITH + `x < &0 /\ &0 <= y ==> abs(x) <= abs(y - x)`]);; + +let FINITE_SET_AVOID = prove + (`!a:real^N s. FINITE s + ==> ?d. &0 < d /\ !x. x IN s /\ ~(x = a) ==> d <= dist(a,x)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `s:real^N->bool`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `x:real^N = a` THEN REWRITE_TAC[IN_INSERT] THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `min d (dist(a:real^N,x))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ; REAL_MIN_LE] THEN + ASM_MESON_TAC[REAL_LE_REFL]);; + +let LIMIT_POINT_FINITE = prove + (`!s a. FINITE s ==> ~(a limit_point_of s)`, + REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LE] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM; REAL_NOT_LE; + REAL_NOT_LT; TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`] THEN + MESON_TAC[FINITE_SET_AVOID; DIST_SYM]);; + +let LIMPT_SING = prove + (`!x y:real^N. ~(x limit_point_of {y})`, + SIMP_TAC[LIMIT_POINT_FINITE; FINITE_SING]);; + +let LIMPT_INSERT = prove + (`!s x y:real^N. x limit_point_of (y INSERT s) <=> x limit_point_of s`, + ONCE_REWRITE_TAC[SET_RULE `y INSERT s = {y} UNION s`] THEN + REWRITE_TAC[LIMIT_POINT_UNION] THEN + SIMP_TAC[FINITE_SING; LIMIT_POINT_FINITE]);; + +let LIMPT_OF_LIMPTS = prove + (`!x:real^N s. + x limit_point_of {y | y limit_point_of s} ==> x limit_point_of s`, + REWRITE_TAC[LIMPT_APPROACHABLE; IN_ELIM_THM] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `dist(y:real^N,x)`) THEN + ASM_SIMP_TAC[DIST_POS_LT] THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let CLOSED_LIMPTS = prove + (`!s. closed {x:real^N | x limit_point_of s}`, + REWRITE_TAC[CLOSED_LIMPT; IN_ELIM_THM; LIMPT_OF_LIMPTS]);; + +let DISCRETE_IMP_CLOSED = prove + (`!s:real^N->bool e. + &0 < e /\ + (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) + ==> closed s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!x:real^N. ~(x limit_point_of s)` + (fun th -> MESON_TAC[th; CLOSED_LIMPT]) THEN + GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN + REWRITE_TAC[REAL_HALF; ASSUME `&0 < e`] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min (e / &2) (dist(x:real^N,y))`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; DIST_POS_LT; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^N`; `z:real^N`]) THEN + ASM_REWRITE_TAC[] THEN ASM_NORM_ARITH_TAC);; + +let LIMPT_OF_UNIV = prove + (`!x. x limit_point_of (:real^N)`, + GEN_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE; IN_UNIV] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `e / &2`] VECTOR_CHOOSE_DIST) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + POP_ASSUM MP_TAC THEN CONV_TAC NORM_ARITH);; + +let LIMPT_OF_OPEN_IN = prove + (`!s t x:real^N. + open_in (subtopology euclidean s) t /\ x limit_point_of s /\ x IN t + ==> x limit_point_of t`, + REWRITE_TAC[open_in; SUBSET; LIMPT_APPROACHABLE] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + TRY(FIRST_X_ASSUM MATCH_MP_TAC) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +let LIMPT_OF_OPEN = prove + (`!s x:real^N. open s /\ x IN s ==> x limit_point_of s`, + REWRITE_TAC[OPEN_IN] THEN ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + MESON_TAC[LIMPT_OF_OPEN_IN; LIMPT_OF_UNIV]);; + +let OPEN_IN_SING = prove + (`!s a. open_in (subtopology euclidean s) {a} <=> + a IN s /\ ~(a limit_point_of s)`, + REWRITE_TAC[open_in; LIMPT_APPROACHABLE; SING_SUBSET; IN_SING] THEN + REWRITE_TAC[FORALL_UNWIND_THM2] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Interior of a set. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_LIMIT_POINT = prove + (`!s x:real^N. x IN interior s ==> x limit_point_of s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IN_INTERIOR; IN_ELIM_THM; SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `d:real` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`x:real^N`; `min d e / &2`] VECTOR_CHOOSE_DIST) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC; + CONV_TAC (RAND_CONV SYM_CONV) THEN REWRITE_TAC[GSYM DIST_EQ_0]; + ONCE_REWRITE_TAC[DIST_SYM]] THEN + ASM_REAL_ARITH_TAC);; + +let INTERIOR_SING = prove + (`!a:real^N. interior {a} = {}`, + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + MESON_TAC[INTERIOR_LIMIT_POINT; LIMPT_SING]);; + +(* ------------------------------------------------------------------------- *) +(* Closure of a set. *) +(* ------------------------------------------------------------------------- *) + +let LIMPT_OF_CLOSURE = prove + (`!x:real^N s. x limit_point_of closure s <=> x limit_point_of s`, + REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM; LIMIT_POINT_UNION] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT `(q ==> p) ==> (p \/ q <=> p)`) THEN + REWRITE_TAC[LIMPT_OF_LIMPTS]);; + +(* ------------------------------------------------------------------------- *) +(* A variant of nets (slightly non-standard but good for our purposes). *) +(* ------------------------------------------------------------------------- *) + +let net_tybij = new_type_definition "net" ("mk_net","netord") + (prove + (`?g:A->A->bool. !x y. (!z. g z x ==> g z y) \/ (!z. g z y ==> g z x)`, + EXISTS_TAC `\x:A y:A. F` THEN REWRITE_TAC[]));; + +let NET = prove + (`!n x y. (!z. netord n z x ==> netord n z y) \/ + (!z. netord n z y ==> netord n z x)`, + REWRITE_TAC[net_tybij; ETA_AX]);; + +let OLDNET = prove + (`!n x y. netord n x x /\ netord n y y + ==> ?z. netord n z z /\ + !w. netord n w z ==> netord n w x /\ netord n w y`, + MESON_TAC[NET]);; + +let NET_DILEMMA = prove + (`!net. (?a. (?x. netord net x a) /\ (!x. netord net x a ==> P x)) /\ + (?b. (?x. netord net x b) /\ (!x. netord net x b ==> Q x)) + ==> ?c. (?x. netord net x c) /\ (!x. netord net x c ==> P x /\ Q x)`, + MESON_TAC[NET]);; + +(* ------------------------------------------------------------------------- *) +(* Common nets and the "within" modifier for nets. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("within",(14,"right"));; +parse_as_infix("in_direction",(14,"right"));; + +let at = new_definition + `at a = mk_net(\x y. &0 < dist(x,a) /\ dist(x,a) <= dist(y,a))`;; + +let at_infinity = new_definition + `at_infinity = mk_net(\x y. norm(x) >= norm(y))`;; + +let sequentially = new_definition + `sequentially = mk_net(\m:num n. m >= n)`;; + +let within = new_definition + `net within s = mk_net(\x y. netord net x y /\ x IN s)`;; + +let in_direction = new_definition + `a in_direction v = (at a) within {b | ?c. &0 <= c /\ (b - a = c % v)}`;; + +(* ------------------------------------------------------------------------- *) +(* Prove that they are all nets. *) +(* ------------------------------------------------------------------------- *) + +let NET_PROVE_TAC[def] = + REWRITE_TAC[GSYM FUN_EQ_THM; def] THEN + REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[GSYM(CONJUNCT2 net_tybij)];; + +let AT = prove + (`!a:real^N x y. + netord(at a) x y <=> &0 < dist(x,a) /\ dist(x,a) <= dist(y,a)`, + GEN_TAC THEN NET_PROVE_TAC[at] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS; REAL_LET_TRANS]);; + +let AT_INFINITY = prove + (`!x y. netord at_infinity x y <=> norm(x) >= norm(y)`, + NET_PROVE_TAC[at_infinity] THEN + REWRITE_TAC[real_ge; REAL_LE_REFL] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_REFL; REAL_LE_TRANS]);; + +let SEQUENTIALLY = prove + (`!m n. netord sequentially m n <=> m >= n`, + NET_PROVE_TAC[sequentially] THEN REWRITE_TAC[GE; LE_REFL] THEN + MESON_TAC[LE_CASES; LE_REFL; LE_TRANS]);; + +let WITHIN = prove + (`!n s x y. netord(n within s) x y <=> netord n x y /\ x IN s`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[within; GSYM FUN_EQ_THM] THEN + REWRITE_TAC[GSYM(CONJUNCT2 net_tybij); ETA_AX] THEN + MESON_TAC[NET]);; + +let IN_DIRECTION = prove + (`!a v x y. netord(a in_direction v) x y <=> + &0 < dist(x,a) /\ dist(x,a) <= dist(y,a) /\ + ?c. &0 <= c /\ (x - a = c % v)`, + REWRITE_TAC[WITHIN; AT; in_direction; IN_ELIM_THM; CONJ_ACI]);; + +let WITHIN_UNIV = prove + (`!x:real^N. at x within UNIV = at x`, + REWRITE_TAC[within; at; IN_UNIV] THEN REWRITE_TAC[ETA_AX; net_tybij]);; + +let WITHIN_WITHIN = prove + (`!net s t. (net within s) within t = net within (s INTER t)`, + ONCE_REWRITE_TAC[within] THEN + REWRITE_TAC[WITHIN; IN_INTER; GSYM CONJ_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Identify trivial limits, where we can't approach arbitrarily closely. *) +(* ------------------------------------------------------------------------- *) + +let trivial_limit = new_definition + `trivial_limit net <=> + (!a:A b. a = b) \/ + ?a:A b. ~(a = b) /\ !x. ~(netord(net) x a) /\ ~(netord(net) x b)`;; + +let TRIVIAL_LIMIT_WITHIN = prove + (`!a:real^N. trivial_limit (at a within s) <=> ~(a limit_point_of s)`, + REWRITE_TAC[trivial_limit; LIMPT_APPROACHABLE_LE; WITHIN; AT; DIST_NZ] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(DISJ_CASES_THEN MP_TAC) THENL + [MESON_TAC[REAL_LT_01; REAL_LT_REFL; VECTOR_CHOOSE_DIST; + DIST_REFL; REAL_LT_IMP_LE]; + DISCH_THEN(X_CHOOSE_THEN `b:real^N` (X_CHOOSE_THEN `c:real^N` + STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `&0 < dist(a,b:real^N) \/ &0 < dist(a,c:real^N)` MP_TAC THEN + ASM_MESON_TAC[DIST_TRIANGLE; DIST_SYM; GSYM DIST_NZ; GSYM DIST_EQ_0; + REAL_ARITH `x <= &0 + &0 ==> ~(&0 < x)`]]; + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `a:real^N` THEN + SUBGOAL_THEN `?b:real^N. dist(a,b) = e` MP_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]]);; + +let TRIVIAL_LIMIT_AT = prove + (`!a. ~(trivial_limit (at a))`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; LIMPT_UNIV]);; + +let TRIVIAL_LIMIT_AT_INFINITY = prove + (`~(trivial_limit at_infinity)`, + REWRITE_TAC[trivial_limit; AT_INFINITY; real_ge] THEN + MESON_TAC[REAL_LE_REFL; VECTOR_CHOOSE_SIZE; REAL_LT_01; REAL_LT_LE]);; + +let TRIVIAL_LIMIT_SEQUENTIALLY = prove + (`~(trivial_limit sequentially)`, + REWRITE_TAC[trivial_limit; SEQUENTIALLY] THEN + MESON_TAC[GE_REFL; NOT_SUC]);; + +let LIM_WITHIN_CLOSED_TRIVIAL = prove + (`!a s. closed s /\ ~(a IN s) ==> trivial_limit (at a within s)`, + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN MESON_TAC[CLOSED_LIMPT]);; + +let NONTRIVIAL_LIMIT_WITHIN = prove + (`!net s. trivial_limit net ==> trivial_limit(net within s)`, + REWRITE_TAC[trivial_limit; WITHIN] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some property holds "sufficiently close" to the limit point. *) +(* ------------------------------------------------------------------------- *) + +let eventually = new_definition + `eventually p net <=> + trivial_limit net \/ + ?y. (?x. netord net x y) /\ (!x. netord net x y ==> p x)`;; + +let EVENTUALLY_HAPPENS = prove + (`!net p. eventually p net ==> trivial_limit net \/ ?x. p x`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_WITHIN_LE = prove + (`!s a:real^M p. + eventually p (at a within s) <=> + ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d ==> p(x)`, + REWRITE_TAC[eventually; AT; WITHIN; TRIVIAL_LIMIT_WITHIN] THEN + REWRITE_TAC[LIMPT_APPROACHABLE_LE; DIST_NZ] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LTE_TRANS]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(TAUT `(a ==> b) ==> ~a \/ b`) THEN DISCH_TAC THEN + SUBGOAL_THEN `?b:real^M. dist(a,b) = d` MP_TAC THENL + [ASM_SIMP_TAC[VECTOR_CHOOSE_DIST; REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^M` THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_NZ; DIST_SYM]);; + +let EVENTUALLY_WITHIN = prove + (`!s a:real^M p. + eventually p (at a within s) <=> + ?d. &0 < d /\ !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, + REWRITE_TAC[EVENTUALLY_WITHIN_LE] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> c ==> a /\ b ==> d`] THEN + REWRITE_TAC[APPROACHABLE_LT_LE]);; + +let EVENTUALLY_AT = prove + (`!a p. eventually p (at a) <=> + ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d ==> p(x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[EVENTUALLY_WITHIN; IN_UNIV]);; + +let EVENTUALLY_SEQUENTIALLY = prove + (`!p. eventually p sequentially <=> ?N. !n. N <= n ==> p n`, + REWRITE_TAC[eventually; SEQUENTIALLY; GE; LE_REFL; + TRIVIAL_LIMIT_SEQUENTIALLY] THEN MESON_TAC[LE_REFL]);; + +let EVENTUALLY_AT_INFINITY = prove + (`!p. eventually p at_infinity <=> ?b. !x. norm(x) >= b ==> p x`, + REWRITE_TAC[eventually; AT_INFINITY; TRIVIAL_LIMIT_AT_INFINITY] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + MESON_TAC[real_ge; REAL_LE_REFL; VECTOR_CHOOSE_SIZE; + REAL_ARITH `&0 <= b \/ (!x. x >= &0 ==> x >= b)`]);; + +let EVENTUALLY_AT_INFINITY_POS = prove + (`!p:real^N->bool. + eventually p at_infinity <=> ?b. &0 < b /\ !x. norm x >= b ==> p x`, + GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT_INFINITY; real_ge] THEN + MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (abs b + &1 <= x ==> b <= x)`]);; + +let ALWAYS_EVENTUALLY = prove + (`(!x. p x) ==> eventually p net`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[eventually; trivial_limit] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combining theorems for "eventually". *) +(* ------------------------------------------------------------------------- *) + +let EVENTUALLY_AND = prove + (`!net:(A net) p q. + eventually (\x. p x /\ q x) net <=> + eventually p net /\ eventually q net`, + REPEAT GEN_TAC THEN REWRITE_TAC[eventually] THEN + ASM_CASES_TAC `trivial_limit(net:(A net))` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN SIMP_TAC[NET_DILEMMA] THEN MESON_TAC[]);; + +let EVENTUALLY_MONO = prove + (`!net:(A net) p q. + (!x. p x ==> q x) /\ eventually p net + ==> eventually q net`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_MP = prove + (`!net:(A net) p q. + eventually (\x. p x ==> q x) net /\ eventually p net + ==> eventually q net`, + REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_FALSE = prove + (`!net. eventually (\x. F) net <=> trivial_limit net`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_TRUE = prove + (`!net. eventually (\x. T) net <=> T`, + REWRITE_TAC[eventually; trivial_limit] THEN MESON_TAC[]);; + +let NOT_EVENTUALLY = prove + (`!net p. (!x. ~(p x)) /\ ~(trivial_limit net) ==> ~(eventually p net)`, + REWRITE_TAC[eventually] THEN MESON_TAC[]);; + +let EVENTUALLY_FORALL = prove + (`!net:(A net) p s:B->bool. + FINITE s /\ ~(s = {}) + ==> (eventually (\x. !a. a IN s ==> p a x) net <=> + !a. a IN s ==> eventually (p a) net)`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[FORALL_IN_INSERT; EVENTUALLY_AND; ETA_AX] THEN + MAP_EVERY X_GEN_TAC [`b:B`; `t:B->bool`] THEN + ASM_CASES_TAC `t:B->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE]);; + +let FORALL_EVENTUALLY = prove + (`!net:(A net) p s:B->bool. + FINITE s /\ ~(s = {}) + ==> ((!a. a IN s ==> eventually (p a) net) <=> + eventually (\x. !a. a IN s ==> p a x) net)`, + SIMP_TAC[EVENTUALLY_FORALL]);; + +(* ------------------------------------------------------------------------- *) +(* Limits, defined as vacuously true when the limit is trivial. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("-->",(12,"right"));; + +let tendsto = new_definition + `(f --> l) net <=> !e. &0 < e ==> eventually (\x. dist(f(x),l) < e) net`;; + +let lim = new_definition + `lim net f = @l. (f --> l) net`;; + +let LIM = prove + (`(f --> l) net <=> + trivial_limit net \/ + !e. &0 < e ==> ?y. (?x. netord(net) x y) /\ + !x. netord(net) x y ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; eventually] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Show that they yield usual definitions in the various cases. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_LE = prove + (`!f:real^M->real^N l a s. + (f --> l)(at a within s) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) <= d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_WITHIN_LE]);; + +let LIM_WITHIN = prove + (`!f:real^M->real^N l a s. + (f --> l) (at a within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. x IN s /\ &0 < dist(x,a) /\ dist(x,a) < d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_WITHIN] THEN MESON_TAC[]);; + +let LIM_AT_LE = prove + (`!f l a. (f --> l) (at a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x. &0 < dist(x,a) /\ dist(x,a) <= d + ==> dist (f x,l) < e`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[LIM_WITHIN_LE; IN_UNIV]);; + +let LIM_AT = prove + (`!f l:real^N a:real^M. + (f --> l) (at a) <=> + !e. &0 < e + ==> ?d. &0 < d /\ !x. &0 < dist(x,a) /\ dist(x,a) < d + ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_AT] THEN MESON_TAC[]);; + +let LIM_AT_INFINITY = prove + (`!f l. (f --> l) at_infinity <=> + !e. &0 < e ==> ?b. !x. norm(x) >= b ==> dist(f(x),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_AT_INFINITY] THEN MESON_TAC[]);; + +let LIM_AT_INFINITY_POS = prove + (`!f l. (f --> l) at_infinity <=> + !e. &0 < e ==> ?b. &0 < b /\ !x. norm x >= b ==> dist(f x,l) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT_INFINITY] THEN + MESON_TAC[REAL_ARITH `&0 < abs b + &1 /\ (x >= abs b + &1 ==> x >= b)`]);; + +let LIM_SEQUENTIALLY = prove + (`!s l. (s --> l) sequentially <=> + !e. &0 < e ==> ?N. !n. N <= n ==> dist(s(n),l) < e`, + REWRITE_TAC[tendsto; EVENTUALLY_SEQUENTIALLY] THEN MESON_TAC[]);; + +let LIM_EVENTUALLY = prove + (`!net f l. eventually (\x. f x = l) net ==> (f --> l) net`, + REWRITE_TAC[eventually; LIM] THEN MESON_TAC[DIST_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* The expected monotonicity property. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_EMPTY = prove + (`!f l x. (f --> l) (at x within {})`, + REWRITE_TAC[LIM_WITHIN; NOT_IN_EMPTY] THEN MESON_TAC[REAL_LT_01]);; + +let LIM_WITHIN_SUBSET = prove + (`!f l a s. + (f --> l) (at a within s) /\ t SUBSET s ==> (f --> l) (at a within t)`, + REWRITE_TAC[LIM_WITHIN; SUBSET] THEN MESON_TAC[]);; + +let LIM_UNION = prove + (`!f x l s t. + (f --> l) (at x within s) /\ (f --> l) (at x within t) + ==> (f --> l) (at x within (s UNION t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_WITHIN; IN_UNION] THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `d1:real`) (X_CHOOSE_TAC `d2:real`)) THEN + EXISTS_TAC `min d1 d2` THEN ASM_MESON_TAC[REAL_LT_MIN]);; + +let LIM_UNION_UNIV = prove + (`!f x l s t. + (f --> l) (at x within s) /\ (f --> l) (at x within t) /\ + s UNION t = (:real^N) + ==> (f --> l) (at x)`, + MESON_TAC[LIM_UNION; WITHIN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPOSE_WITHIN = prove + (`!net f:real^M->real^N g:real^N->real^P s y z. + (f --> y) net /\ + eventually (\w. f w IN s /\ (f w = y ==> g y = z)) net /\ + (g --> z) (at y within s) + ==> ((g o f) --> z) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[LEFT_AND_FORALL_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVENTUALLY_WITHIN; GSYM DIST_NZ; o_DEF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + ASM_MESON_TAC[DIST_REFL]);; + +let LIM_COMPOSE_AT = prove + (`!net f:real^M->real^N g:real^N->real^P y z. + (f --> y) net /\ + eventually (\w. f w = y ==> g y = z) net /\ + (g --> z) (at y) + ==> ((g o f) --> z) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(real^M)net`; `f:real^M->real^N`; `g:real^N->real^P`; + `(:real^N)`; `y:real^N`; `z:real^P`] + LIM_COMPOSE_WITHIN) THEN + ASM_REWRITE_TAC[IN_UNIV; WITHIN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Interrelations between restricted and unrestricted limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_AT_WITHIN = prove + (`!f l a s. (f --> l)(at a) ==> (f --> l)(at a within s)`, + REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN MESON_TAC[]);; + +let LIM_WITHIN_OPEN = prove + (`!f l a:real^M s. + a IN s /\ open s ==> ((f --> l)(at a within s) <=> (f --> l)(at a))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_AT_WITHIN] THEN + REWRITE_TAC[LIM_AT; LIM_WITHIN] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M` o GEN_REWRITE_RULE I [open_def]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`d1:real`; `d2:real`] REAL_DOWN2) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LT_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* More limit point characterizations. *) +(* ------------------------------------------------------------------------- *) + +let LIMPT_SEQUENTIAL_INJ = prove + (`!x:real^N s. + x limit_point_of s <=> + ?f. (!n. f(n) IN (s DELETE x)) /\ + (!m n. f m = f n <=> m = n) /\ + (f --> x) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[GE; LE_REFL]] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real->real^N` THEN DISCH_TAC THEN + (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) + `(z 0 = y (&1)) /\ + (!n. z (SUC n):real^N = y(min (inv(&2 pow (SUC n))) (dist(z n,x))))` THEN + EXISTS_TAC `z:num->real^N` THEN + SUBGOAL_THEN + `!n. z(n) IN s /\ ~(z n:real^N = x) /\ dist(z n,x) < inv(&2 pow n)` + ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_SIMP_TAC[REAL_LT_01] THEN FIRST_X_ASSUM(MP_TAC o SPEC + `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT]; + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC WLOG_LT THEN REWRITE_TAC[EQ_SYM_EQ] THEN + SUBGOAL_THEN `!m n:num. m < n ==> dist(z n:real^N,x) < dist(z m,x)` + (fun th -> MESON_TAC[th; REAL_LT_REFL; LT_REFL]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN + CONJ_TAC THENL [REAL_ARITH_TAC; GEN_TAC THEN ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `min (inv(&2 pow (SUC n))) (dist(z n:real^N,x))`) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_INV_EQ; REAL_LT_POW2; DIST_POS_LT]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `N:num` THEN REWRITE_TAC[REAL_POW_INV] THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LT_TRANS)) THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&2 pow n)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_LT_POW2] THEN MATCH_MP_TAC REAL_POW_MONO THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]);; + +let LIMPT_SEQUENTIAL = prove + (`!x:real^N s. + x limit_point_of s <=> + ?f. (!n. f(n) IN (s DELETE x)) /\ (f --> x) sequentially`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LIMPT_SEQUENTIAL_INJ] THEN MESON_TAC[]; + REWRITE_TAC[LIMPT_APPROACHABLE; LIM_SEQUENTIALLY; IN_DELETE] THEN + MESON_TAC[GE; LE_REFL]]);; + +let [LIMPT_INFINITE_OPEN; LIMPT_INFINITE_BALL; LIMPT_INFINITE_CBALL] = + (CONJUNCTS o prove) + (`(!s x:real^N. + x limit_point_of s <=> !t. x IN t /\ open t ==> INFINITE(s INTER t)) /\ + (!s x:real^N. + x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER ball(x,e))) /\ + (!s x:real^N. + x limit_point_of s <=> !e. &0 < e ==> INFINITE(s INTER cball(x,e)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(q ==> p) /\ (r ==> s) /\ (s ==> q) /\ (p ==> r) + ==> (p <=> q) /\ (p <=> r) /\ (p <=> s)`) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[limit_point_of; INFINITE; SET_RULE + `(?y. ~(y = x) /\ y IN s /\ y IN t) <=> ~(s INTER t SUBSET {x})`] THEN + MESON_TAC[FINITE_SUBSET; FINITE_SING]; + MESON_TAC[INFINITE_SUPERSET; BALL_SUBSET_CBALL; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; + MESON_TAC[INFINITE_SUPERSET; OPEN_CONTAINS_CBALL; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; + REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] IN_BALL)] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MATCH_MP_TAC INFINITE_SUPERSET THEN + EXISTS_TAC `IMAGE (f:num->real^N) (from N)` THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_FROM; IN_INTER] THEN + ASM_MESON_TAC[INFINITE_IMAGE_INJ; INFINITE_FROM]]);; + +let INFINITE_OPEN_IN = prove + (`!u s:real^N->bool. + open_in (subtopology euclidean u) s /\ (?x. x IN s /\ x limit_point_of u) + ==> INFINITE s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool` o + GEN_REWRITE_RULE I [LIMPT_INFINITE_OPEN]) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Condensation points. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("condensation_point_of",(12,"right"));; + +let condensation_point_of = new_definition + `x condensation_point_of s <=> + !t. x IN t /\ open t ==> ~COUNTABLE(s INTER t)`;; + +let CONDENSATION_POINT_OF_SUBSET = prove + (`!x:real^N s t. + x condensation_point_of s /\ s SUBSET t ==> x condensation_point_of t`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[condensation_point_of] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + ASM SET_TAC[]);; + +let CONDENSATION_POINT_IMP_LIMPT = prove + (`!x s. x condensation_point_of s ==> x limit_point_of s`, + REWRITE_TAC[condensation_point_of; LIMPT_INFINITE_OPEN; INFINITE] THEN + MESON_TAC[FINITE_IMP_COUNTABLE]);; + +let CONDENSATION_POINT_INFINITE_BALL,CONDENSATION_POINT_INFINITE_CBALL = + (CONJ_PAIR o prove) + (`(!s x:real^N. + x condensation_point_of s <=> + !e. &0 < e ==> ~COUNTABLE(s INTER ball(x,e))) /\ + (!s x:real^N. + x condensation_point_of s <=> + !e. &0 < e ==> ~COUNTABLE(s INTER cball(x,e)))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(p ==> q) /\ (q ==> r) /\ (r ==> p) + ==> (p <=> q) /\ (p <=> r)`) THEN + REWRITE_TAC[condensation_point_of] THEN REPEAT CONJ_TAC THENL + [MESON_TAC[OPEN_BALL; CENTRE_IN_BALL]; + MESON_TAC[BALL_SUBSET_CBALL; COUNTABLE_SUBSET; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]; + MESON_TAC[COUNTABLE_SUBSET; OPEN_CONTAINS_CBALL; + SET_RULE `t SUBSET u ==> s INTER t SUBSET s INTER u`]]);; + +(* ------------------------------------------------------------------------- *) +(* Basic arithmetical combining theorems for limits. *) +(* ------------------------------------------------------------------------- *) + +let LIM_LINEAR = prove + (`!net:(A)net h f l. + (f --> l) net /\ linear h ==> ((\x. h(f x)) --> h l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_BOUNDED_POS) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / B`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; dist; GSYM LINEAR_SUB; REAL_LT_RDIV_EQ] THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_MUL_SYM]);; + +let LIM_CONST = prove + (`!net a:real^N. ((\x. a) --> a) net`, + SIMP_TAC[LIM; DIST_REFL; trivial_limit] THEN MESON_TAC[]);; + +let LIM_CMUL = prove + (`!f l c. (f --> l) net ==> ((\x. c % f x) --> c % l) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_LINEAR THEN + ASM_REWRITE_TAC[REWRITE_RULE[ETA_AX] + (MATCH_MP LINEAR_COMPOSE_CMUL LINEAR_ID)]);; + +let LIM_CMUL_EQ = prove + (`!net f l c. + ~(c = &0) ==> (((\x. c % f x) --> c % l) net <=> (f --> l) net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[LIM_CMUL] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP LIM_CMUL) THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; ETA_AX]);; + +let LIM_NEG = prove + (`!net f l:real^N. (f --> l) net ==> ((\x. --(f x)) --> --l) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM; dist] THEN + REWRITE_TAC[VECTOR_ARITH `--x - --y = --(x - y:real^N)`; NORM_NEG]);; + +let LIM_NEG_EQ = prove + (`!net f l:real^N. ((\x. --(f x)) --> --l) net <=> (f --> l) net`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX]);; + +let LIM_ADD = prove + (`!net:(A)net f g l m. + (f --> l) net /\ (g --> m) net ==> ((\x. f(x) + g(x)) --> l + m) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN + ASM_REWRITE_TAC[AND_FORALL_THM] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN MATCH_MP_TAC MONO_EXISTS THEN + MESON_TAC[REAL_HALF; DIST_TRIANGLE_ADD; REAL_LT_ADD2; REAL_LET_TRANS]);; + +let LIM_ABS = prove + (`!net:(A)net f:A->real^N l. + (f --> l) net + ==> ((\x. lambda i. (abs(f(x)$i))) --> (lambda i. abs(l$i)):real^N) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit (net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x - y) <= norm(a - b) ==> dist(a,b) < e ==> dist(x,y) < e`) THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT] THEN + REAL_ARITH_TAC);; + +let LIM_SUB = prove + (`!net:(A)net f g l m. + (f --> l) net /\ (g --> m) net ==> ((\x. f(x) - g(x)) --> l - m) net`, + REWRITE_TAC[real_sub; VECTOR_SUB] THEN ASM_SIMP_TAC[LIM_ADD; LIM_NEG]);; + +let LIM_MAX = prove + (`!net:(A)net f g l:real^N m:real^N. + (f --> l) net /\ (g --> m) net + ==> ((\x. lambda i. max (f(x)$i) (g(x)$i)) + --> (lambda i. max (l$i) (m$i)):real^N) net`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LIM_ADD) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LIM_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ABS) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2)` o MATCH_MP LIM_CMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; LAMBDA_BETA] THEN + REAL_ARITH_TAC);; + +let LIM_MIN = prove + (`!net:(A)net f g l:real^N m:real^N. + (f --> l) net /\ (g --> m) net + ==> ((\x. lambda i. min (f(x)$i) (g(x)$i)) + --> (lambda i. min (l$i) (m$i)):real^N) net`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP LIM_NEG)) THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG o MATCH_MP LIM_MAX) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN BINOP_TAC THEN + SIMP_TAC[FUN_EQ_THM; CART_EQ; LAMBDA_BETA; VECTOR_NEG_COMPONENT] THEN + REAL_ARITH_TAC);; + +let LIM_NORM = prove + (`!net f:A->real^N l. + (f --> l) net ==> ((\x. lift(norm(f x))) --> lift(norm l)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; DIST_LIFT] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let LIM_NULL = prove + (`!net f l. (f --> l) net <=> ((\x. f(x) - l) --> vec 0) net`, + REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO]);; + +let LIM_NULL_NORM = prove + (`!net f. (f --> vec 0) net <=> ((\x. lift(norm(f x))) --> vec 0) net`, + REWRITE_TAC[LIM; dist; VECTOR_SUB_RZERO; REAL_ABS_NORM; NORM_LIFT]);; + +let LIM_NULL_CMUL_EQ = prove + (`!net f c. + ~(c = &0) ==> (((\x. c % f x) --> vec 0) net <=> (f --> vec 0) net)`, + MESON_TAC[LIM_CMUL_EQ; VECTOR_MUL_RZERO]);; + +let LIM_NULL_CMUL = prove + (`!net f c. (f --> vec 0) net ==> ((\x. c % f x) --> vec 0) net`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN + ASM_SIMP_TAC[LIM_NULL_CMUL_EQ; VECTOR_MUL_LZERO; LIM_CONST]);; + +let LIM_NULL_COMPARISON = prove + (`!net f g. eventually (\x. norm(f x) <= g x) net /\ + ((\x. lift(g x)) --> vec 0) net + ==> (f --> vec 0) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN REAL_ARITH_TAC);; + +let LIM_COMPONENT = prove + (`!net f i l:real^N. (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) + ==> ((\a. lift(f(a)$i)) --> lift(l$i)) net`, + REWRITE_TAC[LIM; dist; GSYM LIFT_SUB; NORM_LIFT] THEN + SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS]);; + +let LIM_TRANSFORM_BOUND = prove + (`!f g. eventually (\n. norm(f n) <= norm(g n)) net /\ (g --> vec 0) net + ==> (f --> vec 0) net`, + REPEAT GEN_TAC THEN + REWRITE_TAC[tendsto; RIGHT_AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN REAL_ARITH_TAC);; + +let LIM_NULL_CMUL_BOUNDED = prove + (`!f g:A->real^N B. + eventually (\a. g a = vec 0 \/ abs(f a) <= B) net /\ + (g --> vec 0) net + ==> ((\n. f n % g n) --> vec 0) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN + UNDISCH_TAC `eventually (\a. g a:real^N = vec 0 \/ abs(f a) <= B) + (net:(A net))` THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(g:A->real^N) x = vec 0` THEN + ASM_REWRITE_TAC[NORM_0; REAL_MUL_RZERO] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * e / (abs B + &1)` THEN + ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `c * (a / b) = (c * a) / b`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN + MATCH_MP_TAC(REAL_ARITH + `e * B <= e * abs B /\ &0 < e ==> B * e < e * (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; + +let LIM_NULL_VMUL_BOUNDED = prove + (`!f g:A->real^N B. + ((lift o f) --> vec 0) net /\ + eventually (\a. f a = &0 \/ norm(g a) <= B) net + ==> ((\n. f n % g n) --> vec 0) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_ARITH `&0 < abs x + &1`] THEN + UNDISCH_TAC `eventually(\a. f a = &0 \/ norm((g:A->real^N) a) <= B) net` THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MP) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; o_THM; NORM_LIFT; NORM_MUL] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `(f:A->real) x = &0` THEN + ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_LZERO] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / (abs B + &1) * B` THEN + ASM_SIMP_TAC[REAL_LE_MUL2; REAL_ABS_POS; NORM_POS_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_ARITH `(a / b) * c = (a * c) / b`] THEN + SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 < abs x + &1`] THEN + MATCH_MP_TAC(REAL_ARITH + `e * B <= e * abs B /\ &0 < e ==> e * B < e * (abs B + &1)`) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN REAL_ARITH_TAC);; + +let LIM_VSUM = prove + (`!f:A->B->real^N s. + FINITE s /\ (!i. i IN s ==> ((f i) --> (l i)) net) + ==> ((\x. vsum s (\i. f i x)) --> vsum s l) net`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; LIM_CONST; LIM_ADD; IN_INSERT; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Deducing things about the limit from the elements. *) +(* ------------------------------------------------------------------------- *) + +let LIM_IN_CLOSED_SET = prove + (`!net f:A->real^N s l. + closed s /\ eventually (\x. f(x) IN s) net /\ + ~(trivial_limit net) /\ (f --> l) net + ==> l IN s`, + REWRITE_TAC[closed] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SET_RULE `~(x IN (UNIV DIFF s)) ==> x IN s`) THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `l:real^N` o GEN_REWRITE_RULE I + [OPEN_CONTAINS_BALL]) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; IN_DIFF; IN_UNION] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real` o GEN_REWRITE_RULE I [tendsto]) THEN + UNDISCH_TAC `eventually (\x. (f:A->real^N) x IN s) net` THEN + ASM_REWRITE_TAC[GSYM EVENTUALLY_AND; TAUT `a ==> ~b <=> ~(a /\ b)`] THEN + MATCH_MP_TAC NOT_EVENTUALLY THEN ASM_MESON_TAC[DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Need to prove closed(cball(x,e)) before deducing this as a corollary. *) +(* ------------------------------------------------------------------------- *) + +let LIM_NORM_UBOUND = prove + (`!net:(A)net f (l:real^N) b. + ~(trivial_limit net) /\ + (f --> l) net /\ + eventually (\x. norm(f x) <= b) net + ==> norm(l) <= b`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[eventually] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x:A. dist(f(x):real^N,l) < norm(l:real^N) - b /\ norm(f x) <= b` + (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN + NORM_ARITH_TAC);; + +let LIM_NORM_LBOUND = prove + (`!net:(A)net f (l:real^N) b. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. b <= norm(f x)) net + ==> b <= norm(l)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[LIM] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[eventually] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?x:A. dist(f(x):real^N,l) < b - norm(l:real^N) /\ b <= norm(f x)` + (CHOOSE_THEN MP_TAC) THENL [ASM_MESON_TAC[NET]; ALL_TAC] THEN + REWRITE_TAC[REAL_NOT_LT; REAL_LE_SUB_RADD; DE_MORGAN_THM; dist] THEN + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Uniqueness of the limit, when nontrivial. *) +(* ------------------------------------------------------------------------- *) + +let LIM_UNIQUE = prove + (`!net:(A)net f l:real^N l'. + ~(trivial_limit net) /\ (f --> l) net /\ (f --> l') net ==> (l = l')`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(ASSUME_TAC o REWRITE_RULE[VECTOR_SUB_REFL] o MATCH_MP LIM_SUB) THEN + SUBGOAL_THEN `!e. &0 < e ==> norm(l:real^N - l') <= e` MP_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC LIM_NORM_UBOUND THEN + MAP_EVERY EXISTS_TAC [`net:(A)net`; `\x:A. vec 0 : real^N`] THEN + ASM_SIMP_TAC[NORM_0; REAL_LT_IMP_LE; eventually] THEN + ASM_MESON_TAC[trivial_limit]; + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[DIST_NZ; dist] THEN + DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `norm(l - l':real^N) / &2`) THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + UNDISCH_TAC `&0 < norm(l - l':real^N)` THEN REAL_ARITH_TAC]);; + +let TENDSTO_LIM = prove + (`!net f l. ~(trivial_limit net) /\ (f --> l) net ==> lim net f = l`, + REWRITE_TAC[lim] THEN MESON_TAC[LIM_UNIQUE]);; + +let LIM_CONST_EQ = prove + (`!net:(A net) c d:real^N. + ((\x. c) --> d) net <=> trivial_limit net \/ c = d`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `trivial_limit (net:A net)` THEN ASM_REWRITE_TAC[] THENL + [ASM_REWRITE_TAC[LIM]; ALL_TAC] THEN + EQ_TAC THEN SIMP_TAC[LIM_CONST] THEN DISCH_TAC THEN + MATCH_MP_TAC(SPEC `net:A net` LIM_UNIQUE) THEN + EXISTS_TAC `(\x. c):A->real^N` THEN ASM_REWRITE_TAC[LIM_CONST]);; + +(* ------------------------------------------------------------------------- *) +(* Some unwieldy but occasionally useful theorems about uniform limits. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORM_LIM_ADD = prove + (`!net:(A)net P f g l m. + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm((f n x + g n x) - (l n + m n)) < e) + net`, + REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN + ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NORM_ARITH);; + +let UNIFORM_LIM_SUB = prove + (`!net:(A)net P f g l m. + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm((f n x - g n x) - (l n - m n)) < e) + net`, + REPEAT GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN + ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NORM_ARITH);; + +(* ------------------------------------------------------------------------- *) +(* Limit under bilinear function, uniform version first. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORM_LIM_BILINEAR = prove + (`!net:(A)net P (h:real^M->real^N->real^P) f g l m b1 b2. + bilinear h /\ + eventually (\x. !n. P n ==> norm(l n) <= b1) net /\ + eventually (\x. !n. P n ==> norm(m n) <= b2) net /\ + (!e. &0 < e + ==> eventually (\x. !n:B. P n ==> norm(f n x - l n) < e) net) /\ + (!e. &0 < e + ==> eventually (\x. !n. P n ==> norm(g n x - m n) < e) net) + ==> !e. &0 < e + ==> eventually + (\x. !n. P n + ==> norm(h (f n x) (g n x) - h (l n) (m n)) < e) + net`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o MATCH_MP + BILINEAR_BOUNDED_POS) THEN + REWRITE_TAC[AND_FORALL_THM; RIGHT_AND_FORALL_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `min (abs b2 + &1) (e / &2 / (B * (abs b1 + abs b2 + &2)))`) THEN + ASM_SIMP_TAC[REAL_HALF; REAL_LT_DIV; REAL_LT_MUL; REAL_LT_MIN; + REAL_ARITH `&0 < abs x + &1`; + REAL_ARITH `&0 < abs x + abs y + &2`] THEN + REWRITE_TAC[GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `x:A` THEN REWRITE_TAC[AND_FORALL_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:B` THEN + ASM_CASES_TAC `(P:B->bool) n` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[VECTOR_ARITH + `h a b - h c d :real^N = (h a b - h a d) + (h a d - h c d)`] THEN + ASM_SIMP_TAC[GSYM BILINEAR_LSUB; GSYM BILINEAR_RSUB] THEN + MATCH_MP_TAC NORM_TRIANGLE_LT THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (MESON[REAL_LE_ADD2; REAL_LET_TRANS] + `(!x y. norm(h x y:real^P) <= B * norm x * norm y) + ==> B * norm a * norm b + B * norm c * norm d < e + ==> norm(h a b) + norm(h c d) < e`)) THEN + MATCH_MP_TAC(REAL_ARITH + `x * B < e / &2 /\ y * B < e / &2 ==> B * x + B * y < e`) THEN + CONJ_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ] THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `e / &2 / (B * (abs b1 + abs b2 + &2)) * + (abs b1 + abs b2 + &1)` THEN + (CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b2 ==> a <= abs b1 + abs b2 + &1`] THEN + ASM_MESON_TAC[NORM_ARITH + `norm(f - l:real^P) < abs b2 + &1 /\ norm(l) <= b1 + ==> norm(f) <= abs b1 + abs b2 + &1`]; + ONCE_REWRITE_TAC[real_div] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_HALF; GSYM REAL_MUL_ASSOC; + REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `B * inv x * y < B <=> B * y / x < B * &1`] THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < abs x + abs y + &2`] THEN + REAL_ARITH_TAC]));; + +let LIM_BILINEAR = prove + (`!net:(A)net (h:real^M->real^N->real^P) f g l m. + (f --> l) net /\ (g --> m) net /\ bilinear h + ==> ((\x. h (f x) (g x)) --> (h l m)) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`net:(A)net`; `\x:one. T`; `h:real^M->real^N->real^P`; + `\n:one. (f:A->real^M)`; `\n:one. (g:A->real^N)`; + `\n:one. (l:real^M)`; `\n:one. (m:real^N)`; + `norm(l:real^M)`; `norm(m:real^N)`] + UNIFORM_LIM_BILINEAR) THEN + ASM_REWRITE_TAC[REAL_LE_REFL; EVENTUALLY_TRUE] THEN + ASM_REWRITE_TAC[GSYM dist; GSYM tendsto]);; + +(* ------------------------------------------------------------------------- *) +(* These are special for limits out of the same vector space. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_ID = prove + (`!a s. ((\x. x) --> a) (at a within s)`, + REWRITE_TAC[LIM_WITHIN] THEN MESON_TAC[]);; + +let LIM_AT_ID = prove + (`!a. ((\x. x) --> a) (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN REWRITE_TAC[LIM_WITHIN_ID]);; + +let LIM_AT_ZERO = prove + (`!f:real^M->real^N l a. + (f --> l) (at a) <=> ((\x. f(a + x)) --> l) (at(vec 0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_AT] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN ABS_TAC THEN + ASM_CASES_TAC `&0 < d` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `x:real^M` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a + x:real^M`) THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_SUB_RZERO]; + FIRST_X_ASSUM(MP_TAC o SPEC `x - a:real^M`) THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; VECTOR_SUB_ADD2]]);; + +(* ------------------------------------------------------------------------- *) +(* It's also sometimes useful to extract the limit point from the net. *) +(* ------------------------------------------------------------------------- *) + +let netlimit = new_definition + `netlimit net = @a. !x. ~(netord net x a)`;; + +let NETLIMIT_WITHIN = prove + (`!a:real^N s. ~(trivial_limit (at a within s)) + ==> (netlimit (at a within s) = a)`, + REWRITE_TAC[trivial_limit; netlimit; AT; WITHIN; DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `!x:real^N. ~(&0 < dist(x,a) /\ dist(x,a) <= dist(a,a) /\ x IN s)` + ASSUME_TAC THENL + [ASM_MESON_TAC[DIST_REFL; REAL_NOT_LT]; ASM_MESON_TAC[]]);; + +let NETLIMIT_AT = prove + (`!a. netlimit(at a) = a`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MATCH_MP_TAC NETLIMIT_WITHIN THEN + SIMP_TAC[TRIVIAL_LIMIT_AT; WITHIN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Transformation of limit. *) +(* ------------------------------------------------------------------------- *) + +let LIM_TRANSFORM = prove + (`!net f g l. + ((\x. f x - g x) --> vec 0) net /\ (f --> l) net ==> (g --> l) net`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_NEG) THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN BINOP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + VECTOR_ARITH_TAC);; + +let LIM_TRANSFORM_EVENTUALLY = prove + (`!net f g l. + eventually (\x. f x = g x) net /\ (f --> l) net ==> (g --> l) net`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o MATCH_MP LIM_EVENTUALLY) MP_TAC) THEN + MESON_TAC[LIM_TRANSFORM]);; + +let LIM_TRANSFORM_WITHIN = prove + (`!f g x s d. + &0 < d /\ + (!x'. x' IN s /\ &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ + (f --> l) (at x within s) + ==> (g --> l) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + DISCH_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM) THEN + REWRITE_TAC[LIM_WITHIN] THEN REPEAT STRIP_TAC THEN EXISTS_TAC `d:real` THEN + ASM_SIMP_TAC[VECTOR_SUB_REFL; DIST_REFL]);; + +let LIM_TRANSFORM_AT = prove + (`!f g x d. + &0 < d /\ + (!x'. &0 < dist(x',x) /\ dist(x',x) < d ==> f(x') = g(x')) /\ + (f --> l) (at x) + ==> (g --> l) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN MESON_TAC[LIM_TRANSFORM_WITHIN]);; + +let LIM_TRANSFORM_EQ = prove + (`!net f:A->real^N g l. + ((\x. f x - g x) --> vec 0) net ==> ((f --> l) net <=> (g --> l) net)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC LIM_TRANSFORM THENL + [EXISTS_TAC `f:A->real^N` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `g:A->real^N` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM LIM_NEG_EQ] THEN + ASM_REWRITE_TAC[VECTOR_NEG_SUB; VECTOR_NEG_0]]);; + +let LIM_TRANSFORM_WITHIN_SET = prove + (`!f a s t. + eventually (\x. x IN s <=> x IN t) (at a) + ==> ((f --> l) (at a within s) <=> (f --> l) (at a within t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[EVENTUALLY_AT; LIM_WITHIN] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d k:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Common case assuming being away from some crucial point like 0. *) +(* ------------------------------------------------------------------------- *) + +let LIM_TRANSFORM_AWAY_WITHIN = prove + (`!f:real^M->real^N g a b s. + ~(a = b) /\ + (!x. x IN s /\ ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ + (f --> l) (at a within s) + ==> (g --> l) (at a within s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `dist(a:real^M,b)`] THEN + ASM_REWRITE_TAC[GSYM DIST_NZ] THEN X_GEN_TAC `y:real^M` THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[DIST_SYM; REAL_LT_REFL]);; + +let LIM_TRANSFORM_AWAY_AT = prove + (`!f:real^M->real^N g a b. + ~(a = b) /\ + (!x. ~(x = a) /\ ~(x = b) ==> f(x) = g(x)) /\ + (f --> l) (at a) + ==> (g --> l) (at a)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MESON_TAC[LIM_TRANSFORM_AWAY_WITHIN]);; + +(* ------------------------------------------------------------------------- *) +(* Alternatively, within an open set. *) +(* ------------------------------------------------------------------------- *) + +let LIM_TRANSFORM_WITHIN_OPEN = prove + (`!f g:real^M->real^N s a l. + open s /\ a IN s /\ + (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ + (f --> l) (at a) + ==> (g --> l) (at a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_AT THEN + EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_BALL] THEN + ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; + +let LIM_TRANSFORM_WITHIN_OPEN_IN = prove + (`!f g:real^M->real^N s t a l. + open_in (subtopology euclidean t) s /\ a IN s /\ + (!x. x IN s /\ ~(x = a) ==> f x = g x) /\ + (f --> l) (at a within t) + ==> (g --> l) (at a within t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + EXISTS_TAC `f:real^M->real^N` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M` o CONJUNCT2) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SUBSET; IN_INTER; IN_BALL] THEN + ASM_MESON_TAC[DIST_NZ; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Another quite common idiom of an explicit conditional in a sequence. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CASES_FINITE_SEQUENTIALLY = prove + (`!f g l. FINITE {n | P n} + ==> (((\n. if P n then f n else g n) --> l) sequentially <=> + (g --> l) sequentially)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LIM_TRANSFORM_EVENTUALLY) THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN SIMP_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `N + 1` THEN + ASM_MESON_TAC[ARITH_RULE `~(x <= n /\ n + 1 <= x)`]);; + +let LIM_CASES_COFINITE_SEQUENTIALLY = prove + (`!f g l. FINITE {n | ~P n} + ==> (((\n. if P n then f n else g n) --> l) sequentially <=> + (f --> l) sequentially)`, + ONCE_REWRITE_TAC[TAUT `(if p then x else y) = (if ~p then y else x)`] THEN + REWRITE_TAC[LIM_CASES_FINITE_SEQUENTIALLY]);; + +let LIM_CASES_SEQUENTIALLY = prove + (`!f g l m. (((\n. if m <= n then f n else g n) --> l) sequentially <=> + (f --> l) sequentially) /\ + (((\n. if m < n then f n else g n) --> l) sequentially <=> + (f --> l) sequentially) /\ + (((\n. if n <= m then f n else g n) --> l) sequentially <=> + (g --> l) sequentially) /\ + (((\n. if n < m then f n else g n) --> l) sequentially <=> + (g --> l) sequentially)`, + SIMP_TAC[LIM_CASES_FINITE_SEQUENTIALLY; LIM_CASES_COFINITE_SEQUENTIALLY; + NOT_LE; NOT_LT; FINITE_NUMSEG_LT; FINITE_NUMSEG_LE]);; + +(* ------------------------------------------------------------------------- *) +(* A congruence rule allowing us to transform limits assuming not at point. *) +(* ------------------------------------------------------------------------- *) + +let LIM_CONG_WITHIN = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (at a within s) <=> ((g --> l) (at a within s)))`, + REWRITE_TAC[LIM_WITHIN; GSYM DIST_NZ] THEN SIMP_TAC[]);; + +let LIM_CONG_AT = prove + (`(!x. ~(x = a) ==> f x = g x) + ==> (((\x. f x) --> l) (at a) <=> ((g --> l) (at a)))`, + REWRITE_TAC[LIM_AT; GSYM DIST_NZ] THEN SIMP_TAC[]);; + +extend_basic_congs [LIM_CONG_WITHIN; LIM_CONG_AT];; + +(* ------------------------------------------------------------------------- *) +(* Useful lemmas on closure and set of possible sequential limits. *) +(* ------------------------------------------------------------------------- *) + +let CLOSURE_SEQUENTIAL = prove + (`!s l:real^N. + l IN closure(s) <=> ?x. (!n. x(n) IN s) /\ (x --> l) sequentially`, + REWRITE_TAC[closure; IN_UNION; LIMPT_SEQUENTIAL; IN_ELIM_THM; IN_DELETE] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `((b ==> c) /\ (~a /\ c ==> b)) /\ (a ==> c) ==> (a \/ b <=> c)`) THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + EXISTS_TAC `\n:num. l:real^N` THEN + ASM_REWRITE_TAC[LIM_CONST]);; + +let CLOSED_CONTAINS_SEQUENTIAL_LIMIT = prove + (`!s x l:real^N. + closed s /\ (!n. x n IN s) /\ (x --> l) sequentially ==> l IN s`, + MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED]);; + +let CLOSED_SEQUENTIAL_LIMITS = prove + (`!s. closed s <=> + !x l. (!n. x(n) IN s) /\ (x --> l) sequentially ==> l IN s`, + MESON_TAC[CLOSURE_SEQUENTIAL; CLOSURE_CLOSED; + CLOSED_LIMPT; LIMPT_SEQUENTIAL; IN_DELETE]);; + +let CLOSURE_APPROACHABLE = prove + (`!x s. x IN closure(s) <=> !e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e`, + REWRITE_TAC[closure; LIMPT_APPROACHABLE; IN_UNION; IN_ELIM_THM] THEN + MESON_TAC[DIST_REFL]);; + +let CLOSED_APPROACHABLE = prove + (`!x s. closed s + ==> ((!e. &0 < e ==> ?y. y IN s /\ dist(y,x) < e) <=> x IN s)`, + MESON_TAC[CLOSURE_CLOSED; CLOSURE_APPROACHABLE]);; + +let IN_CLOSURE_DELETE = prove + (`!s x:real^N. x IN closure(s DELETE x) <=> x limit_point_of s`, + SIMP_TAC[CLOSURE_APPROACHABLE; LIMPT_APPROACHABLE; IN_DELETE; CONJ_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Some other lemmas about sequences. *) +(* ------------------------------------------------------------------------- *) + +let SEQ_OFFSET = prove + (`!f l k. (f --> l) sequentially ==> ((\i. f(i + k)) --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N <= n ==> N <= n + k:num`]);; + +let SEQ_OFFSET_NEG = prove + (`!f l k. (f --> l) sequentially ==> ((\i. f(i - k)) --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k:num`]);; + +let SEQ_OFFSET_REV = prove + (`!f l k. ((\i. f(i + k)) --> l) sequentially ==> (f --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N + k <= n ==> N <= n - k /\ (n - k) + k = n:num`]);; + +let SEQ_HARMONIC = prove + (`((\n. lift(inv(&n))) --> vec 0) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO; NORM_LIFT] THEN + ASM_REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_NZ]);; + +(* ------------------------------------------------------------------------- *) +(* More properties of closed balls. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_CBALL = prove + (`!x:real^N e. closed(cball(x,e))`, + REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_CBALL; dist] THEN + GEN_TAC THEN GEN_TAC THEN X_GEN_TAC `s:num->real^N` THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. x - (s:num->real^N) n` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + ASM_SIMP_TAC[LIM_SUB; LIM_CONST; SEQUENTIALLY] THEN MESON_TAC[GE_REFL]);; + +let IN_INTERIOR_CBALL = prove + (`!x s. x IN interior s <=> ?e. &0 < e /\ cball(x,e) SUBSET s`, + REWRITE_TAC[interior; IN_ELIM_THM] THEN + MESON_TAC[OPEN_CONTAINS_CBALL; SUBSET_TRANS; + BALL_SUBSET_CBALL; CENTRE_IN_BALL; OPEN_BALL]);; + +let LIMPT_BALL = prove + (`!x:real^N y e. y limit_point_of ball(x,e) <=> &0 < e /\ y IN cball(x,e)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 < e` THENL + [ALL_TAC; ASM_MESON_TAC[LIMPT_EMPTY; REAL_NOT_LT; BALL_EQ_EMPTY]] THEN + ASM_REWRITE_TAC[] THEN EQ_TAC THENL + [MESON_TAC[CLOSED_CBALL; CLOSED_LIMPT; LIMPT_SUBSET; BALL_SUBSET_CBALL]; + REWRITE_TAC[IN_CBALL; LIMPT_APPROACHABLE; IN_BALL]] THEN + DISCH_TAC THEN X_GEN_TAC `d:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `y:real^N = x` THEN ASM_REWRITE_TAC[DIST_NZ] THENL + [MP_TAC(SPECL [`d:real`; `e:real`] REAL_DOWN2) THEN + ASM_REWRITE_TAC[] THEN + GEN_MESON_TAC 0 40 1 [VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MP_TAC(SPECL [`norm(y:real^N - x)`; `d:real`] REAL_DOWN2) THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ; dist]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(y:real^N) - (k / dist(y,x)) % (y - x)` THEN + REWRITE_TAC[dist; VECTOR_ARITH `(y - c % z) - y = --c % z`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_ABS_NEG] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_ARITH `x - (y - k % (y - x)) = (&1 - k) % (x - y)`] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < k ==> &0 < abs k`; NORM_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < k /\ k < d ==> abs k < d`] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `norm(x:real^N - y)` THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[NORM_SUB]] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < k /\ k < &1 ==> abs(&1 - k) < &1`) THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_MUL_LZERO; + REAL_MUL_LID]);; + +let CLOSURE_BALL = prove + (`!x:real^N e. &0 < e ==> (closure(ball(x,e)) = cball(x,e))`, + SIMP_TAC[EXTENSION; closure; IN_ELIM_THM; IN_UNION; LIMPT_BALL] THEN + REWRITE_TAC[IN_BALL; IN_CBALL] THEN REAL_ARITH_TAC);; + +let INTERIOR_BALL = prove + (`!a r. interior(ball(a,r)) = ball(a,r)`, + SIMP_TAC[INTERIOR_OPEN; OPEN_BALL]);; + +let INTERIOR_CBALL = prove + (`!x:real^N e. interior(cball(x,e)) = ball(x,e)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0 <= e` THENL + [ALL_TAC; + SUBGOAL_THEN `cball(x:real^N,e) = {} /\ ball(x:real^N,e) = {}` + (fun th -> REWRITE_TAC[th; INTERIOR_EMPTY]) THEN + REWRITE_TAC[IN_BALL; IN_CBALL; EXTENSION; NOT_IN_EMPTY] THEN + CONJ_TAC THEN X_GEN_TAC `y:real^N` THEN + MP_TAC(ISPECL [`x:real^N`; `y:real^N`] DIST_POS_LE) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC INTERIOR_UNIQUE THEN + REWRITE_TAC[BALL_SUBSET_CBALL; OPEN_BALL] THEN + X_GEN_TAC `t:real^N->bool` THEN + SIMP_TAC[SUBSET; IN_CBALL; IN_BALL; REAL_LT_LE] THEN STRIP_TAC THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N` o GEN_REWRITE_RULE I [open_def]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `d:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `z:real^N = x` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `k:real` o MATCH_MP REAL_DOWN) THEN + SUBGOAL_THEN `?w:real^N. dist(w,x) = k` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[VECTOR_CHOOSE_DIST; DIST_SYM; REAL_LT_IMP_LE]; + ASM_MESON_TAC[REAL_NOT_LE; DIST_REFL; DIST_SYM]]; + RULE_ASSUM_TAC(REWRITE_RULE[DIST_NZ]) THEN + DISCH_THEN(MP_TAC o SPEC `z + ((d / &2) / dist(z,x)) % (z - x:real^N)`) THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; NORM_MUL; REAL_ABS_DIV; + REAL_ABS_NORM; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; GSYM dist; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN + ASM_REWRITE_TAC[REAL_ARITH `abs d < d * &2 <=> &0 < d`] THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN REWRITE_TAC[dist] THEN + REWRITE_TAC[VECTOR_ARITH `x - (z + k % (z - x)) = (&1 + k) % (x - z)`] THEN + REWRITE_TAC[REAL_NOT_LE; NORM_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[NORM_SUB] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; GSYM dist] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &1 < abs(&1 + x)`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH]]);; + +let FRONTIER_BALL = prove + (`!a e. &0 < e ==> frontier(ball(a,e)) = sphere(a,e)`, + SIMP_TAC[frontier; sphere; CLOSURE_BALL; INTERIOR_OPEN; OPEN_BALL; + REAL_LT_IMP_LE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN + REAL_ARITH_TAC);; + +let FRONTIER_CBALL = prove + (`!a e. frontier(cball(a,e)) = sphere(a,e)`, + SIMP_TAC[frontier; sphere; INTERIOR_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; + REAL_LT_IMP_LE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM; IN_BALL; IN_CBALL] THEN + REAL_ARITH_TAC);; + +let CBALL_EQ_EMPTY = prove + (`!x e. (cball(x,e) = {}) <=> e < &0`, + REWRITE_TAC[EXTENSION; IN_CBALL; NOT_IN_EMPTY; REAL_NOT_LE] THEN + MESON_TAC[DIST_POS_LE; DIST_REFL; REAL_LTE_TRANS]);; + +let CBALL_EMPTY = prove + (`!x e. e < &0 ==> cball(x,e) = {}`, + REWRITE_TAC[CBALL_EQ_EMPTY]);; + +let CBALL_EQ_SING = prove + (`!x:real^N e. (cball(x,e) = {x}) <=> e = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_CBALL; IN_SING] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[DIST_LE_0]] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `x + (e / &2) % basis 1:real^N` th) THEN + MP_TAC(SPEC `x:real^N` th)) THEN + REWRITE_TAC[dist; VECTOR_ARITH `x - (x + e):real^N = --e`; + VECTOR_ARITH `x + e = x <=> e:real^N = vec 0`] THEN + REWRITE_TAC[NORM_NEG; NORM_MUL; VECTOR_MUL_EQ_0; NORM_0; VECTOR_SUB_REFL] THEN + SIMP_TAC[NORM_BASIS; BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1] THEN + REAL_ARITH_TAC);; + +let CBALL_SING = prove + (`!x e. e = &0 ==> cball(x,e) = {x}`, + REWRITE_TAC[CBALL_EQ_SING]);; + +let SPHERE_SING = prove + (`!x e. e = &0 ==> sphere(x,e) = {x}`, + SIMP_TAC[sphere; DIST_EQ_0; SING_GSPEC]);; + +let SPHERE_EQ_SING = prove + (`!a:real^N r x. sphere(a,r) = {x} <=> x = a /\ r = &0`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[SPHERE_SING] THEN + ASM_CASES_TAC `r < &0` THEN ASM_SIMP_TAC[SPHERE_EMPTY; NOT_INSERT_EMPTY] THEN + ASM_CASES_TAC `r = &0` THEN ASM_SIMP_TAC[SPHERE_SING] THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE + `!y. (x IN s ==> y IN s /\ ~(y = x)) ==> ~(s = {x})`) THEN + EXISTS_TAC `a - (x - a):real^N` THEN REWRITE_TAC[IN_SPHERE] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC NORM_ARITH);; + +(* ------------------------------------------------------------------------- *) +(* For points in the interior, localization of limits makes no difference. *) +(* ------------------------------------------------------------------------- *) + +let EVENTUALLY_WITHIN_INTERIOR = prove + (`!p s x. + x IN interior s + ==> (eventually p (at x within s) <=> eventually p (at x))`, + REWRITE_TAC[EVENTUALLY_WITHIN; EVENTUALLY_AT; IN_INTERIOR] THEN + REPEAT GEN_TAC THEN SIMP_TAC[SUBSET; IN_BALL; LEFT_IMP_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min (d:real) e` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[DIST_SYM]);; + +let LIM_WITHIN_INTERIOR = prove + (`!f l s x. + x IN interior s + ==> ((f --> l) (at x within s) <=> (f --> l) (at x))`, + SIMP_TAC[tendsto; EVENTUALLY_WITHIN_INTERIOR]);; + +let NETLIMIT_WITHIN_INTERIOR = prove + (`!s x:real^N. x IN interior s ==> netlimit(at x within s) = x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NETLIMIT_WITHIN THEN + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[OPEN_CONTAINS_BALL] + (SPEC_ALL OPEN_INTERIOR))) THEN + ASM_MESON_TAC[LIMPT_SUBSET; LIMPT_BALL; CENTRE_IN_CBALL; REAL_LT_IMP_LE; + SUBSET_TRANS; INTERIOR_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A non-singleton connected set is perfect (i.e. has no isolated points). *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_IMP_PERFECT = prove + (`!s x:real^N. + connected s /\ ~(?a. s = {a}) /\ x IN s ==> x limit_point_of s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[limit_point_of] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I + [OPEN_CONTAINS_CBALL]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x:real^N}` o + GEN_REWRITE_RULE I [CONNECTED_CLOPEN]) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[OPEN_IN_OPEN] THEN EXISTS_TAC `t:real^N->bool` THEN + ASM SET_TAC[]; + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `cball(x:real^N,e)` THEN REWRITE_TAC[CLOSED_CBALL] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_SING] THEN + ASM_MESON_TAC[CENTRE_IN_CBALL; SUBSET; REAL_LT_IMP_LE]; + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Boundedness. *) +(* ------------------------------------------------------------------------- *) + +let bounded = new_definition + `bounded s <=> ?a. !x:real^N. x IN s ==> norm(x) <= a`;; + +let BOUNDED_EMPTY = prove + (`bounded {}`, + REWRITE_TAC[bounded; NOT_IN_EMPTY]);; + +let BOUNDED_SUBSET = prove + (`!s t. bounded t /\ s SUBSET t ==> bounded s`, + MESON_TAC[bounded; SUBSET]);; + +let BOUNDED_INTERIOR = prove + (`!s:real^N->bool. bounded s ==> bounded(interior s)`, + MESON_TAC[BOUNDED_SUBSET; INTERIOR_SUBSET]);; + +let BOUNDED_CLOSURE = prove + (`!s:real^N->bool. bounded s ==> bounded(closure s)`, + REWRITE_TAC[bounded; CLOSURE_SEQUENTIAL] THEN + GEN_TAC THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MESON_TAC[REWRITE_RULE[eventually] LIM_NORM_UBOUND; + TRIVIAL_LIMIT_SEQUENTIALLY; trivial_limit]);; + +let BOUNDED_CLOSURE_EQ = prove + (`!s:real^N->bool. bounded(closure s) <=> bounded s`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSURE] THEN + MESON_TAC[BOUNDED_SUBSET; CLOSURE_SUBSET]);; + +let BOUNDED_CBALL = prove + (`!x:real^N e. bounded(cball(x,e))`, + REPEAT GEN_TAC THEN REWRITE_TAC[bounded] THEN + EXISTS_TAC `norm(x:real^N) + e` THEN REWRITE_TAC[IN_CBALL; dist] THEN + NORM_ARITH_TAC);; + +let BOUNDED_BALL = prove + (`!x e. bounded(ball(x,e))`, + MESON_TAC[BALL_SUBSET_CBALL; BOUNDED_CBALL; BOUNDED_SUBSET]);; + +let FINITE_IMP_BOUNDED = prove + (`!s:real^N->bool. FINITE s ==> bounded s`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[BOUNDED_EMPTY] THEN + REWRITE_TAC[bounded; IN_INSERT] THEN X_GEN_TAC `x:real^N` THEN GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B:real`) STRIP_ASSUME_TAC) THEN + EXISTS_TAC `norm(x:real^N) + abs B` THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_ARITH + `(y <= b /\ &0 <= x ==> y <= x + abs b) /\ x <= x + abs b`]);; + +let BOUNDED_UNION = prove + (`!s t. bounded (s UNION t) <=> bounded s /\ bounded t`, + REWRITE_TAC[bounded; IN_UNION] THEN MESON_TAC[REAL_LE_MAX]);; + +let BOUNDED_UNIONS = prove + (`!f. FINITE f /\ (!s. s IN f ==> bounded s) ==> bounded(UNIONS f)`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; BOUNDED_EMPTY; IN_INSERT; UNIONS_INSERT] THEN + MESON_TAC[BOUNDED_UNION]);; + +let BOUNDED_POS = prove + (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) <= b`, + REWRITE_TAC[bounded] THEN + MESON_TAC[REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x <= &1 + abs(y))`]);; + +let BOUNDED_POS_LT = prove + (`!s. bounded s <=> ?b. &0 < b /\ !x. x IN s ==> norm(x) < b`, + REWRITE_TAC[bounded] THEN + MESON_TAC[REAL_LT_IMP_LE; + REAL_ARITH `&0 < &1 + abs(y) /\ (x <= y ==> x < &1 + abs(y))`]);; + +let BOUNDED_INTER = prove + (`!s t. bounded s \/ bounded t ==> bounded (s INTER t)`, + MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; + +let BOUNDED_DIFF = prove + (`!s t. bounded s ==> bounded (s DIFF t)`, + MESON_TAC[BOUNDED_SUBSET; SUBSET_DIFF]);; + +let BOUNDED_INSERT = prove + (`!x s. bounded(x INSERT s) <=> bounded s`, + ONCE_REWRITE_TAC[SET_RULE `x INSERT s = {x} UNION s`] THEN + SIMP_TAC[BOUNDED_UNION; FINITE_IMP_BOUNDED; FINITE_RULES]);; + +let BOUNDED_SING = prove + (`!a. bounded {a}`, + REWRITE_TAC[BOUNDED_INSERT; BOUNDED_EMPTY]);; + +let BOUNDED_INTERS = prove + (`!f:(real^N->bool)->bool. + (?s:real^N->bool. s IN f /\ bounded s) ==> bounded(INTERS f)`, + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + ASM SET_TAC[]);; + +let NOT_BOUNDED_UNIV = prove + (`~(bounded (:real^N))`, + REWRITE_TAC[BOUNDED_POS; NOT_FORALL_THM; NOT_EXISTS_THM; IN_UNIV; + DE_MORGAN_THM; REAL_NOT_LE] THEN + X_GEN_TAC `B:real` THEN ASM_CASES_TAC `&0 < B` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `B + &1` VECTOR_CHOOSE_SIZE) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < B ==> &0 <= B + &1`] THEN + MATCH_MP_TAC MONO_EXISTS THEN REAL_ARITH_TAC);; + +let COBOUNDED_IMP_UNBOUNDED = prove + (`!s. bounded((:real^N) DIFF s) ==> ~bounded s`, + GEN_TAC THEN REWRITE_TAC[TAUT `a ==> ~b <=> ~(a /\ b)`] THEN + REWRITE_TAC[GSYM BOUNDED_UNION; SET_RULE `UNIV DIFF s UNION s = UNIV`] THEN + REWRITE_TAC[NOT_BOUNDED_UNIV]);; + +let BOUNDED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. bounded s /\ linear f ==> bounded(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:real`) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `B2:real` o MATCH_MP LINEAR_BOUNDED_POS) THEN + EXISTS_TAC `B2 * B1` THEN ASM_SIMP_TAC[REAL_LT_MUL; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B2 * norm(x:real^M)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ]);; + +let BOUNDED_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (bounded (IMAGE f s) <=> bounded s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE BOUNDED_LINEAR_IMAGE));; + +add_linear_invariants [BOUNDED_LINEAR_IMAGE_EQ];; + +let BOUNDED_SCALING = prove + (`!c s. bounded s ==> bounded (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_LINEAR_IMAGE THEN + ASM_SIMP_TAC[LINEAR_COMPOSE_CMUL; LINEAR_ID]);; + +let BOUNDED_NEGATIONS = prove + (`!s. bounded s ==> bounded (IMAGE (--) s)`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `-- &1` o MATCH_MP BOUNDED_SCALING) THEN + REWRITE_TAC[bounded; IN_IMAGE; VECTOR_MUL_LNEG; VECTOR_MUL_LID]);; + +let BOUNDED_TRANSLATION = prove + (`!a:real^N s. bounded s ==> bounded (IMAGE (\x. a + x) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + EXISTS_TAC `B + norm(a:real^N)` THEN POP_ASSUM MP_TAC THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL [NORM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let BOUNDED_TRANSLATION_EQ = prove + (`!a s. bounded (IMAGE (\x:real^N. a + x) s) <=> bounded s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_TRANSLATION] THEN + DISCH_THEN(MP_TAC o SPEC `--a:real^N` o MATCH_MP BOUNDED_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [BOUNDED_TRANSLATION_EQ];; + +let BOUNDED_DIFFS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t ==> bounded {x - y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN + EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH + `norm x <= a /\ norm y <= b ==> norm(x - y) <= a + b`) THEN + ASM_SIMP_TAC[]);; + +let BOUNDED_SUMS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t ==> bounded {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `B:real`) (X_CHOOSE_TAC `C:real`)) THEN + EXISTS_TAC `B + C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REPEAT STRIP_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(NORM_ARITH + `norm x <= a /\ norm y <= b ==> norm(x + y) <= a + b`) THEN + ASM_SIMP_TAC[]);; + +let BOUNDED_SUMS_IMAGE = prove + (`!f g t. bounded {f x | x IN t} /\ bounded {g x | x IN t} + ==> bounded {f x + g x | x IN t}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUMS) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] BOUNDED_SUBSET) THEN + SET_TAC[]);; + +let BOUNDED_SUMS_IMAGES = prove + (`!f:A->B->real^N t s. + FINITE s /\ + (!a. a IN s ==> bounded {f x a | x IN t}) + ==> bounded { vsum s (f x) | x IN t}`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `{vec 0:real^N}` THEN + SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_RULES] THEN SET_TAC[]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_SUMS_IMAGE THEN + ASM_SIMP_TAC[IN_INSERT]);; + +let BOUNDED_SUBSET_BALL = prove + (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET ball(x,r)`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOUNDED_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&2 * B + norm(x:real^N)` THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH + `&0 < B /\ &0 <= x ==> &0 < &2 * B + x`] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[IN_BALL] THEN + UNDISCH_TAC `&0 < B` THEN NORM_ARITH_TAC);; + +let BOUNDED_SUBSET_CBALL = prove + (`!s x:real^N. bounded(s) ==> ?r. &0 < r /\ s SUBSET cball(x,r)`, + MESON_TAC[BOUNDED_SUBSET_BALL; SUBSET_TRANS; BALL_SUBSET_CBALL]);; + +let UNBOUNDED_INTER_COBOUNDED = prove + (`!s t. ~bounded s /\ bounded((:real^N) DIFF t) ==> ~(s INTER t = {})`, + REWRITE_TAC[SET_RULE `s INTER t = {} <=> s SUBSET (:real^N) DIFF t`] THEN + MESON_TAC[BOUNDED_SUBSET]);; + +let COBOUNDED_INTER_UNBOUNDED = prove + (`!s t. bounded((:real^N) DIFF s) /\ ~bounded t ==> ~(s INTER t = {})`, + REWRITE_TAC[SET_RULE `s INTER t = {} <=> t SUBSET (:real^N) DIFF s`] THEN + MESON_TAC[BOUNDED_SUBSET]);; + +let SUBSPACE_BOUNDED_EQ_TRIVIAL = prove + (`!s:real^N->bool. subspace s ==> (bounded s <=> s = {vec 0})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN SIMP_TAC[BOUNDED_SING] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `~(s = {a}) ==> a IN s ==> ?b. b IN s /\ ~(b = a)`)) THEN + ASM_SIMP_TAC[SUBSPACE_0] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[bounded; NOT_EXISTS_THM] THEN X_GEN_TAC `B:real` THEN + DISCH_THEN(MP_TAC o SPEC `(B + &1) / norm v % v:real^N`) THEN + ASM_SIMP_TAC[SUBSPACE_MUL; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN REAL_ARITH_TAC);; + +let BOUNDED_COMPONENTWISE = prove + (`!s:real^N->bool. + bounded s <=> !i. 1 <= i /\ i <= dimindex(:N) + ==> bounded (IMAGE (\x. lift(x$i)) s)`, + GEN_TAC THEN REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; NORM_LIFT] THEN + EQ_TAC THENL [ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + SIMP_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:num->real` THEN + DISCH_TAC THEN EXISTS_TAC `sum(1..dimindex(:N)) b` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. &0)` THEN + SIMP_TAC[SUM_POS_LE_NUMSEG; REAL_POS] THEN + MATCH_MP_TAC SUM_LT_ALL THEN + ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; NUMSEG_EMPTY] THEN + REWRITE_TAC[NOT_LT; DIMINDEX_GE_1]; + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG]]);; + +(* ------------------------------------------------------------------------- *) +(* Some theorems on sups and infs using the notion "bounded". *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_LIFT = prove + (`!s. bounded(IMAGE lift s) <=> ?a. !x. x IN s ==> abs(x) <= a`, + REWRITE_TAC[bounded; FORALL_LIFT; NORM_LIFT; LIFT_IN_IMAGE_LIFT]);; + +let BOUNDED_HAS_SUP = prove + (`!s. bounded(IMAGE lift s) /\ ~(s = {}) + ==> (!x. x IN s ==> x <= sup s) /\ + (!b. (!x. x IN s ==> x <= b) ==> sup s <= b)`, + REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN + MESON_TAC[SUP; REAL_ARITH `abs(x) <= a ==> x <= a`]);; + +let SUP_INSERT = prove + (`!x s. bounded (IMAGE lift s) + ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_UNIQUE THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL + [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_LE_MAX; REAL_LT_MAX; IN_INSERT] THEN + MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; + +let BOUNDED_HAS_INF = prove + (`!s. bounded(IMAGE lift s) /\ ~(s = {}) + ==> (!x. x IN s ==> inf s <= x) /\ + (!b. (!x. x IN s ==> b <= x) ==> b <= inf s)`, + REWRITE_TAC[BOUNDED_LIFT; IMAGE_EQ_EMPTY] THEN + MESON_TAC[INF; REAL_ARITH `abs(x) <= a ==> --a <= x`]);; + +let INF_INSERT = prove + (`!x s. bounded (IMAGE lift s) + ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INF_UNIQUE THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_SING] THENL + [MESON_TAC[REAL_LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_MIN_LE; REAL_MIN_LT; IN_INSERT] THEN + MP_TAC(ISPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[REAL_LE_REFL; REAL_NOT_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Subset and overlapping relations on balls. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_BALLS = prove + (`(!a a':real^N r r'. + ball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ + (!a a':real^N r r'. + ball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r <= &0) /\ + (!a a':real^N r r'. + cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0) /\ + (!a a':real^N r r'. + cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0)`, + let lemma = prove + (`(!a':real^N r r'. + cball(a,r) SUBSET cball(a',r') <=> dist(a,a') + r <= r' \/ r < &0) /\ + (!a':real^N r r'. + cball(a,r) SUBSET ball(a',r') <=> dist(a,a') + r < r' \/ r < &0)`, + CONJ_TAC THEN + (GEOM_ORIGIN_TAC `a':real^N` THEN + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN + EQ_TAC THENL [REWRITE_TAC[DIST_0]; NORM_ARITH_TAC] THEN + DISJ_CASES_TAC(REAL_ARITH `r < &0 \/ &0 <= r`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISJ1_TAC THEN + ASM_CASES_TAC `a:real^N = vec 0` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `r % basis 1:real^N`) THEN + ASM_SIMP_TAC[DIST_0; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL]; + FIRST_X_ASSUM(MP_TAC o SPEC `(&1 + r / norm(a)) % a:real^N`) THEN + SIMP_TAC[dist; VECTOR_ARITH `a - (&1 + x) % a:real^N = --(x % a)`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; NORM_NEG; REAL_POS; + REAL_LE_DIV; NORM_POS_LE; REAL_ADD_RDISTRIB; REAL_DIV_RMUL; + NORM_EQ_0; REAL_ARITH `&0 <= x ==> abs(&1 + x) = &1 + x`]] THEN + UNDISCH_TAC `&0 <= r` THEN NORM_ARITH_TAC)) + and tac = DISCH_THEN(MP_TAC o MATCH_MP SUBSET_CLOSURE) THEN + ASM_SIMP_TAC[CLOSED_CBALL; CLOSURE_CLOSED; CLOSURE_BALL] in + REWRITE_TAC[AND_FORALL_THM] THEN GEOM_ORIGIN_TAC `a':real^N` THEN + REPEAT STRIP_TAC THEN + (EQ_TAC THENL + [ALL_TAC; REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL] THEN NORM_ARITH_TAC]) THEN + MATCH_MP_TAC(SET_RULE + `(s = {} <=> q) /\ (s SUBSET t /\ ~(s = {}) /\ ~(t = {}) ==> p) + ==> s SUBSET t ==> p \/ q`) THEN + REWRITE_TAC[BALL_EQ_EMPTY; CBALL_EQ_EMPTY; REAL_NOT_LE; REAL_NOT_LT] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THENL + [tac; tac; ALL_TAC; ALL_TAC] THEN REWRITE_TAC[lemma] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let INTER_BALLS_EQ_EMPTY = prove + (`(!a b:real^N r s. ball(a,r) INTER ball(b,s) = {} <=> + r <= &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ + (!a b:real^N r s. ball(a,r) INTER cball(b,s) = {} <=> + r <= &0 \/ s < &0 \/ r + s <= dist(a,b)) /\ + (!a b:real^N r s. cball(a,r) INTER ball(b,s) = {} <=> + r < &0 \/ s <= &0 \/ r + s <= dist(a,b)) /\ + (!a b:real^N r s. cball(a,r) INTER cball(b,s) = {} <=> + r < &0 \/ s < &0 \/ r + s < dist(a,b))`, + REPEAT STRIP_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_CBALL; IN_BALL] THEN + (EQ_TAC THENL + [ALL_TAC; + SPEC_TAC(`b % basis 1:real^N`,`v:real^N`) THEN CONV_TAC NORM_ARITH]) THEN + DISCH_THEN(MP_TAC o GEN `c:real` o SPEC `c % basis 1:real^N`) THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1; dist; NORM_NEG; + VECTOR_SUB_LZERO; GSYM VECTOR_SUB_RDISTRIB; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[real_abs] THEN REWRITE_TAC[GSYM real_abs] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `min b r:real` th) THEN + MP_TAC(SPEC `max (&0) (b - s:real)` th) THEN + MP_TAC(SPEC `(r + (b - s)) / &2` th)) THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Every closed set is a G_Delta. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_AS_GDELTA = prove + (`!s:real^N->bool. + closed s + ==> ?g. COUNTABLE g /\ + (!u. u IN g ==> open u) /\ + INTERS g = s`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `{ UNIONS { ball(x:real^N,inv(&n + &1)) | x IN s} | n IN (:num)}` THEN + SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN + SIMP_TAC[FORALL_IN_IMAGE; OPEN_UNIONS; OPEN_BALL] THEN + MATCH_MP_TAC(SET_RULE + `closure s = s /\ s SUBSET t /\ t SUBSET closure s + ==> t = s`) THEN + ASM_REWRITE_TAC[CLOSURE_EQ] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; INTERS_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM; UNIONS_IMAGE] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LT_TRANS) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + REAL_LT_TRANS)) THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Compactness (the definition is the one based on convegent subsequences). *) +(* ------------------------------------------------------------------------- *) + +let compact = new_definition + `compact s <=> + !f:num->real^N. + (!n. f(n) IN s) + ==> ?l r. l IN s /\ (!m n:num. m < n ==> r(m) < r(n)) /\ + ((f o r) --> l) sequentially`;; + +let MONOTONE_BIGGER = prove + (`!r. (!m n. m < n ==> r(m) < r(n)) ==> !n:num. n <= r(n)`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN + ASM_MESON_TAC[LE_0; ARITH_RULE `n <= m /\ m < p ==> SUC n <= p`; LT]);; + +let LIM_SUBSEQUENCE = prove + (`!s r l. (!m n. m < n ==> r(m) < r(n)) /\ (s --> l) sequentially + ==> (s o r --> l) sequentially`, + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + MESON_TAC[MONOTONE_BIGGER; LE_TRANS]);; + +let MONOTONE_SUBSEQUENCE = prove + (`!s:num->real. ?r:num->num. + (!m n. m < n ==> r(m) < r(n)) /\ + ((!m n. m <= n ==> s(r(m)) <= s(r(n))) \/ + (!m n. m <= n ==> s(r(n)) <= s(r(m))))`, + GEN_TAC THEN + ASM_CASES_TAC `!n:num. ?p. n < p /\ !m. p <= m ==> s(m) <= s(p)` THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; NOT_IMP; DE_MORGAN_THM] THEN + REWRITE_TAC[RIGHT_OR_EXISTS_THM; SKOLEM_THM; REAL_NOT_LE; REAL_NOT_LT] THENL + [ABBREV_TAC `N = 0`; DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC)] THEN + DISCH_THEN(X_CHOOSE_THEN `next:num->num` STRIP_ASSUME_TAC) THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `(r 0 = next(SUC N)) /\ (!n. r(SUC n) = next(r n))` THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THENL + [SUBGOAL_THEN `!m:num n:num. r n <= m ==> s(m) <= s(r n):real` + ASSUME_TAC THEN TRY CONJ_TAC THEN TRY DISJ2_TAC THEN + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL; LT_IMP_LE; LT_TRANS]; + SUBGOAL_THEN `!n. N < (r:num->num) n` ASSUME_TAC THEN + TRY(CONJ_TAC THENL [GEN_TAC; DISJ1_TAC THEN GEN_TAC]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[LT; LE] THEN + TRY STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LT_REFL; LT_LE; LTE_TRANS; REAL_LE_REFL; + REAL_LT_LE; REAL_LE_TRANS; LT]]);; + +let CONVERGENT_BOUNDED_INCREASING = prove + (`!s:num->real b. (!m n. m <= n ==> s m <= s n) /\ (!n. abs(s n) <= b) + ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x. ?n. (s:num->real) n = x` REAL_COMPLETE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `abs(x) <= b ==> x <= b`]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `l - e`) THEN + ASM_MESON_TAC[REAL_ARITH `&0 < e ==> ~(l <= l - e)`; + REAL_ARITH `x <= y /\ y <= l /\ ~(x <= l - e) ==> abs(y - l) < e`]);; + +let CONVERGENT_BOUNDED_MONOTONE = prove + (`!s:num->real b. (!n. abs(s n) <= b) /\ + ((!m n. m <= n ==> s m <= s n) \/ + (!m n. m <= n ==> s n <= s m)) + ==> ?l. !e. &0 < e ==> ?N. !n. N <= n ==> abs(s n - l) < e`, + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[CONVERGENT_BOUNDED_INCREASING]; ALL_TAC] THEN + MP_TAC(SPEC `\n. --((s:num->real) n)` CONVERGENT_BOUNDED_INCREASING) THEN + ASM_REWRITE_TAC[REAL_LE_NEG2; REAL_ABS_NEG] THEN + ASM_MESON_TAC[REAL_ARITH `abs(x - --l) = abs(--x - l)`]);; + +let COMPACT_REAL_LEMMA = prove + (`!s b. (!n:num. abs(s n) <= b) + ==> ?l r. (!m n:num. m < n ==> r(m) < r(n)) /\ + !e. &0 < e ==> ?N. !n. N <= n ==> abs(s(r n) - l) < e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MP_TAC(SPEC `s:num->real` MONOTONE_SUBSEQUENCE) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN ASM_MESON_TAC[]);; + +let COMPACT_LEMMA = prove + (`!s. bounded s /\ (!n. (x:num->real^N) n IN s) + ==> !d. d <= dimindex(:N) + ==> ?l:real^N r. (!m n. m < n ==> r m < (r:num->num) n) /\ + !e. &0 < e + ==> ?N. !n i. 1 <= i /\ i <= d + ==> N <= n + ==> abs(x(r n)$i - l$i) < e`, + GEN_TAC THEN REWRITE_TAC[bounded] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `b:real`) ASSUME_TAC) THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= 0 <=> F`; CONJ_ASSOC] THEN + DISCH_TAC THEN EXISTS_TAC `\n:num. n` THEN REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN STRIP_TAC THEN + MP_TAC(SPECL [`\n:num. (x:num->real^N) (r n) $ (SUC d)`; `b:real`] + COMPACT_REAL_LEMMA) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LE_TRANS; COMPONENT_LE_NORM; ARITH_RULE `1 <= SUC n`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` (X_CHOOSE_THEN `s:num->num` + STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC + [`(lambda k. if k = SUC d then y else (l:real^N)$k):real^N`; + `(r:num->num) o (s:num->num)`] THEN + ASM_SIMP_TAC[o_THM] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REPEAT(FIRST_ASSUM(C UNDISCH_THEN (MP_TAC o SPEC `e:real`) o concl)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN + FIRST_ASSUM(fun th -> SIMP_TAC[LAMBDA_BETA; MATCH_MP(ARITH_RULE + `SUC d <= n ==> !i. 1 <= i /\ i <= SUC d ==> 1 <= i /\ i <= n`) th]) THEN + REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN TRY COND_CASES_TAC THEN + ASM_MESON_TAC[MONOTONE_BIGGER; LE_TRANS; + ARITH_RULE `N1 + N2 <= n ==> N2 <= n:num /\ N1 <= n`; + ARITH_RULE `1 <= i /\ i <= d /\ SUC d <= n + ==> ~(i = SUC d) /\ 1 <= SUC d /\ d <= n /\ i <= n`]);; + +let BOUNDED_CLOSED_IMP_COMPACT = prove + (`!s:real^N->bool. bounded s /\ closed s ==> compact s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[compact] THEN + X_GEN_TAC `x:num->real^N` THEN DISCH_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` COMPACT_LEMMA) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN + REWRITE_TAC[LE_REFL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN ASM_SIMP_TAC[] THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT `(b ==> a) /\ b ==> a /\ b`) THEN + REPEAT STRIP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CLOSED_SEQUENTIAL_LIMITS]) THEN + EXISTS_TAC `(x:num->real^N) o (r:num->num)` THEN + ASM_REWRITE_TAC[o_THM]; + ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2 / &(dimindex(:N))`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_NONZERO; + REAL_HALF; ARITH_RULE `0 < n <=> ~(n = 0)`] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[dist] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MATCH_MP (REAL_ARITH `a <= b ==> b < e ==> a < e`) + (SPEC_ALL NORM_LE_L1)) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (1..dimindex(:N)) + (\k. e / &2 / &(dimindex(:N)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN + SIMP_TAC[o_THM; LAMBDA_BETA; vector_sub] THEN + ASM_MESON_TAC[REAL_LT_IMP_LE; LE_TRANS]; + ASM_SIMP_TAC[SUM_CONST_NUMSEG; ADD_SUB; REAL_DIV_LMUL; REAL_OF_NUM_EQ; + DIMINDEX_NONZERO; REAL_LE_REFL; REAL_LT_LDIV_EQ; ARITH; + REAL_OF_NUM_LT; REAL_ARITH `x < x * &2 <=> &0 < x`]]);; + +(* ------------------------------------------------------------------------- *) +(* Completeness. *) +(* ------------------------------------------------------------------------- *) + +let cauchy = new_definition + `cauchy (s:num->real^N) <=> + !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N ==> dist(s m,s n) < e`;; + +let complete = new_definition + `complete s <=> + !f:num->real^N. (!n. f n IN s) /\ cauchy f + ==> ?l. l IN s /\ (f --> l) sequentially`;; + +let CAUCHY = prove + (`!s:num->real^N. + cauchy s <=> !e. &0 < e ==> ?N. !n. n >= N ==> dist(s n,s N) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[cauchy; GE] THEN EQ_TAC THENL + [MESON_TAC[LE_REFL]; DISCH_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MESON_TAC[DIST_TRIANGLE_HALF_L]);; + +let CONVERGENT_IMP_CAUCHY = prove + (`!s l. (s --> l) sequentially ==> cauchy s`, + REWRITE_TAC[LIM_SEQUENTIALLY; cauchy] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + ASM_MESON_TAC[GE; LE_REFL; DIST_TRIANGLE_HALF_L]);; + +let CAUCHY_IMP_BOUNDED = prove + (`!s:num->real^N. cauchy s ==> bounded {y | ?n. y = s n}`, + REWRITE_TAC[cauchy; bounded; IN_ELIM_THM] THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[GE_REFL] THEN DISCH_TAC THEN + SUBGOAL_THEN `!n:num. N <= n ==> norm(s n :real^N) <= norm(s N) + &1` + ASSUME_TAC THENL + [ASM_MESON_TAC[GE; dist; DIST_SYM; NORM_TRIANGLE_SUB; + REAL_ARITH `a <= b + c /\ c < &1 ==> a <= b + &1`]; + MP_TAC(ISPECL [`\n:num. norm(s n :real^N)`; `0..N`] + UPPER_BOUND_FINITE_SET_REAL) THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0; LEFT_IMP_EXISTS_THM] THEN + ASM_MESON_TAC[LE_CASES; + REAL_ARITH `x <= a \/ x <= b ==> x <= abs a + abs b`]]);; + +let COMPACT_IMP_COMPLETE = prove + (`!s:real^N->bool. compact s ==> complete s`, + GEN_TAC THEN REWRITE_TAC[complete; compact] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:num->real^N` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_ADD)) THEN + DISCH_THEN(MP_TAC o SPEC `\n. (f:num->real^N)(n) - f(r n)`) THEN + DISCH_THEN(MP_TAC o SPEC `vec 0: real^N`) THEN ASM_REWRITE_TAC[o_THM] THEN + REWRITE_TAC[VECTOR_ADD_RID; VECTOR_SUB_ADD2; ETA_AX] THEN + DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [cauchy]) THEN + REWRITE_TAC[GE; LIM; SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN + SUBGOAL_THEN `!n:num. n <= r(n)` MP_TAC THENL [INDUCT_TAC; ALL_TAC] THEN + ASM_MESON_TAC[ LE_TRANS; LE_REFL; LT; LET_TRANS; LE_0; LE_SUC_LT]);; + +let COMPLETE_UNIV = prove + (`complete(:real^N)`, + REWRITE_TAC[complete; IN_UNIV] THEN X_GEN_TAC `x:num->real^N` THEN + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP BOUNDED_CLOSURE) THEN + MP_TAC(ISPEC `closure {y:real^N | ?n:num. y = x n}` + COMPACT_IMP_COMPLETE) THEN + ASM_SIMP_TAC[BOUNDED_CLOSED_IMP_COMPACT; CLOSED_CLOSURE; complete] THEN + DISCH_THEN(MP_TAC o SPEC `x:num->real^N`) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + ASM_REWRITE_TAC[closure; IN_ELIM_THM; IN_UNION] THEN MESON_TAC[]);; + +let COMPLETE_EQ_CLOSED = prove + (`!s:real^N->bool. complete s <=> closed s`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[complete; CLOSED_LIMPT; LIMPT_SEQUENTIAL] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN GEN_TAC THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[CONVERGENT_IMP_CAUCHY; IN_DELETE; LIM_UNIQUE; + TRIVIAL_LIMIT_SEQUENTIALLY]; + REWRITE_TAC[complete; CLOSED_SEQUENTIAL_LIMITS] THEN DISCH_TAC THEN + X_GEN_TAC `f:num->real^N` THEN STRIP_TAC THEN + MP_TAC(REWRITE_RULE[complete] COMPLETE_UNIV) THEN + DISCH_THEN(MP_TAC o SPEC `f:num->real^N`) THEN + ASM_REWRITE_TAC[IN_UNIV] THEN ASM_MESON_TAC[]]);; + +let CONVERGENT_EQ_CAUCHY = prove + (`!s. (?l. (s --> l) sequentially) <=> cauchy s`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[LEFT_IMP_EXISTS_THM; CONVERGENT_IMP_CAUCHY]; + REWRITE_TAC[REWRITE_RULE[complete; IN_UNIV] COMPLETE_UNIV]]);; + +let CONVERGENT_IMP_BOUNDED = prove + (`!s l. (s --> l) sequentially ==> bounded (IMAGE s (:num))`, + REWRITE_TAC[LEFT_FORALL_IMP_THM; CONVERGENT_EQ_CAUCHY] THEN + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CAUCHY_IMP_BOUNDED) THEN + REWRITE_TAC[IMAGE; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Total boundedness. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_IMP_TOTALLY_BOUNDED = prove + (`!s:real^N->bool. + compact s + ==> !e. &0 < e ==> ?k. FINITE k /\ k SUBSET s /\ + s SUBSET (UNIONS(IMAGE (\x. ball(x,e)) k))`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + REWRITE_TAC[TAUT `~(a /\ b /\ c) <=> a /\ b ==> ~c`; SUBSET] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?x:num->real^N. !n. x(n) IN s /\ !m. m < n ==> ~(dist(x(m),x(n)) < e)` + MP_TAC THENL + [SUBGOAL_THEN + `?x:num->real^N. + !n. x(n) = @y. y IN s /\ !m. m < n ==> ~(dist(x(m),y) < e)` + MP_TAC THENL + [MATCH_MP_TAC(MATCH_MP WF_REC WF_num) THEN SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(SUBST1_TAC o SPEC `n:num`) THEN STRIP_TAC THEN + CONV_TAC SELECT_CONV THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (x:num->real^N) {m | m < n}`) THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT; NOT_FORALL_THM; NOT_IMP] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[IN_BALL]; + ALL_TAC] THEN + REWRITE_TAC[compact; NOT_FORALL_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:num->real^N` THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN + REWRITE_TAC[cauchy] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[o_THM; NOT_EXISTS_THM; NOT_IMP; NOT_FORALL_THM; NOT_IMP] THEN + X_GEN_TAC `N:num` THEN MAP_EVERY EXISTS_TAC [`N:num`; `SUC N`] THEN + CONJ_TAC THENL [ARITH_TAC; ASM_MESON_TAC[LT]]);; + +(* ------------------------------------------------------------------------- *) +(* Heine-Borel theorem (following Burkill & Burkill vol. 2) *) +(* ------------------------------------------------------------------------- *) + +let HEINE_BOREL_LEMMA = prove + (`!s:real^N->bool. + compact s + ==> !t. s SUBSET (UNIONS t) /\ (!b. b IN t ==> open b) + ==> ?e. &0 < e /\ + !x. x IN s ==> ?b. b IN t /\ ball(x,e) SUBSET b`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_ARITH `x <= y ==> x < y + &1`; + FORALL_AND_THM; REAL_POS; NOT_FORALL_THM; NOT_IMP; SKOLEM_THM; compact] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `?b:real^N->bool. l IN b /\ b IN t` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_UNIONS]; ALL_TAC] THEN + SUBGOAL_THEN `?e. &0 < e /\ !z:real^N. dist(z,l) < e ==> z IN b` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[open_def]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + SUBGOAL_THEN `&0 < e / &2` (fun th -> + REWRITE_TAC[th; o_THM] THEN MP_TAC(GEN_REWRITE_RULE I [REAL_ARCH_INV] th)) + THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(r:num->num)(N1 + N2)`; `b:real^N->bool`]) THEN + ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_HALF_R THEN + EXISTS_TAC `(f:num->real^N)(r(N1 + N2:num))` THEN CONJ_TAC THENL + [ALL_TAC; FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_BALL]) THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> x < a ==> x < b`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&N1)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN + ASM_MESON_TAC[ARITH_RULE `(~(n = 0) ==> 0 < n)`; LE_ADD; MONOTONE_BIGGER; + LT_IMP_LE; LE_TRANS]);; + +let COMPACT_IMP_HEINE_BOREL = prove + (`!s. compact (s:real^N->bool) + ==> !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `f:(real^N->bool)->bool` o + MATCH_MP HEINE_BOREL_LEMMA) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; SUBSET; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real^N->real^N->bool`) THEN + FIRST_ASSUM(MP_TAC o SPEC `e:real` o + MATCH_MP COMPACT_IMP_TOTALLY_BOUNDED) THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[IN_UNIONS; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (B:real^N->real^N->bool) k` THEN + ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; LEFT_IMP_EXISTS_THM] THEN + ASM_MESON_TAC[IN_BALL]);; + +(* ------------------------------------------------------------------------- *) +(* Bolzano-Weierstrass property. *) +(* ------------------------------------------------------------------------- *) + +let HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. + (!f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')) + ==> !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM; limit_point_of] THEN REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `a ==> b /\ c ==> d <=> c ==> ~d ==> a ==> ~b`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; RIGHT_AND_FORALL_THM] THEN + DISCH_TAC THEN REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `f:real^N->real^N->bool`) THEN + DISCH_THEN(MP_TAC o SPEC + `{t:real^N->bool | ?x:real^N. x IN s /\ (t = f x)}`) THEN + REWRITE_TAC[INFINITE; SUBSET; IN_ELIM_THM; IN_UNIONS; NOT_IMP] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:real^N | x IN t /\ (f(x):real^N->bool) IN g}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ_GENERAL THEN ASM_MESON_TAC[SUBSET]; + SIMP_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N` THEN + DISCH_TAC THEN SUBGOAL_THEN `(u:real^N) IN s` ASSUME_TAC THEN + ASM_MESON_TAC[SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Complete the chain of compactness variants. *) +(* ------------------------------------------------------------------------- *) + +let BOLZANO_WEIERSTRASS_IMP_BOUNDED = prove + (`!s:real^N->bool. + (!t. INFINITE t /\ t SUBSET s ==> ?x. x limit_point_of t) + ==> bounded s`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[compact; bounded] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; SKOLEM_THM; NOT_IMP] THEN + REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `beyond:real->real^N`) THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `(f(0) = beyond(&0)) /\ + (!n. f(SUC n) = beyond(norm(f n) + &1):real^N)` THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (x:num->real^N) UNIV` THEN + SUBGOAL_THEN + `!m n. m < n ==> norm((x:num->real^N) m) + &1 < norm(x n)` + ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN + ASM_MESON_TAC[REAL_LT_TRANS; REAL_ARITH `b < b + &1`]; + ALL_TAC] THEN + SUBGOAL_THEN `!m n. ~(m = n) ==> &1 < dist((x:num->real^N) m,x n)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (SPECL [`m:num`; `n:num`] LT_CASES) THEN + ASM_MESON_TAC[dist; LT_CASES; NORM_TRIANGLE_SUB; NORM_SUB; + REAL_ARITH `x + &1 < y /\ y <= x + d ==> &1 < d`]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[INFINITE_IMAGE_INJ; num_INFINITE; DIST_REFL; + REAL_ARITH `~(&1 < &0)`]; + REWRITE_TAC[SUBSET; IN_IMAGE; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN INDUCT_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `l:real^N` THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + REWRITE_TAC[IN_IMAGE; IN_UNIV; LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN REWRITE_TAC[UNWIND_THM2] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `&1 / &2`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `dist((x:num->real^N) k,l)`) THEN + ASM_SIMP_TAC[DIST_POS_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `m:num = k` THEN + ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; REAL_LT_TRANS; REAL_LT_REFL]);; + +let SEQUENCE_INFINITE_LEMMA = prove + (`!f l. (!n. ~(f(n) = l)) /\ (f --> l) sequentially + ==> INFINITE {y:real^N | ?n. y = f n}`, + REWRITE_TAC[INFINITE] THEN REPEAT STRIP_TAC THEN MP_TAC(ISPEC + `IMAGE (\y:real^N. dist(y,l)) {y | ?n:num. y = f n}` INF_FINITE) THEN + ASM_SIMP_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE; FINITE_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[LIM_SEQUENTIALLY; LE_REFL; REAL_NOT_LE; DIST_POS_LT]);; + +let LIMPT_OF_SEQUENCE_SUBSEQUENCE = prove + (`!f:num->real^N l. + l limit_point_of (IMAGE f (:num)) + ==> ?r. (!m n. m < n ==> r(m) < r(n)) /\ ((f o r) --> l) sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIMPT_APPROACHABLE]) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC + `inf((inv(&n + &1)) INSERT + IMAGE (\k. dist((f:num->real^N) k,l)) + {k | k IN 0..n /\ ~(f k = l)})`) THEN + SIMP_TAC[REAL_LT_INF_FINITE; FINITE_INSERT; NOT_INSERT_EMPTY; + FINITE_RESTRICT; FINITE_NUMSEG; FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + SIMP_TAC[FORALL_AND_THM; FORALL_IN_GSPEC; GSYM DIST_NZ; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `nn:num->num` STRIP_ASSUME_TAC) THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `r 0 = nn 0 /\ (!n. r (SUC n) = nn(r n))` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN + STRIP_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[LT_TRANS] THEN + X_GEN_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(r:num->num) n`; `(nn:num->num)(r(n:num))`]) THEN + ASM_REWRITE_TAC[IN_NUMSEG; LE_0; REAL_LT_REFL] THEN ARITH_TAC; + DISCH_THEN(ASSUME_TAC o MATCH_MP MONOTONE_BIGGER)] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[CONJUNCT1 LE] THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(K ALL_TAC) THEN DISCH_TAC THEN + ASM_REWRITE_TAC[o_THM] THEN MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `inv(&((r:num->num) n) + &1)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; LE_1; REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(ARITH_RULE `N <= SUC n /\ n <= r n ==> N <= r n + 1`) THEN + ASM_REWRITE_TAC[]);; + +let SEQUENCE_UNIQUE_LIMPT = prove + (`!f l l':real^N. + (f --> l) sequentially /\ l' limit_point_of {y | ?n. y = f n} + ==> l' = l`, + REWRITE_TAC[SET_RULE `{y | ?n. y = f n} = IMAGE f (:num)`] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LIMPT_OF_SEQUENCE_SUBSEQUENCE) THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `(f:num->real^N) o (r:num->num)` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_SUBSEQUENCE]);; + +let BOLZANO_WEIERSTRASS_IMP_CLOSED = prove + (`!s:real^N->bool. + (!t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t) + ==> closed s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS] THEN + MAP_EVERY X_GEN_TAC [`f:num->real^N`; `l:real^N`] THEN + DISCH_TAC THEN + MAP_EVERY (MP_TAC o ISPECL [`f:num->real^N`; `l:real^N`]) + [SEQUENCE_UNIQUE_LIMPT; SEQUENCE_INFINITE_LEMMA] THEN + MATCH_MP_TAC(TAUT + `(~d ==> a /\ ~(b /\ c)) ==> (a ==> b) ==> c ==> d`) THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM_MESON_TAC[]; STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | ?n:num. y = f n}`) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM]; + ABBREV_TAC `t = {y:real^N | ?n:num. y = f n}`] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence express everything as an equivalence. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_EQ_HEINE_BOREL = prove + (`!s:real^N->bool. + compact s <=> + !f. (!t. t IN f ==> open t) /\ s SUBSET (UNIONS f) + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET (UNIONS f')`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[COMPACT_IMP_HEINE_BOREL] THEN + DISCH_THEN(MP_TAC o MATCH_MP HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS) THEN + DISCH_TAC THEN MATCH_MP_TAC BOUNDED_CLOSED_IMP_COMPACT THEN + ASM_MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; + BOLZANO_WEIERSTRASS_IMP_CLOSED]);; + +let COMPACT_EQ_BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. + compact s <=> + !t. INFINITE t /\ t SUBSET s ==> ?x. x IN s /\ x limit_point_of t`, + GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[COMPACT_EQ_HEINE_BOREL; HEINE_BOREL_IMP_BOLZANO_WEIERSTRASS]; + MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS_IMP_CLOSED; + BOUNDED_CLOSED_IMP_COMPACT]]);; + +let COMPACT_EQ_BOUNDED_CLOSED = prove + (`!s:real^N->bool. compact s <=> bounded s /\ closed s`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[BOUNDED_CLOSED_IMP_COMPACT] THEN + MESON_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; BOLZANO_WEIERSTRASS_IMP_BOUNDED; + BOLZANO_WEIERSTRASS_IMP_CLOSED]);; + +let COMPACT_IMP_BOUNDED = prove + (`!s. compact s ==> bounded s`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; + +let COMPACT_IMP_CLOSED = prove + (`!s. compact s ==> closed s`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED]);; + +let COMPACT_SEQUENCE_WITH_LIMIT = prove + (`!f l:real^N. + (f --> l) sequentially ==> compact (l INSERT IMAGE f (:num))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + REWRITE_TAC[BOUNDED_INSERT] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CONVERGENT_IMP_BOUNDED]; + SIMP_TAC[CLOSED_LIMPT; LIMPT_INSERT; IN_INSERT] THEN + REWRITE_TAC[IMAGE; IN_UNIV] THEN REPEAT STRIP_TAC THEN DISJ1_TAC THEN + MATCH_MP_TAC SEQUENCE_UNIQUE_LIMPT THEN ASM_MESON_TAC[]]);; + +let CLOSED_IN_COMPACT = prove + (`!s t:real^N->bool. + compact s /\ closed_in (subtopology euclidean s) t + ==> compact t`, + SIMP_TAC[IMP_CONJ; COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_EQ] THEN + MESON_TAC[BOUNDED_SUBSET]);; + +let CLOSED_IN_COMPACT_EQ = prove + (`!s t. compact s + ==> (closed_in (subtopology euclidean s) t <=> + compact t /\ t SUBSET s)`, + MESON_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* A version of Heine-Borel for subtopology. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY = prove + (`!s:real^N->bool. + compact s <=> + (!f. (!t. t IN f ==> open_in(subtopology euclidean s) t) /\ + s SUBSET UNIONS f + ==> ?f'. f' SUBSET f /\ FINITE f' /\ s SUBSET UNIONS f')`, + GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN EQ_TAC THEN + DISCH_TAC THEN X_GEN_TAC `f:(real^N->bool)->bool` THENL + [REWRITE_TAC[OPEN_IN_OPEN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `m:(real^N->bool)->(real^N->bool)`) ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `IMAGE (m:(real^N->bool)->(real^N->bool)) f`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (\t:real^N->bool. s INTER t) f'` THEN + ASM_SIMP_TAC[FINITE_IMAGE; UNIONS_IMAGE; SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_IMAGE]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_MESON_TAC[SUBSET]; + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{s INTER t:real^N->bool | t IN f}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_IN_OPEN; UNIONS_IMAGE] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; UNIONS_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More easy lemmas. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_CLOSURE = prove + (`!s. compact(closure s) <=> bounded s`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE; BOUNDED_CLOSURE_EQ]);; + +let BOLZANO_WEIERSTRASS_CONTRAPOS = prove + (`!s t:real^N->bool. + compact s /\ t SUBSET s /\ + (!x. x IN s ==> ~(x limit_point_of t)) + ==> FINITE t`, + REWRITE_TAC[COMPACT_EQ_BOLZANO_WEIERSTRASS; INFINITE] THEN MESON_TAC[]);; + +let DISCRETE_BOUNDED_IMP_FINITE = prove + (`!s:real^N->bool e. + &0 < e /\ + (!x y. x IN s /\ y IN s /\ norm(y - x) < e ==> y = x) /\ + bounded s + ==> FINITE s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `compact(s:real^N->bool)` MP_TAC THENL + [ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + ASM_MESON_TAC[DISCRETE_IMP_CLOSED]; + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_HEINE_BOREL)] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^N. ball(x,e)) s`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL; UNIONS_IMAGE; IN_ELIM_THM] THEN + ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[CENTRE_IN_BALL]; + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`]] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `s:real^N->bool = t` (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [UNIONS_IMAGE]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_BALL; dist] THEN ASM_MESON_TAC[SUBSET]);; + +let BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. bounded s /\ INFINITE s ==> ?x. x limit_point_of s`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP NO_LIMIT_POINT_IMP_CLOSED) THEN + STRIP_TAC THEN + MP_TAC(ISPEC `s:real^N->bool` COMPACT_EQ_BOLZANO_WEIERSTRASS) THEN + ASM_REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + DISCH_THEN(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN ASM_MESON_TAC[]);; + +let BOUNDED_EQ_BOLZANO_WEIERSTRASS = prove + (`!s:real^N->bool. + bounded s <=> !t. t SUBSET s /\ INFINITE t ==> ?x. x limit_point_of t`, + MESON_TAC[BOLZANO_WEIERSTRASS_IMP_BOUNDED; BOLZANO_WEIERSTRASS; + BOUNDED_SUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* In particular, some common special cases. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_EMPTY = prove + (`compact {}`, + REWRITE_TAC[compact; NOT_IN_EMPTY]);; + +let COMPACT_UNION = prove + (`!s t. compact s /\ compact t ==> compact (s UNION t)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_UNION; CLOSED_UNION]);; + +let COMPACT_INTER = prove + (`!s t. compact s /\ compact t ==> compact (s INTER t)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTER; CLOSED_INTER]);; + +let COMPACT_INTER_CLOSED = prove + (`!s t. compact s /\ closed t ==> compact (s INTER t)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER] THEN + MESON_TAC[BOUNDED_SUBSET; INTER_SUBSET]);; + +let CLOSED_INTER_COMPACT = prove + (`!s t. closed s /\ compact t ==> compact (s INTER t)`, + MESON_TAC[COMPACT_INTER_CLOSED; INTER_COMM]);; + +let COMPACT_INTERS = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> compact s) /\ ~(f = {}) + ==> compact(INTERS f)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTERS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOUNDED_INTERS THEN ASM SET_TAC[]);; + +let FINITE_IMP_CLOSED = prove + (`!s. FINITE s ==> closed s`, + MESON_TAC[BOLZANO_WEIERSTRASS_IMP_CLOSED; INFINITE; FINITE_SUBSET]);; + +let FINITE_IMP_CLOSED_IN = prove + (`!s t. FINITE s /\ s SUBSET t ==> closed_in (subtopology euclidean t) s`, + SIMP_TAC[CLOSED_SUBSET_EQ; FINITE_IMP_CLOSED]);; + +let FINITE_IMP_COMPACT = prove + (`!s. FINITE s ==> compact s`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; FINITE_IMP_CLOSED; FINITE_IMP_BOUNDED]);; + +let COMPACT_SING = prove + (`!a. compact {a}`, + SIMP_TAC[FINITE_IMP_COMPACT; FINITE_RULES]);; + +let COMPACT_INSERT = prove + (`!a s. compact s ==> compact(a INSERT s)`, + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + SIMP_TAC[COMPACT_UNION; COMPACT_SING]);; + +let CLOSED_SING = prove + (`!a. closed {a}`, + MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_SING]);; + +let CLOSED_IN_SING = prove + (`!u x:real^N. closed_in (subtopology euclidean u) {x} <=> x IN u`, + SIMP_TAC[CLOSED_SUBSET_EQ; CLOSED_SING] THEN SET_TAC[]);; + +let CLOSURE_SING = prove + (`!x:real^N. closure {x} = {x}`, + SIMP_TAC[CLOSURE_CLOSED; CLOSED_SING]);; + +let CLOSED_INSERT = prove + (`!a s. closed s ==> closed(a INSERT s)`, + ONCE_REWRITE_TAC[SET_RULE `a INSERT s = {a} UNION s`] THEN + SIMP_TAC[CLOSED_UNION; CLOSED_SING]);; + +let COMPACT_CBALL = prove + (`!x e. compact(cball(x,e))`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_CBALL; CLOSED_CBALL]);; + +let COMPACT_FRONTIER_BOUNDED = prove + (`!s. bounded s ==> compact(frontier s)`, + SIMP_TAC[frontier; COMPACT_EQ_BOUNDED_CLOSED; + CLOSED_DIFF; OPEN_INTERIOR; CLOSED_CLOSURE] THEN + MESON_TAC[SUBSET_DIFF; BOUNDED_SUBSET; BOUNDED_CLOSURE]);; + +let COMPACT_FRONTIER = prove + (`!s. compact s ==> compact (frontier s)`, + MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; COMPACT_FRONTIER_BOUNDED]);; + +let BOUNDED_FRONTIER = prove + (`!s:real^N->bool. bounded s ==> bounded(frontier s)`, + MESON_TAC[COMPACT_FRONTIER_BOUNDED; COMPACT_IMP_BOUNDED]);; + +let FRONTIER_SUBSET_COMPACT = prove + (`!s. compact s ==> frontier s SUBSET s`, + MESON_TAC[FRONTIER_SUBSET_CLOSED; COMPACT_EQ_BOUNDED_CLOSED]);; + +let OPEN_DELETE = prove + (`!s x. open s ==> open(s DELETE x)`, + let lemma = prove(`s DELETE x = s DIFF {x}`,SET_TAC[]) in + SIMP_TAC[lemma; OPEN_DIFF; CLOSED_SING]);; + +let OPEN_IN_DELETE = prove + (`!u s a:real^N. + open_in (subtopology euclidean u) s + ==> open_in (subtopology euclidean u) (s DELETE a)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(a:real^N) IN s` THENL + [ONCE_REWRITE_TAC[SET_RULE `s DELETE a = s DIFF {a}`] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN ASM_REWRITE_TAC[CLOSED_IN_SING] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> s DELETE a = s`]]);; + +let CLOSED_INTERS_COMPACT = prove + (`!s:real^N->bool. + closed s <=> !e. compact(cball(vec 0,e) INTER s)`, + GEN_TAC THEN EQ_TAC THENL + [SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; CLOSED_CBALL; + BOUNDED_INTER; BOUNDED_CBALL]; + ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `norm(x:real^N) + &1`) THEN + DISCH_THEN(MP_TAC o MATCH_MP COMPACT_IMP_CLOSED) THEN + REWRITE_TAC[CLOSED_LIMPT] THEN DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + REWRITE_TAC[IN_INTER] THEN ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[LIMPT_APPROACHABLE] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min e (&1 / &2)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `y:real^N` THEN SIMP_TAC[IN_INTER; IN_CBALL] THEN NORM_ARITH_TAC);; + +let COMPACT_UNIONS = prove + (`!s. FINITE s /\ (!t. t IN s ==> compact t) ==> compact(UNIONS s)`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_UNIONS; BOUNDED_UNIONS]);; + +let COMPACT_DIFF = prove + (`!s t. compact s /\ open t ==> compact(s DIFF t)`, + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + SIMP_TAC[COMPACT_INTER_CLOSED; GSYM OPEN_CLOSED]);; + +let COMPACT_SPHERE = prove + (`!a:real^N r. compact(sphere(a,r))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM FRONTIER_CBALL] THEN MATCH_MP_TAC COMPACT_FRONTIER THEN + REWRITE_TAC[COMPACT_CBALL]);; + +let BOUNDED_SPHERE = prove + (`!a:real^N r. bounded(sphere(a,r))`, + SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_BOUNDED]);; + +let CLOSED_SPHERE = prove + (`!a r. closed(sphere(a,r))`, + SIMP_TAC[COMPACT_SPHERE; COMPACT_IMP_CLOSED]);; + +let FRONTIER_SING = prove + (`!a:real^N. frontier {a} = {a}`, + REWRITE_TAC[frontier; CLOSURE_SING; INTERIOR_SING; DIFF_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Finite intersection property. I could make it an equivalence in fact. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_IMP_FIP = prove + (`!s:real^N->bool f. + compact s /\ + (!t. t IN f ==> closed t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) + ==> ~(s INTER (INTERS f) = {})`, + let lemma = prove(`(s = UNIV DIFF t) <=> (UNIV DIFF s = t)`,SET_TAC[]) in + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) f`) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN(fun th -> REPEAT STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[OPEN_DIFF; CLOSED_DIFF; OPEN_UNIV; CLOSED_UNIV; NOT_IMP] THEN + CONJ_TAC THENL + [UNDISCH_TAC `(s:real^N->bool) INTER INTERS f = {}` THEN + ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_IMAGE] THEN SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` MP_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (\t:real^N->bool. UNIV DIFF t) g`) THEN + ASM_CASES_TAC `FINITE(g:(real^N->bool)->bool)` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN ONCE_REWRITE_TAC[SUBSET; EXTENSION] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_INTER; IN_INTERS; IN_IMAGE; IN_DIFF; + IN_UNIV; NOT_IN_EMPTY; lemma; UNWIND_THM1; IN_UNIONS] THEN + SET_TAC[]]);; + +let CLOSED_IMP_FIP = prove + (`!s:real^N->bool f. + closed s /\ + (!t. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) + ==> ~(s INTER (INTERS f) = {})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `~((s INTER t) INTER u = {}) ==> ~(s INTER u = {})`) THEN + MATCH_MP_TAC COMPACT_IMP_FIP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[CLOSED_INTER_COMPACT; COMPACT_EQ_BOUNDED_CLOSED]; + REWRITE_TAC[INTER_ASSOC] THEN ONCE_REWRITE_TAC[GSYM INTERS_INSERT]] THEN + GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[FINITE_INSERT; INSERT_SUBSET]);; + +let CLOSED_IMP_FIP_COMPACT = prove + (`!s:real^N->bool f. + closed s /\ (!t. t IN f ==> compact t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(s INTER (INTERS f') = {})) + ==> ~(s INTER (INTERS f) = {})`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THEN + ASM_SIMP_TAC[SUBSET_EMPTY; INTERS_0; INTER_UNIV] THENL + [MESON_TAC[FINITE_EMPTY]; ALL_TAC] THEN + STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_FIP THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; MEMBER_NOT_EMPTY]);; + +let CLOSED_FIP = prove + (`!f. (!t:real^N->bool. t IN f ==> closed t) /\ (?t. t IN f /\ bounded t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN + MATCH_MP_TAC CLOSED_IMP_FIP THEN ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; + +let COMPACT_FIP = prove + (`!f. (!t:real^N->bool. t IN f ==> compact t) /\ + (!f'. FINITE f' /\ f' SUBSET f ==> ~(INTERS f' = {})) + ==> ~(INTERS f = {})`, + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s = {} <=> UNIV INTER s = {}`] THEN + MATCH_MP_TAC CLOSED_IMP_FIP_COMPACT THEN + ASM_REWRITE_TAC[CLOSED_UNIV; INTER_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Bounded closed nest property (proof does not use Heine-Borel). *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_CLOSED_NEST = prove + (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ + (!m n. m <= n ==> s(n) SUBSET s(m)) /\ + bounded(s 0) + ==> ?a:real^N. !n:num. a IN s(n)`, + GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `compact(s 0:real^N->bool)` MP_TAC THENL + [ASM_MESON_TAC[BOUNDED_CLOSED_IMP_COMPACT]; ALL_TAC] THEN + REWRITE_TAC[compact] THEN + DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[SUBSET; LE_0]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `l:real^N` THEN + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~(~p)`] THEN + GEN_REWRITE_TAC RAND_CONV [NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + MP_TAC(ISPECL [`l:real^N`; `(s:num->real^N->bool) N`] + CLOSED_APPROACHABLE) THEN + ASM_MESON_TAC[SUBSET; LE_REFL; LE_TRANS; LE_CASES; MONOTONE_BIGGER]);; + +(* ------------------------------------------------------------------------- *) +(* Decreasing case does not even need compactness, just completeness. *) +(* ------------------------------------------------------------------------- *) + +let DECREASING_CLOSED_NEST = prove + (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ + (!m n. m <= n ==> s(n) SUBSET s(m)) /\ + (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) + ==> ?a:real^N. !n:num. a IN s(n)`, + GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; SKOLEM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num->real^N`) STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?l:real^N. (a --> l) sequentially` MP_TAC THENL + [ASM_MESON_TAC[cauchy; GE; SUBSET; LE_TRANS; LE_REFL; + complete; COMPLETE_UNIV; IN_UNIV]; + ASM_MESON_TAC[LIM_SEQUENTIALLY; CLOSED_APPROACHABLE; + SUBSET; LE_REFL; LE_TRANS; LE_CASES]]);; + +(* ------------------------------------------------------------------------- *) +(* Strengthen it to the intersection actually being a singleton. *) +(* ------------------------------------------------------------------------- *) + +let DECREASING_CLOSED_NEST_SING = prove + (`!s. (!n. closed(s n)) /\ (!n. ~(s n = {})) /\ + (!m n. m <= n ==> s(n) SUBSET s(m)) /\ + (!e. &0 < e ==> ?n. !x y. x IN s(n) /\ y IN s(n) ==> dist(x,y) < e) + ==> ?a:real^N. INTERS {t | ?n:num. t = s n} = {a}`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DECREASING_CLOSED_NEST) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERS; IN_SING; IN_ELIM_THM] THEN + ASM_MESON_TAC[DIST_POS_LT; REAL_LT_REFL; SUBSET; LE_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* A version for a more general chain, not indexed by N. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_CLOSED_CHAIN = prove + (`!f b:real^N->bool. + (!s. s IN f ==> closed s /\ ~(s = {})) /\ + (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) /\ + b IN f /\ bounded b + ==> ~(INTERS f = {})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `~(b INTER (INTERS f):real^N->bool = {})` MP_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + MATCH_MP_TAC COMPACT_IMP_FIP THEN + ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + X_GEN_TAC `u:(real^N->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `?s:real^N->bool. s IN f /\ !t. t IN u ==> s SUBSET t` + MP_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + UNDISCH_TAC `(u:(real^N->bool)->bool) SUBSET f` THEN + UNDISCH_TAC `FINITE(u:(real^N->bool)->bool)` THEN + SPEC_TAC(`u:(real^N->bool)->bool`,`u:(real^N->bool)->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`t:real^N->bool`; `u:(real^N->bool)->bool`] THEN + REWRITE_TAC[INSERT_SUBSET] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:real^N->bool`; `t:real^N->bool`]) THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Analogous things directly for compactness. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_CHAIN = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> compact s /\ ~(s = {})) /\ + (!s t. s IN f /\ t IN f ==> s SUBSET t \/ t SUBSET s) + ==> ~(INTERS f = {})`, + GEN_TAC THEN REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN STRIP_TAC THEN + ASM_CASES_TAC `f:(real^N->bool)->bool = {}` THENL + [ASM_REWRITE_TAC[INTERS_0] THEN SET_TAC[]; + MATCH_MP_TAC BOUNDED_CLOSED_CHAIN THEN ASM SET_TAC[]]);; + +let COMPACT_NEST = prove + (`!s. (!n. compact(s n) /\ ~(s n = {})) /\ + (!m n. m <= n ==> s n SUBSET s m) + ==> ~(INTERS {s n | n IN (:num)} = {})`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC COMPACT_CHAIN THEN + ASM_SIMP_TAC[FORALL_IN_GSPEC; IN_UNIV; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC WLOG_LE THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy-type criteria for *uniform* convergence. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONVERGENT_EQ_CAUCHY = prove + (`!P s:num->A->real^N. + (?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e) <=> + (!e. &0 < e + ==> ?N. !m n x. N <= m /\ N <= n /\ P x + ==> dist(s m x,s n x) < e)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `l:A->real^N`) THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MESON_TAC[DIST_TRIANGLE_HALF_L]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `!x:A. P x ==> cauchy (\n. s n x :real^N)` MP_TAC THENL + [REWRITE_TAC[cauchy; GE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY; LIM_SEQUENTIALLY] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `l:A->real^N` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `N + M:num`; `x:A`]) THEN + ASM_REWRITE_TAC[LE_ADD] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN + ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; + +let UNIFORMLY_CAUCHY_IMP_UNIFORMLY_CONVERGENT = prove + (`!P (s:num->A->real^N) l. + (!e. &0 < e + ==> ?N. !m n x. N <= m /\ N <= n /\ P x ==> dist(s m x,s n x) < e) /\ + (!x. P x ==> !e. &0 < e ==> ?N. !n. N <= n ==> dist(s n x,l x) < e) + ==> (!e. &0 < e ==> ?N. !n x. N <= n /\ P x ==> dist(s n x,l x) < e)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `l':A->real^N`) ASSUME_TAC) THEN + SUBGOAL_THEN `!x. P x ==> (l:A->real^N) x = l' x` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n. (s:num->A->real^N) n x` THEN + REWRITE_TAC[LIM_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Define continuity over a net to take in restrictions of the set. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("continuous",(12,"right"));; + +let continuous = new_definition + `f continuous net <=> (f --> f(netlimit net)) net`;; + +let CONTINUOUS_TRIVIAL_LIMIT = prove + (`!f net. trivial_limit net ==> f continuous net`, + SIMP_TAC[continuous; LIM]);; + +let CONTINUOUS_WITHIN = prove + (`!f x:real^M. f continuous (at x within s) <=> (f --> f(x)) (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous] THEN + ASM_CASES_TAC `trivial_limit(at (x:real^M) within s)` THENL + [ASM_REWRITE_TAC[LIM]; ASM_SIMP_TAC[NETLIMIT_WITHIN]]);; + +let CONTINUOUS_AT = prove + (`!f (x:real^N). f continuous (at x) <=> (f --> f(x)) (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[CONTINUOUS_WITHIN; IN_UNIV]);; + +let CONTINUOUS_AT_WITHIN = prove + (`!f:real^M->real^N x s. + f continuous (at x) ==> f continuous (at x within s)`, + SIMP_TAC[LIM_AT_WITHIN; CONTINUOUS_AT; CONTINUOUS_WITHIN]);; + +let CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL = prove + (`!a s. closed s /\ ~(a IN s) ==> f continuous (at a within s)`, + ASM_SIMP_TAC[continuous; LIM; LIM_WITHIN_CLOSED_TRIVIAL]);; + +let CONTINUOUS_TRANSFORM_WITHIN = prove + (`!f g:real^M->real^N s x d. + &0 < d /\ x IN s /\ + (!x'. x' IN s /\ dist(x',x) < d ==> f(x') = g(x')) /\ + f continuous (at x within s) + ==> g continuous (at x within s)`, + REWRITE_TAC[CONTINUOUS_WITHIN] THEN + MESON_TAC[LIM_TRANSFORM_WITHIN; DIST_REFL]);; + +let CONTINUOUS_TRANSFORM_AT = prove + (`!f g:real^M->real^N x d. + &0 < d /\ (!x'. dist(x',x) < d ==> f(x') = g(x')) /\ + f continuous (at x) + ==> g continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT] THEN + MESON_TAC[LIM_TRANSFORM_AT; DIST_REFL]);; + +let CONTINUOUS_TRANSFORM_WITHIN_OPEN = prove + (`!f g:real^M->real^N s a. + open s /\ a IN s /\ + (!x. x IN s ==> f x = g x) /\ + f continuous at a + ==> g continuous at a`, + MESON_TAC[CONTINUOUS_AT; LIM_TRANSFORM_WITHIN_OPEN]);; + +let CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN = prove + (`!f g:real^M->real^N s t a. + open_in (subtopology euclidean t) s /\ a IN s /\ + (!x. x IN s ==> f x = g x) /\ + f continuous (at a within t) + ==> g continuous (at a within t)`, + MESON_TAC[CONTINUOUS_WITHIN; LIM_TRANSFORM_WITHIN_OPEN_IN]);; + +(* ------------------------------------------------------------------------- *) +(* Derive the epsilon-delta forms, which we often use as "definitions" *) +(* ------------------------------------------------------------------------- *) + +let continuous_within = prove + (`f continuous (at x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x',x) < d ==> dist(f(x'),f(x)) < e`, + REWRITE_TAC[CONTINUOUS_WITHIN; LIM_WITHIN] THEN + REWRITE_TAC[GSYM DIST_NZ] THEN MESON_TAC[DIST_REFL]);; + +let continuous_at = prove + (`f continuous (at x) <=> + !e. &0 < e ==> ?d. &0 < d /\ + !x'. dist(x',x) < d ==> dist(f(x'),f(x)) < e`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[continuous_within; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Versions in terms of open balls. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_BALL = prove + (`!f s x. f continuous (at x within s) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + IMAGE f (ball(x,d) INTER s) SUBSET ball(f x,e)`, + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_within; IN_INTER] THEN + MESON_TAC[DIST_SYM]);; + +let CONTINUOUS_AT_BALL = prove + (`!f x. f continuous (at x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + IMAGE f (ball(x,d)) SUBSET ball(f x,e)`, + SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_BALL; continuous_at] THEN + MESON_TAC[DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* For setwise continuity, just start from the epsilon-delta definitions. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("continuous_on",(12,"right"));; +parse_as_infix ("uniformly_continuous_on",(12,"right"));; + +let continuous_on = new_definition + `f continuous_on s <=> + !x. x IN s ==> !e. &0 < e + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x',x) < d + ==> dist(f(x'),f(x)) < e`;; + +let uniformly_continuous_on = new_definition + `f uniformly_continuous_on s <=> + !e. &0 < e + ==> ?d. &0 < d /\ + !x x'. x IN s /\ x' IN s /\ dist(x',x) < d + ==> dist(f(x'),f(x)) < e`;; + +(* ------------------------------------------------------------------------- *) +(* Some simple consequential lemmas. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS = prove + (`!f s. f uniformly_continuous_on s ==> f continuous_on s`, + REWRITE_TAC[uniformly_continuous_on; continuous_on] THEN MESON_TAC[]);; + +let CONTINUOUS_AT_IMP_CONTINUOUS_ON = prove + (`!f s. (!x. x IN s ==> f continuous (at x)) ==> f continuous_on s`, + REWRITE_TAC[continuous_at; continuous_on] THEN MESON_TAC[]);; + +let CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN = prove + (`!f s. f continuous_on s <=> !x. x IN s ==> f continuous (at x within s)`, + REWRITE_TAC[continuous_on; continuous_within]);; + +let CONTINUOUS_ON = prove + (`!f (s:real^N->bool). + f continuous_on s <=> !x. x IN s ==> (f --> f(x)) (at x within s)`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN]);; + +let CONTINUOUS_ON_EQ_CONTINUOUS_AT = prove + (`!f:real^M->real^N s. + open s ==> (f continuous_on s <=> (!x. x IN s ==> f continuous (at x)))`, + SIMP_TAC[CONTINUOUS_ON; CONTINUOUS_AT; LIM_WITHIN_OPEN]);; + +let CONTINUOUS_WITHIN_SUBSET = prove + (`!f s t x. f continuous (at x within s) /\ t SUBSET s + ==> f continuous (at x within t)`, + REWRITE_TAC[CONTINUOUS_WITHIN] THEN MESON_TAC[LIM_WITHIN_SUBSET]);; + +let CONTINUOUS_ON_SUBSET = prove + (`!f s t. f continuous_on s /\ t SUBSET s ==> f continuous_on t`, + REWRITE_TAC[CONTINUOUS_ON] THEN MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; + +let UNIFORMLY_CONTINUOUS_ON_SUBSET = prove + (`!f s t. f uniformly_continuous_on s /\ t SUBSET s + ==> f uniformly_continuous_on t`, + REWRITE_TAC[uniformly_continuous_on] THEN + MESON_TAC[SUBSET; LIM_WITHIN_SUBSET]);; + +let CONTINUOUS_ON_INTERIOR = prove + (`!f:real^M->real^N s x. + f continuous_on s /\ x IN interior(s) ==> f continuous at x`, + REWRITE_TAC[interior; IN_ELIM_THM] THEN + MESON_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; CONTINUOUS_ON_SUBSET]);; + +let CONTINUOUS_ON_EQ = prove + (`!f g s. (!x. x IN s ==> f(x) = g(x)) /\ f continuous_on s + ==> g continuous_on s`, + SIMP_TAC[continuous_on; IMP_CONJ]);; + +let UNIFORMLY_CONTINUOUS_ON_EQ = prove + (`!f g s. + (!x. x IN s ==> f x = g x) /\ f uniformly_continuous_on s + ==> g uniformly_continuous_on s`, + SIMP_TAC[uniformly_continuous_on; IMP_CONJ]);; + +let CONTINUOUS_ON_SING = prove + (`!f:real^M->real^N a. f continuous_on {a}`, + SIMP_TAC[continuous_on; IN_SING; FORALL_UNWIND_THM2; DIST_REFL] THEN + MESON_TAC[]);; + +let CONTINUOUS_ON_EMPTY = prove + (`!f:real^M->real^N. f continuous_on {}`, + MESON_TAC[CONTINUOUS_ON_SING; EMPTY_SUBSET; CONTINUOUS_ON_SUBSET]);; + +let CONTINUOUS_ON_NO_LIMPT = prove + (`!f:real^M->real^N s. + ~(?x. x limit_point_of s) ==> f continuous_on s`, + REWRITE_TAC[continuous_on; LIMPT_APPROACHABLE] THEN MESON_TAC[DIST_REFL]);; + +let CONTINUOUS_ON_FINITE = prove + (`!f:real^M->real^N s. FINITE s ==> f continuous_on s`, + MESON_TAC[CONTINUOUS_ON_NO_LIMPT; LIMIT_POINT_FINITE]);; + +let CONTRACTION_IMP_CONTINUOUS_ON = prove + (`!f:real^M->real^N. + (!x y. x IN s /\ y IN s ==> dist(f x,f y) <= dist(x,y)) + ==> f continuous_on s`, + SIMP_TAC[continuous_on] THEN MESON_TAC[REAL_LET_TRANS]);; + +let ISOMETRY_ON_IMP_CONTINUOUS_ON = prove + (`!f:real^M->real^N. + (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) + ==> f continuous_on s`, + SIMP_TAC[CONTRACTION_IMP_CONTINUOUS_ON; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Characterization of various kinds of continuity in terms of sequences. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_SEQUENTIALLY = prove + (`!f a:real^N. + f continuous (at a within s) <=> + !x. (!n. x(n) IN s) /\ (x --> a) sequentially + ==> ((f o x) --> f(a)) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL + [REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; + REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN + X_GEN_TAC `y:num->real^N` THEN REWRITE_TAC[LIM_SEQUENTIALLY; o_THM] THEN + STRIP_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FORALL_POS_MONO_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; + REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]);; + +let CONTINUOUS_AT_SEQUENTIALLY = prove + (`!f a:real^N. + f continuous (at a) <=> + !x. (x --> a) sequentially + ==> ((f o x) --> f(a)) sequentially`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY; IN_UNIV]);; + +let CONTINUOUS_ON_SEQUENTIALLY = prove + (`!f s:real^N->bool. + f continuous_on s <=> + !x a. a IN s /\ (!n. x(n) IN s) /\ (x --> a) sequentially + ==> ((f o x) --> f(a)) sequentially`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; + +let UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY = prove + (`!f s:real^N->bool. + f uniformly_continuous_on s <=> + !x y. (!n. x(n) IN s) /\ (!n. y(n) IN s) /\ + ((\n. x(n) - y(n)) --> vec 0) sequentially + ==> ((\n. f(x(n)) - f(y(n))) --> vec 0) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; dist; VECTOR_SUB_RZERO] THEN + EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; NOT_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&1 / (&n + &1)`) THEN + SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_POS; ARITH; + REAL_ARITH `&0 <= n ==> &0 < n + &1`; NOT_FORALL_THM; SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:num->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:num->real^N` THEN + REWRITE_TAC[NOT_IMP; FORALL_AND_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN CONJ_TAC THENL + [MATCH_MP_TAC FORALL_POS_MONO_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[REAL_LT_TRANS]; ALL_TAC] THEN + X_GEN_TAC `n:num` THEN EXISTS_TAC `n:num` THEN X_GEN_TAC `m:num` THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 / (&m + &1)` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_INV2; real_div; REAL_ARITH `&0 <= x ==> &0 < x + &1`; + REAL_POS; REAL_MUL_LID; REAL_LE_RADD; REAL_OF_NUM_LE]; + EXISTS_TAC `e:real` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `\x:num. x` THEN ASM_REWRITE_TAC[LE_REFL]]);; + +let LIM_CONTINUOUS_FUNCTION = prove + (`!f net g l. + f continuous (at l) /\ (g --> l) net ==> ((\x. f(g x)) --> f l) net`, + REWRITE_TAC[tendsto; continuous_at; eventually] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combination results for pointwise continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_CONST = prove + (`!net c. (\x. c) continuous net`, + REWRITE_TAC[continuous; LIM_CONST]);; + +let CONTINUOUS_CMUL = prove + (`!f c net. f continuous net ==> (\x. c % f(x)) continuous net`, + REWRITE_TAC[continuous; LIM_CMUL]);; + +let CONTINUOUS_NEG = prove + (`!f net. f continuous net ==> (\x. --(f x)) continuous net`, + REWRITE_TAC[continuous; LIM_NEG]);; + +let CONTINUOUS_ADD = prove + (`!f g net. f continuous net /\ g continuous net + ==> (\x. f(x) + g(x)) continuous net`, + REWRITE_TAC[continuous; LIM_ADD]);; + +let CONTINUOUS_SUB = prove + (`!f g net. f continuous net /\ g continuous net + ==> (\x. f(x) - g(x)) continuous net`, + REWRITE_TAC[continuous; LIM_SUB]);; + +let CONTINUOUS_ABS = prove + (`!(f:A->real^N) net. + f continuous net + ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous net`, + REWRITE_TAC[continuous; LIM_ABS]);; + +let CONTINUOUS_MAX = prove + (`!(f:A->real^N) (g:A->real^N) net. + f continuous net /\ g continuous net + ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) continuous net`, + REWRITE_TAC[continuous; LIM_MAX]);; + +let CONTINUOUS_MIN = prove + (`!(f:A->real^N) (g:A->real^N) net. + f continuous net /\ g continuous net + ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) continuous net`, + REWRITE_TAC[continuous; LIM_MIN]);; + +let CONTINUOUS_VSUM = prove + (`!net f s. FINITE s /\ (!a. a IN s ==> (f a) continuous net) + ==> (\x. vsum s (\a. f a x)) continuous net`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; + CONTINUOUS_CONST; CONTINUOUS_ADD; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing for setwise continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CONST = prove + (`!s c. (\x. c) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CONST]);; + +let CONTINUOUS_ON_CMUL = prove + (`!f c s. f continuous_on s ==> (\x. c % f(x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_CMUL]);; + +let CONTINUOUS_ON_NEG = prove + (`!f s. f continuous_on s + ==> (\x. --(f x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_NEG]);; + +let CONTINUOUS_ON_ADD = prove + (`!f g s. f continuous_on s /\ g continuous_on s + ==> (\x. f(x) + g(x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ADD]);; + +let CONTINUOUS_ON_SUB = prove + (`!f g s. f continuous_on s /\ g continuous_on s + ==> (\x. f(x) - g(x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_SUB]);; + +let CONTINUOUS_ON_ABS = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> (\x. (lambda i. abs(f(x)$i)):real^N) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_ABS]);; + +let CONTINUOUS_ON_MAX = prove + (`!f:real^M->real^N g:real^M->real^N s. + f continuous_on s /\ g continuous_on s + ==> (\x. (lambda i. max (f(x)$i) (g(x)$i)):real^N) + continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MAX]);; + +let CONTINUOUS_ON_MIN = prove + (`!f:real^M->real^N g:real^M->real^N s. + f continuous_on s /\ g continuous_on s + ==> (\x. (lambda i. min (f(x)$i) (g(x)$i)):real^N) + continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_MIN]);; + +let CONTINUOUS_ON_VSUM = prove + (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) continuous_on t) + ==> (\x. vsum s (\a. f a x)) continuous_on t`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_VSUM]);; + +(* ------------------------------------------------------------------------- *) +(* Same thing for uniform continuity, using sequential formulations. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_ON_CONST = prove + (`!s c. (\x. c) uniformly_continuous_on s`, + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY; o_DEF; + VECTOR_SUB_REFL; LIM_CONST]);; + +let LINEAR_UNIFORMLY_CONTINUOUS_ON = prove + (`!f:real^M->real^N s. linear f ==> f uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[uniformly_continuous_on; dist; GSYM LINEAR_SUB] THEN + FIRST_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP LINEAR_BOUNDED_POS) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B:real` THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * norm(y - x:real^M)` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[REAL_LT_RDIV_EQ; REAL_MUL_SYM]);; + +let UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove + (`!f g s. f uniformly_continuous_on s /\ + g uniformly_continuous_on (IMAGE f s) + ==> (g o f) uniformly_continuous_on s`, + let lemma = prove + (`(!y. ((?x. (y = f x) /\ P x) /\ Q y ==> R y)) <=> + (!x. P x /\ Q (f x) ==> R (f x))`, + MESON_TAC[]) in + REPEAT GEN_TAC THEN + REWRITE_TAC[uniformly_continuous_on; o_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[lemma] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +let BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE = prove + (`!f:real^M->real^N g (h:real^N->real^P->real^Q) s. + f uniformly_continuous_on s /\ g uniformly_continuous_on s /\ + bilinear h /\ bounded(IMAGE f s) /\ bounded(IMAGE g s) + ==> (\x. h (f x) (g x)) uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; dist] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!a b c d. (h:real^N->real^P->real^Q) a b - h c d = + h (a - c) b + h c (b - d)` + (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_LSUB th]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP BILINEAR_RSUB th]) THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC o + MATCH_MP BILINEAR_BOUNDED_POS) THEN + UNDISCH_TAC `bounded(IMAGE (g:real^M->real^P) s)` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `B1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(g:real^M->real^P) uniformly_continuous_on s` THEN + UNDISCH_TAC `(f:real^M->real^N) uniformly_continuous_on s` THEN + REWRITE_TAC[uniformly_continuous_on] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2 / &2 / B / B1`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_HALF; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^M`])) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC + `B * e / &2 / &2 / B / B2 * B2 + B * B1 * e / &2 / &2 / B / B1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `norm(x) <= a /\ norm(y) <= b ==> norm(x + y:real^N) <= a + b`) THEN + CONJ_TAC THEN + FIRST_X_ASSUM(fun th -> W(MP_TAC o PART_MATCH lhand th o lhand o snd)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LE_TRANS) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE]; + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + ASM_REAL_ARITH_TAC]);; + +let UNIFORMLY_CONTINUOUS_ON_MUL = prove + (`!f g:real^M->real^N s. + (lift o f) uniformly_continuous_on s /\ g uniformly_continuous_on s /\ + bounded(IMAGE (lift o f) s) /\ bounded(IMAGE g s) + ==> (\x. f x % g x) uniformly_continuous_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`lift o (f:real^M->real)`; `g:real^M->real^N`; + `\c (v:real^N). drop c % v`; `s:real^M->bool`] + BILINEAR_UNIFORMLY_CONTINUOUS_ON_COMPOSE) THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN VECTOR_ARITH_TAC);; + +let UNIFORMLY_CONTINUOUS_ON_CMUL = prove + (`!f c s. f uniformly_continuous_on s + ==> (\x. c % f(x)) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_CMUL) THEN + ASM_SIMP_TAC[VECTOR_SUB_LDISTRIB; VECTOR_MUL_RZERO]);; + +let UNIFORMLY_CONTINUOUS_ON_VMUL = prove + (`!s:real^M->bool c v:real^N. + (lift o c) uniformly_continuous_on s + ==> (\x. c x % v) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o ISPEC `\x. (drop x % v:real^N)` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] UNIFORMLY_CONTINUOUS_ON_COMPOSE)) THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC LINEAR_UNIFORMLY_CONTINUOUS_ON THEN + MATCH_MP_TAC LINEAR_VMUL_DROP THEN REWRITE_TAC[LINEAR_ID]);; + +let UNIFORMLY_CONTINUOUS_ON_NEG = prove + (`!f s. f uniformly_continuous_on s + ==> (\x. --(f x)) uniformly_continuous_on s`, + ONCE_REWRITE_TAC[VECTOR_NEG_MINUS1] THEN + REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_CMUL]);; + +let UNIFORMLY_CONTINUOUS_ON_ADD = prove + (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s + ==> (\x. f(x) + g(x)) uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIFORMLY_CONTINUOUS_ON_SEQUENTIALLY] THEN + REWRITE_TAC[AND_FORALL_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[o_DEF] THEN DISCH_THEN(MP_TAC o MATCH_MP LIM_ADD) THEN + MATCH_MP_TAC EQ_IMP THEN + REWRITE_TAC[VECTOR_ADD_LID] THEN AP_THM_TAC THEN BINOP_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; + +let UNIFORMLY_CONTINUOUS_ON_SUB = prove + (`!f g s. f uniformly_continuous_on s /\ g uniformly_continuous_on s + ==> (\x. f(x) - g(x)) uniformly_continuous_on s`, + REWRITE_TAC[VECTOR_SUB] THEN + SIMP_TAC[UNIFORMLY_CONTINUOUS_ON_NEG; UNIFORMLY_CONTINUOUS_ON_ADD]);; + +let UNIFORMLY_CONTINUOUS_ON_VSUM = prove + (`!t f s. FINITE s /\ (!a. a IN s ==> (f a) uniformly_continuous_on t) + ==> (\x. vsum s (\a. f a x)) uniformly_continuous_on t`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; VSUM_CLAUSES; + UNIFORMLY_CONTINUOUS_ON_CONST; UNIFORMLY_CONTINUOUS_ON_ADD; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Identity function is continuous in every sense. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_ID = prove + (`!a s. (\x. x) continuous (at a within s)`, + REWRITE_TAC[continuous_within] THEN MESON_TAC[]);; + +let CONTINUOUS_AT_ID = prove + (`!a. (\x. x) continuous (at a)`, + REWRITE_TAC[continuous_at] THEN MESON_TAC[]);; + +let CONTINUOUS_ON_ID = prove + (`!s. (\x. x) continuous_on s`, + REWRITE_TAC[continuous_on] THEN MESON_TAC[]);; + +let UNIFORMLY_CONTINUOUS_ON_ID = prove + (`!s. (\x. x) uniformly_continuous_on s`, + REWRITE_TAC[uniformly_continuous_on] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of all kinds is preserved under composition. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_COMPOSE = prove + (`!f g x s. f continuous (at x within s) /\ + g continuous (at (f x) within IMAGE f s) + ==> (g o f) continuous (at x within s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within; o_THM; IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_AT_COMPOSE = prove + (`!f g x. f continuous (at x) /\ g continuous (at (f x)) + ==> (g o f) continuous (at x)`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + MESON_TAC[CONTINUOUS_WITHIN_COMPOSE; IN_IMAGE; CONTINUOUS_WITHIN_SUBSET; + SUBSET_UNIV; IN_UNIV]);; + +let CONTINUOUS_ON_COMPOSE = prove + (`!f g s. f continuous_on s /\ g continuous_on (IMAGE f s) + ==> (g o f) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + MESON_TAC[IN_IMAGE; CONTINUOUS_WITHIN_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity in terms of open preimages. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_OPEN = prove + (`!f:real^M->real^N x u. + f continuous (at x within u) <=> + !t. open t /\ f(x) IN t + ==> ?s. open s /\ x IN s /\ + !x'. x' IN s /\ x' IN u ==> f(x') IN t`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_within] THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [open_def] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL; DIST_SYM]; + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; + +let CONTINUOUS_AT_OPEN = prove + (`!f:real^M->real^N x. + f continuous (at x) <=> + !t. open t /\ f(x) IN t + ==> ?s. open s /\ x IN s /\ + !x'. x' IN s ==> f(x') IN t`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_at] THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC LAND_CONV [open_def] THEN + DISCH_THEN(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ASM_MESON_TAC[IN_BALL; DIST_SYM; OPEN_BALL; CENTRE_IN_BALL]; + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ball((f:real^M->real^N) x,e)`) THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL] THEN + MESON_TAC[open_def; IN_BALL; REAL_LT_TRANS; DIST_SYM]]);; + +let CONTINUOUS_ON_OPEN_GEN = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> (f continuous_on s <=> + !u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_on] THEN EQ_TAC THENL + [REWRITE_TAC[open_in; SUBSET; IN_ELIM_THM] THEN + DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIST_REFL]; ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN ASM SET_TAC[]; + DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o + SPEC `ball((f:real^M->real^N) x,e) INTER t`) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[OPEN_IN_OPEN; INTER_COMM; OPEN_BALL]; ALL_TAC] THEN + REWRITE_TAC[open_in; SUBSET; IN_INTER; IN_ELIM_THM; IN_BALL; IN_IMAGE] THEN + REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_MESON_TAC[DIST_REFL; DIST_SYM]]);; + +let CONTINUOUS_ON_OPEN = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. open_in (subtopology euclidean (IMAGE f s)) t + ==> open_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_OPEN_GEN THEN + REWRITE_TAC[SUBSET_REFL]);; + +let CONTINUOUS_OPEN_IN_PREIMAGE_GEN = prove + (`!f:real^M->real^N s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, + MESON_TAC[CONTINUOUS_ON_OPEN_GEN]);; + +let CONTINUOUS_ON_IMP_OPEN_IN = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ + open_in (subtopology euclidean (IMAGE f s)) t + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + MESON_TAC[CONTINUOUS_ON_OPEN]);; + +(* ------------------------------------------------------------------------- *) +(* Similarly in terms of closed sets. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CLOSED_GEN = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> (f continuous_on s <=> + !u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN u})`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(fun th -> + ONCE_REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN + EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `u:real^N->bool` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THENL + [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let CONTINUOUS_ON_CLOSED = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. closed_in (subtopology euclidean (IMAGE f s)) t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CLOSED_GEN THEN + REWRITE_TAC[SUBSET_REFL]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE_GEN = prove + (`!f:real^M->real^N s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u}`, + MESON_TAC[CONTINUOUS_ON_CLOSED_GEN]);; + +let CONTINUOUS_ON_IMP_CLOSED_IN = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ + closed_in (subtopology euclidean (IMAGE f s)) t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + MESON_TAC[CONTINUOUS_ON_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Half-global and completely global cases. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_OPEN_IN_PREIMAGE = prove + (`!f s t. + f continuous_on s /\ open t + ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_OPEN]) THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + ASM_REWRITE_TAC[]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE = prove + (`!f s t. + f continuous_on s /\ closed t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[SET_RULE + `x IN s /\ f x IN t <=> x IN s /\ f x IN (t INTER IMAGE f s)`] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[CONTINUOUS_ON_CLOSED]) THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN MATCH_MP_TAC CLOSED_IN_CLOSED_INTER THEN + ASM_REWRITE_TAC[]);; + +let CONTINUOUS_OPEN_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ open s /\ open t + ==> open {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + REWRITE_TAC [OPEN_IN_OPEN] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN + ANTS_TAC THENL + [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; + STRIP_TAC THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = + s INTER t'` SUBST1_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [OPEN_INTER]]]);; + +let CONTINUOUS_CLOSED_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ closed s /\ closed t + ==> closed {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_CLOSED]) THEN + REWRITE_TAC [CLOSED_IN_CLOSED] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (f:real^M->real^N) s INTER t`) THEN + ANTS_TAC THENL + [EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC []; + STRIP_TAC THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN t} = + s INTER t'` SUBST1_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [CLOSED_INTER]]]);; + +let CONTINUOUS_OPEN_PREIMAGE_UNIV = prove + (`!f:real^M->real^N s. + (!x. f continuous (at x)) /\ open s ==> open {x | f(x) IN s}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] + CONTINUOUS_OPEN_PREIMAGE) THEN + ASM_SIMP_TAC[OPEN_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let CONTINUOUS_CLOSED_PREIMAGE_UNIV = prove + (`!f:real^M->real^N s. + (!x. f continuous (at x)) /\ closed s ==> closed {x | f(x) IN s}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real^M->real^N`; `(:real^M)`; `s:real^N->bool`] + CONTINUOUS_CLOSED_PREIMAGE) THEN + ASM_SIMP_TAC[CLOSED_UNIV; IN_UNIV; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let CONTINUOUS_OPEN_IN_PREIMAGE_EQ = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. open t ==> open_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_OPEN_IN_PREIMAGE] THEN + REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN DISCH_TAC THEN + X_GEN_TAC `t:real^N->bool` THEN GEN_REWRITE_TAC LAND_CONV [OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE_EQ = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !t. closed t + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x IN t}`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE] THEN + REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN DISCH_TAC THEN + X_GEN_TAC `t:real^N->bool` THEN + GEN_REWRITE_TAC LAND_CONV [CLOSED_IN_CLOSED] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Linear functions are (uniformly) continuous on any set. *) +(* ------------------------------------------------------------------------- *) + +let LINEAR_LIM_0 = prove + (`!f. linear f ==> (f --> vec 0) (at (vec 0))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_AT] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP LINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `e / B` THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN REWRITE_TAC[dist; VECTOR_SUB_RZERO] THEN + ASM_MESON_TAC[REAL_MUL_SYM; REAL_LET_TRANS; REAL_LT_RDIV_EQ]);; + +let LINEAR_CONTINUOUS_AT = prove + (`!f:real^M->real^N a. linear f ==> f continuous (at a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\x. (f:real^M->real^N) (a + x) - f(a)` LINEAR_LIM_0) THEN + ANTS_TAC THENL + [POP_ASSUM MP_TAC THEN SIMP_TAC[linear] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM LIM_NULL; CONTINUOUS_AT] THEN + GEN_REWRITE_TAC RAND_CONV [LIM_AT_ZERO] THEN SIMP_TAC[]);; + +let LINEAR_CONTINUOUS_WITHIN = prove + (`!f:real^M->real^N s x. linear f ==> f continuous (at x within s)`, + SIMP_TAC[CONTINUOUS_AT_WITHIN; LINEAR_CONTINUOUS_AT]);; + +let LINEAR_CONTINUOUS_ON = prove + (`!f:real^M->real^N s. linear f ==> f continuous_on s`, + MESON_TAC[LINEAR_CONTINUOUS_AT; CONTINUOUS_AT_IMP_CONTINUOUS_ON]);; + +let LINEAR_CONTINUOUS_COMPOSE = prove + (`!net f:A->real^N g:real^N->real^P. + f continuous net /\ linear g ==> (\x. g(f x)) continuous net`, + REWRITE_TAC[continuous; LIM_LINEAR]);; + +let LINEAR_CONTINUOUS_ON_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s. + f continuous_on s /\ linear g ==> (\x. g(f x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + LINEAR_CONTINUOUS_COMPOSE]);; + +let CONTINUOUS_LIFT_COMPONENT_COMPOSE = prove + (`!net f:A->real^N i. f continuous net ==> (\x. lift(f x$i)) continuous net`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `linear(\x:real^N. lift (x$i))` MP_TAC THENL + [REWRITE_TAC[LINEAR_LIFT_COMPONENT]; REWRITE_TAC[GSYM IMP_CONJ_ALT]] THEN + REWRITE_TAC[LINEAR_CONTINUOUS_COMPOSE]);; + +let CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> (\x. lift (f x$i)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + CONTINUOUS_LIFT_COMPONENT_COMPOSE]);; + +(* ------------------------------------------------------------------------- *) +(* Also bilinear functions, in composition form. *) +(* ------------------------------------------------------------------------- *) + +let BILINEAR_CONTINUOUS_COMPOSE = prove + (`!net f:A->real^M g:A->real^N h:real^M->real^N->real^P. + f continuous net /\ g continuous net /\ bilinear h + ==> (\x. h (f x) (g x)) continuous net`, + REWRITE_TAC[continuous; LIM_BILINEAR]);; + +let BILINEAR_CONTINUOUS_ON_COMPOSE = prove + (`!f g h s. f continuous_on s /\ g continuous_on s /\ bilinear h + ==> (\x. h (f x) (g x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; + BILINEAR_CONTINUOUS_COMPOSE]);; + +let BILINEAR_DOT = prove + (`bilinear (\x y:real^N. lift(x dot y))`, + REWRITE_TAC[bilinear; linear; DOT_LADD; DOT_RADD; DOT_LMUL; DOT_RMUL] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; + +let CONTINUOUS_LIFT_DOT2 = prove + (`!net f g:A->real^N. + f continuous net /\ g continuous net + ==> (\x. lift(f x dot g x)) continuous net`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_CONTINUOUS_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +let CONTINUOUS_ON_LIFT_DOT2 = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on s + ==> (\x. lift(f x dot g x)) continuous_on s`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP (MATCH_MP (REWRITE_RULE + [TAUT `p /\ q /\ r ==> s <=> r ==> p /\ q ==> s`] + BILINEAR_CONTINUOUS_ON_COMPOSE) BILINEAR_DOT)) THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of compactness and connectedness under continuous function. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ compact s ==> compact(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; compact] THEN + STRIP_TAC THEN X_GEN_TAC `y:num->real^N` THEN + REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `r:num->num` THEN + DISCH_THEN(X_CHOOSE_THEN `l:real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:real^M->real^N) l` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `l:real^M`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[o_THM] THEN + ASM_MESON_TAC[]);; + +let COMPACT_TRANSLATION = prove + (`!s a:real^N. compact s ==> compact (IMAGE (\x. a + x) s)`, + SIMP_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_ADD; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; + +let COMPACT_TRANSLATION_EQ = prove + (`!a s. compact (IMAGE (\x:real^N. a + x) s) <=> compact s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[COMPACT_TRANSLATION] THEN + DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP COMPACT_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [COMPACT_TRANSLATION_EQ];; + +let COMPACT_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. compact s /\ linear f ==> compact(IMAGE f s)`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; COMPACT_CONTINUOUS_IMAGE]);; + +let COMPACT_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (compact (IMAGE f s) <=> compact s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE COMPACT_LINEAR_IMAGE));; + +add_linear_invariants [COMPACT_LINEAR_IMAGE_EQ];; + +let CONNECTED_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f continuous_on s /\ connected s ==> connected(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[CONNECTED_CLOPEN; NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `t:real^N->bool` th) THEN + MP_TAC(SPEC `IMAGE (f:real^M->real^N) s DIFF t` th)) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{x | x IN s /\ (f:real^M->real^N) x IN IMAGE f s DIFF t} = + s DIFF {x | x IN s /\ f x IN t}` + SUBST1_TAC THENL + [UNDISCH_TAC `t SUBSET IMAGE (f:real^M->real^N) s` THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF; IN_ELIM_THM; SUBSET] THEN + MESON_TAC[]; + REPEAT STRIP_TAC THEN + EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x IN t}` THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REWRITE_TAC[IN_IMAGE; SUBSET; IN_ELIM_THM; NOT_IN_EMPTY; EXTENSION] THEN + MESON_TAC[]]);; + +let CONNECTED_TRANSLATION = prove + (`!a s. connected s ==> connected (IMAGE (\x:real^N. a + x) s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_ID; CONTINUOUS_ON_CONST]);; + +let CONNECTED_TRANSLATION_EQ = prove + (`!a s. connected (IMAGE (\x:real^N. a + x) s) <=> connected s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_TRANSLATION] THEN + DISCH_THEN(MP_TAC o ISPEC `--a:real^N` o MATCH_MP CONNECTED_TRANSLATION) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; IMAGE_ID; + VECTOR_ARITH `--a + a + x:real^N = x`]);; + +add_translation_invariants [CONNECTED_TRANSLATION_EQ];; + +let CONNECTED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. connected s /\ linear f ==> connected(IMAGE f s)`, + SIMP_TAC[LINEAR_CONTINUOUS_ON; CONNECTED_CONTINUOUS_IMAGE]);; + +let CONNECTED_LINEAR_IMAGE_EQ = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) + ==> (connected (IMAGE f s) <=> connected s)`, + MATCH_ACCEPT_TAC(LINEAR_INVARIANT_RULE CONNECTED_LINEAR_IMAGE));; + +add_linear_invariants [CONNECTED_LINEAR_IMAGE_EQ];; + +(* ------------------------------------------------------------------------- *) +(* Preservation properties for pasted sets (Cartesian products). *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + bounded (s PCROSS t) <=> + s = {} \/ t = {} \/ bounded s /\ bounded t`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; BOUNDED_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[bounded; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LE_TRANS; NORM_PASTECART_LE; + REAL_LE_ADD2]);; + +let BOUNDED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + bounded s /\ bounded t ==> bounded (s PCROSS t)`, + SIMP_TAC[BOUNDED_PCROSS_EQ]);; + +let CLOSED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + closed (s PCROSS t) <=> + s = {} \/ t = {} \/ closed s /\ closed t`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN MAP_EVERY ASM_CASES_TAC + [`s:real^M->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; CLOSED_EMPTY; SET_RULE + `{f x y |x,y| F} = {}`] THEN + REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; LIM_SEQUENTIALLY] THEN + REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + REWRITE_TAC[IN_ELIM_THM; SKOLEM_THM; FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM] THEN + SIMP_TAC[TAUT `((p /\ q) /\ r) /\ s ==> t <=> r ==> p /\ q /\ s ==> t`] THEN + ONCE_REWRITE_TAC[MESON[] + `(!a b c d e. P a b c d e) <=> (!d e b c a. P a b c d e)`] THEN + REWRITE_TAC[FORALL_UNWIND_THM2] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN EQ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) + [TAUT `p ==> q /\ r <=> (p ==> q) /\ (p ==> r)`; FORALL_AND_THM] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [ALL_TAC; GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM]] THEN + MATCH_MP_TAC MONO_FORALL THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC(MESON[] + `(?x. P x (\n. x)) ==> (?s x. P x s)`) THEN + ASM_MESON_TAC[DIST_PASTECART_CANCEL]; + ONCE_REWRITE_TAC[MESON[] + `(!x l. P x l) /\ (!y m. Q y m) <=> (!x y l m. P x l /\ Q y m)`] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + REWRITE_TAC[dist; PASTECART_SUB] THEN + ASM_MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]]);; + +let CLOSED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + closed s /\ closed t ==> closed (s PCROSS t)`, + SIMP_TAC[CLOSED_PCROSS_EQ]);; + +let COMPACT_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + compact (s PCROSS t) <=> + s = {} \/ t = {} \/ compact s /\ compact t`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_PCROSS_EQ; + BOUNDED_PCROSS_EQ] THEN + MESON_TAC[]);; + +let COMPACT_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + compact s /\ compact t ==> compact (s PCROSS t)`, + SIMP_TAC[COMPACT_PCROSS_EQ]);; + +let OPEN_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + open (s PCROSS t) <=> + s = {} \/ t = {} \/ open s /\ open t`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y |x,y| F} = {}`; OPEN_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + EQ_TAC THENL + [REWRITE_TAC[open_def; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + ASM_MESON_TAC[DIST_PASTECART_CANCEL]; + REWRITE_TAC[OPEN_CLOSED] THEN STRIP_TAC THEN + SUBGOAL_THEN + `UNIV DIFF {pastecart x y | x IN s /\ y IN t} = + {pastecart x y | x IN ((:real^M) DIFF s) /\ y IN (:real^N)} UNION + {pastecart x y | x IN (:real^M) /\ y IN ((:real^N) DIFF t)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; FORALL_PASTECART; IN_UNIV] THEN + REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; FSTCART_PASTECART; + SNDCART_PASTECART] THEN MESON_TAC[]; + SIMP_TAC[GSYM PCROSS] THEN MATCH_MP_TAC CLOSED_UNION THEN CONJ_TAC THEN + MATCH_MP_TAC CLOSED_PCROSS THEN ASM_REWRITE_TAC[CLOSED_UNIV]]]);; + +let OPEN_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + open s /\ open t ==> open (s PCROSS t)`, + SIMP_TAC[OPEN_PCROSS_EQ]);; + +let OPEN_IN_PCROSS = prove + (`!s s':real^M->bool t t':real^N->bool. + open_in (subtopology euclidean s) s' /\ + open_in (subtopology euclidean t) t' + ==> open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN + ASM_SIMP_TAC[OPEN_PCROSS; EXTENSION; FORALL_PASTECART] THEN + REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; + +let PASTECART_IN_INTERIOR_SUBTOPOLOGY = prove + (`!s t u x:real^M y:real^N. + pastecart x y IN u /\ open_in (subtopology euclidean (s PCROSS t)) u + ==> ?v w. open_in (subtopology euclidean s) v /\ x IN v /\ + open_in (subtopology euclidean t) w /\ y IN w /\ + (v PCROSS w) SUBSET u`, + REWRITE_TAC[open_in; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real^M`; `y:real^N`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(x:real^M,e / &2) INTER s` THEN + EXISTS_TAC `ball(y:real^N,e / &2) INTER t` THEN + SUBGOAL_THEN `(x:real^M) IN s /\ (y:real^N) IN t` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET; PASTECART_IN_PCROSS]; ALL_TAC] THEN + ASM_SIMP_TAC[INTER_SUBSET; IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN + REWRITE_TAC[IN_BALL] THEN REPEAT(CONJ_TAC THENL + [MESON_TAC[REAL_SUB_LT; NORM_ARITH + `dist(x,y) < e /\ dist(z,y) < e - dist(x,y) + ==> dist(x:real^N,z) < e`]; + ALL_TAC]) THEN + REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[IN_BALL; IN_INTER] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[dist; PASTECART_SUB] THEN + W(MP_TAC o PART_MATCH lhand NORM_PASTECART_LE o lhand o snd) THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[DIST_SYM] dist)] THEN + ASM_REAL_ARITH_TAC);; + +let OPEN_IN_PCROSS_EQ = prove + (`!s s':real^M->bool t t':real^N->bool. + open_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> + s' = {} \/ t' = {} \/ + open_in (subtopology euclidean s) s' /\ + open_in (subtopology euclidean t) t'`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s':real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN + ASM_CASES_TAC `t':real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; OPEN_IN_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[OPEN_IN_PCROSS] THEN REPEAT STRIP_TAC THENL + [ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + UNDISCH_TAC `~(t':real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`); + ONCE_REWRITE_TAC[OPEN_IN_SUBOPEN] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + UNDISCH_TAC `~(s':real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real^M`)] THEN + MP_TAC(ISPECL + [`s:real^M->bool`; `t:real^N->bool`; + `(s':real^M->bool) PCROSS (t':real^N->bool)`; + `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MESON_TAC[]);; + +let INTERIOR_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + interior (s PCROSS t) = (interior s) PCROSS (interior t)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`(:real^M)`; `(:real^N)`; + `interior((s:real^M->bool) PCROSS (t:real^N->bool))`; + `x:real^M`; `y:real^N`] PASTECART_IN_INTERIOR_SUBTOPOLOGY) THEN + REWRITE_TAC[UNIV_PCROSS_UNIV; SUBTOPOLOGY_UNIV; GSYM OPEN_IN] THEN + ASM_REWRITE_TAC[OPEN_INTERIOR] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[INTERIOR_SUBSET; SUBSET_TRANS] + `s SUBSET interior t ==> s SUBSET t`)) THEN + REWRITE_TAC[SUBSET_PCROSS] THEN + ASM_MESON_TAC[NOT_IN_EMPTY; INTERIOR_MAXIMAL; SUBSET]; + MATCH_MP_TAC INTERIOR_MAXIMAL THEN + SIMP_TAC[OPEN_PCROSS; OPEN_INTERIOR; PCROSS_MONO; INTERIOR_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Quotient maps are occasionally useful. *) +(* ------------------------------------------------------------------------- *) + +let QUASICOMPACT_OPEN_CLOSED = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. u SUBSET t + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} + ==> open_in (subtopology euclidean t) u)) <=> + (!u. u SUBSET t + ==> (closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} + ==> closed_in (subtopology euclidean t) u)))`, + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^N->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN + (ANTS_TAC THENL [SET_TAC[]; REPEAT STRIP_TAC]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_RESTRICT] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `open_in top x ==> x = y ==> open_in top y`)) THEN + ASM SET_TAC[]);; + +let QUOTIENT_MAP_IMP_CONTINUOUS_OPEN = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) + ==> f continuous_on s`, + MESON_TAC[OPEN_IN_IMP_SUBSET; CONTINUOUS_ON_OPEN_GEN]);; + +let QUOTIENT_MAP_IMP_CONTINUOUS_CLOSED = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (closed_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + closed_in (subtopology euclidean t) u)) + ==> f continuous_on s`, + MESON_TAC[CLOSED_IN_IMP_SUBSET; CONTINUOUS_ON_CLOSED_GEN]);; + +let OPEN_MAP_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!t. open_in (subtopology euclidean s) t + ==> open_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) + ==> !t. t SUBSET IMAGE f s + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> + open_in (subtopology euclidean (IMAGE f s)) t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN + `t = IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN t}` + SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + ASM_SIMP_TAC[]]);; + +let CLOSED_MAP_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N s. + f continuous_on s /\ + (!t. closed_in (subtopology euclidean s) t + ==> closed_in (subtopology euclidean (IMAGE f s)) (IMAGE f t)) + ==> !t. t SUBSET IMAGE f s + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN t} <=> + open_in (subtopology euclidean (IMAGE f s)) t)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC + `s DIFF {x | x IN s /\ (f:real^M->real^N) x IN t}`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CLOSED_IN_DIFF THEN + ASM_SIMP_TAC[CLOSED_IN_SUBTOPOLOGY_REFL; + TOPSPACE_EUCLIDEAN; SUBSET_UNIV]; + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN ASM SET_TAC[]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONTINUOUS_ON_OPEN]) THEN + ASM_SIMP_TAC[]]);; + +let CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + (!y. y IN t ==> f(g y) = y) + ==> (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u))`, + REWRITE_TAC[CONTINUOUS_ON_OPEN] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `(IMAGE (g:real^N->real^M) t) + INTER + {x | x IN s /\ (f:real^M->real^N) x IN u}`) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]; + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) s = t` + (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM SET_TAC[]]);; + +let CONTINUOUS_LEFT_INVERSE_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ g continuous_on (IMAGE f s) /\ + (!x. x IN s ==> g(f x) = x) + ==> (!u. u SUBSET (IMAGE f s) + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean (IMAGE f s)) u))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `g:real^N->real^M` THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let QUOTIENT_MAP_OPEN_CLOSED = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. u SUBSET t + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) <=> + (!u. u SUBSET t + ==> (closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} <=> + closed_in (subtopology euclidean t) u)))`, + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `u:real^N->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + ASM_SIMP_TAC[SET_RULE `u SUBSET t ==> t DIFF (t DIFF u) = u`] THEN + (ANTS_TAC THENL [SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN + REWRITE_TAC[SUBSET_RESTRICT] THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let CONTINUOUS_ON_COMPOSE_QUOTIENT = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ + (!v. v SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean t) v)) /\ + (g o f) continuous_on s + ==> g continuous_on t`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 3 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) THEN + SUBGOAL_THEN + `IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) s SUBSET u` + (fun th -> REWRITE_TAC[MATCH_MP CONTINUOUS_ON_OPEN_GEN th]) + THENL [REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; DISCH_TAC] THEN + X_GEN_TAC `v:real^P->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN + ASM_REWRITE_TAC[o_THM] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN v}`) THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `open_in top s ==> s = t ==> open_in top t`)) THEN + ASM SET_TAC[]);; + +let LIFT_TO_QUOTIENT_SPACE = prove + (`!f:real^M->real^N h:real^M->real^P s t u. + IMAGE f s = t /\ + (!v. v SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean t) v)) /\ + h continuous_on s /\ IMAGE h s = u /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> h x = h y) + ==> ?g. g continuous_on t /\ IMAGE g t = u /\ + !x. x IN s ==> h(x) = g(f x)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[FUNCTION_FACTORS_LEFT_GEN] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^P` THEN + DISCH_TAC THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE_QUOTIENT THEN MAP_EVERY EXISTS_TAC + [`f:real^M->real^N`; `s:real^M->bool`; `u:real^P->bool`] THEN + ASM_SIMP_TAC[SUBSET_REFL] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + CONTINUOUS_ON_EQ)) THEN + ASM_REWRITE_TAC[o_THM]);; + +let QUOTIENT_MAP_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ + (!v. v SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean t) v)) /\ + (!v. v SUBSET u + ==> (open_in (subtopology euclidean t) {x | x IN t /\ g x IN v} <=> + open_in (subtopology euclidean u) v)) + ==> !v. v SUBSET u + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ (g o f) x IN v} <=> + open_in (subtopology euclidean u) v)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + SUBGOAL_THEN + `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = + {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` + SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_RESTRICT]]);; + +let QUOTIENT_MAP_FROM_COMPOSITION = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!v. v SUBSET u + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ (g o f) x IN v} <=> + open_in (subtopology euclidean u) v)) + ==> !v. v SUBSET u + ==> (open_in (subtopology euclidean t) + {x | x IN t /\ g x IN v} <=> + open_in (subtopology euclidean u) v)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `v:real^P->bool`) THEN + ASM_REWRITE_TAC[o_THM] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `{x | x IN s /\ (g:real^N->real^P) ((f:real^M->real^N) x) IN v} = + {x | x IN s /\ f x IN {x | x IN t /\ g x IN v}}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_REWRITE_TAC[]]);; + +let QUOTIENT_MAP_FROM_SUBSET = prove + (`!f:real^M->real^N s t u. + f continuous_on t /\ IMAGE f t SUBSET u /\ + s SUBSET t /\ IMAGE f s = u /\ + (!v. v SUBSET u + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN v} <=> + open_in (subtopology euclidean u) v)) + ==> !v. v SUBSET u + ==> (open_in (subtopology euclidean t) + {x | x IN t /\ f x IN v} <=> + open_in (subtopology euclidean u) v)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC QUOTIENT_MAP_FROM_COMPOSITION THEN + MAP_EVERY EXISTS_TAC [`\x:real^M. x`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_ID; IMAGE_ID; o_THM]);; + +let QUOTIENT_MAP_RESTRICT = prove + (`!f:real^M->real^N s t c. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) /\ + (open_in (subtopology euclidean t) c \/ + closed_in (subtopology euclidean t) c) + ==> !u. u SUBSET c + ==> (open_in (subtopology euclidean {x | x IN s /\ f x IN c}) + {x | x IN {x | x IN s /\ f x IN c} /\ f x IN u} <=> + open_in (subtopology euclidean c) u)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC (MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] QUOTIENT_MAP_IMP_CONTINUOUS_OPEN) th)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) {x | x IN s /\ f x IN c} SUBSET c` + ASSUME_TAC THENL [SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET); + ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET)] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `u:real^N->bool` THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + (ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + (MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_MP_TAC(MESON[] `t = s /\ (P s <=> Q s) ==> (P s <=> Q t)`) THEN + CONJ_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[IN_ELIM_THM]]; + ALL_TAC]) THEN + (EQ_TAC THENL + [MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_SUBSET_TRANS) ORELSE + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_SUBSET_TRANS); + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] OPEN_IN_TRANS) ORELSE + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CLOSED_IN_TRANS)]) THEN + (MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN ORELSE + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN ORELSE ASM_SIMP_TAC[]) THEN + ASM SET_TAC[]);; + +let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ + connected t + ==> connected s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[connected; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN STRIP_TAC THEN + UNDISCH_TAC `connected(t:real^N->bool)` THEN SIMP_TAC[CONNECTED_OPEN_IN] THEN + MAP_EVERY EXISTS_TAC + [`IMAGE (f:real^M->real^N) (s INTER u)`; + `IMAGE (f:real^M->real^N) (s INTER v)`] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) (s INTER u) INTER IMAGE f (s INTER v) = {}` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[connected]] THEN + MAP_EVERY EXISTS_TAC [`u:real^M->bool`; `v:real^M->bool`] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [CONJ_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (rand o rand) th o snd)) THEN + (ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)]) THEN + MATCH_MP_TAC(MESON[] + `{x | x IN s /\ f x IN IMAGE f u} = u /\ open_in top u + ==> open_in top {x | x IN s /\ f x IN IMAGE f u}`) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER] THEN ASM SET_TAC[]);; + +let CONNECTED_MONOTONE_QUOTIENT_PREIMAGE_GEN = prove + (`!f:real^M->real^N s t c. + IMAGE f s = t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) /\ + (open_in (subtopology euclidean t) c \/ + closed_in (subtopology euclidean t) c) /\ + connected c + ==> connected {x | x IN s /\ f x IN c}`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ] + (REWRITE_RULE[CONJ_ASSOC] CONNECTED_MONOTONE_QUOTIENT_PREIMAGE)) THEN + SUBGOAL_THEN `(c:real^N->bool) SUBSET t` ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_IN_IMP_SUBSET; CLOSED_IN_IMP_SUBSET]; ALL_TAC] THEN + EXISTS_TAC `f:real^M->real^N` THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + QUOTIENT_MAP_IMP_CONTINUOUS_OPEN)) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] CONTINUOUS_ON_SUBSET) THEN + REWRITE_TAC[SUBSET_RESTRICT]; + ASM SET_TAC[]; + MATCH_MP_TAC QUOTIENT_MAP_RESTRICT THEN + ASM_MESON_TAC[SUBSET_REFL]; + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN + AP_TERM_TAC THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* More properties of open and closed maps. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_MAP_RESTRICT = prove + (`!f:real^M->real^N s t t'. + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ + t' SUBSET t + ==> !u. open_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u + ==> open_in (subtopology euclidean t') (IMAGE f u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +let CLOSED_MAP_RESTRICT = prove + (`!f:real^M->real^N s t t'. + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ + t' SUBSET t + ==> !u. closed_in (subtopology euclidean {x | x IN s /\ f x IN t'}) u + ==> closed_in (subtopology euclidean t') (IMAGE f u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `c:real^M->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^M->bool`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]);; + +let QUOTIENT_MAP_OPEN_MAP_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) + ==> ((!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f k}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let QUOTIENT_MAP_CLOSED_MAP_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t /\ + (!u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)) + ==> ((!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f k}))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[QUOTIENT_MAP_OPEN_CLOSED] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + X_GEN_TAC `k:real^M->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (f:real^M->real^N) k`) THEN + ASM_SIMP_TAC[IMAGE_SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let CLOSED_MAP_IMP_OPEN_MAP = prove + (`!f:real^M->real^N s t. + IMAGE f s = t /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f u}) + ==> (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) u = + t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + ASM_SIMP_TAC[CLOSED_IN_REFL]]);; + +let OPEN_MAP_IMP_CLOSED_MAP = prove + (`!f:real^M->real^N s t. + IMAGE f s = t /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f x IN IMAGE f u}) + ==> (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `IMAGE (f:real^M->real^N) u = + t DIFF IMAGE f (s DIFF {x | x IN s /\ f x IN IMAGE f u})` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + ASM_SIMP_TAC[OPEN_IN_REFL]]);; + +let OPEN_MAP_FROM_COMPOSITION_SURJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. open_in (subtopology euclidean t) k + ==> open_in (subtopology euclidean u) (IMAGE g k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) + {x | x IN s /\ f(x) IN k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; + +let CLOSED_MAP_FROM_COMPOSITION_SURJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ IMAGE g t SUBSET u /\ + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. closed_in (subtopology euclidean t) k + ==> closed_in (subtopology euclidean u) (IMAGE g k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE g k = IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) + {x | x IN s /\ f(x) IN k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[SUBSET_REFL]]);; + +let OPEN_MAP_FROM_COMPOSITION_INJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ + g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE f k = {x | x IN t /\ + g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE_GEN THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; + +let CLOSED_MAP_FROM_COMPOSITION_INJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ IMAGE g t SUBSET u /\ + g continuous_on t /\ (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean u) (IMAGE (g o f) k)) + ==> (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `IMAGE f k = {x | x IN t /\ + g(x) IN IMAGE ((g:real^N->real^P) o (f:real^M->real^N)) k}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[IMAGE_o] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `u:real^P->bool` THEN ASM_SIMP_TAC[]]);; + +let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE = prove + (`!f:real^M->real^N s t u w. + (!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k)) /\ + closed_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. closed_in (subtopology euclidean t) v /\ + w SUBSET v /\ + {x | x IN s /\ f(x) IN v} SUBSET u`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CLOSED_IN_DIFF THEN REWRITE_TAC[CLOSED_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]);; + +let OPEN_MAP_CLOSED_SUPERSET_PREIMAGE_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. open_in (subtopology euclidean s) k + ==> open_in (subtopology euclidean t) (IMAGE f k)) <=> + (!u w. closed_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. closed_in (subtopology euclidean t) v /\ + w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[OPEN_MAP_CLOSED_SUPERSET_PREIMAGE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL]]);; + +let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE = prove + (`!f:real^M->real^N s t u w. + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ + open_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. open_in (subtopology euclidean t) v /\ + w SUBSET v /\ + {x | x IN s /\ f(x) IN v} SUBSET u`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `t DIFF IMAGE (f:real^M->real^N) (s DIFF u)` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN REWRITE_TAC[OPEN_IN_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]);; + +let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> + (!u w. open_in (subtopology euclidean s) u /\ + w SUBSET t /\ {x | x IN s /\ f(x) IN w} SUBSET u + ==> ?v. open_in (subtopology euclidean t) v /\ + w SUBSET v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`s DIFF k:real^M->bool`; `t DIFF IMAGE (f:real^M->real^N) k`]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) k = t DIFF v` SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL]]);; + +let CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_POINT = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) <=> + (!u y. open_in (subtopology euclidean s) u /\ + y IN t /\ {x | x IN s /\ f(x) = y} SUBSET u + ==> ?v. open_in (subtopology euclidean t) v /\ + y IN v /\ {x | x IN s /\ f(x) IN v} SUBSET u))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CLOSED_MAP_OPEN_SUPERSET_PREIMAGE_EQ] THEN + EQ_TAC THEN DISCH_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `y:real^N`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real^M->bool`; `{y:real^N}`]) THEN + ASM_REWRITE_TAC[SING_SUBSET; IN_SING]; + MAP_EVERY X_GEN_TAC [`u:real^M->bool`; `w:real^N->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN + EXISTS_TAC `UNIONS {(vv:real^N->real^N->bool) y | y IN w}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM SET_TAC[]; + REWRITE_TAC[UNIONS_GSPEC] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; RIGHT_AND_EXISTS_THM; + LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM SET_TAC[]]]);; + +let CONNECTED_OPEN_MONOTONE_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!c. open_in (subtopology euclidean s) c + ==> open_in (subtopology euclidean t) (IMAGE f c)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) + ==> !c. connected c /\ c SUBSET t + ==> connected {x | x IN s /\ f x IN c}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] OPEN_MAP_RESTRICT)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] + OPEN_MAP_IMP_QUOTIENT_MAP) THEN + SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` + ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + SIMP_TAC[SET_RULE + `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = + {x | x IN s /\ f x = y}`] THEN + ASM SET_TAC[]]);; + +let CONNECTED_CLOSED_MONOTONE_PREIMAGE = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!c. closed_in (subtopology euclidean s) c + ==> closed_in (subtopology euclidean t) (IMAGE f c)) /\ + (!y. y IN t ==> connected {x | x IN s /\ f x = y}) + ==> !c. connected c /\ c SUBSET t + ==> connected {x | x IN s /\ f x IN c}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `c:real^N->bool` o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] CLOSED_MAP_RESTRICT)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL + [`f:real^M->real^N`; `{x | x IN s /\ (f:real^M->real^N) x IN c}`] + CLOSED_MAP_IMP_QUOTIENT_MAP) THEN + SUBGOAL_THEN `IMAGE f {x | x IN s /\ (f:real^M->real^N) x IN c} = c` + ASSUME_TAC THENL [ASM SET_TAC[]; ASM_REWRITE_TAC[]] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + DISCH_TAC] THEN + MATCH_MP_TAC CONNECTED_MONOTONE_QUOTIENT_PREIMAGE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `c:real^N->bool`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + SIMP_TAC[SET_RULE + `y IN c ==> {x | x IN {x | x IN s /\ f x IN c} /\ f x = y} = + {x | x IN s /\ f x = y}`] THEN + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Proper maps, including projections out of compact sets. *) +(* ------------------------------------------------------------------------- *) + +let PROPER_MAP = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) <=> + (!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) (IMAGE f k)) /\ + (!a. a IN t ==> compact {x | x IN s /\ f x = a}))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THENL + [ALL_TAC; + ONCE_REWRITE_TAC[SET_RULE `x = a <=> x IN {a}`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[SING_SUBSET; COMPACT_SING]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[CLOSED_IN_LIMPT] THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `y:real^N`] THEN + REWRITE_TAC[LIMPT_SEQUENTIAL_INJ; IN_DELETE] THEN + REWRITE_TAC[IN_IMAGE; LEFT_AND_EXISTS_THM; SKOLEM_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[UNWIND_THM2; FUN_EQ_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `~(INTERS {{a | a IN k /\ + (f:real^M->real^N) a IN + (y INSERT IMAGE (\i. f(x(n + i))) (:num))} | + n IN (:num)} = {})` + MP_TAC THENL + [MATCH_MP_TAC COMPACT_FIP THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^M->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[SET_RULE + `{x | x IN s INTER k /\ P x} = k INTER {x | x IN s /\ P x}`] THEN + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_SEQUENCE_WITH_LIMIT THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num` o MATCH_MP SEQ_OFFSET) THEN + REWRITE_TAC[ADD_SYM]; + REWRITE_TAC[SIMPLE_IMAGE; FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `i:num->bool` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `\n:num. n` o MATCH_MP + UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; INTERS_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `(x:num->real^M) m` THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN DISJ2_TAC THEN + EXISTS_TAC `m - p:num` THEN + ASM_MESON_TAC[ARITH_RULE `p <= m ==> p + m - p:num = m`]]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `x:real^M` THEN + REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(fun th -> LABEL_TAC "*" th THEN MP_TAC(SPEC `0` th)) THEN + REWRITE_TAC[ADD_CLAUSES; IN_INSERT; IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN MP_TAC)) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN + REMOVE_THEN "*" (MP_TAC o SPEC `i + 1`) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[IN_INSERT; IN_IMAGE; IN_UNIV] THEN ARITH_TAC]; + STRIP_TAC THEN X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[COMPACT_EQ_HEINE_BOREL] THEN + X_GEN_TAC `c:(real^M->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!a. a IN k + ==> ?g. g SUBSET c /\ FINITE g /\ + {x | x IN s /\ (f:real^M->real^N) x = a} SUBSET UNIONS g` + MP_TAC THENL + [X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN UNDISCH_THEN + `!a. a IN t ==> compact {x | x IN s /\ (f:real^M->real^N) x = a}` + (MP_TAC o SPEC `a:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[COMPACT_EQ_HEINE_BOREL]] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uu:real^N->(real^M->bool)->bool` THEN + DISCH_THEN(LABEL_TAC "*")] THEN + SUBGOAL_THEN + `!a. a IN k + ==> ?v. open v /\ a IN v /\ + {x | x IN s /\ (f:real^M->real^N) x IN v} SUBSET UNIONS(uu a)` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + UNDISCH_THEN + `!k. closed_in (subtopology euclidean s) k + ==> closed_in (subtopology euclidean t) + (IMAGE (f:real^M->real^N) k)` + (MP_TAC o SPEC `(s:real^M->bool) DIFF UNIONS(uu(a:real^N))`) THEN + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ANTS_TAC THENL + [CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN + MATCH_MP_TAC OPEN_IN_OPEN_INTER THEN + MATCH_MP_TAC OPEN_UNIONS THEN ASM SET_TAC[]; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `v:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N`)) THEN + ASM_REWRITE_TAC[] THEN REPEAT + ((ANTS_TAC THENL [ASM SET_TAC[]; DISCH_TAC]) ORELSE STRIP_TAC) + THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM SET_TAC[]]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `vv:real^N->(real^N->bool)` THEN + DISCH_THEN(LABEL_TAC "+")] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (vv:real^N->(real^N->bool)) k`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r ==> s <=> q /\ p ==> r ==> s`] THEN + REWRITE_TAC[FORALL_FINITE_SUBSET_IMAGE] THEN + X_GEN_TAC `j:real^N->bool` THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `UNIONS(IMAGE (uu:real^N->(real^M->bool)->bool) j)` THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + ASM_SIMP_TAC[FINITE_UNIONS; FORALL_IN_IMAGE; FINITE_IMAGE] THEN + ASM SET_TAC[]; + REWRITE_TAC[UNIONS_IMAGE; SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + ASM SET_TAC[]]]);; + +let COMPACT_CONTINUOUS_IMAGE_EQ = prove + (`!f:real^M->real^N s. + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> (f continuous_on s <=> + !t. compact t /\ t SUBSET s ==> compact(IMAGE f t))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[COMPACT_CONTINUOUS_IMAGE; CONTINUOUS_ON_SUBSET]; DISCH_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `g:real^N->real^M` o + GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN + X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) s`; + `s:real^M->bool`] PROPER_MAP) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(q ==> s) /\ p ==> (p <=> q /\ r) ==> s`) THEN + REPEAT STRIP_TAC THENL + [SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN u} = IMAGE g u` + (fun th -> ASM_MESON_TAC[th]); + SUBGOAL_THEN + `{x | x IN IMAGE f s /\ (g:real^N->real^M) x IN k} = IMAGE f k` + (fun th -> ASM_SIMP_TAC[th])] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN ASM SET_TAC[]);; + +let PROPER_MAP_FROM_COMPACT = prove + (`!f:real^M->real^N s k. + f continuous_on s /\ IMAGE f s SUBSET t /\ compact s /\ + closed_in (subtopology euclidean t) k + ==> compact {x | x IN s /\ f x IN k}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CLOSED_IN_COMPACT THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_MESON_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_GEN]);; + +let PROPER_MAP_COMPOSE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + IMAGE f s SUBSET t /\ + (!k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}) /\ + (!k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}) + ==> !k. k SUBSET u /\ compact k + ==> compact {x | x IN s /\ (g o f) x IN k}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[o_THM] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{x | x IN t /\ (g:real^N->real^P) x IN k}`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC EQ_IMP] THEN + AP_TERM_TAC THEN ASM SET_TAC[]);; + +let PROPER_MAP_FROM_COMPOSITION_LEFT = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!k. k SUBSET u /\ compact k + ==> compact {x | x IN s /\ (g o f) x IN k}) + ==> !k. k SUBSET u /\ compact k ==> compact {x | x IN t /\ g x IN k}`, + REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real^P->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o ISPEC `f:real^M->real^N` o MATCH_MP + (REWRITE_RULE[IMP_CONJ_ALT] COMPACT_CONTINUOUS_IMAGE)) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN SET_TAC[]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let PROPER_MAP_FROM_COMPOSITION_RIGHT = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!k. k SUBSET u /\ compact k + ==> compact {x | x IN s /\ (g o f) x IN k}) + ==> !k. k SUBSET t /\ compact k ==> compact {x | x IN s /\ f x IN k}`, + let lemma = prove + (`!s t. closed_in (subtopology euclidean s) t ==> compact s ==> compact t`, + MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET; + CLOSED_IN_CLOSED_EQ]) in + REWRITE_TAC[o_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `IMAGE (g:real^N->real^P) k`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE] THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]; + MATCH_MP_TAC lemma THEN + MATCH_MP_TAC CLOSED_IN_SUBSET_TRANS THEN + EXISTS_TAC `s:real^M->bool` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE_GEN THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_SUBSET THEN ASM_SIMP_TAC[COMPACT_IMP_CLOSED]]);; + +let PROPER_MAP_FSTCART = prove + (`!s:real^M->bool t:real^N->bool k. + compact t /\ k SUBSET s /\ compact k + ==> compact {z | z IN s PCROSS t /\ fstcart z IN k}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{z | z IN s PCROSS t /\ fstcart z IN k} = + (k:real^M->bool) PCROSS (t:real^N->bool)` + (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; + PASTECART_IN_PCROSS; FSTCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CLOSED_MAP_FSTCART = prove + (`!s:real^M->bool t:real^N->bool c. + compact t /\ closed_in (subtopology euclidean (s PCROSS t)) c + ==> closed_in (subtopology euclidean s) (IMAGE fstcart c)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`fstcart:real^(M,N)finite_sum->real^M`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`; + `s:real^M->bool`] + PROPER_MAP) THEN + ASM_SIMP_TAC[PROPER_MAP_FSTCART; IMAGE_FSTCART_PCROSS] THEN + ASM SET_TAC[]);; + +let PROPER_MAP_SNDCART = prove + (`!s:real^M->bool t:real^N->bool k. + compact s /\ k SUBSET t /\ compact k + ==> compact {z | z IN s PCROSS t /\ sndcart z IN k}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{z | z IN s PCROSS t /\ sndcart z IN k} = + (s:real^M->bool) PCROSS (k:real^N->bool)` + (fun th -> ASM_SIMP_TAC[th; COMPACT_PCROSS]) THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; + PASTECART_IN_PCROSS; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CLOSED_MAP_SNDCART = prove + (`!s:real^M->bool t:real^N->bool c. + compact s /\ closed_in (subtopology euclidean (s PCROSS t)) c + ==> closed_in (subtopology euclidean t) (IMAGE sndcart c)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sndcart:real^(M,N)finite_sum->real^N`; + `(s:real^M->bool) PCROSS (t:real^N->bool)`; + `t:real^N->bool`] + PROPER_MAP) THEN + ASM_SIMP_TAC[PROPER_MAP_SNDCART; IMAGE_SNDCART_PCROSS] THEN + ASM SET_TAC[]);; + +let CLOSED_IN_COMPACT_PROJECTION = prove + (`!s:real^M->bool t:real^N->bool u. + compact s /\ closed_in (subtopology euclidean (s PCROSS t)) u + ==> closed_in (subtopology euclidean t) + {y | ?x. x IN s /\ pastecart x y IN u}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_MAP_SNDCART) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET o CONJUNCT2) THEN + REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; FORALL_PASTECART; EXISTS_PASTECART; + PASTECART_IN_PCROSS; IN_ELIM_THM; SNDCART_PASTECART] THEN + SET_TAC[]);; + +let CLOSED_COMPACT_PROJECTION = prove + (`!s:real^M->bool t:real^(M,N)finite_sum->bool. + compact s /\ closed t ==> closed {y | ?x. x IN s /\ pastecart x y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{y | ?x:real^M. x IN s /\ pastecart x y IN t} = + {y | ?x. x IN s /\ pastecart x y IN ((s PCROSS (:real^N)) INTER t)}` + SUBST1_TAC THENL + [REWRITE_TAC[PASTECART_IN_PCROSS; IN_UNIV; IN_INTER] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `(:real^N)` THEN REWRITE_TAC[CLOSED_UNIV] THEN + MATCH_MP_TAC CLOSED_IN_COMPACT_PROJECTION THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_SUBSET THEN + ASM_SIMP_TAC[CLOSED_INTER; CLOSED_UNIV; CLOSED_PCROSS; COMPACT_IMP_CLOSED; + INTER_SUBSET]]);; + +let TUBE_LEMMA = prove + (`!s:real^M->bool t:real^N->bool u a. + compact s /\ ~(s = {}) /\ {pastecart x a | x IN s} SUBSET u /\ + open_in(subtopology euclidean (s PCROSS t)) u + ==> ?v. open_in (subtopology euclidean t) v /\ a IN v /\ + (s PCROSS v) SUBSET u`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT; PCROSS] + CLOSED_IN_COMPACT_PROJECTION)) THEN + ASM_REWRITE_TAC[IN_ELIM_PASTECART_THM; IN_DIFF] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN MATCH_MP_TAC(MESON[] + `(closed_in top t ==> s DIFF (s DIFF t) = t) /\ + s DIFF t SUBSET s /\ P(s DIFF t) + ==> closed_in top t + ==> ?v. v SUBSET s /\ closed_in top (s DIFF v) /\ P v`) THEN + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = t <=> t SUBSET s`] THEN + REWRITE_TAC[SUBSET_DIFF] THEN + SIMP_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET])) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_SING; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM] THEN ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; + +let TUBE_LEMMA_GEN = prove + (`!s t t' u:real^(M,N)finite_sum->bool. + compact s /\ ~(s = {}) /\ t SUBSET t' /\ + s PCROSS t SUBSET u /\ + open_in (subtopology euclidean (s PCROSS t')) u + ==> ?v. open_in (subtopology euclidean t') v /\ + t SUBSET v /\ + s PCROSS v SUBSET u`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a. a IN t ==> ?v. open_in (subtopology euclidean t') v /\ a IN v /\ + (s:real^M->bool) PCROSS (v:real^N->bool) SUBSET u` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC TUBE_LEMMA THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + ASM_REWRITE_TAC[PASTECART_IN_PCROSS]; + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `vv:real^N->real^N->bool` THEN DISCH_TAC THEN + EXISTS_TAC `UNIONS (IMAGE (vv:real^N->real^N->bool) t)` THEN + ASM_SIMP_TAC[OPEN_IN_UNIONS; FORALL_IN_IMAGE] THEN + REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM; FORALL_IN_PCROSS] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `c:real^N`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_PCROSS] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Pasting functions together on open sets. *) +(* ------------------------------------------------------------------------- *) + +let PASTING_LEMMA = prove + (`!f:A->real^M->real^N g t s k. + (!i. i IN k + ==> open_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) /\ + (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) + ==> g continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN + STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ g x IN u} = + UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | + i IN k}` + SUBST1_TAC THENL + [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` + ASSUME_TAC THENL + [ASM_MESON_TAC[OPEN_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; + MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[OPEN_IN_TRANS]]);; + +let PASTING_LEMMA_EXISTS = prove + (`!f:A->real^M->real^N t s k. + s SUBSET UNIONS {t i | i IN k} /\ + (!i. i IN k + ==> open_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) + ==> ?g. g continuous_on s /\ + (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN MATCH_MP_TAC PASTING_LEMMA THEN + MAP_EVERY EXISTS_TAC + [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN + ASM SET_TAC[]);; + +let CONTINUOUS_ON_UNION_LOCAL_OPEN = prove + (`!f:real^M->real^N s. + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`\i:(real^M->bool). (f:real^M->real^N)`; `f:real^M->real^N`; + `\i:(real^M->bool). i`; `s UNION t:real^M->bool`; `{s:real^M->bool,t}`] + PASTING_LEMMA) THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; EXISTS_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_UNION]);; + +let CONTINUOUS_ON_UNION_OPEN = prove + (`!f s t. open s /\ open t /\ f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN + ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; + +let CONTINUOUS_ON_CASES_LOCAL_OPEN = prove + (`!P f g:real^M->real^N s t. + open_in (subtopology euclidean (s UNION t)) s /\ + open_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_CASES_OPEN = prove + (`!P f g s t. + open s /\ + open t /\ + f continuous_on s /\ + g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on s UNION t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL_OPEN THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC OPEN_OPEN_IN_TRANS THEN + ASM_SIMP_TAC[OPEN_UNION] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Likewise on closed sets, with a finiteness assumption. *) +(* ------------------------------------------------------------------------- *) + +let PASTING_LEMMA_CLOSED = prove + (`!f:A->real^M->real^N g t s k. + FINITE k /\ + (!i. i IN k + ==> closed_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) /\ + (!x. x IN s ==> ?j. j IN k /\ x IN t j /\ g x = f j x) + ==> g continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN + STRIP_TAC THEN X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ g x IN u} = + UNIONS {{x | x IN (t i) /\ ((f:A->real^M->real^N) i x) IN u} | + i IN k}` + SUBST1_TAC THENL + [SUBGOAL_THEN `!i. i IN k ==> ((t:A->real^M->bool) i) SUBSET s` + ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY]; + REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]]; + MATCH_MP_TAC CLOSED_IN_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_TRANS]]);; + +let PASTING_LEMMA_EXISTS_CLOSED = prove + (`!f:A->real^M->real^N t s k. + FINITE k /\ + s SUBSET UNIONS {t i | i IN k} /\ + (!i. i IN k + ==> closed_in (subtopology euclidean s) (t i) /\ + (f i) continuous_on (t i)) /\ + (!i j x. i IN k /\ j IN k /\ x IN s INTER t i INTER t j + ==> f i x = f j x) + ==> ?g. g continuous_on s /\ + (!x i. i IN k /\ x IN s INTER t i ==> g x = f i x)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\x. (f:A->real^M->real^N)(@i. i IN k /\ x IN t i) x` THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + MATCH_MP_TAC PASTING_LEMMA_CLOSED THEN + MAP_EVERY EXISTS_TAC + [`f:A->real^M->real^N`; `t:A->real^M->bool`; `k:A->bool`] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Closure of halflines, halfspaces and hyperplanes. *) +(* ------------------------------------------------------------------------- *) + +let LIM_LIFT_DOT = prove + (`!f:real^M->real^N a. + (f --> l) net ==> ((lift o (\y. a dot f(y))) --> lift(a dot l)) net`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a = vec 0:real^N` THENL + [ASM_REWRITE_TAC[DOT_LZERO; LIFT_NUM; o_DEF; LIM_CONST]; ALL_TAC] THEN + REWRITE_TAC[LIM] THEN MATCH_MP_TAC MONO_OR THEN REWRITE_TAC[] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / norm(a:real^N)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; REAL_LT_RDIV_EQ] THEN + REWRITE_TAC[dist; o_THM; GSYM LIFT_SUB; GSYM DOT_RSUB; NORM_LIFT] THEN + ONCE_REWRITE_TAC[DOT_SYM] THEN + MESON_TAC[NORM_CAUCHY_SCHWARZ_ABS; REAL_MUL_SYM; REAL_LET_TRANS]);; + +let CONTINUOUS_AT_LIFT_DOT = prove + (`!a:real^N x. (lift o (\y. a dot y)) continuous at x`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_AT; o_THM] THEN + MATCH_MP_TAC LIM_LIFT_DOT THEN REWRITE_TAC[LIM_AT] THEN MESON_TAC[]);; + +let CONTINUOUS_ON_LIFT_DOT = prove + (`!s. (lift o (\y. a dot y)) continuous_on s`, + SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_AT_LIFT_DOT]);; + +let CLOSED_INTERVAL_LEFT = prove + (`!b:real^N. + closed + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> x$i <= b$i}`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dist; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; + +let CLOSED_INTERVAL_RIGHT = prove + (`!a:real^N. + closed + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= x$i}`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dist; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`]);; + +let CLOSED_HALFSPACE_LE = prove + (`!a:real^N b. closed {x | a dot x <= b}`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `(:real^N)` CONTINUOUS_ON_LIFT_DOT) THEN + REWRITE_TAC[CONTINUOUS_ON_CLOSED; GSYM CLOSED_IN; SUBTOPOLOGY_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE lift {r | ?x:real^N. (a dot x = r) /\ r <= b}`) THEN + ANTS_TAC THENL + [ALL_TAC; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[o_DEF] THEN MESON_TAC[LIFT_DROP]] THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `{x | !i. 1 <= i /\ i <= dimindex(:1) + ==> (x:real^1)$i <= (lift b)$i}` THEN + REWRITE_TAC[CLOSED_INTERVAL_LEFT] THEN + SIMP_TAC[EXTENSION; IN_IMAGE; IN_UNIV; IN_ELIM_THM; IN_INTER; + VEC_COMPONENT; DIMINDEX_1; LAMBDA_BETA; o_THM] THEN + SIMP_TAC[ARITH_RULE `1 <= i /\ i <= 1 <=> (i = 1)`] THEN + REWRITE_TAC[GSYM drop; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + MESON_TAC[LIFT_DROP]);; + +let CLOSED_HALFSPACE_GE = prove + (`!a:real^N b. closed {x | a dot x >= b}`, + REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; CLOSED_HALFSPACE_LE]);; + +let CLOSED_HYPERPLANE = prove + (`!a b. closed {x | a dot x = b}`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + REWRITE_TAC[REAL_ARITH `b <= a dot x <=> a dot x >= b`] THEN + REWRITE_TAC[SET_RULE `{x | P x /\ Q x} = {x | P x} INTER {x | Q x}`] THEN + SIMP_TAC[CLOSED_INTER; CLOSED_HALFSPACE_LE; CLOSED_HALFSPACE_GE]);; + +let CLOSED_STANDARD_HYPERPLANE = prove + (`!k a. closed {x:real^N | x$k = a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CLOSED_HALFSPACE_COMPONENT_LE = prove + (`!a k. closed {x:real^N | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_LE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let CLOSED_HALFSPACE_COMPONENT_GE = prove + (`!a k. closed {x:real^N | x$k >= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSED_HALFSPACE_GE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +(* ------------------------------------------------------------------------- *) +(* Openness of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_HALFSPACE_LT = prove + (`!a b. open {x | a dot x < b}`, + REWRITE_TAC[GSYM REAL_NOT_LE] THEN + REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN + REWRITE_TAC[GSYM closed; GSYM real_ge; CLOSED_HALFSPACE_GE]);; + +let OPEN_HALFSPACE_COMPONENT_LT = prove + (`!a k. open {x:real^N | x$k < a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_LT) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let OPEN_HALFSPACE_GT = prove + (`!a b. open {x | a dot x > b}`, + REWRITE_TAC[REAL_ARITH `x > y <=> ~(x <= y)`] THEN + REWRITE_TAC[SET_RULE `{x | ~p x} = UNIV DIFF {x | p x}`] THEN + REWRITE_TAC[GSYM closed; CLOSED_HALFSPACE_LE]);; + +let OPEN_HALFSPACE_COMPONENT_GT = prove + (`!a k. open {x:real^N | x$k > a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] OPEN_HALFSPACE_GT) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +let OPEN_POSITIVE_MULTIPLES = prove + (`!s:real^N->bool. open s ==> open {c % x | &0 < c /\ x IN s}`, + REWRITE_TAC[open_def; FORALL_IN_GSPEC] THEN GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`c:real`; `x:real^N`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c * e:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(c) % y:real^N`) THEN ANTS_TAC THENL + [SUBGOAL_THEN `x:real^N = inv c % c % x` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID; + REAL_LT_IMP_NZ]; + ASM_SIMP_TAC[DIST_MUL; real_abs; REAL_LT_INV_EQ; REAL_LT_IMP_LE] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv c * x:real = x / c`] THEN + ASM_MESON_TAC[REAL_LT_LDIV_EQ; REAL_MUL_SYM]]; + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `c:real` THEN EXISTS_TAC `inv(c) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + VECTOR_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Closures and interiors of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_HALFSPACE_LE = prove + (`!a:real^N b. + ~(a = vec 0) ==> interior {x | a dot x <= b} = {x | a dot x < b}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_UNIQUE THEN + SIMP_TAC[OPEN_HALFSPACE_LT; SUBSET; IN_ELIM_THM; REAL_LT_IMP_LE] THEN + X_GEN_TAC `s:real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_LT_LE] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[SUBSET; IN_CBALL] THEN + DISCH_THEN(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN + REWRITE_TAC[NORM_ARITH `dist(x:real^N,x + y) = norm y`] THEN + ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; REAL_DIV_RMUL; + NORM_EQ_0; REAL_ARITH `&0 < x ==> abs x <= x`] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x + e / norm(a) % a:real^N`) THEN + ASM_REWRITE_TAC[DOT_RADD; DOT_RMUL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e ==> ~(b + e <= b)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT; DOT_POS_LT]);; + +let INTERIOR_HALFSPACE_GE = prove + (`!a:real^N b. + ~(a = vec 0) ==> interior {x | a dot x >= b} = {x | a dot x > b}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; + REAL_ARITH `a > b <=> --a < --b`] THEN + ASM_SIMP_TAC[GSYM DOT_LNEG; INTERIOR_HALFSPACE_LE; VECTOR_NEG_EQ_0]);; + +let INTERIOR_HALFSPACE_COMPONENT_LE = prove + (`!a k. interior {x:real^N | x$k <= a} = {x | x$k < a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_LE) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let INTERIOR_HALFSPACE_COMPONENT_GE = prove + (`!a k. interior {x:real^N | x$k >= a} = {x | x$k > a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HALFSPACE_GE) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let CLOSURE_HALFSPACE_LT = prove + (`!a:real^N b. + ~(a = vec 0) ==> closure {x | a dot x < b} = {x | a dot x <= b}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSURE_INTERIOR] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF {x | P x} = {x | ~P x}`] THEN + ASM_SIMP_TAC[REAL_ARITH `~(x < b) <=> x >= b`; INTERIOR_HALFSPACE_GE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let CLOSURE_HALFSPACE_GT = prove + (`!a:real^N b. + ~(a = vec 0) ==> closure {x | a dot x > b} = {x | a dot x >= b}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`; + REAL_ARITH `a > b <=> --a < --b`] THEN + ASM_SIMP_TAC[GSYM DOT_LNEG; CLOSURE_HALFSPACE_LT; VECTOR_NEG_EQ_0]);; + +let CLOSURE_HALFSPACE_COMPONENT_LT = prove + (`!a k. closure {x:real^N | x$k < a} = {x | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_LT) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let CLOSURE_HALFSPACE_COMPONENT_GT = prove + (`!a k. closure {x:real^N | x$k > a} = {x | x$k >= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] CLOSURE_HALFSPACE_GT) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let INTERIOR_HYPERPLANE = prove + (`!a b. ~(a = vec 0) ==> interior {x | a dot x = b} = {}`, + REWRITE_TAC[REAL_ARITH `x = y <=> x <= y /\ x >= y`] THEN + REWRITE_TAC[SET_RULE `{x | p x /\ q x} = {x | p x} INTER {x | q x}`] THEN + REWRITE_TAC[INTERIOR_INTER] THEN + ASM_SIMP_TAC[INTERIOR_HALFSPACE_LE; INTERIOR_HALFSPACE_GE] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC);; + +let FRONTIER_HALFSPACE_LE = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x <= b} = {x | a dot x = b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_SIMP_TAC[DOT_LZERO] THENL + [ASM_CASES_TAC `&0 <= b` THEN + ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; + ASM_SIMP_TAC[frontier; INTERIOR_HALFSPACE_LE; CLOSURE_CLOSED; + CLOSED_HALFSPACE_LE] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; + +let FRONTIER_HALFSPACE_GE = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x >= b} = {x | a dot x = b}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LE) THEN + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN + REWRITE_TAC[REAL_LE_NEG2; REAL_EQ_NEG2; real_ge]);; + +let FRONTIER_HALFSPACE_LT = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x < b} = {x | a dot x = b}`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_SIMP_TAC[DOT_LZERO] THENL + [ASM_CASES_TAC `&0 < b` THEN + ASM_REWRITE_TAC[UNIV_GSPEC; FRONTIER_UNIV; EMPTY_GSPEC; FRONTIER_EMPTY]; + ASM_SIMP_TAC[frontier; CLOSURE_HALFSPACE_LT; INTERIOR_OPEN; + OPEN_HALFSPACE_LT] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; + +let FRONTIER_HALFSPACE_GT = prove + (`!a:real^N b. ~(a = vec 0 /\ b = &0) + ==> frontier {x | a dot x > b} = {x | a dot x = b}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`--a:real^N`; `--b:real`] FRONTIER_HALFSPACE_LT) THEN + ASM_REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_NEG_EQ_0; DOT_LNEG] THEN + REWRITE_TAC[REAL_LT_NEG2; REAL_EQ_NEG2; real_gt]);; + +let INTERIOR_STANDARD_HYPERPLANE = prove + (`!k a. interior {x:real^N | x$k = a} = {}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !x:real^N. x$k = x$i` + CHOOSE_TAC THENL + [ASM_REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + MP_TAC(ISPECL [`basis i:real^N`; `a:real`] INTERIOR_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS; BASIS_NONZERO]);; + +let EMPTY_INTERIOR_LOWDIM = prove + (`!s:real^N->bool. dim(s) < dimindex(:N) ==> interior s = {}`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP LOWDIM_SUBSET_HYPERPLANE) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `!t u. s SUBSET t /\ t SUBSET u /\ u = {} ==> s = {}`) THEN + MAP_EVERY EXISTS_TAC + [`interior(span(s):real^N->bool)`; + `interior({x:real^N | a dot x = &0})`] THEN + ASM_SIMP_TAC[SUBSET_INTERIOR; SPAN_INC; INTERIOR_HYPERPLANE]);; + +(* ------------------------------------------------------------------------- *) +(* Unboundedness of halfspaces. *) +(* ------------------------------------------------------------------------- *) + +let UNBOUNDED_HALFSPACE_COMPONENT_LE = prove + (`!a k. ~bounded {x:real^N | x$k <= a}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `?i. 1 <= i /\ i <= dimindex(:N) /\ !z:real^N. z$k = z$i` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + EXISTS_TAC `--(&1 + max (abs B) (abs a)) % basis i:real^N` THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; BASIS_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC);; + +let UNBOUNDED_HALFSPACE_COMPONENT_GE = prove + (`!a k. ~bounded {x:real^N | x$k >= a}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_NEGATIONS) THEN + MP_TAC(SPECL [`--a:real`; `k:num`] UNBOUNDED_HALFSPACE_COMPONENT_LE) THEN + REWRITE_TAC[CONTRAPOS_THM] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN CONJ_TAC THENL + [MESON_TAC[VECTOR_NEG_NEG]; + REWRITE_TAC[IN_ELIM_THM; VECTOR_NEG_COMPONENT] THEN REAL_ARITH_TAC]);; + +let UNBOUNDED_HALFSPACE_COMPONENT_LT = prove + (`!a k. ~bounded {x:real^N | x$k < a}`, + ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN + REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_LT; + UNBOUNDED_HALFSPACE_COMPONENT_LE]);; + +let UNBOUNDED_HALFSPACE_COMPONENT_GT = prove + (`!a k. ~bounded {x:real^N | x$k > a}`, + ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN + REWRITE_TAC[CLOSURE_HALFSPACE_COMPONENT_GT; + UNBOUNDED_HALFSPACE_COMPONENT_GE]);; + +let BOUNDED_HALFSPACE_LE = prove + (`!a:real^N b. bounded {x | a dot x <= b} <=> a = vec 0 /\ b < &0`, + GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN + SIMP_TAC[DOT_LMUL; DOT_BASIS; VECTOR_MUL_EQ_0; DIMINDEX_GE_1; LE_REFL; + BASIS_NONZERO] THEN + X_GEN_TAC `a:real` THEN ASM_CASES_TAC `a = &0` THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN X_GEN_TAC `b:real` THENL + [REWRITE_TAC[REAL_MUL_LZERO; DOT_LZERO; GSYM REAL_NOT_LE] THEN + ASM_CASES_TAC `&0 <= b` THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; + SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LT_LE; + UNBOUNDED_HALFSPACE_COMPONENT_LE]]);; + +let BOUNDED_HALFSPACE_GE = prove + (`!a:real^N b. bounded {x | a dot x >= b} <=> a = vec 0 /\ &0 < b`, + REWRITE_TAC[REAL_ARITH `a >= b <=> --a <= --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LE] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b < &0 <=> &0 < b`]);; + +let BOUNDED_HALFSPACE_LT = prove + (`!a:real^N b. bounded {x | a dot x < b} <=> a = vec 0 /\ b <= &0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = vec 0` THEN + ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[DOT_LZERO; GSYM REAL_NOT_LE] THEN ASM_CASES_TAC `b <= &0` THEN + ASM_REWRITE_TAC[BOUNDED_EMPTY; NOT_BOUNDED_UNIV; + SET_RULE `{x | T} = UNIV`; EMPTY_GSPEC]; + ONCE_REWRITE_TAC[GSYM BOUNDED_CLOSURE_EQ] THEN + ASM_SIMP_TAC[CLOSURE_HALFSPACE_LT; BOUNDED_HALFSPACE_LE]]);; + +let BOUNDED_HALFSPACE_GT = prove + (`!a:real^N b. bounded {x | a dot x > b} <=> a = vec 0 /\ &0 <= b`, + REWRITE_TAC[REAL_ARITH `a > b <=> --a < --b`] THEN + REWRITE_TAC[GSYM DOT_LNEG; BOUNDED_HALFSPACE_LT] THEN + REWRITE_TAC[VECTOR_NEG_EQ_0; REAL_ARITH `--b <= &0 <=> &0 <= b`]);; + +(* ------------------------------------------------------------------------- *) +(* Equality of continuous functions on closure and related results. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_IN_CLOSURE = prove + (`!f:real^M->real^N s t. + closed t /\ f continuous_on (closure s) /\ + (!x. x IN s ==> f x IN t) + ==> (!x. x IN closure s ==> f x IN t)`, + REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x IN t) <=> + s SUBSET {x | x IN s /\ f x IN t}`] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE]]);; + +let FORALL_IN_CLOSURE_EQ = prove + (`!f s t. + closed t /\ f continuous_on closure s + ==> ((!x. x IN closure s ==> f x IN t) <=> + (!x. x IN s ==> f x IN t))`, + MESON_TAC[FORALL_IN_CLOSURE; CLOSURE_SUBSET; SUBSET]);; + +let SUP_CLOSURE = prove + (`!s. sup(IMAGE drop (closure s)) = sup(IMAGE drop s)`, + GEN_TAC THEN MATCH_MP_TAC SUP_EQ THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `drop x <= b <=> x IN {x | drop x <= b}`] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN + REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_LE]);; + +let INF_CLOSURE = prove + (`!s. inf(IMAGE drop (closure s)) = inf(IMAGE drop s)`, + GEN_TAC THEN MATCH_MP_TAC INF_EQ THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `b <= drop x <=> x IN {x | b <= drop x}`] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN + REWRITE_TAC[CONTINUOUS_ON_ID; drop; CLOSED_HALFSPACE_COMPONENT_GE; + GSYM real_ge]);; + +let CONTINUOUS_LE_ON_CLOSURE = prove + (`!f:real^M->real s a. + (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> f(x) <= a) + ==> !x. x IN closure(s) ==> f(x) <= a`, + let lemma = prove + (`x IN s ==> f x <= a <=> x IN s ==> (lift o f) x IN {y | y$1 <= a}`, + REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; LIFT_DROP]) in + REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_LE]);; + +let CONTINUOUS_GE_ON_CLOSURE = prove + (`!f:real^M->real s a. + (lift o f) continuous_on closure(s) /\ (!x. x IN s ==> a <= f(x)) + ==> !x. x IN closure(s) ==> a <= f(x)`, + let lemma = prove + (`x IN s ==> a <= f x <=> x IN s ==> (lift o f) x IN {y | y$1 >= a}`, + REWRITE_TAC[IN_ELIM_THM; o_THM; GSYM drop; real_ge; LIFT_DROP]) in + REWRITE_TAC[lemma] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[ETA_AX; CLOSED_HALFSPACE_COMPONENT_GE]);; + +let CONTINUOUS_CONSTANT_ON_CLOSURE = prove + (`!f:real^M->real^N s a. + f continuous_on closure(s) /\ (!x. x IN s ==> f(x) = a) + ==> !x. x IN closure(s) ==> f(x) = a`, + REWRITE_TAC[SET_RULE + `x IN s ==> f x = a <=> x IN s ==> f x IN {a}`] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC FORALL_IN_CLOSURE THEN + ASM_REWRITE_TAC[CLOSED_SING]);; + +let CONTINUOUS_AGREE_ON_CLOSURE = prove + (`!g h:real^M->real^N. + g continuous_on closure s /\ h continuous_on closure s /\ + (!x. x IN s ==> g x = h x) + ==> !x. x IN closure s ==> g x = h x`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_CONSTANT_ON_CLOSURE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB]);; + +let CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT = prove + (`!f:real^M->real^N s a. + f continuous_on s + ==> closed_in (subtopology euclidean s) {x | x IN s /\ f x = a}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_SING]);; + +let CONTINUOUS_CLOSED_PREIMAGE_CONSTANT = prove + (`!f:real^M->real^N s. + f continuous_on s /\ closed s ==> closed {x | x IN s /\ f(x) = a}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `{x | x IN s /\ (f:real^M->real^N)(x) = a} = {}` THEN + ASM_REWRITE_TAC[CLOSED_EMPTY] THEN ONCE_REWRITE_TAC[SET_RULE + `{x | x IN s /\ f(x) = a} = {x | x IN s /\ f(x) IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_SING] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Theorems relating continuity and uniform continuity to closures. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_CLOSURE = prove + (`!f:real^M->real^N s. + f continuous_on closure s <=> + !x e. x IN closure s /\ &0 < e + ==> ?d. &0 < d /\ + !y. y IN s /\ dist(y,x) < d ==> dist(f y,f x) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on] THEN + EQ_TAC THENL [MESON_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET]; ALL_TAC] THEN + DISCH_TAC THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[REAL_HALF]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real^M`; `e / &2`]) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min k (d / &2)`) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_LT_MIN] THEN + ASM_MESON_TAC[DIST_SYM; NORM_ARITH + `dist(a,b) < e / &2 /\ dist(b,c) < e / &2 ==> dist(a,c) < e`]);; + +let CONTINUOUS_ON_CLOSURE_SEQUENTIALLY = prove + (`!f:real^M->real^N s. + f continuous_on closure s <=> + !x a. a IN closure s /\ (!n. x n IN s) /\ (x --> a) sequentially + ==> ((f o x) --> f a) sequentially`, + REWRITE_TAC[CONTINUOUS_ON_CLOSURE] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM continuous_within] THEN + REWRITE_TAC[CONTINUOUS_WITHIN_SEQUENTIALLY] THEN MESON_TAC[]);; + +let UNIFORMLY_CONTINUOUS_ON_CLOSURE = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s /\ f continuous_on closure s + ==> f uniformly_continuous_on closure s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[uniformly_continuous_on] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d / &3` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^M`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_on]) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `y:real^M` th) THEN MP_TAC(SPEC `x:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPECL [`x:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d1 (d / &3)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN + DISCH_THEN(X_CHOOSE_THEN `x':real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `x':real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPECL [`y:real^M`; `s:real^M->bool`] CLOSURE_APPROACHABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `min d2 (d / &3)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LT_MIN]] THEN + DISCH_THEN(X_CHOOSE_THEN `y':real^M` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `y':real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x':real^M`; `y':real^M`]) THEN + ASM_MESON_TAC[DIST_SYM; NORM_ARITH + `dist(y,x) < d / &3 /\ dist(x',x) < d / &3 /\ dist(y',y) < d / &3 + ==> dist(y',x') < d`]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity properties for square roots. We get other forms of this *) +(* later (transcendentals.ml and realanalysis.ml) but it's nice to have *) +(* them around earlier. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_AT_SQRT = prove + (`!a s. &0 < drop a ==> (lift o sqrt o drop) continuous (at a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `min (drop a) (e * sqrt(drop a))` THEN + ASM_SIMP_TAC[REAL_LT_MIN; SQRT_POS_LT; REAL_LT_MUL; DIST_REAL] THEN + X_GEN_TAC `b:real^1` THEN REWRITE_TAC[GSYM drop] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH + `abs(b - a) < a ==> &0 < b`)) THEN + SUBGOAL_THEN + `sqrt(drop b) - sqrt(drop a) = + (drop b - drop a) / (sqrt(drop a) + sqrt(drop b))` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD + `sa pow 2 = a /\ sb pow 2 = b /\ &0 < sa /\ &0 < sb + ==> sb - sa = (b - a) / (sa + sb)`) THEN + ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_ABS_DIV; SQRT_POS_LT; REAL_LT_ADD; REAL_LT_LDIV_EQ; + REAL_ARITH `&0 < x ==> abs x = x`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + REAL_LTE_TRANS)) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LE_ADDR; SQRT_POS_LE; + REAL_LT_IMP_LE]]);; + +let CONTINUOUS_WITHIN_LIFT_SQRT = prove + (`!a s. (!x. x IN s ==> &0 <= drop x) + ==> (lift o sqrt o drop) continuous (at a within s)`, + REPEAT STRIP_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `drop a < &0 \/ drop a = &0 \/ &0 < drop a`) + THENL + [MATCH_MP_TAC CONTINUOUS_WITHIN_SUBSET THEN + EXISTS_TAC `{x | &0 <= drop x}` THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM] THEN + MATCH_MP_TAC CONTINUOUS_WITHIN_CLOSED_NONTRIVIAL THEN + ASM_REWRITE_TAC[IN_ELIM_THM; REAL_NOT_LE] THEN + REWRITE_TAC[drop; REWRITE_RULE[real_ge] CLOSED_HALFSPACE_COMPONENT_GE]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM LIFT_EQ; LIFT_DROP; LIFT_NUM]) THEN + ASM_REWRITE_TAC[continuous_within; o_THM; DROP_VEC; SQRT_0; LIFT_NUM] THEN + REWRITE_TAC[DIST_0; NORM_LIFT; NORM_REAL; GSYM drop] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `(e:real) pow 2` THEN ASM_SIMP_TAC[REAL_POW_LT] THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + ASM_SIMP_TAC[real_abs; SQRT_POS_LE] THEN + SUBGOAL_THEN `e = sqrt(e pow 2)` SUBST1_TAC THENL + [ASM_SIMP_TAC[POW_2_SQRT; REAL_LT_IMP_LE]; + MATCH_MP_TAC SQRT_MONO_LT THEN ASM_SIMP_TAC[] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[]]);; + +let CONTINUOUS_WITHIN_SQRT_COMPOSE = prove + (`!f s a:real^N. + (\x. lift(f x)) continuous (at a within s) /\ + (&0 < f a \/ !x. x IN s ==> &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous (at a within s)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + (MATCH_MP_TAC CONTINUOUS_WITHIN_COMPOSE THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[o_DEF]; ALL_TAC]) + THENL + [MATCH_MP_TAC CONTINUOUS_AT_WITHIN THEN + MATCH_MP_TAC CONTINUOUS_AT_SQRT THEN ASM_REWRITE_TAC[o_DEF; LIFT_DROP]; + MATCH_MP_TAC CONTINUOUS_WITHIN_LIFT_SQRT THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP]]);; + +let CONTINUOUS_AT_SQRT_COMPOSE = prove + (`!f a:real^N. + (\x. lift(f x)) continuous (at a) /\ (&0 < f a \/ !x. &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous (at a)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:real^N->real`; `(:real^N)`; `a:real^N`] + CONTINUOUS_WITHIN_SQRT_COMPOSE) THEN + REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; + +let CONTINUOUS_ON_LIFT_SQRT = prove + (`!s. (!x. x IN s ==> &0 <= drop x) + ==> (lift o sqrt o drop) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_WITHIN_LIFT_SQRT]);; + +let CONTINUOUS_ON_LIFT_SQRT_COMPOSE = prove + (`!f:real^N->real s. + (lift o f) continuous_on s /\ (!x. x IN s ==> &0 <= f x) + ==> (\x. lift(sqrt(f x))) continuous_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^N. lift(sqrt(f x))) = (lift o sqrt o drop) o (lift o f)` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; LIFT_DROP]; + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_SQRT THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; o_THM; LIFT_DROP]]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy continuity, and the extension of functions to closures. *) +(* ------------------------------------------------------------------------- *) + +let UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s + ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; cauchy; o_DEF] THEN + MESON_TAC[]);; + +let CONTINUOUS_CLOSED_IMP_CAUCHY_CONTINUOUS = prove + (`!f:real^M->real^N s. + f continuous_on s /\ closed s + ==> (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x))`, + REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED; CONTINUOUS_ON_SEQUENTIALLY] THEN + REWRITE_TAC[complete] THEN MESON_TAC[CONVERGENT_IMP_CAUCHY]);; + +let CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA = prove + (`!f:real^M->real^N s. + (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) + ==> !a x. (!n. (x n) IN s) /\ (x --> a) sequentially + ==> ?l. ((f o x) --> l) sequentially /\ + !y. (!n. (y n) IN s) /\ (y --> a) sequentially + ==> ((f o y) --> l) sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:num->real^M` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `y:num->real^M`) THEN + ANTS_TAC THENL [ASM_MESON_TAC[CONVERGENT_IMP_CAUCHY]; ALL_TAC] THEN + REWRITE_TAC[GSYM CONVERGENT_EQ_CAUCHY] THEN + DISCH_THEN(X_CHOOSE_THEN `m:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `l:real^N = m` (fun th -> ASM_REWRITE_TAC[th]) THEN + ONCE_REWRITE_TAC[GSYM VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (f:real^M->real^N)(x n) - f(y n)` THEN + RULE_ASSUM_TAC(REWRITE_RULE[o_DEF]) THEN + ASM_SIMP_TAC[LIM_SUB; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `\n. if EVEN n then x(n DIV 2):real^M else y(n DIV 2)`) THEN + REWRITE_TAC[cauchy; o_THM; LIM_SEQUENTIALLY] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN MAP_EVERY UNDISCH_TAC + [`((y:num->real^M) --> a) sequentially`; + `((x:num->real^M) --> a) sequentially`] THEN + REPEAT(FIRST_X_ASSUM(K ALL_TAC o check (is_forall o concl))) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `2 * (N1 + N2)` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `m DIV 2` th) THEN MP_TAC(SPEC `n DIV 2` th))) THEN + REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_NOT_LE])) THEN + CONV_TAC NORM_ARITH; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`2 * n`; `2 * n + 1`]) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH_EVEN] THEN + REWRITE_TAC[ARITH_RULE `(2 * n) DIV 2 = n /\ (2 * n + 1) DIV 2 = n`] THEN + REWRITE_TAC[dist; VECTOR_SUB_RZERO]]);; + +let CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove + (`!f:real^M->real^N s. + (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) + ==> ?g. g continuous_on closure s /\ (!x. x IN s ==> g x = f x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a:real^M. ?x. + a IN closure s ==> (!n. x n IN s) /\ (x --> a) sequentially` + MP_TAC THENL [MESON_TAC[CLOSURE_SEQUENTIAL]; ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `X:real^M->num->real^M` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_UNIQUENESS_LEMMA) THEN + DISCH_THEN(MP_TAC o GEN `a:real^M` o + SPECL [`a:real^M`; `(X:real^M->num->real^M) a`]) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `(!a. P a ==> Q a) ==> ((!a. P a ==> R a) ==> p) + ==> ((!a. Q a ==> R a) ==> p)`)) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN + STRIP_TAC THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [X_GEN_TAC `a:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^M`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `(\n. a):num->real^M` o CONJUNCT2) THEN + ASM_SIMP_TAC[LIM_CONST_EQ; o_DEF; TRIVIAL_LIMIT_SEQUENTIALLY]; + STRIP_TAC] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CLOSURE_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`x:num->real^M`; `a:real^M`] THEN STRIP_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `(f:real^M->real^N) o (x:num->real^M)` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_SIMP_TAC[o_THM]);; + +let UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s + ==> ?g. g uniformly_continuous_on closure s /\ (!x. x IN s ==> g x = f x) /\ + !h. h continuous_on closure s /\ (!x. x IN s ==> h x = f x) + ==> !x. x IN closure s ==> h x = g x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE o + MATCH_MP UNIFORMLY_CONTINUOUS_IMP_CAUCHY_CONTINUOUS) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^M->real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[UNIFORMLY_CONTINUOUS_ON_CLOSURE; UNIFORMLY_CONTINUOUS_ON_EQ]; + ASM_MESON_TAC[CONTINUOUS_AGREE_ON_CLOSURE]]);; + +let CAUCHY_CONTINUOUS_IMP_CONTINUOUS = prove + (`!f:real^M->real^N s. + (!x. cauchy x /\ (!n. (x n) IN s) ==> cauchy(f o x)) + ==> f continuous_on s`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(CHOOSE_TAC o MATCH_MP CAUCHY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; CLOSURE_SUBSET; CONTINUOUS_ON_EQ]);; + +let BOUNDED_UNIFORMLY_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + f uniformly_continuous_on s /\ bounded s ==> bounded(IMAGE f s)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o MATCH_MP UNIFORMLY_CONTINUOUS_EXTENDS_TO_CLOSURE) THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^M->real^N` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `IMAGE (g:real^M->real^N) (closure s)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[COMPACT_CLOSURE; UNIFORMLY_CONTINUOUS_IMP_CONTINUOUS; + COMPACT_IMP_BOUNDED; COMPACT_CONTINUOUS_IMAGE]; + MP_TAC(ISPEC `s:real^M->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Occasionally useful invariance properties. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_AT_COMPOSE_EQ = prove + (`!f:real^M->real^N g:real^M->real^M h:real^M->real^M. + g continuous at x /\ h continuous at (g x) /\ + (!y. g(h y) = y) /\ h(g x) = x + ==> (f continuous at (g x) <=> (\x. f(g x)) continuous at x)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_AT_COMPOSE] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `((f:real^M->real^N) o (g:real^M->real^M) o (h:real^M->real^M)) + continuous at (g(x:real^M))` + MP_TAC THENL + [REWRITE_TAC[o_ASSOC] THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN + ASM_REWRITE_TAC[o_DEF]; + + ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; + +let CONTINUOUS_AT_TRANSLATION = prove + (`!a z f:real^M->real^N. + f continuous at (a + z) <=> (\x. f(a + x)) continuous at z`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN + EXISTS_TAC `\x:real^M. x - a` THEN + SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_SUB; + CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN + VECTOR_ARITH_TAC);; + +add_translation_invariants [CONTINUOUS_AT_TRANSLATION];; + +let CONTINUOUS_AT_LINEAR_IMAGE = prove + (`!h:real^M->real^M z f:real^M->real^N. + linear h /\ (!x. norm(h x) = norm x) + ==> (f continuous at (h z) <=> (\x. f(h x)) continuous at z)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o GEN_REWRITE_RULE I + [GSYM ORTHOGONAL_TRANSFORMATION]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `g:real^M->real^M` o MATCH_MP + ORTHOGONAL_TRANSFORMATION_INVERSE) THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE_EQ THEN + EXISTS_TAC `g:real^M->real^M` THEN + RULE_ASSUM_TAC(REWRITE_RULE[ORTHOGONAL_TRANSFORMATION]) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; + +add_linear_invariants [CONTINUOUS_AT_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Interior of an injective image. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_IMAGE_SUBSET = prove + (`!f:real^M->real^N s. + (!x. f continuous at x) /\ (!x y. f x = f y ==> x = y) + ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET] THEN + REWRITE_TAC[interior; IN_ELIM_THM] THEN + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + SUBGOAL_THEN `y IN IMAGE (f:real^M->real^N) s` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + EXISTS_TAC `{x | (f:real^M->real^N)(x) IN t}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN ASM_MESON_TAC[]; + ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Making a continuous function avoid some value in a neighbourhood. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_WITHIN_AVOID = prove + (`!f:real^M->real^N x s a. + f continuous (at x within s) /\ x IN s /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_within]) THEN + DISCH_THEN(MP_TAC o SPEC `norm((f:real^M->real^N) x - a)`) THEN + ASM_REWRITE_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN SIMP_TAC[] THEN NORM_ARITH_TAC);; + +let CONTINUOUS_AT_AVOID = prove + (`!f:real^M->real^N x a. + f continuous (at x) /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, + MP_TAC CONTINUOUS_WITHIN_AVOID THEN + REPLICATE_TAC 2 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(:real^M)`) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + REWRITE_TAC[WITHIN_UNIV; IN_UNIV]);; + +let CONTINUOUS_ON_AVOID = prove + (`!f:real^M->real^N x s a. + f continuous_on s /\ x IN s /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. y IN s /\ dist(x,y) < e ==> ~(f y = a)`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_WITHIN_AVOID THEN + ASM_SIMP_TAC[]);; + +let CONTINUOUS_ON_OPEN_AVOID = prove + (`!f:real^M->real^N x s a. + f continuous_on s /\ open s /\ x IN s /\ ~(f x = a) + ==> ?e. &0 < e /\ !y. dist(x,y) < e ==> ~(f y = a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `open(s:real^M->bool)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_AVOID THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Proving a function is constant by proving open-ness of level set. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_LEVELSET_OPEN_IN_CASES = prove + (`!f:real^M->real^N s a. + connected s /\ + f continuous_on s /\ + open_in (subtopology euclidean s) {x | x IN s /\ f x = a} + ==> (!x. x IN s ==> ~(f x = a)) \/ (!x. x IN s ==> f x = a)`, + REWRITE_TAC[SET_RULE `(!x. x IN s ==> ~(f x = a)) <=> + {x | x IN s /\ f x = a} = {}`; + SET_RULE `(!x. x IN s ==> f x = a) <=> + {x | x IN s /\ f x = a} = s`] THEN + REWRITE_TAC[CONNECTED_CLOPEN] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_CONSTANT]);; + +let CONTINUOUS_LEVELSET_OPEN_IN = prove + (`!f:real^M->real^N s a. + connected s /\ + f continuous_on s /\ + open_in (subtopology euclidean s) {x | x IN s /\ f x = a} /\ + (?x. x IN s /\ f x = a) + ==> (!x. x IN s ==> f x = a)`, + MESON_TAC[CONTINUOUS_LEVELSET_OPEN_IN_CASES]);; + +let CONTINUOUS_LEVELSET_OPEN = prove + (`!f:real^M->real^N s a. + connected s /\ + f continuous_on s /\ + open {x | x IN s /\ f x = a} /\ + (?x. x IN s /\ f x = a) + ==> (!x. x IN s ==> f x = a)`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC CONTINUOUS_LEVELSET_OPEN_IN THEN + ASM_REWRITE_TAC[OPEN_IN_OPEN] THEN + EXISTS_TAC `{x | x IN s /\ (f:real^M->real^N) x = a}` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some arithmetical combinations (more to prove). *) +(* ------------------------------------------------------------------------- *) + +let OPEN_SCALING = prove + (`!s:real^N->bool c. ~(c = &0) /\ open s ==> open(IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e * abs(c)` THEN ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `inv(c) % y:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN `x = inv(c) % c % x:real^N` SUBST1_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; + REWRITE_TAC[dist; GSYM VECTOR_SUB_LDISTRIB; NORM_MUL] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_ABS_INV] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LT_LDIV_EQ; GSYM REAL_ABS_NZ] THEN + ASM_REWRITE_TAC[GSYM dist]]);; + +let OPEN_NEGATIONS = prove + (`!s:real^N->bool. open s ==> open (IMAGE (--) s)`, + SUBGOAL_THEN `(--) = \x:real^N. --(&1) % x` + (fun th -> SIMP_TAC[th; OPEN_SCALING; REAL_ARITH `~(--(&1) = &0)`]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; + +let OPEN_TRANSLATION = prove + (`!s a:real^N. open s ==> open(IMAGE (\x. a + x) s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. x - a`; `s:real^N->bool`] + CONTINUOUS_OPEN_PREIMAGE_UNIV) THEN + ASM_SIMP_TAC[CONTINUOUS_SUB; CONTINUOUS_AT_ID; CONTINUOUS_CONST] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + ASM_MESON_TAC[VECTOR_ARITH `(a + x) - a = x:real^N`; + VECTOR_ARITH `a + (x - a) = x:real^N`]);; + +let OPEN_TRANSLATION_EQ = prove + (`!a s. open (IMAGE (\x:real^N. a + x) s) <=> open s`, + REWRITE_TAC[open_def] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [OPEN_TRANSLATION_EQ];; + +let OPEN_AFFINITY = prove + (`!s a:real^N c. + open s /\ ~(c = &0) ==> open (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; OPEN_TRANSLATION; OPEN_SCALING]);; + +let INTERIOR_TRANSLATION = prove + (`!a:real^N s. + interior (IMAGE (\x. a + x) s) = IMAGE (\x. a + x) (interior s)`, + REWRITE_TAC[interior] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [INTERIOR_TRANSLATION];; + +let OPEN_SUMS = prove + (`!s t:real^N->bool. + open s \/ open t ==> open {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def] THEN STRIP_TAC THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`); + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`)] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VECTOR_ADD_SYM; VECTOR_ARITH `(z - y) + y:real^N = z`; + NORM_ARITH `dist(z:real^N,x + y) < e ==> dist(z - y,x) < e`]);; + +(* ------------------------------------------------------------------------- *) +(* Upper and lower hemicontinuous functions, relation in the case of *) +(* preimage map to open and closed maps, and fact that upper and lower *) +(* hemicontinuity together imply continuity in the sense of the Hausdorff *) +(* metric (at points where the function gives a bounded and nonempty set). *) +(* ------------------------------------------------------------------------- *) + +let UPPER_HEMICONTINUOUS = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) + ==> ((!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) <=> + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ ~(f(x) INTER u = {})}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + MATCH_MP_TAC MONO_IMP THEN + SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL + [REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]; REWRITE_TAC[closed_in]] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let LOWER_HEMICONTINUOUS = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) + ==> ((!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) <=> + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ ~(f(x) INTER u = {})}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t DIFF u:real^N->bool`) THEN + MATCH_MP_TAC MONO_IMP THEN + SIMP_TAC[OPEN_IN_DIFF; CLOSED_IN_DIFF; OPEN_IN_REFL; CLOSED_IN_REFL] THENL + [REWRITE_TAC[closed_in]; REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ]] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]);; + +let OPEN_MAP_IFF_LOWER_HEMICONTINUOUS_PREIMAGE = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) + {y | y IN t /\ + {x | x IN s /\ f x = y} SUBSET u}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; + X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + REWRITE_TAC[OPEN_IN_CLOSED_IN_EQ; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let CLOSED_MAP_IFF_UPPER_HEMICONTINUOUS_PREIMAGE = prove + (`!f:real^M->real^N s t. + IMAGE f s SUBSET t + ==> ((!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) <=> + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) + {y | y IN t /\ + {x | x IN s /\ f x = y} SUBSET u}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[CLOSED_IN_DIFF; CLOSED_IN_REFL] THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]; + X_GEN_TAC `v:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DIFF v:real^M->bool`) THEN + ASM_SIMP_TAC[OPEN_IN_DIFF; OPEN_IN_REFL] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CLOSED_IN_IMP_SUBSET) THEN + REWRITE_TAC[closed_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(fun th -> CONJ_TAC THENL [ASM SET_TAC[]; MP_TAC th]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]);; + +let UPPER_LOWER_HEMICONTINUOUS_EXPLICIT = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) /\ + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) /\ + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) + ==> !x e. x IN s /\ &0 < e /\ bounded(f x) /\ ~(f x = {}) + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x,x') < d + ==> (!y. y IN f x + ==> ?y'. y' IN f x' /\ dist(y,y') < e) /\ + (!y'. y' IN f x' + ==> ?y. y IN f x /\ dist(y',y) < e)`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC + `!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN + DISCH_THEN(MP_TAC o SPEC + `t INTER + {a + b | a IN (f:real^M->real^N->bool) x /\ b IN ball(vec 0,e)}`) THEN + SIMP_TAC[OPEN_SUMS; OPEN_BALL; OPEN_IN_OPEN_INTER] THEN + REWRITE_TAC[open_in; SUBSET_RESTRICT] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_SIMP_TAC[IN_ELIM_THM; SUBSET_INTER] THEN ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[CENTRE_IN_BALL; VECTOR_ADD_RID]; + DISCH_THEN(X_CHOOSE_THEN `d1:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "1")))] THEN + UNDISCH_TAC + `!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ (f:real^M->real^N->bool)(x) SUBSET u}` THEN + ASM_SIMP_TAC[LOWER_HEMICONTINUOUS] THEN DISCH_THEN(MP_TAC o + GEN `a:real^N` o SPEC `t INTER ball(a:real^N,e / &2)`) THEN + SIMP_TAC[OPEN_BALL; OPEN_IN_OPEN_INTER] THEN + + MP_TAC(SPEC `closure((f:real^M->real^N->bool) x)` + COMPACT_EQ_HEINE_BOREL) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN DISCH_THEN(MP_TAC o SPEC + `{ball(a:real^N,e / &2) | a IN (f:real^M->real^N->bool) x}`) THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; OPEN_BALL] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL + [REWRITE_TAC[CLOSURE_APPROACHABLE; SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[IN_BALL] THEN ASM_SIMP_TAC[REAL_HALF]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N->bool` STRIP_ASSUME_TAC) THEN + DISCH_TAC THEN FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP + (MESON[CLOSURE_SUBSET; SUBSET_TRANS] + `closure s SUBSET t ==> s SUBSET t`)) THEN + SUBGOAL_THEN + `open_in (subtopology euclidean s) + (INTERS {{x | x IN s /\ + ~((f:real^M->real^N->bool) x INTER t INTER ball(a,e / &2) = {})} | + a IN c})` + MP_TAC THENL + [MATCH_MP_TAC OPEN_IN_INTERS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; FINITE_IMAGE] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[open_in] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN ANTS_TAC THENL + [REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `a:real^N` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `a:real^N` THEN + ASM_REWRITE_TAC[IN_INTER; CENTRE_IN_BALL; REAL_HALF] THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `d2:real` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "2")))] THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN CONJ_TAC THENL + [ALL_TAC; + REMOVE_THEN "1" (MP_TAC o SPEC `x':real^M`) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_BALL] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = a + b <=> x - a = b`; + DIST_0; ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[dist]] THEN + REMOVE_THEN "2" (MP_TAC o SPEC `x':real^M`) THEN + ASM_REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM] THEN + ANTS_TAC THENL [ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + DISCH_THEN(LABEL_TAC "3") THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + UNDISCH_TAC `(f:real^M->real^N->bool) x SUBSET + UNIONS (IMAGE (\a. ball (a,e / &2)) c)` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "3" (MP_TAC o SPEC `a:real^N`) THEN + ASM_REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; IN_BALL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `z:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DIST_TRIANGLE_HALF_L; DIST_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Connected components, considered as a "connectedness" relation or a set. *) +(* ------------------------------------------------------------------------- *) + +let connected_component = new_definition + `connected_component s x y <=> + ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t`;; + +let CONNECTED_COMPONENT_IN = prove + (`!s x y. connected_component s x y ==> x IN s /\ y IN s`, + REWRITE_TAC[connected_component] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_REFL = prove + (`!s x:real^N. x IN s ==> connected_component s x x`, + REWRITE_TAC[connected_component] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `{x:real^N}` THEN REWRITE_TAC[CONNECTED_SING] THEN + ASM SET_TAC[]);; + +let CONNECTED_COMPONENT_REFL_EQ = prove + (`!s x:real^N. connected_component s x x <=> x IN s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_REFL] THEN + REWRITE_TAC[connected_component] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_SYM = prove + (`!s x y:real^N. connected_component s x y ==> connected_component s y x`, + REWRITE_TAC[connected_component] THEN MESON_TAC[]);; + +let CONNECTED_COMPONENT_TRANS = prove + (`!s x y:real^N. + connected_component s x y /\ connected_component s y z + ==> connected_component s x z`, + REPEAT GEN_TAC THEN REWRITE_TAC[connected_component] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `t:real^N->bool`) + (X_CHOOSE_TAC `u:real^N->bool`)) THEN + EXISTS_TAC `t UNION u:real^N->bool` THEN + ASM_REWRITE_TAC[IN_UNION; UNION_SUBSET] THEN + MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]);; + +let CONNECTED_COMPONENT_OF_SUBSET = prove + (`!s t x. s SUBSET t /\ connected_component s x y + ==> connected_component t x y`, + REWRITE_TAC[connected_component] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_SET = prove + (`!s x. connected_component s x = + { y | ?t. connected t /\ t SUBSET s /\ x IN t /\ y IN t}`, + REWRITE_TAC[IN_ELIM_THM; EXTENSION] THEN + REWRITE_TAC[IN; connected_component] THEN MESON_TAC[]);; + +let CONNECTED_COMPONENT_UNIONS = prove + (`!s x. connected_component s x = + UNIONS {t | connected t /\ x IN t /\ t SUBSET s}`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_SUBSET = prove + (`!s x. (connected_component s x) SUBSET s`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_CONNECTED_COMPONENT_SET = prove + (`!s. connected s <=> !x:real^N. x IN s ==> connected_component s x = s`, + GEN_TAC THEN REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN EQ_TAC THENL + [SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[CONNECTED_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `a:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC CONNECTED_UNIONS THEN + ASM SET_TAC[]);; + +let CONNECTED_COMPONENT_EQ_SELF = prove + (`!s x. connected s /\ x IN s ==> connected_component s x = s`, + MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET]);; + +let CONNECTED_IFF_CONNECTED_COMPONENT = prove + (`!s. connected s <=> + !x y. x IN s /\ y IN s ==> connected_component s x y`, + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT_SET] THEN + REWRITE_TAC[EXTENSION] THEN MESON_TAC[IN; CONNECTED_COMPONENT_IN]);; + +let CONNECTED_COMPONENT_MAXIMAL = prove + (`!s t x:real^N. + x IN t /\ connected t /\ t SUBSET s + ==> t SUBSET (connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_MONO = prove + (`!s t x. s SUBSET t + ==> (connected_component s x) SUBSET (connected_component t x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]);; + +let CONNECTED_CONNECTED_COMPONENT = prove + (`!s x. connected(connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_UNIONS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_UNIONS THEN SET_TAC[]);; + +let CONNECTED_COMPONENT_EQ_EMPTY = prove + (`!s x:real^N. connected_component s x = {} <=> ~(x IN s)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SET_TAC[]]);; + +let CONNECTED_COMPONENT_EMPTY = prove + (`!x. connected_component {} x = {}`, + REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; NOT_IN_EMPTY]);; + +let CONNECTED_COMPONENT_EQ = prove + (`!s x y. y IN connected_component s x + ==> (connected_component s y = connected_component s x)`, + REWRITE_TAC[EXTENSION; IN] THEN + MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; + +let CLOSED_CONNECTED_COMPONENT = prove + (`!s x:real^N. closed s ==> closed(connected_component s x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(x:real^N) IN s` THENL + [ALL_TAC; ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CLOSED_EMPTY]] THEN + REWRITE_TAC[GSYM CLOSURE_EQ] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[CLOSURE_SUBSET] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + SIMP_TAC[CONNECTED_CLOSURE; CONNECTED_CONNECTED_COMPONENT] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; + +let CONNECTED_COMPONENT_DISJOINT = prove + (`!s a b. DISJOINT (connected_component s a) (connected_component s b) <=> + ~(a IN connected_component s b)`, + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN] THEN + MESON_TAC[CONNECTED_COMPONENT_SYM; CONNECTED_COMPONENT_TRANS]);; + +let CONNECTED_COMPONENT_NONOVERLAP = prove + (`!s a b:real^N. + (connected_component s a) INTER (connected_component s b) = {} <=> + ~(a IN s) \/ ~(b IN s) \/ + ~(connected_component s a = connected_component s b)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `(a:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[INTER_EMPTY] THEN + ASM_CASES_TAC `(b:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[INTER_EMPTY] THEN ASM_CASES_TAC + `connected_component s (a:real^N) = connected_component s b` THEN + ASM_REWRITE_TAC[INTER_IDEMPOT; CONNECTED_COMPONENT_EQ_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM DISJOINT]) THEN + REWRITE_TAC[CONNECTED_COMPONENT_DISJOINT]);; + +let CONNECTED_COMPONENT_OVERLAP = prove + (`!s a b:real^N. + ~((connected_component s a) INTER (connected_component s b) = {}) <=> + a IN s /\ b IN s /\ + connected_component s a = connected_component s b`, + REWRITE_TAC[CONNECTED_COMPONENT_NONOVERLAP; DE_MORGAN_THM]);; + +let CONNECTED_COMPONENT_SYM_EQ = prove + (`!s x y. connected_component s x y <=> connected_component s y x`, + MESON_TAC[CONNECTED_COMPONENT_SYM]);; + +let CONNECTED_COMPONENT_EQ_EQ = prove + (`!s x y:real^N. + connected_component s x = connected_component s y <=> + ~(x IN s) /\ ~(y IN s) \/ + x IN s /\ y IN s /\ connected_component s x y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(y:real^N) IN s` THENL + [ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[FUN_EQ_THM] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_TRANS; CONNECTED_COMPONENT_REFL; + CONNECTED_COMPONENT_SYM]; + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]; + RULE_ASSUM_TAC(REWRITE_RULE[GSYM CONNECTED_COMPONENT_EQ_EMPTY]) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY] THEN + ONCE_REWRITE_TAC[CONNECTED_COMPONENT_SYM_EQ] THEN + ASM_REWRITE_TAC[EMPTY] THEN ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY]]);; + +let CONNECTED_EQ_CONNECTED_COMPONENT_EQ = prove + (`!s. connected s <=> + !x y. x IN s /\ y IN s + ==> connected_component s x = connected_component s y`, + SIMP_TAC[CONNECTED_COMPONENT_EQ_EQ] THEN + REWRITE_TAC[CONNECTED_IFF_CONNECTED_COMPONENT]);; + +let CONNECTED_COMPONENT_IDEMP = prove + (`!s x:real^N. connected_component (connected_component s x) x = + connected_component s x`, + REWRITE_TAC[FUN_EQ_THM; connected_component] THEN + REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL; SUBSET_TRANS; + CONNECTED_COMPONENT_SUBSET]);; + +let CONNECTED_COMPONENT_UNIQUE = prove + (`!s c x:real^N. + x IN c /\ c SUBSET s /\ connected c /\ + (!c'. x IN c' /\ c' SUBSET s /\ connected c' + ==> c' SUBSET c) + ==> connected_component s x = c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_CONNECTED_COMPONENT] THEN + REWRITE_TAC[IN] THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]]);; + +let JOINABLE_CONNECTED_COMPONENT_EQ = prove + (`!s t x y:real^N. + connected t /\ t SUBSET s /\ + ~(connected_component s x INTER t = {}) /\ + ~(connected_component s y INTER t = {}) + ==> connected_component s x = connected_component s y`, + REPEAT GEN_TAC THEN + REPLICATE_TAC 2 (DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `w:real^N` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC)) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_EQ THEN + REWRITE_TAC[IN] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `z:real^N` THEN CONJ_TAC THENL [ASM_MESON_TAC[IN]; ALL_TAC] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_TRANS THEN + EXISTS_TAC `w:real^N` THEN CONJ_TAC THENL + [REWRITE_TAC[connected_component] THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[IN; CONNECTED_COMPONENT_SYM]]);; + +let CONNECTED_COMPONENT_TRANSLATION = prove + (`!a s x. connected_component (IMAGE (\x. a + x) s) (a + x) = + IMAGE (\x. a + x) (connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [CONNECTED_COMPONENT_TRANSLATION];; + +let CONNECTED_COMPONENT_LINEAR_IMAGE = prove + (`!f s x. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> connected_component (IMAGE f s) (f x) = + IMAGE f (connected_component s x)`, + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN + GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [CONNECTED_COMPONENT_LINEAR_IMAGE];; + +let UNIONS_CONNECTED_COMPONENT = prove + (`!s:real^N->bool. UNIONS {connected_component s x |x| x IN s} = s`, + GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC; CONNECTED_COMPONENT_SUBSET] THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ]);; + +let COMPLEMENT_CONNECTED_COMPONENT_UNIONS = prove + (`!s x:real^N. + s DIFF connected_component s x = + UNIONS({connected_component s y | y | y IN s} DELETE + (connected_component s x))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) + [GSYM UNIONS_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s DELETE a ==> DISJOINT a x) + ==> UNIONS s DIFF a = UNIONS (s DELETE a)`) THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC; IN_DELETE] THEN + SIMP_TAC[CONNECTED_COMPONENT_DISJOINT; CONNECTED_COMPONENT_EQ_EQ] THEN + MESON_TAC[IN; SUBSET; CONNECTED_COMPONENT_SUBSET]);; + +let CLOSED_IN_CONNECTED_COMPONENT = prove + (`!s x:real^N. closed_in (subtopology euclidean s) (connected_component s x)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `connected_component s (x:real^N) = {}` THEN + ASM_REWRITE_TAC[CLOSED_IN_EMPTY] THEN + RULE_ASSUM_TAC(REWRITE_RULE[CONNECTED_COMPONENT_EQ_EMPTY]) THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `closure(connected_component s x):real^N->bool` THEN + REWRITE_TAC[CLOSED_CLOSURE] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + REWRITE_TAC[SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN REWRITE_TAC[INTER_SUBSET] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_INTER] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET] CLOSURE_SUBSET) THEN + ASM_REWRITE_TAC[IN; CONNECTED_COMPONENT_REFL_EQ]; + MATCH_MP_TAC CONNECTED_INTERMEDIATE_CLOSURE THEN + EXISTS_TAC `connected_component s (x:real^N)` THEN + REWRITE_TAC[INTER_SUBSET; CONNECTED_CONNECTED_COMPONENT; + SUBSET_INTER; CONNECTED_COMPONENT_SUBSET; CLOSURE_SUBSET]]);; + +let OPEN_IN_CONNECTED_COMPONENT = prove + (`!s x:real^N. + FINITE {connected_component s x |x| x IN s} + ==> open_in (subtopology euclidean s) (connected_component s x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `connected_component s (x:real^N) = + s DIFF (UNIONS {connected_component s y |y| y IN s} DIFF + connected_component s x)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_CONNECTED_COMPONENT] THEN + MATCH_MP_TAC(SET_RULE `t SUBSET s ==> t = s DIFF (s DIFF t)`) THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]; + MATCH_MP_TAC OPEN_IN_DIFF THEN + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY_REFL; TOPSPACE_EUCLIDEAN; SUBSET_UNIV] THEN + REWRITE_TAC[UNIONS_DIFF] THEN + MATCH_MP_TAC CLOSED_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN + `connected_component s y DIFF connected_component s x = + connected_component s y \/ + connected_component s (y:real^N) DIFF connected_component s x = {}` + (DISJ_CASES_THEN SUBST1_TAC) + THENL + [MATCH_MP_TAC(SET_RULE + `(~(s INTER t = {}) ==> s = t) ==> s DIFF t = s \/ s DIFF t = {}`) THEN + SIMP_TAC[CONNECTED_COMPONENT_OVERLAP]; + REWRITE_TAC[CLOSED_IN_CONNECTED_COMPONENT]; + REWRITE_TAC[CLOSED_IN_EMPTY]]]);; + +let CONNECTED_COMPONENT_EQUIVALENCE_RELATION = prove + (`!R s:real^N->bool. + (!x y. R x y ==> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!a. a IN s + ==> ?t. open_in (subtopology euclidean s) t /\ a IN t /\ + !x. x IN t ==> R a x) + ==> !a b. connected_component s a b ==> R a b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`R:real^N->real^N->bool`; `connected_component s (a:real^N)`] + CONNECTED_EQUIVALENCE_RELATION) THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN ANTS_TAC THENL + [X_GEN_TAC `c:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N`) THEN ANTS_TAC THENL + [ASM_MESON_TAC[CONNECTED_COMPONENT_SUBSET; SUBSET]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t INTER connected_component s (a:real^N)` THEN + ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN]) THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] + CONNECTED_COMPONENT_SUBSET) THEN + SET_TAC[]; + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN] THEN + REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_IN]]);; + +let CONNECTED_COMPONENT_INTERMEDIATE_SUBSET = prove + (`!t u a:real^N. + connected_component u a SUBSET t /\ t SUBSET u + ==> connected_component t a = connected_component u a`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `(a:real^N) IN u` THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + CONJ_TAC THENL [ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM SET_TAC[]; + ASM_MESON_TAC[CONNECTED_COMPONENT_EQ_EMPTY; SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* The set of connected components of a set. *) +(* ------------------------------------------------------------------------- *) + +let components = new_definition + `components s = {connected_component s x | x | x:real^N IN s}`;; + +let COMPONENTS_TRANSLATION = prove + (`!a s. components(IMAGE (\x. a + x) s) = + IMAGE (IMAGE (\x. a + x)) (components s)`, + REWRITE_TAC[components] THEN GEOM_TRANSLATE_TAC[] THEN SET_TAC[]);; + +add_translation_invariants [COMPONENTS_TRANSLATION];; + +let COMPONENTS_LINEAR_IMAGE = prove + (`!f s. linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> components(IMAGE f s) = IMAGE (IMAGE f) (components s)`, + REWRITE_TAC[components] THEN GEOM_TRANSFORM_TAC[] THEN SET_TAC[]);; + +add_linear_invariants [COMPONENTS_LINEAR_IMAGE];; + +let IN_COMPONENTS = prove + (`!u:real^N->bool s. s IN components u + <=> ?x. x IN u /\ s = connected_component u x`, + REPEAT GEN_TAC THEN REWRITE_TAC[components] THEN EQ_TAC + THENL [SET_TAC[];STRIP_TAC THEN ASM_SIMP_TAC[] THEN + UNDISCH_TAC `x:real^N IN u` THEN SET_TAC[]]);; + +let UNIONS_COMPONENTS = prove + (`!u:real^N->bool. u = UNIONS (components u)`, + REWRITE_TAC[EXTENSION] THEN REPEAT GEN_TAC THEN EQ_TAC + THENL[DISCH_TAC THEN REWRITE_TAC[IN_UNIONS] THEN + EXISTS_TAC `connected_component (u:real^N->bool) x` THEN CONJ_TAC THENL + [REWRITE_TAC[components] THEN SET_TAC[ASSUME `x:real^N IN u`]; + REWRITE_TAC[CONNECTED_COMPONENT_SET] THEN SUBGOAL_THEN + `?s:real^N->bool. connected s /\ s SUBSET u /\ x IN s` MP_TAC + THENL[EXISTS_TAC `{x:real^N}` THEN ASM_REWRITE_TAC[CONNECTED_SING] THEN + POP_ASSUM MP_TAC THEN SET_TAC[]; SET_TAC[]]]; + REWRITE_TAC[IN_UNIONS] THEN STRIP_TAC THEN + MATCH_MP_TAC (SET_RULE `!x:real^N s u. x IN s /\ s SUBSET u ==> x IN u`) THEN + EXISTS_TAC `t:real^N->bool` THEN ASM_REWRITE_TAC[] THEN STRIP_ASSUME_TAC + (MESON[IN_COMPONENTS;ASSUME `t:real^N->bool IN components u`] + `?y. t:real^N->bool = connected_component u y`) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]]);; + +let PAIRWISE_DISJOINT_COMPONENTS = prove + (`!u:real^N->bool. pairwise DISJOINT (components u)`, + GEN_TAC THEN REWRITE_TAC[pairwise;DISJOINT] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `t:real^N->bool`] THEN STRIP_TAC THEN + ASSERT_TAC `(?a. s:real^N->bool = connected_component u a) /\ + ?b. t:real^N->bool = connected_component u b` + THENL [ASM_MESON_TAC[IN_COMPONENTS]; + ASM_MESON_TAC[CONNECTED_COMPONENT_NONOVERLAP]]);; + +let IN_COMPONENTS_NONEMPTY = prove + (`!s c. c IN components s ==> ~(c = {})`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY]);; + +let IN_COMPONENTS_SUBSET = prove + (`!s c. c IN components s ==> c SUBSET s`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; + +let IN_COMPONENTS_CONNECTED = prove + (`!s c. c IN components s ==> connected c`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT]);; + +let IN_COMPONENTS_MAXIMAL = prove + (`!s c:real^N->bool. + c IN components s <=> + ~(c = {}) /\ c SUBSET s /\ connected c /\ + !c'. ~(c' = {}) /\ c SUBSET c' /\ c' SUBSET s /\ connected c' + ==> c' = c`, + REPEAT GEN_TAC THEN REWRITE_TAC[components; IN_ELIM_THM] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_EQ_EMPTY; CONNECTED_COMPONENT_SUBSET; + CONNECTED_CONNECTED_COMPONENT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_MESON_TAC[CONNECTED_COMPONENT_REFL; IN; SUBSET]; + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(GSYM CONNECTED_COMPONENT_UNIQUE) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONNECTED_UNION THEN ASM SET_TAC[]]);; + +let JOINABLE_COMPONENTS_EQ = prove + (`!s t c1 c2. + connected t /\ t SUBSET s /\ + c1 IN components s /\ c2 IN components s /\ + ~(c1 INTER t = {}) /\ ~(c2 INTER t = {}) + ==> c1 = c2`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN + MESON_TAC[JOINABLE_CONNECTED_COMPONENT_EQ]);; + +let CLOSED_IN_COMPONENT = prove + (`!s c:real^N->bool. + c IN components s ==> closed_in (subtopology euclidean s) c`, + REWRITE_TAC[components; FORALL_IN_GSPEC; CLOSED_IN_CONNECTED_COMPONENT]);; + +let CLOSED_COMPONENTS = prove + (`!s c. closed s /\ c IN components s ==> closed c`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; components; FORALL_IN_GSPEC] THEN + SIMP_TAC[CLOSED_CONNECTED_COMPONENT]);; + +let COMPACT_COMPONENTS = prove + (`!s c:real^N->bool. compact s /\ c IN components s ==> compact c`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN + MESON_TAC[CLOSED_COMPONENTS; IN_COMPONENTS_SUBSET; BOUNDED_SUBSET]);; + +let CONTINUOUS_ON_COMPONENTS_GEN = prove + (`!f:real^M->real^N s. + (!c. c IN components s + ==> open_in (subtopology euclidean s) c /\ f continuous_on c) + ==> f continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_OPEN_IN_PREIMAGE_EQ] THEN + DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN t} = + UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` + SUBST1_TAC THENL + [CONV_TAC(LAND_CONV(SUBS_CONV + [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; + MATCH_MP_TAC OPEN_IN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[OPEN_IN_TRANS]]);; + +let CONTINUOUS_ON_COMPONENTS_FINITE = prove + (`!f:real^M->real^N s. + FINITE(components s) /\ + (!c. c IN components s ==> f continuous_on c) + ==> f continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONTINUOUS_CLOSED_IN_PREIMAGE_EQ] THEN + DISCH_TAC THEN X_GEN_TAC `t:real^N->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN t} = + UNIONS {{x | x IN c /\ f x IN t} | c IN components s}` + SUBST1_TAC THENL + [CONV_TAC(LAND_CONV(SUBS_CONV + [ISPEC `s:real^M->bool` UNIONS_COMPONENTS])) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_UNIONS] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_IN_UNIONS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; FINITE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_TRANS; CLOSED_IN_COMPONENT]]);; + +let COMPONENTS_NONOVERLAP = prove + (`!s c c'. c IN components s /\ c' IN components s + ==> (c INTER c' = {} <=> ~(c = c'))`, + REWRITE_TAC[components; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CONNECTED_COMPONENT_NONOVERLAP]);; + +let COMPONENTS_EQ = prove + (`!s c c'. c IN components s /\ c' IN components s + ==> (c = c' <=> ~(c INTER c' = {}))`, + MESON_TAC[COMPONENTS_NONOVERLAP]);; + +let COMPONENTS_EQ_EMPTY = prove + (`!s. components s = {} <=> s = {}`, + GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[components; connected_component; IN_ELIM_THM] THEN + SET_TAC[]);; + +let COMPONENTS_EMPTY = prove + (`components {} = {}`, + REWRITE_TAC[COMPONENTS_EQ_EMPTY]);; + +let CONNECTED_EQ_CONNECTED_COMPONENTS_EQ = prove + (`!s. connected s <=> + !c c'. c IN components s /\ c' IN components s ==> c = c'`, + REWRITE_TAC[components; IN_ELIM_THM] THEN + MESON_TAC[CONNECTED_EQ_CONNECTED_COMPONENT_EQ]);; + +let COMPONENTS_EQ_SING,COMPONENTS_EQ_SING_EXISTS = (CONJ_PAIR o prove) + (`(!s:real^N->bool. components s = {s} <=> connected s /\ ~(s = {})) /\ + (!s:real^N->bool. (?a. components s = {a}) <=> connected s /\ ~(s = {}))`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^N->bool` THEN + MATCH_MP_TAC(TAUT `(p ==> q) /\ (q ==> r) /\ (r ==> p) + ==> (p <=> r) /\ (q <=> r)`) THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN + ASM_MESON_TAC[IN_SING; COMPONENTS_EQ_EMPTY; NOT_INSERT_EMPTY]; + STRIP_TAC THEN ONCE_REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[IN_SING] THEN + REWRITE_TAC[components; IN_ELIM_THM] THEN + ASM_MESON_TAC[CONNECTED_CONNECTED_COMPONENT_SET; MEMBER_NOT_EMPTY]]);; + +let CONNECTED_EQ_COMPONENTS_SUBSET_SING = prove + (`!s:real^N->bool. connected s <=> components s SUBSET {s}`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN + REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN + ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING]);; + +let CONNECTED_EQ_COMPONENTS_SUBSET_SING_EXISTS = prove + (`!s:real^N->bool. connected s <=> ?a. components s SUBSET {a}`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[COMPONENTS_EMPTY; CONNECTED_EMPTY; EMPTY_SUBSET] THEN + REWRITE_TAC[SET_RULE `s SUBSET {a} <=> s = {} \/ s = {a}`] THEN + ASM_REWRITE_TAC[COMPONENTS_EQ_EMPTY; COMPONENTS_EQ_SING_EXISTS]);; + +let IN_COMPONENTS_SELF = prove + (`!s:real^N->bool. s IN components s <=> connected s /\ ~(s = {})`, + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[IN_COMPONENTS_NONEMPTY; IN_COMPONENTS_CONNECTED]; + SIMP_TAC[GSYM COMPONENTS_EQ_SING; IN_SING]]);; + +let COMPONENTS_MAXIMAL = prove + (`!s t c:real^N->bool. + c IN components s /\ connected t /\ t SUBSET s /\ ~(c INTER t = {}) + ==> t SUBSET c`, + REWRITE_TAC[IMP_CONJ; components; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_INTER; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP CONNECTED_COMPONENT_EQ) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN ASM_REWRITE_TAC[]);; + +let COMPONENTS_UNIQUE = prove + (`!s:real^N->bool k. + UNIONS k = s /\ + (!c. c IN k + ==> connected c /\ ~(c = {}) /\ + !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c) + ==> components s = k`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `c:real^N->bool` THEN REWRITE_TAC[IN_COMPONENTS] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real^N` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [EXTENSION]) THEN + REWRITE_TAC[IN_UNIONS] THEN ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `connected_component s (x:real^N) = c` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC CONNECTED_COMPONENT_UNIQUE THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `c':real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[SET_RULE `c' SUBSET c <=> c' UNION c = c`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_UNION; ASM SET_TAC[]] THEN + ASM SET_TAC[]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; CONV_TAC SYM_CONV] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT; CONNECTED_COMPONENT_SUBSET] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]);; + +let COMPONENTS_UNIQUE_EQ = prove + (`!s:real^N->bool k. + components s = k <=> + UNIONS k = s /\ + (!c. c IN k + ==> connected c /\ ~(c = {}) /\ + !c'. connected c' /\ c SUBSET c' /\ c' SUBSET s ==> c' = c)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM); REWRITE_TAC[COMPONENTS_UNIQUE]] THEN + REWRITE_TAC[GSYM UNIONS_COMPONENTS] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[IN_COMPONENTS_CONNECTED]; + ASM_MESON_TAC[IN_COMPONENTS_NONEMPTY]; + RULE_ASSUM_TAC(REWRITE_RULE[IN_COMPONENTS_MAXIMAL]) THEN + ASM_MESON_TAC[SUBSET_EMPTY]]);; + +let EXISTS_COMPONENT_SUPERSET = prove + (`!s t:real^N->bool. + t SUBSET s /\ ~(s = {}) /\ connected t + ==> ?c. c IN components s /\ t SUBSET c`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[EMPTY_SUBSET] THEN + ASM_MESON_TAC[COMPONENTS_EQ_EMPTY; MEMBER_NOT_EMPTY]; + FIRST_X_ASSUM(X_CHOOSE_TAC `a:real^N` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `connected_component s (a:real^N)` THEN + REWRITE_TAC[IN_COMPONENTS] THEN CONJ_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[CONNECTED_COMPONENT_MAXIMAL]]]);; + +let COMPONENTS_INTERMEDIATE_SUBSET = prove + (`!s t u:real^N->bool. + s IN components u /\ s SUBSET t /\ t SUBSET u + ==> s IN components t`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_COMPONENTS; LEFT_AND_EXISTS_THM] THEN + MESON_TAC[CONNECTED_COMPONENT_INTERMEDIATE_SUBSET; SUBSET; + CONNECTED_COMPONENT_REFL; IN; CONNECTED_COMPONENT_SUBSET]);; + +let IN_COMPONENTS_UNIONS_COMPLEMENT = prove + (`!s c:real^N->bool. + c IN components s + ==> s DIFF c = UNIONS(components s DELETE c)`, + REWRITE_TAC[components; FORALL_IN_GSPEC; + COMPLEMENT_CONNECTED_COMPONENT_UNIONS]);; + +let CONNECTED_SUBSET_CLOPEN = prove + (`!u s c:real^N->bool. + closed_in (subtopology euclidean u) s /\ + open_in (subtopology euclidean u) s /\ + connected c /\ c SUBSET u /\ ~(c INTER s = {}) + ==> c SUBSET s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CONNECTED_CLOSED_IN]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o + SPECL [`c INTER s:real^N->bool`; `c DIFF s:real^N->bool`]) THEN + ASM_REWRITE_TAC[CONJ_ASSOC; SET_RULE `c DIFF s = {} <=> c SUBSET s`] THEN + MATCH_MP_TAC(TAUT `p ==> ~(p /\ ~q) ==> q`) THEN + REPLICATE_TAC 2 (CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]]) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]); + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_IN_OPEN])] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real^N->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[OPEN_IN_OPEN; CLOSED_IN_CLOSED] THENL + [EXISTS_TAC `t:real^N->bool`; EXISTS_TAC `(:real^N) DIFF t`] THEN + ASM_REWRITE_TAC[GSYM OPEN_CLOSED] THEN ASM SET_TAC[]);; + +let CLOPEN_UNIONS_COMPONENTS = prove + (`!u s:real^N->bool. + closed_in (subtopology euclidean u) s /\ + open_in (subtopology euclidean u) s + ==> ?k. k SUBSET components u /\ s = UNIONS k`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `{c:real^N->bool | c IN components u /\ ~(c INTER s = {})}` THEN + REWRITE_TAC[SUBSET_RESTRICT] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THENL + [MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN SET_TAC[]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONNECTED_SUBSET_CLOPEN THEN + EXISTS_TAC `u:real^N->bool` THEN + ASM_MESON_TAC[IN_COMPONENTS_CONNECTED; IN_COMPONENTS_SUBSET]]);; + +let CLOPEN_IN_COMPONENTS = prove + (`!u s:real^N->bool. + closed_in (subtopology euclidean u) s /\ + open_in (subtopology euclidean u) s /\ + connected s /\ ~(s = {}) + ==> s IN components u`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOPEN_UNIONS_COMPONENTS) THEN + DISCH_THEN(X_CHOOSE_THEN `k:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `k:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[UNIONS_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N->bool`) THEN + ASM_CASES_TAC `k = {c:real^N->bool}` THENL + [ASM_MESON_TAC[UNIONS_1; GSYM SING_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `~p ==> p /\ q ==> r`) THEN + SUBGOAL_THEN `?c':real^N->bool. c' IN k /\ ~(c = c')` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SET_RULE + `a IN s /\ ~(s = {a}) ==> ?b. b IN s /\ ~(b = a)`]; + REWRITE_TAC[CONNECTED_EQ_CONNECTED_COMPONENTS_EQ] THEN + DISCH_THEN(MP_TAC o SPECL [`c:real^N->bool`; `c':real^N->bool`]) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THEN + MATCH_MP_TAC COMPONENTS_INTERMEDIATE_SUBSET THEN + EXISTS_TAC `u:real^N->bool` THEN + MP_TAC(ISPEC `u:real^N->bool` UNIONS_COMPONENTS) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity implies uniform continuity on a compact domain. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_UNIFORMLY_EQUICONTINUOUS = prove + (`!(fs:(real^M->real^N)->bool) s. + (!x e. x IN s /\ &0 < e + ==> ?d. &0 < d /\ + (!f x'. f IN fs /\ x' IN s /\ dist (x',x) < d + ==> dist (f x',f x) < e)) /\ + compact s + ==> !e. &0 < e + ==> ?d. &0 < d /\ + !f x x'. f IN fs /\ x IN s /\ x' IN s /\ dist (x',x) < d + ==> dist(f x',f x) < e`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `d:real^M->real->real` THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN + DISCH_THEN(MP_TAC o SPEC + `{ ball(x:real^M,d x (e / &2)) | x IN s}`) THEN + SIMP_TAC[FORALL_IN_GSPEC; OPEN_BALL; UNIONS_GSPEC; SUBSET; IN_ELIM_THM] THEN + ANTS_TAC THENL [ASM_MESON_TAC[CENTRE_IN_BALL; REAL_HALF]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:real` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `u:real^M`; `v:real^M`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `v:real^M` th) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CHOOSE_THEN MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `u:real^M` th) THEN MP_TAC(SPEC `v:real^M` th)) THEN + ASM_REWRITE_TAC[DIST_REFL] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `w:real^M` (CONJUNCTS_THEN2 ASSUME_TAC + SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL] THEN ASM_REWRITE_TAC[IN_BALL] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`w:real^M`; `e / &2`]) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(MP_TAC o SPEC `f:real^M->real^N` o CONJUNCT2) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `u:real^M` th) THEN + MP_TAC(SPEC `v:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH);; + +let COMPACT_UNIFORMLY_CONTINUOUS = prove + (`!f:real^M->real^N s. + f continuous_on s /\ compact s ==> f uniformly_continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous_on; uniformly_continuous_on] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`{f:real^M->real^N}`; `s:real^M->bool`] + COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; IN_SING; FORALL_UNWIND_THM2] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A uniformly convergent limit of continuous functions is continuous. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_UNIFORM_LIMIT = prove + (`!net f:A->real^M->real^N g s. + ~(trivial_limit net) /\ + eventually (\n. (f n) continuous_on s) net /\ + (!e. &0 < e + ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) net) + ==> g continuous_on s`, + REWRITE_TAC[continuous_on] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `x:real^M` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM EVENTUALLY_AND]) THEN + DISCH_THEN(MP_TAC o MATCH_MP EVENTUALLY_HAPPENS) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `a:A` THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `x:real^M`) ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:real` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^M` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^M` th) THEN MP_TAC(SPEC `y:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(REAL_ARITH + `w <= x + y + z + ==> x < e / &3 ==> y < e / &3 ==> z < e / &3 ==> w < e`) THEN + REWRITE_TAC[dist] THEN + SUBST1_TAC(VECTOR_ARITH + `(g:real^M->real^N) y - g x = + --(f (a:A) y - g y) + (f a x - g x) + (f a y - f a x)`) THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_LADD] THEN + MATCH_MP_TAC NORM_TRIANGLE_LE THEN REWRITE_TAC[NORM_NEG; REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Topological stuff lifted from and dropped to R *) +(* ------------------------------------------------------------------------- *) + +let OPEN_LIFT = prove + (`!s. open(IMAGE lift s) <=> + !x. x IN s ==> ?e. &0 < e /\ !x'. abs(x' - x) < e ==> x' IN s`, + REWRITE_TAC[open_def; FORALL_LIFT; LIFT_IN_IMAGE_LIFT; DIST_LIFT]);; + +let LIMPT_APPROACHABLE_LIFT = prove + (`!x s. (lift x) limit_point_of (IMAGE lift s) <=> + !e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e`, + REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_LIFT; LIFT_IN_IMAGE_LIFT; + LIFT_EQ; DIST_LIFT]);; + +let CLOSED_LIFT = prove + (`!s. closed (IMAGE lift s) <=> + !x. (!e. &0 < e ==> ?x'. x' IN s /\ ~(x' = x) /\ abs(x' - x) < e) + ==> x IN s`, + GEN_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN + ONCE_REWRITE_TAC[FORALL_LIFT] THEN + REWRITE_TAC[LIMPT_APPROACHABLE_LIFT; LIFT_EQ; DIST_LIFT; + EXISTS_LIFT; LIFT_IN_IMAGE_LIFT]);; + +let CONTINUOUS_AT_LIFT_RANGE = prove + (`!f x. (lift o f) continuous (at x) <=> + !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. norm(x' - x) < d + ==> abs(f x' - f x) < e)`, + REWRITE_TAC[continuous_at; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; + +let CONTINUOUS_ON_LIFT_RANGE = prove + (`!f s. (lift o f) continuous_on s <=> + !x. x IN s + ==> !e. &0 < e + ==> ?d. &0 < d /\ + (!x'. x' IN s /\ norm(x' - x) < d + ==> abs(f x' - f x) < e)`, + REWRITE_TAC[continuous_on; o_THM; DIST_LIFT] THEN REWRITE_TAC[dist]);; + +let CONTINUOUS_LIFT_NORM_COMPOSE = prove + (`!net f:A->real^N. + f continuous net + ==> (\x. lift(norm(f x))) continuous net`, + REPEAT GEN_TAC THEN REWRITE_TAC[continuous; tendsto] THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN MATCH_MP_TAC MONO_IMP THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + NORM_ARITH_TAC);; + +let CONTINUOUS_ON_LIFT_NORM_COMPOSE = prove + (`!f:real^M->real^N s. + f continuous_on s + ==> (\x. lift(norm(f x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_NORM_COMPOSE]);; + +let CONTINUOUS_AT_LIFT_NORM = prove + (`!x. (lift o norm) continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE; NORM_LIFT] THEN + MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_LIFT_NORM = prove + (`!s. (lift o norm) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE; NORM_LIFT] THEN + MESON_TAC[REAL_ABS_SUB_NORM; REAL_LET_TRANS]);; + +let CONTINUOUS_AT_LIFT_COMPONENT = prove + (`!i a. 1 <= i /\ i <= dimindex(:N) + ==> (\x:real^N. lift(x$i)) continuous (at a)`, + SIMP_TAC[continuous_at; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; + +let CONTINUOUS_ON_LIFT_COMPONENT = prove + (`!i s. 1 <= i /\ i <= dimindex(:N) + ==> (\x:real^N. lift(x$i)) continuous_on s`, + SIMP_TAC[continuous_on; DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN + MESON_TAC[dist; REAL_LET_TRANS; COMPONENT_LE_NORM]);; + +let CONTINUOUS_AT_LIFT_INFNORM = prove + (`!x:real^N. (lift o infnorm) continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT; LIM_AT; o_THM; DIST_LIFT] THEN + MESON_TAC[REAL_LET_TRANS; dist; REAL_ABS_SUB_INFNORM; INFNORM_LE_NORM]);; + +let CONTINUOUS_AT_LIFT_DIST = prove + (`!a:real^N x. (lift o (\x. dist(a,x))) continuous (at x)`, + REWRITE_TAC[CONTINUOUS_AT_LIFT_RANGE] THEN + MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; + REAL_LET_TRANS]);; + +let CONTINUOUS_ON_LIFT_DIST = prove + (`!a s. (lift o (\x. dist(a,x))) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN + MESON_TAC[NORM_ARITH `abs(dist(a:real^N,x) - dist(a,y)) <= norm(x - y)`; + REAL_LET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence some handy theorems on distance, diameter etc. of/from a set. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_ATTAINS_SUP = prove + (`!s. compact (IMAGE lift s) /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> y <= x`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_SUP) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN EXISTS_TAC `sup s` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s <= s - e <=> ~(&0 < e)`; + REAL_ARITH `x <= s /\ ~(x <= s - e) ==> abs(x - s) < e`]);; + +let COMPACT_ATTAINS_INF = prove + (`!s. compact (IMAGE lift s) /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> x <= y`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPEC `s:real->bool` BOUNDED_HAS_INF) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN EXISTS_TAC `inf s` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CLOSED_LIFT; REAL_ARITH `s + e <= s <=> ~(&0 < e)`; + REAL_ARITH `s <= x /\ ~(s + e <= x) ==> abs(x - s) < e`]);; + +let CONTINUOUS_ATTAINS_SUP = prove + (`!f:real^N->real s. + compact s /\ ~(s = {}) /\ (lift o f) continuous_on s + ==> ?x. x IN s /\ !y. y IN s ==> f(y) <= f(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_SUP) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN + MESON_TAC[IN_IMAGE]);; + +let CONTINUOUS_ATTAINS_INF = prove + (`!f:real^N->real s. + compact s /\ ~(s = {}) /\ (lift o f) continuous_on s + ==> ?x. x IN s /\ !y. y IN s ==> f(x) <= f(y)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `IMAGE (f:real^N->real) s` COMPACT_ATTAINS_INF) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; COMPACT_CONTINUOUS_IMAGE; IMAGE_EQ_EMPTY] THEN + MESON_TAC[IN_IMAGE]);; + +let DISTANCE_ATTAINS_SUP = prove + (`!s a. compact s /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> dist(a,y) <= dist(a,x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ATTAINS_SUP THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_LIFT_RANGE] THEN REWRITE_TAC[dist] THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; + VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]);; + +(* ------------------------------------------------------------------------- *) +(* For *minimal* distance, we only need closure, not compactness. *) +(* ------------------------------------------------------------------------- *) + +let DISTANCE_ATTAINS_INF = prove + (`!s a:real^N. + closed s /\ ~(s = {}) + ==> ?x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real^N`) THEN + MP_TAC(ISPECL [`\x:real^N. dist(a,x)`; `cball(a:real^N,dist(b,a)) INTER s`] + CONTINUOUS_ATTAINS_INF) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_INTER; BOUNDED_INTER; + BOUNDED_CBALL; CLOSED_CBALL; GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[dist; CONTINUOUS_ON_LIFT_RANGE; IN_INTER; IN_CBALL] THEN + ASM_MESON_TAC[REAL_LET_TRANS; REAL_ABS_SUB_NORM; NORM_NEG; REAL_LE_REFL; + NORM_SUB; VECTOR_ARITH `(a - x) - (a - y) = --(x - y):real^N`]; + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[IN_INTER; IN_CBALL] THEN + ASM_MESON_TAC[DIST_SYM; REAL_LE_TOTAL; REAL_LE_TRANS]]);; + +(* ------------------------------------------------------------------------- *) +(* We can now extend limit compositions to consider the scalar multiplier. *) +(* ------------------------------------------------------------------------- *) + +let LIM_MUL = prove + (`!net:(A)net f l:real^N c d. + ((lift o c) --> lift d) net /\ (f --> l) net + ==> ((\x. c(x) % f(x)) --> (d % l)) net`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`net:(A)net`; `\x (y:real^N). drop x % y`; + `lift o (c:A->real)`; `f:A->real^N`; `lift d`; `l:real^N`] LIM_BILINEAR) THEN + ASM_REWRITE_TAC[LIFT_DROP; o_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let LIM_VMUL = prove + (`!net:(A)net c d v:real^N. + ((lift o c) --> lift d) net ==> ((\x. c(x) % v) --> d % v) net`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_MUL THEN ASM_REWRITE_TAC[LIM_CONST]);; + +let CONTINUOUS_VMUL = prove + (`!net c v. (lift o c) continuous net ==> (\x. c(x) % v) continuous net`, + REWRITE_TAC[continuous; LIM_VMUL; o_THM]);; + +let CONTINUOUS_MUL = prove + (`!net f c. (lift o c) continuous net /\ f continuous net + ==> (\x. c(x) % f(x)) continuous net`, + REWRITE_TAC[continuous; LIM_MUL; o_THM]);; + +let CONTINUOUS_ON_VMUL = prove + (`!s c v. (lift o c) continuous_on s ==> (\x. c(x) % v) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_VMUL]);; + +let CONTINUOUS_ON_MUL = prove + (`!s c f. (lift o c) continuous_on s /\ f continuous_on s + ==> (\x. c(x) % f(x)) continuous_on s`, + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + SIMP_TAC[CONTINUOUS_MUL]);; + +let CONTINUOUS_LIFT_POW = prove + (`!net f:A->real n. + (\x. lift(f x)) continuous net + ==> (\x. lift(f x pow n)) continuous net`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_CONST] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN ASM_REWRITE_TAC[o_DEF]);; + +let CONTINUOUS_ON_LIFT_POW = prove + (`!f:real^N->real s n. + (\x. lift(f x)) continuous_on s + ==> (\x. lift(f x pow n)) continuous_on s`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[LIFT_CMUL; real_pow; CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN ASM_REWRITE_TAC[o_DEF]);; + +let CONTINUOUS_LIFT_PRODUCT = prove + (`!net:(A)net f (t:B->bool). + FINITE t /\ + (!i. i IN t ==> (\x. lift(f x i)) continuous net) + ==> (\x. lift(product t (f x))) continuous net`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[PRODUCT_CLAUSES] THEN + REWRITE_TAC[CONTINUOUS_CONST; LIFT_CMUL; FORALL_IN_INSERT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + ASM_SIMP_TAC[o_DEF]);; + +let CONTINUOUS_ON_LIFT_PRODUCT = prove + (`!f:real^N->A->real s t. + FINITE t /\ + + (!i. i IN t ==> (\x. lift(f x i)) continuous_on s) + ==> (\x. lift(product t (f x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_PRODUCT]);; + +(* ------------------------------------------------------------------------- *) +(* And so we have continuity of inverse. *) +(* ------------------------------------------------------------------------- *) + +let LIM_INV = prove + (`!net:(A)net f l. + ((lift o f) --> lift l) net /\ ~(l = &0) + ==> ((lift o inv o f) --> lift(inv l)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[o_THM; DIST_LIFT] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min (abs(l) / &2) ((l pow 2 * e) / &2)`) THEN + REWRITE_TAC[REAL_LT_MIN] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + ASM_SIMP_TAC[REAL_LT_MUL; GSYM REAL_ABS_NZ; REAL_POW_LT]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:A` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `b:A` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + SIMP_TAC[REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; ARITH] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP (REAL_ARITH + `abs(x - l) * &2 < abs l ==> ~(x = &0)`)) THEN + ASM_SIMP_TAC[REAL_SUB_INV; REAL_ABS_DIV; REAL_LT_LDIV_EQ; + GSYM REAL_ABS_NZ; REAL_ENTIRE] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `abs(x - y) * &2 < b * c ==> c * b <= d * &2 ==> abs(y - x) < d`)) THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_LE_LMUL_EQ] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_POW_2; REAL_MUL_ASSOC; GSYM REAL_ABS_NZ; + REAL_LE_RMUL_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `abs(x - y) * &2 < abs y ==> abs y <= &2 * abs x`]);; + +let CONTINUOUS_INV = prove + (`!net f. (lift o f) continuous net /\ ~(f(netlimit net) = &0) + ==> (lift o inv o f) continuous net`, + REWRITE_TAC[continuous; LIM_INV; o_THM]);; + +let CONTINUOUS_AT_WITHIN_INV = prove + (`!f s a:real^N. + (lift o f) continuous (at a within s) /\ ~(f a = &0) + ==> (lift o inv o f) continuous (at a within s)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `trivial_limit (at (a:real^N) within s)` THENL + [ASM_REWRITE_TAC[continuous; LIM]; + ASM_SIMP_TAC[NETLIMIT_WITHIN; CONTINUOUS_INV]]);; + +let CONTINUOUS_AT_INV = prove + (`!f a. (lift o f) continuous at a /\ ~(f a = &0) + ==> (lift o inv o f) continuous at a`, + ONCE_REWRITE_TAC[GSYM WITHIN_UNIV] THEN + REWRITE_TAC[CONTINUOUS_AT_WITHIN_INV]);; + +let CONTINUOUS_ON_INV = prove + (`!f s. (lift o f) continuous_on s /\ (!x. x IN s ==> ~(f x = &0)) + ==> (lift o inv o f) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_AT_WITHIN_INV]);; + +(* ------------------------------------------------------------------------- *) +(* More preservation properties for pasted sets (Cartesian products). *) +(* ------------------------------------------------------------------------- *) + +let LIM_PASTECART = prove + (`!net f:A->real^M g:A->real^N. + (f --> a) net /\ (g --> b) net + ==> ((\x. pastecart (f x) (g x)) --> pastecart a b) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIM] THEN + ASM_CASES_TAC `trivial_limit(net:(A)net)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[AND_FORALL_THM] THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(MP_TAC o MATCH_MP NET_DILEMMA) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN MATCH_MP_TAC MONO_AND THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + REWRITE_TAC[dist; PASTECART_SUB] THEN + MATCH_MP_TAC(REAL_ARITH + `z <= x + y ==> x < e / &2 /\ y < e / &2 ==> z < e`) THEN + REWRITE_TAC[NORM_PASTECART_LE]);; + +let LIM_PASTECART_EQ = prove + (`!net f:A->real^M g:A->real^N. + ((\x. pastecart (f x) (g x)) --> pastecart a b) net <=> + (f --> a) net /\ (g --> b) net`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[LIM_PASTECART] THEN + REPEAT STRIP_TAC THENL + [FIRST_ASSUM(MP_TAC o ISPEC `fstcart:real^(M,N)finite_sum->real^M` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN + REWRITE_TAC[LINEAR_FSTCART; FSTCART_PASTECART; ETA_AX]; + FIRST_ASSUM(MP_TAC o ISPEC `sndcart:real^(M,N)finite_sum->real^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ] LIM_LINEAR)) THEN + REWRITE_TAC[LINEAR_SNDCART; SNDCART_PASTECART; ETA_AX]]);; + +let CONTINUOUS_PASTECART = prove + (`!net f:A->real^M g:A->real^N. + f continuous net /\ g continuous net + ==> (\x. pastecart (f x) (g x)) continuous net`, + REWRITE_TAC[continuous; LIM_PASTECART]);; + +let CONTINUOUS_ON_PASTECART = prove + (`!f:real^M->real^N g:real^M->real^P s. + f continuous_on s /\ g continuous_on s + ==> (\x. pastecart (f x) (g x)) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON; LIM_PASTECART]);; + +let CONNECTED_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + connected s /\ connected t + ==> connected (s PCROSS t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[PCROSS; CONNECTED_IFF_CONNECTED_COMPONENT] THEN + DISCH_TAC THEN REWRITE_TAC[FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + MAP_EVERY X_GEN_TAC [`x1:real^M`; `y1:real^N`; `x2:real^M`; `y2:real^N`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`x1:real^M`; `x2:real^M`]) + (MP_TAC o SPECL [`y1:real^N`; `y2:real^N`])) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; connected_component] THEN + X_GEN_TAC `c2:real^N->bool` THEN STRIP_TAC THEN + X_GEN_TAC `c1:real^M->bool` THEN STRIP_TAC THEN + EXISTS_TAC + `IMAGE (\x:real^M. pastecart x y1) c1 UNION + IMAGE (\y:real^N. pastecart x2 y) c2` THEN + REWRITE_TAC[IN_UNION] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_UNION THEN + ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE; CONTINUOUS_ON_PASTECART; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER; EXISTS_IN_IMAGE] THEN + EXISTS_TAC `x2:real^M` THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; IN_UNION; FORALL_AND_THM; FORALL_IN_IMAGE; + TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + ASM SET_TAC[]; + ASM SET_TAC[]; + ASM SET_TAC[]]);; + +let CONNECTED_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + connected (s PCROSS t) <=> + s = {} \/ t = {} \/ connected s /\ connected t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + REWRITE_TAC[PCROSS_EMPTY; CONNECTED_EMPTY] THEN + EQ_TAC THEN SIMP_TAC[CONNECTED_PCROSS] THEN + REWRITE_TAC[PCROSS] THEN REPEAT STRIP_TAC THENL + [SUBGOAL_THEN `connected (IMAGE fstcart + {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` + MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]; + SUBGOAL_THEN `connected (IMAGE sndcart + {pastecart (x:real^M) (y:real^N) | x IN s /\ y IN t})` + MP_TAC THENL [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE; ALL_TAC]] THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; LINEAR_SNDCART] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PASTECART; IN_ELIM_PASTECART_THM; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let CLOSURE_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + closure (s PCROSS t) = (closure s) PCROSS (closure t)`, + REWRITE_TAC[EXTENSION; PCROSS; FORALL_PASTECART] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; EXISTS_PASTECART; FORALL_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[dist; PASTECART_SUB] THEN EQ_TAC THENL + [MESON_TAC[NORM_LE_PASTECART; REAL_LET_TRANS]; DISCH_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN + ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH + `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; + +let LIMPT_PCROSS = prove + (`!s:real^M->bool t:real^N->bool x y. + x limit_point_of s /\ y limit_point_of t + ==> (pastecart x y) limit_point_of (s PCROSS t)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[PCROSS; LIMPT_APPROACHABLE; EXISTS_PASTECART] THEN + REWRITE_TAC[IN_ELIM_PASTECART_THM; PASTECART_INJ; dist; PASTECART_SUB] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN (MP_TAC o SPEC `e / &2`)) THEN + ASM_MESON_TAC[REAL_HALF; NORM_PASTECART_LE; REAL_ARITH + `z <= x + y /\ x < e / &2 /\ y < e / &2 ==> z < e`]);; + +let CLOSED_IN_PCROSS = prove + (`!s:real^M->bool s' t:real^N->bool t'. + closed_in (subtopology euclidean s) s' /\ + closed_in (subtopology euclidean t) t' + ==> closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_CLOSED] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `s'':real^M->bool` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `t'':real^N->bool` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(s'':real^M->bool) PCROSS (t'':real^N->bool)` THEN + ASM_SIMP_TAC[CLOSED_PCROSS; EXTENSION; FORALL_PASTECART] THEN + REWRITE_TAC[IN_INTER; PASTECART_IN_PCROSS] THEN ASM SET_TAC[]);; + +let CLOSED_IN_PCROSS_EQ = prove + (`!s s':real^M->bool t t':real^N->bool. + closed_in (subtopology euclidean (s PCROSS t)) (s' PCROSS t') <=> + s' = {} \/ t' = {} \/ + closed_in (subtopology euclidean s) s' /\ + closed_in (subtopology euclidean t) t'`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s':real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN + ASM_CASES_TAC `t':real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; CLOSED_IN_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[CLOSED_IN_PCROSS] THEN + ASM_REWRITE_TAC[CLOSED_IN_INTER_CLOSURE; CLOSURE_PCROSS; INTER_PCROSS; + PCROSS_EQ; PCROSS_EQ_EMPTY]);; + +let FRONTIER_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + frontier(s PCROSS t) = frontier s PCROSS closure t UNION + closure s PCROSS frontier t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[frontier; CLOSURE_PCROSS; INTERIOR_PCROSS; PCROSS_DIFF] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; IN_UNION; + PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence some useful properties follow quite easily. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_SCALING = prove + (`!s:real^N->bool c. connected s ==> connected (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let CONNECTED_NEGATIONS = prove + (`!s:real^N->bool. connected s ==> connected (IMAGE (--) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let CONNECTED_SUMS = prove + (`!s t:real^N->bool. + connected s /\ connected t ==> connected {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CONNECTED_PCROSS) THEN + DISCH_THEN(MP_TAC o ISPEC + `\z. (fstcart z + sndcart z:real^N)` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] CONNECTED_CONTINUOUS_IMAGE)) THEN + SIMP_TAC[CONTINUOUS_ON_ADD; LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; + LINEAR_SNDCART; PCROSS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART] THEN + REWRITE_TAC[PASTECART_INJ; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MESON_TAC[]);; + +let COMPACT_SCALING = prove + (`!s:real^N->bool c. compact s ==> compact (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let COMPACT_NEGATIONS = prove + (`!s:real^N->bool. compact s ==> compact (IMAGE (--) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let COMPACT_SUMS = prove + (`!s:real^N->bool t. + compact s /\ compact t ==> compact {x + y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x + y | x IN s /\ y IN t} = + IMAGE (\z. fstcart z + sndcart z :real^N) (s PCROSS t)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; PCROSS] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_FST_SND]; + ALL_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[COMPACT_PCROSS] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[linear; FSTCART_ADD; FSTCART_CMUL; SNDCART_ADD; + SNDCART_CMUL] THEN + CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let COMPACT_DIFFERENCES = prove + (`!s:real^N->bool t. + compact s /\ compact t ==> compact {x - y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = + {x + y | x IN s /\ y IN (IMAGE (--) t)}` + (fun th -> ASM_SIMP_TAC[th; COMPACT_SUMS; COMPACT_NEGATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN + SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN + MESON_TAC[VECTOR_NEG_NEG]);; + +let COMPACT_AFFINITY = prove + (`!s a:real^N c. + compact s ==> compact (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + ASM_SIMP_TAC[IMAGE_o; COMPACT_TRANSLATION; COMPACT_SCALING]);; + +(* ------------------------------------------------------------------------- *) +(* Hence we get the following. *) +(* ------------------------------------------------------------------------- *) + +let COMPACT_SUP_MAXDISTANCE = prove + (`!s:real^N->bool. + compact s /\ ~(s = {}) + ==> ?x y. x IN s /\ y IN s /\ + !u v. u IN s /\ v IN s ==> norm(u - v) <= norm(x - y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN s}`; `vec 0:real^N`] + DISTANCE_ATTAINS_SUP) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[COMPACT_DIFFERENCES] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_RZERO; VECTOR_SUB_LZERO; + NORM_NEG] THEN + MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* We can state this in terms of diameter of a set. *) +(* ------------------------------------------------------------------------- *) + +let diameter = new_definition + `diameter s = + if s = {} then &0 + else sup {norm(x - y) | x IN s /\ y IN s}`;; + +let DIAMETER_BOUNDED = prove + (`!s. bounded s + ==> (!x:real^N y. x IN s /\ y IN s ==> norm(x - y) <= diameter s) /\ + (!d. &0 <= d /\ d < diameter s + ==> ?x y. x IN s /\ y IN s /\ norm(x - y) > d)`, + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[diameter; NOT_IN_EMPTY; REAL_LET_ANTISYM] THEN + MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN + ABBREV_TAC `b = sup {norm(x - y:real^N) | x IN s /\ y IN s}` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[NOT_IN_EMPTY; real_gt] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC]; + MESON_TAC[REAL_NOT_LE]] THEN + SIMP_TAC[VECTOR_SUB; LEFT_IMP_EXISTS_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [bounded]) THEN + MESON_TAC[REAL_ARITH `x <= y + z /\ y <= b /\ z<= b ==> x <= b + b`; + NORM_TRIANGLE; NORM_NEG]);; + +let DIAMETER_BOUNDED_BOUND = prove + (`!s x y. bounded s /\ x IN s /\ y IN s ==> norm(x - y) <= diameter s`, + MESON_TAC[DIAMETER_BOUNDED]);; + +let DIAMETER_COMPACT_ATTAINED = prove + (`!s:real^N->bool. + compact s /\ ~(s = {}) + ==> ?x y. x IN s /\ y IN s /\ (norm(x - y) = diameter s)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_SUP_MAXDISTANCE) THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `s:real^N->bool` DIAMETER_BOUNDED) THEN + RULE_ASSUM_TAC(REWRITE_RULE[COMPACT_EQ_BOUNDED_CLOSED]) THEN + ASM_REWRITE_TAC[real_gt] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_MESON_TAC[NORM_POS_LE; REAL_NOT_LT]);; + +let DIAMETER_TRANSLATION = prove + (`!a s. diameter (IMAGE (\x. a + x) s) = diameter s`, + REWRITE_TAC[diameter] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [DIAMETER_TRANSLATION];; + +let DIAMETER_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x. norm(f x) = norm x) + ==> diameter(IMAGE f s) = diameter s`, + REWRITE_TAC[diameter] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[diameter; IMAGE_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; EXISTS_IN_IMAGE] THEN + ASM_MESON_TAC[LINEAR_SUB]);; + +add_linear_invariants [DIAMETER_LINEAR_IMAGE];; + +let DIAMETER_EMPTY = prove + (`diameter {} = &0`, + REWRITE_TAC[diameter]);; + +let DIAMETER_SING = prove + (`!a. diameter {a} = &0`, + REWRITE_TAC[diameter; NOT_INSERT_EMPTY; IN_SING] THEN + REWRITE_TAC[SET_RULE `{f x y | x = a /\ y = a} = {f a a }`] THEN + REWRITE_TAC[SUP_SING; VECTOR_SUB_REFL; NORM_0]);; + +let DIAMETER_POS_LE = prove + (`!s:real^N->bool. bounded s ==> &0 <= diameter s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[diameter] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + MP_TAC(SPEC `{norm(x - y:real^N) | x IN s /\ y IN s}` SUP) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + EXISTS_TAC `&2 * B` THEN + ASM_SIMP_TAC[NORM_ARITH + `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real^N`; `a:real^N`] o CONJUNCT1) THEN + ASM_REWRITE_TAC[VECTOR_SUB_REFL; NORM_0]]);; + +let DIAMETER_SUBSET = prove + (`!s t:real^N->bool. s SUBSET t /\ bounded t ==> diameter s <= diameter t`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[DIAMETER_EMPTY; DIAMETER_POS_LE] THEN + ASM_REWRITE_TAC[diameter] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + EXISTS_TAC `&2 * B` THEN + ASM_SIMP_TAC[NORM_ARITH + `norm x <= B /\ norm y <= B ==> norm(x - y) <= &2 * B`]);; + +let DIAMETER_CLOSURE = prove + (`!s:real^N->bool. bounded s ==> diameter(closure s) = diameter s`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[DIAMETER_SUBSET; BOUNDED_CLOSURE; CLOSURE_SUBSET] THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + DISCH_TAC THEN MP_TAC(ISPEC `closure s:real^N->bool` DIAMETER_BOUNDED) THEN + ABBREV_TAC `d = diameter(closure s) - diameter(s:real^N->bool)` THEN + ASM_SIMP_TAC[BOUNDED_CLOSURE] THEN DISCH_THEN(MP_TAC o + SPEC `diameter(closure(s:real^N->bool)) - d / &2` o CONJUNCT2) THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; NOT_EXISTS_THM] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DIAMETER_POS_LE) THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; CONJ_ASSOC; AND_FORALL_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (MP_TAC o SPEC `d / &4`) ASSUME_TAC) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < d / &4 <=> &0 < d`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) + (X_CHOOSE_THEN `v:real^N` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIAMETER_BOUNDED) THEN + DISCH_THEN(MP_TAC o SPECL [`u:real^N`; `v:real^N`] o CONJUNCT1) THEN + ASM_REWRITE_TAC[] THEN REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let DIAMETER_SUBSET_CBALL_NONEMPTY = prove + (`!s:real^N->bool. + bounded s /\ ~(s = {}) ==> ?z. z IN s /\ s SUBSET cball(z,diameter s)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + DISCH_TAC THEN ASM_REWRITE_TAC[SUBSET] THEN X_GEN_TAC `b:real^N` THEN + DISCH_TAC THEN REWRITE_TAC[IN_CBALL; dist] THEN + ASM_MESON_TAC[DIAMETER_BOUNDED]);; + +let DIAMETER_SUBSET_CBALL = prove + (`!s:real^N->bool. bounded s ==> ?z. s SUBSET cball(z,diameter s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_MESON_TAC[DIAMETER_SUBSET_CBALL_NONEMPTY; EMPTY_SUBSET]);; + +let DIAMETER_EQ_0 = prove + (`!s:real^N->bool. + bounded s ==> (diameter s = &0 <=> s = {} \/ ?a. s = {a})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[DIAMETER_EMPTY; DIAMETER_SING] THEN + REWRITE_TAC[SET_RULE + `s = {} \/ (?a. s = {a}) <=> !a b. a IN s /\ b IN s ==> a = b`] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`; `b:real^N`] + DIAMETER_BOUNDED_BOUND) THEN + ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let DIAMETER_LE = prove + (`!s:real^N->bool. + (~(s = {}) \/ &0 <= d) /\ + (!x y. x IN s /\ y IN s ==> norm(x - y) <= d) ==> diameter s <= d`, + GEN_TAC THEN REWRITE_TAC[diameter] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN + CONJ_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[FORALL_IN_GSPEC]]);; + +let DIAMETER_CBALL = prove + (`!a:real^N r. diameter(cball(a,r)) = if r < &0 then &0 else &2 * r`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_MESON_TAC[CBALL_EQ_EMPTY; DIAMETER_EMPTY]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_NOT_LT]) THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC DIAMETER_LE THEN + ASM_SIMP_TAC[CBALL_EQ_EMPTY; REAL_LE_MUL; REAL_POS; REAL_NOT_LT] THEN + REWRITE_TAC[IN_CBALL] THEN NORM_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm((a + r % basis 1) - (a - r % basis 1):real^N)` THEN + CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `(a + r % b) - (a - r % b:real^N) = + (&2 * r) % b`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC DIAMETER_BOUNDED_BOUND THEN + REWRITE_TAC[BOUNDED_CBALL; IN_CBALL] THEN + REWRITE_TAC[NORM_ARITH + `dist(a:real^N,a + b) = norm b /\ dist(a,a - b) = norm b`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC]]);; + +let DIAMETER_BALL = prove + (`!a:real^N r. diameter(ball(a,r)) = if r < &0 then &0 else &2 * r`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC[BALL_EMPTY; REAL_LT_IMP_LE; DIAMETER_EMPTY]; ALL_TAC] THEN + ASM_CASES_TAC `r = &0` THEN + ASM_SIMP_TAC[BALL_EMPTY; REAL_LE_REFL; DIAMETER_EMPTY; REAL_MUL_RZERO] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `diameter(cball(a:real^N,r))` THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 < r` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM CLOSURE_BALL; DIAMETER_CLOSURE; BOUNDED_BALL]; + ASM_SIMP_TAC[DIAMETER_CBALL]]);; + +let DIAMETER_SUMS = prove + (`!s t:real^N->bool. + bounded s /\ bounded t + ==> diameter {x + y | x IN s /\ y IN t} <= diameter s + diameter t`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; + DIAMETER_EMPTY; REAL_ADD_LID; DIAMETER_POS_LE] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{f x y |x,y| F} = {}`; + DIAMETER_EMPTY; REAL_ADD_RID; DIAMETER_POS_LE] THEN + MATCH_MP_TAC DIAMETER_LE THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ; FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(NORM_ARITH + `norm(x - x') <= s /\ norm(y - y') <= t + ==> norm((x + y) - (x' + y'):real^N) <= s + t`) THEN + ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND]);; + +let LEBESGUE_COVERING_LEMMA = prove + (`!s:real^N->bool c. + compact s /\ ~(c = {}) /\ s SUBSET UNIONS c /\ (!b. b IN c ==> open b) + ==> ?d. &0 < d /\ + !t. t SUBSET s /\ diameter t <= d + ==> ?b. b IN c /\ t SUBSET b`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HEINE_BOREL_LEMMA) THEN + DISCH_THEN(MP_TAC o SPEC `c:(real^N->bool)->bool`) THEN ASM_SIMP_TAC[] THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN EXISTS_TAC `e / &2` THEN ASM_REWRITE_TAC[REAL_HALF] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `t:real^N->bool` DIAMETER_SUBSET_CBALL_NONEMPTY) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[BOUNDED_SUBSET; COMPACT_IMP_BOUNDED]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `b:real^N->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `cball(x:real^N,diameter(t:real^N->bool))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `ball(x:real^N,e)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_CBALL; IN_BALL] THEN + MAP_EVERY UNDISCH_TAC [`&0 < e`; `diameter(t:real^N->bool) <= e / &2`] THEN + NORM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Related results with closure as the conclusion. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_SCALING = prove + (`!s:real^N->bool c. closed s ==> closed (IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s :real^N->bool = {}` THEN + ASM_REWRITE_TAC[CLOSED_EMPTY; IMAGE_CLAUSES] THEN + ASM_CASES_TAC `c = &0` THENL + [SUBGOAL_THEN `IMAGE (\x:real^N. c % x) s = {(vec 0)}` + (fun th -> REWRITE_TAC[th; CLOSED_SING]) THEN + ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING; VECTOR_MUL_LZERO] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]; + ALL_TAC] THEN + REWRITE_TAC[CLOSED_SEQUENTIAL_LIMITS; IN_IMAGE; SKOLEM_THM] THEN + STRIP_TAC THEN X_GEN_TAC `x:num->real^N` THEN X_GEN_TAC `l:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `y:num->real^N` MP_TAC) THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN + EXISTS_TAC `inv(c) % l :real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `\n:num. inv(c) % x n:real^N` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; VECTOR_MUL_LID]; + MATCH_MP_TAC LIM_CMUL THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[SYM(SPEC_ALL th)]) THEN + ASM_REWRITE_TAC[ETA_AX]]);; + +let CLOSED_NEGATIONS = prove + (`!s:real^N->bool. closed s ==> closed (IMAGE (--) s)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x:real^N. --(&1) % x) s` + SUBST1_TAC THEN SIMP_TAC[CLOSED_SCALING] THEN + REWRITE_TAC[VECTOR_ARITH `--(&1) % x = --x`] THEN REWRITE_TAC[ETA_AX]);; + +let COMPACT_CLOSED_SUMS = prove + (`!s:real^N->bool t. + compact s /\ closed t ==> closed {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[compact; IN_ELIM_THM; CLOSED_SEQUENTIAL_LIMITS] THEN + STRIP_TAC THEN X_GEN_TAC `f:num->real^N` THEN X_GEN_TAC `l:real^N` THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check(is_imp o concl) o SPEC `a:num->real^N`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `la:real^N` (X_CHOOSE_THEN `sub:num->num` + STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`la:real^N`; `l - la:real^N`] THEN + ASM_REWRITE_TAC[VECTOR_ARITH `a + (b - a) = b:real^N`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `\n. (f o (sub:num->num)) n - (a o sub) n:real^N` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[VECTOR_ADD_SUB; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC LIM_SUB THEN ASM_SIMP_TAC[LIM_SUBSEQUENCE; ETA_AX]);; + +let CLOSED_COMPACT_SUMS = prove + (`!s:real^N->bool t. + closed s /\ compact t ==> closed {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `{x + y:real^N | x IN s /\ y IN t} = {y + x | y IN t /\ x IN s}` + SUBST1_TAC THEN SIMP_TAC[COMPACT_CLOSED_SUMS] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[VECTOR_ADD_SYM]);; + +let CLOSURE_SUMS = prove + (`!s t:real^N->bool. + bounded s \/ bounded t + ==> closure {x + y | x IN s /\ y IN t} = + {x + y | x IN closure s /\ y IN closure t}`, + REWRITE_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SUMS_SYM] THEN + MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN + SIMP_TAC[] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; CLOSURE_SEQUENTIAL] THEN + X_GEN_TAC `z:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; IN_DELETE; SKOLEM_THM; LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ r <=> q /\ p /\ r`] THEN + ONCE_REWRITE_TAC[MESON[] `(?f x y. P f x y) <=> (?x y f. P f x y)`] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[ETA_AX; UNWIND_THM2] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num->real^N`; `b:num->real^N`] THEN + STRIP_TAC THEN + MP_TAC(ISPEC `closure s:real^N->bool` compact) THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE] THEN + DISCH_THEN(MP_TAC o SPEC `a:num->real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^N`; `r:num->num`] THEN STRIP_TAC THEN + EXISTS_TAC `z - u:real^N` THEN + EXISTS_TAC `(a:num->real^N) o (r:num->num)` THEN EXISTS_TAC `u:real^N` THEN + ASM_REWRITE_TAC[o_THM] THEN + CONJ_TAC THENL [ALL_TAC; VECTOR_ARITH_TAC] THEN + EXISTS_TAC `(\n. ((\n. a n + b n) o (r:num->num)) n - (a o r) n) + :num->real^N` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[o_DEF; VECTOR_ARITH `(a + b) - a:real^N = b`]; + MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC LIM_SUBSEQUENCE THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`x:real^N`; `y:real^N`; `a:num->real^N`; `b:num->real^N`] THEN + STRIP_TAC THEN EXISTS_TAC `(\n. a n + b n):num->real^N` THEN + ASM_SIMP_TAC[LIM_ADD] THEN ASM_MESON_TAC[]]);; + +let COMPACT_CLOSED_DIFFERENCES = prove + (`!s:real^N->bool t. + compact s /\ closed t ==> closed {x - y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = + {x + y | x IN s /\ y IN (IMAGE (--) t)}` + (fun th -> ASM_SIMP_TAC[th; COMPACT_CLOSED_SUMS; CLOSED_NEGATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN + SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN + MESON_TAC[VECTOR_NEG_NEG]);; + +let CLOSED_COMPACT_DIFFERENCES = prove + (`!s:real^N->bool t. + closed s /\ compact t ==> closed {x - y | x IN s /\ y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x - y | x:real^N IN s /\ y IN t} = + {x + y | x IN s /\ y IN (IMAGE (--) t)}` + (fun th -> ASM_SIMP_TAC[th; CLOSED_COMPACT_SUMS; COMPACT_NEGATIONS]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `(x:real^N = --y) <=> (y = --x)`] THEN + SIMP_TAC[VECTOR_SUB; GSYM CONJ_ASSOC; UNWIND_THM2] THEN + MESON_TAC[VECTOR_NEG_NEG]);; + +let CLOSED_TRANSLATION_EQ = prove + (`!a s. closed (IMAGE (\x:real^N. a + x) s) <=> closed s`, + REWRITE_TAC[closed] THEN GEOM_TRANSLATE_TAC[]);; + +let CLOSED_TRANSLATION = prove + (`!s a:real^N. closed s ==> closed (IMAGE (\x. a + x) s)`, + REWRITE_TAC[CLOSED_TRANSLATION_EQ]);; + +add_translation_invariants [CLOSED_TRANSLATION_EQ];; + +let COMPLETE_TRANSLATION_EQ = prove + (`!a s. complete(IMAGE (\x:real^N. a + x) s) <=> complete s`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_TRANSLATION_EQ]);; + +add_translation_invariants [COMPLETE_TRANSLATION_EQ];; + +let TRANSLATION_UNIV = prove + (`!a. IMAGE (\x. a + x) (:real^N) = (:real^N)`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN GEOM_TRANSLATE_TAC[]);; + +let TRANSLATION_DIFF = prove + (`!s t:real^N->bool. + IMAGE (\x. a + x) (s DIFF t) = + (IMAGE (\x. a + x) s) DIFF (IMAGE (\x. a + x) t)`, + REWRITE_TAC[EXTENSION; IN_DIFF; IN_IMAGE] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `x:real^N = a + y <=> y = x - a`] THEN + REWRITE_TAC[UNWIND_THM2]);; + +let CLOSURE_TRANSLATION = prove + (`!a s. closure(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (closure s)`, + REWRITE_TAC[CLOSURE_INTERIOR] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [CLOSURE_TRANSLATION];; + +let FRONTIER_TRANSLATION = prove + (`!a s. frontier(IMAGE (\x:real^N. a + x) s) = IMAGE (\x. a + x) (frontier s)`, + REWRITE_TAC[frontier] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [FRONTIER_TRANSLATION];; + +(* ------------------------------------------------------------------------- *) +(* Separation between points and sets. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATE_POINT_CLOSED = prove + (`!s a:real^N. + closed s /\ ~(a IN s) + ==> ?d. &0 < d /\ !x. x IN s ==> d <= dist(a,x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; REAL_LT_01]; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N`] DISTANCE_ATTAINS_INF) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `b:real^N` THEN + STRIP_TAC THEN EXISTS_TAC `dist(a:real^N,b)` THEN + ASM_MESON_TAC[DIST_POS_LT]);; + +let SEPARATE_COMPACT_CLOSED = prove + (`!s t:real^N->bool. + compact s /\ closed t /\ s INTER t = {} + ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] + SEPARATE_POINT_CLOSED) THEN + ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `vec 0 = x - y <=> x = y`] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + MESON_TAC[NORM_ARITH `dist(vec 0,x - y) = dist(x,y)`]);; + +let SEPARATE_CLOSED_COMPACT = prove + (`!s t:real^N->bool. + closed s /\ compact t /\ s INTER t = {} + ==> ?d. &0 < d /\ !x y. x IN s /\ y IN t ==> d <= dist(x,y)`, + ONCE_REWRITE_TAC[DIST_SYM; INTER_COMM] THEN + MESON_TAC[SEPARATE_COMPACT_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* Representing sets as the union of a chain of compact sets. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_UNION_COMPACT_SUBSETS = prove + (`!s. closed s + ==> ?f:num->real^N->bool. + (!n. compact(f n)) /\ + (!n. (f n) SUBSET s) /\ + (!n. (f n) SUBSET f(n + 1)) /\ + UNIONS {f n | n IN (:num)} = s /\ + (!k. compact k /\ k SUBSET s + ==> ?N. !n. n >= N ==> k SUBSET (f n))`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\n. s INTER cball(vec 0:real^N,&n)` THEN + ASM_SIMP_TAC[INTER_SUBSET; COMPACT_CBALL; CLOSED_INTER_COMPACT] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `t SUBSET u ==> s INTER t SUBSET s INTER u`) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_INTER] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_CBALL_0] THEN + MESON_TAC[REAL_ARCH_SIMPLE]; + X_GEN_TAC `k:real^N->bool` THEN SIMP_TAC[SUBSET_INTER] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN DISCH_THEN + (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_CBALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `r:real` REAL_ARCH_SIMPLE) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_OF_NUM_GE] THEN + + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC]);; + +let OPEN_UNION_COMPACT_SUBSETS = prove + (`!s. open s + ==> ?f:num->real^N->bool. + (!n. compact(f n)) /\ + (!n. (f n) SUBSET s) /\ + (!n. (f n) SUBSET interior(f(n + 1))) /\ + UNIONS {f n | n IN (:num)} = s /\ + (!k. compact k /\ k SUBSET s + ==> ?N. !n. n >= N ==> k SUBSET (f n))`, + GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THENL + [DISCH_TAC THEN EXISTS_TAC `(\n. {}):num->real^N->bool` THEN + ASM_SIMP_TAC[EMPTY_SUBSET; SUBSET_EMPTY; COMPACT_EMPTY] THEN + REWRITE_TAC[EXTENSION; UNIONS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN STRIP_TAC] THEN + MATCH_MP_TAC(MESON[] + `(!f. p1 f /\ p3 f /\ p4 f ==> p5 f) /\ + (?f. p1 f /\ p2 f /\ p3 f /\ (p2 f ==> p4 f)) + ==> ?f. p1 f /\ p2 f /\ p3 f /\ p4 f /\ p5 f`) THEN + CONJ_TAC THENL + [X_GEN_TAC `f:num->real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + X_GEN_TAC `k:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `{interior(f n):real^N->bool | n IN (:num)}`) THEN + REWRITE_TAC[FORALL_IN_GSPEC; OPEN_INTERIOR] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM] THEN ASM SET_TAC[]; + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[SIMPLE_IMAGE; EXISTS_FINITE_SUBSET_IMAGE] THEN + REWRITE_TAC[SUBSET_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num->bool` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `\n:num. n` o + MATCH_MP UPPER_BOUND_FINITE_SET) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[GE] THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + SUBSET_TRANS)) THEN + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `(f:num->real^N->bool) m` THEN + REWRITE_TAC[INTERIOR_SUBSET] THEN + SUBGOAL_THEN `!m n. m <= n ==> (f:num->real^N->bool) m SUBSET f n` + (fun th -> ASM_MESON_TAC[th; LE_TRANS]) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_MESON_TAC[SUBSET; ADD1; INTERIOR_SUBSET]]; + EXISTS_TAC + `\n. cball(a,&n) DIFF + {x + e | x IN (:real^N) DIFF s /\ e IN ball(vec 0,inv(&n + &1))}` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN MATCH_MP_TAC COMPACT_DIFF THEN + SIMP_TAC[COMPACT_CBALL; OPEN_SUMS; OPEN_BALL]; + GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `(UNIV DIFF s) SUBSET t ==> c DIFF t SUBSET s`) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`x:real^N`; `vec 0:real^N`] THEN + ASM_REWRITE_TAC[VECTOR_ADD_RID; CENTRE_IN_BALL; REAL_LT_INV_EQ] THEN + REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[INTERIOR_DIFF] THEN MATCH_MP_TAC(SET_RULE + `s SUBSET s' /\ t' SUBSET t ==> (s DIFF t) SUBSET (s' DIFF t')`) THEN + CONJ_TAC THENL + [REWRITE_TAC[INTERIOR_CBALL; SUBSET; IN_BALL; IN_CBALL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{x + e | x IN (:real^N) DIFF s /\ + e IN cball(vec 0,inv(&n + &2))}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN + ASM_SIMP_TAC[CLOSED_COMPACT_SUMS; COMPACT_CBALL; + GSYM OPEN_CLOSED] THEN + MATCH_MP_TAC(SET_RULE + `t SUBSET t' + ==> {f x y | x IN s /\ y IN t} SUBSET + {f x y | x IN s /\ y IN t'}`) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(SET_RULE + `t SUBSET t' + ==> {f x y | x IN s /\ y IN t} SUBSET + {f x y | x IN s /\ y IN t'}`) THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_CBALL; GSYM REAL_OF_NUM_ADD] THEN + GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH + `a < b ==> x <= a ==> x < b`) THEN + MATCH_MP_TAC REAL_LT_INV2 THEN REAL_ARITH_TAC]]; + DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_DIFF] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV; IN_BALL_0] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = y + e <=> e = x - y`] THEN + REWRITE_TAC[TAUT `(p /\ q) /\ r <=> r /\ p /\ q`; UNWIND_THM2] THEN + REWRITE_TAC[MESON[] `~(?x. ~P x /\ Q x) <=> !x. Q x ==> P x`] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[SUBSET; IN_BALL; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `norm(x - a:real^N)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN EXISTS_TAC `N1 + N2:num` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_CBALL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + UNDISCH_TAC `norm(x - a:real^N) <= &N2` THEN + REWRITE_TAC[dist; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN `inv(&(N1 + N2) + &1) <= inv(&N1)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Closed-graph characterization of continuity. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_CLOSED_GRAPH_GEN = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s SUBSET t + ==> closed_in (subtopology euclidean (s PCROSS t)) + {pastecart x (f x) | x IN s}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{pastecart (x:real^M) (f x:real^N) | x IN s} = + {z | z IN s PCROSS t /\ f(fstcart z) - sndcart z IN {vec 0}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; IN_SING; + PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + PASTECART_INJ; VECTOR_SUB_EQ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + REWRITE_TAC[CLOSED_SING] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + SIMP_TAC[GSYM o_DEF; LINEAR_CONTINUOUS_ON; LINEAR_SNDCART] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_FSTCART; IMAGE_FSTCART_PCROSS] THEN + ASM_MESON_TAC[CONTINUOUS_ON_EMPTY]]);; + +let CONTINUOUS_CLOSED_GRAPH_EQ = prove + (`!f:real^M->real^N s t. + compact t /\ IMAGE f s SUBSET t + ==> (f continuous_on s <=> + closed_in (subtopology euclidean (s PCROSS t)) + {pastecart x (f x) | x IN s})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_GRAPH_GEN] THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP CONTINUOUS_ON_CLOSED_GEN th]) THEN + X_GEN_TAC `c:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:real^M->real^N) x IN c} = + IMAGE fstcart ({pastecart x (f x) | x IN s} INTER + (s PCROSS c))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; EXISTS_PASTECART; + FSTCART_PASTECART; IN_INTER; IN_ELIM_PASTECART_THM; + PASTECART_IN_PCROSS; PASTECART_INJ] THEN + ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_MAP_FSTCART THEN EXISTS_TAC `t:real^N->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_INTER THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CLOSED_IN_PCROSS THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL]]);; + +let CONTINUOUS_CLOSED_GRAPH = prove + (`!f:real^M->real^N s. + closed s /\ f continuous_on s ==> closed {pastecart x (f x) | x IN s}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `(s:real^M->bool) PCROSS (:real^N)` THEN + ASM_SIMP_TAC[CLOSED_PCROSS; CLOSED_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_GRAPH_GEN THEN + ASM_REWRITE_TAC[SUBSET_UNIV]);; + +let CONTINUOUS_FROM_CLOSED_GRAPH = prove + (`!f:real^M->real^N s t. + compact t /\ IMAGE f s SUBSET t /\ + closed {pastecart x (f x) | x IN s} + ==> f continuous_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP CONTINUOUS_CLOSED_GRAPH_EQ) THEN + MATCH_MP_TAC CLOSED_SUBSET THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* A cute way of denoting open and closed intervals using overloading. *) +(* ------------------------------------------------------------------------- *) + +let open_interval = new_definition + `open_interval(a:real^N,b:real^N) = + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i < x$i /\ x$i < b$i}`;; + +let closed_interval = new_definition + `closed_interval(l:(real^N#real^N)list) = + {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> FST(HD l)$i <= x$i /\ x$i <= SND(HD l)$i}`;; + +make_overloadable "interval" `:A`;; + +overload_interface("interval",`open_interval`);; +overload_interface("interval",`closed_interval`);; + +let interval = prove + (`(interval (a,b) = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i < x$i /\ x$i < b$i}) /\ + (interval [a,b] = {x:real^N | !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i <= x$i /\ x$i <= b$i})`, + REWRITE_TAC[open_interval; closed_interval; HD; FST; SND]);; + +let IN_INTERVAL = prove + (`(!x:real^N. + x IN interval (a,b) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i < x$i /\ x$i < b$i) /\ + (!x:real^N. + x IN interval [a,b] <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> a$i <= x$i /\ x$i <= b$i)`, + REWRITE_TAC[interval; IN_ELIM_THM]);; + +let IN_INTERVAL_REFLECT = prove + (`(!a b x. (--x) IN interval[--b,--a] <=> x IN interval[a,b]) /\ + (!a b x. (--x) IN interval(--b,--a) <=> x IN interval(a,b))`, + SIMP_TAC[IN_INTERVAL; REAL_LT_NEG2; REAL_LE_NEG2; VECTOR_NEG_COMPONENT] THEN + MESON_TAC[]);; + +let REFLECT_INTERVAL = prove + (`(!a b:real^N. IMAGE (--) (interval[a,b]) = interval[--b,--a]) /\ + (!a b:real^N. IMAGE (--) (interval(a,b)) = interval(--b,--a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_INTERVAL_REFLECT] THEN MESON_TAC[VECTOR_NEG_NEG]);; + +let INTERVAL_EQ_EMPTY = prove + (`((interval [a:real^N,b] = {}) <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i < a$i) /\ + ((interval (a:real^N,b) = {}) <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ b$i <= a$i)`, + REWRITE_TAC[EXTENSION; IN_INTERVAL; NOT_IN_EMPTY] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; GSYM CONJ_ASSOC] THEN + CONJ_TAC THEN EQ_TAC THENL + [MESON_TAC[REAL_LE_REFL; REAL_NOT_LE]; + MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE]; + ALL_TAC; + MESON_TAC[REAL_LT_TRANS; REAL_NOT_LT]] THEN + SUBGOAL_THEN `!a b. ?c. a < b ==> a < c /\ c < b` + (MP_TAC o REWRITE_RULE[SKOLEM_THM]) THENL + [MESON_TAC[REAL_LT_BETWEEN]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `mid:real->real->real`) THEN + DISCH_THEN(MP_TAC o SPEC + `(lambda i. mid ((a:real^N)$i) ((b:real^N)$i)):real^N`) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> ~(a /\ b ==> ~c)`] THEN + SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[REAL_NOT_LT]);; + +let INTERVAL_NE_EMPTY = prove + (`(~(interval [a:real^N,b] = {}) <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= b$i) /\ + (~(interval (a:real^N,b) = {}) <=> + !i. 1 <= i /\ i <= dimindex(:N) ==> a$i < b$i)`, + REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN MESON_TAC[REAL_NOT_LE]);; + +let SUBSET_INTERVAL_IMP = prove + (`((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) + ==> interval[c,d] SUBSET interval[a:real^N,b]) /\ + ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i) + ==> interval[c,d] SUBSET interval(a:real^N,b)) /\ + ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) + ==> interval(c,d) SUBSET interval[a:real^N,b]) /\ + ((!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i) + ==> interval(c,d) SUBSET interval(a:real^N,b))`, + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN REPEAT CONJ_TAC THEN + DISCH_TAC THEN GEN_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let INTERVAL_SING = prove + (`interval[a,a] = {a} /\ interval(a,a) = {}`, + REWRITE_TAC[EXTENSION; IN_SING; NOT_IN_EMPTY; IN_INTERVAL] THEN + REWRITE_TAC[REAL_LE_ANTISYM; REAL_LT_ANTISYM; CART_EQ; EQ_SYM_EQ] THEN + MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; + +let SUBSET_INTERVAL = prove + (`(interval[c,d] SUBSET interval[a:real^N,b] <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ + (interval[c,d] SUBSET interval(a:real^N,b) <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i <= d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i < c$i /\ d$i < b$i)) /\ + (interval(c,d) SUBSET interval[a:real^N,b] <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i)) /\ + (interval(c,d) SUBSET interval(a:real^N,b) <=> + (!i. 1 <= i /\ i <= dimindex(:N) ==> c$i < d$i) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> a$i <= c$i /\ d$i <= b$i))`, + let lemma = prove + (`(!x:real^N. (!i. 1 <= i /\ i <= dimindex(:N) ==> Q i (x$i)) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> R i (x$i))) + ==> (!i. 1 <= i /\ i <= dimindex(:N) ==> ?y. Q i y) + ==> !i y. 1 <= i /\ i <= dimindex(:N) /\ Q i y ==> R i y`, + DISCH_TAC THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real` STRIP_ASSUME_TAC) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o + SPEC `(lambda j. if j = i then y else f j):real^N`) THEN + SIMP_TAC[LAMBDA_BETA] THEN ASM_MESON_TAC[]) in + REPEAT STRIP_TAC THEN + (MATCH_MP_TAC(TAUT + `(~q ==> p) /\ (q ==> (p <=> r)) ==> (p <=> q ==> r)`) THEN + CONJ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC(SET_RULE `s = {} ==> s SUBSET t`) THEN + REWRITE_TAC[INTERVAL_EQ_EMPTY] THEN ASM_MESON_TAC[REAL_NOT_LT]; + ALL_TAC] THEN + DISCH_TAC THEN EQ_TAC THEN REWRITE_TAC[SUBSET_INTERVAL_IMP] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN + DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN ANTS_TAC THENL + [ASM_MESON_TAC[REAL_LT_BETWEEN; REAL_LE_BETWEEN]; ALL_TAC] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN STRIP_TAC) + THENL + [ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_REFL]; + ALL_TAC; ALL_TAC] THEN + (REPEAT STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC + `((c:real^N)$i + min ((a:real^N)$i) ((d:real^N)$i)) / &2`) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC + `(max ((b:real^N)$i) ((c:real^N)$i) + (d:real^N)$i) / &2`) THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]));; + +let DISJOINT_INTERVAL = prove + (`!a b c d:real^N. + (interval[a,b] INTER interval[c,d] = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i < a$i \/ d$i < c$i \/ b$i < c$i \/ d$i < a$i)) /\ + (interval[a,b] INTER interval(c,d) = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i < a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ + (interval(a,b) INTER interval[c,d] = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i <= a$i \/ d$i < c$i \/ b$i <= c$i \/ d$i <= a$i)) /\ + (interval(a,b) INTER interval(c,d) = {} <=> + ?i. 1 <= i /\ i <= dimindex(:N) /\ + (b$i <= a$i \/ d$i <= c$i \/ b$i <= c$i \/ d$i <= a$i))`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL; NOT_IN_EMPTY] THEN + REWRITE_TAC[AND_FORALL_THM; NOT_FORALL_THM] THEN + REWRITE_TAC[TAUT `~((p ==> q) /\ (p ==> r)) <=> p /\ (~q \/ ~r)`] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + (EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC + `(lambda i. (max ((a:real^N)$i) ((c:real^N)$i) + + min ((b:real^N)$i) ((d:real^N)$i)) / &2):real^N`) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC; + DISCH_THEN(fun th -> GEN_TAC THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[] THEN + REAL_ARITH_TAC]));; + +let ENDS_IN_INTERVAL = prove + (`(!a b. a IN interval[a,b] <=> ~(interval[a,b] = {})) /\ + (!a b. b IN interval[a,b] <=> ~(interval[a,b] = {})) /\ + (!a b. ~(a IN interval(a,b))) /\ + (!a b. ~(b IN interval(a,b)))`, + REWRITE_TAC[IN_INTERVAL; INTERVAL_NE_EMPTY] THEN + REWRITE_TAC[REAL_LE_REFL; REAL_LT_REFL] THEN + MESON_TAC[DIMINDEX_GE_1; LE_REFL]);; + +let ENDS_IN_UNIT_INTERVAL = prove + (`vec 0 IN interval[vec 0,vec 1] /\ + vec 1 IN interval[vec 0,vec 1] /\ + ~(vec 0 IN interval(vec 0,vec 1)) /\ + ~(vec 1 IN interval(vec 0,vec 1))`, + REWRITE_TAC[ENDS_IN_INTERVAL; INTERVAL_NE_EMPTY; VEC_COMPONENT] THEN + REWRITE_TAC[REAL_POS]);; + +let INTER_INTERVAL = prove + (`interval[a,b] INTER interval[c,d] = + interval[(lambda i. max (a$i) (c$i)),(lambda i. min (b$i) (d$i))]`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL] THEN + SIMP_TAC[LAMBDA_BETA; REAL_MAX_LE; REAL_LE_MIN] THEN MESON_TAC[]);; + +let INTERVAL_OPEN_SUBSET_CLOSED = prove + (`!a b. interval(a,b) SUBSET interval[a,b]`, + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN MESON_TAC[REAL_LT_IMP_LE]);; + +let OPEN_INTERVAL_LEMMA = prove + (`!a b x. a < x /\ x < b + ==> ?d. &0 < d /\ !x'. abs(x' - x) < d ==> a < x' /\ x' < b`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `min (x - a) (b - x)` THEN REWRITE_TAC[REAL_LT_MIN] THEN + ASM_REAL_ARITH_TAC);; + +let OPEN_INTERVAL = prove + (`!a:real^N b. open(interval (a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_def; interval; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?d. &0 < d /\ + !x'. abs(x' - (x:real^N)$i) < d + ==> (a:real^N)$i < x' /\ x' < (b:real^N)$i` + MP_TAC THENL [ASM_SIMP_TAC[OPEN_INTERVAL_LEMMA]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inf (IMAGE d (1..dimindex(:N)))` THEN + SIMP_TAC[REAL_LT_INF_FINITE; FINITE_IMAGE; FINITE_NUMSEG; + IMAGE_EQ_EMPTY; NOT_INSERT_EMPTY; NUMSEG_EMPTY; + ARITH_RULE `n < 1 <=> (n = 0)`; DIMINDEX_NONZERO] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG; dist] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LET_TRANS; VECTOR_SUB_COMPONENT]);; + +let CLOSED_INTERVAL = prove + (`!a:real^N b. closed(interval [a,b])`, + REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE; IN_INTERVAL] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `(a:real^N)$i - (x:real^N)$i`); + FIRST_X_ASSUM(MP_TAC o SPEC `(x:real^N)$i - (b:real^N)$i`)] THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` MP_TAC) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[dist; REAL_NOT_LT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((z - x :real^N)$i)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT] THEN + ASM_SIMP_TAC[REAL_ARITH `x < a /\ a <= z ==> a - x <= abs(z - x)`; + REAL_ARITH `z <= b /\ b < x ==> x - b <= abs(z - x)`]);; + +let INTERIOR_CLOSED_INTERVAL = prove + (`!a:real^N b. interior(interval [a,b]) = interval (a,b)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC INTERIOR_MAXIMAL THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; OPEN_INTERVAL]] THEN + REWRITE_TAC[interior; SUBSET; IN_INTERVAL; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(X_CHOOSE_THEN `s:real^N->bool` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LT_LE] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_def]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THENL + [(let t = `x - (e / &2) % basis i :real^N` in + DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t)); + (let t = `x + (e / &2) % basis i :real^N` in + DISCH_THEN(MP_TAC o SPEC t) THEN FIRST_X_ASSUM(MP_TAC o SPEC t))] THEN + REWRITE_TAC[dist; VECTOR_ADD_SUB; VECTOR_ARITH `x - y - x = --y:real^N`] THEN + ASM_SIMP_TAC[NORM_MUL; NORM_BASIS; NORM_NEG; REAL_MUL_RID; + REAL_ARITH `&0 < e ==> abs(e / &2) < e`] THEN + MATCH_MP_TAC(TAUT `~b ==> (a ==> b) ==> ~a`) THEN + REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `i:num` THEN + ASM_SIMP_TAC[DE_MORGAN_THM; VECTOR_SUB_COMPONENT; VECTOR_ADD_COMPONENT] THENL + [DISJ1_TAC THEN REWRITE_TAC[REAL_ARITH `a <= a - b <=> ~(&0 < b)`]; + DISJ2_TAC THEN REWRITE_TAC[REAL_ARITH `a + b <= a <=> ~(&0 < b)`]] THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; basis; LAMBDA_BETA; REAL_MUL_RID] THEN + ASM_REWRITE_TAC[REAL_HALF]);; + +let INTERIOR_INTERVAL = prove + (`(!a b. interior(interval[a,b]) = interval(a,b)) /\ + (!a b. interior(interval(a,b)) = interval(a,b))`, + SIMP_TAC[INTERIOR_CLOSED_INTERVAL; INTERIOR_OPEN; OPEN_INTERVAL]);; + +let BOUNDED_CLOSED_INTERVAL = prove + (`!a b:real^N. bounded (interval [a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[bounded; interval] THEN + EXISTS_TAC `sum(1..dimindex(:N)) + (\i. abs((a:real^N)$i) + abs((b:real^N)$i))` THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_ARITH + `a <= x /\ x <= b ==> abs(x) <= abs(a) + abs(b)`]);; + +let BOUNDED_INTERVAL = prove + (`(!a b. bounded (interval [a,b])) /\ (!a b. bounded (interval (a,b)))`, + MESON_TAC[BOUNDED_CLOSED_INTERVAL; BOUNDED_SUBSET; + INTERVAL_OPEN_SUBSET_CLOSED]);; + +let NOT_INTERVAL_UNIV = prove + (`(!a b. ~(interval[a,b] = UNIV)) /\ + (!a b. ~(interval(a,b) = UNIV))`, + MESON_TAC[BOUNDED_INTERVAL; NOT_BOUNDED_UNIV]);; + +let COMPACT_INTERVAL = prove + (`!a b. compact (interval [a,b])`, + SIMP_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_INTERVAL; CLOSED_INTERVAL]);; + +let OPEN_INTERVAL_MIDPOINT = prove + (`!a b:real^N. + ~(interval(a,b) = {}) ==> (inv(&2) % (a + b)) IN interval(a,b)`, + REWRITE_TAC[INTERVAL_NE_EMPTY; IN_INTERVAL] THEN + SIMP_TAC[VECTOR_MUL_COMPONENT; VECTOR_ADD_COMPONENT] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let OPEN_CLOSED_INTERVAL_CONVEX = prove + (`!a b x y:real^N e. + x IN interval(a,b) /\ y IN interval[a,b] /\ &0 < e /\ e <= &1 + ==> (e % x + (&1 - e) % y) IN interval(a,b)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(c /\ d ==> a /\ b ==> e) ==> a /\ b /\ c /\ d ==> e`) THEN + STRIP_TAC THEN REWRITE_TAC[IN_INTERVAL; AND_FORALL_THM] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBST1_TAC(REAL_ARITH `(a:real^N)$i = e * a$i + (&1 - e) * a$i`) THEN + SUBST1_TAC(REAL_ARITH `(b:real^N)$i = e * b$i + (&1 - e) * b$i`) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LTE_ADD2 THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL; REAL_SUB_LE]);; + +let CLOSURE_OPEN_INTERVAL = prove + (`!a b:real^N. + ~(interval(a,b) = {}) ==> closure(interval(a,b)) = interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL THEN + REWRITE_TAC[INTERVAL_OPEN_SUBSET_CLOSED; CLOSED_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; closure; IN_UNION] THEN X_GEN_TAC `x:real^N` THEN + DISCH_TAC THEN MATCH_MP_TAC(TAUT `(~b ==> c) ==> b \/ c`) THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM; LIMPT_SEQUENTIAL] THEN + ABBREV_TAC `(c:real^N) = inv(&2) % (a + b)` THEN + EXISTS_TAC `\n. (x:real^N) + inv(&n + &1) % (c - x)` THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DELETE] THEN + REWRITE_TAC[VECTOR_ARITH `x + a = x <=> a = vec 0`] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; REAL_INV_EQ_0] THEN + REWRITE_TAC[VECTOR_SUB_EQ; REAL_ARITH `~(&n + &1 = &0)`] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]] THEN + REWRITE_TAC[VECTOR_ARITH `x + a % (y - x) = a % y + (&1 - a) % x`] THEN + MATCH_MP_TAC OPEN_CLOSED_INTERVAL_CONVEX THEN + CONJ_TAC THENL [ASM_MESON_TAC[OPEN_INTERVAL_MIDPOINT]; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_LT_INV_EQ; REAL_ARITH `&0 < &n + &1`] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [VECTOR_ARITH `x:real^N = x + &0 % (c - x)`] THEN + MATCH_MP_TAC LIM_ADD THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC LIM_VMUL THEN REWRITE_TAC[LIM_CONST] THEN + REWRITE_TAC[LIM_SEQUENTIALLY; o_THM; DIST_LIFT; REAL_SUB_RZERO] THEN + X_GEN_TAC `e:real` THEN GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `inv(&N)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN UNDISCH_TAC `N:num <= n` THEN + UNDISCH_TAC `~(N = 0)` THEN + REWRITE_TAC[GSYM LT_NZ; GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_LT] THEN + REAL_ARITH_TAC);; + +let CLOSURE_INTERVAL = prove + (`(!a b. closure(interval[a,b]) = interval[a,b]) /\ + (!a b. closure(interval(a,b)) = + if interval(a,b) = {} then {} else interval[a,b])`, + SIMP_TAC[CLOSURE_CLOSED; CLOSED_INTERVAL] THEN REPEAT GEN_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[CLOSURE_OPEN_INTERVAL; CLOSURE_EMPTY]);; + +let BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC = prove + (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval(--a,a)`, + REWRITE_TAC[BOUNDED_POS; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`s:real^N->bool`; `B:real`] THEN STRIP_TAC THEN + EXISTS_TAC `(lambda i. B + &1):real^N` THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; REAL_BOUNDS_LT; VECTOR_NEG_COMPONENT] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; + REAL_ARITH `x <= y ==> a <= x ==> a < y + &1`]);; + +let BOUNDED_SUBSET_OPEN_INTERVAL = prove + (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval(a,b)`, + MESON_TAC[BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC]);; + +let BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC = prove + (`!s:real^N->bool. bounded s ==> ?a. s SUBSET interval[--a,a]`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP BOUNDED_SUBSET_OPEN_INTERVAL_SYMMETRIC) THEN + MATCH_MP_TAC MONO_EXISTS THEN + SIMP_TAC[IN_BALL; IN_INTERVAL; SUBSET; REAL_LT_IMP_LE]);; + +let BOUNDED_SUBSET_CLOSED_INTERVAL = prove + (`!s:real^N->bool. bounded s ==> ?a b. s SUBSET interval[a,b]`, + MESON_TAC[BOUNDED_SUBSET_CLOSED_INTERVAL_SYMMETRIC]);; + +let FRONTIER_CLOSED_INTERVAL = prove + (`!a b. frontier(interval[a,b]) = interval[a,b] DIFF interval(a,b)`, + SIMP_TAC[frontier; INTERIOR_CLOSED_INTERVAL; CLOSURE_CLOSED; + CLOSED_INTERVAL]);; + +let FRONTIER_OPEN_INTERVAL = prove + (`!a b. frontier(interval(a,b)) = + if interval(a,b) = {} then {} + else interval[a,b] DIFF interval(a,b)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[FRONTIER_EMPTY] THEN + ASM_SIMP_TAC[frontier; CLOSURE_OPEN_INTERVAL; INTERIOR_OPEN; + OPEN_INTERVAL]);; + +let INTER_INTERVAL_MIXED_EQ_EMPTY = prove + (`!a b c d:real^N. + ~(interval(c,d) = {}) + ==> (interval(a,b) INTER interval[c,d] = {} <=> + interval(a,b) INTER interval(c,d) = {})`, + SIMP_TAC[GSYM CLOSURE_OPEN_INTERVAL; OPEN_INTER_CLOSURE_EQ_EMPTY; + OPEN_INTERVAL]);; + +let INTERVAL_TRANSLATION = prove + (`(!c a b. interval[c + a,c + b] = IMAGE (\x. c + x) (interval[a,b])) /\ + (!c a b. interval(c + a,c + b) = IMAGE (\x. c + x) (interval(a,b)))`, + REWRITE_TAC[interval] THEN CONJ_TAC THEN GEOM_TRANSLATE_TAC[] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; + +add_translation_invariants + [CONJUNCT1 INTERVAL_TRANSLATION; CONJUNCT2 INTERVAL_TRANSLATION];; + +let EMPTY_AS_INTERVAL = prove + (`{} = interval[vec 1,vec 0]`, + SIMP_TAC[EXTENSION; NOT_IN_EMPTY; IN_INTERVAL; VEC_COMPONENT] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[LE_REFL; DIMINDEX_GE_1] THEN REAL_ARITH_TAC);; + +let UNIT_INTERVAL_NONEMPTY = prove + (`~(interval[vec 0:real^N,vec 1] = {}) /\ + ~(interval(vec 0:real^N,vec 1) = {})`, + SIMP_TAC[INTERVAL_NE_EMPTY; VEC_COMPONENT; REAL_LT_01; REAL_POS]);; + +let IMAGE_STRETCH_INTERVAL = prove + (`!a b:real^N m. + IMAGE (\x. lambda k. m(k) * x$k) (interval[a,b]) = + if interval[a,b] = {} then {} + else interval[(lambda k. min (m(k) * a$k) (m(k) * b$k)):real^N, + (lambda k. max (m(k) * a$k) (m(k) * b$k))]`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[IMAGE_CLAUSES] THEN + ASM_SIMP_TAC[EXTENSION; IN_IMAGE; CART_EQ; IN_INTERVAL; AND_FORALL_THM; + TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`; + LAMBDA_BETA; GSYM LAMBDA_SKOLEM] THEN + X_GEN_TAC `x:real^N` THEN MATCH_MP_TAC(MESON[] + `(!x. p x ==> (q x <=> r x)) + ==> ((!x. p x ==> q x) <=> (!x. p x ==> r x))`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INTERVAL_NE_EMPTY]) THEN + MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `k:num` THEN ASM_CASES_TAC `1 <= k /\ k <= dimindex(:N)` THEN + ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `(m:num->real) k = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MAX_ACI; REAL_MIN_ACI] THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_REFL]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(m = &0) ==> (x = m * y <=> y = x / m)`] THEN + REWRITE_TAC[UNWIND_THM2] THEN FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP + (REAL_ARITH `~(z = &0) ==> &0 < z \/ &0 < --z`)) + THENL + [ALL_TAC; + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_ARITH `--(max a b) = min (--a) (--b)`; + REAL_ARITH `--(min a b) = max (--a) (--b)`; real_div; + GSYM REAL_MUL_RNEG; GSYM REAL_INV_NEG] THEN + REWRITE_TAC[GSYM real_div]] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + ASM_SIMP_TAC[real_min; real_max; REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ] THEN + REAL_ARITH_TAC);; + +let INTERVAL_IMAGE_STRETCH_INTERVAL = prove + (`!a b:real^N m. ?u v:real^N. + IMAGE (\x. lambda k. m k * x$k) (interval[a,b]) = interval[u,v]`, + REWRITE_TAC[IMAGE_STRETCH_INTERVAL] THEN MESON_TAC[EMPTY_AS_INTERVAL]);; + +let CLOSED_INTERVAL_IMAGE_UNIT_INTERVAL = prove + (`!a b:real^N. + ~(interval[a,b] = {}) + ==> interval[a,b] = IMAGE (\x:real^N. a + x) + (IMAGE (\x. (lambda i. (b$i - a$i) * x$i)) + (interval[vec 0:real^N,vec 1]))`, + REWRITE_TAC[INTERVAL_NE_EMPTY] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[IMAGE_STRETCH_INTERVAL; UNIT_INTERVAL_NONEMPTY] THEN + REWRITE_TAC[GSYM INTERVAL_TRANSLATION] THEN + REWRITE_TAC[EXTENSION; IN_INTERVAL] THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_ADD_COMPONENT; VEC_COMPONENT] THEN + GEN_TAC THEN REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN + MATCH_MP_TAC(MESON[] `(!x. P x <=> Q x) ==> ((!x. P x) <=> (!x. Q x))`) THEN + POP_ASSUM MP_TAC THEN MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `1 <= i /\ i <= dimindex(:N)` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let SUMS_INTERVALS = prove + (`(!a b c d:real^N. + ~(interval[a,b] = {}) /\ ~(interval[c,d] = {}) + ==> {x + y | x IN interval[a,b] /\ y IN interval[c,d]} = + interval[a+c,b+d]) /\ + (!a b c d:real^N. + ~(interval(a,b) = {}) /\ ~(interval(c,d) = {}) + ==> {x + y | x IN interval(a,b) /\ y IN interval(c,d)} = + interval(a+c,b+d))`, + CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[INTERVAL_NE_EMPTY] THEN + STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTERVAL; IN_ELIM_THM] THEN + REWRITE_TAC[TAUT `(a /\ b) /\ c <=> c /\ a /\ b`] THEN + REWRITE_TAC[VECTOR_ARITH `x:real^N = y + z <=> z = x - y`] THEN + REWRITE_TAC[UNWIND_THM2; VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT] THEN + (X_GEN_TAC `x:real^N` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC); + DISCH_TAC THEN + REWRITE_TAC[AND_FORALL_THM; GSYM LAMBDA_SKOLEM; + TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + REWRITE_TAC[REAL_ARITH + `((a <= y /\ y <= b) /\ c <= x - y /\ x - y <= d <=> + max a (x - d) <= y /\ y <= min b (x - c)) /\ + ((a < y /\ y < b) /\ c < x - y /\ x - y < d <=> + max a (x - d) < y /\ y < min b (x - c))`] THEN + REWRITE_TAC[GSYM REAL_LE_BETWEEN; GSYM REAL_LT_BETWEEN]] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `i:num`)) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC));; + +let PCROSS_INTERVAL = prove + (`!a b:real^M c d:real^N. + interval[a,b] PCROSS interval[c,d] = + interval[pastecart a c,pastecart b d]`, + REPEAT GEN_TAC THEN REWRITE_TAC[PCROSS] THEN + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_PASTECART_THM] THEN + SIMP_TAC[IN_INTERVAL; pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM] THEN + MAP_EVERY X_GEN_TAC [`x:real^M`; `y:real^N`] THEN EQ_TAC THEN STRIP_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + CONJ_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `i + dimindex(:M)`) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB] THENL + [ASM_ARITH_TAC; + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);; + +let OPEN_CONTAINS_INTERVAL,OPEN_CONTAINS_OPEN_INTERVAL = (CONJ_PAIR o prove) + (`(!s:real^N->bool. + open s <=> + !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval[a,b] SUBSET s) /\ + (!s:real^N->bool. + open s <=> + !x. x IN s ==> ?a b. x IN interval(a,b) /\ interval(a,b) SUBSET s)`, + REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(TAUT + `(q ==> r) /\ (r ==> p) /\ (p ==> q) ==> (p <=> q) /\ (p <=> r)`) THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; + DISCH_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN STRIP_TAC THEN + MP_TAC(ISPEC `interval(a:real^N,b)` OPEN_CONTAINS_BALL) THEN + REWRITE_TAC[OPEN_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[SUBSET_TRANS; INTERVAL_OPEN_SUBSET_CLOSED]; + DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `x:real^N` o + GEN_REWRITE_RULE I [OPEN_CONTAINS_CBALL]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x - e / &(dimindex(:N)) % vec 1:real^N` THEN + EXISTS_TAC `x + e / &(dimindex(:N)) % vec 1:real^N` THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b SUBSET s ==> x IN i /\ j SUBSET b ==> x IN i /\ j SUBSET s`)) THEN + SIMP_TAC[IN_INTERVAL; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; IN_CBALL; + VEC_COMPONENT; VECTOR_ADD_COMPONENT; SUBSET; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `x - e < x /\ x < x + e <=> &0 < e`; + REAL_ARITH `x - e <= y /\ y <= x + e <=> abs(x - y) <= e`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + DISCH_TAC THEN REWRITE_TAC[dist] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(1..dimindex(:N)) (\i. abs((x - y:real^N)$i))` THEN + REWRITE_TAC[NORM_LE_L1] THEN MATCH_MP_TAC SUM_BOUND_GEN THEN + ASM_SIMP_TAC[CARD_NUMSEG_1; IN_NUMSEG; FINITE_NUMSEG] THEN + REWRITE_TAC[NUMSEG_EMPTY; NOT_LT; DIMINDEX_GE_1]]);; + +let DIAMETER_INTERVAL = prove + (`(!a b:real^N. + diameter(interval[a,b]) = + if interval[a,b] = {} then &0 else norm(b - a)) /\ + (!a b:real^N. + diameter(interval(a,b)) = + if interval(a,b) = {} then &0 else norm(b - a))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THENL + [ASM_MESON_TAC[INTERVAL_OPEN_SUBSET_CLOSED; SUBSET_EMPTY; DIAMETER_EMPTY]; + ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_SIMP_TAC[DIAMETER_BOUNDED_BOUND; + ENDS_IN_INTERVAL; BOUNDED_INTERVAL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `diameter(cball(inv(&2) % (a + b):real^N,norm(b - a) / &2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIAMETER_SUBSET THEN REWRITE_TAC[BOUNDED_CBALL] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL; IN_CBALL] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[dist] THEN + REWRITE_TAC[GSYM NORM_MUL; REAL_ARITH `x / &2 = abs(inv(&2)) * x`] THEN + MATCH_MP_TAC NORM_LE_COMPONENTWISE THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_SUB_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REAL_ARITH_TAC; + REWRITE_TAC[DIAMETER_CBALL] THEN NORM_ARITH_TAC]; + DISCH_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[DIAMETER_EMPTY] THEN + SUBGOAL_THEN `interval[a:real^N,b] = closure(interval(a,b))` + SUBST_ALL_TAC THEN ASM_REWRITE_TAC[CLOSURE_INTERVAL] THEN + ASM_MESON_TAC[DIAMETER_CLOSURE; BOUNDED_INTERVAL]]);; + +(* ------------------------------------------------------------------------- *) +(* Some special cases for intervals in R^1. *) +(* ------------------------------------------------------------------------- *) + +let INTERVAL_CASES_1 = prove + (`!x:real^1. x IN interval[a,b] ==> x IN interval(a,b) \/ (x = a) \/ (x = b)`, + REWRITE_TAC[CART_EQ; IN_INTERVAL; FORALL_DIMINDEX_1] THEN REAL_ARITH_TAC);; + +let IN_INTERVAL_1 = prove + (`!a b x:real^1. + (x IN interval[a,b] <=> drop a <= drop x /\ drop x <= drop b) /\ + (x IN interval(a,b) <=> drop a < drop x /\ drop x < drop b)`, + REWRITE_TAC[IN_INTERVAL; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN + MESON_TAC[]);; + +let INTERVAL_EQ_EMPTY_1 = prove + (`!a b:real^1. + (interval[a,b] = {} <=> drop b < drop a) /\ + (interval(a,b) = {} <=> drop b <= drop a)`, + REWRITE_TAC[INTERVAL_EQ_EMPTY; drop; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM] THEN + MESON_TAC[]);; + +let INTERVAL_NE_EMPTY_1 = prove + (`(!a b:real^1. ~(interval[a,b] = {}) <=> drop a <= drop b) /\ + (!a b:real^1. ~(interval(a,b) = {}) <=> drop a < drop b)`, + REWRITE_TAC[INTERVAL_EQ_EMPTY_1] THEN REAL_ARITH_TAC);; + +let SUBSET_INTERVAL_1 = prove + (`!a b c d. + (interval[a,b] SUBSET interval[c,d] <=> + drop b < drop a \/ + drop c <= drop a /\ drop a <= drop b /\ drop b <= drop d) /\ + (interval[a,b] SUBSET interval(c,d) <=> + drop b < drop a \/ + drop c < drop a /\ drop a <= drop b /\ drop b < drop d) /\ + (interval(a,b) SUBSET interval[c,d] <=> + drop b <= drop a \/ + drop c <= drop a /\ drop a < drop b /\ drop b <= drop d) /\ + (interval(a,b) SUBSET interval(c,d) <=> + drop b <= drop a \/ + drop c <= drop a /\ drop a < drop b /\ drop b <= drop d)`, + REWRITE_TAC[SUBSET_INTERVAL; FORALL_1; DIMINDEX_1; drop] THEN + REAL_ARITH_TAC);; + +let EQ_INTERVAL_1 = prove + (`!a b c d:real^1. + (interval[a,b] = interval[c,d] <=> + drop b < drop a /\ drop d < drop c \/ + drop a = drop c /\ drop b = drop d)`, + REWRITE_TAC[SET_RULE `s = t <=> s SUBSET t /\ t SUBSET s`] THEN + REWRITE_TAC[SUBSET_INTERVAL_1] THEN REAL_ARITH_TAC);; + +let DISJOINT_INTERVAL_1 = prove + (`!a b c d:real^1. + (interval[a,b] INTER interval[c,d] = {} <=> + drop b < drop a \/ drop d < drop c \/ + drop b < drop c \/ drop d < drop a) /\ + (interval[a,b] INTER interval(c,d) = {} <=> + drop b < drop a \/ drop d <= drop c \/ + drop b <= drop c \/ drop d <= drop a) /\ + (interval(a,b) INTER interval[c,d] = {} <=> + drop b <= drop a \/ drop d < drop c \/ + drop b <= drop c \/ drop d <= drop a) /\ + (interval(a,b) INTER interval(c,d) = {} <=> + drop b <= drop a \/ drop d <= drop c \/ + drop b <= drop c \/ drop d <= drop a)`, + REWRITE_TAC[DISJOINT_INTERVAL; CONJ_ASSOC; DIMINDEX_1; LE_ANTISYM; + UNWIND_THM1; drop]);; + +let OPEN_CLOSED_INTERVAL_1 = prove + (`!a b:real^1. interval(a,b) = interval[a,b] DIFF {a,b}`, + REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_DIFF; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; + +let CLOSED_OPEN_INTERVAL_1 = prove + (`!a b:real^1. drop a <= drop b ==> interval[a,b] = interval(a,b) UNION {a,b}`, + REWRITE_TAC[EXTENSION; IN_INTERVAL_1; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN REAL_ARITH_TAC);; + +let BALL_1 = prove + (`!x:real^1 r. cball(x,r) = interval[x - lift r,x + lift r] /\ + ball(x,r) = interval(x - lift r,x + lift r)`, + REWRITE_TAC[EXTENSION; IN_BALL; IN_CBALL; IN_INTERVAL_1] THEN + REWRITE_TAC[dist; NORM_REAL; GSYM drop; DROP_SUB; LIFT_DROP; DROP_ADD] THEN + REAL_ARITH_TAC);; + +let SPHERE_1 = prove + (`!a:real^1 r. sphere(a,r) = if r < &0 then {} else {a - lift r,a + lift r}`, + REPEAT GEN_TAC THEN REWRITE_TAC[sphere] THEN COND_CASES_TAC THEN + REWRITE_TAC[DIST_REAL; GSYM drop; FORALL_DROP] THEN + REWRITE_TAC[EXTENSION; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_SUB; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC);; + +let FINITE_SPHERE_1 = prove + (`!a:real^1 r. FINITE(sphere(a,r))`, + REPEAT GEN_TAC THEN REWRITE_TAC[SPHERE_1] THEN + MESON_TAC[FINITE_INSERT; FINITE_EMPTY]);; + +let FINITE_INTERVAL_1 = prove + (`(!a b. FINITE(interval[a,b]) <=> drop b <= drop a) /\ + (!a b. FINITE(interval(a,b)) <=> drop b <= drop a)`, + REWRITE_TAC[OPEN_CLOSED_INTERVAL_1] THEN + REWRITE_TAC[SET_RULE `s DIFF {a,b} = s DELETE a DELETE b`] THEN + REWRITE_TAC[FINITE_DELETE] THEN REPEAT GEN_TAC THEN + SUBGOAL_THEN `interval[a,b] = IMAGE lift {x | drop a <= x /\ x <= drop b}` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[IN_INTERVAL_1; IN_ELIM_THM; LIFT_DROP]; + SIMP_TAC[FINITE_IMAGE_INJ_EQ; LIFT_EQ; FINITE_REAL_INTERVAL]]);; + +let BALL_INTERVAL = prove + (`!x:real^1 e. ball(x,e) = interval(x - lift e,x + lift e)`, + REWRITE_TAC[EXTENSION; IN_BALL; IN_INTERVAL_1; DIST_REAL] THEN + REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; + +let CBALL_INTERVAL = prove + (`!x:real^1 e. cball(x,e) = interval[x - lift e,x + lift e]`, + REWRITE_TAC[EXTENSION; IN_CBALL; IN_INTERVAL_1; DIST_REAL] THEN + REWRITE_TAC[GSYM drop; DROP_SUB; DROP_ADD; LIFT_DROP] THEN REAL_ARITH_TAC);; + +let BALL_INTERVAL_0 = prove + (`!e. ball(vec 0:real^1,e) = interval(--lift e,lift e)`, + GEN_TAC THEN REWRITE_TAC[BALL_INTERVAL] THEN AP_TERM_TAC THEN + BINOP_TAC THEN VECTOR_ARITH_TAC);; + +let CBALL_INTERVAL_0 = prove + (`!e. cball(vec 0:real^1,e) = interval[--lift e,lift e]`, + GEN_TAC THEN REWRITE_TAC[CBALL_INTERVAL] THEN AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN BINOP_TAC THEN VECTOR_ARITH_TAC);; + +let INTER_INTERVAL_1 = prove + (`!a b c d:real^1. + interval[a,b] INTER interval[c,d] = + interval[lift(max (drop a) (drop c)),lift(min (drop b) (drop d))]`, + REWRITE_TAC[EXTENSION; IN_INTER; IN_INTERVAL_1; real_max; real_min] THEN + REPEAT GEN_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]) THEN + ASM_REAL_ARITH_TAC);; + +let CLOSED_DIFF_OPEN_INTERVAL_1 = prove + (`!a b:real^1. + interval[a,b] DIFF interval(a,b) = + if interval[a,b] = {} then {} else {a,b}`, + REWRITE_TAC[EXTENSION; IN_DIFF; INTERVAL_EQ_EMPTY_1; IN_INTERVAL_1] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Intervals in general, including infinite and mixtures of open and closed. *) +(* ------------------------------------------------------------------------- *) + +let is_interval = new_definition + `is_interval(s:real^N->bool) <=> + !a b x. a IN s /\ b IN s /\ + (!i. 1 <= i /\ i <= dimindex(:N) + ==> (a$i <= x$i /\ x$i <= b$i) \/ + (b$i <= x$i /\ x$i <= a$i)) + ==> x IN s`;; + +let IS_INTERVAL_INTERVAL = prove + (`!a:real^N b. is_interval(interval (a,b)) /\ is_interval(interval [a,b])`, + REWRITE_TAC[is_interval; IN_INTERVAL] THEN + MESON_TAC[REAL_LT_TRANS; REAL_LE_TRANS; REAL_LET_TRANS; REAL_LTE_TRANS]);; + +let IS_INTERVAL_EMPTY = prove + (`is_interval {}`, + REWRITE_TAC[is_interval; NOT_IN_EMPTY]);; + +let IS_INTERVAL_UNIV = prove + (`is_interval(UNIV:real^N->bool)`, + REWRITE_TAC[is_interval; IN_UNIV]);; + +let IS_INTERVAL_TRANSLATION_EQ = prove + (`!a:real^N s. is_interval(IMAGE (\x. a + x) s) <=> is_interval s`, + REWRITE_TAC[is_interval] THEN GEOM_TRANSLATE_TAC[] THEN + REWRITE_TAC[VECTOR_ADD_COMPONENT; REAL_LT_LADD; REAL_LE_LADD]);; + +add_translation_invariants [IS_INTERVAL_TRANSLATION_EQ];; + +let IS_INTERVAL_TRANSLATION = prove + (`!s a:real^N. is_interval s ==> is_interval(IMAGE (\x. a + x) s)`, + REWRITE_TAC[IS_INTERVAL_TRANSLATION_EQ]);; + +let IS_INTERVAL_POINTWISE = prove + (`!s:real^N->bool x. + is_interval s /\ + (!i. 1 <= i /\ i <= dimindex(:N) ==> ?a. a IN s /\ a$i = x$i) + ==> x IN s`, + REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. ?y:real^N. (!i. 1 <= i /\ i <= n ==> y$i = (x:real^N)$i) /\ y IN s` + MP_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THENL + [ASM_MESON_TAC[DIMINDEX_GE_1; LE_REFL]; ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `y:real^N`) THEN + ASM_CASES_TAC `SUC n <= dimindex(:N)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `SUC n`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(lambda i. if i <= n then (y:real^N)$i else (z:real^N)$i):real^N` THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ASM_SIMP_TAC[LAMBDA_BETA]] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `i = SUC n` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_ARITH_TAC; + FIRST_X_ASSUM(ASSUME_TAC o CONJUNCT2) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`y:real^N`; `z:real^N`] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN REAL_ARITH_TAC]; + EXISTS_TAC `y:real^N` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `y:real^N = x` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[CART_EQ] THEN + ASM_MESON_TAC[ARITH_RULE `i <= N /\ ~(SUC n <= N) ==> i <= n`]]; + DISCH_THEN(MP_TAC o SPEC `dimindex(:N)`) THEN + REWRITE_TAC[GSYM CART_EQ] THEN MESON_TAC[]]);; + +let IS_INTERVAL_COMPACT = prove + (`!s:real^N->bool. is_interval s /\ compact s <=> ?a b. s = interval[a,b]`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[IS_INTERVAL_INTERVAL; COMPACT_INTERVAL] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_MESON_TAC[EMPTY_AS_INTERVAL]; ALL_TAC] THEN + EXISTS_TAC `(lambda i. inf { (x:real^N)$i | x IN s}):real^N` THEN + EXISTS_TAC `(lambda i. sup { (x:real^N)$i | x IN s}):real^N` THEN + SIMP_TAC[EXTENSION; IN_INTERVAL; LAMBDA_BETA] THEN X_GEN_TAC `x:real^N` THEN + EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` INF) THEN + MP_TAC(ISPEC `{ (x:real^N)$i | x IN s}` SUP) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_IMP_BOUNDED) THEN + REWRITE_TAC[bounded] THEN + ASM_MESON_TAC[COMPONENT_LE_NORM; REAL_LE_TRANS; MEMBER_NOT_EMPTY; + REAL_ARITH `abs(x) <= B ==> --B <= x /\ x <= B`]; + DISCH_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN + `?a b:real^N. a IN s /\ b IN s /\ a$i <= (x:real^N)$i /\ x$i <= b$i` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] + CONTINUOUS_ATTAINS_INF) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. x$i`; `s:real^N->bool`] + CONTINUOUS_ATTAINS_SUP) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT; o_DEF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `inf {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LE_INF THEN ASM SET_TAC[]; + EXISTS_TAC `sup {(x:real^N)$i | x IN s}` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_SUP_LE THEN ASM SET_TAC[]]; + EXISTS_TAC + `(lambda j. if j = i then (x:real^N)$i else (a:real^N)$j):real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN + MAP_EVERY EXISTS_TAC + [`a:real^N`; + `(lambda j. if j = i then (b:real^N)$i else (a:real^N)$j):real^N`] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[is_interval]) THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN + ASM_SIMP_TAC[LAMBDA_BETA]; + ALL_TAC] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +let IS_INTERVAL_1 = prove + (`!s:real^1->bool. + is_interval s <=> + !a b x. a IN s /\ b IN s /\ drop a <= drop x /\ drop x <= drop b + ==> x IN s`, + REWRITE_TAC[is_interval; DIMINDEX_1; FORALL_1; GSYM drop] THEN + REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN MESON_TAC[]);; + +let IS_INTERVAL_1_CASES = prove + (`!s:real^1->bool. + is_interval s <=> + s = {} \/ + s = (:real^1) \/ + (?a. s = {x | a < drop x}) \/ + (?a. s = {x | a <= drop x}) \/ + (?b. s = {x | drop x <= b}) \/ + (?b. s = {x | drop x < b}) \/ + (?a b. s = {x | a < drop x /\ drop x < b}) \/ + (?a b. s = {x | a < drop x /\ drop x <= b}) \/ + (?a b. s = {x | a <= drop x /\ drop x < b}) \/ + (?a b. s = {x | a <= drop x /\ drop x <= b})`, + GEN_TAC THEN REWRITE_TAC[IS_INTERVAL_1] THEN EQ_TAC THENL + [DISCH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV; NOT_IN_EMPTY] THEN + REAL_ARITH_TAC] THEN + ASM_CASES_TAC `s:real^1->bool = {}` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `IMAGE drop s` SUP) THEN + MP_TAC(ISPEC `IMAGE drop s` INF) THEN + ASM_REWRITE_TAC[IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + ASM_CASES_TAC `?a. !x. x IN s ==> a <= drop x` THEN + ASM_CASES_TAC `?b. !x. x IN s ==> drop x <= b` THEN + ASM_REWRITE_TAC[] THENL + [STRIP_TAC THEN STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC + [`inf(IMAGE drop s) IN IMAGE drop s`; `sup(IMAGE drop s) IN IMAGE drop s`] + THENL + [REPLICATE_TAC 8 DISJ2_TAC; + REPLICATE_TAC 7 DISJ2_TAC THEN DISJ1_TAC; + REPLICATE_TAC 6 DISJ2_TAC THEN DISJ1_TAC; + REPLICATE_TAC 5 DISJ2_TAC THEN DISJ1_TAC] THEN + MAP_EVERY EXISTS_TAC [`inf(IMAGE drop s)`; `sup(IMAGE drop s)`]; + STRIP_TAC THEN ASM_CASES_TAC `inf(IMAGE drop s) IN IMAGE drop s` THENL + [REPLICATE_TAC 2 DISJ2_TAC THEN DISJ1_TAC; + DISJ2_TAC THEN DISJ1_TAC] THEN + EXISTS_TAC `inf(IMAGE drop s)`; + STRIP_TAC THEN ASM_CASES_TAC `sup(IMAGE drop s) IN IMAGE drop s` THENL + [REPLICATE_TAC 3 DISJ2_TAC THEN DISJ1_TAC; + REPLICATE_TAC 4 DISJ2_TAC THEN DISJ1_TAC] THEN + EXISTS_TAC `sup(IMAGE drop s)`; + DISJ1_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN + REWRITE_TAC[GSYM REAL_NOT_LE] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_LE_TOTAL; REAL_LE_ANTISYM]);; + +let IS_INTERVAL_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + is_interval s /\ is_interval t ==> is_interval(s PCROSS t)`, + REWRITE_TAC[is_interval; DIMINDEX_FINITE_SUM] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + REPEAT GEN_TAC THEN + MATCH_MP_TAC(MESON[] + `(!a b a' b' x x'. P a b x /\ Q a' b' x' ==> R a b x a' b' x') + ==> (!a b x. P a b x) /\ (!a' b' x'. Q a' b' x') + ==> (!a a' b b' x x'. R a b x a' b' x')`) THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `x:num <= m ==> x <= m + n`]; + FIRST_X_ASSUM(MP_TAC o SPEC `dimindex(:M) + i`) THEN + ASM_SIMP_TAC[pastecart; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `x:num <= n ==> m + x <= m + n`; + ARITH_RULE `1 <= x ==> 1 <= m + x`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN ASM_ARITH_TAC]);; + +let IS_INTERVAL_PCROSS_EQ = prove + (`!s:real^M->bool t:real^N->bool. + is_interval(s PCROSS t) <=> + s = {} \/ t = {} \/ is_interval s /\ is_interval t`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; IS_INTERVAL_EMPTY] THEN + EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_PCROSS] THEN + REWRITE_TAC[is_interval] THEN + REWRITE_TAC[FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + STRIP_TAC THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:real^M`; `b:real^M`; `x:real^M`] THEN + STRIP_TAC THEN UNDISCH_TAC `~(t:real^N->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real^N`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`a:real^M`; `y:real^N`; `b:real^M`; + `y:real^N`; `x:real^M`; `y:real^N`]); + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + STRIP_TAC THEN UNDISCH_TAC `~(s:real^M->bool = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `w:real^M`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`w:real^M`; `a:real^N`; `w:real^M`; + `b:real^N`; `w:real^M`; `x:real^N`])] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[pastecart; LAMBDA_BETA] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + ASM_MESON_TAC[DIMINDEX_FINITE_SUM; ARITH_RULE + `1 <= i /\ i <= m + n /\ ~(i <= m) ==> 1 <= i - m /\ i - m <= n`]);; + +let IS_INTERVAL_INTER = prove + (`!s t:real^N->bool. + is_interval s /\ is_interval t ==> is_interval(s INTER t)`, + REWRITE_TAC[is_interval; IN_INTER] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`; `x:real^N`] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`a:real^N`; `b:real^N`] THEN ASM_REWRITE_TAC[]);; + +let INTERVAL_SUBSET_IS_INTERVAL = prove + (`!s a b:real^N. + is_interval s + ==> (interval[a,b] SUBSET s <=> interval[a,b] = {} \/ a IN s /\ b IN s)`, + REWRITE_TAC[is_interval] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `interval[a:real^N,b] = {}` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET] THEN + EQ_TAC THENL [ASM_MESON_TAC[ENDS_IN_INTERVAL; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTERVAL] THEN ASM_MESON_TAC[]);; + +let INTERVAL_CONTAINS_COMPACT_NEIGHBOURHOOD = prove + (`!s x:real^N. + is_interval s /\ x IN s + ==> ?a b d. &0 < d /\ x IN interval[a,b] /\ + interval[a,b] SUBSET s /\ + ball(x,d) INTER s SUBSET interval[a,b]`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTERVAL_SUBSET_IS_INTERVAL] THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?a. (?y. y IN s /\ y$i = a) /\ + (a < x$i \/ a = (x:real^N)$i /\ + !y:real^N. y IN s ==> a <= y$i)` + MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?b. (?y. y IN s /\ y$i = b) /\ + (x$i < b \/ b = (x:real^N)$i /\ + !y:real^N. y IN s ==> y$i <= b)` + MP_TAC THENL [ASM_MESON_TAC[REAL_NOT_LT]; REWRITE_TAC[LAMBDA_SKOLEM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN STRIP_TAC THEN + EXISTS_TAC `min (inf (IMAGE (\i. if a$i < x$i + then (x:real^N)$i - (a:real^N)$i else &1) + (1..dimindex(:N)))) + (inf (IMAGE (\i. if x$i < b$i + then (b:real^N)$i - x$i else &1) + (1..dimindex(:N))))` THEN + REWRITE_TAC[REAL_LT_MIN; SUBSET; IN_BALL; IN_INTER] THEN + SIMP_TAC[REAL_LT_INF_FINITE; IMAGE_EQ_EMPTY; FINITE_IMAGE; + FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_INTERVAL] THEN REPEAT CONJ_TAC THENL + [MESON_TAC[REAL_SUB_LT; REAL_LT_01]; + MESON_TAC[REAL_SUB_LT; REAL_LT_01]; + ASM_MESON_TAC[REAL_LE_LT]; + DISJ2_TAC THEN CONJ_TAC THEN MATCH_MP_TAC IS_INTERVAL_POINTWISE THEN + ASM_MESON_TAC[]; + X_GEN_TAC `y:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + REWRITE_TAC[AND_FORALL_THM] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `i:num` THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + (COND_CASES_TAC THENL [REWRITE_TAC[dist]; ASM_MESON_TAC[]]) THEN + DISCH_TAC THEN MP_TAC(ISPECL [`x - y:real^N`; `i:num`] + COMPONENT_LE_NORM) THEN + ASM_REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN ASM_REAL_ARITH_TAC]);; + +let IS_INTERVAL_SUMS = prove + (`!s t:real^N->bool. + is_interval s /\ is_interval t + ==> is_interval {x + y | x IN s /\ y IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[is_interval] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC] THEN + MAP_EVERY X_GEN_TAC + [`a:real^N`; `a':real^N`; `b:real^N`; `b':real^N`; `y:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`a:real^N`; `b:real^N`]) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPECL [`a':real^N`; `b':real^N`]) STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[IMP_IMP; IN_ELIM_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + ONCE_REWRITE_TAC[VECTOR_ARITH `z:real^N = x + y <=> y = z - x`] THEN + REWRITE_TAC[UNWIND_THM2] THEN MATCH_MP_TAC(MESON[] + `(?x. P x /\ Q(f x)) + ==> (!x. P x ==> x IN s) /\ (!x. Q x ==> x IN t) + ==> ?x. x IN s /\ f x IN t`) THEN + REWRITE_TAC[VECTOR_SUB_COMPONENT; AND_FORALL_THM; + TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + REWRITE_TAC[GSYM LAMBDA_SKOLEM] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH + `c <= y - x /\ y - x <= d <=> y - d <= x /\ x <= y - c`] THEN + REWRITE_TAC[REAL_ARITH + `a <= x /\ x <= b \/ b <= x /\ x <= a <=> min a b <= x /\ x <= max a b`] THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q) /\ (r /\ s) <=> (p /\ r) /\ (q /\ s)`] THEN + REWRITE_TAC[GSYM REAL_LE_MIN; GSYM REAL_MAX_LE] THEN + REWRITE_TAC[GSYM REAL_LE_BETWEEN] THEN REAL_ARITH_TAC);; + +let IS_INTERVAL_SING = prove + (`!a:real^N. is_interval {a}`, + SIMP_TAC[is_interval; IN_SING; IMP_CONJ; CART_EQ; REAL_LE_ANTISYM]);; + +let IS_INTERVAL_SCALING = prove + (`!s:real^N->bool c. is_interval s ==> is_interval(IMAGE (\x. c % x) s)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ + IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` + STRIP_ASSUME_TAC THENL + [SET_TAC[]; + ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; + ASM_REWRITE_TAC[IS_INTERVAL_SING]]; + REWRITE_TAC[is_interval; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + GEN_REWRITE_TAC (BINOP_CONV o REDEPTH_CONV) [RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; VECTOR_MUL_COMPONENT] THEN + MAP_EVERY (fun t -> MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC t) + [`a:real^N`; `b:real^N`] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + MP_TAC(SPEC `inv(c) % x:real^N` th)) THEN + ASM_REWRITE_TAC[VECTOR_MUL_COMPONENT; IN_IMAGE] THEN ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[GSYM real_div] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(c = &0) ==> &0 < c \/ &0 < --c`)) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_LE_NEG2] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_RNEG; GSYM REAL_LE_RDIV_EQ; GSYM + REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_INV_NEG] THEN REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `inv c % x:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RINV; VECTOR_MUL_LID]]]);; + +let IS_INTERVAL_SCALING_EQ = prove + (`!s:real^N->bool c. + is_interval(IMAGE (\x. c % x) s) <=> c = &0 \/ is_interval s`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO] THEN + SUBGOAL_THEN `IMAGE ((\x. vec 0):real^N->real^N) s = {} \/ + IMAGE ((\x. vec 0):real^N->real^N) s = {vec 0}` + STRIP_ASSUME_TAC THENL + [SET_TAC[]; + ASM_REWRITE_TAC[IS_INTERVAL_EMPTY]; + ASM_REWRITE_TAC[IS_INTERVAL_SING]]; + ASM_REWRITE_TAC[] THEN EQ_TAC THEN REWRITE_TAC[IS_INTERVAL_SCALING] THEN + DISCH_THEN(MP_TAC o SPEC `inv c:real` o MATCH_MP IS_INTERVAL_SCALING) THEN + ASM_SIMP_TAC[GSYM IMAGE_o; VECTOR_MUL_ASSOC; o_DEF; REAL_MUL_LINV; + VECTOR_MUL_LID; IMAGE_ID]]);; + +let lemma = prove + (`!c. &0 < c + ==> !s:real^N->bool. is_interval(IMAGE (\x. c % x) s) <=> + is_interval s`, + SIMP_TAC[IS_INTERVAL_SCALING_EQ; REAL_LT_IMP_NZ]) in +add_scaling_theorems [lemma];; + +(* ------------------------------------------------------------------------- *) +(* Line segments, with same open/closed overloading as for intervals. *) +(* ------------------------------------------------------------------------- *) + +let closed_segment = define + `closed_segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1}`;; + +let open_segment = new_definition + `open_segment(a,b) = closed_segment[a,b] DIFF {a,b}`;; + +let OPEN_SEGMENT_ALT = prove + (`!a b:real^N. + ~(a = b) + ==> open_segment(a,b) = {(&1 - u) % a + u % b | &0 < u /\ u < &1}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[open_segment; closed_segment] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_INSERT; NOT_IN_EMPTY; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `u:real` THEN ASM_CASES_TAC `x:real^N = (&1 - u) % a + u % b` THEN + ASM_REWRITE_TAC[REAL_LE_LT; + VECTOR_ARITH `(&1 - u) % a + u % b = a <=> u % (b - a) = vec 0`; + VECTOR_ARITH `(&1 - u) % a + u % b = b <=> (&1 - u) % (b - a) = vec 0`; + VECTOR_MUL_EQ_0; REAL_SUB_0; VECTOR_SUB_EQ] THEN + REAL_ARITH_TAC);; + +make_overloadable "segment" `:A`;; + +overload_interface("segment",`open_segment`);; +overload_interface("segment",`closed_segment`);; + +let segment = prove + (`segment[a,b] = {(&1 - u) % a + u % b | &0 <= u /\ u <= &1} /\ + segment(a,b) = segment[a,b] DIFF {a,b}`, + REWRITE_TAC[open_segment; closed_segment]);; + +let SEGMENT_REFL = prove + (`(!a. segment[a,a] = {a}) /\ + (!a. segment(a,a) = {})`, + REWRITE_TAC[segment; VECTOR_ARITH `(&1 - u) % a + u % a = a`] THEN + SET_TAC[REAL_POS]);; + +let IN_SEGMENT = prove + (`!a b x:real^N. + (x IN segment[a,b] <=> + ?u. &0 <= u /\ u <= &1 /\ x = (&1 - u) % a + u % b) /\ + (x IN segment(a,b) <=> + ~(a = b) /\ ?u. &0 < u /\ u < &1 /\ x = (&1 - u) % a + u % b)`, + REPEAT STRIP_TAC THENL + [REWRITE_TAC[segment; IN_ELIM_THM; CONJ_ASSOC]; ALL_TAC] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[OPEN_SEGMENT_ALT; IN_ELIM_THM; CONJ_ASSOC]);; + +let SEGMENT_SYM = prove + (`(!a b:real^N. segment[a,b] = segment[b,a]) /\ + (!a b:real^N. segment(a,b) = segment(b,a))`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN + SIMP_TAC[open_segment] THEN + CONJ_TAC THENL [ALL_TAC; SIMP_TAC[INSERT_AC]] THEN + REWRITE_TAC[EXTENSION; IN_SEGMENT] THEN REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `u:real`) THEN EXISTS_TAC `&1 - u` THEN + ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THEN TRY ASM_ARITH_TAC THEN VECTOR_ARITH_TAC);; + +let ENDS_IN_SEGMENT = prove + (`!a b. a IN segment[a,b] /\ b IN segment[a,b]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[segment; IN_ELIM_THM] THENL + [EXISTS_TAC `&0`; EXISTS_TAC `&1`] THEN + (CONJ_TAC THENL [REAL_ARITH_TAC; VECTOR_ARITH_TAC]));; + +let ENDS_NOT_IN_SEGMENT = prove + (`!a b. ~(a IN segment(a,b)) /\ ~(b IN segment(a,b))`, + REWRITE_TAC[open_segment] THEN SET_TAC[]);; + +let SEGMENT_CLOSED_OPEN = prove + (`!a b. segment[a,b] = segment(a,b) UNION {a,b}`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN MATCH_MP_TAC(SET_RULE + `a IN s /\ b IN s ==> s = (s DIFF {a,b}) UNION {a,b}`) THEN + REWRITE_TAC[ENDS_IN_SEGMENT]);; + +let MIDPOINT_IN_SEGMENT = prove + (`(!a b:real^N. midpoint(a,b) IN segment[a,b]) /\ + (!a b:real^N. midpoint(a,b) IN segment(a,b) <=> ~(a = b))`, + REWRITE_TAC[IN_SEGMENT] THEN REPEAT STRIP_TAC THENL + [ALL_TAC; ASM_CASES_TAC `a:real^N = b` THEN ASM_REWRITE_TAC[]] THEN + EXISTS_TAC `&1 / &2` THEN REWRITE_TAC[midpoint] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN VECTOR_ARITH_TAC);; + +let BETWEEN_IN_SEGMENT = prove + (`!x a b:real^N. between x (a,b) <=> x IN segment[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[between] THEN + ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING] THENL [NORM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[segment; IN_ELIM_THM] THEN EQ_TAC THENL + [DISCH_THEN(ASSUME_TAC o SYM) THEN + EXISTS_TAC `dist(a:real^N,x) / dist(a,b)` THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ; DIST_POS_LT] THEN CONJ_TAC + THENL [FIRST_ASSUM(SUBST1_TAC o SYM) THEN NORM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC VECTOR_MUL_LCANCEL_IMP THEN EXISTS_TAC `dist(a:real^N,b)` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; VECTOR_ADD_LDISTRIB; REAL_SUB_LDISTRIB; + REAL_DIV_LMUL; DIST_EQ_0] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DIST_TRIANGLE_EQ] o SYM) THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[dist; REAL_ARITH `(a + b) * &1 - a = b`] THEN + VECTOR_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[dist] THEN + REWRITE_TAC[VECTOR_ARITH `a - ((&1 - u) % a + u % b) = u % (a - b)`; + VECTOR_ARITH `((&1 - u) % a + u % b) - b = (&1 - u) % (a - b)`; + NORM_MUL; GSYM REAL_ADD_LDISTRIB] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD]);; + +let IN_SEGMENT_COMPONENT = prove + (`!a b x:real^N i. + x IN segment[a,b] /\ 1 <= i /\ i <= dimindex(:N) + ==> min (a$i) (b$i) <= x$i /\ x$i <= max (a$i) (b$i)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SEGMENT]) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT] THEN + SIMP_TAC[REAL_ARITH `c <= u * a + t * b <=> u * --a + t * --b <= --c`] THEN + MATCH_MP_TAC REAL_CONVEX_BOUND_LE THEN ASM_REAL_ARITH_TAC);; + +let SEGMENT_1 = prove + (`(!a b. segment[a,b] = + if drop a <= drop b then interval[a,b] else interval[b,a]) /\ + (!a b. segment(a,b) = + if drop a <= drop b then interval(a,b) else interval(b,a))`, + CONJ_TAC THEN REPEAT GEN_TAC THEN REWRITE_TAC[open_segment] THEN + COND_CASES_TAC THEN + REWRITE_TAC[IN_DIFF; IN_INSERT; NOT_IN_EMPTY; + EXTENSION; GSYM BETWEEN_IN_SEGMENT; between; IN_INTERVAL_1] THEN + REWRITE_TAC[GSYM DROP_EQ; DIST_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC);; + +let OPEN_SEGMENT_1 = prove + (`!a b:real^1. open(segment(a,b))`, + REPEAT GEN_TAC THEN REWRITE_TAC[SEGMENT_1] THEN + COND_CASES_TAC THEN REWRITE_TAC[OPEN_INTERVAL]);; + +let SEGMENT_TRANSLATION = prove + (`(!c a b. segment[c + a,c + b] = IMAGE (\x. c + x) (segment[a,b])) /\ + (!c a b. segment(c + a,c + b) = IMAGE (\x. c + x) (segment(a,b)))`, + REWRITE_TAC[EXTENSION; IN_SEGMENT; IN_IMAGE] THEN + REWRITE_TAC[VECTOR_ARITH `(&1 - u) % (c + a) + u % (c + b) = + c + (&1 - u) % a + u % b`] THEN + REWRITE_TAC[VECTOR_ARITH `c + a:real^N = c + b <=> a = b`] THEN + MESON_TAC[]);; + +add_translation_invariants + [CONJUNCT1 SEGMENT_TRANSLATION; CONJUNCT2 SEGMENT_TRANSLATION];; + +let CLOSED_SEGMENT_LINEAR_IMAGE = prove + (`!f a b. linear f + ==> segment[f a,f b] = IMAGE f (segment[a,b])`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SEGMENT] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_CMUL th)]) THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_ADD th)]) THEN + MESON_TAC[]);; + +add_linear_invariants [CLOSED_SEGMENT_LINEAR_IMAGE];; + +let OPEN_SEGMENT_LINEAR_IMAGE = prove + (`!f:real^M->real^N a b. + linear f /\ (!x y. f x = f y ==> x = y) + ==> segment(f a,f b) = IMAGE f (segment(a,b))`, + REWRITE_TAC[open_segment] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [OPEN_SEGMENT_LINEAR_IMAGE];; + +let IN_OPEN_SEGMENT = prove + (`!a b x:real^N. + x IN segment(a,b) <=> x IN segment[a,b] /\ ~(x = a) /\ ~(x = b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[open_segment; IN_DIFF] THEN SET_TAC[]);; + +let IN_OPEN_SEGMENT_ALT = prove + (`!a b x:real^N. + x IN segment(a,b) <=> + x IN segment[a,b] /\ ~(x = a) /\ ~(x = b) /\ ~(a = b)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `a:real^N = b` THEN + ASM_REWRITE_TAC[SEGMENT_REFL; IN_SING; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[IN_OPEN_SEGMENT]);; + +let COLLINEAR_DIST_IN_CLOSED_SEGMENT = prove + (`!a b x. collinear {x,a,b} /\ + dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b) + ==> x IN segment[a,b]`, + REWRITE_TAC[GSYM BETWEEN_IN_SEGMENT; COLLINEAR_DIST_BETWEEN]);; + +let COLLINEAR_DIST_IN_OPEN_SEGMENT = prove + (`!a b x. collinear {x,a,b} /\ + dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b) + ==> x IN segment(a,b)`, + REWRITE_TAC[IN_OPEN_SEGMENT] THEN + MESON_TAC[COLLINEAR_DIST_IN_CLOSED_SEGMENT; REAL_LT_LE; DIST_SYM]);; + +let SEGMENT_SCALAR_MULTIPLE = prove + (`(!a b v. segment[a % v,b % v] = + {x % v:real^N | a <= x /\ x <= b \/ b <= x /\ x <= a}) /\ + (!a b v. ~(v = vec 0) + ==> segment(a % v,b % v) = + {x % v:real^N | a < x /\ x < b \/ b < x /\ x < a})`, + MATCH_MP_TAC(TAUT `a /\ (a ==> b) ==> a /\ b`) THEN REPEAT STRIP_TAC THENL + [REPEAT GEN_TAC THEN + MP_TAC(SPECL [`a % basis 1:real^1`; `b % basis 1:real^1`] + (CONJUNCT1 SEGMENT_1)) THEN + REWRITE_TAC[segment; VECTOR_MUL_ASSOC; GSYM VECTOR_ADD_RDISTRIB] THEN + REWRITE_TAC[SET_RULE `{f x % b | p x} = IMAGE (\a. a % b) {f x | p x}`] THEN + DISCH_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `IMAGE drop`) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; DROP_CMUL] THEN + SIMP_TAC[drop; BASIS_COMPONENT; DIMINDEX_GE_1; LE_REFL] THEN + REWRITE_TAC[REAL_MUL_RID; IMAGE_ID] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + CONJ_TAC THENL [MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[FORALL_LIFT; LIFT_DROP] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + SIMP_TAC[drop; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; DIMINDEX_GE_1; + LE_REFL; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[open_segment] THEN + ASM_SIMP_TAC[VECTOR_MUL_RCANCEL; SET_RULE + `(!x y. x % v = y % v <=> x = y) + ==> {x % v | P x} DIFF {a % v,b % v} = + {x % v | P x /\ ~(x = a) /\ ~(x = b)}`] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN REAL_ARITH_TAC]);; + +let FINITE_INTER_COLLINEAR_OPEN_SEGMENTS = prove + (`!a b c d:real^N. + collinear{a,b,c} + ==> (FINITE(segment(a,b) INTER segment(c,d)) <=> + segment(a,b) INTER segment(c,d) = {})`, + REPEAT GEN_TAC THEN ABBREV_TAC `m:real^N = b - a` THEN POP_ASSUM MP_TAC THEN + GEOM_NORMALIZE_TAC `m:real^N` THEN + SIMP_TAC[VECTOR_SUB_EQ; SEGMENT_REFL; INTER_EMPTY; FINITE_EMPTY] THEN + X_GEN_TAC `m:real^N` THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + DISCH_THEN(SUBST_ALL_TAC o SYM) THEN POP_ASSUM MP_TAC THEN + GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN + X_GEN_TAC `b:real` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN + SIMP_TAC[VECTOR_SUB_RZERO; NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_RID] THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM(K ALL_TAC) THEN + ASM_CASES_TAC `collinear{vec 0:real^N,&1 % basis 1,y}` THENL + [POP_ASSUM MP_TAC THEN + SIMP_TAC[COLLINEAR_LEMMA_ALT; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL] THEN + MATCH_MP_TAC(TAUT + `~a /\ (b ==> c ==> d) ==> a \/ b ==> a \/ c ==> d`) THEN + CONJ_TAC THENL + [SIMP_TAC[VECTOR_MUL_LID; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `b:real` THEN DISCH_THEN SUBST_ALL_TAC THEN + X_GEN_TAC `a:real` THEN DISCH_THEN SUBST_ALL_TAC THEN + REWRITE_TAC[VECTOR_MUL_ASSOC; REAL_MUL_RID] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^N = &0 % basis 1`) THEN + SIMP_TAC[SEGMENT_SCALAR_MULTIPLE; BASIS_NONZERO; DIMINDEX_GE_1; LE_REFL; + VECTOR_MUL_RCANCEL; IMAGE_EQ_EMPTY; FINITE_IMAGE_INJ_EQ; SET_RULE + `(!x y. x % v = y % v <=> x = y) + ==> {x % v | P x} INTER {x % v | Q x} = + IMAGE (\x. x % v) {x | P x /\ Q x}`] THEN + REWRITE_TAC[REAL_ARITH `(&0 < x /\ x < &1 \/ &1 < x /\ x < &0) /\ + (b < x /\ x < a \/ a < x /\ x < b) <=> + max (&0) (min a b) < x /\ x < min (&1) (max a b)`] THEN + SIMP_TAC[FINITE_REAL_INTERVAL; EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN + SIMP_TAC[GSYM REAL_LT_BETWEEN; GSYM NOT_EXISTS_THM] THEN REAL_ARITH_TAC; + DISCH_TAC THEN ASM_CASES_TAC + `segment(vec 0:real^N,&1 % basis 1) INTER segment (x,y) = {}` THEN + ASM_REWRITE_TAC[FINITE_EMPTY] THEN DISCH_THEN(K ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[open_segment; IN_DIFF; NOT_IN_EMPTY; + DE_MORGAN_THM; IN_INTER; IN_INSERT] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real^N` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `~collinear{vec 0:real^N,&1 % basis 1, y}` THEN + RULE_ASSUM_TAC(REWRITE_RULE[VECTOR_MUL_LID]) THEN + REWRITE_TAC[VECTOR_MUL_LID] THEN + MATCH_MP_TAC COLLINEAR_SUBSET THEN + EXISTS_TAC `{p,x:real^N, y, vec 0, basis 1}` THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + MP_TAC(ISPECL [`{y:real^N,vec 0,basis 1}`; `p:real^N`; `x:real^N`] + COLLINEAR_TRIPLES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `{p,x,y} = {x,p,y}`] THEN + MATCH_MP_TAC BETWEEN_IMP_COLLINEAR THEN + ASM_REWRITE_TAC[BETWEEN_IN_SEGMENT]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM COLLINEAR_4_3] THEN + ONCE_REWRITE_TAC[SET_RULE `{p,x,z,w} = {w,z,p,x}`] THEN + SIMP_TAC[COLLINEAR_4_3; BASIS_NONZERO; DIMINDEX_GE_1; ARITH] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP BETWEEN_IMP_COLLINEAR o + GEN_REWRITE_RULE I [GSYM BETWEEN_IN_SEGMENT])) THEN + REPEAT(POP_ASSUM MP_TAC) THEN SIMP_TAC[INSERT_AC]]);; + +let DIST_IN_CLOSED_SEGMENT,DIST_IN_OPEN_SEGMENT = (CONJ_PAIR o prove) + (`(!a b x:real^N. + x IN segment[a,b] ==> dist(x,a) <= dist(a,b) /\ dist(x,b) <= dist(a,b)) /\ + (!a b x:real^N. + x IN segment(a,b) ==> dist(x,a) < dist(a,b) /\ dist(x,b) < dist(a,b))`, + SIMP_TAC[IN_SEGMENT; RIGHT_AND_EXISTS_THM; LEFT_IMP_EXISTS_THM; dist; + VECTOR_ARITH + `((&1 - u) % a + u % b) - a:real^N = u % (b - a) /\ + ((&1 - u) % a + u % b) - b = --(&1 - u) % (b - a)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_NEG; NORM_SUB] THEN CONJ_TAC THEN + REPEAT GEN_TAC THEN STRIP_TAC THENL + [REWRITE_TAC[REAL_ARITH `x * y <= y <=> x * y <= &1 * y`] THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `x * y < y <=> x * y < &1 * y`] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let DIST_DECREASES_OPEN_SEGMENT = prove + (`!a b c x:real^N. + x IN segment(a,b) ==> dist(c,x) < dist(c,a) \/ dist(c,x) < dist(c,b)`, + GEOM_ORIGIN_TAC `a:real^N` THEN GEOM_NORMALIZE_TAC `b:real^N` THEN + REWRITE_TAC[SEGMENT_REFL; NOT_IN_EMPTY] THEN X_GEN_TAC `b:real^N` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `b:real^N` THEN X_GEN_TAC `b:real` THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; real_abs; DIMINDEX_GE_1; LE_REFL; + REAL_MUL_RID; VECTOR_MUL_LID] THEN + REPEAT(DISCH_THEN(K ALL_TAC)) THEN REPEAT GEN_TAC THEN + REWRITE_TAC[IN_SEGMENT; dist] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[VECTOR_MUL_RZERO; VECTOR_ADD_LID] THEN + SUBGOAL_THEN + `norm((c$1 - u) % basis 1:real^N) < norm((c:real^N)$1 % basis 1:real^N) \/ + norm((c$1 - u) % basis 1:real^N) < norm((c$1 - &1) % basis 1:real^N)` + MP_TAC THENL + [SIMP_TAC[NORM_MUL; NORM_BASIS; DIMINDEX_GE_1; LE_REFL] THEN + ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[NORM_LT; DOT_LMUL; DOT_RMUL; DOT_BASIS; DIMINDEX_GE_1; + DOT_LSUB; DOT_RSUB; LE_REFL; VECTOR_MUL_COMPONENT; VEC_COMPONENT; + BASIS_COMPONENT; DOT_LZERO; DOT_RZERO; VECTOR_SUB_COMPONENT] THEN + ASM_REAL_ARITH_TAC]);; + +let DIST_DECREASES_CLOSED_SEGMENT = prove + (`!a b c x:real^N. + x IN segment[a,b] ==> dist(c,x) <= dist(c,a) \/ dist(c,x) <= dist(c,b)`, + REWRITE_TAC[SEGMENT_CLOSED_OPEN; IN_UNION; IN_INSERT; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[DIST_DECREASES_OPEN_SEGMENT; REAL_LE_REFL; REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* Limit component bounds. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPONENT_UBOUND = prove + (`!net:(A)net f (l:real^N) b k. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. (f x)$k <= b) net /\ + 1 <= k /\ k <= dimindex(:N) + ==> l$k <= b`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`net:(A)net`; `f:A->real^N`; `{y:real^N | basis k dot y <= b}`; `l:real^N`] + LIM_IN_CLOSED_SET) THEN + ASM_SIMP_TAC[CLOSED_HALFSPACE_LE; IN_ELIM_THM; DOT_BASIS]);; + +let LIM_COMPONENT_LBOUND = prove + (`!net:(A)net f (l:real^N) b k. + ~(trivial_limit net) /\ (f --> l) net /\ + eventually (\x. b <= (f x)$k) net /\ + 1 <= k /\ k <= dimindex(:N) + ==> b <= l$k`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`net:(A)net`; `f:A->real^N`; `{y:real^N | b <= basis k dot y}`; `l:real^N`] + LIM_IN_CLOSED_SET) THEN + ASM_SIMP_TAC[REWRITE_RULE[real_ge] CLOSED_HALFSPACE_GE; + IN_ELIM_THM; DOT_BASIS]);; + +let LIM_COMPONENT_EQ = prove + (`!net f:A->real^N i l b. + (f --> l) net /\ 1 <= i /\ i <= dimindex(:N) /\ + ~(trivial_limit net) /\ eventually (\x. f(x)$i = b) net + ==> l$i = b`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; EVENTUALLY_AND] THEN + MESON_TAC[LIM_COMPONENT_UBOUND; LIM_COMPONENT_LBOUND]);; + +let LIM_COMPONENT_LE = prove + (`!net:(A)net f:A->real^N g:A->real^N k l m. + ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ + eventually (\x. (f x)$k <= (g x)$k) net /\ + 1 <= k /\ k <= dimindex(:N) + ==> l$k <= m$k`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; LIM_COMPONENT_LBOUND] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> b /\ a ==> c ==> d`] THEN + DISCH_THEN(MP_TAC o MATCH_MP LIM_SUB) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; LIM_COMPONENT_LBOUND]);; + +let LIM_DROP_LE = prove + (`!net:(A)net f g l m. + ~(trivial_limit net) /\ (f --> l) net /\ (g --> m) net /\ + eventually (\x. drop(f x) <= drop(g x)) net + ==> drop l <= drop m`, + REWRITE_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `net:(A)net` LIM_COMPONENT_LE) THEN + MAP_EVERY EXISTS_TAC [`f:A->real^1`; `g:A->real^1`] THEN + ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL]);; + +let LIM_DROP_UBOUND = prove + (`!net f:A->real^1 l b. + (f --> l) net /\ + ~(trivial_limit net) /\ eventually (\x. drop(f x) <= b) net + ==> drop l <= b`, + SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_COMPONENT_UBOUND THEN + REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; + +let LIM_DROP_LBOUND = prove + (`!net f:A->real^1 l b. + (f --> l) net /\ + ~(trivial_limit net) /\ eventually (\x. b <= drop(f x)) net + ==> b <= drop l`, + SIMP_TAC[drop] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_COMPONENT_LBOUND THEN + REWRITE_TAC[LE_REFL; DIMINDEX_1] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Also extending closed bounds to closures. *) +(* ------------------------------------------------------------------------- *) + +let IMAGE_CLOSURE_SUBSET = prove + (`!f (s:real^N->bool) (t:real^M->bool). + f continuous_on closure s /\ closed t /\ IMAGE f s SUBSET t + ==> IMAGE f (closure s) SUBSET t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `closure s SUBSET {x | (f:real^N->real^M) x IN t}` MP_TAC + THENL [MATCH_MP_TAC SUBSET_TRANS; SET_TAC []] THEN + EXISTS_TAC `{x | x IN closure s /\ (f:real^N->real^M) x IN t}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CLOSURE_MINIMAL; SET_TAC[]] THEN + ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CLOSURE] THEN + MP_TAC (ISPEC `s:real^N->bool` CLOSURE_SUBSET) THEN ASM SET_TAC[]);; + +let CLOSURE_IMAGE_CLOSURE = prove + (`!f:real^M->real^N s. + f continuous_on closure s + ==> closure(IMAGE f (closure s)) = closure(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN + SIMP_TAC[SUBSET_CLOSURE; IMAGE_SUBSET; CLOSURE_SUBSET] THEN + SIMP_TAC[CLOSURE_MINIMAL_EQ; CLOSED_CLOSURE] THEN + MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN + ASM_REWRITE_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET]);; + +let CLOSURE_IMAGE_BOUNDED = prove + (`!f:real^M->real^N s. + f continuous_on closure s /\ bounded s + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS `closure(IMAGE (f:real^M->real^N) (closure s))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[CLOSURE_IMAGE_CLOSURE]; ALL_TAC] THEN + MATCH_MP_TAC CLOSURE_CLOSED THEN MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE]);; + +let CONTINUOUS_ON_CLOSURE_NORM_LE = prove + (`!f:real^N->real^M s x b. + f continuous_on (closure s) /\ + (!y. y IN s ==> norm(f y) <= b) /\ + x IN (closure s) + ==> norm(f x) <= b`, + REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET cball(vec 0,b)` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN + ASM_REWRITE_TAC [CLOSED_CBALL] THEN ASM SET_TAC []);; + +let CONTINUOUS_ON_CLOSURE_COMPONENT_LE = prove + (`!f:real^N->real^M s x b k. + f continuous_on (closure s) /\ + (!y. y IN s ==> (f y)$k <= b) /\ + x IN (closure s) + ==> (f x)$k <= b`, + REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k <= b}` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC []] THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE] THEN ASM SET_TAC[]);; + +let CONTINUOUS_ON_CLOSURE_COMPONENT_GE = prove + (`!f:real^N->real^M s x b k. + f continuous_on (closure s) /\ + (!y. y IN s ==> b <= (f y)$k) /\ + x IN (closure s) + ==> b <= (f x)$k`, + REWRITE_TAC [GSYM IN_CBALL_0] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^M) (closure s) SUBSET {x | x$k >= b}` + MP_TAC THENL + [MATCH_MP_TAC IMAGE_CLOSURE_SUBSET; ASM SET_TAC [real_ge]] THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE] THEN ASM SET_TAC[real_ge]);; + +(* ------------------------------------------------------------------------- *) +(* Limits relative to a union. *) +(* ------------------------------------------------------------------------- *) + +let LIM_WITHIN_UNION = prove + (`(f --> l) (at x within (s UNION t)) <=> + (f --> l) (at x within s) /\ (f --> l) (at x within t)`, + REWRITE_TAC[LIM_WITHIN; IN_UNION; AND_FORALL_THM] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_TAC `d:real`) (X_CHOOSE_TAC `k:real`)) THEN + EXISTS_TAC `min d k` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_UNION = prove + (`!f s t. closed s /\ closed t /\ f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REWRITE_TAC[CONTINUOUS_ON; CLOSED_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN + MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; + +let CONTINUOUS_ON_CASES = prove + (`!P f g:real^M->real^N s t. + closed s /\ closed t /\ f continuous_on s /\ g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_UNION_LOCAL = prove + (`!f:real^M->real^N s. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ f continuous_on t + ==> f continuous_on (s UNION t)`, + REWRITE_TAC[CONTINUOUS_ON; CLOSED_IN_LIMPT; IN_UNION; LIM_WITHIN_UNION] THEN + MESON_TAC[LIM; TRIVIAL_LIMIT_WITHIN]);; + +let CONTINUOUS_ON_CASES_LOCAL = prove + (`!P f g:real^M->real^N s t. + closed_in (subtopology euclidean (s UNION t)) s /\ + closed_in (subtopology euclidean (s UNION t)) t /\ + f continuous_on s /\ g continuous_on t /\ + (!x. x IN s /\ ~P x \/ x IN t /\ P x ==> f x = g x) + ==> (\x. if P x then f x else g x) continuous_on (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_UNION_LOCAL THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_EQ THENL + [EXISTS_TAC `f:real^M->real^N`; EXISTS_TAC `g:real^M->real^N`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let CONTINUOUS_ON_CASES_LE = prove + (`!f g:real^M->real^N h s a. + f continuous_on {t | t IN s /\ h t <= a} /\ + g continuous_on {t | t IN s /\ a <= h t} /\ + (lift o h) continuous_on s /\ + (!t. t IN s /\ h t = a ==> f t = g t) + ==> (\t. if h t <= a then f(t) else g(t)) continuous_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC + `{t | t IN s /\ (h:real^M->real) t <= a} UNION + {t | t IN s /\ a <= h t}` THEN + CONJ_TAC THENL + [ALL_TAC; SIMP_TAC[SUBSET; IN_UNION; IN_ELIM_THM; REAL_LE_TOTAL]] THEN + MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM; GSYM CONJ_ASSOC; REAL_LE_ANTISYM] THEN + REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `{t | t IN s /\ (h:real^M->real) t <= a} = + {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ + (lift o h) t IN {x | x$1 <= a}}` + (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) + THENL + [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; + IN_UNION] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SET_TAC[]]; + SUBGOAL_THEN + `{t | t IN s /\ a <= (h:real^M->real) t} = + {t | t IN ({t | t IN s /\ h t <= a} UNION {t | t IN s /\ a <= h t}) /\ + (lift o h) t IN {x | x$1 >= a}}` + (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) + THENL + [REWRITE_TAC[GSYM drop; o_THM; IN_ELIM_THM; LIFT_DROP; EXTENSION; + IN_UNION] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_CLOSED_IN_PREIMAGE THEN + ASM_REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE; ETA_AX] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + SET_TAC[]]]);; + +let CONTINUOUS_ON_CASES_1 = prove + (`!f g:real^1->real^N s a. + f continuous_on {t | t IN s /\ drop t <= a} /\ + g continuous_on {t | t IN s /\ a <= drop t} /\ + (lift a IN s ==> f(lift a) = g(lift a)) + ==> (\t. if drop t <= a then f(t) else g(t)) continuous_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LE THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_MESON_TAC[]);; + +let EXTENSION_FROM_CLOPEN = prove + (`!f:real^M->real^N s t u. + open_in (subtopology euclidean s) t /\ + closed_in (subtopology euclidean s) t /\ + f continuous_on t /\ IMAGE f t SUBSET u /\ (u = {} ==> s = {}) + ==> ?g. g continuous_on s /\ IMAGE g s SUBSET u /\ + !x. x IN t ==> g x = f x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `u:real^N->bool = {}` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_EMPTY; IMAGE_CLAUSES; SUBSET_EMPTY; + IMAGE_EQ_EMPTY; NOT_IN_EMPTY] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:real^N`) THEN + EXISTS_TAC `\x. if x IN t then (f:real^M->real^N) x else a` THEN + SIMP_TAC[SUBSET; FORALL_IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + SUBGOAL_THEN `s:real^M->bool = t UNION (s DIFF t)` SUBST1_TAC THENL + [ASM SET_TAC[]; MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL] THEN + ASM_SIMP_TAC[SET_RULE `t SUBSET s ==> t UNION (s DIFF t) = s`] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; IN_DIFF] THEN + CONJ_TAC THENL [MATCH_MP_TAC CLOSED_IN_DIFF; MESON_TAC[]] THEN + ASM_REWRITE_TAC[CLOSED_IN_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Componentwise limits and continuity. *) +(* ------------------------------------------------------------------------- *) + +let LIM_COMPONENTWISE_LIFT = prove + (`!net f:A->real^N. + (f --> l) net <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> ((\x. lift((f x)$i)) --> lift(l$i)) net`, + REPEAT GEN_TAC THEN REWRITE_TAC[tendsto] THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN + ASM_SIMP_TAC[GSYM VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + GEN_TAC THEN REWRITE_TAC[dist] THEN MATCH_MP_TAC(REAL_ARITH + `y <= x ==> x < e ==> y < e`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM; GSYM LIFT_SUB; NORM_LIFT; + GSYM VECTOR_SUB_COMPONENT]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [RIGHT_IMP_FORALL_THM] THEN + ONCE_REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[GSYM IN_NUMSEG; RIGHT_FORALL_IMP_THM] THEN + SIMP_TAC[FORALL_EVENTUALLY; FINITE_NUMSEG; NUMSEG_EMPTY; + GSYM NOT_LE; DIMINDEX_GE_1] THEN + REWRITE_TAC[DIST_LIFT; GSYM VECTOR_SUB_COMPONENT] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &(dimindex(:N))`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `x:A` THEN SIMP_TAC[GSYM VECTOR_SUB_COMPONENT; dist] THEN + DISCH_TAC THEN W(MP_TAC o PART_MATCH lhand NORM_LE_L1 o lhand o snd) THEN + MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; GSYM NOT_LE; DIMINDEX_GE_1; + CARD_NUMSEG_1; GSYM IN_NUMSEG]]);; + +let CONTINUOUS_COMPONENTWISE_LIFT = prove + (`!net f:A->real^N. + f continuous net <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift((f x)$i)) continuous net`, + REWRITE_TAC[continuous; GSYM LIM_COMPONENTWISE_LIFT]);; + +let CONTINUOUS_ON_COMPONENTWISE_LIFT = prove + (`!f:real^M->real^N s. + f continuous_on s <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> (\x. lift((f x)$i)) continuous_on s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) + [CONTINUOUS_COMPONENTWISE_LIFT] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some more convenient intermediate-value theorem formulations. *) +(* ------------------------------------------------------------------------- *) + +let CONNECTED_IVT_HYPERPLANE = prove + (`!s x y:real^N a b. + connected s /\ + x IN s /\ y IN s /\ a dot x <= b /\ b <= a dot y + ==> ?z. z IN s /\ a dot z = b`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [connected]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_THEN(MP_TAC o SPECL + [`{x:real^N | a dot x < b}`; `{x:real^N | a dot x > b}`]) THEN + REWRITE_TAC[OPEN_HALFSPACE_LT; OPEN_HALFSPACE_GT] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; NOT_IN_EMPTY; SUBSET; + IN_UNION; REAL_LT_LE; real_gt] THEN + ASM_MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM]);; + +let CONNECTED_IVT_COMPONENT = prove + (`!s x y:real^N a k. + connected s /\ x IN s /\ y IN s /\ + 1 <= k /\ k <= dimindex(:N) /\ x$k <= a /\ a <= y$k + ==> ?z. z IN s /\ z$k = a`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`s:real^N->bool`; `x:real^N`; `y:real^N`; `(basis k):real^N`; + `a:real`] CONNECTED_IVT_HYPERPLANE) THEN + ASM_SIMP_TAC[DOT_BASIS]);; + +(* ------------------------------------------------------------------------- *) +(* Rather trivial observation that we can map any connected set on segment. *) +(* ------------------------------------------------------------------------- *) + +let MAPPING_CONNECTED_ONTO_SEGMENT = prove + (`!s:real^M->bool a b:real^N. + connected s /\ ~(?a. s SUBSET {a}) + ==> ?f. f continuous_on s /\ IMAGE f s = segment[a,b]`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(?a. s SUBSET {a}) ==> ?a b. a IN s /\ b IN s /\ ~(a = b)`)) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:real^M`; `v:real^M`] THEN STRIP_TAC THEN EXISTS_TAC + `\x:real^M. a + dist(u,x) / (dist(u,x) + dist(v,x)) % (b - a:real^N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN SIMP_TAC[o_DEF; CONTINUOUS_ON_CONST]; + REWRITE_TAC[segment; VECTOR_ARITH + `(&1 - u) % a + u % b:real^N = a + u % (b - a)`] THEN + MATCH_MP_TAC(SET_RULE + `IMAGE f s = {x | P x} + ==> IMAGE (\x. a + f x % b) s = {a + u % b:real^N | P u}`) THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; + NORM_ARITH `~(u:real^N = v) ==> &0 < dist(u,x) + dist(v,x)`] THEN + CONJ_TAC THENL [CONV_TAC NORM_ARITH; REWRITE_TAC[IN_IMAGE]] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`IMAGE (\x:real^M. lift(dist(u,x) / (dist(u,x) + dist(v,x)))) s`; + `vec 0:real^1`; `vec 1:real^1`; `t:real`; `1`] + CONNECTED_IVT_COMPONENT) THEN + ASM_SIMP_TAC[VEC_COMPONENT; DIMINDEX_1; ARITH_LE] THEN + REWRITE_TAC[EXISTS_IN_IMAGE; GSYM drop; LIFT_DROP] THEN + ANTS_TAC THENL [REWRITE_TAC[IN_IMAGE]; MESON_TAC[]] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONNECTED_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `u:real^M` THEN ASM_REWRITE_TAC[DIST_REFL; real_div] THEN + REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ] THEN REAL_ARITH_TAC; + EXISTS_TAC `v:real^M` THEN ASM_REWRITE_TAC[DIST_REFL] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; DIST_EQ_0; REAL_ADD_RID] THEN + REWRITE_TAC[GSYM LIFT_NUM; LIFT_EQ]]] THEN + REWRITE_TAC[real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_DIST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[LIFT_ADD; NORM_ARITH + `~(u:real^N = v) ==> ~(dist(u,x) + dist(v,x) = &0)`] THEN + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REWRITE_RULE[o_DEF] CONTINUOUS_ON_LIFT_DIST]);; + +(* ------------------------------------------------------------------------- *) +(* Also more convenient formulations of monotone convergence. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_INCREASING_CONVERGENT = prove + (`!s:num->real^1. + bounded {s n | n IN (:num)} /\ (!n. drop(s n) <= drop(s(SUC n))) + ==> ?l. (s --> l) sequentially`, + GEN_TAC THEN + REWRITE_TAC[bounded; IN_ELIM_THM; ABS_DROP; LIM_SEQUENTIALLY; dist; + DROP_SUB; IN_UNIV; GSYM EXISTS_DROP] THEN + DISCH_TAC THEN MATCH_MP_TAC CONVERGENT_BOUNDED_MONOTONE THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISJ1_TAC THEN MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_REWRITE_TAC[REAL_LE_TRANS; REAL_LE_REFL]);; + +let BOUNDED_DECREASING_CONVERGENT = prove + (`!s:num->real^1. + bounded {s n | n IN (:num)} /\ (!n. drop(s(SUC n)) <= drop(s(n))) + ==> ?l. (s --> l) sequentially`, + GEN_TAC THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + MP_TAC(ISPEC `\n. --((s:num->real^1) n)` BOUNDED_INCREASING_CONVERGENT) THEN + ASM_SIMP_TAC[bounded; FORALL_IN_GSPEC; NORM_NEG; DROP_NEG; REAL_LE_NEG2] THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [GSYM LIM_NEG_EQ] THEN + REWRITE_TAC[VECTOR_NEG_NEG; ETA_AX] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Since we'll use some cardinality reasoning, add invariance theorems. *) +(* ------------------------------------------------------------------------- *) + +let card_translation_invariants = (CONJUNCTS o prove) + (`(!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s =_c t <=> s =_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s =_c IMAGE (\x. a + x) t <=> s =_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s <_c t <=> s <_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s <_c IMAGE (\x. a + x) t <=> s <_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s <=_c t <=> s <=_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s <=_c IMAGE (\x. a + x) t <=> s <=_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s >_c t <=> s >_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s >_c IMAGE (\x. a + x) t <=> s >_c t) /\ + (!a (s:real^N->bool) (t:A->bool). + IMAGE (\x. a + x) s >=_c t <=> s >=_c t) /\ + (!a (s:A->bool) (t:real^N->bool). + s >=_c IMAGE (\x. a + x) t <=> s >=_c t)`, + REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG] THEN + REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN + SIMP_TAC[VECTOR_ARITH `a + x:real^N = a + y <=> x = y`]) in +add_translation_invariants card_translation_invariants;; + +let card_linear_invariants = (CONJUNCTS o prove) + (`(!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s =_c t <=> s =_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s =_c IMAGE f t <=> s =_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s <_c t <=> s <_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s <_c IMAGE f t <=> s <_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s <=_c t <=> s <=_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s <=_c IMAGE f t <=> s <=_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s >_c t <=> s >_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s >_c IMAGE f t <=> s >_c t)) /\ + (!(f:real^M->real^N) s (t:A->bool). + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s >=_c t <=> s >=_c t)) /\ + (!(f:real^M->real^N) (s:A->bool) t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s >=_c IMAGE f t <=> s >=_c t))`, + REWRITE_TAC[gt_c; ge_c] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_EQ_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LT_CONG; + MATCH_MP_TAC CARD_LE_CONG; + MATCH_MP_TAC CARD_LE_CONG] THEN + REWRITE_TAC[CARD_EQ_REFL] THEN MATCH_MP_TAC CARD_EQ_IMAGE THEN + ASM_MESON_TAC[]) in +add_linear_invariants card_linear_invariants;; + +(* ------------------------------------------------------------------------- *) +(* Basic homeomorphism definitions. *) +(* ------------------------------------------------------------------------- *) + +let homeomorphism = new_definition + `homeomorphism (s,t) (f,g) <=> + (!x. x IN s ==> (g(f(x)) = x)) /\ (IMAGE f s = t) /\ f continuous_on s /\ + (!y. y IN t ==> (f(g(y)) = y)) /\ (IMAGE g t = s) /\ g continuous_on t`;; + +parse_as_infix("homeomorphic",(12,"right"));; + +let homeomorphic = new_definition + `s homeomorphic t <=> ?f g. homeomorphism (s,t) (f,g)`;; + +let HOMEOMORPHISM = prove + (`!s:real^M->bool t:real^N->bool f g. + homeomorphism (s,t) (f,g) <=> + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET s /\ + (!x. x IN s ==> g (f x) = x) /\ + (!y. y IN t ==> f (g y) = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN + EQ_TAC THEN SIMP_TAC[] THEN SET_TAC[]);; + +let HOMEOMORPHISM_OF_SUBSETS = prove + (`!f g s t s' t'. + homeomorphism (s,t) (f,g) /\ s' SUBSET s /\ t' SUBSET t /\ IMAGE f s' = t' + ==> homeomorphism (s',t') (f,g)`, + REWRITE_TAC[homeomorphism] THEN + REPEAT STRIP_TAC THEN + TRY(MATCH_MP_TAC CONTINUOUS_ON_SUBSET) THEN ASM SET_TAC[]);; + +let HOMEOMORPHISM_ID = prove + (`!s:real^N->bool. homeomorphism (s,s) ((\x. x),(\x. x))`, + REWRITE_TAC[homeomorphism; IMAGE_ID; CONTINUOUS_ON_ID]);; + +let HOMEOMORPHISM_I = prove + (`!s:real^N->bool. homeomorphism (s,s) (I,I)`, + REWRITE_TAC[I_DEF; HOMEOMORPHISM_ID]);; + +let HOMEOMORPHIC_REFL = prove + (`!s:real^N->bool. s homeomorphic s`, + REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_I]);; + +let HOMEOMORPHISM_SYM = prove + (`!f:real^M->real^N g s t. + homeomorphism (s,t) (f,g) <=> homeomorphism (t,s) (g,f)`, + REWRITE_TAC[homeomorphism] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_SYM = prove + (`!s t. s homeomorphic t <=> t homeomorphic s`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_EXISTS_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN CONV_TAC TAUT);; + +let HOMEOMORPHISM_COMPOSE = prove + (`!f:real^M->real^N g h:real^N->real^P k s t u. + homeomorphism (s,t) (f,g) /\ homeomorphism (t,u) (h,k) + ==> homeomorphism (s,u) (h o f,g o k)`, + SIMP_TAC[homeomorphism; CONTINUOUS_ON_COMPOSE; IMAGE_o; o_THM] THEN + SET_TAC[]);; + +let HOMEOMORPHIC_TRANS = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + s homeomorphic t /\ t homeomorphic u ==> s homeomorphic u`, + REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPOSE]);; + +let HOMEOMORPHIC_IMP_CARD_EQ = prove + (`!s:real^M->bool t:real^N->bool. s homeomorphic t ==> s =_c t`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism; eq_c] THEN + MATCH_MP_TAC MONO_EXISTS THEN SET_TAC[]);; + +let HOMEOMORPHIC_EMPTY = prove + (`(!s. (s:real^N->bool) homeomorphic ({}:real^M->bool) <=> s = {}) /\ + (!s. ({}:real^M->bool) homeomorphic (s:real^N->bool) <=> s = {})`, + REWRITE_TAC[homeomorphic; homeomorphism; IMAGE_CLAUSES; IMAGE_EQ_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[continuous_on; NOT_IN_EMPTY]);; + +let HOMEOMORPHIC_MINIMAL = prove + (`!s t. s homeomorphic t <=> + ?f g. (!x. x IN s ==> f(x) IN t /\ (g(f(x)) = x)) /\ + (!y. y IN t ==> g(y) IN s /\ (f(g(y)) = y)) /\ + f continuous_on s /\ g continuous_on t`, + REWRITE_TAC[homeomorphic; homeomorphism; EXTENSION; IN_IMAGE] THEN + REPEAT GEN_TAC THEN REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN MESON_TAC[]);; + +let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (IMAGE f s) homeomorphic s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `f:real^M->real^N` THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON; FORALL_IN_IMAGE; FUN_IN_IMAGE] THEN + ASM_SIMP_TAC[continuous_on; IMP_CONJ; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e * B:real` THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + X_GEN_TAC `y:real^M` THEN ASM_SIMP_TAC[dist; GSYM LINEAR_SUB] THEN + DISCH_TAC THEN ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; + +let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((IMAGE f s) homeomorphic t <=> s homeomorphic t)`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o SPEC `s:real^M->bool` o + MATCH_MP HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_SELF) THEN + EQ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [HOMEOMORPHIC_SYM]); + POP_ASSUM MP_TAC] THEN + REWRITE_TAC[IMP_IMP; HOMEOMORPHIC_TRANS]);; + +let HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ = prove + (`!f:real^M->real^N s t. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (s homeomorphic (IMAGE f t) <=> s homeomorphic t)`, + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ]);; + +add_linear_invariants + [HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ; + HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ];; + +let HOMEOMORPHIC_TRANSLATION_SELF = prove + (`!a:real^N s. (IMAGE (\x. a + x) s) homeomorphic s`, + REPEAT GEN_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `\x:real^N. x - a` THEN + EXISTS_TAC `\x:real^N. a + x` THEN + SIMP_TAC[FORALL_IN_IMAGE; CONTINUOUS_ON_SUB; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ADD; VECTOR_ADD_SUB] THEN + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_TRANSLATION_LEFT_EQ = prove + (`!a:real^N s t. + (IMAGE (\x. a + x) s) homeomorphic t <=> s homeomorphic t`, + MESON_TAC[HOMEOMORPHIC_TRANSLATION_SELF; + HOMEOMORPHIC_SYM; HOMEOMORPHIC_TRANS]);; + +let HOMEOMORPHIC_TRANSLATION_RIGHT_EQ = prove + (`!a:real^N s t. + s homeomorphic (IMAGE (\x. a + x) t) <=> s homeomorphic t`, + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_TRANSLATION_LEFT_EQ]);; + +add_translation_invariants + [HOMEOMORPHIC_TRANSLATION_LEFT_EQ; + HOMEOMORPHIC_TRANSLATION_RIGHT_EQ];; + +let HOMEOMORPHISM_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N g s t. + homeomorphism (s,t) (f,g) + ==> !u. u SUBSET t + ==> (open_in (subtopology euclidean s) {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphism] THEN + STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_RIGHT_INVERSE_IMP_QUOTIENT_MAP THEN + EXISTS_TAC `g:real^N->real^M` THEN ASM_REWRITE_TAC[SUBSET_REFL]);; + +let HOMEOMORPHIC_PCROSS = prove + (`!s:real^M->bool t:real^N->bool s':real^P->bool t':real^Q->bool. + s homeomorphic s' /\ t homeomorphic t' + ==> (s PCROSS t) homeomorphic (s' PCROSS t')`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `f:real^M->real^P` + (X_CHOOSE_THEN `f':real^P->real^M` STRIP_ASSUME_TAC)) + (X_CHOOSE_THEN `g:real^N->real^Q` + (X_CHOOSE_THEN `g':real^Q->real^N` STRIP_ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC + [`(\z. pastecart (f(fstcart z)) (g(sndcart z))) + :real^(M,N)finite_sum->real^(P,Q)finite_sum`; + `(\z. pastecart (f'(fstcart z)) (g'(sndcart z))) + :real^(P,Q)finite_sum->real^(M,N)finite_sum`] THEN + ASM_SIMP_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + SUBSET; FORALL_IN_IMAGE; PASTECART_IN_PCROSS] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_ON_PASTECART THEN + CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_SNDCART; LINEAR_CONTINUOUS_ON] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_PCROSS; SUBSET] THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART]);; + +let HOMEOMORPHIC_PCROSS_SYM = prove + (`!s:real^M->bool t:real^N->bool. (s PCROSS t) homeomorphic (t PCROSS s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; homeomorphism] THEN + EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) + :real^(M,N)finite_sum->real^(N,M)finite_sum` THEN + EXISTS_TAC `(\z. pastecart (sndcart z) (fstcart z)) + :real^(N,M)finite_sum->real^(M,N)finite_sum` THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET; FORALL_IN_IMAGE] THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; LINEAR_SNDCART] THEN + REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + IN_IMAGE; EXISTS_PASTECART; PASTECART_INJ; PASTECART_IN_PCROSS] THEN + MESON_TAC[]);; + +let HOMEOMORPHIC_PCROSS_ASSOC = prove + (`!s:real^M->bool t:real^N->bool u:real^P->bool. + (s PCROSS (t PCROSS u)) homeomorphic ((s PCROSS t) PCROSS u)`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + MAP_EVERY EXISTS_TAC + [`\z:real^(M,(N,P)finite_sum)finite_sum. + pastecart (pastecart (fstcart z) (fstcart(sndcart z))) + (sndcart(sndcart z))`; + `\z:real^((M,N)finite_sum,P)finite_sum. + pastecart (fstcart(fstcart z)) + (pastecart (sndcart(fstcart z)) (sndcart z))`] THEN + REWRITE_TAC[FORALL_IN_PCROSS; SUBSET; FORALL_IN_IMAGE; + RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + SIMP_TAC[FSTCART_PASTECART; SNDCART_PASTECART; PASTECART_IN_PCROSS] THEN + CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REPEAT(MATCH_MP_TAC LINEAR_PASTECART THEN CONJ_TAC) THEN + TRY(GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC LINEAR_COMPOSE) THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +let HOMEOMORPHIC_SCALING_LEFT = prove + (`!c. &0 < c + ==> !s t. (IMAGE (\x. c % x) s) homeomorphic t <=> s homeomorphic t`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_LEFT_EQ THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; + +let HOMEOMORPHIC_SCALING_RIGHT = prove + (`!c. &0 < c + ==> !s t. s homeomorphic (IMAGE (\x. c % x) t) <=> s homeomorphic t`, + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_INJECTIVE_LINEAR_IMAGE_RIGHT_EQ THEN + ASM_SIMP_TAC[VECTOR_MUL_LCANCEL; REAL_LT_IMP_NZ; LINEAR_SCALING]);; + +let HOMEOMORPHIC_SUBSPACES = prove + (`!s:real^M->bool t:real^N->bool. + subspace s /\ subspace t /\ dim s = dim t ==> s homeomorphic t`, + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + DISCH_THEN(MP_TAC o MATCH_MP ISOMETRIES_SUBSPACES) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f:real^M->real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTER; IN_CBALL_0] THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ASM SET_TAC[]);; + +let HOMEOMORPHIC_FINITE = prove + (`!s:real^M->bool t:real^N->bool. + FINITE s /\ FINITE t ==> (s homeomorphic t <=> CARD s = CARD t)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN + ASM_SIMP_TAC[CARD_EQ_CARD]; + STRIP_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + MP_TAC(ISPECL [`s:real^M->bool`; `t:real^N->bool`] + CARD_EQ_BIJECTIONS) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + ASM_SIMP_TAC[CONTINUOUS_ON_FINITE] THEN ASM SET_TAC[]]);; + +let HOMEOMORPHIC_FINITE_STRONG = prove + (`!s:real^M->bool t:real^N->bool. + FINITE s \/ FINITE t + ==> (s homeomorphic t <=> FINITE s /\ FINITE t /\ CARD s = CARD t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THEN + SIMP_TAC[HOMEOMORPHIC_FINITE] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CARD_FINITE_CONG o MATCH_MP + HOMEOMORPHIC_IMP_CARD_EQ) THEN + FIRST_X_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HOMEOMORPHIC_FINITE]);; + +let HOMEOMORPHIC_SING = prove + (`!a:real^M b:real^N. {a} homeomorphic {b}`, + SIMP_TAC[HOMEOMORPHIC_FINITE; FINITE_SING; CARD_SING]);; + +let HOMEOMORPHIC_PCROSS_SING = prove + (`(!s:real^M->bool a:real^N. s homeomorphic (s PCROSS {a})) /\ + (!s:real^M->bool a:real^N. s homeomorphic ({a} PCROSS s))`, + MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL + [MESON_TAC[HOMEOMORPHIC_PCROSS_SYM; HOMEOMORPHIC_TRANS]; ALL_TAC] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + EXISTS_TAC `\x. (pastecart x a:real^(M,N)finite_sum)` THEN + EXISTS_TAC `fstcart:real^(M,N)finite_sum->real^M` THEN + SIMP_TAC[CONTINUOUS_ON_PASTECART; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + SIMP_TAC[LINEAR_FSTCART; LINEAR_CONTINUOUS_ON; SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_IN_PCROSS; PASTECART_IN_PCROSS; IN_SING] THEN + SIMP_TAC[FSTCART_PASTECART]);; + +(* ------------------------------------------------------------------------- *) +(* Inverse function property for open/closed maps. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_ON_INVERSE_OPEN_MAP = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) + ==> g continuous_on t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] + CONTINUOUS_ON_OPEN_GEN) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + ASM SET_TAC[]);; + +let CONTINUOUS_ON_INVERSE_CLOSED_MAP = prove + (`!f:real^M->real^N g s t. + f continuous_on s /\ IMAGE f s = t /\ (!x. x IN s ==> g(f x) = x) /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) + ==> g continuous_on t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real^N->real^M`; `t:real^N->bool`; `s:real^M->bool`] + CONTINUOUS_ON_CLOSED_GEN) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN SUBST1_TAC] THEN + X_GEN_TAC `u:real^M->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real^M->bool`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]);; + +let HOMEOMORPHISM_INJECTIVE_OPEN_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + (!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) + ==> ?g. homeomorphism (s,t) (f,g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_ON_INVERSE_OPEN_MAP THEN ASM_MESON_TAC[]);; + +let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) /\ + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)) + ==> ?g. homeomorphism (s,t) (f,g)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `g:real^N->real^M` THEN + DISCH_TAC THEN ASM_SIMP_TAC[homeomorphism] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_ON_INVERSE_CLOSED_MAP THEN ASM_MESON_TAC[]);; + +let HOMEOMORPHISM_IMP_OPEN_MAP = prove + (`!f:real^M->real^N g s t u. + homeomorphism (s,t) (f,g) /\ open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)`, + REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = + {y | y IN t /\ g(y) IN u}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [open_in]) THEN + ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_IMP_OPEN_IN THEN ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHISM_IMP_CLOSED_MAP = prove + (`!f:real^M->real^N g s t u. + homeomorphism (s,t) (f,g) /\ closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)`, + REWRITE_TAC[homeomorphism] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^M->real^N) u = + {y | y IN t /\ g(y) IN u}` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o GEN_REWRITE_RULE I [closed_in]) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; + MATCH_MP_TAC CONTINUOUS_ON_IMP_CLOSED_IN THEN ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((?g. homeomorphism (s,t) (f,g)) <=> + !u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN ASM_MESON_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + ASM_REWRITE_TAC[]]);; + +let HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((?g. homeomorphism (s,t) (f,g)) <=> + !u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_IMP_CLOSED_MAP THEN ASM_MESON_TAC[]; + MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP THEN + ASM_REWRITE_TAC[]]);; + +let INJECTIVE_MAP_OPEN_IFF_CLOSED = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((!u. open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)) <=> + (!u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `?g:real^N->real^M. homeomorphism (s,t) (f,g)` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP_EQ; + MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_CLOSED_MAP_EQ] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Relatively weak hypotheses if the domain of the function is compact. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_IMP_CLOSED_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s + ==> !u. closed_in (subtopology euclidean s) u + ==> closed_in (subtopology euclidean t) (IMAGE f u)`, + SIMP_TAC[CLOSED_IN_CLOSED_EQ; COMPACT_IMP_CLOSED] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_SUBSET THEN + EXPAND_TAC "t" THEN ASM_SIMP_TAC[IMAGE_SUBSET] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; + BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]);; + +let CONTINUOUS_IMP_QUOTIENT_MAP = prove + (`!f:real^M->real^N s t. + f continuous_on s /\ IMAGE f s = t /\ compact s + ==> !u. u SUBSET t + ==> (open_in (subtopology euclidean s) + {x | x IN s /\ f x IN u} <=> + open_in (subtopology euclidean t) u)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC CLOSED_MAP_IMP_QUOTIENT_MAP THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_IMP_CLOSED_MAP THEN + ASM_REWRITE_TAC[]);; + +let CONTINUOUS_ON_INVERSE = prove + (`!f:real^M->real^N g s. + f continuous_on s /\ compact s /\ (!x. x IN s ==> (g(f(x)) = x)) + ==> g continuous_on (IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CLOSED] THEN + SUBGOAL_THEN `IMAGE g (IMAGE (f:real^M->real^N) s) = s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `t:real^M->bool` THEN DISCH_TAC THEN + REWRITE_TAC[CLOSED_IN_CLOSED] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) t` THEN CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET) THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_IN_CLOSED_TRANS; + BOUNDED_SUBSET; CONTINUOUS_ON_SUBSET]; + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_IMAGE] THEN + ASM_MESON_TAC[CLOSED_IN_SUBSET; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET]]);; + +let HOMEOMORPHISM_COMPACT = prove + (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> ?g. homeomorphism(s,t) (f,g)`, + REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE] THEN REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[EXTENSION; homeomorphism] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_MESON_TAC[CONTINUOUS_ON_INVERSE; IN_IMAGE]);; + +let HOMEOMORPHIC_COMPACT = prove + (`!s f t. compact s /\ f continuous_on s /\ (IMAGE f s = t) /\ + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> s homeomorphic t`, + REWRITE_TAC[homeomorphic] THEN MESON_TAC[HOMEOMORPHISM_COMPACT]);; + +(* ------------------------------------------------------------------------- *) +(* Lemmas about composition of homeomorphisms. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHISM_FROM_COMPOSITION_SURJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s = t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (?h. homeomorphism (s,u) (g o f,h)) + ==> (?f'. homeomorphism (s,t) (f,f')) /\ + (?g'. homeomorphism (t,u) (g,g'))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN + MATCH_MP_TAC(TAUT `q /\ (q ==> p) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_SURJECTIVE THEN + MAP_EVERY EXISTS_TAC [`f:real^M->real^N`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[homeomorphism; o_THM]; + REWRITE_TAC[homeomorphism; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `g':real^P->real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(h:real^P->real^M) o (g:real^N->real^P)` THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; + +let HOMEOMORPHISM_FROM_COMPOSITION_INJECTIVE = prove + (`!f:real^M->real^N g:real^N->real^P s t u. + f continuous_on s /\ IMAGE f s SUBSET t /\ + g continuous_on t /\ IMAGE g t SUBSET u /\ + (!x y. x IN t /\ y IN t /\ g x = g y ==> x = y) /\ + (?h. homeomorphism (s,u) (g o f,h)) + ==> (?f'. homeomorphism (s,t) (f,f')) /\ + (?g'. homeomorphism (t,u) (g,g'))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[homeomorphism; o_THM]) THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC OPEN_MAP_FROM_COMPOSITION_INJECTIVE THEN + MAP_EVERY EXISTS_TAC [`g:real^N->real^P`; `u:real^P->bool`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHISM_IMP_OPEN_MAP THEN + MAP_EVERY EXISTS_TAC [`h:real^P->real^M`; `s:real^M->bool`] THEN + ASM_REWRITE_TAC[homeomorphism; o_THM]; + REWRITE_TAC[homeomorphism; o_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `f':real^N->real^M` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:real^M->real^N) o (h:real^P->real^M)` THEN + ASM_SIMP_TAC[o_THM; IMAGE_o] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* Preservation of topological properties. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_COMPACTNESS = prove + (`!s t. s homeomorphic t ==> (compact s <=> compact t)`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN + MESON_TAC[COMPACT_CONTINUOUS_IMAGE]);; + +let HOMEOMORPHIC_CONNECTEDNESS = prove + (`!s t. s homeomorphic t ==> (connected s <=> connected t)`, + REWRITE_TAC[homeomorphic; homeomorphism] THEN + MESON_TAC[CONNECTED_CONTINUOUS_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Results on translation, scaling etc. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_SCALING = prove + (`!s:real^N->bool c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. c % x) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MAP_EVERY EXISTS_TAC [`\x:real^N. c % x`; `\x:real^N. inv(c) % x`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN + SIMP_TAC[VECTOR_MUL_LID; IN_IMAGE; REAL_MUL_LID] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_TRANSLATION = prove + (`!s a:real^N. s homeomorphic (IMAGE (\x. a + x) s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + MAP_EVERY EXISTS_TAC [`\x:real^N. a + x`; `\x:real^N. --a + x`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID] THEN + SIMP_TAC[VECTOR_ADD_ASSOC; VECTOR_ADD_LINV; VECTOR_ADD_RINV; + FORALL_IN_IMAGE; VECTOR_ADD_LID] THEN + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; + +let HOMEOMORPHIC_AFFINITY = prove + (`!s a:real^N c. ~(c = &0) ==> s homeomorphic (IMAGE (\x. a + c % x) s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HOMEOMORPHIC_TRANS THEN + EXISTS_TAC `IMAGE (\x:real^N. c % x) s` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_SCALING] THEN + SUBGOAL_THEN `(\x:real^N. a + c % x) = (\x. a + x) o (\x. c % x)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_o; HOMEOMORPHIC_TRANSLATION]);; + +let [HOMEOMORPHIC_BALLS; HOMEOMORPHIC_CBALLS; HOMEOMORPHIC_SPHERES] = + (CONJUNCTS o prove) + (`(!a:real^N b:real^N d e. + &0 < d /\ &0 < e ==> ball(a,d) homeomorphic ball(b,e)) /\ + (!a:real^N b:real^N d e. + &0 < d /\ &0 < e ==> cball(a,d) homeomorphic cball(b,e)) /\ + (!a:real^N b:real^N d e. + &0 < d /\ &0 < e ==> sphere(a,d) homeomorphic sphere(b,e))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `\x:real^N. b + (e / d) % (x - a)` THEN + EXISTS_TAC `\x:real^N. a + (d / e) % (x - b)` THEN + ASM_SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_SUB; CONTINUOUS_ON_CMUL; + CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID; IN_BALL; IN_CBALL; IN_SPHERE] THEN + REWRITE_TAC[dist; VECTOR_ARITH `a - (a + b) = --b:real^N`; NORM_NEG] THEN + REWRITE_TAC[real_div; VECTOR_ARITH + `a + d % ((b + e % (x - a)) - b) = (&1 - d * e) % a + (d * e) % x`] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(e * d') * (d * e') = (d * d') * (e * e')`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_SUB_REFL] THEN + REWRITE_TAC[NORM_MUL; VECTOR_MUL_LZERO; VECTOR_MUL_LID; VECTOR_ADD_LID] THEN + ASM_SIMP_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ARITH + `&0 < x ==> (abs x = x)`] THEN + GEN_REWRITE_TAC(BINOP_CONV o BINDER_CONV o funpow 2 RAND_CONV) + [GSYM REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * c = (a * c) * b`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; GSYM real_div; REAL_LE_LDIV_EQ; REAL_MUL_LID; + GSYM REAL_MUL_ASSOC; REAL_LT_LMUL_EQ; REAL_LT_LDIV_EQ; NORM_SUB] THEN + ASM_SIMP_TAC[REAL_DIV_REFL; REAL_LT_IMP_NZ; REAL_MUL_RID]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphism of one-point compactifications. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_ONE_POINT_COMPACTIFICATIONS = prove + (`!s:real^M->bool t:real^N->bool a b. + compact s /\ compact t /\ a IN s /\ b IN t /\ + (s DELETE a) homeomorphic (t DELETE b) + ==> s homeomorphic t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHIC_COMPACT THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [homeomorphic]) THEN + REWRITE_TAC[HOMEOMORPHISM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:real^M->real^N`; `g:real^N->real^M`] THEN + STRIP_TAC THEN + EXISTS_TAC `\x. if x = a then b else (f:real^M->real^N) x` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^M = a` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[continuous_within] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`b:real^N`; `e:real`] CENTRE_IN_BALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `closed_in (subtopology euclidean s) + { x | x IN (s DELETE a) /\ + (f:real^M->real^N)(x) IN t DIFF ball(b,e)}` + MP_TAC THENL + [MATCH_MP_TAC CLOSED_SUBSET THEN CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN SUBGOAL_THEN + `{x | x IN s DELETE a /\ f x IN t DIFF ball(b,e)} = + IMAGE (g:real^N->real^M) (t DIFF ball (b,e))` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[COMPACT_DIFF; OPEN_BALL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + CONTINUOUS_ON_SUBSET)) THEN ASM SET_TAC[]; + REWRITE_TAC[closed_in; open_in; TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN + DISCH_THEN(MP_TAC o SPEC `a:real^M` o last o CONJUNCTS) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF; IN_DELETE] THEN + SIMP_TAC[IMP_CONJ; DE_MORGAN_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[DIST_REFL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_BALL]) THEN ASM SET_TAC[]]; + UNDISCH_TAC `(f:real^M->real^N) continuous_on (s DELETE a)` THEN + REWRITE_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[IN_DELETE] THEN + REWRITE_TAC[continuous_within] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (dist(a:real^M,x))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; GSYM DIST_NZ] THEN + ASM_MESON_TAC[REAL_LT_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphisms between open intervals in real^1 and then in real^N. *) +(* Could prove similar things for closed intervals, but they drop out of *) +(* later stuff in "convex.ml" even more easily. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_OPEN_INTERVALS_1 = prove + (`!a b c d. + drop a < drop b /\ drop c < drop d + ==> interval(a,b) homeomorphic interval(c,d)`, + SUBGOAL_THEN + `!a b. drop a < drop b + ==> interval(vec 0:real^1,vec 1) homeomorphic interval(a,b)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `(\x. a + drop x % (b - a)):real^1->real^1` THEN + EXISTS_TAC `(\x. inv(drop b - drop a) % (x - a)):real^1->real^1` THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; GSYM DROP_EQ] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; DROP_VEC; DROP_SUB] THEN + REWRITE_TAC[REAL_ARITH `inv b * a:real = a / b`] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ; REAL_SUB_LT; + REAL_LT_ADDR; REAL_EQ_LDIV_EQ; REAL_DIV_RMUL; REAL_LT_IMP_NZ; + REAL_LT_MUL; REAL_MUL_LZERO; REAL_ADD_SUB; REAL_LT_RMUL_EQ; + REAL_ARITH `a + x < b <=> x < &1 * (b - a)`] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_VMUL THEN + REWRITE_TAC[o_DEF; LIFT_DROP; CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + ASM_SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]]; + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`a:real^1`; `b:real^1`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`c:real^1`; `d:real^1`]) THEN + ASM_REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_TRANS]]);; + +let HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1 = prove + (`!a b. drop a < drop b ==> interval(a,b) homeomorphic (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real^1`; `b:real^1`; `--vec 1:real^1`; `vec 1:real^1`] + HOMEOMORPHIC_OPEN_INTERVALS_1) THEN + ASM_REWRITE_TAC[DROP_VEC; DROP_NEG] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] HOMEOMORPHIC_TRANS) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_UNIV] THEN + EXISTS_TAC `\x:real^1. inv(&1 - norm x) % x` THEN + EXISTS_TAC `\y. if &0 <= drop y then inv(&1 + drop y) % y + else inv(&1 - drop y) % y` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_INTERVAL_1] THEN + REWRITE_TAC[DROP_NEG; DROP_VEC; DROP_CMUL; NORM_REAL; GSYM drop] THEN + SIMP_TAC[REAL_LE_MUL_EQ; REAL_LT_INV_EQ; REAL_LE_MUL_EQ; REAL_ARITH + `--a < x /\ x < a ==> &0 < a - abs x`] THEN + SIMP_TAC[real_abs; VECTOR_MUL_ASSOC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^1` THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC; REAL_BOUNDS_LT] THEN + REWRITE_TAC[DROP_CMUL; REAL_ABS_MUL; REAL_ABS_INV] THEN + REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] real_div)] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ; REAL_ARITH `&0 <= x ==> &0 < abs(&1 + x)`; + REAL_ARITH `~(&0 <= x) ==> &0 < abs(&1 - x)`] THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[NORM_REAL; VECTOR_MUL_ASSOC] THEN + REWRITE_TAC[GSYM drop; DROP_CMUL; REAL_ABS_MUL] THEN + ASM_REWRITE_TAC[real_abs; REAL_LE_INV_EQ] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> &0 <= &1 + x`; + REAL_ARITH `~(&0 <= x) ==> &0 <= &1 - x`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM VECTOR_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; DROP_NEG; DROP_VEC] THEN + DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[CONTINUOUS_AT_ID] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN + REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_SUB; LIFT_DROP] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_SUB THEN + SIMP_TAC[CONTINUOUS_CONST; REWRITE_RULE[o_DEF] CONTINUOUS_AT_LIFT_NORM]; + REWRITE_TAC[NORM_REAL; GSYM drop] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `(:real^1) = {x | x$1 >= &0} UNION {x | x$1 <= &0}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_ON_CASES THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_LE; CLOSED_HALFSPACE_COMPONENT_GE; + IN_ELIM_THM] THEN + REWRITE_TAC[GSYM drop; REAL_NOT_LE; real_ge; REAL_LET_ANTISYM] THEN + SIMP_TAC[REAL_LE_ANTISYM; REAL_SUB_RZERO; REAL_ADD_RID] THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM; real_ge] THEN + DISCH_TAC THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[CONTINUOUS_AT_ID] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN MATCH_MP_TAC CONTINUOUS_INV THEN + REWRITE_TAC[NETLIMIT_AT; o_DEF; LIFT_ADD; LIFT_SUB; LIFT_DROP] THEN + ASM_SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_AT_ID; CONTINUOUS_SUB; + CONTINUOUS_CONST] THEN + ASM_REAL_ARITH_TAC]]);; + +let HOMEOMORPHIC_OPEN_INTERVALS = prove + (`!a b:real^N c d:real^N. + (interval(a,b) = {} <=> interval(c,d) = {}) + ==> interval(a,b) homeomorphic interval(c,d)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `interval(c:real^N,d) = {}` THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[HOMEOMORPHIC_REFL] THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic + interval(lift((c:real^N)$i),lift((d:real^N)$i))` + MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVALS_1; LIFT_DROP]; + ALL_TAC] THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN + DISCH_TAC THEN + EXISTS_TAC + `(\x. lambda i. + drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + EXISTS_TAC + `(\x. lambda i. + drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP] THEN + ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL + [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; + EXISTS_TAC `interval(lift((c:real^N)$i),lift((d:real^N)$i))`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1] THEN + ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; + +let HOMEOMORPHIC_OPEN_INTERVAL_UNIV = prove + (`!a b:real^N. + ~(interval(a,b) = {}) + ==> interval(a,b) homeomorphic (:real^N)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> interval(lift((a:real^N)$i),lift((b:real^N)$i)) homeomorphic + (:real^1)` + MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[INTERVAL_NE_EMPTY]) THEN + ASM_SIMP_TAC[HOMEOMORPHIC_OPEN_INTERVAL_UNIV_1; LIFT_DROP]; + ALL_TAC] THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`f:num->real^1->real^1`; `g:num->real^1->real^1`] THEN + DISCH_TAC THEN + EXISTS_TAC + `(\x. lambda i. + drop((f:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + EXISTS_TAC + `(\x. lambda i. + drop((g:num->real^1->real^1) i (lift(x$i)))):real^N->real^N` THEN + ASM_SIMP_TAC[IN_INTERVAL; LAMBDA_BETA; CART_EQ; LIFT_DROP; IN_UNIV] THEN + ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[LAMBDA_BETA; LIFT_DROP] THEN CONJ_TAC THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT] THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THENL + [EXISTS_TAC `interval(lift((a:real^N)$i),lift((b:real^N)$i))`; + EXISTS_TAC `(:real^1)`] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_INTERVAL_1; IN_UNIV] THEN + ASM_SIMP_TAC[LIFT_DROP; IN_INTERVAL]);; + +let HOMEOMORPHIC_BALL_UNIV = prove + (`!a:real^N r. &0 < r ==> ball(a,r) homeomorphic (:real^N)`, + REPEAT GEN_TAC THEN GEOM_ORIGIN_TAC `a:real^N` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?y:real^N. r = norm(y)` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[VECTOR_CHOOSE_SIZE; REAL_LT_IMP_LE]; POP_ASSUM MP_TAC] THEN + REWRITE_TAC[NORM_POS_LT] THEN GEOM_NORMALIZE_TAC `y:real^N` THEN + SIMP_TAC[] THEN GEN_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN + REWRITE_TAC[HOMEOMORPHIC_MINIMAL] THEN + EXISTS_TAC `\z:real^N. inv(&1 - norm(z)) % z` THEN + EXISTS_TAC `\z:real^N. inv(&1 + norm(z)) % z` THEN + REWRITE_TAC[IN_BALL; IN_UNIV; DIST_0; VECTOR_MUL_ASSOC; VECTOR_MUL_EQ_0; + VECTOR_ARITH `a % x:real^N = x <=> (a - &1) % x = vec 0`] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN DISJ1_TAC THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `x < &1 ==> abs(&1 - x) = &1 - x`] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `y:real^N` THEN REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_ARITH + `&0 <= y ==> inv(abs(&1 + y)) * z = z / (&1 + y)`] THEN + ASM_SIMP_TAC[NORM_POS_LE; REAL_LT_LDIV_EQ; REAL_ARITH + `&0 <= y ==> &0 < &1 + y`] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; DISJ1_TAC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; REAL_SUB_0; REAL_INV_EQ_1] THEN + MP_TAC(ISPEC `y:real^N` NORM_POS_LE) THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_INV THEN + SIMP_TAC[IN_BALL_0; REAL_SUB_0; REAL_ARITH `x < &1 ==> ~(&1 = x)`] THEN + REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN REWRITE_TAC[CONTINUOUS_ON_ID] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_INV THEN + SIMP_TAC[NORM_POS_LE; REAL_ARITH `&0 <= x ==> ~(&1 + x = &0)`] THEN + REWRITE_TAC[o_DEF; LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinalities of various useful sets. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_EUCLIDEAN = prove + (`(:real^N) =_c (:real)`, + MATCH_MP_TAC CARD_EQ_CART THEN REWRITE_TAC[real_INFINITE]);; + +let UNCOUNTABLE_EUCLIDEAN = prove + (`~COUNTABLE(:real^N)`, + MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]);; + +let CARD_EQ_INTERVAL = prove + (`(!a b:real^N. ~(interval(a,b) = {}) ==> interval[a,b] =_c (:real)) /\ + (!a b:real^N. ~(interval(a,b) = {}) ==> interval(a,b) =_c (:real))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + TRANS_TAC CARD_LE_TRANS `interval(a:real^N,b)` THEN + SIMP_TAC[CARD_LE_SUBSET; INTERVAL_OPEN_SUBSET_CLOSED]; + TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + ALL_TAC] THEN + TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE; + CARD_EQ_EUCLIDEAN] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP HOMEOMORPHIC_OPEN_INTERVAL_UNIV) THEN + DISCH_THEN(MP_TAC o MATCH_MP HOMEOMORPHIC_IMP_CARD_EQ) THEN + MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM]);; + +let UNCOUNTABLE_INTERVAL = prove + (`(!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval[a,b])) /\ + (!a b. ~(interval(a,b) = {}) ==> ~COUNTABLE(interval(a,b)))`, + SIMP_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; CARD_EQ_INTERVAL]);; + +let COUNTABLE_OPEN_INTERVAL = prove + (`!a b. COUNTABLE(interval(a,b)) <=> interval(a,b) = {}`, + MESON_TAC[COUNTABLE_EMPTY; UNCOUNTABLE_INTERVAL]);; + +let CARD_EQ_OPEN = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> s =_c (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_INTERVAL]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N`) THEN + DISCH_THEN(MP_TAC o SPEC `c:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + ASM_CASES_TAC `interval(a:real^N,b) = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN STRIP_TAC THEN + TRANS_TAC CARD_LE_TRANS `interval[a:real^N,b]` THEN + ASM_SIMP_TAC[CARD_LE_SUBSET] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_INTERVAL]]);; + +let UNCOUNTABLE_OPEN = prove + (`!s:real^N->bool. open s /\ ~(s = {}) ==> ~(COUNTABLE s)`, + SIMP_TAC[CARD_EQ_OPEN; CARD_EQ_REAL_IMP_UNCOUNTABLE]);; + +let CARD_EQ_BALL = prove + (`!a:real^N r. &0 < r ==> ball(a,r) =_c (:real)`, + SIMP_TAC[CARD_EQ_OPEN; OPEN_BALL; BALL_EQ_EMPTY; GSYM REAL_NOT_LT]);; + +let CARD_EQ_CBALL = prove + (`!a:real^N r. &0 < r ==> cball(a,r) =_c (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + REWRITE_TAC[CARD_LE_UNIV] THEN MATCH_MP_TAC CARD_EQ_IMP_LE THEN + REWRITE_TAC[CARD_EQ_EUCLIDEAN]; + TRANS_TAC CARD_LE_TRANS `ball(a:real^N,r)` THEN + SIMP_TAC[CARD_LE_SUBSET; BALL_SUBSET_CBALL] THEN + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN ASM_SIMP_TAC[CARD_EQ_BALL]]);; + +let FINITE_IMP_NOT_OPEN = prove + (`!s:real^N->bool. FINITE s /\ ~(s = {}) ==> ~(open s)`, + MESON_TAC[UNCOUNTABLE_OPEN; FINITE_IMP_COUNTABLE]);; + +let OPEN_IMP_INFINITE = prove + (`!s. open s ==> s = {} \/ INFINITE s`, + MESON_TAC[FINITE_IMP_NOT_OPEN; INFINITE]);; + +let EMPTY_INTERIOR_FINITE = prove + (`!s:real^N->bool. FINITE s ==> interior s = {}`, + REPEAT STRIP_TAC THEN MP_TAC(ISPEC `s:real^N->bool` OPEN_INTERIOR) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] FINITE_IMP_NOT_OPEN) THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:real^N->bool` THEN + ASM_REWRITE_TAC[INTERIOR_SUBSET]);; + +let CARD_EQ_CONNECTED = prove + (`!s a b:real^N. + connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> s =_c (:real)`, + GEOM_ORIGIN_TAC `b:real^N` THEN GEOM_NORMALIZE_TAC `a:real^N` THEN + REWRITE_TAC[NORM_EQ_SQUARE; REAL_POS; REAL_POW_ONE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:real^N)` THEN + SIMP_TAC[CARD_LE_UNIV; CARD_EQ_EUCLIDEAN; CARD_EQ_IMP_LE]; + TRANS_TAC CARD_LE_TRANS `interval[vec 0:real^1,vec 1]` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE) THEN + SIMP_TAC[UNIT_INTERVAL_NONEMPTY; CARD_EQ_INTERVAL]; + REWRITE_TAC[LE_C] THEN EXISTS_TAC `\x:real^N. lift(a dot x)` THEN + SIMP_TAC[FORALL_LIFT; LIFT_EQ; IN_INTERVAL_1; LIFT_DROP; DROP_VEC] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN + MATCH_MP_TAC CONNECTED_IVT_HYPERPLANE THEN + MAP_EVERY EXISTS_TAC [`vec 0:real^N`; `a:real^N`] THEN + ASM_REWRITE_TAC[DOT_RZERO]]]);; + +let UNCOUNTABLE_CONNECTED = prove + (`!s a b:real^N. + connected s /\ a IN s /\ b IN s /\ ~(a = b) ==> ~COUNTABLE s`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CARD_EQ_REAL_IMP_UNCOUNTABLE THEN + MATCH_MP_TAC CARD_EQ_CONNECTED THEN + ASM_MESON_TAC[]);; + +let CARD_LT_IMP_DISCONNECTED = prove + (`!s x:real^N. s <_c (:real) /\ x IN s ==> connected_component s x = {x}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SET_RULE + `s = {a} <=> a IN s /\ !a b. a IN s /\ b IN s /\ ~(a = b) ==> F`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[IN] THEN + ASM_REWRITE_TAC[CONNECTED_COMPONENT_REFL_EQ] THEN + MP_TAC(ISPECL [`connected_component s (x:real^N)`; `a:real^N`; `b:real^N`] + CARD_EQ_CONNECTED) THEN + ASM_REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + DISCH_TAC THEN UNDISCH_TAC `(s:real^N->bool) <_c (:real)` THEN + REWRITE_TAC[CARD_NOT_LT] THEN + TRANS_TAC CARD_LE_TRANS `connected_component s (x:real^N)` THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[CARD_EQ_SYM] CARD_EQ_IMP_LE] THEN + MATCH_MP_TAC CARD_LE_SUBSET THEN REWRITE_TAC[CONNECTED_COMPONENT_SUBSET]);; + +let COUNTABLE_IMP_DISCONNECTED = prove + (`!s x:real^N. COUNTABLE s /\ x IN s ==> connected_component s x = {x}`, + SIMP_TAC[CARD_LT_IMP_DISCONNECTED; COUNTABLE_IMP_CARD_LT_REAL]);; + +let CONNECTED_CARD_EQ_IFF_NONTRIVIAL = prove + (`!s:real^N->bool. + connected s ==> (s =_c (:real) <=> ~(?a. s SUBSET {a}))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ALL_TAC; MATCH_MP_TAC CARD_EQ_CONNECTED THEN ASM SET_TAC[]] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET)) THEN + REWRITE_TAC[FINITE_SING] THEN + ASM_MESON_TAC[CARD_EQ_REAL_IMP_UNCOUNTABLE; FINITE_IMP_COUNTABLE]);; + +(* ------------------------------------------------------------------------- *) +(* "Iff" forms of constancy of function from connected set into a set that *) +(* is smaller than R, or countable, or finite, or disconnected, or discrete. *) +(* ------------------------------------------------------------------------- *) + +let [CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ; + CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ; + CONTINUOUS_FINITE_RANGE_CONSTANT_EQ] = (CONJUNCTS o prove) + (`(!s. connected s <=> + !f:real^M->real^N t. + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!y. y IN t ==> connected_component t y = {y}) + ==> ?a. !x. x IN s ==> f x = a) /\ + (!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ + (!x. x IN s + ==> ?e. &0 < e /\ + !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) + ==> ?a. !x. x IN s ==> f x = a) /\ + (!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ FINITE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a)`, + REWRITE_TAC[AND_FORALL_THM] THEN X_GEN_TAC `s:real^M->bool` THEN + MATCH_MP_TAC(TAUT + `(s ==> t) /\ (t ==> u) /\ (u ==> v) /\ (v ==> s) + ==> (s <=> t) /\ (s <=> u) /\ (s <=> v)`) THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^M->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `x:real^M` o + GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `(f:real^M->real^N) x` THEN + MATCH_MP_TAC(SET_RULE + `IMAGE f s SUBSET {a} ==> !y. y IN s ==> f y = a`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(f:real^M->real^N) x`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC CONNECTED_COMPONENT_MAXIMAL THEN + ASM_SIMP_TAC[CONNECTED_CONTINUOUS_IMAGE] THEN ASM SET_TAC[]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; SUBSET_REFL] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SET_RULE + `(!y. y IN s /\ f y IN connected_component (IMAGE f s) a ==> f y = a) /\ + connected_component (IMAGE f s) a SUBSET (IMAGE f s) /\ + connected_component (IMAGE f s) a a + ==> connected_component (IMAGE f s) a = {a}`) THEN + REWRITE_TAC[CONNECTED_COMPONENT_SUBSET; CONNECTED_COMPONENT_REFL_EQ] THEN + ASM_SIMP_TAC[FUN_IN_IMAGE] THEN X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MP_TAC(ISPEC `connected_component (IMAGE (f:real^M->real^N) s) (f x)` + CONNECTED_CLOSED) THEN + REWRITE_TAC[CONNECTED_CONNECTED_COMPONENT] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC + [`cball((f:real^M->real^N) x,e / &2)`; + `(:real^N) DIFF ball((f:real^M->real^N) x,e)`] THEN + REWRITE_TAC[GSYM OPEN_CLOSED; OPEN_BALL; CLOSED_CBALL] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_CBALL; IN_UNION; IN_DIFF; IN_BALL; IN_UNIV] THEN + MATCH_MP_TAC(MESON[SUBSET; CONNECTED_COMPONENT_SUBSET] + `(!x. x IN s ==> P x) + ==> (!x. x IN connected_component s y ==> P x)`) THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `z:real^M` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `z:real^M`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NORM_ARITH; + MATCH_MP_TAC(SET_RULE + `(!x. x IN s /\ x IN t ==> F) ==> s INTER t INTER u = {}`) THEN + REWRITE_TAC[IN_BALL; IN_CBALL; IN_DIFF; IN_UNIV] THEN + UNDISCH_TAC `&0 < e` THEN CONV_TAC NORM_ARITH; + EXISTS_TAC `(f:real^M->real^N) x` THEN + ASM_SIMP_TAC[CENTRE_IN_CBALL; REAL_HALF; REAL_LT_IMP_LE; IN_INTER] THEN + REWRITE_TAC[IN] THEN + ASM_SIMP_TAC[CONNECTED_COMPONENT_REFL_EQ; FUN_IN_IMAGE]; + EXISTS_TAC `(f:real^M->real^N) y` THEN + ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNIV; IN_BALL; REAL_NOT_LT] THEN + ASM_SIMP_TAC[ONCE_REWRITE_RULE[DIST_SYM] dist]]; + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `f:real^M->real^N` THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MATCH_MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `IMAGE (f:real^M->real^N) s DELETE (f x) = {}` THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN ASM SET_TAC[]; + ALL_TAC] THEN + EXISTS_TAC + `inf{norm(z - f x) |z| z IN IMAGE (f:real^M->real^N) s DELETE (f x)}` THEN + REWRITE_TAC[SIMPLE_IMAGE] THEN + ASM_SIMP_TAC[REAL_LT_INF_FINITE; REAL_INF_LE_FINITE; FINITE_DELETE; + FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[IN_DELETE; NORM_POS_LT; VECTOR_SUB_EQ; IN_IMAGE] THEN + MESON_TAC[REAL_LE_REFL]; + REWRITE_TAC[CONNECTED_CLOSED_IN_EQ] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`t:real^M->bool`; `u:real^M->bool`] THEN + STRIP_TAC THEN DISCH_THEN(MP_TAC o SPEC + `(\x. if x IN t then vec 0 else basis 1):real^M->real^N`) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC CONTINUOUS_ON_CASES_LOCAL THEN + ASM_REWRITE_TAC[CONTINUOUS_ON_CONST] THEN ASM SET_TAC[]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{vec 0:real^N,basis 1}` THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN SET_TAC[]; + SUBGOAL_THEN `?a b:real^M. a IN s /\ a IN t /\ b IN s /\ ~(b IN t)` + STRIP_ASSUME_TAC THENL + [ASM SET_TAC[]; DISCH_THEN(CHOOSE_THEN MP_TAC)] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `a:real^M` th) THEN + MP_TAC(SPEC `b:real^M` th)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN + SIMP_TAC[BASIS_NONZERO; LE_REFL; DIMINDEX_GE_1; REAL_LE_REFL]]]);; + +let CONTINUOUS_DISCONNECTED_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ + f continuous_on s /\ IMAGE f s SUBSET t /\ + (!y. y IN t ==> connected_component t y = {y}) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_DISCRETE_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ + f continuous_on s /\ + (!x. x IN s + ==> ?e. &0 < e /\ + !y. y IN s /\ ~(f y = f x) ==> e <= norm(f y - f x)) + ==> ?a. !x. x IN s ==> f x = a`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + REWRITE_TAC[IMP_IMP; GSYM CONTINUOUS_DISCRETE_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_FINITE_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ + f continuous_on s /\ + FINITE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ = prove + (`!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ COUNTABLE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; + REWRITE_TAC[CONTINUOUS_FINITE_RANGE_CONSTANT_EQ]] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[FINITE_IMP_COUNTABLE] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[COUNTABLE_IMP_DISCONNECTED; SUBSET_REFL]);; + +let CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ = prove + (`!s. connected s <=> + !f:real^M->real^N. + f continuous_on s /\ (IMAGE f s) <_c (:real) + ==> ?a. !x. x IN s ==> f x = a`, + GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[CONTINUOUS_DISCONNECTED_RANGE_CONSTANT_EQ]; + REWRITE_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_SIMP_TAC[COUNTABLE_IMP_CARD_LT_REAL] THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) s` THEN + ASM_SIMP_TAC[CARD_LT_IMP_DISCONNECTED; SUBSET_REFL]);; + +let CONTINUOUS_COUNTABLE_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ f continuous_on s /\ COUNTABLE(IMAGE f s) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_COUNTABLE_RANGE_CONSTANT_EQ]);; + +let CONTINUOUS_CARD_LT_RANGE_CONSTANT = prove + (`!f:real^M->real^N s. + connected s /\ f continuous_on s /\ (IMAGE f s) <_c (:real) + ==> ?a. !x. x IN s ==> f x = a`, + MESON_TAC[CONTINUOUS_CARD_LT_RANGE_CONSTANT_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Homeomorphism of hyperplanes. *) +(* ------------------------------------------------------------------------- *) + +let HOMEOMORPHIC_HYPERPLANES = prove + (`!a:real^N b c:real^N d. + ~(a = vec 0) /\ ~(c = vec 0) + ==> {x | a dot x = b} homeomorphic {x | c dot x = d}`, + let lemma = prove + (`~(a = vec 0) + ==> {x:real^N | a dot x = b} homeomorphic {x:real^N | x$1 = &0}`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `?c:real^N. a dot c = b` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b / (a:real^N)$k % basis k:real^N` THEN + ASM_SIMP_TAC[DOT_RMUL; DOT_BASIS; REAL_DIV_RMUL]; + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ABBREV_TAC `p = {x:real^N | x$1 = &0}` THEN + GEOM_ORIGIN_TAC `c:real^N` THEN + REWRITE_TAC[VECTOR_ADD_RID; DOT_RADD; DOT_RZERO; REAL_EQ_ADD_LCANCEL_0; + REAL_ADD_RID] THEN + REPEAT STRIP_TAC THEN UNDISCH_TAC `~(a:real^N = vec 0)` THEN + GEOM_BASIS_MULTIPLE_TAC 1 `a:real^N` THEN + SIMP_TAC[VECTOR_MUL_EQ_0; DE_MORGAN_THM; DOT_LMUL; REAL_ENTIRE] THEN + SIMP_TAC[DOT_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + EXPAND_TAC "p" THEN REWRITE_TAC[HOMEOMORPHIC_REFL]]) in + REPEAT STRIP_TAC THEN + TRANS_TAC HOMEOMORPHIC_TRANS `{x:real^N | x$1 = &0}` THEN + ASM_SIMP_TAC[lemma] THEN ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + ASM_SIMP_TAC[lemma]);; + +let HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE = prove + (`!a:real^N b k c. + ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) + ==> {x | a dot x = b} homeomorphic {x:real^N | x$k = c}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x:real^N | x$k = c} = {x | basis k dot x = c}` SUBST1_TAC + THENL [ASM_SIMP_TAC[DOT_BASIS]; MATCH_MP_TAC HOMEOMORPHIC_HYPERPLANES] THEN + ASM_SIMP_TAC[BASIS_NONZERO]);; + +let HOMEOMORPHIC_STANDARD_HYPERPLANE_HYPERPLANE = prove + (`!a:real^N b k c. + ~(a = vec 0) /\ 1 <= k /\ k <= dimindex(:N) + ==> {x:real^N | x$k = c} homeomorphic {x | a dot x = b}`, + ONCE_REWRITE_TAC[HOMEOMORPHIC_SYM] THEN + REWRITE_TAC[HOMEOMORPHIC_HYPERPLANE_STANDARD_HYPERPLANE]);; + +let HOMEOMORPHIC_HYPERPLANE_UNIV = prove + (`!a b. ~(a = vec 0) /\ dimindex(:N) = dimindex(:M) + 1 + ==> {x:real^N | a dot x = b} homeomorphic (:real^M)`, + REPEAT STRIP_TAC THEN TRANS_TAC HOMEOMORPHIC_TRANS + `{x:real^N | basis(dimindex(:N)) dot x = &0}` THEN + ASM_SIMP_TAC[HOMEOMORPHIC_HYPERPLANES; BASIS_NONZERO; + LE_REFL; DIMINDEX_GE_1] THEN + REWRITE_TAC[homeomorphic; HOMEOMORPHISM] THEN + EXISTS_TAC `(\x. lambda i. x$i):real^N->real^M` THEN + EXISTS_TAC `(\x. lambda i. if i <= dimindex(:M) then x$i else &0) + :real^M->real^N` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT]; + REWRITE_TAC[SUBSET_UNIV]; + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + ASM_SIMP_TAC[DOT_BASIS; LAMBDA_BETA; LE_REFL; ARITH_RULE `1 <= n + 1`; + ARITH_RULE `~(m + 1 <= m)`]; + ASM_SIMP_TAC[IN_ELIM_THM; LAMBDA_BETA; DOT_BASIS; LE_REFL; CART_EQ; + ARITH_RULE `1 <= n + 1`] THEN + GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `i = dimindex(:M) + 1` THEN ASM_REWRITE_TAC[COND_ID] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[LAMBDA_BETA; CART_EQ; IN_UNIV; LE_REFL; + ARITH_RULE `i <= n ==> i <= n + 1`]]);; + +(* ------------------------------------------------------------------------- *) +(* "Isometry" (up to constant bounds) of injective linear map etc. *) +(* ------------------------------------------------------------------------- *) + +let CAUCHY_ISOMETRIC = prove + (`!f s e x. + &0 < e /\ subspace s /\ + linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ + (!n. x(n) IN s) /\ cauchy(f o x) + ==> cauchy x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_ge] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[CAUCHY; dist; o_THM] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN + DISCH_THEN(fun th -> X_GEN_TAC `d:real` THEN DISCH_TAC THEN MP_TAC th) THEN + DISCH_THEN(MP_TAC o SPEC `d * e`) THEN ASM_SIMP_TAC[REAL_LT_MUL] THEN + ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_MUL_SYM; REAL_LET_TRANS; SUBSPACE_SUB; + REAL_LT_LDIV_EQ]);; + +let COMPLETE_ISOMETRIC_IMAGE = prove + (`!f:real^M->real^N s e. + &0 < e /\ subspace s /\ + linear f /\ (!x. x IN s ==> norm(f x) >= e * norm(x)) /\ + complete s + ==> complete(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[complete; EXISTS_IN_IMAGE] THEN + STRIP_TAC THEN X_GEN_TAC `g:num->real^N` THEN + REWRITE_TAC[IN_IMAGE; SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->real^M` MP_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM FUN_EQ_THM] THEN + REWRITE_TAC[GSYM o_DEF] THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:num->real^M`) THEN + ASM_MESON_TAC[CAUCHY_ISOMETRIC; LINEAR_CONTINUOUS_AT; + CONTINUOUS_AT_SEQUENTIALLY]);; + +let INJECTIVE_IMP_ISOMETRIC = prove + (`!f:real^M->real^N s. + closed s /\ subspace s /\ + linear f /\ (!x. x IN s /\ (f x = vec 0) ==> (x = vec 0)) + ==> ?e. &0 < e /\ !x. x IN s ==> norm(f x) >= e * norm(x)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s SUBSET {vec 0 :real^M}` THENL + [EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; real_ge] THEN + ASM_MESON_TAC[SUBSET; IN_SING; NORM_0; LINEAR_0; REAL_LE_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [SUBSET]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_SING] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^M` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`{(f:real^M->real^N) x | x IN s /\ norm(x) = norm(a:real^M)}`; + `vec 0:real^N`] DISTANCE_ATTAINS_INF) THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + SUBST1_TAC(SET_RULE + `{f x | x IN s /\ norm(x) = norm(a:real^M)} = + IMAGE (f:real^M->real^N) (s INTER {x | norm x = norm a})`) THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real^M | norm x = norm(a:real^M)} = frontier(cball(vec 0,norm a))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[FRONTIER_CBALL; NORM_POS_LT; dist; VECTOR_SUB_LZERO; + NORM_NEG; sphere]; + ASM_SIMP_TAC[COMPACT_FRONTIER; COMPACT_CBALL]]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE `{f x | P x} = IMAGE f {x | P x}`] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^M` MP_TAC) THEN + REWRITE_TAC[IN_ELIM_THM; dist; VECTOR_SUB_LZERO; NORM_NEG] THEN + STRIP_TAC THEN REWRITE_TAC[CLOSED_LIMPT; LIMPT_APPROACHABLE] THEN + EXISTS_TAC `norm((f:real^M->real^N) b) / norm(b)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LT_DIV; NORM_POS_LT; NORM_EQ_0]; ALL_TAC] THEN + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:real^M = vec 0` THENL + [FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP LINEAR_0 th]) THEN + REWRITE_TAC[NORM_0; REAL_MUL_RZERO; real_ge; REAL_LE_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(norm(a:real^M) / norm(x)) % x:real^M`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0] THEN ASM_MESON_TAC[subspace]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LINEAR_CMUL th]) THEN + ASM_REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM; real_ge] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ; NORM_POS_LT] THEN + REWRITE_TAC[real_div; REAL_MUL_AC]);; + +let CLOSED_INJECTIVE_IMAGE_SUBSPACE = prove + (`!f s. subspace s /\ + linear f /\ + (!x. x IN s /\ f(x) = vec 0 ==> x = vec 0) /\ + closed s + ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM COMPLETE_EQ_CLOSED] THEN + MATCH_MP_TAC COMPLETE_ISOMETRIC_IMAGE THEN + ASM_REWRITE_TAC[COMPLETE_EQ_CLOSED] THEN + MATCH_MP_TAC INJECTIVE_IMP_ISOMETRIC THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Relating linear images to open/closed/interior/closure. *) +(* ------------------------------------------------------------------------- *) + +let OPEN_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!y. ?x. f x = y) + ==> !s. open s ==> open(IMAGE f s)`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[open_def; FORALL_IN_IMAGE] THEN + FIRST_ASSUM(MP_TAC o GEN `k:num` o SPEC `basis k:real^N`) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num->real^M` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `bounded(IMAGE (b:num->real^M) (1..dimindex(:N)))` MP_TAC THENL + [SIMP_TAC[FINITE_IMP_BOUNDED; FINITE_IMAGE; FINITE_NUMSEG]; ALL_TAC] THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `s:real^M->bool` THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `x:real^M` THEN ASM_CASES_TAC `(x:real^M) IN s` THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / B / &(dimindex(:N))` THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + ABBREV_TAC `u = y - (f:real^M->real^N) x` THEN + EXISTS_TAC `x + vsum(1..dimindex(:N)) (\i. (u:real^N)$i % b i):real^M` THEN + ASM_SIMP_TAC[LINEAR_ADD; LINEAR_VSUM; FINITE_NUMSEG; o_DEF; + LINEAR_CMUL; BASIS_EXPANSION] THEN + CONJ_TAC THENL [EXPAND_TAC "u" THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[NORM_ARITH `dist(x + y,x) = norm y`] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(dist(y,(f:real^M->real^N) x) * &(dimindex(:N))) * B` THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_OF_NUM_LT; DIMINDEX_GE_1; LE_1] THEN + MATCH_MP_TAC VSUM_NORM_TRIANGLE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = b * a * c`] THEN + GEN_REWRITE_TAC(RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[NORM_MUL; dist] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS; NORM_POS_LE] THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]);; + +let OPEN_BIJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> (open(IMAGE f s) <=> open s)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC; ASM_MESON_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE]] THEN + SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; + +add_linear_invariants [OPEN_BIJECTIVE_LINEAR_IMAGE_EQ];; + +let CLOSED_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> !s. closed s ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_LEFT_INVERSE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^N->real^M` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC CLOSED_IN_CLOSED_TRANS THEN + EXISTS_TAC `IMAGE (f:real^M->real^N) (:real^M)` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`g:real^N->real^M`; `IMAGE (f:real^M->real^N) (:real^M)`; + `IMAGE (g:real^N->real^M) (IMAGE (f:real^M->real^N) s)`] + CONTINUOUS_CLOSED_IN_PREIMAGE) THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[GSYM IMAGE_o; IMAGE_I]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM]) THEN + REWRITE_TAC[EXTENSION; o_THM; I_THM] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_INJECTIVE_IMAGE_SUBSPACE THEN + ASM_REWRITE_TAC[IN_UNIV; SUBSPACE_UNIV; CLOSED_UNIV] THEN + X_GEN_TAC `x:real^M` THEN + DISCH_THEN(MP_TAC o AP_TERM `g:real^N->real^M`) THEN + RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM; I_THM; o_THM]) THEN + ASM_MESON_TAC[LINEAR_0]]);; + +let CLOSED_INJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (closed(IMAGE f s) <=> closed s)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC; ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE]] THEN + SUBGOAL_THEN `s = {x | (f:real^M->real^N) x IN IMAGE f s}` + SUBST1_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_AT]);; + +add_linear_invariants [CLOSED_INJECTIVE_LINEAR_IMAGE_EQ];; + +let CLOSURE_LINEAR_IMAGE_SUBSET = prove + (`!f:real^M->real^N s. + linear f ==> IMAGE f (closure s) SUBSET closure(IMAGE f s)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC IMAGE_CLOSURE_SUBSET THEN + ASM_SIMP_TAC[CLOSED_CLOSURE; CLOSURE_SUBSET; LINEAR_CONTINUOUS_ON]);; + +let CLOSURE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN + ASM_MESON_TAC[CLOSED_INJECTIVE_LINEAR_IMAGE; CLOSED_CLOSURE]);; + +add_linear_invariants [CLOSURE_INJECTIVE_LINEAR_IMAGE];; + +let CLOSURE_BOUNDED_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ bounded s + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[CLOSURE_LINEAR_IMAGE_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSURE_SUBSET; IMAGE_SUBSET] THEN + MATCH_MP_TAC COMPACT_IMP_CLOSED THEN + MATCH_MP_TAC COMPACT_LINEAR_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_CLOSURE]);; + +let LINEAR_INTERIOR_IMAGE_SUBSET = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> interior(IMAGE f s) SUBSET IMAGE f (interior s)`, + MESON_TAC[INTERIOR_IMAGE_SUBSET; LINEAR_CONTINUOUS_AT]);; + +let LINEAR_IMAGE_SUBSET_INTERIOR = prove + (`!f:real^M->real^N s. + linear f /\ (!y. ?x. f x = y) + ==> IMAGE f (interior s) SUBSET interior(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_MAXIMAL THEN + ASM_SIMP_TAC[OPEN_SURJECTIVE_LINEAR_IMAGE; OPEN_INTERIOR; + IMAGE_SUBSET; INTERIOR_SUBSET]);; + +let INTERIOR_BIJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> interior(IMAGE f s) = IMAGE f (interior s)`, + REWRITE_TAC[interior] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [INTERIOR_BIJECTIVE_LINEAR_IMAGE];; + +let FRONTIER_BIJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) /\ (!y. ?x. f x = y) + ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, + REWRITE_TAC[frontier] THEN GEOM_TRANSFORM_TAC[]);; + +add_linear_invariants [FRONTIER_BIJECTIVE_LINEAR_IMAGE];; + +(* ------------------------------------------------------------------------- *) +(* Corollaries, reformulations and special cases for M = N. *) +(* ------------------------------------------------------------------------- *) + +let IN_INTERIOR_LINEAR_IMAGE = prove + (`!f:real^M->real^N g s x. + linear f /\ linear g /\ (f o g = I) /\ x IN interior s + ==> (f x) IN interior (IMAGE f s)`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `s:real^M->bool`] + LINEAR_IMAGE_SUBSET_INTERIOR) THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[]);; + +let LINEAR_OPEN_MAPPING = prove + (`!f:real^M->real^N g. + linear f /\ linear g /\ (f o g = I) + ==> !s. open s ==> open(IMAGE f s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC OPEN_SURJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[]);; + +let INTERIOR_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> interior(IMAGE f s) = IMAGE f (interior s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; + +let INTERIOR_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!y. ?x. f x = y) + ==> interior(IMAGE f s) = IMAGE f (interior s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERIOR_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let CLOSURE_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!y. ?x. f x = y) + ==> closure(IMAGE f s) = IMAGE f (closure s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let FRONTIER_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_INJECTIVE_IMP_SURJECTIVE]);; + +let FRONTIER_SURJECTIVE_LINEAR_IMAGE = prove + (`!f:real^N->real^N. + linear f /\ (!y. ?x. f x = y) + ==> frontier(IMAGE f s) = IMAGE f (frontier s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FRONTIER_BIJECTIVE_LINEAR_IMAGE THEN + ASM_MESON_TAC[LINEAR_SURJECTIVE_IMP_INJECTIVE]);; + +let COMPLETE_INJECTIVE_LINEAR_IMAGE = prove + (`!f:real^M->real^N. + linear f /\ (!x y. f x = f y ==> x = y) + ==> !s. complete s ==> complete(IMAGE f s)`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE]);; + +let COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> (complete(IMAGE f s) <=> complete s)`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_INJECTIVE_LINEAR_IMAGE_EQ]);; + +add_linear_invariants [COMPLETE_INJECTIVE_LINEAR_IMAGE_EQ];; + +let LIMPT_INJECTIVE_LINEAR_IMAGE_EQ = prove + (`!f:real^M->real^N s. + linear f /\ (!x y. f x = f y ==> x = y) + ==> ((f x) limit_point_of (IMAGE f s) <=> x limit_point_of s)`, + REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THENL + [MP_TAC(ISPEC `f:real^M->real^N` LINEAR_INJECTIVE_BOUNDED_BELOW_POS); + MP_TAC(ISPEC `f:real^M->real^N` LINEAR_BOUNDED_POS)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `e * B:real`); + FIRST_X_ASSUM(MP_TAC o SPEC `e / B:real`)] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; dist; GSYM LINEAR_SUB] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + REPEAT(MATCH_MP_TAC MONO_AND THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_LT_RDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> b < x ==> a < x`) THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; + +add_linear_invariants [LIMPT_INJECTIVE_LINEAR_IMAGE_EQ];; + +let LIMPT_TRANSLATION_EQ = prove + (`!a s x. (a + x) limit_point_of (IMAGE (\y. a + y) s) <=> x limit_point_of s`, + REWRITE_TAC[limit_point_of] THEN GEOM_TRANSLATE_TAC[]);; + +add_translation_invariants [LIMPT_TRANSLATION_EQ];; + +let OPEN_OPEN_LEFT_PROJECTION = prove + (`!s t:real^(M,N)finite_sum->bool. + open s /\ open t ==> open {x | x IN s /\ ?y. pastecart x y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ ?y. (pastecart x y:real^(M,N)finite_sum) IN t} = + s INTER IMAGE fstcart t` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN + MESON_TAC[FSTCART_PASTECART; PASTECART_FST_SND]; + MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] + OPEN_SURJECTIVE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_FSTCART] THEN MESON_TAC[FSTCART_PASTECART]]);; + +let OPEN_OPEN_RIGHT_PROJECTION = prove + (`!s t:real^(M,N)finite_sum->bool. + open s /\ open t ==> open {y | y IN s /\ ?x. pastecart x y IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{y | y IN s /\ ?x. (pastecart x y:real^(M,N)finite_sum) IN t} = + s INTER IMAGE sndcart t` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER; IN_IMAGE] THEN + MESON_TAC[SNDCART_PASTECART; PASTECART_FST_SND]; + MATCH_MP_TAC OPEN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] + OPEN_SURJECTIVE_LINEAR_IMAGE) THEN + ASM_REWRITE_TAC[LINEAR_SNDCART] THEN MESON_TAC[SNDCART_PASTECART]]);; + +(* ------------------------------------------------------------------------- *) +(* Even more special cases. *) +(* ------------------------------------------------------------------------- *) + +let INTERIOR_NEGATIONS = prove + (`!s. interior(IMAGE (--) s) = IMAGE (--) (interior s)`, + GEN_TAC THEN MATCH_MP_TAC INTERIOR_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let SYMMETRIC_INTERIOR = prove + (`!s:real^N->bool. + (!x. x IN s ==> --x IN s) + ==> !x. x IN interior s ==> (--x) IN interior s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN + REWRITE_TAC[GSYM INTERIOR_NEGATIONS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; + +let CLOSURE_NEGATIONS = prove + (`!s. closure(IMAGE (--) s) = IMAGE (--) (closure s)`, + GEN_TAC THEN MATCH_MP_TAC CLOSURE_INJECTIVE_LINEAR_IMAGE THEN + REWRITE_TAC[linear] THEN REPEAT CONJ_TAC THEN VECTOR_ARITH_TAC);; + +let SYMMETRIC_CLOSURE = prove + (`!s:real^N->bool. + (!x. x IN s ==> --x IN s) + ==> !x. x IN closure s ==> (--x) IN closure s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP(ISPEC `(--):real^N->real^N` FUN_IN_IMAGE)) THEN + REWRITE_TAC[GSYM CLOSURE_NEGATIONS] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[VECTOR_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Some properties of a canonical subspace. *) +(* ------------------------------------------------------------------------- *) + +let SUBSPACE_SUBSTANDARD = prove + (`!d. subspace + {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, + GEN_TAC THEN ASM_CASES_TAC `d <= dimindex(:N)` THENL + [MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN + SIMP_TAC[subspace; IN_ELIM_THM; REAL_MUL_RZERO; REAL_ADD_LID; + VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VEC_COMPONENT]; + ASM_SIMP_TAC[ARITH_RULE `~(d:num <= e) ==> (d < i /\ i <= e <=> F)`] THEN + REWRITE_TAC[SET_RULE `{x | T} = UNIV`; SUBSPACE_UNIV]]);; + +let CLOSED_SUBSTANDARD = prove + (`!d. closed + {x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0}`, + GEN_TAC THEN + SUBGOAL_THEN + `{x:real^N | !i. d < i /\ i <= dimindex(:N) ==> x$i = &0} = + INTERS {{x | basis i dot x = &0} | d < i /\ i <= dimindex(:N)}` + SUBST1_TAC THENL + [ALL_TAC; + SIMP_TAC[CLOSED_INTERS; CLOSED_HYPERPLANE; IN_ELIM_THM; + LEFT_IMP_EXISTS_THM]] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; IN_ELIM_THM] THEN + MP_TAC(ARITH_RULE `!i. d < i ==> 1 <= i`) THEN + SIMP_TAC[DOT_BASIS] THEN MESON_TAC[]);; + +let DIM_SUBSTANDARD = prove + (`!d. d <= dimindex(:N) + ==> (dim {x:real^N | !i. d < i /\ i <= dimindex(:N) + ==> x$i = &0} = + d)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIM_UNIQUE THEN + EXISTS_TAC `IMAGE (basis:num->real^N) (1..d)` THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + MESON_TAC[BASIS_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`; NOT_LT]; + ALL_TAC; + MATCH_MP_TAC INDEPENDENT_MONO THEN + EXISTS_TAC `{basis i :real^N | 1 <= i /\ i <= dimindex(:N)}` THEN + REWRITE_TAC[INDEPENDENT_STDBASIS]THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + ASM_MESON_TAC[LE_TRANS]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN + REWRITE_TAC[IN_NUMSEG] THEN ASM_MESON_TAC[LE_TRANS; BASIS_INJ]] THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `0 < i <=> 1 <= i`; SPAN_STDBASIS] THEN + SUBGOAL_THEN `IMAGE basis (1 .. 0) :real^N->bool = {}` SUBST1_TAC THENL + [REWRITE_TAC[IMAGE_EQ_EMPTY; NUMSEG_EMPTY; ARITH]; ALL_TAC] THEN + DISCH_TAC THEN REWRITE_TAC[SPAN_EMPTY; SUBSET; IN_ELIM_THM; IN_SING] THEN + SIMP_TAC[CART_EQ; VEC_COMPONENT]; + ALL_TAC] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_SIMP_TAC[ARITH_RULE `SUC d <= n ==> d <= n`] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_TAC THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x - (x$(SUC d)) % basis(SUC d) :real^N`) THEN + ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP(ARITH_RULE `d < i ==> 1 <= i`)) THEN + ASM_SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[BASIS_COMPONENT] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_SUB_REFL] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO] THEN + ASM_MESON_TAC[ARITH_RULE `d < i /\ ~(i = SUC d) ==> SUC d < i`]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBST1_TAC(VECTOR_ARITH + `x = (x - (x$(SUC d)) % basis(SUC d)) + + x$(SUC d) % basis(SUC d) :real^N`) THEN + MATCH_MP_TAC SPAN_ADD THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_MONO; SUBSET_IMAGE; SUBSET; SUBSET_NUMSEG; LE_REFL; LE]; + MATCH_MP_TAC SPAN_MUL THEN MATCH_MP_TAC SPAN_SUPERSET THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN + MESON_TAC[LE_REFL; ARITH_RULE `1 <= SUC d`]]);; + +(* ------------------------------------------------------------------------- *) +(* Hence closure and completeness of all subspaces. *) +(* ------------------------------------------------------------------------- *) + +let CLOSED_SUBSPACE = prove + (`!s:real^N->bool. subspace s ==> closed s`, + REPEAT STRIP_TAC THEN ABBREV_TAC `d = dim(s:real^N->bool)` THEN + MP_TAC(MATCH_MP DIM_SUBSTANDARD + (ISPEC `s:real^N->bool` DIM_SUBSET_UNIV)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`{x:real^N | !i. d < i /\ i <= dimindex(:N) + ==> x$i = &0}`; + `s:real^N->bool`] SUBSPACE_ISOMORPHISM) THEN + ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD] THEN + DISCH_THEN(X_CHOOSE_THEN `f:real^N->real^N` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(ISPEC `f:real^N->real^N` CLOSED_INJECTIVE_IMAGE_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_SUBSTANDARD; CLOSED_SUBSTANDARD] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LINEAR_0]] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[VEC_COMPONENT; ARITH_RULE `d < i ==> 1 <= i`]);; + +let COMPLETE_SUBSPACE = prove + (`!s:real^N->bool. subspace s ==> complete s`, + REWRITE_TAC[COMPLETE_EQ_CLOSED; CLOSED_SUBSPACE]);; + +let CLOSED_SPAN = prove + (`!s. closed(span s)`, + SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]);; + +let DIM_CLOSURE = prove + (`!s:real^N->bool. dim(closure s) = dim s`, + GEN_TAC THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM DIM_SPAN]; ALL_TAC] THEN + MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[CLOSURE_SUBSET] THEN + MATCH_MP_TAC CLOSURE_MINIMAL THEN + SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN; SPAN_INC]);; + +let CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE = prove + (`!f:real^M->real^N s. + closed s /\ f continuous_on s /\ + (!e. bounded {x | x IN s /\ norm(f x) <= e}) + ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CLOSED_INTERS_COMPACT] THEN + REWRITE_TAC[SET_RULE + `cball(vec 0,e) INTER IMAGE (f:real^M->real^N) s = + IMAGE f (s INTER {x | x IN s /\ f x IN cball(vec 0,e)})`] THEN + X_GEN_TAC `e:real` THEN MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `s:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC CLOSED_INTER_COMPACT THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[IN_CBALL_0]; + ASM_SIMP_TAC[CONTINUOUS_CLOSED_PREIMAGE; CLOSED_CBALL]]]);; + +let CLOSED_INJECTIVE_IMAGE_SUBSET_SUBSPACE = prove + (`!f:real^M->real^N s t. + closed s /\ s SUBSET t /\ subspace t /\ + linear f /\ + (!x. x IN t /\ f(x) = vec 0 ==> x = vec 0) + ==> closed(IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_BOUNDEDPREIM_CONTINUOUS_IMAGE THEN + ASM_SIMP_TAC[LINEAR_CONTINUOUS_ON] THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `t:real^M->bool`] + INJECTIVE_IMP_ISOMETRIC) THEN + ASM_SIMP_TAC[CLOSED_SUBSPACE; real_ge] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `e:real` THEN MATCH_MP_TAC BOUNDED_SUBSET THEN + EXISTS_TAC `cball(vec 0:real^M,e / B)` THEN + REWRITE_TAC[BOUNDED_CBALL] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0; REAL_LE_RDIV_EQ] THEN + ASM_MESON_TAC[SUBSET; REAL_LE_TRANS]);; + +let BASIS_COORDINATES_LIPSCHITZ = prove + (`!b:real^N->bool. + independent b + ==> ?B. &0 < B /\ + !c v. v IN b + ==> abs(c v) <= B * norm(vsum b (\v. c(v) % v))`, + X_GEN_TAC `k:real^N->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP INDEPENDENT_BOUND) THEN + FIRST_ASSUM(X_CHOOSE_THEN `b:num->real^N` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ABBREV_TAC `n = CARD(k:real^N->bool)` THEN + MP_TAC(ISPECL + [`(\x. vsum(1..n) (\i. x$i % b i)):real^N->real^N`; + `span(IMAGE basis (1..n)):real^N->bool`] + INJECTIVE_IMP_ISOMETRIC) THEN + REWRITE_TAC[SUBSPACE_SPAN] THEN ANTS_TAC THENL + [CONJ_TAC THENL [SIMP_TAC[CLOSED_SUBSPACE; SUBSPACE_SPAN]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_COMPOSE_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LINEAR_VMUL_COMPONENT THEN + SIMP_TAC[LINEAR_ID] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_SPAN_IMAGE_BASIS]) THEN + REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:real^N->num`) THEN + SUBGOAL_THEN + `vsum(1..n) (\i. (x:real^N)$i % b i:real^N) = vsum k (\v. x$(c v) % v)` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_EQ_GENERAL_INVERSES THEN + MAP_EVERY EXISTS_TAC [`b:num->real^N`; `c:real^N->num`] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INDEPENDENT_EXPLICIT]) THEN + DISCH_THEN(MP_TAC o SPEC `\v:real^N. (x:real^N)$(c v)` o CONJUNCT2) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[CART_EQ; FORALL_IN_IMAGE; VEC_COMPONENT] THEN + ASM_MESON_TAC[IN_NUMSEG]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(B:real)` THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; IN_NUMSEG] THEN + MAP_EVERY X_GEN_TAC [`c:real^N->real`; `j:num`] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv B * x = x / B`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_IMAGE o rand o rand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`) THEN + SIMP_TAC[IN_SPAN_IMAGE_BASIS; LAMBDA_BETA] THEN + ANTS_TAC THENL [MESON_TAC[IN_NUMSEG]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x = v /\ u <= y ==> x >= y ==> u <= v`) THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + SUBGOAL_THEN `!i. i <= n ==> i <= dimindex(:N)` MP_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN DISCH_THEN(K ALL_TAC)] THEN + REWRITE_TAC[o_THM]; + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ] THEN + MP_TAC(ISPECL + [`(lambda i. if 1 <= i /\ i <= n then c(b i:real^N) else &0):real^N`; + `j:num`] COMPONENT_LE_NORM) THEN + SUBGOAL_THEN `1 <= j /\ j <= dimindex(:N)` MP_TAC THENL + [ASM_ARITH_TAC; SIMP_TAC[LAMBDA_BETA] THEN ASM_REWRITE_TAC[]]]);; + +let BASIS_COORDINATES_CONTINUOUS = prove + (`!b:real^N->bool e. + independent b /\ &0 < e + ==> ?d. &0 < d /\ + !c. norm(vsum b (\v. c(v) % v)) < d + ==> !v. v IN b ==> abs(c v) < e`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP BASIS_COORDINATES_LIPSCHITZ) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e / B:real` THEN ASM_SIMP_TAC[REAL_LT_DIV] THEN + X_GEN_TAC `c:real^N->real` THEN DISCH_TAC THEN + X_GEN_TAC `v:real^N` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `B * norm(vsum b (\v:real^N. c v % v))` THEN + ASM_SIMP_TAC[] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* Affine transformations of intervals. *) +(* ------------------------------------------------------------------------- *) + +let AFFINITY_INVERSES = prove + (`!m c. ~(m = &0) + ==> (\x. m % x + c) o (\x. inv(m) % x + (--(inv(m) % c))) = I /\ + (\x. inv(m) % x + (--(inv(m) % c))) o (\x. m % x + c) = I`, + REWRITE_TAC[FUN_EQ_THM; o_THM; I_THM] THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_RNEG] THEN + SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RINV] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC);; + +let REAL_AFFINITY_LE = prove + (`!m c x y. &0 < m ==> (m * x + c <= y <=> x <= inv(m) * y + --(c / m))`, + REWRITE_TAC[REAL_ARITH `m * x + c <= y <=> x * m <= y - c`] THEN + SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN REAL_ARITH_TAC);; + +let REAL_LE_AFFINITY = prove + (`!m c x y. &0 < m ==> (y <= m * x + c <=> inv(m) * y + --(c / m) <= x)`, + REWRITE_TAC[REAL_ARITH `y <= m * x + c <=> y - c <= x * m`] THEN + SIMP_TAC[GSYM REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC);; + +let REAL_AFFINITY_LT = prove + (`!m c x y. &0 < m ==> (m * x + c < y <=> x < inv(m) * y + --(c / m))`, + SIMP_TAC[REAL_LE_AFFINITY; GSYM REAL_NOT_LE]);; + +let REAL_LT_AFFINITY = prove + (`!m c x y. &0 < m ==> (y < m * x + c <=> inv(m) * y + --(c / m) < x)`, + SIMP_TAC[REAL_AFFINITY_LE; GSYM REAL_NOT_LE]);; + +let REAL_AFFINITY_EQ = prove + (`!m c x y. ~(m = &0) ==> (m * x + c = y <=> x = inv(m) * y + --(c / m))`, + CONV_TAC REAL_FIELD);; + +let REAL_EQ_AFFINITY = prove + (`!m c x y. ~(m = &0) ==> (y = m * x + c <=> inv(m) * y + --(c / m) = x)`, + CONV_TAC REAL_FIELD);; + +let VECTOR_AFFINITY_EQ = prove + (`!m c x y. ~(m = &0) + ==> (m % x + c = y <=> x = inv(m) % y + --(inv(m) % c))`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + real_div; VECTOR_NEG_COMPONENT; REAL_AFFINITY_EQ] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let VECTOR_EQ_AFFINITY = prove + (`!m c x y. ~(m = &0) + ==> (y = m % x + c <=> inv(m) % y + --(inv(m) % c) = x)`, + SIMP_TAC[CART_EQ; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + real_div; VECTOR_NEG_COMPONENT; REAL_EQ_AFFINITY] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +let IMAGE_AFFINITY_INTERVAL = prove + (`!a b:real^N m c. + IMAGE (\x. m % x + c) (interval[a,b]) = + if interval[a,b] = {} then {} + else if &0 <= m then interval[m % a + c,m % b + c] + else interval[m % b + c,m % a + c]`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN + ASM_CASES_TAC `m = &0` THEN ASM_REWRITE_TAC[REAL_LE_LT] THENL + [ASM_REWRITE_TAC[VECTOR_MUL_LZERO; VECTOR_ADD_LID; COND_ID] THEN + REWRITE_TAC[INTERVAL_SING] THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ &0 < --x`)) THEN + ASM_SIMP_TAC[EXTENSION; IN_IMAGE; REAL_ARITH `&0 < --x ==> ~(&0 < x)`] THENL + [ALL_TAC; + ONCE_REWRITE_TAC[VECTOR_ARITH `x = m % y + c <=> c = (--m) % y + x`]] THEN + ASM_SIMP_TAC[VECTOR_EQ_AFFINITY; REAL_LT_IMP_NZ; UNWIND_THM1] THEN + SIMP_TAC[IN_INTERVAL; VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_NEG_COMPONENT] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM REAL_LT_INV_EQ]) THEN + SIMP_TAC[REAL_AFFINITY_LE; REAL_LE_AFFINITY; real_div] THEN + DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[REAL_INV_INV] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_NEGNEG] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> (inv m * x) * m = x`] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existence of eigenvectors. The proof is only in this file because it uses *) +(* a few simple results about continuous functions (at least *) +(* CONTINUOUS_ON_LIFT_DOT2, CONTINUOUS_ATTAINS_SUP and CLOSED_SUBSPACE). *) +(* ------------------------------------------------------------------------- *) + +let SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE = prove + (`!f:real^N->real^N s. + linear f /\ adjoint f = f /\ + subspace s /\ ~(s = {vec 0}) /\ (!x. x IN s ==> f x IN s) + ==> ?v c. v IN s /\ norm(v) = &1 /\ f(v) = c % v`, + let lemma = prove + (`!a b. (!x. a * x <= b * x pow 2) ==> &0 <= b ==> a = &0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(fun t -> MP_TAC(SPEC `&1` t) THEN + MP_TAC(SPEC `-- &1` t)) THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a / &2 / b`) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < b ==> (b * (a / b) pow 2) = a pow 2 / b`] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN SIMP_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN + REWRITE_TAC[REAL_LT_SQUARE; REAL_ARITH + `(a * a) / &2 <= (a / &2) pow 2 <=> ~(&0 < a * a)`]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^N. (f x) dot x`; + `s INTER sphere(vec 0:real^N,&1)`] + CONTINUOUS_ATTAINS_SUP) THEN + REWRITE_TAC[EXISTS_IN_GSPEC; FORALL_IN_GSPEC; o_DEF] THEN ANTS_TAC THENL + [ASM_SIMP_TAC[CONTINUOUS_ON_LIFT_DOT2; LINEAR_CONTINUOUS_ON; + CONTINUOUS_ON_ID] THEN + ASM_SIMP_TAC[COMPACT_SPHERE; CLOSED_INTER_COMPACT; CLOSED_SUBSPACE] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `~(s = {a}) ==> a IN s ==> ?b. ~(b = a) /\ b IN s`)) THEN + ASM_SIMP_TAC[SUBSPACE_0; IN_SPHERE_0; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(norm x) % x:real^N` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; VECTOR_SUB_RZERO; NORM_MUL] THEN + ASM_SIMP_TAC[SUBSPACE_MUL; REAL_ABS_INV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; NORM_EQ_0]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `v:real^N` THEN + REWRITE_TAC[IN_INTER; IN_SPHERE_0] THEN STRIP_TAC THEN + ABBREV_TAC `c = (f:real^N->real^N) v dot v` THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[]] THEN + ABBREV_TAC `p = \x y:real^N. c * (x dot y) - (f x) dot y` THEN + SUBGOAL_THEN `!x:real^N. x IN s ==> &0 <= p x x` (LABEL_TAC "POSDEF") THENL + [X_GEN_TAC `x:real^N` THEN EXPAND_TAC "p" THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `x:real^N = vec 0` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[DOT_RZERO; REAL_MUL_RZERO; REAL_SUB_LE; REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(norm x) % x:real^N`) THEN + ASM_SIMP_TAC[SUBSPACE_MUL] THEN + ASM_SIMP_TAC[LINEAR_CMUL; NORM_MUL; REAL_ABS_INV; DOT_RMUL] THEN + ASM_SIMP_TAC[REAL_ABS_NORM; REAL_MUL_LINV; NORM_EQ_0; DOT_LMUL] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; DOT_POS_LT] THEN + REWRITE_TAC[GSYM NORM_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!y:real^N. y IN s ==> !a. p v y * a <= p y y * a pow 2` + MP_TAC THENL + [REPEAT STRIP_TAC THEN + REMOVE_THEN "POSDEF" (MP_TAC o SPEC `v - (&2 * a) % y:real^N`) THEN + EXPAND_TAC "p" THEN ASM_SIMP_TAC[SUBSPACE_SUB; SUBSPACE_MUL] THEN + ASM_SIMP_TAC[LINEAR_SUB; LINEAR_CMUL] THEN + REWRITE_TAC[DOT_LSUB; DOT_LMUL] THEN + REWRITE_TAC[DOT_RSUB; DOT_RMUL] THEN + SUBGOAL_THEN `f y dot (v:real^N) = f v dot y` SUBST1_TAC THENL + [ASM_MESON_TAC[ADJOINT_CLAUSES; DOT_SYM]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM NORM_POW_2] THEN REWRITE_TAC[NORM_POW_2] THEN + MATCH_MP_TAC(REAL_ARITH + `&4 * (z - y) = x ==> &0 <= x ==> y <= z`) THEN + REWRITE_TAC[DOT_SYM] THEN CONV_TAC REAL_RING; + DISCH_THEN(MP_TAC o GEN `y:real^N` o DISCH `(y:real^N) IN s` o + MATCH_MP lemma o C MP (ASSUME `(y:real^N) IN s`) o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[] THEN EXPAND_TAC "p" THEN + REWRITE_TAC[GSYM DOT_LMUL; GSYM DOT_LSUB] THEN + DISCH_THEN(MP_TAC o SPEC `c % v - f v:real^N`) THEN + ASM_SIMP_TAC[SUBSPACE_MUL; SUBSPACE_SUB; DOT_EQ_0; VECTOR_SUB_EQ]]);; + +let SELF_ADJOINT_HAS_EIGENVECTOR = prove + (`!f:real^N->real^N. + linear f /\ adjoint f = f ==> ?v c. norm(v) = &1 /\ f(v) = c % v`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] + SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC(SET_RULE `!a. ~(a IN s) ==> ~(UNIV = s)`) THEN + EXISTS_TAC `vec 1:real^N` THEN + REWRITE_TAC[IN_SING; VEC_EQ; ARITH_EQ]);; + +let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE = prove + (`!f:real^N->real^N s. + linear f /\ adjoint f = f /\ + subspace s /\ (!x. x IN s ==> f x IN s) + ==> ?b. b SUBSET s /\ + pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ + independent b /\ + span b = s /\ + b HAS_SIZE dim s`, + let lemma = prove + (`!f:real^N->real^N s. + linear f /\ adjoint f = f /\ subspace s /\ (!x. x IN s ==> f x IN s) + ==> ?b. b SUBSET s /\ b HAS_SIZE dim s /\ + pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REWRITE_TAC[IMP_IMP] THEN + GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + WF_INDUCT_TAC `dim(s:real^N->bool)` THEN STRIP_TAC THEN + ASM_CASES_TAC `dim(s:real^N->bool) = 0` THENL + [EXISTS_TAC `{}:real^N->bool` THEN + ASM_SIMP_TAC[HAS_SIZE_CLAUSES; NOT_IN_EMPTY; + PAIRWISE_EMPTY; EMPTY_SUBSET]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [DIM_EQ_0]) THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP (SET_RULE + `~(s SUBSET {a}) ==> ~(s = {a})`)) THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] + SELF_ADJOINT_HAS_EIGENVECTOR_IN_SUBSPACE) THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N` MP_TAC) THEN + ASM_CASES_TAC `v:real^N = vec 0` THEN ASM_REWRITE_TAC[NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:real^N | y IN s /\ orthogonal v y}`) THEN + REWRITE_TAC[SUBSPACE_ORTHOGONAL_TO_VECTOR; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`span {v:real^N}`; `s:real^N->bool`] + DIM_SUBSPACE_ORTHOGONAL_TO_VECTORS) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ORTHOGONAL_SYM] ORTHOGONAL_TO_SPAN_EQ] THEN + ASM_REWRITE_TAC[SUBSPACE_SPAN; IN_SING; FORALL_UNWIND_THM2] THEN + ANTS_TAC THENL + [MATCH_MP_TAC SPAN_SUBSET_SUBSPACE THEN ASM SET_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + ASM_REWRITE_TAC[DIM_SPAN; DIM_SING; ARITH_RULE `n < n + 1`] THEN + ANTS_TAC THENL + [REWRITE_TAC[SET_RULE `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + ASM_SIMP_TAC[SUBSPACE_INTER; SUBSPACE_ORTHOGONAL_TO_VECTOR] THEN + REWRITE_TAC[orthogonal] THEN X_GEN_TAC `x:real^N` THEN STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(f:real^N->real^N) v dot x` THEN CONJ_TAC THENL + [ASM_MESON_TAC[ADJOINT_CLAUSES]; + ASM_MESON_TAC[DOT_LMUL; REAL_MUL_RZERO]]; + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(v:real^N) INSERT b` THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[PAIRWISE_INSERT] THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE; SUBSET; IN_ELIM_THM]) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE; FINITE_INSERT; CARD_CLAUSES] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ADD1] THEN + ASM_MESON_TAC[ORTHOGONAL_REFL]; + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN + ASM_MESON_TAC[ORTHOGONAL_SYM]]]) in + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `s:real^N->bool`] lemma) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `b:real^N->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PAIRWISE_ORTHOGONAL_INDEPENDENT THEN + ASM_MESON_TAC[NORM_ARITH `~(norm(vec 0:real^N) = &1)`]; + DISCH_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [ASM_MESON_TAC[SPAN_SUBSET_SUBSPACE]; + MATCH_MP_TAC CARD_GE_DIM_INDEPENDENT THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_REWRITE_TAC[LE_REFL]]]);; + +let SELF_ADJOINT_HAS_EIGENVECTOR_BASIS = prove + (`!f:real^N->real^N. + linear f /\ adjoint f = f + ==> ?b. pairwise orthogonal b /\ + (!x. x IN b ==> norm x = &1 /\ ?c. f(x) = c % x) /\ + independent b /\ + span b = (:real^N) /\ + b HAS_SIZE (dimindex(:N))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->real^N`; `(:real^N)`] + SELF_ADJOINT_HAS_EIGENVECTOR_BASIS_OF_SUBSPACE) THEN + ASM_REWRITE_TAC[SUBSPACE_UNIV; IN_UNIV; DIM_UNIV; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonalization of symmetric matrix. *) +(* ------------------------------------------------------------------------- *) + +let SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT = prove + (`!A:real^N^N. + transp A = A + ==> ?P d. orthogonal_matrix P /\ + transp P ** A ** P = (lambda i j. if i = j then d i else &0)`, + let lemma1 = prove + (`!A:real^N^N P:real^N^N d. + A ** P = P ** (lambda i j. if i = j then d i else &0) <=> + !i. 1 <= i /\ i <= dimindex(:N) + ==> A ** column i P = d i % column i P`, + SIMP_TAC[CART_EQ; matrix_mul; matrix_vector_mul; LAMBDA_BETA; + column; VECTOR_MUL_COMPONENT] THEN + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[COND_RAND] THEN + SIMP_TAC[REAL_MUL_RZERO; SUM_DELTA; IN_NUMSEG] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[] THEN + REWRITE_TAC[REAL_MUL_SYM]) in + let lemma2 = prove + (`!A:real^N^N P:real^N^N d. + orthogonal_matrix P /\ + transp P ** A ** P = (lambda i j. if i = j then d i else &0) <=> + orthogonal_matrix P /\ + !i. 1 <= i /\ i <= dimindex(:N) + ==> A ** column i P = d i % column i P`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM lemma1; orthogonal_matrix] THEN + ABBREV_TAC `D:real^N^N = lambda i j. if i = j then d i else &0` THEN + MESON_TAC[MATRIX_MUL_ASSOC; MATRIX_MUL_LID]) in + REPEAT STRIP_TAC THEN + REWRITE_TAC[lemma2] THEN REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[GSYM SKOLEM_THM] THEN + MP_TAC(ISPEC `\x:real^N. (A:real^N^N) ** x` + SELF_ADJOINT_HAS_EIGENVECTOR_BASIS) THEN + ASM_SIMP_TAC[MATRIX_SELF_ADJOINT; MATRIX_VECTOR_MUL_LINEAR; + MATRIX_OF_MATRIX_VECTOR_MUL] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real^N->bool` MP_TAC) THEN + REWRITE_TAC[CONJ_ASSOC] THEN ONCE_REWRITE_TAC[IMP_CONJ_ALT] THEN + REWRITE_TAC[HAS_SIZE] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_INDEX_NUMSEG]) THEN + ASM_REWRITE_TAC[IN_NUMSEG; TAUT + `p /\ q /\ x = y ==> a = b <=> p /\ q /\ ~(a = b) ==> ~(x = y)`] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->real^N` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[PAIRWISE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[pairwise; IN_NUMSEG] THEN STRIP_TAC THEN + EXISTS_TAC `transp(lambda i. f i):real^N^N` THEN + SIMP_TAC[COLUMN_TRANSP; ORTHOGONAL_MATRIX_TRANSP] THEN + SIMP_TAC[ORTHOGONAL_MATRIX_ORTHONORMAL_ROWS_INDEXED; row] THEN + SIMP_TAC[LAMBDA_ETA; LAMBDA_BETA; pairwise; IN_NUMSEG] THEN + ASM_MESON_TAC[]);; + +let SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE = prove + (`!A:real^N^N. + transp A = A + ==> ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, + GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SYMMETRIC_MATRIX_DIAGONALIZABLE_EXPLICIT) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[diagonal_matrix; LAMBDA_BETA]);; + +let SYMMETRIC_MATRIX_EQ_DIAGONALIZABLE = prove + (`!A:real^N^N. + transp A = A <=> + ?P. orthogonal_matrix P /\ diagonal_matrix(transp P ** A ** P)`, + GEN_TAC THEN EQ_TAC THEN + REWRITE_TAC[SYMMETRIC_MATRIX_IMP_DIAGONALIZABLE] THEN + REWRITE_TAC[orthogonal_matrix] THEN + DISCH_THEN(X_CHOOSE_THEN `P:real^N^N` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `D:real^N^N = transp P ** (A:real^N^N) ** P` THEN + SUBGOAL_THEN `A:real^N^N = P ** (D:real^N^N) ** transp P` SUBST1_TAC THENL + [EXPAND_TAC "D" THEN REWRITE_TAC[MATRIX_MUL_ASSOC] THEN + ASM_REWRITE_TAC[MATRIX_MUL_LID] THEN + ASM_REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_RID]; + REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; MATRIX_MUL_ASSOC] THEN + ASM_MESON_TAC[TRANSP_DIAGONAL_MATRIX]]);; + +(* ------------------------------------------------------------------------- *) +(* Some matrix identities are easier to deduce for invertible matrices. We *) +(* can then extend by continuity, which is why this material needs to be *) +(* here after basic topological notions have been defined. *) +(* ------------------------------------------------------------------------- *) + +let CONTINUOUS_LIFT_DET = prove + (`!(A:A->real^N^N) net. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (\x. lift(A x$i$j)) continuous net) + ==> (\x. lift(det(A x))) continuous net`, + REPEAT STRIP_TAC THEN REWRITE_TAC[det] THEN + SIMP_TAC[LIFT_SUM; FINITE_PERMUTATIONS; FINITE_NUMSEG; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_VSUM THEN + SIMP_TAC[FINITE_PERMUTATIONS; FINITE_NUMSEG; LIFT_CMUL; IN_ELIM_THM] THEN + X_GEN_TAC `p:num->num` THEN DISCH_TAC THEN + MATCH_MP_TAC CONTINUOUS_CMUL THEN + MATCH_MP_TAC CONTINUOUS_LIFT_PRODUCT THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG]);; + +let CONTINUOUS_ON_LIFT_DET = prove + (`!A:real^M->real^N^N s. + (!i j. 1 <= i /\ i <= dimindex(:N) /\ + 1 <= j /\ j <= dimindex(:N) + ==> (\x. lift(A x$i$j)) continuous_on s) + ==> (\x. lift(det(A x))) continuous_on s`, + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; CONTINUOUS_LIFT_DET]);; + +let NEARBY_INVERTIBLE_MATRIX = prove + (`!A:real^N^N. + ?e. &0 < e /\ !x. ~(x = &0) /\ abs x < e ==> invertible(A + x %% mat 1)`, + GEN_TAC THEN MP_TAC(ISPEC `A:real^N^N` CHARACTERISTIC_POLYNOMIAL) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`dimindex(:N)`; `a:num->real`] REAL_POLYFUN_FINITE_ROOTS) THEN + MATCH_MP_TAC(TAUT `q /\ (p ==> r) ==> (p <=> q) ==> r`) THEN CONJ_TAC THENL + [EXISTS_TAC `dimindex(:N)` THEN ASM_REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o ISPEC `lift` o MATCH_MP FINITE_IMAGE) THEN + DISCH_THEN(MP_TAC o MATCH_MP LIMIT_POINT_FINITE) THEN + DISCH_THEN(MP_TAC o SPEC `lift(&0)`) THEN + REWRITE_TAC[LIMPT_APPROACHABLE; EXISTS_IN_IMAGE; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[DIST_LIFT; LIFT_EQ; REAL_SUB_RZERO; NOT_FORALL_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(fun th -> X_GEN_TAC `x:real` THEN STRIP_TAC THEN + MP_TAC(SPEC `--x:real` th)) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `--x:real`) THEN + ASM_REWRITE_TAC[REAL_NEG_EQ_0; REAL_ABS_NEG] THEN + ONCE_REWRITE_TAC[GSYM INVERTIBLE_NEG] THEN + REWRITE_TAC[INVERTIBLE_DET_NZ; CONTRAPOS_THM] THEN + REWRITE_TAC[MATRIX_SUB; MATRIX_NEG_MINUS1] THEN + ONCE_REWRITE_TAC[REAL_ARITH `--x = -- &1 * x`] THEN + REWRITE_TAC[GSYM MATRIX_CMUL_ADD_LDISTRIB; GSYM MATRIX_CMUL_ASSOC] THEN + REWRITE_TAC[MATRIX_CMUL_LID; MATRIX_ADD_SYM]);; + +let MATRIX_WLOG_INVERTIBLE = prove + (`!P. (!A:real^N^N. invertible A ==> P A) /\ + (!A:real^N^N. ?d. &0 < d /\ + closed {x | x IN cball(vec 0,d) /\ + P(A + drop x %% mat 1)}) + ==> !A:real^N^N. P A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^1` o + GEN_REWRITE_RULE I [CLOSED_LIMPT]) THEN + ASM_SIMP_TAC[IN_ELIM_THM; DROP_VEC; MATRIX_CMUL_LZERO; MATRIX_ADD_RID] THEN + ANTS_TAC THENL [ALL_TAC; CONV_TAC TAUT] THEN + MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIMPT_APPROACHABLE] THEN X_GEN_TAC `k:real` THEN + DISCH_TAC THEN REWRITE_TAC[EXISTS_LIFT; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM LIFT_NUM; IN_CBALL_0; NORM_LIFT; DIST_LIFT] THEN + REWRITE_TAC[REAL_SUB_RZERO; LIFT_EQ; LIFT_DROP] THEN + EXISTS_TAC `min d ((min e k) / &2)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; FIRST_X_ASSUM MATCH_MP_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; + +let SYLVESTER_DETERMINANT_IDENTITY = prove + (`!A:real^N^M B:real^M^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, + let lemma1 = prove + (`!A:real^N^N B:real^N^N. det(mat 1 + A ** B) = det(mat 1 + B ** A)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `det((mat 1 + A ** B) ** A:real^N^N) = + det(A ** (mat 1 + B ** A))` + MP_TAC THENL + [REWRITE_TAC[MATRIX_ADD_RDISTRIB; MATRIX_ADD_LDISTRIB] THEN + REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID; MATRIX_MUL_ASSOC]; + REWRITE_TAC[DET_MUL] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INVERTIBLE_DET_NZ]) THEN + CONV_TAC REAL_RING]; + X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN + ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; CONTINUOUS_CONST] THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN + DISCH_TAC THENL [ONCE_REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_CMUL THEN + REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_MUL_SYM] LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_CMUL THEN + REWRITE_TAC[LIFT_DROP; CONTINUOUS_AT_ID]]) in + let lemma2 = prove + (`!A:real^N^M B:real^M^N. + dimindex(:M) <= dimindex(:N) + ==> det(mat 1 + A ** B) = det(mat 1 + B ** A)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ABBREV_TAC + [`A':real^N^N = + lambda i j. if i <= dimindex(:M) then (A:real^N^M)$i$j + else &0`; + `B':real^N^N = + lambda i j. if j <= dimindex(:M) then (B:real^M^N)$i$j + else &0`] THEN + MP_TAC(ISPECL [`A':real^N^N`; `B':real^N^N`] lemma1) THEN + SUBGOAL_THEN + `(B':real^N^N) ** (A':real^N^N) = (B:real^M^N) ** (A:real^N^M)` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; matrix_mul] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_SIMP_TAC[IN_NUMSEG; REAL_MUL_LZERO; FINITE_NUMSEG; SUBSET_NUMSEG; + LE_REFL; TAUT `(p /\ q) /\ ~(p /\ r) <=> p /\ q /\ ~r`]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[det] THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum {p | p permutes 1..dimindex(:N) /\ !i. dimindex(:M) < i ==> p i = i} + (\p. sign p * product (1..dimindex(:N)) + (\i. (mat 1 + (A':real^N^N) ** (B':real^N^N))$i$p i))` THEN + CONJ_TAC THENL + [ALL_TAC; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + CONJ_TAC THENL [SET_TAC[]; SIMP_TAC[IN_ELIM_THM; IMP_CONJ]] THEN + X_GEN_TAC `p:num->num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE; PRODUCT_EQ_0_NUMSEG] THEN DISJ2_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_FORALL_THM]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `k:num` o CONJUNCT1 o + GEN_REWRITE_RULE I [permutes]) THEN + ASM_REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PERMUTES_IMAGE) THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT; REAL_ADD_LID] THEN + ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN + ASM_SIMP_TAC[LAMBDA_BETA; GSYM NOT_LT]] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_GENERAL THEN + EXISTS_TAC `\f:num->num. f` THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THEN X_GEN_TAC `p:num->num` THEN STRIP_TAC THENL + [REWRITE_TAC[MESON[] `(?!x. P x /\ x = y) <=> P y`] THEN CONJ_TAC THENL + [MATCH_MP_TAC PERMUTES_SUBSET THEN + EXISTS_TAC `1..dimindex(:M)` THEN + ASM_REWRITE_TAC[SUBSET_NUMSEG; LE_REFL]; + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o CONJUNCT1 o + GEN_REWRITE_RULE I [permutes]) THEN + ASM_REWRITE_TAC[IN_NUMSEG; DE_MORGAN_THM; NOT_LE]]; + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [MATCH_MP_TAC PERMUTES_SUPERSET THEN + EXISTS_TAC `1..dimindex(:N)` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_NUMSEG] THEN ASM_MESON_TAC[NOT_LE]; + DISCH_TAC] THEN + AP_TERM_TAC THEN FIRST_ASSUM(SUBST1_TAC o MATCH_MP (ARITH_RULE + `m:num <= n ==> n = m + (n - m)`)) THEN + SIMP_TAC[PRODUCT_ADD_SPLIT; ARITH_RULE `1 <= n + 1`] THEN + MATCH_MP_TAC(REAL_RING `x = y /\ z = &1 ==> x = y * z`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PRODUCT_EQ_NUMSEG THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `i <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->num`; `1..dimindex(:M)`] PERMUTES_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE `s = t ==> s SUBSET t`)) THEN + ASM_SIMP_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:num->num) i <= dimindex(:N)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN + MAP_EVERY EXPAND_TAC ["A'"; "B'"] THEN + ASM_SIMP_TAC[LAMBDA_BETA]; + MATCH_MP_TAC PRODUCT_EQ_1_NUMSEG THEN + ASM_SIMP_TAC[ARITH_RULE `n + 1 <= i ==> n < i`] THEN + ASM_SIMP_TAC[ARITH_RULE `m:num <= n ==> m + (n - m) = n`] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `1 <= i` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MAT_COMPONENT] THEN + ASM_SIMP_TAC[REAL_EQ_ADD_LCANCEL_0; matrix_mul; LAMBDA_BETA] THEN + MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ENTIRE] THEN DISJ1_TAC THEN EXPAND_TAC "A'" THEN + ASM_SIMP_TAC[LAMBDA_BETA; ARITH_RULE `m + 1 <= i ==> ~(i <= m)`]]]) in + REPEAT GEN_TAC THEN DISJ_CASES_TAC (ARITH_RULE + `dimindex(:M) <= dimindex(:N) \/ dimindex(:N) <= dimindex(:M)`) + THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN + MATCH_MP_TAC lemma2 THEN ASM_REWRITE_TAC[]);; + +let COFACTOR_MATRIX_MUL = prove + (`!A B:real^N^N. cofactor(A ** B) = cofactor(A) ** cofactor(B)`, + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[COFACTOR_MATRIX_INV; GSYM INVERTIBLE_DET_NZ; + INVERTIBLE_MATRIX_MUL] THEN + REWRITE_TAC[DET_MUL; MATRIX_MUL_LMUL] THEN + REWRITE_TAC[MATRIX_MUL_RMUL; MATRIX_CMUL_ASSOC; + GSYM MATRIX_TRANSP_MUL] THEN + ASM_SIMP_TAC[MATRIX_INV_MUL]; + GEN_TAC THEN EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01]]; + X_GEN_TAC `A:real^N^N` THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN REWRITE_TAC[RIGHT_AND_FORALL_THM] THEN + MATCH_MP_TAC CLOSED_FORALL THEN GEN_TAC] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + REWRITE_TAC[CART_EQ] THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + ASM_SIMP_TAC[matrix_mul; LAMBDA_BETA; cofactor; LIFT_SUM; + FINITE_NUMSEG; o_DEF] THEN + (MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC CONTINUOUS_VSUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[o_DEF] THEN CONJ_TAC]) THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA; CONTINUOUS_CONST] THEN + REPEAT(W(fun (asl,w) -> + let t = find_term is_cond w in + ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN + SIMP_TAC[LIFT_SUM; FINITE_NUMSEG; o_DEF] THEN + TRY(MATCH_MP_TAC CONTINUOUS_VSUM THEN REWRITE_TAC[FINITE_NUMSEG] THEN + REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `p:num` THEN STRIP_TAC) THEN + REWRITE_TAC[LIFT_CMUL] THEN + TRY(MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[o_DEF; CONTINUOUS_CONST]) THEN + REWRITE_TAC[MATRIX_ADD_COMPONENT; LIFT_ADD] THEN + MATCH_MP_TAC CONTINUOUS_ADD THEN REWRITE_TAC[CONTINUOUS_CONST] THEN + REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN + REWRITE_TAC[CONTINUOUS_CONST; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; + +let DET_COFACTOR = prove + (`!A:real^N^N. det(cofactor A) = det(A) pow (dimindex(:N) - 1)`, + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN + X_GEN_TAC `A:real^N^N` THENL + [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_FIELD + `~(a = &0) ==> a * x = a * y ==> x = y`)) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM DET_TRANSP] THEN + REWRITE_TAC[GSYM DET_MUL; MATRIX_MUL_RIGHT_COFACTOR] THEN + REWRITE_TAC[DET_CMUL; GSYM(CONJUNCT2 real_pow); DET_I; REAL_MUL_RID] THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> SUC(n - 1) = n`]; + ALL_TAC] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN + CONJ_TAC THENL [ALL_TAC; MATCH_MP_TAC CONTINUOUS_LIFT_POW] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; + LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; + CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID] THEN + ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + REPEAT(W(fun (asl,w) -> + let t = find_term is_cond w in + ASM_CASES_TAC (lhand(rator t)) THEN ASM_REWRITE_TAC[CONTINUOUS_CONST])) THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; LIFT_ADD; + LIFT_CMUL; LIFT_DROP; CONTINUOUS_ADD; CONTINUOUS_CONST; + CONTINUOUS_MUL; o_DEF; LIFT_DROP; CONTINUOUS_AT_ID]);; + +let INVERTIBLE_COFACTOR = prove + (`!A:real^N^N. invertible(cofactor A) <=> dimindex(:N) = 1 \/ invertible A`, + SIMP_TAC[DET_COFACTOR; INVERTIBLE_DET_NZ; REAL_POW_EQ_0; DE_MORGAN_THM; + DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`; + DISJ_ACI]);; + +let COFACTOR_COFACTOR = prove + (`!A:real^N^N. + 2 <= dimindex(:N) + ==> cofactor(cofactor A) = (det(A) pow (dimindex(:N) - 2)) %% A`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC MATRIX_WLOG_INVERTIBLE THEN CONJ_TAC THEN + X_GEN_TAC `A:real^N^N` THENL + [REWRITE_TAC[INVERTIBLE_DET_NZ] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] + COFACTOR_MATRIX_MUL) THEN + REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; COFACTOR_CMUL; COFACTOR_I] THEN + REWRITE_TAC[COFACTOR_TRANSP] THEN + DISCH_THEN(MP_TAC o AP_TERM `transp:real^N^N->real^N^N`) THEN + REWRITE_TAC[MATRIX_TRANSP_MUL; TRANSP_TRANSP; TRANSP_MATRIX_CMUL] THEN + REWRITE_TAC[TRANSP_MAT] THEN + DISCH_THEN(MP_TAC o AP_TERM `(\x. x ** A):real^N^N->real^N^N`) THEN + REWRITE_TAC[GSYM MATRIX_MUL_ASSOC; MATRIX_MUL_LEFT_COFACTOR] THEN + REWRITE_TAC[MATRIX_MUL_LMUL; MATRIX_MUL_RMUL] THEN + REWRITE_TAC[MATRIX_MUL_LID; MATRIX_MUL_RID] THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:real^N^N. inv(det(A:real^N^N)) %% x`) THEN + ASM_SIMP_TAC[MATRIX_CMUL_ASSOC; REAL_MUL_LINV; MATRIX_CMUL_LID] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_POW_SUB; ARITH_RULE `2 <= n ==> 1 <= n`] THEN + REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_POW] THEN REAL_ARITH_TAC; + POP_ASSUM(K ALL_TAC)] THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN + REWRITE_TAC[SET_RULE + `{x | x IN s /\ P x} = s INTER {x | P x}`] THEN + MATCH_MP_TAC CLOSED_INTER THEN REWRITE_TAC[CLOSED_CBALL] THEN + REWRITE_TAC[CART_EQ] THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC CLOSED_FORALL_IN THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM LIFT_EQ; LIFT_NUM] THEN + REWRITE_TAC[SET_RULE `{x | f x = a} = {x | f x IN {a}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN + REWRITE_TAC[CLOSED_SING; LIFT_SUB] THEN X_GEN_TAC `x:real^1` THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [REPLICATE_TAC 2 + (ONCE_REWRITE_TAC[cofactor] THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + REPEAT(W(fun (asl,w) -> + let t = find_term is_cond w in + ASM_CASES_TAC (lhand(rator t)) THEN + ASM_REWRITE_TAC[CONTINUOUS_CONST]))); + REWRITE_TAC[MATRIX_CMUL_COMPONENT; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_MUL THEN REWRITE_TAC[o_DEF] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_LIFT_POW THEN + MATCH_MP_TAC CONTINUOUS_LIFT_DET THEN REPEAT STRIP_TAC; + ALL_TAC]] THEN + REWRITE_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL; LIFT_DROP] THEN + SIMP_TAC[CONTINUOUS_ADD; CONTINUOUS_CONST; CONTINUOUS_CMUL; + CONTINUOUS_AT_ID]);; + +let RANK_COFACTOR_EQ_FULL = prove + (`!A:real^N^N. rank(cofactor A) = dimindex(:N) <=> + dimindex(:N) = 1 \/ rank A = dimindex(:N)`, + REWRITE_TAC[RANK_EQ_FULL_DET; DET_COFACTOR; REAL_POW_EQ_0] THEN + SIMP_TAC[DIMINDEX_GE_1; ARITH_RULE `1 <= n ==> (n - 1 = 0 <=> n = 1)`] THEN + CONV_TAC TAUT);; + +let COFACTOR_EQ_0 = prove + (`!A:real^N^N. cofactor A = mat 0 <=> rank(A) < dimindex(:N) - 1`, + let lemma1 = prove + (`!A:real^N^N. rank(A) < dimindex(:N) - 1 ==> cofactor A = mat 0`, + GEN_TAC THEN REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN + SIMP_TAC[CART_EQ; cofactor; MAT_COMPONENT; LAMBDA_BETA; COND_ID] THEN + X_GEN_TAC `m:num` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[DET_EQ_0_RANK] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (ARITH_RULE `r < n - 1 ==> s <= r + 1 ==> s < n`)) THEN + REWRITE_TAC[RANK_ROW; rows] THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC + `dim (basis n INSERT + {row i ((lambda k l. if l = n then &0 else (A:real^N^N)$k$l) + :real^N^N) + | i IN (1..dimindex(:N)) DELETE m})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIM_SUBSET THEN REWRITE_TAC[GSYM IN_NUMSEG] THEN + MATCH_MP_TAC(SET_RULE + `m IN s /\ (!i. i IN s DELETE m ==> f i = g i) /\ f m = a + ==> {f i | i IN s} SUBSET a INSERT {g i | i IN s DELETE m}`) THEN + ASM_SIMP_TAC[IN_NUMSEG; IN_DELETE; row; LAMBDA_BETA; basis; LAMBDA_ETA]; + REWRITE_TAC[DIM_INSERT] THEN MATCH_MP_TAC(ARITH_RULE + `n <= k ==> (if p then n else n + 1) <= k + 1`) THEN + MATCH_MP_TAC(MESON[DIM_LINEAR_IMAGE_LE; DIM_SUBSET; LE_TRANS] + `(?f. linear f /\ t SUBSET IMAGE f s) ==> dim t <= dim s`) THEN + EXISTS_TAC `(\x. lambda i. if i = n then &0 else x$i) + :real^N->real^N` THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [SIMP_TAC[linear; CART_EQ; LAMBDA_BETA; VECTOR_ADD_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG; IN_DELETE] THEN + STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_GSPEC] THEN EXISTS_TAC `i:num` THEN + ASM_SIMP_TAC[row; CART_EQ; LAMBDA_BETA]]]) + and lemma2 = prove + (`!A:real^N^N. + rank A < dimindex(:N) + ==> ?n x. 1 <= n /\ n <= dimindex(:N) /\ + rank A < + rank((lambda i. if i = n then x else row i A):real^N^N)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `?n. 1 <= n /\ n <= dimindex(:N) /\ + row n (A:real^N^N) IN + span {row j A | j IN (1..dimindex(:N)) DELETE n}` + MP_TAC THENL + [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN + ASM_REWRITE_TAC[DET_EQ_0_RANK; RANK_TRANSP] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; VEC_COMPONENT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + SIMP_TAC[matrix_vector_mul; transp; VEC_COMPONENT; LAMBDA_BETA] THEN + DISCH_TAC THEN + SUBGOAL_THEN `row n A = vsum ((1..dimindex(:N)) DELETE n) + (\i. --((c:real^N)$i / c$n) % row i (A:real^N^N))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VSUM_DELETE; FINITE_NUMSEG; IN_NUMSEG; REAL_DIV_REFL] THEN + REWRITE_TAC[VECTOR_ARITH `n = x - -- &1 % n <=> x:real^N = vec 0`] THEN + SIMP_TAC[VSUM_COMPONENT; row; VECTOR_MUL_COMPONENT; LAMBDA_BETA; + CART_EQ; REAL_ARITH `--(x / y) * z:real = --(inv y) * z * x`] THEN + ASM_SIMP_TAC[SUM_LMUL; VEC_COMPONENT; REAL_MUL_RZERO]; + MATCH_MP_TAC SPAN_VSUM THEN SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_DELETE; IN_NUMSEG] THEN + STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `span {row j (A:real^N^N) | j IN (1..dimindex(:N)) DELETE n} + PSUBSET (:real^N)` + MP_TAC THENL + [REWRITE_TAC[PSUBSET; SUBSET_UNIV] THEN + DISCH_THEN(MP_TAC o AP_TERM `dim:(real^N->bool)->num`) THEN + REWRITE_TAC[DIM_UNIV] THEN + MATCH_MP_TAC(ARITH_RULE `1 <= n /\ x <= n - 1 ==> ~(x = n)`) THEN + REWRITE_TAC[DIMINDEX_GE_1; DIM_SPAN] THEN + W(MP_TAC o PART_MATCH (lhand o rand) DIM_LE_CARD o lhand o snd) THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_DELETE; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN + W(MP_TAC o PART_MATCH (lhand o rand) CARD_IMAGE_LE o lhand o snd) THEN + SIMP_TAC[FINITE_DELETE; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] LE_TRANS) THEN + ASM_SIMP_TAC[CARD_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN + REWRITE_TAC[CARD_NUMSEG_1; LE_REFL]; + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `s PSUBSET UNIV ==> ?x. ~(x IN s)`)) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `x:real^N` THEN + REWRITE_TAC[RANK_ROW] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!A:real^N^N. rows A = row n A INSERT + {row j A | j IN (1..dimindex (:N)) DELETE n}` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[rows; IN_DELETE; IN_NUMSEG] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[DIM_INSERT]] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `x IN span s ==> x = y /\ s = t ==> ~(y IN span t) ==> q`)) THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; LAMBDA_ETA]; + MATCH_MP_TAC(ARITH_RULE `s = t ==> s < t + 1`) THEN + AP_TERM_TAC THEN REWRITE_TAC[row]] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s ==> f x = g x) ==> {f x | x IN s} = {g x | x IN s}`) THEN + ASM_SIMP_TAC[IN_DELETE; IN_NUMSEG; LAMBDA_BETA; CART_EQ]]]) in + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[lemma1] THEN DISCH_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `r <= n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `A:real^N^N` RANK_BOUND) THEN ARITH_TAC; + REWRITE_TAC[RANK_EQ_FULL_DET] THEN + MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN + ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN + REWRITE_TAC[MAT_EQ; ARITH_EQ]; + DISCH_TAC] THEN + MP_TAC(ISPEC `A:real^N^N` lemma2) THEN + ASM_REWRITE_TAC[DIMINDEX_GE_1; ARITH_RULE `n - 1 < n <=> 1 <= n`] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN `x:real^N` + STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `n - 1 < k ==> k <= MIN n n ==> k = n`)) THEN + REWRITE_TAC[RANK_BOUND; RANK_EQ_FULL_DET] THEN + MP_TAC(GEN `A:real^N^N` (ISPECL [`A:real^N^N`; `n:num`] + DET_COFACTOR_EXPANSION)) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN MATCH_MP_TAC SUM_EQ_0 THEN + X_GEN_TAC `m:num` THEN SIMP_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN + DISJ2_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[CART_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `m:num`) THEN + ASM_SIMP_TAC[MAT_COMPONENT; COND_ID] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EQ_TRANS) THEN + ASM_SIMP_TAC[cofactor; LAMBDA_BETA] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA; row] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[LAMBDA_BETA]) THEN + ASM_MESON_TAC[]);; + +let RANK_COFACTOR_EQ_1 = prove + (`!A:real^N^N. rank(cofactor A) = 1 <=> + dimindex(:N) = 1 \/ rank A = dimindex(:N) - 1`, + GEN_TAC THEN ASM_CASES_TAC `dimindex(:N) = 1` THENL + [ASM_MESON_TAC[RANK_COFACTOR_EQ_FULL]; ASM_REWRITE_TAC[]] THEN + EQ_TAC THENL + [ASM_CASES_TAC `cofactor A:real^N^N = mat 0` THEN + ASM_REWRITE_TAC[RANK_0; ARITH_EQ] THEN DISCH_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `~(r < n - 1) /\ ~(r = n) /\ r <= MIN n n ==> r = n - 1`) THEN + ASM_REWRITE_TAC[RANK_BOUND; GSYM COFACTOR_EQ_0] THEN + MP_TAC(ISPEC `A:real^N^N` RANK_COFACTOR_EQ_FULL) THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC(ARITH_RULE + `~(n = 0) /\ n <= 1 ==> n = 1`) THEN + ASM_REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0; LT_REFL] THEN + MP_TAC(ISPECL [`A:real^N^N`; `transp(cofactor A):real^N^N`] + RANK_SYLVESTER) THEN + ASM_REWRITE_TAC[MATRIX_MUL_RIGHT_COFACTOR; RANK_TRANSP] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (ARITH_RULE + `a = n - 1 ==> 1 <= n ==> a < n`)) THEN + ASM_SIMP_TAC[GSYM DET_EQ_0_RANK; DIMINDEX_GE_1] THEN + DISCH_TAC THEN REWRITE_TAC[MATRIX_CMUL_LZERO; RANK_0] THEN + ARITH_TAC]);; + +let RANK_COFACTOR = prove + (`!A:real^N^N. + rank(cofactor A) = if rank(A) = dimindex(:N) then dimindex(:N) + else if rank(A) = dimindex(:N) - 1 then 1 + else 0`, + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_FULL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[RANK_COFACTOR_EQ_1] THEN + REWRITE_TAC[RANK_EQ_0; COFACTOR_EQ_0] THEN + MATCH_MP_TAC(ARITH_RULE + `r <= MIN n n /\ ~(r = n) /\ ~(r = n - 1) ==> r < n - 1`) THEN + ASM_REWRITE_TAC[RANK_BOUND]);; + +(* ------------------------------------------------------------------------- *) +(* Not in so many words, but combining this with intermediate value theorem *) +(* implies the determinant is an open map. *) +(* ------------------------------------------------------------------------- *) + +let DET_OPEN_MAP = prove + (`!A:real^N^N e. + &0 < e + ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < det A) /\ + (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > det A)`, + let lemma1 = prove + (`!A:real^N^N i e. + 1 <= i /\ i <= dimindex(:N) /\ row i A = vec 0 /\ &0 < e + ==> (?B:real^N^N. (!i j. abs(B$i$j - A$i$j) < e) /\ det B < &0) /\ + (?C:real^N^N. (!i j. abs(C$i$j - A$i$j) < e) /\ det C > &0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `det(A:real^N^N) = &0` ASSUME_TAC THENL + [ASM_MESON_TAC[DET_ZERO_ROW]; ALL_TAC] THEN + MP_TAC(ISPEC `A:real^N^N` NEARBY_INVERTIBLE_MATRIX) THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `min d e / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[INVERTIBLE_DET_NZ]] THEN + DISCH_THEN(STRIP_ASSUME_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> x < &0 \/ &0 < x`)) + THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN + (CONJ_TAC THENL + [EXISTS_TAC `A + min d e / &2 %% mat 1:real^N^N`; + EXISTS_TAC `(lambda j. if j = i then + --(&1) % row i (A + min d e / &2 %% mat 1:real^N^N) + else row j (A + min d e / &2 %% mat 1:real^N^N)) + :real^N^N`]) THEN + ASM_SIMP_TAC[DET_ROW_MUL; MESON[] + `(if j = i then f i else f j) = f j`] THEN + REWRITE_TAC[row; LAMBDA_ETA] THEN + ASM_REWRITE_TAC[real_gt; GSYM row] THEN + TRY(CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC]) THEN + (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + TRY COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[MATRIX_ADD_COMPONENT; MATRIX_CMUL_COMPONENT; MAT_COMPONENT; + VECTOR_MUL_COMPONENT] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CART_EQ]) THEN + DISCH_THEN(MP_TAC o SPEC `l:num`) THEN + ASM_SIMP_TAC[row; LAMBDA_BETA; VEC_COMPONENT] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC) + and lemma2 = prove + (`!A:real^N^N x:real^N i. + 1 <= i /\ i <= dimindex(:N) /\ x$i = &1 + ==> det(lambda k. if k = i then transp A ** x else row k A) = det A`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `det(lambda k. if k = i + then row i (A:real^N^N) + (transp A ** x - row i A) + else row k A)` THEN + CONJ_TAC THENL + [REWRITE_TAC[VECTOR_ARITH `r + (x - r):real^N = x`]; ALL_TAC] THEN + MATCH_MP_TAC DET_ROW_SPAN THEN + SUBGOAL_THEN + `transp(A:real^N^N) ** x - row i A = + vsum ((1..dimindex(:N)) DELETE i) (\k. x$k % row k A)` + SUBST1_TAC THENL + [SIMP_TAC[CART_EQ; VSUM_COMPONENT; VECTOR_SUB_COMPONENT; row; transp; + LAMBDA_BETA; matrix_vector_mul; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_AC]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SPAN_VSUM THEN + REWRITE_TAC[FINITE_DELETE; IN_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN MATCH_MP_TAC SPAN_MUL THEN + MATCH_MP_TAC SPAN_SUPERSET THEN ASM SET_TAC[]]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `cofactor(A:real^N^N) = mat 0` THENL + [MP_TAC(SYM(ISPEC `A:real^N^N` MATRIX_MUL_LEFT_COFACTOR)) THEN + ASM_REWRITE_TAC[MATRIX_CMUL_EQ_0; TRANSP_MAT; MATRIX_MUL_LZERO] THEN + REWRITE_TAC[MAT_EQ; ARITH_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `?c i. 1 <= i /\ i <= dimindex(:N) /\ c$i = &1 /\ + transp(A:real^N^N) ** c = vec 0` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `transp A:real^N^N` HOMOGENEOUS_LINEAR_EQUATIONS_DET) THEN + ASM_REWRITE_TAC[DET_TRANSP] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real^N` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + REWRITE_TAC[VEC_COMPONENT; NOT_IMP; NOT_FORALL_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `i:num` THEN STRIP_TAC THEN + EXISTS_TAC `inv(c$i) % c:real^N` THEN + ASM_SIMP_TAC[VECTOR_MUL_COMPONENT; REAL_MUL_LINV] THEN + ASM_REWRITE_TAC[MATRIX_VECTOR_MUL_RMUL; VECTOR_MUL_RZERO]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`(lambda k. if k = i then transp A ** c else row k (A:real^N^N)):real^N^N`; + `i:num`; `min e (e / &(dimindex(:N)) / + (&1 + norm(&2 % basis i - c:real^N)))`] lemma1) THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; + NORM_ARITH `&0 < &1 + norm(x:real^N)`] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[row; CART_EQ; VEC_COMPONENT; LAMBDA_BETA]; + ALL_TAC] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THEN + ABBREV_TAC `A':real^N^N = + lambda k. if k = i then vec 0 else row k (A:real^N^N)` THEN + DISCH_THEN(X_CHOOSE_THEN `B:real^N^N` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(lambda k. if k = i then transp(B:real^N^N) ** + (&2 % basis i - c) + else row k B):real^N^N` THEN + ASM_SIMP_TAC[lemma2; BASIS_COMPONENT; VECTOR_MUL_COMPONENT; + VECTOR_SUB_COMPONENT; REAL_ARITH `&2 * x - x = x`] THEN + (MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC]) THEN + EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + (COND_CASES_TAC THENL + [ALL_TAC; + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `l:num`]) THEN + EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA; row]] THEN + SUBGOAL_THEN + `(A:real^N^N)$k$l = (transp(A':real^N^N) ** (&2 % basis i - c:real^N))$l` + SUBST1_TAC THENL + [ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN + EXPAND_TAC "A'" THEN ASM_SIMP_TAC[LAMBDA_BETA] THEN + REWRITE_TAC[COND_RAND; COND_RATOR] THEN + SIMP_TAC[VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT; BASIS_COMPONENT; + VEC_COMPONENT; REAL_MUL_RZERO; REAL_SUB_LZERO; REAL_MUL_LZERO] THEN + ASM_SIMP_TAC[SUM_CASES; FINITE_NUMSEG; SUM_0; REAL_ADD_LID] THEN + ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE; IN_NUMSEG; FINITE_NUMSEG] THEN + UNDISCH_TAC `transp(A:real^N^N) ** (c:real^N) = vec 0` THEN + ASM_SIMP_TAC[CART_EQ; VEC_COMPONENT; matrix_vector_mul; LAMBDA_BETA; + row; transp] THEN + DISCH_THEN(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_MUL_RNEG; SUM_NEG] THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM VECTOR_SUB_COMPONENT; GSYM TRANSP_MATRIX_SUB; + GSYM MATRIX_VECTOR_MUL_SUB_RDISTRIB]] THEN + ASM_SIMP_TAC[matrix_vector_mul; transp; LAMBDA_BETA] THEN + W(MP_TAC o PART_MATCH lhand SUM_ABS_NUMSEG o lhand o snd) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + ASM_SIMP_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; + GSYM NOT_LE; DIMINDEX_GE_1] THEN + X_GEN_TAC `r:num` THEN REWRITE_TAC[CARD_NUMSEG_1; IN_NUMSEG] THEN + STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + TRANS_TAC REAL_LET_TRANS + `abs((B - A':real^N^N)$r$l) * (&1 + norm(&2 % basis i - c:real^N))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= &1 + b`) THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM]; + ASM_SIMP_TAC[MATRIX_SUB_COMPONENT; GSYM REAL_LT_RDIV_EQ; + NORM_ARITH `&0 < &1 + norm(x:real^N)`]]); + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [CART_EQ]) THEN + SIMP_TAC[CART_EQ; MAT_COMPONENT; COND_ID] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; real_gt] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` (CONJUNCTS_THEN2 STRIP_ASSUME_TAC + (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ x < &0`)) + THENL [ALL_TAC; ONCE_REWRITE_TAC[CONJ_SYM]] THEN + (CONJ_TAC THENL + [EXISTS_TAC `(lambda m n. if m = i /\ n = j + then (A:real^N^N)$i$j - + e / (&1 + abs(cofactor A$i$j)) + else A$m$n):real^N^N`; + EXISTS_TAC `(lambda m n. if m = i /\ n = j + then (A:real^N^N)$i$j + + e / (&1 + abs(cofactor A$i$j)) + else A$m$n):real^N^N`]) THEN + (CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `?k. 1 <= k /\ k <= dimindex(:N) /\ !A:real^N^N. A$m = A$k` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + SUBGOAL_THEN `?l. 1 <= l /\ l <= dimindex(:N) /\ !z:real^N. z$n = z$l` + CHOOSE_TAC THENL [REWRITE_TAC[FINITE_INDEX_INRANGE]; ALL_TAC] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ARITH `abs(a - e - a) = abs e`; + REAL_ARITH `abs((a + e) - a) = abs e`] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_ABS_ABS] THEN + ASM_SIMP_TAC[REAL_ARITH `abs(&1 + abs x) = &1 + abs x`; + REAL_LT_LDIV_EQ; REAL_ARITH `&0 < &1 + abs x`] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ &0 < e * x ==> abs e < e * (&1 + x)`) THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN ASM_REAL_ARITH_TAC; + ALL_TAC]) THEN + MP_TAC(GEN `A:real^N^N` (SPECL [`A:real^N^N`; `i:num`] + DET_COFACTOR_EXPANSION)) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(K ALL_TAC) THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ASM_SIMP_TAC[GSYM SUM_SUB_NUMSEG; LAMBDA_BETA] THEN + REWRITE_TAC[REAL_ARITH `p - A$i$j * cofactor A$i$j = + --(A$i$j * cofactor A$i$j - p)`] THEN + REWRITE_TAC[SUM_NEG; REAL_ARITH + `a * b - c * d:real = b * (a - c) + c * (b - d)`] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; REAL_NEG_ADD] THEN MATCH_MP_TAC(REAL_ARITH + `b = &0 /\ &0 < a ==> &0 < a + b`) THEN + (CONJ_TAC THENL + [REWRITE_TAC[REAL_NEG_EQ_0] THEN + MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE] THEN STRIP_TAC THEN DISJ2_TAC THEN + REWRITE_TAC[REAL_SUB_0] THEN REWRITE_TAC[cofactor] THEN + ASM_SIMP_TAC[LAMBDA_BETA] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN ASM_MESON_TAC[]; + ALL_TAC]) THEN + REWRITE_TAC[GSYM SUM_NEG; GSYM REAL_MUL_RNEG] THEN + MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[FINITE_NUMSEG] THEN + MATCH_MP_TAC(MESON[REAL_LT_IMP_LE; REAL_LE_REFL] + `(?i. P i /\ &0 < f i /\ (!j. P j /\ ~(j = i) ==> f j = &0)) + ==> (!j. P j ==> &0 <= f j) /\ (?j. P j /\ &0 < f j)`) THEN + EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + ASM_SIMP_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; IN_NUMSEG; REAL_NEG_0] THEN + REWRITE_TAC[REAL_ARITH `a - (a + e):real = --e`; + REAL_ARITH `a - (a - e):real = e`; REAL_NEG_NEG] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ] THEN + REWRITE_TAC[REAL_ARITH `&0 < a * --b <=> &0 < --a * b`] THEN + ASM_SIMP_TAC[REAL_LT_MUL_EQ; REAL_NEG_GT0] THEN + MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Infinite sums of vectors. Allow general starting point (and more). *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("sums",(12,"right"));; + +let sums = new_definition + `(f sums l) s = ((\n. vsum(s INTER (0..n)) f) --> l) sequentially`;; + +let infsum = new_definition + `infsum s f = @l. (f sums l) s`;; + +let summable = new_definition + `summable s f = ?l. (f sums l) s`;; + +let SUMS_SUMMABLE = prove + (`!f l s. (f sums l) s ==> summable s f`, + REWRITE_TAC[summable] THEN MESON_TAC[]);; + +let SUMS_INFSUM = prove + (`!f s. (f sums (infsum s f)) s <=> summable s f`, + REWRITE_TAC[infsum; summable] THEN MESON_TAC[]);; + +let SUMS_LIM = prove + (`!f:num->real^N s. + (f sums lim sequentially (\n. vsum (s INTER (0..n)) f)) s + <=> summable s f`, + GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL [MESON_TAC[summable]; + REWRITE_TAC[summable; sums] THEN STRIP_TAC THEN REWRITE_TAC[lim] THEN + ASM_MESON_TAC[]]);; + +let FINITE_INTER_NUMSEG = prove + (`!s m n. FINITE(s INTER (m..n))`, + MESON_TAC[FINITE_SUBSET; FINITE_NUMSEG; INTER_SUBSET]);; + +let SERIES_FROM = prove + (`!f l k. (f sums l) (from k) = ((\n. vsum(k..n) f) --> l) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; numseg; from; IN_ELIM_THM; IN_INTER] THEN ARITH_TAC);; + +let SERIES_UNIQUE = prove + (`!f:num->real^N l l' s. (f sums l) s /\ (f sums l') s ==> (l = l')`, + REWRITE_TAC[sums] THEN MESON_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; LIM_UNIQUE]);; + +let INFSUM_UNIQUE = prove + (`!f:num->real^N l s. (f sums l) s ==> infsum s f = l`, + MESON_TAC[SERIES_UNIQUE; SUMS_INFSUM; summable]);; + +let SERIES_TERMS_TOZERO = prove + (`!f l n. (f sums l) (from n) ==> (f --> vec 0) sequentially`, + REPEAT GEN_TAC THEN SIMP_TAC[sums; LIM_SEQUENTIALLY; FROM_INTER_NUMSEG] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N + n + 1` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `m - 1` th) THEN MP_TAC(SPEC `m:num` th)) THEN + SUBGOAL_THEN `0 < m /\ n <= m` (fun th -> SIMP_TAC[VSUM_CLAUSES_RIGHT; th]) + THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REPEAT(ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC);; + +let SERIES_FINITE = prove + (`!f s. FINITE s ==> (f sums (vsum s f)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[num_FINITE; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `n:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `s INTER (0..m) = s` + (fun th -> ASM_REWRITE_TAC[th; DIST_REFL]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LE_TRANS]);; + +let SERIES_LINEAR = prove + (`!f h l s. (f sums l) s /\ linear h ==> ((\n. h(f n)) sums h l) s`, + SIMP_TAC[sums; LIM_LINEAR; FINITE_INTER; FINITE_NUMSEG; + GSYM(REWRITE_RULE[o_DEF] LINEAR_VSUM)]);; + +let SERIES_0 = prove + (`!s. ((\n. vec 0) sums (vec 0)) s`, + REWRITE_TAC[sums; VSUM_0; LIM_CONST]);; + +let SERIES_ADD = prove + (`!x x0 y y0 s. + (x sums x0) s /\ (y sums y0) s ==> ((\n. x n + y n) sums (x0 + y0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_ADD; LIM_ADD]);; + +let SERIES_SUB = prove + (`!x x0 y y0 s. + (x sums x0) s /\ (y sums y0) s ==> ((\n. x n - y n) sums (x0 - y0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_SUB; LIM_SUB]);; + +let SERIES_CMUL = prove + (`!x x0 c s. (x sums x0) s ==> ((\n. c % x n) sums (c % x0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_LMUL; LIM_CMUL]);; + +let SERIES_NEG = prove + (`!x x0 s. (x sums x0) s ==> ((\n. --(x n)) sums (--x0)) s`, + SIMP_TAC[sums; FINITE_INTER_NUMSEG; VSUM_NEG; LIM_NEG]);; + +let SUMS_IFF = prove + (`!f g k. (!x. x IN k ==> f x = g x) ==> ((f sums l) k <=> (g sums l) k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER]);; + +let SUMS_EQ = prove + (`!f g k. (!x. x IN k ==> f x = g x) /\ (f sums l) k ==> (g sums l) k`, + MESON_TAC[SUMS_IFF]);; + +let SUMS_0 = prove + (`!f:num->real^N s. (!n. n IN s ==> f n = vec 0) ==> (f sums vec 0) s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMS_EQ THEN + EXISTS_TAC `\n:num. vec 0:real^N` THEN ASM_SIMP_TAC[SERIES_0]);; + +let SERIES_FINITE_SUPPORT = prove + (`!f:num->real^N s k. + FINITE (s INTER k) /\ (!x. ~(x IN s INTER k) ==> f x = vec 0) + ==> (f sums vsum (s INTER k) f) k`, + REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:num. x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `vsum (k INTER (0..n)) (f:num->real^N) = vsum(s INTER k) f` + (fun th -> ASM_REWRITE_TAC[DIST_REFL; th]) THEN + MATCH_MP_TAC VSUM_SUPERSET THEN + ASM_SIMP_TAC[SUBSET; IN_INTER; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[IN_INTER; LE_TRANS]);; + +let SERIES_COMPONENT = prove + (`!f s l:real^N k. (f sums l) s /\ 1 <= k /\ k <= dimindex(:N) + ==> ((\i. lift(f(i)$k)) sums lift(l$k)) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + ASM_SIMP_TAC[GSYM LIFT_SUM; GSYM VSUM_COMPONENT; + FINITE_INTER; FINITE_NUMSEG] THEN + ASM_SIMP_TAC[o_DEF; LIM_COMPONENT]);; + +let SERIES_DIFFS = prove + (`!f:num->real^N k. + (f --> vec 0) sequentially + ==> ((\n. f(n) - f(n + 1)) sums f(k)) (from k)`, + REWRITE_TAC[sums; FROM_INTER_NUMSEG; VSUM_DIFFS] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n. (f:num->real^N) k - f(n + 1)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `k:num` THEN + SIMP_TAC[]; + GEN_REWRITE_TAC LAND_CONV [GSYM VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC LIM_SUB THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC SEQ_OFFSET THEN ASM_REWRITE_TAC[]]);; + +let SERIES_TRIVIAL = prove + (`!f. (f sums vec 0) {}`, + REWRITE_TAC[sums; INTER_EMPTY; VSUM_CLAUSES; LIM_CONST]);; + +let SERIES_RESTRICT = prove + (`!f k l:real^N. + ((\n. if n IN k then f(n) else vec 0) sums l) (:num) <=> + (f sums l) k`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums] THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; INTER_UNIV] THEN GEN_TAC THEN + MATCH_MP_TAC(MESON[] `vsum s f = vsum t f /\ vsum t f = vsum t g + ==> vsum s f = vsum t g`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN SET_TAC[]; + MATCH_MP_TAC VSUM_EQ THEN SIMP_TAC[IN_INTER]]);; + +let SERIES_VSUM = prove + (`!f l k s. FINITE s /\ s SUBSET k /\ (!x. ~(x IN s) ==> f x = vec 0) /\ + vsum s f = l ==> (f sums l) k`, + REPEAT STRIP_TAC THEN EXPAND_TAC "l" THEN + SUBGOAL_THEN `s INTER k = s:num->bool` ASSUME_TAC THENL + [ASM SET_TAC []; ASM_MESON_TAC [SERIES_FINITE_SUPPORT]]);; + +let SUMS_REINDEX = prove + (`!k a l n. ((\x. a(x + k)) sums l) (from n) <=> (a sums l) (from(n + k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums; FROM_INTER_NUMSEG] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM VSUM_OFFSET] THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + ASM_MESON_TAC[ARITH_RULE `N + k:num <= n ==> n = (n - k) + k /\ N <= n - k`; + ARITH_RULE `N + k:num <= n ==> N <= n + k`]);; + +(* ------------------------------------------------------------------------- *) +(* Similar combining theorems just for summability. *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_LINEAR = prove + (`!f h s. summable s f /\ linear h ==> summable s (\n. h(f n))`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_LINEAR]);; + +let SUMMABLE_0 = prove + (`!s. summable s (\n. vec 0)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_0]);; + +let SUMMABLE_ADD = prove + (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n + y n)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_ADD]);; + +let SUMMABLE_SUB = prove + (`!x y s. summable s x /\ summable s y ==> summable s (\n. x n - y n)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUB]);; + +let SUMMABLE_CMUL = prove + (`!s x c. summable s x ==> summable s (\n. c % x n)`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_CMUL]);; + +let SUMMABLE_NEG = prove + (`!x s. summable s x ==> summable s (\n. --(x n))`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_NEG]);; + +let SUMMABLE_IFF = prove + (`!f g k. (!x. x IN k ==> f x = g x) ==> (summable k f <=> summable k g)`, + REWRITE_TAC[summable] THEN MESON_TAC[SUMS_IFF]);; + +let SUMMABLE_EQ = prove + (`!f g k. (!x. x IN k ==> f x = g x) /\ summable k f ==> summable k g`, + REWRITE_TAC[summable] THEN MESON_TAC[SUMS_EQ]);; + +let SUMMABLE_COMPONENT = prove + (`!f:num->real^N s k. + summable s f /\ 1 <= k /\ k <= dimindex(:N) + ==> summable s (\i. lift(f(i)$k))`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `l:real^N` o REWRITE_RULE[summable]) THEN + REWRITE_TAC[summable] THEN EXISTS_TAC `lift((l:real^N)$k)` THEN + ASM_SIMP_TAC[SERIES_COMPONENT]);; + +let SERIES_SUBSET = prove + (`!x s t l. + s SUBSET t /\ + ((\i. if i IN s then x i else vec 0) sums l) t + ==> (x sums l) s`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[sums] THEN MATCH_MP_TAC EQ_IMP THEN + AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + ASM_SIMP_TAC[GSYM VSUM_RESTRICT_SET; FINITE_INTER_NUMSEG] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let SUMMABLE_SUBSET = prove + (`!x s t. + s SUBSET t /\ + summable t (\i. if i IN s then x i else vec 0) + ==> summable s x`, + REWRITE_TAC[summable] THEN MESON_TAC[SERIES_SUBSET]);; + +let SUMMABLE_TRIVIAL = prove + (`!f:num->real^N. summable {} f`, + GEN_TAC THEN REWRITE_TAC[summable] THEN EXISTS_TAC `vec 0:real^N` THEN + REWRITE_TAC[SERIES_TRIVIAL]);; + +let SUMMABLE_RESTRICT = prove + (`!f:num->real^N k. + summable (:num) (\n. if n IN k then f(n) else vec 0) <=> + summable k f`, + REWRITE_TAC[summable; SERIES_RESTRICT]);; + +let SUMS_FINITE_DIFF = prove + (`!f:num->real^N t s l. + t SUBSET s /\ FINITE t /\ (f sums l) s + ==> (f sums (l - vsum t f)) (s DIFF t)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN + ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP SERIES_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN REWRITE_TAC[IN_DIFF] THEN + FIRST_ASSUM(MP_TAC o SPEC `x:num` o GEN_REWRITE_RULE I [SUBSET]) THEN + MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let SUMS_FINITE_UNION = prove + (`!f:num->real^N s t l. + FINITE t /\ (f sums l) s + ==> (f sums (l + vsum (t DIFF s) f)) (s UNION t)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(MP_TAC o SPEC `s:num->bool` o MATCH_MP FINITE_DIFF) THEN + DISCH_THEN(MP_TAC o ISPEC `f:num->real^N` o MATCH_MP SERIES_FINITE) THEN + ONCE_REWRITE_TAC[GSYM SERIES_RESTRICT] THEN + REWRITE_TAC[IMP_IMP] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP SERIES_ADD) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:num` THEN + REWRITE_TAC[IN_DIFF; IN_UNION] THEN + MAP_EVERY ASM_CASES_TAC [`(x:num) IN s`; `(x:num) IN t`] THEN + ASM_REWRITE_TAC[] THEN VECTOR_ARITH_TAC);; + +let SUMS_OFFSET = prove + (`!f:num->real^N l m n. + (f sums l) (from m) /\ m < n + ==> (f sums (l - vsum(m..(n-1)) f)) (from n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `from n = from m DIFF (m..(n-1))` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_FROM; IN_DIFF; IN_NUMSEG] THEN ASM_ARITH_TAC; + MATCH_MP_TAC SUMS_FINITE_DIFF THEN ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[SUBSET; IN_FROM; IN_NUMSEG]]);; + +let SUMS_OFFSET_REV = prove + (`!f:num->real^N l m n. + (f sums l) (from m) /\ n < m + ==> (f sums (l + vsum(n..m-1) f)) (from n)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `from m`; `n..m-1`; `l:real^N`] + SUMS_FINITE_UNION) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN MATCH_MP_TAC EQ_IMP THEN + BINOP_TAC THENL [AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_FROM; IN_NUMSEG] THEN + ASM_ARITH_TAC);; + +let SUMMABLE_REINDEX = prove + (`!k a n. summable (from n) (\x. a (x + k)) <=> summable (from(n + k)) a`, + REWRITE_TAC[summable; GSYM SUMS_REINDEX]);; + +let SERIES_DROP_LE = prove + (`!f g s a b. + (f sums a) s /\ (g sums b) s /\ + (!x. x IN s ==> drop(f x) <= drop(g x)) + ==> drop a <= drop b`, + REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^1)` THEN + EXISTS_TAC `\n. vsum (s INTER (0..n)) (g:num->real^1)` THEN + ASM_REWRITE_TAC[DROP_VSUM] THEN EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; o_THM; IN_INTER; IN_NUMSEG]);; + +let SERIES_DROP_POS = prove + (`!f s a. + (f sums a) s /\ (!x. x IN s ==> &0 <= drop(f x)) + ==> &0 <= drop a`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\n. vec 0):num->real^1`; `f:num->real^1`; `s:num->bool`; + `vec 0:real^1`; `a:real^1`] SERIES_DROP_LE) THEN + ASM_SIMP_TAC[SUMS_0; DROP_VEC]);; + +let SERIES_BOUND = prove + (`!f:num->real^N g s a b. + (f sums a) s /\ ((lift o g) sums (lift b)) s /\ + (!i. i IN s ==> norm(f i) <= g i) + ==> norm(a) <= b`, + REWRITE_TAC[sums] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC `\n. vsum (s INTER (0..n)) (f:num->real^N)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + TRANS_TAC REAL_LE_TRANS `sum (s INTER (0..m)) g` THEN CONJ_TAC THEN + ASM_SIMP_TAC[VSUM_NORM_LE; IN_INTER; FINITE_NUMSEG; FINITE_INTER] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM sums]) THEN + UNDISCH_TAC `((lift o g) sums lift b) s` THEN + GEN_REWRITE_TAC LAND_CONV [GSYM SERIES_RESTRICT] THEN + REWRITE_TAC[GSYM FROM_0] THEN DISCH_THEN(MP_TAC o SPEC `m + 1` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUMS_OFFSET)) THEN + REWRITE_TAC[ARITH_RULE `0 < m + 1`; o_DEF; ADD_SUB] THEN + REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN + REWRITE_TAC[VSUM_REAL; o_DEF; LIFT_DROP; ETA_AX] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] SERIES_DROP_POS)) THEN + REWRITE_TAC[DROP_SUB; LIFT_DROP; ONCE_REWRITE_RULE[INTER_COMM] (GSYM INTER); + REAL_SUB_LE] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[LIFT_DROP; DROP_VEC; REAL_LE_REFL] THEN + ASM_MESON_TAC[NORM_ARITH `norm(x:real^N) <= y ==> &0 <= y`]);; + +(* ------------------------------------------------------------------------- *) +(* Similar combining theorems for infsum. *) +(* ------------------------------------------------------------------------- *) + +let INFSUM_LINEAR = prove + (`!f h s. summable s f /\ linear h + ==> infsum s (\n. h(f n)) = h(infsum s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_LINEAR THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_0 = prove + (`infsum s (\i. vec 0) = vec 0`, + MATCH_MP_TAC INFSUM_UNIQUE THEN REWRITE_TAC[SERIES_0]);; + +let INFSUM_ADD = prove + (`!x y s. summable s x /\ summable s y + ==> infsum s (\i. x i + y i) = infsum s x + infsum s y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_ADD THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_SUB = prove + (`!x y s. summable s x /\ summable s y + ==> infsum s (\i. x i - y i) = infsum s x - infsum s y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_SUB THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_CMUL = prove + (`!s x c. summable s x ==> infsum s (\n. c % x n) = c % infsum s x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_CMUL THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_NEG = prove + (`!s x. summable s x ==> infsum s (\n. --(x n)) = --(infsum s x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INFSUM_UNIQUE THEN + MATCH_MP_TAC SERIES_NEG THEN ASM_REWRITE_TAC[SUMS_INFSUM]);; + +let INFSUM_EQ = prove + (`!f g k. summable k f /\ summable k g /\ (!x. x IN k ==> f x = g x) + ==> infsum k f = infsum k g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[infsum] THEN + AP_TERM_TAC THEN ABS_TAC THEN ASM_MESON_TAC[SUMS_EQ; SUMS_INFSUM]);; + +let INFSUM_RESTRICT = prove + (`!k a:num->real^N. + infsum (:num) (\n. if n IN k then a n else vec 0) = infsum k a`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`a:num->real^N`; `k:num->bool`] SUMMABLE_RESTRICT) THEN + ASM_CASES_TAC `summable k (a:num->real^N)` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THENL + [MATCH_MP_TAC INFSUM_UNIQUE THEN + ASM_REWRITE_TAC[SERIES_RESTRICT; SUMS_INFSUM]; + RULE_ASSUM_TAC(REWRITE_RULE[summable; NOT_EXISTS_THM]) THEN + ASM_REWRITE_TAC[infsum]]);; + +let PARTIAL_SUMS_COMPONENT_LE_INFSUM = prove + (`!f:num->real^N s k n. + 1 <= k /\ k <= dimindex(:N) /\ + (!i. i IN s ==> &0 <= (f i)$k) /\ + summable s f + ==> (vsum (s INTER (0..n)) f)$k <= (infsum s f)$k`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM SUMS_INFSUM] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[sums; LIM_SEQUENTIALLY] THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `vsum (s INTER (0..n)) (f:num->real^N)$k - (infsum s f)$k`) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N + n:num`)) THEN + REWRITE_TAC[LE_ADD; REAL_NOT_LT; dist] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((vsum (s INTER (0..N + n)) f - infsum s f:real^N)$k)` THEN + ASM_SIMP_TAC[COMPONENT_LE_NORM] THEN REWRITE_TAC[VECTOR_SUB_COMPONENT] THEN + MATCH_MP_TAC(REAL_ARITH `s < a /\ a <= b ==> a - s <= abs(b - s)`) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + SIMP_TAC[NUMSEG_ADD_SPLIT; LE_0; UNION_OVER_INTER] THEN + W(MP_TAC o PART_MATCH (lhs o rand) VSUM_UNION o lhand o rand o snd) THEN + ANTS_TAC THENL + [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG; DISJOINT; EXTENSION] THEN + REWRITE_TAC[IN_INTER; NOT_IN_EMPTY; IN_NUMSEG] THEN ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_LE_ADDR; VECTOR_ADD_COMPONENT] THEN + ASM_SIMP_TAC[VSUM_COMPONENT] THEN MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[FINITE_INTER; IN_INTER; FINITE_NUMSEG]]);; + +let PARTIAL_SUMS_DROP_LE_INFSUM = prove + (`!f s n. + (!i. i IN s ==> &0 <= drop(f i)) /\ + summable s f + ==> drop(vsum (s INTER (0..n)) f) <= drop(infsum s f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[drop] THEN + MATCH_MP_TAC PARTIAL_SUMS_COMPONENT_LE_INFSUM THEN + ASM_REWRITE_TAC[DIMINDEX_1; LE_REFL; GSYM drop]);; + +(* ------------------------------------------------------------------------- *) +(* Cauchy criterion for series. *) +(* ------------------------------------------------------------------------- *) + +let SEQUENCE_CAUCHY_WLOG = prove + (`!P s. (!m n:num. P m /\ P n ==> dist(s m,s n) < e) <=> + (!m n. P m /\ P n /\ m <= n ==> dist(s m,s n) < e)`, + MESON_TAC[DIST_SYM; LE_CASES]);; + +let VSUM_DIFF_LEMMA = prove + (`!f:num->real^N k m n. + m <= n + ==> vsum(k INTER (0..n)) f - vsum(k INTER (0..m)) f = + vsum(k INTER (m+1..n)) f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `k INTER (0..n)`; `k INTER (0..m)`] + VSUM_DIFF) THEN + ANTS_TAC THENL + [SIMP_TAC[FINITE_INTER; FINITE_NUMSEG] THEN MATCH_MP_TAC + (SET_RULE `s SUBSET t ==> (u INTER s SUBSET u INTER t)`) THEN + REWRITE_TAC[SUBSET; IN_NUMSEG] THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `(k INTER s) DIFF (k INTER t) = k INTER (s DIFF t)`] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_DIFF; IN_NUMSEG] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC]);; + +let NORM_VSUM_TRIVIAL_LEMMA = prove + (`!e. &0 < e ==> (P ==> norm(vsum(s INTER (m..n)) f) < e <=> + P ==> n < m \/ norm(vsum(s INTER (m..n)) f) < e)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `n:num < m` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o GEN_REWRITE_RULE I [GSYM NUMSEG_EMPTY]) THEN + ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0; INTER_EMPTY]);; + +let SERIES_CAUCHY = prove + (`!f s. (?l. (f sums l) s) = + !e. &0 < e + ==> ?N. !m n. m >= N + ==> norm(vsum(s INTER (m..n)) f) < e`, + REPEAT GEN_TAC THEN REWRITE_TAC[sums; CONVERGENT_EQ_CAUCHY; cauchy] THEN + REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN + REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN + REWRITE_TAC[NOT_LT; ARITH_RULE + `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> + N + 1 <= m + 1 /\ m + 1 <= n`] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL + [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN + SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL + [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN + ASM_ARITH_TAC);; + +let SUMMABLE_CAUCHY = prove + (`!f s. summable s f <=> + !e. &0 < e + ==> ?N. !m n. m >= N ==> norm(vsum(s INTER (m..n)) f) < e`, + REWRITE_TAC[summable; GSYM SERIES_CAUCHY]);; + +let SUMMABLE_IFF_EVENTUALLY = prove + (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) + ==> (summable k f <=> summable k g)`, + REWRITE_TAC[summable; SERIES_CAUCHY] THEN REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `N0:num` STRIP_ASSUME_TAC) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + AP_TERM_TAC THEN EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` + (fun th -> EXISTS_TAC `N0 + N1:num` THEN MP_TAC th)) THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + (ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN ASM_SIMP_TAC[IN_INTER; IN_NUMSEG] THEN + REPEAT STRIP_TAC THENL [ALL_TAC; CONV_TAC SYM_CONV] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC);; + +let SUMMABLE_EQ_EVENTUALLY = prove + (`!f g k. (?N. !n. N <= n /\ n IN k ==> f n = g n) /\ summable k f + ==> summable k g`, + MESON_TAC[SUMMABLE_IFF_EVENTUALLY]);; + +let SUMMABLE_IFF_COFINITE = prove + (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) + ==> (summable s f <=> summable t f)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM SUMMABLE_RESTRICT] THEN + MATCH_MP_TAC SUMMABLE_IFF_EVENTUALLY THEN + FIRST_ASSUM(MP_TAC o ISPEC `\x:num.x` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN REWRITE_TAC[IN_UNIV] THEN + DISCH_TAC THEN EXISTS_TAC `N + 1` THEN + REWRITE_TAC[ARITH_RULE `N + 1 <= n <=> ~(n <= N)`] THEN ASM SET_TAC[]);; + +let SUMMABLE_EQ_COFINITE = prove + (`!f s t. FINITE((s DIFF t) UNION (t DIFF s)) /\ summable s f + ==> summable t f`, + MESON_TAC[SUMMABLE_IFF_COFINITE]);; + +let SUMMABLE_FROM_ELSEWHERE = prove + (`!f m n. summable (from m) f ==> summable (from n) f`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] SUMMABLE_EQ_COFINITE) THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..(m+n)` THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_UNION; IN_DIFF; IN_FROM] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Uniform vesion of Cauchy criterion. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_CAUCHY_UNIFORM = prove + (`!P f:A->num->real^N k. + (?l. !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> dist(vsum(k INTER (0..n)) (f x), + l x) < e) <=> + (!e. &0 < e ==> ?N. !m n x. N <= m /\ P x + ==> norm(vsum(k INTER (m..n)) (f x)) < e)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[sums; UNIFORMLY_CONVERGENT_EQ_CAUCHY; cauchy] THEN + ONCE_REWRITE_TAC[MESON[] + `(!m n:num y. N <= m /\ N <= n /\ P y ==> Q m n y) <=> + (!y. P y ==> !m n. N <= m /\ N <= n ==> Q m n y)`] THEN + REWRITE_TAC[SEQUENCE_CAUCHY_WLOG] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + SIMP_TAC[dist; VSUM_DIFF_LEMMA; NORM_VSUM_TRIVIAL_LEMMA] THEN + REWRITE_TAC[GE; TAUT `a ==> b \/ c <=> a /\ ~b ==> c`] THEN + REWRITE_TAC[NOT_LT; ARITH_RULE + `(N <= m /\ N <= n /\ m <= n) /\ m + 1 <= n <=> + N + 1 <= m + 1 /\ m + 1 <= n`] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `e:real` THEN + ASM_CASES_TAC `&0 < e` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THENL + [EXISTS_TAC `N + 1`; EXISTS_TAC `N:num`] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `N + 1 <= m + 1 ==> N <= m + 1`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`m - 1`; `n:num`]) THEN + SUBGOAL_THEN `m - 1 + 1 = m` SUBST_ALL_TAC THENL + [ALL_TAC; ANTS_TAC THEN SIMP_TAC[]] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* So trivially, terms of a convergent series go to zero. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_GOESTOZERO = prove + (`!s x. summable s x + ==> !e. &0 < e + ==> eventually (\n. n IN s ==> norm(x n) < e) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[summable; SERIES_CAUCHY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN DISCH_TAC THEN + X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `n:num`]) THEN + ASM_SIMP_TAC[NUMSEG_SING; GE; SET_RULE `n IN s ==> s INTER {n} = {n}`] THEN + REWRITE_TAC[VSUM_SING]);; + +let SUMMABLE_IMP_TOZERO = prove + (`!f:num->real^N k. + summable k f + ==> ((\n. if n IN k then f(n) else vec 0) --> vec 0) sequentially`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM SUMMABLE_RESTRICT] THEN + REWRITE_TAC[summable; LIM_SEQUENTIALLY; INTER_UNIV; sums] THEN + DISCH_THEN(X_CHOOSE_TAC `l:real^N`) THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `N:num` THEN DISCH_TAC THEN EXISTS_TAC `N + 1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `n - 1` th) THEN MP_TAC(SPEC `n:num` th)) THEN + ASM_SIMP_TAC[ARITH_RULE `N + 1 <= n ==> N <= n /\ N <= n - 1`] THEN + ABBREV_TAC `m = n - 1` THEN + SUBGOAL_THEN `n = SUC m` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0] THEN + REWRITE_TAC[NORM_ARITH `dist(x,vec 0) = norm x`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0] THEN CONV_TAC NORM_ARITH);; + +let SUMMABLE_IMP_BOUNDED = prove + (`!f:num->real^N k. summable k f ==> bounded (IMAGE f k)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP SUMMABLE_IMP_TOZERO) THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[REAL_LT_IMP_LE; NORM_0]);; + +let SUMMABLE_IMP_SUMS_BOUNDED = prove + (`!f:num->real^N k. + summable (from k) f ==> bounded { vsum(k..n) f | n IN (:num) }`, + REWRITE_TAC[summable; sums; LEFT_IMP_EXISTS_THM] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[FROM_INTER_NUMSEG; SIMPLE_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Comparison test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_COMPARISON = prove + (`!f g s. (?l. ((lift o g) sums l) s) /\ + (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) + ==> ?l:real^N. (f sums l) s`, + REPEAT GEN_TAC THEN REWRITE_TAC[SERIES_CAUCHY] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL + [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num /\ m <= x ==> x >= N1`]; + ASM_MESON_TAC[ARITH_RULE `m >= N1 + N2:num ==> m >= N2`]]);; + +let SUMMABLE_COMPARISON = prove + (`!f g s. summable s (lift o g) /\ + (?N. !n. n >= N /\ n IN s ==> norm(f n) <= g n) + ==> summable s f`, + REWRITE_TAC[summable; SERIES_COMPARISON]);; + +let SERIES_LIFT_ABSCONV_IMP_CONV = prove + (`!x:num->real^N k. summable k (\n. lift(norm(x n))) ==> summable k x`, + REWRITE_TAC[summable] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\n:num. norm(x n:real^N)` THEN + ASM_REWRITE_TAC[o_DEF; REAL_LE_REFL] THEN ASM_MESON_TAC[]);; + +let SUMMABLE_SUBSET_ABSCONV = prove + (`!x:num->real^N s t. + summable s (\n. lift(norm(x n))) /\ t SUBSET s + ==> summable t (\n. lift(norm(x n)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_SUBSET THEN + EXISTS_TAC `s:num->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[summable] THEN MATCH_MP_TAC SERIES_COMPARISON THEN + EXISTS_TAC `\n:num. norm(x n:real^N)` THEN + ASM_REWRITE_TAC[o_DEF; GSYM summable] THEN + EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_LE_REFL; NORM_LIFT; REAL_ABS_NORM; NORM_0; NORM_POS_LE]);; + +let SERIES_COMPARISON_BOUND = prove + (`!f:num->real^N g s a. + (g sums a) s /\ (!i. i IN s ==> norm(f i) <= drop(g i)) + ==> ?l. (f sums l) s /\ norm(l) <= drop a`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] + SUMMABLE_COMPARISON) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; GE; ETA_AX; summable] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + X_GEN_TAC `l:real^N` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[FROM_0; INTER_UNIV; sums]) THEN + MATCH_MP_TAC SERIES_BOUND THEN MAP_EVERY EXISTS_TAC + [`f:num->real^N`; `drop o (g:num->real^1)`; `s:num->bool`] THEN + ASM_REWRITE_TAC[sums; o_DEF; LIFT_DROP; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Uniform version of comparison test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_COMPARISON_UNIFORM = prove + (`!f g P s. (?l. ((lift o g) sums l) s) /\ + (?N. !n x. N <= n /\ n IN s /\ P x ==> norm(f x n) <= g n) + ==> ?l:A->real^N. + !e. &0 < e + ==> ?N. !n x. N <= n /\ P x + ==> dist(vsum(s INTER (0..n)) (f x), + l x) < e`, + REPEAT GEN_TAC THEN SIMP_TAC[GE; SERIES_CAUCHY; SERIES_CAUCHY_UNIFORM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC (X_CHOOSE_TAC `N1:num`)) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N1 + N2:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `norm (vsum (s INTER (m .. n)) (lift o g))` THEN CONJ_TAC THENL + [SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER_NUMSEG; NORM_LIFT] THEN + MATCH_MP_TAC(REAL_ARITH `x <= a ==> x <= abs(a)`) THEN + MATCH_MP_TAC VSUM_NORM_LE THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; IN_INTER; IN_NUMSEG] THEN + ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m /\ m <= x ==> N1 <= x`]; + ASM_MESON_TAC[ARITH_RULE `N1 + N2:num <= m ==> N2 <= m`]]);; + +(* ------------------------------------------------------------------------- *) +(* Ratio test. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_RATIO = prove + (`!c a s N. + c < &1 /\ + (!n. n >= N ==> norm(a(SUC n)) <= c * norm(a(n))) + ==> ?l:real^N. (a sums l) s`, + REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SERIES_COMPARISON THEN + DISJ_CASES_TAC(REAL_ARITH `c <= &0 \/ &0 < c`) THENL + [EXISTS_TAC `\n:num. &0` THEN REWRITE_TAC[o_DEF; LIFT_NUM] THEN + CONJ_TAC THENL [MESON_TAC[SERIES_0]; ALL_TAC] THEN + EXISTS_TAC `N + 1` THEN REWRITE_TAC[GE] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * norm(a(n - 1):real^N)` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `N + 1 <= n ==> SUC(n - 1) = n /\ N <= n - 1`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --c * x ==> c * x <= &0`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE] THEN + UNDISCH_TAC `c <= &0` THEN REAL_ARITH_TAC; + ASSUME_TAC(MATCH_MP REAL_LT_IMP_LE (ASSUME `&0 < c`))] THEN + EXISTS_TAC `\n. norm(a(N):real^N) * c pow (n - N)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + EXISTS_TAC `N:num` THEN + SIMP_TAC[GE; LE_EXISTS; IMP_CONJ; ADD_SUB2; LEFT_IMP_EXISTS_THM] THEN + SUBGOAL_THEN `!d:num. norm(a(N + d):real^N) <= norm(a N) * c pow d` + (fun th -> MESON_TAC[th]) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_RID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `c * norm((a:num->real^N) (N + d))` THEN + ASM_SIMP_TAC[LE_ADD] THEN ASM_MESON_TAC[REAL_LE_LMUL; REAL_MUL_AC]] THEN + GEN_REWRITE_TAC I [SERIES_CAUCHY] THEN X_GEN_TAC `e:real` THEN + SIMP_TAC[GSYM LIFT_SUM; FINITE_INTER; NORM_LIFT; FINITE_NUMSEG] THEN + DISCH_TAC THEN SIMP_TAC[SUM_LMUL; FINITE_INTER; FINITE_NUMSEG] THEN + ASM_CASES_TAC `(a:num->real^N) N = vec 0` THENL + [ASM_REWRITE_TAC[NORM_0; REAL_MUL_LZERO; REAL_ABS_NUM]; ALL_TAC] THEN + MP_TAC(SPECL [`c:real`; `((&1 - c) * e) / norm((a:num->real^N) N)`] + REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_SUB_LT; NORM_POS_LT; GE] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `N + M:num` THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(norm((a:num->real^N) N) * + sum(m..n) (\i. c pow (i - N)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= abs y`) THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_INTER_NUMSEG; REAL_POW_LE] THEN + MATCH_MP_TAC SUM_SUBSET THEN ASM_SIMP_TAC[REAL_POW_LE] THEN + REWRITE_TAC[FINITE_INTER_NUMSEG; FINITE_NUMSEG] THEN + REWRITE_TAC[IN_INTER; IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NORM] THEN + DISJ_CASES_TAC(ARITH_RULE `n:num < m \/ m <= n`) THENL + [ASM_SIMP_TAC[SUM_TRIV_NUMSEG; REAL_ABS_NUM; REAL_MUL_RZERO]; ALL_TAC] THEN + SUBGOAL_THEN `m = 0 + m /\ n = (n - m) + m` (CONJUNCTS_THEN SUBST1_TAC) THENL + [UNDISCH_TAC `m:num <= n` THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_OFFSET] THEN UNDISCH_TAC `N + M:num <= m` THEN + SIMP_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `(i + (N + M) + d) - N:num = (M + d) + i`] THEN + ONCE_REWRITE_TAC[REAL_POW_ADD] THEN REWRITE_TAC[SUM_LMUL; SUM_GP] THEN + ASM_SIMP_TAC[LT; REAL_LT_IMP_NE] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; NORM_POS_LT; REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_POW] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ; REAL_ABS_DIV; REAL_POW_LT; REAL_ARITH + `&0 < c /\ c < &1 ==> &0 < abs c /\ &0 < abs(&1 - c)`; REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < x /\ x <= &1 /\ &1 <= e ==> abs(c pow 0 - x) < e`) THEN + ASM_SIMP_TAC[REAL_POW_LT; REAL_POW_1_LE; REAL_LT_IMP_LE] THEN + ASM_SIMP_TAC[REAL_ARITH `c < &1 ==> x * abs(&1 - c) = (&1 - c) * x`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH + `(((a * b) * c) * d) * e = (e * ((a * b) * c)) * d`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_POW_LT; REAL_MUL_LID; + REAL_ARITH `&0 < c ==> abs c = c`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `xm < e ==> &0 <= (d - &1) * e ==> xm <= d * e`)) THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_LE; GSYM REAL_POW_INV] THEN + MATCH_MP_TAC REAL_POW_LE_1 THEN + MATCH_MP_TAC REAL_INV_1_LE THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_LT_DIV; NORM_POS_LT]]);; + +(* ------------------------------------------------------------------------- *) +(* Ostensibly weaker versions of the boundedness of partial sums. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDED_PARTIAL_SUMS = prove + (`!f:num->real^N k. + bounded { vsum(k..n) f | n IN (:num) } + ==> bounded { vsum(m..n) f | m IN (:num) /\ n IN (:num) }`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `bounded { vsum(0..n) f:real^N | n IN (:num) }` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + REWRITE_TAC[bounded] THEN + REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `sum { i:num | i < k} (\i. norm(f i:real^N)) + B` THEN + X_GEN_TAC `i:num` THEN ASM_CASES_TAC `i:num < k` THENL + [MATCH_MP_TAC(REAL_ARITH + `!y. x <= y /\ y <= a /\ &0 < b ==> x <= a + b`) THEN + EXISTS_TAC `sum (0..i) (\i. norm(f i:real^N))` THEN + ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_SUBSET THEN + REWRITE_TAC[FINITE_NUMSEG; FINITE_NUMSEG_LT; NORM_POS_LE] THEN + REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_ELIM_THM] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `k = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN MATCH_MP_TAC(REAL_ARITH + `x <= B /\ &0 <= b ==> x <= b + B`) THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG_LT; NORM_POS_LE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:num->real^N`; `0`; `k:num`; `i:num`] + VSUM_COMBINE_L) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[NUMSEG_LT] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(x) <= a /\ norm(y) <= b ==> norm(x + y) <= a + b`) THEN + ASM_SIMP_TAC[VSUM_NORM; FINITE_NUMSEG]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP BOUNDED_DIFFS (W CONJ th)) THEN MP_TAC th) THEN + REWRITE_TAC[IMP_IMP; GSYM BOUNDED_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[TAUT `a /\ b ==> c <=> b ==> a ==> c`] + BOUNDED_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; LEFT_IMP_EXISTS_THM; IN_UNIV] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `m:num`; `n:num`] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_CASES_TAC `m = 0` THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `n:num < m` THENL + [DISJ2_TAC THEN REPEAT(EXISTS_TAC `vsum(0..0) (f:num->real^N)`) THEN + ASM_SIMP_TAC[VSUM_TRIV_NUMSEG; VECTOR_SUB_REFL] THEN MESON_TAC[]; + ALL_TAC] THEN + DISJ2_TAC THEN MAP_EVERY EXISTS_TAC + [`vsum(0..n) (f:num->real^N)`; `vsum(0..(m-1)) (f:num->real^N)`] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:num->real^N`; `0`; `m:num`; `n:num`] + VSUM_COMBINE_L) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; VECTOR_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* General Dirichlet convergence test (could make this uniform on a set). *) +(* ------------------------------------------------------------------------- *) + +let SUMMABLE_BILINEAR_PARTIAL_PRE = prove + (`!f g h:real^M->real^N->real^P l k. + bilinear h /\ + ((\n. h (f(n + 1)) (g(n))) --> l) sequentially /\ + summable (from k) (\n. h (f(n + 1) - f(n)) (g(n))) + ==> summable (from k) (\n. h (f n) (g(n) - g(n - 1)))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + FIRST_ASSUM(fun th -> + REWRITE_TAC[MATCH_MP BILINEAR_VSUM_PARTIAL_PRE th]) THEN + DISCH_THEN(X_CHOOSE_TAC `l':real^P`) THEN + EXISTS_TAC `l - (h:real^M->real^N->real^P) (f k) (g(k - 1)) - l'` THEN + REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN + REPEAT(MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]));; + +let SERIES_DIRICHLET_BILINEAR = prove + (`!f g h:real^M->real^N->real^P k m p l. + bilinear h /\ + bounded { vsum (m..n) f | n IN (:num)} /\ + summable (from p) (\n. lift(norm(g(n + 1) - g(n)))) /\ + ((\n. h (g(n + 1)) (vsum(1..n) f)) --> l) sequentially + ==> summable (from k) (\n. h (g n) (f n))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN + EXISTS_TAC `1` THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[MESON[] `(!x a b. x = f a b ==> p a b) <=> (!a b. p a b)`] THEN + X_GEN_TAC `B:real` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP BILINEAR_BOUNDED_POS) THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC SUMMABLE_EQ THEN + EXISTS_TAC `\n. (h:real^M->real^N->real^P) + (g n) (vsum (1..n) f - vsum (1..n-1) f)` THEN + SIMP_TAC[IN_FROM; GSYM NUMSEG_RREC] THEN + SIMP_TAC[VSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; + ARITH_RULE `1 <= n ==> ~(n <= n - 1)`] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[BILINEAR_RADD; BILINEAR_RSUB] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SUMMABLE_FROM_ELSEWHERE THEN EXISTS_TAC `p:num` THEN + MP_TAC(ISPECL [`g:num->real^M`; `\n. vsum(1..n) f:real^N`; + `h:real^M->real^N->real^P`; `l:real^P`; `p:num`] + SUMMABLE_BILINEAR_PARTIAL_PRE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `summable (from p) (lift o (\n. C * B * norm(g(n + 1) - g(n):real^M)))` + MP_TAC THENL [ASM_SIMP_TAC[o_DEF; LIFT_CMUL; SUMMABLE_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] SUMMABLE_COMPARISON) THEN + EXISTS_TAC `0` THEN REWRITE_TAC[IN_FROM; GE; LE_0] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `C * norm(g(n + 1) - g(n):real^M) * norm(vsum (1..n) f:real^N)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_LMUL; NORM_POS_LE]);; + +let SERIES_DIRICHLET = prove + (`!f:num->real^N g N k m. + bounded { vsum (m..n) f | n IN (:num)} /\ + (!n. N <= n ==> g(n + 1) <= g(n)) /\ + ((lift o g) --> vec 0) sequentially + ==> summable (from k) (\n. g(n) % f(n))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real^N`; `lift o (g:num->real)`; + `\x y:real^N. drop x % y`] SERIES_DIRICHLET_BILINEAR) THEN + REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`m:num`; `N:num`; `vec 0:real^N`] THEN CONJ_TAC THENL + [REWRITE_TAC[bilinear; linear; DROP_ADD; DROP_CMUL] THEN + REPEAT STRIP_TAC THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM LIFT_SUB; NORM_LIFT] THEN + FIRST_ASSUM(MP_TAC o SPEC `1` o MATCH_MP SEQ_OFFSET) THEN + REWRITE_TAC[o_THM] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SUMMABLE_EQ_EVENTUALLY THEN + EXISTS_TAC `\n. lift(g(n) - g(n + 1))` THEN REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `b <= a ==> abs(b - a) = a - b`]; + REWRITE_TAC[summable; sums; FROM_INTER_NUMSEG; VSUM_DIFFS; LIFT_SUB] THEN + REWRITE_TAC[LIM_CASES_SEQUENTIALLY] THEN + EXISTS_TAC `lift(g(N:num)) - vec 0` THEN + MATCH_MP_TAC LIM_SUB THEN ASM_REWRITE_TAC[LIM_CONST]]; + MATCH_MP_TAC LIM_NULL_VMUL_BOUNDED THEN ASM_REWRITE_TAC[o_DEF] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP BOUNDED_PARTIAL_SUMS) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [BOUNDED_POS]) THEN + SIMP_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Rearranging absolutely convergent series. *) +(* ------------------------------------------------------------------------- *) + +let SERIES_INJECTIVE_IMAGE_STRONG = prove + (`!x:num->real^N s f. + summable (IMAGE f s) (\n. lift(norm(x n))) /\ + (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) + ==> ((\n. vsum (IMAGE f s INTER (0..n)) x - + vsum (s INTER (0..n)) (x o f)) --> vec 0) + sequentially`, + let lemma = prove + (`!f:A->real^N s t. + FINITE s /\ FINITE t + ==> vsum s f - vsum t f = vsum (s DIFF t) f - vsum (t DIFF s) f`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN + ASM_SIMP_TAC[VSUM_DIFF; INTER_SUBSET] THEN + REWRITE_TAC[INTER_COMM] THEN VECTOR_ARITH_TAC) in + REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUMMABLE_CAUCHY]) THEN + SIMP_TAC[VSUM_REAL; FINITE_INTER; FINITE_NUMSEG] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [o_DEF] THEN + REWRITE_TAC[NORM_LIFT; LIFT_DROP] THEN + SIMP_TAC[real_abs; SUM_POS_LE; NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[dist; GE; VECTOR_SUB_RZERO; REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `g:num->num`) THEN + MP_TAC(ISPECL [`g:num->num`; `0..N`] UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + DISCH_THEN(X_CHOOSE_TAC `P:num`) THEN + EXISTS_TAC `MAX N P` THEN X_GEN_TAC `n:num` THEN + SIMP_TAC[ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`] THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) VSUM_IMAGE o rand o + rand o lhand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[FINITE_INTER; FINITE_NUMSEG; IN_INTER]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + W(MP_TAC o PART_MATCH (lhand o rand) lemma o rand o lhand o snd) THEN + SIMP_TAC[FINITE_INTER; FINITE_IMAGE; FINITE_NUMSEG] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC(NORM_ARITH + `norm a < e / &2 /\ norm b < e / &2 ==> norm(a - b:real^N) < e`) THEN + CONJ_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) VSUM_NORM o lhand o snd) THEN + SIMP_TAC[FINITE_DIFF; FINITE_IMAGE; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LET_TRANS) THEN + MATCH_MP_TAC REAL_LET_TRANS THENL + [EXISTS_TAC + `sum(IMAGE (f:num->num) s INTER (N..n)) (\i. norm(x i :real^N))` THEN + ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s /\ f(x) IN n /\ ~(x IN m) ==> f x IN t) + ==> (IMAGE f s INTER n) DIFF (IMAGE f (s INTER m)) SUBSET + IMAGE f s INTER t`) THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_0; NOT_LE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[GSYM NOT_LE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE BINDER_CONV + [GSYM CONTRAPOS_THM]) THEN + ASM_SIMP_TAC[] THEN ASM_ARITH_TAC; + MP_TAC(ISPECL [`f:num->num`; `0..n`] UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG; LE_0] THEN + DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN + EXISTS_TAC + `sum(IMAGE (f:num->num) s INTER (N..p)) (\i. norm(x i :real^N))` THEN + ASM_SIMP_TAC[LE_REFL] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[NORM_POS_LE; FINITE_INTER; FINITE_NUMSEG] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN s /\ x IN n /\ ~(f x IN m) ==> f x IN t) + ==> (IMAGE f (s INTER n) DIFF (IMAGE f s) INTER m) SUBSET + (IMAGE f s INTER t)`) THEN + ASM_SIMP_TAC[IN_NUMSEG; LE_0] THEN ASM_ARITH_TAC]);; + +let SERIES_INJECTIVE_IMAGE = prove + (`!x:num->real^N s f l. + summable (IMAGE f s) (\n. lift(norm(x n))) /\ + (!m n. m IN s /\ n IN s /\ f m = f n ==> m = n) + ==> (((x o f) sums l) s <=> (x sums l) (IMAGE f s))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[sums] THEN + MATCH_MP_TAC LIM_TRANSFORM_EQ THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SERIES_INJECTIVE_IMAGE_STRONG THEN + ASM_REWRITE_TAC[]);; + +let SERIES_REARRANGE_EQ = prove + (`!x:num->real^N s p l. + summable s (\n. lift(norm(x n))) /\ p permutes s + ==> (((x o p) sums l) s <=> (x sums l) s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`x:num->real^N`; `s:num->bool`; `p:num->num`; `l:real^N`] + SERIES_INJECTIVE_IMAGE) THEN + ASM_SIMP_TAC[PERMUTES_IMAGE] THEN + ASM_MESON_TAC[PERMUTES_INJECTIVE]);; + +let SERIES_REARRANGE = prove + (`!x:num->real^N s p l. + summable s (\n. lift(norm(x n))) /\ p permutes s /\ (x sums l) s + ==> ((x o p) sums l) s`, + MESON_TAC[SERIES_REARRANGE_EQ]);; + +let SUMMABLE_REARRANGE = prove + (`!x s p. + summable s (\n. lift(norm(x n))) /\ p permutes s + ==> summable s (x o p)`, + MESON_TAC[SERIES_LIFT_ABSCONV_IMP_CONV; summable; SERIES_REARRANGE]);; + +(* ------------------------------------------------------------------------- *) +(* Banach fixed point theorem (not really topological...) *) +(* ------------------------------------------------------------------------- *) + +let BANACH_FIX = prove + (`!f s c. complete s /\ ~(s = {}) /\ + &0 <= c /\ c < &1 /\ + (IMAGE f s) SUBSET s /\ + (!x y. x IN s /\ y IN s ==> dist(f(x),f(y)) <= c * dist(x,y)) + ==> ?!x:real^N. x IN s /\ (f x = x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL + [ALL_TAC; + MAP_EVERY X_GEN_TAC [`x:real^N`; `y:real^N`] THEN STRIP_TAC THEN + SUBGOAL_THEN `dist((f:real^N->real^N) x,f y) <= c * dist(x,y)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ARITH `a <= c * a <=> &0 <= --a * (&1 - c)`] THEN + ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ; REAL_SUB_LT; real_div] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ARITH `&0 <= --x <=> ~(&0 < x)`] THEN + MESON_TAC[DIST_POS_LT]] THEN + STRIP_ASSUME_TAC(prove_recursive_functions_exist num_RECURSION + `(z 0 = @x:real^N. x IN s) /\ (!n. z(SUC n) = f(z n))`) THEN + SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; SUBSET; IN_IMAGE]; + ALL_TAC] THEN + UNDISCH_THEN `z 0 = @x:real^N. x IN s` (K ALL_TAC) THEN + SUBGOAL_THEN `?x:real^N. x IN s /\ (z --> x) sequentially` MP_TAC THENL + [ALL_TAC; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `e = dist(f(a:real^N),a)` THEN + SUBGOAL_THEN `~(&0 < e)` (fun th -> ASM_MESON_TAC[th; DIST_POS_LT]) THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + SUBGOAL_THEN + `dist(f(z N),a:real^N) < e / &2 /\ dist(f(z(N:num)),f(a)) < e / &2` + (fun th -> ASM_MESON_TAC[th; DIST_TRIANGLE_HALF_R; REAL_LT_REFL]) THEN + CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `N <= SUC N`]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `c * dist((z:num->real^N) N,a)` THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x < y /\ c * x <= &1 * x ==> c * x < y`) THEN + ASM_SIMP_TAC[LE_REFL; REAL_LE_RMUL; DIST_POS_LE; REAL_LT_IMP_LE]] THEN + FIRST_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [complete]) THEN + ASM_REWRITE_TAC[CAUCHY] THEN + SUBGOAL_THEN `!n. dist(z(n):real^N,z(SUC n)) <= c pow n * dist(z(0),z(1))` + ASSUME_TAC THENL + [INDUCT_TAC THEN + REWRITE_TAC[real_pow; ARITH; REAL_MUL_LID; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `c * dist(z(n):real^N,z(SUC n))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_LE_LMUL]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n:num. (&1 - c) * dist(z(m):real^N,z(m+n)) + <= c pow m * dist(z(0),z(1)) * (&1 - c pow n)` + ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_SUB_LE; + REAL_POW_1_LE; REAL_LT_IMP_LE]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `(&1 - c) * (dist(z m:real^N,z(m + n)) + dist(z(m + n),z(m + SUC n)))` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_SUB_LE; REAL_LT_IMP_LE; DIST_TRIANGLE] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `c * x <= y ==> c * x' + y <= y' ==> c * (x + x') <= y'`)) THEN + REWRITE_TAC[REAL_ARITH + `q + a * b * (&1 - x) <= a * b * (&1 - y) <=> q <= a * b * (x - y)`] THEN + REWRITE_TAC[ADD_CLAUSES; real_pow] THEN + REWRITE_TAC[REAL_ARITH `a * b * (d - c * d) = (&1 - c) * a * d * b`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_SUB_LE; REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM REAL_POW_ADD; REAL_MUL_ASSOC] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `(z:num->real^N) 0 = z 1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN EXISTS_TAC `0` THEN + REWRITE_TAC[GE; LE_0] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `n:num`]) THEN + REWRITE_TAC[ADD_CLAUSES; DIST_REFL; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + ASM_CASES_TAC `(z:num->real^N) 0 = z n` THEN + ASM_REWRITE_TAC[DIST_REFL; REAL_NOT_LE] THEN + ASM_SIMP_TAC[REAL_LT_MUL; DIST_POS_LT; REAL_SUB_LT]; + ALL_TAC] THEN + MP_TAC(SPECL [`c:real`; `e * (&1 - c) / dist((z:num->real^N) 0,z 1)`] + REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_LT_DIV; REAL_SUB_LT; DIST_POS_LT] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[real_div; GE; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ; GSYM real_div; DIST_POS_LT] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; REAL_SUB_LT] THEN DISCH_TAC THEN + REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN X_GEN_TAC `d:num` THEN DISCH_THEN SUBST_ALL_TAC THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP(REAL_ARITH + `d < e ==> x <= d ==> x < e`)) THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_SUB_LT] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`N:num`; `d:num`]) THEN + MATCH_MP_TAC(REAL_ARITH + `(c * d) * e <= (c * d) * &1 ==> x * y <= c * d * e ==> y * x <= c * d`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; DIST_POS_LE; REAL_ARITH + `&0 <= x ==> &1 - x <= &1`]);; + +(* ------------------------------------------------------------------------- *) +(* Edelstein fixed point theorem. *) +(* ------------------------------------------------------------------------- *) + +let EDELSTEIN_FIX = prove + (`!f s. compact s /\ ~(s = {}) /\ (IMAGE f s) SUBSET s /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> dist(f(x),f(y)) < dist(x,y)) + ==> ?!x:real^N. x IN s /\ f x = x`, + MAP_EVERY X_GEN_TAC [`g:real^N->real^N`; `s:real^N->bool`] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[REAL_LT_REFL]] THEN + SUBGOAL_THEN + `!x y. x IN s /\ y IN s ==> dist((g:real^N->real^N)(x),g(y)) <= dist(x,y)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN ASM_CASES_TAC `x:real^N = y` THEN + ASM_SIMP_TAC[DIST_REFL; REAL_LE_LT]; + ALL_TAC] THEN + ASM_CASES_TAC `?x:real^N. x IN s /\ ~(g x = x)` THENL + [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `y = (g:real^N->real^N) x` THEN + SUBGOAL_THEN `(y:real^N) IN s` ASSUME_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP COMPACT_PCROSS o W CONJ) THEN + REWRITE_TAC[compact; PCROSS] THEN + (STRIP_ASSUME_TAC o prove_general_recursive_function_exists) + `?f:num->real^N->real^N. + (!z. f 0 z = z) /\ (!z n. f (SUC n) z = g(f n z))` THEN + SUBGOAL_THEN `!n z. z IN s ==> (f:num->real^N->real^N) n z IN s` + STRIP_ASSUME_TAC THENL [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!m n w z. m <= n /\ w IN s /\ z IN s + ==> dist((f:num->real^N->real^N) n w,f n z) <= dist(f m w,f m z)` + ASSUME_TAC THENL + [REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + ASM_SIMP_TAC[REAL_LE_REFL] THEN MESON_TAC[REAL_LE_TRANS]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC + `\n:num. pastecart (f n (x:real^N)) (f n y:real^N)`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`l:real^(N,N)finite_sum`; `s:num->num`] THEN + REWRITE_TAC[o_DEF; IN_ELIM_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:real^N`; `b:real^N`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `(\x:real^(N,N)finite_sum. fstcart x) continuous_on UNIV /\ + (\x:real^(N,N)finite_sum. sndcart x) continuous_on UNIV` + MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; LINEAR_FSTCART; LINEAR_SNDCART]; + ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN(fun th -> FIRST_ASSUM(MP_TAC o MATCH_MP th))) THEN + REWRITE_TAC[o_DEF; FSTCART_PASTECART; SNDCART_PASTECART; IMP_IMP] THEN + ONCE_REWRITE_TAC[CONJ_SYM] THEN + DISCH_THEN(fun th -> CONJUNCTS_THEN2 (LABEL_TAC "A") (LABEL_TAC "B") th THEN + MP_TAC(MATCH_MP LIM_SUB th)) THEN + REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "AB") THEN + SUBGOAL_THEN + `!n. dist(a:real^N,b) <= dist((f:num->real^N->real^N) n x,f n y)` + STRIP_ASSUME_TAC THENL + [X_GEN_TAC `N:num` THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN DISCH_TAC THEN + USE_THEN "AB" (MP_TAC o REWRITE_RULE[LIM_SEQUENTIALLY]) THEN + DISCH_THEN(fun th -> FIRST_X_ASSUM(MP_TAC o MATCH_MP th)) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `M:num` THEN + DISCH_THEN(MP_TAC o SPEC `M + N:num`) THEN REWRITE_TAC[LE_ADD] THEN + MATCH_MP_TAC(NORM_ARITH + `dist(fx,fy) <= dist(x,y) + ==> ~(dist(fx - fy,a - b) < dist(a,b) - dist(x,y))`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M + N:num` o MATCH_MP MONOTONE_BIGGER) THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `b:real^N = a` SUBST_ALL_TAC THENL + [MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + ABBREV_TAC `e = dist(a,b) - dist((g:real^N->real^N) a,g b)` THEN + SUBGOAL_THEN `&0 < e` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_SUB_LT]; ALL_TAC] THEN + SUBGOAL_THEN + `?n. dist((f:num->real^N->real^N) n x,a) < e / &2 /\ + dist(f n y,b) < e / &2` + STRIP_ASSUME_TAC THENL + [MAP_EVERY (fun s -> USE_THEN s (MP_TAC o SPEC `e / &2` o + REWRITE_RULE[LIM_SEQUENTIALLY])) ["A"; "B"] THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `(s:num->num) (M + N)` THEN + CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `dist(f (SUC n) x,(g:real^N->real^N) a) + + dist((f:num->real^N->real^N) (SUC n) y,g b) < e` + MP_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN + CONJ_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (REAL_ARITH + `dist(x,y) < e + ==> dist(g x,g y) <= dist(x,y) ==> dist(g x,g y) < e`)) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `SUC n` (ASSUME + `!n. dist (a:real^N,b) <= + dist ((f:num->real^N->real^N) n x,f n y)`)) THEN + EXPAND_TAC "e" THEN NORM_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `a:real^N` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n:num. (f:num->real^N->real^N) (SUC(s n)) x` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(g:real^N->real^N) continuous_on s` MP_TAC THENL + [REWRITE_TAC[continuous_on] THEN ASM_MESON_TAC[REAL_LET_TRANS]; + ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY; o_DEF] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[]; + SUBGOAL_THEN `!n. (f:num->real^N->real^N) (SUC n) x = f n y` + (fun th -> ASM_SIMP_TAC[th]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Dini's theorem. *) +(* ------------------------------------------------------------------------- *) + +let DINI = prove + (`!f:num->real^N->real^1 g s. + compact s /\ (!n. (f n) continuous_on s) /\ g continuous_on s /\ + (!x. x IN s ==> ((\n. (f n x)) --> g x) sequentially) /\ + (!n x. x IN s ==> drop(f n x) <= drop(f (n + 1) x)) + ==> !e. &0 < e + ==> eventually (\n. !x. x IN s ==> norm(f n x - g x) < e) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^N m n:num. x IN s /\ m <= n ==> drop(f m x) <= drop(f n x)` + ASSUME_TAC THENL + [GEN_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[ADD1] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num x:real^N. x IN s ==> drop(f n x) <= drop(g x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_DROP_LE) THEN + EXISTS_TAC `\m:num. (f:num->real^N->real^1) n x` THEN + EXISTS_TAC `\m:num. (f:num->real^N->real^1) m x` THEN + ASM_SIMP_TAC[LIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[LIM_SEQUENTIALLY; dist]) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I + [COMPACT_EQ_HEINE_BOREL_SUBTOPOLOGY]) THEN + DISCH_THEN(MP_TAC o SPEC + `IMAGE (\n. { x | x IN s /\ norm((f:num->real^N->real^1) n x - g x) < e}) + (:num)`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE; SUBSET_UNION; UNIONS_IMAGE] THEN + REWRITE_TAC[IN_UNIV; IN_ELIM_THM; EVENTUALLY_SEQUENTIALLY] THEN + SIMP_TAC[SUBSET; IN_UNIV; IN_ELIM_THM] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE_REFL]] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GSYM IN_BALL_0] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN + ASM_SIMP_TAC[OPEN_BALL; CONTINUOUS_ON_SUB; ETA_AX]; + + DISCH_THEN(X_CHOOSE_THEN `k:num->bool` (CONJUNCTS_THEN2 + (MP_TAC o SPEC `\n:num. n` o MATCH_MP UPPER_BOUND_FINITE_SET) + (LABEL_TAC "*"))) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + REWRITE_TAC[] THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REMOVE_THEN "*" (MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + REWRITE_TAC[NORM_REAL; GSYM drop; DROP_SUB] THEN MATCH_MP_TAC(REAL_ARITH + `m <= n /\ n <= g ==> abs(m - g) < e ==> abs(n - g) < e`) THEN + ASM_MESON_TAC[LE_TRANS]]);; + +(* ------------------------------------------------------------------------- *) +(* Closest point of a (closed) set to a point. *) +(* ------------------------------------------------------------------------- *) + +let closest_point = new_definition + `closest_point s a = @x. x IN s /\ !y. y IN s ==> dist(a,x) <= dist(a,y)`;; + +let CLOSEST_POINT_EXISTS = prove + (`!s a. closed s /\ ~(s = {}) + ==> (closest_point s a) IN s /\ + !y. y IN s ==> dist(a,closest_point s a) <= dist(a,y)`, + REWRITE_TAC[closest_point] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN + REWRITE_TAC[DISTANCE_ATTAINS_INF]);; + +let CLOSEST_POINT_IN_SET = prove + (`!s a. closed s /\ ~(s = {}) ==> (closest_point s a) IN s`, + MESON_TAC[CLOSEST_POINT_EXISTS]);; + +let CLOSEST_POINT_LE = prove + (`!s a x. closed s /\ x IN s ==> dist(a,closest_point s a) <= dist(a,x)`, + MESON_TAC[CLOSEST_POINT_EXISTS; MEMBER_NOT_EMPTY]);; + +let CLOSEST_POINT_SELF = prove + (`!s x:real^N. x IN s ==> closest_point s x = x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[closest_point] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN REWRITE_TAC[] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN + ASM_SIMP_TAC[DIST_LE_0; DIST_REFL]; + STRIP_TAC THEN ASM_REWRITE_TAC[DIST_REFL; DIST_POS_LE]]);; + +let CLOSEST_POINT_REFL = prove + (`!s x:real^N. closed s /\ ~(s = {}) ==> (closest_point s x = x <=> x IN s)`, + MESON_TAC[CLOSEST_POINT_IN_SET; CLOSEST_POINT_SELF]);; + +let DIST_CLOSEST_POINT_LIPSCHITZ = prove + (`!s x y:real^N. + closed s /\ ~(s = {}) + ==> abs(dist(x,closest_point s x) - dist(y,closest_point s y)) + <= dist(x,y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CLOSEST_POINT_EXISTS) THEN + DISCH_THEN(fun th -> + CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `closest_point s (y:real^N)`) (SPEC `x:real^N` th) THEN + CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `closest_point s (x:real^N)`) (SPEC `y:real^N` th)) THEN + ASM_REWRITE_TAC[] THEN NORM_ARITH_TAC);; + +let CONTINUOUS_AT_DIST_CLOSEST_POINT = prove + (`!s x:real^N. + closed s /\ ~(s = {}) + ==> (\x. lift(dist(x,closest_point s x))) continuous (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN + ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_DIST_CLOSEST_POINT = prove + (`!s t. closed s /\ ~(s = {}) + ==> (\x. lift(dist(x,closest_point s x))) continuous_on t`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; + CONTINUOUS_AT_DIST_CLOSEST_POINT]);; + +let UNIFORMLY_CONTINUOUS_ON_DIST_CLOSEST_POINT = prove + (`!s t:real^N->bool. + closed s /\ ~(s = {}) + ==> (\x. lift(dist(x,closest_point s x))) uniformly_continuous_on t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN + ASM_MESON_TAC[DIST_CLOSEST_POINT_LIPSCHITZ; REAL_LET_TRANS]);; + +let SEGMENT_TO_CLOSEST_POINT = prove + (`!s a:real^N. + closed s /\ ~(s = {}) + ==> segment(a,closest_point s a) INTER s = {}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SET_RULE `s INTER t = {} <=> !x. x IN s ==> ~(x IN t)`] THEN + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIST_IN_OPEN_SEGMENT) THEN + MATCH_MP_TAC(TAUT `(r ==> ~p) ==> p /\ q ==> ~r`) THEN + ASM_MESON_TAC[CLOSEST_POINT_EXISTS; REAL_NOT_LT; DIST_SYM]);; + +let SEGMENT_TO_POINT_EXISTS = prove + (`!s a:real^N. + closed s /\ ~(s = {}) ==> ?b. b IN s /\ segment(a,b) INTER s = {}`, + MESON_TAC[SEGMENT_TO_CLOSEST_POINT; CLOSEST_POINT_EXISTS]);; + +let CLOSEST_POINT_IN_INTERIOR = prove + (`!s x:real^N. + closed s /\ ~(s = {}) + ==> ((closest_point s x) IN interior s <=> x IN interior s)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `(x:real^N) IN s` THEN + ASM_SIMP_TAC[CLOSEST_POINT_SELF] THEN + MATCH_MP_TAC(TAUT `~q /\ ~p ==> (p <=> q)`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; STRIP_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTERIOR_CBALL]) THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `closest_point s (x:real^N) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[INTERIOR_SUBSET; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `~(closest_point s (x:real^N) = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `x:real^N`; + `closest_point s x - + (min (&1) (e / norm(closest_point s x - x))) % + (closest_point s x - x):real^N`] + CLOSEST_POINT_LE) THEN + ASM_REWRITE_TAC[dist; NOT_IMP; VECTOR_ARITH + `x - (y - e % (y - x)):real^N = (&1 - e) % (x - y)`] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> abs(min (&1) a) <= a`) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_DIV; NORM_POS_LE]; + REWRITE_TAC[NORM_MUL; REAL_ARITH + `~(n <= a * n) <=> &0 < (&1 - a) * n`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[NORM_POS_LT; VECTOR_SUB_EQ] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 < e /\ e <= &1 ==> &0 < &1 - abs(&1 - e)`) THEN + REWRITE_TAC[REAL_MIN_LE; REAL_LT_MIN; REAL_LT_01; REAL_LE_REFL] THEN + ASM_SIMP_TAC[REAL_LT_DIV; NORM_POS_LT; VECTOR_SUB_EQ]]);; + +let CLOSEST_POINT_IN_FRONTIER = prove + (`!s x:real^N. + closed s /\ ~(s = {}) /\ ~(x IN interior s) + ==> (closest_point s x) IN frontier s`, + SIMP_TAC[frontier; IN_DIFF; CLOSEST_POINT_IN_INTERIOR] THEN + SIMP_TAC[CLOSEST_POINT_IN_SET; CLOSURE_CLOSED]);; + +(* ------------------------------------------------------------------------- *) +(* More general infimum of distance between two sets. *) +(* ------------------------------------------------------------------------- *) + +let setdist = new_definition + `setdist(s,t) = + if s = {} \/ t = {} then &0 + else inf {dist(x,y) | x IN s /\ y IN t}`;; + +let SETDIST_EMPTY = prove + (`(!t. setdist({},t) = &0) /\ (!s. setdist(s,{}) = &0)`, + REWRITE_TAC[setdist]);; + +let SETDIST_POS_LE = prove + (`!s t. &0 <= setdist(s,t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_INF THEN + REWRITE_TAC[FORALL_IN_GSPEC; DIST_POS_LE] THEN ASM SET_TAC[]);; + +let REAL_LE_SETDIST = prove + (`!s t:real^N->bool d. + ~(s = {}) /\ ~(t = {}) /\ + (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) + ==> d <= setdist(s,t)`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[setdist] THEN + MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN + ASM_MESON_TAC[]);; + +let SETDIST_LE_DIST = prove + (`!s t x y:real^N. x IN s /\ y IN t ==> setdist(s,t) <= dist(x,y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist] THEN + COND_CASES_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `{dist(x:real^N,y) | x IN s /\ y IN t}` INF) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN ANTS_TAC THENL + [CONJ_TAC THENL [ASM SET_TAC[]; MESON_TAC[DIST_POS_LE]]; ALL_TAC] THEN + ASM_MESON_TAC[]);; + +let REAL_LE_SETDIST_EQ = prove + (`!d s t:real^N->bool. + d <= setdist(s,t) <=> + (!x y. x IN s /\ y IN t ==> d <= dist(x,y)) /\ + (s = {} \/ t = {} ==> d <= &0)`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[REAL_LE_SETDIST; SETDIST_LE_DIST; REAL_LE_TRANS]);; + +let REAL_SETDIST_LT_EXISTS = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ setdist(s,t) < b + ==> ?x y. x IN s /\ y IN t /\ dist(x,y) < b`, + REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SETDIST_EQ] THEN MESON_TAC[]);; + +let SETDIST_REFL = prove + (`!s:real^N->bool. setdist(s,s) = &0`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[setdist; REAL_LE_REFL]; ALL_TAC] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; MEMBER_NOT_EMPTY; DIST_REFL]);; + +let SETDIST_SYM = prove + (`!s t. setdist(s,t) = setdist(t,s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist; DISJ_SYM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + MESON_TAC[DIST_SYM]);; + +let SETDIST_TRIANGLE = prove + (`!s a t:real^N->bool. + setdist(s,t) <= setdist(s,{a}) + setdist({a},t)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_LID; SETDIST_POS_LE] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_ADD_RID; SETDIST_POS_LE] THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_SUB_RADD] THEN + MATCH_MP_TAC REAL_LE_SETDIST THEN + ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; + RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `x - y <= z <=> x - z <= y`] THEN + MATCH_MP_TAC REAL_LE_SETDIST THEN + ASM_REWRITE_TAC[NOT_INSERT_EMPTY; IN_SING; IMP_CONJ; + RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_LE_SUB_RADD] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `dist(x:real^N,y)` THEN + ASM_SIMP_TAC[SETDIST_LE_DIST] THEN CONV_TAC NORM_ARITH);; + +let SETDIST_SINGS = prove + (`!x y. setdist({x},{y}) = dist(x,y)`, + REWRITE_TAC[setdist; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x y | x IN {a} /\ y IN {b}} = {f a b}`] THEN + SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);; + +let SETDIST_LIPSCHITZ = prove + (`!s t x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SETDIST_SINGS] THEN + REWRITE_TAC[REAL_ARITH + `abs(x - y) <= z <=> x <= z + y /\ y <= z + x`] THEN + MESON_TAC[SETDIST_TRIANGLE; SETDIST_SYM]);; + +let CONTINUOUS_AT_LIFT_SETDIST = prove + (`!s x:real^N. (\y. lift(setdist({y},s))) continuous (at x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[continuous_at; DIST_LIFT] THEN + ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; + +let CONTINUOUS_ON_LIFT_SETDIST = prove + (`!s t:real^N->bool. (\y. lift(setdist({y},s))) continuous_on t`, + MESON_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; + CONTINUOUS_AT_LIFT_SETDIST]);; + +let UNIFORMLY_CONTINUOUS_ON_LIFT_SETDIST = prove + (`!s t:real^N->bool. + (\y. lift(setdist({y},s))) uniformly_continuous_on t`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniformly_continuous_on; DIST_LIFT] THEN + ASM_MESON_TAC[SETDIST_LIPSCHITZ; REAL_LET_TRANS]);; + +let SETDIST_DIFFERENCES = prove + (`!s t. setdist(s,t) = setdist({vec 0},{x - y:real^N | x IN s /\ y IN t})`, + REPEAT GEN_TAC THEN REWRITE_TAC[setdist; NOT_INSERT_EMPTY; + SET_RULE `{f x y | x IN s /\ y IN t} = {} <=> s = {} \/ t = {}`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; RIGHT_EXISTS_AND_THM; UNWIND_THM2; DIST_0] THEN + REWRITE_TAC[dist] THEN MESON_TAC[]);; + +let SETDIST_SUBSET_RIGHT = prove + (`!s t u:real^N->bool. + ~(t = {}) /\ t SUBSET u ==> setdist(s,u) <= setdist(s,t)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `u:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; SETDIST_POS_LE; REAL_LE_REFL] THEN + ASM_REWRITE_TAC[setdist] THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; SUBSET] THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + MESON_TAC[DIST_POS_LE]);; + +let SETDIST_SUBSET_LEFT = prove + (`!s t u:real^N->bool. + ~(s = {}) /\ s SUBSET t ==> setdist(t,u) <= setdist(s,u)`, + MESON_TAC[SETDIST_SUBSET_RIGHT; SETDIST_SYM]);; + +let SETDIST_CLOSURE = prove + (`(!s t:real^N->bool. setdist(closure s,t) = setdist(s,t)) /\ + (!s t:real^N->bool. setdist(s,closure t) = setdist(s,t))`, + GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [SETDIST_SYM] THEN + REWRITE_TAC[] THEN + REWRITE_TAC[MESON[REAL_LE_ANTISYM] + `x:real = y <=> !d. d <= x <=> d <= y`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[CLOSURE_EQ_EMPTY; CLOSURE_EMPTY; NOT_IN_EMPTY] THEN + MATCH_MP_TAC(SET_RULE + `s SUBSET c /\ + (!y. Q y /\ (!x. x IN s ==> P x y) ==> (!x. x IN c ==> P x y)) + ==> ((!x y. x IN c /\ Q y ==> P x y) <=> + (!x y. x IN s /\ Q y ==> P x y))`) THEN + REWRITE_TAC[CLOSURE_SUBSET] THEN GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_GE_ON_CLOSURE THEN + ASM_REWRITE_TAC[o_DEF; dist] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_CONST; CONTINUOUS_ON_ID]);; + +let SETDIST_COMPACT_CLOSED = prove + (`!s t:real^N->bool. + compact s /\ closed t /\ ~(s = {}) /\ ~(t = {}) + ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + MATCH_MP_TAC(MESON[] + `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) + ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN + SIMP_TAC[SETDIST_LE_DIST] THEN + ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] + DISTANCE_ATTAINS_INF) THEN + ASM_SIMP_TAC[COMPACT_CLOSED_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; + DIST_0; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let SETDIST_CLOSED_COMPACT = prove + (`!s t:real^N->bool. + closed s /\ compact t /\ ~(s = {}) /\ ~(t = {}) + ==> ?x y. x IN s /\ y IN t /\ dist(x,y) = setdist(s,t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + MATCH_MP_TAC(MESON[] + `(!x y. P x /\ Q y ==> S x y) /\ (?x y. P x /\ Q y /\ R x y) + ==> ?x y. P x /\ Q y /\ R x y /\ S x y`) THEN + SIMP_TAC[SETDIST_LE_DIST] THEN + ASM_REWRITE_TAC[REAL_LE_SETDIST_EQ] THEN + MP_TAC(ISPECL [`{x - y:real^N | x IN s /\ y IN t}`; `vec 0:real^N`] + DISTANCE_ATTAINS_INF) THEN + ASM_SIMP_TAC[CLOSED_COMPACT_DIFFERENCES; EXISTS_IN_GSPEC; FORALL_IN_GSPEC; + DIST_0; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[dist] THEN DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let SETDIST_EQ_0_COMPACT_CLOSED = prove + (`!s t:real^N->bool. + compact s /\ closed t + ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY] THEN EQ_TAC THENL + [MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] + SETDIST_COMPACT_CLOSED) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[DIST_EQ_0]; + REWRITE_TAC[GSYM REAL_LE_ANTISYM; SETDIST_POS_LE] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + MESON_TAC[SETDIST_LE_DIST; DIST_EQ_0]]);; + +let SETDIST_EQ_0_CLOSED_COMPACT = prove + (`!s t:real^N->bool. + closed s /\ compact t + ==> (setdist(s,t) = &0 <=> s = {} \/ t = {} \/ ~(s INTER t = {}))`, + ONCE_REWRITE_TAC[SETDIST_SYM] THEN + SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED] THEN SET_TAC[]);; + +let SETDIST_EQ_0_BOUNDED = prove + (`!s t:real^N->bool. + (bounded s \/ bounded t) + ==> (setdist(s,t) = &0 <=> + s = {} \/ t = {} \/ ~(closure(s) INTER closure(t) = {}))`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[SETDIST_EMPTY] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] + `setdist(s,t) = setdist(closure s,closure t)`] THEN + ASM_SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; SETDIST_EQ_0_CLOSED_COMPACT; + COMPACT_CLOSURE; CLOSED_CLOSURE; CLOSURE_EQ_EMPTY]);; + + +let SETDIST_TRANSLATION = prove + (`!a:real^N s t. + setdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = setdist(s,t)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[SETDIST_DIFFERENCES] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = + {f (g x) (g y) | x IN s /\ y IN t}`] THEN + REWRITE_TAC[VECTOR_ARITH `(a + x) - (a + y):real^N = x - y`]);; + +add_translation_invariants [SETDIST_TRANSLATION];; + +let SETDIST_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x. norm(f x) = norm x) + ==> setdist(IMAGE f s,IMAGE f t) = setdist(s,t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[setdist; IMAGE_EQ_EMPTY] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[dist] THEN AP_TERM_TAC THEN + REWRITE_TAC[SET_RULE + `{f x y | x IN IMAGE g s /\ y IN IMAGE g t} = + {f (g x) (g y) | x IN s /\ y IN t}`] THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP LINEAR_SUB th)]) THEN + ASM_REWRITE_TAC[]);; + +add_linear_invariants [SETDIST_LINEAR_IMAGE];; + +let SETDIST_UNIQUE = prove + (`!s t a b:real^N d. + a IN s /\ b IN t /\ dist(a,b) = d /\ + (!x y. x IN s /\ y IN t ==> dist(a,b) <= dist(x,y)) + ==> setdist(s,t) = d`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SETDIST_LE_DIST]; + MATCH_MP_TAC REAL_LE_SETDIST THEN ASM SET_TAC[]]);; + +let SETDIST_CLOSEST_POINT = prove + (`!a:real^N s. + closed s /\ ~(s = {}) ==> setdist({a},s) = dist(a,closest_point s a)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_UNIQUE THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; IN_SING; UNWIND_THM2] THEN + EXISTS_TAC `closest_point s (a:real^N)` THEN + ASM_MESON_TAC[CLOSEST_POINT_EXISTS; DIST_SYM]);; + +let SETDIST_EQ_0_SING = prove + (`(!s x:real^N. setdist({x},s) = &0 <=> s = {} \/ x IN closure s) /\ + (!s x:real^N. setdist(s,{x}) = &0 <=> s = {} \/ x IN closure s)`, + SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_SING; CLOSURE_SING] THEN SET_TAC[]);; + +let SETDIST_EQ_0_CLOSED = prove + (`!s x. closed s ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, + SIMP_TAC[SETDIST_EQ_0_COMPACT_CLOSED; COMPACT_SING] THEN SET_TAC[]);; + +let SETDIST_EQ_0_CLOSED_IN = prove + (`!u s x. closed_in (subtopology euclidean u) s /\ x IN u + ==> (setdist({x},s) = &0 <=> s = {} \/ x IN s)`, + REWRITE_TAC[SETDIST_EQ_0_SING; CLOSED_IN_INTER_CLOSURE] THEN SET_TAC[]);; + +let SETDIST_SING_IN_SET = prove + (`!x s. x IN s ==> setdist({x},s) = &0`, + SIMP_TAC[SETDIST_EQ_0_SING; REWRITE_RULE[SUBSET] CLOSURE_SUBSET]);; + +let SETDIST_SING_TRIANGLE = prove + (`!s x y:real^N. abs(setdist({x},s) - setdist({y},s)) <= dist(x,y)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; REAL_SUB_REFL; REAL_ABS_NUM; DIST_POS_LE] THEN + REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_NEG_SUB] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a - b <= c <=> a - c <= b`; + REAL_ARITH `--a <= b - c <=> c - a <= b`] THEN + MATCH_MP_TAC REAL_LE_SETDIST THEN ASM_REWRITE_TAC[NOT_INSERT_EMPTY] THEN + SIMP_TAC[IN_SING; IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_UNWIND_THM2] THEN + X_GEN_TAC `z:real^N` THEN DISCH_TAC THENL + [MATCH_MP_TAC(NORM_ARITH + `a <= dist(y:real^N,z) ==> a - dist(x,y) <= dist(x,z)`); + MATCH_MP_TAC(NORM_ARITH + `a <= dist(x:real^N,z) ==> a - dist(x,y) <= dist(y,z)`)] THEN + MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; + +let SETDIST_LE_SING = prove + (`!s t x:real^N. x IN s ==> setdist(s,t) <= setdist({x},t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SETDIST_SUBSET_LEFT THEN ASM SET_TAC[]);; + +let SETDIST_BALLS = prove + (`(!a b:real^N r s. + setdist(ball(a,r),ball(b,s)) = + if r <= &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ + (!a b:real^N r s. + setdist(ball(a,r),cball(b,s)) = + if r <= &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ + (!a b:real^N r s. + setdist(cball(a,r),ball(b,s)) = + if r < &0 \/ s <= &0 then &0 else max (&0) (dist(a,b) - (r + s))) /\ + (!a b:real^N r s. + setdist(cball(a,r),cball(b,s)) = + if r < &0 \/ s < &0 then &0 else max (&0) (dist(a,b) - (r + s)))`, + REWRITE_TAC[MESON[] + `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN + SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; SETDIST_EMPTY; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[MESON[SETDIST_CLOSURE] + `setdist(s,t) = setdist(closure s,closure t)`] THEN + SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN + REWRITE_TAC[SETDIST_CLOSURE] THEN + MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT GEN_TAC] THEN + REWRITE_TAC[real_max; REAL_SUB_LE] THEN COND_CASES_TAC THEN + SIMP_TAC[SETDIST_EQ_0_BOUNDED; BOUNDED_CBALL; CLOSED_CBALL; CLOSURE_CLOSED; + CBALL_EQ_EMPTY; INTER_BALLS_EQ_EMPTY] + THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_CASES_TAC `b:real^N = a` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_REFL]) THEN + ASM_CASES_TAC `r = &0 /\ s = &0` THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + ASM_SIMP_TAC[CBALL_SING; SETDIST_SINGS] THEN REAL_ARITH_TAC; + STRIP_TAC] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_LE_SETDIST THEN + ASM_REWRITE_TAC[CBALL_EQ_EMPTY; REAL_NOT_LT; IN_CBALL] THEN + CONV_TAC NORM_ARITH] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `dist(a + r / dist(a,b) % (b - a):real^N, + b - s / dist(a,b) % (b - a))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SETDIST_LE_DIST THEN + REWRITE_TAC[IN_CBALL; NORM_ARITH `dist(a:real^N,a + x) = norm x`; + NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[dist; NORM_MUL; REAL_ABS_DIV; REAL_ABS_NORM] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; VECTOR_SUB_EQ; NORM_EQ_0] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[dist; VECTOR_ARITH + `(a + d % (b - a)) - (b - e % (b - a)):real^N = + (&1 - d - e) % (a - b)`] THEN + REWRITE_TAC[NORM_MUL; REAL_ARITH + `&1 - r / y - s / y = &1 - (r + s) / y`] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN + ASM_SIMP_TAC[VECTOR_SUB_EQ; NORM_EQ_0; REAL_FIELD + `~(n = &0) ==> (&1 - x / n) * n = n - x`] THEN + REWRITE_TAC[GSYM dist] THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Use set distance for an easy proof of separation properties etc. *) +(* ------------------------------------------------------------------------- *) + +let SEPARATION_CLOSURES = prove + (`!s t:real^N->bool. + s INTER closure(t) = {} /\ t INTER closure(s) = {} + ==> ?u v. DISJOINT u v /\ open u /\ open v /\ + s SUBSET u /\ t SUBSET v`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `(:real^N)`] THEN + ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`(:real^N)`; `{}:real^N->bool`] THEN + ASM_REWRITE_TAC[OPEN_EMPTY; OPEN_UNIV] THEN ASM SET_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `{x | x IN (:real^N) /\ + lift(setdist({x},t) - setdist({x},s)) IN + {x | &0 < x$1}}` THEN + EXISTS_TAC `{x | x IN (:real^N) /\ + lift(setdist({x},t) - setdist({x},s)) IN + {x | x$1 < &0}}` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s /\ x IN t ==> F`] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REAL_ARITH_TAC; + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN + SIMP_TAC[REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN + SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN + SIMP_TAC[OPEN_HALFSPACE_COMPONENT_LT; OPEN_UNIV] THEN + SIMP_TAC[LIFT_SUB; CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ y = &0 /\ ~(x = &0) ==> &0 < x - y`); + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV; GSYM drop; LIFT_DROP] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ x = &0 /\ ~(y = &0) ==> x - y < &0`)] THEN + ASM_SIMP_TAC[SETDIST_POS_LE; SETDIST_EQ_0_BOUNDED; BOUNDED_SING] THEN + ASM_SIMP_TAC[CLOSED_SING; CLOSURE_CLOSED; NOT_INSERT_EMPTY; + REWRITE_RULE[SUBSET] CLOSURE_SUBSET; + SET_RULE `{a} INTER s = {} <=> ~(a IN s)`] THEN + ASM SET_TAC[]);; + +let SEPARATION_NORMAL = prove + (`!s t:real^N->bool. + closed s /\ closed t /\ s INTER t = {} + ==> ?u v. open u /\ open v /\ + s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DISJOINT] THEN + ONCE_REWRITE_TAC[TAUT + `a /\ b /\ c /\ d /\ e <=> e /\ a /\ b /\ c /\ d`] THEN + MATCH_MP_TAC SEPARATION_CLOSURES THEN + ASM_SIMP_TAC[CLOSURE_CLOSED] THEN ASM SET_TAC[]);; + +let SEPARATION_NORMAL_LOCAL = prove + (`!s t u:real^N->bool. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} + ==> ?s' t'. open_in (subtopology euclidean u) s' /\ + open_in (subtopology euclidean u) t' /\ + s SUBSET s' /\ t SUBSET t' /\ s' INTER t' = {}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`{}:real^N->bool`; `u:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN + ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; + ALL_TAC] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THENL + [MAP_EVERY EXISTS_TAC [`u:real^N->bool`; `{}:real^N->bool`] THEN + ASM_SIMP_TAC[OPEN_IN_REFL; OPEN_IN_EMPTY; INTER_EMPTY; EMPTY_SUBSET] THEN + ASM_MESON_TAC[CLOSED_IN_IMP_SUBSET]; + ALL_TAC] THEN + EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},s) < setdist({x},t)}` THEN + EXISTS_TAC `{x:real^N | x IN u /\ setdist({x},t) < setdist({x},s)}` THEN + SIMP_TAC[EXTENSION; SUBSET; IN_ELIM_THM; SETDIST_SING_IN_SET; IN_INTER; + NOT_IN_EMPTY; SETDIST_POS_LE; CONJ_ASSOC; + REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + CONJ_TAC THENL [ALL_TAC; MESON_TAC[REAL_LT_ANTISYM]] THEN + ONCE_REWRITE_TAC[GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [ALL_TAC; + ASM_MESON_TAC[SETDIST_EQ_0_CLOSED_IN; CLOSED_IN_IMP_SUBSET; SUBSET; + MEMBER_NOT_EMPTY; IN_INTER]] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + ONCE_REWRITE_TAC[MESON[LIFT_DROP] `&0 < x <=> &0 < drop(lift x)`] THEN + REWRITE_TAC[SET_RULE + `{x | x IN u /\ &0 < drop(f x)} = + {x | x IN u /\ f x IN {x | &0 < drop x}}`] THEN + REWRITE_TAC[drop] THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_OPEN_IN_PREIMAGE THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT; LIFT_SUB; + REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_GT; OPEN_UNIV] THEN + SIMP_TAC[CONTINUOUS_ON_SUB; CONTINUOUS_ON_LIFT_SETDIST]);; + +let SEPARATION_NORMAL_COMPACT = prove + (`!s t:real^N->bool. + compact s /\ closed t /\ s INTER t = {} + ==> ?u v. open u /\ compact(closure u) /\ open v /\ + s SUBSET u /\ t SUBSET v /\ u INTER v = {}`, + REWRITE_TAC[COMPACT_EQ_BOUNDED_CLOSED; CLOSED_CLOSURE] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM + (MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t UNION ((:real^N) DIFF ball(vec 0,r))`] + SEPARATION_NORMAL) THEN + ASM_SIMP_TAC[CLOSED_UNION; GSYM OPEN_CLOSED; OPEN_BALL] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REPEAT(MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [MATCH_MP_TAC BOUNDED_CLOSURE; ASM SET_TAC[]] THEN + MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `ball(vec 0:real^N,r)` THEN + REWRITE_TAC[BOUNDED_BALL] THEN ASM SET_TAC[]);; + +let SEPARATION_HAUSDORFF = prove + (`!x:real^N y. + ~(x = y) + ==> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ (u INTER v = {})`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`{x:real^N}`; `{y:real^N}`] SEPARATION_NORMAL) THEN + REWRITE_TAC[SING_SUBSET; CLOSED_SING] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM SET_TAC[]);; + +let SEPARATION_T2 = prove + (`!x:real^N y. + ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ y IN v /\ + (u INTER v = {})`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[SEPARATION_HAUSDORFF] THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let SEPARATION_T1 = prove + (`!x:real^N y. + ~(x = y) <=> ?u v. open u /\ open v /\ x IN u /\ ~(y IN u) /\ + ~(x IN v) /\ y IN v`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_SIMP_TAC[SEPARATION_T2; EXTENSION; NOT_IN_EMPTY; IN_INTER]; + ALL_TAC] THEN MESON_TAC[]);; + +let SEPARATION_T0 = prove + (`!x:real^N y. ~(x = y) <=> ?u. open u /\ ~(x IN u <=> y IN u)`, + MESON_TAC[SEPARATION_T1]);; + +(* ------------------------------------------------------------------------- *) +(* Hausdorff distance between sets. *) +(* ------------------------------------------------------------------------- *) + +let hausdist = new_definition + `hausdist(s:real^N->bool,t:real^N->bool) = + let ds = {setdist({x},t) | x IN s} UNION {setdist({y},s) | y IN t} in + if ~(ds = {}) /\ (?b. !d. d IN ds ==> d <= b) then sup ds + else &0`;; + +let HAUSDIST_POS_LE = prove + (`!s t:real^N->bool. &0 <= hausdist(s,t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ (!x. x IN s ==> P x) ==> ?y. y IN s /\ P y`) THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION; SETDIST_POS_LE]);; + +let HAUSDIST_REFL = prove + (`!s:real^N->bool. hausdist(s,s) = &0`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE] THEN + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_SUP_LE THEN + REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET; REAL_LE_REFL]);; + +let HAUSDIST_SYM = prove + (`!s t:real^N->bool. hausdist(s,t) = hausdist(t,s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [UNION_COMM] THEN + REWRITE_TAC[]);; + +let HAUSDIST_EMPTY = prove + (`(!t:real^N->bool. hausdist ({},t) = &0) /\ + (!s:real^N->bool. hausdist (s,{}) = &0)`, + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_EMPTY] THEN + REWRITE_TAC[SET_RULE `{f x | x IN {}} = {}`; UNION_EMPTY] THEN + REWRITE_TAC[SET_RULE `{c |x| x IN s} = {} <=> s = {}`] THEN + X_GEN_TAC `s:real^N->bool` THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[SET_RULE `~(s = {}) ==> {c |x| x IN s} = {c}`] THEN + REWRITE_TAC[SUP_SING; COND_ID]);; + +let HAUSDIST_SINGS = prove + (`!x y:real^N. hausdist({x},{y}) = dist(x,y)`, + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN + REWRITE_TAC[SET_RULE `{f x | x IN {a}} = {f a}`] THEN + REWRITE_TAC[DIST_SYM; UNION_IDEMPOT; SUP_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; FORALL_UNWIND_THM2] THEN + MESON_TAC[REAL_LE_REFL]);; + +let HAUSDIST_EQ = prove + (`!s t:real^M->bool s' t':real^N->bool. + (!b. (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= b) <=> + (!x. x IN s' ==> setdist({x},t') <= b) /\ + (!y. y IN t' ==> setdist({y},s') <= b)) + ==> hausdist(s,t) = hausdist(s',t')`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + MATCH_MP_TAC(MESON[] + `(p <=> p') /\ s = s' + ==> (if p then s else &0) = (if p' then s' else &0)`) THEN + CONJ_TAC THENL + [BINOP_TAC THENL + [PURE_REWRITE_TAC[SET_RULE `s = {} <=> !x. x IN s ==> F`]; + AP_TERM_TAC THEN ABS_TAC]; + MATCH_MP_TAC SUP_EQ] THEN + PURE_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[GSYM DE_MORGAN_THM] THEN AP_TERM_TAC THEN EQ_TAC THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `--(&1):real`) THEN + SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> ~(x <= --(&1))`] THEN + SET_TAC[]);; + +let HAUSDIST_TRANSLATION = prove + (`!a s t:real^N->bool. + hausdist(IMAGE (\x. a + x) s,IMAGE (\x. a + x) t) = hausdist(s,t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN + REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN + REWRITE_TAC[SET_RULE `{a + x:real^N} = IMAGE (\x. a + x) {x}`] THEN + REWRITE_TAC[SETDIST_TRANSLATION]);; + +add_translation_invariants [HAUSDIST_TRANSLATION];; + +let HAUSDIST_LINEAR_IMAGE = prove + (`!f:real^M->real^N s t. + linear f /\ (!x. norm(f x) = norm x) + ==> hausdist(IMAGE f s,IMAGE f t) = hausdist(s,t)`, + REPEAT STRIP_TAC THEN + REPEAT GEN_TAC THEN REWRITE_TAC[hausdist] THEN + REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN + ONCE_REWRITE_TAC[SET_RULE `{(f:real^M->real^N) x} = IMAGE f {x}`] THEN + ASM_SIMP_TAC[SETDIST_LINEAR_IMAGE]);; + +add_linear_invariants [HAUSDIST_LINEAR_IMAGE];; + +let HAUSDIST_CLOSURE = prove + (`(!s t:real^N->bool. hausdist(closure s,t) = hausdist(s,t)) /\ + (!s t:real^N->bool. hausdist(s,closure t) = hausdist(s,t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAUSDIST_EQ THEN + GEN_TAC THEN BINOP_TAC THEN REWRITE_TAC[SETDIST_CLOSURE] THEN + PURE_ONCE_REWRITE_TAC[SET_RULE + `(!x. P x ==> Q x) <=> (!x. P x ==> x IN {x | Q x})`] THEN + MATCH_MP_TAC FORALL_IN_CLOSURE_EQ THEN + REWRITE_TAC[EMPTY_GSPEC; CONTINUOUS_ON_ID; CLOSED_EMPTY] THEN + ONCE_REWRITE_TAC[MESON[LIFT_DROP] `x <= b <=> drop(lift x) <= b`] THEN + REWRITE_TAC[SET_RULE + `{x | drop(lift(f x)) <= b} = + {x | x IN UNIV /\ lift(f x) IN {x | drop x <= b}}`] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN + REWRITE_TAC[CLOSED_UNIV; CONTINUOUS_ON_LIFT_SETDIST] THEN + REWRITE_TAC[drop; CLOSED_HALFSPACE_COMPONENT_LE]);; + +let REAL_HAUSDIST_LE = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ + (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= b) + ==> hausdist(s,t) <= b`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN + ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + MATCH_MP_TAC REAL_SUP_LE THEN + ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + ASM_REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]);; + +let REAL_HAUSDIST_LE_SUMS = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ + s SUBSET {y + z | y IN t /\ z IN cball(vec 0,b)} /\ + t SUBSET {y + z | y IN s /\ z IN cball(vec 0,b)} + ==> hausdist(s,t) <= b`, + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[GSYM dist] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_MESON_TAC[SETDIST_LE_DIST; REAL_LE_TRANS; IN_SING]);; + +let REAL_LE_HAUSDIST = prove + (`!s t:real^N->bool a b c z. + ~(s = {}) /\ ~(t = {}) /\ + (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= c) /\ + (z IN s /\ a <= setdist({z},t) \/ z IN t /\ a <= setdist({z},s)) + ==> a <= hausdist(s,t)`, + REPEAT GEN_TAC THEN DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF; SETDIST_SINGS] THEN + ASM_REWRITE_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LE_SUP THEN + ASM_SIMP_TAC[EMPTY_UNION; SET_RULE `{f x | x IN s} = {} <=> s = {}`] THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[NOT_FORALL_THM]] THEN + EXISTS_TAC `max b c:real` THEN + ASM_SIMP_TAC[REAL_LE_MAX] THEN ASM SET_TAC[]);; + +let SETDIST_LE_HAUSDIST = prove + (`!s t:real^N->bool. + bounded s /\ bounded t ==> setdist(s,t) <= hausdist(s,t)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_HAUSDIST THEN REWRITE_TAC[CONJ_ASSOC] THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; LEFT_EXISTS_AND_THM] THEN + CONJ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[SETDIST_LE_SING; MEMBER_NOT_EMPTY]] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + CONJ_TAC THEN EXISTS_TAC `b:real` THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[REAL_LE_TRANS; SETDIST_LE_DIST; MEMBER_NOT_EMPTY; IN_SING; + DIST_SYM]);; + +let SETDIST_SING_LE_HAUSDIST = prove + (`!s t x:real^N. + bounded s /\ bounded t /\ x IN s ==> setdist({x},t) <= hausdist(s,t)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_CASES_TAC `t:real^N->bool = {}` THEN + ASM_REWRITE_TAC[SETDIST_EMPTY; HAUSDIST_EMPTY; REAL_LE_REFL] THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_HAUSDIST THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[LEFT_EXISTS_AND_THM; EXISTS_OR_THM; CONJ_ASSOC] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN CONJ_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[bounded; FORALL_IN_GSPEC] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[GSYM dist] THEN GEN_TAC THENL + [ALL_TAC; ONCE_REWRITE_TAC[SWAP_FORALL_THM]] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real^N` THEN + REPEAT STRIP_TAC THENL + [UNDISCH_TAC `~(t:real^N->bool = {})`; + UNDISCH_TAC `~(s:real^N->bool = {})`] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THENL + [ALL_TAC; ONCE_REWRITE_TAC[DIST_SYM]] THEN + MATCH_MP_TAC SETDIST_LE_DIST THEN ASM_REWRITE_TAC[IN_SING]);; + +let UPPER_LOWER_HEMICONTINUOUS = prove + (`!f:real^M->real^N->bool t s. + (!x. x IN s ==> f(x) SUBSET t) /\ + (!u. open_in (subtopology euclidean t) u + ==> open_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) /\ + (!u. closed_in (subtopology euclidean t) u + ==> closed_in (subtopology euclidean s) + {x | x IN s /\ f(x) SUBSET u}) + ==> !x e. x IN s /\ &0 < e /\ bounded(f x) + ==> ?d. &0 < d /\ + !x'. x' IN s /\ dist(x,x') < d + ==> hausdist(f x,f x') < e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(f:real^M->real^N->bool) x = {}` THENL + [ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN MESON_TAC[REAL_LT_01]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPECL [`x:real^M`; `e / &2`] o MATCH_MP + UPPER_LOWER_HEMICONTINUOUS_EXPLICIT) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `vec 0:real^N` o MATCH_MP BOUNDED_SUBSET_BALL) THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o SPEC `t INTER ball(vec 0:real^N,r)` o + CONJUNCT1 o CONJUNCT2) THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REWRITE_TAC[open_in] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M` o CONJUNCT2) THEN + ASM_SIMP_TAC[SUBSET_INTER; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d2:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 d2:real` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + X_GEN_TAC `x':real^M` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x':real^M`)) THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `(f:real^M->real^N->bool) x' = {}` THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < e /\ x <= e / &2 ==> x < e`) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; + IN_SING; REAL_LT_IMP_LE]);; + +let HAUSDIST_NONTRIVIAL = prove + (`!s t:real^N->bool. + bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = + sup({setdist ({x},t) | x IN s} UNION {setdist ({y},s) | y IN t})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hausdist; LET_DEF; LET_END_DEF] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [DE_MORGAN_THM]) THEN + ASM_SIMP_TAC[EMPTY_UNION; SIMPLE_IMAGE; IMAGE_EQ_EMPTY] THEN + MATCH_MP_TAC(TAUT `p ==> ~p ==> q`) THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_NONTRIVIAL_ALT = prove + (`!s t:real^N->bool. + bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = max (sup {setdist ({x},t) | x IN s}) + (sup {setdist ({y},s) | y IN t})`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL] THEN + MATCH_MP_TAC SUP_UNION THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; FORALL_IN_IMAGE; IMAGE_EQ_EMPTY] THEN + CONJ_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let REAL_HAUSDIST_LE_EQ = prove + (`!s t:real^N->bool b. + ~(s = {}) /\ ~(t = {}) /\ bounded s /\ bounded t + ==> (hausdist(s,t) <= b <=> + (!x. x IN s ==> setdist({x},t) <= b) /\ + (!y. y IN t ==> setdist({y},s) <= b))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL_ALT; REAL_MAX_LE] THEN + BINOP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `(!x. x IN s ==> f x <= b) <=> + (!y. y IN {f x | x IN s} ==> y <= b)`] THEN + MATCH_MP_TAC REAL_SUP_LE_EQ THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_REWRITE_TAC[bounded; FORALL_IN_UNION; FORALL_IN_IMAGE; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[FORALL_IN_GSPEC; GSYM dist] THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_COMPACT_EXISTS = prove + (`!s t:real^N->bool. + bounded s /\ compact t /\ ~(t = {}) + ==> !x. x IN s ==> ?y. y IN t /\ dist(x,y) <= hausdist(s,t)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`{x:real^N}`; `t:real^N->bool`] + SETDIST_COMPACT_CLOSED) THEN + ASM_SIMP_TAC[COMPACT_SING; COMPACT_IMP_CLOSED; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; UNWIND_THM2; RIGHT_EXISTS_AND_THM; UNWIND_THM1] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_HAUSDIST THEN + ASM_REWRITE_TAC[LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM] THEN + REWRITE_TAC[CONJ_ASSOC] THEN + CONJ_TAC THENL [CONJ_TAC; ASM_MESON_TAC[REAL_LE_REFL]] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`] BOUNDED_DIFFS) THEN + ASM_SIMP_TAC[COMPACT_IMP_BOUNDED] THEN + REWRITE_TAC[bounded; FORALL_IN_GSPEC; GSYM dist] THEN + MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[SETDIST_LE_DIST; dist; DIST_SYM; REAL_LE_TRANS; + MEMBER_NOT_EMPTY; IN_SING]);; + +let HAUSDIST_COMPACT_SUMS = prove + (`!s t:real^N->bool. + bounded s /\ compact t /\ ~(t = {}) + ==> s SUBSET {y + z | y IN t /\ z IN cball(vec 0,hausdist(s,t))}`, + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_CBALL_0] THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[GSYM dist; HAUSDIST_COMPACT_EXISTS]);; + +let HAUSDIST_TRANS = prove + (`!s t u:real^N->bool. + bounded s /\ bounded t /\ bounded u /\ ~(t = {}) + ==> hausdist(s,u) <= hausdist(s,t) + hausdist(t,u)`, + let lemma = prove + (`!s t u:real^N->bool. + bounded s /\ bounded t /\ bounded u /\ + ~(s = {}) /\ ~(t = {}) /\ ~(u = {}) + ==> !x. x IN s ==> setdist({x},u) <= hausdist(s,t) + hausdist(t,u)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`closure s:real^N->bool`; `closure t:real^N->bool`] + HAUSDIST_COMPACT_EXISTS) THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`closure t:real^N->bool`; `closure u:real^N->bool`] + HAUSDIST_COMPACT_EXISTS) THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `y:real^N`) THEN + ASM_SIMP_TAC[REWRITE_RULE[SUBSET] CLOSURE_SUBSET; HAUSDIST_CLOSURE] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real^N` STRIP_ASSUME_TAC) THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[SETDIST_CLOSURE; SETDIST_LE_DIST; IN_SING]; ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,y) + dist(y,z)` THEN + REWRITE_TAC[DIST_TRIANGLE] THEN ASM_REAL_ARITH_TAC) in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_LID; HAUSDIST_POS_LE] THEN + ASM_CASES_TAC `u:real^N->bool = {}` THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY; REAL_ADD_RID; HAUSDIST_POS_LE] THEN + ASM_SIMP_TAC[REAL_HAUSDIST_LE_EQ] THEN + ASM_MESON_TAC[lemma; HAUSDIST_SYM; SETDIST_SYM; REAL_ADD_SYM]);; + +let HAUSDIST_EQ_0 = prove + (`!s t:real^N->bool. + bounded s /\ bounded t + ==> (hausdist(s,t) = &0 <=> s = {} \/ t = {} \/ closure s = closure t)`, + REPEAT STRIP_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:real^N->bool = {}`; `t:real^N->bool = {}`] THEN + ASM_REWRITE_TAC[HAUSDIST_EMPTY] THEN + ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; HAUSDIST_POS_LE; REAL_HAUSDIST_LE_EQ] THEN + SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN + ASM_REWRITE_TAC[SETDIST_EQ_0_SING; GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN + SIMP_TAC[FORALL_IN_CLOSURE_EQ; CLOSED_CLOSURE; CONTINUOUS_ON_ID]);; + +let HAUSDIST_COMPACT_NONTRIVIAL = prove + (`!s t:real^N->bool. + compact s /\ compact t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = + inf {e | &0 <= e /\ + s SUBSET {x + y | x IN t /\ norm y <= e} /\ + t SUBSET {x + y | x IN s /\ norm y <= e}}`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INF_UNIQUE THEN + REWRITE_TAC[FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_ARITH `a:real^N = b + x <=> a - b = x`; + ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + REWRITE_TAC[GSYM dist] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_HAUSDIST_LE THEN + ASM_MESON_TAC[SETDIST_LE_DIST; DIST_SYM; REAL_LE_TRANS; + IN_SING; REAL_LT_IMP_LE]; + REPEAT STRIP_TAC THEN EXISTS_TAC `hausdist(s:real^N->bool,t)` THEN + ASM_REWRITE_TAC[HAUSDIST_POS_LE] THEN + ASM_MESON_TAC[DIST_SYM; HAUSDIST_SYM; + HAUSDIST_COMPACT_EXISTS; COMPACT_IMP_BOUNDED]]);; + +let HAUSDIST_BALLS = prove + (`(!a b:real^N r s. + hausdist(ball(a,r),ball(b,s)) = + if r <= &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ + (!a b:real^N r s. + hausdist(ball(a,r),cball(b,s)) = + if r <= &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s)) /\ + (!a b:real^N r s. + hausdist(cball(a,r),ball(b,s)) = + if r < &0 \/ s <= &0 then &0 else dist(a,b) + abs(r - s)) /\ + (!a b:real^N r s. + hausdist(cball(a,r),cball(b,s)) = + if r < &0 \/ s < &0 then &0 else dist(a,b) + abs(r - s))`, + REWRITE_TAC[MESON[] + `(x = if p then y else z) <=> (p ==> x = y) /\ (~p ==> x = z)`] THEN + SIMP_TAC[TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + SIMP_TAC[BALL_EMPTY; CBALL_EMPTY; HAUSDIST_EMPTY; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] + `hausdist(s,t) = hausdist(closure s,closure t)`] THEN + SIMP_TAC[REAL_NOT_LE; REAL_NOT_LT; CLOSURE_BALL] THEN + REWRITE_TAC[HAUSDIST_CLOSURE] THEN + MATCH_MP_TAC(TAUT `(s ==> p /\ q /\ r) /\ s ==> p /\ q /\ r /\ s`) THEN + CONJ_TAC THENL [MESON_TAC[REAL_LT_IMP_LE]; REPEAT STRIP_TAC] THEN + ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; BOUNDED_CBALL; CBALL_EQ_EMPTY; + REAL_NOT_LT] THEN + MATCH_MP_TAC SUP_UNIQUE THEN + REWRITE_TAC[FORALL_IN_GSPEC; FORALL_IN_UNION] THEN + REWRITE_TAC[MESON[CBALL_SING] `{a} = cball(a:real^N,&0)`] THEN + ASM_REWRITE_TAC[SETDIST_BALLS; REAL_LT_REFL] THEN + X_GEN_TAC `c:real` THEN REWRITE_TAC[IN_CBALL] THEN + EQ_TAC THENL [ALL_TAC; NORM_ARITH_TAC] THEN + ASM_CASES_TAC `b:real^N = a` THENL + [ASM_REWRITE_TAC[DIST_SYM; DIST_REFL; REAL_MAX_LE] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `a + r % basis 1:real^N`) + (MP_TAC o SPEC `a + s % basis 1:real^N`)) THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a + x) = norm x`] THEN + SIMP_TAC[NORM_MUL; NORM_BASIS; LE_REFL; DIMINDEX_GE_1] THEN + ASM_REAL_ARITH_TAC; + DISCH_THEN(CONJUNCTS_THEN2 + (MP_TAC o SPEC `a - r / dist(a,b) % (b - a):real^N`) + (MP_TAC o SPEC `b - s / dist(a,b) % (a - b):real^N`)) THEN + REWRITE_TAC[NORM_ARITH `dist(a:real^N,a - x) = norm x`] THEN + REWRITE_TAC[dist; NORM_MUL; VECTOR_ARITH + `b - e % (a - b) - a:real^N = (&1 + e) % (b - a)`] THEN + ONCE_REWRITE_TAC[GSYM REAL_ABS_NORM] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_NORM] THEN + REWRITE_TAC[NORM_SUB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; NORM_EQ_0; VECTOR_SUB_EQ] THEN + ASM_REAL_ARITH_TAC]);; + +let HAUSDIST_ALT = prove + (`!s t:real^N->bool. + bounded s /\ bounded t /\ ~(s = {}) /\ ~(t = {}) + ==> hausdist(s,t) = + sup {abs(setdist({x},s) - setdist({x},t)) | x IN (:real^N)}`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM COMPACT_CLOSURE; GSYM(CONJUNCT2 SETDIST_CLOSURE); + GSYM CLOSURE_EQ_EMPTY; MESON[HAUSDIST_CLOSURE] + `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] THEN + SPEC_TAC(`closure t:real^N->bool`,`t:real^N->bool`) THEN + SPEC_TAC(`closure s:real^N->bool`,`s:real^N->bool`) THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[HAUSDIST_NONTRIVIAL; COMPACT_IMP_BOUNDED] THEN + MATCH_MP_TAC SUP_EQ THEN + REWRITE_TAC[FORALL_IN_UNION; FORALL_IN_GSPEC; IN_UNIV] THEN + REWRITE_TAC[REAL_ARITH `abs(y - x) <= b <=> x <= y + b /\ y <= x + b`] THEN + GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN BINOP_TAC THEN + (EQ_TAC THENL [ALL_TAC; MESON_TAC[SETDIST_SING_IN_SET; REAL_ADD_LID]]) THEN + DISCH_TAC THEN X_GEN_TAC `z:real^N` THENL + [MP_TAC(ISPECL[`{z:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT); + MP_TAC(ISPECL[`{z:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN + ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THENL + [MP_TAC(ISPECL[`{y:real^N}`; `t:real^N->bool`] SETDIST_CLOSED_COMPACT); + MP_TAC(ISPECL[`{y:real^N}`; `s:real^N->bool`] SETDIST_CLOSED_COMPACT)] THEN + ASM_REWRITE_TAC[CLOSED_SING; NOT_INSERT_EMPTY] THEN + REWRITE_TAC[IN_SING; RIGHT_EXISTS_AND_THM; UNWIND_THM2] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` (STRIP_ASSUME_TAC o GSYM)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + TRANS_TAC REAL_LE_TRANS `dist(z:real^N,x)` THEN + ASM_SIMP_TAC[SETDIST_LE_DIST; IN_SING] THEN + UNDISCH_TAC `dist(y:real^N,x) <= b` THEN CONV_TAC NORM_ARITH);; + +let CONTINUOUS_DIAMETER = prove + (`!s:real^N->bool e. + bounded s /\ ~(s = {}) /\ &0 < e + ==> ?d. &0 < d /\ + !t. bounded t /\ ~(t = {}) /\ hausdist(s,t) < d + ==> abs(diameter s - diameter t) < e`, + REPEAT STRIP_TAC THEN EXISTS_TAC `e / &2` THEN + ASM_REWRITE_TAC[REAL_HALF] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `diameter(s:real^N->bool) - diameter(t:real^N->bool) = + diameter(closure s) - diameter(closure t)` + SUBST1_TAC THENL [ASM_MESON_TAC[DIAMETER_CLOSURE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&2 * hausdist(s:real^N->bool,t)` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MP_TAC(ISPECL [`vec 0:real^N`; `hausdist(s:real^N->bool,t)`] + DIAMETER_CBALL) THEN + ASM_SIMP_TAC[HAUSDIST_POS_LE; GSYM REAL_NOT_LE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC(REAL_ARITH + `x <= y + e /\ y <= x + e ==> abs(x - y) <= e`) THEN + CONJ_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) DIAMETER_SUMS o rand o snd) THEN + ASM_SIMP_TAC[BOUNDED_CBALL; BOUNDED_CLOSURE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS) THEN + MATCH_MP_TAC DIAMETER_SUBSET THEN + ASM_SIMP_TAC[BOUNDED_SUMS; BOUNDED_CBALL; BOUNDED_CLOSURE] THEN + ONCE_REWRITE_TAC[MESON[HAUSDIST_CLOSURE] + `hausdist(s:real^N->bool,t) = hausdist(closure s,closure t)`] + THENL [ALL_TAC; ONCE_REWRITE_TAC[HAUSDIST_SYM]] THEN + MATCH_MP_TAC HAUSDIST_COMPACT_SUMS THEN + ASM_SIMP_TAC[COMPACT_CLOSURE; BOUNDED_CLOSURE; CLOSURE_EQ_EMPTY]);; + +(* ------------------------------------------------------------------------- *) +(* Isometries are embeddings, and even surjective in the compact case. *) +(* ------------------------------------------------------------------------- *) + +let ISOMETRY_IMP_OPEN_MAP = prove + (`!f:real^M->real^N s t u. + IMAGE f s = t /\ + (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) /\ + open_in (subtopology euclidean s) u + ==> open_in (subtopology euclidean t) (IMAGE f u)`, + REWRITE_TAC[open_in; FORALL_IN_IMAGE] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM SET_TAC[]; X_GEN_TAC `x:real^M` THEN DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `e:real` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IMP_CONJ] THEN + EXPAND_TAC "t" THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN + ASM_SIMP_TAC[IN_IMAGE] THEN ASM_MESON_TAC[]);; + +let ISOMETRY_IMP_EMBEDDING = prove + (`!f:real^M->real^N s t. + IMAGE f s = t /\ (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) + ==> ?g. homeomorphism (s,t) (f,g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HOMEOMORPHISM_INJECTIVE_OPEN_MAP THEN + ASM_SIMP_TAC[ISOMETRY_ON_IMP_CONTINUOUS_ON] THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIST_EQ_0]; REPEAT STRIP_TAC] THEN + MATCH_MP_TAC ISOMETRY_IMP_OPEN_MAP THEN ASM_MESON_TAC[]);; + +let ISOMETRY_IMP_HOMEOMORPHISM_COMPACT = prove + (`!f s:real^N->bool. + compact s /\ IMAGE f s SUBSET s /\ + (!x y. x IN s /\ y IN s ==> dist(f x,f y) = dist(x,y)) + ==> ?g. homeomorphism (s,s) (f,g)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `IMAGE (f:real^N->real^N) s = s` + (fun th -> ASM_MESON_TAC[th; ISOMETRY_IMP_EMBEDDING]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP ISOMETRY_ON_IMP_CONTINUOUS_ON) THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN REWRITE_TAC[SUBSET] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `setdist({x},IMAGE (f:real^N->real^N) s) = &0` MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ ~(&0 < x) ==> x = &0`) THEN + REWRITE_TAC[SETDIST_POS_LE] THEN DISCH_TAC THEN + (X_CHOOSE_THEN `z:num->real^N` STRIP_ASSUME_TAC o + prove_recursive_functions_exist num_RECURSION) + `z 0 = (x:real^N) /\ !n. z(SUC n) = f(z n)` THEN + SUBGOAL_THEN `!n. (z:num->real^N) n IN s` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM SET_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [compact]) THEN + DISCH_THEN(MP_TAC o SPEC `z:num->real^N`) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`l:real^N`; `r:num->num`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CONVERGENT_IMP_CAUCHY) THEN + REWRITE_TAC[cauchy] THEN + DISCH_THEN(MP_TAC o SPEC `setdist({x},IMAGE (f:real^N->real^N) s)`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `N:num` + (MP_TAC o SPECL [`N:num`; `N + 1`])) THEN + ANTS_TAC THENL [ARITH_TAC; REWRITE_TAC[REAL_NOT_LT; o_THM]] THEN + SUBGOAL_THEN `(r:num->num) N < r (N + 1)` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM]] THEN + X_GEN_TAC `d:num` THEN DISCH_THEN SUBST1_TAC THEN + TRANS_TAC REAL_LE_TRANS `dist(x:real^N,z(SUC d))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SETDIST_LE_DIST THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SPEC_TAC(`(r:num->num) N`,`m:num`) THEN + INDUCT_TAC THEN ASM_MESON_TAC[ADD_CLAUSES]; + REWRITE_TAC[SETDIST_EQ_0_SING; IMAGE_EQ_EMPTY] THEN + ASM_MESON_TAC[COMPACT_IMP_CLOSED; NOT_IN_EMPTY; + COMPACT_CONTINUOUS_IMAGE; CLOSURE_CLOSED]]);; + +(* ------------------------------------------------------------------------- *) +(* Urysohn's lemma (for real^N, where the proof is easy using distances). *) +(* ------------------------------------------------------------------------- *) + +let URYSOHN_LOCAL_STRONG = prove + (`!s t u a b. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} /\ ~(a = b) + ==> ?f:real^N->real^M. + f continuous_on u /\ + (!x. x IN u ==> f(x) IN segment[a,b]) /\ + (!x. x IN u ==> (f x = a <=> x IN s)) /\ + (!x. x IN u ==> (f x = b <=> x IN t))`, + let lemma = prove + (`!s t u a b. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} /\ ~(s = {}) /\ ~(t = {}) /\ ~(a = b) + ==> ?f:real^N->real^M. + f continuous_on u /\ + (!x. x IN u ==> f(x) IN segment[a,b]) /\ + (!x. x IN u ==> (f x = a <=> x IN s)) /\ + (!x. x IN u ==> (f x = b <=> x IN t))`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `\x:real^N. a + setdist({x},s) / (setdist({x},s) + setdist({x},t)) % + (b - a:real^M)` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `(!x:real^N. x IN u ==> (setdist({x},s) = &0 <=> x IN s)) /\ + (!x:real^N. x IN u ==> (setdist({x},t) = &0 <=> x IN t))` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[SETDIST_EQ_0_SING] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `s:real^N->bool` CLOSED_IN_CLOSED); + MP_TAC(ISPEC `t:real^N->bool` CLOSED_IN_CLOSED)] THEN + DISCH_THEN(MP_TAC o SPEC `u:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + ASM_MESON_TAC[CLOSURE_CLOSED; INTER_SUBSET; SUBSET_CLOSURE; SUBSET; + IN_INTER; CLOSURE_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:real^N. x IN u ==> &0 < setdist({x},s) + setdist({x},t)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ &0 <= y /\ ~(x = &0 /\ y = &0) ==> &0 < x + y`) THEN + REWRITE_TAC[SETDIST_POS_LE] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_ADD THEN REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[real_div; GSYM VECTOR_MUL_ASSOC] THEN + REPEAT(MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC) THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; o_DEF] THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + REWRITE_TAC[CONTINUOUS_ON_LIFT_SETDIST]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[segment; IN_ELIM_THM] THEN + REWRITE_TAC[VECTOR_MUL_EQ_0; LEFT_OR_DISTRIB; VECTOR_ARITH + `a + x % (b - a):real^N = (&1 - u) % a + u % b <=> + (x - u) % (b - a) = vec 0`; + EXISTS_OR_THM] THEN + DISJ1_TAC THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[REAL_SUB_0; UNWIND_THM1] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LE_ADD; SETDIST_POS_LE; REAL_LE_LDIV_EQ; + REAL_ARITH `a <= &1 * (a + b) <=> &0 <= b`]; + REWRITE_TAC[VECTOR_ARITH `a + x:real^N = a <=> x = vec 0`]; + REWRITE_TAC[VECTOR_ARITH `a + x % (b - a):real^N = b <=> + (x - &1) % (b - a) = vec 0`]] THEN + ASM_REWRITE_TAC[VECTOR_MUL_EQ_0; VECTOR_SUB_EQ] THEN + ASM_SIMP_TAC[REAL_SUB_0; REAL_EQ_LDIV_EQ; + REAL_MUL_LZERO; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `x:real = x + y <=> y = &0`] THEN + ASM_REWRITE_TAC[]) in + MATCH_MP_TAC(MESON[] + `(!s t. P s t <=> P t s) /\ + (!s t. ~(s = {}) /\ ~(t = {}) ==> P s t) /\ + P {} {} /\ (!t. ~(t = {}) ==> P {} t) + ==> !s t. P s t`) THEN + REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [SWAP_FORALL_THM] THEN + REPEAT(AP_TERM_TAC THEN ABS_TAC) THEN + REWRITE_TAC[SEGMENT_SYM; INTER_COMM; CONJ_ACI; EQ_SYM_EQ]; + SIMP_TAC[lemma]; + REPEAT STRIP_TAC THEN EXISTS_TAC `(\x. midpoint(a,b)):real^N->real^M` THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; CONTINUOUS_ON_CONST; MIDPOINT_IN_SEGMENT] THEN + REWRITE_TAC[midpoint] THEN CONJ_TAC THEN GEN_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `~(a:real^M = b)` THEN REWRITE_TAC[CONTRAPOS_THM] THEN + VECTOR_ARITH_TAC; + REPEAT STRIP_TAC THEN ASM_CASES_TAC `t:real^N->bool = u` THENL + [EXISTS_TAC `(\x. b):real^N->real^M` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; ENDS_IN_SEGMENT; IN_UNIV; + CONTINUOUS_ON_CONST]; + SUBGOAL_THEN `?c:real^N. c IN u /\ ~(c IN t)` STRIP_ASSUME_TAC THENL + [REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`{c:real^N}`; `t:real^N->bool`; `u:real^N->bool`; + `midpoint(a,b):real^M`; `b:real^M`] lemma) THEN + ASM_REWRITE_TAC[CLOSED_IN_SING; MIDPOINT_EQ_ENDPOINT] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[NOT_IN_EMPTY] THEN + X_GEN_TAC `f:real^N->real^M` THEN STRIP_TAC THEN CONJ_TAC THENL + [SUBGOAL_THEN + `segment[midpoint(a,b):real^M,b] SUBSET segment[a,b]` MP_TAC + THENL + [REWRITE_TAC[SUBSET; IN_SEGMENT; midpoint] THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(&1 + u) / &2` THEN ASM_REWRITE_TAC[] THEN + REPEAT(CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + VECTOR_ARITH_TAC; + ASM SET_TAC[]]; + SUBGOAL_THEN `~(a IN segment[midpoint(a,b):real^M,b])` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + DISCH_THEN(MP_TAC o CONJUNCT2 o MATCH_MP DIST_IN_CLOSED_SEGMENT) THEN + REWRITE_TAC[DIST_MIDPOINT] THEN + UNDISCH_TAC `~(a:real^M = b)` THEN NORM_ARITH_TAC]]]);; + +let URYSOHN_LOCAL = prove + (`!s t u a b. + closed_in (subtopology euclidean u) s /\ + closed_in (subtopology euclidean u) t /\ + s INTER t = {} + ==> ?f:real^N->real^M. + f continuous_on u /\ + (!x. x IN u ==> f(x) IN segment[a,b]) /\ + (!x. x IN s ==> f x = a) /\ + (!x. x IN t ==> f x = b)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:real^M = b` THENL + [EXISTS_TAC `(\x. b):real^N->real^M` THEN + ASM_REWRITE_TAC[ENDS_IN_SEGMENT; CONTINUOUS_ON_CONST]; + MP_TAC(ISPECL [`s:real^N->bool`; `t:real^N->bool`; `u:real^N->bool`; + `a:real^M`; `b:real^M`] URYSOHN_LOCAL_STRONG) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o MATCH_MP CLOSED_IN_SUBSET)) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY] THEN SET_TAC[]]);; + +let URYSOHN_STRONG = prove + (`!s t a b. + closed s /\ closed t /\ s INTER t = {} /\ ~(a = b) + ==> ?f:real^N->real^M. + f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ + (!x. f x = a <=> x IN s) /\ (!x. f x = b <=> x IN t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP URYSOHN_LOCAL_STRONG) THEN + REWRITE_TAC[IN_UNIV]);; + +let URYSOHN = prove + (`!s t a b. + closed s /\ closed t /\ s INTER t = {} + ==> ?f:real^N->real^M. + f continuous_on (:real^N) /\ (!x. f(x) IN segment[a,b]) /\ + (!x. x IN s ==> f x = a) /\ (!x. x IN t ==> f x = b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN] THEN + ONCE_REWRITE_TAC[GSYM SUBTOPOLOGY_UNIV] THEN DISCH_THEN + (MP_TAC o ISPECL [`a:real^M`; `b:real^M`] o MATCH_MP URYSOHN_LOCAL) THEN + REWRITE_TAC[IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Countability of some relevant sets. *) +(* ------------------------------------------------------------------------- *) + +let COUNTABLE_INTEGER = prove + (`COUNTABLE integer`, + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC + `IMAGE (\n. (&n:real)) (:num) UNION IMAGE (\n. --(&n)) (:num)` THEN + SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_UNION; NUM_COUNTABLE] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_IMAGE; IN_UNIV] THEN + REWRITE_TAC[IN; INTEGER_CASES]);; + +let CARD_EQ_INTEGER = prove + (`integer =_c (:num)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_INTEGER] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN + REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[IN; INTEGER_CLOSED]);; + +let COUNTABLE_RATIONAL = prove + (`COUNTABLE rational`, + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\(x,y). x / y) (integer CROSS integer)` THEN + SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_CROSS; COUNTABLE_INTEGER] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_CROSS] THEN + REWRITE_TAC[rational; IN] THEN MESON_TAC[]);; + +let CARD_EQ_RATIONAL = prove + (`rational =_c (:num)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM; GSYM COUNTABLE_ALT; COUNTABLE_RATIONAL] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `real_of_num` THEN + REWRITE_TAC[IN_UNIV; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[IN; RATIONAL_CLOSED]);; + +let COUNTABLE_INTEGER_COORDINATES = prove + (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }`, + MATCH_MP_TAC COUNTABLE_CART THEN + REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_INTEGER]);; + +let COUNTABLE_RATIONAL_COORDINATES = prove + (`COUNTABLE { x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`, + MATCH_MP_TAC COUNTABLE_CART THEN + REWRITE_TAC[SET_RULE `{x | P x} = P`; COUNTABLE_RATIONAL]);; + +(* ------------------------------------------------------------------------- *) +(* Density of points with rational, or just dyadic rational, coordinates. *) +(* ------------------------------------------------------------------------- *) + +let CLOSURE_DYADIC_RATIONALS = prove + (`closure { inv(&2 pow n) % x |n,x| + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) } = (:real^N)`, + REWRITE_TAC[EXTENSION; CLOSURE_APPROACHABLE; IN_UNIV; EXISTS_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:real^N`; `e:real`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`inv(&2)`; `e / &(dimindex(:N))`] REAL_ARCH_POW_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1; + REAL_POW_INV; REAL_LT_RDIV_EQ] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN MATCH_MP_TAC MONO_EXISTS THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + EXISTS_TAC `(lambda i. floor(&2 pow n * (x:real^N)$i)):real^N` THEN + ASM_SIMP_TAC[LAMBDA_BETA; FLOOR; dist; NORM_MUL] THEN + MATCH_MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS) + (SPEC_ALL NORM_LE_L1)) THEN + SIMP_TAC[LAMBDA_BETA; VECTOR_SUB_COMPONENT; VECTOR_MUL_COMPONENT] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&(dimindex(:N)) * inv(&2 pow n)` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC SUM_BOUND THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + SIMP_TAC[REAL_ABS_MUL; REAL_POW_EQ_0; REAL_OF_NUM_EQ; ARITH; + REAL_FIELD `~(a = &0) ==> inv a * b - x = inv a * (b - a * x)`] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REWRITE_TAC[REAL_LE_REFL; REAL_ABS_POW; REAL_ABS_INV; REAL_ABS_NUM] THEN + MP_TAC(SPEC `&2 pow n * (x:real^N)$k` FLOOR) THEN REAL_ARITH_TAC);; + +let CLOSURE_RATIONAL_COORDINATES = prove + (`closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } = + (:real^N)`, + MATCH_MP_TAC(SET_RULE `!s. s SUBSET t /\ s = UNIV ==> t = UNIV`) THEN + EXISTS_TAC + `closure { inv(&2 pow n) % x:real^N |n,x| + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }` THEN + + CONJ_TAC THENL [ALL_TAC; REWRITE_TAC[CLOSURE_DYADIC_RATIONALS]] THEN + MATCH_MP_TAC SUBSET_CLOSURE THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; VECTOR_MUL_COMPONENT] THEN + ASM_SIMP_TAC[RATIONAL_CLOSED]);; + +let CLOSURE_DYADIC_RATIONALS_IN_OPEN_SET = prove + (`!s:real^N->bool. + open s + ==> closure(s INTER + { inv(&2 pow n) % x | n,x | + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = + closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN + ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; + +let CLOSURE_RATIONALS_IN_OPEN_SET = prove + (`!s:real^N->bool. + open s + ==> closure(s INTER + { inv(&2 pow n) % x | n,x | + !i. 1 <= i /\ i <= dimindex(:N) ==> integer(x$i) }) = + closure s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSURE_OPEN_INTER_SUPERSET THEN + ASM_REWRITE_TAC[CLOSURE_DYADIC_RATIONALS; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Various separability-type properties. *) +(* ------------------------------------------------------------------------- *) + +let UNIV_SECOND_COUNTABLE = prove + (`?b. COUNTABLE b /\ (!c. c IN b ==> open c) /\ + !s:real^N->bool. open s ==> ?u. u SUBSET b /\ s = UNIONS u`, + EXISTS_TAC + `IMAGE (\(v:real^N,q). ball(v,q)) + ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS + rational)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[COUNTABLE_RATIONAL] THEN MATCH_MP_TAC COUNTABLE_CART THEN + REWRITE_TAC[COUNTABLE_RATIONAL; SET_RULE `{x | P x} = P`]; + REWRITE_TAC[FORALL_IN_IMAGE; CROSS; FORALL_IN_GSPEC; OPEN_BALL]; + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[UNIONS_0; EMPTY_SUBSET]; + ALL_TAC] THEN + EXISTS_TAC `{c | c IN IMAGE (\(v:real^N,q). ball(v,q)) + ({v | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(v$i)} CROSS + rational) /\ c SUBSET s}` THEN + CONJ_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[CROSS; EXISTS_PAIR_THM; EXISTS_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [OPEN_CONTAINS_BALL]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM; SUBSET; IN_BALL] THEN + X_GEN_TAC `e:real` THEN STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + MP_TAC(REWRITE_RULE[EXTENSION; IN_UNIV] CLOSURE_RATIONAL_COORDINATES) THEN + REWRITE_TAC[CLOSURE_APPROACHABLE] THEN + DISCH_THEN(MP_TAC o SPECL [`x:real^N`; `e / &4`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[IN_ELIM_THM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + SUBGOAL_THEN `?x. rational x /\ e / &3 < x /\ x < e / &2` + (X_CHOOSE_THEN `q:real` STRIP_ASSUME_TAC) + THENL + [MP_TAC(ISPECL [`&5 / &12 * e`; `e / &12`] RATIONAL_APPROXIMATION) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC MONO_EXISTS] THEN + SIMP_TAC[] THEN REAL_ARITH_TAC; + EXISTS_TAC `q:real` THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[IN]; + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]);; + +let UNIV_SECOND_COUNTABLE_SEQUENCE = prove + (`?b:num->real^N->bool. + (!m n. b m = b n <=> m = n) /\ + (!n. open(b n)) /\ + (!s. open s ==> ?k. s = UNIONS {b n | n IN k})`, + X_CHOOSE_THEN `bb:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + MP_TAC(ISPEC `bb:(real^N->bool)->bool` COUNTABLE_AS_INJECTIVE_IMAGE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INFINITE] THEN DISCH_TAC THEN + SUBGOAL_THEN + `INFINITE {ball(vec 0:real^N,inv(&n + &1)) | n IN (:num)}` + MP_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC(REWRITE_RULE + [RIGHT_IMP_FORALL_THM; IMP_IMP] INFINITE_IMAGE_INJ) THEN + REWRITE_TAC[num_INFINITE] THEN MATCH_MP_TAC WLOG_LT THEN SIMP_TAC[] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + REWRITE_TAC[EXTENSION] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&n + &1) % basis 1:real^N`) THEN + REWRITE_TAC[IN_BALL; DIST_0; NORM_MUL; REAL_ABS_INV] THEN + SIMP_TAC[NORM_BASIS; DIMINDEX_GE_1; LE_REFL; REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(&n + &1) = &n + &1`; REAL_LT_REFL] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; + REWRITE_TAC[INFINITE; SIMPLE_IMAGE] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE UNIONS {u | u SUBSET bb} :(real^N->bool)->bool` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_POWERSET] THEN + GEN_REWRITE_TAC I [SUBSET] THEN SIMP_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[OPEN_BALL]]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:num->real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN + REPEAT(CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC]) THEN + X_GEN_TAC `s:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:real^N->bool`) THEN + ASM_REWRITE_TAC[SUBSET_IMAGE; LEFT_AND_EXISTS_THM; SUBSET_UNIV] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[SIMPLE_IMAGE]]);; + +let SUBSET_SECOND_COUNTABLE = prove + (`!s:real^N->bool. + ?b. COUNTABLE b /\ + (!c. c IN b ==> ~(c = {}) /\ open_in(subtopology euclidean s) c) /\ + !t. open_in(subtopology euclidean s) t + ==> ?u. u SUBSET b /\ t = UNIONS u`, + GEN_TAC THEN + SUBGOAL_THEN + `?b. COUNTABLE b /\ + (!c:real^N->bool. c IN b ==> open_in(subtopology euclidean s) c) /\ + !t. open_in(subtopology euclidean s) t + ==> ?u. u SUBSET b /\ t = UNIONS u` + STRIP_ASSUME_TAC THENL + [X_CHOOSE_THEN `B:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + EXISTS_TAC `{s INTER c :real^N->bool | c IN B}` THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE] THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_SUBSET_IMAGE; OPEN_IN_OPEN_INTER] THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + X_GEN_TAC `t:real^N->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^N->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN `?b. b SUBSET B /\ u:real^N->bool = UNIONS b` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + EXISTS_TAC `b:(real^N->bool)->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTER_UNIONS] THEN AP_TERM_TAC THEN SET_TAC[]; + EXISTS_TAC `b DELETE ({}:real^N->bool)` THEN + ASM_SIMP_TAC[COUNTABLE_DELETE; IN_DELETE; SUBSET_DELETE] THEN + X_GEN_TAC `t:real^N->bool` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `u:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u DELETE ({}:real^N->bool)` THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNIONS] THEN + GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[IN_DELETE] THEN SET_TAC[]]);; + +let SEPARABLE = prove + (`!s:real^N->bool. + ?t. COUNTABLE t /\ t SUBSET s /\ s SUBSET closure t`, + MP_TAC SUBSET_SECOND_COUNTABLE THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `s:real^N->bool` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; LEFT_AND_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `B:(real^N->bool)->bool` + (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC))) THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `f:(real^N->bool)->real^N` THEN DISCH_TAC THEN + EXISTS_TAC `IMAGE (f:(real^N->bool)->real^N) B` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `c:real^N->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN + REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN ASM SET_TAC[]; + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE; EXISTS_IN_IMAGE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_THEN + `!t:real^N->bool. + open_in (subtopology euclidean s) t + ==> (?u. u SUBSET B /\ t = UNIONS u)` + (MP_TAC o SPEC `s INTER ball(x:real^N,e)`) THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `b:(real^N->bool)->bool` THEN + ASM_CASES_TAC `b:(real^N->bool)->bool = {}` THENL + [MATCH_MP_TAC(TAUT `~b ==> a /\ b ==> c`) THEN + ASM_REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY; UNIONS_0] THEN + ASM_MESON_TAC[CENTRE_IN_BALL]; + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:real^N->bool` THEN + DISCH_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `(f:(real^N->bool)->real^N) c`) THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN REWRITE_TAC[IN_INTER; IN_BALL] THEN + MATCH_MP_TAC(TAUT `a /\ c ==> (a /\ b <=> c) ==> b`) THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real^N->bool`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN + REWRITE_TAC[TOPSPACE_SUBTOPOLOGY; TOPSPACE_EUCLIDEAN] THEN + ASM SET_TAC[]]]);; + +let OPEN_SET_RATIONAL_COORDINATES = prove + (`!s. open s /\ ~(s = {}) + ==> ?x:real^N. x IN s /\ + !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `~(closure { x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) } INTER + (s:real^N->bool) = {})` + MP_TAC THENL + [ASM_REWRITE_TAC[CLOSURE_RATIONAL_COORDINATES; INTER_UNIV]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; CLOSURE_APPROACHABLE; IN_INTER; + IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real^N` o REWRITE_RULE[open_def]) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let OPEN_COUNTABLE_UNION_OPEN_INTERVALS, + OPEN_COUNTABLE_UNION_CLOSED_INTERVALS = (CONJ_PAIR o prove) + (`(!s:real^N->bool. + open s + ==> ?D. COUNTABLE D /\ + (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval(a,b)) /\ + UNIONS D = s) /\ + (!s:real^N->bool. + open s + ==> ?D. COUNTABLE D /\ + (!i. i IN D ==> i SUBSET s /\ ?a b. i = interval[a,b]) /\ + UNIONS D = s)`, + REPEAT STRIP_TAC THENL + [EXISTS_TAC + `{i | i IN IMAGE (\(a:real^N,b). interval(a,b)) + ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS + {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ + i SUBSET s}`; + EXISTS_TAC + `{i | i IN IMAGE (\(a:real^N,b). interval[a,b]) + ({x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)} CROSS + {x | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i)}) /\ + i SUBSET s}`] THEN + (SIMP_TAC[COUNTABLE_RESTRICT; COUNTABLE_IMAGE; COUNTABLE_CROSS; + COUNTABLE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; IMP_CONJ; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM; EXISTS_PAIR_THM; IN_CROSS; IN_ELIM_THM] THEN + CONJ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^N` THEN EQ_TAC THENL [SET_TAC[]; DISCH_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o REWRITE_RULE[open_def]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!i. 1 <= i /\ i <= dimindex(:N) + ==> ?a b. rational a /\ rational b /\ + a < (x:real^N)$i /\ (x:real^N)$i < b /\ + abs(b - a) < e / &(dimindex(:N))` + MP_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC RATIONAL_APPROXIMATION_STRADDLE THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; LE_1; DIMINDEX_GE_1]; + REWRITE_TAC[LAMBDA_SKOLEM]] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `a:real^N` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `b:real^N` THEN + DISCH_TAC THEN ASM_SIMP_TAC[SUBSET; IN_INTERVAL; REAL_LT_IMP_LE] THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[dist] THEN MP_TAC(ISPEC `y - x:real^N` NORM_LE_L1) THEN + MATCH_MP_TAC(REAL_ARITH `s < e ==> n <= s ==> n < e`) THEN + MATCH_MP_TAC SUM_BOUND_LT_GEN THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; CARD_NUMSEG_1] THEN + REWRITE_TAC[DIMINDEX_GE_1; IN_NUMSEG; VECTOR_SUB_COMPONENT] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `k:num`)) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC));; + +let LINDELOF = prove + (`!f:(real^N->bool)->bool. + (!s. s IN f ==> open s) + ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?b. COUNTABLE b /\ + (!c:real^N->bool. c IN b ==> open c) /\ + (!s. open s ==> ?u. u SUBSET b /\ s = UNIONS u)` + STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[UNIV_SECOND_COUNTABLE]; ALL_TAC] THEN + ABBREV_TAC + `d = {s:real^N->bool | s IN b /\ ?u. u IN f /\ s SUBSET u}` THEN + SUBGOAL_THEN + `COUNTABLE d /\ UNIONS f :real^N->bool = UNIONS d` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "d" THEN ASM_SIMP_TAC[COUNTABLE_RESTRICT] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!s:real^N->bool. ?u. s IN d ==> u IN f /\ s SUBSET u` + MP_TAC THENL [EXPAND_TAC "d" THEN SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:(real^N->bool)->(real^N->bool)` THEN STRIP_TAC THEN + EXISTS_TAC `IMAGE (g:(real^N->bool)->(real^N->bool)) d` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; UNIONS_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM SET_TAC[]);; + +let LINDELOF_OPEN_IN = prove + (`!f u:real^N->bool. + (!s. s IN f ==> open_in (subtopology euclidean u) s) + ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_OPEN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `v:(real^N->bool)->real^N->bool` THEN DISCH_TAC THEN + MP_TAC(ISPEC `IMAGE (v:(real^N->bool)->real^N->bool) f` LINDELOF) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `f':(real^N->bool)->bool` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!f'. f' SUBSET f ==> UNIONS f' = (u:real^N->bool) INTER UNIONS (IMAGE v f')` + MP_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[SUBSET_REFL]]);; + +let COUNTABLE_DISJOINT_OPEN_SUBSETS = prove + (`!f. (!s:real^N->bool. s IN f ==> open s) /\ pairwise DISJOINT f + ==> COUNTABLE f`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP LINDELOF) THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `({}:real^N->bool) INSERT g` THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT] THEN + REWRITE_TAC[SUBSET; IN_INSERT] THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[EXTENSION; SUBSET] THEN + REWRITE_TAC[IN_UNIONS; pairwise] THEN + REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. ~(x IN s /\ x IN t)`] THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let CARD_EQ_OPEN_SETS = prove + (`{s:real^N->bool | open s} =_c (:real)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + TRANS_TAC CARD_LE_TRANS `{s:(real^N->bool)->bool | s SUBSET b}` THEN + CONJ_TAC THENL + [REWRITE_TAC[LE_C] THEN + EXISTS_TAC `UNIONS:((real^N->bool)->bool)->real^N->bool` THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + TRANS_TAC CARD_LE_TRANS `{s | s SUBSET (:num)}` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_LE_POWERSET THEN ASM_REWRITE_TAC[GSYM COUNTABLE_ALT]; + REWRITE_TAC[SUBSET_UNIV; UNIV_GSPEC] THEN + MESON_TAC[CARD_EQ_IMP_LE; CARD_EQ_SYM; CARD_EQ_REAL]]]; + REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN + EXISTS_TAC `\x. ball(x % basis 1:real^N,&1)` THEN + REWRITE_TAC[OPEN_BALL; GSYM SUBSET_ANTISYM_EQ; SUBSET_BALLS] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[NORM_ARITH `dist(p:real^N,q) + &1 <= &1 <=> p = q`] THEN + REWRITE_TAC[VECTOR_MUL_RCANCEL; EQ_SYM_EQ] THEN + SIMP_TAC[BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; + +let CARD_EQ_CLOSED_SETS = prove + (`{s:real^N->bool | closed s} =_c (:real)`, + SUBGOAL_THEN + `{s:real^N->bool | closed s} = + IMAGE (\s. (:real^N) DIFF s) {s | open s}` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_ELIM_THM; GSYM OPEN_CLOSED] THEN + MESON_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`]; + TRANS_TAC CARD_EQ_TRANS `{s:real^N->bool | open s}` THEN + REWRITE_TAC[CARD_EQ_OPEN_SETS] THEN + MATCH_MP_TAC CARD_EQ_IMAGE THEN SET_TAC[]]);; + +let CARD_EQ_COMPACT_SETS = prove + (`{s:real^N->bool | compact s} =_c (:real)`, + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `{s:real^N->bool | closed s}` THEN + SIMP_TAC[CARD_EQ_IMP_LE; CARD_EQ_CLOSED_SETS] THEN + MATCH_MP_TAC CARD_LE_SUBSET THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; COMPACT_IMP_CLOSED]; + REWRITE_TAC[le_c; IN_UNIV; IN_ELIM_THM] THEN + EXISTS_TAC `\x. {x % basis 1:real^N}` THEN + REWRITE_TAC[COMPACT_SING; SET_RULE `{x} = {y} <=> x = y`] THEN + SIMP_TAC[VECTOR_MUL_RCANCEL; BASIS_NONZERO; DIMINDEX_GE_1; ARITH]]);; + +let COUNTABLE_NON_CONDENSATION_POINTS = prove + (`!s:real^N->bool. COUNTABLE(s DIFF {x | x condensation_point_of s})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[condensation_point_of] THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + X_CHOOSE_THEN `b:(real^N->bool)->bool` STRIP_ASSUME_TAC + UNIV_SECOND_COUNTABLE THEN + EXISTS_TAC + `s INTER UNIONS { u:real^N->bool | u IN b /\ COUNTABLE(s INTER u)}` THEN + REWRITE_TAC[INTER_UNIONS; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_UNIONS THEN SIMP_TAC[FORALL_IN_GSPEC] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; COUNTABLE_RESTRICT]; + SIMP_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_INTER; IN_DIFF] THEN + X_GEN_TAC `x:real^N` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `?u:real^N->bool. x IN u /\ u IN b /\ u SUBSET t` MP_TAC THENL + [ASM SET_TAC[]; MATCH_MP_TAC MONO_EXISTS] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `s INTER t:real^N->bool` THEN ASM SET_TAC[]]);; + +let CARD_EQ_CONDENSATION_POINTS_IN_SET = prove + (`!s:real^N->bool. + ~(COUNTABLE s) ==> {x | x IN s /\ x condensation_point_of s} =_c s`, + REPEAT STRIP_TAC THEN + TRANS_TAC CARD_EQ_TRANS + `(s DIFF {x | x condensation_point_of s}) +_c + {x:real^N | x IN s /\ x condensation_point_of s}` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN MATCH_MP_TAC CARD_ADD_ABSORB THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o CONJ (SPEC `s:real^N->bool` + COUNTABLE_NON_CONDENSATION_POINTS) o MATCH_MP FINITE_IMP_COUNTABLE) THEN + REWRITE_TAC[GSYM COUNTABLE_UNION] THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN SET_TAC[]; + REWRITE_TAC[INFINITE_CARD_LE] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS) THEN + REWRITE_TAC[GSYM COUNTABLE_ALT; COUNTABLE_NON_CONDENSATION_POINTS]]; + ONCE_REWRITE_TAC[CARD_EQ_SYM] THEN + W(MP_TAC o PART_MATCH (rand o rand) CARD_DISJOINT_UNION o rand o snd) THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]]);; + +let LIMPT_OF_CONDENSATION_POINTS,CONDENSATION_POINT_OF_CONDENSATION_POINTS = + (CONJ_PAIR o prove) + (`(!x:real^N s. + x limit_point_of {y | y condensation_point_of s} <=> + x condensation_point_of s) /\ + (!x:real^N s. + x condensation_point_of {y | y condensation_point_of s} <=> + x condensation_point_of s)`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(r ==> q) /\ (q ==> p) /\ (p ==> r) + ==> (q <=> p) /\ (r <=> p)`) THEN + REWRITE_TAC[CONDENSATION_POINT_IMP_LIMPT] THEN CONJ_TAC THENL + [REWRITE_TAC[LIMPT_APPROACHABLE; CONDENSATION_POINT_INFINITE_BALL] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + SIMP_TAC[SUBSET; IN_INTER; IN_BALL] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + ONCE_REWRITE_TAC[CONDENSATION_POINT_INFINITE_BALL] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN DISCH_THEN(MP_TAC o MATCH_MP + (MESON[CARD_EQ_CONDENSATION_POINTS_IN_SET; CARD_COUNTABLE_CONG] + `~COUNTABLE s + ==> ~COUNTABLE {x | x IN s /\ x condensation_point_of s}`)) THEN + REWRITE_TAC[UNCOUNTABLE_REAL; CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INTER] THEN X_GEN_TAC `y:real^N` THEN + REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[CONDENSATION_POINT_OF_SUBSET; INTER_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(SET_RULE `!s. x IN s /\ s SUBSET t ==> x IN t`) THEN + EXISTS_TAC `closure(s INTER ball(x:real^N,e / &2))` THEN CONJ_TAC THENL + [REWRITE_TAC[closure; IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN + ASM_SIMP_TAC[CONDENSATION_POINT_IMP_LIMPT]; + TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_BALL; REAL_HALF; SUBSET_BALLS; DIST_REFL] THEN + ASM_REAL_ARITH_TAC]]);; + +let CLOSED_CONDENSATION_POINTS = prove + (`!s:real^N->bool. closed {x | x condensation_point_of s}`, + SIMP_TAC[CLOSED_LIMPT; LIMPT_OF_CONDENSATION_POINTS; IN_ELIM_THM]);; + +let CANTOR_BENDIXSON = prove + (`!s:real^N->bool. + closed s + ==> ?t u. closed t /\ (!x. x IN t ==> x limit_point_of t) /\ + COUNTABLE u /\ s = t UNION u`, + REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`{x:real^N | x condensation_point_of s}`; + `s DIFF {x:real^N | x condensation_point_of s}`] THEN + REWRITE_TAC[COUNTABLE_NON_CONDENSATION_POINTS; CLOSED_CONDENSATION_POINTS; + IN_ELIM_THM; LIMPT_OF_CONDENSATION_POINTS] THEN + REWRITE_TAC[SET_RULE `s = t UNION (s DIFF t) <=> t SUBSET s`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[CLOSED_LIMPT]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + ASM_MESON_TAC[CONDENSATION_POINT_IMP_LIMPT]);; + +(* ------------------------------------------------------------------------- *) +(* A discrete set is countable, and an uncountable set has a limit point. *) +(* ------------------------------------------------------------------------- *) + +let DISCRETE_IMP_COUNTABLE = prove + (`!s:real^N->bool. + (!x. x IN s ==> ?e. &0 < e /\ + !y. y IN s /\ ~(y = x) ==> e <= norm(y - x)) + ==> COUNTABLE s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN s + ==> ?q. (!i. 1 <= i /\ i <= dimindex(:N) ==> rational(q$i)) /\ + !y:real^N. y IN s /\ ~(y = x) ==> norm(x - q) < norm(y - q)` + MP_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SET_RULE `x IN (:real^N)`) THEN + REWRITE_TAC[GSYM CLOSURE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[CLOSURE_APPROACHABLE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:real^N` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^N` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^N`) THEN ASM_REWRITE_TAC[] THEN + REPEAT(POP_ASSUM MP_TAC) THEN NORM_ARITH_TAC; + POP_ASSUM(K ALL_TAC) THEN + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `q:real^N->real^N` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`s:real^N->bool`; + `{ x:real^N | !i. 1 <= i /\ i <= dimindex(:N) ==> rational(x$i) }`; + `(:num)`] CARD_LE_TRANS) THEN + REWRITE_TAC[COUNTABLE; ge_c] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[REWRITE_RULE[COUNTABLE; ge_c] COUNTABLE_RATIONAL_COORDINATES] THEN + REWRITE_TAC[le_c] THEN EXISTS_TAC `q:real^N->real^N` THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[REAL_LT_ANTISYM]]);; + +let UNCOUNTABLE_CONTAINS_LIMIT_POINT = prove + (`!s. ~(COUNTABLE s) ==> ?x. x IN s /\ x limit_point_of s`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] DISCRETE_IMP_COUNTABLE)) THEN + REWRITE_TAC[LIMPT_APPROACHABLE; GSYM REAL_NOT_LT; dist] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The Brouwer reduction theorem. *) +(* ------------------------------------------------------------------------- *) + +let BROUWER_REDUCTION_THEOREM_GEN = prove + (`!P s:real^N->bool. + (!f. (!n. closed(f n) /\ P(f n)) /\ (!n. f(SUC n) SUBSET f(n)) + ==> P(INTERS {f n | n IN (:num)})) /\ + closed s /\ P s + ==> ?t. t SUBSET s /\ closed t /\ P t /\ + (!u. u SUBSET s /\ closed u /\ P u ==> ~(u PSUBSET t))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?b:num->real^N->bool. + (!m n. b m = b n <=> m = n) /\ + (!n. open (b n)) /\ + (!s. open s ==> (?k. s = UNIONS {b n | n IN k}))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[UNIV_SECOND_COUNTABLE_SEQUENCE]; ALL_TAC] THEN + X_CHOOSE_THEN `a:num->real^N->bool` MP_TAC + (prove_recursive_functions_exist num_RECURSION + `a 0 = (s:real^N->bool) /\ + (!n. a(SUC n) = + if ?u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} + then @u. u SUBSET a(n) /\ closed u /\ P u /\ u INTER (b n) = {} + else a(n))`) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "base") (LABEL_TAC "step")) THEN + EXISTS_TAC `INTERS {a n :real^N->bool | n IN (:num)}` THEN + SUBGOAL_THEN `!n. (a:num->real^N->bool)(SUC n) SUBSET a(n)` ASSUME_TAC THENL + [GEN_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. (a:num->real^N->bool) n SUBSET s` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_MESON_TAC[SUBSET_REFL; SUBSET_TRANS]; ALL_TAC] THEN + SUBGOAL_THEN `!n. closed((a:num->real^N->bool) n) /\ P(a n)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN MESON_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CLOSED_INTERS THEN + ASM_REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + REWRITE_TAC[PSUBSET_ALT] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[INTERS_GSPEC; EXISTS_IN_GSPEC; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real^N` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?n. x IN (b:num->real^N->bool)(n) /\ t INTER b n = {}` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `(:real^N) DIFF t` OPEN_CONTAINS_BALL) THEN + ASM_REWRITE_TAC[GSYM closed] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV; LEFT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SET_RULE `s SUBSET UNIV DIFF t <=> t INTER s = {}`] THEN + X_GEN_TAC `e:real` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(ISPECL [`x:real^N`; `e:real`] CENTRE_IN_BALL) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ball(x:real^N,e)`) THEN + ASM_REWRITE_TAC[OPEN_BALL; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `k:num->bool` THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[IN_UNIONS; INTER_UNIONS; EMPTY_UNIONS; FORALL_IN_GSPEC] THEN + SET_TAC[]; + REMOVE_THEN "step" (MP_TAC o SPEC `n:num`) THEN + COND_CASES_TAC THENL + [DISCH_THEN(ASSUME_TAC o SYM) THEN + FIRST_X_ASSUM(MP_TAC o SELECT_RULE) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOT_EXISTS_THM]) THEN + DISCH_THEN(MP_TAC o SPEC `t:real^N->bool`) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]]]);; + +let BROUWER_REDUCTION_THEOREM = prove + (`!P s:real^N->bool. + (!f. (!n. compact(f n) /\ ~(f n = {}) /\ P(f n)) /\ + (!n. f(SUC n) SUBSET f(n)) + ==> P(INTERS {f n | n IN (:num)})) /\ + compact s /\ ~(s = {}) /\ P s + ==> ?t. t SUBSET s /\ compact t /\ ~(t = {}) /\ P t /\ + (!u. u SUBSET s /\ closed u /\ ~(u = {}) /\ P u + ==> ~(u PSUBSET t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t:real^N->bool. ~(t = {}) /\ t SUBSET s /\ P t`; + `s:real^N->bool`] + BROUWER_REDUCTION_THEOREM_GEN) THEN + ASM_SIMP_TAC[COMPACT_IMP_CLOSED; SUBSET_REFL] THEN ANTS_TAC THENL + [GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. compact((f:num->real^N->bool) n)` ASSUME_TAC THENL + [ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COMPACT_NEST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN ASM_SIMP_TAC[] THEN SET_TAC[]; + ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[COMPACT_EQ_BOUNDED_CLOSED; BOUNDED_SUBSET]]);; + +(* ------------------------------------------------------------------------- *) +(* The Arzela-Ascoli theorem. *) +(* ------------------------------------------------------------------------- *) + +let SUBSEQUENCE_DIAGONALIZATION_LEMMA = prove + (`!P:num->(num->A)->bool. + (!i r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ P i (r o k)) /\ + (!i r:num->A k1 k2 N. + P i (r o k1) /\ (!j. N <= j ==> ?j'. j <= j' /\ k2 j = k1 j') + ==> P i (r o k2)) + ==> !r:num->A. ?k. (!m n. m < n ==> k m < k n) /\ (!i. P i (r o k))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [SKOLEM_THM] THEN + REWRITE_TAC[FORALL_AND_THM; TAUT + `(p ==> q /\ r) <=> (p ==> q) /\ (p ==> r)`] THEN + DISCH_THEN(X_CHOOSE_THEN + `kk:num->(num->A)->num->num` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `r:num->A` THEN + (STRIP_ASSUME_TAC o prove_recursive_functions_exist num_RECURSION) + `(rr 0 = (kk:num->(num->A)->num->num) 0 r) /\ + (!n. rr(SUC n) = rr n o kk (SUC n) (r o rr n))` THEN + EXISTS_TAC `\n. (rr:num->num->num) n n` THEN REWRITE_TAC[ETA_AX] THEN + SUBGOAL_THEN + `(!i. (!m n. m < n ==> (rr:num->num->num) i m < rr i n)) /\ + (!i. (P:num->(num->A)->bool) i (r o rr i))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[AND_FORALL_THM] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[o_ASSOC] THEN + REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!i j n. i <= j ==> (rr:num->num->num) i n <= rr j n` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [LE_EXISTS] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN SPEC_TAC(`j:num`,`j:num`) THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN SIMP_TAC[FORALL_UNWIND_THM2] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] LE_TRANS)) THEN REWRITE_TAC[o_THM] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP + (MESON[LE_LT] + `!f:num->num. + (!m n. m < n ==> f m < f n) ==> (!m n. m <= n ==> f m <= f n)`) o + SPEC `i + d:num`) THEN + SPEC_TAC(`n:num`,`n:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN DISCH_TAC THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `(rr:num->num->num) n m` THEN + ASM_MESON_TAC[LT_IMP_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n i. n <= m ==> ?j. i <= j /\ (rr:num->num->num) m i = rr n j` + ASSUME_TAC THENL + [ALL_TAC; + X_GEN_TAC `i:num` THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `(rr:num->num->num) i` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `i:num` THEN ASM_MESON_TAC[]] THEN + SUBGOAL_THEN + `!p d i. ?j. i <= j /\ (rr:num->num->num) (p + d) i = rr p j` + (fun th -> MESON_TAC[LE_EXISTS; th]) THEN + X_GEN_TAC `p:num` THEN MATCH_MP_TAC num_INDUCTION THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN CONJ_TAC THENL + [MESON_TAC[LE_REFL]; ALL_TAC] THEN + X_GEN_TAC `d:num` THEN DISCH_THEN(LABEL_TAC "+") THEN + X_GEN_TAC `i:num` THEN ASM_REWRITE_TAC[o_THM] THEN + REMOVE_THEN "+" (MP_TAC o SPEC + `(kk:num->(num->A)->num->num) (SUC(p + d)) + ((r:num->A) o (rr:num->num->num) (p + d)) i`) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `j:num` THEN + MATCH_MP_TAC MONO_AND THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN + SPEC_TAC(`i:num`,`i:num`) THEN MATCH_MP_TAC MONOTONE_BIGGER THEN + ASM_REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]);; + +let FUNCTION_CONVERGENT_SUBSEQUENCE = prove + (`!f:num->real^M->real^N s M. + COUNTABLE s /\ (!n x. x IN s ==> norm(f n x) <= M) + ==> ?k. (!m n:num. m < n ==> k m < k n) /\ + !x. x IN s ==> ?l. ((\n. f (k n) x) --> l) sequentially`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^M->bool = {}` THENL + [EXISTS_TAC `\n:num. n` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + MP_TAC(ISPEC `s:real^M->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `X:num->real^M` THEN DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(ISPEC + `\i r. ?l. ((\n. ((f:num->real^M->real^N) o (r:num->num)) n + ((X:num->real^M) i)) --> l) sequentially` + SUBSEQUENCE_DIAGONALIZATION_LEMMA) THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_THM; IN_UNIV] THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN MATCH_ACCEPT_TAC] THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN + MAP_EVERY X_GEN_TAC [`i:num`; `r:num->num`] THEN + MP_TAC(ISPEC `cball(vec 0:real^N,M)` compact) THEN + REWRITE_TAC[COMPACT_CBALL] THEN DISCH_THEN(MP_TAC o SPEC + `\n. (f:num->real^M->real^N) ((r:num->num) n) (X(i:num))`) THEN + ASM_REWRITE_TAC[IN_CBALL_0; o_DEF] THEN MESON_TAC[]; + REPEAT GEN_TAC THEN REWRITE_TAC[LIM_SEQUENTIALLY; GE] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[LE_TRANS; ARITH_RULE `MAX a b <= c <=> a <= c /\ b <= c`]]);; + +let ARZELA_ASCOLI = prove + (`!f:num->real^M->real^N s M. + compact s /\ + (!n x. x IN s ==> norm(f n x) <= M) /\ + (!x e. x IN s /\ &0 < e + ==> ?d. &0 < d /\ + !n y. y IN s /\ norm(x - y) < d + ==> norm(f n x - f n y) < e) + ==> ?g. g continuous_on s /\ + ?r. (!m n:num. m < n ==> r m < r n) /\ + !e. &0 < e + ==> ?N. !n x. n >= N /\ x IN s + ==> norm(f(r n) x - g x) < e`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GE] THEN + MATCH_MP_TAC(MESON[] + `(!k g. V k g ==> N g) /\ (?k. M k /\ ?g. V k g) + ==> ?g. N g /\ ?k. M k /\ V k g`) THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:num->num`; `g:real^M->real^N`] THEN + STRIP_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` + CONTINUOUS_UNIFORM_LIMIT) THEN + EXISTS_TAC `(f:num->real^M->real^N) o (k:num->num)` THEN + ASM_SIMP_TAC[EVENTUALLY_SEQUENTIALLY; o_THM; TRIVIAL_LIMIT_SEQUENTIALLY; + RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[continuous_on; dist] THEN + ASM_MESON_TAC[NORM_SUB]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`IMAGE (f:num->real^M->real^N) (:num)`; + `s:real^M->bool`] + COMPACT_UNIFORMLY_EQUICONTINUOUS) THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE; IN_UNIV] THEN + ANTS_TAC THENL + [REWRITE_TAC[dist] THEN ONCE_REWRITE_TAC[NORM_SUB] THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(K ALL_TAC o SPEC `x:real^M`)] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC; dist] THEN + DISCH_THEN(ASSUME_TAC o ONCE_REWRITE_RULE[NORM_SUB]) THEN + REWRITE_TAC[GSYM dist; UNIFORMLY_CONVERGENT_EQ_CAUCHY] THEN + X_CHOOSE_THEN `r:real^M->bool` STRIP_ASSUME_TAC + (ISPEC `s:real^M->bool` SEPARABLE) THEN + MP_TAC(ISPECL [`f:num->real^M->real^N`; `r:real^M->bool`; `M:real`] + FUNCTION_CONVERGENT_SUBSEQUENCE) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `k:num->num` THEN + REWRITE_TAC[CONVERGENT_EQ_CAUCHY; cauchy] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "*")) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [COMPACT_EQ_HEINE_BOREL]) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\x:real^M. ball(x,d)) r`) THEN + REWRITE_TAC[FORALL_IN_IMAGE; OPEN_BALL] THEN + ONCE_REWRITE_TAC[TAUT `a /\ b /\ c <=> b /\ a /\ c`] THEN + REWRITE_TAC[EXISTS_FINITE_SUBSET_IMAGE] THEN ANTS_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `closure r:real^M->bool` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real^M` THEN DISCH_THEN(MP_TAC o SPEC `d:real`) THEN + ASM_REWRITE_TAC[UNIONS_IMAGE; IN_ELIM_THM; IN_BALL]; + DISCH_THEN(X_CHOOSE_THEN `t:real^M->bool` STRIP_ASSUME_TAC)] THEN + REMOVE_THEN "*" MP_TAC THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + GEN_REWRITE_TAC LAND_CONV [SWAP_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < e / &3 <=> &0 < e`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `M:real^M->num` THEN DISCH_THEN(LABEL_TAC "*") THEN + MP_TAC(ISPECL [`M:real^M->num`; `t:real^M->bool`] + UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:real^M`] THEN STRIP_TAC THEN + UNDISCH_TAC `s SUBSET UNIONS (IMAGE (\x:real^M. ball (x,d)) t)` THEN + REWRITE_TAC[SUBSET; UNIONS_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^M`) THEN + ASM_REWRITE_TAC[IN_BALL; LEFT_IMP_EXISTS_THM; dist] THEN + X_GEN_TAC `y:real^M` THEN STRIP_TAC THEN + MATCH_MP_TAC(NORM_ARITH + `norm(f (k(m:num)) y - f (k m) x) < e / &3 /\ + norm(f (k n) y - f (k n) x) < e / &3 /\ + norm(f (k m) y - f (k n) y) < e / &3 + ==> norm(f (k m) x - f (k n) x :real^M) < e`) THEN + ASM_SIMP_TAC[] THEN REMOVE_THEN "*" (MP_TAC o SPEC `y:real^M`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `n:num`]) THEN + ASM_REWRITE_TAC[dist; GE] THEN ASM_MESON_TAC[SUBSET; LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Two forms of the Baire propery of dense sets. *) +(* ------------------------------------------------------------------------- *) + +let BAIRE = prove + (`!g s:real^N->bool. + closed s /\ COUNTABLE g /\ + (!t. t IN g + ==> open_in (subtopology euclidean s) t /\ s SUBSET closure t) + ==> s SUBSET closure(INTERS g)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `g:(real^N->bool)->bool = {}` THEN + ASM_REWRITE_TAC[INTERS_0; CLOSURE_UNIV; SUBSET_UNIV] THEN + MP_TAC(ISPEC `g:(real^N->bool)->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY (C UNDISCH_THEN (K ALL_TAC)) + [`COUNTABLE(g:(real^N->bool)->bool)`; + `~(g:(real^N->bool)->bool = {})`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real^N->bool` SUBST_ALL_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[FORALL_IN_IMAGE; IN_UNIV]) THEN + REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + REWRITE_TAC[GSYM IN_BALL; GSYM IN_INTER; MEMBER_NOT_EMPTY] THEN + SUBGOAL_THEN + `?t:num->real^N->bool. + (!n. open_in (subtopology euclidean s) (t n) /\ ~(t n = {}) /\ + s INTER closure(t n) SUBSET g n /\ + closure(t n) SUBSET ball(x,e)) /\ + (!n. t(SUC n) SUBSET t n)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `!u n. open_in (subtopology euclidean s) u /\ ~(u = {}) /\ + closure u SUBSET ball(x,e) + ==> ?y. open_in (subtopology euclidean s) y /\ + ~(y = {}) /\ + s INTER closure y SUBSET (g:num->real^N->bool) n /\ + closure y SUBSET ball(x,e) /\ + y SUBSET u` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:real^N->bool`; `n:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `?y:real^N. y IN u /\ y IN g(n:num)` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o SPEC `n:num`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP OPEN_IN_IMP_SUBSET) THEN + DISCH_THEN(X_CHOOSE_THEN `y:real^N` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [open_in]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `d:real` THEN + STRIP_TAC THEN REWRITE_TAC[SUBSET; CLOSURE_APPROACHABLE] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `open_in (subtopology euclidean s) (u INTER g(n:num):real^N->bool)` + MP_TAC THENL [ASM_SIMP_TAC[OPEN_IN_INTER]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [OPEN_IN_CONTAINS_BALL] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `y:real^N`)) THEN + ASM_REWRITE_TAC[IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s INTER ball(y:real^N,d / &2)` THEN + SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `y:real^N` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b SUBSET u INTER g ==> !s. s SUBSET b ==> s SUBSET g`)) THEN + MATCH_MP_TAC(SET_RULE + `closure(s INTER b) SUBSET closure b /\ closure b SUBSET c + ==> s INTER closure(s INTER b) SUBSET c INTER s`) THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN + ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + SUBSET_TRANS)) THEN MATCH_MP_TAC SUBSET_CLOSURE; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `b INTER s SUBSET u INTER g ==> c SUBSET b + ==> s INTER c SUBSET u`)) THEN + REWRITE_TAC[SUBSET_BALLS; DIST_REFL] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC DEPENDENT_CHOICE THEN ASM_SIMP_TAC[GSYM CONJ_ASSOC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s INTER ball(x:real^N,e / &2)`; `0`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; GSYM MEMBER_NOT_EMPTY] THEN + ANTS_TAC THENL [REWRITE_TAC[LEFT_AND_EXISTS_THM]; MESON_TAC[]] THEN + EXISTS_TAC `x:real^N` THEN + ASM_REWRITE_TAC[CENTRE_IN_BALL; REAL_HALF; IN_INTER] THEN + TRANS_TAC SUBSET_TRANS `closure(ball(x:real^N,e / &2))` THEN + SIMP_TAC[SUBSET_CLOSURE; INTER_SUBSET] THEN + ASM_SIMP_TAC[CLOSURE_BALL; SUBSET_BALLS; REAL_HALF; DIST_REFL] THEN + ASM_REAL_ARITH_TAC]; + MP_TAC(ISPEC + `(\n. s INTER closure(t n)):num->real^N->bool` COMPACT_NEST) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CLOSED_INTER_COMPACT THEN + ASM_MESON_TAC[BOUNDED_SUBSET; BOUNDED_BALL; COMPACT_EQ_BOUNDED_CLOSED; + CLOSED_CLOSURE]; + GEN_TAC THEN MATCH_MP_TAC(SET_RULE + `~(t = {}) /\ t SUBSET s /\ t SUBSET closure t + ==> ~(s INTER closure t = {})`) THEN + ASM_MESON_TAC[CLOSURE_SUBSET; OPEN_IN_IMP_SUBSET]; + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + ASM_SIMP_TAC[SUBSET_CLOSURE; SET_RULE + `t SUBSET u ==> s INTER t SUBSET s INTER u`] THEN + SET_TAC[]]; + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> ~(s = {}) ==> ~(t = {})`) THEN + REWRITE_TAC[SUBSET_INTER] THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + ASM SET_TAC[]]]);; + +let BAIRE_ALT = prove + (`!g s:real^N->bool. + closed s /\ ~(s = {}) /\ COUNTABLE g /\ UNIONS g = s + ==> ?t u. t IN g /\ open_in (subtopology euclidean s) u /\ + u SUBSET (closure t)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`IMAGE (\t:real^N->bool. s DIFF closure t) g`; `s:real^N->bool`] BAIRE) THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC(TAUT `~q /\ (~r ==> p) ==> (p ==> q) ==> r`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `~(s = {}) /\ (t = {} ==> closure t = {}) /\ t = {} + ==> ~(s SUBSET closure t)`) THEN + ASM_SIMP_TAC[CLOSURE_EMPTY] THEN + MATCH_MP_TAC(SET_RULE `i SUBSET s /\ s DIFF i = s ==> i = {}`) THEN + CONJ_TAC THENL [REWRITE_TAC[INTERS_IMAGE] THEN ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[DIFF_INTERS] THEN + REWRITE_TAC[SET_RULE `{f x | x IN IMAGE g s} = {f(g x) | x IN s}`] THEN + REWRITE_TAC[SET_RULE `s DIFF (s DIFF t) = s INTER t`] THEN + REWRITE_TAC[SET_RULE `{s INTER closure t | t IN g} = + {s INTER t | t IN IMAGE closure g}`] THEN + SIMP_TAC[GSYM INTER_UNIONS; SET_RULE `s INTER t = s <=> s SUBSET t`] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_ID] THEN + MATCH_MP_TAC UNIONS_MONO_IMAGE THEN REWRITE_TAC[CLOSURE_SUBSET]; + REWRITE_TAC[NOT_EXISTS_THM] THEN STRIP_TAC THEN + X_GEN_TAC `t:real^N->bool` THEN REPEAT STRIP_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s DIFF (s INTER t)`] THEN + MATCH_MP_TAC OPEN_IN_DIFF THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; CLOSED_CLOSURE; OPEN_IN_REFL]; + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[CLOSURE_APPROACHABLE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`t:real^N->bool`; `s INTER ball(x:real^N,e)`]) THEN + ASM_SIMP_TAC[OPEN_IN_OPEN_INTER; OPEN_BALL; SUBSET; IN_INTER; IN_BALL; + IN_DIFF] THEN + MESON_TAC[DIST_SYM]]]);; + +(* ------------------------------------------------------------------------- *) +(* Several variants of paracompactness. *) +(* ------------------------------------------------------------------------- *) + +let PARACOMPACT = prove + (`!s c. (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c + ==> ?c'. s SUBSET UNIONS c' /\ + (!u. u IN c' + ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ + (!x. x IN s + ==> ?v. open v /\ x IN v /\ + FINITE {u | u IN c' /\ ~(u INTER v = {})})`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `s:real^N->bool = {}` THENL + [EXISTS_TAC `{}:(real^N->bool)->bool` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET; NOT_IN_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN s + ==> ?t u. x IN u /\ open u /\ closure u SUBSET t /\ t IN c` + MP_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N` o GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_UNIONS] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `t:real^N->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real^N->bool`) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [OPEN_CONTAINS_CBALL] THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ball(x:real^N,e)` THEN + ASM_SIMP_TAC[OPEN_BALL; CENTRE_IN_BALL; CLOSURE_BALL]; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; SKOLEM_THM] THEN + MAP_EVERY X_GEN_TAC + [`f:real^N->real^N->bool`; `e:real^N->real^N->bool`] THEN + STRIP_TAC] THEN + MP_TAC(ISPEC `IMAGE (e:real^N->real^N->bool) s` LINDELOF) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q /\ r <=> q /\ p /\ r`] THEN + REWRITE_TAC[EXISTS_COUNTABLE_SUBSET_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_CASES_TAC `k:real^N->bool = {}` THENL + [ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `k:real^N->bool` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num->real^N` SUBST_ALL_TAC) THEN + STRIP_TAC THEN EXISTS_TAC + `{ f(a n:real^N) DIFF UNIONS {closure(e(a m)):real^N->bool | m < n} | + n IN (:num)}` THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC OPEN_DIFF THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CLOSED_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC; CLOSED_CLOSURE] THEN + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT]; + EXISTS_TAC `f((a:num->real^N) n):real^N->bool` THEN ASM SET_TAC[]]; + REWRITE_TAC[SUBSET; UNIONS_GSPEC; IN_ELIM_THM; IN_DIFF] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + SUBGOAL_THEN `?n. x IN (f((a:num->real^N) n):real^N->bool)` MP_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:num` THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(a:num->real^N) n`) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]; + GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + MATCH_MP_TAC MONO_EXISTS THEN ASM SET_TAC[]]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[UNIONS_IMAGE; EXISTS_IN_IMAGE]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EXTENSION]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(MP_TAC o snd o EQ_IMP_RULE) THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `e((a:num->real^N) n):real^N->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SET_RULE + `{u | (?n. u = f n) /\ P u} = IMAGE f {n |n| P(f n) /\ n IN (:num)}`] THEN + MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `m:num` THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN + MATCH_MP_TAC(SET_RULE `u SUBSET t ==> (s DIFF t) INTER u = {}`) THEN + REWRITE_TAC[SUBSET; IN_UNIONS; EXISTS_IN_GSPEC] THEN + ASM_MESON_TAC[CLOSURE_SUBSET; SUBSET]]);; + +let PARACOMPACT_CLOSED_IN = prove + (`!u:real^N->bool s c. + closed_in (subtopology euclidean u) s /\ + (!t:real^N->bool. t IN c ==> open_in (subtopology euclidean u) t) /\ + s SUBSET UNIONS c + ==> ?c'. s SUBSET UNIONS c' /\ + (!v. v IN c' + ==> open_in (subtopology euclidean u) v /\ + ?t. t IN c /\ v SUBSET t) /\ + (!x. x IN u + ==> ?v. open_in (subtopology euclidean u) v /\ x IN v /\ + FINITE {n | n IN c' /\ ~(n INTER v = {})})`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `uu:(real^N->bool)->(real^N->bool)` THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [CLOSED_IN_CLOSED]) THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^N->bool` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + MP_TAC(ISPECL + [`u:real^N->bool`; + `((:real^N) DIFF k) INSERT IMAGE (uu:(real^N->bool)->(real^N->bool)) c`] + PARACOMPACT) THEN + ASM_SIMP_TAC[FORALL_IN_IMAGE; UNIONS_IMAGE; UNIONS_INSERT; FORALL_IN_INSERT; + EXISTS_IN_IMAGE; EXISTS_IN_INSERT; GSYM closed] THEN + ANTS_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(real^N->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{u INTER v:real^N->bool | v IN d /\ ~(v INTER k = {})}` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC] THEN ASM SET_TAC[]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM SET_TAC[]; + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real^N->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `u INTER v:real^N->bool` THEN ASM_REWRITE_TAC[IN_INTER] THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SET_RULE + `{y | y IN {f x | P x} /\ Q y} = IMAGE f {x | P x /\ Q(f x)}`] THEN + MATCH_MP_TAC FINITE_IMAGE THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN SET_TAC[]]);; + +let PARACOMPACT_CLOSED = prove + (`!s:real^N->bool c. + closed s /\ (!t:real^N->bool. t IN c ==> open t) /\ s SUBSET UNIONS c + ==> ?c'. s SUBSET UNIONS c' /\ + (!u. u IN c' ==> open u /\ ?t. t IN c /\ u SUBSET t) /\ + (!x. ?v. open v /\ x IN v /\ + FINITE {u | u IN c' /\ ~(u INTER v = {})})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^N)`; `s:real^N->bool`; `c:(real^N->bool)->bool`] + PARACOMPACT_CLOSED_IN) THEN + ASM_REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; GSYM CLOSED_IN; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Partitions of unity subordinate to locally finite open coverings. *) +(* ------------------------------------------------------------------------- *) + +let SUBORDINATE_PARTITION_OF_UNITY = prove + (`!c s. s SUBSET UNIONS c /\ (!u. u IN c ==> open u) /\ + (!x. x IN s + ==> ?v. open v /\ x IN v /\ + FINITE {u | u IN c /\ ~(u INTER v = {})}) + ==> ?f:(real^N->bool)->real^N->real. + (!u. u IN c + ==> (lift o f u) continuous_on s /\ + !x. x IN s ==> &0 <= f u x) /\ + (!x u. u IN c /\ x IN s /\ ~(x IN u) ==> f u x = &0) /\ + (!x. x IN s ==> sum c (\u. f u x) = &1) /\ + (!x. x IN s + ==> ?n. open n /\ x IN n /\ + FINITE {u | u IN c /\ + ~(!x. x IN n ==> f u x = &0)})`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?u:real^N->bool. u IN c /\ s SUBSET u` THENL + [FIRST_X_ASSUM(CHOOSE_THEN STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\v:real^N->bool x:real^N. if v = u then &1 else &0` THEN + REWRITE_TAC[COND_RAND; COND_RATOR; o_DEF; REAL_POS; + REAL_OF_NUM_EQ; ARITH_EQ; + MESON[] `(if p then q else T) <=> p ==> q`] THEN + ASM_SIMP_TAC[CONTINUOUS_ON_CONST; COND_ID; SUM_DELTA] THEN + CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + EXISTS_TAC `ball(x:real^N,&1)` THEN + REWRITE_TAC[OPEN_BALL; CENTRE_IN_BALL; REAL_LT_01] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{u:real^N->bool}` THEN + REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `v:real^N->bool` THEN + ASM_CASES_TAC `v:real^N->bool = u` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `\u:real^N->bool x:real^N. + if x IN s + then setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)) + else &0` THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + SIMP_TAC[SUM_POS_LE; SETDIST_POS_LE; REAL_LE_DIV] THEN + SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[SUM_RMUL] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC(TAUT `r /\ p /\ q ==> p /\ q /\ r`) THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `n:real^N->bool` THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN + ASM_CASES_TAC `(u:real^N->bool) IN c` THEN + ASM_REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN + X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[real_div; REAL_ENTIRE] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(y:real^N) IN u` THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF; REAL_MUL_LZERO] THEN + ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!v x:real^N. v IN c /\ x IN s /\ x IN v ==> &0 < setdist({x},s DIFF v)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SIMP_TAC[SETDIST_POS_LE; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `s DIFF v:real^N->bool`; `x:real^N`] + SETDIST_EQ_0_CLOSED_IN) THEN + ONCE_REWRITE_TAC[SET_RULE `s DIFF t = s INTER (UNIV DIFF t)`] THEN + ASM_SIMP_TAC[CLOSED_IN_CLOSED_INTER; GSYM OPEN_CLOSED] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[IN_INTER; IN_DIFF; IN_UNION] THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^N. x IN s ==> &0 < sum c (\v. setdist ({x},s DIFF v))` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN + MATCH_MP_TAC SUM_POS_LT THEN REWRITE_TAC[SETDIST_POS_LE] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^N`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `u:real^N->bool` THEN + ASM_CASES_TAC `(x:real^N) IN u` THEN + ASM_SIMP_TAC[SETDIST_SING_IN_SET; IN_DIFF] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `x:real^N`) THEN REWRITE_TAC[IN_UNIONS] THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_MESON_TAC[REAL_LT_IMP_NZ]]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_DIV_REFL; o_DEF] THEN + X_GEN_TAC `u:real^N->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_EQ THEN + EXISTS_TAC `\x:real^N. + lift(setdist({x},s DIFF u) / sum c (\v. setdist({x},s DIFF v)))` THEN + SIMP_TAC[] THEN REWRITE_TAC[real_div; LIFT_CMUL] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN + SIMP_TAC[CONTINUOUS_ON_LIFT_SETDIST; o_DEF] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] CONTINUOUS_ON_INV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `x:real^N` th) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real^N->bool` STRIP_ASSUME_TAC)) THEN + MATCH_MP_TAC CONTINUOUS_TRANSFORM_WITHIN_OPEN_IN THEN + MAP_EVERY EXISTS_TAC + [`\x:real^N. lift(sum {v | v IN c /\ ~(v INTER n = {})} + (\v. setdist({x},s DIFF v)))`; + `s INTER n:real^N->bool`] THEN + ASM_SIMP_TAC[IN_INTER; OPEN_IN_OPEN_INTER] THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^N` THEN DISCH_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_REWRITE_TAC[SUBSET_RESTRICT] THEN X_GEN_TAC `v:real^N->bool` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC SETDIST_SING_IN_SET THEN ASM SET_TAC[]; + ASM_SIMP_TAC[LIFT_SUM; o_DEF] THEN MATCH_MP_TAC CONTINUOUS_VSUM THEN + ASM_SIMP_TAC[CONTINUOUS_AT_LIFT_SETDIST; CONTINUOUS_AT_WITHIN]]);; diff --git a/RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml b/RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml new file mode 100644 index 0000000..f2b6f22 --- /dev/null +++ b/RichterHilbertAxiomGeometry/inverse_bug_puzzle_read.ml @@ -0,0 +1,503 @@ +(* ========================================================================= *) +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* Proof of the Bug Puzzle conjecture of the HOL Light tutorial: Any two *) +(* triples of points in the plane with the same oriented area can be *) +(* connected in 5 moves or less (FivemovesOrLess). Much of the code is *) +(* due to John Harrison: a proof (NOTENOUGH_4) showing this is the best *) +(* possible result; an early version of Noncollinear_2Span; the *) +(* definition of move, which defines a closed subset *) +(* {(A,B,C,A',B',C') | move (A,B,C) (A',B',C')} of R^6 x R^6, *) +(* i.e. the zero set of a continuous function; FivemovesOrLess_STRONG, *) +(* which handles the degenerate case (collinear or non-distinct triples), *) +(* giving a satisfying answer using this "closed" definition of move. *) +(* *) +(* The mathematical proofs are essentially due to Tom Hales. *) +(* ========================================================================= *) + +needs "Multivariate/determinants.ml";; +needs "RichterHilbertAxiomGeometry/readable.ml";; + +new_type_abbrev("triple",`:real^2#real^2#real^2`);; + +let VEC2_TAC = + SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_2; SUM_2; DIMINDEX_2; VECTOR_2; + vector_add; vec; dot; orthogonal; basis; + vector_neg; vector_sub; vector_mul; ARITH] THEN + CONV_TAC REAL_RING;; + +let oriented_area = new_definition + `oriented_area (a:real^2,b:real^2,c:real^2) = + ((b$1 - a$1) * (c$2 - a$2) - (c$1 - a$1) * (b$2 - a$2)) / &2`;; + +let move = NewDefinition `; + ∀A B C A' B' C':real^2. move (A,B,C) (A',B',C') ⇔ + (B = B' ∧ C = C' ∧ collinear {vec 0,C - B,A' - A} ∨ + A = A' ∧ C = C' ∧ collinear {vec 0,C - A,B' - B} ∨ + A = A' ∧ B = B' ∧ collinear {vec 0,B - A,C' - C})`;; + +let reachable = NewDefinition `; + ∀p p'. + reachable p p' ⇔ ∃n. ∃s. s 0 = p ∧ s n = p' ∧ + (∀m. 0 <= m ∧ m < n ⇒ move (s m) (s (SUC m)))`;; + +let reachableN = NewDefinition `; + ∀p p'. ∀n. + reachableN p p' n ⇔ ∃s. s 0 = p ∧ s n = p' ∧ + (∀m. 0 <= m ∧ m < n ⇒ move (s m) (s (SUC m)))`;; + +let move2Cond = NewDefinition `; + ∀ A B A' B':real^2. move2Cond A B A' B' ⇔ + ¬collinear {B,A,A'} ∧ ¬collinear {A',B,B'} ∨ + ¬collinear {A,B,B'} ∧ ¬collinear {B',A,A'}`;; + + +let oriented_areaSymmetry = theorem `; + oriented_area (A,B,C) = oriented_area(A',B',C') ⇒ + oriented_area (B,C,A) = oriented_area (B',C',A') ∧ + oriented_area (C,A,B) = oriented_area (C',A',B') ∧ + oriented_area (A,C,B) = oriented_area (A',C',B') ∧ + oriented_area (B,A,C) = oriented_area (B',A',C') ∧ + oriented_area (C,B,A) = oriented_area (C',B',A') + proof + rewrite oriented_area; VEC2_TAC; + qed; +`;; + +let COLLINEAR_3_2Dzero = theorem `; + ∀y z:real^2. collinear{vec 0,y,z} ⇔ + z$1 * y$2 = y$1 * z$2 + proof + rewrite COLLINEAR_3_2D; VEC2_TAC; qed; +`;; + +let Noncollinear_3ImpliesDistinct = theorem `; + ¬collinear {a,b,c} ⇒ ¬(a = b) ∧ ¬(a = c) ∧ ¬(b = c) + by fol COLLINEAR_BETWEEN_CASES BETWEEN_REFL`;; + +let collinearSymmetry = theorem `; + collinear {A,B,C} + ⇒ collinear {A,C,B} ∧ collinear {B,A,C} ∧ + collinear {B,C,A} ∧ collinear {C,A,B} ∧ collinear {C,B,A} + proof + {A,C,B} ⊂ {A,B,C} ∧ {B,A,C} ⊂ {A,B,C} ∧ + {B,C,A} ⊂ {A,B,C} ∧ {C,A,B} ⊂ {A,B,C} ∧ {C,B,A} ⊂ {A,B,C} [] by set; + fol - COLLINEAR_SUBSET; + qed; +`;; + +let Noncollinear_2Span = theorem `; + ∀u v w:real^2. ¬collinear {vec 0,v,w} ⇒ ∃ s t. s % v + t % w = u + + proof + intro_TAC ∀u v w, H1; + ¬(v$1 * w$2 - w$1 * v$2 = &0) [H1'] by fol H1 COLLINEAR_3_2Dzero REAL_SUB_0; + consider M such that + M = transp(vector[v;w]):real^2^2 [Mexists] by fol -; + ¬(det M = &0) ∧ + (∀ x. (M ** x)$1 = v$1 * x$1 + w$1 * x$2 ∧ + (M ** x)$2 = v$2 * x$1 + w$2 * x$2) [MatMult] by simplify H1' Mexists matrix_vector_mul DIMINDEX_2 SUM_2 + TRANSP_COMPONENT VECTOR_2 LAMBDA_BETA ARITH CART_EQ FORALL_2 DET_2; + ∀ r n. ¬(r < n) ∧ r <= MIN n n ⇒ r = n [] by arithmetic; + consider x such that M ** x = u [xDef] by fol MatMult - DET_EQ_0_RANK RANK_BOUND MATRIX_FULL_LINEAR_EQUATIONS; + exists_TAC x$1; + exists_TAC x$2; + x$1 * v$1 + x$2 * w$1 = u$1 ∧ + x$1 * v$2 + x$2 * w$2 = u$2 [xDef] by fol MatMult xDef REAL_MUL_SYM; + simplify - CART_EQ LAMBDA_BETA FORALL_2 SUM_2 DIMINDEX_2 VECTOR_2 vector_add vector_mul ARITH; + qed; +`;; + +let moveInvariant = theorem `; + ∀p p'. move p p' ⇒ oriented_area p = oriented_area p' + proof + rewrite FORALL_PAIR_THM move oriented_area COLLINEAR_LEMMA vector_mul; VEC2_TAC; + qed; +`;; + +let ReachLemma = theorem `; + ∀p p'. reachable p p' ⇔ ∃n. reachableN p p' n + proof + rewrite reachable reachableN; + qed; +`;; + +let reachableN_CLAUSES = theorem `; + ∀ p p'. (reachableN p p' 0 ⇔ p = p') ∧ + ∀ n. reachableN p p' (SUC n) ⇔ ∃ q. reachableN p q n ∧ move q p' + + proof + intro_TAC ∀p p'; + consider s0 such that s0 = λm:num. p:triple [s0exists] by fol; + reachableN p p' 0 ⇔ p = p' [0CLAUSE] by fol s0exists LE_0 reachableN LT; + ∀ n. reachableN p p' (SUC n) ⇒ ∃ q. reachableN p q n ∧ move q p' [Imp1] + proof + intro_TAC ∀n, H1; + consider s such that + s 0 = p ∧ s (SUC n) = p' ∧ ∀m. m < SUC n ⇒ move (s m) (s (SUC m)) [sDef] by fol H1 LE_0 reachableN; + consider q such that q = s n [qDef] by fol; + fol sDef qDef LE_0 reachableN LT; + qed; + ∀n. (∃ q. reachableN p q n ∧ move q p') ⇒ reachableN p p' (SUC n) [Imp2] + proof + intro_TAC ∀n; + rewrite IMP_CONJ LEFT_IMP_EXISTS_THM; + intro_TAC ∀q, nReach, move_qp'; + consider s such that + s 0 = p ∧ s n = q ∧ ∀m. m < n ⇒ move (s m) (s (SUC m)) [sDef] by fol nReach reachableN LT LE_0; + rewrite reachableN LT LE_0; + exists_TAC λm. if m < SUC n then s m else p'; + fol sDef move_qp' LT_0 LT_REFL LT LT_SUC; + qed; + fol 0CLAUSE Imp1 Imp2; + qed; +`;; + +let reachableInvariant = theorem `; + ∀p p'. reachable p p' ⇒ oriented_area p = oriented_area p' + + proof + simplify ReachLemma LEFT_IMP_EXISTS_THM SWAP_FORALL_THM; + MATCH_MP_TAC num_INDUCTION; + simplify reachableN_CLAUSES; + intro_TAC ∀n, nStep; + fol nStep moveInvariant; + qed; +`;; + +let reachableN_One = theorem `; + reachableN P0 P1 1 ⇔ move P0 P1 + by fol ONE reachableN reachableN_CLAUSES`;; + +let reachableN_Two = theorem `; + reachableN P0 P2 2 ⇔ ∃P1. move P0 P1 ∧ move P1 P2 + by fol TWO reachableN_One reachableN_CLAUSES`;; + +let reachableN_Three = theorem `; + reachableN P0 P3 3 ⇔ ∃P1 P2. move P0 P1 ∧ move P1 P2 ∧ move P2 P3 + by fol ARITH_RULE [3 = SUC 2] reachableN_Two reachableN_CLAUSES`;; + +let reachableN_Four = theorem `; + reachableN P0 P4 4 ⇔ ∃P1 P2 P3. move P0 P1 ∧ move P1 P2 ∧ + move P2 P3 ∧ move P3 P4 + by fol ARITH_RULE [4 = SUC 3] reachableN_Three reachableN_CLAUSES`;; + +let reachableN_Five = theorem `; + reachableN P0 P5 5 ⇔ ∃P1 P2 P3 P4. move P0 P1 ∧ move P1 P2 ∧ + move P2 P3 ∧ move P3 P4 ∧ move P4 P5 + proof + rewrite ARITH_RULE [5 = SUC 4] reachableN_CLAUSES; + fol reachableN_Four; + qed; +`;; + +let moveSymmetry = theorem `; + move (A,B,C) (A',B',C') ⇒ + move (B,C,A) (B',C',A') ∧ move (C,A,B) (C',A',B') ∧ + move (A,C,B) (A',C',B') ∧ move (B,A,C) (B',A',C') ∧ move (C,B,A) (C',B',A') + + proof + ∀X Y Z X':real^2. collinear {vec 0, Z - Y, X' - X} + ⇒ collinear {vec 0, Y - Z, X' - X} [] + proof rewrite COLLINEAR_3_2Dzero; VEC2_TAC; qed; + MP_TAC -; + rewrite move; + ∀X Y Z X':real^2. collinear {vec 0, Z - Y, X' - X} + ⇒ collinear {vec 0, Y - Z, X' - X} [] + proof rewrite COLLINEAR_3_2Dzero; VEC2_TAC; qed; + MP_TAC -; + rewrite move; + fol; + qed; +`;; + +let reachableNSymmetry = theorem `; + ∀ n. ∀ A B C A' B' C'. reachableN (A,B,C) (A',B',C') n ⇒ + reachableN (B,C,A) (B',C',A') n ∧ reachableN (C,A,B) (C',A',B') n ∧ + reachableN (A,C,B) (A',C',B') n ∧ reachableN (B,A,C) (B',A',C') n ∧ + reachableN (C,B,A) (C',B',A') n + + proof + MATCH_MP_TAC num_INDUCTION; + rewrite reachableN_CLAUSES; simplify PAIR_EQ; + intro_TAC ∀n, nStep, ∀A B C A' B' C'; + rewrite LEFT_IMP_EXISTS_THM FORALL_PAIR_THM; + X_genl_TAC X Y Z; + intro_TAC XYZexists; + rewrite RIGHT_AND_EXISTS_THM LEFT_AND_EXISTS_THM; + exists_TAC (Y,Z,X); + exists_TAC (Z,X,Y); + exists_TAC (X,Z,Y); + exists_TAC (Y,X,Z); + exists_TAC (Z,Y,X); + simplify nStep XYZexists moveSymmetry; + qed; +`;; + +let ORIENTED_AREA_COLLINEAR_CONG = theorem `; + ∀ A B C A' B' C. + oriented_area (A,B,C) = oriented_area (A',B',C') + ⇒ (collinear {A,B,C} ⇔ collinear {A',B',C'}) + proof + rewrite COLLINEAR_3_2D oriented_area; real_ring; + qed; +`;; + +let Basic2move_THM = theorem `; + ∀ A B C A'. ¬collinear {A,B,C} ∧ ¬collinear {B,A,A'} ⇒ + ∃X. move (A,B,C) (A,B,X) ∧ move (A,B,X) (A',B,X) + + proof + intro_TAC ∀A B C A', H1 H2; + ∀r. r % (A - B) = (--r) % (B - A) ∧ + r % (A - B) = r % (A - B) + &0 % (C - B) [add0vector_mul] by VEC2_TAC; + ¬ ∃ r. A' - A = r % (A - B) [H2'] by fol - H2 COLLINEAR_3 COLLINEAR_LEMMA; + consider r t such that A' - A = r % (A - B) + t % (C - B) [rExists] by fol - H1 COLLINEAR_3 Noncollinear_2Span; + ¬(t = &0) [tNonzero] by fol - add0vector_mul H2'; + consider s X such that s = r / t ∧ X = C + s % (A - B) [Xexists] by fol rExists; + A' - A = (t * s) % (A - B) + t % (C - B) [] by fol - rExists tNonzero REAL_DIV_LMUL; + A' - A = t % (X - B) ∧ X - C = (-- s) % (B - A) [] + proof rewrite - Xexists; VEC2_TAC; qed; + collinear {vec 0,B - A,X - C} ∧ collinear {vec 0,X - B,A' - A} [] by fol - COLLINEAR_LEMMA; + fol - move; + qed; +`;; + +let FourStepMoveAB = theorem `; + ∀A B C A' B'. ¬collinear {A,B,C} ⇒ + ¬collinear {B,A,A'} ∧ ¬collinear {A',B,B'} ⇒ + ∃ X Y. move (A,B,C) (A,B,X) ∧ move (A,B,X) (A',B,X) ∧ + move (A',B,X) (A',B,Y) ∧ move (A',B,Y) (A',B',Y) + + proof + intro_TAC ∀A B C A' B', H1, H2; + consider X such that + move (A,B,C) (A,B,X) ∧ move (A,B,X) (A',B,X) [ABX] by fol H1 H2 Basic2move_THM; + ¬collinear {A,B,X} ∧ ¬collinear {A',B,X} [] by fol - H1 moveInvariant ORIENTED_AREA_COLLINEAR_CONG; + ¬collinear {B,A',X} [] by fol - collinearSymmetry; + consider Y such that + move (B,A',X) (B,A',Y) ∧ move (B,A',Y) (B',A',Y) [BA'Y] by fol - H2 Basic2move_THM; + move (A',B,X) (A',B,Y) ∧ move (A',B,Y) (A',B',Y) [] by fol - BA'Y moveSymmetry; + fol - ABX; + qed; +`;; + +let FourStepMoveABBAreach = theorem `; + ∀A B C A' B'. ¬collinear {A,B,C} ∧ move2Cond A B A' B' ⇒ + ∃ Y. reachableN (A,B,C) (A',B',Y) 4 + + proof + intro_TAC ∀A B C A' B', H1 H2; + case_split Case1 | Case2 by fol - H2 move2Cond; + suppose ¬collinear {B,A,A'} ∧ ¬collinear {A',B,B'}; + fol - H1 FourStepMoveAB reachableN_Four; + end; + suppose ¬collinear {A,B,B'} ∧ ¬collinear {B',A,A'}; + ¬collinear {B,A,C} [] by fol H1 collinearSymmetry; + consider X Y such that + move (B,A,C) (B,A,X) ∧ move (B,A,X) (B',A,X) ∧ + move (B',A,X) (B',A,Y) ∧ move (B',A,Y) (B',A',Y) [BAX] by fol Case2 - FourStepMoveAB; + fol - moveSymmetry reachableN_Four; + end; + qed; +`;; + +let NotMove2ImpliesCollinear = theorem `; + ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ∧ + ¬(A = A') ∧ ¬(B = B') ∧ ¬move2Cond A B A' B' ⇒ + collinear {A,B,A',B'} + + proof + intro_TAC ∀A B C A' B' C', H1 H1' H2 H2' H3; + ¬(A = B) ∧ ¬(A' = B') [Distinct] by fol H1 H1' Noncollinear_3ImpliesDistinct; + {A,B,A',B'} ⊂ {A,A',B,B'} ∧ + {A,B,A',B'} ⊂ {B,B',A',A} ∧ {A,B,A',B'} ⊂ {A',B',B,A} [set4symmetry] by SET_TAC; + case_split Case1 | Case2 | Case3 | Case4 by fol H3 move2Cond; + suppose collinear {B,A,A'} ∧ collinear {A,B,B'}; + fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; + end; + suppose collinear {B,A,A'} ∧ collinear {B',A,A'}; + fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; + end; + suppose collinear {A',B,B'} ∧ collinear {A,B,B'}; + fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; + end; + suppose collinear {A',B,B'} ∧ collinear {B',A,A'}; + fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; + end; + qed; +`;; + +let NotMove2ImpliesCollinear = theorem `; + ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ∧ + ¬(A = A') ∧ ¬(B = B') ∧ ¬move2Cond A B A' B' ⇒ + collinear {A,B,A',B'} + + proof + intro_TAC ∀A B C A' B' C', H1 H1' H2 H2' H3; + ¬(A = B) ∧ ¬(A' = B') [Distinct] by fol H1 H1' Noncollinear_3ImpliesDistinct; + {A,B,A',B'} ⊂ {A,A',B,B'} ∧ + {A,B,A',B'} ⊂ {B,B',A',A} ∧ {A,B,A',B'} ⊂ {A',B',B,A} [set4symmetry] by SET_TAC; + collinear {B,A,A'} ∧ collinear {A,B,B'} ∨ + collinear {B,A,A'} ∧ collinear {B',A,A'} ∨ + collinear {A',B,B'} ∧ collinear {A,B,B'} ∨ + collinear {A',B,B'} ∧ collinear {B',A,A'} [] by fol H3 move2Cond; + fol - Distinct H2 H2' set4symmetry collinearSymmetry COLLINEAR_4_3 COLLINEAR_SUBSET; + qed; +`;; + +let DistinctImplies2moveable = theorem `; + ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ∧ + ¬(A = A') ∧ ¬(B = B') ∧ ¬(C = C') ⇒ + move2Cond A B A' B' ∨ move2Cond B C B' C' + + proof + intro_TAC ∀A B C A' B' C', H1 H1' H2a H2b H2c; + {A,B,B'} ⊂ {A,B,A',B'} ∧ {B,B',C} ⊂ {B,C,B',C'} [3subset4] by SET_TAC; + assume ¬move2Cond A B A' B' ∧ ¬move2Cond B C B' C' [Con] by fol; + collinear {A,B,A',B'} ∧ collinear {B,C,B',C'} [] by fol - H1 H1' H2a H2b H2c collinearSymmetry NotMove2ImpliesCollinear; + collinear {A,B,C} [] by fol - 3subset4 H2a H2b H2c COLLINEAR_SUBSET COLLINEAR_3_TRANS; + fol - H1 H1'; + qed; +`;; + +let SameCdiffAB = theorem `; + ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ⇒ + C = C' ∧ ¬(A = A') ∧ ¬(B = B') ⇒ + ∃ Y. reachableN (A,B,C) (Y,B',C') 2 ∨ reachableN (A,B,C) (A',B',Y) 4 + + proof + intro_TAC ∀A B C A' B' C', H1, H2; + {B,B',A} ⊂ {A,B,A',B'} ∧ {A,B,C} ⊂ {B,B',A,C} [easy_set] by SET_TAC; + case_split Ncol | move | col_Nmove by fol; + suppose ¬collinear {C,B,B'}; + consider X such that move (B,C,A) (B,C,X) ∧ move (B,C,X) (B',C',X) [BCX] by fol - easy_set H1 H2 collinearSymmetry Basic2move_THM; + fol BCX reachableN_Two reachableNSymmetry; + end; + suppose move2Cond A B A' B'; + fol - H1 FourStepMoveABBAreach; + end; + suppose collinear {C,B,B'} ∧ ¬move2Cond A B A' B'; + collinear {B,B',A} ∧ collinear {B,B',C} [] by fol - H1 H2 easy_set NotMove2ImpliesCollinear COLLINEAR_SUBSET collinearSymmetry; + fol - H2 easy_set H1 COLLINEAR_4_3 COLLINEAR_SUBSET; + end; + qed; +`;; + +let FourMovesToCorrectTwo = theorem `; + ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ ¬collinear {A',B',C'} ⇒ + ∃ n. n < 5 ∧ ∃ Y. reachableN (A,B,C) (A',B',Y) n ∨ + reachableN (A,B,C) (A',Y,C') n ∨ reachableN (A,B,C) (Y,B',C') n + + proof + intro_TAC ∀A B C A' B' C', H1; + ¬collinear {B,C,A} ∧ + ¬collinear{B',C',A'} ∧ ¬collinear {C,A,B} ∧ ¬collinear {C',A',B'} [H1'] by fol H1 collinearSymmetry; + 0 < 5 ∧ 2 < 5 ∧ 3 < 5 ∧ 4 < 5 [easy_arith] by ARITH_TAC; + case_split case01 | case2 | case3 by fol; + suppose A = A' ∧ B = B' ∧ C = C' ∨ + A = A' ∧ B = B' ∧ ¬(C = C') ∨ A = A' ∧ ¬(B = B') ∧ C = C' ∨ + ¬(A = A') ∧ B = B' ∧ C = C'; + fol - easy_arith reachableN_CLAUSES; + end; + suppose A = A' ∧ ¬(B = B') ∧ ¬(C = C') ∨ + ¬(A = A') ∧ B = B' ∧ ¬(C = C') ∨ ¬(A = A') ∧ ¬(B = B') ∧ C = C'; + fol - H1 H1' easy_arith SameCdiffAB reachableNSymmetry; + end; + suppose ¬(A = A') ∧ ¬(B = B') ∧ ¬(C = C'); + exists_TAC 4; + simplify easy_arith reachableN_CLAUSES; + fol - H1 H1' DistinctImplies2moveable FourStepMoveABBAreach + reachableNSymmetry reachableN_Four; + end; + qed; +`;; + +let CorrectFinalPoint = theorem `; + oriented_area (A,B,C) = oriented_area (A,B,C') ⇒ + move (A,B,C) (A,B,C') + proof + rewrite move oriented_area COLLINEAR_3_2Dzero; VEC2_TAC; + qed; +`;; + +let FiveMovesOrLess = theorem `; + ∀A B C A' B' C'. ¬collinear {A,B,C} ∧ + oriented_area (A,B,C) = oriented_area (A',B',C') ⇒ + ∃ n. n <= 5 ∧ reachableN (A,B,C) (A',B',C') n + + proof + intro_TAC ∀A B C A' B' C', H1 H2; + ¬collinear {A',B',C'} [H1'] by fol H1 H2 ORIENTED_AREA_COLLINEAR_CONG; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + ¬(A' = B') ∧ ¬(A' = C') ∧ ¬(B' = C') [Distinct] by fol - H1 Noncollinear_3ImpliesDistinct; + consider n Y such that + n < 5 ∧ (reachableN (A,B,C) (A',B',Y) n ∨ + reachableN (A,B,C) (A',Y,C') n ∨ reachableN (A,B,C) (Y,B',C') n) [2Correct] by fol H1 H1' FourMovesToCorrectTwo; + case_split A'B'Y | A'YC' | YB'C' by fol 2Correct; + suppose reachableN (A,B,C) (A',B',Y) n; + oriented_area (A',B',Y) = oriented_area (A',B',C') [] by fol - H2 ReachLemma reachableInvariant; + move (A',B',Y) (A',B',C') [] by fol - Distinct CorrectFinalPoint; + fol A'B'Y - 2Correct reachableN_CLAUSES LE_SUC_LT; + end; + suppose reachableN (A,B,C) (A',Y,C') n; + oriented_area (A',C',Y) = oriented_area (A',C',B') [] by fol H2 - ReachLemma reachableInvariant oriented_areaSymmetry; + move (A',Y,C') (A',B',C') [] by fol - Distinct CorrectFinalPoint moveSymmetry; + fol A'YC' - 2Correct reachableN_CLAUSES LE_SUC_LT; + end; + suppose reachableN (A,B,C) (Y,B',C') n; + oriented_area (B',C',Y) = oriented_area (B',C',A') [] by fol H2 - ReachLemma reachableInvariant oriented_areaSymmetry; + move (Y,B',C') (A',B',C') [] by fol - Distinct CorrectFinalPoint moveSymmetry; + fol YB'C' - 2Correct reachableN_CLAUSES LE_SUC_LT; + end; + qed; +`;; + +let NOTENOUGH_4 = theorem `; + ∃p0 p4. oriented_area p0 = oriented_area p4 ∧ ¬reachableN p0 p4 4 + + proof + consider p0 p4 such that + p0:triple = vector [&0;&0],vector [&0;&1],vector [&1;&0] ∧ + p4:triple = vector [&1;&1],vector [&1;&2],vector [&2;&1] [p04Def] by + fol; + oriented_area p0 = oriented_area p4 [equal_areas] + proof rewrite - oriented_area; VEC2_TAC; qed; + ¬reachableN p0 p4 4 [] + proof + rewrite p04Def reachableN_Four NOT_EXISTS_THM FORALL_PAIR_THM move COLLINEAR_3_2Dzero FORALL_VECTOR_2; + VEC2_TAC; + qed; + fol - equal_areas; + qed; +`;; + +let FiveMovesOrLess_STRONG = theorem `; + ∀A B C A' B' C'. + oriented_area (A,B,C) = oriented_area (A',B',C') ⇒ + ∃n. n <= 5 ∧ reachableN (A,B,C) (A',B',C') n + + proof + intro_TAC ∀A B C A' B' C', H1; + (∀X Y:real^2. collinear {X,Y,Y}) ∧ + (∀A B A'. move (A,B,B) (A',B,B)) ∧ + ∀A B C B'. (collinear {A,B,C} ∧ collinear {A,B',C} ⇒ + move (A,B,C) (A,B',C)) [EZcollinear] + proof rewrite move COLLINEAR_3_2D; VEC2_TAC; qed; + case_split ABCncol | ABCcol by fol ; + suppose ¬collinear {A,B,C}; + fol - H1 FiveMovesOrLess; + end; + suppose collinear {A,B,C}; + collinear {A',B',C'} [A'B'C'col] by fol - H1 ORIENTED_AREA_COLLINEAR_CONG; + consider P1 P2 P3 P4 such that + P1 = A,C,C ∧ P2 = B',C,C ∧ P3 = B',B',C ∧ P4 = B',B',C' [P1234exist] by fol; + move (A,B,C) P1 ∧ move P1 P2 ∧ move P2 P3 ∧ move P3 P4 ∧ + move P4 (A',B',C') [] by fol ABCcol A'B'C'col EZcollinear P1234exist + collinearSymmetry moveSymmetry; + fol - reachableN_Five LE_REFL; + end; + qed; +`;; + diff --git a/RichterHilbertAxiomGeometry/miz3/FontHilbertAxiom.ml b/RichterHilbertAxiomGeometry/miz3/FontHilbertAxiom.ml new file mode 100644 index 0000000..c89c9bb --- /dev/null +++ b/RichterHilbertAxiomGeometry/miz3/FontHilbertAxiom.ml @@ -0,0 +1,3421 @@ +(* ----------------------------------------------------------------- *) +(* HOL Light Hilbert geometry axiomatic proofs using miz3. *) +(* ----------------------------------------------------------------- *) + +(* High school students can learn rigorous axiomatic Geometry proofs, + as in http://www.math.northwestern.edu/~richter/hilbert.pdf, using + Hilbert's axioms, and code up their proofs in miz3 and HOL Light. + Thanks to Bjørn Jahren, Miguel Lerma,Takuo Matsuoka, Stephen + Wilson for advice on Hilbert's axioms, and especially Benjamin + Kordesh, who carefully read much of the paper and the code. + + Formal proofs are given for the first 7 sections of the paper, the + results cited there from Greenberg's book, and most of Euclid's + book I propositions up to Proposition I.29, following Hartshorne, + whose book seems the most exciting axiomatic geometry text. A + proof assistant is an valuable tool to help read it, as + Hartshorne's proofs are often sketchy and even have gaps. + + M. Greenberg, Euclidean and non-Euclidean geometries, W. H. Freeman and Co., 1974. + R. Hartshorne, Geometry, Euclid and Beyond, Undergraduate Texts in Math., Springer, 2000. + + Thanks to Mizar folks for their influential language, Freek + Wiedijk, who wrote the miz3 port of Mizar to HOL Light, and + especially John Harrison, who was extremely helpful and developed + the framework for porting my axiomatic proofs to HOL Light. *) + +verbose := false;; +report_timing := false;; + +horizon := 0;; +timeout := 50;; + +new_type("point",0);; +new_type_abbrev("point_set",`:point->bool`);; +new_constant("Between",`:point->point->point->bool`);; +new_constant("Line",`:point_set->bool`);; +new_constant("≡",`:(point->bool)->(point->bool)->bool`);; + +parse_as_infix("≅",(12, "right"));; +parse_as_infix("same_side",(12, "right"));; +parse_as_infix("≡",(12, "right"));; +parse_as_infix("<__",(12, "right"));; +parse_as_infix("<_ang",(12, "right"));; +parse_as_infix("suppl",(12, "right"));; +parse_as_infix("∉",(11, "right"));; +parse_as_infix("∥",(12, "right"));; + +let ∉ = new_definition + `∀a:A l:A->bool. a ∉ l ⇔ ¬(a ∈ l)`;; + +let Interval_DEF = new_definition + `∀ A B. open (A,B) = {X | Between A X B}`;; + +let Collinear_DEF = new_definition + `Collinear A B C ⇔ + ∃ l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l`;; + +let SameSide_DEF = new_definition + `A,B same_side l ⇔ + Line l ∧ ¬ ∃ X. (X ∈ l) ∧ X ∈ open (A,B)`;; + +let Ray_DEF = new_definition + `∀ A B. ray A B = {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B)}`;; + +let Ordered_DEF = new_definition + `ordered A B C D ⇔ + B ∈ open (A,C) ∧ B ∈ open (A,D) ∧ C ∈ open (A,D) ∧ C ∈ open (B,D)`;; + +let InteriorAngle_DEF = new_definition + `∀ A O B. int_angle A O B = + {P:point | ¬Collinear A O B ∧ ∃ a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b}`;; + +let InteriorTriangle_DEF = new_definition + `∀ A B C. int_triangle A B C = + {P | P ∈ int_angle A B C ∧ + P ∈ int_angle B C A ∧ + P ∈ int_angle C A B}`;; + +let Tetralateral_DEF = new_definition + `Tetralateral A B C D ⇔ + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B`;; + +let Quadrilateral_DEF = new_definition + `Quadrilateral A B C D ⇔ + Tetralateral A B C D ∧ + open (A,B) ∩ open (C,D) = ∅ ∧ + open (B,C) ∩ open (D,A) = ∅ `;; + +let ConvexQuad_DEF = new_definition + `ConvexQuadrilateral A B C D ⇔ + Quadrilateral A B C D ∧ + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C `;; + +let Segment_DEF = new_definition + `seg A B = {A, B} UNION open (A,B)`;; + +let SEGMENT = new_definition + `Segment s ⇔ ∃ A B. s = seg A B ∧ ¬(A = B)`;; + +let SegmentOrdering_DEF = new_definition + `s <__ t ⇔ + Segment s ∧ + ∃ C D X. t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X`;; + +let Angle_DEF = new_definition + ` ∡ A O B = ray O A UNION ray O B `;; + +let ANGLE = new_definition + `Angle α ⇔ ∃ A O B. α = ∡ A O B ∧ ¬Collinear A O B`;; + +let AngleOrdering_DEF = new_definition + `α <_ang β ⇔ + Angle α ∧ + ∃ A O B G. ¬Collinear A O B ∧ β = ∡ A O B ∧ + G ∈ int_angle A O B ∧ α ≡ ∡ A O G`;; + +let RAY = new_definition + `Ray r ⇔ ∃ O A. ¬(O = A) ∧ r = ray O A`;; + +let TriangleCong_DEF = new_definition + `∀ A B C A' B' C' :point. (A, B, C) ≅ (A', B', C') ⇔ + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' ∧ + ∡ B C A ≡ ∡ B' C' A' ∧ + ∡ C A B ≡ ∡ C' A' B'`;; + +let SupplementaryAngles_DEF = new_definition + `∀ α β. α suppl β ⇔ + ∃ A O B A'. ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A'`;; + +let RightAngle_DEF = new_definition + `∀ α. Right α ⇔ ∃ β. α suppl β ∧ α ≡ β`;; + +let PlaneComplement_DEF = new_definition + `∀ α:point_set. complement α = {P | P ∉ α}`;; + +let CONVEX = new_definition + `Convex α ⇔ ∀ A B. A ∈ α ∧ B ∈ α ⇒ open (A,B) ⊂ α`;; + +let PARALLEL = new_definition + `∀ l k. l ∥ k ⇔ + Line l ∧ Line k ∧ l ∩ k = ∅`;; + +let Parallelogram_DEF = new_definition + `∀ A B C D. Parallelogram A B C D ⇔ + Quadrilateral A B C D ∧ ∃ a b c d. + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line b ∧ B ∈ b ∧ C ∈ b ∧ + Line c ∧ C ∈ c ∧ D ∈ d ∧ + Line d ∧ D ∈ d ∧ A ∈ d ∧ + a ∥ c ∧ b ∥ d`;; + +let InteriorCircle_DEF = new_definition + `∀ O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} +`;; + + +(* ---------------------------------------------------------------------------- *) +(* Hilbert's geometry axioms, except the parallel axiom P, defined near the end. *) +(* ---------------------------------------------------------------------------- *) + + +let I1 = new_axiom + `∀ A B. ¬(A = B) ⇒ ∃! l. Line l ∧ A ∈ l ∧ B ∈ l`;; + +let I2 = new_axiom + `∀ l. Line l ⇒ ∃ A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)`;; + +let I3 = new_axiom + `∃ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + ¬Collinear A B C`;; + +let B1 = new_axiom + `∀ A B C. Between A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + Between C B A ∧ Collinear A B C`;; + +let B2 = new_axiom + `∀ A B. ¬(A = B) ⇒ ∃ C. Between A B C`;; + +let B3 = new_axiom + `∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C + ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ + ¬(Between A B C ∧ Between B C A) ∧ + ¬(Between A B C ∧ Between C A B) ∧ + ¬(Between B C A ∧ Between C A B)`;; + +let B4 = new_axiom + `∀ l A B C. Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃ X. X ∈ l ∧ Between A X C) ⇒ + (∃ Y. Y ∈ l ∧ Between A Y B) ∨ (∃ Y. Y ∈ l ∧ Between B Y C)`;; + +let C1 = new_axiom + `∀ s O Z. Segment s ∧ ¬(O = Z) ⇒ + ∃! P. P ∈ ray O Z ━ O ∧ seg O P ≡ s`;; + +let C2Reflexive = new_axiom + `Segment s ⇒ s ≡ s`;; + +let C2Symmetric = new_axiom + `Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s`;; + +let C2Transitive = new_axiom + `Segment s ∧ Segment t ∧ Segment u ∧ + s ≡ t ∧ t ≡ u ⇒ s ≡ u`;; + +let C3 = new_axiom + `∀ A B C A' B' C'. B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ + seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' ⇒ + seg A C ≡ seg A' C'`;; + +let C4 = new_axiom + `∀ α O A l Y. Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l + ⇒ ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ + B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α`;; + +let C5Reflexive = new_axiom + `Angle α ⇒ α ≡ α`;; + +let C5Symmetric = new_axiom + `Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α`;; + +let C5Transitive = new_axiom + `Angle α ∧ Angle β ∧ Angle γ ∧ + α ≡ β ∧ β ≡ γ ⇒ α ≡ γ`;; + +let C6 = new_axiom + `∀ A B C A' B' C'. ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ ∡ A B C ≡ ∡ A' B' C' + ⇒ ∡ B C A ≡ ∡ B' C' A'`;; + + +(* ----------------------------------------------------------------- *) +(* Theorems. *) +(* ----------------------------------------------------------------- *) + + +let IN_Interval = thm `; + ∀ A B X. X ∈ open (A,B) ⇔ Between A X B + by Interval_DEF, SET_RULE; +`;; + +let IN_Ray = thm `; + ∀ A B X. X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B) + by Ray_DEF, SET_RULE; +`;; + +let IN_InteriorAngle = thm `; + ∀ A O B P. P ∈ int_angle A O B ⇔ + ¬Collinear A O B ∧ ∃ a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b + by InteriorAngle_DEF, SET_RULE; +`;; + +let IN_InteriorTriangle = thm `; + ∀ A B C P. P ∈ int_triangle A B C ⇔ + P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B + by InteriorTriangle_DEF, SET_RULE; +`;; + +let IN_PlaneComplement = thm `; + ∀ α:point_set. ∀ P. P ∈ complement α ⇔ P ∉ α + by PlaneComplement_DEF, SET_RULE; +`;; + +let IN_InteriorCircle = thm `; + ∀ O R P. P ∈ int_circle O R ⇔ + ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) + by InteriorCircle_DEF, SET_RULE; +`;; + +let B1' = thm `; + ∀ A B C. B ∈ open (A,C) ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + B ∈ open (C,A) ∧ Collinear A B C + by IN_Interval, B1; +`;; + +let B2' = thm `; + ∀ A B. ¬(A = B) ⇒ ∃ C. B ∈ open (A,C) + by IN_Interval, B2; +`;; + +let B3' = thm `; + ∀ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C + ⇒ (B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B)) ∧ + ¬(B ∈ open (A,C) ∧ C ∈ open (B,A)) ∧ + ¬(B ∈ open (A,C) ∧ A ∈ open (C,B)) ∧ + ¬(C ∈ open (B,A) ∧ A ∈ open (C,B)) + by IN_Interval, B3; +`;; + +let B4' = thm `; + ∀ l A B C. Line l ∧ ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃ X. X ∈ l ∧ X ∈ open (A,C)) ⇒ + (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) + by IN_Interval, B4; +`;; + +let B4'' = thm `; + ∀ l:point_set. ∀ A B C:point. + Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + A,B same_side l ∧ B,C same_side l ⇒ A,C same_side l + by B4', SameSide_DEF; +`;; + +let DisjointOneNotOther = thm `; + ∀ l m:A->bool. (∀ x:A. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ + by SET_RULE, ∉; +`;; + +let EquivIntersectionHelp = thm `; + ∀ e x:A. ∀ l m:A->bool. + (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m ━ x ⇒ e ∉ l + by SET_RULE, ∉; +`;; + +let CollinearSymmetry = thm `; + let A B C be point; + assume Collinear A B C [H1]; + thus Collinear A C B ∧ Collinear B A C ∧ Collinear B C A ∧ + Collinear C A B ∧ Collinear C B A + + proof + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l by H1, Collinear_DEF; + qed by -, Collinear_DEF; +`;; + +let ExistsNewPointOnLine = thm `; + let P be point; + let l be point_set; + assume Line l ∧ P ∈ l [H1]; + thus ∃ Q. Q ∈ l ∧ ¬(P = Q) + + proof + consider A B such that + A ∈ l ∧ B ∈ l ∧ ¬(A = B) [l_line] by H1, I2; + cases; + suppose P = A; + qed by -, l_line; + suppose ¬(P = A); + qed by -, l_line; + end; +`;; + +let ExistsPointOffLine = thm `; + let l be point_set; + assume Line l [H1]; + thus ∃ Q:point. Q ∉ l + + proof + consider A B C such that + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C [Distinct] by I3; + (A ∉ l ∨ B ∉ l ∨ C ∉ l) ∨ (A ∈ l ∧ B ∈ l ∧ C ∈ l) by ∉; + cases by -; + suppose A ∉ l ∨ B ∉ l ∨ C ∉ l; + qed by -; + suppose (A ∈ l) ∧ (B ∈ l) ∧ (C ∈ l); + Collinear A B C by H1, -, Collinear_DEF; + qed by -, Distinct; + end; +`;; + +let BetweenLinear = thm `; + let A B C be point; + let m be point_set; + assume Line m ∧ A ∈ m ∧ C ∈ m [H1]; + assume B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) [H2]; + thus B ∈ m + + proof + ¬(A = C) ∧ + (Collinear A B C ∨ Collinear B C A ∨ Collinear C A B) [X1] by H2, B1'; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X2] by -, Collinear_DEF; + l = m by X1, -, H2, H1, I1; + qed by -, X2; +`;; + +let CollinearLinear = thm `; + let A B C be point; + let m be point_set; + assume Line m ∧ A ∈ m ∧ C ∈ m [H1]; + assume Collinear A B C ∨ Collinear B C A ∨ Collinear C A B [H2]; + assume ¬(A = C) [H3]; + thus B ∈ m + + proof + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l [X1] by H2, Collinear_DEF; + l = m by H3, -, H1, I1; + qed by -, X1; +`;; + +let NonCollinearImpliesDistinct = thm `; + let A B C be point; + assume ¬Collinear A B C [H1]; + thus ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) + + proof + cases; + suppose A = B ∧ B = C [Case1]; + consider Q such that + ¬(Q = A) by I3; + qed by -, I1, Case1, Collinear_DEF, H1; + suppose (A = B ∧ ¬(A = C)) ∨ (A = C ∧ ¬(A = B)) ∨ (B = C ∧ ¬(A = B)); + qed by -, I1, Collinear_DEF, H1; + suppose ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C); + qed by -; + end; +`;; + +let Reverse4Order = thm `; + ∀ A B C D:point. ordered A B C D ⇒ ordered D C B A + by Ordered_DEF, B1'; +`;; + +let OriginInRay = thm `; + let O Q be point; + assume ¬(Q = O) [H1]; + thus O ∈ ray O Q + + proof + O ∉ open (O,Q) [OOQ] by B1', ∉; + Collinear O Q O by H1, I1, Collinear_DEF; + qed by H1, -, OOQ, IN_Ray; +`;; + +let EndpointInRay = thm `; + let O Q be point; + assume ¬(Q = O) [H1]; + thus Q ∈ ray O Q + + proof + O ∉ open (Q,Q) [notOQQ] by B1', ∉; + Collinear O Q Q by H1, I1, Collinear_DEF; + qed by H1, -, notOQQ, IN_Ray; +`;; + +let I1Uniqueness = thm `; + let X be point; + let l m be point_set; + assume Line l ∧ Line m [H0]; + assume ¬(l = m) [H1]; + assume X ∈ l ∧ X ∈ m [H2]; + thus l ∩ m = {X} + + proof + assume ¬(l ∩ m = {X}) [H3]; + X ∈ l ∩ m by H2, IN_INTER; + consider A such that + A ∈ l ∩ m ∧ ¬(A = X) [X1] by -, H3, SET_RULE; + A ∈ l ∧ X ∈ l ∧ A ∈ m ∧ X ∈ m by H0, -, H2, IN_INTER; + l = m by H0, -, X1, I1; + qed by -, H1; +`;; + +let EquivIntersection = thm `; + let A B X be point; + let l m be point_set; + assume Line l ∧ Line m [H0]; + assume l ∩ m = {X} [H1]; + assume A ∈ m ━ X ∧ B ∈ m ━ X [H2]; + assume X ∉ open (A,B) [H3]; + thus A,B same_side l + + proof + assume ¬(A,B same_side l) [Con]; + A ∈ m ∧ B ∈ m ∧ ¬(A = X) ∧ ¬(B = X) [H2'] by H2, IN_DELETE; + ¬(open (A,B) ∩ l = ∅) [nonempty] by H0, Con, SameSide_DEF, SET_RULE; + open (A,B) ⊂ m [ABm] by H0, H2', BetweenLinear, SUBSET; + open (A,B) ∩ l ⊂ {X} by -, SET_RULE, H1; + X ∈ open (A,B) ∩ l by nonempty, -, SET_RULE; + qed by -, IN_INTER, H3, ∉; +`;; + +let RayLine = thm `; + ∀ O P:point. ∀ l: point_set. + Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l + by IN_Ray, CollinearLinear, SUBSET; +`;; + +let RaySameSide = thm `; + let l be point_set; + let O A P be point; + assume Line l ∧ O ∈ l [l_line]; + assume A ∉ l [notAl]; + assume P ∈ ray O A ━ O [PrOA]; + thus P ∉ l ∧ P,A same_side l + + proof + ¬(O = A) [notOA] by l_line, notAl, ∉; + consider d such that + Line d ∧ O ∈ d ∧ A ∈ d [d_line] by notOA, I1; + ¬(l = d) by -, notAl, ∉; + l ∩ d = {O} [ldO] by l_line, d_line, -, I1Uniqueness; + A ∈ d ━ O [Ad_O] by d_line, notOA, IN_DELETE; + ray O A ⊂ d by d_line, RayLine; + P ∈ d ━ O [Pd_O] by PrOA, -, SUBSET, IN_DELETE; + P ∉ l [notPl] by ldO, -, EquivIntersectionHelp; + O ∉ open (P,A) by PrOA, IN_DELETE, IN_Ray; + P,A same_side l by l_line, d_line, ldO, Ad_O, Pd_O, -, EquivIntersection; + qed by notPl, -; +`;; + +let IntervalRayEZ = thm `; + let A B C be point; + assume B ∈ open (A,C) [H1]; + thus B ∈ ray A C ━ A ∧ C ∈ ray A B ━ A + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [ABC] by H1, B1'; + A ∉ open (B,C) ∧ A ∉ open (C,B) by -, H1, B3', B1', ∉; + qed by ABC, CollinearSymmetry, -, IN_Ray, IN_DELETE, ∉; +`;; + +let NoncollinearityExtendsToLine = thm `; + let A O B X be point; + assume ¬Collinear A O B [H1]; + assume Collinear O B X ∧ ¬(X = O) [H2]; + thus ¬Collinear A O X + + proof + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; + consider b such that + Line b ∧ O ∈ b ∧ B ∈ b [b_line] by Distinct, I1; + A ∉ b [notAb] by b_line, Collinear_DEF, H1, ∉; + X ∈ b by H2, b_line, Distinct, I1, Collinear_DEF; + qed by b_line, -, H2, I1, Collinear_DEF, notAb, ∉; +`;; + +let SameSideReflexive = thm `; + ∀ l A. Line l ∧ A ∉ l ⇒ A,A same_side l + by B1', SameSide_DEF; +`;; + +let SameSideSymmetric = thm `; + ∀ l A B. Line l ∧ A ∉ l ∧ B ∉ l ⇒ + A,B same_side l ⇒ B,A same_side l + by SameSide_DEF, B1'; +`;; + +let SameSideTransitive = thm `; + let l be point_set; + let A B C be point; + assume Line l [l_line]; + assume A ∉ l ∧ B ∉ l ∧ C ∉ l [notABCl]; + assume A,B same_side l [Asim_lB]; + assume B,C same_side l [Bsim_lC]; + thus A,C same_side l + + proof + cases; + suppose ¬Collinear A B C ∨ A = B ∨ A = C ∨ B = C; + qed by l_line, -, notABCl, Asim_lB, Bsim_lC, B4'', SameSideReflexive; + suppose Collinear A B C ∧ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct]; + consider m such that + Line m ∧ A ∈ m ∧ C ∈ m [m_line] by Distinct, I1; + B ∈ m [Bm] by -, Distinct, CollinearLinear; + cases; + suppose m ∩ l = ∅; + qed by m_line, l_line, -, BetweenLinear, SET_RULE, SameSide_DEF; + suppose ¬(m ∩ l = ∅); + consider X such that + X ∈ l ∧ X ∈ m [Xlm] by -, MEMBER_NOT_EMPTY, IN_INTER; + Collinear A X B ∧ Collinear B A C ∧ Collinear A B C [ABXcol] by m_line, Bm, -, Collinear_DEF; + consider E such that + E ∈ l ∧ ¬(E = X) [El_X] by l_line, Xlm, ExistsNewPointOnLine; + ¬Collinear E A X [EAXncol] by l_line, El_X, Xlm, I1, Collinear_DEF, notABCl, ∉; + consider B' such that + ¬(B = E) ∧ B ∈ open (E,B') [EBB'] by notABCl, El_X, ∉, B2'; + ¬(B' = E) ∧ ¬(B' = B) ∧ Collinear B E B' [EBB'col] by -, B1', CollinearSymmetry; + ¬Collinear A B B' ∧ ¬Collinear B' B A ∧ ¬Collinear B' A B [ABB'ncol] by EAXncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry, -; + ¬Collinear B' B C ∧ ¬Collinear B' A C ∧ ¬Collinear A B' C [AB'Cncol] by ABB'ncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry; + B' ∈ ray E B ━ E ∧ B ∈ ray E B' ━ E by EBB', IntervalRayEZ; + B' ∉ l ∧ B',B same_side l ∧ B,B' same_side l [notB'l] by l_line, El_X, notABCl, -, RaySameSide; + A,B' same_side l ∧ B',C same_side l by l_line, ABB'ncol, notABCl, notB'l, Asim_lB, -, B4'', AB'Cncol, Bsim_lC; + qed by l_line, AB'Cncol, notABCl, notB'l, -, B4''; + end; + end; +`;; + +let ConverseCrossbar = thm `; + let O A B G be point; + assume ¬Collinear A O B [H1]; + assume G ∈ open (A,B) [H2]; + thus G ∈ int_angle A O B + + proof + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by -, I1; + consider b such that + Line b ∧ O ∈ b ∧ B ∈ b [b_line] by Distinct, I1; + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l [l_line] by Distinct, I1; + B ∉ a ∧ A ∉ b by H1, a_line, Collinear_DEF, ∉, b_line; + ¬(a = l) ∧ ¬(b = l) by -, l_line, ∉; + a ∩ l = {A} ∧ b ∩ l = {B} [alA] by -, a_line, l_line, I1Uniqueness, b_line; + ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [AGB] by H2, B1'; + A ∉ open (G,B) ∧ B ∉ open (G,A) [notGAB] by H2, B3', B1', ∉; + G ∈ l [Gl] by l_line, H2, BetweenLinear; + G ∉ a ∧ G ∉ b [notGa] by alA, Gl, AGB, IN_DELETE, EquivIntersectionHelp; + G ∈ l ━ A ∧ B ∈ l ━ A ∧ G ∈ l ━ B ∧ A ∈ l ━ B by Gl, l_line, AGB, IN_DELETE; + G,B same_side a ∧ G,A same_side b by a_line, l_line, alA, -, notGAB, EquivIntersection, b_line; + qed by H1, a_line, b_line, notGa, -, IN_InteriorAngle; +`;; + +let InteriorUse = thm `; + let A O B P be point; + let a b be point_set; + assume Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b [aOAbOB]; + assume P ∈ int_angle A O B [P_AOB]; + thus P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b + + proof + consider α β such that ¬Collinear A O B ∧ + Line α ∧ O ∈ α ∧ A ∈ α ∧ + Line β ∧ O ∈ β ∧B ∈ β ∧ + P ∉ α ∧ P ∉ β ∧ + P,B same_side α ∧ P,A same_side β [exists] by P_AOB, IN_InteriorAngle; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) [Distinct] by -, NonCollinearImpliesDistinct; + α = a ∧ β = b by -, aOAbOB, exists, I1; + qed by -, exists; +`;; + +let InteriorEZHelp = thm `; + let A O B P be point; + assume P ∈ int_angle A O B [P_AOB]; + thus ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P + + proof + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧B ∈ b ∧ + P ∉ a ∧ P ∉ b [def_int] by P_AOB, IN_InteriorAngle; + ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) [PnotAOB] by -, ∉; + ¬(A = O) [notAO] by def_int, NonCollinearImpliesDistinct; + ¬Collinear A O P by def_int, notAO, -, I1, Collinear_DEF, ∉; + qed by PnotAOB, -; +`;; + +let InteriorAngleSymmetry = thm `; + ∀ A O B P: point. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A + by IN_InteriorAngle, CollinearSymmetry; +`;; + +let InteriorWellDefined = thm `; + let A O B X P be point; + assume P ∈ int_angle A O B [H1]; + assume X ∈ ray O B ━ O [H2]; + thus P ∈ int_angle A O X + + proof + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ P ∉ b ∧ + P,B same_side a ∧ P,A same_side b [def_int] by H1, IN_InteriorAngle; + ¬(X = O) ∧ ¬(O = B) ∧ Collinear O B X [H2'] by H2, IN_DELETE, IN_Ray; + B ∉ a [notBa] by def_int, Collinear_DEF, ∉; + ¬Collinear A O X [AOXnoncol] by def_int, H2', NoncollinearityExtendsToLine; + X ∈ b [Xb] by def_int, H2', CollinearLinear; + X ∉ a ∧ B,X same_side a by def_int, notBa, H2, RaySameSide, SameSideSymmetric; + P,X same_side a by def_int, -, notBa, SameSideTransitive; + qed by AOXnoncol, def_int, Xb, -, IN_InteriorAngle; +`;; + +let WholeRayInterior = thm `; + let A O B X P be point; + assume X ∈ int_angle A O B [XintAOB]; + assume P ∈ ray O X ━ O [PrOX]; + thus P ∈ int_angle A O B + + proof + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ X ∉ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ X ∉ b ∧ + X,B same_side a ∧ X,A same_side b [def_int] by XintAOB, IN_InteriorAngle; + P ∉ a ∧ P,X same_side a ∧ P ∉ b ∧ P,X same_side b [Psim_abX] by def_int, PrOX, RaySameSide; + P,B same_side a ∧ P,A same_side b by -, def_int, Collinear_DEF, SameSideTransitive, ∉; + qed by def_int, Psim_abX, -, IN_InteriorAngle; +`;; + +let AngleOrdering = thm `; + let O A P Q be point; + let a be point_set; + assume ¬(O = A) [H1]; + assume Line a ∧ O ∈ a ∧ A ∈ a [H2]; + assume P ∉ a ∧ Q ∉ a [H3]; + assume P, Q same_side a [H4]; + assume ¬Collinear P O Q [H5]; + thus P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A + + proof + ¬(P = O) ∧ ¬(P = Q) ∧ ¬(O = Q) [Distinct] by H5, NonCollinearImpliesDistinct; + consider q such that + Line q ∧ O ∈ q ∧ Q ∈ q [q_line] by Distinct, I1; + P ∉ q [notPq] by -, Collinear_DEF, H5, ∉; + assume ¬(P ∈ int_angle Q O A) [notPintQOA]; + ¬Collinear Q O A ∧ ¬Collinear P O A [POAncol] by H1, H2, I1, Collinear_DEF, H3, ∉; + ¬(P,A same_side q) by -, H2, q_line, H3, notPq, H4, notPintQOA, IN_InteriorAngle; + consider G such that + G ∈ q ∧ G ∈ open (P,A) [existG] by q_line, -, SameSide_DEF; + G ∈ int_angle P O A [G_POA] by POAncol, existG, ConverseCrossbar; + G ∉ a ∧ G,P same_side a ∧ ¬(G = O) [Gsim_aP] by -, IN_InteriorAngle, H1, H2, I1, ∉; + G,Q same_side a by H2, Gsim_aP, H3, H4, SameSideTransitive; + O ∉ open (Q,G) [notQOG] by -, SameSide_DEF, H2, B1', ∉; + Collinear O G Q by q_line, existG, Collinear_DEF; + Q ∈ ray O G ━ O by Gsim_aP, -, notQOG, IN_Ray, Distinct, IN_DELETE; + qed by G_POA, -, WholeRayInterior; +`;; + +let InteriorsDisjointSupplement = thm `; + let A O B A' be point; + assume ¬Collinear A O B [H1]; + assume O ∈ open (A,A') [H2]; + thus int_angle B O A' ∩ int_angle A O B = ∅ + + proof + ∀ D. D ∈ int_angle A O B ⇒ D ∉ int_angle B O A' + proof + let D be point; + assume D ∈ int_angle A O B [H3]; + ¬(A = O) ∧ ¬(O = B) by H1, NonCollinearImpliesDistinct; + consider a b such that + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ A' ∈ a [ab_line] by -, I1, H2, BetweenLinear; + ¬Collinear B O A' by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; + A ∉ b ∧ A' ∉ b [notAb] by ab_line, Collinear_DEF, H1, -, ∉; + ¬(A',A same_side b) [A'nsim_bA] by ab_line, H2, B1', SameSide_DEF ; + D ∉ b ∧ D,A same_side b [DintAOB] by ab_line, H3, InteriorUse; + ¬(D,A' same_side b) by ab_line, notAb, DintAOB, A'nsim_bA, SameSideSymmetric, SameSideTransitive; + qed by ab_line, -, InteriorUse, ∉; + qed by -, DisjointOneNotOther; +`;; + +let InteriorReflectionInterior = thm `; + let A O B D A' be point; + assume O ∈ open (A,A') [H1]; + assume D ∈ int_angle A O B [H2]; + thus B ∈ int_angle D O A' + + proof + consider a b such that + ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ D ∉ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b ∧ D ∉ b ∧ D,B same_side a [DintAOB] by H2, IN_InteriorAngle; + ¬(O = B) ∧ ¬(O = A') ∧ B ∉ a [Distinct] by -, NonCollinearImpliesDistinct, H1, B1', Collinear_DEF, ∉; + ¬Collinear D O B [DOB_ncol] by DintAOB, -, I1, Collinear_DEF, ∉; + A' ∈ a [A'a] by H1, DintAOB, BetweenLinear; + D ∉ int_angle B O A' by DintAOB, H1, InteriorsDisjointSupplement, H2, DisjointOneNotOther; + qed by Distinct, DintAOB, A'a, DOB_ncol, -, AngleOrdering, ∉; +`;; + +let Crossbar_THM = thm `; + let O A B D be point; + assume D ∈ int_angle A O B [H1]; + thus ∃ G. G ∈ open (A,B) ∧ G ∈ ray O D ━ O + + proof + consider a b such that + ¬Collinear A O B ∧ + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b ∧ + D ∉ a ∧ D ∉ b ∧ D,B same_side a ∧ D,A same_side b [DintAOB] by H1, IN_InteriorAngle; + B ∉ a [notBa] by DintAOB, Collinear_DEF, ∉; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(D = O) [Distinct] by DintAOB, NonCollinearImpliesDistinct, ∉; + consider l such that + Line l ∧ O ∈ l ∧ D ∈ l [l_line] by -, I1; + consider A' such that + O ∈ open (A,A') [AOA'] by Distinct, B2'; + A' ∈ a ∧ Collinear A O A' ∧ ¬(A' = O) [A'a] by DintAOB, -, BetweenLinear, B1'; + ¬(A,A' same_side l) [Ansim_lA'] by l_line, AOA', SameSide_DEF; + B ∈ int_angle D O A' by H1, AOA', InteriorReflectionInterior; + B,A' same_side l [Bsim_lA'] by l_line, DintAOB, A'a, -, InteriorUse; + ¬Collinear A O D ∧ ¬Collinear B O D [AODncol] by H1, InteriorEZHelp, InteriorAngleSymmetry; + ¬Collinear D O A' by -, CollinearSymmetry, A'a, NoncollinearityExtendsToLine; + A ∉ l ∧ B ∉ l ∧ A' ∉ l by l_line, Collinear_DEF, AODncol, -, ∉; + ¬(A,B same_side l) by l_line, -, Bsim_lA', Ansim_lA', SameSideTransitive; + consider G such that + G ∈ open (A,B) ∧ G ∈ l [AGB] by l_line, -, SameSide_DEF; + Collinear O D G [ODGcol] by -, l_line, Collinear_DEF; + G ∈ int_angle A O B by DintAOB, AGB, ConverseCrossbar; + G ∉ a ∧ G,B same_side a ∧ ¬(G = O) [Gsim_aB] by DintAOB, -, InteriorUse, ∉; + B,D same_side a by DintAOB, notBa, SameSideSymmetric; + G,D same_side a [Gsim_aD] by DintAOB, Gsim_aB, notBa, -, SameSideTransitive; + O ∉ open (G,D) by DintAOB, -, SameSide_DEF, ∉; + G ∈ ray O D ━ O by Distinct, ODGcol, -, IN_Ray, Gsim_aB, IN_DELETE; + qed by AGB, -; +`;; + +let AlternateConverseCrossbar = thm `; + let O A B G be point; + assume Collinear A G B ∧ G ∈ int_angle A O B [H1]; + thus G ∈ open (A,B) + + proof + consider a b such that + ¬Collinear A O B ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + G,B same_side a ∧ G,A same_side b [GintAOB] by H1, IN_InteriorAngle; + ¬(A = B) ∧ ¬(G = A) ∧ ¬(G = B) ∧ A ∉ open (G,B) ∧ B ∉ open (G,A) by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SameSide_DEF, ∉; + qed by -, H1, B1', B3', ∉; +`;; + +let InteriorOpposite = thm `; + let A O B P be point; + let p be point_set; + assume P ∈ int_angle A O B [PintAOB]; + assume Line p ∧ O ∈ p ∧ P ∈ p [p_line]; + thus ¬(A,B same_side p) + + proof + consider G such that + G ∈ open (A,B) ∧ G ∈ ray O P [Gexists] by PintAOB, Crossbar_THM, IN_DELETE; + G ∈ p by p_line, RayLine, -, SUBSET; + qed by p_line, -, Gexists, SameSide_DEF; +`;; + +let IntervalTransitivity = thm `; + let O P Q R be point; + let m be point_set; + assume Line m ∧ O ∈ m [H0]; + assume P ∈ m ━ O ∧ Q ∈ m ━ O ∧ R ∈ m ━ O [H2]; + assume O ∉ open (P,Q) ∧ O ∉ open (Q,R) [H3]; + thus O ∉ open (P,R) + + proof + consider E such that + E ∉ m ∧ ¬(O = E) [notEm] by H0, ExistsPointOffLine, ∉; + consider l such that + Line l ∧ O ∈ l ∧ E ∈ l [l_line] by -, I1; + ¬(m = l) by notEm, -, ∉; + l ∩ m = {O} [lmO] by l_line, H0, -, l_line, I1Uniqueness; + P ∉ l ∧ Q ∉ l ∧ R ∉ l [notPQRl] by -, H2, EquivIntersectionHelp; + P,Q same_side l ∧ Q,R same_side l by l_line, H0, lmO, H2, H3, EquivIntersection; + P,R same_side l [Psim_lR] by l_line, notPQRl, -, SameSideTransitive; + qed by l_line, -, SameSide_DEF, ∉; +`;; + +let RayWellDefinedHalfway = thm `; + let O P Q be point; + assume ¬(Q = O) [H1]; + assume P ∈ ray O Q ━ O [H2]; + thus ray O P ⊂ ray O Q + + proof + consider m such that + Line m ∧ O ∈ m ∧ Q ∈ m [OQm] by H1, I1; + P ∈ ray O Q ∧ ¬(P = O) ∧ O ∉ open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; + P ∈ m ∧ P ∈ m ━ O ∧ Q ∈ m ━ O [PQm_O] by OQm, H2', RayLine, SUBSET, H2', OQm, H1, IN_DELETE; + O ∉ open (P,Q) [notPOQ] by H2', IN_Ray; + ∀ X. X ∈ ray O P ⇒ X ∈ ray O Q + proof + let X be point; + assume X ∈ ray O P; + X ∈ m ∧ O ∉ open (X,P) [XrOP] by OQm, PQm_O, H2', -, RayLine, SUBSET, IN_Ray; + Collinear O Q X [OQXcol] by OQm, -, Collinear_DEF; + cases; + suppose X = O; + qed by H1, -, OriginInRay; + suppose ¬(X = O); + X ∈ m ━ O by XrOP, -, IN_DELETE; + O ∉ open (X,Q) by OQm, -, PQm_O, XrOP, H2', IntervalTransitivity; + qed by H1, OQXcol, -, IN_Ray; + end; + qed by -, SUBSET; +`;; + +let RayWellDefined = thm `; + let O P Q be point; + assume ¬(Q = O) [H1]; + assume P ∈ ray O Q ━ O [H2]; + thus ray O P = ray O Q + + proof + ray O P ⊂ ray O Q [PsubsetQ] by H1, H2, RayWellDefinedHalfway; + ¬(P = O) ∧ Collinear O Q P ∧ O ∉ open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; + Q ∈ ray O P ━ O by H2', B1', ∉, CollinearSymmetry, IN_Ray, H1, IN_DELETE; + ray O Q ⊂ ray O P [QsubsetP] by H2', -, RayWellDefinedHalfway; + qed by PsubsetQ, QsubsetP, SUBSET_ANTISYM; +`;; + +let OppositeRaysIntersect1pointHelp = thm `; + let A O B X be point; + assume O ∈ open (A,B) [H1]; + assume X ∈ ray O B ━ O [H2]; + thus X ∉ ray O A ∧ O ∈ open (X,A) + + proof + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ Collinear A O B [AOB] by H1, B1'; + ¬(X = O) ∧ Collinear O B X ∧ O ∉ open (X,B) [H2'] by H2, IN_DELETE, IN_Ray; + consider m such that + Line m ∧ A ∈ m ∧ B ∈ m [m_line] by AOB, I1; + O ∈ m ∧ X ∈ m [Om] by m_line, H2', AOB, CollinearLinear; + A ∈ m ━ O ∧ X ∈ m ━ O ∧ B ∈ m ━ O by m_line, -, H2', AOB, IN_DELETE; + O ∈ open (X,A) by H1, m_line, Om, -, H2', IntervalTransitivity, ∉, B1'; + qed by -, IN_Ray, ∉; +`;; + +let OppositeRaysIntersect1point = thm `; + let A O B be point; + assume O ∈ open (A,B) [H1]; + thus ray O A ∩ ray O B = {O} + + proof + ¬(A = O) ∧ ¬(O = B) by H1, B1'; + {O} ⊂ ray O A ∩ ray O B [Osubset_rOA] by -, OriginInRay, IN_INTER, SING_SUBSET; + ∀ X. ¬(X = O) ∧ X ∈ ray O B ⇒ X ∉ ray O A + by IN_DELETE, H1, OppositeRaysIntersect1pointHelp; + ray O A ∩ ray O B ⊂ {O} by -, IN_INTER, IN_SING, SUBSET, ∉; + qed by -, Osubset_rOA, SUBSET_ANTISYM; +`;; + +let IntervalRay = thm `; + ∀ A B C:point. B ∈ open (A,C) ⇒ ray A B = ray A C + by B1', IntervalRayEZ, RayWellDefined; +`;; + +let TransitivityBetweennessHelp = thm `; + let A B C D be point; + assume B ∈ open (A,C) ∧ C ∈ open (B,D) [H1]; + thus B ∈ open (A,D) + + proof + D ∈ ray B C ━ B by H1, IntervalRayEZ; + qed by H1, -, OppositeRaysIntersect1pointHelp, B1'; +`;; + +let TransitivityBetweenness = thm `; + let A B C D be point; + assume B ∈ open (A,C) ∧ C ∈ open (B,D) [H1]; + thus ordered A B C D + + proof + B ∈ open (A,D) [ABD] by H1, TransitivityBetweennessHelp; + C ∈ open (D,B) ∧ B ∈ open (C,A) by H1, B1'; + C ∈ open (D,A) by -, TransitivityBetweennessHelp; + qed by H1, ABD, -, B1', Ordered_DEF; +`;; + +let IntervalsAreConvex = thm `; + let A B C be point; + assume B ∈ open (A,C) [H1]; + thus open (A,B) ⊂ open (A,C) + + proof + ∀ X. X ∈ open (A,B) ⇒ X ∈ open (A,C) + proof + let X be point; + assume X ∈ open (A,B) [AXB]; + X ∈ ray B A ━ B by AXB, B1', IntervalRayEZ; + B ∈ open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; + qed by AXB, -, TransitivityBetweennessHelp; + qed by -, SUBSET; +`;; + +let TransitivityBetweennessVariant = thm `; + let A X B C be point; + assume X ∈ open (A,B) ∧ B ∈ open (A,C) [H1]; + thus ordered A X B C + + proof + X ∈ ray B A ━ B by H1, B1', IntervalRayEZ; + B ∈ open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; + qed by H1, -, TransitivityBetweenness; +`;; + +let Interval2sides2aLineHelp = thm `; + let A B C X be point; + assume B ∈ open (A,C) [H1]; + thus X ∉ open (A,B) ∨ X ∉ open (B,C) + + proof + assume ¬(X ∉ open (A,B)); + ordered A X B C by -, ∉, H1, TransitivityBetweennessVariant; + B ∈ open (X,C) by -, Ordered_DEF; + X ∉ open (C,B) by -, B1', B3', ∉; + qed by -, B1', ∉; +`;; + +let Interval2sides2aLine = thm `; + let A B C X be point; + assume Collinear A B C [H1]; + thus X ∉ open (A,B) ∨ X ∉ open (A,C) ∨ X ∉ open (B,C) + + proof + cases; + suppose A = B ∨ A = C ∨ B = C; + qed by -, B1', ∉; + suppose ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C); + B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) by -, H1, B3'; + qed by -, Interval2sides2aLineHelp, B1', ∉; + end; +`;; + +let TwosidesTriangle2aLine = thm `; + let A B C Y be point; + let l m be point_set; + assume Line l ∧ ¬Collinear A B C [H1]; + assume A ∉ l ∧ B ∉ l ∧ C ∉ l [off_l]; + assume Line m ∧ A ∈ m ∧ C ∈ m [m_line]; + assume Y ∈ l ∧ Y ∈ m [Ylm]; + assume ¬(A,B same_side l) ∧ ¬(B,C same_side l) [H2]; + thus A,C same_side l + + proof + consider X Z such that + X ∈ l ∧ X ∈ open (A,B) ∧ Z ∈ l ∧ Z ∈ open (C,B) [H2'] by H1, H2, SameSide_DEF, B1'; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Y ∈ m ━ A ∧ Y ∈ m ━ C ∧ C ∈ m ━ A ∧ A ∈ m ━ C [Distinct] by H1, NonCollinearImpliesDistinct, Ylm, off_l, ∉, m_line, IN_DELETE; + consider p such that + Line p ∧ B ∈ p ∧ A ∈ p [p_line] by Distinct, I1; + consider q such that + Line q ∧ B ∈ q ∧ C ∈ q [q_line] by Distinct, I1; + X ∈ p ∧ Z ∈ q [Xp] by p_line, H2', BetweenLinear, q_line, H2'; + A ∉ q ∧ B ∉ m ∧ C ∉ p [vertex_off_line] by q_line, m_line, p_line, H1, Collinear_DEF, ∉; + X ∉ q ∧ X,A same_side q ∧ Z ∉ p ∧ Z,C same_side p [Xsim_qA] by q_line, p_line, -, H2', B1', IntervalRayEZ, RaySameSide; + ¬(m = p) ∧ ¬(m = q) by m_line, vertex_off_line, ∉; + p ∩ m = {A} ∧ q ∩ m = {C} [pmA] by p_line, m_line, q_line, H1, -, Xp, H2', I1Uniqueness; + Y ∉ p ∧ Y ∉ q [notYpq] by -, Distinct, EquivIntersectionHelp; + X ∈ ray A B ━ A ∧ Z ∈ ray C B ━ C by H2', IntervalRayEZ, H2', B1'; + X ∉ m ∧ Z ∉ m ∧ X,B same_side m ∧ B,Z same_side m [notXZm] by m_line, vertex_off_line, -, RaySameSide, SameSideSymmetric; + X,Z same_side m by m_line, -, vertex_off_line, SameSideTransitive; + Collinear X Y Z ∧ Y ∉ open (X,Z) ∧ ¬(Y = X) ∧ ¬(Y = Z) ∧ ¬(X = Z) by H1, H2', Ylm, Collinear_DEF, m_line, -, SameSide_DEF, notXZm, Xsim_qA, Xp, ∉; + Z ∈ open (X,Y) ∨ X ∈ open (Z,Y) by -, B3', ∉, B1'; + cases by -; + suppose X ∈ open (Z,Y); + ¬(Z,Y same_side p) by p_line, Xp, -, SameSide_DEF; + ¬(C,Y same_side p) by p_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; + A ∈ open (C,Y) by p_line, m_line, pmA, Distinct, -, EquivIntersection, ∉; + qed by H1, Ylm, off_l, -, B1', IntervalRayEZ, RaySameSide; + suppose Z ∈ open (X,Y); + ¬(X,Y same_side q) by q_line, Xp, -, SameSide_DEF; + ¬(A,Y same_side q) by q_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; + C ∈ open (Y,A) by q_line, m_line, pmA, Distinct, -, EquivIntersection, ∉, B1'; + qed by H1, Ylm, off_l, -, IntervalRayEZ, RaySameSide; + end; +`;; + +let LineUnionOf2Rays = thm `; + let A O B be point; + let l be point_set; + assume Line l ∧ A ∈ l ∧ B ∈ l [H1]; + assume O ∈ open (A,B) [H2]; + thus l = ray O A ∪ ray O B + + proof + ¬(A = O) ∧ ¬(O = B) ∧ O ∈ l [Distinct] by H2, B1', H1, BetweenLinear; + ray O A ∪ ray O B ⊂ l [AOBsub_l] by H1, -, RayLine, UNION_SUBSET; + ∀ X. X ∈ l ⇒ X ∈ ray O A ∨ X ∈ ray O B + proof + let X be point; + assume X ∈ l [Xl]; + assume ¬(X ∈ ray O B) [notXrOB]; + Collinear O B X ∧ Collinear X A B ∧ Collinear O A X [XABcol] by Distinct, H1, Xl, Collinear_DEF; + O ∈ open (X,B) by notXrOB, Distinct, -, IN_Ray, ∉; + O ∉ open (X,A) by ∉, B1', XABcol, -, H2, Interval2sides2aLine; + qed by Distinct, XABcol, -, IN_Ray; + l ⊂ ray O A ∪ ray O B by -, IN_UNION, SUBSET; + qed by -, AOBsub_l, SUBSET_ANTISYM; +`;; + +let AtMost2Sides = thm `; + let A B C be point; + let l be point_set; + assume Line l [H1]; + assume A ∉ l ∧ B ∉ l ∧ C ∉ l [H2]; + thus A,B same_side l ∨ A,C same_side l ∨ B,C same_side l + + proof + cases; + suppose A = C; + qed by -, H1, H2, SameSideReflexive; + suppose ¬(A = C) [notAC]; + consider m such that + Line m ∧ A ∈ m ∧ C ∈ m [m_line] by notAC, I1; + cases; + suppose m ∩ l = ∅; + A,C same_side l by m_line, H1, -, BetweenLinear, SET_RULE, SameSide_DEF; + qed by -; + suppose ¬(m ∩ l = ∅); + consider Y such that + Y ∈ l ∧ Y ∈ m [Ylm] by -, IN_INTER, MEMBER_NOT_EMPTY; + cases; + suppose ¬Collinear A B C; + qed by H1, -, H2, m_line, Ylm, TwosidesTriangle2aLine; + suppose Collinear A B C [ABCcol]; + B ∈ m [Bm] by -, m_line, notAC, I1, Collinear_DEF; + ¬(Y = A) ∧ ¬(Y = B) ∧ ¬(Y = C) [YnotABC] by Ylm, H2, ∉; + Y ∉ open (A,B) ∨ Y ∉ open (A,C) ∨ Y ∉ open (B,C) by ABCcol, Interval2sides2aLine; + A ∈ ray Y B ━ Y ∨ A ∈ ray Y C ━ Y ∨ B ∈ ray Y C ━ Y by YnotABC, m_line, Bm, Ylm, Collinear_DEF, -, IN_Ray, IN_DELETE; + qed by H1, Ylm, H2, -, RaySameSide; + end; + end; + end; +`;; + +let FourPointsOrder = thm `; + let A B C X be point; + let l be point_set; + assume Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l [H1]; + assume ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) [H2]; + assume B ∈ open (A,C) [H3]; + thus ordered X A B C ∨ ordered A X B C ∨ + ordered A B X C ∨ ordered A B C X + + proof + A ∈ open (X,B) ∨ X ∈ open (A,B) ∨ X ∈ open (B,C) ∨ C ∈ open (B,X) + proof + ¬(A = B) ∧ ¬(B = C) [ABCdistinct] by H3, B1'; + Collinear A B X ∧ Collinear A C X ∧ Collinear C B X [ACXcol] by H1, Collinear_DEF; + A ∈ open (X,B) ∨ X ∈ open (A,B) ∨ B ∈ open (A,X) by H2, ABCdistinct, -, B3', B1'; + cases by -; + suppose A ∈ open (X,B) ∨ X ∈ open (A,B); + qed by -; + suppose B ∈ open (A,X); + B ∉ open (C,X) by ACXcol, H3, -, Interval2sides2aLine, ∉; + qed by H2, ABCdistinct, ACXcol, -, B3', B1', ∉; + end; + qed by -, H3, B1', TransitivityBetweenness, TransitivityBetweennessVariant, Reverse4Order; +`;; + +let HilbertAxiomRedundantByMoore = thm `; + let A B C D be point; + let l be point_set; + assume Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l [H1]; + assume ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) [H2]; + thus ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ ordered A B C D ∨ + ordered D A C B ∨ ordered A D C B ∨ ordered A C D B ∨ ordered A C B D ∨ + ordered D C A B ∨ ordered C D A B ∨ ordered C A D B ∨ ordered C A B D + + proof + Collinear A B C by H1, Collinear_DEF; + B ∈ open (A,C) ∨ C ∈ open (A,B) ∨ A ∈ open (C,B) by H2, -, B3', B1'; + qed by -, H1, H2, FourPointsOrder; +`;; + +let InteriorTransitivity = thm `; + let A O B F G be point; + assume G ∈ int_angle A O B [GintAOB]; + assume F ∈ int_angle A O G [FintAOG]; + thus F ∈ int_angle A O B + + proof + ¬Collinear A O B [AOBncol] by GintAOB, IN_InteriorAngle; + consider G' such that + G' ∈ open (A,B) ∧ G' ∈ ray O G ━ O [CrossG] by GintAOB, Crossbar_THM; + F ∈ int_angle A O G' by FintAOG, -, InteriorWellDefined; + consider F' such that + F' ∈ open (A,G') ∧ F' ∈ ray O F ━ O [CrossF] by -, Crossbar_THM; + ¬(F' = O) ∧ ¬(F = O) ∧ Collinear O F F' ∧ O ∉ open (F',F) by -, IN_DELETE, IN_Ray; + F ∈ ray O F' ━ O [FrOF'] by -, CollinearSymmetry, B1', ∉, IN_Ray, IN_DELETE; + open (A,G') ⊂ open (A,B) ∧ F' ∈ open (A,B) by CrossG, IntervalsAreConvex, CrossF, SUBSET; + F' ∈ int_angle A O B by AOBncol, -, ConverseCrossbar; + qed by -, FrOF', WholeRayInterior; +`;; + +let HalfPlaneConvexNonempty = thm `; + let l H be point_set; + let A be point; + assume Line l ∧ A ∉ l [l_line]; + assume H = {X | X ∉ l ∧ X,A same_side l} [HalfPlane]; + thus ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H + + proof + ∀ X. X ∈ H ⇔ X ∉ l ∧ X,A same_side l [Hdef] by HalfPlane, SET_RULE; + H ⊂ complement l [Hsub] by -, IN_PlaneComplement, SUBSET; + A,A same_side l ∧ A ∈ H by l_line, SameSideReflexive, Hdef; + ¬(H = ∅) [Hnonempty] by -, MEMBER_NOT_EMPTY; + ∀ P Q X. P ∈ H ∧ Q ∈ H ∧ X ∈ open (P,Q) ⇒ X ∈ H + proof + let P Q X be point; + assume P ∈ H ∧ Q ∈ H ∧ X ∈ open (P,Q) [PXQ]; + P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,A same_side l [PQinH] by -, Hdef; + P,Q same_side l [Psim_lQ] by l_line, -, SameSideSymmetric, SameSideTransitive; + X ∉ l [notXl] by -, PXQ, SameSide_DEF, ∉; + open (X,P) ⊂ open (P,Q) by PXQ, IntervalsAreConvex, B1', SUBSET; + X,P same_side l by l_line, -, SUBSET, Psim_lQ, SameSide_DEF; + X,A same_side l by l_line, notXl, PQinH, -, Psim_lQ, PQinH, SameSideTransitive; + qed by -, notXl, Hdef; + Convex H by -, SUBSET, CONVEX; + qed by Hnonempty, Hsub, -; +`;; + +let PlaneSeparation = thm `; + let l be point_set; + assume Line l [l_line]; + thus ∃ H1 H2:point_set. H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ + Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ + ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) + + proof + consider A such that + A ∉ l [notAl] by l_line, ExistsPointOffLine; + consider E such that + E ∈ l ∧ ¬(A = E) [El] by l_line, I2, -, ∉; + consider B such that + E ∈ open (A,B) ∧ ¬(E = B) ∧ Collinear A E B [AEB] by -, B2', B1'; + B ∉ l [notBl] by l_line, El, -, I1, Collinear_DEF, notAl, ∉; + ¬(A,B same_side l) [Ansim_lB] by l_line, El, AEB, SameSide_DEF; + consider H1 H2 such that + H1 = {X | X ∉ l ∧ X,A same_side l} ∧ H2 = {X | X ∉ l ∧ X,B same_side l} [H12sets]; + ∀ X. (X ∈ H1 ⇔ X ∉ l ∧ X,A same_side l) ∧ (X ∈ H2 ⇔ X ∉ l ∧ X,B same_side l) [H12def] by -, SET_RULE; + ∀ X. X ∈ H1 ⇔ X ∉ l ∧ X,A same_side l [H1def] by H12sets, SET_RULE; + ∀ X. X ∈ H2 ⇔ X ∉ l ∧ X,B same_side l [H2def] by H12sets, SET_RULE; + H1 ∩ H2 = ∅ [H12disjoint] + proof + assume ¬(H1 ∩ H2 = ∅); + consider V such that + V ∈ H1 ∧ V ∈ H2 by -, MEMBER_NOT_EMPTY, IN_INTER; + V ∉ l ∧ V,A same_side l ∧ V ∉ l ∧ V,B same_side l by -, H12def; + A,B same_side l by l_line, -, notAl, notBl, SameSideSymmetric, SameSideTransitive; + qed by -, Ansim_lB; + ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ H1 ⊂ complement l ∧ H2 ⊂ complement l ∧ Convex H1 ∧ Convex H2 [H12convex_nonempty] by l_line, notAl, notBl, H12sets, HalfPlaneConvexNonempty; + H1 ∪ H2 ⊂ complement l [H12sub] by H12convex_nonempty, UNION_SUBSET; + ∀ C. C ∈ complement l ⇒ C ∈ H1 ∪ H2 + proof + let C be point; + assume C ∈ complement l; + C ∉ l [notCl] by -, IN_PlaneComplement; + C,A same_side l ∨ C,B same_side l by l_line, notAl, notBl, -, Ansim_lB, AtMost2Sides; + C ∈ H1 ∨ C ∈ H2 by notCl, -, H12def; + qed by -, IN_UNION; + complement l ⊂ H1 ∪ H2 by -, SUBSET; + complement l = H1 ∪ H2 [compl_H1unionH2] by H12sub, -, SUBSET_ANTISYM; + ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) [opp_sides] + proof + let P Q be point; + assume P ∈ H1 ∧ Q ∈ H2; + P ∉ l ∧ P,A same_side l ∧ Q ∉ l ∧ Q,B same_side l [PH1_QH2] by -, H12def, IN; + qed by l_line, -, notAl, SameSideSymmetric, notBl, Ansim_lB, SameSideTransitive; + qed by H12disjoint, H12convex_nonempty, compl_H1unionH2, opp_sides; +`;; + +let TetralateralSymmetry = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + thus Tetralateral B C D A ∧ Tetralateral A B D C + + proof + ¬Collinear A B D ∧ ¬Collinear B D C ∧ ¬Collinear D C A ∧ ¬Collinear C A B [TetraABCD] by H1, Tetralateral_DEF, CollinearSymmetry; + qed by H1, -, Tetralateral_DEF; +`;; + +let EasyEmptyIntersectionsTetralateralHelp = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + thus open (A,B) ∩ open (B,C) = ∅ + + proof + ∀ X. X ∈ open (B,C) ⇒ X ∉ open (A,B) + proof + let X be point; + assume X ∈ open (B,C); + ¬Collinear A B C ∧ Collinear B X C ∧ ¬(X = B) by H1, Tetralateral_DEF, -, B1'; + ¬Collinear A X B by -, CollinearSymmetry, B1', NoncollinearityExtendsToLine; + qed by -, B1', ∉; + qed by -, DisjointOneNotOther; +`;; + +let EasyEmptyIntersectionsTetralateral = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + thus open (A,B) ∩ open (B,C) = ∅ ∧ open (B,C) ∩ open (C,D) = ∅ ∧ + open (C,D) ∩ open (D,A) = ∅ ∧ open (D,A) ∩ open (A,B) = ∅ + + proof + Tetralateral B C D A ∧ Tetralateral C D A B ∧ Tetralateral D A B C by H1, TetralateralSymmetry; + qed by H1, -, EasyEmptyIntersectionsTetralateralHelp; +`;; + +let SegmentSameSideOppositeLine = thm `; + let A B C D be point; + let a c be point_set; + assume Quadrilateral A B C D [H1]; + assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; + assume Line c ∧ C ∈ c ∧ D ∈ c [c_line]; + thus A,B same_side c ∨ C,D same_side a + + proof + assume ¬(C,D same_side a); :: prove A,B same_side c + consider G such that + G ∈ a ∧ G ∈ open (C,D) [CGD] by -, a_line, SameSide_DEF; + G ∈ c ∧ Collinear G B A [Gc] by c_line, -, BetweenLinear, a_line, Collinear_DEF; + ¬Collinear B C D ∧ ¬Collinear C D A ∧ open (A,B) ∩ open (C,D) = ∅ [quadABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + A ∉ c ∧ B ∉ c ∧ ¬(A = G) ∧ ¬(B = G) [Distinct] by -, c_line, Collinear_DEF, ∉, Gc; + G ∉ open (A,B) by quadABCD, CGD, DisjointOneNotOther; + A ∈ ray G B ━ G by Distinct, Gc, -, IN_Ray, IN_DELETE; + qed by c_line, Gc, Distinct, -, RaySameSide; +`;; + +let ConvexImpliesQuad = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + assume C ∈ int_angle D A B ∧ D ∈ int_angle A B C [H2]; + thus Quadrilateral A B C D + + proof + ¬(A = B) ∧ ¬(B = C) ∧ ¬(A = D) [TetraABCD] by H1, Tetralateral_DEF; + consider a such that + Line a ∧ A ∈ a ∧ B ∈ a [a_line] by TetraABCD, I1; + consider b such that + Line b ∧ B ∈ b ∧ C ∈ b [b_line] by TetraABCD, I1; + consider d such that + Line d ∧ D ∈ d ∧ A ∈ d [d_line] by TetraABCD, I1; + open (B,C) ⊂ b ∧ open (A,B) ⊂ a [BCbABa] by b_line, a_line, BetweenLinear, SUBSET; + D,A same_side b ∧ C,D same_side a by H2, a_line, b_line, d_line, InteriorUse; + b ∩ open (D,A) = ∅ ∧ a ∩ open (C,D) = ∅ by -, b_line, SameSide_DEF, SET_RULE; + open (B,C) ∩ open (D,A) = ∅ ∧ open (A,B) ∩ open (C,D) = ∅ by BCbABa, -, SET_RULE; + qed by H1, -, Quadrilateral_DEF; +`;; + +let DiagonalsIntersectImpliesConvexQuad = thm `; + let A B C D G be point; + assume ¬Collinear B C D [BCDncol]; + assume G ∈ open (A,C) ∧ G ∈ open (B,D) [DiagInt]; + thus ConvexQuadrilateral A B C D + + proof + ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ ¬(C = A) ∧ ¬(A = G) ∧ ¬(D = G) ∧ ¬(B = G) [Distinct] by BCDncol, NonCollinearImpliesDistinct, DiagInt, B1'; + Collinear A G C ∧ Collinear B G D [AGCcol] by DiagInt, B1'; + ¬Collinear C D A [CDAncol] by BCDncol, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; + ¬Collinear D A B [DABncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; + ¬Collinear A B C [ABCncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; + ¬(A = B) ∧ ¬(A = D) by DABncol, NonCollinearImpliesDistinct; + Tetralateral A B C D [TetraABCD] by Distinct, -, BCDncol, CDAncol, DABncol, ABCncol, Tetralateral_DEF; + A ∈ ray C G ━ C ∧ B ∈ ray D G ━ D ∧ C ∈ ray A G ━ A ∧ D ∈ ray B G ━ B [ArCG] by DiagInt, B1', IntervalRayEZ; + G ∈ int_angle B C D ∧ G ∈ int_angle C D A ∧ G ∈ int_angle D A B ∧ G ∈ int_angle A B C by BCDncol, CDAncol, DABncol, ABCncol, DiagInt, B1', ConverseCrossbar; + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ C ∈ int_angle D A B ∧ D ∈ int_angle A B C by -, ArCG, WholeRayInterior; + qed by TetraABCD, -, ConvexImpliesQuad, ConvexQuad_DEF; +`;; + +let DoubleNotSimImpliesDiagonalsIntersect = thm `; + let A B C D be point; + let l m be point_set; + assume Line l ∧ A ∈ l ∧ C ∈ l [l_line]; + assume Line m ∧ B ∈ m ∧ D ∈ m [m_line]; + assume Tetralateral A B C D [H1]; + assume ¬(B,D same_side l) [H2]; + assume ¬(A,C same_side m) [H3]; + thus (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ConvexQuadrilateral A B C D + + proof + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; + consider G such that + G ∈ open (A,C) ∧ G ∈ m [AGC] by H3, m_line, SameSide_DEF; + G ∈ l [Gl] by l_line, -, BetweenLinear; + A ∉ m ∧ B ∉ l ∧ D ∉ l by TetraABCD, m_line, l_line, Collinear_DEF, ∉; + ¬(l = m) ∧ B ∈ m ━ G ∧ D ∈ m ━ G [BDm_G] by -, l_line, ∉, m_line, Gl, IN_DELETE; + l ∩ m = {G} by l_line, m_line, -, Gl, AGC, I1Uniqueness; + G ∈ open (B,D) by l_line, m_line, -, BDm_G, H2, EquivIntersection, ∉; + qed by AGC, -, IN_INTER, TetraABCD, DiagonalsIntersectImpliesConvexQuad; +`;; + +let ConvexQuadImpliesDiagonalsIntersect = thm `; + let A B C D be point; + let l m be point_set; + assume Line l ∧ A ∈ l ∧ C ∈ l [l_line]; + assume Line m ∧ B ∈ m ∧ D ∈ m [m_line]; + assume ConvexQuadrilateral A B C D [ConvQuadABCD]; + thus ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ + (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ ¬Quadrilateral A B D C + + proof + Tetralateral A B C D ∧ A ∈ int_angle B C D ∧ D ∈ int_angle A B C [convquadABCD] by ConvQuadABCD, ConvexQuad_DEF, Quadrilateral_DEF; + ¬(B,D same_side l) ∧ ¬(A,C same_side m) [opp_sides] by convquadABCD, l_line, m_line, InteriorOpposite; + consider G such that + G ∈ open (A,C) ∩ open (B,D) [Gexists] by l_line, m_line, convquadABCD, opp_sides, DoubleNotSimImpliesDiagonalsIntersect; + ¬(open (B,D) ∩ open (C,A) = ∅) by -, IN_INTER, B1', MEMBER_NOT_EMPTY; + ¬Quadrilateral A B D C by -, Quadrilateral_DEF; + qed by opp_sides, Gexists, -; +`;; + +let FourChoicesTetralateralHelp = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + assume C ∈ int_angle D A B [CintDAB]; + thus ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B + + proof + ¬(A = B) ∧ ¬(D = A) ∧ ¬(A = C) ∧ ¬(B = D) ∧ ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; + consider a d such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line d ∧ D ∈ d ∧ A ∈ d [ad_line] by TetraABCD, I1; + consider l m such that + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by TetraABCD, I1; + C ∉ a ∧ C ∉ d ∧ B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m ∧ ¬Collinear A B D ∧ ¬Collinear B D A [tetra'] by TetraABCD, ad_line, lm_line, Collinear_DEF, ∉, CollinearSymmetry; + ¬(B,D same_side l) [Bsim_lD] by CintDAB, lm_line, InteriorOpposite, -, SameSideSymmetric; + cases; + suppose ¬(A,C same_side m); + qed by lm_line, H1, Bsim_lD, -, DoubleNotSimImpliesDiagonalsIntersect; + suppose A,C same_side m; + C,A same_side m [Csim_mA] by lm_line, -, tetra', SameSideSymmetric; + C,B same_side d ∧ C,D same_side a by ad_line, CintDAB, InteriorUse; + C ∈ int_angle A B D ∧ C ∈ int_angle B D A by tetra', ad_line, lm_line, Csim_mA, -, IN_InteriorAngle; + C ∈ int_triangle D A B by CintDAB, -, IN_InteriorTriangle; + qed by -; + end; +`;; + +let InteriorTriangleSymmetry = thm `; + ∀ A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A + by IN_InteriorTriangle; +`;; + +let FourChoicesTetralateral = thm `; + let A B C D be point; + let a be point_set; + assume Tetralateral A B C D [H1]; + assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; + assume C,D same_side a [Csim_aD]; + thus ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ + D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B + + proof + ¬(A = B) ∧ ¬Collinear A B C ∧ ¬Collinear C D A ∧ ¬Collinear D A B ∧ Tetralateral A B D C [TetraABCD] by H1, Tetralateral_DEF, TetralateralSymmetry; + ¬Collinear C A D ∧ C ∉ a ∧ D ∉ a [notCDa] by TetraABCD, CollinearSymmetry, a_line, Collinear_DEF, ∉; + C ∈ int_angle D A B ∨ D ∈ int_angle C A B by TetraABCD, a_line, -, Csim_aD, AngleOrdering; + cases by -; + suppose C ∈ int_angle D A B; + ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B by H1, -, FourChoicesTetralateralHelp; + qed by -; + suppose D ∈ int_angle C A B; + ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B by TetraABCD, -, FourChoicesTetralateralHelp; + qed by -, InteriorTriangleSymmetry; + end; +`;; + +let QuadrilateralSymmetry = thm `; + ∀ A B C D:point. Quadrilateral A B C D ⇒ + Quadrilateral B C D A ∧ Quadrilateral C D A B ∧ Quadrilateral D A B C + by Quadrilateral_DEF, INTER_COMM, TetralateralSymmetry, Quadrilateral_DEF; +`;; + +let FiveChoicesQuadrilateral = thm `; + let A B C D be point; + let l m be point_set; + assume Quadrilateral A B C D [H1]; + assume Line l ∧ A ∈ l ∧ C ∈ l ∧ Line m ∧ B ∈ m ∧ D ∈ m [lm_line]; + thus (ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ + B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) ∧ + (¬(B,D same_side l) ∨ ¬(A,C same_side m)) + + proof + Tetralateral A B C D [H1Tetra] by H1, Quadrilateral_DEF; + ¬(A = B) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(C = D) [Distinct] by H1Tetra, Tetralateral_DEF; + consider a c such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by Distinct, I1; + Quadrilateral C D A B ∧ Tetralateral C D A B [tetraCDAB] by H1, QuadrilateralSymmetry, Quadrilateral_DEF; + ¬ConvexQuadrilateral A B D C ∧ ¬ConvexQuadrilateral C D B A [notconvquad] by Distinct, I1, H1, -, ConvexQuadImpliesDiagonalsIntersect; + ConvexQuadrilateral A B C D ∨ A ∈ int_triangle B C D ∨ + B ∈ int_triangle C D A ∨ C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C [5choices] + proof + A,B same_side c ∨ C,D same_side a by H1, ac_line, SegmentSameSideOppositeLine; + cases by -; + suppose C,D same_side a; + qed by H1Tetra, ac_line, -, notconvquad, FourChoicesTetralateral; + suppose A,B same_side c; + ConvexQuadrilateral C D A B ∨ B ∈ int_triangle C D A ∨ A ∈ int_triangle B C D [X1] by tetraCDAB, ac_line, -, notconvquad, FourChoicesTetralateral; + qed by -, QuadrilateralSymmetry, ConvexQuad_DEF; + end; + ¬(B,D same_side l) ∨ ¬(A,C same_side m) by -, lm_line, ConvexQuadImpliesDiagonalsIntersect, IN_InteriorTriangle, InteriorAngleSymmetry, InteriorOpposite; + qed by 5choices, -; +`;; + +let IntervalSymmetry = thm `; + ∀ A B: point. open (A,B) = open (B,A) + by B1', EXTENSION; +`;; + +let SegmentSymmetry = thm `; + ∀ A B: point. seg A B = seg B A + by Segment_DEF, IntervalSymmetry, SET_RULE; +`;; + +let C1OppositeRay = thm `; + let O P be point; + let s be point_set; + assume Segment s ∧ ¬(O = P) [H1]; + thus ∃ Q. P ∈ open (O,Q) ∧ seg P Q ≡ s + + proof + consider Z such that + P ∈ open (O,Z) ∧ ¬(P = Z) [OPZ] by H1, B2', B1'; + consider Q such that + Q ∈ ray P Z ━ P ∧ seg P Q ≡ s [PQeq] by H1, -, C1; + P ∈ open (Q,O) by OPZ, -, OppositeRaysIntersect1pointHelp; + qed by -, B1', PQeq; +`;; + +let OrderedCongruentSegments = thm `; + let A B C D F be point; + assume ¬(A = C) ∧ ¬(D = F) [H1]; + assume seg A C ≡ seg D F [H2]; + assume B ∈ open (A,C) [H3]; + thus ∃ E. E ∈ open (D,F) ∧ seg A B ≡ seg D E + + proof + Segment (seg A B) ∧ Segment (seg A C) ∧ Segment (seg B C) ∧ Segment (seg D F) [segs] by H3, B1', H1, SEGMENT; + seg D F ≡ seg A C [DFeqAC] by -, H2, C2Symmetric; + consider E such that + E ∈ ray D F ━ D ∧ seg D E ≡ seg A B [DEeqAB] by segs, H1, C1; + ¬(E = D) ∧ Collinear D E F ∧ D ∉ open (F,E) [ErDF] by -, IN_DELETE, IN_Ray, B1', CollinearSymmetry, ∉; + consider F' such that + E ∈ open (D,F') ∧ seg E F' ≡ seg B C [DEF'] by segs, -, C1OppositeRay; + seg D F' ≡ seg A C [DF'eqAC] by DEF', H3, DEeqAB, C3; + Segment (seg D F') ∧ Segment (seg D E) by DEF', B1', SEGMENT; + seg A C ≡ seg D F' ∧ seg A B ≡ seg D E [ABeqDE] by segs, -, DF'eqAC, C2Symmetric, DEeqAB; + F' ∈ ray D E ━ D ∧ F ∈ ray D E ━ D by DEF', IntervalRayEZ, ErDF, IN_Ray, H1, IN_DELETE; + F' = F by ErDF, segs, -, DF'eqAC, DFeqAC, C1; + qed by -, DEF', ABeqDE; +`;; + +let SegmentSubtraction = thm `; + let A B C A' B' C' be point; + assume B ∈ open (A,C) ∧ B' ∈ open (A',C') [H1]; + assume seg A B ≡ seg A' B' [H2]; + assume seg A C ≡ seg A' C' [H3]; + thus seg B C ≡ seg B' C' + + proof + ¬(A = B) ∧ ¬(A = C) ∧ Collinear A B C ∧ Segment (seg A' C') ∧ Segment (seg B' C') [Distinct] by H1, B1', SEGMENT; + consider Q such that + B ∈ open (A,Q) ∧ seg B Q ≡ seg B' C' [defQ] by -, C1OppositeRay; + seg A Q ≡ seg A' C' [AQ_A'C'] by H1, H2, -, C3; + ¬(A = Q) ∧ Collinear A B Q ∧ A ∉ open (C,B) ∧ A ∉ open (Q,B) by defQ, B1', H1, B3', ∉; + C ∈ ray A B ━ A ∧ Q ∈ ray A B ━ A by Distinct, -, IN_Ray, IN_DELETE; + C = Q by Distinct, -, AQ_A'C', H3, C1; + qed by defQ, -; +`;; + +let SegmentOrderingUse = thm `; + let A B be point; + let s be point_set; + assume Segment s ∧ ¬(A = B) [H1]; + assume s <__ seg A B [H2]; + thus ∃ G. G ∈ open (A,B) ∧ s ≡ seg A G + + proof + consider A' B' G' such that + seg A B = seg A' B' ∧ G' ∈ open (A',B') ∧ s ≡ seg A' G' [H2'] by H2, SegmentOrdering_DEF; + ¬(A' = G') ∧ ¬(A' = B') ∧ seg A' B' ≡ seg A B [A'notB'G'] by -, B1', H1, SEGMENT, C2Reflexive; + consider G such that + G ∈ open (A,B) ∧ seg A' G' ≡ seg A G [AGB] by A'notB'G', H1, H2', -, OrderedCongruentSegments; + s ≡ seg A G by H1, A'notB'G', -, B1', SEGMENT, H2', C2Transitive; + qed by AGB, -; +`;; + +let SegmentTrichotomy1 = thm `; + let s t be point_set; + assume s <__ t [H1]; + thus ¬(s ≡ t) + + proof + consider A B G such that + Segment s ∧ t = seg A B ∧ G ∈ open (A,B) ∧ s ≡ seg A G [H1'] by H1, SegmentOrdering_DEF; + ¬(A = G) ∧ ¬(A = B) ∧ ¬(G = B) [Distinct] by H1', B1'; + seg A B ≡ seg A B [ABrefl] by -, SEGMENT, C2Reflexive; + G ∈ ray A B ━ A ∧ B ∈ ray A B ━ A by H1', IntervalRay, EndpointInRay, Distinct, IN_DELETE; + ¬(seg A G ≡ seg A B) ∧ seg A G ≡ s by Distinct, SEGMENT, -, ABrefl, C1, H1', C2Symmetric; + qed by Distinct, H1', SEGMENT, -, C2Transitive; +`;; + +let SegmentTrichotomy2 = thm `; + let s t u be point_set; + assume s <__ t [H1]; + assume Segment u ∧ t ≡ u [H2]; + thus s <__ u + + proof + consider A B P such that + Segment s ∧ t = seg A B ∧ P ∈ open (A,B) ∧ s ≡ seg A P [H1'] by H1, SegmentOrdering_DEF; + ¬(A = B) ∧ ¬(A = P) [Distinct] by -, B1'; + consider X Y such that + u = seg X Y ∧ ¬(X = Y) [uXY] by H2, SEGMENT; + consider Q such that + Q ∈ open (X,Y) ∧ seg A P ≡ seg X Q [XQY] by Distinct, -, H1', H2, OrderedCongruentSegments; + ¬(X = Q) ∧ s ≡ seg X Q by -, B1', H1', Distinct, SEGMENT, XQY, C2Transitive; + qed by H1', uXY, XQY, -, SegmentOrdering_DEF; +`;; + +let SegmentOrderTransitivity = thm `; + let s t u be point_set; + assume s <__ t ∧ t <__ u [H1]; + thus s <__ u + + proof + consider A B G such that + u = seg A B ∧ G ∈ open (A,B) ∧ t ≡ seg A G [H1'] by H1, SegmentOrdering_DEF; + ¬(A = B) ∧ ¬(A = G) ∧ Segment s [Distinct] by H1', B1', H1, SegmentOrdering_DEF; + s <__ seg A G by H1, H1', Distinct, SEGMENT, SegmentTrichotomy2; + consider F such that + F ∈ open (A,G) ∧ s ≡ seg A F [AFG] by Distinct, -, SegmentOrderingUse; + F ∈ open (A,B) by H1', IntervalsAreConvex, -, SUBSET; + qed by Distinct, H1', -, AFG, SegmentOrdering_DEF; +`;; + +let SegmentTrichotomy = thm `; + let s t be point_set; + assume Segment s ∧ Segment t [H1]; + thus (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ ¬(s ≡ t ∧ s <__ t) ∧ + ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) + + proof + ¬(s ≡ t ∧ s <__ t) [Not12] + proof + assume s <__ t; + qed by -, SegmentTrichotomy1; + ¬(s ≡ t ∧ t <__ s) [Not13] + proof + assume t <__ s; + ¬(t ≡ s) by -, SegmentTrichotomy1; + qed by H1, -, C2Symmetric; + ¬(s <__ t ∧ t <__ s) [Not23] + proof + assume s <__ t ∧ t <__ s; + s <__ s by H1, -, SegmentOrderTransitivity; + qed by -, SegmentTrichotomy1, H1, C2Reflexive; + consider O P such that + s = seg O P ∧ ¬(O = P) [sOP] by H1, SEGMENT; + consider Q such that + Q ∈ ray O P ━ O ∧ seg O Q ≡ t [QrOP] by H1, -, C1; + O ∉ open (Q,P) ∧ Collinear O P Q ∧ ¬(O = Q) [notQOP] by -, IN_DELETE, IN_Ray; + s ≡ seg O P ∧ t ≡ seg O Q ∧ seg O Q ≡ t ∧ seg O P ≡ s [stOPQ] by H1, sOP, -, SEGMENT, QrOP, C2Reflexive, C2Symmetric; + cases; + suppose Q = P; + s ≡ t by -, sOP, QrOP; + qed by -, Not12, Not13, Not23; + suppose ¬(Q = P); + P ∈ open (O,Q) ∨ Q ∈ open (O,P) by sOP, -, notQOP, B3', B1', ∉; + s <__ seg O Q ∨ t <__ seg O P by H1, -, stOPQ, SegmentOrdering_DEF; + s <__ t ∨ t <__ s by -, H1, stOPQ, SegmentTrichotomy2; + qed by -, Not12, Not13, Not23; + end; +`;; + +let C4Uniqueness = thm `; + let O A B P be point; + let l be point_set; + assume Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) [H1]; + assume B ∉ l ∧ P ∉ l ∧ P,B same_side l [H2]; + assume ∡ A O P ≡ ∡ A O B [H3]; + thus ray O B = ray O P + + proof + ¬(O = B) ∧ ¬(O = P) ∧ Ray (ray O B) ∧ Ray (ray O P) [Distinct] by H2, H1, ∉, RAY; + ¬Collinear A O B ∧ B,B same_side l [Bsim_lB] by H1, H2, I1, Collinear_DEF, ∉, SameSideReflexive; + Angle (∡ A O B) ∧ ∡ A O B ≡ ∡ A O B by -, ANGLE, C5Reflexive; + qed by -, H1, H2, Distinct, Bsim_lB, H3, C4; +`;; + +let AngleSymmetry = thm `; + ∀ A O B. ∡ A O B = ∡ B O A + by Angle_DEF, UNION_COMM; +`;; + +let TriangleCongSymmetry = thm `; + let A B C A' B' C' be point; + assume A,B,C ≅ A',B',C' [H1]; + thus A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ + B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' + + proof + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ ∡ C A B ≡ ∡ C' A' B' [H1'] by H1, TriangleCong_DEF; + seg B A ≡ seg B' A' ∧ seg C A ≡ seg C' A' ∧ seg C B ≡ seg C' B' [segments] by H1', SegmentSymmetry; + ∡ C B A ≡ ∡ C' B' A' ∧ ∡ A C B ≡ ∡ A' C' B' ∧ ∡ B A C ≡ ∡ B' A' C' by H1', AngleSymmetry; + qed by CollinearSymmetry, H1', segments, -, TriangleCong_DEF; +`;; + +let SAS = thm `; + let A B C A' B' C' be point; + assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; + assume seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' [H2]; + assume ∡ A B C ≡ ∡ A' B' C' [H3]; + thus A,B,C ≅ A',B',C' + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A' = C') [Distinct] by H1, NonCollinearImpliesDistinct; :: 134 + consider c such that + Line c ∧ A ∈ c ∧ B ∈ c [c_line] by Distinct, I1; + C ∉ c [notCc] by H1, c_line, Collinear_DEF, ∉; + ∡ B C A ≡ ∡ B' C' A' [BCAeq] by H1, H2, H3, C6; + ∡ B A C ≡ ∡ B' A' C' [BACeq] by H1, CollinearSymmetry, H2, H3, AngleSymmetry, C6; + consider Y such that + Y ∈ ray A C ━ A ∧ seg A Y ≡ seg A' C' [YrAC] by Distinct, SEGMENT, C1; + Y ∉ c ∧ Y,C same_side c [Ysim_cC] by c_line, notCc, -, RaySameSide; + ¬Collinear Y A B [YABncol] by c_line, -, Distinct, I1, Collinear_DEF, ∉; + ray A Y = ray A C ∧ ∡ Y A B = ∡ C A B by Distinct, YrAC, RayWellDefined, Angle_DEF; + ∡ Y A B ≡ ∡ C' A' B' by BACeq, -, AngleSymmetry; + ∡ A B Y ≡ ∡ A' B' C' [ABYeq] by YABncol, H1, CollinearSymmetry, H2, SegmentSymmetry, YrAC, -, C6; + Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A B Y) by H1, CollinearSymmetry, YABncol, ANGLE; + ∡ A B Y ≡ ∡ A B C [ABYeqABC] by -, ABYeq, -, H3, C5Symmetric, C5Transitive; + ray B C = ray B Y ∧ ¬(Y = B) ∧ Y ∈ ray B C by c_line, Distinct, notCc, Ysim_cC, ABYeqABC, C4Uniqueness, ∉, -, EndpointInRay; + Collinear B C Y ∧ Collinear A C Y by -, YrAC, IN_DELETE, IN_Ray; + C = Y by -, I1, Collinear_DEF, H1; + seg A C ≡ seg A' C' by -, YrAC; + qed by H1, H2, SegmentSymmetry, -, H3, BCAeq, BACeq, AngleSymmetry, TriangleCong_DEF; +`;; + +let ASA = thm `; + let A B C A' B' C' be point; + assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; + assume seg A C ≡ seg A' C' [H2]; + assume ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' [H3]; + thus A,B,C ≅ A',B',C' + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(A' = C') ∧ ¬(B' = C') ∧ Segment (seg C' B') [Distinct] by H1, NonCollinearImpliesDistinct, SEGMENT; + consider D such that + D ∈ ray C B ━ C ∧ seg C D ≡ seg C' B' ∧ ¬(D = C) [DrCB] by -, C1, IN_DELETE; + Collinear C B D [CBDcol] by -, IN_DELETE, IN_Ray; + ¬Collinear D C A ∧ Angle (∡ C A D) ∧ Angle (∡ C' A' B') ∧ Angle (∡ C A B) [DCAncol] by H1, CollinearSymmetry, -, DrCB, NoncollinearityExtendsToLine, H1, ANGLE; + consider b such that + Line b ∧ A ∈ b ∧ C ∈ b [b_line] by Distinct, I1; + B ∉ b ∧ ¬(D = A) [notBb] by H1, -, Collinear_DEF, ∉, DCAncol, NonCollinearImpliesDistinct; + D ∉ b ∧ D,B same_side b [Dsim_bB] by b_line, -, DrCB, RaySameSide; + ray C D = ray C B by Distinct, DrCB, RayWellDefined; + ∡ D C A ≡ ∡ B' C' A' by H3, -, Angle_DEF; + D,C,A ≅ B',C',A' by DCAncol, H1, CollinearSymmetry, DrCB, H2, SegmentSymmetry, -, SAS; + ∡ C A D ≡ ∡ C' A' B' by -, TriangleCong_DEF; + ∡ C A D ≡ ∡ C A B by DCAncol, -, H3, C5Symmetric, C5Transitive; + ray A B = ray A D ∧ D ∈ ray A B by b_line, Distinct, notBb, Dsim_bB, -, C4Uniqueness, notBb, EndpointInRay; + Collinear A B D by -, IN_Ray; + D = B by I1, -, Collinear_DEF, CBDcol, H1; + seg C B ≡ seg C' B' by -, DrCB; + B,C,A ≅ B',C',A' by H1, CollinearSymmetry, -, H2, SegmentSymmetry, H3, SAS; + qed by -, TriangleCongSymmetry; +`;; + +let AngleSubtraction = thm `; + let A O B A' O' B' G G' be point; + assume G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' [H1]; + assume ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' [H2]; + thus ∡ G O B ≡ ∡ G' O' B' + + proof + ¬Collinear A O B ∧ ¬Collinear A' O' B' [A'O'B'ncol] by H1, IN_InteriorAngle; + ¬(A = O) ∧ ¬(O = B) ∧ ¬(G = O) ∧ ¬(G' = O') ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SEGMENT; + consider X Y such that + X ∈ ray O A ━ O ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B ━ O ∧ seg O Y ≡ seg O' B' [XYexists] by -, C1; + G ∈ int_angle X O Y [GintXOY] by H1, XYexists, InteriorWellDefined, InteriorAngleSymmetry; + consider H H' such that + H ∈ open (X,Y) ∧ H ∈ ray O G ━ O ∧ + H' ∈ open (A',B') ∧ H' ∈ ray O' G' ━ O' [Hexists] by -, H1, Crossbar_THM; + H ∈ int_angle X O Y ∧ H' ∈ int_angle A' O' B' [HintXOY] by GintXOY, H1, -, WholeRayInterior; + ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G ∧ ray O' H' = ray O' G' [Orays] by Distinct, XYexists, Hexists, RayWellDefined; + ∡ X O Y ≡ ∡ A' O' B' ∧ ∡ X O H ≡ ∡ A' O' H' [H2'] by H2, -, Angle_DEF; + ¬Collinear X O Y by GintXOY, IN_InteriorAngle; + X,O,Y ≅ A',O',B' by -, A'O'B'ncol, H2', XYexists, SAS; + seg X Y ≡ seg A' B' ∧ ∡ O Y X ≡ ∡ O' B' A' ∧ ∡ Y X O ≡ ∡ B' A' O' [XOYcong] by -, TriangleCong_DEF; + ¬Collinear O H X ∧ ¬Collinear O' H' A' ∧ ¬Collinear O Y H ∧ ¬Collinear O' B' H' [OHXncol] by HintXOY, InteriorEZHelp, InteriorAngleSymmetry, CollinearSymmetry; + ray X H = ray X Y ∧ ray A' H' = ray A' B' ∧ ray Y H = ray Y X ∧ ray B' H' = ray B' A' [Hrays] by Hexists, B1', IntervalRay; + ∡ H X O ≡ ∡ H' A' O' by XOYcong, -, Angle_DEF; + O,H,X ≅ O',H',A' by OHXncol, XYexists, -, H2', ASA; + seg X H ≡ seg A' H' by -, TriangleCong_DEF, SegmentSymmetry; + seg H Y ≡ seg H' B' by Hexists, XOYcong, -, SegmentSubtraction; + seg Y O ≡ seg B' O' ∧ seg Y H ≡ seg B' H' [YHeq] by XYexists, -, SegmentSymmetry; + ∡ O Y H ≡ ∡ O' B' H' by XOYcong, Hrays, Angle_DEF; + O,Y,H ≅ O',B',H' by OHXncol, YHeq, -, SAS; + ∡ H O Y ≡ ∡ H' O' B' by -, TriangleCong_DEF; + qed by -, Orays, Angle_DEF; +`;; + +let OrderedCongruentAngles = thm `; + let A O B A' O' B' G be point; + assume ¬Collinear A' O' B' [H1]; + assume ∡ A O B ≡ ∡ A' O' B' [H2]; + assume G ∈ int_angle A O B [H3]; + thus ∃ G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' + + proof + ¬Collinear A O B [AOBncol] by H3, IN_InteriorAngle; + ¬(A = O) ∧ ¬(O = B) ∧ ¬(A' = B') ∧ ¬(O = G) ∧ Segment (seg O' A') ∧ Segment (seg O' B') [Distinct] by AOBncol, H1, NonCollinearImpliesDistinct, H3, InteriorEZHelp, SEGMENT; + consider X Y such that + X ∈ ray O A ━ O ∧ seg O X ≡ seg O' A' ∧ Y ∈ ray O B ━ O ∧ seg O Y ≡ seg O' B' [defXY] by -, C1; + G ∈ int_angle X O Y [GintXOY] by H3, -, InteriorWellDefined, InteriorAngleSymmetry; + ¬Collinear X O Y ∧ ¬(X = Y) [XOYncol] by -, IN_InteriorAngle, NonCollinearImpliesDistinct; + consider H such that + H ∈ open (X,Y) ∧ H ∈ ray O G ━ O [defH] by GintXOY, Crossbar_THM; + ray O X = ray O A ∧ ray O Y = ray O B ∧ ray O H = ray O G [Orays] by Distinct, defXY, -, RayWellDefined; + ∡ X O Y ≡ ∡ A' O' B' by H2, -, Angle_DEF; + X,O,Y ≅ A',O',B' by XOYncol, H1, defXY, -, SAS; + seg X Y ≡ seg A' B' ∧ ∡ O X Y ≡ ∡ O' A' B' [YXOcong] by -, TriangleCong_DEF, AngleSymmetry; + consider G' such that + G' ∈ open (A',B') ∧ seg X H ≡ seg A' G' [A'G'B'] by XOYncol, Distinct, -, defH, OrderedCongruentSegments; + G' ∈ int_angle A' O' B' [G'intA'O'B'] by H1, -, ConverseCrossbar; + ray X H = ray X Y ∧ ray A' G' = ray A' B' by defH, A'G'B', IntervalRay; + ∡ O X H ≡ ∡ O' A' G' [HXOeq] by -, Angle_DEF, YXOcong; + H ∈ int_angle X O Y by GintXOY, defH, WholeRayInterior; + ¬Collinear O X H ∧ ¬Collinear O' A' G' by -, G'intA'O'B', InteriorEZHelp, CollinearSymmetry; + O,X,H ≅ O',A',G' by -, A'G'B', defXY, SegmentSymmetry, HXOeq, SAS; + ∡ X O H ≡ ∡ A' O' G' by -, TriangleCong_DEF, AngleSymmetry; + ∡ A O G ≡ ∡ A' O' G' by -, Orays, Angle_DEF; + qed by G'intA'O'B', -; +`;; + +let AngleAddition = thm `; + let A O B A' O' B' G G' be point; + assume G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' [H1]; + assume ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' [H2]; + thus ∡ A O B ≡ ∡ A' O' B' + + proof + ¬Collinear A O B ∧ ¬Collinear A' O' B' [AOBncol] by H1, IN_InteriorAngle; + ¬(A = O) ∧ ¬(A = B) ∧ ¬(O = B) ∧ ¬(A' = O') ∧ ¬(A' = B') ∧ ¬(O' = B') ∧ ¬(G = O) [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp; + consider a b such that + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b [a_line] by Distinct, I1; + consider g such that + Line g ∧ O ∈ g ∧ G ∈ g [g_line] by Distinct, I1; + G ∉ a ∧ G,B same_side a [H1'] by a_line, H1, InteriorUse; + ¬Collinear A O G ∧ ¬Collinear A' O' G' [AOGncol] by H1, InteriorEZHelp, IN_InteriorAngle; + Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A O G) ∧ Angle (∡ A' O' G') [angles] by AOBncol, -, ANGLE; + ∃! r. Ray r ∧ ∃ X. ¬(O = X) ∧ r = ray O X ∧ X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' by -, Distinct, a_line, H1', C4; + consider X such that + X ∉ a ∧ X,G same_side a ∧ ∡ A O X ≡ ∡ A' O' B' [Xexists] by -; + ¬Collinear A O X [AOXncol] by -, a_line, Distinct, I1, Collinear_DEF, ∉; + ∡ A' O' B' ≡ ∡ A O X by -, AOBncol, ANGLE, Xexists, C5Symmetric; + consider Y such that + Y ∈ int_angle A O X ∧ ∡ A' O' G' ≡ ∡ A O Y [YintAOX] by AOXncol, -, H1, OrderedCongruentAngles; + ¬Collinear A O Y by -, InteriorEZHelp; + ∡ A O Y ≡ ∡ A O G [AOGeq] by -, angles, -, ANGLE, YintAOX, H2, C5Transitive, C5Symmetric; + consider x such that + Line x ∧ O ∈ x ∧ X ∈ x by Distinct, I1; + Y ∉ a ∧ Y,X same_side a by a_line, -, YintAOX, InteriorUse; + Y ∉ a ∧ Y,G same_side a by a_line, -, Xexists, H1', SameSideTransitive; + ray O G = ray O Y by a_line, Distinct, H1', -, AOGeq, C4Uniqueness; + G ∈ ray O Y ━ O by Distinct, -, EndpointInRay, IN_DELETE; + G ∈ int_angle A O X [GintAOX] by YintAOX, -, WholeRayInterior; + ∡ G O X ≡ ∡ G' O' B' [GOXeq] by -, H1, Xexists, H2, AngleSubtraction; + ¬Collinear G O X ∧ ¬Collinear G O B ∧ ¬Collinear G' O' B' [GOXncol] by GintAOX, H1, InteriorAngleSymmetry, InteriorEZHelp, CollinearSymmetry; + Angle (∡ G O X) ∧ Angle (∡ G O B) ∧ Angle (∡ G' O' B') by -, ANGLE; + ∡ G O X ≡ ∡ G O B [G'O'Xeq] by angles, -, GOXeq, C5Symmetric, H2, C5Transitive; + ¬(A,X same_side g) ∧ ¬(A,B same_side g) [Ansim_aXB] by g_line, GintAOX, H1, InteriorOpposite; + A ∉ g ∧ B ∉ g ∧ X ∉ g [notABXg] by g_line, AOGncol, GOXncol, Distinct, I1, Collinear_DEF, ∉; + X,B same_side g by g_line, -, Ansim_aXB, AtMost2Sides; + ray O X = ray O B by g_line, Distinct, notABXg, -, G'O'Xeq, C4Uniqueness; + qed by -, Xexists, Angle_DEF; +`;; + +let AngleOrderingUse = thm `; + let A O B be point; + let α be point_set; + assume Angle α ∧ ¬Collinear A O B [H1]; + assume α <_ang ∡ A O B [H3]; + thus ∃ G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G + + proof + consider A' O' B' G' such that + ¬Collinear A' O' B' ∧ ∡ A O B = ∡ A' O' B' ∧ G' ∈ int_angle A' O' B' ∧ α ≡ ∡ A' O' G' [H3'] by H3, AngleOrdering_DEF; + Angle (∡ A O B) ∧ Angle (∡ A' O' B') ∧ Angle (∡ A' O' G') [angles] by H1, -, ANGLE, InteriorEZHelp; + ∡ A' O' B' ≡ ∡ A O B by -, H3', C5Reflexive; + consider G such that + G ∈ int_angle A O B ∧ ∡ A' O' G' ≡ ∡ A O G [GintAOB] by H1, H3', -, OrderedCongruentAngles; + α ≡ ∡ A O G by H1, angles, -, InteriorEZHelp, ANGLE, H3', GintAOB, C5Transitive; + qed by -, GintAOB; +`;; + +let AngleTrichotomy1 = thm `; + let α β be point_set; + assume α <_ang β [H1]; + thus ¬(α ≡ β) + + proof + assume α ≡ β [Con]; + consider A O B G such that + Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by H1, AngleOrdering_DEF; + ¬(A = O) ∧ ¬(O = B) ∧ ¬Collinear A O G [Distinct] by H1', NonCollinearImpliesDistinct, InteriorEZHelp; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by Distinct, I1; + consider b such that + Line b ∧ O ∈ b ∧ B ∈ b [b_line] by Distinct, I1; + B ∉ a [notBa] by a_line, H1', Collinear_DEF, ∉; + G ∉ a ∧ G ∉ b ∧ G,B same_side a [GintAOB] by a_line, b_line, H1', InteriorUse; + ∡ A O G ≡ α by H1', Distinct, ANGLE, C5Symmetric; + ∡ A O G ≡ ∡ A O B by H1', Distinct, ANGLE, -, Con, C5Transitive; + ray O B = ray O G by a_line, Distinct, notBa, GintAOB, -, C4Uniqueness; + G ∈ b by Distinct, -, EndpointInRay, b_line, RayLine, SUBSET; + qed by -, GintAOB, ∉; +`;; + +let AngleTrichotomy2 = thm `; + let α β γ be point_set; + assume α <_ang β [H1]; + assume Angle γ [H2]; + assume β ≡ γ [H3]; + thus α <_ang γ + + proof + consider A O B G such that + Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by H1, AngleOrdering_DEF; + consider A' O' B' such that + γ = ∡ A' O' B' ∧ ¬Collinear A' O' B' [γA'O'B'] by H2, ANGLE; + consider G' such that + G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' [G'intA'O'B'] by γA'O'B', H1', H3, OrderedCongruentAngles; + ¬Collinear A O G ∧ ¬Collinear A' O' G' [ncol] by H1', -, InteriorEZHelp; + α ≡ ∡ A' O' G' by H1', ANGLE, -, G'intA'O'B', C5Transitive; + qed by H1', -, ncol, γA'O'B', G'intA'O'B', -, AngleOrdering_DEF; +`;; + +let AngleOrderTransitivity = thm `; + let α β γ be point_set; + assume α <_ang β [H0]; + assume β <_ang γ [H2]; + thus α <_ang γ + + proof + consider A O B G such that + Angle β ∧ ¬Collinear A O B ∧ γ = ∡ A O B ∧ G ∈ int_angle A O B ∧ β ≡ ∡ A O G [H2'] by H2, AngleOrdering_DEF; + ¬Collinear A O G [AOGncol] by H2', InteriorEZHelp; + Angle α ∧ Angle (∡ A O G) ∧ Angle γ [angles] by H0, AngleOrdering_DEF, H2', -, ANGLE; + α <_ang ∡ A O G by H0, H2', -, AngleTrichotomy2; + consider F such that + F ∈ int_angle A O G ∧ α ≡ ∡ A O F [FintAOG] by angles, AOGncol, -, AngleOrderingUse; + F ∈ int_angle A O B by H2', -, InteriorTransitivity; + qed by angles, H2', -, FintAOG, AngleOrdering_DEF; +`;; + +let AngleTrichotomy = thm `; + let α β be point_set; + assume Angle α ∧ Angle β [H1]; + thus (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ + ¬(α ≡ β ∧ α <_ang β) ∧ + ¬(α ≡ β ∧ β <_ang α) ∧ + ¬(α <_ang β ∧ β <_ang α) + + proof + ¬(α ≡ β ∧ α <_ang β) [Not12] by AngleTrichotomy1; + ¬(α ≡ β ∧ β <_ang α) [Not13] by H1, C5Symmetric, AngleTrichotomy1; + ¬(α <_ang β ∧ β <_ang α) [Not23] by H1, AngleOrderTransitivity, AngleTrichotomy1, C5Reflexive; + consider P O A such that + α = ∡ P O A ∧ ¬Collinear P O A [POA] by H1, ANGLE; + ¬(P = O) ∧ ¬(O = A) [Distinct] by -, NonCollinearImpliesDistinct; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by -, I1; + P ∉ a [notPa] by -, Distinct, I1, POA, Collinear_DEF, ∉; + ∃! r. Ray r ∧ ∃ Q. ¬(O = Q) ∧ r = ray O Q ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β by H1, Distinct, a_line, -, C4; + consider Q such that + ¬(O = Q) ∧ Q ∉ a ∧ Q,P same_side a ∧ ∡ A O Q ≡ β [Qexists] by -; + O ∉ open (Q,P) [notQOP] by a_line, Qexists, SameSide_DEF, ∉; + ¬Collinear A O P [AOPncol] by POA, CollinearSymmetry; + ¬Collinear A O Q [AOQncol] by a_line, Distinct, I1, Collinear_DEF, Qexists, ∉; + Angle (∡ A O P) ∧ Angle (∡ A O Q) by AOPncol, -, ANGLE; + α ≡ ∡ A O P ∧ β ≡ ∡ A O Q ∧ ∡ A O P ≡ α [flip] by H1, -, POA, AngleSymmetry, C5Reflexive, Qexists, C5Symmetric; + cases; + suppose Collinear Q O P; + Collinear O P Q by -, CollinearSymmetry; + Q ∈ ray O P ━ O by Distinct, -, notQOP, IN_Ray, Qexists, IN_DELETE; + ray O Q = ray O P by Distinct, -, RayWellDefined; + ∡ P O A = ∡ A O Q by -, Angle_DEF, AngleSymmetry; + α ≡ β by -, POA, Qexists; + qed by -, Not12, Not13, Not23; + suppose ¬Collinear Q O P; + P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A by Distinct, a_line, Qexists, notPa, -, AngleOrdering; + P ∈ int_angle A O Q ∨ Q ∈ int_angle A O P by -, InteriorAngleSymmetry; + α <_ang ∡ A O Q ∨ β <_ang ∡ A O P by H1, AOQncol, AOPncol, -, flip, AngleOrdering_DEF; + α <_ang β ∨ β <_ang α by H1, -, Qexists, flip, AngleTrichotomy2; + qed by -, Not12, Not13, Not23; + end; +`;; + +let SupplementExists = thm `; + let α be point_set; + assume Angle α [H1]; + thus ∃ α'. α suppl α' + + proof + consider A O B such that + α = ∡ A O B ∧ ¬Collinear A O B ∧ ¬(A = O) [def_α] by H1, ANGLE, NonCollinearImpliesDistinct; + consider A' such that + O ∈ open (A,A') by -, B2'; + ∡ A O B suppl ∡ A' O B [AOBsup] by def_α, -, SupplementaryAngles_DEF, AngleSymmetry; + qed by -, def_α; +`;; + +let SupplementImpliesAngle = thm `; + let α β be point_set; + assume α suppl β [H1]; + thus Angle α ∧ Angle β + + proof + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by H1, SupplementaryAngles_DEF; + ¬(O = A') ∧ Collinear A O A' [Distinct] by -, NonCollinearImpliesDistinct, B1'; + ¬Collinear B O A' by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; + qed by H1', -, ANGLE; +`;; + +let RightImpliesAngle = thm `; + ∀ α: point_set. Right α ⇒ Angle α + by RightAngle_DEF, SupplementImpliesAngle; +`;; + +let SupplementSymmetry = thm `; + let α β be point_set; + assume α suppl β [H1]; + thus β suppl α + + proof + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ β = ∡ B O A' [H1'] by H1, SupplementaryAngles_DEF; + ¬(O = A') ∧ Collinear A O A' by -, NonCollinearImpliesDistinct, B1'; + ¬Collinear A' O B [A'OBncol] by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; + O ∈ open (A',A) ∧ β = ∡ A' O B ∧ α = ∡ B O A by H1', B1', AngleSymmetry; + qed by A'OBncol, -, SupplementaryAngles_DEF; +`;; + +let SupplementsCongAnglesCong = thm `; + let α β α' β' be point_set; + assume α suppl α' ∧ β suppl β' [H1]; + assume α ≡ β [H2]; + thus α' ≡ β' + + proof + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by H1, SupplementaryAngles_DEF; + ¬(A = O) ∧ ¬(O = B) ∧ ¬(A = A') ∧ ¬(O = A') ∧ Collinear A O A' [Distinctα] by -, NonCollinearImpliesDistinct, B1'; + ¬Collinear B A A' ∧ ¬Collinear O A' B [BAA'ncol] by def_α, CollinearSymmetry, -, NoncollinearityExtendsToLine; + Segment (seg O A) ∧ Segment (seg O B) ∧ Segment (seg O A') [Osegments] by Distinctα, SEGMENT; + consider C P D C' such that + ¬Collinear C P D ∧ P ∈ open (C,C') ∧ β = ∡ C P D ∧ β' = ∡ D P C' [def_β] by H1, SupplementaryAngles_DEF; + ¬(C = P) ∧ ¬(P = D) ∧ ¬(P = C') [Distinctβ] by def_β, NonCollinearImpliesDistinct, B1'; + consider X such that + X ∈ ray P C ━ P ∧ seg P X ≡ seg O A [defX] by Osegments, Distinctβ, C1; + consider Y such that + Y ∈ ray P D ━ P ∧ seg P Y ≡ seg O B ∧ ¬(Y = P) [defY] by Osegments, Distinctβ, C1, IN_DELETE; + consider X' such that + X' ∈ ray P C' ━ P ∧ seg P X' ≡ seg O A' [defX'] by Osegments, Distinctβ, C1; + P ∈ open (X',C) ∧ P ∈ open (X,X') [XPX'] by def_β, -, OppositeRaysIntersect1pointHelp, defX; + ¬(X = P) ∧ ¬(X' = P) ∧ Collinear X P X' ∧ ¬(X = X') ∧ ray A' O = ray A' A ∧ ray X' P = ray X' X [XPX'line] by defX, defX', IN_DELETE, -, B1', def_α, IntervalRay; + Collinear P D Y ∧ Collinear P C X by defY, defX, IN_DELETE, IN_Ray; + ¬Collinear C P Y ∧ ¬Collinear X P Y [XPYncol] by def_β, -, defY, NoncollinearityExtendsToLine, CollinearSymmetry, XPX'line; + ¬Collinear Y X X' ∧ ¬Collinear P X' Y [YXX'ncol] by -, CollinearSymmetry, XPX', XPX'line, NoncollinearityExtendsToLine; + ray P X = ray P C ∧ ray P Y = ray P D ∧ ray P X' = ray P C' [equalPrays] by Distinctβ, defX, defY, defX', RayWellDefined; + β = ∡ X P Y ∧ β' = ∡ Y P X' ∧ ∡ A O B ≡ ∡ X P Y [AOBeqXPY] by def_β, -, Angle_DEF, H2, def_α; + seg O A ≡ seg P X ∧ seg O B ≡ seg P Y ∧ seg A' O ≡ seg X' P [OAeq] by Osegments, XPX'line, SEGMENT, defX, defY, defX', C2Symmetric, SegmentSymmetry; + seg A A' ≡ seg X X' [AA'eq] by def_α, XPX'line, XPX', -, SegmentSymmetry, C3; + A,O,B ≅ X,P,Y by def_α, XPYncol, OAeq, AOBeqXPY, SAS; + seg A B ≡ seg X Y ∧ ∡ B A O ≡ ∡ Y X P [AOB≅] by -, TriangleCong_DEF, AngleSymmetry; + ray A O = ray A A' ∧ ray X P = ray X X' ∧ ∡ B A A' ≡ ∡ Y X X' by def_α, XPX', IntervalRay, -, Angle_DEF; + B,A,A' ≅ Y,X,X' by BAA'ncol, YXX'ncol, AOB≅, -, AA'eq, -, SAS; + seg A' B ≡ seg X' Y ∧ ∡ A A' B ≡ ∡ X X' Y by -, TriangleCong_DEF, SegmentSymmetry; + O,A',B ≅ P,X',Y by BAA'ncol, YXX'ncol, OAeq, -, XPX'line, Angle_DEF, SAS; + ∡ B O A' ≡ ∡ Y P X' by -, TriangleCong_DEF; + qed by -, equalPrays, def_β, Angle_DEF, def_α; +`;; + +let SupplementUnique = thm `; + ∀ α β β': point_set. α suppl β ∧ α suppl β' ⇒ β ≡ β' + by SupplementaryAngles_DEF, ANGLE, C5Reflexive, SupplementsCongAnglesCong; +`;; + +let CongRightImpliesRight = thm `; + let α β be point_set; + assume Angle α ∧ Right β [H1]; + assume α ≡ β [H2]; + thus Right α + + proof + consider α' β' such that + α suppl α' ∧ β suppl β' ∧ β ≡ β' [suppl] by H1, SupplementExists, H1, RightAngle_DEF; + α' ≡ β' [α'eqβ'] by suppl, H2, SupplementsCongAnglesCong; + Angle β ∧ Angle α' ∧ Angle β' by suppl, SupplementImpliesAngle; + α ≡ α' by H1, -, H2, suppl, α'eqβ', C5Symmetric, C5Transitive; + qed by suppl, -, RightAngle_DEF; +`;; + +let RightAnglesCongruentHelp = thm `; + let A O B A' P be point; + let a be point_set; + assume ¬Collinear A O B ∧ O ∈ open (A,A') [H1]; + assume Right (∡ A O B) ∧ Right (∡ A O P) [H2]; + thus P ∉ int_angle A O B + + proof + assume ¬(P ∉ int_angle A O B); + P ∈ int_angle A O B [PintAOB] by -, ∉; + B ∈ int_angle P O A' ∧ B ∈ int_angle A' O P [BintA'OP] by H1, -, InteriorReflectionInterior, InteriorAngleSymmetry ; + ¬Collinear A O P ∧ ¬Collinear P O A' [AOPncol] by PintAOB, InteriorEZHelp, -, IN_InteriorAngle; + ∡ A O B suppl ∡ B O A' ∧ ∡ A O P suppl ∡ P O A' [AOBsup] by H1, -, SupplementaryAngles_DEF; + consider α' β' such that + ∡ A O B suppl α' ∧ ∡ A O B ≡ α' ∧ ∡ A O P suppl β' ∧ ∡ A O P ≡ β' [supplα'] by H2, RightAngle_DEF; + α' ≡ ∡ B O A' ∧ β' ≡ ∡ P O A' [α'eqA'OB] by -, AOBsup, SupplementUnique; + Angle (∡ A O B) ∧ Angle α' ∧ Angle (∡ B O A') ∧ Angle (∡ A O P) ∧ Angle β' ∧ Angle (∡ P O A') [angles] by AOBsup, supplα', SupplementImpliesAngle, AngleSymmetry; + ∡ A O B ≡ ∡ B O A' ∧ ∡ A O P ≡ ∡ P O A' [H2'] by -, supplα', α'eqA'OB, C5Transitive; + ∡ A O P ≡ ∡ A O P ∧ ∡ B O A' ≡ ∡ B O A' [refl] by angles, C5Reflexive; + ∡ A O P <_ang ∡ A O B ∧ ∡ B O A' <_ang ∡ P O A' [BOA'lessPOA'] by angles, H1, PintAOB, -, AngleOrdering_DEF, AOPncol, CollinearSymmetry, BintA'OP, AngleSymmetry; + ∡ A O P <_ang ∡ B O A' by -, angles, H2', AngleTrichotomy2; + ∡ A O P <_ang ∡ P O A' by -, BOA'lessPOA', AngleOrderTransitivity; + qed by -, H2', AngleTrichotomy1; +`;; + +let RightAnglesCongruent = thm `; + let α β be point_set; + assume Right α ∧ Right β [H1]; + thus α ≡ β + + proof + consider α' such that + α suppl α' ∧ α ≡ α' by H1, RightAngle_DEF; + consider A O B A' such that + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ α = ∡ A O B ∧ α' = ∡ B O A' [def_α] by -, SupplementaryAngles_DEF; + ¬(A = O) ∧ ¬(O = B) [Distinct] by def_α, NonCollinearImpliesDistinct, B1'; + consider a such that + Line a ∧ O ∈ a ∧ A ∈ a [a_line] by Distinct, I1; + B ∉ a [notBa] by -, def_α, Collinear_DEF, ∉; + Angle β by H1, RightImpliesAngle; + ∃! r. Ray r ∧ ∃ P. ¬(O = P) ∧ r = ray O P ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β by -, Distinct, a_line, notBa, C4; + consider P such that + ¬(O = P) ∧ P ∉ a ∧ P,B same_side a ∧ ∡ A O P ≡ β [defP] by -; + O ∉ open (P,B) [notPOB] by a_line, -, SameSide_DEF, ∉; + ¬Collinear A O P [AOPncol] by a_line, Distinct, I1, defP, Collinear_DEF, ∉; + Right (∡ A O P) [AOPright] by -, ANGLE, H1, defP, CongRightImpliesRight; + P ∉ int_angle A O B ∧ B ∉ int_angle A O P by def_α, H1, -, AOPncol, AOPright, RightAnglesCongruentHelp; + Collinear P O B by Distinct, a_line, defP, notBa, -, AngleOrdering, InteriorAngleSymmetry, ∉; + P ∈ ray O B ━ O by Distinct, -, CollinearSymmetry, notPOB, IN_Ray, defP, IN_DELETE; + ray O P = ray O B ∧ ∡ A O P = ∡ A O B by Distinct, -, RayWellDefined, Angle_DEF; + qed by -, defP, def_α; +`;; + +let OppositeRightAnglesLinear = thm `; + let A B O H be point; + let h be point_set; + assume ¬Collinear A O H ∧ ¬Collinear H O B [H0]; + assume Right (∡ A O H) ∧ Right (∡ H O B) [H1]; + assume Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) [H2]; + thus O ∈ open (A,B) + + proof + ¬(A = O) ∧ ¬(O = H) ∧ ¬(O = B) [Distinct] by H0, NonCollinearImpliesDistinct; + A ∉ h ∧ B ∉ h [notABh] by H0, H2, Collinear_DEF, ∉; + consider E such that + O ∈ open (A,E) ∧ ¬(E = O) [AOE] by Distinct, B2', B1'; + ∡ A O H suppl ∡ H O E [AOHsupplHOE] by H0, -, SupplementaryAngles_DEF; + E ∉ h [notEh] by H2, ∉, AOE, BetweenLinear, notABh; + ¬(A,E same_side h) by H2, AOE, SameSide_DEF; + B,E same_side h [Bsim_hE] by H2, notABh, notEh, -, H2, AtMost2Sides; + consider α' such that + ∡ A O H suppl α' ∧ ∡ A O H ≡ α' [AOHsupplα'] by H1, RightAngle_DEF; + Angle (∡ H O B) ∧ Angle (∡ A O H) ∧ Angle α' ∧ Angle (∡ H O E) [angα'] by H1, RightImpliesAngle, -, AOHsupplHOE, SupplementImpliesAngle; + ∡ H O B ≡ ∡ A O H ∧ α' ≡ ∡ H O E by H1, RightAnglesCongruent, AOHsupplα', AOHsupplHOE, SupplementUnique; + ∡ H O B ≡ ∡ H O E by angα', -, AOHsupplα', C5Transitive; + ray O B = ray O E by H2, Distinct, notABh, notEh, Bsim_hE, -, C4Uniqueness; + B ∈ ray O E ━ O by Distinct, EndpointInRay, -, IN_DELETE; + qed by AOE, -, OppositeRaysIntersect1pointHelp, B1'; +`;; + +let RightImpliesSupplRight = thm `; + let A O B A' be point; + assume ¬Collinear A O B [H1]; + assume O ∈ open (A,A') [H2]; + assume Right (∡ A O B) [H3]; + thus Right (∡ B O A') + + proof + ∡ A O B suppl ∡ B O A' ∧ Angle (∡ A O B) ∧ Angle (∡ B O A') [AOBsuppl] by H1, H2, SupplementaryAngles_DEF, SupplementImpliesAngle; + consider β such that + ∡ A O B suppl β ∧ ∡ A O B ≡ β [βsuppl] by H3, RightAngle_DEF; + Angle β ∧ β ≡ ∡ A O B [angβ] by -, SupplementImpliesAngle, C5Symmetric; + ∡ B O A' ≡ β by AOBsuppl, βsuppl, SupplementUnique; + ∡ B O A' ≡ ∡ A O B by AOBsuppl, angβ, -, βsuppl, C5Transitive; + qed by AOBsuppl, H3, -, CongRightImpliesRight; +`;; + +let IsoscelesCongBaseAngles = thm `; + let A B C be point; + assume ¬Collinear A B C [H1]; + assume seg B A ≡ seg B C [H2]; + thus ∡ C A B ≡ ∡ A C B + + proof + ¬(A = B) ∧ ¬(B = C) ∧ ¬Collinear C B A [CBAncol] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; + seg B C ≡ seg B A ∧ ∡ A B C ≡ ∡ C B A by -, SEGMENT, H2, C2Symmetric, H1, ANGLE, AngleSymmetry, C5Reflexive; + A,B,C ≅ C,B,A by H1, CBAncol, H2, -, SAS; + qed by -, TriangleCong_DEF; +`;; + +let C4withC1 = thm `; + let α l be point_set; + let O A Y P Q be point; + assume Angle α ∧ ¬(O = A) ∧ ¬(P = Q) [H1]; + assume Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l [l_line]; + thus ∃ N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α + + proof + ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α by H1, l_line, C4; + consider B such that + ¬(O = B) ∧ B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α [Bexists] by -; + consider N such that + N ∈ ray O B ━ O ∧ seg O N ≡ seg P Q [Nexists] by H1, -, SEGMENT, C1; + ¬(O = N) [notON] by -, IN_DELETE; + N ∉ l ∧ N,B same_side l [notNl] by l_line, Bexists, Nexists, RaySameSide; + N,Y same_side l [Nsim_lY] by l_line, -, Bexists, SameSideTransitive; + ray O N = ray O B ∧ ∡ A O N ≡ α by Bexists, Nexists, RayWellDefined, Angle_DEF; + qed by notON, notNl, Nsim_lY, Nexists, -; +`;; + +let C4OppositeSide = thm `; + let α l be point_set; + let O A Z P Q be point; + assume Angle α ∧ ¬(O = A) ∧ ¬(P = Q) [H1]; + assume Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l [l_line]; + thus ∃ N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α + + proof + ¬(Z = O) by l_line, ∉; + consider Y such that + O ∈ open (Z,Y) [ZOY] by -, B2'; + ¬(O = Y) ∧ Collinear Z O Y by -, B1'; + Y ∉ l [notYl] by l_line, I1, -, Collinear_DEF, ∉; + consider N such that + ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ seg O N ≡ seg P Q ∧ ∡ A O N ≡ α [Nexists] by H1, l_line, notYl, C4withC1; + ¬(Z,Y same_side l) by l_line, ZOY, SameSide_DEF; + ¬(Z,N same_side l) by l_line, Nexists, notYl, -, SameSideTransitive; + qed by -, Nexists; +`;; + +let SSS = thm `; + let A B C A' B' C' be point; + assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; + assume seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' [H2]; + thus A,B,C ≅ A',B',C' + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬(A' = B') ∧ ¬(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; + consider h such that + Line h ∧ A ∈ h ∧ C ∈ h [h_line] by Distinct, I1; + B ∉ h [notBh] by h_line, H1, ∉, Collinear_DEF; + Segment (seg A B) ∧ Segment (seg C B) ∧ Segment (seg A' B') ∧ Segment (seg C' B') [segments] by Distinct, -, SEGMENT; + Angle (∡ C' A' B') by H1, CollinearSymmetry, ANGLE; + consider N such that + ¬(A = N) ∧ N ∉ h ∧ ¬(B,N same_side h) ∧ seg A N ≡ seg A' B' ∧ ∡ C A N ≡ ∡ C' A' B' [Nexists] by -, Distinct, h_line, notBh, C4OppositeSide; + ¬(C = N) by h_line, Nexists, ∉; + Segment (seg A N) ∧ Segment (seg C N) [segN] by Nexists, -, SEGMENT; + ¬Collinear A N C [ANCncol] by h_line, Distinct, I1, Collinear_DEF, Nexists, ∉; + Angle (∡ A B C) ∧ Angle (∡ A' B' C') ∧ Angle (∡ A N C) [angles] by H1, -, ANGLE; + seg A B ≡ seg A N [ABeqAN] by segments, segN, Nexists, H2, C2Symmetric, C2Transitive; + C,A,N ≅ C',A',B' by ANCncol, H1, CollinearSymmetry, H2, Nexists, SAS; + ∡ A N C ≡ ∡ A' B' C' ∧ seg C N ≡ seg C' B' [ANCeq] by -, TriangleCong_DEF; + seg C B ≡ seg C N [CBeqCN] by segments, segN, -, H2, SegmentSymmetry, C2Symmetric, C2Transitive; + consider G such that + G ∈ h ∧ G ∈ open (B,N) [BGN] by Nexists, h_line, SameSide_DEF; + ¬(B = N) [notBN] by -, B1'; + ray B G = ray B N ∧ ray N G = ray N B [Grays] by BGN, B1', IntervalRay; + consider v such that + Line v ∧ B ∈ v ∧ N ∈ v [v_line] by notBN, I1; + G ∈ v ∧ ¬(h = v) by v_line, BGN, BetweenLinear, notBh, ∉; + h ∩ v = {G} [hvG] by h_line, v_line, -, BGN, I1Uniqueness; + ¬(G = A) ⇒ ∡ A B G ≡ ∡ A N G [ABGeqANG] + proof + assume ¬(G = A) [notGA]; + A ∉ v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; + ¬Collinear B A N by v_line, notBN, I1, Collinear_DEF, -, ∉; + ∡ N B A ≡ ∡ B N A by -, ABeqAN, IsoscelesCongBaseAngles; + ∡ G B A ≡ ∡ G N A by -, Grays, Angle_DEF, notGA; + qed by -, AngleSymmetry; + ¬(G = C) ⇒ ∡ G B C ≡ ∡ G N C [GBCeqGNC] + proof + assume ¬(G = C) [notGC]; + C ∉ v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; + ¬Collinear B C N by v_line, notBN, I1, Collinear_DEF, -, ∉; + ∡ N B C ≡ ∡ B N C by -, CBeqCN, IsoscelesCongBaseAngles, AngleSymmetry; + qed by -, Grays, Angle_DEF; + ∡ A B C ≡ ∡ A N C + proof + cases; + suppose G = A [GA]; + ¬(G = C) by -, Distinct; + qed by -, GBCeqGNC, GA; + suppose G = C [GC]; + ¬(G = A) by -, Distinct; + qed by -, ABGeqANG, GC; + suppose ¬(G = A) ∧ ¬(G = C) [AGCdistinct]; + ∡ A B G ≡ ∡ A N G ∧ ∡ G B C ≡ ∡ G N C [Gequivs] by -, ABGeqANG, GBCeqGNC; + ¬Collinear G B C ∧ ¬Collinear G N C ∧ ¬Collinear G B A ∧ ¬Collinear G N A [Gncols] by h_line, BGN, AGCdistinct, I1, Collinear_DEF, notBh, Nexists, ∉; + Collinear A G C by h_line, BGN, Collinear_DEF; + G ∈ open (A,C) ∨ C ∈ open (G,A) ∨ A ∈ open (C,G) by Distinct, AGCdistinct, -, B3'; + cases by -; + suppose G ∈ open (A,C); + G ∈ int_angle A B C ∧ G ∈ int_angle A N C by H1, ANCncol, -, ConverseCrossbar; + qed by -, Gequivs, AngleAddition; + suppose C ∈ open (G,A); + C ∈ int_angle G B A ∧ C ∈ int_angle G N A by Gncols, -, B1', ConverseCrossbar; + qed by -, Gequivs, AngleSubtraction, AngleSymmetry; + suppose A ∈ open (C,G); + A ∈ int_angle G B C ∧ A ∈ int_angle G N C by Gncols, -, B1', ConverseCrossbar; + qed by -, Gequivs, AngleSymmetry, AngleSubtraction; + end; + end; + ∡ A B C ≡ ∡ A' B' C' by angles, -, ANCeq, C5Transitive; + qed by H1, H2, SegmentSymmetry, -, SAS; +`;; + +let AngleBisector = thm `; + let A B C be point; + assume ¬Collinear B A C [H1]; + thus ∃ F. F ∈ int_angle B A C ∧ ∡ B A F ≡ ∡ F A C + + proof + ¬(A = B) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + consider D such that + B ∈ open (A,D) [ABD] by Distinct, B2'; + ¬(A = D) ∧ Collinear A B D ∧ Segment (seg A D) [ABD'] by -, B1', SEGMENT; + consider E such that + E ∈ ray A C ━ A ∧ seg A E ≡ seg A D ∧ ¬(A = E) [ErAC] by -, Distinct, C1, IN_DELETE, IN_Ray; + Collinear A C E ∧ D ∈ ray A B ━ A [notAE] by ErAC, IN_DELETE, IN_Ray, ABD, IntervalRayEZ; + ray A D = ray A B ∧ ray A E = ray A C [equalrays] by Distinct, notAE, ErAC, RayWellDefined; + ¬Collinear D A E ∧ ¬Collinear E A D ∧ ¬Collinear A E D [EADncol] by H1, ABD', notAE, ErAC, CollinearSymmetry, NoncollinearityExtendsToLine; + ∡ D E A ≡ ∡ E D A [DEAeq] by EADncol, ErAC, IsoscelesCongBaseAngles; + ¬Collinear E D A ∧ Angle (∡ E D A) ∧ ¬Collinear A D E ∧ ¬Collinear D E A [angEDA] by EADncol, CollinearSymmetry, ANGLE; + ¬(D = E) [notDE] by EADncol, NonCollinearImpliesDistinct; + consider h such that + Line h ∧ D ∈ h ∧ E ∈ h [h_line] by -, I1; + A ∉ h [notAh] by -, Collinear_DEF, EADncol, ∉; + consider F such that + ¬(D = F) ∧ F ∉ h ∧ ¬(A,F same_side h) ∧ seg D F ≡ seg D A ∧ ∡ E D F ≡ ∡ E D A [Fexists] by angEDA, notDE, ABD', h_line, -, C4OppositeSide; + ¬(A = F) [notAF] by h_line, -, SameSideReflexive; + ¬Collinear E D F ∧ ¬Collinear D E F ∧ ¬Collinear F E D [EDFncol] by h_line, notDE, I1, Collinear_DEF, Fexists, ∉; + seg D E ≡ seg D E ∧ seg F A ≡ seg F A [FArefl] by notDE, notAF, SEGMENT, C2Reflexive; + E,D,F ≅ E,D,A by EDFncol, angEDA, -, Fexists, SAS; + seg F E ≡ seg A E ∧ ∡ F E D ≡ ∡ A E D [FED≅] by -, TriangleCong_DEF, SegmentSymmetry; + ∡ E D A ≡ ∡ D E A ∧ ∡ E D A ≡ ∡ E D F ∧ ∡ D E A ≡ ∡ D E F [EDAeqEDF] by EDFncol, ANGLE, angEDA, Fexists, FED≅, DEAeq, C5Symmetric, AngleSymmetry; + consider G such that + G ∈ h ∧ G ∈ open (A,F) [AGF] by Fexists, h_line, SameSide_DEF; + F ∈ ray A G ━ A [FrAG] by -, IntervalRayEZ; + consider v such that + Line v ∧ A ∈ v ∧ F ∈ v ∧ G ∈ v [v_line] by notAF, I1, AGF, BetweenLinear; + ¬(v = h) ∧ v ∩ h = {G} [vhG] by -, notAh, ∉, h_line, AGF, I1Uniqueness; + D ∉ v [notDv] + proof + assume ¬(D ∉ v); + D ∈ v ∧ D = G [DG] by h_line, -, ∉, vhG, IN_INTER, IN_SING; + D ∈ open (A,F) by DG, AGF; + ∡ E D A suppl ∡ E D F [EDAsuppl] by angEDA, -, SupplementaryAngles_DEF, AngleSymmetry; + Right (∡ E D A) by EDAsuppl, EDAeqEDF, RightAngle_DEF; + Right (∡ A E D) [RightAED] by angEDA, ANGLE, -, DEAeq, CongRightImpliesRight, AngleSymmetry; + Right (∡ D E F) by EDFncol, ANGLE, -, FED≅, CongRightImpliesRight, AngleSymmetry; + E ∈ open (A,F) by EADncol, EDFncol, RightAED, -, h_line, Fexists, OppositeRightAnglesLinear; + E ∈ v ∧ E = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; + qed by -, DG, notDE; + E ∉ v [notEv] + proof + assume ¬(E ∉ v); + E ∈ v ∧ E = G [EG] by h_line, -, ∉, vhG, IN_INTER, IN_SING; + E ∈ open (A,F) by -, AGF; + ∡ D E A suppl ∡ D E F [DEAsuppl] by EADncol, -, SupplementaryAngles_DEF, AngleSymmetry; + Right (∡ D E A) [RightDEA] by DEAsuppl, EDAeqEDF, RightAngle_DEF; + Right (∡ E D A) [RightEDA] by angEDA, RightDEA, EDAeqEDF, CongRightImpliesRight; + Right (∡ E D F) by EDFncol, ANGLE, RightEDA, Fexists, CongRightImpliesRight; + D ∈ open (A,F) by angEDA, EDFncol, RightEDA, AngleSymmetry, -, h_line, Fexists, OppositeRightAnglesLinear; + D ∈ v ∧ D = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; + qed by -, EG, notDE; + ¬Collinear F A E ∧ ¬Collinear F A D ∧ ¬(F = E) [FAEncol] by v_line, notAF, I1, Collinear_DEF, notEv, notDv, ∉, NonCollinearImpliesDistinct; + seg F E ≡ seg A D [FEeqAD] by -, ErAC, ABD', SEGMENT, FED≅, ErAC, C2Transitive; + seg A D ≡ seg F D by SegmentSymmetry, ABD', Fexists, SEGMENT, C2Symmetric; + seg F E ≡ seg F D by FAEncol, ABD', Fexists, SEGMENT, FEeqAD, -, C2Transitive; + F,A,E ≅ F,A,D by FAEncol, FArefl, -, ErAC, SSS; + ∡ F A E ≡ ∡ F A D [FAEeq] by -, TriangleCong_DEF; + ∡ D A F ≡ ∡ F A E by FAEncol, ANGLE, FAEeq, C5Symmetric, AngleSymmetry; + ∡ B A F ≡ ∡ F A C [BAFeqFAC] by -, equalrays, Angle_DEF; + ¬(E,D same_side v) + proof + assume E,D same_side v; + ray A D = ray A E by v_line, notAF, notDv, notEv, -, FAEeq, C4Uniqueness; + qed by ABD', EndpointInRay, -, IN_Ray, EADncol; + consider H such that + H ∈ v ∧ H ∈ open (E,D) [EHD] by v_line, -, SameSide_DEF; + H = G by -, h_line, BetweenLinear, IN_INTER, vhG, IN_SING; + G ∈ int_angle E A D [GintEAD] by EADncol, -, EHD, ConverseCrossbar; + F ∈ int_angle E A D [FintEAD] by GintEAD, FrAG, WholeRayInterior; + B ∈ ray A D ━ A ∧ C ∈ ray A E ━ A by equalrays, Distinct, EndpointInRay, IN_DELETE; + F ∈ int_angle B A C by FintEAD, -, InteriorWellDefined, InteriorAngleSymmetry; + qed by -, BAFeqFAC; +`;; + +let EuclidPropositionI_6 = thm `; + let A B C be point; + assume ¬Collinear A B C [H1]; + assume ∡ B A C ≡ ∡ B C A [H2]; + thus seg B A ≡ seg B C + + proof + ¬(A = C) by H1, NonCollinearImpliesDistinct; + seg C A ≡ seg A C [CAeqAC] by SegmentSymmetry, -, SEGMENT, C2Reflexive; + ¬Collinear B C A ∧ ¬Collinear C B A ∧ ¬Collinear B A C [BCAncol] by H1, CollinearSymmetry; + ∡ A C B ≡ ∡ C A B by -, ANGLE, H2, C5Symmetric, AngleSymmetry; + C,B,A ≅ A,B,C by H1, BCAncol, CAeqAC, H2, -, ASA; + qed by -, TriangleCong_DEF; +`;; + +let IsoscelesExists = thm `; + let A B be point; + assume ¬(A = B) [H1]; + thus ∃ D. ¬Collinear A D B ∧ seg D A ≡ seg D B + + proof + consider l such that + Line l ∧ A ∈ l ∧ B ∈ l [l_line] by H1, I1; + consider C such that + C ∉ l [notCl] by -, ExistsPointOffLine; + ¬Collinear C A B ∧ ¬Collinear C B A ∧ ¬Collinear A B C ∧ ¬Collinear A C B ∧ ¬Collinear B A C [CABncol] by l_line, H1, I1, Collinear_DEF, -, ∉; + ∡ C A B ≡ ∡ C B A ∨ ∡ C A B <_ang ∡ C B A ∨ ∡ C B A <_ang ∡ C A B by -, ANGLE, AngleTrichotomy; + cases by -; + suppose ∡ C A B ≡ ∡ C B A; + qed by -, CABncol, EuclidPropositionI_6; + suppose ∡ C A B <_ang ∡ C B A; + ∡ C A B <_ang ∡ A B C by -, AngleSymmetry; + consider E such that + E ∈ int_angle A B C ∧ ∡ C A B ≡ ∡ A B E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; + ¬(B = E) [notBE] by -, InteriorEZHelp; + consider D such that + D ∈ open (A,C) ∧ D ∈ ray B E ━ B [Dexists] by Eexists, Crossbar_THM; + D ∈ int_angle A B C by Eexists, -, WholeRayInterior; + ¬Collinear A D B [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; + ray B D = ray B E ∧ ray A D = ray A C by notBE, Dexists, RayWellDefined, IntervalRay; + ∡ D A B ≡ ∡ A B D by Eexists, -, Angle_DEF; + qed by ADBncol, -, AngleSymmetry, EuclidPropositionI_6; + :: similar case + suppose ∡ C B A <_ang ∡ C A B; + ∡ C B A <_ang ∡ B A C by -, AngleSymmetry; + consider E such that + E ∈ int_angle B A C ∧ ∡ C B A ≡ ∡ B A E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; + ¬(A = E) [notAE] by -, InteriorEZHelp; + consider D such that + D ∈ open (B,C) ∧ D ∈ ray A E ━ A [Dexists] by Eexists, Crossbar_THM; + D ∈ int_angle B A C by Eexists, -, WholeRayInterior; + ¬Collinear A D B ∧ ¬Collinear D A B ∧ ¬Collinear D B A [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; + ray A D = ray A E ∧ ray B D = ray B C by notAE, Dexists, RayWellDefined, IntervalRay; + ∡ D B A ≡ ∡ B A D by Eexists, -, Angle_DEF; + ∡ D A B ≡ ∡ D B A by AngleSymmetry, ADBncol, ANGLE, -, C5Symmetric; + qed by ADBncol, -, EuclidPropositionI_6; + end; +`;; + +let MidpointExists = thm `; + let A B be point; + assume ¬(A = B) [H1]; + thus ∃ M. M ∈ open (A,B) ∧ seg A M ≡ seg M B + + proof + consider D such that + ¬Collinear A D B ∧ seg D A ≡ seg D B [Dexists] by H1, IsoscelesExists; + consider F such that + F ∈ int_angle A D B ∧ ∡ A D F ≡ ∡ F D B [Fexists] by -, AngleBisector; + ¬(D = F) [notDF] by -, InteriorEZHelp; + consider M such that + M ∈ open (A,B) ∧ M ∈ ray D F ━ D [Mexists] by Fexists, Crossbar_THM; + ray D M = ray D F by notDF, -, RayWellDefined; + ∡ A D M ≡ ∡ M D B [ADMeqMDB] by Fexists, -, Angle_DEF; + M ∈ int_angle A D B by Fexists, Mexists, WholeRayInterior; + ¬(D = M) ∧ ¬Collinear A D M ∧ ¬Collinear B D M [ADMncol] by -, InteriorEZHelp, InteriorAngleSymmetry; + seg D M ≡ seg D M by -, SEGMENT, C2Reflexive; + A,D,M ≅ B,D,M by ADMncol, Dexists, -, ADMeqMDB, AngleSymmetry, SAS; + qed by Mexists, -, TriangleCong_DEF, SegmentSymmetry; +`;; + +let EuclidPropositionI_7short = thm `; + let A B C D be point; + let a be point_set; + assume ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a [a_line]; + assume ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a [Csim_aD]; + assume seg A C ≡ seg A D [ACeqAD]; + thus ¬(seg B C ≡ seg B D) + + proof + ¬(A = C) ∧ ¬(A = D) [AnotCD] by a_line, Csim_aD, ∉; + assume seg B C ≡ seg B D; + seg C B ≡ seg D B ∧ seg A B ≡ seg A B ∧ seg A D ≡ seg A D [segeqs] by -, SegmentSymmetry, a_line, AnotCD, SEGMENT, C2Reflexive; + ¬Collinear A C B ∧ ¬Collinear A D B by a_line, I1, Csim_aD, Collinear_DEF, ∉; + A,C,B ≅ A,D,B by -, ACeqAD, segeqs, SSS; + ∡ B A C ≡ ∡ B A D by -, TriangleCong_DEF; + ray A D = ray A C by a_line, Csim_aD, -, C4Uniqueness; + C ∈ ray A D ━ A ∧ D ∈ ray A D ━ A by AnotCD, -, EndpointInRay, IN_DELETE; + C = D by AnotCD, SEGMENT, -, ACeqAD, segeqs, C1; + qed by -, Csim_aD; +`;; + +let EuclidPropositionI_7Help = thm `; + let A B C D be point; + let a be point_set; + assume ¬(A = B) [notAB]; + assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; + assume ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a [Csim_aD]; + assume seg A C ≡ seg A D [ACeqAD]; + assume C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D [Int_ConvQuad]; + thus ¬(seg B C ≡ seg B D) + + proof + ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) [Distinct] by a_line, Csim_aD, ∉, SameSide_DEF; + cases by Int_ConvQuad; + suppose ConvexQuadrilateral A B C D; + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ Tetralateral A B C D [ABint] by -, ConvexQuad_DEF, Quadrilateral_DEF; + ¬Collinear B C D ∧ ¬Collinear D C B ∧ ¬Collinear C B D ∧ ¬Collinear C D A ∧ ¬Collinear D A C ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) [angCDB] by -, Tetralateral_DEF, CollinearSymmetry, ANGLE; + ∡ C D A ≡ ∡ D C A [CDAeqDCA] by angCDB, Distinct, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; + A ∈ int_angle D C B ∧ ∡ D C A ≡ ∡ D C A ∧ ∡ C D B ≡ ∡ C D B by ABint, InteriorAngleSymmetry, angCDB, ANGLE, C5Reflexive; + ∡ D C A <_ang ∡ D C B ∧ ∡ C D B <_ang ∡ C D A by angCDB, ABint, -, AngleOrdering_DEF; + ∡ C D B <_ang ∡ D C B by -, angCDB, CDAeqDCA, AngleTrichotomy2, AngleOrderTransitivity; + ¬(∡ D C B ≡ ∡ C D B) by -, AngleTrichotomy1, angCDB, ANGLE, C5Symmetric; + qed by angCDB, -, IsoscelesCongBaseAngles; + suppose C ∈ int_triangle D A B; + C ∈ int_angle A D B ∧ C ∈ int_angle D A B [CintADB] by -, IN_InteriorTriangle, InteriorAngleSymmetry; + ¬Collinear A D C ∧ ¬Collinear B D C [ADCncol] by CintADB, InteriorEZHelp, InteriorAngleSymmetry; + ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by -, CollinearSymmetry; + ¬Collinear B C D ∧ Angle (∡ D C A) ∧ Angle (∡ C D B) ∧ ¬Collinear D C B [angCDB] by ADCncol, -, CollinearSymmetry, ANGLE; + ∡ C D A ≡ ∡ D C A [CDAeqDCA] by DACncol, Distinct, ADCncol, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; + consider E such that + D ∈ open (A,E) ∧ ¬(D = E) ∧ Collinear A D E [ADE] by Distinct, B2', B1'; + B ∈ int_angle C D E ∧ Collinear D A E [BintCDE] by CintADB, -, InteriorReflectionInterior, CollinearSymmetry; + ¬Collinear C D E [CDEncol] by DACncol, -, ADE, NoncollinearityExtendsToLine; + consider F such that + F ∈ open (B,D) ∧ F ∈ ray A C ━ A [Fexists] by CintADB, Crossbar_THM, B1'; + F ∈ int_angle B C D [FintBCD] by ADCncol, CollinearSymmetry, -, ConverseCrossbar; + ¬Collinear D C F [DCFncol] by Distinct, ADCncol, CollinearSymmetry, Fexists, B1', NoncollinearityExtendsToLine; + Collinear A C F ∧ F ∈ ray D B ━ D ∧ C ∈ int_angle A D F by Fexists, IN_DELETE, IN_Ray, B1', IntervalRayEZ, CintADB, InteriorWellDefined; + C ∈ open (A,F) by -, AlternateConverseCrossbar; + ∡ A D C suppl ∡ C D E ∧ ∡ A C D suppl ∡ D C F by ADE, DACncol, -, SupplementaryAngles_DEF; + ∡ C D E ≡ ∡ D C F [CDEeqDCF] by -, CDAeqDCA, AngleSymmetry, SupplementsCongAnglesCong; + ∡ C D B <_ang ∡ C D E by angCDB, CDEncol, BintCDE, C5Reflexive, AngleOrdering_DEF; + ∡ C D B <_ang ∡ D C F [CDBlessDCF] by -, DCFncol, ANGLE, CDEeqDCF, AngleTrichotomy2; + ∡ D C F <_ang ∡ D C B by DCFncol, ANGLE, angCDB, FintBCD, InteriorAngleSymmetry, C5Reflexive, AngleOrdering_DEF; + ∡ C D B <_ang ∡ D C B by CDBlessDCF, -, AngleOrderTransitivity; + ¬(∡ D C B ≡ ∡ C D B) by -, AngleTrichotomy1, angCDB, CollinearSymmetry, ANGLE, C5Symmetric; + qed by Distinct, ADCncol, CollinearSymmetry, -, IsoscelesCongBaseAngles; + end; +`;; + +let EuclidPropositionI_7 = thm `; + let A B C D be point; + let a be point_set; + assume ¬(A = B) [notAB]; + assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; + assume ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ C,D same_side a [Csim_aD]; + assume seg A C ≡ seg A D [ACeqAD]; + thus ¬(seg B C ≡ seg B D) + + proof + ¬Collinear A B C ∧ ¬Collinear D A B [ABCncol] by a_line, notAB, I1, Collinear_DEF, Csim_aD, ∉; + ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ A ∉ open (C,D) [Distinct] by a_line, Csim_aD, ∉, SameSide_DEF; + ¬Collinear A D C [ADCncol] + proof + assume Collinear A D C; + C ∈ ray A D ━ A ∧ D ∈ ray A D ━ A by Distinct, -, IN_Ray, EndpointInRay, IN_DELETE; + qed by Distinct, SEGMENT, -, ACeqAD, C2Reflexive, C1, Csim_aD; + D,C same_side a [Dsim_aC] by a_line, Csim_aD, SameSideSymmetric; + seg A D ≡ seg A C ∧ seg B D ≡ seg B D [ADeqAC] by Distinct, SEGMENT, ACeqAD, C2Symmetric, C2Reflexive; + ¬Collinear D A C ∧ ¬Collinear C D A ∧ ¬Collinear A C D ∧ ¬Collinear A D C [DACncol] by ADCncol, CollinearSymmetry; + ¬(seg B D ≡ seg B C) ⇒ ¬(seg B C ≡ seg B D) [BswitchDC] by Distinct, SEGMENT, C2Symmetric; + cases; + suppose Collinear B D C; + B ∉ open (C,D) ∧ C ∈ ray B D ━ B ∧ D ∈ ray B D ━ B by a_line, Csim_aD, SameSide_DEF, ∉, Distinct, -, IN_Ray, Distinct, IN_DELETE, EndpointInRay; + qed by Distinct, SEGMENT, -, ACeqAD, ADeqAC, C1, Csim_aD; + suppose ¬Collinear B D C [BDCncol]; + Tetralateral A B C D by notAB, Distinct, Csim_aD, ABCncol, -, CollinearSymmetry, DACncol, Tetralateral_DEF; + ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B ∨ + ConvexQuadrilateral A B D C ∨ D ∈ int_triangle C A B by -, a_line, Csim_aD, FourChoicesTetralateral, InteriorTriangleSymmetry; + qed by notAB, a_line, Csim_aD, Dsim_aC, ACeqAD, ADeqAC, -, EuclidPropositionI_7Help, BswitchDC; + end; +`;; + +let EuclidPropositionI_11 = thm `; + let A B be point; + assume ¬(A = B) [notAB]; + thus ∃ F. Right (∡ A B F) + + proof + consider C such that + B ∈ open (A,C) ∧ seg B C ≡ seg B A [ABC] by notAB, SEGMENT, C1OppositeRay; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C [Distinct] by ABC, B1'; + seg B A ≡ seg B C [BAeqBC] by -, SEGMENT, ABC, C2Symmetric; + consider F such that + ¬Collinear A F C ∧ seg F A ≡ seg F C [Fexists] by Distinct, IsoscelesExists; + ¬Collinear B F A ∧ ¬Collinear B F C [BFAncol] by -, CollinearSymmetry, Distinct, NoncollinearityExtendsToLine; + ¬Collinear A B F ∧ Angle (∡ A B F) [angABF] by BFAncol, CollinearSymmetry, ANGLE; + ∡ A B F suppl ∡ F B C [ABFsuppl] by -, ABC, SupplementaryAngles_DEF; + ¬(B = F) ∧ seg B F ≡ seg B F by BFAncol, NonCollinearImpliesDistinct, SEGMENT, C2Reflexive; + B,F,A ≅ B,F,C by BFAncol, -, BAeqBC, Fexists, SSS; + ∡ A B F ≡ ∡ F B C by -, TriangleCong_DEF, AngleSymmetry; + qed by angABF, ABFsuppl, -, RightAngle_DEF; +`;; + +let DropPerpendicularToLine = thm `; + let P be point; + let l be point_set; + assume Line l ∧ P ∉ l [l_line]; + thus ∃ E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) + + proof + consider A B such that + A ∈ l ∧ B ∈ l ∧ ¬(A = B) [ABl] by l_line, I2; + ¬Collinear B A P ∧ ¬Collinear P A B ∧ ¬(A = P) [BAPncol] by l_line, ABl, I1, Collinear_DEF, ∉, CollinearSymmetry, ABl, ∉; + Angle (∡ B A P) ∧ Angle (∡ P A B) [angBAP] by -, ANGLE, AngleSymmetry; + consider P' such that + ¬(A = P') ∧ P' ∉ l ∧ ¬(P,P' same_side l) ∧ seg A P' ≡ seg A P ∧ ∡ B A P' ≡ ∡ B A P [P'exists] by angBAP, ABl, BAPncol, l_line, C4OppositeSide; + consider Q such that + Q ∈ l ∧ Q ∈ open (P,P') ∧ Collinear A B Q [Qexists] by l_line, -, SameSide_DEF, ABl, Collinear_DEF; + ¬Collinear B A P' [BAP'ncol] by l_line, ABl, I1, Collinear_DEF, P'exists, ∉; + ∡ B A P ≡ ∡ B A P' [BAPeqBAP'] by -, ANGLE, angBAP, P'exists, C5Symmetric; + ∃ E. E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' + proof + cases; + suppose A = Q [AQ]; + qed by ABl, AQ, BAPncol, BAPeqBAP', AngleSymmetry; + suppose ¬(A = Q) [notAQ]; + seg A Q ≡ seg A Q ∧ seg A P ≡ seg A P' [APeqAP'] by -, SEGMENT, C2Reflexive, BAPncol, P'exists, C2Symmetric; + ¬Collinear Q A P' ∧ ¬Collinear Q A P [QAP'ncol] by l_line, ABl, Qexists, notAQ, I1, Collinear_DEF, P'exists, ∉; + ∡ Q A P ≡ ∡ Q A P' + proof + cases; + suppose A ∈ open (Q,B); + ∡ B A P suppl ∡ P A Q ∧ ∡ B A P' suppl ∡ P' A Q by BAPncol, BAP'ncol, -, B1', SupplementaryAngles_DEF; + qed by -, BAPeqBAP', SupplementsCongAnglesCong, AngleSymmetry; + suppose ¬(A ∈ open (Q,B)); + A ∉ open (Q,B) ∧ Q ∈ ray A B ━ A ∧ ray A Q = ray A B by -, ∉, ABl, Qexists, IN_Ray, notAQ, IN_DELETE, ABl, RayWellDefined; + qed by -, BAPeqBAP', Angle_DEF; + end; + Q,A,P ≅ Q,A,P' by QAP'ncol, APeqAP', -, SAS; + qed by -, TriangleCong_DEF, AngleSymmetry, ABl, QAP'ncol, CollinearSymmetry; + end; + consider E such that + E ∈ l ∧ ¬Collinear P Q E ∧ ∡ P Q E ≡ ∡ E Q P' [Eexists] by -; + ∡ P Q E suppl ∡ E Q P' ∧ Right (∡ P Q E) by -, Qexists, SupplementaryAngles_DEF, RightAngle_DEF; + qed by Eexists, Qexists, -; +`;; + +let EuclidPropositionI_14 = thm `; + let A B C D be point; + let l be point_set; + assume Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) [l_line]; + assume C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) [Cnsim_lD]; + assume ∡ C B A suppl ∡ A B D [CBAsupplABD]; + thus B ∈ open (C,D) + + proof + ¬(B = C) ∧ ¬(B = D) ∧ ¬Collinear C B A [Distinct] by l_line, Cnsim_lD, ∉, I1, Collinear_DEF; + consider E such that + B ∈ open (C,E) [CBE] by Distinct, B2'; + E ∉ l ∧ ¬(C,E same_side l) [Csim_lE] by l_line, ∉, -, BetweenLinear, Cnsim_lD, SameSide_DEF; + D,E same_side l [Dsim_lE] by l_line, Cnsim_lD, -, AtMost2Sides; + ∡ C B A suppl ∡ A B E by Distinct, CBE, SupplementaryAngles_DEF; + ∡ A B D ≡ ∡ A B E by CBAsupplABD, -, SupplementUnique; + ray B E = ray B D by l_line, Csim_lE, Cnsim_lD, Dsim_lE, -, C4Uniqueness; + D ∈ ray B E ━ B by Distinct, -, EndpointInRay, IN_DELETE; + qed by CBE, -, OppositeRaysIntersect1pointHelp, B1'; +`;; + +let VerticalAnglesCong = thm `; :: Euclid's Proposition I.15 + let A B O A' B' be point; + assume ¬Collinear A O B [H1]; + assume O ∈ open (A,A') ∧ O ∈ open (B,B') [H2]; + thus ∡ B O A' ≡ ∡ B' O A + + proof + ∡ A O B suppl ∡ B O A' [AOBsupplBOA'] by H1, H2, SupplementaryAngles_DEF; + ∡ B O A suppl ∡ A O B' by H1, CollinearSymmetry, H2, SupplementaryAngles_DEF; + qed by AOBsupplBOA', -, AngleSymmetry, SupplementUnique; +`;; + +let EuclidPropositionI_16 = thm `; + let A B C D be point; + assume ¬Collinear A B C [H1]; + assume C ∈ open (B,D) [H2]; + thus ∡ B A C <_ang ∡ D C A + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by Distinct, I1; + consider m such that + Line m ∧ B ∈ m ∧ C ∈ m [m_line] by Distinct, I1; + D ∈ m [Dm] by m_line, H2, BetweenLinear; + consider E such that + E ∈ open (A,C) ∧ seg A E ≡ seg E C [AEC] by Distinct, MidpointExists; + ¬(A = E) ∧ ¬(E = C) ∧ Collinear A E C ∧ ¬(B = E) [AECcol] by -, B1', H1; + E ∈ l [El] by l_line, AEC, BetweenLinear; + consider F such that + E ∈ open (B,F) ∧ seg E F ≡ seg E B [BEF] by AECcol, SEGMENT, C1OppositeRay; + ¬(B = E) ∧ ¬(B = F) ∧ ¬(E = F) ∧ Collinear B E F [BEF'] by BEF, B1'; + B ∉ l [notBl] by l_line, Distinct, I1, Collinear_DEF, H1, ∉; + ¬Collinear A E B ∧ ¬Collinear C E B [AEBncol] by l_line, El, AECcol, I1, Collinear_DEF, notBl, ∉; + Angle (∡ B A E) [angBAE] by -, CollinearSymmetry, ANGLE; + ¬Collinear C E F [CEFncol] by AEBncol, BEF', CollinearSymmetry, NoncollinearityExtendsToLine; + ∡ B E A ≡ ∡ F E C [BEAeqFEC] by AEBncol, AEC, B1', BEF, VerticalAnglesCong; + seg E A ≡ seg E C ∧ seg E B ≡ seg E F by AEC, SegmentSymmetry, AECcol, BEF', SEGMENT, BEF, C2Symmetric; + A,E,B ≅ C,E,F by AEBncol, CEFncol, -, BEAeqFEC, AngleSymmetry, SAS; + ∡ B A E ≡ ∡ F C E [BAEeqFCE] by -, TriangleCong_DEF; + ¬Collinear E C D [ECDncol] by AEBncol, H2, B1', CollinearSymmetry, NoncollinearityExtendsToLine; + F ∉ l ∧ D ∉ l [notFl] by l_line, El, Collinear_DEF, CEFncol, -, ∉; + F ∈ ray B E ━ B ∧ E ∉ m by BEF, IntervalRayEZ, m_line, Collinear_DEF, AEBncol, ∉; + F ∉ m ∧ F,E same_side m [Fsim_mE] by m_line, -, RaySameSide; + ¬(B,F same_side l) ∧ ¬(B,D same_side l) by El, l_line, BEF, H2, SameSide_DEF; + F,D same_side l by l_line, notBl, notFl, -, AtMost2Sides; + F ∈ int_angle E C D by ECDncol, l_line, El, m_line, Dm, notFl, Fsim_mE, -, IN_InteriorAngle; + ∡ B A E <_ang ∡ E C D [BAElessECD] by angBAE, ECDncol, -, BAEeqFCE, AngleSymmetry, AngleOrdering_DEF; + ray A E = ray A C ∧ ray C E = ray C A by AEC, B1', IntervalRay; + ∡ B A C <_ang ∡ A C D by BAElessECD, -, Angle_DEF; + qed by -, AngleSymmetry; +`;; + +let ExteriorAngle = thm `; + let A B C D be point; + assume ¬Collinear A B C [H1]; + assume C ∈ open (B,D) [H2]; + thus ∡ A B C <_ang ∡ A C D + + proof + ¬(C = D) ∧ C ∈ open (D,B) ∧ Collinear B C D [H2'] by H2, BetweenLinear, B1'; + ¬Collinear B A C ∧ ¬(A = C) [BACncol] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; + consider E such that + C ∈ open (A,E) [ACE] by -, B2'; + ¬(C = E) ∧ C ∈ open (E,A) ∧ Collinear A C E [ACE'] by -, B1'; + ¬Collinear A C D ∧ ¬Collinear D C E [DCEncol] by H1, CollinearSymmetry, H2', -, NoncollinearityExtendsToLine; + ∡ A B C <_ang ∡ E C B [ABClessECB] by BACncol, ACE, EuclidPropositionI_16; + ∡ E C B ≡ ∡ A C D by DCEncol, ACE', H2', VerticalAnglesCong; + qed by ABClessECB, DCEncol, ANGLE, -, AngleTrichotomy2; +`;; + +let EuclidPropositionI_17 = thm `; + let A B C be point; + let α β γ be point_set; + assume ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A [H1]; + assume β suppl γ [H2]; + thus α <_ang γ + + proof + Angle γ [angγ] by H2, SupplementImpliesAngle; + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; + ¬Collinear B A C ∧ ¬Collinear A C B [BACncol] by H1, CollinearSymmetry; + consider D such that + C ∈ open (A,D) [ACD] by Distinct, B2'; + ∡ A B C <_ang ∡ D C B [ABClessDCB] by BACncol, ACD, EuclidPropositionI_16; + β suppl ∡ B C D by -, H1, AngleSymmetry, BACncol, ACD, SupplementaryAngles_DEF; + ∡ B C D ≡ γ by H2, -, SupplementUnique; + qed by ABClessDCB, H1, AngleSymmetry, angγ, -, AngleTrichotomy2; +`;; + +let EuclidPropositionI_18 = thm `; + let A B C be point; + assume ¬Collinear A B C [H1]; + assume seg A C <__ seg A B [H2]; + thus ∡ A B C <_ang ∡ B C A + + proof + ¬(A = B) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + consider D such that + D ∈ open (A,B) ∧ seg A C ≡ seg A D [ADB] by Distinct, SEGMENT, H2, SegmentOrderingUse; + ¬(D = A) ∧ ¬(D = B) ∧ D ∈ open (B,A) ∧ Collinear A D B ∧ ray B D = ray B A [ADB'] by -, B1', IntervalRay; + D ∈ int_angle A C B [DintACB] by H1, CollinearSymmetry, ADB, ConverseCrossbar; + ¬Collinear D A C ∧ ¬Collinear C B D [DACncol] by H1, CollinearSymmetry, ADB', NoncollinearityExtendsToLine; + seg A D ≡ seg A C by ADB', Distinct, SEGMENT, ADB, C2Symmetric; + ∡ C D A ≡ ∡ A C D by DACncol, -, IsoscelesCongBaseAngles, AngleSymmetry; + ∡ C D A <_ang ∡ A C B [CDAlessACB] by DACncol, CollinearSymmetry, ANGLE, H1, CollinearSymmetry, DintACB, -, AngleOrdering_DEF; + ∡ B D C suppl ∡ C D A by DACncol, CollinearSymmetry, ADB', SupplementaryAngles_DEF; + ∡ C B D <_ang ∡ C D A by DACncol, -, EuclidPropositionI_17; + ∡ C B D <_ang ∡ A C B by -, CDAlessACB, AngleOrderTransitivity; + qed by -, ADB', Angle_DEF, AngleSymmetry; +`;; + +let EuclidPropositionI_19 = thm `; + let A B C be point; + assume ¬Collinear A B C [H1]; + assume ∡ A B C <_ang ∡ B C A [H2]; + thus seg A C <__ seg A B + + proof + ¬Collinear B A C ∧ ¬Collinear B C A ∧ ¬Collinear A C B [BACncol] by H1, CollinearSymmetry; + ¬(A = B) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + assume ¬(seg A C <__ seg A B); + seg A B ≡ seg A C ∨ seg A B <__ seg A C by Distinct, SEGMENT, -, SegmentTrichotomy; + cases by -; + suppose seg A B ≡ seg A C; + ∡ C B A ≡ ∡ B C A by BACncol, -, IsoscelesCongBaseAngles; + qed by -, AngleSymmetry, H2, AngleTrichotomy1; + suppose seg A B <__ seg A C; + ∡ A C B <_ang ∡ C B A by BACncol, -, EuclidPropositionI_18; + qed by H1, BACncol, ANGLE, -, AngleSymmetry, H2, AngleTrichotomy; + end; +`;; + +let EuclidPropositionI_20 = thm `; + let A B C D be point; + assume ¬Collinear A B C [H1]; + assume A ∈ open (B,D) ∧ seg A D ≡ seg A C [H2]; + thus seg B C <__ seg B D + + proof + ¬(B = D) ∧ ¬(A = D) ∧ A ∈ open (D,B) ∧ Collinear B A D ∧ ray D A = ray D B [BAD'] by H2, B1', IntervalRay; + ¬Collinear C A D [CADncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; + ¬Collinear D C B ∧ ¬Collinear B D C [DCBncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; :: 13 + Angle (∡ C D A) [angCDA] by CADncol, CollinearSymmetry, ANGLE; + ∡ C D A ≡ ∡ D C A [CDAeqDCA] by CADncol, CollinearSymmetry, H2, IsoscelesCongBaseAngles; + A ∈ int_angle D C B by DCBncol, BAD', ConverseCrossbar; + ∡ C D A <_ang ∡ D C B by angCDA, DCBncol, -, CDAeqDCA, AngleOrdering_DEF; + ∡ B D C <_ang ∡ D C B by -, BAD', Angle_DEF, AngleSymmetry; + qed by DCBncol, -, EuclidPropositionI_19; +`;; + +let EuclidPropositionI_21 = thm `; + let A B C D be point; + assume ¬Collinear A B C [H1]; + assume D ∈ int_triangle A B C [H2]; + thus ∡ A B C <_ang ∡ C D A + + proof + ¬(B = A) ∧ ¬(B = C) ∧ ¬(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + D ∈ int_angle B A C ∧ D ∈ int_angle C B A [DintTri] by H2, IN_InteriorTriangle, InteriorAngleSymmetry; + consider E such that + E ∈ open (B,C) ∧ E ∈ ray A D ━ A [BEC] by -, Crossbar_THM; + ¬(B = E) ∧ ¬(E = C) ∧ Collinear B E C ∧ Collinear A D E [BEC'] by -, B1', IN_DELETE, IN_Ray; + ray B E = ray B C ∧ E ∈ ray B C ━ B [rBErBC] by BEC, IntervalRay, IntervalRayEZ; + D ∈ int_angle A B E [DintABE] by DintTri, -, InteriorAngleSymmetry, InteriorWellDefined; + D ∈ open (A,E) [ADE] by BEC', -, AlternateConverseCrossbar; + ray E D = ray E A [rEDrEA] by -, B1', IntervalRay; + ¬Collinear A B E ∧ ¬Collinear B E A ∧ ¬Collinear C B D ∧ ¬(A = D) [ABEncol] by DintABE, IN_InteriorAngle, CollinearSymmetry, DintTri, InteriorEZHelp; + ¬Collinear E D C ∧ ¬Collinear C E D [EDCncol] by -, CollinearSymmetry, BEC', NoncollinearityExtendsToLine; + ∡ A B E <_ang ∡ A E C by ABEncol, BEC, ExteriorAngle; + ∡ A B C <_ang ∡ C E D [ABClessAEC] by -, rBErBC, rEDrEA, Angle_DEF, AngleSymmetry; + ∡ C E D <_ang ∡ C D A by EDCncol, ADE, B1', ExteriorAngle; + qed by ABClessAEC, -, AngleOrderTransitivity; +`;; + +let AngleTrichotomy3 = thm `; + let α β γ be point_set; + assume α <_ang β ∧ Angle γ ∧ γ ≡ α [H1]; + thus γ <_ang β + + proof + consider A O B G such that + Angle α ∧ ¬Collinear A O B ∧ β = ∡ A O B ∧ G ∈ int_angle A O B ∧ α ≡ ∡ A O G [H1'] by H1, AngleOrdering_DEF; + ¬Collinear A O G by -, InteriorEZHelp; + γ ≡ ∡ A O G by H1, H1', -, ANGLE, C5Transitive; + qed by H1, H1', -, AngleOrdering_DEF; +`;; + +let InteriorCircleConvexHelp = thm `; + let O A B C be point; + assume ¬Collinear A O C [H1]; + assume B ∈ open (A,C) [H2]; + assume seg O A <__ seg O C ∨ seg O A ≡ seg O C [H3]; + thus seg O B <__ seg O C + + proof + ¬Collinear O C A ∧ ¬Collinear C O A ∧ ¬(O = A) ∧ ¬(O = C) [H1'] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; + ray A B = ray A C ∧ ray C B = ray C A [equal_rays] by H2, IntervalRay, B1'; + ∡ O C A <_ang ∡ C A O ∨ ∡ O C A ≡ ∡ C A O + proof + cases by H3; + suppose seg O A <__ seg O C; + qed by H1', -, EuclidPropositionI_18; + suppose seg O A ≡ seg O C [seg_eq]; + seg O C ≡ seg O A by H1', SEGMENT, -, C2Symmetric; + qed by H1', -, IsoscelesCongBaseAngles, AngleSymmetry; + end; + ∡ O C B <_ang ∡ B A O ∨ ∡ O C B ≡ ∡ B A O by -, equal_rays, Angle_DEF; + ∡ B C O <_ang ∡ O A B ∨ ∡ B C O ≡ ∡ O A B [BCOlessOAB] by -, AngleSymmetry; + ¬Collinear O A B ∧ ¬Collinear B C O ∧ ¬Collinear O C B [OABncol] by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; + ∡ O A B <_ang ∡ O B C by -, H2, ExteriorAngle; + ∡ B C O <_ang ∡ O B C by BCOlessOAB, -, AngleOrderTransitivity, OABncol, ANGLE, -, AngleTrichotomy3; + qed by OABncol, -, AngleSymmetry, EuclidPropositionI_19; +`;; + +let InteriorCircleConvex = thm `; + let O R A B C be point; + assume ¬(O = R) [H1]; + assume B ∈ open (A,C) [H2]; + assume A ∈ int_circle O R ∧ C ∈ int_circle O R [H3]; + thus B ∈ int_circle O R + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ B ∈ open (C,A) [H2'] by H2, B1'; + (A = O ∨ seg O A <__ seg O R) ∧ (C = O ∨ seg O C <__ seg O R) [ACintOR] by H3, H1, IN_InteriorCircle; + cases; + suppose O = A ∨ O = C; + B ∈ open (O,C) ∨ B ∈ open (O,A) by -, H2, B1'; + seg O B <__ seg O A ∧ ¬(O = A) ∨ seg O B <__ seg O C ∧ ¬(O = C) by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; + seg O B <__ seg O R by -, ACintOR, SegmentOrderTransitivity; + qed by -, H1, IN_InteriorCircle; + suppose ¬(O = A) ∧ ¬(O = C) [OnotAC]; + cases; + suppose ¬Collinear A O C [AOCncol]; + seg O A <__ seg O C ∨ seg O A ≡ seg O C ∨ seg O C <__ seg O A by OnotAC, SEGMENT, SegmentTrichotomy; + seg O B <__ seg O C ∨ seg O B <__ seg O A by AOCncol, H2, -, InteriorCircleConvexHelp, CollinearSymmetry, B1'; + qed by OnotAC, ACintOR, -, SegmentOrderTransitivity, H1, IN_InteriorCircle; + suppose Collinear A O C [AOCcol]; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l by H2', I1; + Collinear B A O ∧ Collinear B C O [OABCcol] by -, H2, BetweenLinear, H2', AOCcol, CollinearLinear, Collinear_DEF; + B ∉ open (O,A) ∧ B ∉ open (O,C) ⇒ B = O + proof + assume B ∉ open (O,A) ∧ B ∉ open (O,C); + O ∈ ray B A ∩ ray B C by H2', OABCcol, -, IN_Ray, IN_INTER; + qed by -, H2, OppositeRaysIntersect1point, IN_SING; + B ∈ open (O,A) ∨ B ∈ open (O,C) ∨ B = O by -, ∉; + seg O B <__ seg O A ∨ seg O B <__ seg O C ∨ B = O by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; + seg O B <__ seg O R ∨ B = O by -, ACintOR, OnotAC, SegmentOrderTransitivity; + qed by -, H1, IN_InteriorCircle; + end; + end; +`;; + +let SegmentTrichotomy3 = thm `; + let s t u be point_set; + assume s <__ t ∧ Segment u ∧ u ≡ s [H1]; + thus u <__ t + + proof + consider C D X such that + Segment s ∧ t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X ∧ ¬(C = X) [H1'] by H1, SegmentOrdering_DEF, B1'; + u ≡ seg C X by H1, -, SEGMENT, C2Transitive; + qed by H1, H1', -, SegmentOrdering_DEF; +`;; + +let EuclidPropositionI_24Help = thm `; + let O A C O' D F be point; + assume ¬Collinear A O C ∧ ¬Collinear D O' F [H1]; + assume seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C [H2]; + assume ∡ D O' F <_ang ∡ A O C [H3]; + assume seg O A <__ seg O C ∨ seg O A ≡ seg O C [H4]; + thus seg D F <__ seg A C + + proof + consider K such that + K ∈ int_angle A O C ∧ ∡ D O' F ≡ ∡ A O K [KintAOC] by H1, ANGLE, H3, AngleOrderingUse; + ¬(O = C) ∧ ¬(D = F) ∧ ¬(O' = F) ∧ ¬(O = K) [Distinct] by H1, NonCollinearImpliesDistinct, -, InteriorEZHelp; + consider B such that + B ∈ ray O K ━ O ∧ seg O B ≡ seg O C [BrOK] by Distinct, SEGMENT, -, C1; + ray O B = ray O K by Distinct, -, RayWellDefined; + ∡ D O' F ≡ ∡ A O B [DO'FeqAOB] by KintAOC, -, Angle_DEF; + B ∈ int_angle A O C [BintAOC] by KintAOC, BrOK, WholeRayInterior; + ¬(B = O) ∧ ¬Collinear A O B [AOBncol] by -, InteriorEZHelp; + seg O C ≡ seg O B [OCeqOB] by Distinct, -, SEGMENT, BrOK, C2Symmetric; + seg O' F ≡ seg O B by Distinct, SEGMENT, AOBncol, H2, -, C2Transitive; + D,O',F ≅ A,O,B by H1, AOBncol, H2, -, DO'FeqAOB, SAS; + seg D F ≡ seg A B [DFeqAB] by -, TriangleCong_DEF; + consider G such that + G ∈ open (A,C) ∧ G ∈ ray O B ━ O ∧ ¬(G = O) [AGC] by BintAOC, Crossbar_THM, B1', IN_DELETE; + Segment (seg O G) ∧ ¬(O = B) [notOB] by AGC, SEGMENT, BrOK, IN_DELETE; + seg O G <__ seg O C by H1, AGC, H4, InteriorCircleConvexHelp; + seg O G <__ seg O B by -, OCeqOB, BrOK, IN_DELETE, SEGMENT, SegmentTrichotomy2; + consider G' such that + G' ∈ open (O,B) ∧ seg O G ≡ seg O G' [OG'B] by notOB, -, SegmentOrderingUse; + ¬(G' = O) ∧ seg O G' ≡ seg O G' ∧ Segment (seg O G') [notG'O] by -, B1', SEGMENT, C2Reflexive, SEGMENT; + G' ∈ ray O B ━ O by OG'B, IntervalRayEZ; + G' = G ∧ G ∈ open (B,O) by notG'O, notOB, -, AGC, OG'B, C1, B1'; + ConvexQuadrilateral B A O C by H1, -, AGC, DiagonalsIntersectImpliesConvexQuad; + A ∈ int_angle O C B ∧ O ∈ int_angle C B A ∧ Quadrilateral B A O C [OintCBA] by -, ConvexQuad_DEF; + A ∈ int_angle B C O [AintBCO] by -, InteriorAngleSymmetry; + Tetralateral B A O C by OintCBA, Quadrilateral_DEF; + ¬Collinear C B A ∧ ¬Collinear B C O ∧ ¬Collinear C O B ∧ ¬Collinear C B O [BCOncol] by -, Tetralateral_DEF, CollinearSymmetry; + ∡ B C O ≡ ∡ C B O [BCOeqCBO] by -, OCeqOB, IsoscelesCongBaseAngles; + ¬Collinear B C A ∧ ¬Collinear A C B [ACBncol] by AintBCO, InteriorEZHelp, CollinearSymmetry; + ∡ B C A ≡ ∡ B C A ∧ Angle (∡ B C A) ∧ ∡ C B O ≡ ∡ C B O [CBOref] by -, ANGLE, BCOncol, C5Reflexive; + ∡ B C A <_ang ∡ B C O by -, BCOncol, ANGLE, AintBCO, AngleOrdering_DEF; + ∡ B C A <_ang ∡ C B O [BCAlessCBO] by -, BCOncol, ANGLE, BCOeqCBO, AngleTrichotomy2; + ∡ C B O <_ang ∡ C B A by BCOncol, ANGLE, OintCBA, CBOref, AngleOrdering_DEF; + ∡ A C B <_ang ∡ C B A by BCAlessCBO, -, AngleOrderTransitivity, AngleSymmetry; + seg A B <__ seg A C by ACBncol, -, EuclidPropositionI_19; + qed by -, Distinct, SEGMENT, DFeqAB, SegmentTrichotomy3; +`;; + +let EuclidPropositionI_24 = thm `; + let O A C O' D F be point; + assume ¬Collinear A O C ∧ ¬Collinear D O' F [H1]; + assume seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C [H2]; + assume ∡ D O' F <_ang ∡ A O C [H3]; + thus seg D F <__ seg A C + + proof + ¬(O = A) ∧ ¬(O = C) ∧ ¬Collinear C O A ∧ ¬Collinear F O' D [Distinct] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; + seg O A ≡ seg O C ∨ seg O A <__ seg O C ∨ seg O C <__ seg O A by -, SEGMENT, SegmentTrichotomy; + cases by -; + suppose seg O A <__ seg O C ∨ seg O A ≡ seg O C; + qed by H1, H2, H3, -, EuclidPropositionI_24Help; + suppose seg O C <__ seg O A [H4]; + ∡ F O' D <_ang ∡ C O A by H3, AngleSymmetry; + qed by Distinct, H3, AngleSymmetry, H2, H4, EuclidPropositionI_24Help, SegmentSymmetry; + end; +`;; + +let EuclidPropositionI_25 = thm `; + let O A C O' D F be point; + assume ¬Collinear A O C ∧ ¬Collinear D O' F [H1]; + assume seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C [H2]; + assume seg D F <__ seg A C [H3]; + thus ∡ D O' F <_ang ∡ A O C + + proof + ¬(O = A) ∧ ¬(O = C) ∧ ¬(A = C) ∧ ¬(D = F) ∧ ¬(O' = D) ∧ ¬(O' = F) [Distinct] by H1, NonCollinearImpliesDistinct; + assume ¬(∡ D O' F <_ang ∡ A O C); + ∡ D O' F ≡ ∡ A O C ∨ ∡ A O C <_ang ∡ D O' F by H1, ANGLE, -, AngleTrichotomy; + cases by -; + suppose ∡ D O' F ≡ ∡ A O C; + D,O',F ≅ A,O,C by H1, H2, -, SAS; + seg D F ≡ seg A C by -, TriangleCong_DEF; + qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; + suppose ∡ A O C <_ang ∡ D O' F [Con]; + seg O A ≡ seg O' D ∧ seg O C ≡ seg O' F [H2'] by Distinct, SEGMENT, H2, C2Symmetric; + seg A C <__ seg D F by H1, -, Con, EuclidPropositionI_24; + qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; + end; +`;; + +let AAS = thm `; + let A B C A' B' C' be point; + assume ¬Collinear A B C ∧ ¬Collinear A' B' C' [H1]; + assume ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' [H2]; + assume seg A B ≡ seg A' B' [H3]; + thus A,B,C ≅ A',B',C' + + proof + ¬(A = B) ∧ ¬(B = C) ∧ ¬(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; + consider G such that + G ∈ ray B C ━ B ∧ seg B G ≡ seg B' C' [Gexists] by Distinct, SEGMENT, C1; + ¬(G = B) ∧ B ∉ open (G,C) ∧ Collinear G B C [notGBC] by -, IN_DELETE, IN_Ray, CollinearSymmetry; + ¬Collinear A B G ∧ ¬Collinear B G A [ABGncol] by H1, notGBC, CollinearSymmetry, NoncollinearityExtendsToLine; + ray B G = ray B C by Distinct, Gexists, RayWellDefined; + ∡ A B G = ∡ A B C by Distinct, -, Angle_DEF; + A,B,G ≅ A',B',C' [ABG≅A'B'C'] by H1, ABGncol, H3, SegmentSymmetry, H2, -, Gexists, SAS; + ∡ B G A ≡ ∡ B' C' A' [BGAeqB'C'A'] by -, TriangleCong_DEF; + ¬Collinear B C A ∧ ¬Collinear B' C' A' [BCAncol] by H1, CollinearSymmetry; + ∡ B' C' A' ≡ ∡ B C A ∧ ∡ B C A ≡ ∡ B C A [BCArefl] by -, ANGLE, H2, C5Symmetric, C5Reflexive; + ∡ B G A ≡ ∡ B C A [BGAeqBCA] by ABGncol, BCAncol, ANGLE, BGAeqB'C'A', -, C5Transitive; + cases; + suppose G = C; + qed by -, ABG≅A'B'C'; + suppose ¬(G = C) [notGC]; + ¬Collinear A C G ∧ ¬Collinear A G C [ACGncol] by H1, notGBC, -, CollinearSymmetry, NoncollinearityExtendsToLine; + C ∈ open (B,G) ∨ G ∈ open (C,B) by notGBC, notGC, Distinct, B3', ∉; + cases by -; + suppose C ∈ open (B,G) ; + C ∈ open (G,B) ∧ ray G C = ray G B [rGCrBG] by -, B1', IntervalRay; + ∡ A G C <_ang ∡ A C B by ACGncol, -, ExteriorAngle; + ∡ B G A <_ang ∡ B C A by -, rGCrBG, Angle_DEF, AngleSymmetry, AngleSymmetry; + qed by ABGncol, BCAncol, ANGLE, -, AngleSymmetry, BGAeqBCA, AngleTrichotomy; + suppose G ∈ open (C,B) [CGB]; + ray C G = ray C B ∧ ∡ A C G <_ang ∡ A G B by -, IntervalRay, ACGncol, ExteriorAngle; + ∡ A C B <_ang ∡ B G A by -, Angle_DEF, AngleSymmetry; + ∡ B C A <_ang ∡ B C A by -, BCAncol, ANGLE, BGAeqBCA, AngleTrichotomy2, AngleSymmetry; + qed by -, BCArefl, AngleTrichotomy1; + end; + end; +`;; + +let ParallelSymmetry = thm `; + ∀ l k: point_set. l ∥ k ⇒ k ∥ l + by PARALLEL, INTER_COMM; +`;; + +let AlternateInteriorAngles = thm `; + let A B C E be point; + let l m t be point_set; + assume Line l ∧ A ∈ l ∧ E ∈ l [l_line]; + assume Line m ∧ B ∈ m ∧ C ∈ m [m_line]; + assume Line t ∧ A ∈ t ∧ B ∈ t [t_line]; + assume ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t [Distinct]; + assume ¬(C,E same_side t) [Cnsim_tE]; + assume ∡ E A B ≡ ∡ C B A [AltIntAngCong]; + thus l ∥ m + + proof + ¬Collinear E A B ∧ ¬Collinear C B A [EABncol] by t_line, Distinct, I1, Collinear_DEF, ∉; + B ∉ l ∧ A ∉ m [notAmBl] by l_line, m_line, Collinear_DEF, -, ∉; + assume ¬(l ∥ m); + ¬(l ∩ m = ∅) by -, l_line, m_line, PARALLEL; + consider G such that + G ∈ l ∧ G ∈ m [Glm] by -, MEMBER_NOT_EMPTY, IN_INTER; + ¬(G = A) ∧ ¬(G = B) ∧ Collinear B G C ∧ Collinear B C G ∧ Collinear A E G ∧ Collinear A G E [GnotAB] by -, notAmBl, ∉, m_line, l_line, Collinear_DEF; + ¬Collinear A G B ∧ ¬Collinear B G A ∧ G ∉ t [AGBncol] by EABncol, CollinearSymmetry, -, NoncollinearityExtendsToLine, t_line, Collinear_DEF, ∉; + ¬(E,C same_side t) [Ensim_tC] by t_line, -, Distinct, Cnsim_tE, SameSideSymmetric; + C ∈ m ━ B ∧ G ∈ m ━ B [CGm_B] by m_line, Glm, Distinct, GnotAB, IN_DELETE; + E ∈ l ━ A ∧ G ∈ l ━ A [EGm_A] by l_line, Glm, Distinct, GnotAB, IN_DELETE; + ¬(G,E same_side t) + proof + assume G,E same_side t [Gsim_tE]; + A ∉ open (G,E) [notGAE] by t_line, -, SameSide_DEF, ∉; + G ∈ ray A E ━ A by Distinct, GnotAB, notGAE, IN_Ray, GnotAB, IN_DELETE; + ray A G = ray A E [rAGrAE] by Distinct, -, RayWellDefined; + ¬(C,G same_side t) by t_line, AGBncol, Distinct, Gsim_tE, Cnsim_tE, SameSideTransitive; + C ∉ ray B G ∧ B ∈ open (C,G) by t_line, AGBncol, Distinct, -, RaySameSide, ∉, GnotAB, IN_DELETE, IN_Ray; + ∡ G A B <_ang ∡ C B A by AGBncol, -, B1', EuclidPropositionI_16; + ∡ E A B <_ang ∡ C B A by -, rAGrAE, Angle_DEF; + qed by EABncol, ANGLE, AltIntAngCong, -, AngleTrichotomy1; + G,C same_side t [Gsim_tC] by t_line, AGBncol, Distinct, -, Cnsim_tE, AtMost2Sides; + :: now we make a symmetric argument + B ∉ open (G,C) [notGBC] by t_line, -, SameSide_DEF, ∉; + G ∈ ray B C ━ B by Distinct, GnotAB, notGBC, IN_Ray, GnotAB, IN_DELETE; + ray B G = ray B C [rBGrBC] by Distinct, -, RayWellDefined; + ∡ C B A ≡ ∡ E A B [flipAltIntAngCong] by EABncol, ANGLE, AltIntAngCong, C5Symmetric; + ¬(E,G same_side t) by t_line, AGBncol, Distinct, Gsim_tC, Ensim_tC, SameSideTransitive; + E ∉ ray A G ∧ A ∈ open (E,G) by t_line, AGBncol, Distinct, -, RaySameSide, ∉, GnotAB, IN_Ray, IN_DELETE; + ∡ G B A <_ang ∡ E A B by AGBncol, -, B1', EuclidPropositionI_16; + ∡ C B A <_ang ∡ E A B by -, rBGrBC, Angle_DEF; + qed by EABncol, ANGLE, flipAltIntAngCong, -, AngleTrichotomy1; +`;; + +let EuclidPropositionI_28 = thm `; + let A B C D E F G H be point; + let l m t be point_set; + assume Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l [l_line]; + assume Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m [m_line]; + assume Line t ∧ G ∈ t ∧ H ∈ t [t_line]; + assume G ∉ m ∧ H ∉ l [notGmHl]; + assume G ∈ open (A,B) ∧ H ∈ open (C,D) [H1]; + assume G ∈ open (E,H) ∧ H ∈ open (F,G) [H2]; + assume ¬(D,A same_side t) [H3]; + assume ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D [H4]; + thus l ∥ m + + proof + ¬(A = G) ∧ ¬(G = B) ∧ ¬(H = D) ∧ ¬(E = G) ∧ ¬(G = H) ∧ Collinear A G B ∧ Collinear E G H [Distinct] by H1, H2, B1'; + ¬Collinear H G A ∧ ¬Collinear G H D ∧ A ∉ t ∧ D ∉ t [HGAncol] by l_line, m_line, Distinct, I1, Collinear_DEF, notGmHl, ∉, t_line, Collinear_DEF; + ¬Collinear B G H ∧ ¬Collinear A G E ∧ ¬Collinear E G B [BGHncol] by -, Distinct, CollinearSymmetry, NoncollinearityExtendsToLine; + ∡ A G H ≡ ∡ D H G + proof + cases by H4; + suppose ∡ E G B ≡ ∡ G H D [EGBeqGHD]; + ∡ E G B ≡ ∡ H G A by BGHncol, H1, H2, VerticalAnglesCong; + ∡ H G A ≡ ∡ E G B by BGHncol, HGAncol, ANGLE, -, C5Symmetric; + ∡ H G A ≡ ∡ G H D by BGHncol, HGAncol, ANGLE, -, EGBeqGHD, C5Transitive; + qed by -, AngleSymmetry; + suppose ∡ B G H suppl ∡ G H D [BGHeqGHD]; + ∡ B G H suppl ∡ H G A by BGHncol, H1, B1', SupplementaryAngles_DEF; + qed by -, BGHeqGHD, AngleSymmetry, SupplementUnique, AngleSymmetry; + end; + qed by l_line, m_line, t_line, Distinct, HGAncol, H3, -, AlternateInteriorAngles; +`;; + +let OppositeSidesCongImpliesParallelogram = thm `; + let A B C D be point; + assume Quadrilateral A B C D [H1]; + assume seg A B ≡ seg C D ∧ seg B C ≡ seg D A [H2]; + thus Parallelogram A B C D + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + consider a c such that + Line a ∧ A ∈ a ∧ B ∈ a ∧ + Line c ∧ C ∈ c ∧ D ∈ c [ac_line] by TetraABCD, I1; + consider b d such that + Line b ∧ B ∈ b ∧ C ∈ b ∧ + Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by TetraABCD, I1; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by TetraABCD, I1; + consider m such that + Line m ∧ B ∈ m ∧ D ∈ m [m_line] by TetraABCD, I1; + B ∉ l ∧ D ∉ l ∧ A ∉ m ∧ C ∉ m [notBDlACm] by l_line, m_line, TetraABCD, Collinear_DEF, ∉; + seg A C ≡ seg C A ∧ seg B D ≡ seg D B [seg_refl] by TetraABCD, SEGMENT, C2Reflexive, SegmentSymmetry; + A,B,C ≅ C,D,A by TetraABCD, H2, -, SSS; + ∡ B C A ≡ ∡ D A C ∧ ∡ C A B ≡ ∡ A C D [BCAeqDAC] by -, TriangleCong_DEF; + seg C D ≡ seg A B [CDeqAB] by TetraABCD, SEGMENT, H2, C2Symmetric; + B,C,D ≅ D,A,B by TetraABCD, H2, -, seg_refl, SSS; + ∡ C D B ≡ ∡ A B D ∧ ∡ D B C ≡ ∡ B D A [CDBeqABD] by -, TriangleCong_DEF; + ¬(B,D same_side l) ∨ ¬(A,C same_side m) by H1, l_line, m_line, FiveChoicesQuadrilateral; + cases by -; + suppose ¬(B,D same_side l); + ¬(D,B same_side l) by l_line, notBDlACm, -, SameSideSymmetric; + a ∥ c ∧ b ∥ d by ac_line, l_line, TetraABCD, notBDlACm, -, BCAeqDAC, AngleSymmetry, AlternateInteriorAngles, bd_line, BCAeqDAC; + qed by H1, ac_line, bd_line, -, Parallelogram_DEF; + suppose ¬(A,C same_side m); + b ∥ d ∧ c ∥ a by bd_line, m_line, TetraABCD, notBDlACm, -, CDBeqABD, AngleSymmetry, AlternateInteriorAngles, ac_line, CDBeqABD; + qed by H1, ac_line, bd_line, -, ParallelSymmetry, Parallelogram_DEF; + end; +`;; + +let OppositeAnglesCongImpliesParallelogramHelp = thm `; + let A B C D be point; + let a c be point_set; + assume Quadrilateral A B C D [H1]; + assume ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D [H2]; + assume Line a ∧ A ∈ a ∧ B ∈ a [a_line]; + assume Line c ∧ C ∈ c ∧ D ∈ c [c_line]; + thus a ∥ c + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + ∡ C D A ≡ ∡ A B C ∧ ∡ B C D ≡ ∡ D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; + consider l m such that + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m [lm_line] by TetraABCD, I1; + consider b d such that + Line b ∧ B ∈ b ∧ C ∈ b ∧ Line d ∧ D ∈ d ∧ A ∈ d [bd_line] by TetraABCD, I1; + A ∉ c ∧ B ∉ c ∧ A ∉ b ∧ D ∉ b ∧ B ∉ d ∧ C ∉ d [point_off_line] by c_line, bd_line, Collinear_DEF, TetraABCD, ∉; + ¬(A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ + C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) + proof + assume A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ + C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C; + ∡ B C D <_ang ∡ D A B ∨ ∡ C D A <_ang ∡ A B C ∨ + ∡ D A B <_ang ∡ B C D ∨ ∡ A B C <_ang ∡ C D A by TetraABCD, -, EuclidPropositionI_21; + qed by -, H2', H2, AngleTrichotomy1; + ConvexQuadrilateral A B C D by H1, lm_line, -, FiveChoicesQuadrilateral; + A ∈ int_angle B C D ∧ B ∈ int_angle C D A ∧ + C ∈ int_angle D A B ∧ D ∈ int_angle A B C [AintBCD] by -, ConvexQuad_DEF; + B,A same_side c ∧ B,C same_side d [Bsim_cA] by c_line, bd_line, -, InteriorUse; + A,D same_side b [Asim_bD] by bd_line, c_line, AintBCD, InteriorUse; + assume ¬(a ∥ c); + consider G such that + G ∈ a ∧ G ∈ c [Gac] by -, a_line, c_line, PARALLEL, MEMBER_NOT_EMPTY, IN_INTER; + Collinear A B G ∧ Collinear D G C ∧ Collinear C G D [ABGcol] by a_line, -, Collinear_DEF, c_line; + ¬(G = A) ∧ ¬(G = B) ∧ ¬(G = C) ∧ ¬(G = D) [GnotABCD] by Gac, ABGcol, TetraABCD, CollinearSymmetry, Collinear_DEF; + ¬Collinear B G C ∧ ¬Collinear A D G [BGCncol] by c_line, Gac, GnotABCD, I1, Collinear_DEF, point_off_line, ∉; + ¬Collinear B C G ∧ ¬Collinear G B C ∧ ¬Collinear G A D ∧ ¬Collinear A G D [BCGncol] by -, CollinearSymmetry; + G ∉ b ∧ G ∉ d [notGb] by bd_line, Collinear_DEF, BGCncol, ∉; + G ∉ open (B,A) [notBGA] by Bsim_cA, Gac, SameSide_DEF, ∉; + B ∉ open (A,G) [notABG] + proof + assume ¬(B ∉ open (A,G)); + B ∈ open (A,G) [ABG] by -, ∉; + ray A B = ray A G [rABrAG] by -, IntervalRay; + ¬(A,G same_side b) by bd_line, ABG, SameSide_DEF; + ¬(D,G same_side b) by bd_line, point_off_line, notGb, Asim_bD, -, SameSideTransitive; + D ∉ ray C G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, ∉; + C ∈ open (D,G) [DCG] by GnotABCD, ABGcol, -, IN_Ray, ∉; + consider M such that + D ∈ open (C,M) [CDM] by TetraABCD, B2'; + D ∈ open (G,M) [GDM] by -, B1', DCG, TransitivityBetweennessHelp; + ∡ C D A suppl ∡ A D M ∧ ∡ A B C suppl ∡ C B G by TetraABCD, CDM, ABG, SupplementaryAngles_DEF; + ∡ M D A ≡ ∡ G B C [MDAeqGBC] by -, H2', SupplementsCongAnglesCong, AngleSymmetry; + ∡ G A D <_ang ∡ M D A ∧ ∡ G B C <_ang ∡ D C B by BCGncol, BGCncol, GDM, DCG, B1', EuclidPropositionI_16; + ∡ G A D <_ang ∡ D C B by -, BCGncol, ANGLE, MDAeqGBC, AngleTrichotomy2, AngleOrderTransitivity; + ∡ D A B <_ang ∡ B C D by -, rABrAG, Angle_DEF, AngleSymmetry; + qed by -, H2, AngleTrichotomy1; + A ∉ open (G,B) + proof + assume ¬(A ∉ open (G,B)); + A ∈ open (B,G) [BAG] by -, B1', ∉; + ray B A = ray B G [rBArBG] by -, IntervalRay; + ¬(B,G same_side d) by bd_line, BAG, SameSide_DEF; + ¬(C,G same_side d) by bd_line, point_off_line, notGb, Bsim_cA, -, SameSideTransitive; + C ∉ ray D G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, ∉; + D ∈ open (C,G) [CDG] by GnotABCD, ABGcol, -, IN_Ray, ∉; + consider M such that + C ∈ open (D,M) [DCM] by B2', TetraABCD; + C ∈ open (G,M) [GCM] by -, B1', CDG, TransitivityBetweennessHelp; + ∡ B C D suppl ∡ M C B ∧ ∡ D A B suppl ∡ G A D by TetraABCD, CollinearSymmetry, DCM, BAG, SupplementaryAngles_DEF, AngleSymmetry; + ∡ M C B ≡ ∡ G A D [GADeqMCB] by -, H2', SupplementsCongAnglesCong; + ∡ G B C <_ang ∡ M C B ∧ ∡ G A D <_ang ∡ C D A by BGCncol, GCM, BCGncol, CDG, B1', EuclidPropositionI_16; + ∡ G B C <_ang ∡ C D A by -, BCGncol, ANGLE, GADeqMCB, AngleTrichotomy2, AngleOrderTransitivity; + ∡ A B C <_ang ∡ C D A by -, rBArBG, Angle_DEF; + qed by -, H2, AngleTrichotomy1; + qed by TetraABCD, GnotABCD, ABGcol, notABG, notBGA, -, B3', ∉; +`;; + +let OppositeAnglesCongImpliesParallelogram = thm `; + let A B C D be point; + assume Quadrilateral A B C D [H1]; + assume ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D [H2]; + thus Parallelogram A B C D + + proof + Quadrilateral B C D A [QuadBCDA] by H1, QuadrilateralSymmetry; + ¬(A = B) ∧ ¬(B = C) ∧ ¬(C = D) ∧ ¬(D = A) ∧ ¬Collinear B C D ∧ ¬Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + ∡ B C D ≡ ∡ D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; + consider a such that + Line a ∧ A ∈ a ∧ B ∈ a [a_line] by TetraABCD, I1; + consider b such that + Line b ∧ B ∈ b ∧ C ∈ b [b_line] by TetraABCD, I1; + consider c such that + Line c ∧ C ∈ c ∧ D ∈ c [c_line] by TetraABCD, I1; + consider d such that + Line d ∧ D ∈ d ∧ A ∈ d [d_line] by TetraABCD, I1; + qed by H1, QuadBCDA, H2, H2', a_line, b_line, c_line, d_line, OppositeAnglesCongImpliesParallelogramHelp, Parallelogram_DEF; +`;; + + +let P = new_axiom + `∀ P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l`;; + +new_constant("μ",`:point_set->real`);; + +let AMa = new_axiom + `∀ α. Angle α ⇒ &0 < μ α ∧ μ α < &180`;; + +let AMb = new_axiom + `∀ α. Right α ⇒ μ α = &90`;; + +let AMc = new_axiom + `∀ α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β`;; + +let AMd = new_axiom + `∀ A O B P. P ∈ int_angle A O B ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B)`;; + + +let ConverseAlternateInteriorAngles = thm `; + let A B C E be point; + let l m t be point_set; + assume Line l ∧ A ∈ l ∧ E ∈ l [l_line]; + assume Line m ∧ B ∈ m ∧ C ∈ m [m_line]; + assume Line t ∧ A ∈ t ∧ B ∈ t [t_line]; + assume ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t [Distinct]; + assume ¬(C,E same_side t) [Cnsim_tE]; + assume l ∥ m [para_lm]; + thus ∡ E A B ≡ ∡ C B A + + proof + ¬Collinear C B A by t_line, Distinct, I1, Collinear_DEF, ∉, ANGLE; + A ∉ m ∧ Angle (∡ C B A) [notAm] by m_line, -, Collinear_DEF, ∉, ANGLE; + consider D such that + ¬(A = D) ∧ D ∉ t ∧ ¬(C,D same_side t) ∧ seg A D ≡ seg A E ∧ ∡ B A D ≡ ∡ C B A [Dexists] by -, Distinct, t_line, C4OppositeSide; + consider k such that + Line k ∧ A ∈ k ∧ D ∈ k [k_line] by Distinct, I1; + k ∥ m by -, m_line, t_line, Dexists, Distinct, AngleSymmetry, AlternateInteriorAngles; + k = l by m_line, notAm, l_line, k_line, -, para_lm, P; + D,E same_side t ∧ A ∉ open (D,E) ∧ Collinear A E D by t_line, Distinct, Dexists, Cnsim_tE, AtMost2Sides, SameSide_DEF, ∉, -, k_line, l_line, Collinear_DEF; + ray A D = ray A E by Distinct, -, IN_Ray, Dexists, IN_DELETE, RayWellDefined; + qed by -, Dexists, AngleSymmetry, Angle_DEF; +`;; + +let HilbertTriangleSum = thm `; + let A B C be point; + assume ¬Collinear A B C [ABCncol]; + thus ∃ E F. B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ + ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A + + proof + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear C A B [Distinct] by ABCncol, NonCollinearImpliesDistinct, CollinearSymmetry; + consider l such that + Line l ∧ A ∈ l ∧ C ∈ l [l_line] by Distinct, I1; + consider x such that + Line x ∧ A ∈ x ∧ B ∈ x [x_line] by Distinct, I1; + consider y such that + Line y ∧ B ∈ y ∧ C ∈ y [y_line] by Distinct, I1; + C ∉ x [notCx] by x_line, ABCncol, Collinear_DEF, ∉; + Angle (∡ C A B) by ABCncol, CollinearSymmetry, ANGLE; + consider E such that + ¬(B = E) ∧ E ∉ x ∧ ¬(C,E same_side x) ∧ seg B E ≡ seg A B ∧ ∡ A B E ≡ ∡ C A B [Eexists] by -, Distinct, x_line, notCx, C4OppositeSide; + consider m such that + Line m ∧ B ∈ m ∧ E ∈ m [m_line] by -, I1, IN_DELETE; + ∡ E B A ≡ ∡ C A B [EBAeqCAB] by Eexists, AngleSymmetry; + m ∥ l [para_lm] by m_line, l_line, x_line, Eexists, Distinct, notCx, -, AlternateInteriorAngles; + m ∩ l = ∅ [lm0] by -, PARALLEL; + C ∉ m ∧ A ∉ m [notACm] by -, l_line, INTER_COMM, DisjointOneNotOther; + consider F such that + B ∈ open (E,F) [EBF] by Eexists, B2'; + ¬(B = F) ∧ F ∈ m [EBF'] by -, B1', m_line, BetweenLinear; + ¬Collinear A B F ∧ F ∉ x [ABFncol] by m_line, -, I1, Collinear_DEF, notACm, ∉, x_line; + ¬(E,F same_side x) ∧ ¬(E,F same_side y) [Ensim_yF] by EBF, x_line, y_line, SameSide_DEF; + C,F same_side x [Csim_xF] by x_line, notCx, Eexists, ABFncol, Eexists, -, AtMost2Sides; + m ∩ open(C,A) = ∅ by l_line, BetweenLinear, SUBSET, SET_RULE, lm0, SUBSET_EMPTY; + C,A same_side m by m_line, -, SameSide_DEF, SET_RULE; + C ∈ int_angle A B F [CintABF] by ABFncol, x_line, m_line, EBF', notCx, notACm, Csim_xF, -, IN_InteriorAngle; + A ∈ int_angle C B E by EBF, B1', -, InteriorAngleSymmetry, InteriorReflectionInterior; + A ∉ y ∧ A,E same_side y [Asim_yE] by y_line, m_line, -, InteriorUse; + E ∉ y ∧ F ∉ y [notEFy] by y_line, m_line, EBF', Eexists, EBF', I1, Collinear_DEF, notACm, ∉; + E,A same_side y by y_line, -, Asim_yE, SameSideSymmetric; + ¬(A,F same_side y) [Ansim_yF] by y_line, notEFy, Asim_yE, -, Ensim_yF, SameSideTransitive; + ∡ F B C ≡ ∡ A C B by m_line, EBF', l_line, y_line, EBF', Distinct, notEFy, Asim_yE, Ansim_yF, para_lm, ConverseAlternateInteriorAngles; + qed by EBF, CintABF, EBAeqCAB, -, AngleSymmetry; +`;; + +let EuclidPropositionI_13 = thm `; + let A O B A' be point; + assume ¬Collinear A O B [H1]; + assume O ∈ open (A,A') [H2]; + thus μ (∡ A O B) + μ (∡ B O A') = &180 + + proof + cases; + suppose Right (∡ A O B); + Right (∡ B O A') ∧ μ (∡ A O B) = &90 ∧ μ (∡ B O A') = &90 by H1, H2, -, RightImpliesSupplRight, AMb; + qed by -, REAL_ARITH; + suppose ¬Right (∡ A O B) [notRightAOB]; + ¬(A = O) ∧ ¬(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; + consider l such that + Line l ∧ O ∈ l ∧ A ∈ l ∧ A' ∈ l [l_line] by -, I1, H2, BetweenLinear; + B ∉ l [notBl] by -, Distinct, I1, Collinear_DEF, H1, ∉; + consider F such that + Right (∡ O A F) ∧ Angle (∡ O A F) [RightOAF] by Distinct, EuclidPropositionI_11, RightImpliesAngle; + ∃! r. Ray r ∧ ∃ E. ¬(O = E) ∧ r = ray O E ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F by -, Distinct, l_line, notBl, C4; + consider E such that + ¬(O = E) ∧ E ∉ l ∧ E,B same_side l ∧ ∡ A O E ≡ ∡ O A F [Eexists] by -; + ¬Collinear A O E [AOEncol] by l_line, Distinct, I1, Collinear_DEF, -, ∉; + Right (∡ A O E) [RightAOE] by -, ANGLE, RightOAF, Eexists, CongRightImpliesRight; + Right (∡ E O A') ∧ μ (∡ A O E) = &90 ∧ μ (∡ E O A') = &90 [RightEOA'] by AOEncol, H2, -, RightImpliesSupplRight, AMb; + ¬(∡ A O B ≡ ∡ A O E) by notRightAOB, H1, ANGLE, RightAOE, CongRightImpliesRight; + ¬(∡ A O B = ∡ A O E) by H1, AOEncol, ANGLE, -, C5Reflexive; + ¬(ray O B = ray O E) by -, Angle_DEF; + B ∉ ray O E ∧ O ∉ open (B,E) by Distinct, -, Eexists, RayWellDefined, IN_DELETE, ∉, l_line, B1', SameSide_DEF; + ¬Collinear O E B by -, Eexists, IN_Ray, ∉; + E ∈ int_angle A O B ∨ B ∈ int_angle A O E by Distinct, l_line, Eexists, notBl, AngleOrdering, -, CollinearSymmetry, InteriorAngleSymmetry; + cases by -; + suppose E ∈ int_angle A O B [EintAOB]; + B ∈ int_angle E O A' by H2, -, InteriorReflectionInterior; + μ (∡ A O B) = μ (∡ A O E) + μ (∡ E O B) ∧ + μ (∡ E O A') = μ (∡ E O B) + μ (∡ B O A') by EintAOB, -, AMd; + qed by -, RightEOA', REAL_ARITH; + suppose B ∈ int_angle A O E [BintAOE]; + E ∈ int_angle B O A' by H2, -, InteriorReflectionInterior; + μ (∡ A O E) = μ (∡ A O B) + μ (∡ B O E) ∧ + μ (∡ B O A') = μ (∡ B O E) + μ (∡ E O A') by BintAOE, -, AMd; + qed by -, RightEOA', REAL_ARITH; + end; + end; +`;; + +let TriangleSum = thm `; + let A B C be point; + assume ¬Collinear A B C [ABCncol]; + thus μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 + + proof + ¬Collinear C A B ∧ ¬Collinear B C A [CABncol] by ABCncol, CollinearSymmetry; + consider E F such that + B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A [EBF] by ABCncol, HilbertTriangleSum; + ¬Collinear C B F ∧ ¬Collinear A B F ∧ Collinear E B F ∧ ¬(B = E) [CBFncol] by -, InteriorAngleSymmetry, InteriorEZHelp, IN_InteriorAngle, B1', CollinearSymmetry; + ¬Collinear E B A [EBAncol] by CollinearSymmetry, -, NoncollinearityExtendsToLine; + μ (∡ A B F) = μ (∡ A B C) + μ (∡ C B F) [μCintABF] by EBF, AMd; + μ (∡ E B A) + μ (∡ A B F) = &180 [suppl180] by EBAncol, EBF, EuclidPropositionI_13; + μ (∡ C A B) = μ (∡ E B A) ∧ μ (∡ B C A) = μ (∡ C B F) by CABncol, EBAncol, CBFncol, ANGLE, EBF, AMc; + qed by suppl180, μCintABF, -, REAL_ARITH; +`;; + diff --git a/RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml b/RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml new file mode 100644 index 0000000..e5a290e --- /dev/null +++ b/RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml @@ -0,0 +1,3421 @@ +(* ----------------------------------------------------------------- *) +(* HOL Light Hilbert geometry axiomatic proofs using miz3. *) +(* ----------------------------------------------------------------- *) + +(* High school students can learn rigorous axiomatic Geometry proofs, + as in http://www.math.northwestern.edu/~richter/hilbert.pdf, using + Hilbert's axioms, and code up their proofs in miz3 and HOL Light. + Thanks to Bjørn Jahren, Miguel Lerma,Takuo Matsuoka, Stephen + Wilson for advice on Hilbert's axioms, and especially Benjamin + Kordesh, who carefully read much of the paper and the code. + + Formal proofs are given for the first 7 sections of the paper, the + results cited there from Greenberg's book, and most of Euclid's + book I propositions up to Proposition I.29, following Hartshorne, + whose book seems the most exciting axiomatic geometry text. A + proof assistant is an valuable tool to help read it, as + Hartshorne's proofs are often sketchy and even have gaps. + + M. Greenberg, Euclidean and non-Euclidean geometries, W. H. Freeman and Co., 1974. + R. Hartshorne, Geometry, Euclid and Beyond, Undergraduate Texts in Math., Springer, 2000. + + Thanks to Mizar folks for their influential language, Freek + Wiedijk, who wrote the miz3 port of Mizar to HOL Light, and + especially John Harrison, who was extremely helpful and developed + the framework for porting my axiomatic proofs to HOL Light. *) + +verbose := false;; +report_timing := false;; + +horizon := 0;; +timeout := 150;; + +new_type("point",0);; +new_type_abbrev("point_set",`:point->bool`);; +new_constant("Between",`:point->point->point->bool`);; +new_constant("Line",`:point_set->bool`);; +new_constant("===",`:(point->bool)->(point->bool)->bool`);; + +parse_as_infix("cong",(12, "right"));; +parse_as_infix("same_side",(12, "right"));; +parse_as_infix("===",(12, "right"));; +parse_as_infix("<__",(12, "right"));; +parse_as_infix("<_ang",(12, "right"));; +parse_as_infix("suppl",(12, "right"));; +parse_as_infix("NOTIN",(11, "right"));; +parse_as_infix("parallel",(12, "right"));; + +let NOTIN = new_definition + `!a:A l:A->bool. a NOTIN l <=> ~(a IN l)`;; + +let Interval_DEF = new_definition + `! A B. open (A,B) = {X | Between A X B}`;; + +let Collinear_DEF = new_definition + `Collinear A B C <=> + ? l. Line l /\ A IN l /\ B IN l /\ C IN l`;; + +let SameSide_DEF = new_definition + `A,B same_side l <=> + Line l /\ ~ ? X. (X IN l) /\ X IN open (A,B)`;; + +let Ray_DEF = new_definition + `! A B. ray A B = {X | ~(A = B) /\ Collinear A B X /\ A NOTIN open (X,B)}`;; + +let Ordered_DEF = new_definition + `ordered A B C D <=> + B IN open (A,C) /\ B IN open (A,D) /\ C IN open (A,D) /\ C IN open (B,D)`;; + +let InteriorAngle_DEF = new_definition + `! A O B. int_angle A O B = + {P:point | ~Collinear A O B /\ ? a b. + Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ + P NOTIN a /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b}`;; + +let InteriorTriangle_DEF = new_definition + `! A B C. int_triangle A B C = + {P | P IN int_angle A B C /\ + P IN int_angle B C A /\ + P IN int_angle C A B}`;; + +let Tetralateral_DEF = new_definition + `Tetralateral A B C D <=> + ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ + ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B`;; + +let Quadrilateral_DEF = new_definition + `Quadrilateral A B C D <=> + Tetralateral A B C D /\ + open (A,B) INTER open (C,D) = {} /\ + open (B,C) INTER open (D,A) = {} `;; + +let ConvexQuad_DEF = new_definition + `ConvexQuadrilateral A B C D <=> + Quadrilateral A B C D /\ + A IN int_angle B C D /\ B IN int_angle C D A /\ C IN int_angle D A B /\ D IN int_angle A B C `;; + +let Segment_DEF = new_definition + `seg A B = {A, B} UNION open (A,B)`;; + +let SEGMENT = new_definition + `Segment s <=> ? A B. s = seg A B /\ ~(A = B)`;; + +let SegmentOrdering_DEF = new_definition + `s <__ t <=> + Segment s /\ + ? C D X. t = seg C D /\ X IN open (C,D) /\ s === seg C X`;; + +let Angle_DEF = new_definition + ` angle A O B = ray O A UNION ray O B `;; + +let ANGLE = new_definition + `Angle alpha <=> ? A O B. alpha = angle A O B /\ ~Collinear A O B`;; + +let AngleOrdering_DEF = new_definition + `alpha <_ang beta <=> + Angle alpha /\ + ? A O B G. ~Collinear A O B /\ beta = angle A O B /\ + G IN int_angle A O B /\ alpha === angle A O G`;; + +let RAY = new_definition + `Ray r <=> ? O A. ~(O = A) /\ r = ray O A`;; + +let TriangleCong_DEF = new_definition + `! A B C A' B' C' :point. (A, B, C) cong (A', B', C') <=> + ~Collinear A B C /\ ~Collinear A' B' C' /\ + seg A B === seg A' B' /\ seg A C === seg A' C' /\ seg B C === seg B' C' /\ + angle A B C === angle A' B' C' /\ + angle B C A === angle B' C' A' /\ + angle C A B === angle C' A' B'`;; + +let SupplementaryAngles_DEF = new_definition + `! alpha beta. alpha suppl beta <=> + ? A O B A'. ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ beta = angle B O A'`;; + +let RightAngle_DEF = new_definition + `! alpha. Right alpha <=> ? beta. alpha suppl beta /\ alpha === beta`;; + +let PlaneComplement_DEF = new_definition + `! alpha:point_set. complement alpha = {P | P NOTIN alpha}`;; + +let CONVEX = new_definition + `Convex alpha <=> ! A B. A IN alpha /\ B IN alpha ==> open (A,B) SUBSET alpha`;; + +let PARALLEL = new_definition + `! l k. l parallel k <=> + Line l /\ Line k /\ l INTER k = {}`;; + +let Parallelogram_DEF = new_definition + `! A B C D. Parallelogram A B C D <=> + Quadrilateral A B C D /\ ? a b c d. + Line a /\ A IN a /\ B IN a /\ + Line b /\ B IN b /\ C IN b /\ + Line c /\ C IN c /\ D IN d /\ + Line d /\ D IN d /\ A IN d /\ + a parallel c /\ b parallel d`;; + +let InteriorCircle_DEF = new_definition + `! O R. int_circle O R = {P | ~(O = R) /\ (P = O \/ seg O P <__ seg O R)} +`;; + + +(* ---------------------------------------------------------------------------- *) +(* Hilbert's geometry axioms, except the parallel axiom P, defined near the end. *) +(* ---------------------------------------------------------------------------- *) + + +let I1 = new_axiom + `! A B. ~(A = B) ==> ?! l. Line l /\ A IN l /\ B IN l`;; + +let I2 = new_axiom + `! l. Line l ==> ? A B. A IN l /\ B IN l /\ ~(A = B)`;; + +let I3 = new_axiom + `? A B C. ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ + ~Collinear A B C`;; + +let B1 = new_axiom + `! A B C. Between A B C ==> ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ + Between C B A /\ Collinear A B C`;; + +let B2 = new_axiom + `! A B. ~(A = B) ==> ? C. Between A B C`;; + +let B3 = new_axiom + `! A B C. ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C + ==> (Between A B C \/ Between B C A \/ Between C A B) /\ + ~(Between A B C /\ Between B C A) /\ + ~(Between A B C /\ Between C A B) /\ + ~(Between B C A /\ Between C A B)`;; + +let B4 = new_axiom + `! l A B C. Line l /\ ~Collinear A B C /\ + A NOTIN l /\ B NOTIN l /\ C NOTIN l /\ + (? X. X IN l /\ Between A X C) ==> + (? Y. Y IN l /\ Between A Y B) \/ (? Y. Y IN l /\ Between B Y C)`;; + +let C1 = new_axiom + `! s O Z. Segment s /\ ~(O = Z) ==> + ?! P. P IN ray O Z DELETE O /\ seg O P === s`;; + +let C2Reflexive = new_axiom + `Segment s ==> s === s`;; + +let C2Symmetric = new_axiom + `Segment s /\ Segment t /\ s === t ==> t === s`;; + +let C2Transitive = new_axiom + `Segment s /\ Segment t /\ Segment u /\ + s === t /\ t === u ==> s === u`;; + +let C3 = new_axiom + `! A B C A' B' C'. B IN open (A,C) /\ B' IN open (A',C') /\ + seg A B === seg A' B' /\ seg B C === seg B' C' ==> + seg A C === seg A' C'`;; + +let C4 = new_axiom + `! alpha O A l Y. Angle alpha /\ ~(O = A) /\ Line l /\ O IN l /\ A IN l /\ Y NOTIN l + ==> ?! r. Ray r /\ ? B. ~(O = B) /\ r = ray O B /\ + B NOTIN l /\ B,Y same_side l /\ angle A O B === alpha`;; + +let C5Reflexive = new_axiom + `Angle alpha ==> alpha === alpha`;; + +let C5Symmetric = new_axiom + `Angle alpha /\ Angle beta /\ alpha === beta ==> beta === alpha`;; + +let C5Transitive = new_axiom + `Angle alpha /\ Angle beta /\ Angle gamma /\ + alpha === beta /\ beta === gamma ==> alpha === gamma`;; + +let C6 = new_axiom + `! A B C A' B' C'. ~Collinear A B C /\ ~Collinear A' B' C' /\ + seg B A === seg B' A' /\ seg B C === seg B' C' /\ angle A B C === angle A' B' C' + ==> angle B C A === angle B' C' A'`;; + + +(* ----------------------------------------------------------------- *) +(* Theorems. *) +(* ----------------------------------------------------------------- *) + + +let IN_Interval = thm `; + ! A B X. X IN open (A,B) <=> Between A X B + by Interval_DEF, SET_RULE; +`;; + +let IN_Ray = thm `; + ! A B X. X IN ray A B <=> ~(A = B) /\ Collinear A B X /\ A NOTIN open (X,B) + by Ray_DEF, SET_RULE; +`;; + +let IN_InteriorAngle = thm `; + ! A O B P. P IN int_angle A O B <=> + ~Collinear A O B /\ ? a b. + Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ + P NOTIN a /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b + by InteriorAngle_DEF, SET_RULE; +`;; + +let IN_InteriorTriangle = thm `; + ! A B C P. P IN int_triangle A B C <=> + P IN int_angle A B C /\ P IN int_angle B C A /\ P IN int_angle C A B + by InteriorTriangle_DEF, SET_RULE; +`;; + +let IN_PlaneComplement = thm `; + ! alpha:point_set. ! P. P IN complement alpha <=> P NOTIN alpha + by PlaneComplement_DEF, SET_RULE; +`;; + +let IN_InteriorCircle = thm `; + ! O R P. P IN int_circle O R <=> + ~(O = R) /\ (P = O \/ seg O P <__ seg O R) + by InteriorCircle_DEF, SET_RULE; +`;; + +let B1' = thm `; + ! A B C. B IN open (A,C) ==> ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ + B IN open (C,A) /\ Collinear A B C + by IN_Interval, B1; +`;; + +let B2' = thm `; + ! A B. ~(A = B) ==> ? C. B IN open (A,C) + by IN_Interval, B2; +`;; + +let B3' = thm `; + ! A B C. ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C + ==> (B IN open (A,C) \/ C IN open (B,A) \/ A IN open (C,B)) /\ + ~(B IN open (A,C) /\ C IN open (B,A)) /\ + ~(B IN open (A,C) /\ A IN open (C,B)) /\ + ~(C IN open (B,A) /\ A IN open (C,B)) + by IN_Interval, B3; +`;; + +let B4' = thm `; + ! l A B C. Line l /\ ~Collinear A B C /\ + A NOTIN l /\ B NOTIN l /\ C NOTIN l /\ + (? X. X IN l /\ X IN open (A,C)) ==> + (? Y. Y IN l /\ Y IN open (A,B)) \/ (? Y. Y IN l /\ Y IN open (B,C)) + by IN_Interval, B4; +`;; + +let B4'' = thm `; + ! l:point_set. ! A B C:point. + Line l /\ ~Collinear A B C /\ A NOTIN l /\ B NOTIN l /\ C NOTIN l /\ + A,B same_side l /\ B,C same_side l ==> A,C same_side l + by B4', SameSide_DEF; +`;; + +let DisjointOneNotOther = thm `; + ! l m:A->bool. (! x:A. x IN m ==> x NOTIN l) <=> l INTER m = {} + by SET_RULE, NOTIN; +`;; + +let EquivIntersectionHelp = thm `; + ! e x:A. ! l m:A->bool. + (l INTER m = {x} \/ m INTER l = {x}) /\ e IN m DELETE x ==> e NOTIN l + by SET_RULE, NOTIN; +`;; + +let CollinearSymmetry = thm `; + let A B C be point; + assume Collinear A B C [H1]; + thus Collinear A C B /\ Collinear B A C /\ Collinear B C A /\ + Collinear C A B /\ Collinear C B A + + proof + consider l such that + Line l /\ A IN l /\ B IN l /\ C IN l by H1, Collinear_DEF; + qed by -, Collinear_DEF; +`;; + +let ExistsNewPointOnLine = thm `; + let P be point; + let l be point_set; + assume Line l /\ P IN l [H1]; + thus ? Q. Q IN l /\ ~(P = Q) + + proof + consider A B such that + A IN l /\ B IN l /\ ~(A = B) [l_line] by H1, I2; + cases; + suppose P = A; + qed by -, l_line; + suppose ~(P = A); + qed by -, l_line; + end; +`;; + +let ExistsPointOffLine = thm `; + let l be point_set; + assume Line l [H1]; + thus ? Q:point. Q NOTIN l + + proof + consider A B C such that + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~Collinear A B C [Distinct] by I3; + (A NOTIN l \/ B NOTIN l \/ C NOTIN l) \/ (A IN l /\ B IN l /\ C IN l) by NOTIN; + cases by -; + suppose A NOTIN l \/ B NOTIN l \/ C NOTIN l; + qed by -; + suppose (A IN l) /\ (B IN l) /\ (C IN l); + Collinear A B C by H1, -, Collinear_DEF; + qed by -, Distinct; + end; +`;; + +let BetweenLinear = thm `; + let A B C be point; + let m be point_set; + assume Line m /\ A IN m /\ C IN m [H1]; + assume B IN open (A,C) \/ C IN open (B,A) \/ A IN open (C,B) [H2]; + thus B IN m + + proof + ~(A = C) /\ + (Collinear A B C \/ Collinear B C A \/ Collinear C A B) [X1] by H2, B1'; + consider l such that + Line l /\ A IN l /\ B IN l /\ C IN l [X2] by -, Collinear_DEF; + l = m by X1, -, H2, H1, I1; + qed by -, X2; +`;; + +let CollinearLinear = thm `; + let A B C be point; + let m be point_set; + assume Line m /\ A IN m /\ C IN m [H1]; + assume Collinear A B C \/ Collinear B C A \/ Collinear C A B [H2]; + assume ~(A = C) [H3]; + thus B IN m + + proof + consider l such that + Line l /\ A IN l /\ B IN l /\ C IN l [X1] by H2, Collinear_DEF; + l = m by H3, -, H1, I1; + qed by -, X1; +`;; + +let NonCollinearImpliesDistinct = thm `; + let A B C be point; + assume ~Collinear A B C [H1]; + thus ~(A = B) /\ ~(A = C) /\ ~(B = C) + + proof + cases; + suppose A = B /\ B = C [Case1]; + consider Q such that + ~(Q = A) by I3; + qed by -, I1, Case1, Collinear_DEF, H1; + suppose (A = B /\ ~(A = C)) \/ (A = C /\ ~(A = B)) \/ (B = C /\ ~(A = B)); + qed by -, I1, Collinear_DEF, H1; + suppose ~(A = B) /\ ~(A = C) /\ ~(B = C); + qed by -; + end; +`;; + +let Reverse4Order = thm `; + ! A B C D:point. ordered A B C D ==> ordered D C B A + by Ordered_DEF, B1'; +`;; + +let OriginInRay = thm `; + let O Q be point; + assume ~(Q = O) [H1]; + thus O IN ray O Q + + proof + O NOTIN open (O,Q) [OOQ] by B1', NOTIN; + Collinear O Q O by H1, I1, Collinear_DEF; + qed by H1, -, OOQ, IN_Ray; +`;; + +let EndpointInRay = thm `; + let O Q be point; + assume ~(Q = O) [H1]; + thus Q IN ray O Q + + proof + O NOTIN open (Q,Q) [notOQQ] by B1', NOTIN; + Collinear O Q Q by H1, I1, Collinear_DEF; + qed by H1, -, notOQQ, IN_Ray; +`;; + +let I1Uniqueness = thm `; + let X be point; + let l m be point_set; + assume Line l /\ Line m [H0]; + assume ~(l = m) [H1]; + assume X IN l /\ X IN m [H2]; + thus l INTER m = {X} + + proof + assume ~(l INTER m = {X}) [H3]; + X IN l INTER m by H2, IN_INTER; + consider A such that + A IN l INTER m /\ ~(A = X) [X1] by -, H3, SET_RULE; + A IN l /\ X IN l /\ A IN m /\ X IN m by H0, -, H2, IN_INTER; + l = m by H0, -, X1, I1; + qed by -, H1; +`;; + +let EquivIntersection = thm `; + let A B X be point; + let l m be point_set; + assume Line l /\ Line m [H0]; + assume l INTER m = {X} [H1]; + assume A IN m DELETE X /\ B IN m DELETE X [H2]; + assume X NOTIN open (A,B) [H3]; + thus A,B same_side l + + proof + assume ~(A,B same_side l) [Con]; + A IN m /\ B IN m /\ ~(A = X) /\ ~(B = X) [H2'] by H2, IN_DELETE; + ~(open (A,B) INTER l = {}) [nonempty] by H0, Con, SameSide_DEF, SET_RULE; + open (A,B) SUBSET m [ABm] by H0, H2', BetweenLinear, SUBSET; + open (A,B) INTER l SUBSET {X} by -, SET_RULE, H1; + X IN open (A,B) INTER l by nonempty, -, SET_RULE; + qed by -, IN_INTER, H3, NOTIN; +`;; + +let RayLine = thm `; + ! O P:point. ! l: point_set. + Line l /\ O IN l /\ P IN l ==> ray O P SUBSET l + by IN_Ray, CollinearLinear, SUBSET; +`;; + +let RaySameSide = thm `; + let l be point_set; + let O A P be point; + assume Line l /\ O IN l [l_line]; + assume A NOTIN l [notAl]; + assume P IN ray O A DELETE O [PrOA]; + thus P NOTIN l /\ P,A same_side l + + proof + ~(O = A) [notOA] by l_line, notAl, NOTIN; + consider d such that + Line d /\ O IN d /\ A IN d [d_line] by notOA, I1; + ~(l = d) by -, notAl, NOTIN; + l INTER d = {O} [ldO] by l_line, d_line, -, I1Uniqueness; + A IN d DELETE O [Ad_O] by d_line, notOA, IN_DELETE; + ray O A SUBSET d by d_line, RayLine; + P IN d DELETE O [Pd_O] by PrOA, -, SUBSET, IN_DELETE; + P NOTIN l [notPl] by ldO, -, EquivIntersectionHelp; + O NOTIN open (P,A) by PrOA, IN_DELETE, IN_Ray; + P,A same_side l by l_line, d_line, ldO, Ad_O, Pd_O, -, EquivIntersection; + qed by notPl, -; +`;; + +let IntervalRayEZ = thm `; + let A B C be point; + assume B IN open (A,C) [H1]; + thus B IN ray A C DELETE A /\ C IN ray A B DELETE A + + proof + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C [ABC] by H1, B1'; + A NOTIN open (B,C) /\ A NOTIN open (C,B) by -, H1, B3', B1', NOTIN; + qed by ABC, CollinearSymmetry, -, IN_Ray, IN_DELETE, NOTIN; +`;; + +let NoncollinearityExtendsToLine = thm `; + let A O B X be point; + assume ~Collinear A O B [H1]; + assume Collinear O B X /\ ~(X = O) [H2]; + thus ~Collinear A O X + + proof + ~(A = O) /\ ~(A = B) /\ ~(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; + consider b such that + Line b /\ O IN b /\ B IN b [b_line] by Distinct, I1; + A NOTIN b [notAb] by b_line, Collinear_DEF, H1, NOTIN; + X IN b by H2, b_line, Distinct, I1, Collinear_DEF; + qed by b_line, -, H2, I1, Collinear_DEF, notAb, NOTIN; +`;; + +let SameSideReflexive = thm `; + ! l A. Line l /\ A NOTIN l ==> A,A same_side l + by B1', SameSide_DEF; +`;; + +let SameSideSymmetric = thm `; + ! l A B. Line l /\ A NOTIN l /\ B NOTIN l ==> + A,B same_side l ==> B,A same_side l + by SameSide_DEF, B1'; +`;; + +let SameSideTransitive = thm `; + let l be point_set; + let A B C be point; + assume Line l [l_line]; + assume A NOTIN l /\ B NOTIN l /\ C NOTIN l [notABCl]; + assume A,B same_side l [Asim_lB]; + assume B,C same_side l [Bsim_lC]; + thus A,C same_side l + + proof + cases; + suppose ~Collinear A B C \/ A = B \/ A = C \/ B = C; + qed by l_line, -, notABCl, Asim_lB, Bsim_lC, B4'', SameSideReflexive; + suppose Collinear A B C /\ ~(A = B) /\ ~(A = C) /\ ~(B = C) [Distinct]; + consider m such that + Line m /\ A IN m /\ C IN m [m_line] by Distinct, I1; + B IN m [Bm] by -, Distinct, CollinearLinear; + cases; + suppose m INTER l = {}; + qed by m_line, l_line, -, BetweenLinear, SET_RULE, SameSide_DEF; + suppose ~(m INTER l = {}); + consider X such that + X IN l /\ X IN m [Xlm] by -, MEMBER_NOT_EMPTY, IN_INTER; + Collinear A X B /\ Collinear B A C /\ Collinear A B C [ABXcol] by m_line, Bm, -, Collinear_DEF; + consider E such that + E IN l /\ ~(E = X) [El_X] by l_line, Xlm, ExistsNewPointOnLine; + ~Collinear E A X [EAXncol] by l_line, El_X, Xlm, I1, Collinear_DEF, notABCl, NOTIN; + consider B' such that + ~(B = E) /\ B IN open (E,B') [EBB'] by notABCl, El_X, NOTIN, B2'; + ~(B' = E) /\ ~(B' = B) /\ Collinear B E B' [EBB'col] by -, B1', CollinearSymmetry; + ~Collinear A B B' /\ ~Collinear B' B A /\ ~Collinear B' A B [ABB'ncol] by EAXncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry, -; + ~Collinear B' B C /\ ~Collinear B' A C /\ ~Collinear A B' C [AB'Cncol] by ABB'ncol, ABXcol, Distinct, NoncollinearityExtendsToLine, CollinearSymmetry; + B' IN ray E B DELETE E /\ B IN ray E B' DELETE E by EBB', IntervalRayEZ; + B' NOTIN l /\ B',B same_side l /\ B,B' same_side l [notB'l] by l_line, El_X, notABCl, -, RaySameSide; + A,B' same_side l /\ B',C same_side l by l_line, ABB'ncol, notABCl, notB'l, Asim_lB, -, B4'', AB'Cncol, Bsim_lC; + qed by l_line, AB'Cncol, notABCl, notB'l, -, B4''; + end; + end; +`;; + +let ConverseCrossbar = thm `; + let O A B G be point; + assume ~Collinear A O B [H1]; + assume G IN open (A,B) [H2]; + thus G IN int_angle A O B + + proof + ~(A = O) /\ ~(A = B) /\ ~(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; + consider a such that + Line a /\ O IN a /\ A IN a [a_line] by -, I1; + consider b such that + Line b /\ O IN b /\ B IN b [b_line] by Distinct, I1; + consider l such that + Line l /\ A IN l /\ B IN l [l_line] by Distinct, I1; + B NOTIN a /\ A NOTIN b by H1, a_line, Collinear_DEF, NOTIN, b_line; + ~(a = l) /\ ~(b = l) by -, l_line, NOTIN; + a INTER l = {A} /\ b INTER l = {B} [alA] by -, a_line, l_line, I1Uniqueness, b_line; + ~(A = G) /\ ~(A = B) /\ ~(G = B) [AGB] by H2, B1'; + A NOTIN open (G,B) /\ B NOTIN open (G,A) [notGAB] by H2, B3', B1', NOTIN; + G IN l [Gl] by l_line, H2, BetweenLinear; + G NOTIN a /\ G NOTIN b [notGa] by alA, Gl, AGB, IN_DELETE, EquivIntersectionHelp; + G IN l DELETE A /\ B IN l DELETE A /\ G IN l DELETE B /\ A IN l DELETE B by Gl, l_line, AGB, IN_DELETE; + G,B same_side a /\ G,A same_side b by a_line, l_line, alA, -, notGAB, EquivIntersection, b_line; + qed by H1, a_line, b_line, notGa, -, IN_InteriorAngle; +`;; + +let InteriorUse = thm `; + let A O B P be point; + let a b be point_set; + assume Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b [aOAbOB]; + assume P IN int_angle A O B [P_AOB]; + thus P NOTIN a /\ P NOTIN b /\ P,B same_side a /\ P,A same_side b + + proof + consider alpha beta such that ~Collinear A O B /\ + Line alpha /\ O IN alpha /\ A IN alpha /\ + Line beta /\ O IN beta /\B IN beta /\ + P NOTIN alpha /\ P NOTIN beta /\ + P,B same_side alpha /\ P,A same_side beta [exists] by P_AOB, IN_InteriorAngle; + ~(A = O) /\ ~(A = B) /\ ~(O = B) [Distinct] by -, NonCollinearImpliesDistinct; + alpha = a /\ beta = b by -, aOAbOB, exists, I1; + qed by -, exists; +`;; + +let InteriorEZHelp = thm `; + let A O B P be point; + assume P IN int_angle A O B [P_AOB]; + thus ~(P = A) /\ ~(P = O) /\ ~(P = B) /\ ~Collinear A O P + + proof + consider a b such that + ~Collinear A O B /\ + Line a /\ O IN a /\ A IN a /\ + Line b /\ O IN b /\B IN b /\ + P NOTIN a /\ P NOTIN b [def_int] by P_AOB, IN_InteriorAngle; + ~(P = A) /\ ~(P = O) /\ ~(P = B) [PnotAOB] by -, NOTIN; + ~(A = O) [notAO] by def_int, NonCollinearImpliesDistinct; + ~Collinear A O P by def_int, notAO, -, I1, Collinear_DEF, NOTIN; + qed by PnotAOB, -; +`;; + +let InteriorAngleSymmetry = thm `; + ! A O B P: point. P IN int_angle A O B ==> P IN int_angle B O A + by IN_InteriorAngle, CollinearSymmetry; +`;; + +let InteriorWellDefined = thm `; + let A O B X P be point; + assume P IN int_angle A O B [H1]; + assume X IN ray O B DELETE O [H2]; + thus P IN int_angle A O X + + proof + consider a b such that + ~Collinear A O B /\ + Line a /\ O IN a /\ A IN a /\ P NOTIN a /\ Line b /\ O IN b /\ B IN b /\ P NOTIN b /\ + P,B same_side a /\ P,A same_side b [def_int] by H1, IN_InteriorAngle; + ~(X = O) /\ ~(O = B) /\ Collinear O B X [H2'] by H2, IN_DELETE, IN_Ray; + B NOTIN a [notBa] by def_int, Collinear_DEF, NOTIN; + ~Collinear A O X [AOXnoncol] by def_int, H2', NoncollinearityExtendsToLine; + X IN b [Xb] by def_int, H2', CollinearLinear; + X NOTIN a /\ B,X same_side a by def_int, notBa, H2, RaySameSide, SameSideSymmetric; + P,X same_side a by def_int, -, notBa, SameSideTransitive; + qed by AOXnoncol, def_int, Xb, -, IN_InteriorAngle; +`;; + +let WholeRayInterior = thm `; + let A O B X P be point; + assume X IN int_angle A O B [XintAOB]; + assume P IN ray O X DELETE O [PrOX]; + thus P IN int_angle A O B + + proof + consider a b such that + ~Collinear A O B /\ + Line a /\ O IN a /\ A IN a /\ X NOTIN a /\ Line b /\ O IN b /\ B IN b /\ X NOTIN b /\ + X,B same_side a /\ X,A same_side b [def_int] by XintAOB, IN_InteriorAngle; + P NOTIN a /\ P,X same_side a /\ P NOTIN b /\ P,X same_side b [Psim_abX] by def_int, PrOX, RaySameSide; + P,B same_side a /\ P,A same_side b by -, def_int, Collinear_DEF, SameSideTransitive, NOTIN; + qed by def_int, Psim_abX, -, IN_InteriorAngle; +`;; + +let AngleOrdering = thm `; + let O A P Q be point; + let a be point_set; + assume ~(O = A) [H1]; + assume Line a /\ O IN a /\ A IN a [H2]; + assume P NOTIN a /\ Q NOTIN a [H3]; + assume P, Q same_side a [H4]; + assume ~Collinear P O Q [H5]; + thus P IN int_angle Q O A \/ Q IN int_angle P O A + + proof + ~(P = O) /\ ~(P = Q) /\ ~(O = Q) [Distinct] by H5, NonCollinearImpliesDistinct; + consider q such that + Line q /\ O IN q /\ Q IN q [q_line] by Distinct, I1; + P NOTIN q [notPq] by -, Collinear_DEF, H5, NOTIN; + assume ~(P IN int_angle Q O A) [notPintQOA]; + ~Collinear Q O A /\ ~Collinear P O A [POAncol] by H1, H2, I1, Collinear_DEF, H3, NOTIN; + ~(P,A same_side q) by -, H2, q_line, H3, notPq, H4, notPintQOA, IN_InteriorAngle; + consider G such that + G IN q /\ G IN open (P,A) [existG] by q_line, -, SameSide_DEF; + G IN int_angle P O A [G_POA] by POAncol, existG, ConverseCrossbar; + G NOTIN a /\ G,P same_side a /\ ~(G = O) [Gsim_aP] by -, IN_InteriorAngle, H1, H2, I1, NOTIN; + G,Q same_side a by H2, Gsim_aP, H3, H4, SameSideTransitive; + O NOTIN open (Q,G) [notQOG] by -, SameSide_DEF, H2, B1', NOTIN; + Collinear O G Q by q_line, existG, Collinear_DEF; + Q IN ray O G DELETE O by Gsim_aP, -, notQOG, IN_Ray, Distinct, IN_DELETE; + qed by G_POA, -, WholeRayInterior; +`;; + +let InteriorsDisjointSupplement = thm `; + let A O B A' be point; + assume ~Collinear A O B [H1]; + assume O IN open (A,A') [H2]; + thus int_angle B O A' INTER int_angle A O B = {} + + proof + ! D. D IN int_angle A O B ==> D NOTIN int_angle B O A' + proof + let D be point; + assume D IN int_angle A O B [H3]; + ~(A = O) /\ ~(O = B) by H1, NonCollinearImpliesDistinct; + consider a b such that + Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ A' IN a [ab_line] by -, I1, H2, BetweenLinear; + ~Collinear B O A' by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; + A NOTIN b /\ A' NOTIN b [notAb] by ab_line, Collinear_DEF, H1, -, NOTIN; + ~(A',A same_side b) [A'nsim_bA] by ab_line, H2, B1', SameSide_DEF ; + D NOTIN b /\ D,A same_side b [DintAOB] by ab_line, H3, InteriorUse; + ~(D,A' same_side b) by ab_line, notAb, DintAOB, A'nsim_bA, SameSideSymmetric, SameSideTransitive; + qed by ab_line, -, InteriorUse, NOTIN; + qed by -, DisjointOneNotOther; +`;; + +let InteriorReflectionInterior = thm `; + let A O B D A' be point; + assume O IN open (A,A') [H1]; + assume D IN int_angle A O B [H2]; + thus B IN int_angle D O A' + + proof + consider a b such that + ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ D NOTIN a /\ + Line b /\ O IN b /\ B IN b /\ D NOTIN b /\ D,B same_side a [DintAOB] by H2, IN_InteriorAngle; + ~(O = B) /\ ~(O = A') /\ B NOTIN a [Distinct] by -, NonCollinearImpliesDistinct, H1, B1', Collinear_DEF, NOTIN; + ~Collinear D O B [DOB_ncol] by DintAOB, -, I1, Collinear_DEF, NOTIN; + A' IN a [A'a] by H1, DintAOB, BetweenLinear; + D NOTIN int_angle B O A' by DintAOB, H1, InteriorsDisjointSupplement, H2, DisjointOneNotOther; + qed by Distinct, DintAOB, A'a, DOB_ncol, -, AngleOrdering, NOTIN; +`;; + +let Crossbar_THM = thm `; + let O A B D be point; + assume D IN int_angle A O B [H1]; + thus ? G. G IN open (A,B) /\ G IN ray O D DELETE O + + proof + consider a b such that + ~Collinear A O B /\ + Line a /\ O IN a /\ A IN a /\ + Line b /\ O IN b /\ B IN b /\ + D NOTIN a /\ D NOTIN b /\ D,B same_side a /\ D,A same_side b [DintAOB] by H1, IN_InteriorAngle; + B NOTIN a [notBa] by DintAOB, Collinear_DEF, NOTIN; + ~(A = O) /\ ~(A = B) /\ ~(O = B) /\ ~(D = O) [Distinct] by DintAOB, NonCollinearImpliesDistinct, NOTIN; + consider l such that + Line l /\ O IN l /\ D IN l [l_line] by -, I1; + consider A' such that + O IN open (A,A') [AOA'] by Distinct, B2'; + A' IN a /\ Collinear A O A' /\ ~(A' = O) [A'a] by DintAOB, -, BetweenLinear, B1'; + ~(A,A' same_side l) [Ansim_lA'] by l_line, AOA', SameSide_DEF; + B IN int_angle D O A' by H1, AOA', InteriorReflectionInterior; + B,A' same_side l [Bsim_lA'] by l_line, DintAOB, A'a, -, InteriorUse; + ~Collinear A O D /\ ~Collinear B O D [AODncol] by H1, InteriorEZHelp, InteriorAngleSymmetry; + ~Collinear D O A' by -, CollinearSymmetry, A'a, NoncollinearityExtendsToLine; + A NOTIN l /\ B NOTIN l /\ A' NOTIN l by l_line, Collinear_DEF, AODncol, -, NOTIN; + ~(A,B same_side l) by l_line, -, Bsim_lA', Ansim_lA', SameSideTransitive; + consider G such that + G IN open (A,B) /\ G IN l [AGB] by l_line, -, SameSide_DEF; + Collinear O D G [ODGcol] by -, l_line, Collinear_DEF; + G IN int_angle A O B by DintAOB, AGB, ConverseCrossbar; + G NOTIN a /\ G,B same_side a /\ ~(G = O) [Gsim_aB] by DintAOB, -, InteriorUse, NOTIN; + B,D same_side a by DintAOB, notBa, SameSideSymmetric; + G,D same_side a [Gsim_aD] by DintAOB, Gsim_aB, notBa, -, SameSideTransitive; + O NOTIN open (G,D) by DintAOB, -, SameSide_DEF, NOTIN; + G IN ray O D DELETE O by Distinct, ODGcol, -, IN_Ray, Gsim_aB, IN_DELETE; + qed by AGB, -; +`;; + +let AlternateConverseCrossbar = thm `; + let O A B G be point; + assume Collinear A G B /\ G IN int_angle A O B [H1]; + thus G IN open (A,B) + + proof + consider a b such that + ~Collinear A O B /\ Line a /\ O IN a /\ A IN a /\ Line b /\ O IN b /\ B IN b /\ + G,B same_side a /\ G,A same_side b [GintAOB] by H1, IN_InteriorAngle; + ~(A = B) /\ ~(G = A) /\ ~(G = B) /\ A NOTIN open (G,B) /\ B NOTIN open (G,A) by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SameSide_DEF, NOTIN; + qed by -, H1, B1', B3', NOTIN; +`;; + +let InteriorOpposite = thm `; + let A O B P be point; + let p be point_set; + assume P IN int_angle A O B [PintAOB]; + assume Line p /\ O IN p /\ P IN p [p_line]; + thus ~(A,B same_side p) + + proof + consider G such that + G IN open (A,B) /\ G IN ray O P [Gexists] by PintAOB, Crossbar_THM, IN_DELETE; + G IN p by p_line, RayLine, -, SUBSET; + qed by p_line, -, Gexists, SameSide_DEF; +`;; + +let IntervalTransitivity = thm `; + let O P Q R be point; + let m be point_set; + assume Line m /\ O IN m [H0]; + assume P IN m DELETE O /\ Q IN m DELETE O /\ R IN m DELETE O [H2]; + assume O NOTIN open (P,Q) /\ O NOTIN open (Q,R) [H3]; + thus O NOTIN open (P,R) + + proof + consider E such that + E NOTIN m /\ ~(O = E) [notEm] by H0, ExistsPointOffLine, NOTIN; + consider l such that + Line l /\ O IN l /\ E IN l [l_line] by -, I1; + ~(m = l) by notEm, -, NOTIN; + l INTER m = {O} [lmO] by l_line, H0, -, l_line, I1Uniqueness; + P NOTIN l /\ Q NOTIN l /\ R NOTIN l [notPQRl] by -, H2, EquivIntersectionHelp; + P,Q same_side l /\ Q,R same_side l by l_line, H0, lmO, H2, H3, EquivIntersection; + P,R same_side l [Psim_lR] by l_line, notPQRl, -, SameSideTransitive; + qed by l_line, -, SameSide_DEF, NOTIN; +`;; + +let RayWellDefinedHalfway = thm `; + let O P Q be point; + assume ~(Q = O) [H1]; + assume P IN ray O Q DELETE O [H2]; + thus ray O P SUBSET ray O Q + + proof + consider m such that + Line m /\ O IN m /\ Q IN m [OQm] by H1, I1; + P IN ray O Q /\ ~(P = O) /\ O NOTIN open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; + P IN m /\ P IN m DELETE O /\ Q IN m DELETE O [PQm_O] by OQm, H2', RayLine, SUBSET, H2', OQm, H1, IN_DELETE; + O NOTIN open (P,Q) [notPOQ] by H2', IN_Ray; + ! X. X IN ray O P ==> X IN ray O Q + proof + let X be point; + assume X IN ray O P; + X IN m /\ O NOTIN open (X,P) [XrOP] by OQm, PQm_O, H2', -, RayLine, SUBSET, IN_Ray; + Collinear O Q X [OQXcol] by OQm, -, Collinear_DEF; + cases; + suppose X = O; + qed by H1, -, OriginInRay; + suppose ~(X = O); + X IN m DELETE O by XrOP, -, IN_DELETE; + O NOTIN open (X,Q) by OQm, -, PQm_O, XrOP, H2', IntervalTransitivity; + qed by H1, OQXcol, -, IN_Ray; + end; + qed by -, SUBSET; +`;; + +let RayWellDefined = thm `; + let O P Q be point; + assume ~(Q = O) [H1]; + assume P IN ray O Q DELETE O [H2]; + thus ray O P = ray O Q + + proof + ray O P SUBSET ray O Q [PsubsetQ] by H1, H2, RayWellDefinedHalfway; + ~(P = O) /\ Collinear O Q P /\ O NOTIN open (P,Q) [H2'] by H2, IN_DELETE, IN_Ray; + Q IN ray O P DELETE O by H2', B1', NOTIN, CollinearSymmetry, IN_Ray, H1, IN_DELETE; + ray O Q SUBSET ray O P [QsubsetP] by H2', -, RayWellDefinedHalfway; + qed by PsubsetQ, QsubsetP, SUBSET_ANTISYM; +`;; + +let OppositeRaysIntersect1pointHelp = thm `; + let A O B X be point; + assume O IN open (A,B) [H1]; + assume X IN ray O B DELETE O [H2]; + thus X NOTIN ray O A /\ O IN open (X,A) + + proof + ~(A = O) /\ ~(A = B) /\ ~(O = B) /\ Collinear A O B [AOB] by H1, B1'; + ~(X = O) /\ Collinear O B X /\ O NOTIN open (X,B) [H2'] by H2, IN_DELETE, IN_Ray; + consider m such that + Line m /\ A IN m /\ B IN m [m_line] by AOB, I1; + O IN m /\ X IN m [Om] by m_line, H2', AOB, CollinearLinear; + A IN m DELETE O /\ X IN m DELETE O /\ B IN m DELETE O by m_line, -, H2', AOB, IN_DELETE; + O IN open (X,A) by H1, m_line, Om, -, H2', IntervalTransitivity, NOTIN, B1'; + qed by -, IN_Ray, NOTIN; +`;; + +let OppositeRaysIntersect1point = thm `; + let A O B be point; + assume O IN open (A,B) [H1]; + thus ray O A INTER ray O B = {O} + + proof + ~(A = O) /\ ~(O = B) by H1, B1'; + {O} SUBSET ray O A INTER ray O B [Osubset_rOA] by -, OriginInRay, IN_INTER, SING_SUBSET; + ! X. ~(X = O) /\ X IN ray O B ==> X NOTIN ray O A + by IN_DELETE, H1, OppositeRaysIntersect1pointHelp; + ray O A INTER ray O B SUBSET {O} by -, IN_INTER, IN_SING, SUBSET, NOTIN; + qed by -, Osubset_rOA, SUBSET_ANTISYM; +`;; + +let IntervalRay = thm `; + ! A B C:point. B IN open (A,C) ==> ray A B = ray A C + by B1', IntervalRayEZ, RayWellDefined; +`;; + +let TransitivityBetweennessHelp = thm `; + let A B C D be point; + assume B IN open (A,C) /\ C IN open (B,D) [H1]; + thus B IN open (A,D) + + proof + D IN ray B C DELETE B by H1, IntervalRayEZ; + qed by H1, -, OppositeRaysIntersect1pointHelp, B1'; +`;; + +let TransitivityBetweenness = thm `; + let A B C D be point; + assume B IN open (A,C) /\ C IN open (B,D) [H1]; + thus ordered A B C D + + proof + B IN open (A,D) [ABD] by H1, TransitivityBetweennessHelp; + C IN open (D,B) /\ B IN open (C,A) by H1, B1'; + C IN open (D,A) by -, TransitivityBetweennessHelp; + qed by H1, ABD, -, B1', Ordered_DEF; +`;; + +let IntervalsAreConvex = thm `; + let A B C be point; + assume B IN open (A,C) [H1]; + thus open (A,B) SUBSET open (A,C) + + proof + ! X. X IN open (A,B) ==> X IN open (A,C) + proof + let X be point; + assume X IN open (A,B) [AXB]; + X IN ray B A DELETE B by AXB, B1', IntervalRayEZ; + B IN open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; + qed by AXB, -, TransitivityBetweennessHelp; + qed by -, SUBSET; +`;; + +let TransitivityBetweennessVariant = thm `; + let A X B C be point; + assume X IN open (A,B) /\ B IN open (A,C) [H1]; + thus ordered A X B C + + proof + X IN ray B A DELETE B by H1, B1', IntervalRayEZ; + B IN open (X,C) by H1, B1', -, OppositeRaysIntersect1pointHelp; + qed by H1, -, TransitivityBetweenness; +`;; + +let Interval2sides2aLineHelp = thm `; + let A B C X be point; + assume B IN open (A,C) [H1]; + thus X NOTIN open (A,B) \/ X NOTIN open (B,C) + + proof + assume ~(X NOTIN open (A,B)); + ordered A X B C by -, NOTIN, H1, TransitivityBetweennessVariant; + B IN open (X,C) by -, Ordered_DEF; + X NOTIN open (C,B) by -, B1', B3', NOTIN; + qed by -, B1', NOTIN; +`;; + +let Interval2sides2aLine = thm `; + let A B C X be point; + assume Collinear A B C [H1]; + thus X NOTIN open (A,B) \/ X NOTIN open (A,C) \/ X NOTIN open (B,C) + + proof + cases; + suppose A = B \/ A = C \/ B = C; + qed by -, B1', NOTIN; + suppose ~(A = B) /\ ~(A = C) /\ ~(B = C); + B IN open (A,C) \/ C IN open (B,A) \/ A IN open (C,B) by -, H1, B3'; + qed by -, Interval2sides2aLineHelp, B1', NOTIN; + end; +`;; + +let TwosidesTriangle2aLine = thm `; + let A B C Y be point; + let l m be point_set; + assume Line l /\ ~Collinear A B C [H1]; + assume A NOTIN l /\ B NOTIN l /\ C NOTIN l [off_l]; + assume Line m /\ A IN m /\ C IN m [m_line]; + assume Y IN l /\ Y IN m [Ylm]; + assume ~(A,B same_side l) /\ ~(B,C same_side l) [H2]; + thus A,C same_side l + + proof + consider X Z such that + X IN l /\ X IN open (A,B) /\ Z IN l /\ Z IN open (C,B) [H2'] by H1, H2, SameSide_DEF, B1'; + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Y IN m DELETE A /\ Y IN m DELETE C /\ C IN m DELETE A /\ A IN m DELETE C [Distinct] by H1, NonCollinearImpliesDistinct, Ylm, off_l, NOTIN, m_line, IN_DELETE; + consider p such that + Line p /\ B IN p /\ A IN p [p_line] by Distinct, I1; + consider q such that + Line q /\ B IN q /\ C IN q [q_line] by Distinct, I1; + X IN p /\ Z IN q [Xp] by p_line, H2', BetweenLinear, q_line, H2'; + A NOTIN q /\ B NOTIN m /\ C NOTIN p [vertex_off_line] by q_line, m_line, p_line, H1, Collinear_DEF, NOTIN; + X NOTIN q /\ X,A same_side q /\ Z NOTIN p /\ Z,C same_side p [Xsim_qA] by q_line, p_line, -, H2', B1', IntervalRayEZ, RaySameSide; + ~(m = p) /\ ~(m = q) by m_line, vertex_off_line, NOTIN; + p INTER m = {A} /\ q INTER m = {C} [pmA] by p_line, m_line, q_line, H1, -, Xp, H2', I1Uniqueness; + Y NOTIN p /\ Y NOTIN q [notYpq] by -, Distinct, EquivIntersectionHelp; + X IN ray A B DELETE A /\ Z IN ray C B DELETE C by H2', IntervalRayEZ, H2', B1'; + X NOTIN m /\ Z NOTIN m /\ X,B same_side m /\ B,Z same_side m [notXZm] by m_line, vertex_off_line, -, RaySameSide, SameSideSymmetric; + X,Z same_side m by m_line, -, vertex_off_line, SameSideTransitive; + Collinear X Y Z /\ Y NOTIN open (X,Z) /\ ~(Y = X) /\ ~(Y = Z) /\ ~(X = Z) by H1, H2', Ylm, Collinear_DEF, m_line, -, SameSide_DEF, notXZm, Xsim_qA, Xp, NOTIN; + Z IN open (X,Y) \/ X IN open (Z,Y) by -, B3', NOTIN, B1'; + cases by -; + suppose X IN open (Z,Y); + ~(Z,Y same_side p) by p_line, Xp, -, SameSide_DEF; + ~(C,Y same_side p) by p_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; + A IN open (C,Y) by p_line, m_line, pmA, Distinct, -, EquivIntersection, NOTIN; + qed by H1, Ylm, off_l, -, B1', IntervalRayEZ, RaySameSide; + suppose Z IN open (X,Y); + ~(X,Y same_side q) by q_line, Xp, -, SameSide_DEF; + ~(A,Y same_side q) by q_line, Xsim_qA, vertex_off_line, notYpq, -, SameSideTransitive; + C IN open (Y,A) by q_line, m_line, pmA, Distinct, -, EquivIntersection, NOTIN, B1'; + qed by H1, Ylm, off_l, -, IntervalRayEZ, RaySameSide; + end; +`;; + +let LineUnionOf2Rays = thm `; + let A O B be point; + let l be point_set; + assume Line l /\ A IN l /\ B IN l [H1]; + assume O IN open (A,B) [H2]; + thus l = ray O A UNION ray O B + + proof + ~(A = O) /\ ~(O = B) /\ O IN l [Distinct] by H2, B1', H1, BetweenLinear; + ray O A UNION ray O B SUBSET l [AOBsub_l] by H1, -, RayLine, UNION_SUBSET; + ! X. X IN l ==> X IN ray O A \/ X IN ray O B + proof + let X be point; + assume X IN l [Xl]; + assume ~(X IN ray O B) [notXrOB]; + Collinear O B X /\ Collinear X A B /\ Collinear O A X [XABcol] by Distinct, H1, Xl, Collinear_DEF; + O IN open (X,B) by notXrOB, Distinct, -, IN_Ray, NOTIN; + O NOTIN open (X,A) by NOTIN, B1', XABcol, -, H2, Interval2sides2aLine; + qed by Distinct, XABcol, -, IN_Ray; + l SUBSET ray O A UNION ray O B by -, IN_UNION, SUBSET; + qed by -, AOBsub_l, SUBSET_ANTISYM; +`;; + +let AtMost2Sides = thm `; + let A B C be point; + let l be point_set; + assume Line l [H1]; + assume A NOTIN l /\ B NOTIN l /\ C NOTIN l [H2]; + thus A,B same_side l \/ A,C same_side l \/ B,C same_side l + + proof + cases; + suppose A = C; + qed by -, H1, H2, SameSideReflexive; + suppose ~(A = C) [notAC]; + consider m such that + Line m /\ A IN m /\ C IN m [m_line] by notAC, I1; + cases; + suppose m INTER l = {}; + A,C same_side l by m_line, H1, -, BetweenLinear, SET_RULE, SameSide_DEF; + qed by -; + suppose ~(m INTER l = {}); + consider Y such that + Y IN l /\ Y IN m [Ylm] by -, IN_INTER, MEMBER_NOT_EMPTY; + cases; + suppose ~Collinear A B C; + qed by H1, -, H2, m_line, Ylm, TwosidesTriangle2aLine; + suppose Collinear A B C [ABCcol]; + B IN m [Bm] by -, m_line, notAC, I1, Collinear_DEF; + ~(Y = A) /\ ~(Y = B) /\ ~(Y = C) [YnotABC] by Ylm, H2, NOTIN; + Y NOTIN open (A,B) \/ Y NOTIN open (A,C) \/ Y NOTIN open (B,C) by ABCcol, Interval2sides2aLine; + A IN ray Y B DELETE Y \/ A IN ray Y C DELETE Y \/ B IN ray Y C DELETE Y by YnotABC, m_line, Bm, Ylm, Collinear_DEF, -, IN_Ray, IN_DELETE; + qed by H1, Ylm, H2, -, RaySameSide; + end; + end; + end; +`;; + +let FourPointsOrder = thm `; + let A B C X be point; + let l be point_set; + assume Line l /\ A IN l /\ B IN l /\ C IN l /\ X IN l [H1]; + assume ~(X = A) /\ ~(X = B) /\ ~(X = C) [H2]; + assume B IN open (A,C) [H3]; + thus ordered X A B C \/ ordered A X B C \/ + ordered A B X C \/ ordered A B C X + + proof + A IN open (X,B) \/ X IN open (A,B) \/ X IN open (B,C) \/ C IN open (B,X) + proof + ~(A = B) /\ ~(B = C) [ABCdistinct] by H3, B1'; + Collinear A B X /\ Collinear A C X /\ Collinear C B X [ACXcol] by H1, Collinear_DEF; + A IN open (X,B) \/ X IN open (A,B) \/ B IN open (A,X) by H2, ABCdistinct, -, B3', B1'; + cases by -; + suppose A IN open (X,B) \/ X IN open (A,B); + qed by -; + suppose B IN open (A,X); + B NOTIN open (C,X) by ACXcol, H3, -, Interval2sides2aLine, NOTIN; + qed by H2, ABCdistinct, ACXcol, -, B3', B1', NOTIN; + end; + qed by -, H3, B1', TransitivityBetweenness, TransitivityBetweennessVariant, Reverse4Order; +`;; + +let HilbertAxiomRedundantByMoore = thm `; + let A B C D be point; + let l be point_set; + assume Line l /\ A IN l /\ B IN l /\ C IN l /\ D IN l [H1]; + assume ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) [H2]; + thus ordered D A B C \/ ordered A D B C \/ ordered A B D C \/ ordered A B C D \/ + ordered D A C B \/ ordered A D C B \/ ordered A C D B \/ ordered A C B D \/ + ordered D C A B \/ ordered C D A B \/ ordered C A D B \/ ordered C A B D + + proof + Collinear A B C by H1, Collinear_DEF; + B IN open (A,C) \/ C IN open (A,B) \/ A IN open (C,B) by H2, -, B3', B1'; + qed by -, H1, H2, FourPointsOrder; +`;; + +let InteriorTransitivity = thm `; + let A O B F G be point; + assume G IN int_angle A O B [GintAOB]; + assume F IN int_angle A O G [FintAOG]; + thus F IN int_angle A O B + + proof + ~Collinear A O B [AOBncol] by GintAOB, IN_InteriorAngle; + consider G' such that + G' IN open (A,B) /\ G' IN ray O G DELETE O [CrossG] by GintAOB, Crossbar_THM; + F IN int_angle A O G' by FintAOG, -, InteriorWellDefined; + consider F' such that + F' IN open (A,G') /\ F' IN ray O F DELETE O [CrossF] by -, Crossbar_THM; + ~(F' = O) /\ ~(F = O) /\ Collinear O F F' /\ O NOTIN open (F',F) by -, IN_DELETE, IN_Ray; + F IN ray O F' DELETE O [FrOF'] by -, CollinearSymmetry, B1', NOTIN, IN_Ray, IN_DELETE; + open (A,G') SUBSET open (A,B) /\ F' IN open (A,B) by CrossG, IntervalsAreConvex, CrossF, SUBSET; + F' IN int_angle A O B by AOBncol, -, ConverseCrossbar; + qed by -, FrOF', WholeRayInterior; +`;; + +let HalfPlaneConvexNonempty = thm `; + let l H be point_set; + let A be point; + assume Line l /\ A NOTIN l [l_line]; + assume H = {X | X NOTIN l /\ X,A same_side l} [HalfPlane]; + thus ~(H = {}) /\ H SUBSET complement l /\ Convex H + + proof + ! X. X IN H <=> X NOTIN l /\ X,A same_side l [Hdef] by HalfPlane, SET_RULE; + H SUBSET complement l [Hsub] by -, IN_PlaneComplement, SUBSET; + A,A same_side l /\ A IN H by l_line, SameSideReflexive, Hdef; + ~(H = {}) [Hnonempty] by -, MEMBER_NOT_EMPTY; + ! P Q X. P IN H /\ Q IN H /\ X IN open (P,Q) ==> X IN H + proof + let P Q X be point; + assume P IN H /\ Q IN H /\ X IN open (P,Q) [PXQ]; + P NOTIN l /\ P,A same_side l /\ Q NOTIN l /\ Q,A same_side l [PQinH] by -, Hdef; + P,Q same_side l [Psim_lQ] by l_line, -, SameSideSymmetric, SameSideTransitive; + X NOTIN l [notXl] by -, PXQ, SameSide_DEF, NOTIN; + open (X,P) SUBSET open (P,Q) by PXQ, IntervalsAreConvex, B1', SUBSET; + X,P same_side l by l_line, -, SUBSET, Psim_lQ, SameSide_DEF; + X,A same_side l by l_line, notXl, PQinH, -, Psim_lQ, PQinH, SameSideTransitive; + qed by -, notXl, Hdef; + Convex H by -, SUBSET, CONVEX; + qed by Hnonempty, Hsub, -; +`;; + +let PlaneSeparation = thm `; + let l be point_set; + assume Line l [l_line]; + thus ? H1 H2:point_set. H1 INTER H2 = {} /\ ~(H1 = {}) /\ ~(H2 = {}) /\ + Convex H1 /\ Convex H2 /\ complement l = H1 UNION H2 /\ + ! P Q. P IN H1 /\ Q IN H2 ==> ~(P,Q same_side l) + + proof + consider A such that + A NOTIN l [notAl] by l_line, ExistsPointOffLine; + consider E such that + E IN l /\ ~(A = E) [El] by l_line, I2, -, NOTIN; + consider B such that + E IN open (A,B) /\ ~(E = B) /\ Collinear A E B [AEB] by -, B2', B1'; + B NOTIN l [notBl] by l_line, El, -, I1, Collinear_DEF, notAl, NOTIN; + ~(A,B same_side l) [Ansim_lB] by l_line, El, AEB, SameSide_DEF; + consider H1 H2 such that + H1 = {X | X NOTIN l /\ X,A same_side l} /\ H2 = {X | X NOTIN l /\ X,B same_side l} [H12sets]; + ! X. (X IN H1 <=> X NOTIN l /\ X,A same_side l) /\ (X IN H2 <=> X NOTIN l /\ X,B same_side l) [H12def] by -, SET_RULE; + ! X. X IN H1 <=> X NOTIN l /\ X,A same_side l [H1def] by H12sets, SET_RULE; + ! X. X IN H2 <=> X NOTIN l /\ X,B same_side l [H2def] by H12sets, SET_RULE; + H1 INTER H2 = {} [H12disjoint] + proof + assume ~(H1 INTER H2 = {}); + consider V such that + V IN H1 /\ V IN H2 by -, MEMBER_NOT_EMPTY, IN_INTER; + V NOTIN l /\ V,A same_side l /\ V NOTIN l /\ V,B same_side l by -, H12def; + A,B same_side l by l_line, -, notAl, notBl, SameSideSymmetric, SameSideTransitive; + qed by -, Ansim_lB; + ~(H1 = {}) /\ ~(H2 = {}) /\ H1 SUBSET complement l /\ H2 SUBSET complement l /\ Convex H1 /\ Convex H2 [H12convex_nonempty] by l_line, notAl, notBl, H12sets, HalfPlaneConvexNonempty; + H1 UNION H2 SUBSET complement l [H12sub] by H12convex_nonempty, UNION_SUBSET; + ! C. C IN complement l ==> C IN H1 UNION H2 + proof + let C be point; + assume C IN complement l; + C NOTIN l [notCl] by -, IN_PlaneComplement; + C,A same_side l \/ C,B same_side l by l_line, notAl, notBl, -, Ansim_lB, AtMost2Sides; + C IN H1 \/ C IN H2 by notCl, -, H12def; + qed by -, IN_UNION; + complement l SUBSET H1 UNION H2 by -, SUBSET; + complement l = H1 UNION H2 [compl_H1unionH2] by H12sub, -, SUBSET_ANTISYM; + ! P Q. P IN H1 /\ Q IN H2 ==> ~(P,Q same_side l) [opp_sides] + proof + let P Q be point; + assume P IN H1 /\ Q IN H2; + P NOTIN l /\ P,A same_side l /\ Q NOTIN l /\ Q,B same_side l [PH1_QH2] by -, H12def, IN; + qed by l_line, -, notAl, SameSideSymmetric, notBl, Ansim_lB, SameSideTransitive; + qed by H12disjoint, H12convex_nonempty, compl_H1unionH2, opp_sides; +`;; + +let TetralateralSymmetry = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + thus Tetralateral B C D A /\ Tetralateral A B D C + + proof + ~Collinear A B D /\ ~Collinear B D C /\ ~Collinear D C A /\ ~Collinear C A B [TetraABCD] by H1, Tetralateral_DEF, CollinearSymmetry; + qed by H1, -, Tetralateral_DEF; +`;; + +let EasyEmptyIntersectionsTetralateralHelp = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + thus open (A,B) INTER open (B,C) = {} + + proof + ! X. X IN open (B,C) ==> X NOTIN open (A,B) + proof + let X be point; + assume X IN open (B,C); + ~Collinear A B C /\ Collinear B X C /\ ~(X = B) by H1, Tetralateral_DEF, -, B1'; + ~Collinear A X B by -, CollinearSymmetry, B1', NoncollinearityExtendsToLine; + qed by -, B1', NOTIN; + qed by -, DisjointOneNotOther; +`;; + +let EasyEmptyIntersectionsTetralateral = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + thus open (A,B) INTER open (B,C) = {} /\ open (B,C) INTER open (C,D) = {} /\ + open (C,D) INTER open (D,A) = {} /\ open (D,A) INTER open (A,B) = {} + + proof + Tetralateral B C D A /\ Tetralateral C D A B /\ Tetralateral D A B C by H1, TetralateralSymmetry; + qed by H1, -, EasyEmptyIntersectionsTetralateralHelp; +`;; + +let SegmentSameSideOppositeLine = thm `; + let A B C D be point; + let a c be point_set; + assume Quadrilateral A B C D [H1]; + assume Line a /\ A IN a /\ B IN a [a_line]; + assume Line c /\ C IN c /\ D IN c [c_line]; + thus A,B same_side c \/ C,D same_side a + + proof + assume ~(C,D same_side a); :: prove A,B same_side c + consider G such that + G IN a /\ G IN open (C,D) [CGD] by -, a_line, SameSide_DEF; + G IN c /\ Collinear G B A [Gc] by c_line, -, BetweenLinear, a_line, Collinear_DEF; + ~Collinear B C D /\ ~Collinear C D A /\ open (A,B) INTER open (C,D) = {} [quadABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + A NOTIN c /\ B NOTIN c /\ ~(A = G) /\ ~(B = G) [Distinct] by -, c_line, Collinear_DEF, NOTIN, Gc; + G NOTIN open (A,B) by quadABCD, CGD, DisjointOneNotOther; + A IN ray G B DELETE G by Distinct, Gc, -, IN_Ray, IN_DELETE; + qed by c_line, Gc, Distinct, -, RaySameSide; +`;; + +let ConvexImpliesQuad = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + assume C IN int_angle D A B /\ D IN int_angle A B C [H2]; + thus Quadrilateral A B C D + + proof + ~(A = B) /\ ~(B = C) /\ ~(A = D) [TetraABCD] by H1, Tetralateral_DEF; + consider a such that + Line a /\ A IN a /\ B IN a [a_line] by TetraABCD, I1; + consider b such that + Line b /\ B IN b /\ C IN b [b_line] by TetraABCD, I1; + consider d such that + Line d /\ D IN d /\ A IN d [d_line] by TetraABCD, I1; + open (B,C) SUBSET b /\ open (A,B) SUBSET a [BCbABa] by b_line, a_line, BetweenLinear, SUBSET; + D,A same_side b /\ C,D same_side a by H2, a_line, b_line, d_line, InteriorUse; + b INTER open (D,A) = {} /\ a INTER open (C,D) = {} by -, b_line, SameSide_DEF, SET_RULE; + open (B,C) INTER open (D,A) = {} /\ open (A,B) INTER open (C,D) = {} by BCbABa, -, SET_RULE; + qed by H1, -, Quadrilateral_DEF; +`;; + +let DiagonalsIntersectImpliesConvexQuad = thm `; + let A B C D G be point; + assume ~Collinear B C D [BCDncol]; + assume G IN open (A,C) /\ G IN open (B,D) [DiagInt]; + thus ConvexQuadrilateral A B C D + + proof + ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ ~(C = A) /\ ~(A = G) /\ ~(D = G) /\ ~(B = G) [Distinct] by BCDncol, NonCollinearImpliesDistinct, DiagInt, B1'; + Collinear A G C /\ Collinear B G D [AGCcol] by DiagInt, B1'; + ~Collinear C D A [CDAncol] by BCDncol, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; + ~Collinear D A B [DABncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; + ~Collinear A B C [ABCncol] by -, CollinearSymmetry, Distinct, AGCcol, NoncollinearityExtendsToLine; + ~(A = B) /\ ~(A = D) by DABncol, NonCollinearImpliesDistinct; + Tetralateral A B C D [TetraABCD] by Distinct, -, BCDncol, CDAncol, DABncol, ABCncol, Tetralateral_DEF; + A IN ray C G DELETE C /\ B IN ray D G DELETE D /\ C IN ray A G DELETE A /\ D IN ray B G DELETE B [ArCG] by DiagInt, B1', IntervalRayEZ; + G IN int_angle B C D /\ G IN int_angle C D A /\ G IN int_angle D A B /\ G IN int_angle A B C by BCDncol, CDAncol, DABncol, ABCncol, DiagInt, B1', ConverseCrossbar; + A IN int_angle B C D /\ B IN int_angle C D A /\ C IN int_angle D A B /\ D IN int_angle A B C by -, ArCG, WholeRayInterior; + qed by TetraABCD, -, ConvexImpliesQuad, ConvexQuad_DEF; +`;; + +let DoubleNotSimImpliesDiagonalsIntersect = thm `; + let A B C D be point; + let l m be point_set; + assume Line l /\ A IN l /\ C IN l [l_line]; + assume Line m /\ B IN m /\ D IN m [m_line]; + assume Tetralateral A B C D [H1]; + assume ~(B,D same_side l) [H2]; + assume ~(A,C same_side m) [H3]; + thus (? G. G IN open (A,C) INTER open (B,D)) /\ ConvexQuadrilateral A B C D + + proof + ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; + consider G such that + G IN open (A,C) /\ G IN m [AGC] by H3, m_line, SameSide_DEF; + G IN l [Gl] by l_line, -, BetweenLinear; + A NOTIN m /\ B NOTIN l /\ D NOTIN l by TetraABCD, m_line, l_line, Collinear_DEF, NOTIN; + ~(l = m) /\ B IN m DELETE G /\ D IN m DELETE G [BDm_G] by -, l_line, NOTIN, m_line, Gl, IN_DELETE; + l INTER m = {G} by l_line, m_line, -, Gl, AGC, I1Uniqueness; + G IN open (B,D) by l_line, m_line, -, BDm_G, H2, EquivIntersection, NOTIN; + qed by AGC, -, IN_INTER, TetraABCD, DiagonalsIntersectImpliesConvexQuad; +`;; + +let ConvexQuadImpliesDiagonalsIntersect = thm `; + let A B C D be point; + let l m be point_set; + assume Line l /\ A IN l /\ C IN l [l_line]; + assume Line m /\ B IN m /\ D IN m [m_line]; + assume ConvexQuadrilateral A B C D [ConvQuadABCD]; + thus ~(B,D same_side l) /\ ~(A,C same_side m) /\ + (? G. G IN open (A,C) INTER open (B,D)) /\ ~Quadrilateral A B D C + + proof + Tetralateral A B C D /\ A IN int_angle B C D /\ D IN int_angle A B C [convquadABCD] by ConvQuadABCD, ConvexQuad_DEF, Quadrilateral_DEF; + ~(B,D same_side l) /\ ~(A,C same_side m) [opp_sides] by convquadABCD, l_line, m_line, InteriorOpposite; + consider G such that + G IN open (A,C) INTER open (B,D) [Gexists] by l_line, m_line, convquadABCD, opp_sides, DoubleNotSimImpliesDiagonalsIntersect; + ~(open (B,D) INTER open (C,A) = {}) by -, IN_INTER, B1', MEMBER_NOT_EMPTY; + ~Quadrilateral A B D C by -, Quadrilateral_DEF; + qed by opp_sides, Gexists, -; +`;; + +let FourChoicesTetralateralHelp = thm `; + let A B C D be point; + assume Tetralateral A B C D [H1]; + assume C IN int_angle D A B [CintDAB]; + thus ConvexQuadrilateral A B C D \/ C IN int_triangle D A B + + proof + ~(A = B) /\ ~(D = A) /\ ~(A = C) /\ ~(B = D) /\ ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Tetralateral_DEF; + consider a d such that + Line a /\ A IN a /\ B IN a /\ + Line d /\ D IN d /\ A IN d [ad_line] by TetraABCD, I1; + consider l m such that + Line l /\ A IN l /\ C IN l /\ + Line m /\ B IN m /\ D IN m [lm_line] by TetraABCD, I1; + C NOTIN a /\ C NOTIN d /\ B NOTIN l /\ D NOTIN l /\ A NOTIN m /\ C NOTIN m /\ ~Collinear A B D /\ ~Collinear B D A [tetra'] by TetraABCD, ad_line, lm_line, Collinear_DEF, NOTIN, CollinearSymmetry; + ~(B,D same_side l) [Bsim_lD] by CintDAB, lm_line, InteriorOpposite, -, SameSideSymmetric; + cases; + suppose ~(A,C same_side m); + qed by lm_line, H1, Bsim_lD, -, DoubleNotSimImpliesDiagonalsIntersect; + suppose A,C same_side m; + C,A same_side m [Csim_mA] by lm_line, -, tetra', SameSideSymmetric; + C,B same_side d /\ C,D same_side a by ad_line, CintDAB, InteriorUse; + C IN int_angle A B D /\ C IN int_angle B D A by tetra', ad_line, lm_line, Csim_mA, -, IN_InteriorAngle; + C IN int_triangle D A B by CintDAB, -, IN_InteriorTriangle; + qed by -; + end; +`;; + +let InteriorTriangleSymmetry = thm `; + ! A B C P. P IN int_triangle A B C ==> P IN int_triangle B C A + by IN_InteriorTriangle; +`;; + +let FourChoicesTetralateral = thm `; + let A B C D be point; + let a be point_set; + assume Tetralateral A B C D [H1]; + assume Line a /\ A IN a /\ B IN a [a_line]; + assume C,D same_side a [Csim_aD]; + thus ConvexQuadrilateral A B C D \/ ConvexQuadrilateral A B D C \/ + D IN int_triangle A B C \/ C IN int_triangle D A B + + proof + ~(A = B) /\ ~Collinear A B C /\ ~Collinear C D A /\ ~Collinear D A B /\ Tetralateral A B D C [TetraABCD] by H1, Tetralateral_DEF, TetralateralSymmetry; + ~Collinear C A D /\ C NOTIN a /\ D NOTIN a [notCDa] by TetraABCD, CollinearSymmetry, a_line, Collinear_DEF, NOTIN; + C IN int_angle D A B \/ D IN int_angle C A B by TetraABCD, a_line, -, Csim_aD, AngleOrdering; + cases by -; + suppose C IN int_angle D A B; + ConvexQuadrilateral A B C D \/ C IN int_triangle D A B by H1, -, FourChoicesTetralateralHelp; + qed by -; + suppose D IN int_angle C A B; + ConvexQuadrilateral A B D C \/ D IN int_triangle C A B by TetraABCD, -, FourChoicesTetralateralHelp; + qed by -, InteriorTriangleSymmetry; + end; +`;; + +let QuadrilateralSymmetry = thm `; + ! A B C D:point. Quadrilateral A B C D ==> + Quadrilateral B C D A /\ Quadrilateral C D A B /\ Quadrilateral D A B C + by Quadrilateral_DEF, INTER_COMM, TetralateralSymmetry, Quadrilateral_DEF; +`;; + +let FiveChoicesQuadrilateral = thm `; + let A B C D be point; + let l m be point_set; + assume Quadrilateral A B C D [H1]; + assume Line l /\ A IN l /\ C IN l /\ Line m /\ B IN m /\ D IN m [lm_line]; + thus (ConvexQuadrilateral A B C D \/ A IN int_triangle B C D \/ + B IN int_triangle C D A \/ C IN int_triangle D A B \/ D IN int_triangle A B C) /\ + (~(B,D same_side l) \/ ~(A,C same_side m)) + + proof + Tetralateral A B C D [H1Tetra] by H1, Quadrilateral_DEF; + ~(A = B) /\ ~(A = D) /\ ~(B = C) /\ ~(C = D) [Distinct] by H1Tetra, Tetralateral_DEF; + consider a c such that + Line a /\ A IN a /\ B IN a /\ + Line c /\ C IN c /\ D IN c [ac_line] by Distinct, I1; + Quadrilateral C D A B /\ Tetralateral C D A B [tetraCDAB] by H1, QuadrilateralSymmetry, Quadrilateral_DEF; + ~ConvexQuadrilateral A B D C /\ ~ConvexQuadrilateral C D B A [notconvquad] by Distinct, I1, H1, -, ConvexQuadImpliesDiagonalsIntersect; + ConvexQuadrilateral A B C D \/ A IN int_triangle B C D \/ + B IN int_triangle C D A \/ C IN int_triangle D A B \/ D IN int_triangle A B C [5choices] + proof + A,B same_side c \/ C,D same_side a by H1, ac_line, SegmentSameSideOppositeLine; + cases by -; + suppose C,D same_side a; + qed by H1Tetra, ac_line, -, notconvquad, FourChoicesTetralateral; + suppose A,B same_side c; + ConvexQuadrilateral C D A B \/ B IN int_triangle C D A \/ A IN int_triangle B C D [X1] by tetraCDAB, ac_line, -, notconvquad, FourChoicesTetralateral; + qed by -, QuadrilateralSymmetry, ConvexQuad_DEF; + end; + ~(B,D same_side l) \/ ~(A,C same_side m) by -, lm_line, ConvexQuadImpliesDiagonalsIntersect, IN_InteriorTriangle, InteriorAngleSymmetry, InteriorOpposite; + qed by 5choices, -; +`;; + +let IntervalSymmetry = thm `; + ! A B: point. open (A,B) = open (B,A) + by B1', EXTENSION; +`;; + +let SegmentSymmetry = thm `; + ! A B: point. seg A B = seg B A + by Segment_DEF, IntervalSymmetry, SET_RULE; +`;; + +let C1OppositeRay = thm `; + let O P be point; + let s be point_set; + assume Segment s /\ ~(O = P) [H1]; + thus ? Q. P IN open (O,Q) /\ seg P Q === s + + proof + consider Z such that + P IN open (O,Z) /\ ~(P = Z) [OPZ] by H1, B2', B1'; + consider Q such that + Q IN ray P Z DELETE P /\ seg P Q === s [PQeq] by H1, -, C1; + P IN open (Q,O) by OPZ, -, OppositeRaysIntersect1pointHelp; + qed by -, B1', PQeq; +`;; + +let OrderedCongruentSegments = thm `; + let A B C D F be point; + assume ~(A = C) /\ ~(D = F) [H1]; + assume seg A C === seg D F [H2]; + assume B IN open (A,C) [H3]; + thus ? E. E IN open (D,F) /\ seg A B === seg D E + + proof + Segment (seg A B) /\ Segment (seg A C) /\ Segment (seg B C) /\ Segment (seg D F) [segs] by H3, B1', H1, SEGMENT; + seg D F === seg A C [DFeqAC] by -, H2, C2Symmetric; + consider E such that + E IN ray D F DELETE D /\ seg D E === seg A B [DEeqAB] by segs, H1, C1; + ~(E = D) /\ Collinear D E F /\ D NOTIN open (F,E) [ErDF] by -, IN_DELETE, IN_Ray, B1', CollinearSymmetry, NOTIN; + consider F' such that + E IN open (D,F') /\ seg E F' === seg B C [DEF'] by segs, -, C1OppositeRay; + seg D F' === seg A C [DF'eqAC] by DEF', H3, DEeqAB, C3; + Segment (seg D F') /\ Segment (seg D E) by DEF', B1', SEGMENT; + seg A C === seg D F' /\ seg A B === seg D E [ABeqDE] by segs, -, DF'eqAC, C2Symmetric, DEeqAB; + F' IN ray D E DELETE D /\ F IN ray D E DELETE D by DEF', IntervalRayEZ, ErDF, IN_Ray, H1, IN_DELETE; + F' = F by ErDF, segs, -, DF'eqAC, DFeqAC, C1; + qed by -, DEF', ABeqDE; +`;; + +let SegmentSubtraction = thm `; + let A B C A' B' C' be point; + assume B IN open (A,C) /\ B' IN open (A',C') [H1]; + assume seg A B === seg A' B' [H2]; + assume seg A C === seg A' C' [H3]; + thus seg B C === seg B' C' + + proof + ~(A = B) /\ ~(A = C) /\ Collinear A B C /\ Segment (seg A' C') /\ Segment (seg B' C') [Distinct] by H1, B1', SEGMENT; + consider Q such that + B IN open (A,Q) /\ seg B Q === seg B' C' [defQ] by -, C1OppositeRay; + seg A Q === seg A' C' [AQ_A'C'] by H1, H2, -, C3; + ~(A = Q) /\ Collinear A B Q /\ A NOTIN open (C,B) /\ A NOTIN open (Q,B) by defQ, B1', H1, B3', NOTIN; + C IN ray A B DELETE A /\ Q IN ray A B DELETE A by Distinct, -, IN_Ray, IN_DELETE; + C = Q by Distinct, -, AQ_A'C', H3, C1; + qed by defQ, -; +`;; + +let SegmentOrderingUse = thm `; + let A B be point; + let s be point_set; + assume Segment s /\ ~(A = B) [H1]; + assume s <__ seg A B [H2]; + thus ? G. G IN open (A,B) /\ s === seg A G + + proof + consider A' B' G' such that + seg A B = seg A' B' /\ G' IN open (A',B') /\ s === seg A' G' [H2'] by H2, SegmentOrdering_DEF; + ~(A' = G') /\ ~(A' = B') /\ seg A' B' === seg A B [A'notB'G'] by -, B1', H1, SEGMENT, C2Reflexive; + consider G such that + G IN open (A,B) /\ seg A' G' === seg A G [AGB] by A'notB'G', H1, H2', -, OrderedCongruentSegments; + s === seg A G by H1, A'notB'G', -, B1', SEGMENT, H2', C2Transitive; + qed by AGB, -; +`;; + +let SegmentTrichotomy1 = thm `; + let s t be point_set; + assume s <__ t [H1]; + thus ~(s === t) + + proof + consider A B G such that + Segment s /\ t = seg A B /\ G IN open (A,B) /\ s === seg A G [H1'] by H1, SegmentOrdering_DEF; + ~(A = G) /\ ~(A = B) /\ ~(G = B) [Distinct] by H1', B1'; + seg A B === seg A B [ABrefl] by -, SEGMENT, C2Reflexive; + G IN ray A B DELETE A /\ B IN ray A B DELETE A by H1', IntervalRay, EndpointInRay, Distinct, IN_DELETE; + ~(seg A G === seg A B) /\ seg A G === s by Distinct, SEGMENT, -, ABrefl, C1, H1', C2Symmetric; + qed by Distinct, H1', SEGMENT, -, C2Transitive; +`;; + +let SegmentTrichotomy2 = thm `; + let s t u be point_set; + assume s <__ t [H1]; + assume Segment u /\ t === u [H2]; + thus s <__ u + + proof + consider A B P such that + Segment s /\ t = seg A B /\ P IN open (A,B) /\ s === seg A P [H1'] by H1, SegmentOrdering_DEF; + ~(A = B) /\ ~(A = P) [Distinct] by -, B1'; + consider X Y such that + u = seg X Y /\ ~(X = Y) [uXY] by H2, SEGMENT; + consider Q such that + Q IN open (X,Y) /\ seg A P === seg X Q [XQY] by Distinct, -, H1', H2, OrderedCongruentSegments; + ~(X = Q) /\ s === seg X Q by -, B1', H1', Distinct, SEGMENT, XQY, C2Transitive; + qed by H1', uXY, XQY, -, SegmentOrdering_DEF; +`;; + +let SegmentOrderTransitivity = thm `; + let s t u be point_set; + assume s <__ t /\ t <__ u [H1]; + thus s <__ u + + proof + consider A B G such that + u = seg A B /\ G IN open (A,B) /\ t === seg A G [H1'] by H1, SegmentOrdering_DEF; + ~(A = B) /\ ~(A = G) /\ Segment s [Distinct] by H1', B1', H1, SegmentOrdering_DEF; + s <__ seg A G by H1, H1', Distinct, SEGMENT, SegmentTrichotomy2; + consider F such that + F IN open (A,G) /\ s === seg A F [AFG] by Distinct, -, SegmentOrderingUse; + F IN open (A,B) by H1', IntervalsAreConvex, -, SUBSET; + qed by Distinct, H1', -, AFG, SegmentOrdering_DEF; +`;; + +let SegmentTrichotomy = thm `; + let s t be point_set; + assume Segment s /\ Segment t [H1]; + thus (s === t \/ s <__ t \/ t <__ s) /\ ~(s === t /\ s <__ t) /\ + ~(s === t /\ t <__ s) /\ ~(s <__ t /\ t <__ s) + + proof + ~(s === t /\ s <__ t) [Not12] + proof + assume s <__ t; + qed by -, SegmentTrichotomy1; + ~(s === t /\ t <__ s) [Not13] + proof + assume t <__ s; + ~(t === s) by -, SegmentTrichotomy1; + qed by H1, -, C2Symmetric; + ~(s <__ t /\ t <__ s) [Not23] + proof + assume s <__ t /\ t <__ s; + s <__ s by H1, -, SegmentOrderTransitivity; + qed by -, SegmentTrichotomy1, H1, C2Reflexive; + consider O P such that + s = seg O P /\ ~(O = P) [sOP] by H1, SEGMENT; + consider Q such that + Q IN ray O P DELETE O /\ seg O Q === t [QrOP] by H1, -, C1; + O NOTIN open (Q,P) /\ Collinear O P Q /\ ~(O = Q) [notQOP] by -, IN_DELETE, IN_Ray; + s === seg O P /\ t === seg O Q /\ seg O Q === t /\ seg O P === s [stOPQ] by H1, sOP, -, SEGMENT, QrOP, C2Reflexive, C2Symmetric; + cases; + suppose Q = P; + s === t by -, sOP, QrOP; + qed by -, Not12, Not13, Not23; + suppose ~(Q = P); + P IN open (O,Q) \/ Q IN open (O,P) by sOP, -, notQOP, B3', B1', NOTIN; + s <__ seg O Q \/ t <__ seg O P by H1, -, stOPQ, SegmentOrdering_DEF; + s <__ t \/ t <__ s by -, H1, stOPQ, SegmentTrichotomy2; + qed by -, Not12, Not13, Not23; + end; +`;; + +let C4Uniqueness = thm `; + let O A B P be point; + let l be point_set; + assume Line l /\ O IN l /\ A IN l /\ ~(O = A) [H1]; + assume B NOTIN l /\ P NOTIN l /\ P,B same_side l [H2]; + assume angle A O P === angle A O B [H3]; + thus ray O B = ray O P + + proof + ~(O = B) /\ ~(O = P) /\ Ray (ray O B) /\ Ray (ray O P) [Distinct] by H2, H1, NOTIN, RAY; + ~Collinear A O B /\ B,B same_side l [Bsim_lB] by H1, H2, I1, Collinear_DEF, NOTIN, SameSideReflexive; + Angle (angle A O B) /\ angle A O B === angle A O B by -, ANGLE, C5Reflexive; + qed by -, H1, H2, Distinct, Bsim_lB, H3, C4; +`;; + +let AngleSymmetry = thm `; + ! A O B. angle A O B = angle B O A + by Angle_DEF, UNION_COMM; +`;; + +let TriangleCongSymmetry = thm `; + let A B C A' B' C' be point; + assume A,B,C cong A',B',C' [H1]; + thus A,C,B cong A',C',B' /\ B,A,C cong B',A',C' /\ + B,C,A cong B',C',A' /\ C,A,B cong C',A',B' /\ C,B,A cong C',B',A' + + proof + ~Collinear A B C /\ ~Collinear A' B' C' /\ + seg A B === seg A' B' /\ seg A C === seg A' C' /\ seg B C === seg B' C' /\ + angle A B C === angle A' B' C' /\ angle B C A === angle B' C' A' /\ angle C A B === angle C' A' B' [H1'] by H1, TriangleCong_DEF; + seg B A === seg B' A' /\ seg C A === seg C' A' /\ seg C B === seg C' B' [segments] by H1', SegmentSymmetry; + angle C B A === angle C' B' A' /\ angle A C B === angle A' C' B' /\ angle B A C === angle B' A' C' by H1', AngleSymmetry; + qed by CollinearSymmetry, H1', segments, -, TriangleCong_DEF; +`;; + +let SAS = thm `; + let A B C A' B' C' be point; + assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; + assume seg B A === seg B' A' /\ seg B C === seg B' C' [H2]; + assume angle A B C === angle A' B' C' [H3]; + thus A,B,C cong A',B',C' + + proof + ~(A = B) /\ ~(A = C) /\ ~(A' = C') [Distinct] by H1, NonCollinearImpliesDistinct; :: 134 + consider c such that + Line c /\ A IN c /\ B IN c [c_line] by Distinct, I1; + C NOTIN c [notCc] by H1, c_line, Collinear_DEF, NOTIN; + angle B C A === angle B' C' A' [BCAeq] by H1, H2, H3, C6; + angle B A C === angle B' A' C' [BACeq] by H1, CollinearSymmetry, H2, H3, AngleSymmetry, C6; + consider Y such that + Y IN ray A C DELETE A /\ seg A Y === seg A' C' [YrAC] by Distinct, SEGMENT, C1; + Y NOTIN c /\ Y,C same_side c [Ysim_cC] by c_line, notCc, -, RaySameSide; + ~Collinear Y A B [YABncol] by c_line, -, Distinct, I1, Collinear_DEF, NOTIN; + ray A Y = ray A C /\ angle Y A B = angle C A B by Distinct, YrAC, RayWellDefined, Angle_DEF; + angle Y A B === angle C' A' B' by BACeq, -, AngleSymmetry; + angle A B Y === angle A' B' C' [ABYeq] by YABncol, H1, CollinearSymmetry, H2, SegmentSymmetry, YrAC, -, C6; + Angle (angle A B C) /\ Angle (angle A' B' C') /\ Angle (angle A B Y) by H1, CollinearSymmetry, YABncol, ANGLE; + angle A B Y === angle A B C [ABYeqABC] by -, ABYeq, -, H3, C5Symmetric, C5Transitive; + ray B C = ray B Y /\ ~(Y = B) /\ Y IN ray B C by c_line, Distinct, notCc, Ysim_cC, ABYeqABC, C4Uniqueness, NOTIN, -, EndpointInRay; + Collinear B C Y /\ Collinear A C Y by -, YrAC, IN_DELETE, IN_Ray; + C = Y by -, I1, Collinear_DEF, H1; + seg A C === seg A' C' by -, YrAC; + qed by H1, H2, SegmentSymmetry, -, H3, BCAeq, BACeq, AngleSymmetry, TriangleCong_DEF; +`;; + +let ASA = thm `; + let A B C A' B' C' be point; + assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; + assume seg A C === seg A' C' [H2]; + assume angle C A B === angle C' A' B' /\ angle B C A === angle B' C' A' [H3]; + thus A,B,C cong A',B',C' + + proof + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~(A' = B') /\ ~(A' = C') /\ ~(B' = C') /\ Segment (seg C' B') [Distinct] by H1, NonCollinearImpliesDistinct, SEGMENT; + consider D such that + D IN ray C B DELETE C /\ seg C D === seg C' B' /\ ~(D = C) [DrCB] by -, C1, IN_DELETE; + Collinear C B D [CBDcol] by -, IN_DELETE, IN_Ray; + ~Collinear D C A /\ Angle (angle C A D) /\ Angle (angle C' A' B') /\ Angle (angle C A B) [DCAncol] by H1, CollinearSymmetry, -, DrCB, NoncollinearityExtendsToLine, H1, ANGLE; + consider b such that + Line b /\ A IN b /\ C IN b [b_line] by Distinct, I1; + B NOTIN b /\ ~(D = A) [notBb] by H1, -, Collinear_DEF, NOTIN, DCAncol, NonCollinearImpliesDistinct; + D NOTIN b /\ D,B same_side b [Dsim_bB] by b_line, -, DrCB, RaySameSide; + ray C D = ray C B by Distinct, DrCB, RayWellDefined; + angle D C A === angle B' C' A' by H3, -, Angle_DEF; + D,C,A cong B',C',A' by DCAncol, H1, CollinearSymmetry, DrCB, H2, SegmentSymmetry, -, SAS; + angle C A D === angle C' A' B' by -, TriangleCong_DEF; + angle C A D === angle C A B by DCAncol, -, H3, C5Symmetric, C5Transitive; + ray A B = ray A D /\ D IN ray A B by b_line, Distinct, notBb, Dsim_bB, -, C4Uniqueness, notBb, EndpointInRay; + Collinear A B D by -, IN_Ray; + D = B by I1, -, Collinear_DEF, CBDcol, H1; + seg C B === seg C' B' by -, DrCB; + B,C,A cong B',C',A' by H1, CollinearSymmetry, -, H2, SegmentSymmetry, H3, SAS; + qed by -, TriangleCongSymmetry; +`;; + +let AngleSubtraction = thm `; + let A O B A' O' B' G G' be point; + assume G IN int_angle A O B /\ G' IN int_angle A' O' B' [H1]; + assume angle A O B === angle A' O' B' /\ angle A O G === angle A' O' G' [H2]; + thus angle G O B === angle G' O' B' + + proof + ~Collinear A O B /\ ~Collinear A' O' B' [A'O'B'ncol] by H1, IN_InteriorAngle; + ~(A = O) /\ ~(O = B) /\ ~(G = O) /\ ~(G' = O') /\ Segment (seg O' A') /\ Segment (seg O' B') [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp, SEGMENT; + consider X Y such that + X IN ray O A DELETE O /\ seg O X === seg O' A' /\ Y IN ray O B DELETE O /\ seg O Y === seg O' B' [XYexists] by -, C1; + G IN int_angle X O Y [GintXOY] by H1, XYexists, InteriorWellDefined, InteriorAngleSymmetry; + consider H H' such that + H IN open (X,Y) /\ H IN ray O G DELETE O /\ + H' IN open (A',B') /\ H' IN ray O' G' DELETE O' [Hexists] by -, H1, Crossbar_THM; + H IN int_angle X O Y /\ H' IN int_angle A' O' B' [HintXOY] by GintXOY, H1, -, WholeRayInterior; + ray O X = ray O A /\ ray O Y = ray O B /\ ray O H = ray O G /\ ray O' H' = ray O' G' [Orays] by Distinct, XYexists, Hexists, RayWellDefined; + angle X O Y === angle A' O' B' /\ angle X O H === angle A' O' H' [H2'] by H2, -, Angle_DEF; + ~Collinear X O Y by GintXOY, IN_InteriorAngle; + X,O,Y cong A',O',B' by -, A'O'B'ncol, H2', XYexists, SAS; + seg X Y === seg A' B' /\ angle O Y X === angle O' B' A' /\ angle Y X O === angle B' A' O' [XOYcong] by -, TriangleCong_DEF; + ~Collinear O H X /\ ~Collinear O' H' A' /\ ~Collinear O Y H /\ ~Collinear O' B' H' [OHXncol] by HintXOY, InteriorEZHelp, InteriorAngleSymmetry, CollinearSymmetry; + ray X H = ray X Y /\ ray A' H' = ray A' B' /\ ray Y H = ray Y X /\ ray B' H' = ray B' A' [Hrays] by Hexists, B1', IntervalRay; + angle H X O === angle H' A' O' by XOYcong, -, Angle_DEF; + O,H,X cong O',H',A' by OHXncol, XYexists, -, H2', ASA; + seg X H === seg A' H' by -, TriangleCong_DEF, SegmentSymmetry; + seg H Y === seg H' B' by Hexists, XOYcong, -, SegmentSubtraction; + seg Y O === seg B' O' /\ seg Y H === seg B' H' [YHeq] by XYexists, -, SegmentSymmetry; + angle O Y H === angle O' B' H' by XOYcong, Hrays, Angle_DEF; + O,Y,H cong O',B',H' by OHXncol, YHeq, -, SAS; + angle H O Y === angle H' O' B' by -, TriangleCong_DEF; + qed by -, Orays, Angle_DEF; +`;; + +let OrderedCongruentAngles = thm `; + let A O B A' O' B' G be point; + assume ~Collinear A' O' B' [H1]; + assume angle A O B === angle A' O' B' [H2]; + assume G IN int_angle A O B [H3]; + thus ? G'. G' IN int_angle A' O' B' /\ angle A O G === angle A' O' G' + + proof + ~Collinear A O B [AOBncol] by H3, IN_InteriorAngle; + ~(A = O) /\ ~(O = B) /\ ~(A' = B') /\ ~(O = G) /\ Segment (seg O' A') /\ Segment (seg O' B') [Distinct] by AOBncol, H1, NonCollinearImpliesDistinct, H3, InteriorEZHelp, SEGMENT; + consider X Y such that + X IN ray O A DELETE O /\ seg O X === seg O' A' /\ Y IN ray O B DELETE O /\ seg O Y === seg O' B' [defXY] by -, C1; + G IN int_angle X O Y [GintXOY] by H3, -, InteriorWellDefined, InteriorAngleSymmetry; + ~Collinear X O Y /\ ~(X = Y) [XOYncol] by -, IN_InteriorAngle, NonCollinearImpliesDistinct; + consider H such that + H IN open (X,Y) /\ H IN ray O G DELETE O [defH] by GintXOY, Crossbar_THM; + ray O X = ray O A /\ ray O Y = ray O B /\ ray O H = ray O G [Orays] by Distinct, defXY, -, RayWellDefined; + angle X O Y === angle A' O' B' by H2, -, Angle_DEF; + X,O,Y cong A',O',B' by XOYncol, H1, defXY, -, SAS; + seg X Y === seg A' B' /\ angle O X Y === angle O' A' B' [YXOcong] by -, TriangleCong_DEF, AngleSymmetry; + consider G' such that + G' IN open (A',B') /\ seg X H === seg A' G' [A'G'B'] by XOYncol, Distinct, -, defH, OrderedCongruentSegments; + G' IN int_angle A' O' B' [G'intA'O'B'] by H1, -, ConverseCrossbar; + ray X H = ray X Y /\ ray A' G' = ray A' B' by defH, A'G'B', IntervalRay; + angle O X H === angle O' A' G' [HXOeq] by -, Angle_DEF, YXOcong; + H IN int_angle X O Y by GintXOY, defH, WholeRayInterior; + ~Collinear O X H /\ ~Collinear O' A' G' by -, G'intA'O'B', InteriorEZHelp, CollinearSymmetry; + O,X,H cong O',A',G' by -, A'G'B', defXY, SegmentSymmetry, HXOeq, SAS; + angle X O H === angle A' O' G' by -, TriangleCong_DEF, AngleSymmetry; + angle A O G === angle A' O' G' by -, Orays, Angle_DEF; + qed by G'intA'O'B', -; +`;; + +let AngleAddition = thm `; + let A O B A' O' B' G G' be point; + assume G IN int_angle A O B /\ G' IN int_angle A' O' B' [H1]; + assume angle A O G === angle A' O' G' /\ angle G O B === angle G' O' B' [H2]; + thus angle A O B === angle A' O' B' + + proof + ~Collinear A O B /\ ~Collinear A' O' B' [AOBncol] by H1, IN_InteriorAngle; + ~(A = O) /\ ~(A = B) /\ ~(O = B) /\ ~(A' = O') /\ ~(A' = B') /\ ~(O' = B') /\ ~(G = O) [Distinct] by -, NonCollinearImpliesDistinct, H1, InteriorEZHelp; + consider a b such that + Line a /\ O IN a /\ A IN a /\ + Line b /\ O IN b /\ B IN b [a_line] by Distinct, I1; + consider g such that + Line g /\ O IN g /\ G IN g [g_line] by Distinct, I1; + G NOTIN a /\ G,B same_side a [H1'] by a_line, H1, InteriorUse; + ~Collinear A O G /\ ~Collinear A' O' G' [AOGncol] by H1, InteriorEZHelp, IN_InteriorAngle; + Angle (angle A O B) /\ Angle (angle A' O' B') /\ Angle (angle A O G) /\ Angle (angle A' O' G') [angles] by AOBncol, -, ANGLE; + ?! r. Ray r /\ ? X. ~(O = X) /\ r = ray O X /\ X NOTIN a /\ X,G same_side a /\ angle A O X === angle A' O' B' by -, Distinct, a_line, H1', C4; + consider X such that + X NOTIN a /\ X,G same_side a /\ angle A O X === angle A' O' B' [Xexists] by -; + ~Collinear A O X [AOXncol] by -, a_line, Distinct, I1, Collinear_DEF, NOTIN; + angle A' O' B' === angle A O X by -, AOBncol, ANGLE, Xexists, C5Symmetric; + consider Y such that + Y IN int_angle A O X /\ angle A' O' G' === angle A O Y [YintAOX] by AOXncol, -, H1, OrderedCongruentAngles; + ~Collinear A O Y by -, InteriorEZHelp; + angle A O Y === angle A O G [AOGeq] by -, angles, -, ANGLE, YintAOX, H2, C5Transitive, C5Symmetric; + consider x such that + Line x /\ O IN x /\ X IN x by Distinct, I1; + Y NOTIN a /\ Y,X same_side a by a_line, -, YintAOX, InteriorUse; + Y NOTIN a /\ Y,G same_side a by a_line, -, Xexists, H1', SameSideTransitive; + ray O G = ray O Y by a_line, Distinct, H1', -, AOGeq, C4Uniqueness; + G IN ray O Y DELETE O by Distinct, -, EndpointInRay, IN_DELETE; + G IN int_angle A O X [GintAOX] by YintAOX, -, WholeRayInterior; + angle G O X === angle G' O' B' [GOXeq] by -, H1, Xexists, H2, AngleSubtraction; + ~Collinear G O X /\ ~Collinear G O B /\ ~Collinear G' O' B' [GOXncol] by GintAOX, H1, InteriorAngleSymmetry, InteriorEZHelp, CollinearSymmetry; + Angle (angle G O X) /\ Angle (angle G O B) /\ Angle (angle G' O' B') by -, ANGLE; + angle G O X === angle G O B [G'O'Xeq] by angles, -, GOXeq, C5Symmetric, H2, C5Transitive; + ~(A,X same_side g) /\ ~(A,B same_side g) [Ansim_aXB] by g_line, GintAOX, H1, InteriorOpposite; + A NOTIN g /\ B NOTIN g /\ X NOTIN g [notABXg] by g_line, AOGncol, GOXncol, Distinct, I1, Collinear_DEF, NOTIN; + X,B same_side g by g_line, -, Ansim_aXB, AtMost2Sides; + ray O X = ray O B by g_line, Distinct, notABXg, -, G'O'Xeq, C4Uniqueness; + qed by -, Xexists, Angle_DEF; +`;; + +let AngleOrderingUse = thm `; + let A O B be point; + let alpha be point_set; + assume Angle alpha /\ ~Collinear A O B [H1]; + assume alpha <_ang angle A O B [H3]; + thus ? G. G IN int_angle A O B /\ alpha === angle A O G + + proof + consider A' O' B' G' such that + ~Collinear A' O' B' /\ angle A O B = angle A' O' B' /\ G' IN int_angle A' O' B' /\ alpha === angle A' O' G' [H3'] by H3, AngleOrdering_DEF; + Angle (angle A O B) /\ Angle (angle A' O' B') /\ Angle (angle A' O' G') [angles] by H1, -, ANGLE, InteriorEZHelp; + angle A' O' B' === angle A O B by -, H3', C5Reflexive; + consider G such that + G IN int_angle A O B /\ angle A' O' G' === angle A O G [GintAOB] by H1, H3', -, OrderedCongruentAngles; + alpha === angle A O G by H1, angles, -, InteriorEZHelp, ANGLE, H3', GintAOB, C5Transitive; + qed by -, GintAOB; +`;; + +let AngleTrichotomy1 = thm `; + let alpha beta be point_set; + assume alpha <_ang beta [H1]; + thus ~(alpha === beta) + + proof + assume alpha === beta [Con]; + consider A O B G such that + Angle alpha /\ ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G [H1'] by H1, AngleOrdering_DEF; + ~(A = O) /\ ~(O = B) /\ ~Collinear A O G [Distinct] by H1', NonCollinearImpliesDistinct, InteriorEZHelp; + consider a such that + Line a /\ O IN a /\ A IN a [a_line] by Distinct, I1; + consider b such that + Line b /\ O IN b /\ B IN b [b_line] by Distinct, I1; + B NOTIN a [notBa] by a_line, H1', Collinear_DEF, NOTIN; + G NOTIN a /\ G NOTIN b /\ G,B same_side a [GintAOB] by a_line, b_line, H1', InteriorUse; + angle A O G === alpha by H1', Distinct, ANGLE, C5Symmetric; + angle A O G === angle A O B by H1', Distinct, ANGLE, -, Con, C5Transitive; + ray O B = ray O G by a_line, Distinct, notBa, GintAOB, -, C4Uniqueness; + G IN b by Distinct, -, EndpointInRay, b_line, RayLine, SUBSET; + qed by -, GintAOB, NOTIN; +`;; + +let AngleTrichotomy2 = thm `; + let alpha beta gamma be point_set; + assume alpha <_ang beta [H1]; + assume Angle gamma [H2]; + assume beta === gamma [H3]; + thus alpha <_ang gamma + + proof + consider A O B G such that + Angle alpha /\ ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G [H1'] by H1, AngleOrdering_DEF; + consider A' O' B' such that + gamma = angle A' O' B' /\ ~Collinear A' O' B' [gammaA'O'B'] by H2, ANGLE; + consider G' such that + G' IN int_angle A' O' B' /\ angle A O G === angle A' O' G' [G'intA'O'B'] by gammaA'O'B', H1', H3, OrderedCongruentAngles; + ~Collinear A O G /\ ~Collinear A' O' G' [ncol] by H1', -, InteriorEZHelp; + alpha === angle A' O' G' by H1', ANGLE, -, G'intA'O'B', C5Transitive; + qed by H1', -, ncol, gammaA'O'B', G'intA'O'B', -, AngleOrdering_DEF; +`;; + +let AngleOrderTransitivity = thm `; + let alpha beta gamma be point_set; + assume alpha <_ang beta [H0]; + assume beta <_ang gamma [H2]; + thus alpha <_ang gamma + + proof + consider A O B G such that + Angle beta /\ ~Collinear A O B /\ gamma = angle A O B /\ G IN int_angle A O B /\ beta === angle A O G [H2'] by H2, AngleOrdering_DEF; + ~Collinear A O G [AOGncol] by H2', InteriorEZHelp; + Angle alpha /\ Angle (angle A O G) /\ Angle gamma [angles] by H0, AngleOrdering_DEF, H2', -, ANGLE; + alpha <_ang angle A O G by H0, H2', -, AngleTrichotomy2; + consider F such that + F IN int_angle A O G /\ alpha === angle A O F [FintAOG] by angles, AOGncol, -, AngleOrderingUse; + F IN int_angle A O B by H2', -, InteriorTransitivity; + qed by angles, H2', -, FintAOG, AngleOrdering_DEF; +`;; + +let AngleTrichotomy = thm `; + let alpha beta be point_set; + assume Angle alpha /\ Angle beta [H1]; + thus (alpha === beta \/ alpha <_ang beta \/ beta <_ang alpha) /\ + ~(alpha === beta /\ alpha <_ang beta) /\ + ~(alpha === beta /\ beta <_ang alpha) /\ + ~(alpha <_ang beta /\ beta <_ang alpha) + + proof + ~(alpha === beta /\ alpha <_ang beta) [Not12] by AngleTrichotomy1; + ~(alpha === beta /\ beta <_ang alpha) [Not13] by H1, C5Symmetric, AngleTrichotomy1; + ~(alpha <_ang beta /\ beta <_ang alpha) [Not23] by H1, AngleOrderTransitivity, AngleTrichotomy1, C5Reflexive; + consider P O A such that + alpha = angle P O A /\ ~Collinear P O A [POA] by H1, ANGLE; + ~(P = O) /\ ~(O = A) [Distinct] by -, NonCollinearImpliesDistinct; + consider a such that + Line a /\ O IN a /\ A IN a [a_line] by -, I1; + P NOTIN a [notPa] by -, Distinct, I1, POA, Collinear_DEF, NOTIN; + ?! r. Ray r /\ ? Q. ~(O = Q) /\ r = ray O Q /\ Q NOTIN a /\ Q,P same_side a /\ angle A O Q === beta by H1, Distinct, a_line, -, C4; + consider Q such that + ~(O = Q) /\ Q NOTIN a /\ Q,P same_side a /\ angle A O Q === beta [Qexists] by -; + O NOTIN open (Q,P) [notQOP] by a_line, Qexists, SameSide_DEF, NOTIN; + ~Collinear A O P [AOPncol] by POA, CollinearSymmetry; + ~Collinear A O Q [AOQncol] by a_line, Distinct, I1, Collinear_DEF, Qexists, NOTIN; + Angle (angle A O P) /\ Angle (angle A O Q) by AOPncol, -, ANGLE; + alpha === angle A O P /\ beta === angle A O Q /\ angle A O P === alpha [flip] by H1, -, POA, AngleSymmetry, C5Reflexive, Qexists, C5Symmetric; + cases; + suppose Collinear Q O P; + Collinear O P Q by -, CollinearSymmetry; + Q IN ray O P DELETE O by Distinct, -, notQOP, IN_Ray, Qexists, IN_DELETE; + ray O Q = ray O P by Distinct, -, RayWellDefined; + angle P O A = angle A O Q by -, Angle_DEF, AngleSymmetry; + alpha === beta by -, POA, Qexists; + qed by -, Not12, Not13, Not23; + suppose ~Collinear Q O P; + P IN int_angle Q O A \/ Q IN int_angle P O A by Distinct, a_line, Qexists, notPa, -, AngleOrdering; + P IN int_angle A O Q \/ Q IN int_angle A O P by -, InteriorAngleSymmetry; + alpha <_ang angle A O Q \/ beta <_ang angle A O P by H1, AOQncol, AOPncol, -, flip, AngleOrdering_DEF; + alpha <_ang beta \/ beta <_ang alpha by H1, -, Qexists, flip, AngleTrichotomy2; + qed by -, Not12, Not13, Not23; + end; +`;; + +let SupplementExists = thm `; + let alpha be point_set; + assume Angle alpha [H1]; + thus ? alpha'. alpha suppl alpha' + + proof + consider A O B such that + alpha = angle A O B /\ ~Collinear A O B /\ ~(A = O) [def_alpha] by H1, ANGLE, NonCollinearImpliesDistinct; + consider A' such that + O IN open (A,A') by -, B2'; + angle A O B suppl angle A' O B [AOBsup] by def_alpha, -, SupplementaryAngles_DEF, AngleSymmetry; + qed by -, def_alpha; +`;; + +let SupplementImpliesAngle = thm `; + let alpha beta be point_set; + assume alpha suppl beta [H1]; + thus Angle alpha /\ Angle beta + + proof + consider A O B A' such that + ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ beta = angle B O A' [H1'] by H1, SupplementaryAngles_DEF; + ~(O = A') /\ Collinear A O A' [Distinct] by -, NonCollinearImpliesDistinct, B1'; + ~Collinear B O A' by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; + qed by H1', -, ANGLE; +`;; + +let RightImpliesAngle = thm `; + ! alpha: point_set. Right alpha ==> Angle alpha + by RightAngle_DEF, SupplementImpliesAngle; +`;; + +let SupplementSymmetry = thm `; + let alpha beta be point_set; + assume alpha suppl beta [H1]; + thus beta suppl alpha + + proof + consider A O B A' such that + ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ beta = angle B O A' [H1'] by H1, SupplementaryAngles_DEF; + ~(O = A') /\ Collinear A O A' by -, NonCollinearImpliesDistinct, B1'; + ~Collinear A' O B [A'OBncol] by H1', CollinearSymmetry, -, NoncollinearityExtendsToLine; + O IN open (A',A) /\ beta = angle A' O B /\ alpha = angle B O A by H1', B1', AngleSymmetry; + qed by A'OBncol, -, SupplementaryAngles_DEF; +`;; + +let SupplementsCongAnglesCong = thm `; + let alpha beta alpha' beta' be point_set; + assume alpha suppl alpha' /\ beta suppl beta' [H1]; + assume alpha === beta [H2]; + thus alpha' === beta' + + proof + consider A O B A' such that + ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ alpha' = angle B O A' [def_alpha] by H1, SupplementaryAngles_DEF; + ~(A = O) /\ ~(O = B) /\ ~(A = A') /\ ~(O = A') /\ Collinear A O A' [Distinctalpha] by -, NonCollinearImpliesDistinct, B1'; + ~Collinear B A A' /\ ~Collinear O A' B [BAA'ncol] by def_alpha, CollinearSymmetry, -, NoncollinearityExtendsToLine; + Segment (seg O A) /\ Segment (seg O B) /\ Segment (seg O A') [Osegments] by Distinctalpha, SEGMENT; + consider C P D C' such that + ~Collinear C P D /\ P IN open (C,C') /\ beta = angle C P D /\ beta' = angle D P C' [def_beta] by H1, SupplementaryAngles_DEF; + ~(C = P) /\ ~(P = D) /\ ~(P = C') [Distinctbeta] by def_beta, NonCollinearImpliesDistinct, B1'; + consider X such that + X IN ray P C DELETE P /\ seg P X === seg O A [defX] by Osegments, Distinctbeta, C1; + consider Y such that + Y IN ray P D DELETE P /\ seg P Y === seg O B /\ ~(Y = P) [defY] by Osegments, Distinctbeta, C1, IN_DELETE; + consider X' such that + X' IN ray P C' DELETE P /\ seg P X' === seg O A' [defX'] by Osegments, Distinctbeta, C1; + P IN open (X',C) /\ P IN open (X,X') [XPX'] by def_beta, -, OppositeRaysIntersect1pointHelp, defX; + ~(X = P) /\ ~(X' = P) /\ Collinear X P X' /\ ~(X = X') /\ ray A' O = ray A' A /\ ray X' P = ray X' X [XPX'line] by defX, defX', IN_DELETE, -, B1', def_alpha, IntervalRay; + Collinear P D Y /\ Collinear P C X by defY, defX, IN_DELETE, IN_Ray; + ~Collinear C P Y /\ ~Collinear X P Y [XPYncol] by def_beta, -, defY, NoncollinearityExtendsToLine, CollinearSymmetry, XPX'line; + ~Collinear Y X X' /\ ~Collinear P X' Y [YXX'ncol] by -, CollinearSymmetry, XPX', XPX'line, NoncollinearityExtendsToLine; + ray P X = ray P C /\ ray P Y = ray P D /\ ray P X' = ray P C' [equalPrays] by Distinctbeta, defX, defY, defX', RayWellDefined; + beta = angle X P Y /\ beta' = angle Y P X' /\ angle A O B === angle X P Y [AOBeqXPY] by def_beta, -, Angle_DEF, H2, def_alpha; + seg O A === seg P X /\ seg O B === seg P Y /\ seg A' O === seg X' P [OAeq] by Osegments, XPX'line, SEGMENT, defX, defY, defX', C2Symmetric, SegmentSymmetry; + seg A A' === seg X X' [AA'eq] by def_alpha, XPX'line, XPX', -, SegmentSymmetry, C3; + A,O,B cong X,P,Y by def_alpha, XPYncol, OAeq, AOBeqXPY, SAS; + seg A B === seg X Y /\ angle B A O === angle Y X P [AOBcong] by -, TriangleCong_DEF, AngleSymmetry; + ray A O = ray A A' /\ ray X P = ray X X' /\ angle B A A' === angle Y X X' by def_alpha, XPX', IntervalRay, -, Angle_DEF; + B,A,A' cong Y,X,X' by BAA'ncol, YXX'ncol, AOBcong, -, AA'eq, -, SAS; + seg A' B === seg X' Y /\ angle A A' B === angle X X' Y by -, TriangleCong_DEF, SegmentSymmetry; + O,A',B cong P,X',Y by BAA'ncol, YXX'ncol, OAeq, -, XPX'line, Angle_DEF, SAS; + angle B O A' === angle Y P X' by -, TriangleCong_DEF; + qed by -, equalPrays, def_beta, Angle_DEF, def_alpha; +`;; + +let SupplementUnique = thm `; + ! alpha beta beta': point_set. alpha suppl beta /\ alpha suppl beta' ==> beta === beta' + by SupplementaryAngles_DEF, ANGLE, C5Reflexive, SupplementsCongAnglesCong; +`;; + +let CongRightImpliesRight = thm `; + let alpha beta be point_set; + assume Angle alpha /\ Right beta [H1]; + assume alpha === beta [H2]; + thus Right alpha + + proof + consider alpha' beta' such that + alpha suppl alpha' /\ beta suppl beta' /\ beta === beta' [suppl] by H1, SupplementExists, H1, RightAngle_DEF; + alpha' === beta' [alpha'eqbeta'] by suppl, H2, SupplementsCongAnglesCong; + Angle beta /\ Angle alpha' /\ Angle beta' by suppl, SupplementImpliesAngle; + alpha === alpha' by H1, -, H2, suppl, alpha'eqbeta', C5Symmetric, C5Transitive; + qed by suppl, -, RightAngle_DEF; +`;; + +let RightAnglesCongruentHelp = thm `; + let A O B A' P be point; + let a be point_set; + assume ~Collinear A O B /\ O IN open (A,A') [H1]; + assume Right (angle A O B) /\ Right (angle A O P) [H2]; + thus P NOTIN int_angle A O B + + proof + assume ~(P NOTIN int_angle A O B); + P IN int_angle A O B [PintAOB] by -, NOTIN; + B IN int_angle P O A' /\ B IN int_angle A' O P [BintA'OP] by H1, -, InteriorReflectionInterior, InteriorAngleSymmetry ; + ~Collinear A O P /\ ~Collinear P O A' [AOPncol] by PintAOB, InteriorEZHelp, -, IN_InteriorAngle; + angle A O B suppl angle B O A' /\ angle A O P suppl angle P O A' [AOBsup] by H1, -, SupplementaryAngles_DEF; + consider alpha' beta' such that + angle A O B suppl alpha' /\ angle A O B === alpha' /\ angle A O P suppl beta' /\ angle A O P === beta' [supplalpha'] by H2, RightAngle_DEF; + alpha' === angle B O A' /\ beta' === angle P O A' [alpha'eqA'OB] by -, AOBsup, SupplementUnique; + Angle (angle A O B) /\ Angle alpha' /\ Angle (angle B O A') /\ Angle (angle A O P) /\ Angle beta' /\ Angle (angle P O A') [angles] by AOBsup, supplalpha', SupplementImpliesAngle, AngleSymmetry; + angle A O B === angle B O A' /\ angle A O P === angle P O A' [H2'] by -, supplalpha', alpha'eqA'OB, C5Transitive; + angle A O P === angle A O P /\ angle B O A' === angle B O A' [refl] by angles, C5Reflexive; + angle A O P <_ang angle A O B /\ angle B O A' <_ang angle P O A' [BOA'lessPOA'] by angles, H1, PintAOB, -, AngleOrdering_DEF, AOPncol, CollinearSymmetry, BintA'OP, AngleSymmetry; + angle A O P <_ang angle B O A' by -, angles, H2', AngleTrichotomy2; + angle A O P <_ang angle P O A' by -, BOA'lessPOA', AngleOrderTransitivity; + qed by -, H2', AngleTrichotomy1; +`;; + +let RightAnglesCongruent = thm `; + let alpha beta be point_set; + assume Right alpha /\ Right beta [H1]; + thus alpha === beta + + proof + consider alpha' such that + alpha suppl alpha' /\ alpha === alpha' by H1, RightAngle_DEF; + consider A O B A' such that + ~Collinear A O B /\ O IN open (A,A') /\ alpha = angle A O B /\ alpha' = angle B O A' [def_alpha] by -, SupplementaryAngles_DEF; + ~(A = O) /\ ~(O = B) [Distinct] by def_alpha, NonCollinearImpliesDistinct, B1'; + consider a such that + Line a /\ O IN a /\ A IN a [a_line] by Distinct, I1; + B NOTIN a [notBa] by -, def_alpha, Collinear_DEF, NOTIN; + Angle beta by H1, RightImpliesAngle; + ?! r. Ray r /\ ? P. ~(O = P) /\ r = ray O P /\ P NOTIN a /\ P,B same_side a /\ angle A O P === beta by -, Distinct, a_line, notBa, C4; + consider P such that + ~(O = P) /\ P NOTIN a /\ P,B same_side a /\ angle A O P === beta [defP] by -; + O NOTIN open (P,B) [notPOB] by a_line, -, SameSide_DEF, NOTIN; + ~Collinear A O P [AOPncol] by a_line, Distinct, I1, defP, Collinear_DEF, NOTIN; + Right (angle A O P) [AOPright] by -, ANGLE, H1, defP, CongRightImpliesRight; + P NOTIN int_angle A O B /\ B NOTIN int_angle A O P by def_alpha, H1, -, AOPncol, AOPright, RightAnglesCongruentHelp; + Collinear P O B by Distinct, a_line, defP, notBa, -, AngleOrdering, InteriorAngleSymmetry, NOTIN; + P IN ray O B DELETE O by Distinct, -, CollinearSymmetry, notPOB, IN_Ray, defP, IN_DELETE; + ray O P = ray O B /\ angle A O P = angle A O B by Distinct, -, RayWellDefined, Angle_DEF; + qed by -, defP, def_alpha; +`;; + +let OppositeRightAnglesLinear = thm `; + let A B O H be point; + let h be point_set; + assume ~Collinear A O H /\ ~Collinear H O B [H0]; + assume Right (angle A O H) /\ Right (angle H O B) [H1]; + assume Line h /\ O IN h /\ H IN h /\ ~(A,B same_side h) [H2]; + thus O IN open (A,B) + + proof + ~(A = O) /\ ~(O = H) /\ ~(O = B) [Distinct] by H0, NonCollinearImpliesDistinct; + A NOTIN h /\ B NOTIN h [notABh] by H0, H2, Collinear_DEF, NOTIN; + consider E such that + O IN open (A,E) /\ ~(E = O) [AOE] by Distinct, B2', B1'; + angle A O H suppl angle H O E [AOHsupplHOE] by H0, -, SupplementaryAngles_DEF; + E NOTIN h [notEh] by H2, NOTIN, AOE, BetweenLinear, notABh; + ~(A,E same_side h) by H2, AOE, SameSide_DEF; + B,E same_side h [Bsim_hE] by H2, notABh, notEh, -, H2, AtMost2Sides; + consider alpha' such that + angle A O H suppl alpha' /\ angle A O H === alpha' [AOHsupplalpha'] by H1, RightAngle_DEF; + Angle (angle H O B) /\ Angle (angle A O H) /\ Angle alpha' /\ Angle (angle H O E) [angalpha'] by H1, RightImpliesAngle, -, AOHsupplHOE, SupplementImpliesAngle; + angle H O B === angle A O H /\ alpha' === angle H O E by H1, RightAnglesCongruent, AOHsupplalpha', AOHsupplHOE, SupplementUnique; + angle H O B === angle H O E by angalpha', -, AOHsupplalpha', C5Transitive; + ray O B = ray O E by H2, Distinct, notABh, notEh, Bsim_hE, -, C4Uniqueness; + B IN ray O E DELETE O by Distinct, EndpointInRay, -, IN_DELETE; + qed by AOE, -, OppositeRaysIntersect1pointHelp, B1'; +`;; + +let RightImpliesSupplRight = thm `; + let A O B A' be point; + assume ~Collinear A O B [H1]; + assume O IN open (A,A') [H2]; + assume Right (angle A O B) [H3]; + thus Right (angle B O A') + + proof + angle A O B suppl angle B O A' /\ Angle (angle A O B) /\ Angle (angle B O A') [AOBsuppl] by H1, H2, SupplementaryAngles_DEF, SupplementImpliesAngle; + consider beta such that + angle A O B suppl beta /\ angle A O B === beta [betasuppl] by H3, RightAngle_DEF; + Angle beta /\ beta === angle A O B [angbeta] by -, SupplementImpliesAngle, C5Symmetric; + angle B O A' === beta by AOBsuppl, betasuppl, SupplementUnique; + angle B O A' === angle A O B by AOBsuppl, angbeta, -, betasuppl, C5Transitive; + qed by AOBsuppl, H3, -, CongRightImpliesRight; +`;; + +let IsoscelesCongBaseAngles = thm `; + let A B C be point; + assume ~Collinear A B C [H1]; + assume seg B A === seg B C [H2]; + thus angle C A B === angle A C B + + proof + ~(A = B) /\ ~(B = C) /\ ~Collinear C B A [CBAncol] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; + seg B C === seg B A /\ angle A B C === angle C B A by -, SEGMENT, H2, C2Symmetric, H1, ANGLE, AngleSymmetry, C5Reflexive; + A,B,C cong C,B,A by H1, CBAncol, H2, -, SAS; + qed by -, TriangleCong_DEF; +`;; + +let C4withC1 = thm `; + let alpha l be point_set; + let O A Y P Q be point; + assume Angle alpha /\ ~(O = A) /\ ~(P = Q) [H1]; + assume Line l /\ O IN l /\ A IN l /\ Y NOTIN l [l_line]; + thus ? N. ~(O = N) /\ N NOTIN l /\ N,Y same_side l /\ seg O N === seg P Q /\ angle A O N === alpha + + proof + ?! r. Ray r /\ ? B. ~(O = B) /\ r = ray O B /\ B NOTIN l /\ B,Y same_side l /\ angle A O B === alpha by H1, l_line, C4; + consider B such that + ~(O = B) /\ B NOTIN l /\ B,Y same_side l /\ angle A O B === alpha [Bexists] by -; + consider N such that + N IN ray O B DELETE O /\ seg O N === seg P Q [Nexists] by H1, -, SEGMENT, C1; + ~(O = N) [notON] by -, IN_DELETE; + N NOTIN l /\ N,B same_side l [notNl] by l_line, Bexists, Nexists, RaySameSide; + N,Y same_side l [Nsim_lY] by l_line, -, Bexists, SameSideTransitive; + ray O N = ray O B /\ angle A O N === alpha by Bexists, Nexists, RayWellDefined, Angle_DEF; + qed by notON, notNl, Nsim_lY, Nexists, -; +`;; + +let C4OppositeSide = thm `; + let alpha l be point_set; + let O A Z P Q be point; + assume Angle alpha /\ ~(O = A) /\ ~(P = Q) [H1]; + assume Line l /\ O IN l /\ A IN l /\ Z NOTIN l [l_line]; + thus ? N. ~(O = N) /\ N NOTIN l /\ ~(Z,N same_side l) /\ seg O N === seg P Q /\ angle A O N === alpha + + proof + ~(Z = O) by l_line, NOTIN; + consider Y such that + O IN open (Z,Y) [ZOY] by -, B2'; + ~(O = Y) /\ Collinear Z O Y by -, B1'; + Y NOTIN l [notYl] by l_line, I1, -, Collinear_DEF, NOTIN; + consider N such that + ~(O = N) /\ N NOTIN l /\ N,Y same_side l /\ seg O N === seg P Q /\ angle A O N === alpha [Nexists] by H1, l_line, notYl, C4withC1; + ~(Z,Y same_side l) by l_line, ZOY, SameSide_DEF; + ~(Z,N same_side l) by l_line, Nexists, notYl, -, SameSideTransitive; + qed by -, Nexists; +`;; + +let SSS = thm `; + let A B C A' B' C' be point; + assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; + assume seg A B === seg A' B' /\ seg A C === seg A' C' /\ seg B C === seg B' C' [H2]; + thus A,B,C cong A',B',C' + + proof + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~(A' = B') /\ ~(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; + consider h such that + Line h /\ A IN h /\ C IN h [h_line] by Distinct, I1; + B NOTIN h [notBh] by h_line, H1, NOTIN, Collinear_DEF; + Segment (seg A B) /\ Segment (seg C B) /\ Segment (seg A' B') /\ Segment (seg C' B') [segments] by Distinct, -, SEGMENT; + Angle (angle C' A' B') by H1, CollinearSymmetry, ANGLE; + consider N such that + ~(A = N) /\ N NOTIN h /\ ~(B,N same_side h) /\ seg A N === seg A' B' /\ angle C A N === angle C' A' B' [Nexists] by -, Distinct, h_line, notBh, C4OppositeSide; + ~(C = N) by h_line, Nexists, NOTIN; + Segment (seg A N) /\ Segment (seg C N) [segN] by Nexists, -, SEGMENT; + ~Collinear A N C [ANCncol] by h_line, Distinct, I1, Collinear_DEF, Nexists, NOTIN; + Angle (angle A B C) /\ Angle (angle A' B' C') /\ Angle (angle A N C) [angles] by H1, -, ANGLE; + seg A B === seg A N [ABeqAN] by segments, segN, Nexists, H2, C2Symmetric, C2Transitive; + C,A,N cong C',A',B' by ANCncol, H1, CollinearSymmetry, H2, Nexists, SAS; + angle A N C === angle A' B' C' /\ seg C N === seg C' B' [ANCeq] by -, TriangleCong_DEF; + seg C B === seg C N [CBeqCN] by segments, segN, -, H2, SegmentSymmetry, C2Symmetric, C2Transitive; + consider G such that + G IN h /\ G IN open (B,N) [BGN] by Nexists, h_line, SameSide_DEF; + ~(B = N) [notBN] by -, B1'; + ray B G = ray B N /\ ray N G = ray N B [Grays] by BGN, B1', IntervalRay; + consider v such that + Line v /\ B IN v /\ N IN v [v_line] by notBN, I1; + G IN v /\ ~(h = v) by v_line, BGN, BetweenLinear, notBh, NOTIN; + h INTER v = {G} [hvG] by h_line, v_line, -, BGN, I1Uniqueness; + ~(G = A) ==> angle A B G === angle A N G [ABGeqANG] + proof + assume ~(G = A) [notGA]; + A NOTIN v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; + ~Collinear B A N by v_line, notBN, I1, Collinear_DEF, -, NOTIN; + angle N B A === angle B N A by -, ABeqAN, IsoscelesCongBaseAngles; + angle G B A === angle G N A by -, Grays, Angle_DEF, notGA; + qed by -, AngleSymmetry; + ~(G = C) ==> angle G B C === angle G N C [GBCeqGNC] + proof + assume ~(G = C) [notGC]; + C NOTIN v by hvG, h_line, -, EquivIntersectionHelp, IN_DELETE; + ~Collinear B C N by v_line, notBN, I1, Collinear_DEF, -, NOTIN; + angle N B C === angle B N C by -, CBeqCN, IsoscelesCongBaseAngles, AngleSymmetry; + qed by -, Grays, Angle_DEF; + angle A B C === angle A N C + proof + cases; + suppose G = A [GA]; + ~(G = C) by -, Distinct; + qed by -, GBCeqGNC, GA; + suppose G = C [GC]; + ~(G = A) by -, Distinct; + qed by -, ABGeqANG, GC; + suppose ~(G = A) /\ ~(G = C) [AGCdistinct]; + angle A B G === angle A N G /\ angle G B C === angle G N C [Gequivs] by -, ABGeqANG, GBCeqGNC; + ~Collinear G B C /\ ~Collinear G N C /\ ~Collinear G B A /\ ~Collinear G N A [Gncols] by h_line, BGN, AGCdistinct, I1, Collinear_DEF, notBh, Nexists, NOTIN; + Collinear A G C by h_line, BGN, Collinear_DEF; + G IN open (A,C) \/ C IN open (G,A) \/ A IN open (C,G) by Distinct, AGCdistinct, -, B3'; + cases by -; + suppose G IN open (A,C); + G IN int_angle A B C /\ G IN int_angle A N C by H1, ANCncol, -, ConverseCrossbar; + qed by -, Gequivs, AngleAddition; + suppose C IN open (G,A); + C IN int_angle G B A /\ C IN int_angle G N A by Gncols, -, B1', ConverseCrossbar; + qed by -, Gequivs, AngleSubtraction, AngleSymmetry; + suppose A IN open (C,G); + A IN int_angle G B C /\ A IN int_angle G N C by Gncols, -, B1', ConverseCrossbar; + qed by -, Gequivs, AngleSymmetry, AngleSubtraction; + end; + end; + angle A B C === angle A' B' C' by angles, -, ANCeq, C5Transitive; + qed by H1, H2, SegmentSymmetry, -, SAS; +`;; + +let AngleBisector = thm `; + let A B C be point; + assume ~Collinear B A C [H1]; + thus ? F. F IN int_angle B A C /\ angle B A F === angle F A C + + proof + ~(A = B) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + consider D such that + B IN open (A,D) [ABD] by Distinct, B2'; + ~(A = D) /\ Collinear A B D /\ Segment (seg A D) [ABD'] by -, B1', SEGMENT; + consider E such that + E IN ray A C DELETE A /\ seg A E === seg A D /\ ~(A = E) [ErAC] by -, Distinct, C1, IN_DELETE, IN_Ray; + Collinear A C E /\ D IN ray A B DELETE A [notAE] by ErAC, IN_DELETE, IN_Ray, ABD, IntervalRayEZ; + ray A D = ray A B /\ ray A E = ray A C [equalrays] by Distinct, notAE, ErAC, RayWellDefined; + ~Collinear D A E /\ ~Collinear E A D /\ ~Collinear A E D [EADncol] by H1, ABD', notAE, ErAC, CollinearSymmetry, NoncollinearityExtendsToLine; + angle D E A === angle E D A [DEAeq] by EADncol, ErAC, IsoscelesCongBaseAngles; + ~Collinear E D A /\ Angle (angle E D A) /\ ~Collinear A D E /\ ~Collinear D E A [angEDA] by EADncol, CollinearSymmetry, ANGLE; + ~(D = E) [notDE] by EADncol, NonCollinearImpliesDistinct; + consider h such that + Line h /\ D IN h /\ E IN h [h_line] by -, I1; + A NOTIN h [notAh] by -, Collinear_DEF, EADncol, NOTIN; + consider F such that + ~(D = F) /\ F NOTIN h /\ ~(A,F same_side h) /\ seg D F === seg D A /\ angle E D F === angle E D A [Fexists] by angEDA, notDE, ABD', h_line, -, C4OppositeSide; + ~(A = F) [notAF] by h_line, -, SameSideReflexive; + ~Collinear E D F /\ ~Collinear D E F /\ ~Collinear F E D [EDFncol] by h_line, notDE, I1, Collinear_DEF, Fexists, NOTIN; + seg D E === seg D E /\ seg F A === seg F A [FArefl] by notDE, notAF, SEGMENT, C2Reflexive; + E,D,F cong E,D,A by EDFncol, angEDA, -, Fexists, SAS; + seg F E === seg A E /\ angle F E D === angle A E D [FEDcong] by -, TriangleCong_DEF, SegmentSymmetry; + angle E D A === angle D E A /\ angle E D A === angle E D F /\ angle D E A === angle D E F [EDAeqEDF] by EDFncol, ANGLE, angEDA, Fexists, FEDcong, DEAeq, C5Symmetric, AngleSymmetry; + consider G such that + G IN h /\ G IN open (A,F) [AGF] by Fexists, h_line, SameSide_DEF; + F IN ray A G DELETE A [FrAG] by -, IntervalRayEZ; + consider v such that + Line v /\ A IN v /\ F IN v /\ G IN v [v_line] by notAF, I1, AGF, BetweenLinear; + ~(v = h) /\ v INTER h = {G} [vhG] by -, notAh, NOTIN, h_line, AGF, I1Uniqueness; + D NOTIN v [notDv] + proof + assume ~(D NOTIN v); + D IN v /\ D = G [DG] by h_line, -, NOTIN, vhG, IN_INTER, IN_SING; + D IN open (A,F) by DG, AGF; + angle E D A suppl angle E D F [EDAsuppl] by angEDA, -, SupplementaryAngles_DEF, AngleSymmetry; + Right (angle E D A) by EDAsuppl, EDAeqEDF, RightAngle_DEF; + Right (angle A E D) [RightAED] by angEDA, ANGLE, -, DEAeq, CongRightImpliesRight, AngleSymmetry; + Right (angle D E F) by EDFncol, ANGLE, -, FEDcong, CongRightImpliesRight, AngleSymmetry; + E IN open (A,F) by EADncol, EDFncol, RightAED, -, h_line, Fexists, OppositeRightAnglesLinear; + E IN v /\ E = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; + qed by -, DG, notDE; + E NOTIN v [notEv] + proof + assume ~(E NOTIN v); + E IN v /\ E = G [EG] by h_line, -, NOTIN, vhG, IN_INTER, IN_SING; + E IN open (A,F) by -, AGF; + angle D E A suppl angle D E F [DEAsuppl] by EADncol, -, SupplementaryAngles_DEF, AngleSymmetry; + Right (angle D E A) [RightDEA] by DEAsuppl, EDAeqEDF, RightAngle_DEF; + Right (angle E D A) [RightEDA] by angEDA, RightDEA, EDAeqEDF, CongRightImpliesRight; + Right (angle E D F) by EDFncol, ANGLE, RightEDA, Fexists, CongRightImpliesRight; + D IN open (A,F) by angEDA, EDFncol, RightEDA, AngleSymmetry, -, h_line, Fexists, OppositeRightAnglesLinear; + D IN v /\ D = G by v_line, -, BetweenLinear, h_line, vhG, IN_INTER, IN_SING; + qed by -, EG, notDE; + ~Collinear F A E /\ ~Collinear F A D /\ ~(F = E) [FAEncol] by v_line, notAF, I1, Collinear_DEF, notEv, notDv, NOTIN, NonCollinearImpliesDistinct; + seg F E === seg A D [FEeqAD] by -, ErAC, ABD', SEGMENT, FEDcong, ErAC, C2Transitive; + seg A D === seg F D by SegmentSymmetry, ABD', Fexists, SEGMENT, C2Symmetric; + seg F E === seg F D by FAEncol, ABD', Fexists, SEGMENT, FEeqAD, -, C2Transitive; + F,A,E cong F,A,D by FAEncol, FArefl, -, ErAC, SSS; + angle F A E === angle F A D [FAEeq] by -, TriangleCong_DEF; + angle D A F === angle F A E by FAEncol, ANGLE, FAEeq, C5Symmetric, AngleSymmetry; + angle B A F === angle F A C [BAFeqFAC] by -, equalrays, Angle_DEF; + ~(E,D same_side v) + proof + assume E,D same_side v; + ray A D = ray A E by v_line, notAF, notDv, notEv, -, FAEeq, C4Uniqueness; + qed by ABD', EndpointInRay, -, IN_Ray, EADncol; + consider H such that + H IN v /\ H IN open (E,D) [EHD] by v_line, -, SameSide_DEF; + H = G by -, h_line, BetweenLinear, IN_INTER, vhG, IN_SING; + G IN int_angle E A D [GintEAD] by EADncol, -, EHD, ConverseCrossbar; + F IN int_angle E A D [FintEAD] by GintEAD, FrAG, WholeRayInterior; + B IN ray A D DELETE A /\ C IN ray A E DELETE A by equalrays, Distinct, EndpointInRay, IN_DELETE; + F IN int_angle B A C by FintEAD, -, InteriorWellDefined, InteriorAngleSymmetry; + qed by -, BAFeqFAC; +`;; + +let EuclidPropositionI_6 = thm `; + let A B C be point; + assume ~Collinear A B C [H1]; + assume angle B A C === angle B C A [H2]; + thus seg B A === seg B C + + proof + ~(A = C) by H1, NonCollinearImpliesDistinct; + seg C A === seg A C [CAeqAC] by SegmentSymmetry, -, SEGMENT, C2Reflexive; + ~Collinear B C A /\ ~Collinear C B A /\ ~Collinear B A C [BCAncol] by H1, CollinearSymmetry; + angle A C B === angle C A B by -, ANGLE, H2, C5Symmetric, AngleSymmetry; + C,B,A cong A,B,C by H1, BCAncol, CAeqAC, H2, -, ASA; + qed by -, TriangleCong_DEF; +`;; + +let IsoscelesExists = thm `; + let A B be point; + assume ~(A = B) [H1]; + thus ? D. ~Collinear A D B /\ seg D A === seg D B + + proof + consider l such that + Line l /\ A IN l /\ B IN l [l_line] by H1, I1; + consider C such that + C NOTIN l [notCl] by -, ExistsPointOffLine; + ~Collinear C A B /\ ~Collinear C B A /\ ~Collinear A B C /\ ~Collinear A C B /\ ~Collinear B A C [CABncol] by l_line, H1, I1, Collinear_DEF, -, NOTIN; + angle C A B === angle C B A \/ angle C A B <_ang angle C B A \/ angle C B A <_ang angle C A B by -, ANGLE, AngleTrichotomy; + cases by -; + suppose angle C A B === angle C B A; + qed by -, CABncol, EuclidPropositionI_6; + suppose angle C A B <_ang angle C B A; + angle C A B <_ang angle A B C by -, AngleSymmetry; + consider E such that + E IN int_angle A B C /\ angle C A B === angle A B E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; + ~(B = E) [notBE] by -, InteriorEZHelp; + consider D such that + D IN open (A,C) /\ D IN ray B E DELETE B [Dexists] by Eexists, Crossbar_THM; + D IN int_angle A B C by Eexists, -, WholeRayInterior; + ~Collinear A D B [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; + ray B D = ray B E /\ ray A D = ray A C by notBE, Dexists, RayWellDefined, IntervalRay; + angle D A B === angle A B D by Eexists, -, Angle_DEF; + qed by ADBncol, -, AngleSymmetry, EuclidPropositionI_6; + :: similar case + suppose angle C B A <_ang angle C A B; + angle C B A <_ang angle B A C by -, AngleSymmetry; + consider E such that + E IN int_angle B A C /\ angle C B A === angle B A E [Eexists] by CABncol, ANGLE, -, AngleOrderingUse; + ~(A = E) [notAE] by -, InteriorEZHelp; + consider D such that + D IN open (B,C) /\ D IN ray A E DELETE A [Dexists] by Eexists, Crossbar_THM; + D IN int_angle B A C by Eexists, -, WholeRayInterior; + ~Collinear A D B /\ ~Collinear D A B /\ ~Collinear D B A [ADBncol] by -, InteriorEZHelp, CollinearSymmetry; + ray A D = ray A E /\ ray B D = ray B C by notAE, Dexists, RayWellDefined, IntervalRay; + angle D B A === angle B A D by Eexists, -, Angle_DEF; + angle D A B === angle D B A by AngleSymmetry, ADBncol, ANGLE, -, C5Symmetric; + qed by ADBncol, -, EuclidPropositionI_6; + end; +`;; + +let MidpointExists = thm `; + let A B be point; + assume ~(A = B) [H1]; + thus ? M. M IN open (A,B) /\ seg A M === seg M B + + proof + consider D such that + ~Collinear A D B /\ seg D A === seg D B [Dexists] by H1, IsoscelesExists; + consider F such that + F IN int_angle A D B /\ angle A D F === angle F D B [Fexists] by -, AngleBisector; + ~(D = F) [notDF] by -, InteriorEZHelp; + consider M such that + M IN open (A,B) /\ M IN ray D F DELETE D [Mexists] by Fexists, Crossbar_THM; + ray D M = ray D F by notDF, -, RayWellDefined; + angle A D M === angle M D B [ADMeqMDB] by Fexists, -, Angle_DEF; + M IN int_angle A D B by Fexists, Mexists, WholeRayInterior; + ~(D = M) /\ ~Collinear A D M /\ ~Collinear B D M [ADMncol] by -, InteriorEZHelp, InteriorAngleSymmetry; + seg D M === seg D M by -, SEGMENT, C2Reflexive; + A,D,M cong B,D,M by ADMncol, Dexists, -, ADMeqMDB, AngleSymmetry, SAS; + qed by Mexists, -, TriangleCong_DEF, SegmentSymmetry; +`;; + +let EuclidPropositionI_7short = thm `; + let A B C D be point; + let a be point_set; + assume ~(A = B) /\ Line a /\ A IN a /\ B IN a [a_line]; + assume ~(C = D) /\ C NOTIN a /\ D NOTIN a /\ C,D same_side a [Csim_aD]; + assume seg A C === seg A D [ACeqAD]; + thus ~(seg B C === seg B D) + + proof + ~(A = C) /\ ~(A = D) [AnotCD] by a_line, Csim_aD, NOTIN; + assume seg B C === seg B D; + seg C B === seg D B /\ seg A B === seg A B /\ seg A D === seg A D [segeqs] by -, SegmentSymmetry, a_line, AnotCD, SEGMENT, C2Reflexive; + ~Collinear A C B /\ ~Collinear A D B by a_line, I1, Csim_aD, Collinear_DEF, NOTIN; + A,C,B cong A,D,B by -, ACeqAD, segeqs, SSS; + angle B A C === angle B A D by -, TriangleCong_DEF; + ray A D = ray A C by a_line, Csim_aD, -, C4Uniqueness; + C IN ray A D DELETE A /\ D IN ray A D DELETE A by AnotCD, -, EndpointInRay, IN_DELETE; + C = D by AnotCD, SEGMENT, -, ACeqAD, segeqs, C1; + qed by -, Csim_aD; +`;; + +let EuclidPropositionI_7Help = thm `; + let A B C D be point; + let a be point_set; + assume ~(A = B) [notAB]; + assume Line a /\ A IN a /\ B IN a [a_line]; + assume ~(C = D) /\ C NOTIN a /\ D NOTIN a /\ C,D same_side a [Csim_aD]; + assume seg A C === seg A D [ACeqAD]; + assume C IN int_triangle D A B \/ ConvexQuadrilateral A B C D [Int_ConvQuad]; + thus ~(seg B C === seg B D) + + proof + ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) [Distinct] by a_line, Csim_aD, NOTIN, SameSide_DEF; + cases by Int_ConvQuad; + suppose ConvexQuadrilateral A B C D; + A IN int_angle B C D /\ B IN int_angle C D A /\ Tetralateral A B C D [ABint] by -, ConvexQuad_DEF, Quadrilateral_DEF; + ~Collinear B C D /\ ~Collinear D C B /\ ~Collinear C B D /\ ~Collinear C D A /\ ~Collinear D A C /\ Angle (angle D C A) /\ Angle (angle C D B) [angCDB] by -, Tetralateral_DEF, CollinearSymmetry, ANGLE; + angle C D A === angle D C A [CDAeqDCA] by angCDB, Distinct, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; + A IN int_angle D C B /\ angle D C A === angle D C A /\ angle C D B === angle C D B by ABint, InteriorAngleSymmetry, angCDB, ANGLE, C5Reflexive; + angle D C A <_ang angle D C B /\ angle C D B <_ang angle C D A by angCDB, ABint, -, AngleOrdering_DEF; + angle C D B <_ang angle D C B by -, angCDB, CDAeqDCA, AngleTrichotomy2, AngleOrderTransitivity; + ~(angle D C B === angle C D B) by -, AngleTrichotomy1, angCDB, ANGLE, C5Symmetric; + qed by angCDB, -, IsoscelesCongBaseAngles; + suppose C IN int_triangle D A B; + C IN int_angle A D B /\ C IN int_angle D A B [CintADB] by -, IN_InteriorTriangle, InteriorAngleSymmetry; + ~Collinear A D C /\ ~Collinear B D C [ADCncol] by CintADB, InteriorEZHelp, InteriorAngleSymmetry; + ~Collinear D A C /\ ~Collinear C D A /\ ~Collinear A C D /\ ~Collinear A D C [DACncol] by -, CollinearSymmetry; + ~Collinear B C D /\ Angle (angle D C A) /\ Angle (angle C D B) /\ ~Collinear D C B [angCDB] by ADCncol, -, CollinearSymmetry, ANGLE; + angle C D A === angle D C A [CDAeqDCA] by DACncol, Distinct, ADCncol, SEGMENT, ACeqAD, C2Symmetric, IsoscelesCongBaseAngles; + consider E such that + D IN open (A,E) /\ ~(D = E) /\ Collinear A D E [ADE] by Distinct, B2', B1'; + B IN int_angle C D E /\ Collinear D A E [BintCDE] by CintADB, -, InteriorReflectionInterior, CollinearSymmetry; + ~Collinear C D E [CDEncol] by DACncol, -, ADE, NoncollinearityExtendsToLine; + consider F such that + F IN open (B,D) /\ F IN ray A C DELETE A [Fexists] by CintADB, Crossbar_THM, B1'; + F IN int_angle B C D [FintBCD] by ADCncol, CollinearSymmetry, -, ConverseCrossbar; + ~Collinear D C F [DCFncol] by Distinct, ADCncol, CollinearSymmetry, Fexists, B1', NoncollinearityExtendsToLine; + Collinear A C F /\ F IN ray D B DELETE D /\ C IN int_angle A D F by Fexists, IN_DELETE, IN_Ray, B1', IntervalRayEZ, CintADB, InteriorWellDefined; + C IN open (A,F) by -, AlternateConverseCrossbar; + angle A D C suppl angle C D E /\ angle A C D suppl angle D C F by ADE, DACncol, -, SupplementaryAngles_DEF; + angle C D E === angle D C F [CDEeqDCF] by -, CDAeqDCA, AngleSymmetry, SupplementsCongAnglesCong; + angle C D B <_ang angle C D E by angCDB, CDEncol, BintCDE, C5Reflexive, AngleOrdering_DEF; + angle C D B <_ang angle D C F [CDBlessDCF] by -, DCFncol, ANGLE, CDEeqDCF, AngleTrichotomy2; + angle D C F <_ang angle D C B by DCFncol, ANGLE, angCDB, FintBCD, InteriorAngleSymmetry, C5Reflexive, AngleOrdering_DEF; + angle C D B <_ang angle D C B by CDBlessDCF, -, AngleOrderTransitivity; + ~(angle D C B === angle C D B) by -, AngleTrichotomy1, angCDB, CollinearSymmetry, ANGLE, C5Symmetric; + qed by Distinct, ADCncol, CollinearSymmetry, -, IsoscelesCongBaseAngles; + end; +`;; + +let EuclidPropositionI_7 = thm `; + let A B C D be point; + let a be point_set; + assume ~(A = B) [notAB]; + assume Line a /\ A IN a /\ B IN a [a_line]; + assume ~(C = D) /\ C NOTIN a /\ D NOTIN a /\ C,D same_side a [Csim_aD]; + assume seg A C === seg A D [ACeqAD]; + thus ~(seg B C === seg B D) + + proof + ~Collinear A B C /\ ~Collinear D A B [ABCncol] by a_line, notAB, I1, Collinear_DEF, Csim_aD, NOTIN; + ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ A NOTIN open (C,D) [Distinct] by a_line, Csim_aD, NOTIN, SameSide_DEF; + ~Collinear A D C [ADCncol] + proof + assume Collinear A D C; + C IN ray A D DELETE A /\ D IN ray A D DELETE A by Distinct, -, IN_Ray, EndpointInRay, IN_DELETE; + qed by Distinct, SEGMENT, -, ACeqAD, C2Reflexive, C1, Csim_aD; + D,C same_side a [Dsim_aC] by a_line, Csim_aD, SameSideSymmetric; + seg A D === seg A C /\ seg B D === seg B D [ADeqAC] by Distinct, SEGMENT, ACeqAD, C2Symmetric, C2Reflexive; + ~Collinear D A C /\ ~Collinear C D A /\ ~Collinear A C D /\ ~Collinear A D C [DACncol] by ADCncol, CollinearSymmetry; + ~(seg B D === seg B C) ==> ~(seg B C === seg B D) [BswitchDC] by Distinct, SEGMENT, C2Symmetric; + cases; + suppose Collinear B D C; + B NOTIN open (C,D) /\ C IN ray B D DELETE B /\ D IN ray B D DELETE B by a_line, Csim_aD, SameSide_DEF, NOTIN, Distinct, -, IN_Ray, Distinct, IN_DELETE, EndpointInRay; + qed by Distinct, SEGMENT, -, ACeqAD, ADeqAC, C1, Csim_aD; + suppose ~Collinear B D C [BDCncol]; + Tetralateral A B C D by notAB, Distinct, Csim_aD, ABCncol, -, CollinearSymmetry, DACncol, Tetralateral_DEF; + ConvexQuadrilateral A B C D \/ C IN int_triangle D A B \/ + ConvexQuadrilateral A B D C \/ D IN int_triangle C A B by -, a_line, Csim_aD, FourChoicesTetralateral, InteriorTriangleSymmetry; + qed by notAB, a_line, Csim_aD, Dsim_aC, ACeqAD, ADeqAC, -, EuclidPropositionI_7Help, BswitchDC; + end; +`;; + +let EuclidPropositionI_11 = thm `; + let A B be point; + assume ~(A = B) [notAB]; + thus ? F. Right (angle A B F) + + proof + consider C such that + B IN open (A,C) /\ seg B C === seg B A [ABC] by notAB, SEGMENT, C1OppositeRay; + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ Collinear A B C [Distinct] by ABC, B1'; + seg B A === seg B C [BAeqBC] by -, SEGMENT, ABC, C2Symmetric; + consider F such that + ~Collinear A F C /\ seg F A === seg F C [Fexists] by Distinct, IsoscelesExists; + ~Collinear B F A /\ ~Collinear B F C [BFAncol] by -, CollinearSymmetry, Distinct, NoncollinearityExtendsToLine; + ~Collinear A B F /\ Angle (angle A B F) [angABF] by BFAncol, CollinearSymmetry, ANGLE; + angle A B F suppl angle F B C [ABFsuppl] by -, ABC, SupplementaryAngles_DEF; + ~(B = F) /\ seg B F === seg B F by BFAncol, NonCollinearImpliesDistinct, SEGMENT, C2Reflexive; + B,F,A cong B,F,C by BFAncol, -, BAeqBC, Fexists, SSS; + angle A B F === angle F B C by -, TriangleCong_DEF, AngleSymmetry; + qed by angABF, ABFsuppl, -, RightAngle_DEF; +`;; + +let DropPerpendicularToLine = thm `; + let P be point; + let l be point_set; + assume Line l /\ P NOTIN l [l_line]; + thus ? E Q. E IN l /\ Q IN l /\ Right (angle P Q E) + + proof + consider A B such that + A IN l /\ B IN l /\ ~(A = B) [ABl] by l_line, I2; + ~Collinear B A P /\ ~Collinear P A B /\ ~(A = P) [BAPncol] by l_line, ABl, I1, Collinear_DEF, NOTIN, CollinearSymmetry, ABl, NOTIN; + Angle (angle B A P) /\ Angle (angle P A B) [angBAP] by -, ANGLE, AngleSymmetry; + consider P' such that + ~(A = P') /\ P' NOTIN l /\ ~(P,P' same_side l) /\ seg A P' === seg A P /\ angle B A P' === angle B A P [P'exists] by angBAP, ABl, BAPncol, l_line, C4OppositeSide; + consider Q such that + Q IN l /\ Q IN open (P,P') /\ Collinear A B Q [Qexists] by l_line, -, SameSide_DEF, ABl, Collinear_DEF; + ~Collinear B A P' [BAP'ncol] by l_line, ABl, I1, Collinear_DEF, P'exists, NOTIN; + angle B A P === angle B A P' [BAPeqBAP'] by -, ANGLE, angBAP, P'exists, C5Symmetric; + ? E. E IN l /\ ~Collinear P Q E /\ angle P Q E === angle E Q P' + proof + cases; + suppose A = Q [AQ]; + qed by ABl, AQ, BAPncol, BAPeqBAP', AngleSymmetry; + suppose ~(A = Q) [notAQ]; + seg A Q === seg A Q /\ seg A P === seg A P' [APeqAP'] by -, SEGMENT, C2Reflexive, BAPncol, P'exists, C2Symmetric; + ~Collinear Q A P' /\ ~Collinear Q A P [QAP'ncol] by l_line, ABl, Qexists, notAQ, I1, Collinear_DEF, P'exists, NOTIN; + angle Q A P === angle Q A P' + proof + cases; + suppose A IN open (Q,B); + angle B A P suppl angle P A Q /\ angle B A P' suppl angle P' A Q by BAPncol, BAP'ncol, -, B1', SupplementaryAngles_DEF; + qed by -, BAPeqBAP', SupplementsCongAnglesCong, AngleSymmetry; + suppose ~(A IN open (Q,B)); + A NOTIN open (Q,B) /\ Q IN ray A B DELETE A /\ ray A Q = ray A B by -, NOTIN, ABl, Qexists, IN_Ray, notAQ, IN_DELETE, ABl, RayWellDefined; + qed by -, BAPeqBAP', Angle_DEF; + end; + Q,A,P cong Q,A,P' by QAP'ncol, APeqAP', -, SAS; + qed by -, TriangleCong_DEF, AngleSymmetry, ABl, QAP'ncol, CollinearSymmetry; + end; + consider E such that + E IN l /\ ~Collinear P Q E /\ angle P Q E === angle E Q P' [Eexists] by -; + angle P Q E suppl angle E Q P' /\ Right (angle P Q E) by -, Qexists, SupplementaryAngles_DEF, RightAngle_DEF; + qed by Eexists, Qexists, -; +`;; + +let EuclidPropositionI_14 = thm `; + let A B C D be point; + let l be point_set; + assume Line l /\ A IN l /\ B IN l /\ ~(A = B) [l_line]; + assume C NOTIN l /\ D NOTIN l /\ ~(C,D same_side l) [Cnsim_lD]; + assume angle C B A suppl angle A B D [CBAsupplABD]; + thus B IN open (C,D) + + proof + ~(B = C) /\ ~(B = D) /\ ~Collinear C B A [Distinct] by l_line, Cnsim_lD, NOTIN, I1, Collinear_DEF; + consider E such that + B IN open (C,E) [CBE] by Distinct, B2'; + E NOTIN l /\ ~(C,E same_side l) [Csim_lE] by l_line, NOTIN, -, BetweenLinear, Cnsim_lD, SameSide_DEF; + D,E same_side l [Dsim_lE] by l_line, Cnsim_lD, -, AtMost2Sides; + angle C B A suppl angle A B E by Distinct, CBE, SupplementaryAngles_DEF; + angle A B D === angle A B E by CBAsupplABD, -, SupplementUnique; + ray B E = ray B D by l_line, Csim_lE, Cnsim_lD, Dsim_lE, -, C4Uniqueness; + D IN ray B E DELETE B by Distinct, -, EndpointInRay, IN_DELETE; + qed by CBE, -, OppositeRaysIntersect1pointHelp, B1'; +`;; + +let VerticalAnglesCong = thm `; :: Euclid's Proposition I.15 + let A B O A' B' be point; + assume ~Collinear A O B [H1]; + assume O IN open (A,A') /\ O IN open (B,B') [H2]; + thus angle B O A' === angle B' O A + + proof + angle A O B suppl angle B O A' [AOBsupplBOA'] by H1, H2, SupplementaryAngles_DEF; + angle B O A suppl angle A O B' by H1, CollinearSymmetry, H2, SupplementaryAngles_DEF; + qed by AOBsupplBOA', -, AngleSymmetry, SupplementUnique; +`;; + +let EuclidPropositionI_16 = thm `; + let A B C D be point; + assume ~Collinear A B C [H1]; + assume C IN open (B,D) [H2]; + thus angle B A C <_ang angle D C A + + proof + ~(A = B) /\ ~(A = C) /\ ~(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; + consider l such that + Line l /\ A IN l /\ C IN l [l_line] by Distinct, I1; + consider m such that + Line m /\ B IN m /\ C IN m [m_line] by Distinct, I1; + D IN m [Dm] by m_line, H2, BetweenLinear; + consider E such that + E IN open (A,C) /\ seg A E === seg E C [AEC] by Distinct, MidpointExists; + ~(A = E) /\ ~(E = C) /\ Collinear A E C /\ ~(B = E) [AECcol] by -, B1', H1; + E IN l [El] by l_line, AEC, BetweenLinear; + consider F such that + E IN open (B,F) /\ seg E F === seg E B [BEF] by AECcol, SEGMENT, C1OppositeRay; + ~(B = E) /\ ~(B = F) /\ ~(E = F) /\ Collinear B E F [BEF'] by BEF, B1'; + B NOTIN l [notBl] by l_line, Distinct, I1, Collinear_DEF, H1, NOTIN; + ~Collinear A E B /\ ~Collinear C E B [AEBncol] by l_line, El, AECcol, I1, Collinear_DEF, notBl, NOTIN; + Angle (angle B A E) [angBAE] by -, CollinearSymmetry, ANGLE; + ~Collinear C E F [CEFncol] by AEBncol, BEF', CollinearSymmetry, NoncollinearityExtendsToLine; + angle B E A === angle F E C [BEAeqFEC] by AEBncol, AEC, B1', BEF, VerticalAnglesCong; + seg E A === seg E C /\ seg E B === seg E F by AEC, SegmentSymmetry, AECcol, BEF', SEGMENT, BEF, C2Symmetric; + A,E,B cong C,E,F by AEBncol, CEFncol, -, BEAeqFEC, AngleSymmetry, SAS; + angle B A E === angle F C E [BAEeqFCE] by -, TriangleCong_DEF; + ~Collinear E C D [ECDncol] by AEBncol, H2, B1', CollinearSymmetry, NoncollinearityExtendsToLine; + F NOTIN l /\ D NOTIN l [notFl] by l_line, El, Collinear_DEF, CEFncol, -, NOTIN; + F IN ray B E DELETE B /\ E NOTIN m by BEF, IntervalRayEZ, m_line, Collinear_DEF, AEBncol, NOTIN; + F NOTIN m /\ F,E same_side m [Fsim_mE] by m_line, -, RaySameSide; + ~(B,F same_side l) /\ ~(B,D same_side l) by El, l_line, BEF, H2, SameSide_DEF; + F,D same_side l by l_line, notBl, notFl, -, AtMost2Sides; + F IN int_angle E C D by ECDncol, l_line, El, m_line, Dm, notFl, Fsim_mE, -, IN_InteriorAngle; + angle B A E <_ang angle E C D [BAElessECD] by angBAE, ECDncol, -, BAEeqFCE, AngleSymmetry, AngleOrdering_DEF; + ray A E = ray A C /\ ray C E = ray C A by AEC, B1', IntervalRay; + angle B A C <_ang angle A C D by BAElessECD, -, Angle_DEF; + qed by -, AngleSymmetry; +`;; + +let ExteriorAngle = thm `; + let A B C D be point; + assume ~Collinear A B C [H1]; + assume C IN open (B,D) [H2]; + thus angle A B C <_ang angle A C D + + proof + ~(C = D) /\ C IN open (D,B) /\ Collinear B C D [H2'] by H2, BetweenLinear, B1'; + ~Collinear B A C /\ ~(A = C) [BACncol] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; + consider E such that + C IN open (A,E) [ACE] by -, B2'; + ~(C = E) /\ C IN open (E,A) /\ Collinear A C E [ACE'] by -, B1'; + ~Collinear A C D /\ ~Collinear D C E [DCEncol] by H1, CollinearSymmetry, H2', -, NoncollinearityExtendsToLine; + angle A B C <_ang angle E C B [ABClessECB] by BACncol, ACE, EuclidPropositionI_16; + angle E C B === angle A C D by DCEncol, ACE', H2', VerticalAnglesCong; + qed by ABClessECB, DCEncol, ANGLE, -, AngleTrichotomy2; +`;; + +let EuclidPropositionI_17 = thm `; + let A B C be point; + let alpha beta gamma be point_set; + assume ~Collinear A B C /\ alpha = angle A B C /\ beta = angle B C A [H1]; + assume beta suppl gamma [H2]; + thus alpha <_ang gamma + + proof + Angle gamma [anggamma] by H2, SupplementImpliesAngle; + ~(A = B) /\ ~(A = C) /\ ~(B = C) [Distinct] by H1, NonCollinearImpliesDistinct; + ~Collinear B A C /\ ~Collinear A C B [BACncol] by H1, CollinearSymmetry; + consider D such that + C IN open (A,D) [ACD] by Distinct, B2'; + angle A B C <_ang angle D C B [ABClessDCB] by BACncol, ACD, EuclidPropositionI_16; + beta suppl angle B C D by -, H1, AngleSymmetry, BACncol, ACD, SupplementaryAngles_DEF; + angle B C D === gamma by H2, -, SupplementUnique; + qed by ABClessDCB, H1, AngleSymmetry, anggamma, -, AngleTrichotomy2; +`;; + +let EuclidPropositionI_18 = thm `; + let A B C be point; + assume ~Collinear A B C [H1]; + assume seg A C <__ seg A B [H2]; + thus angle A B C <_ang angle B C A + + proof + ~(A = B) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + consider D such that + D IN open (A,B) /\ seg A C === seg A D [ADB] by Distinct, SEGMENT, H2, SegmentOrderingUse; + ~(D = A) /\ ~(D = B) /\ D IN open (B,A) /\ Collinear A D B /\ ray B D = ray B A [ADB'] by -, B1', IntervalRay; + D IN int_angle A C B [DintACB] by H1, CollinearSymmetry, ADB, ConverseCrossbar; + ~Collinear D A C /\ ~Collinear C B D [DACncol] by H1, CollinearSymmetry, ADB', NoncollinearityExtendsToLine; + seg A D === seg A C by ADB', Distinct, SEGMENT, ADB, C2Symmetric; + angle C D A === angle A C D by DACncol, -, IsoscelesCongBaseAngles, AngleSymmetry; + angle C D A <_ang angle A C B [CDAlessACB] by DACncol, CollinearSymmetry, ANGLE, H1, CollinearSymmetry, DintACB, -, AngleOrdering_DEF; + angle B D C suppl angle C D A by DACncol, CollinearSymmetry, ADB', SupplementaryAngles_DEF; + angle C B D <_ang angle C D A by DACncol, -, EuclidPropositionI_17; + angle C B D <_ang angle A C B by -, CDAlessACB, AngleOrderTransitivity; + qed by -, ADB', Angle_DEF, AngleSymmetry; +`;; + +let EuclidPropositionI_19 = thm `; + let A B C be point; + assume ~Collinear A B C [H1]; + assume angle A B C <_ang angle B C A [H2]; + thus seg A C <__ seg A B + + proof + ~Collinear B A C /\ ~Collinear B C A /\ ~Collinear A C B [BACncol] by H1, CollinearSymmetry; + ~(A = B) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + assume ~(seg A C <__ seg A B); + seg A B === seg A C \/ seg A B <__ seg A C by Distinct, SEGMENT, -, SegmentTrichotomy; + cases by -; + suppose seg A B === seg A C; + angle C B A === angle B C A by BACncol, -, IsoscelesCongBaseAngles; + qed by -, AngleSymmetry, H2, AngleTrichotomy1; + suppose seg A B <__ seg A C; + angle A C B <_ang angle C B A by BACncol, -, EuclidPropositionI_18; + qed by H1, BACncol, ANGLE, -, AngleSymmetry, H2, AngleTrichotomy; + end; +`;; + +let EuclidPropositionI_20 = thm `; + let A B C D be point; + assume ~Collinear A B C [H1]; + assume A IN open (B,D) /\ seg A D === seg A C [H2]; + thus seg B C <__ seg B D + + proof + ~(B = D) /\ ~(A = D) /\ A IN open (D,B) /\ Collinear B A D /\ ray D A = ray D B [BAD'] by H2, B1', IntervalRay; + ~Collinear C A D [CADncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; + ~Collinear D C B /\ ~Collinear B D C [DCBncol] by H1, CollinearSymmetry, BAD', NoncollinearityExtendsToLine; :: 13 + Angle (angle C D A) [angCDA] by CADncol, CollinearSymmetry, ANGLE; + angle C D A === angle D C A [CDAeqDCA] by CADncol, CollinearSymmetry, H2, IsoscelesCongBaseAngles; + A IN int_angle D C B by DCBncol, BAD', ConverseCrossbar; + angle C D A <_ang angle D C B by angCDA, DCBncol, -, CDAeqDCA, AngleOrdering_DEF; + angle B D C <_ang angle D C B by -, BAD', Angle_DEF, AngleSymmetry; + qed by DCBncol, -, EuclidPropositionI_19; +`;; + +let EuclidPropositionI_21 = thm `; + let A B C D be point; + assume ~Collinear A B C [H1]; + assume D IN int_triangle A B C [H2]; + thus angle A B C <_ang angle C D A + + proof + ~(B = A) /\ ~(B = C) /\ ~(A = C) [Distinct] by H1, NonCollinearImpliesDistinct; + D IN int_angle B A C /\ D IN int_angle C B A [DintTri] by H2, IN_InteriorTriangle, InteriorAngleSymmetry; + consider E such that + E IN open (B,C) /\ E IN ray A D DELETE A [BEC] by -, Crossbar_THM; + ~(B = E) /\ ~(E = C) /\ Collinear B E C /\ Collinear A D E [BEC'] by -, B1', IN_DELETE, IN_Ray; + ray B E = ray B C /\ E IN ray B C DELETE B [rBErBC] by BEC, IntervalRay, IntervalRayEZ; + D IN int_angle A B E [DintABE] by DintTri, -, InteriorAngleSymmetry, InteriorWellDefined; + D IN open (A,E) [ADE] by BEC', -, AlternateConverseCrossbar; + ray E D = ray E A [rEDrEA] by -, B1', IntervalRay; + ~Collinear A B E /\ ~Collinear B E A /\ ~Collinear C B D /\ ~(A = D) [ABEncol] by DintABE, IN_InteriorAngle, CollinearSymmetry, DintTri, InteriorEZHelp; + ~Collinear E D C /\ ~Collinear C E D [EDCncol] by -, CollinearSymmetry, BEC', NoncollinearityExtendsToLine; + angle A B E <_ang angle A E C by ABEncol, BEC, ExteriorAngle; + angle A B C <_ang angle C E D [ABClessAEC] by -, rBErBC, rEDrEA, Angle_DEF, AngleSymmetry; + angle C E D <_ang angle C D A by EDCncol, ADE, B1', ExteriorAngle; + qed by ABClessAEC, -, AngleOrderTransitivity; +`;; + +let AngleTrichotomy3 = thm `; + let alpha beta gamma be point_set; + assume alpha <_ang beta /\ Angle gamma /\ gamma === alpha [H1]; + thus gamma <_ang beta + + proof + consider A O B G such that + Angle alpha /\ ~Collinear A O B /\ beta = angle A O B /\ G IN int_angle A O B /\ alpha === angle A O G [H1'] by H1, AngleOrdering_DEF; + ~Collinear A O G by -, InteriorEZHelp; + gamma === angle A O G by H1, H1', -, ANGLE, C5Transitive; + qed by H1, H1', -, AngleOrdering_DEF; +`;; + +let InteriorCircleConvexHelp = thm `; + let O A B C be point; + assume ~Collinear A O C [H1]; + assume B IN open (A,C) [H2]; + assume seg O A <__ seg O C \/ seg O A === seg O C [H3]; + thus seg O B <__ seg O C + + proof + ~Collinear O C A /\ ~Collinear C O A /\ ~(O = A) /\ ~(O = C) [H1'] by H1, CollinearSymmetry, NonCollinearImpliesDistinct; + ray A B = ray A C /\ ray C B = ray C A [equal_rays] by H2, IntervalRay, B1'; + angle O C A <_ang angle C A O \/ angle O C A === angle C A O + proof + cases by H3; + suppose seg O A <__ seg O C; + qed by H1', -, EuclidPropositionI_18; + suppose seg O A === seg O C [seg_eq]; + seg O C === seg O A by H1', SEGMENT, -, C2Symmetric; + qed by H1', -, IsoscelesCongBaseAngles, AngleSymmetry; + end; + angle O C B <_ang angle B A O \/ angle O C B === angle B A O by -, equal_rays, Angle_DEF; + angle B C O <_ang angle O A B \/ angle B C O === angle O A B [BCOlessOAB] by -, AngleSymmetry; + ~Collinear O A B /\ ~Collinear B C O /\ ~Collinear O C B [OABncol] by H1, CollinearSymmetry, H2, B1', NoncollinearityExtendsToLine; + angle O A B <_ang angle O B C by -, H2, ExteriorAngle; + angle B C O <_ang angle O B C by BCOlessOAB, -, AngleOrderTransitivity, OABncol, ANGLE, -, AngleTrichotomy3; + qed by OABncol, -, AngleSymmetry, EuclidPropositionI_19; +`;; + +let InteriorCircleConvex = thm `; + let O R A B C be point; + assume ~(O = R) [H1]; + assume B IN open (A,C) [H2]; + assume A IN int_circle O R /\ C IN int_circle O R [H3]; + thus B IN int_circle O R + + proof + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ B IN open (C,A) [H2'] by H2, B1'; + (A = O \/ seg O A <__ seg O R) /\ (C = O \/ seg O C <__ seg O R) [ACintOR] by H3, H1, IN_InteriorCircle; + cases; + suppose O = A \/ O = C; + B IN open (O,C) \/ B IN open (O,A) by -, H2, B1'; + seg O B <__ seg O A /\ ~(O = A) \/ seg O B <__ seg O C /\ ~(O = C) by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; + seg O B <__ seg O R by -, ACintOR, SegmentOrderTransitivity; + qed by -, H1, IN_InteriorCircle; + suppose ~(O = A) /\ ~(O = C) [OnotAC]; + cases; + suppose ~Collinear A O C [AOCncol]; + seg O A <__ seg O C \/ seg O A === seg O C \/ seg O C <__ seg O A by OnotAC, SEGMENT, SegmentTrichotomy; + seg O B <__ seg O C \/ seg O B <__ seg O A by AOCncol, H2, -, InteriorCircleConvexHelp, CollinearSymmetry, B1'; + qed by OnotAC, ACintOR, -, SegmentOrderTransitivity, H1, IN_InteriorCircle; + suppose Collinear A O C [AOCcol]; + consider l such that + Line l /\ A IN l /\ C IN l by H2', I1; + Collinear B A O /\ Collinear B C O [OABCcol] by -, H2, BetweenLinear, H2', AOCcol, CollinearLinear, Collinear_DEF; + B NOTIN open (O,A) /\ B NOTIN open (O,C) ==> B = O + proof + assume B NOTIN open (O,A) /\ B NOTIN open (O,C); + O IN ray B A INTER ray B C by H2', OABCcol, -, IN_Ray, IN_INTER; + qed by -, H2, OppositeRaysIntersect1point, IN_SING; + B IN open (O,A) \/ B IN open (O,C) \/ B = O by -, NOTIN; + seg O B <__ seg O A \/ seg O B <__ seg O C \/ B = O by -, B1', SEGMENT, C2Reflexive, SegmentOrdering_DEF; + seg O B <__ seg O R \/ B = O by -, ACintOR, OnotAC, SegmentOrderTransitivity; + qed by -, H1, IN_InteriorCircle; + end; + end; +`;; + +let SegmentTrichotomy3 = thm `; + let s t u be point_set; + assume s <__ t /\ Segment u /\ u === s [H1]; + thus u <__ t + + proof + consider C D X such that + Segment s /\ t = seg C D /\ X IN open (C,D) /\ s === seg C X /\ ~(C = X) [H1'] by H1, SegmentOrdering_DEF, B1'; + u === seg C X by H1, -, SEGMENT, C2Transitive; + qed by H1, H1', -, SegmentOrdering_DEF; +`;; + +let EuclidPropositionI_24Help = thm `; + let O A C O' D F be point; + assume ~Collinear A O C /\ ~Collinear D O' F [H1]; + assume seg O' D === seg O A /\ seg O' F === seg O C [H2]; + assume angle D O' F <_ang angle A O C [H3]; + assume seg O A <__ seg O C \/ seg O A === seg O C [H4]; + thus seg D F <__ seg A C + + proof + consider K such that + K IN int_angle A O C /\ angle D O' F === angle A O K [KintAOC] by H1, ANGLE, H3, AngleOrderingUse; + ~(O = C) /\ ~(D = F) /\ ~(O' = F) /\ ~(O = K) [Distinct] by H1, NonCollinearImpliesDistinct, -, InteriorEZHelp; + consider B such that + B IN ray O K DELETE O /\ seg O B === seg O C [BrOK] by Distinct, SEGMENT, -, C1; + ray O B = ray O K by Distinct, -, RayWellDefined; + angle D O' F === angle A O B [DO'FeqAOB] by KintAOC, -, Angle_DEF; + B IN int_angle A O C [BintAOC] by KintAOC, BrOK, WholeRayInterior; + ~(B = O) /\ ~Collinear A O B [AOBncol] by -, InteriorEZHelp; + seg O C === seg O B [OCeqOB] by Distinct, -, SEGMENT, BrOK, C2Symmetric; + seg O' F === seg O B by Distinct, SEGMENT, AOBncol, H2, -, C2Transitive; + D,O',F cong A,O,B by H1, AOBncol, H2, -, DO'FeqAOB, SAS; + seg D F === seg A B [DFeqAB] by -, TriangleCong_DEF; + consider G such that + G IN open (A,C) /\ G IN ray O B DELETE O /\ ~(G = O) [AGC] by BintAOC, Crossbar_THM, B1', IN_DELETE; + Segment (seg O G) /\ ~(O = B) [notOB] by AGC, SEGMENT, BrOK, IN_DELETE; + seg O G <__ seg O C by H1, AGC, H4, InteriorCircleConvexHelp; + seg O G <__ seg O B by -, OCeqOB, BrOK, IN_DELETE, SEGMENT, SegmentTrichotomy2; + consider G' such that + G' IN open (O,B) /\ seg O G === seg O G' [OG'B] by notOB, -, SegmentOrderingUse; + ~(G' = O) /\ seg O G' === seg O G' /\ Segment (seg O G') [notG'O] by -, B1', SEGMENT, C2Reflexive, SEGMENT; + G' IN ray O B DELETE O by OG'B, IntervalRayEZ; + G' = G /\ G IN open (B,O) by notG'O, notOB, -, AGC, OG'B, C1, B1'; + ConvexQuadrilateral B A O C by H1, -, AGC, DiagonalsIntersectImpliesConvexQuad; + A IN int_angle O C B /\ O IN int_angle C B A /\ Quadrilateral B A O C [OintCBA] by -, ConvexQuad_DEF; + A IN int_angle B C O [AintBCO] by -, InteriorAngleSymmetry; + Tetralateral B A O C by OintCBA, Quadrilateral_DEF; + ~Collinear C B A /\ ~Collinear B C O /\ ~Collinear C O B /\ ~Collinear C B O [BCOncol] by -, Tetralateral_DEF, CollinearSymmetry; + angle B C O === angle C B O [BCOeqCBO] by -, OCeqOB, IsoscelesCongBaseAngles; + ~Collinear B C A /\ ~Collinear A C B [ACBncol] by AintBCO, InteriorEZHelp, CollinearSymmetry; + angle B C A === angle B C A /\ Angle (angle B C A) /\ angle C B O === angle C B O [CBOref] by -, ANGLE, BCOncol, C5Reflexive; + angle B C A <_ang angle B C O by -, BCOncol, ANGLE, AintBCO, AngleOrdering_DEF; + angle B C A <_ang angle C B O [BCAlessCBO] by -, BCOncol, ANGLE, BCOeqCBO, AngleTrichotomy2; + angle C B O <_ang angle C B A by BCOncol, ANGLE, OintCBA, CBOref, AngleOrdering_DEF; + angle A C B <_ang angle C B A by BCAlessCBO, -, AngleOrderTransitivity, AngleSymmetry; + seg A B <__ seg A C by ACBncol, -, EuclidPropositionI_19; + qed by -, Distinct, SEGMENT, DFeqAB, SegmentTrichotomy3; +`;; + +let EuclidPropositionI_24 = thm `; + let O A C O' D F be point; + assume ~Collinear A O C /\ ~Collinear D O' F [H1]; + assume seg O' D === seg O A /\ seg O' F === seg O C [H2]; + assume angle D O' F <_ang angle A O C [H3]; + thus seg D F <__ seg A C + + proof + ~(O = A) /\ ~(O = C) /\ ~Collinear C O A /\ ~Collinear F O' D [Distinct] by H1, NonCollinearImpliesDistinct, CollinearSymmetry; + seg O A === seg O C \/ seg O A <__ seg O C \/ seg O C <__ seg O A by -, SEGMENT, SegmentTrichotomy; + cases by -; + suppose seg O A <__ seg O C \/ seg O A === seg O C; + qed by H1, H2, H3, -, EuclidPropositionI_24Help; + suppose seg O C <__ seg O A [H4]; + angle F O' D <_ang angle C O A by H3, AngleSymmetry; + qed by Distinct, H3, AngleSymmetry, H2, H4, EuclidPropositionI_24Help, SegmentSymmetry; + end; +`;; + +let EuclidPropositionI_25 = thm `; + let O A C O' D F be point; + assume ~Collinear A O C /\ ~Collinear D O' F [H1]; + assume seg O' D === seg O A /\ seg O' F === seg O C [H2]; + assume seg D F <__ seg A C [H3]; + thus angle D O' F <_ang angle A O C + + proof + ~(O = A) /\ ~(O = C) /\ ~(A = C) /\ ~(D = F) /\ ~(O' = D) /\ ~(O' = F) [Distinct] by H1, NonCollinearImpliesDistinct; + assume ~(angle D O' F <_ang angle A O C); + angle D O' F === angle A O C \/ angle A O C <_ang angle D O' F by H1, ANGLE, -, AngleTrichotomy; + cases by -; + suppose angle D O' F === angle A O C; + D,O',F cong A,O,C by H1, H2, -, SAS; + seg D F === seg A C by -, TriangleCong_DEF; + qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; + suppose angle A O C <_ang angle D O' F [Con]; + seg O A === seg O' D /\ seg O C === seg O' F [H2'] by Distinct, SEGMENT, H2, C2Symmetric; + seg A C <__ seg D F by H1, -, Con, EuclidPropositionI_24; + qed by Distinct, SEGMENT, -, H3, SegmentTrichotomy; + end; +`;; + +let AAS = thm `; + let A B C A' B' C' be point; + assume ~Collinear A B C /\ ~Collinear A' B' C' [H1]; + assume angle A B C === angle A' B' C' /\ angle B C A === angle B' C' A' [H2]; + assume seg A B === seg A' B' [H3]; + thus A,B,C cong A',B',C' + + proof + ~(A = B) /\ ~(B = C) /\ ~(B' = C') [Distinct] by H1, NonCollinearImpliesDistinct; + consider G such that + G IN ray B C DELETE B /\ seg B G === seg B' C' [Gexists] by Distinct, SEGMENT, C1; + ~(G = B) /\ B NOTIN open (G,C) /\ Collinear G B C [notGBC] by -, IN_DELETE, IN_Ray, CollinearSymmetry; + ~Collinear A B G /\ ~Collinear B G A [ABGncol] by H1, notGBC, CollinearSymmetry, NoncollinearityExtendsToLine; + ray B G = ray B C by Distinct, Gexists, RayWellDefined; + angle A B G = angle A B C by Distinct, -, Angle_DEF; + A,B,G cong A',B',C' [ABGcongA'B'C'] by H1, ABGncol, H3, SegmentSymmetry, H2, -, Gexists, SAS; + angle B G A === angle B' C' A' [BGAeqB'C'A'] by -, TriangleCong_DEF; + ~Collinear B C A /\ ~Collinear B' C' A' [BCAncol] by H1, CollinearSymmetry; + angle B' C' A' === angle B C A /\ angle B C A === angle B C A [BCArefl] by -, ANGLE, H2, C5Symmetric, C5Reflexive; + angle B G A === angle B C A [BGAeqBCA] by ABGncol, BCAncol, ANGLE, BGAeqB'C'A', -, C5Transitive; + cases; + suppose G = C; + qed by -, ABGcongA'B'C'; + suppose ~(G = C) [notGC]; + ~Collinear A C G /\ ~Collinear A G C [ACGncol] by H1, notGBC, -, CollinearSymmetry, NoncollinearityExtendsToLine; + C IN open (B,G) \/ G IN open (C,B) by notGBC, notGC, Distinct, B3', NOTIN; + cases by -; + suppose C IN open (B,G) ; + C IN open (G,B) /\ ray G C = ray G B [rGCrBG] by -, B1', IntervalRay; + angle A G C <_ang angle A C B by ACGncol, -, ExteriorAngle; + angle B G A <_ang angle B C A by -, rGCrBG, Angle_DEF, AngleSymmetry, AngleSymmetry; + qed by ABGncol, BCAncol, ANGLE, -, AngleSymmetry, BGAeqBCA, AngleTrichotomy; + suppose G IN open (C,B) [CGB]; + ray C G = ray C B /\ angle A C G <_ang angle A G B by -, IntervalRay, ACGncol, ExteriorAngle; + angle A C B <_ang angle B G A by -, Angle_DEF, AngleSymmetry; + angle B C A <_ang angle B C A by -, BCAncol, ANGLE, BGAeqBCA, AngleTrichotomy2, AngleSymmetry; + qed by -, BCArefl, AngleTrichotomy1; + end; + end; +`;; + +let ParallelSymmetry = thm `; + ! l k: point_set. l parallel k ==> k parallel l + by PARALLEL, INTER_COMM; +`;; + +let AlternateInteriorAngles = thm `; + let A B C E be point; + let l m t be point_set; + assume Line l /\ A IN l /\ E IN l [l_line]; + assume Line m /\ B IN m /\ C IN m [m_line]; + assume Line t /\ A IN t /\ B IN t [t_line]; + assume ~(A = E) /\ ~(B = C) /\ ~(A = B) /\ E NOTIN t /\ C NOTIN t [Distinct]; + assume ~(C,E same_side t) [Cnsim_tE]; + assume angle E A B === angle C B A [AltIntAngCong]; + thus l parallel m + + proof + ~Collinear E A B /\ ~Collinear C B A [EABncol] by t_line, Distinct, I1, Collinear_DEF, NOTIN; + B NOTIN l /\ A NOTIN m [notAmBl] by l_line, m_line, Collinear_DEF, -, NOTIN; + assume ~(l parallel m); + ~(l INTER m = {}) by -, l_line, m_line, PARALLEL; + consider G such that + G IN l /\ G IN m [Glm] by -, MEMBER_NOT_EMPTY, IN_INTER; + ~(G = A) /\ ~(G = B) /\ Collinear B G C /\ Collinear B C G /\ Collinear A E G /\ Collinear A G E [GnotAB] by -, notAmBl, NOTIN, m_line, l_line, Collinear_DEF; + ~Collinear A G B /\ ~Collinear B G A /\ G NOTIN t [AGBncol] by EABncol, CollinearSymmetry, -, NoncollinearityExtendsToLine, t_line, Collinear_DEF, NOTIN; + ~(E,C same_side t) [Ensim_tC] by t_line, -, Distinct, Cnsim_tE, SameSideSymmetric; + C IN m DELETE B /\ G IN m DELETE B [CGm_B] by m_line, Glm, Distinct, GnotAB, IN_DELETE; + E IN l DELETE A /\ G IN l DELETE A [EGm_A] by l_line, Glm, Distinct, GnotAB, IN_DELETE; + ~(G,E same_side t) + proof + assume G,E same_side t [Gsim_tE]; + A NOTIN open (G,E) [notGAE] by t_line, -, SameSide_DEF, NOTIN; + G IN ray A E DELETE A by Distinct, GnotAB, notGAE, IN_Ray, GnotAB, IN_DELETE; + ray A G = ray A E [rAGrAE] by Distinct, -, RayWellDefined; + ~(C,G same_side t) by t_line, AGBncol, Distinct, Gsim_tE, Cnsim_tE, SameSideTransitive; + C NOTIN ray B G /\ B IN open (C,G) by t_line, AGBncol, Distinct, -, RaySameSide, NOTIN, GnotAB, IN_DELETE, IN_Ray; + angle G A B <_ang angle C B A by AGBncol, -, B1', EuclidPropositionI_16; + angle E A B <_ang angle C B A by -, rAGrAE, Angle_DEF; + qed by EABncol, ANGLE, AltIntAngCong, -, AngleTrichotomy1; + G,C same_side t [Gsim_tC] by t_line, AGBncol, Distinct, -, Cnsim_tE, AtMost2Sides; + :: now we make a symmetric argument + B NOTIN open (G,C) [notGBC] by t_line, -, SameSide_DEF, NOTIN; + G IN ray B C DELETE B by Distinct, GnotAB, notGBC, IN_Ray, GnotAB, IN_DELETE; + ray B G = ray B C [rBGrBC] by Distinct, -, RayWellDefined; + angle C B A === angle E A B [flipAltIntAngCong] by EABncol, ANGLE, AltIntAngCong, C5Symmetric; + ~(E,G same_side t) by t_line, AGBncol, Distinct, Gsim_tC, Ensim_tC, SameSideTransitive; + E NOTIN ray A G /\ A IN open (E,G) by t_line, AGBncol, Distinct, -, RaySameSide, NOTIN, GnotAB, IN_Ray, IN_DELETE; + angle G B A <_ang angle E A B by AGBncol, -, B1', EuclidPropositionI_16; + angle C B A <_ang angle E A B by -, rBGrBC, Angle_DEF; + qed by EABncol, ANGLE, flipAltIntAngCong, -, AngleTrichotomy1; +`;; + +let EuclidPropositionI_28 = thm `; + let A B C D E F G H be point; + let l m t be point_set; + assume Line l /\ A IN l /\ B IN l /\ G IN l [l_line]; + assume Line m /\ C IN m /\ D IN m /\ H IN m [m_line]; + assume Line t /\ G IN t /\ H IN t [t_line]; + assume G NOTIN m /\ H NOTIN l [notGmHl]; + assume G IN open (A,B) /\ H IN open (C,D) [H1]; + assume G IN open (E,H) /\ H IN open (F,G) [H2]; + assume ~(D,A same_side t) [H3]; + assume angle E G B === angle G H D \/ angle B G H suppl angle G H D [H4]; + thus l parallel m + + proof + ~(A = G) /\ ~(G = B) /\ ~(H = D) /\ ~(E = G) /\ ~(G = H) /\ Collinear A G B /\ Collinear E G H [Distinct] by H1, H2, B1'; + ~Collinear H G A /\ ~Collinear G H D /\ A NOTIN t /\ D NOTIN t [HGAncol] by l_line, m_line, Distinct, I1, Collinear_DEF, notGmHl, NOTIN, t_line, Collinear_DEF; + ~Collinear B G H /\ ~Collinear A G E /\ ~Collinear E G B [BGHncol] by -, Distinct, CollinearSymmetry, NoncollinearityExtendsToLine; + angle A G H === angle D H G + proof + cases by H4; + suppose angle E G B === angle G H D [EGBeqGHD]; + angle E G B === angle H G A by BGHncol, H1, H2, VerticalAnglesCong; + angle H G A === angle E G B by BGHncol, HGAncol, ANGLE, -, C5Symmetric; + angle H G A === angle G H D by BGHncol, HGAncol, ANGLE, -, EGBeqGHD, C5Transitive; + qed by -, AngleSymmetry; + suppose angle B G H suppl angle G H D [BGHeqGHD]; + angle B G H suppl angle H G A by BGHncol, H1, B1', SupplementaryAngles_DEF; + qed by -, BGHeqGHD, AngleSymmetry, SupplementUnique, AngleSymmetry; + end; + qed by l_line, m_line, t_line, Distinct, HGAncol, H3, -, AlternateInteriorAngles; +`;; + +let OppositeSidesCongImpliesParallelogram = thm `; + let A B C D be point; + assume Quadrilateral A B C D [H1]; + assume seg A B === seg C D /\ seg B C === seg D A [H2]; + thus Parallelogram A B C D + + proof + ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ + ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + consider a c such that + Line a /\ A IN a /\ B IN a /\ + Line c /\ C IN c /\ D IN c [ac_line] by TetraABCD, I1; + consider b d such that + Line b /\ B IN b /\ C IN b /\ + Line d /\ D IN d /\ A IN d [bd_line] by TetraABCD, I1; + consider l such that + Line l /\ A IN l /\ C IN l [l_line] by TetraABCD, I1; + consider m such that + Line m /\ B IN m /\ D IN m [m_line] by TetraABCD, I1; + B NOTIN l /\ D NOTIN l /\ A NOTIN m /\ C NOTIN m [notBDlACm] by l_line, m_line, TetraABCD, Collinear_DEF, NOTIN; + seg A C === seg C A /\ seg B D === seg D B [seg_refl] by TetraABCD, SEGMENT, C2Reflexive, SegmentSymmetry; + A,B,C cong C,D,A by TetraABCD, H2, -, SSS; + angle B C A === angle D A C /\ angle C A B === angle A C D [BCAeqDAC] by -, TriangleCong_DEF; + seg C D === seg A B [CDeqAB] by TetraABCD, SEGMENT, H2, C2Symmetric; + B,C,D cong D,A,B by TetraABCD, H2, -, seg_refl, SSS; + angle C D B === angle A B D /\ angle D B C === angle B D A [CDBeqABD] by -, TriangleCong_DEF; + ~(B,D same_side l) \/ ~(A,C same_side m) by H1, l_line, m_line, FiveChoicesQuadrilateral; + cases by -; + suppose ~(B,D same_side l); + ~(D,B same_side l) by l_line, notBDlACm, -, SameSideSymmetric; + a parallel c /\ b parallel d by ac_line, l_line, TetraABCD, notBDlACm, -, BCAeqDAC, AngleSymmetry, AlternateInteriorAngles, bd_line, BCAeqDAC; + qed by H1, ac_line, bd_line, -, Parallelogram_DEF; + suppose ~(A,C same_side m); + b parallel d /\ c parallel a by bd_line, m_line, TetraABCD, notBDlACm, -, CDBeqABD, AngleSymmetry, AlternateInteriorAngles, ac_line, CDBeqABD; + qed by H1, ac_line, bd_line, -, ParallelSymmetry, Parallelogram_DEF; + end; +`;; + +let OppositeAnglesCongImpliesParallelogramHelp = thm `; + let A B C D be point; + let a c be point_set; + assume Quadrilateral A B C D [H1]; + assume angle A B C === angle C D A /\ angle D A B === angle B C D [H2]; + assume Line a /\ A IN a /\ B IN a [a_line]; + assume Line c /\ C IN c /\ D IN c [c_line]; + thus a parallel c + + proof + ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(B = C) /\ ~(B = D) /\ ~(C = D) /\ + ~Collinear A B C /\ ~Collinear B C D /\ ~Collinear C D A /\ ~Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + angle C D A === angle A B C /\ angle B C D === angle D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; + consider l m such that + Line l /\ A IN l /\ C IN l /\ + Line m /\ B IN m /\ D IN m [lm_line] by TetraABCD, I1; + consider b d such that + Line b /\ B IN b /\ C IN b /\ Line d /\ D IN d /\ A IN d [bd_line] by TetraABCD, I1; + A NOTIN c /\ B NOTIN c /\ A NOTIN b /\ D NOTIN b /\ B NOTIN d /\ C NOTIN d [point_off_line] by c_line, bd_line, Collinear_DEF, TetraABCD, NOTIN; + ~(A IN int_triangle B C D \/ B IN int_triangle C D A \/ + C IN int_triangle D A B \/ D IN int_triangle A B C) + proof + assume A IN int_triangle B C D \/ B IN int_triangle C D A \/ + C IN int_triangle D A B \/ D IN int_triangle A B C; + angle B C D <_ang angle D A B \/ angle C D A <_ang angle A B C \/ + angle D A B <_ang angle B C D \/ angle A B C <_ang angle C D A by TetraABCD, -, EuclidPropositionI_21; + qed by -, H2', H2, AngleTrichotomy1; + ConvexQuadrilateral A B C D by H1, lm_line, -, FiveChoicesQuadrilateral; + A IN int_angle B C D /\ B IN int_angle C D A /\ + C IN int_angle D A B /\ D IN int_angle A B C [AintBCD] by -, ConvexQuad_DEF; + B,A same_side c /\ B,C same_side d [Bsim_cA] by c_line, bd_line, -, InteriorUse; + A,D same_side b [Asim_bD] by bd_line, c_line, AintBCD, InteriorUse; + assume ~(a parallel c); + consider G such that + G IN a /\ G IN c [Gac] by -, a_line, c_line, PARALLEL, MEMBER_NOT_EMPTY, IN_INTER; + Collinear A B G /\ Collinear D G C /\ Collinear C G D [ABGcol] by a_line, -, Collinear_DEF, c_line; + ~(G = A) /\ ~(G = B) /\ ~(G = C) /\ ~(G = D) [GnotABCD] by Gac, ABGcol, TetraABCD, CollinearSymmetry, Collinear_DEF; + ~Collinear B G C /\ ~Collinear A D G [BGCncol] by c_line, Gac, GnotABCD, I1, Collinear_DEF, point_off_line, NOTIN; + ~Collinear B C G /\ ~Collinear G B C /\ ~Collinear G A D /\ ~Collinear A G D [BCGncol] by -, CollinearSymmetry; + G NOTIN b /\ G NOTIN d [notGb] by bd_line, Collinear_DEF, BGCncol, NOTIN; + G NOTIN open (B,A) [notBGA] by Bsim_cA, Gac, SameSide_DEF, NOTIN; + B NOTIN open (A,G) [notABG] + proof + assume ~(B NOTIN open (A,G)); + B IN open (A,G) [ABG] by -, NOTIN; + ray A B = ray A G [rABrAG] by -, IntervalRay; + ~(A,G same_side b) by bd_line, ABG, SameSide_DEF; + ~(D,G same_side b) by bd_line, point_off_line, notGb, Asim_bD, -, SameSideTransitive; + D NOTIN ray C G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, NOTIN; + C IN open (D,G) [DCG] by GnotABCD, ABGcol, -, IN_Ray, NOTIN; + consider M such that + D IN open (C,M) [CDM] by TetraABCD, B2'; + D IN open (G,M) [GDM] by -, B1', DCG, TransitivityBetweennessHelp; + angle C D A suppl angle A D M /\ angle A B C suppl angle C B G by TetraABCD, CDM, ABG, SupplementaryAngles_DEF; + angle M D A === angle G B C [MDAeqGBC] by -, H2', SupplementsCongAnglesCong, AngleSymmetry; + angle G A D <_ang angle M D A /\ angle G B C <_ang angle D C B by BCGncol, BGCncol, GDM, DCG, B1', EuclidPropositionI_16; + angle G A D <_ang angle D C B by -, BCGncol, ANGLE, MDAeqGBC, AngleTrichotomy2, AngleOrderTransitivity; + angle D A B <_ang angle B C D by -, rABrAG, Angle_DEF, AngleSymmetry; + qed by -, H2, AngleTrichotomy1; + A NOTIN open (G,B) + proof + assume ~(A NOTIN open (G,B)); + A IN open (B,G) [BAG] by -, B1', NOTIN; + ray B A = ray B G [rBArBG] by -, IntervalRay; + ~(B,G same_side d) by bd_line, BAG, SameSide_DEF; + ~(C,G same_side d) by bd_line, point_off_line, notGb, Bsim_cA, -, SameSideTransitive; + C NOTIN ray D G by bd_line, notGb, -, RaySameSide, TetraABCD, IN_DELETE, NOTIN; + D IN open (C,G) [CDG] by GnotABCD, ABGcol, -, IN_Ray, NOTIN; + consider M such that + C IN open (D,M) [DCM] by B2', TetraABCD; + C IN open (G,M) [GCM] by -, B1', CDG, TransitivityBetweennessHelp; + angle B C D suppl angle M C B /\ angle D A B suppl angle G A D by TetraABCD, CollinearSymmetry, DCM, BAG, SupplementaryAngles_DEF, AngleSymmetry; + angle M C B === angle G A D [GADeqMCB] by -, H2', SupplementsCongAnglesCong; + angle G B C <_ang angle M C B /\ angle G A D <_ang angle C D A by BGCncol, GCM, BCGncol, CDG, B1', EuclidPropositionI_16; + angle G B C <_ang angle C D A by -, BCGncol, ANGLE, GADeqMCB, AngleTrichotomy2, AngleOrderTransitivity; + angle A B C <_ang angle C D A by -, rBArBG, Angle_DEF; + qed by -, H2, AngleTrichotomy1; + qed by TetraABCD, GnotABCD, ABGcol, notABG, notBGA, -, B3', NOTIN; +`;; + +let OppositeAnglesCongImpliesParallelogram = thm `; + let A B C D be point; + assume Quadrilateral A B C D [H1]; + assume angle A B C === angle C D A /\ angle D A B === angle B C D [H2]; + thus Parallelogram A B C D + + proof + Quadrilateral B C D A [QuadBCDA] by H1, QuadrilateralSymmetry; + ~(A = B) /\ ~(B = C) /\ ~(C = D) /\ ~(D = A) /\ ~Collinear B C D /\ ~Collinear D A B [TetraABCD] by H1, Quadrilateral_DEF, Tetralateral_DEF; + angle B C D === angle D A B [H2'] by TetraABCD, ANGLE, H2, C5Symmetric; + consider a such that + Line a /\ A IN a /\ B IN a [a_line] by TetraABCD, I1; + consider b such that + Line b /\ B IN b /\ C IN b [b_line] by TetraABCD, I1; + consider c such that + Line c /\ C IN c /\ D IN c [c_line] by TetraABCD, I1; + consider d such that + Line d /\ D IN d /\ A IN d [d_line] by TetraABCD, I1; + qed by H1, QuadBCDA, H2, H2', a_line, b_line, c_line, d_line, OppositeAnglesCongImpliesParallelogramHelp, Parallelogram_DEF; +`;; + + +let P = new_axiom + `! P l. Line l /\ P NOTIN l ==> ?! m. Line m /\ P IN m /\ m parallel l`;; + +new_constant("mu",`:point_set->real`);; + +let AMa = new_axiom + `! alpha. Angle alpha ==> &0 < mu alpha /\ mu alpha < &180`;; + +let AMb = new_axiom + `! alpha. Right alpha ==> mu alpha = &90`;; + +let AMc = new_axiom + `! alpha beta. Angle alpha /\ Angle beta /\ alpha === beta ==> mu alpha = mu beta`;; + +let AMd = new_axiom + `! A O B P. P IN int_angle A O B ==> mu (angle A O B) = mu (angle A O P) + mu (angle P O B)`;; + + +let ConverseAlternateInteriorAngles = thm `; + let A B C E be point; + let l m t be point_set; + assume Line l /\ A IN l /\ E IN l [l_line]; + assume Line m /\ B IN m /\ C IN m [m_line]; + assume Line t /\ A IN t /\ B IN t [t_line]; + assume ~(A = E) /\ ~(B = C) /\ ~(A = B) /\ E NOTIN t /\ C NOTIN t [Distinct]; + assume ~(C,E same_side t) [Cnsim_tE]; + assume l parallel m [para_lm]; + thus angle E A B === angle C B A + + proof + ~Collinear C B A by t_line, Distinct, I1, Collinear_DEF, NOTIN, ANGLE; + A NOTIN m /\ Angle (angle C B A) [notAm] by m_line, -, Collinear_DEF, NOTIN, ANGLE; + consider D such that + ~(A = D) /\ D NOTIN t /\ ~(C,D same_side t) /\ seg A D === seg A E /\ angle B A D === angle C B A [Dexists] by -, Distinct, t_line, C4OppositeSide; + consider k such that + Line k /\ A IN k /\ D IN k [k_line] by Distinct, I1; + k parallel m by -, m_line, t_line, Dexists, Distinct, AngleSymmetry, AlternateInteriorAngles; + k = l by m_line, notAm, l_line, k_line, -, para_lm, P; + D,E same_side t /\ A NOTIN open (D,E) /\ Collinear A E D by t_line, Distinct, Dexists, Cnsim_tE, AtMost2Sides, SameSide_DEF, NOTIN, -, k_line, l_line, Collinear_DEF; + ray A D = ray A E by Distinct, -, IN_Ray, Dexists, IN_DELETE, RayWellDefined; + qed by -, Dexists, AngleSymmetry, Angle_DEF; +`;; + +let HilbertTriangleSum = thm `; + let A B C be point; + assume ~Collinear A B C [ABCncol]; + thus ? E F. B IN open (E,F) /\ C IN int_angle A B F /\ + angle E B A === angle C A B /\ angle C B F === angle B C A + + proof + ~(A = B) /\ ~(A = C) /\ ~(B = C) /\ ~Collinear C A B [Distinct] by ABCncol, NonCollinearImpliesDistinct, CollinearSymmetry; + consider l such that + Line l /\ A IN l /\ C IN l [l_line] by Distinct, I1; + consider x such that + Line x /\ A IN x /\ B IN x [x_line] by Distinct, I1; + consider y such that + Line y /\ B IN y /\ C IN y [y_line] by Distinct, I1; + C NOTIN x [notCx] by x_line, ABCncol, Collinear_DEF, NOTIN; + Angle (angle C A B) by ABCncol, CollinearSymmetry, ANGLE; + consider E such that + ~(B = E) /\ E NOTIN x /\ ~(C,E same_side x) /\ seg B E === seg A B /\ angle A B E === angle C A B [Eexists] by -, Distinct, x_line, notCx, C4OppositeSide; + consider m such that + Line m /\ B IN m /\ E IN m [m_line] by -, I1, IN_DELETE; + angle E B A === angle C A B [EBAeqCAB] by Eexists, AngleSymmetry; + m parallel l [para_lm] by m_line, l_line, x_line, Eexists, Distinct, notCx, -, AlternateInteriorAngles; + m INTER l = {} [lm0] by -, PARALLEL; + C NOTIN m /\ A NOTIN m [notACm] by -, l_line, INTER_COMM, DisjointOneNotOther; + consider F such that + B IN open (E,F) [EBF] by Eexists, B2'; + ~(B = F) /\ F IN m [EBF'] by -, B1', m_line, BetweenLinear; + ~Collinear A B F /\ F NOTIN x [ABFncol] by m_line, -, I1, Collinear_DEF, notACm, NOTIN, x_line; + ~(E,F same_side x) /\ ~(E,F same_side y) [Ensim_yF] by EBF, x_line, y_line, SameSide_DEF; + C,F same_side x [Csim_xF] by x_line, notCx, Eexists, ABFncol, Eexists, -, AtMost2Sides; + m INTER open(C,A) = {} by l_line, BetweenLinear, SUBSET, SET_RULE, lm0, SUBSET_EMPTY; + C,A same_side m by m_line, -, SameSide_DEF, SET_RULE; + C IN int_angle A B F [CintABF] by ABFncol, x_line, m_line, EBF', notCx, notACm, Csim_xF, -, IN_InteriorAngle; + A IN int_angle C B E by EBF, B1', -, InteriorAngleSymmetry, InteriorReflectionInterior; + A NOTIN y /\ A,E same_side y [Asim_yE] by y_line, m_line, -, InteriorUse; + E NOTIN y /\ F NOTIN y [notEFy] by y_line, m_line, EBF', Eexists, EBF', I1, Collinear_DEF, notACm, NOTIN; + E,A same_side y by y_line, -, Asim_yE, SameSideSymmetric; + ~(A,F same_side y) [Ansim_yF] by y_line, notEFy, Asim_yE, -, Ensim_yF, SameSideTransitive; + angle F B C === angle A C B by m_line, EBF', l_line, y_line, EBF', Distinct, notEFy, Asim_yE, Ansim_yF, para_lm, ConverseAlternateInteriorAngles; + qed by EBF, CintABF, EBAeqCAB, -, AngleSymmetry; +`;; + +let EuclidPropositionI_13 = thm `; + let A O B A' be point; + assume ~Collinear A O B [H1]; + assume O IN open (A,A') [H2]; + thus mu (angle A O B) + mu (angle B O A') = &180 + + proof + cases; + suppose Right (angle A O B); + Right (angle B O A') /\ mu (angle A O B) = &90 /\ mu (angle B O A') = &90 by H1, H2, -, RightImpliesSupplRight, AMb; + qed by -, REAL_ARITH; + suppose ~Right (angle A O B) [notRightAOB]; + ~(A = O) /\ ~(O = B) [Distinct] by H1, NonCollinearImpliesDistinct; + consider l such that + Line l /\ O IN l /\ A IN l /\ A' IN l [l_line] by -, I1, H2, BetweenLinear; + B NOTIN l [notBl] by -, Distinct, I1, Collinear_DEF, H1, NOTIN; + consider F such that + Right (angle O A F) /\ Angle (angle O A F) [RightOAF] by Distinct, EuclidPropositionI_11, RightImpliesAngle; + ?! r. Ray r /\ ? E. ~(O = E) /\ r = ray O E /\ E NOTIN l /\ E,B same_side l /\ angle A O E === angle O A F by -, Distinct, l_line, notBl, C4; + consider E such that + ~(O = E) /\ E NOTIN l /\ E,B same_side l /\ angle A O E === angle O A F [Eexists] by -; + ~Collinear A O E [AOEncol] by l_line, Distinct, I1, Collinear_DEF, -, NOTIN; + Right (angle A O E) [RightAOE] by -, ANGLE, RightOAF, Eexists, CongRightImpliesRight; + Right (angle E O A') /\ mu (angle A O E) = &90 /\ mu (angle E O A') = &90 [RightEOA'] by AOEncol, H2, -, RightImpliesSupplRight, AMb; + ~(angle A O B === angle A O E) by notRightAOB, H1, ANGLE, RightAOE, CongRightImpliesRight; + ~(angle A O B = angle A O E) by H1, AOEncol, ANGLE, -, C5Reflexive; + ~(ray O B = ray O E) by -, Angle_DEF; + B NOTIN ray O E /\ O NOTIN open (B,E) by Distinct, -, Eexists, RayWellDefined, IN_DELETE, NOTIN, l_line, B1', SameSide_DEF; + ~Collinear O E B by -, Eexists, IN_Ray, NOTIN; + E IN int_angle A O B \/ B IN int_angle A O E by Distinct, l_line, Eexists, notBl, AngleOrdering, -, CollinearSymmetry, InteriorAngleSymmetry; + cases by -; + suppose E IN int_angle A O B [EintAOB]; + B IN int_angle E O A' by H2, -, InteriorReflectionInterior; + mu (angle A O B) = mu (angle A O E) + mu (angle E O B) /\ + mu (angle E O A') = mu (angle E O B) + mu (angle B O A') by EintAOB, -, AMd; + qed by -, RightEOA', REAL_ARITH; + suppose B IN int_angle A O E [BintAOE]; + E IN int_angle B O A' by H2, -, InteriorReflectionInterior; + mu (angle A O E) = mu (angle A O B) + mu (angle B O E) /\ + mu (angle B O A') = mu (angle B O E) + mu (angle E O A') by BintAOE, -, AMd; + qed by -, RightEOA', REAL_ARITH; + end; + end; +`;; + +let TriangleSum = thm `; + let A B C be point; + assume ~Collinear A B C [ABCncol]; + thus mu (angle A B C) + mu (angle B C A) + mu (angle C A B) = &180 + + proof + ~Collinear C A B /\ ~Collinear B C A [CABncol] by ABCncol, CollinearSymmetry; + consider E F such that + B IN open (E,F) /\ C IN int_angle A B F /\ angle E B A === angle C A B /\ angle C B F === angle B C A [EBF] by ABCncol, HilbertTriangleSum; + ~Collinear C B F /\ ~Collinear A B F /\ Collinear E B F /\ ~(B = E) [CBFncol] by -, InteriorAngleSymmetry, InteriorEZHelp, IN_InteriorAngle, B1', CollinearSymmetry; + ~Collinear E B A [EBAncol] by CollinearSymmetry, -, NoncollinearityExtendsToLine; + mu (angle A B F) = mu (angle A B C) + mu (angle C B F) [muCintABF] by EBF, AMd; + mu (angle E B A) + mu (angle A B F) = &180 [suppl180] by EBAncol, EBF, EuclidPropositionI_13; + mu (angle C A B) = mu (angle E B A) /\ mu (angle B C A) = mu (angle C B F) by CABncol, EBAncol, CBFncol, ANGLE, EBF, AMc; + qed by suppl180, muCintABF, -, REAL_ARITH; +`;; + diff --git a/RichterHilbertAxiomGeometry/miz3/make.ml b/RichterHilbertAxiomGeometry/miz3/make.ml new file mode 100644 index 0000000..8fc517f --- /dev/null +++ b/RichterHilbertAxiomGeometry/miz3/make.ml @@ -0,0 +1,3 @@ +#load "unix.cma";; +loadt "miz3/miz3.ml";; +loadt "RichterHilbertAxiomGeometry/miz3/HilbertAxiom.ml";; diff --git a/RichterHilbertAxiomGeometry/readable.ml b/RichterHilbertAxiomGeometry/readable.ml new file mode 100644 index 0000000..5161b34 --- /dev/null +++ b/RichterHilbertAxiomGeometry/readable.ml @@ -0,0 +1,756 @@ +(* ========================================================================= *) +(* Miz3 interface for readable HOL Light tactics formal proofs *) +(* *) +(* (c) Copyright, Bill Richter 2013 *) +(* Distributed under the same license as HOL Light *) +(* *) +(* The primary meaning of readability is explained in the HOL Light tutorial *) +(* on page 81 after the proof of NSQRT_2 (ported below), *) +(* "We would like to claim that this proof can be read in isolation, without *) +(* running it in HOL. For each step, every fact we used is clearly labelled *) +(* somewhere else in the proof, and every assumption is given explicitly." *) +(* However readability is often improved by using tactics constructs like *) +(* SIMP_TAC and MATCH_MP_TAC, which allow facts and assumptions to not be *) +(* given explicitly, so as to not lose sight of the proof. Readability is *) +(* improved by a miz3 interface with few type annotations, back-quotes or *) +(* double-quotes, and allowing HOL4/Isabelle math characters, e.g. *) +(* ⇒ ⇔ ∧ ∨ ¬ ∀ ∃ ∈ ∉ α β γ λ θ μ ⊂ ∩ ∪ ∅ ━ ≡ ≅ ∡ ∥ ∏ ∘ → ╪ . *) +(* We use ideas for readable formal proofs due to John Harrison ("Towards *) +(* more readable proofs" of the tutorial and Examples/mizar.ml), Freek *) +(* Wiedijk (Mizarlight/miz2a.ml, miz3/miz3.ml and arxiv.org/pdf/1201.3601 *) +(* "A Synthesis of Procedural and Declarative Styles of Interactive *) +(* Theorem Proving"), Marco Maggesi (author of tactic constructs *) +(* INTRO_TAC, DESTRUCT_TAC & HYP), Petros Papapanagiotou (coauthor of *) +(* Isabelle Light), Vincent Aravantinos (author of the Q-module *) +(* https://github.com/aravantv/HOL-Light-Q) and Mark Adams (author of HOL *) +(* Zero and Tactician). These readability ideas yield the miz3-type *) +(* declarative constructs assume, consider and case_split. The semantics of *) +(* readable.ml is clear from an obvious translation to HOL Light proofs. An *) +(* interactive mode is useful in writing, debugging and displaying proofs. *) +(* *) +(* The construct "case_split" reducing the goal to various cases given by *) +(* "suppose" clauses. The construct "proof" [...] "qed" allows arbitrarily *) +(* long proofs, which can be arbitrarily nested with other case_split and *) +(* proof/qed constructs. THENL is only implemented implicitly in case_split *) +(* (also eq_tac and conj_tac), and this requires adjustments, such as using *) +(* MATCH_MP_TAC num_INDUCTION instead of INDUCT_TAC. *) +(* ========================================================================= *) + +(* The Str library defines regexp functions needed to process strings. *) + +#load "str.cma";; + +(* parse_qproof uses system.ml quotexpander feature designed for miz3.ml to *) +(* turn backquoted expression `;[...]` into a string with no newline or *) +(* backslash problems. Note that miz3.ml defines parse_qproof differently. *) + +let parse_qproof s = (String.sub s 1 (String.length s - 1));; + +(* Allows HOL4 and Isabelle style math characters. *) + +let CleanMathFontsForHOL_Light s = + let rec clean s loStringPairs = + match loStringPairs with + | [] -> s + | hd :: tl -> + let s = Str.global_replace (Str.regexp (fst hd)) (snd hd) s in + clean s tl in + clean s ["⇒","==>"; "⇔","<=>"; "∧","/\\ "; "∨","\\/"; "¬","~"; + "∀","!"; "∃","?"; "∈","IN"; "∉","NOTIN"; + "α","alpha"; "β","beta"; "γ","gamma"; "λ","\\ "; "θ","theta"; "μ","mu"; + "⊂","SUBSET"; "∩","INTER"; "∪","UNION"; "∅","{}"; "━","DIFF"; + "≡","==="; "≅","cong"; "∡","angle"; "∥","parallel"; + "∏","prod"; "∘","_o_"; "→","--->"; "╪","INSERT"];; + +(* printReadExn prints uncluttered error messages via Readable_fail. This *) +(* is due to Mark Adams, who also explained Roland Zumkeller's exec below. *) + +exception Readable_fail of string;; + +let printReadExn e = + match e with + | Readable_fail s + -> print_string s + | _ -> print_string (Printexc.to_string e);; + +#install_printer printReadExn;; + +(* From update_database.ml: Execute any OCaml expression given as a string. *) + +let exec = ignore o Toploop.execute_phrase false Format.std_formatter + o !Toploop.parse_toplevel_phrase o Lexing.from_string;; + +(* Following miz3.ml, exec_thm returns the theorem representing a string, so *) +(* exec_thm "FORALL_PAIR_THM";; returns *) +(* val it : thm = |- !P. (!p. P p) <=> (!p1 p2. P (p1,p2)) *) +(* Extra error-checking is done to rule out the possibility of the theorem *) +(* string ending with a semicolon. *) + +let thm_ref = ref TRUTH;; +let tactic_ref = ref ALL_TAC;; +let thmtactic_ref = ref MATCH_MP_TAC;; +let thmlist_tactic_ref = ref REWRITE_TAC;; +let termlist_thm_thm_ref = ref SPECL;; +let thm_thm_ref = ref GSYM;; +let term_thm_ref = ref ARITH_RULE;; +let thmlist_term_thm_ref = ref MESON;; + +let exec_thm s = + if Str.string_match (Str.regexp "[^;]*;") s 0 then raise Noparse + else + try exec ("thm_ref := (("^ s ^"): thm);;"); + !thm_ref + with _ -> raise Noparse;; + +let exec_tactic s = + try exec ("tactic_ref := (("^ s ^"): tactic);;"); !tactic_ref + with _ -> raise Noparse;; + +let exec_thmlist_tactic s = + try + exec ("thmlist_tactic_ref := (("^ s ^"): thm list -> tactic);;"); + !thmlist_tactic_ref + with _ -> raise Noparse;; + +let exec_thmtactic s = + try exec ("thmtactic_ref := (("^ s ^"): thm -> tactic);;"); !thmtactic_ref + with _ -> raise Noparse;; + +let exec_termlist_thm_thm s = + try exec ("termlist_thm_thm_ref := (("^ s ^"): (term list -> thm -> thm));;"); + !termlist_thm_thm_ref + with _ -> raise Noparse;; + +let exec_thm_thm s = + try exec ("thm_thm_ref := (("^ s ^"): (thm -> thm));;"); + !thm_thm_ref + with _ -> raise Noparse;; + +let exec_term_thm s = + try exec ("term_thm_ref := (("^ s ^"): (term -> thm));;"); + !term_thm_ref + with _ -> raise Noparse;; + +let exec_thmlist_term_thm s = + try exec ("thmlist_term_thm_ref := (("^ s ^"): (thm list ->term -> thm));;"); + !thmlist_term_thm_ref + with _ -> raise Noparse;; + +(* make_env and parse_env_string (following parse_term from parser.ml, *) +(* Mizarlight/miz2a.ml and https://github.com/aravantv/HOL-Light-Q) turn a *) +(* string into a term with types inferred by the goal and assumption list. *) + +let (make_env: goal -> (string * pretype) list) = + fun (asl, w) -> map ((fun (s, ty) -> (s, pretype_of_type ty)) o dest_var) + (freesl (w::(map (concl o snd) asl)));; + +let parse_env_string env s = + let (ptm, l) = (parse_preterm o lex o explode) s in + if l = [] then (term_of_preterm o retypecheck env) ptm + else raise (Readable_fail + ("Unparsed input at the end of the term\n" ^ s));; + +(* versions of new_constant, parse_as_infix, new_definition and new_axiom *) + +let NewConstant (x, y) = new_constant(CleanMathFontsForHOL_Light x, y);; + +let ParseAsInfix (x, y) = parse_as_infix (CleanMathFontsForHOL_Light x, y);; + +let NewDefinition s = + new_definition (parse_env_string [] (CleanMathFontsForHOL_Light s));; + +let NewAxiom s = + new_axiom (parse_env_string [] (CleanMathFontsForHOL_Light s));; + +(* String versions without type annotations of SUBGOAL_THEN, SUBGOAL_TAC, *) +(* intro_TAC, EXISTS_TAC, X_GEN_TAC, and EXISTS_TAC, and also new miz3-type *) +(* tactic constructs assume, consider and case_split. *) + +(* subgoal_THEN stm ttac gl = (SUBGOAL_THEN t ttac) gl, *) +(* where stm is a string that turned into a statement t by make_env and *) +(* parse_env_string, using the goal gl. We call stm a string statement. *) +(* ttac is often the thm_tactic (LABEL_TAC string) or (DESTRUCT_TAC string). *) + +let subgoal_THEN stm ttac gl = + SUBGOAL_THEN (parse_env_string (make_env gl) stm) ttac gl;; + +(* subgoal_TAC stm lab tac gl = (SUBGOAL_TAC lab t [tac]) gl, *) +(* exists_TAC stm gl = (EXISTS_TAC t) gl, and *) +(* X_gen_TAC svar gl = (X_GEN_TAC v) gl, where *) +(* stm is a string statement which is turned into a statement t by make_env, *) +(* parse_env_string and the goal gl. Similarly string svar is turned into a *) +(* variable v. *) +(* X_genl_TAC combines X_gen_TAC and GENL. Since below in StepToTactic the *) +(* string-term list uses whitespace as the delimiter and no braces, there is *) +(* no reason in readable.ml proofs to use X_gen_TAC instead X_genl_TAC. *) +(* intro_TAC is INTRO_TAC with the delimiter ";" replaced with",". *) +(* eq_tac string tac *) +(* requires the goal to be an iff statement of the form x ⇔ y and then *) +(* performs an EQ_TAC. If string = "Right", then the tactic tac proves the *) +(* implication y ⇒ x, and the goal becomes the other implication x ⇒ y. *) +(* If string = "Left", then tac proves x ⇒ y and the goal becomes y ⇒ x. *) +(* conj_tac string tac *) +(* requires the goal to be a conjunction statement x ∧ y and then performs a *) +(* CONJ_TAC. If string = "Left" then the tactic tac proves x, and the goal *) +(* becomes y. If string = "Right", tac proves y and the new goal is x. *) +(* consider svars stm lab tac *) +(* defines new variables given by the string svars = "v1 v2 ... vn" and the *) +(* string statement stm, which subgoal_THEN turns into statement t, labeled *) +(* by lab. The tactic tac proves the existential statement ?v1 ... vn. t. *) +(* case_split sDestruct tac listofDisj listofTac *) +(* reduces the goal to n cases which are solved separately. listofDisj is a *) +(* list of strings [st_1;...; st_n] whose disjunction st_1 \/...\/ st_n is a *) +(* string statement proved by tactic tac. listofTac is a list of tactics *) +(* [tac_1;...; tac_n] which prove the statements st_1,..., st_n. The string *) +(* sDestruct must have the form "lab_1 |...| lab_n", and lab_i is a label *) +(* used by tac_i to prove st_i. Each lab_i must be a nonempty string. *) +(* assume *) +(* is a version of ASM_CASES_TAC, and performs proofs by contradiction and *) +(* binary case_splits where one of the forks has a short proof. In general, *) +(* assume statement lab tac *) +(* turns the string statement into a term t, with the tactic tac a proof of *) +(* ¬t ⇒ w, where w is the goal. There is a new assumption t labeled lab, and *) +(* the new goal is the result of applying the tactic SIMP_TAC [t] to w. *) +(* It's recommended to only use assume with a short proof tac. Three uses *) +(* of assume arise when t = ¬w or t = ¬α, with w = α ∨ β or w = β ∨ α. *) +(* In all three cases write *) +(* assume statement [lab] by fol; *) +(* and the new goal will be F (false) or β respectively, as a result of the *) +(* SIMP_TAC [t]. So do not use assume if SIMP_TAC [t] is disadvantageous. *) + +let subgoal_TAC stm lab tac gl = + SUBGOAL_TAC lab (parse_env_string (make_env gl) stm) [tac] gl;; + +let exists_TAC stm gl = + EXISTS_TAC (parse_env_string (make_env gl) stm) gl;; + +let X_gen_TAC svar (asl, w as gl) = + let vartype = (snd o dest_var o fst o dest_forall) w in + X_GEN_TAC (mk_var (svar, vartype)) gl;; + +let X_genl_TAC svarlist = MAP_EVERY X_gen_TAC svarlist;; + +let intro_TAC s = INTRO_TAC (Str.global_replace (Str.regexp ",") ";" s);; + +let assume statement lab tac (asl, w as gl) = + let t = parse_env_string (make_env gl) statement in + (DISJ_CASES_THEN (LABEL_TAC lab) (SPEC t EXCLUDED_MIDDLE) THENL + [ALL_TAC; FIRST_ASSUM MP_TAC THEN tac] THEN HYP SIMP_TAC lab []) gl;; + +let eq_tac string tac = + if string = "Right" then CONV_TAC SYM_CONV THEN EQ_TAC THENL [tac; ALL_TAC] + else if string = "Left" then EQ_TAC THENL [tac; ALL_TAC] + else raise (Readable_fail + ("eq_tac requires " ^ string ^" to be either Left or Right"));; + +let conj_tac string tac = + if string = "Right" then ONCE_REWRITE_TAC [CONJ_SYM] THEN + CONJ_TAC THENL [tac; ALL_TAC] + else if string = "Left" then CONJ_TAC THENL [tac; ALL_TAC] + else raise (Readable_fail + ("conj_tac requires " ^ string ^" to be either Left or Right"));; + +let consider svars stm lab tac = + subgoal_THEN ("?"^ svars ^ ". "^ stm) + (DESTRUCT_TAC ("@"^ svars ^ "."^ lab)) THENL [tac; ALL_TAC];; + +let case_split sDestruct tac listofDisj listofTac = + let disjunction = itlist + (fun s t -> if t = "" then "("^ s ^")" else "("^ s ^") \\/ "^ t) + listofDisj "" in + subgoal_TAC disjunction "" tac THEN + FIRST_X_ASSUM (DESTRUCT_TAC sDestruct) THENL listofTac;; + +(* Following the HOL Light tutorial section "Towards more readable proofs." *) + +let fol = MESON_TAC;; +let rewrite = REWRITE_TAC;; +let simplify = SIMP_TAC;; +let set = SET_TAC;; +let rewriteR = GEN_REWRITE_TAC (RAND_CONV);; +let rewriteL = GEN_REWRITE_TAC (LAND_CONV);; +let rewriteI = GEN_REWRITE_TAC I;; +let rewriteRLDepth = GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o DEPTH_CONV);; +let TACtoThmTactic tac = fun ths -> MAP_EVERY MP_TAC ths THEN tac;; +let arithmetic = TACtoThmTactic ARITH_TAC;; +let real_arithmetic = TACtoThmTactic REAL_ARITH_TAC;; +let num_ring = TACtoThmTactic (CONV_TAC NUM_RING);; +let real_ring = TACtoThmTactic (CONV_TAC REAL_RING);; + +let ws = "[ \t\n]+";; +let ws0 = "[ \t\n]*";; + +let StringRegexpEqual r s = Str.string_match r s 0 && + s = Str.matched_string s;; + +(* FindMatch sleft sright s *) +(* turns strings sleft and sright into regexps, recursively searches string *) +(* s for matched pairs of substrings matching sleft and sright, and returns *) +(* the position after the first substring matched by sright which is not *) +(* paired with an sleft-matching substring. Often here sleft ends with *) +(* whitespace (ws) while sright begins with ws. The "degenerate" case of *) +(* X^ws^Y where X^ws matches sleft and ws^Y matches sright is handled by *) +(* backing up a character after an sleft match if the last character is ws. *) + +let FindMatch sleft sright s = + let test = Str.regexp ("\("^ sleft ^"\|"^ sright ^"\)") + and left = Str.regexp sleft in + let rec FindMatchPosition s count = + if count = 1 then 0 + else + try + ignore(Str.search_forward test s 0); + let TestMatch = Str.matched_group 1 s + and AfterTest = Str.match_end() in + let LastChar = Str.last_chars (Str.string_before s AfterTest) 1 in + let endpos = + if Str.string_match (Str.regexp ws) LastChar 0 + then AfterTest - 1 else AfterTest in + let rest = Str.string_after s endpos + and increment = + if StringRegexpEqual left TestMatch then -1 else 1 in + endpos + (FindMatchPosition rest (count + increment)) + with Not_found -> raise (Readable_fail + ("No matching right bracket operator "^ sright ^ + " to left bracket operator "^ sleft ^" in "^ s)) in + FindMatchPosition s 0;; + +(* FindSemicolon uses FindMatch to find the position before the next *) +(* semicolon which is not a delimiter of a list. *) + +let rec FindSemicolon s = + try + let rec FindMatchPosition s pos = + let start = Str.search_forward (Str.regexp ";\|\[") s pos in + if Str.matched_string s = ";" then start + else + let rest = Str.string_after s (start + 1) in + let MatchingSquareBrace = FindMatch "\[" "\]" rest in + let newpos = start + 1 + MatchingSquareBrace in + FindMatchPosition s newpos in + FindMatchPosition s 0 + with Not_found -> raise (Readable_fail ("No final semicolon in "^ s));; + +(* FindCases uses FindMatch to take a string *) +(* "suppose" proof_1 "end;" ... "suppose" proof_n "end;" *) +(* and return the list [proof_1; proof_2; ... ; proof_n]. *) + +let rec FindCases s = + let sleftCase, srightCase = ws^ "suppose"^ws, ws^ "end" ^ws0^ ";" in + if Str.string_match (Str.regexp sleftCase) s 0 then + let CaseEndRest = Str.string_after s (Str.match_end()) in + let PosAfterEnd = FindMatch sleftCase srightCase CaseEndRest in + let pos = Str.search_backward (Str.regexp srightCase) + CaseEndRest PosAfterEnd in + let case = Str.string_before CaseEndRest pos + and rest = Str.string_after CaseEndRest PosAfterEnd in + case :: (FindCases rest) + else [];; + +(* StringToList uses FindSemicolon to turns a string into the list of *) +(* substrings delimited by the semicolons which are not captured in lists. *) + +let rec StringToList s = + if StringRegexpEqual (Str.regexp ws0) s then [] else + if Str.string_match (Str.regexp "[^;]*;") s 0 then + let pos = FindSemicolon s in + let head = Str.string_before s pos in + head :: (StringToList (Str.string_after s (pos + 1))) + else [s];; + +(* ExtractWsStringList string = (["l1"; "l2"; ...; "ln"], rest), *) +(* if string = ws ^ "[l1; l2; ...; ln]" ^ rest. Raises Not_found otherwise. *) + +let ExtractWsStringList string = + if Str.string_match (Str.regexp (ws^ "\[")) string 0 then + let listRest = Str.string_after string (Str.match_end()) in + let RightBrace = FindMatch "\[" "\]" listRest in + let rest = Str.string_after listRest RightBrace + and list = Str.string_before listRest (RightBrace - 1) in + (StringToList list, rest) + else raise Not_found;; + +(* theoremify string goal returns a pair (thm, rest), *) +(* where thm is the first theorem found on string, using goal if needed, and *) +(* rest is the remainder of string. Theoremify uses 3 helping functions: *) +(* 1) CombTermThm_Term, which produces a combination of a term->thm *) +(* (e.g. ARITH_RULE) with a term, *) +(* 2) CombThmlistTermThm_Thmlist_Term, which combines a thmlist->term->thm *) +(* (e.g. MESON) with a thmlist and a term, and *) +(* 3) CombTermlistThmThm_Termlist, which combines a termlist->thm->thm *) +(* (e.g. SPECL) with a termlist and a thm produced by theoremify. *) +(* Similar functions CombThmtactic_Thm and CombThmlisttactic_Thmlist are *) +(* used below, along with theoremify, by StringToTactic. *) + +let CombTermThm_Term word rest gl = + let TermThm = exec_term_thm word in + try + let (stermlist, wsRest) = ExtractWsStringList rest in + if length stermlist = 1 then + let term = (parse_env_string (make_env gl)) (hd stermlist) in + (TermThm term, wsRest) + else raise (Readable_fail ("term->thm "^ word + ^" not followed by length 1 term list, but instead the list \n["^ + String.concat ";" stermlist ^"]")) + with Not_found -> raise (Readable_fail ("term->thm "^ word + ^" not followed by term list, but instead \n"^ rest));; + +let rec theoremify string gl = + if Str.string_match (Str.regexp (ws^ "\([^][ \t\n]+\)")) string 0 then + let word = Str.matched_group 1 string + and rest = Str.string_after string (Str.match_end()) in + if word = "-" then (snd (hd (fst gl)), rest) else + try (exec_thm word, rest) + with _ -> + try (assoc word (fst gl), rest) + with _ -> + try firstPairMult (exec_thm_thm word) (theoremify rest gl) + with _ -> + try CombTermThm_Term word rest gl + with Noparse -> + try CombThmlistTermThm_Thmlist_Term word rest gl + with Noparse -> + try CombTermlistThmThm_Termlist word rest gl + with Noparse -> raise (Readable_fail ("Not a theorem:\n"^ string)) + else raise (Readable_fail ("Empty theorem:\n"^ string)) +and +firstPairMult f (a, b) = (f a, b) +and +CombTermlistThmThm_Termlist word rest gl = + let TermlistThmThm = exec_termlist_thm_thm word in + try + let (stermlist, WsThm) = ExtractWsStringList rest in + let termlist = map (parse_env_string (make_env gl)) stermlist in + firstPairMult (TermlistThmThm termlist) (theoremify WsThm gl) + with Not_found -> raise (Readable_fail ("termlist->thm->thm "^ word + ^"\n not followed by term list in\n"^ rest)) +and +CombThmlistTermThm_Thmlist_Term word rest gl = + let thm_create sthm = + let (thm, rest) = theoremify (" "^ sthm) gl in + if rest = "" then thm + else raise (Readable_fail ("an argument of thmlist->term->thm "^ word ^ + "\n is not a theorem, but instead \n"^ sthm)) in + let ThmlistTermThm = exec_thmlist_term_thm word in + try + let (stermlist, wsTermRest) = ExtractWsStringList rest in + let thmlist = map thm_create stermlist in + if Str.string_match (Str.regexp (ws^ "\[")) wsTermRest 0 then + let termRest = Str.string_after wsTermRest (Str.match_end()) in + let RightBrace = FindMatch "\[" "\]" termRest in + let rest = Str.string_after termRest RightBrace + and sterm = Str.string_before termRest (RightBrace - 1) in + let term = parse_env_string (make_env gl) sterm in + (ThmlistTermThm thmlist term, rest) + else raise (Readable_fail ("thmlist->term->thm "^ word + ^" followed by list of theorems ["^ String.concat ";" stermlist ^"] + not followed by term in\n"^ wsTermRest)) + with Not_found -> raise (Readable_fail ("thmlist->term->thm "^ word + ^" not followed by thm list in\n"^ rest));; + +let CombThmtactic_Thm step = + if Str.string_match (Str.regexp (ws^ "\([a-zA-Z0-9_]+\)")) step 0 then + let sthm_tactic = Str.matched_group 1 step + and sthm = Str.string_after step (Str.match_end()) in + let thm_tactic = exec_thmtactic sthm_tactic in + fun gl -> + let (thm, rest) = theoremify sthm gl in + if rest = "" then thm_tactic thm gl + else raise (Readable_fail ("thm_tactic "^ sthm_tactic + ^" not followed by a theorem, but instead\n"^ sthm)) + else raise Not_found;; + +let CombThmlisttactic_Thmlist step = + let rec makeThmListAccum string list gl = + if StringRegexpEqual (Str.regexp ws0) string then list else + let (thm, rest) = theoremify string gl in + makeThmListAccum rest (thm :: list) gl in + if Str.string_match (Str.regexp (ws^ "\([a-zA-Z0-9_]+\)")) step 0 then + let ttac = exec_thmlist_tactic (Str.matched_group 1 step) + and LabThmString = Str.string_after step (Str.match_end()) in + fun gl -> + let LabThmList = List.rev (makeThmListAccum LabThmString [] gl) in + ttac LabThmList gl + else raise Not_found;; + +(* StringToTactic uses regexp functions from the Str library to transform a *) +(* string into a tactic. The allowable tactics are written in BNF form as *) +(* *) +(* Tactic := ALL_TAC | Tactic THEN Tactic | thm->tactic Thm | *) +(* one-word-tactic (e.g. ARITH_TAC) | thmlist->tactic Thm-list | *) +(* intro_TAC string | exists_TAC term | X_genl_TAC term-list | *) +(* case_split string Tactic statement-list Tactic-list | *) +(* consider variable-list statement label Tactic | *) +(* eq_tac (Right | Left) Tactic | conj_tac (Right | Left) Tactic | *) +(* (assume | subgoal_TAC) statement label Tactic *) +(* *) +(* Thm := theorem-name | label | - [i.e. last assumption] | thm->thm Thm | *) +(* term->thm term | thmlist->term->thm Thm-list term | *) +(* termlist->thm->thm term-list Thm *) +(* *) +(* The string proofs allowed by StringToTactic are written in BNF form as *) +(* *) +(* Proof := Proof THEN Proof | case_split destruct_string ByProofQed *) +(* suppose statement; Proof end; ... suppose statement; Proof end; | *) +(* OneStepProof; | consider variable-list statement [label] ByProofQed | *) +(* eq_tac [Right|Left] ByProofQed | conj_tac [Right|Left] ByProofQed | *) +(* (assume | ) statement [label] ByProofQed *) +(* *) +(* OneStepProof := one-word-tactic | thm->tactic Thm | intro_TAC string | *) +(* exists_TAC term-string | X_genl_TAC variable-string-list | *) +(* thmlist->tactic Thm-list *) +(* *) +(* ByProofQed := by OneStepProof; | proof Proof Proof ... Proof qed; *) +(* *) +(* theorem is a version of prove based on the miz3.ml thm, with argument *) +(* statement ByProofQed *) + +let rec StringToTactic s = + if StringRegexpEqual (Str.regexp ws0) s then ALL_TAC + else + try makeCaseSplit s + with _ -> + let pos = FindSemicolon s in + let step, rest = Str.string_before s pos, Str.string_after s (pos + 1) in + try + let tactic = StepToTactic step in + tactic THEN StringToTactic rest + with Not_found -> + let (tactic, rest) = BigStepToTactic s step in + tactic THEN StringToTactic rest +and +GetProof ByProof s = + if ByProof = "by" then + let pos = FindSemicolon s in + let step, rest = Str.string_before s pos, Str.string_after s (pos + 1) in + (StepToTactic step, rest) + else + let pos_after_qed = FindMatch (ws^"proof"^ws) (ws^"qed"^ws0^";") s in + let pos = Str.search_backward (Str.regexp "qed") s pos_after_qed in + let proof = StringToTactic (Str.string_before s pos) in + (proof, Str.string_after s pos_after_qed) +and +makeCaseSplit s = + if Str.string_match (Str.regexp (ws^ "case_split" ^ws^ "\([^;]+\)" ^ws^ + "\(by\|proof\)" ^ws)) s 0 then + let sDestruct = Str.matched_group 1 s + and (proof, rest) = GetProof (Str.matched_group 2 s) + (Str.string_after s (Str.group_end 2)) + and SplitAtSemicolon case = + let pos = FindSemicolon case in + [Str.string_before case pos; Str.string_after case (pos + 1)] in + let list2Case = map SplitAtSemicolon (FindCases rest) in + let listofDisj = map hd list2Case + and listofTac = map (StringToTactic o hd o tl) list2Case in + case_split sDestruct proof listofDisj listofTac + else raise Not_found +and +StepToTactic step = + try + if StringRegexpEqual (Str.regexp (ws^ "\([^ \t\n]+\)" ^ws0)) step then + exec_tactic (Str.matched_group 1 step) + else raise Not_found + with _ -> + try CombThmtactic_Thm step + with _ -> + try CombThmlisttactic_Thmlist step + with _ -> + if Str.string_match (Str.regexp (ws^ "intro_TAC" ^ws)) step 0 then + let intro_string = Str.string_after step (Str.match_end()) in + intro_TAC intro_string + else if Str.string_match (Str.regexp (ws^ "exists_TAC" ^ws)) step 0 then + let exists_string = Str.string_after step (Str.match_end()) in + exists_TAC exists_string + else if Str.string_match (Str.regexp (ws^ "X_genl_TAC" ^ws)) step 0 then + let genl_string = Str.string_after step (Str.match_end()) in + let svarlist = Str.split (Str.regexp ws) genl_string in + X_genl_TAC svarlist + else raise Not_found +and +BigStepToTactic s step = + if Str.string_match (Str.regexp (ws^ "consider" ^ws^ "\(\(.\|\n\)+\)" ^ws^ + "such" ^ws^ "that" ^ws^ "\(\(.\|\n\)+\)" ^ws^ "\[\(\(.\|\n\)*\)\]" ^ws^ + "\(by\|proof\)" ^ws)) step 0 then + let vars, t = Str.matched_group 1 step, Str.matched_group 3 step + and lab = Str.matched_group 5 step + and KeyWord, endKeyWord = Str.matched_group 7 step, (Str.group_end 7) in + let (proof, rest) = GetProof KeyWord (Str.string_after s endKeyWord) in + (consider vars t lab proof, rest) + else + try + let start = Str.search_forward (Str.regexp + (ws^ "\[\([^]]*\)\]" ^ws^ "\(by\|proof\)" ^ws)) step 0 in + let statement = Str.string_before step start + and lab = Str.matched_group 1 step + and KeyWord = Str.matched_group 2 step + and AfterWord = Str.string_after s (Str.group_end 2) in + let (proof, rest) = GetProof KeyWord AfterWord in + if StringRegexpEqual (Str.regexp (ws^ "eq_tac")) statement + then (eq_tac lab proof, rest) + else if StringRegexpEqual (Str.regexp (ws^ "conj_tac")) statement + then (conj_tac lab proof, rest) + else if + Str.string_match (Str.regexp (ws^ "\(assume\)" ^ws)) statement 0 + then + let statement = Str.string_after statement (Str.match_end()) in + (assume statement lab proof, rest) + else (subgoal_TAC statement lab proof, rest) + with Not_found -> raise (Readable_fail + ("Can't parse as a Proof:\n"^ step));; + +let theorem s = + let s = CleanMathFontsForHOL_Light s in + try + let start = Str.search_forward (Str.regexp + (ws^ "proof\(" ^ws^ "\(.\|\n\)*\)" ^ws ^ "qed" ^ws0^ ";" ^ws0)) s 0 in + let thm = Str.string_before s start + and proof = Str.matched_group 1 s + and rest = Str.string_after s (Str.match_end()) in + if rest = "" then prove (parse_env_string [] thm, StringToTactic proof) + else raise (Readable_fail + ("Trailing garbage after the proof...qed:\n" ^ rest)) + with Not_found -> + try + let start = Str.search_forward (Str.regexp (ws^ "by")) s 0 in + let thm = Str.string_before s start + and proof = Str.string_after s (Str.match_end()) in + try + prove (parse_env_string [] thm, StepToTactic proof) + with Not_found -> raise (Readable_fail ("Not a proof:\n" ^ proof)) + with Not_found -> raise (Readable_fail + ("Missing initial \"proof\", \"by\", or final \"qed;\" in\n" ^ s));; + +let interactive_goal s = + let thm = CleanMathFontsForHOL_Light s in + g (parse_env_string [] thm);; + +let interactive_proof s = + let proof = CleanMathFontsForHOL_Light s in + e (StringToTactic proof);; + +(* Two examples illustrating intro_TAC, eq_tac, exists_TAC MP_TAC and SPECL, *) +(* then a port of the HOL Light tutorial proof that sqrt 2 is irrational. *) + +let SKOLEM_THM_GEN = theorem `; + ∀P R. (∀x. P x ⇒ ∃y. R x y) ⇔ ∃f. ∀x. P x ⇒ R x (f x) + + proof + intro_TAC ∀P R; + eq_tac [Right] by fol; + intro_TAC H1; + exists_TAC λx. @y. R x y; + fol H1; + qed; +`;; + +let MOD_MOD_REFL = theorem `; + ∀m n. ¬(n = 0) ⇒ ((m MOD n) MOD n = m MOD n) + + proof + intro_TAC !m n, H1; + MP_TAC SPECL [m; n; 1] MOD_MOD; + fol H1 MULT_CLAUSES MULT_EQ_0 ONE NOT_SUC; + qed; +`;; + +let NSQRT_2 = theorem `; + ∀p q. p * p = 2 * q * q ⇒ q = 0 + + proof + MATCH_MP_TAC num_WF; + intro_TAC ∀p, A, ∀q, B; + EVEN(p * p) ⇔ EVEN(2 * q * q) [] by fol B; + EVEN(p) [] by fol - EVEN_DOUBLE EVEN_MULT; + consider m such that p = 2 * m [C] by fol - EVEN_EXISTS; + case_split qp | pq by arithmetic; + suppose q < p; + q * q = 2 * m * m ⇒ m = 0 [] by fol qp A; + num_ring - B C; + end; + suppose p <= q; + p * p <= q * q [] by fol - LE_MULT2; + q * q = 0 [] by arithmetic - B; + num_ring -; + end; + qed; +`;; + +(* The following interactive version of the above proof shows a feature of *) +(* proof/qed and case_split/suppose. You can evaluate an incomplete proof *) +(* of a statement in an interactive_proof and complete the proof afterward, *) +(* as indicated below. The "suppose" clauses of a case_split can also be *) +(* incomplete. Do not include code below the incomplete proof or case_split *) +(* in an interactive_proof body, for the usual THEN vs THENL reason. *) + +interactive_goal `;∀p q. p * p = 2 * q * q ⇒ q = 0 +`;; +interactive_proof `; + MATCH_MP_TAC num_WF; + intro_TAC ∀p, A, ∀q, B; + EVEN(p * p) ⇔ EVEN(2 * q * q) [] proof qed; +`;; +interactive_proof `; + fol B; +`;; +interactive_proof `; + EVEN(p) [] by fol - EVEN_DOUBLE EVEN_MULT; + consider m such that p = 2 * m [C] proof fol - EVEN_EXISTS; qed; +`;; +interactive_proof `; + case_split qp | pq by arithmetic; + suppose q < p; + end; + suppose p <= q; + end; +`;; +interactive_proof `; + q * q = 2 * m * m ⇒ m = 0 [] by fol qp A; + num_ring - B C; +`;; +interactive_proof `; + p * p <= q * q [] by fol - LE_MULT2; + q * q = 0 [] by arithmetic - B; + num_ring -; +`;; +let NSQRT_2 = top_thm();; + +(* An port from arith.ml uses by instead of proof...qed; in a short proof: *) + +let EXP_2 = theorem `; + ∀n:num. n EXP 2 = n * n + by rewrite BIT0_THM BIT1_THM EXP EXP_ADD MULT_CLAUSES ADD_CLAUSES`;; + +(* An example using GSYM, ARITH_RULE, MESON and GEN_REWRITE_TAC, reproving *) +(* the binomial theorem from sec 13.1--2 of the HOL Light tutorial. *) + +let binom = define + `(!n. binom(n,0) = 1) /\ + (!k. binom(0,SUC(k)) = 0) /\ + (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; + +let BINOM_LT = theorem `; + ∀n k. n < k ⇒ binom(n,k) = 0 + + proof + INDUCT_TAC; INDUCT_TAC; + rewrite binom ARITH LT_SUC LT; + ASM_SIMP_TAC ARITH_RULE [n < k ==> n < SUC(k)] ARITH; + qed; +`;; + +let BINOMIAL_THEOREM = theorem `; + ∀n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k)) + + proof + ∀f n. nsum (0.. SUC n) f = f(0) + nsum (0..n) (λi. f (SUC i)) [Nsum0SUC] by simplify LE_0 ADD1 NSUM_CLAUSES_LEFT NSUM_OFFSET; + MATCH_MP_TAC num_INDUCTION; + simplify EXP NSUM_SING_NUMSEG binom SUB_0 MULT_CLAUSES; + intro_TAC ∀n, nThm; + rewrite Nsum0SUC binom RIGHT_ADD_DISTRIB NSUM_ADD_NUMSEG GSYM NSUM_LMUL ADD_ASSOC; + rewriteR ADD_SYM; + rewriteRLDepth SUB_SUC EXP; + rewrite MULT_AC EQ_ADD_LCANCEL MESON [binom] [1 = binom(n, 0)] GSYM Nsum0SUC; + simplify NSUM_CLAUSES_RIGHT ARITH_RULE [0 < SUC n ∧ 0 <= SUC n] LT BINOM_LT MULT_CLAUSES ADD_CLAUSES SUC_SUB1; + simplify ARITH_RULE [k <= n ⇒ SUC n - k = SUC(n - k)] EXP MULT_AC; + qed; +`;; diff --git a/RichterHilbertAxiomGeometry/thmFontHilbertAxiom.ml b/RichterHilbertAxiomGeometry/thmFontHilbertAxiom.ml new file mode 100644 index 0000000..70b4492 --- /dev/null +++ b/RichterHilbertAxiomGeometry/thmFontHilbertAxiom.ml @@ -0,0 +1,986 @@ +ocaml +#use "hol.ml";; +#load "unix.cma";; +loadt "miz3/miz3.ml";; + +reset_miz3 0;; + +verbose := true;; +report_timing := true;; + +Theorem/Proof templates: + +let = theorem `; + + proof + + qed; +`;; + +interactive_goal `; +`;; +interactive_proof `; +`;; +interactive_proof `; +`;; +interactive_proof `; +`;; +interactive_proof `; +`;; +interactive_proof `; +`;; + +∉ |- ∀ a l. a ∉ l ⇔ ¬(a ∈ l) + +Interval_DEF |- ∀ A B X. open (A,B) = {X | Between A X B} + +Collinear_DEF + |- ∀ A B C. Collinear A B C ⇔ ∃ l. Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l + +SameSide_DEF + |- ∀ l A B. A,B same_side l ⇔ Line l ∧ ¬ ∃ X. X ∈ l ∧ X ∈ open (A,B) + +Ray_DEF |- ∀ A B. ray A B = + {X | ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B)} + +Ordered_DEF + |- ∀ A C B D. + ordered A B C D ⇔ + B ∈ open (A,C) ∧ B ∈ open (A,D) ∧ C ∈ open (A,D) ∧ C ∈ open (B,D) + +InteriorAngle_DEF |- ∀ A O B. + int_angle A O B = + {P | ¬Collinear A O B ∧ + ∃ a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∉ a ∧ P ∉ b ∧ + P,B same_side a ∧ P,A same_side b} + +InteriorTriangle_DEF + |- ∀ A B C. + int_triangle A B C = + {P | P ∈ int_angle A B C ∧ + P ∈ int_angle B C A ∧ + P ∈ int_angle C A B} + +Tetralateral_DEF + |- ∀ C D A B. + Tetralateral A B C D ⇔ + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) ∧ + ¬Collinear A B C ∧ ¬Collinear B C D ∧ ¬Collinear C D A ∧ ¬Collinear D A B + +Quadrilateral_DEF + |- ∀ B C D A. + Quadrilateral A B C D ⇔ + Tetralateral A B C D ∧ + open (A,B) ∩ open (C,D) = ∅ ∧ + open (B,C) ∩ open (D,A) = ∅ + +ConvexQuad_DEF + |- ∀ D A B C. + ConvexQuadrilateral A B C D ⇔ + Quadrilateral A B C D ∧ + A ∈ int_angle B C D ∧ + B ∈ int_angle C D A ∧ + C ∈ int_angle D A B ∧ + D ∈ int_angle A B C + +Segment_DEF |- ∀ A B. seg A B = {A, B} ∪ open (A,B) + +SEGMENT |- ∀ s. Segment s ⇔ ∃ A B. s = seg A B ∧ ¬(A = B) + +SegmentOrdering_DEF + |- ∀ t s. + s <__ t ⇔ + Segment s ∧ + ∃ C D X. t = seg C D ∧ X ∈ open (C,D) ∧ s ≡ seg C X + +Angle_DEF |- ∀ A O B. ∡ A O B = ray O A ∪ ray O B + +ANGLE + |- ∀ α. Angle α ⇔ ∃ A O B. α = ∡ A O B ∧ ¬Collinear A O B + +AngleOrdering_DEF + |- ∀ β α. + α <_ang β ⇔ + Angle α ∧ + ∃ A O B G. + ¬Collinear A O B ∧ β = ∡ A O B ∧ + G ∈ int_angle A O B ∧ α ≡ ∡ A O G + +RAY |- ∀ r. Ray r ⇔ ∃ O A. ¬(O = A) ∧ r = ray O A + +TriangleCong_DEF + |- ∀ A B C A' B' C'. + A,B,C ≅ A',B',C' ⇔ + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A B ≡ seg A' B' ∧ + seg A C ≡ seg A' C' ∧ + seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' ∧ + ∡ B C A ≡ ∡ B' C' A' ∧ + ∡ C A B ≡ ∡ C' A' B' + +SupplementaryAngles_DEF + |- ∀α β. + α suppl β ⇔ + ∃ A O B A'. + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ + α = ∡ A O B ∧ β = ∡ B O A' + +RightAngle_DEF + |- ∀α. Right α ⇔ ∃ β. α suppl β ∧ α ≡ β + +PlaneComplement_DEF + |- ∀ α. complement α = {P | P ∉ α} + +CONVEX + |- ∀α. Convex α ⇔ + ∀ A B. A ∈ α ∧ B ∈ α ⇒ open (A,B) ⊂ α + +PARALLEL + |- ∀ l k. l ∥ k ⇔ Line l ∧ Line k ∧ l ∩ k = ∅ + +Parallelogram_DEF + |- ∀ A B C D. + Parallelogram A B C D ⇔ + Quadrilateral A B C D ∧ + ∃ a b c d. + Line a ∧ A ∈ a ∧ B ∈ a ∧ Line b ∧ B ∈ b ∧ C ∈ b ∧ + Line c ∧ C ∈ c ∧ D ∈ d ∧ Line d ∧ D ∈ d ∧ A ∈ d ∧ + a ∥ c ∧ b ∥ d + +InteriorCircle_DEF + |- ∀ O R. int_circle O R = {P | ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R)} + + +I1 |- ∀ A B. ¬(A = B) ⇒ (∃! l. Line l ∧ A ∈ l ∧ B ∈ l) + +I2 |- ∀ l. Line l ⇒ (∃ A B. A ∈ l ∧ B ∈ l ∧ ¬(A = B)) + +I3 |- ∃ A B C. ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ ¬Collinear A B C + +B1 |- ∀ A B C. + Between A B C + ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + Between C B A ∧ Collinear A B C + +B2 |- ∀ A B. ¬(A = B) ⇒ ∃C. Between A B C + +B3 |- ∀ A B C. + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C + ⇒ (Between A B C ∨ Between B C A ∨ Between C A B) ∧ + ¬(Between A B C ∧ Between B C A) ∧ + ¬(Between A B C ∧ Between C A B) ∧ + ¬(Between B C A ∧ Between C A B) + +B4 |- ∀ l A B C. + Line l ∧ + ¬Collinear A B C ∧ + A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃X. X ∈ l ∧ Between A X C) + ⇒ (∃ Y. Y ∈ l ∧ Between A Y B) ∨ + (∃ Y. Y ∈ l ∧ Between B Y C) + +C1 |- ∀ s O Z. + Segment s ∧ ¬(O = Z) + ⇒ ∃! P. P ∈ ray O Z ━ O ∧ seg O P ≡ s + +C2Reflexive |- Segment s ⇒ s ≡ s + +C2Symmetric |- Segment s ∧ Segment t ∧ s ≡ t ⇒ t ≡ s + +C2Transitive + |- Segment s ∧ Segment t ∧ Segment u ∧ s ≡ t ∧ t ≡ u ⇒ s ≡ u + +C3 |- ∀ A B C A' B' C'. + B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ + seg A B ≡ seg A' B' ∧ seg B C ≡ seg B' C' + ⇒ seg A C ≡ seg A' C' + +C4 |- ∀ α O A l Y. + Angle α ∧ ¬(O = A) ∧ Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l + ⇒ ∃! r. Ray r ∧ ∃ B. ¬(O = B) ∧ r = ray O B ∧ + B ∉ l ∧ B,Y same_side l ∧ ∡ A O B ≡ α + +C5Reflexive |- Angle α ⇒ α ≡ α + +C5Symmetric + |- Angle α ∧ Angle β ∧ α ≡ β ⇒ β ≡ α + +C5Transitive + |- Angle α ∧ Angle β ∧ Angle γ ∧ α ≡ β ∧ β ≡ γ + ⇒ α ≡ γ + +C6 |- ∀A B C A' B' C'. + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' + ⇒ ∡ B C A ≡ ∡ B' C' A' + + +IN_Interval |- ∀ A B X. X ∈ open (A,B) ⇔ Between A X B + +IN_Ray |- ∀ A B X. + X ∈ ray A B ⇔ ¬(A = B) ∧ Collinear A B X ∧ A ∉ open (X,B) + +IN_InteriorAngle |- ∀A O B P. + P ∈ int_angle A O B ⇔ ¬Collinear A O B ∧ ∃ a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b + +IN_InteriorTriangle + |- ∀A B C P. + P ∈ int_triangle A B C ⇔ + P ∈ int_angle A B C ∧ P ∈ int_angle B C A ∧ P ∈ int_angle C A B + +IN_PlaneComplement + |- ∀α P. P ∈ complement α ⇔ P ∉ α + +IN_InteriorCircle + |- ∀ O R P. + P ∈ int_circle O R ⇔ ¬(O = R) ∧ (P = O ∨ seg O P <__ seg O R) + +B1' |- ∀ A B C. + B ∈ open (A,C) + ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ + B ∈ open (C,A) ∧ Collinear A B C + +B2' |- ∀ A B. ¬(A = B) ⇒ (∃ C. B ∈ open (A,C)) + +B3' |- ∀ A B C. + ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) ∧ Collinear A B C + ⇒ (B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B)) ∧ + ¬(B ∈ open (A,C) ∧ C ∈ open (B,A)) ∧ + ¬(B ∈ open (A,C) ∧ A ∈ open (C,B)) ∧ + ¬(C ∈ open (B,A) ∧ A ∈ open (C,B)) + +B4' |- ∀ l A B C. + Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + (∃ X. X ∈ l ∧ X ∈ open (A,C)) + ⇒ (∃ Y. Y ∈ l ∧ Y ∈ open (A,B)) ∨ + (∃ Y. Y ∈ l ∧ Y ∈ open (B,C)) + +B4'' |- ∀ l A B C. + Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + A,B same_side l ∧ B,C same_side l + ⇒ A,C same_side l + +DisjointOneNotOther + |- ∀ l m. (∀x. x ∈ m ⇒ x ∉ l) ⇔ l ∩ m = ∅ + +EquivIntersectionHelp + |- ∀ e x l m. + (l ∩ m = {x} ∨ m ∩ l = {x}) ∧ e ∈ m ━ x ⇒ e ∉ l + +CollinearSymmetry + |- ∀ A B C. + Collinear A B C + ⇒ Collinear A C B ∧ Collinear B A C ∧ + Collinear B C A ∧ Collinear C A B ∧ Collinear C B A + +ExistsNewPointOnLine + |- ∀ P l. Line l ∧ P ∈ l ⇒ ∃ Q. Q ∈ l ∧ ¬(P = Q) + +ExistsPointOffLine |- ∀ l. Line l ⇒ ∃ Q. Q ∉ l + +BetweenLinear + |- ∀ A B C m. + Line m ∧ A ∈ m ∧ C ∈ m ∧ + B ∈ open (A,C) ∨ C ∈ open (B,A) ∨ A ∈ open (C,B) + ⇒ B ∈ m + +CollinearLinear + |- ∀ A B C m. + Line m ∧ A ∈ m ∧ C ∈ m ∧ ¬(A = C) ∧ + Collinear A B C ∨ Collinear B C A ∨ Collinear C A B + ⇒ B ∈ m + +NonCollinearImpliesDistinct + |- ∀ A B C. ¬Collinear A B C ⇒ ¬(A = B) ∧ ¬(A = C) ∧ ¬(B = C) + +NonCollinearRaa + |- ∀A B C l. + ¬(A = C) ∧ Line l ∧ A ∈ l ∧ C ∈ l ∧ B ∉ l + ⇒ ¬Collinear A B C + +TwoSidesTriangle1Intersection + |- ∀A B C Y. + ¬Collinear A B C ∧ Collinear B C Y ∧ Collinear A C Y ⇒ Y = C + +OriginInRay |- ∀ O Q. ¬(Q = O) ⇒ O ∈ ray O Q + +EndpointInRay |- ∀ O Q. ¬(Q = O) ⇒ Q ∈ ray O Q + +I1Uniqueness + |- ∀ X l m. + Line l ∧ Line m ∧ ¬(l = m) ∧ X ∈ l ∧ X ∈ m + ⇒ l ∩ m = {X} + +EquivIntersection + |- ∀ A B X l m. + Line l ∧ Line m ∧ l ∩ m = {X} ∧ + A ∈ m ━ X ∧ B ∈ m ━ X ∧ X ∉ open (A,B) + ⇒ A,B same_side l + +RayLine + |- ∀ O P l. Line l ∧ O ∈ l ∧ P ∈ l ⇒ ray O P ⊂ l + +RaySameSide + |- ∀ l O A P. + Line l ∧ O ∈ l ∧ A ∉ l ∧ P ∈ ray O A ━ O + ⇒ P ∉ l ∧ P,A same_side l + +IntervalRayEZ + |- ∀ A B C. + B ∈ open (A,C) ⇒ B ∈ ray A C ━ A ∧ C ∈ ray A B ━ A + +NoncollinearityExtendsToLine + |- ∀ A O B X. + ¬Collinear A O B ∧ Collinear O B X ∧ ¬(X = O) + ⇒ ¬Collinear A O X + +SameSideReflexive + |- ∀ l A. Line l ∧ A ∉ l ⇒ A,A same_side l + +SameSideSymmetric + |- ∀ l A B. + Line l ∧ A ∉ l ∧ B ∉ l ∧ A,B same_side l + ⇒ B,A same_side l + +SameSideTransitive + |- ∀l A B C. + Line l ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + A,B same_side l ∧ B,C same_side l + ⇒ A,C same_side l + +ConverseCrossbar + |- ∀ O A B G. ¬Collinear A O B ∧ G ∈ open (A,B) ⇒ G ∈ int_angle A O B + +InteriorUse + |- ∀ A O B P a b. + Line a ∧ O ∈ a ∧ A ∈ a ∧ + Line b ∧ O ∈ b ∧ B ∈ b ∧ + P ∈ int_angle A O B + ⇒ P ∉ a ∧ P ∉ b ∧ P,B same_side a ∧ P,A same_side b + +InteriorEZHelp + |- ∀ A O B P. + P ∈ int_angle A O B + ⇒ ¬(P = A) ∧ ¬(P = O) ∧ ¬(P = B) ∧ ¬Collinear A O P + +InteriorAngleSymmetry + |- ∀ A O B P. P ∈ int_angle A O B ⇒ P ∈ int_angle B O A + +InteriorWellDefined + |- ∀ A O B X P. + P ∈ int_angle A O B ∧ X ∈ ray O B ━ O ⇒ P ∈ int_angle A O X + +WholeRayInterior + |- ∀A O B X P. + X ∈ int_angle A O B ∧ P ∈ ray O X ━ O + ⇒ P ∈ int_angle A O B + +AngleOrdering + |- ∀ O A P Q a. + ¬(O = A) ∧ Line a ∧ O ∈ a ∧ A ∈ a ∧ P ∉ a ∧ Q ∉ a ∧ + P,Q same_side a ∧ ¬Collinear P O Q + ⇒ P ∈ int_angle Q O A ∨ Q ∈ int_angle P O A + +InteriorsDisjointSupplement + |- ∀A O B A'. + ¬Collinear A O B ∧ O ∈ open (A,A') + ⇒ int_angle A O B ∩ int_angle B O A' = ∅ + +InteriorReflectionInterior + |- ∀ A O B D A'. + O ∈ open (A,A') ∧ D ∈ int_angle A O B ⇒ B ∈ int_angle D O A' + +Crossbar_THM + |- ∀ O A B D. + D ∈ int_angle A O B + ⇒ ∃ G. G ∈ open (A,B) ∧ G ∈ ray O D ━ O + +AlternateConverseCrossbar + |- ∀ O A B G. Collinear A G B ∧ G ∈ int_angle A O B ⇒ G ∈ open (A,B) + +InteriorOpposite + |- ∀ A O B P p. + P ∈ int_angle A O B ∧ Line p ∧ O ∈ p ∧ P ∈ p + ⇒ ¬(A,B same_side p) + +IntervalTransitivity + |- ∀ O P Q R m. + Line m ∧ O ∈ m ∧ + P ∈ m ━ O ∧ Q ∈ m ━ O ∧ R ∈ m ━ O ∧ + O ∉ open (P,Q) ∧ O ∉ open (Q,R) + ⇒ O ∉ open (P,R) + +RayWellDefinedHalfway + |- ∀ O P Q. ¬(Q = O) ∧ P ∈ ray O Q ━ O ⇒ ray O P ⊂ ray O Q + +RayWellDefined + |- ∀ O P Q. ¬(Q = O) ∧ P ∈ ray O Q ━ O ⇒ ray O P = ray O Q + +OppositeRaysIntersect1pointHelp + |- ∀ A O B X. + O ∈ open (A,B) ∧ X ∈ ray O B ━ O + ⇒ X ∉ ray O A ∧ O ∈ open (X,A) + +OppositeRaysIntersect1point + |- ∀ A O B. O ∈ open (A,B) ⇒ ray O A ∩ ray O B = {O} + +IntervalRay + |- ∀ A B C. B ∈ open (A,C) ⇒ ray A B = ray A C + +Reverse4Order + |- ∀ A B C D. ordered A B C D ⇒ ordered D C B A + +TransitivityBetweennessHelp + |- ∀ A B C D. B ∈ open (A,C) ∧ C ∈ open (B,D) ⇒ B ∈ open (A,D) + +TransitivityBetweenness + |- ∀ A B C D. B ∈ open (A,C) ∧ C ∈ open (B,D) ⇒ ordered A B C D + +IntervalsAreConvex + |- ∀ A B C. B ∈ open (A,C) ⇒ open (A,B) ⊂ open (A,C) + +TransitivityBetweennessVariant + |- ∀ A X B C. X ∈ open (A,B) ∧ B ∈ open (A,C) ⇒ ordered A X B C + +Interval2sides2aLineHelp + |- ∀ A B C X. B ∈ open (A,C) ⇒ X ∉ open (A,B) ∨ X ∉ open (B,C) + +Interval2sides2aLine + |- ∀ A B C X. + Collinear A B C + ⇒ X ∉ open (A,B) ∨ X ∉ open (A,C) ∨ X ∉ open (B,C) + +TwosidesTriangle2aLine + |- ∀A B C Y l m. + Line l ∧ ¬Collinear A B C ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l ∧ + Line m ∧ A ∈ m ∧ C ∈ m ∧ + Y ∈ l ∧ Y ∈ m ∧ ¬(A,B same_side l) ∧ ¬(B,C same_side l) + ⇒ A,C same_side l + +LineUnionOf2Rays + |- ∀ A O B l. + Line l ∧ A ∈ l ∧ B ∈ l ∧ O ∈ open (A,B) + ⇒ l = ray O A ∪ ray O B + +AtMost2Sides + |- ∀ A B C l. + Line l ∧ A ∉ l ∧ B ∉ l ∧ C ∉ l + ⇒ A,B same_side l ∨ A,C same_side l ∨ B,C same_side l + +FourPointsOrder + |- ∀ A B C X l. + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ X ∈ l ∧ B ∈ open (A,C) ∧ + ¬(X = A) ∧ ¬(X = B) ∧ ¬(X = C) + ⇒ ordered X A B C ∨ ordered A X B C ∨ ordered A B X C ∨ ordered A B C X + +HilbertAxiomRedundantByMoore + |- ∀ A B C D l. + Line l ∧ A ∈ l ∧ B ∈ l ∧ C ∈ l ∧ D ∈ l ∧ + ¬(A = B) ∧ ¬(A = C) ∧ ¬(A = D) ∧ ¬(B = C) ∧ ¬(B = D) ∧ ¬(C = D) + ⇒ ordered D A B C ∨ ordered A D B C ∨ ordered A B D C ∨ + ordered A B C D ∨ ordered D A C B ∨ ordered A D C B ∨ + ordered A C D B ∨ ordered A C B D ∨ ordered D C A B ∨ + ordered C D A B ∨ ordered C A D B ∨ ordered C A B D + +InteriorTransitivity + |- ∀A O B F G. + G ∈ int_angle A O B ∧ F ∈ int_angle A O G + ⇒ F ∈ int_angle A O B + +HalfPlaneConvexNonempty + |- ∀l H A. + Line l ∧ A ∉ l ∧ H = {X | X ∉ l ∧ X,A same_side l} + ⇒ ¬(H = ∅) ∧ H ⊂ complement l ∧ Convex H + +PlaneSeparation + |- ∀ l. Line l + ⇒ ∃ H1 H2. + H1 ∩ H2 = ∅ ∧ ¬(H1 = ∅) ∧ ¬(H2 = ∅) ∧ + Convex H1 ∧ Convex H2 ∧ complement l = H1 ∪ H2 ∧ + ∀ P Q. P ∈ H1 ∧ Q ∈ H2 ⇒ ¬(P,Q same_side l) + +TetralateralSymmetry + |- ∀ A B C D. + Tetralateral A B C D + ⇒ Tetralateral B C D A ∧ Tetralateral A B D C + +EasyEmptyIntersectionsTetralateralHelp + |- ∀ A B C D. Tetralateral A B C D ⇒ open (A,B) ∩ open (B,C) = ∅ + +EasyEmptyIntersectionsTetralateral + |- ∀ A B C D. + Tetralateral A B C D + ⇒ open (A,B) ∩ open (B,C) = ∅ ∧ open (B,C) ∩ open (C,D) = ∅ ∧ + open (C,D) ∩ open (D,A) = ∅ ∧ open (D,A) ∩ open (A,B) = ∅ + +SegmentSameSideOppositeLine + |- ∀ A B C D a c. + Quadrilateral A B C D ∧ + Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c + ⇒ A,B same_side c ∨ C,D same_side a + +ConvexImpliesQuad + |- ∀ A B C D. + Tetralateral A B C D ∧ + C ∈ int_angle D A B ∧ D ∈ int_angle A B C + ⇒ Quadrilateral A B C D + +DiagonalsIntersectImpliesConvexQuad + |- ∀ A B C D G. + ¬Collinear B C D ∧ G ∈ open (A,C) ∧ G ∈ open (B,D) + ⇒ ConvexQuadrilateral A B C D + +DoubleNotSimImpliesDiagonalsIntersect + |- ∀ A B C D l m. + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m ∧ + Tetralateral A B C D ∧ + ¬(B,D same_side l) ∧ ¬(A,C same_side m) + ⇒ (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ + ConvexQuadrilateral A B C D + +ConvexQuadImpliesDiagonalsIntersect + |- ∀ A B C D l m. + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m ∧ + ConvexQuadrilateral A B C D + ⇒ ¬(B,D same_side l) ∧ ¬(A,C same_side m) ∧ + (∃ G. G ∈ open (A,C) ∩ open (B,D)) ∧ + ¬Quadrilateral A B D C + +FourChoicesTetralateralHelp + |- ∀ A B C D. + Tetralateral A B C D ∧ C ∈ int_angle D A B + ⇒ ConvexQuadrilateral A B C D ∨ C ∈ int_triangle D A B + +InteriorTriangleSymmetry + |- ∀ A B C P. P ∈ int_triangle A B C ⇒ P ∈ int_triangle B C A + +FourChoicesTetralateral + |- ∀ A B C D a. + Tetralateral A B C D ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ + C,D same_side a + ⇒ ConvexQuadrilateral A B C D ∨ ConvexQuadrilateral A B D C ∨ + D ∈ int_triangle A B C ∨ C ∈ int_triangle D A B + +QuadrilateralSymmetry + |- ∀ A B C D. + Quadrilateral A B C D + ⇒ Quadrilateral B C D A ∧ + Quadrilateral C D A B ∧ + Quadrilateral D A B C + +FiveChoicesQuadrilateral + |- ∀ A B C D l m. + Quadrilateral A B C D ∧ + Line l ∧ A ∈ l ∧ C ∈ l ∧ + Line m ∧ B ∈ m ∧ D ∈ m + ⇒ (ConvexQuadrilateral A B C D ∨ + A ∈ int_triangle B C D ∨ B ∈ int_triangle C D A ∨ + C ∈ int_triangle D A B ∨ D ∈ int_triangle A B C) ∧ + (¬(B,D same_side l) ∨ ¬(A,C same_side m)) + +IntervalSymmetry |- ∀ A B. open (A,B) = open (B,A) + +SegmentSymmetry |- ∀ A B. seg A B = seg B A + +C1OppositeRay + |- ∀ O P s. + Segment s ∧ ¬(O = P) ⇒ ∃ Q. P ∈ open (O,Q) ∧ seg P Q ≡ s + +OrderedCongruentSegments + |- ∀ A B C D F. + ¬(A = C) ∧ ¬(D = F) ∧ seg A C ≡ seg D F ∧ B ∈ open (A,C) + ⇒ ∃ E. E ∈ open (D,F) ∧ seg A B ≡ seg D E + +SegmentSubtraction + |- ∀ A B C A' B' C'. + B ∈ open (A,C) ∧ B' ∈ open (A',C') ∧ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' + ⇒ seg B C ≡ seg B' C' + +SegmentOrderingUse + |- ∀A B s. + Segment s ∧ ¬(A = B) ∧ s <__ seg A B + ⇒ ∃ G. G ∈ open (A,B) ∧ s ≡ seg A G + +SegmentTrichotomy1 |- ∀ s t. s <__ t ⇒ ¬(s ≡ t) + +SegmentTrichotomy2 + |- ∀ s t u. s <__ t ∧ Segment u ∧ t ≡ u ⇒ s <__ u + +SegmentOrderTransitivity + |- ∀ s t u. s <__ t ∧ t <__ u ⇒ s <__ u + +SegmentTrichotomy + |- ∀ s t. + Segment s ∧ Segment t + ⇒ (s ≡ t ∨ s <__ t ∨ t <__ s) ∧ + ¬(s ≡ t ∧ s <__ t) ∧ ¬(s ≡ t ∧ t <__ s) ∧ ¬(s <__ t ∧ t <__ s) + +C4Uniqueness + |- ∀ O A B P l. + Line l ∧ O ∈ l ∧ A ∈ l ∧ ¬(O = A) ∧ + B ∉ l ∧ P ∉ l ∧ P,B same_side l ∧ ∡ A O P ≡ ∡ A O B + ⇒ ray O B = ray O P + +AngleSymmetry |- ∀ A O B. ∡ A O B = ∡ B O A + +TriangleCongSymmetry + |- ∀ A B C A' B' C'. + A,B,C ≅ A',B',C' + ⇒ A,C,B ≅ A',C',B' ∧ B,A,C ≅ B',A',C' ∧ + B,C,A ≅ B',C',A' ∧ C,A,B ≅ C',A',B' ∧ C,B,A ≅ C',B',A' + +SAS + |- ∀ A B C A' B' C'. + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg B A ≡ seg B' A' ∧ seg B C ≡ seg B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' + ⇒ A,B,C ≅ A',B',C' + +ASA + |- ∀ A B C A' B' C'. + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A C ≡ seg A' C' ∧ + ∡ C A B ≡ ∡ C' A' B' ∧ ∡ B C A ≡ ∡ B' C' A' + ⇒ A,B,C ≅ A',B',C' + +AngleSubtraction + |- ∀ A O B A' O' B' G G'. + G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ∧ + ∡ A O B ≡ ∡ A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' + ⇒ ∡ G O B ≡ ∡ G' O' B' + +OrderedCongruentAngles + |- ∀ A O B A' O' B' G. + ¬Collinear A' O' B' ∧ ∡ A O B ≡ ∡ A' O' B' ∧ + G ∈ int_angle A O B + ⇒ ∃ G'. G' ∈ int_angle A' O' B' ∧ ∡ A O G ≡ ∡ A' O' G' + +AngleAddition + |- ∀ A O B A' O' B' G G'. + G ∈ int_angle A O B ∧ G' ∈ int_angle A' O' B' ∧ + ∡ A O G ≡ ∡ A' O' G' ∧ ∡ G O B ≡ ∡ G' O' B' ∧ + ⇒ ∡ A O B ≡ ∡ A' O' B' + +AngleOrderingUse + |- ∀ A O B α. + Angle α ∧ ¬Collinear A O B ∧ α <_ang ∡ A O B + ⇒ (∃ G. G ∈ int_angle A O B ∧ α ≡ ∡ A O G) + +AngleTrichotomy1 + |- ∀ α β. α <_ang β ⇒ ¬(α ≡ β) + +AngleTrichotomy2 + |- ∀ α β γ. + α <_ang β ∧ Angle γ ∧ β ≡ γ + ⇒ α <_ang γ + +AngleOrderTransitivity + |- ∀α β γ. + α <_ang β ∧ β <_ang γ + ⇒ α <_ang γ + +AngleTrichotomy + |- ∀ α β. + Angle α ∧ Angle β + ⇒ (α ≡ β ∨ α <_ang β ∨ β <_ang α) ∧ + ¬(α ≡ β ∧ α <_ang β) ∧ + ¬(α ≡ β ∧ β <_ang α) ∧ + ¬(α <_ang β ∧ β <_ang α) + +SupplementExists + |- ∀ α. Angle α ⇒ ∃ α'. α suppl α' + +SupplementImpliesAngle + |- ∀ α β. α suppl β ⇒ Angle α ∧ Angle β + +RightImpliesAngle |- ∀ α. Right α ⇒ Angle α + +SupplementSymmetry + |- ∀ α β. α suppl β ⇒ β suppl α + +SupplementsCongAnglesCong + |- ∀ α β α' β'. + α suppl α' ∧ β suppl β' ∧ α ≡ β + ⇒ α' ≡ β' + +SupplementUnique + |- ∀ α β β'. + α suppl β ∧ α suppl β' ⇒ β ≡ β' + +CongRightImpliesRight + |- ∀ α β. + Angle α ∧ Right β ∧ α ≡ β ⇒ Right α + +RightAnglesCongruentHelp + |- ∀ A O B A' P a. + ¬Collinear A O B ∧ O ∈ open (A,A') + Right (∡ A O B) ∧ Right (∡ A O P) + ⇒ P ∉ int_angle A O B + +RightAnglesCongruent + |- ∀ α β. Right α ∧ Right β ⇒ α ≡ β + +OppositeRightAnglesLinear + |- ∀ A B O H h. + ¬Collinear A O H ∧ ¬Collinear H O B ∧ + Right (∡ A O H) ∧ Right (∡ H O B) ∧ + Line h ∧ O ∈ h ∧ H ∈ h ∧ ¬(A,B same_side h) + ⇒ O ∈ open (A,B) + +RightImpliesSupplRight + |- ∀ A O B A'. + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ Right (∡ A O B) + ⇒ Right (∡ B O A') + +IsoscelesCongBaseAngles + |- ∀ A B C. + ¬Collinear A B C ∧ seg B A ≡ seg B C + ⇒ ∡ C A B ≡ ∡ A C B + +C4withC1 + |- ∀ α l O A Y P Q. + Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ∧ + Line l ∧ O ∈ l ∧ A ∈ l ∧ Y ∉ l + ⇒ ∃ N. ¬(O = N) ∧ N ∉ l ∧ N,Y same_side l ∧ + seg O N ≡ seg P Q ∧ ∡ A O N ≡ α + +C4OppositeSide + |- ∀ α l O A Z P Q. + Angle α ∧ ¬(O = A) ∧ ¬(P = Q) ∧ + Line l ∧ O ∈ l ∧ A ∈ l ∧ Z ∉ l + ⇒ ∃ N. ¬(O = N) ∧ N ∉ l ∧ ¬(Z,N same_side l) ∧ + seg O N ≡ seg P Q ∧ ∡ A O N ≡ α + +SSS + |- ∀ A B C A' B' C'. + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + seg A B ≡ seg A' B' ∧ seg A C ≡ seg A' C' ∧ seg B C ≡ seg B' C' + ⇒ A,B,C ≅ A',B',C' + +AngleBisector + |- ∀ A B C. + ¬Collinear B A C + ⇒ ∃ F. F ∈ int_angle B A C ∧ ∡ B A F ≡ ∡ F A C + +EuclidPropositionI_6 + |- ∀ A B C. + ¬Collinear A B C ∧ ∡ B A C ≡ ∡ B C A + ⇒ seg B A ≡ seg B C + +IsoscelesExists + |- ∀ A B. ¬(A = B) ⇒ ∃ D. ¬Collinear A D B ∧ seg D A ≡ seg D B + +MidpointExists + |- ∀ A B. ¬(A = B) ⇒ ∃ M. M ∈ open (A,B) ∧ seg A M ≡ seg M B + +EuclidPropositionI_7short + |- ∀ A B C D a. + ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ + C,D same_side a ∧ seg A C ≡ seg A D + ⇒ ¬(seg B C ≡ seg B D) + +EuclidPropI_7Help + |- ∀ A B C D a. + ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ + C,D same_side a ∧ seg A C ≡ seg A D ∧ + (C ∈ int_triangle D A B ∨ ConvexQuadrilateral A B C D) + ⇒ ¬(seg B C ≡ seg B D) + +EuclidPropositionI_7 + |- ∀ A B C D a. + ¬(A = B) ∧ Line a ∧ A ∈ a ∧ B ∈ a ∧ ¬(C = D) ∧ C ∉ a ∧ D ∉ a ∧ + C,D same_side a ∧ seg A C ≡ seg A D + ⇒ ¬(seg B C ≡ seg B D) + +EuclidPropositionI_11 + |- ∀A B. ¬(A = B) ⇒ ∃ F. Right (∡ A B F) + +DropPerpendicularToLine + |- ∀ P l. + Line l ∧ P ∉ l + ⇒ ∃ E Q. E ∈ l ∧ Q ∈ l ∧ Right (∡ P Q E) + +EuclidPropositionI_14 + |- ∀ A B C D l. + Line l ∧ A ∈ l ∧ B ∈ l ∧ ¬(A = B) ∧ + C ∉ l ∧ D ∉ l ∧ ¬(C,D same_side l) ∧ + ∡ C B A suppl ∡ A B D + ⇒ B ∈ open (C,D) + +VerticalAnglesCong + |- ∀ A B O A' B'. + ¬Collinear A O B ∧ O ∈ open (A,A') ∧ O ∈ open (B,B') + ⇒ ∡ B O A' ≡ ∡ B' O A + +EuclidPropositionI_16 + |- ∀ A B C D. + ¬Collinear A B C ∧ C ∈ open (B,D) + ⇒ ∡ B A C <_ang ∡ D C A + +ExteriorAngle + |- ∀ A B C D. + ¬Collinear A B C ∧ C ∈ open (B,D) + ⇒ ∡ A B C <_ang ∡ A C D + +EuclidPropositionI_17 + |- ∀ A B C α β γ. + ¬Collinear A B C ∧ α = ∡ A B C ∧ β = ∡ B C A ∧ β suppl γ + ⇒ α <_ang γ + +EuclidPropositionI_18 + |- ∀ A B C. + ¬Collinear A B C ∧ seg A C <__ seg A B + ⇒ ∡ A B C <_ang ∡ B C A + +EuclidPropositionI_19 + |- ∀ A B C. + ¬Collinear A B C ∧ ∡ A B C <_ang ∡ B C A + ⇒ seg A C <__ seg A B + +EuclidPropositionI_20 + |- ∀ A B C D. + ¬Collinear A B C ∧ A ∈ open (B,D) ∧ seg A D ≡ seg A C + ⇒ seg B C <__ seg B D + +EuclidPropositionI_21 + |- ∀ A B C D. + ¬Collinear A B C ∧ D ∈ int_triangle A B C + ⇒ ∡ A B C <_ang ∡ C D A + +AngleTrichotomy3 + |- ∀ α β γ. + α <_ang β ∧ Angle γ ∧ γ ≡ α + ⇒ γ <_ang β + +InteriorCircleConvexHelp + |- ∀ O A B C. + ¬Collinear A O C ∧ B ∈ open (A,C) ∧ + seg O A <__ seg O C ∨ seg O A ≡ seg O C + ⇒ seg O B <__ seg O C + +InteriorCircleConvex + |- ∀ O R A B C. + ¬(O = R) ∧ B ∈ open (A,C) ∧ + A ∈ int_circle O R ∧ C ∈ int_circle O R + ⇒ B ∈ int_circle O R + +SegmentTrichotomy3 + |- ∀ s t u. s <__ t ∧ Segment u ∧ u ≡ s ⇒ u <__ t + +EuclidPropositionI_24Help + |- ∀ O A C O' D F. + ¬Collinear A O C ∧ ¬Collinear D O' F ∧ + seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ + ∡ D O' F <_ang ∡ A O C ∧ + seg O A <__ seg O C ∨ seg O A ≡ seg O C + ⇒ seg D F <__ seg A C + +EuclidPropositionI_24 + |- ∀ O A C O' D F. + ¬Collinear A O C ∧ ¬Collinear D O' F ∧ + seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ + ∡ D O' F <_ang ∡ A O C + ⇒ seg D F <__ seg A C + +EuclidPropositionI_25 + |- ∀ O A C O' D F. + ¬Collinear A O C ∧ ¬Collinear D O' F ∧ + seg O' D ≡ seg O A ∧ seg O' F ≡ seg O C ∧ + seg D F <__ seg A C + ⇒ ∡ D O' F <_ang ∡ A O C + +AAS + |- ∀ A B C A' B' C'. + ¬Collinear A B C ∧ ¬Collinear A' B' C' ∧ + ∡ A B C ≡ ∡ A' B' C' ∧ ∡ B C A ≡ ∡ B' C' A' ∧ + seg A B ≡ seg A' B' + ⇒ A,B,C ≅ A',B',C' + +ParallelSymmetry |- ∀ l k. l ∥ k ⇒ k ∥ l + +AlternateInteriorAngles + |- ∀ A B C E l m t. + Line l ∧ A ∈ l ∧ E ∈ l ∧ + Line m ∧ B ∈ m ∧ C ∈ m ∧ + Line t ∧ A ∈ t ∧ B ∈ t ∧ + ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ∧ + ¬(C,E same_side t) ∧ ∡ E A B ≡ ∡ C B A + ⇒ l ∥ m + +EuclidPropositionI_28 + |- ∀ A B C D E F G H l m t. + Line l ∧ A ∈ l ∧ B ∈ l ∧ G ∈ l ∧ + Line m ∧ C ∈ m ∧ D ∈ m ∧ H ∈ m ∧ + Line t ∧ G ∈ t ∧ H ∈ t ∧ G ∉ m ∧ H ∉ l ∧ + G ∈ open (A,B) ∧ H ∈ open (C,D) ∧ + G ∈ open (E,H) ∧ H ∈ open (F,G) ∧ ¬(D,A same_side t) ∧ + ∡ E G B ≡ ∡ G H D ∨ ∡ B G H suppl ∡ G H D + ⇒ l ∥ m + +OppositeSidesCongImpliesParallelogram + |- ∀ A B C D. + Quadrilateral A B C D ∧ + seg A B ≡ seg C D ∧ seg B C ≡ seg D A + ⇒ Parallelogram A B C D + +OppositeAnglesCongImpliesParallelogramHelp + |- ∀ A B C D a c. + Quadrilateral A B C D ∧ + ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D ∧ + Line a ∧ A ∈ a ∧ B ∈ a ∧ Line c ∧ C ∈ c ∧ D ∈ c + ⇒ a ∥ c + +OppositeAnglesCongImpliesParallelogram + |- ∀ A B C D. + Quadrilateral A B C D ∧ + ∡ A B C ≡ ∡ C D A ∧ ∡ D A B ≡ ∡ B C D + ⇒ Parallelogram A B C D + + +P |- ∀ P l. Line l ∧ P ∉ l ⇒ ∃! m. Line m ∧ P ∈ m ∧ m ∥ l + +AMa |- ∀ α. Angle α ⇒ &0 < μ α ∧ μ α < &180 + +AMb |- ∀ α. Right α ⇒ μ α = &90 + +AMc |- ∀ α β. Angle α ∧ Angle β ∧ α ≡ β ⇒ μ α = μ β + +AMd |- ∀ A O B P. P ∈ int_angle A O B + ⇒ μ (∡ A O B) = μ (∡ A O P) + μ (∡ P O B) + + +ConverseAlternateInteriorAngles + |- ∀ A B C E l m t. + Line l ∧ A ∈ l ∧ E ∈ l ∧ + Line m ∧ B ∈ m ∧ C ∈ m ∧ + Line t ∧ A ∈ t ∧ B ∈ t ∧ + ¬(A = E) ∧ ¬(B = C) ∧ ¬(A = B) ∧ E ∉ t ∧ C ∉ t ∧ + ¬(C,E same_side t) ∧ l ∥ m + ⇒ ∡ E A B ≡ ∡ C B A + +HilbertTriangleSum + |- ∀ A B C. + ¬Collinear A B C + ⇒ ∃ E F. + B ∈ open (E,F) ∧ C ∈ int_angle A B F ∧ + ∡ E B A ≡ ∡ C A B ∧ ∡ C B F ≡ ∡ B C A + +EuclidPropositionI_13 + |- ∀A O B A'. + ¬Collinear A O B ∧ O ∈ open (A,A') + ⇒ μ (∡ A O B) + μ (∡ B O A') = &180 + +TriangleSum + |- ∀ A B C. + ¬Collinear A B C + ⇒ μ (∡ A B C) + μ (∡ B C A) + μ (∡ C A B) = &180 diff --git a/Rqe/asym.ml b/Rqe/asym.ml new file mode 100644 index 0000000..44d8c2d --- /dev/null +++ b/Rqe/asym.ml @@ -0,0 +1,3227 @@ +override_interface ("-->",`(tends_num_real)`);; +prioritize_real();; + +(* ---------------------------------------------------------------------- *) +(* properites of num sequences *) +(* ---------------------------------------------------------------------- *) + +let LIM_INV_1N = prove_by_refinement( + `(\n. &1 / &n) --> &0`, +(* {{{ Proof *) + +[ + REWRITE_TAC[SEQ;real_sub;REAL_ADD_RID;REAL_NEG_0;real_gt;real_ge;GT;GE]; + REPEAT STRIP_TAC; + MP_TAC (ISPEC `&2 / e` REAL_ARCH_SIMPLE); + STRIP_TAC; + EXISTS_TAC `n`; + REPEAT STRIP_TAC; + CLAIM `&0 < &2 / e`; + ASM_MESON_TAC[REAL_LT_RDIV_0;REAL_ARITH `&0 < &2`]; + STRIP_TAC; + CLAIM `&0 < &n`; + ASM_MESON_TAC[REAL_LTE_TRANS;REAL_LE]; + STRIP_TAC; + CLAIM `&0 < &n'`; + ASM_MESON_TAC[REAL_LTE_TRANS;REAL_LE]; + STRIP_TAC; + CLAIM `~(&n' = &0)`; + ASM_MESON_TAC[REAL_LT_IMP_NZ]; + STRIP_TAC; + ASM_SIMP_TAC[ABS_DIV]; + REWRITE_TAC[REAL_ABS_NUM]; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ]; + CLAIM `&2 <= e * &n`; + ASM_MESON_TAC[REAL_LE_LDIV_EQ;REAL_MUL_SYM]; + STRIP_TAC; + CLAIM `e * &n <= e * &n'`; + MATCH_MP_TAC REAL_LE_LMUL; + ASM_MESON_TAC [REAL_LT_LE;REAL_LE]; + STRIP_TAC; + ASM_MESON_TAC[REAL_LTE_TRANS;REAL_LE_TRANS;REAL_ARITH `&1 < &2`]; +]);; + +(* }}} *) + +let LIM_INV_CONST = prove_by_refinement( + `!c. (\n. c / &n) --> &0`, +(* {{{ Proof *) + +[ + ONCE_REWRITE_TAC[REAL_ARITH `c / &n = c * &1 / &n`]; + STRIP_TAC; + CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV[REAL_ARITH `&0 = c * &0`])); + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC THENL [MATCH_ACCEPT_TAC SEQ_CONST;MATCH_ACCEPT_TAC LIM_INV_1N]; +]);; + +(* }}} *) + +let LIM_INV_1NP = prove_by_refinement( + `!c k. 0 < k ==> (\n. c / &n pow k) --> &0`, +(* {{{ Proof *) +[ + STRIP_TAC; + INDUCT_TAC; + REWRITE_TAC[ARITH_RULE `~(0 < 0)`]; + REWRITE_TAC[real_pow;REAL_DIV_DISTRIB_R]; + STRIP_TAC; + CASES_ON `k = 0`; + ASM_REWRITE_TAC[real_pow;GSYM REAL_DIV_DISTRIB_R;REAL_MUL_RID]; + MATCH_ACCEPT_TAC LIM_INV_CONST; + CLAIM `(\n. c / &n pow k) --> &0`; + FIRST_ASSUM MATCH_MP_TAC; + EVERY_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 * &0`]; + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC THENL [MATCH_ACCEPT_TAC LIM_INV_1N;FIRST_ASSUM MATCH_ACCEPT_TAC]; +]);; +(* }}} *) + +let LIM_INV_CON = prove_by_refinement( + `!c d k. 0 < k ==> (\n. c / (d * &n pow k)) --> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[REAL_DIV_DISTRIB_R]; + REPEAT STRIP_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `&0 = (&1 / d) * &0`]; + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC; + MATCH_ACCEPT_TAC SEQ_CONST; + POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC LIM_INV_1NP; +]);; +(* }}} *) + +let LIM_NN = prove_by_refinement( + `(\n. &n / &n) --> &1`, +(* {{{ Proof *) +[ + REWRITE_TAC[SEQ]; + REPEAT STRIP_TAC; + EXISTS_TAC `1`; + REWRITE_TAC[GT;GE]; + REPEAT STRIP_TAC; + CLAIM `~(&n = &0)`; + MATCH_MP_TAC REAL_LT_IMP_NZ; + ASM_MESON_TAC[REAL_LE;REAL_ARITH `&0 < &1`;REAL_LTE_TRANS]; + STRIP_TAC; + ASM_SIMP_TAC[REAL_DIV_REFL;real_sub;REAL_ADD_RINV;ABS_0]; +]);; +(* }}} *) + +let LIM_NNC = prove_by_refinement( + `~(k = &0) ==> (\n. (k * &n) / (k * &n)) --> &1`, +(* {{{ Proof *) +[ + REWRITE_TAC[REAL_DIV_DISTRIB_2]; + ONCE_REWRITE_TAC[REAL_ARITH `&1 = &1 * &1`]; + STRIP_TAC; + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC; + ASM_SIMP_TAC[real_div;REAL_MUL_RINV]; + MATCH_ACCEPT_TAC SEQ_CONST; + MATCH_ACCEPT_TAC LIM_NN; +]);; +(* }}} *) + +let LIM_MONO = prove_by_refinement( + `!c d a b. ~(d = &0) /\ a < b ==> (\n. (c * &n pow a) / (d * &n pow b)) --> &0`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC; + INDUCT_TAC; + REPEAT STRIP_TAC; + REWRITE_TAC[real_pow;REAL_MUL_RID]; + POP_ASSUM MP_TAC THEN MATCH_ACCEPT_TAC LIM_INV_CON; + REPEAT STRIP_TAC; + REWRITE_TAC[real_pow]; + CLAIM `(b = SUC(PRE b))`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ONCE_ASM_REWRITE_TAC[]; + REWRITE_TAC[real_pow]; + ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c`]; + ONCE_REWRITE_TAC[REAL_DIV_DISTRIB_2]; + ONCE_REWRITE_TAC[REAL_ARITH `&0 = &1 * &0`]; + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC; + MATCH_ACCEPT_TAC LIM_NN; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC; + ARITH_TAC; +]);; +(* }}} *) + +let LIM_POLY_LT = prove_by_refinement( + `!p k. LENGTH p <= k ==> (\n. poly p (&n) / &n pow k) --> &0`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[poly;LENGTH]; + REPEAT STRIP_TAC; + REWRITE_TAC[REAL_DIV_LZERO;SEQ_CONST]; + REWRITE_TAC[poly;LENGTH]; + REPEAT STRIP_TAC; + CLAIM `~(k = 0)`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + LABEL_ALL_TAC; + CLAIM `LENGTH t <= PRE k`; + USE_THEN "Z-1" MP_TAC THEN ARITH_TAC; + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + STRIP_TAC; + REWRITE_TAC[REAL_DIV_ADD_DISTRIB]; + ONCE_REWRITE_TAC[REAL_ARITH `&0 = &0 + &0`]; + MATCH_MP_TAC SEQ_ADD; + CONJ_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `n pow k = &1 * n pow k`]; + MATCH_MP_TAC LIM_INV_CON; + USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; + CLAIM `k = SUC (PRE k)`; + USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ONCE_ASM_REWRITE_TAC[]; + REWRITE_TAC[real_pow]; + REWRITE_TAC[REAL_DIV_DISTRIB_2]; + ONCE_REWRITE_TAC[REAL_ARITH `&0 = &1 * &0`]; + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC; + MATCH_ACCEPT_TAC LIM_NN; + FIRST_ASSUM MATCH_MP_TAC; + USE_THEN "Z-1" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +let LIM_POLY = prove_by_refinement( + `!p. (0 < LENGTH p /\ ~(LAST p = &0)) ==> + (\n. poly p (&n) / (LAST p * &n pow PRE (LENGTH p))) --> &1`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH;LT]; + ASM_REWRITE_TAC[LENGTH;poly]; + REPEAT STRIP_TAC; + CASES_ON `t = []`; + ASM_REWRITE_TAC[PRE;real_pow;REAL_POW_1;LAST;poly;REAL_MUL_RZERO;REAL_ADD_RID;LENGTH;REAL_DIV_DISTRIB_L]; + CLAIM `~(h = &0)`; + ASM_MESON_TAC[LAST]; + STRIP_TAC; + CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV[REAL_ARITH `&1 = &1 * &1`])); + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC; + ASM_SIMP_TAC[DIV_ID]; + MATCH_ACCEPT_TAC SEQ_CONST; + ASM_SIMP_TAC[DIV_ID;REAL_10]; + MATCH_ACCEPT_TAC SEQ_CONST; + CLAIM `LAST (CONS h t) = LAST t`; + ASM_REWRITE_TAC[LAST]; + STRIP_TAC; + ASM_REWRITE_TAC[LAST;PRE]; + REWRITE_TAC[REAL_DIV_ADD_DISTRIB]; + ONCE_REWRITE_TAC [REAL_ARITH `&1 = &0 + &1`]; + MATCH_MP_TAC SEQ_ADD; + CLAIM `~(LENGTH t = 0)`; + ASM_MESON_TAC[LENGTH_0]; + STRIP_TAC; + CONJ_TAC; + MATCH_MP_TAC LIM_INV_CON; + POP_ASSUM MP_TAC THEN ARITH_TAC; + CLAIM `(LENGTH t = SUC (PRE (LENGTH t)))`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ONCE_ASM_REWRITE_TAC[]; + REWRITE_TAC[real_pow]; + ONCE_REWRITE_TAC[ARITH_RULE `a * b * c = b * a * c`]; + REWRITE_TAC[REAL_DIV_DISTRIB_2]; + ONCE_REWRITE_TAC [REAL_ARITH `&1 = &1 * &1`]; + MATCH_MP_TAC SEQ_MUL; + CONJ_TAC; + MATCH_ACCEPT_TAC LIM_NN; + FIRST_ASSUM MATCH_MP_TAC; + CONJ_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN ARITH_TAC; + ASM_MESON_TAC[]; +]);; + +(* }}} *) + +let mono_inc = new_definition( + `mono_inc (f:num -> real) = !(m:num) n. m <= n ==> f m <= f n`);; + +let mono_dec = new_definition( + `mono_dec (f:num -> real) = !(m:num) n. m <= n ==> f n <= f m`);; + +let mono_inc_dec = prove_by_refinement( + `!f. mono f <=> mono_inc f \/ mono_dec f`, +(* {{{ Proof *) +[ + REWRITE_TAC[mono_inc;mono_dec;mono;real_ge] +]);; +(* }}} *) + +let mono_inc_pow = prove_by_refinement( + `!k. mono_inc (\n. &n pow k)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mono_inc]; + INDUCT_TAC THEN REWRITE_TAC[real_pow;REAL_LE_REFL]; + GEN_TAC THEN GEN_TAC; + DISCH_THEN (fun x -> (RULE_ASSUM_TAC (fun y -> MATCH_MP y x)) THEN ASSUME_TAC x); + MATCH_MP_TAC REAL_LE_MUL2; + REPEAT STRIP_TAC; + MATCH_ACCEPT_TAC REAL_NUM_LE_0; + ASM_REWRITE_TAC[REAL_LE]; + MATCH_MP_TAC REAL_POW_LE; + MATCH_ACCEPT_TAC REAL_NUM_LE_0; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; + +(* }}} *) + +let mono_inc_pow_const = prove_by_refinement( + `!k c. &0 < c ==> mono_inc (\n. c * &n pow k)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mono_inc]; + REPEAT STRIP_TAC; + MATCH_MP_TAC REAL_LE_MUL2; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_LE]; + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_LE; + MATCH_ACCEPT_TAC REAL_NUM_LE_0; + ASM_MESON_TAC[mono_inc_pow;mono_inc] +]);; + +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* Unbounded sequences *) +(* ---------------------------------------------------------------------- *) + +let mono_unbounded_above = new_definition( + `mono_unbounded_above (f:num -> real) = !c. ?N. !n. N <= n ==> c < f n`);; + +let mono_unbounded_below = new_definition( + `mono_unbounded_below (f:num -> real) = !c. ?N. !n. N <= n ==> f n < c`);; + +let mono_unbounded_above_pos = prove_by_refinement( + `mono_unbounded_above (f:num -> real) = !c. &0 <= c ==> ?N. !n. N <= n ==> c < f n`, +(* {{{ Proof *) +[ + REWRITE_TAC[mono_unbounded_above]; + EQ_TAC THENL [ASM_MESON_TAC[];ALL_TAC]; + REPEAT STRIP_TAC; + POP_ASSUM (ASSUME_TAC o ISPEC `abs c`); + POP_ASSUM (MP_TAC o (C MATCH_MP) (ISPEC `c:real` ABS_POS)); + STRIP_TAC; + EXISTS_TAC `N`; + GEN_TAC; + DISCH_THEN (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + ASM_MESON_TAC[ABS_LE;REAL_LET_TRANS]; +]);; +(* }}} *) + +let mono_unbounded_below_neg = prove_by_refinement( + `mono_unbounded_below (f:num -> real) = !c. c <= &0 ==> ?N. !n. N <= n ==> f n < c`, +(* {{{ Proof *) +[ + REWRITE_TAC[mono_unbounded_below]; + EQ_TAC THENL [ASM_MESON_TAC[];ALL_TAC]; + REPEAT STRIP_TAC; + POP_ASSUM (ASSUME_TAC o ISPEC `-- (abs c)`); + POP_ASSUM (MP_TAC o (C MATCH_MP) (ISPEC `c:real` NEG_ABS)); + STRIP_TAC; + EXISTS_TAC `N`; + GEN_TAC; + DISCH_THEN (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let mua_quotient_limit = prove_by_refinement( + `!k f g. &0 < k /\ (\n. f n / g n) --> k /\ mono_unbounded_above g + ==> mono_unbounded_above f`, +(* {{{ Proof *) +[ + REWRITE_TAC[SEQ;mono_unbounded_above_pos;AND_IMP_THM]; + REPEAT GEN_TAC; + STRIP_TAC; + CLAIM `&0 < k / &2`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + DISCH_THEN (fun x -> DISCH_THEN (fun y -> (ASSUME_TAC (MATCH_MP (ISPEC `k / &2` y) x)))); + POP_ASSUM (X_CHOOSE_TAC `M:num`); + STRIP_TAC; + X_GEN_TAC `d:real`; + STRIP_TAC; + CLAIM `&0 <= &2 * d / k`; + MATCH_MP_TAC REAL_LE_MUL; + CONJ_TAC THENL [REAL_ARITH_TAC;ALL_TAC]; + MATCH_MP_TAC REAL_LE_DIV; + CONJ_TAC THENL [FIRST_ASSUM MATCH_ACCEPT_TAC;ASM_MESON_TAC[REAL_LT_LE]]; + STRIP_TAC; + LABEL_ALL_TAC; + MOVE_TO_FRONT "Z-2"; + POP_ASSUM (fun x -> USE_THEN "Z-0" (fun y -> MP_TAC (MATCH_MP x y))); + DISCH_THEN (X_CHOOSE_TAC `K:num`); + EXISTS_TAC `nmax M K`; + REPEAT STRIP_TAC; + CLAIM `M <= n /\ K <= (n:num)`; + POP_ASSUM MP_TAC THEN REWRITE_TAC[nmax] THEN COND_CASES_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[GE]); + FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + FIRST_X_ASSUM (fun x -> FIRST_X_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + RULE_ASSUM_TAC (REWRITE_RULE[real_div]); + CASES_ON `k <= f n * inv (g n)`; + MATCH_MP_TAC (prove(`d <= &2 * d /\ &2 * d < k * (g n) /\ k * (g n) <= f n ==> d < f n`,MESON_TAC !REAL_REWRITES)); + REPEAT STRIP_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + FIRST_ASSUM (fun x -> ASSUME_TAC (MATCH_MP (REWRITE_RULE[AND_IMP_THM] REAL_LT_LMUL) x)); + LABEL_ALL_TAC; + POP_ASSUM (fun y -> USE_THEN "Z-6" (fun x -> ASSUME_TAC (MATCH_MP y x))); + CLAIM `k * &2 * d * inv k = (k * inv k) * &2 * d`; + REAL_ARITH_TAC; + CLAIM `k * inv k = &1`; + ASM_MESON_TAC[REAL_MUL_RINV;REAL_LT_NZ]; + STRIP_TAC; + ASM_REWRITE_TAC[REAL_MUL_LID]; + ASM_MESON_TAC[]; + (* *) + MATCH_MP_TAC REAL_LE_RCANCEL_IMP; + EXISTS_TAC `inv (g n)`; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + CLAIM `&0 < inv (g n)`; + CLAIM `&0 < inv k`; + MATCH_MP_TAC REAL_LT_INV THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + CLAIM `&0 < g n`; + ASM_MESON_TAC !REAL_REWRITES; + STRIP_TAC; + ASM_MESON_TAC[REAL_LT_INV]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `g n * inv (g n) = &1`; + ASM_MESON_TAC[REAL_MUL_RINV;REAL_LT_NZ;REAL_LT_INV_EQ]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[REAL_MUL_RID]; + FIRST_ASSUM MATCH_ACCEPT_TAC; + (* *) + RULE_ASSUM_TAC (REWRITE_RULE[REAL_NOT_LE]); + CLAIM `f n * inv (g n) - k < &0`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `abs (f n * inv (g n) - k) = k - (f n * inv (g n))`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + DISCH_THEN (RULE_ASSUM_TAC o REWRITE_RULE o list); + CLAIM `k * inv(&2) < f n * inv (g n)`; + LABEL_ALL_TAC; + USE_THEN "Z-5" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `k * g n < &2 * f n`; + CLAIM `&0 < g n`; + LABEL_ALL_TAC; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `&2 * d * inv k`; + CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP; + EXISTS_TAC `inv(&2)`; + CONJ_TAC THENL [REAL_ARITH_TAC;ALL_TAC]; + REWRITE_TAC[ARITH_RULE `inv(&2) * &2 = &1`;REAL_MUL_LID;REAL_MUL_ASSOC]; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP; + EXISTS_TAC `inv(g n)`; + CONJ_TAC; + ASM_MESON_TAC[REAL_LT_INV]; + ONCE_REWRITE_TAC[ARITH_RULE `a * (b * c) * d = c * b * (d * a)`]; + CLAIM `g n * inv (g n) = &1`; + POP_ASSUM MP_TAC THEN ASM_MESON_TAC[REAL_MUL_RINV;REAL_POS_NZ]; + DISCH_THEN SUBST1_TAC; + ASM_MESON_TAC[REAL_MUL_RID;REAL_MUL_SYM]; + STRIP_TAC; + CLAIM `&2 * d < k * g n`; + MATCH_MP_TAC REAL_LT_RCANCEL_IMP; + EXISTS_TAC `inv k`; + STRIP_TAC; + ASM_MESON_TAC[REAL_LT_INV]; + MATCH_MP_TAC REAL_LTE_TRANS; + EXISTS_TAC `g n`; + CONJ_TAC; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + FIRST_ASSUM MATCH_ACCEPT_TAC; + LABEL_ALL_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `(a * b) * c = b * (a * c)`]; + CLAIM `k * inv k = &1`; + ASM_MESON_TAC[REAL_MUL_RINV;REAL_POS_NZ]; + DISCH_THEN SUBST1_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&2 * d < &2 * f n`; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let mua_neg = prove_by_refinement( + `!f. mono_unbounded_above f = mono_unbounded_below (\n. -- (f n))`, +(* {{{ Proof *) + +[ + MESON_TAC[mono_unbounded_above;mono_unbounded_below;REAL_ARITH `x < y ==> --y < -- x`;REAL_ARITH `-- (-- x) = x`]; +]);; + +(* }}} *) + +let mua_neg2 = prove_by_refinement( + `!f. mono_unbounded_below f = mono_unbounded_above (\n. -- (f n))`, +(* {{{ Proof *) +[ + MESON_TAC[mono_unbounded_above;mono_unbounded_below;REAL_ARITH `x < y ==> --y < -- x`;REAL_ARITH `-- (-- x) = x`]; +]);; +(* }}} *) + +let mua_quotient_limit_neg = prove_by_refinement( + `!k f g. &0 < k /\ (\n. f n / g n) --> k /\ mono_unbounded_below g + ==> mono_unbounded_below f`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mua_neg2]; + REPEAT STRIP_TAC; + MATCH_MP_TAC (mua_quotient_limit); + EXISTS_TAC `k`; + EXISTS_TAC `\n. -- g n`; + ASM_REWRITE_TAC[]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + REWRITE_TAC[SEQ]; + DISCH_THEN (fun x -> REPEAT STRIP_TAC THEN MP_TAC x); + DISCH_THEN (MP_TAC o ISPEC `e:real`); + ANTS_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + EXISTS_TAC `N`; + REPEAT STRIP_TAC; + REWRITE_TAC[real_div;REAL_NEG_MUL2;REAL_INV_NEG]; + ASM_MESON_TAC[real_div]; +]);; + +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* Polynomial properties *) +(* ---------------------------------------------------------------------- *) + +let normal = new_definition( + `normal p <=> ((normalize p = p) /\ ~(p = []))`);; + +let nonconstant = new_definition( + `nonconstant p <=> normal p /\ (!x. ~(p = [x]))`);; + +let NORMALIZE_SING = prove_by_refinement( + `!x. (normalize [x] = [x]) <=> ~(x = &0)`, +(* {{{ Proof *) +[ + MESON_TAC[NOT_CONS_NIL;normalize]; +]);; +(* }}} *) + +let NORMALIZE_PAIR = prove_by_refinement( + `!x y. ~(y = &0) <=> (normalize [x; y] = [x; y])`, +(* {{{ Proof *) +[ + REWRITE_TAC[normalize;NOT_CONS_NIL]; + REPEAT GEN_TAC; + COND_CASES_TAC; + CLAIM `y = &0`; + ASM_MESON_TAC !LIST_REWRITES; + DISCH_THEN SUBST1_TAC; + ASM_MESON_TAC !LIST_REWRITES; + ASM_MESON_TAC !LIST_REWRITES; +]);; +(* }}} *) + +let POLY_NORMALIZE = prove + (`!p. poly (normalize p) = poly p`, +(* {{{ Proof *) + LIST_INDUCT_TAC THEN REWRITE_TAC[normalize; poly] THEN + ASM_CASES_TAC `h = &0` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[poly; FUN_EQ_THM] THEN + UNDISCH_TAC `poly (normalize t) = poly t` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[poly] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID]);; +(* }}} *) + +let NORMAL_CONS = prove_by_refinement( + `!h t. normal t ==> normal (CONS h t)`, + (* {{{ Proof *) +[ + REWRITE_TAC[normal;normalize]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[NOT_CONS_NIL]; +]);; +(* }}} *) + +let NORMAL_TAIL = prove_by_refinement( + `!h t. ~(t = []) /\ normal (CONS h t) ==> normal t`, +(* {{{ Proof *) +[ + REWRITE_TAC[normal;normalize]; + REPEAT STRIP_TAC THENL [ALL_TAC;ASM_MESON_TAC[]]; + CASES_ON `normalize t = []`; + ASM_MESON_TAC[NOT_CONS_NIL;CONS_11]; + ASM_MESON_TAC[NOT_CONS_NIL;CONS_11]; +]);; +(* }}} *) + +let NORMAL_LAST_NONZERO = prove_by_refinement( + `!p. normal p ==> ~(LAST p = &0)`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + ASM_MESON_TAC[normal]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[normal;normalize;NOT_CONS_NIL;LAST]; + MESON_TAC[NOT_CONS_NIL]; + ASM_SIMP_TAC[GSYM LAST_CONS]; + ASM_REWRITE_TAC[LAST;NOT_CONS_NIL;]; + STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + MATCH_MP_TAC NORMAL_TAIL; + ASM_MESON_TAC[]; +]);; + +(* }}} *) + +let NORMAL_LENGTH = prove_by_refinement( + `!p. normal p ==> 0 < LENGTH p`, +(* {{{ Proof *) + +[ + MESON_TAC[normal;LENGTH_0;ARITH_RULE `~(n = 0) <=> 0 < n`] +]);; + +(* }}} *) + +let NORMAL_LAST_LENGTH = prove_by_refinement( + `!p. 0 < LENGTH p /\ ~(LAST p = &0) ==> normal p`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + MESON_TAC[LENGTH;LT_REFL]; + STRIP_TAC; + CASES_ON `t = []`; + ASM_REWRITE_TAC[normal;NORMALIZE_SING;NOT_CONS_NIL;]; + ASM_MESON_TAC[LAST]; + MATCH_MP_TAC NORMAL_CONS; + FIRST_ASSUM MATCH_MP_TAC; + STRIP_TAC; + ASM_MESON_TAC[LENGTH_0;ARITH_RULE `~(n = 0) <=> 0 < n`]; + ASM_MESON_TAC[LAST_CONS]; +]);; + +(* }}} *) + +let NORMAL_ID = prove_by_refinement( + `!p. normal p <=> 0 < LENGTH p /\ ~(LAST p = &0)`, +(* {{{ Proof *) +[ + MESON_TAC[NORMAL_LAST_LENGTH;NORMAL_LENGTH;NORMAL_LAST_NONZERO]; +]);; +(* }}} *) + +let LIM_POLY2 = prove_by_refinement( + `!p. normal p ==> (\n. poly p (&n) / (LAST p * &n pow (degree p))) --> &1`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[degree]; + CLAIM `normalize p = p`; + ASM_MESON_TAC[normal]; + DISCH_THEN SUBST1_TAC; + MATCH_MP_TAC LIM_POLY; + ASM_MESON_TAC[NORMAL_ID]; +]);; + +(* }}} *) + +let POW_UNB = prove_by_refinement( + `!k. 0 < k ==> mono_unbounded_above (\n. (&n) pow k)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mono_unbounded_above]; + REPEAT STRIP_TAC; + MP_TAC (ISPEC `max (&1) c` REAL_ARCH_SIMPLE_LT); + STRIP_TAC; + EXISTS_TAC `n`; + REPEAT STRIP_TAC; + MATCH_MP_TAC REAL_LTE_TRANS; + EXISTS_TAC `&n`; + CONJ_TAC; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `max (&1) c`; + ASM_MESON_TAC[REAL_MAX_MAX]; + MATCH_MP_TAC REAL_LE_TRANS; + EXISTS_TAC `&n'`; + STRIP_TAC; + ASM_MESON_TAC[REAL_LE]; + CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[REAL_ARITH `x = x pow 1`])); + MATCH_MP_TAC REAL_POW_MONO; + STRIP_TAC; + MATCH_MP_TAC REAL_LE_TRANS; + EXISTS_TAC `max (&1) c`; + CONJ_TAC THENL [ASM_MESON_TAC[REAL_MAX_MAX];ALL_TAC]; + MATCH_MP_TAC REAL_LE_TRANS; + EXISTS_TAC `&n`; + ASM_MESON_TAC (!REAL_REWRITES @ [REAL_LE;REAL_LT_LE]); + EVERY_ASSUM MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +let POW_UNB_CON = prove_by_refinement( + `!k a. 0 < k /\ &0 < a ==> mono_unbounded_above (\n. a * (&n) pow k)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mono_unbounded_above;AND_IMP_THM;]; + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + MOVE_TO_FRONT "Z-1"; + POP_ASSUM (fun x -> MP_TAC (MATCH_MP POW_UNB x)); + REWRITE_TAC[mono_unbounded_above]; + DISCH_THEN (MP_TAC o ISPEC `inv a * c`); + STRIP_TAC; + EXISTS_TAC `N`; + STRIP_TAC; + DISCH_THEN (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + CLAIM `inv a * a = &1`; + MATCH_MP_TAC REAL_MUL_LINV; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP; + EXISTS_TAC `inv a`; + CONJ_TAC; + ASM_MESON_TAC[REAL_LT_INV]; + ASM_REWRITE_TAC[REAL_MUL_ASSOC;REAL_MUL_LID]; +]);; + +(* }}} *) + +let POW_UNBB_CON = prove_by_refinement( + `!k a. 0 < k /\ a < &0 ==> mono_unbounded_below (\n. a * (&n) pow k)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mua_neg2;ARITH_RULE `--(x * y) = -- x * y`]; + REPEAT STRIP_TAC; + MATCH_MP_TAC POW_UNB_CON; + STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; + +(* }}} *) + +let POLY_SING = prove_by_refinement( + `!x y. poly [x] y = x`, +(* {{{ Proof *) +[ + REWRITE_TAC[poly]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_LAST_GT = prove_by_refinement( + `!p. normal p /\ (?X. !x. X < x ==> &0 < poly p x) ==> &0 < LAST p`, +(* {{{ Proof *) + +[ + GEN_TAC; + CASES_ON `LENGTH p = 1`; + RULE_ASSUM_TAC (REWRITE_RULE[LENGTH_1]); + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[LAST_SING;POLY_SING]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + EXISTS_TAC `X + &1`; + REAL_ARITH_TAC; + (* *) + REWRITE_TAC[AND_IMP_THM;]; + DISCH_THEN (fun x -> MP_TAC (MATCH_MP LIM_POLY2 x) THEN ASSUME_TAC x); + REPEAT STRIP_TAC; + DISJ_CASES_TAC (ISPECL [`&0`;`LAST (p:real list)`] REAL_LT_TOTAL); + ASM_MESON_TAC[NORMAL_ID]; + POP_ASSUM DISJ_CASES_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + (* save *) + CLAIM `mono_unbounded_below (\n. LAST p * &n pow degree p)`; + MATCH_MP_TAC POW_UNBB_CON; + REWRITE_TAC[degree]; + CONJ_TAC THENL [ALL_TAC;FIRST_ASSUM MATCH_ACCEPT_TAC]; + CLAIM `normalize p = p`; + ASM_MESON_TAC[normal]; + DISCH_THEN SUBST1_TAC; + CLAIM `~(LENGTH p = 0)`; + ASM_MESON_TAC[normal;LENGTH_EQ_NIL]; + LABEL_ALL_TAC; + USE_THEN "Z-4" MP_TAC; + ARITH_TAC; + (* save *) + STRIP_TAC; + CLAIM `mono_unbounded_below (\n. poly p (&n))`; + MATCH_MP_TAC mua_quotient_limit_neg; + BETA_TAC; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. LAST p * &n pow degree p)`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + BETA_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + REWRITE_TAC[mono_unbounded_below]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM_LIST (fun x -> ALL_TAC); + MP_TAC (ISPEC `X:real` REAL_ARCH_SIMPLE); + STRIP_TAC; + DISCH_THEN (ASSUME_TAC o ISPEC `1 + nmax N n`); + DISCH_THEN (ASSUME_TAC o ISPEC `&1 + &(nmax N n)`); + POP_ASSUM MP_TAC THEN ANTS_TAC; + REWRITE_TAC[nmax]; + COND_CASES_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[NOT_LE;GSYM REAL_LT]); + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + POP_ASSUM MP_TAC THEN ANTS_TAC; + REWRITE_TAC[nmax]; + ARITH_TAC; + ASM_MESON_TAC[ARITH_RULE `~(x < y /\ y < x)`;GSYM REAL_OF_NUM_ADD]; +]);; + +(* }}} *) + +let POLY_LAST_LT = prove_by_refinement( + `!p. normal p /\ (?X. !x. X < x ==> poly p x < &0) ==> LAST p < &0`, +(* {{{ Proof *) + +[ + GEN_TAC; + CASES_ON `LENGTH p = 1`; + RULE_ASSUM_TAC (REWRITE_RULE[LENGTH_1]); + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[LAST_SING;POLY_SING]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + EXISTS_TAC `X + &1`; + REAL_ARITH_TAC; + (* *) + REWRITE_TAC[AND_IMP_THM;]; + DISCH_THEN (fun x -> MP_TAC (MATCH_MP LIM_POLY2 x) THEN ASSUME_TAC x); + REPEAT STRIP_TAC; + DISJ_CASES_TAC (ISPECL [`&0`;`LAST (p:real list)`] REAL_LT_TOTAL); + ASM_MESON_TAC[NORMAL_ID]; + POP_ASSUM DISJ_CASES_TAC THENL [ALL_TAC;FIRST_ASSUM MATCH_ACCEPT_TAC]; + (* save *) + CLAIM `mono_unbounded_above (\n. LAST p * &n pow degree p)`; + MATCH_MP_TAC POW_UNB_CON; + REWRITE_TAC[degree]; + CONJ_TAC THENL [ALL_TAC;FIRST_ASSUM MATCH_ACCEPT_TAC]; + CLAIM `normalize p = p`; + ASM_MESON_TAC[normal]; + DISCH_THEN SUBST1_TAC; + CLAIM `~(LENGTH p = 0)`; + ASM_MESON_TAC[normal;LENGTH_EQ_NIL]; + LABEL_ALL_TAC; + USE_THEN "Z-4" MP_TAC; + ARITH_TAC; + (* save *) + STRIP_TAC; + CLAIM `mono_unbounded_above (\n. poly p (&n))`; + MATCH_MP_TAC mua_quotient_limit; + BETA_TAC; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. LAST p * &n pow degree p)`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + BETA_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + REWRITE_TAC[mono_unbounded_above]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM_LIST (fun x -> ALL_TAC); + MP_TAC (ISPEC `X:real` REAL_ARCH_SIMPLE); + STRIP_TAC; + DISCH_THEN (ASSUME_TAC o ISPEC `1 + nmax N n`); + DISCH_THEN (ASSUME_TAC o ISPEC `&1 + &(nmax N n)`); + POP_ASSUM MP_TAC THEN ANTS_TAC; + REWRITE_TAC[nmax]; + COND_CASES_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[NOT_LE;GSYM REAL_LT]); + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + POP_ASSUM MP_TAC THEN ANTS_TAC; + REWRITE_TAC[nmax]; + ARITH_TAC; + ASM_MESON_TAC[ARITH_RULE `~(x < y /\ y < x)`;GSYM REAL_OF_NUM_ADD]; +]);; + +(* }}} *) + +let NORMALIZE_LENGTH_MONO = prove_by_refinement( + `!l. LENGTH (normalize l) <= LENGTH l`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + MESON_TAC[normalize;LE_REFL]; + REWRITE_TAC[LENGTH;normalize]; + REPEAT COND_CASES_TAC THEN REWRITE_TAC[LENGTH] THEN EVERY_ASSUM MP_TAC THEN ARITH_TAC; +]);; +(* }}} *) + +let DEGREE_SING = prove_by_refinement( + `!x. (degree [x] = 0)`, +(* {{{ Proof *) +[ + REWRITE_TAC[degree]; + STRIP_TAC; + CASES_ON `x = &0`; + ASM_REWRITE_TAC[normalize;LENGTH]; + ARITH_TAC; + CLAIM `normalize [x] = [x]`; + ASM_MESON_TAC[NORMALIZE_SING]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; +]);; +(* }}} *) + +let DEGREE_CONS = prove_by_refinement( + `!h t. normal t ==> (degree (CONS h t) = 1 + degree t)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `normal (CONS h t)`; + ASM_MESON_TAC[NORMAL_CONS]; + REWRITE_TAC[normal;degree]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC (REWRITE_RULE[normal]); + CLAIM `~(LENGTH t = 0)`; + ASM_MESON_TAC[LENGTH_0]; + STRIP_TAC; + ASM_REWRITE_TAC[LENGTH]; + POP_ASSUM MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* Now the derivative *) +(* ---------------------------------------------------------------------- *) + +let PDA_LENGTH = prove_by_refinement( + `!p n. ~(p = []) ==> (LENGTH(poly_diff_aux n p) = LENGTH p)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + GEN_TAC THEN DISCH_THEN IGNORE; + REWRITE_TAC[LENGTH;poly_diff_aux;]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[LENGTH;poly_diff_aux;]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let POLY_DIFF_LENGTH = prove_by_refinement( + `!p. LENGTH (poly_diff p) = PRE (LENGTH p)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[poly_diff;LENGTH;PRE]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[LENGTH;PRE]; + REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;PRE;poly_diff_aux;LENGTH;]; + REWRITE_TAC[poly_diff;TL;LENGTH;PRE;NOT_CONS_NIL;]; + MATCH_MP_TAC PDA_LENGTH; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let POLY_DIFF_SING = prove_by_refinement( + `!p h. (poly_diff p = [h]) <=> ?x. p = [x; h]`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + DISJ_CASES_TAC (ISPEC `LENGTH (p:real list)` (ARITH_RULE `!n. (n = 0) \/ (n = 1) \/ (n = 2) \/ 2 < n`)); + ASM_MESON_TAC[poly_diff;LENGTH_0;NOT_CONS_NIL;]; + POP_ASSUM DISJ_CASES_TAC; + RULE_ASSUM_TAC (REWRITE_RULE[LENGTH_1]); + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM SUBST1_TAC; + REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;poly_diff_aux;]; + ASM_MESON_TAC !LIST_REWRITES; + POP_ASSUM DISJ_CASES_TAC; + RULE_ASSUM_TAC (MATCH_EQ_MP LENGTH_PAIR); + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;poly_diff_aux;REAL_MUL_LID;]; + ASM_MESON_TAC[CONS_11]; + EQ_TAC; + STRIP_TAC; + POP_ASSUM (ASSUME_TAC o (AP_TERM `LENGTH:((real) list) -> num`)); + RULE_ASSUM_TAC(REWRITE_RULE[LENGTH]); + CLAIM `PRE (LENGTH p) = 1`; + ASM_MESON_TAC[POLY_DIFF_LENGTH;ARITH_RULE `SUC 0 = 1`]; + STRIP_TAC; + CLAIM `LENGTH p = 2`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + ASM_MESON_TAC[LT_REFL]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL;poly_diff_aux;REAL_MUL_LID;]; +]);; +(* }}} *) + +let lem = prove_by_refinement( + `!p n. ~(p = []) ==> (LAST (poly_diff_aux n p) = LAST p * &(PRE(LENGTH p) + n))`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REPEAT STRIP_TAC; + POP_ASSUM IGNORE; + REWRITE_TAC[LENGTH;poly_diff_aux;]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[poly_diff_aux;LAST;LENGTH;GSYM REAL_OF_NUM_ADD]; + CLAIM `((SUC 0) - 1) + n = n`; + ARITH_TAC; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[PRE]; + REAL_ARITH_TAC; + POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x)) THEN ASSUME_TAC x); + STRIP_TAC; + ASM_REWRITE_TAC[]; + LIST_SIMP_TAC; + ASM_REWRITE_TAC[]; + COND_CASES_TAC; + REWRITE_TAC[PRE]; + ASM_MESON_TAC[PDA_LENGTH;LENGTH;LENGTH_0]; + REWRITE_TAC[PRE]; + MATCH_EQ_MP_TAC (GSYM REAL_EQ_MUL_LCANCEL); + DISJ2_TAC; + AP_TERM_TAC; + CLAIM `~(LENGTH t = 0)`; + ASM_MESON_TAC[LENGTH_0]; + ARITH_TAC; +]);; + +(* }}} *) + +let NONCONSTANT_LENGTH = prove_by_refinement( + `!p. nonconstant p ==> 1 < LENGTH p`, +(* {{{ Proof *) + +[ + REWRITE_TAC[nonconstant;normal]; + ASM_MESON_TAC[LENGTH_0;LENGTH_1;ARITH_RULE `(x = 0) \/ (x = 1) \/ 1 < x`]; +]);; + +(* }}} *) + +let NONCONSTANT_DIFF_NIL = prove_by_refinement( + `!p. nonconstant p ==> ~(poly_diff p = [])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `1 < LENGTH p`; + ASM_MESON_TAC[NONCONSTANT_LENGTH]; + STRIP_TAC; + CLAIM `0 < LENGTH (poly_diff p)`; + REWRITE_TAC[POLY_DIFF_LENGTH]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + ASM_REWRITE_TAC[LENGTH]; + ARITH_TAC; +]);; +(* }}} *) + +let NONCONSTANT_DEGREE = prove_by_refinement( + `!p. nonconstant p ==> 0 < degree p`, +(* {{{ Proof *) +[ + GEN_TAC; + DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); + REWRITE_TAC[nonconstant;degree]; + REPEAT STRIP_TAC; + CLAIM `normalize p = p`; + ASM_MESON_TAC[normal]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `1 < LENGTH p`; + ASM_MESON_TAC[NONCONSTANT_LENGTH]; + ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_LAST_LEM = prove_by_refinement( + `!p. nonconstant p ==> (LAST (poly_diff p) = LAST p * &(degree p))`, +(* {{{ Proof *) +[ + REWRITE_TAC[nonconstant;poly_diff;]; + REPEAT STRIP_TAC; + COND_CASES_TAC; + ASM_MESON_TAC[normal]; + CLAIM `~(TL p = [])`; + ASM_MESON_TAC[TL;NOT_CONS_NIL;list_CASES;TL_NIL]; + DISCH_THEN (fun x -> MP_TAC (MATCH_MP lem x) THEN ASSUME_TAC x); + DISCH_THEN (ASSUME_TAC o ISPEC `1`); + ASM_REWRITE_TAC[]; + CLAIM `LAST (TL p) = LAST p`; + ASM_MESON_TAC[LAST_TL]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[degree]; + CLAIM `normalize p = p`; + ASM_MESON_TAC[normal]; + DISCH_THEN SUBST1_TAC; + MATCH_EQ_MP_TAC (GSYM REAL_EQ_MUL_LCANCEL); + DISJ2_TAC; + AP_TERM_TAC; + ASM_SIMP_TAC[LENGTH_TL]; + CLAIM `~(LENGTH p = 0)`; + ASM_MESON_TAC[LENGTH_0]; + CLAIM `~(LENGTH p = 1)`; + ASM_MESON_TAC[LENGTH_1]; + ARITH_TAC; +]);; +(* }}} *) + +let NONCONSTANT_DIFF_0 = prove_by_refinement( + `!p. nonconstant p ==> ~(poly_diff p = [&0])`, +(* {{{ Proof *) + +[ + STRIP_TAC; + DISCH_THEN (fun x -> MP_TAC x THEN ASSUME_TAC x); + REWRITE_TAC[nonconstant]; + REPEAT STRIP_TAC; + CLAIM `~(p = [])`; + ASM_MESON_TAC[normal]; + DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE[x]) THEN ASSUME_TAC x); + CLAIM `~(LAST p = &0)`; + MATCH_MP_TAC NORMAL_LAST_NONZERO; + FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + CLAIM `LAST p * &(degree p) = &0`; + ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_LEM]; + REWRITE_TAC[LAST]; + STRIP_TAC; + CLAIM `(LAST p = &0) \/ (&(degree p) = &0)`; + ASM_MESON_TAC[REAL_ENTIRE]; + STRIP_TAC; + ASM_MESON_TAC[]; + CLAIM `?h t. p = CONS h t`; + ASM_MESON_TAC[list_CASES]; + STRIP_TAC; + CLAIM `normal t`; + ASM_MESON_TAC[NORMAL_TAIL]; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o (MATCH_MP (ISPECL [`h:real`;`t:real list`] DEGREE_CONS))); + STRIP_TAC; + CLAIM `degree p = 0`; + ASM_MESON_TAC [REAL_OF_NUM_EQ]; + ASM_REWRITE_TAC[]; + ARITH_TAC; +]);; + +(* }}} *) + +let POLY_DIFF_LAST_LT = prove_by_refinement( + `!p. nonconstant p ==> (LAST (poly_diff p) < &0 <=> LAST p < &0)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ASM_SIMP_TAC[POLY_DIFF_LAST_LEM]; + CLAIM `&0 <= &(degree p)`; + REAL_ARITH_TAC; + STRIP_TAC; + EQ_TAC; + ASM_MESON_TAC([REAL_MUL_LT] @ !REAL_REWRITES); + STRIP_TAC; + CLAIM `0 < degree p`; + ASM_MESON_TAC[NONCONSTANT_DEGREE]; + STRIP_TAC; + CLAIM `&0 < &(degree p)`; + REAL_SIMP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + MATCH_EQ_MP_TAC (GSYM REAL_MUL_LT); + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let POLY_DIFF_LAST_GT = prove_by_refinement( + `!p. nonconstant p ==> (&0 < LAST (poly_diff p) <=> &0 < LAST p)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ASM_SIMP_TAC[POLY_DIFF_LAST_LEM]; + CLAIM `&0 < &(degree p)`; + ASM_MESON_TAC[NONCONSTANT_DEGREE;REAL_OF_NUM_LT]; + STRIP_TAC; + EQ_TAC; + REWRITE_TAC[REAL_MUL_GT]; + STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; + MATCH_MP_TAC REAL_LT_MUL2; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let NONCONSTANT_DIFF_NORMAL = prove_by_refinement( + `!p. nonconstant p ==> normal (poly_diff p)`, +(* {{{ Proof *) +[ + GEN_TAC; + DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); + REWRITE_TAC[nonconstant]; + REPEAT STRIP_TAC; + MATCH_MP_TAC NORMAL_LAST_LENGTH; + STRIP_TAC; + CLAIM `1 < LENGTH p`; + ASM_MESON_TAC[NONCONSTANT_LENGTH]; + STRIP_TAC; + CLAIM `LENGTH (poly_diff p) = PRE (LENGTH p)`; + ASM_MESON_TAC[POLY_DIFF_LENGTH]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CASES_ON `LAST p < &0`; + CLAIM `LAST (poly_diff p) < &0`; + ASM_MESON_TAC[POLY_DIFF_LAST_LT]; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + REWRITE_ASSUMS !REAL_REWRITES; + REWRITE_ASSUMS[REAL_LE_LT]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `&0 < LAST (poly_diff p)`; + ASM_MESON_TAC[POLY_DIFF_LAST_GT]; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + ASM_MESON_TAC[NORMAL_ID]; +]);; +(* }}} *) + +let PDIFF_POS_LAST = prove_by_refinement( + `!p. nonconstant p /\ (?X. !x. X < x ==> &0 < poly (poly_diff p) x) ==> &0 < LAST p`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `&0 < LAST (poly_diff p)`; + MATCH_MP_TAC POLY_LAST_GT; + ASM_SIMP_TAC[NONCONSTANT_DIFF_NORMAL]; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_GT]; +]);; +(* }}} *) + +let LAST_UNB = prove_by_refinement( + `!p. nonconstant p /\ &0 < LAST p ==> mono_unbounded_above (\n. poly p (&n))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MATCH_MP_TAC mua_quotient_limit; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. (LAST p) * (&n) pow (degree p))`; + BETA_TAC; + STRIP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + MATCH_MP_TAC LIM_POLY2; + ASM_MESON_TAC[nonconstant]; + MATCH_MP_TAC POW_UNB_CON; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[NONCONSTANT_DEGREE]; +]);; +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* Finally, the positive theorems *) +(* ---------------------------------------------------------------------- *) + + +let POLY_DIFF_UP_RIGHT = prove_by_refinement( + `nonconstant p /\ (?X. !x. X < x ==> &0 < poly (poly_diff p) x) ==> + (?Y. !y. Y < y ==> &0 < poly p y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `mono_unbounded_above (\n. poly p (&n))`; + MATCH_MP_TAC LAST_UNB; + ASM_MESON_TAC[PDIFF_POS_LAST]; + REWRITE_TAC[mono_unbounded_above]; + DISCH_THEN (MP_TAC o (ISPEC `&0`)); + STRIP_TAC; + CLAIM `?K. max X (&N) < &K`; + ASM_MESON_TAC[REAL_ARCH_SIMPLE_LT]; + STRIP_TAC; + EXISTS_TAC `&K`; + REPEAT STRIP_TAC; + CCONTR_TAC; + REWRITE_ASSUMS[REAL_NOT_LT]; + CLAIM `&N < y /\ X < y`; + ASM_MESON_TAC([REAL_MAX_MAX] @ !REAL_REWRITES); + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`&K`;`y:real`] POLY_MVT); + ANTS_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + CLAIM `poly p y - poly p (&K) <= &0`; + MATCH_MP_TAC (REAL_ARITH `x <= &0 /\ &0 < y ==> x - y <= &0`); + ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC; + CLAIM `&N < &K`; + ASM_MESON_TAC [REAL_MAX_MAX;REAL_LET_TRANS]; + STRIP_TAC; + CLAIM `N:num < K`; + ASM_MESON_TAC [REAL_OF_NUM_LT]; + ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - &K`; + LABEL_ALL_TAC; + USE_THEN "Z-7" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < poly (poly_diff p) x`; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_MAX_MAX;REAL_LET_TRANS;REAL_LT_TRANS]; + STRIP_TAC; + CLAIM `&0 < (y - &K) * poly (poly_diff p) x`; + ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; + MATCH_MP_TAC REAL_LT_MUL2 THEN REPEAT STRIP_TAC THEN TRY REAL_ARITH_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + REAL_SOLVE_TAC; +]);; +(* }}} *) + +let PDIFF_NEG_LAST = prove_by_refinement( + `!p. nonconstant p /\ (?X. !x. X < x ==> poly (poly_diff p) x < &0) ==> LAST p < &0`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `LAST (poly_diff p) < &0`; + MATCH_MP_TAC POLY_LAST_LT; + ASM_SIMP_TAC[NONCONSTANT_DIFF_NORMAL]; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_LT]; +]);; +(* }}} *) + +let LAST_UNB_NEG = prove_by_refinement( + `!p. nonconstant p /\ LAST p < &0 ==> mono_unbounded_below (\n. poly p (&n))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MATCH_MP_TAC mua_quotient_limit_neg; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. (LAST p) * (&n) pow (degree p))`; + BETA_TAC; + STRIP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + MATCH_MP_TAC LIM_POLY2; + ASM_MESON_TAC[nonconstant]; + MATCH_MP_TAC POW_UNBB_CON; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[NONCONSTANT_DEGREE]; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_RIGHT = prove_by_refinement( + `nonconstant p /\ (?X. !x. X < x ==> poly (poly_diff p) x < &0) ==> + (?Y. !y. Y < y ==> poly p y < &0)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `mono_unbounded_below (\n. poly p (&n))`; + MATCH_MP_TAC LAST_UNB_NEG; + ASM_MESON_TAC[PDIFF_NEG_LAST]; + REWRITE_TAC[mono_unbounded_below]; + DISCH_THEN (MP_TAC o (ISPEC `&0`)); + STRIP_TAC; + CLAIM `?K. max X (&N) < &K`; + ASM_MESON_TAC[REAL_ARCH_SIMPLE_LT]; + STRIP_TAC; + EXISTS_TAC `&K`; + REPEAT STRIP_TAC; + CCONTR_TAC; + REWRITE_ASSUMS[REAL_NOT_LT]; + CLAIM `&N < y /\ X < y`; + ASM_MESON_TAC([REAL_MAX_MAX] @ !REAL_REWRITES); + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`&K`;`y:real`] POLY_MVT); + ANTS_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + STRIP_TAC; + CLAIM `&0 <= poly p y - poly p (&K)`; + MATCH_MP_TAC (REAL_ARITH `&0 <= x /\ y < &0 ==> &0 <= x - y`); + ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC; + CLAIM `&N < &K`; + ASM_MESON_TAC (!REAL_REWRITES @ !NUM_REWRITES); + STRIP_TAC; + CLAIM `N:num < K`; + ASM_MESON_TAC [REAL_OF_NUM_LT]; + ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - &K`; + LABEL_ALL_TAC; + USE_THEN "Z-7" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `poly (poly_diff p) x < &0`; + FIRST_ASSUM MATCH_MP_TAC; + REAL_SOLVE_TAC; + STRIP_TAC; + CLAIM `(y - &K) * poly (poly_diff p) x < &0`; + ASM_MESON_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + REAL_SOLVE_TAC; +]);; +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* Now the negative ones *) +(* ---------------------------------------------------------------------- *) + +let UNB_LEFT_EVEN = prove_by_refinement( + `!k. 0 < k /\ EVEN k ==> mono_unbounded_above (\n. (-- &n) pow k)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[REAL_POW_NEG]; + MATCH_MP_TAC POW_UNB; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let UNB_LEFT_ODD = prove_by_refinement( + `!k. 0 < k /\ ODD k ==> mono_unbounded_below (\n. (-- &n) pow k)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_ASSUMS[GSYM NOT_EVEN]; + ASM_REWRITE_TAC[REAL_POW_NEG]; + MATCH_EQ_MP_TAC mua_neg; + MATCH_MP_TAC POW_UNB; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let EVEN_CONS = prove_by_refinement( + `!t h. ODD (LENGTH (CONS h t)) = EVEN (LENGTH t)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + ASM_MESON_TAC[LENGTH_SING;LENGTH;EVEN;ODD;ONE]; +]);; +(* }}} *) + +let ODD_CONS = prove_by_refinement( + `!t h. EVEN (LENGTH (CONS h t)) = ODD (LENGTH t)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + ASM_MESON_TAC[LENGTH_SING;LENGTH;EVEN;ODD;ONE]; +]);; +(* }}} *) + +let MUA_DIV_CONST = prove_by_refinement( + `!a b p. mono_unbounded_above (\n. p n) ==> (\n. a / (b + p n)) --> &0`, +(* {{{ Proof *) + +[ + REWRITE_TAC[mono_unbounded_above;SEQ]; + REPEAT STRIP_TAC; + REAL_SIMP_TAC; + CASES_ON `a = &0`; + ASM_REWRITE_TAC[real_div;REAL_MUL_LZERO;ABS_0]; + ABBREV_TAC `k = (max (&1) (abs a / e - b))`; + FIRST_ASSUM (MP_TAC o (ISPEC `k:real`)); + STRIP_TAC; + EXISTS_TAC `N`; + REPEAT STRIP_TAC; + REWRITE_ASSUMS (!REAL_REWRITES @ !NUM_REWRITES); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + REWRITE_TAC[REAL_ABS_DIV]; + MATCH_MP_TAC REAL_LTE_TRANS; + EXISTS_TAC `abs a / (b + k)`; + STRIP_TAC; + MATCH_MP_TAC REAL_DIV_DENOM_LT; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ABS_NZ]; + LABEL_ALL_TAC; + CLAIM `(abs a / e - b) <= k`; + ASM_MESON_TAC[REAL_MAX_MAX]; + STRIP_TAC; + CLAIM `&0 < abs a / e`; + REWRITE_TAC[real_div]; + MATCH_MP_TAC REAL_LT_MUL; + ASM_MESON_TAC[REAL_INV_POS;REAL_ABS_NZ]; + STRIP_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + CLAIM `-- b < p n`; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `k`; + ASM_REWRITE_TAC[]; + CLAIM `(abs a / e - b) <= k`; + ASM_MESON_TAC[REAL_MAX_MAX]; + STRIP_TAC; + CLAIM `&0 < abs a / e`; + REWRITE_TAC[real_div]; + MATCH_MP_TAC REAL_LT_MUL; + ASM_MESON_TAC[REAL_INV_POS;REAL_ABS_NZ]; + STRIP_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `abs (b + p n) = b + p n`; + MATCH_EQ_MP_TAC REAL_ABS_REFL; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + CLAIM `(abs a / e - b) <= k`; + ASM_MESON_TAC[REAL_MAX_MAX]; + STRIP_TAC; + CLAIM `&0 < abs a / e`; + REWRITE_TAC[real_div]; + MATCH_MP_TAC REAL_LT_MUL; + ASM_MESON_TAC[REAL_INV_POS;REAL_ABS_NZ]; + STRIP_TAC; + LABEL_ALL_TAC; + CLAIM `abs a / e <= b + k`; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CASES_ON `&1 <= abs a / e - b`; + CLAIM `k = abs a / e - b`; + USE_THEN "Z-3" (SUBST1_TAC o GSYM); + ASM_REWRITE_TAC[real_max]; + ASM_MESON_TAC[real_max]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[ARITH_RULE `b + a - b = a`]; + REWRITE_TAC[real_div;]; + REAL_SIMP_TAC; + REWRITE_TAC[REAL_MUL_ASSOC]; + CLAIM `~(abs a = &0)`; + ASM_MESON_TAC[REAL_ABS_NZ;REAL_LT_LE]; + STRIP_TAC; + ASM_SIMP_TAC[REAL_MUL_RINV]; + REAL_SIMP_TAC; + (* save *) + REWRITE_ASSUMS !REAL_REWRITES; + CLAIM `k = &1`; + ASM_MESON_TAC([real_max] @ !REAL_REWRITES); + STRIP_TAC; + CLAIM `&0 < b + k`; + MATCH_MP_TAC REAL_LTE_TRANS; + EXISTS_TAC `abs a / e`; + ASM_MESON_TAC[]; + STRIP_TAC; + MATCH_MP_TAC REAL_LE_RCANCEL_IMP; + EXISTS_TAC `b + k`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[real_div]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + CLAIM `inv (b + &1) * (b + &1) = &1`; + LABEL_ALL_TAC; + POP_ASSUM MP_TAC; + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[REAL_MUL_LINV;REAL_LT_LE]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[REAL_MUL_RID]; + MATCH_MP_TAC REAL_LE_LCANCEL_IMP; + EXISTS_TAC `inv e`; + REPEAT STRIP_TAC; + USE_THEN "Z-5" MP_TAC; + MESON_TAC[REAL_INV_POS;REAL_LT_LE]; + REWRITE_TAC[REAL_MUL_ASSOC]; + CLAIM `~(e = &0)`; + ASM_MESON_TAC[REAL_INV_NZ;REAL_LT_LE]; + STRIP_TAC; + ASM_SIMP_TAC[REAL_MUL_LINV]; + REAL_SIMP_TAC; + ASM_MESON_TAC[real_div;REAL_MUL_SYM] +]);; + +(* }}} *) + +let SEQ_0_NEG = prove_by_refinement( + `!p. (\n. p n) --> &0 <=> (\n. -- p n) --> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[SEQ]; + GEN_TAC THEN EQ_TAC; + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-0" (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + STRIP_TAC; + EXISTS_TAC `N`; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + REAL_SIMP_TAC; + STRIP_TAC; + ASM_MESON_TAC[REAL_ABS_NEG]; + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-0" (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + STRIP_TAC; + EXISTS_TAC `N`; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + REAL_SIMP_TAC; + STRIP_TAC; + ASM_MESON_TAC[REAL_ABS_NEG]; +]);; +(* }}} *) + +let lem = prove_by_refinement( + `!x y z. --(x / (y + z)) = x / (-- y + -- z)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[real_div]; + REWRITE_TAC[ARITH_RULE `--(x * y) = x * -- y`]; + REWRITE_TAC[ARITH_RULE `-- y + -- z = --(y + z)`]; + REWRITE_TAC[REAL_INV_NEG]; +]);; +(* }}} *) + +let MUB_DIV_CONST = prove_by_refinement( + `!a b p. mono_unbounded_below (\n. p n) ==> (\n. a / (b + p n)) --> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[mua_neg2]; + REPEAT STRIP_TAC; + ONCE_REWRITE_TAC[SEQ_0_NEG]; + REWRITE_TAC[lem]; + MATCH_MP_TAC MUA_DIV_CONST; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let mono_unbounded = new_definition( + `mono_unbounded p <=> mono_unbounded_above p \/ mono_unbounded_below p`);; + +let MU_DIV_CONST = prove_by_refinement( + `!a b p. mono_unbounded p ==> (\n. a / (b + p n)) --> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[mono_unbounded]; + REPEAT STRIP_TAC; + MATCH_MP_TAC MUA_DIV_CONST; + REWRITE_TAC[ETA_AX]; + POP_ASSUM MATCH_ACCEPT_TAC; + MATCH_MP_TAC MUB_DIV_CONST; + REWRITE_TAC[ETA_AX]; + POP_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let MUA_MUA = prove_by_refinement( + `!p q. mono_unbounded_above (\n. p n) /\ mono_unbounded_above (\n. q n) ==> + mono_unbounded_above (\n. p n * q n)`, +(* {{{ Proof *) +[ + REWRITE_TAC[mono_unbounded_above_pos]; + REPEAT STRIP_TAC; + CLAIM `&0 <= max c (&1)`; + REWRITE_TAC[real_max]; + COND_CASES_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + DISCH_THEN (fun y -> POP_ASSUM (fun x -> RULE_ASSUM_TAC (C MATCH_MP y) THEN ASSUME_TAC x)); + EVERY_ASSUM MP_TAC THEN REPEAT STRIP_TAC; + EXISTS_TAC `nmax N N'`; + REPEAT STRIP_TAC; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `max c (&1)`; + ASM_REWRITE_TAC[REAL_MAX_MAX]; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `max c (&1) * max c (&1)`; + REPEAT STRIP_TAC; + CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV [GSYM REAL_MUL_RID])); + MATCH_MP_TAC REAL_LE_MUL2; + REPEAT STRIP_TAC; + REAL_SOLVE_TAC; + REAL_SIMP_TAC; + REAL_ARITH_TAC; + REAL_SOLVE_TAC; + MATCH_MP_TAC REAL_LT_MUL2; + REPEAT STRIP_TAC; + REAL_SOLVE_TAC; + CLAIM `N <= n /\ N' <= (n:num)`; + POP_ASSUM MP_TAC; + REWRITE_TAC[nmax]; + COND_CASES_TAC; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + REAL_SOLVE_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REWRITE_TAC[nmax] THEN ARITH_TAC; +]);; +(* }}} *) + +let MUA_MUB = prove_by_refinement( + `!p q. mono_unbounded_above (\n. p n) /\ mono_unbounded_below (\n. q n) ==> + mono_unbounded_below (\n. p n * q n)`, +(* {{{ Proof *) +[ + REWRITE_TAC[mua_neg2]; + REWRITE_TAC[ARITH_RULE `--(x * y) = x * -- y`]; + REPEAT STRIP_TAC; + MATCH_MP_TAC MUA_MUA; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let MUB_MUA = prove_by_refinement( + `!p q. mono_unbounded_below (\n. p n) /\ mono_unbounded_above (\n. q n) ==> + mono_unbounded_below (\n. p n * q n)`, +(* {{{ Proof *) +[ + REWRITE_TAC[mua_neg2]; + REWRITE_TAC[ARITH_RULE `--(x * y) = -- x * y`]; + REPEAT STRIP_TAC; + MATCH_MP_TAC MUA_MUA; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let MUB_MUB = prove_by_refinement( + `!p q. mono_unbounded_below (\n. p n) /\ mono_unbounded_below (\n. q n) ==> + mono_unbounded_above (\n. p n * q n)`, +(* {{{ Proof *) +[ + REWRITE_TAC[mua_neg2]; + ONCE_REWRITE_TAC[ARITH_RULE `(x * y) = -- x * -- y`]; + REPEAT STRIP_TAC; + MATCH_MP_TAC MUA_MUA; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let MU_PROD = prove_by_refinement( + `!p q. mono_unbounded (\n. p n) /\ mono_unbounded (\n. q n) ==> mono_unbounded (\n. p n * q n)`, +(* {{{ Proof *) +[ + REWRITE_TAC[mono_unbounded]; + ASM_MESON_TAC[MUA_MUA;MUA_MUB;MUB_MUA;MUB_MUB]; +]);; +(* }}} *) + +let mub_quotient_limit = prove_by_refinement( + `!k f g. &0 < k /\ (\n. f n / g n) --> k /\ mono_unbounded_below g + ==> mono_unbounded_below f`, +(* {{{ Proof *) +[ + REWRITE_TAC[mua_neg2]; + REPEAT STRIP_TAC; + MATCH_MP_TAC mua_quotient_limit; + EXISTS_TAC `k`; + EXISTS_TAC `\n. -- g n`; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + BETA_TAC; + REWRITE_TAC[REAL_NEG_DIV]; + FIRST_ASSUM MATCH_ACCEPT_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let POLY_UB = prove_by_refinement( + `!p. nonconstant p ==> mono_unbounded (\n. poly p (&n))`, +(* {{{ Proof *) + +[ + GEN_TAC; + DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); + REWRITE_TAC[nonconstant]; + REPEAT STRIP_TAC; + FIRST_ASSUM (fun x -> ASSUME_TAC (MATCH_MP LIM_POLY2 x)); + CASES_ON `LAST p < &0`; + REWRITE_TAC[mono_unbounded]; + DISJ2_TAC; + MATCH_MP_TAC mub_quotient_limit; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. LAST p * &n pow degree p)`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + BETA_TAC; + MATCH_MP_TAC LIM_POLY2; + FIRST_ASSUM MATCH_ACCEPT_TAC; + MATCH_MP_TAC POW_UNBB_CON; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC NONCONSTANT_DEGREE; + FIRST_ASSUM MATCH_ACCEPT_TAC; + REWRITE_ASSUMS !REAL_REWRITES; + REWRITE_ASSUMS[REAL_LE_LT]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + (* save *) + REWRITE_TAC[mono_unbounded]; + DISJ1_TAC; + MATCH_MP_TAC mua_quotient_limit; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. LAST p * &n pow degree p)`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + BETA_TAC; + MATCH_MP_TAC LIM_POLY2; + FIRST_ASSUM MATCH_ACCEPT_TAC; + MATCH_MP_TAC POW_UNB_CON; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC NONCONSTANT_DEGREE; + FIRST_ASSUM MATCH_ACCEPT_TAC; + ASM_MESON_TAC[NORMAL_LAST_NONZERO]; +]);; + +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* A polynomial applied to a negative argument *) +(* ---------------------------------------------------------------------- *) + +let pneg_aux = new_recursive_definition list_RECURSION + `(pneg_aux n [] = []) /\ + (pneg_aux n (CONS h t) = CONS (--(&1) pow n * h) (pneg_aux (SUC n) t))`;; + +let pneg = new_recursive_definition list_RECURSION + `(pneg [] = []) /\ + (pneg (CONS h t) = pneg_aux 0 (CONS h t))`;; + +let POLY_PNEG_AUX_SUC = prove_by_refinement( + `!t n. pneg_aux (SUC (SUC n)) t = pneg_aux n t`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + STRIP_TAC; + REWRITE_TAC[pneg_aux]; + REWRITE_TAC[pneg_aux;pow]; + REAL_SIMP_TAC; + STRIP_TAC; + AP_TERM_TAC; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let POLY_NEG_NEG = prove_by_refinement( + `!p. poly_neg (poly_neg p) = p`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[poly_neg;poly_cmul]; + REWRITE_TAC[poly_neg;poly_cmul]; + REAL_SIMP_TAC; + AP_TERM_TAC; + ASM_MESON_TAC[poly_neg;poly_cmul]; +]);; +(* }}} *) + +let POLY_PNEG_NEG = prove_by_refinement( + `!p n. poly_neg (pneg_aux (SUC n) p) = pneg_aux n p`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + ASM_REWRITE_TAC[pneg_aux;poly_neg;poly_cmul]; + REWRITE_TAC[pneg_aux]; + REPEAT STRIP_TAC; + REWRITE_TAC[POLY_PNEG_AUX_SUC]; + REWRITE_TAC[poly_neg;poly_cmul]; + REAL_SIMP_TAC; + AP_TERM_TAC; + REWRITE_TAC[GSYM poly_neg]; + CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV[GSYM POLY_NEG_NEG])); + POP_ASSUM (ONCE_REWRITE_TAC o list); + REWRITE_TAC[]; +]);; +(* }}} *) + +let POLY_PNEG_AUX = prove_by_refinement( + `!k p n. EVEN n ==> (poly p (-- k) = poly (pneg_aux n p) k)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REPEAT STRIP_TAC; + REWRITE_TAC[pneg_aux;poly]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> RULE_ASSUM_TAC (fun y -> MATCH_MP y x) THEN ASSUME_TAC x); + REWRITE_TAC[poly;pneg_aux]; + REAL_SIMP_TAC; + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + CLAIM `-- &1 pow n = &1`; + REWRITE_TAC[REAL_POW_NEG]; + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + DISCH_THEN SUBST1_TAC; + REAL_SIMP_TAC; + AP_TERM_TAC; + CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[GSYM POLY_PNEG_NEG])); + REWRITE_TAC[POLY_NEG]; + REAL_SIMP_TAC; +]);; +(* }}} *) + +let POLY_PNEG = prove_by_refinement( + `!p x. poly p (-- x) = poly (pneg p) x`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[pneg;poly]; + REWRITE_TAC[pneg;poly]; + REPEAT STRIP_TAC; + CLAIM `poly (pneg_aux 0 (CONS h t)) x = poly (CONS h t) (--x)`; + ASM_MESON_TAC[POLY_PNEG_AUX;EVEN]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[poly]; +]);; +(* }}} *) + +let DEGREE_0 = prove_by_refinement( + `degree [] = 0 `, +(* {{{ Proof *) +[ + REWRITE_TAC[degree]; + REWRITE_TAC[normalize;LENGTH]; + ARITH_TAC; +]);; +(* }}} *) + +let EVEN_ODD = prove_by_refinement( + `!x. EVEN (SUC x) = ODD x`, +(* {{{ Proof *) +[ + REWRITE_TAC[EVEN;NOT_EVEN]; +]);; +(* }}} *) + +let ODD_EVEN = prove_by_refinement( + `!x. ODD (SUC x) = EVEN x`, +(* {{{ Proof *) +[ + REWRITE_TAC[ODD;NOT_ODD]; +]);; +(* }}} *) + +let PNEG_CONS = prove_by_refinement( + `!p. pneg (CONS h t) = CONS h (neg (pneg t))`, +(* {{{ Proof *) +[ + REWRITE_TAC[pneg;pneg_aux]; + REAL_SIMP_TAC; + ONCE_REWRITE_TAC[GSYM POLY_PNEG_NEG]; + REWRITE_TAC[POLY_PNEG_AUX_SUC]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[pneg;pneg_aux;]; + REWRITE_ASSUMS !LIST_REWRITES; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM pneg]; +]);; +(* }}} *) + +let PNEG_NIL = prove_by_refinement( + `!p. (pneg p = []) <=> (p = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + MESON_TAC[pneg;NOT_CONS_NIL;pneg_aux]; +]);; +(* }}} *) + +let PNEG_AUX_NIL = prove_by_refinement( + `!p n. (pneg_aux n p = []) <=> (p = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + MESON_TAC[pneg;NOT_CONS_NIL;pneg_aux]; +]);; +(* }}} *) + +let POLY_CMUL_NIL = prove_by_refinement( + `!p. (c ## p = []) <=> (p = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + MESON_TAC[poly_cmul;NOT_CONS_NIL;pneg_aux]; +]);; +(* }}} *) + +let POLY_NEG_NIL = prove_by_refinement( + `!p. (poly_neg p = []) <=> (p = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + MESON_TAC[poly_neg;poly_cmul;NOT_CONS_NIL]; +]);; +(* }}} *) + +let NEG_LAST = prove_by_refinement( + `!p. ~(p = []) ==> (LAST (neg p) = -- LAST p)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + DISCH_THEN IGNORE; + CASES_ON `t = []`; + ASM_REWRITE_TAC[poly_neg;poly_cmul;LAST;]; + REAL_ARITH_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + ASM_SIMP_TAC[LAST_CONS;poly_neg;poly_cmul;]; + CLAIM `~(-- &1 ## t = [])`; + ASM_MESON_TAC[POLY_CMUL_NIL]; + STRIP_TAC; + ASM_SIMP_TAC[LAST_CONS]; + ASM_MESON_TAC[poly_neg;]; +]);; +(* }}} *) + +let POLY_PNEG_LAST = prove_by_refinement( + `!p. normal p ==> + (EVEN (degree p) ==> (LAST p = LAST (pneg p))) /\ + (ODD (degree p) ==> (LAST p = -- LAST (pneg p)))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[normal]; + STRIP_TAC; + CASES_ON `t = []`; + ASM_REWRITE_TAC[LAST;pneg;pneg_aux]; + REAL_SIMP_TAC; + ASM_MESON_TAC[DEGREE_SING;EVEN;NOT_EVEN]; + CLAIM `normal t`; + MATCH_MP_TAC NORMAL_TAIL; + ASM_MESON_TAC[]; + DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE [x]) THEN ASSUME_TAC x); + STRIP_TAC; + STRIP_TAC; + CLAIM `ODD (degree t)`; + MATCH_EQ_MP_TAC EVEN_ODD; + ASM_MESON_TAC[DEGREE_CONS;ADD1;ADD_SYM]; + DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE [x]) THEN ASSUME_TAC x); + ASM_SIMP_TAC[LAST_CONS]; + REWRITE_TAC[PNEG_CONS]; + CLAIM `~(neg (pneg t) = [])`; + ASM_MESON_TAC[POLY_NEG_NIL;PNEG_NIL]; + STRIP_TAC; + ASM_SIMP_TAC[LAST_CONS]; + ASM_MESON_TAC[NEG_LAST;PNEG_NIL]; + CLAIM `normal t`; + MATCH_MP_TAC NORMAL_TAIL; + ASM_MESON_TAC[]; + REPEAT STRIP_TAC; + CLAIM `EVEN (degree t)`; + MATCH_EQ_MP_TAC ODD_EVEN; + ASM_MESON_TAC[DEGREE_CONS;ADD1;ADD_SYM]; + DISCH_THEN (fun x -> RULE_ASSUM_TAC (REWRITE_RULE [x]) THEN ASSUME_TAC x); + ASM_SIMP_TAC[LAST_CONS]; + REWRITE_TAC[PNEG_CONS]; + CLAIM `~(neg (pneg t) = [])`; + ASM_MESON_TAC[POLY_NEG_NIL;PNEG_NIL]; + STRIP_TAC; + ASM_SIMP_TAC[LAST_CONS]; + ASM_SIMP_TAC[NEG_LAST;PNEG_NIL]; + REAL_SIMP_TAC; +]);; +(* }}} *) + +let PNEG_AUX_LENGTH = prove_by_refinement( + `!p n. LENGTH (pneg_aux n p) = LENGTH p`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH;pneg;pneg_aux;]; + REWRITE_TAC[LENGTH;pneg;pneg_aux;]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let PNEG_LENGTH = prove_by_refinement( + `!p. LENGTH (pneg p) = LENGTH p`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH;pneg;pneg_aux;]; + REWRITE_TAC[LENGTH;pneg;pneg_aux;]; + ASM_MESON_TAC[PNEG_AUX_LENGTH]; +]);; +(* }}} *) + +let LAST_PNEG_AUX_0 = prove_by_refinement( + `!p n. ~(p = []) ==> ((LAST p = &0) <=> (LAST (pneg_aux n p) = &0))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + STRIP_TAC; + DISCH_THEN IGNORE; + CASES_ON `t = []`; + ASM_REWRITE_TAC[LAST;pneg;pneg_aux;]; + REAL_SIMP_TAC; + ASM_SIMP_TAC[LAST_CONS;pneg;pneg_aux;]; + REAL_SIMP_TAC; + EQ_TAC; + DISCH_THEN SUBST1_TAC; + REAL_SIMP_TAC; + STRIP_TAC; + MP_TAC (ISPECL[`-- &1`;`n:num`] POW_NZ); + REAL_SIMP_TAC; + REWRITE_TAC[ARITH_RULE `~(-- &1 = &0)`]; + STRIP_TAC; + ASM_MESON_TAC[REAL_ENTIRE]; + ASM_SIMP_TAC[LAST_CONS]; + REWRITE_TAC[pneg_aux]; + CLAIM `~(pneg_aux (SUC n) t = [])`; + ASM_MESON_TAC[PNEG_AUX_NIL]; + STRIP_TAC; + ASM_SIMP_TAC[LAST_CONS]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let LAST_PNEG_0 = prove_by_refinement( + `!p n. ~(p = []) ==> ((LAST p = &0) = (LAST (pneg p) = &0))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN MESON_TAC[LAST_PNEG_AUX_0;pneg]; +]);; +(* }}} *) + +let PNEG_LAST = prove_by_refinement( + `!p. ~(p = []) ==> (LAST (pneg p) = LAST p) \/ (LAST (pneg p) = -- LAST p)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CASES_ON `normal p`; + MP_TAC (ISPEC `p:real list` POLY_PNEG_LAST); + ASM_REWRITE_TAC[]; + STRIP_TAC; + DISJ_CASES_TAC (ISPEC `degree p` EVEN_OR_ODD); + ASM_MESON_TAC[]; + ASM_MESON_TAC !REAL_REWRITES; + REWRITE_ASSUMS[NORMAL_ID;DE_MORGAN_THM;]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `LENGTH p = 0`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + ASM_MESON_TAC[LENGTH_0]; + ASM_REWRITE_TAC[]; + DISJ1_TAC; + ASM_MESON_TAC[LAST_PNEG_0]; +]);; +(* }}} *) + +let NORMAL_PNEG = prove_by_refinement( + `!p. normal p = normal (pneg p)`, +(* {{{ Proof *) +[ + REWRITE_TAC[NORMAL_ID]; + REPEAT STRIP_TAC; + EQ_TAC; + REPEAT STRIP_TAC; + ASM_MESON_TAC[PNEG_LENGTH]; + MP_TAC (ISPEC `p:real list` PNEG_LAST); + CLAIM `~(p = [])`; + ASM_MESON_TAC[LENGTH_NZ]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + (* save *) + REPEAT STRIP_TAC; + ONCE_REWRITE_TAC[GSYM PNEG_LENGTH]; + ASM_REWRITE_TAC[]; + MP_TAC (ISPEC `p:real list` PNEG_LAST); + CLAIM `~(p = [])`; + ASM_MESON_TAC[LENGTH_NZ;PNEG_LENGTH]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let PNEG_AUX_NORMALIZE_LENGTH = prove_by_refinement( + `!p n. LENGTH (normalize (pneg_aux n p)) = LENGTH (normalize p)`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[normalize;LENGTH;pneg_aux;]; + REWRITE_TAC[normalize;LENGTH;pneg;pneg_aux;]; + STRIP_TAC; + REPEAT COND_CASES_TAC THEN TRY (ASM_SIMP_TAC !LIST_REWRITES); + LABEL_ALL_TAC; + KEEP ["Z-2";"Z-0"]; + CLAIM `~(-- &1 pow n = &0)`; + MATCH_MP_TAC REAL_POW_NZ; + REAL_ARITH_TAC; + STRIP_TAC; + ASM_MESON_TAC[REAL_ENTIRE]; + ASM_MESON_TAC[LENGTH_0]; + CLAIM `~(-- &1 pow n = &0)`; + MATCH_MP_TAC REAL_POW_NZ; + REAL_ARITH_TAC; + STRIP_TAC; + ASM_MESON_TAC[REAL_ENTIRE]; + ASM_MESON_TAC[LENGTH_0]; + ASM_MESON_TAC[LENGTH_0]; +]);; + +(* }}} *) + +let PNEG_NORMALIZE_LENGTH = prove_by_refinement( + `!p n. LENGTH (normalize (pneg p)) = LENGTH (normalize p)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[pneg]; + ASM_MESON_TAC[PNEG_AUX_NORMALIZE_LENGTH;pneg;pneg_aux;]; +]);; +(* }}} *) + +let DEGREE_PNEG = prove_by_refinement( + `!p. degree (pneg p) = degree p`, +(* {{{ Proof *) +[ + REWRITE_TAC[degree]; + ASM_MESON_TAC[PNEG_NORMALIZE_LENGTH]; +]);; +(* }}} *) + +let PNEG_SING = prove_by_refinement( + `!p. (pneg p = [x]) <=> (p = [x])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[pneg;pneg_aux]; + EQ_TAC; + REPEAT STRIP_TAC; + LIST_SIMP_TAC; + STRIP_TAC; + REWRITE_ASSUMS[pneg;pneg_aux]; + POP_ASSUM MP_TAC; + REAL_SIMP_TAC; + LIST_SIMP_TAC; + MESON_TAC[]; + POP_ASSUM MP_TAC; + REWRITE_TAC[pneg;pneg_aux]; + LIST_SIMP_TAC; + ASM_MESON_TAC[PNEG_AUX_NIL]; + REWRITE_TAC[pneg;pneg_aux]; + REAL_SIMP_TAC; + LIST_SIMP_TAC; + STRIP_TAC; + ASM_MESON_TAC[pneg_aux]; +]);; +(* }}} *) + +let PNEG_NONCONSTANT = prove_by_refinement( + `!p. nonconstant (pneg p) = nonconstant p`, +(* {{{ Proof *) +[ + REWRITE_TAC[nonconstant]; + STRIP_TAC THEN EQ_TAC; + REPEAT STRIP_TAC; + ASM_MESON_TAC[NORMAL_PNEG]; + POP_ASSUM (REWRITE_ASSUMS o list); + REWRITE_ASSUMS[pneg;pneg_aux]; + POP_ASSUM MP_TAC; + REAL_SIMP_TAC; + MESON_TAC[]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[NORMAL_PNEG]; + ASM_MESON_TAC[PNEG_SING]; +]);; +(* }}} *) + +let LAST_UNBB_EVEN_NEG = prove_by_refinement( + `!p. nonconstant p /\ EVEN (degree p) /\ LAST p < &0 ==> + mono_unbounded_below (\n. poly p (-- &n))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[POLY_PNEG]; + MATCH_MP_TAC LAST_UNB_NEG; + ASM_REWRITE_TAC[PNEG_NONCONSTANT]; + ASM_MESON_TAC[POLY_PNEG_LAST;nonconstant;]; +]);; +(* }}} *) + +let POLY_PNEG_LAST2 = prove_by_refinement( + `!p. normal p + ==> (EVEN (degree p) ==> (LAST (pneg p) = LAST p)) /\ + (ODD (degree p) ==> (LAST (pneg p) = -- LAST p))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ASM_MESON_TAC[POLY_PNEG_LAST]; + ASM_MESON_TAC([POLY_PNEG_LAST; ARITH_RULE `(--x = y) <=> (x = -- y)` ]); +]);; +(* }}} *) + +let LAST_UNB_ODD_NEG = prove_by_refinement( + `!p. nonconstant p /\ ODD (degree p) /\ LAST p < &0 ==> + mono_unbounded_above (\n. poly p (-- &n))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[POLY_PNEG]; + MATCH_MP_TAC LAST_UNB; + ASM_REWRITE_TAC[PNEG_NONCONSTANT]; + CLAIM `LAST (pneg p) = -- LAST p`; + ASM_MESON_TAC[POLY_PNEG_LAST2;nonconstant;]; + DISCH_THEN SUBST1_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let LAST_UNB_EVEN_POS = prove_by_refinement( + `!p. nonconstant p /\ EVEN (degree p) /\ &0 < LAST p ==> + mono_unbounded_above (\n. poly p (-- &n))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[POLY_PNEG]; + MATCH_MP_TAC LAST_UNB; + ASM_REWRITE_TAC[PNEG_NONCONSTANT]; + ASM_MESON_TAC[POLY_PNEG_LAST2;nonconstant;]; +]);; +(* }}} *) + +let LAST_UNB_ODD_POS = prove_by_refinement( + `!p. nonconstant p /\ ODD (degree p) /\ &0 < LAST p ==> + mono_unbounded_below (\n. poly p (-- &n))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[POLY_PNEG]; + MATCH_MP_TAC LAST_UNB_NEG; + ASM_REWRITE_TAC[PNEG_NONCONSTANT]; + CLAIM `LAST (pneg p) = -- LAST p`; + ASM_MESON_TAC[POLY_PNEG_LAST2;nonconstant;]; + DISCH_THEN SUBST1_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let PNEG_NORMALIZE_LENGTH = prove_by_refinement( + `!p n. LENGTH (normalize (pneg p)) = LENGTH (normalize p)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[pneg]; + ASM_MESON_TAC[PNEG_AUX_NORMALIZE_LENGTH;pneg;pneg_aux;]; +]);; +(* }}} *) + +let POLY_DIFF_AUX_NORMAL = prove_by_refinement( + `!p n. ~(n = 0) ==> (normal p = normal (poly_diff_aux n p))`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[normal;poly_diff_aux;]; + REPEAT STRIP_TAC; + REWRITE_TAC[poly_diff_aux]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[poly_diff_aux;]; + REWRITE_TAC[normal]; + EQ_TAC; + REPEAT STRIP_TAC; + REWRITE_TAC[normalize]; + COND_CASES_TAC; + CLAIM `~(h = &0)`; + ASM_MESON_TAC[normal;normalize]; + STRIP_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_INJ]; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[NOT_CONS_NIL]; + STRIP_TAC; + ASM_REWRITE_TAC[NOT_CONS_NIL]; + REWRITE_TAC[NORMALIZE_SING]; + CLAIM `~(&n * h = &0)`; + ASM_MESON_TAC[normalize]; + ASM_MESON_TAC[REAL_ENTIRE;REAL_INJ;normalize]; + EQ_TAC; + REPEAT STRIP_TAC; + CLAIM `normal t`; + ASM_MESON_TAC[NORMAL_TAIL]; + STRIP_TAC; + MATCH_MP_TAC NORMAL_CONS; + ASM_MESON_TAC[ARITH_RULE `~(SUC x = 0)`]; + STRIP_TAC; + MATCH_MP_TAC NORMAL_CONS; + MP_TAC (ARITH_RULE `~(SUC n = 0)`); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> (MP_TAC (MATCH_MP y x)))); + STRIP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC NORMAL_TAIL; + EXISTS_TAC `&n * h`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[poly_diff_aux;NOT_CONS_NIL;list_CASES]; +]);; + +(* }}} *) + +let POLY_DIFF_NORMAL = prove_by_refinement( + `!p. nonconstant p ==> normal (poly_diff p)`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + ASM_MESON_TAC[normal;poly_diff;poly_diff_aux;POLY_DIFF_AUX_NORMAL;ARITH_RULE `~(1 = 0)`;nonconstant;]; + REWRITE_TAC[poly_diff;NOT_CONS_NIL;TL]; + REWRITE_TAC[nonconstant]; + STRIP_TAC; + CLAIM `normal t`; + MATCH_MP_TAC NORMAL_TAIL; + EXISTS_TAC `h:real`; + ASM_MESON_TAC[normal]; + STRIP_TAC; + ASM_MESON_TAC[normal;poly_diff;poly_diff_aux;POLY_DIFF_AUX_NORMAL;ARITH_RULE `~(1 = 0)`]; +]);; + +(* }}} *) + +let POLY_DIFF_AUX_NORMAL2 = prove_by_refinement( + `!p n. ~(n = 0) ==> (normal (poly_diff_aux n p) <=> normal p)`, +(* {{{ Proof *) +[MESON_TAC[POLY_DIFF_AUX_NORMAL]]);; +(* }}} *) + +let POLY_DIFF_AUX_DEGREE = prove_by_refinement( + `!p m n. ~(n = 0) /\ ~(m = 0) /\ normal p ==> + (degree (poly_diff_aux n p) = degree (poly_diff_aux m p))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[poly_diff_aux]; + REPEAT STRIP_TAC; + REWRITE_TAC[poly_diff_aux]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[poly_diff_aux;DEGREE_SING]; + CLAIM `normal (poly_diff_aux (SUC n) t)`; + ASM_SIMP_TAC[POLY_DIFF_AUX_NORMAL2;NOT_SUC]; + MATCH_MP_TAC NORMAL_TAIL; + ASM_REWRITE_TAC[]; + EXISTS_TAC `h:real`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `normal (poly_diff_aux (SUC m) t)`; + ASM_SIMP_TAC[POLY_DIFF_AUX_NORMAL2;NOT_SUC]; + MATCH_MP_TAC NORMAL_TAIL; + ASM_REWRITE_TAC[]; + EXISTS_TAC `h:real`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[DEGREE_CONS]; + AP_TERM_TAC; + FIRST_ASSUM MATCH_MP_TAC; + STRIP_TAC; + ARITH_TAC; + STRIP_TAC; + ARITH_TAC; + MATCH_MP_TAC NORMAL_TAIL; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let poly_diff_aux_odd = prove_by_refinement( + `!p n. nonconstant p ==> + (EVEN (degree p) = EVEN (degree (poly_diff_aux n p))) /\ + (ODD (degree p) = ODD (degree (poly_diff_aux n p)))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[normal;nonconstant;]; + STRIP_TAC; + DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); + REWRITE_TAC[nonconstant]; + STRIP_TAC; + CASES_ON `t = []`; + ASM_MESON_TAC[nonconstant;normal]; + REWRITE_TAC[poly_diff_aux]; + CLAIM `normal t`; + ASM_MESON_TAC[NORMAL_TAIL]; + STRIP_TAC; + CLAIM `normal (poly_diff_aux (SUC n) t)`; + ASM_MESON_TAC[nonconstant;normal;POLY_DIFF_AUX_NORMAL;NOT_SUC]; + STRIP_TAC; + CASES_ON `?x. t = [x]`; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `~(x = &0)`; + ASM_MESON_TAC[normal;normalize]; + STRIP_TAC; + CLAIM `degree [h; x] = 1`; + CLAIM `normalize [h; x] = [h; x]`; + ASM_MESON_TAC[normal]; + DISCH_THEN SUBST1_TAC; + CLAIM `LENGTH [h; x] = 2`; + ASM_MESON_TAC[LENGTH_PAIR]; + STRIP_TAC; + REWRITE_TAC[degree]; + CLAIM `normal [h; x]`; + ASM_MESON_TAC[normal;normalize]; + DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x); + REWRITE_TAC[normal]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + STRIP_TAC; + ASM_REWRITE_TAC[poly_diff_aux;]; + CLAIM `~(&(SUC n) * x = &0)`; + ASM_MESON_TAC[normal;normalize;REAL_ENTIRE;ARITH_RULE `~(SUC n = 0)`;REAL_INJ]; + STRIP_TAC; + CLAIM `degree [&n * h; &(SUC n) * x] = 1`; + REWRITE_TAC[degree]; + ASM_REWRITE_TAC[normalize;NOT_CONS_NIL;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[DEGREE_CONS]; + CLAIM `nonconstant t`; + ASM_MESON_TAC[nonconstant]; + STRIP_TAC; + ONCE_REWRITE_TAC[ADD_SYM]; + REWRITE_TAC[GSYM ADD1]; + ASM_SIMP_TAC[EVEN;ODD]; + ASM_MESON_TAC[POLY_DIFF_AUX_DEGREE]; +]);; +(* }}} *) + +let poly_diff_parity = prove_by_refinement( + `!p n. nonconstant p ==> + (EVEN (degree p) = ODD (degree (poly_diff p))) /\ + (ODD (degree p) = EVEN (degree (poly_diff p)))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[nonconstant;normal]; + STRIP_TAC; + DISCH_ASS; + REWRITE_TAC[nonconstant]; + STRIP_TAC; + REWRITE_TAC[poly_diff]; + LIST_SIMP_TAC; + CLAIM `~(1 = 0)`; + ARITH_TAC; + STRIP_TAC; + CLAIM `normal t`; + MATCH_MP_TAC NORMAL_TAIL; + ASM_MESON_TAC[nonconstant;normal]; + STRIP_TAC; + ASM_SIMP_TAC[DEGREE_CONS]; + CASES_ON `?x. t = [x]`; + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `~(x = &0)`; + ASM_MESON_TAC[normal;normalize]; + STRIP_TAC; + ASM_REWRITE_TAC[poly_diff_aux;DEGREE_SING;degree;normalize;LENGTH;NOT_CONS_NIL;]; + CLAIM `~(&1 * x = &0)`; + ASM_MESON_TAC[REAL_ENTIRE;ARITH_RULE `~(&1 = &0)`]; + STRIP_TAC; + ASM_REWRITE_TAC[LENGTH]; + REWRITE_TAC[ARITH_RULE `1 + x = SUC x`]; + ASM_MESON_TAC[EVEN;ODD;NOT_EVEN;NOT_ODD;]; + CLAIM `nonconstant t`; + ASM_MESON_TAC[nonconstant]; + DISCH_ASS; + DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + ONCE_REWRITE_TAC[ADD_SYM]; + REWRITE_TAC[GSYM ADD1;EVEN;ODD]; + CLAIM `?h' t'. t = CONS h' t'`; + ASM_MESON_TAC[nonconstant;normal;list_CASES]; + STRIP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS [x] THEN REWRITE_TAC[x] THEN ASSUME_TAC x); + REWRITE_ASSUMS[poly_diff;NOT_CONS_NIL;TL]; + REWRITE_TAC[poly_diff_aux]; + CLAIM `normal t'`; + ASM_MESON_TAC[nonconstant;NORMAL_TAIL;normal]; + STRIP_TAC; + CLAIM `normal (poly_diff_aux (SUC 1) t')`; + ASM_MESON_TAC[POLY_DIFF_AUX_NORMAL2;NOT_SUC]; + STRIP_TAC; + ASM_SIMP_TAC[DEGREE_CONS]; + ONCE_REWRITE_TAC[ADD_SYM]; + REWRITE_TAC[GSYM ADD1;EVEN;ODD]; + CLAIM `normal (poly_diff_aux 1 t')`; + ASM_MESON_TAC[POLY_DIFF_AUX_NORMAL2;ONE;NOT_SUC]; + STRIP_TAC; + ASM_MESON_TAC[POLY_DIFF_AUX_DEGREE;ONE;NOT_SUC]; +]);; +(* }}} *) + +let poly_diff_parity2 = prove_by_refinement( + `!p n. nonconstant p ==> + (ODD (degree (poly_diff p)) = EVEN (degree p)) /\ + (EVEN (degree (poly_diff p)) = ODD (degree p))`, +(* {{{ Proof *) +[MESON_TAC[poly_diff_parity]]);; +(* }}} *) + +let normal_nonconstant = prove_by_refinement( + `!p. normal p /\ 0 < degree p ==> nonconstant p`, +(* {{{ Proof *) +[ + REWRITE_TAC[nonconstant]; + ASM_MESON_TAC[DEGREE_SING;LT_REFL]; +]);; +(* }}} *) + +let nmax_le = prove_by_refinement( + `!n m. n <= nmax n m /\ m <= nmax n m`, +(* {{{ Proof *) +[ + REWRITE_TAC[nmax]; + REPEAT STRIP_TAC; + COND_CASES_TAC; + ARITH_TAC; + ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_UP_LEFT = prove_by_refinement( + `!p. nonconstant p /\ (?X. !x. x < X ==> poly (poly_diff p) x < &0) ==> + (?Y. !y. y < Y ==> &0 < poly p y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `mono_unbounded_above (\n. poly p (-- &n))`; + REWRITE_TAC[POLY_PNEG]; + DISJ_CASES_TAC (ISPEC `degree p` EVEN_OR_ODD); + MATCH_MP_TAC mua_quotient_limit; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. LAST (pneg p) * &n pow degree (pneg p))`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + BETA_TAC; + MATCH_MP_TAC LIM_POLY2; + MATCH_EQ_MP_TAC NORMAL_PNEG; + ASM_MESON_TAC[nonconstant]; + MATCH_MP_TAC POW_UNB_CON; + STRIP_TAC; + REWRITE_TAC[DEGREE_PNEG]; + REWRITE_TAC[degree]; + CLAIM `normalize p = p`; + ASM_MESON_TAC[nonconstant;normal]; + DISCH_THEN SUBST1_TAC; + CLAIM `~(LENGTH p = 0)`; + ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_0;degree]; + STRIP_TAC; + CLAIM `~(LENGTH p = 1)`; + ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_1;degree]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + (* save *) + CLAIM `LAST (pneg p) = LAST p`; + ASM_MESON_TAC[GSYM POLY_PNEG_LAST;nonconstant;]; + DISCH_THEN SUBST1_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `x < y <=> ~(x = y) /\ ~(y < x)`]; + STRIP_TAC; + ASM_MESON_TAC[NORMAL_ID;nonconstant]; + STRIP_TAC; + CLAIM `ODD (degree (poly_diff p))`; + ASM_SIMP_TAC[poly_diff_parity2]; + STRIP_TAC; + CLAIM `nonconstant (poly_diff p)`; + MATCH_MP_TAC normal_nonconstant; + STRIP_TAC; + MATCH_MP_TAC NONCONSTANT_DIFF_NORMAL; + FIRST_ASSUM MATCH_ACCEPT_TAC; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `mono_unbounded_above (\n. poly (poly_diff p) (-- &n))`; + MATCH_MP_TAC LAST_UNB_ODD_NEG; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[POLY_DIFF_LAST_LT]; + REWRITE_TAC[mono_unbounded_above]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + (* save *) + MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); + DISCH_THEN (X_CHOOSE_TAC `M:num`); + CLAIM `-- &M <= X - &1`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); + STRIP_TAC; + CLAIM `N <= nmax M N`; + REWRITE_TAC[nmax_le]; + DISCH_THEN (REWRITE_ASSUMS o list); + CLAIM `-- &(nmax M N) < X`; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `-- &M`; + STRIP_TAC; + REWRITE_TAC[nmax]; + REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; + USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; + (* save *) + REWRITE_TAC[GSYM POLY_PNEG]; + MATCH_MP_TAC LAST_UNB_ODD_NEG; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_LT]; + CASES_ON `?x. poly_diff p = [x]`; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[LAST]; + LABEL_ALL_TAC; + USE_THEN "Z-2" MP_TAC; + POP_ASSUM (fun x -> REWRITE_TAC[x] THEN ASSUME_TAC x); + REWRITE_TAC[poly]; + REAL_SIMP_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + EXISTS_TAC `X - &1`; + REAL_ARITH_TAC; + CLAIM `nonconstant (poly_diff p)`; + REWRITE_TAC[nonconstant]; + STRIP_TAC; + MATCH_MP_TAC POLY_DIFF_NORMAL; + FIRST_ASSUM MATCH_ACCEPT_TAC; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `EVEN (degree (poly_diff p))`; + ASM_MESON_TAC[poly_diff_parity]; + STRIP_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x) /\ ~(y = x)`]; + REPEAT STRIP_TAC; + CLAIM `mono_unbounded_above (\n. poly (poly_diff p) (-- (&n)))`; + MATCH_MP_TAC LAST_UNB_EVEN_POS; + ASM_REWRITE_TAC[]; + REWRITE_TAC[mono_unbounded_above]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + (* save *) + MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); + DISCH_THEN (X_CHOOSE_TAC `M:num`); + CLAIM `-- &M <= X - &1`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); + STRIP_TAC; + CLAIM `N <= nmax M N`; + REWRITE_TAC[nmax_le]; + DISCH_THEN (REWRITE_ASSUMS o list); + CLAIM `-- &(nmax M N) < X`; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `-- &M`; + STRIP_TAC; + REWRITE_TAC[nmax]; + REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; + USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; + ASM_MESON_TAC[nonconstant;NORMAL_ID]; + (* save xxx *) + REWRITE_TAC[mono_unbounded_above]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); + DISCH_THEN (X_CHOOSE_TAC `M:num`); + ABBREV_TAC `k = nmax N M`; + EXISTS_TAC `-- &k`; + REPEAT STRIP_TAC; + REWRITE_TAC [ARITH_RULE `x < y <=> ~(y <= x)`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`y:real`;`-- &k`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + CLAIM `&0 < (-- &k) - y`; + USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `poly (poly_diff p) x < &0`; + FIRST_ASSUM MATCH_MP_TAC; + MATCH_MP_TAC REAL_LTE_TRANS; + EXISTS_TAC `-- &k`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS; + EXISTS_TAC `-- &M`; + STRIP_TAC; + USE_THEN "Z-5" (SUBST1_TAC o GSYM); + REWRITE_TAC[nmax]; + REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; + USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + (* save *) + CLAIM `N <= k:num`; + USE_THEN "Z-5" (SUBST1_TAC o GSYM); + REWRITE_TAC[nmax] THEN ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < poly p (-- &k)`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `&0 < poly p (-- &k) - poly p y`; + LABEL_ALL_TAC; + USE_ASSUM_LIST ["Z-10";"Z-3"] MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(-- &k - y) * poly (poly_diff p) x < &0`; + REWRITE_TAC[REAL_MUL_LT]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC; + USE_THEN "Z-0" MP_TAC; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_LEFT = prove_by_refinement( + `!p. nonconstant p /\ (?X. !x. x < X ==> &0 < poly (poly_diff p) x) ==> + (?Y. !y. y < Y ==> poly p y < &0)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `mono_unbounded_below (\n. poly p (-- &n))`; + REWRITE_TAC[POLY_PNEG]; + DISJ_CASES_TAC (ISPEC `degree p` EVEN_OR_ODD); + MATCH_MP_TAC mua_quotient_limit_neg; + EXISTS_TAC `&1`; + EXISTS_TAC `(\n. LAST (pneg p) * &n pow degree (pneg p))`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + BETA_TAC; + MATCH_MP_TAC LIM_POLY2; + MATCH_EQ_MP_TAC NORMAL_PNEG; + ASM_MESON_TAC[nonconstant]; + MATCH_MP_TAC POW_UNBB_CON; + STRIP_TAC; + REWRITE_TAC[DEGREE_PNEG]; + REWRITE_TAC[degree]; + CLAIM `normalize p = p`; + ASM_MESON_TAC[nonconstant;normal]; + DISCH_THEN SUBST1_TAC; + CLAIM `~(LENGTH p = 0)`; + ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_0;degree]; + STRIP_TAC; + CLAIM `~(LENGTH p = 1)`; + ASM_MESON_TAC[nonconstant;normal;LENGTH_NZ;LENGTH_1;degree]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + (* save *) + CLAIM `LAST (pneg p) = LAST p`; + ASM_MESON_TAC[GSYM POLY_PNEG_LAST;nonconstant;]; + DISCH_THEN SUBST1_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `x < y <=> ~(x = y) /\ ~(y < x)`]; + STRIP_TAC; + ASM_MESON_TAC[NORMAL_ID;nonconstant]; + STRIP_TAC; + CLAIM `ODD (degree (poly_diff p))`; + ASM_SIMP_TAC[poly_diff_parity2]; + STRIP_TAC; + CLAIM `nonconstant (poly_diff p)`; + MATCH_MP_TAC normal_nonconstant; + STRIP_TAC; + MATCH_MP_TAC NONCONSTANT_DIFF_NORMAL; + FIRST_ASSUM MATCH_ACCEPT_TAC; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `mono_unbounded_below (\n. poly (poly_diff p) (-- &n))`; + MATCH_MP_TAC LAST_UNB_ODD_POS; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[POLY_DIFF_LAST_GT]; + REWRITE_TAC[mono_unbounded_below]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + (* save *) + MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); + DISCH_THEN (X_CHOOSE_TAC `M:num`); + CLAIM `-- &M <= X - &1`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); + STRIP_TAC; + CLAIM `N <= nmax M N`; + REWRITE_TAC[nmax_le]; + DISCH_THEN (REWRITE_ASSUMS o list); + CLAIM `-- &(nmax M N) < X`; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `-- &M`; + STRIP_TAC; + REWRITE_TAC[nmax]; + REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; + USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; + (* save *) + REWRITE_TAC[GSYM POLY_PNEG]; + MATCH_MP_TAC LAST_UNB_ODD_POS; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[GSYM POLY_DIFF_LAST_GT]; + CASES_ON `?x. poly_diff p = [x]`; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[LAST]; + LABEL_ALL_TAC; + USE_THEN "Z-2" MP_TAC; + POP_ASSUM (fun x -> REWRITE_TAC[x] THEN ASSUME_TAC x); + REWRITE_TAC[poly]; + REAL_SIMP_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + EXISTS_TAC `X - &1`; + REAL_ARITH_TAC; + CLAIM `nonconstant (poly_diff p)`; + REWRITE_TAC[nonconstant]; + STRIP_TAC; + MATCH_MP_TAC POLY_DIFF_NORMAL; + FIRST_ASSUM MATCH_ACCEPT_TAC; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `EVEN (degree (poly_diff p))`; + ASM_MESON_TAC[poly_diff_parity]; + STRIP_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x) /\ ~(y = x)`]; + REPEAT STRIP_TAC; + CLAIM `mono_unbounded_below (\n. poly (poly_diff p) (-- (&n)))`; + MATCH_MP_TAC LAST_UNBB_EVEN_NEG; + ASM_REWRITE_TAC[]; + REWRITE_TAC[mono_unbounded_below]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + (* save *) + MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); + DISCH_THEN (X_CHOOSE_TAC `M:num`); + CLAIM `-- &M <= X - &1`; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-2" (MP_TAC o ISPEC `nmax M N`); + STRIP_TAC; + CLAIM `N <= nmax M N`; + REWRITE_TAC[nmax_le]; + DISCH_THEN (REWRITE_ASSUMS o list); + CLAIM `-- &(nmax M N) < X`; + MATCH_MP_TAC REAL_LET_TRANS; + EXISTS_TAC `-- &M`; + STRIP_TAC; + REWRITE_TAC[nmax]; + REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; + USE_THEN "Z-0" MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ASM_MESON_TAC[ARITH_RULE `~(x < &0 /\ &0 < x)`]; + ASM_MESON_TAC[nonconstant;NORMAL_ID]; + (* save *) + REWRITE_TAC[mono_unbounded_below]; + DISCH_THEN (MP_TAC o ISPEC `&0`); + STRIP_TAC; + MP_TAC (ISPEC `-- (X - &1)` REAL_ARCH_SIMPLE); + DISCH_THEN (X_CHOOSE_TAC `M:num`); + ABBREV_TAC `k = nmax N M`; + EXISTS_TAC `-- &k`; + REPEAT STRIP_TAC; + REWRITE_TAC [ARITH_RULE `x < y <=> ~(y <= x)`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`y:real`;`-- &k`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + CLAIM `&0 < (-- &k) - y`; + USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < poly (poly_diff p) x`; + FIRST_ASSUM MATCH_MP_TAC; + MATCH_MP_TAC REAL_LTE_TRANS; + EXISTS_TAC `-- &k`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS; + EXISTS_TAC `-- &M`; + STRIP_TAC; + USE_THEN "Z-5" (SUBST1_TAC o GSYM); + REWRITE_TAC[nmax]; + REWRITE_TAC[REAL_LE_NEG2; REAL_OF_NUM_LE] THEN ARITH_TAC; + USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + (* save *) + CLAIM `N <= k:num`; + USE_THEN "Z-5" (SUBST1_TAC o GSYM); + REWRITE_TAC[nmax] THEN ARITH_TAC; + STRIP_TAC; + CLAIM `poly p (-- &k) < &0`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `poly p (-- &k) - poly p y < &0`; + LABEL_ALL_TAC; + USE_ASSUM_LIST ["Z-10";"Z-3"] MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (-- &k - y) * poly (poly_diff p) x`; + REWRITE_TAC[REAL_MUL_GT]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC; + USE_THEN "Z-0" MP_TAC; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_LEFT2 = prove_by_refinement( + `!p X. nonconstant p /\ (!x. x < X ==> &0 < poly (poly_diff p) x) ==> + (?Y. Y < X /\ (!y. y < Y ==> poly p y < &0))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPEC `p:real list` POLY_DIFF_DOWN_LEFT); + ASM_REWRITE_TAC[]; + ANTS_TAC; + ASM_MESON_TAC[]; + STRIP_TAC; + EXISTS_TAC `min X Y - &1`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_UP_LEFT2 = prove_by_refinement( + `!p X. nonconstant p /\ (!x. x < X ==> poly (poly_diff p) x < &0) ==> + (?Y. Y < X /\ (!y. y < Y ==> &0 < poly p y))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPEC `p:real list` POLY_DIFF_UP_LEFT); + ASM_REWRITE_TAC[]; + ANTS_TAC; + ASM_MESON_TAC[]; + STRIP_TAC; + EXISTS_TAC `min X Y - &1`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_LEFT3 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. x < X ==> &0 < poly p' x) ==> + (?Y. Y < X /\ (!y. y < Y ==> poly p y < &0))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPEC `p:real list` POLY_DIFF_DOWN_LEFT); + ASM_REWRITE_TAC[]; + ANTS_TAC; + ASM_MESON_TAC[]; + STRIP_TAC; + EXISTS_TAC `min X Y - &1`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_UP_LEFT3 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. x < X ==> poly p' x < &0) ==> + (?Y. Y < X /\ (!y. y < Y ==> &0 < poly p y))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPEC `p:real list` POLY_DIFF_UP_LEFT); + ASM_REWRITE_TAC[]; + ANTS_TAC; + ASM_MESON_TAC[]; + STRIP_TAC; + EXISTS_TAC `min X Y - &1`; + REPEAT STRIP_TAC; + REAL_ARITH_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_LEFT4 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. x < X ==> &0 < poly p' x) ==> + (?Y. Y < X /\ (!y. y <= Y ==> poly p y < &0))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPECL[ `p:real list`;`p':real list`;`X:real`] POLY_DIFF_DOWN_LEFT3); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + EXISTS_TAC `Y - &1`; + STRIP_TAC; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_UP_LEFT4 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. x < X ==> poly p' x < &0) ==> + (?Y. Y < X /\ (!y. y <= Y ==> &0 < poly p y))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPECL[ `p:real list`;`p':real list`;`X:real`] POLY_DIFF_UP_LEFT3); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + EXISTS_TAC `Y - &1`; + STRIP_TAC; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_LEFT5 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. x < X ==> poly p' x > &0) ==> + (?Y. Y < X /\ (!y. y <= Y ==> poly p y < &0))`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt]; + ASM_MESON_TAC[POLY_DIFF_DOWN_LEFT4]; +]);; +(* }}} *) + +let POLY_DIFF_UP_LEFT5 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. x < X ==> poly p' x < &0) ==> + (?Y. Y < X /\ (!y. y <= Y ==> poly p y > &0))`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt]; + MESON_TAC[POLY_DIFF_UP_LEFT4]; +]);; +(* }}} *) + +let NORMAL_PDIFF_LEM = prove_by_refinement( + `!p. normal (poly_diff p) ==> nonconstant p`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[normal;poly_diff;poly_diff_aux]; + REWRITE_TAC[nonconstant]; + REWRITE_TAC[poly_diff;poly_diff_aux;NOT_CONS_NIL;TL;]; + REPEAT STRIP_TAC; + MATCH_MP_TAC NORMAL_CONS; + ASM_MESON_TAC[POLY_DIFF_AUX_NORMAL;ARITH_RULE `~(1 = 0)`]; + CLAIM `t = []`; + ASM_MESON_TAC !LIST_REWRITES; + DISCH_THEN (REWRITE_ASSUMS o list); + ASM_MESON_TAC[normal;poly_diff_aux]; +]);; +(* }}} *) + +let NORMAL_PDIFF = prove_by_refinement( + `!p. nonconstant p = normal (poly_diff p)`, +(* {{{ Proof *) +[ + MESON_TAC[NORMAL_PDIFF_LEM;POLY_DIFF_NORMAL]; +]);; +(* }}} *) + +let POLY_DIFF_UP_RIGHT2 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. X < x ==> &0 < poly p' x) ==> + (?Y. X < Y /\ (!y. Y <= y ==> &0 < poly p y))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPECL[ `p:real list`] (GEN_ALL POLY_DIFF_UP_RIGHT)); + ASM_REWRITE_TAC[]; + ANTS_TAC; + ASM_MESON_TAC[]; + REPEAT STRIP_TAC; + EXISTS_TAC `(max X Y) + &1`; + STRIP_TAC; + REAL_ARITH_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_RIGHT2 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. X < x ==> poly p' x < &0) ==> + (?Y. X < Y /\ (!y. Y <= y ==> poly p y < &0))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MP_TAC (ISPECL[ `p:real list`] (GEN_ALL POLY_DIFF_DOWN_RIGHT)); + ASM_REWRITE_TAC[]; + ANTS_TAC; + ASM_MESON_TAC[]; + REPEAT STRIP_TAC; + EXISTS_TAC `(max X Y) + &1`; + STRIP_TAC; + REAL_ARITH_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLY_DIFF_UP_RIGHT3 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. X < x ==> poly p' x > &0) ==> + (?Y. X < Y /\ (!y. Y <= y ==> poly p y > &0))`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt;real_ge]; + MESON_TAC[POLY_DIFF_UP_RIGHT2]; +]);; +(* }}} *) + +let POLY_DIFF_DOWN_RIGHT3 = prove_by_refinement( + `!p p' X. nonconstant p ==> (poly_diff p = p') ==> + (!x. X < x ==> poly p' x < &0) ==> + (?Y. X < Y /\ (!y. Y <= y ==> poly p y < &0))`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt;real_ge]; + MESON_TAC[POLY_DIFF_DOWN_RIGHT2]; +]);; +(* }}} *) + + + diff --git a/Rqe/basic.ml b/Rqe/basic.ml new file mode 100644 index 0000000..325c73c --- /dev/null +++ b/Rqe/basic.ml @@ -0,0 +1,36 @@ + +(* ---------------------------------------------------------------------- *) +(* Operators *) +(* ---------------------------------------------------------------------- *) +let dest_beq = dest_binop `(<=>)`;; +let t_tm = `T`;; +let f_tm = `F`;; + +parse_as_infix ("<>",(12,"right"));; + +let NEQ = new_definition + `x <> y <=> ~(x = y)`;; + +let nqt = `(<>):A -> A -> bool`;; +let mk_neq (l,r) = + try + let ty = type_of l in + let nqt' = inst[ty,aty] nqt in + mk_comb(mk_comb(nqt',l),r) + with Failure _ -> failwith "mk_neq";; + +(* ---------------------------------------------------------------------- *) +(* Unfiled *) +(* ---------------------------------------------------------------------- *) + +let IMP_AND_THM = TAUT `(p ==> q ==> r) <=> (p /\ q ==> r)`;; +let AND_IMP_THM = TAUT `(p /\ q ==> r) <=> (p ==> q ==> r)`;; + +let is_pos tm = not (is_neg tm);; + +let CONJ_LIST thms = + end_itlist CONJ thms;; + +(* +CONJ_LIST [TRUTH;TRUTH;TRUTH] +*) diff --git a/Rqe/condense.ml b/Rqe/condense.ml new file mode 100644 index 0000000..6f93610 --- /dev/null +++ b/Rqe/condense.ml @@ -0,0 +1,667 @@ +(* ====================================================================== *) +(* CONDENSE *) +(* ====================================================================== *) +(* +let merge_interpsign ord_thm (thm1,thm2,thm3) = + let thm1' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm1) in + let thm2' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm2) in + let thm3' = BETA_RULE(PURE_REWRITE_RULE[interpsign] thm3) in + let set1,_,_ = dest_interpsign thm1 in + let _,s1 = dest_abs set1 in + let set3,_,_ = dest_interpsign thm3 in + let _,s3 = dest_abs set3 in + let gthm = + if is_conj s1 && is_conj s3 then gen_thm + else if is_conj s1 && not (is_conj s3) then gen_thm_noright + else if not (is_conj s1) && is_conj s3 then gen_thm_noleft + else gen_thm_noboth in + PURE_REWRITE_RULE[GSYM interpsign] (MATCH_MPL[gthm;ord_thm;thm1';thm2';thm3']);; +*) +(* {{{ Examples *) + +(* + +length thms +merge_interpsign ord_thm (hd thms) + +let thm1,thm2,thm3 = hd thms + +let ord_thm = ASSUME `x2 < x3`;; +let thm1 = ASSUME `interpsign (\x. x < x2) [&1; &2; &3] Pos`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Pos`;; +let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Pos`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = ASSUME `x1 < x2`;; +let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Pos`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Pos`;; +let thm3 = ASSUME `interpsign (\x. x2 < x) [&1; &2; &3] Pos`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = TRUTH;; +let thm1 = ASSUME `interpsign (\x. x < x1) [&1; &2; &3] Pos`;; +let thm2 = ASSUME `interpsign (\x. x = x1) [&1; &2; &3] Pos`;; +let thm3 = ASSUME `interpsign (\x. x1 < x) [&1; &2; &3] Pos`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = ASSUME `x1 < x2 /\ x2 < x3`;; +let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Pos`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Pos`;; +let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Pos`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = ASSUME `x1 < x3`;; +let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Neg`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Neg`;; +let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Neg`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = ASSUME `x1 < x3`;; +let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Zero`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Zero`;; +let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Zero`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = ASSUME `x1 < x3`;; +let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Nonzero`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Nonzero`;; +let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Nonzero`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + +let ord_thm = ASSUME `x1 < x3`;; +let thm1 = ASSUME `interpsign (\x. x1 < x /\ x < x2) [&1; &2; &3] Unknown`;; +let thm2 = ASSUME `interpsign (\x. x = x2) [&1; &2; &3] Unknown`;; +let thm3 = ASSUME `interpsign (\x. x2 < x /\ x < x3) [&1; &2; &3] Unknown`;; +merge_interpsign ord_thm (thm1,thm2,thm3);; + + +*) +(* }}} *) +(* +let rec merge_three l1 l2 l3 = + match l1 with + [] -> [] + | h::t -> (hd l1,hd l2,hd l3)::merge_three (tl l1) (tl l2) (tl l3);; +*) + +(* {{{ Doc *) +(* + combine_interpsigns + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x1 < x /\ x < x2) + [Unknown; Pos; Pos; Neg] + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x = x2) + [Unknown; Pos; Pos; Neg]; + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x2 < x /\ x < x3) + [Unknown; Pos; Pos; Neg]; +--> + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x1 < x /\ x < x3) + [Unknown; Pos; Pos; Neg]; +*) +(* }}} *) +(* +let combine_interpsigns ord_thm thm1 thm2 thm3 = + let _,_,s1 = dest_interpsigns thm1 in + let _,_,s2 = dest_interpsigns thm2 in + let _,_,s3 = dest_interpsigns thm3 in + if not (s1 = s2) or not (s1 = s3) then failwith "combine_interpsigns: signs not equal" else + try + let thms1 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm1) in + let thms2 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm2) in + let thms3 = CONJUNCTS(PURE_REWRITE_RULE[interpsigns;ALL2] thm3) in + let thms = butlast (merge_three thms1 thms2 thms3) (* ignore the T at end *) in + let thms' = map (merge_interpsign ord_thm) thms in + mk_interpsigns thms' + with Failure s -> failwith ("combine_interpsigns: " ^ s);; +*) +(* {{{ Examples *) + +(* +let thm = combine_interpsigns +let ord_thm,thm1,thm2,thm3 = ord_thm5 ,ci1 ,ci2 ,ci3 + + +let h1 = combine_interpsigns ord_thm int1 pt int2 in +let thm1,thm2,thm3 = int1,pt,int2 + +let tmp = (ith 0 thms) +merge_interpsign ord_thm tmp + +let thm1 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x1 < x /\ x < x2) + [Unknown; Pos; Pos; Neg]`;; + +let thm2 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x = x2) + [Unknown; Pos; Pos; Neg]`;; + +let thm3 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x2 < x /\ x < x3) + [Unknown; Pos; Pos; Neg]`;; + +let ord_thm = ASSUME `x1 < x2 /\ x2 < x3` + +combine_interpsigns ord_thm thm1 thm2 thm3;; + + + +let thm1 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x < x5) + [Unknown; Pos; Pos; Neg]`;; + +let thm2 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x = x5) + [Unknown; Pos; Pos; Neg]`;; + +let thm3 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x5 < x /\ x < x6) + [Unknown; Pos; Pos; Neg]`;; + +let ord_thm = ASSUME `x5 < x6`;; + +combine_interpsigns ord_thm thm1 thm2 thm3;; + + +let thm1 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x < x6) + [Unknown; Pos; Pos; Neg]`;; + +let thm2 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x = x6) + [Unknown; Pos; Pos; Neg]`;; + +let thm3 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x6 < x) + [Unknown; Pos; Pos; Neg]`;; + +let ord_thm = ASSUME `x5 < x6`;; + +combine_interpsigns ord_thm thm1 thm2 thm3;; + + +*) + +(* }}} *) + + +(* {{{ Doc *) +(* + get_bounds `\x. x < x1` `\x. x1 < x /\ x < x2` + --> + x1 < x2 + + get_bounds `\x. x0 < x < x1` `\x. x1 < x /\ x < x2` + --> + x0 < x1 /\ x1 < x2 + + get_bounds `\x. x < x1` `\x. x1 < x` + --> + T + +*) +(* }}} *) +(* +let get_bounds set1 set2 = + let _,s1 = dest_abs set1 in + let _,s2 = dest_abs set2 in + let c1 = + if is_conj s1 then + let l,r = dest_conj s1 in + let l1,l2 = dest_binop rlt l in + let l3,l4 = dest_binop rlt r in + mk_binop rlt l1 l4 + else t_tm in + let c2 = + if is_conj s2 then + let l,r = dest_conj s2 in + let l1,l2 = dest_binop rlt l in + let l3,l4 = dest_binop rlt r in + mk_binop rlt l1 l4 + else t_tm in + if c1 = t_tm then c2 + else if c2 = t_tm then c1 + else mk_conj (c1,c2);; +*) +(* {{{ Examples *) +(* + get_bounds `\x. x < x1` `\x. x1 < x /\ x < x2` + + + get_bounds `\x. x0 < x /\ x < x1` `\x. x1 < x /\ x < x2` + + get_bounds `\x. x < x1` `\x. x1 < x` +*) +(* }}} *) + + +(* {{{ Doc *) + +(* collect_pts + |- interpsigns ... (\x. x < x1) ... + |- interpsigns ... (\x. x1 < x /\ x < x4) ... + |- interpsigns ... (\x. x4 < x /\ x < x7) ... + |- interpsigns ... (\x. x7 < x) ... + + --> + [x1,x4,x7] +*) + +(* }}} *) +(* + +let rec collect_pts thms = + match thms with + [] -> [] + | h::t -> + let rest = collect_pts t in + let _,set,_ = dest_interpsigns h in + let x,b = dest_abs set in + let bds = + if b = t_tm then [] + else if is_conj b then + let l,r = dest_conj b in + [fst(dest_binop rlt l);snd(dest_binop rlt r)] + else + let _,l,r = get_binop b in + if x = l then [r] else [l] in + match rest with + [] -> bds + | h::t -> if not (h = (last bds)) then failwith "pts not in order" + else if length bds = 2 then hd bds::rest else rest;; +*) +(* {{{ Examples *) + +(* + +let thms = [ASSUME `interpsigns [\x. &0 + x * &1; \x. &1] (\x. T) [Unknown; Pos]`] +let h::t = [ASSUME `interpsigns [\x. &0 + x * &1; \x. &1] (\x. T) [Unknown; Pos]`] +collect_pts [ASSUME `interpsigns [\x. &0 + x * &1; \x. &1] (\x. T) [Unknown; Pos]`] + +let t1 = ASSUME `interpsigns [[&1]] (\x. x < x1) [Pos]` +let t2 = ASSUME `interpsigns [[&1]] (\x. x1 < x /\ x < x4) [Pos]` +let t3 = ASSUME `interpsigns [[&1]] (\x. x4 < x /\ x < x7) [Pos]` +let t4 = ASSUME `interpsigns [[&1]] (\x. x7 < x) [Pos]` + +collect_pts [t1;t2;t3;t4] + +let t1 = ASSUME `interpsigns [[&1]] (\x. x0 < x /\ x < x1) [Pos]` +let t2 = ASSUME `interpsigns [[&1]] (\x. x1 < x /\ x < x4) [Pos]` +let t3 = ASSUME `interpsigns [[&1]] (\x. x4 < x /\ x < x7) [Pos]` +let t4 = ASSUME `interpsigns [[&1]] (\x. x7 < x) [Pos]` + +collect_pts [t1;t2;t3;t4] + +let t1 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x < x1) + [Unknown; Pos; Pos; Pos]`;; + +let t2 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x = x1) + [Neg; Pos; Pos; Zero]`;; + +let t3 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x1 < x /\ x < x4) + [Unknown; Pos; Pos; Neg]`;; + +let t4 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x = x4) + [Pos; Pos; Zero; Neg]`;; + +let t5 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x4 < x /\ x < x5) + [Unknown; Pos; Neg; Neg]`;; + +let t6 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x = x5) + [Pos; Pos; Zero; Zero]`;; + +let t7 = ASSUME + `interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; + &1]] + (\x. x5 < x) + [Unknown; Pos; Pos; Pos]`;; + +let thms = [t1;t2;t3;t4;t5;t6;t7] +collect_pts thms + +*) + + + + + +(* +combine_identical_lines + |- real_ordered_list [x1; x2; x3; x4; x5] + |- ALL2 + (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) + (partition_line [x1; x2; x3; x4; x5]) + [[Unknown; Pos; Pos; Pos]; +x1 [Neg; Pos; Pos; Zero]; + [Unknown; Pos; Pos; Neg]; +x2 [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; +x3 [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; +x4 [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; +x5 [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Pos]] + + --> + + + |- ALL2 + (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) + (partition_line [x1; x4; x5]) + [[Unknown; Pos; Pos; Pos]; +x1 [Neg; Pos; Pos; Zero]; + [Unknown; Pos; Pos; Neg]; +x4 [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; +x5 [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Pos]] + +*) + +(* }}} *) + +(* +let sublist i j l = + let _,r = chop_list i l in + let l2,r2 = chop_list (j-i+1) r in + l2;; +*) +(* {{{ Examples *) +(* +let i,j,l = 1,4,[1;2;3;4;5;6;7] +sublist 1 4 [1;2;3;4;5;6;7] +sublist 2 4 [1;2;3;4;5;6;7] +sublist 1 1 [1;2;3;4;5;6;7] +*) +(* }}} *) + +(* +let rec combine ord_thms l = + let lem = REWRITE_RULE[AND_IMP_THM] REAL_LT_TRANS in + match l with + [int] -> [int] + | [int1;int2] -> [int1;int2] + | int1::pt::int2::rest -> + try + let _,set1,_ = dest_interpsigns int1 in + let _,set2,_ = dest_interpsigns int2 in + let ord_tm = get_bounds set1 set2 in + if ord_tm = t_tm then + let h1 = combine_interpsigns TRUTH int1 pt int2 in + combine ord_thms (h1::rest) + else + let lt,rt = + if is_conj ord_tm then + let c1,c2 = dest_conj ord_tm in + let l,_ = dest_binop rlt c1 in + let _,r = dest_binop rlt c2 in + l,r + else dest_binop rlt ord_tm in + let e1 = find (fun x -> lt = fst(dest_binop rlt (concl x))) ord_thms in + let i1 = index e1 ord_thms in + let e2 = find (fun x -> rt = snd(dest_binop rlt (concl x))) ord_thms in + let i2 = index e2 ord_thms in + let ord_thms' = sublist i1 i2 ord_thms in + let ord_thm = end_itlist (fun x y -> MATCH_MPL[lem;x;y]) ord_thms' in + let h1 = combine_interpsigns ord_thm int1 pt int2 in + combine ord_thms (h1::rest) + with + Failure "combine_interpsigns: signs not equal" -> + int1::pt::(combine ord_thms(int2::rest));; +*) + +(* +let combine_identical_lines rol_thm all_thm = + let tmp,mat = dest_comb (concl all_thm) in + let _,line = dest_comb tmp in + let _,pts = dest_comb line in + let part_thm = PARTITION_LINE_CONV pts in + let thm' = REWRITE_RULE[ALL2;part_thm] all_thm in + let thms = CONJUNCTS thm' in + let ord_thms = rol_thms rol_thm in + let thms' = combine ord_thms thms in + let pts = collect_pts thms' in + let part_thm' = PARTITION_LINE_CONV (mk_list (pts,real_ty)) in + mk_all2_interpsigns part_thm' thms';; +*) +(* {{{ Examples *) + +(* +#untrace combine +#trace combine +let int1::pt::int2::rest = snd (chop_list 6 thms) +let int1::pt::int2::rest = snd (chop_list 0 thms) +let int1::pt::int2::rest = snd (chop_list 2 thms) + +let l = thms +let int1::pt::int2::rest = l +combine thms +let rol_thm = ASSUME `real_ordered_list [x1; x2; x3; x4; x5]` +let all_thm = ASSUME + `ALL2 + (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) + (partition_line [x1; x2; x3; x4; x5]) + [[Unknown; Pos; Pos; Pos]; + [Neg; Pos; Pos; Zero]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Unknown; Pos; Pos; Neg]; + [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; + [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Pos]]`;; + +let all_thm' = combine_identical_lines rol_thm all_thm + +*) + +(* }}} *) + +(* {{{ Doc *) +(* +assumes l2 is a sublist of l1 + +list_diff [1;2;3;4] [2;3] --> [1;4] + +*) +(* }}} *) +(* +let rec list_diff l1 l2 = + match l1 with + [] -> if l2 = [] then [] else failwith "l2 not a sublist of l1" + | h::t -> + match l2 with + [] -> l1 + | h'::t' -> if h = h' then list_diff t t' + else h::list_diff t l2;; +*) +(* {{{ Examples *) +(* +list_diff [1;2;3;4] [2;3] +list_diff [1;2;3;4] [1;3;4] +*) +(* }}} *) + +(* +let CONDENSE mat_thm = + let rol_thm,all_thm = interpmat_thms mat_thm in + let pts = dest_list (snd (dest_comb (concl rol_thm))) in + let all_thm' = combine_identical_lines rol_thm all_thm in + let _,part,_ = dest_all2 (concl all_thm) in + let plist = dest_list (snd (dest_comb part)) in + let _,part',_ = dest_all2 (concl all_thm') in + let plist' = dest_list (snd (dest_comb part')) in + let rol_thm' = itlist ROL_REMOVE (list_diff plist plist') rol_thm in + let mat_thm' = mk_interpmat_thm rol_thm' all_thm' in + mat_thm';; +*) +(* ---------------------------------------------------------------------- *) +(* OPT *) +(* ---------------------------------------------------------------------- *) + +let rec triple_index l = + match l with + [] -> failwith "triple_index" + | [x] -> failwith "triple_index" + | [x;y] -> failwith "triple_index" + | x::y::z::rest -> if x = y && y = z then 0 else 1 + triple_index (y::z::rest);; + +let tmp = ref TRUTH;; +(* +let +tmp +let mat_thm = !tmp +let mat_thm = mat_thm' +*) +let rec CONDENSE = + let real_app = `APPEND:real list -> real list -> real list` in + let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in + let real_len = `LENGTH:real list -> num` in + let sign_len = `LENGTH:(sign list) list -> num` in + let num_mul = `( * ):num -> num -> num` in + let real_ty = `:real` in + let two = `2` in + let sl_ty = `:sign list` in + fun mat_thm -> + try + tmp := mat_thm; + let pts,_,sgns = dest_interpmat (concl mat_thm) in + let sgnl = dest_list sgns in + let ptl = dest_list pts in + let i = triple_index sgnl (* fail here if fully condensed *) in + if not (i mod 2 = 0) then failwith "misshifted matrix" else + if i = 0 then + if length ptl = 1 then MATCH_MP INTERPMAT_SING mat_thm + else CONDENSE (MATCH_MP INTERPMAT_TRIO mat_thm) else + let l,r = chop_list (i - 2) sgnl in + let sgn1,sgn2 = mk_list(l,sl_ty),mk_list(r,sl_ty) in + let sgns' = mk_comb(mk_comb(sign_app,sgn1),sgn2) in + let sgn_thm = prove(mk_eq(sgns,sgns'),REWRITE_TAC[APPEND]) in + let l',r' = chop_list (i / 2 - 1) ptl (* i always even *) in + let pt1,pt2 = mk_list(l',real_ty),mk_list(r',real_ty) in + let pts' = mk_comb(mk_comb(real_app,pt1),pt2) in + let pt_thm = prove(mk_eq(pts,pts'),REWRITE_TAC[APPEND]) in + let mat_thm' = ONCE_REWRITE_RULE[sgn_thm;pt_thm] mat_thm in + let len_thm = prove((mk_eq(mk_comb(sign_len,sgn1),mk_binop num_mul two (mk_comb(real_len,pt1)))),REWRITE_TAC[LENGTH] THEN ARITH_TAC) in + CONDENSE (REWRITE_RULE[APPEND] + (MATCH_MP (MATCH_MP INTERPMAT_TRIO_INNER mat_thm') len_thm)) + with + Failure "triple_index" -> mat_thm + | Failure x -> failwith ("CONDENSE: " ^ x);; + + +(* {{{ Examples *) + +(* + +let mat_thm = mat_thm' +CONDENSE mat_thm + + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); + \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] + [ + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Pos; Neg; Neg; Neg]; + [Zero; Pos; Pos; Neg; Neg; Neg]; + [Neg; Pos; Pos; Neg; Neg; Neg] + ]` + + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); + \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` + +let mat_thm' = INFERPSIGN vars sgns mat_thm div_thms + +CONDENSE mat_thm + + + +*) + +(* }}} *) + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let CONDENSE mat_thm = + let start_time = Sys.time() in + let res = CONDENSE mat_thm in + condense_timer +.= (Sys.time() -. start_time); + res;; + diff --git a/Rqe/condense_thms.ml b/Rqe/condense_thms.ml new file mode 100644 index 0000000..c7760d5 --- /dev/null +++ b/Rqe/condense_thms.ml @@ -0,0 +1,51 @@ +(* ------------------------------------------------------------------------- *) +(* Condense subdivision by removing points with no relevant zeros. *) +(* ------------------------------------------------------------------------- *) + +let real_cases = prove(`!x y. x < y \/ (x = y) \/ y < x`,REAL_ARITH_TAC);; + +let gt_aux = prove( + `!x. (x1 < x2 /\ x2 < x3) /\ ((x1 < x /\ x < x2) \/ (x = x2) \/ (x2 < x /\ x < x3)) ==> x1 < x /\ x < x3`, + REAL_ARITH_TAC);; + +let gen_thm = prove_by_refinement( + `!P x1 x2 x3. + (x1 < x3) ==> + (!x. x1 < x /\ x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x /\ x < x3 ==> P x) ==> + (!x. x1 < x /\ x < x3 ==> P x)`, +(* {{{ Proof *) + +[ + MESON_TAC[real_cases;gt_aux;DE_MORGAN_THM;REAL_NOT_LT;REAL_LE_LT]; +]);; + +(* }}} *) + +let gen_thm_noleft = prove( + `!P x2 x3. + (x2 < x3) ==> + (!x. x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x /\ x < x3 ==> P x) ==> + (!x. x < x3 ==> P x)`, + MESON_TAC[real_cases;gt_aux]);; + +let gen_thm_noright = prove( + `!P x1 x2. + (x1 < x2) ==> + (!x. x1 < x /\ x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x ==> P x) ==> + (!x. x1 < x ==> P x)`, + MESON_TAC[real_cases;gt_aux]);; + +let gen_thm_noboth = prove( + `!P Q x2. + Q ==> + (!x. x < x2 ==> P x) ==> + (!x. (x = x2) ==> P x) ==> + (!x. x2 < x ==> P x) ==> + (!x. T ==> P x)`, + MESON_TAC[real_cases;gt_aux]);; diff --git a/Rqe/dedmatrix.ml b/Rqe/dedmatrix.ml new file mode 100644 index 0000000..c0bbb7e --- /dev/null +++ b/Rqe/dedmatrix.ml @@ -0,0 +1,238 @@ +(* ====================================================================== *) +(* DEDMATRIX *) +(* ====================================================================== *) + +(* ------------------------------------------------------------------------- *) +(* Deduce matrix for p,p1,...,pn from matrix for p',p1,...,pn,q0,...,qn *) +(* where qi = rem(p,pi) with p0 = p' *) +(* ------------------------------------------------------------------------- *) + +let prove_nonconstant = + let nonconstant_tm = `nonconstant` in + fun pdiff_thm normal_thm -> + let thm = ONCE_REWRITE_RULE[GSYM pdiff_thm] normal_thm in + let ret = REWRITE_RULE[GSYM NORMAL_PDIFF] thm in + let f,_ = strip_comb (concl ret) in + if not (f = nonconstant_tm) then failwith "prove_nonconstant" else ret;; + +let REMOVE_COLUMN1 mat_thm = + let mat_thm1 = MATCH_MP REMOVE_COL1 mat_thm in + REWRITE_RULE[MAP;HD;TL] mat_thm1;; + +let APPENDIZE l n = + let lty = type_of l in + let ty = hd(snd(dest_type lty)) in + let app_tm = mk_const("APPEND",[ty,aty]) in + let l1,l2 = chop_list n (dest_list l) in + let app = mk_comb(mk_comb(app_tm,mk_list(l1,ty)),mk_list(l2,ty)) in + GSYM (REWRITE_CONV[APPEND] app);; + +let REMOVE_INFINITIES thm = + let thm' = MATCH_MP INTERPMAT_TRIO thm in + let pts,_,sgns = dest_interpmat (concl thm') in + let p_thm = APPENDIZE pts (length (dest_list pts) - 2) in + let pts',_,sgns = dest_interpmat (concl thm') in + let s_thm = APPENDIZE sgns (length (dest_list sgns) - 5) in + let thm'' = MATCH_MP INTERPMAT_TRIO_TL (ONCE_REWRITE_RULE[p_thm;s_thm] thm') in + REWRITE_RULE[APPEND] thm'';; + +let get_dirs = + let pos = `Pos` in + let neg = `Neg` in + fun lb_deriv ub_deriv -> + if lb_deriv = pos && ub_deriv = pos then INFIN_POS_POS + else if lb_deriv = pos && ub_deriv = neg then INFIN_POS_NEG + else if lb_deriv = neg && ub_deriv = pos then INFIN_NEG_POS + else if lb_deriv = neg && ub_deriv = neg then INFIN_NEG_NEG + else failwith "get_dirs: bad signs";; + +let get_sing_dirs = + let pos = `Pos` in + let neg = `Neg` in + fun lb_deriv ub_deriv -> + if lb_deriv = pos && ub_deriv = pos then INFIN_SING_POS_POS + else if lb_deriv = pos && ub_deriv = neg then INFIN_SING_POS_NEG + else if lb_deriv = neg && ub_deriv = pos then INFIN_SING_NEG_POS + else if lb_deriv = neg && ub_deriv = neg then INFIN_SING_NEG_NEG + else failwith "get_dirs: bad signs";; + + +let aitvars,aitdiff,aitnorm,aitmat = ref [],ref TRUTH,ref TRUTH,ref TRUTH;; +(* +let vars,diff_thm,normal_thm,mat_thm = !aitvars,!aitdiff,!tnorm,!tmat +let vars,diff_thm,normal_thm,mat_thm = vars, pdiff_thm, normal_thm, mat_thm'' +*) +let ADD_INFINITIES = + let real_app = `APPEND:real list -> real list -> real list` in + let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in + let imat = `interpmat` in + let pos = `Pos` in + let neg = `Neg` in + let sl_ty = `:sign list` in + let real_ty = `:real` in + fun vars diff_thm normal_thm mat_thm -> + aitvars := vars; + aitdiff := diff_thm; + aitnorm := normal_thm; + aitmat := mat_thm; + let nc_thm = prove_nonconstant diff_thm normal_thm in + let pts,pols,sgns = dest_interpmat (concl mat_thm) in + let polsl = dest_list pols in + let p::p'::_ = polsl in + let p_thm = ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p))) in + let p'_thm = ONCE_REWRITE_RULE[GSYM diff_thm] (ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p')))) in + let pols_thm = REWRITE_CONV[p_thm;p'_thm] pols in + let sgnsl = dest_list sgns in + let sgns_len = length sgnsl in + let thm1 = + if sgns_len = 1 then + let sgn = (hd(tl(dest_list (hd sgnsl)))) in + let mp_thm = + if sgn = pos then INFIN_NIL_POS + else if sgn = neg then INFIN_NIL_NEG + else failwith "bad sign in mat" in + let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),REFL sgns) in + let mat_thm2 = EQ_MP mat_thm1 mat_thm in + MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm + else if sgns_len = 3 then + let lb_deriv = hd (tl (dest_list (hd sgnsl))) in + let ub_deriv = hd (tl (dest_list (last sgnsl))) in + let mp_thm = get_sing_dirs lb_deriv ub_deriv in + let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),REFL sgns) in + let mat_thm2 = EQ_MP mat_thm1 mat_thm in + MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm + else + let s1,s2 = chop_list (sgns_len - 3) sgnsl in + let s3 = mk_list(s1,sl_ty) in + let s4 = mk_comb(mk_comb(sign_app,s3),mk_list(s2,sl_ty)) in + let sgns_thm = prove(mk_eq(sgns,s4),REWRITE_TAC[APPEND]) in + let mat_thm1 = MK_COMB(MK_COMB(AP_TERM imat (REFL pts), pols_thm),sgns_thm) in + let mat_thm2 = EQ_MP mat_thm1 mat_thm in + let lb_deriv = hd (tl (dest_list (hd sgnsl))) in + let ub_deriv = hd (tl (dest_list (last sgnsl))) in + let mp_thm = get_dirs lb_deriv ub_deriv in + MATCH_MP (MATCH_MP mp_thm mat_thm2) nc_thm in + let thm2 = REWRITE_RULE[APPEND;GSYM pols_thm] thm1 in + let c = concl thm2 in + let x,bod = dest_exists c in + let x' = new_var real_ty in + let bod1 = subst [x',x] bod in + let assume_thm1 = ASSUME bod1 in + let x2,bod2 = dest_exists bod1 in + let x'' = new_var real_ty in + let assume_thm2 = ASSUME (subst [x'',x2] bod2) in + assume_thm2,(x',thm2),(x'',assume_thm1);; + + +(* +print_timers() +print_times() +reset_timers() +*) + + +let tvars,tsgns,tdivs,tdiff,tnorm,tcont,tmat,tex = ref [],ref [],ref [], ref TRUTH,ref TRUTH, ref (fun x y -> x), ref TRUTH, ref [];; +(* +let vars,sgns,div_thms,pdiff_thm,normal_thm,cont,mat_thm,ex_thms = !tvars,!tsgns,!tdivs,!tdiff,!tnorm,!tcont,!tmat,!tex +DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms +*) + +let DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont mat_thm ex_thms = + try + tvars := vars; + tsgns := sgns; + tdivs := div_thms; + tdiff := pdiff_thm; + tnorm := normal_thm; + tmat := mat_thm; + tex := ex_thms; + tcont := cont; + let start_time = Sys.time() in + let pts,pols,signll = dest_interpmat (concl mat_thm) in + let mat_thm' = INFERPSIGN vars sgns mat_thm div_thms in + let mat_thm'' = CONDENSE mat_thm' in + let mat_thm''',(v1,exthm1),(v2,exthm2) = ADD_INFINITIES vars pdiff_thm normal_thm mat_thm'' in + let mat_thm4,new_ex_pairs = INFERISIGN vars pdiff_thm mat_thm''' ((v1,exthm1)::(v2,exthm2)::ex_thms) in + let mat_thm5 = REMOVE_INFINITIES mat_thm4 in + let mat_thm6 = REMOVE_COLUMN1 mat_thm5 in + let mat_thm7 = CONDENSE mat_thm6 in + (* hack for changing renamed vars *) + let mat_thm8 = CONV_RULE (RATOR_CONV (RAND_CONV (LIST_CONV (ALPHA_CONV (hd vars))))) mat_thm7 in + let ex_pairs = [(v1,exthm1);(v2,exthm2)] @ new_ex_pairs in + let cont' mat_thm ex_thms = cont mat_thm (ex_thms @ ex_pairs) in + cont' mat_thm8 ex_thms + with (Isign (false_thm,ex_thms)) -> + raise (Isign (false_thm,ex_thms)) + | Failure x -> failwith ("DEDMATRIX: " ^ x);; + +(* {{{ Examples *) + +(* + + +let NOT_NIL_CONV tm = + let h,t = dest_cons tm in + ISPECL [h;t] NOT_CONS_NIL;; + +let NORMAL_CONV tm = + let normalize_thm = POLY_NORMALIZE_CONV (mk_comb (`normalize`,tm)) in + let nonnil_thm = NOT_NIL_CONV tm in + let conj_thm = CONJ normalize_thm nonnil_thm in + REWRITE_RULE[GSYM normal] conj_thm;; + +let vars = [`x:real`];; +let cont a b = a;; +let sgns = [ARITH_RULE `&1 > &0`];; +let normal_thm = NORMAL_CONV `[&1; &2; &3]`;; +let pdiff_thm = POLY_DIFF_CONV `poly_diff [&1; &1; &1; &1]`;; +let ex_thms = [];; +let _,l1 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(&1 + x * (&2 + x * &3))`;; +let _,l2 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(&2 + x * (-- &3 + x * &1))`;; +let _,l3 = PDIVIDES vars sgns `(&1 + x * (&1 + x * (&1 + x * &1)))` `(-- &4 + x * (&0 + x * &1))`;; +let div_thms = [l1;l2;l3];; + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); + \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Zero; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Zero; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Zero; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` ;; + +time (DEDMATRIX vars sgns div_thms pdiff_thm normal_thm (fun x y -> x) mat_thm) [] + + +*) + +(* }}} *) + + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let REMOVE_COLUMN1 mat_thm = + let start_time = Sys.time() in + let res = REMOVE_COLUMN1 mat_thm in + remove_column1_timer +.= (Sys.time() -. start_time); + res;; + +let ADD_INFINITIES vars pdiff_thm normal_thm mat_thm = + let start_time = Sys.time() in + let res = ADD_INFINITIES vars pdiff_thm normal_thm mat_thm in + add_infinities_timer +.= (Sys.time() -. start_time); + res;; + +let REMOVE_INFINITIES thm = + let start_time = Sys.time() in + let res = REMOVE_INFINITIES thm in + remove_infinities_timer +.= (Sys.time() -. start_time); + res;; diff --git a/Rqe/dedmatrix_thms.ml b/Rqe/dedmatrix_thms.ml new file mode 100644 index 0000000..4b24cbd --- /dev/null +++ b/Rqe/dedmatrix_thms.ml @@ -0,0 +1,158 @@ +let le_lem = prove_by_refinement( + `(!y. y <= Y ==> P y) ==> + (!y. y < Y ==> P y) /\ + (!y. (y = Y) ==> P y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + + +let lt_int_lem = prove_by_refinement( + `(!y. y < Y ==> P y) ==> X < Y ==> + (!y. X < y /\ y < Y ==> P y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let ge_lem = prove_by_refinement( + `(!y. Y <= y ==> P y) ==> + (!y. Y < y ==> P y) /\ + (!y. (y = Y) ==> P y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + FIRST_ASSUM MATCH_MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let gt_int_lem = prove_by_refinement( + `(!y. Y < y ==> P y) ==> Y < X ==> + (!y. Y < y /\ y < X ==> P y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let rest_lt_lem = prove_by_refinement( + `Y < X ==> (!x. x < X ==> P x) ==> (!x. x < Y ==> P x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS;real_gt]; +]);; +(* }}} *) + +let rest_gt_lem = prove_by_refinement( + `X < Y ==> (!x. X < x ==> P x) ==> (!x. Y < x ==> P x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS;real_gt]; +]);; +(* }}} *) + +let rest_eq_lt_lem = prove_by_refinement( + `Y < X ==> (!x. x < X ==> P x) ==> (!x. (x = Y) ==> P x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; +]);; +(* }}} *) + +let rest_eq_gt_lem = prove_by_refinement( + `X < Y ==> (!x. X < x ==> P x) ==> (!x. (x = Y) ==> P x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; +]);; +(* }}} *) + +let rest_int_lt_lem = prove_by_refinement( + `Y < X ==> (!x. x < X ==> P x) ==> (!x. Y < x /\ x < X ==> P x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; +]);; +(* }}} *) + +let rest_int_gt_lem = prove_by_refinement( + `X < Y ==> (!x. X < x ==> P x) ==> (!x. X < x /\ x < Y ==> P x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; +]);; +(* }}} *) + + +let INTERPSIGN_SUBSET = prove_by_refinement( + `!P Q p s. interpsign P p s /\ Q SUBSET P ==> interpsign Q p s`, +(* {{{ Proof *) +[ + REWRITE_TAC[SUBSET;IN]; + REPEAT_N 4 STRIP_TAC; + STRUCT_CASES_TAC (ISPEC `s:sign` SIGN_CASES) THEN + REWRITE_TAC[interpsign] THEN MESON_TAC[]; +]);; +(* }}} *) + +let INTERPSIGNS_SUBSET = prove_by_refinement( + `!P Q ps ss. interpsigns ps P ss /\ Q SUBSET P ==> interpsigns ps Q ss`, +(* {{{ Proof *) +[ + REWRITE_TAC[SUBSET;IN]; + REPEAT_N 2 STRIP_TAC; + LIST_INDUCT_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[ALL2;interpsigns;interpsign]; + REWRITE_TAC[ALL2;interpsigns;interpsign]; + LIST_INDUCT_TAC; + REWRITE_TAC[ALL2;interpsigns;interpsign]; + REWRITE_TAC[ALL2;interpsigns;interpsign]; + (* save *) + REPEAT STRIP_TAC; + MATCH_MP_TAC INTERPSIGN_SUBSET; + ASM_MESON_TAC[SUBSET;IN]; + REWRITE_ASSUMS[ALL2;interpsigns;interpsign]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let NOPOINT_LEM = prove_by_refinement( + `!pl sl. interpsigns pl (\x. T) sl ==> + (interpsigns pl (\x. x < &0) sl /\ + interpsigns pl (\x. x = &0) sl /\ + interpsigns pl (\x. &0 < x) sl)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTERPSIGNS_SUBSET THEN ASM_MESON_TAC[SUBSET;IN] +]);; + +(* }}} *) diff --git a/Rqe/defs.ml b/Rqe/defs.ml new file mode 100644 index 0000000..e6524c5 --- /dev/null +++ b/Rqe/defs.ml @@ -0,0 +1,314 @@ +(* ====================================================================== *) +(* Signs *) +(* ====================================================================== *) + +(* ---------------------------------------------------------------------- *) +(* Datatype *) +(* ---------------------------------------------------------------------- *) + +let sign_INDUCT,sign_RECURSION = define_type + "sign = Zero | Pos | Neg | Nonzero | Unknown";; + +let SIGN_CASES = prove_by_refinement( + `!s. (s = Pos) \/ (s = Neg) \/ (s = Zero) \/ (s = Nonzero) \/ (s = Unknown)`, +(* {{{ Proof *) +[ + MATCH_MP_TAC sign_INDUCT; + REWRITE_TAC[]; +]);; +(* }}} *) + +let szero_tm,spos_tm,sneg_tm,snonz_tm,sunk_tm = `Zero`,`Pos`,`Neg`,`Nonzero`,`Unknown`;; + +(* ------------------------------------------------------------------------- *) +(* Intepretation of signs. *) +(* ------------------------------------------------------------------------- *) + +(* An interpretation of the sign of a polynomial over a set. *) +let interpsign = new_recursive_definition sign_RECURSION + `(interpsign set ply Zero = (!x:real. set x ==> (ply x = &0))) /\ + (interpsign set ply Pos = (!x. set x ==> (ply x > &0))) /\ + (interpsign set ply Neg = (!x. set x ==> (ply x < &0))) /\ + (interpsign set ply Nonzero = (!x. set x ==> (ply x <> &0))) /\ + (interpsign set ply Unknown = (!x. set x ==> (ply x = ply x)))`;; + + +let interpsign_tm = `interpsign`;; +let dest_interpsign interpthm = + let int,[set;poly;sign] = strip_ncomb 3 (concl interpthm) in + if not (int = interpsign_tm) then + failwith "not an interpsign" + else + set,poly,sign;; + +(* +let k0 = prove_by_refinement( + `interpsign (\x. x = &10) (\x. -- &10 + x * &1) Zero`,[ + REWRITE_TAC[interpsign;poly]; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC +]);; + +*) + +(* A version for one set but multiple polynomials *) +let interpsigns = new_definition + `interpsigns polyl set signl = ALL2 (interpsign set) polyl signl`;; + +let t0 = TAUT `a /\ T <=> a`;; +let interpsigns_thms interpthm = + let ret = map BETA_RULE( + CONJUNCTS (PURE_REWRITE_RULE[interpsign;interpsigns;ALL2;t0] interpthm)) in + ret;; + +(* keep interpsign *) +let interpsigns_thms2 interpthm = + CONJUNCTS (PURE_REWRITE_RULE[interpsigns;ALL2;t0] interpthm);; + +let interpsigns_tm = `interpsigns`;; +let dest_interpsigns interpthm = + let int,[polys;set;signs] = strip_ncomb 3 (concl interpthm) in + if not (int = interpsigns_tm) then + failwith "not an interpsigns" + else + polys,set,signs;; + + +let interp_sing = prove( + `interpsign set p s = interpsigns [p] set [s]`, + REWRITE_TAC[interpsigns;ALL2]);; + +let interp_doub = prove( + `interpsigns [p1] set [s1] ==> interpsigns pl set sl ==> + interpsigns (CONS p1 pl) set (CONS s1 sl)`, + ASM_MESON_TAC[interpsigns;ALL2]);; + +let mk_interpsigns thms = + let thms' = map (PURE_REWRITE_RULE[interp_sing]) thms in + end_itlist (fun t1 t2 -> MATCH_MPL [interp_doub;t1;t2]) thms';; + + +(* + +let t0 = ASSUME `interpsign s1 p1 Zero`;; +let t1 = ASSUME `interpsign s1 p2 Pos`;; +let t2 = ASSUME `interpsign s1 p3 Neg`;; + +mk_interpsigns [t0;t1;t2];; +map (PURE_REWRITE_RULE[interp_sing]) [t0;t1;t2];; +*) + + +(* +let k0 = prove_by_refinement( + `interpsigns [(\x. &1 + x * &1); (\x. &2 + x * &3)] (\x. x = (-- &1)) [Zero; Neg]`, +[ + REWRITE_TAC[interpsigns;ALL2;interpsign;poly]; + REAL_ARITH_TAC +]);; +*) + +(* ---------------------------------------------------------------------- *) +(* Partition line *) +(* ---------------------------------------------------------------------- *) + + +let partition_line = new_recursive_definition list_RECURSION + `(partition_line [] = [(\x. T)]) /\ + (partition_line (CONS h t) = + if t = [] then [(\x. x < h); (\x. x = h); (\x. h < x)] else + APPEND [(\x. x < h); (\x. x = h); (\x. h < x /\ x < HD t)] + (TL (partition_line t)))`;; + +(* +let ex0 = prove( + `partition_line [&1] = [(\x. x < &1); (\x. x = &1); (\x. &1 < x)]`, + REWRITE_TAC[partition_line]) + +let ex1 = prove( + `partition_line [&1; &2] = + [(\x. x < &1); (\x. x = &1); (\x. &1 < x /\ x < &2); (\x. x = &2); (\x. &2 < x)]`, + REWRITE_TAC[partition_line;APPEND;COND_CLAUSES;NOT_CONS_NIL;TL;HD]);; +*) + + +let make_partition_list = + let lxt = `\x:real. T` + and htm = `h:real` + and h1tm = `h1:real` + and h2tm = `h2:real` + and x_lt_h = `(\x. x < h)` + and x_eq_h = `(\x:real. x = h)` + and h_lt_x = `(\x. h < x)` + and x_lt_h1 = `(\x. x < h1)` + and x_eq_h1 = `(\x:real. x = h1)` + and x_h1_h2 = `(\x. h1 < x /\ x < h2)` in + let rec make_partition_list ps = + match ps with + [] -> [lxt] + | [h] -> map (subst [h,htm]) [x_lt_h; x_eq_h;h_lt_x] + | h1::h2::t -> (map (subst [(h1,h1tm);(h2,h2tm)]) + [x_lt_h1; x_eq_h1;x_h1_h2]) @ tl (make_partition_list (h2::t)) in + make_partition_list;; + + +(* +make_partition_list [`&1`;`&2`] +*) + +(* partition a line based on a list of points + this is just a compact representation of a list of terms +*) +let part_line_tm = `partition_line`;; +let real_bool_ty = `:real->bool`;; +let PARTITION_LINE_CONV pts = + let ptm = mk_comb (part_line_tm,pts) in + let ltm = mk_list ((make_partition_list (dest_list pts)),real_bool_ty) in + let tm = mk_eq (ptm,ltm) in + prove(tm,REWRITE_TAC [partition_line;APPEND;COND_CLAUSES;NOT_CONS_NIL;TL;HD]);; + +(* +PARTITION_LINE_CONV `[]:real list` +PARTITION_LINE_CONV `[&1; &2]` +PARTITION_LINE_CONV `[&2; &1]` +PARTITION_LINE_CONV `[a:real; b]` +*) + + +(* an interpretation of a sign matrix + arguments are a list of points, a list of polynomials, and a sign matrix + the points form an ordered list (smallest first), + each zero of each polynomial must appear among the list of points + and finally, the sign matrix corresponds to the correct sign for the polynomial + in the region represented by the set. +*) +let interpmat = new_definition + `interpmat ptl polyl signll <=> + real_ordered_list ptl /\ + ALL2 (interpsigns polyl) (partition_line ptl) signll`;; + +let interpmat_tm = `interpmat`;; +let dest_interpmat = + let imat_tm = interpmat_tm in + fun tm -> + let sc,args = strip_comb tm in + if not (sc = imat_tm) then failwith "dest_interpmat: not an interpmat term" else + let [ptl;polyl;signll] = args in + ptl,polyl,signll;; + +let interpmat_thms thm = + let [rol_thm;interpsigns_thm] = CONJUNCTS (PURE_REWRITE_RULE[interpmat] thm) in + rol_thm,interpsigns_thm;; + +let mk_interpmat_thm rol_thm = + fun all_thm -> + let ret = REWRITE_RULE[GSYM interpmat] (CONJ rol_thm all_thm) in + let l,_ = strip_comb (concl ret) in + if not (l = interpmat_tm) then failwith "mk_interpmat" else ret;; + +(* +let rol_thm = rol_thm''' +let all_thm = all_thm'' +*) + +(* {{{ Doc *) + +(* +mk_all2_interpsigns + +|- partition_line [x1; x2; x3; x4; x5] = + [(\x. x < x1); (\x. x = x1); (\x. x1 < x /\ x < x2); (\x. x = x2); + (\x. x2 < x /\ x < x3); (\x. x = x3); (\x. x3 < x /\ x < x4); (\x. x = x4); + (\x. x4 < x /\ x < x5); (\x. x = x5); (\x. x5 < x)] + +[ + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x < x1) + [Unknown; Pos; Pos; Pos] + . + . + . + . + + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x = x5) + [Pos; Pos; Zero; Zero] + + |- interpsigns + [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]] + (\x. x5 < x) + [Unknown; Pos; Pos; Pos] +] + +--> + + |- ALL2 (interpsigns [[&1; &1; &1; &1]; [&1; &2; &3]; [&2; -- &3; &1]; [-- &4; &0; &1]]) + (partition_line [x1;x2;x3;x4;x5]) + [[Unknown; Pos; Pos; Pos];...; [Pos; Pos; Zero; Zero]; [Unknown; Pos; Pos; Pos]] + +*) + +(* }}} *) + +let all2_thm0 = GEN_ALL(EQT_ELIM(hd (CONJUNCTS ALL2)));; +let all2_thm = GEN_ALL (REWRITE_RULE[AND_IMP_THM] (fst (EQ_IMP_RULE (GSYM (last (CONJUNCTS ALL2))))));; + +let mk_all2_interpsigns part_thm is_thms = + let is_tm = fst(dest_comb(fst (dest_comb (concl (hd is_thms))))) in + let all2_thm0' = ISPEC is_tm all2_thm0 in (* it`s having trouble matching *) + let ret = itlist (fun x -> fun y -> MATCH_MPL[all2_thm;x;y]) is_thms all2_thm0' in + REWRITE_RULE[GSYM part_thm] ret;; + +let dest_all2 tm = + let a2,l = strip_comb tm in + if fst(dest_const a2) = "ALL2" then + let [a1;a2;a3] = l in + a1,a2,a3 + else + failwith "dest_all2: not an ALL2";; + +(* ---------------------------------------------------------------------- *) +(* Sets *) +(* ---------------------------------------------------------------------- *) + +let is_interval set = + try + let x,bod = dest_abs set in + if is_conj bod then + let l,r = dest_conj bod in + can (dest_binop rlt) l & can (dest_binop rlt) r + else can (dest_binop rlt) bod + with _ -> false;; + +(* +is_interval `\x. &4 < x /\ x < &5`;; +is_interval `\x. x = &4`;; +*) + +let is_point set = + try + let x,bod = dest_abs set in + if is_eq bod then true else false + with _ -> false;; + +(* +is_point `\x. x = &5` +is_point `\x. x = y:real` +*) + +(* ---------------------------------------------------------------------- *) +(* We generate new var names *) +(* ---------------------------------------------------------------------- *) + +let new_var,reset_vars = + let id = ref 0 in + let pre = "x_" in + let new_var ty = + id := !id + 1; + mk_var (pre ^ (string_of_int !id),ty) in + let reset_vars () = + id := 0 in + new_var,reset_vars;; diff --git a/Rqe/examples.ml b/Rqe/examples.ml new file mode 100644 index 0000000..d03de1c --- /dev/null +++ b/Rqe/examples.ml @@ -0,0 +1,1429 @@ +(* ---------------------------------------------------------------------- *) +(* Paper *) +(* ---------------------------------------------------------------------- *) + +(* ---------------------------- Chebychev ----------------------------- *) + +time REAL_QELIM_CONV + `!x. --(&1) <= x /\ x <= &1 ==> + -- (&1) <= &2 * x pow 2 - &1 /\ &2 * x pow 2 - &1 <= &1`;; + +(* +DATE ------- HOL -------- +5/20 4.92 +5/22 4.67 +*) + +time REAL_QELIM_CONV + `!x. --(&1) <= x /\ x <= &1 ==> + -- (&1) <= &4 * x pow 3 - &3 * x /\ &4 * x pow 3 - &3 * x <= &1`;; + +(* +DATE ------- HOL -------- +5/20 14.38 +5/22 13.65 +*) + +time REAL_QELIM_CONV + `&1 < &2 /\ (!x. &1 < x ==> &1 < x pow 2) /\ + (!x y. &1 < x /\ &1 < y ==> &1 < x * (&1 + &2 * y))`;; + + +(* +DATE ------- HOL -------- +5/22 23.61 +*) + +time REAL_QELIM_CONV + `&0 <= b /\ &0 <= c /\ &0 < a * c ==> ?u. &0 < u /\ u * (u * c - a * c) - + (u * a * c - (a pow 2 * c + b)) < a pow 2 * c + b`;; + +(* +DATE ------- HOL -------- +5/22 8.78 +*) + + +(* ------------------------------------------------------------------------- *) +(* Examples. *) +(* ------------------------------------------------------------------------- *) + + + + +(* --------------------------------- --------------------------------- *) +(* +time real_qelim <>;; +0.01 + +let fm = `?x. x pow 4 + x pow 2 + &1 = &0`;; +let vars = [] +*) + + +time REAL_QELIM_CONV `?x. x pow 4 + x pow 2 + &1 = &0`;; + + + +(* +DATE ------- HOL -------- +4/29/2005 3.19 +5/19 2.2 +5/20 1.96 +5/22 1.53 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +0.01 +*) + +time REAL_QELIM_CONV `?x. x pow 3 - x pow 2 + x - &1 = &0`;; + +(* +DATE ------- HOL -------- +4/29/2005 3.83 +5/22/2005 1.69 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +0.23 +*) + +time REAL_QELIM_CONV + `?x y. (x pow 3 - x pow 2 + x - &1 = &0) /\ + (y pow 3 - y pow 2 + y - &1 = &0) /\ ~(x = y)`;; + +(* +DATE ------- HOL -------- Factor +4/29/2005 682.85 3000 +5/17/2005 345.27 +5/22 269 +*) + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim + < f < a * e) ==> f <= a * k>>;; +0.02 +*) + +time REAL_QELIM_CONV + `!a f k. (!e. k < e ==> f < a * e) ==> f <= a * k`;; + +(* +DATE ------- HOL -------- Factor +4/29/2005 20.91 1000 +5/15/2005 17.98 +5/17/2005 15.12 +5/18/2005 12.87 +5/22 12.09 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +0.01 +*) + +time REAL_QELIM_CONV + `?x. a * x pow 2 + b * x + c = &0`;; + +(* +DATE ------- HOL -------- Factor +4/29/2005 10.99 1000 +5/17/2005 6.42 +5/18 5.39 +5/22 4.74 +*) + +(* --------------------------------- --------------------------------- *) +(* +time real_qelim + < + b^2 >= 4 * a * c>>;; +0.51 +*) + +time REAL_QELIM_CONV + `!a b c. (?x. a * x pow 2 + b * x + c = &0) <=> + b pow 2 >= &4 * a * c`;; + + +(* +DATE ------- HOL -------- Factor +4/29/2005 1200.99 2400 +5/17 878.25 +*) + + +(* --------------------------------- --------------------------------- *) +(* +time real_qelim + < + a = 0 /\ (~(b = 0) \/ c = 0) \/ + ~(a = 0) /\ b^2 >= 4 * a * c>>;; + +0.51 +*) +time REAL_QELIM_CONV + `!a b c. (?x. a * x pow 2 + b * x + c = &0) <=> + (a = &0) /\ (~(b = &0) \/ (c = &0)) \/ + ~(a = &0) /\ b pow 2 >= &4 * a * c`;; + +(* +DATE ------- HOL -------- Factor +4/29/2005 1173.9 2400 +5/17 848.4 +5/20 816 + +1095 during depot update +*) + + +(* +time real_qelim <> +*) +time REAL_QELIM_CONV + `?x. &0 <= x /\ x <= &1 /\ (r pow 2 * x pow 2 - r * (&1 + r) * x + (&1 + r) = &0) + /\ ~(&2 * r * x = &1 + r)`;; + +(* +DATE ------- HOL -------- Factor +5/20/2005 19021 1460 + +4000 line output +*) + + + + +(* ------------------------------------------------------------------------- *) +(* Termination ordering for group theory completion. *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* Left this out *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* This one works better using DNF. *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* And this *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* Linear examples. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +0 +*) + +time REAL_QELIM_CONV `?x. x - &1 > &0`;; +(* +DATE ------- HOL +4/29/2005 .56 +*) + +(* --------------------------------- --------------------------------- *) +(* +time real_qelim < 0 /\ x - 1 > 0>>;; +0 +*) + +time REAL_QELIM_CONV `?x. &3 - x > &0 /\ x - &1 > &0`;; + +(* +DATE ------- HOL +4/29/2005 1.66 +*) + +(* ------------------------------------------------------------------------- *) +(* Quadratics. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) +(* +time real_qelim <>;; +0 +*) + +time REAL_QELIM_CONV `?x. x pow 2 = &0`;; +(* +DATE ------- HOL +4/29/2005 1.12 +*) + +(* --------------------------------- --------------------------------- *) +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 + &1 = &0`;; +(* +DATE ------- HOL +4/29/2005 1.11 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 - &1 = &0`;; + +(* +DATE ------- HOL +4/29/2005 1.54 +*) +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 - &2 * x + &1 = &0`;; +(* +DATE ------- HOL +4/29/2005 1.21 +*) +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 - &3 * x + &1 = &0`;; + +(* +DATE ------- HOL +4/29/2005 1.75 +*) + + +(* ------------------------------------------------------------------------- *) +(* Cubics. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +*) +time REAL_QELIM_CONV `?x. x pow 3 - &1 > &0`;; + +(* +DATE ------- HOL +4/29/2005 1.96 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +*) +time REAL_QELIM_CONV `?x. x pow 3 - &3 * x pow 2 + &3 * x - &1 > &0`;; +(* +DATE ------- HOL +4/29/2005 1.97 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +*) +time REAL_QELIM_CONV `?x. x pow 3 - &4 * x pow 2 + &5 * x - &2 > &0`;; +(* +DATE ------- HOL +4/29/2005 4.89 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 3 - &6 * x pow 2 + &11 * x - &6 = &0`;; +(* +DATE ------- HOL +4/29/2005 4.17 +*) + + +(* ------------------------------------------------------------------------- *) +(* Quartics. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +*) + +time REAL_QELIM_CONV `?x. x pow 4 - &1 > &0`;; +(* +DATE ------- HOL +4/29/2005 3.07 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +*) +time REAL_QELIM_CONV `?x. x pow 4 + &1 > &0`;; +(* +DATE ------- HOL +4/29/2005 2.47 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 4 = &0`;; +(* +DATE ------- HOL +4/29/2005 2.48 +*) + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 4 - x pow 3 = &0`;; +(* +DATE ------- HOL +4/29/2005 1.76 +*) + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 4 - x pow 2 = &0`;; +(* +DATE ------- HOL +4/29/2005 2.16 +*) + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 4 - &2 * x pow 2 + &2 = &0`;; +(* +DATE ------- HOL +4/29/2005 6.87 +5/16/2005 5.22 +*) + +(* ------------------------------------------------------------------------- *) +(* Quintics. *) +(* ------------------------------------------------------------------------- *) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +0.03 + +print_timers() +*) + +time REAL_QELIM_CONV + `?x. x pow 5 - &15 * x pow 4 + &85 * x pow 3 - &225 * x pow 2 + &274 * x - &120 = &0`;; + +(* +DATE ------- HOL -------- Factor +4/29/2005 65.64 2500 +5/15/2005 55.93 +5/16/2005 47.72 +*) + + +(* ------------------------------------------------------------------------- *) +(* Sextics(?) *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim <>;; +0.15 +*) + +time REAL_QELIM_CONV `?x. + x pow 6 - &21 * x pow 5 + &175 * x pow 4 - &735 * x pow 3 + &1624 * x pow 2 - &1764 * x + &720 = &0`;; + `?x. x pow 5 - &15 * x pow 4 + &85 * x pow 3 - &225 * x pow 2 + &274 * x - &120 = &0`;; + +(* +DATE ------- HOL -------- Factor +4/29/2005 1400.4 10000 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +7.54 +*) + +(* NOT YET *) +(* +time REAL_QELIM_CONV `?x. + x pow 6 - &12 * x pow 5 + &56 * x pow 4 - &130 * x pow 3 + &159 * x pow 2 - &98 * x + &24 = &0`;; +*) + +(* ------------------------------------------------------------------------- *) +(* Multiple polynomials. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0 /\ x^3 - 11 = 0 /\ x + 131 >= 0>>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 + &2 > &0 /\ (x pow 3 - &11 = &0) /\ x + &131 >= &0`;; +(* +DATE ------- HOL +4/29/2005 13.1 +*) + +(* ------------------------------------------------------------------------- *) +(* With more variables. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. a * x pow 2 + b * x + c = &0`;; +(* +DATE ------- HOL +4/29/2005 10.94 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. a * x pow 3 + b * x pow 2 + c * x + d = &0`;; +(* +DATE ------- HOL +4/29/2005 269.17 +*) + + + +(* ------------------------------------------------------------------------- *) +(* Constraint solving. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0>>;; +*) +time REAL_QELIM_CONV `?x1 x2. x1 pow 2 + x2 pow 2 - u1 <= &0 /\ x1 pow 2 - u2 > &0`;; +(* +DATE ------- HOL +4/29/2005 89.97 +*) + +(* ------------------------------------------------------------------------- *) +(* Huet & Oppen (interpretation of group theory). *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0 /\ y > 0 ==> x * (1 + 2 * y) > 0>>;; +*) +time REAL_QELIM_CONV `!x y. x > &0 /\ y > &0 ==> x * (&1 + &2 * y) > &0`;; +(* +DATE ------- HOL +4/29/2005 5.03 +*) + + +(* ------------------------------------------------------------------------- *) +(* Other examples. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 - x + &1 = &0`;; +(* +DATE ------- HOL +4/29/2005 1.19 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 2 - &3 * x + &1 = &0`;; +(* +DATE ------- HOL +4/29/2005 1.65 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 6 /\ (x^2 - 3 * x + 1 = 0)>>;; +*) +time REAL_QELIM_CONV `?x. x > &6 /\ (x pow 2 - &3 * x + &1 = &0)`;; +(* +DATE ------- HOL +4/29/2005 3.63 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0 /\ + x^2 - 3 * x + 1 = 0>>;; +*) +time REAL_QELIM_CONV `?x. &7 * x pow 2 - &5 * x + &3 > &0 /\ + (x pow 2 - &3 * x + &1 = &0)`;; + +(* +DATE ------- HOL +4/29/2005 8.62 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0 /\ + x^2 - 8 * x + 1 = 0>>;; +*) +time REAL_QELIM_CONV `?x. (&11 * x pow 3 - &7 * x pow 2 - &2 * x + &1 = &0) /\ + &7 * x pow 2 - &5 * x + &3 > &0 /\ + (x pow 2 - &8 * x + &1 = &0)`;; +(* +DATE ------- HOL +4/29/2005 221.4 +*) + + +(* ------------------------------------------------------------------------- *) +(* Quadratic inequality from Liska and Steinberg *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < + C * (x - 1) * (4 * x * a * C - x * C - 4 * a * C + C - 2) >= 0>>;; +*) +time REAL_QELIM_CONV + `!x. -- &1 <= x /\ x <= &1 ==> + C * (x - &1) * (&4 * x * a * C - x * C - &4 * a * C + C - &2) >= &0`;; +(* +DATE ------- HOL +4/29/2005 1493 +*) + + +(* ------------------------------------------------------------------------- *) +(* Metal-milling example from Loos and Weispfenning *) +(* ------------------------------------------------------------------------- *) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `?x y. &0 < x /\ + y < &0 /\ + (x * r - x * t + t = q * x - s * x + s) /\ + (x * b - x * d + d = a * y - c * y + c)`;; + + +(* ------------------------------------------------------------------------- *) +(* Linear example from Collins and Johnson *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `?r. &0 < r /\ + r < &1 /\ + &0 < (&1 - &3 * r) * (a pow 2 + b pow 2) + &2 * a * r /\ + (&2 - &3 * r) * (a pow 2 + b pow 2) + &4 * a * r - &2 * a - r < &0`;; + + +(* ------------------------------------------------------------------------- *) +(* Dave Griffioen #4 *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < 0 <= y>>;; +*) +time REAL_QELIM_CONV + `!x y. (&1 - t) * x <= (&1 + t) * y /\ (&1 - t) * y <= (&1 + t) * x + ==> &0 <= y`;; + +(* +DATE ------- HOL +4/29/2005 893 +*) + + +(* ------------------------------------------------------------------------- *) +(* Some examples from "Real Quantifier Elimination in practice". *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < u2>>;; +*) +time REAL_QELIM_CONV `?x2. x1 pow 2 + x2 pow 2 <= u1 /\ x1 pow 2 > u2`;; +(* +DATE ------- HOL +4/29/2005 4 +*) + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim < u2>>;; +*) +time REAL_QELIM_CONV `?x1 x2. x1 pow 2 + x2 pow 2 <= u1 /\ x1 pow 2 > u2`;; +(* +DATE ------- HOL +4/29/2005 90 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <= 0 /\ x2 >= 0 + ==> 3 * (x1 + 3 * x2^2 + 2) <= 8 * (2 * x1 + x2 + 1)>>;; +*) +time REAL_QELIM_CONV + `!x1 x2. x1 + x2 <= &2 /\ x1 <= &1 /\ x1 >= &0 /\ x2 >= &0 + ==> &3 * (x1 + &3 * x2 pow 2 + &2) <= &8 * (&2 * x1 + x2 + &1)`;; +(* +DATE ------- HOL +4/29/2005 18430 +*) + + + +(* ------------------------------------------------------------------------- *) +(* From Collins & Johnson's "Sign variation..." article. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0 /\ + (2 - 3 * r) * (a^2 + b^2) + 4 * a * r - 2 * a - r < 0>>;; +*) +time REAL_QELIM_CONV `?r. &0 < r /\ r < &1 /\ + (&1 - &3 * r) * (a pow 2 + b pow 2) + &2 * a * r > &0 /\ + (&2 - &3 * r) * (a pow 2 + b pow 2) + &4 * a * r - &2 * a - r < &0`;; +(* +DATE ------- HOL +4/29/2005 4595.11 +*) + + +(* ------------------------------------------------------------------------- *) +(* From "Parallel implementation of CAD" article. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 1 /\ x * y >= 1>>;; +*) +time REAL_QELIM_CONV `?x. !y. x pow 2 + y pow 2 > &1 /\ x * y >= &1`;; +(* +DATE ------- HOL +4/29/2005 89.51 +*) + + + +(* ------------------------------------------------------------------------- *) +(* Other misc examples. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 2 * x * y <= 1>>;; +*) +time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &1) ==> &2 * x * y <= &1`;; +(* +DATE ------- HOL +4/29/2005 83.02 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 2 * x * y < 1>>;; +*) +time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &1) ==> &2 * x * y < &1`;; +(* +DATE ------- HOL +4/29/2005 83.7 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < 0 <=> x > 0 /\ y > 0 \/ x < 0 /\ y < 0>>;; +*) +time REAL_QELIM_CONV `!x y. x * y > &0 <=> x > &0 /\ y > &0 \/ x < &0 /\ y < &0`;; +(* +DATE ------- HOL +4/29/2005 27.4 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < y /\ x^2 < y^2>>;; +*) +time REAL_QELIM_CONV `?x y. x > y /\ x pow 2 < y pow 2`;; +(* +DATE ------- HOL +4/29/2005 1.19 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < exists z. x < z /\ z < y>>;; +*) +time REAL_QELIM_CONV `!x y. x < y ==> ?z. x < z /\ z < y`;; +(* +DATE ------- HOL +4/29/2005 3.8 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < exists y. x * y^2 = 1>>;; +*) +time REAL_QELIM_CONV `!x. &0 < x <=> ?y. x * y pow 2 = &1`;; +(* +DATE ------- HOL +4/29/2005 3.76 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < exists y. x * y^2 = 1>>;; +*) +time REAL_QELIM_CONV `!x. &0 <= x <=> ?y. x * y pow 2 = &1`;; +(* +DATE ------- HOL +4/29/2005 4.38 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < exists y. x = y^2>>;; +*) +time REAL_QELIM_CONV `!x. &0 <= x <=> ?y. x = y pow 2`;; +(* +DATE ------- HOL +4/29/2005 4.38 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < exists z. x < z^2 /\ z^2 < y>>;; +*) +time REAL_QELIM_CONV `!x y. &0 < x /\ x < y ==> ?z. x < z pow 2 /\ z pow 2 < y`;; +(* +DATE ------- HOL +4/29/2005 93.1 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < exists z. x < z^2 /\ z^2 < y>>;; +*) +time REAL_QELIM_CONV `!x y. x < y ==> ?z. x < z pow 2 /\ z pow 2 < y`;; +(* +DATE ------- HOL +4/29/2005 93.22 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < x = 0 /\ y = 0>>;; +*) +time REAL_QELIM_CONV `!x y. (x pow 2 + y pow 2 = &0) ==> (x = &0) /\ (y = &0)`;; +(* +DATE ------- HOL +4/29/2005 17.21 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < x = 0 /\ y = 0 /\ z = 0>>;; +*) +time REAL_QELIM_CONV `!x y z. (x pow 2 + y pow 2 + z pow 2 = &0) ==> (x = &0) /\ (y = &0) /\ (z = &0)`;; + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < w = 0 /\ x = 0 /\ y = 0 /\ z = 0>>;; +*) +time REAL_QELIM_CONV `!w x y z. (w pow 2 + x pow 2 + y pow 2 + z pow 2 = &0) + ==> (w = &0) /\ (x = &0) /\ (y = &0) /\ (z = &0)`;; +(* +DATE ------- HOL +4/29/2005 596 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < forall x. ~(x^2 + a*x + 1 = 0)>>;; +*) +time REAL_QELIM_CONV `!a. (a pow 2 = &2) ==> !x. ~(x pow 2 + a*x + &1 = &0)`;; + +(* +DATE ------- HOL +4/29/2005 8.7 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < forall x. ~(x^2 - a*x + 1 = 0)>>;; +*) +time REAL_QELIM_CONV `!a. (a pow 2 = &2) ==> !x. ~(x pow 2 - a*x + &1 = &0)`;; +(* +DATE ------- HOL +4/29/2005 8.82 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim < (x * y)^2 = 6>>;; +*) +time REAL_QELIM_CONV `!x y. (x pow 2 = &2) /\ (y pow 2 = &3) ==> ((x * y) pow 2 = &6)`;; +(* +DATE ------- HOL +4/29/2005 48.59 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `!x. ?y. x pow 2 = y pow 3`;; +(* +DATE ------- HOL +4/29/2005 6.93 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `!x. ?y. x pow 3 = y pow 2`;; +(* +DATE ------- HOL +4/29/2005 5.76 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < (a * (x + y) + b = 0)>>;; +*) +time REAL_QELIM_CONV + `!a b c. + (a * x pow 2 + b * x + c = &0) /\ + (a * y pow 2 + b * y + c = &0) /\ + ~(x = y) + ==> (a * (x + y) + b = &0)`;; +(* +DATE ------- HOL +4/29/2005 76.5 +*) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < (y_1^2 = y_2^2)>>;; +*) +time REAL_QELIM_CONV + `!y_1 y_2 y_3 y_4. + (y_1 = &2 * y_3) /\ + (y_2 = &2 * y_4) /\ + (y_1 * y_3 = y_2 * y_4) + ==> (y_1 pow 2 = y_2 pow 2)`;; +(* +time real_qelim < x^4 < 1>>;; +*) +(* +DATE ------- HOL +4/29/2005 1327 +*) + + + +(* ------------------------------------------------------------------------- *) +(* Counting roots. *) +(* ------------------------------------------------------------------------- *) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 3 - x pow 2 + x - &1 = &0`;; +(* +DATE ------- HOL +4/29/2005 3.8 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `?x y. (x pow 3 - x pow 2 + x - &1 = &0) /\ (y pow 3 - y pow 2 + y - &1 = &0) /\ ~(x = y)`;; +(* +DATE ------- HOL +4/29/2005 670 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x. x pow 4 + x pow 2 - &2 = &0`;; +(* +DATE ------- HOL +4/29/2005 4.9 +*) + + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `?x y. x pow 4 + x pow 2 - &2 = &0 /\ y pow 4 + y pow 2 - &2 = &0 /\ ~(x = y)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `?x y. (x pow 3 + x pow 2 - x - &1 = &0) /\ (y pow 3 + y pow 2 - y - &1 = &0) /\ ~(x = y)`;; + +(* --------------------------------- --------------------------------- *) + + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `?x y z. (x pow 3 + x pow 2 - x - &1 = &0) /\ + (y pow 3 + y pow 2 - y - &1 = &0) /\ + (z pow 3 + z pow 2 - z - &1 = &0) /\ ~(x = y) /\ ~(x = z)`;; + +(* ------------------------------------------------------------------------- *) +(* Existence of tangents, so to speak. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `!x y. ?s c. (s pow 2 + c pow 2 = &1) /\ s * x + c * y = &0`;; + +(* ------------------------------------------------------------------------- *) +(* Another useful thing (componentwise ==> normwise accuracy etc.) *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `!x y. (x + y) pow 2 <= &2 * (x pow 2 + y pow 2)`;; + +(* ------------------------------------------------------------------------- *) +(* Some related quantifier elimination problems. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `!x y. (x + y) pow 2 <= c * (x pow 2 + y pow 2)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < 2 <= c>>;; +*) +time REAL_QELIM_CONV + `!c. (!x y. (x + y) pow 2 <= c * (x pow 2 + y pow 2)) <=> &2 <= c`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim <>;; +*) +time REAL_QELIM_CONV `!a b. a * b * c <= a pow 2 + b pow 2`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < c^2 <= 4>>;; +*) +time REAL_QELIM_CONV + `!c. (!a b. a * b * c <= a pow 2 + b pow 2) <=> c pow 2 <= &4`;; + +(* ------------------------------------------------------------------------- *) +(* Tedious lemmas I once proved manually in HOL. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < 0 < a * b /\ 0 < a * c /\ 0 < b * c>>;; +*) +time REAL_QELIM_CONV + `!a b c. &0 < a /\ &0 < b /\ &0 < c + ==> &0 < a * b /\ &0 < a * c /\ &0 < b * c`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < 0 ==> (c * a < 0 <=> c * b < 0)>>;; +*) +time REAL_QELIM_CONV + `!a b c. a * b > &0 ==> (c * a < &0 <=> c * b < &0)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < 0 ==> (a * c < 0 <=> b * c < 0)>>;; +*) +time REAL_QELIM_CONV + `!a b c. a * b > &0 ==> (a * c < &0 <=> b * c < &0)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < (a * b > 0 <=> b < 0)>>;; +*) +time REAL_QELIM_CONV + `!a b. a < &0 ==> (a * b > &0 <=> b < &0)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < (c * a < 0 <=> ~(c * b < 0))>>;; +*) +time REAL_QELIM_CONV + `!a b c. a * b < &0 /\ ~(c = &0) ==> (c * a < &0 <=> ~(c * b < &0))`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < a > 0 /\ b < 0 \/ a < 0 /\ b > 0>>;; +*) +time REAL_QELIM_CONV + `!a b. a * b < &0 <=> a > &0 /\ b < &0 \/ a < &0 /\ b > &0`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < a >= 0 /\ b <= 0 \/ a <= 0 /\ b >= 0>>;; +*) +time REAL_QELIM_CONV + `!a b. a * b <= &0 <=> a >= &0 /\ b <= &0 \/ a <= &0 /\ b >= &0`;; + +(* ------------------------------------------------------------------------- *) +(* Vaguely connected with reductions for Robinson arithmetic. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < forall d. d <= b ==> d < a>>;; +*) +time REAL_QELIM_CONV + `!a b. ~(a <= b) <=> !d. d <= b ==> d < a`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < forall d. d <= b ==> ~(d = a)>>;; +*) +time REAL_QELIM_CONV + `!a b. ~(a <= b) <=> !d. d <= b ==> ~(d = a)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < forall d. d < b ==> d < a>>;; +*) +time REAL_QELIM_CONV + `!a b. ~(a < b) <=> !d. d < b ==> d < a`;; + +(* ------------------------------------------------------------------------- *) +(* Another nice problem. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < (x + y)^2 <= 2>>;; +*) +time REAL_QELIM_CONV + `!x y. (x pow 2 + y pow 2 = &1) ==> (x + y) pow 2 <= &2`;; + +(* ------------------------------------------------------------------------- *) +(* Some variants / intermediate steps in Cauchy-Schwartz inequality. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `!x y. &2 * x * y <= x pow 2 + y pow 2`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `!a b c d. &2 * a * b * c * d <= a pow 2 * b pow 2 + c pow 2 * d pow 2`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `!x1 x2 y1 y2. + (x1 * y1 + x2 * y2) pow 2 <= (x1 pow 2 + x2 pow 2) * (y1 pow 2 + y2 pow 2)`;; + +(* ------------------------------------------------------------------------- *) +(* The determinant example works OK here too. *) +(* ------------------------------------------------------------------------- *) + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + <>;; +*) +time REAL_QELIM_CONV + `?w x y z. (a * w + b * y = &1) /\ + (a * x + b * z = &0) /\ + (c * w + d * y = &0) /\ + (c * x + d * z = &1)`;; + +(* --------------------------------- --------------------------------- *) + +(* +time real_qelim + < ~(a * d = b * c)>>;; +*) +time REAL_QELIM_CONV + `!a b c d. + (?w x y z. (a * w + b * y = &1) /\ + (a * x + b * z = &0) /\ + (c * w + d * y = &0) /\ + (c * x + d * z = &1)) + <=> ~(a * d = b * c)`;; + +(* ------------------------------------------------------------------------- *) +(* From applying SOLOVAY_VECTOR_TAC. *) +(* ------------------------------------------------------------------------- *) + +let th = prove + (`&0 <= c' /\ &0 <= c /\ &0 < h * c' + ==> (?u. &0 < u /\ + (!v. &0 < v /\ v <= u + ==> v * (v * (h * h * c' + c) - h * c') - (v * h * c' - c') < + c'))`, + W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC REAL_QELIM_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Two notions of parallelism. *) +(* ------------------------------------------------------------------------- *) + +time REAL_QELIM_CONV + `!x1 x2 y1 y2. (?c. (x2 = c * x1) /\ (y2 = c * y1)) <=> + (x1 = &0 /\ y1 = &0 ==> x2 = &0 /\ y2 = &0) /\ + x1 * y2 = x2 * y1`;; + +(* ------------------------------------------------------------------------- *) +(* From Behzad Akbarpour (takes about 300 seconds). *) +(* ------------------------------------------------------------------------- *) + +time REAL_QELIM_CONV + `!x. &0 <= x /\ x <= &1 + ==> &0 < &1 - x + x pow 2 / &2 - x pow 3 / &6 /\ + &1 <= (&1 + x + x pow 2) * + (&1 - x + x pow 2 / &2 - x pow 3 / &6)`;; + +(* ------------------------------------------------------------------------- *) +(* A natural simplification of "limit of a product" result. *) +(* Takes about 450 seconds. *) +(* ------------------------------------------------------------------------- *) + +(*** Would actually like to get rid of abs internally and state it like this: + +time REAL_QELIM_CONV + `!x y e. &0 < e ==> ?d. &0 < d /\ abs((x + d) * (y + d) - x * y) < e`;; + +****) + +time REAL_QELIM_CONV + `!x y e. &0 < e ==> ?d. &0 < d /\ (x + d) * (y + d) - x * y < e /\ + x * y - (x + d) * (y + d) < e`;; diff --git a/Rqe/inferisign.ml b/Rqe/inferisign.ml new file mode 100644 index 0000000..9b404e0 --- /dev/null +++ b/Rqe/inferisign.ml @@ -0,0 +1,241 @@ +exception Isign of (thm * ((term * thm) list));; + +(* ---------------------------------------------------------------------- *) +(* Opt *) +(* ---------------------------------------------------------------------- *) + +let get_mp = + let unknown = `Unknown` in + let pos = `Pos` in + let zero = `Zero` in + let neg = `Neg` in + fun upper_sign lower_sign deriv_sign -> + (* Pos Pos *) + if upper_sign = pos && + lower_sign = pos && + deriv_sign = pos then INFERISIGN_POS_POS_POS + else if upper_sign = pos && + lower_sign = pos && + deriv_sign = neg then INFERISIGN_POS_POS_NEG + (* Pos Neg *) + else if upper_sign = pos && + lower_sign = neg && + deriv_sign = pos then INFERISIGN_POS_NEG_POS + else if upper_sign = pos && + lower_sign = neg && + deriv_sign = neg then INFERISIGN_POS_NEG_NEG + (* Pos Zero *) + else if upper_sign = pos && + lower_sign = zero && + deriv_sign = pos then INFERISIGN_POS_ZERO_POS + else if upper_sign = pos && + lower_sign = zero && + deriv_sign = neg then INFERISIGN_POS_ZERO_NEG + (* Neg Pos *) + else if upper_sign = neg && + lower_sign = pos && + deriv_sign = pos then INFERISIGN_NEG_POS_POS + else if upper_sign = neg && + lower_sign = pos && + deriv_sign = neg then INFERISIGN_NEG_POS_NEG + (* Neg Neg *) + else if upper_sign = neg && + lower_sign = neg && + deriv_sign = pos then INFERISIGN_NEG_NEG_POS + else if upper_sign = neg && + lower_sign = neg && + deriv_sign = neg then INFERISIGN_NEG_NEG_NEG + (* Neg Zero *) + else if upper_sign = neg && + lower_sign = zero && + deriv_sign = pos then INFERISIGN_NEG_ZERO_POS + else if upper_sign = neg && + lower_sign = zero && + deriv_sign = neg then INFERISIGN_NEG_ZERO_NEG + (* Zero Pos *) + else if upper_sign = zero && + lower_sign = pos && + deriv_sign = pos then INFERISIGN_ZERO_POS_POS + else if upper_sign = zero && + lower_sign = pos && + deriv_sign = neg then INFERISIGN_ZERO_POS_NEG + (* Zero Neg *) + else if upper_sign = zero && + lower_sign = neg && + deriv_sign = pos then INFERISIGN_ZERO_NEG_POS + else if upper_sign = zero && + lower_sign = neg && + deriv_sign = neg then INFERISIGN_ZERO_NEG_NEG + (* Zero Zero *) + else if upper_sign = zero && + lower_sign = zero && + deriv_sign = pos then INFERISIGN_ZERO_ZERO_POS + else if upper_sign = zero && + lower_sign = zero && + deriv_sign = neg then INFERISIGN_ZERO_ZERO_NEG + else failwith "bad signs in thm";; + + +let tvars,tdiff,tmat,tex = ref [],ref TRUTH,ref TRUTH,ref [];; +(* + let vars,diff_thm,mat_thm,ex_thms = !tvars,!tdiff,!tmat,!tex +INFERISIGN vars diff_thm mat_thm ex_thms + +let vars,diff_thm,mat_thm,ex_thms = vars, pdiff_thm, mat_thm''', ((v1,exthm1)::(v2,exthm2)::ex_thms) +*) + +let rec INFERISIGN = + let real_app = `APPEND:real list -> real list -> real list` in + let sign_app = `APPEND:(sign list) list -> (sign list) list -> (sign list) list` in + let real_len = `LENGTH:real list -> num` in + let sign_len = `LENGTH:(sign list) list -> num` in + let unknown = `Unknown` in + let pos = `Pos` in + let zero = `Zero` in + let neg = `Neg` in + let num_mul = `( * ):num -> num -> num` in + let num_add = `( + ):num -> num -> num` in + let real_ty = `:real` in + let one = `1` in + let two = `2` in + let f = `F` in + let imat = `interpmat` in + let sl_ty = `:sign list` in + fun vars diff_thm mat_thm ex_thms -> + try + tvars := vars; + tdiff := diff_thm; + tmat := mat_thm; + tex := ex_thms; + let pts,ps,sgns = dest_interpmat (concl mat_thm) in + let pts' = dest_list pts in + if pts' = [] then mat_thm,ex_thms else + let sgns' = dest_list sgns in + let sgnl = map dest_list sgns' in + let i = get_index (fun x -> hd x = unknown) sgnl in + if i mod 2 = 1 then failwith "bad shifted matrix" else + let p::p'::_ = dest_list ps in + let p_thm = ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p))) in + let p'_thm = ONCE_REWRITE_RULE[GSYM diff_thm] (ABS (hd vars) (POLY_ENLIST_CONV vars (snd(dest_abs p')))) in + let pts1,qts1 = chop_list (i / 2 - 1) pts' in + let ps_thm = REWRITE_CONV[p_thm;p'_thm] ps in + let pts2 = mk_list(pts1,real_ty) in + let pts3 = mk_comb(mk_comb(real_app,pts2),mk_list(qts1,real_ty)) in + let pts_thm = prove(mk_eq(pts,pts3),REWRITE_TAC[APPEND]) in + let sgns1,rgns1 = chop_list (i - 1) sgns' in + let sgns2 = mk_list(sgns1,sl_ty) in + let sgns3 = mk_comb(mk_comb(sign_app,sgns2),mk_list(rgns1,sl_ty)) in + let sgns_thm = prove(mk_eq(sgns,sgns3),REWRITE_TAC[APPEND]) in + let len1 = mk_comb(sign_len,sgns2) in + let len2 = mk_binop num_add (mk_binop num_mul two (mk_comb(real_len,pts2))) one in + let len_thm = prove(mk_eq(len1,len2),REWRITE_TAC[LENGTH] THEN ARITH_TAC) in + let mat_thm1 = MK_COMB(MK_COMB((AP_TERM imat pts_thm), ps_thm),sgns_thm) in + let mat_thm2 = EQ_MP mat_thm1 mat_thm in + let upper_sign = hd (ith (i - 1) sgnl) in + let lower_sign = hd (ith (i + 1) sgnl) in + let deriv_sign = hd (tl (ith i sgnl)) in + let mp_thm = get_mp upper_sign lower_sign deriv_sign in + let mat_thm3 = MATCH_MP (MATCH_MP mp_thm mat_thm2) len_thm in + let mat_thm4 = REWRITE_RULE[GSYM p_thm;GSYM p'_thm;APPEND] mat_thm3 in + let c = concl mat_thm4 in + if c = f then raise (Isign (mat_thm4,ex_thms)) else + if not (is_exists c) then + INFERISIGN vars diff_thm mat_thm4 ex_thms else + let x,bod = dest_exists c in + let x' = new_var real_ty in + let assume_thm = ASSUME (subst [x',x] bod) in + INFERISIGN vars diff_thm assume_thm ((x',mat_thm4)::ex_thms) + with + Failure "get_index" -> mat_thm,ex_thms + | Failure x -> failwith ("INFERISIGN: " ^ x);; + +(* +let vars,diff_thm,mat_thm,ex_thms = vars,pdiff_thm, mat_thm''',[] + +let mat_thm = ASSUME ` interpmat [x_25; x1; x2; x4; x5; x_26] + [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); + \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1)] + [[Neg; Pos; Pos; Pos]; + [Neg; Pos; Pos; Pos]; + [Unknown; Pos; Pos; Pos]; + [Pos; Pos; Pos; Zero]; + [Unknown; Neg; Pos; Neg]; + [Unknown; Neg; Neg; Neg]; + [Unknown; Neg; Pos; Neg]; + [Pos; Zero; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; + [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]]` + +*) + + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let INFERISIGN vars diff_thm mat_thm ex_thms = + let start_time = Sys.time() in + let res = INFERISIGN vars diff_thm mat_thm ex_thms in + inferisign_timer +.= (Sys.time() -. start_time); + res;; + +(* {{{ Examples *) + +(* +let is_thms = isigns_thms''' + +let vars,diff_thm,mat_thm = +[`w:real`; `z:real`; `y:real`; `x:real`], +ASSUME `poly_diff [&0 + y * (&0 + x * &1); &0 + z * -- &1] = [&0 + z * -- &1]`, +ASSUME `interpmat [x_178; x_179] + [\w. (&0 + y * (&0 + x * &1)) + w * (&0 + z * -- &1); \w. &0 + z * -- &1] + [[Pos; Neg]; [Pos; Neg]; [Unknown; Neg]; [Neg; Neg]; [Neg; Neg]]` + +INFERISIGN vars pdiff_thm mat_thm + +let diff +let vars,diff_thm,mat_thm = + + + +let vars,diff_thm,mat_thm = +[`x:real`], +ASSUME `poly_diff [&0; &2; &0; &4] = [&2; &0; &12]`, +ASSUME `interpmat [x_79; x_68; x_80] + [\x. &0 + x * (&2 + x * (&0 + x * &4)); \x. &2 + x * (&0 + x * &12); + \x. &4 + x * (&0 + x * &2)] + [[Neg; Pos; Pos]; [Neg; Pos; Pos]; [Unknown; Pos; Pos]; [Unknown; Pos; Pos]; [Unknown; Pos; Pos]; [Pos; Pos; Pos]; [Pos; Pos; Pos]]` + + + +let mat_thm = mat_thm''' +let diff_thm = pdiff_thm +INFERISIGN vars pdiff_thm mat_thm''' + +let diff_thm = POLY_DIFF_CONV `poly_diff [&1; &1; &1; &1]`;; + +let vars = [`x:real`] + +let mat_thm = ASSUME + `interpmat + [xminf; x1; x4; x5; xinf] + [\x. &1 + x * (&1 + x * (&1 + x * &1)); \x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1)] + [[Neg; Pos; Pos; Pos]; + [Neg; Pos; Pos; Pos]; + [Unknown; Pos; Pos; Pos]; + [Neg; Pos; Pos; Zero]; + [Unknown; Pos; Pos; Neg]; + [Pos; Pos; Zero; Neg]; + [Unknown; Pos; Neg; Neg]; + [Pos; Pos; Zero; Zero]; + [Unknown; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos]]`;; + +let mat_thm1,_ = INFERISIGN vars diff_thm mat_thm [] + +*) +(* }}} *) diff --git a/Rqe/inferisign_thms.ml b/Rqe/inferisign_thms.ml new file mode 100644 index 0000000..38fc30c --- /dev/null +++ b/Rqe/inferisign_thms.ml @@ -0,0 +1,1033 @@ +let inferisign_lem00 = prove_by_refinement( + `x1 < x3 ==> x3 < x2 ==> (!x. x1 < x /\ x < x2 ==> P x) ==> + (!x. x1 < x /\ x < x3 ==> P x) /\ + (!x. (x = x3) ==> P x) /\ + (!x. x3 < x /\ x < x2 ==> P x)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x3`; + ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x3`; + ASM_REWRITE_TAC[]; +]);; + +(* }}} *) + +let neg_neg_neq_thm = prove_by_refinement( + `!x y p. x < y /\ poly p x < &0 /\ poly p y < &0 /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z < &0)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `&0 < poly p z - poly p x`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-8" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (z - x) * poly (poly_diff p) x'`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p y - poly p z < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-13" MP_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(y - z) * poly (poly_diff p) x'' < &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + CLAIM `x' < x''`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `x < x''' /\ x''' < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x'`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x''`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let neg_neg_neq_thm2 = prove_by_refinement( + `!x y p. x < y ==> poly p x < &0 ==> poly p y < &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z < &0)`, +(* {{{ Proof *) +[ + REPEAT_N 7 STRIP_TAC; + MATCH_MP_TAC neg_neg_neq_thm; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let pos_pos_neq_thm = prove_by_refinement( + `!x y p. x < y /\ &0 < poly p x /\ &0 < poly p y /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> &0 < poly p z)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p z - poly p x < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-8" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) x' < &0`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `&0 < poly p y - poly p z`; + LABEL_ALL_TAC; + USE_THEN "Z-13" MP_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (y - z) * poly (poly_diff p) x''`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + CLAIM `x' < x''`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `x < x''' /\ x''' < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x'`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x''`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let pos_pos_neq_thm2 = prove_by_refinement( + `!x y p. x < y ==> poly p x > &0 ==> poly p y > &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z > &0)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt]; + REPEAT_N 7 STRIP_TAC; + MATCH_MP_TAC pos_pos_neq_thm; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let pos_neg_neq_thm = prove_by_refinement( + `!x y p. x < y /\ &0 < poly p x /\ poly p y < &0 /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ (poly p X = &0) /\ + (!z. x < z /\ z < X ==> &0 < poly p z) /\ + (!z. X < z /\ z < y ==> poly p z < &0)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`y:real`] POLY_IVT_NEG); + REWRITE_TAC[real_gt]; + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `X:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + REPEAT STRIP_TAC; + (* save *) + ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `N:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `poly p z - poly p x < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-11" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) N < &0`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `&0 < &0 - poly p z`; + LABEL_ALL_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < X - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (X - z) * poly (poly_diff p) M`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + CLAIM `N < M`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `K:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + (* save *) + CLAIM `x < K /\ K < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `N`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `M`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + POP_ASSUM (ASSUME_TAC o GSYM); + MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; + ASM_REWRITE_TAC[REAL_ENTIRE]; + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + LABEL_ALL_TAC; + POP_ASSUM MP_TAC; + USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; + CLAIM `x < M /\ M < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + REPEAT STRIP_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `N:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM MP_TAC; + REAL_SIMP_TAC; + STRIP_TAC; + CLAIM `&0 < (z - X) * poly (poly_diff p) N`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - X`; + LABEL_ALL_TAC; + USE_THEN "Z-7" MP_TAC THEN REAL_ARITH_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + LABEL_ALL_TAC; + USE_THEN "Z-6" (REWRITE_TAC o list); + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `poly p y - poly p z < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-12" MP_TAC; + USE_THEN "Z-5" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(y - z) * poly (poly_diff p) M < &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + CLAIM `N < M`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `K:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + (* save *) + CLAIM `x < K /\ K < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `N`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `M`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; + ASM_REWRITE_TAC[REAL_ENTIRE]; + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + LABEL_ALL_TAC; + POP_ASSUM MP_TAC; + USE_THEN "Z-5" MP_TAC THEN REAL_ARITH_TAC; + CLAIM `x < M /\ M < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; +]);; + +(* }}} *) + + +let pos_neg_neq_thm2 = prove_by_refinement( + `!x y p. x < y ==> poly p x > &0 ==> poly p y < &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ + (!z. (z = X) ==> (poly p z = &0)) /\ + (!z. x < z /\ z < X ==> poly p z > &0) /\ + (!z. X < z /\ z < y ==> poly p z < &0)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL[`x:real`;`y:real`;`p:real list`] pos_neg_neq_thm); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + EXISTS_TAC `X`; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let neg_pos_neq_thm = prove_by_refinement( + `!x y p. x < y /\ poly p x < &0 /\ &0 < poly p y /\ + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ (poly p X = &0) /\ + (!z. x < z /\ z < X ==> poly p z < &0) /\ + (!z. X < z /\ z < y ==> &0 < poly p z)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`y:real`] POLY_IVT_POS); + REWRITE_TAC[real_gt]; + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `X:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + REPEAT STRIP_TAC; + (* save *) + ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `N:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `&0 < poly p z - poly p x`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-11" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (z - x) * poly (poly_diff p) N`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `&0 - poly p z < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < X - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(X - z) * poly (poly_diff p) M < &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + CLAIM `N < M`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `K:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + (* save *) + CLAIM `x < K /\ K < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `N`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `M`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`X:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; + ASM_REWRITE_TAC[REAL_ENTIRE]; + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + LABEL_ALL_TAC; + POP_ASSUM MP_TAC; + USE_THEN "Z-4" MP_TAC THEN REAL_ARITH_TAC; + CLAIM `x < M /\ M < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + REPEAT STRIP_TAC; + ONCE_REWRITE_TAC[ARITH_RULE `x < y <=> ~(y < x \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `N:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM MP_TAC; + REAL_SIMP_TAC; + STRIP_TAC; + CLAIM `(z - X) * poly (poly_diff p) N < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - X`; + LABEL_ALL_TAC; + USE_THEN "Z-7" MP_TAC THEN REAL_ARITH_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC THEN REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + LABEL_ALL_TAC; + USE_THEN "Z-6" (REWRITE_TAC o list); + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `&0 < poly p y - poly p z`; + LABEL_ALL_TAC; + USE_THEN "Z-12" MP_TAC; + USE_THEN "Z-5" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (y - z) * poly (poly_diff p) M`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + CLAIM `N < M`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`N:real`;`M:real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); + ASM_REWRITE_TAC[]; + DISCH_THEN (X_CHOOSE_TAC `K:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + (* save *) + CLAIM `x < K /\ K < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `N`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `M`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + POP_ASSUM (ASSUME_TAC o GSYM); + MP_TAC (ISPECL [`p:real list`;`X:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `(x:real = y) <=> (y = x)`]; + ASM_REWRITE_TAC[REAL_ENTIRE]; + DISCH_THEN (X_CHOOSE_TAC `M:real`); + POP_ASSUM MP_TAC THEN STRIP_TAC; + LABEL_ALL_TAC; + POP_ASSUM MP_TAC; + USE_THEN "Z-5" MP_TAC THEN REAL_ARITH_TAC; + CLAIM `x < M /\ M < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `X`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; +]);; + +(* }}} *) + +let neg_pos_neq_thm2 = prove_by_refinement( + `!x y p. x < y ==> poly p x < &0 ==> poly p y > &0 ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + ?X. x < X /\ X < y /\ + (!z. (z = X) ==> (poly p z = &0)) /\ + (!z. x < z /\ z < X ==> poly p z < &0) /\ + (!z. X < z /\ z < y ==> poly p z > &0)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL[`x:real`;`y:real`;`p:real list`] neg_pos_neq_thm); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + EXISTS_TAC `X`; + ASM_MESON_TAC[]; +]);; +(* }}} *) + + +let lt_nz_thm = prove_by_refinement( + `(!x. x1 < x /\ x < x2 ==> poly p x < &0) ==> (!x. x1 < x /\ x < x2 ==> ~(poly p x = &0))`, +(* {{{ Proof *) +[ + MESON_TAC[REAL_LT_NZ]; +]);; +(* }}} *) + +let gt_nz_thm = prove_by_refinement( + `(!x. x1 < x /\ x < x2 ==> poly p x > &0) ==> (!x. x1 < x /\ x < x2 ==> ~(poly p x = &0))`, +(* {{{ Proof *) +[ + MESON_TAC[REAL_LT_NZ;real_gt]; +]);; +(* }}} *) + +let eq_eq_false_thm = prove_by_refinement( + `!x y p. x < y ==> (poly p x = &0) ==> (poly p y = &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> F`, +(* {{{ Proof *) + +[ + REPEAT_N 3 STRIP_TAC; + DISCH_THEN (fun x -> MP_TAC (MATCH_MP (ISPEC `p:real list` POLY_MVT) x) THEN ASSUME_TAC x); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + CLAIM `poly p y - poly p x = &0`; + REWRITE_TAC[real_sub]; + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + DISCH_THEN (REWRITE_ASSUMS o list); + CLAIM `&0 < y - x`; + USE_THEN "Z-6" MP_TAC THEN REAL_ARITH_TAC; + POP_ASSUM (MP_TAC o ISPEC `x':real`); + RULE_ASSUM_TAC GSYM; + POP_ASSUM IGNORE THEN POP_ASSUM IGNORE; + ASM_REWRITE_TAC[]; + STRIP_TAC; + STRIP_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_POS_NZ]; +]);; + +(* }}} *) + +let neg_zero_neg_thm = prove_by_refinement( + `!x y p. x < y ==> poly p x < &0 ==> (poly p y = &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z < &0)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; + REWRITE_TAC[ARITH_RULE `x <= y <=> (x < y \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p z - poly p x > &0`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-8" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) x' > &0`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + REWRITE_TAC[real_gt]; + ASM_REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) x' < &0`; + REWRITE_TAC[REAL_MUL_LT]; + DISJ2_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LT_ANTISYM]; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `&0 - poly p z < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(y - z) * poly (poly_diff p) x'' < &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* save *) + CLAIM `x' < x''`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); + REWRITE_ASSUMS[real_gt]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `x < x''' /\ x''' < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x'`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x''`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + MP_TAC (ISPECL[`z:real`;`y:real`;`p:real list`] eq_eq_false_thm); + POP_ASSUM (ASSUME_TAC o GSYM); + ASM_REWRITE_TAC[]; + REPEAT_N 2 STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; +]);; + +(* }}} *) + +let pos_zero_pos_thm = prove_by_refinement( + `!x y p. x < y ==> poly p x > &0 ==> (poly p y = &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z > &0)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[ARITH_RULE `x > y <=> ~(y >= x)`]; + REWRITE_TAC[ARITH_RULE `x >= y <=> (x > y \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p z - poly p x < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-8" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) x' < &0`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + REWRITE_TAC[real_gt]; + ASM_REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < (z - x) * poly (poly_diff p) x'`; + REWRITE_TAC[REAL_MUL_GT]; + DISJ2_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LT_ANTISYM]; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `&0 - poly p z > &0`; + LABEL_ALL_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(y - z) * poly (poly_diff p) x'' > &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;]; + REPEAT STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* save *) + CLAIM `x' < x''`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); + REWRITE_ASSUMS[real_gt]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `x < x''' /\ x''' < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x'`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x''`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + MP_TAC (ISPECL[`z:real`;`y:real`;`p:real list`] eq_eq_false_thm); + POP_ASSUM (ASSUME_TAC o GSYM); + ASM_REWRITE_TAC[]; + REPEAT_N 2 STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; +]);; + +(* }}} *) + +let zero_neg_neg_thm = prove_by_refinement( + `!x y p. x < y ==> (poly p x = &0) ==> (poly p y < &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z < &0)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[ARITH_RULE `x < y <=> ~(y <= x)`]; + REWRITE_TAC[ARITH_RULE `x <= y <=> (x < y \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p z - &0 > &0`; + LABEL_ALL_TAC; + USE_THEN "Z-3" MP_TAC; + USE_THEN "Z-8" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) x' > &0`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + REWRITE_TAC[real_gt]; + ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;]; + REPEAT STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-8" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 > (z - x) * poly (poly_diff p) x'`; + REWRITE_TAC[REAL_MUL_GT;real_gt;REAL_MUL_LT;]; + DISJ2_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LT_ANTISYM]; + (* save *) + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p y - poly p z < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-13" MP_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < y - z`; + LABEL_ALL_TAC; + USE_THEN "Z-11" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(y - z) * poly (poly_diff p) x'' < &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;]; + REPEAT STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* save *) + CLAIM `x' < x''`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`x':real`;`x'':real`] (REWRITE_RULE[real_gt] POLY_IVT_NEG)); + REWRITE_ASSUMS[real_gt]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `x < x''' /\ x''' < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x'`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x''`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + MP_TAC (ISPECL[`x:real`;`z:real`;`p:real list`] eq_eq_false_thm); + POP_ASSUM (ASSUME_TAC o GSYM); + ASM_REWRITE_TAC[]; + REPEAT_N 2 STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; +]);; + +(* }}} *) + +let zero_pos_pos_thm = prove_by_refinement( + `!x y p. x < y ==> (poly p x = &0) ==> (poly p y > &0) ==> + (!z. x < z /\ z < y ==> ~(poly (poly_diff p) z = &0)) ==> + (!z. x < z /\ z < y ==> poly p z > &0)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[ARITH_RULE `x > y <=> ~(y >= x)`]; + REWRITE_TAC[ARITH_RULE `x >= y <=> (x > y \/ (x = y))`]; + STRIP_TAC; + MP_TAC (ISPECL [`p:real list`;`z:real`;`y:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p y - poly p z > &0`; + LABEL_ALL_TAC; + USE_THEN "Z-7" MP_TAC; + USE_THEN "Z-3" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(y - z) * poly (poly_diff p) x' > &0`; + REPEAT_N 2 (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC; + REWRITE_TAC[real_gt]; + ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;]; + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + USE_THEN "Z-1" MP_TAC; + USE_THEN "Z-7" MP_TAC; + REAL_ARITH_TAC; + (* save *) + MP_TAC (ISPECL [`p:real list`;`x:real`;`z:real`] POLY_MVT); + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `poly p z - &0 < &0`; + LABEL_ALL_TAC; + USE_THEN "Z-9" MP_TAC; + REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 < z - x`; + LABEL_ALL_TAC; + USE_THEN "Z-12" MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `(z - x) * poly (poly_diff p) x'' < &0`; + POP_ASSUM IGNORE; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;]; + REPEAT STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REAL_ARITH_TAC; + (* save *) + CLAIM `x'' < x'`; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; + STRIP_TAC; + MP_TAC (ISPECL [`poly_diff p`;`x'':real`;`x':real`] (REWRITE_RULE[real_gt] POLY_IVT_POS)); + REWRITE_ASSUMS[real_gt]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + CLAIM `x < x''' /\ x''' < y`; + STRIP_TAC; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x''`; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `x'`; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + (* save *) + MP_TAC (ISPECL[`x:real`;`z:real`;`p:real list`] eq_eq_false_thm); + POP_ASSUM (ASSUME_TAC o GSYM); + ASM_REWRITE_TAC[]; + REPEAT_N 2 STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_TRANS; + EXISTS_TAC `z`; + ASM_REWRITE_TAC[]; +]);; + +(* }}} *) diff --git a/Rqe/inferpsign.ml b/Rqe/inferpsign.ml new file mode 100644 index 0000000..76cd756 --- /dev/null +++ b/Rqe/inferpsign.ml @@ -0,0 +1,361 @@ +(* ====================================================================== *) +(* INFERPSIGN *) +(* ====================================================================== *) + +(* ------------------------------------------------------------------------- *) +(* Infer sign of p(x) at points from corresponding qi(x) with pi(x) = 0 *) +(* ------------------------------------------------------------------------- *) + +(* ---------------------------------------------------------------------- *) +(* INFERPSIGN *) +(* ---------------------------------------------------------------------- *) + + +let isign_eq_zero thm = + let __,_,sign = dest_interpsign thm in + sign = szero_tm;; + +let isign_lt_zero thm = + let __,_,sign = dest_interpsign thm in + sign = sneg_tm;; + +let isign_gt_zero thm = + let __,_,sign = dest_interpsign thm in + sign = spos_tm;; + +(* +let p_thm,q_thm = ith 1 split_thms +*) +let inferpsign_row vars sgns p_thm q_thm div_thms = + let pthms = map (BETA_RULE o (PURE_REWRITE_RULE[interpsigns])) (interpsigns_thms2 p_thm) in + let qthms = map (BETA_RULE o (PURE_REWRITE_RULE[interpsigns])) (interpsigns_thms2 q_thm) in + let _,set,_ = dest_interpsigns p_thm in + if can (get_index isign_eq_zero) pthms then (* there's a zero *) + let ind = get_index isign_eq_zero pthms in + let pthm = ith ind pthms in + let qthm = ith ind qthms in + let div_thm = ith ind div_thms in + let div_thm' = GEN (hd vars) div_thm in + let aks,pqr = dest_eq (concl div_thm) in + let ak,s = dest_mult aks in + let a,k = dest_pow ak in + let pq,r = dest_plus pqr in + let p,q = dest_mult pq in + let parity_thm = PARITY_CONV k in + let evenp = fst(dest_comb (concl parity_thm)) = even_tm in + let sign_thm = FINDSIGN vars sgns a in + let op,_,_ = get_binop (concl sign_thm) in + if evenp then + let nz_thm = + if op = rlt then MATCH_MP ips_lt_nz_thm sign_thm + else if op = rgt then MATCH_MP ips_gt_nz_thm sign_thm + else if op = rneq then sign_thm + else failwith "inferpsign: 0" in + let imp_thms = + CONJUNCTS(ISPEC set (MATCH_MPL[EVEN_DIV_LEM;div_thm';nz_thm;parity_thm])) in + let _,_,qsign = dest_interpsign qthm in + let mp_thm = + if qsign = sneg_tm then ith 0 imp_thms + else if qsign = spos_tm then ith 1 imp_thms + else if qsign = szero_tm then ith 2 imp_thms + else failwith "inferpsign: 1" in + let final_thm = MATCH_MPL[mp_thm;pthm;qthm] in + mk_interpsigns (final_thm::pthms) + else (* k is odd *) + if op = rgt then (* a > &0 *) + let imp_thms = + CONJUNCTS(ISPEC set (MATCH_MPL[GT_DIV_LEM;div_thm';sign_thm])) in + let _,_,qsign = dest_interpsign qthm in + let mp_thm = + if qsign = sneg_tm then ith 0 imp_thms + else if qsign = spos_tm then ith 1 imp_thms + else if qsign = szero_tm then ith 2 imp_thms + else failwith "inferpsign: 1" in + let final_thm = MATCH_MPL[mp_thm;pthm;qthm] in + mk_interpsigns (final_thm::pthms) + else + failwith "inferpsign: shouldn`t reach this point with an odd power and negative sign! See PDIVIDES and return the correct div_thm" + else (* no zero *) + let p = snd(dest_mult (lhs(concl (hd div_thms)))) in + let p1 = mk_abs(hd vars,p) in + let pthm = ISPECL [set;p1] unknown_thm in + mk_interpsigns (pthm::pthms);; + +(* {{{ Doc *) +(* +split_interpsigns + |- interpsigns + [p0; p1; p2; q0; q1; q2] + (\x. x < x1) + [Pos; Pos; Pos; Neg; Neg; Neg] + + --> + +( + |- interpsigns + [p0; p1; p2] + (\x. x < x1) + [Pos; Pos; Pos] +, + |- interpsigns + [q0; q1; q2] + (\x. x < x1) + [ Neg; Neg; Neg] +) +*) +(* }}} *) +let split_interpsigns thm = + let thms = interpsigns_thms2 thm in + let n = length thms / 2 in + let l,r = chop_list n thms in + (mk_interpsigns l,mk_interpsigns r);; + +let INFERPSIGN vars sgns mat_thm div_thms = + let pts,pols,signs = dest_interpmat (concl mat_thm) in + let n = length (dest_list pols) / 2 in + let rol_thm,sgn_thm = interpmat_thms mat_thm in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb (concl rol_thm))) in + let conj_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] sgn_thm) in + let split_thms = map split_interpsigns conj_thms in + let conj_thms' = map (fun (x,y) -> inferpsign_row vars sgns x y div_thms) split_thms in + let all_thm = mk_all2_interpsigns part_thm conj_thms' in + let mat_thm' = mk_interpmat_thm rol_thm all_thm in + mat_thm';; + +(* ---------------------------------------------------------------------- *) +(* Opt *) +(* ---------------------------------------------------------------------- *) + +let MK_REP = + let rep_tm = `REPLICATE:num -> sign -> sign list` in + let len_tm = `LENGTH:real list -> num` in + let one = `1` in + let two = `2` in + let unknown = `Unknown` in + fun pts -> + let num = mk_binop np (mk_binop nm two (mk_comb(len_tm,pts))) one in + let len = length (dest_list pts) in + let num2 = MK_SUC (2 * len + 1) in + let lthm = ARITH_SIMP_CONV[LENGTH] num in + let lthm2 = TRANS lthm num2 in + let lthm3 = AP_THM (AP_TERM rep_tm lthm2) unknown in + REWRITE_RULE[REPLICATE] lthm3;; + +let INSERT_UNKNOWN_COL = + fun mat_thm p -> + let pts,_,_ = dest_interpmat (concl mat_thm) in + let rep_thm = MK_REP pts in + let mat_thm' = MATCH_MP INFERPSIGN_MATINSERT_THM mat_thm in + let mat_thm'' = PURE_REWRITE_RULE[MAP2;rep_thm] mat_thm' in + ISPEC p mat_thm'';; + +let REMOVE_QS = + fun mat_thm -> + let _,pols,_ = dest_interpmat (concl mat_thm) in + let len = length (dest_list pols) in + if not (len mod 2 = 1) then failwith "odd pols?" else + let mat_thm' = funpow (len / 2) (MATCH_MP REMOVE_LAST) mat_thm in + REWRITE_RULE[MAP;BUTLAST;NOT_CONS_NIL;TL;HD;] mat_thm';; + +let SPLIT_LIST n l ty = + let l' = dest_list l in + let l1',l2' = chop_list n l' in + let l1,l2 = (mk_list(l1',ty),mk_list(l2',ty)) in + let app_tm = mk_const("APPEND",[ty,aty]) in + let l3 = mk_comb(mk_comb(app_tm,l1),l2) in + SYM(REWRITE_CONV[APPEND] l3);; + +(* +let thm = asign +*) + +let prove_nonzero thm = + let op,_,_ = get_binop (concl thm) in + if op = rgt then MATCH_MP ips_gt_nz_thm thm + else if op = rlt then MATCH_MP ips_lt_nz_thm thm + else if op = rneq then thm + else failwith "prove_nonzero: bad op";; + +(* +let mat_thm = mat_thm' +let ind = 7 +*) + + +let INFERPT = + let unknown = `Unknown` in + let zero = `Zero` in + let pos = `Pos` in + let neg = `Neg` in + let pow = `(pow)` in + let even_tm = `(EVEN)` in + let odd_tm = `(ODD)` in + let rr_ty = `:real -> real` in + let sl_ty = `:sign list` in + let s_ty = `:sign` in + let imat = `interpmat` in + let rr_length = mk_const("LENGTH",[rr_ty,aty]) in + let s_length = mk_const("LENGTH",[s_ty,aty]) in + let sl_length = mk_const("LENGTH",[sl_ty,aty]) in + let imat = `interpmat` in + fun vars sgns mat_thm div_thms ind -> + let pts,pols,signs = dest_interpmat (concl mat_thm) in + let pols' = dest_list pols in + let signsl = dest_list signs in + let signs' = map dest_list signsl in + let pols_len = length (hd signs') in + let pols_len2 = pols_len / 2 in + let pt_sgnl = ith ind signsl in + let pt_sgns = ith ind signs' in + let zind = index zero pt_sgns in + if zind > pols_len2 then mat_thm else (* return if not a zero of a p, only a q *) + let psgn = ith (pols_len2 + zind) pt_sgns in + let div_thm = ith (zind - 1) div_thms in + let a,n = dest_binop pow (fst (dest_binop rm (lhs (concl div_thm)))) in + let asign = FINDSIGN vars sgns a in + let op,_,_ = get_binop (concl asign) in + let par_thm = PARITY_CONV n in + let par = fst(dest_comb(concl par_thm)) in + let mp_thm = + (* note: by def of PDIVIDES, we can`t have + negative sign and odd power at this point *) + (* n is even *) + if par = even_tm then + if psgn = pos then INFERPSIGN_POS_EVEN + else if psgn = neg then INFERPSIGN_NEG_EVEN + else if psgn = zero then INFERPSIGN_ZERO_EVEN + else failwith "INFERPT: bad sign" + else (* n is odd *) + if psgn = pos then INFERPSIGN_POS_ODD_POS + else if psgn = neg then INFERPSIGN_NEG_ODD_POS + else if psgn = zero then INFERPSIGN_ZERO_ODD_POS + else failwith "INFERPT: bad sign" in + (* pols *) + let split_pols1 = SPLIT_LIST zind pols rr_ty in + let _,l2 = chop_list zind pols' in + let split_pols2 = SPLIT_LIST pols_len2 (mk_list(l2,rr_ty)) rr_ty in + let s1,t1 = dest_comb (rhs (concl split_pols1)) in + let split_pols_thm = TRANS split_pols1 (AP_TERM s1 split_pols2) in + (* pt_sgns *) + let split_sgns1 = SPLIT_LIST zind pt_sgnl s_ty in + let _,l3 = chop_list zind pt_sgns in + let split_sgns2 = SPLIT_LIST pols_len2 (mk_list(l3,s_ty)) s_ty in + let s2,t2 = dest_comb (rhs (concl split_sgns1)) in + let split_pt_sgns_thm = TRANS split_sgns1 (AP_TERM s2 split_sgns2) in + (* sgns *) + let split_signs = SPLIT_LIST ind signs sl_ty in + let r1,r3 = dest_comb(rhs (concl split_signs)) in + let tl_thm = HD_CONV (ONCE_REWRITE_CONV[split_pt_sgns_thm]) r3 in + let r4,_ = dest_comb (rhs (concl split_signs)) in + let split_sgns_thm = TRANS split_signs (AP_TERM r4 tl_thm) in + (* imat *) + let mat1 = mk_comb(imat,pts) in + let mat_thm1 = AP_TERM mat1 split_pols_thm in + let mat_thm2 = MK_COMB(mat_thm1,split_sgns_thm) in + let mat_thm3 = EQ_MP mat_thm2 mat_thm in + (* length thms *) + (* LENGTH ps = LENGTH s1 *) + let ps = mk_list(tl(dest_list(snd(dest_comb s1))),rr_ty) in + let ps_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,ps)) in + let ss = mk_list(tl(dest_list(snd(dest_comb s2))),s_ty) in + let ss_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,ss)) in + let ps_s1_thm = TRANS ps_len (SYM ss_len) in + (* LENGTH qs = LENGTH s2 *) + let k1 = tl (fst (chop_list pols_len2 (dest_list t1))) in + let qs = mk_list(k1,rr_ty) in + let qs_len = REWRITE_CONV[LENGTH] (mk_comb(rr_length,qs)) in + let k2 = tl (fst (chop_list pols_len2 (dest_list t2))) in + let s2s = mk_list(k2,s_ty) in + let s2s_len = REWRITE_CONV[LENGTH] (mk_comb(s_length,s2s)) in + let qs_s2_thm = TRANS qs_len (SYM s2s_len) in + (* ODD (LENGTH sgns) *) + let _,hdsgns = dest_comb r1 in + let odd_thm = EQT_ELIM(REWRITE_CONV[LENGTH;ODD;EVEN;NOT_ODD;NOT_EVEN] (mk_comb(odd_tm,mk_comb(sl_length,hdsgns)))) in + (* a <> 0 *) + let a_thm = + if par = even_tm then prove_nonzero asign + else asign in + let div_thm' = GEN (hd vars) div_thm in + (* main *) + let thm1 = BETA_RULE(MATCH_MPL[mp_thm;mat_thm3;ps_s1_thm;qs_s2_thm;odd_thm]) in + let thm2 = + if par = even_tm then MATCH_MPL[thm1;div_thm';a_thm;par_thm] + else MATCH_MPL[thm1;div_thm';a_thm] in + REWRITE_RULE[APPEND] thm2;; + +(* +let mat_thm = mat_thm' +*) +let INFERPTS vars sgns mat_thm div_thms = + let pts,_,_ = dest_interpmat (concl mat_thm) in + let len = 2 * length (dest_list pts) in + let ods = filter odd (1--len) in + itlist (fun i matthm -> INFERPT vars sgns matthm div_thms i) ods mat_thm;; + + +let itvars,itsgns,itmat,itdivs = ref [],ref [],ref TRUTH,ref [];; +(* +let vars,sgns,mat_thm,div_thms = !itvars,!itsgns,!itmat,!itdivs +*) + +let INFERPSIGN2 vars sgns mat_thm div_thms = + itvars := vars; + itsgns := sgns; + itmat := mat_thm; + itdivs := div_thms; + let _,bod = dest_binop rm (lhs (concl (hd div_thms))) in + let p = mk_abs(hd vars,bod) in + let mat_thm' = INSERT_UNKNOWN_COL mat_thm p in + let mat_thm'' = INFERPTS vars sgns mat_thm' div_thms in + REMOVE_QS mat_thm'';; + + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let INFERPSIGN vars sgns mat_thm div_thms = + let start_time = Sys.time() in + let res = INFERPSIGN vars sgns mat_thm div_thms in + inferpsign_timer +.= (Sys.time() -. start_time); + res;; + +(* + +let l1 = PDIVIDE [`x:real`] + `&1 + x * (&1 + x * (&1 + x * &1))` `&1 + x * (&2 + x * &3)`;; +let l2 = PDIVIDE [`x:real`] + `&1 + x * (&1 + x * (&1 + x * &1))` `&2 + x * (-- &3 + x * &1)`;; +let l3 = PDIVIDE [`x:real`] + `&1 + x * (&1 + x * (&1 + x * &1))` `-- &4 + x * (&0 + x * &1)`;; + +let div_thms = [l1;l2;l3];; +let vars = [`x:real`];; +let sgns = [ARITH_RULE `&1 > &0`];; + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. &1 + x * (&2 + x * &3); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); + \x. &8 + x * &4; \x. -- &7 + x * &11; \x. &5 + x * &5] + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` ;; + +INFERPSIGN vars sgns mat_thm div_thms + + + + + + + + +*) diff --git a/Rqe/inferpsign_thms.ml b/Rqe/inferpsign_thms.ml new file mode 100644 index 0000000..1c9866e --- /dev/null +++ b/Rqe/inferpsign_thms.ml @@ -0,0 +1,377 @@ +let EVEN_DIV_LEM = prove_by_refinement( + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> + a <> &0 ==> + EVEN n ==> + ((interpsign set q Zero) ==> + (interpsign set d Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Zero) ==> + (interpsign set p Zero))`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpsign]; + REPEAT STRIP_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `&0 < a pow n`; + ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; + STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `&0 < a pow n`; + ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; + STRIP_TAC; + CLAIM `a pow n * p x > &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `&0 < a pow n`; + ASM_MESON_TAC[EVEN_ODD_POW;real_gt]; + STRIP_TAC; + CLAIM `a pow n * p x = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_POS_NZ]; +]);; + +(* }}} *) + +let GT_DIV_LEM = prove_by_refinement( + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> + a > &0 ==> + ((interpsign set q Zero) ==> + (interpsign set d Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set d Zero) ==> + (interpsign set p Zero))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign]; + REPEAT_N 9 STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[REAL_POW_LT;real_gt;]; + STRIP_TAC; + REPEAT STRIP_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + (* save *) + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `a pow n * p x > &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `a pow n * p x = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; +]);; +(* }}} *) + +let NEG_ODD_LEM = prove_by_refinement( + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> + a < &0 ==> + ODD n ==> + ((interpsign set q Zero) ==> + (interpsign set (\x. -- d x) Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. -- d x) Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. -- d x) Zero) ==> + (interpsign set p Zero))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;POLY_NEG]; + REPEAT_N 10 STRIP_TAC; + CLAIM `a pow n < &0`; + ASM_MESON_TAC[PARITY_POW_LT;real_gt;]; + STRIP_TAC; + REAL_SIMP_TAC; + REPEAT STRIP_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `a pow n * p x > &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + (* save *) + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `a pow n * p x = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; +]);; +(* }}} *) + +let NEQ_ODD_LEM = prove_by_refinement( + `!set p q c d a n. + (!x. a pow n * p x = c x * q x + d x) ==> + a <> &0 ==> + ODD n ==> + ((interpsign set q Zero) ==> + (interpsign set (\x. a * d x) Neg) ==> + (interpsign set p Neg)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. a * d x) Pos) ==> + (interpsign set p Pos)) /\ + ((interpsign set q Zero) ==> + (interpsign set (\x. a * d x) Zero) ==> + (interpsign set p Zero))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;POLY_CMUL]; + REPEAT_N 10 STRIP_TAC; + CLAIM `a < &0 \/ a > &0 \/ (a = &0)`; + REAL_ARITH_TAC; + REWRITE_ASSUMS[NEQ]; + ASM_REWRITE_TAC[]; + LABEL_ALL_TAC; + STRIP_TAC; + (* save *) + CLAIM `a pow n < &0`; + ASM_MESON_TAC[PARITY_POW_LT]; + STRIP_TAC; + REPEAT STRIP_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `d x > &0`; + POP_ASSUM MP_TAC; + ASM_REWRITE_TAC[real_gt;REAL_MUL_LT]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + CLAIM `&0 < a pow n * p x`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_GT]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + (* save *) + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `d x < &0`; + POP_ASSUM MP_TAC; + REWRITE_TAC[REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `d x = &0`; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; + STRIP_TAC; + CLAIM `a pow n * p x = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; + (* save *) + CLAIM `a pow n > &0`; + ASM_MESON_TAC[EVEN_ODD_POW;NEQ;real_gt]; + STRIP_TAC; + REPEAT STRIP_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `d x < &0`; + POP_ASSUM MP_TAC; + ASM_REWRITE_TAC[real_gt;REAL_MUL_LT]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + REWRITE_TAC[REAL_MUL_LT]; + REPEAT STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + (* save *) + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `d x > &0`; + POP_ASSUM MP_TAC; + REWRITE_TAC[REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + CLAIM `a pow n * p x < &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `a pow n * p x > &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; + REPEAT STRIP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + RULE_ASSUM_TAC (fun y -> try ISPEC `x:real` y with _ -> y); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x]); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x;REAL_MUL_RZERO;REAL_ADD_LID;]); + STRIP_TAC; + CLAIM `d x = &0`; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; + STRIP_TAC; + CLAIM `a pow n * p x = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; +]);; +(* }}} *) + +let NEQ_MULT_LT_LEM = prove_by_refinement( + `!a q d d' set. + a < &0 ==> + ((interpsign set d Neg) ==> + (interpsign set (\x. a * d x) Pos)) /\ + ((interpsign set d Pos) ==> + (interpsign set (\x. a * d x) Neg)) /\ + ((interpsign set d Zero) ==> + (interpsign set (\x. a * d x) Zero))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;POLY_NEG]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_MUL_GT;real_gt]; + ASM_MESON_TAC[REAL_MUL_LT;real_gt]; + ASM_MESON_TAC[REAL_ENTIRE;REAL_NOT_EQ;real_gt]; +]);; +(* }}} *) + +let NEQ_MULT_GT_LEM = prove_by_refinement( + `!a q d d' set. + a > &0 ==> + ((interpsign set d Neg) ==> + (interpsign set (\x. a * d x) Neg)) /\ + ((interpsign set d Pos) ==> + (interpsign set (\x. a * d x) Pos)) /\ + ((interpsign set d Zero) ==> + (interpsign set (\x. a * d x) Zero))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;POLY_NEG] THEN + MESON_TAC[REAL_MUL_LT;REAL_ENTIRE;REAL_NOT_EQ;REAL_MUL_GT;real_gt]; +]);; +(* }}} *) + +let unknown_thm = prove( + `!set p. (interpsign set p Unknown)`, + MESON_TAC[interpsign]);; + +let ips_gt_nz_thm = prove_by_refinement( + `!x. x > &0 ==> x <> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[NEQ]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let ips_lt_nz_thm = prove_by_refinement( + `!x. x < &0 ==> x <> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[NEQ]; + REAL_ARITH_TAC; +]);; +(* }}} *) diff --git a/Rqe/lift_qelim.ml b/Rqe/lift_qelim.ml new file mode 100644 index 0000000..78977f1 --- /dev/null +++ b/Rqe/lift_qelim.ml @@ -0,0 +1,129 @@ +let ACI_CONJ = + let rec build ths tm = + if is_conj tm then + let l,r = dest_conj tm in CONJ (build ths l) (build ths r) + else find (fun th -> concl th = tm) ths in + fun p p' -> + let cjs = CONJUNCTS(ASSUME p) and cjs' = CONJUNCTS(ASSUME p') in + let th = build cjs p' and th' = build cjs' p in + IMP_ANTISYM_RULE (DISCH_ALL th) (DISCH_ALL th');; + +let QE_SIMPLIFY_CONV = + let NOT_EXISTS_UNIQUE_THM = prove + (`~(?!x. P x) <=> (!x. ~P x) \/ ?x x'. P x /\ P x' /\ ~(x = x')`, + REWRITE_TAC[EXISTS_UNIQUE_THM; DE_MORGAN_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; CONJ_ASSOC]) in + let tauts = + [TAUT `~(~p) <=> p`; + TAUT `~(p /\ q) <=> ~p \/ ~q`; + TAUT `~(p \/ q) <=> ~p /\ ~q`; + TAUT `~(p ==> q) <=> p /\ ~q`; + TAUT `p ==> q <=> ~p \/ q`; + NOT_FORALL_THM; + NOT_EXISTS_THM; + EXISTS_UNIQUE_THM; + NOT_EXISTS_UNIQUE_THM; + TAUT `~(p <=> q) <=> (p /\ ~q) \/ (~p /\ q)`; + TAUT `(p <=> q) <=> (p /\ q) \/ (~p /\ ~q)`; + TAUT `~(p /\ q \/ ~p /\ r) <=> p /\ ~q \/ ~p /\ ~r`] in + GEN_REWRITE_CONV TOP_SWEEP_CONV tauts;; + +let OR_ASSOC = TAUT `(a \/ b) \/ c <=> a \/ b \/ c`;; +let forall_thm = prove(`!P. (!x. P x) <=> ~ (?x. ~ P x)`,MESON_TAC[]) +and or_exists_conv = PURE_REWRITE_CONV[OR_EXISTS_THM] +and triv_exists_conv = REWR_CONV EXISTS_SIMP +and push_exists_conv = REWR_CONV RIGHT_EXISTS_AND_THM +and not_tm = `(~)` +and or_tm = `(\/)` +and t_tm = `T` +and f_tm = `F`;; + +let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = + let rec qelift_conv vars fm = + if fm = t_tm or fm = f_tm then REFL fm + else if is_neg fm then + let thm1 = qelift_conv vars (dest_neg fm) in + MK_COMB(REFL not_tm,thm1) + else if is_conj fm or is_disj fm or is_imp fm or is_iff fm then + let (op,p,q) = get_binop fm in + let thm1 = qelift_conv vars p in + let thm2 = qelift_conv vars q in + MK_COMB(MK_COMB((REFL op),thm1),thm2) + else if is_forall fm then + let (x,p) = dest_forall fm in + let nex_thm = BETA_RULE (ISPEC (mk_abs(x,p)) forall_thm) in + let nex_thm' = CONV_RULE (LAND_CONV (RAND_CONV (ALPHA_CONV x))) nex_thm in + let nex_thm'' = CONV_RULE (RAND_CONV (RAND_CONV (RAND_CONV (ALPHA_CONV x)))) nex_thm' in + let elim_thm = qelift_conv vars (mk_exists(x,mk_neg p)) in + TRANS nex_thm'' (MK_COMB (REFL not_tm,elim_thm)) + else if is_exists fm then + let (x,p) = dest_exists fm in + let thm1 = qelift_conv (x::vars) p in + let thm1a = MK_EXISTS x thm1 in + let thm1b = PURE_REWRITE_RULE[OR_ASSOC] thm1a in + let thm2 = nfn_conv (rhs(concl thm1)) in + let thm2a = MK_EXISTS x thm2 in + let thm2b = PURE_REWRITE_RULE[OR_ASSOC] thm2a in + let djs = disjuncts (rhs (concl thm2)) in + let djthms = map (qelim x vars) djs in + let thm3 = end_itlist + (fun thm1 thm2 -> MK_COMB(MK_COMB (REFL or_tm,thm1),thm2)) djthms in + let split_ex_thm = GSYM (or_exists_conv (lhs (concl thm3))) in + let thm3a = TRANS split_ex_thm thm3 in + TRANS (TRANS thm1b thm2b) thm3a + else + afn_conv vars fm + and qelim x vars p = + let cjs = conjuncts p in + let ycjs,ncjs = partition (mem x o frees) cjs in + if ycjs = [] then triv_exists_conv(mk_exists(x,p)) + else if ncjs = [] then qfn_conv vars (mk_exists(x,p)) else + let th1 = ACI_CONJ p (mk_conj(list_mk_conj ncjs,list_mk_conj ycjs)) in + let th2 = CONV_RULE (RAND_CONV push_exists_conv) (MK_EXISTS x th1) in + let t1,t2 = dest_comb (rand(concl th2)) in + TRANS th2 (AP_TERM t1 (qfn_conv vars t2)) in + fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; + + + +(* +let afn_conv,nfn_conv,qfn_conv = POLYATOM_CONV,(EVALC_CONV THENC SIMPLIFY_CONV),BASIC_REAL_QELIM_CONV +let LIFT_QELIM_CONV afn_conv nfn_conv qfn_conv = + fun fm -> ((qelift_conv (frees fm)) THENC QE_SIMPLIFY_CONV) fm;; + + +let k0 = (TRANS thm1a thm2a) +let k1 = thm3a +let k2 = CONV_RULE (LAND_CONV (RAND_CONV (ALPHA_CONV `x:real`))) k1 +TRANS k0 k2 + + +let vars = [] +let fm,vars = !lqc_fm,!lqc_vars +let fm = `?x y z. x * y * z < &0` +let p = `~((&0 + y * (&0 + x * &1) = &0) <=> (&0 + x * &1 = &0) \/ (&0 + y * &1 = &0))` +#trace qelift_conv +#trace qelim + + + +TRANS (ASSUME `T <=> (?x. x * y > &0)`) (ASSUME `(?z. z * y > &0) <=> F`) + +MATCH_TRANS (ASSUME `T <=> (?x. x * y > &0)`) (ASSUME `?z. z * y > &0 <=> F`) +MATCH_EQ_MP (ASSUME `(?x. x * y > &0) <=> F`) (ASSUME `?z. z * y > &0`) + +qelift_conv vars fm + + +let fm = `?x y. x * y = &0` +let fm = `!y. (x * y = &0) <=> (x = &0) \/ (y = &0)` +let fm = `?y. (x * y = &0) <=> (x = &0) \/ (y = &0)` +let fm = `?y. ~ ((x * y = &0) <=> (x = &0) \/ (y = &0))` +let fm = `?x. ~(!y. (x * y = &0) <=> (x = &0) \/ (y = &0))` +let vars = [ry;rx] +let vars = [rx] + +let QELIM_DLO_CONV = + (LIFT_QELIM_CONV AFN_DLO_CONV ((CNNF_CONV LFN_DLO_CONV) THENC DNF_CONV) + (fun v -> DLOBASIC_CONV)) THENC (REWRITE_CONV[]);; +*) diff --git a/Rqe/list_rewrites.ml b/Rqe/list_rewrites.ml new file mode 100644 index 0000000..0584fd5 --- /dev/null +++ b/Rqe/list_rewrites.ml @@ -0,0 +1,36 @@ +(* ---------------------------------------------------------------------- *) +(* List *) +(* ---------------------------------------------------------------------- *) + +let NOT_NIL = prove_by_refinement( + `!l. ~(l = []) <=> ?(h:A) t. l = CONS h t`, +(* {{{ Proof *) + +[ + STRIP_TAC THEN EQ_TAC; + MESON_TAC[list_CASES]; + STRIP_TAC; + ASM_MESON_TAC[NOT_CONS_NIL]; +]);; + +(* }}} *) + +let LIST_REWRITES = ref [ +NOT_CONS_NIL; +HD; +TL; +CONS_11; +LENGTH; +LAST; +list_CASES; +NOT_NIL; +];; + +let LIST_SIMP_TAC = REWRITE_TAC ( + !LIST_REWRITES +);; + +let extend_list_rewrites l = + LIST_REWRITES := !LIST_REWRITES @ l;; + +BASIC_REWRITES := !LIST_REWRITES @ !BASIC_REWRITES;; diff --git a/Rqe/main_thms.ml b/Rqe/main_thms.ml new file mode 100644 index 0000000..0d245fd --- /dev/null +++ b/Rqe/main_thms.ml @@ -0,0 +1,247 @@ +let empty_mat = prove_by_refinement( + `interpmat [] [] [[]]`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat;ROL_EMPTY;interpsigns;ALL2;partition_line]; +]);; + +(* }}} *) + +let empty_sgns = [ARITH_RULE `&1 > &0`];; + +let monic_isign_lem = prove( + `(!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Pos ==> interpsign s p Pos) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Pos ==> interpsign s p Neg) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Neg ==> interpsign s p Neg) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Neg ==> interpsign s p Pos) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c > &0 ==> interpsign s mp Zero ==> interpsign s p Zero) /\ + (!s c mp p. (!x. c * p x = mp x) ==> c < &0 ==> interpsign s mp Zero ==> interpsign s p Zero)`, +(* {{{ Proof *) + + REWRITE_TAC[interpsign] THEN REPEAT STRIP_TAC THEN + POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC (MATCH_MP y x))) THEN + POP_ASSUM MP_TAC THEN + POP_ASSUM (ASSUME_TAC o GSYM o (ISPEC `x:real`)) THEN + ASM_REWRITE_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_ENTIRE] THEN + REAL_ARITH_TAC);; + +(* }}} *) + +let gtpos::ltpos::gtneg::ltneg::gtzero::ltzero::[] = CONJUNCTS monic_isign_lem;; + +let main_lem000 = prove_by_refinement( + `!l n. (LENGTH l = SUC n) ==> 0 < LENGTH l`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + ARITH_TAC; +]);; + +(* }}} *) + +let main_lem001 = prove_by_refinement( + `x <> &0 ==> (LAST l = x) ==> LAST l <> &0`, +[MESON_TAC[]]);; + +let main_lem002 = prove_by_refinement( + `(x <> y ==> x <> y) /\ + (x < y ==> x <> y) /\ + (x > y ==> x <> y) /\ + (~(x >= y) ==> x <> y) /\ + (~(x <= y) ==> x <> y) /\ + (~(x = y) ==> x <> y)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[NEQ] THEN REAL_ARITH_TAC +]);; + +(* }}} *) + +let factor_pos_pos = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Pos ==> + (!x. x pow k * p x = q x) ==> interpsign s q Pos`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;real_gt]; + DISJ2_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt]; +]);; +(* }}} *) + +let factor_pos_neg = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Neg ==> + (!x. x pow k * p x = q x) ==> interpsign s q Neg`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_LT;real_gt]; + DISJ2_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt]; +]);; +(* }}} *) + +let factor_pos_zero = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Pos ==> interpsign s p Zero ==> + (!x. x pow k * p x = q x) ==> interpsign s q Zero`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_LT;REAL_ENTIRE;real_gt]; +]);; +(* }}} *) + +let factor_zero_pos = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Pos ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Zero`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;REAL_ENTIRE]; + DISJ1_TAC; + ASM_MESON_TAC[POW_0;num_CASES;]; +]);; +(* }}} *) + +let factor_zero_neg = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Neg ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Zero`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;REAL_ENTIRE]; + DISJ1_TAC; + ASM_MESON_TAC[POW_0;num_CASES;]; +]);; +(* }}} *) + +let factor_zero_zero = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Zero ==> interpsign s p Zero ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Zero`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let factor_neg_even_pos = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> EVEN k ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Pos`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt]; + DISJ2_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; +]);; +(* }}} *) + +let factor_neg_even_neg = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> EVEN k ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Neg`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt]; + DISJ2_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; +]);; +(* }}} *) + +let factor_neg_even_zero = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> EVEN k ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Zero`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; +]);; +(* }}} *) + +let factor_neg_odd_pos = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Pos ==> ODD k ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Neg`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; + DISJ1_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; +]);; +(* }}} *) + +let factor_neg_odd_neg = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Neg ==> ODD k ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Pos`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; + DISJ1_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt;PARITY_POW_LT]; +]);; +(* }}} *) + +let factor_neg_odd_zero = prove_by_refinement( + `interpsign s (\x. &0 + x * &1) Neg ==> interpsign s p Zero ==> ODD k ==> ~(k = 0) ==> + (!x. x pow k * p x = q x) ==> interpsign s q Zero`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpsign;REAL_ADD_LID;REAL_MUL_RID;]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> (RULE_ASSUM_TAC (fun y -> try MATCH_MP y x with _ -> y))); + POP_ASSUM (ASSUME_TAC o ISPEC rx o GSYM); + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_GT;REAL_MUL_LT;real_gt;REAL_ENTIRE]; +]);; +(* }}} *) diff --git a/Rqe/make.ml b/Rqe/make.ml new file mode 100644 index 0000000..9162649 --- /dev/null +++ b/Rqe/make.ml @@ -0,0 +1,51 @@ +(* ------------------------------------------------------------------------- *) +(* Library requirements. *) +(* ------------------------------------------------------------------------- *) + +needs "Library/analysis.ml";; +needs "Library/poly.ml";; + +(* ------------------------------------------------------------------------- *) +(* The main code. *) +(* ------------------------------------------------------------------------- *) + +loads "Rqe/rqe_lib.ml";; +loads "Rqe/rqe_tactics_ext.ml";; +loads "Rqe/util.ml";; +loads "Rqe/rewrites.ml";; +loads "Rqe/basic.ml";; +loads "Rqe/rqe_num.ml";; +loads "Rqe/rqe_real.ml";; +loads "Rqe/list_rewrites.ml";; +loads "Rqe/rqe_list.ml";; +loads "Rqe/timers.ml";; +loads "Rqe/num_calc_simp.ml";; +loads "Rqe/asym.ml";; +loads "Rqe/rol.ml";; +loads "Rqe/poly_ext.ml";; +loads "Rqe/simplify.ml";; +loads "Rqe/lift_qelim.ml";; +loads "Rqe/defs.ml";; +loads "Rqe/testform_thms.ml";; +loads "Rqe/condense_thms.ml";; +loads "Rqe/inferisign_thms.ml";; +loads "Rqe/matinsert_thms.ml";; +loads "Rqe/signs_thms.ml";; +loads "Rqe/inferpsign_thms.ml";; +loads "Rqe/dedmatrix_thms.ml";; +loads "Rqe/pdivides_thms.ml";; +loads "Rqe/main_thms.ml";; +loads "Rqe/work_thms.ml";; +loads "Rqe/testform.ml";; +loads "Rqe/condense.ml";; +loads "Rqe/inferisign.ml";; +loads "Rqe/matinsert.ml";; +loads "Rqe/signs.ml";; +loads "Rqe/inferpsign.ml";; +loads "Rqe/dedmatrix.ml";; +loads "Rqe/pdivides.ml";; +loads "Rqe/rqe_main.ml";; + +(**** +loads "Rqe/examples.ml";; + ****) diff --git a/Rqe/matinsert.ml b/Rqe/matinsert.ml new file mode 100644 index 0000000..eddb00a --- /dev/null +++ b/Rqe/matinsert.ml @@ -0,0 +1,125 @@ + +let ROWINSERT = + let lxt = `\x:real. T` in + fun i const_thm interpsigns_thm -> + let isigns_thms = interpsigns_thms2 interpsigns_thm in + let isigns_thm = hd isigns_thms in + let set,_,_ = + if concl isigns_thm = t_tm then lxt,t_tm,t_tm else + dest_interpsign (hd isigns_thms) in + let const_thm' = MATCH_MP (ISPEC set matinsert_lem0) const_thm in + let const_thm'' = PURE_REWRITE_RULE[GSYM interpsign] const_thm' in + let isigns_thms' = insertat i const_thm'' isigns_thms in + let isigns_thms'' = if isigns_thm = TRUTH then butlast isigns_thms' else isigns_thms' in + mk_interpsigns isigns_thms'';; + +let MATINSERT vars i const_thm cont mat_thm = + let const_thm' = GEN (hd vars) const_thm in + let rol_thm,all2_thm = interpmat_thms mat_thm in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb (concl rol_thm))) in + let isigns_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] all2_thm) in + let isigns_thms' = map (ROWINSERT i const_thm') isigns_thms in + let all2_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let mat_thm' = mk_interpmat_thm rol_thm all2_thm' in + cont mat_thm';; + + + +(* ---------------------------------------------------------------------- *) +(* Opt *) +(* ---------------------------------------------------------------------- *) + +(* OPT FAILED... slightly slower, even with hashtables *) + +let rec mk_suc = + let zero = `0` in + let suc = `SUC` in + fun n -> + match n with + 0 -> zero + | n -> mk_comb(suc,mk_suc (n-1));; + +let rec MK_SUC = + let f n = prove(mk_eq(mk_small_numeral n,mk_suc n),ARITH_TAC) in + let size = 100 in + let range = 0--size in + let suc_tbl = Hashtbl.create size in + map2 (Hashtbl.add suc_tbl) range (map f range); + fun n -> + try Hashtbl.find suc_tbl n with _ -> f n;; + +let PL_LENGTH = + let pl_tm = `partition_line` in + let len_tm = `LENGTH:(real -> bool) list -> num` in + fun pts -> + let lpts = mk_comb(len_tm,mk_comb(pl_tm,pts)) in + let lthm = ARITH_SIMP_CONV[PARTITION_LINE_LENGTH;LENGTH] lpts in + let pts' = snd(dest_eq(concl lthm)) in + let n = dest_small_numeral pts' in + let suc_thm = MK_SUC n in + TRANS lthm suc_thm;; + + +let rec MK_LT = + let f(n1,n2) = prove(mk_binop nle (mk_suc n1) (mk_suc n2),ARITH_TAC) in + let size1 = 20 in + let size2 = 20 in + let range1 = 0--size1 in + let range2 = 0--size2 in + let range = filter (fun (x,y) -> x <= y) (allpairs (fun x y -> x,y) range1 range2) in + let suc_tbl = Hashtbl.create (size1 * size2) in + map2 (Hashtbl.add suc_tbl) range (map f range); + fun (n1,n2) -> + try Hashtbl.find suc_tbl (n1,n2) with _ -> f(n1,n2);; + + +(* +let vars,i,const_thm,mat_thm = !ti,!tconst,!tmat +#trace MATINSERT +*) + + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let MATINSERT vars i const_thm cont mat_thm = + let start_time = Sys.time() in + let res = MATINSERT vars i const_thm cont mat_thm in + matinsert_timer +.= (Sys.time() -. start_time); + res;; + + + +(* + +let vars,i,const_thm, cont,mat_thm = +[ry;rx], +0, +ASSUME `-- &1 < &0`, +I, +ASSUME `interpmat [x_24] [\x. &0 + x * &1] [[Neg]; [Zero]; [Pos]]` + +MATINSERT vars i const_thm cont mat_thm + + +let vars,i,const_thm, cont,mat_thm = +[ry;rx], +0, +ASSUME `&0 + x * &1 < &0`, +I, +ASSUME `interpmat [] [\y. &1] [[Pos]]` + +MATINSERT vars i const_thm cont mat_thm + + +let vars,i,const_thm, cont,mat_thm = +[`x:real`; `a:real`; `b:real`; `c:real`], +0, +ASSUME `&0 + a * &2 < &0`, +I, +ASSUME `interpmat [x_408] [\x. (&0 + b * &1) + x * (&0 + a * &2)] [[Pos]; [Zero]; [Neg]]` + +MATINSERT vars i const_thm cont mat_thm + +*) diff --git a/Rqe/matinsert_thms.ml b/Rqe/matinsert_thms.ml new file mode 100644 index 0000000..6119b3e --- /dev/null +++ b/Rqe/matinsert_thms.ml @@ -0,0 +1,6 @@ + +let matinsert_lem0 = prove_by_refinement( + `!S. (!x. P x) ==> (!x. S x ==> P x)`, +(* {{{ Proof *) + [MESON_TAC[]]);; +(* }}} *) diff --git a/Rqe/num_calc_simp.ml b/Rqe/num_calc_simp.ml new file mode 100644 index 0000000..4628959 --- /dev/null +++ b/Rqe/num_calc_simp.ml @@ -0,0 +1,50 @@ + + +(* PUT BASIC ARITHMETIC OF THE NATURALS INTO THE SIMPLIFIER *) + +(* based on NUM_RED_CONV in num_calc *) + +let arith_ss thml = itlist (fun (x,y) ss -> ss_of_conv x y ss) + [`SUC(NUMERAL n)`,NUM_SUC_CONV; + `PRE(NUMERAL n)`,NUM_PRE_CONV; + `FACT(NUMERAL n)`,NUM_FACT_CONV; + `NUMERAL m < NUMERAL n`,NUM_REL_CONV; + `NUMERAL m <= NUMERAL n`,NUM_REL_CONV; + `NUMERAL m > NUMERAL n`,NUM_REL_CONV; + `NUMERAL m >= NUMERAL n`,NUM_REL_CONV; + `NUMERAL m = NUMERAL n`,NUM_REL_CONV; + `EVEN(NUMERAL n)`,NUM_EVEN_CONV; + `ODD(NUMERAL n)`,NUM_ODD_CONV; + `NUMERAL m + NUMERAL n`,NUM_ADD_CONV; + `NUMERAL m - NUMERAL n`,NUM_SUB_CONV; + `NUMERAL m * NUMERAL n`,NUM_MULT_CONV; + `(NUMERAL m) EXP (NUMERAL n)`,NUM_EXP_CONV; + `(NUMERAL m) DIV (NUMERAL n)`,NUM_DIV_CONV; + `(NUMERAL m) MOD (NUMERAL n)`,NUM_MOD_CONV] + (basic_ss thml);; + +let ARITH_SIMP_CONV thl = SIMPLIFY_CONV (arith_ss []) thl;; + +let arith_net() = itlist (uncurry net_of_conv) + [`SUC(NUMERAL n)`,NUM_SUC_CONV; + `PRE(NUMERAL n)`,NUM_PRE_CONV; + `FACT(NUMERAL n)`,NUM_FACT_CONV; + `NUMERAL m < NUMERAL n`,NUM_REL_CONV; + `NUMERAL m <= NUMERAL n`,NUM_REL_CONV; + `NUMERAL m > NUMERAL n`,NUM_REL_CONV; + `NUMERAL m >= NUMERAL n`,NUM_REL_CONV; + `NUMERAL m = NUMERAL n`,NUM_REL_CONV; + `EVEN(NUMERAL n)`,NUM_EVEN_CONV; + `ODD(NUMERAL n)`,NUM_ODD_CONV; + `NUMERAL m + NUMERAL n`,NUM_ADD_CONV; + `NUMERAL m - NUMERAL n`,NUM_SUB_CONV; + `NUMERAL m * NUMERAL n`,NUM_MULT_CONV; + `(NUMERAL m) EXP (NUMERAL n)`,NUM_EXP_CONV; + `(NUMERAL m) DIV (NUMERAL n)`,NUM_DIV_CONV; + `(NUMERAL m) MOD (NUMERAL n)`,NUM_MOD_CONV] + (basic_net());; + +let ARITH_REWRITE_CONV thl = + GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (arith_net()) thl;; + +let ARITH_SIMP_TAC thl = CONV_TAC (ARITH_SIMP_CONV thl);; diff --git a/Rqe/pdivides.ml b/Rqe/pdivides.ml new file mode 100644 index 0000000..500fa7b --- /dev/null +++ b/Rqe/pdivides.ml @@ -0,0 +1,90 @@ + +(* ---------------------------------------------------------------------- *) +(* PDIVIDES *) +(* ---------------------------------------------------------------------- *) + +let PDIVIDES vars sgns p q = + let s_thm = FINDSIGN vars sgns (head vars q) in + let op,l1,r1 = get_binop (concl s_thm) in + if op = req then failwith "PDIVIDES : head coefficient is zero" else + let div_thm = PDIVIDE vars p q in + let asx,pqr = dest_eq (concl div_thm) in + let pq,r = dest_plus pqr in + let p',q' = dest_mult pq in + let ak,s = dest_mult asx in + let a,k = dest_pow ak in + let k' = dest_small_numeral k in + if op = rgt or even k' then + r,div_thm + else if odd k' & op = rlt then + let par_thm = PARITY_CONV k in + let mp_thm = MATCH_MPL[neg_odd_lem;div_thm;par_thm] in + let mp_thm1 = (CONV_RULE (LAND_CONV (LAND_CONV (LAND_CONV POLY_NEG_CONV)))) mp_thm in + let mp_thm2 = (CONV_RULE (RAND_CONV (LAND_CONV (LAND_CONV (POLY_NEG_CONV))))) mp_thm1 in + let mp_thm3 = (CONV_RULE (RAND_CONV (RAND_CONV POLY_NEG_CONV))) mp_thm2 in + let ret = (snd o dest_plus o rhs o concl) mp_thm3 in + ret,mp_thm3 + else if odd k' & op = rneq then + let par_thm = PARITY_CONV k in + let mp_thm = MATCH_MPL[mul_odd_lem;div_thm;par_thm] in + let mp_thm1 = (CONV_RULE (LAND_CONV (LAND_CONV (LAND_CONV (POLYNATE_CONV vars))))) mp_thm in + let mp_thm2 = (CONV_RULE (RAND_CONV (LAND_CONV (POLYNATE_CONV vars)))) mp_thm1 in + let mp_thm3 = (CONV_RULE (RAND_CONV (RAND_CONV (POLY_MUL_CONV vars)))) mp_thm2 in + let ret = (snd o dest_plus o rhs o concl) mp_thm3 in + ret,mp_thm3 + else failwith "PDIVIDES: 1";; + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let PDIVIDES vars sgns mat_thm div_thms = + let start_time = Sys.time() in + let res = PDIVIDES vars sgns mat_thm div_thms in + pdivides_timer +.= (Sys.time() -. start_time); + res;; + + + +(* +PDIVIDES vars sgns p +let q = (ith 2 qs) + + +let vars = [`x:real`;`y:real`];; +let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 < &0`];; +let q = rhs(concl (POLYNATE_CONV vars `x * y`));; +let p = rhs(concl (POLYNATE_CONV vars `&1 + y * x * x + x * x * x * &5 * y`));; +PDIVIDE vars p q;; +PDIVIDES vars sgns p q;; + +let vars = [`x:real`;`y:real`];; +let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 > &0`];; +let q = rhs(concl (POLYNATE_CONV vars `x * x * y`));; +let p = rhs(concl (POLYNATE_CONV vars `&1 + x * x + x * x * x * y`));; +PDIVIDE vars p q;; +PDIVIDES vars sgns p q;; + + +let vars = [`x:real`;`y:real`];; +let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 < &0`];; +let q = rhs(concl (POLYNATE_CONV vars `x * x * y`));; +let p = rhs(concl (POLYNATE_CONV vars `&1 + x * x + x * x * x * y`));; +PDIVIDE vars p q;; +PDIVIDES vars sgns p q;; + +let vars = [`x:real`;`y:real`];; +let sgns = [ASSUME `&0 + y * &1 < &0`];; +let q = rhs(concl (POLYNATE_CONV vars `-- x:real`));; +let p = rhs(concl (POLYNATE_CONV vars `x * x * y`));; +PDIVIDE vars p q;; +PDIVIDES vars sgns p q + +let vars = [`x:real`;`y:real`];; +let sgns = [ARITH_RULE `&1 > &0`;ASSUME `&0 + y * &1 <> &0`];; +let q = rhs(concl (POLYNATE_CONV vars `x * x * y`));; +let p = rhs(concl (POLYNATE_CONV vars `&1 + x * x + x * x * x * y`));; +PDIVIDE vars p q;; +PDIVIDES vars sgns p q;; + +*) diff --git a/Rqe/pdivides_thms.ml b/Rqe/pdivides_thms.ml new file mode 100644 index 0000000..170ec14 --- /dev/null +++ b/Rqe/pdivides_thms.ml @@ -0,0 +1,50 @@ +let neg_odd_lem = prove_by_refinement( + `!a n p c q d. + (a pow n * p x = c x * q x + d x) ==> + ODD n ==> + ((-- a) pow n * p x = (-- c x) * q x + (-- d x))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[REAL_ARITH `-- x * y = -- (x * y)`]; + REWRITE_TAC[REAL_ARITH `-- x + -- y = -- (x + y)`]; + CLAIM `-- a pow n = -- (a pow n)`; + DISJ_CASES_TAC (ARITH_RULE `a < &0 \/ (a = &0) \/ a > &0`); + MP_TAC (ISPECL[`a:real`;`n:num`] REAL_POW_NEG); + ASM_REWRITE_TAC[GSYM NOT_ODD]; + POP_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[real_pow]; + CLAIM `~(n = 0)`; + ASM_MESON_TAC[ODD]; + STRIP_TAC; + CLAIM `?n'. n = SUC n'`; + ASM_MESON_TAC[num_CASES]; + STRIP_TAC; + ASM_REWRITE_TAC[real_pow]; + REAL_ARITH_TAC; + MP_TAC (ISPECL[`a:real`;`n:num`] REAL_POW_NEG); + ASM_REWRITE_TAC[GSYM NOT_ODD]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ARITH_RULE `-- x * y = -- (x * y)`]; + REWRITE_TAC[ARITH_RULE `(-- x = -- y) <=> (x = y)`]; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; + +(* }}} *) + +let mul_odd_lem = prove_by_refinement( + `!a n p c q d. + (a pow n * p x = c x * q x + d x) ==> + ODD n ==> + ((a * a pow n) * p x = (a * c x) * q x + (a * d x))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[REAL_ARITH `(a * x) * y = a * (x * y)`]; + REWRITE_TAC[REAL_ARITH `a * x + a * y = a * (x + y)`]; + AP_TERM_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) diff --git a/Rqe/poly_ext.ml b/Rqe/poly_ext.ml new file mode 100644 index 0000000..524bd7a --- /dev/null +++ b/Rqe/poly_ext.ml @@ -0,0 +1,772 @@ +let poly_tm = `poly`;; + +let dest_poly tm = + let poly,[l;var] = strip_ncomb 2 tm in + if not (poly = poly_tm) then failwith "dest_poly: not a poly" + else l,var;; + +let is_poly tm = fst (strip_comb tm) = `poly`;; + +(* ------------------------------------------------------------------------- *) +(* Get the lead variable in polynomial; &1 if a constant. *) +(* ------------------------------------------------------------------------- *) + +let polyvar = + let dummy_tm = `&1` in + fun tm -> if is_ratconst tm then dummy_tm else lhand(rand tm);; + + +(* +let k00 = `&3 * x * y pow 2 + &2 * x pow 2 * y * z + z * x + &3 * y * z` +let k0 = `(&0 + y * (&0 + z * &3)) + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))`;; +# polyvar k0;; +val it : Term.term = `x` +*) + +(* ---------------------------------------------------------------------- *) +(* Is a constant polynomial (wrt variable ordering) *) +(* ---------------------------------------------------------------------- *) + +let is_constant vars p = + assert (not (vars = [])); + try + let l,r = dest_plus p in + let x,r2 = dest_mult r in + if x = hd vars then false else true + with _ -> + if p = hd vars then false else true;; + +(* ------------------------------------------------------------------------- *) +(* We only use this as a handy way to do derivatives. *) +(* ------------------------------------------------------------------------- *) + +let POLY = prove + (`(poly [] x = &0) /\ + (poly [__c__] x = __c__) /\ + (poly (CONS __h__ __t__) x = __h__ + x * poly __t__ x)`, + REWRITE_TAC[poly] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Convert in and out of list representations. *) +(* ------------------------------------------------------------------------- *) + +(* THIS IS BAD CODE!!! It depends on the names of the variables in POLY *) +let POLY_ENLIST_CONV vars = + let lem = GEN rx POLY in + let [cnv_0; cnv_1; cnv_2] = + map (fun th -> GEN_REWRITE_CONV I [GSYM th]) (CONJUNCTS (ISPEC (hd vars) lem)) + and zero_tm = rzero in + let rec conv tm = + if polyvar tm = hd vars then + (funpow 2 RAND_CONV conv THENC cnv_2) tm + else if tm = zero_tm then cnv_0 tm + else cnv_1 tm in + conv;; + + +(* +map GSYM (CONJUNCTS (ISPEC (hd vars) lem)) + +POLY_ENLIST_CONV vars p in + +let tm = `&0 + c * &1` + + + +POLY_ENLIST_CONV vars tm + +#trace conv +POLY_ENLIST_CONV vars tm +let vars = [ry;rx] +let tm = `&0 + y * (&0 + x * &1)` + + +let k1 = rhs(concl (POLY_ENLIST_CONV [`x:real`;`y:real`;`z:real`] k0));; +POLY_ENLIST_CONV [`x:real`;`y:real`;`z:real`] k0;; +val it : Hol.thm = + |- k0 = + poly [&0 + y * (&0 + z * &3); + &0 * z * &1 + y * (&0 + y * &3); + &0 + y * (&0 + z * &2)] x +*) + +let POLY_DELIST_CONV = + let [cnv_0; cnv_1; cnv_2] = + map (fun th -> GEN_REWRITE_CONV I [th]) (CONJUNCTS POLY) in + let rec conv tm = + (cnv_0 ORELSEC cnv_1 ORELSEC (cnv_2 THENC funpow 2 RAND_CONV conv)) tm in + conv;; + +(* +# POLY_DELIST_CONV `poly [&5; &6; &7] x`;; +val it : Hol.thm = |- poly [&5; &6; &7] x = &5 + x * (&6 + x * &7) +*) + +(* ------------------------------------------------------------------------- *) +(* Differentiation within list representation. *) +(* ------------------------------------------------------------------------- *) + +(* let poly_diff_aux = new_recursive_definition list_RECURSION *) +(* `(poly_diff_aux n [] = []) /\ *) +(* (poly_diff_aux n (CONS h t) = CONS (&n * h) (poly_diff_aux (SUC n) t))`;; *) + +(* let poly_diff = new_definition *) +(* `poly_diff l = if l = [] then [] else poly_diff_aux 1 (TL l)`;; *) + +let POLY_DIFF_CLAUSES = prove + (`(poly_diff [] = []) /\ + (poly_diff [c] = []) /\ + (poly_diff (CONS h t) = poly_diff_aux 1 t)`, + REWRITE_TAC[poly_diff; NOT_CONS_NIL; HD; TL; poly_diff_aux]);; + +let POLY_DIFF_LEMMA = prove + (`!l n x. ((\x. (x pow (SUC n)) * poly l x) diffl + ((x pow n) * poly (poly_diff_aux (SUC n) l) x))(x)`, +(* {{{ Proof *) + + LIST_INDUCT_TAC THEN + REWRITE_TAC[poly; poly_diff_aux; REAL_MUL_RZERO; DIFF_CONST] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN + REWRITE_TAC[REAL_LDISTRIB; REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM(ONCE_REWRITE_RULE[REAL_MUL_SYM] (CONJUNCT2 pow))] THEN + POP_ASSUM(MP_TAC o SPECL [`SUC n`; `x:real`]) THEN + SUBGOAL_THEN `(((\x. (x pow (SUC n)) * h)) diffl + ((x pow n) * &(SUC n) * h))(x)` + (fun th -> DISCH_THEN(MP_TAC o CONJ th)) THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(SPEC `\x. x pow (SUC n)` DIFF_CMUL) THEN BETA_TAC THEN + DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(SPEC `SUC n` DIFF_POW) THEN REWRITE_TAC[SUC_SUB1] THEN + DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[REAL_MUL_SYM]); + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC]]);; + +(* }}} *) + +let POLY_DIFF = prove + (`!l x. ((\x. poly l x) diffl (poly (poly_diff l) x))(x)`, +(* {{{ Proof *) + + LIST_INDUCT_TAC THEN REWRITE_TAC[POLY_DIFF_CLAUSES] THEN + ONCE_REWRITE_TAC[SYM(ETA_CONV `\x. poly l x`)] THEN + REWRITE_TAC[poly; DIFF_CONST] THEN + MAP_EVERY X_GEN_TAC [`x:real`] THEN + MP_TAC(SPECL [`t:(real)list`; `0`; `x:real`] POLY_DIFF_LEMMA) THEN + REWRITE_TAC[SYM(num_CONV `1`)] THEN REWRITE_TAC[pow; REAL_MUL_LID] THEN + REWRITE_TAC[POW_1] THEN + DISCH_THEN(MP_TAC o CONJ (SPECL [`h:real`; `x:real`] DIFF_CONST)) THEN + DISCH_THEN(MP_TAC o MATCH_MP DIFF_ADD) THEN BETA_TAC THEN + REWRITE_TAC[REAL_ADD_LID]);; + +(* }}} *) + +let CANON_POLY_DIFF_CONV = + let aux_conv0 = GEN_REWRITE_CONV I [CONJUNCT1 poly_diff_aux] + and aux_conv1 = GEN_REWRITE_CONV I [CONJUNCT2 poly_diff_aux] + and diff_conv0 = GEN_REWRITE_CONV I (butlast (CONJUNCTS POLY_DIFF_CLAUSES)) + and diff_conv1 = GEN_REWRITE_CONV I [last (CONJUNCTS POLY_DIFF_CLAUSES)] in + let rec POLY_DIFF_AUX_CONV tm = + (aux_conv0 ORELSEC + (aux_conv1 THENC + RAND_CONV (LAND_CONV NUM_SUC_CONV THENC POLY_DIFF_AUX_CONV))) tm in + diff_conv0 ORELSEC + (diff_conv1 THENC POLY_DIFF_AUX_CONV);; + +(* + +# POLY_DIFF_CONV (mk_comb(`poly_diff`,k2));; +val it : Hol.thm = + |- poly_diff k2 = + [&1 * (&0 * z * &1 + y * (&0 + y * &3)); &2 * (&0 + y * (&0 + z * &2))] +*) + +(* ------------------------------------------------------------------------- *) +(* Whether the first of two items comes earlier in the list. *) +(* ------------------------------------------------------------------------- *) + +let rec earlier l x y = + match l with + h::t -> if h = y then false + else if h = x then true + else earlier t x y + | [] -> false;; + +(* ------------------------------------------------------------------------- *) +(* Add polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_ADD_CONV = + let [cnv_r; cnv_l; cnv_2; cnv_0] = (map REWR_CONV o CONJUNCTS o REAL_ARITH) + `(pol1 + (d + y * q) = (pol1 + d) + y * q) /\ + ((c + x * p) + pol2 = (c + pol2) + x * p) /\ + ((c + x * p) + (d + x * q) = (c + d) + x * (p + q)) /\ + (c + x * &0 = c)` + and dest_add = dest_binop `(+)` in + let rec POLY_ADD_CONV vars tm = + let pol1,pol2 = dest_add tm in + let x = polyvar pol1 and y = polyvar pol2 in + if not(is_var x) & not(is_var y) then REAL_RAT_REDUCE_CONV tm else + if not(is_var y) or earlier vars x y then + (cnv_l THENC LAND_CONV (POLY_ADD_CONV vars)) tm + else if not(is_var x) or earlier vars y x then + (cnv_r THENC LAND_CONV (POLY_ADD_CONV vars)) tm + else + (cnv_2 THENC COMB_CONV(RAND_CONV(POLY_ADD_CONV vars)) THENC + TRY_CONV cnv_0) tm in + POLY_ADD_CONV;; + +(* +# POLY_ADD_CONV [`x:real`;`y:real`;`z:real`] (mk_binop `(+)` k0 k0) ;; +val it : Hol.thm = + |- ((&0 + y * (&0 + z * &3)) + + x * + (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) + + (&0 + y * (&0 + z * &3)) + + x * (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2))) = + (&0 + y * (&0 + z * &6)) + + x * (((&0 + z * &2) + y * (&0 + y * &6)) + x * (&0 + y * (&0 + z * &4))) +*) + +(* ------------------------------------------------------------------------- *) +(* Negate polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_NEG_CONV = + let cnv = REWR_CONV(REAL_ARITH `--(c + x * p) = --c + x * --p`) in + let rec POLY_NEG_CONV tm = + if is_ratconst(rand tm) then REAL_RAT_NEG_CONV tm else + (cnv THENC COMB_CONV(RAND_CONV POLY_NEG_CONV)) tm in + POLY_NEG_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Subtract polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_SUB_CONV = + let cnv = REWR_CONV real_sub in + fun vars -> cnv THENC RAND_CONV POLY_NEG_CONV THENC POLY_ADD_CONV vars;; + +(* ------------------------------------------------------------------------- *) +(* Multiply polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_MUL_CONV = + let [cnv_l1; cnv_r1; cnv_2; cnv_l0; cnv_r0] = + (map REWR_CONV o CONJUNCTS o REAL_ARITH) + `(pol1 * (d + y * q) = (pol1 * d) + y * (pol1 * q)) /\ + ((c + x * p) * pol2 = (c * pol2) + x * (p * pol2)) /\ + (pol1 * (d + x * q) = pol1 * d + (&0 + x * pol1 * q)) /\ + (&0 * pol2 = &0) /\ + (pol1 * &0 = &0)` + and dest_mul = dest_binop `( * )` + and zero_tm = `&0` in + let rec POLY_MUL_CONV vars tm = + let pol1,pol2 = dest_mul tm in + if pol1 = zero_tm then cnv_l0 tm + else if pol2 = zero_tm then cnv_r0 tm + else if is_ratconst pol1 & is_ratconst pol2 then REAL_RAT_MUL_CONV tm else + let x = polyvar pol1 and y = polyvar pol2 in + if not(is_var y) or earlier vars x y then + (cnv_r1 THENC COMB_CONV(RAND_CONV(POLY_MUL_CONV vars))) tm + else if not(is_var x) or earlier vars y x then + (cnv_l1 THENC COMB_CONV(RAND_CONV(POLY_MUL_CONV vars))) tm + else + (cnv_2 THENC COMB2_CONV (RAND_CONV(POLY_MUL_CONV vars)) + (funpow 2 RAND_CONV (POLY_MUL_CONV vars)) THENC + POLY_ADD_CONV vars) tm in + POLY_MUL_CONV;; + +(* + +# POLY_MUL_CONV [`x:real`;`y:real`;`z:real`] (mk_binop `( * )` k0 k0) ;; +val it : Hol.thm = + |- ((&0 + y * (&0 + z * &3)) + + x * + (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) * + ((&0 + y * (&0 + z * &3)) + + x * + (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) = + (&0 + y * (&0 + y * (&0 + z * (&0 + z * &9)))) + + x * + ((&0 + y * ((&0 + z * (&0 + z * &6)) + y * (&0 + y * (&0 + z * &18)))) + + x * + (((&0 + z * (&0 + z * &1)) + + y * (&0 + y * ((&0 + z * (&6 + z * &12)) + y * (&0 + y * &9)))) + + x * + ((&0 + y * ((&0 + z * (&0 + z * &4)) + y * (&0 + y * (&0 + z * &12)))) + + x * (&0 + y * (&0 + y * (&0 + z * (&0 + z * &4))))))) +*) + + +(* ------------------------------------------------------------------------- *) +(* Exponentiate polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLY_POW_CONV = + let [cnv_0; cnv_1] = map REWR_CONV (CONJUNCTS real_pow) + and zero_tm = `0` in + let rec POLY_POW_CONV vars tm = + if rand tm = zero_tm then cnv_0 tm else + (RAND_CONV num_CONV THENC cnv_1 THENC + RAND_CONV (POLY_POW_CONV vars) THENC + POLY_MUL_CONV vars) tm in + POLY_POW_CONV;; + +(* +# POLY_POW_CONV [`x:real`;`y:real`;`z:real`] (mk_binop `(pow)` k0 `2`) ;; +val it : Hol.thm = + |- ((&0 + y * (&0 + z * &3)) + + x * + (((&0 + z * &1) + y * (&0 + y * &3)) + x * (&0 + y * (&0 + z * &2)))) pow + 2 = + (&0 + y * (&0 + y * (&0 + z * (&0 + z * &9)))) + + x * + ((&0 + y * ((&0 + z * (&0 + z * &6)) + y * (&0 + y * (&0 + z * &18)))) + + x * + (((&0 + z * (&0 + z * &1)) + + y * (&0 + y * ((&0 + z * (&6 + z * &12)) + y * (&0 + y * &9)))) + + x * + ((&0 + y * ((&0 + z * (&0 + z * &4)) + y * (&0 + y * (&0 + z * &12)))) + + x * (&0 + y * (&0 + y * (&0 + z * (&0 + z * &4))))))) +*) + +(* ------------------------------------------------------------------------- *) +(* Convert expression to canonical polynomials. *) +(* ------------------------------------------------------------------------- *) + +let POLYNATE_CONV = + let cnv_var = REWR_CONV(REAL_ARITH `x = &0 + x * &1`) + and cnv_div = REWR_CONV real_div + and neg_tm = `(--)` + and add_tm = `(+)` + and sub_tm = `(-)` + and mul_tm = `( * )` + and pow_tm = `(pow)` + and div_tm = `(/)` in + let rec POLYNATE_CONV vars tm = + if is_var tm then cnv_var tm + else if is_ratconst tm then REFL tm else + let lop,r = dest_comb tm in + if lop = neg_tm + then (RAND_CONV(POLYNATE_CONV vars) THENC POLY_NEG_CONV) tm else + let op,l = dest_comb lop in + if op = pow_tm then + (LAND_CONV(POLYNATE_CONV vars) THENC POLY_POW_CONV vars) tm + else if op = div_tm then + (cnv_div THENC + COMB2_CONV (RAND_CONV(POLYNATE_CONV vars)) REAL_RAT_REDUCE_CONV THENC + POLY_MUL_CONV vars) tm else + let cnv = if op = add_tm then POLY_ADD_CONV + else if op = sub_tm then POLY_SUB_CONV + else if op = mul_tm then POLY_MUL_CONV + else failwith "POLYNATE_CONV: unknown operation" in + (BINOP_CONV (POLYNATE_CONV vars) THENC cnv vars) tm in + POLYNATE_CONV;; + +(* +POLYNATE_CONV [`x:real`;`y:real`] `x + y`;; +POLYNATE_CONV [`x:real`;`y:real`] `x * y + &2 * y`;; +*) + +(* ------------------------------------------------------------------------- *) +(* Pure term manipulation versions; will optimize eventually. *) +(* ------------------------------------------------------------------------- *) + +let poly_add_ = + let add_tm = `(+)` in + fun vars p1 p2 -> + rand(concl(POLY_ADD_CONV vars (mk_comb(mk_comb(add_tm,p1),p2))));; + +let poly_sub_ = + let sub_tm = `(-)` in + fun vars p1 p2 -> + rand(concl(POLY_SUB_CONV vars (mk_comb(mk_comb(sub_tm,p1),p2))));; + +let poly_mul_ = + let mul_tm = `( * )` in + fun vars p1 p2 -> + rand(concl(POLY_MUL_CONV vars (mk_comb(mk_comb(mul_tm,p1),p2))));; + +let poly_neg_ = + let neg_tm = `(--)` in + fun p -> rand(concl(POLY_NEG_CONV(mk_comb(neg_tm,p))));; + +let poly_pow_ = + let pow_tm = `(pow)` in + fun vars p k -> + rand(concl(POLY_POW_CONV vars + (mk_comb(mk_comb(pow_tm,p),mk_small_numeral k))));; + +(* ------------------------------------------------------------------------- *) +(* Get the degree of a polynomial. *) +(* ------------------------------------------------------------------------- *) + +let rec degree_ vars tm = + if polyvar tm = hd vars then 1 + degree_ vars (funpow 2 rand tm) + else 0;; + +(* ------------------------------------------------------------------------- *) +(* Get the list of coefficients. *) +(* ------------------------------------------------------------------------- *) + +let rec coefficients vars tm = + if polyvar tm = hd vars then (lhand tm)::coefficients vars (funpow 2 rand tm) + else [tm];; + +(* ------------------------------------------------------------------------- *) +(* Get the head constant. *) +(* ------------------------------------------------------------------------- *) + +let head vars p = last(coefficients vars p);; + +(* ---------------------------------------------------------------------- *) +(* Remove the head coefficient *) +(* ---------------------------------------------------------------------- *) + +let rec behead vars tm = + try + let c,r = dest_plus tm in + let x,p = dest_mult r in + if not (x = hd vars) then failwith "" else + let p' = behead vars p in + if p' = rzero then c + else mk_plus c (mk_mult x p') + with _ -> rzero;; + +(* +behead [`x:real`] `&1 + x * (&1 + x * (&0 + y * &1))` +*) + + +let BEHEAD = + let lem = ARITH_RULE `a + b * &0 = a` in + fun vars zthm tm -> + let tm' = behead vars tm in + (* note: pure rewrite is ok here, as tm is in canonical form *) + let thm1 = PURE_REWRITE_CONV[zthm] tm in + let thm2 = PURE_REWRITE_CONV[lem] (rhs(concl thm1)) in + let thm3 = TRANS thm1 thm2 in + thm3;; + +let BEHEAD3 = + let lem = ARITH_RULE `a + b * &0 = a` in + fun vars zthm tm -> + let tm' = behead vars tm in + (* note slight hack here: + BEHEAD was working fine if + p = a + x * b where a <> b. But + when they were equal, dropping multiple levels + broke the reconstruction. Thus, we only do conversion + on the right except when the head variable has been fully eliminated *) + let conv = + let l,r = dest_binop rp tm in + let l1,r1 = dest_binop rm r in + if l1 = hd vars then RAND_CONV(PURE_ONCE_REWRITE_CONV[zthm]) + else PURE_ONCE_REWRITE_CONV[zthm] in + let thm1 = conv tm in + let thm2 = PURE_REWRITE_CONV[lem] (rhs(concl thm1)) in + let thm3 = TRANS thm1 thm2 in + thm3;; + +let BEHEAD = BEHEAD3;; + + +(* +let vars = [`z:real`;`x:real`] +let zthm = (ASSUME `&0 + x * &1 = &0`) +let tm = `(&0 + x * &1) + z * (&0 + x * &1)` +behead vars tm +BEHEAD vars zthm tm +BEHEAD2 vars zthm tm +BEHEAD3 vars zthm tm + +let tm = `(&0 + x * &1)` +BEHEAD3 vars zthm tm + + + +let vars = [`x:real`] +let tm = `&1 + x * (&1 + x * (&0 + y * &1))` +let zthm = (ASSUME `&0 + y * &1 = &0`) +BEHEAD vars zthm tm +BEHEAD2 vars zthm tm + + + +*) + +(* ------------------------------------------------------------------------- *) +(* Test whether a polynomial is a constant w.r.t. the head variable. *) +(* ------------------------------------------------------------------------- *) + +let is_const_poly vars tm = polyvar tm <> hd vars;; + +(* ------------------------------------------------------------------------- *) +(* Get the constant multiple of the "maximal" monomial (implicit lex order) *) +(* ------------------------------------------------------------------------- *) + +let rec headconst p = + try rat_of_term p with Failure _ -> headconst(funpow 2 rand p);; + +(* ------------------------------------------------------------------------- *) +(* Monicize; return |- const * pol = monic-pol *) +(* ------------------------------------------------------------------------- *) + +let MONIC_CONV = + let mul_tm = `( * ):real->real->real` in + fun vars p -> + let c = Int 1 // headconst p in + POLY_MUL_CONV vars (mk_comb(mk_comb(mul_tm,term_of_rat c),p));; + +(* ------------------------------------------------------------------------- *) +(* Pseudo-division of s by p; head coefficient of p assumed nonzero. *) +(* Returns |- a^k s = p q + r for some q and r with deg(r) < deg(p). *) +(* Optimized only for the trivial case of equal head coefficients; no GCDs. *) +(* ------------------------------------------------------------------------- *) + +let PDIVIDE = + let zero_tm = `&0` + and add0_tm = `(+) (&0)` + and add_tm = `(+)` + and mul_tm = `( * )` + and pow_tm = `(pow)` + and one_tm = `&1` in + let mk_varpow vars k = + let mulx_tm = mk_comb(mul_tm,hd vars) in + funpow k (fun t -> mk_comb(add0_tm,mk_comb(mulx_tm,t))) one_tm in + let rec pdivide_aux vars a n p s = + if s = zero_tm then (0,zero_tm,s) else + let b = head vars s and m = degree_ vars s in + if m < n then (0,zero_tm,s) else + let xp = mk_varpow vars (m - n) in + let p' = poly_mul_ vars xp p in + if a = b then + let (k,q,r) = pdivide_aux vars a n p (poly_sub_ vars s p') in + (k,poly_add_ vars q (poly_mul_ vars xp (poly_pow_ vars a k)),r) + else + let (k,q,r) = pdivide_aux vars a n p + (poly_sub_ vars (poly_mul_ vars a s) (poly_mul_ vars b p')) in + let q' = poly_add_ vars q (poly_mul_ vars b + (poly_mul_ vars (poly_pow_ vars a k) xp)) in + (k+1,q',r) in + fun vars s p -> + let a = head vars p in + let (k,q,r) = pdivide_aux vars a (degree_ vars p) p s in + let th1 = POLY_MUL_CONV vars (mk_comb(mk_comb(mul_tm,q),p)) in + let th2 = AP_THM (AP_TERM add_tm th1) r in + let th3 = CONV_RULE(RAND_CONV(POLY_ADD_CONV vars)) th2 in + let th4 = POLY_POW_CONV vars + (mk_comb(mk_comb(pow_tm,a),mk_small_numeral k)) in + let th5 = AP_THM (AP_TERM mul_tm th4) s in + let th6 = CONV_RULE(RAND_CONV(POLY_MUL_CONV vars)) th5 in + TRANS th6 (GSYM th3);; + +(* ------------------------------------------------------------------------- *) +(* Produce sign theorem for rational constant. *) +(* ------------------------------------------------------------------------- *) + +let SIGN_CONST = + let zero = Int 0 + and zero_tm = `&0` + and eq_tm = `(=):real->real->bool` + and gt_tm = `(>):real->real->bool` + and lt_tm = `(<):real->real->bool` in + fun tm -> + let x = rat_of_term tm in + if x =/ zero then + EQT_ELIM(REAL_RAT_EQ_CONV(mk_comb(mk_comb(eq_tm,tm),zero_tm))) + else if x >/ zero then + EQT_ELIM(REAL_RAT_GT_CONV(mk_comb(mk_comb(gt_tm,tm),zero_tm))) + else + EQT_ELIM(REAL_RAT_LT_CONV(mk_comb(mk_comb(lt_tm,tm),zero_tm)));; + +(* +SIGN_CONST `-- &5`;; +val it : Hol.thm = |- &5 > &0 +*) + + +(* ------------------------------------------------------------------------- *) +(* Differentiation conversion in main representation. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DERIV_CONV = + let poly_diff_tm = `poly_diff` + and pth = GEN_REWRITE_RULE I [SWAP_FORALL_THM] POLY_DIFF in + fun vars tm -> + let th1 = POLY_ENLIST_CONV vars tm in + let th2 = SPECL [hd vars; lhand(rand(concl th1))] pth in + CONV_RULE(RATOR_CONV + (COMB2_CONV (RAND_CONV(ABS_CONV(POLY_DELIST_CONV))) + (LAND_CONV(CANON_POLY_DIFF_CONV THENC + LIST_CONV (POLY_MUL_CONV vars)) THENC + POLY_DELIST_CONV))) th2;; + +(* +let k0 = (rhs o concl) (POLYNATE_CONV [`x:real`] `x pow 2 * y`);; +let vars = [`x:real`] +let tm = k0 +let k1 = concl th2 +let k2 = rator k1 +let l,r = dest_comb k2 + +RATOR_CONV +(RAND_CONV(ABS_CONV(POLY_DELIST_CONV))) l +(LAND_CONV(POLY_DIFF_CONV THENC LIST_CONV (CANON_POLY_MUL_CONV vars)) THENC POLY_DELIST_CONV) r +(LAND_CONV(POLY_DIFF_CONV THENC LIST_CONV (CANON_POLY_MUL_CONV vars))) r +(LAND_CONV(POLY_DIFF_CONV)) r + + +POLY_DERIV_CONV [`x:real`] (rhs(concl((POLYNATE_CONV [`x:real`] `x pow 2 * y`))));; +val it : Hol.thm = + |- ((\x. &0 + x * (&0 + x * (&0 + y * &1))) diffl &0 + x * (&0 + y * &2)) x +*) + +(* ---------------------------------------------------------------------- *) +(* POLYATOM_CONV *) +(* ---------------------------------------------------------------------- *) + +(* + This is the AFN_CONV argument to the lifting function LIFT_QELIM_CONV +*) + +let lt_lem = prove_by_refinement( + `!x y. x < y <=> x - y < &0`, +(* {{{ Proof *) +[ + REAL_ARITH_TAC; +]);; +(* }}} *) + +let le_lem = prove_by_refinement( + `!x y. x <= y <=> x - y <= &0`, +(* {{{ Proof *) +[ + REAL_ARITH_TAC; +]);; +(* }}} *) + +let eq_lem = prove_by_refinement( + `!x y. (x = y) <=> (x - y = &0)`, +(* {{{ Proof *) +[ + REAL_ARITH_TAC; +]);; +(* }}} *) + +let POLYATOM_CONV vars tm = + let thm1 = ONCE_REWRITE_CONV[real_gt;real_ge;eq_lem] tm in + let l,r = dest_eq (concl thm1) in + let thm2 = ONCE_REWRITE_CONV[lt_lem;le_lem] r in + let op,l',r' = get_binop (rhs (concl thm2)) in + let thm3a = POLYNATE_CONV vars l' in + let thm3b = AP_TERM op thm3a in + let thm3 = AP_THM thm3b rzero in + end_itlist TRANS [thm1;thm2;thm3];; + +(* + +let k0 = `x pow 2 + y * x - &5 > x + &10` +let k0 = `x pow 2 + y * x - &5 >= x + &10` +let k0 = `x pow 2 + y * x - &5 < x + &10` +let k0 = `x pow 2 + y * x - &5 <= x + &10` +let k0 = `x pow 2 + y * x - &5 = x + &10` +let tm = k0;; +let vars = [`x:real`;`y:real`] +POLYATOM_CONV vars k0 + +let vars = [`e:real`; `k:real`;`f:real`;`a:real`] +prioritize_real() +let tm = `k < e` + +let liouville = + `&6 * (w pow 2 + x pow 2 + y pow 2 + z pow 2) pow 2 = + (((w + x) pow 4 + (w + y) pow 4 + (w + z) pow 4 + + (x + y) pow 4 + (x + z) pow 4 + (y + z) pow 4) + + ((w - x) pow 4 + (w - y) pow 4 + (w - z) pow 4 + + (x - y) pow 4 + (x - z) pow 4 + (y - z) pow 4))` + +let lvars = [`w:real`;`x:real`;`y:real`; `z:real`] + +POLYATOM_CONV lvars liouville + +*) + +(* ---------------------------------------------------------------------- *) +(* Factoring *) +(* ---------------------------------------------------------------------- *) + +let weakfactor x pol = + let rec weakfactor k x pol = + try + let ls,rs = dest_plus pol in + if not (ls = rzero) then failwith "" else + let lm,rm = dest_mult rs in + if not (lm = x) then failwith "" else + weakfactor (k + 1) x rm + with Failure _ -> + k,pol in + weakfactor 0 x pol;; + +let poly_var x = mk_plus rzero (mk_mult x rone);; +(* + poly_var rx +*) + +let POW_PROD_SUM = prove_by_refinement( + `!x n m. (x pow n) * x pow m = x pow (n + m)`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC THEN INDUCT_TAC; + REWRITE_TAC[real_pow]; + NUM_SIMP_TAC; + REAL_SIMP_TAC; + REWRITE_TAC[real_pow]; + REWRITE_TAC[ARITH_RULE `n + SUC m = SUC (n + m)`]; + REWRITE_TAC[real_pow]; + POP_ASSUM (SUBST1_TAC o GSYM); + REAL_ARITH_TAC; +]);; +(* }}} *) + +let lem1 = REAL_ARITH `x * x = x pow 2`;; +let lem2 = GSYM (CONJUNCT2 real_pow);; +let lem3 = REAL_ARITH `!x. x = x pow 1`;; + +let SIMP_POW_CONV tm = + let thm1 = ((REWRITE_CONV [GSYM REAL_MUL_ASSOC;lem1;lem2;POW_PROD_SUM]) THENC (ARITH_SIMP_CONV[])) tm in + let _,r = dest_eq (concl thm1) in + if can dest_pow r then thm1 else + let thm2 = ISPEC r lem3 in + thm2;; + +(* + SIMP_POW_CONV `x * x * x * x * x` + SIMP_POW_CONV `x * x * (x * x) * x` + SIMP_POW_CONV `x * (x * (x * x)) *(x * x)` + SIMP_POW_CONV `x:real` + +*) + + +let WEAKFACTOR_CONV x pol = + let k,pol' = weakfactor x pol in + let thm1 = ((itlist2 (fun x y z -> ((funpow y RAND_CONV) x) THENC z) + (replicate (GEN_REWRITE_CONV I [REAL_ADD_LID]) k) + (0--(k-1)) ALL_CONV) THENC + (PURE_REWRITE_CONV[REAL_MUL_ASSOC])) pol in + let thm2 = (CONV_RULE (RAND_CONV (LAND_CONV SIMP_POW_CONV))) thm1 in + thm2;; + + + +(* + let pol = `&0 + x * (&0 + x * (&0 + y * &1))` + let pol = `&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + y * &1))))))` + let pol = `&0 + x * (&0 + x * (&0 + x * (&0 + x * (&0 + x * (&1 + x * (&0 + y * &1))))))` + let pol = `&1 + x * (&0 + x * (&0 + y * &1))` + let pol = `&0 + x * (&1 + x * (&0 + y * &1))` + WEAKFACTOR_CONV rx pol + weakfactor rx pol + +*) diff --git a/Rqe/rewrites.ml b/Rqe/rewrites.ml new file mode 100644 index 0000000..5955ff7 --- /dev/null +++ b/Rqe/rewrites.ml @@ -0,0 +1,90 @@ +(* ---------------------------------------------------------------------- *) +(* Num *) +(* ---------------------------------------------------------------------- *) + +let NUM_REWRITES = ref [ +LT_TRANS; +LET_TRANS; +LTE_TRANS; +LE_TRANS; +GT; +GE; +PRE; +ARITH_RULE `x + 0 = x`; +ARITH_RULE `0 + x = x`; +ARITH_RULE `1 * x = x`; +ARITH_RULE `x * 1 = x`; +];; + +let NUM_SIMP_TAC = REWRITE_TAC !NUM_REWRITES;; + +let extend_num_rewrites l = + NUM_REWRITES := !NUM_REWRITES @ l;; + +(* ---------------------------------------------------------------------- *) +(* Real *) +(* ---------------------------------------------------------------------- *) + +(* +search [`(pow)`;rp] +*) + +let REAL_REWRITES = ref [ +REAL_MUL_LID; +REAL_MUL_RID; +REAL_MUL_RZERO; +REAL_MUL_LZERO; +REAL_LT_TRANS; +REAL_LET_TRANS; +REAL_LTE_TRANS; +REAL_LE_TRANS; +REAL_LE_MUL; +REAL_NOT_LT; +REAL_LT_REFL; +REAL_LE_REFL; +REAL_ADD_RID; +REAL_ADD_LID; +REAL_ADD_LDISTRIB; +REAL_ADD_RDISTRIB; +REAL_NEG_0; +REAL_NEG_MUL2; +REAL_OF_NUM_LT; +REAL_MAX_MAX; +real_pow; +REAL_ARITH `x - &0 = x`; +REAL_NOT_LT; +REAL_NOT_LE; +REAL_INV_INV; +REAL_INV_MUL; +real_gt; +real_ge; +REAL_POW_1; +ARITH_RULE `-- &1 * x = -- x`; +ARITH_RULE `-- &1 * -- &1 = &1`; +ARITH_RULE `-- (-- x * y) = x * y`; +ARITH_RULE `x - x = &0`; +REAL_POW_ONE; +REAL_NEG_NEG; +];; + +let REAL_ELIM = ref [ +REAL_LT_INV; +REAL_ADD_SYM; +REAL_ADD_ASSOC; +REAL_MUL_SYM; +REAL_MUL_ASSOC; +REAL_LT_LE; +REAL_LE_LT; +real_div; +];; + +let REAL_SIMP_TAC = REWRITE_TAC ( + !REAL_REWRITES +);; + +let REAL_SOLVE_TAC = ASM_MESON_TAC (!REAL_REWRITES @ !REAL_ELIM);; + +let extend_real_rewrites l = + REAL_REWRITES := !REAL_REWRITES @ l;; + +let BASIC_REWRITES = ref (!REAL_REWRITES @ !NUM_REWRITES);; diff --git a/Rqe/rol.ml b/Rqe/rol.ml new file mode 100644 index 0000000..c3b5fb2 --- /dev/null +++ b/Rqe/rol.ml @@ -0,0 +1,606 @@ +(* ---------------------------------------------------------------------- *) +(* Util *) +(* ---------------------------------------------------------------------- *) + +(* ---------------------------------------------------------------------- *) +(* Real Ordered Lists *) +(* ---------------------------------------------------------------------- *) + +let real_ordered_list = new_recursive_definition list_RECURSION + `(real_ordered_list [] <=> T) /\ + (real_ordered_list (CONS h t) <=> + real_ordered_list t /\ + ((t = []) \/ (h < HD t)))`;; + +let ROL_EMPTY = EQT_ELIM (CONJUNCT1 real_ordered_list);; + +let ROL_SING = prove_by_refinement( + `!x. real_ordered_list [x]`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_ordered_list]; +]);; +(* }}} *) + +let ROL_TAIL = prove( + `!l. ~(l = []) /\ real_ordered_list l ==> real_ordered_list (TL l)`, +(* {{{ Proof *) + LIST_INDUCT_TAC THEN + MESON_TAC[real_ordered_list;TL]; +);; +(* }}} *) + +let EL_CONS = prove_by_refinement( + `!l h n. EL n t = EL (SUC n) (CONS h t)`, +(* {{{ Proof *) +[ + MESON_TAC[TL;EL]; +]);; +(* }}} *) + +let NOT_ROL = prove_by_refinement( + `!l. ~(real_ordered_list l) ==> ?n. EL n l >= EL (SUC n) l`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[real_ordered_list]; + REWRITE_TAC[real_ordered_list;DE_MORGAN_THM]; + STRIP_TAC; + POP_ASSUM (fun x -> POP_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + STRIP_TAC; + EXISTS_TAC `SUC n`; + ASM_MESON_TAC[EL_CONS]; + EXISTS_TAC `0`; + REWRITE_TAC[EL;HD;TL;real_ge]; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; + +(* }}} *) + +let ROL_CONS = prove_by_refinement( + `!h t. real_ordered_list (CONS h t) ==> real_ordered_list t`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC; +]);; +(* }}} *) + +let ROL_CONS_CONS = prove_by_refinement( + `!h t. real_ordered_list (CONS h1 (CONS h2 t)) <=> + real_ordered_list (CONS h2 t) /\ h1 < h2`, +(* {{{ Proof *) + +[ + REPEAT GEN_TAC; + EQ_TAC; + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL;HD]; + ASM_MESON_TAC[NOT_CONS_NIL]; + ASM_MESON_TAC[HD]; + ASM_MESON_TAC[NOT_CONS_NIL]; + ASM_MESON_TAC[HD]; + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL;HD]; +]);; + +(* }}} *) + +let ROL_APPEND = prove_by_refinement( + `!l1 l2. real_ordered_list (APPEND l1 l2) ==> + real_ordered_list l1 /\ real_ordered_list l2`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + MESON_TAC[APPEND;real_ordered_list]; + GEN_TAC; + REWRITE_TAC[APPEND]; + STRIP_TAC; + CLAIM `real_ordered_list (APPEND t l2)`; + ASM_MESON_TAC[ROL_CONS]; + STRIP_TAC; + CLAIM `real_ordered_list t /\ real_ordered_list l2`; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + CASES_ON `t = []`; + ASM_MESON_TAC[real_ordered_list]; + POP_ASSUM MP_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC; + ASM_REWRITE_TAC[ROL_CONS_CONS]; + CONJ_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + USE_THEN "Z-4" MP_TAC; + POP_ASSUM SUBST1_TAC; + REWRITE_TAC[APPEND]; + ASM_MESON_TAC[ROL_CONS_CONS]; +]);; + +(* }}} *) + +let ROL_CONS_CONS_LT = prove_by_refinement( + `!h1 h2 t. real_ordered_list (CONS h1 (CONS h2 t)) ==> h1 < h2`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC THEN + ASM_MESON_TAC[NOT_CONS_NIL;HD]; +]);; +(* }}} *) + +let ROL_INSERT_THM = prove_by_refinement( + `!x l1 l2. + real_ordered_list l1 /\ real_ordered_list l2 /\ + ~(l1 = []) /\ ~(l2 = []) /\ LAST l1 < x /\ x < HD l2 ==> + real_ordered_list (APPEND l1 (CONS x l2))`, +(* {{{ Proof *) + +[ + GEN_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[APPEND;LAST_SING;NOT_CONS_NIL]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[ROL_CONS_CONS;real_ordered_list]; + POP_ASSUM MP_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + CLAIM `real_ordered_list (APPEND t (CONS x l2))`; + REWRITE_ASSUMS[TAUT `(p ==> q ==> r) <=> (p /\ q ==> r)`]; + FIRST_ASSUM MATCH_MP_TAC; + REPEAT STRIP_TAC; + ASM_MESON_TAC[ROL_CONS]; + FIRST_ASSUM MATCH_ACCEPT_TAC; + ASM_MESON_TAC[NOT_CONS_NIL]; + ASM_MESON_TAC[NOT_CONS_NIL]; + ASM_MESON_TAC[LAST_CONS;NOT_CONS_NIL]; + FIRST_ASSUM MATCH_ACCEPT_TAC; + ASM_REWRITE_TAC[]; + LABEL_ALL_TAC; + USE_THEN "Z-3" (SUBST1_TAC o GSYM); + REWRITE_TAC[APPEND]; + STRIP_TAC; + REWRITE_TAC[ROL_CONS_CONS]; + STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + ASM_MESON_TAC[ROL_CONS_CONS]; +]);; + +(* }}} *) + +let ROL_INSERT_FRONT_THM = prove_by_refinement( + `!x l. real_ordered_list l /\ ~(l = []) /\ x < HD l ==> + real_ordered_list (CONS x l)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[NOT_NIL;AND_IMP_THM]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[ROL_CONS_CONS;HD]; +]);; + +(* }}} *) + +let ROL_CONS_CONS_DELETE = prove_by_refinement( + `!h1 h2 t. real_ordered_list (CONS h1 (CONS h2 t)) ==> + real_ordered_list (CONS h1 t)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[NOT_CONS_NIL]; + REWRITE_ASSUMS[HD]; + ASM_MESON_TAC[REAL_LT_TRANS]; +]);; +(* }}} *) + +let LAST_CONS_LT = prove_by_refinement( + `!x t h. real_ordered_list (CONS h t) /\ LAST (CONS h t) < x ==> h < x`, +(* {{{ Proof *) + +[ + GEN_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[LAST]; + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + CONJ_TAC; + ASM_MESON_TAC[ROL_CONS_CONS_DELETE]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[LAST]; + ASM_MESON_TAC[LAST;ROL_CONS_CONS;REAL_LT_TRANS]; + ASM_MESON_TAC[LAST_CONS;ROL_CONS_CONS_DELETE;LAST_CONS_CONS]; +]);; + +(* }}} *) + +let ROL_INSERT_BACK_THM = prove_by_refinement( + `!x l. real_ordered_list l /\ ~(l = []) /\ LAST l < x ==> + real_ordered_list (APPEND l [x])`, +(* {{{ Proof *) + +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND;ROL_SING]; + LABEL_ALL_TAC; + STRIP_TAC; + CASES_ON `t = []`; + ASM_REWRITE_TAC[APPEND;ROL_CONS_CONS;ROL_SING]; + ASM_MESON_TAC[LAST;COND_CLAUSES]; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[ROL_CONS]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[LAST_CONS]; + REWRITE_TAC[APPEND]; + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + DISJ2_TAC; + REWRITE_ASSUMS[NOT_NIL]; + LABEL_ALL_TAC; + USE_IASSUM 2 MP_TAC; + STRIP_TAC; + ASM_REWRITE_TAC[HD_APPEND]; + ASM_MESON_TAC[ROL_CONS_CONS]; +]);; + +(* }}} *) + +(* + CHOP_REAL_LIST 1 `[&1; &2; &3]` --> |- [&1; &2; &3] = APPEND [&1; &2] [&3] + let n,l = 1,`[&1; &2; &3]` +*) +let CHOP_REAL_LIST n l = + let l' = dest_list l in + let l1',l2' = chop_list n l' in + let l1,l2 = mk_list (l1',real_ty),mk_list (l2',real_ty) in + let tm = mk_binop rappend l1 l2 in + GSYM (REWRITE_CONV [APPEND] tm);; + + +(* + ROL_CHOP_LT 2 + let n = 1 +*) +let ROL_CHOP_LT n thm = + let thm' = funpow (n - 1) (MATCH_MP ROL_CONS) thm in + CONJUNCT2 (PURE_REWRITE_RULE[ROL_CONS_CONS] thm');; + +let t1 = prove_by_refinement( + `real_ordered_list [&1; &2; &3; &4]`, +[ + REWRITE_TAC[HD;real_ordered_list]; + REAL_ARITH_TAC; +]);; + +(* +ROL_CHOP_LIST 2 |- real_ordered_list [&1; &2; &3; &4] --> + |- real_ordered_list [&1; &2; &3], + |- real_ordered_list [&4], + |- &3 < &4 +let thm = ASSUME `real_ordered_list [&1; &2; &3; &4]` +let n = 2 +ROL_CHOP_LIST 2 thm +*) +let ROL_CHOP_LIST n thm = + let _,l = dest_comb (concl thm) in + let lthm = CHOP_REAL_LIST n l in + let thm' = REWRITE_RULE[lthm] thm in + let thm'' = MATCH_MP ROL_APPEND thm' in + let [lthm;rthm] = CONJUNCTS thm'' in + let lt_thm = ROL_CHOP_LT n thm in + lthm,rthm,lt_thm;; + +(* +rol_insert (|- x1 < x4 /\ x4 < x2) + (|- real_ordered_list [x1; x2; x3]) --> + (|- real_ordered_list [x1; x4; x2; x3]); + +rol_insert (|- &2 < &5 /\ &5 < &6) (|- real_ordered_list [&1; &2; &6]) --> + (|- real_ordered_list [&1; &2; &5; &6]); + +rol_insert (|- x4 < x1) + (|- real_ordered_list [x1; x2; x3]) --> + (|- real_ordered_list [x4; x1; x2; x3]); + +rol_insert (|- x1 < x4) + (|- real_ordered_list [x1; x2; x3]) --> + (|- real_ordered_list [x1; x2; x3; x4]); +*) + +let lem1 = prove( + `!e x l. e < x /\ (LAST l = e) ==> LAST l < x`, + MESON_TAC[]);; + +let ROL_INSERT_MIDDLE place_thm rol_thm = + let [pl1;pl2] = CONJUNCTS place_thm in + let list = snd(dest_comb(concl rol_thm)) in + let new_x,slot = + let ltl,ltr = dest_conj (concl place_thm) in + let x1,x4 = dest_binop rlt ltl in + let _,x2 = dest_binop rlt ltr in + let n = (index x1 (dest_list list)) + 1 in + x4,n in + let lthm,rthm,lt_thm = ROL_CHOP_LIST slot rol_thm in + let llist = snd(dest_comb(concl lthm)) in + let hllist = hd (dest_list llist) in + let tllist = mk_rlist (tl (dest_list llist)) in + let rlist = snd(dest_comb(concl rthm)) in + let hrlist = hd (dest_list rlist) in + let trlist = mk_rlist (tl (dest_list rlist)) in + let gthm = REWRITE_RULE[AND_IMP_THM] ROL_INSERT_THM in + let a1 = lthm in + let a2 = rthm in + let a3 = ISPECL [hllist;tllist] NOT_CONS_NIL in + let a4 = ISPECL [hrlist;trlist] NOT_CONS_NIL in + let l,r = dest_binop rlt (concl pl1) in + let a5_aux = prove(mk_eq (mk_comb(rlast,llist),l),REWRITE_TAC[LAST;COND_CLAUSES;NOT_CONS_NIL]) in + let a5 = MATCH_MPL [ISPECL [l;r;llist] (REWRITE_RULE[AND_IMP_THM] lem1);pl1;a5_aux] in + let a6_aux = ISPECL [trlist;hrlist] (GEN_ALL HD) in + let a6 = CONV_RULE (RAND_CONV (ONCE_REWRITE_CONV[GSYM a6_aux])) pl2 in + let thm = MATCH_MPL [gthm;a1;a2;a3;a4;a5;a6] in + REWRITE_RULE[APPEND] thm;; + +(* +ROL_INSERT_MIDDLE (ASSUME `x1 < x4 /\ x4 < x2`) + (ASSUME `real_ordered_list [x1; x2; x3]`);; + +ROL_INSERT_MIDDLE (ASSUME `x1 < x6 /\ x6 < x2`) + (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`);; + +ROL_INSERT_MIDDLE (ASSUME `x2 < x6 /\ x6 < x3`) + (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`);; + +ROL_INSERT_MIDDLE (ASSUME `x4 < x6 /\ x6 < x5`) + (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`);; + +ROL_INSERT_MIDDLE (ASSUME `x2 < x4 /\ x4 < x3`) + (ASSUME `real_ordered_list [x1; x2; x3]`);; + +*) + + +let ROL_INSERT_FRONT place_thm rol_thm = + let _,rlist = dest_comb (concl rol_thm) in + let h,t = hd (dest_list rlist),mk_rlist (tl (dest_list rlist)) in + let imp_thm = ISPECL [h;t] (GSYM ROL_CONS_CONS) in + let imp_thm' = REWRITE_RULE[AND_IMP_THM] (fst (EQ_IMP_RULE imp_thm)) in + MATCH_MPL[imp_thm';rol_thm;place_thm];; + +(* +ROL_INSERT_FRONT (ASSUME `x4 < x1`) + (ASSUME `real_ordered_list [x1; x2; x3]`);; +ROL_INSERT_FRONT (ASSUME `x4 < x1`) + (ASSUME `real_ordered_list [x1]`);; +*) + +let ROL_INSERT_BACK place_thm rol_thm = + let _,rlist = dest_comb (concl rol_thm) in + let rlist' = dest_list rlist in + let h,t = hd rlist',mk_rlist (tl rlist') in + let lst = last rlist' in + let b,x = dest_binop rlt (concl place_thm) in + let imp_thm = REWRITE_RULE[AND_IMP_THM] + (ISPECL [x;rlist] ROL_INSERT_BACK_THM) in + let a1 = rol_thm in + let a2 = ISPECL [h;t] NOT_CONS_NIL in + let a3_aux = prove(mk_eq (mk_comb(rlast,rlist),lst), + REWRITE_TAC[LAST;COND_CLAUSES;NOT_CONS_NIL]) in + let a3 = MATCH_MPL [ISPECL [lst;x;rlist] + (REWRITE_RULE[AND_IMP_THM] lem1);place_thm;a3_aux] in + REWRITE_RULE[APPEND] (MATCH_MPL[imp_thm;a1;a2;a3]);; + +(* +ROL_INSERT_BACK (ASSUME `x3 < x4`) + (ASSUME `real_ordered_list [x1; x2; x3]`);; +*) + +let ROL_INSERT place_thm rol_thm = + let place_thm' = REWRITE_RULE[real_gt] place_thm in + if is_conj (concl place_thm') then ROL_INSERT_MIDDLE place_thm' rol_thm + else + let _,rlist = dest_comb (concl rol_thm) in + let rlist' = dest_list rlist in + let h = hd rlist' in + let l,r = dest_binop rlt (concl place_thm') in + if r = h then ROL_INSERT_FRONT place_thm' rol_thm + else ROL_INSERT_BACK place_thm' rol_thm;; + +(* +let k00 = ROL_INSERT (ASSUME `x1 < x4 /\ x4 < x2`) + (ASSUME `real_ordered_list [x1; x2; x3]`);; + +rol_thms k00 + +PARTITION_LINE_CONV `[x1; x4; x2; x3:real]` + +ROL_INSERT (ASSUME `x4 < x1`) + (ASSUME `real_ordered_list [x1]`);; + +ROL_INSERT (ASSUME `x3 < x4`) + (ASSUME `real_ordered_list [x1; x2; x3]`);; + +*) + + +(* + rol_thms |- real_ordered_list [x;y;z] + + ---> + + |- x < y; |- y < z + +*) +let rol_thms rol_thm = + let thm = REWRITE_RULE[real_ordered_list;NOT_CONS_NIL;HD] rol_thm in + rev(CONJUNCTS thm);; +(* +let rol_thm = ASSUME `real_ordered_list [x;y;z]` +rol_thms rol_thm +*) + +let lem = prove(`!x. ?y. y = x`,MESON_TAC[]);; + +let rec interleave l1 l2 = + match l1 with + [] -> l2 + | h::t -> + match l2 with + [] -> l1 + | h1::t1 -> h::h1::(interleave t t1);; + + +let lem0 = prove(`?x:real. T`,MESON_TAC[]);; + +let lem1 = prove_by_refinement( + `!x. (?y. y < x) /\ (?y. y = x) /\ (?y. x < y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + EXISTS_TAC `x - &1`; + REAL_ARITH_TAC; + MESON_TAC[]; + EXISTS_TAC `x + &1`; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let rol_nonempty_thms rol_thm = + let pts = dest_list (snd(dest_comb(concl rol_thm))) in + if length pts = 0 then [lem0] else + if length pts = 1 then CONJUNCTS (ISPEC (hd pts) lem1) else + let rthms = rol_thms rol_thm in + let pt_thms = map (C ISPEC lem) pts in + let left_thm = ISPEC (hd pts) REAL_GT_EXISTS in + let right_thm = ISPEC (last pts) REAL_LT_EXISTS in + let int_thms = map (MATCH_MP REAL_DENSE) rthms in + let thms = interleave pt_thms int_thms in + left_thm::thms @ [right_thm];; + + +(* + rol_nonempty_thms (ASSUME `real_ordered_list [y]`) +*) + +let lem0 = prove_by_refinement( + `real_ordered_list []`, +(* {{{ Proof *) +[REWRITE_TAC[real_ordered_list]]);; +(* }}} *) + +let lem1 = prove_by_refinement( + `!x y. x < y ==> real_ordered_list [x; y]`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD]; +]);; +(* }}} *) + +let lem2 = prove_by_refinement( + `!x y. x < y ==> real_ordered_list (CONS y t) ==> + real_ordered_list (CONS x (CONS y t))`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[real_ordered_list;NOT_CONS_NIL;HD;TL]; +]);; +(* }}} *) + +let mk_rol ord_thms = + match ord_thms with + [] -> lem0 + | [x] -> MATCH_MP lem1 x + | h1::h2::rest -> + itlist (fun x y -> MATCH_MPL[lem2;x;y]) (butlast ord_thms) (MATCH_MP lem1 (last ord_thms));; + +(* +let k0 = rol_thms (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) +mk_rol k0 +*) + +let real_nil = `[]:real list`;; +let ROL_NIL = prove + (`real_ordered_list ([]:real list)`, + REWRITE_TAC[real_ordered_list]);; + +let ROL_REMOVE x rol_thm = + let list = dest_list (snd (dest_comb (concl rol_thm))) in + if length list = 0 then failwith "ROL_REMOVE: 0" + else if length list = 1 then + if x = hd list then ROL_NIL + else failwith "ROL_REMOVE: Not an elem" + else if length list = 2 then + let l::r::[] = list in + if l = x then ISPEC r ROL_SING + else if r = x then ISPEC l ROL_SING + else failwith "ROL_REMOVE: Not an elem" + else + let ord_thms = rol_thms rol_thm in + let partition_fun thm = + let l,r = dest_binop rlt (concl thm) in + not (x = l) && not (x = r) in + let ord_thms',elim_thms = partition partition_fun ord_thms in + if length elim_thms = 1 then mk_rol ord_thms' else + let [xy_thm; yz_thm] = elim_thms in + let connect_thm = MATCH_MP REAL_LT_TRANS (CONJ xy_thm yz_thm) in + let rec insert xz_thm thms = + match thms with + [] -> [connect_thm] + | h::t -> + let l,r = dest_binop rlt (concl h) in + let l1,r1 = dest_binop rlt (concl xz_thm) in + if (r1 = l) then xz_thm::h::t else h::insert xz_thm t in + let ord_thms'' = insert connect_thm ord_thms' in + mk_rol ord_thms'';; + + +(* +ROL_REMOVE `x1:real` (ASSUME `real_ordered_list [x1]`) +ROL_REMOVE `x1:real` (ASSUME `real_ordered_list [x1; x3]`) +ROL_REMOVE `x3:real` (ASSUME `real_ordered_list [x1; x3]`) +ROL_REMOVE `x3:real` (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) +ROL_REMOVE `x1:real` (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) +ROL_REMOVE `x5:real` (ASSUME `real_ordered_list [x1; x2; x3; x4; x5]`) + +ROL_REMOVE `-- &1` (ASSUME `real_ordered_list [-- &1; &0; &1]`) +let rol_thm = (ASSUME `real_ordered_list [-- &1; &0; &1]`) +let x = `&0` +*) + +let lem = prove( + `!y x. x < y \/ (x = y) \/ y < x`, +(* {{{ Proof *) +REAL_ARITH_TAC);; +(* }}} *) + +let lem2 = prove( + `!x y z. y < z ==> (y < x <=> (y < x /\ x < z) \/ (x = z) \/ z < x)`, +(* {{{ Proof *) + REAL_ARITH_TAC);; +(* }}} *) + + +let ROL_COVERS rol_thm = + let pts = dest_list (snd(dest_comb(concl rol_thm))) in + if length pts = 1 then ISPEC (hd pts) lem else + let thms = rol_thms rol_thm in + let thms' = map (MATCH_MP lem2) thms in + let base = ISPEC (hd pts) lem in + itlist (fun x y -> ONCE_REWRITE_RULE[MATCH_MP lem2 x] y) (rev thms) base;; + +(* +ROL_COVERS (ASSUME `real_ordered_list [x; y; z]`) +ROL_COVERS (ASSUME `real_ordered_list [x; y]`) +ROL_COVERS (ASSUME `real_ordered_list [x]`) + +*) diff --git a/Rqe/rqe_lib.ml b/Rqe/rqe_lib.ml new file mode 100644 index 0000000..cdfe8ae --- /dev/null +++ b/Rqe/rqe_lib.ml @@ -0,0 +1,143 @@ +(* ---------------------------------------------------------------------- *) +(* Refs *) +(* ---------------------------------------------------------------------- *) + +let (+=) a b = a := !a + b;; +let (+.=) a b = a := !a +. b;; + +(* ---------------------------------------------------------------------- *) +(* Timing *) +(* ---------------------------------------------------------------------- *) + +let ptime f x = + let start_time = Sys.time() in + try let result = f x in + let finish_time = Sys.time() in + let total_time = finish_time -. start_time in + (result,total_time) + with e -> + let finish_time = Sys.time() in + let total_time = finish_time -. start_time in + (print_string("Failed after (user) CPU time of "^ + (string_of_float(total_time) ^": ")); + raise e);; + +(* ---------------------------------------------------------------------- *) +(* Lists *) +(* ---------------------------------------------------------------------- *) + +let mappair f g l = + let a,b = unzip l in + let la = map f a in + let lb = map g b in + zip la lb;; + +let rec insertat i x l = + if i = 0 then x::l else + match l with + [] -> failwith "insertat: list too short for position to exist" + | h::t -> h::(insertat (i-1) x t);; + +let rec allcombs f l = + match l with + [] -> [] + | h::t -> + map (f h) t @ allcombs f t;; + +let rec assoc_list keys assl = + match keys with + [] -> [] + | h::t -> assoc h assl::assoc_list t assl;; + + +let add_to_list l1 l2 = + l1 := !l1 @ l2;; + +let list x = [x];; + +let rec ith i l = + if i = 0 then hd l else ith (i-1) (tl l);; + +let rev_ith i l = ith (length l - i - 1) l;; + +let get_index p l = + let rec get_index p l n = + match l with + [] -> failwith "get_index" + | h::t -> if p h then n else get_index p t (n + 1) in + get_index p l 0;; +(* + get_index (fun x -> x > 5) [1;2;3;7;9] +*) + + +let bindex p l = + let rec bindex p l i = + match l with + [] -> failwith "bindex: not found" + | h::t -> if p h then i else bindex p t (i + 1) in + bindex p l 0;; + +let cons x y = x :: y;; + +let rec swap_lists l store = + match l with + [] -> store + | h::t -> + let store' = map2 cons h store in + swap_lists t store';; + + +(* +swap_lists [[1;2;3];[4;5;6];[7;8;9];[10;11;12]] +--> +[[1; 4; 7; 10]; [2; 5; 8; 11]; [3; 6; 9; 12]] +*) + +let swap_lists l = + let n = length (hd l) in + let l' = swap_lists l (replicate [] n) in + map rev l';; + + + + +(* +bindex (fun x -> x = 5) [1;2;5];; +*) + +let fst3 (a,_,_) = a;; +let snd3 (_,a,_) = a;; +let thd3 (_,_,a) = a;; + +let odd n = (n mod 2 = 1);; +let even n = (n mod 2 = 0);; + +(* ---------------------------------------------------------------------- *) +(* Terms *) +(* ---------------------------------------------------------------------- *) + +let dest_var_or_const t = + match t with + Var(s,ty) -> s,ty + | Const(s,ty) -> s,ty + | _ -> failwith "not a var or const";; + +let can_match t1 t2 = + try + let n1,_ = dest_var_or_const t1 in + let n2,_ = dest_var_or_const t2 in + n1 = n2 & can (term_match [] t1) t2 + with Failure _ -> false;; + +let dest_quant tm = + if is_forall tm then dest_forall tm + else if is_exists tm then dest_exists tm + else failwith "dest_quant: not a quantified term";; + +let get_binop tm = + try let f,r = dest_comb tm in + let xop,l = dest_comb f in + xop,l,r + with Failure _ -> failwith "get_binop";; + diff --git a/Rqe/rqe_list.ml b/Rqe/rqe_list.ml new file mode 100644 index 0000000..9761cf8 --- /dev/null +++ b/Rqe/rqe_list.ml @@ -0,0 +1,313 @@ + +let aacons_tm = `CONS:A -> A list -> A list` ;; +let HD_CONV conv tm = + let h::rest = dest_list tm in + let ty = type_of h in + let thm = conv h in + let thm2 = REFL (mk_list(rest,ty)) in + let cs = inst [ty,aty] aacons_tm in + MK_COMB ((AP_TERM cs thm),thm2);; + +let TL_CONV conv tm = +(* try *) + let h::t = dest_list tm in + let lty = type_of h in + let cs = inst [lty,aty] aacons_tm in + MK_COMB ((AP_TERM cs (REFL h)), (LIST_CONV conv (mk_list(t,lty)))) +(* with _ -> failwith "TL_CONV" *) + +let rec EL_CONV conv i tm = + if i = 0 then HD_CONV conv tm + else + let h::t = dest_list tm in + let lty = type_of h in + let cs = inst [lty,aty] aacons_tm in + MK_COMB ((AP_TERM cs (REFL h)), (EL_CONV conv (i - 1) (mk_list(t,lty)))) + + +(* + + let conv = (REWRITE_CONV[ARITH_RULE `x + x = &2 * x`]) + let tm = `[&5 + &5; &6 + &6; &7 + &7]` + HD_CONV conv tm + TL_CONV conv tm + HD_CONV(TL_CONV conv) tm + CONS_CONV conv tm + EL_CONV conv 0 tm + EL_CONV conv 1 tm + EL_CONV conv 2 tm + +*) + +let NOT_CONS = prove_by_refinement( + `!l. (~ ?(h:A) t. (l = CONS h t)) ==> (l = [])`, +(* {{{ Proof *) + +[ + MESON_TAC[list_CASES]; +]);; + +(* }}} *) + +let REMOVE = new_recursive_definition list_RECURSION + `(REMOVE x [] = []) /\ + (REMOVE x (CONS (h:A) t) = + let rest = REMOVE x t in + if x = h then rest else CONS h rest)`;; + +let CHOP_LIST = new_recursive_definition num_RECURSION + `(CHOP_LIST 0 l = [],l) /\ + (CHOP_LIST (SUC n) l = + let a,b = CHOP_LIST n (TL l) in + CONS (HD l) a,b)`;; + +let REM_NIL = prove( + `REMOVE x [] = []`, + MESON_TAC[REMOVE]);; + +let REM_FALSE = prove_by_refinement( + `!x l. ~(MEM x (REMOVE x l))`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + ASM_MESON_TAC[MEM;REM_NIL]; + CASES_ON `x = h`; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; + ASM_MESON_TAC[MEM]; +]);; +(* }}} *) + +let MEM_REMOVE = prove_by_refinement( + `!x y z l. MEM x (REMOVE y l) ==> MEM x (REMOVE y (CONS z l))`, +(* {{{ Proof *) +[ + REPEAT_N 3 STRIP_TAC; + CASES_ON `y = z`; + ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; + ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF]; + ASM_MESON_TAC[MEM]; +]);; +(* }}} *) + +let REM_NEQ = prove_by_refinement( + `!x x1 l. MEM x l /\ ~(x = x1) ==> MEM x (REMOVE x1 l)`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC; + LIST_INDUCT_TAC; + MESON_TAC[MEM]; + CASES_ON `x = h`; + POP_ASSUM SUBST1_TAC; + STRIP_TAC; + ASM_REWRITE_TAC[REMOVE;LET_DEF;LET_END_DEF;COND_CLAUSES;MEM]; + STRIP_TAC; + CLAIM `MEM x t`; + ASM_MESON_TAC[MEM]; + STRIP_TAC; + CLAIM `MEM x (REMOVE x1 t)`; + ASM_MESON_TAC[]; + STRIP_TAC; + MATCH_MP_TAC MEM_REMOVE; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + + +let LAST_SING = prove_by_refinement( + `!h. LAST [h] = h`, +(* {{{ Proof *) + +[ + MESON_TAC[LAST]; +]);; + +(* }}} *) + +let LAST_CONS = prove_by_refinement( + `!h t. ~(t = []) ==> (LAST (CONS h t) = LAST t)`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[LAST]; +]);; +(* }}} *) + + +let LAST_CONS_CONS = prove_by_refinement( + `!h1 h2 t. ~(t = []) ==> (LAST (CONS h1 (CONS h2 t)) = LAST (CONS h1 t))`, +(* {{{ Proof *) +[ + REWRITE_TAC[LAST;NOT_CONS_NIL]; + MESON_TAC[LAST;NOT_CONS_NIL;COND_CLAUSES]; +]);; +(* }}} *) + +let HD_APPEND = prove_by_refinement( + `!h t l. HD (APPEND (CONS h t) l) = h`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[HD;APPEND]; +]);; +(* }}} *) + +let LENGTH_0 = prove_by_refinement( + `!l. (LENGTH l = 0) <=> (l = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH]; + ASM_MESON_TAC[LENGTH;NOT_CONS_NIL;ARITH_RULE `~(0 = SUC n)`]; +]);; +(* }}} *) + +let LENGTH_1 = prove_by_refinement( + `!l. (LENGTH l = 1) <=> ?x. l = [x]`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + EQ_TAC; + MESON_TAC[LENGTH;ARITH_RULE `~(1 = 0)`]; + MESON_TAC[NOT_CONS_NIL]; + EQ_TAC; + REWRITE_TAC[LENGTH;ARITH_RULE `~(0 = 1)`]; + REWRITE_TAC[LENGTH]; + STRIP_TAC; + CLAIM `LENGTH t = 0`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `t = []`; + ASM_MESON_TAC[LENGTH_0]; + STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[LENGTH;ONE]; +]);; +(* }}} *) + +let LIST_TRI = prove_by_refinement( + `!p. (p = []) \/ (?x. p = [x:A]) \/ (?x y t. p = CONS x (CONS y t))`, +(* {{{ Proof *) +[ + STRIP_TAC; + DISJ_CASES_TAC (ISPEC `p:A list` list_CASES); + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + DISJ_CASES_TAC (ISPEC `t:A list` list_CASES); + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let LENGTH_PAIR = prove_by_refinement( + `!p. (LENGTH p = 2) <=> ?h t. p = [h:A; t]`, +(* {{{ Proof *) +[ + STRIP_TAC THEN EQ_TAC; + STRIP_TAC; + MP_TAC (ISPEC `p:A list` list_CASES); + STRIP_TAC; + ASM_MESON_TAC[LENGTH_0;ARITH_RULE `~(2 = 0)`]; + MP_TAC (ISPEC `t:A list` list_CASES); + STRIP_TAC; + ASM_MESON_TAC[LENGTH_1;ARITH_RULE `~(1 = 2)`]; + MP_TAC (ISPEC `t':A list` list_CASES); + STRIP_TAC; + EXISTS_TAC `h:A`; + EXISTS_TAC `h':A`; + ASM_MESON_TAC[]; + CLAIM `p = CONS h (CONS h' (CONS h'' t''))`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `2 < LENGTH p`; + POP_ASSUM SUBST1_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + ASM_MESON_TAC[LT_REFL]; + STRIP_TAC; + ASM_REWRITE_TAC[LENGTH]; + ARITH_TAC; +]);; +(* }}} *) + +let LENGTH_SING = prove_by_refinement( + `!p. (LENGTH p = 1) <=> ?h. p = [h:A]`, +(* {{{ Proof *) +[ + STRIP_TAC THEN EQ_TAC; + STRIP_TAC; + MP_TAC (ISPEC `p:A list` list_CASES); + STRIP_TAC; + ASM_MESON_TAC[LENGTH_0;ARITH_RULE `~(1 = 0)`]; + MP_TAC (ISPEC `t:A list` list_CASES); + STRIP_TAC; + EXISTS_TAC `h:A`; + ASM_MESON_TAC[]; + CLAIM `p = CONS h (CONS h' t')`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `1 < LENGTH p`; + POP_ASSUM SUBST1_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + ASM_REWRITE_TAC[]; + ARITH_TAC; + STRIP_TAC; + ASM_REWRITE_TAC[LENGTH;]; + ARITH_TAC; +]);; +(* }}} *) + +let TL_NIL = prove_by_refinement( + `!l. ~(l = []) ==> ((TL l = []) <=> ?x. l = [x])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC THEN EQ_TAC; + CLAIM `?h t. l = CONS h t`; + ASM_MESON_TAC[list_CASES]; + STRIP_TAC; + ASM_REWRITE_TAC[TL]; + ASM_MESON_TAC !LIST_REWRITES; + ASM_MESON_TAC !LIST_REWRITES; +]);; +(* }}} *) + +let LAST_TL = prove_by_refinement( + `!l. ~(l = []) /\ ~(TL l = []) ==> (LAST (TL l) = LAST l)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[TL;LAST]; + ASM_MESON_TAC[NOT_CONS_NIL]; +]);; +(* }}} *) + +let LENGTH_TL = prove_by_refinement( + `!l. ~(l = []) /\ ~(TL l = []) ==> (LENGTH (TL l) = PRE(LENGTH l))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REPEAT STRIP_TAC; + LIST_SIMP_TAC; + NUM_SIMP_TAC; +]);; +(* }}} *) + +let LENGTH_NZ = prove_by_refinement( + `!p. 0 < LENGTH p <=> ~(p = [])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + EQ_TAC; + ASM_MESON_TAC[LENGTH;NOT_CONS_NIL;LT_REFL]; + REWRITE_TAC[LENGTH;NOT_CONS_NIL;LT_REFL;NOT_NIL]; + STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[LENGTH]; + ARITH_TAC; +]);; +(* }}} *) diff --git a/Rqe/rqe_main.ml b/Rqe/rqe_main.ml new file mode 100644 index 0000000..965126e --- /dev/null +++ b/Rqe/rqe_main.ml @@ -0,0 +1,671 @@ +let TRAPOUT cont mat_thm ex_thms fm = + try + cont mat_thm ex_thms + with Isign (false_thm,ex_thms) -> + let ftm = mk_eq(fm,f_tm) in + let fthm = CONTR ftm false_thm in + let ex_thms' = sort (fun x y -> xterm_lt (fst y) (fst x)) ex_thms in + let fthm' = rev_itlist CHOOSE ex_thms' fthm in + fthm';; + +let get_repeats l = + let rec get_repeats l seen ind = + match l with + [] -> [] + | h::t -> + if mem h seen then ind::get_repeats t seen (ind + 1) + else get_repeats t (h::seen) (ind + 1) in + get_repeats l [] 0;; + +let subtract_index l = + let rec subtract_index l ind = + match l with + [] -> [] + | h::t -> (h - ind):: (subtract_index t (ind + 1)) in + subtract_index l 0;; + +(* +subtract_index (get_repeats [1; 2; 1; 2 ; 3]) +*) + +let remove_column n isigns_thm = + let thms = interpsigns_thms2 isigns_thm in + let l,r = chop_list n thms in + let thms' = l @ tl r in + mk_interpsigns thms';; + +let REMOVE_COLUMN n mat_thm = + let rol_thm,all_thm = interpmat_thms mat_thm in + let ints,part,signs = dest_all2 (concl all_thm) in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in + let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in + let isigns_thms' = map (remove_column n) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in + let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in + mat_thm';; + +let SETIFY_CONV mat_thm = + let _,pols,_ = dest_interpmat(concl mat_thm) in + let pols' = dest_list pols in + let sols = setify (dest_list pols) in + let indices = map (fun p -> try index p sols with _ -> failwith "SETIFY: no index") pols' in + let subtract_cols = subtract_index (get_repeats indices) in + rev_itlist REMOVE_COLUMN subtract_cols mat_thm;; + + +(* +SETIFY_CONV +(ASSUME `interpmat [] [(\x. x + &1); (\x. x + &1); (\x. x + &2); (\x. x + &3); (\x. x + &1); (\x. x + &2)][[Pos; Pos; Pos; Pos; Neg; Zero]]`) + +*) +(* +let duplicate_column i j isigns_thm = + let thms = interpsigns_thms2 isigns_thm in + let col = ith i thms in + let l,r = chop_list j thms in + let thms' = l @ (col :: r) in + mk_interpsigns thms';; + +let DUPLICATE_COLUMN i j mat_thm = + let rol_thm,all_thm = interpmat_thms mat_thm in + let ints,part,signs = dest_all2 (concl all_thm) in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in + let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in + let isigns_thms' = map (duplicate_column i j) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in + let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in + mat_thm';; +*) + +let duplicate_columns new_cols isigns_thm = + let thms = interpsigns_thms2 isigns_thm in + let thms' = map (fun i -> el i thms) new_cols in + mk_interpsigns thms';; + +let DUPLICATE_COLUMNS mat_thm ls = + if ls = [] then if mat_thm = empty_mat then empty_mat else failwith "empty duplication list" else + let rol_thm,all_thm = interpmat_thms mat_thm in + let ints,part,signs = dest_all2 (concl all_thm) in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in + let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in + let isigns_thms' = map (duplicate_columns ls) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in + let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in + mat_thm';; + + +let DUPLICATE_COLUMNS mat_thm ls = + let start_time = Sys.time() in + let res = DUPLICATE_COLUMNS mat_thm ls in + duplicate_columns_timer +.= (Sys.time() -. start_time); + res;; + + +let UNMONICIZE_ISIGN vars monic_thm isign_thm = + let _,_,sign = dest_interpsign isign_thm in + let const = (fst o dest_mult o lhs o concl) monic_thm in + let const_thm = SIGN_CONST const in + let op,_,_ = get_binop (concl const_thm) in + let mp_thm = + if op = rgt then + if sign = spos_tm then gtpos + else if sign = sneg_tm then gtneg + else if sign = szero_tm then gtzero + else failwith "bad sign" + else if op = rlt then + if sign = spos_tm then ltpos + else if sign = sneg_tm then ltneg + else if sign = szero_tm then ltzero + else failwith "bad sign" + else (failwith "bad op") in + let monic_thm' = GEN (hd vars) monic_thm in + MATCH_MPL[mp_thm;monic_thm';const_thm;isign_thm];; + +let UNMONICIZE_ISIGNS vars monic_thms isigns_thm = + let isign_thms = interpsigns_thms2 isigns_thm in + let isign_thms' = map2 (UNMONICIZE_ISIGN vars) monic_thms isign_thms in + mk_interpsigns isign_thms';; + +let UNMONICIZE_MAT vars monic_thms mat_thm = + if monic_thms = [] then mat_thm else + let rol_thm,all_thm = interpmat_thms mat_thm in + let ints,part,signs = dest_all2 (concl all_thm) in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in + let consts = map (fst o dest_mult o lhs o concl) monic_thms in + let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in + let isigns_thms' = map (UNMONICIZE_ISIGNS vars monic_thms) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in + let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in + mat_thm';; + +let UNMONICIZE_MAT vars monic_thms mat_thm = + let start_time = Sys.time() in + let res = UNMONICIZE_MAT vars monic_thms mat_thm in + unmonicize_mat_timer +.= (Sys.time() -. start_time); + res;; + + +(* {{{ Examples *) + +(* +let vars,monic_thms,mat_thm = + [], [], empty_mat + + +let monic_thm = hd monic_thms +length isigns_thms + +MONIC_CONV [rx] `&1 + x * (&1 + x * (&1 + x * &7))` + +let isign_thm = hd isign_thms + +let isigns_thm = hd isigns_thms + + mk_interpsigns [TRUTH];; +let ls = [0;1;2;0;1;2] + let mat_thm,ls = empty_mat,[] +1,3, + +DUPLICATE_COLUMNS +(ASSUME `interpmat [] [(\x. x + &1); (\x. x + &1); (\x. x + &2); (\x. x + &3); (\x. x + &1); (\x. x + &2)][[Pos; Pos; Pos; Pos; Neg; Zero]]`) +[5] + +duplicate_columns [] (ASSUME `interpsigns [] (\x. T) []`) +let new_cols, isigns_thm = [],(ASSUME `interpsigns [] (\x. T) []`) + +let isigns_thm = hd isigns_thms + +*) + +(* }}} *) + + +let SWAP_HEAD_COL_ROW i isigns_thm = + let s_thms = interpsigns_thms2 isigns_thm in + let s_thms' = insertat i (hd s_thms) (tl s_thms) in + mk_interpsigns s_thms';; + +let SWAP_HEAD_COL i mat_thm = + let rol_thm,all_thm = interpmat_thms mat_thm in + let ints,part,signs = dest_all2 (concl all_thm) in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in + let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in + let isigns_thms' = map (SWAP_HEAD_COL_ROW i) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + mk_interpmat_thm rol_thm all_thm';; + +let SWAP_HEAD_COL i mat_thm = + let start_time = Sys.time() in + let res = SWAP_HEAD_COL i mat_thm in + swap_head_col_timer +.= (Sys.time() -. start_time); + res;; + + +let LENGTH_CONV = + let alength_tm = `LENGTH:(A list) -> num` in + fun tm -> + try + let ty = type_of tm in + let lty,[cty] = dest_type ty in + if lty <> "list" then failwith "LENGTH_CONV: not a list" else + let ltm = mk_comb(inst[cty,aty] alength_tm,tm) in + let lthm = REWRITE_CONV[LENGTH] ltm in + MATCH_MP main_lem000 lthm + with _ -> failwith "LENGTH_CONV";; + +let LAST_NZ_CONV = + let alast_tm = `LAST:(A list) -> A` in + fun nz_thm tm -> + try + let ty = type_of tm in + let lty,[cty] = dest_type ty in + if lty <> "list" then failwith "LAST_NZ_CONV: not a list" else + let ltm = mk_comb(inst[cty,aty] alast_tm,tm) in + let lthm = REWRITE_CONV[LAST;NOT_CONS_NIL] ltm in + MATCH_MPL[main_lem001;nz_thm;lthm] + with _ -> failwith "LAST_NZ_CONV";; + +let rec first f l = + match l with + [] -> failwith "first" + | h::t -> if can f h then f h else first f t;; + +let NEQ_RULE thm = + let thms = CONJUNCTS main_lem002 in + first (C MATCH_MP thm) thms;; + +(* +NEQ_CONV (ARITH_RULE `~(&11 <= &2)`) +*) + +let NORMAL_LIST_CONV nz_thm tm = + let nz_thm' = NEQ_RULE nz_thm in + let len_thm = LENGTH_CONV tm in + let last_thm = LAST_NZ_CONV nz_thm' tm in + let cthm = CONJ len_thm last_thm in + MATCH_EQ_MP (GSYM (REWRITE_RULE[GSYM NEQ] NORMAL_ID)) cthm;; + +(* +|- poly_diff [&0; &0; &0 + a * &1] = [&0; &0 + a * &2] +let tm = `poly_diff [&0; &0 + a * &1]` +*) +let pdiff_tm = `poly_diff`;; +let GEN_POLY_DIFF_CONV vars tm = + let thm1 = POLY_ENLIST_CONV vars tm in + let l,x = dest_poly (rhs (concl thm1)) in + let thm2 = CANON_POLY_DIFF_CONV (mk_comb(pdiff_tm,l)) in + let thm3 = CONV_RULE (RAND_CONV (LIST_CONV (POLYNATE_CONV vars))) thm2 in + thm3;; + +(* + if \x. p = \x. q, where \x. p is the leading polynomial + replace p by q in mat_thm, +*) + + +(* +let peq,mat_thm = !rppeq,!rpmat +*) +let rppeq,rpmat = ref TRUTH,ref TRUTH;; +let REPLACE_POL = + let imat_tm = `interpmat` in + fun peq mat_thm -> + rppeq := peq; + rpmat := mat_thm; + let pts,pols,sgnll = dest_interpmat (concl mat_thm) in + let rep_p = lhs(concl peq) in + let i = try index rep_p (dest_list pols) with _ -> failwith "REPLACE_POL: index" in + let thm1 = EL_CONV (fun x -> GEN_REWRITE_CONV I [peq] x) i pols in + end_itlist (C (curry MK_COMB)) (rev [REFL imat_tm;REFL pts;thm1;REFL sgnll]);; + + +let REPLACE_POL peq mat_thm = + let start_time = Sys.time() in + let res = REPLACE_POL peq mat_thm in + replace_pol_timer +.= (Sys.time() -. start_time); + res;; + +(* {{{ Examples *) + +(* + +let peq,mat_thm = +ASSUME `(\x. &0) = + (\x. &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)))`, +ASSUME `interpmat [x_44] [\x. (&0 + b * &1) + x * (&0 + a * &2); \x. &0] + [[Pos; Zero]; [Zero; Zero]; [Neg; Zero]]` + +let peq = ASSUME `(\x. &1 + x * (&1 + x * (&1 + x * &1))) = (\x. &1 + x)` + +REPLACE_POL peq mat_thm + +is_constant [`y:real`] `&1 + x * -- &1` + +let vars,pols,cont,sgns,ex_thms = +[`c:real`; `b:real`; `a:real`], +[`&0 + c * &1`], +(fun x y -> x), +[ASSUME `&0 + b * (&0 + b * -- &1) = &0`; +ASSUME ` &0 + b * (&0 + b * (&0 + a * -- &1)) = &0`; +ASSUME `&0 + a * (&0 + a * &1) = &0`;ASSUME `&0 + b * &1 = &0`; +ASSUME `&0 + a * &1 = &0`; ASSUME ` &1 > &0`], +[] + +*) + +(* }}} *) + + + +(* ---------------------------------------------------------------------- *) +(* Factoring *) +(* ---------------------------------------------------------------------- *) + +let UNFACTOR_ISIGN vars xsign_thm pol isign_thm = + let x = hd vars in + let k,pol' = weakfactor x pol in + if k = 0 then isign_thm else + let fact_thm = GEN x (GSYM (WEAKFACTOR_CONV x pol)) in + let par_thm = PARITY_CONV (mk_small_numeral k) in + let _,_,xsign = dest_interpsign xsign_thm in + let _,_,psign = dest_interpsign isign_thm in + let parity,_ = dest_comb (concl par_thm) in + if xsign = spos_tm then + let mp_thm = + if psign = spos_tm then factor_pos_pos + else if psign = sneg_tm then factor_pos_neg + else if psign = szero_tm then factor_pos_zero + else failwith "bad sign" in + let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm]) in + MATCH_MP ret fact_thm + else if xsign = szero_tm then + let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in + let mp_thm = + if psign = spos_tm then factor_zero_pos + else if psign = sneg_tm then factor_zero_neg + else if psign = szero_tm then factor_zero_zero + else failwith "bad sign" in + let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;k_thm]) in + MATCH_MP ret fact_thm + else if xsign = sneg_tm & parity = even_tm then + let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in + let mp_thm = + if psign = spos_tm then factor_neg_even_pos + else if psign = sneg_tm then factor_neg_even_neg + else if psign = szero_tm then factor_neg_even_zero + else failwith "bad sign" in + let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;par_thm;k_thm]) in + MATCH_MP ret fact_thm + else if xsign = sneg_tm & parity = odd_tm then + let k_thm = prove(mk_neg(mk_eq(mk_small_numeral k,nzero)),ARITH_TAC) in + let mp_thm = + if psign = spos_tm then factor_neg_odd_pos + else if psign = sneg_tm then factor_neg_odd_neg + else if psign = szero_tm then factor_neg_odd_zero + else failwith "bad sign" in + let ret = BETA_RULE(MATCH_MPL[mp_thm;xsign_thm;isign_thm;par_thm;k_thm]) in + MATCH_MP ret fact_thm + else failwith "bad something...";; + +(* {{{ Examples *) + +(* + +let vars,xsign_thm,pol,isign_thm = +[ry;rx], +`interpsign (\x. x < x1) (\x. x) Pos`, +ASSUME `interpsign (\x. x < x_254) (\y. &0 + y * &1) Neg` + +`\x. &0 + x * (&4 + x * &6)`, +ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` + + +let xsign_thm,pol,isign_thm = +ASSUME `interpsign (\x. x < x1) (\x. x) Pos`, +`\x. &0 + x * (&4 + x * &6)`, +ASSUME `interpsign (\x. x < x1) (\x. &4 + x * &6) Pos` + + +*) + +(* }}} *) + +let UNFACTOR_ISIGNS vars pols isigns_thm = + let isign_thms = interpsigns_thms2 isigns_thm in + let isign_thms' = map2 (UNFACTOR_ISIGN vars (hd isign_thms)) pols (tl isign_thms) in + mk_interpsigns isign_thms';; + +let UNFACTOR_MAT vars pols mat_thm = + let rol_thm,all_thm = interpmat_thms mat_thm in + let ints,part,signs = dest_all2 (concl all_thm) in + let part_thm = PARTITION_LINE_CONV (snd (dest_comb part)) in + let isigns_thms = CONJUNCTS (REWRITE_RULE[ALL2;part_thm] all_thm) in + let isigns_thms' = map (UNFACTOR_ISIGNS vars pols) isigns_thms in + let all_thm' = mk_all2_interpsigns part_thm isigns_thms' in + let all_thm'' = REWRITE_RULE[GSYM part_thm] all_thm' in + let mat_thm' = mk_interpmat_thm rol_thm all_thm'' in + mat_thm';; + +let UNFACTOR_MAT vars pols mat_thm = + let start_time = Sys.time() in + let res = UNFACTOR_MAT vars pols mat_thm in + unfactor_mat_timer +.= (Sys.time() -. start_time); + res;; + +(* {{{ Examples *) + +(* +#untrace UNFACTOR_ISIGN + +let isigns_thm = el 0 isigns_thms +UNFACTOR_ISIGNS pols isigns_thm + +let isign_thm = el 1 isign_thm + +pols + let isigns_thms' = map (UNFACTOR_ISIGNS pols) isigns_thms in + +let xsign_thm = hd isign_thms +let xsign_thm = ASSUME `interpsign (\x. x < x1) (\x. x) Neg` +let isign_thm = hd (tl isign_thms) +let pol = hd pols +let pol = `\x. &0 + x * (&0 + x * (&0 + x * (&0 + y * &1)))` + +let isigns_thm = hd isigns_thms +let vars = [rx;ry;rz] + + +let pols = + [`\x. &0 + x * (&0 + x * (&0 + y * &1))`; `\x. &0 + x * (&4 + x * &6)`; `\x. &3 + x * (&6 + x * &9)`; + `\x. &0 + x * (&0 + x * (&0 + x * (&0 + z * &1)))`; `\x. -- &4 + x * (&0 + x * &1)`] + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. x; \x. &0 + y * &1; \x. &4 + x * &6; \x. &3 + x * (&6 + x * &9); + \x. &0 + z * &1; \x. -- &4 + x * (&0 + x * &1)] + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Neg; Pos; Zero; Zero; Neg; Neg]; + [Neg; Pos; Neg; Pos; Neg; Neg]; + [Neg; Pos; Neg; Pos; Neg; Zero]; + [Neg; Pos; Neg; Pos; Neg; Pos]; + [Zero; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` + +UNFACTOR_MAT pols mat_thm + +*) + +(* }}} *) + +let message_time s f x = + report s; + time f x;; + + +(* ---------------------------------------------------------------------- *) +(* Matrix *) +(* ---------------------------------------------------------------------- *) + +let matrix_count,splitzero_count,splitsigns_count,monicize_count = ref 0,ref 0,ref 0,ref 0;; +let reset_counts() = matrix_count := 0;splitzero_count := 0;splitsigns_count := 0;monicize_count := 0;; +let print_counts() = !matrix_count,!splitzero_count,!splitsigns_count,!monicize_count;; + + +(* +let vars,dun,pols,cont,sgns,ex_thms,fm = !szvars,!szdun,!szpols,!szcont,!szsgns,!szex_thms,!szfm +*) + + +let rec MATRIX vars pols cont sgns ex_thms fm = + incr matrix_count; + if pols = [] then TRAPOUT cont empty_mat [] fm else + if exists (is_constant vars) pols then + let p = find (is_constant vars) pols in + let i = try index p pols with _ -> failwith "MATRIX: no such pol" in + let pols1,pols2 = chop_list i pols in + let pols' = pols1 @ tl pols2 in + let cont' = MATINSERT vars i (FINDSIGN vars sgns p) cont in + MATRIX vars pols' cont' sgns ex_thms fm + else + let kqs = map (weakfactor (hd vars)) pols in + if exists (fun (k,q) -> k <> 0 & not(is_constant vars q)) kqs then + let pols' = poly_var(hd vars) :: map snd kqs in + let ks = map fst kqs in + let cont' mat_thm ex_thms = cont (UNFACTOR_MAT vars pols mat_thm) ex_thms in + MATRIX vars pols' cont' sgns ex_thms fm + else + let d = itlist (max o degree_ vars) pols (-1) in + let p = find (fun p -> degree_ vars p = d) pols in + let pl_thm = POLY_ENLIST_CONV vars p in + let pl = rhs(concl pl_thm) in + let l,x = dest_poly pl in + let pdiff_thm = GEN_POLY_DIFF_CONV vars p in + let p'l = rhs (concl pdiff_thm) in + let p' = mk_comb(mk_comb(poly_tm,p'l),hd vars) in + let p'thm = (POLY_DELIST_CONV THENC (POLYNATE_CONV vars)) p' in + let p'c = rhs (concl p'thm) in + let hdp' = last (dest_list p'l) in + let sign_thm = FINDSIGN vars sgns hdp' in + let normal_thm = NORMAL_LIST_CONV sign_thm p'l in + let i = try index p pols with _ -> failwith "MATRIX: no such pol1" in + let qs = let p1,p2 = chop_list i pols in p'c::p1 @ tl p2 in + let gs,div_thms = unzip (map (PDIVIDES vars sgns p) qs) in + let cont' mat_thm = cont (SWAP_HEAD_COL i mat_thm) in + let dedcont mat_thm ex_thms = + DEDMATRIX vars sgns div_thms pdiff_thm normal_thm cont' mat_thm ex_thms in + SPLITZERO vars qs gs dedcont sgns ex_thms fm + +and SPLITZERO vars dun pols cont sgns ex_thms fm = + incr splitzero_count; + match pols with + [] -> SPLITSIGNS vars [] dun cont sgns ex_thms fm + | p::ops -> + if p = rzero then + let cont' mat_thm ex_thms = MATINSERT vars (length dun) (REFL rzero) cont mat_thm ex_thms in + SPLITZERO vars dun ops cont' sgns ex_thms fm + else + let hp = behead vars p in + let h = head vars p in + let nzcont = + let tmp = SPLITZERO vars (dun@[p]) ops cont in + fun sgns ex_thms -> tmp sgns ex_thms fm in + let zcont = + let tmp = SPLITZERO vars dun (hp :: ops) in + fun sgns ex_thms -> + let zthm = FINDSIGN vars sgns h in + let b_thm = GSYM (BEHEAD vars zthm p) in + let lam_thm = ABS (hd vars) b_thm in + let cont' mat_thm ex_thms = + let mat_thm' = REPLACE_POL (lam_thm) mat_thm in + let mat_thm'' = MATCH_EQ_MP mat_thm' mat_thm in + cont mat_thm'' ex_thms in + tmp cont' sgns ex_thms fm in + SPLIT_ZERO (tl vars) sgns (head vars p) zcont nzcont ex_thms + +and SPLITSIGNS vars dun pols cont sgns ex_thms fm = + incr splitsigns_count; + match pols with + [] -> MONICIZE vars dun cont sgns ex_thms fm +(* [] -> MATRIX vars dun cont sgns ex_thms fm *) + | p::ops -> + let cont' sgns ex_thms = SPLITSIGNS vars (dun@[p]) ops cont sgns ex_thms fm in + SPLIT_SIGN (tl vars) sgns (head vars p) cont' cont' ex_thms + +and MONICIZE vars pols cont sgns ex_thms fm = + incr monicize_count; + let monic_thms = map (MONIC_CONV vars) pols in + let monic_pols = map (rhs o concl) monic_thms in + let sols = setify monic_pols in + let indices = map (fun p -> try index p sols with _ -> failwith "MONICIZE: no such pol") monic_pols in + let transform mat_thm = + let mat_thm' = DUPLICATE_COLUMNS mat_thm indices in +(* mat_thm' *) + UNMONICIZE_MAT vars monic_thms mat_thm' in + let cont' mat_thm ex_thms = cont (transform mat_thm) ex_thms in + MATRIX vars sols cont' sgns ex_thms fm +;; + +(* {{{ Examples *) + +(* +let vars,pols,sgns,ex_thms = [],[],[],[] + +let mat_thm = mat_thm' +monic_thms + +let vars = [rx] +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [(\x. &1 + x * (&2 + x * &3)); (\x. &2 + x * (&4 + x * &6)); \x. &3 + x * (&6 + x * &9); \x. &2 + x * (-- &3 + x * &1); \x. -- &4 + x * (&0 + x * &1); \x. &8 + x * &4] + [[Pos; Pos; Pos; Neg; Neg; Neg]; + [Pos; Pos; Zero; Zero; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Neg]; + [Pos; Pos; Neg; Pos; Neg; Zero]; + [Pos; Pos; Neg; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos; Zero; Pos]; + [Pos; Pos; Neg; Pos; Pos; Pos]; + [Pos; Zero; Neg; Pos; Pos; Pos]; + [Pos; Neg; Neg; Pos; Pos; Pos]; + [Pos; Zero; Zero; Pos; Pos; Pos]; + [Pos; Pos; Pos; Pos; Pos; Pos]]` + +let mat_thm = ASSUME + `interpmat [x1; x2; x3; x4; x5] + [\x. -- &4 + x * (&0 + x * &1); \x. &2 + x * &1; \x. &2 + x * (-- &3 + x * &1); \x. &1 / &3 + x * (&2 / &3 + x * &1)] + [[Pos; Pos; Pos; Neg]; + [Pos; Pos; Zero; Zero]; + [Pos; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos]; + [Pos; Pos; Neg; Pos]; + [Pos; Zero; Neg; Pos]; + [Pos; Neg; Neg; Pos]; + [Pos; Zero; Zero; Pos]; + [Pos; Pos; Pos; Pos]]`;; + +let vars = [rx] +let pols = [`&1 + x * (&2 + x * &3)`;`&2 + x * (&4 + x * &6)`;`&3 + x * (&6 + x * &9)`; `&2 + x * (-- &3 + x * &1)`;`-- &4 + x * (&0 + x * &1)`;`&8 + x * &4`] + + +*) +(* }}} *) + + +(* ---------------------------------------------------------------------- *) +(* Set up RQE *) +(* ---------------------------------------------------------------------- *) + +let polynomials tm = + let rec polynomials tm = + if tm = t_tm or tm = f_tm then [] + else if is_conj tm or is_disj tm or is_imp tm or is_iff tm then + let _,l,r = get_binop tm in polynomials l @ polynomials r + else if is_neg tm then polynomials (dest_neg tm) + else if + can (dest_binop rlt) tm or + can (dest_binop rgt) tm or + can (dest_binop rle) tm or + can (dest_binop rge) tm or + can (dest_binop req) tm or + can (dest_binop rneq) tm then + let _,l,_ = get_binop tm in [l] + else failwith "not a fol atom" in + setify (polynomials tm);; +(* {{{ Examples *) + +(* +let pols = polynomials `(poly [&1; -- &2] x > &0 ==> poly [&1; -- &2] x >= &0 /\ (poly [&8] x = &0)) /\ ~(poly [y] x <= &0)` +*) + +(* }}} *) + + +let BASIC_REAL_QELIM_CONV vars fm = + let x,bod = dest_exists fm in + let pols = polynomials bod in + let cont mat_thm ex_thms = + let ex_thms' = sort (fun x y -> xterm_lt (fst y) (fst x)) ex_thms in + let comb_thm = COMBINE_TESTFORMS x mat_thm bod in + let comb_thm' = rev_itlist CHOOSE ex_thms' comb_thm in + comb_thm' in + let ret_thm = SPLITZERO (x::vars) [] pols cont empty_sgns [] fm in + PURE_REWRITE_RULE[NEQ] ret_thm;; + +let REAL_QELIM_CONV fm = + reset_counts(); + ((LIFT_QELIM_CONV POLYATOM_CONV (EVALC_CONV THENC SIMPLIFY_CONV) + BASIC_REAL_QELIM_CONV) THENC EVALC_CONV THENC SIMPLIFY_CONV) fm;; + +(* ---------------------------------------------------------------------- *) +(* timers *) +(* ---------------------------------------------------------------------- *) + diff --git a/Rqe/rqe_num.ml b/Rqe/rqe_num.ml new file mode 100644 index 0000000..a91c7d2 --- /dev/null +++ b/Rqe/rqe_num.ml @@ -0,0 +1,34 @@ + +(* ---------------------------------------------------------------------- *) +(* Nums *) +(* ---------------------------------------------------------------------- *) + +let neq = `(=):num->num->bool`;; +let nlt = `(<):num->num->bool`;; +let ngt = `(>):num->num->bool`;; +let nle = `(<=):num->num->bool`;; +let nge = `(>=):num->num->bool`;; +let nm = `( * ):num->num->num`;; +let np = `(+):num->num->num`;; +let nzero = `0`;; +let even_tm = `EVEN`;; +let odd_tm = `ODD`;; + + +let nmax = new_definition( + `nmax (n:num) m = if n <= m then m else n`);; + +let SUC_1 = prove( + `1 + x = SUC x`, +(* {{{ Proof *) + ARITH_TAC);; +(* }}} *) + +let even_tm = `EVEN`;; +let odd_tm = `ODD`;; +let PARITY_CONV tm = + let k = dest_small_numeral tm in + if even k then + prove(mk_comb(even_tm,tm),ARITH_TAC) + else + prove(mk_comb(odd_tm,tm),ARITH_TAC);; diff --git a/Rqe/rqe_real.ml b/Rqe/rqe_real.ml new file mode 100644 index 0000000..31c335e --- /dev/null +++ b/Rqe/rqe_real.ml @@ -0,0 +1,475 @@ +(* ---------------------------------------------------------------------- *) +(* Reals *) +(* ---------------------------------------------------------------------- *) +let real_ty = `:real`;; +let rx = `x:real`;; +let ry = `y:real`;; +let rz = `z:real`;; +let rzero = `&0`;; +let req = `(=):real->real->bool`;; +let rneq = `(<>):real->real->bool`;; +let rlt = `(<):real->real->bool`;; +let rgt = `(>):real->real->bool`;; +let rle = `(<=):real->real->bool`;; +let rge = `(>=):real->real->bool`;; +let rm = `( * ):real->real->real`;; +let rs = `(-):real->real->real`;; +let rn = `(--):real->real`;; +let rd = `(/):real->real->real`;; +let rp = `(+):real->real->real`;; +let rzero = `&0`;; +let rone = `&1`;; +let rlast = `LAST:(real) list -> real`;; +let rappend = `APPEND:(real) list -> real list -> real list`;; +let mk_rlist l = mk_list (l,real_ty);; + +let diffl_tm = `(diffl)`;; +let dest_diffl tm = + try + let l,var = dest_comb tm in + let dp,p' = dest_comb l in + let d,p = dest_comb dp in + if not (d = diffl_tm) then failwith "dest_diffl: not a diffl" else + let _,bod = dest_abs p in + bod,p' + with _ -> failwith "dest_diffl";; + +let dest_mult = + try + dest_binop rm + with _ -> failwith "dest_mult";; + +let mk_mult = mk_binop rm;; + +let pow_tm = `(pow)`;; +let dest_pow = + try + dest_binop pow_tm + with _ -> failwith "dest_pow";; + +let mk_plus = mk_binop rp;; +let mk_negative = curry mk_comb rn;; + +let dest_plus = + try + dest_binop rp + with _ -> failwith "dest_plus";; + +let REAL_DENSE = prove( + `!x y. x < y ==> ?z. x < z /\ z < y`, +(* {{{ Proof *) + REPEAT STRIP_TAC THEN + CLAIM `&0 < y - x` THENL + [REWRITE_TAC[REAL_LT_SUB_LADD;REAL_ADD_LID] THEN + POP_ASSUM MATCH_ACCEPT_TAC; + DISCH_THEN (ASSUME_TAC o (MATCH_MP REAL_DOWN)) THEN + POP_ASSUM MP_TAC THEN STRIP_TAC THEN + EXISTS_TAC `e + x` THEN + STRIP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV[GSYM REAL_ADD_RID])) THEN + MATCH_MP_TAC REAL_LET_ADD2 THEN + STRIP_TAC THENL + [MATCH_ACCEPT_TAC REAL_LE_REFL; + FIRST_ASSUM MATCH_ACCEPT_TAC]; + MATCH_EQ_MP_TAC ((GEN `y:real` (GEN `z:real` (ISPECL [`y:real`;`z:real`;`-- x`] REAL_LT_RADD)))) THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_ADD_RINV;REAL_ADD_RID] THEN + REWRITE_TAC[GSYM real_sub] THEN + FIRST_ASSUM MATCH_ACCEPT_TAC]]);; +(* }}} *) + +let REAL_LT_EXISTS = prove( + `!x. ?y. x < y`, +(* {{{ Proof *) + GEN_TAC THEN + EXISTS_TAC `x + &1` THEN + REAL_ARITH_TAC);; +(* }}} *) + +let REAL_GT_EXISTS = prove( + `!x. ?y. y < x`, +(* {{{ Proof *) + GEN_TAC THEN + EXISTS_TAC `x - &1` THEN + REAL_ARITH_TAC);; +(* }}} *) + +let REAL_DIV_DISTRIB_L = prove_by_refinement( + `!x y z. x / (y * z) = (x / y) * (&1 / z)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_div;REAL_INV_MUL]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_DIV_DISTRIB_R = prove_by_refinement( + `!x y z. x / (y * z) = (&1 / y) * (x / z)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_div;REAL_INV_MUL]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_DIV_DISTRIB_2 = prove_by_refinement( + `!x y z. (x * w) / (y * z) = (x / y) * (w / z)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_div;REAL_INV_MUL]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_DIV_ADD_DISTRIB = prove_by_refinement( + `!x y z. (x + y) / z = (x / z) + (y / z)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_div;REAL_INV_MUL]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let DIV_ID = prove_by_refinement( + `!x. ~(x = &0) ==> (x / x = &1)`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + REWRITE_TAC[real_div]; + ASM_MESON_TAC[REAL_MUL_LINV;REAL_MUL_SYM]; +]);; + +(* }}} *) + +let POS_POW = prove_by_refinement( + `!c x. &0 < c /\ &0 < x ==> &0 < c * x pow k`, +(* {{{ Proof *) + +[ + MESON_TAC[REAL_POW_LT;REAL_LT_MUL] +]);; + +(* }}} *) + +let POS_NAT_POW = prove_by_refinement( + `!c n. 0 < n /\ &0 < c ==> &0 < c * &n pow k`, +(* {{{ Proof *) + +[ + MESON_TAC[REAL_POW_LT;REAL_LT_MUL;REAL_LT;] +]);; + +(* }}} *) + +let REAL_NUM_LE_0 = prove_by_refinement( + `!n. &0 <= (&n)`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REAL_ARITH_TAC; + REWRITE_TAC[REAL]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_ARCH_SIMPLE_LT = prove_by_refinement( + `!x. ?n. x < &n`, +(* {{{ Proof *) +[ + STRIP_TAC; + CHOOSE_THEN ASSUME_TAC (ISPEC `x:real` REAL_ARCH_SIMPLE); + EXISTS_TAC `SUC n`; + REWRITE_TAC[REAL]; + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let BINOMIAL_LEMMA_LT = prove_by_refinement( + `!x y. &0 < x /\ &0 < y + ==> !n. 0 < n ==> x pow n + y pow n <= (x + y) pow n`, +(* {{{ Proof *) + +[ + REPEAT GEN_TAC; + STRIP_TAC; + INDUCT_TAC; + ARITH_TAC; + REWRITE_TAC[real_pow]; + STRIP_TAC; + CASES_ON `n = 0`; + ASM_REWRITE_TAC[real_pow;REAL_MUL_RID;REAL_LE_REFL]; + CLAIM `0 < n`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x))); + MATCH_MP_TAC REAL_LE_TRANS; + EXISTS_TAC `(x + y) * (x pow n + y pow n)`; + STRIP_TAC; + REWRITE_TAC[REAL_ADD_RDISTRIB]; + MATCH_MP_TAC REAL_LE_ADD2; + CONJ_TAC; + MATCH_MP_TAC REAL_LE_LMUL; + STRIP_TAC; + FIRST_ASSUM (fun x -> MP_TAC x THEN ARITH_TAC); + MATCH_MP_TAC (REAL_ARITH `&0 <= y ==> x <= x + y`); + MATCH_MP_TAC REAL_POW_LE; + FIRST_ASSUM (fun x -> MP_TAC x THEN ARITH_TAC); + REWRITE_TAC[REAL_ADD_LDISTRIB]; + MATCH_MP_TAC (REAL_ARITH `&0 <= y ==> x <= y + x`); + MATCH_MP_TAC REAL_LE_MUL; + CONJ_TAC; + FIRST_ASSUM (fun x -> MP_TAC x THEN REAL_ARITH_TAC); + MATCH_MP_TAC (REAL_ARITH `x < y ==> x <= y`); + MATCH_MP_TAC REAL_POW_LT; + FIRST_ASSUM MATCH_ACCEPT_TAC; + MATCH_MP_TAC REAL_LE_LMUL; + CONJ_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; + +(* }}} *) + +let BINOMIAL_LEMMA = prove_by_refinement( + `!x y. &0 <= x /\ &0 <= y + ==> !n. 0 < n ==> x pow n + y pow n <= (x + y) pow n`, +(* {{{ Proof *) + +[ + REPEAT GEN_TAC; + STRIP_TAC; + CASES_ON `(x = &0) \/ (y = &0)`; + POP_ASSUM DISJ_CASES_TAC; + ASM_REWRITE_TAC[real_pow;REAL_ADD_LID;POW_0]; + REPEAT STRIP_TAC; + CLAIM `n = SUC (PRE n)`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ONCE_ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[POW_0;REAL_ADD_LID;real_pow;REAL_LE_REFL]; + REPEAT STRIP_TAC; + CLAIM `n = SUC (PRE n)`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + ONCE_ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[POW_0;REAL_ADD_LID;REAL_ADD_RID;real_pow;REAL_LE_REFL]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC; + MATCH_MP_TAC BINOMIAL_LEMMA_LT; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; + +(* }}} *) + +let NEG_ABS = prove_by_refinement( + `!x. -- (abs x) <= &0`, +(* {{{ Proof *) +[ + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_MUL_LT = prove_by_refinement( + `!x y. x * y < &0 <=> (x < &0 /\ &0 < y) \/ (&0 < x /\ y < &0)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + EQ_TAC; + REPEAT STRIP_TAC; + CCONTR_TAC; + REWRITE_ASSUMS ([REAL_NOT_LT;DE_MORGAN_THM;] @ !REAL_REWRITES); + POP_ASSUM MP_TAC THEN STRIP_TAC; + CLAIM `x = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + DISCH_THEN (REWRITE_ASSUMS o list); + REWRITE_ASSUMS !REAL_REWRITES; + ASM_MESON_TAC !REAL_REWRITES; + CLAIM `&0 * &0 <= x * y`; + MATCH_MP_TAC REAL_LE_MUL2; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REAL_SIMP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + CLAIM `&0 * &0 <= --x * --y`; + MATCH_MP_TAC REAL_LE_MUL2; + REAL_SIMP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REAL_SIMP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + CLAIM `y = &0`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + DISCH_THEN (REWRITE_ASSUMS o list); + REWRITE_ASSUMS !REAL_REWRITES; + ASM_REWRITE_TAC[]; + EVERY_ASSUM MP_TAC THEN ARITH_TAC; + (* save *) + REPEAT STRIP_TAC; + CLAIM `&0 < --x`; + EVERY_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `&0 * &0 < --x * y`; + MATCH_MP_TAC REAL_LT_MUL2; + REAL_SIMP_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REAL_SIMP_TAC; + REWRITE_TAC[REAL_ARITH `--y * x = --(y * x)`]; + REAL_ARITH_TAC; + CLAIM `&0 < --y`; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + STRIP_TAC; + CLAIM `&0 * &0 < x * --y`; + MATCH_MP_TAC REAL_LT_MUL2; + REAL_SIMP_TAC; + ASM_REWRITE_TAC[]; + REAL_SIMP_TAC; + REWRITE_TAC[REAL_ARITH `x * --y = --(x * y)`]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_MUL_GT = prove_by_refinement( + `!x y. &0 < x * y <=> (x < &0 /\ y < &0) \/ (&0 < x /\ &0 < y)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + EQ_TAC; + REPEAT STRIP_TAC; + ONCE_REWRITE_ASSUMS[ARITH_RULE `x < y <=> -- y < -- x`]; + REWRITE_ASSUMS[GSYM REAL_MUL_RNEG]; + REWRITE_ASSUMS[REAL_ARITH `-- &0 = &0`; REAL_MUL_LT]; + POP_ASSUM MP_TAC THEN REPEAT STRIP_TAC; + DISJ1_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC; + ONCE_REWRITE_TAC [ARITH_RULE `x * y = --x * --y`]; + ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; + MATCH_MP_TAC REAL_LT_MUL2; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ONCE_REWRITE_TAC [ARITH_RULE `&0 = &0 * &0`]; + MATCH_MP_TAC REAL_LT_MUL2; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_DIV_INV = prove_by_refinement( + `!y z. &0 < y /\ y < z ==> &1 / z < &1 / y`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_TAC[real_div]; + REAL_SIMP_TAC; + MATCH_MP_TAC REAL_LT_INV2; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let REAL_DIV_DENOM_LT = prove_by_refinement( + `!x y z. &0 < x /\ &0 < y /\ y < z ==> x / z < x / y`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP; + EXISTS_TAC `inv x`; + REPEAT STRIP_TAC; + REAL_SOLVE_TAC; + REWRITE_TAC[real_div]; + ASM_SIMP_TAC[REAL_LT_IMP_NZ;REAL_MUL_ASSOC;REAL_MUL_LINV;]; + REAL_SIMP_TAC; + MATCH_MP_TAC (REWRITE_RULE [REAL_MUL_LID;real_div] REAL_DIV_INV); + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let REAL_DIV_DENOM_LE = prove_by_refinement( + `!x y z. &0 <= x /\ &0 < y /\ y <= z ==> x / z <= x / y`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CASES_ON `x = &0`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[real_div;REAL_MUL_LZERO;REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_LCANCEL_IMP; + EXISTS_TAC `inv x`; + REPEAT STRIP_TAC; + MATCH_MP_TAC REAL_LT_INV; + ASM_MESON_TAC[REAL_LT_LE]; + REWRITE_TAC[real_div]; + ASM_SIMP_TAC[REAL_LT_IMP_NZ;REAL_MUL_ASSOC;REAL_MUL_LINV;]; + REAL_SIMP_TAC; + MATCH_MP_TAC REAL_LE_INV2; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let REAL_NEG_DIV = prove_by_refinement( + `!x y. -- x / -- y = x / y`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_div]; + REWRITE_TAC[REAL_INV_NEG]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let REAL_GT_IMP_NZ = prove( + `!x. x < &0 ==> ~(x = &0)`, +(* {{{ Proof *) + REAL_ARITH_TAC);; +(* }}} *) + +let REAL_NEG_NZ = prove( + `!x. x < &0 ==> ~(x = &0)`, +(* {{{ Proof *) + REAL_ARITH_TAC);; +(* }}} *) + +let PARITY_POW_LT = prove_by_refinement( + `!a n. a < &0 ==> (EVEN n ==> a pow n > &0) /\ (ODD n ==> a pow n < &0)`, +(* {{{ Proof *) + +[ + STRIP_TAC; + INDUCT_TAC; + REWRITE_TAC[EVEN;ODD;real_pow]; + REAL_ARITH_TAC; + DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_TAC[EVEN;ODD;real_pow;NOT_EVEN;NOT_ODD]; + DISJ_CASES_TAC (ISPEC `n:num` EVEN_OR_ODD); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[real_gt;REAL_MUL_GT]; + ASM_MESON_TAC[EVEN_AND_ODD]; + ASM_REWRITE_TAC[real_gt;REAL_MUL_LT]; + ASM_MESON_TAC[real_gt]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[real_gt;REAL_MUL_LT;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[EVEN_AND_ODD]; +]);; + +(* }}} *) + +let EVEN_ODD_POW = prove_by_refinement( + `!a n. a <> &0 ==> + (EVEN n ==> a pow n > &0) /\ + (ODD n ==> a < &0 ==> a pow n < &0) /\ + (ODD n ==> a > &0 ==> a pow n > &0)`, +(* {{{ Proof *) +[ + REWRITE_TAC[NEQ]; + REPEAT_N 2 STRIP_TAC; + CLAIM `a < &0 \/ a > &0 \/ (a = &0)`; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + STRIP_TAC; + REPEAT STRIP_TAC; + ASM_MESON_TAC[PARITY_POW_LT]; + ASM_MESON_TAC[PARITY_POW_LT]; + ASM_MESON_TAC[REAL_POW_LT;real_gt]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt]; + EVERY_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_POW_LT;real_gt]; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) diff --git a/Rqe/rqe_tactics_ext.ml b/Rqe/rqe_tactics_ext.ml new file mode 100644 index 0000000..caa308b --- /dev/null +++ b/Rqe/rqe_tactics_ext.ml @@ -0,0 +1,266 @@ +(* ---------------------------------------------------------------------- *) +(* Labels *) +(* ---------------------------------------------------------------------- *) + +let labels_flag = ref false;; + +let LABEL_ALL_TAC:tactic = + let mk_label avoid = + let rec mk_one_label i avoid = + let label = "Z-"^(string_of_int i) in + if not(mem label avoid) then label else mk_one_label (i+1) avoid in + mk_one_label 0 avoid in + let update_label i asl = + let rec f_at_i f j = + function [] -> [] + | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in + let avoid = map fst asl in + let current = el i avoid in + let new_label = mk_label avoid in + if (String.length current > 0) then asl else + f_at_i (fun (_,y) -> (new_label,y) ) i asl in + fun (asl,w) -> + let aslp = ref asl in + (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done; + (ALL_TAC (!aslp,w)));; + +let e tac = refine(by(VALID + (if !labels_flag then (tac THEN LABEL_ALL_TAC) else tac)));; + + +(* ---------------------------------------------------------------------- *) +(* Refinement *) +(* ---------------------------------------------------------------------- *) + + +let prove_by_refinement(t,(tacl:tactic list)) = + let gstate = mk_goalstate ([],t) in + let _,sgs,just = rev_itlist + (fun tac gs -> by + (if !labels_flag then (tac THEN LABEL_ALL_TAC) else tac) gs) + tacl gstate in + let th = if sgs = [] then just null_inst [] + else failwith "BY_REFINEMENT_PROOF: Unsolved goals" in + let t' = concl th in + if t' = t then th else + try EQ_MP (ALPHA t' t) th + with Failure _ -> failwith "prove_by_refinement: generated wrong theorem";; + +(* ---------------------------------------------------------------------- *) +(* Term Type Inference Tactics *) +(* ---------------------------------------------------------------------- *) + +let exclude_list = ref +["=";"FINITE";"COND";"@";"!";"?";"UNION";"DELETE";"CARD";"swap";"IN"];; +(* exclude is needed because polymorphic operators were causing problems *) + +let get_var_list tm = + let rec get_var_list tm = + match tm with + Var(name,ty) -> [name,ty] + | Const(name,ty) -> [name,ty] + | Abs(bv,bod) -> union (get_var_list bv) (get_var_list bod) + | Comb(s,t) -> union (get_var_list s) (get_var_list t) in + filter (fun x -> not (mem (fst x) !exclude_list)) (get_var_list tm);; + + +let rec auto_theta new_type old_type = + let tyvar_prefix = "?" in + let is_generated ty_name = + let first_char = hd(explode ty_name) in + if first_char = tyvar_prefix then true else false in + match new_type with + Tyvar(ns) -> + (match old_type with + Tyvar(os) -> + if is_generated ns then [old_type,new_type] else [] + | Tyapp (old_name,old_list) -> [old_type,new_type]) + | Tyapp(new_ty_op,new_ty_list) -> + (match old_type with + Tyvar _ -> [] + | Tyapp (old_ty_op,old_ty_list) -> + if new_ty_op = old_ty_op then + itlist2 (fun newt oldt b -> union (auto_theta newt oldt) b) + new_ty_list old_ty_list [] + else []);; + +let rec auto_theta_list newl oldl = + match newl with + [] -> [] + | (h::t) -> + let head_list = + (try + let new_name,new_type = h in + let old_type = assoc new_name oldl in + (auto_theta new_type old_type) + with Failure _ -> []) in + union head_list (auto_theta_list t oldl);; + + +let auto_type new_tm old_tm = + let old_list = get_var_list old_tm in + let new_list = get_var_list new_tm in + let theta = auto_theta_list new_list old_list in + inst theta new_tm;; + +let rec auto_type_list tm tml = + match tml with + [] -> tm + | (h::t) -> auto_type_list (auto_type tm h) t;; + +let auto_type_goal tm (asl,w) = + let thm_list = snd(unzip asl) in + let term_list = map (fun x -> snd (dest_thm x)) thm_list in + auto_type_list tm ([w] @ term_list);; + +let TYPE_TAC (f:term->tactic) tm = + function (asl,w) as g -> + let typed_term = auto_type_goal tm g in + f typed_term g;; + +let TYPE_TACL (f:term list -> tactic) tml = + function (asl,w) as g -> + let typed_terms = map (C auto_type_goal g) tml in + f typed_terms g;; + +(* ---------------------------------------------------------------------- *) +(* Unfiled *) +(* ---------------------------------------------------------------------- *) + +let CLAIM t = + TYPE_TAC (C SUBGOAL_THEN MP_TAC) t;; + +let lem = TAUT `(a = b) <=> (a ==> b) /\ (b ==> a)`;; +let MATCH_EQ_MP t1 t2 = + try EQ_MP t1 t2 with Failure _ -> + let k1 = (SPEC_ALL (PURE_REWRITE_RULE[lem] t1)) in + let left,right = CONJUNCT1 k1,CONJUNCT2 k1 in + try MATCH_MP left t2 with Failure _ -> + try MATCH_MP right t2 with Failure _ -> + failwith "MATCH_EQ_MP";; + +let MATCH_EQ_MP_TAC thm = + let t1,t2 = EQ_IMP_RULE (SPEC_ALL thm) in + MATCH_MP_TAC t1 ORELSE MATCH_MP_TAC t2;; + + +let rec REPEAT_N_CONV n conv = + if n = 0 then ALL_CONV else conv THENC (REPEAT_N_CONV (n-1) conv);; + +let rec REPEAT_N n tac = + if n = 0 then ALL_TAC else tac THEN REPEAT_N (n-1) tac;; + +let dest_goal g = + let (asms,conc) = g in (asms:(string * thm) list),(conc:term);; + +let DISJ_LCASE g = + let _,c = dest_goal g in + let l,r = dest_disj c in + let thm = ISPEC l EXCLUDED_MIDDLE in + (DISJ_CASES_TAC thm THENL [ + DISJ1_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + DISJ2_TAC + ]) g;; + +let DISJ_RCASE g = + let _,c = dest_goal g in + let l,r = dest_disj c in + let thm = ISPEC r EXCLUDED_MIDDLE in + (DISJ_CASES_TAC thm THENL [ + DISJ2_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + DISJ1_TAC + ]) g;; + +let CASES_ON tm = + let ty,_ = dest_type (type_of tm) in + match ty with + "num" -> + DISJ_CASES_TAC (SPEC tm num_CASES) THENL + [ + POP_ASSUM SUBST1_TAC; + POP_ASSUM STRIP_ASSUME_TAC THEN POP_ASSUM SUBST1_TAC + ] + | "bool" -> + DISJ_CASES_TAC (SPEC tm EXCLUDED_MIDDLE) + | _ -> failwith "not a case type";; + + +let CASES_ON t = TYPE_TAC CASES_ON t;; + +let EXISTS_TAC t = TYPE_TAC EXISTS_TAC t;; + +let REWRITE_ASSUMS thl = RULE_ASSUM_TAC (REWRITE_RULE thl);; +let ONCE_REWRITE_ASSUMS thl = RULE_ASSUM_TAC (ONCE_REWRITE_RULE thl);; +let REWRITE_ALL thl = REWRITE_ASSUMS thl THEN REWRITE_TAC thl;; +let USE_IASSUM n = + USE_THEN ("Z-" ^ string_of_int n);; + +let PROVE_ASSUM_ANTECEDENT_TAC n = + fun ((asl,w) as g) -> + let assum = assoc ("Z-" ^ string_of_int n) asl in + let ant,_ = dest_imp (concl assum) in + SUBGOAL_THEN ant (fun x -> (USE_IASSUM n (fun y-> ASSUME_TAC (MATCH_MP y x)))) g;; + +let FALSE_ANTECEDENT_TAC = + fun ((asl,w) as g) -> + let l,r = dest_imp w in + (SUBGOAL_THEN (mk_neg l) (fun x -> REWRITE_TAC[x])) g;; + + +let REWRITE_ASSUMS thl = RULE_ASSUM_TAC (REWRITE_RULE thl);; +let ONCE_REWRITE_ASSUMS thl = RULE_ASSUM_TAC (ONCE_REWRITE_RULE thl);; + +let REWRITE_ALL_TAC l = REWRITE_ASSUMS l THEN REWRITE_TAC l;; + +let rec MATCH_MPL thms = + match thms with + [thm] -> thm + | impl::ant::rest -> + MATCH_MPL ((MATCH_MP impl ant)::rest);; + +let rec MATCH_EQ_MPL thms = + match thms with + [thm] -> thm + | impl::ant::rest -> + MATCH_EQ_MPL ((MATCH_EQ_MP impl ant)::rest);; + + +(* +MATCH_MPL [ASSUME `a ==> b ==> c ==> d`;ASSUME `a:bool`;ASSUME `b:bool`;ASSUME `c:bool`] ;; +*) + + +let (USE_ASSUM_LIST: string list -> thm_tactic -> tactic) = + fun l ttac ((asl,w) as g) -> + try + let l' = assoc_list l asl in + let l'' = map ttac l' in + (EVERY l'') g + with Failure _ -> failwith "USE_ASSUM_LIST";; + +let (KEEP: string list -> tactic) = + fun l (asl,w) -> + try + let asl' = filter (fun x -> mem (fst x) l) asl in + ALL_TAC (asl',w) + with Failure _ -> failwith "USE_ASSUM_LIST";; + + +let PROVE_THM_ANTECEDENT_TAC thm = + let ant,cons = dest_imp (concl thm) in + SUBGOAL_THEN ant (fun x -> MP_TAC (MATCH_MP thm x));; + +let MOVE_TO_FRONT s = + fun (asl,w) -> + let k,asl' = remove (fun x -> fst x = s) asl in + ALL_TAC (k::asl',w);; + +let IGNORE x = ALL_TAC;; + +let CCONTR_TAC = + MATCH_MP_TAC (TAUT `(~x ==> F) ==> x`) THEN STRIP_TAC;; + +let DISCH_ASS = DISCH_THEN (fun x -> ASSUME_TAC x THEN MP_TAC x);; + +let pgoal() = + !current_goalstack;; diff --git a/Rqe/signs.ml b/Rqe/signs.ml new file mode 100644 index 0000000..21d0a33 --- /dev/null +++ b/Rqe/signs.ml @@ -0,0 +1,352 @@ +(* ------------------------------------------------------------------------- *) +(* Find sign of polynomial, using modulo-constant lookup and computation. *) +(* ------------------------------------------------------------------------- *) + +let xterm_lt t1 t2 = + try + let n1,_ = dest_var t1 in + let n2,_ = dest_var t2 in + let i1 = String.sub n1 2 (String.length n1 - 2) in + let i2 = String.sub n2 2 (String.length n2 - 2) in + let x1 = int_of_string i1 in + let x2 = int_of_string i2 in + x1 < x2 + with _ -> failwith "xterm_lt: not an xvar?";; + +(* +String.sub n1 2 (String.length n1 - 2) +substring +let t1,t2 = `x_99:real`,`x_100:real` +xterm_sort t1 t2 +t1 < t2 +*) + + +let FINDSIGN = + let p_tm = `p:real` + and c_tm = `c:real` + and fth = prove + (`r (a * b * p) (&0) ==> (a * b = &1) ==> r p (&0)`, + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID]) in + let rec FINDSIGN vars sgns p = + try + try SIGN_CONST p with Failure _ -> + let mth = MONIC_CONV vars p in + let p' = rand(concl mth) in + let pth = find (fun th -> lhand(concl th) = p') sgns in + let c = lhand(lhand(concl mth)) in + let c' = term_of_rat(Int 1 // rat_of_term c) in + let sth = SIGN_CONST c' in + let rel_c = funpow 2 rator (concl sth) in + let rel_p = funpow 2 rator (concl pth) in + let th1 = + if rel_p = req then if rel_c = rgt then pth_0g else pth_0l + else if rel_p = rgt then if rel_c = rgt then pth_gg else pth_gl + else if rel_p = rlt then if rel_c = rgt then pth_lg else pth_ll + else if rel_p = rneq then if rel_c = rgt then pth_nzg else pth_nzl + else failwith "FINDSIGN" in + let th2 = MP (MP (INST [p',p_tm; c',c_tm] th1) pth) sth in + let th3 = EQ_MP (LAND_CONV(RAND_CONV(K(SYM mth))) (concl th2)) th2 in + let th4 = MATCH_MP fth th3 in + MP th4 (EQT_ELIM(REAL_RAT_REDUCE_CONV(lhand(concl th4)))) + with Failure _ -> failwith "FINDSIGN" in + FINDSIGN;; + +(* + +let vars = [`x:real`;`y:real`] +let p = `&7 + x * (&11 + x * (&10 + y * &7))` + +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) < &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) = &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) > &0`] +let sgns = [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] + +FINDSIGN vars sgns p +FINDSIGN vars sgns `-- &1` + +*) + + + +(* +ASSERTSIGN [x,y] [] (|- &7 + x * (&11 + x * (&10 + y * -- &7)) < &0 + +--> + +[-- &1 + x * (-- &11 / &7 + x * (-- &10 / &7 + y * &1)) > &0] + + +ASSERTSIGN [x,y] [] (|- &7 + x * (&11 + x * (&10 + y * &7)) < &0 + +--> + +[&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) < &0] + +*) + + +let ASSERTSIGN vars sgns sgn_thm = + let op,l,r = get_binop (concl sgn_thm) in + let p_thm = MONIC_CONV vars l in + let _,pl,pr = get_binop (concl p_thm) in + let c,_ = dest_binop rm pl in + let c_thm = SIGN_CONST c in + let c_op,_,_ = get_binop (concl c_thm) in + let sgn_thm' = + if c_op = rlt & op = rlt then + MATCH_MPL[signs_lem01;c_thm;sgn_thm;p_thm] + else if c_op = rgt & op = rlt then + MATCH_MPL[signs_lem02;c_thm;sgn_thm;p_thm] + else if c_op = rlt & op = rgt then + MATCH_MPL[signs_lem03;c_thm;sgn_thm;p_thm] + else if c_op = rgt & op = rgt then + MATCH_MPL[signs_lem04;c_thm;sgn_thm;p_thm] + else if c_op = rlt & op = req then + MATCH_MPL[signs_lem05;c_thm;sgn_thm;p_thm] + else if c_op = rgt & op = req then + MATCH_MPL[signs_lem06;c_thm;sgn_thm;p_thm] + else if c_op = rlt & op = rneq then + MATCH_MPL[signs_lem07;c_thm;sgn_thm;p_thm] + else if c_op = rgt & op = rneq then + MATCH_MPL[signs_lem08;c_thm;sgn_thm;p_thm] + else failwith "ASSERTSIGN : 0" in + try + let sgn_thm'' = find (fun th -> lhand(concl th) = pr) sgns in + let op1,l1,r1 = get_binop (concl sgn_thm') in + let op2,l2,r2 = get_binop (concl sgn_thm'') in + if (concl sgn_thm') = (concl sgn_thm'') then sgns + else if op2 = rneq & (op1 = rlt or op1 = rgt) then sgn_thm'::snd (remove ((=) sgn_thm'') sgns) + else failwith "ASSERTSIGN : 1" + with Failure "find" -> sgn_thm'::sgns;; + + + +(* +let k0 = `&7 + x * (&11 + x * (&10 + y * -- &7))` +MONIC_CONV vars k0 +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` +let sgn_thm = k1 + +ASSERTSIGN vars [ASSUME `&1 + x * (&11 / &7 + x * (&10 / &7 + y * &1)) <> &0`] k1 + +*) + +(* ---------------------------------------------------------------------- *) +(* Case splitting *) +(* ---------------------------------------------------------------------- *) + + + +let SPLIT_ZERO vars sgns p cont_z cont_n ex_thms = + try + let sgn_thm = FINDSIGN vars sgns p in + let op,l,r = get_binop (concl sgn_thm) in + (if op = req then cont_z else cont_n) sgns ex_thms + with Failure "FINDSIGN" -> + let eq_tm = mk_eq(p,rzero) in + let neq_tm = mk_neq(p,rzero) in + let or_thm = ISPEC p signs_lem002 in + (* zero *) + let z_thm = cont_z (ASSERTSIGN vars sgns (ASSUME eq_tm)) ex_thms in + let z_thm' = DISCH eq_tm z_thm in + (* nonzero *) + let nz_thm = cont_n (ASSERTSIGN vars sgns (ASSUME neq_tm)) ex_thms in + let nz_thm' = DISCH neq_tm nz_thm in + (* combine *) + let ret = MATCH_MPL[signs_lem003;or_thm;z_thm';nz_thm'] in + (* matching problem... must continue by hand *) + let ldj,rdj = dest_disj (concl ret) in + let lcj,rcj = dest_conj ldj in + let a,_ = dest_binop req lcj in + let p,p1 = dest_beq rcj in + let _,rcj = dest_conj rdj in + let p2 = rhs rcj in + let pull_thm = ISPECL[a;p;p1;p2] PULL_CASES_THM in + let ret' = MATCH_EQ_MP pull_thm ret in + ret';; + +(* + +let ret = MATCH_MPL[lem3;or_thm] +MATCH_MP ret z_thm' + +;nz_thm'] in + +let vars,sgns,p,cont_z,cont_n,ex_thms = !sz_vars, !sz_sgns, !sz_p,!sz_cont_z, !sz_cont_n ,!sz_ex_thms + + + + let ret = MATCH_MPL[lem3;or_thm;] +let mp_thm = MATCH_MPL[lem3;or_thm;] in +let vars, sgns, p,cont_z, cont_n = !sz_vars,!sz_sgns,!sz_p,!sz_cont_z,!sz_cont_n + +let mp_thm = k1 + + +let t1 = ISPECL[`(?y. &0 + y * (&0 + x * &1) = &0)`;`T`;`T`;`&0 + x * &1`;`T`] t0 +MATCH_EQ_MP t1 k1 + + + +EQ_MP t1 k1 + +MATCH_EQ_MP PULL_CASES_THM k1 + +concl k1 = lhs (concl t1) + +MATCH_EQ_MP PULL_CASES_THM k0 +let k0 = ASSUME `(&0 + x * &1 = &0) /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) \/ + &0 + x * &1 <> &0 /\ + (&0 + x * &1 > &0 /\ ((?x_1089. &0 + x_1089 * (&0 + x * &1) = &0) <=> T) \/ + &0 + x * &1 < &0 /\ ((?x_1084. &0 + x_1084 * (&0 + x * &1) = &0) <=> T))`;; +let k1 = ASSUME `(&0 + x * &1 = &0) /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) \/ + &0 + x * &1 <> &0 /\ + (&0 + x * &1 > &0 /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T) \/ + &0 + x * &1 < &0 /\ ((?y. &0 + y * (&0 + x * &1) = &0) <=> T))`;; + +MATCH_MPL[PULL_CASES_THM;!sz_z_thm;!sz_nz_thm] in + +let thm1 = ASSUME `(?x_32. (&0 + c * &1) + x_32 * ((&0 + b * &1) + x_32 * (&0 + a * &1)) = &0) <=> T` +let thm2 = +ASSUME `(&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 ==> + ((?x. (&0 + c * &1) + x * ((&0 + b * &1) + x * (&0 + a * &1)) = &0) <=> F)) /\ + (&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 ==> + ((?x_26. (&0 + c * &1) + x_26 * ((&0 + b * &1) + x_26 * (&0 + a * &1)) = &0) <=> T)) ` + + +MATCH_MPL + +(* let PULL_CASES_THM = prove_by_refinement( *) +(* `((a = &0) ==> (p <=> p0)) ==> ((a <> &0) ==> (a < &0 ==> (p <=> p1)) /\ (a > &0 ==> (p <=> p2))) *) +(* ==> (p <=> ((a = &0) /\ p0) \/ ((a < &0) /\ p1) \/ (a > &0 /\ p2))`, *) +(* (\* {{{ Proof *\) +[ + REWRITE_TAC[NEQ] THEN + MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN + ASM_REWRITE_TAC[NEQ] THEN TRY REAL_ARITH_TAC +]);; +(\* }}} *\) *) + +let PULL_CASES_THM = prove + (`!a p p0 p1 p2. +((a = &0) /\ (p <=> p0) \/ + (a <> &0) /\ (a > &0 /\ (p <=> p1) \/ a < &0 /\ (p <=> p2))) <=> + ((p <=> (a = &0) /\ p0 \/ a > &0 /\ p1 \/ a < &0 /\ p2))`, +(* {{{ Proof *) + REPEAT STRIP_TAC THEN REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; +(* }}} *) + + +let vars, sgns, p, cont_z, cont_n = +[`x:real`;`y:real`], + empty_sgns, +`&0 + y * &1`, +(fun x -> (ASSUME `abc > def`,[])), +(fun x -> (ASSUME `sean > steph`,[])) + + +SPLIT_ZERO vars sgns p cont_z cont_n + +ASSERTSIGN vars empty_sgns (ASSUME `&0 + y * &1 = &0`) , + +let vars = [`x:real`;`y:real`] +let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) +let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` +let cont_z = hd +let cont_n = hd +SPLIT_ZERO vars sgns p cont_z cont_n + + +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` +let sgn_thm = k1 +ASSERTSIGN vars [] k1 + +*) + +let SPLIT_SIGN vars sgns p cont_p cont_n ex_thms = + let sgn_thm = try FINDSIGN vars sgns p + with Failure "FINDSIGN" -> + failwith "SPLIT_SIGN: no sign -- should have sign assumption by now" in + let gt_tm = mk_binop rgt p rzero in + let lt_tm = mk_binop rlt p rzero in + let op,_,_ = get_binop (concl sgn_thm) in + if op = rgt then cont_p sgns ex_thms + else if op = rlt then cont_n sgns ex_thms + else if op = req then failwith "SPLIT_SIGN: lead coef is 0" + else if op = rneq then + let or_thm = MATCH_MP signs_lem0002 sgn_thm in + (* < *) + let lt_sgns = ASSERTSIGN vars sgns (ASSUME lt_tm) in + let lt_thm = cont_n lt_sgns ex_thms in + let lt_thm' = DISCH lt_tm lt_thm in + (* > *) + let gt_sgns = ASSERTSIGN vars sgns (ASSUME gt_tm) in + let gt_thm = cont_p gt_sgns ex_thms in + let gt_thm' = DISCH gt_tm gt_thm in + (* combine *) + let ret = MATCH_MPL[signs_lem0003;or_thm;gt_thm';lt_thm'] in + (* matching problem... must continue by hand *) + let ldj,rdj = dest_disj (concl ret) in + let lcj,rcj = dest_conj ldj in + let a,_ = dest_binop rgt lcj in + let p,p1 = dest_beq rcj in + let _,rcj = dest_conj rdj in + let p2 = rhs rcj in + let pull_thm = ISPECL[a;p;p1;p2] PULL_CASES_THM_NZ in + let ret' = MATCH_EQ_MP (MATCH_MP pull_thm sgn_thm) ret in + ret' + else failwith "SPLIT_SIGN: unknown op";; + + +(* +let vars, sgns, p,cont_p, cont_n = !ss_vars,!ss_sgns,!ss_p,!ss_cont_p,!ss_cont_n +[`x`], +[ASSUME `&0 + x * &1 <> &0`; ARITH_RULE ` &1 > &0`], +`&0 + x * &1` + +let ss_vars, ss_sgns, ss_p,ss_cont_p, ss_cont_n = ref [],ref [],ref `T`,ref (fun x -> TRUTH,[]),ref(fun x -> TRUTH,[]);; + ss_vars := vars; + ss_sgns := sgns; + ss_p := p; + ss_cont_p := cont_p; + ss_cont_n := cont_n; + + + +let vars, sgns, p, cont_p, cont_n = +[`x:real`;`y:real`], +ASSERTSIGN vars empty_sgns (ASSUME `&0 + y * &1 <> &0`) , +`&0 + y * &1`, +(fun x -> (ASSUME `P > def`,[])), +(fun x -> (ASSUME `sean > steph`,[])) + +SPLIT_SIGN vars sgns p cont_z cont_n + + +let vars = [`x:real`;`y:real`] +let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) +let p = `&7 + x * (&11 + x * (&10 + y * -- &7))` +let cont_p = hd +let cont_n = hd +SPLIT_SIGN vars sgns p cont_p cont_n + +let sgns = ASSERTSIGN vars [] (ASSUME `&7 + x * (&11 + x * (&10 + y * -- &7)) <> &0`) + +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) < &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) = &0` +let k1 = ASSUME `&7 + x * (&11 + x * (&10 + y * &7)) <> &0` +let sgn_thm = k1 +ASSERTSIGN vars [] k1 + + + + +*) diff --git a/Rqe/signs_thms.ml b/Rqe/signs_thms.ml new file mode 100644 index 0000000..c9ab076 --- /dev/null +++ b/Rqe/signs_thms.ml @@ -0,0 +1,136 @@ +let [pth_0g;pth_0l;pth_gg;pth_gl;pth_lg;pth_ll] = + (CONJUNCTS o prove) + (`((p = &0) ==> c > &0 ==> (c * p = &0)) /\ + ((p = &0) ==> c < &0 ==> (c * p = &0)) /\ + (p > &0 ==> c > &0 ==> c * p > &0) /\ + (p > &0 ==> c < &0 ==> c * p < &0) /\ + (p < &0 ==> c > &0 ==> c * p < &0) /\ + (p < &0 ==> c < &0 ==> c * p > &0)`, + SIMP_TAC[REAL_MUL_RZERO] THEN + REWRITE_TAC[REAL_ARITH `(x > &0 <=> &0 < x) /\ (x < &0 <=> &0 < --x)`; + REAL_ARITH `~(p = &0) <=> p < &0 \/ p > &0`] THEN + REWRITE_TAC[IMP_IMP] THEN + REPEAT CONJ_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_MUL) THEN + REAL_ARITH_TAC);; + +let pth_nzg = prove_by_refinement( + `p <> &0 ==> c > &0 ==> c * p <> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[NEQ;REAL_ENTIRE] THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let pth_nzl = prove_by_refinement( + `p <> &0 ==> c < &0 ==> c * p <> &0`, +(* {{{ Proof *) +[ + REWRITE_TAC[NEQ;REAL_ENTIRE] THEN REAL_ARITH_TAC; +]);; +(* }}} *) + +let signs_lem01 = prove_by_refinement( + `c < &0 ==> p < &0 ==> (c * p = p') ==> p' > &0`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; +]);; +(* }}} *) + +let signs_lem02 = prove_by_refinement( + `c > &0 ==> p < &0 ==> (c * p = p') ==> p' < &0`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; +]);; +(* }}} *) + +let signs_lem03 = prove_by_refinement( + `c < &0 ==> p > &0 ==> (c * p = p') ==> p' < &0`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; +]);; +(* }}} *) + +let signs_lem04 = prove_by_refinement( + `c > &0 ==> p > &0 ==> (c * p = p') ==> p' > &0`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt]; +]);; +(* }}} *) + +let signs_lem05 = prove_by_refinement( + `c < &0 ==> (p = &0) ==> (c * p = p') ==> (p' = &0)`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO]; +]);; +(* }}} *) + +let signs_lem06 = prove_by_refinement( + `c > &0 ==> (p = &0) ==> (c * p = p') ==> (p' = &0)`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO]; +]);; +(* }}} *) + +let signs_lem07 = prove_by_refinement( + `c < &0 ==> p <> &0 ==> (c * p = p') ==> p' <> &0`, +(* {{{ Proof *) + +[ + ASM_MESON_TAC[NEQ;REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO;REAL_ENTIRE;REAL_GT_IMP_NZ]; +]);; + +(* }}} *) + +let signs_lem08 = prove_by_refinement( + `c > &0 ==> p <> &0 ==> (c * p = p') ==> p' <> &0`, +(* {{{ Proof *) + +[ + ASM_MESON_TAC[NEQ;REAL_MUL_LT;REAL_MUL_GT;real_gt;REAL_MUL_RZERO;REAL_ENTIRE;REAL_LT_IMP_NZ]; +]);; + +(* }}} *) + +let signs_lem002 = prove_by_refinement( + `!p. (p = &0) \/ (p <> &0)`, +(* {{{ Proof *) +[ + MESON_TAC[NEQ]; +]);; +(* }}} *) + +let signs_lem003 = TAUT `a \/ b ==> (a ==> x) ==> (b ==> y) ==> (a /\ x \/ b /\ y)`;; + +let sz_z_thm = ref TRUTH;; +let sz_nz_thm = ref TRUTH;; + +let PULL_CASES_THM = prove + (`!a p p0 p1. +((a = &0) /\ (p <=> p0) \/ (a <> &0) /\ (p <=> p1)) <=> ((p <=> (a = &0) /\ p0 \/ a <> &0 /\ p1 ))`, +(* {{{ Proof *) + REPEAT STRIP_TAC THEN REWRITE_TAC[NEQ] THEN MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; +(* }}} *) + +let signs_lem0002 = prove( + `!p. p <> &0 ==> (p > &0) \/ (p < &0)`,REWRITE_TAC [NEQ] THEN REAL_ARITH_TAC);; +let signs_lem0003 = TAUT `a \/ b ==> (a ==> x) ==> (b ==> y) ==> (a /\ x \/ b /\ y)`;; + +let PULL_CASES_THM_NZ = prove + (`!a p p1 p2. + (a <> &0) ==> ((a > &0 /\ (p <=> p1) \/ a < &0 /\ (p <=> p2)) <=> + ((p <=> a > &0 /\ p1 \/ a < &0 /\ p2)))`, +(* {{{ Proof *) + REWRITE_TAC[NEQ] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[NEQ] THEN + MAP_EVERY BOOL_CASES_TAC [`p:bool`; `p0:bool`; `p1:bool`; `p2:bool`] THEN + ASM_REWRITE_TAC[] THEN TRY (POP_ASSUM MP_TAC THEN REAL_ARITH_TAC) +);; +(* }}} *) diff --git a/Rqe/simplify.ml b/Rqe/simplify.ml new file mode 100644 index 0000000..323a2a9 --- /dev/null +++ b/Rqe/simplify.ml @@ -0,0 +1,189 @@ +(* ---------------------------------------------------------------------- *) +(* Simplification *) +(* ---------------------------------------------------------------------- *) + +(* +let psimplify1 fm = + match fm with + Not False -> True + | Not True -> False + | And(False,q) -> False + | And(p,False) -> False + | And(True,q) -> q + | And(p,True) -> p + | Or(False,q) -> q + | Or(p,False) -> p + | Or(True,q) -> True + | Or(p,True) -> True + | Imp(False,q) -> True + | Imp(True,q) -> q + | Imp(p,True) -> True + | Imp(p,False) -> Not p + | Iff(True,q) -> q + | Iff(p,True) -> p + | Iff(False,q) -> Not q + | Iff(p,False) -> Not p + | _ -> fm;; +*) + + +let PSIMPLIFY1_CONV = + let nt = `~T` + and t = `T` + and f = `F` + and nf = `~F` in + fun fm -> + try + let fm' = + if fm = nt then f + else if fm = nf then t + else if is_conj fm then + let l,r = dest_conj fm in + if l = f or r = f then f + else if l = t then r + else if r = t then l + else fm + else if is_disj fm then + let l,r = dest_disj fm in + if l = t or r = t then t + else if l = f then r + else if r = f then l + else fm + else if is_imp fm then + let l,r = dest_imp fm in + if l = f then t + else if r = t then t + else if l = t then r + else if r = f then mk_neg l + else fm + else if is_iff fm then + let l,r = dest_beq fm in + if l = f then mk_neg r + else if l = t then r + else if r = t then l + else if r = f then mk_neg l + else fm + else failwith "PSIMPLIFY: 0" in + let fm'' = mk_eq(fm,fm') in + prove(fm'',REWRITE_TAC[]) + with _ -> REFL fm;; + +(* +let fm = `T /\ T` +PSIMPLIFY1_CONV `T /\ A` + +let simplify1 fm = + match fm with + Forall(x,p) -> if mem x (fv p) then fm else p + | Exists(x,p) -> if mem x (fv p) then fm else p + | _ -> psimplify1 fm;; +*) + +let SIMPLIFY1_CONV fm = + if is_forall fm or is_exists fm then + let x,p = dest_forall fm in + if mem x (frees p) then REFL fm + else prove(mk_eq(fm,p),REWRITE_TAC[]) + else PSIMPLIFY1_CONV fm;; + +(* +let rec simplify fm = + match fm with + Not p -> simplify1 (Not(simplify p)) + | And(p,q) -> simplify1 (And(simplify p,simplify q)) + | Or(p,q) -> simplify1 (Or(simplify p,simplify q)) + | Imp(p,q) -> simplify1 (Imp(simplify p,simplify q)) + | Iff(p,q) -> simplify1 (Iff(simplify p,simplify q)) + | Forall(x,p) -> simplify1(Forall(x,simplify p)) + | Exists(x,p) -> simplify1(Exists(x,simplify p)) + | _ -> fm;; +*) + +let rec SIMPLIFY_CONV = + let not_tm = `(~)` + and ex_tm = `(?)` in + fun fm -> + if is_neg fm then + let thm1 = SIMPLIFY_CONV (dest_neg fm) in + let thm2 = AP_TERM not_tm thm1 in + let l,r = dest_eq (concl thm2) in + let thm3 = SIMPLIFY1_CONV r in + TRANS thm2 thm3 + else if is_conj fm or is_disj fm or is_imp fm or is_iff fm then + let op,l,r = get_binop fm in + let l_thm = SIMPLIFY_CONV l in + let r_thm = SIMPLIFY_CONV r in + let a_thm = (curry MK_COMB) (AP_TERM op l_thm) r_thm in + let al,ar = dest_eq (concl a_thm) in + let thm = SIMPLIFY1_CONV ar in + TRANS a_thm thm + else if is_forall fm or is_exists fm then + let x,bod = dest_quant fm in + let bod_thm = SIMPLIFY_CONV bod in + let lam_thm = ABS x bod_thm in + let q_thm = AP_TERM ex_tm lam_thm in + let l,r = dest_eq (concl q_thm) in + let thm = SIMPLIFY1_CONV r in + TRANS q_thm thm + else REFL fm;; + + + +(* + +SIMPLIFY_CONV `T /\ T \/ F` + +let operations = + ["=",(=/); "<",(",(>/); "<=",(<=/); ">=",(>=/); + "divides",(fun x y -> mod_num y x =/ Int 0)];; + +let evalc_atom at = + match at with + R(p,[s;t]) -> + (try if assoc p operations (dest_numeral s) (dest_numeral t) + then True else False + with Failure _ -> Atom at) + | _ -> Atom at;; + +let evalc = onatoms evalc_atom;; +*) + +let REAL_LEAF_CONV fm = + let op,l,r = get_binop fm in + if op = rlt then + REAL_RAT_LT_CONV fm + else if op = rgt then + REAL_RAT_GT_CONV fm + else if op = rle then + REAL_RAT_LE_CONV fm + else if op = rge then + REAL_RAT_GE_CONV fm + else if op = req then + REAL_RAT_EQ_CONV fm + else failwith "REAL_LEAF_CONV";; + +let EVALC_CONV = DEPTH_CONV REAL_LEAF_CONV;; + + + + + +(* +EVALC_CONV `x < &0 /\ &1 < &2` +(EVALC_CONV THENC SIMPLIFY_CONV) `(&0 + a * &1 = &0) /\ + ((&0 + b * &1 = &0) /\ + ((&0 + c * &1 = &0) /\ T \/ + &0 + c * &1 < &0 /\ F \/ + &0 + c * &1 > &0 /\ F) \/ + &0 + b * &1 < &0 /\ T \/ + &0 + b * &1 > &0 /\ T) \/ + &0 + a * &1 < &0 /\ + ((&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) = &0) /\ T \/ + &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 /\ F \/ + &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 /\ T) \/ + &0 + a * &1 > &0 /\ + ((&0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) = &0) /\ T \/ + &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) < &0 /\ T \/ + &0 + a * ((&0 + b * (&0 + b * -- &1)) + a * (&0 + c * &4)) > &0 /\ &1 < &2)` + +*) diff --git a/Rqe/testform.ml b/Rqe/testform.ml new file mode 100644 index 0000000..0efd73c --- /dev/null +++ b/Rqe/testform.ml @@ -0,0 +1,218 @@ +(* ====================================================================== *) +(* TESTFORM *) +(* ====================================================================== *) + +let rec TESTFORM var interpsigns_thm set_thm fm = + let polys,set,signs = dest_interpsigns interpsigns_thm in + let polys' = dest_list polys in + let signs' = dest_list signs in + if fm = t_tm then BETA_RULE (ISPECL [set] t_thm) + else if fm = f_tm then BETA_RULE (ISPECL [set] f_thm) + else if is_neg fm then + let lam = mk_abs (var,dest_neg fm) in + let thm = TESTFORM var interpsigns_thm set_thm (dest_neg fm) in + if is_pos (concl thm) then + MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_p)) thm + else if is_neg (concl thm) then + MATCH_MP (BETA_RULE (ISPECL [lam;set] neg_thm_n)) thm + else failwith "error" + else if is_conj fm then + let a,b = dest_conj fm in + let a',b' = mk_abs (var,a),mk_abs (var,b) in + let thma = TESTFORM var interpsigns_thm set_thm a in + let thmb = TESTFORM var interpsigns_thm set_thm b in + if is_neg (concl thma) && is_neg (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_nn);set_thm;thma;thmb] + else if is_neg (concl thma) && is_pos (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_np);set_thm;thma;thmb] + else if is_pos (concl thma) && is_neg (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_pn);set_thm;thma;thmb] + else if is_pos (concl thma) && is_pos (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] and_thm_pp);set_thm;thma;thmb] + else failwith "error" + else if is_disj fm then + let a,b = dest_disj fm in + let a',b' = mk_abs (var,a),mk_abs (var,b) in + let thma = TESTFORM var interpsigns_thm set_thm a in + let thmb = TESTFORM var interpsigns_thm set_thm b in + if is_neg (concl thma) && is_neg (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] or_thm_nn);set_thm;thma;thmb] + else if is_pos (concl thma) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] or_thm_p);set_thm;thma] + else if is_pos (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] or_thm_q);set_thm;thmb] + else failwith "error" + else if is_imp fm then + let a,b = dest_imp fm in + let a',b' = mk_abs (var,a),mk_abs (var,b) in + let thma = TESTFORM var interpsigns_thm set_thm a in + let thmb = TESTFORM var interpsigns_thm set_thm b in + if is_neg (concl thma) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_n);set_thm;thma] + else if is_pos (concl thma) && is_neg (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_pn);set_thm;thma;thmb] + else if is_pos (concl thma) && is_pos (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] imp_thm_pp);set_thm;thmb] + else failwith "error" + else if is_iff fm then + let a,b = dest_eq fm in + let a',b' = mk_abs (var,a),mk_abs (var,b) in + let thma = TESTFORM var interpsigns_thm set_thm a in + let thmb = TESTFORM var interpsigns_thm set_thm b in + if is_neg (concl thma) && is_neg (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_nn);set_thm;thma;thmb] + else if is_neg (concl thma) && is_pos (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_np);set_thm;thma;thmb] + else if is_pos (concl thma) && is_neg (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_pn);set_thm;thma;thmb] + else if is_pos (concl thma) && is_pos (concl thmb) then + MATCH_MPL [BETA_RULE (ISPECL [a';b';set] iff_thm_pp);set_thm;thma;thmb] + else failwith "error" + else (* an atom *) + let op,p,_ = get_binop fm in + let lam = mk_abs (var,p) in + let ind = + try + index lam polys' + with Failure "index" -> failwith "TESTFORM: Poly not present in list" in + let sign = ith ind signs' in + let thm = ith ind (interpsigns_thms interpsigns_thm) in + let thm_op,thm_p,_ = + get_binop (snd (dest_imp (snd (dest_forall (concl thm))))) in + if op = req then + if thm_op = req then thm + else if thm_op = rlt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_eq_thm);thm] + else if thm_op = rgt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_eq_thm);thm] + else failwith "error" + else if op = rlt then + if thm_op = rlt then thm + else if thm_op = req then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_lt_thm);thm] + else if thm_op = rgt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_lt_thm);thm] + else failwith "error" + else if op = rgt then + if thm_op = rgt then thm + else if thm_op = req then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_gt_thm);thm] + else if thm_op = rlt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_gt_thm);thm] + else failwith "error" + else if op = rle then + if thm_op = rlt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_le_thm);thm] + else if thm_op = req then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_le_thm);thm] + else if thm_op = rgt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_le_thm);thm] + else failwith "error" + else if op = rge then + if thm_op = rlt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] lt_ge_thm);thm] + else if thm_op = req then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] eq_ge_thm);thm] + else if thm_op = rgt then + MATCH_MPL [BETA_RULE (ISPECL [lam;set] gt_ge_thm);thm] + else failwith "error" + else failwith "error" ;; + +let TESTFORM var interpsigns_thm set_thm fm = + let start_time = Sys.time() in + let res = TESTFORM var interpsigns_thm set_thm fm in + testform_timer +.= (Sys.time() -. start_time); + res;; + + +let tvar,tmat,tfm = ref `T`,ref TRUTH,ref `T`;; +(* +let var,mat_thm,fm = !tvar,!tmat,!tfm +*) + +let COMBINE_TESTFORMS = + let lem1 = TAUT `(T ==> a) <=> a` + and lem2 = TAUT `(T /\ x) <=> x` + and imat_tm = `interpmat` in + fun var mat_thm fm -> + tvar := var; + tmat := mat_thm; + tfm := fm; + (* if not (fst (strip_comb (concl mat_thm)) = imat_tm) then failwith "not a mat thm" else *) + let mat_thm' = (CONV_RULE (RATOR_CONV (RAND_CONV (LIST_CONV (ALPHA_CONV var))))) mat_thm in + let rol_thm,all2_thm = interpmat_thms mat_thm' in + let ord_thms = rol_nonempty_thms rol_thm in + let part_thm = PARTITION_LINE_CONV (snd(dest_comb(concl rol_thm))) in + let isigns_thms = CONJUNCTS(REWRITE_RULE[ALL2;part_thm] all2_thm) in + let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in + if exists (fun x -> is_forall(concl x)) ex_thms then + let witness_thm = find (fun x -> is_forall(concl x)) ex_thms in + let i = try index witness_thm ex_thms with _ -> failwith "COMBINE_TESTFORMS: witness not present" in + let ord_thm = ith i ord_thms in + let x,bod = dest_exists (concl ord_thm) in + if bod = t_tm then + let thm1 = ISPEC var witness_thm in + let thm2 = PURE_REWRITE_RULE[lem1] thm1 in + let exists_thm = EXISTS (mk_exists(var,concl thm2),var) thm2 in + EQT_INTRO exists_thm + else + let nv = new_var real_ty in + let ord_thm' = CONV_RULE (RAND_CONV (ALPHA_CONV nv)) ord_thm in + let y,bod = dest_exists (concl ord_thm') in + let ass_thm = ASSUME bod in + let thm = MATCH_MP witness_thm ass_thm in + let exists_thm = EXISTS (mk_exists(y,concl thm) ,y) thm in + let ret = CHOOSE (nv,ord_thm) exists_thm in + EQT_INTRO ret + else + if length ord_thms = 1 & snd(dest_exists(concl (hd ord_thms))) = t_tm then + PURE_REWRITE_RULE[lem2] (EQF_INTRO (hd ex_thms)) else + let ex_thms' = map (MATCH_MP NOT_EXISTS_CONJ_THM) ex_thms in + let len = length ex_thms' in + let first,[t1;t2] = chop_list (len-2) ex_thms' in + let base = MATCH_MPL[testform_itlem;t1;t2] in + let ex_thm = itlist (fun x y -> MATCH_MPL[testform_itlem;x;y]) first base in + let cover_thm = ROL_COVERS rol_thm in + let pre_thm = MATCH_MP ex_thm (ISPEC var cover_thm) in + let gen_thm = GEN var pre_thm in + let ret = MATCH_EQ_MP FORALL_NOT_THM gen_thm in + EQF_INTRO ret;; + +let COMBINE_TESTFORMS var mat_thm fm = + let start_time = Sys.time() in + let res = COMBINE_TESTFORMS var mat_thm fm in + combine_testforms_timer +.= (Sys.time() -. start_time); + res;; + +(* {{{ Examples *) +(* + +let var,mat_thm,fm = +rx,ASSUME `interpsigns [\x. &1 + x * (&0 + x * &1)] (\x. T) [Pos]`,ASSUME `?x:real. T` + + +let ex_thms = map2 (fun x y -> TESTFORM var x y fm) isigns_thms ord_thms in +TESTFORM ry (hd isigns_thms) (hd ord_thms) fm +TESTFORM ry (hd isigns_thms) (hd ord_thms) `&1 + y * (&0 + x * -- &1) <= &0` +TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` +TESTFORM ry (hd isigns_thms) (hd ord_thms) `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` +let fm = `(&1 + y * (&0 + x * -- &1) <= &0) /\ (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0` + +let var,mat_thm,fm = +ry, +ASSUME `interpmat [] [\y. (&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1); \y. &1 + y * (&0 + x * -- &1)] [[Neg; Pos]]`, +`~((&1 + x * (&0 + x * -- &1)) + y * (&0 + y * -- &1) < &0 /\ &1 + y * (&0 + x * -- &1) <= &0)` + +let var,mat_thm,fm = +ry, +ASSUME `interpmat [x_354] + [\y. (&1 + x * -- &1) + y * (&0 + x * -- &2); \x. &1 + x * -- &1; + \y. (&1 + x * -- &1) + y * (&0 + x * -- &2)] + [[Neg; Pos; Neg]; [Neg; Zero; Neg]; [Neg; Neg; Neg]]`, +`~(&1 + x * -- &1 < &0 /\ &1 + y * -- &1 < &0 + ==> (&1 + x * -- &1) + y * (&0 + x * -- &2) < &0)` + + +*) + +(* }}} *) diff --git a/Rqe/testform_thms.ml b/Rqe/testform_thms.ml new file mode 100644 index 0000000..8594e04 --- /dev/null +++ b/Rqe/testform_thms.ml @@ -0,0 +1,196 @@ +(* ------------------------------------------------------------------------- *) +(* Evaluate a quantifier-free formula given a sign matrix row for its polys. *) +(* ------------------------------------------------------------------------- *) + +(* +let rec testform pmat fm = + match fm with + Atom(R(a,[p;Fn("0",[])])) -> + let s = assoc p pmat in + if a = "=" then s = Zero + else if a = "<=" then s = Zero or s = Negative + else if a = ">=" then s = Zero or s = Positive + else if a = "<" then s = Negative + else if a = ">" then s = Positive + else failwith "testform: unknown literal" + | False -> false + | True -> true + | Not(p) -> not(testform pmat p) + | And(p,q) -> testform pmat p & testform pmat q + | Or(p,q) -> testform pmat p or testform pmat q + | Imp(p,q) -> not(testform pmat p) or testform pmat q + | Iff(p,q) -> (testform pmat p = testform pmat q) + | _ -> failwith "testform: non-propositional formula";; + +The model version of testform takes a row of the sign matrix in the form + (p_1,s_1),(p_2,s_2),...,(p_n,s_n) +The corresponding argument of TESTFORM is a theorem representing +an `interpsigns` proposition. This is natural. The next argument, +the formula to be tested, is the same. + +*) + +(* ====================================================================== *) +(* Theorems *) +(* ====================================================================== *) + +(* -------------------------------- T -------------------------------- *) + +let t_thm = prove(`!set:real->bool. (!x. set x ==> T)`,MESON_TAC[]);; + +(* -------------------------------- F --------------------------------- *) + +let f_thm = prove(`!set:real->bool. ~(?x. set x /\ F)`,MESON_TAC[]);; + +(* -------------------------------- ~ --------------------------------- *) + +let neg_thm_p = prove( + `!P set. (!x. set x ==> P x) ==> (~ ?x. set x /\ ~ P x)`,MESON_TAC[]);; + +let neg_thm_n = prove( + `!P set. (~ ?x. set x /\ P x) ==> (!x. set x ==> ~ P x)`,MESON_TAC[]);; + +(* -------------------------------- /\ -------------------------------- *) + +let and_thm_pp = prove( + `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (!x. set x ==> Q x) ==> + (!x. set x ==> (P x /\ Q x))`,MESON_TAC[]);; + +let and_thm_pn = prove( + `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> + (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; + +let and_thm_np = prove( + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + (!x. set x ==> Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; + +let and_thm_nn = prove( + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ P x /\ Q x)`,MESON_TAC[]);; + +(* -------------------------------- \/ -------------------------------- *) + +let or_thm_p = prove( +`!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (!x. set x ==> (P x \/ Q x))`, + MESON_TAC[]);; + +let or_thm_q = prove( + `!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> (!x. set x ==> (P x \/ Q x))`, + MESON_TAC[]);; + +let or_thm_nn = + prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x \/ Q x))`,MESON_TAC[]);; + +(* ------------------------------- ==> -------------------------------- *) + +let imp_thm_pp = + prove(`!P Q set. (?x. set x) ==> (!x. set x ==> Q x) ==> + (!x. set x ==> (P x ==> Q x))`,MESON_TAC[]);; + +let imp_thm_pn = + prove(`!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> + (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x ==> Q x))`,MESON_TAC[]);; + +let imp_thm_n = + prove(`!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + (!x. set x ==> (P x ==> Q x))`,MESON_TAC[]);; + +(* -------------------------------- = --------------------------------- *) + +let iff_thm_pp = prove( + `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> (!x. set x ==> Q x) ==> + (!x. set x ==> (P x <=> Q x))`,MESON_TAC[]);; + +let iff_thm_pn = prove( + `!P Q set. (?x. set x) ==> (!x. set x ==> P x) ==> + (~ ?x. set x /\ Q x) ==> (~ ?x. set x /\ (P x <=> Q x))`,MESON_TAC[]);; + +let iff_thm_np = prove( + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + (!x. set x ==> Q x) ==> (~ ?x. set x /\ (P x <=> Q x))`,MESON_TAC[]);; + +let iff_thm_nn = prove( + `!P Q set. (?x. set x) ==> (~ ?x. set x /\ P x) ==> + (~ ?x. set x /\ Q x) ==> (!x. set x ==> (P x <=> Q x))`,MESON_TAC[]);; + +(* ---------------------------------------------------------------------- *) +(* Atoms *) +(* ---------------------------------------------------------------------- *) + +(* --------------------------- ?x. p x < &0 --------------------------- *) + +let eq_lt_thm = prove( + `!P set. (!x. set x ==> (P x = &0)) ==> ~ ?x. set x /\ P x < &0`, + MESON_TAC[REAL_LT_LE]);; + +let gt_lt_thm = prove( + `!P set. (!x. set x ==> (P x > &0)) ==> ~ ?x. set x /\ P x < &0`, + MESON_TAC[real_gt;REAL_LT_REFL;REAL_LT_TRANS]);; + +(* --------------------------- ?x. p x = &0 --------------------------- *) + +let lt_eq_thm = prove( + `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x = &0)`, + MESON_TAC[REAL_LT_LE]);; + +let gt_eq_thm = prove( + `!P set. (!x. set x ==> (P x > &0)) ==> ~ ?x. set x /\ (P x = &0)`, + MESON_TAC[real_gt;REAL_LT_LE]);; + +(* --------------------------- ?x. p x > &0 --------------------------- *) + +let eq_gt_thm = prove( + `!P set. (!x. set x ==> (P x = &0)) ==> ~ ?x. set x /\ (P x > &0)`, + MESON_TAC[real_gt;REAL_LT_LE]);; + +let lt_gt_thm = prove( + `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x > &0)`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS]);; + +(* -------------------------- ?x. p x <= &0 --------------------------- *) + +let lt_le_thm = prove( + `!P set. (!x. set x ==> (P x < &0)) ==> !x. set x ==> (P x <= &0)`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS]);; + +let eq_le_thm = prove( + `!P set. (!x. set x ==> (P x = &0)) ==> (!x. set x ==> (P x <= &0))`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_le]);; + +let gt_le_thm = prove( + `!P set. (!x. set x ==> (P x > &0)) ==> ~ ?x. set x /\ (P x <= &0)`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_le]);; + +(* -------------------------- ?x. p x >= &0 --------------------------- *) + +let lt_ge_thm = prove( + `!P set. (!x. set x ==> (P x < &0)) ==> ~ ?x. set x /\ (P x >= &0)`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge]);; + +let eq_ge_thm = prove( + `!P set. (!x. set x ==> (P x = &0)) ==> (!x. set x ==> (P x >= &0))`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge;real_le]);; + +let gt_ge_thm = prove( + `!P set. (!x. set x ==> (P x > &0)) ==> (!x. set x ==> (P x >= &0))`, + MESON_TAC[real_gt;REAL_LT_LE;REAL_LT_TRANS;real_ge;real_le]);; + +(* let lookup_sign isigns_thm fm = *) +(* let asms,_ = dest_thm isigns_thm in *) +(* let *) + + +let NOT_EXISTS_CONJ_THM = prove_by_refinement( + `~(?x. P x /\ Q x) ==> (!x. P x ==> ~Q x)`, +(* {{{ Proof *) +[ + MESON_TAC[]; +]);; +(* }}} *) + +let testform_itlem = prove_by_refinement( + `(!x. P x ==> ~Q x) ==> (!x. P2 x ==> ~Q x) ==> (!x. P x \/ P2 x ==> ~ Q x)`, +(* {{{ Proof *) +[MESON_TAC[]]);; +(* }}} *) diff --git a/Rqe/timers.ml b/Rqe/timers.ml new file mode 100644 index 0000000..09fe144 --- /dev/null +++ b/Rqe/timers.ml @@ -0,0 +1,120 @@ +let testform_timer = ref 0.0;; +let combine_testforms_timer = ref 0.0;; + +let condense_timer = ref 0.0;; + +let inferisign_timer = ref 0.0;; + +let matinsert_timer = ref 0.0;; + +let inferpsign_timer = ref 0.0;; + +let remove_column1_timer = ref 0.0;; +let add_infinities_timer = ref 0.0;; +let remove_infinities_timer = ref 0.0;; + +let pdivides_timer = ref 0.0;; + +let duplicate_columns_timer = ref 0.0;; +let unmonicize_mat_timer = ref 0.0;; +let swap_head_col_timer = ref 0.0;; +let replace_pol_timer = ref 0.0;; +let unfactor_mat_timer = ref 0.0;; + +let reset_timers() = + + testform_timer := 0.0; + combine_testforms_timer := 0.0; + + condense_timer := 0.0; + + inferisign_timer := 0.0; + + matinsert_timer := 0.0; + + inferpsign_timer := 0.0; + + remove_column1_timer := 0.0; + add_infinities_timer := 0.0; + remove_infinities_timer := 0.0; + + pdivides_timer := 0.0; + + duplicate_columns_timer := 0.0; + unmonicize_mat_timer := 0.0; + swap_head_col_timer := 0.0; + replace_pol_timer := 0.0; + unfactor_mat_timer := 0.0; + +;; + + +let print_timers() = + print_string "\n----------TIMERS---------\n\n"; + + print_string "TESTFORM: "; + print_float !testform_timer; + print_string "\n"; + + print_string "COMBINE_TESTFORMS: "; + print_float !combine_testforms_timer; + print_string "\n"; + + print_string "CONDENSE: "; + print_float !condense_timer; + print_string "\n"; + + print_string "INFERISIGN: "; + print_float !inferisign_timer; + print_string "\n"; + + print_string "MATINSERT: "; + print_float !matinsert_timer; + print_string "\n"; + + print_string "INFERPSIGN: "; + print_float !inferpsign_timer; + print_string "\n"; + + print_string "REMOVE_COLUMN1: "; + print_float !remove_column1_timer; + print_string "\n"; + + print_string "ADD_INFINITIES: "; + print_float !add_infinities_timer; + print_string "\n"; + + print_string "REMOVE_INFINITIES: "; + print_float !remove_infinities_timer; + print_string "\n"; + + print_string "PDIVIDES: "; + print_float !pdivides_timer; + print_string "\n"; + + print_string "DUPLICATE_COLUMNS: "; + print_float !duplicate_columns_timer; + print_string "\n"; + + print_string "UNMONICIZE_MAT: "; + print_float !unmonicize_mat_timer; + print_string "\n"; + + print_string "SWAP_HEAD_COL: "; + print_float !swap_head_col_timer; + print_string "\n"; + + print_string "REPLACE_POL: "; + print_float !replace_pol_timer; + print_string "\n"; + + print_string "UNFACTOR_MAT: "; + print_float !unfactor_mat_timer; + print_string "\n"; + + + print_string "\n-------------------------\n"; + +;; + + diff --git a/Rqe/util.ml b/Rqe/util.ml new file mode 100644 index 0000000..04adaad --- /dev/null +++ b/Rqe/util.ml @@ -0,0 +1,96 @@ +(* ---------------------------------------------------------------------- *) +(* Strings *) +(* ---------------------------------------------------------------------- *) + + +let string_of_char c = String.make 1 c;; + + + +(* ---------------------------------------------------------------------- *) +(* Types *) +(* ---------------------------------------------------------------------- *) + + +let gensort = sort (<);; +let suppress = ref ([]:string list);; +suppress := ["==>";"?";"!";"/\\";"\\/";",";"~";"APPEND";"CONS";"HD";"LAST"; + "NIL";"=";"real_lt";"real_gt";"real_le";"real_ge";"BIT0";"BIT1";"NUMERAL"; + "real_of_num";"_0";"_1";"real_div";"real_mul";"real_pow";"COND"];; + +let rec get_type_list tm = + match tm with + Var(s,t) -> if mem s !suppress then [] else [(s,t)] + | Const(s,t) -> if mem s !suppress then [] else [(s,t)] + | Comb (t1,t2) -> get_type_list t1 @ get_type_list t2 + | Abs (t1,t2) -> get_type_list t1 @ get_type_list t2;; + +let my_print_type (s,t) = + print_string ("(\"" ^ s ^ "\", "); + print_qtype t; + print_string ")\n";; + +let rec my_print_typel l = + match l with + [] -> (); + | (h::t) -> my_print_type h; my_print_typel t;; + +let set_types tm = (gensort o setify o get_type_list) tm;; + +let print_term_types = my_print_typel o set_types;; +let print_thm_types tm = print_term_types (concl tm);; +let goal_types() = (print_term_types o snd o top_goal)();; + +let assum i = (rev_ith i o fst o top_goal)();; +let assum_types i = (print_term_types o rev_ith i o fst o top_goal)();; + +let (get_type:string->thm->hol_type) = + fun s thm -> assoc s (get_type_list (concl thm));; + + +(* ---------------------------------------------------------------------- *) +(* Proof Stack *) +(* ---------------------------------------------------------------------- *) + +exception Empty_stack;; +let proof_stack = ref ([]:goalstack list);; +let push_proof t = + proof_stack := [!current_goalstack] @ !proof_stack; + g t;; + +let pop_proof() = + match !proof_stack with + [] -> raise Empty_stack + | h::t -> current_goalstack := h; proof_stack := t; + p();; + +(* ---------------------------------------------------------------------- *) +(* Printing *) +(* ---------------------------------------------------------------------- *) + +let print_thm_no_hyps th = + let asl,tm = dest_thm th in + (if not (asl = []) then + print_string "..." + else (); + open_hbox(); + print_string "|- "; + print_term tm; + close_box());; + + +let print_trace_thm hyps msg th = + let asl,tm = dest_thm th in + open_hbox(); + print_string "------------------------\n "; + print_string (msg ^ "\n"); + if hyps then print_thm th else print_thm_no_hyps th; + print_string "\n========================\n "; + close_box();; + +(* +#install_printer print_thm_no_hyps;; +#install_printer print_thm;; +*) + + diff --git a/Rqe/work_thms.ml b/Rqe/work_thms.ml new file mode 100644 index 0000000..2652088 --- /dev/null +++ b/Rqe/work_thms.ml @@ -0,0 +1,8279 @@ +let rec DISJ_TAC thm = DISJ_CASES_TAC thm THENL[ALL_TAC;TRY (POP_ASSUM DISJ_TAC)];; + +let INTERPSIGNS_CONJ = prove_by_refinement( + `!P Q eqs l. + interpsigns eqs (\x. P x) l /\ + interpsigns eqs (\x. Q x) l ==> + interpsigns eqs (\x. P x \/ Q x) l`, +(* {{{ Proof *) + +[ + STRIP_TAC THEN STRIP_TAC; + REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[interpsigns;ALL2;interpsign]; + REPEAT (POP_ASSUM MP_TAC); + DISJ_TAC (ISPEC `h':sign` SIGN_CASES) THEN ASM_REWRITE_TAC[interpsign;interpsigns] THEN REPEAT STRIP_TAC THEN ASM_MESON_TAC[]; +]);; + +(* }}} *) + +let INTERPMAT_TRIO = prove_by_refinement( + `!eqs x y l r t. + interpmat (CONS x (CONS y t)) eqs (CONS l (CONS l (CONS l r))) ==> + interpmat (CONS y t) eqs (CONS l r)`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat;partition_line;NOT_CONS_NIL;ALL2;HD;TL;APPEND]; + REPEAT_N 6 STRIP_TAC; + DISJ_CASES_TAC (ISPEC `t:real list` list_CASES); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + MATCH_ACCEPT_TAC ROL_SING; + REWRITE_TAC[ALL2]; + REWRITE_ASSUMS[TL]; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\z. z < x \/ (z = x) \/ (x < z /\ z < y)`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[NOT_CONS_NIL;TL]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[ROL_TAIL;TL;NOT_CONS_NIL;]; + REWRITE_TAC[ALL2]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\z. z < x \/ (z = x) \/ (x < z /\ z < y)`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; +]);; + +(* }}} *) + +let PARTITION_LINE_NOT_NIL = prove_by_refinement( + `!l. ~(partition_line l = [])`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[partition_line;NOT_CONS_NIL;]; + REWRITE_TAC[partition_line]; + COND_CASES_TAC; + REWRITE_TAC[NOT_CONS_NIL]; + ASM_MESON_TAC[APPEND_EQ_NIL;NOT_CONS_NIL]; +]);; + +(* }}} *) + +let ALL2_LENGTH = prove_by_refinement( + `!P l1 l2. ALL2 P l1 l2 ==> (LENGTH l1 = LENGTH l2)`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[ALL2;LENGTH]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let LENGTH_TL = prove_by_refinement( + `!l:A list. ~(l = []) ==> (LENGTH (TL l) = PRE (LENGTH l))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[NOT_CONS_NIL;TL;LENGTH;]; + ARITH_TAC; +]);; +(* }}} *) + +let PARTITION_LINE_LENGTH = prove_by_refinement( + `!l. LENGTH (partition_line l) = 2 * LENGTH l + 1`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[partition_line;LENGTH;]; + ARITH_TAC; + REWRITE_TAC[partition_line;LENGTH;]; + COND_CASES_TAC; + ASM_REWRITE_TAC[LENGTH;]; + ARITH_TAC; + REWRITE_TAC[APPEND;LENGTH;]; + ASM_SIMP_TAC[PARTITION_LINE_NOT_NIL;LENGTH_TL]; + ARITH_TAC; +]);; + +(* }}} *) + +let PARTITION_LINE_LENGTH_TL = prove_by_refinement( + `!l. LENGTH (TL (partition_line l)) = 2 * LENGTH l`, +(* {{{ Proof *) +[ + STRIP_TAC; + REWRITE_TAC[MATCH_MP LENGTH_TL (ISPEC `l:real list` PARTITION_LINE_NOT_NIL)]; + REWRITE_TAC[PARTITION_LINE_LENGTH]; + ARITH_TAC; +]);; +(* }}} *) + +let PL_ALL2_LENGTH = prove_by_refinement( + `!eqs pts sgns. ALL2 (interpsigns eqs) (partition_line pts) sgns ==> + (LENGTH sgns = 2 * LENGTH pts + 1)`, +(* {{{ Proof *) + +[ + REPEAT_N 3 STRIP_TAC; + DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); + ASM_REWRITE_TAC[interpmat;LENGTH;ROL_NIL;partition_line;]; + ARITH_SIMP_TAC[]; + DISJ_CASES_TAC (ISPEC `sgns:(sign list) list` list_CASES); + ASM_REWRITE_TAC[ALL2]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[ALL2]; + DISJ_CASES_TAC (ISPEC `t:(sign list) list` list_CASES); + ASM_REWRITE_TAC[ALL2;LENGTH;ONE]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[ALL2]; + (* save *) + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[interpmat;partition_line;]; + COND_CASES_TAC; + ASM_REWRITE_TAC[ROL_SING;LENGTH;GSYM ONE]; + ARITH_SIMP_TAC[]; + STRIP_TAC; + CLAIM `LENGTH [\x. x < h; \x. x = h; \x. h < x] = LENGTH sgns`; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + REWRITE_ASSUMS[NOT_NIL]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + REWRITE_TAC[LENGTH]; + STRIP_TAC; + CLAIM `LENGTH sgns = LENGTH (APPEND [\x. x < h; \x. x = h; \x. h < x /\ x < HD t] (TL (partition_line t)))`; + ASM_MESON_TAC[ ALL2_LENGTH]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[LENGTH_APPEND]; + REWRITE_TAC[PARTITION_LINE_LENGTH_TL]; + REWRITE_TAC[LENGTH]; + ARITH_TAC; +]);; + +(* }}} *) + +let INTERPMAT_LENGTH = prove_by_refinement( + `!eqs pts sgns. interpmat pts eqs sgns ==> + (LENGTH sgns = 2 * LENGTH pts + 1)`, +(* {{{ Proof *) + +[ + REPEAT_N 3 STRIP_TAC; + DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); + ASM_REWRITE_TAC[interpmat;LENGTH;ROL_NIL;partition_line;]; + ARITH_SIMP_TAC[]; + DISJ_CASES_TAC (ISPEC `sgns:(sign list) list` list_CASES); + ASM_REWRITE_TAC[ALL2]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[ALL2]; + DISJ_CASES_TAC (ISPEC `t:(sign list) list` list_CASES); + ASM_REWRITE_TAC[ALL2;LENGTH;ONE]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[ALL2]; + (* save *) + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[interpmat;partition_line;]; + COND_CASES_TAC; + ASM_REWRITE_TAC[ROL_SING;LENGTH;GSYM ONE]; + ARITH_SIMP_TAC[]; + STRIP_TAC; + CLAIM `LENGTH [\x. x < h; \x. x = h; \x. h < x] = LENGTH sgns`; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + REWRITE_ASSUMS[NOT_NIL]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + REWRITE_TAC[LENGTH]; + STRIP_TAC; + CLAIM `LENGTH sgns = LENGTH (APPEND [\x. x < h; \x. x = h; \x. h < x /\ x < HD t] (TL (partition_line t)))`; + ASM_MESON_TAC[ ALL2_LENGTH]; + DISCH_THEN SUBST1_TAC; + REWRITE_TAC[LENGTH_APPEND]; + REWRITE_TAC[PARTITION_LINE_LENGTH_TL]; + REWRITE_TAC[LENGTH]; + ARITH_TAC; +]);; + +(* }}} *) + +let ALL2_HD = prove_by_refinement( + `!b d a c. (LENGTH a = LENGTH c) ==> + ALL2 P (APPEND a b) (APPEND c d) ==> ALL2 P a c`, +(* {{{ Proof *) + +[ + REPEAT_N 2 STRIP_TAC; + LIST_INDUCT_TAC; + ONCE_REWRITE_TAC[prove(`(x = y) <=> (y = x)`,MESON_TAC[])]; + REWRITE_TAC[LENGTH;LENGTH_EQ_NIL]; + MESON_TAC[ALL2]; + REWRITE_TAC[LENGTH;APPEND;]; + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + REWRITE_TAC[LENGTH;APPEND;ALL2;SUC_INJ]; + ASM_MESON_TAC[]; +]);; + +(* }}} *) + +let ALL2_TL = prove_by_refinement( + `!b d a c. (LENGTH a = LENGTH c) ==> + ALL2 P (APPEND a b) (APPEND c d) ==> ALL2 P b d`, +(* {{{ Proof *) +[ + REPEAT_N 2 STRIP_TAC; + LIST_INDUCT_TAC; + ONCE_REWRITE_TAC[prove(`(x = y) <=> (y = x)`,MESON_TAC[])]; + REWRITE_TAC[LENGTH;LENGTH_EQ_NIL]; + MESON_TAC[APPEND]; + REWRITE_TAC[LENGTH;APPEND;]; + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + REWRITE_TAC[ALL2;APPEND;LENGTH;SUC_INJ]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let ALL2_APPEND_LENGTH = prove_by_refinement( + `!P a c b d. (LENGTH a = LENGTH c) ==> + ALL2 P (APPEND a b) (APPEND c d) ==> ALL2 P a c /\ ALL2 P b d`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[ALL2_HD;ALL2_TL]; +]);; +(* }}} *) + +let ALL2_APPEND = prove_by_refinement( + `!a c b d. ALL2 P a c /\ ALL2 P b d ==> + ALL2 P (APPEND a b) (APPEND c d)`, +(* {{{ Proof *) +[ + REPEAT LIST_INDUCT_TAC THEN REWRITE_ALL[APPEND;ALL2;LENGTH;ARITH_RULE `~(0 = SUC x)`;APPEND_NIL]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[ALL2]; +]);; +(* }}} *) + +let ALL2_SPLIT = prove_by_refinement( + `!a c b d. (LENGTH a = LENGTH c) ==> + (ALL2 P (APPEND a b) (APPEND c d) <=> ALL2 P a c /\ ALL2 P b d)`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[ALL2_APPEND;ALL2_APPEND_LENGTH]; +]);; +(* }}} *) + +let BUTLAST_THM = prove_by_refinement( + `(BUTLAST [] = []) /\ + (BUTLAST [x] = []) /\ + (BUTLAST (CONS h1 (CONS h2 t)) = CONS h1 (BUTLAST (CONS h2 t)))`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[BUTLAST;NOT_CONS_NIL;]; +]);; +(* }}} *) + +let HD_BUTLAST = prove_by_refinement( + `!l. ~(l = []) ==> (!x. ~(l = [x])) ==> (HD (BUTLAST l) = HD l)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[NOT_CONS_NIL;HD;BUTLAST]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REPEAT STRIP_TAC; + REWRITE_TAC[HD]; +]);; +(* }}} *) + + +let SUBLIST = new_recursive_definition list_RECURSION + `(SUBLIST l [] <=> (l = [])) /\ + (SUBLIST l (CONS h t) <=> (l = []) \/ + SUBLIST l t \/ + ((HD l = h) /\ SUBLIST (TL l) t))`;; + +let SUBLIST_NIL = prove_by_refinement( + `!l. SUBLIST [] l`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN + ASM_MESON_TAC[SUBLIST]; +]);; +(* }}} *) + +let SUBLIST_CONS = prove_by_refinement( + `!l1 l2 h. SUBLIST l1 l2 ==> SUBLIST l1 (CONS h l2)`, +(* {{{ Proof *) +[ + REPEAT LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST]; +]);; +(* }}} *) + +let SUBLIST_TL = prove_by_refinement( + `!l1 l2. SUBLIST l1 l2 ==> ~(l1 = []) ==> SUBLIST (TL l1) l2`, +(* {{{ Proof *) +[ + REPEAT LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST;] +]);; +(* }}} *) + +let SUBLIST_CONS2 = prove_by_refinement( + `!h t l. SUBLIST (CONS h t) l ==> SUBLIST t l`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; +]);; +(* }}} *) + +let SUBLIST_ID = prove_by_refinement( + `!l. SUBLIST l l`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;NOT_CONS_NIL;HD;TL]; +]);; +(* }}} *) + +let SUBLIST_CONS_CONS = prove_by_refinement( + `!h t1 t2. SUBLIST (CONS h t1) (CONS h t2) = SUBLIST t1 t2`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID]; + ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID]; + REWRITE_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID;NOT_CONS_NIL;HD;TL]; + REWRITE_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID;NOT_CONS_NIL;HD;TL;SUBLIST_CONS2;SUBLIST_CONS]; + ASM_MESON_TAC[SUBLIST;SUBLIST_NIL;SUBLIST_ID;NOT_CONS_NIL;HD;TL]; +]);; +(* }}} *) + +let SUBLIST_NEQ = prove_by_refinement( + `!h1 h2 t1 t2. SUBLIST (CONS h1 t1) (CONS h2 t2) ==> ~(h1 = h2) ==> + SUBLIST (CONS h1 t1) t2`, +(* {{{ Proof *) +[ + ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; +]);; +(* }}} *) + +let SUBLIST_TRANS = prove_by_refinement( + `!l1 l2 l3. SUBLIST l1 l2 ==> SUBLIST l2 l3 ==> SUBLIST l1 l3`, +(* {{{ Proof *) +[ + REPEAT LIST_INDUCT_TAC; + ASM_MESON_TAC[SUBLIST]; + ASM_MESON_TAC[SUBLIST]; + ASM_MESON_TAC[SUBLIST]; + ASM_MESON_TAC[SUBLIST]; + ASM_MESON_TAC[SUBLIST]; + ASM_MESON_TAC[SUBLIST]; + ASM_MESON_TAC[SUBLIST]; + REPEAT STRIP_TAC; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; + CASES_ON `h = h''`; + DISJ2_TAC; + ASM_REWRITE_TAC[]; + POP_ASSUM (REWRITE_ALL o list); + CASES_ON `h' = h''`; + POP_ASSUM (REWRITE_ALL o list); + ASM_MESON_TAC[SUBLIST_CONS_CONS]; + REWRITE_ASSUMS[IMP_AND_THM]; + FIRST_ASSUM MATCH_MP_TAC; + EVERY_ASSUM (fun x -> try MP_TAC (MATCH_MP SUBLIST_CONS2 x) with _ -> ALL_TAC); + REPEAT STRIP_TAC; + ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL;SUBLIST_CONS;SUBLIST_CONS2]; + DISJ1_TAC; + CASES_ON `h' = h''`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ASSUMS[SUBLIST_CONS_CONS]; + CLAIM `SUBLIST (CONS h t) t'`; + ASM_MESON_TAC[SUBLIST_NEQ]; + STRIP_TAC; + ASM_MESON_TAC[]; + CASES_ON `h = h'`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ASSUMS[SUBLIST_CONS_CONS]; + ASM_MESON_TAC[SUBLIST_NEQ]; + CLAIM `SUBLIST (CONS h t) t'`; + ASM_MESON_TAC[SUBLIST_NEQ]; + STRIP_TAC; + CLAIM `SUBLIST (CONS h' t') t''`; + ASM_MESON_TAC[SUBLIST_NEQ]; + STRIP_TAC; + CLAIM `SUBLIST t' t''`; + ASM_MESON_TAC[SUBLIST_CONS2]; + STRIP_TAC; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let ROL_MEM = prove_by_refinement( + `!h t. real_ordered_list (CONS h t) ==> !x. MEM x t ==> h < x`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[MEM]; + REPEAT STRIP_TAC; + CASES_ON `x = h'`; + POP_ASSUM (REWRITE_ALL o list); + ASM_MESON_TAC[ROL_CONS_CONS]; + CLAIM `real_ordered_list (CONS h t)`; + ASM_MESON_TAC[ROL_CONS_CONS_DELETE]; + DISCH_THEN (REWRITE_ASSUMS o list); + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[MEM]; +]);; +(* }}} *) + +let SUBLIST_MEM = prove_by_refinement( + `!x l1 l2. SUBLIST l1 l2 ==> MEM x l1 ==> MEM x l2`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + REWRITE_TAC[MEM]; + REWRITE_TAC[MEM]; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; + REPEAT STRIP_TAC; + CASES_ON `h = h'`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ASSUMS[SUBLIST_CONS_CONS]; + CASES_ON `x = h'`; + ASM_MESON_TAC[MEM]; + REWRITE_ASSUMS[IMP_AND_THM]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[MEM;SUBLIST_CONS]; + CASES_ON `x = h'`; + ASM_MESON_TAC[MEM]; + ASM_MESON_TAC[SUBLIST_NEQ;SUBLIST;MEM]; +]);; +(* }}} *) + +let ROL_SUBLIST_LT = prove_by_refinement( + `!h t1 t2. real_ordered_list (CONS h t2) ==> + SUBLIST (CONS h t1) (CONS h t2) ==> !x. MEM x t1 ==> h < x`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + REWRITE_TAC[MEM]; + REWRITE_TAC[MEM]; + ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; + REPEAT STRIP_TAC; + REWRITE_ASSUMS[SUBLIST_CONS_CONS]; + CLAIM `MEM x (CONS h'' t')`; + ASM_MESON_TAC[SUBLIST_MEM]; + STRIP_TAC; + ASM_MESON_TAC[ROL_MEM]; +]);; +(* }}} *) + +let SUBLIST_DELETE = prove_by_refinement( + `!h1 h2 t l. SUBLIST (CONS h1 (CONS h2 t)) l ==> + SUBLIST (CONS h1 t) l`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; + CASES_ON `h1 = h`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;HD;TL;SUBLIST_NIL]; + STRIP_TAC; + CLAIM `SUBLIST [h1; h2] t`; + ASM_MESON_TAC[SUBLIST_NEQ]; + DISCH_THEN (REWRITE_ASSUMS o list); + ASM_MESON_TAC[SUBLIST_CONS]; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; + CASES_ON `h1 = h'`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[SUBLIST_CONS_CONS]; + MESON_TAC[SUBLIST_CONS2]; + STRIP_TAC; + CLAIM `SUBLIST (CONS h1 (CONS h2 (CONS h t))) t'`; + ASM_MESON_TAC[SUBLIST_NEQ]; + DISCH_THEN (REWRITE_ASSUMS o list); + ASM_MESON_TAC[SUBLIST_CONS]; +]);; +(* }}} *) + +let SUBLIST_MATCH = prove_by_refinement( + `!h t l. SUBLIST (CONS h t) l ==> + ?(l1:A list) l2. (l = APPEND l1 (CONS h l2)) /\ SUBLIST t l2`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; + CASES_ON `h = h'`; + POP_ASSUM (REWRITE_ALL o list); + STRIP_TAC; + EXISTS_TAC `[]`; + REWRITE_TAC[APPEND;SUBLIST_NIL]; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBLIST_NIL]; + STRIP_TAC; + CLAIM `SUBLIST [h] t`; + ASM_MESON_TAC[SUBLIST_NEQ]; + DISCH_THEN (REWRITE_ASSUMS o list); + REPEAT (POP_ASSUM MP_TAC); + REPEAT STRIP_TAC; + EXISTS_TAC `CONS h' l1`; + EXISTS_TAC `l2`; + REWRITE_TAC[APPEND]; + AP_TERM_TAC; + ASM_MESON_TAC[]; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; + (* save *) + CASES_ON `h = h''`; + POP_ASSUM (REWRITE_ALL o list); + STRIP_TAC; + REWRITE_ASSUMS[SUBLIST_CONS_CONS]; + EXISTS_TAC `[]:A list`; + EXISTS_TAC `t'`; + ASM_MESON_TAC[APPEND]; + (* save *) + STRIP_TAC; + CLAIM `SUBLIST (CONS h (CONS h' t)) t'`; + ASM_MESON_TAC[SUBLIST_NEQ]; + DISCH_THEN (REWRITE_ASSUMS o list); + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + EXISTS_TAC `CONS h'' l1`; + EXISTS_TAC `l2`; + ASM_REWRITE_TAC[APPEND]; +]);; +(* }}} *) + +let ROL_SUBLIST = prove_by_refinement( + `!l1 l2. real_ordered_list l2 ==> SUBLIST l1 l2 ==> real_ordered_list l1`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[ROL_NIL]; + REWRITE_TAC[real_ordered_list]; + REPEAT STRIP_TAC; + REWRITE_ASSUMS[IMP_AND_THM]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[SUBLIST_CONS2]; + CASES_ON `t = []`; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_ASSUMS[NOT_NIL]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[HD]; + DISJ_CASES_TAC (ISPEC `l2:real list` list_CASES); + ASM_MESON_TAC[SUBLIST;NOT_CONS_NIL]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + CASES_ON `h = h''`; + POP_ASSUM (REWRITE_ALL o list); + ASM_MESON_TAC[ROL_SUBLIST_LT;MEM]; + FIRST_ASSUM (fun x -> MP_TAC (MATCH_MP SUBLIST_MATCH x)); + STRIP_TAC; + CLAIM `real_ordered_list (CONS h l2')`; + ASM_MESON_TAC[ROL_APPEND]; + STRIP_TAC; + CLAIM `MEM h' l2'`; + ASM_MESON_TAC[SUBLIST_MEM;MEM]; + STRIP_TAC; + ASM_MESON_TAC[ROL_MEM]; +]);; +(* }}} *) + +let SUBLIST_BUTLAST = prove_by_refinement( + `!l. SUBLIST (BUTLAST l) l`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[BUTLAST;SUBLIST_NIL]; + REWRITE_TAC[BUTLAST;SUBLIST_NIL;SUBLIST]; + REPEAT COND_CASES_TAC; + REWRITE_TAC[SUBLIST_NIL]; + ASM_REWRITE_TAC[HD;TL;NOT_CONS_NIL;]; +]);; + +(* }}} *) + +let SUBLIST_APPEND_HD = prove_by_refinement( + `!l2 l3 l1. SUBLIST (APPEND l1 l2) (APPEND l1 l3) = SUBLIST l2 l3`, +(* {{{ Proof *) +[ + REPEAT_N 2 STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND]; + ASM_REWRITE_TAC[APPEND;SUBLIST_CONS_CONS]; +]);; +(* }}} *) + +let SUBLIST_ID_CONS = prove_by_refinement( + `!h l. ~(SUBLIST (CONS h l) l)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[SUBLIST;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[SUBLIST;NOT_CONS_NIL;HD;TL]; + ASM_MESON_TAC[SUBLIST_DELETE]; +]);; +(* }}} *) + +let SUBLIST_ID_APPEND = prove_by_refinement( + `!m l. ~(l = []) ==> ~(SUBLIST (APPEND l m) m)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[APPEND;]; + DISCH_THEN (fun x -> ALL_TAC); + CASES_ON `t = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[APPEND;SUBLIST_ID_CONS]; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + ASM_MESON_TAC[SUBLIST_CONS2]; +]);; +(* }}} *) + +let SUBLIST_APPEND_TL = prove_by_refinement( + `!l3 l1 l2. SUBLIST (APPEND l1 l3) (APPEND l2 l3) = SUBLIST l1 l2`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + REWRITE_TAC[APPEND;APPEND_NIL;SUBLIST;SUBLIST_ID]; + REWRITE_ALL[SUBLIST_NIL;APPEND;APPEND_NIL;SUBLIST;SUBLIST_ID]; + ASM_REWRITE_TAC[]; + REWRITE_ALL[SUBLIST_NIL;SUBLIST;SUBLIST_ID;NOT_CONS_NIL;]; + ASM_MESON_TAC[SUBLIST_ID_APPEND;APPEND;NOT_CONS_NIL;]; + REWRITE_TAC[APPEND]; + CASES_ON `h = h'`; + POP_ASSUM (REWRITE_ALL o list); + EQ_TAC; + REWRITE_TAC[SUBLIST;APPEND;HD;TL;NOT_CONS_NIL;]; + STRIP_TAC; + ASM_MESON_TAC[APPEND;]; + ASM_MESON_TAC[APPEND;]; + REWRITE_TAC[SUBLIST_CONS_CONS]; + ASM_MESON_TAC[]; + EQ_TAC; + STRIP_TAC; + MATCH_MP_TAC SUBLIST_CONS; + CLAIM `SUBLIST (CONS h (APPEND t l3)) (APPEND t' l3)`; + ASM_MESON_TAC[SUBLIST_NEQ]; + STRIP_TAC; + ASM_MESON_TAC[APPEND;]; + ASM_REWRITE_TAC[NOT_CONS_NIL;SUBLIST;HD;TL]; + STRIP_TAC; + ASM_MESON_TAC[APPEND;]; +]);; +(* }}} *) + +let SUBLIST_TRANS2 = REWRITE_RULE[IMP_AND_THM] SUBLIST_TRANS;; + +let APPEND_CONS = prove_by_refinement( + `!h l1 l2. APPEND l1 (CONS h l2) = APPEND (APPEND l1 [h]) l2`, +(* {{{ Proof *) +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[APPEND_NIL;APPEND]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let SUBLIST_APPEND = prove_by_refinement( + `!l1 l2 m1 m2. SUBLIST l1 l2 ==> SUBLIST m1 m2 ==> + SUBLIST (APPEND l1 m1) (APPEND l2 m2)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[SUBLIST_NIL;APPEND]; + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND]; + REPEAT STRIP_TAC; + POP_ASSUM (fun x -> FIRST_ASSUM (fun y -> ASSUME_TAC (MATCH_MP y x) THEN ASSUME_TAC x)); + REWRITE_TAC[APPEND]; + ASM_MESON_TAC[SUBLIST_CONS]; + LIST_INDUCT_TAC; + MESON_TAC[SUBLIST;NOT_CONS_NIL]; + CASES_ON `h = h'`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[SUBLIST_CONS_CONS]; + REWRITE_TAC[SUBLIST_CONS_CONS;APPEND;]; + ASM_MESON_TAC[]; + REPEAT STRIP_TAC; + CLAIM `SUBLIST (CONS h t) t'`; + ASM_MESON_TAC[SUBLIST_NEQ]; + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + POP_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + ASM_MESON_TAC[APPEND;SUBLIST_CONS]; +]);; +(* }}} *) + +let SUBLIST_APPEND2 = REWRITE_RULE[IMP_AND_THM] SUBLIST_APPEND;; + +let ROL_APPEND2 = prove_by_refinement( + `!l2 l1. real_ordered_list (APPEND l1 l2) ==> + real_ordered_list (APPEND l1 (BUTLAST l2))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ROL_SUBLIST); + EXISTS_TAC `APPEND l1 l2`; + ASM_REWRITE_TAC[SUBLIST_APPEND_HD;SUBLIST_BUTLAST]; +]);; +(* }}} *) + +let PL_LEM = prove_by_refinement( + `!l. ~(l = []) ==> ~(TL (partition_line l) = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + STRIP_TAC; + REWRITE_TAC[partition_line]; + ASM_MESON_TAC[NOT_CONS_NIL;APPEND;TL]; +]);; +(* }}} *) + +let HD_APPEND2 = prove_by_refinement( + `!l m. ~(l = []) ==> (HD (APPEND l m) = HD l)`, +(* {{{ Proof *) + +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REPEAT STRIP_TAC; + REWRITE_TAC[APPEND;HD]; +]);; + +(* }}} *) + +let BUTLAST_TL = prove_by_refinement( + `!l. LENGTH l > 1 ==> (BUTLAST (TL l) = TL (BUTLAST l))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH] THEN ARITH_TAC; + REWRITE_TAC[LENGTH]; + STRIP_TAC; + REWRITE_TAC[TL;BUTLAST]; + COND_CASES_TAC; + REWRITE_ASSUMS [GSYM LENGTH_0]; + REPEAT (POP_ASSUM MP_TAC) THEN ARITH_TAC; + REWRITE_ASSUMS[NOT_NIL]; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[TL;BUTLAST]; +]);; +(* }}} *) + +let APPEND_TL = prove_by_refinement( + `!m l. ~(l = []) ==> (APPEND (TL l) m = TL (APPEND l m))`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[APPEND;TL]; +]);; +(* }}} *) + +let APPEND_HD = prove_by_refinement( + `!m l. ~(l = []) ==> (HD (APPEND l m) = HD l)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[]; + STRIP_TAC; + REWRITE_TAC[APPEND;HD]; +]);; +(* }}} *) + +let PL_LEM2 = prove_by_refinement( + `!l. ~(l = []) ==> LENGTH (partition_line l) > 1`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN REWRITE_TAC[]; + REWRITE_TAC[partition_line]; + STRIP_TAC; + COND_CASES_TAC; + REWRITE_TAC[LENGTH] THEN ARITH_TAC; + REWRITE_TAC[APPEND;LENGTH] THEN ARITH_TAC; +]);; +(* }}} *) + +let BUTLAST_APPEND = prove_by_refinement( + `!l m. ~(m = []) ==> + (BUTLAST (APPEND l m) = APPEND l (BUTLAST m))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND]; + REPEAT STRIP_TAC; + REWRITE_TAC[APPEND;BUTLAST]; + ASM_MESON_TAC[APPEND_EQ_NIL]; +]);; +(* }}} *) + +let LENGTH_TL1 = prove_by_refinement( + `!l. LENGTH l > 1 ==> ~(TL l = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH] THEN ARITH_TAC; + REWRITE_TAC[LENGTH;TL]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ASSUMS o list); + REWRITE_ASSUMS[LENGTH]; + POP_ASSUM MP_TAC THEN ARITH_TAC; +]);; +(* }}} *) + +let PL_BUTLAST = prove_by_refinement( + `!l. ~(l = []) ==> ~(BUTLAST (partition_line l) = [])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[partition_line]; + COND_CASES_TAC; + (* XXX REWRITE_TAC works here, but not MESON_TAC *) + REWRITE_TAC[APPEND;NOT_CONS_NIL;BUTLAST]; + REWRITE_TAC[APPEND;NOT_CONS_NIL;BUTLAST]; +]);; +(* }}} *) + +let PARTITION_LINE_APPEND = prove_by_refinement( + `!h t l. ~(l = []) ==> + (partition_line (APPEND l (CONS h t)) = + APPEND (BUTLAST (partition_line l)) + (CONS (\x. LAST l < x /\ x < h) + (TL (partition_line (CONS h t)))))`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun x -> ALL_TAC); + CASES_ON `t' = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[HD;APPEND;partition_line;BUTLAST;LAST;TL;NOT_CONS_NIL;]; + POP_ASSUM (fun x -> REWRITE_ASSUMS [x] THEN ASSUME_TAC x); + REWRITE_TAC[APPEND]; + CONV_TAC (LAND_CONV (REWRITE_CONV[partition_line])); + COND_CASES_TAC; + ASM_MESON_TAC[NOT_CONS_NIL;APPEND_EQ_NIL]; + POP_ASSUM (fun x -> ALL_TAC); + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[LAST]; + ASM_SIMP_TAC[APPEND_HD]; + CONV_TAC (RAND_CONV (LAND_CONV (RAND_CONV (REWRITE_CONV[partition_line])))); + ASM_REWRITE_TAC[]; + REWRITE_TAC[APPEND;BUTLAST;NOT_CONS_NIL;]; + REPEAT AP_TERM_TAC; + COND_CASES_TAC; + ASM_MESON_TAC[PL_LEM2;LENGTH_TL1]; + REWRITE_TAC[APPEND]; + AP_TERM_TAC; + MP_TAC (ISPEC `t':real list` PL_LEM2); + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[BUTLAST_TL]; + MP_TAC (ISPEC `t':real list` PL_BUTLAST); + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[APPEND_TL]; +]);; +(* }}} *) + +let HD_TL = prove_by_refinement( + `!l. ~(l = []) ==> (l = CONS (HD l) (TL l))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + REWRITE_TAC[HD;TL]; +]);; +(* }}} *) + +let HD_LEM = prove_by_refinement( + `!l1 l2. (TL l1 = l2) <=> (CONS (HD l1) (TL l1) = CONS (HD l1) l2)`, +(* {{{ Proof *) +[ + MESON_TAC[CONS_11]; +]);; +(* }}} *) + +let rec LENGTH_N n ty = + let zero = `0` in + let neg = `(~)` in + let imp_thm = TAUT `(a ==> b) ==> (b ==> a) ==> (a <=> b)` in + match n with + 0 -> CONJUNCT1 LENGTH + | 1 -> LENGTH_SING + | n -> + let len_tm = mk_const ("LENGTH",[ty,aty]) in + let tl_tm = mk_const ("TL",[ty,aty]) in + let hd_tm = mk_const ("HD",[ty,aty]) in + let t = mk_var("t",mk_type("list",[ty])) in + let n_tm = mk_small_numeral n in + let pren_tm = mk_small_numeral (n - 1) in + let len_thm = ASSUME (mk_eq(mk_comb(len_tm,t),n_tm)) in + let pre_thm = LENGTH_N (n - 1) ty in + let n_nz = prove(mk_neg(mk_eq(n_tm,zero)),ARITH_TAC) in + let not_nil_thm = EQ_MP (REWRITE_RULE[len_thm] (AP_TERM neg (ISPEC t LENGTH_0))) n_nz in + let n_suc = prove(mk_eq(n_tm,mk_comb(`SUC`,pren_tm)),ARITH_TAC) in + let len_tl = REWRITE_RULE[n_suc;PRE;ISPEC (mk_comb(tl_tm,t)) pre_thm;len_thm] (MATCH_MP LENGTH_TL not_nil_thm) in + let cons_thm = MATCH_MP (ISPEC t HD_TL) not_nil_thm in + let hd_thm = ONCE_REWRITE_RULE[HD_LEM] len_tl in + let thm = REWRITE_RULE[GSYM cons_thm] hd_thm in + let x0 = mk_var("x" ^ string_of_int n,ty) in + let hdt = mk_comb(hd_tm,t) in + let ex_thm = EXISTS (mk_exists(x0,subst[x0,hdt] (concl thm)),mk_comb(hd_tm,t)) thm in + let left = DISCH (concl len_thm) ex_thm in + let right = prove(mk_imp(concl ex_thm,concl len_thm),REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LENGTH] THEN ARITH_TAC) in + GEN_ALL(MATCH_MPL[imp_thm;left;right]);; + +let BUTLAST_LENGTH = prove_by_refinement( + `!l. ~(l = []) ==> (LENGTH (BUTLAST l) = PRE (LENGTH l))`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC THEN REWRITE_TAC[]; + REWRITE_TAC[BUTLAST;LENGTH]; + COND_CASES_TAC; + ASM_REWRITE_TAC[NOT_CONS_NIL;LENGTH;]; + ARITH_TAC; + ASM_REWRITE_TAC[NOT_CONS_NIL;LENGTH;]; + ASM_SIMP_TAC[]; + MATCH_MP_TAC (ARITH_RULE `~(n = 0) ==> (SUC(PRE n) = PRE(SUC n))`); + ASM_MESON_TAC[LENGTH_0]; +]);; +(* }}} *) + +let ALL2_LEM = prove_by_refinement( + `!a b x y s eqs pts sgns. + ALL2 (interpsigns eqs) (partition_line + (APPEND pts [x; y])) (APPEND sgns [a; b; s; s; s]) ==> + ALL2 (interpsigns eqs) (partition_line + (APPEND pts [x])) (APPEND sgns [a; b; s])`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;NOT_CONS_NIL;HD;TL]; + CLAIM `sgns = []`; + CLAIM `LENGTH [\x'. x' < x; \x'. x' = x; \x'. x < x' /\ x' < y; \x. x = y; \x. y < x] = LENGTH (APPEND sgns [a; b; s; s; s])`; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH;LENGTH_APPEND;GSYM LENGTH_0]; + ARITH_TAC; + DISCH_THEN (REWRITE_ALL o list); + REWRITE_ALL [APPEND;ALL2;]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\z. x < z /\ z < y \/ (z = y) \/ y < z`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; + (* save *) + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + ASM_SIMP_TAC[PARTITION_LINE_APPEND;NOT_CONS_NIL;]; + STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line (CONS (h:real) t))) (CONS (\x'. LAST (CONS h t) < x' /\ x' < x) (TL (partition_line [x; y])))) = LENGTH (APPEND sgns [(a:sign list); b; s; s; s])`; + ASM_MESON_TAC[ALL2_LENGTH]; + CLAIM `~(partition_line [x; y] = [])`; + REWRITE_TAC[APPEND;NOT_CONS_NIL;partition_line;]; + REWRITE_TAC[TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; + STRIP_TAC; + ASM_SIMP_TAC[LENGTH_TL]; + REWRITE_TAC[partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[HD;LENGTH;APPEND;TL;BUTLAST;NOT_CONS_NIL;]; + ARITH_SIMP_TAC[]; + STRIP_TAC; + CLAIM `LENGTH sgns = 2`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_PAIR]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[partition_line;BUTLAST;LAST;ALL2;TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; + ASM_REWRITE_TAC[]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + REWRITE_ASSUMS[HD]; + EXISTS_TAC `\z. x < z /\ z < y \/ (z = y) \/ y < z`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; + (* save *) + REWRITE_ALL[HD;partition_line;BUTLAST;LAST;ALL2;TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + COND_CASES_TAC; + ASM_MESON_TAC[PL_LEM2;LENGTH_TL1]; + ARITH_SIMP_TAC[LENGTH;]; + ASM_SIMP_TAC[PARTITION_LINE_LENGTH]; + ASM_SIMP_TAC[BUTLAST_LENGTH]; + CLAIM `~(partition_line t = [])`; + REWRITE_ASSUMS[NOT_NIL]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[partition_line;NOT_CONS_NIL;list_CASES;APPEND;]; + COND_CASES_TAC; + MESON_TAC[NOT_CONS_NIL]; + MESON_TAC[NOT_CONS_NIL]; + STRIP_TAC; + ASM_SIMP_TAC[LENGTH_TL]; + STRIP_TAC; + MP_TAC (ISPEC `t:real list` PARTITION_LINE_LENGTH); + STRIP_TAC; + CLAIM `~(LENGTH (partition_line t) = 0)`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP PL_LEM2); + STRIP_TAC; + CLAIM `~(PRE (LENGTH (partition_line t)) = 0)`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `SUC(LENGTH (partition_line t)) = LENGTH sgns`; + REPEAT_N 5 (POP_ASSUM MP_TAC) THEN ARITH_TAC; + DISCH_THEN (ASSUME_TAC o GSYM); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_TAC[GSYM APPEND]; + CLAIM `(ALL2 (interpsigns eqs) (BUTLAST + (CONS (\x. x < h) + (CONS (\x. x = h) + (CONS (\x. h < x /\ x < HD t) (TL (partition_line t)))))) + sgns) /\ (ALL2 (interpsigns eqs) [\x'. LAST t < x' /\ x' < x; \x'. x' = x; \x'. x < x' /\ + x' < y; + \x. x = y; \x. y < x] [a; b; s; s; s])`; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_APPEND_LENGTH); + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[BUTLAST;NOT_CONS_NIL;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;LENGTH_TL]; + CLAIM `~(LENGTH t = 0)`; + ASM_MESON_TAC[LENGTH_0]; + ARITH_TAC; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + STRIP_TAC; + REWRITE_ASSUMS[BUTLAST;NOT_CONS_NIL;]; + ASM_MESON_TAC[]; + REWRITE_ALL[BUTLAST;LAST;ALL2;TL;APPEND;NOT_CONS_NIL;LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;LENGTH_TL]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\z. x < z /\ z < y \/ (z = y) \/ y < z`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; +]);; + +(* }}} *) + +let INTERPMAT_TRIO_TL = prove_by_refinement( + `!a b x y s eqs pts sgns. + interpmat (APPEND pts [x; y]) eqs + (APPEND sgns [a; b; s; s; s]) ==> + interpmat (APPEND pts [x]) eqs (APPEND sgns [a; b; s])`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ROL_SUBLIST); + EXISTS_TAC `APPEND pts [x; y]`; + ASM_REWRITE_TAC[SUBLIST_APPEND_HD;SUBLIST_CONS_CONS;SUBLIST_NIL]; + MATCH_MP_TAC ALL2_LEM; + ASM_MESON_TAC[]; +]);; +(* }}} *) + + +let LAST_APPEND = prove_by_refinement( + `!l1 l2. ~(l2 = []) ==> (LAST (APPEND l1 l2) = LAST l2)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND]; + REWRITE_TAC[APPEND;LAST;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[APPEND_EQ_NIL]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let APPEND_APPEND = prove_by_refinement( + `!l1 l2 l3. APPEND (APPEND l1 l2) l3 = APPEND l1 (APPEND l2 l3)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND]; + REWRITE_TAC[APPEND]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let ALL2_LEM2 = prove_by_refinement( + `!a b x y s eqs pts sgns qts rgns. + ALL2 (interpsigns eqs) (partition_line + (APPEND pts (CONS x (CONS y qts)))) + (APPEND sgns (CONS a (CONS b + (CONS s (CONS s (CONS s rgns)))))) ==> + (LENGTH sgns = 2 * LENGTH pts) ==> + ALL2 (interpsigns eqs) (partition_line + (APPEND pts (CONS x qts))) + (APPEND sgns (CONS a (CONS b (CONS s rgns))))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (partition_line + (APPEND pts (CONS x (CONS y qts)))) = + LENGTH (APPEND sgns (CONS (a:sign list) (CONS b + (CONS s (CONS s (CONS s rgns))))))`; + ASM_MESON_TAC[ALL2_LENGTH]; + ASM_REWRITE_TAC[PARTITION_LINE_LENGTH;LENGTH;APPEND;LENGTH_APPEND]; + STRIP_TAC; + CLAIM `LENGTH rgns = 2 * LENGTH qts`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + POP_ASSUM (fun x -> ALL_TAC); + STRIP_TAC; + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + CLAIM `sgns = []`; + ASM_MESON_TAC[ARITH_RULE `2 * 0 = 0`;LENGTH_0;LENGTH]; + DISCH_THEN (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;NOT_CONS_NIL;HD;TL;APPEND;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[ALL2;partition_line;NOT_CONS_NIL;HD;TL;APPEND;]; + REPEAT_N 3 STRIP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ALL2;partition_line;NOT_CONS_NIL;HD;TL;APPEND;]; + REPEAT_N 3 STRIP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z /\ z < HD qts`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + CLAIM `LENGTH (BUTLAST (partition_line pts)) = LENGTH sgns`; + ASM_REWRITE_TAC[]; + ASSUME_TAC (ISPEC `pts:real list` PARTITION_LINE_NOT_NIL); + ASM_SIMP_TAC[BUTLAST_LENGTH]; + REWRITE_TAC[PARTITION_LINE_LENGTH]; + ARITH_TAC; + STRIP_TAC; + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[ALL2_SPLIT]; + REWRITE_ALL[partition_line;NOT_CONS_NIL;HD;TL;]; + COND_CASES_TAC; + REWRITE_TAC[ALL2;TL;HD;APPEND;]; + REPEAT_N 4 STRIP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT_N 4 STRIP_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\(z:real). x < z /\ z < y \/ (z = y) \/ y < z /\ z < HD qts`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; +]);; + +(* }}} *) + +let INTERPMAT_TRIO_INNER = prove_by_refinement( + `!a b x y s eqs qts rgns pts sgns. + interpmat (APPEND pts (CONS x (CONS y qts))) eqs + (APPEND sgns (CONS a (CONS b + (CONS s (CONS s (CONS s rgns)))))) ==> + (LENGTH sgns = 2 * LENGTH pts) ==> + interpmat (APPEND pts (CONS x qts)) eqs + (APPEND sgns (CONS a (CONS b (CONS s rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ROL_SUBLIST); + EXISTS_TAC `(APPEND pts (CONS x (CONS y qts)))`; + ASM_REWRITE_TAC[SUBLIST_APPEND_HD;SUBLIST_CONS_CONS;SUBLIST_NIL]; + MESON_TAC[SUBLIST_CONS;SUBLIST_ID]; + ASM_MESON_TAC[ALL2_LEM2]; +]);; +(* }}} *) + +let INTERPMAT_SING = prove_by_refinement( + `!x l. interpmat [x] eqs [l; l; l] ==> interpmat [] eqs [l]`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REWRITE_TAC[ROL_SING;partition_line;ROL_NIL;ALL2;]; + REPEAT STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_SUBSET; + EXISTS_TAC `\(z:real). x < z \/ (z = x) \/ z < x`; + STRIP_TAC; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTERPSIGNS_CONJ; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REAL_ARITH_TAC; +]);; +(* }}} *) + +let INFERISIGN_POS_POS_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Pos r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Pos (CONS Pos r2)) + (CONS (CONS Pos r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_POS_POS_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Pos r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Pos (CONS Neg r2)) + (CONS (CONS Pos r3) rgns))))`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] pos_pos_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; +]);; + +(* }}} *) + + +let INFERISIGN_NEG_NEG_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Neg r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Neg (CONS Pos r2)) + (CONS (CONS Neg r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_NEG_NEG_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Neg r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Neg (CONS Neg r2)) + (CONS (CONS Neg r3) rgns))))`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Neg r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] neg_neg_neq_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; + +(* }}} *) + + +let ALL2_INTERPSIGN_SUBSET = prove_by_refinement( + `!P Q l1 l2. ALL2 (interpsign P) l1 l2 ==> Q SUBSET P ==> + ALL2 (interpsign Q) l1 l2`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC THEN REPEAT LIST_INDUCT_TAC THEN REWRITE_TAC[ALL2]; + ASM_MESON_TAC[INTERPSIGN_SUBSET]; +]);; +(* }}} *) + + +let HD_APPEND1 = prove_by_refinement( + `!h i l1 l2. + HD (APPEND l1 (CONS h l2)) = HD (APPEND l1 (CONS h (CONS i l2)))`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC; + LIST_INDUCT_TAC; + ASM_REWRITE_TAC[HD;APPEND]; + ASM_REWRITE_TAC[HD;APPEND]; +]);; +(* }}} *) + +let ROL_APPEND_INSERT = prove_by_refinement( + `!h j l1 l2. + real_ordered_list (APPEND l1 (CONS h (CONS i l2))) ==> + h < j ==> j < i ==> + real_ordered_list (APPEND l1 (CONS h (CONS j (CONS i l2))))`, +(* {{{ Proof *) +[ + STRIP_TAC THEN STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[APPEND;real_ordered_list;HD;TL;NOT_CONS_NIL;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[APPEND;real_ordered_list]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[]; + ASM_MESON_TAC[APPEND_EQ_NIL;NOT_CONS_NIL;]; + ASM_MESON_TAC[]; + DISJ2_TAC; + ASM_MESON_TAC[HD_APPEND1]; +]);; +(* }}} *) + + +let INFERISIGN_POS_NEG_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Neg r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Pos (CONS Pos r2)) + (CONS (CONS Zero (CONS Pos r2)) + (CONS (CONS Neg (CONS Pos r2)) + (CONS (CONS Neg r3) rgns))))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + (* save *) + REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS]; + ASM_MESON_TAC[REAL_LT_TRANS]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) + (CONS (\x. LAST pts < x /\ x < y) rts) = + APPEND (APPEND (BUTLAST (partition_line pts)) + [\x. LAST pts < x /\ x < y]) rts`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (ONCE_REWRITE_TAC o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; + (* save *) + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + (* save *) + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; +]);; +(* }}} *) + + +let INFERISIGN_POS_NEG_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Neg r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Pos (CONS Neg r2)) + (CONS (CONS Zero (CONS Neg r2)) + (CONS (CONS Neg (CONS Neg r2)) + (CONS (CONS Neg r3) rgns))))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + (* save *) + REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) + (CONS (\x. LAST pts < x /\ x < y) rts) = + APPEND (APPEND (BUTLAST (partition_line pts)) + [\x. LAST pts < x /\ x < y]) rts`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (ONCE_REWRITE_TAC o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;real_gt;ROL_APPEND]; + REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; + (* save *) + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + (* save *) + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] pos_neg_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; +]);; +(* }}} *) + + +let INFERISIGN_NEG_POS_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Pos r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Neg (CONS Neg r2)) + (CONS (CONS Zero (CONS Neg r2)) + (CONS (CONS Pos (CONS Neg r2)) + (CONS (CONS Pos r3) rgns))))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Pos r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + (* save *) + REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) + (CONS (\x. LAST pts < x /\ x < y) rts) = + APPEND (APPEND (BUTLAST (partition_line pts)) + [\x. LAST pts < x /\ x < y]) rts`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (ONCE_REWRITE_TAC o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;real_gt;ROL_APPEND]; + REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; + (* save *) + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + (* save *) + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; +]);; +(* }}} *) + +let INFERISIGN_NEG_POS_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Pos r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + ?w. interpmat (APPEND pts (CONS y (CONS w (CONS z qts)))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Neg (CONS Pos r2)) + (CONS (CONS Zero (CONS Pos r2)) + (CONS (CONS Pos (CONS Pos r2)) + (CONS (CONS Pos r3) rgns))))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Pos r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + (* save *) + REWRITE_TAC[TL;APPEND;ALL2;real_gt;interpsigns;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REWRITE_ALL[real_ordered_list;HD;NOT_CONS_NIL;]; + ASM_REWRITE_TAC[]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[real_gt;interpsigns;ALL2;interpsign;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET;IN]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + ASM_MESON_TAC[real_gt;REAL_LT_TRANS]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + CLAIM `!rts. APPEND (BUTLAST (partition_line pts)) + (CONS (\x. LAST pts < x /\ x < y) rts) = + APPEND (APPEND (BUTLAST (partition_line pts)) + [\x. LAST pts < x /\ x < y]) rts`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (ONCE_REWRITE_TAC o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;real_gt;ROL_APPEND]; + REWRITE_TAC[real_ordered_list;NOT_CONS_NIL;HD;]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[ALL2;partition_line;HD;TL;NOT_CONS_NIL;]; + (* save *) + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + (* save *) + REWRITE_ALL[APPEND;TL;HD;interpsigns;interpsign;ALL2;]; + REPEAT STRIP_TAC; + MP_TAC (ISPECL [`y:real`;`z:real`;`p:real list`] neg_pos_neq_thm); + REPEAT STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_ARITH `x < y ==> ~(x = y)`;REAL_ARITH `y < x ==> ~(x = y)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + EXISTS_TAC `X`; + REWRITE_ALL[interpsign;real_gt]; + (* save *) + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[interpsigns;interpsign]; + FIRST_ASSUM (MP_TAC o MATCH_MP ROL_APPEND); + REPEAT STRIP_TAC; + ASM_MESON_TAC[real_gt;ROL_APPEND_INSERT]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;interpsign]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. y < x /\ x < z`; + REWRITE_TAC[SUBSET;IN]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; + ASM_MESON_TAC[real_gt;real_gt;REAL_LT_TRANS;]; +]);; +(* }}} *) + + +let INFERISIGN_ZERO_POS_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Pos r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Pos (CONS Pos r2)) + (CONS (CONS Pos r3) rgns))))`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Pos r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; + +(* }}} *) + +let INFERISIGN_ZERO_POS_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Pos r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Pos (CONS Neg r2)) + (CONS (CONS Pos r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Zero r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Pos r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_pos_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_POS_ZERO_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Zero r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Pos (CONS Pos r2)) + (CONS (CONS Zero r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_POS_ZERO_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Zero r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Pos r1) + (CONS (CONS Pos (CONS Neg r2)) + (CONS (CONS Zero r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = LENGTH (APPEND sgns (CONS (CONS Pos r1) (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] pos_zero_pos_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_ZERO_NEG_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Neg r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Neg (CONS Pos r2)) + (CONS (CONS Neg r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Neg r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_ZERO_NEG_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Neg r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Neg (CONS Neg r2)) + (CONS (CONS Neg r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Neg r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] zero_neg_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + + + +let INFERISIGN_NEG_ZERO_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Zero r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Neg (CONS Neg r2)) + (CONS (CONS Zero r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_NEG_ZERO_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Zero r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Neg r1) + (CONS (CONS Neg (CONS Pos r2)) + (CONS (CONS Zero r3) rgns))))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Neg r1) + (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH sgns = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;NOT_CONS_NIL;HD;ALL2;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[real_gt]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH sgns`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (REWRITE_RULE[real_gt;IMP_AND_THM] neg_zero_neg_thm); + REWRITE_ALL[interpsign;real_ordered_list;ROL_APPEND;NOT_CONS_NIL;HD;ALL2;real_ordered_list;APPEND;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y (CONS z qts))`; + ASM_MESON_TAC[real_gt;ROL_APPEND]; + REWRITE_ALL[NOT_CONS_NIL;real_gt;real_ordered_list;HD;]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_ZERO_ZERO_POS = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Pos r2)) + (CONS (CONS Zero r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> F`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~((sgns:(sign list) list) = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Pos r2)) (CONS (CONS Zero r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH (sgns:(sign list) list) = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list) list)`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list)list)`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y(CONS z qts))`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; + STRIP_TAC; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERISIGN_ZERO_ZERO_NEG = prove_by_refinement( + `!y z p pts qts eqs sgns rgns r1 r2 r3. + interpmat (APPEND pts (CONS y (CONS z qts))) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) eqs)) + (APPEND sgns + (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Neg r2)) + (CONS (CONS Zero r3) rgns)))) ==> + (LENGTH sgns = 2 * LENGTH pts + 1) ==> F`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~((sgns:(sign list) list) = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `LENGTH (partition_line (APPEND pts (CONS y (CONS z qts)))) = + LENGTH (APPEND sgns (CONS (CONS Zero r1) + (CONS (CONS Unknown (CONS Neg r2)) (CONS (CONS Zero r3) rgns))))`; + ASM_MESON_TAC[real_gt;ALL2_LENGTH]; + STRIP_TAC; + (* save *) + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;]; + CLAIM `LENGTH (sgns:(sign list) list) = 1`; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_ALL[LENGTH]; + ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[LENGTH_1]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND]; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[partition_line;TL;HD;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;APPEND;ALL2;real_gt]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;ALL2;]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign]; + REWRITE_ALL[real_gt]; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[LENGTH;APPEND;TL;HD;ALL2;interpsigns]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[interpsign;real_gt;]; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND;partition_line;NOT_CONS_NIL;]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[TL;HD;APPEND;ALL2;]; + CLAIM `APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y; \x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x] = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) [\x. x = y; \x. y < x /\ x < z; \x. x = z; \x. z < x]`; + MESON_TAC[real_gt;APPEND;APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list) list)`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list [y; z]`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; + (* save *) + REWRITE_TAC[APPEND;TL;HD;ALL2;]; + REPEAT STRIP_TAC; + CLAIM `!j. APPEND (BUTLAST (partition_line pts)) (CONS (\x. LAST pts < x /\ x < y) j) = APPEND (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) j`; + MESON_TAC[APPEND;APPEND_CONS]; + DISCH_THEN (fun x -> ONCE_REWRITE_TAC[x] THEN ONCE_REWRITE_ASSUMS[x]); + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts)) [\x. LAST pts < x /\ x < y]) = LENGTH (sgns:(sign list)list)`; + REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ASM_SIMP_TAC[LENGTH_APPEND;BUTLAST_LENGTH;LENGTH;PARTITION_LINE_NOT_NIL;PARTITION_LINE_LENGTH]; + ARITH_TAC; + REWRITE_ALL[TL;APPEND;HD]; + DISCH_THEN (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REPEAT STRIP_TAC; + REPEAT STRIP_TAC; + REWRITE_ALL[ALL2;interpsigns;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsign;real_gt]; + MATCH_MP_TAC (PURE_REWRITE_RULE[real_gt;IMP_AND_THM] eq_eq_false_thm); + EXISTS_TAC `y`; + EXISTS_TAC `z`; + EXISTS_TAC `p`; + REWRITE_ALL[real_ordered_list;NOT_CONS_NIL;HD;interpsign]; + REWRITE_ALL[real_gt;ALL2;interpsigns;interpsign;]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + CLAIM `real_ordered_list (CONS y(CONS z qts))`; + ASM_MESON_TAC[ROL_APPEND]; + REWRITE_TAC[HD;NOT_CONS_NIL;real_ordered_list]; + STRIP_TAC; + ASM_MESON_TAC[real_gt;]; + ASM_MESON_TAC[real_gt;real_gt;]; + ASM_MESON_TAC[real_gt;REAL_ARITH `x > y ==> ~(x = y)`]; +]);; +(* }}} *) + +let BUTLAST_ID = prove_by_refinement( + `!l. ~(l = []) ==> (APPEND (BUTLAST l) [LAST l] = l)`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[]; + DISCH_THEN (fun x -> ALL_TAC); + REWRITE_TAC[BUTLAST;APPEND;LAST;]; + COND_CASES_TAC; + ASM_REWRITE_TAC[BUTLAST;APPEND;LAST;]; + ASM_REWRITE_TAC[APPEND;]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let BUTLAST_ID = prove_by_refinement( + `!l. ~(l = []) ==> (l = APPEND (BUTLAST l) [LAST l])`, +(* {{{ Proof *) +[ + MESON_TAC[BUTLAST_ID]; +]);; +(* }}} *) + +let BUTLAST_NIL = prove_by_refinement( + `!l. (BUTLAST l = []) <=> (l = []) \/ (?x. l = [x])`, +(* {{{ Proof *) +[ + LIST_INDUCT_TAC; + REWRITE_TAC[BUTLAST;]; + REWRITE_TAC[BUTLAST;NOT_CONS_NIL;]; + COND_CASES_TAC; + ASM_REWRITE_TAC[]; + MESON_TAC[]; + ASM_REWRITE_TAC[]; + POP_ASSUM (fun x -> REWRITE_ALL[x] THEN ASSUME_TAC x); + REWRITE_TAC[NOT_CONS_NIL]; + STRIP_TAC; + ASM_MESON_TAC[NOT_CONS_NIL;CONS_11]; +]);; +(* }}} *) + +let INFIN_HD_POS_LEM = prove_by_refinement( + `!pts p ps r1 sgns. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (CONS (CONS Unknown (CONS Pos r1)) sgns) ==> + nonconstant p ==> + ?xminf. + interpmat (CONS xminf pts) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (CONS (CONS Neg (CONS Pos r1)) + (CONS (CONS Neg (CONS Pos r1)) + (CONS (CONS Unknown (CONS Pos r1)) sgns)))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;partition_line;]; + REPEAT STRIP_TAC; + DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_DOWN_LEFT5)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN]; + (* save *) + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_DOWN_LEFT5)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; + REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + (* save *) + POP_ASSUM (fun x -> (REWRITE_ALL[x] THEN ASSUME_TAC x)); + REWRITE_ALL[APPEND;NOT_CONS_NIL;HD;TL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_DOWN_LEFT5)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; + REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; +]);; +(* }}} *) + +let INFIN_TL_POS_LEM = prove_by_refinement( + `!pts p ps r1 sgns r2. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND sgns [a; b; CONS Unknown (CONS Pos r2)]) ==> + nonconstant p ==> + ?xinf. + interpmat (APPEND pts [xinf]) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND sgns + [a; b; CONS Unknown (CONS Pos r2); + CONS Pos (CONS Pos r2); + CONS Pos (CONS Pos r2)])`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat;partition_line;]; + REPEAT STRIP_TAC; + CLAIM `LENGTH (partition_line pts) = LENGTH (APPEND sgns [a; b; CONS Unknown (CONS Pos r2)])`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + CLAIM `LENGTH sgns = LENGTH (partition_line pts) - 3`; + REWRITE_ALL[PARTITION_LINE_LENGTH]; + ASM_REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN FALSE_ANTECEDENT_TAC; + ARITH_TAC; + (* save *) + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + CLAIM `pts = APPEND (BUTLAST pts) [LAST (pts:real list)]`; + MATCH_MP_TAC BUTLAST_ID; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `ALL2 + (interpsigns + (CONS (\x. poly p x) + (CONS (\x. poly (poly_diff p) x) ps))) + (partition_line (APPEND (BUTLAST pts) [LAST pts])) + (APPEND sgns [a; b; CONS Unknown (CONS Pos r2)])`; + ASM_MESON_TAC[]; + CASES_ON `BUTLAST (pts:real list) = []`; + CLAIM `?w. pts = [w:real]`; + ASM_MESON_TAC[BUTLAST_NIL]; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + CLAIM `sgns = []`; + REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); + REWRITE_TAC[GSYM LENGTH_0]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN (REWRITE_ALL o list); + REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`w:real`] POLY_DIFF_UP_RIGHT3)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; + REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. w < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + ASM_MESON_TAC[REAL_LT_TRANS]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. w < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_IMP_LE]; + ASM_MESON_TAC[REAL_LT_IMP_LE;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. w < x`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + (* save *) + CLAIM `LENGTH (BUTLAST (partition_line (BUTLAST pts))) = LENGTH sgns`; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;]; + REWRITE_ALL[PARTITION_LINE_LENGTH;LENGTH_APPEND;LENGTH;]; + MP_TAC (ISPEC `pts:real list` BUTLAST_LENGTH); + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + ASM_MESON_TAC[]; + POP_ASSUM SUBST1_TAC; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM SUBST1_TAC; + ARITH_TAC; + STRIP_TAC; + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`LAST pts:real`] POLY_DIFF_UP_RIGHT3)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + REPEAT STRIP_TAC; + MATCH_MP_TAC ROL_INSERT_BACK_THM; + ASM_REWRITE_TAC[]; + ONCE_ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REWRITE_TAC[partition_line;TL;]; + SIMP_TAC[NOT_CONS_NIL;LAST_APPEND]; + REWRITE_TAC[LAST]; + SIMP_TAC[BUTLAST_APPEND;NOT_CONS_NIL;]; + REWRITE_TAC[BUTLAST;NOT_CONS_NIL;]; + REWRITE_TAC[APPEND_APPEND]; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. LAST pts < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. LAST pts < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. LAST pts < x`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; +]);; + +(* }}} *) + +let INFIN_HD_NEG_LEM = prove_by_refinement( + `!pts p ps r1 sgns. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (CONS (CONS Unknown (CONS Neg r1)) sgns) ==> + nonconstant p ==> + ?xminf. + interpmat (CONS xminf pts) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (CONS (CONS Pos (CONS Neg r1)) + (CONS (CONS Pos (CONS Neg r1)) + (CONS (CONS Unknown (CONS Neg r1)) sgns)))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;partition_line;]; + REPEAT STRIP_TAC; + DISJ_CASES_TAC (ISPEC `pts:real list` list_CASES); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_UP_LEFT5)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN]; + (* save *) + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_UP_LEFT5)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; + REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + (* save *) + POP_ASSUM (fun x -> (REWRITE_ALL[x] THEN ASSUME_TAC x)); + REWRITE_ALL[APPEND;NOT_CONS_NIL;HD;TL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`h:real`] POLY_DIFF_UP_LEFT5)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + ASM_REWRITE_TAC[real_ordered_list;HD;NOT_CONS_NIL;]; + REWRITE_ALL[APPEND;TL;NOT_CONS_NIL;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. x < h`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE;]; +]);; +(* }}} *) + +let INFIN_TL_NEG_LEM = prove_by_refinement( + `!pts p ps r1 sgns r2. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND sgns [a; b; CONS Unknown (CONS Neg r2)]) ==> + nonconstant p ==> + ?xinf. + interpmat (APPEND pts [xinf]) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND sgns + [a; b; CONS Unknown (CONS Neg r2); + CONS Neg (CONS Neg r2); + CONS Neg (CONS Neg r2)])`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;partition_line;]; + REPEAT STRIP_TAC; + CLAIM `LENGTH (partition_line pts) = LENGTH (APPEND sgns [a; b; CONS Unknown (CONS Neg r2)])`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + CLAIM `LENGTH sgns = LENGTH (partition_line pts) - 3`; + REWRITE_ALL[PARTITION_LINE_LENGTH]; + ASM_REWRITE_TAC[LENGTH_APPEND;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + CASES_ON `pts = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN FALSE_ANTECEDENT_TAC; + ARITH_TAC; + (* save *) + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + CLAIM `pts = APPEND (BUTLAST pts) [LAST (pts:real list)]`; + MATCH_MP_TAC BUTLAST_ID; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `ALL2 + (interpsigns + (CONS (\x. poly p x) + (CONS (\x. poly (poly_diff p) x) ps))) + (partition_line (APPEND (BUTLAST pts) [LAST pts])) + (APPEND sgns [a; b; CONS Unknown (CONS Neg r2)])`; + ASM_MESON_TAC[]; + CASES_ON `BUTLAST (pts:real list) = []`; + CLAIM `?w. pts = [w:real]`; + ASM_MESON_TAC[BUTLAST_NIL]; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + CLAIM `sgns = []`; + REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); + REWRITE_TAC[GSYM LENGTH_0]; + POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN (REWRITE_ALL o list); + REWRITE_ALL[LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`w:real`] POLY_DIFF_DOWN_RIGHT3)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; + REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. w < x`; + ASM_MESON_TAC[SUBSET;IN]; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. w < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_LT_IMP_LE]; + ASM_MESON_TAC[REAL_LT_IMP_LE;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. w < x`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + (* save *) + CLAIM `LENGTH (BUTLAST (partition_line (BUTLAST pts))) = LENGTH sgns`; + ASM_SIMP_TAC[BUTLAST_LENGTH;PARTITION_LINE_NOT_NIL;]; + REWRITE_ALL[PARTITION_LINE_LENGTH;LENGTH_APPEND;LENGTH;]; + MP_TAC (ISPEC `pts:real list` BUTLAST_LENGTH); + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + ASM_MESON_TAC[]; + POP_ASSUM SUBST1_TAC; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM SUBST1_TAC; + ARITH_TAC; + STRIP_TAC; + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP x y))); + REWRITE_ALL[BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`LAST pts:real`] POLY_DIFF_DOWN_RIGHT3)); + ASM_REWRITE_TAC[real_gt;]; + STRIP_TAC; + EXISTS_TAC `Y`; + REPEAT STRIP_TAC; + MATCH_MP_TAC ROL_INSERT_BACK_THM; + ASM_REWRITE_TAC[]; + ONCE_ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REWRITE_TAC[partition_line;TL;]; + SIMP_TAC[NOT_CONS_NIL;LAST_APPEND]; + REWRITE_TAC[LAST]; + SIMP_TAC[BUTLAST_APPEND;NOT_CONS_NIL;]; + REWRITE_TAC[BUTLAST;NOT_CONS_NIL;]; + REWRITE_TAC[APPEND_APPEND]; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2;BUTLAST;TL;NOT_CONS_NIL;LAST;LENGTH;LENGTH_APPEND;APPEND;partition_line;ALL2;interpsigns;interpsign;real_gt;ROL_SING]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_gt;REAL_LT_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. LAST pts < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + ASM_MESON_TAC[REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. LAST pts < x`; + ASM_MESON_TAC[SUBSET;IN]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_MESON_TAC[REAL_EQ_IMP_LE;REAL_LT_IMP_LE;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. LAST pts < x`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; +]);; +(* }}} *) + +let INFIN_POS_POS = prove_by_refinement( + `!pts p ps r1 sgns r2. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND (CONS (CONS Unknown (CONS Pos r1)) sgns) + [a; b; CONS Unknown (CONS Pos r2)]) ==> + nonconstant p ==> + ?xminf xinf. + interpmat (APPEND (CONS xminf pts) [xinf]) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND + (CONS (CONS Neg (CONS Pos r1)) + (CONS (CONS Neg (CONS Pos r1)) + (CONS (CONS Unknown (CONS Pos r1)) sgns))) + [a; b; CONS Unknown (CONS Pos r2); + CONS Pos (CONS Pos r2); + CONS Pos (CONS Pos r2)])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_ASSUMS[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + EXISTS_TAC `xminf`; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_POS_LEM); + ASM_REWRITE_TAC[APPEND;]; +]);; +(* }}} *) + +let INFIN_POS_NEG = prove_by_refinement( + `!pts p ps r1 sgns r2. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND (CONS (CONS Unknown (CONS Pos r1)) sgns) + [a; b; CONS Unknown (CONS Neg r2)]) ==> + nonconstant p ==> + ?xminf xinf. + interpmat (APPEND (CONS xminf pts) [xinf]) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND + (CONS (CONS Neg (CONS Pos r1)) + (CONS (CONS Neg (CONS Pos r1)) + (CONS (CONS Unknown (CONS Pos r1)) sgns))) + [a; b; CONS Unknown (CONS Neg r2); + CONS Neg (CONS Neg r2); + CONS Neg (CONS Neg r2)])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_ASSUMS[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + EXISTS_TAC `xminf`; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_NEG_LEM); + ASM_REWRITE_TAC[APPEND;]; +]);; +(* }}} *) + +let INFIN_NEG_POS = prove_by_refinement( + `!pts p ps r1 sgns r2. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND (CONS (CONS Unknown (CONS Neg r1)) sgns) + [a; b; CONS Unknown (CONS Pos r2)]) ==> + nonconstant p ==> + ?xminf xinf. + interpmat (APPEND (CONS xminf pts) [xinf]) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND + (CONS (CONS Pos (CONS Neg r1)) + (CONS (CONS Pos (CONS Neg r1)) + (CONS (CONS Unknown (CONS Neg r1)) sgns))) + [a; b; CONS Unknown (CONS Pos r2); + CONS Pos (CONS Pos r2); + CONS Pos (CONS Pos r2)])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_ASSUMS[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + EXISTS_TAC `xminf`; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_POS_LEM); + ASM_REWRITE_TAC[APPEND;]; +]);; +(* }}} *) + +let INFIN_NEG_NEG = prove_by_refinement( + `!pts p ps r1 sgns r2. + interpmat pts + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND (CONS (CONS Unknown (CONS Neg r1)) sgns) + [a; b; CONS Unknown (CONS Neg r2)]) ==> + nonconstant p ==> + ?xminf xinf. + interpmat (APPEND (CONS xminf pts) [xinf]) + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + (APPEND + (CONS (CONS Pos (CONS Neg r1)) + (CONS (CONS Pos (CONS Neg r1)) + (CONS (CONS Unknown (CONS Neg r1)) sgns))) + [a; b; CONS Unknown (CONS Neg r2); + CONS Neg (CONS Neg r2); + CONS Neg (CONS Neg r2)])`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + REWRITE_ASSUMS[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + EXISTS_TAC `xminf`; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM]INFIN_TL_NEG_LEM); + ASM_REWRITE_TAC[APPEND;]; +]);; +(* }}} *) + +let INFIN_NIL_POS = prove_by_refinement( + `!p ps r1. + interpmat [] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Unknown (CONS Pos r1)] ==> + nonconstant p ==> + ?xminf xinf. + interpmat [xminf; xinf] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Neg (CONS Pos r1); + CONS Neg (CONS Pos r1); + CONS Unknown (CONS Pos r1); + CONS Pos (CONS Pos r1); + CONS Pos (CONS Pos r1)]`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt;interpmat;partition_line;ROL_NIL;ALL2;interpsigns;interpsign]; + REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_UP_RIGHT3)); + ASM_REWRITE_TAC[real_gt]; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_DOWN_LEFT5)); + ASM_REWRITE_TAC[real_gt]; + STRIP_TAC; + EXISTS_TAC `Y'`; + EXISTS_TAC `Y`; + ASM_REWRITE_TAC[real_gt;NOT_CONS_NIL;HD;TL;APPEND;ALL2;interpsigns;interpsign]; + REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; +]);; +(* }}} *) + +let INFIN_NIL_NEG = prove_by_refinement( + `!p ps r1. + interpmat [] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Unknown (CONS Neg r1)] ==> + nonconstant p ==> + ?xminf xinf. + interpmat [xminf; xinf] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Pos (CONS Neg r1); + CONS Pos (CONS Neg r1); + CONS Unknown (CONS Neg r1); + CONS Neg (CONS Neg r1); + CONS Neg (CONS Neg r1)]`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt;interpmat;partition_line;ROL_NIL;ALL2;interpsigns;interpsign]; + REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_DOWN_RIGHT3)); + ASM_REWRITE_TAC[real_gt]; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP (ISPECL [`p:real list`;`poly_diff p`;`&0`] POLY_DIFF_UP_LEFT5)); + ASM_REWRITE_TAC[real_gt]; + STRIP_TAC; + EXISTS_TAC `Y'`; + EXISTS_TAC `Y`; + ASM_REWRITE_TAC[real_gt;NOT_CONS_NIL;HD;TL;APPEND;ALL2;interpsigns;interpsign]; + REWRITE_TAC[ROL_CONS_CONS;ROL_SING]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; + ASM_MESON_TAC[REAL_LT_TRANS;REAL_LT_IMP_LE;REAL_EQ_IMP_LE]; + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] ALL2_INTERPSIGN_SUBSET); + EXISTS_TAC `\x. T`; + ASM_MESON_TAC[SUBSET;IN;REAL_LT_TRANS;]; +]);; +(* }}} *) + +let INFIN_SING_POS_POS = prove_by_refinement( + `!p ps r1 x s2 r2 r3. + interpmat [x] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Unknown (CONS Pos r1);CONS s2 r2;CONS Unknown (CONS Pos r3)] ==> + nonconstant p ==> + ?xminf xinf. + interpmat [xminf; x; xinf] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Neg (CONS Pos r1); + CONS Neg (CONS Pos r1); + CONS Unknown (CONS Pos r1); + CONS s2 r2; + CONS Unknown (CONS Pos r3); + CONS Pos (CONS Pos r3); + CONS Pos (CONS Pos r3)]`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_POS_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); + EXISTS_TAC `xinf`; + REWRITE_ALL[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let INFIN_SING_POS_NEG = prove_by_refinement( + `!p ps r1 x s2 r2 r3. + interpmat [x] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Unknown (CONS Pos r1);CONS s2 r2;CONS Unknown (CONS Neg r3)] ==> + nonconstant p ==> + ?xminf xinf. + interpmat [xminf; x; xinf] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Neg (CONS Pos r1); + CONS Neg (CONS Pos r1); + CONS Unknown (CONS Pos r1); + CONS s2 r2; + CONS Unknown (CONS Neg r3); + CONS Neg (CONS Neg r3); + CONS Neg (CONS Neg r3)]`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_NEG_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); + EXISTS_TAC `xinf`; + REWRITE_ALL[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_POS_LEM); + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let INFIN_SING_NEG_POS = prove_by_refinement( + `!p ps r1 x s2 r2 r3. + interpmat [x] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Unknown (CONS Neg r1);CONS s2 r2;CONS Unknown (CONS Pos r3)] ==> + nonconstant p ==> + ?xminf xinf. + interpmat [xminf; x; xinf] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Pos (CONS Neg r1); + CONS Pos (CONS Neg r1); + CONS Unknown (CONS Neg r1); + CONS s2 r2; + CONS Unknown (CONS Pos r3); + CONS Pos (CONS Pos r3); + CONS Pos (CONS Pos r3)]`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_POS_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); + EXISTS_TAC `xinf`; + REWRITE_ALL[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let INFIN_SING_NEG_NEG = prove_by_refinement( + `!p ps r1 x s2 r2 r3. + interpmat [x] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Unknown (CONS Neg r1);CONS s2 r2;CONS Unknown (CONS Neg r3)] ==> + nonconstant p ==> + ?xminf xinf. + interpmat [xminf; x; xinf] + (CONS (\x. poly p x) (CONS (\x. poly (poly_diff p) x) ps)) + [CONS Pos (CONS Neg r1); + CONS Pos (CONS Neg r1); + CONS Unknown (CONS Neg r1); + CONS s2 r2; + CONS Unknown (CONS Neg r3); + CONS Neg (CONS Neg r3); + CONS Neg (CONS Neg r3)]`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + ONCE_REWRITE_ASSUMS[prove(`[x; y; z] = APPEND [] [x; y; z]`,REWRITE_TAC[APPEND])]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_TL_NEG_LEM); + ASM_REWRITE_TAC[]; + STRIP_TAC; + MATCH_MP_TAC (prove(`(?y x. P x y) ==> (?x y. P x y)`,MESON_TAC[])); + EXISTS_TAC `xinf`; + REWRITE_ALL[APPEND]; + FIRST_ASSUM (MP_TAC o MATCH_MP INFIN_HD_NEG_LEM); + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let EL_SUC = prove_by_refinement( + `!i h t. EL (SUC i) (CONS h t) = EL i t`, +(* {{{ Proof *) +[ + REWRITE_TAC[EL;TL]; +]);; +(* }}} *) + +let EL_PRE = prove_by_refinement( + `!i h t. ~(i = 0) ==> (EL i (CONS h t) = EL (PRE i) t)`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REWRITE_TAC[]; + REPEAT STRIP_TAC; + REWRITE_TAC[EL;TL;PRE]; +]);; +(* }}} *) + +let ALL2_EL_LT_LEM = prove_by_refinement( + `!k P l1 l2 n. + (k = LENGTH l1) /\ ALL2 P l1 l2 /\ n < k ==> + P (EL n l1) (EL n l2)`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC THEN ARITH_TAC; + REPEAT STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + STRIP_TAC; + CLAIM `~(l1 = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL;]; + STRIP_TAC; + CLAIM `~(l2 = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (SUBST1_TAC o GSYM); + REPEAT_N 2 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL;]; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ASSUMS[LENGTH;SUC_INJ;ALL2;]; + REPEAT_N 3 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + (* save *) + DISJ_CASES_TAC (ISPEC `n:num` num_CASES); + POP_ASSUM (REWRITE_ALL o list); + ASM_REWRITE_TAC[EL;HD]; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;TL;]; + REWRITE_ASSUMS[LENGTH;SUC_INJ;ALL2;LT_SUC]; + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let ALL2_EL_LT = prove_by_refinement( + `!P l1 l2 n. ALL2 P l1 l2 /\ n < LENGTH l1 ==> P (EL n l1) (EL n l2)`, +(* {{{ Proof *) +[ + MESON_TAC[ALL2_EL_LT_LEM]; +]);; +(* }}} *) + +let ALL2_EL_LEM = prove_by_refinement( + `!k P (l1:A list) (l2:B list). (k = LENGTH l1) /\ (k = LENGTH l2) /\ + ~(?i. i < LENGTH l1 /\ ~(P (EL i l1) (EL i l2))) ==> ALL2 P l1 l2`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REPEAT STRIP_TAC; + EVERY_ASSUM (MP_TAC o GSYM); + ASM_MESON_TAC[LENGTH_0;ALL2]; + REPEAT STRIP_TAC; + CLAIM `~(l1 = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + REPEAT_N 2 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL;]; + STRIP_TAC; + CLAIM `~(l2 = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + REPEAT_N 2 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL;]; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[LENGTH;SUC_INJ;ALL2;]; + STRIP_TAC; + ASM_MESON_TAC[LT_0;EL;HD;]; + (* save *) + FIRST_ASSUM MATCH_MP_TAC; + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + REPEAT STRIP_TAC; + CLAIM `SUC i < SUC (LENGTH t)`; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + REPEAT_N 3 (POP_ASSUM MP_TAC); + REWRITE_ASSUMS[NOT_EXISTS_THM]; + POP_ASSUM (ASSUME_TAC o ISPEC `SUC i`); + REWRITE_ALL[LT_SUC]; + REWRITE_ALL[EL;TL;]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let ALL2_EL = prove_by_refinement( + `!P (l1:A list) (l2:B list). ALL2 P l1 l2 <=> (LENGTH l1 = LENGTH l2) /\ + ~(?i. i < LENGTH l1 /\ ~(P (EL i l1) (EL i l2)))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + EQ_TAC; + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_LENGTH; + ASM_MESON_TAC[]; + ASM_MESON_TAC[ALL2_EL_LT]; + (* save *) + ASM_MESON_TAC[ALL2_EL_LEM]; +]);; +(* }}} *) + +let EL_MAP = prove_by_refinement( + `!f l n. n < LENGTH l ==> (EL n (MAP f l) = f (EL n l))`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[LENGTH]; + ARITH_TAC; + REWRITE_TAC[MAP;LENGTH;]; + INDUCT_TAC; + REWRITE_TAC[MAP;LENGTH;EL;HD;]; + REWRITE_ALL[LT_SUC;TL;MAP;LENGTH;EL;HD;]; + ASM_REWRITE_TAC[]; +]);; +(* }}} *) + +let REMOVE_HD_COL = prove_by_refinement( + `!p ps sgns pts. + interpmat pts (CONS p ps) sgns ==> interpmat pts ps (MAP TL sgns)`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;ALL2_EL]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[ALL2_EL]; + ASM_MESON_TAC[LENGTH_MAP]; + REWRITE_ASSUMS[NOT_EXISTS_THM]; + REPEAT_N 2 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `i:num`); + REWRITE_TAC[DE_MORGAN_THM]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[]; + REWRITE_ALL[interpsigns]; + CLAIM `i < LENGTH sgns`; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[EL_MAP]; + REWRITE_ALL[interpsigns]; + CLAIM `~(EL i sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + REWRITE_TAC[LENGTH]; + ARITH_TAC; + (* save *) + DISCH_THEN (MP_TAC o MATCH_MP HD_TL); + DISCH_THEN (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN SUBST1_TAC x); + REWRITE_TAC[ALL2;TL;]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; +(* }}} *) + +let REMOVE_COL1 = prove_by_refinement( + `!sgns pts p1 p2 ps. + interpmat pts (CONS p1 (CONS p2 ps)) sgns ==> + interpmat pts (CONS p1 ps) (MAP (\x. CONS (HD x) (TL (TL x))) sgns)`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;ALL2_EL]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[LENGTH_MAP]; + REWRITE_ASSUMS[NOT_EXISTS_THM]; + REPEAT_N 2 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `i:num`); + REWRITE_TAC[DE_MORGAN_THM]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[]; + REWRITE_ALL[interpsigns]; + CLAIM `i < LENGTH sgns`; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[EL_MAP]; + REWRITE_ALL[interpsigns]; + CLAIM `~(EL i sgns = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + REWRITE_TAC[LENGTH]; + ARITH_TAC; + (* save *) + DISCH_THEN (MP_TAC o MATCH_MP HD_TL); + DISCH_THEN (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN SUBST1_TAC x); + REWRITE_TAC[ALL2;TL;]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[HD;]; + CLAIM `~(TL (EL i sgns) = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + REWRITE_TAC[LENGTH]; + ARITH_TAC; + (* save *) + DISCH_THEN (MP_TAC o MATCH_MP HD_TL); + DISCH_THEN (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN SUBST1_TAC x); + REWRITE_TAC[ALL2;TL;]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[HD;]; +]);; +(* }}} *) + +let ALL_EL = prove_by_refinement( + `!P l. ALL P l <=> !n. n < LENGTH l ==> P (EL n l)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[ALL;LENGTH]; + ARITH_TAC; + ASM_REWRITE_TAC[ALL]; + POP_ASSUM (fun x -> ALL_TAC); + EQ_TAC; + REPEAT STRIP_TAC; + CASES_ON `n = 0`; + POP_ASSUM (REWRITE_ALL o list); + ASM_REWRITE_TAC[EL;HD;]; + REWRITE_ASSUMS[LENGTH]; + CLAIM `PRE n < LENGTH t`; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN (fun x -> FIRST_ASSUM (MP_TAC o C MATCH_MP x)); + ASM_MESON_TAC[EL_PRE]; + (* save *) + REPEAT STRIP_TAC; + REWRITE_ASSUMS[LENGTH]; + FIRST_ASSUM (MP_TAC o ISPEC `0`); + REWRITE_TAC[EL;HD;]; + MESON_TAC[LT_0]; + REWRITE_ASSUMS[LENGTH]; + CLAIM `SUC n < SUC (LENGTH t)`; + ASM_MESON_TAC[LT_SUC]; + DISCH_THEN (fun x -> FIRST_ASSUM (MP_TAC o C MATCH_MP x)); + REWRITE_TAC[EL_SUC]; +]);; +(* }}} *) + +let INTERPMAT_POL_LENGTH_LEM = prove_by_refinement( + `!k pols l1 l2. ALL2 (interpsigns pols) l1 l2 /\ (k = LENGTH l2) ==> + ALL (\x. LENGTH x = LENGTH pols) l2`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REPEAT STRIP_TAC; + CLAIM `l2 = []`; + ASM_MESON_TAC[NOT_CONS_NIL;LENGTH_0;ALL2_LENGTH]; + DISCH_THEN (REWRITE_ALL o list); + REWRITE_TAC[ALL]; + REPEAT STRIP_TAC; + CLAIM `~(l2 = [])`; + ASM_MESON_TAC[NOT_CONS_NIL;LENGTH_0;ALL2_LENGTH;NOT_SUC]; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN (POP_ASSUM (REWRITE_ALL o list)); + CLAIM `~(l1 = [])`; + ASM_MESON_TAC[NOT_CONS_NIL;LENGTH_0;ALL2_LENGTH;NOT_SUC]; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN (POP_ASSUM (REWRITE_ALL o list)); + REWRITE_ALL[ALL2;ALL;interpsigns]; + STRIP_TAC; + ASM_MESON_TAC[ALL2_LENGTH]; + FIRST_ASSUM MATCH_MP_TAC; + EXISTS_TAC `t'`; + ASM_REWRITE_TAC[]; + REWRITE_ALL[LENGTH]; + POP_ASSUM MP_TAC THEN ARITH_TAC; +]);; +(* }}} *) + +let INTERPMAT_POL_LENGTH = prove_by_refinement( + `!pts pols sgns. interpmat pts pols sgns ==> + ALL (\x. LENGTH x = LENGTH pols) sgns`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + MESON_TAC[INTERPMAT_POL_LENGTH_LEM]; +]);; +(* }}} *) + +let RESTRIP_TAC = REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC;; + +let ALL2_BUTLAST = prove_by_refinement( + `!P l1 l2. ALL2 P l1 l2 ==> ALL2 P (BUTLAST l1) (BUTLAST l2)`, +(* {{{ Proof *) + +[ + STRIP_TAC; + REPEAT LIST_INDUCT_TAC; + REWRITE_TAC[ALL2;BUTLAST]; + REWRITE_TAC[ALL2;BUTLAST]; + REWRITE_TAC[ALL2;BUTLAST]; + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[ALL2;BUTLAST;]; + REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[NOT_CONS_NIL;ALL2;]; + REWRITE_ASSUMS[NOT_NIL]; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[ALL2]; + REWRITE_ASSUMS[NOT_NIL]; + RESTRIP_TAC; + ASM_MESON_TAC[ALL2]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; +]);; + +(* }}} *) + +let REMOVE_LAST = prove_by_refinement( + `!pts pols sgns . + interpmat pts pols sgns ==> + interpmat pts (BUTLAST pols) (MAP BUTLAST sgns)`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;ALL2_EL]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[LENGTH_MAP]; + REWRITE_ASSUMS[NOT_EXISTS_THM]; + REPEAT_N 2 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `i:num`); + REWRITE_TAC[DE_MORGAN_THM]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[]; + REWRITE_ALL[interpsigns]; + CLAIM `i < LENGTH sgns`; + ASM_MESON_TAC[]; + STRIP_TAC; + (* save *) + ASM_SIMP_TAC[EL_MAP]; + ASM_MESON_TAC[ALL2_BUTLAST]; +]);; +(* }}} *) + +let INSERTAT = new_recursive_definition num_RECURSION + `(INSERTAT 0 x l = CONS x l) /\ + (INSERTAT (SUC n) x l = CONS (HD l) (INSERTAT n x (TL l)))`;; + +let MAP2_EL_LEM = prove_by_refinement( + `!f k l1 l2 i. (LENGTH l1 = LENGTH l2) ==> i < LENGTH l1 ==> + (k = LENGTH l1) ==> + (EL i (MAP2 f l1 l2) = f (EL i l1) (EL i l2))`, +(* {{{ Proof *) +[ + STRIP_TAC; + INDUCT_TAC; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + REPEAT STRIP_TAC; + CLAIM `~(l1 = [])`; + ASM_MESON_TAC[LENGTH_0;NOT_SUC]; + CLAIM `~(l2 = [])`; + ASM_MESON_TAC[LENGTH_0;NOT_SUC]; + REWRITE_TAC[NOT_NIL]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[MAP2]; + REWRITE_ALL[LENGTH;SUC_INJ]; + DISJ_CASES_TAC (ISPEC `i:num` num_CASES); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;HD;]; + POP_ASSUM MP_TAC THEN STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;TL;]; + REWRITE_ASSUMS[LT_SUC]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let MAP2_EL = prove_by_refinement( + `!f i l1 l2. (LENGTH l1 = LENGTH l2) ==> i < LENGTH l1 ==> + (EL i (MAP2 f l1 l2) = f (EL i l1) (EL i l2))`, +(* {{{ Proof *) +[ + MESON_TAC[MAP2_EL_LEM]; +]);; +(* }}} *) + +let INSERTAT_LENGTH = prove_by_refinement( + `!x n l. n <= LENGTH l ==> (LENGTH (INSERTAT n x l) = SUC (LENGTH l))`, +(* {{{ Proof *) + +[ + STRIP_TAC; + INDUCT_TAC; + REWRITE_TAC[INSERTAT;LENGTH;]; + REWRITE_TAC[INSERTAT;LENGTH;]; + REPEAT STRIP_TAC; + AP_TERM_TAC; + CLAIM `~(l = [])`; + ASM_MESON_TAC[LENGTH_0;NOT_LE;ARITH_RULE `~(SUC n <= 0)`]; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[LENGTH;TL;LE_SUC]; + ASM_MESON_TAC[]; +]);; + +(* }}} *) + +let NUM_CASES_TAC = TYPE_TAC (fun x -> DISJ_CASES_TAC (ISPEC x num_CASES));; + +let INSERTAT_TL = prove_by_refinement( + `!x n l. n < LENGTH l ==> (INSERTAT n x (TL l) = TL (INSERTAT (SUC n) x l))`, +(* {{{ Proof *) +[ + STRIP_TAC; + INDUCT_TAC; + REPEAT STRIP_TAC; + REWRITE_TAC[INSERTAT;TL;]; + REPEAT STRIP_TAC; + CLAIM `n < LENGTH l \/ (n = LENGTH l)`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + REWRITE_TAC[INSERTAT;HD;TL;]; + REWRITE_TAC[INSERTAT;HD;TL;]; +]);; +(* }}} *) + +let INSERTAT_EL = prove_by_refinement( + `!n (x:A) i l. n <= LENGTH l ==> i <= LENGTH l ==> + ((i < n ==> (EL i (INSERTAT n x l) = EL i l)) /\ + ((i = n) ==> (EL i (INSERTAT n x l) = x)) /\ + (i > n ==> (EL i (INSERTAT n x l) = EL (PRE i) l)))`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REPEAT STRIP_TAC; + POP_ASSUM MP_TAC THEN ARITH_TAC; + ASM_REWRITE_TAC[INSERTAT;EL;HD;]; + ASM_REWRITE_TAC[INSERTAT;EL;HD;]; + DISJ_CASES_TAC (ISPEC `i:num` num_CASES); + EVERY_ASSUM MP_TAC THEN ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;TL;PRE]; + (* save *) + REPEAT_N 5 STRIP_TAC; + CLAIM `~(l = [])`; + ASM_MESON_TAC[LENGTH_0;NOT_LE;ARITH_RULE `~(SUC n <= 0)`]; + STRIP_TAC; + CLAIM `n <= LENGTH (TL l)`; + ASM_SIMP_TAC[LENGTH_TL]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + (* save *) + REPEAT STRIP_TAC; + REWRITE_TAC[INSERTAT]; + NUM_CASES_TAC `i`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;HD;]; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;TL;]; + CLAIM `n' <= LENGTH (TL l)`; + REWRITE_ASSUMS[LT_SUC]; + ASM_MESON_TAC[LTE_TRANS;LT_TRANS;LET_TRANS;LT_IMP_LE]; + STRIP_TAC; + REWRITE_ASSUMS[LT_SUC]; + ASM_MESON_TAC[]; + (* save *) + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;INSERTAT;TL;]; + ASM_MESON_TAC[]; + REWRITE_TAC[INSERTAT]; + NUM_CASES_TAC `i`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;HD;PRE]; + (* save *) + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;TL;PRE]; + CLAIM `n' <= LENGTH (TL l)`; + ASM_SIMP_TAC[LENGTH_TL]; + REPEAT_N 3 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + REWRITE_ASSUMS[GT;LT_SUC]; + FIRST_X_ASSUM (MP_TAC o ISPECL[`x:A`;`n':num`;`TL l:A list`]); + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + NUM_CASES_TAC `n'`; + ASM_MESON_TAC[ARITH_RULE `x < y ==> ~(y = 0)`]; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[PRE;EL]; +]);; +(* }}} *) + +let USE_X_ASSUM lab ttac = + USE_THEN lab (fun th -> UNDISCH_THEN (concl th) ttac);; + +let MATINSERT_THM = prove_by_refinement( + `!pts p pols n psgns sgns. + interpmat pts pols sgns ==> + ALL2 (\x y. interpsign x p y) (partition_line pts) psgns ==> + n <= LENGTH pols ==> + interpmat pts (INSERTAT n p pols) (MAP2 (INSERTAT n) psgns sgns)`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat;ALL2_EL;NOT_EXISTS_THM;DE_MORGAN_THM;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + CLAIM `LENGTH (psgns:sign list) = LENGTH sgns`; + ASM_MESON_TAC[LENGTH_MAP2]; + ASM_MESON_TAC[LENGTH_MAP2]; + DISJ_LCASE; + REWRITE_ASSUMS[]; + (* save *) + REWRITE_ALL[interpsigns]; + CLAIM `LENGTH psgns = LENGTH sgns`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `i < LENGTH psgns`; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[MAP2_EL]; + (* save *) + REWRITE_TAC[ALL2_EL]; + REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM]; + REPEAT STRIP_TAC; + ASM_SIMP_TAC[INSERTAT_LENGTH]; + CLAIM `LENGTH (EL i (sgns:(sign list) list)) = LENGTH pols`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + ASM_SIMP_TAC[INSERTAT_LENGTH]; + (* save *) + DISJ_LCASE; + REWRITE_ASSUMS[]; + MP_TAC (ARITH_RULE `i' < n \/ (i' = n) \/ i' > (n:num)`); + REPEAT STRIP_TAC; + CLAIM `LENGTH (EL i sgns) = LENGTH pols`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + CLAIM `n <= LENGTH (EL i sgns)`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `i' <= LENGTH (EL i sgns)`; + ASM_MESON_TAC[LTE_TRANS;LET_TRANS;LT_TRANS;LT_IMP_LE]; + STRIP_TAC; + ASM_SIMP_TAC[INSERTAT_EL]; + CLAIM `i' <= LENGTH pols`; + ASM_MESON_TAC[LTE_TRANS;LET_TRANS;LT_TRANS;LT_IMP_LE]; + STRIP_TAC; + ASM_SIMP_TAC[INSERTAT_EL]; + REPEAT_N 12 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `i:num`); + REPEAT STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + USE_THEN "Z-12" MP_TAC; + REWRITE_TAC[ALL2_EL]; + REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM]; + STRIP_TAC; + POP_ASSUM (MP_TAC o ISPEC `i':num`); + POP_ASSUM (fun x -> ALL_TAC); + ASM_REWRITE_TAC[]; + POP_ASSUM (fun x -> ALL_TAC); + STRIP_TAC; + ASM_MESON_TAC[ARITH_RULE `x <= y /\ z < x ==> z < (y:num)`]; + (* save *) + POP_ASSUM (REWRITE_ALL o list); + CLAIM `LENGTH (EL i sgns) = LENGTH pols`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + CLAIM `n <= LENGTH (EL i sgns)`; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[INSERTAT_EL]; + ASM_MESON_TAC[ALL2_EL]; + (* save *) + CLAIM `LENGTH (EL i sgns) = LENGTH pols`; + ASM_MESON_TAC[ALL2_LENGTH]; + STRIP_TAC; + CLAIM `n <= LENGTH (EL i sgns)`; + ASM_MESON_TAC[]; + STRIP_TAC; + CLAIM `i' <= LENGTH (EL i sgns)`; + ASM_REWRITE_TAC[]; + LABEL_ALL_TAC; + USE_THEN "Z-7" (MP_TAC o MATCH_MP INSERTAT_LENGTH); + TYPE_TAC (fun x -> DISCH_THEN (MP_TAC o ISPEC x)) `p`; + USE_THEN "Z-3" MP_TAC THEN ARITH_TAC; + STRIP_TAC; + CLAIM `i' <= LENGTH pols`; + ASM_MESON_TAC[]; + STRIP_TAC; + ASM_SIMP_TAC[INSERTAT_EL]; + LABEL_ALL_TAC; + (* save *) + USE_X_ASSUM "Z-12" (MP_TAC o ISPEC `i:num`); + ASM_REWRITE_TAC[]; + REWRITE_TAC[ALL2_EL]; + ASM_REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM;]; + DISCH_THEN (MP_TAC o ISPEC `PRE i':num`); + STRIP_TAC; + CLAIM `~(i' = 0)`; + USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; +]);; +(* }}} *) + +let INTERP_CONST_POS = prove_by_refinement( + `!c l. c > &0 ==> + ALL2 (\x y. interpsign x (\x. c) y) l (REPLICATE (LENGTH l) Pos)`, +(* {{{ Proof *) +[ + REWRITE_TAC[real_gt;]; + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[REPLICATE;LENGTH;ALL2;]; + DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; +]);; +(* }}} *) + +let INTERP_CONST_NEG = prove_by_refinement( + `!c l. c < &0 ==> + ALL2 (\x y. interpsign x (\x. c) y) l (REPLICATE (LENGTH l) Neg)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[REPLICATE;LENGTH;ALL2;]; + DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let INTERP_CONST_ZERO = prove_by_refinement( + `!c l. (c = &0) ==> + ALL2 (\x y. interpsign x (\x. c) y) l (REPLICATE (LENGTH l) Zero)`, +(* {{{ Proof *) +[ + STRIP_TAC; + LIST_INDUCT_TAC; + REWRITE_TAC[REPLICATE;LENGTH;ALL2;]; + DISCH_THEN (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_TAC[REPLICATE;LENGTH;ALL2;interpsign;real_gt;]; + ASM_REWRITE_TAC[]; + (* XXX MESON FAILS HERE *) +]);; +(* }}} *) + +let QUANT_CONV conv = RAND_CONV(ABS_CONV conv);; + +let rec PATH_CONV2 s cnv = + match s with + [] -> cnv + | "l"::t -> RATOR_CONV (PATH_CONV2 t cnv) + | "r"::t -> RAND_CONV (PATH_CONV2 t cnv) + | "q"::t -> QUANT_CONV (PATH_CONV2 t cnv) + | "a"::t -> ABS_CONV (PATH_CONV2 t cnv) + | _ -> failwith "PATH_CONV2: unknown direction";; + +let EL_REPLICATE = prove_by_refinement( + `!n x i. i < n ==> (EL i (REPLICATE n x) = x)`, +(* {{{ Proof *) +[ + INDUCT_TAC; + ARITH_TAC; + REPEAT STRIP_TAC; + REWRITE_TAC[REPLICATE]; + NUM_CASES_TAC `i`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;HD;]; + POP_ASSUM MP_TAC THEN STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + REWRITE_TAC[EL;TL;]; + ASM_MESON_TAC[LT_SUC]; +]);; +(* }}} *) + +let ALL2_UNKNOWN = prove_by_refinement( + `!p pts. ALL2 (\x y. interpsign x p y) (partition_line pts) + (REPLICATE (LENGTH (partition_line pts)) Unknown)`, +(* {{{ Proof *) +[ + REWRITE_TAC[ALL2_EL]; + REWRITE_TAC[NOT_EXISTS_THM;DE_MORGAN_THM]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[LENGTH_REPLICATE]; + DISJ_LCASE; + REWRITE_ASSUMS[]; + ASM_SIMP_TAC[EL_REPLICATE]; + REWRITE_TAC[interpsign]; +]);; +(* }}} *) + +let MATINSERT_THM2 = prove_by_refinement( + `!pts p pols n psgns sgns. + ALL2 (\x y. interpsign x p y) (partition_line pts) psgns ==> + n <= LENGTH pols ==> + interpmat pts pols sgns ==> + interpmat pts (INSERTAT n p pols) (MAP2 (INSERTAT n) psgns sgns)`, +(* {{{ Proof *) +[ + MESON_TAC[MATINSERT_THM] +]);; +(* }}} *) + +let FUN_EQ_TAC = MATCH_EQ_MP_TAC (GSYM FUN_EQ_THM);; + +let INSERTAT_0 = prove_by_refinement( + `INSERTAT 0 = CONS`, +(* {{{ Proof *) +[ + FUN_EQ_TAC; + STRIP_TAC; + FUN_EQ_TAC; + REWRITE_TAC[INSERTAT]; +]);; +(* }}} *) + +let INFERPSIGN_MATINSERT_THM = prove_by_refinement( + `!pts p pols sgns. + interpmat pts pols sgns ==> + interpmat pts (CONS p pols) + (MAP2 CONS + (REPLICATE (2 * LENGTH pts + 1) Unknown) sgns)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l MATINSERT_THM)) + [`pts`;`p`;`pols`;`0`;`REPLICATE (LENGTH (partition_line pts)) Unknown`;`sgns`]; + ASM_REWRITE_TAC[ALL2_UNKNOWN;ARITH_RULE `0 <= x`;INSERTAT;PARTITION_LINE_LENGTH]; + MESON_TAC[INSERTAT_0]; +]);; +(* }}} *) + +let INFERPSIGN_POS = prove_by_refinement( + `!p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. p x = s x * q x + r x) ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Pos s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, +(* {{{ Proof *) + +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 5 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* save *) + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 6 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; + (* save *) + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; +]);; + +(* }}} *) + +let INFERPSIGN_NEG = prove_by_refinement( + `!p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. p x = s x * q x + r x) ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Neg s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, +(* {{{ Proof *) +[ + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 5 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* save *) + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 6 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; + (* save *) + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + REWRITE_TAC[REAL_MUL_RZERO;REAL_ADD_LID;]; + FIRST_ASSUM MATCH_MP_TAC; + REWRITE_TAC[]; +]);; +(* }}} *) + +let INFERPSIGN_POS_EVEN_LEM = prove_by_refinement( + `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a <> &0) ==> + EVEN n ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Pos s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[EVEN_ODD_POW]; + STRIP_TAC; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 8 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 9 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 15 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + (* save *) + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 10 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 17 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`]; +]);; +(* }}} *) + +let SPLIT_LIST_THM = prove_by_refinement( + `!n (l:A list). n < LENGTH l ==> + ?l1 l2. (l = APPEND l1 l2) /\ (LENGTH l1 = n)`, +(* {{{ Proof *) +[ + INDUCT_TAC; + REPEAT STRIP_TAC; + EXISTS_TAC `[]:A list`; + EXISTS_TAC `l`; + REWRITE_TAC[APPEND;LENGTH]; + REPEAT STRIP_TAC; + CLAIM `n < LENGTH l`; + POP_ASSUM MP_TAC THEN ARITH_TAC; + DISCH_THEN (fun x -> FIRST_ASSUM (fun y -> MP_TAC (MATCH_MP y x))); + STRIP_TAC; + EXISTS_TAC `APPEND l1 [HD l2]`; + EXISTS_TAC `TL (l2:A list)`; + CLAIM `~((l2:A list) = [])`; + REWRITE_TAC[GSYM LENGTH_0]; + STRIP_TAC; + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC; + POP_ASSUM (MP_TAC o AP_TERM `LENGTH:A list -> num`); + REWRITE_TAC[LENGTH_APPEND]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL;]; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + ASM_REWRITE_TAC[TL;HD;LENGTH_APPEND;LENGTH;]; + STRIP_TAC; + REWRITE_TAC[APPEND_APPEND;APPEND;]; + ARITH_TAC; +]);; +(* }}} *) + +let rec EXISTS_TACL = + (fun l -> + match l with + [] -> ALL_TAC + | h::t -> TYPE_TAC EXISTS_TAC h THEN EXISTS_TACL t);; + + +let DIV_EVEN = prove_by_refinement( + `!x. EVEN x ==> (2 * x DIV 2 = x)`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l DIVISION)) [`x`;`2`]; + ARITH_SIMP_TAC[]; + REWRITE_ASSUMS[EVEN_MOD]; + ASM_REWRITE_TAC[]; + ARITH_SIMP_TAC[]; + STRIP_TAC; + REWRITE_ASSUMS[ARITH_RULE `x + 0 = x`]; + ONCE_REWRITE_ASSUMS[ARITH_RULE `x * y = y * x:num`]; + ASM_MESON_TAC[]; +]);; +(* }}} *) + +let PRE_LEM = prove_by_refinement( + `!n. (ODD n ==> EVEN (PRE n)) /\ + (~(n = 0) ==> (EVEN n ==> ODD (PRE n)))`, +(* {{{ Proof *) +[ + INDUCT_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + REPEAT STRIP_TAC; + REWRITE_TAC[PRE]; + ASM_MESON_TAC[ODD;NOT_ODD]; + ASM_MESON_TAC[ODD;PRE;NOT_ODD]; +]);; +(* }}} *) + +let EVEN_PRE = GEN_ALL (CONJUNCT1 (SPEC_ALL PRE_LEM));; +let ODD_PRE = GEN_ALL (CONJUNCT2 (SPEC_ALL PRE_LEM));; + +let INFERPSIGN_POS_EVEN = prove_by_refinement( + `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a <> &0) ==> + EVEN n ==> + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Pos s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND sgns (CONS + (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) = + LENGTH (partition_line pts)`; + REWRITE_ALL[interpmat]; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; + STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(l2 = [])`; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + REWRITE_ALL[APPEND_NIL]; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_POS_EVEN_LEM); + ASM_REWRITE_TAC[]; + EXISTS_TACL [`a`;`n`;`s`]; + (* save *) + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + CLAIM `EVEN (LENGTH sgns - 1)`; + ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; + STRIP_TAC; + ASM_SIMP_TAC[DIV_EVEN]; + USE_THEN "Z-5" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +let INFERPSIGN_NEG_EVEN_LEM = prove_by_refinement( + `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a <> &0) ==> + EVEN n ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Neg s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[EVEN_ODD_POW]; + STRIP_TAC; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 8 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 9 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 15 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + (* save *) + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 10 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 17 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT]; +]);; +(* }}} *) + + +let INFERPSIGN_NEG_EVEN = prove_by_refinement( + `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a <> &0) ==> + EVEN n ==> + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Neg s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND sgns (CONS + (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) = + LENGTH (partition_line pts)`; + REWRITE_ALL[interpmat]; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; + STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(l2 = [])`; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + REWRITE_ALL[APPEND_NIL]; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_NEG_EVEN_LEM); + ASM_REWRITE_TAC[]; + EXISTS_TACL [`a`;`n`;`s`]; + (* save *) + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + CLAIM `EVEN (LENGTH sgns - 1)`; + ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; + STRIP_TAC; + ASM_SIMP_TAC[DIV_EVEN]; + USE_THEN "Z-5" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +let INFERPSIGN_ZERO_EVEN_LEM = prove_by_refinement( + `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a <> &0) ==> + EVEN n ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Zero s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[EVEN_ODD_POW]; + STRIP_TAC; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 8 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 5 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 9 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 15 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + (* save *) + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 10 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 17 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; +]);; +(* }}} *) + +let INFERPSIGN_ZERO_EVEN = prove_by_refinement( + `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a <> &0) ==> + EVEN n ==> + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Zero s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND sgns (CONS + (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) = + LENGTH (partition_line pts)`; + REWRITE_ALL[interpmat]; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; + STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(l2 = [])`; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + REWRITE_ALL[APPEND_NIL]; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_ZERO_EVEN_LEM); + ASM_REWRITE_TAC[]; + EXISTS_TACL [`a`;`n`;`s`]; + (* save *) + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + CLAIM `EVEN (LENGTH sgns - 1)`; + ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; + STRIP_TAC; + ASM_SIMP_TAC[DIV_EVEN]; + USE_THEN "Z-5" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + + +let INFERPSIGN_POS_ODD_POS_LEM = prove_by_refinement( + `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a > &0) ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Pos s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[REAL_POW_LT;real_gt;]; + STRIP_TAC; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 7 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 5 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 8 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 14 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + (* save *) + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x > &0`; + ASM_MESON_TAC[]; + REPEAT_N 15 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; +]);; + +(* }}} *) + +let INFERPSIGN_POS_ODD_POS = prove_by_refinement( + `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a > &0) ==> + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Pos s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND sgns (CONS + (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Pos s3))) rest)) = + LENGTH (partition_line pts)`; + REWRITE_ALL[interpmat]; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; + STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(l2 = [])`; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + REWRITE_ALL[APPEND_NIL]; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_POS_ODD_POS_LEM); + ASM_REWRITE_TAC[]; + EXISTS_TACL [`a`;`n`;`s`]; + (* save *) + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + CLAIM `EVEN (LENGTH sgns - 1)`; + ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; + STRIP_TAC; + ASM_SIMP_TAC[DIV_EVEN]; + USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +let INFERPSIGN_NEG_ODD_POS_LEM = prove_by_refinement( + `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a > &0) ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Neg s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[REAL_POW_LT;real_gt;]; + STRIP_TAC; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 7 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[real_gt]; + REPEAT_N 5 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 8 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 14 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + (* save *) + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x < &0`; + ASM_MESON_TAC[]; + REPEAT_N 15 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; +]);; + +(* }}} *) + +let INFERPSIGN_NEG_ODD_POS = prove_by_refinement( + `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a > &0) ==> + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Neg s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest))`, +(* {{{ Proof *) + +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND sgns (CONS + (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Neg s3))) rest)) = + LENGTH (partition_line pts)`; + REWRITE_ALL[interpmat]; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; + STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(l2 = [])`; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + REWRITE_ALL[APPEND_NIL]; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_NEG_ODD_POS_LEM); + ASM_REWRITE_TAC[]; + EXISTS_TACL [`a`;`n`;`s`]; + (* save *) + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + CLAIM `EVEN (LENGTH sgns - 1)`; + ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; + STRIP_TAC; + ASM_SIMP_TAC[DIV_EVEN]; + USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) + +let INFERPSIGN_ZERO_ODD_POS_LEM = prove_by_refinement( + `!a n p ps q qs r rs s x pts1 pts2 s1 s2 s3 rest sgns. + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (LENGTH sgns = 2 * LENGTH pts1 + 1) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a > &0) ==> + interpmat (APPEND pts1 (CONS x pts2)) + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Zero s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `a pow n > &0`; + ASM_MESON_TAC[REAL_POW_LT;real_gt;]; + STRIP_TAC; + REPEAT (POP_ASSUM MP_TAC); + REWRITE_TAC[interpmat]; + REPEAT STRIP_TAC; + FIRST_ASSUM MATCH_ACCEPT_TAC; + CASES_ON `pts1 = []`; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;]; + COND_CASES_TAC; + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 7 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[real_gt]; + REPEAT_N 5 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 6 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REWRITE_ASSUMS[x] THEN ASSUME_TAC x); + CLAIM `?k. sgns = [k]`; + MATCH_EQ_MP_TAC (GSYM LENGTH_1); + REWRITE_ALL[LENGTH]; + REPEAT_N 4 (POP_ASSUM (fun x -> ALL_TAC)); + POP_ASSUM MP_TAC THEN ARITH_TAC; + STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[APPEND;partition_line;ALL2;]; + REPEAT (POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + REWRITE_ALL[interpsigns;interpsign;ALL2;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 8 (POP_ASSUM MP_TAC); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 7 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`]; + ASM_REWRITE_TAC[]; + (* save *) + POP_ASSUM (fun x -> REPEAT (POP_ASSUM MP_TAC) THEN ASSUME_TAC x); + ASM_SIMP_TAC[PARTITION_LINE_APPEND]; + REPEAT STRIP_TAC; + CLAIM `(APPEND (BUTLAST (partition_line pts1)) + (CONS (\x'. LAST pts1 < x' /\ x' < x) + (TL (partition_line (CONS x pts2))))) = + (APPEND + (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) + (TL (partition_line (CONS x pts2))))`; + ASM_MESON_TAC[APPEND_CONS]; + DISCH_THEN (REWRITE_ALL o list); + REPEAT (POP_ASSUM MP_TAC); + REWRITE_ALL[partition_line]; + COND_CASES_TAC; + POP_ASSUM (REWRITE_ALL o list); + REPEAT STRIP_TAC; + REWRITE_ALL[TL;]; + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REPEAT_N 8 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + RESTRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 14 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT;REAL_LT_IMP_NZ]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + (* save *) + CLAIM `LENGTH (APPEND (BUTLAST (partition_line pts1)) + [\x'. LAST pts1 < x' /\ x' < x]) = LENGTH sgns`; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_LENGTH); + ASM_SIMP_TAC[LENGTH_APPEND;PARTITION_LINE_NOT_NIL;BUTLAST_LENGTH;PARTITION_LINE_LENGTH;LENGTH;]; + ARITH_TAC; + STRIP_TAC; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REPEAT STRIP_TAC; + MATCH_MP_TAC ALL2_APPEND; + ASM_REWRITE_TAC[]; + (* save *) + REWRITE_ALL[TL;ALL2;interpsign;interpsigns;APPEND]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC; + REPEAT_N 9 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> POP_ASSUM (fun y -> REPEAT STRIP_TAC THEN ASSUME_TAC x THEN ASSUME_TAC y)); + REWRITE_ALL[ALL2;interpsigns;APPEND;interpsign;]; + ASM_REWRITE_TAC[]; + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + REPEAT_N 4 (POP_ASSUM MP_TAC); + POP_ASSUM (fun x -> REPEAT STRIP_TAC THEN ASSUME_TAC x); + FIRST_ASSUM (MP_TAC o MATCH_MP ALL2_APPEND_LENGTH); + FIRST_ASSUM (fun x -> DISCH_THEN (fun y -> MP_TAC (MATCH_MP y x))); + REWRITE_TAC[ALL2;interpsign;]; + REPEAT STRIP_TAC; + REWRITE_ALL[interpsigns;ALL2;interpsign;]; + ASM_REWRITE_TAC[]; + CLAIM `q x = &0`; + ASM_MESON_TAC[]; + CLAIM `r x = &0`; + ASM_MESON_TAC[]; + REPEAT_N 15 (POP_ASSUM MP_TAC); + POP_ASSUM (MP_TAC o ISPEC `x:real`); + REPEAT STRIP_TAC; + POP_ASSUM (REWRITE_ALL o list); + REWRITE_ALL[REAL_MUL_RZERO;REAL_ADD_LID;]; + REPEAT_N 16 (POP_ASSUM MP_TAC); + POP_ASSUM (REWRITE_ALL o list o GSYM); + REWRITE_TAC[real_gt;REAL_MUL_GT]; + REPEAT STRIP_TAC; + ASM_MESON_TAC[REAL_ARITH `~(x < y /\ y < x)`;REAL_MUL_LT;REAL_ENTIRE;ARITH_RULE `x < y ==> ~(x = y)`;REAL_MUL_GT;REAL_LT_IMP_NZ]; +]);; + +(* }}} *) + +let INFERPSIGN_ZERO_ODD_POS = prove_by_refinement( + `!a n p ps q qs pts r rs s s1 s2 s3 rest sgns. + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) ==> + (LENGTH ps = LENGTH s1) ==> + (LENGTH qs = LENGTH s2) ==> + ODD (LENGTH sgns) ==> + (!x. a pow n * p x = s x * q x + r x) ==> + (a > &0) ==> + interpmat pts + (APPEND (CONS p ps) (APPEND (CONS q qs) (CONS r rs))) + (APPEND sgns + (CONS (APPEND (CONS Zero s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest))`, +(* {{{ Proof *) +[ + REPEAT STRIP_TAC; + CLAIM `LENGTH (APPEND sgns (CONS + (APPEND (CONS Unknown s1) + (APPEND (CONS Zero s2) (CONS Zero s3))) rest)) = + LENGTH (partition_line pts)`; + REWRITE_ALL[interpmat]; + ASM_MESON_TAC[ALL2_LENGTH]; + REWRITE_TAC[LENGTH_APPEND;PARTITION_LINE_LENGTH;LENGTH;]; + STRIP_TAC; + TYPE_TACL (fun l -> MP_TAC (ISPECL l SPLIT_LIST_THM)) [`(LENGTH sgns - 1) DIV 2`;`pts`]; + STRIP_TAC; + LABEL_ALL_TAC; + PROVE_ASSUM_ANTECEDENT_TAC 0; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC; + ARITH_TAC; + POP_ASSUM MP_TAC THEN STRIP_TAC; + ASM_REWRITE_TAC[]; + CLAIM `~(l2 = [])`; + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + REWRITE_ALL[APPEND_NIL]; + POP_ASSUM (REWRITE_ALL o list); + POP_ASSUM (fun x -> ALL_TAC); + DISCH_THEN (REWRITE_ALL o list); + POP_ASSUM MP_TAC; + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM (fun x -> ALL_TAC); + POP_ASSUM MP_TAC THEN ARITH_TAC; + REWRITE_TAC[NOT_NIL]; + STRIP_TAC THEN POP_ASSUM (REWRITE_ALL o list); + MATCH_MP_TAC (REWRITE_RULE[IMP_AND_THM] INFERPSIGN_ZERO_ODD_POS_LEM); + ASM_REWRITE_TAC[]; + EXISTS_TACL [`a`;`n`;`s`]; + (* save *) + ASM_REWRITE_TAC[]; + STRIP_TAC; + ASM_MESON_TAC[]; + LABEL_ALL_TAC; + CLAIM `EVEN (LENGTH sgns - 1)`; + ASM_MESON_TAC[EVEN_PRE;ARITH_RULE `x - 1 = PRE x`]; + STRIP_TAC; + ASM_SIMP_TAC[DIV_EVEN]; + USE_THEN "Z-4" MP_TAC THEN ARITH_TAC; +]);; + +(* }}} *) diff --git a/Tutorial/Abstractions_and_quantifiers.ml b/Tutorial/Abstractions_and_quantifiers.ml new file mode 100644 index 0000000..8d01070 --- /dev/null +++ b/Tutorial/Abstractions_and_quantifiers.ml @@ -0,0 +1,28 @@ +MESON[] + `((?x. !y. P(x) <=> P(y)) <=> ((?x. Q(x)) <=> (!y. Q(y)))) <=> + ((?x. !y. Q(x) <=> Q(y)) <=> ((?x. P(x)) <=> (!y. P(y))))`;; + +MESON[] +`(!x y z. P x y /\ P y z ==> P x z) /\ + (!x y z. Q x y /\ Q y z ==> Q x z) /\ + (!x y. P x y ==> P y x) /\ + (!x y. P x y \/ Q x y) + ==> (!x y. P x y) \/ (!x y. Q x y)`;; + +let ewd1062 = MESON[] + `(!x. x <= x) /\ + (!x y z. x <= y /\ y <= z ==> x <= z) /\ + (!x y. f(x) <= y <=> x <= g(y)) + ==> (!x y. x <= y ==> f(x) <= f(y)) /\ + (!x y. x <= y ==> g(x) <= g(y))`;; + +let ewd1062 = MESON[] + `(!x. R x x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x y. R (f x) y <=> R x (g y)) + ==> (!x y. R x y ==> R (f x) (f y)) /\ + (!x y. R x y ==> R (g x) (g y))`;; + +MESON[] `(?!x. g(f x) = x) <=> (?!y. f(g y) = y)`;; + +MESON [ADD_ASSOC; ADD_SYM] `m + (n + p) = n + (m + p)`;; diff --git a/Tutorial/Changing_proof_style.ml b/Tutorial/Changing_proof_style.ml new file mode 100644 index 0000000..f972ac1 --- /dev/null +++ b/Tutorial/Changing_proof_style.ml @@ -0,0 +1,54 @@ +let fix ts = MAP_EVERY X_GEN_TAC ts;; + +let assume lab t = + DISCH_THEN(fun th -> if concl th = t then LABEL_TAC lab th + else failwith "assume");; + +let we're finished tac = tac;; + +let suffices_to_prove q tac = SUBGOAL_THEN q (fun th -> MP_TAC th THEN tac);; + +let note(lab,t) tac = + SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN + DISCH_THEN(fun th -> LABEL_TAC lab th);; + +let have t = note("",t);; + +let cases (lab,t) tac = + SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (LABEL_TAC lab));; + +let consider (x,lab,t) tac = + let tm = mk_exists(x,t) in + SUBGOAL_THEN tm (X_CHOOSE_THEN x (LABEL_TAC lab)) THENL [tac; ALL_TAC];; + +let trivial = MESON_TAC[];; +let algebra = CONV_TAC NUM_RING;; +let arithmetic = ARITH_TAC;; + +let by labs tac = MAP_EVERY (fun l -> USE_THEN l MP_TAC) labs THEN tac;; + +let using ths tac = MAP_EVERY MP_TAC ths THEN tac;; + +let so constr arg tac = constr arg (FIRST_ASSUM MP_TAC THEN tac);; + +let NSQRT_2 = prove + (`!p q. p * p = 2 * q * q ==> q = 0`, + suffices_to_prove + `!p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) + ==> (!q. p * p = 2 * q * q ==> q = 0)` + (MATCH_ACCEPT_TAC num_WF) THEN + fix [`p:num`] THEN + assume("A") `!m. m < p ==> !q. m * m = 2 * q * q ==> q = 0` THEN + fix [`q:num`] THEN + assume("B") `p * p = 2 * q * q` THEN + so have `EVEN(p * p) <=> EVEN(2 * q * q)` (trivial) THEN + so have `EVEN(p)` (using [ARITH; EVEN_MULT] trivial) THEN + so consider (`m:num`,"C",`p = 2 * m`) (using [EVEN_EXISTS] trivial) THEN + cases ("D",`q < p \/ p <= q`) (arithmetic) THENL + [so have `q * q = 2 * m * m ==> m = 0` (by ["A"] trivial) THEN + so we're finished (by ["B"; "C"] algebra); + + so have `p * p <= q * q` (using [LE_MULT2] trivial) THEN + so have `q * q = 0` (by ["B"] arithmetic) THEN + so we're finished (algebra)]);; diff --git a/Tutorial/Custom_inference_rules.ml b/Tutorial/Custom_inference_rules.ml new file mode 100644 index 0000000..d1b276c --- /dev/null +++ b/Tutorial/Custom_inference_rules.ml @@ -0,0 +1,176 @@ +let near_ring_axioms = + `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z))`;; + +(**** Works eventually but takes a very long time +MESON[] + `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) + ==> !a. 0 * a = 0`;; + ****) + +let is_realvar w x = is_var x & not(mem x w);; + +let rec real_strip w tm = + if mem tm w then tm,[] else + let l,r = dest_comb tm in + let f,args = real_strip w l in f,args@[r];; + +let weight lis (f,n) (g,m) = + let i = index f lis and j = index g lis in + i > j or i = j & n > m;; + +let rec lexord ord l1 l2 = + match (l1,l2) with + (h1::t1,h2::t2) -> if ord h1 h2 then length t1 = length t2 + else h1 = h2 & lexord ord t1 t2 + | _ -> false;; + +let rec lpo_gt w s t = + if is_realvar w t then not(s = t) & mem t (frees s) + else if is_realvar w s or is_abs s or is_abs t then false else + let f,fargs = real_strip w s and g,gargs = real_strip w t in + exists (fun si -> lpo_ge w si t) fargs or + forall (lpo_gt w s) gargs & + (f = g & lexord (lpo_gt w) fargs gargs or + weight w (f,length fargs) (g,length gargs)) +and lpo_ge w s t = (s = t) or lpo_gt w s t;; + +let rec istriv w env x t = + if is_realvar w t then t = x or defined env t & istriv w env x (apply env t) + else if is_const t then false else + let f,args = strip_comb t in + exists (istriv w env x) args & failwith "cyclic";; + +let rec unify w env tp = + match tp with + ((Var(_,_) as x),t) | (t,(Var(_,_) as x)) when not(mem x w) -> + if defined env x then unify w env (apply env x,t) + else if istriv w env x t then env else (x|->t) env + | (Comb(f,x),Comb(g,y)) -> unify w (unify w env (x,y)) (f,g) + | (s,t) -> if s = t then env else failwith "unify: not unifiable";; + +let fullunify w (s,t) = + let env = unify w undefined (s,t) in + let th = map (fun (x,t) -> (t,x)) (graph env) in + let rec subs t = + let t' = vsubst th t in + if t' = t then t else subs t' in + map (fun (t,x) -> (subs t,x)) th;; + +let rec listcases fn rfn lis acc = + match lis with + [] -> acc + | h::t -> fn h (fun i h' -> rfn i (h'::map REFL t)) @ + listcases fn (fun i t' -> rfn i (REFL h::t')) t acc;; + +let LIST_MK_COMB f ths = rev_itlist (fun s t -> MK_COMB(t,s)) ths (REFL f);; + +let rec overlaps w th tm rfn = + let l,r = dest_eq(concl th) in + if not (is_comb tm) then [] else + let f,args = strip_comb tm in + listcases (overlaps w th) (fun i a -> rfn i (LIST_MK_COMB f a)) args + (try [rfn (fullunify w (l,tm)) th] with Failure _ -> []);; + +let crit1 w eq1 eq2 = + let l1,r1 = dest_eq(concl eq1) + and l2,r2 = dest_eq(concl eq2) in + overlaps w eq1 l2 (fun i th -> TRANS (SYM(INST i th)) (INST i eq2));; + +let fixvariables s th = + let fvs = subtract (frees(concl th)) (freesl(hyp th)) in + let gvs = map2 (fun v n -> mk_var(s^string_of_int n,type_of v)) + fvs (1--length fvs) in + INST (zip gvs fvs) th;; + +let renamepair (th1,th2) = fixvariables "x" th1,fixvariables "y" th2;; + +let critical_pairs w tha thb = + let th1,th2 = renamepair (tha,thb) in crit1 w th1 th2 @ crit1 w th2 th1;; + +let normalize_and_orient w eqs th = + let th' = GEN_REWRITE_RULE TOP_DEPTH_CONV eqs th in + let s',t' = dest_eq(concl th') in + if lpo_ge w s' t' then th' else if lpo_ge w t' s' then SYM th' + else failwith "Can't orient equation";; + +let status(eqs,crs) eqs0 = + if eqs = eqs0 & (length crs) mod 1000 <> 0 then () else + (print_string(string_of_int(length eqs)^" equations and "^ + string_of_int(length crs)^" pending critical pairs"); + print_newline());; + +let left_reducible eqs eq = + can (CHANGED_CONV(GEN_REWRITE_CONV (LAND_CONV o ONCE_DEPTH_CONV) eqs)) + (concl eq);; + +let rec complete w (eqs,crits) = + match crits with + (eq::ocrits) -> + let trip = + try let eq' = normalize_and_orient w eqs eq in + let s',t' = dest_eq(concl eq') in + if s' = t' then (eqs,ocrits) else + let crits',eqs' = partition(left_reducible [eq']) eqs in + let eqs'' = eq'::eqs' in + eqs'', + ocrits @ crits' @ itlist ((@) o critical_pairs w eq') eqs'' [] + with Failure _ -> + if exists (can (normalize_and_orient w eqs)) ocrits + then (eqs,ocrits@[eq]) + else failwith "complete: no orientable equations" in + status trip eqs; complete w trip + | [] -> eqs;; + +let complete_equations wts eqs = + let eqs' = map (normalize_and_orient wts []) eqs in + complete wts ([],eqs');; + +complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] + [SPEC_ALL(ASSUME `!a b. i(a) * a * b = b`)];; + +complete_equations [`c:A`; `f:A->A`] + (map SPEC_ALL (CONJUNCTS (ASSUME + `((f(f(f(f(f c))))) = c:A) /\ (f(f(f c)) = c)`)));; + +let eqs = map SPEC_ALL (CONJUNCTS (ASSUME + `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ + (!x y z. (x * y) * z = x * y * z)`)) in +map concl (complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] eqs);; + +let COMPLETE_TAC w th = + let eqs = map SPEC_ALL (CONJUNCTS(SPEC_ALL th)) in + let eqs' = complete_equations w eqs in + MAP_EVERY (ASSUME_TAC o GEN_ALL) eqs';; + +g `(!x. 1 * x = x) /\ + (!x. i(x) * x = 1) /\ + (!x y z. (x * y) * z = x * y * z) + ==> !x y. i(y) * i(i(i(x * i(y)))) * x = 1`;; + +e (DISCH_THEN(COMPLETE_TAC [`1`; `( * ):num->num->num`; `i:num->num`]));; +e(ASM_REWRITE_TAC[]);; + +g `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) + ==> (neg 0 * (x * y + z + neg(neg(w + z))) + neg(neg b + neg a) = + a + b)`;; + +e (DISCH_THEN(COMPLETE_TAC + [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`]));; +e(ASM_REWRITE_TAC[]);; + +(**** Could have done this instead +e (DISCH_THEN(COMPLETE_TAC + [`0`; `(+):num->num->num`; `( * ):num->num->num`; `neg:num->num`]));; +****) diff --git a/Tutorial/Custom_tactics.ml b/Tutorial/Custom_tactics.ml new file mode 100644 index 0000000..87a432f --- /dev/null +++ b/Tutorial/Custom_tactics.ml @@ -0,0 +1,124 @@ +needs "Tutorial/Vectors.ml";; + +let points = +[((0, -1), (0, -1), (2, 0)); ((0, -1), (0, 0), (2, 0)); + ((0, -1), (0, 1), (2, 0)); ((0, -1), (2, 0), (0, -1)); + ((0, -1), (2, 0), (0, 0)); ((0, -1), (2, 0), (0, 1)); + ((0, 0), (0, -1), (2, 0)); ((0, 0), (0, 0), (2, 0)); + ((0, 0), (0, 1), (2, 0)); ((0, 0), (2, 0), (-2, 0)); + ((0, 0), (2, 0), (0, -1)); ((0, 0), (2, 0), (0, 0)); + ((0, 0), (2, 0), (0, 1)); ((0, 0), (2, 0), (2, 0)); + ((0, 1), (0, -1), (2, 0)); ((0, 1), (0, 0), (2, 0)); + ((0, 1), (0, 1), (2, 0)); ((0, 1), (2, 0), (0, -1)); + ((0, 1), (2, 0), (0, 0)); ((0, 1), (2, 0), (0, 1)); + ((2, 0), (-2, 0), (0, 0)); ((2, 0), (0, -1), (0, -1)); + ((2, 0), (0, -1), (0, 0)); ((2, 0), (0, -1), (0, 1)); + ((2, 0), (0, 0), (-2, 0)); ((2, 0), (0, 0), (0, -1)); + ((2, 0), (0, 0), (0, 0)); ((2, 0), (0, 0), (0, 1)); + ((2, 0), (0, 0), (2, 0)); ((2, 0), (0, 1), (0, -1)); + ((2, 0), (0, 1), (0, 0)); ((2, 0), (0, 1), (0, 1)); + ((2, 0), (2, 0), (0, 0))];; + +let ortho = + let mult (x1,y1) (x2,y2) = (x1 * x2 + 2 * y1 * y2,x1 * y2 + y1 * x2) + and add (x1,y1) (x2,y2) = (x1 + x2,y1 + y2) in + let dot (x1,y1,z1) (x2,y2,z2) = + end_itlist add [mult x1 x2; mult y1 y2; mult z1 z2] in + fun (v1,v2) -> dot v1 v2 = (0,0);; + +let opairs = filter ortho (allpairs (fun a b -> a,b) points points);; + +let otrips = filter (fun (a,b,c) -> ortho(a,b) & ortho(a,c)) + (allpairs (fun a (b,c) -> a,b,c) points opairs);; + +let hol_of_value = + let tm0 = `&0` and tm1 = `&2` and tm2 = `-- &2` + and tm3 = `sqrt(&2)` and tm4 = `--sqrt(&2)` in + function 0,0 -> tm0 | 2,0 -> tm1 | -2,0 -> tm2 | 0,1 -> tm3 | 0,-1 -> tm4;; + +let hol_of_point = + let ptm = `vector:(real)list->real^3` in + fun (x,y,z) -> mk_comb(ptm,mk_flist(map hol_of_value [x;y;z]));; + +let SQRT_2_POW = prove + (`sqrt(&2) pow 2 = &2`, + SIMP_TAC[SQRT_POW_2; REAL_POS]);; + +let PROVE_NONTRIVIAL = + let ptm = `~(x :real^3 = vec 0)` and xtm = `x:real^3` in + fun x -> prove(vsubst [hol_of_point x,xtm] ptm, + GEN_REWRITE_TAC RAND_CONV [VECTOR_ZERO] THEN + MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; + +let PROVE_ORTHOGONAL = + let ptm = `orthogonal:real^3->real^3->bool` in + fun (x,y) -> + prove(list_mk_comb(ptm,[hol_of_point x;hol_of_point y]), + ONCE_REWRITE_TAC[ORTHOGONAL_VECTOR] THEN + MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; + +let ppoint = let p = `P:real^3->bool` in fun v -> mk_comb(p,hol_of_point v);; + +let DEDUCE_POINT_TAC pts = + FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC (map hol_of_point pts) THEN + ASM_REWRITE_TAC[];; + +let rec KOCHEN_SPECKER_TAC set_0 set_1 = + if intersect set_0 set_1 <> [] then + let p = ppoint(hd(intersect set_0 set_1)) in + let th1 = ASSUME(mk_neg p) and th2 = ASSUME p in + ACCEPT_TAC(EQ_MP (EQF_INTRO th1) th2) + else + let prf_1 = filter (fun (a,b) -> mem a set_0) opairs + and prf_0 = filter (fun (a,b,c) -> mem a set_1 & mem b set_1) otrips in + let new_1 = map snd prf_1 and new_0 = map (fun (a,b,c) -> c) prf_0 in + let set_0' = union new_0 set_0 and set_1' = union new_1 set_1 in + let del_0 = subtract set_0' set_0 and del_1 = subtract set_1' set_1 in + if del_0 <> [] or del_1 <> [] then + let prv_0 x = + let a,b,_ = find (fun (a,b,c) -> c = x) prf_0 in DEDUCE_POINT_TAC [a;b] + and prv_1 x = + let a,_ = find (fun (a,c) -> c = x) prf_1 in DEDUCE_POINT_TAC [a] in + let newuns = list_mk_conj + (map ppoint del_1 @ map (mk_neg o ppoint) del_0) + and tacs = map prv_1 del_1 @ map prv_0 del_0 in + SUBGOAL_THEN newuns STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL tacs; ALL_TAC] THEN + KOCHEN_SPECKER_TAC set_0' set_1' + else + let v = find (fun i -> not(mem i set_0) & not(mem i set_1)) points in + ASM_CASES_TAC (ppoint v) THENL + [KOCHEN_SPECKER_TAC set_0 (v::set_1); + KOCHEN_SPECKER_TAC (v::set_0) set_1];; + +let KOCHEN_SPECKER_LEMMA = prove + (`!P. (!x y:real^3. ~(x = vec 0) /\ ~(y = vec 0) /\ orthogonal x y /\ + ~(P x) ==> P y) /\ + (!x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ + orthogonal x y /\ orthogonal x z /\ orthogonal y z /\ + P x /\ P y ==> ~(P z)) + ==> F`, + REPEAT STRIP_TAC THEN + MAP_EVERY (ASSUME_TAC o PROVE_NONTRIVIAL) points THEN + MAP_EVERY (ASSUME_TAC o PROVE_ORTHOGONAL) opairs THEN + KOCHEN_SPECKER_TAC [] []);; + +let NONTRIVIAL_CROSS = prove + (`!x y. orthogonal x y /\ ~(x = vec 0) /\ ~(y = vec 0) + ==> ~(x cross y = vec 0)`, + REWRITE_TAC[GSYM DOT_EQ_0] THEN VEC3_TAC);; + +let KOCHEN_SPECKER_PARADOX = prove + (`~(?spin:real^3->num. + !x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ + orthogonal x y /\ orthogonal x z /\ orthogonal y z + ==> (spin x = 0) /\ (spin y = 1) /\ (spin z = 1) \/ + (spin x = 1) /\ (spin y = 0) /\ (spin z = 1) \/ + (spin x = 1) /\ (spin y = 1) /\ (spin z = 0))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x:real^3. spin(x) = 1` KOCHEN_SPECKER_LEMMA) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`; NONTRIVIAL_CROSS; ORTHOGONAL_CROSS]);; diff --git a/Tutorial/Defining_new_types.ml b/Tutorial/Defining_new_types.ml new file mode 100644 index 0000000..1786819 --- /dev/null +++ b/Tutorial/Defining_new_types.ml @@ -0,0 +1,124 @@ +needs "Tutorial/Vectors.ml";; + +let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") + (MESON[LEMMA_0] `?x:real^3. ~(x = vec 0)`);; + +parse_as_infix("||",(11,"right"));; +parse_as_infix("_|_",(11,"right"));; + +let perpdir = new_definition + `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; + +let pardir = new_definition + `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; + +let DIRECTION_CLAUSES = prove + (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ + ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, + MESON_TAC[direction_tybij]);; + +let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) + (`(!x. x || x) /\ + (!x y. x || y <=> y || x) /\ + (!x y z. x || y /\ y || z ==> x || z)`, + REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let DIRECTION_AXIOM_1 = prove + (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ + !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_2 = prove + (`!l l'. ?p. p _|_ l /\ p _|_ l'`, + REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN + MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; + +let DIRECTION_AXIOM_3 = prove + (`?p p' p''. + ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN + MAP_EVERY (fun t -> EXISTS_TAC t THEN REWRITE_TAC[LEMMA_0]) + [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN + VEC3_TAC);; + +let CROSS_0 = VEC3_RULE `x cross vec 0 = vec 0 /\ vec 0 cross x = vec 0`;; + +let DIRECTION_AXIOM_4_WEAK = prove + (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ + ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ + orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ + orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 2) cross (l cross basis 3) = vec 0)` + MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; + +let ORTHOGONAL_COMBINE = prove + (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) + ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_4 = prove + (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + p _|_ l /\ p' _|_ l /\ p'' _|_ l`, + MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; + +let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; + +let PERPDIR_WELLDEF = prove + (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let perpl,perpl_th = + lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) + "perpl" PERPDIR_WELLDEF;; + +let line_lift_thm = lift_theorem line_tybij + (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; + +let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; +let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; +let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; +let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; + +let point_tybij = new_type_definition "point" ("mk_point","dest_point") + (prove(`?x:line. T`,REWRITE_TAC[]));; + +parse_as_infix("on",(11,"right"));; + +let on = new_definition `p on l <=> perpl (dest_point p) l`;; + +let POINT_CLAUSES = prove + (`((p = p') <=> (dest_point p = dest_point p')) /\ + ((!p. P (dest_point p)) <=> (!l. P l)) /\ + ((?p. P (dest_point p)) <=> (?l. P l))`, + MESON_TAC[point_tybij]);; + +let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; + +let AXIOM_1 = prove + (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ + !l'. p on l' /\ p' on l' ==> (l' = l)`, + POINT_TAC LINE_AXIOM_1);; + +let AXIOM_2 = prove + (`!l l'. ?p. p on l /\ p on l'`, + POINT_TAC LINE_AXIOM_2);; + +let AXIOM_3 = prove + (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p on l /\ p' on l /\ p'' on l)`, + POINT_TAC LINE_AXIOM_3);; + +let AXIOM_4 = prove + (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p on l /\ p' on l /\ p'' on l`, + POINT_TAC LINE_AXIOM_4);; diff --git a/Tutorial/Embedding_of_logics_deep.ml b/Tutorial/Embedding_of_logics_deep.ml new file mode 100644 index 0000000..ac07692 --- /dev/null +++ b/Tutorial/Embedding_of_logics_deep.ml @@ -0,0 +1,116 @@ +let string_INDUCT,string_RECURSION = define_type + "string = String num";; + +parse_as_infix("&&",(16,"right"));; +parse_as_infix("||",(15,"right"));; +parse_as_infix("-->",(14,"right"));; +parse_as_infix("<->",(13,"right"));; + +parse_as_prefix "Not";; +parse_as_prefix "Box";; +parse_as_prefix "Diamond";; + +let form_INDUCT,form_RECURSION = define_type + "form = False + | True + | Atom string + | Not form + | && form form + | || form form + | --> form form + | <-> form form + | Box form + | Diamond form";; + +let holds = define + `(holds (W,R) V False w <=> F) /\ + (holds (W,R) V True w <=> T) /\ + (holds (W,R) V (Atom a) w <=> V a w) /\ + (holds (W,R) V (Not p) w <=> ~(holds (W,R) V p w)) /\ + (holds (W,R) V (p && q) w <=> holds (W,R) V p w /\ holds (W,R) V q w) /\ + (holds (W,R) V (p || q) w <=> holds (W,R) V p w \/ holds (W,R) V q w) /\ + (holds (W,R) V (p --> q) w <=> holds (W,R) V p w ==> holds (W,R) V q w) /\ + (holds (W,R) V (p <-> q) w <=> holds (W,R) V p w <=> holds (W,R) V q w) /\ + (holds (W,R) V (Box p) w <=> + !w'. w' IN W /\ R w w' ==> holds (W,R) V p w') /\ + (holds (W,R) V (Diamond p) w <=> + ?w'. w' IN W /\ R w w' /\ holds (W,R) V p w')`;; + +let holds_in = new_definition + `holds_in (W,R) p = !V w. w IN W ==> holds (W,R) V p w`;; + +parse_as_infix("|=",(11,"right"));; + +let valid = new_definition + `L |= p <=> !f. L f ==> holds_in f p`;; + +let S4 = new_definition + `S4(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ + (!x. x IN W ==> R x x) /\ + (!x y z. R x y /\ R y z ==> R x z)`;; + +let LTL = new_definition + `LTL(W,R) <=> (W = UNIV) /\ !x y:num. R x y <=> x <= y`;; + +let GL = new_definition + `GL(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ + WF(\x y. R y x) /\ (!x y z:num. R x y /\ R y z ==> R x z)`;; + +let MODAL_TAC = + REWRITE_TAC[valid; FORALL_PAIR_THM; holds_in; holds] THEN MESON_TAC[];; + +let MODAL_RULE tm = prove(tm,MODAL_TAC);; + +let TAUT_1 = MODAL_RULE `L |= Box True`;; +let TAUT_2 = MODAL_RULE `L |= Box(A --> B) --> Box A --> Box B`;; +let TAUT_3 = MODAL_RULE `L |= Diamond(A --> B) --> Box A --> Diamond B`;; +let TAUT_4 = MODAL_RULE `L |= Box(A --> B) --> Diamond A --> Diamond B`;; +let TAUT_5 = MODAL_RULE `L |= Box(A && B) --> Box A && Box B`;; +let TAUT_6 = MODAL_RULE `L |= Diamond(A || B) --> Diamond A || Diamond B`;; + +let HOLDS_FORALL_LEMMA = prove + (`!W R P. (!A V. P(holds (W,R) V A)) <=> (!p:W->bool. P p)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC; SIMP_TAC[]] THEN + POP_ASSUM(MP_TAC o SPECL [`Atom a`; `\a:string. (p:W->bool)`]) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[holds] THEN REWRITE_TAC[ETA_AX]);; + +let MODAL_SCHEMA_TAC = + REWRITE_TAC[holds_in; holds] THEN MP_TAC HOLDS_FORALL_LEMMA THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]);; + +let MODAL_REFL = prove + (`!W R. (!w:W. w IN W ==> R w w) <=> !A. holds_in (W,R) (Box A --> A)`, + MODAL_SCHEMA_TAC THEN MESON_TAC[]);; + +let MODAL_TRANS = prove + (`!W R. (!w w' w'':W. w IN W /\ w' IN W /\ w'' IN W /\ + R w w' /\ R w' w'' ==> R w w'') <=> + (!A. holds_in (W,R) (Box A --> Box(Box A)))`, + MODAL_SCHEMA_TAC THEN MESON_TAC[]);; + +let MODAL_SERIAL = prove + (`!W R. (!w:W. w IN W ==> ?w'. w' IN W /\ R w w') <=> + (!A. holds_in (W,R) (Box A --> Diamond A))`, + MODAL_SCHEMA_TAC THEN MESON_TAC[]);; + +let MODAL_SYM = prove + (`!W R. (!w w':W. w IN W /\ w' IN W /\ R w w' ==> R w' w) <=> + (!A. holds_in (W,R) (A --> Box(Diamond A)))`, + MODAL_SCHEMA_TAC THEN EQ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\v:W. v = w`; `w:W`]) THEN ASM_MESON_TAC[]);; + +let MODAL_WFTRANS = prove + (`!W R. (!x y z:W. x IN W /\ y IN W /\ z IN W /\ R x y /\ R y z ==> R x z) /\ + WF(\x y. x IN W /\ y IN W /\ R y x) <=> + (!A. holds_in (W,R) (Box(Box A --> A) --> Box A))`, + MODAL_SCHEMA_TAC THEN REWRITE_TAC[WF_IND] THEN EQ_TAC THEN + STRIP_TAC THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; + X_GEN_TAC `w:W` THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`\v:W. v IN W /\ R w v /\ !w''. w'' IN W /\ R v w'' ==> R w w''`; `w:W`]); + X_GEN_TAC `P:W->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\x:W. !w:W. x IN W /\ R w x ==> P x`) THEN + MATCH_MP_TAC MONO_FORALL] THEN + ASM_MESON_TAC[]);; diff --git a/Tutorial/Embedding_of_logics_shallow.ml b/Tutorial/Embedding_of_logics_shallow.ml new file mode 100644 index 0000000..44eaac9 --- /dev/null +++ b/Tutorial/Embedding_of_logics_shallow.ml @@ -0,0 +1,24 @@ +parse_as_prefix "Not";; +parse_as_infix("&&",(16,"right"));; +parse_as_infix("||",(15,"right"));; +parse_as_infix("-->",(14,"right"));; +parse_as_infix("<->",(13,"right"));; + +let false_def = define `False = \t:num. F`;; +let true_def = define `True = \t:num. T`;; +let not_def = define `Not p = \t:num. ~(p t)`;; +let and_def = define `p && q = \t:num. p t /\ q t`;; +let or_def = define `p || q = \t:num. p t \/ q t`;; +let imp_def = define `p --> q = \t:num. p t ==> q t`;; +let iff_def = define `p <-> q = \t:num. p t <=> q t`;; + +let forever = define `forever p = \t:num. !t'. t <= t' ==> p t'`;; +let sometime = define `sometime p = \t:num. ?t'. t <= t' /\ p t'`;; + +let next = define `next p = \t:num. p(t + 1)`;; + +parse_as_infix("until",(17,"right"));; + +let until = define + `p until q = + \t:num. ?t'. t <= t' /\ (!t''. t <= t'' /\ t'' < t' ==> p t'') /\ q t'`;; diff --git a/Tutorial/HOL_as_a_functional_programming_language.ml b/Tutorial/HOL_as_a_functional_programming_language.ml new file mode 100644 index 0000000..01e2dc0 --- /dev/null +++ b/Tutorial/HOL_as_a_functional_programming_language.ml @@ -0,0 +1,178 @@ +type ite = False | True | Atomic of int | Ite of ite*ite*ite;; + +let rec norm e = + match e with + Ite(False,y,z) -> norm z + | Ite(True,y,z) -> norm y + | Ite(Atomic i,y,z) -> Ite(Atomic i,norm y,norm z) + | Ite(Ite(u,v,w),y,z) -> norm(Ite(u,Ite(v,y,z),Ite(w,y,z))) + | _ -> e;; + +let ite_INDUCT,ite_RECURSION = define_type + "ite = False | True | Atomic num | Ite ite ite ite";; + +let eth = prove_general_recursive_function_exists + `?norm. (norm False = False) /\ + (norm True = True) /\ + (!i. norm (Atomic i) = Atomic i) /\ + (!y z. norm (Ite False y z) = norm z) /\ + (!y z. norm (Ite True y z) = norm y) /\ + (!i y z. norm (Ite (Atomic i) y z) = + Ite (Atomic i) (norm y) (norm z)) /\ + (!u v w y z. norm (Ite (Ite u v w) y z) = + norm (Ite u (Ite v y z) (Ite w y z)))`;; + +let sizeof = define + `(sizeof False = 1) /\ + (sizeof True = 1) /\ + (sizeof(Atomic i) = 1) /\ + (sizeof(Ite x y z) = sizeof x * (1 + sizeof y + sizeof z))`;; + +let eth' = + let th = prove + (hd(hyp eth), + EXISTS_TAC `MEASURE sizeof` THEN + REWRITE_TAC[WF_MEASURE; MEASURE_LE; MEASURE; sizeof] THEN ARITH_TAC) in + PROVE_HYP th eth;; + +let norm = new_specification ["norm"] eth';; + +let SIZEOF_INDUCT = REWRITE_RULE[WF_IND; MEASURE] (ISPEC`sizeof` WF_MEASURE);; + +let SIZEOF_NZ = prove + (`!e. ~(sizeof e = 0)`, + MATCH_MP_TAC ite_INDUCT THEN SIMP_TAC[sizeof; ADD_EQ_0; MULT_EQ_0; ARITH]);; + +let ITE_INDUCT = prove + (`!P. P False /\ + P True /\ + (!i. P(Atomic i)) /\ + (!y z. P z ==> P(Ite False y z)) /\ + (!y z. P y ==> P(Ite True y z)) /\ + (!i y z. P y /\ P z ==> P (Ite (Atomic i) y z)) /\ + (!u v w x y z. P(Ite u (Ite v y z) (Ite w y z)) + ==> P(Ite (Ite u v w) y z)) + ==> !e. P e`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SIZEOF_INDUCT THEN + MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ite_INDUCT THEN POP_ASSUM_LIST + (fun ths -> REPEAT STRIP_TAC THEN FIRST(mapfilter MATCH_MP_TAC ths)) THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[sizeof] THEN TRY ARITH_TAC THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC; ADD_AC; LT_ADD_LCANCEL] THEN + REWRITE_TAC[ADD_ASSOC; LT_ADD_RCANCEL] THEN + MATCH_MP_TAC(ARITH_RULE `~(b = 0) /\ ~(c = 0) ==> a < (b + a) + c`) THEN + REWRITE_TAC[MULT_EQ_0; SIZEOF_NZ]);; + +let normalized = define + `(normalized False <=> T) /\ + (normalized True <=> T) /\ + (normalized(Atomic a) <=> T) /\ + (normalized(Ite False x y) <=> F) /\ + (normalized(Ite True x y) <=> F) /\ + (normalized(Ite (Atomic a) x y) <=> normalized x /\ normalized y) /\ + (normalized(Ite (Ite u v w) x y) <=> F)`;; + +let NORMALIZED_NORM = prove + (`!e. normalized(norm e)`, + MATCH_MP_TAC ITE_INDUCT THEN REWRITE_TAC[norm; normalized]);; + +let NORMALIZED_INDUCT = prove + (`P False /\ + P True /\ + (!i. P (Atomic i)) /\ + (!i x y. P x /\ P y ==> P (Ite (Atomic i) x y)) + ==> !e. normalized e ==> P e`, + STRIP_TAC THEN MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[normalized] THEN + MATCH_MP_TAC ite_INDUCT THEN ASM_MESON_TAC[normalized]);; + +let holds = define + `(holds v False <=> F) /\ + (holds v True <=> T) /\ + (holds v (Atomic i) <=> v(i)) /\ + (holds v (Ite b x y) <=> if holds v b then holds v x else holds v y)`;; + +let HOLDS_NORM = prove + (`!e v. holds v (norm e) <=> holds v e`, + MATCH_MP_TAC ITE_INDUCT THEN SIMP_TAC[holds; norm] THEN + REPEAT STRIP_TAC THEN CONV_TAC TAUT);; + +let taut = define + `(taut (t,f) False <=> F) /\ + (taut (t,f) True <=> T) /\ + (taut (t,f) (Atomic i) <=> MEM i t) /\ + (taut (t,f) (Ite (Atomic i) x y) <=> + if MEM i t then taut (t,f) x + else if MEM i f then taut (t,f) y + else taut (CONS i t,f) x /\ taut (t,CONS i f) y)`;; + +let tautology = define `tautology e = taut([],[]) (norm e)`;; + +let NORMALIZED_TAUT = prove + (`!e. normalized e + ==> !f t. (!a. ~(MEM a t /\ MEM a f)) + ==> (taut (t,f) e <=> + !v. (!a. MEM a t ==> v(a)) /\ (!a. MEM a f ==> ~v(a)) + ==> holds v e)`, + MATCH_MP_TAC NORMALIZED_INDUCT THEN REWRITE_TAC[holds; taut] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `\a:num. MEM a t` THEN ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; DISCH_THEN MATCH_MP_TAC] THEN ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[])] THEN + ASM_SIMP_TAC[MEM; RIGHT_OR_DISTRIB; LEFT_OR_DISTRIB; + MESON[] `(!a. ~(MEM a t /\ a = i)) <=> ~(MEM i t)`; + MESON[] `(!a. ~(a = i /\ MEM a f)) <=> ~(MEM i f)`] THEN + ASM_REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + MESON_TAC[]);; + +let TAUTOLOGY = prove + (`!e. tautology e <=> !v. holds v e`, + MESON_TAC[tautology; HOLDS_NORM; NORMALIZED_TAUT; MEM; NORMALIZED_NORM]);; + +let HOLDS_BACK = prove + (`!v. (F <=> holds v False) /\ + (T <=> holds v True) /\ + (!i. v i <=> holds v (Atomic i)) /\ + (!p. ~holds v p <=> holds v (Ite p False True)) /\ + (!p q. (holds v p /\ holds v q) <=> holds v (Ite p q False)) /\ + (!p q. (holds v p \/ holds v q) <=> holds v (Ite p True q)) /\ + (!p q. (holds v p <=> holds v q) <=> + holds v (Ite p q (Ite q False True))) /\ + (!p q. holds v p ==> holds v q <=> holds v (Ite p q True))`, + REWRITE_TAC[holds] THEN CONV_TAC TAUT);; + +let COND_CONV = GEN_REWRITE_CONV I [COND_CLAUSES];; +let AND_CONV = GEN_REWRITE_CONV I [TAUT `(F /\ a <=> F) /\ (T /\ a <=> a)`];; +let OR_CONV = GEN_REWRITE_CONV I [TAUT `(F \/ a <=> a) /\ (T \/ a <=> T)`];; + +let rec COMPUTE_DEPTH_CONV conv tm = + if is_cond tm then + (RATOR_CONV(LAND_CONV(COMPUTE_DEPTH_CONV conv)) THENC + COND_CONV THENC + COMPUTE_DEPTH_CONV conv) tm + else if is_conj tm then + (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC + AND_CONV THENC + COMPUTE_DEPTH_CONV conv) tm + else if is_disj tm then + (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC + OR_CONV THENC + COMPUTE_DEPTH_CONV conv) tm + else + (SUB_CONV (COMPUTE_DEPTH_CONV conv) THENC + TRY_CONV(conv THENC COMPUTE_DEPTH_CONV conv)) tm;; + +g `!v. v 1 \/ v 2 \/ v 3 \/ v 4 \/ v 5 \/ v 6 \/ + ~v 1 \/ ~v 2 \/ ~v 3 \/ ~v 4 \/ ~v 5 \/ ~v 6`;; + +e(MP_TAC HOLDS_BACK THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + SPEC_TAC(`v:num->bool`,`v:num->bool`) THEN + REWRITE_TAC[GSYM TAUTOLOGY; tautology]);; + +time e (GEN_REWRITE_TAC COMPUTE_DEPTH_CONV [norm; taut; MEM; ARITH_EQ]);; + +ignore(b()); time e (REWRITE_TAC[norm; taut; MEM; ARITH_EQ]);; diff --git a/Tutorial/HOL_basics.ml b/Tutorial/HOL_basics.ml new file mode 100644 index 0000000..3128ee1 --- /dev/null +++ b/Tutorial/HOL_basics.ml @@ -0,0 +1,5 @@ +ARITH_RULE + `(a * x + b * y + a * y) EXP 3 + (b * x) EXP 3 + + (a * x + b * y + b * x) EXP 3 + (a * y) EXP 3 = + (a * x + a * y + b * x) EXP 3 + (b * y) EXP 3 + + (a * y + b * y + b * x) EXP 3 + (a * x) EXP 3`;; diff --git a/Tutorial/HOLs_number_systems.ml b/Tutorial/HOLs_number_systems.ml new file mode 100644 index 0000000..b91b53e --- /dev/null +++ b/Tutorial/HOLs_number_systems.ml @@ -0,0 +1,126 @@ +REAL_ARITH `!x y:real. (abs(x) - abs(y)) <= abs(x - y)`;; + +INT_ARITH + `!a b a' b' D:int. + (a pow 2 - D * b pow 2) * (a' pow 2 - D * b' pow 2) = + (a * a' + D * b * b') pow 2 - D * (a * b' + a' * b) pow 2`;; + +REAL_ARITH + `!x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11:real. + x3 = abs(x2) - x1 /\ + x4 = abs(x3) - x2 /\ + x5 = abs(x4) - x3 /\ + x6 = abs(x5) - x4 /\ + x7 = abs(x6) - x5 /\ + x8 = abs(x7) - x6 /\ + x9 = abs(x8) - x7 /\ + x10 = abs(x9) - x8 /\ + x11 = abs(x10) - x9 + ==> x1 = x10 /\ x2 = x11`;; + +REAL_ARITH `!x y:real. x < y ==> x < (x + y) / &2 /\ (x + y) / &2 < y`;; + +REAL_ARITH + `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) = + ((&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) + + (&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;; + +ARITH_RULE `x < 2 ==> 2 * x + 1 < 4`;; + +(**** Fails +ARITH_RULE `~(2 * m + 1 = 2 * n)`;; + ****) + +ARITH_RULE `x < 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; + +(**** Fails +ARITH_RULE `x <= 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; + ****) + +(**** Fails +ARITH_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; + ****) + +(**** Fails +REAL_ARITH `!x y:real. x = y ==> x * y = y pow 2`;; + ****) + +prioritize_real();; + +REAL_RING + `s = (a + b + c) / &2 + ==> s * (s - b) * (s - c) + s * (s - c) * (s - a) + + s * (s - a) * (s - b) - (s - a) * (s - b) * (s - c) = + a * b * c`;; + +REAL_RING `a pow 2 = &2 /\ x pow 2 + a * x + &1 = &0 ==> x pow 4 + &1 = &0`;; + +REAL_RING + `(a * x pow 2 + b * x + c = &0) /\ + (a * y pow 2 + b * y + c = &0) /\ + ~(x = y) + ==> (a * x * y = c) /\ (a * (x + y) + b = &0)`;; + +REAL_RING + `p = (&3 * a1 - a2 pow 2) / &3 /\ + q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ + x = z + a2 / &3 /\ + x * w = w pow 2 - p / &3 + ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> + if p = &0 then x pow 3 = q + else (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; + +REAL_FIELD `&0 < x ==> &1 / x - &1 / (&1 + x) = &1 / (x * (&1 + x))`;; + +REAL_FIELD +`s pow 2 = b pow 2 - &4 * a * c + ==> (a * x pow 2 + b * x + c = &0 <=> + if a = &0 then + if b = &0 then + if c = &0 then T else F + else x = --c / b + else x = (--b + s) / (&2 * a) \/ x = (--b + --s) / (&2 * a))`;; + +(**** This needs an external SDP solver to assist with proof + +needs "Examples/sos.ml";; + +SOS_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; + +REAL_SOS + `!a1 a2 a3 a4:real. + &0 <= a1 /\ &0 <= a2 /\ &0 <= a3 /\ &0 <= a4 + ==> a1 pow 2 + + ((a1 + a2) / &2) pow 2 + + ((a1 + a2 + a3) / &3) pow 2 + + ((a1 + a2 + a3 + a4) / &4) pow 2 + <= &4 * (a1 pow 2 + a2 pow 2 + a3 pow 2 + a4 pow 2)`;; + +REAL_SOS + `!a b c:real. + a >= &0 /\ b >= &0 /\ c >= &0 + ==> &3 / &2 * (b + c) * (a + c) * (a + b) <= + a * (a + c) * (a + b) + + b * (b + c) * (a + b) + + c * (b + c) * (a + c)`;; + +SOS_CONV `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;; + +PURE_SOS +`x pow 4 + &2 * x pow 2 * z + x pow 2 - &2 * x * y * z + + &2 * y pow 2 * z pow 2 + &2 * y * z pow 2 + &2 * z pow 2 - &2 * x + + &2 * y * z + &1 >= &0`;; + +****) + +needs "Examples/cooper.ml";; + +COOPER_RULE `ODD n ==> 2 * n DIV 2 < n`;; + +COOPER_RULE `!n. n >= 8 ==> ?a b. n = 3 * a + 5 * b`;; + +needs "Rqe/make.ml";; + +REAL_QELIM_CONV `!x. &0 <= x ==> ?y. y pow 2 = x`;; diff --git a/Tutorial/Inductive_datatypes.ml b/Tutorial/Inductive_datatypes.ml new file mode 100644 index 0000000..4db2033 --- /dev/null +++ b/Tutorial/Inductive_datatypes.ml @@ -0,0 +1,76 @@ +let line_INDUCT,line_RECURSION = define_type + "line = Line_1 | Line_2 | Line_3 | Line_4 | + Line_5 | Line_6 | Line_7";; + +let point_INDUCT,point_RECURSION = define_type + "point = Point_1 | Point_2 | Point_3 | Point_4 | + Point_5 | Point_6 | Point_7";; + +let fano_incidence = + [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; + 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; + +let fano_point i = mk_const("Point_"^string_of_int i,[]);; +let fano_line i = mk_const("Line_"^string_of_int i,[]);; +let p = `p:point` and l = `l:line` ;; + +let fano_clause (i,j) = mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; + +parse_as_infix("ON",(11,"right"));; + +let ON = new_definition + (mk_eq(`((ON):point->line->bool) p l`, + list_mk_disj(map fano_clause fano_incidence)));; + +let ON_CLAUSES = prove + (list_mk_conj(allpairs + (fun i j -> mk_eq(mk_comb(mk_comb(`(ON)`,fano_point i),fano_line j), + if mem (i,j) fano_incidence then `T` else `F`)) + (1--7) (1--7)), + REWRITE_TAC[ON; distinctness "line"; distinctness "point"]);; + +let FORALL_POINT = prove + (`(!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ + P Point_5 /\ P Point_6 /\ P Point_7`, + EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[point_INDUCT]]);; + +let FORALL_LINE = prove + (`(!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ + P Line_5 /\ P Line_6 /\ P Line_7`, + EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[line_INDUCT]]);; + +let EXISTS_POINT = prove + (`(?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ + P Point_5 \/ P Point_6 \/ P Point_7`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_POINT]);; + +let EXISTS_LINE = prove + (`(?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ + P Line_5 \/ P Line_6 \/ P Line_7`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_LINE]);; + +let FANO_TAC = + GEN_REWRITE_TAC DEPTH_CONV + [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN + GEN_REWRITE_TAC DEPTH_CONV + (basic_rewrites() @ + [ON_CLAUSES; distinctness "point"; distinctness "line"]);; + +let FANO_RULE tm = prove(tm,FANO_TAC);; + +let AXIOM_1 = FANO_RULE +`!p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ + !l'. p ON l' /\ p' ON l' ==> l' = l`;; + +let AXIOM_2 = FANO_RULE + `!l l'. ?p. p ON l /\ p ON l'`;; + +let AXIOM_3 = FANO_RULE + `?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l)`;; + +let AXIOM_4 = FANO_RULE + `!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l`;; diff --git a/Tutorial/Inductive_definitions.ml b/Tutorial/Inductive_definitions.ml new file mode 100644 index 0000000..cde94ae --- /dev/null +++ b/Tutorial/Inductive_definitions.ml @@ -0,0 +1,90 @@ +(* ------------------------------------------------------------------------- *) +(* Bug puzzle. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let move = new_definition + `move ((ax,ay),(bx,by),(cx,cy)) ((ax',ay'),(bx',by'),(cx',cy')) <=> + (?a. ax' = ax + a * (cx - bx) /\ ay' = ay + a * (cy - by) /\ + bx' = bx /\ by' = by /\ cx' = cx /\ cy' = cy) \/ + (?b. bx' = bx + b * (ax - cx) /\ by' = by + b * (ay - cy) /\ + ax' = ax /\ ay' = ay /\ cx' = cx /\ cy' = cy) \/ + (?c. ax' = ax /\ ay' = ay /\ bx' = bx /\ by' = by /\ + cx' = cx + c * (bx - ax) /\ cy' = cy + c * (by - ay))`;; + +let reachable_RULES,reachable_INDUCT,reachable_CASES = + new_inductive_definition + `(!p. reachable p p) /\ + (!p q r. move p q /\ reachable q r ==> reachable p r)`;; + +let oriented_area = new_definition + `oriented_area ((ax,ay),(bx,by),(cx,cy)) = + ((bx - ax) * (cy - ay) - (cx - ax) * (by - ay)) / &2`;; + +let MOVE_INVARIANT = prove + (`!p p'. move p p' ==> oriented_area p = oriented_area p'`, + REWRITE_TAC[FORALL_PAIR_THM; move; oriented_area] THEN CONV_TAC REAL_RING);; + +let REACHABLE_INVARIANT = prove + (`!p p'. reachable p p' ==> oriented_area p = oriented_area p'`, + MATCH_MP_TAC reachable_INDUCT THEN MESON_TAC[MOVE_INVARIANT]);; + +let IMPOSSIBILITY_B = prove + (`~(reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(&2,&5),(-- &2,&3)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(-- &2,&3),(&2,&5)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(&1,&2),(-- &2,&3)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(-- &2,&3),(&1,&2)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&1,&2),(&2,&5)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&2,&5),(&1,&2)))`, + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REACHABLE_INVARIANT) THEN + REWRITE_TAC[oriented_area] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Verification of a simple concurrent program. *) +(* ------------------------------------------------------------------------- *) + +let init = new_definition + `init (x,y,pc1,pc2,sem) <=> + pc1 = 10 /\ pc2 = 10 /\ x = 0 /\ y = 0 /\ sem = 1`;; + +let trans = new_definition + `trans (x,y,pc1,pc2,sem) (x',y',pc1',pc2',sem') <=> + pc1 = 10 /\ sem > 0 /\ pc1' = 20 /\ sem' = sem - 1 /\ + (x',y',pc2') = (x,y,pc2) \/ + pc2 = 10 /\ sem > 0 /\ pc2' = 20 /\ sem' = sem - 1 /\ + (x',y',pc1') = (x,y,pc1) \/ + pc1 = 20 /\ pc1' = 30 /\ x' = x + 1 /\ + (y',pc2',sem') = (y,pc2,sem) \/ + pc2 = 20 /\ pc2' = 30 /\ y' = y + 1 /\ x' = x /\ + pc1' = pc1 /\ sem' = sem \/ + pc1 = 30 /\ pc1' = 10 /\ sem' = sem + 1 /\ + (x',y',pc2') = (x,y,pc2) \/ + pc2 = 30 /\ pc2' = 10 /\ sem' = sem + 1 /\ + (x',y',pc1') = (x,y,pc1)`;; + +let mutex = new_definition + `mutex (x,y,pc1,pc2,sem) <=> pc1 = 10 \/ pc2 = 10`;; + +let indinv = new_definition + `indinv (x:num,y:num,pc1,pc2,sem) <=> + sem + (if pc1 = 10 then 0 else 1) + (if pc2 = 10 then 0 else 1) = 1`;; + +needs "Library/rstc.ml";; + +let INDUCTIVE_INVARIANT = prove + (`!init invariant transition P. + (!s. init s ==> invariant s) /\ + (!s s'. invariant s /\ transition s s' ==> invariant s') /\ + (!s. invariant s ==> P s) + ==> !s s':A. init s /\ RTC transition s s' ==> P s'`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`transition:A->A->bool`; + `\s s':A. invariant s ==> invariant s'`] RTC_INDUCT) THEN + MESON_TAC[]);; + +let MUTEX = prove + (`!s s'. init s /\ RTC trans s s' ==> mutex s'`, + MATCH_MP_TAC INDUCTIVE_INVARIANT THEN EXISTS_TAC `indinv` THEN + REWRITE_TAC[init; trans; indinv; mutex; FORALL_PAIR_THM; PAIR_EQ] THEN + ARITH_TAC);; diff --git a/Tutorial/Linking_external_tools.ml b/Tutorial/Linking_external_tools.ml new file mode 100644 index 0000000..3af36b0 --- /dev/null +++ b/Tutorial/Linking_external_tools.ml @@ -0,0 +1,154 @@ +needs "Library/transc.ml";; + +let maximas e = + let filename = Filename.temp_file "maxima" ".out" in + let s = + "echo 'linel:10000; display2d:false;" ^ e ^ + ";' | maxima | grep '^(%o3)' | sed -e 's/^(%o3) //' >" ^ + filename in + if Sys.command s <> 0 then failwith "maxima" else + let fd = Pervasives.open_in filename in + let data = input_line fd in + close_in fd; Sys.remove filename; data;; + +prioritize_real();; +let maxima_ops = ["+",`(+)`; "-",`(-)`; "*",`( * )`; "/",`(/)`; "^",`(pow)`];; +let maxima_funs = ["sin",`sin`; "cos",`cos`];; + +let mk_uneg = curry mk_comb `(--)`;; + +let dest_uneg = + let ntm = `(--)` in + fun tm -> let op,t = dest_comb tm in + if op = ntm then t else failwith "dest_uneg";; + +let mk_pow = let f = mk_binop `(pow)` in fun x y -> f x (rand y);; +let mk_realvar = let real_ty = `:real` in fun x -> mk_var(x,real_ty);; + +let rec string_of_hol tm = + if is_ratconst tm then "("^string_of_num(rat_of_term tm)^")" + else if is_numeral tm then string_of_num(dest_numeral tm) + else if is_var tm then fst(dest_var tm) + else if can dest_uneg tm then "-(" ^ string_of_hol(rand tm) ^ ")" else + let lop,r = dest_comb tm in + try let op,l = dest_comb lop in + "("^string_of_hol l^" "^ rev_assoc op maxima_ops^" "^string_of_hol r^")" + with Failure _ -> rev_assoc lop maxima_funs ^ "(" ^ string_of_hol r ^ ")";; + +string_of_hol `(x + sin(-- &2 * x)) pow 2 - cos(x - &22 / &7)`;; + +let lexe s = map (function Resword s -> s | Ident s -> s) (lex(explode s));; + +let parse_bracketed prs inp = + match prs inp with + ast,")"::rst -> ast,rst + | _ -> failwith "Closing bracket expected";; + +let rec parse_ginfix op opup sof prs inp = + match prs inp with + e1,hop::rst when hop = op -> parse_ginfix op opup (opup sof e1) prs rst + | e1,rest -> sof e1,rest;; + +let parse_general_infix op = + let opcon = if op = "^" then mk_pow else mk_binop (assoc op maxima_ops) in + let constr = if op <> "^" & snd(get_infix_status op) = "right" + then fun f e1 e2 -> f(opcon e1 e2) + else fun f e1 e2 -> opcon(f e1) e2 in + parse_ginfix op constr (fun x -> x);; + +let rec parse_atomic_expression inp = + match inp with + [] -> failwith "expression expected" + | "(" :: rest -> parse_bracketed parse_expression rest + | s :: rest when forall isnum (explode s) -> + term_of_rat(num_of_string s),rest + | s :: "(" :: rest when forall isalnum (explode s) -> + let e,rst = parse_bracketed parse_expression rest in + mk_comb(assoc s maxima_funs,e),rst + | s :: rest when forall isalnum (explode s) -> mk_realvar s,rest +and parse_exp inp = parse_general_infix "^" parse_atomic_expression inp +and parse_neg inp = + match inp with + | "-" :: rest -> let e,rst = parse_neg rest in mk_uneg e,rst + | _ -> parse_exp inp +and parse_expression inp = + itlist parse_general_infix (map fst maxima_ops) parse_neg inp;; + +let hol_of_string = fst o parse_expression o lexe;; + +hol_of_string "sin(x) - cos(-(- - 1 + x))";; + +let FACTOR_CONV tm = + let s = "factor("^string_of_hol tm^")" in + let tm' = hol_of_string(maximas s) in + REAL_RING(mk_eq(tm,tm'));; + +FACTOR_CONV `&1234567890`;; + +FACTOR_CONV `x pow 6 - &1`;; + +FACTOR_CONV `r * (r * x * (&1 - x)) * (&1 - r * x * (&1 - x)) - x`;; + +let ANTIDERIV_CONV tm = + let x,bod = dest_abs tm in + let s = "integrate("^string_of_hol bod^","^fst(dest_var x)^")" in + let tm' = mk_abs(x,hol_of_string(maximas s)) in + let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) + (SPEC x (DIFF_CONV tm')) in + let th2 = REAL_RING(mk_eq(lhand(concl th1),bod)) in + GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; + +ANTIDERIV_CONV `\x. (x + &5) pow 2 + &77 * x`;; + +ANTIDERIV_CONV `\x. sin(x) + x pow 11`;; + +(**** This one fails as expected so we need more simplification later +ANTIDERIV_CONV `\x. sin(x) pow 3`;; + ****) + +let SIN_N_CLAUSES = prove + (`(sin(&(NUMERAL(BIT0 n)) * x) = + &2 * sin(&(NUMERAL n) * x) * cos(&(NUMERAL n) * x)) /\ + (sin(&(NUMERAL(BIT1 n)) * x) = + sin(&(NUMERAL(BIT0 n)) * x) * cos(x) + + sin(x) * cos(&(NUMERAL(BIT0 n)) * x)) /\ + (cos(&(NUMERAL(BIT0 n)) * x) = + cos(&(NUMERAL n) * x) pow 2 - sin(&(NUMERAL n) * x) pow 2) /\ + (cos(&(NUMERAL(BIT1 n)) * x) = + cos(&(NUMERAL(BIT0 n)) * x) * cos(x) - + sin(x) * sin(&(NUMERAL(BIT0 n)) * x))`, + REWRITE_TAC[REAL_MUL_2; REAL_POW_2] THEN + REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; SIN_ADD; COS_ADD; REAL_MUL_LID] THEN + CONV_TAC REAL_RING);; + +let TRIG_IDENT_TAC x = + REWRITE_TAC[SIN_N_CLAUSES; SIN_ADD; COS_ADD] THEN + REWRITE_TAC[REAL_MUL_LZERO; SIN_0; COS_0; REAL_MUL_RZERO] THEN + MP_TAC(SPEC x SIN_CIRCLE) THEN CONV_TAC REAL_RING;; + +let ANTIDERIV_CONV tm = + let x,bod = dest_abs tm in + let s = "expand(integrate("^string_of_hol bod^","^fst(dest_var x)^"))" in + let tm' = mk_abs(x,hol_of_string(maximas s)) in + let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) + (SPEC x (DIFF_CONV tm')) in + let th2 = prove(mk_eq(lhand(concl th1),bod),TRIG_IDENT_TAC x) in + GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; + +time ANTIDERIV_CONV `\x. sin(x) pow 3`;; + +time ANTIDERIV_CONV `\x. sin(x) * sin(x) pow 5 * cos(x) pow 4 + cos(x)`;; + +let FCT1_WEAK = prove + (`(!x. (f diffl f'(x)) x) ==> !x. &0 <= x ==> defint(&0,x) f' (f x - f(&0))`, + MESON_TAC[FTC1]);; + +let INTEGRAL_CONV tm = + let th1 = MATCH_MP FCT1_WEAK (ANTIDERIV_CONV tm) in + (CONV_RULE REAL_RAT_REDUCE_CONV o + REWRITE_RULE[SIN_0; COS_0; REAL_MUL_LZERO; REAL_MUL_RZERO] o + CONV_RULE REAL_RAT_REDUCE_CONV o BETA_RULE) th1;; + +INTEGRAL_CONV `\x. sin(x) pow 13`;; diff --git a/Tutorial/Number_theory.ml b/Tutorial/Number_theory.ml new file mode 100644 index 0000000..c1a5572 --- /dev/null +++ b/Tutorial/Number_theory.ml @@ -0,0 +1,105 @@ +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; +needs "Library/binomial.ml";; + +prioritize_num();; + +let FERMAT_PRIME_CONV n = + let tm = subst [mk_small_numeral n,`x:num`] `prime(2 EXP (2 EXP x) + 1)` in + (RAND_CONV NUM_REDUCE_CONV THENC PRIME_CONV) tm;; + +FERMAT_PRIME_CONV 0;; +FERMAT_PRIME_CONV 1;; +FERMAT_PRIME_CONV 2;; +FERMAT_PRIME_CONV 3;; +FERMAT_PRIME_CONV 4;; +FERMAT_PRIME_CONV 5;; +FERMAT_PRIME_CONV 6;; +FERMAT_PRIME_CONV 7;; +FERMAT_PRIME_CONV 8;; + +let CONG_TRIVIAL = prove + (`!x y. n divides x /\ n divides y ==> (x == y) (mod n)`, + MESON_TAC[CONG_0; CONG_SYM; CONG_TRANS]);; + +let LITTLE_CHECK_CONV tm = + EQT_ELIM((RATOR_CONV(LAND_CONV NUM_EXP_CONV) THENC CONG_CONV) tm);; + +LITTLE_CHECK_CONV `(9 EXP 8 == 9) (mod 3)`;; +LITTLE_CHECK_CONV `(9 EXP 3 == 9) (mod 3)`;; +LITTLE_CHECK_CONV `(10 EXP 7 == 10) (mod 7)`;; +LITTLE_CHECK_CONV `(2 EXP 7 == 2) (mod 7)`;; +LITTLE_CHECK_CONV `(777 EXP 13 == 777) (mod 13)`;; + +let DIVIDES_FACT_PRIME = prove + (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1]; + ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL; + ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);; + +let DIVIDES_BINOM_PRIME = prove + (`!n p. prime p /\ 0 < n /\ n < p ==> p divides binom(p,n)`, + REPEAT STRIP_TAC THEN + MP_TAC(AP_TERM `(divides) p` (SPECL [`p - n`; `n:num`] BINOM_FACT)) THEN + ASM_SIMP_TAC[DIVIDES_FACT_PRIME; PRIME_DIVPROD_EQ; SUB_ADD; LT_IMP_LE] THEN + ASM_REWRITE_TAC[GSYM NOT_LT; LT_REFL] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < n /\ n < p ==> p - n < p`]);; + +let DIVIDES_NSUM = prove + (`!m n. (!i. m <= i /\ i <= n ==> p divides f(i)) ==> p divides nsum(m..n) f`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN + ASM_MESON_TAC[LE; LE_TRANS; DIVIDES_0; DIVIDES_ADD; LE_REFL]);; + +let FLT_LEMMA = prove + (`!p a b. prime p ==> ((a + b) EXP p == a EXP p + b EXP p) (mod p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[BINOMIAL_THEOREM] THEN + SUBGOAL_THEN `1 <= p /\ 0 < p` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0; ARITH; NSUM_CLAUSES_RIGHT] THEN + REWRITE_TAC[SUB_0; SUB_REFL; EXP; binom; BINOM_REFL; MULT_CLAUSES] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a + b = (b + 0) + a`] THEN + REPEAT(MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL]) THEN + REWRITE_TAC[CONG_0] THEN MATCH_MP_TAC DIVIDES_NSUM THEN + ASM_MESON_TAC[DIVIDES_RMUL; DIVIDES_BINOM_PRIME; ARITH_RULE + `0 < p /\ 1 <= i /\ i <= p - 1 ==> 0 < i /\ i < p`]);; + +let FERMAT_LITTLE = prove + (`!p a. prime p ==> (a EXP p == a) (mod p)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THENL + [ASM_MESON_TAC[EXP_EQ_0; CONG_REFL; PRIME_0]; + ASM_MESON_TAC[ADD1; FLT_LEMMA; EXP_ONE; CONG_ADD; CONG_TRANS; CONG_REFL]]);; + +let FERMAT_LITTLE_COPRIME = prove + (`!p a. prime p /\ coprime(a,p) ==> (a EXP (p - 1) == 1) (mod p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN + ASM_SIMP_TAC[PRIME_IMP_NZ; ARITH_RULE `~(p = 0) ==> SUC(p - 1) = p`] THEN + ASM_SIMP_TAC[FERMAT_LITTLE; MULT_CLAUSES]);; + +let FERMAT_LITTLE_VARIANT = prove + (`!p a. prime p ==> (a EXP (1 + m * (p - 1)) == a) (mod p)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME_STRONG) + THENL [ASM_MESON_TAC[CONG_TRIVIAL; ADD_AC; ADD1; DIVIDES_REXP_SUC]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN + REWRITE_TAC[EXP_ADD; EXP_1] THEN MATCH_MP_TAC CONG_MULT THEN + REWRITE_TAC[GSYM EXP_EXP; CONG_REFL] THEN + ASM_MESON_TAC[COPRIME_SYM; COPRIME_EXP; PHI_PRIME; FERMAT_LITTLE_COPRIME]);; + +let RSA = prove + (`prime p /\ prime q /\ ~(p = q) /\ + (d * e == 1) (mod ((p - 1) * (q - 1))) /\ + plaintext < p * q /\ (ciphertext = (plaintext EXP e) MOD (p * q)) + ==> (plaintext = (ciphertext EXP d) MOD (p * q))`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[MOD_EXP_MOD; MULT_EQ_0; PRIME_IMP_NZ; EXP_EXP] THEN + SUBGOAL_THEN `(plaintext == plaintext EXP (e * d)) (mod (p * q))` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[CONG; MULT_EQ_0; PRIME_IMP_NZ; MOD_LT]] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [CONG_TO_1]) THENL + [ASM_MESON_TAC[MULT_EQ_1; ARITH_RULE `p - 1 = 1 <=> p = 2`]; ALL_TAC] THEN + MATCH_MP_TAC CONG_CHINESE THEN ASM_SIMP_TAC[DISTINCT_PRIME_COPRIME] THEN + ASM_MESON_TAC[FERMAT_LITTLE_VARIANT; MULT_AC; CONG_SYM]);; diff --git a/Tutorial/Propositional_logic.ml b/Tutorial/Propositional_logic.ml new file mode 100644 index 0000000..bae26f9 --- /dev/null +++ b/Tutorial/Propositional_logic.ml @@ -0,0 +1,35 @@ +TAUT + `(~input_a ==> (internal <=> T)) /\ + (~input_b ==> (output <=> internal)) /\ + (input_a ==> (output <=> F)) /\ + (input_b ==> (output <=> F)) + ==> (output <=> ~(input_a \/ input_b))`;; + +TAUT +`(i1 /\ i2 <=> a) /\ + (i1 /\ i3 <=> b) /\ + (i2 /\ i3 <=> c) /\ + (i1 /\ c <=> d) /\ + (m /\ r <=> e) /\ + (m /\ w <=> f) /\ + (n /\ w <=> g) /\ + (p /\ w <=> h) /\ + (q /\ w <=> i) /\ + (s /\ x <=> j) /\ + (t /\ x <=> k) /\ + (v /\ x <=> l) /\ + (i1 \/ i2 <=> m) /\ + (i1 \/ i3 <=> n) /\ + (i1 \/ q <=> p) /\ + (i2 \/ i3 <=> q) /\ + (i3 \/ a <=> r) /\ + (a \/ w <=> s) /\ + (b \/ w <=> t) /\ + (d \/ h <=> u) /\ + (c \/ w <=> v) /\ + (~e <=> w) /\ + (~u <=> x) /\ + (i \/ l <=> o1) /\ + (g \/ k <=> o2) /\ + (f \/ j <=> o3) + ==> (o1 <=> ~i1) /\ (o2 <=> ~i2) /\ (o3 <=> ~i3)`;; diff --git a/Tutorial/Real_analysis.ml b/Tutorial/Real_analysis.ml new file mode 100644 index 0000000..dd7d290 --- /dev/null +++ b/Tutorial/Real_analysis.ml @@ -0,0 +1,86 @@ +needs "Library/analysis.ml";; +needs "Library/transc.ml";; + +let cheb = define + `(!x. cheb 0 x = &1) /\ + (!x. cheb 1 x = x) /\ + (!n x. cheb (n + 2) x = &2 * x * cheb (n + 1) x - cheb n x)`;; + +let CHEB_INDUCT = prove + (`!P. P 0 /\ P 1 /\ (!n. P n /\ P(n + 1) ==> P(n + 2)) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN + INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN + ASM_SIMP_TAC[ARITH]);; + +let CHEB_COS = prove + (`!n x. cheb n (cos x) = cos(&n * x)`, + MATCH_MP_TAC CHEB_INDUCT THEN + REWRITE_TAC[cheb; REAL_MUL_LZERO; REAL_MUL_LID; COS_0] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_MUL_LID; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[COS_ADD; COS_DOUBLE; SIN_DOUBLE] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +let CHEB_RIPPLE = prove + (`!x. abs(x) <= &1 ==> abs(cheb n x) <= &1`, + REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN + MESON_TAC[CHEB_COS; ACS_COS; COS_BOUNDS]);; + +let NUM_ADD2_CONV = + let add_tm = `(+):num->num->num` + and two_tm = `2` in + fun tm -> + let m = mk_numeral(dest_numeral tm -/ Int 2) in + let tm' = mk_comb(mk_comb(add_tm,m),two_tm) in + SYM(NUM_ADD_CONV tm');; + +let CHEB_CONV = + let [pth0;pth1;pth2] = CONJUNCTS cheb in + let rec conv tm = + (GEN_REWRITE_CONV I [pth0; pth1] ORELSEC + (LAND_CONV NUM_ADD2_CONV THENC + GEN_REWRITE_CONV I [pth2] THENC + COMB2_CONV + (funpow 3 RAND_CONV ((LAND_CONV NUM_ADD_CONV) THENC conv)) + conv THENC + REAL_POLY_CONV)) tm in + conv;; + +CHEB_CONV `cheb 8 x`;; + +let CHEB_2N1 = prove + (`!n x. ((x - &1) * (cheb (2 * n + 1) x - &1) = + (cheb (n + 1) x - cheb n x) pow 2) /\ + (&2 * (x pow 2 - &1) * (cheb (2 * n + 2) x - &1) = + (cheb (n + 2) x - cheb n x) pow 2)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC CHEB_INDUCT THEN + REWRITE_TAC[ARITH; cheb; CHEB_CONV `cheb 2 x`; CHEB_CONV `cheb 3 x`] THEN + REPEAT(CHANGED_TAC + (REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; ARITH] THEN + REWRITE_TAC[ARITH_RULE `n + 5 = (n + 3) + 2`; + ARITH_RULE `n + 4 = (n + 2) + 2`; + ARITH_RULE `n + 3 = (n + 1) + 2`; + + cheb])) THEN + CONV_TAC REAL_RING);; + +let IVT_LEMMA1 = prove + (`!f. (!x. f contl x) + ==> !x y. f(x) <= &0 /\ &0 <= f(y) ==> ?x. f(x) = &0`, + ASM_MESON_TAC[IVT; IVT2; REAL_LE_TOTAL]);; + +let IVT_LEMMA2 = prove + (`!f. (!x. f contl x) /\ (?x. f(x) <= x) /\ (?y. y <= f(y)) ==> ?x. f(x) = x`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. f x - x` IVT_LEMMA1) THEN + ASM_SIMP_TAC[CONT_SUB; CONT_X] THEN + SIMP_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD; REAL_SUB_0; REAL_ADD_LID] THEN + ASM_MESON_TAC[]);; + +let SARKOVSKII_TRIVIAL = prove + (`!f:real->real. (!x. f contl x) /\ (?x. f(f(f(x))) = x) ==> ?x. f(x) = x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_LEMMA2 THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC + (MESON[] `P x \/ P (f x) \/ P (f(f x)) ==> ?x:real. P x`) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN REAL_ARITH_TAC);; diff --git a/Tutorial/Recursive_definitions.ml b/Tutorial/Recursive_definitions.ml new file mode 100644 index 0000000..c017608 --- /dev/null +++ b/Tutorial/Recursive_definitions.ml @@ -0,0 +1,65 @@ +let fib = define + `fib n = if n = 0 \/ n = 1 then 1 else fib(n - 1) + fib(n - 2)`;; + +let fib2 = define + `(fib2 0 = 1) /\ + (fib2 1 = 1) /\ + (fib2 (n + 2) = fib2(n) + fib2(n + 1))`;; + +let halve = define `halve (2 * n) = n`;; + +let unknown = define `unknown n = unknown(n + 1)`;; + +define + `!n. collatz(n) = if n <= 1 then n + else if EVEN(n) then collatz(n DIV 2) + else collatz(3 * n + 1)`;; + +let fusc_def = define + `(fusc (2 * n) = if n = 0 then 0 else fusc(n)) /\ + (fusc (2 * n + 1) = if n = 0 then 1 else fusc(n) + fusc(n + 1))`;; + +let fusc = prove + (`fusc 0 = 0 /\ + fusc 1 = 1 /\ + fusc (2 * n) = fusc(n) /\ + fusc (2 * n + 1) = fusc(n) + fusc(n + 1)`, + REWRITE_TAC[fusc_def] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(INST [`0`,`n:num`] fusc_def) THEN ARITH_TAC);; + +let binom = define + `(!n. binom(n,0) = 1) /\ + (!k. binom(0,SUC(k)) = 0) /\ + (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; + +let BINOM_LT = prove + (`!n k. n < k ==> (binom(n,k) = 0)`, + INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN + ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; + +let BINOM_REFL = prove + (`!n. binom(n,n) = 1`, + INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; + +let BINOM_FACT = prove + (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, + INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; + +let BINOMIAL_THEOREM = prove + (`!n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k))`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP] THEN + REWRITE_TAC[NSUM_SING_NUMSEG; binom; SUB_REFL; EXP; MULT_CLAUSES] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; NSUM_OFFSET] THEN + ASM_REWRITE_TAC[EXP; binom; GSYM ADD1; GSYM NSUM_LMUL] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; NSUM_ADD_NUMSEG; MULT_CLAUSES; SUB_0] THEN + MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN + CONJ_TAC THENL [REWRITE_TAC[MULT_AC; SUB_SUC]; REWRITE_TAC[GSYM EXP]] THEN + SIMP_TAC[ADD1; SYM(REWRITE_CONV[NSUM_OFFSET]`nsum(m+1..n+1) (\i. f i)`)] THEN + REWRITE_TAC[NSUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0] THEN + SIMP_TAC[BINOM_LT; LT; MULT_CLAUSES; ADD_CLAUSES; SUB_0; EXP; binom] THEN + SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; EXP] THEN + REWRITE_TAC[MULT_AC]);; diff --git a/Tutorial/Semantics_of_programming_languages_deep.ml b/Tutorial/Semantics_of_programming_languages_deep.ml new file mode 100644 index 0000000..67d4c15 --- /dev/null +++ b/Tutorial/Semantics_of_programming_languages_deep.ml @@ -0,0 +1,97 @@ +let string_INDUCT,string_RECURSION = + define_type "string = String (int list)";; + +let expression_INDUCT,expression_RECURSION = define_type +"expression = Literal num + | Variable string + | Plus expression expression + | Times expression expression";; + +let command_INDUCT,command_RECURSION = define_type + "command = Assign string expression + | Sequence command command + | If expression command command + | While expression command";; + +parse_as_infix(";;",(18,"right"));; +parse_as_infix(":=",(20,"right"));; +override_interface(";;",`Sequence`);; +override_interface(":=",`Assign`);; +overload_interface("+",`Plus`);; +overload_interface("*",`Times`);; + +let value = define + `(value (Literal n) s = n) /\ + (value (Variable x) s = s(x)) /\ + (value (e1 + e2) s = value e1 s + value e2 s) /\ + (value (e1 * e2) s = value e1 s * value e2 s)`;; + +let sem_RULES,sem_INDUCT,sem_CASES = new_inductive_definition + `(!x e s s'. s'(x) = value e s /\ (!y. ~(y = x) ==> s'(y) = s(y)) + ==> sem (x := e) s s') /\ + (!c1 c2 s s' s''. sem(c1) s s' /\ sem(c2) s' s'' ==> sem(c1 ;; c2) s s'') /\ + (!e c1 c2 s s'. ~(value e s = 0) /\ sem(c1) s s' ==> sem(If e c1 c2) s s') /\ + (!e c1 c2 s s'. value e s = 0 /\ sem(c2) s s' ==> sem(If e c1 c2) s s') /\ + (!e c s. value e s = 0 ==> sem(While e c) s s) /\ + (!e c s s' s''. ~(value e s = 0) /\ sem(c) s s' /\ sem(While e c) s' s'' + ==> sem(While e c) s s'')`;; + +(**** Fails + define + `sem(While e c) s s' <=> if value e s = 0 then (s' = s) + else ?s''. sem c s s'' /\ sem(While e c) s'' s'`;; +****) + +let DETERMINISM = prove + (`!c s s' s''. sem c s s' /\ sem c s s'' ==> (s' = s'')`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC sem_INDUCT THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[sem_CASES] THEN + REWRITE_TAC[distinctness "command"; injectivity "command"] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; + +let wlp = new_definition + `wlp c q s <=> !s'. sem c s s' ==> q s'`;; + +let terminates = new_definition + `terminates c s <=> ?s'. sem c s s'`;; + +let wp = new_definition + `wp c q s <=> terminates c s /\ wlp c q s`;; + +let WP_TOTAL = prove + (`!c. (wp c EMPTY = EMPTY)`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; EMPTY] THEN MESON_TAC[]);; + +let WP_MONOTONIC = prove + (`q SUBSET r ==> wp c q SUBSET wp c r`, + REWRITE_TAC[SUBSET; IN; wp; wlp; terminates] THEN MESON_TAC[]);; + +let WP_DISJUNCTIVE = prove + (`(wp c p) UNION (wp c q) = wp c (p UNION q)`, + REWRITE_TAC[FUN_EQ_THM; IN; wp; wlp; IN_ELIM_THM; UNION; terminates] THEN + MESON_TAC[DETERMINISM]);; + +let WP_SEQ = prove + (`!c1 c2 q. wp (c1 ;; c2) = wp c1 o wp c2`, + REWRITE_TAC[wp; wlp; terminates; FUN_EQ_THM; o_THM] THEN REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sem_CASES] THEN + REWRITE_TAC[injectivity "command"; distinctness "command"] THEN + MESON_TAC[DETERMINISM]);; + +let correct = new_definition + `correct p c q <=> p SUBSET (wp c q)`;; + +let CORRECT_PRESTRENGTH = prove + (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, + REWRITE_TAC[correct; SUBSET_TRANS]);; + +let CORRECT_POSTWEAK = prove + (`!p c q q'. correct p c q' /\ q' SUBSET q ==> correct p c q`, + REWRITE_TAC[correct] THEN MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; + +let CORRECT_SEQ = prove + (`!p q r c1 c2. + correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; c2) q`, + REWRITE_TAC[correct; WP_SEQ; o_THM] THEN + MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; diff --git a/Tutorial/Semantics_of_programming_languages_shallow.ml b/Tutorial/Semantics_of_programming_languages_shallow.ml new file mode 100644 index 0000000..75c68c2 --- /dev/null +++ b/Tutorial/Semantics_of_programming_languages_shallow.ml @@ -0,0 +1,240 @@ +let assign = new_definition + `Assign (f:S->S) (q:S->bool) = q o f`;; + +parse_as_infix(";;",(18,"right"));; + +let sequence = new_definition + `(c1:(S->bool)->(S->bool)) ;; (c2:(S->bool)->(S->bool)) = c1 o c2`;; + +let if_def = new_definition + `If e (c:(S->bool)->(S->bool)) q = {s | if e s then c q s else q s}`;; + +let ite_def = new_definition + `Ite e (c1:(S->bool)->(S->bool)) c2 q = + {s | if e s then c1 q s else c2 q s}`;; + +let while_RULES,while_INDUCT,while_CASES = new_inductive_definition + `!q s. If e (c ;; while e c) q s ==> while e c q s`;; + +let while_def = new_definition + `While e c q = + {s | !w. (!s:S. (if e(s) then c w s else q s) ==> w s) ==> w s}`;; + +let monotonic = new_definition + `monotonic c <=> !q q'. q SUBSET q' ==> (c q) SUBSET (c q')`;; + +let MONOTONIC_ASSIGN = prove + (`monotonic (Assign f)`, + SIMP_TAC[monotonic; assign; SUBSET; o_THM; IN]);; + +let MONOTONIC_IF = prove + (`monotonic c ==> monotonic (If e c)`, + REWRITE_TAC[monotonic; if_def] THEN SET_TAC[]);; + +let MONOTONIC_ITE = prove + (`monotonic c1 /\ monotonic c2 ==> monotonic (Ite e c1 c2)`, + REWRITE_TAC[monotonic; ite_def] THEN SET_TAC[]);; + +let MONOTONIC_SEQ = prove + (`monotonic c1 /\ monotonic c2 ==> monotonic (c1 ;; c2)`, + REWRITE_TAC[monotonic; sequence; o_THM] THEN SET_TAC[]);; + +let MONOTONIC_WHILE = prove + (`monotonic c ==> monotonic(While e c)`, + REWRITE_TAC[monotonic; while_def] THEN SET_TAC[]);; + +let WHILE_THM = prove + (`!e c q:S->bool. + monotonic c + ==> (!s. If e (c ;; While e c) q s ==> While e c q s) /\ + (!w'. (!s. If e (c ;; (\q. w')) q s ==> w' s) + ==> (!a. While e c q a ==> w' a)) /\ + (!s. While e c q s <=> If e (c ;; While e c) q s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + (MP_TAC o GEN_ALL o DISCH_ALL o derive_nonschematic_inductive_relations) + `!s:S. (if e s then c w s else q s) ==> w s` THEN + REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM; IMP_IMP] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[FUN_EQ_THM; while_def; IN_ELIM_THM] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[monotonic] THEN SET_TAC[]);; + +let WHILE_FIX = prove + (`!e c. monotonic c ==> (While e c = If e (c ;; While e c))`, + REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[WHILE_THM]);; + +let correct = new_definition + `correct p c q <=> p SUBSET (c q)`;; + +let CORRECT_PRESTRENGTH = prove + (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, + REWRITE_TAC[correct; SUBSET_TRANS]);; + +let CORRECT_POSTWEAK = prove + (`!p c q q'. monotonic c /\ correct p c q' /\ q' SUBSET q ==> correct p c q`, + REWRITE_TAC[correct; monotonic] THEN SET_TAC[]);; + +let CORRECT_ASSIGN = prove + (`!p f q. (p SUBSET (q o f)) ==> correct p (Assign f) q`, + REWRITE_TAC[correct; assign]);; + +let CORRECT_SEQ = prove + (`!p q r c1 c2. + monotonic c1 /\ correct p c1 r /\ correct r c2 q + ==> correct p (c1 ;; c2) q`, + REWRITE_TAC[correct; sequence; monotonic; o_THM] THEN SET_TAC[]);; + +let CORRECT_ITE = prove + (`!p e c1 c2 q. + correct (p INTER e) c1 q /\ correct (p INTER (UNIV DIFF e)) c2 q + ==> correct p (Ite e c1 c2) q`, + REWRITE_TAC[correct; ite_def] THEN SET_TAC[]);; + +let CORRECT_IF = prove + (`!p e c q. + correct (p INTER e) c q /\ p INTER (UNIV DIFF e) SUBSET q + ==> correct p (If e c) q`, + REWRITE_TAC[correct; if_def] THEN SET_TAC[]);; + +let CORRECT_WHILE = prove + (`!(<<) p c q e invariant. + monotonic c /\ + WF(<<) /\ + p SUBSET invariant /\ + (UNIV DIFF e) INTER invariant SUBSET q /\ + (!X:S. correct (invariant INTER e INTER (\s. X = s)) c + (invariant INTER (\s. s << X))) + ==> correct p (While e c) q`, + REWRITE_TAC[correct; SUBSET; IN_INTER; IN_UNIV; IN_DIFF; IN] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!s:S. invariant s ==> While e c q s` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND]) THEN + X_GEN_TAC `s:S` THEN REPEAT DISCH_TAC THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP WHILE_FIX th]) THEN + REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:S`; `s:S`]) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [monotonic]) THEN + REWRITE_TAC[SUBSET; IN; RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[INTER; IN_ELIM_THM; IN]);; + +let assert_def = new_definition + `assert (p:S->bool) (q:S->bool) = q`;; + +let variant_def = new_definition + `variant ((<<):S->S->bool) (q:S->bool) = q`;; + +let CORRECT_SEQ_VC = prove + (`!p q r c1 c2. + monotonic c1 /\ correct p c1 r /\ correct r c2 q + ==> correct p (c1 ;; assert r ;; c2) q`, + REWRITE_TAC[correct; sequence; monotonic; assert_def; o_THM] THEN SET_TAC[]);; + +let CORRECT_WHILE_VC = prove + (`!(<<) p c q e invariant. + monotonic c /\ + WF(<<) /\ + p SUBSET invariant /\ + (UNIV DIFF e) INTER invariant SUBSET q /\ + (!X:S. correct (invariant INTER e INTER (\s. X = s)) c + (invariant INTER (\s. s << X))) + ==> correct p (While e (assert invariant ;; variant(<<) ;; c)) q`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[sequence; variant_def; assert_def; o_DEF; ETA_AX] THEN + ASM_MESON_TAC[CORRECT_WHILE]);; + +let MONOTONIC_ASSERT = prove + (`monotonic (assert p)`, + REWRITE_TAC[assert_def; monotonic]);; + +let MONOTONIC_VARIANT = prove + (`monotonic (variant p)`, + REWRITE_TAC[variant_def; monotonic]);; + +let MONO_TAC = + REPEAT(MATCH_MP_TAC MONOTONIC_WHILE ORELSE + (MAP_FIRST MATCH_MP_TAC + [MONOTONIC_SEQ; MONOTONIC_IF; MONOTONIC_ITE] THEN CONJ_TAC)) THEN + MAP_FIRST MATCH_ACCEPT_TAC + [MONOTONIC_ASSIGN; MONOTONIC_ASSERT; MONOTONIC_VARIANT];; + +let VC_TAC = + FIRST + [MATCH_MP_TAC CORRECT_SEQ_VC THEN CONJ_TAC THENL [MONO_TAC; CONJ_TAC]; + MATCH_MP_TAC CORRECT_ITE THEN CONJ_TAC; + MATCH_MP_TAC CORRECT_IF THEN CONJ_TAC; + MATCH_MP_TAC CORRECT_WHILE_VC THEN REPEAT CONJ_TAC THENL + [MONO_TAC; TRY(MATCH_ACCEPT_TAC WF_MEASURE); ALL_TAC; ALL_TAC; + REWRITE_TAC[FORALL_PAIR_THM; MEASURE] THEN REPEAT GEN_TAC]; + MATCH_MP_TAC CORRECT_ASSIGN];; + +needs "Library/prime.ml";; + +(* ------------------------------------------------------------------------- *) +(* x = m, y = n; *) +(* while (!(x == 0 || y == 0)) *) +(* { if (x < y) y = y - x; *) +(* else x = x - y; *) +(* } *) +(* if (x == 0) x = y; *) +(* ------------------------------------------------------------------------- *) + +g `correct + (\(m,n,x,y). T) + (Assign (\(m,n,x,y). m,n,m,n) ;; // x,y := m,n + assert (\(m,n,x,y). x = m /\ y = n) ;; + While (\(m,n,x,y). ~(x = 0 \/ y = 0)) + (assert (\(m,n,x,y). gcd(x,y) = gcd(m,n)) ;; + variant(MEASURE(\(m,n,x,y). x + y)) ;; + Ite (\(m,n,x,y). x < y) + (Assign (\(m,n,x,y). m,n,x,y - x)) + (Assign (\(m,n,x,y). m,n,x - y,y))) ;; + assert (\(m,n,x,y). (x = 0 \/ y = 0) /\ gcd(x,y) = gcd(m,n)) ;; + If (\(m,n,x,y). x = 0) (Assign (\(m,n,x,y). (m,n,y,y)))) + (\(m,n,x,y). gcd(m,n) = x)`;; + +e(REPEAT VC_TAC);; + +b();; +e(REPEAT VC_TAC THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:num`; `y:num`] THEN + REWRITE_TAC[IN; INTER; UNIV; DIFF; o_DEF; IN_ELIM_THM; PAIR_EQ] THEN + CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN SIMP_TAC[]);; + +e(SIMP_TAC[GCD_SUB; LT_IMP_LE]);; +e ARITH_TAC;; + +e(SIMP_TAC[GCD_SUB; NOT_LT] THEN ARITH_TAC);; + +e(MESON_TAC[GCD_0]);; + +e(MESON_TAC[GCD_0; GCD_SYM]);; + +parse_as_infix("refines",(12,"right"));; + +let refines = new_definition + `c2 refines c1 <=> !q. c1(q) SUBSET c2(q)`;; + +let REFINES_REFL = prove + (`!c. c refines c`, + REWRITE_TAC[refines; SUBSET_REFL]);; + +let REFINES_TRANS = prove + (`!c1 c2 c3. c3 refines c2 /\ c2 refines c1 ==> c3 refines c1`, + REWRITE_TAC[refines] THEN MESON_TAC[SUBSET_TRANS]);; + +let REFINES_CORRECT = prove + (`correct p c1 q /\ c2 refines c1 ==> correct p c2 q`, + REWRITE_TAC[correct; refines] THEN MESON_TAC[SUBSET_TRANS]);; + +let REFINES_WHILE = prove + (`c' refines c ==> While e c' refines While e c`, + REWRITE_TAC[refines; while_def; SUBSET; IN_ELIM_THM; IN] THEN MESON_TAC[]);; + +let specification = new_definition + `specification(p,q) r = if q SUBSET r then p else {}`;; + +let REFINES_SPECIFICATION = prove + (`c refines specification(p,q) ==> correct p c q`, + REWRITE_TAC[specification; correct; refines] THEN + MESON_TAC[SUBSET_REFL; SUBSET_EMPTY]);; diff --git a/Tutorial/Sets_and_functions.ml b/Tutorial/Sets_and_functions.ml new file mode 100644 index 0000000..5f2f7a6 --- /dev/null +++ b/Tutorial/Sets_and_functions.ml @@ -0,0 +1,50 @@ +let SURJECTIVE_IFF_RIGHT_INVERSE = prove + (`(!y. ?x. g x = y) <=> (?f. g o f = I)`, + REWRITE_TAC[FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; + +let INJECTIVE_IFF_LEFT_INVERSE = prove + (`(!x y. f x = f y ==> x = y) <=> (?g. g o f = I)`, + let lemma = MESON[] + `(!x x'. f x = f x' ==> x = x') <=> (!y:B. ?u:A. !x. f x = y ==> u = x)` in + REWRITE_TAC[lemma; FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; + +let cantor = new_definition + `cantor(x,y) = ((x + y) EXP 2 + 3 * x + y) DIV 2`;; + +(**** Needs external SDP solver + +needs "Examples/sos.ml";; + +let CANTOR_LEMMA = prove + (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, + REWRITE_TAC[cantor] THEN CONV_TAC SOS_RULE);; + +****) + +let CANTOR_LEMMA_LEMMA = prove + (`x + y < x' + y' ==> cantor(x,y) < cantor(x',y')`, + REWRITE_TAC[ARITH_RULE `x + y < z <=> x + y + 1 <= z`] THEN DISCH_TAC THEN + REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN + MATCH_MP_TAC(ARITH_RULE `x + 2 <= y ==> x DIV 2 < y DIV 2`) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(x + y + 1) EXP 2 + (x + y + 1)` THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `a:num <= b /\ c <= d ==> a + c <= b + d + e`) THEN + ASM_SIMP_TAC[EXP_2; LE_MULT2]);; + +let CANTOR_LEMMA = prove + (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, + MESON_TAC[LT_CASES; LT_REFL; CANTOR_LEMMA_LEMMA]);; + +let CANTOR_INJ = prove + (`!w z. cantor w = cantor z ==> w = z`, + REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP CANTOR_LEMMA th)) THEN + ASM_REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN + REWRITE_TAC[ARITH_RULE `(a + b + 2 * x) DIV 2 = (a + b) DIV 2 + x`] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let CANTOR_THM = prove + (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, + REWRITE_TAC[INJECTIVE_IFF_LEFT_INVERSE; FUN_EQ_THM; I_DEF; o_DEF] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN + MESON_TAC[]);; diff --git a/Tutorial/Tactics_and_tacticals.ml b/Tutorial/Tactics_and_tacticals.ml new file mode 100644 index 0000000..e2eac42 --- /dev/null +++ b/Tutorial/Tactics_and_tacticals.ml @@ -0,0 +1,53 @@ +g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; +e DISCH_TAC;; +b();; +e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; +e(SIMP_TAC[]);; +e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; +e DISCH_TAC;; +e(ASM_REWRITE_TAC[]);; +e(CONV_TAC ARITH_RULE);; +let trivial = top_thm();; + +g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; +e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; +e(SIMP_TAC[]);; +e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; +e DISCH_TAC;; +e(ASM_REWRITE_TAC[]);; +e(CONV_TAC ARITH_RULE);; +let trivial = top_thm();; + +g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; +e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN + SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; +let trivial = top_thm();; + +let trivial = prove + (`2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`, + CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN + SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; + +let trivial = prove + (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, + REPEAT GEN_TAC THEN MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN + MP_TAC(SPECL [`x:real`; `--y`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; + +let trivial = prove + (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; + +let SUM_OF_NUMBERS = prove + (`!n. nsum(1..n) (\i. i) = (n * (n + 1)) DIV 2`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let SUM_OF_SQUARES = prove + (`!n. nsum(1..n) (\i. i * i) = (n * (n + 1) * (2 * n + 1)) DIV 6`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let SUM_OF_CUBES = prove + (`!n. nsum(1..n) (\i. i*i*i) = (n * n * (n + 1) * (n + 1)) DIV 4`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; diff --git a/Tutorial/Vectors.ml b/Tutorial/Vectors.ml new file mode 100644 index 0000000..eea62ef --- /dev/null +++ b/Tutorial/Vectors.ml @@ -0,0 +1,117 @@ +needs "Multivariate/vectors.ml";; + +needs "Examples/solovay.ml";; + +g `orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`;; + +e SOLOVAY_VECTOR_TAC;; +e(CONV_TAC REAL_RING);; + +g`!x y:real^N. x dot y <= norm x * norm y`;; +e SOLOVAY_VECTOR_TAC;; + +(**** Needs external SDP solver +needs "Examples/sos.ml";; + +e(CONV_TAC REAL_SOS);; + +let EXAMPLE_0 = prove + (`!a x y:real^N. (y - x) dot (a - y) >= &0 ==> norm(y - a) <= norm(x - a)`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; +****) + +(*** Needs Rqe loaded + +needs "Rqe/make.ml";; +let EXAMPLE_10 = prove + (`!x:real^N y. + x dot y > &0 + ==> ?u. &0 < u /\ + !v. &0 < v /\ v <= u ==> norm(v % y - x) < norm x`, + SOLOVAY_VECTOR_TAC THEN + W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC REAL_QELIM_CONV);; + +****) + +let FORALL_3 = prove + (`(!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`, + MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> (i = 1) \/ (i = 2) \/ (i = 3)`]);; + +let SUM_3 = prove + (`!t. sum(1..3) t = t(1) + t(2) + t(3)`, + REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; + +let VECTOR_3 = prove + (`(vector [x;y;z] :real^3)$1 = x /\ + (vector [x;y;z] :real^3)$2 = y /\ + (vector [x;y;z] :real^3)$3 = z`, + SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; LENGTH; ARITH] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; EL; HD; TL]);; + +let DOT_VECTOR = prove + (`(vector [x1;y1;z1] :real^3) dot (vector [x2;y2;z2]) = + x1 * x2 + y1 * y2 + z1 * z2`, + REWRITE_TAC[dot; DIMINDEX_3; SUM_3; VECTOR_3]);; + +let VECTOR_ZERO = prove + (`(vector [x;y;z] :real^3 = vec 0) <=> x = &0 /\ y = &0 /\ z = &0`, + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT; VECTOR_3; ARITH]);; + +let ORTHOGONAL_VECTOR = prove + (`orthogonal (vector [x1;y1;z1] :real^3) (vector [x2;y2;z2]) = + (x1 * x2 + y1 * y2 + z1 * z2 = &0)`, + REWRITE_TAC[orthogonal; DOT_VECTOR]);; + +parse_as_infix("cross",(20,"right"));; + +let cross = new_definition + `(a:real^3) cross (b:real^3) = + vector [a$2 * b$3 - a$3 * b$2; + a$3 * b$1 - a$1 * b$3; + a$1 * b$2 - a$2 * b$1] :real^3`;; + +let VEC3_TAC = + SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_3; SUM_3; DIMINDEX_3; VECTOR_3; + vector_add; vec; dot; cross; orthogonal; basis; ARITH] THEN + CONV_TAC REAL_RING;; + +let VEC3_RULE tm = prove(tm,VEC3_TAC);; + +let ORTHOGONAL_CROSS = VEC3_RULE + `!x y. orthogonal (x cross y) x /\ orthogonal (x cross y) y /\ + orthogonal x (x cross y) /\ orthogonal y (x cross y)`;; + +let LEMMA_0 = VEC3_RULE + `~(basis 1 :real^3 = vec 0) /\ + ~(basis 2 :real^3 = vec 0) /\ + ~(basis 3 :real^3 = vec 0)`;; + +let LEMMA_1 = VEC3_RULE `!u v. u dot (u cross v) = &0`;; + +let LEMMA_2 = VEC3_RULE `!u v. v dot (u cross v) = &0`;; + +let LEMMA_3 = VEC3_RULE `!u:real^3. vec 0 dot u = &0`;; + +let LEMMA_4 = VEC3_RULE `!u:real^3. u dot vec 0 = &0`;; + +let LEMMA_5 = VEC3_RULE `!x. x cross x = vec 0`;; + +let LEMMA_6 = VEC3_RULE + `!u. ~(u = vec 0) + ==> ~(u cross basis 1 = vec 0) \/ + ~(u cross basis 2 = vec 0) \/ + ~(u cross basis 3 = vec 0)`;; + +let LEMMA_7 = VEC3_RULE + `!u v w. (u cross v = vec 0) ==> (u dot (v cross w) = &0)`;; + +let NORMAL_EXISTS = prove + (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`u:real^3 = vec 0`; `v:real^3 = vec 0`; `u cross v = vec 0`] THEN + ASM_REWRITE_TAC[orthogonal] THEN + ASM_MESON_TAC[LEMMA_0; LEMMA_1; LEMMA_2; LEMMA_3; LEMMA_4; + LEMMA_5; LEMMA_6; LEMMA_7]);; diff --git a/Tutorial/Wellfounded_induction.ml b/Tutorial/Wellfounded_induction.ml new file mode 100644 index 0000000..5b1742c --- /dev/null +++ b/Tutorial/Wellfounded_induction.ml @@ -0,0 +1,11 @@ +let NSQRT_2 = prove + (`!p q. p * p = 2 * q * q ==> q = 0`, + MATCH_MP_TAC num_WF THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; ARITH] THEN REWRITE_TAC[EVEN_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `m:num`]) THEN + ASM_REWRITE_TAC[ARITH_RULE + `q < 2 * m ==> q * q = 2 * m * m ==> m = 0 <=> + (2 * m) * 2 * m = 2 * q * q ==> 2 * m <= q`] THEN + ASM_MESON_TAC[LE_MULT2; MULT_EQ_0; ARITH_RULE `2 * x <= x <=> x = 0`]);; diff --git a/Tutorial/all.ml b/Tutorial/all.ml new file mode 100644 index 0000000..e6a4a48 --- /dev/null +++ b/Tutorial/all.ml @@ -0,0 +1,2237 @@ +(* ========================================================================= *) +(* HOL basics *) +(* ========================================================================= *) + +ARITH_RULE + `(a * x + b * y + a * y) EXP 3 + (b * x) EXP 3 + + (a * x + b * y + b * x) EXP 3 + (a * y) EXP 3 = + (a * x + a * y + b * x) EXP 3 + (b * y) EXP 3 + + (a * y + b * y + b * x) EXP 3 + (a * x) EXP 3`;; + +(* ========================================================================= *) +(* Propositional logic *) +(* ========================================================================= *) + +TAUT + `(~input_a ==> (internal <=> T)) /\ + (~input_b ==> (output <=> internal)) /\ + (input_a ==> (output <=> F)) /\ + (input_b ==> (output <=> F)) + ==> (output <=> ~(input_a \/ input_b))`;; + +TAUT +`(i1 /\ i2 <=> a) /\ + (i1 /\ i3 <=> b) /\ + (i2 /\ i3 <=> c) /\ + (i1 /\ c <=> d) /\ + (m /\ r <=> e) /\ + (m /\ w <=> f) /\ + (n /\ w <=> g) /\ + (p /\ w <=> h) /\ + (q /\ w <=> i) /\ + (s /\ x <=> j) /\ + (t /\ x <=> k) /\ + (v /\ x <=> l) /\ + (i1 \/ i2 <=> m) /\ + (i1 \/ i3 <=> n) /\ + (i1 \/ q <=> p) /\ + (i2 \/ i3 <=> q) /\ + (i3 \/ a <=> r) /\ + (a \/ w <=> s) /\ + (b \/ w <=> t) /\ + (d \/ h <=> u) /\ + (c \/ w <=> v) /\ + (~e <=> w) /\ + (~u <=> x) /\ + (i \/ l <=> o1) /\ + (g \/ k <=> o2) /\ + (f \/ j <=> o3) + ==> (o1 <=> ~i1) /\ (o2 <=> ~i2) /\ (o3 <=> ~i3)`;; + +(* ========================================================================= *) +(* Abstractions and quantifiers *) +(* ========================================================================= *) + +MESON[] + `((?x. !y. P(x) <=> P(y)) <=> ((?x. Q(x)) <=> (!y. Q(y)))) <=> + ((?x. !y. Q(x) <=> Q(y)) <=> ((?x. P(x)) <=> (!y. P(y))))`;; + +MESON[] +`(!x y z. P x y /\ P y z ==> P x z) /\ + (!x y z. Q x y /\ Q y z ==> Q x z) /\ + (!x y. P x y ==> P y x) /\ + (!x y. P x y \/ Q x y) + ==> (!x y. P x y) \/ (!x y. Q x y)`;; + +let ewd1062 = MESON[] + `(!x. x <= x) /\ + (!x y z. x <= y /\ y <= z ==> x <= z) /\ + (!x y. f(x) <= y <=> x <= g(y)) + ==> (!x y. x <= y ==> f(x) <= f(y)) /\ + (!x y. x <= y ==> g(x) <= g(y))`;; + +let ewd1062 = MESON[] + `(!x. R x x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x y. R (f x) y <=> R x (g y)) + ==> (!x y. R x y ==> R (f x) (f y)) /\ + (!x y. R x y ==> R (g x) (g y))`;; + +MESON[] `(?!x. g(f x) = x) <=> (?!y. f(g y) = y)`;; + +MESON [ADD_ASSOC; ADD_SYM] `m + (n + p) = n + (m + p)`;; + +(* ========================================================================= *) +(* Tactics and tacticals *) +(* ========================================================================= *) + +g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; +e DISCH_TAC;; +b();; +e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; +e(SIMP_TAC[]);; +e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; +e DISCH_TAC;; +e(ASM_REWRITE_TAC[]);; +e(CONV_TAC ARITH_RULE);; +let trivial = top_thm();; + +g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; +e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]));; +e(SIMP_TAC[]);; +e(ONCE_REWRITE_TAC[EQ_SYM_EQ]);; +e DISCH_TAC;; +e(ASM_REWRITE_TAC[]);; +e(CONV_TAC ARITH_RULE);; +let trivial = top_thm();; + +g `2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`;; +e(CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN + SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; +let trivial = top_thm();; + +let trivial = prove + (`2 <= n /\ n <= 2 ==> f(2,2) + n < f(n,n) + 7`, + CONV_TAC(REWRITE_CONV[LE_ANTISYM]) THEN + SIMP_TAC[] THEN ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC ARITH_RULE);; + +let trivial = prove + (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, + REPEAT GEN_TAC THEN MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN + MP_TAC(SPECL [`x:real`; `--y`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; + +let trivial = prove + (`!x y:real. &0 < x * y ==> (&0 < x <=> &0 < y)`, + MATCH_MP_TAC REAL_WLOG_LE THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + MP_TAC(SPECL [`--x`; `y:real`] REAL_LE_MUL) THEN REAL_ARITH_TAC);; + +let SUM_OF_NUMBERS = prove + (`!n. nsum(1..n) (\i. i) = (n * (n + 1)) DIV 2`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let SUM_OF_SQUARES = prove + (`!n. nsum(1..n) (\i. i * i) = (n * (n + 1) * (2 * n + 1)) DIV 6`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let SUM_OF_CUBES = prove + (`!n. nsum(1..n) (\i. i*i*i) = (n * n * (n + 1) * (n + 1)) DIV 4`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +(* ========================================================================= *) +(* HOL's number systems *) +(* ========================================================================= *) + +REAL_ARITH `!x y:real. (abs(x) - abs(y)) <= abs(x - y)`;; + +INT_ARITH + `!a b a' b' D:int. + (a pow 2 - D * b pow 2) * (a' pow 2 - D * b' pow 2) = + (a * a' + D * b * b') pow 2 - D * (a * b' + a' * b) pow 2`;; + +REAL_ARITH + `!x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11:real. + x3 = abs(x2) - x1 /\ + x4 = abs(x3) - x2 /\ + x5 = abs(x4) - x3 /\ + x6 = abs(x5) - x4 /\ + x7 = abs(x6) - x5 /\ + x8 = abs(x7) - x6 /\ + x9 = abs(x8) - x7 /\ + x10 = abs(x9) - x8 /\ + x11 = abs(x10) - x9 + ==> x1 = x10 /\ x2 = x11`;; + +REAL_ARITH `!x y:real. x < y ==> x < (x + y) / &2 /\ (x + y) / &2 < y`;; + +REAL_ARITH + `((x1 pow 2 + x2 pow 2 + x3 pow 2 + x4 pow 2) pow 2) = + ((&1 / &6) * ((x1 + x2) pow 4 + (x1 + x3) pow 4 + (x1 + x4) pow 4 + + (x2 + x3) pow 4 + (x2 + x4) pow 4 + (x3 + x4) pow 4) + + (&1 / &6) * ((x1 - x2) pow 4 + (x1 - x3) pow 4 + (x1 - x4) pow 4 + + (x2 - x3) pow 4 + (x2 - x4) pow 4 + (x3 - x4) pow 4))`;; + +ARITH_RULE `x < 2 ==> 2 * x + 1 < 4`;; + +(**** Fails +ARITH_RULE `~(2 * m + 1 = 2 * n)`;; + ****) + +ARITH_RULE `x < 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; + +(**** Fails +ARITH_RULE `x <= 2 EXP 30 ==> (429496730 * x) DIV (2 EXP 32) = x DIV 10`;; + ****) + +(**** Fails +ARITH_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; + ****) + +(**** Fails +REAL_ARITH `!x y:real. x = y ==> x * y = y pow 2`;; + ****) + +prioritize_real();; + +REAL_RING + `s = (a + b + c) / &2 + ==> s * (s - b) * (s - c) + s * (s - c) * (s - a) + + s * (s - a) * (s - b) - (s - a) * (s - b) * (s - c) = + a * b * c`;; + +REAL_RING `a pow 2 = &2 /\ x pow 2 + a * x + &1 = &0 ==> x pow 4 + &1 = &0`;; + +REAL_RING + `(a * x pow 2 + b * x + c = &0) /\ + (a * y pow 2 + b * y + c = &0) /\ + ~(x = y) + ==> (a * x * y = c) /\ (a * (x + y) + b = &0)`;; + +REAL_RING + `p = (&3 * a1 - a2 pow 2) / &3 /\ + q = (&9 * a1 * a2 - &27 * a0 - &2 * a2 pow 3) / &27 /\ + x = z + a2 / &3 /\ + x * w = w pow 2 - p / &3 + ==> (z pow 3 + a2 * z pow 2 + a1 * z + a0 = &0 <=> + if p = &0 then x pow 3 = q + else (w pow 3) pow 2 - q * (w pow 3) - p pow 3 / &27 = &0)`;; + +REAL_FIELD `&0 < x ==> &1 / x - &1 / (&1 + x) = &1 / (x * (&1 + x))`;; + +REAL_FIELD +`s pow 2 = b pow 2 - &4 * a * c + ==> (a * x pow 2 + b * x + c = &0 <=> + if a = &0 then + if b = &0 then + if c = &0 then T else F + else x = --c / b + else x = (--b + s) / (&2 * a) \/ x = (--b + --s) / (&2 * a))`;; + +(**** This needs an external SDP solver to assist with proof + +needs "Examples/sos.ml";; + +SOS_RULE `1 <= x /\ 1 <= y ==> 1 <= x * y`;; + +REAL_SOS + `!a1 a2 a3 a4:real. + &0 <= a1 /\ &0 <= a2 /\ &0 <= a3 /\ &0 <= a4 + ==> a1 pow 2 + + ((a1 + a2) / &2) pow 2 + + ((a1 + a2 + a3) / &3) pow 2 + + ((a1 + a2 + a3 + a4) / &4) pow 2 + <= &4 * (a1 pow 2 + a2 pow 2 + a3 pow 2 + a4 pow 2)`;; + +REAL_SOS + `!a b c:real. + a >= &0 /\ b >= &0 /\ c >= &0 + ==> &3 / &2 * (b + c) * (a + c) * (a + b) <= + a * (a + c) * (a + b) + + b * (b + c) * (a + b) + + c * (b + c) * (a + c)`;; + +SOS_CONV `&2 * x pow 4 + &2 * x pow 3 * y - x pow 2 * y pow 2 + &5 * y pow 4`;; + +PURE_SOS +`x pow 4 + &2 * x pow 2 * z + x pow 2 - &2 * x * y * z + + &2 * y pow 2 * z pow 2 + &2 * y * z pow 2 + &2 * z pow 2 - &2 * x + + &2 * y * z + &1 >= &0`;; + +*****) + +needs "Examples/cooper.ml";; + +COOPER_RULE `ODD n ==> 2 * n DIV 2 < n`;; + +COOPER_RULE `!n. n >= 8 ==> ?a b. n = 3 * a + 5 * b`;; + +needs "Rqe/make.ml";; + +REAL_QELIM_CONV `!x. &0 <= x ==> ?y. y pow 2 = x`;; + +(* ========================================================================= *) +(* Inductive definitions *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Bug puzzle. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let move = new_definition + `move ((ax,ay),(bx,by),(cx,cy)) ((ax',ay'),(bx',by'),(cx',cy')) <=> + (?a. ax' = ax + a * (cx - bx) /\ ay' = ay + a * (cy - by) /\ + bx' = bx /\ by' = by /\ cx' = cx /\ cy' = cy) \/ + (?b. bx' = bx + b * (ax - cx) /\ by' = by + b * (ay - cy) /\ + ax' = ax /\ ay' = ay /\ cx' = cx /\ cy' = cy) \/ + (?c. ax' = ax /\ ay' = ay /\ bx' = bx /\ by' = by /\ + cx' = cx + c * (bx - ax) /\ cy' = cy + c * (by - ay))`;; + +let reachable_RULES,reachable_INDUCT,reachable_CASES = + new_inductive_definition + `(!p. reachable p p) /\ + (!p q r. move p q /\ reachable q r ==> reachable p r)`;; + +let oriented_area = new_definition + `oriented_area ((ax,ay),(bx,by),(cx,cy)) = + ((bx - ax) * (cy - ay) - (cx - ax) * (by - ay)) / &2`;; + +let MOVE_INVARIANT = prove + (`!p p'. move p p' ==> oriented_area p = oriented_area p'`, + REWRITE_TAC[FORALL_PAIR_THM; move; oriented_area] THEN CONV_TAC REAL_RING);; + +let REACHABLE_INVARIANT = prove + (`!p p'. reachable p p' ==> oriented_area p = oriented_area p'`, + MATCH_MP_TAC reachable_INDUCT THEN MESON_TAC[MOVE_INVARIANT]);; + +let IMPOSSIBILITY_B = prove + (`~(reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(&2,&5),(-- &2,&3)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((&1,&2),(-- &2,&3),(&2,&5)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(&1,&2),(-- &2,&3)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((&2,&5),(-- &2,&3),(&1,&2)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&1,&2),(&2,&5)) \/ + reachable ((&0,&0),(&3,&0),(&0,&3)) ((-- &2,&3),(&2,&5),(&1,&2)))`, + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP REACHABLE_INVARIANT) THEN + REWRITE_TAC[oriented_area] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Verification of a simple concurrent program. *) +(* ------------------------------------------------------------------------- *) + +let init = new_definition + `init (x,y,pc1,pc2,sem) <=> + pc1 = 10 /\ pc2 = 10 /\ x = 0 /\ y = 0 /\ sem = 1`;; + +let trans = new_definition + `trans (x,y,pc1,pc2,sem) (x',y',pc1',pc2',sem') <=> + pc1 = 10 /\ sem > 0 /\ pc1' = 20 /\ sem' = sem - 1 /\ + (x',y',pc2') = (x,y,pc2) \/ + pc2 = 10 /\ sem > 0 /\ pc2' = 20 /\ sem' = sem - 1 /\ + (x',y',pc1') = (x,y,pc1) \/ + pc1 = 20 /\ pc1' = 30 /\ x' = x + 1 /\ + (y',pc2',sem') = (y,pc2,sem) \/ + pc2 = 20 /\ pc2' = 30 /\ y' = y + 1 /\ x' = x /\ + pc1' = pc1 /\ sem' = sem \/ + pc1 = 30 /\ pc1' = 10 /\ sem' = sem + 1 /\ + (x',y',pc2') = (x,y,pc2) \/ + pc2 = 30 /\ pc2' = 10 /\ sem' = sem + 1 /\ + (x',y',pc1') = (x,y,pc1)`;; + +let mutex = new_definition + `mutex (x,y,pc1,pc2,sem) <=> pc1 = 10 \/ pc2 = 10`;; + +let indinv = new_definition + `indinv (x:num,y:num,pc1,pc2,sem) <=> + sem + (if pc1 = 10 then 0 else 1) + (if pc2 = 10 then 0 else 1) = 1`;; + +needs "Library/rstc.ml";; + +let INDUCTIVE_INVARIANT = prove + (`!init invariant transition P. + (!s. init s ==> invariant s) /\ + (!s s'. invariant s /\ transition s s' ==> invariant s') /\ + (!s. invariant s ==> P s) + ==> !s s':A. init s /\ RTC transition s s' ==> P s'`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`transition:A->A->bool`; + `\s s':A. invariant s ==> invariant s'`] RTC_INDUCT) THEN + MESON_TAC[]);; + +let MUTEX = prove + (`!s s'. init s /\ RTC trans s s' ==> mutex s'`, + MATCH_MP_TAC INDUCTIVE_INVARIANT THEN EXISTS_TAC `indinv` THEN + REWRITE_TAC[init; trans; indinv; mutex; FORALL_PAIR_THM; PAIR_EQ] THEN + ARITH_TAC);; + +(* ========================================================================= *) +(* Wellfounded induction *) +(* ========================================================================= *) + +let NSQRT_2 = prove + (`!p q. p * p = 2 * q * q ==> q = 0`, + MATCH_MP_TAC num_WF THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; ARITH] THEN REWRITE_TAC[EVEN_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`q:num`; `m:num`]) THEN + ASM_REWRITE_TAC[ARITH_RULE + `q < 2 * m ==> q * q = 2 * m * m ==> m = 0 <=> + (2 * m) * 2 * m = 2 * q * q ==> 2 * m <= q`] THEN + ASM_MESON_TAC[LE_MULT2; MULT_EQ_0; ARITH_RULE `2 * x <= x <=> x = 0`]);; + +(* ========================================================================= *) +(* Changing proof style *) +(* ========================================================================= *) + +let fix ts = MAP_EVERY X_GEN_TAC ts;; + +let assume lab t = + DISCH_THEN(fun th -> if concl th = t then LABEL_TAC lab th + else failwith "assume");; + +let we're finished tac = tac;; + +let suffices_to_prove q tac = SUBGOAL_THEN q (fun th -> MP_TAC th THEN tac);; + +let note(lab,t) tac = + SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN + DISCH_THEN(fun th -> LABEL_TAC lab th);; + +let have t = note("",t);; + +let cases (lab,t) tac = + SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (LABEL_TAC lab));; + +let consider (x,lab,t) tac = + let tm = mk_exists(x,t) in + SUBGOAL_THEN tm (X_CHOOSE_THEN x (LABEL_TAC lab)) THENL [tac; ALL_TAC];; + +let trivial = MESON_TAC[];; +let algebra = CONV_TAC NUM_RING;; +let arithmetic = ARITH_TAC;; + +let by labs tac = MAP_EVERY (fun l -> USE_THEN l MP_TAC) labs THEN tac;; + +let using ths tac = MAP_EVERY MP_TAC ths THEN tac;; + +let so constr arg tac = constr arg (FIRST_ASSUM MP_TAC THEN tac);; + +let NSQRT_2 = prove + (`!p q. p * p = 2 * q * q ==> q = 0`, + suffices_to_prove + `!p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) + ==> (!q. p * p = 2 * q * q ==> q = 0)` + (MATCH_ACCEPT_TAC num_WF) THEN + fix [`p:num`] THEN + assume("A") `!m. m < p ==> !q. m * m = 2 * q * q ==> q = 0` THEN + fix [`q:num`] THEN + assume("B") `p * p = 2 * q * q` THEN + so have `EVEN(p * p) <=> EVEN(2 * q * q)` (trivial) THEN + so have `EVEN(p)` (using [ARITH; EVEN_MULT] trivial) THEN + so consider (`m:num`,"C",`p = 2 * m`) (using [EVEN_EXISTS] trivial) THEN + cases ("D",`q < p \/ p <= q`) (arithmetic) THENL + [so have `q * q = 2 * m * m ==> m = 0` (by ["A"] trivial) THEN + so we're finished (by ["B"; "C"] algebra); + + so have `p * p <= q * q` (using [LE_MULT2] trivial) THEN + so have `q * q = 0` (by ["B"] arithmetic) THEN + so we're finished (algebra)]);; + +(* ========================================================================= *) +(* Recursive definitions *) +(* ========================================================================= *) + +let fib = define + `fib n = if n = 0 \/ n = 1 then 1 else fib(n - 1) + fib(n - 2)`;; + +let fib2 = define + `(fib2 0 = 1) /\ + (fib2 1 = 1) /\ + (fib2 (n + 2) = fib2(n) + fib2(n + 1))`;; + +let halve = define `halve (2 * n) = n`;; + +let unknown = define `unknown n = unknown(n + 1)`;; + +define + `!n. collatz(n) = if n <= 1 then n + else if EVEN(n) then collatz(n DIV 2) + else collatz(3 * n + 1)`;; + +let fusc_def = define + `(fusc (2 * n) = if n = 0 then 0 else fusc(n)) /\ + (fusc (2 * n + 1) = if n = 0 then 1 else fusc(n) + fusc(n + 1))`;; + +let fusc = prove + (`fusc 0 = 0 /\ + fusc 1 = 1 /\ + fusc (2 * n) = fusc(n) /\ + fusc (2 * n + 1) = fusc(n) + fusc(n + 1)`, + REWRITE_TAC[fusc_def] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(INST [`0`,`n:num`] fusc_def) THEN ARITH_TAC);; + +let binom = define + `(!n. binom(n,0) = 1) /\ + (!k. binom(0,SUC(k)) = 0) /\ + (!n k. binom(SUC(n),SUC(k)) = binom(n,SUC(k)) + binom(n,k))`;; + +let BINOM_LT = prove + (`!n k. n < k ==> (binom(n,k) = 0)`, + INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC[binom; ARITH; LT_SUC; LT] THEN + ASM_SIMP_TAC[ARITH_RULE `n < k ==> n < SUC(k)`; ARITH]);; + +let BINOM_REFL = prove + (`!n. binom(n,n) = 1`, + INDUCT_TAC THEN ASM_SIMP_TAC[binom; BINOM_LT; LT; ARITH]);; + +let BINOM_FACT = prove + (`!n k. FACT n * FACT k * binom(n+k,k) = FACT(n + k)`, + INDUCT_TAC THEN REWRITE_TAC[FACT; ADD_CLAUSES; MULT_CLAUSES; BINOM_REFL] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; FACT; MULT_CLAUSES; binom] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC k`) THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[ADD_CLAUSES; FACT; binom] THEN CONV_TAC NUM_RING);; + +let BINOMIAL_THEOREM = prove + (`!n. (x + y) EXP n = nsum(0..n) (\k. binom(n,k) * x EXP k * y EXP (n - k))`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP] THEN + REWRITE_TAC[NSUM_SING_NUMSEG; binom; SUB_REFL; EXP; MULT_CLAUSES] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; ADD1; ARITH_RULE `0 <= n + 1`; NSUM_OFFSET] THEN + ASM_REWRITE_TAC[EXP; binom; GSYM ADD1; GSYM NSUM_LMUL] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; NSUM_ADD_NUMSEG; MULT_CLAUSES; SUB_0] THEN + MATCH_MP_TAC(ARITH_RULE `a = e /\ b = c + d ==> a + b = c + d + e`) THEN + CONJ_TAC THENL [REWRITE_TAC[MULT_AC; SUB_SUC]; REWRITE_TAC[GSYM EXP]] THEN + SIMP_TAC[ADD1; SYM(REWRITE_CONV[NSUM_OFFSET]`nsum(m+1..n+1) (\i. f i)`)] THEN + REWRITE_TAC[NSUM_CLAUSES_NUMSEG; GSYM ADD1; LE_SUC; LE_0] THEN + SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0] THEN + SIMP_TAC[BINOM_LT; LT; MULT_CLAUSES; ADD_CLAUSES; SUB_0; EXP; binom] THEN + SIMP_TAC[ARITH; ARITH_RULE `k <= n ==> SUC n - k = SUC(n - k)`; EXP] THEN + REWRITE_TAC[MULT_AC]);; + +(* ========================================================================= *) +(* Sets and functions *) +(* ========================================================================= *) + +let SURJECTIVE_IFF_RIGHT_INVERSE = prove + (`(!y. ?x. g x = y) <=> (?f. g o f = I)`, + REWRITE_TAC[FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; + +let INJECTIVE_IFF_LEFT_INVERSE = prove + (`(!x y. f x = f y ==> x = y) <=> (?g. g o f = I)`, + let lemma = MESON[] + `(!x x'. f x = f x' ==> x = x') <=> (!y:B. ?u:A. !x. f x = y ==> u = x)` in + REWRITE_TAC[lemma; FUN_EQ_THM; o_DEF; I_DEF] THEN MESON_TAC[]);; + +let cantor = new_definition + `cantor(x,y) = ((x + y) EXP 2 + 3 * x + y) DIV 2`;; + +(**** Needs external SDP solver + +needs "Examples/sos.ml";; + +let CANTOR_LEMMA = prove + (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, + REWRITE_TAC[cantor] THEN CONV_TAC SOS_RULE);; + +****) + +let CANTOR_LEMMA_LEMMA = prove + (`x + y < x' + y' ==> cantor(x,y) < cantor(x',y')`, + REWRITE_TAC[ARITH_RULE `x + y < z <=> x + y + 1 <= z`] THEN DISCH_TAC THEN + REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN + MATCH_MP_TAC(ARITH_RULE `x + 2 <= y ==> x DIV 2 < y DIV 2`) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `(x + y + 1) EXP 2 + (x + y + 1)` THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(ARITH_RULE `a:num <= b /\ c <= d ==> a + c <= b + d + e`) THEN + ASM_SIMP_TAC[EXP_2; LE_MULT2]);; + +let CANTOR_LEMMA = prove + (`cantor(x,y) = cantor(x',y') ==> x + y = x' + y'`, + MESON_TAC[LT_CASES; LT_REFL; CANTOR_LEMMA_LEMMA]);; + +let CANTOR_INJ = prove + (`!w z. cantor w = cantor z ==> w = z`, + REWRITE_TAC[FORALL_PAIR_THM; PAIR_EQ] THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> MP_TAC th THEN ASSUME_TAC(MATCH_MP CANTOR_LEMMA th)) THEN + ASM_REWRITE_TAC[cantor; ARITH_RULE `3 * x + y = (x + y) + 2 * x`] THEN + REWRITE_TAC[ARITH_RULE `(a + b + 2 * x) DIV 2 = (a + b) DIV 2 + x`] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let CANTOR_THM = prove + (`~(?f:(A->bool)->A. (!x y. f(x) = f(y) ==> x = y))`, + REWRITE_TAC[INJECTIVE_IFF_LEFT_INVERSE; FUN_EQ_THM; I_DEF; o_DEF] THEN + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o SPEC `\x:A. ~(g x x)`) THEN + MESON_TAC[]);; + +(* ========================================================================= *) +(* Inductive datatypes *) +(* ========================================================================= *) + +let line_INDUCT,line_RECURSION = define_type + "line = Line_1 | Line_2 | Line_3 | Line_4 | + Line_5 | Line_6 | Line_7";; + +let point_INDUCT,point_RECURSION = define_type + "point = Point_1 | Point_2 | Point_3 | Point_4 | + Point_5 | Point_6 | Point_7";; + +let fano_incidence = + [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; + 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; + +let fano_point i = mk_const("Point_"^string_of_int i,[]);; +let fano_line i = mk_const("Line_"^string_of_int i,[]);; +let p = `p:point` and l = `l:line` ;; + +let fano_clause (i,j) = mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; + +parse_as_infix("ON",(11,"right"));; + +let ON = new_definition + (mk_eq(`((ON):point->line->bool) p l`, + list_mk_disj(map fano_clause fano_incidence)));; + +let ON_CLAUSES = prove + (list_mk_conj(allpairs + (fun i j -> mk_eq(mk_comb(mk_comb(`(ON)`,fano_point i),fano_line j), + if mem (i,j) fano_incidence then `T` else `F`)) + (1--7) (1--7)), + REWRITE_TAC[ON; distinctness "line"; distinctness "point"]);; + +let FORALL_POINT = prove + (`(!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ + P Point_5 /\ P Point_6 /\ P Point_7`, + EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[point_INDUCT]]);; + +let FORALL_LINE = prove + (`(!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ + P Line_5 /\ P Line_6 /\ P Line_7`, + EQ_TAC THENL [SIMP_TAC[]; REWRITE_TAC[line_INDUCT]]);; + +let EXISTS_POINT = prove + (`(?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ + P Point_5 \/ P Point_6 \/ P Point_7`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_POINT]);; + +let EXISTS_LINE = prove + (`(?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ + P Line_5 \/ P Line_6 \/ P Line_7`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_LINE]);; + +let FANO_TAC = + GEN_REWRITE_TAC DEPTH_CONV + [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN + GEN_REWRITE_TAC DEPTH_CONV + (basic_rewrites() @ + [ON_CLAUSES; distinctness "point"; distinctness "line"]);; + +let FANO_RULE tm = prove(tm,FANO_TAC);; + +let AXIOM_1 = FANO_RULE +`!p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ + !l'. p ON l' /\ p' ON l' ==> l' = l`;; + +let AXIOM_2 = FANO_RULE + `!l l'. ?p. p ON l /\ p ON l'`;; + +let AXIOM_3 = FANO_RULE + `?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l)`;; + +let AXIOM_4 = FANO_RULE + `!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l`;; + +(* ========================================================================= *) +(* Semantics of programming languages *) +(* ========================================================================= *) + +let string_INDUCT,string_RECURSION = + define_type "string = String (int list)";; + +let expression_INDUCT,expression_RECURSION = define_type +"expression = Literal num + | Variable string + | Plus expression expression + | Times expression expression";; + +let command_INDUCT,command_RECURSION = define_type + "command = Assign string expression + | Sequence command command + | If expression command command + | While expression command";; + +parse_as_infix(";;",(18,"right"));; +parse_as_infix(":=",(20,"right"));; +override_interface(";;",`Sequence`);; +override_interface(":=",`Assign`);; +overload_interface("+",`Plus`);; +overload_interface("*",`Times`);; + +let value = define + `(value (Literal n) s = n) /\ + (value (Variable x) s = s(x)) /\ + (value (e1 + e2) s = value e1 s + value e2 s) /\ + (value (e1 * e2) s = value e1 s * value e2 s)`;; + +let sem_RULES,sem_INDUCT,sem_CASES = new_inductive_definition + `(!x e s s'. s'(x) = value e s /\ (!y. ~(y = x) ==> s'(y) = s(y)) + ==> sem (x := e) s s') /\ + (!c1 c2 s s' s''. sem(c1) s s' /\ sem(c2) s' s'' ==> sem(c1 ;; c2) s s'') /\ + (!e c1 c2 s s'. ~(value e s = 0) /\ sem(c1) s s' ==> sem(If e c1 c2) s s') /\ + (!e c1 c2 s s'. value e s = 0 /\ sem(c2) s s' ==> sem(If e c1 c2) s s') /\ + (!e c s. value e s = 0 ==> sem(While e c) s s) /\ + (!e c s s' s''. ~(value e s = 0) /\ sem(c) s s' /\ sem(While e c) s' s'' + ==> sem(While e c) s s'')`;; + +(**** Fails + define + `sem(While e c) s s' <=> if value e s = 0 then (s' = s) + else ?s''. sem c s s'' /\ sem(While e c) s'' s'`;; +****) + +let DETERMINISM = prove + (`!c s s' s''. sem c s s' /\ sem c s s'' ==> (s' = s'')`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC sem_INDUCT THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[sem_CASES] THEN + REWRITE_TAC[distinctness "command"; injectivity "command"] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]);; + +let wlp = new_definition + `wlp c q s <=> !s'. sem c s s' ==> q s'`;; + +let terminates = new_definition + `terminates c s <=> ?s'. sem c s s'`;; + +let wp = new_definition + `wp c q s <=> terminates c s /\ wlp c q s`;; + +let WP_TOTAL = prove + (`!c. (wp c EMPTY = EMPTY)`, + REWRITE_TAC[FUN_EQ_THM; wp; wlp; terminates; EMPTY] THEN MESON_TAC[]);; + +let WP_MONOTONIC = prove + (`q SUBSET r ==> wp c q SUBSET wp c r`, + REWRITE_TAC[SUBSET; IN; wp; wlp; terminates] THEN MESON_TAC[]);; + +let WP_DISJUNCTIVE = prove + (`(wp c p) UNION (wp c q) = wp c (p UNION q)`, + REWRITE_TAC[FUN_EQ_THM; IN; wp; wlp; IN_ELIM_THM; UNION; terminates] THEN + MESON_TAC[DETERMINISM]);; + +let WP_SEQ = prove + (`!c1 c2 q. wp (c1 ;; c2) = wp c1 o wp c2`, + REWRITE_TAC[wp; wlp; terminates; FUN_EQ_THM; o_THM] THEN REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [sem_CASES] THEN + REWRITE_TAC[injectivity "command"; distinctness "command"] THEN + MESON_TAC[DETERMINISM]);; + +let correct = new_definition + `correct p c q <=> p SUBSET (wp c q)`;; + +let CORRECT_PRESTRENGTH = prove + (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, + REWRITE_TAC[correct; SUBSET_TRANS]);; + +let CORRECT_POSTWEAK = prove + (`!p c q q'. correct p c q' /\ q' SUBSET q ==> correct p c q`, + REWRITE_TAC[correct] THEN MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; + +let CORRECT_SEQ = prove + (`!p q r c1 c2. + correct p c1 r /\ correct r c2 q ==> correct p (c1 ;; c2) q`, + REWRITE_TAC[correct; WP_SEQ; o_THM] THEN + MESON_TAC[WP_MONOTONIC; SUBSET_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Need a fresh HOL session here; now doing shallow embedding. *) +(* ------------------------------------------------------------------------- *) + +let assign = new_definition + `Assign (f:S->S) (q:S->bool) = q o f`;; + +parse_as_infix(";;",(18,"right"));; + +let sequence = new_definition + `(c1:(S->bool)->(S->bool)) ;; (c2:(S->bool)->(S->bool)) = c1 o c2`;; + +let if_def = new_definition + `If e (c:(S->bool)->(S->bool)) q = {s | if e s then c q s else q s}`;; + +let ite_def = new_definition + `Ite e (c1:(S->bool)->(S->bool)) c2 q = + {s | if e s then c1 q s else c2 q s}`;; + +let while_RULES,while_INDUCT,while_CASES = new_inductive_definition + `!q s. If e (c ;; while e c) q s ==> while e c q s`;; + +let while_def = new_definition + `While e c q = + {s | !w. (!s:S. (if e(s) then c w s else q s) ==> w s) ==> w s}`;; + +let monotonic = new_definition + `monotonic c <=> !q q'. q SUBSET q' ==> (c q) SUBSET (c q')`;; + +let MONOTONIC_ASSIGN = prove + (`monotonic (Assign f)`, + SIMP_TAC[monotonic; assign; SUBSET; o_THM; IN]);; + +let MONOTONIC_IF = prove + (`monotonic c ==> monotonic (If e c)`, + REWRITE_TAC[monotonic; if_def] THEN SET_TAC[]);; + +let MONOTONIC_ITE = prove + (`monotonic c1 /\ monotonic c2 ==> monotonic (Ite e c1 c2)`, + REWRITE_TAC[monotonic; ite_def] THEN SET_TAC[]);; + +let MONOTONIC_SEQ = prove + (`monotonic c1 /\ monotonic c2 ==> monotonic (c1 ;; c2)`, + REWRITE_TAC[monotonic; sequence; o_THM] THEN SET_TAC[]);; + +let MONOTONIC_WHILE = prove + (`monotonic c ==> monotonic(While e c)`, + REWRITE_TAC[monotonic; while_def] THEN SET_TAC[]);; + +let WHILE_THM = prove + (`!e c q:S->bool. + monotonic c + ==> (!s. If e (c ;; While e c) q s ==> While e c q s) /\ + (!w'. (!s. If e (c ;; (\q. w')) q s ==> w' s) + ==> (!a. While e c q a ==> w' a)) /\ + (!s. While e c q s <=> If e (c ;; While e c) q s)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + (MP_TAC o GEN_ALL o DISCH_ALL o derive_nonschematic_inductive_relations) + `!s:S. (if e s then c w s else q s) ==> w s` THEN + REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM; IMP_IMP] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[FUN_EQ_THM; while_def; IN_ELIM_THM] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[monotonic] THEN SET_TAC[]);; + +let WHILE_FIX = prove + (`!e c. monotonic c ==> (While e c = If e (c ;; While e c))`, + REWRITE_TAC[FUN_EQ_THM] THEN MESON_TAC[WHILE_THM]);; + +let correct = new_definition + `correct p c q <=> p SUBSET (c q)`;; + +let CORRECT_PRESTRENGTH = prove + (`!p p' c q. p SUBSET p' /\ correct p' c q ==> correct p c q`, + REWRITE_TAC[correct; SUBSET_TRANS]);; + +let CORRECT_POSTWEAK = prove + (`!p c q q'. monotonic c /\ correct p c q' /\ q' SUBSET q ==> correct p c q`, + REWRITE_TAC[correct; monotonic] THEN SET_TAC[]);; + +let CORRECT_ASSIGN = prove + (`!p f q. (p SUBSET (q o f)) ==> correct p (Assign f) q`, + REWRITE_TAC[correct; assign]);; + +let CORRECT_SEQ = prove + (`!p q r c1 c2. + monotonic c1 /\ correct p c1 r /\ correct r c2 q + ==> correct p (c1 ;; c2) q`, + REWRITE_TAC[correct; sequence; monotonic; o_THM] THEN SET_TAC[]);; + +let CORRECT_ITE = prove + (`!p e c1 c2 q. + correct (p INTER e) c1 q /\ correct (p INTER (UNIV DIFF e)) c2 q + ==> correct p (Ite e c1 c2) q`, + REWRITE_TAC[correct; ite_def] THEN SET_TAC[]);; + +let CORRECT_IF = prove + (`!p e c q. + correct (p INTER e) c q /\ p INTER (UNIV DIFF e) SUBSET q + ==> correct p (If e c) q`, + REWRITE_TAC[correct; if_def] THEN SET_TAC[]);; + +let CORRECT_WHILE = prove + (`!(<<) p c q e invariant. + monotonic c /\ + WF(<<) /\ + p SUBSET invariant /\ + (UNIV DIFF e) INTER invariant SUBSET q /\ + (!X:S. correct (invariant INTER e INTER (\s. X = s)) c + (invariant INTER (\s. s << X))) + ==> correct p (While e c) q`, + REWRITE_TAC[correct; SUBSET; IN_INTER; IN_UNIV; IN_DIFF; IN] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!s:S. invariant s ==> While e c q s` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[WF_IND]) THEN + X_GEN_TAC `s:S` THEN REPEAT DISCH_TAC THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP WHILE_FIX th]) THEN + REWRITE_TAC[if_def; sequence; o_THM; IN_ELIM_THM] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:S`; `s:S`]) THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [monotonic]) THEN + REWRITE_TAC[SUBSET; IN; RIGHT_IMP_FORALL_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[INTER; IN_ELIM_THM; IN]);; + +let assert_def = new_definition + `assert (p:S->bool) (q:S->bool) = q`;; + +let variant_def = new_definition + `variant ((<<):S->S->bool) (q:S->bool) = q`;; + +let CORRECT_SEQ_VC = prove + (`!p q r c1 c2. + monotonic c1 /\ correct p c1 r /\ correct r c2 q + ==> correct p (c1 ;; assert r ;; c2) q`, + REWRITE_TAC[correct; sequence; monotonic; assert_def; o_THM] THEN SET_TAC[]);; + +let CORRECT_WHILE_VC = prove + (`!(<<) p c q e invariant. + monotonic c /\ + WF(<<) /\ + p SUBSET invariant /\ + (UNIV DIFF e) INTER invariant SUBSET q /\ + (!X:S. correct (invariant INTER e INTER (\s. X = s)) c + (invariant INTER (\s. s << X))) + ==> correct p (While e (assert invariant ;; variant(<<) ;; c)) q`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[sequence; variant_def; assert_def; o_DEF; ETA_AX] THEN + ASM_MESON_TAC[CORRECT_WHILE]);; + +let MONOTONIC_ASSERT = prove + (`monotonic (assert p)`, + REWRITE_TAC[assert_def; monotonic]);; + +let MONOTONIC_VARIANT = prove + (`monotonic (variant p)`, + REWRITE_TAC[variant_def; monotonic]);; + +let MONO_TAC = + REPEAT(MATCH_MP_TAC MONOTONIC_WHILE ORELSE + (MAP_FIRST MATCH_MP_TAC + [MONOTONIC_SEQ; MONOTONIC_IF; MONOTONIC_ITE] THEN CONJ_TAC)) THEN + MAP_FIRST MATCH_ACCEPT_TAC + [MONOTONIC_ASSIGN; MONOTONIC_ASSERT; MONOTONIC_VARIANT];; + +let VC_TAC = + FIRST + [MATCH_MP_TAC CORRECT_SEQ_VC THEN CONJ_TAC THENL [MONO_TAC; CONJ_TAC]; + MATCH_MP_TAC CORRECT_ITE THEN CONJ_TAC; + MATCH_MP_TAC CORRECT_IF THEN CONJ_TAC; + MATCH_MP_TAC CORRECT_WHILE_VC THEN REPEAT CONJ_TAC THENL + [MONO_TAC; TRY(MATCH_ACCEPT_TAC WF_MEASURE); ALL_TAC; ALL_TAC; + REWRITE_TAC[FORALL_PAIR_THM; MEASURE] THEN REPEAT GEN_TAC]; + MATCH_MP_TAC CORRECT_ASSIGN];; + +needs "Library/prime.ml";; + +(* ------------------------------------------------------------------------- *) +(* x = m, y = n; *) +(* while (!(x == 0 || y == 0)) *) +(* { if (x < y) y = y - x; *) +(* else x = x - y; *) +(* } *) +(* if (x == 0) x = y; *) +(* ------------------------------------------------------------------------- *) + +g `correct + (\(m,n,x,y). T) + (Assign (\(m,n,x,y). m,n,m,n) ;; // x,y := m,n + assert (\(m,n,x,y). x = m /\ y = n) ;; + While (\(m,n,x,y). ~(x = 0 \/ y = 0)) + (assert (\(m,n,x,y). gcd(x,y) = gcd(m,n)) ;; + variant(MEASURE(\(m,n,x,y). x + y)) ;; + Ite (\(m,n,x,y). x < y) + (Assign (\(m,n,x,y). m,n,x,y - x)) + (Assign (\(m,n,x,y). m,n,x - y,y))) ;; + assert (\(m,n,x,y). (x = 0 \/ y = 0) /\ gcd(x,y) = gcd(m,n)) ;; + If (\(m,n,x,y). x = 0) (Assign (\(m,n,x,y). (m,n,y,y)))) + (\(m,n,x,y). gcd(m,n) = x)`;; + +e(REPEAT VC_TAC);; + +b();; +e(REPEAT VC_TAC THEN REWRITE_TAC[SUBSET; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:num`; `y:num`] THEN + REWRITE_TAC[IN; INTER; UNIV; DIFF; o_DEF; IN_ELIM_THM; PAIR_EQ] THEN + CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN SIMP_TAC[]);; + +e(SIMP_TAC[GCD_SUB; LT_IMP_LE]);; +e ARITH_TAC;; + +e(SIMP_TAC[GCD_SUB; NOT_LT] THEN ARITH_TAC);; + +e(MESON_TAC[GCD_0]);; + +e(MESON_TAC[GCD_0; GCD_SYM]);; + +parse_as_infix("refines",(12,"right"));; + +let refines = new_definition + `c2 refines c1 <=> !q. c1(q) SUBSET c2(q)`;; + +let REFINES_REFL = prove + (`!c. c refines c`, + REWRITE_TAC[refines; SUBSET_REFL]);; + +let REFINES_TRANS = prove + (`!c1 c2 c3. c3 refines c2 /\ c2 refines c1 ==> c3 refines c1`, + REWRITE_TAC[refines] THEN MESON_TAC[SUBSET_TRANS]);; + +let REFINES_CORRECT = prove + (`correct p c1 q /\ c2 refines c1 ==> correct p c2 q`, + REWRITE_TAC[correct; refines] THEN MESON_TAC[SUBSET_TRANS]);; + +let REFINES_WHILE = prove + (`c' refines c ==> While e c' refines While e c`, + REWRITE_TAC[refines; while_def; SUBSET; IN_ELIM_THM; IN] THEN MESON_TAC[]);; + +let specification = new_definition + `specification(p,q) r = if q SUBSET r then p else {}`;; + +let REFINES_SPECIFICATION = prove + (`c refines specification(p,q) ==> correct p c q`, + REWRITE_TAC[specification; correct; refines] THEN + MESON_TAC[SUBSET_REFL; SUBSET_EMPTY]);; + +(* ========================================================================= *) +(* Number theory *) +(* ========================================================================= *) + +needs "Library/prime.ml";; +needs "Library/pocklington.ml";; +needs "Library/binomial.ml";; + +prioritize_num();; + +let FERMAT_PRIME_CONV n = + let tm = subst [mk_small_numeral n,`x:num`] `prime(2 EXP (2 EXP x) + 1)` in + (RAND_CONV NUM_REDUCE_CONV THENC PRIME_CONV) tm;; + +FERMAT_PRIME_CONV 0;; +FERMAT_PRIME_CONV 1;; +FERMAT_PRIME_CONV 2;; +FERMAT_PRIME_CONV 3;; +FERMAT_PRIME_CONV 4;; +FERMAT_PRIME_CONV 5;; +FERMAT_PRIME_CONV 6;; +FERMAT_PRIME_CONV 7;; +FERMAT_PRIME_CONV 8;; + +let CONG_TRIVIAL = prove + (`!x y. n divides x /\ n divides y ==> (x == y) (mod n)`, + MESON_TAC[CONG_0; CONG_SYM; CONG_TRANS]);; + +let LITTLE_CHECK_CONV tm = + EQT_ELIM((RATOR_CONV(LAND_CONV NUM_EXP_CONV) THENC CONG_CONV) tm);; + +LITTLE_CHECK_CONV `(9 EXP 8 == 9) (mod 3)`;; +LITTLE_CHECK_CONV `(9 EXP 3 == 9) (mod 3)`;; +LITTLE_CHECK_CONV `(10 EXP 7 == 10) (mod 7)`;; +LITTLE_CHECK_CONV `(2 EXP 7 == 2) (mod 7)`;; +LITTLE_CHECK_CONV `(777 EXP 13 == 777) (mod 13)`;; + +let DIVIDES_FACT_PRIME = prove + (`!p. prime p ==> !n. p divides (FACT n) <=> p <= n`, + GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN REWRITE_TAC[FACT; LE] THENL + [ASM_MESON_TAC[DIVIDES_ONE; PRIME_0; PRIME_1]; + ASM_MESON_TAC[PRIME_DIVPROD_EQ; DIVIDES_LE; NOT_SUC; DIVIDES_REFL; + ARITH_RULE `~(p <= n) /\ p <= SUC n ==> p = SUC n`]]);; + +let DIVIDES_BINOM_PRIME = prove + (`!n p. prime p /\ 0 < n /\ n < p ==> p divides binom(p,n)`, + REPEAT STRIP_TAC THEN + MP_TAC(AP_TERM `(divides) p` (SPECL [`p - n`; `n:num`] BINOM_FACT)) THEN + ASM_SIMP_TAC[DIVIDES_FACT_PRIME; PRIME_DIVPROD_EQ; SUB_ADD; LT_IMP_LE] THEN + ASM_REWRITE_TAC[GSYM NOT_LT; LT_REFL] THEN + ASM_SIMP_TAC[ARITH_RULE `0 < n /\ n < p ==> p - n < p`]);; + +let DIVIDES_NSUM = prove + (`!m n. (!i. m <= i /\ i <= n ==> p divides f(i)) ==> p divides nsum(m..n) f`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN + ASM_MESON_TAC[LE; LE_TRANS; DIVIDES_0; DIVIDES_ADD; LE_REFL]);; + +let FLT_LEMMA = prove + (`!p a b. prime p ==> ((a + b) EXP p == a EXP p + b EXP p) (mod p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[BINOMIAL_THEOREM] THEN + SUBGOAL_THEN `1 <= p /\ 0 < p` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_IMP_NZ) THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[NSUM_CLAUSES_LEFT; LE_0; ARITH; NSUM_CLAUSES_RIGHT] THEN + REWRITE_TAC[SUB_0; SUB_REFL; EXP; binom; BINOM_REFL; MULT_CLAUSES] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a + b = (b + 0) + a`] THEN + REPEAT(MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL]) THEN + REWRITE_TAC[CONG_0] THEN MATCH_MP_TAC DIVIDES_NSUM THEN + ASM_MESON_TAC[DIVIDES_RMUL; DIVIDES_BINOM_PRIME; ARITH_RULE + `0 < p /\ 1 <= i /\ i <= p - 1 ==> 0 < i /\ i < p`]);; + +let FERMAT_LITTLE = prove + (`!p a. prime p ==> (a EXP p == a) (mod p)`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THENL + [ASM_MESON_TAC[EXP_EQ_0; CONG_REFL; PRIME_0]; + ASM_MESON_TAC[ADD1; FLT_LEMMA; EXP_ONE; CONG_ADD; CONG_TRANS; CONG_REFL]]);; + +let FERMAT_LITTLE_COPRIME = prove + (`!p a. prime p /\ coprime(a,p) ==> (a EXP (p - 1) == 1) (mod p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_MULT_LCANCEL THEN + EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[GSYM(CONJUNCT2 EXP)] THEN + ASM_SIMP_TAC[PRIME_IMP_NZ; ARITH_RULE `~(p = 0) ==> SUC(p - 1) = p`] THEN + ASM_SIMP_TAC[FERMAT_LITTLE; MULT_CLAUSES]);; + +let FERMAT_LITTLE_VARIANT = prove + (`!p a. prime p ==> (a EXP (1 + m * (p - 1)) == a) (mod p)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(DISJ_CASES_TAC o SPEC `a:num` o MATCH_MP PRIME_COPRIME_STRONG) + THENL [ASM_MESON_TAC[CONG_TRIVIAL; ADD_AC; ADD1; DIVIDES_REXP_SUC]; + ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [ARITH_RULE `a = a * 1`] THEN + REWRITE_TAC[EXP_ADD; EXP_1] THEN MATCH_MP_TAC CONG_MULT THEN + REWRITE_TAC[GSYM EXP_EXP; CONG_REFL] THEN + ASM_MESON_TAC[COPRIME_SYM; COPRIME_EXP; PHI_PRIME; FERMAT_LITTLE_COPRIME]);; + +let RSA = prove + (`prime p /\ prime q /\ ~(p = q) /\ + (d * e == 1) (mod ((p - 1) * (q - 1))) /\ + plaintext < p * q /\ (ciphertext = (plaintext EXP e) MOD (p * q)) + ==> (plaintext = (ciphertext EXP d) MOD (p * q))`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[MOD_EXP_MOD; MULT_EQ_0; PRIME_IMP_NZ; EXP_EXP] THEN + SUBGOAL_THEN `(plaintext == plaintext EXP (e * d)) (mod (p * q))` MP_TAC THENL + [ALL_TAC; ASM_SIMP_TAC[CONG; MULT_EQ_0; PRIME_IMP_NZ; MOD_LT]] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o GEN_REWRITE_RULE I [CONG_TO_1]) THENL + [ASM_MESON_TAC[MULT_EQ_1; ARITH_RULE `p - 1 = 1 <=> p = 2`]; ALL_TAC] THEN + MATCH_MP_TAC CONG_CHINESE THEN ASM_SIMP_TAC[DISTINCT_PRIME_COPRIME] THEN + ASM_MESON_TAC[FERMAT_LITTLE_VARIANT; MULT_AC; CONG_SYM]);; + +(* ========================================================================= *) +(* Real analysis *) +(* ========================================================================= *) + +needs "Library/analysis.ml";; +needs "Library/transc.ml";; + +let cheb = define + `(!x. cheb 0 x = &1) /\ + (!x. cheb 1 x = x) /\ + (!n x. cheb (n + 2) x = &2 * x * cheb (n + 1) x - cheb n x)`;; + +let CHEB_INDUCT = prove + (`!P. P 0 /\ P 1 /\ (!n. P n /\ P(n + 1) ==> P(n + 2)) ==> !n. P n`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. P n /\ P(n + 1)` (fun th -> MESON_TAC[th]) THEN + INDUCT_TAC THEN ASM_SIMP_TAC[ADD1; GSYM ADD_ASSOC] THEN + ASM_SIMP_TAC[ARITH]);; + +let CHEB_COS = prove + (`!n x. cheb n (cos x) = cos(&n * x)`, + MATCH_MP_TAC CHEB_INDUCT THEN + REWRITE_TAC[cheb; REAL_MUL_LZERO; REAL_MUL_LID; COS_0] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_MUL_LID; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[COS_ADD; COS_DOUBLE; SIN_DOUBLE] THEN + MP_TAC(SPEC `x:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING);; + +let CHEB_RIPPLE = prove + (`!x. abs(x) <= &1 ==> abs(cheb n x) <= &1`, + REWRITE_TAC[GSYM REAL_BOUNDS_LE] THEN + MESON_TAC[CHEB_COS; ACS_COS; COS_BOUNDS]);; + +let NUM_ADD2_CONV = + let add_tm = `(+):num->num->num` + and two_tm = `2` in + fun tm -> + let m = mk_numeral(dest_numeral tm -/ Int 2) in + let tm' = mk_comb(mk_comb(add_tm,m),two_tm) in + SYM(NUM_ADD_CONV tm');; + +let CHEB_CONV = + let [pth0;pth1;pth2] = CONJUNCTS cheb in + let rec conv tm = + (GEN_REWRITE_CONV I [pth0; pth1] ORELSEC + (LAND_CONV NUM_ADD2_CONV THENC + GEN_REWRITE_CONV I [pth2] THENC + COMB2_CONV + (funpow 3 RAND_CONV ((LAND_CONV NUM_ADD_CONV) THENC conv)) + conv THENC + REAL_POLY_CONV)) tm in + conv;; + +CHEB_CONV `cheb 8 x`;; + +let CHEB_2N1 = prove + (`!n x. ((x - &1) * (cheb (2 * n + 1) x - &1) = + (cheb (n + 1) x - cheb n x) pow 2) /\ + (&2 * (x pow 2 - &1) * (cheb (2 * n + 2) x - &1) = + (cheb (n + 2) x - cheb n x) pow 2)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + MATCH_MP_TAC CHEB_INDUCT THEN REWRITE_TAC[ARITH; cheb; CHEB_2; CHEB_3] THEN + REPEAT(CHANGED_TAC + (REWRITE_TAC[GSYM ADD_ASSOC; LEFT_ADD_DISTRIB; ARITH] THEN + REWRITE_TAC[ARITH_RULE `n + 5 = (n + 3) + 2`; + ARITH_RULE `n + 4 = (n + 2) + 2`; + ARITH_RULE `n + 3 = (n + 1) + 2`; + + cheb])) THEN + CONV_TAC REAL_RING);; + +let IVT_LEMMA1 = prove + (`!f. (!x. f contl x) + ==> !x y. f(x) <= &0 /\ &0 <= f(y) ==> ?x. f(x) = &0`, + ASM_MESON_TAC[IVT; IVT2; REAL_LE_TOTAL]);; + +let IVT_LEMMA2 = prove + (`!f. (!x. f contl x) /\ (?x. f(x) <= x) /\ (?y. y <= f(y)) ==> ?x. f(x) = x`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `\x. f x - x` IVT_LEMMA1) THEN + ASM_SIMP_TAC[CONT_SUB; CONT_X] THEN + SIMP_TAC[REAL_LE_SUB_LADD; REAL_LE_SUB_RADD; REAL_SUB_0; REAL_ADD_LID] THEN + ASM_MESON_TAC[]);; + +let SARKOVSKII_TRIVIAL = prove + (`!f:real->real. (!x. f contl x) /\ (?x. f(f(f(x))) = x) ==> ?x. f(x) = x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC IVT_LEMMA2 THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THEN MATCH_MP_TAC + (MESON[] `P x \/ P (f x) \/ P (f(f x)) ==> ?x:real. P x`) THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* Embedding of logics *) +(* ========================================================================= *) + +let string_INDUCT,string_RECURSION = define_type + "string = String num";; + +parse_as_infix("&&",(16,"right"));; +parse_as_infix("||",(15,"right"));; +parse_as_infix("-->",(14,"right"));; +parse_as_infix("<->",(13,"right"));; + +parse_as_prefix "Not";; +parse_as_prefix "Box";; +parse_as_prefix "Diamond";; + +let form_INDUCT,form_RECURSION = define_type + "form = False + | True + | Atom string + | Not form + | && form form + | || form form + | --> form form + | <-> form form + | Box form + | Diamond form";; + +let holds = define + `(holds (W,R) V False w <=> F) /\ + (holds (W,R) V True w <=> T) /\ + (holds (W,R) V (Atom a) w <=> V a w) /\ + (holds (W,R) V (Not p) w <=> ~(holds (W,R) V p w)) /\ + (holds (W,R) V (p && q) w <=> holds (W,R) V p w /\ holds (W,R) V q w) /\ + (holds (W,R) V (p || q) w <=> holds (W,R) V p w \/ holds (W,R) V q w) /\ + (holds (W,R) V (p --> q) w <=> holds (W,R) V p w ==> holds (W,R) V q w) /\ + (holds (W,R) V (p <-> q) w <=> holds (W,R) V p w <=> holds (W,R) V q w) /\ + (holds (W,R) V (Box p) w <=> + !w'. w' IN W /\ R w w' ==> holds (W,R) V p w') /\ + (holds (W,R) V (Diamond p) w <=> + ?w'. w' IN W /\ R w w' /\ holds (W,R) V p w')`;; + +let holds_in = new_definition + `holds_in (W,R) p = !V w. w IN W ==> holds (W,R) V p w`;; + +parse_as_infix("|=",(11,"right"));; + +let valid = new_definition + `L |= p <=> !f. L f ==> holds_in f p`;; + +let S4 = new_definition + `S4(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ + (!x. x IN W ==> R x x) /\ + (!x y z. R x y /\ R y z ==> R x z)`;; + +let LTL = new_definition + `LTL(W,R) <=> (W = UNIV) /\ !x y:num. R x y <=> x <= y`;; + +let GL = new_definition + `GL(W,R) <=> ~(W = {}) /\ (!x y. R x y ==> x IN W /\ y IN W) /\ + WF(\x y. R y x) /\ (!x y z:num. R x y /\ R y z ==> R x z)`;; + +let MODAL_TAC = + REWRITE_TAC[valid; FORALL_PAIR_THM; holds_in; holds] THEN MESON_TAC[];; + +let MODAL_RULE tm = prove(tm,MODAL_TAC);; + +let TAUT_1 = MODAL_RULE `L |= Box True`;; +let TAUT_2 = MODAL_RULE `L |= Box(A --> B) --> Box A --> Box B`;; +let TAUT_3 = MODAL_RULE `L |= Diamond(A --> B) --> Box A --> Diamond B`;; +let TAUT_4 = MODAL_RULE `L |= Box(A --> B) --> Diamond A --> Diamond B`;; +let TAUT_5 = MODAL_RULE `L |= Box(A && B) --> Box A && Box B`;; +let TAUT_6 = MODAL_RULE `L |= Diamond(A || B) --> Diamond A || Diamond B`;; + +let HOLDS_FORALL_LEMMA = prove + (`!W R P. (!A V. P(holds (W,R) V A)) <=> (!p:W->bool. P p)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC THEN GEN_TAC; SIMP_TAC[]] THEN + POP_ASSUM(MP_TAC o SPECL [`Atom a`; `\a:string. (p:W->bool)`]) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[holds] THEN REWRITE_TAC[ETA_AX]);; + +let MODAL_SCHEMA_TAC = + REWRITE_TAC[holds_in; holds] THEN MP_TAC HOLDS_FORALL_LEMMA THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]);; + +let MODAL_REFL = prove + (`!W R. (!w:W. w IN W ==> R w w) <=> !A. holds_in (W,R) (Box A --> A)`, + MODAL_SCHEMA_TAC THEN MESON_TAC[]);; + +let MODAL_TRANS = prove + (`!W R. (!w w' w'':W. w IN W /\ w' IN W /\ w'' IN W /\ + R w w' /\ R w' w'' ==> R w w'') <=> + (!A. holds_in (W,R) (Box A --> Box(Box A)))`, + MODAL_SCHEMA_TAC THEN MESON_TAC[]);; + +let MODAL_SERIAL = prove + (`!W R. (!w:W. w IN W ==> ?w'. w' IN W /\ R w w') <=> + (!A. holds_in (W,R) (Box A --> Diamond A))`, + MODAL_SCHEMA_TAC THEN MESON_TAC[]);; + +let MODAL_SYM = prove + (`!W R. (!w w':W. w IN W /\ w' IN W /\ R w w' ==> R w' w) <=> + (!A. holds_in (W,R) (A --> Box(Diamond A)))`, + MODAL_SCHEMA_TAC THEN EQ_TAC THENL [MESON_TAC[]; REPEAT STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\v:W. v = w`; `w:W`]) THEN ASM_MESON_TAC[]);; + +let MODAL_WFTRANS = prove + (`!W R. (!x y z:W. x IN W /\ y IN W /\ z IN W /\ R x y /\ R y z ==> R x z) /\ + WF(\x y. x IN W /\ y IN W /\ R y x) <=> + (!A. holds_in (W,R) (Box(Box A --> A) --> Box A))`, + MODAL_SCHEMA_TAC THEN REWRITE_TAC[WF_IND] THEN EQ_TAC THEN + STRIP_TAC THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REPEAT DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC; + X_GEN_TAC `w:W` THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`\v:W. v IN W /\ R w v /\ !w''. w'' IN W /\ R v w'' ==> R w w''`; `w:W`]); + X_GEN_TAC `P:W->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\x:W. !w:W. x IN W /\ R w x ==> P x`) THEN + MATCH_MP_TAC MONO_FORALL] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Need a fresh HOL session here: doing shallow embedding. *) +(* ------------------------------------------------------------------------- *) + +parse_as_prefix "Not";; +parse_as_infix("&&",(16,"right"));; +parse_as_infix("||",(15,"right"));; +parse_as_infix("-->",(14,"right"));; +parse_as_infix("<->",(13,"right"));; + +let false_def = define `False = \t:num. F`;; +let true_def = define `True = \t:num. T`;; +let not_def = define `Not p = \t:num. ~(p t)`;; +let and_def = define `p && q = \t:num. p t /\ q t`;; +let or_def = define `p || q = \t:num. p t \/ q t`;; +let imp_def = define `p --> q = \t:num. p t ==> q t`;; +let iff_def = define `p <-> q = \t:num. p t <=> q t`;; + +let forever = define `forever p = \t:num. !t'. t <= t' ==> p t'`;; +let sometime = define `sometime p = \t:num. ?t'. t <= t' /\ p t'`;; + +let next = define `next p = \t:num. p(t + 1)`;; + +parse_as_infix("until",(17,"right"));; + +let until = define + `p until q = + \t:num. ?t'. t <= t' /\ (!t''. t <= t'' /\ t'' < t' ==> p t'') /\ q t'`;; + +(* ========================================================================= *) +(* HOL as a functional programming language *) +(* ========================================================================= *) + +type ite = False | True | Atomic of int | Ite of ite*ite*ite;; + +let rec norm e = + match e with + Ite(False,y,z) -> norm z + | Ite(True,y,z) -> norm y + | Ite(Atomic i,y,z) -> Ite(Atomic i,norm y,norm z) + | Ite(Ite(u,v,w),y,z) -> norm(Ite(u,Ite(v,y,z),Ite(w,y,z))) + | _ -> e;; + +let ite_INDUCT,ite_RECURSION = define_type + "ite = False | True | Atomic num | Ite ite ite ite";; + +let eth = prove_general_recursive_function_exists + `?norm. (norm False = False) /\ + (norm True = True) /\ + (!i. norm (Atomic i) = Atomic i) /\ + (!y z. norm (Ite False y z) = norm z) /\ + (!y z. norm (Ite True y z) = norm y) /\ + (!i y z. norm (Ite (Atomic i) y z) = + Ite (Atomic i) (norm y) (norm z)) /\ + (!u v w y z. norm (Ite (Ite u v w) y z) = + norm (Ite u (Ite v y z) (Ite w y z)))`;; + +let sizeof = define + `(sizeof False = 1) /\ + (sizeof True = 1) /\ + (sizeof(Atomic i) = 1) /\ + (sizeof(Ite x y z) = sizeof x * (1 + sizeof y + sizeof z))`;; + +let eth' = + let th = prove + (hd(hyp eth), + EXISTS_TAC `MEASURE sizeof` THEN + REWRITE_TAC[WF_MEASURE; MEASURE_LE; MEASURE; sizeof] THEN ARITH_TAC) in + PROVE_HYP th eth;; + +let norm = new_specification ["norm"] eth';; + +let SIZEOF_INDUCT = REWRITE_RULE[WF_IND; MEASURE] (ISPEC`sizeof` WF_MEASURE);; + +let SIZEOF_NZ = prove + (`!e. ~(sizeof e = 0)`, + MATCH_MP_TAC ite_INDUCT THEN SIMP_TAC[sizeof; ADD_EQ_0; MULT_EQ_0; ARITH]);; + +let ITE_INDUCT = prove + (`!P. P False /\ + P True /\ + (!i. P(Atomic i)) /\ + (!y z. P z ==> P(Ite False y z)) /\ + (!y z. P y ==> P(Ite True y z)) /\ + (!i y z. P y /\ P z ==> P (Ite (Atomic i) y z)) /\ + (!u v w x y z. P(Ite u (Ite v y z) (Ite w y z)) + ==> P(Ite (Ite u v w) y z)) + ==> !e. P e`, + GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC SIZEOF_INDUCT THEN + MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ite_INDUCT THEN POP_ASSUM_LIST + (fun ths -> REPEAT STRIP_TAC THEN FIRST(mapfilter MATCH_MP_TAC ths)) THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[sizeof] THEN TRY ARITH_TAC THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC; ADD_AC; LT_ADD_LCANCEL] THEN + REWRITE_TAC[ADD_ASSOC; LT_ADD_RCANCEL] THEN + MATCH_MP_TAC(ARITH_RULE `~(b = 0) /\ ~(c = 0) ==> a < (b + a) + c`) THEN + REWRITE_TAC[MULT_EQ_0; SIZEOF_NZ]);; + +let normalized = define + `(normalized False <=> T) /\ + (normalized True <=> T) /\ + (normalized(Atomic a) <=> T) /\ + (normalized(Ite False x y) <=> F) /\ + (normalized(Ite True x y) <=> F) /\ + (normalized(Ite (Atomic a) x y) <=> normalized x /\ normalized y) /\ + (normalized(Ite (Ite u v w) x y) <=> F)`;; + +let NORMALIZED_NORM = prove + (`!e. normalized(norm e)`, + MATCH_MP_TAC ITE_INDUCT THEN REWRITE_TAC[norm; normalized]);; + +let NORMALIZED_INDUCT = prove + (`P False /\ + P True /\ + (!i. P (Atomic i)) /\ + (!i x y. P x /\ P y ==> P (Ite (Atomic i) x y)) + ==> !e. normalized e ==> P e`, + STRIP_TAC THEN MATCH_MP_TAC ite_INDUCT THEN ASM_REWRITE_TAC[normalized] THEN + MATCH_MP_TAC ite_INDUCT THEN ASM_MESON_TAC[normalized]);; + +let holds = define + `(holds v False <=> F) /\ + (holds v True <=> T) /\ + (holds v (Atomic i) <=> v(i)) /\ + (holds v (Ite b x y) <=> if holds v b then holds v x else holds v y)`;; + +let HOLDS_NORM = prove + (`!e v. holds v (norm e) <=> holds v e`, + MATCH_MP_TAC ITE_INDUCT THEN SIMP_TAC[holds; norm] THEN + REPEAT STRIP_TAC THEN CONV_TAC TAUT);; + +let taut = define + `(taut (t,f) False <=> F) /\ + (taut (t,f) True <=> T) /\ + (taut (t,f) (Atomic i) <=> MEM i t) /\ + (taut (t,f) (Ite (Atomic i) x y) <=> + if MEM i t then taut (t,f) x + else if MEM i f then taut (t,f) y + else taut (CONS i t,f) x /\ taut (t,CONS i f) y)`;; + +let tautology = define `tautology e = taut([],[]) (norm e)`;; + +let NORMALIZED_TAUT = prove + (`!e. normalized e + ==> !f t. (!a. ~(MEM a t /\ MEM a f)) + ==> (taut (t,f) e <=> + !v. (!a. MEM a t ==> v(a)) /\ (!a. MEM a f ==> ~v(a)) + ==> holds v e)`, + MATCH_MP_TAC NORMALIZED_INDUCT THEN REWRITE_TAC[holds; taut] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `\a:num. MEM a t` THEN ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ALL_TAC; DISCH_THEN MATCH_MP_TAC] THEN ASM_MESON_TAC[]; + REPEAT STRIP_TAC THEN REPEAT(COND_CASES_TAC THEN ASM_SIMP_TAC[])] THEN + ASM_SIMP_TAC[MEM; RIGHT_OR_DISTRIB; LEFT_OR_DISTRIB; + MESON[] `(!a. ~(MEM a t /\ a = i)) <=> ~(MEM i t)`; + MESON[] `(!a. ~(a = i /\ MEM a f)) <=> ~(MEM i f)`] THEN + ASM_REWRITE_TAC[AND_FORALL_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + MESON_TAC[]);; + +let TAUTOLOGY = prove + (`!e. tautology e <=> !v. holds v e`, + MESON_TAC[tautology; HOLDS_NORM; NORMALIZED_TAUT; MEM; NORMALIZED_NORM]);; + +let HOLDS_BACK = prove + (`!v. (F <=> holds v False) /\ + (T <=> holds v True) /\ + (!i. v i <=> holds v (Atomic i)) /\ + (!p. ~holds v p <=> holds v (Ite p False True)) /\ + (!p q. (holds v p /\ holds v q) <=> holds v (Ite p q False)) /\ + (!p q. (holds v p \/ holds v q) <=> holds v (Ite p True q)) /\ + (!p q. (holds v p <=> holds v q) <=> + holds v (Ite p q (Ite q False True))) /\ + (!p q. holds v p ==> holds v q <=> holds v (Ite p q True))`, + REWRITE_TAC[holds] THEN CONV_TAC TAUT);; + +let COND_CONV = GEN_REWRITE_CONV I [COND_CLAUSES];; +let AND_CONV = GEN_REWRITE_CONV I [TAUT `(F /\ a <=> F) /\ (T /\ a <=> a)`];; +let OR_CONV = GEN_REWRITE_CONV I [TAUT `(F \/ a <=> a) /\ (T \/ a <=> T)`];; + +let rec COMPUTE_DEPTH_CONV conv tm = + if is_cond tm then + (RATOR_CONV(LAND_CONV(COMPUTE_DEPTH_CONV conv)) THENC + COND_CONV THENC + COMPUTE_DEPTH_CONV conv) tm + else if is_conj tm then + (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC + AND_CONV THENC + COMPUTE_DEPTH_CONV conv) tm + else if is_disj tm then + (LAND_CONV (COMPUTE_DEPTH_CONV conv) THENC + OR_CONV THENC + COMPUTE_DEPTH_CONV conv) tm + else + (SUB_CONV (COMPUTE_DEPTH_CONV conv) THENC + TRY_CONV(conv THENC COMPUTE_DEPTH_CONV conv)) tm;; + +g `!v. v 1 \/ v 2 \/ v 3 \/ v 4 \/ v 5 \/ v 6 \/ + ~v 1 \/ ~v 2 \/ ~v 3 \/ ~v 4 \/ ~v 5 \/ ~v 6`;; + +e(MP_TAC HOLDS_BACK THEN MATCH_MP_TAC MONO_FORALL THEN + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + SPEC_TAC(`v:num->bool`,`v:num->bool`) THEN + REWRITE_TAC[GSYM TAUTOLOGY; tautology]);; + +time e (GEN_REWRITE_TAC COMPUTE_DEPTH_CONV [norm; taut; MEM; ARITH_EQ]);; + +ignore(b()); time e (REWRITE_TAC[norm; taut; MEM; ARITH_EQ]);; + +(* ========================================================================= *) +(* Vectors *) +(* ========================================================================= *) + +needs "Multivariate/vectors.ml";; + +needs "Examples/solovay.ml";; + +g `orthogonal (A - B) (C - B) + ==> norm(C - A) pow 2 = norm(B - A) pow 2 + norm(C - B) pow 2`;; + +e SOLOVAY_VECTOR_TAC;; +e(CONV_TAC REAL_RING);; + +g`!x y:real^N. x dot y <= norm x * norm y`;; +e SOLOVAY_VECTOR_TAC;; + +(**** Needs external SDP solver +needs "Examples/sos.ml";; + +e(CONV_TAC REAL_SOS);; + +let EXAMPLE_0 = prove + (`!a x y:real^N. (y - x) dot (a - y) >= &0 ==> norm(y - a) <= norm(x - a)`, + SOLOVAY_VECTOR_TAC THEN CONV_TAC REAL_SOS);; +****) + +needs "Rqe/make.ml";; +let EXAMPLE_10 = prove + (`!x:real^N y. + x dot y > &0 + ==> ?u. &0 < u /\ + !v. &0 < v /\ v <= u ==> norm(v % y - x) < norm x`, + SOLOVAY_VECTOR_TAC THEN + W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC REAL_QELIM_CONV);; + +let FORALL_3 = prove + (`(!i. 1 <= i /\ i <= 3 ==> P i) <=> P 1 /\ P 2 /\ P 3`, + MESON_TAC[ARITH_RULE `1 <= i /\ i <= 3 <=> (i = 1) \/ (i = 2) \/ (i = 3)`]);; + +let SUM_3 = prove + (`!t. sum(1..3) t = t(1) + t(2) + t(3)`, + REWRITE_TAC[num_CONV `3`; num_CONV `2`; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[SUM_SING_NUMSEG; ARITH; REAL_ADD_ASSOC]);; + +let VECTOR_3 = prove + (`(vector [x;y;z] :real^3)$1 = x /\ + (vector [x;y;z] :real^3)$2 = y /\ + (vector [x;y;z] :real^3)$3 = z`, + SIMP_TAC[vector; LAMBDA_BETA; DIMINDEX_3; LENGTH; ARITH] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; EL; HD; TL]);; + +let DOT_VECTOR = prove + (`(vector [x1;y1;z1] :real^3) dot (vector [x2;y2;z2]) = + x1 * x2 + y1 * y2 + z1 * z2`, + REWRITE_TAC[dot; DIMINDEX_3; SUM_3; VECTOR_3]);; + +let VECTOR_ZERO = prove + (`(vector [x;y;z] :real^3 = vec 0) <=> x = &0 /\ y = &0 /\ z = &0`, + SIMP_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VEC_COMPONENT; VECTOR_3; ARITH]);; + +let ORTHOGONAL_VECTOR = prove + (`orthogonal (vector [x1;y1;z1] :real^3) (vector [x2;y2;z2]) = + (x1 * x2 + y1 * y2 + z1 * z2 = &0)`, + REWRITE_TAC[orthogonal; DOT_VECTOR]);; + +parse_as_infix("cross",(20,"right"));; + +let cross = new_definition + `(a:real^3) cross (b:real^3) = + vector [a$2 * b$3 - a$3 * b$2; + a$3 * b$1 - a$1 * b$3; + a$1 * b$2 - a$2 * b$1] :real^3`;; + +let VEC3_TAC = + SIMP_TAC[CART_EQ; LAMBDA_BETA; FORALL_3; SUM_3; DIMINDEX_3; VECTOR_3; + vector_add; vec; dot; cross; orthogonal; basis; ARITH] THEN + CONV_TAC REAL_RING;; + +let VEC3_RULE tm = prove(tm,VEC3_TAC);; + +let ORTHOGONAL_CROSS = VEC3_RULE + `!x y. orthogonal (x cross y) x /\ orthogonal (x cross y) y /\ + orthogonal x (x cross y) /\ orthogonal y (x cross y)`;; + +let LEMMA_0 = VEC3_RULE + `~(basis 1 :real^3 = vec 0) /\ + ~(basis 2 :real^3 = vec 0) /\ + ~(basis 3 :real^3 = vec 0)`;; + +let LEMMA_1 = VEC3_RULE `!u v. u dot (u cross v) = &0`;; + +let LEMMA_2 = VEC3_RULE `!u v. v dot (u cross v) = &0`;; + +let LEMMA_3 = VEC3_RULE `!u:real^3. vec 0 dot u = &0`;; + +let LEMMA_4 = VEC3_RULE `!u:real^3. u dot vec 0 = &0`;; + +let LEMMA_5 = VEC3_RULE `!x. x cross x = vec 0`;; + +let LEMMA_6 = VEC3_RULE + `!u. ~(u = vec 0) + ==> ~(u cross basis 1 = vec 0) \/ + ~(u cross basis 2 = vec 0) \/ + ~(u cross basis 3 = vec 0)`;; + +let LEMMA_7 = VEC3_RULE + `!u v w. (u cross v = vec 0) ==> (u dot (v cross w) = &0)`;; + +let NORMAL_EXISTS = prove + (`!u v:real^3. ?w. ~(w = vec 0) /\ orthogonal u w /\ orthogonal v w`, + REPEAT GEN_TAC THEN MAP_EVERY ASM_CASES_TAC + [`u:real^3 = vec 0`; `v:real^3 = vec 0`; `u cross v = vec 0`] THEN + ASM_REWRITE_TAC[orthogonal] THEN + ASM_MESON_TAC[LEMMA_0; LEMMA_1; LEMMA_2; LEMMA_3; LEMMA_4; + LEMMA_5; LEMMA_6; LEMMA_7]);; + +(* ========================================================================= *) +(* Custom tactics *) +(* ========================================================================= *) + +let points = +[((0, -1), (0, -1), (2, 0)); ((0, -1), (0, 0), (2, 0)); + ((0, -1), (0, 1), (2, 0)); ((0, -1), (2, 0), (0, -1)); + ((0, -1), (2, 0), (0, 0)); ((0, -1), (2, 0), (0, 1)); + ((0, 0), (0, -1), (2, 0)); ((0, 0), (0, 0), (2, 0)); + ((0, 0), (0, 1), (2, 0)); ((0, 0), (2, 0), (-2, 0)); + ((0, 0), (2, 0), (0, -1)); ((0, 0), (2, 0), (0, 0)); + ((0, 0), (2, 0), (0, 1)); ((0, 0), (2, 0), (2, 0)); + ((0, 1), (0, -1), (2, 0)); ((0, 1), (0, 0), (2, 0)); + ((0, 1), (0, 1), (2, 0)); ((0, 1), (2, 0), (0, -1)); + ((0, 1), (2, 0), (0, 0)); ((0, 1), (2, 0), (0, 1)); + ((2, 0), (-2, 0), (0, 0)); ((2, 0), (0, -1), (0, -1)); + ((2, 0), (0, -1), (0, 0)); ((2, 0), (0, -1), (0, 1)); + ((2, 0), (0, 0), (-2, 0)); ((2, 0), (0, 0), (0, -1)); + ((2, 0), (0, 0), (0, 0)); ((2, 0), (0, 0), (0, 1)); + ((2, 0), (0, 0), (2, 0)); ((2, 0), (0, 1), (0, -1)); + ((2, 0), (0, 1), (0, 0)); ((2, 0), (0, 1), (0, 1)); + ((2, 0), (2, 0), (0, 0))];; + +let ortho = + let mult (x1,y1) (x2,y2) = (x1 * x2 + 2 * y1 * y2,x1 * y2 + y1 * x2) + and add (x1,y1) (x2,y2) = (x1 + x2,y1 + y2) in + let dot (x1,y1,z1) (x2,y2,z2) = + end_itlist add [mult x1 x2; mult y1 y2; mult z1 z2] in + fun (v1,v2) -> dot v1 v2 = (0,0);; + +let opairs = filter ortho (allpairs (fun a b -> a,b) points points);; + +let otrips = filter (fun (a,b,c) -> ortho(a,b) & ortho(a,c)) + (allpairs (fun a (b,c) -> a,b,c) points opairs);; + +let hol_of_value = + let tm0 = `&0` and tm1 = `&2` and tm2 = `-- &2` + and tm3 = `sqrt(&2)` and tm4 = `--sqrt(&2)` in + function 0,0 -> tm0 | 2,0 -> tm1 | -2,0 -> tm2 | 0,1 -> tm3 | 0,-1 -> tm4;; + +let hol_of_point = + let ptm = `vector:(real)list->real^3` in + fun (x,y,z) -> mk_comb(ptm,mk_flist(map hol_of_value [x;y;z]));; + +let SQRT_2_POW = prove + (`sqrt(&2) pow 2 = &2`, + SIMP_TAC[SQRT_POW_2; REAL_POS]);; + +let PROVE_NONTRIVIAL = + let ptm = `~(x :real^3 = vec 0)` and xtm = `x:real^3` in + fun x -> prove(vsubst [hol_of_point x,xtm] ptm, + GEN_REWRITE_TAC RAND_CONV [VECTOR_ZERO] THEN + MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; + +let PROVE_ORTHOGONAL = + let ptm = `orthogonal:real^3->real^3->bool` in + fun (x,y) -> + prove(list_mk_comb(ptm,[hol_of_point x;hol_of_point y]), + ONCE_REWRITE_TAC[ORTHOGONAL_VECTOR] THEN + MP_TAC SQRT_2_POW THEN CONV_TAC REAL_RING);; + +let ppoint = let p = `P:real^3->bool` in fun v -> mk_comb(p,hol_of_point v);; + +let DEDUCE_POINT_TAC pts = + FIRST_X_ASSUM MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC (map hol_of_point pts) THEN + ASM_REWRITE_TAC[];; + +let rec KOCHEN_SPECKER_TAC set_0 set_1 = + if intersect set_0 set_1 <> [] then + let p = ppoint(hd(intersect set_0 set_1)) in + let th1 = ASSUME(mk_neg p) and th2 = ASSUME p in + ACCEPT_TAC(EQ_MP (EQF_INTRO th1) th2) + else + let prf_1 = filter (fun (a,b) -> mem a set_0) opairs + and prf_0 = filter (fun (a,b,c) -> mem a set_1 & mem b set_1) otrips in + let new_1 = map snd prf_1 and new_0 = map (fun (a,b,c) -> c) prf_0 in + let set_0' = union new_0 set_0 and set_1' = union new_1 set_1 in + let del_0 = subtract set_0' set_0 and del_1 = subtract set_1' set_1 in + if del_0 <> [] or del_1 <> [] then + let prv_0 x = + let a,b,_ = find (fun (a,b,c) -> c = x) prf_0 in DEDUCE_POINT_TAC [a;b] + and prv_1 x = + let a,_ = find (fun (a,c) -> c = x) prf_1 in DEDUCE_POINT_TAC [a] in + let newuns = list_mk_conj + (map ppoint del_1 @ map (mk_neg o ppoint) del_0) + and tacs = map prv_1 del_1 @ map prv_0 del_0 in + SUBGOAL_THEN newuns STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL tacs; ALL_TAC] THEN + KOCHEN_SPECKER_TAC set_0' set_1' + else + let v = find (fun i -> not(mem i set_0) & not(mem i set_1)) points in + ASM_CASES_TAC (ppoint v) THENL + [KOCHEN_SPECKER_TAC set_0 (v::set_1); + KOCHEN_SPECKER_TAC (v::set_0) set_1];; + +let KOCHEN_SPECKER_LEMMA = prove + (`!P. (!x y:real^3. ~(x = vec 0) /\ ~(y = vec 0) /\ orthogonal x y /\ + ~(P x) ==> P y) /\ + (!x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ + orthogonal x y /\ orthogonal x z /\ orthogonal y z /\ + P x /\ P y ==> ~(P z)) + ==> F`, + REPEAT STRIP_TAC THEN + MAP_EVERY (ASSUME_TAC o PROVE_NONTRIVIAL) points THEN + MAP_EVERY (ASSUME_TAC o PROVE_ORTHOGONAL) opairs THEN + KOCHEN_SPECKER_TAC [] []);; + +let NONTRIVIAL_CROSS = prove + (`!x y. orthogonal x y /\ ~(x = vec 0) /\ ~(y = vec 0) + ==> ~(x cross y = vec 0)`, + REWRITE_TAC[GSYM DOT_EQ_0] THEN VEC3_TAC);; + +let KOCHEN_SPECKER_PARADOX = prove + (`~(?spin:real^3->num. + !x y z. ~(x = vec 0) /\ ~(y = vec 0) /\ ~(z = vec 0) /\ + orthogonal x y /\ orthogonal x z /\ orthogonal y z + ==> (spin x = 0) /\ (spin y = 1) /\ (spin z = 1) \/ + (spin x = 1) /\ (spin y = 0) /\ (spin z = 1) \/ + (spin x = 1) /\ (spin y = 1) /\ (spin z = 0))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\x:real^3. spin(x) = 1` KOCHEN_SPECKER_LEMMA) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + POP_ASSUM MP_TAC THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_MESON_TAC[ARITH_RULE `~(1 = 0)`; NONTRIVIAL_CROSS; ORTHOGONAL_CROSS]);; + +(* ========================================================================= *) +(* Defining new types *) +(* ========================================================================= *) + +let direction_tybij = new_type_definition "direction" ("mk_dir","dest_dir") + (MESON[LEMMA_0] `?x:real^3. ~(x = vec 0)`);; + +parse_as_infix("||",(11,"right"));; +parse_as_infix("_|_",(11,"right"));; + +let perpdir = new_definition + `x _|_ y <=> orthogonal (dest_dir x) (dest_dir y)`;; + +let pardir = new_definition + `x || y <=> (dest_dir x) cross (dest_dir y) = vec 0`;; + +let DIRECTION_CLAUSES = prove + (`((!x. P(dest_dir x)) <=> (!x. ~(x = vec 0) ==> P x)) /\ + ((?x. P(dest_dir x)) <=> (?x. ~(x = vec 0) /\ P x))`, + MESON_TAC[direction_tybij]);; + +let [PARDIR_REFL; PARDIR_SYM; PARDIR_TRANS] = (CONJUNCTS o prove) + (`(!x. x || x) /\ + (!x y. x || y <=> y || x) /\ + (!x y z. x || y /\ y || z ==> x || z)`, + REWRITE_TAC[pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let DIRECTION_AXIOM_1 = prove + (`!p p'. ~(p || p') ==> ?l. p _|_ l /\ p' _|_ l /\ + !l'. p _|_ l' /\ p' _|_ l' ==> l' || l`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:real^3`; `p':real^3`] NORMAL_EXISTS) THEN + MATCH_MP_TAC MONO_EXISTS THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_2 = prove + (`!l l'. ?p. p _|_ l /\ p _|_ l'`, + REWRITE_TAC[perpdir; DIRECTION_CLAUSES] THEN + MESON_TAC[NORMAL_EXISTS; ORTHOGONAL_SYM]);; + +let DIRECTION_AXIOM_3 = prove + (`?p p' p''. + ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + ~(?l. p _|_ l /\ p' _|_ l /\ p'' _|_ l)`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN + MAP_EVERY (fun t -> EXISTS_TAC t THEN REWRITE_TAC[LEMMA_0]) + [`basis 1 :real^3`; `basis 2 : real^3`; `basis 3 :real^3`] THEN + VEC3_TAC);; + +let CROSS_0 = VEC3_RULE `x cross vec 0 = vec 0 /\ vec 0 cross x = vec 0`;; + +let DIRECTION_AXIOM_4_WEAK = prove + (`!l. ?p p'. ~(p || p') /\ p _|_ l /\ p' _|_ l`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 2) l /\ + ~((l cross basis 1) cross (l cross basis 2) = vec 0) \/ + orthogonal (l cross basis 1) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 1) cross (l cross basis 3) = vec 0) \/ + orthogonal (l cross basis 2) l /\ orthogonal (l cross basis 3) l /\ + ~((l cross basis 2) cross (l cross basis 3) = vec 0)` + MP_TAC THENL [POP_ASSUM MP_TAC THEN VEC3_TAC; MESON_TAC[CROSS_0]]);; + +let ORTHOGONAL_COMBINE = prove + (`!x a b. a _|_ x /\ b _|_ x /\ ~(a || b) + ==> ?c. c _|_ x /\ ~(a || c) /\ ~(b || c)`, + REWRITE_TAC[DIRECTION_CLAUSES; pardir; perpdir] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `a + b:real^3` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN VEC3_TAC);; + +let DIRECTION_AXIOM_4 = prove + (`!l. ?p p' p''. ~(p || p') /\ ~(p' || p'') /\ ~(p || p'') /\ + p _|_ l /\ p' _|_ l /\ p'' _|_ l`, + MESON_TAC[DIRECTION_AXIOM_4_WEAK; ORTHOGONAL_COMBINE]);; + +let line_tybij = define_quotient_type "line" ("mk_line","dest_line") `(||)`;; + +let PERPDIR_WELLDEF = prove + (`!x y x' y'. x || x' /\ y || y' ==> (x _|_ y <=> x' _|_ y')`, + REWRITE_TAC[perpdir; pardir; DIRECTION_CLAUSES] THEN VEC3_TAC);; + +let perpl,perpl_th = + lift_function (snd line_tybij) (PARDIR_REFL,PARDIR_TRANS) + "perpl" PERPDIR_WELLDEF;; + +let line_lift_thm = lift_theorem line_tybij + (PARDIR_REFL,PARDIR_SYM,PARDIR_TRANS) [perpl_th];; + +let LINE_AXIOM_1 = line_lift_thm DIRECTION_AXIOM_1;; +let LINE_AXIOM_2 = line_lift_thm DIRECTION_AXIOM_2;; +let LINE_AXIOM_3 = line_lift_thm DIRECTION_AXIOM_3;; +let LINE_AXIOM_4 = line_lift_thm DIRECTION_AXIOM_4;; + +let point_tybij = new_type_definition "point" ("mk_point","dest_point") + (prove(`?x:line. T`,REWRITE_TAC[]));; + +parse_as_infix("on",(11,"right"));; + +let on = new_definition `p on l <=> perpl (dest_point p) l`;; + +let POINT_CLAUSES = prove + (`((p = p') <=> (dest_point p = dest_point p')) /\ + ((!p. P (dest_point p)) <=> (!l. P l)) /\ + ((?p. P (dest_point p)) <=> (?l. P l))`, + MESON_TAC[point_tybij]);; + +let POINT_TAC th = REWRITE_TAC[on; POINT_CLAUSES] THEN ACCEPT_TAC th;; + +let AXIOM_1 = prove + (`!p p'. ~(p = p') ==> ?l. p on l /\ p' on l /\ + !l'. p on l' /\ p' on l' ==> (l' = l)`, + POINT_TAC LINE_AXIOM_1);; + +let AXIOM_2 = prove + (`!l l'. ?p. p on l /\ p on l'`, + POINT_TAC LINE_AXIOM_2);; + +let AXIOM_3 = prove + (`?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p on l /\ p' on l /\ p'' on l)`, + POINT_TAC LINE_AXIOM_3);; + +let AXIOM_4 = prove + (`!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p on l /\ p' on l /\ p'' on l`, + POINT_TAC LINE_AXIOM_4);; + +(* ========================================================================= *) +(* Custom inference rules *) +(* ========================================================================= *) + +let near_ring_axioms = + `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z))`;; + +(**** Works eventually but takes a very long time +MESON[] + `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) + ==> !a. 0 * a = 0`;; + ****) + +let is_realvar w x = is_var x & not(mem x w);; + +let rec real_strip w tm = + if mem tm w then tm,[] else + let l,r = dest_comb tm in + let f,args = real_strip w l in f,args@[r];; + +let weight lis (f,n) (g,m) = + let i = index f lis and j = index g lis in + i > j or i = j & n > m;; + +let rec lexord ord l1 l2 = + match (l1,l2) with + (h1::t1,h2::t2) -> if ord h1 h2 then length t1 = length t2 + else h1 = h2 & lexord ord t1 t2 + | _ -> false;; + +let rec lpo_gt w s t = + if is_realvar w t then not(s = t) & mem t (frees s) + else if is_realvar w s or is_abs s or is_abs t then false else + let f,fargs = real_strip w s and g,gargs = real_strip w t in + exists (fun si -> lpo_ge w si t) fargs or + forall (lpo_gt w s) gargs & + (f = g & lexord (lpo_gt w) fargs gargs or + weight w (f,length fargs) (g,length gargs)) +and lpo_ge w s t = (s = t) or lpo_gt w s t;; + +let rec istriv w env x t = + if is_realvar w t then t = x or defined env t & istriv w env x (apply env t) + else if is_const t then false else + let f,args = strip_comb t in + exists (istriv w env x) args & failwith "cyclic";; + +let rec unify w env tp = + match tp with + ((Var(_,_) as x),t) | (t,(Var(_,_) as x)) when not(mem x w) -> + if defined env x then unify w env (apply env x,t) + else if istriv w env x t then env else (x|->t) env + | (Comb(f,x),Comb(g,y)) -> unify w (unify w env (x,y)) (f,g) + | (s,t) -> if s = t then env else failwith "unify: not unifiable";; + +let fullunify w (s,t) = + let env = unify w undefined (s,t) in + let th = map (fun (x,t) -> (t,x)) (graph env) in + let rec subs t = + let t' = vsubst th t in + if t' = t then t else subs t' in + map (fun (t,x) -> (subs t,x)) th;; + +let rec listcases fn rfn lis acc = + match lis with + [] -> acc + | h::t -> fn h (fun i h' -> rfn i (h'::map REFL t)) @ + listcases fn (fun i t' -> rfn i (REFL h::t')) t acc;; + +let LIST_MK_COMB f ths = rev_itlist (fun s t -> MK_COMB(t,s)) ths (REFL f);; + +let rec overlaps w th tm rfn = + let l,r = dest_eq(concl th) in + if not (is_comb tm) then [] else + let f,args = strip_comb tm in + listcases (overlaps w th) (fun i a -> rfn i (LIST_MK_COMB f a)) args + (try [rfn (fullunify w (l,tm)) th] with Failure _ -> []);; + +let crit1 w eq1 eq2 = + let l1,r1 = dest_eq(concl eq1) + and l2,r2 = dest_eq(concl eq2) in + overlaps w eq1 l2 (fun i th -> TRANS (SYM(INST i th)) (INST i eq2));; + +let fixvariables s th = + let fvs = subtract (frees(concl th)) (freesl(hyp th)) in + let gvs = map2 (fun v n -> mk_var(s^string_of_int n,type_of v)) + fvs (1--length fvs) in + INST (zip gvs fvs) th;; + +let renamepair (th1,th2) = fixvariables "x" th1,fixvariables "y" th2;; + +let critical_pairs w tha thb = + let th1,th2 = renamepair (tha,thb) in crit1 w th1 th2 @ crit1 w th2 th1;; + +let normalize_and_orient w eqs th = + let th' = GEN_REWRITE_RULE TOP_DEPTH_CONV eqs th in + let s',t' = dest_eq(concl th') in + if lpo_ge w s' t' then th' else if lpo_ge w t' s' then SYM th' + else failwith "Can't orient equation";; + +let status(eqs,crs) eqs0 = + if eqs = eqs0 & (length crs) mod 1000 <> 0 then () else + (print_string(string_of_int(length eqs)^" equations and "^ + string_of_int(length crs)^" pending critical pairs"); + print_newline());; + +let left_reducible eqs eq = + can (CHANGED_CONV(GEN_REWRITE_CONV (LAND_CONV o ONCE_DEPTH_CONV) eqs)) + (concl eq);; + +let rec complete w (eqs,crits) = + match crits with + (eq::ocrits) -> + let trip = + try let eq' = normalize_and_orient w eqs eq in + let s',t' = dest_eq(concl eq') in + if s' = t' then (eqs,ocrits) else + let crits',eqs' = partition(left_reducible [eq']) eqs in + let eqs'' = eq'::eqs' in + eqs'', + ocrits @ crits' @ itlist ((@) o critical_pairs w eq') eqs'' [] + with Failure _ -> + if exists (can (normalize_and_orient w eqs)) ocrits + then (eqs,ocrits@[eq]) + else failwith "complete: no orientable equations" in + status trip eqs; complete w trip + | [] -> eqs;; + +let complete_equations wts eqs = + let eqs' = map (normalize_and_orient wts []) eqs in + complete wts ([],eqs');; + +complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] + [SPEC_ALL(ASSUME `!a b. i(a) * a * b = b`)];; + +complete_equations [`c:A`; `f:A->A`] + (map SPEC_ALL (CONJUNCTS (ASSUME + `((f(f(f(f(f c))))) = c:A) /\ (f(f(f c)) = c)`)));; + +let eqs = map SPEC_ALL (CONJUNCTS (ASSUME + `(!x. 1 * x = x) /\ (!x. i(x) * x = 1) /\ + (!x y z. (x * y) * z = x * y * z)`)) in +map concl (complete_equations [`1`; `( * ):num->num->num`; `i:num->num`] eqs);; + +let COMPLETE_TAC w th = + let eqs = map SPEC_ALL (CONJUNCTS(SPEC_ALL th)) in + let eqs' = complete_equations w eqs in + MAP_EVERY (ASSUME_TAC o GEN_ALL) eqs';; + +g `(!x. 1 * x = x) /\ + (!x. i(x) * x = 1) /\ + (!x y z. (x * y) * z = x * y * z) + ==> !x y. i(y) * i(i(i(x * i(y)))) * x = 1`;; + +e (DISCH_THEN(COMPLETE_TAC [`1`; `( * ):num->num->num`; `i:num->num`]));; +e(ASM_REWRITE_TAC[]);; + +g `(!x. 0 + x = x) /\ + (!x. neg x + x = 0) /\ + (!x y z. (x + y) + z = x + y + z) /\ + (!x y z. (x * y) * z = x * y * z) /\ + (!x y z. (x + y) * z = (x * z) + (y * z)) + ==> (neg 0 * (x * y + z + neg(neg(w + z))) + neg(neg b + neg a) = + a + b)`;; + +e (DISCH_THEN(COMPLETE_TAC + [`0`; `(+):num->num->num`; `neg:num->num`; `( * ):num->num->num`]));; +e(ASM_REWRITE_TAC[]);; + +(**** Could have done this instead +e (DISCH_THEN(COMPLETE_TAC + [`0`; `(+):num->num->num`; `( * ):num->num->num`; `neg:num->num`]));; +****) + +(* ========================================================================= *) +(* Linking external tools *) +(* ========================================================================= *) + +let maximas e = + let filename = Filename.temp_file "maxima" ".out" in + let s = + "echo 'linel:10000; display2d:false;" ^ e ^ + ";' | maxima | grep '^(%o3)' | sed -e 's/^(%o3) //' >" ^ + filename in + if Sys.command s <> 0 then failwith "maxima" else + let fd = Pervasives.open_in filename in + let data = input_line fd in + close_in fd; Sys.remove filename; data;; + +prioritize_real();; +let maxima_ops = ["+",`(+)`; "-",`(-)`; "*",`( * )`; "/",`(/)`; "^",`(pow)`];; +let maxima_funs = ["sin",`sin`; "cos",`cos`];; + +let mk_uneg = curry mk_comb `(--)`;; + +let dest_uneg = + let ntm = `(--)` in + fun tm -> let op,t = dest_comb tm in + if op = ntm then t else failwith "dest_uneg";; + +let mk_pow = let f = mk_binop `(pow)` in fun x y -> f x (rand y);; +let mk_realvar = let real_ty = `:real` in fun x -> mk_var(x,real_ty);; + +let rec string_of_hol tm = + if is_ratconst tm then "("^string_of_num(rat_of_term tm)^")" + else if is_numeral tm then string_of_num(dest_numeral tm) + else if is_var tm then fst(dest_var tm) + else if can dest_uneg tm then "-(" ^ string_of_hol(rand tm) ^ ")" else + let lop,r = dest_comb tm in + try let op,l = dest_comb lop in + "("^string_of_hol l^" "^ rev_assoc op maxima_ops^" "^string_of_hol r^")" + with Failure _ -> rev_assoc lop maxima_funs ^ "(" ^ string_of_hol r ^ ")";; + +string_of_hol `(x + sin(-- &2 * x)) pow 2 - cos(x - &22 / &7)`;; + +let lexe s = map (function Resword s -> s | Ident s -> s) (lex(explode s));; + +let parse_bracketed prs inp = + match prs inp with + ast,")"::rst -> ast,rst + | _ -> failwith "Closing bracket expected";; + +let rec parse_ginfix op opup sof prs inp = + match prs inp with + e1,hop::rst when hop = op -> parse_ginfix op opup (opup sof e1) prs rst + | e1,rest -> sof e1,rest;; + +let parse_general_infix op = + let opcon = if op = "^" then mk_pow else mk_binop (assoc op maxima_ops) in + let constr = if op <> "^" & snd(get_infix_status op) = "right" + then fun f e1 e2 -> f(opcon e1 e2) + else fun f e1 e2 -> opcon(f e1) e2 in + parse_ginfix op constr (fun x -> x);; + +let rec parse_atomic_expression inp = + match inp with + [] -> failwith "expression expected" + | "(" :: rest -> parse_bracketed parse_expression rest + | s :: rest when forall isnum (explode s) -> + term_of_rat(num_of_string s),rest + | s :: "(" :: rest when forall isalnum (explode s) -> + let e,rst = parse_bracketed parse_expression rest in + mk_comb(assoc s maxima_funs,e),rst + | s :: rest when forall isalnum (explode s) -> mk_realvar s,rest +and parse_exp inp = parse_general_infix "^" parse_atomic_expression inp +and parse_neg inp = + match inp with + | "-" :: rest -> let e,rst = parse_neg rest in mk_uneg e,rst + | _ -> parse_exp inp +and parse_expression inp = + itlist parse_general_infix (map fst maxima_ops) parse_neg inp;; + +let hol_of_string = fst o parse_expression o lexe;; + +hol_of_string "sin(x) - cos(-(- - 1 + x))";; + +let FACTOR_CONV tm = + let s = "factor("^string_of_hol tm^")" in + let tm' = hol_of_string(maximas s) in + REAL_RING(mk_eq(tm,tm'));; + +FACTOR_CONV `&1234567890`;; + +FACTOR_CONV `x pow 6 - &1`;; + +FACTOR_CONV `r * (r * x * (&1 - x)) * (&1 - r * x * (&1 - x)) - x`;; + +let ANTIDERIV_CONV tm = + let x,bod = dest_abs tm in + let s = "integrate("^string_of_hol bod^","^fst(dest_var x)^")" in + let tm' = mk_abs(x,hol_of_string(maximas s)) in + let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) + (SPEC x (DIFF_CONV tm')) in + let th2 = REAL_RING(mk_eq(lhand(concl th1),bod)) in + GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; + +ANTIDERIV_CONV `\x. (x + &5) pow 2 + &77 * x`;; + +ANTIDERIV_CONV `\x. sin(x) + x pow 11`;; + +(**** This one fails +ANTIDERIV_CONV `\x. sin(x) pow 3`;; + ****) + +let SIN_N_CLAUSES = prove + (`(sin(&(NUMERAL(BIT0 n)) * x) = + &2 * sin(&(NUMERAL n) * x) * cos(&(NUMERAL n) * x)) /\ + (sin(&(NUMERAL(BIT1 n)) * x) = + sin(&(NUMERAL(BIT0 n)) * x) * cos(x) + + sin(x) * cos(&(NUMERAL(BIT0 n)) * x)) /\ + (cos(&(NUMERAL(BIT0 n)) * x) = + cos(&(NUMERAL n) * x) pow 2 - sin(&(NUMERAL n) * x) pow 2) /\ + (cos(&(NUMERAL(BIT1 n)) * x) = + cos(&(NUMERAL(BIT0 n)) * x) * cos(x) - + sin(x) * sin(&(NUMERAL(BIT0 n)) * x))`, + REWRITE_TAC[REAL_MUL_2; REAL_POW_2] THEN + REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; SIN_ADD; COS_ADD; REAL_MUL_LID] THEN + CONV_TAC REAL_RING);; + +let TRIG_IDENT_TAC x = + REWRITE_TAC[SIN_N_CLAUSES; SIN_ADD; COS_ADD] THEN + REWRITE_TAC[REAL_MUL_LZERO; SIN_0; COS_0; REAL_MUL_RZERO] THEN + MP_TAC(SPEC x SIN_CIRCLE) THEN CONV_TAC REAL_RING;; + +let ANTIDERIV_CONV tm = + let x,bod = dest_abs tm in + let s = "expand(integrate("^string_of_hol bod^","^fst(dest_var x)^"))" in + let tm' = mk_abs(x,hol_of_string(maximas s)) in + let th1 = CONV_RULE (NUM_REDUCE_CONV THENC REAL_RAT_REDUCE_CONV) + (SPEC x (DIFF_CONV tm')) in + let th2 = prove(mk_eq(lhand(concl th1),bod),TRIG_IDENT_TAC x) in + GEN x (GEN_REWRITE_RULE LAND_CONV [th2] th1);; + +time ANTIDERIV_CONV `\x. sin(x) pow 3`;; + +time ANTIDERIV_CONV `\x. sin(x) * sin(x) pow 5 * cos(x) pow 4 + cos(x)`;; + +let FCT1_WEAK = prove + (`(!x. (f diffl f'(x)) x) ==> !x. &0 <= x ==> defint(&0,x) f' (f x - f(&0))`, + MESON_TAC[FTC1]);; + +let INTEGRAL_CONV tm = + let th1 = MATCH_MP FCT1_WEAK (ANTIDERIV_CONV tm) in + (CONV_RULE REAL_RAT_REDUCE_CONV o + REWRITE_RULE[SIN_0; COS_0; REAL_MUL_LZERO; REAL_MUL_RZERO] o + CONV_RULE REAL_RAT_REDUCE_CONV o BETA_RULE) th1;; + +INTEGRAL_CONV `\x. sin(x) pow 13`;; diff --git a/Unity/aux_definitions.ml b/Unity/aux_definitions.ml new file mode 100644 index 0000000..9d4384b --- /dev/null +++ b/Unity/aux_definitions.ml @@ -0,0 +1,70 @@ +(* + File: aux_definitions.ml + + Description: This file defines a few useful functions + + Author: (c) Copyright 1989-2008 by Flemming Andersen + Date: October 23, 1989 + Last Update: December 30, 2007 +*) + +let prove_thm ((thm_name:string), thm_term, thm_tactic) = + prove (thm_term, thm_tactic);; + +(* Uniform error facility *) +let UNITY_ERR (func,mesg) = ( failwith func, Failure mesg );; + +(*----------------------------------------------------------------------*) +(* Auxilliary definitions *) +(*----------------------------------------------------------------------*) + +let UNDISCH_ALL_TAC = + let th_tac (th:thm) (tac:tactic) = (MP_TAC th) THEN tac in + let u_asml (thml:thm list) = itlist th_tac thml ALL_TAC in + POP_ASSUM_LIST u_asml + ;; + +let UNDISCH_ONE_TAC = + let th_tac (th:thm) (tac:tactic) = (UNDISCH_TAC (concl th)) THEN tac in + let u_asm (th:thm) = itlist th_tac [th] ALL_TAC in + FIRST_ASSUM u_asm + ;; + +let LIST_INDUCT = list_INDUCT;; + +let CONTRAPOS = + let a = `a:bool` and b = `b:bool` in + let pth = ITAUT `(a ==> b) ==> (~b ==> ~a)` in + fun th -> + try let P,Q = dest_imp(concl th) in + MP (INST [P,a; Q,b] pth) th + with Failure _ -> failwith "CONTRAPOS";; + + +let OP_FIX = 200;; + +let new_infix_definition (define_name, name_org, define_term, fixity) = +( + let defined_thm = new_definition define_term in + let (infix_num, assoc_str) = get_infix_status name_org in + let defined_infix = + ( parse_as_infix ( define_name, (infix_num + fixity, assoc_str) ) ) in + (fst (defined_thm, defined_infix)) +);; + +(* +get_infix_status +infixes();; + +get_prefix_status + +prefixes();; + +*) + +let new_binder_definition def_term def_binder = +( + let def_thm = ( new_definition def_term ) in + let def_bind = ( parse_as_binder def_binder ) in + (fst (def_thm, def_bind)) +);; diff --git a/Unity/make.ml b/Unity/make.ml new file mode 100644 index 0000000..311d847 --- /dev/null +++ b/Unity/make.ml @@ -0,0 +1,22 @@ +(*-------------------------------------------------------------------------*) +(* + File: unity + Description: + + This file loads and opens the HOL Light theory unity, called HOL_UNITY + + Author: Flemming Andersen + Date: November 17, 2003 +*) +(*-------------------------------------------------------------------------*) + +loadt "Examples/hol88.ml";; + +loadt "Unity/aux_definitions.ml";; +loadt "Unity/mk_state_logic.ml";; +loadt "Unity/mk_unless.ml";; +loadt "Unity/mk_ensures.ml";; +loadt "Unity/mk_gen_induct.ml";; +loadt "Unity/mk_leadsto.ml";; +loadt "Unity/mk_comp_unity.ml";; +loadt "Unity/mk_unity_prog.ml";; diff --git a/Unity/mk_comp_unity.ml b/Unity/mk_comp_unity.ml new file mode 100644 index 0000000..526d4be --- /dev/null +++ b/Unity/mk_comp_unity.ml @@ -0,0 +1,551 @@ +(*---------------------------------------------------------------------------*) +(* + File: mk_comp_unity.ml + + Description: This file proves the unity compositionality theorems and + corrollaries valid. + + Author: (c) Copyright 1989-2008 by Flemming Andersen + Date: December 1, 1989 + Last Update: December 30, 2007 +*) +(*---------------------------------------------------------------------------*) + +(*---------------------------------------------------------------------------*) +(* + Theorems +*) +(*---------------------------------------------------------------------------*) + +(* + Prove: + !p q FPr GPr. + (p UNLESS q) (APPEND FPr GPr) ==> (p UNLESS q) FPr /\ (p UNLESS q) GPr +*) +let COMP_UNLESS_thm1_lemma_1 = TAC_PROOF + (([], + (`!(p:'a->bool) q FPr GPr. + (p UNLESS q) (APPEND FPr GPr) ==> (p UNLESS q) FPr /\ (p UNLESS q) GPr`)), + REPEAT GEN_TAC THEN + SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN + SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN + LIST_INDUCT_TAC THENL + [ + REWRITE_TAC [UNLESS;APPEND] + ; + REWRITE_TAC [APPEND] THEN + REWRITE_TAC [UNLESS] THEN + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + RES_TAC + ; + RES_TAC]]);; + +(* + Prove: + !p q FPr GPr. + (p UNLESS q) FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr) +*) +let COMP_UNLESS_thm1_lemma_2 = TAC_PROOF + (([], + (`!(p:'a->bool) q FPr GPr. + (p UNLESS q) FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr)`)), + REPEAT GEN_TAC THEN + SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN + SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN + LIST_INDUCT_TAC THENL + [ + REWRITE_TAC [UNLESS;APPEND] + ; + REWRITE_TAC [APPEND] THEN + REWRITE_TAC [UNLESS] THEN + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + RES_TAC + ]]);; + + +(* + Prove: + !p q FPr GPr. + (p UNLESS q) (APPEND FPr GPr) = (p UNLESS q) FPr /\ (p UNLESS q) GPr +*) +let COMP_UNLESS_thm1 = prove_thm + ("COMP_UNLESS_thm1", + (`!(p:'a->bool) q FPr GPr. + (p UNLESS q) (APPEND FPr GPr) <=> (p UNLESS q) FPr /\ (p UNLESS q) GPr`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL COMP_UNLESS_thm1_lemma_1) + (SPEC_ALL COMP_UNLESS_thm1_lemma_2)));; + + +(* + Prove: + !p q FPr GPr. + (p ENSURES q) (APPEND FPr GPr) ==> (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ + (p ENSURES q) GPr /\ (p UNLESS q) FPr +*) +let COMP_ENSURES_thm1_lemma_1 = TAC_PROOF + (([], + (`!(p:'a->bool) q FPr GPr. + (p ENSURES q) (APPEND FPr GPr) ==> (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ + (p ENSURES q) GPr /\ (p UNLESS q) FPr`)), + REPEAT GEN_TAC THEN + SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN + SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN + LIST_INDUCT_TAC THENL + [ + REWRITE_TAC [ENSURES;EXIST_TRANSITION;UNLESS;APPEND] + ; + GEN_TAC THEN + REWRITE_TAC [ENSURES;EXIST_TRANSITION;UNLESS;APPEND] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC [] THENL + [ + DISJ1_TAC THEN + ASM_REWRITE_TAC [] THEN + ASM_REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL COMP_UNLESS_thm1))] + ; + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS q)(APPEND t GPr)`); + (`((p:'a->bool) EXIST_TRANSITION q)(APPEND t GPr)`)] + AND_INTRO_THM)) THEN + UNDISCH_TAC (`((p:'a->bool) UNLESS q)(APPEND t GPr) /\ + (p EXIST_TRANSITION q)(APPEND t GPr)`) THEN + REWRITE_TAC [SPECL [(`q:'a->bool`); (`p:'a->bool`); + (`APPEND (t:('a->'a)list) GPr`)] + (GEN_ALL (SYM (SPEC_ALL ENSURES)))] THEN + DISCH_TAC THEN + RES_TAC THENL + [ + UNDISCH_TAC (`((p:'a->bool) ENSURES q) t`) THEN + REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] + ; + UNDISCH_TAC (`((p:'a->bool) ENSURES q) GPr`) THEN + REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] + ]]]);; + +(* + Prove: + !p q FPr GPr. + (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ + (p ENSURES q) GPr /\ (p UNLESS q) FPr ==> (p ENSURES q) (APPEND FPr GPr) +*) +let COMP_ENSURES_thm1_lemma_2 = TAC_PROOF + (([], + `!(p:'a->bool) q FPr GPr. + ((p ENSURES q) FPr /\ (p UNLESS q) GPr \/ + (p ENSURES q) GPr /\ (p UNLESS q) FPr) + ==> (p ENSURES q) (APPEND FPr GPr)`), + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [ENSURES;EXIST_TRANSITION;UNLESS;APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [COMP_UNLESS_thm1;ENSURES;EXIST_TRANSITION; + UNLESS;APPEND] THEN + REWRITE_TAC [UNDISCH_ALL (ONCE_REWRITE_RULE [EXIST_TRANSITION_thm12] + (SPEC_ALL EXIST_TRANSITION_thm8))] THENL + [ + REWRITE_TAC + [ONCE_REWRITE_RULE [EXIST_TRANSITION_thm12] (UNDISCH_ALL (SPECL + [`p:'a->bool`;`q:'a->bool`;`t:('a->'a)list`;`GPr:('a->'a)list`] + EXIST_TRANSITION_thm8))] + ; + REWRITE_TAC + [UNDISCH_ALL + (SPECL [`p:'a->bool`;`q:'a->bool`;`GPr:('a->'a)list`;`t:('a->'a)list`] + EXIST_TRANSITION_thm8)] + ]);; + +(* + Prove: + !p q FPr GPr. + (p ENSURES q) (APPEND FPr GPr) = (p ENSURES q) FPr /\ (p UNLESS q) GPr \/ + (p ENSURES q) GPr /\ (p UNLESS q) FPr +*) +let COMP_ENSURES_thm1 = prove_thm + ("COMP_ENSURES_thm1", + (`!(p:'a->bool) q FPr GPr. + (p ENSURES q) (APPEND FPr GPr) <=> + ((p ENSURES q) FPr /\ (p UNLESS q) GPr \/ + (p ENSURES q) GPr /\ (p UNLESS q) FPr)`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL COMP_ENSURES_thm1_lemma_1) + (SPEC_ALL COMP_ENSURES_thm1_lemma_2)));; + +(* + Prove: + |- !p q FPr GPr. + (p ENSURES q)FPr /\ (p UNLESS q)GPr ==> (p ENSURES q)(APPEND FPr GPr) +*) +let COMP_ENSURES_cor0 = prove_thm + ("COMP_ENSURES_cor0", + (`!(p:'a->bool) q FPr GPr. + (p ENSURES q) FPr /\ (p UNLESS q) GPr + ==> (p ENSURES q) (APPEND FPr GPr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`((p:'a->bool) ENSURES q)FPr`);ASSUME (`((p:'a->bool) UNLESS q)GPr`)] + (SPEC_ALL COMP_ENSURES_thm1)));; + + +(* + Prove: + |- !p q FPr GPr. + (p ENSURES q)GPr /\ (p UNLESS q)FPr ==> (p ENSURES q)(APPEND FPr GPr) +*) +let COMP_ENSURES_cor1 = prove_thm + ("COMP_ENSURES_cor1", + (`!(p:'a->bool) q FPr GPr. + (p ENSURES q) GPr /\ (p UNLESS q) FPr + ==> (p ENSURES q) (APPEND FPr GPr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`((p:'a->bool) ENSURES q)GPr`);ASSUME (`((p:'a->bool) UNLESS q)FPr`)] + (SPEC_ALL COMP_ENSURES_thm1)));; + + +(* + Prove: + !p q FPr GPr. + (p INVARIANT q) (APPEND FPr GPr) = + (p INVARIANT q) FPr /\ (p INVARIANT q) GPr +*) +let COMP_UNITY_cor0 = prove_thm + ("COMP_UNITY_cor0", + (`!(p0:'a->bool) p FPr GPr. + (p INVARIANT (p0, APPEND FPr GPr)) = + (p INVARIANT (p0,FPr) /\ p INVARIANT (p0,GPr))`), + REWRITE_TAC [INVARIANT;STABLE;COMP_UNLESS_thm1] THEN + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN + RES_TAC THEN ASM_REWRITE_TAC []);; + + +(* + Prove: + !p FPr GPr. + p STABLE (APPEND FPr GPr) = p STABLE FPr /\ p STABLE GPr +*) +let COMP_UNITY_cor1 = prove_thm + ("COMP_UNITY_cor1", + (`!(p:'a->bool) FPr GPr. + (p STABLE (APPEND FPr GPr)) = (p STABLE FPr /\ p STABLE GPr)`), + REWRITE_TAC [STABLE;COMP_UNLESS_thm1]);; + + +(* + Prove: + !p q FPr GPr. + (p UNLESS q) FPr /\ p STABLE GPr ==>(p UNLESS q) (APPEND FPr GPr) +*) +let COMP_UNITY_cor2 = prove_thm + ("COMP_UNITY_cor2", + (`!(p:'a->bool) q FPr GPr. + (p UNLESS q) FPr /\ p STABLE GPr ==>(p UNLESS q) (APPEND FPr GPr)`), + REWRITE_TAC [STABLE;COMP_UNLESS_thm1] THEN + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + UNDISCH_TAC (`((p:'a->bool) UNLESS False)GPr`) THEN + SPEC_TAC ((`GPr:('a->'a)list`),(`GPr:('a->'a)list`)) THEN + LIST_INDUCT_TAC THENL + [ + REWRITE_TAC [UNLESS] + ; + REWRITE_TAC [UNLESS;UNLESS_STMT] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THENL + [ + RES_TAC THEN + UNDISCH_TAC + (`~(False:'a->bool) s ==> (p:'a->bool)(h s) \/ False(h s)`) THEN + REWRITE_TAC [FALSE_def;NOT_CLAUSES;OR_INTRO_THM1] + ; + RES_TAC]]]);; + + +(* + Prove: + !p0 p FPr GPr. + p INVARIANT (p0; FPr) /\ p STABLE GPr + ==> p INVARIANT (p0; (APPEND FPr GPr)) +*) +let COMP_UNITY_cor3 = prove_thm + ("COMP_UNITY_cor3", + (`!(p0:'a->bool) p FPr GPr. + p INVARIANT (p0, FPr) /\ p STABLE GPr ==> + p INVARIANT (p0, (APPEND FPr GPr))`), + REWRITE_TAC [INVARIANT;STABLE;COMP_UNLESS_thm1] THEN + REPEAT STRIP_TAC THENL + [ + RES_TAC + ; + ASM_REWRITE_TAC [] + ; + ASM_REWRITE_TAC []]);; + + +(* + Prove: + !p q FPr GPr. + (p ENSURES q) FPr /\ p STABLE GPr ==> (p ENSURES q) (APPEND FPr GPr) +*) +let COMP_UNITY_cor4 = prove_thm + ("COMP_UNITY_cor4", + (`!(p:'a->bool) q FPr GPr. + (p ENSURES q) FPr /\ p STABLE GPr ==> (p ENSURES q) (APPEND FPr GPr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`);(`q:'a->bool`);(`FPr:('a->'a)list`)] ENSURES_cor2)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS q)FPr`);(`(p:'a->bool) STABLE GPr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`);(`q:'a->bool`);(`FPr:('a->'a)list`);(`GPr:('a->'a)list`)] + COMP_UNITY_cor2)) THEN + REWRITE_TAC [ENSURES] THEN + ASM_REWRITE_TAC [] THEN + UNDISCH_TAC (`((p:'a->bool) ENSURES q)FPr`) THEN + REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + UNDISCH_TAC (`((p:'a->bool) EXIST_TRANSITION q)FPr`) THEN + SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN + LIST_INDUCT_TAC THENL + [ + REWRITE_TAC [EXIST_TRANSITION] + ; + REWRITE_TAC [APPEND;EXIST_TRANSITION] THEN + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + RES_TAC THEN + ASM_REWRITE_TAC []]]);; + +(* + Prove: + !p q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) GPr +*) +let COMP_UNITY_cor5 = prove_thm + ("COMP_UNITY_cor5", + (`!(p:'a->bool) q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) GPr`), + REWRITE_TAC [COMP_UNLESS_thm1] THEN + REPEAT STRIP_TAC);; + +(* + Prove: + !p q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) FPr +*) +let COMP_UNITY_cor6 = prove_thm + ("COMP_UNITY_cor6", + (`!(p:'a->bool) q FPr GPr. (p UNLESS q)(APPEND FPr GPr) ==> (p UNLESS q) FPr`), + REWRITE_TAC [COMP_UNLESS_thm1] THEN + REPEAT STRIP_TAC);; + +(* + Prove: + !p q st FPr. (p UNLESS q)(CONS st FPr) ==> (p UNLESS q) FPr +*) +let COMP_UNITY_cor7 = prove_thm + ("COMP_UNITY_cor7", + (`!(p:'a->bool) q st FPr. (p UNLESS q)(CONS st FPr) ==> (p UNLESS q) FPr`), + REWRITE_TAC [UNLESS] THEN + REPEAT STRIP_TAC);; + +(* + Prove: + !p FPr GPr. + (p ENSURES (NotX p)) FPr ==> (p ENSURES (NotX p)) (APPEND FPr GPr) +*) +let COMP_UNITY_cor8 = prove_thm + ("COMP_UNITY_cor8", + (`!(p:'a->bool) FPr GPr. + (p ENSURES (Not p)) FPr ==> (p ENSURES (Not p)) (APPEND FPr GPr)`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND;ENSURES;UNLESS;EXIST_TRANSITION] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [UNLESS_thm2] THEN + REWRITE_TAC [UNDISCH_ALL (ONCE_REWRITE_RULE [EXIST_TRANSITION_thm12] (SPECL + [`p:'a->bool`;`Not (p:'a->bool)`;`t:('a->'a)list`;`GPr:('a->'a)list`] + EXIST_TRANSITION_thm8))]);; + +(* + Prove: + !p q FPr GPr. + p STABLE FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr) +*) +let COMP_UNITY_cor9 = prove_thm + ("COMP_UNITY_cor9", + (`!(p:'a->bool) q FPr GPr. + p STABLE FPr /\ (p UNLESS q) GPr ==> (p UNLESS q) (APPEND FPr GPr)`), + REWRITE_TAC [STABLE;COMP_UNLESS_thm1] THEN + REPEAT STRIP_TAC THENL + [ + UNDISCH_TAC (`((p:'a->bool) UNLESS False)FPr`) THEN + SPEC_TAC ((`FPr:('a->'a)list`),(`FPr:('a->'a)list`)) THEN + LIST_INDUCT_TAC THENL + [ + REWRITE_TAC [UNLESS] + ; + REWRITE_TAC [UNLESS;UNLESS_STMT] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THENL + [ + RES_TAC THEN + UNDISCH_TAC + (`~(False:'a->bool) s ==> (p:'a->bool)(h s) \/ False(h s)`) THEN + REWRITE_TAC [FALSE_def;NOT_CLAUSES;OR_INTRO_THM1] + ; + RES_TAC + ] + ] + ; + ASM_REWRITE_TAC [] + ]);; + + +(* + Prove: + !p q FPr GPr. + (p UNLESS q) (APPEND FPr GPr) = (p UNLESS q) (APPEND GPr FPr) +*) +let COMP_UNITY_cor10 = prove_thm + ("COMP_UNITY_cor10", + (`!(p:'a->bool) q FPr GPr. + (p UNLESS q) (APPEND FPr GPr) = (p UNLESS q) (APPEND GPr FPr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [COMP_UNLESS_thm1] THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +(* + Prove: + !p q FPr GPr. + (p ENSURES q) (APPEND FPr GPr) = (p ENSURES q) (APPEND GPr FPr) +*) +let COMP_UNITY_cor11 = prove_thm + ("COMP_UNITY_cor11", + (`!(p:'a->bool) q FPr GPr. + (p ENSURES q) (APPEND FPr GPr) = (p ENSURES q) (APPEND GPr FPr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [COMP_ENSURES_thm1] THEN + EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +(* + Prove: + !p q FPr GPr. + (p LEADSTO q) (APPEND FPr GPr) = (p LEADSTO q) (APPEND GPr FPr) +*) + +(* + |- (!p' q'. + ((p' ENSURES q')(APPEND Pr1 Pr2) ==> (p' LEADSTO q')(APPEND Pr2 Pr1)) /\ + (!r. + (p' LEADSTO r)(APPEND Pr1 Pr2) /\ (p' LEADSTO r)(APPEND Pr2 Pr1) /\ + (r LEADSTO q')(APPEND Pr1 Pr2) /\ (r LEADSTO q')(APPEND Pr2 Pr1) ==> + (p' LEADSTO q')(APPEND Pr1 Pr2) ==> (p' LEADSTO q')(APPEND Pr2 Pr1)) /\ + (!P. + (!i. ((P i) LEADSTO q')(APPEND Pr1 Pr2)) /\ + (!i. ((P i) LEADSTO q')(APPEND Pr2 Pr1)) ==> + (($ExistsX P) LEADSTO q')(APPEND Pr1 Pr2) ==> + (($ExistsX P) LEADSTO q')(APPEND Pr2 Pr1))) + ==> + (p LEADSTO q)(APPEND Pr1 Pr2) ==> (p LEADSTO q)(APPEND Pr2 Pr1) +*) +let COMP_UNITY_cor12_lemma00 = (BETA_RULE (SPECL + [(`\(p:'a->bool) q. (p LEADSTO q)(APPEND Pr2 Pr1)`); + (`p:'a->bool`);(`q:'a->bool`);(`APPEND (Pr1:('a->'a)list) Pr2`)] LEADSTO_thm37));; + +let COMP_UNITY_cor12_lemma01 = TAC_PROOF + (([], + (`!(p':'a->bool) q' Pr1 Pr2. + (p' ENSURES q')(APPEND Pr1 Pr2) ==> (p' LEADSTO q')(APPEND Pr2 Pr1)`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (ONCE_REWRITE_RULE [COMP_UNITY_cor11] (ASSUME + (`((p':'a->bool) ENSURES q')(APPEND Pr1 Pr2)`))) THEN + IMP_RES_TAC LEADSTO_thm0);; + +let COMP_UNITY_cor12_lemma02 = TAC_PROOF + (([], + (`!(p':'a->bool) q' Pr1 Pr2. + (!r. + (p' LEADSTO r)(APPEND Pr1 Pr2) /\ (p' LEADSTO r)(APPEND Pr2 Pr1) /\ + (r LEADSTO q')(APPEND Pr1 Pr2) /\ (r LEADSTO q')(APPEND Pr2 Pr1) + ==> (p' LEADSTO q')(APPEND Pr2 Pr1))`)), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm1);; + +let COMP_UNITY_cor12_lemma03 = TAC_PROOF + (([], + (`!(p':'a->bool) q' Pr1 Pr2. + (!P:('a->bool)->bool. + (!p''. p'' In P ==> (p'' LEADSTO q')(APPEND Pr1 Pr2)) /\ + (!p''. p'' In P ==> (p'' LEADSTO q')(APPEND Pr2 Pr1)) + ==> ((LUB P) LEADSTO q')(APPEND Pr2 Pr1))`)), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm3a);; + +(* + |- !p q Pr1 Pr2. + (p LEADSTO q)(APPEND Pr1 Pr2) ==> (p LEADSTO q)(APPEND Pr2 Pr1) +*) +let COMP_UNITY_cor12_lemma04 = (GEN_ALL (REWRITE_RULE + [COMP_UNITY_cor12_lemma01;COMP_UNITY_cor12_lemma02;COMP_UNITY_cor12_lemma03] + (SPEC_ALL COMP_UNITY_cor12_lemma00)));; + +(* + |- !p q Pr1 Pr2. (p LEADSTO q)(APPEND Pr1 Pr2) = (p LEADSTO q)(APPEND Pr2 Pr1) +*) +let COMP_UNITY_cor12 = prove_thm + ("COMP_UNITY_cor12", + (`!(p:'a->bool) q Pr1 Pr2. + (p LEADSTO q)(APPEND Pr1 Pr2) = (p LEADSTO q)(APPEND Pr2 Pr1)`), + REPEAT GEN_TAC THEN + EQ_TAC THEN REWRITE_TAC [COMP_UNITY_cor12_lemma04]);; + +(* + |- !p FPr GPr. p STABLE (APPEND FPr GPr) = p STABLE (APPEND GPr FPr) +*) +let COMP_UNITY_cor13 = prove_thm + ("COMP_UNITY_cor13", + (`!(p:'a->bool) FPr GPr. + (p STABLE (APPEND FPr GPr)) = (p STABLE (APPEND GPr FPr))`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + EQ_TAC THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC [COMP_UNITY_cor10] THEN + ASM_REWRITE_TAC []);; + + +(* + |- !p0 p FPr GPr. + p INVARIANT (p0, APPEND FPr GPr) = p INVARIANT (p0, APPEND GPr FPr) +*) +let COMP_UNITY_cor14 = prove_thm + ("COMP_UNITY_cor14", + (`!(p0:'a->bool) p FPr GPr. + (p INVARIANT (p0, (APPEND FPr GPr))) + = + (p INVARIANT (p0, (APPEND GPr FPr)))`), + REPEAT GEN_TAC THEN + REWRITE_TAC [INVARIANT] THEN + EQ_TAC THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC [COMP_UNITY_cor13] THEN + ASM_REWRITE_TAC []);; diff --git a/Unity/mk_ensures.ml b/Unity/mk_ensures.ml new file mode 100644 index 0000000..8be7e2c --- /dev/null +++ b/Unity/mk_ensures.ml @@ -0,0 +1,710 @@ +(*---------------------------------------------------------------------------*) +(* + File: mk_ensures.sml + + Description: This file defines ENSURES and the theorems and corrollaries + described in [CM88]. + + Author: (c) Copyright 1989-2008 by Flemming Andersen + Date: June 29, 1989 + Last Update: December 30, 2007 +*) +(*---------------------------------------------------------------------------*) + +(*---------------------------------------------------------------------------*) +(* The definition of ENSURES is based on the definition: + + p ensures q in Pr =

+ + where p and q are state dependent first order logic predicates and s + in the program Pr are conditionally enabled statements transforming + a state into a new state. ENSURES then requires safety and the + existance of at least one state transition statement s which makes q + valid. +*) + +let EXIST_TRANSITION_term = + `(!p q. EXIST_TRANSITION (p:'a->bool) q [] <=> F) /\ + (!p q. EXIST_TRANSITION p q (CONS (st:'a->'a) Pr) <=> + ((!s. (p s /\ ~q s) ==> q (st s)) \/ (EXIST_TRANSITION p q Pr)))`;; +let EXIST_TRANSITION = new_recursive_definition + list_RECURSION EXIST_TRANSITION_term;; +parse_as_infix ( "EXIST_TRANSITION", (TL_FIX, "right") );; + +let ENSURES = new_infix_definition + ("ENSURES", "<=>", + `!(p:'a->bool) q (Pr:('a->'a)list). + ENSURES p q Pr = (((p UNLESS q) Pr) /\ ((p EXIST_TRANSITION q) Pr))`, + TL_FIX);; + +let ENSURES_STMT = new_infix_definition + ("ENSURES_STMT", "<=>", + `!(p:'a->bool) q (st:'a->'a). + ENSURES_STMT p q st = (\s. p s /\ ~(q s) ==> q (st s))`, + TL_FIX);; + + +(*-------------------------------------------------------------------------*) +(* + Lemmas +*) +(*-------------------------------------------------------------------------*) + +let ENSURES_lemma0 = TAC_PROOF + (([], + (`!(p:'a->bool) q r st. + ((!s. p s /\ ~q s ==> q (st s)) /\ (!s. q s ==> r s)) ==> + (!s. p s /\ ~r s ==> r (st s))`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (CONTRAPOS (SPEC_ALL (ASSUME (`!s:'a. q s ==> r s`)))) THEN + ASSUME_TAC (SPEC (`(st:'a->'a) s`) (ASSUME (`!s:'a. q s ==> r s`))) THEN + RES_TAC THEN + RES_TAC);; + +set_goal([], + (`!(p:'a->bool) p' q q' h. + (!s. (p UNLESS_STMT q) h s) ==> + (!s. (p' UNLESS_STMT q') h s) ==> + (!s. p' s /\ ~q' s ==> q' (h s)) ==> + (!s. (p /\* p') s /\ ~((p /\* q' \/* p' /\* q) \/* q /\* q') s) ==> + (((p /\* q' \/* p' /\* q) \/* q /\* q') (h s))`) +);; + +let ENSURES_lemma1 = TAC_PROOF + (([], + `!(p:'a->bool) p' q q' h. + (!s. (p UNLESS_STMT q) h s) ==> + (!s. (p' UNLESS_STMT q') h s) ==> + (!s. p' s /\ ~q' s ==> q' (h s)) ==> + (!s. (p /\* p') s /\ ~((p /\* q' \/* p' /\* q) \/* q /\* q') s + ==> ((p /\* q' \/* p' /\* q) \/* q /\* q') (h s))`), + REWRITE_TAC [UNLESS_STMT; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + MESON_TAC []);; + +let ENSURES_lemma2 = TAC_PROOF + (([], + (`!(p:'a->bool) q r st. + (!s. p s /\ ~q s ==> q (st s)) ==> + (!s. (p s \/ r s) /\ ~(q s \/ r s) ==> q (st s) \/ r (st s))`)), + REWRITE_TAC [(GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC))); + (SYM (SPEC_ALL DISJ_ASSOC));NOT_CLAUSES;DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN RES_TAC THEN + ASM_REWRITE_TAC []);; + +let ENSURES_lemma3 = TAC_PROOF + (([], + (`!(p:'a->bool) q r Pr. (p ENSURES (q \/* r)) Pr ==> + (((p /\* (Not q)) \/* (p /\* q)) ENSURES (q \/* r)) Pr`)), + REWRITE_TAC [AND_COMPL_OR_lemma]);; + +let ENSURES_lemma4 = TAC_PROOF + (([], + `!(p:'a->bool) q r (st:'a->'a). + (!s. p s /\ ~q s ==> q (st s)) ==> + (!s. (p \/* r) s /\ ~(q \/* r) s ==> (q \/* r) (st s))`), + REPEAT GEN_TAC THEN + REWRITE_TAC [OR_def] THEN + MESON_TAC []);; + +(*---------------------------------------------------------------------------*) +(* + Theorems about EXIST_TRANSITION +*) +(*---------------------------------------------------------------------------*) + +(* + EXIST_TRANSITION Consequence Weakening Theorem: + + p EXIST_TRANSITION q in Pr; q ==> r + ------------------------------------- + p EXIST_TRANSITION r in Pr +*) + +let EXIST_TRANSITION_thm1 = prove_thm + ("EXIST_TRANSITION_thm1", + (`!(p:'a->bool) q r Pr. + ((p EXIST_TRANSITION q) Pr /\ (!s. (q s) ==> (r s))) ==> + ((p EXIST_TRANSITION r) Pr)`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [EXIST_TRANSITION] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + REWRITE_TAC [REWRITE_RULE + [ASSUME `!s:'a. p s /\ ~q s ==> q (h s)`; ASSUME `!s:'a. q s ==> r s`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] ENSURES_lemma0)]);; + +(* + Impossibility EXIST_TRANSITION Theorem: + + p EXIST_TRANSITION false in Pr + -------------------------------- + ~p +*) +let EXIST_TRANSITION_thm2 = prove_thm + ("EXIST_TRANSITION_thm2", + (`!(p:'a->bool) Pr. + ((p EXIST_TRANSITION False) Pr) ==> !s. (Not p) s`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [EXIST_TRANSITION; NOT_def1] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THENL + [ + UNDISCH_TAC (`!s:'a. ((p:'a->bool) s) /\ ~(False s) + ==> (False ((h:'a->'a) s))`) THEN + REWRITE_TAC [FALSE_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) + ; + UNDISCH_TAC (`!s:'a. (Not (p:'a->bool)) s`) THEN + REWRITE_TAC [NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) + ]);; + +(* + Always EXIST_TRANSITION Theorem: + + false EXIST_TRANSITION p in Pr +*) +let EXIST_TRANSITION_thm3 = prove_thm + ("EXIST_TRANSITION_thm3", + (`!(p:'a->bool) st Pr. (False EXIST_TRANSITION p) (CONS st Pr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [EXIST_TRANSITION; FALSE_def]);; + +let EXIST_TRANSITION_thm4 = prove_thm + ("EXIST_TRANSITION_thm4", + (`!(p:'a->bool) q r Pr. + (p EXIST_TRANSITION q) Pr ==> + ((p \/* r) EXIST_TRANSITION (q \/* r)) Pr`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [EXIST_TRANSITION] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + REWRITE_TAC [REWRITE_RULE + [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] + ENSURES_lemma4)]);; + +let APPEND_lemma01 = TAC_PROOF + (([], + `!(l:('a)list). (APPEND l []) = l`), + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [APPEND]);; + +let EXIST_TRANSITION_thm5 = prove_thm + ("EXIST_TRANSITION_thm5", + (`!(p:'a->bool) q st Pr. + (!s. p s /\ ~q s ==> q (st s)) + ==> (p EXIST_TRANSITION q) (CONS st Pr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [EXIST_TRANSITION] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +let APPEND_lemma02 = TAC_PROOF + (([], + `!st (l:('a)list). (APPEND [st] l) = (CONS st l)`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND]);; + +let APPEND_lemma03 = TAC_PROOF + (([], + `!st (l1:('a)list) l2. + (APPEND (APPEND l1 [st]) l2) = (APPEND l1 (CONS st l2))`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND]);; + +let APPEND_lemma04 = TAC_PROOF + (([], + `!st (l1:('a)list) l2. + (APPEND (CONS st l1) l2) = (CONS st (APPEND l1 l2))`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND]);; + +let EXIST_TRANSITION_thm6 = prove_thm + ("EXIST_TRANSITION_thm6", + (`!(p:'a->bool) q st Pr1 Pr2. + (!s. p s /\ ~q s ==> q (st s)) + ==> (p EXIST_TRANSITION q) (APPEND Pr1 (CONS st Pr2))`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [EXIST_TRANSITION;APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC []);; + +let EXIST_TRANSITION_thm7 = prove_thm + ("EXIST_TRANSITION_thm7", + (`!(p:'a->bool) q FPr GPr. + (p EXIST_TRANSITION q) FPr + ==> (p EXIST_TRANSITION q) (APPEND FPr GPr)`), + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [EXIST_TRANSITION;APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND]);; + +let EXIST_TRANSITION_thm8 = prove_thm + ("EXIST_TRANSITION_thm8", + (`!(p:'a->bool) q FPr GPr. + (p EXIST_TRANSITION q) FPr + ==> (p EXIST_TRANSITION q) (APPEND GPr FPr)`), + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THENL + [ + REWRITE_TAC [UNDISCH_ALL (SPECL + [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`;`t':('a->'a)list`;`t:('a->'a)list`] + EXIST_TRANSITION_thm6)] + ; + REWRITE_TAC [REWRITE_RULE [APPEND_lemma03] (SPECL + [`(APPEND (t':('a->'a)list) [h])`] + (ASSUME `!GPr:('a->'a)list. (p EXIST_TRANSITION q) (APPEND GPr t)`))] + ]);; + +let EXIST_TRANSITION_thm9 = prove_thm + ("EXIST_TRANSITION_thm9", + (`!(p:'a->bool) q st FPr GPr. + (p EXIST_TRANSITION q) (APPEND FPr GPr) + ==> (p EXIST_TRANSITION q) (APPEND FPr (CONS st GPr))`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND]);; + +let EXIST_TRANSITION_thm10 = prove_thm + ("EXIST_TRANSITION_thm10", + (`!(p:'a->bool) q st Pr. + (p EXIST_TRANSITION q) Pr ==> (p EXIST_TRANSITION q) (CONS st Pr)`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +let EXIST_TRANSITION_thm11 = prove_thm + ("EXIST_TRANSITION_thm11", + (`!(p:'a->bool) q st Pr. + (p EXIST_TRANSITION q) (APPEND [st] Pr) = + (p EXIST_TRANSITION q) (APPEND Pr [st])`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN + EQ_TAC THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THENL + [ + REWRITE_TAC [REWRITE_RULE [APPEND_lemma02] (SYM (ASSUME + `(((p:'a->bool) EXIST_TRANSITION q) (APPEND [st] t)) <=> + ((p EXIST_TRANSITION q) (APPEND t [st]))`))] THEN + ASM_REWRITE_TAC [EXIST_TRANSITION] + ; + REWRITE_TAC [REWRITE_RULE [APPEND_lemma02] (SYM (ASSUME + `(((p:'a->bool) EXIST_TRANSITION q) (APPEND [st] t)) <=> + ((p EXIST_TRANSITION q) (APPEND t [st]))`))] THEN + ASM_REWRITE_TAC [UNDISCH_ALL (SPECL + [`p:'a->bool`;`q:'a->bool`;`st:'a->'a`;`t:('a->'a)list`] + EXIST_TRANSITION_thm10)] + ; + STRIP_ASSUME_TAC (REWRITE_RULE [APPEND_lemma02;EXIST_TRANSITION] + (ASSUME `((p:'a->bool) EXIST_TRANSITION q) (APPEND [st] t)`)) THEN + ASM_REWRITE_TAC [] + ]);; + +let EXIST_TRANSITION_thm12a = prove_thm + ("EXIST_TRANSITION_thm12a", + (`!(p:'a->bool) q FPr GPr. + (p EXIST_TRANSITION q) (APPEND FPr GPr) ==> + (p EXIST_TRANSITION q) (APPEND GPr FPr)`), + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THENL + [ + REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; + `GPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm6)] + ; + REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; + `GPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm9)] + ]);; + +let EXIST_TRANSITION_thm12b = prove_thm + ("EXIST_TRANSITION_thm12b", + (`!(p:'a->bool) q FPr GPr. + (p EXIST_TRANSITION q) (APPEND GPr FPr) ==> + (p EXIST_TRANSITION q) (APPEND FPr GPr)`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;APPEND;EXIST_TRANSITION] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [APPEND_lemma01;EXIST_TRANSITION;APPEND] THENL + [ + REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; + `FPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm6)] + ; + REWRITE_TAC [UNDISCH_ALL (SPECL [`p:'a->bool`;`q:'a->bool`;`h:'a->'a`; + `FPr:('a->'a)list`;`t:('a->'a)list`] EXIST_TRANSITION_thm9)] + ]);; + +let EXIST_TRANSITION_thm12 = prove_thm + ("EXIST_TRANSITION_thm12", + (`!(p:'a->bool) q FPr GPr. + (p EXIST_TRANSITION q) (APPEND GPr FPr) = + (p EXIST_TRANSITION q) (APPEND FPr GPr)`), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + REWRITE_TAC [UNDISCH_ALL (SPEC_ALL EXIST_TRANSITION_thm12a); + UNDISCH_ALL (SPEC_ALL EXIST_TRANSITION_thm12b)]);; + +(*---------------------------------------------------------------------------*) +(* + Theorems about ENSURES +*) +(*---------------------------------------------------------------------------*) + +(* + Reflexivity Theorem: + + p ensures p in Pr + + The theorem is only valid for non-empty programs +*) +let ENSURES_thm0 = prove_thm + ("ENSURES_thm0", + (`!(p:'a->bool) q. (p ENSURES q) [] = F`), + REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + REWRITE_TAC [UNLESS;EXIST_TRANSITION]);; + +let ENSURES_thm1 = prove_thm + ("ENSURES_thm1", + (`!(p:'a->bool) st Pr. (p ENSURES p) (CONS st Pr)`), + REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + REWRITE_TAC [UNLESS;EXIST_TRANSITION] THEN + REWRITE_TAC [UNLESS_thm1;UNLESS_STMT] THEN + REWRITE_TAC [BETA_CONV (`(\s:'a. (p s /\ ~p s) ==> p (st s))s`)] THEN + REWRITE_TAC[NOT_AND;IMP_CLAUSES]);; + +(* + Consequence Weakening Theorem: + + p ensures q in Pr; q ==> r + ---------------------------- + p ensures r in Pr +*) + +let ENSURES_thm2 = prove_thm + ("ENSURES_thm2", + (`!(p:'a->bool) q r Pr. + ((p ENSURES q) Pr /\ (!s:'a. (q s) ==> (r s))) + ==> + ((p ENSURES r) Pr)`), + REWRITE_TAC [ENSURES] THEN + REPEAT STRIP_TAC THENL + [ + ASSUME_TAC (UNDISCH_ALL (SPEC (`!s:'a. q s ==> r s`) + (SPEC (`((p:'a->bool) UNLESS q) Pr`) AND_INTRO_THM))) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL UNLESS_thm3)) + ; + ASSUME_TAC (UNDISCH_ALL (SPEC (`!s:'a. q s ==> r s`) + (SPEC (`((p:'a->bool) EXIST_TRANSITION q) Pr`) AND_INTRO_THM))) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL EXIST_TRANSITION_thm1)) + ]);; + +(* + Impossibility Theorem: + + p ensures false in Pr + ---------------------- + ~p +*) + +let ENSURES_thm3 = prove_thm + ("ENSURES_thm3", + (`!(p:'a->bool) Pr. ((p ENSURES False) Pr) ==> !s. (Not p)s`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC [ENSURES; UNLESS; EXIST_TRANSITION] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] THENL + [ + UNDISCH_TAC `!s:'a. (p:'a->bool) s /\ ~(False s) ==> False ((h:'a->'a) s)` THEN + REWRITE_TAC [FALSE_def; NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) + ; + IMP_RES_TAC EXIST_TRANSITION_thm2 + ]);; + +(* + Conjunction Theorem: + + p unless q in Pr; p' ensures q' in Pr + ----------------------------------------------- + p/\p' ensures (p/\q')\/(p'/\q)\/(q/\q') in Pr +*) +let ENSURES_thm4 = prove_thm + ("ENSURES_thm4", + (`!(p:'a->bool) q p' q' Pr. + (p UNLESS q) Pr /\ (p' ENSURES q') Pr ==> + ((p /\* p') ENSURES (((p /\* q') \/* (p' /\* q)) \/* (q /\* q'))) + Pr`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [ENSURES;UNLESS;EXIST_TRANSITION] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC [] THENL + [ + REWRITE_TAC + [REWRITE_RULE [ASSUME `!s:'a. ((p:'a->bool) UNLESS_STMT q) (h:'a->'a) s`; + ASSUME `!s:'a. ((p':'a->bool) UNLESS_STMT q') (h:'a->'a) s`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`p':'a->bool`;`q':'a->bool`;`h:'a->'a`] + UNLESS_STMT_thm3)] + ; + REWRITE_TAC + [REWRITE_RULE [ASSUME `((p:'a->bool) UNLESS q) (t:('a->'a)list)`; + ASSUME `((p':'a->bool) UNLESS q') (t:('a->'a)list)`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`p':'a->bool`;`q':'a->bool`;`t:('a->'a)list`] + UNLESS_thm4)] + ; + REWRITE_TAC [REWRITE_RULE + [ASSUME `!s:'a. ((p:'a->bool) UNLESS_STMT q) (h:'a->'a) s`; + ASSUME `!s:'a. ((p':'a->bool) UNLESS_STMT q') (h:'a->'a) s`; + ASSUME `!s:'a. (p':'a->bool) s /\ ~(q' s) ==> q' ((h:'a->'a) s)`] + (SPEC_ALL ENSURES_lemma1)] + ; + REWRITE_TAC + [REWRITE_RULE [ASSUME `!s:'a. ((p:'a->bool) UNLESS_STMT q) (h:'a->'a) s`; + ASSUME `!s:'a. ((p':'a->bool) UNLESS_STMT q') (h:'a->'a) s`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`p':'a->bool`;`q':'a->bool`;`h:'a->'a`] + UNLESS_STMT_thm3)] + ; + UNDISCH_TAC `((p:'a->bool) UNLESS q) t /\ (p' ENSURES q') (t:('a->'a)list) + ==> (p /\* p' ENSURES (p /\* q' \/* p' /\* q) \/* q /\* q') t` THEN + ASM_REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] + ; + UNDISCH_TAC `((p:'a->bool) UNLESS q) t /\ (p' ENSURES q') (t:('a->'a)list) + ==> (p /\* p' ENSURES (p /\* q' \/* p' /\* q) \/* q /\* q') t` THEN + ASM_REWRITE_TAC [ENSURES] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] + ]);; + +(* + Conjunction Theorem: + + p ensures q in Pr + ------------------------- + p\/r ensures q\/r in Pr +*) + +let ENSURES_thm5 = prove_thm + ("ENSURES_thm5", + (`!(p:'a->bool) q r Pr. + ((p ENSURES q) Pr) ==> (((p \/* r) ENSURES (q \/* r)) Pr)`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [ENSURES;UNLESS;EXIST_TRANSITION] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC [] THENL + [ + IMP_RES_TAC UNLESS_STMT_thm6 THEN + ASM_REWRITE_TAC [] + ; + IMP_RES_TAC UNLESS_cor23 THEN + ASM_REWRITE_TAC [] + ; + REWRITE_TAC [REWRITE_RULE + [ASSUME `!s:'a. (p:'a->bool) s /\ ~q s ==> q (h s)`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`r:'a->bool`;`h:'a->'a`] + ENSURES_lemma4)] + ; + IMP_RES_TAC UNLESS_STMT_thm6 THEN + ASM_REWRITE_TAC [] + ; + IMP_RES_TAC UNLESS_cor23 THEN + ASM_REWRITE_TAC [] + ; + IMP_RES_TAC EXIST_TRANSITION_thm4 THEN + ASM_REWRITE_TAC [] + ]);; + +(* + ----------------------------------------------------------------------------- + Corollaries about ENSURES + ----------------------------------------------------------------------------- +*) + +(* + Implies Corollary: + + p => q + ------------------- + p ensures q in Pr + + This corollary is only valid for non-empty programs. +*) + +let ENSURES_cor1 = prove_thm + ("ENSURES_cor1", + (`!(p:'a->bool) q st Pr. + (!s. p s ==> q s) ==> (p ENSURES q) (CONS st Pr)`), + REPEAT GEN_TAC THEN + DISCH_TAC THEN + ASSUME_TAC (SPEC_ALL ENSURES_thm1) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) ENSURES p)(CONS st Pr)`);(`!s:'a. p s ==> q s`)] + AND_INTRO_THM)) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`);(`p:'a->bool`);(`q:'a->bool`); + (`CONS (st:'a->'a) Pr`)] + ENSURES_thm2)));; + +let ENSURES_cor2 = prove_thm + ("ENSURES_cor2", + (`!(p:'a->bool) q Pr. (p ENSURES q) Pr ==> (p UNLESS q) Pr`), + REWRITE_TAC [ENSURES] THEN + REPEAT STRIP_TAC);; + +let ENSURES_cor3 = prove_thm + ("ENSURES_cor3", + (`!(p:'a->bool) q r Pr. + ((p \/* q) ENSURES r)Pr ==> (p ENSURES (q \/* r))Pr`), + REPEAT GEN_TAC THEN + DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) \/* q)`);(`r:'a->bool`); + (`Pr:('a->'a)list`)] ENSURES_cor2)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`);(`q:'a->bool`);(`r:'a->bool`); + (`Pr:('a->'a)list`)] UNLESS_cor4)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS (q \/* r))Pr`); + (`(((p:'a->bool) \/* q) ENSURES r)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`);(`((q:'a->bool) \/* r)`); + (`((p:'a->bool) \/* q)`);(`r:'a->bool`); + (`Pr:('a->'a)list`)] ENSURES_thm4)) THEN + UNDISCH_TAC (`(((p:'a->bool) /\* (p \/* q)) ENSURES + (((p /\* r) \/* ((p \/* q) /\* (q \/* r))) \/* + ((q \/* r) /\* r))) Pr`) THEN + REWRITE_TAC [AND_OR_EQ_lemma] THEN + REWRITE_TAC [OR_ASSOC_lemma;AND_ASSOC_lemma] THEN + PURE_ONCE_REWRITE_TAC [SPECL + [(`((q:'a->bool) \/* r)`); + (`r:'a->bool`)] AND_COMM_lemma] THEN + ONCE_REWRITE_TAC [AND_OR_EQ_AND_COMM_OR_lemma] THEN + REWRITE_TAC [AND_OR_EQ_lemma] THEN + DISCH_TAC THEN + ASSUME_TAC (SPECL [(`p:'a->bool`);(`q:'a->bool`);(`r:'a->bool`)] + IMPLY_WEAK_lemma5) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) ENSURES + ((p /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r)))Pr`); + (`!s:'a. ((p /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r))s ==> + (q \/* r)s`)] + AND_INTRO_THM)) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`); + (`(((p:'a->bool) /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r))`); + (`((q:'a->bool) \/* r)`);(`Pr:('a->'a)list`)] + ENSURES_thm2)));; + +let ENSURES_cor4 = prove_thm + ("ENSURES_cor4", + (`!(p:'a->bool) q r Pr. (p ENSURES (q \/* r)) Pr ==> + ((p /\* (Not q)) ENSURES (q \/* r)) Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL ENSURES_lemma3)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) /\* (Not q))`);(`((p:'a->bool) /\* q)`); + (`((q:'a->bool) \/* r)`);(`Pr:('a->'a)list`)] ENSURES_cor3)) THEN + UNDISCH_TAC + (`(((p:'a->bool) /\* (Not q)) ENSURES + ((p /\* q) \/* (q \/* r)))Pr`) THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL OR_ASSOC_lemma))] THEN + REWRITE_TAC [P_AND_Q_OR_Q_lemma]);; + +(* + Consequence Weakening Corollary: + + p ensures q in Pr + ------------------------- + p ensures (q \/ r) in Pr +*) + +let ENSURES_cor5 = prove_thm + ("ENSURES_cor5", + (`!(p:'a->bool) q r Pr. + (p ENSURES q) Pr ==> (p ENSURES (q \/* r)) Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPECL [(`q:'a->bool`);(`r:'a->bool`)] + IMPLY_WEAK_lemma_b) THEN + ASSUME_TAC (SPECL + [(`p:'a->bool`);(`q:'a->bool`);(`(q:'a->bool) \/* r`)] + ENSURES_thm2) THEN + RES_TAC);; + +(* + Always Corollary: + + false ensures p in Pr +*) + +let ENSURES_cor6 = prove_thm + ("ENSURES_cor6", + (`!(p:'a->bool) st Pr. (False ENSURES p) (CONS st Pr)`), + REWRITE_TAC [ENSURES;UNLESS_cor7;EXIST_TRANSITION_thm3]);; + +let ENSURES_cor7 = prove_thm + ("ENSURES_cor7", + (`!(p:'a->bool) q r Pr. + (p ENSURES q) Pr /\ (r STABLE Pr) + ==> + ((p /\* r) ENSURES (q /\* + r))Pr`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + REPEAT STRIP_TAC THEN + IMP_RES_TAC (ONCE_REWRITE_RULE [AND_COMM_lemma] + (REWRITE_RULE [AND_False_lemma;OR_False_lemma] + (ONCE_REWRITE_RULE [OR_AND_COMM_lemma] + (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL + [(`r:'a->bool`);(`False:'a->bool`); + (`p:'a->bool`);(`q:'a->bool`); + (`Pr:('a->'a)list`)] ENSURES_thm4))))));; diff --git a/Unity/mk_gen_induct.ml b/Unity/mk_gen_induct.ml new file mode 100644 index 0000000..1a05814 --- /dev/null +++ b/Unity/mk_gen_induct.ml @@ -0,0 +1,30 @@ +(* -*- Emacs Mode: sml -*- *) + +(*---------------------------------------------------------------------------*) +(* + File: mk_gen_induct.sml + + Description: This file proves the theorem of general induction on natural + numbers by using the theorem of primitive recursion. + + Author: (c) Copyright 1990-2008 by Flemming Andersen + Modified by John Harrison to just pick up num_WF instead + Date: June 7. 1990 + Last Update: January 18, 2008 +*) +(*---------------------------------------------------------------------------*) + +(* + !P. (!(m:num). (!n. n < m ==> (P n)) ==> (P m)) ==> (!m. P m) +*) +let GEN_INDUCT_thm = prove_thm + ("GEN_INDUCT_thm", + (`!P. (!(m:num). (!n. n < m ==> (P n)) ==> (P m)) ==> (!m. P m)`), + MATCH_ACCEPT_TAC num_WF);; + +(* Emacs editor information +| Local variables: +| mode:sml +| sml-prog-name:"hol90" +| End: +*) diff --git a/Unity/mk_leadsto.ml b/Unity/mk_leadsto.ml new file mode 100644 index 0000000..b9cd943 --- /dev/null +++ b/Unity/mk_leadsto.ml @@ -0,0 +1,4464 @@ +(*---------------------------------------------------------------------------*) +(* + File: mk_leadsto.ml + + Description: This file defines LEADSTO and the theorems and corrollaries + described in [CM88]. + + Author: (c) Copyright 1990-2008 by Flemming Andersen + Date: July 24. 1990 + Updated: November 11, 1991 (including LUB) + Updated: October 3, 1992 (including state space restriction) + Last Update: December 30, 2007 +*) +(*---------------------------------------------------------------------------*) + +(* + We want to define a function LeadstoRel, which satisfies the three + properties of the given axiomatic definition of LEADSTO: + + p ensures q in Pr + ------------------- (1) + p leadsto q in Pr + + p leadsto q in Pr, q leadsto r in Pr + -------------------------------------- (2) + p leadsto r in Pr + + !i. (p i) leadsto q in Pr + ------------------------- (3) + (?i. p i) leadsto q in Pr +*) +let LUB = new_definition + `LUB (P:('a->bool)->bool) = \s:'a. ?p. (P p) /\ p s`;; + +let IN = new_infix_definition + ("In", "<=>", + `In (p:'a->bool) (P:('a->bool)->bool) = P p`, TL_FIX);; + +let LeadstoRel = new_definition + (`LeadstoRel R Pr = + !(p:'a->bool) q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (R p r Pr /\ R r q Pr) ==> R p q Pr) /\ + (!P. (p = LUB P) /\ (!p. (p In P) ==> R p q Pr) ==> R p q Pr)`);; + +(* + Now we may define LEADSTO: +*) +let LEADSTO = new_infix_definition + ("LEADSTO", "<=>", + (`LEADSTO (p:'a->bool) q Pr = (!R. (LeadstoRel R Pr) ==> (R p q Pr))`), + TL_FIX);; + +(* + Prove that the given axioms 1, 2, 3 are really theorems for the family +*) + +(* Prove: + !P Q Pr. (P ENSURES Q)Pr ==> (P LEADSTO Q)Pr +*) +let LEADSTO_thm0 = prove_thm + ("LEADSTO_thm0", + (`!(p:'a->bool) q Pr. (p ENSURES q) Pr ==> (p LEADSTO q)Pr`), + REWRITE_TAC [LEADSTO; LeadstoRel] THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* Prove: + !P Q R Pr. + (P LEADSTO Q)Pr /\ (Q LEADSTO R)Pr ==> (P LEADSTO R)Pr +*) +let LEADSTO_thm1 = prove_thm + ("LEADSTO_thm1", + (`!(p:'a->bool) r q Pr. + (p LEADSTO r)Pr /\ (r LEADSTO q)Pr ==> (p LEADSTO q) Pr`), + REWRITE_TAC [LEADSTO; LeadstoRel] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC);; + +(* Prove: + !P Q R Pr. + (P ENSURES Q)Pr /\ (Q LEADSTO R)Pr ==> (P LEADSTO R)Pr +*) +let LEADSTO_thm2 = prove_thm + ("LEADSTO_thm2", + (`!(p:'a->bool) r q Pr. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr ==> (p LEADSTO q) Pr`), + REWRITE_TAC [LEADSTO; LeadstoRel] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC);; + +(* Prove: + !P Q R Pr. + (P ENSURES Q)Pr /\ (Q ENSURES R)Pr ==> (P LEADSTO R)Pr +*) +let LEADSTO_thm2a = prove_thm + ("LEADSTO_thm2a", + (`!(p:'a->bool) r q Pr. + (p ENSURES r)Pr /\ (r ENSURES q)Pr ==> (p LEADSTO q) Pr`), + REWRITE_TAC [LEADSTO; LeadstoRel] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC);; + +(* Prove: + !P q Pr. (!i. (P i) LEADSTO q)Pr ==> ((( ?* ) P) LEADSTO q)Pr +*) +let LEADSTO_thm3_lemma01 = TAC_PROOF + (([], + (`(!p:'a->bool. + p In P ==> + (!R. + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. + (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)) ==> + R p q Pr)) + ==> + (!p:'a->bool. + p In P ==> + ((!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. + (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)) ==> + R p q Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm3 = prove_thm + ("LEADSTO_thm3", + (`!p (P:('a->bool)->bool) q Pr. + ((p = LUB P) /\ (!p. (p In P) ==> (p LEADSTO q)Pr)) ==> (p LEADSTO q)Pr`), + REPEAT GEN_TAC THEN + REWRITE_TAC [LEADSTO;LeadstoRel] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (GEN_ALL (REWRITE_RULE[ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)`)] + (SPEC_ALL (UNDISCH (SPEC_ALL LEADSTO_thm3_lemma01))))) THEN + RES_TAC);; + +let LEADSTO_thm3a = prove_thm + ("LEADSTO_thm3a", + (`!(P:('a->bool)->bool) q Pr. + (!p. (p In P) ==> (p LEADSTO q)Pr) ==> ((LUB P) LEADSTO q)Pr`), + REPEAT GEN_TAC THEN + ACCEPT_TAC (SPEC_ALL + (REWRITE_RULE [] (SPECL + [(`LUB (P:('a->bool)->bool)`); (`P:('a->bool)->bool`)] LEADSTO_thm3))));; + +let LEADSTO_thm3c_lemma01 = TAC_PROOF + (([], + (`!p:'a->bool. p In (\p. ?i. p = P (i:num)) = (?i. p = P i)`)), + REWRITE_TAC [IN] THEN + BETA_TAC THEN + REWRITE_TAC []);; + +let LEADSTO_thm3c_lemma02 = TAC_PROOF + (([], + (`!(P:num->'a->bool) q i. + ((?i'. P i = P i') ==> q) = (!i'. (P i = P i') ==> q)`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + ASM_CASES_TAC (`?i'. (P:num->'a->bool) i = P i'`) THEN + RES_TAC + ; + ACCEPT_TAC (REWRITE_RULE [SYM (ASSUME (`(P:num->'a->bool) i = P i'`))] + (SPEC_ALL (ASSUME (`!i'. ((P:num->'a->bool) i = P i') ==> q`)))) + ]);; + +let LEADSTO_thm3c_lemma03 = TAC_PROOF + (([], + (`(!p:'a->bool. (?i. p = P i) ==> (p LEADSTO q)Pr) = + (!i:num. ((P i) LEADSTO q)Pr)`)), + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`i:num`) (REWRITE_RULE + [LEADSTO_thm3c_lemma02] (SPEC (`(P:num->'a->bool)i`) (ASSUME + (`!p:'a->bool. (?i:num. p = P i) ==> (p LEADSTO q)Pr`)))))) + ; + ASM_REWRITE_TAC [] + ]);; + +let LEADSTO_thm3c_lemma04 = TAC_PROOF + (([], + (`!s. ((?*) (P:num->'a->bool))s <=> (LUB(\p. ?i. p = P i))s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [EXISTS_def; LUB] THEN + BETA_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + EXISTS_TAC (`(P:num->'a->bool)x`) THEN + ASM_REWRITE_TAC [] THEN + EXISTS_TAC (`x:num`) THEN + REFL_TAC + ; + EXISTS_TAC (`i:num`) THEN + ACCEPT_TAC (ONCE_REWRITE_RULE [ASSUME (`p = (P:num->'a->bool)i`)] + (ASSUME (`(p:'a->bool) s`))) + ]);; + +let LEADSTO_thm3c = prove_thm + ("LEADSTO_thm3c", + (`!(P:num->'a->bool) q Pr. + (!i. ((P i) LEADSTO q)Pr) ==> (((?*) P) LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm3c_lemma03] + (REWRITE_RULE [LEADSTO_thm3c_lemma01] (ISPEC + (`\p. ?i. (p = (P:num->'a->bool)i)`) LEADSTO_thm3a))) THEN + RES_TAC THEN + ASM_REWRITE_TAC [REWRITE_RULE [ETA_AX] (MK_ABS LEADSTO_thm3c_lemma04)]);; + +(* Prove: + !p1 p2 q Pr. + (p1 LEADSTO q)Pr /\ (p2 LEADSTO q)Pr ==> ((p1 \/* p2) LEADSTO q)Pr +*) + +(* + To prove this we need some general lemmas about expressing two known + relations as one relation: +*) + +(* + |- !p1 p2 s. (p1 \/* p2)s = LUB(\p. (p = p1) \/ (p = p2))s +*) +let LEADSTO_thm4_lemma1a = TAC_PROOF + (([], + (`!(p1:'a->bool) p2 s. + (p1 \/* p2) s = (LUB (\p. (p = p1) \/ (p = p2))) s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [LUB; OR_def ] THEN + BETA_TAC THEN + EQ_TAC THENL + [ + STRIP_TAC THENL + [ + EXISTS_TAC (`p1:'a->bool`) THEN + ASM_REWRITE_TAC [] + ; + EXISTS_TAC (`p2:'a->bool`) THEN + ASM_REWRITE_TAC [] + ] + ; + STRIP_TAC THENL + [ + REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p1`)] (ASSUME + (`(p:'a->bool) s`))] + ; + REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p2`)] (ASSUME + (`(p:'a->bool) s`))] + ] + ]);; + +(* + |- !p1 p2. p1 \/* p2 = LUB(\p. (p = p1) \/ (p = p2)) +*) +let LEADSTO_thm4_lemma1 = + (GEN_ALL (REWRITE_RULE [ETA_AX] + (MK_ABS (GEN (`s:'a`) + (SPEC_ALL LEADSTO_thm4_lemma1a)))));; + +(* + |- !R p1 p2 q Pr. + R p1 q Pr ==> R p2 q Pr ==> (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr) +*) +let LEADSTO_thm4_lemma2 = TAC_PROOF + (([], + (`!R (p1:'a->bool) p2 (q:'a->bool) (Pr:('a->'a)list). + R p1 q Pr ==> R p2 q Pr ==> + (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr)`)), + BETA_TAC THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +(* + |- !R p1 p2 q Pr. R p1 q Pr ==> R p2 q Pr ==> + (!p q P. (p = LUB P) /\ (!p. P p ==> R p q Pr) ==> R p q Pr) + ==> R(p1 \/* p2) q Pr +*) +let LEADSTO_thm4_lemma3 = TAC_PROOF + (([], + (`!R (p1:'a->bool) p2 (q:'a->bool) (Pr:('a->'a)list). + R p1 q Pr ==> R p2 q Pr ==> + (!p q P. (p = LUB P) /\ (!p. P p ==> R p q Pr) ==> R p q Pr) ==> + R (p1 \/* p2) q Pr`)), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [SYM (SPEC_ALL LEADSTO_thm4_lemma1); + UNDISCH_ALL (SPEC_ALL LEADSTO_thm4_lemma2)] + (SPECL + [(`(p1:'a->bool) \/* p2`); (`q:'a->bool`); + (`\p:'a->bool. (p = p1) \/ (p = p2)`)] + (ASSUME (`!p (q:'a->bool) (P:('a->bool)->bool). (p = LUB P) /\ + (!p. P p ==> R p q Pr) ==> R p q (Pr:('a->'a)list)`)))));; +(* + Now Prove that the finite disjunction is satisfied +*) + +(* +|- !p1 p2 q Pr. + (p1 LEADSTO q)Pr /\ (p2 LEADSTO q)Pr ==> ((p1 \/* p2) LEADSTO q)Pr +*) +let LEADSTO_thm4 = prove_thm + ("LEADSTO_thm4", + (`!(p1:'a->bool) p2 q Pr. + (p1 LEADSTO q)Pr /\ (p2 LEADSTO q)Pr ==> + ((p1 \/* p2) LEADSTO q)Pr`), + REWRITE_TAC [LEADSTO;LeadstoRel] THEN + (* BETA_TAC THEN *) + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASSUME_TAC (GEN(`p:'a->bool`)(GEN(`q:'a->bool`)(REWRITE_RULE [IN] + (CONJUNCT2 (CONJUNCT2 (SPEC_ALL + (ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> + R p q Pr)`)))))))) THEN + ACCEPT_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm4_lemma3)));; + +(* + Prove: + ((p ENSURES q)Pr \/ + (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = (( ?* ) P)) /\ (!i. ((P i) LEADSTO q)Pr))) = + (p LEADSTO q)Pr +*) +let LEADSTO_thm5_lemma1 = TAC_PROOF + (([], + `!(p:'a->bool) s. (p s = (\s. ?p'. (if (p = p') then T else F) /\ p' s)s)`), + REPEAT GEN_TAC THEN + BETA_TAC THEN + EQ_TAC THEN REPEAT STRIP_TAC THENL + [ + EXISTS_TAC (`p:'a->bool`) THEN + ASM_REWRITE_TAC [] + ; + UNDISCH_TAC (`(if ((p:'a->bool) = p') then T else F)`) THEN + REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC [] + ]);; + +(* + |- !p. p = (\s. ?p'. ((p = p') => T | F) /\ p' s) +*) +let LEADSTO_thm5_lemma2 = (GEN_ALL + (REWRITE_RULE [ETA_AX] + (MK_ABS (SPEC (`p:'a->bool`) LEADSTO_thm5_lemma1))));; + +let LEADSTO_thm5_lemma3 = TAC_PROOF + (([], + (`!(p:'a->bool) p'. (if (p = p') then T else F) = (p = p')`)), + REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC []);; + + +(* + |- !p q Pr. + (p ENSURES q)Pr \/ + (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) + = + (p LEADSTO q)Pr +*) +let LEADSTO_thm5 = prove_thm + ("LEADSTO_thm5", + (`!(p:'a->bool) q Pr. + ((p ENSURES q) Pr \/ + (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) \/ + (?P:('a->bool)->bool. (p = LUB P) /\ (!p. (p In P) ==> (p LEADSTO q)Pr))) + = + (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) + ; + IMP_RES_TAC LEADSTO_thm1 + ; + IMP_RES_TAC LEADSTO_thm3 + ] + ; + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + +(* + Prove: + ((p ENSURES q)Pr \/ + (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) + = + (p LEADSTO q)Pr +*) +let LEADSTO_thm6 = prove_thm + ("LEADSTO_thm6", + (`!(p:'a->bool) q Pr. + ((p ENSURES q) Pr \/ + (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) + = + (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) + ; + IMP_RES_TAC LEADSTO_thm2 + ; + IMP_RES_TAC LEADSTO_thm3 + ] + ; + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + +(* + Prove: + ((p ENSURES q)Pr \/ + (?r. (p ENSURES r)Pr /\ (r ENSURES q)Pr) \/ + (?P. (p = (( ?* ) P)) /\ (!i. ((P i) LEADSTO q)Pr))) = + (p LEADSTO q)Pr +*) +let LEADSTO_thm7 = prove_thm + ("LEADSTO_thm7", + (`!(p:'a->bool) q Pr. + ((p ENSURES q) Pr \/ + (?r. (p ENSURES r)Pr /\ (r ENSURES q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = + (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) + ; + IMP_RES_TAC LEADSTO_thm2a + ; + IMP_RES_TAC LEADSTO_thm3 + ] + ; + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + +(* + Prove: + ((p ENSURES q)Pr \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = + (p LEADSTO q)Pr +*) +let LEADSTO_thm8 = prove_thm + ("LEADSTO_thm8", + (`!(p:'a->bool) q Pr. + ((p ENSURES q) Pr \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) + = + (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO_thm0)) + ; + IMP_RES_TAC LEADSTO_thm3 THEN + ASM_REWRITE_TAC [] + ] + ; + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + +(* + Prove: + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr +*) +let LEADSTO_thm9 = prove_thm + ("LEADSTO_thm9", + (`!(p:'a->bool) q Pr. + (?P. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr)) = (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm3 THEN + ASM_REWRITE_TAC [] + ; + REPEAT STRIP_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + +(* Prove: + + !P Q Pr. (P LEADSTO Q) [] = false + +*) + +(* + Theorem LEADSTO_thm10 does Not hold for the generalised disjunctive + rule, since: + + (!P. (p = LUB P) /\ (!p'. p' In P ==> F) ==> F)) + + is only satisfied when P is non-empty + +let LEADSTO_thm10 = prove_thm + ("LEADSTO_thm10", + (`!(p:'a->bool) q. (p LEADSTO q) [] = F`), + REPEAT GEN_TAC THEN + REWRITE_TAC [LEADSTO;LeadstoRel] THEN + CONV_TAC NOT_FORALL_CONV THEN + EXISTS_TAC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). F`) THEN + BETA_TAC THEN + REWRITE_TAC [ENSURES_thm0] THEN + REPEAT GEN_TAC THEN + REWRITE_TAC [DE_MORGAN_THM] THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL IMP_DISJ_THM))] THEN + REWRITE_TAC [In,LUB] THEN + STRIP_TAC THEN + CONV_TAC NOT_FORALL_CONV THEN + REWRITE_TAC [] THEN + + ... + +*) + +(* + Prove: + (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) = (p LEADSTO q)Pr +*) +let LEADSTO_thm11 = prove_thm + ("LEADSTO_thm11", + (`!(p:'a->bool) q st Pr. + (?r. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr)) = + (p LEADSTO q)(CONS st Pr)`), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + IMP_RES_TAC LEADSTO_thm2 + ; + EXISTS_TAC (`p:'a->bool`) THEN + ASM_REWRITE_TAC [ENSURES_thm1] + ]);; + + +(* Prove: + !P Pr. (P LEADSTO P) (CONS st Pr) +*) +let LEADSTO_thm12 = prove_thm + ("LEADSTO_thm12", + (`!(p:'a->bool) st Pr. (p LEADSTO p) (CONS st Pr)`), + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC [SYM (SPEC_ALL LEADSTO_thm5)] THEN + DISJ1_TAC THEN + REWRITE_TAC [ENSURES_thm1]);; + +(* + Prove: + (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) = (p LEADSTO q)Pr +*) +let LEADSTO_thm13 = prove_thm + ("LEADSTO_thm13", + (`!(p:'a->bool) q st Pr. + (?r. (p LEADSTO r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr)) + = (p LEADSTO q)(CONS st Pr)`), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + IMP_RES_TAC LEADSTO_thm1 + ; + EXISTS_TAC (`p:'a->bool`) THEN + ASM_REWRITE_TAC [LEADSTO_thm12] + ]);; + +(* + Prove: + (?r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr) = + (?r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) +*) +let LEADSTO_thm14 = prove_thm + ("LEADSTO_thm14", + (`!(p:'a->bool) q st Pr. + (?r. (p LEADSTO r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr)) + = + (?r. (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr))`), + REPEAT GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm11; LEADSTO_thm13]);; + +(* + Prove: + |- !p q Pr. + (p ENSURES q)Pr \/ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) + = + (p LEADSTO q)Pr +*) +let LEADSTO_thm15 = prove_thm + ("LEADSTO_thm15", + (`!(p:'a->bool) q Pr. + ((p ENSURES q) Pr \/ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = + (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + IMP_RES_TAC LEADSTO_thm0 + ; + ACCEPT_TAC (MP (SPEC_ALL LEADSTO_thm2) (SPEC_ALL + (ASSUME (`!r:'a->bool. (p ENSURES r)Pr /\ (r LEADSTO q)Pr`)))) + ; + IMP_RES_TAC LEADSTO_thm3 + ; + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + +(* + Prove: + |- !p q Pr. + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr)) + = + (p LEADSTO q)Pr +*) +let LEADSTO_thm16 = prove_thm + ("LEADSTO_thm16", + (`!(p:'a->bool) q Pr. + ((!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> (p LEADSTO q)Pr))) = + (p LEADSTO q)Pr`), + REPEAT STRIP_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (MP (SPEC_ALL LEADSTO_thm2) (SPEC_ALL + (ASSUME (`!r:'a->bool. (p ENSURES r)Pr /\ (r LEADSTO q)Pr`)))) + ; + IMP_RES_TAC LEADSTO_thm3 + ; + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + GEN_TAC THEN + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + DISCH_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))) + ] + ]);; + + +(* + Finally prove one of the used LEADSTO induction principles in CM88: + +|- !X p q Pr. + + (!p q. + + ((p ENSURES q)Pr ==> X p q Pr) + + /\ + + (!r. + (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + + ==> (p LEADSTO q)Pr ==> X p q Pr) + + /\ + + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + + ==> (p LEADSTO q)Pr ==> X p q Pr + +*) + +let STRUCT_lemma0 = TAC_PROOF + (([], + (` (!p:'a->bool. p In P ==> + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) + = + ((!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr))`)), + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + + +let STRUCT_lemma00 = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + = + (!p q. + ((p ENSURES q)Pr ==> + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!r. + ((p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr)) /\ + (r LEADSTO q)Pr /\ + ((r LEADSTO q)Pr ==> X r q Pr) ==> + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!P. + (p = LUB P) /\ + (!p'. + p' In P ==> (p' LEADSTO q)Pr /\ ((p' LEADSTO q)Pr ==> X p' q Pr)) + ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + IMP_RES_TAC LEADSTO_thm0 + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm1 + ; + RES_TAC + ; + IMP_RES_TAC STRUCT_lemma0 THEN + IMP_RES_TAC LEADSTO_thm3a THEN + RES_TAC THEN + ASM_REWRITE_TAC [] + ; + IMP_RES_TAC STRUCT_lemma0 THEN + IMP_RES_TAC LEADSTO_thm3a THEN + RES_TAC THEN + ASM_REWRITE_TAC [] + ; + RES_TAC + ; + RES_TAC + ; + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma0)] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) + (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr ==> X p q Pr`)))) THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`((LUB P) LEADSTO (q:'a->bool))Pr`)] + (SPEC (`LUB (P:('a->bool)->bool)`) (GEN_ALL (REWRITE_RULE + [ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ + ((p LEADSTO q)Pr ==> X p q Pr)`)] + (SPEC_ALL (CONJUNCT2 (CONJUNCT2 (SPEC_ALL (ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!r. + ((p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr)) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) ==> + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!P. (p = LUB P) /\ + (!p'. p' In P ==> + (p' LEADSTO q)Pr /\ ((p' LEADSTO q)Pr ==> X p' q Pr)) ==> + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr))`)))))))))) + ]);; + +(* + The induction theorem: +*) +let LEADSTO_thm17 = prove_thm + ("LEADSTO_thm17", + (`!X (p:'a->bool) q Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> (((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr))) + ==> ((p LEADSTO q)Pr ==> X p q Pr)`), + REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma00)] (BETA_RULE (SPEC + (`\(p:'a->bool) q Pr. + (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`)))))) THEN + RES_TAC);; + +(* + A derived theorem for an induction tactic +*) +let LEADSTO_thm18 = prove_thm + ("LEADSTO_thm18", + (`!X. + ((!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!(p:'a->bool) P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma00)] + (BETA_RULE (SPEC + (`\ (p:'a->bool) q Pr. (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`)))))) THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) r q Pr. + (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) P (q:'a->bool) Pr. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (ASSUME + (`(!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p LEADSTO r)Pr /\ ((p LEADSTO r)Pr ==> X p r Pr) /\ + (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. + (!p'. p' In P ==> (p' LEADSTO q)Pr) /\ + (!p'. p' In P ==> (p' LEADSTO q)Pr ==> X p' q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + ==> (p LEADSTO q)Pr /\ ((p LEADSTO q)Pr ==> X p q Pr)`))));; + + +(* + Now prove another LEADSTO induction principle: +*) +let STRUCT_lemma1 = TAC_PROOF + (([], + (`(!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ X p q Pr) + = + ((!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr))`)), + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + + +let STRUCT_lemma01 = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ X p q Pr) /\ + (!r. ((p LEADSTO r)Pr /\ X p r Pr) /\ (r LEADSTO q)Pr /\ X r q Pr + ==> (p LEADSTO q)Pr /\ X p q Pr) /\ + (!P. (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr) + ==> (p LEADSTO q)Pr /\ X p q Pr)) + = + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p LEADSTO r)Pr /\ X p r Pr /\ (r LEADSTO q)Pr /\ X r q Pr + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr))`)), + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ + RES_TAC + ; + RES_TAC + ; + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL STRUCT_lemma1)] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) + (ASSUME (`!p. p In P + ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool) p q Pr`)))) THEN + RES_TAC THEN + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool)p q Pr`)))) + ; + IMP_RES_TAC LEADSTO_thm0 + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm1 + ; + IMP_RES_TAC LEADSTO_thm1 THEN + RES_TAC + ; + IMP_RES_TAC STRUCT_lemma1 THEN + IMP_RES_TAC LEADSTO_thm3 + ; + IMP_RES_TAC STRUCT_lemma1 THEN + IMP_RES_TAC LEADSTO_thm3a THEN + RES_TAC THEN + ASM_REWRITE_TAC [] + ]);; + +(* + The induction theorem: +*) +let LEADSTO_thm19 = prove_thm + ("LEADSTO_thm19", + (`!X (p:'a->bool) q Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p LEADSTO r)Pr /\ (X p r Pr) /\ (r LEADSTO q)Pr /\ (X r q Pr) + ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + ==> ((p LEADSTO q)Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [STRUCT_lemma01] (BETA_RULE + (SPEC (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q Pr)`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`)))))) THEN + RES_TAC);; + +(* + The derived theorem for the induction tactic +*) +let LEADSTO_thm20 = prove_thm + ("LEADSTO_thm20", + (`!X. + ((!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. (p LEADSTO r)Pr /\ X p r Pr /\ (r LEADSTO q)Pr /\ X r q Pr + ==> ((p LEADSTO q)Pr ==> X p q Pr)) /\ + (!(p:'a->bool) P q Pr. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) r q Pr. + (p LEADSTO r)Pr /\ X p r Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> + (p LEADSTO q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) P q Pr. + (!p:'a->bool. + p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> + ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] + (REWRITE_RULE [STRUCT_lemma01](BETA_RULE (SPEC + (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q Pr)`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))))));; + +(* + Now prove a third LEADSTO induction principle: +|- !X p q Pr. + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) + /\ + (!r. (X p r Pr) /\ (X r q Pr) ==> X p q Pr) + /\ + (!P. (!i. X(P i)q Pr) ==> X(( ?* ) P)q Pr)) + ==> (p LEADSTO q)Pr ==> X p q Pr +*) +let LEADSTO_thm21 = prove_thm + ("LEADSTO_thm21", + (`!X (p:'a->bool) q Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (X p r Pr) /\ (X r q Pr) ==> X p q Pr) /\ + (!P. (p = LUB P) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) + ==> ((p LEADSTO q)Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (BETA_RULE (SPEC + (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). X p q Pr:bool`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))) THEN + RES_TAC);; + +(* + The theorem derived for an induction tactic +*) +let LEADSTO_thm22 = prove_thm + ("LEADSTO_thm22", + (`!X. + ((!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. (X p r Pr) /\ (X r q Pr) ==> (X p q Pr)) /\ + (!p P q Pr. (p = LUB P) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr)) + ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) (r:'a->bool) q (Pr:('a->'a)list). + X p r Pr /\ X r q Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) P (q:'a->bool) (Pr:('a->'a)list). + (p = LUB P) /\ (!p. p In P ==> X p q Pr) ==> X p q Pr`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] + (REWRITE_RULE [SYM (SPEC_ALL CONJ_ASSOC)] (BETA_RULE (SPEC + (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). X p q Pr:bool`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))))));; + +(* + yet another LEADSTO induction principle: +*) +let LEADSTO_thm23_lemma00 = TAC_PROOF + (([], + (`!X Pr. + ((!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr)) = + (!p:'a->bool. p In P ==> (p LEADSTO q)Pr /\ X p q Pr)`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm23_lemma01 = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ X p q Pr) /\ + (!r. + ((p LEADSTO r)Pr /\ X p r Pr) /\ (r LEADSTO q)Pr /\ X r q Pr + ==> (p LEADSTO q)Pr /\ X p q Pr) /\ + (!P. (p = LUB P) /\ + (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr) + ==> (p LEADSTO q)Pr /\ X p q Pr)) + = + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr))`)), + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ + RES_TAC + ; + RES_TAC + ; + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm23_lemma00] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) + (ASSUME (`!p. p In P + ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool) p q Pr`)))) THEN + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm0 + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm1 + ; + RES_TAC + ; + STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm23_lemma00)] + (ASSUME (`!p':'a->bool. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr`))) THEN + IMP_RES_TAC LEADSTO_thm3a THEN + ASM_REWRITE_TAC [] + ; + STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm23_lemma00)] + (ASSUME (`!p':'a->bool. p' In P ==> (p' LEADSTO q)Pr /\ X p' q Pr`))) THEN + RES_TAC + ]);; + +let LEADSTO_thm23 = prove_thm + ("LEADSTO_thm23", + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr)) + ==> (!p q. (p LEADSTO q) Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm23_lemma01] (BETA_RULE (SPEC + (`\(p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q Pr)`) + (REWRITE_RULE [LEADSTO;LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q) Pr`)))))) THEN + RES_TAC);; + +let LEADSTO_thm24_lemma01 = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr)) + = + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> + X p q Pr) /\ + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> + X(LUB P)q Pr))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC THENL + [ + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->('a->'a)list->bool) p q Pr`)))) + ; + ASM_REWRITE_TAC [] + ]);; + +let LEADSTO_thm24 = prove_thm + ("LEADSTO_thm24", + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X (LUB P) q Pr)) + ==> (!p q. (p LEADSTO q) Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (UNDISCH (SPEC_ALL (UNDISCH (REWRITE_RULE [LEADSTO_thm24_lemma01] + (SPEC_ALL LEADSTO_thm23))))));; + +(* Prove: + !P Q st Pr. (!s. P s ==> Q s) ==> (P LEADSTO Q) (CONS st Pr) +*) +let LEADSTO_thm25 = prove_thm + ("LEADSTO_thm25", + (`!(p:'a->bool) q st Pr. (!s. p s ==> q s) ==> (p LEADSTO q) (CONS st Pr)`), + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC + (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm0) + (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + ENSURES_cor1) (ASSUME (`!s:'a. p s ==> q s`)))));; + + +(* Prove: + |- !p q q' st Pr. + (p LEADSTO q)(CONS st Pr) ==> (p LEADSTO (q \/* q'))(CONS st Pr) +*) +let LEADSTO_thm26 = prove_thm + ("LEADSTO_thm26", + (`!(p:'a->bool) q q' st Pr. + (p LEADSTO q)(CONS st Pr) ==> (p LEADSTO (q \/* q'))(CONS st Pr)`), + REPEAT GEN_TAC THEN + DISCH_TAC THEN + ASSUME_TAC (SPECL [(`q:'a->bool`); (`q':'a->bool`)] IMPLY_WEAK_lemma_b) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`q:'a->bool`); (`(q:'a->bool) \/* q'`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm25)) THEN + IMP_RES_TAC (SPECL + [(`p:'a->bool`); (`q:'a->bool`); (`(q:'a->bool) \/* q'`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm1));; + + +(* Prove: + |- !p q p' q' st Pr. + (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) ==> + ((p \/* p') LEADSTO (q \/* q'))(CONS st Pr) +*) +let LEADSTO_thm27 = prove_thm + ("LEADSTO_thm27", + (`!(p:'a->bool) q p' q' st Pr. + (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) + ==> ((p \/* p') LEADSTO (q \/* q'))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm26)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p':'a->bool`); (`q':'a->bool`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm26)) THEN + ASSUME_TAC (ONCE_REWRITE_RULE [OR_COMM_lemma] + (ASSUME (`((p':'a->bool) LEADSTO (q' \/* q))(CONS st Pr)`))) THEN + IMP_RES_TAC (SPECL + [(`p:'a->bool`); (`p':'a->bool`); (`(q:'a->bool) \/* q'`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm4));; + + +(* Prove: + |- !p q b r st Pr. + (p LEADSTO (q \/* b))(CONS st Pr) /\ (b LEADSTO r)(CONS st Pr) ==> + (p LEADSTO (q \/* r))(CONS st Pr) +*) +let LEADSTO_thm28 = prove_thm + ("LEADSTO_thm28", + (`!(p:'a->bool) q b r st Pr. + (p LEADSTO (q \/* b))(CONS st Pr) /\ (b LEADSTO r)(CONS st Pr) + ==> (p LEADSTO (q \/* r))(CONS st Pr)`), + REPEAT GEN_TAC THEN + STRIP_TAC THEN + ASSUME_TAC (SPEC_ALL (SPEC (`q:'a->bool`) LEADSTO_thm12)) THEN + ASSUME_TAC (MP (SPECL + [(`b:'a->bool`); (`r:'a->bool`); (`q:'a->bool`); (`q:'a->bool`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm27) (CONJ + (ASSUME (`((b:'a->bool) LEADSTO r)(CONS st Pr)`)) + (ASSUME (`((q:'a->bool) LEADSTO q)(CONS st Pr)`)))) THEN + ACCEPT_TAC (MP (SPECL [(`p:'a->bool`); (`(q:'a->bool) \/* b`); + (`(q:'a->bool) \/* r`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm1) + (CONJ (ASSUME (`((p:'a->bool) LEADSTO (q \/* b))(CONS st Pr)`)) + (ONCE_REWRITE_RULE [OR_COMM_lemma] + (ASSUME (`(((b:'a->bool) \/* q) LEADSTO (r \/* q))(CONS st Pr)`))))));; + +(* Prove: + !p q r b Pr. + (p LEADSTO q)Pr /\ (r UNLESS b)Pr + ==> ((p /\* r) LEADSTO ((q /\* r) \/* b))Pr +*) +let LEADSTO_thm29_lemma00 = + (SPEC (`CONS (st:'a->'a) Pr`) (GEN (`Pr:('a->'a)list`) (BETA_RULE (SPEC_ALL (SPEC + (`\(p:'a->bool) q Pr. + (r UNLESS b) Pr ==> ((p /\* r) LEADSTO ((q /\* r) \/* b)) Pr`) + LEADSTO_thm17)))));; + +let LEADSTO_thm29_lemma05_1 = TAC_PROOF + (([], + (`(!p'':'a->bool. p'' In P ==> (p'' LEADSTO q')(CONS st Pr)) ==> + (!p''. p'' In P ==> + (p'' LEADSTO q')(CONS st Pr) ==> (r UNLESS b)(CONS st Pr) ==> + ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> + (!p''. p'' In P ==> (r UNLESS b)(CONS st Pr) ==> + ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC);; + +let LEADSTO_thm29_lemma05_2 = TAC_PROOF + (([], + (`!(P:('a->bool)->bool) r q st Pr. + (!p. p In P ==> ((p /\* r) LEADSTO q)(CONS st Pr)) ==> + (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) ==> + (((LUB P) /\* r) LEADSTO q)(CONS st Pr)`)), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm3a THEN + ASSUME_TAC (SPECL + [(`LUB (P:('a->bool)->bool)`); (`r:'a->bool`)] SYM_AND_IMPLY_WEAK_lemma) THEN + ASSUME_TAC (UNDISCH (SPEC_ALL (SPECL + [(`(LUB P) /\* (r:'a->bool)`); (`(LUB P):'a->bool`)] ENSURES_cor1))) THEN + IMP_RES_TAC LEADSTO_thm0 THEN + IMP_RES_TAC LEADSTO_thm1);; + +let LEADSTO_thm29_lemma05_3 = TAC_PROOF + (([], + (`!(p:'a->bool) P r. + p In (\p''. ?p'. p' In P /\ (p'' = p' /\* r)) + = + (?p'. p' In P /\ (p = p' /\* r))`)), + REWRITE_TAC [IN] THEN + BETA_TAC THEN + REWRITE_TAC []);; + +let LEADSTO_thm29_lemma05_4 = TAC_PROOF + (([], + (`!s:'a. + ((LUB P) /\* r)s = + (LUB(\p. ?p'. p' In P /\ (p = p' /\* r)))s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [LUB; AND_def ] THEN + BETA_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + EXISTS_TAC (`\s:'a. p s /\ r s`) THEN + BETA_TAC THEN + ASM_REWRITE_TAC [] THEN + EXISTS_TAC (`p:'a->bool`) THEN + ASM_REWRITE_TAC [IN] + ; + EXISTS_TAC (`p':'a->bool`) THEN + REWRITE_TAC [REWRITE_RULE [IN] (ASSUME (`(p':'a->bool) In P`))] THEN + STRIP_ASSUME_TAC (BETA_RULE (SUBS [ASSUME (`p = (\s:'a. p' s /\ r s)`)] + (ASSUME (`(p:'a->bool) s`)))) + ; + STRIP_ASSUME_TAC (BETA_RULE (SUBS [ASSUME (`p = (\s:'a. p' s /\ r s)`)] + (ASSUME (`(p:'a->bool) s`)))) + ]);; + +let LEADSTO_thm29_lemma05_5 = TAC_PROOF + (([], + (`!(P:('a->bool)->bool) r q' b st Pr. + (!p''. p'' In P ==> ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) + ==> + (!p. (?p'. p' In P /\ (p = p' /\* r)) ==> + (p LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC []);; + +let LEADSTO_thm29_lemma05_6 = TAC_PROOF + (([], + (`!(P:('a->bool)->bool) r q' b st Pr. + (!p''. + p'' In P ==> + ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) + ==> ((((LUB P) /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm29_lemma05_3] (SPECL + [(`\p:'a->bool. ?p'. p' In P /\ (p = (p' /\* r))`); + (`(q' /\* r) \/* (b:'a->bool)`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm3a)) THEN + ASSUME_TAC (REWRITE_RULE [UNDISCH (SPEC_ALL LEADSTO_thm29_lemma05_5)] + (ASSUME (`(!p:'a->bool. (?p'. p' In P /\ (p = p' /\* r)) ==> + (p LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> + ((LUB(\p. ?p'. p' In P /\ (p = p' /\* r))) LEADSTO ((q' /\* r) \/* b)) + (CONS st Pr)`))) THEN + ASM_REWRITE_TAC [REWRITE_RULE [ETA_AX] (MK_ABS LEADSTO_thm29_lemma05_4)]);; + + +let LEADSTO_thm29_lemma05 = TAC_PROOF + (([], + (`!(p':'a->bool) q' r b st Pr. + ((p' ENSURES q')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) ==> + ((p' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) /\ + (!r'. + (p' LEADSTO r')(CONS st Pr) /\ + ((p' LEADSTO r')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) ==> + ((p' /\* r) LEADSTO ((r' /\* r) \/* b))(CONS st Pr)) /\ + (r' LEADSTO q')(CONS st Pr) /\ + ((r' LEADSTO q')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) ==> + ((r' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> + (p' LEADSTO q')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) ==> + ((p' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) /\ + (!P. + (!p''. p'' In P ==> (p'' LEADSTO q')(CONS st Pr)) /\ + (!p''. + p'' In P ==> + (p'' LEADSTO q')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) ==> + ((p'' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)) ==> + ((LUB P) LEADSTO q')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) ==> + (((LUB P) /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr))`)), + REPEAT GEN_TAC THEN + REPEAT CONJ_TAC THENL + [ + REPEAT STRIP_TAC THEN + IMP_RES_TAC ENSURES_thm4 THEN + ASSUME_TAC (SPECL + [(`p':'a->bool`); (`q':'a->bool`); (`b:'a->bool`); (`r:'a->bool`)] + IMPLY_WEAK_lemma6) THEN + ASSUME_TAC (MP (SPECL + [(`(r:'a->bool) /\* p'`); + (`((r:'a->bool) /\* q') \/* ((p' /\* b) \/* (b /\* q'))`); + (`((q':'a->bool) /\* r) \/* b`); (`(CONS st Pr):('a->'a)list`)] ENSURES_thm2) + (CONJ (REWRITE_RULE [OR_ASSOC_lemma] + (ASSUME (`(((r:'a->bool) /\* p') ENSURES + (((r /\* q') \/* (p' /\* b)) \/* (b /\* q')))(CONS st Pr)`))) + (ASSUME (`!s:'a. ((r /\* q') \/* ((p' /\* b) \/* (b /\* q')))s ==> + ((q' /\* r) \/* b)s`)))) THEN + ONCE_REWRITE_TAC [AND_COMM_lemma] THEN + ONCE_REWRITE_TAC [AND_COMM_OR_lemma] THEN + IMP_RES_TAC (SPECL [(`(r:'a->bool) /\* p'`); (`((q':'a->bool) /\* r) \/* b`); + (`(CONS st Pr):('a->'a)list`)] LEADSTO_thm0) + ; + REPEAT STRIP_TAC THEN + ASSUME_TAC (MP (MP (ASSUME (`((p':'a->bool) LEADSTO r')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) + ==> ((p' /\* r) LEADSTO ((r' /\* r) \/* b))(CONS st Pr)`)) + (ASSUME (`((p':'a->bool) LEADSTO r')(CONS st Pr)`))) + (ASSUME (`((r:'a->bool) UNLESS b)(CONS st Pr)`))) THEN + ASSUME_TAC (MP (MP (ASSUME (`((r':'a->bool) LEADSTO q')(CONS st Pr) ==> + (r UNLESS b)(CONS st Pr) + ==> ((r' /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)`)) + (ASSUME (`((r':'a->bool) LEADSTO q')(CONS st Pr)`))) + (ASSUME (`((r:'a->bool) UNLESS b)(CONS st Pr)`))) THEN + ACCEPT_TAC (REWRITE_RULE [OR_ASSOC_lemma; OR_OR_lemma] + (ONCE_REWRITE_RULE [OR_COMM_lemma] (MP (SPECL + [(`(p':'a->bool) /\* r`); (`b:'a->bool`); (`(r':'a->bool) /\* r`); + (`((q':'a->bool) /\* r) \/* b`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28) + (CONJ (ONCE_REWRITE_RULE [OR_COMM_lemma] + (ASSUME + (`(((p':'a->bool) /\* r) LEADSTO ((r' /\* r) \/* b))(CONS st Pr)`))) + (ASSUME + (`(((r':'a->bool) /\* r) LEADSTO ((q' /\* r) \/* b))(CONS st Pr)`)))))) + ; + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [ASSUME (`((r:'a->bool) UNLESS b)(CONS st Pr)`)] + (UNDISCH_ALL LEADSTO_thm29_lemma05_1)) THEN + IMP_RES_TAC LEADSTO_thm29_lemma05_6 + ]);; + +let LEADSTO_thm29_lemma06 = + GEN_ALL (MP (SPEC_ALL LEADSTO_thm29_lemma00) + (GEN (`p':'a->bool`) (GEN (`q':'a->bool`) (SPEC_ALL LEADSTO_thm29_lemma05))));; + +let LEADSTO_thm29 = prove_thm + ("LEADSTO_thm29", + (`!(p:'a->bool) q r b st Pr. + (p LEADSTO q)(CONS st Pr) /\ (r UNLESS b)(CONS st Pr) + ==> ((p /\* r) LEADSTO ((q /\* r) \/* b))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + REWRITE_TAC [UNDISCH_ALL (SPEC_ALL LEADSTO_thm29_lemma06)]);; + +(* Prove: + !p st Pr. (p LEADSTO False)(CONS st Pr) ==> (!s. Not p s) +*) +let LEADSTO_thm30_lemma00 = BETA_RULE + (SPEC (`CONS (st:'a->'a) Pr`) (GEN (`Pr:('a->'a)list`) (BETA_RULE (SPEC_ALL (SPEC + (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). (q = False) ==> (!s. Not p s)`) + LEADSTO_thm21)))));; + +let LEADSTO_thm30_lemma01 = TAC_PROOF + (([], + (`!(r:'a->bool). (!s. Not r s) ==> (!s. r s = False s)`)), + REWRITE_TAC [NOT_def1; FALSE_def] THEN + BETA_TAC THEN + REWRITE_TAC []);; + +(* + |- (!s. Not r s) ==> (r = False) +*) +let LEADSTO_thm30_lemma02 = (DISCH_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (UNDISCH + (SPEC_ALL LEADSTO_thm30_lemma01)))));; + +let LEADSTO_thm30_lemma03 = TAC_PROOF + (([], + (`!p:'a->bool. + (p' = (\s:'a->'a. ?p. P p /\ p s)) ==> (!s. p' s = ?p. P p /\ p s)`)), + GEN_TAC THEN + DISCH_TAC THEN + GEN_TAC THEN + ONCE_ASM_REWRITE_TAC [] THEN + BETA_TAC THEN + REFL_TAC);; + +let LEADSTO_thm30_lemma04 = TAC_PROOF + (([], + (`!(p':'a->bool) (q':'a->bool). + ((p' ENSURES q')(CONS st Pr) ==> (q' = False) ==> (!s. Not p' s)) /\ + (!r:'a->bool. + ((r = False) ==> (!s. Not p' s)) /\ + ((q' = False) ==> (!s. Not r s)) ==> + (q' = False) ==> (!s. Not p' s)) /\ + (!P:('a->bool)->bool. + (p' = LUB P) /\ + (!p''. p'' In P ==> (q' = False) ==> (!s. Not p'' s)) ==> + (q' = False) ==> (!s. Not p' s))`)), + REPEAT GEN_TAC THEN + REPEAT CONJ_TAC THENL + [ + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [ASSUME (`(q':'a->bool) = False`)] + (ASSUME (`((p':'a->bool) ENSURES q')(CONS st Pr)`))) THEN + IMP_RES_TAC ENSURES_thm3 THEN + ASM_REWRITE_TAC [] + ; + REPEAT STRIP_TAC THEN + RES_TAC THEN + IMP_RES_TAC LEADSTO_thm30_lemma02 THEN + RES_TAC THEN + ASM_REWRITE_TAC [] + ; + REPEAT GEN_TAC THEN + REWRITE_TAC [LUB; IN; NOT_def1; FALSE_def] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [ASSUME (`(q':'a->bool) = \s. F`)] (ASSUME + (`!p'':'a->bool. P p'' + ==> ((q':'a->bool) = \s. F) ==> (!s. ~p'' s)`))) THEN + IMP_RES_TAC LEADSTO_thm30_lemma03 THEN + UNDISCH_TAC(`(p':'a->bool)s`) THEN + ASM_REWRITE_TAC [] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC + ]);; + +(* + |- !p q st Pr. (p LEADSTO q)(CONS st Pr) ==> (q = False) ==> (!s. Not p s) +*) +let LEADSTO_thm30_lemma05 = + GEN_ALL (MP (SPEC_ALL LEADSTO_thm30_lemma00) LEADSTO_thm30_lemma04);; + +let LEADSTO_thm30_lemma06 = TAC_PROOF + (([], + (`!(p:'a->bool) st Pr. + (p LEADSTO False)(CONS st Pr) + ==> (?q. (q = False) /\ (p LEADSTO q)(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + EXISTS_TAC (`False:'a->bool`) THEN + ASM_REWRITE_TAC []);; + +(* Now Prove: + |- !p st Pr. (p LEADSTO False)(CONS st Pr) ==> (!s. Not p s) +*) +let LEADSTO_thm30 = prove_thm + ("LEADSTO_thm30", + (`!(p:'a->bool) st Pr. (p LEADSTO False)(CONS st Pr) ==> (!s. Not p s)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm30_lemma06 THEN + REWRITE_TAC [UNDISCH_ALL (SPEC_ALL LEADSTO_thm30_lemma05)]);; + + +(* Prove: + |- !p b q Pr. + ((p /\* b) LEADSTO q)Pr /\ ((p /\* (Not b)) LEADSTO q)Pr ==> (p LEADSTO q)Pr +*) +let LEADSTO_cor1 = prove_thm + ("LEADSTO_cor1", + (`!(p:'a->bool) b q Pr. + ((p /\* b) LEADSTO q) Pr /\ ((p /\* (Not b)) LEADSTO q) Pr + ==> (p LEADSTO q) Pr`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC (SPECL [(`(p:'a->bool) /\* b`); (`(p:'a->bool) /\* (Not b)`); + (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO_thm4) THEN + ACCEPT_TAC (REWRITE_RULE [SYM (SPEC_ALL AND_OR_DISTR_lemma); + P_OR_NOT_P_lemma; AND_True_lemma] + (ASSUME (`((((p:'a->bool) /\* b) \/* (p /\* (Not b))) LEADSTO q)Pr`))));; + + +(* Prove: + |- !p q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ r STABLE (CONS st Pr) ==> + ((p /\* r) LEADSTO (q /\* r))(CONS st Pr) +*) +let LEADSTO_cor2 = prove_thm + ("LEADSTO_cor2", + (`!(p:'a->bool) q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ r STABLE (CONS st Pr) + ==> ((p /\* r) LEADSTO (q /\* r))(CONS st Pr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm29 THEN + ACCEPT_TAC (REWRITE_RULE [OR_False_lemma] (ASSUME + (`(((p:'a->bool) /\* r) LEADSTO ((q /\* r) \/* False))(CONS st Pr)`))));; + + +(* Prove: + |- !p q st Pr. + (p LEADSTO q)(CONS st Pr) = ((p /\* (Not q)) LEADSTO q)(CONS st Pr) +*) +let LEADSTO_cor3 = prove_thm + ("LEADSTO_cor3", + (`!(p:'a->bool) q st Pr. + (p LEADSTO q)(CONS st Pr) = ((p /\* (Not q)) LEADSTO q)(CONS st Pr)`), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + ASSUME_TAC (REWRITE_RULE [NOT_NOT_lemma] + (SPECL [(`Not (q:'a->bool)`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm2)) THEN + IMP_RES_TAC LEADSTO_thm29 THEN + ASSUME_TAC (REWRITE_RULE [P_AND_NOT_P_lemma] + (ASSUME (`(((p:'a->bool) /\* (Not q)) LEADSTO + ((q /\* (Not q)) \/* q))(CONS st Pr)`))) THEN + ACCEPT_TAC (REWRITE_RULE [OR_False_lemma] + (ONCE_REWRITE_RULE [OR_COMM_lemma] (ASSUME + (`(((p:'a->bool) /\* (Not q)) LEADSTO (False \/* q))(CONS st Pr)`)))) + ; + ASSUME_TAC (MP + (SPECL [(`(p:'a->bool) /\* q`); (`q:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm25) + (SPECL [(`p:'a->bool`); (`q:'a->bool`)] AND_IMPLY_WEAK_lemma)) THEN + IMP_RES_TAC LEADSTO_cor1 + ]);; + + +(* Prove: + |- !p b q st Pr. + ((p /\* b) LEADSTO q)(CONS st Pr) /\ + ((p /\* (Not b)) LEADSTO ((p /\* b) \/* q))(CONS st Pr) ==> + (p LEADSTO q)(CONS st Pr) +*) +let LEADSTO_cor4 = prove_thm + ("LEADSTO_cor4", + (`!(p:'a->bool) b q st Pr. + ((p /\* b) LEADSTO q)(CONS st Pr) /\ + ((p /\* (Not b)) LEADSTO ((p /\* b) \/* q))(CONS st Pr) + ==> (p LEADSTO q)(CONS st Pr)`), + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm28 THEN + ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (ASSUME + (`(((p:'a->bool) /\* (Not b)) LEADSTO (q \/* q))(CONS st Pr)`))) THEN + IMP_RES_TAC LEADSTO_cor1);; + + +(* Prove: + |- !p q r st Pr. + ((p /\* q) LEADSTO r)(CONS st Pr) ==> (p LEADSTO ((Not q) \/* r))(CONS st Pr) +*) +let LEADSTO_cor5 = prove_thm + ("LEADSTO_cor5", + (`!(p:'a->bool) q r st Pr. + ((p /\* q) LEADSTO r)(CONS st Pr) + ==> (p LEADSTO ((Not q) \/* r))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC [LEADSTO_cor3] THEN + REWRITE_TAC [NOT_OR_AND_NOT_lemma; NOT_NOT_lemma] THEN + ASSUME_TAC (REWRITE_RULE [NOT_NOT_lemma] + (SPECL [(`Not (r:'a->bool)`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm2)) THEN + IMP_RES_TAC LEADSTO_thm29 THEN + ASSUME_TAC (REWRITE_RULE [AND_ASSOC_lemma; P_AND_NOT_P_lemma] (ASSUME + (`((((p:'a->bool) /\* q) /\* (Not r)) LEADSTO ((r /\* (Not r)) \/* r)) + (CONS st Pr)`))) THEN + ASSUME_TAC (REWRITE_RULE [OR_False_lemma] (ONCE_REWRITE_RULE + [OR_COMM_lemma] (ASSUME (`(((p:'a->bool) /\* (q /\* (Not r))) LEADSTO + (False \/* r))(CONS st Pr)`)))) THEN + ASSUME_TAC (MP + (SPEC_ALL (SPECL [(`r:'a->bool`); (`(Not (q:'a->bool)) \/* r`)] LEADSTO_thm25)) + (SPECL [(`r:'a->bool`); (`Not (q:'a->bool)`)] SYM_OR_IMPLY_WEAK_lemma)) THEN + IMP_RES_TAC LEADSTO_thm1);; + + +(* Prove: + |- !p q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (r UNLESS (q /\* r))(CONS st Pr) ==> + ((p /\* r) LEADSTO (q /\* r))(CONS st Pr) +*) +let LEADSTO_cor6 = prove_thm + ("LEADSTO_cor6", + (`!(p:'a->bool) q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (r UNLESS (q /\* r))(CONS st Pr) + ==> ((p /\* r) LEADSTO (q /\* r))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm29 THEN + ACCEPT_TAC (REWRITE_RULE [OR_OR_lemma] (ASSUME + (`(((p:'a->bool) /\* r) LEADSTO ((q /\* r) \/* (q /\* r)))(CONS st Pr)`))));; + + +(* Prove: + |- !p q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (r /\* (Not q)) STABLE (CONS st Pr) ==> + (!s. (p /\* r)s ==> q s) +*) +let LEADSTO_cor7 = prove_thm + ("LEADSTO_cor7", + (`!(p:'a->bool) q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (r /\* (Not q)) STABLE (CONS st Pr) + ==> (!s. (p /\* r)s ==> q s)`), + REPEAT GEN_TAC THEN + STRIP_TAC THEN + IMP_RES_TAC LEADSTO_cor2 THEN + ASSUME_TAC (REWRITE_RULE + [(SYM (SPEC_ALL AND_ASSOC_lemma)); P_AND_NOT_P_lemma] + (ONCE_REWRITE_RULE [AND_AND_COMM_lemma] (ASSUME + (`(((p:'a->bool) /\* (r /\* (Not q))) LEADSTO + (q /\* (r /\* (Not q))))(CONS st Pr)`)))) THEN + ASSUME_TAC (REWRITE_RULE [AND_False_lemma] + (ONCE_REWRITE_RULE [AND_COMM_lemma] (ASSUME + (`((((p:'a->bool) /\* (Not q)) /\* r) LEADSTO (False /\* r)) + (CONS st Pr)`)))) THEN + IMP_RES_TAC LEADSTO_thm30 THEN + GEN_TAC THEN + MP_TAC (SPEC_ALL (ASSUME (`!s:'a. Not (r /\* (p /\* (Not q)))s`))) THEN + REWRITE_TAC [NOT_def1; AND_def] THEN + BETA_TAC THEN + REWRITE_TAC [DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; + +(* + Prove: + |- !p r q st Pr. + (p LEADSTO r)(CONS st Pr) ==> ((p /\* q) LEADSTO r)(CONS st Pr) +*) +let LEADSTO_cor8 = prove_thm + ("LEADSTO_cor8", + (`!(p:'a->bool) r q st Pr. (p LEADSTO r)(CONS st Pr) + ==> ((p /\* q) LEADSTO r)(CONS st Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPECL + [`p:'a->bool`; `q:'a->bool`] SYM_AND_IMPLY_WEAK_lemma) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [`(p:'a->bool) /\* q`; `p:'a->bool`; `st:'a->'a`; `Pr:('a->'a)list`] + LEADSTO_thm25)) THEN + IMP_RES_TAC LEADSTO_thm1);; + +(* + Prove: + |- !p q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (!s. q s ==> r s) ==> + (p LEADSTO r)(CONS st Pr) +*) +let LEADSTO_cor9 = prove_thm + ("LEADSTO_cor9", + (`!(p:'a->bool) q r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (!s. q s ==> r s) + ==> (p LEADSTO r)(CONS st Pr)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm25 THEN + ASSUME_TAC (SPEC_ALL (ASSUME + (`!st Pr. ((q:'a->bool) LEADSTO r)(CONS st Pr)`))) THEN + IMP_RES_TAC LEADSTO_thm1);; + + +(* Prove: + |- !P q Pr. (!i. ((P i) LEADSTO q)Pr) ==> (!i. (( \<=/* P i) LEADSTO q)Pr) +*) +let LEADSTO_cor10 = prove_thm + ("LEADSTO_cor10", + (`!(P:num->'a->bool) q Pr. + (!i. ((P i) LEADSTO q)Pr) ==> (!i. (( \<=/* P i) LEADSTO q)Pr)`), + REPEAT GEN_TAC THEN + STRIP_TAC THEN + INDUCT_TAC THENL + [ + ASM_REWRITE_TAC [OR_LE_N_def] + ; + REWRITE_TAC [OR_LE_N_def] THEN + ACCEPT_TAC (MP + (SPECL [(` \<=/* (P:num->'a->bool) i`); (`(P:num->'a->bool) (SUC i)`); + (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO_thm4) (CONJ + (ASSUME (`(( \<=/* (P:num->'a->bool) i) LEADSTO q)Pr`)) + (SPEC (`SUC i`) (ASSUME (`!i. (((P:num->'a->bool) i) LEADSTO q)Pr`))))) + ]);; + + +(* Prove: + !p st Pr. (False LEADSTO p) (CONS st Pr) +*) +let LEADSTO_cor11 = prove_thm + ("LEADSTO_cor11", + (`!(p:'a->bool) st Pr. (False LEADSTO p) (CONS st Pr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [LEADSTO;LeadstoRel] THEN + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ENSURES_cor6] (CONJUNCT1 + (SPECL [(`False:'a->bool`); (`p:'a->bool`)] + (ASSUME (`!(p:'a->bool) q. + ((p ENSURES q)(CONS st Pr) ==> R p q(CONS st Pr)) /\ + (!r. R p r(CONS st Pr) /\ R r q(CONS st Pr) ==> R p q(CONS st Pr)) /\ + (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q(CONS st Pr)) ==> + R p q(CONS st Pr))`))))));; + + +(* Prove: + |- !P q st Pr. (!i. ((P i) LEADSTO q)(CONS st Pr)) ==> + (!i. (( \'a->bool) q st Pr. + (!i. ((P i) LEADSTO q)(CONS st Pr)) + ==> (!i. (( \'a->bool) i`); (`(P:num->'a->bool) i`); + (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] LEADSTO_thm4) (CONJ + (ASSUME (`(( \'a->bool) i) LEADSTO q)(CONS st Pr)`)) + (SPEC (`i:num`) + (ASSUME (`!i. (((P:num->'a->bool) i) LEADSTO q)(CONS st Pr)`))))));; + +(* + We now want to introduce some tactics for allowing structural induction + of leadsto relations, but we have problems with the induction principle + for the completion theorem: + + !P Q R P' Q' Pr. + (P LEADSTO Q)Pr /\ (P' LEADSTO Q')Pr /\ (Q UNLESS R)Pr /\ (Q' UNLESS R)Pr + ==> ((P /\* P') LEADSTO ((Q /\* Q') \/* R))Pr + + since this theorems demands another induction principle not directly + derivable from the given definition of leadsto. + + We circumvent the problem by proving that leadsto may be defined by another + functional. + + This time we use the results of Tarski directly. +*) +(* *) +(* + Suppose we wanted to change the transitive inductitive axiom into + + p ensures r, r leadsto q + --------------------------- (2) + p leadsto q + + instead of the previous given. + + Let us investigate the following definition a litte: + + Now the functional becomes +*) + +(* + |- !R Pr. + LEADSTO2Fn R Pr = + (\p q. + (p ENSURES q) Pr \/ + (?r. (p ENSURES r) Pr /\ R r q Pr) \/ + (?P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr))) +*) +let LEADSTO2Fn = new_definition + (`LEADSTO2Fn R = \(p:'a->bool) q Pr. + (p ENSURES q) Pr \/ + (?r. (p ENSURES r) Pr /\ R r q Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> R p q Pr))`);; + +(* + |- !p q Pr. + LEADSTO2 p q Pr = + (!R Pr. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr) +*) +let LEADSTO2 = new_definition + (`LEADSTO2 (p:'a->bool) q Pr = + !R. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> R p q Pr`);; + +(* + |- !R p q Pr. + (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> + (!p q. + (\p q Pr. !R. + (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> R p q Pr) p q Pr + ==> + R p q Pr) +*) +let LEADSTO2Imply_1 = TAC_PROOF + (([], + (`!R (p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). + (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> + (!p q. (\p q Pr. !R. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) + ==> R p q Pr) p q Pr + ==> R p q Pr)`)), + BETA_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* + |- !R1 R2 Pr. + (!p q. R1 p q Pr ==> R2 p q Pr) ==> + (!p q. LEADSTO2Fn R1 p q Pr ==> LEADSTO2Fn R2 p q Pr) +*) +let IsMonoLEADSTO2 = TAC_PROOF + (([], + (`!R1 R2 (Pr:('a->'a)list). + (!p q. R1 p q Pr ==> R2 p q Pr) + ==> (!p q. LEADSTO2Fn R1 p q Pr ==> LEADSTO2Fn R2 p q Pr)`)), + REWRITE_TAC [LEADSTO2Fn] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + RES_TAC THEN + DISJ2_TAC THEN + DISJ1_TAC THEN + EXISTS_TAC (`r:'a->bool`) THEN + ASM_REWRITE_TAC [] + ; + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`P:('a->bool)->bool`) THEN + ASM_REWRITE_TAC [] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC + ]);; + +(* +LEADSTO2th = + |- LEADSTO2 = + (\p q Pr. + !R. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) ==> R p q Pr) +*) +let LEADSTO2th = (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`p:'a->bool`) (MK_ABS + (GEN (`q:'a->bool`) (MK_ABS (GEN (`Pr:('a->'a)list`) (SPEC_ALL LEADSTO2))))))));; + +(* + |- !p q Pr. LEADSTO2Fn LEADSTO2 p q Pr ==> LEADSTO2 p q Pr +*) +let LEADSTO2Imply1 = TAC_PROOF + (([], + (`!(p:'a->bool) q Pr. + LEADSTO2Fn LEADSTO2 p q Pr ==> LEADSTO2 p q Pr`)), + REPEAT GEN_TAC THEN + ASSUME_TAC (GENL + [(`R1:('a->bool)->('a->bool)->(('a->'a)list)->bool`); + (`R2:('a->bool)->('a->bool)->(('a->'a)list)->bool`)] + (SPEC_ALL IsMonoLEADSTO2)) THEN + REWRITE_TAC [LEADSTO2th] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (MP (SPEC_ALL (MP (BETA_RULE (SPEC_ALL (SPECL + [(`\(p:'a->bool) q Pr. !R. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) + ==> R p q Pr`); + (`R:('a->bool)->('a->bool)->(('a->'a)list)->bool`)] IsMonoLEADSTO2))) + (BETA_RULE (MP (SPEC_ALL LEADSTO2Imply_1) + (ASSUME (`!(p':'a->bool) q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr`)))))) + (ASSUME (`LEADSTO2Fn (\(p:'a->bool) q Pr. + !R. (!p' q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) + ==> R p q Pr) p q Pr`))) THEN + RES_TAC);; + +(* + |- !p q Pr. LEADSTO2 p q Pr ==> LEADSTO2Fn LEADSTO2 p q Pr +*) +let LEADSTO2Imply2 = TAC_PROOF + (([], + (`!(p:'a->bool) q Pr. LEADSTO2 p q Pr ==> LEADSTO2Fn LEADSTO2 p q Pr`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [ETA_AX] (MP (BETA_RULE (SPECL + [(`\p q Pr. LEADSTO2Fn LEADSTO2 (p:'a->bool) q Pr`); + (`LEADSTO2:('a->bool)->('a->bool)->(('a->'a)list)->bool`); + (`Pr:('a->'a)list`)] IsMonoLEADSTO2)) + (GENL [(`p:'a->bool`); (`q:'a->bool`)] (SPEC_ALL LEADSTO2Imply1)))) THEN + ACCEPT_TAC (UNDISCH (GEN_ALL (SPEC + (`LEADSTO2Fn (LEADSTO2:('a->bool)->('a->bool)->(('a->'a)list)->bool)`) (BETA_RULE + (REWRITE_RULE [LEADSTO2] (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`))))))));; + +(* + |- !p q Pr. LEADSTO2 p q Pr = LEADSTO2Fn LEADSTO2 p q Pr +*) +let LEADSTO2EQs = TAC_PROOF + (([], + (`!(p:'a->bool) q Pr. LEADSTO2 p q Pr = LEADSTO2Fn LEADSTO2 p q Pr`)), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO2Imply2) + ; + ACCEPT_TAC (SPEC_ALL LEADSTO2Imply1) + ]);; + +(* + |- LEADSTO2 = LEADSTO2Fn LEADSTO2 +*) +let LEADSTO2EQ = + (REWRITE_RULE [ETA_AX] + (MK_ABS (GEN (`p:'a->bool`) + (MK_ABS (GEN (`q:'a->bool`) (MK_ABS (GEN (`Pr:('a->'a)list`) + (SPEC_ALL LEADSTO2EQs))))))));; + +(* + |- !R. (R = LEADSTO2Fn R) ==> (!p q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr) +*) +let LEADSTO2Thm1_1 = TAC_PROOF + (([], + (`!R. (R = LEADSTO2Fn R) + ==> (!(p:'a->bool) q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr)`)), + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC + [ASSUME + (`R = LEADSTO2Fn (R:('a->bool)->('a->bool)->(('a->'a)list)->bool)`)] THEN + REWRITE_TAC [ASSUME (`LEADSTO2Fn R (p:'a->bool) q Pr`)]);; + +(* + |- !R. (R = LEADSTO2Fn R) ==> (!p q Pr. LEADSTO2 p q Pr ==> R p q Pr) +*) +let LEADSTO2MinFixThm = TAC_PROOF + (([], + (`!R. (R = LEADSTO2Fn R) + ==> (!(p:'a->bool) q Pr. LEADSTO2 p q Pr ==> R p q Pr)`)), + REWRITE_TAC [LEADSTO2] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPEC_ALL (ASSUME + (`!R. (!(p':'a->bool) q'. LEADSTO2Fn R p' q' Pr ==> R p' q' Pr) + ==> R p q Pr`))) THEN + ASSUME_TAC (GENL [(`p:'a->bool`); (`q:'a->bool`)] (SPEC_ALL + (UNDISCH (SPEC_ALL LEADSTO2Thm1_1)))) THEN + RES_TAC);; + +(* + |- !R. + (!p q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr) ==> + (!p q Pr. LEADSTO2 p q Pr ==> R p q Pr) +*) +let LEADSTO2InductThm = TAC_PROOF + (([], + (`!R. (!(p:'a->bool) q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr) + ==> (!p q Pr. LEADSTO2 p q Pr ==> R p q Pr)`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [LEADSTO2] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (GENL [(`p:'a->bool`); (`q:'a->bool`)] (SPEC_ALL (ASSUME + (`!(p:'a->bool) q Pr. LEADSTO2Fn R p q Pr ==> R p q Pr`)))) THEN + RES_TAC);; + +(* + |- !R Pr. + LEADSTO2Fam R Pr = + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr) +*) +let LEADSTO2Fam = new_definition + (`LEADSTO2Fam R Pr = + !(p:'a->bool) (q:'a->bool). + ((p ENSURES q) Pr ==> R p q Pr) /\ + (!r. (p ENSURES r) Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr)`);; + +(* + |- !R Pr. (!p q. LEADSTO2Fn R p q Pr ==> R p q Pr) = LEADSTO2Fam R Pr +*) +let LEADSTO2Fn_EQ_LEADSTO2Fam = TAC_PROOF + (([], + (`!R Pr. + (!(p:'a->bool) q. LEADSTO2Fn R p q Pr ==> R p q Pr) = LEADSTO2Fam R Pr`)), + REWRITE_TAC [LEADSTO2Fam; LEADSTO2Fn] THEN + BETA_TAC THEN + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC THENL + [ + REWRITE_TAC [REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p. (p = LUB (P:('a->bool)->bool)) ==> + (R:('a->bool)->('a->bool)->(('a->'a)list)->bool) p q Pr`)))] + ; + ASM_REWRITE_TAC [] + ]);; + + +(* + Prove that the wanted axioms 1; 2, 3 are really theorems for the found + fixed point +*) + +(* + |- !p q Pr. (p ENSURES q)Pr ==> LEADSTO2 p q Pr +*) +let LEADSTO2_thm0 = prove_thm + ("LEADSTO2_thm0", + (`!(p:'a->bool) q Pr. (p ENSURES q) Pr ==> LEADSTO2 p q Pr`), + REWRITE_TAC [LEADSTO2; LEADSTO2Fn] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* + |- !p r q Pr. (p ENSURES r)Pr /\ LEADSTO2 r q Pr ==> LEADSTO2 p q Pr +*) +let LEADSTO2_thm1 = prove_thm + ("LEADSTO2_thm1", + (`!(p:'a->bool) r q Pr. + (p ENSURES r) Pr /\ (LEADSTO2 r q Pr) ==> (LEADSTO2 p q Pr)`), + REWRITE_TAC [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC);; + + +(* Prove: + |- !P q Pr. (!p. p In P ==> LEADSTO2 p q Pr) ==> LEADSTO2(LUB P)q Pr +*) +let LEADSTO2_thm3_lemma1 = TAC_PROOF + (([], + (`(!p:'a->bool. p In P ==> + (!R. + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr)) ==> + R p q Pr)) ==> + (!p. p In P ==> + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr)) ==> + R p q Pr)`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO2_thm3 = prove_thm + ("LEADSTO2_thm3", + (`!(P:('a->bool)->bool) q Pr. + (!p. p In P ==> LEADSTO2 p q Pr) ==> LEADSTO2 (LUB P) q Pr`), + REPEAT GEN_TAC THEN + REWRITE_TAC [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (GEN_ALL (REWRITE_RULE[ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr)`)] + (SPEC_ALL (UNDISCH (SPEC_ALL LEADSTO2_thm3_lemma1))))) THEN + RES_TAC);; + +let LEADSTO2_thm3a = prove_thm + ("LEADSTO2_thm3a", + (`!(P:('a->bool)->bool) q Pr. + (p = LUB P) /\ (!p. p In P ==> LEADSTO2 p q Pr) + ==> LEADSTO2 p q Pr`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO2_thm3 THEN + ASM_REWRITE_TAC []);; + +(* + !p1 p2 q Pr. (LEADSTO2 p1 q Pr) /\ (LEADSTO2 p2 q Pr) + ==> (LEADSTO2 (p1 \/* p2) q Pr) +*) + +(* + To prove this we need some general lemmas about expressing two known + relations as one relation: +*) + +(* + |- !p1 p2 s. (p1 \/* p2)s = LUB(\p. (p = p1) \/ (p = p2))s +*) +let LEADSTO2_thm4_lemma1a = TAC_PROOF + (([], + (`!(p1:'a->bool) p2 s. (p1 \/* p2) s = (LUB (\p. (p = p1) \/ (p = p2))) s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [LUB; OR_def] THEN + BETA_TAC THEN + EQ_TAC THENL + [ + STRIP_TAC THENL + [ + EXISTS_TAC (`p1:'a->bool`) THEN + ASM_REWRITE_TAC [] + ; + EXISTS_TAC (`p2:'a->bool`) THEN + ASM_REWRITE_TAC [] + ] + ; + STRIP_TAC THENL + [ + REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p1`)] (ASSUME + (`(p:'a->bool) s`))] + ; + REWRITE_TAC [REWRITE_RULE [ASSUME (`(p:'a->bool) = p2`)] (ASSUME + (`(p:'a->bool) s`))] + ] + ]);; + +(* + |- !p1 p2. p1 \/* p2 = LUB(\p. (p = p1) \/ (p = p2)) +*) +let LEADSTO2_thm4_lemma1 = (GEN_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) + (SPEC_ALL LEADSTO2_thm4_lemma1a)))));; + +(* + |- !R Pr. + (!p' q'. + (p' ENSURES q')Pr \/ + (?r. (p' ENSURES r)Pr /\ R r q' Pr) \/ + (?P. (p' = LUB P) /\ (!p. p In P ==> R p q' Pr)) ==> + R p' q' Pr) ==> + (!p q P. (p = LUB P) /\ (!p. p In P ==> R p q Pr) ==> R p q Pr) +*) +let LEADSTO2_thm4_lemma2 = TAC_PROOF + (([], + (`!(R:('a->bool)->('a->bool)->(('a->'a)list)->bool) Pr. + (!p' q'. + (p' ENSURES q') Pr \/ (?r. (p' ENSURES r) Pr /\ R r q' Pr) \/ + (?P. (p' = LUB P) /\ (!p. p In P ==> R p q' Pr)) ==> R p' q' Pr) + ==> (!p q P. ((p = LUB P) /\ (!p. p In P ==> R p q Pr)) ==> R p q Pr)`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* + |- !R p1 p2 q Pr Pr. R p1 q Pr ==> R p2 q Pr ==> + (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr) +*) +let LEADSTO2_thm4_lemma3 = TAC_PROOF + (([], + (`!R (p1:'a->bool) p2 (q:'a->bool) (Pr:('a->'a)list) (Pr:('a->'a)list). + R p1 q Pr ==> R p2 q Pr ==> + (!p. (\p. (p = p1) \/ (p = p2))p ==> R p q Pr)`)), + BETA_TAC THEN + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + ASM_REWRITE_TAC [] + ]);; + +(* + |- !R p1 p2 q Pr. R p1 q Pr ==> R p2 q Pr ==> + (!p q P. (p = LUB P) /\ (!p. p In P ==> R p q Pr) ==> R p q Pr) ==> + R(p1 \/* p2)q Pr +*) +let LEADSTO2_thm4_lemma4 = TAC_PROOF + (([], + (`!R (p1:'a->bool) (p2:'a->bool) (q:'a->bool) (Pr:('a->'a)list). + R p1 q Pr ==> R p2 q Pr ==> + (!p q P. (p = LUB P) /\ (!p. p In P ==> R p q Pr) ==> R p q Pr) ==> + R (p1 \/* p2) q Pr`)), + REWRITE_TAC [IN] THEN + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [SYM (SPEC_ALL LEADSTO2_thm4_lemma1); + UNDISCH_ALL (SPEC_ALL LEADSTO2_thm4_lemma3)] + (SPECL + [(`(p1:'a->bool) \/* p2`); (`q:'a->bool`); (`\p:'a->bool. (p = p1) \/ (p = p2)`)] + (ASSUME (`!p (q:'a->bool) (P:('a->bool)->bool). (p = LUB P) /\ + (!p. P p ==> R p q Pr) ==> R p q (Pr:('a->'a)list)`)))));; + +(* + Now Prove that the finite disjunction is satisfied +*) + +(* + |- !p1 p2 q Pr. + LEADSTO2 p1 q Pr /\ LEADSTO2 p2 q Pr ==> LEADSTO2(p1 \/* p2)q Pr +*) +let LEADSTO2_thm4 = prove_thm + ("LEADSTO2_thm4", + (`!(p1:'a->bool) p2 q Pr. + (LEADSTO2 p1 q Pr) /\ (LEADSTO2 p2 q Pr) ==> LEADSTO2 (p1 \/* p2) q Pr`), + REWRITE_TAC [LEADSTO2; LEADSTO2Fn] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO2_thm4_lemma2)) THEN + ACCEPT_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO2_thm4_lemma4)));; + + +(* Prove: + + This is more difficult and we need to use structural induction + +*) + +(* + Prove the induction theorem: + |- !X p q Pr. + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ + (!P. (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr)) + ==> + LEADSTO2 p q Pr ==> X p q Pr +*) +let LEADSTO2_thm8 = prove_thm + ("LEADSTO2_thm8", + (`!X (p:'a->bool) q Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ X r q Pr ==> (X p q Pr)) /\ + (!P. (!p. p In P ==> X p q Pr) ==> (X (LUB P) q Pr))) + ==> ((LEADSTO2 p q Pr) ==> X p q Pr)`), + REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL CONJ_ASSOC)] (BETA_RULE + (SPEC (`\(p:'a->bool) (q:'a->bool) (Pr:('a->'a)list). X p q Pr:bool`) + (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] + (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`)))))) THEN + RES_TAC);; + +(* + We now use LEADSTO2_thm8 to prove a slightly modified writing of the wanted + theorem: + + !p q Pr. (LEADSTO2 p q Pr) ==> (!r. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr) + +*) + +(* + We get by specialization: + + |- (!p' q'. + + ((p' ENSURES q')Pr ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr)) /\ + + (!r. + (p' ENSURES r)Pr /\ (!r'. LEADSTO2 q' r' Pr ==> LEADSTO2 r r' Pr) + ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr)) /\ + + (!P. + (!p''. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) + ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2(LUB P)r Pr))) + + ==> + + LEADSTO2 p q Pr ==> (!r. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr) + +*) + +let LEADSTO2_thm2a = (BETA_RULE (SPECL + [(`\p q Pr. !r:'a->bool. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr`); + (`p:'a->bool`); (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO2_thm8));; + +(* + We prove the implications of Rel_thm2a: +*) + +(* + |- !p' q'. (p' ENSURES q')Pr ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr) +*) +let LEADSTO2_thm2b = TAC_PROOF + (([], + (`!(p':'a->bool) q'. + ((p' ENSURES q')Pr ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr))`)), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO2_thm1);; + +(* + |- !p' q' r. + (p' ENSURES r)Pr /\ (!r'. LEADSTO2 q' r' Pr ==> LEADSTO2 r r' Pr) ==> + (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr) +*) +let LEADSTO2_thm2c = TAC_PROOF + (([], + (`!(p':'a->bool) q'. + (!r. + (p' ENSURES r)Pr /\ (!r'. LEADSTO2 q' r' Pr ==> LEADSTO2 r r' Pr) ==> + (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p' r Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + IMP_RES_TAC LEADSTO2_thm1);; + +(* + |- !p' q' P. + (!p''. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) ==> + (!r. LEADSTO2 q' r Pr ==> LEADSTO2(LUB P)r Pr) +*) +let LEADSTO2_thm2d_lemma1 = TAC_PROOF + (([], + (`!(q':'a->bool) r Pr. + LEADSTO2 q' r Pr ==> + (!p'':'a->bool. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) + ==> (!p'':'a->bool. p'' In P ==> LEADSTO2 p'' r Pr)`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO2_thm2d = TAC_PROOF + (([], + (`!(p':'a->bool) q'. + (!P:('a->bool)->bool. + (!p''. p'' In P ==> (!r. LEADSTO2 q' r Pr ==> LEADSTO2 p'' r Pr)) ==> + (!r. LEADSTO2 q' r Pr ==> LEADSTO2(LUB P)r Pr))`)), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO2_thm2d_lemma1 THEN + IMP_RES_TAC LEADSTO2_thm3);; + +(* + Hence by rewriting we get: + + |- LEADSTO2 p q Pr ==> (!r. LEADSTO2 q r Pr ==> LEADSTO2 p r Pr) + +*) +let LEADSTO2_thm2e = +(REWRITE_RULE [LEADSTO2_thm2b; LEADSTO2_thm2c; LEADSTO2_thm2d] LEADSTO2_thm2a);; + +(* Now we may Prove: + + |- !p r q Pr. LEADSTO2 p r Pr /\ LEADSTO2 r q Pr ==> LEADSTO2 p q Pr + +*) +let LEADSTO2_thm2 = prove_thm + ("LEADSTO2_thm2", + (`!(p:'a->bool) r q Pr. + (LEADSTO2 p r Pr) /\ (LEADSTO2 r q Pr) ==> (LEADSTO2 p q Pr)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO2_thm2e);; + +(* + |- !p q Pr. + (p ENSURES q)Pr \/ + (?r. LEADSTO2 p r Pr /\ LEADSTO2 r q Pr) \/ + (?P. (p = LUB P) /\ (!p. p In P ==> LEADSTO2 p q Pr)) + = + LEADSTO2 p q Pr +*) +let LEADSTO2_thm5 = prove_thm + ("LEADSTO2_thm5", + (`!(p:'a->bool) q Pr. + ((p ENSURES q)Pr \/ + (?r. (LEADSTO2 p r Pr) /\ (LEADSTO2 r q Pr)) \/ + (?P. (p = (LUB P)) /\ (!p. p In P ==> LEADSTO2 p q Pr))) + = + (LEADSTO2 p q Pr)`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO2_thm0)) + ; + IMP_RES_TAC LEADSTO2_thm2 + ; + IMP_RES_TAC LEADSTO2_thm3 THEN + ASM_REWRITE_TAC [] + ] + ; + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + REPEAT STRIP_TAC THEN + ACCEPT_TAC (ONCE_REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME + (`LEADSTO2 (p:'a->bool) q Pr`))) + ] + ]);; + +(* + |- !p q Pr. + (p ENSURES q)Pr \/ + (?r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr) \/ + (?P. (p = ?* P) /\ (!i. LEADSTO2(P i)q Pr)) + = + LEADSTO2 p q Pr +*) +let LEADSTO2_thm6 = prove_thm + ("LEADSTO2_thm6", + (`!(p:'a->bool) q Pr. + ((p ENSURES q)Pr \/ + (?r. (p ENSURES r)Pr /\ (LEADSTO2 r q Pr)) \/ + (?P. (p = (LUB P)) /\ (!p. p In P ==> LEADSTO2 p q Pr))) + = + (LEADSTO2 p q Pr)`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ACCEPT_TAC (UNDISCH (SPEC_ALL LEADSTO2_thm0)) + ; + IMP_RES_TAC LEADSTO2_thm1 + ; + IMP_RES_TAC LEADSTO2_thm3 THEN + ASM_REWRITE_TAC [] + ] + ; + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`\(p':'a->bool). if (p = p') then T else F`) THEN + REWRITE_TAC [LUB; IN] THEN + BETA_TAC THEN + CONJ_TAC THENL + [ + ACCEPT_TAC (SPEC_ALL LEADSTO_thm5_lemma2) + ; + REWRITE_TAC [LEADSTO_thm5_lemma3] THEN + REPEAT STRIP_TAC THEN + ACCEPT_TAC (ONCE_REWRITE_RULE [ASSUME (`(p:'a->bool) = p'`)] (ASSUME + (`LEADSTO2 (p:'a->bool) q Pr`))) + ] + ]);; + +(* + Now we are able to prove another induction principle +*) + +(* + We need a lemma + +*) +let LEADSTO2_thm7_lemma01 = TAC_PROOF + (([], + (`(!p':'a->bool. + p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)) + = + ((!p'. p' In P ==> LEADSTO2 p' q Pr) /\ + (!p'. p' In P ==> LEADSTO2 p' q Pr ==> X p' q Pr))`)), + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO2_thm7_lemma = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p ENSURES r)Pr /\ + LEADSTO2 r q Pr /\ + (LEADSTO2 r q Pr ==> X r q Pr) ==> + LEADSTO2 p q Pr ==> + X p q Pr) /\ + (!P. + (!p. p In P ==> LEADSTO2 p q Pr) /\ + (!p. p In P ==> LEADSTO2 p q Pr ==> X p q Pr) ==> + LEADSTO2(LUB P)q Pr ==> + X(LUB P)q Pr)) + = + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> + LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q Pr)) /\ + (!r. + (p ENSURES r)Pr /\ + LEADSTO2 r q Pr /\ + (LEADSTO2 r q Pr ==> X r q Pr) ==> + LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q Pr)) /\ + (!P. + (!p'. + p' In P ==> + LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)) ==> + LEADSTO2(LUB P)q Pr /\ (LEADSTO2(LUB P)q Pr ==> X(LUB P)q Pr)))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + IMP_RES_TAC LEADSTO2_thm0 + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO2_thm1 + ; + RES_TAC + ; + STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO2_thm7_lemma01] (ASSUME + (`!p':'a->bool. p' In P + ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)`))) THEN + IMP_RES_TAC LEADSTO2_thm3 + ; + STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO2_thm7_lemma01] (ASSUME + (`!p':'a->bool. p' In P + ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q Pr)`))) THEN + RES_TAC + ; + RES_TAC + ; + RES_TAC + ; + ASSUME_TAC (REWRITE_RULE [SYM LEADSTO2_thm7_lemma01] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr`)) + (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr ==> X p q Pr`)))) THEN + RES_TAC + ]);; + +(* + The induction theorem: + + |- !X p q Pr. + + (!p q. + + ((p ENSURES q)Pr ==> X p q Pr) /\ + + (!r. + (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ (LEADSTO2 r q Pr ==> X r q Pr) + ==> LEADSTO2 p q Pr ==> X p q Pr) /\ + + (!P. + (!p. p In P ==> LEADSTO2 p q Pr) /\ + (!p. p In P ==> LEADSTO2 p q Pr ==> X p q Pr) + ==> LEADSTO2(LUB P)q Pr ==> X(LUB P)q Pr)) + ==> + + LEADSTO2 p q Pr ==> X p q Pr + +*) +let LEADSTO2_thm7 = prove_thm + ("LEADSTO2_thm7", + (`!X (p:'a->bool) q Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ (LEADSTO2 r q Pr) /\ + ((LEADSTO2 r q Pr) ==> X r q Pr) + ==> ((LEADSTO2 p q Pr) ==> X p q Pr)) /\ + (!P. (!p. p In P ==> LEADSTO2 p q Pr) /\ + (!p. p In P ==> LEADSTO2 p q Pr ==> X p q Pr) + ==> ((LEADSTO2 (LUB P) q Pr) ==> X (LUB P) q Pr))) + ==> ((LEADSTO2 p q Pr) ==> X p q Pr)`), + REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO2_thm7_lemma)] + (BETA_RULE (SPEC + (`\(p:'a->bool) q Pr. (LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q Pr))`) + (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] + (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`)))))) THEN + RES_TAC);; + +(* + Finally we want to prove that LEADSTO is equal to LEADSTO2: +*) + +(* + We do the proving as two implication proofs: +*) + +(* + |- !R Pr. + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p. p In P ==> R p q Pr) ==> R(LUB P)q Pr)) + ==> + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p. p In P ==> R p q Pr) ==> R(LUB P)q Pr)) + +*) +let LEADSTO_EQ_LEADSTO2a = TAC_PROOF + (([], + (`!R (Pr:('a->'a)list). + (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr)) + ==> + (!p q. ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. (p ENSURES r)Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p. p In P ==> R p q Pr) ==> R (LUB P) q Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* + |- !p q Pr. LEADSTO2 p q Pr ==> (p LEADSTO q)Pr +*) +let LEADSTO_EQ_LEADSTO2b_lemma = TAC_PROOF + (([], + (`(!(p:'a->bool) q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (p = LUB P) /\ (!p'. p' In P ==> R p' q Pr) ==> R p q Pr)) + ==> + (!p q. + ((p ENSURES q)Pr ==> R p q Pr) /\ + (!r. R p r Pr /\ R r q Pr ==> R p q Pr) /\ + (!P. (!p'. p' In P ==> R p' q Pr) ==> R (LUB P) q Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p:'a->bool. (p = LUB P) ==> R p (q:'a->bool) (Pr:('a->'a)list)`)))));; + +let LEADSTO_EQ_LEADSTO2b = TAC_PROOF + (([], + (`!(p:'a->bool) q Pr. LEADSTO2 p q Pr ==> (p LEADSTO q) Pr`)), + REWRITE_TAC [LEADSTO; LeadstoRel; + LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO_EQ_LEADSTO2b_lemma)) THEN + ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO_EQ_LEADSTO2a)) THEN + RES_TAC);; + +(* + |- (!p' q'. + ((p' ENSURES q')Pr ==> LEADSTO2 p' q' Pr) /\ + (!r. LEADSTO2 p' r Pr /\ LEADSTO2 r q' Pr ==> LEADSTO2 p' q' Pr) /\ + (!P. (p' = LUB P) /\ + (!p''. p'' In P ==> LEADSTO2 p'' q' Pr) ==> LEADSTO2 p' q' Pr)) + ==> + (p LEADSTO q)Pr ==> LEADSTO2 p q Pr +*) +let LEADSTO_EQ_LEADSTO2c = (SPECL + [(`LEADSTO2:('a->bool)->('a->bool)->(('a->'a)list)->bool`); + (`p:'a->bool`); (`q:'a->bool`); (`Pr:('a->'a)list`)] LEADSTO_thm21);; + +(* + |- !p q Pr. (p LEADSTO q)Pr ==> LEADSTO2 p q Pr +*) +let LEADSTO_EQ_LEADSTO2d = + (GEN_ALL (REWRITE_RULE [LEADSTO2_thm0; LEADSTO2_thm2; LEADSTO2_thm3a] + LEADSTO_EQ_LEADSTO2c));; + +(* + The equivalence proof: + + |- !p q Pr. (p LEADSTO q)Pr = LEADSTO2 p q Pr + +*) +let LEADSTO_EQ_LEADSTO2 = prove_thm + ("LEADSTO_EQ_LEADSTO2", + (`!(p:'a->bool) q Pr. (p LEADSTO q)Pr = LEADSTO2 p q Pr`), + REPEAT GEN_TAC THEN + EQ_TAC THENL + [ + REWRITE_TAC [LEADSTO_EQ_LEADSTO2d] + ; + REWRITE_TAC [LEADSTO_EQ_LEADSTO2b] + ]);; + +(* + Hence now we may conclude all theorems proven valid for both relations +*) + +(* + We get the last two induction principles for LEADSTO: +*) + +(* + |- !X p q Pr. + + (!p q. + + ((p ENSURES q)Pr ==> X p q Pr) /\ + + (!r. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ + + (!P. (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr)) ==> + + ==> + + (p LEADSTO q)Pr ==> X p q Pr +*) +let LEADSTO_thm31 = prove_thm + ("LEADSTO_thm31", + (`!X (p:'a->bool) q Pr. + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ + (!P. (!p. p In P ==> X p q Pr) ==> X (LUB P) q Pr)) + ==> + (p LEADSTO q)Pr ==> X p q Pr`), + ACCEPT_TAC (REWRITE_RULE + [SYM (SPEC_ALL LEADSTO_EQ_LEADSTO2)] LEADSTO2_thm8));; + +(* + The theorem may also be written: +*) +let LEADSTO_thm32 = prove_thm + ("LEADSTO_thm32", + (`!X. + (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr) /\ + (!P q Pr. (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr) + ==> + !(p:'a->bool) q Pr. (p LEADSTO q)Pr ==> X p q Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) (r:'a->bool) (q:'a->bool) Pr. + (p ENSURES r)Pr /\ X r q Pr ==> X p q Pr`); + ASSUME (`!(P:('a->bool)->bool) (q:'a->bool) (Pr:('a->'a)list). + (!p. p In P ==> X p q Pr) ==> X(LUB P)q Pr`)] + (SPEC_ALL LEADSTO_thm31)) THEN + RES_TAC);; + + +(* + |- !X p q Pr. + + (!p q. + + ((p ENSURES q)Pr ==> X p q Pr) /\ + + (!r. + (p ENSURES r)Pr /\ + (r LEADSTO q)Pr /\ + ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)) + + ==> + + (p LEADSTO q)Pr ==> X p q Pr +*) +let LEADSTO_thm33 = prove_thm + ("LEADSTO_thm33", + (`!X (p:'a->bool) q Pr. + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ + ((r LEADSTO q)Pr ==> X r q Pr) ==> + (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> + ((LUB P) LEADSTO q)Pr ==> X (LUB P) q Pr)) + ==> + (p LEADSTO q)Pr ==> X p q Pr`), + ACCEPT_TAC (REWRITE_RULE + [SYM (SPEC_ALL LEADSTO_EQ_LEADSTO2)] LEADSTO2_thm7));; + +(* + We may now derive the theorem: +*) +let LEADSTO_thm34 = prove_thm + ("LEADSTO_thm34", + (`!X. + (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ + ((r LEADSTO q)Pr ==> X r q Pr) ==> + (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P q Pr. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> + ((LUB P) LEADSTO q)Pr ==> X (LUB P) q Pr) + ==> + !(p:'a->bool) q Pr. (p LEADSTO q)Pr ==> X p q Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ + ((r LEADSTO q)Pr ==> X r q Pr) ==> (p LEADSTO q)Pr ==> X p q Pr`); + ASSUME (`!(P:('a->bool)->bool) q Pr. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> + ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr`)] + (SPEC_ALL LEADSTO_thm33)) THEN + RES_TAC);; + + +(* + And the theorem: + + |- !X Pr. + + (!p q. (p ENSURES q)Pr ==> X p q Pr) /\ + + (!p r q. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr + ==> X p q Pr) /\ + + (!P q. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X(LUB P)q Pr) + + ==> + + (!p q. (p LEADSTO q)Pr ==> X p q Pr) + + which may be used for deriving a tactic supporting given programs. +*) +let LEADSTO_thm34a_lemma1 = TAC_PROOF + (([], + (`!P q Pr. (!p:'a->bool. p In P ==> (p LEADSTO q)Pr) ==> + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> (!p. p In P ==> X p q Pr)`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + RES_TAC);; + +let LEADSTO_thm34a_lemma2 = TAC_PROOF + (([], + (`!P q Pr. (!p:'a->bool. p In P ==> (p LEADSTO q)Pr) ==> + (!p. p In P ==> X p q Pr) ==> + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr)`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm34a_lemma3 = TAC_PROOF + (([], + (`((!(p:'a->bool) q. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr) /\ + (!P q. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> + X(LUB P)q Pr)) + = + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) + ==> ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr))`)), + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + RES_TAC + ; + RES_TAC + ; + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm34a_lemma1)) THEN + RES_TAC + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm2 THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`((p:'a->bool) ENSURES r)Pr`); + ASSUME (`((r:'a->bool) LEADSTO q)Pr`); + ASSUME (`(X:('a->bool)->('a->bool)->('a->'a)list->bool) r q Pr`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] + (SPEC_ALL (CONJUNCT1 (CONJUNCT2 (SPEC_ALL (ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> + ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)`))))))) + ; + IMP_RES_TAC LEADSTO_thm3a THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL LEADSTO_thm34a_lemma2)) THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`); + ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr ==> X p q Pr`); + ASSUME (`((LUB (P:('a->bool)->bool)) LEADSTO q)Pr`)] + (SPEC_ALL (CONJUNCT2 (CONJUNCT2 (SPEC_ALL (ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ ((r LEADSTO q)Pr ==> X r q Pr) + ==> (p LEADSTO q)Pr ==> X p q Pr) /\ + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> (p LEADSTO q)Pr ==> X p q Pr) ==> + ((LUB P) LEADSTO q)Pr ==> X(LUB P)q Pr)`))))))) + ]);; + +(* + The theorem for the tactic +*) +let LEADSTO_thm34a = prove_thm + ("LEADSTO_thm34a", + (`!X Pr. + (!p q. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P q. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X (LUB P) q Pr) + ==> + !(p:'a->bool) q. (p LEADSTO q)Pr ==> X p q Pr`), + REPEAT GEN_TAC THEN + STRIP_TAC THEN + REPEAT GEN_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) r q. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr`); + ASSUME (`!P (q:'a->bool). + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) ==> + X(LUB P)q Pr`)] + (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm34a_lemma3)] + (SPEC_ALL LEADSTO_thm33))));; + +let LEADSTO_thm34b = prove_thm + ("LEADSTO_thm34b", + (`!X:('a->bool)->('a->bool)->('a->'a)list->bool. + (!p q st Pr. (p ENSURES q)(CONS st Pr) ==> X p q (CONS st Pr)) /\ + (!p r q st Pr. + (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr) /\ + X r q (CONS st Pr) + ==> X p q (CONS st Pr)) /\ + (!P q st Pr. + (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) /\ + (!p. p In P ==> X p q (CONS st Pr)) + ==> X (LUB P) q (CONS st Pr)) + ==> + !p q st Pr. (p LEADSTO q)(CONS st Pr) ==> X p q (CONS st Pr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE [ASSUME (`((p:'a->bool) LEADSTO q)(CONS st Pr)`)] + (SPEC_ALL (REWRITE_RULE + [ASSUME + (`!(p:'a->bool) q st Pr. (p ENSURES q)(CONS st Pr) ==> X p q(CONS st Pr)`); + ASSUME (`!(p:'a->bool) r q st Pr. + (p ENSURES r)(CONS st Pr) /\ (r LEADSTO q)(CONS st Pr) /\ + X r q(CONS st Pr) ==> X p q(CONS st Pr)`); + ASSUME (`!P (q:'a->bool) st Pr. + (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) /\ + (!p. p In P ==> X p q(CONS st Pr)) ==> X(LUB P)q(CONS st Pr)`)] + (SPECL [(`X:('a->bool)->('a->bool)->('a->'a)list->bool`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm34a)))));; + +(* + Now we may introduce some tactics for supporting structural induction + of leadsto relations: +*) +(* use"leadsto_induct0.sml";; *) +(* +|- !X st Pr. + (!p q. (p ENSURES q)(CONS st Pr) ==> X p q(CONS st Pr)) /\ + (!p r q. (p ENSURES r)(CONS st Pr) /\ + (r LEADSTO q)(CONS st Pr) /\ X r q(CONS st Pr) + ==> X p q(CONS st Pr)) /\ + (!P q. (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) /\ + (!p. p In P ==> X p q(CONS st Pr)) + ==> X (LUB P) q (CONS st Pr)) + + ==> (!p q. (p LEADSTO q)(CONS st Pr) ==> X p q(CONS st Pr)) +*) + +let LEADSTO_thm34a_lemma00 = TAC_PROOF + (([], + `!(p:'a->bool) q Pr X. + (!p q. (p ENSURES q) Pr ==> X p q Pr) /\ + (!p r q. + (p ENSURES r) Pr /\ (r LEADSTO q) Pr /\ X r q Pr ==> X p q Pr) /\ + (!P q. + (!p. p In P ==> (p LEADSTO q) Pr) /\ (!p. p In P ==> X p q Pr) + ==> X (LUB P) q Pr) + ==> ((p LEADSTO q) Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC (SPEC_ALL LEADSTO_thm34a));; + +let LEADSTO_thm34a_lemma01 = GENL + [`p:'a->bool`;`q:'a->bool`;`st:'a->'a`;`Pr:('a->'a)list`; + `X:('a->bool)->('a->bool)->('a->'a)list->bool`] + (SPECL [`p:'a->bool`;`q:'a->bool`;`(CONS st Pr):('a->'a)list`; + `X:('a->bool)->('a->bool)->('a->'a)list->bool`] LEADSTO_thm34a_lemma00);; + +(* + Prove: + |- !p q st Pr. + (p ENSURES q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ + (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) + ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr) +*) +let LEADSTO_thm35_lemma00 = TAC_PROOF + (([], + (`!(p:'a->bool) q r st Pr. + (p ENSURES q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ + (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) + ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (MP (SPECL + [(`p:'a->bool`); (`q:'a->bool`); + (`(CONS st Pr):('a->'a)list`)] ENSURES_cor2) + (ASSUME (`((p:'a->bool) ENSURES q)(CONS st Pr)`))) THEN + ASSUME_TAC (MP (SPECL + [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`); + (`(CONS st Pr):('a->'a)list`)] + UNLESS_thm8) + (CONJ (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); + (`(CONS st Pr):('a->'a)list`)] + ENSURES_cor2) + (ASSUME (`((p:'a->bool) ENSURES q)(CONS st Pr)`))) + (ASSUME (`((q:'a->bool) UNLESS r)(CONS st Pr)`)))) THEN + ASSUME_TAC (MP (SPECL + [(`p':'a->bool`); (`q':'a->bool`); + (`(p:'a->bool) \/* q`); (`r:'a->bool`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm29) (CONJ + (ASSUME (`((p':'a->bool) LEADSTO q')(CONS st Pr)`)) + (ASSUME (`(((p:'a->bool) \/* q) UNLESS r)(CONS st Pr)`)))) THEN + ASSUME_TAC (MP (SPECL [(`p:'a->bool`); (`(p:'a->bool) \/* q`); + (`p':'a->bool`)] IMPLY_WEAK_AND_lemma) + (SPECL [(`p:'a->bool`); + (`q:'a->bool`)] OR_IMPLY_WEAK_lemma)) THEN + ASSUME_TAC (MP (SPECL + [(`(p:'a->bool) /\* p'`); (`(p':'a->bool) /\* (p \/* q)`); + (`st:'a->'a`); + (`Pr:('a->'a)list`)] LEADSTO_thm25) (ONCE_REWRITE_RULE + [(SPECL [(`(p:'a->bool) \/* q`); + (`p':'a->bool`)] AND_COMM_lemma)] + (ASSUME (`!s:'a. (p /\* p')s ==> + ((p \/* q) /\* p')s`)))) THEN + ASSUME_TAC (MP (SPECL + [(`(p:'a->bool) /\* p'`); (`(p':'a->bool) /\* (p \/* q)`); + (`((q':'a->bool) /\* (p \/* q)) \/* r`); + (`CONS (st:'a->'a) Pr`)] LEADSTO_thm1) + (CONJ + (ASSUME (`(((p:'a->bool) /\* p') LEADSTO + (p' /\* (p \/* q)))(CONS st Pr)`)) + (ASSUME (`((p' /\* (p \/* q)) LEADSTO + ((q' /\* (p \/* q)) \/* r)) + (CONS (st:'a->'a) Pr)`)))) THEN + ASSUME_TAC (MP (SPECL + [(`p:'a->bool`); (`q:'a->bool`); + (`q':'a->bool`); (`r:'a->bool`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm29) + (CONJ (MP (SPECL [(`p:'a->bool`); (`q:'a->bool`); + (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm0) + (ASSUME (`((p:'a->bool) ENSURES q)(CONS st Pr)`))) + (ASSUME (`((q':'a->bool) UNLESS r)(CONS st Pr)`)))) THEN + ASSUME_TAC (ONCE_REWRITE_RULE [SPECL + [(`((q':'a->bool) /\* q) \/* r`); + (`p:'a->bool`); (`q':'a->bool`)] + OR_AND_COMM_lemma] (ONCE_REWRITE_RULE [SPECL + [(`(q':'a->bool) /\* p`); (`((q':'a->bool) /\* q) \/* r`)] + OR_COMM_lemma] (REWRITE_RULE [OR_ASSOC_lemma] + (REWRITE_RULE [AND_OR_DISTR_lemma] (ASSUME + (`(((p:'a->bool) /\* p') LEADSTO + ((q' /\* (p \/* q)) \/* r))(CONS st Pr)`)))))) THEN + ACCEPT_TAC (ONCE_REWRITE_RULE [OR_COMM_lemma] (REWRITE_RULE [OR_OR_lemma] + (REWRITE_RULE [OR_ASSOC_lemma] (ONCE_REWRITE_RULE[OR_AND_COMM_lemma] + (REWRITE_RULE [OR_OR_lemma] (REWRITE_RULE [SYM (SPEC_ALL OR_ASSOC_lemma)] + (ONCE_REWRITE_RULE [OR_COMM_lemma] (REWRITE_RULE [OR_ASSOC_lemma] + (ONCE_REWRITE_RULE [OR_OR_COMM_lemma] (MP (SPECL + [(`(p:'a->bool) /\* p'`); (`((q':'a->bool) /\* q) \/* r`); + (`(p:'a->bool) /\* q'`); (`((q:'a->bool) /\* q') \/* r`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28) (CONJ + (ASSUME (`((p /\* p') LEADSTO + (((q' /\* q) \/* r) \/* (p /\* q'))) + (CONS (st:'a->'a) Pr)`)) + (ASSUME (`((p /\* q') LEADSTO ((q /\* q') \/* r)) + (CONS (st:'a->'a) Pr)`))))))))))))));; + + +let LEADSTO_thm35_lemma01_1 = TAC_PROOF + (([], + (`!(q:'a->bool) (q':'a->bool) r'' p r s. + ((((q /\* q') \/* r'') \/* (p /\* r)) \/* ((q' /\* q) \/* r''))s = + (((q /\* q') \/* r'') \/* (p /\* r))s`)), + REWRITE_TAC [OR_def; AND_def] THEN + BETA_TAC THEN + REPEAT GEN_TAC THEN + EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let LEADSTO_thm35_lemma01_2 = + GEN_ALL (REWRITE_RULE [ETA_AX] (MK_ABS (GEN (`s:'a`) (SPEC_ALL + LEADSTO_thm35_lemma01_1))));; + +let LEADSTO_thm35_lemma01_3 = TAC_PROOF + (([], + (`(!p:'a->bool. p In P ==> + (!p'' q r r'. + (r LEADSTO q)(CONS st Pr) ==> + (p'' ENSURES r)(CONS st Pr) ==> + (q' UNLESS r')(CONS st Pr) ==> + (q UNLESS r')(CONS st Pr) ==> + (!p' q' r''. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r'')(CONS st Pr) ==> + (q' UNLESS r'')(CONS st Pr) ==> + ((r /\* p') LEADSTO ((q /\* q') \/* r''))(CONS st Pr)) ==> + ((p'' /\* p) LEADSTO ((q /\* q') \/* r'))(CONS st Pr))) + ==> + (!p'' q r r'. + (r LEADSTO q)(CONS st Pr) ==> + (p'' ENSURES r)(CONS st Pr) ==> + (q' UNLESS r')(CONS st Pr) ==> + (q UNLESS r')(CONS st Pr) ==> + (!p' q' r''. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r'')(CONS st Pr) ==> + (q' UNLESS r'')(CONS st Pr) ==> + ((r /\* p') LEADSTO ((q /\* q') \/* r''))(CONS st Pr)) ==> + (!p. p In P ==> + ((p'' /\* p) LEADSTO ((q /\* q') \/* r'))(CONS st Pr)))`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm35_lemma01_4 = TAC_PROOF + (([], + (`!(P:('a->bool)->bool) r q st Pr. + (!p. p In P ==> ((p /\* r) LEADSTO q)(CONS st Pr)) ==> + (!p. p In P ==> (p LEADSTO q)(CONS st Pr)) ==> + (((LUB P) /\* r) LEADSTO q)(CONS st Pr)`)), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm3a THEN + ASSUME_TAC (SPECL + [(`LUB (P:('a->bool)->bool)`); (`r:'a->bool`)] SYM_AND_IMPLY_WEAK_lemma) THEN + ASSUME_TAC (UNDISCH (SPEC_ALL (SPECL + [(`(LUB P) /\* (r:'a->bool)`); (`(LUB P):'a->bool`)] ENSURES_cor1))) THEN + IMP_RES_TAC LEADSTO_thm0 THEN + IMP_RES_TAC LEADSTO_thm1);; + +let LEADSTO_thm35_lemma01_5 = TAC_PROOF + (([], + (`!(p':'a->bool) P p (p'':'a->bool). + p' In (\p''. ?p'''. p''' In P /\ (p'' = p /\* p''')) + = + (?p'''. p''' In P /\ (p' = p /\* p'''))`)), + REWRITE_TAC [IN] THEN + BETA_TAC THEN + REWRITE_TAC []);; + +let LEADSTO_thm35_lemma01_6 = TAC_PROOF + (([], + (`!s:'a. + (p /\* (LUB P))s = + (LUB(\p''. ?p'. p' In P /\ (p'' = p /\* p')))s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [LUB; AND_def] THEN + BETA_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THENL + [ + EXISTS_TAC (`\s:'a. p s /\ p' s`) THEN + BETA_TAC THEN + ASM_REWRITE_TAC [] THEN + EXISTS_TAC (`p':'a->bool`) THEN + ASM_REWRITE_TAC [IN] + ; + STRIP_ASSUME_TAC (BETA_RULE (SUBS + [ASSUME (`p' = (\s:'a. p s /\ p'' s)`)] + (ASSUME (`(p':'a->bool) s`)))) + ; + EXISTS_TAC (`p'':'a->bool`) THEN + REWRITE_TAC [REWRITE_RULE [IN] (ASSUME (`(p'':'a->bool) In P`))] THEN + STRIP_ASSUME_TAC (BETA_RULE (SUBS + [ASSUME (`p' = (\s:'a. p s /\ p'' s)`)] + (ASSUME (`(p':'a->bool) s`)))) + ]);; + +let LEADSTO_thm35_lemma01_7 = TAC_PROOF + (([], + (`!(P:('a->bool)->bool) r' q q' st Pr. + (!p'. p' In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) + ==> + (!p'. (?p'''. p''' In P /\ (p' = p /\* p''')) ==> + (p' LEADSTO ((q /\* q') \/* r'))(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC []);; + +let LEADSTO_thm35_lemma01_8 = TAC_PROOF + (([], + (`!(P:('a->bool)->bool) r' q q' st Pr. + (!p'. + p' In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) + ==> (((p /\* (LUB P)) LEADSTO ((q /\* q') \/* r'))(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm35_lemma01_5] (SPECL + [(`\p'':'a->bool. ?p'. p' In P /\ (p'' = (p /\* p'))`); + (`(q /\* q') \/* (r':'a->bool)`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm3a)) THEN + ASSUME_TAC (REWRITE_RULE [(UNDISCH (SPEC_ALL LEADSTO_thm35_lemma01_7))] + (ASSUME (`(!p':'a->bool. + (?p'''. p''' In P /\ (p' = p /\* p''')) ==> + (p' LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> + ((LUB(\p''. ?p'. p' In P /\ (p'' = p /\* p'))) LEADSTO + ((q /\* q') \/* r')) + (CONS st Pr)`))) THEN + ASM_REWRITE_TAC [REWRITE_RULE [ETA_AX] (MK_ABS LEADSTO_thm35_lemma01_6)]);; + +let LEADSTO_thm35_lemma01_9 = TAC_PROOF + (([], + (`(!p:'a->bool. + p In P ==> + (!p' q' r. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r)(CONS st Pr) ==> + (q' UNLESS r)(CONS st Pr) ==> + ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr))) + ==> + ((!p' q' r. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r)(CONS st Pr) ==> + (q' UNLESS r)(CONS st Pr) ==> + (!p. p In P ==> + ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr))))`)), + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm35_lemma01_10 = TAC_PROOF + (([], + (`(!p:'a->bool. p In P ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)) + ==> + (!p. p In P ==> ((p' /\* p) LEADSTO ((q /\* q') \/* r))(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + RES_TAC THEN + ONCE_REWRITE_TAC [SPECL [(`p':'a->bool`); (`p:'a->bool`)] AND_COMM_lemma] THEN + ONCE_REWRITE_TAC [AND_COMM_OR_lemma] THEN + ASM_REWRITE_TAC []);; + +let LEADSTO_thm35_lemma01a = TAC_PROOF + (([], + (`(!(p:'a->bool) q r'' r'. + (r'' LEADSTO q)(CONS st Pr) ==> + (p ENSURES r'')(CONS st Pr) ==> + (q' UNLESS r')(CONS st Pr) ==> + (q UNLESS r')(CONS st Pr) ==> + (!p' q' r'. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r')(CONS st Pr) ==> + (q' UNLESS r')(CONS st Pr) ==> + ((r'' /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) ==> + ((p /\* r) LEADSTO ((q /\* q') \/* r'))(CONS st Pr)) + ==> + (!(p:'a->bool) q r' r''. + (r' LEADSTO q)(CONS st Pr) ==> + (p ENSURES r')(CONS st Pr) ==> + (q' UNLESS r'')(CONS st Pr) ==> + (q UNLESS r'')(CONS st Pr) ==> + (!p' q' r''. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r'')(CONS st Pr) ==> + (q' UNLESS r'')(CONS st Pr) ==> + ((r' /\* p') LEADSTO ((q /\* q') \/* r''))(CONS st Pr)) ==> + ((p /\* r) LEADSTO ((q /\* q') \/* r''))(CONS st Pr))`)), + + REPEAT STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC[] +);; + +(* + Now we define a tactic that given one of the LEADSTO induction + theorems can be used as a tactic to prove properties that require + structural induction to prove the required propertie +*) +let LEADSTO_INDUCT0_TAC : tactic = +( + try + MATCH_MP_TAC LEADSTO_thm34b THEN REPEAT CONJ_TAC + with Failure _ -> failwith "LEADSTO_INDUCT0_TAC Failed" +);; + +let LEADSTO_thm35_lemma01 = TAC_PROOF + (([], + (`!(p:'a->bool) q st Pr. + (p LEADSTO q)(CONS st Pr) ==> + !p' q' r. (p' LEADSTO q')(CONS st Pr) + ==> (q UNLESS r)(CONS st Pr) ==> (q' UNLESS r)(CONS st Pr) + ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`)), + LEADSTO_INDUCT0_TAC THENL + [ + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm35_lemma00 + ; + REPEAT STRIP_TAC THEN + UNDISCH_TAC (`!(p':'a->bool) q' r'. + (p' LEADSTO q')(CONS st Pr) ==> + (q UNLESS r')(CONS st Pr) ==> + (q' UNLESS r')(CONS st Pr) ==> + ((r /\* p') LEADSTO ((q /\* q') \/* r'))(CONS st Pr)`) THEN + UNDISCH_TAC (`((q:'a->bool) UNLESS r')(CONS st Pr)`) THEN + UNDISCH_TAC (`((q':'a->bool) UNLESS r')(CONS st Pr)`) THEN + UNDISCH_TAC (`((p:'a->bool) ENSURES r)(CONS st Pr)`) THEN + UNDISCH_TAC (`((r:'a->bool) LEADSTO q)(CONS st Pr)`) THEN + SPEC_TAC ((`r':'a->bool`), (`r':'a->bool`)) THEN + SPEC_TAC ((`r:'a->bool`), (`r:'a->bool`)) THEN + SPEC_TAC ((`q:'a->bool`), (`q:'a->bool`)) THEN + SPEC_TAC ((`p:'a->bool`), (`p:'a->bool`)) THEN + UNDISCH_TAC (`((p':'a->bool) LEADSTO q')(CONS st Pr)`) THEN + SPEC_TAC ((`Pr:('a->'a)list`), (`Pr:('a->'a)list`)) THEN + SPEC_TAC ((`st:'a->'a`), (`st:'a->'a`)) THEN + SPEC_TAC ((`q':'a->bool`), (`q':'a->bool`)) THEN + SPEC_TAC ((`p':'a->bool`), (`p':'a->bool`)) THEN + LEADSTO_INDUCT0_TAC THENL + [ + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm2 THEN + IMP_RES_TAC LEADSTO_thm35_lemma00 THEN + ONCE_REWRITE_TAC [AND_COMM_lemma] THEN + ACCEPT_TAC (ASSUME + (`(((p':'a->bool) /\* p) LEADSTO + ((q' /\* q) \/* r'))(CONS st Pr)`)) + ; + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm2 THEN + IMP_RES_TAC LEADSTO_thm0 THEN + ASSUME_TAC (UNDISCH (SPECL + [(`p:'a->bool`); (`r':'a->bool`); + (`CONS (st:'a->'a) Pr`)] ENSURES_cor2)) THEN + ASSUME_TAC (UNDISCH (SPECL + [(`p':'a->bool`); (`r:'a->bool`); + (`CONS (st:'a->'a) Pr`)] ENSURES_cor2)) THEN + ASSUME_TAC (REWRITE_RULE + [ASSUME (`((p:'a->bool)UNLESS r')(CONS st Pr)`); + ASSUME (`((p':'a->bool)ENSURES r)(CONS st Pr)`)] + (SPECL + [(`p:'a->bool`); (`r':'a->bool`); + (`p':'a->bool`); (`r:'a->bool`); + (`CONS (st:'a->'a) Pr`)] ENSURES_thm4)) THEN + IMP_RES_TAC LEADSTO_thm0 THEN + RES_TAC THEN + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL OR_ASSOC_lemma)] + (ONCE_REWRITE_RULE [OR_COMM_lemma] (REWRITE_RULE [ + (ASSUME + (`(((r':'a->bool) /\* r) LEADSTO ((q /\* q') \/* r'')) + (CONS st Pr)`)); + (ASSUME (`(((p:'a->bool) /\* p') LEADSTO + (((p /\* r) \/* (p' /\* r')) \/* (r' /\* r))) + (CONS st Pr)`))] (SPECL + [(`(p:'a->bool) /\* p'`); + (`((p:'a->bool) /\* r) \/* (p' /\* r')`); + (`(r':'a->bool) /\* r`); + (`((q:'a->bool) /\* q') \/* r''`); (`st:'a->'a`); + (`Pr:('a->'a)list`)] LEADSTO_thm28)))) THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm35_lemma01_2] (REWRITE_RULE + [(ONCE_REWRITE_RULE [SPECL [(`r':'a->bool`); + (`p':'a->bool`)] AND_COMM_lemma] + (ASSUME + (`(((r':'a->bool) /\* p') LEADSTO ((q /\* q') \/* r'')) + (CONS st Pr)`))); + (ASSUME (`(((p:'a->bool) /\* p') LEADSTO + ((((q /\* q') \/* r'') \/* (p /\* r)) \/* (p' /\* r'))) + (CONS st Pr)`))] (SPECL + [(`(p:'a->bool) /\* p'`); + (`(((q:'a->bool) /\* q') \/* r'') \/* (p /\* r)`); + (`(p':'a->bool) /\* r'`); + (`((q':'a->bool) /\* q) \/* r''`); (`st:'a->'a`); + (`Pr:('a->'a)list`)] LEADSTO_thm28))) THEN + ASM_REWRITE_TAC [REWRITE_RULE [OR_OR_lemma] (REWRITE_RULE + [(ASSUME + (`(((p:'a->bool) /\* r) LEADSTO ((q /\* q') \/* r''))(CONS st Pr)`)); + (ASSUME (`(((p:'a->bool) /\* p') LEADSTO + (((q /\* q') \/* r'') \/* (p /\* r)))(CONS st Pr)`))] (SPECL + [(`(p:'a->bool) /\* p'`); (`((q:'a->bool) /\* q') \/* r''`); + (`(p:'a->bool) /\* r`); (`((q:'a->bool) /\* q') \/* r''`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm28))] + ; + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm0 THEN + IMP_RES_TAC LEADSTO_thm2 THEN + IMP_RES_TAC LEADSTO_thm35_lemma01_3 THEN + IMP_RES_TAC LEADSTO_thm35_lemma01_8 + ] + ; + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm35_lemma01_9 THEN + IMP_RES_TAC LEADSTO_thm35_lemma01_10 THEN + IMP_RES_TAC LEADSTO_thm35_lemma01_8 THEN + ONCE_REWRITE_TAC [SPECL + [(`LUB (P:('a->bool)->bool)`); (`p':'a->bool`)] AND_COMM_lemma] THEN + ASM_REWRITE_TAC [] + ]);; + +(* + Now prove the completion theorem: + + |- !p q p' q' r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ + (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) + ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr) +*) +let LEADSTO_thm35 = prove_thm + ("LEADSTO_thm35", + (`!(p:'a->bool) q p' q' r st Pr. + (p LEADSTO q)(CONS st Pr) /\ (p' LEADSTO q')(CONS st Pr) /\ + (q UNLESS r)(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) + ==> ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm35_lemma01);; + +(* + We now prove the theorem valid for proving bounds of progress. + *) + +(* + We need to define the metric predicates EQmetric and LESSmetric +*) + +(* + EQmetric is the state abstracted predicate expressing that the metric + function M must have the value m in the state s. +*) +let EQmetric = new_infix_definition + ("EQmetric", "<=>", + (`EQmetric (M:'a->num) m = \s. M s = m`), TL_FIX);; + +(* + LESSmetric is the state abstracted predicate expressing that the metric + function M must have a value less than m in the state s. +*) +let LESSmetric = new_infix_definition + ("LESSmetric", "<=>", + (`LESSmetric (M:'a->num) m = \s. M s < m`), TL_FIX);; + +(*---------------------------------------------------------------------------*) +(* + Lemmas +*) +(*---------------------------------------------------------------------------*) + +let LEADSTO_thm36_lemma00 = BETA_RULE + (SPEC (`\n. (((p:'a->bool) /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)`) + GEN_INDUCT_thm);; + +let LEADSTO_thm36_lemma01 = TAC_PROOF + (([], + (`!(M:'a->num) m. (p /\* (M EQmetric m)) = ((\i. p /\* (M EQmetric i))m)`)), + BETA_TAC THEN + REWRITE_TAC []);; + +let LEADSTO_thm36_lemma02 = TAC_PROOF + (([], + (`!(p:'a->bool) q st Pr M m. + (!n. n < (SUC m) ==> ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)) ==> + (!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr))`)), + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC + (MP (SPEC (`n:num`) (ASSUME (`!n. n < (SUC m) ==> + (((p:'a->bool) /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)`))) + (MP (SPECL [(`n:num`); (`m:num`)] LESS_SUC) (ASSUME (`n < m`)))));; + +let LEADSTO_thm36_lemma03 = TAC_PROOF + (([], + (`!(p:'a->bool) q st Pr M m. + (!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q) (CONS st Pr)) ==> + (( \ ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)) + ==> (( \'a) Pr)`)) + (ASSUME (`!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q) + (CONS (st:'a->'a) Pr)`))) THEN + ASSUME_TAC (REWRITE_RULE [LESS_SUC_REFL] (SPEC (`m:num`) + (ASSUME (`!n. n < (SUC m) ==> ((p /\* (M EQmetric n)) LEADSTO q) + (CONS (st:'a->'a) Pr)`)))) THEN + STRIP_ASSUME_TAC (MP (SPECL + [(` \bool) /\* (M EQmetric i))m`); + (`(p:'a->bool) /\* (M EQmetric m)`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm4) (CONJ + (ASSUME (`(( \'a) Pr)`)) + (ASSUME (`((p /\* (M EQmetric m)) LEADSTO q)(CONS (st:'a->'a) Pr)`)))) + ]);; + +let LEADSTO_thm36_lemma04 = TAC_PROOF + (([], + (`!M:'a->num. (!m s. (M LESSmetric m)s = ( \num) m. (M LESSmetric m) = ( \num`); (`m:num`)] LEADSTO_thm36_lemma04)))] THEN + REWRITE_TAC [ETA_AX]);; + +let LEADSTO_thm36_lemma06 = TAC_PROOF + (([], + (`!(p:'a->bool) M q Pr. + (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q))Pr) + ==> (!m. ((p /\* (M EQmetric m)) LEADSTO + ((p /\* ( \bool) M m. + ( \bool) q st Pr M. + (!m. ((p /\* (M EQmetric m)) LEADSTO + ((p /\* (M LESSmetric m)) \/* q)) (CONS st Pr)) ==> + (!m. (!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q)(CONS st Pr)) ==> + ((p /\* (M EQmetric m)) LEADSTO q) (CONS st Pr))`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm36_lemma07] + (MP (SPEC_ALL LEADSTO_thm36_lemma03) + (ASSUME (`!n. n < m ==> ((p /\* (M EQmetric n)) LEADSTO q) + (CONS (st:'a->'a) Pr)`)))) THEN + ASSUME_TAC (ONCE_REWRITE_RULE [OR_COMM_lemma] (SPEC_ALL (UNDISCH (SPECL + [(`p:'a->bool`); (`M:'a->num`); (`q:'a->bool`); (`CONS (st:'a->'a) Pr`)] + LEADSTO_thm36_lemma06)))) THEN + STRIP_ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] + (MP (SPECL [(`(p:'a->bool) /\* (M EQmetric m)`); (`q:'a->bool`); + (`(p:'a->bool) /\* ( \bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm28) + (CONJ (ASSUME (`(((p:'a->bool) /\* (M EQmetric m)) LEADSTO + (q \/* (p /\* ( \'a) Pr)`))))));; + +let LEADSTO_thm36_lemma09 = TAC_PROOF + (([], + (`!(p:'a->bool) q st Pr M. + (!m. ((p /\* (M EQmetric m)) LEADSTO + ((p /\* (M LESSmetric m)) \/* q)) (CONS st Pr)) ==> + (!m. ((p /\* (M EQmetric m)) LEADSTO q) (CONS st Pr))`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH (SPEC_ALL LEADSTO_thm36_lemma08)) THEN + STRIP_ASSUME_TAC (SPEC (`m:num`) (UNDISCH_ALL LEADSTO_thm36_lemma00)));; + +let LEADSTO_thm36_lemma10s = TAC_PROOF + (([], + (`!(p:'a->bool) M s. + (p /\* ((?*) (\n. M EQmetric n)))s = ((?*) (\i. p /\* (M EQmetric i)))s`)), + REPEAT STRIP_TAC THEN + REWRITE_TAC [AND_def; EXISTS_def; EQmetric] THEN + BETA_TAC THEN + EQ_TAC THENL + [ + STRIP_TAC THEN + EXISTS_TAC (`x:num`) THEN + ASM_REWRITE_TAC [] + ; + STRIP_TAC THEN + ASM_REWRITE_TAC [] THEN + EXISTS_TAC (`x:num`) THEN + ASM_REWRITE_TAC [] + ]);; + +(* + |- !p M. p /\* ( ?* ) ((EQmetric) M) = (?*i. p /\* (M EQmetric i)) +*) +let LEADSTO_thm36_lemma10 = + (GENL [`p:'a->bool`;`M:'a->num`] (ONCE_REWRITE_RULE [ETA_AX] + (MK_ABS (SPECL [`p:'a->bool`;`M:'a->num`] LEADSTO_thm36_lemma10s))));; + +let LEADSTO_thm36_lemma11s = TAC_PROOF + (([], + (`!(M:'a->num) s. ((?*) (\n. M EQmetric n))s = True s`)), + REWRITE_TAC [EXISTS_def; EQmetric; TRUE_def] THEN + BETA_TAC THEN + REPEAT GEN_TAC THEN + EXISTS_TAC (`(M:'a->num) s`) THEN + REFL_TAC);; + +(* + |- !M. ( ?* ) ((EQmetric) M) = True +*) +let LEADSTO_thm36_lemma11 = + (GENL [`M:'a->num`] (ONCE_REWRITE_RULE [ETA_AX] + (MK_ABS (SPECL [`M:'a->num`] LEADSTO_thm36_lemma11s))));; + +let LEADSTO_thm36_lemma12 = TAC_PROOF + (([], + (`!(p:'a->bool) q st Pr M. + (!m. ((p /\* (M EQmetric m)) LEADSTO + ((p /\* (M LESSmetric m)) \/* q))(CONS st Pr)) + ==> ((p /\* ((?*) (\n. M EQmetric n))) LEADSTO q)(CONS st Pr)`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (ONCE_REWRITE_RULE [LEADSTO_thm36_lemma01] (MP + (SPEC_ALL LEADSTO_thm36_lemma09) + (ASSUME (`!m. ((p /\* (M EQmetric m)) LEADSTO + ((p /\* (M LESSmetric m)) \/* q)) (CONS (st:'a->'a) Pr)`)))) THEN + IMP_RES_TAC (SPECL [`\i:num. (p:'a->bool) /\* (M EQmetric i)`] + LEADSTO_thm3c) THEN + ASM_REWRITE_TAC [LEADSTO_thm36_lemma10]);; + +let LEADSTO_thm36 = prove_thm + ("LEADSTO_thm36", + (`!(p:'a->bool) q st Pr M. + (!m. ((p /\* (M EQmetric m)) LEADSTO ((p /\* (M LESSmetric m)) \/* q)) + (CONS st Pr)) + ==> (p LEADSTO q)(CONS st Pr)`), + REPEAT STRIP_TAC THEN + IMP_RES_TAC LEADSTO_thm36_lemma12 THEN + ACCEPT_TAC (REWRITE_RULE [LEADSTO_thm36_lemma11; AND_True_lemma] + (ASSUME + (`(((p:'a->bool) /\* ((?*) (\n. M EQmetric n))) LEADSTO q)(CONS st Pr)`))));; + +(* + We prove a new induction theorem: +*) +let LEADSTO_thm37_lemma00 = TAC_PROOF + (([], + (`((!p:'a->bool. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q)) = + (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q)`)), + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm37_lemma01 = TAC_PROOF + (([], + (`(!p':'a->bool. p' In P ==> (p' LEADSTO q)Pr /\ X p' q) = + ((!p'. p' In P ==> (p' LEADSTO q)Pr) /\ (!p'. p' In P ==> X p' q))`)), + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm37_lemma02 = TAC_PROOF + (([], + (`!(X:('a->bool)->('a->bool)->bool) Pr. + (!p q. + ((p ENSURES q)Pr ==> (p LEADSTO q)Pr /\ X p q) /\ + (!r. + (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> + (p LEADSTO q)Pr /\ X p q) /\ + (!P. + (p = LUB P) /\ (!p'. p' In P ==> (p' LEADSTO q)Pr /\ X p' q) ==> + (p LEADSTO q)Pr /\ X p q)) + = + (!p q. + ((p ENSURES q)Pr ==> X p q) /\ + (!r. + (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q ==> X p q) /\ + (!P. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) ==> + X(LUB P)q))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN REPEAT STRIP_TAC THENL + [ + RES_TAC + ; + RES_TAC + ; + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm37_lemma00] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> (p LEADSTO q)Pr`)) + (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->bool) p q`)))) THEN + RES_TAC THEN + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p. (p = LUB P) ==> (X:('a->bool)->('a->bool)->bool) p q`)))) + ; + IMP_RES_TAC LEADSTO_thm0 + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm1 THEN + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm1 THEN + RES_TAC + ; + IMP_RES_TAC LEADSTO_thm37_lemma01 THEN + IMP_RES_TAC LEADSTO_thm3 + ; + IMP_RES_TAC LEADSTO_thm37_lemma01 THEN + RES_TAC THEN + ASM_REWRITE_TAC [] + ]);; + +let LEADSTO_thm37 = prove_thm + ("LEADSTO_thm37", + (`!X p q Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q) /\ + (!r. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q + ==> X p q) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) + ==> X (LUB P) q)) + ==> ((p LEADSTO q)Pr ==> X p q)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm37_lemma02] + (REWRITE_RULE [SYM (SPEC_ALL CONJ_ASSOC)] (BETA_RULE (SPEC + (`\ (p:'a->bool) q Pr. (p LEADSTO q)Pr /\ (X p q)`) + (REWRITE_RULE [LEADSTO; LeadstoRel] + (ASSUME (`((p:'a->bool) LEADSTO q)Pr`))))))) THEN + RES_TAC);; + +(* + The theorem useful for an induction tactic +*) +let LEADSTO_thm38 = prove_thm + ("LEADSTO_thm38", + (`!X. + (!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q) /\ + (!p r q Pr. (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q + ==> X p q) /\ + (!P q Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) + ==> X (LUB P) q) + ==> (!p q Pr. (p LEADSTO q)Pr ==> X p q)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q`); + ASSUME (`!(p:'a->bool) r q Pr. + (p LEADSTO r)Pr /\ X p r /\ (r LEADSTO q)Pr /\ X r q + ==> X p q`); + ASSUME (`!(P:('a->bool)->bool) q Pr. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) + ==> X (LUB P) q`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL LEADSTO_thm37)));; + + +let LEADSTO_thm39_lemma00 = TAC_PROOF + (([], + (`!(X:('a->bool)->('a->bool)->bool) Pr. + ((!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q)) = + (!p. p In P ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm39_lemma01 = TAC_PROOF + (([], + (`!(X:('a->bool)->('a->bool)->bool) Pr. + (!p q. + ((p ENSURES q)Pr ==> + LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ + (!r. + (p ENSURES r)Pr /\ + LEADSTO2 r q Pr /\ + (LEADSTO2 r q Pr ==> X r q) ==> + LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ + (!P. + (!p'. + p' In P ==> + LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q)) ==> + LEADSTO2(LUB P)q Pr /\ (LEADSTO2(LUB P)q Pr ==> X(LUB P)q))) + = + (!p q. + ((p ENSURES q)Pr ==> X p q) /\ + (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q ==> X p q) /\ + (!P. + (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q) ==> + X(LUB P)q))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN REPEAT STRIP_TAC THENL + [ + RES_TAC + ; + IMP_RES_TAC LEADSTO2_thm1 THEN + ACCEPT_TAC (REWRITE_RULE + [ASSUME (`((p:'a->bool) ENSURES r)Pr`); + ASSUME (`LEADSTO2 (r:'a->bool) q Pr`); + ASSUME (`LEADSTO2 (p:'a->bool) q Pr`); + ASSUME (`(X:('a->bool)->('a->bool)->bool) r q`)] + (SPEC_ALL (CONJUNCT1 (CONJUNCT2 (SPEC_ALL + (ASSUME (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ + (!r. + (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ + (LEADSTO2 r q Pr ==> X r q) ==> + LEADSTO2 p q Pr /\ (LEADSTO2 p q Pr ==> X p q)) /\ + (!P. + (!p'. p' In P ==> LEADSTO2 p' q Pr /\ (LEADSTO2 p' q Pr ==> X p' q)) + ==> LEADSTO2(LUB P)q Pr /\ (LEADSTO2(LUB P)q Pr ==> X(LUB P)q))`))))))) + ; + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm39_lemma00] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr`)) + (ASSUME (`!p. p In P ==> (X:('a->bool)->('a->bool)->bool) p q`)))) THEN + IMP_RES_TAC LEADSTO2_thm3a THEN + ASSUME_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p:'a->bool. (p = LUB P) ==> LEADSTO2 p q Pr`)))) THEN + RES_TAC + ; + IMP_RES_TAC LEADSTO2_thm0 + ; + RES_TAC + ; + IMP_RES_TAC LEADSTO2_thm1 + ; + RES_TAC + ; + STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm39_lemma00)] + (ASSUME (`!p':'a->bool. p' In P ==> (LEADSTO2 p' q)Pr /\ + (LEADSTO2 p' q Pr ==> X p' q)`))) THEN + IMP_RES_TAC LEADSTO2_thm3a THEN + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p:'a->bool. (p = LUB P) ==> LEADSTO2 p q Pr`)))) + ; + STRIP_ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm39_lemma00)] + (ASSUME (`!p':'a->bool. p' In P ==> (LEADSTO2 p' q)Pr /\ + (LEADSTO2 p' q Pr ==> X p' q)`))) THEN + RES_TAC + ]);; + +let LEADSTO_thm39 = prove_thm + ("LEADSTO_thm39", + (`!(X:('a->bool)->('a->bool)->bool) p q Pr. + (!p q. ((p ENSURES q)Pr ==> X p q) /\ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ (X r q) ==> X p q) /\ + (!P. (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) + ==> X (LUB P) q)) + ==> ((p LEADSTO q)Pr ==> X p q)`), + REWRITE_TAC [LEADSTO_EQ_LEADSTO2] THEN + REPEAT GEN_TAC THEN + REPEAT DISCH_TAC THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm39_lemma01] (BETA_RULE + (SPEC (`\(p:'a->bool) q Pr. (LEADSTO2 p q Pr /\ + (LEADSTO2 p q Pr ==> X p q))`) + (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] + (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`)))))) THEN + RES_TAC);; + + +(* + The theorem useful for an induction tactic +*) +let LEADSTO_thm40 = prove_thm + ("LEADSTO_thm40", + (`!X. + (!p q Pr. (p ENSURES q)Pr ==> X p q) /\ + (!p r q Pr. + (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q ==> X p q) /\ + (!P q Pr. + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q) + ==> X (LUB P) q) + ==> + (!(p:'a->bool) q Pr. (p LEADSTO q)Pr ==> X p q)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q`); + ASSUME (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ + X r q ==> X p q`); + ASSUME (`!P (q:'a->bool) Pr. (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> X p q) ==> X (LUB P) q`)] + (SPEC_ALL LEADSTO_thm39)) THEN + RES_TAC);; + +(* + Finally let us present the most compact form of the two induction principles + used in [CM88] +*) + +(* + The first induction principle (actually a weakening of LEADSTO_thm23): +*) +let LEADSTO_thm41 = prove_thm + ("LEADSTO_thm41", + (`!X. + (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!p P q Pr. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr) + ==> (!(p:'a->bool) q Pr. (p LEADSTO q) Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (UNDISCH (SPEC_ALL (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) r q Pr. + (p LEADSTO r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) P q Pr. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL LEADSTO_thm23)))));; + +(* + Now prove the second induction principle: +*) +let LEADSTO_thm42_lemma00 = TAC_PROOF + (([], + (`!X Pr. + (!p:'a->bool. p In P ==> LEADSTO2 p q Pr /\ X p q Pr) = + ((!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q Pr))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let LEADSTO_thm42_lemma01 = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P. (p = (LUB P)) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr)) + = + (!p q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X r q Pr ==> X p q Pr) /\ + (!P. (p = (LUB P)) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr))`)), + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC);; + +let LEADSTO_thm42_lemma02 = TAC_PROOF + (([], + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q Pr ==> X p q Pr) /\ + (!P. (p = LUB P) /\ + (!p. p In P ==> LEADSTO2 p q Pr) /\ + (!p. p In P ==> X p q Pr) ==> X p q Pr)) + = + (!p q. + ((p ENSURES q)Pr ==> LEADSTO2 p q Pr /\ X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q Pr + ==> LEADSTO2 p q Pr /\ X p q Pr) /\ + (!P. (!p. p In P ==> LEADSTO2 p q Pr /\ X p q Pr) + ==> LEADSTO2 (LUB P) q Pr /\ X (LUB P) q Pr))`)), + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THENL + [ + IMP_RES_TAC LEADSTO2_thm0 + ; + IMP_RES_TAC LEADSTO2_thm1 + ; + STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO_thm42_lemma00] (ASSUME + (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr /\ X p q Pr`))) THEN + IMP_RES_TAC LEADSTO2_thm3 + ; + STRIP_ASSUME_TAC (REWRITE_RULE [LEADSTO_thm42_lemma00] (ASSUME + (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr /\ X p q Pr`))) THEN + RES_TAC THEN + ACCEPT_TAC (REWRITE_RULE [] (SPEC (`LUB (P:('a->bool)->bool)`) (ASSUME + (`!p. (p = LUB P) + ==> (X:('a->bool)->('a->bool)->(('a->'a)list)->bool)p q Pr`)))) + ; + ASSUME_TAC (REWRITE_RULE [SYM (SPEC_ALL LEADSTO_thm42_lemma00)] (CONJ + (ASSUME (`!p:'a->bool. p In P ==> LEADSTO2 p q Pr`)) + (ASSUME (`!p. p In P + ==> (X:('a->bool)->('a->bool)->(('a->'a)list)->bool) p q Pr`)))) THEN + RES_TAC THEN + ASM_REWRITE_TAC [] + ]);; + +(* + The strongest version of the second induction theorem: +*) +let LEADSTO_thm42 = prove_thm + ("LEADSTO_thm42", + (`!X Pr. + (!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!P. (p = (LUB P)) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr)) + ==> (!(p:'a->bool) q. (p LEADSTO q) Pr ==> X p q Pr)`), + REWRITE_TAC [LEADSTO_thm42_lemma01] THEN + REWRITE_TAC [LEADSTO_EQ_LEADSTO2] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (BETA_RULE (SPEC + (`\(p:'a->bool) q Pr. (LEADSTO2 p q Pr) /\ (X p q Pr)`) + (REWRITE_RULE [LEADSTO2; LEADSTO2Fn_EQ_LEADSTO2Fam; LEADSTO2Fam] + (ASSUME (`LEADSTO2 (p:'a->bool) q Pr`))))) THEN + ASSUME_TAC (REWRITE_RULE [LEADSTO_thm42_lemma02] (ASSUME + (`!(p:'a->bool) q. + ((p ENSURES q)Pr ==> X p q Pr) /\ + (!r. (p ENSURES r)Pr /\ LEADSTO2 r q Pr /\ X r q Pr ==> X p q Pr) /\ + (!P. (p = LUB P) /\ + (!p. p In P ==> LEADSTO2 p q Pr) /\ (!p. p In P ==> X p q Pr) ==> + X p q Pr)`))) THEN + RES_TAC);; + +(* + The second induction principle (actually a weakening of LEADSTO_thm42a): +*) +let LEADSTO_thm43 = prove_thm + ("LEADSTO_thm43", + (`!X. + (!p q Pr. (p ENSURES q)Pr ==> X p q Pr) /\ + (!p r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ X p r Pr /\ X r q Pr + ==> X p q Pr) /\ + (!p P q Pr. (p = (LUB P)) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ (!p. p In P ==> X p q Pr) + ==> X p q Pr) + ==> (!(p:'a->bool) q Pr. (p LEADSTO q) Pr ==> X p q Pr)`), + REPEAT STRIP_TAC THEN + ACCEPT_TAC (UNDISCH (SPEC_ALL (REWRITE_RULE + [ASSUME (`!(p:'a->bool) q Pr. (p ENSURES q)Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) r q Pr. (p ENSURES r)Pr /\ (r LEADSTO q)Pr /\ + X p r Pr /\ X r q Pr ==> X p q Pr`); + ASSUME (`!(p:'a->bool) P q Pr. (p = LUB P) /\ + (!p. p In P ==> (p LEADSTO q)Pr) /\ + (!p. p In P ==> X p q Pr) ==> X p q Pr`); + ASSUME (`((p:'a->bool) LEADSTO q)Pr`)] (SPEC_ALL LEADSTO_thm42)))));; + + +(* + The last corollaries using the completion theorem: + *) + +let LEADSTO_cor13_lemma01 = TAC_PROOF + (([], + (`!(Q:num->('a->bool)) r s. + ((((/<=\* Q i) \/* r) /\* ((Q(SUC i)) \/* r)) \/* r)s + = + ((/<=\* Q (SUC i)) \/* r)s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_LE_N_def; OR_def; AND_def] THEN + BETA_TAC THEN + EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; + +let LEADSTO_cor13 = prove_thm + ("LEADSTO_cor13", + (`!(P:num->('a->bool)) Q r st Pr. + (!i. ((P i) LEADSTO ((Q i) \/* r)) (CONS st Pr)) /\ + (!i. ((Q i) UNLESS r) (CONS st Pr)) ==> + (!i. ((/<=\* P i) LEADSTO ((/<=\* Q i) \/* r)) (CONS st Pr))`), + REPEAT GEN_TAC THEN + STRIP_TAC THEN + INDUCT_TAC THENL + [ + ASM_REWRITE_TAC [AND_LE_N_def] + ; + IMP_RES_TAC UNLESS_cor17 THEN + ASSUME_TAC (SPEC_ALL + (ASSUME (`!i. ((/<=\* (Q:num->'a->bool) i) UNLESS r)(CONS st Pr)`))) THEN + ASSUME_TAC (SPEC (`SUC i`) (ASSUME + (`!i. (((P:num->('a->bool)) i) LEADSTO ((Q i) \/* r))(CONS st Pr)`))) THEN + ASSUME_TAC (SPEC (`SUC i`) (ASSUME + (`!i. (((Q:num->('a->bool)) i) UNLESS r)(CONS st Pr)`))) THEN + ASSUME_TAC (REWRITE_RULE + [ASSUME (`((/<=\* (Q:num->'a->bool) i) UNLESS r)(CONS st Pr)`); + UNLESS_thm1] (SPECL + [(`/<=\* (Q:num->('a->bool))i`); (`r:'a->bool`); (`r:'a->bool`); (`CONS(st:'a->'a)Pr`)] + UNLESS_thm8)) THEN + ASSUME_TAC (REWRITE_RULE + [ASSUME (`(((Q:num->'a->bool)(SUC i)) UNLESS r)(CONS st Pr)`); + UNLESS_thm1] (SPECL + [(`(Q:num->('a->bool))(SUC i)`); (`r:'a->bool`); (`r:'a->bool`); (`CONS(st:'a->'a)Pr`)] + UNLESS_thm8)) THEN + ACCEPT_TAC (REWRITE_RULE + [REWRITE_RULE [ETA_AX] + (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO_cor13_lemma01))); + SYM (SPEC_ALL (CONJUNCT2 AND_LE_N_def))] (REWRITE_RULE + [ASSUME (`((/<=\* (P:num->'a->bool)i) LEADSTO ((/<=\* Q i) \/* r)) + (CONS st Pr)`); + ASSUME (`(((P:num->'a->bool)(SUC i)) LEADSTO ((Q(SUC i)) \/* r)) + (CONS st Pr)`); + ASSUME (`(((/<=\* (Q:num->'a->bool) i) \/* r) UNLESS r)(CONS st Pr)`); + ASSUME (`((((Q:num->'a->bool)(SUC i)) \/* r) UNLESS r)(CONS st Pr)`)] + (SPECL [(`/<=\* (P:num->'a->bool)i`); (`(/<=\* (Q:num->'a->bool)i) \/* r`); + (`(P:num->'a->bool)(SUC i)`); (`((Q:num->'a->bool)(SUC i)) \/* r`); + (`r:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm35))) + ]);; + +(* Prove: + + !p q r b p' q' r' b' Pr. + (p LEADSTO (q \/* r)) Pr /\ (q UNLESS b) Pr /\ + (p' LEADSTO (q' \/* r')) Pr /\ (q' UNLESS b') Pr ==> + ((p /\* p') LEADSTO ((q /\* q') \/* ((r \/* b) \/* (r' \/* b'))) Pr + + Hint: + Show that: + b ==> (r \/* b) \/* (r' \/* b') + b' ==> (r \/* b) \/* (r' \/* b') + use these as assumptions for the unless properties in using the + weakening theorem we then have + q unless (r \/* b) \/* (r' \/* b') in st^Pr, + q' unless (R \/* B) \/* (R' \/* B') in st^Pr, + now show that: + r ==> (r \/* b) \/* (r' \/* b') + r' ==> (r \/* b) \/* (r' \/* b') + use these to derive the leadto properties: + r leadsto ((r \/* b) \/* (r' \/* b')) in st^Pr + r' leadsto ((r \/* b) \/* (r' \/* b')) in st^Pr + by using the cancellation theorem of leadsto we get + p leadsto q \/* ((r \/* b) \/* (r' \/* b')) in st^Pr + p' leadsto q' \/* ((r \/* b) \/* (r' \/* b')) in st^Pr + now we are ready to use the theorem of completion: + p leadsto q \/* ((r \/* b) \/* (r' \/* b')) in st^Pr, + q unless (r \/* b) \/* (r' \/* b') in st^Pr, + p' leadsto q \/* ((r \/* b) \/* (r' \/* b')) in st^Pr, + q' unless (r \/* b) \/* (r' \/* b') in st^Pr + ---------------------------------------------------------------------- + (p /\* p') leadsto (q /\* q') \/* ((r \/* b) \/* (r' \/* b')) in st^Pr + +*) + +(* Prove: + !p q r p' q' Pr. + (p LEADSTO (q \/* r)) Pr /\ (q UNLESS r) Pr /\ + (p' LEADSTO (q' \/* r)) Pr /\ (q' UNLESS r) Pr ==> + ((p /\* p') LEADSTO ((q /\* q') \/* r)) Pr +*) +let LEADSTO_cor14 = prove_thm + ("LEADSTO_cor14", + (`!(p:'a->bool) q r p' q' st Pr. + (p LEADSTO (q \/* r))(CONS st Pr) /\ (q UNLESS r)(CONS st Pr) /\ + (p' LEADSTO (q' \/* r))(CONS st Pr) /\ (q' UNLESS r)(CONS st Pr) + ==> + ((p /\* p') LEADSTO ((q /\* q') \/* r))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPECL [(`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] UNLESS_thm1) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((q:'a->bool) UNLESS r)(CONS st Pr)`); (`((r:'a->bool) UNLESS r)(CONS st Pr)`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (UNDISCH_ALL (SPECL + [(`q:'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] + UNLESS_thm7))) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((q':'a->bool)UNLESS r)(CONS st Pr)`); (`((r:'a->bool) UNLESS r)(CONS st Pr)`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (REWRITE_RULE [OR_OR_lemma] (UNDISCH_ALL (SPECL + [(`q':'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`r:'a->bool`); (`CONS (st:'a->'a) Pr`)] + UNLESS_thm7))) THEN + ASSUME_TAC (SPECL + [(`p:'a->bool`); (`(q:'a->bool) \/* r`); + (`p':'a->bool`); (`(q':'a->bool) \/* r`); (`r:'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm35) THEN + RES_TAC THEN + UNDISCH_TAC (`(((p:'a->bool) /\* p') LEADSTO + (((q \/* r) /\* (q' \/* r)) \/* r))(CONS st Pr)`) THEN + ONCE_REWRITE_TAC [SPECL + [(`(q:'a->bool) \/* r`); (`r:'a->bool`); (`q':'a->bool`)] AND_OR_COMM_lemma] THEN + ONCE_REWRITE_TAC [SPECL + [(`(r:'a->bool) \/* q'`); (`r:'a->bool`); (`q:'a->bool`)] OR_COMM_AND_lemma] THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL OR_AND_DISTR_lemma))] THEN + ONCE_REWRITE_TAC [SPECL + [(`r:'a->bool`); (`(q:'a->bool) /\* q'`)] OR_COMM_lemma] THEN + REWRITE_TAC [OR_ASSOC_lemma; OR_OR_lemma]);; + + +(* + !p q r b p' q' r' b' Pr. + (p LEADSTO (q \/* r)) Pr /\ (q UNLESS b) Pr /\ + (p' LEADSTO (q' \/* r')) Pr /\ (q' UNLESS b') Pr ==> + ((p /\* p') LEADSTO ((q /\* q') \/* ((r \/* b) \/* (r' \/* b')))) Pr +*) +let LEADSTO_cor15 = prove_thm + ("LEADSTO_cor15", + (`!(p:'a->bool) q r b p' q' r' b' st Pr. + (p LEADSTO (q \/* r))(CONS st Pr) /\ (q UNLESS b)(CONS st Pr) /\ + (p' LEADSTO (q' \/* r'))(CONS st Pr) /\ (q' UNLESS b')(CONS st Pr) + ==> + ((p /\* p') LEADSTO + ((q /\* q') \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr)`), + REPEAT STRIP_TAC THEN + MP_TAC (SPECL + [(`b:'a->bool`); (`(r:'a->bool) \/* (r' \/* b')`)] OR_IMPLY_WEAK_lemma) THEN + REWRITE_TAC [SYM (SPECL [(`b:'a->bool`); (`r:'a->bool`); (`(r':'a->bool) \/* b'`)] + OR_ASSOC_lemma)] THEN + ONCE_REWRITE_TAC [SPECL [(`(r':'a->bool) \/* b'`); (`r:'a->bool`); (`b:'a->bool`)] + OR_COMM_OR_lemma] THEN + DISCH_TAC THEN + MP_TAC (SPECL + [(`b':'a->bool`); (`(r':'a->bool) \/* (r \/* b)`)] OR_IMPLY_WEAK_lemma) THEN + REWRITE_TAC [SYM (SPECL [(`b':'a->bool`); (`r':'a->bool`); (`(r:'a->bool) \/* b`)] + OR_ASSOC_lemma)] THEN + ONCE_REWRITE_TAC [SPECL [(`(r:'a->bool) \/* b`); (`r':'a->bool`); (`b':'a->bool`)] + OR_COMM_OR_lemma] THEN + ONCE_REWRITE_TAC [SPECL [(`(r':'a->bool) \/* b'`); (`(r:'a->bool) \/* b`)] + OR_COMM_lemma] THEN + DISCH_TAC THEN + MP_TAC (SPECL + [(`r:'a->bool`); (`(b:'a->bool) \/* (r' \/* b')`)] OR_IMPLY_WEAK_lemma) THEN + REWRITE_TAC [SYM (SPECL [(`r:'a->bool`); (`b:'a->bool`); (`(r':'a->bool) \/* b'`)] + OR_ASSOC_lemma)] THEN + DISCH_TAC THEN + MP_TAC (SPECL + [(`r':'a->bool`); (`(b':'a->bool) \/* (r \/* b)`)] OR_IMPLY_WEAK_lemma) THEN + REWRITE_TAC [SYM (SPECL [(`r':'a->bool`); (`b':'a->bool`); (`(r:'a->bool) \/* b`)] + OR_ASSOC_lemma)] THEN + ONCE_REWRITE_TAC [SPECL [(`(r':'a->bool) \/* b'`); (`(r:'a->bool) \/* b`)] + OR_COMM_lemma] THEN + DISCH_TAC THEN + REWRITE_TAC [SYM (SPECL [(`(r:'a->bool) \/* b`); (`(r':'a->bool) \/* b'`); + (`(q:'a->bool) /\* q'`)] + OR_ASSOC_lemma)] THEN + ONCE_REWRITE_TAC [SPECL + [(`(((r:'a->bool) \/* b) \/* (r' \/* b'))`); (`(q:'a->bool) /\* q'`)] + OR_COMM_lemma] THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((q:'a->bool) UNLESS b)(CONS st Pr)`); + (`!s:'a. b s ==> ((r \/* b) \/* (r' \/* b'))s`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`q:'a->bool`); (`b:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); + (`CONS (st:'a->'a) Pr`)] + UNLESS_thm3)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((q':'a->bool) UNLESS b')(CONS st Pr)`); + (`!s:'a. b' s ==> ((r \/* b) \/* (r' \/* b'))s`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`q':'a->bool`); (`b':'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); + (`CONS (st:'a->'a) Pr`)] + UNLESS_thm3)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`r:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`r':'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b')`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] LEADSTO_thm25)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) LEADSTO (q \/* r))(CONS st Pr)`); + (`((r:'a->bool) LEADSTO ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`); + (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm28)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p':'a->bool) LEADSTO (q' \/* r'))(CONS st Pr)`); + (`((r':'a->bool) LEADSTO ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p':'a->bool`); (`q':'a->bool`); (`r':'a->bool`); + (`((r:'a->bool) \/* b) \/* (r' \/* b')`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_thm28)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) LEADSTO (q \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr)`); + (`((q:'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p':'a->bool) LEADSTO(q' \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr)`); + (`((q':'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) LEADSTO(q \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ + ((q:'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`); + (`((p':'a->bool)LEADSTO(q' \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ + ((q':'a->bool) UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`)] + AND_INTRO_THM)) THEN + UNDISCH_TAC + (`(((p:'a->bool) LEADSTO(q \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ + (q UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)) /\ + (p' LEADSTO (q' \/* ((r \/* b) \/* (r' \/* b'))))(CONS st Pr) /\ + (q' UNLESS ((r \/* b) \/* (r' \/* b')))(CONS st Pr)`) THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC))] THEN + DISCH_TAC THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`q:'a->bool`); (`((r:'a->bool) \/* b) \/* (r' \/* b'):'a->bool`); + (`p':'a->bool`); (`q':'a->bool`); (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_cor14)));; + + +(* Prove: + |- !P Q R B Pr. + (!i. ((P i) LEADSTO ((Q i) \/* (R i)))Pr) /\ (!i. ((Q i) UNLESS (B i))Pr) ==> + (!i. ((/<=\* P i) LEADSTO ((/<=\* Q i) \/* (( \<=/* R i) \/* ( \<=/* B i))))Pr) +*) +let LEADSTO_cor16_lemma1 = TAC_PROOF + (([], + (`!(Q:num->('a->bool)) R B i s. + ((/<=\* Q(SUC i)) \/* + (((( \<=/* R i) \/* ( \<=/* B i)) \/* ( \<=/* B i)) \/* + ((R(SUC i)) \/* (B(SUC i)))))s = + ((/<=\* Q(SUC i)) \/* (( \<=/* R(SUC i)) \/* ( \<=/* B(SUC i))))s`)), + REPEAT GEN_TAC THEN + REWRITE_TAC [OR_def; AND_LE_N_def; OR_LE_N_def; AND_def] THEN + BETA_TAC THEN + EQ_TAC THEN REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; + +let LEADSTO_cor16 = prove_thm + ("LEADSTO_cor16", + (`!(P:num->('a->bool)) Q R B st Pr. + (!i. ((P i) LEADSTO ((Q i) \/* (R i)))(CONS st Pr)) /\ + (!i. ((Q i) UNLESS (B i))(CONS st Pr)) ==> + (!i. ((/<=\* P i) LEADSTO + ((/<=\* Q i) \/* (( \<=/* R i) \/* ( \<=/* B i)))) (CONS st Pr))`), + REPEAT GEN_TAC THEN + STRIP_TAC THEN + INDUCT_TAC THENL + [ + ASM_REWRITE_TAC [AND_LE_N_def; OR_LE_N_def] THEN + ASSUME_TAC (ONCE_REWRITE_RULE [OR_ASSOC_lemma] (SPECL + [(`((Q:num->('a->bool))0) \/* (R 0)`); (`((B:num->('a->bool))0)`)] + OR_IMPLY_WEAK_lemma)) THEN + ASSUME_TAC (SPEC (`0`) (ASSUME + (`!i.(((P:num->('a->bool))i) LEADSTO ((Q i) \/* (R i)))(CONS st Pr)`))) THEN + IMP_RES_TAC (SPECL [`(P:num->('a->bool)) 0`; + `(Q:num->('a->bool)) 0 \/* R 0`; + `(Q:num->('a->bool)) 0 \/* R 0 \/* B 0` ] LEADSTO_cor9) + ; + ASSUME_TAC (SPEC (`SUC i`) (ASSUME + (`!i.(((P:num->('a->bool))i) LEADSTO ((Q i) \/* (R i)))(CONS st Pr)`))) THEN + ASSUME_TAC (SPEC (`SUC i`) (ASSUME + (`!i. (((Q:num->('a->bool)) i) UNLESS (B i))(CONS st Pr)`))) THEN + ASSUME_TAC (SPEC (`i:num`) (UNDISCH_ALL (SPECL + [(`Q:num->('a->bool)`); (`B:num->('a->bool)`); (`CONS st Pr:('a->'a)list`)] + UNLESS_cor16))) THEN + ACCEPT_TAC (REWRITE_RULE [ONCE_REWRITE_RULE [ETA_AX] + (MK_ABS (GEN (`s:'a`) (SPEC_ALL LEADSTO_cor16_lemma1)))] + (REWRITE_RULE [SYM (SPEC_ALL (CONJUNCT2 AND_LE_N_def))] (REWRITE_RULE + [ASSUME (`((/<=\* (P:num->'a->bool) i) LEADSTO + ((/<=\* Q i) \/* (( \<=/* R i) \/* ( \<=/* B i))))(CONS st Pr)`); + ASSUME (`(((P:num->'a->bool)(SUC i)) LEADSTO ((Q(SUC i)) \/* (R(SUC i)))) + (CONS st Pr)`); + ASSUME (`(((Q:num->'a->bool)(SUC i)) UNLESS (B(SUC i)))(CONS st Pr)`); + ASSUME (`((/<=\* (Q:num->'a->bool) i) UNLESS ( \<=/* B i))(CONS st Pr)`)] + (SPECL + [(`/<=\* (P:num->('a->bool))i`); (`/<=\* (Q:num->('a->bool))i`); + (`( \<=/* (R:num->('a->bool))i) \/* ( \<=/* (B:num->('a->bool))i)`); + (` \<=/* (B:num->('a->bool))i`); + (`(P:num->('a->bool))(SUC i)`); (`(Q:num->('a->bool))(SUC i)`); + (`(R:num->('a->bool))(SUC i)`); (`(B:num->('a->bool))(SUC i)`); + (`st:'a->'a`); (`Pr:('a->'a)list`)] + LEADSTO_cor15)))) + ]);; diff --git a/Unity/mk_state_logic.ml b/Unity/mk_state_logic.ml new file mode 100644 index 0000000..8bc6565 --- /dev/null +++ b/Unity/mk_state_logic.ml @@ -0,0 +1,1036 @@ +(* + File: mk_state_logic.ml + + Description: This file defines the state abstracted logical + operators used in unity and some theorems valid for + the combination of these operators. + + Author: (c) Copyright 1989-2008 by Flemming Andersen + Date: October 23, 1989 + Last Update: December 30, 2007 + +*) + +(* loadt"aux_definitions.ml";; *) + +let FALSE_def = new_definition (`(False:'a->bool) = \s:'a. F`);; +let TRUE_def = new_definition (`(True:'a->bool) = \s:'a. T`);; +let NOT_def1 = new_definition (`Not (p:'a->bool) = \s. ~p s`);; +let NOT_def2 = new_definition (`~* (p:'a->bool) = \s. ~p s`);; + +let AND_def = new_infix_definition +("/\*", "/\\", `/\* (p:'a->bool) (q:'a->bool) = \s. (p s) /\ (q s)`, OP_FIX);; +let OR_def = new_infix_definition +("\/*", "\/", `\/* (p:'a->bool) (q:'a->bool) = \s. (p s) \/ (q s)`, OP_FIX);; + +let FORALL_def = new_binder_definition + (`!* (P:'b->('a->bool)) = (\s. (!x. ((P x)s)))`) "!*";; +let EXISTS_def = new_binder_definition + (`?* (P:'b->('a->bool)) = (\s. (?x. ((P x)s)))`) "?*";; +let CHOICE_def = new_binder_definition + (`@* P = (\s:'a. (@x:'b. ((P x)s)))`) "@*";; + +let IMPLIES_def = new_infix_definition +("==>*", "==>", `==>* (p:'a->bool) (q:'a->bool) = \s. (p s) ==> (q s)`, OP_FIX);; + +let LESS_def = new_infix_definition + ("<*", "<", `<* (p:'a->num) (q:'a->num) = \s. (p s) < (q s)`, OP_FIX);; +let GREATER_def = new_infix_definition + (">*", ">", `>* (p:'a->num) (q:'a->num) = \s. (p s) > (q s)`, OP_FIX);; +let LESS_EQ_def = new_infix_definition + ("<=*", "<=", `<=* (p:'a->num) (q:'a->num) = \s. (p s) <= (q s)`, OP_FIX);; +let GREATER_EQ_def = new_infix_definition + (">=*", ">=", `>=* (p:'a->num) (q:'a->num) = \s. (p s) >= (q s)`, OP_FIX);; +let EQ_def = new_infix_definition + ("=*", "=", `=* (p:'a->'b) (q:'a->'b) = \s. (p s) = (q s)`, OP_FIX);; +let NEQ_def = new_infix_definition + ("<>*", "=", `<>* (p:'a->'b) (q:'a->'b) = \s. ~((p s) = (q s))`, OP_FIX);; +let GE_def = new_infix_definition + ("=>*", "<=>", `=>* (p:'a->bool) (r1:'a->'b) (r2:'a->'b) = + \s. if (p s) then r1 s else r2 s`, OP_FIX);; +let PLUS_def = new_infix_definition + ("+*", "+", `+* (p:'a->num) (q:'a->num) = \s. (p s) + (q s)`, OP_FIX);; +let SUB_def = new_infix_definition + ("-*", "-", `-* (p:'a->num) (q:'a->num) = \s. (p s) - (q s)`, OP_FIX);; +let MUL_def = new_infix_definition + ("**", "*", `(**) (p:'a->num) (q:'a->num) = \s. ((p s) * (q s))`, OP_FIX);; +let SUC_def = new_definition + (`Suc (p:'a->num) = \s. SUC (p s)`);; +let PRE_def = new_definition + (`Pre (p:'a->num) = \s. PRE (p s)`);; +let MOD_def = new_infix_definition + ("%*", "MOD", `%* (p:'a->num) (q:'a->num) = \s. (p s) MOD (q s)`, OP_FIX);; +let DIV_def = new_infix_definition + ("/*", "/", `/* (p:'a->num) (q:'a->num) = \s. (p s) DIV (q s)`, OP_FIX);; +let EXP_def = new_infix_definition + ("***", "EXP", `*** (p:'a->num) (q:'a->num) = \s. (p s) EXP (q s)`, OP_FIX);; + +(* State dependent index *) +(* Weakness in defining priority: does o have same prio as Ind? *) +let IND_def = new_infix_definition + ("Ind", "o", `Ind (a:'a->('b->'c)) (i:'a->'b) = \s. (a s) (i s)`, OP_FIX);; + +(* More State dependent operators to be defined ??? *) + +(* Be aware that (!i :: i <= m. P i) = (!i. i <= m ==> P i) *) +let FORALL_LE_def = new_definition + (`!<=* (P:num->('a->bool)) m = (\s:'a. (!i. i <= m ==> ((P i)s)))`);; + +(* Be aware that ?i :: i <= m. P i == ?i. i <= m /\ P i *) +let EXISTS_LE_def = new_definition + (`?<=* (P:num->('a->bool)) m = (\s:'a. (?i. i <= m /\ ((P i)s)))`);; + +let EXISTS_LT_def = new_definition + (`?<* (P:num->('a->bool)) m = (\s:'a. (?i. i < m /\ ((P i)s)))`);; + +let AND_LE_N_def = new_recursive_definition + num_RECURSION + (`(!P. /<=\* P 0 = (P:num->('a->bool)) 0) /\ + (!P. /<=\* P (SUC i) = ((/<=\* P i) /\* (P (SUC i))))`);; + +let OR_LE_N_def = new_recursive_definition + num_RECURSION + (`(!P. \<=/* P 0 = (P:num->('a->bool)) 0) /\ + (!P. (\<=/* P (SUC i)) = ((\<=/* P i) \/* (P (SUC i))))`);; + +let AND_LT_N_def = new_recursive_definition + num_RECURSION + (`(!P. /<\* P 0 = (False:'a->bool)) /\ + (!P. /<\* P (SUC i) = ((/<\* P i) /\* (P i)))`);; + +let OR_LT_N_def = new_recursive_definition + num_RECURSION + (`(!P. \bool)) /\ + (!P. \bool`;; +let q = `q:'a->bool`;; +let r = `r:'a->bool`;; +let i = `i:num`;; +let P = `P:num->('a->bool)`;; + +let IMPLY_WEAK_lemma1 = prove_thm + ("IMPLY_WEAK_lemma1", + (`!p q p' q' (s:'a). + ( (((p /\* q') \/* (p' /\* q)) \/* (q /\* q')) s ) ==> ((q \/* q') s)`), + REPEAT(GEN_TAC) THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [(SYM (SPEC_ALL DISJ_ASSOC))] THEN + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []]);; + +let IMPLY_WEAK_lemma2 = prove_thm + ("IMPLY_WEAK_lemma2", + `!p q p' q' (s:'a). + ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))s + ==> + (q \/* q')s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + BETA_TAC THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); + SYM (SPEC_ALL DISJ_ASSOC); + NOT_CLAUSES; + DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []]);; + +let IMPLY_WEAK_lemma3 = prove_thm + ("IMPLY_WEAK_lemma3", + `!p q r (s:'a). + ((((Not p) /\* r) \/* ((Not q) /\* q)) \/* (q /\* r))s + ==> + r s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [(SYM (SPEC_ALL DISJ_ASSOC))] THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let IMPLY_WEAK_lemma4 = prove_thm + ("IMPLY_WEAK_lemma4", + `!p q p' q' r r' (s:'a). + ((((Not(p \/* p')) /\* (p \/* r')) \/* + ((Not(q \/* q')) /\* (q \/* r))) \/* + ((q \/* r) /\* (p \/* r')))s + ==> + ((p /\* q) \/* r \/* r')s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [SYM (SPEC_ALL DISJ_ASSOC); + GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); + NOT_CLAUSES; + DE_MORGAN_THM] THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN ASM_REWRITE_TAC []);; + +let IMPLY_WEAK_lemma5 = prove_thm + ("IMPLY_WEAK_lemma5", + `!p q r (s:'a). + ((p /\* r) \/* (((p \/* q) /\* (q \/* r)) \/* r)) s + ==> + (q \/* r) s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN + RES_TAC THEN ASM_REWRITE_TAC []);; + +let IMPLY_WEAK_lemma6 = prove_thm + ("IMPLY_WEAK_lemma6", + `!p q b r (s:'a). + ((r /\* q) \/* (p /\* b) \/* (b /\* q)) s + ==> + ((q /\* r) \/* b) s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let IMPLY_WEAK_lemma7 = prove_thm + ("IMPLY_WEAK_lemma7", + `!p q b r (s:'a). + (((r /\* q) \/* ((r /\* p) /\* b)) \/* (b /\* q)) s + ==> + ((q /\* r) \/* b) s`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let CONJ_COMM_DISJ_lemma_a = TAC_PROOF + (([], + `!p q r (s:'a). + (r s /\ q s) \/ p s + ==> + (q s /\ r s) \/ p s`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_COMM_DISJ_lemma_b = TAC_PROOF + (([], + `!p q r (s:'a). + (q s /\ r s) \/ p s + ==> + (r s /\ q s) \/ p s`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_COMM_DISJ_lemma = TAC_PROOF + (([], + `!p q r (s:'a). + (r s /\ q s) \/ p s + <=> (q s /\ r s) \/ p s`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL CONJ_COMM_DISJ_lemma_a) + (SPEC_ALL CONJ_COMM_DISJ_lemma_b)));; + +let AND_COMM_OR_lemma = prove_thm + ("AND_COMM_OR_lemma", + `!(p:'a->bool) q r. ((r /\* q) \/* p) = ((q /\* r) \/* p)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_COMM_DISJ_lemma)));; + +let CONJ_DISJ_COMM_lemma_a = TAC_PROOF + (([], + `!p q r (s:'a). + (p s /\ (r s \/ q s)) + ==> + (p s /\ (q s \/ r s))`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_DISJ_COMM_lemma_b = TAC_PROOF + (([], + `!p q r (s:'a). + (p s /\ (q s \/ r s)) + ==> + (p s /\ (r s \/ q s))`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_DISJ_COMM_lemma = TAC_PROOF + (([], + `!p q r (s:'a). + (p s /\ (r s \/ q s)) + = (p s /\ (q s \/ r s))`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL CONJ_DISJ_COMM_lemma_a) + (SPEC_ALL CONJ_DISJ_COMM_lemma_b)));; + +let AND_OR_COMM_lemma = prove_thm + ("AND_OR_COMM_lemma", + `!(p:'a->bool) q r. + p /\* (r \/* q) + = p /\* (q \/* r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_DISJ_COMM_lemma)));; + +let DISJ_COMM_CONJ_lemma_a = TAC_PROOF + (([], + `!p q r (s:'a). + (r s \/ q s) /\ p s + ==> + (q s \/ r s) /\ p s`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_COMM_CONJ_lemma_b = TAC_PROOF + (([], + `!p q r (s:'a). + (q s \/ r s) /\ p s + ==> + (r s \/ q s) /\ p s`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_COMM_CONJ_lemma = TAC_PROOF + (([], + `!p q r (s:'a). + (r s \/ q s) /\ p s + <=> (q s \/ r s) /\ p s`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL DISJ_COMM_CONJ_lemma_a) + (SPEC_ALL DISJ_COMM_CONJ_lemma_b)));; + +let OR_COMM_AND_lemma = prove_thm + ("OR_COMM_AND_lemma", + `!(p:'a->bool) q r. + (r \/* q) /\* p + = (q \/* r) /\* p`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_COMM_CONJ_lemma)));; + +let DISJ_COMM_DISJ_lemma_a = TAC_PROOF + (([], + `!p q r (s:'a). + (r s \/ q s) \/ p s + ==> + (q s \/ r s) \/ p s`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_COMM_DISJ_lemma_b = TAC_PROOF + (([], + `!p q r (s:'a). + (q s \/ r s) \/ p s + ==> + (r s \/ q s) \/ p s`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_COMM_DISJ_lemma = TAC_PROOF + (([], + `!(p:'a->bool) q r s. (r s \/ q s) \/ p s <=> (q s \/ r s) \/ p s`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL DISJ_COMM_DISJ_lemma_a) + (SPEC_ALL DISJ_COMM_DISJ_lemma_b)));; + +let OR_COMM_OR_lemma = prove_thm + ("OR_COMM_OR_lemma", + `!(p:'a->bool) q r. (r \/* q) \/* p = (q \/* r) \/* p`, + REPEAT GEN_TAC THEN + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_COMM_DISJ_lemma)));; + +let DISJ_DISJ_COMM_lemma_a = TAC_PROOF + (([], `!p q r (s:'a). p s \/ (r s \/ q s) ==> p s \/ (q s \/ r s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_DISJ_COMM_lemma_b = TAC_PROOF + (([], `!p q r (s:'a). p s \/ (q s \/ r s) ==> p s \/ (r s \/ q s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_DISJ_COMM_lemma = TAC_PROOF + (([], `!p q r (s:'a). p s \/ (r s \/ q s) <=> p s \/ (q s \/ r s) `), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL DISJ_DISJ_COMM_lemma_a) + (SPEC_ALL DISJ_DISJ_COMM_lemma_b)));; + +let OR_OR_COMM_lemma = prove_thm + ("OR_OR_COMM_lemma", + (`!(p:'a->bool) q r. p \/* (r \/* q) = p \/* (q \/* r)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_DISJ_COMM_lemma)));; + +let CONJ_COMM_CONJ_lemma_a = TAC_PROOF + (([], `!p q r (s:'a). (r s /\ q s) /\ p s ==> (q s /\ r s) /\ p s`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let CONJ_COMM_CONJ_lemma_b = TAC_PROOF + (([], `!p q r (s:'a). (q s /\ r s) /\ p s ==> (r s /\ q s) /\ p s`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let CONJ_COMM_CONJ_lemma = TAC_PROOF + (([], `!p q r (s:'a). (r s /\ q s) /\ p s <=> (q s /\ r s) /\ p s`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL CONJ_COMM_CONJ_lemma_a) + (SPEC_ALL CONJ_COMM_CONJ_lemma_b)));; + +let AND_COMM_AND_lemma = prove_thm + ("AND_COMM_AND_lemma", + `!(p:'a->bool) q r. (r /\* q) /\* p = (q /\* r) /\* p`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_COMM_CONJ_lemma)));; + +let CONJ_CONJ_COMM_lemma_a = TAC_PROOF + (([], `!p q r (s:'a). p s /\ (r s /\ q s) ==> p s /\ (q s /\ r s)`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let CONJ_CONJ_COMM_lemma_b = TAC_PROOF + (([], `!p q r (s:'a). p s /\ (q s /\ r s) ==> p s /\ (r s /\ q s)`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let CONJ_CONJ_COMM_lemma = TAC_PROOF + (([], `!p q r (s:'a). p s /\ (r s /\ q s) <=> p s /\ (q s /\ r s) `), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL CONJ_CONJ_COMM_lemma_a) + (SPEC_ALL CONJ_CONJ_COMM_lemma_b)));; + +let AND_AND_COMM_lemma = prove_thm + ("AND_AND_COMM_lemma", + `!(p:'a->bool) q r. p /\* (r /\* q) = p /\* (q /\* r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_CONJ_COMM_lemma)));; + +let DISJ_CONJ_COMM_lemma_a = TAC_PROOF + (([], `!p q r (s:'a). p s \/ (r s /\ q s) ==> p s \/ (q s /\ r s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_CONJ_COMM_lemma_b = TAC_PROOF + (([], `!p q r (s:'a). p s \/ (q s /\ r s) ==> p s \/ (r s /\ q s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_CONJ_COMM_lemma = TAC_PROOF + (([], `!p q r (s:'a). p s \/ (r s /\ q s) <=> p s \/ (q s /\ r s)`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (IMP_ANTISYM_RULE + (SPEC_ALL DISJ_CONJ_COMM_lemma_a) + (SPEC_ALL DISJ_CONJ_COMM_lemma_b)));; + +let OR_AND_COMM_lemma = prove_thm + ("OR_AND_COMM_lemma", + `!(p:'a->bool) q r. p \/* (r /\* q) = p \/* (q /\* r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_CONJ_COMM_lemma)));; + +let NOT_NOT_lemma = prove_thm + ("NOT_NOT_lemma", + `!(p:'a->bool). (Not (Not p)) = p`, + REWRITE_TAC [NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [NOT_CLAUSES; ETA_AX]);; + +let DISJ_COMM_lemma = TAC_PROOF + (([], `!p q (s:'a). p s \/ q s <=> q s \/ p s`), + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC + (SPECL [`(p (s:'a)):bool`; `(q (s:'a)):bool`] DISJ_SYM));; + +let OR_COMM_lemma = prove_thm + ("OR_COMM_lemma", + `!(p:'a->bool) q. (p \/* q) = (q \/* p)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC [OR_def] THEN + ASSUME_TAC DISJ_COMM_lemma THEN + STRIP_ASSUME_TAC + (MK_ABS (SPECL [p;q] + (ASSUME (`!(p:'a->bool) q s. p s \/ q s <=> q s \/ p s`)))));; + +let OR_OR_lemma = prove_thm + ("OR_OR_lemma", + `!p:'a->bool. p \/* p = p`, + GEN_TAC THEN REWRITE_TAC [OR_def; ETA_AX]);; + +let DISJ_ASSOC_lemma = TAC_PROOF + (([], `!p q r (s:'a). ((p s \/ q s) \/ r s) <=> (p s \/ (q s \/ r s))`), + REWRITE_TAC [(SYM (SPEC_ALL DISJ_ASSOC))]);; + +let OR_ASSOC_lemma = prove_thm + ("OR_ASSOC_lemma", + (`!(p:'a->bool) q r. (p \/* q) \/* r = p \/* (q \/* r)`), + REPEAT STRIP_TAC THEN REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + ASSUME_TAC DISJ_ASSOC_lemma THEN + STRIP_ASSUME_TAC + (MK_ABS (SPECL [p;q;r] + (ASSUME (`!p q r (s:'a). + ((p s \/ q s) \/ r s) <=> (p s \/ (q s \/ r s))`)))));; + +let CONJ_WEAK_lemma = TAC_PROOF + (([], `!p q (s:'a). p s /\ q s ==> q s`), + REPEAT STRIP_TAC THEN RES_TAC);; + +let AND_IMPLY_WEAK_lemma = prove_thm + ("AND_IMPLY_WEAK_lemma", + `!p q (s:'a). (p /\* q) s ==> q s`, + REWRITE_TAC [AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [CONJ_WEAK_lemma]);; + +let SYM_CONJ_WEAK_lemma = TAC_PROOF + (([], `!p q (s:'a). p s /\ q s ==> p s`), + REPEAT STRIP_TAC THEN RES_TAC);; + +let SYM_AND_IMPLY_WEAK_lemma = prove_thm + ("SYM_AND_IMPLY_WEAK_lemma", + `!p q (s:'a). (p /\* q) s ==> p s`, + REWRITE_TAC [AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [SYM_CONJ_WEAK_lemma]);; + +let OR_IMPLY_WEAK_lemma = prove_thm + ("OR_IMPLY_WEAK_lemma", + `!p q (s:'a). p s ==> (p \/* q) s`, + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +let SYM_OR_IMPLY_WEAK_lemma = prove_thm + ("SYM_OR_IMPLY_WEAK_lemma", + `!p q (s:'a). p s ==> (q \/* p) s`, + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +let IMPLY_WEAK_AND_lemma = prove_thm + ("IMPLY_WEAK_AND_lemma", + `!(p:'a->bool) q r. + (!s. p s ==> q s) + ==> + (!s. (p /\* r) s ==> (q /\* r) s)`, + REWRITE_TAC [AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THENL + [RES_TAC; + RES_TAC THEN + ASM_REWRITE_TAC []]);; + +let IMPLY_WEAK_OR_lemma = prove_thm + ("IMPLY_WEAK_OR_lemma", + `!(p:'a->bool) q r. + (!s. p s ==> q s) + ==> + (!s. (p \/* r) s ==> (q \/* r) s)`, + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THENL + [RES_TAC THEN + ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []]);; + +let AND_AND_lemma = prove_thm + ("AND_AND_lemma", + `!p:'a->bool. p /\* p = p`, + REWRITE_TAC [AND_def; ETA_AX]);; + +let CONJ_COMM_lemma = TAC_PROOF + (([], + `!p q (s:'a). (p s /\ q s) <=> (q s /\ p s)`), + REPEAT GEN_TAC THEN + STRIP_ASSUME_TAC (SPECL [`(p:'a->bool) s`; `(q:'a->bool) s`] CONJ_SYM));; + +let AND_COMM_lemma = prove_thm + ("AND_COMM_lemma", + (`!(p:'a->bool) q. (p /\* q) = (q /\* p)`), + REWRITE_TAC [AND_def] THEN + REPEAT GEN_TAC THEN + ASSUME_TAC CONJ_COMM_lemma THEN + STRIP_ASSUME_TAC + (MK_ABS (SPECL [p;q] + (ASSUME (`!p q (s:'a). p s /\ q s <=> q s /\ p s`)))));; + +let CONJ_ASSOC_lemma = TAC_PROOF + (([], + `!p q r (s:'a). ((p s /\ q s) /\ r s) <=> (p s /\ (q s /\ r s))`), + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC))]);; + +let AND_ASSOC_lemma = prove_thm + ("AND_ASSOC_lemma", + `!(p:'a->bool) q r. (p /\* q) /\* r = p /\* (q /\* r)`, + REPEAT GEN_TAC THEN REWRITE_TAC [AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + ASSUME_TAC CONJ_ASSOC_lemma THEN + STRIP_ASSUME_TAC + (MK_ABS (SPECL [p;q;r] + (ASSUME (`!p q r (s:'a). + ((p s /\ q s) /\ r s) <=> (p s /\ (q s /\ r s))`)))));; + +let NOT_True_lemma = prove_thm + ("NOT_True_lemma", + `Not (True:'a->bool) = False`, + REWRITE_TAC [NOT_def1; TRUE_def; FALSE_def; ETA_AX]);; + +let NOT_False_lemma = prove_thm + ("NOT_False_lemma", + `Not (False:'a->bool) = True`, + REWRITE_TAC [NOT_def1; TRUE_def; FALSE_def; ETA_AX]);; + +let AND_True_lemma = prove_thm + ("AND_True_lemma", + `!p:'a->bool. p /\* True = p`, + REWRITE_TAC [AND_def; TRUE_def; ETA_AX]);; + +let OR_True_lemma = prove_thm + ("OR_True_lemma", + `!p:'a->bool. p \/* True = True`, + REWRITE_TAC [OR_def; TRUE_def; ETA_AX]);; + +let AND_False_lemma = prove_thm + ("AND_False_lemma", + `!p:'a->bool. p /\* False = False`, + REWRITE_TAC [AND_def; FALSE_def; ETA_AX]);; + +let OR_False_lemma = prove_thm + ("OR_False_lemma", + `!p:'a->bool. p \/* False = p`, + REWRITE_TAC [OR_def; FALSE_def; ETA_AX]);; + +let P_OR_NOT_P_lemma = prove_thm + ("P_OR_NOT_P_lemma", + `!p:'a->bool. p \/* (Not p) = True`, + REWRITE_TAC [OR_def; NOT_def1; TRUE_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [EXCLUDED_MIDDLE; OR_CLAUSES; NOT_CLAUSES; ETA_AX]);; + +let P_AND_NOT_P_lemma = prove_thm + ("P_AND_NOT_P_lemma", + `!p:'a->bool. p /\* (Not p) = False`, + REWRITE_TAC [AND_def; NOT_def1; FALSE_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [NOT_AND; AND_CLAUSES; NOT_CLAUSES; ETA_AX]);; + +let CONJ_COMPL_DISJ_lemma1 = TAC_PROOF + (([], + `!p q. p /\ ~q \/ p /\ q ==> p`), + REPEAT STRIP_TAC);; + +let CONJ_COMPL_DISJ_lemma2 = TAC_PROOF + (([], + `!p q. p ==> p /\ ~q \/ p /\ q`), + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC [] THEN + PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN + REWRITE_TAC [EXCLUDED_MIDDLE]);; + +let CONJ_COMPL_DISJ_lemma = TAC_PROOF + (([], + `!p q. p /\ ~q \/ p /\ q <=> p`), + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL CONJ_COMPL_DISJ_lemma1) + (SPEC_ALL CONJ_COMPL_DISJ_lemma2)]);; + +let AND_COMPL_OR_lemma = prove_thm + ("AND_COMPL_OR_lemma", + `!(p:'a->bool) q. ((p /\* (Not q)) \/* (p /\* q)) = p`, + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [CONJ_COMPL_DISJ_lemma; ETA_AX]);; + +let DISJ_NOT_CONJ_lemma1 = TAC_PROOF + (([], + `!p q. (p \/ q) /\ ~q ==> p /\ ~q`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC);; + +let DISJ_NOT_CONJ_lemma2 = TAC_PROOF + (([], + `!p q. p /\ ~q ==> (p \/ q) /\ ~q`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [] THEN RES_TAC);; + +let DISJ_NOT_CONJ_lemma = TAC_PROOF + (([], `!p q. (p \/ q) /\ ~q <=> p /\ ~q`), + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL DISJ_NOT_CONJ_lemma1) + (SPEC_ALL DISJ_NOT_CONJ_lemma2)]);; + +let OR_NOT_AND_lemma = prove_thm + ("OR_NOT_AND_lemma", + `!(p:'a->bool) q. ((p \/* q) /\* (Not q)) = p /\* (Not q)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [DISJ_NOT_CONJ_lemma]);; + +let P_CONJ_Q_DISJ_Q_lemma1 = TAC_PROOF + (([], `!(p:'a->bool) q s. (p s /\ q s) \/ q s ==> q s`), + REPEAT STRIP_TAC);; + +let P_CONJ_Q_DISJ_Q_lemma2 = TAC_PROOF + (([], `!(p:'a->bool) q s. q s ==> (p s /\ q s) \/ q s`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let P_CONJ_Q_DISJ_Q_lemma = TAC_PROOF + (([], `!(p:'a->bool) q s. (p s /\ q s) \/ q s <=> q s`), + ASM_REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL P_CONJ_Q_DISJ_Q_lemma1) + (SPEC_ALL P_CONJ_Q_DISJ_Q_lemma2)]);; + +let P_AND_Q_OR_Q_lemma = prove_thm + ("P_AND_Q_OR_Q_lemma", + `!(p:'a->bool) q. (p /\* q) \/* q = q`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [GEN_ALL (MK_ABS (SPECL [p;q] P_CONJ_Q_DISJ_Q_lemma)); ETA_AX]);; + +let P_DISJ_Q_CONJ_Q_lemma1 = TAC_PROOF + (([], `!(p:'a->bool) q s. (p s \/ q s) /\ q s ==> q s`), + REPEAT STRIP_TAC);; + +let P_DISJ_Q_CONJ_Q_lemma2 = TAC_PROOF + (([], `!(p:'a->bool) q s. q s ==> (p s \/ q s) /\ q s`), + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []);; + +let P_DISJ_Q_CONJ_Q_lemma = TAC_PROOF + (([], `!(p:'a->bool) q s. (p s \/ q s) /\ q s <=> q s`), + ASM_REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL P_DISJ_Q_CONJ_Q_lemma1) + (SPEC_ALL P_DISJ_Q_CONJ_Q_lemma2)]);; + +let P_OR_Q_AND_Q_lemma = prove_thm + ("P_OR_Q_AND_Q_lemma", + `!(p:'a->bool) q. (p \/* q) /\* q = q`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [GEN_ALL (MK_ABS (SPECL [p;q] P_DISJ_Q_CONJ_Q_lemma)); ETA_AX]);; + +let NOT_OR_AND_NOT_lemma = prove_thm + ("NOT_OR_AND_NOT_lemma", + `!(p:'a->bool) q. Not (p \/* q) = (Not p) /\* (Not q)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [NOT_CLAUSES; + DE_MORGAN_THM]);; + +let NOT_AND_OR_NOT_lemma = prove_thm + ("NOT_AND_OR_NOT_lemma", + `!(p:'a->bool) q. Not (p /\* q) = (Not p) \/* (Not q)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [NOT_CLAUSES; + DE_MORGAN_THM]);; + +let NOT_IMPLY_OR_lemma = prove_thm + ("NOT_IMPLY_OR_lemma", + `!(p:'a->bool) q. + (!s. (Not p)s ==> q s) + = (!s. (p \/* q)s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [IMP_DISJ_THM]);; + +let IMPLY_OR_lemma = prove_thm + ("IMPLY_OR_lemma", + `!(p:'a->bool) q. (!s. p s ==> q s) = (!s. ((Not p) \/* q)s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [IMP_DISJ_THM]);; + +let OR_IMPLY_lemma = prove_thm + ("OR_IMPLY_lemma", + `!(p:'a->bool) q. (!s. (p \/* q)s) = (!s. (Not p)s ==> q s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [IMP_DISJ_THM; NOT_CLAUSES]);; + +let NOT_OR_IMPLY_lemma = prove_thm + ("NOT_OR_IMPLY_lemma", + `!(p:'a->bool) q. (!s. ((Not p) \/* q)s) = (!s. p s ==> q s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [NOT_def1; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [IMP_DISJ_THM; NOT_CLAUSES]);; + +let DISJ_CONJ_lemma1 = TAC_PROOF + (([], + `!p q r (s:'a). + (p s \/ q s /\ r s) + ==> + ((p s \/ q s) /\ (p s \/ r s))`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_CONJ_lemma2 = TAC_PROOF + (([], `!(p:'a->bool) q r s. + ((p s \/ q s) /\ (p s \/ r s)) ==> (p s \/ q s /\ r s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let DISJ_CONJ_lemma = TAC_PROOF + (([], `!(p:'a->bool) q r s. + (p s \/ q s /\ r s) <=> ((p s \/ q s) /\ (p s \/ r s))`), + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL DISJ_CONJ_lemma1) + (SPEC_ALL DISJ_CONJ_lemma2)]);; + +let OR_AND_DISTR_lemma = prove_thm + ("OR_AND_DISTR_lemma", + `!(p:'a->bool) q r. p \/* (q /\* r) = (p \/* q) /\* (p \/* r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] DISJ_CONJ_lemma)));; + +let CONJ_DISJ_lemma1 = TAC_PROOF + (([], `!(p:'a->bool) q r s. + (p s /\ (q s \/ r s)) ==> (p s /\ q s \/ p s /\ r s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_DISJ_lemma2 = TAC_PROOF + (([], `!(p:'a->bool) q r s. + (p s /\ q s \/ p s /\ r s) ==> (p s /\ (q s \/ r s))`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []; + ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_DISJ_lemma = TAC_PROOF + (([], `!(p:'a->bool) q r s. + (p s /\ (q s \/ r s)) <=> (p s /\ q s \/ p s /\ r s)`), + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL CONJ_DISJ_lemma1) + (SPEC_ALL CONJ_DISJ_lemma2)]);; + +let AND_OR_DISTR_lemma = prove_thm + ("AND_OR_DISTR_lemma", + `!(p:'a->bool) q r. p /\* (q \/* r) = (p /\* q) \/* (p /\* r)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [p;q;r] CONJ_DISJ_lemma)));; + +let NOT_IMPLIES_False_lemma = prove_thm + ("NOT_IMPLIES_False_lemma", + `!(p:'a->bool). (!s. (Not p)s) ==> (!s. p s = False s)`, + REWRITE_TAC [FALSE_def; NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC []);; + +let NOT_P_IMPLIES_P_EQ_False_lemma = prove_thm + ("NOT_P_IMPLIES_P_EQ_False_lemma", + `!(p:'a->bool). (!s. (Not p)s) ==> (p = False)`, + REPEAT STRIP_TAC THEN + ASSUME_TAC (MK_ABS (UNDISCH_ALL (SPEC_ALL NOT_IMPLIES_False_lemma))) THEN + UNDISCH_TAC (`(\s:'a. p s) = (\s. False s)`) THEN + REWRITE_TAC [ETA_AX]);; + +let NOT_AND_IMPLIES_lemma = prove_thm + ("NOT_AND_IMPLIES_lemma", + `!(p:'a->bool) q. (!s. (Not (p /\* q))s) <=> (!s. p s ==> Not q s)`, + REWRITE_TAC [NOT_def1; AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [DE_MORGAN_THM; NOT_CLAUSES; IMP_DISJ_THM]);; + +let NOT_AND_IMPLIES_lemma1 = prove_thm + ("NOT_AND_IMPLIES_lemma1", + `!(p:'a->bool) q. (!s. (Not (p /\* q))s) ==> (!s. p s ==> Not q s)`, + REWRITE_TAC [NOT_AND_IMPLIES_lemma]);; + +let NOT_AND_IMPLIES_lemma2 = prove_thm + ("NOT_AND_IMPLIES_lemma2", + `!(p:'a->bool) q. (!s. (Not (p /\* q))s) ==> (!s. q s ==> Not p s)`, + REWRITE_TAC [NOT_AND_IMPLIES_lemma; NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +let CONJ_DISJ_IMPLY_lemma1 = TAC_PROOF + (([], `!(p:'a->bool) q s. p s /\ (p s \/ q s) ==> p s`), + REPEAT STRIP_TAC);; + +let CONJ_DISJ_IMPLY_lemma2 = TAC_PROOF + (([], `!(p:'a->bool) q s. p s ==> p s /\ (p s \/ q s)`), + REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC []; ASM_REWRITE_TAC []]);; + +let CONJ_DISJ_IMPLY_lemma = TAC_PROOF + (([], `!(p:'a->bool) q s. p s /\ (p s \/ q s) <=> p s`), + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL CONJ_DISJ_IMPLY_lemma1) + (SPEC_ALL CONJ_DISJ_IMPLY_lemma2)]);; + +let CONJ_DISJ_ABS_IMPLY_lemma = TAC_PROOF + (([], `!(p:'a->bool) q. (\s. p s /\ (p s \/ q s)) = p`), + REPEAT GEN_TAC THEN + REWRITE_TAC [CONJ_DISJ_IMPLY_lemma; ETA_AX]);; + +let AND_OR_EQ_lemma = prove_thm + ("AND_OR_EQ_lemma", + `!(p:'a->bool) q. p /\* (p \/* q) = p`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_def; OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [CONJ_DISJ_ABS_IMPLY_lemma]);; + +let AND_OR_EQ_AND_COMM_OR_lemma = prove_thm + ("AND_OR_EQ_AND_COMM_OR_lemma", + `!(p:'a->bool) q. p /\* (q \/* p) = p /\* (p \/* q)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [AND_OR_EQ_lemma] THEN + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [AND_OR_EQ_lemma]);; + +let IMPLY_WEAK_lemma = prove_thm + ("IMPLY_WEAK_lemma", + `!(p:'a->bool) q. (!s. p s) ==> (!s. (p \/* q) s)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + ASM_REWRITE_TAC []);; + +let IMPLY_WEAK_lemma_b = prove_thm + ("IMPLY_WEAK_lemma_b", + `!(p:'a->bool) q s. p s ==> (p \/* q) s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC [OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + ASM_REWRITE_TAC []);; + +let ALL_AND_lemma1 = TAC_PROOF + (([], + `!(P:num->('a->bool)) i s. (!i. P i s) <=> (P i s /\ (!i. P i s))`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THENL + [ + ASM_REWRITE_TAC [] + ; + ASM_REWRITE_TAC [] + ]; + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []]);; + +let ALL_OR_lemma1 = TAC_PROOF + (([], + `!(P:num->('a->bool)) i s. (?i. P i s) <=> (P i s \/ (?i. P i s))`), + REPEAT GEN_TAC THEN + EQ_TAC THENL + [ + REPEAT STRIP_TAC THEN + DISJ2_TAC THEN + EXISTS_TAC (`i':num`) THEN + ASM_REWRITE_TAC [] + ; + REPEAT STRIP_TAC THENL + [ + EXISTS_TAC (`i:num`) THEN + ASM_REWRITE_TAC [] + ; + EXISTS_TAC (`i:num`) THEN + ASM_REWRITE_TAC [] + ] + ]);; + +let ALL_OR_lemma = prove_thm + ("ALL_OR_lemma", + `!(P:num->('a->bool)) i. (((?*) P) = ((P i) \/* ((?*) P)))`, + GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC [EXISTS_def; OR_def] THEN + BETA_TAC THEN + STRIP_ASSUME_TAC (MK_ABS (SPECL [P;i] ALL_OR_lemma1)));; + +let ALL_i_OR_lemma1 = TAC_PROOF + (([], + `!P (s:'a). (?i. \<=/* P i s) = (?i. P i s)`), + REPEAT STRIP_TAC THEN + EQ_TAC THENL + [ + STRIP_TAC THEN + UNDISCH_TAC (`\<=/* (P:num->('a->bool)) i s`) THEN + SPEC_TAC (i,i) THEN + INDUCT_TAC THENL + [ + REWRITE_TAC [OR_LE_N_def] THEN + DISCH_TAC THEN + EXISTS_TAC (`0`) THEN + ASM_REWRITE_TAC [] + ; + REWRITE_TAC [OR_LE_N_def; OR_def] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THENL + [ + RES_TAC THEN + EXISTS_TAC (`i':num`) THEN + ASM_REWRITE_TAC [] + ; + EXISTS_TAC (`SUC i`) THEN + ASM_REWRITE_TAC [] + ] + ] + ; + STRIP_TAC THEN + UNDISCH_TAC (`(P (i:num) (s:'a)):bool`) THEN + SPEC_TAC (i,i) THEN + INDUCT_TAC THENL + [ + DISCH_TAC THEN + EXISTS_TAC (`0`) THEN + ASM_REWRITE_TAC [OR_LE_N_def] + ; + DISCH_TAC THEN + EXISTS_TAC (`SUC i`) THEN + REWRITE_TAC [OR_LE_N_def; OR_def] THEN + BETA_TAC THEN + ASM_REWRITE_TAC [] + ] + ]);; + +let ALL_i_OR_lemma = prove_thm + ("ALL_i_OR_lemma", + (`!P. ((\s:'a. ?i. \<=/* P i s) = ((?*) P))`), + REWRITE_TAC [EXISTS_def] THEN + GEN_TAC THEN + STRIP_ASSUME_TAC (MK_ABS (SPEC P ALL_i_OR_lemma1)));; diff --git a/Unity/mk_unity_prog.ml b/Unity/mk_unity_prog.ml new file mode 100644 index 0000000..512dbf2 --- /dev/null +++ b/Unity/mk_unity_prog.ml @@ -0,0 +1,993 @@ +(*---------------------------------------------------------------------------*) +(* + File: mk_unity_prog.sml + + Description: + + A back-end definition for the HOL-UNITY compiler programming language. + ===================================================================== + + This file introduces general definitions for describing a program + in HOL-UNITY. + + Author: (c) Copyright 1992-2008 + by Flemming Andersen & Kim Dam Petersen + Date: August 3, 1992 + Updated: May 4, 1995 + Updated: March 22, 2006 + Last Update: December 30, 2007 + + The functions below are based on the following representations: + + type 'loc = ``program variable location'' + type 'val = ``program value'' + type state = ('loc -> 'val) ``program state'' + + type t xpr = state -> t ``expression of type t'' + type t asg = t -> state -> state -> state ``assignment of type t'' + type t var = (t xpr, t asg) ``variable of type t'' + + type atom = state -> state ``atomic (singleton action)'' + type par = state -> state -> state ``parallel action'' + type int = atom list ``interleaved action (program)'' + type seq = var -> num -> (int list # num)``sequential action'' + + + Description of type representation: (Added: March 22, 2006) + ----------------------------------------------------------- + + 'loc is an atomic (location) value that identifies a variable. + Composite variables, such as arrays and lists has a + single identifier. Assignment to a composite part is + considered an assignment to the complete variable, that + doesn't change the non-assigned parts of the variable. + + 'val is a generic value type of all variables. + It is constructed as a union of the types of the + variables in the program. Each program will for each type + of variable define a pair of functions to respectively + encode and decode values of the type of the variable into + and from the generic type 'val. + + state is a state that associates each variable (identified by it's + 'loc location) with it's current value (encoded in the + generic type 'val of value). + A state represents the values of every variable at a + given moment. + A state is implemented as a map from variable locations + ('loc) to the generic value ('val) of the applied + variable location. + + ----- + + xpr 'val xpr - generic typed expression. + + t xpr is an expression of some (decoded) type t. + An expression represents a state dependent value, ie. a + value that depends on the values of variables. + An expression is implemented as map from a state (in + which the value is to be interpreted) to the value of the + expression in that state. + + t asg is a assignment to a variable of type t. + An assignment represents the change in state due to + assignment of some variable to a value. An assignment is + implemented as a map from the value to be assigned, the + original state and a previous state to the final state. + The need for two parameter states: original and previous + is due to the fact that assignment Consider the + (high-level) assignment: + + INITIALLY + a[0] = 0 /\ a[1] = 1 + ASSIGN + a[a[0]], a[a[1]] := 1, 0 + + The right-hand-side expression, and the left-hand-side + index expression should be evaluated in the original + state. + + The parallel assignments of: + a[a[0]], a[a[1]] := 1, 0 + must be "transformed" into a single assignment of a: + a := a[a[i] => 1, a[j] => 0] + If more variables are to be assigned we get: + i, j, a := 1, 0, a[a[i] => 1, a[j] => 0] + A parallel assignment is evaluated in sequence; it is + transformed into: + [ i := <1> ] ; [ j := <0> ] ; [ a := 1, a[j] => 0> ] + It should be obvious that the expression in <>-braces has + to be evaluated in the original state of the parallel + assignment, whereas the sequential assignments has to be + evaluated in the state that is the result of the previous + assignment. This explains the need for two state + parameters. + + ** To Be Changed ** + + t var is a variable of type t. + A variable is represented by a pair that allow read- and + write- access to the variable. + ** To Be Changed ** + + atom is an atomic action. + An atomic action represents the state change associated + with a single variable assignments. An atomic action is + implemented as a function, that given an initial state + returns the state after executing the atomic action. ** + To Be Changed ** + + par is a parallel action. + A parallel action represents the state change associated + with multiple atomic actions, ex. + (a[0] := a[1]) || (a[1] := a[0]). + A parallel action is implemented as a function of an + original- and previous state, that return a next + state. The use of original- and previous state is + explained above under section "t asg". + ** To Be Changed ** + + int is an interleaved action. + An interleaved action represents the semantic of an + interleaved action. An interleaved action is implemented + as a funtion that given an initial state returns the + state after evaluating the interleaved action. + + seq is a sequential action. + A sequential action is a sequence of interleaved + actions. Each interleaved action is identified with a + numeric label. A sequential action is represented as a + function that takes a program counter variable location, + a NUM -encode and -decode function and an initial label + for the action and returns a pair with a list of + interleaved actions that implements the individual + actions to be executed in sequence and a numeric label + that represents the end of the sequential action. This + label is used as initial label for an optional sequential + action that is compositionally added to the current. + + Example: val s1 : seq = `` Computer generated seq ''; + val s2 : seq = `` Computer generated seq ''; + val s1s2 : seq = fn pc => mk => ds => l0 => + let val (lst1, l1) = s1 pc mk ds l0 in + let val (lst2, l2) = s2 pc mk ds l1 in + (APPEND lst1 lst2, l2) + + +[Flemming, May 1995: + + Whereas we leave it for now due to the otherwize need for + updating the compiler, assignment COULD BE CHANGED to the + alternative below...] + + An alternative way of implementing multiple parallel + assignment exists: + + 1. Introduce a parallel variable assignment operator, + which takes a list of locations and a list of evaluated + generic typed expressions and performs the + assignment. There will no problems with side-effects, + due to the fact that all values has been evaluated. + + define + ParAsg ([]: 'loc list) ([] : 'val list) (s : state) : state = s + | ParAsg (loc::locs) (val :: vals) = + ParAsg locs vals (fn l => (l == loc) ? val | s l)) + | ParAsg _ _ = raise "ParAsg: location and value list differ in length"; + + The new type of ParAsg becomes: + + ParAsg : 'loc list -> 'val list -> state -> state + + If we redefine the type asg we get + + ParAsg : 'loc list -> 'val list -> asg + + 2. Introduce a list evaluation operator: + + define + EvalList ([] : (state -> 'val) list) (s : state) : 'val list = [] + | EvalList (genExp :: genExps) s = (genExp s) :: EvalList genExps s; + + 3. Compile a source parallel assignment into two lists: + locs of the variables being assigned, and exps of + component transformed expressions using decoded + types. This process is part of the exisiting compiler. + + 4. Prepend each expression in exps with the proper encode + function This produces a list genExps where every + element is a generic typed expression. + + 5. The final representaion can now be expressed as: + + ... + val locs_123 : 'loc list = [ ``Generated by compiler'' ] + val genExps_123 : 'val list = [ ``Generated by compiler'' ] + val parAsg_123 : asg = (ParAsg locs_123) o (EvalList genExps_123) + ... + + a) A consequence of this is that VAR parameters should be + represented by their 'loc location. + b) A variable component can not be used as argument for a + VAR parameter, but still be used for a value parameter. + c) The assignment and update funtion will be deprecated. + d) The write part of a variable pair has to be replaced + with it's 'loc location. + e) The representation of an atomic action should be changed + such that it is based on the variable locations and the + assigned expressions. (How do we handle components???) + +*) +(*---------------------------------------------------------------------------*) + + +let NUM = `:num`;; +let BOOL = `:bool`;; +let VAR_TP = (fun s -> mk_vartype("'"^s));; +let LST = (fun t -> mk_type("list",[t]));; +let PRD = (fun (l,r) -> mk_type("prod",[l;r]));; +let FUN = (fun (l,r) -> mk_type("fun",[l;r]));; +let rec FNC = + function (l,[]) -> l + | (l,(r::rs)) -> FUN(l,FNC(r,rs));; + +let LOC = VAR_TP"loc";; +let VAL = VAR_TP"val";; +let STA = FUN(LOC,VAL);; +let ACT = FUN(STA,STA);; +let INT = LST(ACT);; + +let XPR = (fun t -> FUN(STA,t));; +let ASG = (fun t -> FNC(XPR t,[STA; STA; STA]));; +let VAR = (fun t -> PRD(XPR t, ASG t));; +let PAR = FNC(STA,[STA; STA]);; +let SEQ = FUN(LOC, FUN(FUN(NUM,VAL), FUN(FUN(VAL,NUM), FUN(NUM, PRD(INT,NUM)))));; + +(*---------------------------------------------------------------------------*) +(* + Defining Variable extraction functions +*) +(*---------------------------------------------------------------------------*) + +let t = mk_vartype"'t";; +let v = mk_var("v", VAR t);; + +new_type_abbrev("stype", + `:'loc->'val`);; +new_type_abbrev("vtype", + `:(stype->'t)#((stype->'t)->stype->stype->stype)`);; +new_type_abbrev("vindex_type", + `:(stype->'i->'t)#((stype->'i->'t)->stype->stype->stype)`);; +new_type_abbrev("vpair_type", + `:(stype->'a#'b)#((stype->'a#'b)->stype->stype->stype)`);; +new_type_abbrev("seq_type", + `:'loc->(num->'val)->('val->num)->num->(stype->stype)list#num`);; + + +(* + * Extraction expression of a variable + *) +let VAR_EXP = new_definition (`VAR_EXP (v:vtype) = FST v`);; + +(* + * Extraction assignment of a variable + *) +let VAR_ASG = new_definition (`VAR_ASG (v:vtype) = SND v`);; + +(*---------------------------------------------------------------------------*) +(* + Location to variable translator functions +*) +(*---------------------------------------------------------------------------*) + +let loc = mk_var("loc",LOC);; +let s = mk_var("s", STA);; +let s0 = mk_var("s0", STA);; +let ds = mk_var("ds", FUN(VAL,t));; +let mk = mk_var("mk", FUN(t,VAL));; +let e = mk_var("e", XPR t);; + +(* + * Translate a location to an expression + *) +let LOC_EXP = new_definition + (`LOC_EXP loc (ds:'val->'t) (s:stype) = ds (s loc)`);; + +(* + * Translate a location to an assignment + *) +let LOC_ASG = new_definition + (`LOC_ASG loc (mk:'t->'val) (e:stype->'t) + (s0:stype) (s:stype) l = + (if (l = loc) then (mk (e s0)) else (s l))`);; + +(* + * Translate a location to a variable pair + *) +let LOC_VAR = new_definition + (`LOC_VAR (loc:'loc) (mk:'t->'val) (ds:'val->'t) = + (LOC_EXP loc ds, LOC_ASG loc mk)`);; + +(*---------------------------------------------------------------------------*) +(* + Array (index) functions +*) +(*---------------------------------------------------------------------------*) + +(* + * Generate index expression + * + * IndexExp [(i,v),...] a + *) +let INDEX_EXP = new_definition + (`(INDEX_EXP (a:stype->('i->'t)) (i:stype->'i) (s:stype) = + (a s) (i s))`);; + +(* + * Generate updated index expression (index, exp and array are frozen) + * + * UpdIndex [(i,v),...] a + *) +let UPD_INDEX = new_definition + (`(UPD_INDEX (i:'i) (c:'t) (a:'i->'t) j = (if (j = i) then c else (a j)))`);; + +(* + * Generate updated index expression (index and exp are frozen) + * + * UPD_INDEX_XPR [(i,v),...] a + *) +let UPD_INDEX_EXP = new_definition + (`(UPD_INDEX_EXP (i:'i) (c:'t) (a:stype->'i->'t) (s:stype) = + UPD_INDEX i c (a s))`);; + +(* + * Assignment part from Index of a variable + *) +let VAR_INDEX_ASG = new_definition + (`VAR_INDEX_ASG + (i:stype->'i) (v:vindex_type) + (e:stype->'t) (s0:stype) (s:stype) = + VAR_ASG v (UPD_INDEX_EXP (i s0) (e s0) (VAR_EXP v)) s0 s`);; + +(* + * Expression part from Index of a variable + *) +let VAR_INDEX_EXP = new_definition + (`VAR_INDEX_EXP + (i:stype->'i) (v:vindex_type) (s:stype) = + (VAR_EXP v s) (i s)`);; + +(* + * Index variable + *) +let VAR_INDEXVAR = new_definition + (`VAR_INDEXVAR (i:stype->'i) (v:vindex_type) = + (VAR_INDEX_EXP i v, VAR_INDEX_ASG i v)`);; + +(*---------------------------------------------------------------------------*) +(* + List functions (not complete) +*) +(*---------------------------------------------------------------------------*) + +(* + * List of expressions + *) +let LIST_EXP_term = + (`(LIST_EXP [] (s:stype) = []) /\ + (LIST_EXP (CONS (e:stype->'t) t) s = (CONS (e s) (LIST_EXP t s)))`);; +let LIST_EXP = new_recursive_definition list_RECURSION LIST_EXP_term;; + +(*---------------------------------------------------------------------------*) +(* + Record (pair,fst,snd) functions +*) +(*---------------------------------------------------------------------------*) + +(* + * State abstracted FST and SND + *) +let s_FST = new_definition + (`s_FST (e:'sta->('a # 'b)) s = FST (e s)`);; + +let s_SND = new_definition + (`s_SND (e:'sta->('a # 'b)) s = SND (e s)`);; + +(* + * Update PAIR + *) +let UPD_FST = new_definition + (`UPD_FST (c:'a) (p:'sta->('a#'b)) s = (c, SND(p s))`);; + +let UPD_SND = new_definition + (`UPD_SND (c:'b) (p:'sta->('a#'b)) s = (FST(p s),c)`);; + +(* + * Assignment to FST and SND + *) +let VAR_FST_ASG = new_definition + (`VAR_FST_ASG (v:vpair_type) (e:stype->'a) (s0:stype) (s:stype) = + VAR_ASG v (UPD_FST (e s0) (VAR_EXP v)) s0 s`);; + +let VAR_SND_ASG = new_definition + (`VAR_SND_ASG (v:vpair_type) (e:stype->'b) (s0:stype) (s:stype) = + VAR_ASG v (UPD_SND (e s0) (VAR_EXP v)) s0 s`);; + +(* + * Variables of FST and SND + *) +let FST_VAR = new_definition + (`FST_VAR (v:vpair_type) = (s_FST (VAR_EXP v), VAR_FST_ASG v)`);; + +let SND_VAR = new_definition + (`SND_VAR (v:vpair_type) = (s_SND (VAR_EXP v), VAR_SND_ASG v)`);; + +(*---------------------------------------------------------------------------*) +(* + Parallel actions +*) +(*---------------------------------------------------------------------------*) + +(* + * Execute two parallel actions simultaneously + *) +let PAR_PAR = new_definition + (`(PAR_PAR (p1:stype->stype->stype) + (p2:stype->stype->stype) + (s0:stype) (s:stype) = + p2 s0 (p1 s0 s))`);; + +(* + * Execute a list of parallel actions + *) +let LIST_PAR_term = + (`(LIST_PAR [] (s0:stype) (s:stype) = s) /\ + (LIST_PAR (CONS (h:stype->stype->stype) t) s0 s = LIST_PAR t s0 (h s0 s))`);; +let LIST_PAR = new_recursive_definition list_RECURSION LIST_PAR_term;; + +(* + * Translate a parallel action into an atomic action + *) +let PAR_ATOM = new_definition + (`PAR_ATOM (p:stype->stype->stype) (s:stype) = p s s`);; + +(* + * Guard a parallel action + *) +let WHEN_PAR = new_definition + (`WHEN_PAR (p:stype->stype->stype) g + (s0:stype) (s:stype) = + (if (g s0) then (p s0 s) else s)`);; + +(* + * Conditional parallel action + *) +let IF_PAR = new_definition + (`IF_PAR (p1:stype->stype->stype) + (p2:stype->stype->stype) g + (s0:stype) (s:stype) = + (if (g s0) then (p1 s0 s) else (p2 s0 s))`);; + +(* + * Identity parallel action + *) +let ID_PAR = new_definition (`ID_PAR (s0:stype) (s:stype) = s`);; + +(* + * Iterated parallel assignment + *) +let ITER_PAR0_term = + (`(ITER_PAR0 (low:num) 0 (f:num->bool) + (fi:num->stype->stype->stype) = ID_PAR) /\ + (ITER_PAR0 low (SUC n) f fi = + (if (f low) then PAR_PAR (fi low) (ITER_PAR0 (SUC low) n f fi) + else (ITER_PAR0 (SUC low) n f fi)))`);; +let ITER_PAR0 = new_recursive_definition num_RECURSION ITER_PAR0_term;; + +let ITER_PAR = new_definition + (`ITER_PAR low high (f:num->bool) + (fi:num->stype->stype->stype) = + (ITER_PAR0 low ((1+high)-low) f fi)`);; + +(*---------------------------------------------------------------------------*) +(* + Atomic actions +*) +(*---------------------------------------------------------------------------*) + +(* + * Translate a parallel action into an atomic action + *) + +(* + K and S are removed from HOL Light. + I and o are defined in trivia.ml + + So I introduce K myself +*) +let K_DEF = new_definition (`K x y = x`);; + +let ASG_ACT = new_definition + (`ASG_ACT (par:stype->stype->stype) + (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + PAR_ATOM + (WHEN_PAR (LIST_PAR [par; LOC_ASG pc mk (K (SUC l0))]) + (LOC_EXP pc ds =* (K l0)))`);; + +(* + * Test atomic action + *) +let TST_ACT = new_definition + (`TST_ACT (g:stype->bool) + (l:num) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + (PAR_ATOM (WHEN_PAR (LOC_ASG pc mk ((g =>* K(SUC l0)) (K l))) + (LOC_EXP pc ds =* K l0)))`);; + +(* + * Goto atomic action + *) +let GTO_ACT = new_definition + (`GTO_ACT (l:num) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + PAR_ATOM (WHEN_PAR (LOC_ASG pc mk (K l)) + (LOC_EXP pc ds =* K l0))`);; + +(*---------------------------------------------------------------------------*) +(* + Sequential actions +*) +(*---------------------------------------------------------------------------*) + +(* + * Translate parallel to sequential action + *) +let PAR_SEQ = new_definition + (`PAR_SEQ (par:stype->stype->stype) + (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + ([ASG_ACT par pc mk ds l0], SUC l0)`);; + +(* + * Identity sequential action + *) +let ID_SEQ = new_definition + (`ID_SEQ (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + ([], l0)`);; + +(* + * Execute two sequential actions in a row + *) +let SEQ_SEQ = new_definition + (`SEQ_SEQ (s1:seq_type) (s2:seq_type) + (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + let b1 = s1 pc mk ds l0 in + let b2 = s2 pc mk ds (SND b1) in + (APPEND (FST b1) (FST b2), (SND b2))`);; + +(* + * Iterated sequential actions + *) +let ITER_SEQ0_term = + (`(ITER_SEQ0 (low:num) 0 (f:num->bool) (fi:num->seq_type) = ID_SEQ) /\ + (ITER_SEQ0 low (SUC n) f fi = + (if (f low) then (SEQ_SEQ (fi low) (ITER_SEQ0 (SUC low) n f fi)) + else (ITER_SEQ0 (SUC low) n f fi)))`);; +let ITER_SEQ0 = new_recursive_definition num_RECURSION ITER_SEQ0_term;; + +let ITER_SEQ = new_definition + (`ITER_SEQ low high (f:num->bool) (fi:num->seq_type) = + ITER_SEQ0 low ((1+high)-low) f fi`);; + +(* + * List of sequential actions + *) +let LIST_SEQ_term = + (`(LIST_SEQ [] (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = ([], l0)) /\ + (LIST_SEQ (CONS (sa:seq_type) sas) pc mk ds l0 = + let b1 = sa pc mk ds l0 in + let bs = LIST_SEQ sas pc mk ds (SND b1) in + (APPEND (FST b1) (FST bs), (SND bs)))`);; +let LIST_SEQ = new_recursive_definition list_RECURSION LIST_SEQ_term;; + +(* + * Conditional sequential actions + *) +let IF1_SEQ = new_definition + (`(IF1_SEQ (g:stype->bool) + (sa:seq_type) (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + let b1 = sa pc mk ds (SUC l0) in + let a1 = TST_ACT g (SND b1) pc mk ds l0 in + (CONS a1 (FST b1), (SND b1)))`);; + +(* + * Conditional (else) sequential actions + *) +let IF2_SEQ = new_definition + (`(IF2_SEQ (g:stype->bool) (sa1:seq_type) (sa2:seq_type) + (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + let b1 = sa1 pc mk ds (SUC l0) in + let b2 = sa2 pc mk ds (SUC (SND b1)) in + let a1 = TST_ACT g (SUC (SND b1)) pc mk ds l0 in + let a2 = GTO_ACT (SND b2) pc mk ds (SND b1) in + (APPEND (CONS a1 (FST b1)) + (CONS a2 (FST b2)), (SND b2)))`);; + +(* + * While loop sequential actions + *) +let WHL_SEQ = new_definition + (`(WHL_SEQ (g:stype->bool) (sa:seq_type) + (pc:'loc) (mk:num->'val) (ds:'val->num) (l0:num) = + let b1 = sa pc mk ds (SUC l0) in + let a1 = TST_ACT g (SUC (SND b1)) pc mk ds l0 in + let a2 = GTO_ACT l0 pc mk ds (SND b1) in + (APPEND (CONS a1 (FST b1)) [a2], (SUC(SND b1))))`);; + +(*---------------------------------------------------------------------------*) +(* + Interleaved actions +*) +(*---------------------------------------------------------------------------*) + +(* + * Translate a parallel action into an interleaved action + *) +let PAR_INT = new_definition + (`PAR_INT (par:stype->stype->stype) = [PAR_ATOM par]`);; + +(* + * Composition of two interleaved actions + *) +let INT_INT = new_definition + (`INT_INT (i1:(stype->stype)list) i2 = APPEND i1 i2`);; + +(* + * Translate a list of interleaved action into a single interleaved action + *) +let LIST_INT_term = + (`(LIST_INT [] = ([]:(stype->stype)list)) /\ + (LIST_INT (CONS (h:(stype->stype)list) t) = + (APPEND h (LIST_INT t)))`);; +let LIST_INT = new_recursive_definition list_RECURSION LIST_INT_term;; + +(* + * Translate a parallel action into an interleaved action + *) +let ID_INT = new_definition + (`ID_INT = ([]:(stype->stype)list)`);; + + +(*######################################################################## + # # + # Iterated interleaving # + # # + # << i : 1 <= i <= N :: Pr[i] >> # + # # + # is defined as: # + # # + # IteratedINTerleaving low n Pr[.] --> # + # Pr[low] [] ... [] Pr[low+n-1] # + # # + ########################################################################*) + +(* + * Iterated interleaved assignment + *) +let ITER_INT0_term = + (`(ITER_INT0 (low:num) 0 (f:num->bool) (fi:num->(stype->stype)list) = ID_INT) /\ + (ITER_INT0 low (SUC n) f fi = + (if (f low) then (INT_INT (fi low) (ITER_INT0 (SUC low) n f fi)) + else (ITER_INT0 (SUC low) n f fi)))`);; +let ITER_INT0 = new_recursive_definition num_RECURSION ITER_INT0_term;; + +let ITER_INT = new_definition + (`ITER_INT low high (f:num->bool) (fi:num->(stype->stype)list) = + ITER_INT0 low ((1+high)-low) f fi`);; + +(*####################################################################### + # # + # Absolute and relative Label predicates # + # # + # AT,AFTER : At first, first following action # + # IN : Inside action # + # BEFORE,FOLLOW : Strictly before,following action # + # # + ########################################################################*) + +let AT_LBL = new_definition + (`AT_LBL ds pc (label:num#num) = + (LOC_EXP pc ds:stype->num) =* K (FST label)`);; + +let AFTER_LBL = new_definition + (`AFTER_LBL ds pc (label:num#num) = + (LOC_EXP pc ds:stype->num) =* K (SND label)`);; + +let BEFORE_LBL = new_definition + (`BEFORE_LBL ds pc (label:num#num) = + (LOC_EXP pc ds:stype->num) <* K (FST label)`);; + +let INSIDE_LBL = new_definition + (`INSIDE_LBL ds pc (label:num#num) = + ((LOC_EXP pc ds:stype->num) >=* K (FST label)) /\* + ((LOC_EXP pc ds:stype->num) <* K (SND label))`);; + +let FOLLOW_LBL = new_definition + (`FOLLOW_LBL ds pc (label:num#num) = + (LOC_EXP pc ds:stype->num) >=* K (SND label)`);; + +(* Absolute label handler *) +let AT_ABS = new_definition + (`AT_ABS (pc:stype->num) (l:num) (u:num) = (pc =* K l)`);; + +let AT_REL = new_definition + (`AT_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) + (label:(num#num)) = + VAR_EXP pc =* K (FST label)`);; + +let AFTER_ABS = new_definition + (`AFTER_ABS (pc:stype->num) (l:num) (u:num) = (pc =* K u)`);; + +let AFTER_REL = new_definition + (`AFTER_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) + (label:(num#num)) = + VAR_EXP pc =* K (SND label)`);; + +let BEFORE_ABS = new_definition + (`BeforeAbs (pc:stype->num) (l:num) (u:num) = (pc <* K l)`);; + +let BEFORE_REL = new_definition + (`BEFORE_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) + (label:(num#num)) = + VAR_EXP pc <* K (FST label)`);; + +let INSIDE_ABS = new_definition + (`INSIDE_ABS (pc:stype->num) (l:num) (u:num) = + (pc >=* K l) /\* (pc <* K u)`);; + +let INSIDE_REL = new_definition + (`INSIDE_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) + (label:(num#num)) = + (VAR_EXP pc >=* K (FST label)) /\* + (VAR_EXP pc <* K (SND label))`);; + +let FOLLOW_ABS = new_definition + (`FollowAbs (pc:stype->num) (l:num) (u:num) = (pc >=* K l)`);; + +let FOLLOW_REL = new_definition + (`FOLLOW_REL (pc:(stype->num)#((stype->num)->stype->stype->stype)) + (label:(num#num)) = + VAR_EXP pc >=* K (SND label)`);; + +(*######################################################################## + # # + # Restricted UNLESS # + # # + # (p UNLESS{valid} q) Pr # + # # + # is defined as: # + # # + # RESTRICTED_UNLESS valid p q Pr = # + # {p /\ valid /\ ~q)} Pr {p \/ q} # + # # + ########################################################################*) + +let RESTRICTED_UNLESS_STMT = new_definition + (`RESTRICTED_UNLESS_STMT v p q st = + (!s:'state. p s /\ v s /\ ~(q s) ==> p (st s) \/ q (st s))`);; + +let RESTRICTED_UNLESS_term = + (`(RESTRICTED_UNLESS (v:'state->bool) p q [] = T) /\ + (RESTRICTED_UNLESS (v:'state->bool) p q (CONS st Pr) = + (RESTRICTED_UNLESS_STMT v p q st /\ RESTRICTED_UNLESS v p q Pr))`);; +let RESTRICTED_UNLESS = + new_recursive_definition list_RECURSION RESTRICTED_UNLESS_term;; + +(*####################################################################### + # # + # RESTRICTED STABLE # + # # + # (p STABLE{valid} q) Pr # + # # + # is defined as: # + # # + # RESTRICTED_STABLE valid p q Pr = # + # {p /\ valid} Pr {p} # + # # + ########################################################################*) +let RESTRICTED_STABLE_STMT = new_definition + (`RESTRICTED_STABLE_STMT v p st = + (!s:'state. p s /\ v s ==> p (st s))`);; + +let RESTRICTED_STABLE_term = + (`(RESTRICTED_STABLE (v:'state->bool) p [] = T) /\ + (RESTRICTED_STABLE (v:'state->bool) p (CONS st Pr) = + (RESTRICTED_STABLE_STMT v p st /\ RESTRICTED_STABLE v p Pr))`);; +let RESTRICTED_STABLE = + new_recursive_definition list_RECURSION RESTRICTED_STABLE_term;; + +(*######################################################################## + # # + # RESTRICTED EXISTS_TRANSITION # + # # + # (p EXISTS_TRANSITION{valid} q) Pr # + # # + # is defined as: # + # # + # RESTRICTED_EXISTS_TRANSITION valid p q Pr = # + # ?st In Pr. {p /\ valid /\ ~q} Pr {q} # + # # + ########################################################################*) +let RESTRICTED_EXISTS_TRANSITION_STMT = new_definition + (`RESTRICTED_EXISTS_TRANSITION_STMT v p q st = + (!s:'state. p s /\ v s /\ ~(q s) ==> q (st s))`);; + +let RESTRICTED_EXISTS_TRANSITION_term = + (`(RESTRICTED_EXISTS_TRANSITION (v:'state->bool) p q [] = F) /\ + (RESTRICTED_EXISTS_TRANSITION (v:'state->bool) p q (CONS st Pr) = + (RESTRICTED_EXISTS_TRANSITION_STMT v p q st \/ + RESTRICTED_EXISTS_TRANSITION v p q Pr))`);; +let RESTRICTED_EXISTS_TRANSITION = + new_recursive_definition list_RECURSION RESTRICTED_EXISTS_TRANSITION_term;; + +(*######################################################################## + # # + # RESTRICTED ENSURES # + # # + # (p ENSURES{valid} q) Pr # + # # + # is defined as: # + # # + # RESTRICTED_ENSURES valid p q Pr = # + # RESTRICTED_UNLESS valid p q Pr /\ # + # RESTRICTED_EXISTS_TRANSITION valid p q Pr # + # # + ########################################################################*) +let RESTRICTED_ENSURES = new_definition + (`RESTRICTED_ENSURES (v:'state->bool) p q Pr = + (RESTRICTED_UNLESS v p q Pr /\ + RESTRICTED_EXISTS_TRANSITION v p q Pr)`);; + +(*######################################################################## + # # + # RESTRICTED LEADSTO # + # # + # (p LEADSTO{valid} q) Pr # + # # + # is defined as: # + # # + # RESTRICTED_LEADSTO valid p q Pr = # + # (p /\ valid p) LEADSTO q Pr /\ # + # # + ########################################################################*) +let RESTRICTED_LEADSTO = new_definition + (`RESTRICTED_LEADSTO (v:'state->bool) p q Pr = + (((p /\* v) LEADSTO q) Pr)`);; + +(*######################################################################## + # # + # Valid # + # # + # Valid p # + # # + # is defined as: # + # # + # Valid p = # + # !s. p s # + # # + ########################################################################*) +let VALID = new_definition + (`VALID (p:'state->bool) = !s. p s`);; + +let TRIPLE_term = + (`(TRIPLE (p:'state->bool) q [] = T) /\ + (TRIPLE p q (CONS (st:'state->'state) Pr) = + ((!s. p s ==> q(st s)) /\ TRIPLE p q Pr))`);; +let RESTRICTED_TRIPLE = + new_recursive_definition list_RECURSION TRIPLE_term;; + +(*######################################################################## + # # + # SUMMA lwb len filter body = # + # Body(lwb) + ... Body(i) ... + Body(lwb+len-1) , when filter(i)# + # # + # SUMMA lwb 0 f b = 0 # + # SUMMA lwb (SUC n) f b = (f lwb => b lwb | 0) + SUMMA lwb n f b # + # # + ########################################################################*) +let SUMMA0_term = + (`(SUMMA0 lwb 0 f b = 0) /\ + (SUMMA0 lwb (SUC n) f b = + ((if (f lwb) then (b lwb) else 0) + (SUMMA0 (SUC lwb) n f b)))`);; +let SUMMA0 = new_recursive_definition num_RECURSION SUMMA0_term;; + +let SUMMA = new_definition + (`SUMMA lwb upb f b = SUMMA0 lwb ((1 + upb)-lwb) f b`);; + +let SUMMA_S = new_definition + (`SUMMA_S lwb upb f b (s:'state) = + SUMMA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; + +(*######################################################################## + # # + # MULTA lwb len filter body = # + # Body(lwb) * ... Body(i) ... * Body(lwb+len-1) , when filter(i)# + # # + # MULTA lwb 0 f b = 1 # + # MULTA lwb (SUC n) f b = (f lwb => b lwb | 1) * MULTA lwb n f b # + # # + ########################################################################*) +let MULTA0_term = + (`(MULTA0 lwb 0 f b = 1) /\ + (MULTA0 lwb (SUC n) f b = + ((if (f lwb) then (b lwb) else 1) * (MULTA0 (SUC lwb) n f b)))`);; +let MULTA0 = new_recursive_definition num_RECURSION MULTA0_term;; + +let MULTA = new_definition + (`MULTA lwb upb f b = MULTA0 lwb ((1 + upb)-lwb) f b`);; + +let MULTA_S = new_definition + (`MULTA_S lwb upb f b (s:'state) = + MULTA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; + +(*######################################################################## + # # + # CONJA lwb len filter body = # + # Body(lwb) & ... Body(i) ... & Body(lwb+len-1) , when filter(i)# + # # + # CONJA lwb 0 f b = T # + # CONJA lwb (SUC n) f b = (f lwb => b lwb | 1) & CONJA lwb n f b # + # # + ########################################################################*) +let CONJA0_term = + (`(CONJA0 lwb 0 f b = T) /\ + (CONJA0 lwb (SUC n) f b = + ((if (f lwb) then (b lwb) else T) /\ (CONJA0 (SUC lwb) n f b)))`);; +let CONJA0 = new_recursive_definition num_RECURSION CONJA0_term;; + +let CONJA = new_definition + (`CONJA lwb upb f b = CONJA0 lwb ((1 + upb)-lwb) f b`);; + +let CONJA_S = new_definition + (`CONJA_S lwb upb f b (s:'state) = + CONJA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; + +(*######################################################################## + # # + # DISJA lwb len filter body = # + # Body(lwb) | ... Body(i) ... | Body(lwb+len-1) , when filter(i)# + # # + # DISJA lwb 0 f b = F # + # DISJA lwb (SUC n) f b = (f lwb => b lwb | 1) | DISJA lwb n f b # + # # + ########################################################################*) +let DISJA0_term = + (`(DISJA0 lwb 0 f b = F) /\ + (DISJA0 lwb (SUC n) f b = + ((if (f lwb) then (b lwb) else F) \/ (DISJA0 (SUC lwb) n f b)))`);; +let DISJA0 = new_recursive_definition num_RECURSION DISJA0_term;; + +let DISJA = new_definition + (`DISJA lwb upb f b = DISJA0 lwb ((1 + upb)-lwb) f b`);; + +let DISJA_S = new_definition + (`DISJA_S lwb upb f b (s:'state) = + DISJA (lwb s) (upb s) (\i. f i s) (\i. b i s)`);; + +(*---------------------------------------------------------------------------*) +(* + Miscellaneous +*) +(*---------------------------------------------------------------------------*) +(* + * Test for list membership + *) +let MEMBER_term = + (`(MEMBER (x:'a) [] = F) /\ + (MEMBER x (CONS h t) = ((x=h) \/ (MEMBER x t)))`);; +let MEMBER = new_recursive_definition list_RECURSION MEMBER_term;; + +(* + * Test for unique elements in list + *) +let UNIQUE_term = + (`(UNIQUE [] = T) /\ + (UNIQUE (CONS (h:'a) t) = ((~(MEMBER h t)) /\ UNIQUE t))`);; +let UNIQUE = new_recursive_definition list_RECURSION UNIQUE_term;; diff --git a/Unity/mk_unless.ml b/Unity/mk_unless.ml new file mode 100644 index 0000000..c14e4e4 --- /dev/null +++ b/Unity/mk_unless.ml @@ -0,0 +1,1060 @@ +(*-------------------------------------------------------------------------*) +(* + File: mk_unless.ml + Description: + + This file defines the theorems for the UNLESS definition. + + Author: (c) Copyright 1989-2008 by Flemming Andersen + Date: June 29, 1989 + Last Update: December 30, 2007 +*) +(*-------------------------------------------------------------------------*) + + +(*-------------------------------------------------------------------------*) +(* The definition of UNLESS is based on the definition: + + p UNLESS q in Pr = + + where p and q are state dependent first order logic predicates or all + s in the program Pr are conditionally enabled statements transforming + a state into a new state. + + To define UNLESS as a relation UNLESS_STMT to be satisfied for a finite + number of program statements, we define the UNLESS_STMT to be fulfilled as + a separate HOARE tripple relation between pre- or post predicates to be + satisfied for state transitions. The pre- or post predicates of the + UNLESS_STMT relation must be satisfiable for all states possible in the + finite state space of the program. +*) + +let TL_FIX = 100;; + +let UNLESS_STMT = new_infix_definition + ("UNLESS_STMT", "<=>", + `UNLESS_STMT (p:'a->bool) q st = + \s:'a. (p s /\ ~q s) ==> (p (st s) \/ q (st s))`, TL_FIX);; + +(* + Since a program is defined as a set (list) of statements, we + recursively define the UNLESS relation itself using the UNLESS_STMT + relation to be satisfied for every statement in the program. + + As the bottom of the recursion we choose the empty program always to be + satisfied. For every statement in the program the UNLESS_STMT relation + must be satisfied in all possible states. +*) + +let UNLESS_term = + (`(!p q. UNLESS p q [] <=> T) /\ + (!p q. UNLESS p q (CONS (st:'a->'a) Pr) <=> + ((!s:'a. (p UNLESS_STMT q) st s) /\ (UNLESS p q Pr)))`);; +let UNLESS = new_recursive_definition list_RECURSION UNLESS_term;; +parse_as_infix ( "UNLESS", (TL_FIX, "right") );; + +let STABLE_STMT = new_infix_definition + ("STABLE_STMT", "<=>", + `STABLE_STMT (p:'a->bool) st = \s:'a. p s ==> p (st s)`, TL_FIX);; + +(* +* The state predicate STABLE is a special case of UNLESS. +* +* stable p in Pr = p unless false in Pr +*) +let STABLE = new_infix_definition + ("STABLE", "<=>", `STABLE (p:'a->bool) Pr = (p UNLESS False) Pr`, TL_FIX);; + +(* +* The state predicate INVARIANT is a special case of UNLESS too. +* However invariant is dependent of a program /\* its initial state. +* +* invariant P in (initial condition, Pr) = +* (initial condition ==> p) /\ (p stable in Pr) +*) +let INVARIANT = new_infix_definition + ("INVARIANT", "<=>", + `INVARIANT p (p0, Pr) = ((!s:'a. p0 s ==> p s) /\ (p STABLE Pr))`, TL_FIX);; + +(************************************************************************ +* * +* Lemmas used in the UNLESS Theory * +* * +************************************************************************) + +let s = `s:'a`;; +let p = `p:'a->bool`;; +let q = `q:'a->bool`;; +let r = `r:'a->bool`;; +let P = `P:num->'a->bool`;; + +let IMP_IMP_CONJIMP_lemma = TAC_PROOF + (([], + (`!p q ps qs p' q' p's q's. + (p /\ ~q ==> ps \/ qs) ==> (p' /\ ~q' ==> p's \/ q's) ==> + (p /\ p' /\ (~p \/ ~q') /\ (~p' \/ ~q) /\ (~q \/ ~q') ==> + ps /\ p's \/ ps /\ q's \/ p's /\ qs \/ qs /\ q's)`)), + REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; + +let NOT_NOT_OR_lemma = TAC_PROOF + (([], + (`!t1 t2 t3. t1 \/ t2 \/ t3 <=> ~(~t1 /\ ~t2) \/ t3`)), + REWRITE_TAC [NOT_CLAUSES; DE_MORGAN_THM; (SYM (SPEC_ALL DISJ_ASSOC))]);; + +let CONJ_IMPLY_THM = TAC_PROOF + (([], + (`!p p' q q'. + ((p \/ p') /\ (p \/ ~q') /\ (p' \/ ~q) /\ (~q \/ ~q')) = + ((p /\ ~q) \/ (p' /\ ~q'))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN REPEAT (ASM_REWRITE_TAC []));; + +(************************************************************************ +* * +* Theorems about UNLESS_STMT * +* * +************************************************************************) + +(* + * The reflexivity theorem: + * + * p unless_stmt P in Prog + *) +let UNLESS_STMT_thm0 = prove_thm + ("UNLESS_STMT_thm0", + `!p st (s:'a). (p UNLESS_STMT p)st s`, + REPEAT STRIP_TAC THEN + REWRITE_TAC [UNLESS_STMT] THEN + REWRITE_TAC [BETA_CONV (`(\s:'a. p s /\ ~(p s) ==> p (st s))s`)] THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* + * Theorem: + * p unless_stmt Q in stmt, q ==> r + * ------------------------------ + * p unless_stmt r in stmt + *) + +let UNLESS_STMT_thm1 = prove_thm + ("UNLESS_STMT_thm1", + `!(p:'a->bool) q r st. + ((!s. (p UNLESS_STMT q) st s) /\ (!s. (q s) ==> (r s))) ==> + (!s. (p UNLESS_STMT r) st s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [UNLESS_STMT] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (REWRITE_RULE [ASSUME `~r (s:'a)`] + ( CONTRAPOS (SPEC `s:'a` (ASSUME `!s:'a. q s ==> r s`)))) THEN + STRIP_ASSUME_TAC (REWRITE_RULE [ASSUME `(p:'a->bool) s`; ASSUME `~q (s:'a)`] + (SPEC `s:'a` (ASSUME `!s:'a. p s /\ ~q s ==> p (st s) \/ q (st s)`))) THEN + ASM_REWRITE_TAC [] THEN + STRIP_ASSUME_TAC (REWRITE_RULE [ASSUME `(q:'a->bool) ((st:'a->'a) s)`] + (SPEC `(st:'a->'a) s` (ASSUME `!s:'a. q s ==> r s`))) THEN + ASM_REWRITE_TAC []);; + +(* + Theorem: + p unless_stmt Q in st, p' unless_stmt q' in st + ------------------------------------------------ + p\/p' unless_stmt q\/q' in st +*) +let UNLESS_STMT_thm2 = prove_thm + ("UNLESS_STMT_thm2", + `!p q p' q' (st:'a->'a). + ((!s. (p UNLESS_STMT q) st s) /\ (!s. (p' UNLESS_STMT q') st s)) ==> + (!s. ((p \/* p') UNLESS_STMT (q \/* q')) st s)`, + REWRITE_TAC [UNLESS_STMT;OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); + (SYM (SPEC_ALL DISJ_ASSOC)); NOT_CLAUSES; DE_MORGAN_THM] THEN + (REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []));; + +(* + Conjunction Theorem: + p unless_stmt Q in stmt, p' unless_stmt q' in stmt + ------------------------------------------------------------------ + (p /\ p') unless_stmt (p /\ q') \/ (p' /\ q) \/ (q /\ q') in stmt +*) +let UNLESS_STMT_thm3 = prove_thm + ("UNLESS_STMT_thm3", + `!p q p' q' (st:'a->'a). + ((!s. (p UNLESS_STMT q) st s) /\ (!s. (p' UNLESS_STMT q') st s)) ==> + (!s. ((p /\* p') UNLESS_STMT + (((p /\* q') \/* (p' /\* q)) \/* (q /\* q'))) st s)`, + PURE_REWRITE_TAC [UNLESS_STMT;AND_def;OR_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL CONJ_ASSOC)); + (SYM (SPEC_ALL DISJ_ASSOC)); NOT_CLAUSES; DE_MORGAN_THM] THEN + STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + DISCH_TAC THEN STRIP_TAC THEN DISCH_TAC THEN + ASSUME_TAC (CONJUNCT1 (ASSUME + (`(!s. p s /\ ~q s ==> p ((st:'a->'a) s) \/ q (st s)) /\ + (!s. p' s /\ ~q' s ==> p'((st:'a->'a) s) \/ q'(st s))`))) THEN + ASSUME_TAC (CONJUNCT2 (ASSUME + (`(!s. p s /\ ~q s ==> p ((st:'a->'a) s) \/ q (st s)) /\ + (!s. p' s /\ ~q' s ==> p'((st:'a->'a) s) \/ q'(st s))`))) THEN + STRIP_ASSUME_TAC (SPEC_ALL (ASSUME + (`(!s. p s /\ ~q s ==> p ((st:'a->'a) s) \/ q (st s))`))) THEN + STRIP_ASSUME_TAC (SPEC_ALL (ASSUME + (`(!s. p' s /\ ~q' s ==> p'((st:'a->'a) s) \/ q'(st s))`))) THEN + ASSUME_TAC (UNDISCH_ALL + (SPEC (`(q':'a->bool) ((st:'a->'a) s)`) + (SPEC (`(p':'a->bool) ((st:'a->'a) s)`) + (SPEC (`(q':'a->bool) s`) + (SPEC (`(p':'a->bool) s`) + (SPEC (`(q:'a->bool) ((st:'a->'a) s)`) + (SPEC (`(p:'a->bool) ((st:'a->'a) s)`) + (SPEC (`(q:'a->bool) s`) + (SPEC (`(p:'a->bool) s`) + IMP_IMP_CONJIMP_lemma))))))))) THEN + ASM_REWRITE_TAC []);; + +(* + Disjunction Theorem: + p unless_stmt Q in stmt, p' unless_stmt q' in stmt + ------------------------------------------------------------------ + (p \/ p') unless_stmt (~p /\ q') \/ (~p' /\ q) \/ (q /\ q') in stmt +*) +let UNLESS_STMT_thm4 = prove_thm + ("UNLESS_STMT_thm4", + `!p q p' q' (st:'a->'a). + ((!s. (p UNLESS_STMT q) st s) /\ (!s. (p' UNLESS_STMT q') st s)) ==> + (!s. ((p \/* p') UNLESS_STMT + ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))) + st s)`, + REPEAT GEN_TAC THEN + PURE_REWRITE_TAC [UNLESS_STMT;AND_def;OR_def;NOT_def1] THEN + MESON_TAC []);; + +let UNLESS_STMT_thm5_lemma1 = TAC_PROOF + (([], + `!p q r. (p ==> q) ==> (p \/ r ==> q \/ r)`), + REPEAT STRIP_TAC THENL + [RES_TAC THEN ASM_REWRITE_TAC [] + ;ASM_REWRITE_TAC []]);; + +let UNLESS_STMT_thm5_lemma2 = TAC_PROOF + (([], + `!(P:num->('a->bool)) q s. ((?n. P n s) \/ q s) = (?n. P n s \/ q s)`), + REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ EXISTS_TAC (`n:num`) THEN + ASM_REWRITE_TAC [] + ; EXISTS_TAC (`n:num`) THEN + ASM_REWRITE_TAC [] + ; DISJ1_TAC THEN + EXISTS_TAC (`n:num`) THEN + ASM_REWRITE_TAC [] + ; DISJ2_TAC THEN + ASM_REWRITE_TAC [] + ]);; + +let UNLESS_STMT_thm5 = prove_thm + ("UNLESS_STMT_thm5", + `!(P:num->('a->bool)) q st. + (!m. (!s. ((P m) UNLESS_STMT q)st s)) ==> + (!s. ((\s. ?n. P n s) UNLESS_STMT q)st s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [UNLESS_STMT] THEN + BETA_TAC THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC [UNLESS_STMT_thm5_lemma2] THEN + EXISTS_TAC (`n:num`) THEN + RES_TAC THEN + ASM_REWRITE_TAC []);; + +let UNLESS_STMT_thm6 = prove_thm + ("UNLESS_STMT_thm6", + `!(p:'a->bool) q r (st:'a->'a). + (!s. (p UNLESS_STMT q) st s) ==> + (!s. ((p \/* r) UNLESS_STMT (q \/* r)) st s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [UNLESS_STMT; OR_def] THEN + MESON_TAC []);; + +(* + Theorems about UNLESS +*) + +(* + The reflexivity theorem: + p unless p in Prog +*) + +let UNLESS_thm1 = prove_thm + ("UNLESS_thm1", + `!(p:'a->bool) Pr. (p UNLESS p) Pr`, + GEN_TAC THEN + LIST_INDUCT_TAC THEN + PURE_REWRITE_TAC [UNLESS] THEN + ASM_REWRITE_TAC [] THEN + PURE_REWRITE_TAC [UNLESS_STMT] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN + RES_TAC);; + +(* +* The anti reflexivity theorem: +* +* p unless ~p in Prog +*) +let UNLESS_thm2 = prove_thm + ("UNLESS_thm2", + (`!(p:'a->bool) Pr. (p UNLESS (Not p)) Pr`), + GEN_TAC THEN + LIST_INDUCT_TAC THEN + PURE_REWRITE_TAC [UNLESS] THEN + ASM_REWRITE_TAC [] THEN + PURE_REWRITE_TAC [UNLESS_STMT;NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC [EXCLUDED_MIDDLE]);; + +(* + The unless implies theorem: + p unless q in Pr, q ==> r + --------------------------- + p unless r in Pr +*) +let UNLESS_thm3 = prove_thm + ("UNLESS_thm3", + `!(p:'a->bool) q r Pr. + (((p UNLESS q) Pr) /\ (!s. (q s) ==> (r s))) ==> ((p UNLESS r) Pr)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + IMP_RES_TAC UNLESS_STMT_thm1);; + +(* + Conjunction Theorem: + p unless q in Pr, p' unless q' in Pr + ----------------------------------------------------------- + (p /\ p') unless (p /\ q') \/ (p' /\ q) \/ (q /\ q') in Pr +*) +let UNLESS_thm4 = prove_thm + ("UNLESS_thm4", + `!(p:'a->bool) q p' q' Pr. + (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> + (((p /\* p') UNLESS + (((p /\* q') \/* (p' /\* q)) \/* (q /\* q'))) Pr)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + IMP_RES_TAC UNLESS_STMT_thm3);; + +(* + Disjunction Theorem: + p unless q in Pr, p' unless q' in Pr + ------------------------------------------------------------- + (p \/ p') unless (~p /\ q') \/ (~p' /\ q) \/ (q /\ q') in Pr +*) +let UNLESS_thm5 = prove_thm + ("UNLESS_thm5", + `!(p:'a->bool) q p' q' Pr. + (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) + ==> + (((p \/* p') UNLESS + ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))) Pr)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + IMP_RES_TAC UNLESS_STMT_thm4);; + +(* + Simple Conjunction Theorem: + p unless q in Pr, p' unless q' in Pr + ------------------------------------------- + (p /\ p') unless (q \/ q') in Pr +*) +let UNLESS_thm6 = prove_thm + ("UNLESS_thm6", + `!(p:'a->bool) q p' q' Pr. + (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> + (((p /\* p') UNLESS (q \/* q')) Pr)`, + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS q)Pr`); + (`((p':'a->bool) UNLESS q')Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL UNLESS_thm4)) THEN + ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); + (`p':'a->bool`); (`q':'a->bool`)] + IMPLY_WEAK_lemma1) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((p:'a->bool) /\* p') UNLESS + (((p /\* q') \/* (p' /\* q)) \/* (q /\* q')))Pr`); + (`!s. ((((p:'a->bool) /\* q') \/* (p' /\* q)) \/* (q /\* q'))s ==> + (q \/* q')s`)] + AND_INTRO_THM)) THEN + ASM_REWRITE_TAC [UNDISCH_ALL (SPECL + [(`(p:'a->bool) /\* p'`); + (`((((p:'a->bool) /\* q') \/* (p' /\* q)) \/* (q /\* q'))`); + (`(q:'a->bool) \/* q'`); (`Pr:('a->'a)list`)] + UNLESS_thm3)]);; + +(* + Simple Disjunction Theorem: + p unless Q in Pr, p' unless q' in Pr + --------------------------------------- + (p \/ p') unless (q \/ q') in Pr +*) +let UNLESS_thm7 = prove_thm + ("UNLESS_thm7", + `!(p:'a->bool) q p' q' Pr. + (((p UNLESS q) Pr) /\ ((p' UNLESS q') Pr)) ==> + (((p \/* p') UNLESS (q \/* q')) Pr)`, + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS q)Pr`); (`((p':'a->bool) UNLESS q')Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL UNLESS_thm5)) THEN + ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`); + (`p':'a->bool`); (`q':'a->bool`)] + IMPLY_WEAK_lemma2) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((p:'a->bool) \/* p') UNLESS + ((((Not p) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q'))) + Pr`); + (`!s. ((((Not (p:'a->bool)) /\* q') \/* ((Not p') /\* q)) \/* + (q /\* q'))s ==> (q \/* q')s`)] + AND_INTRO_THM)) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL + [`(p:'a->bool) \/* p'`; + `(((Not (p:'a->bool)) /\* q') \/* ((Not p') /\* q)) \/* (q /\* q')`; + `(q:'a->bool) \/* q'`; + `Pr:('a->'a)list`] + UNLESS_thm3)));; + +(* + Cancellation Theorem: + p unless Q in Pr, q unless r in Pr + ------------------------------------ + (p \/ q) unless r in Pr +*) +let UNLESS_thm8 = prove_thm + ("UNLESS_thm8", + `!(p:'a->bool) q r Pr. + (((p UNLESS q) Pr) /\ ((q UNLESS r) Pr)) ==> + (((p \/* q) UNLESS r) Pr)`, + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [`((p:'a->bool) UNLESS q)Pr`; `((q:'a->bool) UNLESS r)Pr`] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`p:'a->bool`); (`q:'a->bool`); + (`q:'a->bool`); (`r:'a->bool`)] + UNLESS_thm5))) THEN + ASSUME_TAC (SPECL + [(`p:'a->bool`); (`q:'a->bool`); (`r:'a->bool`)] + IMPLY_WEAK_lemma3) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((p:'a->bool) \/* q) UNLESS + ((((Not p) /\* r) \/* ((Not q) /\* q)) \/* (q /\* r))) Pr`); + (`!s:'a. ((((Not p) /\* r) \/* ((Not q) /\* q)) \/* + (q /\* r))s ==> r s`)] + AND_INTRO_THM)) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`((p:'a->bool) \/* q)`); + (`((((Not (p:'a->bool)) /\* r) \/* ((Not q) /\* q)) \/* + (q /\* r))`); + (`r:'a->bool`)] + UNLESS_thm3))));; + +(* + Corollaries +*) +let UNLESS_cor1 = prove_thm + ("UNLESS_cor1", + `!(p:'a->bool) q Pr. (!s. p s ==> q s) ==> ((p UNLESS q) Pr)`, + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [`((p:'a->bool) UNLESS p)Pr`; `!s:'a. p s ==> q s`] + AND_INTRO_THM)) THEN + ASM_REWRITE_TAC [UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`p:'a->bool`); (`q:'a->bool`); + (`Pr:('a->'a)list`)] UNLESS_thm3)]);; + +let UNLESS_cor2 = prove_thm + ("UNLESS_cor2", + (`!(p:'a->bool) q Pr. (!s. (Not p)s ==> q s) ==> ((p UNLESS q) Pr)`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPEC_ALL UNLESS_thm2) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS (Not p))Pr`); + (`!s:'a. (Not p) s ==> q s`)] + AND_INTRO_THM)) THEN + ASM_REWRITE_TAC [UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`Not (p:'a->bool)`); + (`q:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm3)]);; + +let UNLESS_cor3a = TAC_PROOF + (([], + (`!(p:'a->bool) q r Pr. + (p UNLESS (q \/* r)) Pr ==> + ((p /\* (Not q)) UNLESS (q \/* r)) Pr`)), + REPEAT GEN_TAC THEN + ASSUME_TAC (SPECL [(`Not (q:'a->bool)`); + (`Pr:('a->'a)list`)] UNLESS_thm2) THEN + UNDISCH_TAC (`((Not (q:'a->bool)) UNLESS (Not(Not q)))Pr`) THEN + REWRITE_TAC [NOT_NOT_lemma] THEN + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS (q \/* r))Pr`); + (`((Not (q:'a->bool)) UNLESS q)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`((q:'a->bool) \/* r)`); + (`(Not (q:'a->bool))`); (`q:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm6)) THEN + UNDISCH_TAC (`(((p:'a->bool) /\* (Not q)) UNLESS + ((q \/* r) \/* q))Pr`) THEN + PURE_ONCE_REWRITE_TAC + [SPECL [(`(q:'a->bool) \/* r`); + (`q:'a->bool`)] OR_COMM_lemma] THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL OR_ASSOC_lemma))] THEN + REWRITE_TAC [OR_OR_lemma]);; + +let UNLESS_cor3b = TAC_PROOF + (([], + (`!(p:'a->bool) q r Pr. + ((p /\* (Not q)) UNLESS (q \/* r)) Pr ==> (p UNLESS (q \/* r)) Pr`)), + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPECL [(`(p:'a->bool) /\* q`); + (`Pr:('a->'a)list`)] UNLESS_thm1) THEN + ASSUME_TAC (SPECL [(`p:'a->bool`); (`q:'a->bool`)] + AND_IMPLY_WEAK_lemma) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((p:'a->bool) /\* q) UNLESS (p /\* q))Pr`); + (`!s:'a. (p /\* q)s ==> q s`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(p:'a->bool) /\* q`); (`(p:'a->bool) /\* q`); + (`q:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm3)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((p:'a->bool) /\* (Not q)) UNLESS (q \/* r))Pr`); + (`(((p:'a->bool) /\* q) UNLESS q)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) /\* (Not q))`); (`((q:'a->bool) \/* r)`); + (`((p:'a->bool) /\* q)`); (`q:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm7)) THEN + UNDISCH_TAC + (`((((p:'a->bool) /\* (Not q)) \/* (p /\* q)) UNLESS + ((q \/* r) \/* q))Pr`) THEN + REWRITE_TAC [AND_COMPL_OR_lemma] THEN + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL (OR_ASSOC_lemma)))] THEN + REWRITE_TAC [OR_OR_lemma] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + ASM_REWRITE_TAC []);; + +let UNLESS_cor3 = prove_thm + ("UNLESS_cor3", + (`!(p:'a->bool) q r Pr. + ((p /\* (Not q)) UNLESS (q \/* r)) Pr = (p UNLESS (q \/* r)) Pr`), + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL UNLESS_cor3b) (SPEC_ALL UNLESS_cor3a)]);; + +let UNLESS_cor4 = prove_thm + ("UNLESS_cor4", + (`!(p:'a->bool) q r Pr. + ((p \/* q) UNLESS r) Pr ==> (p UNLESS (q \/* r)) Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (SPEC_ALL ((SPEC (`Not (q:'a->bool)`) UNLESS_thm2))) THEN + UNDISCH_TAC (`((Not (q:'a->bool)) UNLESS (Not(Not q)))Pr`) THEN + REWRITE_TAC [NOT_NOT_lemma] THEN + STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`(((p:'a->bool) \/* q) UNLESS r)Pr`); + (`((Not (q:'a->bool)) UNLESS q)Pr`)] + AND_INTRO_THM))) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`((p:'a->bool) \/* q)`); (`r:'a->bool`); + (`(Not (q:'a->bool))`); (`q:'a->bool`)] + UNLESS_thm6))) THEN + UNDISCH_TAC (`((((p:'a->bool) \/* q) /\* (Not q)) UNLESS + (r \/* q))Pr`) THEN + REWRITE_TAC [OR_NOT_AND_lemma] THEN + PURE_ONCE_REWRITE_TAC [SPECL [(`r:'a->bool`); (`q:'a->bool`)] + OR_COMM_lemma] THEN + REWRITE_TAC [UNLESS_cor3] THEN + STRIP_TAC THEN + PURE_ONCE_REWRITE_TAC [SPECL [(`r:'a->bool`); (`q:'a->bool`)] + OR_COMM_lemma] THEN + ASM_REWRITE_TAC []);; + +let UNLESS_cor5 = prove_thm + ("UNLESS_cor5", + (`!(p:'a->bool) Pr. (p UNLESS True) Pr`), + REPEAT GEN_TAC THEN + ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN + ASSUME_TAC (SPEC_ALL UNLESS_thm2) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS p)Pr`); + (`((p:'a->bool) UNLESS (Not p))Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`p:'a->bool`); (`p:'a->bool`); + (`p:'a->bool`); (`(Not (p:'a->bool))`)] + UNLESS_thm6))) THEN + UNDISCH_TAC (`(((p:'a->bool) /\* p) UNLESS (p \/* (Not p)))Pr`) THEN + REWRITE_TAC [AND_AND_lemma;P_OR_NOT_P_lemma]);; + +let UNLESS_cor6 = prove_thm + ("UNLESS_cor6", + (`!(p:'a->bool) Pr. (True UNLESS p) Pr`), + REPEAT GEN_TAC THEN + ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN + ASSUME_TAC (SPEC_ALL (SPEC (`(Not (p:'a->bool))`) UNLESS_thm2)) THEN + UNDISCH_TAC (`((Not (p:'a->bool)) UNLESS (Not(Not p)))Pr`) THEN + REWRITE_TAC [NOT_NOT_lemma] THEN + DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((Not (p:'a->bool)) UNLESS p)Pr`); + (`((p:'a->bool) UNLESS p)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`(Not (p:'a->bool))`); (`p:'a->bool`); + (`p:'a->bool`); (`p:'a->bool`)] + UNLESS_thm7))) THEN + UNDISCH_TAC (`(((Not (p:'a->bool)) \/* p) UNLESS (p \/* p))Pr`) THEN + PURE_ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [OR_OR_lemma;P_OR_NOT_P_lemma]);; + +let UNLESS_cor7 = prove_thm + ("UNLESS_cor7", + (`!(p:'a->bool) Pr. (False UNLESS p) Pr`), + REPEAT GEN_TAC THEN + ASSUME_TAC (SPEC_ALL UNLESS_thm1) THEN + ASSUME_TAC (SPEC_ALL (SPEC (`(Not (p:'a->bool))`) UNLESS_thm2)) THEN + UNDISCH_TAC (`((Not (p:'a->bool)) UNLESS (Not(Not p)))Pr`) THEN + REWRITE_TAC [NOT_NOT_lemma] THEN + DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((Not (p:'a->bool)) UNLESS p)Pr`); + (`((p:'a->bool) UNLESS p)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`(Not (p:'a->bool))`); (`p:'a->bool`); + (`p:'a->bool`); (`p:'a->bool`)] + UNLESS_thm6))) THEN + UNDISCH_TAC (`(((Not (p:'a->bool)) /\* p) UNLESS (p \/* p))Pr`) THEN + PURE_ONCE_REWRITE_TAC [AND_COMM_lemma] THEN + REWRITE_TAC [OR_OR_lemma;P_AND_NOT_P_lemma]);; + +let HeJiFeng_lemma1 = TAC_PROOF + (([], + (`!(p:'a->bool) q p'. + (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> + (!s. p s /\ ~q s ==> p' s /\ ~q s)`)), + REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; + +let HeJiFeng_lemma2 = TAC_PROOF + (([], + (`!(p:'a->bool) q p'. + (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> + (!s. p' s /\ ~q s ==> p s /\ ~q s)`)), + REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC []);; + +let HeJiFeng_lemma = TAC_PROOF + (([], + (`!(p:'a->bool) q p'. + (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) ==> + (!s. p s /\ ~q s <=> p' s /\ ~q s)`)), + REPEAT STRIP_TAC THEN + REWRITE_TAC [IMP_ANTISYM_RULE + (SPEC_ALL (UNDISCH (UNDISCH (UNDISCH (SPEC_ALL HeJiFeng_lemma1))))) + (SPEC_ALL (UNDISCH (UNDISCH (UNDISCH (SPEC_ALL HeJiFeng_lemma2)))))]);; + +let HeJiFeng_lemma_f = MK_ABS (UNDISCH_ALL (SPEC_ALL HeJiFeng_lemma));; + +let UNLESS_cor8 = prove_thm + ("UNLESS_cor8", + (`!(p:'a->bool) q p' Pr. + (!s. p s /\ ~q s) ==> (!s. p' s) ==> (!s. p s \/ q s) + ==> (((p /\* (Not q)) UNLESS q) Pr = + ((p' /\* (Not q)) UNLESS q) Pr)`), + REPEAT STRIP_TAC THEN + REWRITE_TAC [AND_def;OR_def;NOT_def1] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC [HeJiFeng_lemma_f]);; + +(* + Corollary of generalized cancellation +*) +let UNLESS_cor9 = prove_thm + ("UNLESS_cor9", + (`!(p:'a->bool) q p' q' r r' Pr. + ((p \/* p') UNLESS (q \/* r)) Pr /\ ((q \/* q') UNLESS (p \/* r')) Pr ==> + ((p \/* p' \/* q \/* q') UNLESS ((p /\* q) \/* r \/* r')) Pr`), + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) \/* p')`); (`((q:'a->bool) \/* r)`); + (`((q:'a->bool) \/* q')`); (`((p:'a->bool) \/* r')`); + (`Pr:('a->'a)list`)] + UNLESS_thm5)) THEN + ASSUME_TAC (SPECL + [(`p:'a->bool`); (`q:'a->bool`); + (`p':'a->bool`); (`q':'a->bool`); + (`r:'a->bool`); (`r':'a->bool`)] IMPLY_WEAK_lemma4) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((((p:'a->bool) \/* p') \/* (q \/* q')) UNLESS + ((((Not(p \/* p')) /\* (p \/* r')) \/* + ((Not(q \/* q')) /\* (q \/* r))) \/* + ((q \/* r) /\* (p \/* r')))) Pr`); + (`!s:'a. ((((Not(p \/* p')) /\* (p \/* r')) \/* + ((Not(q \/* q')) /\* (q \/* r))) \/* + ((q \/* r) /\* (p \/* r'))) s ==> + ((p /\* q) \/* (r \/* r'))s`)] + AND_INTRO_THM)) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPEC_ALL (SPECL + [(`(((p:'a->bool) \/* p') \/* (q \/* q'))`); + (`((((Not((p:'a->bool) \/* p')) /\* (p \/* r')) \/* + ((Not(q \/* q')) /\* (q \/* r))) \/* + ((q \/* r) /\* (p \/* r')))`); + (`(((p:'a->bool) /\* q) \/* (r \/* r'))`)] + UNLESS_thm3))) THEN + UNDISCH_TAC (`((((p:'a->bool) \/* p') \/* (q \/* q')) UNLESS + ((p /\* q) \/* (r \/* r')))Pr`) THEN + REWRITE_TAC [OR_ASSOC_lemma]);; + +let UNLESS_cor10 = prove_thm + ("UNLESS_cor10", + (`!(p:'a->bool) q Pr. (p \/* q) STABLE Pr ==> (p UNLESS q) Pr`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + DISCH_TAC THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`q:'a->bool`); + (`False:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_cor4)) THEN + UNDISCH_TAC (`((p:'a->bool) UNLESS (q \/* False))Pr`) THEN + REWRITE_TAC [OR_False_lemma]);; + + +let UNLESS_cor11 = prove_thm + ("UNLESS_cor11", + (`!(p:'a->bool) Pr. (!s. (Not p)s) ==> p STABLE Pr`), + GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + GEN_TAC THEN + REWRITE_TAC [UNLESS_STMT; FALSE_def] THEN + STRIP_ASSUME_TAC (REWRITE_RULE [NOT_def1] + (SPEC `s:'a` (ASSUME `!s:'a. Not (p:'a->bool) s`))) THEN + STRIP_TAC THEN + RES_TAC);; + +let UNLESS_cor12 = prove_thm + ("UNLESS_cor12", + (`!(p:'a->bool) Pr. (!s. (Not p)s) ==> (Not p) STABLE Pr`), + GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [UNLESS_STMT]);; + +let UNLESS_cor13 = prove_thm + ("UNLESS_cor13", + (`!(p:'a->bool) q Pr. + (p UNLESS q) Pr /\ (q UNLESS p) Pr /\ (!s. Not (p /\* q) s) ==> + (p \/* q) STABLE Pr`), + REPEAT STRIP_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) /\* q)`); + (`Pr:('a->'a)list`)] UNLESS_cor11)) THEN + UNDISCH_TAC (`((p:'a->bool) /\* q) STABLE Pr`) THEN + REWRITE_TAC [STABLE] THEN + DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((p:'a->bool) UNLESS q)Pr`); (`((q:'a->bool) UNLESS p)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(p:'a->bool)`); (`(q:'a->bool)`); + (`(q:'a->bool)`); (`(p:'a->bool)`); (`Pr:('a->'a)list`)] + UNLESS_thm5)) THEN + UNDISCH_TAC (`(((p:'a->bool) \/* q) UNLESS + ((((Not p) /\* p) \/* ((Not q) /\* q)) \/* (q /\* p)) + ) Pr`) THEN + PURE_ONCE_REWRITE_TAC [AND_COMM_lemma] THEN + REWRITE_TAC [P_AND_NOT_P_lemma;OR_False_lemma] THEN + PURE_ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [OR_False_lemma] THEN + DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((q:'a->bool) \/* p) UNLESS (p /\* q))Pr`); + (`(((p:'a->bool) /\* q) UNLESS False)Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`((q:'a->bool) \/* p)`); (`((p:'a->bool) /\* q)`); + (`False:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm8)) THEN + UNDISCH_TAC + (`((((q:'a->bool) \/* p) \/* (p /\* q)) UNLESS False)Pr`) THEN + REWRITE_TAC [OR_AND_DISTR_lemma] THEN + REWRITE_TAC [OR_ASSOC_lemma;OR_OR_lemma] THEN + PURE_ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [OR_ASSOC_lemma;OR_OR_lemma;AND_AND_lemma]);; + +let UNLESS_cor14 = prove_thm + ("UNLESS_cor14", + (`!(p:'a->bool) q Pr. (p UNLESS (Not q)) Pr /\ q STABLE Pr ==> + (p UNLESS (p /\* (Not q))) Pr`), + REWRITE_TAC [STABLE] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`p:'a->bool`); (`Not (q:'a->bool)`); + (`q:'a->bool`); (`False:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm4)) THEN + UNDISCH_TAC (`(((p:'a->bool) /\* q) UNLESS + (((p /\* False) \/* (q /\* (Not q))) \/* + ((Not q) /\* False)))Pr`) THEN + REWRITE_TAC [AND_False_lemma;P_AND_NOT_P_lemma;OR_False_lemma] THEN + DISCH_TAC THEN + ASSUME_TAC (SPECL + [(`(p:'a->bool) /\* (Not q)`); + (`Pr:('a->'a)list`)] UNLESS_thm1) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(((p:'a->bool) /\* q) UNLESS False)Pr`); + (`(((p:'a->bool) /\* (Not q)) UNLESS (p /\* (Not q)))Pr`)] + AND_INTRO_THM)) THEN + ASSUME_TAC (UNDISCH_ALL (SPECL + [(`(p:'a->bool) /\* q`); (`False:'a->bool`); + (`(p:'a->bool) /\* (Not q)`); (`(p:'a->bool) /\* (Not q)`); + (`Pr:('a->'a)list`)] + UNLESS_thm5)) THEN + UNDISCH_TAC (`((((p:'a->bool) /\* q) \/* (p /\* (Not q))) UNLESS + ((((Not(p /\* q)) /\* (p /\* (Not q))) \/* + ((Not(p /\* (Not q))) /\* False)) \/* + (False /\* (p /\* (Not q)))))Pr`) THEN + REWRITE_TAC [AND_False_lemma;OR_False_lemma] THEN + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [AND_COMPL_OR_lemma] THEN + ONCE_REWRITE_TAC [AND_COMM_lemma] THEN + REWRITE_TAC [AND_False_lemma] THEN + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [OR_False_lemma] THEN + REWRITE_TAC [NOT_AND_OR_NOT_lemma] THEN + REWRITE_TAC [AND_OR_DISTR_lemma] THEN + REWRITE_TAC [AND_ASSOC_lemma] THEN + REWRITE_TAC [AND_AND_lemma] THEN + ONCE_REWRITE_TAC [AND_AND_COMM_lemma] THEN + REWRITE_TAC [GEN_ALL (SYM (SPEC_ALL AND_ASSOC_lemma))] THEN + REWRITE_TAC [P_AND_NOT_P_lemma] THEN + ONCE_REWRITE_TAC [AND_COMM_OR_lemma] THEN + REWRITE_TAC [AND_False_lemma] THEN + ONCE_REWRITE_TAC [OR_COMM_lemma] THEN + REWRITE_TAC [OR_False_lemma] THEN + DISCH_TAC THEN + ONCE_REWRITE_TAC [AND_COMM_lemma] THEN + ASM_REWRITE_TAC []);; + +let UNLESS_cor15_lem1 = TAC_PROOF + (([], + (`!p q. p /\ (~p \/ ~q) <=> p /\ ~q`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + (RES_TAC THEN ASM_REWRITE_TAC []));; + +let UNLESS_cor15_lem2 = TAC_PROOF + (([], + (`!p q. p \/ (p /\ q) <=> p`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +let UNLESS_cor15_lem3 = TAC_PROOF + (([], + (`!P Q. (!(i:num). (P i) /\ (Q i)) <=> ((!i. P i) /\ (!i. Q i))`)), + REPEAT GEN_TAC THEN + EQ_TAC THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC []);; + +(* + MESON_TAC is powerful, but I should change this proof to not use + MESON_TAC as a detailed proof will better show why the UNLESS_STMT + property holds +*) +let UNLESS_STMT_cor15 = prove_thm + ("UNLESS_STMT_cor15", + `!(P:num->('a->bool)) Q st. + (!i s. (P i UNLESS_STMT P i /\* Q i) st s) ==> + (!s. ((!*) P UNLESS_STMT (!*) P /\* (?*) Q) st s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [FORALL_def; EXISTS_def; UNLESS_STMT; AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + MESON_TAC []);; + +let UNLESS_cor15 = prove_thm + ("UNLESS_cor15", + `!(P:num->('a->bool)) Q Pr. + (!i. ((P i) UNLESS ((P i) /\* (Q i))) Pr) ==> + (((!*) P) UNLESS (((!*) P) /\* ((?*) Q))) Pr`, + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + STRIP_ASSUME_TAC (REWRITE_RULE [UNLESS_cor15_lem3] (ASSUME + `!i:num. (!s:'a. (P i UNLESS_STMT P i /\* Q i) h s) /\ + (P i UNLESS P i /\* Q i) t`)) THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + IMP_RES_TAC UNLESS_STMT_cor15);; + +let UNLESS_cor16 = prove_thm + ("UNLESS_cor16", + `!(P:num->('a->bool)) Q Pr. + (!i. ((P i) UNLESS (Q i))Pr) ==> + (!i. ((/<=\* P i) UNLESS (\<=/* Q i))Pr)`, + REPEAT GEN_TAC THEN + DISCH_TAC THEN + INDUCT_TAC THENL + [ + ASM_REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] + ; + REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] THEN + ASSUME_TAC (SPEC (`SUC i`) (ASSUME + (`!i. (((P:num->('a->bool)) i) UNLESS (Q i))Pr`))) THEN + STRIP_ASSUME_TAC (UNDISCH_ALL (hd (IMP_CANON (SPECL + [(`/<=\* (P:num->('a->bool)) i`); + (`\<=/* (Q:num->('a->bool)) i`); + (`(P:num->('a->bool))(SUC i)`); (`(Q:num->('a->bool))(SUC i)`); + (`Pr:('a->'a)list`)] + UNLESS_thm6)))) + ]);; + +let UNLESS_cor17 = prove_thm + ("UNLESS_cor17", + (`!(P:num->('a->bool)) q Pr. + (!i. ((P i) UNLESS q)Pr) ==> (!i. ((/<=\* P i) UNLESS q)Pr)`), + REPEAT GEN_TAC THEN + DISCH_TAC THEN + INDUCT_TAC THENL + [ + ASM_REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] + ; + REWRITE_TAC [AND_LE_N_def;OR_LE_N_def] THEN + ASSUME_TAC (SPEC (`SUC i`) (ASSUME + (`!i. (((P:num->('a->bool)) i) UNLESS q)Pr`))) THEN + ASSUME_TAC (UNDISCH_ALL (hd (IMP_CANON (SPECL + [(`/<=\* (P:num->('a->bool)) i`); (`q:'a->bool`); + (`(P:num->('a->bool))(SUC i)`); + (`q:'a->bool`); (`Pr:('a->'a)list`)] + UNLESS_thm6)))) THEN + UNDISCH_ONE_TAC THEN + REWRITE_TAC [OR_OR_lemma] + ]);; + +(* + MESON_TAC is powerful, but I should change this proof to not use + MESON_TAC as a detailed proof will better show why the UNLESS_STMT + property holds +*) +let UNLESS_STMT_cor18 = prove_thm + ("UNLESS_STMT_cor18", + `!(P:num->('a->bool)) Q st. + (!i s. ((P i) UNLESS_STMT q) st s) ==> + (!s. (((?*) P) UNLESS_STMT q) st s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC [FORALL_def; EXISTS_def; UNLESS_STMT; AND_def] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + MESON_TAC []);; + +let UNLESS_cor18 = prove_thm + ("UNLESS_cor18", + (`!(P:num->('a->bool)) q Pr. + (!m. ((P m) UNLESS q) Pr) ==> (((?*) P) UNLESS q) Pr`), + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC [] THEN + STRIP_ASSUME_TAC (REWRITE_RULE [UNLESS_cor15_lem3] (ASSUME + `!m:num. (!s:'a. (P m UNLESS_STMT q) h s) /\ (P m UNLESS q) t`)) THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + IMP_RES_TAC UNLESS_STMT_cor18);; + +let UNLESS_cor19 = prove_thm + ("UNLESS_cor19", + (`!Pr. (False:'a->bool) STABLE Pr`), + GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + REWRITE_TAC [UNLESS_thm1]);; + +let UNLESS_cor20 = prove_thm + ("UNLESS_cor20", + (`!(p:'a->bool) q Pr. + (p STABLE Pr) /\ (q STABLE Pr) ==> ((p /\* q) STABLE Pr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + ACCEPT_TAC (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL + [(`p:'a->bool`); (`False:'a->bool`); + (`q:'a->bool`); (`False:'a->bool`); + (`Pr:('a->'a)list`)] UNLESS_thm4)));; + +let UNLESS_cor21 = prove_thm + ("UNLESS_cor21", + (`!(p:'a->bool) q Pr. + (p STABLE Pr) /\ (q STABLE Pr) ==> ((p \/* q) STABLE Pr)`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + ACCEPT_TAC (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL + [(`p:'a->bool`); (`False:'a->bool`); + (`q:'a->bool`); (`False:'a->bool`); + (`Pr:('a->'a)list`)] UNLESS_thm7)));; + +let UNLESS_cor22 = prove_thm + ("UNLESS_cor22", + (`!(p:'a->bool) q r Pr. + (p UNLESS q) Pr /\ (r STABLE Pr) ==> + ((p /\* r) UNLESS (q /\* r))Pr`), + REPEAT GEN_TAC THEN + REWRITE_TAC [STABLE] THEN + ACCEPT_TAC (REWRITE_RULE [OR_False_lemma] (ONCE_REWRITE_RULE [OR_COMM_lemma] + (ONCE_REWRITE_RULE [OR_AND_COMM_lemma] + (REWRITE_RULE [AND_False_lemma;OR_False_lemma] (SPECL + [(`p:'a->bool`); (`q:'a->bool`); + (`r:'a->bool`); (`False:'a->bool`); + (`Pr:('a->'a)list`)] UNLESS_thm4))))));; + +let UNLESS_cor23 = prove_thm + ("UNLESS_cor23", + (`!(p:'a->bool) q r Pr. + ((p UNLESS q) Pr) ==> ((p \/* r) UNLESS (q \/* r)) Pr`), + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC [UNLESS] THEN + STRIP_TAC THEN + RES_TAC THEN + ASM_REWRITE_TAC [] THEN + IMP_RES_TAC UNLESS_STMT_thm6 THEN + ASM_REWRITE_TAC []);; diff --git a/arith.ml b/arith.ml new file mode 100644 index 0000000..e368aa0 --- /dev/null +++ b/arith.ml @@ -0,0 +1,1560 @@ +(* ========================================================================= *) +(* Natural number arithmetic. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "recursion.ml";; + +(* ------------------------------------------------------------------------- *) +(* Note: all the following proofs are intuitionistic and intensional, except *) +(* for the least number principle num_WOP. *) +(* (And except the arith rewrites at the end; these could be done that way *) +(* but they use the conditional anyway.) In fact, one could very easily *) +(* write a "decider" returning P \/ ~P for quantifier-free P. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("<",(12,"right"));; +parse_as_infix("<=",(12,"right"));; +parse_as_infix(">",(12,"right"));; +parse_as_infix(">=",(12,"right"));; + +parse_as_infix("+",(16,"right"));; +parse_as_infix("-",(18,"left"));; +parse_as_infix("*",(20,"right"));; +parse_as_infix("EXP",(24,"left"));; + +parse_as_infix("DIV",(22,"left"));; +parse_as_infix("MOD",(22,"left"));; + +(* ------------------------------------------------------------------------- *) +(* The predecessor function. *) +(* ------------------------------------------------------------------------- *) + +let PRE = new_recursive_definition num_RECURSION + `(PRE 0 = 0) /\ + (!n. PRE (SUC n) = n)`;; + +(* ------------------------------------------------------------------------- *) +(* Addition. *) +(* ------------------------------------------------------------------------- *) + +let ADD = new_recursive_definition num_RECURSION + `(!n. 0 + n = n) /\ + (!m n. (SUC m) + n = SUC(m + n))`;; + +let ADD_0 = prove + (`!m. m + 0 = m`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]);; + +let ADD_SUC = prove + (`!m n. m + (SUC n) = SUC(m + n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD]);; + +let ADD_CLAUSES = prove + (`(!n. 0 + n = n) /\ + (!m. m + 0 = m) /\ + (!m n. (SUC m) + n = SUC(m + n)) /\ + (!m n. m + (SUC n) = SUC(m + n))`, + REWRITE_TAC[ADD; ADD_0; ADD_SUC]);; + +let ADD_SYM = prove + (`!m n. m + n = n + m`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; + +let ADD_ASSOC = prove + (`!m n p. m + (n + p) = (m + n) + p`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]);; + +let ADD_AC = prove + (`(m + n = n + m) /\ + ((m + n) + p = m + (n + p)) /\ + (m + (n + p) = n + (m + p))`, + MESON_TAC[ADD_ASSOC; ADD_SYM]);; + +let ADD_EQ_0 = prove + (`!m n. (m + n = 0) <=> (m = 0) /\ (n = 0)`, + REPEAT INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; NOT_SUC]);; + +let EQ_ADD_LCANCEL = prove + (`!m n p. (m + n = m + p) <=> (n = p)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUC_INJ]);; + +let EQ_ADD_RCANCEL = prove + (`!m n p. (m + p = n + p) <=> (m = n)`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC EQ_ADD_LCANCEL);; + +let EQ_ADD_LCANCEL_0 = prove + (`!m n. (m + n = m) <=> (n = 0)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUC_INJ]);; + +let EQ_ADD_RCANCEL_0 = prove + (`!m n. (m + n = n) <=> (m = 0)`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC EQ_ADD_LCANCEL_0);; + +(* ------------------------------------------------------------------------- *) +(* Now define "bitwise" binary representation of numerals. *) +(* ------------------------------------------------------------------------- *) + +let BIT0 = prove + (`!n. BIT0 n = n + n`, + INDUCT_TAC THEN ASM_REWRITE_TAC[BIT0_DEF; ADD_CLAUSES]);; + +let BIT1 = prove + (`!n. BIT1 n = SUC(n + n)`, + REWRITE_TAC[BIT1_DEF; BIT0]);; + +let BIT0_THM = prove + (`!n. NUMERAL (BIT0 n) = NUMERAL n + NUMERAL n`, + REWRITE_TAC[NUMERAL; BIT0]);; + +let BIT1_THM = prove + (`!n. NUMERAL (BIT1 n) = SUC(NUMERAL n + NUMERAL n)`, + REWRITE_TAC[NUMERAL; BIT1]);; + +(* ------------------------------------------------------------------------- *) +(* Following is handy before num_CONV arrives. *) +(* ------------------------------------------------------------------------- *) + +let ONE = prove + (`1 = SUC 0`, + REWRITE_TAC[BIT1; REWRITE_RULE[NUMERAL] ADD_CLAUSES; NUMERAL]);; + +let TWO = prove + (`2 = SUC 1`, + REWRITE_TAC[BIT0; BIT1; REWRITE_RULE[NUMERAL] ADD_CLAUSES; NUMERAL]);; + +(* ------------------------------------------------------------------------- *) +(* One immediate consequence. *) +(* ------------------------------------------------------------------------- *) + +let ADD1 = prove + (`!m. SUC m = m + 1`, + REWRITE_TAC[BIT1_THM; ADD_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Multiplication. *) +(* ------------------------------------------------------------------------- *) + +let MULT = new_recursive_definition num_RECURSION + `(!n. 0 * n = 0) /\ + (!m n. (SUC m) * n = (m * n) + n)`;; + +let MULT_0 = prove + (`!m. m * 0 = 0`, + INDUCT_TAC THEN ASM_REWRITE_TAC[MULT; ADD_CLAUSES]);; + +let MULT_SUC = prove + (`!m n. m * (SUC n) = m + (m * n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[MULT; ADD_CLAUSES; ADD_ASSOC]);; + +let MULT_CLAUSES = prove + (`(!n. 0 * n = 0) /\ + (!m. m * 0 = 0) /\ + (!n. 1 * n = n) /\ + (!m. m * 1 = m) /\ + (!m n. (SUC m) * n = (m * n) + n) /\ + (!m n. m * (SUC n) = m + (m * n))`, + REWRITE_TAC[BIT1_THM; MULT; MULT_0; MULT_SUC; ADD_CLAUSES]);; + +let MULT_SYM = prove + (`!m n. m * n = n * m`, + INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; EQT_INTRO(SPEC_ALL ADD_SYM)]);; + +let LEFT_ADD_DISTRIB = prove + (`!m n p. m * (n + p) = (m * n) + (m * p)`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD; MULT_CLAUSES; ADD_ASSOC]);; + +let RIGHT_ADD_DISTRIB = prove + (`!m n p. (m + n) * p = (m * p) + (n * p)`, + ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_ACCEPT_TAC LEFT_ADD_DISTRIB);; + +let MULT_ASSOC = prove + (`!m n p. m * (n * p) = (m * n) * p`, + INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; RIGHT_ADD_DISTRIB]);; + +let MULT_AC = prove + (`(m * n = n * m) /\ + ((m * n) * p = m * (n * p)) /\ + (m * (n * p) = n * (m * p))`, + MESON_TAC[MULT_ASSOC; MULT_SYM]);; + +let MULT_EQ_0 = prove + (`!m n. (m * n = 0) <=> (m = 0) \/ (n = 0)`, + REPEAT INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; NOT_SUC]);; + +let EQ_MULT_LCANCEL = prove + (`!m n p. (m * n = m * p) <=> (m = 0) \/ (n = p)`, + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; NOT_SUC] THEN + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; GSYM NOT_SUC; NOT_SUC] THEN + ASM_REWRITE_TAC[SUC_INJ; GSYM ADD_ASSOC; EQ_ADD_LCANCEL]);; + +let EQ_MULT_RCANCEL = prove + (`!m n p. (m * p = n * p) <=> (m = n) \/ (p = 0)`, + ONCE_REWRITE_TAC[MULT_SYM; DISJ_SYM] THEN MATCH_ACCEPT_TAC EQ_MULT_LCANCEL);; + +let MULT_2 = prove + (`!n. 2 * n = n + n`, + GEN_TAC THEN REWRITE_TAC[BIT0_THM; MULT_CLAUSES; RIGHT_ADD_DISTRIB]);; + +let MULT_EQ_1 = prove + (`!m n. (m * n = 1) <=> (m = 1) /\ (n = 1)`, + INDUCT_TAC THEN INDUCT_TAC THEN REWRITE_TAC + [MULT_CLAUSES; ADD_CLAUSES; BIT0_THM; BIT1_THM; GSYM NOT_SUC] THEN + REWRITE_TAC[SUC_INJ; ADD_EQ_0; MULT_EQ_0] THEN + CONV_TAC TAUT);; + +(* ------------------------------------------------------------------------- *) +(* Exponentiation. *) +(* ------------------------------------------------------------------------- *) + +let EXP = new_recursive_definition num_RECURSION + `(!m. m EXP 0 = 1) /\ + (!m n. m EXP (SUC n) = m * (m EXP n))`;; + +let EXP_EQ_0 = prove + (`!m n. (m EXP n = 0) <=> (m = 0) /\ ~(n = 0)`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC + [BIT1_THM; NOT_SUC; NOT_SUC; EXP; MULT_CLAUSES; ADD_CLAUSES; ADD_EQ_0]);; + +let EXP_EQ_1 = prove + (`!x n. x EXP n = 1 <=> x = 1 \/ n = 0`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_EQ_1; NOT_SUC] THEN + CONV_TAC TAUT);; + +let EXP_ZERO = prove + (`!n. 0 EXP n = if n = 0 then 1 else 0`, + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[EXP_EQ_0; EXP_EQ_1]);; + +let EXP_ADD = prove + (`!m n p. m EXP (n + p) = (m EXP n) * (m EXP p)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[EXP; ADD_CLAUSES; MULT_CLAUSES; MULT_AC]);; + +let EXP_ONE = prove + (`!n. 1 EXP n = 1`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES]);; + +let EXP_1 = prove + (`!n. n EXP 1 = n`, + REWRITE_TAC[ONE; EXP; MULT_CLAUSES; ADD_CLAUSES]);; + +let EXP_2 = prove + (`!n. n EXP 2 = n * n`, + REWRITE_TAC[BIT0_THM; BIT1_THM; EXP; EXP_ADD; MULT_CLAUSES; ADD_CLAUSES]);; + +let MULT_EXP = prove + (`!p m n. (m * n) EXP p = m EXP p * n EXP p`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES; MULT_AC]);; + +let EXP_MULT = prove + (`!m n p. m EXP (n * p) = (m EXP n) EXP p`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[EXP_ADD; EXP; MULT_CLAUSES] THENL + [CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP; MULT_CLAUSES]; + REWRITE_TAC[MULT_EXP] THEN MATCH_ACCEPT_TAC MULT_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Define the orderings recursively too. *) +(* ------------------------------------------------------------------------- *) + +let LE = new_recursive_definition num_RECURSION + `(!m. (m <= 0) <=> (m = 0)) /\ + (!m n. (m <= SUC n) <=> (m = SUC n) \/ (m <= n))`;; + +let LT = new_recursive_definition num_RECURSION + `(!m. (m < 0) <=> F) /\ + (!m n. (m < SUC n) <=> (m = n) \/ (m < n))`;; + +let GE = new_definition + `m >= n <=> n <= m`;; + +let GT = new_definition + `m > n <=> n < m`;; + +(* ------------------------------------------------------------------------- *) +(* Maximum and minimum of natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let MAX = new_definition + `!m n. MAX m n = if m <= n then n else m`;; + +let MIN = new_definition + `!m n. MIN m n = if m <= n then m else n`;; + +(* ------------------------------------------------------------------------- *) +(* Step cases. *) +(* ------------------------------------------------------------------------- *) + +let LE_SUC_LT = prove + (`!m n. (SUC m <= n) <=> (m < n)`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LE; LT; NOT_SUC; SUC_INJ]);; + +let LT_SUC_LE = prove + (`!m n. (m < SUC n) <=> (m <= n)`, + GEN_TAC THEN INDUCT_TAC THEN ONCE_REWRITE_TAC[LT; LE] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LT]);; + +let LE_SUC = prove + (`!m n. (SUC m <= SUC n) <=> (m <= n)`, + REWRITE_TAC[LE_SUC_LT; LT_SUC_LE]);; + +let LT_SUC = prove + (`!m n. (SUC m < SUC n) <=> (m < n)`, + REWRITE_TAC[LT_SUC_LE; LE_SUC_LT]);; + +(* ------------------------------------------------------------------------- *) +(* Base cases. *) +(* ------------------------------------------------------------------------- *) + +let LE_0 = prove + (`!n. 0 <= n`, + INDUCT_TAC THEN ASM_REWRITE_TAC[LE]);; + +let LT_0 = prove + (`!n. 0 < SUC n`, + REWRITE_TAC[LT_SUC_LE; LE_0]);; + +(* ------------------------------------------------------------------------- *) +(* Reflexivity. *) +(* ------------------------------------------------------------------------- *) + +let LE_REFL = prove + (`!n. n <= n`, + INDUCT_TAC THEN REWRITE_TAC[LE]);; + +let LT_REFL = prove + (`!n. ~(n < n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[LT]);; + +(* ------------------------------------------------------------------------- *) +(* Antisymmetry. *) +(* ------------------------------------------------------------------------- *) + +let LE_ANTISYM = prove + (`!m n. (m <= n /\ n <= m) <=> (m = n)`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; SUC_INJ] THEN + REWRITE_TAC[LE; NOT_SUC; GSYM NOT_SUC]);; + +let LT_ANTISYM = prove + (`!m n. ~(m < n /\ n < m)`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC] THEN REWRITE_TAC[LT]);; + +let LET_ANTISYM = prove + (`!m n. ~(m <= n /\ n < m)`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC] THEN + REWRITE_TAC[LE; LT; NOT_SUC]);; + +let LTE_ANTISYM = prove + (`!m n. ~(m < n /\ n <= m)`, + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[LET_ANTISYM]);; + +(* ------------------------------------------------------------------------- *) +(* Transitivity. *) +(* ------------------------------------------------------------------------- *) + +let LE_TRANS = prove + (`!m n p. m <= n /\ n <= p ==> m <= p`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[LE_SUC; LE_0] THEN REWRITE_TAC[LE; NOT_SUC]);; + +let LT_TRANS = prove + (`!m n p. m < n /\ n < p ==> m < p`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[LT_SUC; LT_0] THEN REWRITE_TAC[LT; NOT_SUC]);; + +let LET_TRANS = prove + (`!m n p. m <= n /\ n < p ==> m < p`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[LE_SUC; LT_SUC; LT_0] THEN REWRITE_TAC[LT; LE; NOT_SUC]);; + +let LTE_TRANS = prove + (`!m n p. m < n /\ n <= p ==> m < p`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[LE_SUC; LT_SUC; LT_0] THEN REWRITE_TAC[LT; LE; NOT_SUC]);; + +(* ------------------------------------------------------------------------- *) +(* Totality. *) +(* ------------------------------------------------------------------------- *) + +let LE_CASES = prove + (`!m n. m <= n \/ n <= m`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_0; LE_SUC]);; + +let LT_CASES = prove + (`!m n. (m < n) \/ (n < m) \/ (m = n)`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LT_SUC; SUC_INJ] THEN + REWRITE_TAC[LT; NOT_SUC; GSYM NOT_SUC] THEN + W(W (curry SPEC_TAC) o hd o frees o snd) THEN + INDUCT_TAC THEN REWRITE_TAC[LT_0]);; + +let LET_CASES = prove + (`!m n. m <= n \/ n < m`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC_LT; LT_SUC_LE; LE_0]);; + +let LTE_CASES = prove + (`!m n. m < n \/ n <= m`, + ONCE_REWRITE_TAC[DISJ_SYM] THEN MATCH_ACCEPT_TAC LET_CASES);; + +(* ------------------------------------------------------------------------- *) +(* Relationship between orderings. *) +(* ------------------------------------------------------------------------- *) + +let LE_LT = prove + (`!m n. (m <= n) <=> (m < n) \/ (m = n)`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[LE_SUC; LT_SUC; SUC_INJ; LE_0; LT_0] THEN + REWRITE_TAC[LE; LT]);; + +let LT_LE = prove + (`!m n. (m < n) <=> (m <= n) /\ ~(m = n)`, + REWRITE_TAC[LE_LT] THEN REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST_ALL_TAC THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[LT_REFL]; + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + ASM_REWRITE_TAC[]]);; + +let NOT_LE = prove + (`!m n. ~(m <= n) <=> (n < m)`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC] THEN + REWRITE_TAC[LE; LT; NOT_SUC; GSYM NOT_SUC; LE_0] THEN + W(W (curry SPEC_TAC) o hd o frees o snd) THEN + INDUCT_TAC THEN REWRITE_TAC[LT_0]);; + +let NOT_LT = prove + (`!m n. ~(m < n) <=> n <= m`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[LE_SUC; LT_SUC] THEN + REWRITE_TAC[LE; LT; NOT_SUC; GSYM NOT_SUC; LE_0] THEN + W(W (curry SPEC_TAC) o hd o frees o snd) THEN + INDUCT_TAC THEN REWRITE_TAC[LT_0]);; + +let LT_IMP_LE = prove + (`!m n. m < n ==> m <= n`, + REWRITE_TAC[LT_LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +let EQ_IMP_LE = prove + (`!m n. (m = n) ==> m <= n`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Often useful to shuffle between different versions of "0 < n". *) +(* ------------------------------------------------------------------------- *) + +let LT_NZ = prove + (`!n. 0 < n <=> ~(n = 0)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NOT_SUC; LT; EQ_SYM_EQ] THEN + CONV_TAC TAUT);; + +let LE_1 = prove + (`(!n. ~(n = 0) ==> 0 < n) /\ + (!n. ~(n = 0) ==> 1 <= n) /\ + (!n. 0 < n ==> ~(n = 0)) /\ + (!n. 0 < n ==> 1 <= n) /\ + (!n. 1 <= n ==> 0 < n) /\ + (!n. 1 <= n ==> ~(n = 0))`, + REWRITE_TAC[LT_NZ; GSYM NOT_LT; ONE; LT]);; + +(* ------------------------------------------------------------------------- *) +(* Relate the orderings to arithmetic operations. *) +(* ------------------------------------------------------------------------- *) + +let LE_EXISTS = prove + (`!m n. (m <= n) <=> (?d. n = m + d)`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LE] THENL + [REWRITE_TAC[CONV_RULE(LAND_CONV SYM_CONV) (SPEC_ALL ADD_EQ_0)] THEN + REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL]; + EQ_TAC THENL + [DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES]; + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + EXISTS_TAC `SUC d` THEN REWRITE_TAC[ADD_CLAUSES]]; + ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN DISJ2_TAC THEN + REWRITE_TAC[EQ_ADD_LCANCEL; GSYM EXISTS_REFL]]]);; + +let LT_EXISTS = prove + (`!m n. (m < n) <=> (?d. n = m + SUC d)`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[LT; ADD_CLAUSES; GSYM NOT_SUC] THEN + ASM_REWRITE_TAC[SUC_INJ] THEN EQ_TAC THENL + [DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC MP_TAC) THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES]; + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + EXISTS_TAC `SUC d` THEN REWRITE_TAC[ADD_CLAUSES]]; + ONCE_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; SUC_INJ] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN DISJ2_TAC THEN + REWRITE_TAC[SUC_INJ; EQ_ADD_LCANCEL; GSYM EXISTS_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Interaction with addition. *) +(* ------------------------------------------------------------------------- *) + +let LE_ADD = prove + (`!m n. m <= m + n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[LE; ADD_CLAUSES; LE_REFL]);; + +let LE_ADDR = prove + (`!m n. n <= m + n`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LE_ADD);; + +let LT_ADD = prove + (`!m n. (m < m + n) <=> (0 < n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; LT_SUC]);; + +let LT_ADDR = prove + (`!m n. (n < m + n) <=> (0 < m)`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LT_ADD);; + +let LE_ADD_LCANCEL = prove + (`!m n p. (m + n) <= (m + p) <=> n <= p`, + REWRITE_TAC[LE_EXISTS; GSYM ADD_ASSOC; EQ_ADD_LCANCEL]);; + +let LE_ADD_RCANCEL = prove + (`!m n p. (m + p) <= (n + p) <=> (m <= n)`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LE_ADD_LCANCEL);; + +let LT_ADD_LCANCEL = prove + (`!m n p. (m + n) < (m + p) <=> n < p`, + REWRITE_TAC[LT_EXISTS; GSYM ADD_ASSOC; EQ_ADD_LCANCEL; SUC_INJ]);; + +let LT_ADD_RCANCEL = prove + (`!m n p. (m + p) < (n + p) <=> (m < n)`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC LT_ADD_LCANCEL);; + +let LE_ADD2 = prove + (`!m n p q. m <= p /\ n <= q ==> m + n <= p + q`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num`) (X_CHOOSE_TAC `b:num`)) THEN + EXISTS_TAC `a + b` THEN ASM_REWRITE_TAC[ADD_AC]);; + +let LET_ADD2 = prove + (`!m n p q. m <= p /\ n < q ==> m + n < p + q`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS; LT_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num`) (X_CHOOSE_TAC `b:num`)) THEN + EXISTS_TAC `a + b` THEN ASM_REWRITE_TAC[SUC_INJ; ADD_CLAUSES; ADD_AC]);; + +let LTE_ADD2 = prove + (`!m n p q. m < p /\ n <= q ==> m + n < p + q`, + ONCE_REWRITE_TAC[ADD_SYM; CONJ_SYM] THEN + MATCH_ACCEPT_TAC LET_ADD2);; + +let LT_ADD2 = prove + (`!m n p q. m < p /\ n < q ==> m + n < p + q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_ADD2 THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LT_IMP_LE THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* And multiplication. *) +(* ------------------------------------------------------------------------- *) + +let LT_MULT = prove + (`!m n. (0 < m * n) <=> (0 < m) /\ (0 < n)`, + REPEAT INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LT_0]);; + +let LE_MULT2 = prove + (`!m n p q. m <= n /\ p <= q ==> m * p <= n * q`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `a:num`) (X_CHOOSE_TAC `b:num`)) THEN + EXISTS_TAC `a * p + m * b + a * b` THEN + ASM_REWRITE_TAC[LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; ADD_ASSOC]);; + +let LT_LMULT = prove + (`!m n p. ~(m = 0) /\ n < p ==> m * n < m * p`, + REPEAT GEN_TAC THEN REWRITE_TAC[LT_LE] THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC LE_MULT2 THEN ASM_REWRITE_TAC[LE_REFL]; + ASM_REWRITE_TAC[EQ_MULT_LCANCEL]]);; + +let LE_MULT_LCANCEL = prove + (`!m n p. (m * n) <= (m * p) <=> (m = 0) \/ n <= p`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LE_REFL; LE_0; NOT_SUC] THEN + REWRITE_TAC[LE_SUC] THEN + REWRITE_TAC[LE; LE_ADD_LCANCEL; GSYM ADD_ASSOC] THEN + ASM_REWRITE_TAC[GSYM(el 4(CONJUNCTS MULT_CLAUSES)); NOT_SUC]);; + +let LE_MULT_RCANCEL = prove + (`!m n p. (m * p) <= (n * p) <=> (m <= n) \/ (p = 0)`, + ONCE_REWRITE_TAC[MULT_SYM; DISJ_SYM] THEN + MATCH_ACCEPT_TAC LE_MULT_LCANCEL);; + +let LT_MULT_LCANCEL = prove + (`!m n p. (m * n) < (m * p) <=> ~(m = 0) /\ n < p`, + REPEAT INDUCT_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LT_REFL; LT_0; NOT_SUC] THEN + REWRITE_TAC[LT_SUC] THEN + REWRITE_TAC[LT; LT_ADD_LCANCEL; GSYM ADD_ASSOC] THEN + ASM_REWRITE_TAC[GSYM(el 4(CONJUNCTS MULT_CLAUSES)); NOT_SUC]);; + +let LT_MULT_RCANCEL = prove + (`!m n p. (m * p) < (n * p) <=> (m < n) /\ ~(p = 0)`, + ONCE_REWRITE_TAC[MULT_SYM; CONJ_SYM] THEN + MATCH_ACCEPT_TAC LT_MULT_LCANCEL);; + +let LT_MULT2 = prove + (`!m n p q. m < n /\ p < q ==> m * p < n * q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `n * p` THEN + ASM_SIMP_TAC[LE_MULT_RCANCEL; LT_IMP_LE; LT_MULT_LCANCEL] THEN + UNDISCH_TAC `m < n` THEN CONV_TAC CONTRAPOS_CONV THEN SIMP_TAC[LT]);; + +let LE_SQUARE_REFL = prove + (`!n. n <= n * n`, + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; LE_0; LE_ADDR]);; + +let LT_POW2_REFL = prove + (`!n. n < 2 EXP n`, + INDUCT_TAC THEN REWRITE_TAC[EXP] THEN REWRITE_TAC[MULT_2; ADD1] THEN + REWRITE_TAC[ONE; LT] THEN MATCH_MP_TAC LTE_ADD2 THEN + ASM_REWRITE_TAC[LE_SUC_LT; TWO] THEN + MESON_TAC[EXP_EQ_0; LE_1; NOT_SUC]);; + +(* ------------------------------------------------------------------------- *) +(* Useful "without loss of generality" lemmas. *) +(* ------------------------------------------------------------------------- *) + +let WLOG_LE = prove + (`(!m n. P m n <=> P n m) /\ (!m n. m <= n ==> P m n) ==> !m n. P m n`, + MESON_TAC[LE_CASES]);; + +let WLOG_LT = prove + (`(!m. P m m) /\ (!m n. P m n <=> P n m) /\ (!m n. m < n ==> P m n) + ==> !m y. P m y`, + MESON_TAC[LT_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of least and greatest elements of (finite) set. *) +(* ------------------------------------------------------------------------- *) + +let num_WF = prove + (`!P. (!n. (!m. m < n ==> P m) ==> P n) ==> !n. P n`, + GEN_TAC THEN MP_TAC(SPEC `\n. !m. m < n ==> P m` num_INDUCTION) THEN + REWRITE_TAC[LT; BETA_THM] THEN MESON_TAC[LT]);; + +let num_WOP = prove + (`!P. (?n. P n) <=> (?n. P(n) /\ !m. m < n ==> ~P(m))`, + GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_TAC THEN MATCH_MP_TAC num_WF THEN ASM_MESON_TAC[]);; + +let num_MAX = prove + (`!P. (?x. P x) /\ (?M. !x. P x ==> x <= M) <=> + ?m. P m /\ (!x. P x ==> x <= m)`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:num`) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC o ONCE_REWRITE_RULE[num_WOP]) THEN + DISCH_THEN(fun th -> EXISTS_TAC `m:num` THEN MP_TAC th) THEN + REWRITE_TAC[TAUT `(a /\ b ==> c /\ a) <=> (a /\ b ==> c)`] THEN + SPEC_TAC(`m:num`,`m:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[LE; LT] THEN DISCH_THEN(IMP_RES_THEN SUBST_ALL_TAC) THEN + POP_ASSUM ACCEPT_TAC; + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `m:num`)) THEN + REWRITE_TAC[LT] THEN CONV_TAC CONTRAPOS_CONV THEN + DISCH_TAC THEN REWRITE_TAC[] THEN X_GEN_TAC `p:num` THEN + FIRST_ASSUM(MP_TAC o SPEC `p:num`) THEN REWRITE_TAC[LE] THEN + ASM_CASES_TAC `p = SUC m` THEN ASM_REWRITE_TAC[]]; + REPEAT STRIP_TAC THEN EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Oddness and evenness (recursively rather than inductively!) *) +(* ------------------------------------------------------------------------- *) + +let EVEN = new_recursive_definition num_RECURSION + `(EVEN 0 <=> T) /\ + (!n. EVEN (SUC n) <=> ~(EVEN n))`;; + +let ODD = new_recursive_definition num_RECURSION + `(ODD 0 <=> F) /\ + (!n. ODD (SUC n) <=> ~(ODD n))`;; + +let NOT_EVEN = prove + (`!n. ~(EVEN n) <=> ODD n`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ODD]);; + +let NOT_ODD = prove + (`!n. ~(ODD n) <=> EVEN n`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ODD]);; + +let EVEN_OR_ODD = prove + (`!n. EVEN n \/ ODD n`, + INDUCT_TAC THEN REWRITE_TAC[EVEN; ODD; NOT_EVEN; NOT_ODD] THEN + ONCE_REWRITE_TAC[DISJ_SYM] THEN ASM_REWRITE_TAC[]);; + +let EVEN_AND_ODD = prove + (`!n. ~(EVEN n /\ ODD n)`, + REWRITE_TAC[GSYM NOT_EVEN; ITAUT `~(p /\ ~p)`]);; + +let EVEN_ADD = prove + (`!m n. EVEN(m + n) <=> (EVEN m <=> EVEN n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[EVEN; ADD_CLAUSES] THEN + X_GEN_TAC `p:num` THEN + DISJ_CASES_THEN MP_TAC (SPEC `n:num` EVEN_OR_ODD) THEN + DISJ_CASES_THEN MP_TAC (SPEC `p:num` EVEN_OR_ODD) THEN + REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]);; + +let EVEN_MULT = prove + (`!m n. EVEN(m * n) <=> EVEN(m) \/ EVEN(n)`, + INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES; EVEN_ADD; EVEN] THEN + X_GEN_TAC `p:num` THEN + DISJ_CASES_THEN MP_TAC (SPEC `n:num` EVEN_OR_ODD) THEN + DISJ_CASES_THEN MP_TAC (SPEC `p:num` EVEN_OR_ODD) THEN + REWRITE_TAC[GSYM NOT_EVEN] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]);; + +let EVEN_EXP = prove + (`!m n. EVEN(m EXP n) <=> EVEN(m) /\ ~(n = 0)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[EVEN; EXP; ONE; EVEN_MULT; NOT_SUC] THEN + CONV_TAC ITAUT);; + +let ODD_ADD = prove + (`!m n. ODD(m + n) <=> ~(ODD m <=> ODD n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NOT_EVEN; EVEN_ADD] THEN + CONV_TAC ITAUT);; + +let ODD_MULT = prove + (`!m n. ODD(m * n) <=> ODD(m) /\ ODD(n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NOT_EVEN; EVEN_MULT] THEN + CONV_TAC ITAUT);; + +let ODD_EXP = prove + (`!m n. ODD(m EXP n) <=> ODD(m) \/ (n = 0)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ODD; EXP; ONE; ODD_MULT; NOT_SUC] THEN + CONV_TAC ITAUT);; + +let EVEN_DOUBLE = prove + (`!n. EVEN(2 * n)`, + GEN_TAC THEN REWRITE_TAC[EVEN_MULT] THEN DISJ1_TAC THEN + PURE_REWRITE_TAC[BIT0_THM; BIT1_THM] THEN REWRITE_TAC[EVEN; EVEN_ADD]);; + +let ODD_DOUBLE = prove + (`!n. ODD(SUC(2 * n))`, + REWRITE_TAC[ODD] THEN REWRITE_TAC[NOT_ODD; EVEN_DOUBLE]);; + +let EVEN_EXISTS_LEMMA = prove + (`!n. (EVEN n ==> ?m. n = 2 * m) /\ + (~EVEN n ==> ?m. n = SUC(2 * m))`, + INDUCT_TAC THEN REWRITE_TAC[EVEN] THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[MULT_CLAUSES]; + POP_ASSUM STRIP_ASSUME_TAC THEN CONJ_TAC THEN + DISCH_THEN(ANTE_RES_THEN(X_CHOOSE_TAC `m:num`)) THENL + [EXISTS_TAC `SUC m` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MULT_2] THEN REWRITE_TAC[ADD_CLAUSES]; + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]]]);; + +let EVEN_EXISTS = prove + (`!n. EVEN n <=> ?m. n = 2 * m`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MATCH_MP_TAC(CONJUNCT1(SPEC_ALL EVEN_EXISTS_LEMMA)) THEN ASM_REWRITE_TAC[]; + POP_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[EVEN_DOUBLE]]);; + +let ODD_EXISTS = prove + (`!n. ODD n <=> ?m. n = SUC(2 * m)`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MATCH_MP_TAC(CONJUNCT2(SPEC_ALL EVEN_EXISTS_LEMMA)) THEN + ASM_REWRITE_TAC[NOT_EVEN]; + POP_ASSUM(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[ODD_DOUBLE]]);; + +let EVEN_ODD_DECOMPOSITION = prove + (`!n. (?k m. ODD m /\ (n = 2 EXP k * m)) <=> ~(n = 0)`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + DISJ_CASES_TAC(SPEC `n:num` EVEN_OR_ODD) THENL + [ALL_TAC; ASM_MESON_TAC[ODD; EXP; MULT_CLAUSES]] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[MULT_EQ_0] THENL + [REWRITE_TAC[MULT_CLAUSES; LT] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + REWRITE_TAC[EXP_EQ_0; MULT_EQ_0; TWO; NOT_SUC] THEN MESON_TAC[ODD]; + ALL_TAC] THEN + ANTS_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM(el 2 (CONJUNCTS MULT_CLAUSES))] THEN + ASM_REWRITE_TAC[LT_MULT_RCANCEL; TWO; LT]; + ALL_TAC] THEN + REWRITE_TAC[TWO; NOT_SUC] THEN REWRITE_TAC[GSYM TWO] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `SUC k` THEN ASM_REWRITE_TAC[EXP; MULT_ASSOC]);; + +(* ------------------------------------------------------------------------- *) +(* Cutoff subtraction, also defined recursively. (Not the HOL88 defn.) *) +(* ------------------------------------------------------------------------- *) + +let SUB = new_recursive_definition num_RECURSION + `(!m. m - 0 = m) /\ + (!m n. m - (SUC n) = PRE(m - n))`;; + +let SUB_0 = prove + (`!m. (0 - m = 0) /\ (m - 0 = m)`, + REWRITE_TAC[SUB] THEN INDUCT_TAC THEN ASM_REWRITE_TAC[SUB; PRE]);; + +let SUB_PRESUC = prove + (`!m n. PRE(SUC m - n) = m - n`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[SUB; PRE]);; + +let SUB_SUC = prove + (`!m n. SUC m - SUC n = m - n`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[SUB; PRE; SUB_PRESUC]);; + +let SUB_REFL = prove + (`!n. n - n = 0`, + INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_SUC; SUB_0]);; + +let ADD_SUB = prove + (`!m n. (m + n) - n = m`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUB_SUC; SUB_0]);; + +let ADD_SUB2 = prove + (`!m n. (m + n) - m = n`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC ADD_SUB);; + +let SUB_EQ_0 = prove + (`!m n. (m - n = 0) <=> m <= n`, + REPEAT INDUCT_TAC THEN ASM_REWRITE_TAC[SUB_SUC; LE_SUC; SUB_0] THEN + REWRITE_TAC[LE; LE_0]);; + +let ADD_SUBR2 = prove + (`!m n. m - (m + n) = 0`, + REWRITE_TAC[SUB_EQ_0; LE_ADD]);; + +let ADD_SUBR = prove + (`!m n. n - (m + n) = 0`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC ADD_SUBR2);; + +let SUB_ADD = prove + (`!m n. n <= m ==> ((m - n) + n = m)`, + REWRITE_TAC[LE_EXISTS] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB] THEN + MATCH_ACCEPT_TAC ADD_SYM);; + +let SUB_ADD_LCANCEL = prove + (`!m n p. (m + n) - (m + p) = n - p`, + INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; SUB_0; SUB_SUC]);; + +let SUB_ADD_RCANCEL = prove + (`!m n p. (m + p) - (n + p) = m - n`, + ONCE_REWRITE_TAC[ADD_SYM] THEN MATCH_ACCEPT_TAC SUB_ADD_LCANCEL);; + +let LEFT_SUB_DISTRIB = prove + (`!m n p. m * (n - p) = m * n - m * p`, + REPEAT GEN_TAC THEN CONV_TAC SYM_CONV THEN + DISJ_CASES_TAC(SPECL [`n:num`; `p:num`] LE_CASES) THENL + [FIRST_ASSUM(fun th -> REWRITE_TAC[REWRITE_RULE[GSYM SUB_EQ_0] th]) THEN + ASM_REWRITE_TAC[MULT_CLAUSES; SUB_EQ_0; LE_MULT_LCANCEL]; + POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[ADD_SYM] ADD_SUB]]);; + +let RIGHT_SUB_DISTRIB = prove + (`!m n p. (m - n) * p = m * p - n * p`, + ONCE_REWRITE_TAC[MULT_SYM] THEN MATCH_ACCEPT_TAC LEFT_SUB_DISTRIB);; + +let SUC_SUB1 = prove + (`!n. SUC n - 1 = n`, + REWRITE_TAC[ONE; SUB_SUC; SUB_0]);; + +let EVEN_SUB = prove + (`!m n. EVEN(m - n) <=> m <= n \/ (EVEN(m) <=> EVEN(n))`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `m <= n:num` THENL + [ASM_MESON_TAC[SUB_EQ_0; EVEN]; ALL_TAC] THEN + DISJ_CASES_TAC(SPECL [`m:num`; `n:num`] LE_CASES) THEN ASM_SIMP_TAC[] THEN + FIRST_ASSUM(MP_TAC o AP_TERM `EVEN` o MATCH_MP SUB_ADD) THEN + ASM_MESON_TAC[EVEN_ADD]);; + +let ODD_SUB = prove + (`!m n. ODD(m - n) <=> n < m /\ ~(ODD m <=> ODD n)`, + REWRITE_TAC[GSYM NOT_EVEN; EVEN_SUB; DE_MORGAN_THM; NOT_LE] THEN + CONV_TAC TAUT);; + +(* ------------------------------------------------------------------------- *) +(* The factorial function. *) +(* ------------------------------------------------------------------------- *) + +let FACT = new_recursive_definition num_RECURSION + `(FACT 0 = 1) /\ + (!n. FACT (SUC n) = (SUC n) * FACT(n))`;; + +let FACT_LT = prove + (`!n. 0 < FACT n`, + INDUCT_TAC THEN ASM_REWRITE_TAC[FACT; LT_MULT] THEN + REWRITE_TAC[ONE; LT_0]);; + +let FACT_LE = prove + (`!n. 1 <= FACT n`, + REWRITE_TAC[ONE; LE_SUC_LT; FACT_LT]);; + +let FACT_NZ = prove + (`!n. ~(FACT n = 0)`, + REWRITE_TAC[GSYM LT_NZ; FACT_LT]);; + +let FACT_MONO = prove + (`!m n. m <= n ==> FACT m <= FACT n`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; LE_REFL] THEN + REWRITE_TAC[FACT] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `FACT(m + d)` THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(el 2 (CONJUNCTS MULT_CLAUSES))] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN + REWRITE_TAC[ONE; LE_SUC; LE_0]);; + +(* ------------------------------------------------------------------------- *) +(* More complicated theorems about exponential. *) +(* ------------------------------------------------------------------------- *) + +let EXP_LT_0 = prove + (`!n x. 0 < x EXP n <=> ~(x = 0) \/ (n = 0)`, + REWRITE_TAC[GSYM NOT_LE; LE; EXP_EQ_0; DE_MORGAN_THM]);; + +let LT_EXP = prove + (`!x m n. x EXP m < x EXP n <=> 2 <= x /\ m < n \/ + (x = 0) /\ ~(m = 0) /\ (n = 0)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `x = 0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[GSYM NOT_LT; TWO; ONE; LT] THEN + SPEC_TAC (`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; NOT_SUC; MULT_CLAUSES; LT] THEN + SPEC_TAC (`m:num`,`m:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[EXP; MULT_CLAUSES; NOT_SUC; LT_REFL; LT] THEN + REWRITE_TAC[ONE; LT_0]; ALL_TAC] THEN + EQ_TAC THENL + [CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[NOT_LT; DE_MORGAN_THM; NOT_LE] THEN + REWRITE_TAC[TWO; ONE; LT] THEN + ASM_REWRITE_TAC[SYM ONE] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[EXP_ONE; LE_REFL] THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o + REWRITE_RULE[LE_EXISTS]) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; EXP; LE_REFL] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `1 * x EXP (n + d)` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[MULT_CLAUSES]; + REWRITE_TAC[LE_MULT_RCANCEL] THEN + DISJ1_TAC THEN UNDISCH_TAC `~(x = 0)` THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN + REWRITE_TAC[ONE; LT]]; + STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num` SUBST1_TAC o + REWRITE_RULE[LT_EXISTS]) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; EXP] THENL + [MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `2 * x EXP m` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[MULT_2; LT_ADD; EXP_LT_0]; + ASM_REWRITE_TAC[LE_MULT_RCANCEL]]; + MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `x EXP (m + SUC d)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_CLAUSES; EXP; MULT_ASSOC; LE_MULT_RCANCEL] THEN + DISJ1_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `x * 1` THEN CONJ_TAC THENL + [REWRITE_TAC[MULT_CLAUSES; LE_REFL]; + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + UNDISCH_TAC `~(x = 0)` THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN + REWRITE_TAC[ONE; LT]]]]);; + +let LE_EXP = prove + (`!x m n. x EXP m <= x EXP n <=> + if x = 0 then (m = 0) ==> (n = 0) + else (x = 1) \/ m <= n`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM NOT_LT; LT_EXP; DE_MORGAN_THM] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[TWO; LT; ONE] THEN + CONV_TAC(EQT_INTRO o TAUT));; + +let EQ_EXP = prove + (`!x m n. x EXP m = x EXP n <=> + if x = 0 then (m = 0 <=> n = 0) + else (x = 1) \/ m = n`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM LE_ANTISYM; LE_EXP] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LE_EXP] THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN CONV_TAC TAUT);; + +let EXP_MONO_LE_IMP = prove + (`!x y n. x <= y ==> x EXP n <= y EXP n`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN ASM_SIMP_TAC[LE_MULT2; EXP; LE_REFL]);; + +let EXP_MONO_LT_IMP = prove + (`!x y n. x < y /\ ~(n = 0) ==> x EXP n < y EXP n`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; EXP] THEN + DISCH_TAC THEN MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `x * y EXP n` THEN + ASM_SIMP_TAC[LT_IMP_LE; LE_MULT_LCANCEL; LT_MULT_RCANCEL; EXP_MONO_LE_IMP; + EXP_EQ_0] THEN + ASM_MESON_TAC[CONJUNCT1 LT]);; + +let EXP_MONO_LE = prove + (`!x y n. x EXP n <= y EXP n <=> x <= y \/ n = 0`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[EXP; LE_REFL; EXP_MONO_LE_IMP] THEN + ASM_MESON_TAC[NOT_LE; EXP_MONO_LT_IMP]);; + +let EXP_MONO_LT = prove + (`!x y n. x EXP n < y EXP n <=> x < y /\ ~(n = 0)`, + REWRITE_TAC[GSYM NOT_LE; EXP_MONO_LE; DE_MORGAN_THM]);; + +let EXP_MONO_EQ = prove + (`!x y n. x EXP n = y EXP n <=> x = y \/ n = 0`, + REWRITE_TAC[GSYM LE_ANTISYM; EXP_MONO_LE] THEN CONV_TAC TAUT);; + +(* ------------------------------------------------------------------------- *) +(* Division and modulus, via existence proof of their basic property. *) +(* ------------------------------------------------------------------------- *) + +let DIVMOD_EXIST = prove + (`!m n. ~(n = 0) ==> ?q r. (m = q * n + r) /\ r < n`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `\r. ?q. m = q * n + r` num_WOP) THEN + BETA_TAC THEN DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `0`]) THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `q:num`) MP_TAC) THEN + DISCH_THEN(fun th -> + MAP_EVERY EXISTS_TAC [`q:num`; `r:num`] THEN MP_TAC th) THEN + CONV_TAC CONTRAPOS_CONV THEN ASM_REWRITE_TAC[NOT_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o + REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `d:num` THEN + REWRITE_TAC[NOT_IMP; RIGHT_AND_EXISTS_THM] THEN + EXISTS_TAC `q + 1` THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_ASSOC; LT_ADDR] THEN + ASM_REWRITE_TAC[GSYM NOT_LE; LE]);; + +let DIVMOD_EXIST_0 = prove + (`!m n. ?q r. if n = 0 then q = 0 /\ r = m + else m = q * n + r /\ r < n`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_SIMP_TAC[DIVMOD_EXIST; RIGHT_EXISTS_AND_THM; EXISTS_REFL]);; + +let DIVISION_0 = new_specification ["DIV"; "MOD"] + (REWRITE_RULE[SKOLEM_THM] DIVMOD_EXIST_0);; + +let DIVISION = prove + (`!m n. ~(n = 0) ==> (m = m DIV n * n + m MOD n) /\ m MOD n < n`, + MESON_TAC[DIVISION_0]);; + +let DIVISION_SIMP = prove + (`(!m n. ~(n = 0) ==> m DIV n * n + m MOD n = m) /\ + (!m n. ~(n = 0) ==> n * m DIV n + m MOD n = m)`, + MESON_TAC[DIVISION; MULT_SYM]);; + +let DIVMOD_UNIQ_LEMMA = prove + (`!m n q1 r1 q2 r2. ((m = q1 * n + r1) /\ r1 < n) /\ + ((m = q2 * n + r2) /\ r2 < n) + ==> (q1 = q2) /\ (r1 = r2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `r1:num = r2` MP_TAC THENL + [UNDISCH_TAC `m = q2 * n + r2` THEN + ASM_REWRITE_TAC[] THEN + DISJ_CASES_THEN MP_TAC (SPECL [`q1:num`; `q2:num`] LE_CASES) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; EQ_ADD_LCANCEL] THENL + [DISCH_TAC THEN UNDISCH_TAC `r1 < n`; + DISCH_THEN(ASSUME_TAC o SYM) THEN UNDISCH_TAC `r2 < n`] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; + GSYM NOT_LE; LE_ADD; GSYM ADD_ASSOC]; + DISCH_THEN SUBST_ALL_TAC THEN REWRITE_TAC[] THEN + CONV_TAC SYM_CONV THEN + UNDISCH_TAC `m = q1 * n + r2` THEN + ASM_REWRITE_TAC[EQ_ADD_RCANCEL; EQ_MULT_RCANCEL] THEN + REPEAT (UNDISCH_TAC `r2 < n`) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[GSYM NOT_LE; LE_0]]);; + +let DIVMOD_UNIQ = prove + (`!m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q) /\ (m MOD n = r)`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC o GSYM) THEN + MATCH_MP_TAC DIVMOD_UNIQ_LEMMA THEN + MAP_EVERY EXISTS_TAC [`m:num`; `n:num`] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIVISION THEN + DISCH_TAC THEN UNDISCH_TAC `r < n` THEN + ASM_REWRITE_TAC[GSYM NOT_LE; LE_0]);; + +let MOD_UNIQ = prove + (`!m n q r. (m = q * n + r) /\ r < n ==> (m MOD n = r)`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP DIVMOD_UNIQ th]));; + +let DIV_UNIQ = prove + (`!m n q r. (m = q * n + r) /\ r < n ==> (m DIV n = q)`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP DIVMOD_UNIQ th]));; + +let DIV_MULT,MOD_MULT = (CONJ_PAIR o prove) + (`(!m n. ~(m = 0) ==> (m * n) DIV m = n) /\ + (!m n. ~(m = 0) ==> (m * n) MOD m = 0)`, + SIMP_TAC[AND_FORALL_THM; TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIVMOD_UNIQ THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; MULT_AC; LT_NZ]);; + +let MOD_LT = prove + (`!m n. m < n ==> (m MOD n = m)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MOD_UNIQ THEN + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]);; + +let MOD_EQ = prove + (`!m n p q. (m = n + q * p) ==> (m MOD p = n MOD p)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `p = 0` THENL + [ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC; + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC MOD_UNIQ THEN + EXISTS_TAC `q + n DIV p` THEN + POP_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM o SPEC `n:num`) THEN + ASM_REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN + MATCH_ACCEPT_TAC ADD_SYM]);; + +let DIV_LE = prove + (`!m n. ~(n = 0) ==> m DIV n <= m`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [MATCH_MP DIVISION th]) THEN + UNDISCH_TAC `~(n = 0)` THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; GSYM ADD_ASSOC; LE_ADD]);; + +let DIV_MUL_LE = prove + (`!m n. n * (m DIV n) <= m`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LE_0] THEN + POP_ASSUM(MP_TAC o SPEC `m:num` o MATCH_MP DIVISION) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [CONJUNCT1 th]) THEN + REWRITE_TAC[LE_ADD; MULT_AC]);; + +let DIV_0,MOD_0 = (CONJ_PAIR o prove) + (`(!n. ~(n = 0) ==> 0 DIV n = 0) /\ + (!n. ~(n = 0) ==> 0 MOD n = 0)`, + SIMP_TAC[AND_FORALL_THM; TAUT `(a ==> b) /\ (a ==> c) <=> a ==> b /\ c`] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC DIVMOD_UNIQ THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LT_NZ]);; + +let DIV_1,MOD_1 = (CONJ_PAIR o prove) + (`(!n. n DIV 1 = n) /\ (!n. n MOD 1 = 0)`, + SIMP_TAC[AND_FORALL_THM] THEN GEN_TAC THEN MATCH_MP_TAC DIVMOD_UNIQ THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN REWRITE_TAC[ONE; LT]);; + +let DIV_LT = prove + (`!m n. m < n ==> (m DIV n = 0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `m:num` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]);; + +let MOD_MOD = prove + (`!m n p. ~(n * p = 0) ==> ((m MOD (n * p)) MOD n = m MOD n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN STRIP_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN + EXISTS_TAC `m DIV (n * p) * p` THEN + MP_TAC(SPECL [`m:num`; `n * p:num`] DIVISION) THEN + ASM_REWRITE_TAC[MULT_EQ_0; MULT_AC; ADD_AC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]));; + +let MOD_MOD_REFL = prove + (`!m n. ~(n = 0) ==> ((m MOD n) MOD n = m MOD n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`m:num`; `n:num`; `1`] MOD_MOD) THEN + ASM_REWRITE_TAC[MULT_CLAUSES; MULT_EQ_0] THEN + REWRITE_TAC[ONE; NOT_SUC]);; + +let DIV_MULT2 = prove + (`!m n p. ~(m * p = 0) ==> ((m * n) DIV (m * p) = n DIV p)`, + REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `m * (n MOD p)` THEN + ASM_SIMP_TAC[LT_MULT_LCANCEL; DIVISION] THEN + ONCE_REWRITE_TAC[AC MULT_AC `a * b * c:num = b * a * c`] THEN + REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; EQ_MULT_LCANCEL] THEN + ASM_SIMP_TAC[GSYM DIVISION]);; + +let MOD_MULT2 = prove + (`!m n p. ~(m * p = 0) ==> ((m * n) MOD (m * p) = m * n MOD p)`, + REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `n DIV p` THEN + ASM_SIMP_TAC[LT_MULT_LCANCEL; DIVISION] THEN + ONCE_REWRITE_TAC[AC MULT_AC `a * b * c:num = b * a * c`] THEN + REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; EQ_MULT_LCANCEL] THEN + ASM_SIMP_TAC[GSYM DIVISION]);; + +let MOD_EXISTS = prove + (`!m n. (?q. m = n * q) <=> if n = 0 then (m = 0) else (m MOD n = 0)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[MOD_MULT] THEN + EXISTS_TAC `m DIV n` THEN + SUBGOAL_THEN `m = (m DIV n) * n + m MOD n` + (fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THENL + [ASM_MESON_TAC[DIVISION]; ASM_REWRITE_TAC[ADD_CLAUSES; MULT_AC]]);; + +let LE_RDIV_EQ = prove + (`!a b n. ~(a = 0) ==> (n <= b DIV a <=> a * n <= b)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `a * (b DIV a)` THEN + ASM_REWRITE_TAC[DIV_MUL_LE; LE_MULT_LCANCEL]; + SUBGOAL_THEN `a * n < a * (b DIV a + 1)` MP_TAC THENL + [MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `(b DIV a) * a + b MOD a` THEN + CONJ_TAC THENL [ASM_MESON_TAC[DIVISION]; ALL_TAC] THEN + SIMP_TAC[LEFT_ADD_DISTRIB; MULT_SYM; MULT_CLAUSES; LT_ADD_LCANCEL] THEN + ASM_MESON_TAC[DIVISION]; + ASM_REWRITE_TAC[LT_MULT_LCANCEL; GSYM ADD1; LT_SUC_LE]]]);; + +let LE_LDIV_EQ = prove + (`!a b n. ~(a = 0) ==> (b DIV a <= n <=> b < a * (n + 1))`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NOT_LT] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM LE_SUC_LT] THEN + ASM_SIMP_TAC[LE_RDIV_EQ] THEN REWRITE_TAC[NOT_LT; NOT_LE; ADD1]);; + +let LE_LDIV = prove + (`!a b n. ~(a = 0) /\ b <= a * n ==> b DIV a <= n`, + SIMP_TAC[LE_LDIV_EQ; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN + MESON_TAC[LT_ADD; LT_NZ; LET_TRANS]);; + +let DIV_MONO = prove + (`!m n p. ~(p = 0) /\ m <= n ==> m DIV p <= n DIV p`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MESON[LE_REFL] `(!k:num. k <= a ==> k <= b) ==> a <= b`) THEN + ASM_SIMP_TAC[LE_RDIV_EQ] THEN ASM_MESON_TAC[LE_TRANS]);; + +let DIV_MONO_LT = prove + (`!m n p. ~(p = 0) /\ m + p <= n ==> m DIV p < n DIV p`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[ADD1; LE_SUC_LT; LE_REFL] + `(!k:num. k <= a ==> k + 1 <= b) ==> a < b`) THEN + ASM_SIMP_TAC[LE_RDIV_EQ; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN + ASM_MESON_TAC[LE_REFL; LE_TRANS; LE_ADD2; ADD_SYM]);; + +let DIV_EQ_0 = prove + (`!m n. ~(n = 0) ==> ((m DIV n = 0) <=> m < n)`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [FIRST_ASSUM(SUBST1_TAC o CONJUNCT1 o SPEC `m:num` o MATCH_MP DIVISION) THEN + ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVISION]; + MATCH_MP_TAC DIV_UNIQ THEN EXISTS_TAC `m:num` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]]);; + +let MOD_EQ_0 = prove + (`!m n. ~(n = 0) ==> ((m MOD n = 0) <=> (?q. m = q * n))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [FIRST_ASSUM(SUBST1_TAC o CONJUNCT1 o SPEC `m:num` o MATCH_MP DIVISION) THEN + ASM_SIMP_TAC[MULT_CLAUSES; ADD_CLAUSES; DIVISION] THEN MESON_TAC[]; + MATCH_MP_TAC MOD_UNIQ THEN ASM_SIMP_TAC[ADD_CLAUSES; MULT_AC] THEN + ASM_MESON_TAC[NOT_LE; CONJUNCT1 LE]]);; + +let MOD_REFL = prove + (`!n. ~(n = 0) ==> n MOD n = 0`, + SIMP_TAC[MOD_EQ_0] THEN MESON_TAC[MULT_CLAUSES]);; + +let EVEN_MOD = prove + (`!n. EVEN(n) <=> (n MOD 2 = 0)`, + GEN_TAC THEN REWRITE_TAC[EVEN_EXISTS] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + MATCH_MP_TAC(GSYM MOD_EQ_0) THEN REWRITE_TAC[TWO; NOT_SUC]);; + +let ODD_MOD = prove + (`!n. ODD(n) <=> (n MOD 2 = 1)`, + GEN_TAC THEN REWRITE_TAC[GSYM NOT_EVEN; EVEN_MOD] THEN + SUBGOAL_THEN `n MOD 2 < 2` MP_TAC THENL + [SIMP_TAC[DIVISION; TWO; NOT_SUC]; ALL_TAC] THEN + SPEC_TAC(`n MOD 2`,`n:num`) THEN + REWRITE_TAC[TWO; ONE; LT] THEN MESON_TAC[NOT_SUC]);; + +let MOD_MULT_RMOD = prove + (`!m n p. ~(n = 0) ==> ((m * (p MOD n)) MOD n = (m * p) MOD n)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN + EXISTS_TAC `m * p DIV n` THEN + REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[EQ_MULT_LCANCEL] THEN DISJ2_TAC THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_SIMP_TAC[DIVISION]);; + +let MOD_MULT_LMOD = prove + (`!m n p. ~(n = 0) ==> (((m MOD n) * p) MOD n = (m * p) MOD n)`, + ONCE_REWRITE_TAC[MULT_SYM] THEN SIMP_TAC[MOD_MULT_RMOD]);; + +let MOD_MULT_MOD2 = prove + (`!m n p. ~(n = 0) ==> (((m MOD n) * (p MOD n)) MOD n = (m * p) MOD n)`, + SIMP_TAC[MOD_MULT_RMOD; MOD_MULT_LMOD]);; + +let MOD_EXP_MOD = prove + (`!m n p. ~(n = 0) ==> (((m MOD n) EXP p) MOD n = (m EXP p) MOD n)`, + REPEAT STRIP_TAC THEN SPEC_TAC(`p:num`,`p:num`) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[EXP] THEN ASM_SIMP_TAC[MOD_MULT_LMOD] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(m * ((m MOD n) EXP p) MOD n) MOD n` THEN CONJ_TAC THENL + [ALL_TAC; ASM_REWRITE_TAC[]] THEN + ASM_SIMP_TAC[MOD_MULT_RMOD]);; + +let MOD_MULT_ADD = prove + (`!m n p. (m * n + p) MOD n = p MOD n`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + MATCH_MP_TAC MOD_UNIQ THEN EXISTS_TAC `m + p DIV n` THEN + ASM_SIMP_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; EQ_ADD_LCANCEL; DIVISION]);; + +let DIV_MULT_ADD = prove + (`!a b n. ~(n = 0) ==> (a * n + b) DIV n = a + b DIV n`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN + EXISTS_TAC `b MOD n` THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN + ASM_MESON_TAC[DIVISION]);; + +let MOD_ADD_MOD = prove + (`!a b n. ~(n = 0) ==> ((a MOD n + b MOD n) MOD n = (a + b) MOD n)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC MOD_EQ THEN + EXISTS_TAC `a DIV n + b DIV n` THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + (c + d) = (c + a) + (d + b)`] THEN + BINOP_TAC THEN ASM_SIMP_TAC[DIVISION]);; + +let DIV_ADD_MOD = prove + (`!a b n. ~(n = 0) + ==> (((a + b) MOD n = a MOD n + b MOD n) <=> + ((a + b) DIV n = a DIV n + b DIV n))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN + DISCH_THEN(fun th -> MAP_EVERY (MP_TAC o CONJUNCT1 o C SPEC th) + [`a + b:num`; `a:num`; `b:num`]) THEN + DISCH_THEN(fun th1 -> DISCH_THEN(fun th2 -> + MP_TAC(MK_COMB(AP_TERM `(+)` th2,th1)))) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (funpow 2 LAND_CONV) [th]) THEN + ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + c + d = (a + c) + (b + d)`] THEN + REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN + DISCH_THEN(fun th -> EQ_TAC THEN DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[EQ_ADD_RCANCEL; EQ_ADD_LCANCEL; EQ_MULT_RCANCEL] THEN + REWRITE_TAC[EQ_SYM_EQ]);; + +let DIV_REFL = prove + (`!n. ~(n = 0) ==> (n DIV n = 1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIV_UNIQ THEN + EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + POP_ASSUM MP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[LT_0]);; + +let MOD_LE = prove + (`!m n. ~(n = 0) ==> m MOD n <= m`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV + [MATCH_MP DIVISION th]) THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[LE_ADD]);; + +let DIV_MONO2 = prove + (`!m n p. ~(p = 0) /\ p <= m ==> n DIV m <= n DIV p`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LE_RDIV_EQ] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `m * n DIV m` THEN + ASM_REWRITE_TAC[LE_MULT_RCANCEL] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN ASM_MESON_TAC[LE_ADD; LE]);; + +let DIV_LE_EXCLUSION = prove + (`!a b c d. ~(b = 0) /\ b * c < (a + 1) * d ==> c DIV d <= a DIV b`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `d = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LT] THEN STRIP_TAC THEN + MATCH_MP_TAC(MESON[LE_REFL] `(!k:num. k <= a ==> k <= b) ==> a <= b`) THEN + X_GEN_TAC `k:num` THEN + SUBGOAL_THEN `b * d * k <= b * c ==> (b * k) * d < (a + 1) * d` MP_TAC THENL + [ASM_MESON_TAC[LET_TRANS; MULT_AC]; ALL_TAC] THEN + MATCH_MP_TAC MONO_IMP THEN + ASM_SIMP_TAC[LE_MULT_LCANCEL; LT_MULT_RCANCEL; LE_RDIV_EQ] THEN + REWRITE_TAC[GSYM ADD1; LT_SUC_LE]);; + +let DIV_EQ_EXCLUSION = prove + (`b * c < (a + 1) * d /\ a * d < (c + 1) * b ==> (a DIV b = c DIV d)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `b = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT] THEN + ASM_CASES_TAC `d = 0` THEN ASM_REWRITE_TAC[MULT_CLAUSES; LT] THEN + ASM_MESON_TAC[MULT_SYM; LE_ANTISYM; DIV_LE_EXCLUSION]);; + +let MULT_DIV_LE = prove + (`!m n p. ~(p = 0) ==> m * (n DIV p) <= (m * n) DIV p`, + REPEAT GEN_TAC THEN SIMP_TAC[LE_RDIV_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `n:num` o MATCH_MP DIVISION) THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [CONJUNCT1 th]) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB] THEN REWRITE_TAC[MULT_AC; LE_ADD]);; + +let DIV_DIV = prove + (`!m n p. ~(n * p = 0) ==> ((m DIV n) DIV p = m DIV (n * p))`, + REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MESON[LE_ANTISYM] `(!k. k <= m <=> k <= n) ==> m = n`) THEN + ASM_SIMP_TAC[LE_RDIV_EQ; MULT_EQ_0; MULT_ASSOC]);; + +let DIV_MOD = prove + (`!m n p. ~(n * p = 0) ==> ((m DIV n) MOD p = (m MOD (n * p)) DIV n)`, + REWRITE_TAC[MULT_EQ_0; DE_MORGAN_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MESON[LE_ANTISYM] `(!k. k <= m <=> k <= n) ==> m = n`) THEN + X_GEN_TAC `k:num` THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `k + p * ((m DIV n) DIV p) <= (m DIV n)` THEN CONJ_TAC THENL + [MP_TAC(SPECL [`m DIV n`; `p:num`] DIVISION) THEN ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`m:num`; `n * p:num`] DIVISION) THEN + ASM_SIMP_TAC[LE_RDIV_EQ; MULT_EQ_0; DIV_DIV; LEFT_ADD_DISTRIB]] THEN + REWRITE_TAC[MULT_AC] THEN MESON_TAC[ADD_SYM; MULT_SYM; LE_ADD_RCANCEL]);; + +let MOD_MOD_EXP_MIN = prove + (`!x p m n. ~(p = 0) + ==> x MOD (p EXP m) MOD (p EXP n) = x MOD (p EXP (MIN m n))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[MIN] THEN + ASM_CASES_TAC `m:num <= n` THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + MATCH_MP_TAC MOD_LT THEN MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `p EXP m` THEN + ASM_SIMP_TAC[DIVISION; EXP_EQ_0; LE_EXP; LE_ADD]; + SUBGOAL_THEN `?d. m = n + d` (CHOOSE_THEN SUBST1_TAC) THENL + [ASM_MESON_TAC[LE_CASES; LE_EXISTS]; + ASM_SIMP_TAC[EXP_ADD; MOD_MOD; MULT_EQ_0; EXP_EQ_0]]]);; + +(* ------------------------------------------------------------------------- *) +(* Theorems for eliminating cutoff subtraction, predecessor, DIV and MOD. *) +(* We have versions that introduce universal or existential quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let PRE_ELIM_THM = prove + (`P(PRE n) <=> !m. n = SUC m \/ m = 0 /\ n = 0 ==> P m`, + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[NOT_SUC; SUC_INJ; PRE] THEN MESON_TAC[]);; + +let PRE_ELIM_THM' = prove + (`P(PRE n) <=> ?m. (n = SUC m \/ m = 0 /\ n = 0) /\ P m`, + MP_TAC(INST [`\x:num. ~P x`,`P:num->bool`] PRE_ELIM_THM) THEN MESON_TAC[]);; + +let SUB_ELIM_THM = prove + (`P(a - b) <=> !d. a = b + d \/ a < b /\ d = 0 ==> P d`, + DISJ_CASES_TAC(SPECL [`a:num`; `b:num`] LTE_CASES) THENL + [ASM_MESON_TAC[NOT_LT; SUB_EQ_0; LT_IMP_LE; LE_ADD]; ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_THEN `e:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + SIMP_TAC[ADD_SUB2; GSYM NOT_LE; LE_ADD; EQ_ADD_LCANCEL] THEN MESON_TAC[]);; + +let SUB_ELIM_THM' = prove + (`P(a - b) <=> ?d. (a = b + d \/ a < b /\ d = 0) /\ P d`, + MP_TAC(INST [`\x:num. ~P x`,`P:num->bool`] SUB_ELIM_THM) THEN MESON_TAC[]);; + +let DIVMOD_ELIM_THM = prove + (`P (m DIV n) (m MOD n) <=> + !q r. n = 0 /\ q = 0 /\ r = m \/ m = q * n + r /\ r < n ==> P q r`, + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[DIVISION_0; LT]; + FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN MESON_TAC[DIVMOD_UNIQ]]);; + +let DIVMOD_ELIM_THM' = prove + (`P (m DIV n) (m MOD n) <=> + ?q r. (n = 0 /\ q = 0 /\ r = m \/ m = q * n + r /\ r < n) /\ P q r`, + MP_TAC(INST [`\x:num y:num. ~P x y`,`P:num->num->bool`] DIVMOD_ELIM_THM) THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Crude but useful conversion for cancelling down equations. *) +(* ------------------------------------------------------------------------- *) + +let NUM_CANCEL_CONV = + let rec minter i l1' l2' l1 l2 = + if l1 = [] then (i,l1',l2'@l2) + else if l2 = [] then (i,l1@l1',l2') else + let h1 = hd l1 and h2 = hd l2 in + if h1 = h2 then minter (h1::i) l1' l2' (tl l1) (tl l2) + else if h1 < h2 then minter i (h1::l1') l2' (tl l1) l2 + else minter i l1' (h2::l2') l1 (tl l2) in + let add_tm = `(+)` and eq_tm = `(=) :num->num->bool` in + let EQ_ADD_LCANCEL_0' = + GEN_REWRITE_RULE (funpow 2 BINDER_CONV o LAND_CONV) [EQ_SYM_EQ] + EQ_ADD_LCANCEL_0 in + let AC_RULE = AC ADD_AC in + fun tm -> + let l,r = dest_eq tm in + let lats = sort (<=) (binops `(+)` l) + and rats = sort (<=) (binops `(+)` r) in + let i,lats',rats' = minter [] [] [] lats rats in + let l' = list_mk_binop add_tm (i @ lats') + and r' = list_mk_binop add_tm (i @ rats') in + let lth = AC_RULE (mk_eq(l,l')) + and rth = AC_RULE (mk_eq(r,r')) in + let eth = MK_COMB(AP_TERM eq_tm lth,rth) in + GEN_REWRITE_RULE (RAND_CONV o REPEATC) + [EQ_ADD_LCANCEL; EQ_ADD_LCANCEL_0; EQ_ADD_LCANCEL_0'] eth;; + +(* ------------------------------------------------------------------------- *) +(* This is handy for easing MATCH_MP on inequalities. *) +(* ------------------------------------------------------------------------- *) + +let LE_IMP = + let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] LE_TRANS in + fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));; + +(* ------------------------------------------------------------------------- *) +(* Binder for "the minimal n such that". *) +(* ------------------------------------------------------------------------- *) + +parse_as_binder "minimal";; + +let minimal = new_definition + `(minimal) (P:num->bool) = @n. P n /\ !m. m < n ==> ~(P m)`;; + +let MINIMAL = prove + (`!P. (?n. P n) <=> P((minimal) P) /\ (!m. m < (minimal) P ==> ~(P m))`, + GEN_TAC THEN REWRITE_TAC[minimal] THEN CONV_TAC(RAND_CONV SELECT_CONV) THEN + REWRITE_TAC[GSYM num_WOP]);; + +(* ------------------------------------------------------------------------- *) +(* A common lemma for transitive relations. *) +(* ------------------------------------------------------------------------- *) + +let TRANSITIVE_STEPWISE_LT_EQ = prove + (`!R. (!x y z. R x y /\ R y z ==> R x z) + ==> ((!m n. m < n ==> R m n) <=> (!n. R n (SUC n)))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[LT] THEN + DISCH_TAC THEN SIMP_TAC[LT_EXISTS; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; ADD_CLAUSES] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN ASM_MESON_TAC[]);; + +let TRANSITIVE_STEPWISE_LT = prove + (`!R. (!x y z. R x y /\ R y z ==> R x z) /\ (!n. R n (SUC n)) + ==> !m n. m < n ==> R m n`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(a ==> (c <=> b)) ==> a /\ b ==> c`) THEN + MATCH_ACCEPT_TAC TRANSITIVE_STEPWISE_LT_EQ);; + +let TRANSITIVE_STEPWISE_LE_EQ = prove + (`!R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) + ==> ((!m n. m <= n ==> R m n) <=> (!n. R n (SUC n)))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[LE; LE_REFL] THEN + + DISCH_TAC THEN SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL; ADD_CLAUSES] THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN ASM_MESON_TAC[]);; + +let TRANSITIVE_STEPWISE_LE = prove + (`!R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) /\ + (!n. R n (SUC n)) + ==> !m n. m <= n ==> R m n`, + REPEAT GEN_TAC THEN MATCH_MP_TAC(TAUT + `(a /\ a' ==> (c <=> b)) ==> a /\ a' /\ b ==> c`) THEN + MATCH_ACCEPT_TAC TRANSITIVE_STEPWISE_LE_EQ);; + +(* ------------------------------------------------------------------------- *) +(* A couple of forms of Dependent Choice. *) +(* ------------------------------------------------------------------------- *) + +let DEPENDENT_CHOICE_FIXED = prove + (`!P R a:A. + P 0 a /\ (!n x. P n x ==> ?y. P (SUC n) y /\ R n x y) + ==> ?f. f 0 = a /\ (!n. P n (f n)) /\ (!n. R n (f n) (f(SUC n)))`, + REPEAT STRIP_TAC THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `f 0 = (a:A) /\ (!n. f(SUC n) = @y. P (SUC n) y /\ R n (f n) y)` THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN GEN_REWRITE_TAC LAND_CONV + [MESON[num_CASES] `(!n. P n) <=> P 0 /\ !n. P(SUC n)`] THEN + ASM_REWRITE_TAC[AND_FORALL_THM] THEN INDUCT_TAC THEN ASM_MESON_TAC[]);; + +let DEPENDENT_CHOICE = prove + (`!P R:num->A->A->bool. + (?a. P 0 a) /\ (!n x. P n x ==> ?y. P (SUC n) y /\ R n x y) + ==> ?f. (!n. P n (f n)) /\ (!n. R n (f n) (f(SUC n)))`, + MESON_TAC[DEPENDENT_CHOICE_FIXED]);; diff --git a/basics.ml b/basics.ml new file mode 100644 index 0000000..b6ad939 --- /dev/null +++ b/basics.ml @@ -0,0 +1,427 @@ +(* ========================================================================= *) +(* More syntax constructors, and prelogical utilities like matching. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "fusion.ml";; + +(* ------------------------------------------------------------------------- *) +(* Create probably-fresh variable *) +(* ------------------------------------------------------------------------- *) + +let genvar = + let gcounter = ref 0 in + fun ty -> let count = !gcounter in + (gcounter := count + 1; + mk_var("_"^(string_of_int count),ty));; + +(* ------------------------------------------------------------------------- *) +(* Convenient functions for manipulating types. *) +(* ------------------------------------------------------------------------- *) + +let dest_fun_ty ty = + match ty with + Tyapp("fun",[ty1;ty2]) -> (ty1,ty2) + | _ -> failwith "dest_fun_ty";; + +let rec occurs_in ty bigty = + bigty = ty or + is_type bigty & exists (occurs_in ty) (snd(dest_type bigty));; + +let rec tysubst alist ty = + try rev_assoc ty alist with Failure _ -> + if is_vartype ty then ty else + let tycon,tyvars = dest_type ty in + mk_type(tycon,map (tysubst alist) tyvars);; + +(* ------------------------------------------------------------------------- *) +(* A bit more syntax. *) +(* ------------------------------------------------------------------------- *) + +let bndvar tm = + try fst(dest_abs tm) + with Failure _ -> failwith "bndvar: Not an abstraction";; + +let body tm = + try snd(dest_abs tm) + with Failure _ -> failwith "body: Not an abstraction";; + +let list_mk_comb(h,t) = rev_itlist (C (curry mk_comb)) t h;; + +let list_mk_abs(vs,bod) = itlist (curry mk_abs) vs bod;; + +let strip_comb = rev_splitlist dest_comb;; + +let strip_abs = splitlist dest_abs;; + +(* ------------------------------------------------------------------------- *) +(* Generic syntax to deal with some binary operators. *) +(* *) +(* Note that "mk_binary" only works for monomorphic functions. *) +(* ------------------------------------------------------------------------- *) + +let is_binary s tm = + match tm with + Comb(Comb(Const(s',_),_),_) -> s' = s + | _ -> false;; + +let dest_binary s tm = + match tm with + Comb(Comb(Const(s',_),l),r) when s' = s -> (l,r) + | _ -> failwith "dest_binary";; + +let mk_binary s = + let c = mk_const(s,[]) in + fun (l,r) -> try mk_comb(mk_comb(c,l),r) + with Failure _ -> failwith "mk_binary";; + +(* ------------------------------------------------------------------------- *) +(* Produces a sequence of variants, considering previous inventions. *) +(* ------------------------------------------------------------------------- *) + +let rec variants av vs = + if vs = [] then [] else + let vh = variant av (hd vs) in vh::(variants (vh::av) (tl vs));; + +(* ------------------------------------------------------------------------- *) +(* Gets all variables (free and/or bound) in a term. *) +(* ------------------------------------------------------------------------- *) + +let variables = + let rec vars(acc,tm) = + if is_var tm then insert tm acc + else if is_const tm then acc + else if is_abs tm then + let v,bod = dest_abs tm in + vars(insert v acc,bod) + else + let l,r = dest_comb tm in + vars(vars(acc,l),r) in + fun tm -> vars([],tm);; + +(* ------------------------------------------------------------------------- *) +(* General substitution (for any free expression). *) +(* ------------------------------------------------------------------------- *) + +let subst = + let rec ssubst ilist tm = + if ilist = [] then tm else + try fst (find ((aconv tm) o snd) ilist) with Failure _ -> + match tm with + Comb(f,x) -> let f' = ssubst ilist f and x' = ssubst ilist x in + if f' == f & x' == x then tm else mk_comb(f',x') + | Abs(v,bod) -> + let ilist' = filter (not o (vfree_in v) o snd) ilist in + mk_abs(v,ssubst ilist' bod) + | _ -> tm in + fun ilist -> + let theta = filter (fun (s,t) -> Pervasives.compare s t <> 0) ilist in + if theta = [] then (fun tm -> tm) else + let ts,xs = unzip theta in + fun tm -> + let gs = variants (variables tm) (map (genvar o type_of) xs) in + let tm' = ssubst (zip gs xs) tm in + if tm' == tm then tm else vsubst (zip ts gs) tm';; + +(* ------------------------------------------------------------------------- *) +(* Alpha conversion term operation. *) +(* ------------------------------------------------------------------------- *) + +let alpha v tm = + let v0,bod = try dest_abs tm + with Failure _ -> failwith "alpha: Not an abstraction"in + if v = v0 then tm else + if type_of v = type_of v0 & not (vfree_in v bod) then + mk_abs(v,vsubst[v,v0]bod) + else failwith "alpha: Invalid new variable";; + +(* ------------------------------------------------------------------------- *) +(* Type matching. *) +(* ------------------------------------------------------------------------- *) + +let rec type_match vty cty sofar = + if is_vartype vty then + try if rev_assoc vty sofar = cty then sofar else failwith "type_match" + with Failure "find" -> (cty,vty)::sofar + else + let vop,vargs = dest_type vty and cop,cargs = dest_type cty in + if vop = cop then itlist2 type_match vargs cargs sofar + else failwith "type_match";; + +(* ------------------------------------------------------------------------- *) +(* Conventional matching version of mk_const (but with a sanity test). *) +(* ------------------------------------------------------------------------- *) + +let mk_mconst(c,ty) = + try let uty = get_const_type c in + let mat = type_match uty ty [] in + let con = mk_const(c,mat) in + if type_of con = ty then con else fail() + with Failure _ -> failwith "mk_const: generic type cannot be instantiated";; + +(* ------------------------------------------------------------------------- *) +(* Like mk_comb, but instantiates type variables in rator if necessary. *) +(* ------------------------------------------------------------------------- *) + +let mk_icomb(tm1,tm2) = + let "fun",[ty;_] = dest_type (type_of tm1) in + let tyins = type_match ty (type_of tm2) [] in + mk_comb(inst tyins tm1,tm2);; + +(* ------------------------------------------------------------------------- *) +(* Instantiates types for constant c and iteratively makes combination. *) +(* ------------------------------------------------------------------------- *) + +let list_mk_icomb cname args = + let atys,_ = nsplit dest_fun_ty args (get_const_type cname) in + let tyin = itlist2 (fun g a -> type_match g (type_of a)) atys args [] in + list_mk_comb(mk_const(cname,tyin),args);; + +(* ------------------------------------------------------------------------- *) +(* Free variables in assumption list and conclusion of a theorem. *) +(* ------------------------------------------------------------------------- *) + +let thm_frees th = + let asl,c = dest_thm th in + itlist (union o frees) asl (frees c);; + +(* ------------------------------------------------------------------------- *) +(* Is one term free in another? *) +(* ------------------------------------------------------------------------- *) + +let rec free_in tm1 tm2 = + if aconv tm1 tm2 then true + else if is_comb tm2 then + let l,r = dest_comb tm2 in free_in tm1 l or free_in tm1 r + else if is_abs tm2 then + let bv,bod = dest_abs tm2 in + not (vfree_in bv tm1) & free_in tm1 bod + else false;; + +(* ------------------------------------------------------------------------- *) +(* Searching for terms. *) +(* ------------------------------------------------------------------------- *) + +let rec find_term p tm = + if p tm then tm else + if is_abs tm then find_term p (body tm) else + if is_comb tm then + let l,r = dest_comb tm in + try find_term p l with Failure _ -> find_term p r + else failwith "find_term";; + +let find_terms = + let rec accum tl p tm = + let tl' = if p tm then insert tm tl else tl in + if is_abs tm then + accum tl' p (body tm) + else if is_comb tm then + accum (accum tl' p (rator tm)) p (rand tm) + else tl' in + accum [];; + +(* ------------------------------------------------------------------------- *) +(* General syntax for binders. *) +(* *) +(* NB! The "mk_binder" function expects polytype "A", which is the domain. *) +(* ------------------------------------------------------------------------- *) + +let is_binder s tm = + match tm with + Comb(Const(s',_),Abs(_,_)) -> s' = s + | _ -> false;; + +let dest_binder s tm = + match tm with + Comb(Const(s',_),Abs(x,t)) when s' = s -> (x,t) + | _ -> failwith "dest_binder";; + +let mk_binder op = + let c = mk_const(op,[]) in + fun (v,tm) -> mk_comb(inst [type_of v,aty] c,mk_abs(v,tm));; + +(* ------------------------------------------------------------------------- *) +(* Syntax for binary operators. *) +(* ------------------------------------------------------------------------- *) + +let is_binop op tm = + match tm with + Comb(Comb(op',_),_) -> op' = op + | _ -> false;; + +let dest_binop op tm = + match tm with + Comb(Comb(op',l),r) when op' = op -> (l,r) + | _ -> failwith "dest_binop";; + +let mk_binop op tm1 = + let f = mk_comb(op,tm1) in + fun tm2 -> mk_comb(f,tm2);; + +let list_mk_binop op = end_itlist (mk_binop op);; + +let binops op = striplist (dest_binop op);; + +(* ------------------------------------------------------------------------- *) +(* Some common special cases *) +(* ------------------------------------------------------------------------- *) + +let is_conj = is_binary "/\\";; +let dest_conj = dest_binary "/\\";; +let conjuncts = striplist dest_conj;; + +let is_imp = is_binary "==>";; +let dest_imp = dest_binary "==>";; + +let is_forall = is_binder "!";; +let dest_forall = dest_binder "!";; +let strip_forall = splitlist dest_forall;; + +let is_exists = is_binder "?";; +let dest_exists = dest_binder "?";; +let strip_exists = splitlist dest_exists;; + +let is_disj = is_binary "\\/";; +let dest_disj = dest_binary "\\/";; +let disjuncts = striplist dest_disj;; + +let is_neg tm = + try fst(dest_const(rator tm)) = "~" + with Failure _ -> false;; + +let dest_neg tm = + try let n,p = dest_comb tm in + if fst(dest_const n) = "~" then p else fail() + with Failure _ -> failwith "dest_neg";; + +let is_uexists = is_binder "?!";; +let dest_uexists = dest_binder "?!";; + +let dest_cons = dest_binary "CONS";; +let is_cons = is_binary "CONS";; +let dest_list tm = + try let tms,nil = splitlist dest_cons tm in + if fst(dest_const nil) = "NIL" then tms else fail() + with Failure _ -> failwith "dest_list";; +let is_list = can dest_list;; + +(* ------------------------------------------------------------------------- *) +(* Syntax for numerals. *) +(* ------------------------------------------------------------------------- *) + +let dest_numeral = + let rec dest_num tm = + if try fst(dest_const tm) = "_0" with Failure _ -> false then num_0 else + let l,r = dest_comb tm in + let n = num_2 */ dest_num r in + let cn = fst(dest_const l) in + if cn = "BIT0" then n + else if cn = "BIT1" then n +/ num_1 + else fail() in + fun tm -> try let l,r = dest_comb tm in + if fst(dest_const l) = "NUMERAL" then dest_num r else fail() + with Failure _ -> failwith "dest_numeral";; + +(* ------------------------------------------------------------------------- *) +(* Syntax for generalized abstractions. *) +(* *) +(* These are here because they are used by the preterm->term translator; *) +(* preterms regard generalized abstractions as an atomic notion. This is *) +(* slightly unclean --- for example we need locally some operations on *) +(* universal quantifiers --- but probably simplest. It has to go somewhere! *) +(* ------------------------------------------------------------------------- *) + +let dest_gabs = + let dest_geq = dest_binary "GEQ" in + fun tm -> + try if is_abs tm then dest_abs tm else + let l,r = dest_comb tm in + if not (fst(dest_const l) = "GABS") then fail() else + let ltm,rtm = dest_geq(snd(strip_forall(body r))) in + rand ltm,rtm + with Failure _ -> failwith "dest_gabs: Not a generalized abstraction";; + +let is_gabs = can dest_gabs;; + +let mk_gabs = + let mk_forall(v,t) = + let cop = mk_const("!",[type_of v,aty]) in + mk_comb(cop,mk_abs(v,t)) in + let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in + let mk_geq(t1,t2) = + let p = mk_const("GEQ",[type_of t1,aty]) in + mk_comb(mk_comb(p,t1),t2) in + fun (tm1,tm2) -> + if is_var tm1 then mk_abs(tm1,tm2) else + let fvs = frees tm1 in + let fty = mk_fun_ty (type_of tm1) (type_of tm2) in + let f = variant (frees tm1 @ frees tm2) (mk_var("f",fty)) in + let bod = mk_abs(f,list_mk_forall(fvs,mk_geq(mk_comb(f,tm1),tm2))) in + mk_comb(mk_const("GABS",[fty,aty]),bod);; + +let list_mk_gabs(vs,bod) = itlist (curry mk_gabs) vs bod;; + +let strip_gabs = splitlist dest_gabs;; + +(* ------------------------------------------------------------------------- *) +(* Syntax for let terms. *) +(* ------------------------------------------------------------------------- *) + +let dest_let tm = + try let l,aargs = strip_comb tm in + if fst(dest_const l) <> "LET" then fail() else + let vars,lebod = strip_gabs (hd aargs) in + let eqs = zip vars (tl aargs) in + let le,bod = dest_comb lebod in + if fst(dest_const le) = "LET_END" then eqs,bod else fail() + with Failure _ -> failwith "dest_let: not a let-term";; + +let is_let = can dest_let;; + +let mk_let(assigs,bod) = + let lefts,rights = unzip assigs in + let lend = mk_comb(mk_const("LET_END",[type_of bod,aty]),bod) in + let lbod = list_mk_gabs(lefts,lend) in + let ty1,ty2 = dest_fun_ty(type_of lbod) in + let ltm = mk_const("LET",[ty1,aty; ty2,bty]) in + list_mk_comb(ltm,lbod::rights);; + +(* ------------------------------------------------------------------------- *) +(* Useful function to create stylized arguments using numbers. *) +(* ------------------------------------------------------------------------- *) + +let make_args = + let rec margs n s avoid tys = + if tys = [] then [] else + let v = variant avoid (mk_var(s^(string_of_int n),hd tys)) in + v::(margs (n + 1) s (v::avoid) (tl tys)) in + fun s avoid tys -> + if length tys = 1 then + [variant avoid (mk_var(s,hd tys))] + else + margs 0 s avoid tys;; + +(* ------------------------------------------------------------------------- *) +(* Director strings down a term. *) +(* ------------------------------------------------------------------------- *) + +let find_path = + let rec find_path p tm = + if p tm then [] else + if is_abs tm then "b"::(find_path p (body tm)) else + try "r"::(find_path p (rand tm)) + with Failure _ -> "l"::(find_path p (rator tm)) in + fun p tm -> implode(find_path p tm);; + +let follow_path = + let rec follow_path s tm = + match s with + [] -> tm + | "l"::t -> follow_path t (rator tm) + | "r"::t -> follow_path t (rand tm) + | _::t -> follow_path t (body tm) in + fun s tm -> follow_path (explode s) tm;; diff --git a/bool.ml b/bool.ml new file mode 100644 index 0000000..9d27e78 --- /dev/null +++ b/bool.ml @@ -0,0 +1,483 @@ +(* ========================================================================= *) +(* Boolean theory including (intuitionistic) defs of logical connectives. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "equal.ml";; + +(* ------------------------------------------------------------------------- *) +(* Set up parse status of basic and derived logical constants. *) +(* ------------------------------------------------------------------------- *) + +parse_as_prefix "~";; + +parse_as_binder "\\";; +parse_as_binder "!";; +parse_as_binder "?";; +parse_as_binder "?!";; + +parse_as_infix ("==>",(4,"right"));; +parse_as_infix ("\\/",(6,"right"));; +parse_as_infix ("/\\",(8,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Set up more orthodox notation for equations and equivalence. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("<=>",(2,"right"));; +override_interface ("<=>",`(=):bool->bool->bool`);; +parse_as_infix("=",(12,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Special syntax for Boolean equations (IFF). *) +(* ------------------------------------------------------------------------- *) + +let is_iff tm = + match tm with + Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> true + | _ -> false;; + +let dest_iff tm = + match tm with + Comb(Comb(Const("=",Tyapp("fun",[Tyapp("bool",[]);_])),l),r) -> (l,r) + | _ -> failwith "dest_iff";; + +let mk_iff = + let eq_tm = `(<=>)` in + fun (l,r) -> mk_comb(mk_comb(eq_tm,l),r);; + +(* ------------------------------------------------------------------------- *) +(* Rule allowing easy instantiation of polymorphic proformas. *) +(* ------------------------------------------------------------------------- *) + +let PINST tyin tmin = + let iterm_fn = INST (map (I F_F (inst tyin)) tmin) + and itype_fn = INST_TYPE tyin in + fun th -> try iterm_fn (itype_fn th) + with Failure _ -> failwith "PINST";; + +(* ------------------------------------------------------------------------- *) +(* Useful derived deductive rule. *) +(* ------------------------------------------------------------------------- *) + +let PROVE_HYP ath bth = + if exists (aconv (concl ath)) (hyp bth) + then EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath + else bth;; + +(* ------------------------------------------------------------------------- *) +(* Rules for T *) +(* ------------------------------------------------------------------------- *) + +let T_DEF = new_basic_definition + `T = ((\p:bool. p) = (\p:bool. p))`;; + +let TRUTH = EQ_MP (SYM T_DEF) (REFL `\p:bool. p`);; + +let EQT_ELIM th = + try EQ_MP (SYM th) TRUTH + with Failure _ -> failwith "EQT_ELIM";; + +let EQT_INTRO = + let t = `t:bool` in + let pth = + let th1 = DEDUCT_ANTISYM_RULE (ASSUME t) TRUTH in + let th2 = EQT_ELIM(ASSUME(concl th1)) in + DEDUCT_ANTISYM_RULE th2 th1 in + fun th -> EQ_MP (INST[concl th,t] pth) th;; + +(* ------------------------------------------------------------------------- *) +(* Rules for /\ *) +(* ------------------------------------------------------------------------- *) + +let AND_DEF = new_basic_definition + `(/\) = \p q. (\f:bool->bool->bool. f p q) = (\f. f T T)`;; + +let mk_conj = mk_binary "/\\";; +let list_mk_conj = end_itlist (curry mk_conj);; + +let CONJ = + let f = `f:bool->bool->bool` + and p = `p:bool` + and q = `q:bool` in + let pth1 = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF p) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 q) in + let th3 = EQ_MP th2 (ASSUME(mk_conj(p,q))) in + EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). q`)) + and pth2 = + let pth = ASSUME p + and qth = ASSUME q in + let th1 = MK_COMB(AP_TERM f (EQT_INTRO pth),EQT_INTRO qth) in + let th2 = ABS f th1 in + let th3 = BETA_RULE (AP_THM (AP_THM AND_DEF p) q) in + EQ_MP (SYM th3) th2 in + let pth = DEDUCT_ANTISYM_RULE pth1 pth2 in + fun th1 th2 -> + let th = INST [concl th1,p; concl th2,q] pth in + EQ_MP (PROVE_HYP th1 th) th2;; + +let CONJUNCT1 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF P) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 Q) in + let th3 = EQ_MP th2 (ASSUME(mk_conj(P,Q))) in + EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). p`)) in + fun th -> + try let l,r = dest_conj(concl th) in + PROVE_HYP th (INST [l,P; r,Q] pth) + with Failure _ -> failwith "CONJUNCT1";; + +let CONJUNCT2 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM AND_DEF P) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 Q) in + let th3 = EQ_MP th2 (ASSUME(mk_conj(P,Q))) in + EQT_ELIM(BETA_RULE (AP_THM th3 `\(p:bool) (q:bool). q`)) in + fun th -> + try let l,r = dest_conj(concl th) in + PROVE_HYP th (INST [l,P; r,Q] pth) + with Failure _ -> failwith "CONJUNCT2";; + +let CONJ_PAIR th = + try CONJUNCT1 th,CONJUNCT2 th + with Failure _ -> failwith "CONJ_PAIR: Not a conjunction";; + +let CONJUNCTS = striplist CONJ_PAIR;; + +(* ------------------------------------------------------------------------- *) +(* Rules for ==> *) +(* ------------------------------------------------------------------------- *) + +let IMP_DEF = new_basic_definition + `(==>) = \p q. p /\ q <=> p`;; + +let mk_imp = mk_binary "==>";; + +let MP = + let p = `p:bool` and q = `q:bool` in + let pth = + let th1 = BETA_RULE (AP_THM (AP_THM IMP_DEF p) q) + and th2 = CONJ (ASSUME p) (ASSUME q) + and th3 = CONJUNCT1(ASSUME(mk_conj(p,q))) in + EQ_MP (SYM th1) (DEDUCT_ANTISYM_RULE th2 th3) + and qth = + let th1 = BETA_RULE (AP_THM (AP_THM IMP_DEF p) q) in + let th2 = EQ_MP th1 (ASSUME(mk_imp(p,q))) in + CONJUNCT2 (EQ_MP (SYM th2) (ASSUME p)) in + let rth = DEDUCT_ANTISYM_RULE pth qth in + fun ith th -> + let ant,con = dest_imp (concl ith) in + if aconv ant (concl th) then + EQ_MP (PROVE_HYP th (INST [ant,p; con,q] rth)) ith + else failwith "MP: theorems do not agree";; + +let DISCH = + let p = `p:bool` + and q = `q:bool` in + let pth = SYM(BETA_RULE (AP_THM (AP_THM IMP_DEF p) q)) in + fun a th -> + let th1 = CONJ (ASSUME a) th in + let th2 = CONJUNCT1 (ASSUME (concl th1)) in + let th3 = DEDUCT_ANTISYM_RULE th1 th2 in + let th4 = INST [a,p; concl th,q] pth in + EQ_MP th4 th3;; + +let rec DISCH_ALL th = + try DISCH_ALL (DISCH (hd (hyp th)) th) + with Failure _ -> th;; + +let UNDISCH th = + try MP th (ASSUME(rand(rator(concl th)))) + with Failure _ -> failwith "UNDISCH";; + +let rec UNDISCH_ALL th = + if is_imp (concl th) then UNDISCH_ALL (UNDISCH th) + else th;; + +let IMP_ANTISYM_RULE = + let p = `p:bool` and q = `q:bool` and imp_tm = `(==>)` in + let pq = mk_imp(p,q) and qp = mk_imp(q,p) in + let pth1,pth2 = CONJ_PAIR(ASSUME(mk_conj(pq,qp))) in + let pth3 = DEDUCT_ANTISYM_RULE (UNDISCH pth2) (UNDISCH pth1) in + let pth4 = DISCH_ALL(ASSUME q) and pth5 = ASSUME(mk_eq(p,q)) in + let pth6 = CONJ (EQ_MP (SYM(AP_THM (AP_TERM imp_tm pth5) q)) pth4) + (EQ_MP (SYM(AP_TERM (mk_comb(imp_tm,q)) pth5)) pth4) in + let pth = DEDUCT_ANTISYM_RULE pth6 pth3 in + fun th1 th2 -> + let p1,q1 = dest_imp(concl th1) and p2,q2 = dest_imp(concl th2) in + EQ_MP (INST [p1,p; q1,q] pth) (CONJ th1 th2);; + +let ADD_ASSUM tm th = MP (DISCH tm th) (ASSUME tm);; + +let EQ_IMP_RULE = + let peq = `p <=> q` in + let p,q = dest_iff peq in + let pth1 = DISCH peq (DISCH p (EQ_MP (ASSUME peq) (ASSUME p))) + and pth2 = DISCH peq (DISCH q (EQ_MP (SYM(ASSUME peq)) (ASSUME q))) in + fun th -> let l,r = dest_iff(concl th) in + MP (INST [l,p; r,q] pth1) th,MP (INST [l,p; r,q] pth2) th;; + +let IMP_TRANS = + let pq = `p ==> q` + and qr = `q ==> r` in + let p,q = dest_imp pq and r = rand qr in + let pth = + itlist DISCH [pq; qr; p] (MP (ASSUME qr) (MP (ASSUME pq) (ASSUME p))) in + fun th1 th2 -> + let x,y = dest_imp(concl th1) + and y',z = dest_imp(concl th2) in + if y <> y' then failwith "IMP_TRANS" else + MP (MP (INST [x,p; y,q; z,r] pth) th1) th2;; + +(* ------------------------------------------------------------------------- *) +(* Rules for ! *) +(* ------------------------------------------------------------------------- *) + +let FORALL_DEF = new_basic_definition + `(!) = \P:A->bool. P = \x. T`;; + +let mk_forall = mk_binder "!";; +let list_mk_forall(vs,bod) = itlist (curry mk_forall) vs bod;; + +let SPEC = + let P = `P:A->bool` + and x = `x:A` in + let pth = + let th1 = EQ_MP(AP_THM FORALL_DEF `P:A->bool`) (ASSUME `(!)(P:A->bool)`) in + let th2 = AP_THM (CONV_RULE BETA_CONV th1) `x:A` in + let th3 = CONV_RULE (RAND_CONV BETA_CONV) th2 in + DISCH_ALL (EQT_ELIM th3) in + fun tm th -> + try let abs = rand(concl th) in + CONV_RULE BETA_CONV + (MP (PINST [snd(dest_var(bndvar abs)),aty] [abs,P; tm,x] pth) th) + with Failure _ -> failwith "SPEC";; + +let SPECL tms th = + try rev_itlist SPEC tms th + with Failure _ -> failwith "SPECL";; + +let SPEC_VAR th = + let bv = variant (thm_frees th) (bndvar(rand(concl th))) in + bv,SPEC bv th;; + +let rec SPEC_ALL th = + if is_forall(concl th) then SPEC_ALL(snd(SPEC_VAR th)) else th;; + +let ISPEC t th = + let x,_ = try dest_forall(concl th) with Failure _ -> + failwith "ISPEC: input theorem not universally quantified" in + let tyins = try type_match (snd(dest_var x)) (type_of t) [] with Failure _ -> + failwith "ISPEC can't type-instantiate input theorem" in + try SPEC t (INST_TYPE tyins th) + with Failure _ -> failwith "ISPEC: type variable(s) free in assumptions";; + +let ISPECL tms th = + try if tms = [] then th else + let avs = fst (chop_list (length tms) (fst(strip_forall(concl th)))) in + let tyins = itlist2 type_match (map (snd o dest_var) avs) + (map type_of tms) [] in + SPECL tms (INST_TYPE tyins th) + with Failure _ -> failwith "ISPECL";; + +let GEN = + let pth = SYM(CONV_RULE (RAND_CONV BETA_CONV) + (AP_THM FORALL_DEF `P:A->bool`)) in + fun x -> + let qth = INST_TYPE[snd(dest_var x),aty] pth in + let ptm = rand(rand(concl qth)) in + fun th -> + let th' = ABS x (EQT_INTRO th) in + let phi = lhand(concl th') in + let rth = INST[phi,ptm] qth in + EQ_MP rth th';; + +let GENL = itlist GEN;; + +let GEN_ALL th = + let asl,c = dest_thm th in + let vars = subtract (frees c) (freesl asl) in + GENL vars th;; + +(* ------------------------------------------------------------------------- *) +(* Rules for ? *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_DEF = new_basic_definition + `(?) = \P:A->bool. !q. (!x. P x ==> q) ==> q`;; + +let mk_exists = mk_binder "?";; +let list_mk_exists(vs,bod) = itlist (curry mk_exists) vs bod;; + +let EXISTS = + let P = `P:A->bool` and x = `x:A` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in + let th2 = SPEC `x:A` (ASSUME `!x:A. P x ==> Q`) in + let th3 = DISCH `!x:A. P x ==> Q` (MP th2 (ASSUME `(P:A->bool) x`)) in + EQ_MP (SYM th1) (GEN `Q:bool` th3) in + fun (etm,stm) th -> + try let qf,abs = dest_comb etm in + let bth = BETA_CONV(mk_comb(abs,stm)) in + let cth = PINST [type_of stm,aty] [abs,P; stm,x] pth in + PROVE_HYP (EQ_MP (SYM bth) th) cth + with Failure _ -> failwith "EXISTS";; + +let SIMPLE_EXISTS v th = + EXISTS (mk_exists(v,concl th),v) th;; + +let CHOOSE = + let P = `P:A->bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_DEF P) in + let th2 = SPEC `Q:bool` (UNDISCH(fst(EQ_IMP_RULE th1))) in + DISCH_ALL (DISCH `(?) (P:A->bool)` (UNDISCH th2)) in + fun (v,th1) th2 -> + try let abs = rand(concl th1) in + let bv,bod = dest_abs abs in + let cmb = mk_comb(abs,v) in + let pat = vsubst[v,bv] bod in + let th3 = CONV_RULE BETA_CONV (ASSUME cmb) in + let th4 = GEN v (DISCH cmb (MP (DISCH pat th2) th3)) in + let th5 = PINST [snd(dest_var v),aty] [abs,P; concl th2,Q] pth in + MP (MP th5 th4) th1 + with Failure _ -> failwith "CHOOSE";; + +let SIMPLE_CHOOSE v th = + CHOOSE(v,ASSUME (mk_exists(v,hd(hyp th)))) th;; + +(* ------------------------------------------------------------------------- *) +(* Rules for \/ *) +(* ------------------------------------------------------------------------- *) + +let OR_DEF = new_basic_definition + `(\/) = \p q. !r. (p ==> r) ==> (q ==> r) ==> r`;; + +let mk_disj = mk_binary "\\/";; +let list_mk_disj = end_itlist (curry mk_disj);; + +let DISJ1 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = MP (ASSUME `P ==> t`) (ASSUME `P:bool`) in + let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in + EQ_MP (SYM th2) th4 in + fun th tm -> + try PROVE_HYP th (INST [concl th,P; tm,Q] pth) + with Failure _ -> failwith "DISJ1";; + +let DISJ2 = + let P = `P:bool` and Q = `Q:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = MP (ASSUME `Q ==> t`) (ASSUME `Q:bool`) in + let th4 = GEN `t:bool` (DISCH `P ==> t` (DISCH `Q ==> t` th3)) in + EQ_MP (SYM th2) th4 in + fun tm th -> + try PROVE_HYP th (INST [tm,P; concl th,Q] pth) + with Failure _ -> failwith "DISJ2";; + +let DISJ_CASES = + let P = `P:bool` and Q = `Q:bool` and R = `R:bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM OR_DEF `P:bool`) in + let th2 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM th1 `Q:bool`) in + let th3 = SPEC `R:bool` (EQ_MP th2 (ASSUME `P \/ Q`)) in + UNDISCH (UNDISCH th3) in + fun th0 th1 th2 -> + try let c1 = concl th1 and c2 = concl th2 in + if not (aconv c1 c2) then failwith "DISJ_CASES" else + let l,r = dest_disj (concl th0) in + let th = INST [l,P; r,Q; c1,R] pth in + PROVE_HYP (DISCH r th2) (PROVE_HYP (DISCH l th1) (PROVE_HYP th0 th)) + with Failure _ -> failwith "DISJ_CASES";; + +let SIMPLE_DISJ_CASES th1 th2 = + DISJ_CASES (ASSUME(mk_disj(hd(hyp th1),hd(hyp th2)))) th1 th2;; + +(* ------------------------------------------------------------------------- *) +(* Rules for negation and falsity. *) +(* ------------------------------------------------------------------------- *) + +let F_DEF = new_basic_definition + `F = !p:bool. p`;; + +let NOT_DEF = new_basic_definition + `(~) = \p. p ==> F`;; + +let mk_neg = + let neg_tm = `(~)` in + fun tm -> try mk_comb(neg_tm,tm) + with Failure _ -> failwith "mk_neg";; + +let NOT_ELIM = + let P = `P:bool` in + let pth = CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P) in + fun th -> + try EQ_MP (INST [rand(concl th),P] pth) th + with Failure _ -> failwith "NOT_ELIM";; + +let NOT_INTRO = + let P = `P:bool` in + let pth = SYM(CONV_RULE(RAND_CONV BETA_CONV) (AP_THM NOT_DEF P)) in + fun th -> + try EQ_MP (INST [rand(rator(concl th)),P] pth) th + with Failure _ -> failwith "NOT_INTRO";; + +let EQF_INTRO = + let P = `P:bool` in + let pth = + let th1 = NOT_ELIM (ASSUME `~ P`) + and th2 = DISCH `F` (SPEC P (EQ_MP F_DEF (ASSUME `F`))) in + DISCH_ALL (IMP_ANTISYM_RULE th1 th2) in + fun th -> + try MP (INST [rand(concl th),P] pth) th + with Failure _ -> failwith "EQF_INTRO";; + +let EQF_ELIM = + let P = `P:bool` in + let pth = + let th1 = EQ_MP (ASSUME `P = F`) (ASSUME `P:bool`) in + let th2 = DISCH P (SPEC `F` (EQ_MP F_DEF th1)) in + DISCH_ALL (NOT_INTRO th2) in + fun th -> + try MP (INST [rand(rator(concl th)),P] pth) th + with Failure _ -> failwith "EQF_ELIM";; + +let CONTR = + let P = `P:bool` and f_tm = `F` in + let pth = SPEC P (EQ_MP F_DEF (ASSUME `F`)) in + fun tm th -> + if concl th <> f_tm then failwith "CONTR" + else PROVE_HYP th (INST [tm,P] pth);; + +(* ------------------------------------------------------------------------- *) +(* Rules for unique existence. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_UNIQUE_DEF = new_basic_definition + `(?!) = \P:A->bool. ((?) P) /\ (!x y. P x /\ P y ==> x = y)`;; + +let mk_uexists = mk_binder "?!";; + +let EXISTENCE = + let P = `P:A->bool` in + let pth = + let th1 = CONV_RULE (RAND_CONV BETA_CONV) (AP_THM EXISTS_UNIQUE_DEF P) in + let th2 = UNDISCH (fst(EQ_IMP_RULE th1)) in + DISCH_ALL (CONJUNCT1 th2) in + fun th -> + try let abs = rand(concl th) in + let ty = snd(dest_var(bndvar abs)) in + MP (PINST [ty,aty] [abs,P] pth) th + with Failure _ -> failwith "EXISTENCE";; diff --git a/calc_int.ml b/calc_int.ml new file mode 100644 index 0000000..9dcd666 --- /dev/null +++ b/calc_int.ml @@ -0,0 +1,391 @@ +(* ========================================================================= *) +(* Calculation with integer-valued reals. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "realax.ml";; + +(* ------------------------------------------------------------------------- *) +(* Syntax operations on integer constants of type ":real". *) +(* ------------------------------------------------------------------------- *) + +let is_realintconst tm = + match tm with + Comb(Const("real_of_num",_),n) -> is_numeral n + | Comb(Const("real_neg",_),Comb(Const("real_of_num",_),n)) -> + is_numeral n & not(dest_numeral n = num_0) + | _ -> false;; + +let dest_realintconst tm = + match tm with + Comb(Const("real_of_num",_),n) -> dest_numeral n + | Comb(Const("real_neg",_),Comb(Const("real_of_num",_),n)) -> + let nn = dest_numeral n in + if nn <>/ num_0 then minus_num(dest_numeral n) + else failwith "dest_realintconst" + | _ -> failwith "dest_realintconst";; + +let mk_realintconst = + let cast_tm = `real_of_num` and neg_tm = `(--)` in + let mk_numconst n = mk_comb(cast_tm,mk_numeral n) in + fun x -> if x + is_realintconst p & is_realintconst q & + (let m = dest_realintconst p and n = dest_realintconst q in + n >/ num_1 & gcd_num m n =/ num_1) + | _ -> is_realintconst tm;; + +let rat_of_term tm = + match tm with + Comb(Comb(Const("real_div",_),p),q) -> + let m = dest_realintconst p and n = dest_realintconst q in + if n >/ num_1 & gcd_num m n =/ num_1 then m // n + else failwith "rat_of_term" + | _ -> dest_realintconst tm;; + +let term_of_rat = + let div_tm = `(/)` in + fun x -> + let p,q = numdom x in + let ptm = mk_realintconst p in + if q = num_1 then ptm + else mk_comb(mk_comb(div_tm,ptm),mk_realintconst q);; + +(* ------------------------------------------------------------------------- *) +(* Some elementary "bootstrapping" lemmas we need below. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ADD_AC = prove + (`(m + n = n + m) /\ + ((m + n) + p = m + (n + p)) /\ + (m + (n + p) = n + (m + p))`, + MESON_TAC[REAL_ADD_ASSOC; REAL_ADD_SYM]);; + +let REAL_ADD_RINV = prove + (`!x. x + --x = &0`, + MESON_TAC[REAL_ADD_SYM; REAL_ADD_LINV]);; + +let REAL_EQ_ADD_LCANCEL = prove + (`!x y z. (x + y = x + z) <=> (y = z)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o AP_TERM `(+) (--x)`) THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_EQ_ADD_RCANCEL = prove + (`!x y z. (x + z = y + z) <=> (x = y)`, + MESON_TAC[REAL_ADD_SYM; REAL_EQ_ADD_LCANCEL]);; + +let REAL_MUL_RZERO = prove + (`!x. x * &0 = &0`, + MESON_TAC[REAL_EQ_ADD_RCANCEL; REAL_ADD_LDISTRIB; REAL_ADD_LID]);; + +let REAL_MUL_LZERO = prove + (`!x. &0 * x = &0`, + MESON_TAC[REAL_MUL_SYM; REAL_MUL_RZERO]);; + +let REAL_NEG_NEG = prove + (`!x. --(--x) = x`, + MESON_TAC + [REAL_EQ_ADD_RCANCEL; REAL_ADD_LINV; REAL_ADD_SYM; REAL_ADD_LINV]);; + +let REAL_MUL_RNEG = prove + (`!x y. x * (--y) = -- (x * y)`, + MESON_TAC[REAL_EQ_ADD_RCANCEL; REAL_ADD_LDISTRIB; REAL_ADD_LINV; + REAL_MUL_RZERO]);; + +let REAL_MUL_LNEG = prove + (`!x y. (--x) * y = -- (x * y)`, + MESON_TAC[REAL_MUL_SYM; REAL_MUL_RNEG]);; + +let REAL_NEG_ADD = prove + (`!x y. --(x + y) = --x + --y`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL REAL_EQ_ADD_RCANCEL)))) THEN + EXISTS_TAC `x + y` THEN REWRITE_TAC[REAL_ADD_LINV] THEN + ONCE_REWRITE_TAC[AC REAL_ADD_AC `(a + b) + (c + d) = (a + c) + (b + d)`] THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_ADD_RID = prove + (`!x. x + &0 = x`, + MESON_TAC[REAL_ADD_SYM; REAL_ADD_LID]);; + +let REAL_NEG_0 = prove + (`--(&0) = &0`, + MESON_TAC[REAL_ADD_LINV; REAL_ADD_RID]);; + +let REAL_LE_LNEG = prove + (`!x y. --x <= y <=> &0 <= x + y`, + REPEAT GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THENL + [DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LINV]; + DISCH_THEN(MP_TAC o SPEC `--x`) THEN + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_ASSOC; REAL_ADD_LID; + ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]);; + +let REAL_LE_NEG2 = prove + (`!x y. --x <= --y <=> y <= x`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_LE_LNEG] THEN + AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_ADD_SYM);; + +let REAL_LE_RNEG = prove + (`!x y. x <= --y <=> x + y <= &0`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_LE_LNEG; GSYM REAL_NEG_ADD] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_LE_NEG2] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_ADD_LINV] THEN + REWRITE_TAC[REAL_NEG_ADD; REAL_NEG_NEG] THEN + MATCH_ACCEPT_TAC REAL_ADD_SYM);; + +let REAL_OF_NUM_POW = prove + (`!x n. (&x) pow n = &(x EXP n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; EXP; REAL_OF_NUM_MUL]);; + +let REAL_POW_NEG = prove + (`!x n. (--x) pow n = if EVEN n then x pow n else --(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; EVEN] THEN + ASM_CASES_TAC `EVEN n` THEN + ASM_REWRITE_TAC[REAL_MUL_RNEG; REAL_MUL_LNEG; REAL_NEG_NEG]);; + +let REAL_ABS_NUM = prove + (`!n. abs(&n) = &n`, + REWRITE_TAC[real_abs; REAL_OF_NUM_LE; LE_0]);; + +let REAL_ABS_NEG = prove + (`!x. abs(--x) = abs x`, + REWRITE_TAC[real_abs; REAL_LE_RNEG; REAL_NEG_NEG; REAL_ADD_LID] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_ANTISYM; REAL_NEG_0]);; + +(* ------------------------------------------------------------------------- *) +(* First, the conversions on integer constants. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INT_LE_CONV,REAL_INT_LT_CONV, + REAL_INT_GE_CONV,REAL_INT_GT_CONV,REAL_INT_EQ_CONV = + let tth = + TAUT `(F /\ F <=> F) /\ (F /\ T <=> F) /\ + (T /\ F <=> F) /\ (T /\ T <=> T)` in + let nth = TAUT `(~T <=> F) /\ (~F <=> T)` in + let NUM2_EQ_CONV = BINOP_CONV NUM_EQ_CONV THENC GEN_REWRITE_CONV I [tth] in + let NUM2_NE_CONV = + RAND_CONV NUM2_EQ_CONV THENC + GEN_REWRITE_CONV I [nth] in + let [pth_le1; pth_le2a; pth_le2b; pth_le3] = (CONJUNCTS o prove) + (`(--(&m) <= &n <=> T) /\ + (&m <= &n <=> m <= n) /\ + (--(&m) <= --(&n) <=> n <= m) /\ + (&m <= --(&n) <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[REAL_LE_NEG2] THEN + REWRITE_TAC[REAL_LE_LNEG; REAL_LE_RNEG] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE; LE_0] THEN + REWRITE_TAC[LE; ADD_EQ_0]) in + let REAL_INT_LE_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_le1]; + GEN_REWRITE_CONV I [pth_le2a; pth_le2b] THENC NUM_LE_CONV; + GEN_REWRITE_CONV I [pth_le3] THENC NUM2_EQ_CONV] in + let [pth_lt1; pth_lt2a; pth_lt2b; pth_lt3] = (CONJUNCTS o prove) + (`(&m < --(&n) <=> F) /\ + (&m < &n <=> m < n) /\ + (--(&m) < --(&n) <=> n < m) /\ + (--(&m) < &n <=> ~((m = 0) /\ (n = 0)))`, + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; + GSYM NOT_LE; real_lt] THEN + CONV_TAC TAUT) in + let REAL_INT_LT_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_lt1]; + GEN_REWRITE_CONV I [pth_lt2a; pth_lt2b] THENC NUM_LT_CONV; + GEN_REWRITE_CONV I [pth_lt3] THENC NUM2_NE_CONV] in + let [pth_ge1; pth_ge2a; pth_ge2b; pth_ge3] = (CONJUNCTS o prove) + (`(&m >= --(&n) <=> T) /\ + (&m >= &n <=> n <= m) /\ + (--(&m) >= --(&n) <=> m <= n) /\ + (--(&m) >= &n <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; real_ge] THEN + CONV_TAC TAUT) in + let REAL_INT_GE_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_ge1]; + GEN_REWRITE_CONV I [pth_ge2a; pth_ge2b] THENC NUM_LE_CONV; + GEN_REWRITE_CONV I [pth_ge3] THENC NUM2_EQ_CONV] in + let [pth_gt1; pth_gt2a; pth_gt2b; pth_gt3] = (CONJUNCTS o prove) + (`(--(&m) > &n <=> F) /\ + (&m > &n <=> n < m) /\ + (--(&m) > --(&n) <=> m < n) /\ + (&m > --(&n) <=> ~((m = 0) /\ (n = 0)))`, + REWRITE_TAC[pth_lt1; pth_lt2a; pth_lt2b; pth_lt3; real_gt] THEN + CONV_TAC TAUT) in + let REAL_INT_GT_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_gt1]; + GEN_REWRITE_CONV I [pth_gt2a; pth_gt2b] THENC NUM_LT_CONV; + GEN_REWRITE_CONV I [pth_gt3] THENC NUM2_NE_CONV] in + let [pth_eq1a; pth_eq1b; pth_eq2a; pth_eq2b] = (CONJUNCTS o prove) + (`((&m = &n) <=> (m = n)) /\ + ((--(&m) = --(&n)) <=> (m = n)) /\ + ((--(&m) = &n) <=> (m = 0) /\ (n = 0)) /\ + ((&m = --(&n)) <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; GSYM LE_ANTISYM] THEN + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; LE; LE_0] THEN + CONV_TAC TAUT) in + let REAL_INT_EQ_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_eq1a; pth_eq1b] THENC NUM_EQ_CONV; + GEN_REWRITE_CONV I [pth_eq2a; pth_eq2b] THENC NUM2_EQ_CONV] in + REAL_INT_LE_CONV,REAL_INT_LT_CONV, + REAL_INT_GE_CONV,REAL_INT_GT_CONV,REAL_INT_EQ_CONV;; + +let REAL_INT_NEG_CONV = + let pth = prove + (`(--(&0) = &0) /\ + (--(--(&x)) = &x)`, + REWRITE_TAC[REAL_NEG_NEG; REAL_NEG_0]) in + GEN_REWRITE_CONV I [pth];; + +let REAL_INT_MUL_CONV = + let pth0 = prove + (`(&0 * &x = &0) /\ + (&0 * --(&x) = &0) /\ + (&x * &0 = &0) /\ + (--(&x) * &0 = &0)`, + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO]) + and pth1,pth2 = (CONJ_PAIR o prove) + (`((&m * &n = &(m * n)) /\ + (--(&m) * --(&n) = &(m * n))) /\ + ((--(&m) * &n = --(&(m * n))) /\ + (&m * --(&n) = --(&(m * n))))`, + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_OF_NUM_MUL]) in + FIRST_CONV + [GEN_REWRITE_CONV I [pth0]; + GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_MULT_CONV; + GEN_REWRITE_CONV I [pth2] THENC RAND_CONV(RAND_CONV NUM_MULT_CONV)];; + +let REAL_INT_ADD_CONV = + let neg_tm = `(--)` in + let amp_tm = `&` in + let add_tm = `(+)` in + let dest = dest_binop `(+)` in + let m_tm = `m:num` and n_tm = `n:num` in + let pth0 = prove + (`(--(&m) + &m = &0) /\ + (&m + --(&m) = &0)`, + REWRITE_TAC[REAL_ADD_LINV; REAL_ADD_RINV]) in + let [pth1; pth2; pth3; pth4; pth5; pth6] = (CONJUNCTS o prove) + (`(--(&m) + --(&n) = --(&(m + n))) /\ + (--(&m) + &(m + n) = &n) /\ + (--(&(m + n)) + &m = --(&n)) /\ + (&(m + n) + --(&m) = &n) /\ + (&m + --(&(m + n)) = --(&n)) /\ + (&m + &n = &(m + n))`, + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_NEG_ADD] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID] THEN + REWRITE_TAC[REAL_ADD_RINV; REAL_ADD_LID]) in + GEN_REWRITE_CONV I [pth0] ORELSEC + (fun tm -> + try let l,r = dest tm in + if rator l = neg_tm then + if rator r = neg_tm then + let th1 = INST [rand(rand l),m_tm; rand(rand r),n_tm] pth1 in + let tm1 = rand(rand(rand(concl th1))) in + let th2 = AP_TERM neg_tm (AP_TERM amp_tm (NUM_ADD_CONV tm1)) in + TRANS th1 th2 + else + let m = rand(rand l) and n = rand r in + let m' = dest_numeral m and n' = dest_numeral n in + if m' <=/ n' then + let p = mk_numeral (n' -/ m') in + let th1 = INST [m,m_tm; p,n_tm] pth2 in + let th2 = NUM_ADD_CONV (rand(rand(lhand(concl th1)))) in + let th3 = AP_TERM (rator tm) (AP_TERM amp_tm (SYM th2)) in + TRANS th3 th1 + else + let p = mk_numeral (m' -/ n') in + let th1 = INST [n,m_tm; p,n_tm] pth3 in + let th2 = NUM_ADD_CONV (rand(rand(lhand(lhand(concl th1))))) in + let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_THM (AP_TERM add_tm th3) (rand tm) in + TRANS th4 th1 + else + if rator r = neg_tm then + let m = rand l and n = rand(rand r) in + let m' = dest_numeral m and n' = dest_numeral n in + if n' <=/ m' then + let p = mk_numeral (m' -/ n') in + let th1 = INST [n,m_tm; p,n_tm] pth4 in + let th2 = NUM_ADD_CONV (rand(lhand(lhand(concl th1)))) in + let th3 = AP_TERM add_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_THM th3 (rand tm) in + TRANS th4 th1 + else + let p = mk_numeral (n' -/ m') in + let th1 = INST [m,m_tm; p,n_tm] pth5 in + let th2 = NUM_ADD_CONV (rand(rand(rand(lhand(concl th1))))) in + let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_TERM (rator tm) th3 in + TRANS th4 th1 + else + let th1 = INST [rand l,m_tm; rand r,n_tm] pth6 in + let tm1 = rand(rand(concl th1)) in + let th2 = AP_TERM amp_tm (NUM_ADD_CONV tm1) in + TRANS th1 th2 + with Failure _ -> failwith "REAL_INT_ADD_CONV");; + +let REAL_INT_SUB_CONV = + GEN_REWRITE_CONV I [real_sub] THENC + TRY_CONV(RAND_CONV REAL_INT_NEG_CONV) THENC + REAL_INT_ADD_CONV;; + +let REAL_INT_POW_CONV = + let pth1,pth2 = (CONJ_PAIR o prove) + (`(&x pow n = &(x EXP n)) /\ + ((--(&x)) pow n = if EVEN n then &(x EXP n) else --(&(x EXP n)))`, + REWRITE_TAC[REAL_OF_NUM_POW; REAL_POW_NEG]) in + let tth = prove + (`((if T then x:real else y) = x) /\ ((if F then x:real else y) = y)`, + REWRITE_TAC[]) in + let neg_tm = `(--)` in + (GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_EXP_CONV) ORELSEC + (GEN_REWRITE_CONV I [pth2] THENC + RATOR_CONV(RATOR_CONV(RAND_CONV NUM_EVEN_CONV)) THENC + GEN_REWRITE_CONV I [tth] THENC + (fun tm -> if rator tm = neg_tm then RAND_CONV(RAND_CONV NUM_EXP_CONV) tm + else RAND_CONV NUM_EXP_CONV tm));; + +let REAL_INT_ABS_CONV = + let pth = prove + (`(abs(--(&x)) = &x) /\ + (abs(&x) = &x)`, + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM]) in + GEN_REWRITE_CONV I [pth];; + +let REAL_INT_RED_CONV = + let gconv_net = itlist (uncurry net_of_conv) + [`x <= y`,REAL_INT_LE_CONV; + `x < y`,REAL_INT_LT_CONV; + `x >= y`,REAL_INT_GE_CONV; + `x > y`,REAL_INT_GT_CONV; + `x:real = y`,REAL_INT_EQ_CONV; + `--x`,CHANGED_CONV REAL_INT_NEG_CONV; + `abs(x)`,REAL_INT_ABS_CONV; + `x + y`,REAL_INT_ADD_CONV; + `x - y`,REAL_INT_SUB_CONV; + `x * y`,REAL_INT_MUL_CONV; + `x pow n`,REAL_INT_POW_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let REAL_INT_REDUCE_CONV = DEPTH_CONV REAL_INT_RED_CONV;; diff --git a/calc_num.ml b/calc_num.ml new file mode 100644 index 0000000..e4a54d6 --- /dev/null +++ b/calc_num.ml @@ -0,0 +1,1491 @@ +(* ========================================================================= *) +(* Calculation with naturals. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "wf.ml";; + +(* ------------------------------------------------------------------------- *) +(* Simple rule to get rid of NUMERAL constant. *) +(* ------------------------------------------------------------------------- *) + +let DENUMERAL = GEN_REWRITE_RULE DEPTH_CONV [NUMERAL];; + +(* ------------------------------------------------------------------------- *) +(* Big collection of rewrites to do trivial arithmetic. *) +(* *) +(* Note that we have none for DIV and MOD, and that PRE and SUB are a bit *) +(* inefficient; log(n)^2 instead of log(n). *) +(* ------------------------------------------------------------------------- *) + +let ARITH_ZERO = prove + (`(NUMERAL 0 = 0) /\ + (BIT0 _0 = _0)`, + REWRITE_TAC[NUMERAL; BIT0; DENUMERAL ADD_CLAUSES]);; + +let ARITH_SUC = prove + (`(!n. SUC(NUMERAL n) = NUMERAL(SUC n)) /\ + (SUC _0 = BIT1 _0) /\ + (!n. SUC (BIT0 n) = BIT1 n) /\ + (!n. SUC (BIT1 n) = BIT0 (SUC n))`, + REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL ADD_CLAUSES]);; + +let ARITH_PRE = prove + (`(!n. PRE(NUMERAL n) = NUMERAL(PRE n)) /\ + (PRE _0 = _0) /\ + (!n. PRE(BIT0 n) = if n = _0 then _0 else BIT1 (PRE n)) /\ + (!n. PRE(BIT1 n) = BIT0 n)`, + REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL PRE] THEN INDUCT_TAC THEN + REWRITE_TAC[NUMERAL; DENUMERAL PRE; DENUMERAL ADD_CLAUSES; DENUMERAL NOT_SUC; + ARITH_ZERO]);; + +let ARITH_ADD = prove + (`(!m n. NUMERAL(m) + NUMERAL(n) = NUMERAL(m + n)) /\ + (_0 + _0 = _0) /\ + (!n. _0 + BIT0 n = BIT0 n) /\ + (!n. _0 + BIT1 n = BIT1 n) /\ + (!n. BIT0 n + _0 = BIT0 n) /\ + (!n. BIT1 n + _0 = BIT1 n) /\ + (!m n. BIT0 m + BIT0 n = BIT0 (m + n)) /\ + (!m n. BIT0 m + BIT1 n = BIT1 (m + n)) /\ + (!m n. BIT1 m + BIT0 n = BIT1 (m + n)) /\ + (!m n. BIT1 m + BIT1 n = BIT0 (SUC(m + n)))`, + PURE_REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL ADD_CLAUSES; SUC_INJ] THEN + REWRITE_TAC[ADD_AC]);; + +let ARITH_MULT = prove + (`(!m n. NUMERAL(m) * NUMERAL(n) = NUMERAL(m * n)) /\ + (_0 * _0 = _0) /\ + (!n. _0 * BIT0 n = _0) /\ + (!n. _0 * BIT1 n = _0) /\ + (!n. BIT0 n * _0 = _0) /\ + (!n. BIT1 n * _0 = _0) /\ + (!m n. BIT0 m * BIT0 n = BIT0 (BIT0 (m * n))) /\ + (!m n. BIT0 m * BIT1 n = BIT0 m + BIT0 (BIT0 (m * n))) /\ + (!m n. BIT1 m * BIT0 n = BIT0 n + BIT0 (BIT0 (m * n))) /\ + (!m n. BIT1 m * BIT1 n = BIT1 m + BIT0 n + BIT0 (BIT0 (m * n)))`, + PURE_REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL MULT_CLAUSES; + DENUMERAL ADD_CLAUSES; SUC_INJ] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; ADD_AC]);; + +let ARITH_EXP = prove + (`(!m n. (NUMERAL m) EXP (NUMERAL n) = NUMERAL(m EXP n)) /\ + (_0 EXP _0 = BIT1 _0) /\ + (!m. (BIT0 m) EXP _0 = BIT1 _0) /\ + (!m. (BIT1 m) EXP _0 = BIT1 _0) /\ + (!n. _0 EXP (BIT0 n) = (_0 EXP n) * (_0 EXP n)) /\ + (!m n. (BIT0 m) EXP (BIT0 n) = ((BIT0 m) EXP n) * ((BIT0 m) EXP n)) /\ + (!m n. (BIT1 m) EXP (BIT0 n) = ((BIT1 m) EXP n) * ((BIT1 m) EXP n)) /\ + (!n. _0 EXP (BIT1 n) = _0) /\ + (!m n. (BIT0 m) EXP (BIT1 n) = + BIT0 m * ((BIT0 m) EXP n) * ((BIT0 m) EXP n)) /\ + (!m n. (BIT1 m) EXP (BIT1 n) = + BIT1 m * ((BIT1 m) EXP n) * ((BIT1 m) EXP n))`, + REWRITE_TAC[NUMERAL] THEN REPEAT STRIP_TAC THEN + TRY(GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [BIT0; BIT1]) THEN + REWRITE_TAC[DENUMERAL EXP; DENUMERAL MULT_CLAUSES; EXP_ADD]);; + +let ARITH_EVEN = prove + (`(!n. EVEN(NUMERAL n) <=> EVEN n) /\ + (EVEN _0 <=> T) /\ + (!n. EVEN(BIT0 n) <=> T) /\ + (!n. EVEN(BIT1 n) <=> F)`, + REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL EVEN; EVEN_ADD]);; + +let ARITH_ODD = prove + (`(!n. ODD(NUMERAL n) <=> ODD n) /\ + (ODD _0 <=> F) /\ + (!n. ODD(BIT0 n) <=> F) /\ + (!n. ODD(BIT1 n) <=> T)`, + REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL ODD; ODD_ADD]);; + +let ARITH_LE = prove + (`(!m n. NUMERAL m <= NUMERAL n <=> m <= n) /\ + ((_0 <= _0) <=> T) /\ + (!n. (BIT0 n <= _0) <=> n <= _0) /\ + (!n. (BIT1 n <= _0) <=> F) /\ + (!n. (_0 <= BIT0 n) <=> T) /\ + (!n. (_0 <= BIT1 n) <=> T) /\ + (!m n. (BIT0 m <= BIT0 n) <=> m <= n) /\ + (!m n. (BIT0 m <= BIT1 n) <=> m <= n) /\ + (!m n. (BIT1 m <= BIT0 n) <=> m < n) /\ + (!m n. (BIT1 m <= BIT1 n) <=> m <= n)`, + REWRITE_TAC[NUMERAL; BIT1; BIT0; DENUMERAL NOT_SUC; + DENUMERAL(GSYM NOT_SUC); SUC_INJ] THEN + REWRITE_TAC[DENUMERAL LE_0] THEN REWRITE_TAC[DENUMERAL LE; GSYM MULT_2] THEN + REWRITE_TAC[LE_MULT_LCANCEL; SUC_INJ; + DENUMERAL MULT_EQ_0; DENUMERAL NOT_SUC] THEN + REWRITE_TAC[DENUMERAL NOT_SUC] THEN REWRITE_TAC[LE_SUC_LT] THEN + REWRITE_TAC[LT_MULT_LCANCEL] THEN + SUBGOAL_THEN `2 = SUC 1` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[NUMERAL; BIT0; BIT1; DENUMERAL ADD_CLAUSES]; + REWRITE_TAC[DENUMERAL NOT_SUC; NOT_SUC; EQ_MULT_LCANCEL] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[DISJ_SYM] LE_LT] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + SUBGOAL_THEN `~(SUC 1 * m = SUC (SUC 1 * n))` + (fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; EVEN_ADD; NUMERAL; BIT1; EVEN]]);; + +let ARITH_LT = prove + (`(!m n. NUMERAL m < NUMERAL n <=> m < n) /\ + ((_0 < _0) <=> F) /\ + (!n. (BIT0 n < _0) <=> F) /\ + (!n. (BIT1 n < _0) <=> F) /\ + (!n. (_0 < BIT0 n) <=> _0 < n) /\ + (!n. (_0 < BIT1 n) <=> T) /\ + (!m n. (BIT0 m < BIT0 n) <=> m < n) /\ + (!m n. (BIT0 m < BIT1 n) <=> m <= n) /\ + (!m n. (BIT1 m < BIT0 n) <=> m < n) /\ + (!m n. (BIT1 m < BIT1 n) <=> m < n)`, + REWRITE_TAC[NUMERAL; GSYM NOT_LE; ARITH_LE] THEN + REWRITE_TAC[DENUMERAL LE]);; + +let ARITH_GE = REWRITE_RULE[GSYM GE; GSYM GT] ARITH_LE;; + +let ARITH_GT = REWRITE_RULE[GSYM GE; GSYM GT] ARITH_LT;; + +let ARITH_EQ = prove + (`(!m n. (NUMERAL m = NUMERAL n) <=> (m = n)) /\ + ((_0 = _0) <=> T) /\ + (!n. (BIT0 n = _0) <=> (n = _0)) /\ + (!n. (BIT1 n = _0) <=> F) /\ + (!n. (_0 = BIT0 n) <=> (_0 = n)) /\ + (!n. (_0 = BIT1 n) <=> F) /\ + (!m n. (BIT0 m = BIT0 n) <=> (m = n)) /\ + (!m n. (BIT0 m = BIT1 n) <=> F) /\ + (!m n. (BIT1 m = BIT0 n) <=> F) /\ + (!m n. (BIT1 m = BIT1 n) <=> (m = n))`, + REWRITE_TAC[NUMERAL; GSYM LE_ANTISYM; ARITH_LE] THEN + REWRITE_TAC[LET_ANTISYM; LTE_ANTISYM; DENUMERAL LE_0]);; + +let ARITH_SUB = prove + (`(!m n. NUMERAL m - NUMERAL n = NUMERAL(m - n)) /\ + (_0 - _0 = _0) /\ + (!n. _0 - BIT0 n = _0) /\ + (!n. _0 - BIT1 n = _0) /\ + (!n. BIT0 n - _0 = BIT0 n) /\ + (!n. BIT1 n - _0 = BIT1 n) /\ + (!m n. BIT0 m - BIT0 n = BIT0 (m - n)) /\ + (!m n. BIT0 m - BIT1 n = PRE(BIT0 (m - n))) /\ + (!m n. BIT1 m - BIT0 n = if n <= m then BIT1 (m - n) else _0) /\ + (!m n. BIT1 m - BIT1 n = BIT0 (m - n))`, + REWRITE_TAC[NUMERAL; DENUMERAL SUB_0] THEN PURE_REWRITE_TAC[BIT0; BIT1] THEN + REWRITE_TAC[GSYM MULT_2; SUB_SUC; LEFT_SUB_DISTRIB] THEN + REWRITE_TAC[SUB] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[DENUMERAL SUB_EQ_0] THEN + RULE_ASSUM_TAC(REWRITE_RULE[NOT_LE]) THEN + ASM_REWRITE_TAC[LE_SUC_LT; LT_MULT_LCANCEL; ARITH_EQ] THEN + POP_ASSUM(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[ADD1; LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[ADD_SUB2; GSYM ADD_ASSOC]);; + +let ARITH = end_itlist CONJ + [ARITH_ZERO; ARITH_SUC; ARITH_PRE; + ARITH_ADD; ARITH_MULT; ARITH_EXP; + ARITH_EVEN; ARITH_ODD; + ARITH_EQ; ARITH_LE; ARITH_LT; ARITH_GE; ARITH_GT; + ARITH_SUB];; + +(* ------------------------------------------------------------------------- *) +(* Now more delicate conversions for situations where efficiency matters. *) +(* ------------------------------------------------------------------------- *) + +let NUM_EVEN_CONV = + let tth,rths = CONJ_PAIR ARITH_EVEN in + GEN_REWRITE_CONV I [tth] THENC GEN_REWRITE_CONV I [rths];; + +let NUM_ODD_CONV = + let tth,rths = CONJ_PAIR ARITH_ODD in + GEN_REWRITE_CONV I [tth] THENC GEN_REWRITE_CONV I [rths];; + +let NUM_SUC_CONV,NUM_ADD_CONV,NUM_MULT_CONV,NUM_EXP_CONV, + NUM_LT_CONV,NUM_LE_CONV,NUM_EQ_CONV = + let Comb(NUMERAL_tm,Comb(BIT0_tm,Comb(BIT1_tm,zero_tm))) = + mk_small_numeral 2 + and suc_tm = rator(rand(concl TWO)) + and one_tm = rand(mk_small_numeral 1) + and add_tm = rator(rator(lhand(snd(strip_forall(concl ADD_0))))) + and mul_tm = rator(rator(rand(snd(strip_forall(concl EXP_2))))) + and exp_tm = rator(rator(lhand(snd(strip_forall(concl EXP_2))))) + and eq_tm = rator(rator(concl TWO)) in + let num_0 = Int 0 and num_1 = Int 1 and num_2 = Int 2 in + let a_tm = `a:num` + and b_tm = `b:num` + and c_tm = `c:num` + and d_tm = `d:num` + and e_tm = `e:num` + and h_tm = `h:num` + and l_tm = `l:num` + and m_tm = `m:num` + and n_tm = `n:num` + and p_tm = `p:num` in + let STANDARDIZE = + let ilist = [BIT0_tm,BIT0_tm; BIT1_tm,BIT1_tm; zero_tm,zero_tm; + suc_tm,suc_tm; add_tm,add_tm; mul_tm,mul_tm; + exp_tm,exp_tm; eq_tm,eq_tm; NUMERAL_tm,NUMERAL_tm; + a_tm,a_tm; b_tm,b_tm; c_tm,c_tm; d_tm,d_tm; e_tm,e_tm; + h_tm,h_tm; l_tm,l_tm; m_tm,m_tm; n_tm,n_tm; p_tm,p_tm] in + let rec replace tm = + match tm with + Var(_,_) | Const(_,_) -> rev_assocd tm ilist tm + | Comb(s,t) -> mk_comb(replace s,replace t) + | Abs(_,_) -> failwith "replace" in + fun th -> let tm' = replace (concl th) in EQ_MP (REFL tm') th in + let REFL_bit0 = STANDARDIZE(REFL BIT0_tm) + and REFL_bit1 = STANDARDIZE(REFL BIT1_tm) in + let AP_BIT0 th = MK_COMB(REFL_bit0,th) + and AP_BIT1 th = MK_COMB(REFL_bit1,th) + and QUICK_PROVE_HYP ath bth = EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath in + let rec dest_raw_numeral tm = + match tm with + Comb(Const("BIT1",_),t) -> num_2 */ dest_raw_numeral t +/ num_1 + | Comb(Const("BIT0",_),t) -> num_2 */ dest_raw_numeral t + | Const("_0",_) -> num_0 in + let bitcounts = + let rec bctr w z tm = + match tm with + Const("_0",_) -> (w,z) + | Comb(Const("BIT0",_),t) -> bctr w (z + 1) t + | Comb(Const("BIT1",_),t) -> bctr (w + 1) z t + | _ -> failwith "malformed numeral" in + bctr 0 0 in + let rec wellformed tm = + match tm with + Const("_0",_) -> true + | Comb(Const("BIT0",_),t)|Comb(Const("BIT1",_),t) -> wellformed t + | _ -> false in + let rec orderrelation mtm ntm = + if mtm == ntm then + if wellformed mtm then 0 else failwith "orderrelation" + else + match (mtm,ntm) with + Const("_0",_),Const("_0",_) -> 0 + | Const("_0",_),_ -> + if wellformed ntm then -1 else failwith "orderrelation" + | _, Const("_0",_) -> + if wellformed ntm then 1 else failwith "orderrelation" + | Comb(Const("BIT0",_),mt),Comb(Const("BIT0",_),nt) + | Comb(Const("BIT1",_),mt),Comb(Const("BIT1",_),nt) -> + orderrelation mt nt + | Comb(Const("BIT0",_),mt),Comb(Const("BIT1",_),nt) -> + if orderrelation mt nt > 0 then 1 else -1 + | Comb(Const("BIT1",_),mt),Comb(Const("BIT0",_),nt) -> + if orderrelation mt nt < 0 then -1 else 1 in + let doublebn tm = if tm = zero_tm then tm else mk_comb(BIT0_tm,tm) in + let rec subbn mtm ntm = + match (mtm,ntm) with + (_,Const("_0",_)) -> mtm + | (Comb(Const("BIT0",_),mt),Comb(Const("BIT0",_),nt)) -> + doublebn (subbn mt nt) + | (Comb(Const("BIT1",_),mt),Comb(Const("BIT1",_),nt)) -> + doublebn (subbn mt nt) + | (Comb(Const("BIT1",_),mt),Comb(Const("BIT0",_),nt)) -> + mk_comb(BIT1_tm,subbn mt nt) + | (Comb(Const("BIT0",_),mt),Comb(Const("BIT1",_),nt)) -> + mk_comb(BIT1_tm,sbcbn mt nt) + | _ -> failwith "malformed numeral or wrong relation" + and sbcbn mtm ntm = + match (mtm,ntm) with + | (Comb(Const("BIT0",_),mt),Const("_0",_)) -> + mk_comb(BIT1_tm,sbcbn mt ntm) + | (Comb(Const("BIT1",_),mt),Const("_0",_)) -> + doublebn mt + | (Comb(Const("BIT0",_),mt),Comb(Const("BIT0",_),nt)) -> + mk_comb(BIT1_tm,sbcbn mt nt) + | (Comb(Const("BIT1",_),mt),Comb(Const("BIT1",_),nt)) -> + mk_comb(BIT1_tm,sbcbn mt nt) + | (Comb(Const("BIT1",_),mt),Comb(Const("BIT0",_),nt)) -> + doublebn (subbn mt nt) + | (Comb(Const("BIT0",_),mt),Comb(Const("BIT1",_),nt)) -> + doublebn (sbcbn mt nt) + | _ -> failwith "malformed numeral or wrong relation" in + let topsplit tm = + match tm with + Const("_0",_) -> 0,zero_tm + | Comb(Const("BIT1",_),Const("_0",_)) -> 1,zero_tm + | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Const("_0",_))) -> 2,zero_tm + | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Const("_0",_))) -> 3,zero_tm + | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 4,zero_tm + | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 5,zero_tm + | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 6,zero_tm + | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Const("_0",_)))) -> 7,zero_tm + | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 0,n + | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 1,n + | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 2,n + | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),n)))) -> 3,n + | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 4,n + | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 5,n + | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 6,n + | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),n)))) -> 7,n + | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 8,n + | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 9,n + | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 10,n + | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),n)))) -> 11,n + | Comb(Const("BIT0",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 12,n + | Comb(Const("BIT1",_),Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 13,n + | Comb(Const("BIT0",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 14,n + | Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),Comb(Const("BIT1",_),n)))) -> 15,n + | _ -> failwith "malformed numeral" in + let NUM_ADD_RULE,NUM_ADC_RULE = + let rec mk_compnumeral k base = + if k = 0 then base else + let t = mk_compnumeral (k / 2) base in + if k mod 2 = 1 then mk_comb(BIT1_tm,t) else mk_comb(BIT0_tm,t) in + let bases v = + let part2 = map (fun k -> mk_compnumeral k v) (8--15) in + let part1 = map (subst[mk_comb(BIT0_tm,v),mk_comb(BIT1_tm,v)]) + part2 + and part0 = map (fun k -> mk_compnumeral k zero_tm) (0--15) in + part0 @ part1 @ part2 in + let starts = + allpairs (fun mtm ntm -> + mk_comb(mk_comb(add_tm,mtm),ntm)) (bases m_tm) (bases n_tm) in + let BITS_INJ = (STANDARDIZE o prove) + (`(BIT0 m = BIT0 n <=> m = n) /\ + (BIT1 m = BIT1 n <=> m = n)`, + REWRITE_TAC[BIT0; BIT1] THEN + REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ]) in + let ARITH_0 = (STANDARDIZE o MESON[NUMERAL; ADD_CLAUSES]) + `m + _0 = m /\ _0 + n = n` in + let patadj = subst[`SUC(m + _0)`,`SUC m`; `SUC(_0 + n)`,`SUC n`] in + let mkclauses sucflag t = + let tm = if sucflag then mk_comb(suc_tm,t) else t in + let th1 = PURE_REWRITE_CONV[ARITH_ADD; ARITH_SUC; ARITH_0] tm in + let tm1 = patadj(rand(concl th1)) in + if not(free_in add_tm tm1) then th1, + (if free_in m_tm tm1 then 0 else 1) else + let ptm = rand(rand(rand(rand tm1))) in + let tmc = mk_eq(mk_eq(ptm,p_tm),mk_eq(tm,subst[p_tm,ptm] tm1)) in + EQT_ELIM(REWRITE_CONV[ARITH_ADD; ARITH_SUC; ARITH_0; BITS_INJ] tmc), + (if free_in suc_tm tm1 then 3 else 2) in + let add_clauses,add_flags = + let l1,l2 = unzip(map (mkclauses false) starts) in + Array.of_list(map STANDARDIZE l1),Array.of_list l2 in + let adc_clauses,adc_flags = + let l1,l2 = unzip(map (mkclauses true) starts) in + Array.of_list(map STANDARDIZE l1),Array.of_list l2 in + let rec NUM_ADD_RULE mtm ntm = + let m_lo,m_hi = topsplit mtm + and n_lo,n_hi = topsplit ntm in + let m_ind = if m_hi = zero_tm then m_lo else m_lo + 16 + and n_ind = if n_hi = zero_tm then n_lo else n_lo + 16 in + let ind = 32 * m_ind + n_ind in + let th1 = Array.get add_clauses ind + and fl = Array.get add_flags ind in + match fl with + 0 -> INST [m_hi,m_tm] th1 + | 1 -> INST [n_hi,n_tm] th1 + | 2 -> let th2 = NUM_ADD_RULE m_hi n_hi in + (match concl th2 with Comb(_,ptm) -> + let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in + EQ_MP th3 th2) + | 3 -> let th2 = NUM_ADC_RULE m_hi n_hi in + (match concl th2 with Comb(_,ptm) -> + let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in + EQ_MP th3 th2) + and NUM_ADC_RULE mtm ntm = + let m_lo,m_hi = topsplit mtm + and n_lo,n_hi = topsplit ntm in + let m_ind = if m_hi = zero_tm then m_lo else m_lo + 16 + and n_ind = if n_hi = zero_tm then n_lo else n_lo + 16 in + let ind = 32 * m_ind + n_ind in + let th1 = Array.get adc_clauses ind + and fl = Array.get adc_flags ind in + match fl with + 0 -> INST [m_hi,m_tm] th1 + | 1 -> INST [n_hi,n_tm] th1 + | 2 -> let th2 = NUM_ADD_RULE m_hi n_hi in + (match concl th2 with Comb(_,ptm) -> + let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in + EQ_MP th3 th2) + | 3 -> let th2 = NUM_ADC_RULE m_hi n_hi in + (match concl th2 with Comb(_,ptm) -> + let th3 = INST [m_hi,m_tm; n_hi,n_tm;ptm,p_tm] th1 in + EQ_MP th3 th2) in + NUM_ADD_RULE,NUM_ADC_RULE in + let NUM_SHIFT_CONV = + let pth_0 = (STANDARDIZE o prove) + (`(n = a + p * b <=> BIT0 n = BIT0 a + BIT0 p * b)`, + REWRITE_TAC[BIT0; BIT1] THEN + REWRITE_TAC[GSYM MULT_2; GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) + and pth_z = (STANDARDIZE o prove) + (`n = _0 + p * b <=> BIT0 n = _0 + BIT0 p * b`, + SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN + REWRITE_TAC[BIT1; BIT0] THEN + REWRITE_TAC[ADD_CLAUSES; GSYM MULT_2] THEN + REWRITE_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL; ARITH_EQ]) + and pth_1 = (STANDARDIZE o prove) + (`(n = a + p * b <=> BIT1 n = BIT1 a + BIT0 p * b)`, + REWRITE_TAC[BIT0; BIT1] THEN + REWRITE_TAC[GSYM MULT_2; GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB; + ADD_CLAUSES; SUC_INJ] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) + and pth_base = (STANDARDIZE o prove) + (`n = _0 + BIT1 _0 * n`, + MESON_TAC[ADD_CLAUSES; MULT_CLAUSES; NUMERAL]) + and pth_triv = (STANDARDIZE o prove) + (`_0 = a + p * b <=> _0 = a + BIT0 p * b`, + CONV_TAC(BINOP_CONV SYM_CONV) THEN + SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN + REWRITE_TAC[ADD_EQ_0; MULT_EQ_0; BIT0]) + and pths_1 = (Array.of_list o CONJUNCTS o STANDARDIZE o prove) + (`(n = a + p * b <=> + BIT0(BIT0(BIT0(BIT0 n))) = + BIT0(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT0(BIT0(BIT0 n))) = + BIT1(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT1(BIT0(BIT0 n))) = + BIT0(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT1(BIT0(BIT0 n))) = + BIT1(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT0(BIT1(BIT0 n))) = + BIT0(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT0(BIT1(BIT0 n))) = + BIT1(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT1(BIT1(BIT0 n))) = + BIT0(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT1(BIT1(BIT0 n))) = + BIT1(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT0(BIT0(BIT1 n))) = + BIT0(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT0(BIT0(BIT1 n))) = + BIT1(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT1(BIT0(BIT1 n))) = + BIT0(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT1(BIT0(BIT1 n))) = + BIT1(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT0(BIT1(BIT1 n))) = + BIT0(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT0(BIT1(BIT1 n))) = + BIT1(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT0(BIT1(BIT1(BIT1 n))) = + BIT0(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = a + p * b <=> + BIT1(BIT1(BIT1(BIT1 n))) = + BIT1(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b)`, + MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT0) THEN + MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT1) THEN + ABBREV_TAC `two = 2` THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_CLAUSES; SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ; + GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC]) + and pths_0 = (Array.of_list o CONJUNCTS o STANDARDIZE o prove) + (`(n = _0 + p * b <=> + BIT0(BIT0(BIT0(BIT0 n))) = + _0 + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT0(BIT0(BIT0 n))) = + BIT1 _0 + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT1(BIT0(BIT0 n))) = + BIT0(BIT1 _0) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT1(BIT0(BIT0 n))) = + BIT1(BIT1 _0) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT0(BIT1(BIT0 n))) = + BIT0(BIT0(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT0(BIT1(BIT0 n))) = + BIT1(BIT0(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT1(BIT1(BIT0 n))) = + BIT0(BIT1(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT1(BIT1(BIT0 n))) = + BIT1(BIT1(BIT1 _0)) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT0(BIT0(BIT1 n))) = + BIT0(BIT0(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT0(BIT0(BIT1 n))) = + BIT1(BIT0(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT1(BIT0(BIT1 n))) = + BIT0(BIT1(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT1(BIT0(BIT1 n))) = + BIT1(BIT1(BIT0(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT0(BIT1(BIT1 n))) = + BIT0(BIT0(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT0(BIT1(BIT1 n))) = + BIT1(BIT0(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT0(BIT1(BIT1(BIT1 n))) = + BIT0(BIT1(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b) /\ + (n = _0 + p * b <=> + BIT1(BIT1(BIT1(BIT1 n))) = + BIT1(BIT1(BIT1(BIT1 _0))) + BIT0(BIT0(BIT0(BIT0 p))) * b)`, + SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN + MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT0) THEN + MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT1) THEN + ABBREV_TAC `two = 2` THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_CLAUSES; SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ; + GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC]) in + let rec NUM_SHIFT_CONV k tm = + if k <= 0 then INST [tm,n_tm] pth_base else + match tm with + Comb(_,Comb(_,Comb(_,Comb(_,_)))) when k >= 4 -> + let i,ntm = topsplit tm in + let th1 = NUM_SHIFT_CONV (k - 4) ntm in + (match concl th1 with + Comb(_,Comb(Comb(_,Const("_0",_)),Comb(Comb(_,ptm),btm))) -> + let th2 = Array.get pths_0 i in + let th3 = INST [ntm,n_tm; btm,b_tm; ptm,p_tm] th2 in + EQ_MP th3 th1 + | Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> + let th2 = Array.get pths_1 i in + let th3 = INST[ntm,n_tm; atm,a_tm; btm,b_tm; ptm,p_tm] th2 in + EQ_MP th3 th1) + | Comb(Const("BIT0",_),ntm) -> + let th1 = NUM_SHIFT_CONV (k - 1) ntm in + (match concl th1 with + Comb(_,Comb(Comb(_,Const("_0",_)),Comb(Comb(_,ptm),btm))) -> + EQ_MP (INST [ntm,n_tm; btm,b_tm; ptm,p_tm] pth_z) th1 + | Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> + EQ_MP + (INST[ntm,n_tm; atm,a_tm; btm,b_tm; ptm,p_tm] pth_0) th1) + | Comb(Const("BIT1",_),ntm) -> + let th1 = NUM_SHIFT_CONV (k - 1) ntm in + (match concl th1 with + Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> + EQ_MP + (INST [ntm,n_tm; atm,a_tm; btm,b_tm; ptm,p_tm] pth_1) th1) + | Const("_0",_) -> + let th1 = NUM_SHIFT_CONV (k - 1) tm in + (match concl th1 with + Comb(_,Comb(Comb(_,atm),Comb(Comb(_,ptm),btm))) -> + EQ_MP (INST [atm,a_tm; btm,b_tm; ptm,p_tm] pth_triv) + th1) + | _ -> failwith "malformed numeral" in + NUM_SHIFT_CONV in + let NUM_UNSHIFT_CONV = + let pth_triv = (STANDARDIZE o prove) + (`a + p * _0 = a`, + SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]) + and pth_base = (STANDARDIZE o prove) + (`a + BIT1 _0 * b = a + b`, + SUBST1_TAC(SYM(SPEC `BIT1 _0` NUMERAL)) THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]) + and pth_0 = (STANDARDIZE o prove) + (`BIT0 a + BIT0 p * b = BIT0(a + p * b)`, + REWRITE_TAC[BIT0] THEN REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB]) + and pth_1 = (STANDARDIZE o prove) + (`BIT1 a + BIT0 p * b = BIT1(a + p * b)`, + REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[ADD_CLAUSES; SUC_INJ] THEN + REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) + and pth_z = (STANDARDIZE o prove) + (`_0 + BIT0 p * b = BIT0(_0 + p * b)`, + SUBST1_TAC(SYM(SPEC `_0` NUMERAL)) THEN + REWRITE_TAC[BIT1; BIT0] THEN REWRITE_TAC[ADD_CLAUSES] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB]) + and puths_1 = (Array.of_list o CONJUNCTS o STANDARDIZE o prove) + (`(a + p * b = n <=> + BIT0(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT0(BIT0(BIT0 n)))) /\ + (a + p * b = n <=> + BIT1(BIT0(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT0(BIT0(BIT0 n)))) /\ + (a + p * b = n <=> + BIT0(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT1(BIT0(BIT0 n)))) /\ + (a + p * b = n <=> + BIT1(BIT1(BIT0(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT1(BIT0(BIT0 n)))) /\ + (a + p * b = n <=> + BIT0(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT0(BIT1(BIT0 n)))) /\ + (a + p * b = n <=> + BIT1(BIT0(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT0(BIT1(BIT0 n)))) /\ + (a + p * b = n <=> + BIT0(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT1(BIT1(BIT0 n)))) /\ + (a + p * b = n <=> + BIT1(BIT1(BIT1(BIT0 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT1(BIT1(BIT0 n)))) /\ + (a + p * b = n <=> + BIT0(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT0(BIT0(BIT1 n)))) /\ + (a + p * b = n <=> + BIT1(BIT0(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT0(BIT0(BIT1 n)))) /\ + (a + p * b = n <=> + BIT0(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT1(BIT0(BIT1 n)))) /\ + (a + p * b = n <=> + BIT1(BIT1(BIT0(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT1(BIT0(BIT1 n)))) /\ + (a + p * b = n <=> + BIT0(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT0(BIT1(BIT1 n)))) /\ + (a + p * b = n <=> + BIT1(BIT0(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT0(BIT1(BIT1 n)))) /\ + (a + p * b = n <=> + BIT0(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT0(BIT1(BIT1(BIT1 n)))) /\ + (a + p * b = n <=> + BIT1(BIT1(BIT1(BIT1 a))) + BIT0(BIT0(BIT0(BIT0 p))) * b = + BIT1(BIT1(BIT1(BIT1 n))))`, + SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN + MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT0) THEN + MP_TAC(REWRITE_RULE[GSYM MULT_2] BIT1) THEN + ABBREV_TAC `two = 2` THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_CLAUSES; SUC_INJ; EQ_MULT_LCANCEL; ARITH_EQ; + GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC]) in + let puths_2 = Array.of_list + (map (fun i -> let th1 = Array.get puths_1 (i mod 16) + and th2 = Array.get puths_1 (i / 16) in + let th3 = GEN_REWRITE_RULE RAND_CONV [th1] th2 in + STANDARDIZE th3) (0--255)) in + let rec NUM_UNSHIFT_CONV tm = + match tm with + Comb(Comb(Const("+",_),atm),Comb(Comb(Const("*",_),ptm),btm)) -> + (match (atm,ptm,btm) with + (_,_,Const("_0",_)) -> + INST [atm,a_tm; ptm,p_tm] pth_triv + | (_,Comb(Const("BIT1",_),Const("_0",_)),_) -> + let th1 = INST [atm,a_tm; btm,b_tm] pth_base in + let Comb(_,Comb(Comb(_,mtm),ntm)) = concl th1 in + TRANS th1 (NUM_ADD_RULE mtm ntm) + | (Comb(_,Comb(_,Comb(_,Comb(_,atm')))), + Comb(_,Comb(_,Comb(_,Comb(_,(Comb(_,_) as ptm'))))),_) -> + let i,_ = topsplit atm in + (match (atm',ptm') with + (Comb(_,Comb(_,Comb(_,Comb(_,atm'')))), + Comb(_,Comb(_,Comb(_,Comb(_,(Comb(_,_) as ptm'')))))) -> + let j,_ = topsplit atm' in + let tm' = mk_comb(mk_comb(add_tm,atm''), + mk_comb(mk_comb(mul_tm,ptm''),btm)) in + let th1 = NUM_UNSHIFT_CONV tm' in + let th2 = INST [atm'',a_tm; ptm'',p_tm; btm,b_tm; + rand(concl th1),n_tm] + (Array.get puths_2 (16 * j + i)) in + EQ_MP th2 th1 + | _ -> + let tm' = mk_comb(mk_comb(add_tm,atm'), + mk_comb(mk_comb(mul_tm,ptm'),btm)) in + let th1 = NUM_UNSHIFT_CONV tm' in + let th2 = INST [atm',a_tm; ptm',p_tm; btm,b_tm; + rand(concl th1),n_tm] + (Array.get puths_1 i) in + EQ_MP th2 th1) + | (Const("_0",_),Comb(Const("BIT0",_),qtm),_) -> + let th1 = INST [btm,b_tm; qtm,p_tm] pth_z in + CONV_RULE(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV)) th1 + | (Comb(Const("BIT0",_),ctm),Comb(Const("BIT0",_),qtm),_) -> + let th1 = INST [ctm,a_tm; btm,b_tm; qtm,p_tm] pth_0 in + CONV_RULE(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV)) th1 + | (Comb(Const("BIT1",_),ctm),Comb(Const("BIT0",_),qtm),_) -> + let th1 = INST [ctm,a_tm; btm,b_tm; qtm,p_tm] pth_1 in + CONV_RULE(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV)) th1 + | _ -> failwith "malformed numeral") + | _ -> failwith "malformed numeral" in + NUM_UNSHIFT_CONV in + let NUM_SQUARE_RULE = + let pth_0 = (STANDARDIZE o prove) + (`_0 EXP 2 = _0`, + MESON_TAC[NUMERAL; REWRITE_CONV[ARITH] `0 EXP 2`]) + and pth_1 = (STANDARDIZE o prove) + (`(BIT1 _0) EXP 2 = BIT1 _0`, + MESON_TAC[NUMERAL; REWRITE_CONV[ARITH] `1 EXP 2`]) + and pth_even = (STANDARDIZE o prove) + (`m EXP 2 = n <=> (BIT0 m) EXP 2 = BIT0(BIT0 n)`, + ABBREV_TAC `two = 2` THEN + REWRITE_TAC[BIT0] THEN EXPAND_TAC "two" THEN + REWRITE_TAC[GSYM MULT_2] THEN REWRITE_TAC[EXP_2] THEN + REWRITE_TAC[AC MULT_AC `(2 * m) * (2 * n) = 2 * 2 * m * n`] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) + and pth_odd = (STANDARDIZE o prove) + (`m EXP 2 = n <=> (BIT1 m) EXP 2 = BIT1(BIT0(m + n))`, + ABBREV_TAC `two = 2` THEN + REWRITE_TAC[NUMERAL; BIT0; BIT1] THEN + EXPAND_TAC "two" THEN REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[EXP_2; MULT_CLAUSES; ADD_CLAUSES] THEN + REWRITE_TAC[SUC_INJ; GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[AC ADD_AC `(m + m * 2 * m) + m = m * 2 * m + m + m`] THEN + REWRITE_TAC[GSYM MULT_2; AC MULT_AC `m * 2 * m = 2 * m * m`] THEN + REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM] THEN + REWRITE_TAC[EQ_ADD_RCANCEL]) + and pth_qstep = (UNDISCH o STANDARDIZE o prove) + (`n + BIT1 _0 = m /\ + m EXP 2 = p /\ + m + a = BIT0(BIT0 p) + ==> (BIT1(BIT1(BIT1 n))) EXP 2 = BIT1(BIT0(BIT0(BIT0 a)))`, + ABBREV_TAC `two = 2` THEN + SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN + REWRITE_TAC[BIT1; BIT0] THEN EXPAND_TAC "two" THEN + REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[ADD1; LEFT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN + REWRITE_TAC[MULT_ASSOC] THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN DISCH_TAC THEN + MATCH_MP_TAC(MESON[EQ_ADD_LCANCEL] + `!m:num. m + n = m + p ==> n = p`) THEN + EXISTS_TAC `16 * (n + 1)` THEN + ASM_REWRITE_TAC[ADD_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + EXPAND_TAC "two" THEN REWRITE_TAC[EXP_2] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_CLAUSES; MULT_ASSOC] THEN + REWRITE_TAC[AC MULT_AC `(8 * n) * NUMERAL p = (8 * NUMERAL p) * n`] THEN + REWRITE_TAC[ARITH] THEN + REWRITE_TAC[AC ADD_AC + `(n + 16) + p + q + 49 = (n + p + q) + (16 + 49)`] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN REWRITE_TAC[ARITH] THEN + REWRITE_TAC[ADD_ASSOC; EQ_ADD_RCANCEL] THEN + REWRITE_TAC[GSYM ADD_ASSOC; GSYM MULT_2; MULT_ASSOC] THEN + ONCE_REWRITE_TAC[AC ADD_AC `a + b + c:num = b + a + c`] THEN + REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[ARITH]) + and pth_rec = (UNDISCH o STANDARDIZE o prove) + (`n = l + p * h /\ + h + l = m /\ + h EXP 2 = a /\ + l EXP 2 = c /\ + m EXP 2 = d /\ + a + c = e /\ + e + b = d + ==> n EXP 2 = c + p * (b + p * a)`, + REWRITE_TAC[IMP_CONJ] THEN + DISCH_THEN SUBST1_TAC THEN + REPLICATE_TAC 5 (DISCH_THEN(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[EXP_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_AC] THEN CONV_TAC(BINOP_CONV NUM_CANCEL_CONV) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]) + and pth_toom3 = (STANDARDIZE o prove) + (`h EXP 2 = e /\ + l EXP 2 = a /\ + (l + BIT1 _0 * (m + BIT1 _0 * h)) EXP 2 = + a + BIT1 _0 * (b + BIT1 _0 * (c + BIT1 _0 * (d + BIT1 _0 * e))) /\ + (l + BIT0(BIT1 _0) * (m + BIT0(BIT1 _0) * h)) EXP 2 = + a + BIT0(BIT1 _0) * (b + BIT0(BIT1 _0) * + (c + BIT0(BIT1 _0) * (d + BIT0(BIT1 _0) * e))) /\ + (h + BIT0(BIT1 _0) * (m + BIT0(BIT1 _0) * l)) EXP 2 = + e + BIT0(BIT1 _0) * (d + BIT0(BIT1 _0) * + (c + BIT0(BIT1 _0) * (b + BIT0(BIT1 _0) * a))) + ==> (l + p * (m + p * h)) EXP 2 = + a + p * (b + p * (c + p * (d + p * e)))`, + ABBREV_TAC `two = 2` THEN + SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN + REWRITE_TAC[BIT1; BIT0] THEN + EXPAND_TAC "two" THEN REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[ARITH] THEN + SUBGOAL_THEN + `!p x y z. (x + p * (y + p * z)) EXP 2 = + x * x + p * (2 * x * y + p * ((2 * x * z + y * y) + + p * (2 * y * z + p * z * z)))` + (fun th -> REWRITE_TAC[th]) + THENL + [REWRITE_TAC[EXP_2; MULT_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]; + REWRITE_TAC[EXP_2]] THEN + MAP_EVERY ABBREV_TAC + [`a':num = l * l`; `b' = 2 * l * m`; `c' = 2 * l * h + m * m`; + `d' = 2 * m * h`; `e':num = h * h`] THEN + SUBST1_TAC(AC MULT_AC `2 * m * l = 2 * l * m`) THEN + SUBST1_TAC(AC MULT_AC `2 * h * l = 2 * l * h`) THEN + SUBST1_TAC(AC MULT_AC `2 * h * m = 2 * m * h`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "two" THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + ASM_CASES_TAC `a':num = a` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `e':num = e` THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[EQ_ADD_LCANCEL; EQ_MULT_LCANCEL] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC] THEN + REWRITE_TAC[ARITH] THEN + REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN + REWRITE_TAC[ADD_ASSOC; EQ_ADD_RCANCEL] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[] + `b = b' /\ c = c' /\ d = d' + ==> 5 * b + c' + d' = 5 * b' + c + d`)) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC] THEN + REWRITE_TAC(map (fun k -> + SYM(REWRITE_CONV[ARITH_SUC] + (mk_comb(suc_tm,mk_small_numeral(k - 1))))) + (1--5)) THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + CONV_TAC(LAND_CONV NUM_CANCEL_CONV) THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (MESON[] + `b = b' /\ c = c' /\ d = d' + ==> b + d':num = b' + d /\ 4 * b + d' = 4 * b' + d`)) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; MULT_ASSOC] THEN + REWRITE_TAC(map (fun k -> + SYM(REWRITE_CONV[ARITH_SUC] + (mk_comb(suc_tm,mk_small_numeral(k - 1))))) + (1--4)) THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES] THEN + CONV_TAC(LAND_CONV(BINOP_CONV NUM_CANCEL_CONV)) THEN + REWRITE_TAC[GSYM MULT_2] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[GSYM(el 4 (CONJUNCTS MULT_CLAUSES))] THEN + SIMP_TAC[EQ_MULT_LCANCEL; NOT_SUC]) + and pth_even3 = (STANDARDIZE o prove) + (`m EXP 2 = n <=> + (BIT0(BIT0(BIT0 m))) EXP 2 = BIT0(BIT0(BIT0(BIT0(BIT0(BIT0 n)))))`, + ABBREV_TAC `two = 2` THEN + REWRITE_TAC[BIT0] THEN REWRITE_TAC[GSYM MULT_2] THEN + EXPAND_TAC "two" THEN REWRITE_TAC[EXP_2] THEN + REWRITE_TAC[AC MULT_AC + `(2 * 2 * 2 * m) * 2 * 2 * 2 * m = 2 * 2 * 2 * 2 * 2 * 2 * m * m`] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; ARITH_EQ]) in + let NUM_UNSHIFT2_CONV = + RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV) THENC NUM_UNSHIFT_CONV in + let NUM_UNSHIFT3_CONV = + RAND_CONV(RAND_CONV NUM_UNSHIFT2_CONV) THENC NUM_UNSHIFT_CONV in + let NUM_UNSHIFT4_CONV = + RAND_CONV(RAND_CONV NUM_UNSHIFT3_CONV) THENC NUM_UNSHIFT_CONV in + let BINOP2_CONV conv1 conv2 = COMB2_CONV (RAND_CONV conv1) conv2 in + let TOOM3_CONV = BINOP2_CONV + (LAND_CONV NUM_UNSHIFT2_CONV) NUM_UNSHIFT4_CONV in + let rec GEN_NUM_SQUARE_RULE w z tm = + match tm with + Const("_0",_) -> pth_0 + | Comb(Const("BIT0",_),mtm) -> + (match mtm with + Comb(Const("BIT0",_),Comb(Const("BIT0",_),ptm)) -> + let th1 = GEN_NUM_SQUARE_RULE w (z - 3) ptm in + let ntm = rand(concl th1) in + EQ_MP (INST [ptm,m_tm; ntm,n_tm] pth_even3) th1 + | _ -> + let th1 = GEN_NUM_SQUARE_RULE w (z - 1) mtm in + let ntm = rand(concl th1) in + EQ_MP (INST [mtm,m_tm; ntm,n_tm] pth_even) th1) + | Comb(Const("BIT1",_),mtm) -> + if mtm = zero_tm then pth_1 else + if (w < 100 or z < 20) & w + z < 150 then + match mtm with + Comb(Const("BIT1",_),Comb(Const("BIT1",_),ntm)) -> + let th1 = NUM_ADD_RULE ntm one_tm in + let mtm = rand(concl th1) in + let th2 = NUM_SQUARE_RULE mtm in + let ptm = rand(concl th2) in + let atm = subbn + (mk_comb(BIT0_tm,mk_comb(BIT0_tm,ptm))) mtm in + let th3 = NUM_ADD_RULE mtm atm in + let th4 = INST + [atm,a_tm; mtm,m_tm; ntm,n_tm; ptm,p_tm] pth_qstep in + QUICK_PROVE_HYP (CONJ th1 (CONJ th2 th3)) th4 + | _ -> + let th1 = GEN_NUM_SQUARE_RULE (w - 1) z mtm in + let ntm = rand(concl th1) in + let th2 = EQ_MP (INST [mtm,m_tm; ntm,n_tm] pth_odd) th1 in + (match concl th2 with + Comb(_,Comb(_,Comb(_,Comb(Comb(_,ptm),qtm)))) -> + let th3 = NUM_ADD_RULE ptm qtm in + TRANS th2 (AP_BIT1 (AP_BIT0 th3))) + else if w + z < 800 then + let k2 = (w + z) / 2 in + let th1 = NUM_SHIFT_CONV k2 tm in + let Comb(Comb(_,ltm),Comb(Comb(_,ptm),htm)) = rand(concl th1) in + let th2 = NUM_ADD_RULE htm ltm in + let mtm = rand(concl th2) in + let th3 = NUM_SQUARE_RULE htm + and th4 = NUM_SQUARE_RULE ltm + and th5 = NUM_SQUARE_RULE mtm in + let atm = rand(concl th3) + and ctm = rand(concl th4) + and dtm = rand(concl th5) in + let th6 = NUM_ADD_RULE atm ctm in + let etm = rand(concl th6) in + let btm = subbn dtm etm in + let th7 = NUM_ADD_RULE etm btm in + let dtm = rand(concl th7) in + let th8 = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; etm,e_tm; + htm,h_tm; ltm,l_tm; mtm,m_tm; tm,n_tm; ptm,p_tm] + pth_rec in + let th9 = QUICK_PROVE_HYP (end_itlist CONJ + [th1;th2;th3;th4;th5;th6;th7]) th8 in + CONV_RULE(RAND_CONV(RAND_CONV(RAND_CONV NUM_UNSHIFT_CONV) THENC + NUM_UNSHIFT_CONV)) th9 + else + let k3 = (w + z) / 3 in + let th0 = (NUM_SHIFT_CONV k3 THENC + RAND_CONV(RAND_CONV(NUM_SHIFT_CONV k3))) tm in + let Comb(Comb(_,ltm),Comb(Comb(_,ptm), + Comb(Comb(_,mtm),Comb(Comb(_,_),htm)))) = rand(concl th0) in + let th1 = NUM_SQUARE_RULE htm + and th2 = NUM_SQUARE_RULE ltm in + let atm = rand(concl th2) and etm = rand(concl th1) in + let lnum = dest_raw_numeral ltm + and mnum = dest_raw_numeral mtm + and hnum = dest_raw_numeral htm in + let btm = rand(mk_numeral(num_2 */ lnum */ mnum)) + and ctm = rand(mk_numeral(mnum */ mnum +/ num_2 */ lnum */ hnum)) + and dtm = rand(mk_numeral(num_2 */ hnum */ mnum)) in + let th = INST + [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; etm,e_tm; + htm,h_tm; mtm,m_tm; ltm,l_tm; ptm,p_tm] pth_toom3 in + let th' = CONV_RULE + (BINOP2_CONV + (RAND_CONV(RAND_CONV + (BINOP2_CONV TOOM3_CONV (BINOP2_CONV TOOM3_CONV TOOM3_CONV)))) + TOOM3_CONV) th in + let [tm3;tm4;tm5] = conjuncts(rand(rand(lhand(concl th')))) in + let th3 = NUM_SQUARE_RULE (lhand(lhand tm3)) + and th4 = NUM_SQUARE_RULE (lhand(lhand tm4)) + and th5 = NUM_SQUARE_RULE (lhand(lhand tm5)) in + MP th' (end_itlist CONJ [th1;th2;th3;th4;th5]) + and NUM_SQUARE_RULE tm = + let w,z = bitcounts tm in GEN_NUM_SQUARE_RULE w z tm in + NUM_SQUARE_RULE in + let NUM_MUL_RULE = + let QUICK_PROVE_HYP ath bth = + EQ_MP (DEDUCT_ANTISYM_RULE ath bth) ath + and pth_0l,pth_0r = (CONJ_PAIR o STANDARDIZE o prove) + (`_0 * n = _0 /\ m * _0 = _0`, + MESON_TAC[NUMERAL; MULT_CLAUSES]) + and pth_1l,pth_1r = (CONJ_PAIR o STANDARDIZE o prove) + (`(BIT1 _0) * n = n /\ m * (BIT1 _0) = m`, + MESON_TAC[NUMERAL; MULT_CLAUSES]) + and pth_evenl,pth_evenr = (CONJ_PAIR o STANDARDIZE o prove) + (`(m * n = p <=> (BIT0 m) * n = BIT0 p) /\ + (m * n = p <=> m * BIT0 n = BIT0 p)`, + REWRITE_TAC[BIT0] THEN REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[AC MULT_AC `m * 2 * n = 2 * m * n`] THEN + REWRITE_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL; ARITH_EQ]) + and pth_oddl,pth_oddr = (CONJ_PAIR o STANDARDIZE o prove) + (`(m * n = p <=> BIT1 m * n = BIT0 p + n) /\ + (m * n = p <=> m * BIT1 n = BIT0 p + m)`, + REWRITE_TAC[BIT0; BIT1] THEN REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[MESON[MULT_AC; ADD_SYM] `m + m * 2 * n = 2 * m * n + m`] THEN + REWRITE_TAC[GSYM MULT_ASSOC; EQ_MULT_LCANCEL; EQ_ADD_RCANCEL] THEN + REWRITE_TAC[ARITH_EQ]) in + let pth_oo1 = (UNDISCH_ALL o STANDARDIZE o prove) + (`n + p = m /\ SUC(m + n) = a /\ p EXP 2 = b /\ a EXP 2 = c /\ b + d = c + ==> ((BIT1 m) * (BIT1 n) = d)`, + ABBREV_TAC `two = 2` THEN REWRITE_TAC[BIT1; IMP_CONJ] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[EXP_2; GSYM MULT_2] THEN + REPLICATE_TAC 4 (DISCH_THEN(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[ADD1; AC ADD_AC `((n + p) + n) + 1 = (p + (n + n)) + 1`] THEN + REWRITE_TAC[GSYM MULT_2] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[GSYM ADD_ASSOC; MULT_CLAUSES; EQ_ADD_LCANCEL] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[MULT_2; LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_AC] THEN REWRITE_TAC[ADD_AC]) in + let pth_oo2 = PURE_ONCE_REWRITE_RULE[MULT_SYM] + (INST [n_tm,m_tm; m_tm,n_tm] pth_oo1) in + let pth_recodel = (UNDISCH_ALL o STANDARDIZE o prove) + (`SUC(_0 + m) = p ==> (p * n = a + n <=> m * n = a)`, + SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; EQ_ADD_RCANCEL]) + and pth_recoder = (UNDISCH_ALL o STANDARDIZE o prove) + (`SUC(_0 + n) = p ==> (m * p = a + m <=> m * n = a)`, + ONCE_REWRITE_TAC[MULT_SYM] THEN + SUBST1_TAC(MESON[NUMERAL] `_0 = 0`) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES; EQ_ADD_RCANCEL]) in + let rec NUM_MUL_RULE k l tm tm' = + match (tm,tm') with + (Const("_0",_),_) -> INST [tm',n_tm] pth_0l + | (_,Const("_0",_)) -> INST [tm,m_tm] pth_0r + | (Comb(Const("BIT1",_),Const("_0",_)),_) -> INST [tm',n_tm] pth_1l + | (_,Comb(Const("BIT1",_),Const("_0",_))) -> INST [tm,m_tm] pth_1r + | (Comb(Const("BIT0",_),mtm),_) -> + let th0 = NUM_MUL_RULE (k - 1) l mtm tm' in + let th1 = INST + [mtm,m_tm; tm',n_tm; rand(concl th0),p_tm] pth_evenl in + EQ_MP th1 th0 + | (_,Comb(Const("BIT0",_),ntm)) -> + let th0 = NUM_MUL_RULE k (l - 1) tm ntm in + let th1 = INST + [tm,m_tm; ntm,n_tm; rand(concl th0),p_tm] pth_evenr in + EQ_MP th1 th0 + | (Comb(Const("BIT1",_),mtm),Comb(Const("BIT1",_),ntm)) -> + if k <= 50 or l <= 50 or + Int k */ Int k <=/ Int l or + Int l */ Int l <= Int k then + match (mtm,ntm) with + (Comb(Const("BIT1",_),Comb(Const("BIT1",_),_)),_) -> + let th1 = NUM_ADC_RULE zero_tm tm in + let ptm = rand(concl th1) in + let th2 = NUM_MUL_RULE k l ptm tm' in + let atm = subbn (rand(concl th2)) tm' in + let th3 = INST [tm,m_tm; tm',n_tm; ptm,p_tm; atm,a_tm] + pth_recodel in + let th4 = PROVE_HYP th1 th3 in + EQ_MP th4 (TRANS th2 (SYM(NUM_ADD_RULE atm tm'))) + | (_,Comb(Const("BIT1",_),Comb(Const("BIT1",_),_))) -> + let th1 = NUM_ADC_RULE zero_tm tm' in + let ptm = rand(concl th1) in + let th2 = NUM_MUL_RULE k l tm ptm in + let atm = subbn (rand(concl th2)) tm in + let th3 = INST [tm,m_tm; tm',n_tm; ptm,p_tm; atm,a_tm] + pth_recoder in + let th4 = PROVE_HYP th1 th3 in + EQ_MP th4 (TRANS th2 (SYM(NUM_ADD_RULE atm tm))) + | _ -> + if k <= l then + let th0 = NUM_MUL_RULE (k - 1) l mtm tm' in + let ptm = rand(concl th0) in + let th1 = + EQ_MP (INST [mtm,m_tm; tm',n_tm; ptm,p_tm] pth_oddl) th0 in + let tm1 = lhand(rand(concl th1)) in + TRANS th1 (NUM_ADD_RULE tm1 tm') + else + let th0 = NUM_MUL_RULE k (l - 1) tm ntm in + let ptm = rand(concl th0) in + let th1 = + EQ_MP (INST [tm,m_tm; ntm,n_tm; ptm,p_tm] pth_oddr) th0 in + let tm1 = lhand(rand(concl th1)) in + TRANS th1 (NUM_ADD_RULE tm1 tm) + else + let mval = dest_raw_numeral mtm + and nval = dest_raw_numeral ntm in + if nval <=/ mval then + let ptm = rand(mk_numeral(mval -/ nval)) in + let th2 = NUM_ADD_RULE ntm ptm + and th3 = NUM_ADC_RULE mtm ntm in + let atm = rand(concl th3) in + let th4 = NUM_SQUARE_RULE ptm in + let btm = rand(concl th4) in + let th5 = NUM_SQUARE_RULE atm in + let ctm = rand(concl th5) in + let dtm = subbn ctm btm in + let th6 = NUM_ADD_RULE btm dtm in + let th1 = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; + mtm,m_tm; ntm,n_tm; ptm,p_tm] pth_oo1 in + QUICK_PROVE_HYP (end_itlist CONJ + [th2;th3;th4;th5;th6]) th1 + else + let ptm = rand(mk_numeral(nval -/ mval)) in + let th2 = NUM_ADD_RULE mtm ptm + and th3 = NUM_ADC_RULE ntm mtm in + let atm = rand(concl th3) in + let th4 = NUM_SQUARE_RULE ptm in + let btm = rand(concl th4) in + let th5 = NUM_SQUARE_RULE atm in + let ctm = rand(concl th5) in + let dtm = subbn ctm btm in + let th6 = NUM_ADD_RULE btm dtm in + let th1 = INST [atm,a_tm; btm,b_tm; ctm,c_tm; dtm,d_tm; + mtm,m_tm; ntm,n_tm; ptm,p_tm] pth_oo2 in + QUICK_PROVE_HYP (end_itlist CONJ + [th2;th3;th4;th5;th6]) th1 + | _ -> failwith "NUM_MUL_RULE" in + NUM_MUL_RULE in + let NUM_MULT_CONV' = + let pth_refl = (STANDARDIZE o MESON[EXP_2]) + `m EXP 2 = p <=> m * m = p` in + fun tm -> + match tm with + Comb(Comb(Const("*",_),mtm),ntm) -> + if Pervasives.compare mtm ntm = 0 then + let th1 = NUM_SQUARE_RULE mtm in + let ptm = rand(concl th1) in + EQ_MP (INST [mtm,m_tm;ptm,p_tm] pth_refl) th1 + else + let w1,z1 = bitcounts mtm and w2,z2 = bitcounts ntm in + NUM_MUL_RULE (w1+z1) (w2+z2) mtm ntm + | _ -> failwith "NUM_MULT_CONV'" in + let NUM_SUC_CONV = + let pth = (STANDARDIZE o prove) + (`SUC(_0 + m) = n <=> SUC(NUMERAL m) = NUMERAL n`, + BINOP_TAC THEN MESON_TAC[NUMERAL; ADD_CLAUSES]) in + fun tm -> + match tm with + Comb(Const("SUC",_),Comb(Const("NUMERAL",_),mtm)) + when wellformed mtm -> + let th1 = NUM_ADC_RULE zero_tm mtm in + let ntm = rand(concl th1) in + EQ_MP(INST [mtm,m_tm; ntm,n_tm] pth) th1 + | _ -> failwith "NUM_SUC_CONV" in + let NUM_ADD_CONV = + let topthm_add = (STANDARDIZE o MESON[NUMERAL]) + `m + n = p <=> NUMERAL m + NUMERAL n = NUMERAL p` in + fun tm -> + match tm with + Comb(Comb(Const("+",_),Comb(Const("NUMERAL",_),mtm)), + Comb(Const("NUMERAL",_),ntm)) + when wellformed mtm & wellformed ntm -> + let th1 = NUM_ADD_RULE mtm ntm in + let ptm = rand(concl th1) in + let th2 = INST [mtm,m_tm; ntm,n_tm; ptm,p_tm] topthm_add in + EQ_MP th2 th1 + | _ -> failwith "NUM_ADD_CONV" in + let NUM_MULT_CONV = + let topthm_mul = (STANDARDIZE o MESON[NUMERAL]) + `m * n = p <=> NUMERAL m * NUMERAL n = NUMERAL p` + and pth_refl = (STANDARDIZE o MESON[NUMERAL; EXP_2]) + `m EXP 2 = p <=> NUMERAL m * NUMERAL m = NUMERAL p` in + fun tm -> + match tm with + Comb(Comb(Const("*",_),Comb(Const("NUMERAL",_),mtm)), + Comb(Const("NUMERAL",_),ntm)) -> + if Pervasives.compare mtm ntm = 0 then + let th1 = NUM_SQUARE_RULE mtm in + let ptm = rand(concl th1) in + EQ_MP (INST [mtm,m_tm;ptm,p_tm] pth_refl) th1 + else + let w1,z1 = bitcounts mtm and w2,z2 = bitcounts ntm in + let th1 = NUM_MUL_RULE (w1+z1) (w2+z2) mtm ntm in + let ptm = rand(concl th1) in + let th2 = INST [mtm,m_tm; ntm,n_tm; ptm,p_tm] topthm_mul in + EQ_MP th2 th1 + | _ -> failwith "NUM_MULT_CONV" in + let NUM_EXP_CONV = + let pth0 = (STANDARDIZE o prove) + (`(m EXP n = p) ==> (p * p = a) ==> (m EXP (BIT0 n) = a)`, + REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[BIT0; EXP_ADD]) + and pth1 = (STANDARDIZE o prove) + (`(m EXP n = p) ==> (p * p = b) ==> (m * b = a) ==> (m EXP (BIT1 n) = a)`, + REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[BIT1; EXP_ADD; EXP]) + and pth = (STANDARDIZE o prove) + (`m EXP _0 = BIT1 _0`, + MP_TAC (CONJUNCT1 EXP) THEN REWRITE_TAC[NUMERAL; BIT1] THEN + DISCH_THEN MATCH_ACCEPT_TAC) + and tth = (STANDARDIZE o prove) + (`(NUMERAL m) EXP (NUMERAL n) = m EXP n`, + REWRITE_TAC[NUMERAL]) + and fth = (STANDARDIZE o prove) + (`m = NUMERAL m`, + REWRITE_TAC[NUMERAL]) in + let tconv = GEN_REWRITE_CONV I [tth] in + let rec NUM_EXP_CONV l r = + if r = zero_tm then INST [l,m_tm] pth else + let b,r' = dest_comb r in + if b = BIT0_tm then + let th1 = NUM_EXP_CONV l r' in + let tm1 = rand(concl th1) in + let th2 = NUM_MULT_CONV' (mk_binop mul_tm tm1 tm1) in + let tm2 = rand(concl th2) in + MP (MP (INST [l,m_tm; r',n_tm; tm1,p_tm; tm2,a_tm] pth0) th1) th2 + else + let th1 = NUM_EXP_CONV l r' in + let tm1 = rand(concl th1) in + let th2 = NUM_MULT_CONV' (mk_binop mul_tm tm1 tm1) in + let tm2 = rand(concl th2) in + let th3 = NUM_MULT_CONV' (mk_binop mul_tm l tm2) in + let tm3 = rand(concl th3) in + MP (MP (MP (INST [l,m_tm; r',n_tm; tm1,p_tm; tm2,b_tm; tm3,a_tm] + pth1) th1) th2) th3 in + fun tm -> try let th = tconv tm in + let lop,r = dest_comb (rand(concl th)) in + let _,l = dest_comb lop in + if not (wellformed l & wellformed r) then failwith "" else + let th' = NUM_EXP_CONV l r in + let tm' = rand(concl th') in + TRANS (TRANS th th') (INST [tm',m_tm] fth) + with Failure _ -> failwith "NUM_EXP_CONV" in + let NUM_LT_CONV = + let pth = (UNDISCH o STANDARDIZE o prove) + (`SUC(m + n) = p ==> ((NUMERAL n < NUMERAL p) <=> T)`, + REWRITE_TAC[NUMERAL; LT_EXISTS; ADD_CLAUSES] THEN + MESON_TAC[ADD_SYM]) + and qth = (UNDISCH o STANDARDIZE o prove) + (`m + p = n ==> (NUMERAL n < NUMERAL p <=> F)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[NOT_LT; NUMERAL] THEN + MESON_TAC[LE_ADD; ADD_SYM]) + and rth = (STANDARDIZE o prove) + (`NUMERAL n < NUMERAL n <=> F`, + MESON_TAC[LT_REFL]) in + fun tm -> + match tm with + Comb(Comb(Const("<",_),Comb(Const("NUMERAL",_),mtm)), + Comb(Const("NUMERAL",_),ntm)) -> + let rel = orderrelation mtm ntm in + if rel = 0 then INST[ntm,n_tm] rth + else if rel < 0 then + let dtm = sbcbn ntm mtm in + let th = NUM_ADC_RULE dtm mtm in + QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] pth) + else + let dtm = subbn mtm ntm in + let th = NUM_ADD_RULE dtm ntm in + QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] qth) + | _ -> failwith "NUM_LT_CONV" + and NUM_LE_CONV = + let pth = (UNDISCH o STANDARDIZE o prove) + (`m + n = p ==> ((NUMERAL n <= NUMERAL p) <=> T)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[NUMERAL] THEN + MESON_TAC[LE_ADD; ADD_SYM]) + and qth = (UNDISCH o STANDARDIZE o prove) + (`SUC(m + p) = n ==> (NUMERAL n <= NUMERAL p <=> F)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[NUMERAL; NOT_LE; ADD_CLAUSES; LT_EXISTS] THEN + MESON_TAC[ADD_SYM]) + and rth = (STANDARDIZE o prove) + (`NUMERAL n <= NUMERAL n <=> T`, + REWRITE_TAC[LE_REFL]) in + fun tm -> + match tm with + Comb(Comb(Const("<=",_),Comb(Const("NUMERAL",_),mtm)), + Comb(Const("NUMERAL",_),ntm)) -> + let rel = orderrelation mtm ntm in + if rel = 0 then INST[ntm,n_tm] rth + else if rel < 0 then + let dtm = subbn ntm mtm in + let th = NUM_ADD_RULE dtm mtm in + QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] pth) + else + let dtm = sbcbn mtm ntm in + let th = NUM_ADC_RULE dtm ntm in + QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] qth) + | _ -> failwith "NUM_LE_CONV" + and NUM_EQ_CONV = + let pth = (UNDISCH o STANDARDIZE o prove) + (`SUC(m + n) = p ==> ((NUMERAL n = NUMERAL p) <=> F)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[NUMERAL; GSYM LE_ANTISYM; DE_MORGAN_THM] THEN + REWRITE_TAC[NOT_LE; LT_EXISTS; ADD_CLAUSES] THEN + MESON_TAC[ADD_SYM]) + and qth = (UNDISCH o STANDARDIZE o prove) + (`SUC(m + p) = n ==> ((NUMERAL n = NUMERAL p) <=> F)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[NUMERAL; GSYM LE_ANTISYM; DE_MORGAN_THM] THEN + REWRITE_TAC[NOT_LE; LT_EXISTS; ADD_CLAUSES] THEN + MESON_TAC[ADD_SYM]) + and rth = (STANDARDIZE o prove) + (`(NUMERAL n = NUMERAL n) <=> T`, + REWRITE_TAC[]) in + fun tm -> + match tm with + Comb(Comb(Const("=",_),Comb(Const("NUMERAL",_),mtm)), + Comb(Const("NUMERAL",_),ntm)) -> + let rel = orderrelation mtm ntm in + if rel = 0 then INST [ntm,n_tm] rth + else if rel < 0 then + let dtm = sbcbn ntm mtm in + let th = NUM_ADC_RULE dtm mtm in + QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] pth) + else + let dtm = sbcbn mtm ntm in + let th = NUM_ADC_RULE dtm ntm in + QUICK_PROVE_HYP th (INST [dtm,m_tm; mtm,n_tm; ntm,p_tm] qth) + | _ -> failwith "NUM_EQ_CONV" in + NUM_SUC_CONV,NUM_ADD_CONV,NUM_MULT_CONV,NUM_EXP_CONV, + NUM_LT_CONV,NUM_LE_CONV,NUM_EQ_CONV;; + +let NUM_GT_CONV = GEN_REWRITE_CONV I [GT] THENC NUM_LT_CONV;; + +let NUM_GE_CONV = GEN_REWRITE_CONV I [GE] THENC NUM_LE_CONV;; + +let NUM_PRE_CONV = + let tth = prove + (`PRE 0 = 0`, + REWRITE_TAC[PRE]) in + let pth = prove + (`(SUC m = n) ==> (PRE n = m)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[PRE]) + and m = `m:num` and n = `n:num` in + let suc = `SUC` in + let pre = `PRE` in + fun tm -> try let l,r = dest_comb tm in + if not (l = pre) then fail() else + let x = dest_numeral r in + if x =/ Int 0 then tth else + let tm' = mk_numeral (x -/ Int 1) in + let th1 = NUM_SUC_CONV (mk_comb(suc,tm')) in + MP (INST [tm',m; r,n] pth) th1 + with Failure _ -> failwith "NUM_PRE_CONV";; + +let NUM_SUB_CONV = + let pth0 = prove + (`p <= n ==> (p - n = 0)`, + REWRITE_TAC[SUB_EQ_0]) + and pth1 = prove + (`(m + n = p) ==> (p - n = m)`, + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ADD_SUB]) + and m = `m:num` and n = `n:num` and p = `p:num` + and minus = `(-)` + and plus = `(+)` + and le = `(<=)` in + fun tm -> try let l,r = dest_binop minus tm in + let ln = dest_numeral l + and rn = dest_numeral r in + if ln <=/ rn then + let pth = INST [l,p; r,n] pth0 + and th0 = EQT_ELIM(NUM_LE_CONV (mk_binop le l r)) in + MP pth th0 + else + let kn = ln -/ rn in + let k = mk_numeral kn in + let pth = INST [k,m; l,p; r,n] pth1 + and th0 = NUM_ADD_CONV (mk_binop plus k r) in + MP pth th0 + with Failure _ -> failwith "NUM_SUB_CONV";; + +let NUM_DIV_CONV,NUM_MOD_CONV = + let pth = prove + (`(q * n + r = m) ==> r < n ==> (m DIV n = q) /\ (m MOD n = r)`, + MESON_TAC[DIVMOD_UNIQ]) + and m = `m:num` and n = `n:num` and q = `q:num` and r = `r:num` + and dtm = `(DIV)` and mtm = `(MOD)` in + let NUM_DIVMOD_CONV x y = + let k = quo_num x y + and l = mod_num x y in + let th0 = INST [mk_numeral x,m; mk_numeral y,n; + mk_numeral k,q; mk_numeral l,r] pth in + let tm0 = lhand(lhand(concl th0)) in + let th1 = (LAND_CONV NUM_MULT_CONV THENC NUM_ADD_CONV) tm0 in + let th2 = MP th0 th1 in + let tm2 = lhand(concl th2) in + MP th2 (EQT_ELIM(NUM_LT_CONV tm2)) in + (fun tm -> try let xt,yt = dest_binop dtm tm in + CONJUNCT1(NUM_DIVMOD_CONV (dest_numeral xt) (dest_numeral yt)) + with Failure _ -> failwith "NUM_DIV_CONV"), + (fun tm -> try let xt,yt = dest_binop mtm tm in + CONJUNCT2(NUM_DIVMOD_CONV (dest_numeral xt) (dest_numeral yt)) + with Failure _ -> failwith "NUM_MOD_CONV");; + +let NUM_FACT_CONV = + let suc = `SUC` + and mul = `(*)` in + let pth_0 = prove + (`FACT 0 = 1`, + REWRITE_TAC[FACT]) + and pth_suc = prove + (`(SUC x = y) ==> (FACT x = w) ==> (y * w = z) ==> (FACT y = z)`, + REPEAT (DISCH_THEN(SUBST1_TAC o SYM)) THEN + REWRITE_TAC[FACT]) + and w = `w:num` and x = `x:num` and y = `y:num` and z = `z:num` in + let mksuc n = + let n' = n -/ (Int 1) in + NUM_SUC_CONV (mk_comb(suc,mk_numeral n')) in + let rec NUM_FACT_CONV n = + if n =/ Int 0 then pth_0 else + let th0 = mksuc n in + let tmx = rand(lhand(concl th0)) in + let tm0 = rand(concl th0) in + let th1 = NUM_FACT_CONV (n -/ Int 1) in + let tm1 = rand(concl th1) in + let th2 = NUM_MULT_CONV (mk_binop mul tm0 tm1) in + let tm2 = rand(concl th2) in + let pth = INST [tmx,x; tm0, y; tm1,w; tm2,z] pth_suc in + MP (MP (MP pth th0) th1) th2 in + fun tm -> + try let l,r = dest_comb tm in + if fst(dest_const l) = "FACT" + then NUM_FACT_CONV (dest_numeral r) + else fail() + with Failure _ -> failwith "NUM_FACT_CONV";; + +let NUM_MAX_CONV = + REWR_CONV MAX THENC + RATOR_CONV(RATOR_CONV(RAND_CONV NUM_LE_CONV)) THENC + GEN_REWRITE_CONV I [COND_CLAUSES];; + +let NUM_MIN_CONV = + REWR_CONV MIN THENC + RATOR_CONV(RATOR_CONV(RAND_CONV NUM_LE_CONV)) THENC + GEN_REWRITE_CONV I [COND_CLAUSES];; + +(* ------------------------------------------------------------------------- *) +(* Final hack-together. *) +(* ------------------------------------------------------------------------- *) + +let NUM_REL_CONV = + let gconv_net = itlist (uncurry net_of_conv) + [`NUMERAL m < NUMERAL n`,NUM_LT_CONV; + `NUMERAL m <= NUMERAL n`,NUM_LE_CONV; + `NUMERAL m > NUMERAL n`,NUM_GT_CONV; + `NUMERAL m >= NUMERAL n`,NUM_GE_CONV; + `NUMERAL m = NUMERAL n`,NUM_EQ_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let NUM_RED_CONV = + let gconv_net = itlist (uncurry net_of_conv) + [`SUC(NUMERAL n)`,NUM_SUC_CONV; + `PRE(NUMERAL n)`,NUM_PRE_CONV; + `FACT(NUMERAL n)`,NUM_FACT_CONV; + `NUMERAL m < NUMERAL n`,NUM_LT_CONV; + `NUMERAL m <= NUMERAL n`,NUM_LE_CONV; + `NUMERAL m > NUMERAL n`,NUM_GT_CONV; + `NUMERAL m >= NUMERAL n`,NUM_GE_CONV; + `NUMERAL m = NUMERAL n`,NUM_EQ_CONV; + `EVEN(NUMERAL n)`,NUM_EVEN_CONV; + `ODD(NUMERAL n)`,NUM_ODD_CONV; + `NUMERAL m + NUMERAL n`,NUM_ADD_CONV; + `NUMERAL m - NUMERAL n`,NUM_SUB_CONV; + `NUMERAL m * NUMERAL n`,NUM_MULT_CONV; + `(NUMERAL m) EXP (NUMERAL n)`,NUM_EXP_CONV; + `(NUMERAL m) DIV (NUMERAL n)`,NUM_DIV_CONV; + `(NUMERAL m) MOD (NUMERAL n)`,NUM_MOD_CONV; + `MAX (NUMERAL m) (NUMERAL n)`,NUM_MAX_CONV; + `MIN (NUMERAL m) (NUMERAL n)`,NUM_MIN_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let NUM_REDUCE_CONV = DEPTH_CONV NUM_RED_CONV;; + +let NUM_REDUCE_TAC = CONV_TAC NUM_REDUCE_CONV;; + +(* ------------------------------------------------------------------------- *) +(* I do like this after all... *) +(* ------------------------------------------------------------------------- *) + +let num_CONV = + let SUC_tm = `SUC` in + fun tm -> + let n = dest_numeral tm -/ Int 1 in + if n P(n)" into all the cases. *) +(* ------------------------------------------------------------------------- *) + +let EXPAND_CASES_CONV = + let pth_base = prove + (`(!n. n < 0 ==> P n) <=> T`, + REWRITE_TAC[LT]) + and pth_step = prove + (`(!n. n < SUC k ==> P n) <=> (!n. n < k ==> P n) /\ P k`, + REWRITE_TAC[LT] THEN MESON_TAC[]) in + let base_CONV = GEN_REWRITE_CONV I [pth_base] + and step_CONV = + BINDER_CONV(LAND_CONV(RAND_CONV num_CONV)) THENC + GEN_REWRITE_CONV I [pth_step] in + let rec conv tm = + (base_CONV ORELSEC (step_CONV THENC LAND_CONV conv)) tm in + conv THENC (REWRITE_CONV[GSYM CONJ_ASSOC]);; diff --git a/calc_rat.ml b/calc_rat.ml new file mode 100644 index 0000000..eece6d6 --- /dev/null +++ b/calc_rat.ml @@ -0,0 +1,566 @@ +(* ========================================================================= *) +(* Calculation with rational-valued reals. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "real.ml";; + +(* ------------------------------------------------------------------------- *) +(* Constant for decimal fractions written #xxx.yyy *) +(* ------------------------------------------------------------------------- *) + +let DECIMAL = new_definition + `DECIMAL x y = &x / &y`;; + +(* ------------------------------------------------------------------------- *) +(* Various handy lemmas. *) +(* ------------------------------------------------------------------------- *) + +let RAT_LEMMA1 = prove + (`~(y1 = &0) /\ ~(y2 = &0) ==> + ((x1 / y1) + (x2 / y2) = (x1 * y2 + x2 * y1) * inv(y1) * inv(y2))`, + STRIP_TAC THEN REWRITE_TAC[real_div; REAL_ADD_RDISTRIB] THEN BINOP_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN ONCE_REWRITE_TAC + [AC REAL_MUL_AC `a * b * c = (b * a) * c`]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN + DISJ2_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN + ASM_REWRITE_TAC[]);; + +let RAT_LEMMA2 = prove + (`&0 < y1 /\ &0 < y2 ==> + ((x1 / y1) + (x2 / y2) = (x1 * y2 + x2 * y1) * inv(y1) * inv(y2))`, + DISCH_TAC THEN MATCH_MP_TAC RAT_LEMMA1 THEN POP_ASSUM MP_TAC THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_LT_REFL]);; + +let RAT_LEMMA3 = prove + (`&0 < y1 /\ &0 < y2 ==> + ((x1 / y1) - (x2 / y2) = (x1 * y2 - x2 * y1) * inv(y1) * inv(y2))`, + DISCH_THEN(MP_TAC o GEN_ALL o MATCH_MP RAT_LEMMA2) THEN + REWRITE_TAC[real_div] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[real_sub; GSYM REAL_MUL_LNEG]);; + +let RAT_LEMMA4 = prove + (`&0 < y1 /\ &0 < y2 ==> (x1 / y1 <= x2 / y2 <=> x1 * y2 <= x2 * y1)`, + let lemma = prove + (`&0 < y ==> (&0 <= x * y <=> &0 <= x)`, + DISCH_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN `&0 <= x * (y * inv y)` MP_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `y * inv y = &1` (fun th -> + REWRITE_TAC[th; REAL_MUL_RID]) THEN + MATCH_MP_TAC REAL_MUL_RINV THEN + UNDISCH_TAC `&0 < y` THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]) in + ONCE_REWRITE_TAC[CONJ_SYM] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a <= b <=> &0 <= b - a`] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP RAT_LEMMA3 th]) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&0 <= (x2 * y1 - x1 * y2) * inv y2` THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN CONJ_TAC THEN + MATCH_MP_TAC lemma THEN MATCH_MP_TAC REAL_LT_INV THEN + ASM_REWRITE_TAC[]);; + +let RAT_LEMMA5 = prove + (`&0 < y1 /\ &0 < y2 ==> ((x1 / y1 = x2 / y2) <=> (x1 * y2 = x2 * y1))`, + REPEAT DISCH_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + MATCH_MP_TAC(TAUT `(a <=> a') /\ (b <=> b') ==> (a /\ b <=> a' /\ b')`) THEN + CONJ_TAC THEN MATCH_MP_TAC RAT_LEMMA4 THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Create trivial rational from integer or decimal, and postconvert back. *) +(* ------------------------------------------------------------------------- *) + +let REAL_INT_RAT_CONV = + let pth = prove + (`(&x = &x / &1) /\ + (--(&x) = --(&x) / &1) /\ + (DECIMAL x y = &x / &y) /\ + (--(DECIMAL x y) = --(&x) / &y)`, + REWRITE_TAC[REAL_DIV_1; DECIMAL] THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG]) in + TRY_CONV(GEN_REWRITE_CONV I [pth]);; + +(* ------------------------------------------------------------------------- *) +(* Relational operations. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_LE_CONV = + let pth = prove + (`&0 < y1 ==> &0 < y2 ==> (x1 / y1 <= x2 / y2 <=> x1 * y2 <= x2 * y1)`, + REWRITE_TAC[IMP_IMP; RAT_LEMMA4]) + and x1 = `x1:real` and x2 = `x2:real` + and y1 = `y1:real` and y2 = `y2:real` + and dest_le = dest_binop `(<=)` + and dest_div = dest_binop `(/)` in + let RAW_REAL_RAT_LE_CONV tm = + let l,r = dest_le tm in + let lx,ly = dest_div l + and rx,ry = dest_div r in + let th0 = INST [lx,x1; ly,y1; rx,x2; ry,y2] pth in + let th1 = funpow 2 (MP_CONV REAL_INT_LT_CONV) th0 in + let th2 = (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_LE_CONV) + (rand(concl th1)) in + TRANS th1 th2 in + BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_LE_CONV;; + +let REAL_RAT_LT_CONV = + let pth = prove + (`&0 < y1 ==> &0 < y2 ==> (x1 / y1 < x2 / y2 <=> x1 * y2 < x2 * y1)`, + REWRITE_TAC[IMP_IMP] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_NOT_LE] THEN + SIMP_TAC[TAUT `(~a <=> ~b) <=> (a <=> b)`; RAT_LEMMA4]) + and x1 = `x1:real` and x2 = `x2:real` + and y1 = `y1:real` and y2 = `y2:real` + and dest_lt = dest_binop `(<)` + and dest_div = dest_binop `(/)` in + let RAW_REAL_RAT_LT_CONV tm = + let l,r = dest_lt tm in + let lx,ly = dest_div l + and rx,ry = dest_div r in + let th0 = INST [lx,x1; ly,y1; rx,x2; ry,y2] pth in + let th1 = funpow 2 (MP_CONV REAL_INT_LT_CONV) th0 in + let th2 = (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_LT_CONV) + (rand(concl th1)) in + TRANS th1 th2 in + BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_LT_CONV;; + +let REAL_RAT_GE_CONV = + GEN_REWRITE_CONV I [real_ge] THENC REAL_RAT_LE_CONV;; + +let REAL_RAT_GT_CONV = + GEN_REWRITE_CONV I [real_gt] THENC REAL_RAT_LT_CONV;; + +let REAL_RAT_EQ_CONV = + let pth = prove + (`&0 < y1 ==> &0 < y2 ==> ((x1 / y1 = x2 / y2) <=> (x1 * y2 = x2 * y1))`, + REWRITE_TAC[IMP_IMP; RAT_LEMMA5]) + and x1 = `x1:real` and x2 = `x2:real` + and y1 = `y1:real` and y2 = `y2:real` + and dest_eq = dest_binop `(=) :real->real->bool` + and dest_div = dest_binop `(/)` in + let RAW_REAL_RAT_EQ_CONV tm = + let l,r = dest_eq tm in + let lx,ly = dest_div l + and rx,ry = dest_div r in + let th0 = INST [lx,x1; ly,y1; rx,x2; ry,y2] pth in + let th1 = funpow 2 (MP_CONV REAL_INT_LT_CONV) th0 in + let th2 = (BINOP_CONV REAL_INT_MUL_CONV THENC REAL_INT_EQ_CONV) + (rand(concl th1)) in + TRANS th1 th2 in + BINOP_CONV REAL_INT_RAT_CONV THENC RAW_REAL_RAT_EQ_CONV;; + +(* ------------------------------------------------------------------------- *) +(* The unary operations; all easy. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_NEG_CONV = + let pth = prove + (`(--(&0) = &0) /\ + (--(--(&n)) = &n) /\ + (--(&m / &n) = --(&m) / &n) /\ + (--(--(&m) / &n) = &m / &n) /\ + (--(DECIMAL m n) = --(&m) / &n)`, + REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_LNEG; REAL_NEG_NEG; + REAL_NEG_0; DECIMAL]) + and ptm = `(--)` in + let conv1 = GEN_REWRITE_CONV I [pth] in + fun tm -> try conv1 tm + with Failure _ -> try + let l,r = dest_comb tm in + if l = ptm & is_realintconst r & dest_realintconst r >/ num_0 + then REFL tm + else fail() + with Failure _ -> failwith "REAL_RAT_NEG_CONV";; + +let REAL_RAT_ABS_CONV = + let pth = prove + (`(abs(&n) = &n) /\ + (abs(--(&n)) = &n) /\ + (abs(&m / &n) = &m / &n) /\ + (abs(--(&m) / &n) = &m / &n) /\ + (abs(DECIMAL m n) = &m / &n) /\ + (abs(--(DECIMAL m n)) = &m / &n)`, + REWRITE_TAC[DECIMAL; REAL_ABS_DIV; REAL_ABS_NEG; REAL_ABS_NUM]) in + GEN_REWRITE_CONV I [pth];; + +let REAL_RAT_INV_CONV = + let pth1 = prove + (`(inv(&0) = &0) /\ + (inv(&1) = &1) /\ + (inv(-- &1) = --(&1)) /\ + (inv(&1 / &n) = &n) /\ + (inv(-- &1 / &n) = -- &n)`, + REWRITE_TAC[REAL_INV_0; REAL_INV_1; REAL_INV_NEG; + REAL_INV_DIV; REAL_DIV_1] THEN + REWRITE_TAC[real_div; REAL_INV_NEG; REAL_MUL_RNEG; REAL_INV_1; + REAL_MUL_RID]) + and pth2 = prove + (`(inv(&n) = &1 / &n) /\ + (inv(--(&n)) = --(&1) / &n) /\ + (inv(&m / &n) = &n / &m) /\ + (inv(--(&m) / &n) = --(&n) / &m) /\ + (inv(DECIMAL m n) = &n / &m) /\ + (inv(--(DECIMAL m n)) = --(&n) / &m)`, + REWRITE_TAC[DECIMAL; REAL_INV_DIV] THEN + REWRITE_TAC[REAL_INV_NEG; real_div; REAL_MUL_RNEG; REAL_MUL_AC; + REAL_MUL_LID; REAL_MUL_LNEG; REAL_INV_MUL; REAL_INV_INV]) in + GEN_REWRITE_CONV I [pth1] ORELSEC + GEN_REWRITE_CONV I [pth2];; + +(* ------------------------------------------------------------------------- *) +(* Addition. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_ADD_CONV = + let pth = prove + (`&0 < y1 ==> &0 < y2 ==> &0 < y3 ==> + ((x1 * y2 + x2 * y1) * y3 = x3 * y1 * y2) + ==> (x1 / y1 + x2 / y2 = x3 / y3)`, + REPEAT DISCH_TAC THEN + MP_TAC RAT_LEMMA2 THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM REAL_INV_MUL; GSYM real_div] THEN + SUBGOAL_THEN `&0 < y1 * y2 /\ &0 < y3` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> ASM_REWRITE_TAC[MATCH_MP RAT_LEMMA5 th])]) + and dest_divop = dest_binop `(/)` + and dest_addop = dest_binop `(+)` + and x1 = `x1:real` and x2 = `x2:real` and x3 = `x3:real` + and y1 = `y1:real` and y2 = `y2:real` and y3 = `y3:real` in + let RAW_REAL_RAT_ADD_CONV tm = + let r1,r2 = dest_addop tm in + let x1',y1' = dest_divop r1 + and x2',y2' = dest_divop r2 in + let x1n = dest_realintconst x1' and y1n = dest_realintconst y1' + and x2n = dest_realintconst x2' and y2n = dest_realintconst y2' in + let x3n = x1n */ y2n +/ x2n */ y1n + and y3n = y1n */ y2n in + let d = gcd_num x3n y3n in + let x3n' = quo_num x3n d and y3n' = quo_num y3n d in + let x3n'',y3n'' = if y3n' >/ Int 0 then x3n',y3n' + else minus_num x3n',minus_num y3n' in + let x3' = mk_realintconst x3n'' and y3' = mk_realintconst y3n'' in + let th0 = INST [x1',x1; y1',y1; x2',x2; y2',y2; x3',x3; y3',y3] pth in + let th1 = funpow 3 (MP_CONV REAL_INT_LT_CONV) th0 in + let tm2,tm3 = dest_eq(fst(dest_imp(concl th1))) in + let th2 = (LAND_CONV (BINOP_CONV REAL_INT_MUL_CONV THENC + REAL_INT_ADD_CONV) THENC + REAL_INT_MUL_CONV) tm2 + and th3 = (RAND_CONV REAL_INT_MUL_CONV THENC REAL_INT_MUL_CONV) tm3 in + MP th1 (TRANS th2 (SYM th3)) in + BINOP_CONV REAL_INT_RAT_CONV THENC + RAW_REAL_RAT_ADD_CONV THENC TRY_CONV(GEN_REWRITE_CONV I [REAL_DIV_1]);; + +(* ------------------------------------------------------------------------- *) +(* Subtraction. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_SUB_CONV = + let pth = prove + (`x - y = x + --y`, + REWRITE_TAC[real_sub]) in + GEN_REWRITE_CONV I [pth] THENC + RAND_CONV REAL_RAT_NEG_CONV THENC REAL_RAT_ADD_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Multiplication. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_MUL_CONV = + let pth_nocancel = prove + (`(x1 / y1) * (x2 / y2) = (x1 * x2) / (y1 * y2)`, + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_AC]) + and pth_cancel = prove + (`~(d1 = &0) /\ ~(d2 = &0) /\ + (d1 * u1 = x1) /\ (d2 * u2 = x2) /\ + (d2 * v1 = y1) /\ (d1 * v2 = y2) + ==> ((x1 / y1) * (x2 / y2) = (u1 * u2) / (v1 * v2))`, + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN + ASM_REWRITE_TAC[real_div; REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC + `((d1 * u1) * (id2 * iv1)) * ((d2 * u2) * id1 * iv2) = + (u1 * u2) * (iv1 * iv2) * (id2 * d2) * (id1 * d1)`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID]) + and dest_divop = dest_binop `(/)` + and dest_mulop = dest_binop `(*)` + and x1 = `x1:real` and x2 = `x2:real` + and y1 = `y1:real` and y2 = `y2:real` + and u1 = `u1:real` and u2 = `u2:real` + and v1 = `v1:real` and v2 = `v2:real` + and d1 = `d1:real` and d2 = `d2:real` in + let RAW_REAL_RAT_MUL_CONV tm = + let r1,r2 = dest_mulop tm in + let x1',y1' = dest_divop r1 + and x2',y2' = dest_divop r2 in + let x1n = dest_realintconst x1' and y1n = dest_realintconst y1' + and x2n = dest_realintconst x2' and y2n = dest_realintconst y2' in + let d1n = gcd_num x1n y2n + and d2n = gcd_num x2n y1n in + if d1n = num_1 & d2n = num_1 then + let th0 = INST [x1',x1; y1',y1; x2',x2; y2',y2] pth_nocancel in + let th1 = BINOP_CONV REAL_INT_MUL_CONV (rand(concl th0)) in + TRANS th0 th1 + else + let u1n = quo_num x1n d1n + and u2n = quo_num x2n d2n + and v1n = quo_num y1n d2n + and v2n = quo_num y2n d1n in + let u1' = mk_realintconst u1n + and u2' = mk_realintconst u2n + and v1' = mk_realintconst v1n + and v2' = mk_realintconst v2n + and d1' = mk_realintconst d1n + and d2' = mk_realintconst d2n in + let th0 = INST [x1',x1; y1',y1; x2',x2; y2',y2; + u1',u1; v1',v1; u2',u2; v2',v2; d1',d1; d2',d2] + pth_cancel in + let th1 = EQT_ELIM(REAL_INT_REDUCE_CONV(lhand(concl th0))) in + let th2 = MP th0 th1 in + let th3 = BINOP_CONV REAL_INT_MUL_CONV (rand(concl th2)) in + TRANS th2 th3 in + BINOP_CONV REAL_INT_RAT_CONV THENC + RAW_REAL_RAT_MUL_CONV THENC TRY_CONV(GEN_REWRITE_CONV I [REAL_DIV_1]);; + +(* ------------------------------------------------------------------------- *) +(* Division. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_DIV_CONV = + let pth = prove + (`x / y = x * inv(y)`, + REWRITE_TAC[real_div]) in + GEN_REWRITE_CONV I [pth] THENC + RAND_CONV REAL_RAT_INV_CONV THENC REAL_RAT_MUL_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Powers. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_POW_CONV = + let pth = prove + (`(x / y) pow n = (x pow n) / (y pow n)`, + REWRITE_TAC[REAL_POW_DIV]) in + REAL_INT_POW_CONV ORELSEC + (LAND_CONV REAL_INT_RAT_CONV THENC + GEN_REWRITE_CONV I [pth] THENC + BINOP_CONV REAL_INT_POW_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Max and min. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_MAX_CONV = + REWR_CONV real_max THENC + RATOR_CONV(RATOR_CONV(RAND_CONV REAL_RAT_LE_CONV)) THENC + GEN_REWRITE_CONV I [COND_CLAUSES];; + +let REAL_RAT_MIN_CONV = + REWR_CONV real_min THENC + RATOR_CONV(RATOR_CONV(RAND_CONV REAL_RAT_LE_CONV)) THENC + GEN_REWRITE_CONV I [COND_CLAUSES];; + +(* ------------------------------------------------------------------------- *) +(* Everything. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RAT_RED_CONV = + let gconv_net = itlist (uncurry net_of_conv) + [`x <= y`,REAL_RAT_LE_CONV; + `x < y`,REAL_RAT_LT_CONV; + `x >= y`,REAL_RAT_GE_CONV; + `x > y`,REAL_RAT_GT_CONV; + `x:real = y`,REAL_RAT_EQ_CONV; + `--x`,CHANGED_CONV REAL_RAT_NEG_CONV; + `abs(x)`,REAL_RAT_ABS_CONV; + `inv(x)`,REAL_RAT_INV_CONV; + `x + y`,REAL_RAT_ADD_CONV; + `x - y`,REAL_RAT_SUB_CONV; + `x * y`,REAL_RAT_MUL_CONV; + `x / y`,CHANGED_CONV REAL_RAT_DIV_CONV; + `x pow n`,REAL_RAT_POW_CONV; + `max x y`,REAL_RAT_MAX_CONV; + `min x y`,REAL_RAT_MIN_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let REAL_RAT_REDUCE_CONV = DEPTH_CONV REAL_RAT_RED_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Real normalizer dealing with rational constants. *) +(* ------------------------------------------------------------------------- *) + +let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, + REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = + SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES + (is_ratconst, + REAL_RAT_ADD_CONV,REAL_RAT_MUL_CONV,REAL_RAT_POW_CONV) + (<);; + +(* ------------------------------------------------------------------------- *) +(* Extend normalizer to handle "inv" and division by rational constants, and *) +(* normalize inside nested "max", "min" and "abs" terms. *) +(* ------------------------------------------------------------------------- *) + +let REAL_POLY_CONV = + let neg_tm = `(--):real->real` + and inv_tm = `inv:real->real` + and add_tm = `(+):real->real->real` + and sub_tm = `(-):real->real->real` + and mul_tm = `(*):real->real->real` + and div_tm = `(/):real->real->real` + and pow_tm = `(pow):real->num->real` + and abs_tm = `abs:real->real` + and max_tm = `max:real->real->real` + and min_tm = `min:real->real->real` + and div_conv = REWR_CONV real_div in + let rec REAL_POLY_CONV tm = + if not(is_comb tm) or is_ratconst tm then REFL tm else + let lop,r = dest_comb tm in + if lop = neg_tm then + let th1 = AP_TERM lop (REAL_POLY_CONV r) in + TRANS th1 (REAL_POLY_NEG_CONV (rand(concl th1))) + else if lop = inv_tm then + let th1 = AP_TERM lop (REAL_POLY_CONV r) in + TRANS th1 (TRY_CONV REAL_RAT_INV_CONV (rand(concl th1))) + else if lop = abs_tm then + AP_TERM lop (REAL_POLY_CONV r) + else if not(is_comb lop) then REFL tm else + let op,l = dest_comb lop in + if op = pow_tm then + let th1 = AP_THM (AP_TERM op (REAL_POLY_CONV l)) r in + TRANS th1 (TRY_CONV REAL_POLY_POW_CONV (rand(concl th1))) + else if op = add_tm or op = mul_tm or op = sub_tm then + let th1 = MK_COMB(AP_TERM op (REAL_POLY_CONV l), + REAL_POLY_CONV r) in + let fn = if op = add_tm then REAL_POLY_ADD_CONV + else if op = mul_tm then REAL_POLY_MUL_CONV + else REAL_POLY_SUB_CONV in + TRANS th1 (fn (rand(concl th1))) + else if op = div_tm then + let th1 = div_conv tm in + TRANS th1 (REAL_POLY_CONV (rand(concl th1))) + else if op = min_tm or op = max_tm then + MK_COMB(AP_TERM op (REAL_POLY_CONV l),REAL_POLY_CONV r) + else REFL tm in + REAL_POLY_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Basic ring and ideal conversions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_RING,real_ideal_cofactors = + let REAL_INTEGRAL = prove + (`(!x. &0 * x = &0) /\ + (!x y z. (x + y = x + z) <=> (y = z)) /\ + (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, + REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[GSYM REAL_ENTIRE] THEN REAL_ARITH_TAC) + and REAL_RABINOWITSCH = prove + (`!x y:real. ~(x = y) <=> ?z. (x - y) * z = &1`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM REAL_SUB_0] THEN + MESON_TAC[REAL_MUL_RINV; REAL_MUL_LZERO; REAL_ARITH `~(&1 = &0)`]) + and init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] + and real_ty = `:real` in + let pure,ideal = + RING_AND_IDEAL_CONV + (rat_of_term,term_of_rat,REAL_RAT_EQ_CONV, + `(--):real->real`,`(+):real->real->real`,`(-):real->real->real`, + `(inv):real->real`,`(*):real->real->real`,`(/):real->real->real`, + `(pow):real->num->real`, + REAL_INTEGRAL,REAL_RABINOWITSCH,REAL_POLY_CONV) in + (fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)))), + (fun tms tm -> if forall (fun t -> type_of t = real_ty) (tm::tms) + then ideal tms tm + else failwith + "real_ideal_cofactors: not all terms have type :real");; + +(* ------------------------------------------------------------------------- *) +(* Conversion for ideal membership. *) +(* ------------------------------------------------------------------------- *) + +let REAL_IDEAL_CONV = + let mk_add = mk_binop `( + ):real->real->real` + and mk_mul = mk_binop `( * ):real->real->real` in + fun tms tm -> + let cfs = real_ideal_cofactors tms tm in + let tm' = end_itlist mk_add (map2 mk_mul cfs tms) in + let th = REAL_POLY_CONV tm and th' = REAL_POLY_CONV tm' in + TRANS th (SYM th');; + +(* ------------------------------------------------------------------------- *) +(* Further specialize GEN_REAL_ARITH and REAL_ARITH (final versions). *) +(* ------------------------------------------------------------------------- *) + +let GEN_REAL_ARITH PROVER = + GEN_REAL_ARITH + (term_of_rat, + REAL_RAT_EQ_CONV,REAL_RAT_GE_CONV,REAL_RAT_GT_CONV, + REAL_POLY_CONV,REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_MUL_CONV, + PROVER);; + +let REAL_ARITH = + let init = GEN_REWRITE_CONV ONCE_DEPTH_CONV [DECIMAL] + and pure = GEN_REAL_ARITH REAL_LINEAR_PROVER in + fun tm -> let th = init tm in EQ_MP (SYM th) (pure(rand(concl th)));; + +let REAL_ARITH_TAC = CONV_TAC REAL_ARITH;; + +let ASM_REAL_ARITH_TAC = + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN + REAL_ARITH_TAC;; + +(* ------------------------------------------------------------------------- *) +(* A simple "field" rule. *) +(* ------------------------------------------------------------------------- *) + +let REAL_FIELD = + let prenex_conv = + TOP_DEPTH_CONV BETA_CONV THENC + PURE_REWRITE_CONV[FORALL_SIMP; EXISTS_SIMP; real_div; + REAL_INV_INV; REAL_INV_MUL; GSYM REAL_POW_INV] THENC + NNFC_CONV THENC DEPTH_BINOP_CONV `(/\)` CONDS_CELIM_CONV THENC + PRENEX_CONV THENC + ONCE_REWRITE_CONV[REAL_ARITH `x < y <=> x < y /\ ~(x = y)`] + and setup_conv = NNF_CONV THENC WEAK_CNF_CONV THENC CONJ_CANON_CONV + and core_rule t = try REAL_RING t with Failure _ -> REAL_ARITH t + and is_inv = + let inv_tm = `inv:real->real` + and is_div = is_binop `(/):real->real->real` in + fun tm -> (is_div tm or (is_comb tm & rator tm = inv_tm)) & + not(is_ratconst(rand tm)) in + let BASIC_REAL_FIELD tm = + let is_freeinv t = is_inv t & free_in t tm in + let itms = setify(map rand (find_terms is_freeinv tm)) in + let hyps = map (fun t -> SPEC t REAL_MUL_RINV) itms in + let tm' = itlist (fun th t -> mk_imp(concl th,t)) hyps tm in + let th1 = setup_conv tm' in + let cjs = conjuncts(rand(concl th1)) in + let ths = map core_rule cjs in + let th2 = EQ_MP (SYM th1) (end_itlist CONJ ths) in + rev_itlist (C MP) hyps th2 in + fun tm -> + let th0 = prenex_conv tm in + let tm0 = rand(concl th0) in + let avs,bod = strip_forall tm0 in + let th1 = setup_conv bod in + let ths = map BASIC_REAL_FIELD (conjuncts(rand(concl th1))) in + EQ_MP (SYM th0) (GENL avs (EQ_MP (SYM th1) (end_itlist CONJ ths)));; diff --git a/canon.ml b/canon.ml new file mode 100644 index 0000000..0f36c2a --- /dev/null +++ b/canon.ml @@ -0,0 +1,733 @@ +(* ========================================================================= *) +(* Reasonably efficient conversions for various canonical forms. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "trivia.ml";; + +(* ------------------------------------------------------------------------- *) +(* Pre-simplification. *) +(* ------------------------------------------------------------------------- *) + +let PRESIMP_CONV = + GEN_REWRITE_CONV TOP_DEPTH_CONV + [NOT_CLAUSES; AND_CLAUSES; OR_CLAUSES; IMP_CLAUSES; EQ_CLAUSES; + FORALL_SIMP; EXISTS_SIMP; EXISTS_OR_THM; FORALL_AND_THM; + LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; + LEFT_FORALL_OR_THM; RIGHT_FORALL_OR_THM];; + +(* ------------------------------------------------------------------------- *) +(* ACI rearrangements of conjunctions and disjunctions. This is much faster *) +(* than AC xxx_ACI on large problems, as well as being more controlled. *) +(* ------------------------------------------------------------------------- *) + +let CONJ_ACI_RULE = + let rec mk_fun th fn = + let tm = concl th in + if is_conj tm then + let th1,th2 = CONJ_PAIR th in + mk_fun th1 (mk_fun th2 fn) + else (tm |-> th) fn + and use_fun fn tm = + if is_conj tm then + let l,r = dest_conj tm in CONJ (use_fun fn l) (use_fun fn r) + else apply fn tm in + fun fm -> + let p,p' = dest_eq fm in + if p = p' then REFL p else + let th = use_fun (mk_fun (ASSUME p) undefined) p' + and th' = use_fun (mk_fun (ASSUME p') undefined) p in + IMP_ANTISYM_RULE (DISCH_ALL th) (DISCH_ALL th');; + +let DISJ_ACI_RULE = + let pth_left = UNDISCH(TAUT `~(a \/ b) ==> ~a`) + and pth_right = UNDISCH(TAUT `~(a \/ b) ==> ~b`) + and pth = repeat UNDISCH (TAUT `~a ==> ~b ==> ~(a \/ b)`) + and pth_neg = UNDISCH(TAUT `(~a <=> ~b) ==> (a <=> b)`) + and a_tm = `a:bool` and b_tm = `b:bool` in + let NOT_DISJ_PAIR th = + let p,q = dest_disj(rand(concl th)) in + let ilist = [p,a_tm; q,b_tm] in + PROVE_HYP th (INST ilist pth_left), + PROVE_HYP th (INST ilist pth_right) + and NOT_DISJ th1 th2 = + let th3 = INST [rand(concl th1),a_tm; rand(concl th2),b_tm] pth in + PROVE_HYP th1 (PROVE_HYP th2 th3) in + let rec mk_fun th fn = + let tm = rand(concl th) in + if is_disj tm then + let th1,th2 = NOT_DISJ_PAIR th in + mk_fun th1 (mk_fun th2 fn) + else (tm |-> th) fn + and use_fun fn tm = + if is_disj tm then + let l,r = dest_disj tm in NOT_DISJ (use_fun fn l) (use_fun fn r) + else apply fn tm in + fun fm -> + let p,p' = dest_eq fm in + if p = p' then REFL p else + let th = use_fun (mk_fun (ASSUME(mk_neg p)) undefined) p' + and th' = use_fun (mk_fun (ASSUME(mk_neg p')) undefined) p in + let th1 = IMP_ANTISYM_RULE (DISCH_ALL th) (DISCH_ALL th') in + PROVE_HYP th1 (INST [p,a_tm; p',b_tm] pth_neg);; + +(* ------------------------------------------------------------------------- *) +(* Order canonically, right-associate and remove duplicates. *) +(* ------------------------------------------------------------------------- *) + +let CONJ_CANON_CONV tm = + let tm' = list_mk_conj(setify(conjuncts tm)) in + CONJ_ACI_RULE(mk_eq(tm,tm'));; + +let DISJ_CANON_CONV tm = + let tm' = list_mk_disj(setify(disjuncts tm)) in + DISJ_ACI_RULE(mk_eq(tm,tm'));; + +(* ------------------------------------------------------------------------- *) +(* General NNF conversion. The user supplies some conversion to be applied *) +(* to atomic formulas. *) +(* *) +(* "Iff"s are split conjunctively or disjunctively according to the flag *) +(* argument (conjuctively = true) until a universal quantifier (modulo *) +(* current parity) is passed; after that they are split conjunctively. This *) +(* is appropriate when the result is passed to a disjunctive splitter *) +(* followed by a clausal form inner core, such as MESON. *) +(* *) +(* To avoid some duplicate computation, this function will in general *) +(* enter a recursion where it simultaneously computes NNF representations *) +(* for "p" and "~p", so the user needs to supply an atomic "conversion" *) +(* that does the same. *) +(* ------------------------------------------------------------------------- *) + +let (GEN_NNF_CONV:bool->conv*(term->thm*thm)->conv) = + let and_tm = `(/\)` and or_tm = `(\/)` and not_tm = `(~)` + and pth_not_not = TAUT `~ ~ p = p` + and pth_not_and = TAUT `~(p /\ q) <=> ~p \/ ~q` + and pth_not_or = TAUT `~(p \/ q) <=> ~p /\ ~q` + and pth_imp = TAUT `p ==> q <=> ~p \/ q` + and pth_not_imp = TAUT `~(p ==> q) <=> p /\ ~q` + and pth_eq = TAUT `(p <=> q) <=> p /\ q \/ ~p /\ ~q` + and pth_not_eq = TAUT `~(p <=> q) <=> p /\ ~q \/ ~p /\ q` + and pth_eq' = TAUT `(p <=> q) <=> (p \/ ~q) /\ (~p \/ q)` + and pth_not_eq' = TAUT `~(p <=> q) <=> (p \/ q) /\ (~p \/ ~q)` + and [pth_not_forall; pth_not_exists; pth_not_exu] = + (CONJUNCTS o prove) + (`(~((!) P) <=> ?x:A. ~(P x)) /\ + (~((?) P) <=> !x:A. ~(P x)) /\ + (~((?!) P) <=> (!x:A. ~(P x)) \/ ?x y. P x /\ P y /\ ~(y = x))`, + REPEAT CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; EXISTS_UNIQUE_DEF; + DE_MORGAN_THM; NOT_IMP] THEN + REWRITE_TAC[CONJ_ASSOC; EQ_SYM_EQ]) + and pth_exu = prove + (`((?!) P) <=> (?x:A. P x) /\ !x y. ~(P x) \/ ~(P y) \/ (y = x)`, + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[EXISTS_UNIQUE_DEF; TAUT `a /\ b ==> c <=> ~a \/ ~b \/ c`] THEN + REWRITE_TAC[EQ_SYM_EQ]) + and p_tm = `p:bool` and q_tm = `q:bool` in + let rec NNF_DCONV cf baseconvs tm = + match tm with + Comb(Comb(Const("/\\",_),l),r) -> + let th_lp,th_ln = NNF_DCONV cf baseconvs l + and th_rp,th_rn = NNF_DCONV cf baseconvs r in + MK_COMB(AP_TERM and_tm th_lp,th_rp), + TRANS (INST [l,p_tm; r,q_tm] pth_not_and) + (MK_COMB(AP_TERM or_tm th_ln,th_rn)) + | Comb(Comb(Const("\\/",_),l),r) -> + let th_lp,th_ln = NNF_DCONV cf baseconvs l + and th_rp,th_rn = NNF_DCONV cf baseconvs r in + MK_COMB(AP_TERM or_tm th_lp,th_rp), + TRANS (INST [l,p_tm; r,q_tm] pth_not_or) + (MK_COMB(AP_TERM and_tm th_ln,th_rn)) + | Comb(Comb(Const("==>",_),l),r) -> + let th_lp,th_ln = NNF_DCONV cf baseconvs l + and th_rp,th_rn = NNF_DCONV cf baseconvs r in + TRANS (INST [l,p_tm; r,q_tm] pth_imp) + (MK_COMB(AP_TERM or_tm th_ln,th_rp)), + TRANS (INST [l,p_tm; r,q_tm] pth_not_imp) + (MK_COMB(AP_TERM and_tm th_lp,th_rn)) + | Comb(Comb(Const("=",Tyapp("fun",Tyapp("bool",_)::_)),l),r) -> + let th_lp,th_ln = NNF_DCONV cf baseconvs l + and th_rp,th_rn = NNF_DCONV cf baseconvs r in + if cf then + TRANS (INST [l,p_tm; r,q_tm] pth_eq') + (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rn)), + MK_COMB(AP_TERM or_tm th_ln,th_rp))), + TRANS (INST [l,p_tm; r,q_tm] pth_not_eq') + (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rp)), + MK_COMB(AP_TERM or_tm th_ln,th_rn))) + else + TRANS (INST [l,p_tm; r,q_tm] pth_eq) + (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rp)), + MK_COMB(AP_TERM and_tm th_ln,th_rn))), + TRANS (INST [l,p_tm; r,q_tm] pth_not_eq) + (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rn)), + MK_COMB(AP_TERM and_tm th_ln,th_rp))) + | Comb(Const("!",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, + (Abs(x,t) as bod)) -> + let th_p,th_n = NNF_DCONV true baseconvs t in + AP_TERM q (ABS x th_p), + let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_not_forall) + and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in + TRANS th1 (MK_EXISTS x th2) + | Comb(Const("?",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, + (Abs(x,t) as bod)) -> + let th_p,th_n = NNF_DCONV cf baseconvs t in + AP_TERM q (ABS x th_p), + let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_not_exists) + and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in + TRANS th1 (MK_FORALL x th2) + | Comb(Const("?!",Tyapp("fun",Tyapp("fun",ty::_)::_)), + (Abs(x,t) as bod)) -> + let y = variant (x::frees t) x + and th_p,th_n = NNF_DCONV cf baseconvs t in + let eq = mk_eq(y,x) in + let eth_p,eth_n = baseconvs eq + and bth = BETA (mk_comb(bod,x)) + and bth' = BETA_CONV(mk_comb(bod,y)) in + let th_p' = INST [y,x] th_p and th_n' = INST [y,x] th_n in + let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_exu) + and th1' = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_not_exu) + and th2 = + MK_COMB(AP_TERM and_tm + (MK_EXISTS x (TRANS bth th_p)), + MK_FORALL x (MK_FORALL y + (MK_COMB(AP_TERM or_tm (TRANS (AP_TERM not_tm bth) th_n), + MK_COMB(AP_TERM or_tm + (TRANS (AP_TERM not_tm bth') th_n'), + eth_p))))) + and th2' = + MK_COMB(AP_TERM or_tm + (MK_FORALL x (TRANS (AP_TERM not_tm bth) th_n)), + MK_EXISTS x (MK_EXISTS y + (MK_COMB(AP_TERM and_tm (TRANS bth th_p), + MK_COMB(AP_TERM and_tm (TRANS bth' th_p'), + eth_n))))) in + TRANS th1 th2,TRANS th1' th2' + | Comb(Const("~",_),t) -> + let th1,th2 = NNF_DCONV cf baseconvs t in + th2,TRANS (INST [t,p_tm] pth_not_not) th1 + | _ -> try baseconvs tm + with Failure _ -> REFL tm,REFL(mk_neg tm) in + let rec NNF_CONV cf (base1,base2 as baseconvs) tm = + match tm with + Comb(Comb(Const("/\\",_),l),r) -> + let th_lp = NNF_CONV cf baseconvs l + and th_rp = NNF_CONV cf baseconvs r in + MK_COMB(AP_TERM and_tm th_lp,th_rp) + | Comb(Comb(Const("\\/",_),l),r) -> + let th_lp = NNF_CONV cf baseconvs l + and th_rp = NNF_CONV cf baseconvs r in + MK_COMB(AP_TERM or_tm th_lp,th_rp) + | Comb(Comb(Const("==>",_),l),r) -> + let th_ln = NNF_CONV' cf baseconvs l + and th_rp = NNF_CONV cf baseconvs r in + TRANS (INST [l,p_tm; r,q_tm] pth_imp) + (MK_COMB(AP_TERM or_tm th_ln,th_rp)) + | Comb(Comb(Const("=",Tyapp("fun",Tyapp("bool",_)::_)),l),r) -> + let th_lp,th_ln = NNF_DCONV cf base2 l + and th_rp,th_rn = NNF_DCONV cf base2 r in + if cf then + TRANS (INST [l,p_tm; r,q_tm] pth_eq') + (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rn)), + MK_COMB(AP_TERM or_tm th_ln,th_rp))) + else + TRANS (INST [l,p_tm; r,q_tm] pth_eq) + (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rp)), + MK_COMB(AP_TERM and_tm th_ln,th_rn))) + | Comb(Const("!",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, + (Abs(x,t))) -> + let th_p = NNF_CONV true baseconvs t in + AP_TERM q (ABS x th_p) + | Comb(Const("?",Tyapp("fun",Tyapp("fun",ty::_)::_)) as q, + (Abs(x,t))) -> + let th_p = NNF_CONV cf baseconvs t in + AP_TERM q (ABS x th_p) + | Comb(Const("?!",Tyapp("fun",Tyapp("fun",ty::_)::_)), + (Abs(x,t) as bod)) -> + let y = variant (x::frees t) x + and th_p,th_n = NNF_DCONV cf base2 t in + let eq = mk_eq(y,x) in + let eth_p,eth_n = base2 eq + and bth = BETA (mk_comb(bod,x)) + and bth' = BETA_CONV(mk_comb(bod,y)) in + let th_n' = INST [y,x] th_n in + let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_exu) + and th2 = + MK_COMB(AP_TERM and_tm + (MK_EXISTS x (TRANS bth th_p)), + MK_FORALL x (MK_FORALL y + (MK_COMB(AP_TERM or_tm (TRANS (AP_TERM not_tm bth) th_n), + MK_COMB(AP_TERM or_tm + (TRANS (AP_TERM not_tm bth') th_n'), + eth_p))))) in + TRANS th1 th2 + | Comb(Const("~",_),t) -> NNF_CONV' cf baseconvs t + | _ -> try base1 tm with Failure _ -> REFL tm + and NNF_CONV' cf (base1,base2 as baseconvs) tm = + match tm with + Comb(Comb(Const("/\\",_),l),r) -> + let th_ln = NNF_CONV' cf baseconvs l + and th_rn = NNF_CONV' cf baseconvs r in + TRANS (INST [l,p_tm; r,q_tm] pth_not_and) + (MK_COMB(AP_TERM or_tm th_ln,th_rn)) + | Comb(Comb(Const("\\/",_),l),r) -> + let th_ln = NNF_CONV' cf baseconvs l + and th_rn = NNF_CONV' cf baseconvs r in + TRANS (INST [l,p_tm; r,q_tm] pth_not_or) + (MK_COMB(AP_TERM and_tm th_ln,th_rn)) + | Comb(Comb(Const("==>",_),l),r) -> + let th_lp = NNF_CONV cf baseconvs l + and th_rn = NNF_CONV' cf baseconvs r in + TRANS (INST [l,p_tm; r,q_tm] pth_not_imp) + (MK_COMB(AP_TERM and_tm th_lp,th_rn)) + | Comb(Comb(Const("=",Tyapp("fun",Tyapp("bool",_)::_)),l),r) -> + let th_lp,th_ln = NNF_DCONV cf base2 l + and th_rp,th_rn = NNF_DCONV cf base2 r in + if cf then + TRANS (INST [l,p_tm; r,q_tm] pth_not_eq') + (MK_COMB(AP_TERM and_tm (MK_COMB(AP_TERM or_tm th_lp,th_rp)), + MK_COMB(AP_TERM or_tm th_ln,th_rn))) + else + TRANS (INST [l,p_tm; r,q_tm] pth_not_eq) + (MK_COMB(AP_TERM or_tm (MK_COMB(AP_TERM and_tm th_lp,th_rn)), + MK_COMB(AP_TERM and_tm th_ln,th_rp))) + | Comb(Const("!",Tyapp("fun",Tyapp("fun",ty::_)::_)), + (Abs(x,t) as bod)) -> + let th_n = NNF_CONV' cf baseconvs t in + let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_not_forall) + and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in + TRANS th1 (MK_EXISTS x th2) + | Comb(Const("?",Tyapp("fun",Tyapp("fun",ty::_)::_)), + (Abs(x,t) as bod)) -> + let th_n = NNF_CONV' true baseconvs t in + let th1 = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_not_exists) + and th2 = TRANS (AP_TERM not_tm (BETA(mk_comb(bod,x)))) th_n in + TRANS th1 (MK_FORALL x th2) + | Comb(Const("?!",Tyapp("fun",Tyapp("fun",ty::_)::_)), + (Abs(x,t) as bod)) -> + let y = variant (x::frees t) x + and th_p,th_n = NNF_DCONV cf base2 t in + let eq = mk_eq(y,x) in + let eth_p,eth_n = base2 eq + and bth = BETA (mk_comb(bod,x)) + and bth' = BETA_CONV(mk_comb(bod,y)) in + let th_p' = INST [y,x] th_p in + let th1' = INST [bod,mk_var("P",mk_fun_ty ty bool_ty)] + (INST_TYPE [ty,aty] pth_not_exu) + and th2' = + MK_COMB(AP_TERM or_tm + (MK_FORALL x (TRANS (AP_TERM not_tm bth) th_n)), + MK_EXISTS x (MK_EXISTS y + (MK_COMB(AP_TERM and_tm (TRANS bth th_p), + MK_COMB(AP_TERM and_tm (TRANS bth' th_p'), + eth_n))))) in + TRANS th1' th2' + | Comb(Const("~",_),t) -> + let th1 = NNF_CONV cf baseconvs t in + TRANS (INST [t,p_tm] pth_not_not) th1 + | _ -> let tm' = mk_neg tm in try base1 tm' with Failure _ -> REFL tm' in + NNF_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Some common special cases. *) +(* ------------------------------------------------------------------------- *) + +let NNF_CONV = + (GEN_NNF_CONV false (ALL_CONV,fun t -> REFL t,REFL(mk_neg t)) :conv);; + +let NNFC_CONV = + (GEN_NNF_CONV true (ALL_CONV,fun t -> REFL t,REFL(mk_neg t)) :conv);; + +(* ------------------------------------------------------------------------- *) +(* Skolemize a term already in NNF (doesn't matter if it's not prenex). *) +(* ------------------------------------------------------------------------- *) + +let SKOLEM_CONV = + GEN_REWRITE_CONV TOP_DEPTH_CONV + [EXISTS_OR_THM; LEFT_EXISTS_AND_THM; RIGHT_EXISTS_AND_THM; + FORALL_AND_THM; LEFT_FORALL_OR_THM; RIGHT_FORALL_OR_THM; + FORALL_SIMP; EXISTS_SIMP] THENC + GEN_REWRITE_CONV REDEPTH_CONV + [RIGHT_AND_EXISTS_THM; + LEFT_AND_EXISTS_THM; + OR_EXISTS_THM; + RIGHT_OR_EXISTS_THM; + LEFT_OR_EXISTS_THM; + SKOLEM_THM];; + +(* ------------------------------------------------------------------------- *) +(* Put a term already in NNF into prenex form. *) +(* ------------------------------------------------------------------------- *) + +let PRENEX_CONV = + GEN_REWRITE_CONV REDEPTH_CONV + [AND_FORALL_THM; LEFT_AND_FORALL_THM; RIGHT_AND_FORALL_THM; + LEFT_OR_FORALL_THM; RIGHT_OR_FORALL_THM; + OR_EXISTS_THM; LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM];; + +(* ------------------------------------------------------------------------- *) +(* Weak and normal DNF conversion. The "weak" form gives a disjunction of *) +(* conjunctions, but has no particular associativity at either level and *) +(* may contain duplicates. The regular forms give canonical right-associate *) +(* lists without duplicates, but do not remove subsumed disjuncts. *) +(* *) +(* In both cases the input term is supposed to be in NNF already. We do go *) +(* inside quantifiers and transform their body, but don't move them. *) +(* ------------------------------------------------------------------------- *) + +let WEAK_DNF_CONV,DNF_CONV = + let pth1 = TAUT `a /\ (b \/ c) <=> a /\ b \/ a /\ c` + and pth2 = TAUT `(a \/ b) /\ c <=> a /\ c \/ b /\ c` + and a_tm = `a:bool` and b_tm = `b:bool` and c_tm = `c:bool` in + let rec distribute tm = + match tm with + Comb(Comb(Const("/\\",_),a),Comb(Comb(Const("\\/",_),b),c)) -> + let th = INST [a,a_tm; b,b_tm; c,c_tm] pth1 in + TRANS th (BINOP_CONV distribute (rand(concl th))) + | Comb(Comb(Const("/\\",_),Comb(Comb(Const("\\/",_),a),b)),c) -> + let th = INST [a,a_tm; b,b_tm; c,c_tm] pth2 in + TRANS th (BINOP_CONV distribute (rand(concl th))) + | _ -> REFL tm in + let strengthen = + DEPTH_BINOP_CONV `(\/)` CONJ_CANON_CONV THENC DISJ_CANON_CONV in + let rec weakdnf tm = + match tm with + Comb(Const("!",_),Abs(_,_)) + | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV weakdnf tm + | Comb(Comb(Const("\\/",_),_),_) -> BINOP_CONV weakdnf tm + | Comb(Comb(Const("/\\",_) as op,l),r) -> + let th = MK_COMB(AP_TERM op (weakdnf l),weakdnf r) in + TRANS th (distribute(rand(concl th))) + | _ -> REFL tm + and substrongdnf tm = + match tm with + Comb(Const("!",_),Abs(_,_)) + | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV strongdnf tm + | Comb(Comb(Const("\\/",_),_),_) -> BINOP_CONV substrongdnf tm + | Comb(Comb(Const("/\\",_) as op,l),r) -> + let th = MK_COMB(AP_TERM op (substrongdnf l),substrongdnf r) in + TRANS th (distribute(rand(concl th))) + | _ -> REFL tm + and strongdnf tm = + let th = substrongdnf tm in + TRANS th (strengthen(rand(concl th))) in + weakdnf,strongdnf;; + +(* ------------------------------------------------------------------------- *) +(* Likewise for CNF. *) +(* ------------------------------------------------------------------------- *) + +let WEAK_CNF_CONV,CNF_CONV = + let pth1 = TAUT `a \/ (b /\ c) <=> (a \/ b) /\ (a \/ c)` + and pth2 = TAUT `(a /\ b) \/ c <=> (a \/ c) /\ (b \/ c)` + and a_tm = `a:bool` and b_tm = `b:bool` and c_tm = `c:bool` in + let rec distribute tm = + match tm with + Comb(Comb(Const("\\/",_),a),Comb(Comb(Const("/\\",_),b),c)) -> + let th = INST [a,a_tm; b,b_tm; c,c_tm] pth1 in + TRANS th (BINOP_CONV distribute (rand(concl th))) + | Comb(Comb(Const("\\/",_),Comb(Comb(Const("/\\",_),a),b)),c) -> + let th = INST [a,a_tm; b,b_tm; c,c_tm] pth2 in + TRANS th (BINOP_CONV distribute (rand(concl th))) + | _ -> REFL tm in + let strengthen = + DEPTH_BINOP_CONV `(/\)` DISJ_CANON_CONV THENC CONJ_CANON_CONV in + let rec weakcnf tm = + match tm with + Comb(Const("!",_),Abs(_,_)) + | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV weakcnf tm + | Comb(Comb(Const("/\\",_),_),_) -> BINOP_CONV weakcnf tm + | Comb(Comb(Const("\\/",_) as op,l),r) -> + let th = MK_COMB(AP_TERM op (weakcnf l),weakcnf r) in + TRANS th (distribute(rand(concl th))) + | _ -> REFL tm + and substrongcnf tm = + match tm with + Comb(Const("!",_),Abs(_,_)) + | Comb(Const("?",_),Abs(_,_)) -> BINDER_CONV strongcnf tm + | Comb(Comb(Const("/\\",_),_),_) -> BINOP_CONV substrongcnf tm + | Comb(Comb(Const("\\/",_) as op,l),r) -> + let th = MK_COMB(AP_TERM op (substrongcnf l),substrongcnf r) in + TRANS th (distribute(rand(concl th))) + | _ -> REFL tm + and strongcnf tm = + let th = substrongcnf tm in + TRANS th (strengthen(rand(concl th))) in + weakcnf,strongcnf;; + +(* ------------------------------------------------------------------------- *) +(* Simply right-associate w.r.t. a binary operator. *) +(* ------------------------------------------------------------------------- *) + +let ASSOC_CONV th = + let th' = SYM(SPEC_ALL th) in + let opx,yopz = dest_comb(rhs(concl th')) in + let op,x = dest_comb opx in + let y = lhand yopz and z = rand yopz in + let rec distrib tm = + match tm with + Comb(Comb(op',Comb(Comb(op'',p),q)),r) when op' = op & op'' = op -> + let th1 = INST [p,x; q,y; r,z] th' in + let l,r' = dest_comb(rand(concl th1)) in + let th2 = AP_TERM l (distrib r') in + let th3 = distrib(rand(concl th2)) in + TRANS th1 (TRANS th2 th3) + | _ -> REFL tm in + let rec assoc tm = + match tm with + Comb(Comb(op',p) as l,q) when op' = op -> + let th = AP_TERM l (assoc q) in + TRANS th (distrib(rand(concl th))) + | _ -> REFL tm in + assoc;; + +(* ------------------------------------------------------------------------- *) +(* Eliminate select terms from a goal. *) +(* ------------------------------------------------------------------------- *) + +let SELECT_ELIM_TAC = + let SELECT_ELIM_CONV = + let SELECT_ELIM_THM = + let pth = prove + (`(P:A->bool)((@) P) <=> (?) P`, + REWRITE_TAC[EXISTS_THM] THEN BETA_TAC THEN REFL_TAC) + and ptm = `P:A->bool` in + fun tm -> let stm,atm = dest_comb tm in + if is_const stm & fst(dest_const stm) = "@" then + CONV_RULE(LAND_CONV BETA_CONV) + (PINST [type_of(bndvar atm),aty] [atm,ptm] pth) + else failwith "SELECT_ELIM_THM: not a select-term" in + fun tm -> + PURE_REWRITE_CONV (map SELECT_ELIM_THM (find_terms is_select tm)) tm in + let SELECT_ELIM_ICONV = + let SELECT_AX_THM = + let pth = ISPEC `P:A->bool` SELECT_AX + and ptm = `P:A->bool` in + fun tm -> let stm,atm = dest_comb tm in + if is_const stm & fst(dest_const stm) = "@" then + let fvs = frees atm in + let th1 = PINST [type_of(bndvar atm),aty] [atm,ptm] pth in + let th2 = CONV_RULE(BINDER_CONV (BINOP_CONV BETA_CONV)) th1 in + GENL fvs th2 + else failwith "SELECT_AX_THM: not a select-term" in + let SELECT_ELIM_ICONV tm = + let t = find_term is_select tm in + let th1 = SELECT_AX_THM t in + let itm = mk_imp(concl th1,tm) in + let th2 = DISCH_ALL (MP (ASSUME itm) th1) in + let fvs = frees t in + let fty = itlist (mk_fun_ty o type_of) fvs (type_of t) in + let fn = genvar fty + and atm = list_mk_abs(fvs,t) in + let rawdef = mk_eq(fn,atm) in + let def = GENL fvs (SYM(RIGHT_BETAS fvs (ASSUME rawdef))) in + let th3 = PURE_REWRITE_CONV[def] (lhand(concl th2)) in + let gtm = mk_forall(fn,rand(concl th3)) in + let th4 = EQ_MP (SYM th3) (SPEC fn (ASSUME gtm)) in + let th5 = IMP_TRANS (DISCH gtm th4) th2 in + MP (INST [atm,fn] (DISCH rawdef th5)) (REFL atm) in + let rec SELECT_ELIMS_ICONV tm = + try let th = SELECT_ELIM_ICONV tm in + let tm' = lhand(concl th) in + IMP_TRANS (SELECT_ELIMS_ICONV tm') th + with Failure _ -> DISCH tm (ASSUME tm) in + SELECT_ELIMS_ICONV in + CONV_TAC SELECT_ELIM_CONV THEN W(MATCH_MP_TAC o SELECT_ELIM_ICONV o snd);; + +(* ------------------------------------------------------------------------- *) +(* Eliminate all lambda-terms except those part of quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let LAMBDA_ELIM_CONV = + let HALF_MK_ABS_CONV = + let pth = prove + (`(s = \x. t x) <=> (!x. s x = t x)`, + REWRITE_TAC[FUN_EQ_THM]) in + let rec conv vs tm = + if vs = [] then REFL tm else + (GEN_REWRITE_CONV I [pth] THENC BINDER_CONV(conv (tl vs))) tm in + conv in + let rec find_lambda tm = + if is_abs tm then tm + else if is_var tm or is_const tm then failwith "find_lambda" + else if is_abs tm then tm else + if is_forall tm or is_exists tm or is_uexists tm + then find_lambda (body(rand tm)) else + let l,r = dest_comb tm in + try find_lambda l with Failure _ -> find_lambda r in + let rec ELIM_LAMBDA conv tm = + try conv tm with Failure _ -> + if is_abs tm then ABS_CONV (ELIM_LAMBDA conv) tm + else if is_var tm or is_const tm then REFL tm else + if is_forall tm or is_exists tm or is_uexists tm + then BINDER_CONV (ELIM_LAMBDA conv) tm + else COMB_CONV (ELIM_LAMBDA conv) tm in + let APPLY_PTH = + let pth = prove + (`(!a. (a = c) ==> (P = Q a)) ==> (P <=> !a. (a = c) ==> Q a)`, + SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL]) in + MATCH_MP pth in + let LAMB1_CONV tm = + let atm = find_lambda tm in + let v,bod = dest_abs atm in + let vs = frees atm in + let vs' = vs @ [v] in + let aatm = list_mk_abs(vs,atm) in + let f = genvar(type_of aatm) in + let eq = mk_eq(f,aatm) in + let th1 = SYM(RIGHT_BETAS vs (ASSUME eq)) in + let th2 = ELIM_LAMBDA(GEN_REWRITE_CONV I [th1]) tm in + let th3 = APPLY_PTH (GEN f (DISCH_ALL th2)) in + CONV_RULE(RAND_CONV(BINDER_CONV(LAND_CONV (HALF_MK_ABS_CONV vs')))) th3 in + let rec conv tm = + try (LAMB1_CONV THENC conv) tm with Failure _ -> REFL tm in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Eliminate conditionals; CONDS_ELIM_CONV aims for disjunctive splitting, *) +(* for refutation procedures, and CONDS_CELIM_CONV for conjunctive. *) +(* Both switch modes "sensibly" when going through a quantifier. *) +(* ------------------------------------------------------------------------- *) + +let CONDS_ELIM_CONV,CONDS_CELIM_CONV = + let th_cond = prove + (`((b <=> F) ==> x = x0) /\ ((b <=> T) ==> x = x1) + ==> x = (b /\ x1 \/ ~b /\ x0)`, + BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]) + and th_cond' = prove + (`((b <=> F) ==> x = x0) /\ ((b <=> T) ==> x = x1) + ==> x = ((~b \/ x1) /\ (b \/ x0))`, + BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]) + and propsimps = basic_net() + and false_tm = `F` and true_tm = `T` in + let match_th = MATCH_MP th_cond and match_th' = MATCH_MP th_cond' + and propsimp_conv = DEPTH_CONV(REWRITES_CONV propsimps) + and proptsimp_conv = + let cnv = TRY_CONV(REWRITES_CONV propsimps) in + BINOP_CONV cnv THENC cnv in + let rec find_conditional fvs tm = + match tm with + Comb(s,t) -> + if is_cond tm & intersect (frees(lhand s)) fvs = [] then tm + else (try (find_conditional fvs s) + with Failure _ -> find_conditional fvs t) + | Abs(x,t) -> find_conditional (x::fvs) t + | _ -> failwith "find_conditional" in + let rec CONDS_ELIM_CONV dfl tm = + try let t = find_conditional [] tm in + let p = lhand(rator t) in + let th_new = + if p = false_tm or p = true_tm then propsimp_conv tm else + let asm_0 = mk_eq(p,false_tm) and asm_1 = mk_eq(p,true_tm) in + let simp_0 = net_of_thm false (ASSUME asm_0) propsimps + and simp_1 = net_of_thm false (ASSUME asm_1) propsimps in + let th_0 = DISCH asm_0 (DEPTH_CONV(REWRITES_CONV simp_0) tm) + and th_1 = DISCH asm_1 (DEPTH_CONV(REWRITES_CONV simp_1) tm) in + let th_2 = CONJ th_0 th_1 in + let th_3 = if dfl then match_th th_2 else match_th' th_2 in + TRANS th_3 (proptsimp_conv(rand(concl th_3))) in + CONV_RULE (RAND_CONV (CONDS_ELIM_CONV dfl)) th_new + with Failure _ -> + if is_neg tm then + RAND_CONV (CONDS_ELIM_CONV (not dfl)) tm + else if is_conj tm or is_disj tm then + BINOP_CONV (CONDS_ELIM_CONV dfl) tm + else if is_imp tm or is_iff tm then + COMB2_CONV (RAND_CONV (CONDS_ELIM_CONV (not dfl))) + (CONDS_ELIM_CONV dfl) tm + else if is_forall tm then + BINDER_CONV (CONDS_ELIM_CONV false) tm + else if is_exists tm or is_uexists tm then + BINDER_CONV (CONDS_ELIM_CONV true) tm + else REFL tm in + CONDS_ELIM_CONV true,CONDS_ELIM_CONV false;; + +(* ------------------------------------------------------------------------- *) +(* Fix up all head arities to be consistent, in "first order logic" style. *) +(* Applied to the assumptions (not conclusion) in a goal. *) +(* ------------------------------------------------------------------------- *) + +let ASM_FOL_TAC = + let rec get_heads lconsts tm (cheads,vheads as sofar) = + try let v,bod = dest_forall tm in + get_heads (subtract lconsts [v]) bod sofar + with Failure _ -> try + let l,r = try dest_conj tm with Failure _ -> dest_disj tm in + get_heads lconsts l (get_heads lconsts r sofar) + with Failure _ -> try + let tm' = dest_neg tm in + get_heads lconsts tm' sofar + with Failure _ -> + let hop,args = strip_comb tm in + let len = length args in + let newheads = + if is_const hop or mem hop lconsts + then (insert (hop,len) cheads,vheads) + else if len > 0 then (cheads,insert (hop,len) vheads) else sofar in + itlist (get_heads lconsts) args newheads in + let get_thm_heads th sofar = + get_heads (freesl(hyp th)) (concl th) sofar in + let APP_CONV = + let th = prove + (`!(f:A->B) x. f x = I f x`, + REWRITE_TAC[I_THM]) in + REWR_CONV th in + let rec APP_N_CONV n tm = + if n = 1 then APP_CONV tm + else (RATOR_CONV (APP_N_CONV (n - 1)) THENC APP_CONV) tm in + let rec FOL_CONV hddata tm = + if is_forall tm then BINDER_CONV (FOL_CONV hddata) tm + else if is_conj tm or is_disj tm then BINOP_CONV (FOL_CONV hddata) tm else + let op,args = strip_comb tm in + let th = rev_itlist (C (curry MK_COMB)) + (map (FOL_CONV hddata) args) (REFL op) in + let tm' = rand(concl th) in + let n = try length args - assoc op hddata with Failure _ -> 0 in + if n = 0 then th + else TRANS th (APP_N_CONV n tm') in + let GEN_FOL_CONV (cheads,vheads) = + let hddata = + if vheads = [] then + let hops = setify (map fst cheads) in + let getmin h = + let ns = mapfilter + (fun (k,n) -> if k = h then n else fail()) cheads in + if length ns < 2 then fail() else h,end_itlist min ns in + mapfilter getmin hops + else + map (fun t -> if is_const t & fst(dest_const t) = "=" + then t,2 else t,0) + (setify (map fst (vheads @ cheads))) in + FOL_CONV hddata in + fun (asl,w as gl) -> + let headsp = itlist (get_thm_heads o snd) asl ([],[]) in + RULE_ASSUM_TAC(CONV_RULE(GEN_FOL_CONV headsp)) gl;; + +(* ------------------------------------------------------------------------- *) +(* Depth conversion to apply at "atomic" formulas in "first-order" term. *) +(* ------------------------------------------------------------------------- *) + +let rec PROP_ATOM_CONV conv tm = + match tm with + Comb((Const("!",_) | Const("?",_) | Const("?!",_)),Abs(_,_)) + -> BINDER_CONV (PROP_ATOM_CONV conv) tm + | Comb(Comb + ((Const("/\\",_) | Const("\\/",_) | Const("==>",_) | + (Const("=",Tyapp("fun",[Tyapp("bool",[]);_])))),_),_) + -> BINOP_CONV (PROP_ATOM_CONV conv) tm + | Comb(Const("~",_),_) -> RAND_CONV (PROP_ATOM_CONV conv) tm + | _ -> TRY_CONV conv tm;; diff --git a/cart.ml b/cart.ml new file mode 100644 index 0000000..f2bcb53 --- /dev/null +++ b/cart.ml @@ -0,0 +1,499 @@ +(* ========================================================================= *) +(* Definition of finite Cartesian product types. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "iterate.ml";; + +(* ------------------------------------------------------------------------- *) +(* Association of a number with an indexing type. *) +(* ------------------------------------------------------------------------- *) + +let dimindex = new_definition + `dimindex(s:A->bool) = if FINITE(:A) then CARD(:A) else 1`;; + +let DIMINDEX_NONZERO = prove + (`!s:A->bool. ~(dimindex(s) = 0)`, + GEN_TAC THEN REWRITE_TAC[dimindex] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[CARD_EQ_0; ARITH] THEN SET_TAC[]);; + +let DIMINDEX_GE_1 = prove + (`!s:A->bool. 1 <= dimindex(s)`, + REWRITE_TAC[ARITH_RULE `1 <= x <=> ~(x = 0)`; DIMINDEX_NONZERO]);; + +let DIMINDEX_UNIV = prove + (`!s. dimindex(s:A->bool) = dimindex(:A)`, + REWRITE_TAC[dimindex]);; + +let DIMINDEX_UNIQUE = prove + (`(:A) HAS_SIZE n ==> dimindex(:A) = n`, + MESON_TAC[dimindex; HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* An indexing type with that size, parametrized by base type. *) +(* ------------------------------------------------------------------------- *) + +let finite_image_tybij = + new_type_definition "finite_image" ("finite_index","dest_finite_image") + (prove + (`?x. x IN 1..dimindex(:A)`, + EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1]));; + +let FINITE_IMAGE_IMAGE = prove + (`UNIV:(A)finite_image->bool = IMAGE finite_index (1..dimindex(:A))`, + REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN + MESON_TAC[finite_image_tybij]);; + +(* ------------------------------------------------------------------------- *) +(* Dimension of such a type, and indexing over it. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_FINITE_IMAGE = prove + (`!s. (UNIV:(A)finite_image->bool) HAS_SIZE dimindex(s:A->bool)`, + GEN_TAC THEN SIMP_TAC[FINITE_IMAGE_IMAGE] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + ONCE_REWRITE_TAC[DIMINDEX_UNIV] THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN + MESON_TAC[finite_image_tybij]);; + +let CARD_FINITE_IMAGE = prove + (`!s. CARD(UNIV:(A)finite_image->bool) = dimindex(s:A->bool)`, + MESON_TAC[HAS_SIZE_FINITE_IMAGE; HAS_SIZE]);; + +let FINITE_FINITE_IMAGE = prove + (`FINITE(UNIV:(A)finite_image->bool)`, + MESON_TAC[HAS_SIZE_FINITE_IMAGE; HAS_SIZE]);; + +let DIMINDEX_FINITE_IMAGE = prove + (`!s t. dimindex(s:(A)finite_image->bool) = dimindex(t:A->bool)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [dimindex] THEN + MP_TAC(ISPEC `t:A->bool` HAS_SIZE_FINITE_IMAGE) THEN + SIMP_TAC[FINITE_FINITE_IMAGE; HAS_SIZE]);; + +let FINITE_INDEX_WORKS = prove + (`!i:(A)finite_image. + ?!n. 1 <= n /\ n <= dimindex(:A) /\ (finite_index n = i)`, + REWRITE_TAC[CONJ_ASSOC; GSYM IN_NUMSEG] THEN MESON_TAC[finite_image_tybij]);; + +let FINITE_INDEX_INJ = prove + (`!i j. 1 <= i /\ i <= dimindex(:A) /\ + 1 <= j /\ j <= dimindex(:A) + ==> ((finite_index i :A finite_image = finite_index j) <=> + (i = j))`, + MESON_TAC[FINITE_INDEX_WORKS]);; + +let FORALL_FINITE_INDEX = prove + (`(!k:(N)finite_image. P k) = + (!i. 1 <= i /\ i <= dimindex(:N) ==> P(finite_index i))`, + MESON_TAC[FINITE_INDEX_WORKS]);; + +(* ------------------------------------------------------------------------- *) +(* Hence finite Cartesian products, with indexing and lambdas. *) +(* ------------------------------------------------------------------------- *) + +let cart_tybij = + new_type_definition "cart" ("mk_cart","dest_cart") + (prove(`?f:(B)finite_image->A. T`,REWRITE_TAC[]));; + +parse_as_infix("$",(25,"left"));; + +let finite_index = new_definition + `x$i = dest_cart x (finite_index i)`;; + +let CART_EQ = prove + (`!x:A^B y. + (x = y) <=> !i. 1 <= i /\ i <= dimindex(:B) ==> (x$i = y$i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[finite_index; GSYM FORALL_FINITE_INDEX] THEN + REWRITE_TAC[GSYM FUN_EQ_THM; ETA_AX] THEN MESON_TAC[cart_tybij]);; + +parse_as_binder "lambda";; + +let lambda = new_definition + `(lambda) g = + @f:A^B. !i. 1 <= i /\ i <= dimindex(:B) ==> (f$i = g i)`;; + +let LAMBDA_BETA = prove + (`!i. 1 <= i /\ i <= dimindex(:B) + ==> (((lambda) g:A^B) $i = g i)`, + REWRITE_TAC[lambda] THEN CONV_TAC SELECT_CONV THEN + EXISTS_TAC `mk_cart(\k. g(@i. 1 <= i /\ i <= dimindex(:B) /\ + (finite_index i = k))):A^B` THEN + REWRITE_TAC[finite_index; REWRITE_RULE[] cart_tybij] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN + GEN_TAC THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[FINITE_INDEX_INJ; DIMINDEX_FINITE_IMAGE]);; + +let LAMBDA_UNIQUE = prove + (`!f:A^B g. + (!i. 1 <= i /\ i <= dimindex(:B) ==> (f$i = g i)) <=> + ((lambda) g = f)`, + SIMP_TAC[CART_EQ; LAMBDA_BETA] THEN MESON_TAC[]);; + +let LAMBDA_ETA = prove + (`!g. (lambda i. g$i) = g`, + REWRITE_TAC[CART_EQ; LAMBDA_BETA]);; + +(* ------------------------------------------------------------------------- *) +(* For some purposes we can avoid side-conditions on the index. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_INDEX_INRANGE = prove + (`!i. ?k. 1 <= k /\ k <= dimindex(:N) /\ !x:A^N. x$i = x$k`, + REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]);; + +let FINITE_INDEX_INRANGE_2 = prove + (`!i. ?k. 1 <= k /\ k <= dimindex(:N) /\ + (!x:A^N. x$i = x$k) /\ (!y:B^N. y$i = y$k)`, + REWRITE_TAC[finite_index] THEN MESON_TAC[FINITE_INDEX_WORKS]);; + +let CART_EQ_FULL = prove + (`!x y:A^N. x = y <=> !i. x$i = y$i`, + REPEAT GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN SIMP_TAC[CART_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* We need a non-standard sum to "paste" together Cartesian products. *) +(* ------------------------------------------------------------------------- *) + +let finite_sum_tybij = + let th = prove + (`?x. x IN 1..(dimindex(:A) + dimindex(:B))`, + EXISTS_TAC `1` THEN SIMP_TAC[IN_NUMSEG; LE_REFL; DIMINDEX_GE_1; + ARITH_RULE `1 <= a ==> 1 <= a + b`]) in + new_type_definition "finite_sum" ("mk_finite_sum","dest_finite_sum") th;; + +let pastecart = new_definition + `(pastecart:A^M->A^N->A^(M,N)finite_sum) f g = + lambda i. if i <= dimindex(:M) then f$i + else g$(i - dimindex(:M))`;; + +let fstcart = new_definition + `(fstcart:A^(M,N)finite_sum->A^M) f = lambda i. f$i`;; + +let sndcart = new_definition + `(sndcart:A^(M,N)finite_sum->A^N) f = + lambda i. f$(i + dimindex(:M))`;; + +let FINITE_SUM_IMAGE = prove + (`UNIV:(A,B)finite_sum->bool = + IMAGE mk_finite_sum (1..(dimindex(:A)+dimindex(:B)))`, + REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN + MESON_TAC[finite_sum_tybij]);; + +let DIMINDEX_HAS_SIZE_FINITE_SUM = prove + (`(UNIV:(M,N)finite_sum->bool) HAS_SIZE (dimindex(:M) + dimindex(:N))`, + SIMP_TAC[FINITE_SUM_IMAGE] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN + ONCE_REWRITE_TAC[DIMINDEX_UNIV] THEN REWRITE_TAC[HAS_SIZE_NUMSEG_1] THEN + MESON_TAC[finite_sum_tybij]);; + +let DIMINDEX_FINITE_SUM = prove + (`dimindex(:(M,N)finite_sum) = dimindex(:M) + dimindex(:N)`, + GEN_REWRITE_TAC LAND_CONV [dimindex] THEN + REWRITE_TAC[REWRITE_RULE[HAS_SIZE] DIMINDEX_HAS_SIZE_FINITE_SUM]);; + +let FSTCART_PASTECART = prove + (`!x y. fstcart(pastecart (x:A^M) (y:A^N)) = x`, + SIMP_TAC[pastecart; fstcart; CART_EQ; LAMBDA_BETA; DIMINDEX_FINITE_SUM; + ARITH_RULE `a <= b ==> a <= b + c`]);; + +let SNDCART_PASTECART = prove + (`!x y. sndcart(pastecart (x:A^M) (y:A^N)) = y`, + SIMP_TAC[pastecart; sndcart; CART_EQ; LAMBDA_BETA] THEN REPEAT STRIP_TAC THEN + W(fun (_,w) -> MP_TAC (PART_MATCH (lhs o rand) LAMBDA_BETA (lhand w))) THEN + ANTS_TAC THENL + [REWRITE_TAC[DIMINDEX_FINITE_SUM] THEN MATCH_MP_TAC + (ARITH_RULE `1 <= i /\ i <= b ==> 1 <= i + a /\ i + a <= a + b`) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[ADD_SUB; ARITH_RULE `1 <= i ==> ~(i + a <= a)`]]);; + +let PASTECART_FST_SND = prove + (`!z. pastecart (fstcart z) (sndcart z) = z`, + SIMP_TAC[pastecart; fstcart; sndcart; CART_EQ; LAMBDA_BETA] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[DIMINDEX_FINITE_SUM; LAMBDA_BETA; + ARITH_RULE `i <= a + b ==> i - a <= b`; + ARITH_RULE `~(i <= a) ==> 1 <= i - a`; + ARITH_RULE `~(i <= a) ==> ((i - a) + a = i)`]);; + +let PASTECART_EQ = prove + (`!x y. (x = y) <=> (fstcart x = fstcart y) /\ (sndcart x = sndcart y)`, + MESON_TAC[PASTECART_FST_SND]);; + +let FORALL_PASTECART = prove + (`(!p. P p) <=> !x y. P (pastecart x y)`, + MESON_TAC[PASTECART_FST_SND; FSTCART_PASTECART; SNDCART_PASTECART]);; + +let EXISTS_PASTECART = prove + (`(?p. P p) <=> ?x y. P (pastecart x y)`, + MESON_TAC[PASTECART_FST_SND; FSTCART_PASTECART; SNDCART_PASTECART]);; + +let PASTECART_INJ = prove + (`!x:real^M y:real^N w z. pastecart x y = pastecart w z <=> x = w /\ y = z`, + REWRITE_TAC[PASTECART_EQ; FSTCART_PASTECART; SNDCART_PASTECART]);; + +(* ------------------------------------------------------------------------- *) +(* Automatically define a type of size n. *) +(* ------------------------------------------------------------------------- *) + +let define_finite_type = + let lemma_pre = prove + (`~(n = 0) ==> ?x. x IN 1..n`, + DISCH_TAC THEN EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC) + and lemma_post = prove + (`(!a:A. mk(dest a) = a) /\ (!r. r IN 1..n <=> dest(mk r) = r) + ==> (:A) HAS_SIZE n`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(:A) = IMAGE mk (1..n)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ] THEN + ASM_MESON_TAC[HAS_SIZE_NUMSEG_1]) in + let POST_RULE = MATCH_MP lemma_post and n_tm = `n:num` in + fun n -> + let ns = string_of_int n in + let ns' = "auto_define_finite_type_"^ns in + let th0 = INST [mk_small_numeral n,n_tm] lemma_pre in + let th1 = MP th0 (EQF_ELIM(NUM_EQ_CONV(rand(lhand(concl th0))))) in + POST_RULE(new_type_definition ns ("mk_"^ns',"dest_"^ns') th1);; + +(* ------------------------------------------------------------------------- *) +(* Predefine the cases 2, 3 and 4, which are especially useful for real^N. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_1 = prove + (`(:1) HAS_SIZE 1`, + SUBGOAL_THEN `(:1) = {one}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIV; IN_SING] THEN MESON_TAC[one]; + SIMP_TAC[NOT_IN_EMPTY; HAS_SIZE; FINITE_RULES; CARD_CLAUSES; ARITH]]);; + +let HAS_SIZE_2 = define_finite_type 2;; + +let HAS_SIZE_3 = define_finite_type 3;; + +let HAS_SIZE_4 = define_finite_type 4;; + +let DIMINDEX_1 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_1;; +let DIMINDEX_2 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_2;; +let DIMINDEX_3 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_3;; +let DIMINDEX_4 = MATCH_MP DIMINDEX_UNIQUE HAS_SIZE_4;; + +(* ------------------------------------------------------------------------- *) +(* Finiteness lemma. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_CART = prove + (`!P. (!i. 1 <= i /\ i <= dimindex(:N) ==> FINITE {x | P i x}) + ==> FINITE {v:A^N | !i. 1 <= i /\ i <= dimindex(:N) ==> P i (v$i)}`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n. n <= dimindex(:N) + ==> FINITE {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n + ==> P i (v$i)) /\ + (!i. 1 <= i /\ i <= dimindex(:N) /\ n < i + ==> v$i = @x. F)}` + (MP_TAC o SPEC `dimindex(:N)`) THEN REWRITE_TAC[LE_REFL; LET_ANTISYM] THEN + INDUCT_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n /\ i <= 0 <=> F`] THEN + SIMP_TAC[ARITH_RULE `1 <= i /\ i <= n /\ 0 < i <=> 1 <= i /\ i <= n`] THEN + SUBGOAL_THEN + `{v | !i. 1 <= i /\ i <= dimindex (:N) ==> v$i = (@x. F)} = + {(lambda i. @x. F):A^N}` + (fun th -> SIMP_TAC[FINITE_RULES;th]) THEN + SIMP_TAC[EXTENSION; IN_SING; IN_ELIM_THM; CART_EQ; LAMBDA_BETA]; + ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC + `IMAGE (\(x:A,v:A^N). (lambda i. if i = SUC n then x else v$i):A^N) + {x,v | x IN {x:A | P (SUC n) x} /\ + v IN {v:A^N | (!i. 1 <= i /\ i <= dimindex(:N) /\ i <= n + ==> P i (v$i)) /\ + (!i. 1 <= i /\ i <= dimindex (:N) /\ n < i + ==> v$i = (@x. F))}}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN + ASM_SIMP_TAC[FINITE_PRODUCT; ARITH_RULE `1 <= SUC n`; + ARITH_RULE `SUC n <= m ==> n <= m`]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_PAIR_THM; EXISTS_PAIR_THM] THEN + X_GEN_TAC `v:A^N` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN EXISTS_TAC `(v:A^N)$(SUC n)` THEN + EXISTS_TAC `(lambda i. if i = SUC n then @x. F else (v:A^N)$i):A^N` THEN + SIMP_TAC[CART_EQ; LAMBDA_BETA; ARITH_RULE `i <= n ==> ~(i = SUC n)`] THEN + ASM_MESON_TAC[LE; ARITH_RULE `1 <= SUC n`; + ARITH_RULE `n < i /\ ~(i = SUC n) ==> SUC n < i`]);; + +(* ------------------------------------------------------------------------- *) +(* More cardinality results for whole universe. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_CART_UNIV = prove + (`!m. (:A) HAS_SIZE m ==> (:A^N) HAS_SIZE m EXP (dimindex(:N))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(:(N)finite_image->A) HAS_SIZE m EXP (dimindex(:N))` + MP_TAC THENL + [ASM_SIMP_TAC[HAS_SIZE_FUNSPACE_UNIV; HAS_SIZE_FINITE_IMAGE]; + DISCH_THEN(MP_TAC o ISPEC `mk_cart:((N)finite_image->A)->A^N` o + MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] HAS_SIZE_IMAGE_INJ)) THEN + REWRITE_TAC[IN_UNIV] THEN + ANTS_TAC THENL [MESON_TAC[cart_tybij]; MATCH_MP_TAC EQ_IMP] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_UNIV] THEN MESON_TAC[cart_tybij]]);; + +let CARD_CART_UNIV = prove + (`FINITE(:A) ==> CARD(:A^N) = CARD(:A) EXP dimindex(:N)`, + MESON_TAC[HAS_SIZE_CART_UNIV; HAS_SIZE]);; + +let FINITE_CART_UNIV = prove + (`FINITE(:A) ==> FINITE(:A^N)`, + MESON_TAC[HAS_SIZE_CART_UNIV; HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* Explicit construction of a vector from a list of components. *) +(* ------------------------------------------------------------------------- *) + +let vector = new_definition + `(vector l):A^N = lambda i. EL (i - 1) l`;; + +(* ------------------------------------------------------------------------- *) +(* Convenient set membership elimination theorem. *) +(* ------------------------------------------------------------------------- *) + +let IN_ELIM_PASTECART_THM = prove + (`!P a b. pastecart a b IN {pastecart x y | P x y} <=> P a b`, + REWRITE_TAC[IN_ELIM_THM; PASTECART_EQ; + FSTCART_PASTECART; SNDCART_PASTECART] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Variant of product types using pasting of vectors. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("PCROSS",(22,"right"));; + +let PCROSS = new_definition + `s PCROSS t = {pastecart (x:A^M) (y:A^N) | x IN s /\ y IN t}`;; + +let FORALL_IN_PCROSS = prove + (`(!z. z IN s PCROSS t ==> P z) <=> + (!x y. x IN s /\ y IN t ==> P(pastecart x y))`, + REWRITE_TAC[PCROSS; FORALL_IN_GSPEC]);; + +let EXISTS_IN_PCROSS = prove + (`(?z. z IN s PCROSS t /\ P z) <=> + (?x y. x IN s /\ y IN t /\ P(pastecart x y))`, + REWRITE_TAC[PCROSS; EXISTS_IN_GSPEC; CONJ_ASSOC]);; + +let PASTECART_IN_PCROSS = prove + (`!s t x y. (pastecart x y) IN (s PCROSS t) <=> x IN s /\ y IN t`, + REWRITE_TAC[PCROSS; IN_ELIM_PASTECART_THM]);; + +let PCROSS_EQ_EMPTY = prove + (`!s t. s PCROSS t = {} <=> s = {} \/ t = {}`, + REWRITE_TAC[PCROSS] THEN SET_TAC[]);; + +let PCROSS_EMPTY = prove + (`(!s. s PCROSS {} = {}) /\ (!t. {} PCROSS t = {})`, + REWRITE_TAC[PCROSS_EQ_EMPTY]);; + +let SUBSET_PCROSS = prove + (`!s t s' t'. s PCROSS t SUBSET s' PCROSS t' <=> + s = {} \/ t = {} \/ s SUBSET s' /\ t SUBSET t'`, + SIMP_TAC[PCROSS; EXTENSION; IN_ELIM_PASTECART_THM; SUBSET; + FORALL_PASTECART; PASTECART_IN_PCROSS; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let PCROSS_MONO = prove + (`!s t s' t'. s SUBSET s' /\ t SUBSET t' ==> s PCROSS t SUBSET s' PCROSS t'`, + SIMP_TAC[SUBSET_PCROSS]);; + +let PCROSS_EQ = prove + (`!s s':real^M->bool t t':real^N->bool. + s PCROSS t = s' PCROSS t' <=> + (s = {} \/ t = {}) /\ (s' = {} \/ t' = {}) \/ s = s' /\ t = t'`, + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_PCROSS] THEN SET_TAC[]);; + +let UNIV_PCROSS_UNIV = prove + (`(:A^M) PCROSS (:A^N) = (:A^(M,N)finite_sum)`, + REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_UNIV]);; + +let HAS_SIZE_PCROSS = prove + (`!(s:A^M->bool) (t:A^N->bool) m n. + s HAS_SIZE m /\ t HAS_SIZE n ==> (s PCROSS t) HAS_SIZE (m * n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_SIZE_PRODUCT) THEN + MATCH_MP_TAC EQ_IMP THEN SPEC_TAC(`m * n:num`,`k:num`) THEN + MATCH_MP_TAC BIJECTIONS_HAS_SIZE_EQ THEN + EXISTS_TAC `\(x:A^M,y:A^N). pastecart x y` THEN + EXISTS_TAC `\z:A^(M,N)finite_sum. fstcart z,sndcart z` THEN + REWRITE_TAC[FORALL_IN_GSPEC; PASTECART_IN_PCROSS] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; PASTECART_FST_SND] THEN + REWRITE_TAC[FORALL_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART]);; + +let FINITE_PCROSS = prove + (`!(s:A^M->bool) (t:A^N->bool). + FINITE s /\ FINITE t ==> FINITE(s PCROSS t)`, + MESON_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_PCROSS]);; + +let FINITE_PCROSS_EQ = prove + (`!(s:A^M->bool) (t:A^N->bool). + FINITE(s PCROSS t) <=> s = {} \/ t = {} \/ FINITE s /\ FINITE t`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`s:A^M->bool = {}`; `t:A^N->bool = {}`] THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; FINITE_EMPTY] THEN + EQ_TAC THEN SIMP_TAC[FINITE_PCROSS] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THENL + [EXISTS_TAC `IMAGE fstcart ((s PCROSS t):A^(M,N)finite_sum->bool)`; + EXISTS_TAC `IMAGE sndcart ((s PCROSS t):A^(M,N)finite_sum->bool)`] THEN + ASM_SIMP_TAC[FINITE_IMAGE; SUBSET; IN_IMAGE; EXISTS_PASTECART] THEN + REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM SET_TAC[]);; + +let IMAGE_FSTCART_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + IMAGE fstcart (s PCROSS t) = if t = {} then {} else s`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; IMAGE_CLAUSES] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_PCROSS; FSTCART_PASTECART] THEN ASM SET_TAC[]);; + +let IMAGE_SNDCART_PCROSS = prove + (`!s:real^M->bool t:real^N->bool. + IMAGE sndcart (s PCROSS t) = if s = {} then {} else t`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[PCROSS_EMPTY; IMAGE_CLAUSES] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[EXISTS_IN_PCROSS; SNDCART_PASTECART] THEN ASM SET_TAC[]);; + +let PCROSS_INTER = prove + (`(!s t u. s PCROSS (t INTER u) = (s PCROSS t) INTER (s PCROSS u)) /\ + (!s t u. (s INTER t) PCROSS u = (s PCROSS u) INTER (t PCROSS u))`, + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_INTER; PASTECART_IN_PCROSS] THEN + REPEAT STRIP_TAC THEN CONV_TAC TAUT);; + +let PCROSS_UNION = prove + (`(!s t u. s PCROSS (t UNION u) = (s PCROSS t) UNION (s PCROSS u)) /\ + (!s t u. (s UNION t) PCROSS u = (s PCROSS u) UNION (t PCROSS u))`, + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_UNION; PASTECART_IN_PCROSS] THEN + REPEAT STRIP_TAC THEN CONV_TAC TAUT);; + +let PCROSS_DIFF = prove + (`(!s t u. s PCROSS (t DIFF u) = (s PCROSS t) DIFF (s PCROSS u)) /\ + (!s t u. (s DIFF t) PCROSS u = (s PCROSS u) DIFF (t PCROSS u))`, + REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_DIFF; PASTECART_IN_PCROSS] THEN + REPEAT STRIP_TAC THEN CONV_TAC TAUT);; + +let INTER_PCROSS = prove + (`!s s' t t'. + (s PCROSS t) INTER (s' PCROSS t') = (s INTER s') PCROSS (t INTER t')`, + REWRITE_TAC[EXTENSION; IN_INTER; FORALL_PASTECART; PASTECART_IN_PCROSS] THEN + CONV_TAC TAUT);; + +let PCROSS_UNIONS_UNIONS,PCROSS_UNIONS = (CONJ_PAIR o prove) + (`(!f g. (UNIONS f) PCROSS (UNIONS g) = + UNIONS {s PCROSS t | s IN f /\ t IN g}) /\ + (!s f. s PCROSS (UNIONS f) = UNIONS {s PCROSS t | t IN f}) /\ + (!f t. (UNIONS f) PCROSS t = UNIONS {s PCROSS t | s IN f})`, + REWRITE_TAC[UNIONS_GSPEC; EXTENSION; FORALL_PASTECART; IN_ELIM_THM; + PASTECART_IN_PCROSS] THEN + SET_TAC[]);; diff --git a/class.ml b/class.ml new file mode 100644 index 0000000..0b2fb5a --- /dev/null +++ b/class.ml @@ -0,0 +1,483 @@ +(* ========================================================================= *) +(* Extensional, classical reasoning with AC starts now! *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "ind_defs.ml";; + +(* ------------------------------------------------------------------------- *) +(* Eta-axiom, corresponding conversion, and extensionality. *) +(* ------------------------------------------------------------------------- *) + +let ETA_AX = new_axiom + `!t:A->B. (\x. t x) = t`;; + +let ETA_CONV = + let t = `t:A->B` in + let pth = prove(`(\x. (t:A->B) x) = t`,MATCH_ACCEPT_TAC ETA_AX) in + fun tm -> + try let bv,bod = dest_abs tm in + let l,r = dest_comb bod in + if r = bv & not (vfree_in bv l) then + TRANS (REFL tm) (PINST [type_of bv,aty; type_of bod,bty] [l,t] pth) + else fail() + with Failure _ -> failwith "ETA_CONV";; + +let EQ_EXT = prove + (`!(f:A->B) g. (!x. f x = g x) ==> f = g`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o ABS `x:A` o SPEC `x:A`) THEN + REWRITE_TAC[ETA_AX]);; + +let FUN_EQ_THM = prove + (`!(f:A->B) g. f = g <=> (!x. f x = g x)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC; + MATCH_ACCEPT_TAC EQ_EXT]);; + +(* ------------------------------------------------------------------------- *) +(* Indefinite descriptor (giving AC). *) +(* ------------------------------------------------------------------------- *) + +new_constant("@",`:(A->bool)->A`);; + +parse_as_binder "@";; + +let is_select = is_binder "@";; +let dest_select = dest_binder "@";; +let mk_select = mk_binder "@";; + +let SELECT_AX = new_axiom + `!P (x:A). P x ==> P((@) P)`;; + +(* ------------------------------------------------------------------------- *) +(* Useful for compatibility. (The old EXISTS_DEF.) *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_THM = prove + (`(?) = \P:A->bool. P ((@) P)`, + MATCH_MP_TAC EQ_EXT THEN BETA_TAC THEN X_GEN_TAC `P:A->bool` THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + EQ_TAC THENL + [DISCH_THEN(CHOOSE_THEN MP_TAC) THEN MATCH_ACCEPT_TAC SELECT_AX; + DISCH_TAC THEN EXISTS_TAC `((@) P):A` THEN POP_ASSUM ACCEPT_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Rules and so on for the select operator. *) +(* ------------------------------------------------------------------------- *) + +let SELECT_RULE = + let P = `P:A->bool` in + let pth = prove + (`(?) (P:A->bool) ==> P((@) P)`, + SIMP_TAC[SELECT_AX; ETA_AX]) in + fun th -> + try let abs = rand(concl th) in + let ty = type_of(bndvar abs) in + CONV_RULE BETA_CONV (MP (PINST [ty,aty] [abs,P] pth) th) + with Failure _ -> failwith "SELECT_RULE";; + +let SELECT_CONV = + let P = `P:A->bool` in + let pth = prove + (`(P:A->bool)((@) P) = (?) P`, + REWRITE_TAC[EXISTS_THM] THEN BETA_TAC THEN REFL_TAC) in + fun tm -> + try let is_epsok t = is_select t & + let bv,bod = dest_select t in + aconv tm (vsubst [t,bv] bod) in + let pickeps = find_term is_epsok tm in + let abs = rand pickeps in + let ty = type_of (bndvar abs) in + CONV_RULE (LAND_CONV BETA_CONV) (PINST [ty,aty] [abs,P] pth) + with Failure _ -> failwith "SELECT_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Some basic theorems. *) +(* ------------------------------------------------------------------------- *) + +let SELECT_REFL = prove + (`!x:A. (@y. y = x) = x`, + GEN_TAC THEN CONV_TAC SELECT_CONV THEN + EXISTS_TAC `x:A` THEN REFL_TAC);; + +let SELECT_UNIQUE = prove + (`!P x. (!y:A. P y = (y = x)) ==> ((@) P = x)`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + ASM_REWRITE_TAC[SELECT_REFL]);; + +extend_basic_rewrites [SELECT_REFL];; + +(* ------------------------------------------------------------------------- *) +(* Now we can derive type definitions from existence; check benignity. *) +(* ------------------------------------------------------------------------- *) + +let the_type_definitions = ref ([]:((string*string*string)*(thm*thm))list);; + +let new_type_definition tyname (absname,repname) th = + try let th',tth' = assoc (tyname,absname,repname) (!the_type_definitions) in + if concl th' <> concl th then failwith "" else + (warn true "Benign redefinition of type"; tth') + with Failure _ -> + let th0 = + CONV_RULE (RATOR_CONV (REWR_CONV EXISTS_THM) THENC BETA_CONV) th in + let th1,th2 = new_basic_type_definition tyname (absname,repname) th0 in + let tth = CONJ (GEN_ALL th1) + (GEN_ALL (CONV_RULE(LAND_CONV (TRY_CONV BETA_CONV)) th2)) in + the_type_definitions := ((tyname,absname,repname),(th,tth)):: + (!the_type_definitions); + tth;; + +(* ------------------------------------------------------------------------- *) +(* Derive excluded middle. The proof is an optimization due to Mark Adams of *) +(* the original Diaconescu proof as presented in Beeson's book. *) +(* ------------------------------------------------------------------------- *) + +let EXCLUDED_MIDDLE = prove + (`!t. t \/ ~t`, + GEN_TAC THEN SUBGOAL_THEN + `(((@x. (x <=> F) \/ t) <=> F) \/ t) /\ (((@x. (x <=> T) \/ t) <=> T) \/ t)` + MP_TAC THENL + [CONJ_TAC THEN CONV_TAC SELECT_CONV THENL + [EXISTS_TAC `F`; EXISTS_TAC `T`] THEN + DISJ1_TAC THEN REFL_TAC; + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + TRY(DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC) THEN + DISJ2_TAC THEN DISCH_TAC THEN MP_TAC(ITAUT `~(T <=> F)`) THEN + PURE_ONCE_ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[ITAUT `p \/ T <=> T`]]);; + +let BOOL_CASES_AX = prove + (`!t. (t <=> T) \/ (t <=> F)`, + GEN_TAC THEN DISJ_CASES_TAC(SPEC `t:bool` EXCLUDED_MIDDLE) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Classically based tactics. (See also COND_CASES_TAC later on.) *) +(* ------------------------------------------------------------------------- *) + +let BOOL_CASES_TAC p = STRUCT_CASES_TAC (SPEC p BOOL_CASES_AX);; + +let ASM_CASES_TAC t = DISJ_CASES_TAC(SPEC t EXCLUDED_MIDDLE);; + +(* ------------------------------------------------------------------------- *) +(* Set up a reasonable tautology checker for classical logic. *) +(* ------------------------------------------------------------------------- *) + +let TAUT = + let PROP_REWRITE_TAC = REWRITE_TAC[] in + let RTAUT_TAC (asl,w) = + let ok t = type_of t = bool_ty & can (find_term is_var) t & free_in t w in + (PROP_REWRITE_TAC THEN + W((fun t1 t2 -> t1 THEN t2) (REWRITE_TAC[]) o BOOL_CASES_TAC o + hd o sort free_in o find_terms ok o snd)) (asl,w) in + let TAUT_TAC = REPEAT(GEN_TAC ORELSE CONJ_TAC) THEN REPEAT RTAUT_TAC in + fun tm -> prove(tm,TAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A few useful classical tautologies. *) +(* ------------------------------------------------------------------------- *) + +let DE_MORGAN_THM = TAUT + `!t1 t2. (~(t1 /\ t2) <=> ~t1 \/ ~t2) /\ (~(t1 \/ t2) <=> ~t1 /\ ~t2)`;; + +let NOT_CLAUSES = + TAUT `(!t. ~ ~t <=> t) /\ (~T <=> F) /\ (~F <=> T)`;; + +let NOT_IMP = TAUT `!t1 t2. ~(t1 ==> t2) <=> t1 /\ ~t2`;; + +let CONTRAPOS_THM = TAUT `!t1 t2. (~t1 ==> ~t2) <=> (t2 ==> t1)`;; + +extend_basic_rewrites [CONJUNCT1 NOT_CLAUSES];; + +(* ------------------------------------------------------------------------- *) +(* Some classically based rules. *) +(* ------------------------------------------------------------------------- *) + +let CCONTR = + let P = `P:bool` in + let pth = TAUT `(~P ==> F) ==> P` in + fun tm th -> + try let tm' = mk_neg tm in + MP (INST [tm,P] pth) (DISCH tm' th) + with Failure _ -> failwith "CCONTR";; + +let CONTRAPOS_CONV = + let a = `a:bool` and b = `b:bool` in + let pth = TAUT `(a ==> b) <=> (~b ==> ~a)` in + fun tm -> + try let P,Q = dest_imp tm in + INST [P,a; Q,b] pth + with Failure _ -> failwith "CONTRAPOS_CONV";; + +(* ------------------------------------------------------------------------- *) +(* A classicalal "refutation" tactic. *) +(* ------------------------------------------------------------------------- *) + +let REFUTE_THEN = + let f_tm = `F` + and conv = REWR_CONV(TAUT `p <=> ~p ==> F`) in + fun ttac (asl,w as gl) -> + if w = f_tm then ALL_TAC gl + else if is_neg w then DISCH_THEN ttac gl + else (CONV_TAC conv THEN DISCH_THEN ttac) gl;; + +(* ------------------------------------------------------------------------- *) +(* Infinite de Morgan laws. *) +(* ------------------------------------------------------------------------- *) + +let NOT_EXISTS_THM = prove + (`!P. ~(?x:A. P x) <=> (!x. ~(P x))`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN UNDISCH_TAC `~(?x:A. P x)` THEN + REWRITE_TAC[] THEN EXISTS_TAC `x:A` THEN POP_ASSUM ACCEPT_TAC; + DISCH_THEN(CHOOSE_THEN MP_TAC) THEN ASM_REWRITE_TAC[]]);; + +let EXISTS_NOT_THM = prove + (`!P. (?x:A. ~(P x)) <=> ~(!x. P x)`, + ONCE_REWRITE_TAC[TAUT `(a <=> ~b) <=> (~a <=> b)`] THEN + REWRITE_TAC[NOT_EXISTS_THM]);; + +let NOT_FORALL_THM = prove + (`!P. ~(!x. P x) <=> (?x:A. ~(P x))`, + MATCH_ACCEPT_TAC(GSYM EXISTS_NOT_THM));; + +let FORALL_NOT_THM = prove + (`!P. (!x. ~(P x)) <=> ~(?x:A. P x)`, + MATCH_ACCEPT_TAC(GSYM NOT_EXISTS_THM));; + +(* ------------------------------------------------------------------------- *) +(* Expand quantification over Booleans. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_BOOL_THM = prove + (`(!b. P b) <=> P T /\ P F`, + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN ASM_REWRITE_TAC[]);; + +let EXISTS_BOOL_THM = prove + (`(?b. P b) <=> P T \/ P F`, + MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_EXISTS_THM; FORALL_BOOL_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Universal quantifier and disjunction *) +(* ------------------------------------------------------------------------- *) + +let LEFT_FORALL_OR_THM = prove + (`!P Q. (!x:A. P x \/ Q) <=> (!x. P x) \/ Q`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[NOT_FORALL_THM; DE_MORGAN_THM; LEFT_EXISTS_AND_THM]);; + +let RIGHT_FORALL_OR_THM = prove + (`!P Q. (!x:A. P \/ Q x) <=> P \/ (!x. Q x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[NOT_FORALL_THM; DE_MORGAN_THM; RIGHT_EXISTS_AND_THM]);; + +let LEFT_OR_FORALL_THM = prove + (`!P Q. (!x:A. P x) \/ Q <=> (!x. P x \/ Q)`, + MATCH_ACCEPT_TAC(GSYM LEFT_FORALL_OR_THM));; + +let RIGHT_OR_FORALL_THM = prove + (`!P Q. P \/ (!x:A. Q x) <=> (!x. P \/ Q x)`, + MATCH_ACCEPT_TAC(GSYM RIGHT_FORALL_OR_THM));; + +(* ------------------------------------------------------------------------- *) +(* Implication and quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_IMP_FORALL_THM = prove + (`!P Q. ((!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP; LEFT_AND_FORALL_THM]);; + +let LEFT_EXISTS_IMP_THM = prove + (`!P Q. (?x. P x ==> Q) <=> ((!x:A. P x) ==> Q)`, + MATCH_ACCEPT_TAC(GSYM LEFT_IMP_FORALL_THM));; + +let RIGHT_IMP_EXISTS_THM = prove + (`!P Q. (P ==> ?x:A. Q x) <=> (?x:A. P ==> Q x)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_IMP; RIGHT_AND_FORALL_THM]);; + +let RIGHT_EXISTS_IMP_THM = prove + (`!P Q. (?x:A. P ==> Q x) <=> (P ==> ?x:A. Q x)`, + MATCH_ACCEPT_TAC(GSYM RIGHT_IMP_EXISTS_THM));; + +(* ------------------------------------------------------------------------- *) +(* The conditional. *) +(* ------------------------------------------------------------------------- *) + +let COND_DEF = new_definition + `COND = \t t1 t2. @x:A. ((t <=> T) ==> (x = t1)) /\ + ((t <=> F) ==> (x = t2))`;; + +let COND_CLAUSES = prove + (`!(t1:A) t2. ((if T then t1 else t2) = t1) /\ + ((if F then t1 else t2) = t2)`, + REWRITE_TAC[COND_DEF]);; + +let is_cond tm = + try fst(dest_const(rator(rator (rator tm)))) = "COND" + with Failure _ -> false;; + +let mk_cond (b,x,y) = + try let c = mk_const("COND",[type_of x,aty]) in + mk_comb(mk_comb(mk_comb(c,b),x),y) + with Failure _ -> failwith "mk_cond";; + +let dest_cond tm = + try let tm1,y = dest_comb tm in + let tm2,x = dest_comb tm1 in + let c,b = dest_comb tm2 in + if fst(dest_const c) = "COND" then (b,(x,y)) else fail() + with Failure _ -> failwith "dest_cond";; + +extend_basic_rewrites [COND_CLAUSES];; + +let COND_EXPAND = prove + (`!b t1 t2. (if b then t1 else t2) <=> (~b \/ t1) /\ (b \/ t2)`, + REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN + REWRITE_TAC[]);; + +let COND_ID = prove + (`!b (t:A). (if b then t else t) = t`, + REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; + +let COND_RAND = prove + (`!b (f:A->B) x y. f (if b then x else y) = (if b then f x else f y)`, + REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; + +let COND_RATOR = prove + (`!b (f:A->B) g x. (if b then f else g)(x) = (if b then f x else g x)`, + REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[]);; + +let COND_ABS = prove + (`!b (f:A->B) g. (\x. if b then f x else g x) = (if b then f else g)`, + REPEAT GEN_TAC THEN BOOL_CASES_TAC `b:bool` THEN REWRITE_TAC[ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Redefine TAUT to freeze in the rewrites including COND. *) +(* ------------------------------------------------------------------------- *) + +let TAUT = + let PROP_REWRITE_TAC = REWRITE_TAC[] in + let RTAUT_TAC (asl,w) = + let ok t = type_of t = bool_ty & can (find_term is_var) t & free_in t w in + (PROP_REWRITE_TAC THEN + W((fun t1 t2 -> t1 THEN t2) (REWRITE_TAC[]) o BOOL_CASES_TAC o + hd o sort free_in o find_terms ok o snd)) (asl,w) in + let TAUT_TAC = REPEAT(GEN_TAC ORELSE CONJ_TAC) THEN REPEAT RTAUT_TAC in + fun tm -> prove(tm,TAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Throw monotonicity in. *) +(* ------------------------------------------------------------------------- *) + +let MONO_COND = prove + (`(A ==> B) /\ (C ==> D) ==> (if b then A else C) ==> (if b then B else D)`, + STRIP_TAC THEN BOOL_CASES_TAC `b:bool` THEN + ASM_REWRITE_TAC[]);; + +monotonicity_theorems := MONO_COND::(!monotonicity_theorems);; + +(* ------------------------------------------------------------------------- *) +(* Tactic for splitting over an arbitrarily chosen conditional. *) +(* ------------------------------------------------------------------------- *) + +let COND_ELIM_THM = prove + (`(P:A->bool) (if c then x else y) <=> (c ==> P x) /\ (~c ==> P y)`, + BOOL_CASES_TAC `c:bool` THEN REWRITE_TAC[]);; + +let COND_ELIM_CONV = HIGHER_REWRITE_CONV[COND_ELIM_THM] true;; + +let (COND_CASES_TAC :tactic) = + let DENEG_RULE = GEN_REWRITE_RULE I [TAUT `~ ~ p <=> p`] in + CONV_TAC COND_ELIM_CONV THEN CONJ_TAC THENL + [DISCH_THEN(fun th -> ASSUME_TAC th THEN SUBST1_TAC(EQT_INTRO th)); + DISCH_THEN(fun th -> try let th' = DENEG_RULE th in + ASSUME_TAC th' THEN SUBST1_TAC(EQT_INTRO th') + with Failure _ -> + ASSUME_TAC th THEN SUBST1_TAC(EQF_INTRO th))];; + +(* ------------------------------------------------------------------------- *) +(* Skolemization. *) +(* ------------------------------------------------------------------------- *) + +let SKOLEM_THM = prove + (`!P. (!x:A. ?y:B. P x y) <=> (?y. !x. P x (y x))`, + REPEAT(STRIP_TAC ORELSE EQ_TAC) THENL + [EXISTS_TAC `\x:A. @y:B. P x y` THEN GEN_TAC THEN + BETA_TAC THEN CONV_TAC SELECT_CONV; + EXISTS_TAC `(y:A->B) x`] THEN + POP_ASSUM MATCH_ACCEPT_TAC);; + +let SKOLEM_THM_GEN = prove + (`!P s. (!x. P x ==> ?y. R x y) <=> (?f. !x. P x ==> R x (f x))`, + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM]);; + +(* ------------------------------------------------------------------------- *) +(* NB: this one is true intutionistically and intensionally. *) +(* ------------------------------------------------------------------------- *) + +let UNIQUE_SKOLEM_ALT = prove + (`!P:A->B->bool. (!x. ?!y. P x y) <=> ?f. !x y. P x y <=> (f x = y)`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_ALT; SKOLEM_THM]);; + +(* ------------------------------------------------------------------------- *) +(* and this one intuitionistically and extensionally. *) +(* ------------------------------------------------------------------------- *) + +let UNIQUE_SKOLEM_THM = prove + (`!P. (!x:A. ?!y:B. P x y) <=> (?!f. !x. P x (f x))`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM; SKOLEM_THM; FORALL_AND_THM] THEN + EQ_TAC THEN DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THENL + [REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`x:A`; `y1:B`; `y2:B`] THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `f:A->B`) THEN + SUBGOAL_THEN `(\z. if z = x then y1 else (f:A->B) z) = + (\z. if z = x then y2 else (f:A->B) z)` MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o C AP_THM `x:A`) THEN REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Extend default congruences for contextual rewriting. *) +(* ------------------------------------------------------------------------- *) + +let COND_CONG = + TAUT `(g = g') ==> + (g' ==> (t = t')) ==> + (~g' ==> (e = e')) ==> + ((if g then t else e) = (if g' then t' else e'))` in + extend_basic_congs [COND_CONG];; + +let COND_EQ_CLAUSE = prove + (`(if x = x then y else z) = y`, + REWRITE_TAC[]) in + extend_basic_rewrites [COND_EQ_CLAUSE];; + +(* ------------------------------------------------------------------------- *) +(* We can now treat "bool" as an enumerated type for some purposes. *) +(* ------------------------------------------------------------------------- *) + +let bool_INDUCT = prove + (`!P. P F /\ P T ==> !x. P x`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(SPEC `x:bool` BOOL_CASES_AX) THEN + ASM_REWRITE_TAC[]);; + +let bool_RECURSION = prove + (`!a b:A. ?f. f F = a /\ f T = b`, + REPEAT GEN_TAC THEN EXISTS_TAC `\x. if x then b:A else a` THEN + REWRITE_TAC[]);; + +let inductive_type_store = ref + ["bool",(2,bool_INDUCT,bool_RECURSION)];; diff --git a/database.ml b/database.ml new file mode 100644 index 0000000..a787088 --- /dev/null +++ b/database.ml @@ -0,0 +1,2289 @@ +needs "help.ml";; + +theorems := +[ +"ABSORPTION",ABSORPTION; +"ABS_SIMP",ABS_SIMP; +"ADD",ADD; +"ADD1",ADD1; +"ADD_0",ADD_0; +"ADD_AC",ADD_AC; +"ADD_ASSOC",ADD_ASSOC; +"ADD_CLAUSES",ADD_CLAUSES; +"ADD_EQ_0",ADD_EQ_0; +"ADD_SUB",ADD_SUB; +"ADD_SUB2",ADD_SUB2; +"ADD_SUBR",ADD_SUBR; +"ADD_SUBR2",ADD_SUBR2; +"ADD_SUC",ADD_SUC; +"ADD_SYM",ADD_SYM; +"ADMISSIBLE_BASE",ADMISSIBLE_BASE; +"ADMISSIBLE_COMB",ADMISSIBLE_COMB; +"ADMISSIBLE_COND",ADMISSIBLE_COND; +"ADMISSIBLE_CONST",ADMISSIBLE_CONST; +"ADMISSIBLE_GUARDED_PATTERN",ADMISSIBLE_GUARDED_PATTERN; +"ADMISSIBLE_IMP_SUPERADMISSIBLE",ADMISSIBLE_IMP_SUPERADMISSIBLE; +"ADMISSIBLE_LAMBDA",ADMISSIBLE_LAMBDA; +"ADMISSIBLE_MAP",ADMISSIBLE_MAP; +"ADMISSIBLE_MATCH",ADMISSIBLE_MATCH; +"ADMISSIBLE_MATCH_SEQPATTERN",ADMISSIBLE_MATCH_SEQPATTERN; +"ADMISSIBLE_NEST",ADMISSIBLE_NEST; +"ADMISSIBLE_NSUM",ADMISSIBLE_NSUM; +"ADMISSIBLE_RAND",ADMISSIBLE_RAND; +"ADMISSIBLE_SEQPATTERN",ADMISSIBLE_SEQPATTERN; +"ADMISSIBLE_SUM",ADMISSIBLE_SUM; +"ADMISSIBLE_UNGUARDED_PATTERN",ADMISSIBLE_UNGUARDED_PATTERN; +"ALL",ALL; +"ALL2",ALL2; +"ALL2_ALL",ALL2_ALL; +"ALL2_AND_RIGHT",ALL2_AND_RIGHT; +"ALL2_DEF",ALL2_DEF; +"ALL2_MAP",ALL2_MAP; +"ALL2_MAP2",ALL2_MAP2; +"ALL_APPEND",ALL_APPEND; +"ALL_EL",ALL_EL; +"ALL_FILTER",ALL_FILTER; +"ALL_IMP",ALL_IMP; +"ALL_MAP",ALL_MAP; +"ALL_MEM",ALL_MEM; +"ALL_MP",ALL_MP; +"ALL_T",ALL_T; +"AND_ALL",AND_ALL; +"AND_ALL2",AND_ALL2; +"AND_CLAUSES",AND_CLAUSES; +"AND_DEF",AND_DEF; +"AND_FORALL_THM",AND_FORALL_THM; +"APPEND",APPEND; +"APPEND_ASSOC",APPEND_ASSOC; +"APPEND_BUTLAST_LAST",APPEND_BUTLAST_LAST; +"APPEND_EQ_NIL",APPEND_EQ_NIL; +"APPEND_NIL",APPEND_NIL; +"APPEND_SING",APPEND_SING; +"ARITH",ARITH; +"ARITH_ADD",ARITH_ADD; +"ARITH_EQ",ARITH_EQ; +"ARITH_EVEN",ARITH_EVEN; +"ARITH_EXP",ARITH_EXP; +"ARITH_GE",ARITH_GE; +"ARITH_GT",ARITH_GT; +"ARITH_LE",ARITH_LE; +"ARITH_LT",ARITH_LT; +"ARITH_MULT",ARITH_MULT; +"ARITH_ODD",ARITH_ODD; +"ARITH_PRE",ARITH_PRE; +"ARITH_SUB",ARITH_SUB; +"ARITH_SUC",ARITH_SUC; +"ARITH_ZERO",ARITH_ZERO; +"ASSOC",ASSOC; +"BETA_THM",BETA_THM; +"BIJ",BIJ; +"BIJECTIONS_CARD_EQ",BIJECTIONS_CARD_EQ; +"BIJECTIONS_HAS_SIZE",BIJECTIONS_HAS_SIZE; +"BIJECTIONS_HAS_SIZE_EQ",BIJECTIONS_HAS_SIZE_EQ; +"BIJECTIVE_LEFT_RIGHT_INVERSE",BIJECTIVE_LEFT_RIGHT_INVERSE; +"BIJECTIVE_ON_LEFT_RIGHT_INVERSE",BIJECTIVE_ON_LEFT_RIGHT_INVERSE; +"BIT0",BIT0; +"BIT0_DEF",BIT0_DEF; +"BIT0_THM",BIT0_THM; +"BIT1",BIT1; +"BIT1_DEF",BIT1_DEF; +"BIT1_THM",BIT1_THM; +"BOOL_CASES_AX",BOOL_CASES_AX; +"BOTTOM",BOTTOM; +"BOUNDS_DIVIDED",BOUNDS_DIVIDED; +"BOUNDS_IGNORE",BOUNDS_IGNORE; +"BOUNDS_LINEAR",BOUNDS_LINEAR; +"BOUNDS_LINEAR_0",BOUNDS_LINEAR_0; +"BOUNDS_NOTZERO",BOUNDS_NOTZERO; +"BUTLAST",BUTLAST; +"CARD",CARD; +"CARD_BOOL",CARD_BOOL; +"CARD_CART_UNIV",CARD_CART_UNIV; +"CARD_CLAUSES",CARD_CLAUSES; +"CARD_CROSS",CARD_CROSS; +"CARD_DELETE",CARD_DELETE; +"CARD_DIFF",CARD_DIFF; +"CARD_EQ_0",CARD_EQ_0; +"CARD_EQ_BIJECTION",CARD_EQ_BIJECTION; +"CARD_EQ_BIJECTIONS",CARD_EQ_BIJECTIONS; +"CARD_EQ_NSUM",CARD_EQ_NSUM; +"CARD_EQ_SUM",CARD_EQ_SUM; +"CARD_FINITE_IMAGE",CARD_FINITE_IMAGE; +"CARD_FUNSPACE",CARD_FUNSPACE; +"CARD_FUNSPACE_UNIV",CARD_FUNSPACE_UNIV; +"CARD_IMAGE_EQ_INJ",CARD_IMAGE_EQ_INJ; +"CARD_IMAGE_INJ",CARD_IMAGE_INJ; +"CARD_IMAGE_INJ_EQ",CARD_IMAGE_INJ_EQ; +"CARD_IMAGE_LE",CARD_IMAGE_LE; +"CARD_LE_INJ",CARD_LE_INJ; +"CARD_NUMSEG",CARD_NUMSEG; +"CARD_NUMSEG_1",CARD_NUMSEG_1; +"CARD_NUMSEG_LE",CARD_NUMSEG_LE; +"CARD_NUMSEG_LEMMA",CARD_NUMSEG_LEMMA; +"CARD_NUMSEG_LT",CARD_NUMSEG_LT; +"CARD_POWERSET",CARD_POWERSET; +"CARD_PRODUCT",CARD_PRODUCT; +"CARD_PSUBSET",CARD_PSUBSET; +"CARD_SET_OF_LIST_LE",CARD_SET_OF_LIST_LE; +"CARD_SING",CARD_SING; +"CARD_SUBSET",CARD_SUBSET; +"CARD_SUBSET_EQ",CARD_SUBSET_EQ; +"CARD_SUBSET_IMAGE",CARD_SUBSET_IMAGE; +"CARD_SUBSET_LE",CARD_SUBSET_LE; +"CARD_UNION",CARD_UNION; +"CARD_UNIONS",CARD_UNIONS; +"CARD_UNIONS_LE",CARD_UNIONS_LE; +"CARD_UNION_EQ",CARD_UNION_EQ; +"CARD_UNION_GEN",CARD_UNION_GEN; +"CARD_UNION_LE",CARD_UNION_LE; +"CARD_UNION_OVERLAP",CARD_UNION_OVERLAP; +"CARD_UNION_OVERLAP_EQ",CARD_UNION_OVERLAP_EQ; +"CART_EQ",CART_EQ; +"CART_EQ_FULL",CART_EQ_FULL; +"CASEWISE",CASEWISE; +"CASEWISE_CASES",CASEWISE_CASES; +"CASEWISE_DEF",CASEWISE_DEF; +"CASEWISE_WORKS",CASEWISE_WORKS; +"CHOICE",CHOICE; +"CHOICE_DEF",CHOICE_DEF; +"CHOOSE_SUBSET",CHOOSE_SUBSET; +"CHOOSE_SUBSET_BETWEEN",CHOOSE_SUBSET_BETWEEN; +"CHOOSE_SUBSET_STRONG",CHOOSE_SUBSET_STRONG; +"COMMA_DEF",COMMA_DEF; +"COMPONENT",COMPONENT; +"COND_ABS",COND_ABS; +"COND_CLAUSES",COND_CLAUSES; +"COND_DEF",COND_DEF; +"COND_ELIM_THM",COND_ELIM_THM; +"COND_EXPAND",COND_EXPAND; +"COND_ID",COND_ID; +"COND_RAND",COND_RAND; +"COND_RATOR",COND_RATOR; +"CONJ_ACI",CONJ_ACI; +"CONJ_ASSOC",CONJ_ASSOC; +"CONJ_SYM",CONJ_SYM; +"CONSTR",CONSTR; +"CONSTR_BOT",CONSTR_BOT; +"CONSTR_IND",CONSTR_IND; +"CONSTR_INJ",CONSTR_INJ; +"CONSTR_REC",CONSTR_REC; +"CONS_11",CONS_11; +"CONS_HD_TL",CONS_HD_TL; +"CONTRAPOS_THM",CONTRAPOS_THM; +"COUNTABLE",COUNTABLE; +"CROSS",CROSS; +"CROSS_EQ_EMPTY",CROSS_EQ_EMPTY; +"CURRY_DEF",CURRY_DEF; +"DECIMAL",DECIMAL; +"DECOMPOSITION",DECOMPOSITION; +"DELETE",DELETE; +"DELETE_COMM",DELETE_COMM; +"DELETE_DELETE",DELETE_DELETE; +"DELETE_INSERT",DELETE_INSERT; +"DELETE_INTER",DELETE_INTER; +"DELETE_NON_ELEMENT",DELETE_NON_ELEMENT; +"DELETE_SUBSET",DELETE_SUBSET; +"DEPENDENT_CHOICE",DEPENDENT_CHOICE; +"DEPENDENT_CHOICE_FIXED",DEPENDENT_CHOICE_FIXED; +"DEST_REC_INJ",DEST_REC_INJ; +"DE_MORGAN_THM",DE_MORGAN_THM; +"DIFF",DIFF; +"DIFF_DIFF",DIFF_DIFF; +"DIFF_EMPTY",DIFF_EMPTY; +"DIFF_EQ_EMPTY",DIFF_EQ_EMPTY; +"DIFF_INSERT",DIFF_INSERT; +"DIFF_INTERS",DIFF_INTERS; +"DIFF_UNIONS",DIFF_UNIONS; +"DIFF_UNIONS_NONEMPTY",DIFF_UNIONS_NONEMPTY; +"DIFF_UNIV",DIFF_UNIV; +"DIMINDEX_1",DIMINDEX_1; +"DIMINDEX_2",DIMINDEX_2; +"DIMINDEX_3",DIMINDEX_3; +"DIMINDEX_4",DIMINDEX_4; +"DIMINDEX_FINITE_IMAGE",DIMINDEX_FINITE_IMAGE; +"DIMINDEX_FINITE_SUM",DIMINDEX_FINITE_SUM; +"DIMINDEX_GE_1",DIMINDEX_GE_1; +"DIMINDEX_HAS_SIZE_FINITE_SUM",DIMINDEX_HAS_SIZE_FINITE_SUM; +"DIMINDEX_NONZERO",DIMINDEX_NONZERO; +"DIMINDEX_UNIQUE",DIMINDEX_UNIQUE; +"DIMINDEX_UNIV",DIMINDEX_UNIV; +"DISJOINT",DISJOINT; +"DISJOINT_DELETE_SYM",DISJOINT_DELETE_SYM; +"DISJOINT_EMPTY",DISJOINT_EMPTY; +"DISJOINT_EMPTY_REFL",DISJOINT_EMPTY_REFL; +"DISJOINT_INSERT",DISJOINT_INSERT; +"DISJOINT_NUMSEG",DISJOINT_NUMSEG; +"DISJOINT_SYM",DISJOINT_SYM; +"DISJOINT_UNION",DISJOINT_UNION; +"DISJ_ACI",DISJ_ACI; +"DISJ_ASSOC",DISJ_ASSOC; +"DISJ_SYM",DISJ_SYM; +"DIST_ADD2",DIST_ADD2; +"DIST_ADD2_REV",DIST_ADD2_REV; +"DIST_ADDBOUND",DIST_ADDBOUND; +"DIST_ELIM_THM",DIST_ELIM_THM; +"DIST_EQ_0",DIST_EQ_0; +"DIST_LADD",DIST_LADD; +"DIST_LADD_0",DIST_LADD_0; +"DIST_LE_CASES",DIST_LE_CASES; +"DIST_LMUL",DIST_LMUL; +"DIST_LZERO",DIST_LZERO; +"DIST_RADD",DIST_RADD; +"DIST_RADD_0",DIST_RADD_0; +"DIST_REFL",DIST_REFL; +"DIST_RMUL",DIST_RMUL; +"DIST_RZERO",DIST_RZERO; +"DIST_SYM",DIST_SYM; +"DIST_TRIANGLE",DIST_TRIANGLE; +"DIST_TRIANGLES_LE",DIST_TRIANGLES_LE; +"DIST_TRIANGLE_LE",DIST_TRIANGLE_LE; +"DIVIDES_LE",DIVIDES_LE; +"DIVISION",DIVISION; +"DIVISION_0",DIVISION_0; +"DIVISION_SIMP",DIVISION_SIMP; +"DIVMOD_ELIM_THM",DIVMOD_ELIM_THM; +"DIVMOD_ELIM_THM'",DIVMOD_ELIM_THM'; +"DIVMOD_EXIST",DIVMOD_EXIST; +"DIVMOD_EXIST_0",DIVMOD_EXIST_0; +"DIVMOD_UNIQ",DIVMOD_UNIQ; +"DIVMOD_UNIQ_LEMMA",DIVMOD_UNIQ_LEMMA; +"DIV_0",DIV_0; +"DIV_1",DIV_1; +"DIV_ADD_MOD",DIV_ADD_MOD; +"DIV_DIV",DIV_DIV; +"DIV_EQ_0",DIV_EQ_0; +"DIV_EQ_EXCLUSION",DIV_EQ_EXCLUSION; +"DIV_LE",DIV_LE; +"DIV_LE_EXCLUSION",DIV_LE_EXCLUSION; +"DIV_LT",DIV_LT; +"DIV_MOD",DIV_MOD; +"DIV_MONO",DIV_MONO; +"DIV_MONO2",DIV_MONO2; +"DIV_MONO_LT",DIV_MONO_LT; +"DIV_MULT",DIV_MULT; +"DIV_MULT2",DIV_MULT2; +"DIV_MULT_ADD",DIV_MULT_ADD; +"DIV_MUL_LE",DIV_MUL_LE; +"DIV_REFL",DIV_REFL; +"DIV_UNIQ",DIV_UNIQ; +"EL",EL; +"EL_APPEND",EL_APPEND; +"EL_CONS",EL_CONS; +"EL_MAP",EL_MAP; +"EL_TL",EL_TL; +"EMPTY",EMPTY; +"EMPTY_DELETE",EMPTY_DELETE; +"EMPTY_DIFF",EMPTY_DIFF; +"EMPTY_GSPEC",EMPTY_GSPEC; +"EMPTY_NOT_UNIV",EMPTY_NOT_UNIV; +"EMPTY_SUBSET",EMPTY_SUBSET; +"EMPTY_UNION",EMPTY_UNION; +"EMPTY_UNIONS",EMPTY_UNIONS; +"EQ_ADD_LCANCEL",EQ_ADD_LCANCEL; +"EQ_ADD_LCANCEL_0",EQ_ADD_LCANCEL_0; +"EQ_ADD_RCANCEL",EQ_ADD_RCANCEL; +"EQ_ADD_RCANCEL_0",EQ_ADD_RCANCEL_0; +"EQ_CLAUSES",EQ_CLAUSES; +"EQ_EXP",EQ_EXP; +"EQ_EXT",EQ_EXT; +"EQ_IMP",EQ_IMP; +"EQ_IMP_LE",EQ_IMP_LE; +"EQ_MULT_LCANCEL",EQ_MULT_LCANCEL; +"EQ_MULT_RCANCEL",EQ_MULT_RCANCEL; +"EQ_REFL",EQ_REFL; +"EQ_SYM",EQ_SYM; +"EQ_SYM_EQ",EQ_SYM_EQ; +"EQ_TRANS",EQ_TRANS; +"EQ_UNIV",EQ_UNIV; +"ETA_AX",ETA_AX; +"EVEN",EVEN; +"EVEN_ADD",EVEN_ADD; +"EVEN_AND_ODD",EVEN_AND_ODD; +"EVEN_DOUBLE",EVEN_DOUBLE; +"EVEN_EXISTS",EVEN_EXISTS; +"EVEN_EXISTS_LEMMA",EVEN_EXISTS_LEMMA; +"EVEN_EXP",EVEN_EXP; +"EVEN_MOD",EVEN_MOD; +"EVEN_MULT",EVEN_MULT; +"EVEN_ODD_DECOMPOSITION",EVEN_ODD_DECOMPOSITION; +"EVEN_OR_ODD",EVEN_OR_ODD; +"EVEN_SUB",EVEN_SUB; +"EX",EX; +"EXCLUDED_MIDDLE",EXCLUDED_MIDDLE; +"EXISTS_BOOL_THM",EXISTS_BOOL_THM; +"EXISTS_CURRY",EXISTS_CURRY; +"EXISTS_DEF",EXISTS_DEF; +"EXISTS_EX",EXISTS_EX; +"EXISTS_FINITE_SUBSET_IMAGE",EXISTS_FINITE_SUBSET_IMAGE; +"EXISTS_IN_CLAUSES",EXISTS_IN_CLAUSES; +"EXISTS_IN_GSPEC",EXISTS_IN_GSPEC; +"EXISTS_IN_IMAGE",EXISTS_IN_IMAGE; +"EXISTS_IN_INSERT",EXISTS_IN_INSERT; +"EXISTS_IN_PCROSS",EXISTS_IN_PCROSS; +"EXISTS_IN_UNION",EXISTS_IN_UNION; +"EXISTS_IN_UNIONS",EXISTS_IN_UNIONS; +"EXISTS_NOT_THM",EXISTS_NOT_THM; +"EXISTS_ONE_REP",EXISTS_ONE_REP; +"EXISTS_OR_THM",EXISTS_OR_THM; +"EXISTS_PAIRED_THM",EXISTS_PAIRED_THM; +"EXISTS_PAIR_THM",EXISTS_PAIR_THM; +"EXISTS_PASTECART",EXISTS_PASTECART; +"EXISTS_REFL",EXISTS_REFL; +"EXISTS_SIMP",EXISTS_SIMP; +"EXISTS_SUBSET_IMAGE",EXISTS_SUBSET_IMAGE; +"EXISTS_SUBSET_UNION",EXISTS_SUBSET_UNION; +"EXISTS_THM",EXISTS_THM; +"EXISTS_TRIPLED_THM",EXISTS_TRIPLED_THM; +"EXISTS_UNCURRY",EXISTS_UNCURRY; +"EXISTS_UNIQUE",EXISTS_UNIQUE; +"EXISTS_UNIQUE_ALT",EXISTS_UNIQUE_ALT; +"EXISTS_UNIQUE_DEF",EXISTS_UNIQUE_DEF; +"EXISTS_UNIQUE_REFL",EXISTS_UNIQUE_REFL; +"EXISTS_UNIQUE_THM",EXISTS_UNIQUE_THM; +"EXISTS_UNPAIR_THM",EXISTS_UNPAIR_THM; +"EXP",EXP; +"EXP_1",EXP_1; +"EXP_2",EXP_2; +"EXP_ADD",EXP_ADD; +"EXP_EQ_0",EXP_EQ_0; +"EXP_EQ_1",EXP_EQ_1; +"EXP_LT_0",EXP_LT_0; +"EXP_MONO_EQ",EXP_MONO_EQ; +"EXP_MONO_LE",EXP_MONO_LE; +"EXP_MONO_LE_IMP",EXP_MONO_LE_IMP; +"EXP_MONO_LT",EXP_MONO_LT; +"EXP_MONO_LT_IMP",EXP_MONO_LT_IMP; +"EXP_MULT",EXP_MULT; +"EXP_ONE",EXP_ONE; +"EXP_ZERO",EXP_ZERO; +"EXTENSION",EXTENSION; +"EX_IMP",EX_IMP; +"EX_MAP",EX_MAP; +"EX_MEM",EX_MEM; +"FACT",FACT; +"FACT_LE",FACT_LE; +"FACT_LT",FACT_LT; +"FACT_MONO",FACT_MONO; +"FACT_NZ",FACT_NZ; +"FCONS",FCONS; +"FCONS_UNDO",FCONS_UNDO; +"FILTER",FILTER; +"FILTER_APPEND",FILTER_APPEND; +"FILTER_MAP",FILTER_MAP; +"FINITE_BOOL",FINITE_BOOL; +"FINITE_CART",FINITE_CART; +"FINITE_CART_UNIV",FINITE_CART_UNIV; +"FINITE_CASES",FINITE_CASES; +"FINITE_CROSS",FINITE_CROSS; +"FINITE_DELETE",FINITE_DELETE; +"FINITE_DELETE_IMP",FINITE_DELETE_IMP; +"FINITE_DIFF",FINITE_DIFF; +"FINITE_EMPTY",FINITE_EMPTY; +"FINITE_FINITE_IMAGE",FINITE_FINITE_IMAGE; +"FINITE_FINITE_PREIMAGE",FINITE_FINITE_PREIMAGE; +"FINITE_FINITE_PREIMAGE_GENERAL",FINITE_FINITE_PREIMAGE_GENERAL; +"FINITE_FINITE_UNIONS",FINITE_FINITE_UNIONS; +"FINITE_FUNSPACE",FINITE_FUNSPACE; +"FINITE_FUNSPACE_UNIV",FINITE_FUNSPACE_UNIV; +"FINITE_HAS_SIZE",FINITE_HAS_SIZE; +"FINITE_IMAGE",FINITE_IMAGE; +"FINITE_IMAGE_EXPAND",FINITE_IMAGE_EXPAND; +"FINITE_IMAGE_IMAGE",FINITE_IMAGE_IMAGE; +"FINITE_IMAGE_INJ",FINITE_IMAGE_INJ; +"FINITE_IMAGE_INJ_EQ",FINITE_IMAGE_INJ_EQ; +"FINITE_IMAGE_INJ_GENERAL",FINITE_IMAGE_INJ_GENERAL; +"FINITE_INDEX_INJ",FINITE_INDEX_INJ; +"FINITE_INDEX_INRANGE",FINITE_INDEX_INRANGE; +"FINITE_INDEX_INRANGE_2",FINITE_INDEX_INRANGE_2; +"FINITE_INDEX_NUMBERS",FINITE_INDEX_NUMBERS; +"FINITE_INDEX_NUMSEG",FINITE_INDEX_NUMSEG; +"FINITE_INDEX_WORKS",FINITE_INDEX_WORKS; +"FINITE_INDUCT",FINITE_INDUCT; +"FINITE_INDUCT_DELETE",FINITE_INDUCT_DELETE; +"FINITE_INDUCT_STRONG",FINITE_INDUCT_STRONG; +"FINITE_INSERT",FINITE_INSERT; +"FINITE_INTER",FINITE_INTER; +"FINITE_INTSEG",FINITE_INTSEG; +"FINITE_NUMSEG",FINITE_NUMSEG; +"FINITE_NUMSEG_LE",FINITE_NUMSEG_LE; +"FINITE_NUMSEG_LT",FINITE_NUMSEG_LT; +"FINITE_PCROSS",FINITE_PCROSS; +"FINITE_PCROSS_EQ",FINITE_PCROSS_EQ; +"FINITE_POWERSET",FINITE_POWERSET; +"FINITE_PRODUCT",FINITE_PRODUCT; +"FINITE_PRODUCT_DEPENDENT",FINITE_PRODUCT_DEPENDENT; +"FINITE_REAL_INTERVAL",FINITE_REAL_INTERVAL; +"FINITE_RECURSION",FINITE_RECURSION; +"FINITE_RECURSION_DELETE",FINITE_RECURSION_DELETE; +"FINITE_RESTRICT",FINITE_RESTRICT; +"FINITE_RULES",FINITE_RULES; +"FINITE_SET_OF_LIST",FINITE_SET_OF_LIST; +"FINITE_SING",FINITE_SING; +"FINITE_SUBSET",FINITE_SUBSET; +"FINITE_SUBSET_IMAGE",FINITE_SUBSET_IMAGE; +"FINITE_SUBSET_IMAGE_IMP",FINITE_SUBSET_IMAGE_IMP; +"FINITE_SUM_IMAGE",FINITE_SUM_IMAGE; +"FINITE_SUPPORT",FINITE_SUPPORT; +"FINITE_SUPPORT_DELTA",FINITE_SUPPORT_DELTA; +"FINITE_TRANSITIVITY_CHAIN",FINITE_TRANSITIVITY_CHAIN; +"FINITE_UNION",FINITE_UNION; +"FINITE_UNIONS",FINITE_UNIONS; +"FINITE_UNION_IMP",FINITE_UNION_IMP; +"FINREC",FINREC; +"FINREC_1_LEMMA",FINREC_1_LEMMA; +"FINREC_EXISTS_LEMMA",FINREC_EXISTS_LEMMA; +"FINREC_FUN",FINREC_FUN; +"FINREC_FUN_LEMMA",FINREC_FUN_LEMMA; +"FINREC_SUC_LEMMA",FINREC_SUC_LEMMA; +"FINREC_UNIQUE_LEMMA",FINREC_UNIQUE_LEMMA; +"FNIL",FNIL; +"FORALL_ALL",FORALL_ALL; +"FORALL_AND_THM",FORALL_AND_THM; +"FORALL_BOOL_THM",FORALL_BOOL_THM; +"FORALL_CURRY",FORALL_CURRY; +"FORALL_DEF",FORALL_DEF; +"FORALL_FINITE_INDEX",FORALL_FINITE_INDEX; +"FORALL_FINITE_SUBSET_IMAGE",FORALL_FINITE_SUBSET_IMAGE; +"FORALL_IN_CLAUSES",FORALL_IN_CLAUSES; +"FORALL_IN_GSPEC",FORALL_IN_GSPEC; +"FORALL_IN_IMAGE",FORALL_IN_IMAGE; +"FORALL_IN_INSERT",FORALL_IN_INSERT; +"FORALL_IN_PCROSS",FORALL_IN_PCROSS; +"FORALL_IN_UNION",FORALL_IN_UNION; +"FORALL_IN_UNIONS",FORALL_IN_UNIONS; +"FORALL_NOT_THM",FORALL_NOT_THM; +"FORALL_PAIRED_THM",FORALL_PAIRED_THM; +"FORALL_PAIR_THM",FORALL_PAIR_THM; +"FORALL_PASTECART",FORALL_PASTECART; +"FORALL_SIMP",FORALL_SIMP; +"FORALL_SUBSET_IMAGE",FORALL_SUBSET_IMAGE; +"FORALL_SUBSET_UNION",FORALL_SUBSET_UNION; +"FORALL_TRIPLED_THM",FORALL_TRIPLED_THM; +"FORALL_UNCURRY",FORALL_UNCURRY; +"FORALL_UNPAIR_THM",FORALL_UNPAIR_THM; +"FORALL_UNWIND_THM1",FORALL_UNWIND_THM1; +"FORALL_UNWIND_THM2",FORALL_UNWIND_THM2; +"FST",FST; +"FSTCART_PASTECART",FSTCART_PASTECART; +"FST_DEF",FST_DEF; +"FUNCTION_FACTORS_LEFT",FUNCTION_FACTORS_LEFT; +"FUNCTION_FACTORS_LEFT_GEN",FUNCTION_FACTORS_LEFT_GEN; +"FUNCTION_FACTORS_RIGHT",FUNCTION_FACTORS_RIGHT; +"FUNCTION_FACTORS_RIGHT_GEN",FUNCTION_FACTORS_RIGHT_GEN; +"FUN_EQ_THM",FUN_EQ_THM; +"FUN_IN_IMAGE",FUN_IN_IMAGE; +"F_DEF",F_DEF; +"GABS_DEF",GABS_DEF; +"GE",GE; +"GEQ_DEF",GEQ_DEF; +"GE_C",GE_C; +"GSPEC",GSPEC; +"GT",GT; +"HAS_SIZE",HAS_SIZE; +"HAS_SIZE_0",HAS_SIZE_0; +"HAS_SIZE_1",HAS_SIZE_1; +"HAS_SIZE_2",HAS_SIZE_2; +"HAS_SIZE_3",HAS_SIZE_3; +"HAS_SIZE_4",HAS_SIZE_4; +"HAS_SIZE_BOOL",HAS_SIZE_BOOL; +"HAS_SIZE_CARD",HAS_SIZE_CARD; +"HAS_SIZE_CART_UNIV",HAS_SIZE_CART_UNIV; +"HAS_SIZE_CLAUSES",HAS_SIZE_CLAUSES; +"HAS_SIZE_CROSS",HAS_SIZE_CROSS; +"HAS_SIZE_DIFF",HAS_SIZE_DIFF; +"HAS_SIZE_FINITE_IMAGE",HAS_SIZE_FINITE_IMAGE; +"HAS_SIZE_FUNSPACE",HAS_SIZE_FUNSPACE; +"HAS_SIZE_FUNSPACE_UNIV",HAS_SIZE_FUNSPACE_UNIV; +"HAS_SIZE_IMAGE_INJ",HAS_SIZE_IMAGE_INJ; +"HAS_SIZE_IMAGE_INJ_EQ",HAS_SIZE_IMAGE_INJ_EQ; +"HAS_SIZE_INDEX",HAS_SIZE_INDEX; +"HAS_SIZE_NUMSEG",HAS_SIZE_NUMSEG; +"HAS_SIZE_NUMSEG_1",HAS_SIZE_NUMSEG_1; +"HAS_SIZE_NUMSEG_LE",HAS_SIZE_NUMSEG_LE; +"HAS_SIZE_NUMSEG_LT",HAS_SIZE_NUMSEG_LT; +"HAS_SIZE_PCROSS",HAS_SIZE_PCROSS; +"HAS_SIZE_POWERSET",HAS_SIZE_POWERSET; +"HAS_SIZE_PRODUCT",HAS_SIZE_PRODUCT; +"HAS_SIZE_PRODUCT_DEPENDENT",HAS_SIZE_PRODUCT_DEPENDENT; +"HAS_SIZE_SET_OF_LIST",HAS_SIZE_SET_OF_LIST; +"HAS_SIZE_SUC",HAS_SIZE_SUC; +"HAS_SIZE_UNION",HAS_SIZE_UNION; +"HAS_SIZE_UNIONS",HAS_SIZE_UNIONS; +"HD",HD; +"HD_APPEND",HD_APPEND; +"HREAL_ADD_AC",HREAL_ADD_AC; +"HREAL_ADD_ASSOC",HREAL_ADD_ASSOC; +"HREAL_ADD_LCANCEL",HREAL_ADD_LCANCEL; +"HREAL_ADD_LDISTRIB",HREAL_ADD_LDISTRIB; +"HREAL_ADD_LID",HREAL_ADD_LID; +"HREAL_ADD_RDISTRIB",HREAL_ADD_RDISTRIB; +"HREAL_ADD_RID",HREAL_ADD_RID; +"HREAL_ADD_SYM",HREAL_ADD_SYM; +"HREAL_ARCH",HREAL_ARCH; +"HREAL_COMPLETE",HREAL_COMPLETE; +"HREAL_EQ_ADD_LCANCEL",HREAL_EQ_ADD_LCANCEL; +"HREAL_EQ_ADD_RCANCEL",HREAL_EQ_ADD_RCANCEL; +"HREAL_INV_0",HREAL_INV_0; +"HREAL_LE_ADD",HREAL_LE_ADD; +"HREAL_LE_ADD2",HREAL_LE_ADD2; +"HREAL_LE_ADD_LCANCEL",HREAL_LE_ADD_LCANCEL; +"HREAL_LE_ADD_RCANCEL",HREAL_LE_ADD_RCANCEL; +"HREAL_LE_ANTISYM",HREAL_LE_ANTISYM; +"HREAL_LE_EXISTS",HREAL_LE_EXISTS; +"HREAL_LE_EXISTS_DEF",HREAL_LE_EXISTS_DEF; +"HREAL_LE_MUL_RCANCEL_IMP",HREAL_LE_MUL_RCANCEL_IMP; +"HREAL_LE_REFL",HREAL_LE_REFL; +"HREAL_LE_TOTAL",HREAL_LE_TOTAL; +"HREAL_LE_TRANS",HREAL_LE_TRANS; +"HREAL_MUL_ASSOC",HREAL_MUL_ASSOC; +"HREAL_MUL_LID",HREAL_MUL_LID; +"HREAL_MUL_LINV",HREAL_MUL_LINV; +"HREAL_MUL_LZERO",HREAL_MUL_LZERO; +"HREAL_MUL_RZERO",HREAL_MUL_RZERO; +"HREAL_MUL_SYM",HREAL_MUL_SYM; +"HREAL_OF_NUM_ADD",HREAL_OF_NUM_ADD; +"HREAL_OF_NUM_EQ",HREAL_OF_NUM_EQ; +"HREAL_OF_NUM_LE",HREAL_OF_NUM_LE; +"HREAL_OF_NUM_MUL",HREAL_OF_NUM_MUL; +"IMAGE",IMAGE; +"IMAGE_CLAUSES",IMAGE_CLAUSES; +"IMAGE_CONST",IMAGE_CONST; +"IMAGE_DELETE_INJ",IMAGE_DELETE_INJ; +"IMAGE_DIFF_INJ",IMAGE_DIFF_INJ; +"IMAGE_EQ_EMPTY",IMAGE_EQ_EMPTY; +"IMAGE_FSTCART_PCROSS",IMAGE_FSTCART_PCROSS; +"IMAGE_I",IMAGE_I; +"IMAGE_ID",IMAGE_ID; +"IMAGE_IMP_INJECTIVE",IMAGE_IMP_INJECTIVE; +"IMAGE_IMP_INJECTIVE_GEN",IMAGE_IMP_INJECTIVE_GEN; +"IMAGE_INJECTIVE_IMAGE_OF_SUBSET",IMAGE_INJECTIVE_IMAGE_OF_SUBSET; +"IMAGE_INTER_INJ",IMAGE_INTER_INJ; +"IMAGE_SNDCART_PCROSS",IMAGE_SNDCART_PCROSS; +"IMAGE_SUBSET",IMAGE_SUBSET; +"IMAGE_UNION",IMAGE_UNION; +"IMAGE_UNIONS",IMAGE_UNIONS; +"IMAGE_o",IMAGE_o; +"IMP_CLAUSES",IMP_CLAUSES; +"IMP_CONJ",IMP_CONJ; +"IMP_CONJ_ALT",IMP_CONJ_ALT; +"IMP_DEF",IMP_DEF; +"IMP_IMP",IMP_IMP; +"IN",IN; +"IND_SUC_0",IND_SUC_0; +"IND_SUC_0_EXISTS",IND_SUC_0_EXISTS; +"IND_SUC_INJ",IND_SUC_INJ; +"IND_SUC_SPEC",IND_SUC_SPEC; +"INF",INF; +"INFINITE",INFINITE; +"INFINITE_DIFF_FINITE",INFINITE_DIFF_FINITE; +"INFINITE_ENUMERATE",INFINITE_ENUMERATE; +"INFINITE_IMAGE_INJ",INFINITE_IMAGE_INJ; +"INFINITE_NONEMPTY",INFINITE_NONEMPTY; +"INFINITE_SUPERSET",INFINITE_SUPERSET; +"INFINITY_AX",INFINITY_AX; +"INF_EQ",INF_EQ; +"INF_FINITE",INF_FINITE; +"INF_FINITE_LEMMA",INF_FINITE_LEMMA; +"INF_INSERT_FINITE",INF_INSERT_FINITE; +"INF_SING",INF_SING; +"INF_UNION",INF_UNION; +"INF_UNIQUE",INF_UNIQUE; +"INF_UNIQUE_FINITE",INF_UNIQUE_FINITE; +"INJ",INJ; +"INJA",INJA; +"INJA_INJ",INJA_INJ; +"INJECTIVE_ALT",INJECTIVE_ALT; +"INJECTIVE_IMAGE",INJECTIVE_IMAGE; +"INJECTIVE_LEFT_INVERSE",INJECTIVE_LEFT_INVERSE; +"INJECTIVE_MAP",INJECTIVE_MAP; +"INJECTIVE_ON_ALT",INJECTIVE_ON_ALT; +"INJECTIVE_ON_IMAGE",INJECTIVE_ON_IMAGE; +"INJECTIVE_ON_LEFT_INVERSE",INJECTIVE_ON_LEFT_INVERSE; +"INJF",INJF; +"INJF_INJ",INJF_INJ; +"INJN",INJN; +"INJN_INJ",INJN_INJ; +"INJP",INJP; +"INJP_INJ",INJP_INJ; +"INJ_INVERSE2",INJ_INVERSE2; +"INSERT",INSERT; +"INSERT_AC",INSERT_AC; +"INSERT_COMM",INSERT_COMM; +"INSERT_DEF",INSERT_DEF; +"INSERT_DELETE",INSERT_DELETE; +"INSERT_DIFF",INSERT_DIFF; +"INSERT_INSERT",INSERT_INSERT; +"INSERT_INTER",INSERT_INTER; +"INSERT_SUBSET",INSERT_SUBSET; +"INSERT_UNION",INSERT_UNION; +"INSERT_UNION_EQ",INSERT_UNION_EQ; +"INSERT_UNIV",INSERT_UNIV; +"INTER",INTER; +"INTERS",INTERS; +"INTERS_0",INTERS_0; +"INTERS_1",INTERS_1; +"INTERS_2",INTERS_2; +"INTERS_GSPEC",INTERS_GSPEC; +"INTERS_IMAGE",INTERS_IMAGE; +"INTERS_INSERT",INTERS_INSERT; +"INTERS_OVER_UNIONS",INTERS_OVER_UNIONS; +"INTERS_UNION",INTERS_UNION; +"INTERS_UNIONS",INTERS_UNIONS; +"INTER_ACI",INTER_ACI; +"INTER_ASSOC",INTER_ASSOC; +"INTER_COMM",INTER_COMM; +"INTER_EMPTY",INTER_EMPTY; +"INTER_IDEMPOT",INTER_IDEMPOT; +"INTER_OVER_UNION",INTER_OVER_UNION; +"INTER_PCROSS",INTER_PCROSS; +"INTER_SUBSET",INTER_SUBSET; +"INTER_UNIONS",INTER_UNIONS; +"INTER_UNIV",INTER_UNIV; +"INT_ABS",INT_ABS; +"INT_ABS_0",INT_ABS_0; +"INT_ABS_1",INT_ABS_1; +"INT_ABS_ABS",INT_ABS_ABS; +"INT_ABS_BETWEEN",INT_ABS_BETWEEN; +"INT_ABS_BETWEEN1",INT_ABS_BETWEEN1; +"INT_ABS_BETWEEN2",INT_ABS_BETWEEN2; +"INT_ABS_BOUND",INT_ABS_BOUND; +"INT_ABS_CASES",INT_ABS_CASES; +"INT_ABS_CIRCLE",INT_ABS_CIRCLE; +"INT_ABS_LE",INT_ABS_LE; +"INT_ABS_MUL",INT_ABS_MUL; +"INT_ABS_MUL_1",INT_ABS_MUL_1; +"INT_ABS_NEG",INT_ABS_NEG; +"INT_ABS_NUM",INT_ABS_NUM; +"INT_ABS_NZ",INT_ABS_NZ; +"INT_ABS_POS",INT_ABS_POS; +"INT_ABS_POW",INT_ABS_POW; +"INT_ABS_REFL",INT_ABS_REFL; +"INT_ABS_SGN",INT_ABS_SGN; +"INT_ABS_SIGN",INT_ABS_SIGN; +"INT_ABS_SIGN2",INT_ABS_SIGN2; +"INT_ABS_STILLNZ",INT_ABS_STILLNZ; +"INT_ABS_SUB",INT_ABS_SUB; +"INT_ABS_SUB_ABS",INT_ABS_SUB_ABS; +"INT_ABS_TRIANGLE",INT_ABS_TRIANGLE; +"INT_ABS_ZERO",INT_ABS_ZERO; +"INT_ADD2_SUB2",INT_ADD2_SUB2; +"INT_ADD_AC",INT_ADD_AC; +"INT_ADD_ASSOC",INT_ADD_ASSOC; +"INT_ADD_LDISTRIB",INT_ADD_LDISTRIB; +"INT_ADD_LID",INT_ADD_LID; +"INT_ADD_LINV",INT_ADD_LINV; +"INT_ADD_RDISTRIB",INT_ADD_RDISTRIB; +"INT_ADD_RID",INT_ADD_RID; +"INT_ADD_RINV",INT_ADD_RINV; +"INT_ADD_SUB",INT_ADD_SUB; +"INT_ADD_SUB2",INT_ADD_SUB2; +"INT_ADD_SYM",INT_ADD_SYM; +"INT_ARCH",INT_ARCH; +"INT_BOUNDS_LE",INT_BOUNDS_LE; +"INT_BOUNDS_LT",INT_BOUNDS_LT; +"INT_DIFFSQ",INT_DIFFSQ; +"INT_DIVISION",INT_DIVISION; +"INT_DIVISION_0",INT_DIVISION_0; +"INT_DIVMOD_EXIST_0",INT_DIVMOD_EXIST_0; +"INT_DIVMOD_UNIQ",INT_DIVMOD_UNIQ; +"INT_ENTIRE",INT_ENTIRE; +"INT_EQ_ADD_LCANCEL",INT_EQ_ADD_LCANCEL; +"INT_EQ_ADD_LCANCEL_0",INT_EQ_ADD_LCANCEL_0; +"INT_EQ_ADD_RCANCEL",INT_EQ_ADD_RCANCEL; +"INT_EQ_ADD_RCANCEL_0",INT_EQ_ADD_RCANCEL_0; +"INT_EQ_IMP_LE",INT_EQ_IMP_LE; +"INT_EQ_MUL_LCANCEL",INT_EQ_MUL_LCANCEL; +"INT_EQ_MUL_RCANCEL",INT_EQ_MUL_RCANCEL; +"INT_EQ_NEG2",INT_EQ_NEG2; +"INT_EQ_SGN_ABS",INT_EQ_SGN_ABS; +"INT_EQ_SQUARE_ABS",INT_EQ_SQUARE_ABS; +"INT_EQ_SUB_LADD",INT_EQ_SUB_LADD; +"INT_EQ_SUB_RADD",INT_EQ_SUB_RADD; +"INT_EXISTS_ABS",INT_EXISTS_ABS; +"INT_EXISTS_POS",INT_EXISTS_POS; +"INT_FORALL_ABS",INT_FORALL_ABS; +"INT_FORALL_POS",INT_FORALL_POS; +"INT_GCD_EXISTS",INT_GCD_EXISTS; +"INT_GCD_EXISTS_POS",INT_GCD_EXISTS_POS; +"INT_GE",INT_GE; +"INT_GT",INT_GT; +"INT_GT_DISCRETE",INT_GT_DISCRETE; +"INT_IMAGE",INT_IMAGE; +"INT_LET_ADD",INT_LET_ADD; +"INT_LET_ADD2",INT_LET_ADD2; +"INT_LET_ANTISYM",INT_LET_ANTISYM; +"INT_LET_TOTAL",INT_LET_TOTAL; +"INT_LET_TRANS",INT_LET_TRANS; +"INT_LE_01",INT_LE_01; +"INT_LE_ADD",INT_LE_ADD; +"INT_LE_ADD2",INT_LE_ADD2; +"INT_LE_ADDL",INT_LE_ADDL; +"INT_LE_ADDR",INT_LE_ADDR; +"INT_LE_ANTISYM",INT_LE_ANTISYM; +"INT_LE_DISCRETE",INT_LE_DISCRETE; +"INT_LE_DOUBLE",INT_LE_DOUBLE; +"INT_LE_LADD",INT_LE_LADD; +"INT_LE_LADD_IMP",INT_LE_LADD_IMP; +"INT_LE_LMUL",INT_LE_LMUL; +"INT_LE_LNEG",INT_LE_LNEG; +"INT_LE_LT",INT_LE_LT; +"INT_LE_MAX",INT_LE_MAX; +"INT_LE_MIN",INT_LE_MIN; +"INT_LE_MUL",INT_LE_MUL; +"INT_LE_MUL_EQ",INT_LE_MUL_EQ; +"INT_LE_NEG",INT_LE_NEG; +"INT_LE_NEG2",INT_LE_NEG2; +"INT_LE_NEGL",INT_LE_NEGL; +"INT_LE_NEGR",INT_LE_NEGR; +"INT_LE_NEGTOTAL",INT_LE_NEGTOTAL; +"INT_LE_POW2",INT_LE_POW2; +"INT_LE_RADD",INT_LE_RADD; +"INT_LE_REFL",INT_LE_REFL; +"INT_LE_RMUL",INT_LE_RMUL; +"INT_LE_RNEG",INT_LE_RNEG; +"INT_LE_SQUARE",INT_LE_SQUARE; +"INT_LE_SQUARE_ABS",INT_LE_SQUARE_ABS; +"INT_LE_SUB_LADD",INT_LE_SUB_LADD; +"INT_LE_SUB_RADD",INT_LE_SUB_RADD; +"INT_LE_TOTAL",INT_LE_TOTAL; +"INT_LE_TRANS",INT_LE_TRANS; +"INT_LNEG_UNIQ",INT_LNEG_UNIQ; +"INT_LT",INT_LT; +"INT_LTE_ADD",INT_LTE_ADD; +"INT_LTE_ADD2",INT_LTE_ADD2; +"INT_LTE_ANTISYM",INT_LTE_ANTISYM; +"INT_LTE_TOTAL",INT_LTE_TOTAL; +"INT_LTE_TRANS",INT_LTE_TRANS; +"INT_LT_01",INT_LT_01; +"INT_LT_ADD",INT_LT_ADD; +"INT_LT_ADD1",INT_LT_ADD1; +"INT_LT_ADD2",INT_LT_ADD2; +"INT_LT_ADDL",INT_LT_ADDL; +"INT_LT_ADDNEG",INT_LT_ADDNEG; +"INT_LT_ADDNEG2",INT_LT_ADDNEG2; +"INT_LT_ADDR",INT_LT_ADDR; +"INT_LT_ADD_SUB",INT_LT_ADD_SUB; +"INT_LT_ANTISYM",INT_LT_ANTISYM; +"INT_LT_DISCRETE",INT_LT_DISCRETE; +"INT_LT_GT",INT_LT_GT; +"INT_LT_IMP_LE",INT_LT_IMP_LE; +"INT_LT_IMP_NE",INT_LT_IMP_NE; +"INT_LT_LADD",INT_LT_LADD; +"INT_LT_LE",INT_LT_LE; +"INT_LT_LMUL_EQ",INT_LT_LMUL_EQ; +"INT_LT_MAX",INT_LT_MAX; +"INT_LT_MIN",INT_LT_MIN; +"INT_LT_MUL",INT_LT_MUL; +"INT_LT_MUL_EQ",INT_LT_MUL_EQ; +"INT_LT_NEG",INT_LT_NEG; +"INT_LT_NEG2",INT_LT_NEG2; +"INT_LT_NEGTOTAL",INT_LT_NEGTOTAL; +"INT_LT_POW2",INT_LT_POW2; +"INT_LT_RADD",INT_LT_RADD; +"INT_LT_REFL",INT_LT_REFL; +"INT_LT_RMUL_EQ",INT_LT_RMUL_EQ; +"INT_LT_SQUARE_ABS",INT_LT_SQUARE_ABS; +"INT_LT_SUB_LADD",INT_LT_SUB_LADD; +"INT_LT_SUB_RADD",INT_LT_SUB_RADD; +"INT_LT_TOTAL",INT_LT_TOTAL; +"INT_LT_TRANS",INT_LT_TRANS; +"INT_MAX",INT_MAX; +"INT_MAX_ACI",INT_MAX_ACI; +"INT_MAX_ASSOC",INT_MAX_ASSOC; +"INT_MAX_LE",INT_MAX_LE; +"INT_MAX_LT",INT_MAX_LT; +"INT_MAX_MAX",INT_MAX_MAX; +"INT_MAX_MIN",INT_MAX_MIN; +"INT_MAX_SYM",INT_MAX_SYM; +"INT_MIN",INT_MIN; +"INT_MIN_ACI",INT_MIN_ACI; +"INT_MIN_ASSOC",INT_MIN_ASSOC; +"INT_MIN_LE",INT_MIN_LE; +"INT_MIN_LT",INT_MIN_LT; +"INT_MIN_MAX",INT_MIN_MAX; +"INT_MIN_MIN",INT_MIN_MIN; +"INT_MIN_SYM",INT_MIN_SYM; +"INT_MUL_AC",INT_MUL_AC; +"INT_MUL_ASSOC",INT_MUL_ASSOC; +"INT_MUL_LID",INT_MUL_LID; +"INT_MUL_LNEG",INT_MUL_LNEG; +"INT_MUL_LZERO",INT_MUL_LZERO; +"INT_MUL_POS_LE",INT_MUL_POS_LE; +"INT_MUL_POS_LT",INT_MUL_POS_LT; +"INT_MUL_RID",INT_MUL_RID; +"INT_MUL_RNEG",INT_MUL_RNEG; +"INT_MUL_RZERO",INT_MUL_RZERO; +"INT_MUL_SYM",INT_MUL_SYM; +"INT_NEGNEG",INT_NEGNEG; +"INT_NEG_0",INT_NEG_0; +"INT_NEG_ADD",INT_NEG_ADD; +"INT_NEG_EQ",INT_NEG_EQ; +"INT_NEG_EQ_0",INT_NEG_EQ_0; +"INT_NEG_GE0",INT_NEG_GE0; +"INT_NEG_GT0",INT_NEG_GT0; +"INT_NEG_LE0",INT_NEG_LE0; +"INT_NEG_LMUL",INT_NEG_LMUL; +"INT_NEG_LT0",INT_NEG_LT0; +"INT_NEG_MINUS1",INT_NEG_MINUS1; +"INT_NEG_MUL2",INT_NEG_MUL2; +"INT_NEG_NEG",INT_NEG_NEG; +"INT_NEG_RMUL",INT_NEG_RMUL; +"INT_NEG_SUB",INT_NEG_SUB; +"INT_NOT_EQ",INT_NOT_EQ; +"INT_NOT_LE",INT_NOT_LE; +"INT_NOT_LT",INT_NOT_LT; +"INT_OF_NUM_ADD",INT_OF_NUM_ADD; +"INT_OF_NUM_EQ",INT_OF_NUM_EQ; +"INT_OF_NUM_EXISTS",INT_OF_NUM_EXISTS; +"INT_OF_NUM_GE",INT_OF_NUM_GE; +"INT_OF_NUM_GT",INT_OF_NUM_GT; +"INT_OF_NUM_LE",INT_OF_NUM_LE; +"INT_OF_NUM_LT",INT_OF_NUM_LT; +"INT_OF_NUM_MAX",INT_OF_NUM_MAX; +"INT_OF_NUM_MIN",INT_OF_NUM_MIN; +"INT_OF_NUM_MUL",INT_OF_NUM_MUL; +"INT_OF_NUM_OF_INT",INT_OF_NUM_OF_INT; +"INT_OF_NUM_POW",INT_OF_NUM_POW; +"INT_OF_NUM_SUB",INT_OF_NUM_SUB; +"INT_OF_NUM_SUC",INT_OF_NUM_SUC; +"INT_POS",INT_POS; +"INT_POS_NZ",INT_POS_NZ; +"INT_POW",INT_POW; +"INT_POW2_ABS",INT_POW2_ABS; +"INT_POW_1",INT_POW_1; +"INT_POW_1_LE",INT_POW_1_LE; +"INT_POW_1_LT",INT_POW_1_LT; +"INT_POW_2",INT_POW_2; +"INT_POW_ADD",INT_POW_ADD; +"INT_POW_EQ",INT_POW_EQ; +"INT_POW_EQ_0",INT_POW_EQ_0; +"INT_POW_EQ_ABS",INT_POW_EQ_ABS; +"INT_POW_LE",INT_POW_LE; +"INT_POW_LE2",INT_POW_LE2; +"INT_POW_LE2_ODD",INT_POW_LE2_ODD; +"INT_POW_LE2_REV",INT_POW_LE2_REV; +"INT_POW_LE_1",INT_POW_LE_1; +"INT_POW_LT",INT_POW_LT; +"INT_POW_LT2",INT_POW_LT2; +"INT_POW_LT2_REV",INT_POW_LT2_REV; +"INT_POW_LT_1",INT_POW_LT_1; +"INT_POW_MONO",INT_POW_MONO; +"INT_POW_MONO_LT",INT_POW_MONO_LT; +"INT_POW_MUL",INT_POW_MUL; +"INT_POW_NEG",INT_POW_NEG; +"INT_POW_NZ",INT_POW_NZ; +"INT_POW_ONE",INT_POW_ONE; +"INT_POW_POW",INT_POW_POW; +"INT_POW_ZERO",INT_POW_ZERO; +"INT_RNEG_UNIQ",INT_RNEG_UNIQ; +"INT_SGN",INT_SGN; +"INT_SGN_0",INT_SGN_0; +"INT_SGN_ABS",INT_SGN_ABS; +"INT_SGN_CASES",INT_SGN_CASES; +"INT_SGN_EQ",INT_SGN_EQ; +"INT_SGN_INEQS",INT_SGN_INEQS; +"INT_SGN_INT_SGN",INT_SGN_INT_SGN; +"INT_SGN_MUL",INT_SGN_MUL; +"INT_SGN_NEG",INT_SGN_NEG; +"INT_SGN_POW",INT_SGN_POW; +"INT_SGN_POW_2",INT_SGN_POW_2; +"INT_SOS_EQ_0",INT_SOS_EQ_0; +"INT_SUB",INT_SUB; +"INT_SUB_0",INT_SUB_0; +"INT_SUB_ABS",INT_SUB_ABS; +"INT_SUB_ADD",INT_SUB_ADD; +"INT_SUB_ADD2",INT_SUB_ADD2; +"INT_SUB_LDISTRIB",INT_SUB_LDISTRIB; +"INT_SUB_LE",INT_SUB_LE; +"INT_SUB_LNEG",INT_SUB_LNEG; +"INT_SUB_LT",INT_SUB_LT; +"INT_SUB_LZERO",INT_SUB_LZERO; +"INT_SUB_NEG2",INT_SUB_NEG2; +"INT_SUB_RDISTRIB",INT_SUB_RDISTRIB; +"INT_SUB_REFL",INT_SUB_REFL; +"INT_SUB_RNEG",INT_SUB_RNEG; +"INT_SUB_RZERO",INT_SUB_RZERO; +"INT_SUB_SUB",INT_SUB_SUB; +"INT_SUB_SUB2",INT_SUB_SUB2; +"INT_SUB_TRIANGLE",INT_SUB_TRIANGLE; +"INT_WOP",INT_WOP; +"IN_CROSS",IN_CROSS; +"IN_DELETE",IN_DELETE; +"IN_DELETE_EQ",IN_DELETE_EQ; +"IN_DIFF",IN_DIFF; +"IN_DISJOINT",IN_DISJOINT; +"IN_ELIM_PAIR_THM",IN_ELIM_PAIR_THM; +"IN_ELIM_PASTECART_THM",IN_ELIM_PASTECART_THM; +"IN_ELIM_THM",IN_ELIM_THM; +"IN_IMAGE",IN_IMAGE; +"IN_INSERT",IN_INSERT; +"IN_INTER",IN_INTER; +"IN_INTERS",IN_INTERS; +"IN_NUMSEG",IN_NUMSEG; +"IN_NUMSEG_0",IN_NUMSEG_0; +"IN_REST",IN_REST; +"IN_SET_OF_LIST",IN_SET_OF_LIST; +"IN_SING",IN_SING; +"IN_SUPPORT",IN_SUPPORT; +"IN_UNION",IN_UNION; +"IN_UNIONS",IN_UNIONS; +"IN_UNIV",IN_UNIV; +"ISO",ISO; +"ISO_FUN",ISO_FUN; +"ISO_REFL",ISO_REFL; +"ISO_USAGE",ISO_USAGE; +"ITERATE_BIJECTION",ITERATE_BIJECTION; +"ITERATE_CASES",ITERATE_CASES; +"ITERATE_CLAUSES",ITERATE_CLAUSES; +"ITERATE_CLAUSES_GEN",ITERATE_CLAUSES_GEN; +"ITERATE_CLAUSES_NUMSEG",ITERATE_CLAUSES_NUMSEG; +"ITERATE_CLOSED",ITERATE_CLOSED; +"ITERATE_DELETE",ITERATE_DELETE; +"ITERATE_DELTA",ITERATE_DELTA; +"ITERATE_DIFF",ITERATE_DIFF; +"ITERATE_DIFF_GEN",ITERATE_DIFF_GEN; +"ITERATE_EQ",ITERATE_EQ; +"ITERATE_EQ_GENERAL",ITERATE_EQ_GENERAL; +"ITERATE_EQ_GENERAL_INVERSES",ITERATE_EQ_GENERAL_INVERSES; +"ITERATE_EQ_NEUTRAL",ITERATE_EQ_NEUTRAL; +"ITERATE_EXPAND_CASES",ITERATE_EXPAND_CASES; +"ITERATE_IMAGE",ITERATE_IMAGE; +"ITERATE_IMAGE_NONZERO",ITERATE_IMAGE_NONZERO; +"ITERATE_INCL_EXCL",ITERATE_INCL_EXCL; +"ITERATE_INJECTION",ITERATE_INJECTION; +"ITERATE_ITERATE_PRODUCT",ITERATE_ITERATE_PRODUCT; +"ITERATE_OP",ITERATE_OP; +"ITERATE_OP_GEN",ITERATE_OP_GEN; +"ITERATE_PAIR",ITERATE_PAIR; +"ITERATE_RELATED",ITERATE_RELATED; +"ITERATE_SING",ITERATE_SING; +"ITERATE_SUPERSET",ITERATE_SUPERSET; +"ITERATE_SUPPORT",ITERATE_SUPPORT; +"ITERATE_UNION",ITERATE_UNION; +"ITERATE_UNION_GEN",ITERATE_UNION_GEN; +"ITERATE_UNION_NONZERO",ITERATE_UNION_NONZERO; +"ITLIST",ITLIST; +"ITLIST2",ITLIST2; +"ITLIST2_DEF",ITLIST2_DEF; +"ITLIST_APPEND",ITLIST_APPEND; +"ITLIST_EXTRA",ITLIST_EXTRA; +"ITSET",ITSET; +"ITSET_EQ",ITSET_EQ; +"I_DEF",I_DEF; +"I_O_ID",I_O_ID; +"I_THM",I_THM; +"LAMBDA_BETA",LAMBDA_BETA; +"LAMBDA_ETA",LAMBDA_ETA; +"LAMBDA_PAIR_THM",LAMBDA_PAIR_THM; +"LAMBDA_UNIQUE",LAMBDA_UNIQUE; +"LAST",LAST; +"LAST_APPEND",LAST_APPEND; +"LAST_CLAUSES",LAST_CLAUSES; +"LAST_EL",LAST_EL; +"LE",LE; +"LEFT_ADD_DISTRIB",LEFT_ADD_DISTRIB; +"LEFT_AND_EXISTS_THM",LEFT_AND_EXISTS_THM; +"LEFT_AND_FORALL_THM",LEFT_AND_FORALL_THM; +"LEFT_EXISTS_AND_THM",LEFT_EXISTS_AND_THM; +"LEFT_EXISTS_IMP_THM",LEFT_EXISTS_IMP_THM; +"LEFT_FORALL_IMP_THM",LEFT_FORALL_IMP_THM; +"LEFT_FORALL_OR_THM",LEFT_FORALL_OR_THM; +"LEFT_IMP_EXISTS_THM",LEFT_IMP_EXISTS_THM; +"LEFT_IMP_FORALL_THM",LEFT_IMP_FORALL_THM; +"LEFT_OR_DISTRIB",LEFT_OR_DISTRIB; +"LEFT_OR_EXISTS_THM",LEFT_OR_EXISTS_THM; +"LEFT_OR_FORALL_THM",LEFT_OR_FORALL_THM; +"LEFT_SUB_DISTRIB",LEFT_SUB_DISTRIB; +"LENGTH",LENGTH; +"LENGTH_APPEND",LENGTH_APPEND; +"LENGTH_EQ_CONS",LENGTH_EQ_CONS; +"LENGTH_EQ_NIL",LENGTH_EQ_NIL; +"LENGTH_LIST_OF_SET",LENGTH_LIST_OF_SET; +"LENGTH_MAP",LENGTH_MAP; +"LENGTH_MAP2",LENGTH_MAP2; +"LENGTH_REPLICATE",LENGTH_REPLICATE; +"LENGTH_TL",LENGTH_TL; +"LET_ADD2",LET_ADD2; +"LET_ANTISYM",LET_ANTISYM; +"LET_CASES",LET_CASES; +"LET_DEF",LET_DEF; +"LET_END_DEF",LET_END_DEF; +"LET_TRANS",LET_TRANS; +"LE_0",LE_0; +"LE_1",LE_1; +"LE_ADD",LE_ADD; +"LE_ADD2",LE_ADD2; +"LE_ADDR",LE_ADDR; +"LE_ADD_LCANCEL",LE_ADD_LCANCEL; +"LE_ADD_RCANCEL",LE_ADD_RCANCEL; +"LE_ANTISYM",LE_ANTISYM; +"LE_C",LE_C; +"LE_CASES",LE_CASES; +"LE_EXISTS",LE_EXISTS; +"LE_EXP",LE_EXP; +"LE_LDIV",LE_LDIV; +"LE_LDIV_EQ",LE_LDIV_EQ; +"LE_LT",LE_LT; +"LE_MULT2",LE_MULT2; +"LE_MULT_LCANCEL",LE_MULT_LCANCEL; +"LE_MULT_RCANCEL",LE_MULT_RCANCEL; +"LE_RDIV_EQ",LE_RDIV_EQ; +"LE_REFL",LE_REFL; +"LE_SQUARE_REFL",LE_SQUARE_REFL; +"LE_SUC",LE_SUC; +"LE_SUC_LT",LE_SUC_LT; +"LE_TRANS",LE_TRANS; +"LIST_OF_SET_EMPTY",LIST_OF_SET_EMPTY; +"LIST_OF_SET_PROPERTIES",LIST_OF_SET_PROPERTIES; +"LIST_OF_SET_SING",LIST_OF_SET_SING; +"LT",LT; +"LTE_ADD2",LTE_ADD2; +"LTE_ANTISYM",LTE_ANTISYM; +"LTE_CASES",LTE_CASES; +"LTE_TRANS",LTE_TRANS; +"LT_0",LT_0; +"LT_ADD",LT_ADD; +"LT_ADD2",LT_ADD2; +"LT_ADDR",LT_ADDR; +"LT_ADD_LCANCEL",LT_ADD_LCANCEL; +"LT_ADD_RCANCEL",LT_ADD_RCANCEL; +"LT_ANTISYM",LT_ANTISYM; +"LT_CASES",LT_CASES; +"LT_EXISTS",LT_EXISTS; +"LT_EXP",LT_EXP; +"LT_IMP_LE",LT_IMP_LE; +"LT_LE",LT_LE; +"LT_LMULT",LT_LMULT; +"LT_MULT",LT_MULT; +"LT_MULT2",LT_MULT2; +"LT_MULT_LCANCEL",LT_MULT_LCANCEL; +"LT_MULT_RCANCEL",LT_MULT_RCANCEL; +"LT_NZ",LT_NZ; +"LT_POW2_REFL",LT_POW2_REFL; +"LT_REFL",LT_REFL; +"LT_SUC",LT_SUC; +"LT_SUC_LE",LT_SUC_LE; +"LT_TRANS",LT_TRANS; +"MAP",MAP; +"MAP2",MAP2; +"MAP2_DEF",MAP2_DEF; +"MAP_APPEND",MAP_APPEND; +"MAP_EQ",MAP_EQ; +"MAP_EQ_ALL2",MAP_EQ_ALL2; +"MAP_EQ_DEGEN",MAP_EQ_DEGEN; +"MAP_EQ_NIL",MAP_EQ_NIL; +"MAP_FST_ZIP",MAP_FST_ZIP; +"MAP_I",MAP_I; +"MAP_ID",MAP_ID; +"MAP_REVERSE",MAP_REVERSE; +"MAP_SND_ZIP",MAP_SND_ZIP; +"MAP_o",MAP_o; +"MATCH_SEQPATTERN",MATCH_SEQPATTERN; +"MAX",MAX; +"MEASURE",MEASURE; +"MEASURE_LE",MEASURE_LE; +"MEM",MEM; +"MEMBER_NOT_EMPTY",MEMBER_NOT_EMPTY; +"MEM_APPEND",MEM_APPEND; +"MEM_APPEND_DECOMPOSE",MEM_APPEND_DECOMPOSE; +"MEM_APPEND_DECOMPOSE_LEFT",MEM_APPEND_DECOMPOSE_LEFT; +"MEM_ASSOC",MEM_ASSOC; +"MEM_EL",MEM_EL; +"MEM_EXISTS_EL",MEM_EXISTS_EL; +"MEM_FILTER",MEM_FILTER; +"MEM_LIST_OF_SET",MEM_LIST_OF_SET; +"MEM_MAP",MEM_MAP; +"MIN",MIN; +"MINIMAL",MINIMAL; +"MK_REC_INJ",MK_REC_INJ; +"MOD_0",MOD_0; +"MOD_1",MOD_1; +"MOD_ADD_MOD",MOD_ADD_MOD; +"MOD_EQ",MOD_EQ; +"MOD_EQ_0",MOD_EQ_0; +"MOD_EXISTS",MOD_EXISTS; +"MOD_EXP_MOD",MOD_EXP_MOD; +"MOD_LE",MOD_LE; +"MOD_LT",MOD_LT; +"MOD_MOD",MOD_MOD; +"MOD_MOD_EXP_MIN",MOD_MOD_EXP_MIN; +"MOD_MOD_REFL",MOD_MOD_REFL; +"MOD_MULT",MOD_MULT; +"MOD_MULT2",MOD_MULT2; +"MOD_MULT_ADD",MOD_MULT_ADD; +"MOD_MULT_LMOD",MOD_MULT_LMOD; +"MOD_MULT_MOD2",MOD_MULT_MOD2; +"MOD_MULT_RMOD",MOD_MULT_RMOD; +"MOD_NSUM_MOD",MOD_NSUM_MOD; +"MOD_NSUM_MOD_NUMSEG",MOD_NSUM_MOD_NUMSEG; +"MOD_REFL",MOD_REFL; +"MOD_UNIQ",MOD_UNIQ; +"MONOIDAL_AC",MONOIDAL_AC; +"MONOIDAL_ADD",MONOIDAL_ADD; +"MONOIDAL_MUL",MONOIDAL_MUL; +"MONOIDAL_REAL_ADD",MONOIDAL_REAL_ADD; +"MONOIDAL_REAL_MUL",MONOIDAL_REAL_MUL; +"MONO_ALL",MONO_ALL; +"MONO_ALL2",MONO_ALL2; +"MONO_AND",MONO_AND; +"MONO_COND",MONO_COND; +"MONO_EXISTS",MONO_EXISTS; +"MONO_FORALL",MONO_FORALL; +"MONO_IMP",MONO_IMP; +"MONO_NOT",MONO_NOT; +"MONO_OR",MONO_OR; +"MULT",MULT; +"MULT_0",MULT_0; +"MULT_2",MULT_2; +"MULT_AC",MULT_AC; +"MULT_ASSOC",MULT_ASSOC; +"MULT_CLAUSES",MULT_CLAUSES; +"MULT_DIV_LE",MULT_DIV_LE; +"MULT_EQ_0",MULT_EQ_0; +"MULT_EQ_1",MULT_EQ_1; +"MULT_EXP",MULT_EXP; +"MULT_SUC",MULT_SUC; +"MULT_SYM",MULT_SYM; +"NADD_ADD",NADD_ADD; +"NADD_ADDITIVE",NADD_ADDITIVE; +"NADD_ADD_ASSOC",NADD_ADD_ASSOC; +"NADD_ADD_LCANCEL",NADD_ADD_LCANCEL; +"NADD_ADD_LID",NADD_ADD_LID; +"NADD_ADD_SYM",NADD_ADD_SYM; +"NADD_ADD_WELLDEF",NADD_ADD_WELLDEF; +"NADD_ALTMUL",NADD_ALTMUL; +"NADD_ARCH",NADD_ARCH; +"NADD_ARCH_LEMMA",NADD_ARCH_LEMMA; +"NADD_ARCH_MULT",NADD_ARCH_MULT; +"NADD_ARCH_ZERO",NADD_ARCH_ZERO; +"NADD_BOUND",NADD_BOUND; +"NADD_CAUCHY",NADD_CAUCHY; +"NADD_COMPLETE",NADD_COMPLETE; +"NADD_DIST",NADD_DIST; +"NADD_DIST_LEMMA",NADD_DIST_LEMMA; +"NADD_EQ_IMP_LE",NADD_EQ_IMP_LE; +"NADD_EQ_REFL",NADD_EQ_REFL; +"NADD_EQ_SYM",NADD_EQ_SYM; +"NADD_EQ_TRANS",NADD_EQ_TRANS; +"NADD_INV",NADD_INV; +"NADD_INV_0",NADD_INV_0; +"NADD_INV_WELLDEF",NADD_INV_WELLDEF; +"NADD_LBOUND",NADD_LBOUND; +"NADD_LDISTRIB",NADD_LDISTRIB; +"NADD_LE_0",NADD_LE_0; +"NADD_LE_ADD",NADD_LE_ADD; +"NADD_LE_ANTISYM",NADD_LE_ANTISYM; +"NADD_LE_EXISTS",NADD_LE_EXISTS; +"NADD_LE_LADD",NADD_LE_LADD; +"NADD_LE_LMUL",NADD_LE_LMUL; +"NADD_LE_RADD",NADD_LE_RADD; +"NADD_LE_REFL",NADD_LE_REFL; +"NADD_LE_RMUL",NADD_LE_RMUL; +"NADD_LE_TOTAL",NADD_LE_TOTAL; +"NADD_LE_TOTAL_LEMMA",NADD_LE_TOTAL_LEMMA; +"NADD_LE_TRANS",NADD_LE_TRANS; +"NADD_LE_WELLDEF",NADD_LE_WELLDEF; +"NADD_LE_WELLDEF_LEMMA",NADD_LE_WELLDEF_LEMMA; +"NADD_MUL",NADD_MUL; +"NADD_MULTIPLICATIVE",NADD_MULTIPLICATIVE; +"NADD_MUL_ASSOC",NADD_MUL_ASSOC; +"NADD_MUL_LID",NADD_MUL_LID; +"NADD_MUL_LINV",NADD_MUL_LINV; +"NADD_MUL_LINV_LEMMA0",NADD_MUL_LINV_LEMMA0; +"NADD_MUL_LINV_LEMMA1",NADD_MUL_LINV_LEMMA1; +"NADD_MUL_LINV_LEMMA2",NADD_MUL_LINV_LEMMA2; +"NADD_MUL_LINV_LEMMA3",NADD_MUL_LINV_LEMMA3; +"NADD_MUL_LINV_LEMMA4",NADD_MUL_LINV_LEMMA4; +"NADD_MUL_LINV_LEMMA5",NADD_MUL_LINV_LEMMA5; +"NADD_MUL_LINV_LEMMA6",NADD_MUL_LINV_LEMMA6; +"NADD_MUL_LINV_LEMMA7",NADD_MUL_LINV_LEMMA7; +"NADD_MUL_LINV_LEMMA7a",NADD_MUL_LINV_LEMMA7a; +"NADD_MUL_LINV_LEMMA8",NADD_MUL_LINV_LEMMA8; +"NADD_MUL_SYM",NADD_MUL_SYM; +"NADD_MUL_WELLDEF",NADD_MUL_WELLDEF; +"NADD_MUL_WELLDEF_LEMMA",NADD_MUL_WELLDEF_LEMMA; +"NADD_NONZERO",NADD_NONZERO; +"NADD_OF_NUM",NADD_OF_NUM; +"NADD_OF_NUM_ADD",NADD_OF_NUM_ADD; +"NADD_OF_NUM_EQ",NADD_OF_NUM_EQ; +"NADD_OF_NUM_LE",NADD_OF_NUM_LE; +"NADD_OF_NUM_MUL",NADD_OF_NUM_MUL; +"NADD_OF_NUM_WELLDEF",NADD_OF_NUM_WELLDEF; +"NADD_RDISTRIB",NADD_RDISTRIB; +"NADD_SUC",NADD_SUC; +"NADD_UBOUND",NADD_UBOUND; +"NEUTRAL_ADD",NEUTRAL_ADD; +"NEUTRAL_MUL",NEUTRAL_MUL; +"NEUTRAL_REAL_ADD",NEUTRAL_REAL_ADD; +"NEUTRAL_REAL_MUL",NEUTRAL_REAL_MUL; +"NOT_ALL",NOT_ALL; +"NOT_CLAUSES",NOT_CLAUSES; +"NOT_CLAUSES_WEAK",NOT_CLAUSES_WEAK; +"NOT_CONS_NIL",NOT_CONS_NIL; +"NOT_DEF",NOT_DEF; +"NOT_EMPTY_INSERT",NOT_EMPTY_INSERT; +"NOT_EQUAL_SETS",NOT_EQUAL_SETS; +"NOT_EVEN",NOT_EVEN; +"NOT_EX",NOT_EX; +"NOT_EXISTS_THM",NOT_EXISTS_THM; +"NOT_FORALL_THM",NOT_FORALL_THM; +"NOT_IMP",NOT_IMP; +"NOT_INSERT_EMPTY",NOT_INSERT_EMPTY; +"NOT_IN_EMPTY",NOT_IN_EMPTY; +"NOT_LE",NOT_LE; +"NOT_LT",NOT_LT; +"NOT_ODD",NOT_ODD; +"NOT_PSUBSET_EMPTY",NOT_PSUBSET_EMPTY; +"NOT_SUC",NOT_SUC; +"NOT_UNIV_PSUBSET",NOT_UNIV_PSUBSET; +"NSUM_0",NSUM_0; +"NSUM_ADD",NSUM_ADD; +"NSUM_ADD_GEN",NSUM_ADD_GEN; +"NSUM_ADD_NUMSEG",NSUM_ADD_NUMSEG; +"NSUM_ADD_SPLIT",NSUM_ADD_SPLIT; +"NSUM_BIJECTION",NSUM_BIJECTION; +"NSUM_BOUND",NSUM_BOUND; +"NSUM_BOUND_GEN",NSUM_BOUND_GEN; +"NSUM_BOUND_LT",NSUM_BOUND_LT; +"NSUM_BOUND_LT_ALL",NSUM_BOUND_LT_ALL; +"NSUM_BOUND_LT_GEN",NSUM_BOUND_LT_GEN; +"NSUM_CASES",NSUM_CASES; +"NSUM_CLAUSES",NSUM_CLAUSES; +"NSUM_CLAUSES_LEFT",NSUM_CLAUSES_LEFT; +"NSUM_CLAUSES_NUMSEG",NSUM_CLAUSES_NUMSEG; +"NSUM_CLAUSES_RIGHT",NSUM_CLAUSES_RIGHT; +"NSUM_CLOSED",NSUM_CLOSED; +"NSUM_CONST",NSUM_CONST; +"NSUM_CONST_NUMSEG",NSUM_CONST_NUMSEG; +"NSUM_DEGENERATE",NSUM_DEGENERATE; +"NSUM_DELETE",NSUM_DELETE; +"NSUM_DELTA",NSUM_DELTA; +"NSUM_DIFF",NSUM_DIFF; +"NSUM_EQ",NSUM_EQ; +"NSUM_EQ_0",NSUM_EQ_0; +"NSUM_EQ_0_IFF",NSUM_EQ_0_IFF; +"NSUM_EQ_0_IFF_NUMSEG",NSUM_EQ_0_IFF_NUMSEG; +"NSUM_EQ_0_NUMSEG",NSUM_EQ_0_NUMSEG; +"NSUM_EQ_GENERAL",NSUM_EQ_GENERAL; +"NSUM_EQ_GENERAL_INVERSES",NSUM_EQ_GENERAL_INVERSES; +"NSUM_EQ_NUMSEG",NSUM_EQ_NUMSEG; +"NSUM_EQ_SUPERSET",NSUM_EQ_SUPERSET; +"NSUM_GROUP",NSUM_GROUP; +"NSUM_IMAGE",NSUM_IMAGE; +"NSUM_IMAGE_GEN",NSUM_IMAGE_GEN; +"NSUM_IMAGE_NONZERO",NSUM_IMAGE_NONZERO; +"NSUM_INCL_EXCL",NSUM_INCL_EXCL; +"NSUM_INJECTION",NSUM_INJECTION; +"NSUM_LE",NSUM_LE; +"NSUM_LE_GEN",NSUM_LE_GEN; +"NSUM_LE_NUMSEG",NSUM_LE_NUMSEG; +"NSUM_LMUL",NSUM_LMUL; +"NSUM_LT",NSUM_LT; +"NSUM_LT_ALL",NSUM_LT_ALL; +"NSUM_MULTICOUNT",NSUM_MULTICOUNT; +"NSUM_MULTICOUNT_GEN",NSUM_MULTICOUNT_GEN; +"NSUM_NSUM_PRODUCT",NSUM_NSUM_PRODUCT; +"NSUM_NSUM_RESTRICT",NSUM_NSUM_RESTRICT; +"NSUM_OFFSET",NSUM_OFFSET; +"NSUM_OFFSET_0",NSUM_OFFSET_0; +"NSUM_PAIR",NSUM_PAIR; +"NSUM_POS_BOUND",NSUM_POS_BOUND; +"NSUM_POS_LT",NSUM_POS_LT; +"NSUM_POS_LT_ALL",NSUM_POS_LT_ALL; +"NSUM_RESTRICT",NSUM_RESTRICT; +"NSUM_RESTRICT_SET",NSUM_RESTRICT_SET; +"NSUM_RMUL",NSUM_RMUL; +"NSUM_SING",NSUM_SING; +"NSUM_SING_NUMSEG",NSUM_SING_NUMSEG; +"NSUM_SUBSET",NSUM_SUBSET; +"NSUM_SUBSET_SIMPLE",NSUM_SUBSET_SIMPLE; +"NSUM_SUPERSET",NSUM_SUPERSET; +"NSUM_SUPPORT",NSUM_SUPPORT; +"NSUM_SWAP",NSUM_SWAP; +"NSUM_SWAP_NUMSEG",NSUM_SWAP_NUMSEG; +"NSUM_TRIV_NUMSEG",NSUM_TRIV_NUMSEG; +"NSUM_UNION",NSUM_UNION; +"NSUM_UNIONS_NONZERO",NSUM_UNIONS_NONZERO; +"NSUM_UNION_EQ",NSUM_UNION_EQ; +"NSUM_UNION_LZERO",NSUM_UNION_LZERO; +"NSUM_UNION_NONZERO",NSUM_UNION_NONZERO; +"NSUM_UNION_RZERO",NSUM_UNION_RZERO; +"NULL",NULL; +"NUMERAL",NUMERAL; +"NUMPAIR",NUMPAIR; +"NUMPAIR_DEST",NUMPAIR_DEST; +"NUMPAIR_INJ",NUMPAIR_INJ; +"NUMPAIR_INJ_LEMMA",NUMPAIR_INJ_LEMMA; +"NUMSEG_ADD_SPLIT",NUMSEG_ADD_SPLIT; +"NUMSEG_CLAUSES",NUMSEG_CLAUSES; +"NUMSEG_COMBINE_L",NUMSEG_COMBINE_L; +"NUMSEG_COMBINE_R",NUMSEG_COMBINE_R; +"NUMSEG_EMPTY",NUMSEG_EMPTY; +"NUMSEG_LE",NUMSEG_LE; +"NUMSEG_LREC",NUMSEG_LREC; +"NUMSEG_LT",NUMSEG_LT; +"NUMSEG_OFFSET_IMAGE",NUMSEG_OFFSET_IMAGE; +"NUMSEG_REC",NUMSEG_REC; +"NUMSEG_RREC",NUMSEG_RREC; +"NUMSEG_SING",NUMSEG_SING; +"NUMSUM",NUMSUM; +"NUMSUM_DEST",NUMSUM_DEST; +"NUMSUM_INJ",NUMSUM_INJ; +"NUM_GCD",NUM_GCD; +"NUM_OF_INT",NUM_OF_INT; +"NUM_OF_INT_OF_NUM",NUM_OF_INT_OF_NUM; +"NUM_REP_CASES",NUM_REP_CASES; +"NUM_REP_INDUCT",NUM_REP_INDUCT; +"NUM_REP_RULES",NUM_REP_RULES; +"ODD",ODD; +"ODD_ADD",ODD_ADD; +"ODD_DOUBLE",ODD_DOUBLE; +"ODD_EXISTS",ODD_EXISTS; +"ODD_EXP",ODD_EXP; +"ODD_MOD",ODD_MOD; +"ODD_MULT",ODD_MULT; +"ODD_SUB",ODD_SUB; +"ONE",ONE; +"ONE_ONE",ONE_ONE; +"ONTO",ONTO; +"OR_CLAUSES",OR_CLAUSES; +"OR_DEF",OR_DEF; +"OR_EXISTS_THM",OR_EXISTS_THM; +"OUTL",OUTL; +"OUTR",OUTR; +"PAIR",PAIR; +"PAIRED_ETA_THM",PAIRED_ETA_THM; +"PAIRWISE",PAIRWISE; +"PAIRWISE_EMPTY",PAIRWISE_EMPTY; +"PAIRWISE_IMAGE",PAIRWISE_IMAGE; +"PAIRWISE_INSERT",PAIRWISE_INSERT; +"PAIRWISE_MONO",PAIRWISE_MONO; +"PAIRWISE_SING",PAIRWISE_SING; +"PAIR_EQ",PAIR_EQ; +"PAIR_EXISTS_THM",PAIR_EXISTS_THM; +"PAIR_SURJECTIVE",PAIR_SURJECTIVE; +"PASSOC_DEF",PASSOC_DEF; +"PASTECART_EQ",PASTECART_EQ; +"PASTECART_FST_SND",PASTECART_FST_SND; +"PASTECART_INJ",PASTECART_INJ; +"PASTECART_IN_PCROSS",PASTECART_IN_PCROSS; +"PCROSS",PCROSS; +"PCROSS_DIFF",PCROSS_DIFF; +"PCROSS_EMPTY",PCROSS_EMPTY; +"PCROSS_EQ",PCROSS_EQ; +"PCROSS_EQ_EMPTY",PCROSS_EQ_EMPTY; +"PCROSS_INTER",PCROSS_INTER; +"PCROSS_MONO",PCROSS_MONO; +"PCROSS_UNION",PCROSS_UNION; +"PCROSS_UNIONS",PCROSS_UNIONS; +"PCROSS_UNIONS_UNIONS",PCROSS_UNIONS_UNIONS; +"POLYNOMIAL_FUNCTION_ADD",POLYNOMIAL_FUNCTION_ADD; +"POLYNOMIAL_FUNCTION_CONST",POLYNOMIAL_FUNCTION_CONST; +"POLYNOMIAL_FUNCTION_FINITE_ROOTS",POLYNOMIAL_FUNCTION_FINITE_ROOTS; +"POLYNOMIAL_FUNCTION_I",POLYNOMIAL_FUNCTION_I; +"POLYNOMIAL_FUNCTION_ID",POLYNOMIAL_FUNCTION_ID; +"POLYNOMIAL_FUNCTION_INDUCT",POLYNOMIAL_FUNCTION_INDUCT; +"POLYNOMIAL_FUNCTION_LMUL",POLYNOMIAL_FUNCTION_LMUL; +"POLYNOMIAL_FUNCTION_MUL",POLYNOMIAL_FUNCTION_MUL; +"POLYNOMIAL_FUNCTION_NEG",POLYNOMIAL_FUNCTION_NEG; +"POLYNOMIAL_FUNCTION_POW",POLYNOMIAL_FUNCTION_POW; +"POLYNOMIAL_FUNCTION_RMUL",POLYNOMIAL_FUNCTION_RMUL; +"POLYNOMIAL_FUNCTION_SUB",POLYNOMIAL_FUNCTION_SUB; +"POLYNOMIAL_FUNCTION_SUM",POLYNOMIAL_FUNCTION_SUM; +"POLYNOMIAL_FUNCTION_o",POLYNOMIAL_FUNCTION_o; +"POWERSET_CLAUSES",POWERSET_CLAUSES; +"PRE",PRE; +"PRE_ELIM_THM",PRE_ELIM_THM; +"PRE_ELIM_THM'",PRE_ELIM_THM'; +"PSUBSET",PSUBSET; +"PSUBSET_ALT",PSUBSET_ALT; +"PSUBSET_INSERT_SUBSET",PSUBSET_INSERT_SUBSET; +"PSUBSET_IRREFL",PSUBSET_IRREFL; +"PSUBSET_MEMBER",PSUBSET_MEMBER; +"PSUBSET_SUBSET_TRANS",PSUBSET_SUBSET_TRANS; +"PSUBSET_TRANS",PSUBSET_TRANS; +"PSUBSET_UNIV",PSUBSET_UNIV; +"RAT_LEMMA1",RAT_LEMMA1; +"RAT_LEMMA2",RAT_LEMMA2; +"RAT_LEMMA3",RAT_LEMMA3; +"RAT_LEMMA4",RAT_LEMMA4; +"RAT_LEMMA5",RAT_LEMMA5; +"REAL_ABS_0",REAL_ABS_0; +"REAL_ABS_1",REAL_ABS_1; +"REAL_ABS_ABS",REAL_ABS_ABS; +"REAL_ABS_BETWEEN",REAL_ABS_BETWEEN; +"REAL_ABS_BETWEEN1",REAL_ABS_BETWEEN1; +"REAL_ABS_BETWEEN2",REAL_ABS_BETWEEN2; +"REAL_ABS_BOUND",REAL_ABS_BOUND; +"REAL_ABS_BOUNDS",REAL_ABS_BOUNDS; +"REAL_ABS_CASES",REAL_ABS_CASES; +"REAL_ABS_CIRCLE",REAL_ABS_CIRCLE; +"REAL_ABS_DIV",REAL_ABS_DIV; +"REAL_ABS_INF_LE",REAL_ABS_INF_LE; +"REAL_ABS_INV",REAL_ABS_INV; +"REAL_ABS_LE",REAL_ABS_LE; +"REAL_ABS_MUL",REAL_ABS_MUL; +"REAL_ABS_NEG",REAL_ABS_NEG; +"REAL_ABS_NUM",REAL_ABS_NUM; +"REAL_ABS_NZ",REAL_ABS_NZ; +"REAL_ABS_POS",REAL_ABS_POS; +"REAL_ABS_POW",REAL_ABS_POW; +"REAL_ABS_REFL",REAL_ABS_REFL; +"REAL_ABS_SGN",REAL_ABS_SGN; +"REAL_ABS_SIGN",REAL_ABS_SIGN; +"REAL_ABS_SIGN2",REAL_ABS_SIGN2; +"REAL_ABS_STILLNZ",REAL_ABS_STILLNZ; +"REAL_ABS_SUB",REAL_ABS_SUB; +"REAL_ABS_SUB_ABS",REAL_ABS_SUB_ABS; +"REAL_ABS_SUP_LE",REAL_ABS_SUP_LE; +"REAL_ABS_TRIANGLE",REAL_ABS_TRIANGLE; +"REAL_ABS_TRIANGLE_LE",REAL_ABS_TRIANGLE_LE; +"REAL_ABS_TRIANGLE_LT",REAL_ABS_TRIANGLE_LT; +"REAL_ABS_ZERO",REAL_ABS_ZERO; +"REAL_ADD2_SUB2",REAL_ADD2_SUB2; +"REAL_ADD_AC",REAL_ADD_AC; +"REAL_ADD_ASSOC",REAL_ADD_ASSOC; +"REAL_ADD_LDISTRIB",REAL_ADD_LDISTRIB; +"REAL_ADD_LID",REAL_ADD_LID; +"REAL_ADD_LINV",REAL_ADD_LINV; +"REAL_ADD_RDISTRIB",REAL_ADD_RDISTRIB; +"REAL_ADD_RID",REAL_ADD_RID; +"REAL_ADD_RINV",REAL_ADD_RINV; +"REAL_ADD_SUB",REAL_ADD_SUB; +"REAL_ADD_SUB2",REAL_ADD_SUB2; +"REAL_ADD_SYM",REAL_ADD_SYM; +"REAL_ARCH",REAL_ARCH; +"REAL_ARCH_LT",REAL_ARCH_LT; +"REAL_ARCH_SIMPLE",REAL_ARCH_SIMPLE; +"REAL_BOUNDS_LE",REAL_BOUNDS_LE; +"REAL_BOUNDS_LT",REAL_BOUNDS_LT; +"REAL_COMPLETE",REAL_COMPLETE; +"REAL_COMPLETE_SOMEPOS",REAL_COMPLETE_SOMEPOS; +"REAL_DIFFSQ",REAL_DIFFSQ; +"REAL_DIV_1",REAL_DIV_1; +"REAL_DIV_EQ_0",REAL_DIV_EQ_0; +"REAL_DIV_LMUL",REAL_DIV_LMUL; +"REAL_DIV_POW2",REAL_DIV_POW2; +"REAL_DIV_POW2_ALT",REAL_DIV_POW2_ALT; +"REAL_DIV_REFL",REAL_DIV_REFL; +"REAL_DIV_RMUL",REAL_DIV_RMUL; +"REAL_DOWN",REAL_DOWN; +"REAL_DOWN2",REAL_DOWN2; +"REAL_ENTIRE",REAL_ENTIRE; +"REAL_EQ_ADD_LCANCEL",REAL_EQ_ADD_LCANCEL; +"REAL_EQ_ADD_LCANCEL_0",REAL_EQ_ADD_LCANCEL_0; +"REAL_EQ_ADD_RCANCEL",REAL_EQ_ADD_RCANCEL; +"REAL_EQ_ADD_RCANCEL_0",REAL_EQ_ADD_RCANCEL_0; +"REAL_EQ_IMP_LE",REAL_EQ_IMP_LE; +"REAL_EQ_INV2",REAL_EQ_INV2; +"REAL_EQ_LCANCEL_IMP",REAL_EQ_LCANCEL_IMP; +"REAL_EQ_LDIV_EQ",REAL_EQ_LDIV_EQ; +"REAL_EQ_MUL_LCANCEL",REAL_EQ_MUL_LCANCEL; +"REAL_EQ_MUL_RCANCEL",REAL_EQ_MUL_RCANCEL; +"REAL_EQ_NEG2",REAL_EQ_NEG2; +"REAL_EQ_RCANCEL_IMP",REAL_EQ_RCANCEL_IMP; +"REAL_EQ_RDIV_EQ",REAL_EQ_RDIV_EQ; +"REAL_EQ_SGN_ABS",REAL_EQ_SGN_ABS; +"REAL_EQ_SQUARE_ABS",REAL_EQ_SQUARE_ABS; +"REAL_EQ_SUB_LADD",REAL_EQ_SUB_LADD; +"REAL_EQ_SUB_RADD",REAL_EQ_SUB_RADD; +"REAL_HREAL_LEMMA1",REAL_HREAL_LEMMA1; +"REAL_HREAL_LEMMA2",REAL_HREAL_LEMMA2; +"REAL_INF_ASCLOSE",REAL_INF_ASCLOSE; +"REAL_INF_BOUNDS",REAL_INF_BOUNDS; +"REAL_INF_LE",REAL_INF_LE; +"REAL_INF_LE_FINITE",REAL_INF_LE_FINITE; +"REAL_INF_LT_FINITE",REAL_INF_LT_FINITE; +"REAL_INF_UNIQUE",REAL_INF_UNIQUE; +"REAL_INV_0",REAL_INV_0; +"REAL_INV_1",REAL_INV_1; +"REAL_INV_1_LE",REAL_INV_1_LE; +"REAL_INV_1_LT",REAL_INV_1_LT; +"REAL_INV_DIV",REAL_INV_DIV; +"REAL_INV_EQ_0",REAL_INV_EQ_0; +"REAL_INV_EQ_1",REAL_INV_EQ_1; +"REAL_INV_INV",REAL_INV_INV; +"REAL_INV_LE_1",REAL_INV_LE_1; +"REAL_INV_LT_1",REAL_INV_LT_1; +"REAL_INV_MUL",REAL_INV_MUL; +"REAL_INV_NEG",REAL_INV_NEG; +"REAL_INV_POW",REAL_INV_POW; +"REAL_INV_SGN",REAL_INV_SGN; +"REAL_LET_ADD",REAL_LET_ADD; +"REAL_LET_ADD2",REAL_LET_ADD2; +"REAL_LET_ANTISYM",REAL_LET_ANTISYM; +"REAL_LET_TOTAL",REAL_LET_TOTAL; +"REAL_LET_TRANS",REAL_LET_TRANS; +"REAL_LE_01",REAL_LE_01; +"REAL_LE_ADD",REAL_LE_ADD; +"REAL_LE_ADD2",REAL_LE_ADD2; +"REAL_LE_ADDL",REAL_LE_ADDL; +"REAL_LE_ADDR",REAL_LE_ADDR; +"REAL_LE_ANTISYM",REAL_LE_ANTISYM; +"REAL_LE_DIV",REAL_LE_DIV; +"REAL_LE_DIV2_EQ",REAL_LE_DIV2_EQ; +"REAL_LE_DOUBLE",REAL_LE_DOUBLE; +"REAL_LE_INF",REAL_LE_INF; +"REAL_LE_INF_EQ",REAL_LE_INF_EQ; +"REAL_LE_INF_FINITE",REAL_LE_INF_FINITE; +"REAL_LE_INF_SUBSET",REAL_LE_INF_SUBSET; +"REAL_LE_INV",REAL_LE_INV; +"REAL_LE_INV2",REAL_LE_INV2; +"REAL_LE_INV_EQ",REAL_LE_INV_EQ; +"REAL_LE_LADD",REAL_LE_LADD; +"REAL_LE_LADD_IMP",REAL_LE_LADD_IMP; +"REAL_LE_LCANCEL_IMP",REAL_LE_LCANCEL_IMP; +"REAL_LE_LDIV_EQ",REAL_LE_LDIV_EQ; +"REAL_LE_LINV",REAL_LE_LINV; +"REAL_LE_LMUL",REAL_LE_LMUL; +"REAL_LE_LMUL_EQ",REAL_LE_LMUL_EQ; +"REAL_LE_LNEG",REAL_LE_LNEG; +"REAL_LE_LT",REAL_LE_LT; +"REAL_LE_MAX",REAL_LE_MAX; +"REAL_LE_MIN",REAL_LE_MIN; +"REAL_LE_MUL",REAL_LE_MUL; +"REAL_LE_MUL2",REAL_LE_MUL2; +"REAL_LE_MUL_EQ",REAL_LE_MUL_EQ; +"REAL_LE_NEG",REAL_LE_NEG; +"REAL_LE_NEG2",REAL_LE_NEG2; +"REAL_LE_NEGL",REAL_LE_NEGL; +"REAL_LE_NEGR",REAL_LE_NEGR; +"REAL_LE_NEGTOTAL",REAL_LE_NEGTOTAL; +"REAL_LE_POW2",REAL_LE_POW2; +"REAL_LE_POW_2",REAL_LE_POW_2; +"REAL_LE_RADD",REAL_LE_RADD; +"REAL_LE_RCANCEL_IMP",REAL_LE_RCANCEL_IMP; +"REAL_LE_RDIV_EQ",REAL_LE_RDIV_EQ; +"REAL_LE_REFL",REAL_LE_REFL; +"REAL_LE_RINV",REAL_LE_RINV; +"REAL_LE_RMUL",REAL_LE_RMUL; +"REAL_LE_RMUL_EQ",REAL_LE_RMUL_EQ; +"REAL_LE_RNEG",REAL_LE_RNEG; +"REAL_LE_SQUARE",REAL_LE_SQUARE; +"REAL_LE_SQUARE_ABS",REAL_LE_SQUARE_ABS; +"REAL_LE_SUB_LADD",REAL_LE_SUB_LADD; +"REAL_LE_SUB_RADD",REAL_LE_SUB_RADD; +"REAL_LE_SUP",REAL_LE_SUP; +"REAL_LE_SUP_FINITE",REAL_LE_SUP_FINITE; +"REAL_LE_TOTAL",REAL_LE_TOTAL; +"REAL_LE_TRANS",REAL_LE_TRANS; +"REAL_LNEG_UNIQ",REAL_LNEG_UNIQ; +"REAL_LTE_ADD",REAL_LTE_ADD; +"REAL_LTE_ADD2",REAL_LTE_ADD2; +"REAL_LTE_ANTISYM",REAL_LTE_ANTISYM; +"REAL_LTE_TOTAL",REAL_LTE_TOTAL; +"REAL_LTE_TRANS",REAL_LTE_TRANS; +"REAL_LT_01",REAL_LT_01; +"REAL_LT_ADD",REAL_LT_ADD; +"REAL_LT_ADD1",REAL_LT_ADD1; +"REAL_LT_ADD2",REAL_LT_ADD2; +"REAL_LT_ADDL",REAL_LT_ADDL; +"REAL_LT_ADDNEG",REAL_LT_ADDNEG; +"REAL_LT_ADDNEG2",REAL_LT_ADDNEG2; +"REAL_LT_ADDR",REAL_LT_ADDR; +"REAL_LT_ADD_SUB",REAL_LT_ADD_SUB; +"REAL_LT_ANTISYM",REAL_LT_ANTISYM; +"REAL_LT_DIV",REAL_LT_DIV; +"REAL_LT_DIV2_EQ",REAL_LT_DIV2_EQ; +"REAL_LT_GT",REAL_LT_GT; +"REAL_LT_IMP_LE",REAL_LT_IMP_LE; +"REAL_LT_IMP_NE",REAL_LT_IMP_NE; +"REAL_LT_IMP_NZ",REAL_LT_IMP_NZ; +"REAL_LT_INF_FINITE",REAL_LT_INF_FINITE; +"REAL_LT_INV",REAL_LT_INV; +"REAL_LT_INV2",REAL_LT_INV2; +"REAL_LT_INV_EQ",REAL_LT_INV_EQ; +"REAL_LT_LADD",REAL_LT_LADD; +"REAL_LT_LADD_IMP",REAL_LT_LADD_IMP; +"REAL_LT_LCANCEL_IMP",REAL_LT_LCANCEL_IMP; +"REAL_LT_LDIV_EQ",REAL_LT_LDIV_EQ; +"REAL_LT_LE",REAL_LT_LE; +"REAL_LT_LINV",REAL_LT_LINV; +"REAL_LT_LMUL",REAL_LT_LMUL; +"REAL_LT_LMUL_EQ",REAL_LT_LMUL_EQ; +"REAL_LT_LNEG",REAL_LT_LNEG; +"REAL_LT_MAX",REAL_LT_MAX; +"REAL_LT_MIN",REAL_LT_MIN; +"REAL_LT_MUL",REAL_LT_MUL; +"REAL_LT_MUL2",REAL_LT_MUL2; +"REAL_LT_MUL_EQ",REAL_LT_MUL_EQ; +"REAL_LT_NEG",REAL_LT_NEG; +"REAL_LT_NEG2",REAL_LT_NEG2; +"REAL_LT_NEGTOTAL",REAL_LT_NEGTOTAL; +"REAL_LT_POW2",REAL_LT_POW2; +"REAL_LT_POW_2",REAL_LT_POW_2; +"REAL_LT_RADD",REAL_LT_RADD; +"REAL_LT_RCANCEL_IMP",REAL_LT_RCANCEL_IMP; +"REAL_LT_RDIV_EQ",REAL_LT_RDIV_EQ; +"REAL_LT_REFL",REAL_LT_REFL; +"REAL_LT_RINV",REAL_LT_RINV; +"REAL_LT_RMUL",REAL_LT_RMUL; +"REAL_LT_RMUL_EQ",REAL_LT_RMUL_EQ; +"REAL_LT_RNEG",REAL_LT_RNEG; +"REAL_LT_SQUARE",REAL_LT_SQUARE; +"REAL_LT_SQUARE_ABS",REAL_LT_SQUARE_ABS; +"REAL_LT_SUB_LADD",REAL_LT_SUB_LADD; +"REAL_LT_SUB_RADD",REAL_LT_SUB_RADD; +"REAL_LT_SUP_FINITE",REAL_LT_SUP_FINITE; +"REAL_LT_TOTAL",REAL_LT_TOTAL; +"REAL_LT_TRANS",REAL_LT_TRANS; +"REAL_MAX_ACI",REAL_MAX_ACI; +"REAL_MAX_ASSOC",REAL_MAX_ASSOC; +"REAL_MAX_LE",REAL_MAX_LE; +"REAL_MAX_LT",REAL_MAX_LT; +"REAL_MAX_MAX",REAL_MAX_MAX; +"REAL_MAX_MIN",REAL_MAX_MIN; +"REAL_MAX_SYM",REAL_MAX_SYM; +"REAL_MIN_ACI",REAL_MIN_ACI; +"REAL_MIN_ASSOC",REAL_MIN_ASSOC; +"REAL_MIN_LE",REAL_MIN_LE; +"REAL_MIN_LT",REAL_MIN_LT; +"REAL_MIN_MAX",REAL_MIN_MAX; +"REAL_MIN_MIN",REAL_MIN_MIN; +"REAL_MIN_SYM",REAL_MIN_SYM; +"REAL_MUL_2",REAL_MUL_2; +"REAL_MUL_AC",REAL_MUL_AC; +"REAL_MUL_ASSOC",REAL_MUL_ASSOC; +"REAL_MUL_LID",REAL_MUL_LID; +"REAL_MUL_LINV",REAL_MUL_LINV; +"REAL_MUL_LINV_UNIQ",REAL_MUL_LINV_UNIQ; +"REAL_MUL_LNEG",REAL_MUL_LNEG; +"REAL_MUL_LZERO",REAL_MUL_LZERO; +"REAL_MUL_POS_LE",REAL_MUL_POS_LE; +"REAL_MUL_POS_LT",REAL_MUL_POS_LT; +"REAL_MUL_RID",REAL_MUL_RID; +"REAL_MUL_RINV",REAL_MUL_RINV; +"REAL_MUL_RINV_UNIQ",REAL_MUL_RINV_UNIQ; +"REAL_MUL_RNEG",REAL_MUL_RNEG; +"REAL_MUL_RZERO",REAL_MUL_RZERO; +"REAL_MUL_SYM",REAL_MUL_SYM; +"REAL_NEGNEG",REAL_NEGNEG; +"REAL_NEG_0",REAL_NEG_0; +"REAL_NEG_ADD",REAL_NEG_ADD; +"REAL_NEG_EQ",REAL_NEG_EQ; +"REAL_NEG_EQ_0",REAL_NEG_EQ_0; +"REAL_NEG_GE0",REAL_NEG_GE0; +"REAL_NEG_GT0",REAL_NEG_GT0; +"REAL_NEG_LE0",REAL_NEG_LE0; +"REAL_NEG_LMUL",REAL_NEG_LMUL; +"REAL_NEG_LT0",REAL_NEG_LT0; +"REAL_NEG_MINUS1",REAL_NEG_MINUS1; +"REAL_NEG_MUL2",REAL_NEG_MUL2; +"REAL_NEG_NEG",REAL_NEG_NEG; +"REAL_NEG_RMUL",REAL_NEG_RMUL; +"REAL_NEG_SUB",REAL_NEG_SUB; +"REAL_NOT_EQ",REAL_NOT_EQ; +"REAL_NOT_LE",REAL_NOT_LE; +"REAL_NOT_LT",REAL_NOT_LT; +"REAL_OF_NUM_ADD",REAL_OF_NUM_ADD; +"REAL_OF_NUM_EQ",REAL_OF_NUM_EQ; +"REAL_OF_NUM_GE",REAL_OF_NUM_GE; +"REAL_OF_NUM_GT",REAL_OF_NUM_GT; +"REAL_OF_NUM_LE",REAL_OF_NUM_LE; +"REAL_OF_NUM_LT",REAL_OF_NUM_LT; +"REAL_OF_NUM_MAX",REAL_OF_NUM_MAX; +"REAL_OF_NUM_MIN",REAL_OF_NUM_MIN; +"REAL_OF_NUM_MUL",REAL_OF_NUM_MUL; +"REAL_OF_NUM_POW",REAL_OF_NUM_POW; +"REAL_OF_NUM_SUB",REAL_OF_NUM_SUB; +"REAL_OF_NUM_SUC",REAL_OF_NUM_SUC; +"REAL_OF_NUM_SUM",REAL_OF_NUM_SUM; +"REAL_OF_NUM_SUM_NUMSEG",REAL_OF_NUM_SUM_NUMSEG; +"REAL_POLYFUN_EQ_0",REAL_POLYFUN_EQ_0; +"REAL_POLYFUN_EQ_CONST",REAL_POLYFUN_EQ_CONST; +"REAL_POLYFUN_FINITE_ROOTS",REAL_POLYFUN_FINITE_ROOTS; +"REAL_POLYFUN_ROOTBOUND",REAL_POLYFUN_ROOTBOUND; +"REAL_POLY_CLAUSES",REAL_POLY_CLAUSES; +"REAL_POLY_NEG_CLAUSES",REAL_POLY_NEG_CLAUSES; +"REAL_POS",REAL_POS; +"REAL_POS_NZ",REAL_POS_NZ; +"REAL_POW2_ABS",REAL_POW2_ABS; +"REAL_POW_1",REAL_POW_1; +"REAL_POW_1_LE",REAL_POW_1_LE; +"REAL_POW_1_LT",REAL_POW_1_LT; +"REAL_POW_2",REAL_POW_2; +"REAL_POW_ADD",REAL_POW_ADD; +"REAL_POW_DIV",REAL_POW_DIV; +"REAL_POW_EQ",REAL_POW_EQ; +"REAL_POW_EQ_0",REAL_POW_EQ_0; +"REAL_POW_EQ_1",REAL_POW_EQ_1; +"REAL_POW_EQ_1_IMP",REAL_POW_EQ_1_IMP; +"REAL_POW_EQ_ABS",REAL_POW_EQ_ABS; +"REAL_POW_EQ_EQ",REAL_POW_EQ_EQ; +"REAL_POW_EQ_ODD",REAL_POW_EQ_ODD; +"REAL_POW_EQ_ODD_EQ",REAL_POW_EQ_ODD_EQ; +"REAL_POW_INV",REAL_POW_INV; +"REAL_POW_LE",REAL_POW_LE; +"REAL_POW_LE2",REAL_POW_LE2; +"REAL_POW_LE2_ODD",REAL_POW_LE2_ODD; +"REAL_POW_LE2_ODD_EQ",REAL_POW_LE2_ODD_EQ; +"REAL_POW_LE2_REV",REAL_POW_LE2_REV; +"REAL_POW_LE_1",REAL_POW_LE_1; +"REAL_POW_LT",REAL_POW_LT; +"REAL_POW_LT2",REAL_POW_LT2; +"REAL_POW_LT2_ODD",REAL_POW_LT2_ODD; +"REAL_POW_LT2_ODD_EQ",REAL_POW_LT2_ODD_EQ; +"REAL_POW_LT2_REV",REAL_POW_LT2_REV; +"REAL_POW_LT_1",REAL_POW_LT_1; +"REAL_POW_MONO",REAL_POW_MONO; +"REAL_POW_MONO_INV",REAL_POW_MONO_INV; +"REAL_POW_MONO_LT",REAL_POW_MONO_LT; +"REAL_POW_MUL",REAL_POW_MUL; +"REAL_POW_NEG",REAL_POW_NEG; +"REAL_POW_NZ",REAL_POW_NZ; +"REAL_POW_ONE",REAL_POW_ONE; +"REAL_POW_POW",REAL_POW_POW; +"REAL_POW_SUB",REAL_POW_SUB; +"REAL_POW_ZERO",REAL_POW_ZERO; +"REAL_RNEG_UNIQ",REAL_RNEG_UNIQ; +"REAL_SGN",REAL_SGN; +"REAL_SGN_0",REAL_SGN_0; +"REAL_SGN_ABS",REAL_SGN_ABS; +"REAL_SGN_CASES",REAL_SGN_CASES; +"REAL_SGN_DIV",REAL_SGN_DIV; +"REAL_SGN_EQ",REAL_SGN_EQ; +"REAL_SGN_INEQS",REAL_SGN_INEQS; +"REAL_SGN_INV",REAL_SGN_INV; +"REAL_SGN_MUL",REAL_SGN_MUL; +"REAL_SGN_NEG",REAL_SGN_NEG; +"REAL_SGN_POW",REAL_SGN_POW; +"REAL_SGN_POW_2",REAL_SGN_POW_2; +"REAL_SGN_REAL_SGN",REAL_SGN_REAL_SGN; +"REAL_SOS_EQ_0",REAL_SOS_EQ_0; +"REAL_SUB_0",REAL_SUB_0; +"REAL_SUB_ABS",REAL_SUB_ABS; +"REAL_SUB_ADD",REAL_SUB_ADD; +"REAL_SUB_ADD2",REAL_SUB_ADD2; +"REAL_SUB_INV",REAL_SUB_INV; +"REAL_SUB_LDISTRIB",REAL_SUB_LDISTRIB; +"REAL_SUB_LE",REAL_SUB_LE; +"REAL_SUB_LNEG",REAL_SUB_LNEG; +"REAL_SUB_LT",REAL_SUB_LT; +"REAL_SUB_LZERO",REAL_SUB_LZERO; +"REAL_SUB_NEG2",REAL_SUB_NEG2; +"REAL_SUB_POLYFUN",REAL_SUB_POLYFUN; +"REAL_SUB_POLYFUN_ALT",REAL_SUB_POLYFUN_ALT; +"REAL_SUB_POW",REAL_SUB_POW; +"REAL_SUB_POW_L1",REAL_SUB_POW_L1; +"REAL_SUB_POW_R1",REAL_SUB_POW_R1; +"REAL_SUB_RDISTRIB",REAL_SUB_RDISTRIB; +"REAL_SUB_REFL",REAL_SUB_REFL; +"REAL_SUB_RNEG",REAL_SUB_RNEG; +"REAL_SUB_RZERO",REAL_SUB_RZERO; +"REAL_SUB_SUB",REAL_SUB_SUB; +"REAL_SUB_SUB2",REAL_SUB_SUB2; +"REAL_SUB_TRIANGLE",REAL_SUB_TRIANGLE; +"REAL_SUP_ASCLOSE",REAL_SUP_ASCLOSE; +"REAL_SUP_BOUNDS",REAL_SUP_BOUNDS; +"REAL_SUP_EQ_INF",REAL_SUP_EQ_INF; +"REAL_SUP_LE",REAL_SUP_LE; +"REAL_SUP_LE_EQ",REAL_SUP_LE_EQ; +"REAL_SUP_LE_FINITE",REAL_SUP_LE_FINITE; +"REAL_SUP_LE_SUBSET",REAL_SUP_LE_SUBSET; +"REAL_SUP_LT_FINITE",REAL_SUP_LT_FINITE; +"REAL_SUP_UNIQUE",REAL_SUP_UNIQUE; +"REAL_WLOG_LE",REAL_WLOG_LE; +"REAL_WLOG_LT",REAL_WLOG_LT; +"RECURSION_CASEWISE",RECURSION_CASEWISE; +"RECURSION_CASEWISE_PAIRWISE",RECURSION_CASEWISE_PAIRWISE; +"RECURSION_SUPERADMISSIBLE",RECURSION_SUPERADMISSIBLE; +"REFL_CLAUSE",REFL_CLAUSE; +"REPLICATE",REPLICATE; +"REP_ABS_PAIR",REP_ABS_PAIR; +"REST",REST; +"REVERSE",REVERSE; +"REVERSE_APPEND",REVERSE_APPEND; +"REVERSE_REVERSE",REVERSE_REVERSE; +"RIGHT_ADD_DISTRIB",RIGHT_ADD_DISTRIB; +"RIGHT_AND_EXISTS_THM",RIGHT_AND_EXISTS_THM; +"RIGHT_AND_FORALL_THM",RIGHT_AND_FORALL_THM; +"RIGHT_EXISTS_AND_THM",RIGHT_EXISTS_AND_THM; +"RIGHT_EXISTS_IMP_THM",RIGHT_EXISTS_IMP_THM; +"RIGHT_FORALL_IMP_THM",RIGHT_FORALL_IMP_THM; +"RIGHT_FORALL_OR_THM",RIGHT_FORALL_OR_THM; +"RIGHT_IMP_EXISTS_THM",RIGHT_IMP_EXISTS_THM; +"RIGHT_IMP_FORALL_THM",RIGHT_IMP_FORALL_THM; +"RIGHT_OR_DISTRIB",RIGHT_OR_DISTRIB; +"RIGHT_OR_EXISTS_THM",RIGHT_OR_EXISTS_THM; +"RIGHT_OR_FORALL_THM",RIGHT_OR_FORALL_THM; +"RIGHT_SUB_DISTRIB",RIGHT_SUB_DISTRIB; +"SELECT_AX",SELECT_AX; +"SELECT_REFL",SELECT_REFL; +"SELECT_UNIQUE",SELECT_UNIQUE; +"SETSPEC",SETSPEC; +"SET_CASES",SET_CASES; +"SET_OF_LIST_APPEND",SET_OF_LIST_APPEND; +"SET_OF_LIST_EQ_EMPTY",SET_OF_LIST_EQ_EMPTY; +"SET_OF_LIST_MAP",SET_OF_LIST_MAP; +"SET_OF_LIST_OF_SET",SET_OF_LIST_OF_SET; +"SET_PAIR_THM",SET_PAIR_THM; +"SET_PROVE_CASES",SET_PROVE_CASES; +"SET_RECURSION_LEMMA",SET_RECURSION_LEMMA; +"SIMPLE_IMAGE",SIMPLE_IMAGE; +"SIMPLE_IMAGE_GEN",SIMPLE_IMAGE_GEN; +"SING",SING; +"SING_GSPEC",SING_GSPEC; +"SING_SUBSET",SING_SUBSET; +"SKOLEM_THM",SKOLEM_THM; +"SKOLEM_THM_GEN",SKOLEM_THM_GEN; +"SND",SND; +"SNDCART_PASTECART",SNDCART_PASTECART; +"SND_DEF",SND_DEF; +"SUB",SUB; +"SUBSET",SUBSET; +"SUBSET_ANTISYM",SUBSET_ANTISYM; +"SUBSET_ANTISYM_EQ",SUBSET_ANTISYM_EQ; +"SUBSET_CARD_EQ",SUBSET_CARD_EQ; +"SUBSET_DELETE",SUBSET_DELETE; +"SUBSET_DIFF",SUBSET_DIFF; +"SUBSET_EMPTY",SUBSET_EMPTY; +"SUBSET_IMAGE",SUBSET_IMAGE; +"SUBSET_INSERT",SUBSET_INSERT; +"SUBSET_INSERT_DELETE",SUBSET_INSERT_DELETE; +"SUBSET_INTER",SUBSET_INTER; +"SUBSET_INTERS",SUBSET_INTERS; +"SUBSET_INTER_ABSORPTION",SUBSET_INTER_ABSORPTION; +"SUBSET_NUMSEG",SUBSET_NUMSEG; +"SUBSET_PCROSS",SUBSET_PCROSS; +"SUBSET_PSUBSET_TRANS",SUBSET_PSUBSET_TRANS; +"SUBSET_REFL",SUBSET_REFL; +"SUBSET_RESTRICT",SUBSET_RESTRICT; +"SUBSET_TRANS",SUBSET_TRANS; +"SUBSET_UNION",SUBSET_UNION; +"SUBSET_UNIONS",SUBSET_UNIONS; +"SUBSET_UNION_ABSORPTION",SUBSET_UNION_ABSORPTION; +"SUBSET_UNIV",SUBSET_UNIV; +"SUB_0",SUB_0; +"SUB_ADD",SUB_ADD; +"SUB_ADD_LCANCEL",SUB_ADD_LCANCEL; +"SUB_ADD_RCANCEL",SUB_ADD_RCANCEL; +"SUB_ELIM_THM",SUB_ELIM_THM; +"SUB_ELIM_THM'",SUB_ELIM_THM'; +"SUB_EQ_0",SUB_EQ_0; +"SUB_PRESUC",SUB_PRESUC; +"SUB_REFL",SUB_REFL; +"SUB_SUC",SUB_SUC; +"SUC_DEF",SUC_DEF; +"SUC_INJ",SUC_INJ; +"SUC_SUB1",SUC_SUB1; +"SUM_0",SUM_0; +"SUM_ABS",SUM_ABS; +"SUM_ABS_BOUND",SUM_ABS_BOUND; +"SUM_ABS_LE",SUM_ABS_LE; +"SUM_ABS_NUMSEG",SUM_ABS_NUMSEG; +"SUM_ADD",SUM_ADD; +"SUM_ADD_GEN",SUM_ADD_GEN; +"SUM_ADD_NUMSEG",SUM_ADD_NUMSEG; +"SUM_ADD_SPLIT",SUM_ADD_SPLIT; +"SUM_BIJECTION",SUM_BIJECTION; +"SUM_BOUND",SUM_BOUND; +"SUM_BOUND_GEN",SUM_BOUND_GEN; +"SUM_BOUND_LT",SUM_BOUND_LT; +"SUM_BOUND_LT_ALL",SUM_BOUND_LT_ALL; +"SUM_BOUND_LT_GEN",SUM_BOUND_LT_GEN; +"SUM_CASES",SUM_CASES; +"SUM_CASES_1",SUM_CASES_1; +"SUM_CLAUSES",SUM_CLAUSES; +"SUM_CLAUSES_LEFT",SUM_CLAUSES_LEFT; +"SUM_CLAUSES_NUMSEG",SUM_CLAUSES_NUMSEG; +"SUM_CLAUSES_RIGHT",SUM_CLAUSES_RIGHT; +"SUM_CLOSED",SUM_CLOSED; +"SUM_COMBINE_L",SUM_COMBINE_L; +"SUM_COMBINE_R",SUM_COMBINE_R; +"SUM_CONST",SUM_CONST; +"SUM_CONST_NUMSEG",SUM_CONST_NUMSEG; +"SUM_DEGENERATE",SUM_DEGENERATE; +"SUM_DELETE",SUM_DELETE; +"SUM_DELETE_CASES",SUM_DELETE_CASES; +"SUM_DELTA",SUM_DELTA; +"SUM_DIFF",SUM_DIFF; +"SUM_DIFFS",SUM_DIFFS; +"SUM_DIFFS_ALT",SUM_DIFFS_ALT; +"SUM_EQ",SUM_EQ; +"SUM_EQ_0",SUM_EQ_0; +"SUM_EQ_0_NUMSEG",SUM_EQ_0_NUMSEG; +"SUM_EQ_GENERAL",SUM_EQ_GENERAL; +"SUM_EQ_GENERAL_INVERSES",SUM_EQ_GENERAL_INVERSES; +"SUM_EQ_NUMSEG",SUM_EQ_NUMSEG; +"SUM_EQ_SUPERSET",SUM_EQ_SUPERSET; +"SUM_GROUP",SUM_GROUP; +"SUM_IMAGE",SUM_IMAGE; +"SUM_IMAGE_GEN",SUM_IMAGE_GEN; +"SUM_IMAGE_LE",SUM_IMAGE_LE; +"SUM_IMAGE_NONZERO",SUM_IMAGE_NONZERO; +"SUM_INCL_EXCL",SUM_INCL_EXCL; +"SUM_INJECTION",SUM_INJECTION; +"SUM_LE",SUM_LE; +"SUM_LE_INCLUDED",SUM_LE_INCLUDED; +"SUM_LE_NUMSEG",SUM_LE_NUMSEG; +"SUM_LMUL",SUM_LMUL; +"SUM_LT",SUM_LT; +"SUM_LT_ALL",SUM_LT_ALL; +"SUM_MULTICOUNT",SUM_MULTICOUNT; +"SUM_MULTICOUNT_GEN",SUM_MULTICOUNT_GEN; +"SUM_NEG",SUM_NEG; +"SUM_OFFSET",SUM_OFFSET; +"SUM_OFFSET_0",SUM_OFFSET_0; +"SUM_PAIR",SUM_PAIR; +"SUM_PARTIAL_PRE",SUM_PARTIAL_PRE; +"SUM_PARTIAL_SUC",SUM_PARTIAL_SUC; +"SUM_POS_BOUND",SUM_POS_BOUND; +"SUM_POS_EQ_0",SUM_POS_EQ_0; +"SUM_POS_EQ_0_NUMSEG",SUM_POS_EQ_0_NUMSEG; +"SUM_POS_LE",SUM_POS_LE; +"SUM_POS_LE_NUMSEG",SUM_POS_LE_NUMSEG; +"SUM_POS_LT",SUM_POS_LT; +"SUM_POS_LT_ALL",SUM_POS_LT_ALL; +"SUM_RESTRICT",SUM_RESTRICT; +"SUM_RESTRICT_SET",SUM_RESTRICT_SET; +"SUM_RMUL",SUM_RMUL; +"SUM_SING",SUM_SING; +"SUM_SING_NUMSEG",SUM_SING_NUMSEG; +"SUM_SUB",SUM_SUB; +"SUM_SUBSET",SUM_SUBSET; +"SUM_SUBSET_SIMPLE",SUM_SUBSET_SIMPLE; +"SUM_SUB_NUMSEG",SUM_SUB_NUMSEG; +"SUM_SUM_PRODUCT",SUM_SUM_PRODUCT; +"SUM_SUM_RESTRICT",SUM_SUM_RESTRICT; +"SUM_SUPERSET",SUM_SUPERSET; +"SUM_SUPPORT",SUM_SUPPORT; +"SUM_SWAP",SUM_SWAP; +"SUM_SWAP_NUMSEG",SUM_SWAP_NUMSEG; +"SUM_TRIV_NUMSEG",SUM_TRIV_NUMSEG; +"SUM_UNION",SUM_UNION; +"SUM_UNIONS_NONZERO",SUM_UNIONS_NONZERO; +"SUM_UNION_EQ",SUM_UNION_EQ; +"SUM_UNION_LZERO",SUM_UNION_LZERO; +"SUM_UNION_NONZERO",SUM_UNION_NONZERO; +"SUM_UNION_RZERO",SUM_UNION_RZERO; +"SUM_ZERO_EXISTS",SUM_ZERO_EXISTS; +"SUP",SUP; +"SUPERADMISSIBLE_COND",SUPERADMISSIBLE_COND; +"SUPERADMISSIBLE_CONST",SUPERADMISSIBLE_CONST; +"SUPERADMISSIBLE_MATCH_GUARDED_PATTERN",SUPERADMISSIBLE_MATCH_GUARDED_PATTERN; +"SUPERADMISSIBLE_MATCH_SEQPATTERN",SUPERADMISSIBLE_MATCH_SEQPATTERN; +"SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN",SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN; +"SUPERADMISSIBLE_T",SUPERADMISSIBLE_T; +"SUPERADMISSIBLE_TAIL",SUPERADMISSIBLE_TAIL; +"SUPPORT_CLAUSES",SUPPORT_CLAUSES; +"SUPPORT_DELTA",SUPPORT_DELTA; +"SUPPORT_EMPTY",SUPPORT_EMPTY; +"SUPPORT_SUBSET",SUPPORT_SUBSET; +"SUPPORT_SUPPORT",SUPPORT_SUPPORT; +"SUP_EQ",SUP_EQ; +"SUP_FINITE",SUP_FINITE; +"SUP_FINITE_LEMMA",SUP_FINITE_LEMMA; +"SUP_INSERT_FINITE",SUP_INSERT_FINITE; +"SUP_SING",SUP_SING; +"SUP_UNION",SUP_UNION; +"SUP_UNIQUE",SUP_UNIQUE; +"SUP_UNIQUE_FINITE",SUP_UNIQUE_FINITE; +"SURJ",SURJ; +"SURJECTIVE_EXISTS_THM",SURJECTIVE_EXISTS_THM; +"SURJECTIVE_FORALL_THM",SURJECTIVE_FORALL_THM; +"SURJECTIVE_IFF_INJECTIVE",SURJECTIVE_IFF_INJECTIVE; +"SURJECTIVE_IFF_INJECTIVE_GEN",SURJECTIVE_IFF_INJECTIVE_GEN; +"SURJECTIVE_IMAGE",SURJECTIVE_IMAGE; +"SURJECTIVE_IMAGE_EQ",SURJECTIVE_IMAGE_EQ; +"SURJECTIVE_IMAGE_THM",SURJECTIVE_IMAGE_THM; +"SURJECTIVE_MAP",SURJECTIVE_MAP; +"SURJECTIVE_ON_IMAGE",SURJECTIVE_ON_IMAGE; +"SURJECTIVE_ON_RIGHT_INVERSE",SURJECTIVE_ON_RIGHT_INVERSE; +"SURJECTIVE_RIGHT_INVERSE",SURJECTIVE_RIGHT_INVERSE; +"SWAP_EXISTS_THM",SWAP_EXISTS_THM; +"SWAP_FORALL_THM",SWAP_FORALL_THM; +"TL",TL; +"TOPOLOGICAL_SORT",TOPOLOGICAL_SORT; +"TRANSITIVE_STEPWISE_LE",TRANSITIVE_STEPWISE_LE; +"TRANSITIVE_STEPWISE_LE_EQ",TRANSITIVE_STEPWISE_LE_EQ; +"TRANSITIVE_STEPWISE_LT",TRANSITIVE_STEPWISE_LT; +"TRANSITIVE_STEPWISE_LT_EQ",TRANSITIVE_STEPWISE_LT_EQ; +"TREAL_ADD_ASSOC",TREAL_ADD_ASSOC; +"TREAL_ADD_LDISTRIB",TREAL_ADD_LDISTRIB; +"TREAL_ADD_LID",TREAL_ADD_LID; +"TREAL_ADD_LINV",TREAL_ADD_LINV; +"TREAL_ADD_SYM",TREAL_ADD_SYM; +"TREAL_ADD_SYM_EQ",TREAL_ADD_SYM_EQ; +"TREAL_ADD_WELLDEF",TREAL_ADD_WELLDEF; +"TREAL_ADD_WELLDEFR",TREAL_ADD_WELLDEFR; +"TREAL_EQ_AP",TREAL_EQ_AP; +"TREAL_EQ_IMP_LE",TREAL_EQ_IMP_LE; +"TREAL_EQ_REFL",TREAL_EQ_REFL; +"TREAL_EQ_SYM",TREAL_EQ_SYM; +"TREAL_EQ_TRANS",TREAL_EQ_TRANS; +"TREAL_INV_0",TREAL_INV_0; +"TREAL_INV_WELLDEF",TREAL_INV_WELLDEF; +"TREAL_LE_ANTISYM",TREAL_LE_ANTISYM; +"TREAL_LE_LADD_IMP",TREAL_LE_LADD_IMP; +"TREAL_LE_MUL",TREAL_LE_MUL; +"TREAL_LE_REFL",TREAL_LE_REFL; +"TREAL_LE_TOTAL",TREAL_LE_TOTAL; +"TREAL_LE_TRANS",TREAL_LE_TRANS; +"TREAL_LE_WELLDEF",TREAL_LE_WELLDEF; +"TREAL_MUL_ASSOC",TREAL_MUL_ASSOC; +"TREAL_MUL_LID",TREAL_MUL_LID; +"TREAL_MUL_LINV",TREAL_MUL_LINV; +"TREAL_MUL_SYM",TREAL_MUL_SYM; +"TREAL_MUL_SYM_EQ",TREAL_MUL_SYM_EQ; +"TREAL_MUL_WELLDEF",TREAL_MUL_WELLDEF; +"TREAL_MUL_WELLDEFR",TREAL_MUL_WELLDEFR; +"TREAL_NEG_WELLDEF",TREAL_NEG_WELLDEF; +"TREAL_OF_NUM_ADD",TREAL_OF_NUM_ADD; +"TREAL_OF_NUM_EQ",TREAL_OF_NUM_EQ; +"TREAL_OF_NUM_LE",TREAL_OF_NUM_LE; +"TREAL_OF_NUM_MUL",TREAL_OF_NUM_MUL; +"TREAL_OF_NUM_WELLDEF",TREAL_OF_NUM_WELLDEF; +"TRIV_AND_EXISTS_THM",TRIV_AND_EXISTS_THM; +"TRIV_EXISTS_AND_THM",TRIV_EXISTS_AND_THM; +"TRIV_EXISTS_IMP_THM",TRIV_EXISTS_IMP_THM; +"TRIV_FORALL_IMP_THM",TRIV_FORALL_IMP_THM; +"TRIV_FORALL_OR_THM",TRIV_FORALL_OR_THM; +"TRIV_OR_FORALL_THM",TRIV_OR_FORALL_THM; +"TRUTH",TRUTH; +"TWO",TWO; +"T_DEF",T_DEF; +"UNCURRY_DEF",UNCURRY_DEF; +"UNION",UNION; +"UNIONS",UNIONS; +"UNIONS_0",UNIONS_0; +"UNIONS_1",UNIONS_1; +"UNIONS_2",UNIONS_2; +"UNIONS_DIFF",UNIONS_DIFF; +"UNIONS_GSPEC",UNIONS_GSPEC; +"UNIONS_IMAGE",UNIONS_IMAGE; +"UNIONS_INSERT",UNIONS_INSERT; +"UNIONS_INTERS",UNIONS_INTERS; +"UNIONS_MAXIMAL_SETS",UNIONS_MAXIMAL_SETS; +"UNIONS_MONO",UNIONS_MONO; +"UNIONS_MONO_IMAGE",UNIONS_MONO_IMAGE; +"UNIONS_SUBSET",UNIONS_SUBSET; +"UNIONS_UNION",UNIONS_UNION; +"UNION_ACI",UNION_ACI; +"UNION_ASSOC",UNION_ASSOC; +"UNION_COMM",UNION_COMM; +"UNION_EMPTY",UNION_EMPTY; +"UNION_IDEMPOT",UNION_IDEMPOT; +"UNION_OVER_INTER",UNION_OVER_INTER; +"UNION_SUBSET",UNION_SUBSET; +"UNION_UNIV",UNION_UNIV; +"UNIQUE_SKOLEM_ALT",UNIQUE_SKOLEM_ALT; +"UNIQUE_SKOLEM_THM",UNIQUE_SKOLEM_THM; +"UNIV",UNIV; +"UNIV_GSPEC",UNIV_GSPEC; +"UNIV_NOT_EMPTY",UNIV_NOT_EMPTY; +"UNIV_PCROSS_UNIV",UNIV_PCROSS_UNIV; +"UNIV_SUBSET",UNIV_SUBSET; +"UNWIND_THM1",UNWIND_THM1; +"UNWIND_THM2",UNWIND_THM2; +"WF",WF; +"WF_DCHAIN",WF_DCHAIN; +"WF_EQ",WF_EQ; +"WF_EREC",WF_EREC; +"WF_FALSE",WF_FALSE; +"WF_FINITE",WF_FINITE; +"WF_IND",WF_IND; +"WF_INT_MEASURE",WF_INT_MEASURE; +"WF_INT_MEASURE_2",WF_INT_MEASURE_2; +"WF_LEX",WF_LEX; +"WF_LEX_DEPENDENT",WF_LEX_DEPENDENT; +"WF_MEASURE",WF_MEASURE; +"WF_MEASURE_GEN",WF_MEASURE_GEN; +"WF_POINTWISE",WF_POINTWISE; +"WF_REC",WF_REC; +"WF_REC_CASES",WF_REC_CASES; +"WF_REC_CASES'",WF_REC_CASES'; +"WF_REC_INVARIANT",WF_REC_INVARIANT; +"WF_REC_TAIL",WF_REC_TAIL; +"WF_REC_TAIL_GENERAL",WF_REC_TAIL_GENERAL; +"WF_REC_TAIL_GENERAL'",WF_REC_TAIL_GENERAL'; +"WF_REC_WF",WF_REC_WF; +"WF_REC_num",WF_REC_num; +"WF_REFL",WF_REFL; +"WF_SUBSET",WF_SUBSET; +"WF_UREC",WF_UREC; +"WF_UREC_WF",WF_UREC_WF; +"WF_num",WF_num; +"WLOG_LE",WLOG_LE; +"WLOG_LT",WLOG_LT; +"ZBOT",ZBOT; +"ZCONSTR",ZCONSTR; +"ZCONSTR_ZBOT",ZCONSTR_ZBOT; +"ZERO_DEF",ZERO_DEF; +"ZIP",ZIP; +"ZIP_DEF",ZIP_DEF; +"ZRECSPACE_CASES",ZRECSPACE_CASES; +"ZRECSPACE_INDUCT",ZRECSPACE_INDUCT; +"ZRECSPACE_RULES",ZRECSPACE_RULES; +"_FALSITY_",_FALSITY_; +"_FUNCTION",_FUNCTION; +"_GUARDED_PATTERN",_GUARDED_PATTERN; +"_MATCH",_MATCH; +"_SEQPATTERN",_SEQPATTERN; +"_UNGUARDED_PATTERN",_UNGUARDED_PATTERN; +"admissible",admissible; +"bool_INDUCT",bool_INDUCT; +"bool_RECURSION",bool_RECURSION; +"cart_tybij",cart_tybij; +"char_INDUCT",char_INDUCT; +"char_RECURSION",char_RECURSION; +"cong",cong; +"dest_int_rep",dest_int_rep; +"dimindex",dimindex; +"dist",dist; +"divides",divides; +"eq_c",eq_c; +"finite_image_tybij",finite_image_tybij; +"finite_index",finite_index; +"finite_sum_tybij",finite_sum_tybij; +"fstcart",fstcart; +"ge_c",ge_c; +"gt_c",gt_c; +"hreal_add",hreal_add; +"hreal_add_th",hreal_add_th; +"hreal_inv",hreal_inv; +"hreal_inv_th",hreal_inv_th; +"hreal_le",hreal_le; +"hreal_le_th",hreal_le_th; +"hreal_mul",hreal_mul; +"hreal_mul_th",hreal_mul_th; +"hreal_of_num",hreal_of_num; +"hreal_of_num_th",hreal_of_num_th; +"inf",inf; +"int_abs",int_abs; +"int_abs_th",int_abs_th; +"int_abstr",int_abstr; +"int_add",int_add; +"int_add_th",int_add_th; +"int_congruent",int_congruent; +"int_coprime",int_coprime; +"int_divides",int_divides; +"int_eq",int_eq; +"int_gcd",int_gcd; +"int_ge",int_ge; +"int_gt",int_gt; +"int_le",int_le; +"int_lt",int_lt; +"int_max",int_max; +"int_max_th",int_max_th; +"int_min",int_min; +"int_min_th",int_min_th; +"int_mod",int_mod; +"int_mul",int_mul; +"int_mul_th",int_mul_th; +"int_neg",int_neg; +"int_neg_th",int_neg_th; +"int_of_num",int_of_num; +"int_of_num_th",int_of_num_th; +"int_pow",int_pow; +"int_pow_th",int_pow_th; +"int_rep",int_rep; +"int_sgn",int_sgn; +"int_sgn_th",int_sgn_th; +"int_sub",int_sub; +"int_sub_th",int_sub_th; +"int_tybij",int_tybij; +"integer",integer; +"is_int",is_int; +"is_nadd",is_nadd; +"is_nadd_0",is_nadd_0; +"iterate",iterate; +"lambda",lambda; +"le_c",le_c; +"list_CASES",list_CASES; +"list_INDUCT",list_INDUCT; +"list_RECURSION",list_RECURSION; +"list_of_set",list_of_set; +"lt_c",lt_c; +"minimal",minimal; +"mk_pair_def",mk_pair_def; +"monoidal",monoidal; +"nadd_abs",nadd_abs; +"nadd_add",nadd_add; +"nadd_eq",nadd_eq; +"nadd_inv",nadd_inv; +"nadd_le",nadd_le; +"nadd_mul",nadd_mul; +"nadd_of_num",nadd_of_num; +"nadd_rep",nadd_rep; +"nadd_rinv",nadd_rinv; +"neutral",neutral; +"nsum",nsum; +"num_Axiom",num_Axiom; +"num_CASES",num_CASES; +"num_FINITE",num_FINITE; +"num_FINITE_AVOID",num_FINITE_AVOID; +"num_INDUCTION",num_INDUCTION; +"num_INFINITE",num_INFINITE; +"num_MAX",num_MAX; +"num_RECURSION",num_RECURSION; +"num_RECURSION_STD",num_RECURSION_STD; +"num_WF",num_WF; +"num_WOP",num_WOP; +"num_congruent",num_congruent; +"num_coprime",num_coprime; +"num_divides",num_divides; +"num_gcd",num_gcd; +"num_mod",num_mod; +"num_of_int",num_of_int; +"numseg",numseg; +"o_ASSOC",o_ASSOC; +"o_DEF",o_DEF; +"o_THM",o_THM; +"one",one; +"one_Axiom",one_Axiom; +"one_DEF",one_DEF; +"one_INDUCT",one_INDUCT; +"one_RECURSION",one_RECURSION; +"one_axiom",one_axiom; +"one_tydef",one_tydef; +"option_INDUCT",option_INDUCT; +"option_RECURSION",option_RECURSION; +"pair_INDUCT",pair_INDUCT; +"pair_RECURSION",pair_RECURSION; +"pairwise",pairwise; +"pastecart",pastecart; +"polynomial_function",polynomial_function; +"prod_tybij",prod_tybij; +"real_INFINITE",real_INFINITE; +"real_abs",real_abs; +"real_add",real_add; +"real_add_th",real_add_th; +"real_div",real_div; +"real_ge",real_ge; +"real_gt",real_gt; +"real_inv",real_inv; +"real_inv_th",real_inv_th; +"real_le",real_le; +"real_le_th",real_le_th; +"real_lt",real_lt; +"real_max",real_max; +"real_min",real_min; +"real_mod",real_mod; +"real_mul",real_mul; +"real_mul_th",real_mul_th; +"real_neg",real_neg; +"real_neg_th",real_neg_th; +"real_of_num",real_of_num; +"real_of_num_th",real_of_num_th; +"real_pow",real_pow; +"real_sgn",real_sgn; +"real_sub",real_sub; +"set_of_list",set_of_list; +"sndcart",sndcart; +"string_INFINITE",string_INFINITE; +"sum",sum; +"sum_INDUCT",sum_INDUCT; +"sum_RECURSION",sum_RECURSION; +"sup",sup; +"superadmissible",superadmissible; +"support",support; +"tailadmissible",tailadmissible; +"treal_add",treal_add; +"treal_eq",treal_eq; +"treal_inv",treal_inv; +"treal_le",treal_le; +"treal_mul",treal_mul; +"treal_neg",treal_neg; +"treal_of_num",treal_of_num; +"vector",vector +];; diff --git a/define.ml b/define.ml new file mode 100644 index 0000000..f8ba960 --- /dev/null +++ b/define.ml @@ -0,0 +1,989 @@ +(* ========================================================================= *) +(* Automated support for general recursive definitions. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "cart.ml";; + +(* ------------------------------------------------------------------------- *) +(* Constant supporting casewise definitions. *) +(* ------------------------------------------------------------------------- *) + +let CASEWISE_DEF = new_recursive_definition list_RECURSION + `(CASEWISE [] f x = @y. T) /\ + (CASEWISE (CONS h t) f x = + if ?y. FST h y = x then SND h f (@y. FST h y = x) + else CASEWISE t f x)`;; + +let CASEWISE = prove + (`(CASEWISE [] f x = @y. T) /\ + (CASEWISE (CONS (s,t) clauses) f x = + if ?y. s y = x then t f (@y. s y = x) else CASEWISE clauses f x)`, + REWRITE_TAC[CASEWISE_DEF]);; + +(* ------------------------------------------------------------------------- *) +(* Conditions for all the clauses in a casewise definition to hold. *) +(* ------------------------------------------------------------------------- *) + +let CASEWISE_CASES = prove + (`!clauses c x. + (?s t a. MEM (s,t) clauses /\ (s a = x) /\ + (CASEWISE clauses c x = t c a)) \/ + ~(?s t a. MEM (s,t) clauses /\ (s a = x)) /\ + (CASEWISE clauses c x = @y. T)`, + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[MEM; CASEWISE; FORALL_PAIR_THM; PAIR_EQ] THEN + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[]);; + +let CASEWISE_WORKS = prove + (`!clauses c:C. + (!s t s' t' x y. MEM (s,t) clauses /\ MEM (s',t') clauses /\ (s x = s' y) + ==> (t c x = t' c y)) + ==> ALL (\(s:P->A,t). !x. CASEWISE clauses c (s x) :B = t c x) clauses`, + REWRITE_TAC[GSYM ALL_MEM; FORALL_PAIR_THM] THEN + MESON_TAC[CASEWISE_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Various notions of admissibility, with tail recursion and preconditions. *) +(* ------------------------------------------------------------------------- *) + +let admissible = new_definition + `admissible(<<) p s t <=> + !f g a. p f a /\ p g a /\ (!z. z << s(a) ==> (f z = g z)) + ==> (t f a = t g a)`;; + +let tailadmissible = new_definition + `tailadmissible(<<) p s t <=> + ?P G H. (!f a y. P f a /\ y << G f a ==> y << s a) /\ + (!f g a. (!z. z << s(a) ==> (f z = g z)) + ==> (P f a = P g a) /\ + (G f a = G g a) /\ (H f a = H g a)) /\ + (!f a:P. p f a ==> (t (f:A->B) a = + if P f a then f(G f a) else H f a))`;; + +let superadmissible = new_definition + `superadmissible(<<) p s t <=> + admissible(<<) (\f a. T) s p ==> tailadmissible(<<) p s t`;; + +(* ------------------------------------------------------------------------- *) +(* A lemma. *) +(* ------------------------------------------------------------------------- *) + +let MATCH_SEQPATTERN = prove + (`_MATCH x (_SEQPATTERN r s) = + if ?y. r x y then _MATCH x r else _MATCH x s`, + REWRITE_TAC[_MATCH; _SEQPATTERN] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Admissibility combinators. *) +(* ------------------------------------------------------------------------- *) + +let ADMISSIBLE_CONST = prove + (`!p s c. admissible(<<) p s (\f. c)`, + REWRITE_TAC[admissible]);; + +let ADMISSIBLE_BASE = prove + (`!(<<) p s t. + (!f a. p f a ==> t a << s a) + ==> admissible((<<):A->A->bool) p s (\f:A->B x:P. f(t x))`, + REWRITE_TAC[admissible] THEN MESON_TAC[]);; + +let ADMISSIBLE_COMB = prove + (`!(<<) p s:P->A g:(A->B)->P->C->D y:(A->B)->P->C. + admissible(<<) p s g /\ admissible(<<) p s y + ==> admissible(<<) p s (\f x. (g f x) (y f x))`, + SIMP_TAC[admissible] THEN MESON_TAC[]);; + +let ADMISSIBLE_RAND = prove + (`!(<<) p s:P->A g:P->C->D y:(A->B)->P->C. + admissible(<<) p s y + ==> admissible(<<) p s (\f x. (g x) (y f x))`, + SIMP_TAC[admissible] THEN MESON_TAC[]);; + +let ADMISSIBLE_LAMBDA = prove + (`!(<<) p s:P->A t:(A->B)->C->P->bool. + admissible(<<) (\f (u,x). p f x) (\(u,x). s x) (\f (u,x). t f u x) + ==> admissible(<<) p s (\f x. \u. t f u x)`, + REWRITE_TAC[admissible; FUN_EQ_THM; FORALL_PAIR_THM] THEN MESON_TAC[]);; + +let ADMISSIBLE_NEST = prove + (`!(<<) p s t. + admissible(<<) p s t /\ + (!f a. p f a ==> t f a << s a) + ==> admissible((<<):A->A->bool) p s (\f:A->B x:P. f(t f x))`, + REWRITE_TAC[admissible] THEN MESON_TAC[]);; + +let ADMISSIBLE_COND = prove + (`!(<<) p P s h k. + admissible(<<) p s P /\ + admissible(<<) (\f x. p f x /\ P f x) s h /\ + admissible(<<) (\f x. p f x /\ ~P f x) s k + ==> admissible(<<) p s (\f x:P. if P f x then h f x else k f x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[admissible; AND_FORALL_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let ADMISSIBLE_MATCH = prove + (`!(<<) p s e c. + admissible(<<) p s e /\ admissible(<<) p s (\f x. c f x (e f x)) + ==> admissible(<<) p s (\f x:P. _MATCH (e f x) (c f x))`, + REWRITE_TAC[admissible; _MATCH] THEN + REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN ASM_MESON_TAC[]);; + +let ADMISSIBLE_SEQPATTERN = prove + (`!(<<) p s c1 c2 e. + admissible(<<) p s (\f x:P. ?y. c1 f x (e f x) y) /\ + admissible(<<) (\f x. p f x /\ ?y. c1 f x (e f x) y) s + (\f x. c1 f x (e f x)) /\ + admissible(<<) (\f x. p f x /\ ~(?y. c1 f x (e f x) y)) s + (\f x. c2 f x (e f x)) + ==> admissible(<<) p s (\f x. _SEQPATTERN (c1 f x) (c2 f x) (e f x))`, + REWRITE_TAC[_SEQPATTERN; admissible] THEN MESON_TAC[]);; + +let ADMISSIBLE_UNGUARDED_PATTERN = prove + (`!(<<) p s pat e t y. + admissible (<<) p s pat /\ + admissible (<<) p s e /\ + admissible (<<) (\f x. p f x /\ pat f x = e f x) s t /\ + admissible (<<) (\f x. p f x /\ pat f x = e f x) s y + ==> admissible(<<) p s + (\f x:P. _UNGUARDED_PATTERN (GEQ (pat f x) (e f x)) + (GEQ (t f x) (y f x)))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[admissible; FORALL_PAIR_THM; _UNGUARDED_PATTERN] THEN + REWRITE_TAC[GEQ_DEF] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(TAUT `(a <=> a') /\ (a /\ a' ==> (b <=> b')) + ==> (a /\ b <=> a' /\ b')`) THEN + ASM_MESON_TAC[]);; + +let ADMISSIBLE_GUARDED_PATTERN = prove + (`!(<<) p s pat q e t y. + admissible (<<) p s pat /\ + admissible (<<) p s e /\ + admissible (<<) (\f x. p f x /\ pat f x = e f x /\ q f x) s t /\ + admissible (<<) (\f x. p f x /\ pat f x = e f x) s q /\ + admissible (<<) (\f x. p f x /\ pat f x = e f x /\ q f x) s y + ==> admissible(<<) p s + (\f x:P. _GUARDED_PATTERN (GEQ (pat f x) (e f x)) + (q f x) + (GEQ (t f x) (y f x)))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[admissible; FORALL_PAIR_THM; _GUARDED_PATTERN] THEN + REWRITE_TAC[GEQ_DEF] THEN REPEAT STRIP_TAC THEN + REPEAT(MATCH_MP_TAC(TAUT `(a <=> a') /\ (a /\ a' ==> (b <=> b')) + ==> (a /\ b <=> a' /\ b')`) THEN + REPEAT STRIP_TAC) THEN + TRY(MATCH_MP_TAC(MESON[] `x = x' /\ y = y' ==> (x = y <=> x' = y')`)) THEN + ASM_MESON_TAC[]);; + +let ADMISSIBLE_NSUM = prove + (`!(<<) p:(B->C)->P->bool s:P->A h a b. + admissible(<<) (\f (k,x). a(x) <= k /\ k <= b(x) /\ p f x) + (\(k,x). s x) (\f (k,x). h f x k) + ==> admissible(<<) p s (\f x. nsum(a(x)..b(x)) (h f x))`, + REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC NSUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; + +let ADMISSIBLE_SUM = prove + (`!(<<) p:(B->C)->P->bool s:P->A h a b. + admissible(<<) (\f (k,x). a(x) <= k /\ k <= b(x) /\ p f x) + (\(k,x). s x) (\f (k,x). h f x k) + ==> admissible(<<) p s (\f x. sum(a(x)..b(x)) (h f x))`, + REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_MESON_TAC[]);; + +let ADMISSIBLE_MAP = prove + (`!(<<) p s h l. + admissible(<<) p s l /\ + admissible (<<) (\f (y,x). p f x /\ MEM y (l f x)) + (\(y,x). s x) (\f (y,x). h f x y) + ==> admissible (<<) p s (\f:A->B x:P. MAP (h f x) (l f x))`, + REWRITE_TAC[admissible; FORALL_PAIR_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(MESON[] `x = y /\ MAP f x = MAP g x ==> MAP f x = MAP g y`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MAP_EQ THEN REWRITE_TAC[GSYM ALL_MEM] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[]);; + +let ADMISSIBLE_MATCH_SEQPATTERN = prove + (`!(<<) p s c1 c2 e. + admissible(<<) p s (\f x. ?y. c1 f x (e f x) y) /\ + admissible(<<) (\f x. p f x /\ ?y. c1 f x (e f x) y) s + (\f x. _MATCH (e f x) (c1 f x)) /\ + admissible(<<) (\f x. p f x /\ ~(?y. c1 f x (e f x) y)) s + (\f x. _MATCH (e f x) (c2 f x)) + ==> admissible(<<) p s + (\f x:P. _MATCH (e f x) (_SEQPATTERN (c1 f x) (c2 f x)))`, + REWRITE_TAC[MATCH_SEQPATTERN; ADMISSIBLE_COND]);; + +(* ------------------------------------------------------------------------- *) +(* Superadmissible generalizations where applicable. *) +(* *) +(* Note that we can't take the "higher type" route in the simple theorem *) +(* ADMISSIBLE_MATCH because that isn't a context where tail recursion makes *) +(* sense. Instead, we use specific theorems for the two _MATCH instances. *) +(* Note that also, because of some delicacy over assessing welldefinedness *) +(* of patterns, a special well-formedness hypothesis crops up here. (We need *) +(* to separate it from the function f or we lose the "tail" optimization.) *) +(* ------------------------------------------------------------------------- *) + +let ADMISSIBLE_IMP_SUPERADMISSIBLE = prove + (`!(<<) p s t:(A->B)->P->B. + admissible(<<) p s t ==> superadmissible(<<) p s t`, + REWRITE_TAC[admissible; superadmissible; tailadmissible] THEN + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`\f:A->B x:P. F`; + `\f:A->B. (anything:P->A)`; + `\f:A->B a:P. if p f a then t f a :B else fixed`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let SUPERADMISSIBLE_CONST = prove + (`!p s c. superadmissible(<<) p s (\f. c)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC ADMISSIBLE_IMP_SUPERADMISSIBLE THEN + REWRITE_TAC[ADMISSIBLE_CONST]);; + +let SUPERADMISSIBLE_TAIL = prove + (`!(<<) p s t:(A->B)->P->A. + admissible(<<) p s t /\ + (!f a. p f a ==> !y. y << t f a ==> y << s a) + ==> superadmissible(<<) p s (\f x. f(t f x))`, + REWRITE_TAC[admissible; superadmissible; tailadmissible] THEN + REPEAT STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`\f:A->B x:P. T`; + `\f:A->B a:P. if p f a then t f a :A else s a`; + `\f:A->B. anything:P->B`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let SUPERADMISSIBLE_COND = prove + (`!(<<) p P s h k:(A->B)->P->B. + admissible(<<) p s P /\ + superadmissible(<<) (\f x. p f x /\ P f x) s h /\ + superadmissible(<<) (\f x. p f x /\ ~P f x) s k + ==> superadmissible(<<) p s (\f x. if P f x then h f x else k f x)`, + REWRITE_TAC[superadmissible; admissible] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN CONJUNCTS_THEN MP_TAC th) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> ANTS_TAC THENL [ASM_MESON_TAC[]; MP_TAC th]) THEN + REWRITE_TAC[tailadmissible] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC + [`P1:(A->B)->P->bool`; `G1:(A->B)->P->A`; `H1:(A->B)->P->B`; + `P2:(A->B)->P->bool`; `G2:(A->B)->P->A`; `H2:(A->B)->P->B`] THEN + REWRITE_TAC[TAUT `(a1 /\ b1 /\ c1 ==> a2 /\ b2 /\ c2 ==> x) <=> + (a1 /\ a2) /\ (b1 /\ b2) /\ (c1 /\ c2) ==> x`] THEN + DISCH_THEN(fun th -> + MAP_EVERY EXISTS_TAC + [`\f:A->B a:P. if p f a then if P f a then P2 f a else P1 f a else F`; + `\f:A->B a:P. if p f a then if P f a then G2 f a else G1 f a else z:A`; + `\f:A->B a:P. if p f a then if P f a then H2 f a else H1 f a else w:B`] THEN + MP_TAC th) THEN + REWRITE_TAC[] THEN REPEAT(MATCH_MP_TAC MONO_AND THEN CONJ_TAC) THENL + [ASM_MESON_TAC[]; + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ); + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP; AND_FORALL_THM] THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> DISCH_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +let SUPERADMISSIBLE_MATCH_SEQPATTERN = prove + (`!(<<) p s c1 c2 e. + admissible(<<) p s (\f x. ?y. c1 f x (e f x) y) /\ + superadmissible(<<) (\f x. p f x /\ ?y. c1 f x (e f x) y) s + (\f x. _MATCH (e f x) (c1 f x)) /\ + superadmissible(<<) (\f x. p f x /\ ~(?y. c1 f x (e f x) y)) s + (\f x. _MATCH (e f x) (c2 f x)) + ==> superadmissible(<<) p s + (\f x:P. _MATCH (e f x) (_SEQPATTERN (c1 f x) (c2 f x)))`, + REWRITE_TAC[MATCH_SEQPATTERN; SUPERADMISSIBLE_COND]);; + +let SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN = prove + (`!(<<) p s e:P->D pat:Q->D arg. + (!f a t u. p f a /\ pat t = e a /\ pat u = e a ==> arg a t = arg a u) /\ + (!f a t. p f a /\ pat t = e a ==> !y. y << arg a t ==> y << s a) + ==> superadmissible(<<) p s + (\f:A->B x. _MATCH (e x) + (\u v. ?t. _UNGUARDED_PATTERN (GEQ (pat t) u) + (GEQ (f(arg x t)) v)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[superadmissible] THEN DISCH_TAC THEN + REWRITE_TAC[_UNGUARDED_PATTERN; GEQ_DEF; _MATCH] THEN + REWRITE_TAC[tailadmissible] THEN + SUBGOAL_THEN + `!f:A->B x:P. + p f x ==> ((?!v. ?t:Q. pat t:D = e x /\ f(arg x t) = v) <=> + ?t. pat t = e x)` + (fun th -> SIMP_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`\(f:A->B) x:P. p f x /\ ?t:Q. pat t:D = e x`; + `\f:A->B x:P. arg x (@t. (pat:Q->D) t = e x):A`; + `\(f:A->B) x:P. (@z:B. F)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[admissible]) THEN SIMP_TAC[] THEN + ASM_MESON_TAC[]);; + +let SUPERADMISSIBLE_MATCH_GUARDED_PATTERN = prove + (`!(<<) p s e:P->D pat:Q->D q arg. + (!f a t u. p f a /\ pat t = e a /\ q a t /\ pat u = e a /\ q a u + ==> arg a t = arg a u) /\ + (!f a t. p f a /\ q a t /\ pat t = e a ==> !y. y << arg a t ==> y << s a) + ==> superadmissible(<<) p s + (\f:A->B x. _MATCH (e x) + (\u v. ?t. _GUARDED_PATTERN (GEQ (pat t) u) + (q x t) + (GEQ (f(arg x t)) v)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[superadmissible] THEN DISCH_TAC THEN + REWRITE_TAC[_GUARDED_PATTERN; GEQ_DEF; _MATCH] THEN + REWRITE_TAC[tailadmissible] THEN + SUBGOAL_THEN + `!f:A->B x:P. + p f x ==> ((?!v. ?t:Q. pat t:D = e x /\ q x t /\ f(arg x t) = v) <=> + ?t. pat t = e x /\ q x t)` + (fun th -> SIMP_TAC[th]) THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`\(f:A->B) x:P. p f x /\ ?t:Q. pat t:D = e x /\ q x t`; + `\f:A->B x:P. arg x (@t. (pat:Q->D) t = e x /\ q x t):A`; + `\(f:A->B) x:P. (@z:B. F)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[admissible]) THEN SIMP_TAC[] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Combine general WF/tail recursion theorem with casewise definitions. *) +(* ------------------------------------------------------------------------- *) + +let WF_REC_TAIL_GENERAL' = prove + (`!P G H H'. + WF (<<) /\ + (!f g x. (!z. z << x ==> (f z = g z)) + ==> (P f x <=> P g x) /\ + (G f x = G g x) /\ (H' f x = H' g x)) /\ + (!f x y. P f x /\ y << G f x ==> y << x) /\ + (!f x. H f x = if P f x then f(G f x) else H' f x) + ==> ?f. !x. f x = H f x`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC WF_REC_TAIL_GENERAL THEN ASM_MESON_TAC[]);; + +let WF_REC_CASES = prove + (`!(<<) clauses. + WF((<<):A->A->bool) /\ + ALL (\(s,t). ?P G H. + (!f a y. P f a /\ y << G f a ==> y << s a) /\ + (!f g a. (!z. z << s(a) ==> (f z = g z)) + ==> (P f a = P g a) /\ + (G f a = G g a) /\ (H f a = H g a)) /\ + (!f a:P. t f a = if P f a then f(G f a) else H f a)) + clauses + ==> ?f:A->B. !x. f x = CASEWISE clauses f x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC WF_REC_TAIL_GENERAL' THEN + FIRST_X_ASSUM(MP_TAC o check(is_binary "ALL" o concl)) THEN + SPEC_TAC(`clauses:((P->A)#((A->B)->P->B))list`, + `clauses:((P->A)#((A->B)->P->B))list`) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC) THEN + MATCH_MP_TAC list_INDUCT THEN + REWRITE_TAC[ALL; CASEWISE; FORALL_PAIR_THM] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC + [`\f:A->B x:A. F`; `\f:A->B. anything:A->A`; `\f:A->B x:A. @y:B. T`] THEN + REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC + [`s:P->A`; `t:(A->B)->P->B`; `clauses:((P->A)#((A->B)->P->B))list`] THEN + DISCH_THEN(fun th -> DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN + MAP_EVERY X_GEN_TAC + [`P1:(A->B)->A->bool`; `G1:(A->B)->A->A`; `H1:(A->B)->A->B`; + `P2:(A->B)->P->bool`; `G2:(A->B)->P->A`; `H2:(A->B)->P->B`] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC + `\f:A->B x:A. if ?y:P. s y = x then P2 f (@y. s y = x) else P1 f x:bool` THEN + EXISTS_TAC `\f:A->B x:A. + if ?y:P. s y = x then G2 f (@y. s y = x) else G1 f x:A` THEN + EXISTS_TAC `\f:A->B x:A. if ?y:P. s y = x + then H2 f (@y. s y = x) else H1 f x:B` THEN + ASM_MESON_TAC[]);; + +let WF_REC_CASES' = prove + (`!(<<) clauses. + WF((<<):A->A->bool) /\ + ALL (\(s,t). tailadmissible(<<) (\f a. T) s t) clauses + ==> ?f:A->B. !x. f x = CASEWISE clauses f x`, + REWRITE_TAC[WF_REC_CASES; tailadmissible]);; + +let RECURSION_CASEWISE = prove + (`!clauses. + (?(<<). WF(<<) /\ + ALL (\(s:P->A,t). tailadmissible(<<) (\f a. T) s t) clauses) /\ + (!s t s' t' f x y. MEM (s,t) clauses /\ MEM (s',t') clauses + ==> (s x = s' y) ==> (t f x = t' f y)) + ==> ?f:A->B. ALL (\(s,t). !x. f (s x) = t f x) clauses`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_IMP; CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(CHOOSE_THEN (MP_TAC o MATCH_MP WF_REC_CASES')) THEN + MATCH_MP_TAC MONO_EXISTS THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[CASEWISE_WORKS]);; + +let RECURSION_CASEWISE_PAIRWISE = prove + (`!clauses. + (?(<<). WF (<<) /\ + ALL (\(s,t). tailadmissible(<<) (\f a. T) s t) clauses) /\ + ALL (\(s,t). !f x y. (s x = s y) ==> (t f x = t f y)) clauses /\ + PAIRWISE (\(s,t) (s',t'). !f x y. (s x = s' y) ==> (t f x = t' f y)) + clauses + ==> (?f. ALL (\(s,t). !x. f (s x) = t f x) clauses)`, + let lemma = prove + (`!P. (!x y. P x y ==> P y x) + ==> !l. (!x y. MEM x l /\ MEM y l ==> P x y) <=> + ALL (\x. P x x) l /\ PAIRWISE P l`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; GSYM ALL_MEM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[PAIRWISE; MEM; GSYM ALL_MEM] THEN ASM_MESON_TAC[]) + and paired_lambda = prove + (`(\x. P x) = (\(a,b). P (a,b))`, + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) in + let pth = REWRITE_RULE[FORALL_PAIR_THM; paired_lambda] (ISPEC + `\(s,t) (s',t'). !c x:A y:A. (s x = s' y) ==> (t c x = t' c y)` lemma) in + let cth = prove(lhand(concl pth),MESON_TAC[]) in + REWRITE_TAC[GSYM(MATCH_MP pth cth); RIGHT_IMP_FORALL_THM] THEN + REWRITE_TAC[RECURSION_CASEWISE]);; + +let SUPERADMISSIBLE_T = prove + (`superadmissible(<<) (\f x. T) s t <=> tailadmissible(<<) (\f x. T) s t`, + REWRITE_TAC[superadmissible; admissible]);; + +let RECURSION_SUPERADMISSIBLE = REWRITE_RULE[GSYM SUPERADMISSIBLE_T] + RECURSION_CASEWISE_PAIRWISE;; + +(* ------------------------------------------------------------------------- *) +(* The main suite of functions for justifying recursion. *) +(* ------------------------------------------------------------------------- *) + +let instantiate_casewise_recursion, + pure_prove_recursive_function_exists, + prove_general_recursive_function_exists = + +(* ------------------------------------------------------------------------- *) +(* Make some basic simplification of conjunction of welldefinedness clauses. *) +(* ------------------------------------------------------------------------- *) + + let SIMPLIFY_WELLDEFINEDNESS_CONV = + let LSYM = + GEN_ALL o CONV_RULE(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) o SPEC_ALL + and evensimps = prove + (`((2 * m + 2 = 2 * n + 1) <=> F) /\ + ((2 * m + 1 = 2 * n + 2) <=> F) /\ + ((2 * m = 2 * n + 1) <=> F) /\ + ((2 * m + 1 = 2 * n) <=> F) /\ + ((2 * m = SUC(2 * n)) <=> F) /\ + ((SUC(2 * m) = 2 * n) <=> F)`, + REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN + DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH; EVEN]) in + let allsimps = itlist (mk_rewrites false) + [EQ_ADD_RCANCEL; EQ_ADD_LCANCEL; + EQ_ADD_RCANCEL_0; EQ_ADD_LCANCEL_0; + LSYM EQ_ADD_RCANCEL_0; LSYM EQ_ADD_LCANCEL_0; + EQ_MULT_RCANCEL; EQ_MULT_LCANCEL; + EQT_INTRO(SPEC_ALL EQ_REFL); + ADD_EQ_0; LSYM ADD_EQ_0; + MULT_EQ_0; LSYM MULT_EQ_0; + MULT_EQ_1; LSYM MULT_EQ_1; + ARITH_RULE `(m + n = 1) <=> (m = 1) /\ (n = 0) \/ (m = 0) /\ (n = 1)`; + ARITH_RULE `(1 = m + n) <=> (m = 1) /\ (n = 0) \/ (m = 0) /\ (n = 1)`; + evensimps; ARITH_EQ] [] + and [simp1; simp2; simp3] = map MATCH_MP (CONJUNCTS + (TAUT + `((a <=> F) /\ (b <=> b) ==> ((a ==> b) <=> T)) /\ + ((a <=> a') /\ (a' ==> (b <=> T)) ==> ((a ==> b) <=> T)) /\ + ((a <=> a') /\ (a' ==> (b <=> b')) ==> ((a ==> b) <=> (a' ==> b')))`)) + and false_tm = `F` and and_tm = `(/\)` + and eq_refl = EQT_INTRO(SPEC_ALL EQ_REFL) in + fun tm -> + let net = itlist (net_of_thm false) allsimps (!basic_rectype_net) in + let RECTYPE_ARITH_EQ_CONV = + TOP_SWEEP_CONV(REWRITES_CONV net) THENC + GEN_REWRITE_CONV DEPTH_CONV [AND_CLAUSES; OR_CLAUSES] in + let SIMPLIFY_CASE_DISTINCTNESS_CLAUSE tm = + let avs,bod = strip_forall tm in + let ant,cons = dest_imp bod in + let ath = RECTYPE_ARITH_EQ_CONV ant in + let atm = rand(concl ath) in + let bth = CONJ ath + (if atm = false_tm then REFL cons + else DISCH atm + (PURE_REWRITE_CONV[eq_refl; ASSUME atm] cons)) in + let cth = try simp1 bth with Failure _ -> try simp2 bth + with Failure _ -> simp3 bth in + itlist MK_FORALL avs cth in + (DEPTH_BINOP_CONV and_tm SIMPLIFY_CASE_DISTINCTNESS_CLAUSE THENC + GEN_REWRITE_CONV DEPTH_CONV [FORALL_SIMP; AND_CLAUSES]) tm in + +(* ------------------------------------------------------------------------- *) +(* Simplify an existential question about a pattern. *) +(* ------------------------------------------------------------------------- *) + + let EXISTS_PAT_CONV = + let pth = prove + (`((?y. _UNGUARDED_PATTERN (GEQ s t) (GEQ z y)) <=> s = t) /\ + ((?y. _GUARDED_PATTERN (GEQ s t) g (GEQ z y)) <=> g /\ s = t)`, + REWRITE_TAC[_UNGUARDED_PATTERN; _GUARDED_PATTERN; GEQ_DEF] THEN + MESON_TAC[]) in + let basecnv = GEN_REWRITE_CONV I [pth] + and pushcnv = GEN_REWRITE_CONV I [SWAP_EXISTS_THM] in + let rec EXISTS_PAT_CONV tm = + ((pushcnv THENC BINDER_CONV EXISTS_PAT_CONV) ORELSEC + basecnv) tm in + fun tm -> if is_exists tm then EXISTS_PAT_CONV tm + else failwith "EXISTS_PAT_CONV" in + +(* ------------------------------------------------------------------------- *) +(* Hack a proforma to introduce new pairing or pattern variables. *) +(* ------------------------------------------------------------------------- *) + + let HACK_PROFORMA,EACK_PROFORMA = + let elemma0 = prove + (`((!z. GEQ (f z) (g z)) <=> (!x y. GEQ (f(x,y)) (g(x,y)))) /\ + ((\p. P p) = (\(x,y). P(x,y)))`, + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) + and elemma1 = prove + (`(!P. (!t:A->B->C#D->E. P t) <=> (!t. P (\a b (c,d). t a b d c))) /\ + (!P. (!t:B->C#D->E. P t) <=> (!t. P (\b (c,d). t b d c))) /\ + (!P. (!t:C#D->E. P t) <=> (!t. P (\(c,d). t d c)))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `\a b d c. (t:A->B->C#D->E) a b (c,d)`); + FIRST_X_ASSUM(MP_TAC o SPEC `\b d c. (t:B->C#D->E) b (c,d)`); + FIRST_X_ASSUM(MP_TAC o SPEC `\d c. (t:C#D->E) (c,d)`)] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) in + let HACK_PROFORMA n th = + if n <= 1 then th else + let mkname i = "_P"^string_of_int i in + let ty = end_itlist (fun s t -> mk_type("prod",[s;t])) + (map (mk_vartype o mkname) (1--n)) in + let conv i = + let name = "x"^string_of_int i in + let cnv = ALPHA_CONV (mk_var(name,mk_vartype(mkname i))) in + fun tm -> if is_abs tm & name_of(bndvar tm) <> name + then cnv tm else failwith "conv" in + let convs = FIRST_CONV (map conv (1--n)) in + let th1 = INST_TYPE [ty,`:P`] th in + let th2 = REWRITE_RULE[FORALL_PAIR_THM] th1 in + let th3 = REWRITE_RULE[elemma0; elemma1] th2 in + CONV_RULE(REDEPTH_CONV convs) th3 + and EACK_PROFORMA n th = + if n <= 1 then th else + let mkname i = "_Q"^string_of_int i in + let ty = end_itlist (fun s t -> mk_type("prod",[s;t])) + (map (mk_vartype o mkname) (1--n)) in + let conv i = + let name = "t"^string_of_int i in + let cnv = ALPHA_CONV (mk_var(name,mk_vartype(mkname i))) in + fun tm -> if is_abs tm & name_of(bndvar tm) <> name + then cnv tm else failwith "conv" in + let convs = FIRST_CONV (map conv (1--n)) in + let th1 = INST_TYPE [ty,`:Q`] th in + let th2 = REWRITE_RULE[EXISTS_PAIR_THM] th1 in + let th3 = REWRITE_RULE[elemma1] th2 in + let th4 = REWRITE_RULE[FORALL_PAIR_THM] th3 in + CONV_RULE(REDEPTH_CONV convs) th4 in + HACK_PROFORMA,EACK_PROFORMA in + +(* ------------------------------------------------------------------------- *) +(* Hack and apply. *) +(* ------------------------------------------------------------------------- *) + + let APPLY_PROFORMA_TAC th (asl,w as gl) = + let vs = fst(dest_gabs(body(rand w))) in + let n = 1 + length(fst(splitlist dest_pair vs)) in + (MATCH_MP_TAC(HACK_PROFORMA n th) THEN BETA_TAC) gl in + + let is_pattern p n tm = + try let f,args = strip_comb(snd(strip_exists (body(body tm)))) in + is_const f & name_of f = p & length args = n + with Failure _ -> false in + + let SIMPLIFY_MATCH_WELLDEFINED_TAC = + let pth0 = MESON[] + `(a /\ x = k ==> x = y ==> d) ==> (a /\ x = k /\ y = k ==> d)` + and pth1 = MESON[] + `(a /\ b /\ c /\ x = k ==> x = y ==> d) + ==> (a /\ x = k /\ b /\ y = k /\ c ==> d)` in + REPEAT GEN_TAC THEN + (MATCH_MP_TAC pth1 ORELSE MATCH_MP_TAC pth0) THEN + CONV_TAC(RAND_CONV SIMPLIFY_WELLDEFINEDNESS_CONV) THEN + PURE_REWRITE_TAC + [AND_CLAUSES; IMP_CLAUSES; OR_CLAUSES; EQ_CLAUSES; NOT_CLAUSES] in + + let rec headonly f tm = + match tm with + Comb(s,t) -> headonly f s & headonly f t & not(t = f) + | Abs(x,t) -> headonly f t + | _ -> true in + + let MAIN_ADMISS_TAC (asl,w as gl) = + let had,args = strip_comb w in + if not(is_const had) then failwith "ADMISS_TAC" else + let f,fbod = dest_abs(last args) in + let xtup,bod = dest_gabs fbod in + let hop,args = strip_comb bod in + match (name_of had,name_of hop) with + "superadmissible","COND" + -> APPLY_PROFORMA_TAC SUPERADMISSIBLE_COND gl + | "superadmissible","_MATCH" when + name_of(repeat rator (last args)) = "_SEQPATTERN" + -> (APPLY_PROFORMA_TAC SUPERADMISSIBLE_MATCH_SEQPATTERN THEN + CONV_TAC(ONCE_DEPTH_CONV EXISTS_PAT_CONV)) gl + | "superadmissible","_MATCH" when + is_pattern "_UNGUARDED_PATTERN" 2 (last args) + -> let n = length(fst(strip_exists(body(body(last args))))) in + let th = EACK_PROFORMA n SUPERADMISSIBLE_MATCH_UNGUARDED_PATTERN in + (APPLY_PROFORMA_TAC th THEN CONJ_TAC THENL + [SIMPLIFY_MATCH_WELLDEFINED_TAC; ALL_TAC]) gl + | "superadmissible","_MATCH" when + is_pattern "_GUARDED_PATTERN" 3 (last args) + -> let n = length(fst(strip_exists(body(body(last args))))) in + let th = EACK_PROFORMA n SUPERADMISSIBLE_MATCH_GUARDED_PATTERN in + (APPLY_PROFORMA_TAC th THEN CONJ_TAC THENL + [SIMPLIFY_MATCH_WELLDEFINED_TAC; ALL_TAC]) gl + | "superadmissible",_ when is_comb bod & rator bod = f + -> APPLY_PROFORMA_TAC SUPERADMISSIBLE_TAIL gl + | "admissible","sum" + -> APPLY_PROFORMA_TAC ADMISSIBLE_SUM gl + | "admissible","nsum" + -> APPLY_PROFORMA_TAC ADMISSIBLE_NSUM gl + | "admissible","MAP" + -> APPLY_PROFORMA_TAC ADMISSIBLE_MAP gl + | "admissible","_MATCH" when + name_of(repeat rator (last args)) = "_SEQPATTERN" + -> (APPLY_PROFORMA_TAC ADMISSIBLE_MATCH_SEQPATTERN THEN + CONV_TAC(ONCE_DEPTH_CONV EXISTS_PAT_CONV)) gl + | "admissible","_MATCH" + -> APPLY_PROFORMA_TAC ADMISSIBLE_MATCH gl + | "admissible","_UNGUARDED_PATTERN" + -> APPLY_PROFORMA_TAC ADMISSIBLE_UNGUARDED_PATTERN gl + | "admissible","_GUARDED_PATTERN" + -> APPLY_PROFORMA_TAC ADMISSIBLE_GUARDED_PATTERN gl + | "admissible",_ when is_abs bod + -> APPLY_PROFORMA_TAC ADMISSIBLE_LAMBDA gl + | "admissible",_ when is_comb bod & rator bod = f + -> if free_in f (rand bod) then + APPLY_PROFORMA_TAC ADMISSIBLE_NEST gl + else + APPLY_PROFORMA_TAC ADMISSIBLE_BASE gl + | "admissible",_ when is_comb bod & headonly f bod + -> APPLY_PROFORMA_TAC ADMISSIBLE_COMB gl + | _ -> failwith "MAIN_ADMISS_TAC" in + + let ADMISS_TAC = + CONJ_TAC ORELSE + MATCH_ACCEPT_TAC ADMISSIBLE_CONST ORELSE + MATCH_ACCEPT_TAC SUPERADMISSIBLE_CONST ORELSE + MAIN_ADMISS_TAC ORELSE + MATCH_MP_TAC ADMISSIBLE_IMP_SUPERADMISSIBLE in + +(* ------------------------------------------------------------------------- *) +(* Instantiate the casewise recursion theorem for existential claim. *) +(* Also make a first attempt to simplify the distinctness clause. This may *) +(* yield a theorem with just the wellfoundedness "?(<<)" assumption, or it *) +(* may be that and an additional distinctness one. *) +(* ------------------------------------------------------------------------- *) + + let instantiate_casewise_recursion = + let EXPAND_PAIRED_ALL_CONV = + let pth0,pth1 = (CONJ_PAIR o prove) + (`(ALL (\(s,t). P s t) [a,b] <=> P a b) /\ + (ALL (\(s,t). P s t) (CONS (a,b) l) <=> + P a b /\ ALL (\(s,t). P s t) l)`, + REWRITE_TAC[ALL]) in + let conv0 = REWR_CONV pth0 and conv1 = REWR_CONV pth1 in + let rec conv tm = + try conv0 tm with Failure _ -> + let th = conv1 tm in CONV_RULE (funpow 2 RAND_CONV conv) th in + conv + and LAMBDA_PAIR_CONV = + let rewr1 = GEN_REWRITE_RULE I [GSYM FORALL_PAIR_THM] + and rewr2 = GEN_REWRITE_CONV I [FUN_EQ_THM] in + fun parms tm -> + let parm = end_itlist (curry mk_pair) parms in + let x,bod = dest_abs tm in + let tm' = mk_gabs(parm,vsubst[parm,x] bod) in + let th1 = BETA_CONV(mk_comb(tm,parm)) + and th2 = GEN_BETA_CONV (mk_comb(tm',parm)) in + let th3 = TRANS th1 (SYM th2) in + let th4 = itlist (fun v th -> rewr1 (GEN v th)) + (butlast parms) (GEN (last parms) th3) in + EQ_MP (SYM(rewr2(mk_eq(tm,tm')))) th4 + and FORALL_PAIR_CONV = + let rule = GEN_REWRITE_RULE RAND_CONV [GSYM FORALL_PAIR_THM] in + let rec depair l t = + match l with + [v] -> REFL t + | v::vs -> rule(BINDER_CONV (depair vs) t) in + fun parm parms -> + let p = mk_var("P",mk_fun_ty (type_of parm) bool_ty) in + let tm = list_mk_forall(parms,mk_comb(p,parm)) in + GEN p (SYM(depair parms tm)) in + let ELIM_LISTOPS_CONV = + PURE_REWRITE_CONV[PAIRWISE; ALL; GSYM CONJ_ASSOC; AND_CLAUSES] THENC + TOP_DEPTH_CONV GEN_BETA_CONV in + let tuple_function_existence tm = + let f,def = dest_exists tm in + let domtys0,ranty0 = splitlist dest_fun_ty (type_of f) in + let nargs = + itlist + (max o length o snd o strip_comb o lhs o snd o strip_forall) + (conjuncts(snd(strip_forall def))) 0 in + let domtys,midtys = chop_list nargs domtys0 in + let ranty = itlist mk_fun_ty midtys ranty0 in + if length domtys <= 1 then ASSUME tm else + let dty = end_itlist (fun ty1 ty2 -> mk_type("prod",[ty1;ty2])) domtys in + let f' = variant (frees tm) + (mk_var(fst(dest_var f),mk_fun_ty dty ranty)) in + let gvs = map genvar domtys in + let f'' = list_mk_abs(gvs,mk_comb(f',end_itlist (curry mk_pair) gvs)) in + let def' = subst [f'',f] def in + let th1 = EXISTS (tm,f'') (ASSUME def') + and bth = BETAS_CONV (list_mk_comb(f'',gvs)) in + let th2 = GEN_REWRITE_CONV TOP_DEPTH_CONV [bth] (hd(hyp th1)) in + SIMPLE_CHOOSE f' (PROVE_HYP (UNDISCH(snd(EQ_IMP_RULE th2))) th1) in + let pinstantiate_casewise_recursion def = + try PART_MATCH I EXISTS_REFL def with Failure _ -> + let f,bod = dest_exists def in + let cjs = conjuncts bod in + let eqs = map (snd o strip_forall) cjs in + let lefts,rights = unzip(map dest_eq eqs) in + let arglists = map (snd o strip_comb) lefts in + let parms0 = freesl(unions arglists) in + let parms = if parms0 <> [] then parms0 else [genvar aty] in + let parm = end_itlist (curry mk_pair) parms in + let ss = map (fun a -> mk_gabs(parm,end_itlist (curry mk_pair) a)) + arglists + and ts = map (fun a -> mk_abs(f,mk_gabs(parm,a))) rights in + let clauses = mk_flist(map2 (curry mk_pair) ss ts) in + let pth = ISPEC clauses RECURSION_SUPERADMISSIBLE in + let FIDDLE_CONV = + (LAND_CONV o LAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o + GABS_CONV o RATOR_CONV o LAND_CONV o ABS_CONV) in + let th0 = UNDISCH(CONV_RULE(FIDDLE_CONV(LAMBDA_PAIR_CONV parms)) pth) in + let th1 = EQ_MP (GEN_ALPHA_CONV f (concl th0)) th0 in + let rewr_forall_th = REWR_CONV(FORALL_PAIR_CONV parm parms) in + let th2 = CONV_RULE (BINDER_CONV + (LAND_CONV(GABS_CONV rewr_forall_th) THENC + EXPAND_PAIRED_ALL_CONV)) th1 in + let f2,bod2 = dest_exists(concl th2) in + let ths3 = map + (CONV_RULE (COMB2_CONV (funpow 2 RAND_CONV GEN_BETA_CONV) + (RATOR_CONV BETA_CONV THENC GEN_BETA_CONV)) o SPEC_ALL) + (CONJUNCTS(ASSUME bod2)) in + let ths4 = map2 + (fun th t -> let avs,tbod = strip_forall t in + itlist GEN avs (PART_MATCH I th tbod)) ths3 cjs in + let th5 = SIMPLE_EXISTS f (end_itlist CONJ ths4) in + let th6 = PROVE_HYP th2 (SIMPLE_CHOOSE f th5) in + let th7 = + (RAND_CONV(COMB2_CONV + (RAND_CONV (LAND_CONV (GABS_CONV(BINDER_CONV + (BINDER_CONV(rewr_forall_th) THENC rewr_forall_th))))) + (LAND_CONV (funpow 2 GABS_CONV(BINDER_CONV + (BINDER_CONV(rewr_forall_th) THENC + rewr_forall_th))))) THENC + ELIM_LISTOPS_CONV) (hd(hyp th6)) in + let th8 = PROVE_HYP (UNDISCH(snd(EQ_IMP_RULE th7))) th6 in + let wfasm,cdasm = dest_conj(hd(hyp th8)) in + let th9 = PROVE_HYP (CONJ (ASSUME wfasm) (ASSUME cdasm)) th8 in + let th10 = SIMPLIFY_WELLDEFINEDNESS_CONV cdasm in + let th11 = PROVE_HYP (UNDISCH(snd(EQ_IMP_RULE th10))) th9 in + PROVE_HYP TRUTH th11 in + fun etm -> + let eth = tuple_function_existence etm in + let dtm = hd(hyp eth) in + let dth = pinstantiate_casewise_recursion dtm in + PROVE_HYP dth eth in + +(* ------------------------------------------------------------------------- *) +(* Justify existence assertion and try to simplify/remove side-conditions. *) +(* ------------------------------------------------------------------------- *) + + let pure_prove_recursive_function_exists = + let break_down_admissibility th1 = + if hyp th1 = [] then th1 else + let def = concl th1 in + let f,bod = dest_exists def in + let cjs = conjuncts bod in + let eqs = map (snd o strip_forall) cjs in + let lefts,rights = unzip(map dest_eq eqs) in + let arglists = map (snd o strip_comb) lefts in + let parms0 = freesl(unions arglists) in + let parms = if parms0 <> [] then parms0 else [genvar aty] in + let wfasm = find is_exists (hyp th1) in + let ord,bod = dest_exists wfasm in + let SIMP_ADMISS_TAC = + REWRITE_TAC[LET_DEF; LET_END_DEF] THEN + REPEAT ADMISS_TAC THEN + TRY(W(fun (asl,w) -> let v = fst(dest_forall w) in + X_GEN_TAC v THEN + MAP_EVERY + (fun v -> TRY(GEN_REWRITE_TAC I [FORALL_PAIR_THM]) THEN + X_GEN_TAC v) + parms THEN + CONV_TAC(TOP_DEPTH_CONV GEN_BETA_CONV) THEN + MAP_EVERY (fun v -> SPEC_TAC(v,v)) (rev parms @ [v]))) THEN + PURE_REWRITE_TAC[FORALL_SIMP] THEN + W(fun (asl,w) -> MAP_EVERY (fun t -> SPEC_TAC(t,t)) + (subtract (frees w) [ord])) THEN + W(fun (asl,w) -> ACCEPT_TAC(ASSUME w)) in + let th2 = prove(bod,SIMP_ADMISS_TAC) in + let th3 = SIMPLE_EXISTS ord th2 in + let allasms = hyp th3 and wfasm = lhand(concl th2) in + let th4 = ASSUME(list_mk_conj(wfasm::subtract allasms [wfasm])) in + let th5 = SIMPLE_CHOOSE ord (itlist PROVE_HYP (CONJUNCTS th4) th3) in + PROVE_HYP th5 th1 in + fun dtm -> + let th = break_down_admissibility(instantiate_casewise_recursion dtm) in + if concl th = dtm then th + else failwith "prove_general_recursive_function_exists: sanity" in + +(* ------------------------------------------------------------------------- *) +(* Same, but attempt to prove the wellfoundedness hyp by good guesses. *) +(* ------------------------------------------------------------------------- *) + + let prove_general_recursive_function_exists = + let prove_depth_measure_exists = + let num_ty = `:num` in + fun tyname -> + let _,_,sth = assoc tyname (!inductive_type_store) in + let ty,zty = dest_fun_ty + (type_of(fst(dest_exists(snd(strip_forall(concl sth)))))) in + let rth = INST_TYPE [num_ty,zty] sth in + let avs,bod = strip_forall(concl rth) in + let ev,cbod = dest_exists bod in + let process_clause k t = + let avs,eq = strip_forall t in + let l,r = dest_eq eq in + let fn,cargs = dest_comb l in + let con,args = strip_comb cargs in + let bargs = filter (fun t -> type_of t = ty) args in + let r' = list_mk_binop `(+):num->num->num` + (mk_small_numeral k :: map (curry mk_comb fn) bargs) in + list_mk_forall(avs,mk_eq(l,r')) in + let cjs = conjuncts cbod in + let def = map2 process_clause (1--length cjs) cjs in + prove_recursive_functions_exist sth (list_mk_conj def) in + let INDUCTIVE_MEASURE_THEN tac (asl,w) = + let ev,bod = dest_exists w in + let ty = fst(dest_type(fst(dest_fun_ty(type_of ev)))) in + let th = prove_depth_measure_exists ty in + let ev',bod' = dest_exists(concl th) in + let th' = INST_TYPE(type_match (type_of ev') (type_of ev) []) th in + (MP_TAC th' THEN MATCH_MP_TAC MONO_EXISTS THEN + GEN_TAC THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN tac) (asl,w) in + let CONSTANT_MEASURE_THEN = + let one_tm = `1` in + fun tac (asl,w) -> + let ev,bod = dest_exists w in + let ty = fst(dest_fun_ty(type_of ev)) in + (EXISTS_TAC(mk_abs(genvar ty,one_tm)) THEN tac) (asl,w) in + let GUESS_MEASURE_THEN tac = + (EXISTS_TAC `\n. n + 1` THEN tac) ORELSE + (INDUCTIVE_MEASURE_THEN tac) ORELSE + CONSTANT_MEASURE_THEN tac in + let pth_lexleft = prove + (`(?r. WF(r) /\ + ?s. WF(s) /\ + P(\(x1,y1) (x2,y2). r x1 x2 \/ (x1 = x2) /\ s y1 y2)) + ==> ?t:A#B->A#B->bool. WF(t) /\ P t`, + REPEAT STRIP_TAC THEN EXISTS_TAC + `\(x1:A,y1:B) (x2:A,y2:B). r x1 x2 \/ (x1 = x2) /\ s y1 y2` THEN + ASM_SIMP_TAC[WF_LEX]) in + let pth_lexright = prove + (`(?r. WF(r) /\ + ?s. WF(s) /\ + P(\(x1,y1) (x2,y2). r y1 y2 \/ (y1 = y2) /\ s x1 x2)) + ==> ?t:A#B->A#B->bool. WF(t) /\ P t`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\u:A#B v:A#B. + (\(x1:B,y1:A) (x2:B,y2:A). r x1 x2 \/ (x1 = x2) /\ s y1 y2) + ((\(a,b). b,a) u) ((\(a,b). b,a) v)` THEN + ASM_SIMP_TAC[ISPEC `\(a,b). b,a` WF_MEASURE_GEN; WF_LEX; ETA_AX] THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN + MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC) THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]) in + let pth_measure = prove + (`(?m:A->num. P(MEASURE m)) ==> ?r:A->A->bool. WF(r) /\ P r`, + MESON_TAC[WF_MEASURE]) in + let rec GUESS_WF_THEN tac (asl,w) = + ((MATCH_MP_TAC pth_lexleft THEN GUESS_WF_THEN (GUESS_WF_THEN tac)) ORELSE + (MATCH_MP_TAC pth_lexright THEN GUESS_WF_THEN (GUESS_WF_THEN tac)) ORELSE + (MATCH_MP_TAC pth_measure THEN + REWRITE_TAC[MEASURE; MEASURE_LE] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + GUESS_MEASURE_THEN tac)) (asl,w) in + let PRE_GUESS_TAC = + CONV_TAC(BINDER_CONV(DEPTH_BINOP_CONV `(/\)` + (TRY_CONV SIMPLIFY_WELLDEFINEDNESS_CONV THENC + TRY_CONV FORALL_UNWIND_CONV))) in + let GUESS_ORDERING_TAC = + let false_tm = `\x:A y:A. F` in + W(fun (asl,w) -> + let ty = fst(dest_fun_ty(type_of(fst(dest_exists w)))) in + EXISTS_TAC(inst [ty,aty] false_tm) THEN + REWRITE_TAC[WF_FALSE] THEN NO_TAC) ORELSE + GUESS_WF_THEN + (REWRITE_TAC[FORALL_PAIR_THM] THEN ARITH_TAC) in + fun etm -> + let th = pure_prove_recursive_function_exists etm in + try let wtm = find is_exists (hyp th) in + let wth = prove(wtm,PRE_GUESS_TAC THEN GUESS_ORDERING_TAC) in + PROVE_HYP wth th + with Failure _ -> th in + + instantiate_casewise_recursion, + pure_prove_recursive_function_exists, + prove_general_recursive_function_exists;; + +(* ------------------------------------------------------------------------- *) +(* Simple "define" function. *) +(* ------------------------------------------------------------------------- *) + +let define = + let close_definition_clauses tm = + let avs,bod = strip_forall tm in + let cjs = conjuncts bod in + let fs = + try map (repeat rator o lhs o snd o strip_forall) cjs + with Failure _ -> failwith "close_definition_clauses: non-equation" in + if length (setify fs) <> 1 + then failwith "close_definition_clauses: defining multiple functions" else + let f = hd fs in + if mem f avs then failwith "close_definition_clauses: fn quantified" else + let do_clause t = + let lvs,bod = strip_forall t in + let fvs = subtract (frees(lhs bod)) (f::lvs) in + SPECL fvs (ASSUME(list_mk_forall(fvs,t))) in + let ths = map do_clause cjs in + let ajs = map (hd o hyp) ths in + let th = ASSUME(list_mk_conj ajs) in + f,itlist GEN avs (itlist PROVE_HYP (CONJUNCTS th) (end_itlist CONJ ths)) in + fun tm -> + let tm' = snd(strip_forall tm) in + try let th,th' = tryfind (fun th -> th,PART_MATCH I th tm') + (!the_definitions) in + if can (PART_MATCH I th') (concl th) then + (warn true "Benign redefinition"; th') + else failwith "" + with Failure _ -> + let f,th = close_definition_clauses tm in + let etm = mk_exists(f,hd(hyp th)) in + let th1 = prove_general_recursive_function_exists etm in + let th2 = new_specification[fst(dest_var f)] th1 in + let g = mk_mconst(dest_var f) in + let th3 = PROVE_HYP th2 (INST [g,f] th) in + the_definitions := th3::(!the_definitions); th3;; diff --git a/drule.ml b/drule.ml new file mode 100644 index 0000000..05ae897 --- /dev/null +++ b/drule.ml @@ -0,0 +1,488 @@ +(* ========================================================================= *) +(* More sophisticated derived rules including definitions and rewriting. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "bool.ml";; + +(* ------------------------------------------------------------------------- *) +(* Type of instantiations, with terms, types and higher-order data. *) +(* ------------------------------------------------------------------------- *) + +type instantiation = + (int * term) list * (term * term) list * (hol_type * hol_type) list;; + +(* ------------------------------------------------------------------------- *) +(* The last recourse when all else fails! *) +(* ------------------------------------------------------------------------- *) + +let mk_thm(asl,c) = + let ax = new_axiom(itlist (curry mk_imp) (rev asl) c) in + rev_itlist (fun t th -> MP th (ASSUME t)) (rev asl) ax;; + +(* ------------------------------------------------------------------------- *) +(* Derived congruence rules; very useful things! *) +(* ------------------------------------------------------------------------- *) + +let MK_CONJ = + let andtm = `(/\)` in + fun eq1 eq2 -> MK_COMB(AP_TERM andtm eq1,eq2);; + +let MK_DISJ = + let ortm = `(\/)` in + fun eq1 eq2 -> MK_COMB(AP_TERM ortm eq1,eq2);; + +let MK_FORALL = + let atm = mk_const("!",[]) in + fun v th -> AP_TERM (inst [type_of v,aty] atm) (ABS v th);; + +let MK_EXISTS = + let atm = mk_const("?",[]) in + fun v th -> AP_TERM (inst [type_of v,aty] atm) (ABS v th);; + +(* ------------------------------------------------------------------------- *) +(* Eliminate the antecedent of a theorem using a conversion/proof rule. *) +(* ------------------------------------------------------------------------- *) + +let MP_CONV (cnv:conv) th = + let l,r = dest_imp(concl th) in + let ath = cnv l in + try MP th (EQT_ELIM ath) with Failure _ -> MP th ath;; + +(* ------------------------------------------------------------------------- *) +(* Multiple beta-reduction (we use a slight variant below). *) +(* ------------------------------------------------------------------------- *) + +let rec BETAS_CONV tm = + match tm with + Comb(Abs(_,_),_) -> BETA_CONV tm + | Comb(Comb(_,_),_) -> (RATOR_CONV BETAS_CONV THENC BETA_CONV) tm + | _ -> failwith "BETAS_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Instantiators. *) +(* ------------------------------------------------------------------------- *) + +let (instantiate :instantiation->term->term) = + let betas n tm = + let args,lam = funpow n (fun (l,t) -> (rand t)::l,rator t) ([],tm) in + rev_itlist (fun a l -> let v,b = dest_abs l in vsubst[a,v] b) args lam in + let rec ho_betas bcs pat tm = + if is_var pat or is_const pat then fail() else + try let bv,bod = dest_abs tm in + mk_abs(bv,ho_betas bcs (body pat) bod) + with Failure _ -> + let hop,args = strip_comb pat in + try let n = rev_assoc hop bcs in + if length args = n then betas n tm else fail() + with Failure _ -> + let lpat,rpat = dest_comb pat in + let ltm,rtm = dest_comb tm in + try let lth = ho_betas bcs lpat ltm in + try let rth = ho_betas bcs rpat rtm in + mk_comb(lth,rth) + with Failure _ -> + mk_comb(lth,rtm) + with Failure _ -> + let rth = ho_betas bcs rpat rtm in + mk_comb(ltm,rth) in + fun (bcs,tmin,tyin) tm -> + let itm = if tyin = [] then tm else inst tyin tm in + if tmin = [] then itm else + let ttm = vsubst tmin itm in + if bcs = [] then ttm else + try ho_betas bcs itm ttm with Failure _ -> ttm;; + +let (INSTANTIATE : instantiation->thm->thm) = + let rec BETAS_CONV n tm = + if n = 1 then TRY_CONV BETA_CONV tm else + (RATOR_CONV (BETAS_CONV (n-1)) THENC + TRY_CONV BETA_CONV) tm in + let rec HO_BETAS bcs pat tm = + if is_var pat or is_const pat then fail() else + try let bv,bod = dest_abs tm in + ABS bv (HO_BETAS bcs (body pat) bod) + with Failure _ -> + let hop,args = strip_comb pat in + try let n = rev_assoc hop bcs in + if length args = n then BETAS_CONV n tm else fail() + with Failure _ -> + let lpat,rpat = dest_comb pat in + let ltm,rtm = dest_comb tm in + try let lth = HO_BETAS bcs lpat ltm in + try let rth = HO_BETAS bcs rpat rtm in + MK_COMB(lth,rth) + with Failure _ -> + AP_THM lth rtm + with Failure _ -> + let rth = HO_BETAS bcs rpat rtm in + AP_TERM ltm rth in + fun (bcs,tmin,tyin) th -> + let ith = if tyin = [] then th else INST_TYPE tyin th in + if tmin = [] then ith else + let tth = INST tmin ith in + if hyp tth = hyp th then + if bcs = [] then tth else + try let eth = HO_BETAS bcs (concl ith) (concl tth) in + EQ_MP eth tth + with Failure _ -> tth + else failwith "INSTANTIATE: term or type var free in assumptions";; + +let (INSTANTIATE_ALL : instantiation->thm->thm) = + fun ((_,tmin,tyin) as i) th -> + if tmin = [] & tyin = [] then th else + let hyps = hyp th in + if hyps = [] then INSTANTIATE i th else + let tyrel,tyiirel = + if tyin = [] then [],hyps else + let tvs = itlist (union o tyvars o snd) tyin [] in + partition (fun tm -> let tvs' = type_vars_in_term tm in + not(intersect tvs tvs' = [])) hyps in + let tmrel,tmirrel = + if tmin = [] then [],tyiirel else + let vs = itlist (union o frees o snd) tmin [] in + partition (fun tm -> let vs' = frees tm in + not (intersect vs vs' = [])) tyiirel in + let rhyps = union tyrel tmrel in + let th1 = rev_itlist DISCH rhyps th in + let th2 = INSTANTIATE i th1 in + funpow (length rhyps) UNDISCH th2;; + +(* ------------------------------------------------------------------------- *) +(* Higher order matching of terms. *) +(* *) +(* Note: in the event of spillover patterns, this may return false results; *) +(* but there's usually an implicit check outside that the match worked *) +(* anyway. A test could be put in (see if any "env" variables are left in *) +(* the term after abstracting out the pattern instances) but it'd be slower. *) +(* ------------------------------------------------------------------------- *) + +let (term_match:term list -> term -> term -> instantiation) = + let safe_inserta ((y,x) as n) l = + try let z = rev_assoc x l in + if aconv y z then l else failwith "safe_inserta" + with Failure "find" -> n::l in + + let safe_insert ((y,x) as n) l = + try let z = rev_assoc x l in + if Pervasives.compare y z = 0 then l else failwith "safe_insert" + with Failure "find" -> n::l in + + let mk_dummy = + let name = fst(dest_var(genvar aty)) in + fun ty -> mk_var(name,ty) in + + let rec term_pmatch lconsts env vtm ctm ((insts,homs) as sofar) = + match (vtm,ctm) with + Var(_,_),_ -> + (try let ctm' = rev_assoc vtm env in + if Pervasives.compare ctm' ctm = 0 then sofar + else failwith "term_pmatch" + with Failure "find" -> + if mem vtm lconsts then + if Pervasives.compare ctm vtm = 0 then sofar + else failwith "term_pmatch: can't instantiate local constant" + else safe_inserta (ctm,vtm) insts,homs) + | Const(vname,vty),Const(cname,cty) -> + if Pervasives.compare vname cname = 0 then + if Pervasives.compare vty cty = 0 then sofar + else safe_insert (mk_dummy cty,mk_dummy vty) insts,homs + else failwith "term_pmatch" + | Abs(vv,vbod),Abs(cv,cbod) -> + let sofar' = safe_insert + (mk_dummy(snd(dest_var cv)),mk_dummy(snd(dest_var vv))) insts,homs in + term_pmatch lconsts ((cv,vv)::env) vbod cbod sofar' + | _ -> + let vhop = repeat rator vtm in + if is_var vhop & not (mem vhop lconsts) & + not (can (rev_assoc vhop) env) then + let vty = type_of vtm and cty = type_of ctm in + let insts' = + if Pervasives.compare vty cty = 0 then insts + else safe_insert (mk_dummy cty,mk_dummy vty) insts in + (insts',(env,ctm,vtm)::homs) + else + let lv,rv = dest_comb vtm + and lc,rc = dest_comb ctm in + let sofar' = term_pmatch lconsts env lv lc sofar in + term_pmatch lconsts env rv rc sofar' in + + let get_type_insts insts = + itlist (fun (t,x) -> type_match (snd(dest_var x)) (type_of t)) insts in + + let separate_insts insts = + let realinsts,patterns = partition (is_var o snd) insts in + let betacounts = + if patterns = [] then [] else + itlist + (fun (_,p) sof -> + let hop,args = strip_comb p in + try safe_insert (length args,hop) sof with Failure _ -> + (warn true "Inconsistent patterning in higher order match"; sof)) + patterns [] in + let tyins = get_type_insts realinsts [] in + betacounts, + mapfilter (fun (t,x) -> + let x' = let xn,xty = dest_var x in + mk_var(xn,type_subst tyins xty) in + if Pervasives.compare t x' = 0 then fail() else (t,x')) realinsts, + tyins in + + let rec term_homatch lconsts tyins (insts,homs) = + if homs = [] then insts else + let (env,ctm,vtm) = hd homs in + if is_var vtm then + if Pervasives.compare ctm vtm = 0 + then term_homatch lconsts tyins (insts,tl homs) else + let newtyins = safe_insert (type_of ctm,snd(dest_var vtm)) tyins + and newinsts = (ctm,vtm)::insts in + term_homatch lconsts newtyins (newinsts,tl homs) else + let vhop,vargs = strip_comb vtm in + let afvs = freesl vargs in + let inst_fn = inst tyins in + try let tmins = map + (fun a -> (try rev_assoc a env with Failure _ -> try + rev_assoc a insts with Failure _ -> + if mem a lconsts then a else fail()), + inst_fn a) afvs in + let pats0 = map inst_fn vargs in + let pats = map (vsubst tmins) pats0 in + let vhop' = inst_fn vhop in + let ni = + let chop,cargs = strip_comb ctm in + if Pervasives.compare cargs pats = 0 then + if Pervasives.compare chop vhop = 0 + then insts else safe_inserta (chop,vhop) insts else + let ginsts = map + (fun p -> (if is_var p then p else genvar(type_of p)),p) pats in + let ctm' = subst ginsts ctm + and gvs = map fst ginsts in + let abstm = list_mk_abs(gvs,ctm') in + let vinsts = safe_inserta (abstm,vhop) insts in + let icpair = ctm',list_mk_comb(vhop',gvs) in + icpair::vinsts in + term_homatch lconsts tyins (ni,tl homs) + with Failure _ -> + let lc,rc = dest_comb ctm + and lv,rv = dest_comb vtm in + let pinsts_homs' = + term_pmatch lconsts env rv rc (insts,(env,lc,lv)::(tl homs)) in + let tyins' = get_type_insts (fst pinsts_homs') [] in + term_homatch lconsts tyins' pinsts_homs' in + + fun lconsts vtm ctm -> + let pinsts_homs = term_pmatch lconsts [] vtm ctm ([],[]) in + let tyins = get_type_insts (fst pinsts_homs) [] in + let insts = term_homatch lconsts tyins pinsts_homs in + separate_insts insts;; + +(* ------------------------------------------------------------------------- *) +(* First order unification (no type instantiation -- yet). *) +(* ------------------------------------------------------------------------- *) + +let (term_unify:term list -> term -> term -> instantiation) = + let augment1 sofar (s,x) = + let s' = subst sofar s in + if vfree_in x s & not (s = x) then failwith "augment_insts" + else (s',x) in + let raw_augment_insts p insts = + p::(map (augment1 [p]) insts) in + let augment_insts(t,v) insts = + let t' = vsubst insts t in + if t' = v then insts + else if vfree_in v t' then failwith "augment_insts" + else raw_augment_insts (t',v) insts in + let rec unify vars tm1 tm2 sofar = + if tm1 = tm2 then sofar + else if is_var tm1 & mem tm1 vars then + try let tm1' = rev_assoc tm1 sofar in + unify vars tm1' tm2 sofar + with Failure "find" -> + augment_insts (tm2,tm1) sofar + else if is_var tm2 & mem tm2 vars then + try let tm2' = rev_assoc tm2 sofar in + unify vars tm1 tm2' sofar + with Failure "find" -> + augment_insts (tm1,tm2) sofar + else if is_abs tm1 then + let tm1' = body tm1 + and tm2' = subst [bndvar tm1,bndvar tm2] (body tm2) in + unify vars tm1' tm2' sofar + else + let l1,r1 = dest_comb tm1 + and l2,r2 = dest_comb tm2 in + unify vars l1 l2 (unify vars r1 r2 sofar) in + fun vars tm1 tm2 -> [],unify vars tm1 tm2 [],[];; + +(* ------------------------------------------------------------------------- *) +(* Modify bound variable names at depth. (Not very efficient...) *) +(* ------------------------------------------------------------------------- *) + +let deep_alpha = + let tryalpha v tm = + try alpha v tm + with Failure _ -> try + let v' = variant (frees tm) v in + alpha v' tm + with Failure _ -> tm in + let rec deep_alpha env tm = + if env = [] then tm else + try let v,bod = dest_abs tm in + let vn,vty = dest_var v in + try let (vn',_),newenv = remove (fun (_,x) -> x = vn) env in + let v' = mk_var(vn',vty) in + let tm' = tryalpha v' tm in + let iv,ib = dest_abs tm' in + mk_abs(iv,deep_alpha newenv ib) + with Failure _ -> mk_abs(v,deep_alpha env bod) + with Failure _ -> try + let l,r = dest_comb tm in + mk_comb(deep_alpha env l,deep_alpha env r) + with Failure _ -> tm in + deep_alpha;; + +(* ------------------------------------------------------------------------- *) +(* Instantiate theorem by matching part of it to a term. *) +(* The GEN_PART_MATCH version renames free vars to avoid clashes. *) +(* ------------------------------------------------------------------------- *) + +let PART_MATCH,GEN_PART_MATCH = + let rec match_bvs t1 t2 acc = + try let v1,b1 = dest_abs t1 + and v2,b2 = dest_abs t2 in + let n1 = fst(dest_var v1) and n2 = fst(dest_var v2) in + let newacc = if n1 = n2 then acc else insert (n1,n2) acc in + match_bvs b1 b2 newacc + with Failure _ -> try + let l1,r1 = dest_comb t1 + and l2,r2 = dest_comb t2 in + match_bvs l1 l2 (match_bvs r1 r2 acc) + with Failure _ -> acc in + let PART_MATCH partfn th = + let sth = SPEC_ALL th in + let bod = concl sth in + let pbod = partfn bod in + let lconsts = intersect (frees (concl th)) (freesl(hyp th)) in + fun tm -> + let bvms = match_bvs tm pbod [] in + let abod = deep_alpha bvms bod in + let ath = EQ_MP (ALPHA bod abod) sth in + let insts = term_match lconsts (partfn abod) tm in + let fth = INSTANTIATE insts ath in + if hyp fth <> hyp ath then failwith "PART_MATCH: instantiated hyps" else + let tm' = partfn (concl fth) in + if Pervasives.compare tm' tm = 0 then fth else + try SUBS[ALPHA tm' tm] fth + with Failure _ -> failwith "PART_MATCH: Sanity check failure" + and GEN_PART_MATCH partfn th = + let sth = SPEC_ALL th in + let bod = concl sth in + let pbod = partfn bod in + let lconsts = intersect (frees (concl th)) (freesl(hyp th)) in + let fvs = subtract (subtract (frees bod) (frees pbod)) lconsts in + fun tm -> + let bvms = match_bvs tm pbod [] in + let abod = deep_alpha bvms bod in + let ath = EQ_MP (ALPHA bod abod) sth in + let insts = term_match lconsts (partfn abod) tm in + let eth = INSTANTIATE insts (GENL fvs ath) in + let fth = itlist (fun v th -> snd(SPEC_VAR th)) fvs eth in + if hyp fth <> hyp ath then failwith "PART_MATCH: instantiated hyps" else + let tm' = partfn (concl fth) in + if Pervasives.compare tm' tm = 0 then fth else + try SUBS[ALPHA tm' tm] fth + with Failure _ -> failwith "PART_MATCH: Sanity check failure" in + PART_MATCH,GEN_PART_MATCH;; + +(* ------------------------------------------------------------------------- *) +(* Matching modus ponens. *) +(* ------------------------------------------------------------------------- *) + +let MATCH_MP ith = + let sth = + try let tm = concl ith in + let avs,bod = strip_forall tm in + let ant,con = dest_imp bod in + let svs,pvs = partition (C vfree_in ant) avs in + if pvs = [] then ith else + let th1 = SPECL avs (ASSUME tm) in + let th2 = GENL svs (DISCH ant (GENL pvs (UNDISCH th1))) in + MP (DISCH tm th2) ith + with Failure _ -> failwith "MATCH_MP: Not an implication" in + let match_fun = PART_MATCH (fst o dest_imp) sth in + fun th -> try MP (match_fun (concl th)) th + with Failure _ -> failwith "MATCH_MP: No match";; + +(* ------------------------------------------------------------------------- *) +(* Useful instance of more general higher order matching. *) +(* ------------------------------------------------------------------------- *) + +let HIGHER_REWRITE_CONV = + let BETA_VAR = + let rec BETA_CONVS n = + if n = 1 then TRY_CONV BETA_CONV else + RATOR_CONV (BETA_CONVS (n - 1)) THENC TRY_CONV BETA_CONV in + let rec free_beta v tm = + if is_abs tm then + let bv,bod = dest_abs tm in + if v = bv then failwith "unchanged" else + ABS_CONV(free_beta v bod) else + let op,args = strip_comb tm in + if args = [] then failwith "unchanged" else + if op = v then BETA_CONVS (length args) else + let l,r = dest_comb tm in + try let lconv = free_beta v l in + (try let rconv = free_beta v r in + COMB2_CONV lconv rconv + with Failure _ -> RATOR_CONV lconv) + with Failure _ -> RAND_CONV (free_beta v r) in + free_beta in + let GINST th = + let fvs = subtract (frees(concl th)) (freesl (hyp th)) in + let gvs = map (genvar o type_of) fvs in + INST (zip gvs fvs) th in + fun ths -> + let thl = map (GINST o SPEC_ALL) ths in + let concs = map concl thl in + let lefts = map lhs concs in + let preds,pats = unzip(map dest_comb lefts) in + let beta_fns = map2 BETA_VAR preds concs in + let ass_list = zip pats (zip preds (zip thl beta_fns)) in + let mnet = itlist (fun p n -> enter [] (p,p) n) pats empty_net in + let look_fn t = + mapfilter (fun p -> if can (term_match [] p) t then p else fail()) + (lookup t mnet) in + fun top tm -> + let pred t = not (look_fn t = []) & free_in t tm in + let stm = if top then find_term pred tm + else hd(sort free_in (find_terms pred tm)) in + let pat = hd(look_fn stm) in + let _,tmin,tyin = term_match [] pat stm in + let pred,(th,beta_fn) = assoc pat ass_list in + let gv = genvar(type_of stm) in + let abs = mk_abs(gv,subst[gv,stm] tm) in + let _,tmin0,tyin0 = term_match [] pred abs in + CONV_RULE beta_fn (INST tmin (INST tmin0 (INST_TYPE tyin0 th)));; + +(* ------------------------------------------------------------------------- *) +(* Derived principle of definition justifying |- c x1 .. xn = t[x1,..,xn] *) +(* ------------------------------------------------------------------------- *) + +let new_definition tm = + let avs,bod = strip_forall tm in + let l,r = try dest_eq bod + with Failure _ -> failwith "new_definition: Not an equation" in + let lv,largs = strip_comb l in + let rtm = try list_mk_abs(largs,r) + with Failure _ -> failwith "new_definition: Non-variable in LHS pattern" in + let def = mk_eq(lv,rtm) in + let th1 = new_basic_definition def in + let th2 = rev_itlist + (fun tm th -> let ith = AP_THM th tm in + TRANS ith (BETA_CONV(rand(concl ith)))) largs th1 in + let rvs = filter (not o C mem avs) largs in + itlist GEN rvs (itlist GEN avs th2);; diff --git a/equal.ml b/equal.ml new file mode 100644 index 0000000..f267083 --- /dev/null +++ b/equal.ml @@ -0,0 +1,334 @@ +(* ========================================================================= *) +(* Basic equality reasoning including conversionals. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "printer.ml";; + +(* ------------------------------------------------------------------------- *) +(* Type abbreviation for conversions. *) +(* ------------------------------------------------------------------------- *) + +type conv = term->thm;; + +(* ------------------------------------------------------------------------- *) +(* A bit more syntax. *) +(* ------------------------------------------------------------------------- *) + +let lhand = rand o rator;; + +let lhs = fst o dest_eq;; + +let rhs = snd o dest_eq;; + +(* ------------------------------------------------------------------------- *) +(* Similar to variant, but even avoids constants, and ignores types. *) +(* ------------------------------------------------------------------------- *) + +let mk_primed_var = + let rec svariant avoid s = + if mem s avoid or (can get_const_type s & not(is_hidden s)) then + svariant avoid (s^"'") + else s in + fun avoid v -> + let s,ty = dest_var v in + let s' = svariant (mapfilter (fst o dest_var) avoid) s in + mk_var(s',ty);; + +(* ------------------------------------------------------------------------- *) +(* General case of beta-conversion. *) +(* ------------------------------------------------------------------------- *) + +let BETA_CONV tm = + try BETA tm with Failure _ -> + try let f,arg = dest_comb tm in + let v = bndvar f in + INST [arg,v] (BETA (mk_comb(f,v))) + with Failure _ -> failwith "BETA_CONV: Not a beta-redex";; + +(* ------------------------------------------------------------------------- *) +(* A few very basic derived equality rules. *) +(* ------------------------------------------------------------------------- *) + +let AP_TERM tm = + let rth = REFL tm in + fun th -> try MK_COMB(rth,th) + with Failure _ -> failwith "AP_TERM";; + +let AP_THM th tm = + try MK_COMB(th,REFL tm) + with Failure _ -> failwith "AP_THM";; + +let SYM th = + let tm = concl th in + let l,r = dest_eq tm in + let lth = REFL l in + EQ_MP (MK_COMB(AP_TERM (rator (rator tm)) th,lth)) lth;; + +let ALPHA tm1 tm2 = + try TRANS (REFL tm1) (REFL tm2) + with Failure _ -> failwith "ALPHA";; + +let ALPHA_CONV v tm = + let res = alpha v tm in + ALPHA tm res;; + +let GEN_ALPHA_CONV v tm = + if is_abs tm then ALPHA_CONV v tm else + let b,abs = dest_comb tm in + AP_TERM b (ALPHA_CONV v abs);; + +let MK_BINOP op = + let afn = AP_TERM op in + fun (lth,rth) -> MK_COMB(afn lth,rth);; + +(* ------------------------------------------------------------------------- *) +(* Terminal conversion combinators. *) +(* ------------------------------------------------------------------------- *) + +let (NO_CONV:conv) = fun tm -> failwith "NO_CONV";; + +let (ALL_CONV:conv) = REFL;; + +(* ------------------------------------------------------------------------- *) +(* Combinators for sequencing, trying, repeating etc. conversions. *) +(* ------------------------------------------------------------------------- *) + +let ((THENC):conv -> conv -> conv) = + fun conv1 conv2 t -> + let th1 = conv1 t in + let th2 = conv2 (rand(concl th1)) in + TRANS th1 th2;; + +let ((ORELSEC):conv -> conv -> conv) = + fun conv1 conv2 t -> + try conv1 t with Failure _ -> conv2 t;; + +let (FIRST_CONV:conv list -> conv) = end_itlist (fun c1 c2 -> c1 ORELSEC c2);; + +let (EVERY_CONV:conv list -> conv) = + fun l -> itlist (fun c1 c2 -> c1 THENC c2) l ALL_CONV;; + +let REPEATC = + let rec REPEATC conv t = + ((conv THENC (REPEATC conv)) ORELSEC ALL_CONV) t in + (REPEATC:conv->conv);; + +let (CHANGED_CONV:conv->conv) = + fun conv tm -> + let th = conv tm in + let l,r = dest_eq (concl th) in + if aconv l r then failwith "CHANGED_CONV" else th;; + +let TRY_CONV conv = conv ORELSEC ALL_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Subterm conversions. *) +(* ------------------------------------------------------------------------- *) + +let (RATOR_CONV:conv->conv) = + fun conv tm -> + match tm with + Comb(l,r) -> AP_THM (conv l) r + | _ -> failwith "RATOR_CONV: Not a combination";; + +let (RAND_CONV:conv->conv) = + fun conv tm -> + match tm with + Comb(l,r) -> MK_COMB(REFL l,conv r) + | _ -> failwith "RAND_CONV: Not a combination";; + +let LAND_CONV = RATOR_CONV o RAND_CONV;; + +let (COMB2_CONV: conv->conv->conv) = + fun lconv rconv tm -> + match tm with + Comb(l,r) -> MK_COMB(lconv l,rconv r) + | _ -> failwith "COMB2_CONV: Not a combination";; + +let COMB_CONV = W COMB2_CONV;; + +let (ABS_CONV:conv->conv) = + fun conv tm -> + let v,bod = dest_abs tm in + let th = conv bod in + try ABS v th with Failure _ -> + let gv = genvar(type_of v) in + let gbod = vsubst[gv,v] bod in + let gth = ABS gv (conv gbod) in + let gtm = concl gth in + let l,r = dest_eq gtm in + let v' = variant (frees gtm) v in + let l' = alpha v' l and r' = alpha v' r in + EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth;; + +let BINDER_CONV conv tm = + if is_abs tm then ABS_CONV conv tm + else RAND_CONV(ABS_CONV conv) tm;; + +let SUB_CONV conv tm = + match tm with + Comb(_,_) -> COMB_CONV conv tm + | Abs(_,_) -> ABS_CONV conv tm + | _ -> REFL tm;; + +let BINOP_CONV conv tm = + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + MK_COMB(AP_TERM op (conv l),conv r);; + +(* ------------------------------------------------------------------------- *) +(* Depth conversions; internal use of a failure-propagating `Boultonized' *) +(* version to avoid a great deal of reuilding of terms. *) +(* ------------------------------------------------------------------------- *) + +let (ONCE_DEPTH_CONV: conv->conv), + (DEPTH_CONV: conv->conv), + (REDEPTH_CONV: conv->conv), + (TOP_DEPTH_CONV: conv->conv), + (TOP_SWEEP_CONV: conv->conv) = + let THENQC conv1 conv2 tm = + try let th1 = conv1 tm in + try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 + with Failure _ -> th1 + with Failure _ -> conv2 tm + and THENCQC conv1 conv2 tm = + let th1 = conv1 tm in + try let th2 = conv2(rand(concl th1)) in TRANS th1 th2 + with Failure _ -> th1 + and COMB_QCONV conv tm = + match tm with + Comb(l,r) -> + (try let th1 = conv l in + try let th2 = conv r in MK_COMB(th1,th2) + with Failure _ -> AP_THM th1 r + with Failure _ -> AP_TERM l (conv r)) + | _ -> failwith "COMB_QCONV: Not a combination" in + let rec REPEATQC conv tm = THENCQC conv (REPEATQC conv) tm in + let SUB_QCONV conv tm = + match tm with + Abs(_,_) -> ABS_CONV conv tm + | _ -> COMB_QCONV conv tm in + let rec ONCE_DEPTH_QCONV conv tm = + (conv ORELSEC (SUB_QCONV (ONCE_DEPTH_QCONV conv))) tm + and DEPTH_QCONV conv tm = + THENQC (SUB_QCONV (DEPTH_QCONV conv)) + (REPEATQC conv) tm + and REDEPTH_QCONV conv tm = + THENQC (SUB_QCONV (REDEPTH_QCONV conv)) + (THENCQC conv (REDEPTH_QCONV conv)) tm + and TOP_DEPTH_QCONV conv tm = + THENQC (REPEATQC conv) + (THENCQC (SUB_QCONV (TOP_DEPTH_QCONV conv)) + (THENCQC conv (TOP_DEPTH_QCONV conv))) tm + and TOP_SWEEP_QCONV conv tm = + THENQC (REPEATQC conv) + (SUB_QCONV (TOP_SWEEP_QCONV conv)) tm in + (fun c -> TRY_CONV (ONCE_DEPTH_QCONV c)), + (fun c -> TRY_CONV (DEPTH_QCONV c)), + (fun c -> TRY_CONV (REDEPTH_QCONV c)), + (fun c -> TRY_CONV (TOP_DEPTH_QCONV c)), + (fun c -> TRY_CONV (TOP_SWEEP_QCONV c));; + +(* ------------------------------------------------------------------------- *) +(* Apply at leaves of op-tree; NB any failures at leaves cause failure. *) +(* ------------------------------------------------------------------------- *) + +let rec DEPTH_BINOP_CONV op conv tm = + match tm with + Comb(Comb(op',l),r) when Pervasives.compare op' op = 0 -> + let l,r = dest_binop op tm in + let lth = DEPTH_BINOP_CONV op conv l + and rth = DEPTH_BINOP_CONV op conv r in + MK_COMB(AP_TERM op' lth,rth) + | _ -> conv tm;; + +(* ------------------------------------------------------------------------- *) +(* Follow a path. *) +(* ------------------------------------------------------------------------- *) + +let PATH_CONV = + let rec path_conv s cnv = + match s with + [] -> cnv + | "l"::t -> RATOR_CONV (path_conv t cnv) + | "r"::t -> RAND_CONV (path_conv t cnv) + | _::t -> ABS_CONV (path_conv t cnv) in + fun s cnv -> path_conv (explode s) cnv;; + +(* ------------------------------------------------------------------------- *) +(* Follow a pattern *) +(* ------------------------------------------------------------------------- *) + +let PAT_CONV = + let rec PCONV xs pat conv = + if mem pat xs then conv + else if not(exists (fun x -> free_in x pat) xs) then ALL_CONV + else if is_comb pat then + COMB2_CONV (PCONV xs (rator pat) conv) (PCONV xs (rand pat) conv) + else + ABS_CONV (PCONV xs (body pat) conv) in + fun pat -> let xs,pbod = strip_abs pat in PCONV xs pbod;; + +(* ------------------------------------------------------------------------- *) +(* Symmetry conversion. *) +(* ------------------------------------------------------------------------- *) + +let SYM_CONV tm = + try let th1 = SYM(ASSUME tm) in + let tm' = concl th1 in + let th2 = SYM(ASSUME tm') in + DEDUCT_ANTISYM_RULE th2 th1 + with Failure _ -> failwith "SYM_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Conversion to a rule. *) +(* ------------------------------------------------------------------------- *) + +let CONV_RULE (conv:conv) th = + EQ_MP (conv(concl th)) th;; + +(* ------------------------------------------------------------------------- *) +(* Substitution conversion. *) +(* ------------------------------------------------------------------------- *) + +let SUBS_CONV ths tm = + try if ths = [] then REFL tm else + let lefts = map (lhand o concl) ths in + let gvs = map (genvar o type_of) lefts in + let pat = subst (zip gvs lefts) tm in + let abs = list_mk_abs(gvs,pat) in + let th = rev_itlist + (fun y x -> CONV_RULE (RAND_CONV BETA_CONV THENC LAND_CONV BETA_CONV) + (MK_COMB(x,y))) ths (REFL abs) in + if rand(concl th) = tm then REFL tm else th + with Failure _ -> failwith "SUBS_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Get a few rules. *) +(* ------------------------------------------------------------------------- *) + +let BETA_RULE = CONV_RULE(REDEPTH_CONV BETA_CONV);; + +let GSYM = CONV_RULE(ONCE_DEPTH_CONV SYM_CONV);; + +let SUBS ths = CONV_RULE (SUBS_CONV ths);; + +(* ------------------------------------------------------------------------- *) +(* A cacher for conversions. *) +(* ------------------------------------------------------------------------- *) + +let CACHE_CONV = + let ALPHA_HACK th = + let tm' = lhand(concl th) in + fun tm -> if tm' = tm then th else TRANS (ALPHA tm tm') th in + fun conv -> + let net = ref empty_net in + fun tm -> try tryfind (fun f -> f tm) (lookup tm (!net)) + with Failure _ -> + let th = conv tm in + (net := enter [] (tm,ALPHA_HACK th) (!net); th);; diff --git a/grobner.ml b/grobner.ml new file mode 100644 index 0000000..53817f5 --- /dev/null +++ b/grobner.ml @@ -0,0 +1,698 @@ +(* ========================================================================= *) +(* Generic Grobner basis algorithm. *) +(* *) +(* Whatever the instantiation, it basically solves the universal theory of *) +(* the complex numbers, or equivalently something like the theory of all *) +(* commutative cancellation semirings with no nilpotent elements and having *) +(* characteristic zero. We could do "all rings" by a more elaborate integer *) +(* version of Grobner bases, but I don't have any useful applications. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "normalizer.ml";; + +(* ------------------------------------------------------------------------- *) +(* Type for recording history, i.e. how a polynomial was obtained. *) +(* ------------------------------------------------------------------------- *) + +type history = + Start of int + | Mmul of (num * (int list)) * history + | Add of history * history;; + +(* ------------------------------------------------------------------------- *) +(* Overall function; everything else is local. *) +(* ------------------------------------------------------------------------- *) + +let RING_AND_IDEAL_CONV = + + (* ----------------------------------------------------------------------- *) + (* Monomial ordering. *) + (* ----------------------------------------------------------------------- *) + + let morder_lt = + let rec lexorder l1 l2 = + match (l1,l2) with + [],[] -> false + | (x1::o1,x2::o2) -> x1 > x2 or x1 = x2 & lexorder o1 o2 + | _ -> failwith "morder: inconsistent monomial lengths" in + fun m1 m2 -> let n1 = itlist (+) m1 0 + and n2 = itlist (+) m2 0 in + n1 < n2 or n1 = n2 & lexorder m1 m2 in + + (* ----------------------------------------------------------------------- *) + (* Arithmetic on canonical polynomials. *) + (* ----------------------------------------------------------------------- *) + + let grob_neg = map (fun (c,m) -> (minus_num c,m)) in + + let rec grob_add l1 l2 = + match (l1,l2) with + ([],l2) -> l2 + | (l1,[]) -> l1 + | ((c1,m1)::o1,(c2,m2)::o2) -> + if m1 = m2 then + let c = c1+/c2 and rest = grob_add o1 o2 in + if c =/ num_0 then rest else (c,m1)::rest + else if morder_lt m2 m1 then (c1,m1)::(grob_add o1 l2) + else (c2,m2)::(grob_add l1 o2) in + + let grob_sub l1 l2 = grob_add l1 (grob_neg l2) in + + let grob_mmul (c1,m1) (c2,m2) = (c1*/c2,map2 (+) m1 m2) in + + let rec grob_cmul cm pol = map (grob_mmul cm) pol in + + let rec grob_mul l1 l2 = + match l1 with + [] -> [] + | (h1::t1) -> grob_add (grob_cmul h1 l2) (grob_mul t1 l2) in + + let grob_inv l = + match l with + [c,vs] when forall (fun x -> x = 0) vs -> + if c =/ num_0 then failwith "grob_inv: division by zero" + else [num_1 // c,vs] + | _ -> failwith "grob_inv: non-constant divisor polynomial" in + + let grob_div l1 l2 = + match l2 with + [c,l] when forall (fun x -> x = 0) l -> + if c =/ num_0 then failwith "grob_div: division by zero" + else grob_cmul (num_1 // c,l) l1 + | _ -> failwith "grob_div: non-constant divisor polynomial" in + + let rec grob_pow vars l n = + if n < 0 then failwith "grob_pow: negative power" + else if n = 0 then [num_1,map (fun v -> 0) vars] + else grob_mul l (grob_pow vars l (n - 1)) in + + (* ----------------------------------------------------------------------- *) + (* Monomial division operation. *) + (* ----------------------------------------------------------------------- *) + + let mdiv (c1,m1) (c2,m2) = + (c1//c2, + map2 (fun n1 n2 -> if n1 < n2 then failwith "mdiv" else n1-n2) m1 m2) in + + (* ----------------------------------------------------------------------- *) + (* Lowest common multiple of two monomials. *) + (* ----------------------------------------------------------------------- *) + + let mlcm (c1,m1) (c2,m2) = (num_1,map2 max m1 m2) in + + (* ----------------------------------------------------------------------- *) + (* Reduce monomial cm by polynomial pol, returning replacement for cm. *) + (* ----------------------------------------------------------------------- *) + + let reduce1 cm (pol,hpol) = + match pol with + [] -> failwith "reduce1" + | cm1::cms -> try let (c,m) = mdiv cm cm1 in + (grob_cmul (minus_num c,m) cms, + Mmul((minus_num c,m),hpol)) + with Failure _ -> failwith "reduce1" in + + (* ----------------------------------------------------------------------- *) + (* Try this for all polynomials in a basis. *) + (* ----------------------------------------------------------------------- *) + + let reduceb cm basis = tryfind (fun p -> reduce1 cm p) basis in + + (* ----------------------------------------------------------------------- *) + (* Reduction of a polynomial (always picking largest monomial possible). *) + (* ----------------------------------------------------------------------- *) + + let rec reduce basis (pol,hist) = + match pol with + [] -> (pol,hist) + | cm::ptl -> try let q,hnew = reduceb cm basis in + reduce basis (grob_add q ptl,Add(hnew,hist)) + with Failure _ -> + let q,hist' = reduce basis (ptl,hist) in + cm::q,hist' in + + (* ----------------------------------------------------------------------- *) + (* Check for orthogonality w.r.t. LCM. *) + (* ----------------------------------------------------------------------- *) + + let orthogonal l p1 p2 = + snd l = snd(grob_mmul (hd p1) (hd p2)) in + + (* ----------------------------------------------------------------------- *) + (* Compute S-polynomial of two polynomials. *) + (* ----------------------------------------------------------------------- *) + + let spoly cm ph1 ph2 = + match (ph1,ph2) with + ([],h),p -> ([],h) + | p,([],h) -> ([],h) + | (cm1::ptl1,his1),(cm2::ptl2,his2) -> + (grob_sub (grob_cmul (mdiv cm cm1) ptl1) + (grob_cmul (mdiv cm cm2) ptl2), + Add(Mmul(mdiv cm cm1,his1), + Mmul(mdiv (minus_num(fst cm),snd cm) cm2,his2))) in + + (* ----------------------------------------------------------------------- *) + (* Make a polynomial monic. *) + (* ----------------------------------------------------------------------- *) + + let monic (pol,hist) = + if pol = [] then (pol,hist) else + let c',m' = hd pol in + (map (fun (c,m) -> (c//c',m)) pol, + Mmul((num_1 // c',map (K 0) m'),hist)) in + + (* ----------------------------------------------------------------------- *) + (* The most popular heuristic is to order critical pairs by LCM monomial. *) + (* ----------------------------------------------------------------------- *) + + let forder ((c1,m1),_) ((c2,m2),_) = morder_lt m1 m2 in + + (* ----------------------------------------------------------------------- *) + (* Stupid stuff forced on us by lack of equality test on num type. *) + (* ----------------------------------------------------------------------- *) + + let rec poly_lt p q = + match (p,q) with + p,[] -> false + | [],q -> true + | (c1,m1)::o1,(c2,m2)::o2 -> + c1 c1 =/ c2 & m1 = m2) p1 p2 in + + let memx ((p1,h1),(p2,h2)) ppairs = + not (exists (fun ((q1,_),(q2,_)) -> poly_eq p1 q1 & poly_eq p2 q2) + ppairs) in + + (* ----------------------------------------------------------------------- *) + (* Buchberger's second criterion. *) + (* ----------------------------------------------------------------------- *) + + let criterion2 basis (lcm,((p1,h1),(p2,h2))) opairs = + exists (fun g -> not(poly_eq (fst g) p1) & not(poly_eq (fst g) p2) & + can (mdiv lcm) (hd(fst g)) & + not(memx (align(g,(p1,h1))) (map snd opairs)) & + not(memx (align(g,(p2,h2))) (map snd opairs))) basis in + + (* ----------------------------------------------------------------------- *) + (* Test for hitting constant polynomial. *) + (* ----------------------------------------------------------------------- *) + + let constant_poly p = + length p = 1 & forall ((=) 0) (snd(hd p)) in + + (* ----------------------------------------------------------------------- *) + (* Grobner basis algorithm. *) + (* ----------------------------------------------------------------------- *) + + let rec grobner_basis basis pairs = + Format.print_string(string_of_int(length basis)^" basis elements and "^ + string_of_int(length pairs)^" critical pairs"); + Format.print_newline(); + match pairs with + [] -> basis + | (l,(p1,p2))::opairs -> + let (sp,hist as sph) = monic (reduce basis (spoly l p1 p2)) in + if sp = [] or criterion2 basis (l,(p1,p2)) opairs + then grobner_basis basis opairs else + if constant_poly sp then grobner_basis (sph::basis) [] else + let rawcps = + map (fun p -> mlcm (hd(fst p)) (hd sp),align(p,sph)) basis in + let newcps = filter + (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) rawcps in + grobner_basis (sph::basis) + (merge forder opairs (mergesort forder newcps)) in + + (* ----------------------------------------------------------------------- *) + (* Interreduce initial polynomials. *) + (* ----------------------------------------------------------------------- *) + + let rec grobner_interreduce rpols ipols = + match ipols with + [] -> map monic (rev rpols) + | p::ps -> let p' = reduce (rpols @ ps) p in + if fst p' = [] then grobner_interreduce rpols ps + else grobner_interreduce (p'::rpols) ps in + + (* ----------------------------------------------------------------------- *) + (* Overall function. *) + (* ----------------------------------------------------------------------- *) + + let grobner pols = + let npols = map2 (fun p n -> p,Start n) pols (0--(length pols - 1)) in + let phists = filter (fun (p,_) -> p <> []) npols in + let bas = grobner_interreduce [] (map monic phists) in + let prs0 = allpairs (fun x y -> x,y) bas bas in + let prs1 = filter (fun ((x,_),(y,_)) -> poly_lt x y) prs0 in + let prs2 = map (fun (p,q) -> mlcm (hd(fst p)) (hd(fst q)),(p,q)) prs1 in + let prs3 = + filter (fun (l,(p,q)) -> not(orthogonal l (fst p) (fst q))) prs2 in + grobner_basis bas (mergesort forder prs3) in + + (* ----------------------------------------------------------------------- *) + (* Get proof of contradiction from Grobner basis. *) + (* ----------------------------------------------------------------------- *) + + let grobner_refute pols = + let gb = grobner pols in + snd(find (fun (p,h) -> length p = 1 & forall ((=)0) (snd(hd p))) gb) in + + (* ----------------------------------------------------------------------- *) + (* Turn proof into a certificate as sum of multipliers. *) + (* *) + (* In principle this is very inefficient: in a heavily shared proof it may *) + (* make the same calculation many times. Could add a cache or something. *) + (* ----------------------------------------------------------------------- *) + + let rec resolve_proof vars prf = + match prf with + Start(-1) -> [] + | Start m -> [m,[num_1,map (K 0) vars]] + | Mmul(pol,lin) -> + let lis = resolve_proof vars lin in + map (fun (n,p) -> n,grob_cmul pol p) lis + | Add(lin1,lin2) -> + let lis1 = resolve_proof vars lin1 + and lis2 = resolve_proof vars lin2 in + let dom = setify(union (map fst lis1) (map fst lis2)) in + map (fun n -> let a = try assoc n lis1 with Failure _ -> [] + and b = try assoc n lis2 with Failure _ -> [] in + n,grob_add a b) dom in + + (* ----------------------------------------------------------------------- *) + (* Run the procedure and produce Weak Nullstellensatz certificate. *) + (* ----------------------------------------------------------------------- *) + + let grobner_weak vars pols = + let cert = resolve_proof vars (grobner_refute pols) in + let l = + itlist (itlist (lcm_num o denominator o fst) o snd) cert (num_1) in + l,map (fun (i,p) -> i,map (fun (d,m) -> (l*/d,m)) p) cert in + + (* ----------------------------------------------------------------------- *) + (* Prove polynomial is in ideal generated by others, using Grobner basis. *) + (* ----------------------------------------------------------------------- *) + + let grobner_ideal vars pols pol = + let pol',h = reduce (grobner pols) (grob_neg pol,Start(-1)) in + if pol' <> [] then failwith "grobner_ideal: not in the ideal" else + resolve_proof vars h in + + (* ----------------------------------------------------------------------- *) + (* Produce Strong Nullstellensatz certificate for a power of pol. *) + (* ----------------------------------------------------------------------- *) + + let grobner_strong vars pols pol = + if pol = [] then 1,num_1,[] else + let vars' = (concl TRUTH)::vars in + let grob_z = [num_1,1::(map (fun x -> 0) vars)] + and grob_1 = [num_1,(map (fun x -> 0) vars')] + and augment = map (fun (c,m) -> (c,0::m)) in + let pols' = map augment pols + and pol' = augment pol in + let allpols = (grob_sub (grob_mul grob_z pol') grob_1)::pols' in + let l,cert = grobner_weak vars' allpols in + let d = itlist (itlist (max o hd o snd) o snd) cert 0 in + let transform_monomial (c,m) = + grob_cmul (c,tl m) (grob_pow vars pol (d - hd m)) in + let transform_polynomial q = itlist (grob_add o transform_monomial) q [] in + let cert' = map (fun (c,q) -> c-1,transform_polynomial q) + (filter (fun (k,_) -> k <> 0) cert) in + d,l,cert' in + + (* ----------------------------------------------------------------------- *) + (* Overall parametrized universal procedure for (semi)rings. *) + (* We return an IDEAL_CONV and the actual ring prover. *) + (* ----------------------------------------------------------------------- *) + + let pth_step = prove + (`!(add:A->A->A) (mul:A->A->A) (n0:A). + (!x. mul n0 x = n0) /\ + (!x y z. (add x y = add x z) <=> (y = z)) /\ + (!w x y z. (add (mul w y) (mul x z) = add (mul w z) (mul x y)) <=> + (w = x) \/ (y = z)) + ==> (!a b c d. ~(a = b) /\ ~(c = d) <=> + ~(add (mul a c) (mul b d) = + add (mul a d) (mul b c))) /\ + (!n a b c d. ~(n = n0) + ==> (a = b) /\ ~(c = d) + ==> ~(add a (mul n c) = add b (mul n d)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM DE_MORGAN_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`n0:A`; `n:A`; `d:A`; `c:A`]) THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN ASM_SIMP_TAC[]) + and FINAL_RULE = MATCH_MP(TAUT `(p ==> F) ==> (~q = p) ==> q`) + and false_tm = `F` in + let rec refute_disj rfn tm = + match tm with + Comb(Comb(Const("\\/",_),l),r) -> + DISJ_CASES (ASSUME tm) (refute_disj rfn l) (refute_disj rfn r) + | _ -> rfn tm in + fun (ring_dest_const,ring_mk_const,RING_EQ_CONV, + ring_neg_tm,ring_add_tm,ring_sub_tm, + ring_inv_tm,ring_mul_tm,ring_div_tm,ring_pow_tm, + RING_INTEGRAL,RABINOWITSCH_THM,RING_NORMALIZE_CONV) -> + let INITIAL_CONV = + TOP_DEPTH_CONV BETA_CONV THENC + PRESIMP_CONV THENC + CONDS_ELIM_CONV THENC + NNF_CONV THENC + (if is_iff(snd(strip_forall(concl RABINOWITSCH_THM))) + then GEN_REWRITE_CONV ONCE_DEPTH_CONV [RABINOWITSCH_THM] + else ALL_CONV) THENC + GEN_REWRITE_CONV REDEPTH_CONV + [AND_FORALL_THM; + LEFT_AND_FORALL_THM; + RIGHT_AND_FORALL_THM; + LEFT_OR_FORALL_THM; + RIGHT_OR_FORALL_THM; + OR_EXISTS_THM; + LEFT_OR_EXISTS_THM; + RIGHT_OR_EXISTS_THM; + LEFT_AND_EXISTS_THM; + RIGHT_AND_EXISTS_THM] in + let ring_dest_neg t = + let l,r = dest_comb t in + if l = ring_neg_tm then r else failwith "ring_dest_neg" + and ring_dest_inv t = + let l,r = dest_comb t in + if l = ring_inv_tm then r else failwith "ring_dest_inv" + and ring_dest_add = dest_binop ring_add_tm + and ring_mk_add = mk_binop ring_add_tm + and ring_dest_sub = dest_binop ring_sub_tm + and ring_dest_mul = dest_binop ring_mul_tm + and ring_mk_mul = mk_binop ring_mul_tm + and ring_dest_div = dest_binop ring_div_tm + and ring_dest_pow = dest_binop ring_pow_tm + and ring_mk_pow = mk_binop ring_pow_tm in + let rec grobvars tm acc = + if can ring_dest_const tm then acc + else if can ring_dest_neg tm then grobvars (rand tm) acc + else if can ring_dest_pow tm & is_numeral (rand tm) + then grobvars (lhand tm) acc + else if can ring_dest_add tm or can ring_dest_sub tm + or can ring_dest_mul tm + then grobvars (lhand tm) (grobvars (rand tm) acc) + else if can ring_dest_inv tm then + let gvs = grobvars (rand tm) [] in + if gvs = [] then acc else tm::acc + else if can ring_dest_div tm then + let lvs = grobvars (lhand tm) acc + and gvs = grobvars (rand tm) [] in + if gvs = [] then lvs else tm::acc + else tm::acc in + let rec grobify_term vars tm = + try if not(mem tm vars) then failwith "" else + [num_1,map (fun i -> if i = tm then 1 else 0) vars] + with Failure _ -> try + let x = ring_dest_const tm in + if x =/ num_0 then [] else [x,map (fun v -> 0) vars] + with Failure _ -> try + grob_neg(grobify_term vars (ring_dest_neg tm)) + with Failure _ -> try + grob_inv(grobify_term vars (ring_dest_inv tm)) + with Failure _ -> try + let l,r = ring_dest_add tm in + grob_add (grobify_term vars l) (grobify_term vars r) + with Failure _ -> try + let l,r = ring_dest_sub tm in + grob_sub (grobify_term vars l) (grobify_term vars r) + with Failure _ -> try + let l,r = ring_dest_mul tm in + grob_mul (grobify_term vars l) (grobify_term vars r) + with Failure _ -> try + let l,r = ring_dest_div tm in + grob_div (grobify_term vars l) (grobify_term vars r) + with Failure _ -> try + let l,r = ring_dest_pow tm in + grob_pow vars (grobify_term vars l) (dest_small_numeral r) + with Failure _ -> + failwith "grobify_term: unknown or invalid term" in + let grobify_equation vars tm = + let l,r = dest_eq tm in + grob_sub (grobify_term vars l) (grobify_term vars r) in + let grobify_equations tm = + let cjs = conjuncts tm in + let rawvars = + itlist (fun eq a -> grobvars (lhand eq) (grobvars (rand eq) a)) + cjs [] in + let vars = sort (fun x y -> x < y) (setify rawvars) in + vars,map (grobify_equation vars) cjs in + let holify_polynomial = + let holify_varpow (v,n) = + if n = 1 then v else ring_mk_pow v (mk_small_numeral n) in + let holify_monomial vars (c,m) = + let xps = map holify_varpow + (filter (fun (_,n) -> n <> 0) (zip vars m)) in + end_itlist ring_mk_mul (ring_mk_const c :: xps) in + let holify_polynomial vars p = + if p = [] then ring_mk_const (num_0) + else end_itlist ring_mk_add (map (holify_monomial vars) p) in + holify_polynomial in + let (pth_idom,pth_ine) = CONJ_PAIR(MATCH_MP pth_step RING_INTEGRAL) in + let IDOM_RULE = CONV_RULE(REWR_CONV pth_idom) in + let PROVE_NZ n = EQF_ELIM(RING_EQ_CONV + (mk_eq(ring_mk_const n,ring_mk_const(num_0)))) in + let NOT_EQ_01 = PROVE_NZ (num_1) + and INE_RULE n = MATCH_MP(MATCH_MP pth_ine (PROVE_NZ n)) + and MK_ADD th1 th2 = MK_COMB(AP_TERM ring_add_tm th1,th2) in + let execute_proof vars eths prf = + let x,th1 = SPEC_VAR(CONJUNCT1(CONJUNCT2 RING_INTEGRAL)) in + let y,th2 = SPEC_VAR th1 in + let z,th3 = SPEC_VAR th2 in + let SUB_EQ_RULE = GEN_REWRITE_RULE I + [SYM(INST [mk_comb(ring_neg_tm,z),x] th3)] in + let initpols = map (CONV_RULE(BINOP_CONV RING_NORMALIZE_CONV) o + SUB_EQ_RULE) eths in + let ADD_RULE th1 th2 = + CONV_RULE (BINOP_CONV RING_NORMALIZE_CONV) + (MK_COMB(AP_TERM ring_add_tm th1,th2)) + and MUL_RULE vars m th = + CONV_RULE (BINOP_CONV RING_NORMALIZE_CONV) + (AP_TERM (mk_comb(ring_mul_tm,holify_polynomial vars [m])) + th) in + let execache = ref [] in + let memoize prf x = (execache := (prf,x)::(!execache)); x in + let rec assoceq a l = + match l with + [] -> failwith "assoceq" + | (x,y)::t -> if x==a then y else assoceq a t in + let rec run_proof vars prf = + try assoceq prf (!execache) with Failure _ -> + (match prf with + Start m -> el m initpols + | Add(p1,p2) -> + memoize prf (ADD_RULE (run_proof vars p1) (run_proof vars p2)) + | Mmul(m,p2) -> + memoize prf (MUL_RULE vars m (run_proof vars p2))) in + let th = run_proof vars prf in + execache := []; CONV_RULE RING_EQ_CONV th in + let REFUTE tm = + if tm = false_tm then ASSUME tm else + let nths0,eths0 = partition (is_neg o concl) (CONJUNCTS(ASSUME tm)) in + let nths = filter (is_eq o rand o concl) nths0 + and eths = filter (is_eq o concl) eths0 in + if eths = [] then + let th1 = end_itlist (fun th1 th2 -> IDOM_RULE(CONJ th1 th2)) nths in + let th2 = CONV_RULE(RAND_CONV(BINOP_CONV RING_NORMALIZE_CONV)) th1 in + let l,r = dest_eq(rand(concl th2)) in + EQ_MP (EQF_INTRO th2) (REFL l) + else if nths = [] & not(is_var ring_neg_tm) then + let vars,pols = grobify_equations(list_mk_conj(map concl eths)) in + execute_proof vars eths (grobner_refute pols) + else + let vars,l,cert,noteqth = + if nths = [] then + let vars,pols = grobify_equations(list_mk_conj(map concl eths)) in + let l,cert = grobner_weak vars pols in + vars,l,cert,NOT_EQ_01 + else + let nth = end_itlist + (fun th1 th2 -> IDOM_RULE(CONJ th1 th2)) nths in + let vars,pol::pols = + grobify_equations(list_mk_conj(rand(concl nth)::map concl eths)) in + let deg,l,cert = grobner_strong vars pols pol in + let th1 = + CONV_RULE(RAND_CONV(BINOP_CONV RING_NORMALIZE_CONV)) nth in + let th2 = funpow deg (IDOM_RULE o CONJ th1) NOT_EQ_01 in + vars,l,cert,th2 in + Format.print_string("Translating certificate to HOL inferences"); + Format.print_newline(); + let cert_pos = map + (fun (i,p) -> i,filter (fun (c,m) -> c >/ num_0) p) cert + and cert_neg = map + (fun (i,p) -> i,map (fun (c,m) -> minus_num c,m) + (filter (fun (c,m) -> c i,holify_polynomial vars p) cert_pos + and herts_neg = + map (fun (i,p) -> i,holify_polynomial vars p) cert_neg in + let thm_fn pols = + if pols = [] then REFL(ring_mk_const num_0) else + end_itlist MK_ADD + (map (fun (i,p) -> AP_TERM(mk_comb(ring_mul_tm,p)) (el i eths)) + pols) in + let th1 = thm_fn herts_pos and th2 = thm_fn herts_neg in + let th3 = CONJ(MK_ADD (SYM th1) th2) noteqth in + let th4 = CONV_RULE (RAND_CONV(BINOP_CONV RING_NORMALIZE_CONV)) + (INE_RULE l th3) in + let l,r = dest_eq(rand(concl th4)) in + EQ_MP (EQF_INTRO th4) (REFL l) in + let RING tm = + let avs = frees tm in + let tm' = list_mk_forall(avs,tm) in + let th1 = INITIAL_CONV(mk_neg tm') in + let evs,bod = strip_exists(rand(concl th1)) in + if is_forall bod then failwith "RING: non-universal formula" else + let th1a = WEAK_DNF_CONV bod in + let boda = rand(concl th1a) in + let th2a = refute_disj REFUTE boda in + let th2b = TRANS th1a (EQF_INTRO(NOT_INTRO(DISCH boda th2a))) in + let th2 = UNDISCH(NOT_ELIM(EQF_ELIM th2b)) in + let th3 = itlist SIMPLE_CHOOSE evs th2 in + SPECL avs (MATCH_MP (FINAL_RULE (DISCH_ALL th3)) th1) + and ideal tms tm = + let rawvars = itlist grobvars (tm::tms) [] in + let vars = sort (fun x y -> x < y) (setify rawvars) in + let pols = map (grobify_term vars) tms and pol = grobify_term vars tm in + let cert = grobner_ideal vars pols pol in + map (fun n -> let p = assocd n cert [] in holify_polynomial vars p) + (0--(length pols-1)) in + RING,ideal;; + +(* ----------------------------------------------------------------------- *) +(* Separate out the cases. *) +(* ----------------------------------------------------------------------- *) + +let RING parms = fst(RING_AND_IDEAL_CONV parms);; + +let ideal_cofactors parms = snd(RING_AND_IDEAL_CONV parms);; + +(* ------------------------------------------------------------------------- *) +(* Simplify a natural number assertion to eliminate conditionals, DIV, MOD, *) +(* PRE, cutoff subtraction, EVEN and ODD. Try to do it in a way that makes *) +(* new quantifiers universal. At the moment we don't split "<=>" which would *) +(* make this quantifier selection work there too; better to do NNF first if *) +(* you care. This also applies to EVEN and ODD. *) +(* ------------------------------------------------------------------------- *) + +let NUM_SIMPLIFY_CONV = + let pre_tm = `PRE` + and div_tm = `(DIV):num->num->num` + and mod_tm = `(MOD):num->num->num` + and p_tm = `P:num->bool` and n_tm = `n:num` and m_tm = `m:num` + and q_tm = `P:num->num->bool` and a_tm = `a:num` and b_tm = `b:num` in + let is_pre tm = is_comb tm & rator tm = pre_tm + and is_sub = is_binop `(-):num->num->num` + and is_divmod = + let is_div = is_binop div_tm and is_mod = is_binop mod_tm in + fun tm -> is_div tm or is_mod tm + and contains_quantifier = + can (find_term (fun t -> is_forall t or is_exists t or is_uexists t)) + and BETA2_CONV = RATOR_CONV BETA_CONV THENC BETA_CONV + and PRE_ELIM_THM'' = CONV_RULE (RAND_CONV NNF_CONV) PRE_ELIM_THM + and SUB_ELIM_THM'' = CONV_RULE (RAND_CONV NNF_CONV) SUB_ELIM_THM + and DIVMOD_ELIM_THM'' = CONV_RULE (RAND_CONV NNF_CONV) DIVMOD_ELIM_THM + and pth_evenodd = prove + (`(EVEN(x) <=> (!y. ~(x = SUC(2 * y)))) /\ + (ODD(x) <=> (!y. ~(x = 2 * y))) /\ + (~EVEN(x) <=> (!y. ~(x = 2 * y))) /\ + (~ODD(x) <=> (!y. ~(x = SUC(2 * y))))`, + REWRITE_TAC[GSYM NOT_EXISTS_THM; GSYM EVEN_EXISTS; GSYM ODD_EXISTS] THEN + REWRITE_TAC[NOT_EVEN; NOT_ODD]) in + let rec NUM_MULTIPLY_CONV pos tm = + if is_forall tm or is_exists tm or is_uexists tm then + BINDER_CONV (NUM_MULTIPLY_CONV pos) tm + else if is_imp tm & contains_quantifier tm then + COMB2_CONV (RAND_CONV(NUM_MULTIPLY_CONV(not pos))) + (NUM_MULTIPLY_CONV pos) tm + else if (is_conj tm or is_disj tm or is_iff tm) & + contains_quantifier tm + then BINOP_CONV (NUM_MULTIPLY_CONV pos) tm + else if is_neg tm & not pos & contains_quantifier tm then + RAND_CONV (NUM_MULTIPLY_CONV (not pos)) tm + else + try let t = find_term (fun t -> is_pre t & free_in t tm) tm in + let ty = type_of t in + let v = genvar ty in + let p = mk_abs(v,subst [v,t] tm) in + let th0 = if pos then PRE_ELIM_THM'' else PRE_ELIM_THM' in + let th1 = INST [p,p_tm; rand t,n_tm] th0 in + let th2 = CONV_RULE(COMB2_CONV (RAND_CONV BETA_CONV) + (BINDER_CONV(RAND_CONV BETA_CONV))) th1 in + CONV_RULE(RAND_CONV (NUM_MULTIPLY_CONV pos)) th2 + with Failure _ -> try + let t = find_term (fun t -> is_sub t & free_in t tm) tm in + let ty = type_of t in + let v = genvar ty in + let p = mk_abs(v,subst [v,t] tm) in + let th0 = if pos then SUB_ELIM_THM'' else SUB_ELIM_THM' in + let th1 = INST [p,p_tm; lhand t,a_tm; rand t,b_tm] th0 in + let th2 = CONV_RULE(COMB2_CONV (RAND_CONV BETA_CONV) + (BINDER_CONV(RAND_CONV BETA_CONV))) th1 in + CONV_RULE(RAND_CONV (NUM_MULTIPLY_CONV pos)) th2 + with Failure _ -> try + let t = find_term (fun t -> is_divmod t & free_in t tm) tm in + let x = lhand t and y = rand t in + let dtm = mk_comb(mk_comb(div_tm,x),y) + and mtm = mk_comb(mk_comb(mod_tm,x),y) in + let vd = genvar(type_of dtm) + and vm = genvar(type_of mtm) in + let p = list_mk_abs([vd;vm],subst[vd,dtm; vm,mtm] tm) in + let th0 = if pos then DIVMOD_ELIM_THM'' else DIVMOD_ELIM_THM' in + let th1 = INST [p,q_tm; x,m_tm; y,n_tm] th0 in + let th2 = CONV_RULE(COMB2_CONV(RAND_CONV BETA2_CONV) + (funpow 2 BINDER_CONV(RAND_CONV BETA2_CONV))) th1 in + CONV_RULE(RAND_CONV (NUM_MULTIPLY_CONV pos)) th2 + with Failure _ -> REFL tm in + NUM_REDUCE_CONV THENC + CONDS_CELIM_CONV THENC + NNF_CONV THENC + NUM_MULTIPLY_CONV true THENC + NUM_REDUCE_CONV THENC + GEN_REWRITE_CONV ONCE_DEPTH_CONV [pth_evenodd];; + +(* ----------------------------------------------------------------------- *) +(* Natural number version of ring procedure with this normalization. *) +(* ----------------------------------------------------------------------- *) + +let NUM_RING = + let NUM_INTEGRAL_LEMMA = prove + (`(w = x + d) /\ (y = z + e) + ==> ((w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC] THEN + ONCE_REWRITE_TAC[AC ADD_AC + `a + b + c + d + e = a + c + e + b + d`] THEN + REWRITE_TAC[EQ_ADD_LCANCEL; EQ_ADD_LCANCEL_0; MULT_EQ_0]) in + let NUM_INTEGRAL = prove + (`(!x. 0 * x = 0) /\ + (!x y z. (x + y = x + z) <=> (y = z)) /\ + (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, + REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN + REPEAT GEN_TAC THEN + DISJ_CASES_TAC (SPECL [`w:num`; `x:num`] LE_CASES) THEN + DISJ_CASES_TAC (SPECL [`y:num`; `z:num`] LE_CASES) THEN + REPEAT(FIRST_X_ASSUM + (CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS])) THEN + ASM_MESON_TAC[NUM_INTEGRAL_LEMMA; ADD_SYM; MULT_SYM]) in + let rawring = + RING(dest_numeral,mk_numeral,NUM_EQ_CONV, + genvar bool_ty,`(+):num->num->num`,genvar bool_ty, + genvar bool_ty,`(*):num->num->num`,genvar bool_ty, + `(EXP):num->num->num`, + NUM_INTEGRAL,TRUTH,NUM_NORMALIZE_CONV) in + let initconv = NUM_SIMPLIFY_CONV THENC GEN_REWRITE_CONV DEPTH_CONV [ADD1] + and t_tm = `T` in + fun tm -> let th = initconv tm in + if rand(concl th) = t_tm then th + else EQ_MP (SYM th) (rawring(rand(concl th)));; diff --git a/help.ml b/help.ml new file mode 100644 index 0000000..4b22a23 --- /dev/null +++ b/help.ml @@ -0,0 +1,138 @@ +(* ========================================================================= *) +(* Simple online help system, based on old HOL88 one. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "define.ml";; + +(* ------------------------------------------------------------------------- *) +(* Help system. *) +(* ------------------------------------------------------------------------- *) + +let help_path = ref ["$/Help"];; + +let help s = + let funny_filenames = + ["++", ".joinparsers"; + "||", ".orparser"; + ">>", ".pipeparser"; + "|=>", ".singlefun"; + "--", ".upto"; + "|->", ".valmod"; + "insert'", "insert_prime"; + "mem'", "mem_prime"; + "subtract'", "subtract_prime"; + "union'", "union_prime"; + "unions'", "unions_prime"; + "ALPHA", "ALPHA_UPPERCASE"; + "CHOOSE", "CHOOSE_UPPERCASE"; + "CONJUNCTS", "CONJUNCTS_UPPERCASE"; + "EXISTS", "EXISTS_UPPERCASE"; + "HYP", "HYP_UPPERCASE"; + "INSTANTIATE", "INSTANTIATE_UPPERCASE"; + "INST", "INST_UPPERCASE"; + "MK_BINOP", "MK_BINOP_UPPERCASE"; + "MK_COMB", "MK_COMB_UPPERCASE"; + "MK_CONJ", "MK_CONJ_UPPERCASE"; + "MK_DISJ", "MK_DISJ_UPPERCASE"; + "MK_EXISTS", "MK_EXISTS_UPPERCASE"; + "MK_FORALL", "MK_FORALL_UPPERCASE"; + "REPEAT", "REPEAT_UPPERCASE"] in + let true_path = map hol_expand_directory (!help_path) in + let raw_listing = + map (fun s -> String.sub s 0 (String.length s - 4)) + (itlist (fun a l -> Array.to_list (Sys.readdir a) @ l) true_path []) in + let mod_listing = + map fst funny_filenames @ + subtract raw_listing (map snd funny_filenames) in + let edit_distance s1 s2 = + let l1 = String.length s1 and l2 = String.length s2 in + let a = Array.make_matrix (l1 + 1) (l2 + 1) 0 in + for i = 1 to l1 do a.(i).(0) <- i done; + for j = 1 to l2 do a.(0).(j) <- j done; + for i = 1 to l1 do + for j = 1 to l2 do + let cost = if String.get s1 (i-1) = String.get s2 (j-1) then 0 else 1 in + a.(i).(j) <- min (min a.(i-1).(j) a.(i).(j-1) + 1) + (a.(i-1).(j-1) + cost) + done + done; + a.(l1).(l2) in + let closeness s s' = + s',2.0 *. float_of_int + (edit_distance (String.uppercase s) (String.uppercase s')) /. + float_of_int(String.length s + String.length s') in + let guess s = + let guesses = mergesort(increasing snd) (map (closeness s) mod_listing) in + map fst (fst(chop_list 3 guesses)) in + Format.print_string + "-------------------------------------------------------------------\n"; + Format.print_flush(); + (if mem s mod_listing then + let fn = assocd s funny_filenames s ^".doc" in + let file = file_on_path true_path fn + and script = file_on_path [!hol_dir] "doc-to-help.sed" in + ignore(Sys.command("sed -f "^script^" "^file)) + else + let guesses = map + (fun s -> "help \""^String.escaped s^"\";;\n") (guess s) in + (Format.print_string o end_itlist(^)) + (["No help found for \""; String.escaped s; "\"; did you mean:\n\n"] @ + guesses @ ["\n?\n"])); + Format.print_string + "--------------------------------------------------------------------\n"; + Format.print_flush();; + +(* ------------------------------------------------------------------------- *) +(* Set up a theorem database, but leave contents clear for now. *) +(* ------------------------------------------------------------------------- *) + +let theorems = ref([]:(string*thm)list);; + +(* ------------------------------------------------------------------------- *) +(* Some hacky term modifiers to encode searches. *) +(* ------------------------------------------------------------------------- *) + +let omit t = mk_comb(mk_var("",W mk_fun_ty (type_of t)),t);; + +let exactly t = mk_comb(mk_var("",W mk_fun_ty (type_of t)),t);; + +let name s = mk_comb(mk_var("",W mk_fun_ty aty), + mk_var(s,aty));; + +(* ------------------------------------------------------------------------- *) +(* The main search function. *) +(* ------------------------------------------------------------------------- *) + +let search = + let rec immediatesublist l1 l2 = + match (l1,l2) with + [],_ -> true + | _,[] -> false + | (h1::t1,h2::t2) -> h1 = h2 & immediatesublist t1 t2 in + let rec sublist l1 l2 = + match (l1,l2) with + [],_ -> true + | _,[] -> false + | (h1::t1,h2::t2) -> immediatesublist l1 l2 or sublist l1 t2 in + let exists_subterm_satisfying p (n,th) = can (find_term p) (concl th) + and name_contains s (n,th) = sublist (explode s) (explode n) in + let rec filterpred tm = + match tm with + Comb(Var("",_),t) -> not o filterpred t + | Comb(Var("",_),Var(pat,_)) -> name_contains pat + | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) + | pat -> exists_subterm_satisfying (can (term_match [] pat)) in + fun pats -> + let triv,nontriv = partition is_var pats in + (if triv <> [] then + warn true + ("Ignoring plain variables in search: "^ + end_itlist (fun s t -> s^", "^t) (map (fst o dest_var) triv)) + else ()); + (if nontriv = [] & triv <> [] then [] + else itlist (filter o filterpred) pats (!theorems));; diff --git a/hol.ml b/hol.ml new file mode 100644 index 0000000..2329a40 --- /dev/null +++ b/hol.ml @@ -0,0 +1,170 @@ +(* ========================================================================= *) +(* HOL LIGHT *) +(* *) +(* Modern OCaml version of the HOL theorem prover *) +(* *) +(* John Harrison *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +let hol_version = "2.20++";; + +#directory "+compiler-libs";; + +let hol_dir = ref + (try Sys.getenv "HOLLIGHT_DIR" with Not_found -> Sys.getcwd());; + +(* ------------------------------------------------------------------------- *) +(* Should eventually change to "ref(Filename.temp_dir_name)". *) +(* However that's not available in 3.08, which is still the default *) +(* in Cygwin, and I don't want to force people to upgrade Ocaml. *) +(* ------------------------------------------------------------------------- *) + +let temp_path = ref "/tmp";; + +(* ------------------------------------------------------------------------- *) +(* Load in parsing extensions. *) +(* For Ocaml < 3.10, use the built-in camlp4 *) +(* and for Ocaml >= 3.10, use camlp5 instead. *) +(* ------------------------------------------------------------------------- *) + +if let v = String.sub Sys.ocaml_version 0 4 in v >= "3.10" +then (Topdirs.dir_directory "+camlp5"; + Topdirs.dir_load Format.std_formatter "camlp5o.cma") +else (Topdirs.dir_load Format.std_formatter "camlp4o.cma");; + +Topdirs.dir_load Format.std_formatter (Filename.concat (!hol_dir) "pa_j.cmo");; + +(* ------------------------------------------------------------------------- *) +(* Load files from system and/or user-settable directories. *) +(* Paths map initial "$/" to !hol_dir dynamically; use $$ to get the actual *) +(* $ character at the start of a directory. *) +(* ------------------------------------------------------------------------- *) + +let file_stack = ref [];; +let file_order = ref [];; +let use_file_start_hook = ref (fun (s : string) -> file_stack := s :: !file_stack);; +let use_file_end_hook = ref (fun (s : string) -> + file_order := s :: !file_order; + if !file_stack <> [] then file_stack := List.tl !file_stack +);; +let use_file s = + !use_file_start_hook s; + let ret = Toploop.use_file Format.std_formatter s in + !use_file_end_hook s; + if ret then () else (Format.print_string("Error in included file "^s); Format.print_newline());; + +let hol_expand_directory s = + if s = "$" or s = "$/" then !hol_dir + else if s = "$$" then "$" + else if String.length s <= 2 then s + else if String.sub s 0 2 = "$$" then (String.sub s 1 (String.length s - 1)) + else if String.sub s 0 2 = "$/" + then Filename.concat (!hol_dir) (String.sub s 2 (String.length s - 2)) + else s;; + +let load_path = ref ["."; "$"];; + +let loaded_files = ref [];; + +let file_on_path p s = + if not (Filename.is_relative s) then s else + let p' = List.map hol_expand_directory p in + let d = List.find (fun d -> Sys.file_exists(Filename.concat d s)) p' in + Filename.concat (if d = "." then Sys.getcwd() else d) s;; + +let load_on_path p s = + let s' = file_on_path p s in + let fileid = (Filename.basename s',Digest.file s') in + (use_file s'; loaded_files := fileid::(!loaded_files));; + +let loads s = load_on_path ["$"] s;; + +let loadt s = load_on_path (!load_path) s;; + +let needs s = + let s' = file_on_path (!load_path) s in + let fileid = (Filename.basename s',Digest.file s') in + if List.mem fileid (!loaded_files) + then Format.print_string("File \""^s^"\" already loaded\n") else loadt s;; + +(* ------------------------------------------------------------------------- *) +(* Various tweaks to OCaml and general library functions. *) +(* ------------------------------------------------------------------------- *) + +loads "system.ml";; (* Set up proper parsing and load bignums *) +loads "lib.ml";; (* Various useful general library functions *) + +(* ------------------------------------------------------------------------- *) +(* The logical core. *) +(* ------------------------------------------------------------------------- *) + +loads "fusion.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some extra support stuff needed outside the core. *) +(* ------------------------------------------------------------------------- *) + +loads "basics.ml";; (* Additional syntax operations and other utilities *) +loads "nets.ml";; (* Term nets for fast matchability-based lookup *) + +(* ------------------------------------------------------------------------- *) +(* The interface. *) +(* ------------------------------------------------------------------------- *) + +loads "printer.ml";; (* Crude prettyprinter *) +loads "preterm.ml";; (* Preterms and their interconversion with terms *) +loads "parser.ml";; (* Lexer and parser *) + +(* ------------------------------------------------------------------------- *) +(* Higher level deductive system. *) +(* ------------------------------------------------------------------------- *) + +loads "equal.ml";; (* Basic equality reasoning and conversionals *) +loads "bool.ml";; (* Boolean theory and basic derived rules *) +loads "drule.ml";; (* Additional derived rules *) +loads "tactics.ml";; (* Tactics, tacticals and goal stack *) +loads "itab.ml";; (* Toy prover for intuitionistic logic *) +loads "simp.ml";; (* Basic rewriting and simplification tools. *) +loads "theorems.ml";; (* Additional theorems (mainly for quantifiers) etc. *) +loads "ind_defs.ml";; (* Derived rules for inductive definitions *) +loads "class.ml";; (* Classical reasoning: Choice and Extensionality *) +loads "trivia.ml";; (* Some very basic theories, e.g. type ":1" *) +loads "canon.ml";; (* Tools for putting terms in canonical forms *) +loads "meson.ml";; (* First order automation: MESON (model elimination) *) +loads "quot.ml";; (* Derived rules for defining quotient types *) +loads "impconv.ml";; (* More powerful implicational rewriting etc. *) + +(* ------------------------------------------------------------------------- *) +(* Mathematical theories and additional proof tools. *) +(* ------------------------------------------------------------------------- *) + +loads "pair.ml";; (* Theory of pairs *) +loads "nums.ml";; (* Axiom of Infinity, definition of natural numbers *) +loads "recursion.ml";; (* Tools for primitive recursion on inductive types *) +loads "arith.ml";; (* Natural number arithmetic *) +loads "wf.ml";; (* Theory of wellfounded relations *) +loads "calc_num.ml";; (* Calculation with natural numbers *) +loads "normalizer.ml";; (* Polynomial normalizer for rings and semirings *) +loads "grobner.ml";; (* Groebner basis procedure for most semirings. *) +loads "ind_types.ml";; (* Tools for defining inductive types *) +loads "lists.ml";; (* Theory of lists *) +loads "realax.ml";; (* Definition of real numbers *) +loads "calc_int.ml";; (* Calculation with integer-valued reals *) +loads "realarith.ml";; (* Universal linear real decision procedure *) +loads "real.ml";; (* Derived properties of reals *) +loads "calc_rat.ml";; (* Calculation with rational-valued reals *) +loads "int.ml";; (* Definition of integers *) +loads "sets.ml";; (* Basic set theory. *) +loads "iterate.ml";; (* Iterated operations *) +loads "cart.ml";; (* Finite Cartesian products *) +loads "define.ml";; (* Support for general recursive definitions *) + +(* ------------------------------------------------------------------------- *) +(* The help system. *) +(* ------------------------------------------------------------------------- *) + +loads "help.ml";; (* Online help using the entries in Help directory *) +loads "database.ml";; (* List of name-theorem pairs for search system *) diff --git a/impconv.ml b/impconv.ml new file mode 100644 index 0000000..9dbb15a --- /dev/null +++ b/impconv.ml @@ -0,0 +1,1857 @@ +(* ========================================================================= *) +(* Implicational conversions, implicational rewriting and target rewriting. *) +(* *) +(* (c) Copyright, Vincent Aravantinos, 2012-2013 *) +(* Analysis and Design of Dependable Systems *) +(* fortiss GmbH, Munich, Germany *) +(* *) +(* Formerly: Hardware Verification Group, *) +(* Concordia University *) +(* *) +(* Contact: *) +(* ========================================================================= *) + +let IMP_REWRITE_TAC,TARGET_REWRITE_TAC,HINT_EXISTS_TAC, + SEQ_IMP_REWRITE_TAC,CASE_REWRITE_TAC = + +let I = fun x -> x in + +(* Same as [UNDISCH] but also returns the undischarged term *) +let UNDISCH_TERM th = + let p = (fst o dest_imp o concl) th in + p,UNDISCH th in + +(* Same as [UNDISCH_ALL] but also returns the undischarged terms *) +let rec UNDISCH_TERMS th = + try + let t,th' = UNDISCH_TERM th in + let ts,th'' = UNDISCH_TERMS th' in + t::ts,th'' + with Failure _ -> [],th in + +(* Comblies the function [f] to the conclusion of an implicational theorem. *) +let MAP_CONCLUSION f th = + let p,th = UNDISCH_TERM th in + DISCH p (f th) in + +let strip_conj = binops `(/\)` in + +(* For a list [f1;...;fk], returns the first [fi x] that succeeds. *) +let rec tryfind_fun fs x = + match fs with + |[] -> failwith "tryfind_fun" + |f::fs' -> try f x with Failure _ -> tryfind_fun fs' x in + +(* Same as [mapfilter] but also provides the rank of the iteration as an + * argument to [f]. *) +let mapfilteri f = + let rec self i = function + |[] -> [] + |h::t -> + let rest = self (i+1) t in + try f i h :: rest with Failure _ -> rest + in + self 0 in + +let list_of_option = function None -> [] | Some x -> [x] in + +let try_list f x = try f x with Failure _ -> [] in + +(* A few constants. *) +let A_ = `A:bool` and B_ = `B:bool` and C_ = `C:bool` and D_ = `D:bool` in +let T_ = `T:bool` in + +(* For a term t, builds `t ==> t` *) +let IMP_REFL = + let lem = TAUT `A ==> A` in + fun t -> INST [t,A_] lem in + +(* Conversion version of [variant]: + * Given variables [v1;...;vk] to avoid and a term [t], + * returns [|- t = t'] where [t'] is the same as [t] without any use of the + * variables [v1;...;vk]. + *) +let VARIANT_CONV av t = + let vs = variables t in + let mapping = filter (fun (x,y) -> x <> y) (zip vs (variants av vs)) in + DEPTH_CONV (fun u -> ALPHA_CONV (assoc (bndvar u) mapping) u) t in + +(* Rule version of [VARIANT_CONV] *) +let VARIANT_RULE = CONV_RULE o VARIANT_CONV in + +(* Discharges the first hypothesis of a theorem. *) +let DISCH_HD th = DISCH (hd (hyp th)) th in + +(* Rule version of [REWR_CONV] *) +let REWR_RULE = CONV_RULE o REWR_CONV in + +(* Given a list [A1;...;Ak] and a theorem [th], + * returns [|- A1 /\ ... /\ Ak ==> th]. + *) +let DISCH_IMP_IMP = + let f = function + |[] -> I + |t::ts -> rev_itlist (fun t -> REWR_RULE IMP_IMP o DISCH t) ts o DISCH t + in + f o rev in + +(* Given a term [A /\ B] and a theorem [th], returns [|- A ==> B ==> th]. *) +let rec DISCH_CONJ t th = + try + let t1,t2 = dest_conj t in + REWR_RULE IMP_IMP (DISCH_CONJ t1 (DISCH_CONJ t2 th)) + with Failure _ -> DISCH t th in + +(* Specializes all the universally quantified variables of a theorem, + * and returns both the theorem and the list of variables. + *) +let rec SPEC_VARS th = + try + let v,th' = SPEC_VAR th in + let vs,th'' = SPEC_VARS th' in + v::vs,th'' + with Failure _ -> [],th in + +(* Comblies the function [f] to the body of a universally quantified theorem. *) +let MAP_FORALL_BODY f th = + let vs,th = SPEC_VARS th in + GENL vs (f th) in + +(* Given a theorem of the form [!xyz. P ==> !uvw. C] and a function [f], + * return [!xyz. P ==> !uvw. f C]. + *) +let GEN_MAP_CONCLUSION = MAP_FORALL_BODY o MAP_CONCLUSION o MAP_FORALL_BODY in + +(* Turn a theorem of the form [x ==> y /\ z] into [(x==>y) /\ (x==>z)]. + * Also deals with universal quantifications if necessary + * (e.g., [x ==> !v. y /\ z] will be turned into + * [(x ==> !v. y) /\ (x ==> !v. z)]) + * + * possible improvement: apply the rewrite more locally + *) +let IMPLY_AND = + let IMPLY_AND_RDISTRIB = TAUT `(x ==> y /\ z) <=> (x==>y) /\(x==>z)` in + PURE_REWRITE_RULE [GSYM AND_FORALL_THM;IMP_IMP; + RIGHT_IMP_FORALL_THM;IMPLY_AND_RDISTRIB;GSYM CONJ_ASSOC] in + +(* Returns the two operands of a binary combination. + * Contrary to [dest_binary], does not check what is the operator. + *) +let dest_binary_blind = function + |Comb(Comb(_,l),r) -> l,r + |_ -> failwith "dest_binary_blind" in + +let spec_all = repeat (snd o dest_forall) in + +let thm_lt (th1:thm) th2 = th1 < th2 in + +(* GMATCH_MP (U1 |- !x1...xn. H1 /\ ... /\ Hk ==> C) (U2 |- P) + * = (U1 u U2 |- !y1...ym. G1' /\ ... /\ Gl' ==> C') + * where: + * - P matches some Hi + * - C' is the result of applying the matching substitution to C + * - Gj' is the result of applying the matching substitution to Hj + * - G1',...,Gl' is the list corresponding to H1,...,Hk but without Hi + * - y1...ym are the variables among x1,...,xn that are not instantiated + * + * possible improvement: make a specific conversion, + * define a MATCH_MP that also returns the instantiated variables *) +let GMATCH_MP = + let swap = CONV_RULE (REWR_CONV (TAUT `(p==>q==>r) <=> (q==>p==>r)`)) in + fun th1 -> + let vs,th1' = SPEC_VARS th1 in + let hs,th1'' = UNDISCH_TERMS (PURE_REWRITE_RULE [IMP_CONJ] th1') in + fun th2 -> + let f h hs = + let th1''' = DISCH h th1'' in + let th1'''' = + try swap (DISCH_IMP_IMP hs th1''') with Failure _ -> th1''' + in + MATCH_MP (GENL vs th1'''') th2 + in + let rec loop acc = function + |[] -> [] + |h::hs -> + (try [f h (acc @ hs)] with Failure _ -> []) @ loop (h::acc) hs + in + loop [] hs in + +let GMATCH_MPS ths1 ths2 = + let insert (y:thm) = function + |[] -> [y] + |x::_ as xs when equals_thm x y -> xs + |x::xs when thm_lt x y -> x :: insert y xs + |_::_ as xs -> y::xs + in + let inserts ys = itlist insert ys in + match ths1 with + |[] -> [] + |th1::ths1' -> + let rec self acc th1 ths1 = function + |[] -> (match ths1 with [] -> acc | th::ths1' -> self acc th ths1' ths2) + |th2::ths2' -> self (inserts (GMATCH_MP th1 th2) acc) th1 ths1 ths2' + in + self [] th1 ths1' ths2 in + +let MP_CLOSURE ths1 ths2 = + let ths1 = filter (is_imp o spec_all o concl) ths1 in + let rec self ths2 = function + |[] -> [] + |_::_ as ths1 -> + let ths1'' = GMATCH_MPS ths1 ths2 in + self ths2 ths1'' @ ths1'' + in + self ths2 ths1 in + +(* Set of terms. Implemented as ordered lists. *) +let module Tset = + struct + type t = term list + let cmp (x:term) y = Pervasives.compare x y + let lt (x:term) y = Pervasives.compare x y < 0 + let lift f = List.sort cmp o f + let of_list = lift I + let insert ts t = + let rec self = function + |[] -> [t] + |x::xs when lt x t -> x::self xs + |x::_ as xs when x = t -> xs + |xs -> t::xs + in + if t = T_ then ts else self ts + let remove ts t = + let rec self = function + |[] -> [] + |x::xs when lt x t -> x::self xs + |x::xs when x = t -> xs + |_::_ as xs -> xs + in + self ts + let strip_conj = + let rec self acc t = + try + let t1,t2 = dest_conj t in + self (self acc t1) t2 + with Failure _ -> insert acc t + in + self [] + let rec union l1 l2 = + match l1 with + |[] -> l2 + |h1::t1 -> + match l2 with + |[] -> l1 + |h2::t2 when lt h1 h2 -> h1::union t1 l2 + |h2::t2 when h1 = h2 -> h1::union t1 t2 + |h2::t2 -> h2::union l1 t2 + let rec mem x = function + |x'::xs when x' = x -> true + |x'::xs when lt x' x -> mem x xs + |_ -> false + let subtract l1 l2 = filter (fun x -> not (mem x l2)) l1 + let empty = [] + let flat_revmap f = + let rec self acc = function + |[] -> acc + |x::xs -> self (union (f x) acc) xs + in + self [] + let flat_map f = flat_revmap f o rev + let rec frees acc = function + |Var _ as t -> insert acc t + |Const _ -> acc + |Abs(v,b) -> remove (frees acc b) v + |Comb(u,v) -> frees (frees acc u) v + let freesl ts = itlist (C frees) ts empty + let frees = frees empty + end in + +let module Type_annoted_term = + struct + type t = + |Var_ of string * hol_type + |Const_ of string * hol_type * term + |Comb_ of t * t * hol_type + |Abs_ of t * t * hol_type + + let type_of = function + |Var_(_,ty) -> ty + |Const_(_,ty,_) -> ty + |Comb_(_,_,ty) -> ty + |Abs_(_,_,ty) -> ty + + let rec of_term = function + |Var(s,ty) -> Var_(s,ty) + |Const(s,ty) as t -> Const_(s,ty,t) + |Comb(u,v) -> + let u' = of_term u and v' = of_term v in + Comb_(u',v',snd (dest_fun_ty (type_of u'))) + |Abs(x,b) -> + let x' = of_term x and b' = of_term b in + Abs_(x',b',mk_fun_ty (type_of x') (type_of b')) + + let rec equal t1 t2 = + match t1,t2 with + |Var_(s1,ty1),Var_(s2,ty2) + |Const_(s1,ty1,_),Const_(s2,ty2,_) -> s1 = s2 & ty1 = ty2 + |Comb_(u1,v1,_),Comb_(u2,v2,_) -> equal u1 u2 & equal v1 v2 + |Abs_(v1,b1,_),Abs_(v2,b2,_) -> equal v1 v2 & equal b1 b2 + |_ -> false + + let rec to_term = function + |Var_(s,ty) -> mk_var(s,ty) + |Const_(_,_,t) -> t + |Comb_(u,v,_) -> mk_comb(to_term u,to_term v) + |Abs_(v,b,_) -> mk_abs(to_term v,to_term b) + + let dummy = Var_("",aty) + + let rec find_term p t = + if p t then t else + match t with + |Abs_(_,b,_) -> find_term p b + |Comb_(u,v,_) -> try find_term p u with Failure _ -> find_term p v + |_ -> failwith "Annot.find_term" + end in + +let module Annot = Type_annoted_term in + +(* ------------------------------------------------------------------------- *) +(* First-order matching of terms. *) +(* *) +(* Same note as in [drule.ml]: *) +(* in the event of spillover patterns, this may return false results; *) +(* but there's usually an implicit check outside that the match worked *) +(* anyway. A test could be put in (see if any "env" variables are left in *) +(* the term after abstracting out the pattern instances) but it'd be slower. *) +(* ------------------------------------------------------------------------- *) + +let fo_term_match lcs p t = + let fail () = failwith "fo_term_match" in + let rec self bnds (tenv,tyenv as env) p t = + match p,t with + |Comb(p1,p2),Annot.Comb_(t1,t2,_) -> self bnds (self bnds env p1 t1) p2 t2 + |Abs(v,p),Annot.Abs_(v',t,_) -> + let tyenv' = type_match (type_of v) (Annot.type_of v') tyenv in + self ((v',v)::bnds) (tenv,tyenv') p t + |Const(n,ty),Annot.Const_(n',ty',_) -> + if n <> n' then fail () + else + let tyenv' = type_match ty ty' tyenv in + tenv,tyenv' + |Var(n,ty) as v,t -> + (* Is [v] bound? *) + (try if Annot.equal t (rev_assoc v bnds) then env else fail () + (* No *) + with Failure _ -> + if mem v lcs + then + match t with + |Annot.Var_(n',ty') when n' = n & ty' = ty -> env + |_ -> fail () + else + let tyenv' = type_match ty (Annot.type_of t) tyenv in + let t' = try Some (rev_assoc v tenv) with Failure _ -> None in + match t' with + |Some t' -> if t = t' then tenv,tyenv' else fail () + |None -> (t,v)::tenv,tyenv') + |_ -> fail () + in + let tenv,tyenv = self [] ([],[]) p (Annot.of_term t) in + let inst = inst tyenv in + List.rev_map (fun t,v -> Annot.to_term t,inst v) tenv,tyenv in + +let GEN_PART_MATCH_ALL = + let rec match_bvs t1 t2 acc = + try let v1,b1 = dest_abs t1 + and v2,b2 = dest_abs t2 in + let n1 = fst(dest_var v1) and n2 = fst(dest_var v2) in + let newacc = if n1 = n2 then acc else insert (n1,n2) acc in + match_bvs b1 b2 newacc + with Failure _ -> try + let l1,r1 = dest_comb t1 + and l2,r2 = dest_comb t2 in + match_bvs l1 l2 (match_bvs r1 r2 acc) + with Failure _ -> acc + in + fun partfn th -> + let sth = SPEC_ALL th in + let bod = concl sth in + let pbod = partfn bod in + let lcs = intersect (frees (concl th)) (freesl(hyp th)) in + let fvs = subtract (subtract (frees bod) (frees pbod)) lcs in + fun tm -> + let bvms = match_bvs tm pbod [] in + let abod = deep_alpha bvms bod in + let ath = EQ_MP (ALPHA bod abod) sth in + let insts,tyinsts = fo_term_match lcs (partfn abod) tm in + let eth = INSTANTIATE_ALL ([],insts,tyinsts) (GENL fvs ath) in + let fth = itlist (fun v th -> snd(SPEC_VAR th)) fvs eth in + let tm' = partfn (concl fth) in + if Pervasives.compare tm' tm = 0 then fth else + try SUBS[ALPHA tm' tm] fth + with Failure _ -> failwith "PART_MATCH: Sanity check failure" in + +let exists_subterm p t = + try ignore (find_term p t);true with Failure _ -> false in + +let module Fo_nets = + struct + type term_label = + |Vnet of int + |Lcnet of string * int + |Cnet of string * int + |Lnet of int + + type 'a t = Netnode of (term_label * 'a t) list * 'a list + + let empty_net = Netnode([],[]) + + let enter = + let label_to_store lcs t = + let op,args = strip_comb t in + let nargs = length args in + match op with + |Const(n,_) -> Cnet(n,nargs),args + |Abs(v,b) -> + let b' = if mem v lcs then vsubst [genvar(type_of v),v] b else b in + Lnet nargs,b'::args + |Var(n,_) when mem op lcs -> Lcnet(n,nargs),args + |Var(_,_) -> Vnet nargs,args + |_ -> assert false + in + let rec net_update lcs elem (Netnode(edges,tips)) = function + |[] -> Netnode(edges,elem::tips) + |t::rts -> + let label,nts = label_to_store lcs t in + let child,others = + try (snd F_F I) (remove (fun (x,y) -> x = label) edges) + with Failure _ -> empty_net,edges in + let new_child = net_update lcs elem child (nts@rts) in + Netnode ((label,new_child)::others,tips) + in + fun lcs (t,elem) net -> net_update lcs elem net [t] + + let lookup = + let label_for_lookup t = + let op,args = strip_comb t in + let nargs = length args in + match op with + |Const(n,_) -> Cnet(n,nargs),args + |Abs(_,b) -> Lnet nargs,b::args + |Var(n,_) -> Lcnet(n,nargs),args + |Comb _ -> assert false + in + let rec follow (Netnode(edges,tips)) = function + |[] -> tips + |t::rts -> + let label,nts = label_for_lookup t in + let collection = + try follow (assoc label edges) (nts@rts) with Failure _ -> [] + in + let rec support = function + |[] -> [0,rts] + |t::ts -> + let ((k,nts')::res') as res = support ts in + (k+1,(t::nts'))::res + in + let follows = + let f (k,nts) = + try follow (assoc (Vnet k) edges) nts with Failure _ -> [] + in + map f (support nts) + in + collection @ flat follows + in + fun t net -> follow net [t] + + let rec filter p (Netnode(edges,tips)) = + Netnode( + List.map (fun l,n -> l,filter p n) edges, + List.filter p tips) + end in + +let module Variance = + struct + type t = Co | Contra + let neg = function Co -> Contra | Contra -> Co + end in + +(*****************************************************************************) +(* IMPLICATIONAL RULES *) +(* i.e., rules to build propositions based on implications rather than *) +(* equivalence. *) +(*****************************************************************************) + +let module Impconv = + struct + +let MKIMP_common lem th1 th2 = + let a,b = dest_imp (concl th1) and c,d = dest_imp (concl th2) in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +(* Similar to [MK_CONJ] but theorems should be implicational instead of + * equational, i.e., conjoin both sides of two implicational theorems. + * + * More precisely: given two theorems [A ==> B] and [C ==> D], + * returns [A /\ C ==> B /\ D]. + *) +let MKIMP_CONJ = MKIMP_common MONO_AND + +(* Similar to [MK_DISJ] but theorems should be implicational instead of + * equational, i.e., disjoin both sides of two implicational theorems. + * + * More precisely: given two theorems [A ==> B] and [C ==> D], + * returns [A \/ C ==> B \/ D]. + *) +let MKIMP_DISJ = MKIMP_common MONO_OR + +let MKIMP_IFF = + let lem = + TAUT `((A ==> B) ==> (C ==> D)) /\ ((B ==> A) ==> (D ==> C)) ==> (A <=> B) + ==> (C <=> D)` + in + fun th1 th2 -> + let ab,cd = dest_imp (concl th1) in + let a,b = dest_imp ab and c,d = dest_imp cd in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +(* th1 = (A ==> B) ==> C1 + * th2 = (B ==> A) ==> C2 + * output = (A <=> B) ==> (C1 /\ C2) + *) +let MKIMP_CONTRA_IFF = + let lem = + TAUT `((A ==> B) ==> C) /\ ((B ==> A) ==> D) ==> (A <=> B) ==> C /\ D` + in + fun th1 th2 -> + let ab,c = dest_imp (concl th1) and _,d = dest_imp (concl th2) in + let a,b = dest_imp ab in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +let MKIMPL_CONTRA_IFF = + let lem = TAUT `((A ==> B) ==> C) ==> (A <=> B) ==> C /\ (B ==> A)` in + fun th -> + let ab,c = dest_imp (concl th) in + let a,b = dest_imp ab in + MP (INST [a,A_;b,B_;c,C_] lem) th + +let MKIMPR_CONTRA_IFF = + let lem = + TAUT `((B ==> A) ==> D) ==> (A <=> B) ==> (A ==> B) /\ D` + in + fun th -> + let ba,d = dest_imp (concl th) in + let b,a = dest_imp ba in + MP (INST [a,A_;b,B_;d,D_] lem) th + +let MKIMP_CO_IFF = + let lem = + TAUT `(C ==> A ==> B) /\ (D ==> B ==> A) ==> C /\ D ==> (A <=> B)` + in + fun th1 th2 -> + let c,ab = dest_imp (concl th1) and d,_ = dest_imp (concl th2) in + let a,b = dest_imp ab in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +let MKIMPL_CO_IFF = + let lem = + TAUT `(C ==> A ==> B) ==> C /\ (B ==> A) ==> (A <=> B)` + in + fun th -> + let c,ab = dest_imp (concl th) in + let a,b = dest_imp ab in + MP (INST [a,A_;b,B_;c,C_] lem) th + +let MKIMPR_CO_IFF = + let lem = TAUT `(D ==> B ==> A) ==> (A ==> B) /\ D ==> (A <=> B)` in + fun th -> + let d,ba = dest_imp (concl th) in + let b,a = dest_imp ba in + MP (INST [a,A_;b,B_;d,D_] lem) th + +(* Given two theorems [A ==> B] and [C ==> D], + * returns [(B ==> C) ==> (A ==> D)]. + *) +let MKIMP_IMP th1 th2 = + let b,a = dest_imp (concl th1) and c,d = dest_imp (concl th2) in + MP (INST [a,A_;b,B_;c,C_;d,D_] MONO_IMP) (CONJ th1 th2) + +let MKIMPL_common lem = + let lem' = REWRITE_RULE[] (INST [C_,D_] lem) in + fun th t -> + let a,b = dest_imp (concl th) in + MP (INST [a,A_;b,B_;t,C_] lem') th + +(* Given a theorem [A ==> B] and a term [C], + * returns [A /\ C ==> B /\ C]. + *) +let MKIMPL_CONJ = MKIMPL_common MONO_AND + +(* Given a theorem [A ==> B] and a term [C], + * returns [A \/ C ==> B \/ C]. + *) +let MKIMPL_DISJ = MKIMPL_common MONO_OR + +(* Given a theorem [A ==> B] and a term [C], + * returns [(B ==> C) ==> (A ==> C)]. + *) +let MKIMPL_IMP = + let MONO_IMP' = REWRITE_RULE[] (INST [C_,D_] MONO_IMP) in + fun th t -> + let b,a = dest_imp (concl th) in + MP (INST [a,A_;b,B_;t,C_] MONO_IMP') th + +let MKIMPR_common lem = + let lem' = REWRITE_RULE[] (INST [A_,B_] lem) in + fun t th -> + let c,d = dest_imp (concl th) in + MP (INST [c,C_;d,D_;t,A_] lem') th + +(* Given a term [A] and a theorem [B ==> C], + * returns [A /\ B ==> A /\ C]. + *) +let MKIMPR_CONJ = MKIMPR_common MONO_AND + +(* Given a term [A] and a theorem [B ==> C], + * returns [A \/ B ==> A \/ C]. + *) +let MKIMPR_DISJ = MKIMPR_common MONO_OR + +(* Given a term [A] and a theorem [B ==> C], + * returns [(A ==> B) ==> (A ==> C)]. + *) +let MKIMPR_IMP = MKIMPR_common MONO_IMP + +(* Given a theorem [A ==> B], returns [~B ==> ~A]. *) +let MKIMP_NOT th = + let b,a = dest_imp (concl th) in + MP (INST [a,A_;b,B_] MONO_NOT) th + +let MKIMP_QUANT lem x th = + let x_ty = type_of x and p,q = dest_imp (concl th) in + let p' = mk_abs(x,p) and q' = mk_abs(x,q) in + let P = mk_var("P",mk_fun_ty x_ty bool_ty) in + let Q = mk_var("Q",mk_fun_ty x_ty bool_ty) in + let lem = INST [p',P;q',Q] (INST_TYPE [x_ty,aty] lem) in + let c = ONCE_DEPTH_CONV (ALPHA_CONV x) THENC ONCE_DEPTH_CONV BETA_CONV in + MP (CONV_RULE c lem) (GEN x th) + +(* Given a variable [x] and a theorem [A ==> B], + * returns [(!x. A) ==> (!x. B)]. *) +let MKIMP_FORALL = MKIMP_QUANT MONO_FORALL + +(* Given a variable [x] and a theorem [A ==> B], + * returns [(?x. A) ==> (?x. B)]. *) +let MKIMP_EXISTS = MKIMP_QUANT MONO_EXISTS + +(* Given two theorems [A ==> B] and [B ==> C ==> D], + * returns [(B ==> C) ==> (A ==> D)], + * i.e., similar to [MKIMP_IMP] but allows to remove the context [B] + * since it is a consequence of [A]. + *) +let MKIMP_IMP_CONTRA_CTXT = + let lem = TAUT `(B==>A) /\ (A==>B==>C==>D) ==> (A==>C) ==> (B==>D)` in + fun th1 th2 -> + let a,bcd = dest_imp (concl th2) in + let b,cd = dest_imp bcd in + let c,d = dest_imp cd in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +let MKIMP_IMP_CO_CTXT = + let lem = TAUT `(A==>B) /\ (A==>B==>D==>C) ==> (B==>D) ==> (A==>C)` in + fun th1 th2 -> + let a,bdc = dest_imp (concl th2) in + let b,dc = dest_imp bdc in + let d,c = dest_imp dc in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +(* Given a theorem [B ==> C ==> D], returns [(B ==> C) ==> (B ==> D)], + * i.e., similar to [MKIMP_IMP] but allows to remove the context [B] + * since it is a consequence of [A]. + *) +let MKIMPR_IMP_CTXT = + let lem = TAUT `(A==>C==>D) ==> (A==>C) ==> (A==>D)` in + fun th -> + let a,cd = dest_imp (concl th) in + let c,d = dest_imp cd in + MP (INST [c,C_;d,D_;a,A_] lem) th + +(* Given two theorems [A ==> B] and [A ==> B ==> C ==> D], + * returns [(A /\ C) ==> (B /\ D)], + * i.e., similar to [MKIMP_CONJ] but allows to remove the contexts [A] and [B]. + *) +let MKIMP_CONJ_CONTRA_CTXT = + let lem = TAUT `(C==>A==>B) /\ (A==>B==>C==>D) ==> (A/\C==>B/\D)` in + fun th1 th2 -> + let a,bcd = dest_imp (concl th2) in + let b,cd = dest_imp bcd in + let c,d = dest_imp cd in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +let MKIMPL_CONJ_CONTRA_CTXT = + let lem = TAUT `(C==>A==>B) ==> (A/\C==>B/\C)` in + fun th -> + let c,ab = dest_imp (concl th) in + let a,b = dest_imp ab in + MP (INST [a,A_;b,B_;c,C_] lem) th + +let MKIMPR_CONJ_CONTRA_CTXT = + let lem = TAUT `(A==>C==>D) ==> (A/\C==>A/\D)` in + fun th -> + let a,cd = dest_imp (concl th) in + let c,d = dest_imp cd in + MP (INST [a,A_;c,C_;d,D_] lem) th + +let MKIMP_CONJ_CO_CTXT = + let lem = TAUT `(B==>A) /\ (B==>D==>C) ==> (B/\D==>A/\C)` in + fun th1 th2 -> + let b,a = dest_imp (concl th1) in + let d,c = dest_imp (snd (dest_imp (concl th2))) in + MP (INST [a,A_;b,B_;c,C_;d,D_] lem) (CONJ th1 th2) + +let MKIMPL_CONJ_CO_CTXT = + let lem = TAUT `(B==>A) ==> (B/\C==>A/\C)` in + fun th -> + let b,a = dest_imp (concl th) in + fun c -> MP (INST [a,A_;b,B_;c,C_] lem) th + +let MKIMPL_CONJ_CO2_CTXT = + let lem = TAUT `(C==>B==>A) ==> (B/\C==>A/\C)` in + fun th -> + let c,ba = dest_imp (concl th) in + let b,a = dest_imp ba in + MP (INST [a,A_;b,B_;c,C_] lem) th + +let MKIMPR_CONJ_CO_CTXT = MKIMPR_CONJ_CONTRA_CTXT + + +(*****************************************************************************) +(* IMPLICATIONAL CONVERSIONS *) +(*****************************************************************************) + +open Variance + +(* An implicational conversion maps a term t to a theorem of the form: + * t' ==> t if covariant + * t ==> t' if contravariant + *) +type imp_conv = Variance.t -> term -> thm + +(* Trivial embedding of conversions into implicational conversions. *) +let imp_conv_of_conv:conv->imp_conv = + fun c v t -> + let th1,th2 = EQ_IMP_RULE (c t) in + match v with Co -> th2 | Contra -> th1 + +(* Retrieves the outcome of an implicational conversion, i.e., t'. *) +let imp_conv_outcome th v = + let t1,t2 = dest_binary_blind (concl th) in + match v with Co -> t1 | Contra -> t2 + +(* [ALL_IMPCONV _ t] returns `t==>t` *) +let ALL_IMPCONV:imp_conv = fun _ -> IMP_REFL + +(* The implicational conversion which always fails. *) +let NO_IMPCONV:imp_conv = fun _ _ -> failwith "NO_IMPCONV" + +let bind_impconv (c:imp_conv) v th = + let t1,t2 = dest_imp (concl th) in + match v with + |Co -> IMP_TRANS (c v t1) th + |Contra -> IMP_TRANS th (c v t2) + +let THEN_IMPCONV (c1:imp_conv) c2 v t = bind_impconv c2 v (c1 v t) + + +(*****************************************************************************) +(* SOME USEFUL IMPLICATIONAL CONVERSIONS *) +(*****************************************************************************) + +(* Given a theorem [p ==> c], returns the implicational conversion which: + * - in the covariant case, matches the input term [t] against [c] and returns + * [s(p) ==> t], where [s] is the matching substitution + * - in the contravariant case, matches the input term [t] against [p] and returns + * [t ==> s(c)], where [s] is the matching substitution + *) +let MATCH_MP_IMPCONV:thm->imp_conv = + fun th -> function + |Co -> GEN_PART_MATCH rand th + |Contra -> GEN_PART_MATCH lhand th + + +(*****************************************************************************) +(* INTERFACE *) +(*****************************************************************************) + +(* From an implicational conversion builds a rule, i.e., a function which + * takes a theorem and returns a new theorem. + *) +let IMPCONV_RULE:imp_conv->thm->thm = + fun c th -> + let t = concl th in + MATCH_MP (c Contra t) th + +(* From an implicational conversion builds a tactic. *) +let IMPCONV_TAC:imp_conv->tactic = + fun cnv (_,c as g) -> + (MATCH_MP_TAC (cnv Co c) THEN TRY (ACCEPT_TAC TRUTH)) g + + +(*****************************************************************************) +(* CONTEXT HANDLING *) +(*****************************************************************************) + +(* [term list] = terms to add to the context *) +type 'a with_context = + With_context of 'a * (Tset.t -> 'a with_context) * (term -> 'a with_context) + +let apply (With_context(c,_,_)) = c + +(* Maybe avoid the augment if the input list is empty? *) +let augment (With_context(_,a,_)) = a +let diminish (With_context(_,_,d)) = d +let apply_with_context c ctx v t = + DISCH_CONJ ctx (apply (augment c (Tset.strip_conj ctx)) v t) + +let imp_conv_of_ctx_imp_conv = (apply:imp_conv with_context -> imp_conv) + +(* Consider two implicational conversions ic1, ic2. + * Suppose [ic1 Co A] returns [B ==> A], and [ic2 Co C] returns [D ==> C], + * then [CONJ_IMPCONV ic1 ic2 Co (A /\ C)] returns [B /\ D ==> A /\ C]. + * Suppose [ic1 Contra A] returns [A ==> B], and [ic2 Contra C] returns + * [C ==> D], then [CONJ_IMPCONV ic1 ic2 Contra (A /\ B)] + * returns [A /\ B ==> C /\ D]. + * + * Additionally takes the context into account, i.e., if [ic2 Co C] returns + * [A |- D ==> C], + * then [CONJ_IMPCONV ic1 ic2 Co (A /\ B)] returns [|- C /\ D ==> A /\ B] + * (i.e., [A] does not appear in the hypotheses). + *) +let rec CONJ_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> + let t1,t2 = dest_conj t in + match v with + |Co -> + (try + let th1 = apply c Co t1 in + try + let t1' = imp_conv_outcome th1 Co in + MKIMP_CONJ_CO_CTXT th1 (apply_with_context c t1' Co t2) + with Failure _ -> MKIMPL_CONJ_CO_CTXT th1 t2 + with Failure _ -> MKIMPR_CONJ_CO_CTXT (apply_with_context c t1 Co t2)) + |Contra -> + try + (* note: we remove t1 in case it appears in t2, since otherwise, + * t1 removes t2 and t2 removes t1 + *) + let t2s = Tset.remove (Tset.strip_conj t2) t1 in + let th1 = apply (augment c t2s) Contra t1 in + try + let t1' = imp_conv_outcome th1 Contra in + let t1s = Tset.strip_conj t1 and t1s' = Tset.strip_conj t1' in + let t1s'' = Tset.union t1s t1s' in + let th2 = apply (augment c t1s'') Contra t2 in + let th2' = DISCH_CONJ t1 (DISCH_CONJ t1' th2) in + MKIMP_CONJ_CONTRA_CTXT (DISCH_CONJ t2 th1) th2' + with Failure _ -> MKIMPL_CONJ_CONTRA_CTXT (DISCH_CONJ t2 th1) + with Failure _ -> + MKIMPR_CONJ_CONTRA_CTXT (apply_with_context c t1 Contra t2)) + :imp_conv), + CONJ_CTXIMPCONV o augment c, + CONJ_CTXIMPCONV o diminish c) + +(* Consider two implicational conversions ic1, ic2. + * Suppose [ic1 Co A] returns [B ==> A], and [ic2 Co C] returns [D ==> C], + * then [DISJ_IMPCONV ic1 ic2 Co (A \/ C)] returns [B \/ D ==> A \/ C]. + * Suppose [ic1 Contra A] returns [A ==> B], and [ic2 Contra C] returns + * [C ==> D], then [DISJ_IMPCONV ic1 ic2 Contra (A \/ B)] + * returns [A \/ B ==> C \/ D]. + *) +let rec DISJ_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> + let t1,t2 = dest_disj t in + try + let th1 = apply c v t1 in + try MKIMP_DISJ th1 (apply c v t2) with Failure _ -> MKIMPL_DISJ th1 t2 + with Failure _ -> MKIMPR_DISJ t1 (apply c v t2)):imp_conv), + DISJ_CTXIMPCONV o augment c, + DISJ_CTXIMPCONV o diminish c) + +(* Consider two implicational conversions ic1, ic2. + * Suppose [ic1 Contra A] returns [A ==> B], and [ic2 Co C] returns [D ==> C], + * then [IMP_IMPCONV ic1 ic2 Co (A ==> C)] returns [(B ==> D) ==> (A ==> C)]. + * Suppose [ic1 Co A] returns [B ==> A], and [ic2 Contra C] returns + * [C ==> D], then [IMP_IMPCONV ic1 ic2 Contra (A ==> C)] + * returns [(A ==> C) ==> (B ==> D)]. + * + * Additionally takes the context into account, i.e., if [ic2 Co C] returns + * [B |- D ==> C], then [IMP_IMPCONV ic1 ic2 Co (A ==> C)] returns + * [|- (B ==> D) ==> (A ==> C)] (i.e., [B] does not appear in the hypotheses). + *) +let rec IMP_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> + let t1,t2 = dest_imp t in + try + let v' = Variance.neg v in + let th1 = apply c v' t1 in + let t1' = imp_conv_outcome th1 v' in + let t1s = Tset.union (Tset.strip_conj t1) (Tset.strip_conj t1') in + let c' = augment c t1s in + let mk = + match v with Co -> MKIMP_IMP_CO_CTXT | Contra -> MKIMP_IMP_CONTRA_CTXT + in + try mk th1 (DISCH_CONJ t1 (DISCH_CONJ t1' (apply c' v t2))) + with Failure _ -> MKIMPL_IMP th1 t2 + with Failure _ -> MKIMPR_IMP_CTXT (apply_with_context c t1 v t2) + ):imp_conv), + IMP_CTXIMPCONV o augment c, + IMP_CTXIMPCONV o diminish c) + +let rec IFF_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> + let t1,t2 = dest_iff t in + let lr,l,r = + match v with + |Co -> MKIMP_CO_IFF,MKIMPL_CO_IFF,MKIMPR_CO_IFF + |Contra -> MKIMP_CONTRA_IFF,MKIMPL_CONTRA_IFF,MKIMPR_CONTRA_IFF + in + (try + let th1 = apply c v (mk_imp (t1,t2)) in + try + let th2 = apply c v (mk_imp (t2,t1)) in + (try MKIMP_IFF th1 th2 with Failure _ -> lr th1 th2) + with Failure _ -> l th1 + with Failure _ -> r (apply c v (mk_imp (t2,t1))))):imp_conv), + IFF_CTXIMPCONV o augment c, + IFF_CTXIMPCONV o diminish c) + +(* Consider an implicational conversion ic. + * Suppose [ic Contra A] returns [A ==> B] + * then [NOT_IMPCONV ic Co ~A] returns [~B ==> ~A]. + * Suppose [ic Co A] returns [B ==> A] + * then [NOT_IMPCONV ic Contra ~A] returns [~A ==> ~B]. + *) +let rec NOT_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> MKIMP_NOT (apply c (Variance.neg v) (dest_neg t))):imp_conv), + NOT_CTXIMPCONV o augment c, + NOT_CTXIMPCONV o diminish c) + +let rec QUANT_CTXIMPCONV mkimp sel (c:imp_conv with_context) = + With_context( + ((fun v t -> + let x,b = sel t in + let c' = diminish c x in + mkimp x (apply c' v b)):imp_conv), + QUANT_CTXIMPCONV mkimp sel o augment c, + QUANT_CTXIMPCONV mkimp sel o diminish c) + +(* Consider an implicational conversion ic. + * Suppose [ic Co A] returns [B ==> A] + * then [FORALL_IMPCONV ic Co (!x.A)] returns [(!x.B) ==> (!x.A)]. + * Suppose [ic Contra A] returns [A ==> B] + * then [FORALL_IMPCONV ic Contra (!x.A)] returns [(!x.A) ==> (!x.B)]. + *) +let FORALL_CTXIMPCONV = QUANT_CTXIMPCONV MKIMP_FORALL dest_forall + +(* Consider an implicational conversion ic. + * Suppose [ic Co A] returns [B ==> A] + * then [EXISTS_IMPCONV ic Co (?x.A)] returns [(?x.B) ==> (?x.A)]. + * Suppose [ic Contra A] returns [A ==> B] + * then [EXISTS_IMPCONV ic Contra (?x.A)] returns [(?x.A) ==> (?x.B)]. + *) +let EXISTS_CTXIMPCONV = QUANT_CTXIMPCONV MKIMP_EXISTS dest_exists + +(* Applies an implicational conversion on the subformula(s) of the input term*) +let rec SUB_CTXIMPCONV = + let iff_ty = `:bool->bool->bool` in + fun c -> + With_context( + ((fun v t -> + let n,ty = dest_const (fst (strip_comb t)) in + apply + ((match n with + |"==>" -> IMP_CTXIMPCONV + |"/\\" -> CONJ_CTXIMPCONV + |"\\/" -> DISJ_CTXIMPCONV + |"=" when ty = iff_ty -> IFF_CTXIMPCONV + |"!" -> FORALL_CTXIMPCONV + |"?" -> EXISTS_CTXIMPCONV + |"~" -> NOT_CTXIMPCONV + |_ -> failwith "SUB_CTXIMPCONV") c) + v t):imp_conv), + SUB_CTXIMPCONV o augment c, + SUB_CTXIMPCONV o diminish c) + +(* Takes a theorem which results of an implicational conversion and applies + * another implicational conversion on the outcome. + *) +let bind_ctximpconv (c:imp_conv with_context) v th = + let t1,t2 = dest_imp (concl th) in + match v with + |Co -> IMP_TRANS (apply c v t1) th + |Contra -> IMP_TRANS th (apply c v t2) + +let rec BIND_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v th -> bind_ctximpconv c v th), + BIND_CTXIMPCONV o augment c, + BIND_CTXIMPCONV o diminish c)) + +(* Sequential combinator. *) +let rec THEN_CTXIMPCONV (c1:imp_conv with_context) (c2:imp_conv with_context) = + With_context( + ((fun v t -> bind_ctximpconv c2 v (apply c1 v t)):imp_conv), + (fun x -> THEN_CTXIMPCONV (augment c1 x) (augment c2 x)), + (fun x -> THEN_CTXIMPCONV (diminish c1 x) (diminish c2 x))) + +(* Try combinator *) +let rec TRY_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> + try apply c v t + with Failure _ | Unchanged -> ALL_IMPCONV v t):imp_conv), + TRY_CTXIMPCONV o augment c, + TRY_CTXIMPCONV o diminish c) + + +(* Applies the first of two implicational conversions that succeeds. *) +let rec ORELSE_CTXIMPCONV + (c1:imp_conv with_context) (c2:imp_conv with_context) = + With_context( + ((fun v t -> try apply c1 v t with Failure _ -> apply c2 v t):imp_conv), + (fun x -> ORELSE_CTXIMPCONV (augment c1 x) (augment c2 x)), + (fun x -> ORELSE_CTXIMPCONV (diminish c1 x) (diminish c2 x))) + +(* Makes an implicational conversion fail if applying it leaves a term + * unchanged. + *) +let rec CHANGED_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> + let th = apply c v t in + let l,r = dest_imp (concl th) in + if aconv l r then failwith "CHANGED_CTXIMPCONV" else th):imp_conv), + CHANGED_CTXIMPCONV o augment c, + CHANGED_CTXIMPCONV o diminish c) + +let rec UNCHANGED_OF_FAIL_CTXIMPCONV (c:imp_conv with_context) = + With_context( + ((fun v t -> try apply c v t with Failure _ -> raise Unchanged + ):imp_conv), + UNCHANGED_OF_FAIL_CTXIMPCONV o augment c, + UNCHANGED_OF_FAIL_CTXIMPCONV o diminish c) + +let rec REPEAT_UNCHANGED_CTXIMPCONV = + let rec map_all f xs x = + match xs with + |[] -> [] + |y::ys -> f y x :: map_all f ys x + in + fun (cs:imp_conv with_context list) -> + With_context( + ((fun v t -> + let rec loop changed acc = function + |[] when changed -> loop false acc cs + |[] -> acc + |c::cs' -> + try + let acc' = bind_ctximpconv c v acc in + loop true acc' cs' + with Unchanged -> loop changed acc cs' + in + loop false (IMP_REFL t) cs):imp_conv), + REPEAT_UNCHANGED_CTXIMPCONV o map_all augment cs, + REPEAT_UNCHANGED_CTXIMPCONV o map_all diminish cs) + + +type atomic = Atomic | Non_atomic + +let DEPTH_CTXIMPCONV = + let bind c na v th = + let t1,t2 = dest_imp (concl th) in + match v with + |Co -> IMP_TRANS (apply c na v t1) th + |Contra -> IMP_TRANS th (apply c na v t2) + in + let rec self (c:(atomic->imp_conv) with_context) = + With_context( + (fun v t -> + try + let th1 = apply (SUB_CTXIMPCONV (self c)) v t in + (try bind c Non_atomic v th1 with Failure _ -> th1) + with + | Failure "SUB_CTXIMPCONV" -> + let th1 = apply c Atomic v t in + (try bind_ctximpconv (self c) v th1 with Failure _ -> th1) + | Failure _ -> apply c Non_atomic v t), + self o augment c, + self o diminish c) + in + UNCHANGED_OF_FAIL_CTXIMPCONV o self + +let TOP_DEPTH_CTXIMPCONV = + let rec self (c:imp_conv with_context) = + With_context( + (fun v t -> + try + let th = apply c v t in + try bind_ctximpconv (self c) v th with Failure _ -> th + with Failure _ -> apply (SUB_CTXIMPCONV (self c)) v t), + self o augment c, + self o diminish c) + in + UNCHANGED_OF_FAIL_CTXIMPCONV o self + +let ONCE_DEPTH_CTXIMPCONV = + let rec self (c:(atomic->imp_conv) with_context) = + With_context( + (fun v t -> + try apply (SUB_CTXIMPCONV (self c)) v t + with + | Failure "SUB_CTXIMPCONV" -> apply c Atomic v t + | Failure _ -> apply c Non_atomic v t), + self o augment c, + self o diminish c) + in + UNCHANGED_OF_FAIL_CTXIMPCONV o self + + +let CTXIMPCONV_RULE (c:imp_conv with_context) th = + MATCH_MP (apply c Contra (concl th)) th + +let CTXIMPCONV_TAC (cnv:imp_conv with_context) : tactic = + fun (asms,c as g) -> + let cnv' = augment cnv (map (concl o snd) asms) in + (MATCH_MP_TAC (apply cnv' Co c) THEN TRY (ACCEPT_TAC TRUTH)) g + +(*****************************************************************************) +(* REWRITE IMPLICATIONAL CONVERSION *) +(*****************************************************************************) + +(* Given a theorem [H1,...,Hn |- P ==> l = r], + * returns the variables that occur in [P] and [r] but not in the rest. + * Basically represents the variables that are introduced by the implicational + * rewrite (similar status as variables occurring in the r.h.s. of a rewrite + * but not in the l.h.s.). + *) +let indep_vars th = + let hs,c = dest_thm (SPEC_ALL th) in + let p,c = dest_imp c in + let all_vars = union (frees p) (frees (rhs c)) in + let dep_vars = union (frees (lhs c)) (freesl hs) in + subtract all_vars dep_vars + +(* Given a list of variables to avoid [v1,...,vk], a theorem of the form + * [hs |- !x1...xn. p ==> !y1...ym. l = r], and a term [t], matches [t] with + * [l], yielding the substitution [s], and returns the theorem + * [s(hs) |- !z1...zp. s(p) ==> s(l) = s(r)] where [z1], ..., [zp] are the + * variables among [x1], ..., [xn], [y1], ..., [ym] that are not instantiated + * by [s], and renamed so as to avoid [v1], ..., [vk]. + *) +let GEN_IMPREWR_CONV avs = + let sel = lhs o snd o strip_forall o snd o dest_imp in + let pmatch = GEN_PART_MATCH_ALL sel in + fun th -> + let pmatch' = pmatch th in + fun t -> + let th' = pmatch' t in + VARIANT_RULE avs (GENL (indep_vars th') th') + +(* A conversion which returns not only a theorem but also a list of terms + * which is a sublist of the theorem hypotheses, and a list of terms which + * are the variables newly introduced by the conversion. + * + * See [IMPREWR_CONV] for an example. + *) +type annot_conv = term -> thm * term option * term list + +(* Takes a list of variables to avoid [av], a theorem [th] of the form + * [h1,..,hk |- !x1...xn. p ==> !y1...ym. l = r], and a term [t] + * and returns a conversion with hypotheses defined as follows: + * for a term [t], if [t] matches [l] with substitution [s], then return + * the theorem [h1,...,hk,s(p) |- t = s(r)] and the the list containing only + * [s(p)]. + * + * The purpose of the conversion with hypothesis is to be able to distinguish + * which hypothesis comes from the input theorem and which is added by the + * conversion itself. + *) +let IMPREWR_CONV:Tset.t->thm->annot_conv = + fun avs th -> + let f t = SPEC_VARS (GEN_IMPREWR_CONV avs th t) in + fun t -> + let vs,uh = f t in + let u = fst (dest_imp (concl uh)) in + UNDISCH uh,Some u,Tset.of_list vs + +let REWR_ANNOTCONV avs th t = + let th' = PART_MATCH lhs th t in + let _,t' = dest_binary_blind (concl th') in + let new_vars = Tset.frees t' in + let old_vars = Tset.union (Tset.frees t) (Tset.freesl (hyp th')) in + th',None,Tset.subtract new_vars old_vars + +let ORDER_ANNOTCONV cnv t = + let th,_,_ as res = cnv t in + let l,r = dest_binary_blind (concl th) in + if term_order l r then res else failwith "ORDER_ANNOTCONV" + +(* Takes a theorem, a net of conversions with hypotheses (which also take + * variables to avoid), and adds to the net the conversion corresponding to + * the theorem. + * + * Special cases: + * - usual term rewriting is handled with [REWR_CONV] instead of introducing + * a fake premise. Might be useful though to introduce a fake premise since + * the conversion would benefit from a better handling of variables occurring + * in the r.h.s. but not in the l.h.s. + * - a theorem of the form [p ==> c] where [c] is not equational is turned into + * [p ==> c = T] + * - a theorem of the form [p ==> ~c] is turned into [p ==> c = F] + *) +let pat_cnv_of_thm th : (term * (term list->annot_conv)) = + let th = SPEC_ALL th in + let lconsts = freesl (hyp th) and c = concl th in + match c with + |Comb(Comb(Const("=",_),l),r) as t -> + let matches = C (can o term_match lconsts) in + if free_in l r or (matches l r & matches r l) + then t,C REWR_ANNOTCONV (MAP_FORALL_BODY EQT_INTRO th) + else l,C REWR_ANNOTCONV th + |Comb(Comb(Const("==>",_),p),c) as t -> + let matches = C (can o fo_term_match lconsts) in + let imprewr_concl f = C IMPREWR_CONV (GEN_MAP_CONCLUSION f th) in + (match c with + |Comb(Comb(Const("=",_),l),r) -> + if free_in l r or (matches l r & matches r l) or is_var l + then + if matches p c + then t, C REWR_ANNOTCONV (EQT_INTRO th) + else c, imprewr_concl EQT_INTRO + else l, C IMPREWR_CONV th + |Comb(Const("~",_),l) -> l, imprewr_concl EQF_INTRO + |l -> l, imprewr_concl EQT_INTRO) + |Comb(Const("~",_),l) -> l, C REWR_ANNOTCONV (EQF_INTRO th) + |Const("T",bool_ty) -> failwith "pat_cnv_of_thm" + |l -> l, C REWR_ANNOTCONV (EQT_INTRO th) + +let impconv_net_of_thm th = + try + let p,c = pat_cnv_of_thm th in + let vs = Tset.freesl (hyp th) in + Fo_nets.enter vs (p,(c,vs,th)) + with Failure _ -> I + +let patterns_of_thm = fst o pat_cnv_of_thm + +(* Apply a conversion net to the term at the top level, taking + * avoided variables as parameter too. + *) +let REWRITES_IMPCONV + (net:((term list -> annot_conv) * Tset.t * thm) Fo_nets.t) avs t = + tryfind (fun c,_,_ -> c avs t) (Fo_nets.lookup t net) + +let extra_basic_rewrites = + itlist (mk_rewrites false) [NOT_FORALL_THM;NOT_IMP] [] + +let IMPREWR_CTXCONV :thm list -> (atomic->annot_conv) with_context = + let rec top_depth c avs t = + let rec (++) c1 c2 avs t = + match c1 avs t with + |_,Some _,_ as c1t -> c1t + |th1,None,vs1 as c1t -> + (try + let th2,ho2,vs2 = c2 (Tset.union vs1 avs) (rand (concl th1)) in + TRANS th1 th2, ho2, Tset.union vs1 vs2 + with Failure _ -> c1t) + and (+) c1 c2 avs t = try (c1 ++ c2) avs t with Failure _ -> c2 avs t + and COMB_QCONV c avs l r = + try + match c avs l with + |th,(Some _ as ho),vs -> AP_THM th r,ho,vs + |th1,None,vs1 -> + (try + let th2,ho2,vs2 = c (Tset.union vs1 avs) r in + MK_COMB (th1,th2), ho2, Tset.union vs1 vs2 + with Failure _ -> AP_THM th1 r,None,vs1) + with Failure _ -> + let th2,ho2,vs2 = c avs r in + AP_TERM l th2,ho2,vs2 + in + let SUB_QCONV c avs t = + match t with + |Comb(l,r) -> COMB_QCONV c avs l r + |Abs(v,_) -> + let ho = ref None and vs = ref [] in + let c' t = + let th,ho',vs' = c (Tset.insert avs v) t in + ho := ho'; vs := vs'; th + in + let res = ABS_CONV c' t in + res,!ho,!vs + |_ -> failwith "SUB_QCONV" + in + let rec (!) c avs t = (c ++ !c) avs t in + (!c + (SUB_QCONV (top_depth c) ++ top_depth c)) avs t + in + let bigger_net() = + itlist (net_of_thm false) extra_basic_rewrites (basic_net()) in + let basic_cnv t = REWRITES_CONV (bigger_net ()) t,None,[] in + let rec self net ths = + let avs = Tset.flat_revmap (Tset.freesl o hyp) ths in + let cnv avs t = + try REWRITES_IMPCONV net avs t with Failure _ -> basic_cnv t + in + With_context( + (fun a t -> + let f = match a with Atomic -> top_depth | Non_atomic -> I in + f cnv (Tset.union (Tset.frees t) avs) t), + (fun ts -> + let ths' = map ASSUME ts in + (*let ths'' = ths' @ GMATCH_MPS ths ths' in*) + let ths'' = MP_CLOSURE ths' ths' @ ths' @ MP_CLOSURE ths ths' in + self (itlist impconv_net_of_thm ths'' net) (ths'' @ ths)), + (fun v -> + let ths = ref [] in + let f (_,vs,th) = + if not (Tset.mem v vs) then (ths := th :: !ths; true) else false + in + let net' = Fo_nets.filter f net in + self net' !ths)) + in + fun ths -> self (itlist impconv_net_of_thm ths Fo_nets.empty_net) ths + + +(*****************************************************************************) +(* SOME USEFUL IMPLICATIONAL CONVERSIONS *) +(*****************************************************************************) + +(* Takes a conversion with hypotheses (with context) and makes an + * implicational conversion out of it. + * Basically turns a rewrite with hypotheses into an implicational rewrite + * withouth hypotheses. + * Adds existential quantifications for variables introduced by the rewrite. + *) +let rec REWR_IMPCONV_OF_CONV = + let IMP_SYM = REWR_RULE (TAUT `A==>B==>C <=> B==>A==>C`) in + let IMP_EXIST = GSYM LEFT_IMP_EXISTS_THM in + let TRY_GEN v th = try GEN v th with Failure _ -> th in + fun (c:(atomic -> annot_conv) with_context) -> + With_context( + ((fun a v t -> + let th,ho,new_vars = apply c a t in + let th1,th2 = EQ_IMP_RULE th in + let res = + match v with + |Co -> + let p,th2' = UNDISCH_TERM th2 in + let rec exists_intro = function + |[] -> DISCH_IMP_IMP (p::list_of_option ho) th2' + |v::vs -> + let th = exists_intro vs in + try REWR_RULE IMP_EXIST (GEN v th) with Failure _ -> th + in + exists_intro new_vars + |Contra -> + let th1' = + match ho with None -> th1 | Some h -> IMP_SYM (DISCH h th1) + in + match new_vars with + |[] -> th1' + |_::_ -> MAP_CONCLUSION (itlist TRY_GEN new_vars) th1' + in + let t1,t2 = dest_imp (concl res) in + if t1 = t2 then raise Unchanged else res):atomic->imp_conv), + REWR_IMPCONV_OF_CONV o augment c, + REWR_IMPCONV_OF_CONV o diminish c) + +(* Applies the implicational rewrite, with context simplifications. *) +let REWRITE_CTXIMPCONV = + DEPTH_CTXIMPCONV o REWR_IMPCONV_OF_CONV o IMPREWR_CTXCONV + + +(*****************************************************************************) +(* INTERFACE *) +(*****************************************************************************) + +(* Preprocessor. For now takes a theorem of the form [p ==> c1 /\ ... /\ ck] + * and returns the list of theorems [p ==> c1], ..., [p ==> ck]. + *) +let preprocess = CONJUNCTS o IMPLY_AND + +(* Tactic for implicational rewrite. *) +let IMP_REWRITE_TAC ths = + CTXIMPCONV_TAC (REWRITE_CTXIMPCONV (flat (map preprocess ths))) + +let SEQ_IMP_REWRITE_TAC ths = + let cnv = + match ths with + |[] -> REWRITE_CTXIMPCONV [TRUTH] + |[th] -> REWRITE_CTXIMPCONV (preprocess th) + |_::_ -> + let fcnv = REWRITE_CTXIMPCONV o preprocess in + REPEAT_UNCHANGED_CTXIMPCONV (map fcnv ths) + in + CTXIMPCONV_TAC cnv + +(* Tactic for implicational rewrite with assumptions. *) +let ASM_IMP_REWRITE_TAC = ASM IMP_REWRITE_TAC + +(* Cases-like conversion for implicational theorems, i.e., for a theorem of + * the form: + * [h1,..,hk |- !x1...xn. p ==> !y1...ym. l = r], and a term [t], + * return [(p ==> t') /\ (~p ==> t)], where [t'] is the result of rewriting + * [t] by [l=r]. + *) +let rec CASE_REWR_IMPCONV_OF_CONV = + let MP_TAUT th = MATCH_MP (TAUT th) in + let MP_LEM1 = MP_TAUT `(~P ==> Q = R) ==> (Q <=> (~P ==> R) /\ (P ==> Q))` in + let MP_LEM2 = MP_TAUT `(P ==> Q = R) ==> (Q <=> (P ==> R) /\ (~P ==> Q))` in + fun (c:(atomic -> annot_conv) with_context) -> + With_context( + (fun a v t -> + match apply c a t with + |_,None,_ -> failwith "CASE_REWR_IMPCONV_OF_CONV" + |th,Some h,_ -> + let th' = DISCH h th in + let th'' = try MP_LEM1 th' with Failure _ -> MP_LEM2 th' in + imp_conv_of_conv (REWR_CONV th'') v t), + CASE_REWR_IMPCONV_OF_CONV o augment c, + CASE_REWR_IMPCONV_OF_CONV o diminish c) + +let CASE_REWRITE_CTXIMPCONV = + ONCE_DEPTH_CTXIMPCONV o CASE_REWR_IMPCONV_OF_CONV o IMPREWR_CTXCONV + +(* Tactic version of it. *) +let CASE_REWRITE_TAC = CTXIMPCONV_TAC o CASE_REWRITE_CTXIMPCONV o preprocess + +(*****************************************************************************) +(* IMPLICATIONAL CONVERSIONS WITH MULTIPLE RESULTS *) +(*****************************************************************************) + +(* Multiple implicational conversion. *) +type imp_mconv = Variance.t -> term -> thm list + +let mapply_with_context c ctx v t = + map (DISCH_CONJ ctx) (apply (augment c (Tset.strip_conj ctx)) v t) + +(* Consider two multiple implicational conversions ic1, ic2. + * Suppose [ic1 Co A] returns a list [B1 ==> A; ...; Bk ==> A], + * and [ic2 Co C] returns [D1 ==> C; ...; Dn ==> C], + * then [CONJ_IMPMCONV ic1 ic2 Co (A /\ C)] returns + * [B1 /\ C ==> A /\ C; ...; Bk /\ C ==> A /\ C; A /\ D1 ==> A /\ C; ...; Dn + * ==> A /\ C]. + * + * And similarly for the contravariant case. + *) +let rec CONJ_CTXIMPMCONV (c:imp_mconv with_context) + : imp_mconv with_context = + With_context( + (fun v t -> + let t1,t2 = dest_conj t in + let left,right = + match v with + |Co -> MKIMPL_CONJ_CO2_CTXT,MKIMPR_CONJ_CO_CTXT + |Contra -> MKIMPL_CONJ_CONTRA_CTXT,MKIMPR_CONJ_CONTRA_CTXT + in + let th1s = map left (mapply_with_context c t2 v t1) in + let th2s = map right (mapply_with_context c t1 v t2) in + th1s @ th2s), + CONJ_CTXIMPMCONV o augment c, + CONJ_CTXIMPMCONV o diminish c) + +(* Consider two multiple implicational conversions ic1, ic2. + * Suppose [ic1 Co A] returns a list [B1 ==> A; ...; Bk ==> A], + * and [ic2 Co C] returns [D1 ==> C; ...; Dn ==> C], + * then [DISJ_IMPMCONV ic1 ic2 Co (A \/ C)] returns + * [B1 \/ C ==> A \/ C; ...; Bk \/ C ==> A \/ C; A \/ D1 ==> A \/ C; ...; Dn + * ==> A \/ C]. + * + * And similarly for the contravariant case. + *) +let rec DISJ_CTXIMPMCONV (c:imp_mconv with_context) + : imp_mconv with_context = + With_context( + (fun v t -> + let t1,t2 = dest_disj t in + let th1s = map (C MKIMPL_DISJ t2) (apply c v t1) in + let th2s = map (MKIMPR_DISJ t1) (apply c v t2) in + th1s @ th2s), + DISJ_CTXIMPMCONV o augment c, + DISJ_CTXIMPMCONV o diminish c) + +(* Consider two multiple implicational conversions ic1, ic2. + * Suppose [ic1 Contra A] returns a list [A ==> B1; ...; A ==> Bk], + * and [ic2 Co C] returns [D1 ==> C; ...; Dn ==> C], + * then [DISJ_IMPMCONV ic1 ic2 Co (A \/ C)] returns + * [(B1 ==> C) ==> (A ==> C); ...; (Bk ==> C) ==> (A ==> C); (A ==> D1) ==> (A + * ==> C); ...; (A ==> Dn) ==> (A ==> C)]. + * + * And similarly for the contravariant case. + *) +let rec IMP_CTXIMPMCONV (c:imp_mconv with_context) + : imp_mconv with_context = + With_context( + (fun v t -> + let t1,t2 = dest_imp t in + let th1s = map (C MKIMPL_IMP t2) (apply c (Variance.neg v) t1) in + let th2s = map MKIMPR_IMP_CTXT (mapply_with_context c t1 v t2) in + th1s @ th2s), + CONJ_CTXIMPMCONV o augment c, + CONJ_CTXIMPMCONV o diminish c) + +let rec IFF_CTXIMPCONV (c:imp_mconv with_context) = + With_context( + ((fun v t -> + let t1,t2 = dest_iff t in + let left,right = + match v with + |Co -> MKIMPL_CO_IFF,MKIMPR_CO_IFF + |Contra -> MKIMPL_CONTRA_IFF,MKIMPR_CONTRA_IFF + in + let th1s = map left (apply c v (mk_imp(t1,t2))) in + let th2s = map right (apply c v (mk_imp(t2,t1))) in + th1s @ th2s):imp_mconv), + IFF_CTXIMPCONV o augment c, + IFF_CTXIMPCONV o diminish c) + +(* Consider one multiple implicational conversion ic. + * Suppose [ic Contra A] returns a list [A ==> B1; ...; A ==> Bk], + * then [NOT_IMPMCONV ic Co ~A] returns [~B1 ==> ~A; ...; ~Bk ==> ~A]. + * + * And similarly for the contravariant case. + *) +let rec NOT_CTXIMPMCONV (c:imp_mconv with_context) : imp_mconv with_context = + With_context( + (fun v t -> + map MKIMP_NOT (try_list (apply c (Variance.neg v)) (dest_neg t))), + NOT_CTXIMPMCONV o augment c, + NOT_CTXIMPMCONV o diminish c) + +let rec QUANT_CTXIMPMCONV mkimp sel (c:imp_mconv with_context) + : imp_mconv with_context = + With_context( + (fun v t -> + let x,b = sel t in + let c' = diminish c x in + map (mkimp x) (try_list (apply c' v) b)), + QUANT_CTXIMPMCONV mkimp sel o augment c, + QUANT_CTXIMPMCONV mkimp sel o diminish c) + +(* Consider one multiple implicational conversion ic. + * Suppose [ic Co A] returns a list [B1 ==> A; ...; Bk ==> A], + * then [FORALL_IMPMCONV ic Co (!x.A)] returns [(!x.B1) ==> (!x.A); ...; + * (!x.Bk) ==> (!x.A)]. + * + * And similarly for the contravariant case. + *) +let FORALL_CTXIMPMCONV = QUANT_CTXIMPMCONV MKIMP_FORALL dest_forall + +(* Consider one multiple implicational conversion ic. + * Suppose [ic Co A] returns a list [B1 ==> A; ...; Bk ==> A], + * then [EXISTS_IMPMCONV ic Co (?x.A)] returns [(?x.B1) ==> (?x.A); ...; + * (?x.Bk) ==> (?x.A)]. + * + * And similarly for the contravariant case. + *) +let EXISTS_CTXIMPMCONV = QUANT_CTXIMPMCONV MKIMP_EXISTS dest_exists + +(* Applies a multiple implicational conversion on the subformula(s) of the + * input term + *) +let rec SUB_CTXIMPMCONV = + let iff_ty = `:bool->bool->bool` in + fun c -> + With_context( + ((fun v t -> + let n,ty = dest_const (fst (strip_comb t)) in + apply + ((match n with + |"==>" -> IMP_CTXIMPMCONV + |"/\\" -> CONJ_CTXIMPMCONV + |"\\/" -> DISJ_CTXIMPMCONV + |"!" -> FORALL_CTXIMPMCONV + |"?" -> EXISTS_CTXIMPMCONV + |"~" -> NOT_CTXIMPMCONV + |"=" when ty = iff_ty -> IFF_CTXIMPCONV + |_ -> failwith "SUB_CTXIMPMCONV") c) v t):imp_mconv), + SUB_CTXIMPMCONV o augment c, + SUB_CTXIMPMCONV o diminish c) + + +(* Applies a multiple implicational conversion once to the first suitable sub-term(s) + * encountered in bottom-up order. + *) +let rec DEPTH_CTXIMPMCONV (c : (atomic->imp_mconv) with_context) = + With_context( + (fun v t -> + try + let ths = apply (SUB_CTXIMPMCONV (DEPTH_CTXIMPMCONV c)) v t in + apply c Non_atomic v t @ ths + with Failure "SUB_CTXIMPMCONV" -> + (apply c Atomic v t)), + DEPTH_CTXIMPMCONV o augment c, + DEPTH_CTXIMPMCONV o diminish c) + + +(*****************************************************************************) +(* REWRITE IMPLICATIONAL CONVERSIONS *) +(*****************************************************************************) + +(* Multiple implicational conversion with hypotheses. *) +type annot_mconv = term -> (thm * term option * term list) list + +(* Takes a theorem, a net of conversions with hypotheses (which also take + * variables to avoid), and adds to the net the conversion corresponding to + * the theorem. + * + * Special cases: + * - usual term rewriting is handled with [REWR_CONV] instead of introducing + * a fake premise. Might be useful though to introduce a fake premise since + * the conversion would benefit from a better handling of variables occurring + * in the r.h.s. but not in the l.h.s. + * - a theorem of the form [p ==> c] where [c] is not equational is turned into + * [p ==> c = T] + * - a theorem of the form [p ==> ~c] is turned into [p ==> c = F] + *) +let target_pat_cnv_of_thm th : (term * (term list->annot_conv)) = + let th = SPEC_ALL th in + match concl th with + |Comb(Comb(Const("=",_),l),_) -> l,C REWR_ANNOTCONV th + |Comb(Comb(Const("==>",_),_),c) -> + let pat,th' = + match c with + |Comb(Comb(Const("=",_),l),_) -> l, th + |Comb(Const("~",_),l) -> l, GEN_MAP_CONCLUSION EQF_INTRO th + |l -> c, GEN_MAP_CONCLUSION EQT_INTRO th + in + pat, C IMPREWR_CONV th' + |Comb(Const("~",_),l) -> l, C REWR_ANNOTCONV (EQF_INTRO th) + |Const("T",bool_ty) -> failwith "target_pat_cnv_of_thm" + |l -> l, C REWR_ANNOTCONV (EQT_INTRO th) + +let target_impconv_net_of_thm th = + try + let p,c = target_pat_cnv_of_thm th in + let vs = Tset.freesl (hyp th) in + Fo_nets.enter vs (p,(c,vs,th)) + with Failure _ -> I + +let target_patterns_of_thm = fst o target_pat_cnv_of_thm + +(* Multiple conversion which returns all the possible rewrites (on one subterm + * only) by one theorem. + *) + +let DEEP_IMP_REWR_MCONV:thm list->(atomic->annot_mconv) with_context = + let map_fst f (x,y,z) = f x,y,z in + let COMB_MCONV c l r = + map (map_fst (C AP_THM r)) (c l) @ map (map_fst (AP_TERM l)) (c r) + and ABS_MCONV c v b = + let ths = c b in + try map (map_fst (ABS v)) ths + with Failure _ -> + let gv = genvar(type_of v) in + let f (gth,ho,vs) = + let gtm = concl gth in + let l,r = dest_eq gtm in + let v' = variant (frees gtm) v in + let l' = alpha v' l and r' = alpha v' r in + EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth,ho,vs + in + let b' = vsubst[gv,v] b in + map f (map (map_fst (ABS gv)) (c b')) + in + let SUB_MCONV c = function + |Comb(l,r) -> COMB_MCONV c l r + |Abs(v,b) -> ABS_MCONV c v b + |Const _ | Var _ -> [] + in + let rec top_depth c t = SUB_MCONV (top_depth c) t @ c t in + let REWRITES_IMPCONV (net:((term list -> annot_conv) * Tset.t * thm) Fo_nets.t) avs t = + mapfilter (fun c,_,_ -> c avs t) (Fo_nets.lookup t net) + in + let rec self net ths = + let avs = Tset.flat_revmap (Tset.freesl o hyp) ths in + With_context( + (fun a t -> + let avs' = Tset.union (Tset.frees t) avs in + let cnv t = REWRITES_IMPCONV net avs' t in + let f = + match a with + |Atomic -> top_depth + |Non_atomic -> (fun cnv avs -> cnv avs) + in + f cnv t), + (fun _ -> self net ths), + (fun v -> + let ths = ref [] in + let f (_,vs,th) = + if not (Tset.mem v vs) then (ths := th :: !ths; true) else false + in + let net' = Fo_nets.filter f net in + self net' !ths)) + in + fun ths -> + self (itlist target_impconv_net_of_thm ths Fo_nets.empty_net) ths + +(* Takes a multiple conversion with hypotheses (which also takes a context as + * parameter) and makes a multiple implicational conversion out of it. + * + * Basically extends [GENERAL_REWRITE_IMPCONV] to the multiple conversion + * case. + *) +let rec REWR_IMPMCONV_OF_MCONV = + let IMP_SYM = REWR_RULE (TAUT `A==>B==>C <=> B==>A==>C`) in + let IMP_EXIST = GSYM LEFT_IMP_EXISTS_THM in + let TRY_GEN v th = try GEN v th with Failure _ -> th in + fun (c:(atomic -> annot_mconv) with_context) -> + With_context( + ((fun a v t -> + let f (th,ho,new_vars) = + let th1,th2 = EQ_IMP_RULE th in + match v with + |Co -> + let p,th2' = UNDISCH_TERM th2 in + let rec exists_intro = function + |[] -> DISCH_IMP_IMP (p::list_of_option ho) th2' + |v::vs -> + let th = exists_intro vs in + try REWR_RULE IMP_EXIST (GEN v th) with Failure _ -> th + in + exists_intro new_vars + |Contra -> + let th1' = + match ho with None -> th1 | Some h -> IMP_SYM (DISCH h th1) + in + match new_vars with + |[] -> th1' + |_::_ -> MAP_CONCLUSION (itlist TRY_GEN new_vars) th1' + in + map f (apply c a t)):atomic->imp_mconv), + REWR_IMPMCONV_OF_MCONV o augment c, + REWR_IMPMCONV_OF_MCONV o diminish c) + + +(*****************************************************************************) +(* TARGET REWRITING *) +(*****************************************************************************) + +let EXISTS_CTXIMPCONV:imp_conv with_context = + let EXISTSs i p = + let codom,dom = unzip i in + let f i ps = vsubst [i] (snd (dest_exists (hd ps))) :: ps in + let h::ps = rev_itlist f i [list_mk_exists(dom,p)] in + rev_itlist EXISTS (zip ps (rev codom)) (ASSUME h) + in + let LEFT_FORALL_IMP = REWR_RULE LEFT_FORALL_IMP_THM in + let rec self ts = + With_context + ((fun v t -> + match v,t with + |Co,Comb(Const("?",_),_) -> + let vs,b = strip_exists t in + let bs = strip_conj b in + let hmatch (n,b) = + match partition (C mem vs) (variables b) with + |[],_ -> failwith "EXISTS_CTXIMPCONV" + |_::_ as lvs,lcs -> + fun h -> + match term_match lcs b h with + |_,i,j when filter (uncurry (<>)) j = [] -> + (if i = [] then zip lvs lvs else i),n + |_ -> failwith "EXISTS_CTXIMPCONV" + in + let s,n = tryfind_fun (mapfilteri (curry (tryfind o hmatch)) bs) ts in + let th = EXISTSs (map (fun v -> rev_assocd v s v,v) vs) b in + let th' = DISCH_HD th in + let h = fst (dest_imp (concl th')) in + (match strip_conj h with + |[] -> assert false + |[h] -> DISCH T_ th + |_::_ as hs -> + let hs1,h'::hs2 = chop_list n hs in + let hs_th = CONJ_ACI_RULE (mk_eq(h,list_mk_conj (h'::(hs1@hs2)))) in + let th1 = CONV_RULE (LAND_CONV (REWR_CONV hs_th)) th' in + let th2 = UNDISCH (CONV_RULE (REWR_CONV IMP_CONJ) th1) in + let vs' = subtract vs (map snd s) in + let f v th = try LEFT_FORALL_IMP (GEN v th) with Failure _ -> th in + itlist f vs' th2) + |_ -> failwith "EXISTS_CTXIMPCONV"), + (fun ts' -> self (Tset.union ts' ts)), + (fun _ -> self ts)) + in + self [] + +(* Takes a theorem which results of an implicational conversion and applies a + * multiple implicational conversion on the outcome. + *) +let bind_impmconv (c:imp_mconv) v th = + let t1,t2 = dest_imp (concl th) in + match v with + |Co -> map (C IMP_TRANS th) (c v t1) + |Contra -> map (IMP_TRANS th) (c v t2) + + +(* Target rewrite implicational conversion: + * [TARGET_REWRITE_IMPCONV sths ts] is an implicational conversion which + * applies all the possible implicational rewrites on the input term until + * one of the resulting terms matches one of the terms in [ts]. + * + * Note that we allow several target terms and not just one. See + * TARGET_REWRITE_TAC for a justification. + *) +let TARGET_REWRITE_IMPCONV : thm list -> term list -> imp_conv = + let PRE = apply (TRY_CTXIMPCONV (REWRITE_CTXIMPCONV [])) in + let POST = TRY_CTXIMPCONV (TOP_DEPTH_CTXIMPCONV EXISTS_CTXIMPCONV) in + fun sths -> + let one_step_sths v uh = + let pre v th = try bind_impconv PRE v th with Unchanged -> th in + let post v = bind_ctximpconv POST v in + let f = + DEPTH_CTXIMPMCONV o REWR_IMPMCONV_OF_MCONV o DEEP_IMP_REWR_MCONV + in + map (post v) (bind_impmconv (apply (f sths)) v (pre v uh)) + in + let flat l = uniq (itlist (merge thm_lt) l []) in + fun ts v t -> + let rec self ths = + let pool = flat (map (mergesort thm_lt o one_step_sths v) ths) in + let sel th = imp_conv_outcome th v in + let is_one_sol g = (can o find_term o can o fo_term_match []) g o sel in + let is_sol th = tryfind is_one_sol ts th in + try bind_ctximpconv POST v (find is_sol pool) + with _ -> + match pool with + |[] -> failwith "TARGET_REWRITE_IMPCONV: no path found" + |_::_ -> self (map (bind_ctximpconv POST v) pool) + in + self [IMP_REFL t] + +(* Tactic version of it. + * + * Since the target theorem is preprocessed, it can yield several theorems. + * Therefore, there is not just one possible target pattern but several. + *) +let TARGET_REWRITE_TAC sths th = + let sths' = flat (map preprocess sths) in + let ths = preprocess th and (+) = THEN_IMPCONV in + IMPCONV_TAC + (TARGET_REWRITE_IMPCONV sths' (map patterns_of_thm ths) + + imp_conv_of_ctx_imp_conv (REWRITE_CTXIMPCONV ths)) + +let HINT_EXISTS_TAC = CTXIMPCONV_TAC (TOP_DEPTH_CTXIMPCONV EXISTS_CTXIMPCONV) + +end in + +Impconv.IMP_REWRITE_TAC, +Impconv.TARGET_REWRITE_TAC, +Impconv.HINT_EXISTS_TAC, +Impconv.SEQ_IMP_REWRITE_TAC, +Impconv.CASE_REWRITE_TAC;; diff --git a/ind_defs.ml b/ind_defs.ml new file mode 100644 index 0000000..b1d1f45 --- /dev/null +++ b/ind_defs.ml @@ -0,0 +1,463 @@ +(* ========================================================================= *) +(* Mutually inductively defined relations. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "theorems.ml";; + +(* ------------------------------------------------------------------------- *) +(* Strip off exactly n arguments from combination. *) +(* ------------------------------------------------------------------------- *) + +let strip_ncomb = + let rec strip(n,tm,acc) = + if n < 1 then tm,acc else + let l,r = dest_comb tm in + strip(n - 1,l,r::acc) in + fun n tm -> strip(n,tm,[]);; + +(* ------------------------------------------------------------------------- *) +(* Expand lambda-term function definition with its arguments. *) +(* ------------------------------------------------------------------------- *) + +let RIGHT_BETAS = + rev_itlist (fun a -> CONV_RULE (RAND_CONV BETA_CONV) o C AP_THM a);; + +(* ------------------------------------------------------------------------- *) +(* A, x = t |- P[x] *) +(* ------------------ EXISTS_EQUATION *) +(* A |- ?x. P[x] *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_EQUATION = + let pth = prove + (`!P t. (!x:A. (x = t) ==> P x) ==> (?) P`, + REWRITE_TAC[EXISTS_DEF] THEN BETA_TAC THEN + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `t:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN + REFL_TAC) in + fun tm th -> + let l,r = dest_eq tm in + let P = mk_abs(l,concl th) in + let th1 = BETA_CONV(mk_comb(P,l)) in + let th2 = ISPECL [P; r] pth in + let th3 = EQ_MP (SYM th1) th in + let th4 = GEN l (DISCH tm th3) in + MP th2 th4;; + +(* ========================================================================= *) +(* Part 1: The main part of the inductive definitions package. *) +(* This proves that a certain definition yields the requires theorems. *) +(* ========================================================================= *) + +let derive_nonschematic_inductive_relations = + let getconcl tm = + let bod = repeat (snd o dest_forall) tm in + try snd(dest_imp bod) with Failure _ -> bod + and CONJ_ACI_RULE = AC CONJ_ACI + and SIMPLE_DISJ_PAIR th = + let l,r = dest_disj(hd(hyp th)) in + PROVE_HYP (DISJ1 (ASSUME l) r) th,PROVE_HYP (DISJ2 l (ASSUME r)) th + and HALF_BETA_EXPAND args th = GENL args (RIGHT_BETAS args th) in + let AND_IMPS_CONV tm = + let ths = CONJUNCTS(ASSUME tm) in + let avs = fst(strip_forall(concl(hd ths))) in + let thl = map (DISCH tm o UNDISCH o SPEC_ALL) ths in + let th1 = end_itlist SIMPLE_DISJ_CASES thl in + let tm1 = hd(hyp th1) in + let th2 = GENL avs (DISCH tm1 (UNDISCH th1)) in + let tm2 = concl th2 in + let th3 = DISCH tm2 (UNDISCH (SPEC_ALL (ASSUME tm2))) in + let thts,tht = nsplit SIMPLE_DISJ_PAIR (tl ths) th3 in + let proc_fn th = + let t = hd(hyp th) in GENL avs (DISCH t (UNDISCH th)) in + let th4 = itlist (CONJ o proc_fn) thts (proc_fn tht) in + IMP_ANTISYM_RULE (DISCH_ALL th2) (DISCH_ALL th4) in + let t_tm = `T` in + let calculate_simp_sequence = + let rec getequs(avs,plis) = + if plis = [] then [] else + let h::t = plis in + let r = snd h in + if mem r avs then + h::(getequs(avs,filter ((<>) r o snd) t)) + else + getequs(avs,t) in + fun avs plis -> + let oks = getequs(avs,plis) in + oks,subtract plis oks + and FORALL_IMPS_CONV tm = + let avs,bod = strip_forall tm in + let th1 = DISCH tm (UNDISCH(SPEC_ALL(ASSUME tm))) in + let th2 = itlist SIMPLE_CHOOSE avs th1 in + let tm2 = hd(hyp th2) in + let th3 = DISCH tm2 (UNDISCH th2) in + let th4 = ASSUME (concl th3) in + let ant = lhand bod in + let th5 = itlist SIMPLE_EXISTS avs (ASSUME ant) in + let th6 = GENL avs (DISCH ant (MP th4 th5)) in + IMP_ANTISYM_RULE (DISCH_ALL th3) (DISCH_ALL th6) in + let canonicalize_clause cls args = + let avs,bimp = strip_forall cls in + let ant,con = try dest_imp bimp with Failure _ -> t_tm,bimp in + let rel,xargs = strip_comb con in + let plis = zip args xargs in + let yes,no = calculate_simp_sequence avs plis in + let nvs = filter (not o C mem (map snd yes)) avs in + let eth = + if is_imp bimp then + let atm = itlist (curry mk_conj o mk_eq) (yes@no) ant in + let ths,tth = nsplit CONJ_PAIR plis (ASSUME atm) in + let thl = map (fun t -> find (fun th -> lhs(concl th) = t) ths) args in + let th0 = MP (SPECL avs (ASSUME cls)) tth in + let th1 = rev_itlist (C (curry MK_COMB)) thl (REFL rel) in + let th2 = EQ_MP (SYM th1) th0 in + let th3 = INST yes (DISCH atm th2) in + let tm4 = funpow (length yes) rand (lhand(concl th3)) in + let th4 = itlist (CONJ o REFL o fst) yes (ASSUME tm4) in + let th5 = GENL args (GENL nvs (DISCH tm4 (MP th3 th4))) in + let th6 = SPECL nvs (SPECL (map snd plis) (ASSUME (concl th5))) in + let th7 = itlist (CONJ o REFL o snd) no (ASSUME ant) in + let th8 = GENL avs (DISCH ant (MP th6 th7)) in + IMP_ANTISYM_RULE (DISCH_ALL th5) (DISCH_ALL th8) + else + let atm = list_mk_conj(map mk_eq (yes@no)) in + let ths = CONJUNCTS (ASSUME atm) in + let thl = map (fun t -> find (fun th -> lhs(concl th) = t) ths) args in + let th0 = SPECL avs (ASSUME cls) in + let th1 = rev_itlist (C (curry MK_COMB)) thl (REFL rel) in + let th2 = EQ_MP (SYM th1) th0 in + let th3 = INST yes (DISCH atm th2) in + let tm4 = funpow (length yes) rand (lhand(concl th3)) in + let th4 = itlist (CONJ o REFL o fst) yes (ASSUME tm4) in + let th5 = GENL args (GENL nvs (DISCH tm4 (MP th3 th4))) in + let th6 = SPECL nvs (SPECL (map snd plis) (ASSUME (concl th5))) in + let th7 = end_itlist CONJ (map (REFL o snd) no) in + let th8 = GENL avs (MP th6 th7) in + IMP_ANTISYM_RULE (DISCH_ALL th5) (DISCH_ALL th8) in + let ftm = funpow (length args) (body o rand) (rand(concl eth)) in + TRANS eth (itlist MK_FORALL args (FORALL_IMPS_CONV ftm)) in + let canonicalize_clauses clauses = + let concls = map getconcl clauses in + let uncs = map strip_comb concls in + let rels = itlist (insert o fst) uncs [] in + let xargs = map (C assoc uncs) rels in + let closed = list_mk_conj clauses in + let avoids = variables closed in + let flargs = + make_args "a" avoids (map type_of (end_itlist (@) xargs)) in + let zargs = zip rels (shareout xargs flargs) in + let cargs = map (fun (r,a) -> assoc r zargs) uncs in + let cthms = map2 canonicalize_clause clauses cargs in + let pclauses = map (rand o concl) cthms in + let collectclauses tm = + mapfilter (fun t -> if fst t = tm then snd t else fail()) + (zip (map fst uncs) pclauses) in + let clausell = map collectclauses rels in + let cclausel = map list_mk_conj clausell in + let cclauses = list_mk_conj cclausel + and oclauses = list_mk_conj pclauses in + let eth = CONJ_ACI_RULE(mk_eq(oclauses,cclauses)) in + let pth = TRANS (end_itlist MK_CONJ cthms) eth in + TRANS pth (end_itlist MK_CONJ (map AND_IMPS_CONV cclausel)) + and derive_canon_inductive_relations clauses = + let closed = list_mk_conj clauses in + let clauses = conjuncts closed in + let vargs,bodies = unzip(map strip_forall clauses) in + let ants,concs = unzip(map dest_imp bodies) in + let rels = map (repeat rator) concs in + let avoids = variables closed in + let rels' = variants avoids rels in + let crels = zip rels' rels in + let prime_fn = subst crels in + let closed' = prime_fn closed in + let mk_def arg con = + mk_eq(repeat rator con, + list_mk_abs(arg,list_mk_forall(rels',mk_imp(closed',prime_fn con)))) in + let deftms = map2 mk_def vargs concs in + let defthms = map2 HALF_BETA_EXPAND vargs (map ASSUME deftms) in + let mk_ind args th = + let th1 = fst(EQ_IMP_RULE(SPEC_ALL th)) in + let ant = lhand(concl th1) in + let th2 = SPECL rels' (UNDISCH th1) in + GENL args (DISCH ant (UNDISCH th2)) in + let indthms = map2 mk_ind vargs defthms in + let indthmr = end_itlist CONJ indthms in + let indthm = GENL rels' (DISCH closed' indthmr) in + let mconcs = map2 (fun a t -> list_mk_forall(a,mk_imp(t,prime_fn t))) + vargs ants in + let monotm = mk_imp(concl indthmr,list_mk_conj mconcs) in + let monothm = ASSUME(list_mk_forall(rels,list_mk_forall(rels',monotm))) in + let closthm = ASSUME closed' in + let monothms = CONJUNCTS + (MP (SPEC_ALL monothm) (MP (SPECL rels' indthm) closthm)) in + let closthms = CONJUNCTS closthm in + let prove_rule mth (cth,dth) = + let avs,bod = strip_forall(concl mth) in + let th1 = IMP_TRANS (SPECL avs mth) (SPECL avs cth) in + let th2 = GENL rels' (DISCH closed' (UNDISCH th1)) in + let th3 = EQ_MP (SYM (SPECL avs dth)) th2 in + GENL avs (DISCH (lhand bod) th3) in + let rulethms = map2 prove_rule monothms (zip closthms defthms) in + let rulethm = end_itlist CONJ rulethms in + let dtms = map2 (curry list_mk_abs) vargs ants in + let double_fn = subst (zip dtms rels) in + let mk_unbetas tm dtm = + let avs,bod = strip_forall tm in + let il,r = dest_comb bod in + let i,l = dest_comb il in + let bth = RIGHT_BETAS avs (REFL dtm) in + let munb = AP_THM (AP_TERM i bth) r in + let iunb = AP_TERM (mk_comb(i,double_fn l)) bth in + let junb = AP_TERM (mk_comb(i,r)) bth in + let quantify = itlist MK_FORALL avs in + (quantify munb,(quantify iunb,quantify junb)) in + let unths = map2 mk_unbetas clauses dtms in + let irthm = EQ_MP (SYM(end_itlist MK_CONJ (map fst unths))) rulethm in + let mrthm = MP (SPECL rels (SPECL dtms monothm)) irthm in + let imrth = EQ_MP (SYM(end_itlist MK_CONJ (map (fst o snd) unths))) mrthm in + let ifthm = MP (SPECL dtms indthm) imrth in + let fthm = EQ_MP (end_itlist MK_CONJ (map (snd o snd) unths)) ifthm in + let mk_case th1 th2 = + let avs = fst(strip_forall(concl th1)) in + GENL avs (IMP_ANTISYM_RULE (SPEC_ALL th1) (SPEC_ALL th2)) in + let casethm = end_itlist CONJ + (map2 mk_case (CONJUNCTS fthm) (CONJUNCTS rulethm)) in + CONJ rulethm (CONJ indthm casethm) in + fun tm -> + let clauses = conjuncts tm in + let canonthm = canonicalize_clauses clauses in + let canonthm' = SYM canonthm in + let pclosed = rand(concl canonthm) in + let pclauses = conjuncts pclosed in + let rawthm = derive_canon_inductive_relations pclauses in + let rulethm,otherthms = CONJ_PAIR rawthm in + let indthm,casethm = CONJ_PAIR otherthms in + let rulethm' = EQ_MP canonthm' rulethm + and indthm' = CONV_RULE (ONCE_DEPTH_CONV (REWR_CONV canonthm')) indthm in + CONJ rulethm' (CONJ indthm' casethm);; + +(* ========================================================================= *) +(* Part 2: Tactic-integrated tools for proving monotonicity automatically. *) +(* ========================================================================= *) + +let MONO_AND = ITAUT `(A ==> B) /\ (C ==> D) ==> (A /\ C ==> B /\ D)`;; + +let MONO_OR = ITAUT `(A ==> B) /\ (C ==> D) ==> (A \/ C ==> B \/ D)`;; + +let MONO_IMP = ITAUT `(B ==> A) /\ (C ==> D) ==> ((A ==> C) ==> (B ==> D))`;; + +let MONO_NOT = ITAUT `(B ==> A) ==> (~A ==> ~B)`;; + +let MONO_FORALL = prove + (`(!x:A. P x ==> Q x) ==> ((!x. P x) ==> (!x. Q x))`, + REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +let MONO_EXISTS = prove + (`(!x:A. P x ==> Q x) ==> ((?x. P x) ==> (?x. Q x))`, + DISCH_TAC THEN DISCH_THEN(X_CHOOSE_TAC `x:A`) THEN + EXISTS_TAC `x:A` THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Assignable list of monotonicity theorems, so users can add their own. *) +(* ------------------------------------------------------------------------- *) + +let monotonicity_theorems = ref + [MONO_AND; MONO_OR; MONO_IMP; MONO_NOT; MONO_EXISTS; MONO_FORALL];; + +(* ------------------------------------------------------------------------- *) +(* Attempt to backchain through the monotonicity theorems. *) +(* ------------------------------------------------------------------------- *) + +let MONO_TAC = + let imp = `(==>)` and IMP_REFL = ITAUT `!p. p ==> p` in + let BACKCHAIN_TAC th = + let match_fn = PART_MATCH (snd o dest_imp) th in + fun (asl,w) -> + let th1 = match_fn w in + let ant,con = dest_imp(concl th1) in + null_meta,[asl,ant],fun i [t] -> MATCH_MP (INSTANTIATE i th1) t + and MONO_ABS_TAC (asl,w) = + let ant,con = dest_imp w in + let vars = snd(strip_comb con) in + let rnum = length vars - 1 in + let hd1,args1 = strip_ncomb rnum ant + and hd2,args2 = strip_ncomb rnum con in + let th1 = rev_itlist (C AP_THM) args1 (BETA_CONV hd1) + and th2 = rev_itlist (C AP_THM) args1 (BETA_CONV hd2) in + let th3 = MK_COMB(AP_TERM imp th1,th2) in + CONV_TAC(REWR_CONV th3) (asl,w) + and APPLY_MONOTAC tacs (asl,w) = + let a,c = dest_imp w in + if aconv a c then ACCEPT_TAC (SPEC a IMP_REFL) (asl,w) else + let cn = try fst(dest_const(repeat rator c)) with Failure _ -> "" in + tryfind (fun (k,t) -> if k = cn then t (asl,w) else fail()) tacs in + fun gl -> + let tacs = itlist + (fun th l -> let ft = repeat rator (funpow 2 rand (concl th)) in + let c = try fst(dest_const ft) with Failure _ -> "" in + (c,BACKCHAIN_TAC th THEN REPEAT CONJ_TAC)::l) + (!monotonicity_theorems) ["",MONO_ABS_TAC] in + let MONO_STEP_TAC = REPEAT GEN_TAC THEN APPLY_MONOTAC tacs in + (REPEAT MONO_STEP_TAC THEN ASM_REWRITE_TAC[]) gl;; + +(* ------------------------------------------------------------------------- *) +(* Attempt to dispose of the non-equational assumption(s) of a theorem. *) +(* ------------------------------------------------------------------------- *) + +let prove_monotonicity_hyps = + let tac = REPEAT GEN_TAC THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + REPEAT CONJ_TAC THEN MONO_TAC in + let prove_mth t = prove(t,tac) in + fun th -> + let mths = mapfilter prove_mth (filter (not o is_eq) (hyp th)) in + itlist PROVE_HYP mths th;; + +(* ========================================================================= *) +(* Part 3: The final user wrapper, with schematic variables added. *) +(* ========================================================================= *) + +let the_inductive_definitions = ref [];; + +let prove_inductive_relations_exist,new_inductive_definition = + let rec pare_comb qvs tm = + if intersect (frees tm) qvs = [] & forall is_var (snd(strip_comb tm)) + then tm + else pare_comb qvs (rator tm) in + let generalize_schematic_variables gflag vs = + let generalize_def tm th = + let l,r = dest_eq tm in + let lname,lty = dest_var l in + let l' = mk_var(lname,itlist (mk_fun_ty o type_of) vs lty) in + let r' = list_mk_abs(vs,r) in + let tm' = mk_eq(l',r') in + let th0 = RIGHT_BETAS vs (ASSUME tm') in + let th1 = INST [lhs(concl th0),l] (DISCH tm th) in + MP th1 th0 in + fun th -> + let defs,others = partition is_eq (hyp th) in + let th1 = itlist generalize_def defs th in + if gflag then + let others' = map (fun t -> let fvs = frees t in + SPECL fvs (ASSUME (list_mk_forall(fvs,t)))) + others in + GENL vs (itlist PROVE_HYP others' th1) + else th1 + and derive_existence th = + let defs = filter is_eq (hyp th) in + itlist EXISTS_EQUATION defs th + and make_definitions th = + let defs = filter is_eq (hyp th) in + let dths = map new_definition defs in + let insts = zip (map (lhs o concl) dths) (map lhs defs) in + rev_itlist (C MP) dths (INST insts (itlist DISCH defs th)) + and unschematize_clauses clauses = + let schem = map (fun cls -> let avs,bod = strip_forall cls in + pare_comb avs (try snd(dest_imp bod) with Failure _ -> bod)) + clauses in + let schems = setify schem in + if is_var(hd schem) then (clauses,[]) else + if not (length(setify (map (snd o strip_comb) schems)) = 1) + then failwith "Schematic variables not used consistently" else + let avoids = variables (list_mk_conj clauses) in + let hack_fn tm = mk_var(fst(dest_var(repeat rator tm)),type_of tm) in + let grels = variants avoids (map hack_fn schems) in + let crels = zip grels schems in + let clauses' = map (subst crels) clauses in + clauses',snd(strip_comb(hd schems)) in + let find_redefinition tm (rth,ith,cth as trip) = + if aconv tm (concl rth) then trip else failwith "find_redefinition" in + let prove_inductive_properties tm = + let clauses = conjuncts tm in + let clauses',fvs = unschematize_clauses clauses in + let th = derive_nonschematic_inductive_relations (list_mk_conj clauses') in + fvs,prove_monotonicity_hyps th in + let prove_inductive_relations_exist tm = + let fvs,th1 = prove_inductive_properties tm in + let th2 = generalize_schematic_variables true fvs th1 in + derive_existence th2 + and new_inductive_definition tm = + try let th = tryfind (find_redefinition tm) (!the_inductive_definitions) in + warn true "Benign redefinition of inductive predicate"; th + with Failure _ -> + let fvs,th1 = prove_inductive_properties tm in + let th2 = generalize_schematic_variables true fvs th1 in + let th3 = make_definitions th2 in + let avs = fst(strip_forall(concl th3)) in + let r,ic = CONJ_PAIR(SPECL avs th3) in + let i,c = CONJ_PAIR ic in + let thtr = GENL avs r,GENL avs i,GENL avs c in + the_inductive_definitions := thtr::(!the_inductive_definitions); + thtr in + prove_inductive_relations_exist,new_inductive_definition;; + +(* ------------------------------------------------------------------------- *) +(* Derivation of "strong induction". *) +(* ------------------------------------------------------------------------- *) + +let derive_strong_induction = + let dest_ibod tm = + let avs,ibod = strip_forall tm in + let n = length avs in + let prator = funpow n rator in + let ant,con = dest_imp ibod in + n,(prator ant,prator con) in + let rec prove_triv tm = + if is_conj tm then CONJ (prove_triv(lhand tm)) (prove_triv(rand tm)) else + let avs,bod = strip_forall tm in + let a,c = dest_imp bod in + let ths = CONJUNCTS(ASSUME a) in + let th = find (aconv c o concl) ths in + GENL avs (DISCH a th) in + let rec weaken_triv th = + if is_conj(concl th) + then CONJ (weaken_triv(CONJUNCT1 th)) (weaken_triv(CONJUNCT2 th)) else + let avs,bod = strip_forall(concl th) in + let th1 = SPECL avs th in + let a = fst(dest_imp(concl th1)) in + GENL avs (DISCH a (CONJUNCT2 (UNDISCH th1))) in + let MATCH_IMPS = MATCH_MP MONO_AND in + fun (rth,ith) -> + let ovs,ibod = strip_forall(concl ith) in + let iant,icon = dest_imp ibod in + let ns,prrs = unzip (map dest_ibod (conjuncts icon)) in + let rs,ps = unzip prrs in + let gs = variants (variables ibod) ps in + let svs,tvs = chop_list (length ovs - length ns) ovs in + let sth = SPECL svs rth and jth = SPECL svs ith in + let gimps = subst (zip gs rs) icon in + let prs = map2 (fun n (r,p) -> + let tys,ty = nsplit dest_fun_ty (1--n) (type_of r) in + let gvs = map genvar tys in + list_mk_abs(gvs,mk_conj(list_mk_comb(r,gvs),list_mk_comb(p,gvs)))) + ns prrs in + let modify_rule rcl itm = + let avs,bod = strip_forall itm in + if is_imp bod then + let a,c = dest_imp bod in + let mgoal = mk_imp(gimps,mk_imp(vsubst(zip gs ps) a,a)) in + let mth = ASSUME(list_mk_forall(gs@ps@avs,mgoal)) in + let ith_r = BETA_RULE(SPECL (prs @ rs @ avs) mth) in + let jth_r = MP ith_r (prove_triv(lhand(concl ith_r))) in + let t = lhand(concl jth_r) in + let kth_r = UNDISCH jth_r in + let ntm = list_mk_forall(avs,mk_imp(t,c)) in + let lth_r = MP(SPECL avs rcl) kth_r + and lth_p = UNDISCH(SPECL avs (ASSUME ntm)) in + DISCH ntm (GENL avs (DISCH t (CONJ lth_r lth_p))) + else + DISCH itm (GENL avs (CONJ (SPECL avs rcl) (SPECL avs (ASSUME itm)))) in + let mimps = map2 modify_rule (CONJUNCTS sth) (conjuncts iant) in + let th1 = end_itlist (fun th th' -> MATCH_IMPS(CONJ th th')) mimps in + let th2 = BETA_RULE(SPECL prs jth) in + let th3 = IMP_TRANS th1 th2 in + let nasm = lhand(concl th3) in + let th4 = GENL ps (DISCH nasm (weaken_triv(UNDISCH th3))) in + GENL svs (prove_monotonicity_hyps th4);; diff --git a/ind_types.ml b/ind_types.ml new file mode 100644 index 0000000..56d22f8 --- /dev/null +++ b/ind_types.ml @@ -0,0 +1,1555 @@ +(* ========================================================================= *) +(* Inductive (or free recursive) types. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "grobner.ml";; + +(* ------------------------------------------------------------------------- *) +(* Abstract left inverses for binary injections (we could construct them...) *) +(* ------------------------------------------------------------------------- *) + +let INJ_INVERSE2 = prove + (`!P:A->B->C. + (!x1 y1 x2 y2. (P x1 y1 = P x2 y2) <=> (x1 = x2) /\ (y1 = y2)) + ==> ?X Y. !x y. (X(P x y) = x) /\ (Y(P x y) = y)`, + GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `\z:C. @x:A. ?y:B. P x y = z` THEN + EXISTS_TAC `\z:C. @y:B. ?x:A. P x y = z` THEN + REPEAT GEN_TAC THEN ASM_REWRITE_TAC[BETA_THM] THEN + CONJ_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN BETA_TAC THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + W(EXISTS_TAC o rand o snd o dest_exists o snd) THEN REFL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Define an injective pairing function on ":num". *) +(* ------------------------------------------------------------------------- *) + +let NUMPAIR = new_definition + `NUMPAIR x y = (2 EXP x) * (2 * y + 1)`;; + +let NUMPAIR_INJ_LEMMA = prove + (`!x1 y1 x2 y2. (NUMPAIR x1 y1 = NUMPAIR x2 y2) ==> (x1 = x2)`, + REWRITE_TAC[NUMPAIR] THEN REPEAT(INDUCT_TAC THEN GEN_TAC) THEN + ASM_REWRITE_TAC[EXP; GSYM MULT_ASSOC; ARITH; EQ_MULT_LCANCEL; + NOT_SUC; GSYM NOT_SUC; SUC_INJ] THEN + DISCH_THEN(MP_TAC o AP_TERM `EVEN`) THEN + REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH]);; + +let NUMPAIR_INJ = prove + (`!x1 y1 x2 y2. (NUMPAIR x1 y1 = NUMPAIR x2 y2) <=> (x1 = x2) /\ (y1 = y2)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(SUBST_ALL_TAC o MATCH_MP NUMPAIR_INJ_LEMMA) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NUMPAIR] THEN + REWRITE_TAC[EQ_MULT_LCANCEL; EQ_ADD_RCANCEL; EXP_EQ_0; ARITH]);; + +let NUMPAIR_DEST = new_specification + ["NUMFST"; "NUMSND"] + (MATCH_MP INJ_INVERSE2 NUMPAIR_INJ);; + +(* ------------------------------------------------------------------------- *) +(* Also, an injective map bool->num->num (even easier!) *) +(* ------------------------------------------------------------------------- *) + +let NUMSUM = new_definition + `NUMSUM b x = if b then SUC(2 * x) else 2 * x`;; + +let NUMSUM_INJ = prove + (`!b1 x1 b2 x2. (NUMSUM b1 x1 = NUMSUM b2 x2) <=> (b1 = b2) /\ (x1 = x2)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o REWRITE_RULE[NUMSUM]) THEN + DISCH_THEN(fun th -> MP_TAC th THEN MP_TAC(AP_TERM `EVEN` th)) THEN + REPEAT COND_CASES_TAC THEN REWRITE_TAC[EVEN; EVEN_DOUBLE] THEN + REWRITE_TAC[SUC_INJ; EQ_MULT_LCANCEL; ARITH]);; + +let NUMSUM_DEST = new_specification + ["NUMLEFT"; "NUMRIGHT"] + (MATCH_MP INJ_INVERSE2 NUMSUM_INJ);; + +(* ------------------------------------------------------------------------- *) +(* Injection num->Z, where Z == num->A->bool. *) +(* ------------------------------------------------------------------------- *) + +let INJN = new_definition + `INJN (m:num) = \(n:num) (a:A). n = m`;; + +let INJN_INJ = prove + (`!n1 n2. (INJN n1 :num->A->bool = INJN n2) <=> (n1 = n2)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o C AP_THM `n1:num` o REWRITE_RULE[INJN]) THEN + DISCH_THEN(MP_TAC o C AP_THM `a:A`) THEN REWRITE_TAC[BETA_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Injection A->Z, where Z == num->A->bool. *) +(* ------------------------------------------------------------------------- *) + +let INJA = new_definition + `INJA (a:A) = \(n:num) b. b = a`;; + +let INJA_INJ = prove + (`!a1 a2. (INJA a1 = INJA a2) <=> (a1:A = a2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[INJA; FUN_EQ_THM] THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `a1:A`) THEN REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Injection (num->Z)->Z, where Z == num->A->bool. *) +(* ------------------------------------------------------------------------- *) + +let INJF = new_definition + `INJF (f:num->(num->A->bool)) = \n. f (NUMFST n) (NUMSND n)`;; + +let INJF_INJ = prove + (`!f1 f2. (INJF f1 :num->A->bool = INJF f2) <=> (f1 = f2)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `m:num`; `a:A`] THEN + POP_ASSUM(MP_TAC o REWRITE_RULE[INJF]) THEN + DISCH_THEN(MP_TAC o C AP_THM `a:A` o C AP_THM `NUMPAIR n m`) THEN + REWRITE_TAC[NUMPAIR_DEST]);; + +(* ------------------------------------------------------------------------- *) +(* Injection Z->Z->Z, where Z == num->A->bool. *) +(* ------------------------------------------------------------------------- *) + +let INJP = new_definition + `INJP f1 f2:num->A->bool = + \n a. if NUMLEFT n then f1 (NUMRIGHT n) a else f2 (NUMRIGHT n) a`;; + +let INJP_INJ = prove + (`!(f1:num->A->bool) f1' f2 f2'. + (INJP f1 f2 = INJP f1' f2') <=> (f1 = f1') /\ (f2 = f2')`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[FUN_EQ_THM] THEN REWRITE_TAC[AND_FORALL_THM] THEN + X_GEN_TAC `n:num` THEN POP_ASSUM(MP_TAC o REWRITE_RULE[INJP]) THEN + DISCH_THEN(MP_TAC o GEN `b:bool` o C AP_THM `NUMSUM b n`) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `T` th) THEN MP_TAC(SPEC `F` th)) THEN + ASM_SIMP_TAC[NUMSUM_DEST; ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Now, set up "constructor" and "bottom" element. *) +(* ------------------------------------------------------------------------- *) + +let ZCONSTR = new_definition + `ZCONSTR c i r :num->A->bool + = INJP (INJN (SUC c)) (INJP (INJA i) (INJF r))`;; + +let ZBOT = new_definition + `ZBOT = INJP (INJN 0) (@z:num->A->bool. T)`;; + +let ZCONSTR_ZBOT = prove + (`!c i r. ~(ZCONSTR c i r :num->A->bool = ZBOT)`, + REWRITE_TAC[ZCONSTR; ZBOT; INJP_INJ; INJN_INJ; NOT_SUC]);; + +(* ------------------------------------------------------------------------- *) +(* Carve out an inductively defined set. *) +(* ------------------------------------------------------------------------- *) + +let ZRECSPACE_RULES,ZRECSPACE_INDUCT,ZRECSPACE_CASES = + new_inductive_definition + `ZRECSPACE (ZBOT:num->A->bool) /\ + (!c i r. (!n. ZRECSPACE (r n)) ==> ZRECSPACE (ZCONSTR c i r))`;; + +let recspace_tydef = + new_basic_type_definition "recspace" ("_mk_rec","_dest_rec") + (CONJUNCT1 ZRECSPACE_RULES);; + +(* ------------------------------------------------------------------------- *) +(* Define lifted constructors. *) +(* ------------------------------------------------------------------------- *) + +let BOTTOM = new_definition + `BOTTOM = _mk_rec (ZBOT:num->A->bool)`;; + +let CONSTR = new_definition + `CONSTR c i r :(A)recspace + = _mk_rec (ZCONSTR c i (\n. _dest_rec(r n)))`;; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas. *) +(* ------------------------------------------------------------------------- *) + +let MK_REC_INJ = prove + (`!x y. (_mk_rec x :(A)recspace = _mk_rec y) + ==> (ZRECSPACE x /\ ZRECSPACE y ==> (x = y))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[snd recspace_tydef] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + ASM_REWRITE_TAC[]);; + +let DEST_REC_INJ = prove + (`!x y. (_dest_rec x = _dest_rec y) <=> (x:(A)recspace = y)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o AP_TERM + `_mk_rec:(num->A->bool)->(A)recspace`) THEN + REWRITE_TAC[fst recspace_tydef]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the set is freely inductively generated. *) +(* ------------------------------------------------------------------------- *) + +let CONSTR_BOT = prove + (`!c i r. ~(CONSTR c i r :(A)recspace = BOTTOM)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONSTR; BOTTOM] THEN + DISCH_THEN(MP_TAC o MATCH_MP MK_REC_INJ) THEN + REWRITE_TAC[ZCONSTR_ZBOT; ZRECSPACE_RULES] THEN + MATCH_MP_TAC(CONJUNCT2 ZRECSPACE_RULES) THEN + REWRITE_TAC[fst recspace_tydef; snd recspace_tydef]);; + +let CONSTR_INJ = prove + (`!c1 i1 r1 c2 i2 r2. (CONSTR c1 i1 r1 :(A)recspace = CONSTR c2 i2 r2) <=> + (c1 = c2) /\ (i1 = i2) /\ (r1 = r2)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o REWRITE_RULE[CONSTR]) THEN + DISCH_THEN(MP_TAC o MATCH_MP MK_REC_INJ) THEN + W(C SUBGOAL_THEN ASSUME_TAC o funpow 2 lhand o snd) THENL + [CONJ_TAC THEN MATCH_MP_TAC(CONJUNCT2 ZRECSPACE_RULES) THEN + REWRITE_TAC[fst recspace_tydef; snd recspace_tydef]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ZCONSTR] THEN + REWRITE_TAC[INJP_INJ; INJN_INJ; INJF_INJ; INJA_INJ] THEN + ONCE_REWRITE_TAC[FUN_EQ_THM] THEN BETA_TAC THEN + REWRITE_TAC[SUC_INJ; DEST_REC_INJ]]);; + +let CONSTR_IND = prove + (`!P. P(BOTTOM) /\ + (!c i r. (!n. P(r n)) ==> P(CONSTR c i r)) + ==> !x:(A)recspace. P(x)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\z:num->A->bool. ZRECSPACE(z) /\ P(_mk_rec z)` + ZRECSPACE_INDUCT) THEN + BETA_TAC THEN ASM_REWRITE_TAC[ZRECSPACE_RULES; GSYM BOTTOM] THEN + W(C SUBGOAL_THEN ASSUME_TAC o funpow 2 lhand o snd) THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[FORALL_AND_THM] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(CONJUNCT2 ZRECSPACE_RULES) THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM(ANTE_RES_THEN MP_TAC) THEN + REWRITE_TAC[CONSTR] THEN + RULE_ASSUM_TAC(REWRITE_RULE[snd recspace_tydef]) THEN + ASM_SIMP_TAC[ETA_AX]]; + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `_dest_rec (x:(A)recspace)`) THEN + REWRITE_TAC[fst recspace_tydef] THEN + REWRITE_TAC[ITAUT `(a ==> a /\ b) <=> (a ==> b)`] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[fst recspace_tydef; snd recspace_tydef]]);; + +(* ------------------------------------------------------------------------- *) +(* Now prove the recursion theorem (this subcase is all we need). *) +(* ------------------------------------------------------------------------- *) + +let CONSTR_REC = prove + (`!Fn:num->A->(num->(A)recspace)->(num->B)->B. + ?f. (!c i r. f (CONSTR c i r) = Fn c i r (\n. f (r n)))`, + REPEAT STRIP_TAC THEN (MP_TAC o prove_inductive_relations_exist) + `(Z:(A)recspace->B->bool) BOTTOM b /\ + (!c i r y. (!n. Z (r n) (y n)) ==> Z (CONSTR c i r) (Fn c i r y))` THEN + DISCH_THEN(CHOOSE_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN `!x. ?!y. (Z:(A)recspace->B->bool) x y` MP_TAC THENL + [W(MP_TAC o PART_MATCH rand CONSTR_IND o snd) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN REPEAT GEN_TAC THENL + [FIRST_ASSUM(fun t -> GEN_REWRITE_TAC BINDER_CONV [GSYM t]) THEN + REWRITE_TAC[GSYM CONSTR_BOT; EXISTS_UNIQUE_REFL]; + DISCH_THEN(MP_TAC o REWRITE_RULE[EXISTS_UNIQUE_THM; FORALL_AND_THM]) THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(MP_TAC o REWRITE_RULE[SKOLEM_THM]) THEN + DISCH_THEN(X_CHOOSE_THEN `y:num->B` ASSUME_TAC) THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + FIRST_ASSUM(fun th -> CHANGED_TAC(ONCE_REWRITE_TAC[GSYM th])) THEN + CONJ_TAC THENL + [EXISTS_TAC `(Fn:num->A->(num->(A)recspace)->(num->B)->B) c i r y` THEN + REWRITE_TAC[CONSTR_BOT; CONSTR_INJ; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[UNWIND_THM1; RIGHT_EXISTS_AND_THM] THEN + EXISTS_TAC `y:num->B` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CONSTR_BOT; CONSTR_INJ; GSYM CONJ_ASSOC] THEN + REWRITE_TAC[UNWIND_THM1; RIGHT_EXISTS_AND_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT AP_TERM_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `w:num` THEN FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `w:num` THEN ASM_REWRITE_TAC[]]]; + REWRITE_TAC[UNIQUE_SKOLEM_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `fn:(A)recspace->B` (ASSUME_TAC o GSYM)) THEN + EXISTS_TAC `fn:(A)recspace->B` THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + REWRITE_TAC[BETA_THM]]);; + +(* ------------------------------------------------------------------------- *) +(* The following is useful for coding up functions casewise. *) +(* ------------------------------------------------------------------------- *) + +let FCONS = new_recursive_definition num_RECURSION + `(!a f. FCONS (a:A) f 0 = a) /\ + (!a f n. FCONS (a:A) f (SUC n) = f n)`;; + +let FCONS_UNDO = prove + (`!f:num->A. f = FCONS (f 0) (f o SUC)`, + GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + INDUCT_TAC THEN REWRITE_TAC[FCONS; o_THM]);; + +let FNIL = new_definition + `FNIL (n:num) = @x:A. T`;; + +(* ------------------------------------------------------------------------- *) +(* The initial mutual type definition function, with a type-restricted *) +(* recursion theorem. *) +(* ------------------------------------------------------------------------- *) + +let define_type_raw = + + (* ----------------------------------------------------------------------- *) + (* Handy utility to produce "SUC o SUC o SUC ..." form of numeral. *) + (* ----------------------------------------------------------------------- *) + + let sucivate = + let zero = `0` and suc = `SUC` in + fun n -> funpow n (curry mk_comb suc) zero in + + (* ----------------------------------------------------------------------- *) + (* Eliminate local "definitions" in hyps. *) + (* ----------------------------------------------------------------------- *) + + + let SCRUB_EQUATION eq (th,insts) = (*HA*) + let eq' = itlist subst (map (fun t -> [t]) insts) eq in + let l,r = dest_eq eq' in + (MP (INST [r,l] (DISCH eq' th)) (REFL r),(r,l)::insts) in + + (* ----------------------------------------------------------------------- *) + (* Proves existence of model (inductively); use pseudo-constructors. *) + (* *) + (* Returns suitable definitions of constructors in terms of CONSTR, and *) + (* the rule and induction theorems from the inductive relation package. *) + (* ----------------------------------------------------------------------- *) + + let justify_inductive_type_model = + let t_tm = `T` and n_tm = `n:num` and beps_tm = `@x:bool. T` in + let rec munion s1 s2 = + if s1 = [] then s2 else + let h1 = hd s1 + and s1' = tl s1 in + try let _,s2' = remove (fun h2 -> h2 = h1) s2 in h1::(munion s1' s2') + with Failure _ -> h1::(munion s1' s2) in + fun def -> + let newtys,rights = unzip def in + let tyargls = itlist ((@) o map snd) rights [] in + let alltys = itlist (munion o C subtract newtys) tyargls [] in + let epstms = map (fun ty -> mk_select(mk_var("v",ty),t_tm)) alltys in + let pty = + try end_itlist (fun ty1 ty2 -> mk_type("prod",[ty1;ty2])) alltys + with Failure _ -> bool_ty in + let recty = mk_type("recspace",[pty]) in + let constr = mk_const("CONSTR",[pty,aty]) in + let fcons = mk_const("FCONS",[recty,aty]) in + let bot = mk_const("BOTTOM",[pty,aty]) in + let bottail = mk_abs(n_tm,bot) in + let mk_constructor n (cname,cargs) = + let ttys = map (fun ty -> if mem ty newtys then recty else ty) cargs in + let args = make_args "a" [] ttys in + let rargs,iargs = partition (fun t -> type_of t = recty) args in + let rec mk_injector epstms alltys iargs = + if alltys = [] then [] else + let ty = hd alltys in + try let a,iargs' = remove (fun t -> type_of t = ty) iargs in + a::(mk_injector (tl epstms) (tl alltys) iargs') + with Failure _ -> + (hd epstms)::(mk_injector (tl epstms) (tl alltys) iargs) in + let iarg = + try end_itlist (curry mk_pair) (mk_injector epstms alltys iargs) + with Failure _ -> beps_tm in + let rarg = itlist (mk_binop fcons) rargs bottail in + let conty = itlist mk_fun_ty (map type_of args) recty in + let condef = list_mk_comb(constr,[sucivate n; iarg; rarg]) in + mk_eq(mk_var(cname,conty),list_mk_abs(args,condef)) in + let rec mk_constructors n rights = + if rights = [] then [] else + (mk_constructor n (hd rights))::(mk_constructors (n + 1) (tl rights)) in + let condefs = mk_constructors 0 (itlist (@) rights []) in + let conths = map ASSUME condefs in + let predty = mk_fun_ty recty bool_ty in + let edefs = itlist (fun (x,l) acc -> map (fun t -> x,t) l @ acc) def [] in + let idefs = map2 (fun (r,(_,atys)) def -> (r,atys),def) edefs condefs in + let mk_rule ((r,a),condef) = + let left,right = dest_eq condef in + let args,bod = strip_abs right in + let lapp = list_mk_comb(left,args) in + let conds = itlist2 + (fun arg argty sofar -> + if mem argty newtys then + mk_comb(mk_var(dest_vartype argty,predty),arg)::sofar + else sofar) args a [] in + let conc = mk_comb(mk_var(dest_vartype r,predty),lapp) in + let rule = if conds = [] then conc + else mk_imp(list_mk_conj conds,conc) in + list_mk_forall(args,rule) in + let rules = list_mk_conj (map mk_rule idefs) in + let th0 = derive_nonschematic_inductive_relations rules in + let th1 = prove_monotonicity_hyps th0 in + let th2a,th2bc = CONJ_PAIR th1 in + let th2b = CONJUNCT1 th2bc in + conths,th2a,th2b in + + (* ----------------------------------------------------------------------- *) + (* Shows that the predicates defined by the rules are all nonempty. *) + (* (This could be done much more efficiently/cleverly, but it's OK.) *) + (* ----------------------------------------------------------------------- *) + + let prove_model_inhabitation rth = + let srules = map SPEC_ALL (CONJUNCTS rth) in + let imps,bases = partition (is_imp o concl) srules in + let concs = map concl bases @ map (rand o concl) imps in + let preds = setify (map (repeat rator) concs) in + let rec exhaust_inhabitations ths sofar = + let dunnit = setify(map (fst o strip_comb o concl) sofar) in + let useful = filter + (fun th -> not (mem (fst(strip_comb(rand(concl th)))) dunnit)) ths in + if useful = [] then sofar else + let follow_horn thm = + let preds = map (fst o strip_comb) (conjuncts(lhand(concl thm))) in + let asms = map + (fun p -> find (fun th -> fst(strip_comb(concl th)) = p) sofar) + preds in + MATCH_MP thm (end_itlist CONJ asms) in + let newth = tryfind follow_horn useful in + exhaust_inhabitations ths (newth::sofar) in + let ithms = exhaust_inhabitations imps bases in + let exths = map + (fun p -> find (fun th -> fst(strip_comb(concl th)) = p) ithms) preds in + exths in + + (* ----------------------------------------------------------------------- *) + (* Makes a type definition for one of the defined subsets. *) + (* ----------------------------------------------------------------------- *) + + let define_inductive_type cdefs exth = + let extm = concl exth in + let epred = fst(strip_comb extm) in + let ename = fst(dest_var epred) in + let th1 = ASSUME (find (fun eq -> lhand eq = epred) (hyp exth)) in + let th2 = TRANS th1 (SUBS_CONV cdefs (rand(concl th1))) in + let th3 = EQ_MP (AP_THM th2 (rand extm)) exth in + let th4,_ = itlist SCRUB_EQUATION (hyp th3) (th3,[]) in + let mkname = "_mk_"^ename and destname = "_dest_"^ename in + let bij1,bij2 = new_basic_type_definition ename (mkname,destname) th4 in + let bij2a = AP_THM th2 (rand(rand(concl bij2))) in + let bij2b = TRANS bij2a bij2 in + bij1,bij2b in + + (* ----------------------------------------------------------------------- *) + (* Defines a type constructor corresponding to current pseudo-constructor. *) + (* ----------------------------------------------------------------------- *) + + let define_inductive_type_constructor defs consindex th = + let avs,bod = strip_forall(concl th) in + let asms,conc = + if is_imp bod then conjuncts(lhand bod),rand bod else [],bod in + let asmlist = map dest_comb asms in + let cpred,cterm = dest_comb conc in + let oldcon,oldargs = strip_comb cterm in + let modify_arg v = + try let dest = snd(assoc (rev_assoc v asmlist) consindex) in + let ty' = hd(snd(dest_type(type_of dest))) in + let v' = mk_var(fst(dest_var v),ty') in + mk_comb(dest,v'),v' + with Failure _ -> v,v in + let newrights,newargs = unzip(map modify_arg oldargs) in + let retmk = fst(assoc cpred consindex) in + let defbod = mk_comb(retmk,list_mk_comb(oldcon,newrights)) in + let defrt = list_mk_abs(newargs,defbod) in + let expth = find (fun th -> lhand(concl th) = oldcon) defs in + let rexpth = SUBS_CONV [expth] defrt in + let deflf = mk_var(fst(dest_var oldcon),type_of defrt) in + let defth = new_definition(mk_eq(deflf,rand(concl rexpth))) in + TRANS defth (SYM rexpth) in + + (* ----------------------------------------------------------------------- *) + (* Instantiate the induction theorem on the representatives to transfer *) + (* it to the new type(s). Uses "\x. rep-pred(x) /\ P(mk x)" for "P". *) + (* ----------------------------------------------------------------------- *) + + let instantiate_induction_theorem consindex ith = + let avs,bod = strip_forall(concl ith) in + let corlist = map((repeat rator F_F repeat rator) o dest_imp o body o rand) + (conjuncts(rand bod)) in + let consindex' = map (fun v -> let w = rev_assoc v corlist in + w,assoc w consindex) avs in + let recty = (hd o snd o dest_type o type_of o fst o snd o hd) consindex in + let newtys = map (hd o snd o dest_type o type_of o snd o snd) consindex' in + let ptypes = map (C mk_fun_ty bool_ty) newtys in + let preds = make_args "P" [] ptypes in + let args = make_args "x" [] (map (K recty) preds) in + let lambs = map2 (fun (r,(m,d)) (p,a) -> + mk_abs(a,mk_conj(mk_comb(r,a),mk_comb(p,mk_comb(m,a))))) + consindex' (zip preds args) in + SPECL lambs ith in + + (* ----------------------------------------------------------------------- *) + (* Reduce a single clause of the postulated induction theorem (old_ver) ba *) + (* to the kind wanted for the new type (new_ver); |- new_ver ==> old_ver *) + (* ----------------------------------------------------------------------- *) + + let pullback_induction_clause tybijpairs conthms = + let PRERULE = GEN_REWRITE_RULE (funpow 3 RAND_CONV) (map SYM conthms) in + let IPRULE = SYM o GEN_REWRITE_RULE I (map snd tybijpairs) in + fun rthm tm -> + let avs,bimp = strip_forall tm in + if is_imp bimp then + let ant,con = dest_imp bimp in + let ths = map (CONV_RULE BETA_CONV) (CONJUNCTS (ASSUME ant)) in + let tths,pths = unzip (map CONJ_PAIR ths) in + let tth = MATCH_MP (SPEC_ALL rthm) (end_itlist CONJ tths) in + let mths = map IPRULE (tth::tths) in + let conth1 = BETA_CONV con in + let contm1 = rand(concl conth1) in + let conth2 = TRANS conth1 + (AP_TERM (rator contm1) (SUBS_CONV (tl mths) (rand contm1))) in + let conth3 = PRERULE conth2 in + let lctms = map concl pths in + let asmin = mk_imp(list_mk_conj lctms,rand(rand(concl conth3))) in + let argsin = map rand (conjuncts(lhand asmin)) in + let argsgen = + map (fun tm -> mk_var(fst(dest_var(rand tm)),type_of tm)) argsin in + let asmgen = subst (zip argsgen argsin) asmin in + let asmquant = + list_mk_forall(snd(strip_comb(rand(rand asmgen))),asmgen) in + let th1 = INST (zip argsin argsgen) (SPEC_ALL (ASSUME asmquant)) in + let th2 = MP th1 (end_itlist CONJ pths) in + let th3 = EQ_MP (SYM conth3) (CONJ tth th2) in + DISCH asmquant (GENL avs (DISCH ant th3)) + else + let con = bimp in + let conth2 = BETA_CONV con in + let tth = PART_MATCH I rthm (lhand(rand(concl conth2))) in + let conth3 = PRERULE conth2 in + let asmgen = rand(rand(concl conth3)) in + let asmquant = list_mk_forall(snd(strip_comb(rand asmgen)),asmgen) in + let th2 = SPEC_ALL (ASSUME asmquant) in + let th3 = EQ_MP (SYM conth3) (CONJ tth th2) in + DISCH asmquant (GENL avs th3) in + + (* ----------------------------------------------------------------------- *) + (* Finish off a consequence of the induction theorem. *) + (* ----------------------------------------------------------------------- *) + + let finish_induction_conclusion consindex tybijpairs = + let tybij1,tybij2 = unzip tybijpairs in + let PRERULE = + GEN_REWRITE_RULE (LAND_CONV o LAND_CONV o RAND_CONV) tybij1 o + GEN_REWRITE_RULE LAND_CONV tybij2 + and FINRULE = GEN_REWRITE_RULE RAND_CONV tybij1 in + fun th -> + let av,bimp = dest_forall(concl th) in + let pv = lhand(body(rator(rand bimp))) in + let p,v = dest_comb pv in + let mk,dest = assoc p consindex in + let ty = hd(snd(dest_type(type_of dest))) in + let v' = mk_var(fst(dest_var v),ty) in + let dv = mk_comb(dest,v') in + let th1 = PRERULE (SPEC dv th) in + let th2 = MP th1 (REFL (rand(lhand(concl th1)))) in + let th3 = CONV_RULE BETA_CONV th2 in + GEN v' (FINRULE (CONJUNCT2 th3)) in + + (* ----------------------------------------------------------------------- *) + (* Derive the induction theorem. *) + (* ----------------------------------------------------------------------- *) + + let derive_induction_theorem consindex tybijpairs conthms iith rth = + let bths = map2 + (pullback_induction_clause tybijpairs conthms) + (CONJUNCTS rth) (conjuncts(lhand(concl iith))) in + let asm = list_mk_conj(map (lhand o concl) bths) in + let ths = map2 MP bths (CONJUNCTS (ASSUME asm)) in + let th1 = MP iith (end_itlist CONJ ths) in + let th2 = end_itlist CONJ (map + (finish_induction_conclusion consindex tybijpairs) (CONJUNCTS th1)) in + let th3 = DISCH asm th2 in + let preds = map (rator o body o rand) (conjuncts(rand(concl th3))) in + let th4 = GENL preds th3 in + let pasms = filter (C mem (map fst consindex) o lhand) (hyp th4) in + let th5 = itlist DISCH pasms th4 in + let th6,_ = itlist SCRUB_EQUATION (hyp th5) (th5,[]) in + let th7 = UNDISCH_ALL th6 in + fst (itlist SCRUB_EQUATION (hyp th7) (th7,[])) in + + (* ----------------------------------------------------------------------- *) + (* Create the recursive functions and eliminate pseudo-constructors. *) + (* (These are kept just long enough to derive the key property.) *) + (* ----------------------------------------------------------------------- *) + + let create_recursive_functions tybijpairs consindex conthms rth = + let domtys = map (hd o snd o dest_type o type_of o snd o snd) consindex in + let recty = (hd o snd o dest_type o type_of o fst o snd o hd) consindex in + let ranty = mk_vartype "Z" in + let fn = mk_var("fn",mk_fun_ty recty ranty) + and fns = make_args "fn" [] (map (C mk_fun_ty ranty) domtys) in + let args = make_args "a" [] domtys in + let rights = map2 (fun (_,(_,d)) a -> mk_abs(a,mk_comb(fn,mk_comb(d,a)))) + consindex args in + let eqs = map2 (curry mk_eq) fns rights in + let fdefs = map ASSUME eqs in + let fxths1 = map (fun th1 -> tryfind (fun th2 -> MK_COMB(th2,th1)) fdefs) + conthms in + let fxths2 = map (fun th -> TRANS th (BETA_CONV (rand(concl th)))) fxths1 in + let mk_tybijcons (th1,th2) = + let th3 = INST [rand(lhand(concl th1)),rand(lhand(concl th2))] th2 in + let th4 = AP_TERM (rator(lhand(rand(concl th2)))) th1 in + EQ_MP (SYM th3) th4 in + let SCONV = GEN_REWRITE_CONV I (map mk_tybijcons tybijpairs) + and ERULE = GEN_REWRITE_RULE I (map snd tybijpairs) in + let simplify_fxthm rthm fxth = + let pat = funpow 4 rand (concl fxth) in + if is_imp(repeat (snd o dest_forall) (concl rthm)) then + let th1 = PART_MATCH (rand o rand) rthm pat in + let tms1 = conjuncts(lhand(concl th1)) in + let ths2 = map (fun t -> EQ_MP (SYM(SCONV t)) TRUTH) tms1 in + ERULE (MP th1 (end_itlist CONJ ths2)) + else + ERULE (PART_MATCH rand rthm pat) in + let fxths3 = map2 simplify_fxthm (CONJUNCTS rth) fxths2 in + let fxths4 = map2 (fun th1 -> TRANS th1 o AP_TERM fn) fxths2 fxths3 in + let cleanup_fxthm cth fxth = + let tms = snd(strip_comb(rand(rand(concl fxth)))) in + let kth = RIGHT_BETAS tms (ASSUME (hd(hyp cth))) in + TRANS fxth (AP_TERM fn kth) in + let fxth5 = end_itlist CONJ (map2 cleanup_fxthm conthms fxths4) in + let pasms = filter (C mem (map fst consindex) o lhand) (hyp fxth5) in + let fxth6 = itlist DISCH pasms fxth5 in + let fxth7,_ = + itlist SCRUB_EQUATION (itlist (union o hyp) conthms []) (fxth6,[]) in + let fxth8 = UNDISCH_ALL fxth7 in + fst (itlist SCRUB_EQUATION (subtract (hyp fxth8) eqs) (fxth8,[])) in + + (* ----------------------------------------------------------------------- *) + (* Create a function for recursion clause. *) + (* ----------------------------------------------------------------------- *) + + let create_recursion_iso_constructor = + let s = `s:num->Z` in + let zty = `:Z` in + let numty = `:num` in + let rec extract_arg tup v = + if v = tup then REFL tup else + let t1,t2 = dest_pair tup in + let PAIR_th = ISPECL [t1;t2] (if free_in v t1 then FST else SND) in + let tup' = rand(concl PAIR_th) in + if tup' = v then PAIR_th else + let th = extract_arg (rand(concl PAIR_th)) v in + SUBS[SYM PAIR_th] th in + fun consindex -> + let recty = hd(snd(dest_type(type_of(fst(hd consindex))))) in + let domty = hd(snd(dest_type recty)) in + let i = mk_var("i",domty) + and r = mk_var("r",mk_fun_ty numty recty) in + let mks = map (fst o snd) consindex in + let mkindex = map (fun t -> hd(tl(snd(dest_type(type_of t)))),t) mks in + fun cth -> + let artms = snd(strip_comb(rand(rand(concl cth)))) in + let artys = mapfilter (type_of o rand) artms in + let args,bod = strip_abs(rand(hd(hyp cth))) in + let ccitm,rtm = dest_comb bod in + let cctm,itm = dest_comb ccitm in + let rargs,iargs = partition (C free_in rtm) args in + let xths = map (extract_arg itm) iargs in + let cargs' = map (subst [i,itm] o lhand o concl) xths in + let indices = map sucivate (0--(length rargs - 1)) in + let rindexed = map (curry mk_comb r) indices in + let rargs' = map2 (fun a rx -> mk_comb(assoc a mkindex,rx)) + artys rindexed in + let sargs' = map (curry mk_comb s) indices in + let allargs = cargs'@ rargs' @ sargs' in + let funty = itlist (mk_fun_ty o type_of) allargs zty in + let funname = fst(dest_const(repeat rator (lhand(concl cth))))^"'" in + let funarg = mk_var(funname,funty) in + list_mk_abs([i;r;s],list_mk_comb(funarg,allargs)) in + + (* ----------------------------------------------------------------------- *) + (* Derive the recursion theorem. *) + (* ----------------------------------------------------------------------- *) + + let derive_recursion_theorem = + let CCONV = funpow 3 RATOR_CONV (REPEATC (GEN_REWRITE_CONV I [FCONS])) in + fun tybijpairs consindex conthms rath -> + let isocons = map (create_recursion_iso_constructor consindex) conthms in + let ty = type_of(hd isocons) in + let fcons = mk_const("FCONS",[ty,aty]) + and fnil = mk_const("FNIL",[ty,aty]) in + let bigfun = itlist (mk_binop fcons) isocons fnil in + let eth = ISPEC bigfun CONSTR_REC in + let fn = rator(rand(hd(conjuncts(concl rath)))) in + let betm = let v,bod = dest_abs(rand(concl eth)) in vsubst[fn,v] bod in + let LCONV = REWR_CONV (ASSUME betm) in + let fnths = + map (fun t -> RIGHT_BETAS [bndvar(rand t)] (ASSUME t)) (hyp rath) in + let SIMPER = PURE_REWRITE_RULE + (map SYM fnths @ map fst tybijpairs @ [FST; SND; FCONS; BETA_THM]) in + let hackdown_rath th = + let ltm,rtm = dest_eq(concl th) in + let wargs = snd(strip_comb(rand ltm)) in + let th1 = TRANS th (LCONV rtm) in + let th2 = TRANS th1 (CCONV (rand(concl th1))) in + let th3 = TRANS th2 (funpow 2 RATOR_CONV BETA_CONV (rand(concl th2))) in + let th4 = TRANS th3 (RATOR_CONV BETA_CONV (rand(concl th3))) in + let th5 = TRANS th4 (BETA_CONV (rand(concl th4))) in + GENL wargs (SIMPER th5) in + let rthm = end_itlist CONJ (map hackdown_rath (CONJUNCTS rath)) in + let seqs = + let unseqs = filter is_eq (hyp rthm) in + let tys = map (hd o snd o dest_type o type_of o snd o snd) consindex in + map (fun ty -> find + (fun t -> hd(snd(dest_type(type_of(lhand t)))) = ty) unseqs) tys in + let rethm = itlist EXISTS_EQUATION seqs rthm in + let fethm = CHOOSE(fn,eth) rethm in + let pcons = map (repeat rator o rand o repeat (snd o dest_forall)) + (conjuncts(concl rthm)) in + GENL pcons fethm in + + (* ----------------------------------------------------------------------- *) + (* Basic function: returns induction and recursion separately. No parser. *) + (* ----------------------------------------------------------------------- *) + + fun def -> + let defs,rth,ith = justify_inductive_type_model def in + let neths = prove_model_inhabitation rth in + let tybijpairs = map (define_inductive_type defs) neths in + let preds = map (repeat rator o concl) neths in + let mkdests = map + (fun (th,_) -> let tm = lhand(concl th) in rator tm,rator(rand tm)) + tybijpairs in + let consindex = zip preds mkdests in + let condefs = map (define_inductive_type_constructor defs consindex) + (CONJUNCTS rth) in + let conthms = map + (fun th -> let args = fst(strip_abs(rand(concl th))) in + RIGHT_BETAS args th) condefs in + let iith = instantiate_induction_theorem consindex ith in + let fth = derive_induction_theorem consindex tybijpairs conthms iith rth in + let rath = create_recursive_functions tybijpairs consindex conthms rth in + let kth = derive_recursion_theorem tybijpairs consindex conthms rath in + fth,kth;; + +(* ------------------------------------------------------------------------- *) +(* Parser to present a nice interface a la Melham. *) +(* ------------------------------------------------------------------------- *) + +let parse_inductive_type_specification = + let parse_type_loc src = + let pty,rst = parse_pretype src in + type_of_pretype pty,rst in + let parse_type_conapp src = + let cn,sps = + match src with (Ident cn)::sps -> cn,sps + | _ -> fail() in + let tys,rst = many parse_type_loc sps in + (cn,tys),rst in + let parse_type_clause src = + let tn,sps = + match src with (Ident tn)::sps -> tn,sps + | _ -> fail() in + let tys,rst = (a (Ident "=") ++ listof parse_type_conapp (a (Resword "|")) + "type definition clauses" + >> snd) sps in + (mk_vartype tn,tys),rst in + let parse_type_definition = + listof parse_type_clause (a (Resword ";")) "type definition" in + fun s -> + let spec,rst = (parse_type_definition o lex o explode) s in + if rst = [] then spec + else failwith "parse_inductive_type_specification: junk after def";; + +(* ------------------------------------------------------------------------- *) +(* Use this temporary version to define the sum type. *) +(* ------------------------------------------------------------------------- *) + +let sum_INDUCT,sum_RECURSION = + define_type_raw (parse_inductive_type_specification "sum = INL A | INR B");; + +let OUTL = new_recursive_definition sum_RECURSION + `OUTL (INL x :A+B) = x`;; + +let OUTR = new_recursive_definition sum_RECURSION + `OUTR (INR y :A+B) = y`;; + +(* ------------------------------------------------------------------------- *) +(* Generalize the recursion theorem to multiple domain types. *) +(* (We needed to use a single type to justify it via a proforma theorem.) *) +(* *) +(* NB! Before this is called nontrivially (i.e. more than one new type) *) +(* the type constructor ":sum", used internally, must have been defined. *) +(* ------------------------------------------------------------------------- *) + +let define_type_raw = + let generalize_recursion_theorem = + let ELIM_OUTCOMBS = GEN_REWRITE_RULE TOP_DEPTH_CONV [OUTL; OUTR] in + let rec mk_sum tys = + let k = length tys in + if k = 1 then hd tys else + let tys1,tys2 = chop_list (k / 2) tys in + mk_type("sum",[mk_sum tys1; mk_sum tys2]) in + let mk_inls = + let rec mk_inls ty = + if is_vartype ty then [mk_var("x",ty)] else + let _,[ty1;ty2] = dest_type ty in + let inls1 = mk_inls ty1 + and inls2 = mk_inls ty2 in + let inl = mk_const("INL",[ty1,aty; ty2,bty]) + and inr = mk_const("INR",[ty1,aty; ty2,bty]) in + map (curry mk_comb inl) inls1 @ map (curry mk_comb inr) inls2 in + fun ty -> let bods = mk_inls ty in + map (fun t -> mk_abs(find_term is_var t,t)) bods in + let mk_outls = + let rec mk_inls sof ty = + if is_vartype ty then [sof] else + let _,[ty1;ty2] = dest_type ty in + let outl = mk_const("OUTL",[ty1,aty; ty2,bty]) + and outr = mk_const("OUTR",[ty1,aty; ty2,bty]) in + mk_inls (mk_comb(outl,sof)) ty1 @ mk_inls (mk_comb(outr,sof)) ty2 in + fun ty -> let x = mk_var("x",ty) in + map (curry mk_abs x) (mk_inls x ty) in + let mk_newfun fn outl = + let s,ty = dest_var fn in + let dty = hd(snd(dest_type ty)) in + let x = mk_var("x",dty) in + let y,bod = dest_abs outl in + let r = mk_abs(x,vsubst[mk_comb(fn,x),y] bod) in + let l = mk_var(s,type_of r) in + let th1 = ASSUME (mk_eq(l,r)) in + RIGHT_BETAS [x] th1 in + fun th -> + let avs,ebod = strip_forall(concl th) in + let evs,bod = strip_exists ebod in + let n = length evs in + if n = 1 then th else + let tys = map (fun i -> mk_vartype ("Z"^(string_of_int i))) + (0--(n - 1)) in + let sty = mk_sum tys in + let inls = mk_inls sty + and outls = mk_outls sty in + let zty = type_of(rand(snd(strip_forall(hd(conjuncts bod))))) in + let ith = INST_TYPE [sty,zty] th in + let avs,ebod = strip_forall(concl ith) in + let evs,bod = strip_exists ebod in + let fns' = map2 mk_newfun evs outls in + let fnalist = zip evs (map (rator o lhs o concl) fns') + and inlalist = zip evs inls + and outlalist = zip evs outls in + let hack_clause tm = + let avs,bod = strip_forall tm in + let l,r = dest_eq bod in + let fn,args = strip_comb r in + let pargs = map + (fun a -> let g = genvar(type_of a) in + if is_var a then g,g else + let outl = assoc (rator a) outlalist in + mk_comb(outl,g),g) args in + let args',args'' = unzip pargs in + let inl = assoc (rator l) inlalist in + let rty = hd(snd(dest_type(type_of inl))) in + let nty = itlist (mk_fun_ty o type_of) args' rty in + let fn' = mk_var(fst(dest_var fn),nty) in + let r' = list_mk_abs(args'',mk_comb(inl,list_mk_comb(fn',args'))) in + r',fn in + let defs = map hack_clause (conjuncts bod) in + let jth = BETA_RULE (SPECL (map fst defs) ith) in + let bth = ASSUME (snd(strip_exists(concl jth))) in + let finish_clause th = + let avs,bod = strip_forall (concl th) in + let outl = assoc (rator (lhand bod)) outlalist in + GENL avs (BETA_RULE (AP_TERM outl (SPECL avs th))) in + let cth = end_itlist CONJ (map finish_clause (CONJUNCTS bth)) in + let dth = ELIM_OUTCOMBS cth in + let eth = GEN_REWRITE_RULE ONCE_DEPTH_CONV (map SYM fns') dth in + let fth = itlist SIMPLE_EXISTS (map snd fnalist) eth in + let dtms = map (hd o hyp) fns' in + let gth = itlist (fun e th -> let l,r = dest_eq e in + MP (INST [r,l] (DISCH e th)) (REFL r)) dtms fth in + let hth = PROVE_HYP jth (itlist SIMPLE_CHOOSE evs gth) in + let xvs = map (fst o strip_comb o rand o snd o strip_forall) + (conjuncts(concl eth)) in + GENL xvs hth in + fun def -> let ith,rth = define_type_raw def in + ith,generalize_recursion_theorem rth;; + +(* ------------------------------------------------------------------------- *) +(* Set up options and lists. *) +(* ------------------------------------------------------------------------- *) + +let option_INDUCT,option_RECURSION = + define_type_raw + (parse_inductive_type_specification "option = NONE | SOME A");; + +let list_INDUCT,list_RECURSION = + define_type_raw + (parse_inductive_type_specification "list = NIL | CONS A list");; + +(* ------------------------------------------------------------------------- *) +(* Tools for proving injectivity and distinctness of constructors. *) +(* ------------------------------------------------------------------------- *) + +let prove_constructors_injective = + let DEPAIR = GEN_REWRITE_RULE TOP_SWEEP_CONV [PAIR_EQ] in + let prove_distinctness ax pat = + let f,args = strip_comb pat in + let rt = end_itlist (curry mk_pair) args in + let ty = mk_fun_ty (type_of pat) (type_of rt) in + let fn = genvar ty in + let dtm = mk_eq(mk_comb(fn,pat),rt) in + let eth = prove_recursive_functions_exist ax (list_mk_forall(args,dtm)) in + let args' = variants args args in + let atm = mk_eq(pat,list_mk_comb(f,args')) in + let ath = ASSUME atm in + let bth = AP_TERM fn ath in + let cth1 = SPECL args (ASSUME(snd(dest_exists(concl eth)))) in + let cth2 = INST (zip args' args) cth1 in + let pth = TRANS (TRANS (SYM cth1) bth) cth2 in + let qth = DEPAIR pth in + let qtm = concl qth in + let rth = rev_itlist (C(curry MK_COMB)) (CONJUNCTS(ASSUME qtm)) (REFL f) in + let tth = IMP_ANTISYM_RULE (DISCH atm qth) (DISCH qtm rth) in + let uth = GENL args (GENL args' tth) in + PROVE_HYP eth (SIMPLE_CHOOSE fn uth) in + fun ax -> + let cls = conjuncts(snd(strip_exists(snd(strip_forall(concl ax))))) in + let pats = map (rand o lhand o snd o strip_forall) cls in + end_itlist CONJ (mapfilter (prove_distinctness ax) pats);; + +let prove_constructors_distinct = + let num_ty = `:num` in + let rec allopairs f l m = + if l = [] then [] else + map (f (hd l)) (tl m) @ allopairs f (tl l) (tl m) in + let NEGATE = GEN_ALL o CONV_RULE (REWR_CONV (TAUT `a ==> F <=> ~a`)) in + let prove_distinct ax pat = + let nums = map mk_small_numeral (0--(length pat - 1)) in + let fn = genvar (mk_type("fun",[type_of(hd pat); num_ty])) in + let ls = map (curry mk_comb fn) pat in + let defs = map2 (fun l r -> list_mk_forall(frees (rand l),mk_eq(l,r))) + ls nums in + let eth = prove_recursive_functions_exist ax (list_mk_conj defs) in + let ev,bod = dest_exists(concl eth) in + let REWRITE = GEN_REWRITE_RULE ONCE_DEPTH_CONV (CONJUNCTS (ASSUME bod)) in + let pat' = map + (fun t -> let f,args = if is_numeral t then t,[] else strip_comb t in + list_mk_comb(f,variants args args)) pat in + let pairs = allopairs (curry mk_eq) pat pat' in + let nths = map (REWRITE o AP_TERM fn o ASSUME) pairs in + let fths = map2 (fun t th -> NEGATE (DISCH t (CONV_RULE NUM_EQ_CONV th))) + pairs nths in + CONJUNCTS(PROVE_HYP eth (SIMPLE_CHOOSE ev (end_itlist CONJ fths))) in + fun ax -> + let cls = conjuncts(snd(strip_exists(snd(strip_forall(concl ax))))) in + let lefts = map (dest_comb o lhand o snd o strip_forall) cls in + let fns = itlist (insert o fst) lefts [] in + let pats = map (fun f -> map snd (filter ((=)f o fst) lefts)) fns in + end_itlist CONJ + (end_itlist (@) (mapfilter (prove_distinct ax) pats));; + +(* ------------------------------------------------------------------------- *) +(* Automatically prove the case analysis theorems. *) +(* ------------------------------------------------------------------------- *) + +let prove_cases_thm = + let mk_exclauses x rpats = + let xts = map (fun t -> list_mk_exists(frees t,mk_eq(x,t))) rpats in + mk_abs(x,list_mk_disj xts) in + let prove_triv tm = + let evs,bod = strip_exists tm in + let l,r = dest_eq bod in + if l = r then REFL l else + let lf,largs = strip_comb l + and rf,rargs = strip_comb r in + if lf = rf then + let ths = map (ASSUME o mk_eq) (zip rargs largs) in + let th1 = rev_itlist (C (curry MK_COMB)) ths (REFL lf) in + itlist EXISTS_EQUATION (map concl ths) (SYM th1) + else failwith "prove_triv" in + let rec prove_disj tm = + if is_disj tm then + let l,r = dest_disj tm in + try DISJ1 (prove_triv l) r + with Failure _ -> DISJ2 l (prove_disj r) + else + prove_triv tm in + let prove_eclause tm = + let avs,bod = strip_forall tm in + let ctm = if is_imp bod then rand bod else bod in + let cth = prove_disj ctm in + let dth = if is_imp bod then DISCH (lhand bod) cth else cth in + GENL avs dth in + fun th -> + let avs,bod = strip_forall(concl th) in + let cls = map (snd o strip_forall) (conjuncts(lhand bod)) in + let pats = map (fun t -> if is_imp t then rand t else t) cls in + let spats = map dest_comb pats in + let preds = itlist (insert o fst) spats [] in + let rpatlist = map + (fun pr -> map snd (filter (fun (p,x) -> p = pr) spats)) preds in + let xs = make_args "x" (freesl pats) (map (type_of o hd) rpatlist) in + let xpreds = map2 mk_exclauses xs rpatlist in + let ith = BETA_RULE (INST (zip xpreds preds) (SPEC_ALL th)) in + let eclauses = conjuncts(fst(dest_imp(concl ith))) in + MP ith (end_itlist CONJ (map prove_eclause eclauses));; + +(* ------------------------------------------------------------------------- *) +(* Now deal with nested recursion. Need a store of previous theorems. *) +(* ------------------------------------------------------------------------- *) + +inductive_type_store := + ["list",(2,list_INDUCT,list_RECURSION); + "option",(2,option_INDUCT,option_RECURSION); + "sum",(2,sum_INDUCT,sum_RECURSION)] @ + (!inductive_type_store);; + +(* ------------------------------------------------------------------------- *) +(* Also add a cached rewrite of distinctness and injectivity theorems. Since *) +(* there can be quadratically many distinctness clauses, it would really be *) +(* preferable to have a conversion, but this seems OK up 100 constructors. *) +(* ------------------------------------------------------------------------- *) + +let basic_rectype_net = ref empty_net;; +let distinctness_store = ref ["bool",TAUT `(T <=> F) <=> F`];; +let injectivity_store = ref [];; + +let extend_rectype_net (tyname,(_,_,rth)) = + let ths1 = try [prove_constructors_distinct rth] with Failure _ -> [] + and ths2 = try [prove_constructors_injective rth] with Failure _ -> [] in + let canon_thl = itlist (mk_rewrites false) (ths1 @ ths2) [] in + distinctness_store := map (fun th -> tyname,th) ths1 @ (!distinctness_store); + injectivity_store := map (fun th -> tyname,th) ths2 @ (!injectivity_store); + basic_rectype_net := + itlist (net_of_thm true) canon_thl (!basic_rectype_net);; + +do_list extend_rectype_net (!inductive_type_store);; + +(* ------------------------------------------------------------------------- *) +(* Return distinctness and injectivity for a type by simple lookup. *) +(* ------------------------------------------------------------------------- *) + +let distinctness ty = assoc ty (!distinctness_store);; + +let injectivity ty = assoc ty (!injectivity_store);; + +let cases ty = + if ty = "num" then num_CASES else + let _,ith,_ = assoc ty (!inductive_type_store) in prove_cases_thm ith;; + +(* ------------------------------------------------------------------------- *) +(* Convenient definitions for type isomorphism. *) +(* ------------------------------------------------------------------------- *) + +let ISO = new_definition + `ISO (f:A->B) (g:B->A) <=> (!x. f(g x) = x) /\ (!y. g(f y) = y)`;; + +let ISO_REFL = prove + (`ISO (\x:A. x) (\x. x)`, + REWRITE_TAC[ISO]);; + +let ISO_FUN = prove + (`ISO (f:A->A') f' /\ ISO (g:B->B') g' + ==> ISO (\h a'. g(h(f' a'))) (\h a. g'(h(f a)))`, + REWRITE_TAC[ISO; FUN_EQ_THM] THEN MESON_TAC[]);; + +let ISO_USAGE = prove + (`ISO f g + ==> (!P. (!x. P x) <=> (!x. P(g x))) /\ + (!P. (?x. P x) <=> (?x. P(g x))) /\ + (!a b. (a = g b) <=> (f a = b))`, + REWRITE_TAC[ISO; FUN_EQ_THM] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hence extend type definition to nested types. *) +(* ------------------------------------------------------------------------- *) + +let define_type_raw = + + (* ----------------------------------------------------------------------- *) + (* Dispose of trivial antecedent. *) + (* ----------------------------------------------------------------------- *) + + let TRIV_ANTE_RULE = + let TRIV_IMP_CONV tm = + let avs,bod = strip_forall tm in + let bth = + if is_eq bod then REFL (rand bod) else + let ant,con = dest_imp bod in + let ith = SUBS_CONV (CONJUNCTS(ASSUME ant)) (lhs con) in + DISCH ant ith in + GENL avs bth in + fun th -> + let tm = concl th in + if is_imp tm then + let ant,con = dest_imp(concl th) in + let cjs = conjuncts ant in + let cths = map TRIV_IMP_CONV cjs in + MP th (end_itlist CONJ cths) + else th in + + (* ----------------------------------------------------------------------- *) + (* Lift type bijections to "arbitrary" (well, free rec or function) type. *) + (* ----------------------------------------------------------------------- *) + + let ISO_EXPAND_CONV = PURE_ONCE_REWRITE_CONV[ISO] in + + let rec lift_type_bijections iths cty = + let itys = map (hd o snd o dest_type o type_of o lhand o concl) iths in + try assoc cty (zip itys iths) with Failure _ -> + if not (exists (C occurs_in cty) itys) + then INST_TYPE [cty,aty] ISO_REFL else + let tycon,isotys = dest_type cty in + if tycon = "fun" + then MATCH_MP ISO_FUN + (end_itlist CONJ (map (lift_type_bijections iths) isotys)) + else failwith + ("lift_type_bijections: Unexpected type operator \""^tycon^"\"") in + + (* ----------------------------------------------------------------------- *) + (* Prove isomorphism of nested types where former is the smaller. *) + (* ----------------------------------------------------------------------- *) + + let DE_EXISTENTIALIZE_RULE = + let pth = prove + (`(?) P ==> (c = (@)P) ==> P c`, + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + DISCH_TAC THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SELECT_AX THEN POP_ASSUM ACCEPT_TAC) in + let USE_PTH = MATCH_MP pth in + let rec DE_EXISTENTIALIZE_RULE th = + if not (is_exists(concl th)) then [],th else + let th1 = USE_PTH th in + let v1 = rand(rand(concl th1)) in + let gv = genvar(type_of v1) in + let th2 = CONV_RULE BETA_CONV (UNDISCH (INST [gv,v1] th1)) in + let vs,th3 = DE_EXISTENTIALIZE_RULE th2 in + gv::vs,th3 in + DE_EXISTENTIALIZE_RULE in + + let grab_type = type_of o rand o lhand o snd o strip_forall in + + let clause_corresponds cl0 = + let f0,ctm0 = dest_comb (lhs cl0) in + let c0 = fst(dest_const(fst(strip_comb ctm0))) in + let dty0,rty0 = dest_fun_ty (type_of f0) in + fun cl1 -> + let f1,ctm1 = dest_comb (lhs cl1) in + let c1 = fst(dest_const(fst(strip_comb ctm1))) in + let dty1,rty1 = dest_fun_ty (type_of f1) in + c0 = c1 & dty0 = rty1 & rty0 = dty1 in + + let prove_inductive_types_isomorphic n k (ith0,rth0) (ith1,rth1) = + let sth0 = SPEC_ALL rth0 + and sth1 = SPEC_ALL rth1 + and t_tm = concl TRUTH in + let pevs0,pbod0 = strip_exists (concl sth0) + and pevs1,pbod1 = strip_exists (concl sth1) in + let pcjs0,qcjs0 = chop_list k (conjuncts pbod0) + and pcjs1,qcjs1 = chop_list k (snd(chop_list n (conjuncts pbod1))) in + let tyal0 = setify (zip (map grab_type pcjs1) (map grab_type pcjs0)) in + let tyal1 = map (fun (a,b) -> (b,a)) tyal0 in + let tyins0 = map + (fun f -> let domty,ranty = dest_fun_ty (type_of f) in + tysubst tyal0 domty,ranty) pevs0 + and tyins1 = map + (fun f -> let domty,ranty = dest_fun_ty (type_of f) in + tysubst tyal1 domty,ranty) pevs1 in + let tth0 = INST_TYPE tyins0 sth0 + and tth1 = INST_TYPE tyins1 sth1 in + let evs0,bod0 = strip_exists(concl tth0) + and evs1,bod1 = strip_exists(concl tth1) in + let lcjs0,rcjs0 = chop_list k (map (snd o strip_forall) (conjuncts bod0)) + and lcjs1,rcjsx = chop_list k (map (snd o strip_forall) + (snd(chop_list n (conjuncts bod1)))) in + let rcjs1 = map (fun t -> find (clause_corresponds t) rcjsx) rcjs0 in + let proc_clause tm0 tm1 = + let l0,r0 = dest_eq tm0 + and l1,r1 = dest_eq tm1 in + let vc0,wargs0 = strip_comb r0 in + let con0,vargs0 = strip_comb(rand l0) in + let gargs0 = map (genvar o type_of) wargs0 in + let nestf0 = map (fun a -> can (find (fun t -> is_comb t & rand t = a)) + wargs0) vargs0 in + let targs0 = map2 (fun a f -> + if f then find (fun t -> is_comb t & rand t = a) wargs0 else a) + vargs0 nestf0 in + let gvlist0 = zip wargs0 gargs0 in + let xargs = map (fun v -> assoc v gvlist0) targs0 in + let inst0 = + list_mk_abs(gargs0,list_mk_comb(fst(strip_comb(rand l1)),xargs)),vc0 in + let vc1,wargs1 = strip_comb r1 in + let con1,vargs1 = strip_comb(rand l1) in + let gargs1 = map (genvar o type_of) wargs1 in + let targs1 = map2 + (fun a f -> if f then + find (fun t -> is_comb t & rand t = a) wargs1 + else a) vargs1 nestf0 in + let gvlist1 = zip wargs1 gargs1 in + let xargs = map (fun v -> assoc v gvlist1) targs1 in + let inst1 = + list_mk_abs(gargs1,list_mk_comb(fst(strip_comb(rand l0)),xargs)),vc1 in + inst0,inst1 in + let insts0,insts1 = unzip (map2 proc_clause (lcjs0@rcjs0) (lcjs1@rcjs1)) in + let uth0 = BETA_RULE(INST insts0 tth0) + and uth1 = BETA_RULE(INST insts1 tth1) in + let efvs0,sth0 = DE_EXISTENTIALIZE_RULE uth0 + and efvs1,sth1 = DE_EXISTENTIALIZE_RULE uth1 in + let efvs2 = map + (fun t1 -> find (fun t2 -> hd(tl(snd(dest_type(type_of t1)))) = + hd(snd(dest_type(type_of t2)))) efvs1) efvs0 in + let isotms = map2 (fun ff gg -> list_mk_icomb "ISO" [ff;gg]) efvs0 efvs2 in + let ctm = list_mk_conj isotms in + let cth1 = ISO_EXPAND_CONV ctm in + let ctm1 = rand(concl cth1) in + let cjs = conjuncts ctm1 in + let eee = map (fun n -> n mod 2 = 0) (0--(length cjs - 1)) in + let cjs1,cjs2 = partition fst (zip eee cjs) in + let ctm2 = mk_conj(list_mk_conj (map snd cjs1), + list_mk_conj (map snd cjs2)) in + let DETRIV_RULE = TRIV_ANTE_RULE o REWRITE_RULE[sth0;sth1] in + let jth0 = + let itha = SPEC_ALL ith0 in + let icjs = conjuncts(rand(concl itha)) in + let cinsts = map + (fun tm -> tryfind (fun vtm -> term_match [] vtm tm) icjs) + (conjuncts (rand ctm2)) in + let tvs = subtract (fst(strip_forall(concl ith0))) + (itlist (fun (_,x,_) -> union (map snd x)) cinsts []) in + let ctvs = + map (fun p -> let x = mk_var("x",hd(snd(dest_type(type_of p)))) in + mk_abs(x,t_tm),p) tvs in + DETRIV_RULE (INST ctvs (itlist INSTANTIATE cinsts itha)) + and jth1 = + let itha = SPEC_ALL ith1 in + let icjs = conjuncts(rand(concl itha)) in + let cinsts = map + (fun tm -> tryfind (fun vtm -> term_match [] vtm tm) icjs) + (conjuncts (lhand ctm2)) in + let tvs = subtract (fst(strip_forall(concl ith1))) + (itlist (fun (_,x,_) -> union (map snd x)) cinsts []) in + let ctvs = + map (fun p -> let x = mk_var("x",hd(snd(dest_type(type_of p)))) in + mk_abs(x,t_tm),p) tvs in + DETRIV_RULE (INST ctvs (itlist INSTANTIATE cinsts itha)) in + let cths4 = map2 CONJ (CONJUNCTS jth0) (CONJUNCTS jth1) in + let cths5 = map (PURE_ONCE_REWRITE_RULE[GSYM ISO]) cths4 in + let cth6 = end_itlist CONJ cths5 in + cth6,CONJ sth0 sth1 in + + (* ----------------------------------------------------------------------- *) + (* Define nested type by doing a 1-level unwinding. *) + (* ----------------------------------------------------------------------- *) + + let SCRUB_ASSUMPTION th = + let hyps = hyp th in + let eqn = find (fun t -> let x = lhs t in + forall (fun u -> not (free_in x (rand u))) hyps) + hyps in + let l,r = dest_eq eqn in + MP (INST [r,l] (DISCH eqn th)) (REFL r) in + + let define_type_basecase def = + let add_id s = fst(dest_var(genvar bool_ty)) in + let def' = map (I F_F (map (add_id F_F I))) def in + define_type_raw def' in + + let SIMPLE_BETA_RULE = GSYM o PURE_REWRITE_RULE[BETA_THM; FUN_EQ_THM] in + let ISO_USAGE_RULE = MATCH_MP ISO_USAGE in + let SIMPLE_ISO_EXPAND_RULE = CONV_RULE(REWR_CONV ISO) in + + let REWRITE_FUN_EQ_RULE = + let ths = itlist (mk_rewrites false) [FUN_EQ_THM] [] in + let net = itlist (net_of_thm false) ths (basic_net()) in + CONV_RULE o GENERAL_REWRITE_CONV true TOP_DEPTH_CONV net in + + let is_nested vs ty = + not (is_vartype ty) & not (intersect (tyvars ty) vs = []) in + let rec modify_type alist ty = + try rev_assoc ty alist + with Failure _ -> try + let tycon,tyargs = dest_type ty in + mk_type(tycon,map (modify_type alist) tyargs) + with Failure _ -> ty in + let modify_item alist (s,l) = + s,map (modify_type alist) l in + let modify_clause alist (l,lis) = + l,map (modify_item alist) lis in + let recover_clause id tm = + let con,args = strip_comb tm in + fst(dest_const con)^id,map type_of args in + let rec create_auxiliary_clauses nty = + let id = fst(dest_var(genvar bool_ty)) in + let tycon,tyargs = dest_type nty in + let k,ith,rth = try assoc tycon (!inductive_type_store) with Failure _ -> + failwith ("Can't find definition for nested type: "^tycon) in + let evs,bod = strip_exists(snd(strip_forall(concl rth))) in + let cjs = map (lhand o snd o strip_forall) (conjuncts bod) in + let rtys = map (hd o snd o dest_type o type_of) evs in + let tyins = tryfind (fun vty -> type_match vty nty []) rtys in + let cjs' = map (inst tyins o rand) (fst(chop_list k cjs)) in + let mtys = itlist (insert o type_of) cjs' [] in + let pcons = map (fun ty -> filter (fun t -> type_of t = ty) cjs') mtys in + let cls' = zip mtys (map (map (recover_clause id)) pcons) in + let tyal = map (fun ty -> mk_vartype(fst(dest_type ty)^id),ty) mtys in + let cls'' = map (modify_type tyal F_F map (modify_item tyal)) cls' in + k,tyal,cls'',INST_TYPE tyins ith,INST_TYPE tyins rth in + let rec define_type_nested def = + let n = length(itlist (@) (map (map fst o snd) def) []) in + let newtys = map fst def in + let utys = unions (itlist (union o map snd o snd) def []) in + let rectys = filter (is_nested newtys) utys in + if rectys = [] then + let th1,th2 = define_type_basecase def in n,th1,th2 else + let nty = hd (sort (fun t1 t2 -> occurs_in t2 t1) rectys) in + let k,tyal,ncls,ith,rth = create_auxiliary_clauses nty in + let cls = map (modify_clause tyal) def @ ncls in + let _,ith1,rth1 = define_type_nested cls in + let xnewtys = map (hd o snd o dest_type o type_of) + (fst(strip_exists(snd(strip_forall(concl rth1))))) in + let xtyal = map (fun ty -> let s = dest_vartype ty in + find (fun t -> fst(dest_type t) = s) xnewtys,ty) + (map fst cls) in + let ith0 = INST_TYPE xtyal ith + and rth0 = INST_TYPE xtyal rth in + let isoth,rclauses = + prove_inductive_types_isomorphic n k (ith0,rth0) (ith1,rth1) in + let irth3 = CONJ ith1 rth1 in + let vtylist = itlist (insert o type_of) (variables(concl irth3)) [] in + let isoths = CONJUNCTS isoth in + let isotys = map (hd o snd o dest_type o type_of o lhand o concl) isoths in + let ctylist = filter + (fun ty -> exists (fun t -> occurs_in t ty) isotys) vtylist in + let atylist = itlist + (union o striplist dest_fun_ty) ctylist [] in + let isoths' = map (lift_type_bijections isoths) + (filter (fun ty -> exists (fun t -> occurs_in t ty) isotys) atylist) in + let cisoths = map (BETA_RULE o lift_type_bijections isoths') + ctylist in + let uisoths = map ISO_USAGE_RULE cisoths in + let visoths = map (ASSUME o concl) uisoths in + let irth4 = itlist PROVE_HYP uisoths (REWRITE_FUN_EQ_RULE visoths irth3) in + let irth5 = REWRITE_RULE + (rclauses :: map SIMPLE_ISO_EXPAND_RULE isoths') irth4 in + let irth6 = repeat SCRUB_ASSUMPTION irth5 in + let ncjs = filter (fun t -> exists (fun v -> not(is_var v)) + (snd(strip_comb(rand(lhs(snd(strip_forall t))))))) + (conjuncts(snd(strip_exists + (snd(strip_forall(rand(concl irth6))))))) in + let mk_newcon tm = + let vs,bod = strip_forall tm in + let rdeb = rand(lhs bod) in + let rdef = list_mk_abs(vs,rdeb) in + let newname = fst(dest_var(genvar bool_ty)) in + let def = mk_eq(mk_var(newname,type_of rdef),rdef) in + let dth = new_definition def in + SIMPLE_BETA_RULE dth in + let dths = map mk_newcon ncjs in + let ith6,rth6 = CONJ_PAIR(PURE_REWRITE_RULE dths irth6) in + n,ith6,rth6 in + fun def -> + let newtys = map fst def in + let truecons = itlist (@) (map (map fst o snd) def) [] in + let (p,ith0,rth0) = define_type_nested def in + let avs,etm = strip_forall(concl rth0) in + let allcls = conjuncts(snd(strip_exists etm)) in + let relcls = fst(chop_list (length truecons) allcls) in + let gencons = + map (repeat rator o rand o lhand o snd o strip_forall) relcls in + let cdefs = + map2 (fun s r -> SYM(new_definition (mk_eq(mk_var(s,type_of r),r)))) + truecons gencons in + let tavs = make_args "f" [] (map type_of avs) in + let ith1 = SUBS cdefs ith0 + and rth1 = GENL tavs (SUBS cdefs (SPECL tavs rth0)) in + let retval = p,ith1,rth1 in + let newentries = map (fun s -> dest_vartype s,retval) newtys in + (inductive_type_store := newentries @ (!inductive_type_store); + do_list extend_rectype_net newentries; ith1,rth1);; + +(* ----------------------------------------------------------------------- *) +(* The overall function, with rather crude string-based benignity. *) +(* ----------------------------------------------------------------------- *) + +let the_inductive_types = ref + ["list = NIL | CONS A list",(list_INDUCT,list_RECURSION); + "option = NONE | SOME A",(option_INDUCT,option_RECURSION); + "sum = INL A | INR B",(sum_INDUCT,sum_RECURSION)];; + +let define_type s = + try let retval = assoc s (!the_inductive_types) in + (warn true "Benign redefinition of inductive type"; retval) + with Failure _ -> + let defspec = parse_inductive_type_specification s in + let newtypes = map fst defspec + and constructors = itlist ((@) o map fst) (map snd defspec) [] in + if not(length(setify newtypes) = length newtypes) + then failwith "define_type: multiple definitions of a type" + else if not(length(setify constructors) = length constructors) + then failwith "define_type: multiple instances of a constructor" + else if exists (can get_type_arity o dest_vartype) newtypes + then let t = find (can get_type_arity) (map dest_vartype newtypes) in + failwith("define_type: type :"^t^" already defined") + else if exists (can get_const_type) constructors + then let t = find (can get_const_type) constructors in + failwith("define_type: constant "^t^" already defined") + else + let retval = define_type_raw defspec in + the_inductive_types := (s,retval)::(!the_inductive_types); retval;; + +(* ------------------------------------------------------------------------- *) +(* Unwinding, and application of patterns. Add easy cases to default net. *) +(* ------------------------------------------------------------------------- *) + +let UNWIND_CONV,MATCH_CONV = + let pth_0 = prove + (`(if ?!x. x = a /\ p then @x. x = a /\ p else @x. F) = + (if p then a else @x. F)`, + BOOL_CASES_TAC `p:bool` THEN ASM_REWRITE_TAC[COND_ID] THEN + MESON_TAC[]) + and pth_1 = prove + (`_MATCH x (_SEQPATTERN r s) = + (if ?y. r x y then _MATCH x r else _MATCH x s) /\ + _FUNCTION (_SEQPATTERN r s) x = + (if ?y. r x y then _FUNCTION r x else _FUNCTION s x)`, + REWRITE_TAC[_MATCH; _SEQPATTERN; _FUNCTION] THEN + MESON_TAC[]) + and pth_2 = prove + (`((?y. _UNGUARDED_PATTERN (GEQ s t) (GEQ u y)) <=> s = t) /\ + ((?y. _GUARDED_PATTERN (GEQ s t) p (GEQ u y)) <=> s = t /\ p)`, + REWRITE_TAC[_UNGUARDED_PATTERN; _GUARDED_PATTERN; GEQ_DEF] THEN + MESON_TAC[]) + and pth_3 = prove + (`(_MATCH x (\y z. P y z) = if ?!z. P x z then @z. P x z else @x. F) /\ + (_FUNCTION (\y z. P y z) x = if ?!z. P x z then @z. P x z else @x. F)`, + REWRITE_TAC[_MATCH; _FUNCTION]) + and pth_4 = prove + (`(_UNGUARDED_PATTERN (GEQ s t) (GEQ u y) <=> y = u /\ s = t) /\ + (_GUARDED_PATTERN (GEQ s t) p (GEQ u y) <=> y = u /\ s = t /\ p)`, + REWRITE_TAC[_UNGUARDED_PATTERN; _GUARDED_PATTERN; GEQ_DEF] THEN + MESON_TAC[]) + and pth_5 = prove + (`(if ?!z. z = k then @z. z = k else @x. F) = k`, + MESON_TAC[]) in + let rec INSIDE_EXISTS_CONV conv tm = + if is_exists tm then BINDER_CONV (INSIDE_EXISTS_CONV conv) tm + else conv tm in + let PUSH_EXISTS_CONV = + let econv = REWR_CONV SWAP_EXISTS_THM in + let rec conv bc tm = + try (econv THENC BINDER_CONV(conv bc)) tm + with Failure _ -> bc tm in + conv in + let BREAK_CONS_CONV = + let conv2 = GEN_REWRITE_CONV DEPTH_CONV [AND_CLAUSES; OR_CLAUSES] THENC + ASSOC_CONV CONJ_ASSOC in + fun tm -> + let conv0 = TOP_SWEEP_CONV(REWRITES_CONV(!basic_rectype_net)) in + let conv1 = if is_conj tm then LAND_CONV conv0 else conv0 in + (conv1 THENC conv2) tm in + let UNWIND_CONV = + let baseconv = GEN_REWRITE_CONV I + [UNWIND_THM1; UNWIND_THM2; + EQT_INTRO(SPEC_ALL EXISTS_REFL); + EQT_INTRO(GSYM(SPEC_ALL EXISTS_REFL))] in + let rec UNWIND_CONV tm = + let evs,bod = strip_exists tm in + let eqs = conjuncts bod in + try let eq = find + (fun tm -> is_eq tm & + let l,r = dest_eq tm in + (mem l evs & not (free_in l r)) or + (mem r evs & not (free_in r l))) eqs in + let l,r = dest_eq eq in + let v = if mem l evs & not (free_in l r) then l else r in + let cjs' = eq::(subtract eqs [eq]) in + let n = length evs - (1 + index v (rev evs)) in + let th1 = CONJ_ACI_RULE(mk_eq(bod,list_mk_conj cjs')) in + let th2 = itlist MK_EXISTS evs th1 in + let th3 = funpow n BINDER_CONV (PUSH_EXISTS_CONV baseconv) + (rand(concl th2)) in + CONV_RULE (RAND_CONV UNWIND_CONV) (TRANS th2 th3) + with Failure _ -> REFL tm in + UNWIND_CONV in + let MATCH_SEQPATTERN_CONV = + GEN_REWRITE_CONV I [pth_1] THENC + RATOR_CONV(LAND_CONV + (BINDER_CONV(RATOR_CONV BETA_CONV THENC BETA_CONV) THENC + PUSH_EXISTS_CONV(GEN_REWRITE_CONV I [pth_2] THENC BREAK_CONS_CONV) THENC + UNWIND_CONV THENC + GEN_REWRITE_CONV DEPTH_CONV + [EQT_INTRO(SPEC_ALL EQ_REFL); AND_CLAUSES] THENC + GEN_REWRITE_CONV DEPTH_CONV [EXISTS_SIMP])) + and MATCH_ONEPATTERN_CONV tm = + let th1 = GEN_REWRITE_CONV I [pth_3] tm in + let tm' = body(rand(lhand(rand(concl th1)))) in + let th2 = (INSIDE_EXISTS_CONV + (GEN_REWRITE_CONV I [pth_4] THENC + RAND_CONV BREAK_CONS_CONV) THENC + UNWIND_CONV THENC + GEN_REWRITE_CONV DEPTH_CONV + [EQT_INTRO(SPEC_ALL EQ_REFL); AND_CLAUSES] THENC + GEN_REWRITE_CONV DEPTH_CONV [EXISTS_SIMP]) + tm' in + let conv tm = if tm = lhand(concl th2) then th2 else fail() in + CONV_RULE + (RAND_CONV (RATOR_CONV + (COMB2_CONV (RAND_CONV (BINDER_CONV conv)) (BINDER_CONV conv)))) + th1 in + let MATCH_SEQPATTERN_CONV_TRIV = + MATCH_SEQPATTERN_CONV THENC + GEN_REWRITE_CONV I [COND_CLAUSES] + and MATCH_SEQPATTERN_CONV_GEN = + MATCH_SEQPATTERN_CONV THENC + GEN_REWRITE_CONV TRY_CONV [COND_CLAUSES] + and MATCH_ONEPATTERN_CONV_TRIV = + MATCH_ONEPATTERN_CONV THENC + GEN_REWRITE_CONV I [pth_5] + and MATCH_ONEPATTERN_CONV_GEN = + MATCH_ONEPATTERN_CONV THENC + GEN_REWRITE_CONV TRY_CONV [pth_0; pth_5] in + do_list extend_basic_convs + ["MATCH_SEQPATTERN_CONV", + (`_MATCH x (_SEQPATTERN r s)`,MATCH_SEQPATTERN_CONV_TRIV); + "FUN_SEQPATTERN_CONV", + (`_FUNCTION (_SEQPATTERN r s) x`,MATCH_SEQPATTERN_CONV_TRIV); + "MATCH_ONEPATTERN_CONV", + (`_MATCH x (\y z. P y z)`,MATCH_ONEPATTERN_CONV_TRIV); + "FUN_ONEPATTERN_CONV", + (`_FUNCTION (\y z. P y z) x`,MATCH_ONEPATTERN_CONV_TRIV)]; + (CHANGED_CONV UNWIND_CONV, + (MATCH_SEQPATTERN_CONV_GEN ORELSEC MATCH_ONEPATTERN_CONV_GEN));; + +let FORALL_UNWIND_CONV = + let PUSH_FORALL_CONV = + let econv = REWR_CONV SWAP_FORALL_THM in + let rec conv bc tm = + try (econv THENC BINDER_CONV(conv bc)) tm + with Failure _ -> bc tm in + conv in + let baseconv = GEN_REWRITE_CONV I + [MESON[] `(!x. x = a /\ p x ==> q x) <=> (p a ==> q a)`; + MESON[] `(!x. a = x /\ p x ==> q x) <=> (p a ==> q a)`; + MESON[] `(!x. x = a ==> q x) <=> q a`; + MESON[] `(!x. a = x ==> q x) <=> q a`] in + let rec FORALL_UNWIND_CONV tm = + try let avs,bod = strip_forall tm in + let ant,con = dest_imp bod in + let eqs = conjuncts ant in + let eq = find (fun tm -> + is_eq tm & + let l,r = dest_eq tm in + (mem l avs & not (free_in l r)) or + (mem r avs & not (free_in r l))) eqs in + let l,r = dest_eq eq in + let v = if mem l avs & not (free_in l r) then l else r in + let cjs' = eq::(subtract eqs [eq]) in + let n = length avs - (1 + index v (rev avs)) in + let th1 = CONJ_ACI_RULE(mk_eq(ant,list_mk_conj cjs')) in + let th2 = AP_THM (AP_TERM (rator(rator bod)) th1) con in + let th3 = itlist MK_FORALL avs th2 in + let th4 = funpow n BINDER_CONV (PUSH_FORALL_CONV baseconv) + (rand(concl th3)) in + CONV_RULE (RAND_CONV FORALL_UNWIND_CONV) (TRANS th3 th4) + with Failure _ -> REFL tm in + FORALL_UNWIND_CONV;; diff --git a/int.ml b/int.ml new file mode 100644 index 0000000..9ab14c9 --- /dev/null +++ b/int.ml @@ -0,0 +1,1446 @@ +(* ========================================================================= *) +(* Theory of integers. *) +(* *) +(* The integers are carved out of the real numbers; hence all the *) +(* universal theorems can be derived trivially from the real analog. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "calc_rat.ml";; + +(* ------------------------------------------------------------------------- *) +(* Representing predicate. The "is_int" variant is useful for backwards *) +(* compatibility with former definition of "is_int" constant, now removed. *) +(* ------------------------------------------------------------------------- *) + +let integer = new_definition + `integer(x) <=> ?n. abs(x) = &n`;; + +let is_int = prove + (`integer(x) <=> ?n. x = &n \/ x = -- &n`, + REWRITE_TAC[integer] THEN AP_TERM_TAC THEN ABS_TAC THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Type of integers. *) +(* ------------------------------------------------------------------------- *) + +let int_tybij = new_type_definition "int" ("int_of_real","real_of_int") + (prove(`?x. integer x`, + EXISTS_TAC `&0` THEN + REWRITE_TAC[is_int; REAL_OF_NUM_EQ; EXISTS_OR_THM; GSYM EXISTS_REFL]));; + +let int_abstr,int_rep = + SPEC_ALL(CONJUNCT1 int_tybij),SPEC_ALL(CONJUNCT2 int_tybij);; + +let dest_int_rep = prove + (`!i. ?n. (real_of_int i = &n) \/ (real_of_int i = --(&n))`, + REWRITE_TAC[GSYM is_int; int_rep; int_abstr]);; + +(* ------------------------------------------------------------------------- *) +(* We want the following too. *) +(* ------------------------------------------------------------------------- *) + +let int_eq = prove + (`!x y. (x = y) <=> (real_of_int x = real_of_int y)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o AP_TERM `int_of_real`) THEN + REWRITE_TAC[int_abstr]);; + +(* ------------------------------------------------------------------------- *) +(* Set up interface map. *) +(* ------------------------------------------------------------------------- *) + +do_list overload_interface + ["+",`int_add:int->int->int`; "-",`int_sub:int->int->int`; + "*",`int_mul:int->int->int`; "<",`int_lt:int->int->bool`; + "<=",`int_le:int->int->bool`; ">",`int_gt:int->int->bool`; + ">=",`int_ge:int->int->bool`; "--",`int_neg:int->int`; + "pow",`int_pow:int->num->int`; "abs",`int_abs:int->int`; + "max",`int_max:int->int->int`; "min",`int_min:int->int->int`; + "&",`int_of_num:num->int`];; + +let prioritize_int() = prioritize_overload(mk_type("int",[]));; + +(* ------------------------------------------------------------------------- *) +(* Definitions and closure derivations of all operations but "inv" and "/". *) +(* ------------------------------------------------------------------------- *) + +let int_le = new_definition + `x <= y <=> (real_of_int x) <= (real_of_int y)`;; + +let int_lt = new_definition + `x < y <=> (real_of_int x) < (real_of_int y)`;; + +let int_ge = new_definition + `x >= y <=> (real_of_int x) >= (real_of_int y)`;; + +let int_gt = new_definition + `x > y <=> (real_of_int x) > (real_of_int y)`;; + +let int_of_num = new_definition + `&n = int_of_real(real_of_num n)`;; + +let int_of_num_th = prove + (`!n. real_of_int(int_of_num n) = real_of_num n`, + REWRITE_TAC[int_of_num; GSYM int_rep; is_int] THEN + REWRITE_TAC[REAL_OF_NUM_EQ; EXISTS_OR_THM; GSYM EXISTS_REFL]);; + +let int_neg = new_definition + `--i = int_of_real(--(real_of_int i))`;; + +let int_neg_th = prove + (`!x. real_of_int(int_neg x) = --(real_of_int x)`, + REWRITE_TAC[int_neg; GSYM int_rep; is_int] THEN + GEN_TAC THEN STRIP_ASSUME_TAC(SPEC `x:int` dest_int_rep) THEN + ASM_REWRITE_TAC[REAL_NEG_NEG; EXISTS_OR_THM; REAL_EQ_NEG2; + REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; + +let int_add = new_definition + `x + y = int_of_real((real_of_int x) + (real_of_int y))`;; + +let int_add_th = prove + (`!x y. real_of_int(x + y) = (real_of_int x) + (real_of_int y)`, + REWRITE_TAC[int_add; GSYM int_rep; is_int] THEN REPEAT GEN_TAC THEN + X_CHOOSE_THEN `m:num` DISJ_CASES_TAC (SPEC `x:int` dest_int_rep) THEN + X_CHOOSE_THEN `n:num` DISJ_CASES_TAC (SPEC `y:int` dest_int_rep) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; EXISTS_OR_THM] THEN + REWRITE_TAC[GSYM EXISTS_REFL] THEN + DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN + REWRITE_TAC[LE_EXISTS] THEN DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; OR_EXISTS_THM; REAL_NEG_ADD] THEN + TRY(EXISTS_TAC `d:num` THEN REAL_ARITH_TAC) THEN + REWRITE_TAC[EXISTS_OR_THM; GSYM REAL_NEG_ADD; REAL_EQ_NEG2; + REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; + +let int_sub = new_definition + `x - y = int_of_real(real_of_int x - real_of_int y)`;; + +let int_sub_th = prove + (`!x y. real_of_int(x - y) = (real_of_int x) - (real_of_int y)`, + REWRITE_TAC[int_sub; real_sub; GSYM int_neg_th; GSYM int_add_th] THEN + REWRITE_TAC[int_abstr]);; + +let int_mul = new_definition + `x * y = int_of_real ((real_of_int x) * (real_of_int y))`;; + +let int_mul_th = prove + (`!x y. real_of_int(x * y) = (real_of_int x) * (real_of_int y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[int_mul; GSYM int_rep; is_int] THEN + X_CHOOSE_THEN `m:num` DISJ_CASES_TAC (SPEC `x:int` dest_int_rep) THEN + X_CHOOSE_THEN `n:num` DISJ_CASES_TAC (SPEC `y:int` dest_int_rep) THEN + ASM_REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_EQ; EXISTS_OR_THM] THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG; REAL_OF_NUM_MUL] THEN + REWRITE_TAC[REAL_EQ_NEG2; REAL_OF_NUM_EQ; GSYM EXISTS_REFL]);; + +let int_abs = new_definition + `abs x = int_of_real(abs(real_of_int x))`;; + +let int_abs_th = prove + (`!x. real_of_int(abs x) = abs(real_of_int x)`, + GEN_TAC THEN REWRITE_TAC[int_abs; real_abs] THEN COND_CASES_TAC THEN + REWRITE_TAC[GSYM int_neg; int_neg_th; int_abstr]);; + +let int_sgn = new_definition + `int_sgn x = int_of_real(real_sgn(real_of_int x))`;; + +let int_sgn_th = prove + (`!x. real_of_int(int_sgn x) = real_sgn(real_of_int x)`, + GEN_TAC THEN REWRITE_TAC[int_sgn; real_sgn; GSYM int_rep] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + MESON_TAC[is_int]);; + +let int_max = new_definition + `int_max x y = int_of_real(max (real_of_int x) (real_of_int y))`;; + +let int_max_th = prove + (`!x y. real_of_int(max x y) = max (real_of_int x) (real_of_int y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[int_max; real_max] THEN + COND_CASES_TAC THEN REWRITE_TAC[int_abstr]);; + +let int_min = new_definition + `int_min x y = int_of_real(min (real_of_int x) (real_of_int y))`;; + +let int_min_th = prove + (`!x y. real_of_int(min x y) = min (real_of_int x) (real_of_int y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[int_min; real_min] THEN + COND_CASES_TAC THEN REWRITE_TAC[int_abstr]);; + +let int_pow = new_definition + `x pow n = int_of_real((real_of_int x) pow n)`;; + +let int_pow_th = prove + (`!x n. real_of_int(x pow n) = (real_of_int x) pow n`, + GEN_TAC THEN REWRITE_TAC[int_pow] THEN INDUCT_TAC THEN + REWRITE_TAC[real_pow] THENL + [REWRITE_TAC[GSYM int_of_num; int_of_num_th]; + POP_ASSUM(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[GSYM int_mul; int_mul_th]]);; + +(* ------------------------------------------------------------------------- *) +(* A couple of theorems peculiar to the integers. *) +(* ------------------------------------------------------------------------- *) + +let INT_IMAGE = prove + (`!x. (?n. x = &n) \/ (?n. x = --(&n))`, + GEN_TAC THEN + X_CHOOSE_THEN `n:num` DISJ_CASES_TAC (SPEC `x:int` dest_int_rep) THEN + POP_ASSUM(MP_TAC o AP_TERM `int_of_real`) THEN REWRITE_TAC[int_abstr] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[int_of_num; int_neg] THENL + [DISJ1_TAC; DISJ2_TAC] THEN + EXISTS_TAC `n:num` THEN REWRITE_TAC[int_abstr] THEN + REWRITE_TAC[GSYM int_of_num; int_of_num_th]);; + +let INT_LT_DISCRETE = prove + (`!x y. x < y <=> (x + &1) <= y`, + REPEAT GEN_TAC THEN + REWRITE_TAC[int_le; int_lt; int_add_th] THEN + DISJ_CASES_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC ) + (SPEC `x:int` INT_IMAGE) THEN + DISJ_CASES_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC ) + (SPEC `y:int` INT_IMAGE) THEN + REWRITE_TAC[int_neg_th; int_of_num_th] THEN + REWRITE_TAC[REAL_LE_NEG2; REAL_LT_NEG2] THEN + REWRITE_TAC[REAL_LE_LNEG; REAL_LT_LNEG; REAL_LE_RNEG; REAL_LT_RNEG] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[GSYM real_sub; REAL_LE_SUB_RADD] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[GSYM ADD1; ONCE_REWRITE_RULE[ADD_SYM] (GSYM ADD1)] THEN + REWRITE_TAC[SYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN + REWRITE_TAC[ADD_CLAUSES; LE_SUC_LT; LT_SUC_LE]);; + +let INT_GT_DISCRETE = prove + (`!x y. x > y <=> x >= (y + &1)`, + REWRITE_TAC[int_gt; int_ge; real_ge; real_gt; GSYM int_le; GSYM int_lt] THEN + MATCH_ACCEPT_TAC INT_LT_DISCRETE);; + +(* ------------------------------------------------------------------------- *) +(* Conversions of integer constants to and from OCaml numbers. *) +(* ------------------------------------------------------------------------- *) + +let is_intconst tm = + match tm with + Comb(Const("int_of_num",_),n) -> is_numeral n + | Comb(Const("int_neg",_),Comb(Const("int_of_num",_),n)) -> + is_numeral n & not(dest_numeral n = num_0) + | _ -> false;; + +let dest_intconst tm = + match tm with + Comb(Const("int_of_num",_),n) -> dest_numeral n + | Comb(Const("int_neg",_),Comb(Const("int_of_num",_),n)) -> + let nn = dest_numeral n in + if nn <>/ num_0 then minus_num(dest_numeral n) + else failwith "dest_intconst" + | _ -> failwith "dest_intconst";; + +let mk_intconst = + let cast_tm = `int_of_num` and neg_tm = `int_neg` in + let mk_numconst n = mk_comb(cast_tm,mk_numeral n) in + fun x -> if x (!i:int. &0 <= i ==> P(i))`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THENL + [DISJ_CASES_THEN (CHOOSE_THEN SUBST1_TAC) (SPEC `i:int` INT_IMAGE) THEN + ASM_REWRITE_TAC[INT_LE_RNEG; INT_ADD_LID; INT_OF_NUM_LE; LE] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[INT_NEG_0]; + FIRST_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[INT_OF_NUM_LE; LE_0]]);; + +let INT_EXISTS_POS = prove + (`!P. (?n. P(&n)) <=> (?i:int. &0 <= i /\ P(i))`, + GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN + REWRITE_TAC[NOT_EXISTS_THM; INT_FORALL_POS] THEN MESON_TAC[]);; + +let INT_FORALL_ABS = prove + (`!P. (!n. P(&n)) <=> (!x:int. P(abs x))`, + REWRITE_TAC[INT_FORALL_POS] THEN MESON_TAC[INT_ABS_POS; INT_ABS_REFL]);; + +let INT_EXISTS_ABS = prove + (`!P. (?n. P(&n)) <=> (?x:int. P(abs x))`, + GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `(p <=> q) <=> (~p <=> ~q)`] THEN + REWRITE_TAC[NOT_EXISTS_THM; INT_FORALL_ABS] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Sometimes handy in number-theoretic applications. *) +(* ------------------------------------------------------------------------- *) + +let INT_ABS_MUL_1 = prove + (`!x y. (abs(x * y) = &1) <=> (abs(x) = &1) /\ (abs(y) = &1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[INT_ABS_MUL] THEN + MP_TAC(SPEC `y:int` INT_ABS_POS) THEN SPEC_TAC(`abs(y)`,`b:int`) THEN + MP_TAC(SPEC `x:int` INT_ABS_POS) THEN SPEC_TAC(`abs(x)`,`a:int`) THEN + REWRITE_TAC[GSYM INT_FORALL_POS; INT_OF_NUM_MUL; INT_OF_NUM_EQ; MULT_EQ_1]);; + +let INT_WOP = prove + (`(?x. &0 <= x /\ P x) <=> + (?x. &0 <= x /\ P x /\ !y. &0 <= y /\ P y ==> x <= y)`, + ONCE_REWRITE_TAC[MESON[] `(?x. P x /\ Q x) <=> ~(!x. P x ==> ~Q x)`] THEN + REWRITE_TAC[IMP_CONJ; GSYM INT_FORALL_POS; INT_OF_NUM_LE] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN + REWRITE_TAC[GSYM NOT_LE; CONTRAPOS_THM]);; + +(* ------------------------------------------------------------------------- *) +(* A few "pseudo definitions". *) +(* ------------------------------------------------------------------------- *) + +let INT_POW = prove + (`(x pow 0 = &1) /\ + (!n. x pow (SUC n) = x * x pow n)`, + REWRITE_TAC(map INT_OF_REAL_THM (CONJUNCTS real_pow)));; + +let INT_ABS = prove + (`!x. abs(x) = if &0 <= x then x else --x`, + GEN_TAC THEN MP_TAC(INT_OF_REAL_THM(SPEC `x:real` real_abs)) THEN + COND_CASES_TAC THEN REWRITE_TAC[int_eq]);; + +let INT_GE = prove + (`!x y. x >= y <=> y <= x`, + REWRITE_TAC[int_ge; int_le; real_ge]);; + +let INT_GT = prove + (`!x y. x > y <=> y < x`, + REWRITE_TAC[int_gt; int_lt; real_gt]);; + +let INT_LT = prove + (`!x y. x < y <=> ~(y <= x)`, + REWRITE_TAC[int_lt; int_le; real_lt]);; + +(* ------------------------------------------------------------------------- *) +(* Now a decision procedure for the integers. *) +(* ------------------------------------------------------------------------- *) + +let INT_ARITH = + let atom_CONV = + let pth = prove + (`(~(x <= y) <=> y + &1 <= x) /\ + (~(x < y) <=> y <= x) /\ + (~(x = y) <=> x + &1 <= y \/ y + &1 <= x) /\ + (x < y <=> x + &1 <= y)`, + REWRITE_TAC[INT_NOT_LE; INT_NOT_LT; INT_NOT_EQ; INT_LT_DISCRETE]) in + GEN_REWRITE_CONV I [pth] + and bub_CONV = GEN_REWRITE_CONV TOP_SWEEP_CONV + [int_eq; int_le; int_lt; int_ge; int_gt; + int_of_num_th; int_neg_th; int_add_th; int_mul_th; + int_sub_th; int_pow_th; int_abs_th; int_max_th; int_min_th] in + let base_CONV = TRY_CONV atom_CONV THENC bub_CONV in + let NNF_NORM_CONV = GEN_NNF_CONV false + (base_CONV,fun t -> base_CONV t,base_CONV(mk_neg t)) in + let init_CONV = + TOP_DEPTH_CONV BETA_CONV THENC + PRESIMP_CONV THENC + GEN_REWRITE_CONV DEPTH_CONV [INT_GT; INT_GE] THENC + NNF_CONV THENC DEPTH_BINOP_CONV `(\/)` CONDS_ELIM_CONV THENC + NNF_NORM_CONV in + let p_tm = `p:bool` + and not_tm = `(~)` in + let pth = TAUT(mk_eq(mk_neg(mk_neg p_tm),p_tm)) in + fun tm -> + let th0 = INST [tm,p_tm] pth + and th1 = init_CONV (mk_neg tm) in + let th2 = REAL_ARITH(mk_neg(rand(concl th1))) in + EQ_MP th0 (EQ_MP (AP_TERM not_tm (SYM th1)) th2);; + +let INT_ARITH_TAC = CONV_TAC(EQT_INTRO o INT_ARITH);; + +let ASM_INT_ARITH_TAC = + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN + INT_ARITH_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Some pseudo-definitions. *) +(* ------------------------------------------------------------------------- *) + +let INT_SUB = INT_ARITH `!x y. x - y = x + --y`;; + +let INT_MAX = INT_ARITH `!x y. max x y = if x <= y then y else x`;; + +let INT_MIN = INT_ARITH `!x y. min x y = if x <= y then x else y`;; + +(* ------------------------------------------------------------------------- *) +(* Additional useful lemmas. *) +(* ------------------------------------------------------------------------- *) + +let INT_OF_NUM_EXISTS = prove + (`!x:int. (?n. x = &n) <=> &0 <= x`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[INT_POS] THEN + MP_TAC(ISPEC `x:int` INT_IMAGE) THEN + REWRITE_TAC[OR_EXISTS_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_INT_ARITH_TAC);; + +let INT_LE_DISCRETE = INT_ARITH `!x y:int. x <= y <=> x < y + &1`;; + +(* ------------------------------------------------------------------------- *) +(* Archimedian property for the integers. *) +(* ------------------------------------------------------------------------- *) + +let INT_ARCH = prove + (`!x d. ~(d = &0) ==> ?c. x < c * d`, + SUBGOAL_THEN `!x. &0 <= x ==> ?n. x <= &n` ASSUME_TAC THENL + [REWRITE_TAC[GSYM INT_FORALL_POS; INT_OF_NUM_LE] THEN MESON_TAC[LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `!x. ?n. x <= &n` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_LE_TOTAL]; ALL_TAC] THEN + SUBGOAL_THEN `!x d. &0 < d ==> ?c. x < c * d` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[INT_LT_DISCRETE; INT_ADD_LID] THEN + ASM_MESON_TAC[INT_POS; INT_LE_LMUL; INT_ARITH + `x + &1 <= &n /\ &n * &1 <= &n * d ==> x + &1 <= &n * d`]; + ALL_TAC] THEN + SUBGOAL_THEN `!x d. ~(d = &0) ==> ?c. x < c * d` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH `--x * y = x * --y`; + INT_ARITH `~(d = &0) ==> &0 < d \/ &0 < --d`]; + ALL_TAC] THEN + ASM_MESON_TAC[INT_ARITH `--x * y = x * --y`; + INT_ARITH `~(d = &0) ==> &0 < d \/ &0 < --d`]);; + +(* ------------------------------------------------------------------------- *) +(* Definitions of ("Euclidean") integer division and remainder. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVMOD_EXIST_0 = prove + (`!m n:int. ?q r. if n = &0 then q = &0 /\ r = m + else &0 <= r /\ r < abs(n) /\ m = q * n + r`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = &0` THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM; EXISTS_REFL] THEN + GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN + SUBGOAL_THEN `?r. &0 <= r /\ ?q:int. m = n * q + r` MP_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `--m:int` o MATCH_MP INT_ARCH) THEN + DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN + EXISTS_TAC `m + s * n:int` THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; EXISTS_TAC `--s:int` THEN INT_ARITH_TAC]; + GEN_REWRITE_TAC LAND_CONV [INT_WOP] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:int` THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:int` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `r - abs n`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `if &0 <= n then q + &1 else q - &1`) THEN + ASM_INT_ARITH_TAC]);; + +parse_as_infix("div",(22,"left"));; +parse_as_infix("rem",(22,"left"));; + +let INT_DIVISION_0 = new_specification ["div"; "rem"] + (REWRITE_RULE[SKOLEM_THM] INT_DIVMOD_EXIST_0);; + +let INT_DIVISION = prove + (`!m n. ~(n = &0) + ==> m = m div n * n + m rem n /\ &0 <= m rem n /\ m rem n < abs n`, + MESON_TAC[INT_DIVISION_0]);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations on integers. Essentially a clone of stuff for reals *) +(* in the file "calc_int.ml", except for div and rem, which are more like N. *) +(* ------------------------------------------------------------------------- *) + +let INT_LE_CONV,INT_LT_CONV,INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV = + let tth = + TAUT `(F /\ F <=> F) /\ (F /\ T <=> F) /\ + (T /\ F <=> F) /\ (T /\ T <=> T)` in + let nth = TAUT `(~T <=> F) /\ (~F <=> T)` in + let NUM2_EQ_CONV = BINOP_CONV NUM_EQ_CONV THENC GEN_REWRITE_CONV I [tth] in + let NUM2_NE_CONV = + RAND_CONV NUM2_EQ_CONV THENC + GEN_REWRITE_CONV I [nth] in + let [pth_le1; pth_le2a; pth_le2b; pth_le3] = (CONJUNCTS o prove) + (`(--(&m) <= &n <=> T) /\ + (&m <= &n <=> m <= n) /\ + (--(&m) <= --(&n) <=> n <= m) /\ + (&m <= --(&n) <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[INT_LE_NEG2] THEN + REWRITE_TAC[INT_LE_LNEG; INT_LE_RNEG] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_LE; LE_0] THEN + REWRITE_TAC[LE; ADD_EQ_0]) in + let INT_LE_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_le1]; + GEN_REWRITE_CONV I [pth_le2a; pth_le2b] THENC NUM_LE_CONV; + GEN_REWRITE_CONV I [pth_le3] THENC NUM2_EQ_CONV] in + let [pth_lt1; pth_lt2a; pth_lt2b; pth_lt3] = (CONJUNCTS o prove) + (`(&m < --(&n) <=> F) /\ + (&m < &n <=> m < n) /\ + (--(&m) < --(&n) <=> n < m) /\ + (--(&m) < &n <=> ~((m = 0) /\ (n = 0)))`, + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; + GSYM NOT_LE; INT_LT] THEN + CONV_TAC TAUT) in + let INT_LT_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_lt1]; + GEN_REWRITE_CONV I [pth_lt2a; pth_lt2b] THENC NUM_LT_CONV; + GEN_REWRITE_CONV I [pth_lt3] THENC NUM2_NE_CONV] in + let [pth_ge1; pth_ge2a; pth_ge2b; pth_ge3] = (CONJUNCTS o prove) + (`(&m >= --(&n) <=> T) /\ + (&m >= &n <=> n <= m) /\ + (--(&m) >= --(&n) <=> m <= n) /\ + (--(&m) >= &n <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; INT_GE] THEN + CONV_TAC TAUT) in + let INT_GE_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_ge1]; + GEN_REWRITE_CONV I [pth_ge2a; pth_ge2b] THENC NUM_LE_CONV; + GEN_REWRITE_CONV I [pth_ge3] THENC NUM2_EQ_CONV] in + let [pth_gt1; pth_gt2a; pth_gt2b; pth_gt3] = (CONJUNCTS o prove) + (`(--(&m) > &n <=> F) /\ + (&m > &n <=> n < m) /\ + (--(&m) > --(&n) <=> m < n) /\ + (&m > --(&n) <=> ~((m = 0) /\ (n = 0)))`, + REWRITE_TAC[pth_lt1; pth_lt2a; pth_lt2b; pth_lt3; INT_GT] THEN + CONV_TAC TAUT) in + let INT_GT_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_gt1]; + GEN_REWRITE_CONV I [pth_gt2a; pth_gt2b] THENC NUM_LT_CONV; + GEN_REWRITE_CONV I [pth_gt3] THENC NUM2_NE_CONV] in + let [pth_eq1a; pth_eq1b; pth_eq2a; pth_eq2b] = (CONJUNCTS o prove) + (`((&m = &n) <=> (m = n)) /\ + ((--(&m) = --(&n)) <=> (m = n)) /\ + ((--(&m) = &n) <=> (m = 0) /\ (n = 0)) /\ + ((&m = --(&n)) <=> (m = 0) /\ (n = 0))`, + REWRITE_TAC[GSYM INT_LE_ANTISYM; GSYM LE_ANTISYM] THEN + REWRITE_TAC[pth_le1; pth_le2a; pth_le2b; pth_le3; LE; LE_0] THEN + CONV_TAC TAUT) in + let INT_EQ_CONV = FIRST_CONV + [GEN_REWRITE_CONV I [pth_eq1a; pth_eq1b] THENC NUM_EQ_CONV; + GEN_REWRITE_CONV I [pth_eq2a; pth_eq2b] THENC NUM2_EQ_CONV] in + INT_LE_CONV,INT_LT_CONV, + INT_GE_CONV,INT_GT_CONV,INT_EQ_CONV;; + +let INT_NEG_CONV = + let pth = prove + (`(--(&0) = &0) /\ + (--(--(&x)) = &x)`, + REWRITE_TAC[INT_NEG_NEG; INT_NEG_0]) in + GEN_REWRITE_CONV I [pth];; + +let INT_MUL_CONV = + let pth0 = prove + (`(&0 * &x = &0) /\ + (&0 * --(&x) = &0) /\ + (&x * &0 = &0) /\ + (--(&x) * &0 = &0)`, + REWRITE_TAC[INT_MUL_LZERO; INT_MUL_RZERO]) + and pth1,pth2 = (CONJ_PAIR o prove) + (`((&m * &n = &(m * n)) /\ + (--(&m) * --(&n) = &(m * n))) /\ + ((--(&m) * &n = --(&(m * n))) /\ + (&m * --(&n) = --(&(m * n))))`, + REWRITE_TAC[INT_MUL_LNEG; INT_MUL_RNEG; INT_NEG_NEG] THEN + REWRITE_TAC[INT_OF_NUM_MUL]) in + FIRST_CONV + [GEN_REWRITE_CONV I [pth0]; + GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_MULT_CONV; + GEN_REWRITE_CONV I [pth2] THENC RAND_CONV(RAND_CONV NUM_MULT_CONV)];; + +let INT_ADD_CONV = + let neg_tm = `(--)` in + let amp_tm = `&` in + let add_tm = `(+)` in + let dest = dest_binop `(+)` in + let m_tm = `m:num` and n_tm = `n:num` in + let pth0 = prove + (`(--(&m) + &m = &0) /\ + (&m + --(&m) = &0)`, + REWRITE_TAC[INT_ADD_LINV; INT_ADD_RINV]) in + let [pth1; pth2; pth3; pth4; pth5; pth6] = (CONJUNCTS o prove) + (`(--(&m) + --(&n) = --(&(m + n))) /\ + (--(&m) + &(m + n) = &n) /\ + (--(&(m + n)) + &m = --(&n)) /\ + (&(m + n) + --(&m) = &n) /\ + (&m + --(&(m + n)) = --(&n)) /\ + (&m + &n = &(m + n))`, + REWRITE_TAC[GSYM INT_OF_NUM_ADD; INT_NEG_ADD] THEN + REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN + REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID] THEN + ONCE_REWRITE_TAC[INT_ADD_SYM] THEN + REWRITE_TAC[INT_ADD_ASSOC; INT_ADD_LINV; INT_ADD_LID] THEN + REWRITE_TAC[INT_ADD_RINV; INT_ADD_LID]) in + GEN_REWRITE_CONV I [pth0] ORELSEC + (fun tm -> + try let l,r = dest tm in + if rator l = neg_tm then + if rator r = neg_tm then + let th1 = INST [rand(rand l),m_tm; rand(rand r),n_tm] pth1 in + let tm1 = rand(rand(rand(concl th1))) in + let th2 = AP_TERM neg_tm (AP_TERM amp_tm (NUM_ADD_CONV tm1)) in + TRANS th1 th2 + else + let m = rand(rand l) and n = rand r in + let m' = dest_numeral m and n' = dest_numeral n in + if m' <=/ n' then + let p = mk_numeral (n' -/ m') in + let th1 = INST [m,m_tm; p,n_tm] pth2 in + let th2 = NUM_ADD_CONV (rand(rand(lhand(concl th1)))) in + let th3 = AP_TERM (rator tm) (AP_TERM amp_tm (SYM th2)) in + TRANS th3 th1 + else + let p = mk_numeral (m' -/ n') in + let th1 = INST [n,m_tm; p,n_tm] pth3 in + let th2 = NUM_ADD_CONV (rand(rand(lhand(lhand(concl th1))))) in + let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_THM (AP_TERM add_tm th3) (rand tm) in + TRANS th4 th1 + else + if rator r = neg_tm then + let m = rand l and n = rand(rand r) in + let m' = dest_numeral m and n' = dest_numeral n in + if n' <=/ m' then + let p = mk_numeral (m' -/ n') in + let th1 = INST [n,m_tm; p,n_tm] pth4 in + let th2 = NUM_ADD_CONV (rand(lhand(lhand(concl th1)))) in + let th3 = AP_TERM add_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_THM th3 (rand tm) in + TRANS th4 th1 + else + let p = mk_numeral (n' -/ m') in + let th1 = INST [m,m_tm; p,n_tm] pth5 in + let th2 = NUM_ADD_CONV (rand(rand(rand(lhand(concl th1))))) in + let th3 = AP_TERM neg_tm (AP_TERM amp_tm (SYM th2)) in + let th4 = AP_TERM (rator tm) th3 in + TRANS th4 th1 + else + let th1 = INST [rand l,m_tm; rand r,n_tm] pth6 in + let tm1 = rand(rand(concl th1)) in + let th2 = AP_TERM amp_tm (NUM_ADD_CONV tm1) in + TRANS th1 th2 + with Failure _ -> failwith "INT_ADD_CONV");; + +let INT_SUB_CONV = + GEN_REWRITE_CONV I [INT_SUB] THENC + TRY_CONV(RAND_CONV INT_NEG_CONV) THENC + INT_ADD_CONV;; + +let INT_POW_CONV = + let pth1,pth2 = (CONJ_PAIR o prove) + (`(&x pow n = &(x EXP n)) /\ + ((--(&x)) pow n = if EVEN n then &(x EXP n) else --(&(x EXP n)))`, + REWRITE_TAC[INT_OF_NUM_POW; INT_POW_NEG]) in + let tth = prove + (`((if T then x:int else y) = x) /\ ((if F then x:int else y) = y)`, + REWRITE_TAC[]) in + let neg_tm = `(--)` in + (GEN_REWRITE_CONV I [pth1] THENC RAND_CONV NUM_EXP_CONV) ORELSEC + (GEN_REWRITE_CONV I [pth2] THENC + RATOR_CONV(RATOR_CONV(RAND_CONV NUM_EVEN_CONV)) THENC + GEN_REWRITE_CONV I [tth] THENC + (fun tm -> if rator tm = neg_tm then RAND_CONV(RAND_CONV NUM_EXP_CONV) tm + else RAND_CONV NUM_EXP_CONV tm));; + +let INT_ABS_CONV = + let pth = prove + (`(abs(--(&x)) = &x) /\ + (abs(&x) = &x)`, + REWRITE_TAC[INT_ABS_NEG; INT_ABS_NUM]) in + GEN_REWRITE_CONV I [pth];; + +let INT_MAX_CONV = + REWR_CONV INT_MAX THENC + RATOR_CONV(RATOR_CONV(RAND_CONV INT_LE_CONV)) THENC + GEN_REWRITE_CONV I [COND_CLAUSES];; + +let INT_MIN_CONV = + REWR_CONV INT_MIN THENC + RATOR_CONV(RATOR_CONV(RAND_CONV INT_LE_CONV)) THENC + GEN_REWRITE_CONV I [COND_CLAUSES];; + +(* ------------------------------------------------------------------------- *) +(* Instantiate the normalizer. *) +(* ------------------------------------------------------------------------- *) + +let INT_POLY_CONV = + let sth = prove + (`(!x y z. x + (y + z) = (x + y) + z) /\ + (!x y. x + y = y + x) /\ + (!x. &0 + x = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x y. x * y = y * x) /\ + (!x. &1 * x = x) /\ + (!x. &0 * x = &0) /\ + (!x y z. x * (y + z) = x * y + x * z) /\ + (!x. x pow 0 = &1) /\ + (!x n. x pow (SUC n) = x * x pow n)`, + REWRITE_TAC[INT_POW] THEN INT_ARITH_TAC) + and rth = prove + (`(!x. --x = --(&1) * x) /\ + (!x y. x - y = x + --(&1) * y)`, + INT_ARITH_TAC) + and is_semiring_constant = is_intconst + and SEMIRING_ADD_CONV = INT_ADD_CONV + and SEMIRING_MUL_CONV = INT_MUL_CONV + and SEMIRING_POW_CONV = INT_POW_CONV in + let _,_,_,_,_,INT_POLY_CONV = + SEMIRING_NORMALIZERS_CONV sth rth + (is_semiring_constant, + SEMIRING_ADD_CONV,SEMIRING_MUL_CONV,SEMIRING_POW_CONV) + (<) in + INT_POLY_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Instantiate the ring and ideal procedures. *) +(* ------------------------------------------------------------------------- *) + +let INT_RING,int_ideal_cofactors = + let INT_INTEGRAL = prove + (`(!x. &0 * x = &0) /\ + (!x y z. (x + y = x + z) <=> (y = z)) /\ + (!w x y z. (w * y + x * z = w * z + x * y) <=> (w = x) \/ (y = z))`, + REWRITE_TAC[MULT_CLAUSES; EQ_ADD_LCANCEL] THEN + REWRITE_TAC[GSYM INT_OF_NUM_EQ; + GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[GSYM INT_SUB_0] THEN + REWRITE_TAC[GSYM INT_ENTIRE] THEN INT_ARITH_TAC) + and int_ty = `:int` in + let pure,ideal = + RING_AND_IDEAL_CONV + (dest_intconst,mk_intconst,INT_EQ_CONV, + `(--):int->int`,`(+):int->int->int`,`(-):int->int->int`, + genvar bool_ty,`(*):int->int->int`,genvar bool_ty, + `(pow):int->num->int`, + INT_INTEGRAL,TRUTH,INT_POLY_CONV) in + pure, + (fun tms tm -> if forall (fun t -> type_of t = int_ty) (tm::tms) + then ideal tms tm + else failwith + "int_ideal_cofactors: not all terms have type :int");; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic operations also on div and rem, hence the whole lot. *) +(* ------------------------------------------------------------------------- *) + +let INT_DIVMOD_UNIQ = prove + (`!m n q r:int. m = q * n + r /\ &0 <= r /\ r < abs n + ==> m div n = q /\ m rem n = r`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `~(n = &0)` MP_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(STRIP_ASSUME_TAC o SPEC `m:int` o MATCH_MP INT_DIVISION) THEN + ASM_CASES_TAC `m div n = q` THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC INT_RING; ALL_TAC] THEN + SUBGOAL_THEN `abs(m rem n - r) < abs n` MP_TAC THENL + [ASM_INT_ARITH_TAC; MATCH_MP_TAC(TAUT `~p ==> p ==> q`)] THEN + MATCH_MP_TAC(INT_ARITH + `&1 * abs n <= abs(q - m div n) * abs n /\ + abs(m rem n - r) = abs((q - m div n) * n) + ==> ~(abs(m rem n - r) < abs n)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_RMUL THEN ASM_INT_ARITH_TAC; + AP_TERM_TAC THEN REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC INT_RING]);; + +let INT_DIV_CONV,INT_REM_CONV = + let pth = prove + (`q * n + r = m ==> &0 <= r ==> r < abs n ==> m div n = q /\ m rem n = r`, + MESON_TAC[INT_DIVMOD_UNIQ]) + and m = `m:int` and n = `n:int` and q = `q:int` and r = `r:int` + and dtm = `(div)` and mtm = `(rem)` in + let emod_num x y = + let r = mod_num x y in + if r try let l,r = dest_binop dtm tm in + CONJUNCT1(INT_DIVMOD_CONV (dest_intconst l) (dest_intconst r)) + with Failure _ -> failwith "INT_DIV_CONV"), + (fun tm -> try let l,r = dest_binop mtm tm in + CONJUNCT2(INT_DIVMOD_CONV (dest_intconst l) (dest_intconst r)) + with Failure _ -> failwith "INT_MOD_CONV");; + +let INT_RED_CONV = + let gconv_net = itlist (uncurry net_of_conv) + [`x <= y`,INT_LE_CONV; + `x < y`,INT_LT_CONV; + `x >= y`,INT_GE_CONV; + `x > y`,INT_GT_CONV; + `x:int = y`,INT_EQ_CONV; + `--x`,CHANGED_CONV INT_NEG_CONV; + `abs(x)`,INT_ABS_CONV; + `x + y`,INT_ADD_CONV; + `x - y`,INT_SUB_CONV; + `x * y`,INT_MUL_CONV; + `x div y`,INT_DIV_CONV; + `x rem y`,INT_REM_CONV; + `x pow n`,INT_POW_CONV; + `max x y`,INT_MAX_CONV; + `min x y`,INT_MIN_CONV] + (basic_net()) in + REWRITES_CONV gconv_net;; + +let INT_REDUCE_CONV = DEPTH_CONV INT_RED_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Set up overloading so we can use same symbols for N, Z and even R. *) +(* ------------------------------------------------------------------------- *) + +make_overloadable "divides" `:A->A->bool`;; +make_overloadable "mod" `:A->A->A->bool`;; +make_overloadable "coprime" `:A#A->bool`;; +make_overloadable "gcd" `:A#A->A`;; + +(* ------------------------------------------------------------------------- *) +(* The general notion of congruence: just syntax for equivalence relation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("==",(10,"right"));; + +let cong = new_definition + `(x == y) (rel:A->A->bool) <=> rel x y`;; + +(* ------------------------------------------------------------------------- *) +(* Get real moduli defined and out of the way first. *) +(* ------------------------------------------------------------------------- *) + +let real_mod = new_definition + `real_mod n (x:real) y = ?q. integer q /\ x - y = q * n`;; + +overload_interface ("mod",`real_mod`);; + +(* ------------------------------------------------------------------------- *) +(* Integer divisibility. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("divides",(12,"right"));; +overload_interface("divides",`int_divides:int->int->bool`);; + +let int_divides = new_definition + `a divides b <=> ?x. b = a * x`;; + +(* ------------------------------------------------------------------------- *) +(* Integer congruences. *) +(* ------------------------------------------------------------------------- *) + +parse_as_prefix "mod";; +overload_interface ("mod",`int_mod:int->int->int->bool`);; + +let int_mod = new_definition + `(mod n) x y = n divides (x - y)`;; + +let int_congruent = prove + (`!x y n. (x == y) (mod n) <=> ?d. x - y = n * d`, + REWRITE_TAC[int_mod; cong; int_divides]);; + +(* ------------------------------------------------------------------------- *) +(* Integer coprimality. *) +(* ------------------------------------------------------------------------- *) + +overload_interface("coprime",`int_coprime:int#int->bool`);; + +let int_coprime = new_definition + `!a b. coprime(a,b) <=> ?x y. a * x + b * y = &1`;; + +(* ------------------------------------------------------------------------- *) +(* A tactic for simple divisibility/congruence/coprimality goals. *) +(* ------------------------------------------------------------------------- *) + +let INTEGER_TAC = + let int_ty = `:int` in + let INT_POLYEQ_CONV = + GEN_REWRITE_CONV I [GSYM INT_SUB_0] THENC LAND_CONV INT_POLY_CONV in + let ISOLATE_VARIABLE = + let pth = INT_ARITH `!a x. a = &0 <=> x = x + a` in + let is_defined v t = + let mons = striplist(dest_binary "int_add") t in + mem v mons & forall (fun m -> v = m or not(free_in v m)) mons in + fun vars tm -> + let th = INT_POLYEQ_CONV tm + and th' = (SYM_CONV THENC INT_POLYEQ_CONV) tm in + let v,th1 = + try find (fun v -> is_defined v (lhand(rand(concl th)))) vars,th' + with Failure _ -> + find (fun v -> is_defined v (lhand(rand(concl th')))) vars,th in + let th2 = TRANS th1 (SPECL [lhs(rand(concl th1)); v] pth) in + CONV_RULE(RAND_CONV(RAND_CONV INT_POLY_CONV)) th2 in + let UNWIND_POLYS_CONV tm = + let vars,bod = strip_exists tm in + let cjs = conjuncts bod in + let th1 = tryfind (ISOLATE_VARIABLE vars) cjs in + let eq = lhand(concl th1) in + let bod' = list_mk_conj(eq::(subtract cjs [eq])) in + let th2 = CONJ_ACI_RULE(mk_eq(bod,bod')) in + let th3 = TRANS th2 (MK_CONJ th1 (REFL(rand(rand(concl th2))))) in + let v = lhs(lhand(rand(concl th3))) in + let vars' = (subtract vars [v]) @ [v] in + let th4 = CONV_RULE(RAND_CONV(REWR_CONV UNWIND_THM2)) (MK_EXISTS v th3) in + let IMP_RULE v v' = + DISCH_ALL(itlist SIMPLE_CHOOSE v (itlist SIMPLE_EXISTS v' (ASSUME bod))) in + let th5 = IMP_ANTISYM_RULE (IMP_RULE vars vars') (IMP_RULE vars' vars) in + TRANS th5 (itlist MK_EXISTS (subtract vars [v]) th4) in + let zero_tm = `&0` and one_tm = `&1` in + let isolate_monomials = + let mul_tm = `(int_mul)` and add_tm = `(int_add)` + and neg_tm = `(int_neg)` in + let dest_mul = dest_binop mul_tm + and dest_add = dest_binop add_tm + and mk_mul = mk_binop mul_tm + and mk_add = mk_binop add_tm in + let scrub_var v m = + let ps = striplist dest_mul m in + let ps' = subtract ps [v] in + if ps' = [] then one_tm else end_itlist mk_mul ps' in + let find_multipliers v mons = + let mons1 = filter (fun m -> free_in v m) mons in + let mons2 = map (scrub_var v) mons1 in + if mons2 = [] then zero_tm else end_itlist mk_add mons2 in + fun vars tm -> + let cmons,vmons = + partition (fun m -> intersect (frees m) vars = []) + (striplist dest_add tm) in + let cofactors = map (fun v -> find_multipliers v vmons) vars + and cnc = if cmons = [] then zero_tm + else mk_comb(neg_tm,end_itlist mk_add cmons) in + cofactors,cnc in + let isolate_variables evs ps eq = + let vars = filter (fun v -> vfree_in v eq) evs in + let qs,p = isolate_monomials vars eq in + let rs = filter (fun t -> type_of t = int_ty) (qs @ ps) in + let rs = int_ideal_cofactors rs p in + eq,zip (fst(chop_list(length qs) rs)) vars in + let subst_in_poly i p = rhs(concl(INT_POLY_CONV (vsubst i p))) in + let rec solve_idealism evs ps eqs = + if evs = [] then [] else + let eq,cfs = tryfind (isolate_variables evs ps) eqs in + let evs' = subtract evs (map snd cfs) + and eqs' = map (subst_in_poly cfs) (subtract eqs [eq]) in + cfs @ solve_idealism evs' ps eqs' in + let rec GENVAR_EXISTS_CONV tm = + if not(is_exists tm) then REFL tm else + let ev,bod = dest_exists tm in + let gv = genvar(type_of ev) in + (GEN_ALPHA_CONV gv THENC BINDER_CONV GENVAR_EXISTS_CONV) tm in + let EXISTS_POLY_TAC (asl,w as gl) = + let evs,bod = strip_exists w + and ps = mapfilter (check (fun t -> type_of t = int_ty) o + lhs o concl o snd) asl in + let cfs = solve_idealism evs ps (map lhs (conjuncts bod)) in + (MAP_EVERY EXISTS_TAC(map (fun v -> rev_assocd v cfs zero_tm) evs) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC INT_RING) gl in + let SCRUB_NEQ_TAC = MATCH_MP_TAC o MATCH_MP (MESON[] + `~(x = y) ==> x = y \/ p ==> p`) in + REWRITE_TAC[int_coprime; int_congruent; int_divides] THEN + REPEAT(STRIP_TAC ORELSE EQ_TAC) THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; + LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM] THEN + CONV_TAC(REPEATC UNWIND_POLYS_CONV) THEN + REPEAT(FIRST_X_ASSUM SCRUB_NEQ_TAC) THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM; + LEFT_OR_EXISTS_THM; RIGHT_OR_EXISTS_THM] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SYM)) THEN + CONV_TAC(ONCE_DEPTH_CONV INT_POLYEQ_CONV) THEN + REWRITE_TAC[GSYM INT_ENTIRE; + TAUT `a \/ (b /\ c) <=> (a \/ b) /\ (a \/ c)`] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + REPEAT DISCH_TAC THEN CONV_TAC GENVAR_EXISTS_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV INT_POLYEQ_CONV) THEN EXISTS_POLY_TAC;; + +let INTEGER_RULE tm = prove(tm,INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existence of integer gcd, and the Bezout identity. *) +(* ------------------------------------------------------------------------- *) + +let WF_INT_MEASURE = prove + (`!P m. (!x. &0 <= m(x)) /\ (!x. (!y. m(y) < m(x) ==> P(y)) ==> P(x)) + ==> !x:A. P(x)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `!n x:A. m(x) = &n ==> P(x)` MP_TAC THENL + [MATCH_MP_TAC num_WF; ALL_TAC] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT; INT_FORALL_POS] THEN ASM_MESON_TAC[]);; + +let WF_INT_MEASURE_2 = prove + (`!P m. (!x y. &0 <= m x y) /\ + (!x y. (!x' y'. m x' y' < m x y ==> P x' y') ==> P x y) + ==> !x:A y:B. P x y`, + REWRITE_TAC[FORALL_UNCURRY; GSYM FORALL_PAIR_THM; WF_INT_MEASURE]);; + +let INT_GCD_EXISTS = prove + (`!a b. ?d. d divides a /\ d divides b /\ ?x y. d = a * x + b * y`, + let INT_GCD_EXISTS_CASES = INT_ARITH + `(a = &0 \/ b = &0) \/ + abs(a - b) + abs b < abs a + abs b \/ abs(a + b) + abs b < abs a + abs b \/ + abs a + abs(b - a) < abs a + abs b \/ abs a + abs(b + a) < abs a + abs b` in + MATCH_MP_TAC WF_INT_MEASURE_2 THEN EXISTS_TAC `\x y. abs(x) + abs(y)` THEN + REWRITE_TAC[] THEN REPEAT STRIP_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + DISJ_CASES_THEN MP_TAC INT_GCD_EXISTS_CASES THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[INTEGER_RULE `d divides &0`] THEN + REWRITE_TAC[INT_MUL_LZERO; INT_ADD_LID; INT_ADD_RID] THEN + MESON_TAC[INTEGER_RULE `d divides d`; INT_MUL_RID]; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (ANTE_RES_THEN MP_TAC)) THEN + MATCH_MP_TAC MONO_EXISTS THEN INTEGER_TAC]);; + +let INT_GCD_EXISTS_POS = prove + (`!a b. ?d. &0 <= d /\ d divides a /\ d divides b /\ ?x y. d = a * x + b * y`, + REPEAT GEN_TAC THEN + X_CHOOSE_TAC `d:int` (SPECL [`a:int`; `b:int`] INT_GCD_EXISTS) THEN + DISJ_CASES_TAC(SPEC `d:int` INT_LE_NEGTOTAL) THEN + ASM_MESON_TAC[INTEGER_RULE `(--d) divides x <=> d divides x`; + INT_ARITH `a * --x + b * --y = --(a * x + b * y)`]);; + +(* ------------------------------------------------------------------------- *) +(* Hence define (positive) gcd function; add elimination to INTEGER_TAC. *) +(* ------------------------------------------------------------------------- *) + +overload_interface("gcd",`int_gcd:int#int->int`);; + +let int_gcd = new_specification ["int_gcd"] + (REWRITE_RULE[EXISTS_UNCURRY; SKOLEM_THM] INT_GCD_EXISTS_POS);; + +let INTEGER_TAC = + let GCD_ELIM_TAC = + let gcd_tm = `gcd` in + let dest_gcd tm = + let l,r = dest_comb tm in + if l = gcd_tm then dest_pair r else failwith "dest_gcd" in + REPEAT GEN_TAC THEN + W(fun (asl,w) -> + let gts = find_terms (can dest_gcd) w in + let ths = map + (fun tm -> let a,b = dest_gcd tm in SPECL [a;b] int_gcd) gts in + MAP_EVERY MP_TAC ths THEN + MAP_EVERY SPEC_TAC (zip gts (map (genvar o type_of) gts))) in + REPEAT(GEN_TAC ORELSE CONJ_TAC) THEN GCD_ELIM_TAC THEN INTEGER_TAC;; + +let INTEGER_RULE tm = prove(tm,INTEGER_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Mapping from nonnegative integers back to natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let num_of_int = new_definition + `num_of_int x = @n. &n = x`;; + +let NUM_OF_INT_OF_NUM = prove + (`!n. num_of_int(&n) = n`, + REWRITE_TAC[num_of_int; INT_OF_NUM_EQ; SELECT_UNIQUE]);; + +let INT_OF_NUM_OF_INT = prove + (`!x. &0 <= x ==> &(num_of_int x) = x`, + REWRITE_TAC[GSYM INT_FORALL_POS; num_of_int] THEN + GEN_TAC THEN CONV_TAC SELECT_CONV THEN MESON_TAC[]);; + +let NUM_OF_INT = prove + (`!x. &0 <= x <=> (&(num_of_int x) = x)`, + MESON_TAC[INT_OF_NUM_OF_INT; INT_POS]);; + +(* ------------------------------------------------------------------------- *) +(* Now define similar notions over the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +overload_interface("divides",`num_divides:num->num->bool`);; +overload_interface ("mod",`num_mod:num->num->num->bool`);; +overload_interface("coprime",`num_coprime:num#num->bool`);; +overload_interface("gcd",`num_gcd:num#num->num`);; + +let num_divides = new_definition + `a divides b <=> &a divides &b`;; + +let num_mod = new_definition + `(mod n) x y <=> (mod &n) (&x) (&y)`;; + +let num_congruent = prove + (`!x y n. (x == y) (mod n) <=> (&x == &y) (mod &n)`, + REWRITE_TAC[cong; num_mod]);; + +let num_coprime = new_definition + `coprime(a,b) <=> coprime(&a,&b)`;; + +let num_gcd = new_definition + `gcd(a,b) = num_of_int(gcd(&a,&b))`;; + +(* ------------------------------------------------------------------------- *) +(* Map an assertion over N to an integer equivalent. *) +(* To make this work nicely, all variables of type num should be quantified. *) +(* ------------------------------------------------------------------------- *) + +let NUM_TO_INT_CONV = + let pth_relativize = prove + (`((!n. P(&n)) <=> (!i. ~(&0 <= i) \/ P i)) /\ + ((?n. P(&n)) <=> (?i. &0 <= i /\ P i))`, + REWRITE_TAC[INT_EXISTS_POS; INT_FORALL_POS] THEN MESON_TAC[]) in + let relation_conv = (GEN_REWRITE_CONV TOP_SWEEP_CONV o map GSYM) + [INT_OF_NUM_EQ; INT_OF_NUM_LE; INT_OF_NUM_LT; INT_OF_NUM_GE; INT_OF_NUM_GT; + INT_OF_NUM_SUC; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW] + and quantifier_conv = GEN_REWRITE_CONV DEPTH_CONV [pth_relativize] in + NUM_SIMPLIFY_CONV THENC relation_conv THENC quantifier_conv;; + +(* ------------------------------------------------------------------------- *) +(* Linear decision procedure for the naturals at last! *) +(* ------------------------------------------------------------------------- *) + +let ARITH_RULE = + let init_conv = + NUM_SIMPLIFY_CONV THENC + GEN_REWRITE_CONV DEPTH_CONV [ADD1] THENC + PROP_ATOM_CONV (BINOP_CONV NUM_NORMALIZE_CONV) THENC + PRENEX_CONV THENC + (GEN_REWRITE_CONV TOP_SWEEP_CONV o map GSYM) + [INT_OF_NUM_EQ; INT_OF_NUM_LE; INT_OF_NUM_LT; INT_OF_NUM_GE; + INT_OF_NUM_GT; INT_OF_NUM_ADD; SPEC `NUMERAL k` INT_OF_NUM_MUL; + INT_OF_NUM_MAX; INT_OF_NUM_MIN] + and is_numimage t = + match t with + Comb(Const("int_of_num",_),n) when not(is_numeral n) -> true + | _ -> false in + fun tm -> + let th1 = init_conv tm in + let tm1 = rand(concl th1) in + let avs,bod = strip_forall tm1 in + let nim = setify(find_terms is_numimage bod) in + let gvs = map (genvar o type_of) nim in + let pths = map (fun v -> SPEC (rand v) INT_POS) nim in + let ibod = itlist (curry mk_imp o concl) pths bod in + let gbod = subst (zip gvs nim) ibod in + let th2 = INST (zip nim gvs) (INT_ARITH gbod) in + let th3 = GENL avs (rev_itlist (C MP) pths th2) in + EQ_MP (SYM th1) th3;; + +let ARITH_TAC = CONV_TAC(EQT_INTRO o ARITH_RULE);; + +let ASM_ARITH_TAC = + REPEAT(FIRST_X_ASSUM(MP_TAC o check (not o is_forall o concl))) THEN + ARITH_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Also a similar divisibility procedure for natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let NUM_GCD = prove + (`!a b. &(gcd(a,b)) = gcd(&a,&b)`, + REWRITE_TAC[num_gcd; GSYM NUM_OF_INT; int_gcd]);; + +let NUMBER_TAC = + let pth_relativize = prove + (`((!n. P(&n)) <=> (!i. &0 <= i ==> P i)) /\ + ((?n. P(&n)) <=> (?i. &0 <= i /\ P i))`, + GEN_REWRITE_TAC RAND_CONV [TAUT `(a <=> b) <=> (~a <=> ~b)`] THEN + REWRITE_TAC[NOT_EXISTS_THM; INT_FORALL_POS] THEN MESON_TAC[]) in + let relation_conv = + GEN_REWRITE_CONV TOP_SWEEP_CONV + (num_divides::num_congruent::num_coprime::NUM_GCD::(map GSYM + [INT_OF_NUM_EQ; INT_OF_NUM_LE; INT_OF_NUM_LT; INT_OF_NUM_GE; INT_OF_NUM_GT; + INT_OF_NUM_SUC; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW])) + and quantifier_conv = GEN_REWRITE_CONV DEPTH_CONV [pth_relativize] in + W(fun (_,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC(relation_conv THENC quantifier_conv) THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM] THEN REPEAT GEN_TAC THEN + INTEGER_TAC;; + +let NUMBER_RULE tm = prove(tm,NUMBER_TAC);; + +let divides = prove + (`a divides b <=> ?x. b = a * x`, + EQ_TAC THENL [REWRITE_TAC[num_divides; int_divides]; NUMBER_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `x:int`) THEN EXISTS_TAC `num_of_int(abs x)` THEN + SIMP_TAC[GSYM INT_OF_NUM_EQ; + INT_ARITH `&m:int = &n <=> abs(&m :int) = abs(&n)`] THEN + ASM_REWRITE_TAC[GSYM INT_OF_NUM_MUL; INT_ABS_MUL] THEN + SIMP_TAC[INT_OF_NUM_OF_INT; INT_ABS_POS; INT_ABS_ABS]);; + +let DIVIDES_LE = prove + (`!m n. m divides n ==> m <= n \/ n = 0`, + SUBGOAL_THEN `!m n. m <= m * n \/ m * n = 0` + (fun th -> MESON_TAC[divides; th]) THEN + REWRITE_TAC[LE_MULT_LCANCEL; MULT_EQ_0; ARITH_RULE + `m <= m * n <=> m * 1 <= m * n`] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Make sure we give priority to N. *) +(* ------------------------------------------------------------------------- *) + +prioritize_num();; diff --git a/itab.ml b/itab.ml new file mode 100644 index 0000000..f7b9a0d --- /dev/null +++ b/itab.ml @@ -0,0 +1,73 @@ +(* ========================================================================= *) +(* Intuitionistic theorem prover (complete for propositional fragment). *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "tactics.ml";; + +(* ------------------------------------------------------------------------- *) +(* Accept a theorem modulo unification. *) +(* ------------------------------------------------------------------------- *) + +let UNIFY_ACCEPT_TAC mvs th (asl,w) = + let insts = term_unify mvs (concl th) w in + ([],insts),[], + let th' = INSTANTIATE insts th in + fun i [] -> INSTANTIATE i th';; + +(* ------------------------------------------------------------------------- *) +(* The actual prover, as a tactic. *) +(* ------------------------------------------------------------------------- *) + +let ITAUT_TAC = + let CONJUNCTS_THEN' ttac cth = + ttac(CONJUNCT1 cth) THEN ttac(CONJUNCT2 cth) in + let IMPLICATE t = + let th1 = AP_THM NOT_DEF (dest_neg t) in + CONV_RULE (RAND_CONV BETA_CONV) th1 in + let RIGHT_REVERSIBLE_TAC = FIRST + [CONJ_TAC; (* and *) + GEN_TAC; (* forall *) + DISCH_TAC; (* implies *) + (fun gl -> CONV_TAC(K(IMPLICATE(snd gl))) gl); (* not *) + EQ_TAC] (* iff *) + and LEFT_REVERSIBLE_TAC th gl = tryfind (fun ttac -> ttac th gl) + [CONJUNCTS_THEN' ASSUME_TAC; (* and *) + DISJ_CASES_TAC; (* or *) + CHOOSE_TAC; (* exists *) + (fun th -> ASSUME_TAC (EQ_MP (IMPLICATE (concl th)) th)); (* not *) + (CONJUNCTS_THEN' MP_TAC o uncurry CONJ o EQ_IMP_RULE)] (* iff *) + in + let rec ITAUT_TAC mvs n gl = + if n <= 0 then failwith "ITAUT_TAC: Too deep" else + ((FIRST_ASSUM (UNIFY_ACCEPT_TAC mvs)) ORELSE + (ACCEPT_TAC TRUTH) ORELSE + (FIRST_ASSUM CONTR_TAC) ORELSE + (RIGHT_REVERSIBLE_TAC THEN TRY (ITAUT_TAC mvs n)) ORELSE + (FIRST_X_ASSUM LEFT_REVERSIBLE_TAC THEN TRY(ITAUT_TAC mvs n)) ORELSE + (FIRST_X_ASSUM(fun th -> ASSUME_TAC th THEN + (let gv = genvar(type_of(fst(dest_forall(concl th)))) in + META_SPEC_TAC gv th THEN + ITAUT_TAC (gv::mvs) (n - 2) THEN NO_TAC))) ORELSE + (DISJ1_TAC THEN ITAUT_TAC mvs n THEN NO_TAC) ORELSE + (DISJ2_TAC THEN ITAUT_TAC mvs n THEN NO_TAC) ORELSE + (fun gl -> let gv = genvar(type_of(fst(dest_exists(snd gl)))) in + (X_META_EXISTS_TAC gv THEN + ITAUT_TAC (gv::mvs) (n - 2) THEN NO_TAC) gl) ORELSE + (FIRST_ASSUM(fun th -> SUBGOAL_THEN (fst(dest_imp(concl th))) + (fun ath -> ASSUME_TAC (MP th ath)) THEN + ITAUT_TAC mvs (n - 1) THEN NO_TAC))) gl in + let rec ITAUT_ITERDEEP_TAC n gl = + remark ("Searching with limit "^(string_of_int n)); + ((ITAUT_TAC [] n THEN NO_TAC) ORELSE ITAUT_ITERDEEP_TAC (n + 1)) gl in + ITAUT_ITERDEEP_TAC 0;; + +(* ------------------------------------------------------------------------- *) +(* Alternative interface. *) +(* ------------------------------------------------------------------------- *) + +let ITAUT tm = prove(tm,ITAUT_TAC);; diff --git a/iterate.ml b/iterate.ml new file mode 100644 index 0000000..90f3a9e --- /dev/null +++ b/iterate.ml @@ -0,0 +1,2387 @@ +(* ========================================================================= *) +(* Generic iterated operations and special cases of sums over N and R. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* (c) Copyright, Lars Schewe 2007 *) +(* ========================================================================= *) + +needs "sets.ml";; + +prioritize_num();; + +(* ------------------------------------------------------------------------- *) +(* A natural notation for segments of the naturals. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("..",(15,"right"));; + +let numseg = new_definition + `m..n = {x:num | m <= x /\ x <= n}`;; + +let FINITE_NUMSEG = prove + (`!m n. FINITE(m..n)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x:num | x <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; numseg]);; + +let NUMSEG_COMBINE_R = prove + (`!m p n. m <= p + 1 /\ p <= n ==> ((m..p) UNION ((p+1)..n) = m..n)`, + REWRITE_TAC[EXTENSION; IN_UNION; numseg; IN_ELIM_THM] THEN ARITH_TAC);; + +let NUMSEG_COMBINE_L = prove + (`!m p n. m <= p /\ p <= n + 1 ==> ((m..(p-1)) UNION (p..n) = m..n)`, + REWRITE_TAC[EXTENSION; IN_UNION; numseg; IN_ELIM_THM] THEN ARITH_TAC);; + +let NUMSEG_LREC = prove + (`!m n. m <= n ==> (m INSERT ((m+1)..n) = m..n)`, + REWRITE_TAC[EXTENSION; IN_INSERT; numseg; IN_ELIM_THM] THEN ARITH_TAC);; + +let NUMSEG_RREC = prove + (`!m n. m <= n ==> (n INSERT (m..(n-1)) = m..n)`, + REWRITE_TAC[EXTENSION; IN_INSERT; numseg; IN_ELIM_THM] THEN ARITH_TAC);; + +let NUMSEG_REC = prove + (`!m n. m <= SUC n ==> (m..SUC n = (SUC n) INSERT (m..n))`, + SIMP_TAC[GSYM NUMSEG_RREC; SUC_SUB1]);; + +let IN_NUMSEG = prove + (`!m n p. p IN (m..n) <=> m <= p /\ p <= n`, + REWRITE_TAC[numseg; IN_ELIM_THM]);; + +let IN_NUMSEG_0 = prove + (`!m n. m IN (0..n) <=> m <= n`, + REWRITE_TAC[IN_NUMSEG; LE_0]);; + +let NUMSEG_SING = prove + (`!n. n..n = {n}`, + REWRITE_TAC[EXTENSION; IN_SING; IN_NUMSEG] THEN ARITH_TAC);; + +let NUMSEG_EMPTY = prove + (`!m n. (m..n = {}) <=> n < m`, + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_NUMSEG] THEN + MESON_TAC[NOT_LE; LE_TRANS; LE_REFL]);; + +let CARD_NUMSEG_LEMMA = prove + (`!m d. CARD(m..(m+d)) = d + 1`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[ADD_CLAUSES; NUMSEG_REC; NUMSEG_SING; FINITE_RULES; + ARITH_RULE `m <= SUC(m + d)`; CARD_CLAUSES; FINITE_NUMSEG; + NOT_IN_EMPTY; ARITH; IN_NUMSEG; ARITH_RULE `~(SUC n <= n)`]);; + +let CARD_NUMSEG = prove + (`!m n. CARD(m..n) = (n + 1) - m`, + REPEAT GEN_TAC THEN + DISJ_CASES_THEN MP_TAC (ARITH_RULE `n:num < m \/ m <= n`) THENL + [ASM_MESON_TAC[NUMSEG_EMPTY; CARD_CLAUSES; + ARITH_RULE `n < m ==> ((n + 1) - m = 0)`]; + SIMP_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM; CARD_NUMSEG_LEMMA] THEN + REPEAT STRIP_TAC THEN ARITH_TAC]);; + +let HAS_SIZE_NUMSEG = prove + (`!m n. (m..n) HAS_SIZE ((n + 1) - m)`, + REWRITE_TAC[HAS_SIZE; FINITE_NUMSEG; CARD_NUMSEG]);; + +let CARD_NUMSEG_1 = prove + (`!n. CARD(1..n) = n`, + REWRITE_TAC[CARD_NUMSEG] THEN ARITH_TAC);; + +let HAS_SIZE_NUMSEG_1 = prove + (`!n. (1..n) HAS_SIZE n`, + REWRITE_TAC[CARD_NUMSEG; HAS_SIZE; FINITE_NUMSEG] THEN ARITH_TAC);; + +let NUMSEG_CLAUSES = prove + (`(!m. m..0 = if m = 0 then {0} else {}) /\ + (!m n. m..SUC n = if m <= SUC n then (SUC n) INSERT (m..n) else m..n)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_NUMSEG; NOT_IN_EMPTY; IN_INSERT] THEN + POP_ASSUM MP_TAC THEN ARITH_TAC);; + +let FINITE_INDEX_NUMSEG = prove + (`!s:A->bool. + FINITE s = + ?f. (!i j. i IN (1..CARD(s)) /\ j IN (1..CARD(s)) /\ (f i = f j) + ==> (i = j)) /\ + (s = IMAGE f (1..CARD(s)))`, + GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; MESON_TAC[FINITE_NUMSEG; FINITE_IMAGE]] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`s:A->bool`; `CARD(s:A->bool)`] HAS_SIZE_INDEX) THEN + ASM_REWRITE_TAC[HAS_SIZE] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n. f(n - 1):A` THEN + ASM_REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN + CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= i /\ i <= n <=> ~(i = 0) /\ i - 1 < n`] THEN + ASM_MESON_TAC[ARITH_RULE + `~(x = 0) /\ ~(y = 0) /\ (x - 1 = y - 1) ==> (x = y)`]; + ASM_MESON_TAC + [ARITH_RULE `m < C ==> (m = (m + 1) - 1) /\ 1 <= m + 1 /\ m + 1 <= C`; + ARITH_RULE `1 <= i /\ i <= n <=> ~(i = 0) /\ i - 1 < n`]]);; + +let FINITE_INDEX_NUMBERS = prove + (`!s:A->bool. + FINITE s = + ?k:num->bool f. (!i j. i IN k /\ j IN k /\ (f i = f j) ==> (i = j)) /\ + FINITE k /\ (s = IMAGE f k)`, + MESON_TAC[FINITE_INDEX_NUMSEG; FINITE_NUMSEG; FINITE_IMAGE]);; + +let DISJOINT_NUMSEG = prove + (`!m n p q. DISJOINT (m..n) (p..q) <=> n < p \/ q < m \/ n < m \/ q < p`, + REWRITE_TAC[DISJOINT; IN_NUMSEG; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM; NOT_LE] THEN + EQ_TAC THENL [MESON_TAC[LT_ANTISYM]; ARITH_TAC]);; + +let NUMSEG_ADD_SPLIT = prove + (`!m n p. m <= n + 1 ==> (m..(n+p) = (m..n) UNION (n+1..n+p))`, + REWRITE_TAC[EXTENSION; IN_UNION; IN_NUMSEG] THEN ARITH_TAC);; + +let NUMSEG_OFFSET_IMAGE = prove + (`!m n p. (m+p..n+p) = IMAGE (\i. i + p) (m..n)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_NUMSEG] THEN + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(fun th -> EXISTS_TAC `x - p:num` THEN MP_TAC th); ALL_TAC] THEN + ARITH_TAC);; + +let SUBSET_NUMSEG = prove + (`!m n p q. (m..n) SUBSET (p..q) <=> n < m \/ p <= m /\ n <= q`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_NUMSEG] THEN + EQ_TAC THENL [MESON_TAC[LE_TRANS; NOT_LE; LE_REFL]; ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Equivalence with the more ad-hoc comprehension notation. *) +(* ------------------------------------------------------------------------- *) + +let NUMSEG_LE = prove + (`!n. {x | x <= n} = 0..n`, + REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM] THEN ARITH_TAC);; + +let NUMSEG_LT = prove + (`!n. {x | x < n} = if n = 0 then {} else 0..(n-1)`, + GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[EXTENSION; IN_NUMSEG; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Conversion to evaluate m..n for specific numerals. *) +(* ------------------------------------------------------------------------- *) + +let NUMSEG_CONV = + let pth_0 = MESON[NUMSEG_EMPTY] `n < m ==> m..n = {}` + and pth_1 = MESON[NUMSEG_SING] `m..m = {m}` + and pth_2 = MESON[NUMSEG_LREC; ADD1] `m <= n ==> m..n = m INSERT (SUC m..n)` + and ns_tm = `(..)` and m_tm = `m:num` and n_tm = `n:num` in + let rec NUMSEG_CONV tm = + let nstm,nt = dest_comb tm in + let nst,mt = dest_comb nstm in + if nst <> ns_tm then failwith "NUMSEG_CONV" else + let m = dest_numeral mt and n = dest_numeral nt in + if n x = y) /\ + (!x y z. x << y /\ y << z ==> x << z) + ==> !n s. s HAS_SIZE n + ==> ?f. s = IMAGE f (1..n) /\ + (!j k. j IN 1..n /\ k IN 1..n /\ j < k + ==> ~(f k << f j))`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `!n s. s HAS_SIZE n /\ ~(s = {}) + ==> ?a:A. a IN s /\ !b. b IN (s DELETE a) ==> ~(b << a)` + ASSUME_TAC THENL + [INDUCT_TAC THEN + REWRITE_TAC[HAS_SIZE_0; HAS_SIZE_SUC; TAUT `~(a /\ ~a)`] THEN + X_GEN_TAC `s:A->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A)`) THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> (s DELETE a = {} <=> s = {a})`] THEN + ASM_CASES_TAC `s = {a:A}` THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `a:A` THEN SET_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `((a:A) << (b:A)) :bool` THENL + [EXISTS_TAC `a:A`; EXISTS_TAC `b:A`] THEN ASM SET_TAC[]; + ALL_TAC] THEN + INDUCT_TAC THENL + [SIMP_TAC[HAS_SIZE_0; NUMSEG_CLAUSES; ARITH; IMAGE_CLAUSES; NOT_IN_EMPTY]; + ALL_TAC] THEN + REWRITE_TAC[HAS_SIZE_SUC] THEN X_GEN_TAC `s:A->bool` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`SUC n`; `s:A->bool`]) THEN + ASM_REWRITE_TAC[HAS_SIZE_SUC] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` MP_TAC) THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A)`) THEN ASM_SIMP_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\k. if k = 1 then a:A else f(k - 1)` THEN + SIMP_TAC[ARITH_RULE `1 <= k ==> ~(SUC k = 1)`; SUC_SUB1] THEN + SUBGOAL_THEN `!i. i IN 1..SUC n <=> i = 1 \/ 1 < i /\ (i - 1) IN 1..n` + (fun th -> REWRITE_TAC[EXTENSION; IN_IMAGE; th]) + THENL [REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL + [X_GEN_TAC `b:A` THEN ASM_CASES_TAC `b:A = a` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP + (SET_RULE `~(b = a) ==> (b IN s <=> b IN (s DELETE a))`) th]) THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN + EQ_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + DISCH_THEN(X_CHOOSE_TAC `i:num`) THEN EXISTS_TAC `i + 1` THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= x ==> 1 < x + 1 /\ ~(x + 1 = 1)`; ADD_SUB]; + MAP_EVERY X_GEN_TAC [`j:num`; `k:num`] THEN + MAP_EVERY ASM_CASES_TAC [`j = 1`; `k = 1`] THEN + ASM_REWRITE_TAC[LT_REFL] THENL + [STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; + ARITH_TAC; + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Analogous finiteness theorem for segments of integers. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_INTSEG = prove + (`(!l r. FINITE {x:int | l <= x /\ x <= r}) /\ + (!l r. FINITE {x:int | l <= x /\ x < r}) /\ + (!l r. FINITE {x:int | l < x /\ x <= r}) /\ + (!l r. FINITE {x:int | l < x /\ x < r})`, + MATCH_MP_TAC(TAUT `(a ==> b) /\ a ==> a /\ b`) THEN CONJ_TAC THENL + [DISCH_TAC THEN REPEAT CONJ_TAC THEN POP_ASSUM MP_TAC THEN + REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN INT_ARITH_TAC; + REPEAT GEN_TAC THEN ASM_CASES_TAC `&0:int <= r - l` THEN + ASM_SIMP_TAC[INT_ARITH `~(&0 <= r - l:int) ==> ~(l <= x /\ x <= r)`] THEN + ASM_SIMP_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\n. l + &n) (0..num_of_int(r - l))` THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LE; IN_NUMSEG] THEN + X_GEN_TAC `x:int` THEN STRIP_TAC THEN EXISTS_TAC `num_of_int(x - l)` THEN + ASM_SIMP_TAC[INT_OF_NUM_OF_INT; INT_SUB_LE] THEN ASM_INT_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Generic iteration of operation over set with finite support. *) +(* ------------------------------------------------------------------------- *) + +let neutral = new_definition + `neutral op = @x. !y. (op x y = y) /\ (op y x = y)`;; + +let monoidal = new_definition + `monoidal op <=> (!x y. op x y = op y x) /\ + (!x y z. op x (op y z) = op (op x y) z) /\ + (!x:A. op (neutral op) x = x)`;; + +let MONOIDAL_AC = prove + (`!op. monoidal op + ==> (!a. op (neutral op) a = a) /\ + (!a. op a (neutral op) = a) /\ + (!a b. op a b = op b a) /\ + (!a b c. op (op a b) c = op a (op b c)) /\ + (!a b c. op a (op b c) = op b (op a c))`, + REWRITE_TAC[monoidal] THEN MESON_TAC[]);; + +let support = new_definition + `support op (f:A->B) s = {x | x IN s /\ ~(f x = neutral op)}`;; + +let iterate = new_definition + `iterate op (s:A->bool) f = + if FINITE(support op f s) + then ITSET (\x a. op (f x) a) (support op f s) (neutral op) + else neutral op`;; + +let IN_SUPPORT = prove + (`!op f x s. x IN (support op f s) <=> x IN s /\ ~(f x = neutral op)`, + REWRITE_TAC[support; IN_ELIM_THM]);; + +let SUPPORT_SUPPORT = prove + (`!op f s. support op f (support op f s) = support op f s`, + REWRITE_TAC[support; IN_ELIM_THM; EXTENSION] THEN REWRITE_TAC[CONJ_ACI]);; + +let SUPPORT_EMPTY = prove + (`!op f s. (!x. x IN s ==> (f(x) = neutral op)) <=> (support op f s = {})`, + REWRITE_TAC[IN_SUPPORT; EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +let SUPPORT_SUBSET = prove + (`!op f s. (support op f s) SUBSET s`, + SIMP_TAC[SUBSET; IN_SUPPORT]);; + +let FINITE_SUPPORT = prove + (`!op f s. FINITE s ==> FINITE(support op f s)`, + MESON_TAC[SUPPORT_SUBSET; FINITE_SUBSET]);; + +let SUPPORT_CLAUSES = prove + (`(!f. support op f {} = {}) /\ + (!f x s. support op f (x INSERT s) = + if f(x) = neutral op then support op f s + else x INSERT (support op f s)) /\ + (!f x s. support op f (s DELETE x) = (support op f s) DELETE x) /\ + (!f s t. support op f (s UNION t) = + (support op f s) UNION (support op f t)) /\ + (!f s t. support op f (s INTER t) = + (support op f s) INTER (support op f t)) /\ + (!f s t. support op f (s DIFF t) = + (support op f s) DIFF (support op f t)) /\ + (!f g s. support op g (IMAGE f s) = IMAGE f (support op (g o f) s))`, + REWRITE_TAC[support; EXTENSION; IN_ELIM_THM; IN_INSERT; IN_DELETE; o_THM; + IN_IMAGE; NOT_IN_EMPTY; IN_UNION; IN_INTER; IN_DIFF; COND_RAND] THEN + REPEAT STRIP_TAC THEN TRY COND_CASES_TAC THEN ASM_MESON_TAC[]);; + +let SUPPORT_DELTA = prove + (`!op s f a. support op (\x. if x = a then f(x) else neutral op) s = + if a IN s then support op f {a} else {}`, + REWRITE_TAC[EXTENSION; support; IN_ELIM_THM; IN_SING] THEN + REPEAT GEN_TAC THEN REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY]);; + +let FINITE_SUPPORT_DELTA = prove + (`!op f a. FINITE(support op (\x. if x = a then f(x) else neutral op) s)`, + REWRITE_TAC[SUPPORT_DELTA] THEN REPEAT GEN_TAC THEN + COND_CASES_TAC THEN SIMP_TAC[FINITE_RULES; FINITE_SUPPORT]);; + +(* ------------------------------------------------------------------------- *) +(* Key lemmas about the generic notion. *) +(* ------------------------------------------------------------------------- *) + +let ITERATE_SUPPORT = prove + (`!op f s. iterate op (support op f s) f = iterate op s f`, + SIMP_TAC[iterate; SUPPORT_SUPPORT]);; + +let ITERATE_EXPAND_CASES = prove + (`!op f s. iterate op s f = + if FINITE(support op f s) then iterate op (support op f s) f + else neutral op`, + SIMP_TAC[iterate; SUPPORT_SUPPORT]);; + +let ITERATE_CLAUSES_GEN = prove + (`!op. monoidal op + ==> (!(f:A->B). iterate op {} f = neutral op) /\ + (!f x s. monoidal op /\ FINITE(support op (f:A->B) s) + ==> (iterate op (x INSERT s) f = + if x IN s then iterate op s f + else op (f x) (iterate op s f)))`, + GEN_TAC THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[AND_FORALL_THM] THEN GEN_TAC THEN + MP_TAC(ISPECL [`\x a. (op:B->B->B) ((f:A->B)(x)) a`; `neutral op :B`] + FINITE_RECURSION) THEN + ANTS_TAC THENL [ASM_MESON_TAC[monoidal]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[iterate; SUPPORT_CLAUSES; FINITE_RULES] THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o LAND_CONV) [COND_RAND] THEN + ASM_REWRITE_TAC[SUPPORT_CLAUSES; FINITE_INSERT; COND_ID] THEN + ASM_CASES_TAC `(f:A->B) x = neutral op` THEN + ASM_SIMP_TAC[IN_SUPPORT] THEN COND_CASES_TAC THEN ASM_MESON_TAC[monoidal]);; + +let ITERATE_CLAUSES = prove + (`!op. monoidal op + ==> (!f. iterate op {} f = neutral op) /\ + (!f x s. FINITE(s) + ==> (iterate op (x INSERT s) f = + if x IN s then iterate op s f + else op (f x) (iterate op s f)))`, + SIMP_TAC[ITERATE_CLAUSES_GEN; FINITE_SUPPORT]);; + +let ITERATE_UNION = prove + (`!op. monoidal op + ==> !f s t. FINITE s /\ FINITE t /\ DISJOINT s t + ==> (iterate op (s UNION t) f = + op (iterate op s f) (iterate op t f))`, + let lemma = prove + (`(s UNION (x INSERT t) = x INSERT (s UNION t)) /\ + (DISJOINT s (x INSERT t) <=> ~(x IN s) /\ DISJOINT s t)`, + SET_TAC[]) in + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN REPEAT DISCH_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; IN_UNION; UNION_EMPTY; REAL_ADD_RID; lemma; + FINITE_UNION] THEN + ASM_MESON_TAC[monoidal]);; + +let ITERATE_UNION_GEN = prove + (`!op. monoidal op + ==> !(f:A->B) s t. FINITE(support op f s) /\ FINITE(support op f t) /\ + DISJOINT (support op f s) (support op f t) + ==> (iterate op (s UNION t) f = + op (iterate op s f) (iterate op t f))`, + ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN + SIMP_TAC[SUPPORT_CLAUSES; ITERATE_UNION]);; + +let ITERATE_DIFF = prove + (`!op. monoidal op + ==> !f s t. FINITE s /\ t SUBSET s + ==> (op (iterate op (s DIFF t) f) (iterate op t f) = + iterate op s f)`, + let lemma = prove + (`t SUBSET s ==> (s = (s DIFF t) UNION t) /\ DISJOINT (s DIFF t) t`, + SET_TAC[]) in + MESON_TAC[lemma; ITERATE_UNION; FINITE_UNION; FINITE_SUBSET; SUBSET_DIFF]);; + +let ITERATE_DIFF_GEN = prove + (`!op. monoidal op + ==> !f:A->B s t. FINITE (support op f s) /\ + (support op f t) SUBSET (support op f s) + ==> (op (iterate op (s DIFF t) f) (iterate op t f) = + iterate op s f)`, + ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN + SIMP_TAC[SUPPORT_CLAUSES; ITERATE_DIFF]);; + +let ITERATE_INCL_EXCL = prove + (`!op. monoidal op + ==> !s t f. FINITE s /\ FINITE t + ==> op (iterate op s f) (iterate op t f) = + op (iterate op (s UNION t) f) + (iterate op (s INTER t) f)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE + `a UNION b = ((a DIFF b) UNION (b DIFF a)) UNION (a INTER b)`] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) + [SET_RULE `s:A->bool = s DIFF t UNION s INTER t`] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) + [SET_RULE `t:A->bool = t DIFF s UNION s INTER t`] THEN + ASM_SIMP_TAC[ITERATE_UNION; FINITE_UNION; FINITE_DIFF; FINITE_INTER; + SET_RULE `DISJOINT (s DIFF s' UNION s' DIFF s) (s INTER s')`; + SET_RULE `DISJOINT (s DIFF s') (s' DIFF s)`; + SET_RULE `DISJOINT (s DIFF s') (s' INTER s)`; + SET_RULE `DISJOINT (s DIFF s') (s INTER s')`] THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[MATCH_MP MONOIDAL_AC th]));; + +let ITERATE_CLOSED = prove + (`!op. monoidal op + ==> !P. P(neutral op) /\ (!x y. P x /\ P y ==> P (op x y)) + ==> !f:A->B s. (!x. x IN s /\ ~(f x = neutral op) ==> P(f x)) + ==> P(iterate op s f)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM IN_SUPPORT] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN POP_ASSUM MP_TAC THEN + SPEC_TAC(`support op (f:A->B) s`,`s:A->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_INSERT; IN_INSERT]);; + +let ITERATE_RELATED = prove + (`!op. monoidal op + ==> !R. R (neutral op) (neutral op) /\ + (!x1 y1 x2 y2. R x1 x2 /\ R y1 y2 ==> R (op x1 y1) (op x2 y2)) + ==> !f:A->B g s. + FINITE s /\ + (!x. x IN s ==> R (f x) (g x)) + ==> R (iterate op s f) (iterate op s g)`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_INSERT; IN_INSERT]);; + +let ITERATE_EQ_NEUTRAL = prove + (`!op. monoidal op + ==> !f:A->B s. (!x. x IN s ==> (f(x) = neutral op)) + ==> (iterate op s f = neutral op)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `support op (f:A->B) s = {}` ASSUME_TAC THENL + [ASM_MESON_TAC[EXTENSION; NOT_IN_EMPTY; IN_SUPPORT]; + ASM_MESON_TAC[ITERATE_CLAUSES; FINITE_RULES; ITERATE_SUPPORT]]);; + +let ITERATE_SING = prove + (`!op. monoidal op ==> !f:A->B x. (iterate op {x} f = f x)`, + SIMP_TAC[ITERATE_CLAUSES; FINITE_RULES; NOT_IN_EMPTY] THEN + MESON_TAC[monoidal]);; + +let ITERATE_DELETE = prove + (`!op. monoidal op + ==> !f:A->B s a. FINITE s /\ a IN s + ==> op (f a) (iterate op (s DELETE a) f) = + iterate op s f`, + MESON_TAC[ITERATE_CLAUSES; FINITE_DELETE; IN_DELETE; INSERT_DELETE]);; + +let ITERATE_DELTA = prove + (`!op. monoidal op + ==> !f a s. iterate op s (\x. if x = a then f(x) else neutral op) = + if a IN s then f(a) else neutral op`, + GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN + REWRITE_TAC[SUPPORT_DELTA] THEN REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[ITERATE_CLAUSES] THEN REWRITE_TAC[SUPPORT_CLAUSES] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[ITERATE_CLAUSES; ITERATE_SING]);; + +let ITERATE_IMAGE = prove + (`!op. monoidal op + ==> !f:A->B g:B->C s. + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> (iterate op (IMAGE f s) g = iterate op s (g o f))`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN + SUBGOAL_THEN + `!s. FINITE s /\ + (!x y:A. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> (iterate op (IMAGE f s) (g:B->C) = iterate op s (g o f))` + ASSUME_TAC THENL + [REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; IMAGE_CLAUSES; FINITE_IMAGE] THEN + REWRITE_TAC[o_THM; IN_INSERT] THEN ASM_MESON_TAC[IN_IMAGE]; + GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(TAUT + `(a <=> a') /\ (a' ==> (b = b')) + ==> (if a then b else c) = (if a' then b' else c)`) THEN + REWRITE_TAC[SUPPORT_CLAUSES] THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN ASM_MESON_TAC[IN_SUPPORT]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_SUPPORT]]]);; + +let ITERATE_BIJECTION = prove + (`!op. monoidal op + ==> !f:A->B p s. + (!x. x IN s ==> p(x) IN s) /\ + (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) + ==> iterate op s f = iterate op s (f o p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `iterate op (IMAGE (p:A->A) s) (f:A->B)` THEN CONJ_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (INST_TYPE [aty,bty] ITERATE_IMAGE))] THEN + ASM_MESON_TAC[]);; + +let ITERATE_ITERATE_PRODUCT = prove + (`!op. monoidal op + ==> !s:A->bool t:A->B->bool x:A->B->C. + FINITE s /\ (!i. i IN s ==> FINITE(t i)) + ==> iterate op s (\i. iterate op (t i) (x i)) = + iterate op {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[NOT_IN_EMPTY; SET_RULE `{a,b | F} = {}`; ITERATE_CLAUSES] THEN + REWRITE_TAC[SET_RULE `{i,j | i IN a INSERT s /\ j IN t i} = + IMAGE (\j. a,j) (t a) UNION {i,j | i IN s /\ j IN t i}`] THEN + ASM_SIMP_TAC[FINITE_INSERT; ITERATE_CLAUSES; IN_INSERT] THEN + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) (MATCH_MP ITERATE_UNION th) o + rand o snd)) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_PRODUCT_DEPENDENT; IN_INSERT] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_IMAGE; IN_INTER; NOT_IN_EMPTY; + IN_ELIM_THM; EXISTS_PAIR_THM; FORALL_PAIR_THM; PAIR_EQ] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_ASSUM(fun th -> + W(MP_TAC o PART_MATCH (lhand o rand) (MATCH_MP ITERATE_IMAGE th) o + rand o snd)) THEN + ANTS_TAC THENL + [SIMP_TAC[FORALL_PAIR_THM] THEN CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + ASM_SIMP_TAC[PAIR_EQ]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REWRITE_TAC[ETA_AX]]);; + +let ITERATE_EQ = prove + (`!op. monoidal op + ==> !f:A->B g s. + (!x. x IN s ==> f x = g x) ==> iterate op s f = iterate op s g`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + SUBGOAL_THEN `support op g s = support op (f:A->B) s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_SUPPORT] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `FINITE(support op (f:A->B) s) /\ + (!x. x IN (support op f s) ==> f x = g x)` + MP_TAC THENL [ASM_MESON_TAC[IN_SUPPORT]; REWRITE_TAC[IMP_CONJ]] THEN + SPEC_TAC(`support op (f:A->B) s`,`t:A->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN ASM_SIMP_TAC[ITERATE_CLAUSES] THEN + MESON_TAC[IN_INSERT]);; + +let ITERATE_EQ_GENERAL = prove + (`!op. monoidal op + ==> !s:A->bool t:B->bool f:A->C g h. + (!y. y IN t ==> ?!x. x IN s /\ h(x) = y) /\ + (!x. x IN s ==> h(x) IN t /\ g(h x) = f x) + ==> iterate op s f = iterate op t g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `t = IMAGE (h:A->B) s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `iterate op s ((g:B->C) o (h:A->B))` THEN CONJ_TAC THENL + [ASM_MESON_TAC[ITERATE_EQ; o_THM]; + CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_IMAGE) THEN + ASM_MESON_TAC[]]);; + +let ITERATE_EQ_GENERAL_INVERSES = prove + (`!op. monoidal op + ==> !s:A->bool t:B->bool f:A->C g h k. + (!y. y IN t ==> k(y) IN s /\ h(k y) = y) /\ + (!x. x IN s ==> h(x) IN t /\ k(h x) = x /\ g(h x) = f x) + ==> iterate op s f = iterate op t g`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ_GENERAL) THEN + EXISTS_TAC `h:A->B` THEN ASM_MESON_TAC[]);; + +let ITERATE_INJECTION = prove + (`!op. monoidal op + ==> !f:A->B p:A->A s. + FINITE s /\ + (!x. x IN s ==> p x IN s) /\ + (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) + ==> iterate op s (f o p) = iterate op s f`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_BIJECTION) THEN + MP_TAC(ISPECL [`s:A->bool`; `p:A->A`] SURJECTIVE_IFF_INJECTIVE) THEN + ASM_REWRITE_TAC[SUBSET; IN_IMAGE] THEN ASM_MESON_TAC[]);; + +let ITERATE_UNION_NONZERO = prove + (`!op. monoidal op + ==> !f:A->B s t. + FINITE(s) /\ FINITE(t) /\ + (!x. x IN (s INTER t) ==> f x = neutral(op)) + ==> iterate op (s UNION t) f = + op (iterate op s f) (iterate op t f)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN + REWRITE_TAC[SUPPORT_CLAUSES] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_UNION) THEN + ASM_SIMP_TAC[FINITE_SUPPORT; DISJOINT; IN_INTER; IN_SUPPORT; EXTENSION] THEN + ASM_MESON_TAC[IN_INTER; NOT_IN_EMPTY]);; + +let ITERATE_OP = prove + (`!op. monoidal op + ==> !f g s. FINITE s + ==> iterate op s (\x. op (f x) (g x)) = + op (iterate op s f) (iterate op s g)`, + GEN_TAC THEN DISCH_TAC THEN + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; MONOIDAL_AC]);; + +let ITERATE_SUPERSET = prove + (`!op. monoidal op + ==> !f:A->B u v. + u SUBSET v /\ + (!x. x IN v /\ ~(x IN u) ==> f(x) = neutral op) + ==> iterate op v f = iterate op u f`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[support; EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]);; + +let ITERATE_IMAGE_NONZERO = prove + (`!op. monoidal op + ==> !g:B->C f:A->B s. + FINITE s /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) /\ f x = f y + ==> g(f x) = neutral op) + ==> iterate op (IMAGE f s) g = iterate op s (g o f)`, + GEN_TAC THEN DISCH_TAC THEN + GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[IMAGE_CLAUSES; ITERATE_CLAUSES; FINITE_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `iterate op s ((g:B->C) o (f:A->B)) = iterate op (IMAGE f s) g` + SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[o_THM] THEN + SUBGOAL_THEN `(g:B->C) ((f:A->B) a) = neutral op` SUBST1_TAC THEN + ASM_MESON_TAC[MONOIDAL_AC]);; + +let ITERATE_CASES = prove + (`!op. monoidal op + ==> !s P f g:A->B. + FINITE s + ==> iterate op s (\x. if P x then f x else g x) = + op (iterate op {x | x IN s /\ P x} f) + (iterate op {x | x IN s /\ ~P x} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `op (iterate op {x | x IN s /\ P x} (\x. if P x then f x else (g:A->B) x)) + (iterate op {x | x IN s /\ ~P x} (\x. if P x then f x else g x))` THEN + CONJ_TAC THENL + [FIRST_ASSUM(fun th -> ASM_SIMP_TAC[GSYM(MATCH_MP ITERATE_UNION th); + FINITE_RESTRICT; + SET_RULE `DISJOINT {x | x IN s /\ P x} {x | x IN s /\ ~P x}`]) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]; + BINOP_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_EQ) THEN + SIMP_TAC[IN_ELIM_THM]]);; + +let ITERATE_OP_GEN = prove + (`!op. monoidal op + ==> !f g:A->B s. + FINITE(support op f s) /\ FINITE(support op g s) + ==> iterate op s (\x. op (f x) (g x)) = + op (iterate op s f) (iterate op s g)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM ITERATE_SUPPORT] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `iterate op (support op f s UNION support op g s) + (\x. op ((f:A->B) x) (g x))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV; + ASM_SIMP_TAC[ITERATE_OP; FINITE_UNION] THEN BINOP_TAC] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP ITERATE_SUPERSET) THEN + REWRITE_TAC[support; IN_ELIM_THM; SUBSET; IN_UNION] THEN + ASM_MESON_TAC[monoidal]);; + +let ITERATE_CLAUSES_NUMSEG = prove + (`!op. monoidal op + ==> (!m. iterate op (m..0) f = if m = 0 then f(0) else neutral op) /\ + (!m n. iterate op (m..SUC n) f = + if m <= SUC n then op (iterate op (m..n) f) (f(SUC n)) + else iterate op (m..n) f)`, + REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[ITERATE_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; FINITE_EMPTY] THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[monoidal]);; + +let ITERATE_PAIR = prove + (`!op. monoidal op + ==> !f m n. iterate op (2*m..2*n+1) f = + iterate op (m..n) (\i. op (f(2*i)) (f(2*i+1)))`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN GEN_TAC THEN + INDUCT_TAC THEN CONV_TAC NUM_REDUCE_CONV THENL + [ASM_SIMP_TAC[num_CONV `1`; ITERATE_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `2 * m <= SUC 0 <=> m = 0`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MULT_EQ_0; ARITH]; + REWRITE_TAC[ARITH_RULE `2 * SUC n + 1 = SUC(SUC(2 * n + 1))`] THEN + ASM_SIMP_TAC[ITERATE_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `2 * m <= SUC(SUC(2 * n + 1)) <=> m <= SUC n`; + ARITH_RULE `2 * m <= SUC(2 * n + 1) <=> m <= SUC n`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `2 * SUC n = SUC(2 * n + 1)`; + ARITH_RULE `2 * SUC n + 1 = SUC(SUC(2 * n + 1))`] THEN + ASM_MESON_TAC[monoidal]]);; + +(* ------------------------------------------------------------------------- *) +(* Sums of natural numbers. *) +(* ------------------------------------------------------------------------- *) + +prioritize_num();; + +let nsum = new_definition + `nsum = iterate (+)`;; + +let NEUTRAL_ADD = prove + (`neutral((+):num->num->num) = 0`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[ADD_CLAUSES]);; + +let NEUTRAL_MUL = prove + (`neutral(( * ):num->num->num) = 1`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[MULT_CLAUSES; MULT_EQ_1]);; + +let MONOIDAL_ADD = prove + (`monoidal((+):num->num->num)`, + REWRITE_TAC[monoidal; NEUTRAL_ADD] THEN ARITH_TAC);; + +let MONOIDAL_MUL = prove + (`monoidal(( * ):num->num->num)`, + REWRITE_TAC[monoidal; NEUTRAL_MUL] THEN ARITH_TAC);; + +let NSUM_DEGENERATE = prove + (`!f s. ~(FINITE {x | x IN s /\ ~(f x = 0)}) ==> nsum s f = 0`, + REPEAT GEN_TAC THEN REWRITE_TAC[nsum] THEN + SIMP_TAC[iterate; support; NEUTRAL_ADD]);; + +let NSUM_CLAUSES = prove + (`(!f. nsum {} f = 0) /\ + (!x f s. FINITE(s) + ==> (nsum (x INSERT s) f = + if x IN s then nsum s f else f(x) + nsum s f))`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_UNION = prove + (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t + ==> (nsum (s UNION t) f = nsum s f + nsum t f)`, + SIMP_TAC[nsum; ITERATE_UNION; MONOIDAL_ADD]);; + +let NSUM_DIFF = prove + (`!f s t. FINITE s /\ t SUBSET s + ==> (nsum (s DIFF t) f = nsum s f - nsum t f)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ARITH_RULE `(x + z = y:num) ==> (x = y - z)`) THEN + ASM_SIMP_TAC[nsum; ITERATE_DIFF; MONOIDAL_ADD]);; + +let NSUM_INCL_EXCL = prove + (`!s t (f:A->num). + FINITE s /\ FINITE t + ==> nsum s f + nsum t f = nsum (s UNION t) f + nsum (s INTER t) f`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + MATCH_MP_TAC ITERATE_INCL_EXCL THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_SUPPORT = prove + (`!f s. nsum (support (+) f s) f = nsum s f`, + SIMP_TAC[nsum; iterate; SUPPORT_SUPPORT]);; + +let NSUM_ADD = prove + (`!f g s. FINITE s ==> (nsum s (\x. f(x) + g(x)) = nsum s f + nsum s g)`, + SIMP_TAC[nsum; ITERATE_OP; MONOIDAL_ADD]);; + +let NSUM_ADD_GEN = prove + (`!f g s. + FINITE {x | x IN s /\ ~(f x = 0)} /\ FINITE {x | x IN s /\ ~(g x = 0)} + ==> nsum s (\x. f x + g x) = nsum s f + nsum s g`, + REWRITE_TAC[GSYM NEUTRAL_ADD; GSYM support; nsum] THEN + MATCH_MP_TAC ITERATE_OP_GEN THEN ACCEPT_TAC MONOIDAL_ADD);; + +let NSUM_EQ_0 = prove + (`!f s. (!x:A. x IN s ==> (f(x) = 0)) ==> (nsum s f = 0)`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_ADD]);; + +let NSUM_0 = prove + (`!s:A->bool. nsum s (\n. 0) = 0`, + SIMP_TAC[NSUM_EQ_0]);; + +let NSUM_LMUL = prove + (`!f c s:A->bool. nsum s (\x. c * f(x)) = c * nsum s f`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; NSUM_0] THEN REWRITE_TAC[nsum] THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + SUBGOAL_THEN `support (+) (\x:A. c * f(x)) s = support (+) f s` SUBST1_TAC + THENL [ASM_SIMP_TAC[support; MULT_EQ_0; NEUTRAL_ADD]; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[NEUTRAL_ADD; MULT_CLAUSES] THEN + UNDISCH_TAC `FINITE (support (+) f (s:A->bool))` THEN + SPEC_TAC(`support (+) f (s:A->bool)`,`t:A->bool`) THEN + REWRITE_TAC[GSYM nsum] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NSUM_CLAUSES; MULT_CLAUSES; LEFT_ADD_DISTRIB]);; + +let NSUM_RMUL = prove + (`!f c s:A->bool. nsum s (\x. f(x) * c) = nsum s f * c`, + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[NSUM_LMUL]);; + +let NSUM_LE = prove + (`!f g s. FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) + ==> nsum s f <= nsum s g`, + ONCE_REWRITE_TAC[IMP_CONJ] THEN + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NSUM_CLAUSES; LE_REFL; LE_ADD2; IN_INSERT]);; + +let NSUM_LT = prove + (`!f g s:A->bool. + FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) /\ + (?x. x IN s /\ f(x) < g(x)) + ==> nsum s f < nsum s g`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL + [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[NSUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + ASM_SIMP_TAC[LTE_ADD2; NSUM_LE; IN_DELETE; FINITE_DELETE]);; + +let NSUM_LT_ALL = prove + (`!f g s. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < g(x)) + ==> nsum s f < nsum s g`, + MESON_TAC[MEMBER_NOT_EMPTY; LT_IMP_LE; NSUM_LT]);; + +let NSUM_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (nsum s f = nsum s g)`, + REWRITE_TAC[nsum] THEN + MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_CONST = prove + (`!c s. FINITE s ==> (nsum s (\n. c) = (CARD s) * c)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NSUM_CLAUSES; CARD_CLAUSES] THEN + REPEAT STRIP_TAC THEN ARITH_TAC);; + +let NSUM_POS_BOUND = prove + (`!f b s. FINITE s /\ nsum s f <= b ==> !x:A. x IN s ==> f x <= b`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NSUM_CLAUSES; NOT_IN_EMPTY; IN_INSERT] THEN + MESON_TAC[LE_0; ARITH_RULE + `0 <= x /\ 0 <= y /\ x + y <= b ==> x <= b /\ y <= b`]);; + +let NSUM_EQ_0_IFF = prove + (`!s. FINITE s ==> (nsum s f = 0 <=> !x. x IN s ==> f x = 0)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[NSUM_EQ_0] THEN + ASM_MESON_TAC[ARITH_RULE `n = 0 <=> n <= 0`; NSUM_POS_BOUND]);; + +let NSUM_POS_LT = prove + (`!f s:A->bool. + FINITE s /\ (?x. x IN s /\ 0 < f x) + ==> 0 < nsum s f`, + SIMP_TAC[ARITH_RULE `0 < n <=> ~(n = 0)`; NSUM_EQ_0_IFF] THEN MESON_TAC[]);; + +let NSUM_POS_LT_ALL = prove + (`!s f:A->num. + FINITE s /\ ~(s = {}) /\ (!i. i IN s ==> 0 < f i) ==> 0 < nsum s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_POS_LT THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE]);; + +let NSUM_DELETE = prove + (`!f s a. FINITE s /\ a IN s ==> f(a) + nsum(s DELETE a) f = nsum s f`, + SIMP_TAC[nsum; ITERATE_DELETE; MONOIDAL_ADD]);; + +let NSUM_SING = prove + (`!f x. nsum {x} f = f(x)`, + SIMP_TAC[NSUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; ADD_CLAUSES]);; + +let NSUM_DELTA = prove + (`!s a. nsum s (\x. if x = a:A then b else 0) = if a IN s then b else 0`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + SIMP_TAC[ITERATE_DELTA; MONOIDAL_ADD]);; + +let NSUM_SWAP = prove + (`!f:A->B->num s t. + FINITE(s) /\ FINITE(t) + ==> (nsum s (\i. nsum t (f i)) = nsum t (\j. nsum s (\i. f i j)))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NSUM_CLAUSES; NSUM_0; NSUM_ADD; ETA_AX]);; + +let NSUM_IMAGE = prove + (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> (nsum (IMAGE f s) g = nsum s (g o f))`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_SUPERSET = prove + (`!f:A->num u v. + u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = 0)) + ==> (nsum v f = nsum u f)`, + SIMP_TAC[nsum; GSYM NEUTRAL_ADD; ITERATE_SUPERSET; MONOIDAL_ADD]);; + +let NSUM_UNION_RZERO = prove + (`!f:A->num u v. + FINITE u /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = 0)) + ==> (nsum (u UNION v) f = nsum u f)`, + let lemma = prove(`u UNION v = u UNION (v DIFF u)`,SET_TAC[]) in + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[lemma] THEN + MATCH_MP_TAC NSUM_SUPERSET THEN ASM_MESON_TAC[IN_UNION; IN_DIFF; SUBSET]);; + +let NSUM_UNION_LZERO = prove + (`!f:A->num u v. + FINITE v /\ (!x. x IN u /\ ~(x IN v) ==> (f(x) = 0)) + ==> (nsum (u UNION v) f = nsum v f)`, + MESON_TAC[NSUM_UNION_RZERO; UNION_COMM]);; + +let NSUM_RESTRICT = prove + (`!f s. FINITE s ==> (nsum s (\x. if x IN s then f(x) else 0) = nsum s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ THEN ASM_SIMP_TAC[]);; + +let NSUM_BOUND = prove + (`!s f b. FINITE s /\ (!x:A. x IN s ==> f(x) <= b) + ==> nsum s f <= (CARD s) * b`, + SIMP_TAC[GSYM NSUM_CONST; NSUM_LE]);; + +let NSUM_BOUND_GEN = prove + (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) <= b DIV (CARD s)) + ==> nsum s f <= b`, + SIMP_TAC[IMP_CONJ; CARD_EQ_0; LE_RDIV_EQ] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `nsum s (\x. CARD(s:A->bool) * f x) <= CARD s * b` MP_TAC THENL + [ASM_SIMP_TAC[NSUM_BOUND]; + ASM_SIMP_TAC[NSUM_LMUL; LE_MULT_LCANCEL; CARD_EQ_0]]);; + +let NSUM_BOUND_LT = prove + (`!s f b. FINITE s /\ (!x:A. x IN s ==> f x <= b) /\ (?x. x IN s /\ f x < b) + ==> nsum s f < (CARD s) * b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `nsum s (\x:A. b)` THEN CONJ_TAC THENL + [MATCH_MP_TAC NSUM_LT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ASM_SIMP_TAC[NSUM_CONST; LE_REFL]]);; + +let NSUM_BOUND_LT_ALL = prove + (`!s f b. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < b) + ==> nsum s f < (CARD s) * b`, + MESON_TAC[MEMBER_NOT_EMPTY; LT_IMP_LE; NSUM_BOUND_LT]);; + +let NSUM_BOUND_LT_GEN = prove + (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) < b DIV (CARD s)) + ==> nsum s f < b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LTE_TRANS THEN + EXISTS_TAC `nsum (s:A->bool) (\a. f(a) + 1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC NSUM_LT_ALL THEN ASM_SIMP_TAC[] THEN ARITH_TAC; + MATCH_MP_TAC NSUM_BOUND_GEN THEN + ASM_REWRITE_TAC[ARITH_RULE `a + 1 <= b <=> a < b`]]);; + +let NSUM_UNION_EQ = prove + (`!s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) + ==> (nsum s f + nsum t f = nsum u f)`, + MESON_TAC[NSUM_UNION; DISJOINT; FINITE_SUBSET; SUBSET_UNION]);; + +let NSUM_EQ_SUPERSET = prove + (`!f s t:A->bool. + FINITE t /\ t SUBSET s /\ + (!x. x IN t ==> (f x = g x)) /\ + (!x. x IN s /\ ~(x IN t) ==> (f(x) = 0)) + ==> (nsum s f = nsum t g)`, + MESON_TAC[NSUM_SUPERSET; NSUM_EQ]);; + +let NSUM_RESTRICT_SET = prove + (`!P s f. nsum {x:A | x IN s /\ P x} f = nsum s (\x. if P x then f(x) else 0)`, + ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_ADD; IN_ELIM_THM] THEN + REWRITE_TAC[MESON[] `~((if P x then f x else a) = a) <=> P x /\ ~(f x = a)`; + GSYM CONJ_ASSOC] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC NSUM_EQ THEN SIMP_TAC[IN_ELIM_THM]);; + +let NSUM_NSUM_RESTRICT = prove + (`!R f s t. + FINITE s /\ FINITE t + ==> (nsum s (\x. nsum {y | y IN t /\ R x y} (\y. f x y)) = + nsum t (\y. nsum {x | x IN s /\ R x y} (\x. f x y)))`, + REPEAT GEN_TAC THEN SIMP_TAC[NSUM_RESTRICT_SET] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP NSUM_SWAP th]));; + +let CARD_EQ_NSUM = prove + (`!s. FINITE s ==> ((CARD s) = nsum s (\x. 1))`, + SIMP_TAC[NSUM_CONST; MULT_CLAUSES]);; + +let NSUM_MULTICOUNT_GEN = prove + (`!R:A->B->bool s t k. + FINITE s /\ FINITE t /\ + (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k(j))) + ==> (nsum s (\i. (CARD {j | j IN t /\ R i j})) = + nsum t (\i. (k i)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `nsum s (\i:A. nsum {j:B | j IN t /\ R i j} (\j. 1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NSUM_EQ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARD_EQ_NSUM; FINITE_RESTRICT]; + FIRST_ASSUM(fun t -> ONCE_REWRITE_TAC[MATCH_MP NSUM_NSUM_RESTRICT t]) THEN + MATCH_MP_TAC NSUM_EQ THEN ASM_SIMP_TAC[NSUM_CONST; FINITE_RESTRICT] THEN + REWRITE_TAC[MULT_CLAUSES]]);; + +let NSUM_MULTICOUNT = prove + (`!R:A->B->bool s t k. + FINITE s /\ FINITE t /\ + (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k)) + ==> (nsum s (\i. (CARD {j | j IN t /\ R i j})) = (k * CARD t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `nsum t (\i:B. k)` THEN CONJ_TAC THENL + [MATCH_MP_TAC NSUM_MULTICOUNT_GEN THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[NSUM_CONST] THEN REWRITE_TAC[MULT_AC]]);; + +let NSUM_IMAGE_GEN = prove + (`!f:A->B g s. + FINITE s + ==> (nsum s g = + nsum (IMAGE f s) (\y. nsum {x | x IN s /\ (f(x) = y)} g))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `nsum s (\x:A. nsum {y:B | y IN IMAGE f s /\ (f x = y)} (\y. g x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NSUM_EQ THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:A` THEN + DISCH_TAC THEN + SUBGOAL_THEN `{y | y IN IMAGE (f:A->B) s /\ (f x = y)} = {(f x)}` + (fun th -> REWRITE_TAC[th; NSUM_SING; o_THM]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_IMAGE] THEN + ASM_MESON_TAC[]; + GEN_REWRITE_TAC (funpow 2 RAND_CONV o ABS_CONV o RAND_CONV) + [GSYM ETA_AX] THEN + ASM_SIMP_TAC[NSUM_NSUM_RESTRICT; FINITE_IMAGE]]);; + +let NSUM_GROUP = prove + (`!f:A->B g s t. + FINITE s /\ IMAGE f s SUBSET t + ==> nsum t (\y. nsum {x | x IN s /\ f(x) = y} g) = nsum s g`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->B`; `g:A->num`; `s:A->bool`] NSUM_IMAGE_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC NSUM_SUPERSET THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ_0 THEN ASM SET_TAC[]);; + +let NSUM_SUBSET = prove + (`!u v f. FINITE u /\ FINITE v /\ (!x:A. x IN (u DIFF v) ==> f(x) = 0) + ==> nsum u f <= nsum v f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->num`; `u INTER v :A->bool`] NSUM_UNION) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `v DIFF u :A->bool` th) THEN + MP_TAC(SPEC `u DIFF v :A->bool` th)) THEN + REWRITE_TAC[SET_RULE `(u INTER v) UNION (u DIFF v) = u`; + SET_RULE `(u INTER v) UNION (v DIFF u) = v`] THEN + ASM_SIMP_TAC[FINITE_DIFF; FINITE_INTER] THEN + REPEAT(ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN + ASM_SIMP_TAC[NSUM_EQ_0] THEN ARITH_TAC);; + +let NSUM_SUBSET_SIMPLE = prove + (`!u v f. FINITE v /\ u SUBSET v ==> nsum u f <= nsum v f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_SUBSET THEN + ASM_MESON_TAC[IN_DIFF; SUBSET; FINITE_SUBSET]);; + +let NSUM_LE_GEN = prove + (`!f g s. (!x:A. x IN s ==> f x <= g x) /\ FINITE {x | x IN s /\ ~(g x = 0)} + ==> nsum s f <= nsum s g`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM NSUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_ADD] THEN + TRANS_TAC LE_TRANS `nsum {x | x IN s /\ ~(g(x:A) = 0)} f` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NSUM_SUBSET THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_DIFF] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[LE]] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + FINITE_SUBSET)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[LE]; + MATCH_MP_TAC NSUM_LE THEN ASM_SIMP_TAC[IN_ELIM_THM]]);; + +let NSUM_IMAGE_NONZERO = prove + (`!d:B->num i:A->B s. + FINITE s /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = 0) + ==> nsum (IMAGE i s) d = nsum s (d o i)`, + REWRITE_TAC[GSYM NEUTRAL_ADD; nsum] THEN + MATCH_MP_TAC ITERATE_IMAGE_NONZERO THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_BIJECTION = prove + (`!f p s:A->bool. + (!x. x IN s ==> p(x) IN s) /\ + (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) + ==> nsum s f = nsum s (f o p)`, + REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_BIJECTION THEN + REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_NSUM_PRODUCT = prove + (`!s:A->bool t:A->B->bool x. + FINITE s /\ (!i. i IN s ==> FINITE(t i)) + ==> nsum s (\i. nsum (t i) (x i)) = + nsum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, + REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_ITERATE_PRODUCT THEN + REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_EQ_GENERAL = prove + (`!s:A->bool t:B->bool f g h. + (!y. y IN t ==> ?!x. x IN s /\ h(x) = y) /\ + (!x. x IN s ==> h(x) IN t /\ g(h x) = f x) + ==> nsum s f = nsum t g`, + REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL THEN + REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_EQ_GENERAL_INVERSES = prove + (`!s:A->bool t:B->bool f g h k. + (!y. y IN t ==> k(y) IN s /\ h(k y) = y) /\ + (!x. x IN s ==> h(x) IN t /\ k(h x) = x /\ g(h x) = f x) + ==> nsum s f = nsum t g`, + REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL_INVERSES THEN + REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_INJECTION = prove + (`!f p s. FINITE s /\ + (!x. x IN s ==> p x IN s) /\ + (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) + ==> nsum s (f o p) = nsum s f`, + REWRITE_TAC[nsum] THEN MATCH_MP_TAC ITERATE_INJECTION THEN + REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_UNION_NONZERO = prove + (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = 0) + ==> nsum (s UNION t) f = nsum s f + nsum t f`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + MATCH_MP_TAC ITERATE_UNION_NONZERO THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_UNIONS_NONZERO = prove + (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\ + (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 + ==> f x = 0) + ==> nsum (UNIONS s) f = nsum s (\t. nsum t f)`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NSUM_CLAUSES; IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[NSUM_CLAUSES] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN + STRIP_TAC THEN MATCH_MP_TAC NSUM_UNION_NONZERO THEN + ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);; + +let NSUM_CASES = prove + (`!s P f g. FINITE s + ==> nsum s (\x:A. if P x then f x else g x) = + nsum {x | x IN s /\ P x} f + nsum {x | x IN s /\ ~P x} g`, + REWRITE_TAC[nsum; GSYM NEUTRAL_ADD] THEN + MATCH_MP_TAC ITERATE_CASES THEN REWRITE_TAC[MONOIDAL_ADD]);; + +let NSUM_CLOSED = prove + (`!P f:A->num s. + P(0) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!a. a IN s ==> P(f a)) + ==> P(nsum s f)`, + REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_ADD) THEN + DISCH_THEN(MP_TAC o SPEC `P:num->bool`) THEN + ASM_SIMP_TAC[NEUTRAL_ADD; GSYM nsum]);; + +let NSUM_ADD_NUMSEG = prove + (`!f g m n. nsum(m..n) (\i. f(i) + g(i)) = nsum(m..n) f + nsum(m..n) g`, + SIMP_TAC[NSUM_ADD; FINITE_NUMSEG]);; + +let NSUM_LE_NUMSEG = prove + (`!f g m n. (!i. m <= i /\ i <= n ==> f(i) <= g(i)) + ==> nsum(m..n) f <= nsum(m..n) g`, + SIMP_TAC[NSUM_LE; FINITE_NUMSEG; IN_NUMSEG]);; + +let NSUM_EQ_NUMSEG = prove + (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) + ==> (nsum(m..n) f = nsum(m..n) g)`, + MESON_TAC[NSUM_EQ; FINITE_NUMSEG; IN_NUMSEG]);; + +let NSUM_CONST_NUMSEG = prove + (`!c m n. nsum(m..n) (\n. c) = ((n + 1) - m) * c`, + SIMP_TAC[NSUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);; + +let NSUM_EQ_0_NUMSEG = prove + (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = 0)) ==> (nsum(m..n) f = 0)`, + SIMP_TAC[NSUM_EQ_0; IN_NUMSEG]);; + +let NSUM_EQ_0_IFF_NUMSEG = prove + (`!f m n. nsum (m..n) f = 0 <=> !i. m <= i /\ i <= n ==> f i = 0`, + SIMP_TAC[NSUM_EQ_0_IFF; FINITE_NUMSEG; IN_NUMSEG]);; + +let NSUM_TRIV_NUMSEG = prove + (`!f m n. n < m ==> (nsum(m..n) f = 0)`, + MESON_TAC[NSUM_EQ_0_NUMSEG; LE_TRANS; NOT_LT]);; + +let NSUM_SING_NUMSEG = prove + (`!f n. nsum(n..n) f = f(n)`, + SIMP_TAC[NSUM_SING; NUMSEG_SING]);; + +let NSUM_CLAUSES_NUMSEG = prove + (`(!m. nsum(m..0) f = if m = 0 then f(0) else 0) /\ + (!m n. nsum(m..SUC n) f = if m <= SUC n then nsum(m..n) f + f(SUC n) + else nsum(m..n) f)`, + MP_TAC(MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_ADD) THEN + REWRITE_TAC[NEUTRAL_ADD; nsum]);; + +let NSUM_SWAP_NUMSEG = prove + (`!a b c d f. + nsum(a..b) (\i. nsum(c..d) (f i)) = + nsum(c..d) (\j. nsum(a..b) (\i. f i j))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NSUM_SWAP THEN REWRITE_TAC[FINITE_NUMSEG]);; + +let NSUM_ADD_SPLIT = prove + (`!f m n p. + m <= n + 1 ==> (nsum (m..(n+p)) f = nsum(m..n) f + nsum(n+1..n+p) f)`, + SIMP_TAC[NUMSEG_ADD_SPLIT; NSUM_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; + ARITH_RULE `x < x + 1`]);; + +let NSUM_OFFSET = prove + (`!p f m n. nsum(m+p..n+p) f = nsum(m..n) (\i. f(i + p))`, + SIMP_TAC[NUMSEG_OFFSET_IMAGE; NSUM_IMAGE; EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[o_DEF]);; + +let NSUM_OFFSET_0 = prove + (`!f m n. m <= n ==> (nsum(m..n) f = nsum(0..n-m) (\i. f(i + m)))`, + SIMP_TAC[GSYM NSUM_OFFSET; ADD_CLAUSES; SUB_ADD]);; + +let NSUM_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> nsum(m..n) f = f(m) + nsum(m+1..n) f`, + SIMP_TAC[GSYM NUMSEG_LREC; NSUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ARITH_TAC);; + +let NSUM_CLAUSES_RIGHT = prove + (`!f m n. 0 < n /\ m <= n ==> nsum(m..n) f = nsum(m..n-1) f + f(n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LT_REFL; NSUM_CLAUSES_NUMSEG; SUC_SUB1]);; + +let NSUM_PAIR = prove + (`!f m n. nsum(2*m..2*n+1) f = nsum(m..n) (\i. f(2*i) + f(2*i+1))`, + MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_ADD) THEN + REWRITE_TAC[nsum; NEUTRAL_ADD]);; + +let MOD_NSUM_MOD = prove + (`!f:A->num n s. + FINITE s /\ ~(n = 0) + ==> (nsum s f) MOD n = nsum s (\i. f(i) MOD n) MOD n`, + GEN_TAC THEN GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN SIMP_TAC[NSUM_CLAUSES] THEN + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) MOD_ADD_MOD o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + W(MP_TAC o PART_MATCH (rand o rand) MOD_ADD_MOD o rand o snd) THEN + ASM_SIMP_TAC[MOD_MOD_REFL]);; + +let MOD_NSUM_MOD_NUMSEG = prove + (`!f a b n. + ~(n = 0) + ==> (nsum(a..b) f) MOD n = nsum(a..b) (\i. f i MOD n) MOD n`, + MESON_TAC[MOD_NSUM_MOD; FINITE_NUMSEG]);; + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> nsum s (\i. f(i)) = nsum s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> nsum(a..b) (\i. f(i)) = nsum(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> nsum {y | p y} (\i. f(i)) = nsum {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NSUM_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; + +(* ------------------------------------------------------------------------- *) +(* Thanks to finite sums, we can express cardinality of finite union. *) +(* ------------------------------------------------------------------------- *) + +let CARD_UNIONS = prove + (`!s:(A->bool)->bool. + FINITE s /\ (!t. t IN s ==> FINITE t) /\ + (!t u. t IN s /\ u IN s /\ ~(t = u) ==> t INTER u = {}) + ==> CARD(UNIONS s) = nsum s CARD`, + ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NOT_IN_EMPTY; IN_INSERT] THEN + REWRITE_TAC[CARD_CLAUSES; NSUM_CLAUSES] THEN + MAP_EVERY X_GEN_TAC [`t:A->bool`; `f:(A->bool)->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_SIMP_TAC[NSUM_CLAUSES] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN + ASM_SIMP_TAC[FINITE_UNIONS; FINITE_UNION; INTER_UNIONS] THEN + REWRITE_TAC[EMPTY_UNIONS; IN_ELIM_THM] THEN ASM MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Sums of real numbers. *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let sum = new_definition + `sum = iterate (+)`;; + +let NEUTRAL_REAL_ADD = prove + (`neutral((+):real->real->real) = &0`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[REAL_ADD_LID; REAL_ADD_RID]);; + +let NEUTRAL_REAL_MUL = prove + (`neutral(( * ):real->real->real) = &1`, + REWRITE_TAC[neutral] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + MESON_TAC[REAL_MUL_LID; REAL_MUL_RID]);; + +let MONOIDAL_REAL_ADD = prove + (`monoidal((+):real->real->real)`, + REWRITE_TAC[monoidal; NEUTRAL_REAL_ADD] THEN REAL_ARITH_TAC);; + +let MONOIDAL_REAL_MUL = prove + (`monoidal(( * ):real->real->real)`, + REWRITE_TAC[monoidal; NEUTRAL_REAL_MUL] THEN REAL_ARITH_TAC);; + +let SUM_DEGENERATE = prove + (`!f s. ~(FINITE {x | x IN s /\ ~(f x = &0)}) ==> sum s f = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[sum] THEN + SIMP_TAC[iterate; support; NEUTRAL_REAL_ADD]);; + +let SUM_CLAUSES = prove + (`(!f. sum {} f = &0) /\ + (!x f s. FINITE(s) + ==> (sum (x INSERT s) f = + if x IN s then sum s f else f(x) + sum s f))`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + MATCH_MP_TAC ITERATE_CLAUSES THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_UNION = prove + (`!f s t. FINITE s /\ FINITE t /\ DISJOINT s t + ==> (sum (s UNION t) f = sum s f + sum t f)`, + SIMP_TAC[sum; ITERATE_UNION; MONOIDAL_REAL_ADD]);; + +let SUM_DIFF = prove + (`!f s t. FINITE s /\ t SUBSET s ==> (sum (s DIFF t) f = sum s f - sum t f)`, + SIMP_TAC[REAL_EQ_SUB_LADD; sum; ITERATE_DIFF; MONOIDAL_REAL_ADD]);; + +let SUM_INCL_EXCL = prove + (`!s t (f:A->real). + FINITE s /\ FINITE t + ==> sum s f + sum t f = sum (s UNION t) f + sum (s INTER t) f`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + MATCH_MP_TAC ITERATE_INCL_EXCL THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_SUPPORT = prove + (`!f s. sum (support (+) f s) f = sum s f`, + SIMP_TAC[sum; iterate; SUPPORT_SUPPORT]);; + +let SUM_ADD = prove + (`!f g s. FINITE s ==> (sum s (\x. f(x) + g(x)) = sum s f + sum s g)`, + SIMP_TAC[sum; ITERATE_OP; MONOIDAL_REAL_ADD]);; + +let SUM_ADD_GEN = prove + (`!f g s. + FINITE {x | x IN s /\ ~(f x = &0)} /\ FINITE {x | x IN s /\ ~(g x = &0)} + ==> sum s (\x. f x + g x) = sum s f + sum s g`, + REWRITE_TAC[GSYM NEUTRAL_REAL_ADD; GSYM support; sum] THEN + MATCH_MP_TAC ITERATE_OP_GEN THEN ACCEPT_TAC MONOIDAL_REAL_ADD);; + +let SUM_EQ_0 = prove + (`!f s. (!x:A. x IN s ==> (f(x) = &0)) ==> (sum s f = &0)`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + SIMP_TAC[ITERATE_EQ_NEUTRAL; MONOIDAL_REAL_ADD]);; + +let SUM_0 = prove + (`!s:A->bool. sum s (\n. &0) = &0`, + SIMP_TAC[SUM_EQ_0]);; + +let SUM_LMUL = prove + (`!f c s:A->bool. sum s (\x. c * f(x)) = c * sum s f`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `c = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; SUM_0] THEN REWRITE_TAC[sum] THEN + ONCE_REWRITE_TAC[ITERATE_EXPAND_CASES] THEN + SUBGOAL_THEN `support (+) (\x:A. c * f(x)) s = support (+) f s` SUBST1_TAC + THENL [ASM_SIMP_TAC[support; REAL_ENTIRE; NEUTRAL_REAL_ADD]; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[NEUTRAL_REAL_ADD; REAL_MUL_RZERO] THEN + UNDISCH_TAC `FINITE (support (+) f (s:A->bool))` THEN + SPEC_TAC(`support (+) f (s:A->bool)`,`t:A->bool`) THEN + REWRITE_TAC[GSYM sum] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; REAL_MUL_RZERO; REAL_MUL_LZERO; + REAL_ADD_LDISTRIB]);; + +let SUM_RMUL = prove + (`!f c s:A->bool. sum s (\x. f(x) * c) = sum s f * c`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SUM_LMUL]);; + +let SUM_NEG = prove + (`!f s. sum s (\x. --(f(x))) = --(sum s f)`, + ONCE_REWRITE_TAC[REAL_ARITH `--x = --(&1) * x`] THEN + SIMP_TAC[SUM_LMUL]);; + +let SUM_SUB = prove + (`!f g s. FINITE s ==> (sum s (\x. f(x) - g(x)) = sum s f - sum s g)`, + ONCE_REWRITE_TAC[real_sub] THEN SIMP_TAC[SUM_NEG; SUM_ADD]);; + +let SUM_LE = prove + (`!f g s. FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) ==> sum s f <= sum s g`, + ONCE_REWRITE_TAC[IMP_CONJ] THEN + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; REAL_LE_REFL; REAL_LE_ADD2; IN_INSERT]);; + +let SUM_LT = prove + (`!f g s:A->bool. + FINITE(s) /\ (!x. x IN s ==> f(x) <= g(x)) /\ + (?x. x IN s /\ f(x) < g(x)) + ==> sum s f < sum s g`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `s = (a:A) INSERT (s DELETE a)` SUBST1_TAC THENL + [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + ASM_SIMP_TAC[REAL_LTE_ADD2; SUM_LE; IN_DELETE; FINITE_DELETE]);; + +let SUM_LT_ALL = prove + (`!f g s. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < g(x)) + ==> sum s f < sum s g`, + MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE; SUM_LT]);; + +let SUM_POS_LT = prove + (`!f s:A->bool. + FINITE s /\ + (!x. x IN s ==> &0 <= f x) /\ + (?x. x IN s /\ &0 < f x) + ==> &0 < sum s f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum (s:A->bool) (\i. &0)` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_0; REAL_LE_REFL]; MATCH_MP_TAC SUM_LT] THEN + ASM_MESON_TAC[]);; + +let SUM_POS_LT_ALL = prove + (`!s f:A->real. + FINITE s /\ ~(s = {}) /\ (!i. i IN s ==> &0 < f i) ==> &0 < sum s f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LT THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE]);; + +let SUM_EQ = prove + (`!f g s. (!x. x IN s ==> (f x = g x)) ==> (sum s f = sum s g)`, + REWRITE_TAC[sum] THEN + MATCH_MP_TAC ITERATE_EQ THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_ABS = prove + (`!f s. FINITE(s) ==> abs(sum s f) <= sum s (\x. abs(f x))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; REAL_ABS_NUM; REAL_LE_REFL; + REAL_ARITH `abs(a) <= b ==> abs(x + a) <= abs(x) + b`]);; + +let SUM_ABS_LE = prove + (`!f:A->real g s. + FINITE s /\ (!x. x IN s ==> abs(f x) <= g x) + ==> abs(sum s f) <= sum s g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum s (\x:A. abs(f x))` THEN + ASM_SIMP_TAC[SUM_ABS] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[]);; + +let SUM_CONST = prove + (`!c s. FINITE s ==> (sum s (\n. c) = &(CARD s) * c)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; CARD_CLAUSES; GSYM REAL_OF_NUM_SUC] THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC);; + +let SUM_POS_LE = prove + (`!s:A->bool. (!x. x IN s ==> &0 <= f x) ==> &0 <= sum s f`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `FINITE {x:A | x IN s /\ ~(f x = &0)}` THEN + ASM_SIMP_TAC[SUM_DEGENERATE; REAL_LE_REFL] THEN + ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN + MP_TAC(ISPECL [`\x:A. &0`; `f:A->real`; `{x:A | x IN s /\ ~(f x = &0)}`] + SUM_LE) THEN + ASM_SIMP_TAC[SUM_0; IN_ELIM_THM]);; + +let SUM_POS_BOUND = prove + (`!f b s. FINITE s /\ (!x. x IN s ==> &0 <= f x) /\ sum s f <= b + ==> !x:A. x IN s ==> f x <= b`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; NOT_IN_EMPTY; IN_INSERT] THEN + MESON_TAC[SUM_POS_LE; + REAL_ARITH `&0 <= x /\ &0 <= y /\ x + y <= b ==> x <= b /\ y <= b`]);; + +let SUM_POS_EQ_0 = prove + (`!f s. FINITE s /\ (!x. x IN s ==> &0 <= f x) /\ (sum s f = &0) + ==> !x. x IN s ==> f x = &0`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + MESON_TAC[SUM_POS_BOUND; SUM_POS_LE]);; + +let SUM_ZERO_EXISTS = prove + (`!(u:A->real) s. + FINITE s /\ sum s u = &0 + ==> (!i. i IN s ==> u i = &0) \/ + (?j k. j IN s /\ u j < &0 /\ k IN s /\ u k > &0)`, + REPEAT STRIP_TAC THEN REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (MESON[REAL_ARITH `(&0 <= --u <=> ~(u > &0)) /\ (&0 <= u <=> ~(u < &0))`] + `(?j k:A. j IN s /\ u j < &0 /\ k IN s /\ u k > &0) \/ + (!i. i IN s ==> &0 <= u i) \/ (!i. i IN s ==> &0 <= --(u i))`) THEN + ASM_REWRITE_TAC[] THEN DISJ1_TAC THENL + [ALL_TAC; ONCE_REWRITE_TAC[REAL_ARITH `x = &0 <=> --x = &0`]] THEN + MATCH_MP_TAC SUM_POS_EQ_0 THEN ASM_REWRITE_TAC[SUM_NEG; REAL_NEG_0]);; + +let SUM_DELETE = prove + (`!f s a. FINITE s /\ a IN s ==> sum (s DELETE a) f = sum s f - f(a)`, + SIMP_TAC[REAL_ARITH `y = z - x <=> x + y = z:real`; sum; ITERATE_DELETE; + MONOIDAL_REAL_ADD]);; + +let SUM_DELETE_CASES = prove + (`!f s a. FINITE s + ==> sum (s DELETE a) f = if a IN s then sum s f - f(a) + else sum s f`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SET_RULE `~(a IN s) ==> (s DELETE a = s)`; SUM_DELETE]);; + +let SUM_SING = prove + (`!f x. sum {x} f = f(x)`, + SIMP_TAC[SUM_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; REAL_ADD_RID]);; + +let SUM_DELTA = prove + (`!s a. sum s (\x. if x = a:A then b else &0) = if a IN s then b else &0`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + SIMP_TAC[ITERATE_DELTA; MONOIDAL_REAL_ADD]);; + +let SUM_SWAP = prove + (`!f:A->B->real s t. + FINITE(s) /\ FINITE(t) + ==> (sum s (\i. sum t (f i)) = sum t (\j. sum s (\i. f i j)))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; SUM_0; SUM_ADD; ETA_AX]);; + +let SUM_IMAGE = prove + (`!f g s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) + ==> (sum (IMAGE f s) g = sum s (g o f))`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + MATCH_MP_TAC ITERATE_IMAGE THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_SUPERSET = prove + (`!f:A->real u v. + u SUBSET v /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = &0)) + ==> (sum v f = sum u f)`, + SIMP_TAC[sum; GSYM NEUTRAL_REAL_ADD; ITERATE_SUPERSET; MONOIDAL_REAL_ADD]);; + +let SUM_UNION_RZERO = prove + (`!f:A->real u v. + FINITE u /\ (!x. x IN v /\ ~(x IN u) ==> (f(x) = &0)) + ==> (sum (u UNION v) f = sum u f)`, + let lemma = prove(`u UNION v = u UNION (v DIFF u)`,SET_TAC[]) in + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[lemma] THEN + MATCH_MP_TAC SUM_SUPERSET THEN + ASM_MESON_TAC[IN_UNION; IN_DIFF; SUBSET]);; + +let SUM_UNION_LZERO = prove + (`!f:A->real u v. + FINITE v /\ (!x. x IN u /\ ~(x IN v) ==> (f(x) = &0)) + ==> (sum (u UNION v) f = sum v f)`, + MESON_TAC[SUM_UNION_RZERO; UNION_COMM]);; + +let SUM_RESTRICT = prove + (`!f s. FINITE s ==> (sum s (\x. if x IN s then f(x) else &0) = sum s f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]);; + +let SUM_BOUND = prove + (`!s f b. FINITE s /\ (!x:A. x IN s ==> f(x) <= b) + ==> sum s f <= &(CARD s) * b`, + SIMP_TAC[GSYM SUM_CONST; SUM_LE]);; + +let SUM_BOUND_GEN = prove + (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) <= b / &(CARD s)) + ==> sum s f <= b`, + MESON_TAC[SUM_BOUND; REAL_DIV_LMUL; REAL_OF_NUM_EQ; HAS_SIZE_0; + HAS_SIZE]);; + +let SUM_ABS_BOUND = prove + (`!s f b. FINITE s /\ (!x:A. x IN s ==> abs(f(x)) <= b) + ==> abs(sum s f) <= &(CARD s) * b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum s (\x:A. abs(f x))` THEN + ASM_SIMP_TAC[SUM_BOUND; SUM_ABS]);; + +let SUM_BOUND_LT = prove + (`!s f b. FINITE s /\ (!x:A. x IN s ==> f x <= b) /\ (?x. x IN s /\ f x < b) + ==> sum s f < &(CARD s) * b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `sum s (\x:A. b)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LT THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ASM_SIMP_TAC[SUM_CONST; REAL_LE_REFL]]);; + +let SUM_BOUND_LT_ALL = prove + (`!s f b. FINITE s /\ ~(s = {}) /\ (!x. x IN s ==> f(x) < b) + ==> sum s f < &(CARD s) * b`, + MESON_TAC[MEMBER_NOT_EMPTY; REAL_LT_IMP_LE; SUM_BOUND_LT]);; + +let SUM_BOUND_LT_GEN = prove + (`!s f b. FINITE s /\ ~(s = {}) /\ (!x:A. x IN s ==> f(x) < b / &(CARD s)) + ==> sum s f < b`, + MESON_TAC[SUM_BOUND_LT_ALL; REAL_DIV_LMUL; REAL_OF_NUM_EQ; HAS_SIZE_0; + HAS_SIZE]);; + +let SUM_UNION_EQ = prove + (`!s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) + ==> (sum s f + sum t f = sum u f)`, + MESON_TAC[SUM_UNION; DISJOINT; FINITE_SUBSET; SUBSET_UNION]);; + +let SUM_EQ_SUPERSET = prove + (`!f s t:A->bool. + FINITE t /\ t SUBSET s /\ + (!x. x IN t ==> (f x = g x)) /\ + (!x. x IN s /\ ~(x IN t) ==> (f(x) = &0)) + ==> (sum s f = sum t g)`, + MESON_TAC[SUM_SUPERSET; SUM_EQ]);; + +let SUM_RESTRICT_SET = prove + (`!P s f. sum {x | x IN s /\ P x} f = sum s (\x. if P x then f x else &0)`, + ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD; IN_ELIM_THM] THEN + REWRITE_TAC[MESON[] `~((if P x then f x else a) = a) <=> P x /\ ~(f x = a)`; + GSYM CONJ_ASSOC] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_ELIM_THM]);; + +let SUM_SUM_RESTRICT = prove + (`!R f s t. + FINITE s /\ FINITE t + ==> (sum s (\x. sum {y | y IN t /\ R x y} (\y. f x y)) = + sum t (\y. sum {x | x IN s /\ R x y} (\x. f x y)))`, + REPEAT GEN_TAC THEN SIMP_TAC[SUM_RESTRICT_SET] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP SUM_SWAP th]));; + +let CARD_EQ_SUM = prove + (`!s. FINITE s ==> (&(CARD s) = sum s (\x. &1))`, + SIMP_TAC[SUM_CONST; REAL_MUL_RID]);; + +let SUM_MULTICOUNT_GEN = prove + (`!R:A->B->bool s t k. + FINITE s /\ FINITE t /\ + (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k(j))) + ==> (sum s (\i. &(CARD {j | j IN t /\ R i j})) = + sum t (\i. &(k i)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[CONJ_ASSOC] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum s (\i:A. sum {j:B | j IN t /\ R i j} (\j. &1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARD_EQ_SUM; FINITE_RESTRICT]; + FIRST_ASSUM(fun th -> + ONCE_REWRITE_TAC[MATCH_MP SUM_SUM_RESTRICT th]) THEN + MATCH_MP_TAC SUM_EQ THEN + ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN + REWRITE_TAC[REAL_MUL_RID]]);; + +let SUM_MULTICOUNT = prove + (`!R:A->B->bool s t k. + FINITE s /\ FINITE t /\ + (!j. j IN t ==> (CARD {i | i IN s /\ R i j} = k)) + ==> (sum s (\i. &(CARD {j | j IN t /\ R i j})) = &(k * CARD t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum t (\i:B. &k)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_MULTICOUNT_GEN THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[SUM_CONST; REAL_OF_NUM_MUL] THEN REWRITE_TAC[MULT_AC]]);; + +let SUM_IMAGE_GEN = prove + (`!f:A->B g s. + FINITE s + ==> (sum s g = + sum (IMAGE f s) (\y. sum {x | x IN s /\ (f(x) = y)} g))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `sum s (\x:A. sum {y:B | y IN IMAGE f s /\ (f x = y)} (\y. g x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:A` THEN + DISCH_TAC THEN + SUBGOAL_THEN `{y | y IN IMAGE (f:A->B) s /\ (f x = y)} = {(f x)}` + (fun th -> REWRITE_TAC[th; SUM_SING; o_THM]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_IMAGE] THEN + ASM_MESON_TAC[]; + GEN_REWRITE_TAC (funpow 2 RAND_CONV o ABS_CONV o RAND_CONV) + [GSYM ETA_AX] THEN + ASM_SIMP_TAC[SUM_SUM_RESTRICT; FINITE_IMAGE]]);; + +let SUM_GROUP = prove + (`!f:A->B g s t. + FINITE s /\ IMAGE f s SUBSET t + ==> sum t (\y. sum {x | x IN s /\ f(x) = y} g) = sum s g`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->B`; `g:A->real`; `s:A->bool`] SUM_IMAGE_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_SUPERSET THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_0 THEN ASM SET_TAC[]);; + +let REAL_OF_NUM_SUM = prove + (`!f s. FINITE s ==> (&(nsum s f) = sum s (\x. &(f x)))`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; NSUM_CLAUSES; GSYM REAL_OF_NUM_ADD]);; + +let SUM_SUBSET = prove + (`!u v f. FINITE u /\ FINITE v /\ + (!x. x IN (u DIFF v) ==> f(x) <= &0) /\ + (!x:A. x IN (v DIFF u) ==> &0 <= f(x)) + ==> sum u f <= sum v f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->real`; `u INTER v :A->bool`] SUM_UNION) THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `v DIFF u :A->bool` th) THEN + MP_TAC(SPEC `u DIFF v :A->bool` th)) THEN + REWRITE_TAC[SET_RULE `(u INTER v) UNION (u DIFF v) = u`; + SET_RULE `(u INTER v) UNION (v DIFF u) = v`] THEN + ASM_SIMP_TAC[FINITE_DIFF; FINITE_INTER] THEN + REPEAT(ANTS_TAC THENL [SET_TAC[]; DISCH_THEN SUBST1_TAC]) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --x /\ &0 <= y ==> a + x <= a + y`) THEN + ASM_SIMP_TAC[GSYM SUM_NEG; FINITE_DIFF] THEN CONJ_TAC THEN + MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[FINITE_DIFF; REAL_LE_RNEG; REAL_ADD_LID]);; + +let SUM_SUBSET_SIMPLE = prove + (`!u v f. FINITE v /\ u SUBSET v /\ (!x:A. x IN (v DIFF u) ==> &0 <= f(x)) + + ==> sum u f <= sum v f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_SUBSET THEN + ASM_MESON_TAC[IN_DIFF; SUBSET; FINITE_SUBSET]);; + +let SUM_IMAGE_NONZERO = prove + (`!d:B->real i:A->B s. + FINITE s /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) /\ i x = i y ==> d(i x) = &0) + ==> sum (IMAGE i s) d = sum s (d o i)`, + REWRITE_TAC[GSYM NEUTRAL_REAL_ADD; sum] THEN + MATCH_MP_TAC ITERATE_IMAGE_NONZERO THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_BIJECTION = prove + (`!f p s:A->bool. + (!x. x IN s ==> p(x) IN s) /\ + (!y. y IN s ==> ?!x. x IN s /\ p(x) = y) + ==> sum s f = sum s (f o p)`, + REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_BIJECTION THEN + REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_SUM_PRODUCT = prove + (`!s:A->bool t:A->B->bool x. + FINITE s /\ (!i. i IN s ==> FINITE(t i)) + ==> sum s (\i. sum (t i) (x i)) = + sum {i,j | i IN s /\ j IN t i} (\(i,j). x i j)`, + REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_ITERATE_PRODUCT THEN + REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_EQ_GENERAL = prove + (`!s:A->bool t:B->bool f g h. + (!y. y IN t ==> ?!x. x IN s /\ h(x) = y) /\ + (!x. x IN s ==> h(x) IN t /\ g(h x) = f x) + ==> sum s f = sum t g`, + REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL THEN + REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_EQ_GENERAL_INVERSES = prove + (`!s:A->bool t:B->bool f g h k. + (!y. y IN t ==> k(y) IN s /\ h(k y) = y) /\ + (!x. x IN s ==> h(x) IN t /\ k(h x) = x /\ g(h x) = f x) + ==> sum s f = sum t g`, + REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_EQ_GENERAL_INVERSES THEN + REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_INJECTION = prove + (`!f p s. FINITE s /\ + (!x. x IN s ==> p x IN s) /\ + (!x y. x IN s /\ y IN s /\ p x = p y ==> x = y) + ==> sum s (f o p) = sum s f`, + REWRITE_TAC[sum] THEN MATCH_MP_TAC ITERATE_INJECTION THEN + REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_UNION_NONZERO = prove + (`!f s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> f(x) = &0) + ==> sum (s UNION t) f = sum s f + sum t f`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + MATCH_MP_TAC ITERATE_UNION_NONZERO THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_UNIONS_NONZERO = prove + (`!f s. FINITE s /\ (!t:A->bool. t IN s ==> FINITE t) /\ + (!t1 t2 x. t1 IN s /\ t2 IN s /\ ~(t1 = t2) /\ x IN t1 /\ x IN t2 + ==> f x = &0) + ==> sum (UNIONS s) f = sum s (\t. sum t f)`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNIONS_0; UNIONS_INSERT; SUM_CLAUSES; IN_INSERT] THEN + MAP_EVERY X_GEN_TAC [`t:A->bool`; `s:(A->bool)->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN ASM_SIMP_TAC[SUM_CLAUSES] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_THEN(SUBST_ALL_TAC o SYM)] THEN + STRIP_TAC THEN MATCH_MP_TAC SUM_UNION_NONZERO THEN + ASM_SIMP_TAC[FINITE_UNIONS; IN_INTER; IN_UNIONS] THEN ASM_MESON_TAC[]);; + +let SUM_CASES = prove + (`!s P f g. FINITE s + ==> sum s (\x:A. if P x then f x else g x) = + sum {x | x IN s /\ P x} f + sum {x | x IN s /\ ~P x} g`, + REWRITE_TAC[sum; GSYM NEUTRAL_REAL_ADD] THEN + MATCH_MP_TAC ITERATE_CASES THEN REWRITE_TAC[MONOIDAL_REAL_ADD]);; + +let SUM_CASES_1 = prove + (`!s a. FINITE s /\ a IN s + ==> sum s (\x. if x = a then y else f(x)) = sum s f + (y - f a)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[SUM_CASES] THEN + ASM_SIMP_TAC[GSYM DELETE; SUM_DELETE] THEN + ASM_SIMP_TAC[SET_RULE `a IN s ==> {x | x IN s /\ x = a} = {a}`] THEN + REWRITE_TAC[SUM_SING] THEN REAL_ARITH_TAC);; + +let SUM_LE_INCLUDED = prove + (`!f:A->real g:B->real s t i. + FINITE s /\ FINITE t /\ + (!y. y IN t ==> &0 <= g y) /\ + (!x. x IN s ==> ?y. y IN t /\ i y = x /\ f(x) <= g(y)) + ==> sum s f <= sum t g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (i:B->A) t) (\y. sum {x | x IN t /\ i x = y} g)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC(GSYM SUM_IMAGE_GEN) THEN ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum s (\y. sum {x | x IN t /\ (i:B->A) x = y} g)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:A` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN X_GEN_TAC `y:B` THEN + STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {y:B} g` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[SUM_SING]; ALL_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + ASM_SIMP_TAC[SUM_POS_LE; FINITE_RESTRICT; IN_ELIM_THM] THEN + ASM SET_TAC[]);; + +let SUM_IMAGE_LE = prove + (`!f:A->B g s. + FINITE s /\ + (!x. x IN s ==> &0 <= g(f x)) + ==> sum (IMAGE f s) g <= sum s (g o f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_LE_INCLUDED THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_REWRITE_TAC[o_THM] THEN EXISTS_TAC `f:A->B` THEN + MESON_TAC[REAL_LE_REFL]);; + +let SUM_CLOSED = prove + (`!P f:A->real s. + P(&0) /\ (!x y. P x /\ P y ==> P(x + y)) /\ (!a. a IN s ==> P(f a)) + ==> P(sum s f)`, + REPEAT STRIP_TAC THEN MP_TAC(MATCH_MP ITERATE_CLOSED MONOIDAL_REAL_ADD) THEN + DISCH_THEN(MP_TAC o SPEC `P:real->bool`) THEN + ASM_SIMP_TAC[NEUTRAL_REAL_ADD; GSYM sum]);; + +(* ------------------------------------------------------------------------- *) +(* Specialize them to sums over intervals of numbers. *) +(* ------------------------------------------------------------------------- *) + +let SUM_ADD_NUMSEG = prove + (`!f g m n. sum(m..n) (\i. f(i) + g(i)) = sum(m..n) f + sum(m..n) g`, + SIMP_TAC[SUM_ADD; FINITE_NUMSEG]);; + +let SUM_SUB_NUMSEG = prove + (`!f g m n. sum(m..n) (\i. f(i) - g(i)) = sum(m..n) f - sum(m..n) g`, + SIMP_TAC[SUM_SUB; FINITE_NUMSEG]);; + +let SUM_LE_NUMSEG = prove + (`!f g m n. (!i. m <= i /\ i <= n ==> f(i) <= g(i)) + ==> sum(m..n) f <= sum(m..n) g`, + SIMP_TAC[SUM_LE; FINITE_NUMSEG; IN_NUMSEG]);; + +let SUM_EQ_NUMSEG = prove + (`!f g m n. (!i. m <= i /\ i <= n ==> (f(i) = g(i))) + ==> (sum(m..n) f = sum(m..n) g)`, + MESON_TAC[SUM_EQ; FINITE_NUMSEG; IN_NUMSEG]);; + +let SUM_ABS_NUMSEG = prove + (`!f m n. abs(sum(m..n) f) <= sum(m..n) (\i. abs(f i))`, + SIMP_TAC[SUM_ABS; FINITE_NUMSEG]);; + +let SUM_CONST_NUMSEG = prove + (`!c m n. sum(m..n) (\n. c) = &((n + 1) - m) * c`, + SIMP_TAC[SUM_CONST; FINITE_NUMSEG; CARD_NUMSEG]);; + +let SUM_EQ_0_NUMSEG = prove + (`!f m n. (!i. m <= i /\ i <= n ==> (f(i) = &0)) ==> (sum(m..n) f = &0)`, + SIMP_TAC[SUM_EQ_0; IN_NUMSEG]);; + +let SUM_TRIV_NUMSEG = prove + (`!f m n. n < m ==> (sum(m..n) f = &0)`, + MESON_TAC[SUM_EQ_0_NUMSEG; LE_TRANS; NOT_LT]);; + +let SUM_POS_LE_NUMSEG = prove + (`!m n f. (!p. m <= p /\ p <= n ==> &0 <= f(p)) ==> &0 <= sum(m..n) f`, + SIMP_TAC[SUM_POS_LE; FINITE_NUMSEG; IN_NUMSEG]);; + +let SUM_POS_EQ_0_NUMSEG = prove + (`!f m n. (!p. m <= p /\ p <= n ==> &0 <= f(p)) /\ (sum(m..n) f = &0) + ==> !p. m <= p /\ p <= n ==> (f(p) = &0)`, + MESON_TAC[SUM_POS_EQ_0; FINITE_NUMSEG; IN_NUMSEG]);; + +let SUM_SING_NUMSEG = prove + (`!f n. sum(n..n) f = f(n)`, + SIMP_TAC[SUM_SING; NUMSEG_SING]);; + +let SUM_CLAUSES_NUMSEG = prove + (`(!m. sum(m..0) f = if m = 0 then f(0) else &0) /\ + (!m n. sum(m..SUC n) f = if m <= SUC n then sum(m..n) f + f(SUC n) + else sum(m..n) f)`, + MP_TAC(MATCH_MP ITERATE_CLAUSES_NUMSEG MONOIDAL_REAL_ADD) THEN + REWRITE_TAC[NEUTRAL_REAL_ADD; sum]);; + +let SUM_SWAP_NUMSEG = prove + (`!a b c d f. + sum(a..b) (\i. sum(c..d) (f i)) = sum(c..d) (\j. sum(a..b) (\i. f i j))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC SUM_SWAP THEN + REWRITE_TAC[FINITE_NUMSEG]);; + +let SUM_ADD_SPLIT = prove + (`!f m n p. + m <= n + 1 ==> (sum (m..(n+p)) f = sum(m..n) f + sum(n+1..n+p) f)`, + SIMP_TAC[NUMSEG_ADD_SPLIT; SUM_UNION; DISJOINT_NUMSEG; FINITE_NUMSEG; + ARITH_RULE `x < x + 1`]);; + +let SUM_OFFSET = prove + (`!p f m n. sum(m+p..n+p) f = sum(m..n) (\i. f(i + p))`, + SIMP_TAC[NUMSEG_OFFSET_IMAGE; SUM_IMAGE; + EQ_ADD_RCANCEL; FINITE_NUMSEG] THEN + REWRITE_TAC[o_DEF]);; + +let SUM_OFFSET_0 = prove + (`!f m n. m <= n ==> (sum(m..n) f = sum(0..n-m) (\i. f(i + m)))`, + SIMP_TAC[GSYM SUM_OFFSET; ADD_CLAUSES; SUB_ADD]);; + +let SUM_CLAUSES_LEFT = prove + (`!f m n. m <= n ==> sum(m..n) f = f(m) + sum(m+1..n) f`, + SIMP_TAC[GSYM NUMSEG_LREC; SUM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG] THEN + ARITH_TAC);; + +let SUM_CLAUSES_RIGHT = prove + (`!f m n. 0 < n /\ m <= n ==> sum(m..n) f = sum(m..n-1) f + f(n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + SIMP_TAC[LT_REFL; SUM_CLAUSES_NUMSEG; SUC_SUB1]);; + +let SUM_PAIR = prove + (`!f m n. sum(2*m..2*n+1) f = sum(m..n) (\i. f(2*i) + f(2*i+1))`, + MP_TAC(MATCH_MP ITERATE_PAIR MONOIDAL_REAL_ADD) THEN + REWRITE_TAC[sum; NEUTRAL_REAL_ADD]);; + +let REAL_OF_NUM_SUM_NUMSEG = prove + (`!f m n. (&(nsum(m..n) f) = sum (m..n) (\i. &(f i)))`, + SIMP_TAC[REAL_OF_NUM_SUM; FINITE_NUMSEG]);; + +(* ------------------------------------------------------------------------- *) +(* Partial summation and other theorems specific to number segments. *) +(* ------------------------------------------------------------------------- *) + +let SUM_PARTIAL_SUC = prove + (`!f g m n. + sum (m..n) (\k. f(k) * (g(k + 1) - g(k))) = + if m <= n then f(n + 1) * g(n + 1) - f(m) * g(m) - + sum (m..n) (\k. g(k + 1) * (f(k + 1) - f(k))) + else &0`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[SUM_TRIV_NUMSEG; GSYM NOT_LE] THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THENL + [COND_CASES_TAC THEN ASM_SIMP_TAC[] THENL [REAL_ARITH_TAC; ASM_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LE]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC) THEN + ASM_SIMP_TAC[GSYM NOT_LT; SUM_TRIV_NUMSEG; ARITH_RULE `n < SUC n`] THEN + ASM_SIMP_TAC[GSYM ADD1; ADD_CLAUSES] THEN REAL_ARITH_TAC);; + +let SUM_PARTIAL_PRE = prove + (`!f g m n. + sum (m..n) (\k. f(k) * (g(k) - g(k - 1))) = + if m <= n then f(n + 1) * g(n) - f(m) * g(m - 1) - + sum (m..n) (\k. g k * (f(k + 1) - f(k))) + else &0`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`f:num->real`; `\k. (g:num->real)(k - 1)`; + `m:num`; `n:num`] SUM_PARTIAL_SUC) THEN + REWRITE_TAC[ADD_SUB] THEN DISCH_THEN SUBST1_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]);; + +let SUM_DIFFS = prove + (`!m n. sum(m..n) (\k. f(k) - f(k + 1)) = + if m <= n then f(m) - f(n + 1) else &0`, + ONCE_REWRITE_TAC[REAL_ARITH `a - b = -- &1 * (b - a)`] THEN + ONCE_REWRITE_TAC[SUM_PARTIAL_SUC] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_RZERO; SUM_0] THEN + REAL_ARITH_TAC);; + +let SUM_DIFFS_ALT = prove + (`!m n. sum(m..n) (\k. f(k + 1) - f(k)) = + if m <= n then f(n + 1) - f(m) else &0`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN + SIMP_TAC[SUM_NEG; SUM_DIFFS] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_NEG_SUB; REAL_NEG_0]);; + +let SUM_COMBINE_R = prove + (`!f m n p. m <= n + 1 /\ n <= p + ==> sum(m..n) f + sum(n+1..p) f = sum(m..p) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_UNION_EQ THEN + REWRITE_TAC[FINITE_NUMSEG; EXTENSION; IN_INTER; IN_UNION; NOT_IN_EMPTY; + IN_NUMSEG] THEN + ASM_ARITH_TAC);; + +let SUM_COMBINE_L = prove + (`!f m n p. 0 < n /\ m <= n /\ n <= p + 1 + ==> sum(m..n-1) f + sum(n..p) f = sum(m..p) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_UNION_EQ THEN + REWRITE_TAC[FINITE_NUMSEG; EXTENSION; IN_INTER; IN_UNION; NOT_IN_EMPTY; + IN_NUMSEG] THEN + ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Extend congruences to deal with sum. Note that we must have the eta *) +(* redex or we'll get a loop since f(x) will lambda-reduce recursively. *) +(* ------------------------------------------------------------------------- *) + +let th = prove + (`(!f g s. (!x. x IN s ==> f(x) = g(x)) + ==> sum s (\i. f(i)) = sum s g) /\ + (!f g a b. (!i. a <= i /\ i <= b ==> f(i) = g(i)) + ==> sum(a..b) (\i. f(i)) = sum(a..b) g) /\ + (!f g p. (!x. p x ==> f x = g x) + ==> sum {y | p y} (\i. f(i)) = sum {y | p y} g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ THEN + ASM_SIMP_TAC[IN_ELIM_THM; IN_NUMSEG]) in + extend_basic_congs (map SPEC_ALL (CONJUNCTS th));; + +(* ------------------------------------------------------------------------- *) +(* Expand "sum (m..n) f" where m and n are numerals. *) +(* ------------------------------------------------------------------------- *) + +let EXPAND_SUM_CONV = + let [pth_0; pth_1; pth_2] = (CONJUNCTS o prove) + (`(n < m ==> sum(m..n) f = &0) /\ + sum(m..m) f = f m /\ + (m <= n ==> sum (m..n) f = f m + sum (m + 1..n) f)`, + REWRITE_TAC[SUM_CLAUSES_LEFT; SUM_SING_NUMSEG; SUM_TRIV_NUMSEG]) + and ns_tm = `..` and f_tm = `f:num->real` + and m_tm = `m:num` and n_tm = `n:num` in + let rec conv tm = + let smn,ftm = dest_comb tm in + let s,mn = dest_comb smn in + if not(is_const s & fst(dest_const s) = "sum") + then failwith "EXPAND_SUM_CONV" else + let mtm,ntm = dest_binop ns_tm mn in + let m = dest_numeral mtm and n = dest_numeral ntm in + if n < m then + let th1 = INST [ftm,f_tm; mtm,m_tm; ntm,n_tm] pth_0 in + MP th1 (EQT_ELIM(NUM_LT_CONV(lhand(concl th1)))) + else if n = m then CONV_RULE (RAND_CONV(TRY_CONV BETA_CONV)) + (INST [ftm,f_tm; mtm,m_tm] pth_1) + else + let th1 = INST [ftm,f_tm; mtm,m_tm; ntm,n_tm] pth_2 in + let th2 = MP th1 (EQT_ELIM(NUM_LE_CONV(lhand(concl th1)))) in + CONV_RULE (RAND_CONV(COMB2_CONV (RAND_CONV(TRY_CONV BETA_CONV)) + (LAND_CONV(LAND_CONV NUM_ADD_CONV) THENC conv))) th2 in + conv;; + +(* ------------------------------------------------------------------------- *) +(* Some special algebraic rearrangements. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SUB_POW = prove + (`!x y n. + 1 <= n ==> x pow n - y pow n = + (x - y) * sum(0..n-1) (\i. x pow i * y pow (n - 1 - i))`, + REWRITE_TAC[GSYM SUM_LMUL] THEN + REWRITE_TAC[REAL_ARITH + `(x - y) * (a * b):real = (x * a) * b - a * (y * b)`] THEN + SIMP_TAC[GSYM real_pow; ADD1; ARITH_RULE + `1 <= n /\ x <= n - 1 + ==> n - 1 - x = n - (x + 1) /\ SUC(n - 1 - x) = n - x`] THEN + REWRITE_TAC[SUM_DIFFS_ALT; LE_0] THEN + SIMP_TAC[SUB_0; SUB_ADD; SUB_REFL; real_pow; REAL_MUL_LID; REAL_MUL_RID]);; + +let REAL_SUB_POW_R1 = prove + (`!x n. 1 <= n ==> x pow n - &1 = (x - &1) * sum(0..n-1) (\i. x pow i)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `&1`] o MATCH_MP REAL_SUB_POW) THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID]);; + +let REAL_SUB_POW_L1 = prove + (`!x n. 1 <= n ==> &1 - x pow n = (&1 - x) * sum(0..n-1) (\i. x pow i)`, + ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN + SIMP_TAC[REAL_SUB_POW_R1] THEN REWRITE_TAC[REAL_MUL_LNEG]);; + +(* ------------------------------------------------------------------------- *) +(* Some useful facts about real polynomial functions. *) +(* ------------------------------------------------------------------------- *) + +let REAL_SUB_POLYFUN = prove + (`!a x y n. + 1 <= n + ==> sum(0..n) (\i. a i * x pow i) - sum(0..n) (\i. a i * y pow i) = + (x - y) * + sum(0..n-1) (\j. sum(j+1..n) (\i. a i * y pow (i - j - 1)) * x pow j)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM SUM_SUB_NUMSEG; GSYM REAL_SUB_LDISTRIB] THEN + GEN_REWRITE_TAC LAND_CONV [MATCH_MP SUM_CLAUSES_LEFT (SPEC_ALL LE_0)] THEN + REWRITE_TAC[REAL_SUB_REFL; real_pow; REAL_MUL_RZERO; REAL_ADD_LID] THEN + SIMP_TAC[REAL_SUB_POW; ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * x * s:real = x * a * s`] THEN + REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL; SUM_SUM_PRODUCT; FINITE_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC `\(x:num,y:num). (y,x)`) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_ELIM_PAIR_THM; IN_NUMSEG] THEN + REWRITE_TAC[ARITH_RULE `a - b - c:num = a - (b + c)`; ADD_SYM] THEN + REWRITE_TAC[REAL_MUL_AC] THEN ARITH_TAC);; + +let REAL_SUB_POLYFUN_ALT = prove + (`!a x y n. + 1 <= n + ==> sum(0..n) (\i. a i * x pow i) - sum(0..n) (\i. a i * y pow i) = + (x - y) * + sum(0..n-1) (\j. sum(0..n-j-1) (\k. a(j+k+1) * y pow k) * x pow j)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_SUB_POLYFUN] THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `j:num` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ_GENERAL_INVERSES THEN + MAP_EVERY EXISTS_TAC + [`\i. i - (j + 1)`; `\k. j + k + 1`] THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + TRY(BINOP_TAC THEN AP_TERM_TAC) THEN ASM_ARITH_TAC);; + +let REAL_POLYFUN_ROOTBOUND = prove + (`!n c. ~(!i. i IN 0..n ==> c i = &0) + ==> FINITE {x | sum(0..n) (\i. c i * x pow i) = &0} /\ + CARD {x | sum(0..n) (\i. c i * x pow i) = &0} <= n`, + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN INDUCT_TAC THENL + [REWRITE_TAC[NUMSEG_SING; IN_SING; UNWIND_THM2; SUM_CLAUSES_NUMSEG] THEN + SIMP_TAC[real_pow; REAL_MUL_RID; EMPTY_GSPEC; CARD_CLAUSES; FINITE_EMPTY; + LE_REFL]; + X_GEN_TAC `c:num->real` THEN REWRITE_TAC[IN_NUMSEG] THEN + DISCH_TAC THEN ASM_CASES_TAC `(c:num->real) (SUC n) = &0` THENL + [ASM_SIMP_TAC[SUM_CLAUSES_NUMSEG; LE_0; REAL_MUL_LZERO; REAL_ADD_RID] THEN + REWRITE_TAC[LE; LEFT_OR_DISTRIB] THEN DISJ2_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[IN_NUMSEG; LE]; + ASM_CASES_TAC `{x | sum (0..SUC n) (\i. c i * x pow i) = &0} = {}` THEN + ASM_REWRITE_TAC[FINITE_RULES; CARD_CLAUSES; LE_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `r:real` THEN DISCH_TAC THEN + MP_TAC(GEN `x:real` (ISPECL [`c:num->real`; `x:real`; `r:real`; `SUC n`] + REAL_SUB_POLYFUN)) THEN + ASM_REWRITE_TAC[ARITH_RULE `1 <= SUC n`; REAL_SUB_RZERO] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th; REAL_ENTIRE; REAL_SUB_0]) THEN + REWRITE_TAC[SET_RULE `{x | x = c \/ P x} = c INSERT {x | P x}`] THEN + MATCH_MP_TAC(MESON[FINITE_INSERT; CARD_CLAUSES; + ARITH_RULE `x <= n ==> SUC x <= SUC n /\ x <= SUC n`] + `FINITE s /\ CARD s <= n + ==> FINITE(r INSERT s) /\ CARD(r INSERT s) <= SUC n`) THEN + REWRITE_TAC[SUC_SUB1] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `n:num` THEN REWRITE_TAC[IN_NUMSEG; ADD1; LE_REFL; LE_0] THEN + REWRITE_TAC[SUM_SING_NUMSEG; ARITH_RULE `(n + 1) - n - 1 = 0`] THEN + ASM_REWRITE_TAC[GSYM ADD1; real_pow; REAL_MUL_RID]]]);; + +let REAL_POLYFUN_FINITE_ROOTS = prove + (`!n c. FINITE {x | sum(0..n) (\i. c i * x pow i) = &0} <=> + ?i. i IN 0..n /\ ~(c i = &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[TAUT `a /\ ~b <=> ~(a ==> b)`] THEN + REWRITE_TAC[GSYM NOT_FORALL_THM] THEN EQ_TAC THEN + SIMP_TAC[REAL_POLYFUN_ROOTBOUND] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN + SIMP_TAC[REAL_MUL_LZERO; SUM_0] THEN + REWRITE_TAC[SET_RULE `{x | T} = (:real)`; real_INFINITE; GSYM INFINITE]);; + +let REAL_POLYFUN_EQ_0 = prove + (`!n c. (!x. sum(0..n) (\i. c i * x pow i) = &0) <=> + (!i. i IN 0..n ==> c i = &0)`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_THEN(MP_TAC o MATCH_MP + REAL_POLYFUN_ROOTBOUND) THEN + ASM_REWRITE_TAC[real_INFINITE; GSYM INFINITE; DE_MORGAN_THM; + SET_RULE `{x | T} = (:real)`]; + ASM_SIMP_TAC[IN_NUMSEG; LE_0; REAL_MUL_LZERO; SUM_0]]);; + +let REAL_POLYFUN_EQ_CONST = prove + (`!n c k. (!x. sum(0..n) (\i. c i * x pow i) = k) <=> + c 0 = k /\ (!i. i IN 1..n ==> c i = &0)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC + `!x. sum(0..n) (\i. (if i = 0 then c 0 - k else c i) * x pow i) = &0` THEN + CONJ_TAC THENL + [SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; real_pow; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ARITH `(c - k) + s = &0 <=> c + s = k`] THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ THEN GEN_TAC THEN + REWRITE_TAC[IN_NUMSEG] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ARITH]; + REWRITE_TAC[REAL_POLYFUN_EQ_0; IN_NUMSEG; LE_0] THEN + GEN_REWRITE_TAC LAND_CONV [MESON[] + `(!n. P n) <=> P 0 /\ (!n. ~(n = 0) ==> P n)`] THEN + SIMP_TAC[LE_0; REAL_SUB_0] THEN MESON_TAC[LE_1]]);; + +(* ------------------------------------------------------------------------- *) +(* A general notion of polynomial function. *) +(* ------------------------------------------------------------------------- *) + +let polynomial_function = new_definition + `polynomial_function p <=> ?m c. !x. p x = sum(0..m) (\i. c i * x pow i)`;; + +let POLYNOMIAL_FUNCTION_CONST = prove + (`!c. polynomial_function (\x. c)`, + GEN_TAC THEN REWRITE_TAC[polynomial_function] THEN + MAP_EVERY EXISTS_TAC [`0`; `(\i. c):num->real`] THEN + REWRITE_TAC[SUM_SING_NUMSEG; real_pow; REAL_MUL_RID]);; + +let POLYNOMIAL_FUNCTION_ID = prove + (`polynomial_function (\x. x)`, + REWRITE_TAC[polynomial_function] THEN + MAP_EVERY EXISTS_TAC [`SUC 0`; `\i. if i = 1 then &1 else &0`] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH] THEN REAL_ARITH_TAC);; + +let POLYNOMIAL_FUNCTION_I = prove + (`polynomial_function I`, + REWRITE_TAC[I_DEF; POLYNOMIAL_FUNCTION_ID]);; + +let POLYNOMIAL_FUNCTION_ADD = prove + (`!p q. polynomial_function p /\ polynomial_function q + ==> polynomial_function (\x. p x + q x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; polynomial_function; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `a:num->real`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`n:num`; `b:num->real`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `MAX m n` THEN EXISTS_TAC + `\i:num. (if i <= m then a i else &0) + (if i <= n then b i else &0)` THEN + GEN_TAC THEN REWRITE_TAC[REAL_ADD_RDISTRIB; SUM_ADD_NUMSEG] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN BINOP_TAC THEN + BINOP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_NUMSEG] THEN ARITH_TAC);; + +let POLYNOMIAL_FUNCTION_LMUL = prove + (`!p c. polynomial_function p ==> polynomial_function (\x. c * p x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; polynomial_function; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`n:num`; `\i. c * (a:num->real) i`] THEN + ASM_REWRITE_TAC[SUM_LMUL; GSYM REAL_MUL_ASSOC]);; + +let POLYNOMIAL_FUNCTION_RMUL = prove + (`!p c. polynomial_function p ==> polynomial_function (\x. p x * c)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[POLYNOMIAL_FUNCTION_LMUL]);; + +let POLYNOMIAL_FUNCTION_NEG = prove + (`!p. polynomial_function(\x. --(p x)) <=> polynomial_function p`, + GEN_TAC THEN EQ_TAC THEN + DISCH_THEN(MP_TAC o SPEC `--(&1)` o MATCH_MP POLYNOMIAL_FUNCTION_LMUL) THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_LID; ETA_AX; REAL_NEG_NEG]);; + +let POLYNOMIAL_FUNCTION_SUB = prove + (`!p q. polynomial_function p /\ polynomial_function q + ==> polynomial_function (\x. p x - q x)`, + SIMP_TAC[real_sub; POLYNOMIAL_FUNCTION_NEG; POLYNOMIAL_FUNCTION_ADD]);; + +let POLYNOMIAL_FUNCTION_MUL = prove + (`!p q. polynomial_function p /\ polynomial_function q + ==> polynomial_function (\x. p x * q x)`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC (BINDER_CONV o LAND_CONV) [polynomial_function] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[MESON[] `(!q m c. P q m c) <=> (!m c q. P q m c)`] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[SUM_SING_NUMSEG; real_pow; POLYNOMIAL_FUNCTION_RMUL] THEN + X_GEN_TAC `c:num->real` THEN SIMP_TAC[SUM_CLAUSES_LEFT; LE_0; ADD1] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; real_pow] THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_ADD THEN + ASM_SIMP_TAC[POLYNOMIAL_FUNCTION_RMUL] THEN + REWRITE_TAC[SPEC `1` SUM_OFFSET] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_ASSOC; SUM_RMUL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\i. (c:num->real)(i + 1)`) THEN + ABBREV_TAC `q = \x. p x * sum (0..m) (\i. c (i + 1) * x pow i)` THEN + RULE_ASSUM_TAC(REWRITE_RULE[FUN_EQ_THM]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[polynomial_function; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `a:num->real`] THEN STRIP_TAC THEN + EXISTS_TAC `n + 1` THEN + EXISTS_TAC `\i. if i = 0 then &0 else (a:num->real)(i - 1)` THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN + ASM_REWRITE_TAC[SPEC `1` SUM_OFFSET; ADD_EQ_0; ARITH_EQ; ADD_SUB] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; SUM_RMUL] THEN REAL_ARITH_TAC);; + +let POLYNOMIAL_FUNCTION_SUM = prove + (`!s:A->bool p. + FINITE s /\ (!i. i IN s ==> polynomial_function(\x. p x i)) + ==> polynomial_function (\x. sum s (p x))`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; POLYNOMIAL_FUNCTION_CONST] THEN + SIMP_TAC[FORALL_IN_INSERT; POLYNOMIAL_FUNCTION_ADD]);; + +let POLYNOMIAL_FUNCTION_POW = prove + (`!p n. polynomial_function p ==> polynomial_function (\x. p x pow n)`, + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[real_pow; POLYNOMIAL_FUNCTION_CONST; POLYNOMIAL_FUNCTION_MUL]);; + +let POLYNOMIAL_FUNCTION_INDUCT = prove + (`!P. P (\x. x) /\ (!c. P (\x. c)) /\ + (!p q. P p /\ P q ==> P (\x. p x + q x)) /\ + (!p q. P p /\ P q ==> P (\x. p x * q x)) + ==> !p. polynomial_function p ==> P p`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[polynomial_function; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[MESON[] `(!q m c. P q m c) <=> (!m c q. P q m c)`] THEN + ONCE_REWRITE_TAC[GSYM FUN_EQ_THM] THEN + SIMP_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[SUM_SING_NUMSEG; real_pow] THEN + GEN_TAC THEN SIMP_TAC[SUM_CLAUSES_LEFT; ADD1; LE_0] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[real_pow] THEN + REWRITE_TAC[SPEC `1` SUM_OFFSET] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_MUL_ASSOC; SUM_RMUL] THEN + ASM_SIMP_TAC[]);; + +let POLYNOMIAL_FUNCTION_o = prove + (`!p q. polynomial_function p /\ polynomial_function q + ==> polynomial_function (p o q)`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IMP_CONJ_ALT; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC POLYNOMIAL_FUNCTION_INDUCT THEN + SIMP_TAC[o_DEF; POLYNOMIAL_FUNCTION_ADD; POLYNOMIAL_FUNCTION_MUL] THEN + ASM_REWRITE_TAC[ETA_AX; POLYNOMIAL_FUNCTION_CONST]);; + +let POLYNOMIAL_FUNCTION_FINITE_ROOTS = prove + (`!p a. polynomial_function p + ==> (FINITE {x | p x = a} <=> ~(!x. p x = a))`, + ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + SUBGOAL_THEN + `!p. polynomial_function p ==> (FINITE {x | p x = &0} <=> ~(!x. p x = &0))` + (fun th -> + SIMP_TAC[th; POLYNOMIAL_FUNCTION_SUB; POLYNOMIAL_FUNCTION_CONST]) THEN + GEN_TAC THEN REWRITE_TAC[polynomial_function] THEN + STRIP_TAC THEN EQ_TAC THEN ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THENL + [SIMP_TAC[UNIV_GSPEC; GSYM INFINITE; real_INFINITE]; + ASM_REWRITE_TAC[REAL_POLYFUN_FINITE_ROOTS] THEN + SIMP_TAC[NOT_EXISTS_THM; TAUT `~(p /\ ~q) <=> p ==> q`] THEN + REWRITE_TAC[REAL_MUL_LZERO; SUM_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Make natural numbers the default again. *) +(* ------------------------------------------------------------------------- *) + +prioritize_num();; diff --git a/lib.ml b/lib.ml new file mode 100644 index 0000000..30078cc --- /dev/null +++ b/lib.ml @@ -0,0 +1,843 @@ +(* ========================================================================= *) +(* Convenient library functions. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +let fail() = failwith "";; + +(* ------------------------------------------------------------------------- *) +(* Combinators. *) +(* ------------------------------------------------------------------------- *) + +let curry f x y = f(x,y);; + +let uncurry f(x,y) = f x y;; + +let I x = x;; + +let K x y = x;; + +let C f x y = f y x;; + +let W f x = f x x;; + +let (o) = fun f g x -> f(g x);; + +let (F_F) = fun f g (x,y) -> (f x,g y);; + +(* ------------------------------------------------------------------------- *) +(* List basics. *) +(* ------------------------------------------------------------------------- *) + +let hd l = + match l with + h::t -> h + | _ -> failwith "hd";; + +let tl l = + match l with + h::t -> t + | _ -> failwith "tl";; + +let map f = + let rec mapf l = + match l with + [] -> [] + | (x::t) -> let y = f x in y::(mapf t) in + mapf;; + +let rec last l = + match l with + [x] -> x + | (h::t) -> last t + | [] -> failwith "last";; + +let rec butlast l = + match l with + [_] -> [] + | (h::t) -> h::(butlast t) + | [] -> failwith "butlast";; + +let rec el n l = + if n = 0 then hd l else el (n - 1) (tl l);; + +let rev = + let rec rev_append acc l = + match l with + [] -> acc + | h::t -> rev_append (h::acc) t in + fun l -> rev_append [] l;; + +let rec map2 f l1 l2 = + match (l1,l2) with + [],[] -> [] + | (h1::t1),(h2::t2) -> let h = f h1 h2 in h::(map2 f t1 t2) + | _ -> failwith "map2: length mismatch";; + +(* ------------------------------------------------------------------------- *) +(* Attempting function or predicate applications. *) +(* ------------------------------------------------------------------------- *) + +let can f x = try (f x; true) with Failure _ -> false;; + +let check p x = if p x then x else failwith "check";; + +(* ------------------------------------------------------------------------- *) +(* Repetition of a function. *) +(* ------------------------------------------------------------------------- *) + +let rec funpow n f x = + if n < 1 then x else funpow (n-1) f (f x);; + +let rec repeat f x = + try let y = f x in repeat f y with Failure _ -> x;; + +(* ------------------------------------------------------------------------- *) +(* To avoid consing in various situations, we propagate this exception. *) +(* I should probably eliminate this and use pointer EQ tests instead. *) +(* ------------------------------------------------------------------------- *) + +exception Unchanged;; + +(* ------------------------------------------------------------------------- *) +(* Various versions of list iteration. *) +(* ------------------------------------------------------------------------- *) + +let rec itlist f l b = + match l with + [] -> b + | (h::t) -> f h (itlist f t b);; + +let rec rev_itlist f l b = + match l with + [] -> b + | (h::t) -> rev_itlist f t (f h b);; + +let rec end_itlist f l = + match l with + [] -> failwith "end_itlist" + | [x] -> x + | (h::t) -> f h (end_itlist f t);; + +let rec itlist2 f l1 l2 b = + match (l1,l2) with + ([],[]) -> b + | (h1::t1,h2::t2) -> f h1 h2 (itlist2 f t1 t2 b) + | _ -> failwith "itlist2";; + +let rec rev_itlist2 f l1 l2 b = + match (l1,l2) with + ([],[]) -> b + | (h1::t1,h2::t2) -> rev_itlist2 f t1 t2 (f h1 h2 b) + | _ -> failwith "rev_itlist2";; + +(* ------------------------------------------------------------------------- *) +(* Iterative splitting (list) and stripping (tree) via destructor. *) +(* ------------------------------------------------------------------------- *) + +let rec splitlist dest x = + try let l,r = dest x in + let ls,res = splitlist dest r in + (l::ls,res) + with Failure _ -> ([],x);; + +let rev_splitlist dest = + let rec rsplist ls x = + try let l,r = dest x in + rsplist (r::ls) l + with Failure _ -> (x,ls) in + fun x -> rsplist [] x;; + +let striplist dest = + let rec strip x acc = + try let l,r = dest x in + strip l (strip r acc) + with Failure _ -> x::acc in + fun x -> strip x [];; + +(* ------------------------------------------------------------------------- *) +(* Apply a destructor as many times as elements in list. *) +(* ------------------------------------------------------------------------- *) + +let rec nsplit dest clist x = + if clist = [] then [],x else + let l,r = dest x in + let ll,y = nsplit dest (tl clist) r in + l::ll,y;; + +(* ------------------------------------------------------------------------- *) +(* Replication and sequences. *) +(* ------------------------------------------------------------------------- *) + +let rec replicate x n = + if n < 1 then [] + else x::(replicate x (n - 1));; + +let rec (--) = fun m n -> if m > n then [] else m::((m + 1) -- n);; + +(* ------------------------------------------------------------------------- *) +(* Various useful list operations. *) +(* ------------------------------------------------------------------------- *) + +let rec forall p l = + match l with + [] -> true + | h::t -> p(h) & forall p t;; + +let rec forall2 p l1 l2 = + match (l1,l2) with + [],[] -> true + | (h1::t1,h2::t2) -> p h1 h2 & forall2 p t1 t2 + | _ -> false;; + +let rec exists p l = + match l with + [] -> false + | h::t -> p(h) or exists p t;; + +let length = + let rec len k l = + if l = [] then k else len (k + 1) (tl l) in + fun l -> len 0 l;; + +let rec filter p l = + match l with + [] -> l + | h::t -> let t' = filter p t in + if p(h) then if t'==t then l else h::t' + else t';; + +let rec partition p l = + match l with + [] -> [],l + | h::t -> let yes,no = partition p t in + if p(h) then (if yes == t then l,[] else h::yes,no) + else (if no == t then [],l else yes,h::no);; + +let rec mapfilter f l = + match l with + [] -> [] + | (h::t) -> let rest = mapfilter f t in + try (f h)::rest with Failure _ -> rest;; + +let rec find p l = + match l with + [] -> failwith "find" + | (h::t) -> if p(h) then h else find p t;; + +let rec tryfind f l = + match l with + [] -> failwith "tryfind" + | (h::t) -> try f h with Failure _ -> tryfind f t;; + +let flat l = itlist (@) l [];; + +let rec remove p l = + match l with + [] -> failwith "remove" + | (h::t) -> if p(h) then h,t else + let y,n = remove p t in y,h::n;; + +let rec chop_list n l = + if n = 0 then [],l else + try let m,l' = chop_list (n-1) (tl l) in (hd l)::m,l' + with Failure _ -> failwith "chop_list";; + +let index x = + let rec ind n l = + match l with + [] -> failwith "index" + | (h::t) -> if Pervasives.compare x h = 0 then n else ind (n + 1) t in + ind 0;; + +(* ------------------------------------------------------------------------- *) +(* "Set" operations on lists. *) +(* ------------------------------------------------------------------------- *) + +let rec mem x lis = + match lis with + [] -> false + | (h::t) -> Pervasives.compare x h = 0 or mem x t;; + +let insert x l = + if mem x l then l else x::l;; + +let union l1 l2 = itlist insert l1 l2;; + +let unions l = itlist union l [];; + +let intersect l1 l2 = filter (fun x -> mem x l2) l1;; + +let subtract l1 l2 = filter (fun x -> not (mem x l2)) l1;; + +let subset l1 l2 = forall (fun t -> mem t l2) l1;; + +let set_eq l1 l2 = subset l1 l2 & subset l2 l1;; + +(* ------------------------------------------------------------------------- *) +(* Association lists. *) +(* ------------------------------------------------------------------------- *) + +let rec assoc a l = + match l with + (x,y)::t -> if Pervasives.compare x a = 0 then y else assoc a t + | [] -> failwith "find";; + +let rec rev_assoc a l = + match l with + (x,y)::t -> if Pervasives.compare y a = 0 then x else rev_assoc a t + | [] -> failwith "find";; + +(* ------------------------------------------------------------------------- *) +(* Zipping, unzipping etc. *) +(* ------------------------------------------------------------------------- *) + +let rec zip l1 l2 = + match (l1,l2) with + ([],[]) -> [] + | (h1::t1,h2::t2) -> (h1,h2)::(zip t1 t2) + | _ -> failwith "zip";; + +let rec unzip = + function [] -> [],[] + | ((a,b)::rest) -> let alist,blist = unzip rest in + (a::alist,b::blist);; + +(* ------------------------------------------------------------------------- *) +(* Sharing out a list according to pattern in list-of-lists. *) +(* ------------------------------------------------------------------------- *) + +let rec shareout pat all = + if pat = [] then [] else + let l,r = chop_list (length (hd pat)) all in + l::(shareout (tl pat) r);; + +(* ------------------------------------------------------------------------- *) +(* Iterating functions over lists. *) +(* ------------------------------------------------------------------------- *) + +let rec do_list f l = + match l with + [] -> () + | (h::t) -> (f h; do_list f t);; + +(* ------------------------------------------------------------------------- *) +(* Sorting. *) +(* ------------------------------------------------------------------------- *) + +let rec sort cmp lis = + match lis with + [] -> [] + | piv::rest -> + let r,l = partition (cmp piv) rest in + (sort cmp l) @ (piv::(sort cmp r));; + +(* ------------------------------------------------------------------------- *) +(* Removing adjacent (NB!) equal elements from list. *) +(* ------------------------------------------------------------------------- *) + +let rec uniq l = + match l with + x::(y::_ as t) -> let t' = uniq t in + if Pervasives.compare x y = 0 then t' else + if t'==t then l else x::t' + | _ -> l;; + +(* ------------------------------------------------------------------------- *) +(* Convert list into set by eliminating duplicates. *) +(* ------------------------------------------------------------------------- *) + +let setify s = uniq (sort (fun x y -> Pervasives.compare x y <= 0) s);; + +(* ------------------------------------------------------------------------- *) +(* String operations (surely there is a better way...) *) +(* ------------------------------------------------------------------------- *) + +let implode l = itlist (^) l "";; + +let explode s = + let rec exap n l = + if n < 0 then l else + exap (n - 1) ((String.sub s n 1)::l) in + exap (String.length s - 1) [];; + +(* ------------------------------------------------------------------------- *) +(* Greatest common divisor. *) +(* ------------------------------------------------------------------------- *) + +let gcd = + let rec gxd x y = + if y = 0 then x else gxd y (x mod y) in + fun x y -> let x' = abs x and y' = abs y in + if x' < y' then gxd y' x' else gxd x' y';; + +(* ------------------------------------------------------------------------- *) +(* Some useful functions on "num" type. *) +(* ------------------------------------------------------------------------- *) + +let num_0 = Int 0 +and num_1 = Int 1 +and num_2 = Int 2 +and num_10 = Int 10;; + +let pow2 n = power_num num_2 (Int n);; +let pow10 n = power_num num_10 (Int n);; + +let numdom r = + let r' = Ratio.normalize_ratio (ratio_of_num r) in + num_of_big_int(Ratio.numerator_ratio r'), + num_of_big_int(Ratio.denominator_ratio r');; + +let numerator = fst o numdom +and denominator = snd o numdom;; + +let gcd_num n1 n2 = + num_of_big_int(Big_int.gcd_big_int (big_int_of_num n1) (big_int_of_num n2));; + +let lcm_num x y = + if x =/ num_0 & y =/ num_0 then num_0 + else abs_num((x */ y) // gcd_num x y);; + +(* ------------------------------------------------------------------------- *) +(* All pairs arising from applying a function over two lists. *) +(* ------------------------------------------------------------------------- *) + +let rec allpairs f l1 l2 = + match l1 with + h1::t1 -> itlist (fun x a -> f h1 x :: a) l2 (allpairs f t1 l2) + | [] -> [];; + +(* ------------------------------------------------------------------------- *) +(* Issue a report with a newline. *) +(* ------------------------------------------------------------------------- *) + +let report s = + Format.print_string s; Format.print_newline();; + +(* ------------------------------------------------------------------------- *) +(* Convenient function for issuing a warning. *) +(* ------------------------------------------------------------------------- *) + +let warn cond s = + if cond then report ("Warning: "^s) else ();; + +(* ------------------------------------------------------------------------- *) +(* Flags to switch on verbose mode. *) +(* ------------------------------------------------------------------------- *) + +let verbose = ref true;; +let report_timing = ref true;; + +(* ------------------------------------------------------------------------- *) +(* Switchable version of "report". *) +(* ------------------------------------------------------------------------- *) + +let remark s = + if !verbose then report s else ();; + +(* ------------------------------------------------------------------------- *) +(* Time a function. *) +(* ------------------------------------------------------------------------- *) + +let time f x = + if not (!report_timing) then f x else + let start_time = Sys.time() in + try let result = f x in + let finish_time = Sys.time() in + report("CPU time (user): "^(string_of_float(finish_time -. start_time))); + result + with e -> + let finish_time = Sys.time() in + Format.print_string("Failed after (user) CPU time of "^ + (string_of_float(finish_time -. start_time))^": "); + raise e;; + +(* ------------------------------------------------------------------------- *) +(* Versions of assoc and rev_assoc with default rather than failure. *) +(* ------------------------------------------------------------------------- *) + +let rec assocd a l d = + match l with + [] -> d + | (x,y)::t -> if Pervasives.compare x a = 0 then y else assocd a t d;; + +let rec rev_assocd a l d = + match l with + [] -> d + | (x,y)::t -> if Pervasives.compare y a = 0 then x else rev_assocd a t d;; + +(* ------------------------------------------------------------------------- *) +(* Version of map that avoids rebuilding unchanged subterms. *) +(* ------------------------------------------------------------------------- *) + +let rec qmap f l = + match l with + h::t -> let h' = f h and t' = qmap f t in + if h' == h & t' == t then l else h'::t' + | _ -> l;; + +(* ------------------------------------------------------------------------- *) +(* Merging and bottom-up mergesort. *) +(* ------------------------------------------------------------------------- *) + +let rec merge ord l1 l2 = + match l1 with + [] -> l2 + | h1::t1 -> match l2 with + [] -> l1 + | h2::t2 -> if ord h1 h2 then h1::(merge ord t1 l2) + else h2::(merge ord l1 t2);; + +let mergesort ord = + let rec mergepairs l1 l2 = + match (l1,l2) with + ([s],[]) -> s + | (l,[]) -> mergepairs [] l + | (l,[s1]) -> mergepairs (s1::l) [] + | (l,(s1::s2::ss)) -> mergepairs ((merge ord s1 s2)::l) ss in + fun l -> if l = [] then [] else mergepairs [] (map (fun x -> [x]) l);; + +(* ------------------------------------------------------------------------- *) +(* Common measure predicates to use with "sort". *) +(* ------------------------------------------------------------------------- *) + +let increasing f x y = Pervasives.compare (f x) (f y) < 0;; + +let decreasing f x y = Pervasives.compare (f x) (f y) > 0;; + +(* ------------------------------------------------------------------------- *) +(* Polymorphic finite partial functions via Patricia trees. *) +(* *) +(* The point of this strange representation is that it is canonical (equal *) +(* functions have the same encoding) yet reasonably efficient on average. *) +(* *) +(* Idea due to Diego Olivier Fernandez Pons (OCaml list, 2003/11/10). *) +(* ------------------------------------------------------------------------- *) + +type ('a,'b)func = + Empty + | Leaf of int * ('a*'b)list + | Branch of int * int * ('a,'b)func * ('a,'b)func;; + +(* ------------------------------------------------------------------------- *) +(* Undefined function. *) +(* ------------------------------------------------------------------------- *) + +let undefined = Empty;; + +(* ------------------------------------------------------------------------- *) +(* In case of equality comparison worries, better use this. *) +(* ------------------------------------------------------------------------- *) + +let is_undefined f = + match f with + Empty -> true + | _ -> false;; + +(* ------------------------------------------------------------------------- *) +(* Operation analagous to "map" for lists. *) +(* ------------------------------------------------------------------------- *) + +let mapf = + let rec map_list f l = + match l with + [] -> [] + | (x,y)::t -> (x,f(y))::(map_list f t) in + let rec mapf f t = + match t with + Empty -> Empty + | Leaf(h,l) -> Leaf(h,map_list f l) + | Branch(p,b,l,r) -> Branch(p,b,mapf f l,mapf f r) in + mapf;; + +(* ------------------------------------------------------------------------- *) +(* Operations analogous to "fold" for lists. *) +(* ------------------------------------------------------------------------- *) + +let foldl = + let rec foldl_list f a l = + match l with + [] -> a + | (x,y)::t -> foldl_list f (f a x y) t in + let rec foldl f a t = + match t with + Empty -> a + | Leaf(h,l) -> foldl_list f a l + | Branch(p,b,l,r) -> foldl f (foldl f a l) r in + foldl;; + +let foldr = + let rec foldr_list f l a = + match l with + [] -> a + | (x,y)::t -> f x y (foldr_list f t a) in + let rec foldr f t a = + match t with + Empty -> a + | Leaf(h,l) -> foldr_list f l a + | Branch(p,b,l,r) -> foldr f l (foldr f r a) in + foldr;; + +(* ------------------------------------------------------------------------- *) +(* Mapping to sorted-list representation of the graph, domain and range. *) +(* ------------------------------------------------------------------------- *) + +let graph f = setify (foldl (fun a x y -> (x,y)::a) [] f);; + +let dom f = setify(foldl (fun a x y -> x::a) [] f);; + +let ran f = setify(foldl (fun a x y -> y::a) [] f);; + +(* ------------------------------------------------------------------------- *) +(* Application. *) +(* ------------------------------------------------------------------------- *) + +let applyd = + let rec apply_listd l d x = + match l with + (a,b)::t -> let c = Pervasives.compare x a in + if c = 0 then b else if c > 0 then apply_listd t d x else d x + | [] -> d x in + fun f d x -> + let k = Hashtbl.hash x in + let rec look t = + match t with + Leaf(h,l) when h = k -> apply_listd l d x + | Branch(p,b,l,r) when (k lxor p) land (b - 1) = 0 + -> look (if k land b = 0 then l else r) + | _ -> d x in + look f;; + +let apply f = applyd f (fun x -> failwith "apply");; + +let tryapplyd f a d = applyd f (fun x -> d) a;; + +let defined f x = try apply f x; true with Failure _ -> false;; + +(* ------------------------------------------------------------------------- *) +(* Undefinition. *) +(* ------------------------------------------------------------------------- *) + +let undefine = + let rec undefine_list x l = + match l with + (a,b as ab)::t -> + let c = Pervasives.compare x a in + if c = 0 then t + else if c < 0 then l else + let t' = undefine_list x t in + if t' == t then l else ab::t' + | [] -> [] in + fun x -> + let k = Hashtbl.hash x in + let rec und t = + match t with + Leaf(h,l) when h = k -> + let l' = undefine_list x l in + if l' == l then t + else if l' = [] then Empty + else Leaf(h,l') + | Branch(p,b,l,r) when k land (b - 1) = p -> + if k land b = 0 then + let l' = und l in + if l' == l then t + else (match l' with Empty -> r | _ -> Branch(p,b,l',r)) + else + let r' = und r in + if r' == r then t + else (match r' with Empty -> l | _ -> Branch(p,b,l,r')) + | _ -> t in + und;; + +(* ------------------------------------------------------------------------- *) +(* Redefinition and combination. *) +(* ------------------------------------------------------------------------- *) + +let (|->),combine = + let newbranch p1 t1 p2 t2 = + let zp = p1 lxor p2 in + let b = zp land (-zp) in + let p = p1 land (b - 1) in + if p1 land b = 0 then Branch(p,b,t1,t2) + else Branch(p,b,t2,t1) in + let rec define_list (x,y as xy) l = + match l with + (a,b as ab)::t -> + let c = Pervasives.compare x a in + if c = 0 then xy::t + else if c < 0 then xy::l + else ab::(define_list xy t) + | [] -> [xy] + and combine_list op z l1 l2 = + match (l1,l2) with + [],_ -> l2 + | _,[] -> l1 + | ((x1,y1 as xy1)::t1,(x2,y2 as xy2)::t2) -> + let c = Pervasives.compare x1 x2 in + if c < 0 then xy1::(combine_list op z t1 l2) + else if c > 0 then xy2::(combine_list op z l1 t2) else + let y = op y1 y2 and l = combine_list op z t1 t2 in + if z(y) then l else (x1,y)::l in + let (|->) x y = + let k = Hashtbl.hash x in + let rec upd t = + match t with + Empty -> Leaf (k,[x,y]) + | Leaf(h,l) -> + if h = k then Leaf(h,define_list (x,y) l) + else newbranch h t k (Leaf(k,[x,y])) + | Branch(p,b,l,r) -> + if k land (b - 1) <> p then newbranch p t k (Leaf(k,[x,y])) + else if k land b = 0 then Branch(p,b,upd l,r) + else Branch(p,b,l,upd r) in + upd in + let rec combine op z t1 t2 = + match (t1,t2) with + Empty,_ -> t2 + | _,Empty -> t1 + | Leaf(h1,l1),Leaf(h2,l2) -> + if h1 = h2 then + let l = combine_list op z l1 l2 in + if l = [] then Empty else Leaf(h1,l) + else newbranch h1 t1 h2 t2 + | (Leaf(k,lis) as lf),(Branch(p,b,l,r) as br) -> + if k land (b - 1) = p then + if k land b = 0 then + (match combine op z lf l with + Empty -> r | l' -> Branch(p,b,l',r)) + else + (match combine op z lf r with + Empty -> l | r' -> Branch(p,b,l,r')) + else + newbranch k lf p br + | (Branch(p,b,l,r) as br),(Leaf(k,lis) as lf) -> + if k land (b - 1) = p then + if k land b = 0 then + (match combine op z l lf with + Empty -> r | l' -> Branch(p,b,l',r)) + else + (match combine op z r lf with + Empty -> l | r' -> Branch(p,b,l,r')) + else + newbranch p br k lf + | Branch(p1,b1,l1,r1),Branch(p2,b2,l2,r2) -> + if b1 < b2 then + if p2 land (b1 - 1) <> p1 then newbranch p1 t1 p2 t2 + else if p2 land b1 = 0 then + (match combine op z l1 t2 with + Empty -> r1 | l -> Branch(p1,b1,l,r1)) + else + (match combine op z r1 t2 with + Empty -> l1 | r -> Branch(p1,b1,l1,r)) + else if b2 < b1 then + if p1 land (b2 - 1) <> p2 then newbranch p1 t1 p2 t2 + else if p1 land b2 = 0 then + (match combine op z t1 l2 with + Empty -> r2 | l -> Branch(p2,b2,l,r2)) + else + (match combine op z t1 r2 with + Empty -> l2 | r -> Branch(p2,b2,l2,r)) + else if p1 = p2 then + (match (combine op z l1 l2,combine op z r1 r2) with + (Empty,r) -> r | (l,Empty) -> l | (l,r) -> Branch(p1,b1,l,r)) + else + newbranch p1 t1 p2 t2 in + (|->),combine;; + +(* ------------------------------------------------------------------------- *) +(* Special case of point function. *) +(* ------------------------------------------------------------------------- *) + +let (|=>) = fun x y -> (x |-> y) undefined;; + +(* ------------------------------------------------------------------------- *) +(* Grab an arbitrary element. *) +(* ------------------------------------------------------------------------- *) + +let rec choose t = + match t with + Empty -> failwith "choose: completely undefined function" + | Leaf(h,l) -> hd l + | Branch(b,p,t1,t2) -> choose t1;; + +(* ------------------------------------------------------------------------- *) +(* Install a trivial printer for the general polymorphic case. *) +(* ------------------------------------------------------------------------- *) + +let print_fpf (f:('a,'b)func) = Format.print_string "";; + +#install_printer print_fpf;; + +(* ------------------------------------------------------------------------- *) +(* Set operations parametrized by equality (from Steven Obua). *) +(* ------------------------------------------------------------------------- *) + +let rec mem' eq = + let rec mem x lis = + match lis with + [] -> false + | (h::t) -> eq x h or mem x t + in mem;; + +let insert' eq x l = + if mem' eq x l then l else x::l;; + +let union' eq l1 l2 = itlist (insert' eq) l1 l2;; + +let unions' eq l = itlist (union' eq) l [];; + +let subtract' eq l1 l2 = filter (fun x -> not (mem' eq x l2)) l1;; + +(* ------------------------------------------------------------------------- *) +(* Accepts decimal, hex or binary numeral, using C notation 0x... for hex *) +(* and analogous 0b... for binary. *) +(* ------------------------------------------------------------------------- *) + +let num_of_string = + let values = + ["0",0; "1",1; "2",2; "3",3; "4",4; + "5",5; "6",6; "7",7; "8",8; "9",9; + "a",10; "A",10; "b",11; "B",11; + "c",12; "C",12; "d",13; "D",13; + "e",14; "E",14; "f",15; "F",15] in + let valof b s = + let v = Int(assoc s values) in + if v failwith "num_of_string: no digits after base indicator" + | [h] -> valof b h + | h::t -> valof b h +/ b */ num_of_stringlist b t in + fun s -> + match explode(s) with + [] -> failwith "num_of_string: no digits" + | "0"::"x"::hexdigits -> num_of_stringlist sixteen (rev hexdigits) + | "0"::"b"::bindigits -> num_of_stringlist two (rev bindigits) + | decdigits -> num_of_stringlist ten (rev decdigits);; + +(* ------------------------------------------------------------------------- *) +(* Convenient conversion between files and (lists of) strings. *) +(* ------------------------------------------------------------------------- *) + +let strings_of_file filename = + let fd = try Pervasives.open_in filename + with Sys_error _ -> + failwith("strings_of_file: can't open "^filename) in + let rec suck_lines acc = + try let l = Pervasives.input_line fd in + suck_lines (l::acc) + with End_of_file -> rev acc in + let data = suck_lines [] in + (Pervasives.close_in fd; data);; + +let string_of_file filename = + end_itlist (fun s t -> s^"\n"^t) (strings_of_file filename);; + +let file_of_string filename s = + let fd = Pervasives.open_out filename in + output_string fd s; close_out fd;; diff --git a/lists.ml b/lists.ml new file mode 100644 index 0000000..92401bc --- /dev/null +++ b/lists.ml @@ -0,0 +1,551 @@ +(* ========================================================================= *) +(* Theory of lists, plus characters and strings as lists of characters. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "ind_types.ml";; + +(* ------------------------------------------------------------------------- *) +(* Standard tactic for list induction using MATCH_MP_TAC list_INDUCT *) +(* ------------------------------------------------------------------------- *) + +let LIST_INDUCT_TAC = + let list_INDUCT = prove + (`!P:(A)list->bool. P [] /\ (!h t. P t ==> P (CONS h t)) ==> !l. P l`, + MATCH_ACCEPT_TAC list_INDUCT) in + MATCH_MP_TAC list_INDUCT THEN + CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN GEN_TAC THEN DISCH_TAC];; + +(* ------------------------------------------------------------------------- *) +(* Basic definitions. *) +(* ------------------------------------------------------------------------- *) + +let HD = new_recursive_definition list_RECURSION + `HD(CONS (h:A) t) = h`;; + +let TL = new_recursive_definition list_RECURSION + `TL(CONS (h:A) t) = t`;; + +let APPEND = new_recursive_definition list_RECURSION + `(!l:(A)list. APPEND [] l = l) /\ + (!h t l. APPEND (CONS h t) l = CONS h (APPEND t l))`;; + +let REVERSE = new_recursive_definition list_RECURSION + `(REVERSE [] = []) /\ + (REVERSE (CONS (x:A) l) = APPEND (REVERSE l) [x])`;; + +let LENGTH = new_recursive_definition list_RECURSION + `(LENGTH [] = 0) /\ + (!h:A. !t. LENGTH (CONS h t) = SUC (LENGTH t))`;; + +let MAP = new_recursive_definition list_RECURSION + `(!f:A->B. MAP f NIL = NIL) /\ + (!f h t. MAP f (CONS h t) = CONS (f h) (MAP f t))`;; + +let LAST = new_recursive_definition list_RECURSION + `LAST (CONS (h:A) t) = if t = [] then h else LAST t`;; + +let BUTLAST = new_recursive_definition list_RECURSION + `(BUTLAST [] = []) /\ + (BUTLAST (CONS h t) = if t = [] then [] else CONS h (BUTLAST t))`;; + +let REPLICATE = new_recursive_definition num_RECURSION + `(REPLICATE 0 x = []) /\ + (REPLICATE (SUC n) x = CONS x (REPLICATE n x))`;; + +let NULL = new_recursive_definition list_RECURSION + `(NULL [] = T) /\ + (NULL (CONS h t) = F)`;; + +let ALL = new_recursive_definition list_RECURSION + `(ALL P [] = T) /\ + (ALL P (CONS h t) <=> P h /\ ALL P t)`;; + +let EX = new_recursive_definition list_RECURSION + `(EX P [] = F) /\ + (EX P (CONS h t) <=> P h \/ EX P t)`;; + +let ITLIST = new_recursive_definition list_RECURSION + `(ITLIST f [] b = b) /\ + (ITLIST f (CONS h t) b = f h (ITLIST f t b))`;; + +let MEM = new_recursive_definition list_RECURSION + `(MEM x [] <=> F) /\ + (MEM x (CONS h t) <=> (x = h) \/ MEM x t)`;; + +let ALL2_DEF = new_recursive_definition list_RECURSION + `(ALL2 P [] l2 <=> (l2 = [])) /\ + (ALL2 P (CONS h1 t1) l2 <=> + if l2 = [] then F + else P h1 (HD l2) /\ ALL2 P t1 (TL l2))`;; + +let ALL2 = prove + (`(ALL2 P [] [] <=> T) /\ + (ALL2 P (CONS h1 t1) [] <=> F) /\ + (ALL2 P [] (CONS h2 t2) <=> F) /\ + (ALL2 P (CONS h1 t1) (CONS h2 t2) <=> P h1 h2 /\ ALL2 P t1 t2)`, + REWRITE_TAC[distinctness "list"; ALL2_DEF; HD; TL]);; + +let MAP2_DEF = new_recursive_definition list_RECURSION + `(MAP2 f [] l = []) /\ + (MAP2 f (CONS h1 t1) l = CONS (f h1 (HD l)) (MAP2 f t1 (TL l)))`;; + +let MAP2 = prove + (`(MAP2 f [] [] = []) /\ + (MAP2 f (CONS h1 t1) (CONS h2 t2) = CONS (f h1 h2) (MAP2 f t1 t2))`, + REWRITE_TAC[MAP2_DEF; HD; TL]);; + +let EL = new_recursive_definition num_RECURSION + `(EL 0 l = HD l) /\ + (EL (SUC n) l = EL n (TL l))`;; + +let FILTER = new_recursive_definition list_RECURSION + `(FILTER P [] = []) /\ + (FILTER P (CONS h t) = if P h then CONS h (FILTER P t) else FILTER P t)`;; + +let ASSOC = new_recursive_definition list_RECURSION + `ASSOC a (CONS h t) = if FST h = a then SND h else ASSOC a t`;; + +let ITLIST2_DEF = new_recursive_definition list_RECURSION + `(ITLIST2 f [] l2 b = b) /\ + (ITLIST2 f (CONS h1 t1) l2 b = f h1 (HD l2) (ITLIST2 f t1 (TL l2) b))`;; + +let ITLIST2 = prove + (`(ITLIST2 f [] [] b = b) /\ + (ITLIST2 f (CONS h1 t1) (CONS h2 t2) b = f h1 h2 (ITLIST2 f t1 t2 b))`, + REWRITE_TAC[ITLIST2_DEF; HD; TL]);; + +let ZIP_DEF = new_recursive_definition list_RECURSION + `(ZIP [] l2 = []) /\ + (ZIP (CONS h1 t1) l2 = CONS (h1,HD l2) (ZIP t1 (TL l2)))`;; + +let ZIP = prove + (`(ZIP [] [] = []) /\ + (ZIP (CONS h1 t1) (CONS h2 t2) = CONS (h1,h2) (ZIP t1 t2))`, + REWRITE_TAC[ZIP_DEF; HD; TL]);; + +(* ------------------------------------------------------------------------- *) +(* Various trivial theorems. *) +(* ------------------------------------------------------------------------- *) + +let NOT_CONS_NIL = prove + (`!(h:A) t. ~(CONS h t = [])`, + REWRITE_TAC[distinctness "list"]);; + +let LAST_CLAUSES = prove + (`(LAST [h:A] = h) /\ + (LAST (CONS h (CONS k t)) = LAST (CONS k t))`, + REWRITE_TAC[LAST; NOT_CONS_NIL]);; + +let APPEND_NIL = prove + (`!l:A list. APPEND l [] = l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND]);; + +let APPEND_ASSOC = prove + (`!(l:A list) m n. APPEND l (APPEND m n) = APPEND (APPEND l m) n`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND]);; + +let REVERSE_APPEND = prove + (`!(l:A list) m. REVERSE (APPEND l m) = APPEND (REVERSE m) (REVERSE l)`, + LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[APPEND; REVERSE; APPEND_NIL; APPEND_ASSOC]);; + +let REVERSE_REVERSE = prove + (`!l:A list. REVERSE(REVERSE l) = l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[REVERSE; REVERSE_APPEND; APPEND]);; + +let CONS_11 = prove + (`!(h1:A) h2 t1 t2. (CONS h1 t1 = CONS h2 t2) <=> (h1 = h2) /\ (t1 = t2)`, + REWRITE_TAC[injectivity "list"]);; + +let list_CASES = prove + (`!l:(A)list. (l = []) \/ ?h t. l = CONS h t`, + LIST_INDUCT_TAC THEN REWRITE_TAC[CONS_11; NOT_CONS_NIL] THEN + MESON_TAC[]);; + +let LENGTH_APPEND = prove + (`!(l:A list) m. LENGTH(APPEND l m) = LENGTH l + LENGTH m`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; LENGTH; ADD_CLAUSES]);; + +let MAP_APPEND = prove + (`!f:A->B. !l1 l2. MAP f (APPEND l1 l2) = APPEND (MAP f l1) (MAP f l2)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; APPEND]);; + +let LENGTH_MAP = prove + (`!l. !f:A->B. LENGTH (MAP f l) = LENGTH l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; LENGTH]);; + +let LENGTH_EQ_NIL = prove + (`!l:A list. (LENGTH l = 0) <=> (l = [])`, + LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_CONS_NIL; NOT_SUC]);; + +let LENGTH_EQ_CONS = prove + (`!l n. (LENGTH l = SUC n) <=> ?h t. (l = CONS h t) /\ (LENGTH t = n)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; NOT_SUC; NOT_CONS_NIL] THEN + ASM_REWRITE_TAC[SUC_INJ; CONS_11] THEN MESON_TAC[]);; + +let MAP_o = prove + (`!f:A->B. !g:B->C. !l. MAP (g o f) l = MAP g (MAP f l)`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[MAP; o_THM]);; + +let MAP_EQ = prove + (`!f g l. ALL (\x. f x = g x) l ==> (MAP f l = MAP g l)`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[MAP; ALL] THEN ASM_MESON_TAC[]);; + +let ALL_IMP = prove + (`!P Q l. (!x. MEM x l /\ P x ==> Q x) /\ ALL P l ==> ALL Q l`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[MEM; ALL] THEN ASM_MESON_TAC[]);; + +let NOT_EX = prove + (`!P l. ~(EX P l) <=> ALL (\x. ~(P x)) l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[EX; ALL; DE_MORGAN_THM]);; + +let NOT_ALL = prove + (`!P l. ~(ALL P l) <=> EX (\x. ~(P x)) l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[EX; ALL; DE_MORGAN_THM]);; + +let ALL_MAP = prove + (`!P f l. ALL P (MAP f l) <=> ALL (P o f) l`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[ALL; MAP; o_THM]);; + +let ALL_T = prove + (`!l. ALL (\x. T) l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL]);; + +let MAP_EQ_ALL2 = prove + (`!l m. ALL2 (\x y. f x = f y) l m ==> (MAP f l = MAP f m)`, + REPEAT LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; ALL2; CONS_11] THEN + ASM_MESON_TAC[]);; + +let ALL2_MAP = prove + (`!P f l. ALL2 P (MAP f l) l <=> ALL (\a. P (f a) a) l`, + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2; MAP; ALL]);; + +let MAP_EQ_DEGEN = prove + (`!l f. ALL (\x. f(x) = x) l ==> (MAP f l = l)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; MAP; CONS_11] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let ALL2_AND_RIGHT = prove + (`!l m P Q. ALL2 (\x y. P x /\ Q x y) l m <=> ALL P l /\ ALL2 Q l m`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; ALL2] THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; ALL2] THEN + REWRITE_TAC[CONJ_ACI]);; + +let ITLIST_APPEND = prove + (`!f a l1 l2. ITLIST f (APPEND l1 l2) a = ITLIST f l1 (ITLIST f l2 a)`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[ITLIST; APPEND]);; + +let ITLIST_EXTRA = prove + (`!l. ITLIST f (APPEND l [a]) b = ITLIST f l (f a b)`, + REWRITE_TAC[ITLIST_APPEND; ITLIST]);; + +let ALL_MP = prove + (`!P Q l. ALL (\x. P x ==> Q x) l /\ ALL P l ==> ALL Q l`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[ALL] THEN ASM_MESON_TAC[]);; + +let AND_ALL = prove + (`!l. ALL P l /\ ALL Q l <=> ALL (\x. P x /\ Q x) l`, + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL; CONJ_ACI]);; + +let EX_IMP = prove + (`!P Q l. (!x. MEM x l /\ P x ==> Q x) /\ EX P l ==> EX Q l`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[MEM; EX] THEN ASM_MESON_TAC[]);; + +let ALL_MEM = prove + (`!P l. (!x. MEM x l ==> P x) <=> ALL P l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; MEM] THEN + ASM_MESON_TAC[]);; + +let LENGTH_REPLICATE = prove + (`!n x. LENGTH(REPLICATE n x) = n`, + INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; REPLICATE]);; + +let EX_MAP = prove + (`!P f l. EX P (MAP f l) <=> EX (P o f) l`, + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP; EX; o_THM]);; + +let EXISTS_EX = prove + (`!P l. (?x. EX (P x) l) <=> EX (\s. ?x. P x s) l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EX] THEN + ASM_MESON_TAC[]);; + +let FORALL_ALL = prove + (`!P l. (!x. ALL (P x) l) <=> ALL (\s. !x. P x s) l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN + ASM_MESON_TAC[]);; + +let MEM_APPEND = prove + (`!x l1 l2. MEM x (APPEND l1 l2) <=> MEM x l1 \/ MEM x l2`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; APPEND; DISJ_ACI]);; + +let MEM_MAP = prove + (`!f y l. MEM y (MAP f l) <=> ?x. MEM x l /\ (y = f x)`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[MEM; MAP] THEN MESON_TAC[]);; + +let FILTER_APPEND = prove + (`!P l1 l2. FILTER P (APPEND l1 l2) = APPEND (FILTER P l1) (FILTER P l2)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[FILTER; APPEND] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[APPEND]);; + +let FILTER_MAP = prove + (`!P f l. FILTER P (MAP f l) = MAP f (FILTER (P o f) l)`, + GEN_TAC THEN GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[MAP; FILTER; o_THM] THEN COND_CASES_TAC THEN + REWRITE_TAC[MAP]);; + +let MEM_FILTER = prove + (`!P l x. MEM x (FILTER P l) <=> P x /\ MEM x l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; FILTER] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[MEM] THEN + ASM_MESON_TAC[]);; + +let EX_MEM = prove + (`!P l. (?x. P x /\ MEM x l) <=> EX P l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[EX; MEM] THEN + ASM_MESON_TAC[]);; + +let MAP_FST_ZIP = prove + (`!l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP FST (ZIP l1 l2) = l1)`, + LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN + ASM_SIMP_TAC[LENGTH; SUC_INJ; MAP; FST; ZIP; NOT_SUC]);; + +let MAP_SND_ZIP = prove + (`!l1 l2. (LENGTH l1 = LENGTH l2) ==> (MAP SND (ZIP l1 l2) = l2)`, + LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN + ASM_SIMP_TAC[LENGTH; SUC_INJ; MAP; FST; ZIP; NOT_SUC]);; + +let MEM_ASSOC = prove + (`!l x. MEM (x,ASSOC x l) l <=> MEM x (MAP FST l)`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MEM; MAP; ASSOC] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[PAIR; FST]);; + +let ALL_APPEND = prove + (`!P l1 l2. ALL P (APPEND l1 l2) <=> ALL P l1 /\ ALL P l2`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[ALL; APPEND; GSYM CONJ_ASSOC]);; + +let MEM_EL = prove + (`!l n. n < LENGTH l ==> MEM (EL n l) l`, + LIST_INDUCT_TAC THEN REWRITE_TAC[MEM; CONJUNCT1 LT; LENGTH] THEN + INDUCT_TAC THEN ASM_SIMP_TAC[EL; HD; LT_SUC; TL]);; + +let MEM_EXISTS_EL = prove + (`!l x. MEM x l <=> ?i. i < LENGTH l /\ x = EL i l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[LENGTH; EL; MEM; CONJUNCT1 LT] THEN + GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV + [MESON[num_CASES] `(?i. P i) <=> P 0 \/ (?i. P(SUC i))`] THEN + REWRITE_TAC[LT_SUC; LT_0; EL; HD; TL]);; + +let ALL_EL = prove + (`!P l. (!i. i < LENGTH l ==> P (EL i l)) <=> ALL P l`, + REWRITE_TAC[GSYM ALL_MEM; MEM_EXISTS_EL] THEN MESON_TAC[]);; + +let ALL2_MAP2 = prove + (`!l m. ALL2 P (MAP f l) (MAP g m) = ALL2 (\x y. P (f x) (g y)) l m`, + LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2; MAP]);; + +let AND_ALL2 = prove + (`!P Q l m. ALL2 P l m /\ ALL2 Q l m <=> ALL2 (\x y. P x y /\ Q x y) l m`, + GEN_TAC THEN GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL2] THEN + REWRITE_TAC[CONJ_ACI]);; + +let ALL2_ALL = prove + (`!P l. ALL2 P l l <=> ALL (\x. P x x) l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[ALL2; ALL]);; + +let APPEND_EQ_NIL = prove + (`!l m. (APPEND l m = []) <=> (l = []) /\ (m = [])`, + REWRITE_TAC[GSYM LENGTH_EQ_NIL; LENGTH_APPEND; ADD_EQ_0]);; + +let LENGTH_MAP2 = prove + (`!f l m. (LENGTH l = LENGTH m) ==> (LENGTH(MAP2 f l m) = LENGTH m)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN LIST_INDUCT_TAC THEN + ASM_SIMP_TAC[LENGTH; NOT_CONS_NIL; NOT_SUC; MAP2; SUC_INJ]);; + +let MAP_EQ_NIL = prove + (`!f l. MAP f l = [] <=> l = []`, + GEN_TAC THEN LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; NOT_CONS_NIL]);; + +let INJECTIVE_MAP = prove + (`!f:A->B. (!l m. MAP f l = MAP f m ==> l = m) <=> + (!x y. f x = f y ==> x = y)`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`[x:A]`; `[y:A]`]) THEN + ASM_REWRITE_TAC[MAP; CONS_11]; + REPEAT LIST_INDUCT_TAC THEN ASM_SIMP_TAC[MAP; NOT_CONS_NIL; CONS_11] THEN + ASM_MESON_TAC[]]);; + +let SURJECTIVE_MAP = prove + (`!f:A->B. (!m. ?l. MAP f l = m) <=> (!y. ?x. f x = y)`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [X_GEN_TAC `y:B` THEN FIRST_X_ASSUM(MP_TAC o SPEC `[y:B]`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[MAP; CONS_11; NOT_CONS_NIL; MAP_EQ_NIL]; + MATCH_MP_TAC list_INDUCT] THEN + ASM_MESON_TAC[MAP]);; + +let MAP_ID = prove + (`!l. MAP (\x. x) l = l`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[MAP]);; + +let MAP_I = prove + (`MAP I = I`, + REWRITE_TAC[FUN_EQ_THM; I_DEF; MAP_ID]);; + +let APPEND_BUTLAST_LAST = prove + (`!l. ~(l = []) ==> APPEND (BUTLAST l) [LAST l] = l`, + LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; BUTLAST; NOT_CONS_NIL] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[APPEND]);; + +let LAST_APPEND = prove + (`!p q. LAST(APPEND p q) = if q = [] then LAST p else LAST q`, + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[APPEND; LAST; APPEND_EQ_NIL] THEN + MESON_TAC[]);; + +let LENGTH_TL = prove + (`!l. ~(l = []) ==> LENGTH(TL l) = LENGTH l - 1`, + LIST_INDUCT_TAC THEN REWRITE_TAC[LENGTH; TL; ARITH; SUC_SUB1]);; + +let EL_APPEND = prove + (`!k l m. EL k (APPEND l m) = if k < LENGTH l then EL k l + else EL (k - LENGTH l) m`, + INDUCT_TAC THEN REWRITE_TAC[EL] THEN + LIST_INDUCT_TAC THEN + REWRITE_TAC[HD; APPEND; LENGTH; SUB_0; EL; LT_0; CONJUNCT1 LT] THEN + ASM_REWRITE_TAC[TL; LT_SUC; SUB_SUC]);; + +let EL_TL = prove + (`!n. EL n (TL l) = EL (n + 1) l`, + REWRITE_TAC[GSYM ADD1; EL]);; + +let EL_CONS = prove + (`!n h t. EL n (CONS h t) = if n = 0 then h else EL (n - 1) t`, + INDUCT_TAC THEN REWRITE_TAC[EL; HD; TL; NOT_SUC; SUC_SUB1]);; + +let LAST_EL = prove + (`!l. ~(l = []) ==> LAST l = EL (LENGTH l - 1) l`, + LIST_INDUCT_TAC THEN REWRITE_TAC[LAST; LENGTH; SUC_SUB1] THEN + DISCH_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[LENGTH; EL; HD; EL_CONS; LENGTH_EQ_NIL]);; + +let HD_APPEND = prove + (`!l m:A list. HD(APPEND l m) = if l = [] then HD m else HD l`, + LIST_INDUCT_TAC THEN REWRITE_TAC[HD; APPEND; NOT_CONS_NIL]);; + +let CONS_HD_TL = prove + (`!l. ~(l = []) ==> l = CONS (HD l) (TL l)`, + LIST_INDUCT_TAC THEN REWRITE_TAC[NOT_CONS_NIL;HD;TL]);; + +let EL_MAP = prove + (`!f n l. n < LENGTH l ==> EL n (MAP f l) = f(EL n l)`, + GEN_TAC THEN INDUCT_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[LENGTH; CONJUNCT1 LT; LT_0; EL; HD; TL; MAP; LT_SUC]);; + +let MAP_REVERSE = prove + (`!f l. REVERSE(MAP f l) = MAP f (REVERSE l)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[MAP; REVERSE; MAP_APPEND]);; + +let ALL_FILTER = prove + (`!P Q l:A list. ALL P (FILTER Q l) <=> ALL (\x. Q x ==> P x) l`, + GEN_TAC THEN GEN_TAC THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[ALL; FILTER] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[ALL]);; + +let APPEND_SING = prove + (`!h t. APPEND [h] t = CONS h t`, + REWRITE_TAC[APPEND]);; + +let MEM_APPEND_DECOMPOSE_LEFT = prove + (`!x:A l. MEM x l <=> ?l1 l2. ~(MEM x l1) /\ l = APPEND l1 (CONS x l2)`, + REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; MEM_APPEND; MEM] THEN X_GEN_TAC `x:A` THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[MEM] THEN + MAP_EVERY X_GEN_TAC [`y:A`; `l:A list`] THEN + ASM_CASES_TAC `x:A = y` THEN ASM_MESON_TAC[MEM; APPEND]);; + +let MEM_APPEND_DECOMPOSE = prove + (`!x:A l. MEM x l <=> ?l1 l2. l = APPEND l1 (CONS x l2)`, + REWRITE_TAC[TAUT `(p <=> q) <=> (p ==> q) /\ (q ==> p)`] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM; MEM_APPEND; MEM] THEN + ONCE_REWRITE_TAC[MEM_APPEND_DECOMPOSE_LEFT] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Syntax. *) +(* ------------------------------------------------------------------------- *) + +let mk_cons h t = + try let cons = mk_const("CONS",[type_of h,aty]) in + mk_comb(mk_comb(cons,h),t) + with Failure _ -> failwith "mk_cons";; + +let mk_list (tms,ty) = + try let nil = mk_const("NIL",[ty,aty]) in + if tms = [] then nil else + let cons = mk_const("CONS",[ty,aty]) in + itlist (mk_binop cons) tms nil + with Failure _ -> failwith "mk_list";; + +let mk_flist tms = + try mk_list(tms,type_of(hd tms)) + with Failure _ -> failwith "mk_flist";; + +(* ------------------------------------------------------------------------- *) +(* Extra monotonicity theorems for inductive definitions. *) +(* ------------------------------------------------------------------------- *) + +let MONO_ALL = prove + (`(!x:A. P x ==> Q x) ==> ALL P l ==> ALL Q l`, + DISCH_TAC THEN SPEC_TAC(`l:A list`,`l:A list`) THEN + LIST_INDUCT_TAC THEN ASM_REWRITE_TAC[ALL] THEN ASM_MESON_TAC[]);; + +let MONO_ALL2 = prove + (`(!x y. (P:A->B->bool) x y ==> Q x y) ==> ALL2 P l l' ==> ALL2 Q l l'`, + DISCH_TAC THEN + SPEC_TAC(`l':B list`,`l':B list`) THEN SPEC_TAC(`l:A list`,`l:A list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[ALL2_DEF] THEN + GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +monotonicity_theorems := [MONO_ALL; MONO_ALL2] @ !monotonicity_theorems;; + +(* ------------------------------------------------------------------------- *) +(* Apply a conversion down a list. *) +(* ------------------------------------------------------------------------- *) + +let rec LIST_CONV conv tm = + if is_cons tm then + COMB2_CONV (RAND_CONV conv) (LIST_CONV conv) tm + else if fst(dest_const tm) = "NIL" then REFL tm + else failwith "LIST_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Type of characters, like the HOL88 "ascii" type. *) +(* ------------------------------------------------------------------------- *) + +let char_INDUCT,char_RECURSION = define_type + "char = ASCII bool bool bool bool bool bool bool bool";; + +new_type_abbrev("string",`:char list`);; diff --git a/make.ml b/make.ml new file mode 100644 index 0000000..eb4b437 --- /dev/null +++ b/make.ml @@ -0,0 +1,54 @@ +(* ========================================================================= *) +(* Create a standalone HOL image. Assumes that we are running under Linux *) +(* and have the program "ckpt" available to create checkpoints. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +#use "hol.ml";; + +(* ------------------------------------------------------------------------- *) +(* Record the build date and OCaml version for the startup banner. *) +(* ------------------------------------------------------------------------- *) + +#load "unix.cma";; + +let startup_banner = + let {Unix.tm_mday = d;Unix.tm_mon = m;Unix.tm_year = y;Unix.tm_wday = w} = + Unix.localtime(Unix.time()) in + let nice_date = string_of_int d ^ " " ^ + el m ["January"; "February"; "March"; "April"; "May"; "June"; + "July"; "August"; "September"; "October"; "November"; "December"] ^ + " " ^ string_of_int(1900+y) in + " HOL Light "^hol_version^ + ", built "^nice_date^" on OCaml "^Sys.ocaml_version;; + +(* ------------------------------------------------------------------------- *) +(* Self-destruct to create checkpoint file; print banner when restarted. *) +(* ------------------------------------------------------------------------- *) + +let self_destruct bannerstring = + let longer_banner = startup_banner ^ " with ckpt" in + let complete_banner = + if bannerstring = "" then longer_banner + else longer_banner^"\n "^bannerstring in + (Gc.compact(); + ignore(Unix.system "sleep 1s; kill -USR1 $PPID"); + Format.print_string complete_banner; + Format.print_newline(); Format.print_newline());; + +(* ------------------------------------------------------------------------- *) +(* Non-destructive checkpoint using CryoPID "freeze". *) +(* ------------------------------------------------------------------------- *) + +let checkpoint bannerstring = + let rec waste_time n = if n = 0 then () else waste_time(n - 1) in + let longer_banner = startup_banner ^ " with CryoPID" in + let complete_banner = + if bannerstring = "" then longer_banner + else longer_banner^"\n "^bannerstring in + (Gc.compact(); + ignore(Unix.system "(sleep 1s; freeze -l hol.snapshot $PPID) &"); + waste_time 100000000; + Format.print_string complete_banner; + Format.print_newline(); Format.print_newline());; diff --git a/meson.ml b/meson.ml new file mode 100644 index 0000000..d89d747 --- /dev/null +++ b/meson.ml @@ -0,0 +1,831 @@ +(* ========================================================================= *) +(* Version of the MESON procedure a la PTTP. Various search options. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "canon.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some parameters controlling MESON behaviour. *) +(* ------------------------------------------------------------------------- *) + +let meson_depth = ref false;; (* Use depth not inference bound. *) + +let meson_prefine = ref true;; (* Use Plaisted's positive refinement. *) + +let meson_dcutin = ref 1;; (* Min size for d-and-c optimization cut-in. *) + +let meson_skew = ref 3;; (* Skew proof bias (one side is <= n / skew) *) + +let meson_brand = ref false;; (* Use Brand transformation *) + +let meson_split_limit = ref 8;; (* Limit of case splits before MESON proper *) + +let meson_chatty = ref false;; (* Old-style verbose MESON output *) + +(* ------------------------------------------------------------------------- *) +(* Prolog exception. *) +(* ------------------------------------------------------------------------- *) + +exception Cut;; + +(* ------------------------------------------------------------------------- *) +(* Shadow syntax for FOL terms in NNF. Functions and predicates have *) +(* numeric codes, and negation is done by negating the predicate code. *) +(* ------------------------------------------------------------------------- *) + +type fol_term = Fvar of int + | Fnapp of int * fol_term list;; + +type fol_atom = int * fol_term list;; + +type fol_form = Atom of fol_atom + | Conj of fol_form * fol_form + | Disj of fol_form * fol_form + | Forallq of int * fol_form;; + +(* ------------------------------------------------------------------------- *) +(* Type for recording a MESON proof tree. *) +(* ------------------------------------------------------------------------- *) + +type fol_goal = + Subgoal of fol_atom * fol_goal list * (int * thm) * + int * (fol_term * int)list;; + +(* ------------------------------------------------------------------------- *) +(* General MESON procedure, using assumptions and with settable limits. *) +(* ------------------------------------------------------------------------- *) + +let GEN_MESON_TAC = + + let offinc = 10000 + and inferences = ref 0 in + + (* ----------------------------------------------------------------------- *) + (* Like partition, but with short-circuiting for special situation. *) + (* ----------------------------------------------------------------------- *) + + let qpartition p m = + let rec qpartition l = + if l == m then raise Unchanged else + match l with + [] -> raise Unchanged + | (h::t) -> if p h then + try let yes,no = qpartition t in h::yes,no + with Unchanged -> [h],t + else + let yes,no = qpartition t in yes,h::no in + function l -> try qpartition l + with Unchanged -> [],l in + + (* ----------------------------------------------------------------------- *) + (* Translate a term (in NNF) into the shadow syntax. *) + (* ----------------------------------------------------------------------- *) + + let reset_vars,fol_of_var,hol_of_var = + let vstore = ref [] + and gstore = ref [] + and vcounter = ref 0 in + let inc_vcounter() = + let n = !vcounter in + let m = n + 1 in + if m >= offinc then failwith "inc_vcounter: too many variables" else + (vcounter := m; n) in + let reset_vars() = vstore := []; gstore := []; vcounter := 0 in + let fol_of_var v = + let currentvars = !vstore in + try assoc v currentvars with Failure _ -> + let n = inc_vcounter() in + vstore := (v,n)::currentvars; n in + let hol_of_var v = + try rev_assoc v (!vstore) + with Failure _ -> rev_assoc v (!gstore) in + let hol_of_bumped_var v = + try hol_of_var v with Failure _ -> + let v' = v mod offinc in + let hv' = hol_of_var v' in + let gv = genvar(type_of hv') in + gstore := (gv,v)::(!gstore); gv in + reset_vars,fol_of_var,hol_of_bumped_var in + + let reset_consts,fol_of_const,hol_of_const = + let false_tm = `F` in + let cstore = ref ([]:(term * int)list) + and ccounter = ref 2 in + let reset_consts() = cstore := [false_tm,1]; ccounter := 2 in + let fol_of_const c = + let currentconsts = !cstore in + try assoc c currentconsts with Failure _ -> + let n = !ccounter in + ccounter := n + 1; cstore := (c,n)::currentconsts; n in + let hol_of_const c = rev_assoc c (!cstore) in + reset_consts,fol_of_const,hol_of_const in + + let rec fol_of_term env consts tm = + if is_var tm & not (mem tm consts) then + Fvar(fol_of_var tm) + else + let f,args = strip_comb tm in + if mem f env then failwith "fol_of_term: higher order" else + let ff = fol_of_const f in + Fnapp(ff,map (fol_of_term env consts) args) in + + let fol_of_atom env consts tm = + let f,args = strip_comb tm in + if mem f env then failwith "fol_of_atom: higher order" else + let ff = fol_of_const f in + ff,map (fol_of_term env consts) args in + + let fol_of_literal env consts tm = + try let tm' = dest_neg tm in + let p,a = fol_of_atom env consts tm' in + -p,a + with Failure _ -> fol_of_atom env consts tm in + + let rec fol_of_form env consts tm = + try let v,bod = dest_forall tm in + let fv = fol_of_var v in + let fbod = fol_of_form (v::env) (subtract consts [v]) bod in + Forallq(fv,fbod) + with Failure _ -> try + let l,r = dest_conj tm in + let fl = fol_of_form env consts l + and fr = fol_of_form env consts r in + Conj(fl,fr) + with Failure _ -> try + let l,r = dest_disj tm in + let fl = fol_of_form env consts l + and fr = fol_of_form env consts r in + Disj(fl,fr) + with Failure _ -> + Atom(fol_of_literal env consts tm) in + + (* ----------------------------------------------------------------------- *) + (* Further translation functions for HOL formulas. *) + (* ----------------------------------------------------------------------- *) + + let rec hol_of_term tm = + match tm with + Fvar v -> hol_of_var v + | Fnapp(f,args) -> list_mk_comb(hol_of_const f,map hol_of_term args) in + + let hol_of_atom (p,args) = + list_mk_comb(hol_of_const p,map hol_of_term args) in + + let hol_of_literal (p,args) = + if p < 0 then mk_neg(hol_of_atom(-p,args)) + else hol_of_atom (p,args) in + + (* ----------------------------------------------------------------------- *) + (* Versions of shadow syntax operations with variable bumping. *) + (* ----------------------------------------------------------------------- *) + + let rec fol_free_in v tm = + match tm with + Fvar x -> x = v + | Fnapp(_,lis) -> exists (fol_free_in v) lis in + + let rec fol_subst theta tm = + match tm with + Fvar v -> rev_assocd v theta tm + | Fnapp(f,args) -> + let args' = qmap (fol_subst theta) args in + if args' == args then tm else Fnapp(f,args') in + + let fol_inst theta ((p,args) as at:fol_atom) = + let args' = qmap (fol_subst theta) args in + if args' == args then at else p,args' in + + let rec fol_subst_bump offset theta tm = + match tm with + Fvar v -> if v < offinc then + let v' = v + offset in + rev_assocd v' theta (Fvar(v')) + else + rev_assocd v theta tm + | Fnapp(f,args) -> + let args' = qmap (fol_subst_bump offset theta) args in + if args' == args then tm else Fnapp(f,args') in + + let fol_inst_bump offset theta ((p,args) as at:fol_atom) = + let args' = qmap (fol_subst_bump offset theta) args in + if args' == args then at else p,args' in + + (* ----------------------------------------------------------------------- *) + (* Main unification function, maintaining a "graph" instantiation. *) + (* We implicitly apply an offset to variables in the second term, so this *) + (* is not symmetric between the arguments. *) + (* ----------------------------------------------------------------------- *) + + let rec istriv env x t = + match t with + Fvar y -> y = x or + (try let t' = rev_assoc y env in istriv env x t' + with Failure "find" -> false) + | Fnapp(f,args) -> exists (istriv env x) args & failwith "cyclic" in + + let rec fol_unify offset tm1 tm2 sofar = + match tm1,tm2 with + Fnapp(f,fargs),Fnapp(g,gargs) -> + if f <> g then failwith "" else + itlist2 (fol_unify offset) fargs gargs sofar + | _,Fvar(x) -> + (let x' = x + offset in + try let tm2' = rev_assoc x' sofar in + fol_unify 0 tm1 tm2' sofar + with Failure "find" -> + if istriv sofar x' tm1 then sofar + else (tm1,x')::sofar) + | Fvar(x),_ -> + (try let tm1' = rev_assoc x sofar in + fol_unify offset tm1' tm2 sofar + with Failure "find" -> + let tm2' = fol_subst_bump offset [] tm2 in + if istriv sofar x tm2' then sofar + else (tm2',x)::sofar) in + + (* ----------------------------------------------------------------------- *) + (* Test for equality under the pending instantiations. *) + (* ----------------------------------------------------------------------- *) + + let rec fol_eq insts tm1 tm2 = + tm1 == tm2 or + match tm1,tm2 with + Fnapp(f,fargs),Fnapp(g,gargs) -> + f = g & forall2 (fol_eq insts) fargs gargs + | _,Fvar(x) -> + (try let tm2' = rev_assoc x insts in + fol_eq insts tm1 tm2' + with Failure "find" -> + try istriv insts x tm1 with Failure _ -> false) + | Fvar(x),_ -> + (try let tm1' = rev_assoc x insts in + fol_eq insts tm1' tm2 + with Failure "find" -> + try istriv insts x tm2 with Failure _ -> false) in + + let fol_atom_eq insts (p1,args1) (p2,args2) = + p1 = p2 & forall2 (fol_eq insts) args1 args2 in + + (* ----------------------------------------------------------------------- *) + (* Cacheing continuations. Very crude, but it works remarkably well. *) + (* ----------------------------------------------------------------------- *) + + let cacheconts f = + let memory = ref [] in + fun (gg,(insts,offset,size) as input) -> + if exists (fun (_,(insts',_,size')) -> + insts = insts' & (size <= size' or !meson_depth)) + (!memory) + then failwith "cachecont" + else memory := input::(!memory); f input in + + (* ----------------------------------------------------------------------- *) + (* Check ancestor list for repetition. *) + (* ----------------------------------------------------------------------- *) + + let checkan insts (p,a) ancestors = + let p' = -p in + let t' = (p',a) in + try let ours = assoc p' ancestors in + if exists (fun u -> fol_atom_eq insts t' (snd(fst u))) ours + then failwith "checkan" + else ancestors + with Failure "find" -> ancestors in + + (* ----------------------------------------------------------------------- *) + (* Insert new goal's negation in ancestor clause, given refinement. *) + (* ----------------------------------------------------------------------- *) + + let insertan insts (p,a) ancestors = + let p' = -p in + let t' = (p',a) in + let ourancp,otheranc = + try remove (fun (pr,_) -> pr = p') ancestors + with Failure _ -> (p',[]),ancestors in + let ouranc = snd ourancp in + if exists (fun u -> fol_atom_eq insts t' (snd(fst u))) ouranc + then failwith "insertan: loop" + else (p',(([],t'),(0,TRUTH))::ouranc)::otheranc in + + (* ----------------------------------------------------------------------- *) + (* Apply a multi-level "graph" instantiation. *) + (* ----------------------------------------------------------------------- *) + + let rec fol_subst_partial insts tm = + match tm with + Fvar(v) -> (try let t = rev_assoc v insts in + fol_subst_partial insts t + with Failure "find" -> tm) + | Fnapp(f,args) -> Fnapp(f,map (fol_subst_partial insts) args) in + + (* ----------------------------------------------------------------------- *) + (* Tease apart local and global instantiations. *) + (* At the moment we also force a full evaluation; should eliminate this. *) + (* ----------------------------------------------------------------------- *) + + let separate_insts offset oldinsts newinsts = + let locins,globins = + qpartition (fun (_,v) -> offset <= v) oldinsts newinsts in + if globins = oldinsts then + map (fun (t,x) -> fol_subst_partial newinsts t,x) locins,oldinsts + else + map (fun (t,x) -> fol_subst_partial newinsts t,x) locins, + map (fun (t,x) -> fol_subst_partial newinsts t,x) globins in + + (* ----------------------------------------------------------------------- *) + (* Perform basic MESON expansion. *) + (* ----------------------------------------------------------------------- *) + + let meson_single_expand loffset rule ((g,ancestors),(insts,offset,size)) = + let (hyps,conc),tag = rule in + let allins = rev_itlist2 (fol_unify loffset) (snd g) (snd conc) insts in + let locin,globin = separate_insts offset insts allins in + let mk_ihyp h = + let h' = fol_inst_bump offset locin h in + h',checkan insts h' ancestors in + let newhyps = map mk_ihyp hyps in + inferences := !inferences + 1; + newhyps,(globin,offset+offinc,size-length hyps) in + + (* ----------------------------------------------------------------------- *) + (* Perform first basic expansion which allows continuation call. *) + (* ----------------------------------------------------------------------- *) + + let meson_expand_cont loffset rules state cont = + tryfind + (fun r -> cont (snd r) (meson_single_expand loffset r state)) rules in + + (* ----------------------------------------------------------------------- *) + (* Try expansion and continuation call with ancestor or initial rule. *) + (* ----------------------------------------------------------------------- *) + + let meson_expand rules ((g,ancestors),((insts,offset,size) as tup)) cont = + let pr = fst g in + let newancestors = insertan insts g ancestors in + let newstate = (g,newancestors),tup in + try if !meson_prefine & pr > 0 then failwith "meson_expand" else + let arules = assoc pr ancestors in + meson_expand_cont 0 arules newstate cont + with Cut -> failwith "meson_expand" | Failure _ -> + try let crules = + filter (fun ((h,_),_) -> length h <= size) (assoc pr rules) in + meson_expand_cont offset crules newstate cont + with Cut -> failwith "meson_expand" + | Failure _ -> failwith "meson_expand" in + + (* ----------------------------------------------------------------------- *) + (* Simple Prolog engine organizing search and backtracking. *) + (* ----------------------------------------------------------------------- *) + + let expand_goal rules = + let rec expand_goal depth ((g,_),(insts,offset,size) as state) cont = + if depth < 0 then failwith "expand_goal: too deep" else + meson_expand rules state + (fun apprule (_,(pinsts,_,_) as newstate) -> + expand_goals (depth-1) newstate + (cacheconts(fun (gs,(newinsts,newoffset,newsize)) -> + let locin,globin = separate_insts offset pinsts newinsts in + let g' = Subgoal(g,gs,apprule,offset,locin) in + if globin = insts & gs = [] then + try cont(g',(globin,newoffset,size)) + with Failure _ -> raise Cut + else + try cont(g',(globin,newoffset,newsize)) + with Cut -> failwith "expand_goal" + | Failure _ -> failwith "expand_goal"))) + + and expand_goals depth (gl,(insts,offset,size as tup)) cont = + match gl with + [] -> cont ([],tup) + + | [g] -> expand_goal depth (g,tup) (fun (g',stup) -> cont([g'],stup)) + + | gl -> if size >= !meson_dcutin then + let lsize = size / (!meson_skew) in + let rsize = size - lsize in + let lgoals,rgoals = chop_list (length gl / 2) gl in + try expand_goals depth (lgoals,(insts,offset,lsize)) + (cacheconts(fun (lg',(i,off,n)) -> + expand_goals depth (rgoals,(i,off,n + rsize)) + (cacheconts(fun (rg',ztup) -> cont (lg'@rg',ztup))))) + with Failure _ -> + expand_goals depth (rgoals,(insts,offset,lsize)) + (cacheconts(fun (rg',(i,off,n)) -> + expand_goals depth (lgoals,(i,off,n + rsize)) + (cacheconts (fun (lg',((_,_,fsize) as ztup)) -> + if n + rsize <= lsize + fsize + then failwith "repetition of demigoal pair" + else cont (lg'@rg',ztup))))) + else + let g::gs = gl in + expand_goal depth (g,tup) + (cacheconts(fun (g',stup) -> + expand_goals depth (gs,stup) + (cacheconts(fun (gs',ftup) -> cont(g'::gs',ftup))))) in + + fun g maxdep maxinf cont -> + expand_goal maxdep (g,([],2 * offinc,maxinf)) cont in + + (* ----------------------------------------------------------------------- *) + (* With iterative deepening of inferences or depth. *) + (* ----------------------------------------------------------------------- *) + + let solve_goal rules incdepth min max incsize = + let rec solve n g = + if n > max then failwith "solve_goal: Too deep" else + (if !meson_chatty & !verbose then + (Format.print_string + ((string_of_int (!inferences))^" inferences so far. "^ + "Searching with maximum size "^(string_of_int n)^"."); + Format.print_newline()) + else if !verbose then + (Format.print_string(string_of_int (!inferences)^".."); + Format.print_flush()) + else ()); + try let gi = + if incdepth then expand_goal rules g n 100000 (fun x -> x) + else expand_goal rules g 100000 n (fun x -> x) in + (if !meson_chatty & !verbose then + (Format.print_string + ("Goal solved with "^(string_of_int (!inferences))^ + " inferences."); + Format.print_newline()) + else if !verbose then + (Format.print_string("solved at "^string_of_int (!inferences)); + Format.print_newline()) + else ()); + gi + with Failure _ -> solve (n + incsize) g in + fun g -> solve min (g,[]) in + + (* ----------------------------------------------------------------------- *) + (* Creation of tagged contrapositives from a HOL clause. *) + (* This includes any possible support clauses (1 = falsity). *) + (* The rules are partitioned into association lists. *) + (* ----------------------------------------------------------------------- *) + + let fol_of_hol_clauses = + let eqt (a1,(b1,c1)) (a2, (b2,c2)) = + ((a1 = a2) & (b1 = b2) & (equals_thm c1 c2)) in + let mk_negated (p,a) = -p,a in + let rec mk_contraposes n th used unused sofar = + match unused with + [] -> sofar + | h::t -> let nw = (map mk_negated (used @ t),h),(n,th) in + mk_contraposes (n + 1) th (used@[h]) t (nw::sofar) in + let fol_of_hol_clause th = + let lconsts = freesl (hyp th) in + let tm = concl th in + let hlits = disjuncts tm in + let flits = map (fol_of_literal [] lconsts) hlits in + let basics = mk_contraposes 0 th [] flits [] in + if forall (fun (p,_) -> p < 0) flits then + ((map mk_negated flits,(1,[])),(-1,th))::basics + else basics in + fun thms -> + let rawrules = itlist (union' eqt o fol_of_hol_clause) thms [] in + let prs = setify (map (fst o snd o fst) rawrules) in + let prules = + map (fun t -> t,filter ((=) t o fst o snd o fst) rawrules) prs in + let srules = sort (fun (p,_) (q,_) -> abs(p) <= abs(q)) prules in + srules in + + (* ----------------------------------------------------------------------- *) + (* Optimize set of clauses; changing literal order complicates HOL stuff. *) + (* ----------------------------------------------------------------------- *) + + let optimize_rules = + let optimize_clause_order cls = + sort (fun ((l1,_),_) ((l2,_),_) -> length l1 <= length l2) cls in + map (fun (a,b) -> a,optimize_clause_order b) in + + (* ----------------------------------------------------------------------- *) + (* Create a HOL contrapositive on demand, with a cache. *) + (* ----------------------------------------------------------------------- *) + + let clear_contrapos_cache,make_hol_contrapos = + let DISJ_AC = AC DISJ_ACI + and imp_CONV = REWR_CONV(TAUT `a \/ b <=> ~b ==> a`) + and push_CONV = + GEN_REWRITE_CONV TOP_SWEEP_CONV + [TAUT `~(a \/ b) <=> ~a /\ ~b`; TAUT `~(~a) <=> a`] + and pull_CONV = GEN_REWRITE_CONV DEPTH_CONV + [TAUT `~a \/ ~b <=> ~(a /\ b)`] + and imf_CONV = REWR_CONV(TAUT `~p <=> p ==> F`) in + let memory = ref [] in + let clear_contrapos_cache() = memory := [] in + let make_hol_contrapos (n,th) = + let tm = concl th in + let key = (n,tm) in + try assoc key (!memory) with Failure _ -> + if n < 0 then + CONV_RULE (pull_CONV THENC imf_CONV) th + else + let djs = disjuncts tm in + let acth = + if n = 0 then th else + let ldjs,rdjs = chop_list n djs in + let ndjs = (hd rdjs)::(ldjs@(tl rdjs)) in + EQ_MP (DISJ_AC(mk_eq(tm,list_mk_disj ndjs))) th in + let fth = + if length djs = 1 then acth + else CONV_RULE (imp_CONV THENC push_CONV) acth in + (memory := (key,fth)::(!memory); fth) in + clear_contrapos_cache,make_hol_contrapos in + + (* ----------------------------------------------------------------------- *) + (* Translate back the saved proof into HOL. *) + (* ----------------------------------------------------------------------- *) + + let meson_to_hol = + let hol_negate tm = + try dest_neg tm with Failure _ -> mk_neg tm in + let merge_inst (t,x) current = + (fol_subst current t,x)::current in + let finish_RULE = + GEN_REWRITE_RULE I + [TAUT `(~p ==> p) <=> p`; TAUT `(p ==> ~p) <=> ~p`] in + let rec meson_to_hol insts (Subgoal(g,gs,(n,th),offset,locin)) = + let newins = itlist merge_inst locin insts in + let g' = fol_inst newins g in + let hol_g = hol_of_literal g' in + let ths = map (meson_to_hol newins) gs in + let hth = + if equals_thm th TRUTH then ASSUME hol_g else + let cth = make_hol_contrapos(n,th) in + if ths = [] then cth else MATCH_MP cth (end_itlist CONJ ths) in + let ith = PART_MATCH I hth hol_g in + finish_RULE (DISCH (hol_negate(concl ith)) ith) in + meson_to_hol in + + (* ----------------------------------------------------------------------- *) + (* Create equality axioms for all the function and predicate symbols in *) + (* a HOL term. Not very efficient (but then neither is throwing them into *) + (* automated proof search!) *) + (* ----------------------------------------------------------------------- *) + + let create_equality_axioms = + let eq_thms = (CONJUNCTS o prove) + (`(x:A = x) /\ + (~(x:A = y) \/ ~(x = z) \/ (y = z))`, + REWRITE_TAC[] THEN ASM_CASES_TAC `x:A = y` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC TAUT) in + let imp_elim_CONV = REWR_CONV + (TAUT `(a ==> b) <=> ~a \/ b`) in + let eq_elim_RULE = + MATCH_MP(TAUT `(a <=> b) ==> b \/ ~a`) in + let veq_tm = rator(rator(concl(hd eq_thms))) in + let create_equivalence_axioms (eq,_) = + let tyins = type_match (type_of veq_tm) (type_of eq) [] in + map (INST_TYPE tyins) eq_thms in + let rec tm_consts tm acc = + let fn,args = strip_comb tm in + if args = [] then acc + else itlist tm_consts args (insert (fn,length args) acc) in + let rec fm_consts tm ((preds,funs) as acc) = + try fm_consts(snd(dest_forall tm)) acc with Failure _ -> + try fm_consts(snd(dest_exists tm)) acc with Failure _ -> + try let l,r = dest_conj tm in fm_consts l (fm_consts r acc) + with Failure _ -> try + let l,r = dest_disj tm in fm_consts l (fm_consts r acc) + with Failure _ -> try + let l,r = dest_imp tm in fm_consts l (fm_consts r acc) + with Failure _ -> try + fm_consts (dest_neg tm) acc with Failure _ -> + try let l,r = dest_eq tm in + if type_of l = bool_ty + then fm_consts r (fm_consts l acc) + else failwith "atomic equality" + with Failure _ -> + let pred,args = strip_comb tm in + if args = [] then acc else + insert (pred,length args) preds,itlist tm_consts args funs in + let create_congruence_axiom pflag (tm,len) = + let atys,rty = splitlist (fun ty -> let op,l = dest_type ty in + if op = "fun" then hd l,hd(tl l) + else fail()) + (type_of tm) in + let ctys = fst(chop_list len atys) in + let largs = map genvar ctys + and rargs = map genvar ctys in + let th1 = rev_itlist (C (curry MK_COMB)) (map (ASSUME o mk_eq) + (zip largs rargs)) (REFL tm) in + let th2 = if pflag then eq_elim_RULE th1 else th1 in + itlist (fun e th -> CONV_RULE imp_elim_CONV (DISCH e th)) (hyp th2) th2 in + fun tms -> let preds,funs = itlist fm_consts tms ([],[]) in + let eqs0,noneqs = partition + (fun (t,_) -> is_const t & fst(dest_const t) = "=") preds in + if eqs0 = [] then [] else + let pcongs = map (create_congruence_axiom true) noneqs + and fcongs = map (create_congruence_axiom false) funs in + let preds1,_ = + itlist fm_consts (map concl (pcongs @ fcongs)) ([],[]) in + let eqs1 = filter + (fun (t,_) -> is_const t & fst(dest_const t) = "=") preds1 in + let eqs = union eqs0 eqs1 in + let equivs = + itlist (union' equals_thm o create_equivalence_axioms) + eqs [] in + equivs@pcongs@fcongs in + + (* ----------------------------------------------------------------------- *) + (* Brand's transformation. *) + (* ----------------------------------------------------------------------- *) + + let perform_brand_modification = + let rec subterms_irrefl lconsts tm acc = + if is_var tm or is_const tm then acc else + let fn,args = strip_comb tm in + itlist (subterms_refl lconsts) args acc + and subterms_refl lconsts tm acc = + if is_var tm then if mem tm lconsts then insert tm acc else acc + else if is_const tm then insert tm acc else + let fn,args = strip_comb tm in + itlist (subterms_refl lconsts) args (insert tm acc) in + let CLAUSIFY = CONV_RULE(REWR_CONV(TAUT `a ==> b <=> ~a \/ b`)) in + let rec BRAND tms th = + if tms = [] then th else + let tm = hd tms in + let gv = genvar (type_of tm) in + let eq = mk_eq(gv,tm) in + let th' = CLAUSIFY (DISCH eq (SUBS [SYM (ASSUME eq)] th)) + and tms' = map (subst [gv,tm]) (tl tms) in + BRAND tms' th' in + let BRAND_CONGS th = + let lconsts = freesl (hyp th) in + let lits = disjuncts (concl th) in + let atoms = map (fun t -> try dest_neg t with Failure _ -> t) lits in + let eqs,noneqs = partition + (fun t -> try fst(dest_const(fst(strip_comb t))) = "=" + with Failure _ -> false) atoms in + let acc = itlist (subterms_irrefl lconsts) noneqs [] in + let uts = itlist + (itlist (subterms_irrefl lconsts) o snd o strip_comb) eqs acc in + let sts = sort (fun s t -> not(free_in s t)) uts in + BRAND sts th in + let BRANDE th = + let tm = concl th in + let l,r = dest_eq tm in + let gv = genvar(type_of l) in + let eq = mk_eq(r,gv) in + CLAUSIFY(DISCH eq (EQ_MP (AP_TERM (rator tm) (ASSUME eq)) th)) in + let LDISJ_CASES th lth rth = + DISJ_CASES th (DISJ1 lth (concl rth)) (DISJ2 (concl lth) rth) in + let ASSOCIATE = CONV_RULE(REWR_CONV(GSYM DISJ_ASSOC)) in + let rec BRAND_TRANS th = + let tm = concl th in + try let l,r = dest_disj tm in + if is_eq l then + let lth = ASSUME l in + let lth1 = BRANDE lth + and lth2 = BRANDE (SYM lth) + and rth = BRAND_TRANS (ASSUME r) in + map (ASSOCIATE o LDISJ_CASES th lth1) rth @ + map (ASSOCIATE o LDISJ_CASES th lth2) rth + else + let rth = BRAND_TRANS (ASSUME r) in + map (LDISJ_CASES th (ASSUME l)) rth + with Failure _ -> + if is_eq tm then [BRANDE th; BRANDE (SYM th)] + else [th] in + let find_eqs = + find_terms (fun t -> try fst(dest_const t) = "=" + with Failure _ -> false) in + let REFLEXATE ths = + let eqs = itlist (union o find_eqs o concl) ths [] in + let tys = map (hd o snd o dest_type o snd o dest_const) eqs in + let gvs = map genvar tys in + itlist (fun v acc -> (REFL v)::acc) gvs ths in + fun ths -> + if exists (can (find_term is_eq o concl)) ths then + let ths' = map BRAND_CONGS ths in + let ths'' = itlist (union' equals_thm o BRAND_TRANS) ths' [] in + REFLEXATE ths'' + else ths in + + (* ----------------------------------------------------------------------- *) + (* Push duplicated copies of poly theorems to match existing assumptions. *) + (* ----------------------------------------------------------------------- *) + + let POLY_ASSUME_TAC = + let rec uniq' eq = + fun l -> + match l with + x::(y::_ as t) -> let t' = uniq' eq t in + if eq x y then t' else + if t'==t then l else x::t' + | _ -> l in + let setify' le eq s = uniq' eq (sort le s) in + let rec grab_constants tm acc = + if is_forall tm or is_exists tm then grab_constants (body(rand tm)) acc + else if is_iff tm or is_imp tm or is_conj tm or is_disj tm then + grab_constants (rand tm) (grab_constants (lhand tm) acc) + else if is_neg tm then grab_constants (rand tm) acc + else union (find_terms is_const tm) acc in + let match_consts (tm1,tm2) = + let s1,ty1 = dest_const tm1 + and s2,ty2 = dest_const tm2 in + if s1 = s2 then type_match ty1 ty2 [] + else failwith "match_consts" in + let polymorph mconsts th = + let tvs = subtract (type_vars_in_term (concl th)) + (unions (map type_vars_in_term (hyp th))) in + if tvs = [] then [th] else + let pconsts = grab_constants (concl th) [] in + let tyins = mapfilter match_consts + (allpairs (fun x y -> x,y) pconsts mconsts) in + let ths' = + setify' (fun th th' -> dest_thm th <= dest_thm th') + equals_thm (mapfilter (C INST_TYPE th) tyins) in + if ths' = [] then + (warn true "No useful-looking instantiations of lemma"; [th]) + else ths' in + let rec polymorph_all mconsts ths acc = + if ths = [] then acc else + let ths' = polymorph mconsts (hd ths) in + let mconsts' = itlist grab_constants (map concl ths') mconsts in + polymorph_all mconsts' (tl ths) (union' equals_thm ths' acc) in + fun ths (asl,w as gl) -> + let mconsts = itlist (grab_constants o concl o snd) asl [] in + let ths' = polymorph_all mconsts ths [] in + MAP_EVERY ASSUME_TAC ths' gl in + + (* ----------------------------------------------------------------------- *) + (* Basic HOL MESON procedure. *) + (* ----------------------------------------------------------------------- *) + + let SIMPLE_MESON_REFUTE min max inc ths = + clear_contrapos_cache(); + inferences := 0; + let old_dcutin = !meson_dcutin in + if !meson_depth then meson_dcutin := 100001 else (); + let ths' = if !meson_brand then perform_brand_modification ths + else ths @ create_equality_axioms (map concl ths) in + let rules = optimize_rules(fol_of_hol_clauses ths') in + let proof,(insts,_,_) = + solve_goal rules (!meson_depth) min max inc (1,[]) in + meson_dcutin := old_dcutin; + meson_to_hol insts proof in + + let CONJUNCTS_THEN' ttac cth = + ttac(CONJUNCT1 cth) THEN ttac(CONJUNCT2 cth) in + + let PURE_MESON_TAC min max inc gl = + reset_vars(); reset_consts(); + (FIRST_ASSUM CONTR_TAC ORELSE + W(ACCEPT_TAC o SIMPLE_MESON_REFUTE min max inc o map snd o fst)) gl in + + let QUANT_BOOL_CONV = + PURE_REWRITE_CONV[FORALL_BOOL_THM; EXISTS_BOOL_THM; COND_CLAUSES; + NOT_CLAUSES; IMP_CLAUSES; AND_CLAUSES; OR_CLAUSES; + EQ_CLAUSES; FORALL_SIMP; EXISTS_SIMP] in + + let rec SPLIT_TAC n g = + ((FIRST_X_ASSUM(CONJUNCTS_THEN' ASSUME_TAC) THEN SPLIT_TAC n) ORELSE + (if n > 0 then FIRST_X_ASSUM DISJ_CASES_TAC THEN SPLIT_TAC (n - 1) + else NO_TAC) ORELSE + ALL_TAC) g in + + fun min max step ths -> + REFUTE_THEN ASSUME_TAC THEN + POLY_ASSUME_TAC (map GEN_ALL ths) THEN + W(MAP_EVERY(UNDISCH_TAC o concl o snd) o fst) THEN + SELECT_ELIM_TAC THEN + W(fun (asl,w) -> MAP_EVERY (fun v -> SPEC_TAC(v,v)) (frees w)) THEN + CONV_TAC(PRESIMP_CONV THENC + TOP_DEPTH_CONV BETA_CONV THENC + LAMBDA_ELIM_CONV THENC + CONDS_CELIM_CONV THENC + QUANT_BOOL_CONV) THEN + REPEAT(GEN_TAC ORELSE DISCH_TAC) THEN + REFUTE_THEN ASSUME_TAC THEN + RULE_ASSUM_TAC(CONV_RULE(NNF_CONV THENC SKOLEM_CONV)) THEN + REPEAT (FIRST_X_ASSUM CHOOSE_TAC) THEN + ASM_FOL_TAC THEN + SPLIT_TAC (!meson_split_limit) THEN + RULE_ASSUM_TAC(CONV_RULE(PRENEX_CONV THENC WEAK_CNF_CONV)) THEN + RULE_ASSUM_TAC(repeat + (fun th -> SPEC(genvar(type_of(fst(dest_forall(concl th))))) th)) THEN + REPEAT (FIRST_X_ASSUM (CONJUNCTS_THEN' ASSUME_TAC)) THEN + RULE_ASSUM_TAC(CONV_RULE(ASSOC_CONV DISJ_ASSOC)) THEN + REPEAT (FIRST_X_ASSUM SUBST_VAR_TAC) THEN + PURE_MESON_TAC min max step;; + +(* ------------------------------------------------------------------------- *) +(* Common cases. *) +(* ------------------------------------------------------------------------- *) + +let ASM_MESON_TAC = GEN_MESON_TAC 0 50 1;; + +let MESON_TAC ths = POP_ASSUM_LIST(K ALL_TAC) THEN ASM_MESON_TAC ths;; + +(* ------------------------------------------------------------------------- *) +(* Also introduce a rule. *) +(* ------------------------------------------------------------------------- *) + +let MESON ths tm = prove(tm,MESON_TAC ths);; diff --git a/miz3/Samples/bug0.ml b/miz3/Samples/bug0.ml new file mode 100644 index 0000000..be1409f --- /dev/null +++ b/miz3/Samples/bug0.ml @@ -0,0 +1,72 @@ +prioritize_num();; + +let EGCD_INVARIANT = thm `; + !m n d. d divides egcd(m,n) <=> d divides m /\ d divides n + proof + let m n be num; + (!m'' n'. + m'' + n' < m + n + ==> (!d. d divides egcd (m'',n') <=> + d divides m'' /\ d divides n')) + ==> (!d. d divides egcd (m,n) <=> d divides m /\ d divides n) [1] + proof + assume !m'' n'. + m'' + n' < m + n + ==> (!d. d divides egcd (m'',n') <=> + d divides m'' /\ d divides n') [2]; + !d. d divides + (if m = 0 + then n + else + if n = 0 + then m + else if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> + d divides m /\ d divides n [3] + proof + let d be num; + m = 0 ==> (d divides n <=> d divides m /\ d divides n) [4] + by DIVIDES_0; + ~(m = 0) + ==> (d divides + (if n = 0 + then m + else + if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> + d divides m /\ d divides n) [5] + proof + assume ~(m = 0) [6]; + n = 0 ==> (d divides m <=> d divides m /\ d divides n) [7] + by DIVIDES_0; + ~(n = 0) + ==> (d divides + (if m <= n then egcd (m,n - m) else egcd (m - n,n)) <=> + d divides m /\ d divides n) [8] + proof + assume ~(n = 0) [9]; + m <= n + ==> (d divides egcd (m,n - m) <=> + d divides m /\ d divides n) [10] + proof + assume m <= n; + m + (n - m) < m + n by ARITH_TAC,6; + qed by #; + ~(m <= n) + ==> (d divides egcd (m - n,n) <=> + d divides m /\ d divides n) [11] + proof + assume ~(m <= n); + (m - n) + n < m + n by ARITH_TAC,9; + d divides egcd (m - n,n) <=> d divides m - n /\ d divides n + by 2; + ... <=> d divides (m - n) + n /\ d divides n by DIVIDES_ADD; +:: #1 +:: 1: inference error + qed by 2,DIVIDES_SUB; +:: #1 + qed by COND_CASES_TAC from 10,11; + qed by COND_CASES_TAC from 7,8; + qed by COND_CASES_TAC from 4,5; + qed by ONCE_REWRITE_TAC[egcd] from 3; + qed by WF_INDUCT_TAC (parse_term "m + n") from 1; +:: #1 +`;; diff --git a/miz3/Samples/bug1.ml b/miz3/Samples/bug1.ml new file mode 100644 index 0000000..5bca78d --- /dev/null +++ b/miz3/Samples/bug1.ml @@ -0,0 +1,52 @@ +horizon := -1;; + +let FOO = thm `; + !x n. x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0 [1] + proof + let x be real; + let n be num; + n = 0 + ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0) [2] + proof + assume n = 0 [3]; + qed by ASM_REWRITE_TAC[real_pow],3; + ~(n = 0) + ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) \/ n = 0) [4] + proof + assume ~(n = 0) [5]; + abs x = &1 ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n)) [6] + proof + assume abs x = &1 [7]; + &1 < &0 ==> EVEN n [8] by REAL_ARITH_TAC,5; + &1 pow n = &1 <=> &1 < &0 ==> EVEN n [9] + by ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE],5 from 8; + EVEN n ==> (&1 = &1 <=> -- &1 < &0 ==> T) [10] + proof + assume EVEN n [11]; + qed by ASM_REWRITE_TAC[],5,11; + ~EVEN n ==> (-- &1 = &1 <=> -- &1 < &0 ==> F) [12] + proof + assume ~EVEN n [13]; + -- &1 = &1 <=> ~(-- &1 < &0) [14] by REAL_ARITH_TAC,5,13; + qed by ASM_REWRITE_TAC[],5,13 from 14; + (if EVEN n then &1 else -- &1) = &1 <=> -- &1 < &0 ==> EVEN n [15] + by REPEAT COND_CASES_TAC,5 from 10,12; + -- &1 pow n = &1 <=> -- &1 < &0 ==> EVEN n [16] + by ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE],5 from 15; + x pow n = &1 <=> x < &0 ==> EVEN n [17] + by FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH (parse_term "abs x = a ==> x = a \\/ x = --a"))),5,7 + from 9,16; + x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n) [18] + by ASM_REWRITE_TAC[],5,7 from 17; + qed by ALL_TAC,5,7 from 18; + ~(abs x = &1) + ==> (x pow n = &1 <=> abs x = &1 /\ (x < &0 ==> EVEN n)) [19] + proof + assume ~(abs x = &1) [20]; + qed by ASM_MESON_TAC[REAL_POW_EQ_1_IMP],5,20; +:: #2 +:: 2: inference time-out + qed by ASM_REWRITE_TAC[real_pow],5 from 18; +:: #4 +:: 4: unknown label + qed by ASM_CASES_TAC (parse_term "n = 0") from 2,4;`;; diff --git a/miz3/Samples/bug2.ml b/miz3/Samples/bug2.ml new file mode 100644 index 0000000..98d71b4 --- /dev/null +++ b/miz3/Samples/bug2.ml @@ -0,0 +1,5 @@ +let FOO = thm `; + let P be num->bool; + assume !x. P x \/ ~P x; + thus (~ ~ ?x. P x) ==> ?x. P x; +`;; diff --git a/miz3/Samples/bug3.ml b/miz3/Samples/bug3.ml new file mode 100644 index 0000000..a44947c --- /dev/null +++ b/miz3/Samples/bug3.ml @@ -0,0 +1,3 @@ + let FOO = thm `; + thus T; + `;; diff --git a/miz3/Samples/drinker.ml b/miz3/Samples/drinker.ml new file mode 100644 index 0000000..3c6c455 --- /dev/null +++ b/miz3/Samples/drinker.ml @@ -0,0 +1,36 @@ +horizon := 0;; + +thm `; + assume ?x:A. T [1]; + let P be A->bool; + thus ?x. P x ==> !y. P y + proof + (?x. ~P x) \/ ~(?x. ~P x); // LEM + cases by -; // \/E + suppose ?x. ~P x; + consider x such that + ~P x [2] by -; // ?E + take x; // ?I + assume P x; // ==>I + F by 2,-; // ~E + qed by -; // FE + suppose ~(?x. ~P x) [3]; + consider x such that + (\x:A. T) x by 1; // ?E + take x; // ?I + assume P x; // ==>I + let y be A; // !I + P y \/ ~P y; // LEM + cases by -; // \/E + suppose P y; + qed by -; // + suppose ~P y; + ?y. ~P y + proof + take y; // ?I + qed by -; // + F by 3,-; // ~E + qed by -; // FE + end; + end`;; + diff --git a/miz3/Samples/forster.ml b/miz3/Samples/forster.ml new file mode 100644 index 0000000..edc3a5b --- /dev/null +++ b/miz3/Samples/forster.ml @@ -0,0 +1,389 @@ +(* ======== translation of "The shortest?" from Examples/forster.ml ======== *) + +horizon := 0;; + +let FORSTER_PUZZLE_1 = thm `; + let f be num->num; + thus (!n. f(n + 1) > f(f(n))) ==> !n. f(n) = n + proof + assume !n. f(n + 1) > f(f(n)); + !n. f(f(n)) < f(SUC n) [1] by -,GT,ADD1; + !m n. m <= f(n + m) [2] + proof + !n. 0 <= f(n + 0) [3] by LE_0,ADD_CLAUSES,LE_SUC_LT; + now let m be num; + assume !n. m <= f(n + m); + !n. m < f(SUC (n + m)) by -,1,LET_TRANS,SUB_ADD; + thus !n. SUC m <= f(n + SUC m) by -,LE_0,ADD_CLAUSES,LE_SUC_LT; + end; + qed by INDUCT_TAC,-,3; + !n. f(n) < f(SUC n) [4] by -,1,LET_TRANS,LE_TRANS,ADD_CLAUSES; + !m n. f(m) < f(n) ==> m < n + proof + !n. f(0) < f(n) ==> 0 < n [5] by LT_LE,LE_0,LTE_TRANS,LE_SUC_LT; + now let m be num; + assume !n. f(m) < f(n) ==> m < n; + thus !n. f(SUC m) < f(n) ==> SUC m < n + by -,4,LT_LE,LE_0,LTE_TRANS,LE_SUC_LT; + end; + qed by INDUCT_TAC,-,5; + qed by -,1,2,LE_ANTISYM,ADD_CLAUSES,LT_SUC_LE`;; + +(* ======== long-winded informal proof ===================================== *) + +(* + +Suppose that f(f(n)) < f(n + 1) for all n. We want to +show that f has to be the identity. We will do this by +successively establishing two properties of f (both in a +certain sense being "monotonicity of f"): + + n <= f(n) + + m < n ==> f(m) < f(n) + +The first is the harder one to prove. The second is easy, +but the proof uses the first. Once we know the second +property we know so much about f that the result easily +follows. + +To prove the first, suppose by contradiction that there is a +counterexample, so there is an n with f "going backwards", +i.e., with f(n) < n. Take such a counterexample with f(n) +minimal. (That this minimality is the right one to focus +on is the key to the whole proof for me. Of course one can +present this proof the other way around -- as an induction -- +but the intuition of a descending chain of counterexamples +I find much easier to remember.) Now from the relation + + f(f(n - 1)) < f(n) + +it seems reasonable to look for an n' with f going backwards +that has an image less than f(n). So look at + + n - 1 |-> f(n - 1) |-> f(f(n - 1)) + +and distinguish how f(n - 1) compares to f(n). If it's less, +then the left mapping goes backward to an image < f(n). +(To see that it goes backward, use that f(n) < n, so that +f(n) <= n - 1.) If it's not less, then the right mapping +goes backward to an image < f(n). In both cases we have +a contradiction with the minimality of our choice of n. + +The second kind of monoticity now follows using a trivial +transitivity: + + f(n) <= f(f(n)) < f(n + 1) + +This shows that f(n) < f(n + 1) for all n, from with the +monotonicity of the whole function directly follows. + +Finally to show that f has to be the identity, notice that +a strictly monotonic function always has the property that + + n <= f(n) + +(Of course we knew this already, but I like to just think +about the strict monotonicity of f at this point.) + +However we also can get an upper bound on f(n). A strictly +monototic function always has a strictly monotonic inverse, +and so from the key property + + f(f(n)) < f(n + 1) + +it follows that + + f(n) < n + 1 + +Together this means that we have to have that f(n) = n. + +*) + +(* ======== formal proof sketch of this proof ============================== *) + +horizon := -1;; +sketch_mode := true;; + +let FORSTER_PUZZLE_SKETCH = ref None;; + +FORSTER_PUZZLE_SKETCH := Some `; + let f be num->num; + assume !n. f(f(n)) < f(n + 1); + thus !n. f(n) = n + proof + !n. n <= f(n) + proof + assume ~thesis; + ?n. f(n) < n; + consider n such that f(n) < n /\ + !m. f(m) < m ==> f(n) <= f(m); + cases; + suppose f(n - 1) < f(n); + f(n - 1) < n - 1 /\ f(n - 1) < f(n) + proof + f(n) < n; + f(n) <= n - 1; + qed; + thus F; + end; + suppose f(n) <= f(n - 1); + f(f(n - 1)) < f(n - 1) /\ f(f(n - 1)) < f(n); + thus F; + end; + end; + !m n. m < n ==> f(m) < f(n) + proof + now + let n be num; + f(n) <= f(f(n)) /\ f(f(n)) < f(n + 1); + thus f(n) < f(n + 1); + end; + qed; + let n be num; + n <= f(n); + !m n. f(m) < f(n) ==> m < n; + f(f(n)) < f(n + 1); + f(n) < n + 1; + thus f(n) = n; + end`;; + +sketch_mode := false;; + +(* ======== formalization from this formal proof sketch ==================== *) + +horizon := 1;; + +let FORSTER_PUZZLE_2 = thm `; + let f be num->num; + assume !n. f(f(n)) < f(n + 1) [1]; + thus !n. f(n) = n + proof + !n. n <= f(n) [2] + proof + assume ~thesis; + ?n. f(n) < n by NOT_LE; + ?fn n. f(n) = fn /\ f(n) < n; + consider fn such that (?n. f(n) = fn /\ f(n) < n) /\ + !fm. fm < fn ==> ~(?m. f(m) = fm /\ f(m) < m) [3] + by REWRITE_TAC,GSYM num_WOP; + consider n such that f(n) = fn /\ f(n) < n; + f(n) < n /\ !m. f(m) < m ==> f(n) <= f(m) [4] by 3,NOT_LE; + cases; + suppose f(n - 1) < f(n) [5]; + f(n - 1) < n - 1 /\ f(n - 1) < f(n) + proof + f(n) < n by 4; + f(n) <= n - 1 by ARITH_TAC; + qed by 5,LTE_TRANS; + thus F by 4,NOT_LE; + end; + suppose f(n) <= f(n - 1) [6]; + 0 < n by ARITH_TAC,4; + (n - 1) + 1 = n by ARITH_TAC; + f(f(n - 1)) < f(n) by 1; + f(f(n - 1)) < f(n - 1) /\ f(f(n - 1)) < f(n) by ARITH_TAC,6; + thus F by 4,NOT_LE; + end; + end; + !m n. m < n ==> f(m) < f(n) [7] + proof + now + let n be num; + f(n) <= f(f(n)) /\ f(f(n)) < f(n + 1) by 1,2; + thus f(n) < f(SUC n) by ARITH_TAC; // modified from f(n) < f(n + 1) + end; + qed by LT_TRANS, + SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; + let n be num; + n <= f(n) [8] by 2; // really should be an induction proof from 7 + !m n. f(m) < f(n) ==> m < n [9] by 7,LE_LT,NOT_LE; + f(f(n)) < f(n + 1) by 1; + f(n) < n + 1 by 9; + thus f(n) = n by ARITH_TAC,8; + end`;; + +(* ======== ... and a slightly compressed version ========================== *) + +horizon := 1;; + +let FORSTER_PUZZLE_3 = thm `; + let f be num->num; + assume !n. f(f(n)) < f(n + 1) [1]; + !n. n <= f(n) [2] + proof + assume ~thesis; + ?fn n. f(n) = fn /\ f(n) < n by NOT_LE; + consider fn such that (?n. f(n) = fn /\ f(n) < n) /\ + !fm. fm < fn ==> ~(?m. f(m) = fm /\ f(m) < m) [3] + by REWRITE_TAC,GSYM num_WOP; + consider n such that f(n) = fn /\ f(n) < n [4]; + cases; + suppose f(n - 1) < f(n) [5]; + f(n - 1) < n - 1 by ARITH_TAC,4; + thus F by 3,4,5; + end; + suppose f(n) <= f(n - 1) [6]; + (n - 1) + 1 = n by ARITH_TAC,4; + thus F by 1,3,4,6,LTE_TRANS; + end; + end; + !n. f(n) < f(SUC n) by 1,2,ADD1,LET_TRANS; + !m n. m < n ==> f(m) < f(n) by LT_TRANS, + SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; + !m n. f(m) < f(n) ==> m < n by LE_LT,NOT_LE; + thus !n. f(n) = n by 1,2,ADD1,LE_ANTISYM,LT_SUC_LE`;; + +(* ======== Mizar formalization from the formal proof sketch =============== *) + +(* + +environ + vocabularies RELAT_1, FUNCT_1, ARYTM, ARYTM_1, ORDINAL2; + notations ORDINAL1, RELSET_1, FUNCT_2, NUMBERS, XCMPLX_0, XXREAL_0, NAT_1, + VALUED_0; + constructors XXREAL_0, INT_1, PARTFUN1, VALUED_0, MEMBERED, RELSET_1; + registrations XBOOLE_0, RELAT_1, FUNCT_1, ORDINAL1, XXREAL_0, XREAL_0, + NAT_1, INT_1, VALUED_0, MEMBERED; + requirements NUMERALS, REAL, SUBSET, ARITHM; + theorems XXREAL_0, XREAL_1, INT_1, NAT_1, VALUED_0, VALUED_1, FUNCT_2, + ORDINAL1; + schemes NAT_1; + +begin + reserve n,m,fn,fm for natural number; + reserve f for Function of NAT,NAT; + +theorem + (for n holds f.(f.n) < f.(n + 1)) implies for n holds f.n = n +proof + assume +A1: for n holds f.(f.n) < f.(n + 1); +A2: for n holds n <= f.n + proof + assume +A3: not thesis; + defpred P[Nat] means ex n st f.n < n & f.n = $1; +A4: ex fn st P[fn] by A3; + consider fn being Nat such that +A5: P[fn] & for fm being Nat st P[fm] holds fn <= fm from NAT_1:sch 5(A4); + consider n such that +A6: f.n < n & f.n = fn by A5; + n >= 0 + 1 by A6,NAT_1:13; + then n - 1 >= 0 by XREAL_1:21; + then n - 1 in NAT by INT_1:16; + then reconsider m = n - 1 as natural number; + per cases; + suppose +A7: f.m < f.n; + f.n < m + 1 by A6; + then f.n <= m by NAT_1:13; + then f.m < m by A7,XXREAL_0:2; + hence contradiction by A5,A6,A7; + end; + suppose +A8: f.n <= f.m; +A9: f.(f.m) < f.(m + 1) by A1; + then f.(f.m) < f.m by A8,XXREAL_0:2; + hence contradiction by A5,A6,A9; + end; + end; + now + let n; + f.n <= f.(f.n) & f.(f.n) < f.(n + 1) by A1,A2; + hence f.n < f.(n + 1) by XXREAL_0:2; + end; + then reconsider f as increasing Function of NAT,NAT by VALUED_1:def 13; +A10: now + let m,n; + dom f = NAT & m in NAT & n in NAT by FUNCT_2:def 1,ORDINAL1:def 13; + hence f.m < f.n implies m < n by VALUED_0:def 15; + end; + let n; + f.(f.n) < f.(n + 1) by A1; + then f.n < n + 1 by A10; + then n <= f.n & f.n <= n by A2,NAT_1:13; + hence thesis by XXREAL_0:1; +end; + +*) + +(* ======== miz3 formalization close to the Mizar formalization ============ *) + +horizon := 0;; + +let FORSTER_PUZZLE_4 = thm `; + !f. (!n. f(f(n)) < f(n + 1)) ==> !n. f(n) = n +proof + let f be num->num; + assume !n. f(f(n)) < f(n + 1) [1]; + !n. n <= f(n) [2] + proof + assume ~thesis [3]; + set P = \fn. ?n. f(n) < n /\ f(n) = fn [P]; + ?fn. P(fn) [4] by 3,P,NOT_LE; + consider fn such that P(fn) /\ !fm. P(fm) ==> fn <= fm [5] + by 4,num_WOP,NOT_LE; + consider n such that f(n) < n /\ f(n) = fn [6] by P,5; + set m = n - 1; + n = m + 1 [m] by ARITH_TAC,6; // replaces the reconsider + cases; + suppose f(m) < f(n) [7]; + f(n) < m + 1 by ARITH_TAC,6; + f(n) <= m by ARITH_TAC,-; + f(m) < m by ARITH_TAC,-,7; + f(n) <= f(m) by -,P,5,6; // extra step + thus F by ARITH_TAC,-,7; + end; + suppose f(n) <= f(m) [8]; + f(f(m)) < f(m + 1) [9] by 1; + f(f(m)) < f(m) by -,m,8,LTE_TRANS; + f(n) <= f(f(m)) by -,P,5,6; // extra step + thus F by -,m,9,NOT_LE; + end; + end; + now + let n be num; + f(n) <= f(f(n)) /\ f(f(n)) < f(n + 1) by 1,2; + thus f(n) < f(n + 1) by ARITH_TAC,-; + end; + !n. f(n) < f(SUC n) by -,ADD1; // extra step + !m n. m < n ==> f(m) < f(n) by -,LT_TRANS, + SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; + // replaces the reconsider + now [10] + let m n be num; + thus f(m) < f(n) ==> m < n by -,LE_LT,NOT_LE; + end; + let n be num; + f(f(n)) < f(n + 1) by 1; + f(n) < n + 1 by -,10; + n <= f(n) /\ f(n) <= n by -,2,ADD1,LT_SUC_LE; + thus thesis by ARITH_TAC,-; +end`;; + +(* ======== formalization following Tobias & Sean's version ================ *) + +horizon := 3;; + +let num_MONO_LT_SUC = thm `; + let f be num->num; + assume !n. f(n) < f(SUC n); + !n m. m < n ==> f(m) < f(n) by LT_TRANS, + SPEC (parse_term "\\m n. (f:num->num)(m) < f(n)") TRANSITIVE_STEPWISE_LT; + thus !n m. m < n <=> f(m) < f(n) by LE_LT,NOT_LE`;; + +let FORSTER_PUZZLE_5 = thm `; + let f be num->num; + assume !n. f(f(n)) < f(SUC(n)); + !n m. n <= m ==> n <= f(m) + proof + now let n be num; assume !m. n <= m ==> n <= f(m); + !m. SUC n <= m ==> ?k. m = SUC k by num_CASES,LT,LE_SUC_LT; + thus !m. SUC n <= m ==> SUC n <= f(m) by LE_SUC,LET_TRANS,LE_SUC_LT; + end; + !m. 0 <= m ==> 0 <= f(m); + qed by INDUCT_TAC; + !n. f(n) < f(SUC n) by LE_REFL,LET_TRANS; + thus !n. f(n) = n by num_MONO_LT_SUC,LT_SUC_LE,LE_ANTISYM`;; + diff --git a/miz3/Samples/icms.ml b/miz3/Samples/icms.ml new file mode 100644 index 0000000..5d52ffc --- /dev/null +++ b/miz3/Samples/icms.ml @@ -0,0 +1,157 @@ +(* ------------------------------------------------------------------------- *) +(* From Multivariate/misc.ml *) +(* ------------------------------------------------------------------------- *) + +prioritize_real();; + +let REAL_POW_LBOUND = prove + (`!x n. &0 <= x ==> &1 + &n * x <= (&1 + x) pow n`, + GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_LZERO; REAL_ADD_RID; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 + x) * (&1 + &n * x)` THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_ARITH `&0 <= x ==> &0 <= &1 + x`] THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_POS; REAL_ARITH + `&1 + (n + &1) * x <= (&1 + x) * (&1 + n * x) <=> &0 <= n * x * x`]);; + +let REAL_ARCH_POW = prove + (`!x y. &1 < x ==> ?n. y < x pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `x - &1` REAL_ARCH) THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 + &n * (x - &1)` THEN + ASM_SIMP_TAC[REAL_ARITH `x < y ==> x < &1 + y`] THEN + ASM_MESON_TAC[REAL_POW_LBOUND; REAL_SUB_ADD2; REAL_ARITH + `&1 < x ==> &0 <= x - &1`]);; + +let ABS_CASES = thm `; + !x. x = &0 \/ &0 < abs(x)`;; + +let LL = REAL_ARITH `&1 < k ==> &0 < k`;; + +(* ------------------------------------------------------------------------- *) +(* Miz3 solutions to IMO problem from ICMS 2006. *) +(* ------------------------------------------------------------------------- *) + +horizon := 0;; + +let IMO_1 = thm `; + !k. &1 < k ==> &0 < k [LL] by REAL_ARITH; + now + let f g be real->real; + let x be real; + assume !x y. f (x + y) + f (x - y) = &2 * f x * g y [1]; + assume ~(!x. f x = &0) [2]; + assume !x. abs (f x) <= &1 [3]; + now + let k be real; + assume sup (IMAGE (\x. abs (f x)) (:real)) = k [4]; + ~(IMAGE (\x. abs (f x)) (:real) = {}) /\ (?b. !x. abs (f x) <= b) [5] + by ASM SET_TAC[],-,3; + now + assume !x. abs (f x) <= k [6]; + assume !b. (!x. abs (f x) <= b) ==> k <= b [7]; + now + let y be real; + assume &1 < abs (g y) [8]; + !x. abs (f x) <= k / abs (g y) [9] + by ASM_MESON_TAC[REAL_LE_RDIV_EQ; REAL_ABS_MUL; LL; + REAL_ARITH (parse_term + "u + v = &2 * z /\\ abs u <= k /\\ abs v <= k ==> abs z <= k") + ],-,1,6; + ~(k <= k / abs (g y)) + by TIMED_TAC 2 + (ASM_MESON_TAC[REAL_NOT_LE; REAL_LT_LDIV_EQ; REAL_LT_LMUL; + REAL_MUL_RID; LL; REAL_ARITH (parse_term + "~(z = &0) /\\ abs z <= k ==> &0 < k") + ]),LL,2,6,8; + (!x. abs (f x) <= k / abs (g y)) /\ ~(k <= k / abs (g y)) + by CONJ_TAC,-,9; + ((!x. abs (f x) <= k / abs (g y)) ==> k <= k / abs (g y)) ==> F + by SIMP_TAC[NOT_IMP; NOT_FORALL_THM],-; + thus F by FIRST_X_ASSUM(MP_TAC o + SPEC (parse_term "k / abs(g(y:real))")),-,7; + end; + ~(?y. &1 < abs (g y)) by STRIP_TAC,-; + thus !y. abs (g y) <= &1 + by SIMP_TAC[GSYM REAL_NOT_LT; GSYM NOT_EXISTS_THM],-; + end; + (!x. abs (f x) <= k) /\ (!b. (!x. abs (f x) <= b) ==> k <= b) + ==> (!y. abs (g y) <= &1) by STRIP_TAC,-; + (~(IMAGE (\x. abs (f x)) (:real) = {}) /\ (?b. !x. abs (f x) <= b) + ==> (!x. abs (f x) <= k) /\ (!b. (!x. abs (f x) <= b) ==> k <= b)) + ==> (!y. abs (g y) <= &1) by ANTS_TAC,-,5; + (~(IMAGE (\x. abs (f x)) (:real) = {}) /\ + (?b. !x. x IN IMAGE (\x. abs (f x)) (:real) ==> x <= b) + ==> (!x. x IN IMAGE (\x. abs (f x)) (:real) + ==> x <= sup (IMAGE (\x. abs (f x)) (:real))) /\ + (!b. (!x. x IN IMAGE (\x. abs (f x)) (:real) ==> x <= b) + ==> sup (IMAGE (\x. abs (f x)) (:real)) <= b)) + ==> (!y. abs (g y) <= &1) + by ASM_SIMP_TAC[FORALL_IN_IMAGE; EXISTS_IN_IMAGE; IN_UNIV],-,4; + thus !y. abs (g y) <= &1 + by MP_TAC(SPEC (parse_term "IMAGE (\\x. abs(f(x))) (:real)") SUP),-; + end; + !y. abs (g y) <= &1 + by ABBREV_TAC (parse_term "k = sup (IMAGE (\\x. abs(f(x))) (:real))"),-; + thus abs (g x) <= &1 + by SPEC_TAC ((parse_term "x:real"),(parse_term "y:real")),-; + end; + thus !f g. (!x y. f(x + y) + f(x - y) = &2 * f(x) * g(y)) /\ + ~(!x. f(x) = &0) /\ (!x. abs(f(x)) <= &1) + ==> !x. abs(g(x)) <= &1 by REPEAT STRIP_TAC,-`;; + +horizon := 1;; + +let IMO_2 = thm `; + let f g be real->real; + assume !x y. f (x + y) + f (x - y) = &2 * f x * g y [1]; + assume ~(!x. f x = &0) [2]; + assume !x. abs (f x) <= &1 [3]; + thus !x. abs (g x) <= &1 + proof set s = IMAGE (\x. abs (f x)) (:real); + ~(s = {}) [4] by SET_TAC; + !b. (!y. y IN s ==> y <= b) <=> (!x. abs (f x) <= b) by IN_IMAGE,IN_UNIV; + set k = sup s; + (!x. abs (f x) <= k) /\ !b. (!x. abs (f x) <= b) ==> k <= b [5] by 3,4,SUP; + assume ~thesis; + consider y such that &1 < abs (g y) [6] by REAL_NOT_LT; + &0 < abs (g y) [7] by REAL_ARITH; + !x. abs (f x) <= k / abs (g y) [8] + proof let x be real; + abs (f (x + y)) <= k /\ abs (f (x - y)) <= k /\ + f (x + y) + f (x - y) = &2 * f x * g y by 1,5; + abs (f x * g y) <= k by REAL_ARITH; + qed by 7,REAL_ABS_MUL,REAL_LE_RDIV_EQ; + consider x such that &0 < abs (f x) /\ abs (f x) <= k by 2,5,ABS_CASES; + &0 < k by REAL_ARITH; + k / abs (g y) < k by 6,7,REAL_LT_LMUL,REAL_MUL_RID,REAL_LT_LDIV_EQ; + qed by 5,8,REAL_NOT_LE`;; + +let IMO_3 = thm `; + let f g be real->real; + assume !x y. f (x + y) + f (x - y) = &2 * f x * g y [1]; + assume ~(!x. f x = &0) [2]; + assume !x. abs (f x) <= &1 [3]; + thus !x. abs (g x) <= &1 + proof + now [4] let y be real; + !x. abs (f x * g y pow 0) <= &1 [5] by 3,real_pow,REAL_MUL_RID; + now let l be num; + assume !x. abs (f x * g y pow l) <= &1; + let x be real; + abs (f (x + y) * g y pow l) <= &1 /\ + abs (f (x - y) * g y pow l) <= &1; + abs ((f (x + y) + f (x - y)) * g y pow l) <= &2 by REAL_ARITH; + abs ((&2 * f x * g y) * g y pow l) <= &2 by 1; + abs (f x * g y * g y pow l) <= &1 by REAL_ARITH; + thus abs (f x * g y pow SUC l) <= &1 by real_pow,REAL_MUL_RID; + end; + thus !l x. abs (f x * g y pow l) <= &1 by INDUCT_TAC,5; + end; + !x y. ~(x = &0) /\ &1 < abs(y) ==> ?n. &1 < abs(y pow n * x) + by SIMP_TAC,REAL_ABS_MUL,REAL_ABS_POW,GSYM REAL_LT_LDIV_EQ, + GSYM REAL_ABS_NZ,REAL_ARCH_POW; + qed by 2,4,REAL_NOT_LE,REAL_MUL_SYM`;; diff --git a/miz3/Samples/irrat2.ml b/miz3/Samples/irrat2.ml new file mode 100644 index 0000000..4c3a50e --- /dev/null +++ b/miz3/Samples/irrat2.ml @@ -0,0 +1,144 @@ +needs "Library/transc.ml";; +needs "Examples/sos.ml";; + +prioritize_real();; + +horizon := 1;; + +let rational = new_definition + `rational(r) = ?p q. ~(q = 0) /\ abs(r) = &p/ &q`;; + +(* ======== Mizar-style version ============================================ *) + +let NSQRT_2_1 = thm `; + !p q. p*p = 2*q*q ==> q = 0 + proof + exec MATCH_MP_TAC num_WF; + let p be num; + assume !p'. p' < p ==> !q. p'*p' = 2*q*q ==> q = 0 [1]; + let q be num; + assume p*p = 2*q*q [2]; + EVEN (p*p) by EVEN_DOUBLE; + EVEN p by EVEN_MULT; + consider p' such that + p = 2*p' [3] by EVEN_EXISTS; + q*q = 2*p'*p' [4] by 2,NUM_RING; + EVEN (q*q) by EVEN_DOUBLE; + EVEN q by EVEN_MULT; + consider q' such that + q = 2*q' [5] by EVEN_EXISTS; + p'*p' = 2*q'*q' [6] by 4,NUM_RING; + assume ~(q = 0) [7]; + ~(p = 0) by 2,NUM_RING; + p > 0 by ARITH_TAC; + p' < p by 3,ARITH_TAC; + q' = 0 by 1,6; + qed by 5,7,MULT_EQ_0`;; + +let SQRT_2_IRRATIONAL_1 = thm `; + ~rational(sqrt(&2)) + proof + assume rational(sqrt(&2)); + set x = abs(sqrt(&2)); + consider p q such that + ~(q = 0) /\ x = &p/ &q [7] by rational; + ~(&q = &0) by REAL_INJ; + x* &q = &p [8] by 7,REAL_DIV_RMUL; + &0 <= &2 by REAL_ARITH_TAC; + sqrt(&2) pow 2 = &2 by SQRT_POW2; + x pow 2 = &2 by REAL_ARITH_TAC; + &p* &p = &2* &q* &q by 8,REAL_RING; + p*p = 2*q*q by 8,REAL_INJ,REAL_OF_NUM_MUL; + qed by 7,NSQRT_2_1`;; + +(* ======== "automatically" converted from John's version ================== *) + +let NSQRT_2_2 = thm `; + now + now + let p q be num; + assume !m q. m < p ==> m * m = 2 * q * q ==> q = 0 [1]; + assume p * p = 2 * q * q [2]; + now + let m be num; + assume !m' q. m' < 2 * m ==> m' * m' = 2 * q * q ==> q = 0 [3]; + assume (2 * m) * 2 * m = 2 * q * q [4]; + (2 * m) * 2 * m = 2 * q * q + ==> (q < 2 * m ==> q * q = 2 * m * m ==> m = 0) + ==> q = 0 + by TIMED_TAC 2 (CONV_TAC SOS_RULE); + (q < 2 * m ==> q * q = 2 * m * m ==> m = 0) ==> q = 0 + by POP_ASSUM MP_TAC,4 from -; + thus q = 0 by FIRST_X_ASSUM + (MP_TAC o SPECL [parse_term "q:num"; parse_term "m:num"]),3,4; + end; + (?m. p = 2 * m) ==> q = 0 + by DISCH_THEN(X_CHOOSE_THEN (parse_term "m:num") SUBST_ALL_TAC),1,2; + EVEN p ==> q = 0 by REWRITE_TAC[EVEN_EXISTS],1,2; + (EVEN (p * p) <=> EVEN (2 * q * q)) ==> q = 0 + by REWRITE_TAC[EVEN_MULT; ARITH],1,2; + thus q = 0 by FIRST_ASSUM(MP_TAC o AP_TERM (parse_term "EVEN")),1,2; + end; + !p q. + (!m q. m < p ==> m * m = 2 * q * q ==> q = 0) + ==> p * p = 2 * q * q + ==> q = 0 by REPEAT STRIP_TAC; + !p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) + ==> (!q. p * p = 2 * q * q ==> q = 0) + by REWRITE_TAC[RIGHT_IMP_FORALL_THM]; + thus !p q. p * p = 2 * q * q ==> q = 0 by MATCH_MP_TAC num_WF; + end`;; + +let SQRT_2_IRRATIONAL_2 = thm `; + now + now + let p q be num; + now + assume ~(q = 0) [1]; + ~(&2 * &q * &q = &p * &p) + by ASM_MESON_TAC[NSQRT_2_2; REAL_OF_NUM_EQ; REAL_OF_NUM_MUL]; + ~((\x. x pow 2) (sqrt (&2)) = (\x. x pow 2) (&p / &q)) + by ASM_SIMP_TAC[SQRT_POW_2; REAL_POS; REAL_POW_DIV; REAL_POW_2; + REAL_LT_SQUARE; REAL_OF_NUM_EQ; REAL_EQ_RDIV_EQ],1; + thus ~(sqrt (&2) = &p / &q) + by DISCH_THEN(MP_TAC o AP_TERM (parse_term "\\x. x pow 2")),1; + end; + thus ~(~(q = 0) /\ sqrt (&2) = &p / &q) + by DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC); + end; + !p q. ~(~(q = 0) /\ sqrt (&2) = &p / &q) by REPEAT GEN_TAC; + thus ~rational (sqrt (&2)) + by SIMP_TAC[rational; real_abs; SQRT_POS_LE; REAL_POS; NOT_EXISTS_THM]; + end`;; + +(* ======== humanized version of John's version ============================ *) + +let NSQRT_2_3 = thm `; + !p q. p*p = 2*q*q ==> q = 0 + proof + set P = \p. !q. p*p = 2*q*q ==> q = 0; + now + let p be num; + assume !m. m < p ==> P m [1]; + let q be num; + assume p*p = 2*q*q [2]; + EVEN(2*q*q) by REWRITE_TAC,EVEN_MULT,ARITH; + EVEN p by 2,EVEN_MULT; + consider m such that p = 2*m [3] by EVEN_EXISTS; + (2*m)*2*m = 2*q*q /\ (q < 2*m /\ q*q = 2*m*m ==> m = 0) ==> q = 0 + from TIMED_TAC 2 (CONV_TAC SOS_RULE); + thus q = 0 by 1,2,3; + end; + qed by MATCH_MP_TAC num_WF`;; + +let SQRT_2_IRRATIONAL_3 = thm `; + ~rational(sqrt(&2)) + proof + assume rational(sqrt(&2)); + consider p q such that ~(q = 0) /\ sqrt(&2) = &p/ &q [1] + by rational,real_abs,SQRT_POS_LE,REAL_POS; + (&p* &p)/(&q* &q) = &2 [2] by SQRT_POW_2,REAL_POS,REAL_POW_DIV,REAL_POW_2; + &0 < &q* &q by 1,REAL_LT_SQUARE,REAL_OF_NUM_EQ; + &2*(&q* &q) = (&p* &p) by 2,REAL_EQ_RDIV_EQ; + qed by 1,NSQRT_2_3,REAL_OF_NUM_EQ,REAL_OF_NUM_MUL`;; + diff --git a/miz3/Samples/lagrange.ml b/miz3/Samples/lagrange.ml new file mode 100644 index 0000000..ca728ca --- /dev/null +++ b/miz3/Samples/lagrange.ml @@ -0,0 +1,353 @@ +needs "Library/prime.ml";; + +let group = new_definition + `group(g,(**),i,(e:A)) <=> + (e IN g) /\ (!x. x IN g ==> i(x) IN g) /\ + (!x y. x IN g /\ y IN g ==> x**y IN g) /\ + (!x y z. x IN g /\ y IN g /\ z IN g ==> x**(y**z) = (x**y)**z) /\ + (!x. x IN g ==> x**e = x /\ e**x = x) /\ + (!x. x IN g ==> x**i(x) = e /\ i(x)**x = e)`;; + +let subgroup = new_definition + `subgroup h (g,(**),i,(e:A)) <=> h SUBSET g /\ group(h,(**),i,e)`;; + +let bijection = new_definition + `bijection f s t <=> ?g. (!x:A. x IN s ==> f x IN t /\ g (f x) = x) /\ + (!y:B. y IN t ==> g y IN s /\ f (g y) = y)`;; + +parse_as_infix("PARTITIONS",(12,"right"));; + +let PARTITIONS = new_definition + `X PARTITIONS s <=> UNIONS X = (s:A->bool) /\ + !t u. t IN X /\ u IN X /\ ~(t = u) ==> t INTER u = {}`;; + +parse_as_infix("**",(20,"left"));; +parse_as_infix("***",(20,"left"));; + +horizon := -1;; + +let LAGRANGE_SKETCH = ref None;; + +LAGRANGE_SKETCH := Some `; + let H G be A->bool; let (**) be A->A->A; let i be A->A; let e be A; + assume FINITE H /\ group (H,(**),i,e:A) /\ subgroup G (H,(**),i,e); + consider (***) such that !h G. h***G = {h**g | g IN G}; +// + now let a be A; assume a IN H; let b be A; assume b IN H; + assume i(a)**b IN G; + b***G = a**i(a)**b***G; .= a***(i(a)**b***G); thus .= a***G; + end; + !a b. a IN H /\ b IN H /\ ~(a***G = b***G) ==> a***G INTER b***G = {} + proof let a be A; assume a IN H; let b be A; assume b IN H; + now assume ~(a***G INTER b***G = {}); + consider g1 g2 such that g1 IN G /\ g2 IN G /\ a**g1 = b**g2; + g1**i(g2) = i(a)**b; + i(a)**b IN G; + thus a***G = b***G; + end; + qed; + !a. a IN H ==> a IN a***G + proof let a be A; assume a IN H; + a**e = a; + qed; + {a***G | a IN H} PARTITIONS H; + !a b. a IN H /\ b IN H ==> CARD (a***G) = CARD (b***G) + proof let a be A; assume a IN H; let b be A; assume b IN H; + consider f such that !g. g IN G ==> f(a**g) = b**g; + bijection f (a***G) (b***G); + qed; + set INDEX = CARD {a***G | a IN H}; + set N = CARD H; set n = CARD G; set j = INDEX; + N = j*n; + thus CARD G divides CARD H; +// +`;; + +LAGRANGE_SKETCH := Some `; + let H G be A->bool; let (**) be A->A->A; let i be A->A; let e be A; + assume FINITE H /\ group (H,(**),i,e:A) /\ subgroup G (H,(**),i,e); + consider (***) such that !h G. h***G = {h**g | g IN G}; +:: #2 +:: 2: inference time-out +// + now let a be A; assume a IN H; let b be A; assume b IN H; + assume i(a)**b IN G; + b***G = a**i(a)**b***G; .= a***(i(a)**b***G); thus .= a***G; +:: #2 #2 #2 + end; + !a b. a IN H /\ b IN H /\ ~(a***G = b***G) ==> a***G INTER b***G = {} + proof let a be A; assume a IN H; let b be A; assume b IN H; + now assume ~(a***G INTER b***G = {}); + consider g1 g2 such that g1 IN G /\ g2 IN G /\ a**g1 = b**g2; +:: #2 + g1**i(g2) = i(a)**b; +:: #2 + i(a)**b IN G; +:: #2 + thus a***G = b***G; + end; + qed; + !a. a IN H ==> a IN a***G + proof let a be A; assume a IN H; + a**e = a; +:: #1 +:: 1: inference error + qed; +:: #2 + {a***G | a IN H} PARTITIONS H; +:: #2 + !a b. a IN H /\ b IN H ==> CARD (a***G) = CARD (b***G) + proof let a be A; assume a IN H; let b be A; assume b IN H; + consider f such that !g. g IN G ==> f(a**g) = b**g; +:: #2 + bijection f (a***G) (b***G); +:: #2 + qed; +:: #2 + set INDEX = CARD {a***G | a IN H}; + set N = CARD H; set n = CARD G; set j = INDEX; + N = j*n; +:: #2 + thus CARD G divides CARD H; +:: #2 +// +`;; + +horizon := 3;; + +let UNIONS_FINITE = thm `; + !s. FINITE (UNIONS s) <=> + FINITE s /\ !t:A->bool. t IN s ==> FINITE t +proof + let s be (A->bool)->bool; + now assume FINITE (UNIONS s) [1]; + now let t be A->bool; assume t IN s; + now let x be A; assume x IN t; + ?t. t IN s /\ x IN t; + thus x IN UNIONS s by ALL_TAC,UNIONS,IN_ELIM_THM; + end; + thus t IN {t | t SUBSET UNIONS s} by SUBSET,IN_ELIM_THM; + end; + s SUBSET {t | t SUBSET UNIONS s} by REWRITE_TAC,SUBSET; + FINITE {t | t SUBSET UNIONS s} by 1,FINITE_POWERSET; + thus FINITE s by FINITE_SUBSET; + end; +qed by FINITE_UNIONS`;; + +let CARD_UNIONS_EQUAL = thm `; + !X s n. FINITE s /\ X PARTITIONS s /\ (!t:A->bool. t IN X ==> CARD t = n) + ==> CARD s = (CARD X)*n +proof + let X be (A->bool)->bool; + let s be A->bool; + let n be num; + assume FINITE s; + assume X PARTITIONS s [1]; + assume !t. t IN X ==> CARD t = n [2]; + FINITE (UNIONS X) by PARTITIONS; + !t. t IN X ==> FINITE t [3] by UNIONS_FINITE; + FINITE X [4] by UNIONS_FINITE; + !t. t IN X ==> CARD t = (\t. n) t [5] by 2; + !t u. t IN X /\ u IN X /\ ~(t = u) ==> t INTER u = {} by 1,PARTITIONS; + CARD s = CARD (UNIONS X) by 1,PARTITIONS; + .= nsum X CARD by 2,3,4,CARD_UNIONS; + .= nsum X (\t. n) by 5,NSUM_EQ; +qed by 4,NSUM_CONST`;; + +let BIJECTION_CARD_EQ = thm `; + let f be A->B; + let s be A->bool; + let t be B->bool; + assume FINITE s /\ bijection f s t [1]; + ?g. (!x. x IN s ==> f x IN t /\ g (f x) = x) /\ + (!y. y IN t ==> g y IN s /\ f (g y) = y) + by REWRITE_TAC,-,GSYM bijection; + thus CARD s = CARD t by -,1,BIJECTIONS_CARD_EQ`;; + +horizon := 0;; + +let LAGRANGE = thm `; + let H G be A->bool; + let (**) be A->A->A; + let i be A->A; + let e be A; + assume FINITE H /\ group (H,(**),i,e) /\ subgroup G (H,(**),i,e) [1]; + (e IN H) /\ (!x. x IN H ==> i(x) IN H) /\ + (!x y. x IN H /\ y IN H ==> x**y IN H) /\ + (!x y z. x IN H /\ y IN H /\ z IN H ==> x**(y**z) = (x**y)**z) /\ + (!x. x IN H ==> x**e = x /\ e**x = x) /\ + (!x. x IN H ==> x**i(x) = e /\ i(x)**x = e) [2] + by REWRITE_TAC,1,GSYM group; + (G SUBSET H) /\ group (G,(**),i,e) [3] by 1,subgroup; + !x. x IN G ==> x IN H [4] by -,SUBSET; + FINITE G [5] by 3,1,FINITE_SUBSET; + (e IN G) /\ (!x. x IN G ==> i(x) IN G) /\ + (!x y. x IN G /\ y IN G ==> x**y IN G) /\ + (!x y z. x IN G /\ y IN G /\ z IN G ==> x**(y**z) = (x**y)**z) /\ + (!x. x IN G ==> x**e = x /\ e**x = x) /\ + (!x. x IN G ==> x**i(x) = e /\ i(x)**x = e) [6] + by REWRITE_TAC,3,GSYM group; + set (***) = \h G. {h**g | g IN G} [7]; + !x h G. x IN h***G <=> ?g. g IN G /\ x = h**g [8] by ALL_TAC,-,IN_ELIM_THM; + !h1 h2. h1 IN H /\ h2 IN H ==> (h1**h2)***G = h1***(h2***G) [9] + proof + let h1 h2 be A; + assume h1 IN H /\ h2 IN H [10]; + now [11] + let x be A; + assume x IN (h1**h2)***G; + consider g such that g IN G /\ x = (h1**h2)**g [12] by -,8; + g IN H by -,4; + x = h1**(h2**g) [13] by -,2,10,12; + h2**g IN h2***G by 8,12; + thus x IN h1***(h2***G) by -,13,8; + end; + now + let x be A; + assume x IN h1***(h2***G); + consider y such that y IN h2***G /\ x = h1**y [14] by -,8; + consider g such that g IN G /\ y = h2**g [15] by -,8; + g IN H [16] by -,4; + x = h1**(h2**g) by 14,15; + .= (h1**h2)**g by -,2,10,14,16; + thus x IN (h1**h2)***G by -,8,15; + end; + qed by -,11,EXTENSION; + !g. g IN G ==> g***G = G [17] + proof + let g be A; + assume g IN G [18]; + now [19] + let x be A; + assume x IN g***G; + consider g' such that g' IN G /\ x = g**g' by -,8; + thus x IN G by -,6,18; + end; + now + let x be A; + assume x IN G [20]; + x = g**i(g)**x by -,6,18; + .= g**(i(g)**x) [21] by -,6,18,20; + i(g)**x IN G by 6,18,20; + thus x IN g***G by -,21,8; + end; + qed by -,19,EXTENSION; +// + now [22] + let a be A; assume a IN H [23]; + let b be A; assume b IN H [24]; + i(a)**b IN H [25] by 2,23,24; + assume i(a)**b IN G [26]; + b***G = e**b***G by 2,24; + .= a**i(a)**b***G by -,2,23; + .= a**(i(a)**b)***G by -,2,23,24; + .= a***(i(a)**b***G) by -,9,23,25; + thus .= a***G by -,17,26; + end; + !a b. a IN H /\ b IN H /\ ~(a***G = b***G) ==> a***G INTER b***G = {} [27] + proof + let a be A; assume a IN H [28]; + let b be A; assume b IN H [29]; + now assume ~(a***G INTER b***G = {}); + consider x such that x IN a***G INTER b***G by -,MEMBER_NOT_EMPTY; + x IN a***G /\ x IN b***G [30] by -,IN_INTER; + consider g1 such that g1 IN G /\ x = a**g1 [31] by 8,30; + consider g2 such that g2 IN G /\ x = b**g2 [32] by 8,30; + g1 IN H /\ g2 IN H [33] by 4,31,32; + a**g1 = b**g2 [34] by 31,32; + g1**i(g2) = e**g1**i(g2) by 2,33; + .= (i(a)**a)**g1**i(g2) by -,2,28; + .= i(a)**(a**g1)**i(g2) by -,2,28,33; + .= i(a)**(b**g2)**i(g2) by -,34; + .= i(a)**(b**g2**i(g2)) by -,2,28,29,33; + .= i(a)**(b**(g2**i(g2))) by -,2,29,33; + .= i(a)**(b**e) by -,2,33; + .= i(a)**b by -,2,29; + i(a)**b IN G by -,6,31,32; + thus a***G = b***G by -,22,28,29; + end; + qed by -,28,29; + !a. a IN H ==> a IN a***G [35] + proof + let a be A; assume a IN H; + a**e = a by -,2; + qed by -,6,8; + now + now [36] + let x be A; + assume x IN UNIONS {a***G | a IN H}; + consider s such that s IN {a***G | a IN H} /\ x IN s [37] + by -,IN_UNIONS; + consider a such that a IN H /\ s = a***G [38] by -; + consider g such that g IN G /\ x = a**g by -,8,37; + thus x IN H by -,2,4,38; + end; + now + let x be A; + assume x IN H; + x IN x***G /\ x***G IN {a***G | a IN H} by -,35; + thus x IN UNIONS {a***G | a IN H} by -,IN_UNIONS; + end; + thus UNIONS {a***G | a IN H} = H by -,36,EXTENSION; + let t u be A->bool; + assume t IN {a***G | a IN H} /\ u IN {a***G | a IN H} /\ ~(t = u) [39]; + consider a b such that a IN H /\ t = a***G /\ b IN H /\ t = b***G by -; + thus t INTER u = {} by -,27,39; + end; + {a***G | a IN H} PARTITIONS H [40] by REWRITE_TAC,-,PARTITIONS; + !a b. a IN H /\ b IN H ==> CARD (a***G) = CARD (b***G) [41] + proof + let a be A; assume a IN H [42]; + let b be A; assume b IN H [43]; + set f = \x. b**(i(a)**x); + set f' = \x. a**(i(b)**x); + !g. g IN G ==> f(a**g) = b**g /\ f'(b**g) = a**g [44] + proof + let g be A; assume g IN G; + g IN H [45] by -,4; + f(a**g) = b**(i(a)**(a**g)); + .= b**(i(a)**a**g) by -,2,42,45; + .= b**(e**g) by -,2,42; + .= b**g [46] by -,2,45; + f'(b**g) = a**(i(b)**(b**g)); + .= a**(i(b)**b**g) by -,2,43,45; + .= a**(e**g) by -,2,43; + .= a**g by -,2,45; + qed by -,46; + now + take f'; + thus !x. x IN a***G ==> f x IN b***G /\ f' (f x) = x + proof + let x be A; assume x IN a***G; + consider g such that g IN G /\ x = a**g [47] by -,8; + f x = b**g by -,44; + qed by -,8,44,47; + thus !y. y IN b***G ==> f' y IN a***G /\ f (f' y) = y + proof + let y be A; assume y IN b***G; + consider g such that g IN G /\ y = b**g [48] by -,8; + f' y = a**g by -,44; + qed by -,8,44,48; + end; + bijection f (a***G) (b***G) [49] by ALL_TAC,-,bijection; + FINITE {a**g | g IN G} by SIMP_TAC,5,SIMPLE_IMAGE,FINITE_IMAGE; + qed by -,7,49,BIJECTION_CARD_EQ; + set INDEX = CARD {a***G | a IN H}; + now + let t be A->bool; + assume t IN {a***G | a IN H}; + consider a such that a IN H /\ t = a***G [50] by -; + CARD t = CARD (a***G) by -; + .= CARD (e***G) by -,2,41,50; + thus .= CARD G by -,6,17; + end; + set N = CARD H; + set n = CARD G; + set j = INDEX; + N = (CARD {a***G | a IN H})*(CARD G) by -,1,40,CARD_UNIONS_EQUAL; + .= j*n by -; + thus CARD G divides CARD H by -,divides,MULT_SYM; +// +`;; + +parse_as_infix("**",(20,"right"));; diff --git a/miz3/Samples/lagrange1.ml b/miz3/Samples/lagrange1.ml new file mode 100644 index 0000000..9f5f720 --- /dev/null +++ b/miz3/Samples/lagrange1.ml @@ -0,0 +1,466 @@ +needs "Library/prime.ml";; + +parse_as_infix("**",(20,"right"));; + +let group = new_definition + `group(g,(**),i,(e:A)) <=> + (e IN g) /\ (!x. x IN g ==> i(x) IN g) /\ + (!x y. x IN g /\ y IN g ==> x**y IN g) /\ + (!x y z. x IN g /\ y IN g /\ z IN g ==> x**(y**z) = (x**y)**z) /\ + (!x. x IN g ==> x**e = x /\ e**x = x) /\ + (!x. x IN g ==> x**i(x) = e /\ i(x)**x = e)`;; + +let subgroup = new_definition + `subgroup h (g,(**),i,(e:A)) <=> h SUBSET g /\ group(h,(**),i,e)`;; + +(* ======== translation of John's proof ==================================== *) + +horizon := 1;; + +let GROUP_LAGRANGE_COSETS = thm `; + !g h (**) i e. + group(g,(**),i,e:A) /\ subgroup h (g,(**),i,e) /\ FINITE g + ==> ?q. CARD g = CARD q * CARD h /\ + !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x +proof exec REWRITE_TAC[group; subgroup; SUBSET]; + let g h be A->bool; + let (**) be A->A->A; + let i be A->A; + let e be A; + assume e IN g; + assume !x. x IN g ==> i(x) IN g [1]; + assume !x y. x IN g /\ y IN g ==> x**y IN g [2]; + assume !x y z. x IN g /\ y IN g /\ z IN g + ==> x**(y**z) = (x**y)**z [3]; + assume !x. x IN g ==> x**e = x /\ e**x = x [4]; + assume !x. x IN g ==> x**i(x) = e /\ i(x)**x = e [5]; + assume !x. x IN h ==> x IN g [6]; + assume e IN h [7]; + assume !x. x IN h ==> i(x) IN h [8]; + assume !x y. x IN h /\ y IN h ==> x**y IN h [9]; + assume !x y z. x IN h /\ y IN h /\ z IN h + ==> x**(y**z) = (x**y)**z; + assume !x. x IN h ==> x**e = x /\ e**x = x [10]; + assume !x. x IN h ==> x**i(x) = e /\ i(x)**x = e [11]; + assume FINITE g [12]; + set coset = \a. {b | b IN g /\ ?x. x IN h /\ b = a**x} [coset]; + !a. coset a = {b' | b' IN g /\ ?x. x IN h /\ b' = a**x} [13]; + !a. a IN g ==> a IN coset a [14] + proof let a be A; + assume a IN g [15]; + ?x. x IN h /\ a = a**x by 4,7; + qed by SIMP_TAC,13,15,IN_ELIM_THM; + FINITE h [16] by 6,12,FINITE_SUBSET,SUBSET; + !a. FINITE (coset a) + proof let a be A; + ?t. FINITE t /\ coset a SUBSET t + proof take g; + qed by SIMP_TAC,12,13,IN_ELIM_THM,SUBSET; + qed by MATCH_MP_TAC,FINITE_SUBSET; + !a x y. a IN g /\ x IN g /\ y IN g /\ a**x = a**y ==> x = y [17] + proof let a x y be A; + assume a IN g /\ x IN g /\ y IN g /\ a**x = a**y [18]; + (i(a)**a)**x = (i(a)**a)**y by 1,3; + e**x = e**y by 5,18; + qed by 4,18; + !a. a IN g ==> CARD (coset a) = CARD h + proof let a be A; + assume a IN g [19]; + coset a = IMAGE (\x. a**x) h [20] + proof + !x. x IN g /\ (?x'. x' IN h /\ x = a**x') <=> + ?x'. x = a**x' /\ x' IN h by 2,6; + qed by REWRITE_TAC,13,EXTENSION,IN_IMAGE,IN_ELIM_THM; + (!x y. x IN h /\ y IN h /\ a**x = a**y ==> x = y) /\ FINITE h + by 6,16,17,19; + CARD (IMAGE (\x. a**x) h) = CARD h by MATCH_MP_TAC,CARD_IMAGE_INJ; + qed by 20; + !x y. x IN g /\ y IN g ==> i(x**y) = i(y)**i(x) [21] + proof let x y be A; + assume x IN g /\ y IN g [22]; + ?a. a IN g /\ i(x**y) IN g /\ i(y)**i(x) IN g /\ + a**i(x**y) = a**i(y)**i(x) + proof take x**y; + e = x**(y**i(y))**i(x) by 1,4,5,22; + .= ((x**y)**i(y))**i(x) by 1,2,3,22; + qed by SIMP_TAC,1,2,3,5,22; + qed by 17; + !x. x IN g ==> i(i(x)) = x [23] + proof let x be A; + assume x IN g; + ?a. a IN g /\ i(i(x)) IN g /\ x IN g /\ a**i(i(x)) = a**x + proof take i(x); + qed by 1,5; + qed by MATCH_MP_TAC,17; + !a b. a IN g /\ b IN g + ==> coset a = coset b \/ coset a INTER coset b = {} + proof let a b be A; + assume a IN g /\ b IN g [24]; + cases; + suppose i(b)**a IN h [25]; + now let x be A; + !x. x IN h ==> b**(i(b)**a)**x = a**x /\ a**i(i(b)**a)**x = b**x + by SIMP_TAC,1,3,4,5,6,21,23,24; + thus x IN g /\ (?x'. x' IN h /\ x = a**x') <=> + x IN g /\ (?x'. x' IN h /\ x = b**x') by 8,9,25; + end; + coset a = coset b by REWRITE_TAC,13,EXTENSION,IN_ELIM_THM; + qed; + suppose ~(i(b)**a IN h) [26]; + now let x be A; + assume x IN g /\ (?y. y IN h /\ x = a**y) /\ (?z. z IN h /\ x = b**z); + consider y z such that y IN h /\ x = a**y /\ z IN h /\ x = b**z [27]; + (i(b)**a)**y = i(b)**a**y by 1,3,6,24,27; + .= i(b)**b**z by 27; + .= e**z by 1,3,5,6,24,27; + .= z by 10,27; + z**i(y) = ((i(b)**a)**y)**i(y); + .= (i(b)**a)**y**i(y) by 1,2,3,5,6,24,27; + .= (i(b)**a)**e by 11,27; + .= i(b)**a by 1,2,4,24; + thus F by 8,9,26,27; + end; + !x. ~((x IN g /\ ?y. y IN h /\ x = a**y) /\ + (x IN g /\ ?z. z IN h /\ x = b**z)); + coset a INTER coset b = {} + by REWRITE_TAC,13,EXTENSION,NOT_IN_EMPTY,IN_INTER,IN_ELIM_THM; + qed; + end; + set q = {c | ?a. a IN g /\ c = (@)(coset a)} [q] [28]; take q; + !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x [29] + proof let b be A; + assume b IN g [30]; + set C = (@)(coset b) [C] [31]; take C; + (@)(coset b) IN {c | ?a. a IN g /\ c = (@)(coset a)} by 30; + thus C IN q by q,C; + C IN coset b by 14,30,C,IN,SELECT_AX; + C IN {b' | b' IN g /\ ?x. x IN h /\ b' = b**x} by 13; + consider c such that + C IN g /\ c IN h /\ C = b**c [32]; + take i(c); + (b**c)**i(c) = b**c**i(c) by 1,3,6,30; + .= b by 1,4,5,6,30,32; + qed by 8,32; + !a b. a IN g /\ b IN g /\ a IN coset b ==> b IN coset a [33] + proof let a b be A; + a IN g /\ b IN g /\ a IN g /\ (?x. x IN h /\ a = b**x) + ==> b IN g /\ (?x. x IN h /\ b = a**x) + proof + assume a IN g /\ b IN g /\ a IN g /\ ?x. x IN h /\ a = b**x [34]; + thus b IN g; + consider c such that c IN h /\ a = b**c by 34; + take i(c); + qed by 3,4,6,8,11,34; + qed by REWRITE_TAC,13,IN_ELIM_THM; + !a b c. a IN coset b /\ b IN coset c /\ c IN g ==> a IN coset c [35] + proof let a b c be A; + now assume (a IN g /\ ?x. x IN h /\ a = b**x) /\ + (b IN g /\ ?x. x IN h /\ b = c**x) /\ c IN g [36]; + consider x x' such that x IN h /\ a = b**x /\ x' IN h /\ b = c**x'; + thus a IN g /\ ?x. x IN h /\ a = c**x by 3,6,9,36; + end; + qed by REWRITE_TAC,13,IN_ELIM_THM; + !a b. a IN coset b ==> a IN g [37] + proof let a b be A; + a IN g /\ (?x. x IN h /\ a = b**x) ==> a IN g; + qed by REWRITE_TAC,13,IN_ELIM_THM; + !a b. a IN coset b /\ b IN g ==> coset a = coset b [38] + by 33,35,37,EXTENSION; + !a. a IN g ==> (@)(coset a) IN coset a [39] by 14,IN,SELECT_AX; + !a. a IN q ==> a IN g [40] + proof let a be A; assume a IN q; + a IN {c | ?a. a IN g /\ c = (@)(coset a)} by q; + consider a' such that a' IN g /\ a = (@)(coset a'); + qed by 37,39; + !a x a' x'. a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x + ==> a' = a /\ x' = x [41] + proof let a x a' x' be A; + assume a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x [42]; + a IN {c | ?a. a IN g /\ c = (@)(coset a)} /\ + a' IN {c | ?a. a IN g /\ c = (@)(coset a)} by q; + consider a1 a2 such that + a1 IN g /\ a = (@)(coset a1) /\ a2 IN g /\ a' = (@)(coset a2) [43]; + a IN g /\ a' IN g [44] by 37,39; + coset a = coset a1 /\ coset a' = coset a2 by 38,39,43; + a = (@)(coset a) /\ a' = (@)(coset a') [45] by 43; + ?x. x IN h /\ a' = a**x + proof take x**i(x'); + thus x**i(x') IN h by 8,9,42; + a' = a'**x'**i(x') by 4,5,6,42,44; + .= (a**x)**i(x') by 1,2,3,6,42,44; + qed by 1,2,3,6,42,44; + a' IN coset a by REWRITE_TAC,13,44,IN_ELIM_THM; + coset a = coset a' by 38,44; + qed by 6,17,42,44,45; + g = IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h} + proof + !x. x IN g <=> ?p1 p2. (x = p1**p2 /\ p1 IN q) /\ p2 IN h by 2,6,29,40; + qed by REWRITE_TAC,EXTENSION,IN_IMAGE,IN_ELIM_THM,EXISTS_PAIR_THM,PAIR_EQ, + CONJ_ASSOC,ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1; + CARD g = CARD (IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h}) [46]; + .= CARD {(a,x) | a IN q /\ x IN h} + proof + !x y. x IN {(a,x) | a IN q /\ x IN h} /\ + y IN {(a,x) | a IN q /\ x IN h} /\ + (\(a,x). a**x) x = (\(a,x). a**x) y + ==> x = y [47] + proof + !p1 p2 p1' p2'. (?a x. (a IN q /\ x IN h) /\ p1 = a /\ p2 = x) /\ + (?a x. (a IN q /\ x IN h) /\ p1' = a /\ p2' = x) /\ + p1**p2 = p1'**p2' + ==> p1 = p1' /\ p2 = p2' by 41; + qed by REWRITE_TAC,FORALL_PAIR_THM,IN_ELIM_THM,PAIR_EQ; + FINITE q /\ FINITE h by 6,12,40,FINITE_SUBSET,SUBSET; + FINITE {(a,x) | a IN q /\ x IN h} by FINITE_PRODUCT; + qed by MATCH_MP_TAC CARD_IMAGE_INJ,47; + .= CARD q * CARD h by 6,12,40,46,CARD_PRODUCT,FINITE_SUBSET,SUBSET; +qed by 29`;; + +let GROUP_LAGRANGE = thm `; + !g h (**) i e. + group (g,( ** ),i,e:A) /\ subgroup h (g,(**),i,e) /\ FINITE g + ==> CARD h divides CARD g + by GROUP_LAGRANGE_COSETS,DIVIDES_LMUL,DIVIDES_REFL`;; + +(* ======== and formal proof sketch derived from this translation ========== *) + +horizon := -1;; + +let GROUP_LAGRANGE_COSETS_SKETCH = ref None;; + +GROUP_LAGRANGE_COSETS_SKETCH := Some `; + !g h (**) i e. + group(g,(**),i,e:A) /\ subgroup h (g,(**),i,e) /\ FINITE g + ==> ?q. CARD g = CARD q * CARD h /\ + !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x +proof exec REWRITE_TAC[group; subgroup; SUBSET]; + let g h be A->bool; + let (**) be A->A->A; + let i be A->A; + let e be A; + assume e IN g; + assume !x. x IN g ==> i(x) IN g; + assume !x y. x IN g /\ y IN g ==> x**y IN g; + assume !x y z. x IN g /\ y IN g /\ z IN g + ==> x**(y**z) = (x**y)**z; + assume !x. x IN g ==> x**e = x /\ e**x = x; + assume !x. x IN g ==> x**i(x) = e /\ i(x)**x = e; + assume !x. x IN h ==> x IN g; + assume e IN h; + assume !x. x IN h ==> i(x) IN h; + assume !x y. x IN h /\ y IN h ==> x**y IN h; + assume !x y z. x IN h /\ y IN h /\ z IN h + ==> x**(y**z) = (x**y)**z; + assume !x. x IN h ==> x**e = x /\ e**x = x; + assume !x. x IN h ==> x**i(x) = e /\ i(x)**x = e; + assume FINITE g; + set coset = \a. {b | b IN g /\ ?x. x IN h /\ b = a**x}; + !a. coset a = {b' | b' IN g /\ ?x. x IN h /\ b' = a**x}; + !a. a IN g ==> a IN coset a + proof let a be A; + assume a IN g; + ?x. x IN h /\ a = a**x; + qed; + FINITE h; +:: #1 +:: 1: inference error + !a. FINITE (coset a) + proof let a be A; + ?t. FINITE t /\ coset a SUBSET t + proof take g; + qed; +:: #2 +:: 2: inference time-out + qed; +:: #2 + !a x y. a IN g /\ x IN g /\ y IN g /\ a**x = a**y ==> x = y + proof let a x y be A; + assume a IN g /\ x IN g /\ y IN g /\ a**x = a**y; + (i(a)**a)**x = (i(a)**a)**y; + e**x = e**y; +:: #2 + qed; + !a. a IN g ==> CARD (coset a) = CARD h + proof let a be A; + assume a IN g; + coset a = IMAGE (\x. a**x) h + proof + !x. x IN g /\ (?x'. x' IN h /\ x = a**x') <=> + ?x'. x = a**x' /\ x' IN h; + qed; +:: #2 + (!x y. x IN h /\ y IN h /\ a**x = a**y ==> x = y) /\ FINITE h; + CARD (IMAGE (\x. a**x) h) = CARD h; +:: #2 + qed; + !x y. x IN g /\ y IN g ==> i(x**y) = i(y)**i(x) + proof let x y be A; + assume x IN g /\ y IN g; + ?a. a IN g /\ i(x**y) IN g /\ i(y)**i(x) IN g /\ + a**i(x**y) = a**i(y)**i(x) + proof take x**y; + e = x**(y**i(y))**i(x); +:: #2 + .= ((x**y)**i(y))**i(x); +:: #2 + qed; + qed; + !x. x IN g ==> i(i(x)) = x + proof let x be A; + assume x IN g; + ?a. a IN g /\ i(i(x)) IN g /\ x IN g /\ a**i(i(x)) = a**x + proof take i(x); + qed; + qed; + !a b. a IN g /\ b IN g + ==> coset a = coset b \/ coset a INTER coset b = {} + proof let a b be A; + assume a IN g /\ b IN g; + cases; + suppose i(b)**a IN h; + now let x be A; + !x. x IN h ==> b**(i(b)**a)**x = a**x /\ a**i(i(b)**a)**x = b**x; +:: #2 + thus x IN g /\ (?x'. x' IN h /\ x = a**x') <=> + x IN g /\ (?x'. x' IN h /\ x = b**x'); +:: #2 + end; + coset a = coset b; +:: #2 + qed; + suppose ~(i(b)**a IN h); + now let x be A; + assume x IN g /\ (?y. y IN h /\ x = a**y) /\ (?z. z IN h /\ x = b**z); + consider y z such that y IN h /\ x = a**y /\ z IN h /\ x = b**z; + (i(b)**a)**y = i(b)**a**y; + .= i(b)**b**z; + .= e**z; +:: #2 + .= z; + z**i(y) = ((i(b)**a)**y)**i(y); + .= (i(b)**a)**y**i(y); +:: #2 + .= (i(b)**a)**e; + .= i(b)**a; +:: #2 + thus F; +:: #2 + end; + !x. ~((x IN g /\ ?y. y IN h /\ x = a**y) /\ + (x IN g /\ ?z. z IN h /\ x = b**z)); + coset a INTER coset b = {}; +:: #2 + qed; + end; + set q = {c | ?a. a IN g /\ c = (@)(coset a)}; + take q; + !b. b IN g ==> ?a x. a IN q /\ x IN h /\ b = a**x + proof let b be A; + assume b IN g; + set C = (@)(coset b); + take C; + (@)(coset b) IN {c | ?a. a IN g /\ c = (@)(coset a)}; + thus C IN q; + C IN coset b; +:: #2 + C IN {b' | b' IN g /\ ?x. x IN h /\ b' = b**x}; + consider c such that + C IN g /\ c IN h /\ C = b**c; + take i(c); + (b**c)**i(c) = b**c**i(c); + .= b; + qed; + !a b. a IN g /\ b IN g /\ a IN coset b ==> b IN coset a + proof let a b be A; + a IN g /\ b IN g /\ a IN g /\ (?x. x IN h /\ a = b**x) + ==> b IN g /\ (?x. x IN h /\ b = a**x) + proof + assume a IN g /\ b IN g /\ a IN g /\ ?x. x IN h /\ a = b**x; + thus b IN g; + consider c such that c IN h /\ a = b**c; + take i(c); + qed; +:: #2 + qed; + !a b c. a IN coset b /\ b IN coset c /\ c IN g ==> a IN coset c + proof let a b c be A; + now assume (a IN g /\ ?x. x IN h /\ a = b**x) /\ + (b IN g /\ ?x. x IN h /\ b = c**x) /\ c IN g; + consider x x' such that x IN h /\ a = b**x /\ x' IN h /\ b = c**x'; + thus a IN g /\ ?x. x IN h /\ a = c**x; +:: #2 + end; + qed; +:: #2 + !a b. a IN coset b ==> a IN g + proof let a b be A; + a IN g /\ (?x. x IN h /\ a = b**x) ==> a IN g; + qed; + !a b. a IN coset b /\ b IN g ==> coset a = coset b; +:: #2 + !a. a IN g ==> (@)(coset a) IN coset a; +:: #2 + !a. a IN q ==> a IN g + proof let a be A; + assume a IN q; + a IN {c | ?a. a IN g /\ c = (@)(coset a)}; + consider a' such that a' IN g /\ a = (@)(coset a'); + qed; + !a x a' x'. a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x + ==> a' = a /\ x' = x + proof let a x a' x' be A; + assume a IN q /\ a' IN q /\ x IN h /\ x' IN h /\ a'**x' = a**x; + a IN {c | ?a. a IN g /\ c = (@)(coset a)} /\ + a' IN {c | ?a. a IN g /\ c = (@)(coset a)}; + consider a1 a2 such that + a1 IN g /\ a = (@)(coset a1) /\ a2 IN g /\ a' = (@)(coset a2); +:: #2 + a IN g /\ a' IN g; + coset a = coset a1 /\ coset a' = coset a2; +:: #2 + a = (@)(coset a) /\ a' = (@)(coset a'); + ?x. x IN h /\ a' = a**x + proof take x**i(x'); + thus x**i(x') IN h; +:: #2 + a' = a'**x'**i(x'); +:: #2 + .= (a**x)**i(x'); +:: #2 + qed; +:: #2 + a' IN coset a; +:: #2 + coset a = coset a'; + qed; +:: #2 + g = IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h} + proof + !x. x IN g <=> ?p1 p2. (x = p1**p2 /\ p1 IN q) /\ p2 IN h; +:: #2 + qed; +:: #2 + CARD g = CARD (IMAGE (\(a,x). a**x) {(a,x) | a IN q /\ x IN h}); + .= CARD {(a,x) | a IN q /\ x IN h} + proof + !x y. x IN {(a,x) | a IN q /\ x IN h} /\ + y IN {(a,x) | a IN q /\ x IN h} /\ + (\(a,x). a**x) x = (\(a,x). a**x) y + ==> x = y + proof + !p1 p2 p1' p2'. (?a x. (a IN q /\ x IN h) /\ p1 = a /\ p2 = x) /\ + (?a x. (a IN q /\ x IN h) /\ p1' = a /\ p2' = x) /\ + p1**p2 = p1'**p2' + ==> p1 = p1' /\ p2 = p2'; + qed; +:: #2 + FINITE q /\ FINITE h; +:: #2 + FINITE {(a,x) | a IN q /\ x IN h}; +:: #2 + qed; +:: #2 + .= CARD q * CARD h; +:: #2 +qed`;; + diff --git a/miz3/Samples/luxury.ml b/miz3/Samples/luxury.ml new file mode 100644 index 0000000..f775c7a --- /dev/null +++ b/miz3/Samples/luxury.ml @@ -0,0 +1,183 @@ +horizon := 0;; + +let SUC_INJ_1 = thm `; + now + now [1] + let m n be num; + now [2] + assume mk_num (IND_SUC (dest_num m)) = + mk_num (IND_SUC (dest_num n)) [3]; + now [4] + let p be num; + NUM_REP (dest_num p) [5] + by REWRITE_TAC[fst num_tydef; snd num_tydef] ; + thus NUM_REP (IND_SUC (dest_num p)) + by MATCH_MP_TAC (CONJUNCT2 NUM_REP_RULES) from 5; + end; + !p. NUM_REP (IND_SUC (dest_num p)) [6] by GEN_TAC from 4; + now [7] + assume !p. dest_num (mk_num (IND_SUC (dest_num p))) = + IND_SUC (dest_num p) [8]; + mk_num (dest_num m) = mk_num (dest_num n) ==> m = n [9] + by REWRITE_TAC[fst num_tydef]; + dest_num m = dest_num n ==> m = n [10] + by DISCH_THEN(MP_TAC o AP_TERM (parse_term "mk_num")) from 9; + thus dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n by ASM_REWRITE_TAC[IND_SUC_INJ],8 from 10; + end; + (!p. dest_num (mk_num (IND_SUC (dest_num p))) = + IND_SUC (dest_num p)) + ==> dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n [11] by DISCH_TAC from 7; + (!p. NUM_REP (IND_SUC (dest_num p))) + ==> dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n [12] by REWRITE_TAC[fst num_tydef; snd num_tydef] from 11; + dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n [13] + by SUBGOAL_THEN (parse_term "!p. NUM_REP (IND_SUC (dest_num p))") + MP_TAC from 6,12; + thus m = n + by POP_ASSUM(MP_TAC o AP_TERM (parse_term "dest_num")),3 from 13; + end; + mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) + ==> m = n [14] by DISCH_TAC from 2; + now [15] + assume m = n [16]; + thus mk_num (IND_SUC (dest_num m)) = + mk_num (IND_SUC (dest_num n)) by ASM_REWRITE_TAC[],16; + end; + m = n + ==> mk_num (IND_SUC (dest_num m)) = + mk_num (IND_SUC (dest_num n)) [17] by DISCH_TAC from 15; + mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) <=> + m = n [18] by EQ_TAC from 14,17; + thus SUC m = SUC n <=> m = n by REWRITE_TAC[SUC_DEF] from 18; + end; + thus !m n. SUC m = SUC n <=> m = n by REPEAT GEN_TAC from 1; + end; +`;; + +let SUC_INJ_2 = thm `; + !m n. SUC m = SUC n <=> m = n [1] + proof + let m n be num; + mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) + ==> m = n [2] + proof + assume mk_num (IND_SUC (dest_num m)) = + mk_num (IND_SUC (dest_num n)) [3]; + !p. NUM_REP (IND_SUC (dest_num p)) [4] + proof + let p be num; + NUM_REP (dest_num p) [5] + by REWRITE_TAC[fst num_tydef; snd num_tydef]; + qed by MATCH_MP_TAC (CONJUNCT2 NUM_REP_RULES) from 5; + (!p. dest_num (mk_num (IND_SUC (dest_num p))) = + IND_SUC (dest_num p)) + ==> dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n [6] + proof + assume !p. dest_num (mk_num (IND_SUC (dest_num p))) = + IND_SUC (dest_num p) [7]; + mk_num (dest_num m) = mk_num (dest_num n) ==> m = n [8] + by REWRITE_TAC[fst num_tydef]; + dest_num m = dest_num n ==> m = n [9] + by DISCH_THEN(MP_TAC o AP_TERM (parse_term "mk_num")) from 8; + qed by ASM_REWRITE_TAC[IND_SUC_INJ],* from 9; + (!p. NUM_REP (IND_SUC (dest_num p))) + ==> dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n [10] by REWRITE_TAC[fst num_tydef; snd num_tydef] from 6; + dest_num (mk_num (IND_SUC (dest_num m))) = + dest_num (mk_num (IND_SUC (dest_num n))) + ==> m = n [11] + by SUBGOAL_THEN (parse_term "!p. NUM_REP (IND_SUC (dest_num p))") + MP_TAC + from 4,10; + qed by POP_ASSUM(MP_TAC o AP_TERM (parse_term "dest_num")),3 from 11; + m = n + ==> mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) [12] + proof + assume m = n [13]; + qed by ASM_REWRITE_TAC[],*; + mk_num (IND_SUC (dest_num m)) = mk_num (IND_SUC (dest_num n)) <=> + m = n [14] by EQ_TAC from 2,12; + qed by REWRITE_TAC[SUC_DEF] from 14;`;; + +let num_INDUCTION_ = thm `; + now [1] + let P be num->bool; + let n be num; + assume P _0; + assume !n. P n ==> P (SUC n); + now [2] + let i be ind; + assume NUM_REP i; + assume P (mk_num i); + NUM_REP i [3] by ASM_REWRITE_TAC[],*; + thus NUM_REP (IND_SUC i) + by MATCH_MP_TAC(CONJUNCT2 NUM_REP_RULES) from 3; + end; + now [4] + let i be ind; + assume NUM_REP i; + assume P (mk_num i); + NUM_REP i [5] by FIRST_ASSUM MATCH_ACCEPT_TAC,*; + dest_num (mk_num i) = i [6] by REWRITE_TAC[GSYM(snd num_tydef)] from 5; + i = dest_num (mk_num i) [7] by CONV_TAC SYM_CONV from 6; + mk_num (IND_SUC i) = mk_num (IND_SUC (dest_num (mk_num i))) [8] + by REPEAT AP_TERM_TAC from 7; + mk_num (IND_SUC i) = SUC (mk_num i) [9] by REWRITE_TAC[SUC_DEF] from 8; + P (mk_num i) [10] by FIRST_ASSUM MATCH_ACCEPT_TAC,*; + P (SUC (mk_num i)) [11] by FIRST_ASSUM MATCH_MP_TAC,* from 10; + thus P (mk_num (IND_SUC i)) + by SUBGOAL_THEN (parse_term "mk_num(IND_SUC i) = SUC(mk_num i)") + SUBST1_TAC + from 9,11; + end; + !i. NUM_REP i /\ P (mk_num i) + ==> NUM_REP (IND_SUC i) /\ P (mk_num (IND_SUC i)) [12] + by REPEAT STRIP_TAC from 2,4; + (NUM_REP (dest_num n) + ==> NUM_REP (dest_num n) /\ P (mk_num (dest_num n))) + ==> P n [13] by REWRITE_TAC[fst num_tydef; snd num_tydef]; + (!a. NUM_REP a ==> NUM_REP a /\ P (mk_num a)) ==> P n [14] + by DISCH_THEN(MP_TAC o SPEC (parse_term "dest_num n")) from 13; + ((!i. NUM_REP i /\ P (mk_num i) + ==> NUM_REP (IND_SUC i) /\ P (mk_num (IND_SUC i))) + ==> (!a. NUM_REP a ==> NUM_REP a /\ P (mk_num a))) + ==> P n [15] + by W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) + from 12,14; + ((\i. NUM_REP i /\ P (mk_num i)) IND_0 /\ + (!i. (\i. NUM_REP i /\ P (mk_num i)) i + ==> (\i. NUM_REP i /\ P (mk_num i)) (IND_SUC i)) + ==> (!a. NUM_REP a ==> (\i. NUM_REP i /\ P (mk_num i)) a)) + ==> P n [16] by ASM_REWRITE_TAC[GSYM ZERO_DEF; NUM_REP_RULES],* from 15; + thus P n by MP_TAC (SPEC (parse_term + "\\i. NUM_REP i /\\ P(mk_num i):bool") NUM_REP_INDUCT) from 16; + end; + thus !P. P(_0) /\ (!n. P(n) ==> P(SUC n)) ==> !n. P n + by REPEAT STRIP_TAC from 1; +`;; + +let num_RECURSION_STD = thm `; + !e:Z f. ?fn. (fn 0 = e) /\ (!n. fn (SUC n) = f n (fn n)) + proof + !e:Z f. ?fn. fn 0 = e /\ (!n. fn (SUC n) = f n (fn n)) [1] + proof + let e be Z; + let f be num->Z->Z; + (?fn. fn 0 = e /\ (!n. fn (SUC n) = (\z n. f n z) (fn n) n)) + ==> (?fn. fn 0 = e /\ (!n. fn (SUC n) = f n (fn n))) [2] + by REWRITE_TAC[]; + qed by MP_TAC(ISPECL [(parse_term "e:Z"); + (parse_term "(\\z n. (f:num->Z->Z) n z)")] num_RECURSION) from 2; + qed by REPEAT GEN_TAC from 1; +`;; + diff --git a/miz3/Samples/other_mizs.ml b/miz3/Samples/other_mizs.ml new file mode 100644 index 0000000..7cf5136 --- /dev/null +++ b/miz3/Samples/other_mizs.ml @@ -0,0 +1,424 @@ +(* ======== Examples/mizar.ml ============================================== *) + +hide_constant "<=";; + +horizon := 0;; + +let KNASTER_TARSKI = thm `; + let (<=) be A->A->bool; + thus !f. (!x y. x <= y /\ y <= x ==> (x = y)) /\ + (!x y z. x <= y /\ y <= z ==> x <= z) /\ + (!x y. x <= y ==> f x <= f y) /\ + (!X. ?s. (!x. x IN X ==> s <= x) /\ + (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s)) + ==> ?x. f x = x + proof + let f be A->A; + exec DISCH_THEN (LABEL_TAC "L"); + !x y. x <= y /\ y <= x ==> (x = y) [antisymmetry] by L; + !x y z. x <= y /\ y <= z ==> x <= z [transitivity] by L; + !x y. x <= y ==> f x <= f y [monotonicity] by L; + !X. ?s:A. (!x. x IN X ==> s <= x) /\ + (!s'. (!x. x IN X ==> s' <= x) ==> s' <= s) [least_upper_bound] + by L; + set Y = {b | f b <= b} [Y_def]; + !b. b IN Y <=> f b <= b [Y_thm] by ALL_TAC,Y_def,IN_ELIM_THM,BETA_THM; + consider a such that + (!x. x IN Y ==> a <= x) /\ + (!a'. (!x. x IN Y ==> a' <= x) ==> a' <= a) [lub] by least_upper_bound; + take a; + !b. b IN Y ==> f a <= b + proof + let b be A; + assume b IN Y [b_in_Y]; + f b <= b [L0] by -,Y_thm; + a <= b by b_in_Y,lub; + f a <= f b by -,monotonicity; + thus f a <= b by -,L0,transitivity; + end; + f(a) <= a [Part1] by -,lub; + f(f(a)) <= f(a) by -,monotonicity; + f(a) IN Y by -,Y_thm; + a <= f(a) by -,lub; + qed by -,Part1,antisymmetry`;; + +unhide_constant "<=";; + +(* ======== Mizarlight/duality.ml ========================================== *) + +parse_as_infix("ON",(11,"right"));; + +hide_constant "ON";; + +let projective = new_definition + `projective((ON):Point->Line->bool) <=> + (!p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l) /\ + (!l l'. ?p. p ON l /\ p ON l') /\ + (?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l)) /\ + (!l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l)`;; + +horizon := 1;; + +let LEMMA_1 = thm `; + !(ON):Point->Line->bool. projective(ON) ==> !p. ?l. p ON l +proof + let (ON) be Point->Line->bool; + assume projective(ON) [0]; + !p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l [1] by 0,projective; + ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l) [3] by 0,projective; + let p be Point; + consider q q' such that ~(q = q':Point); + ~(p = q) \/ ~(p = q'); + consider l such that p ON l by 1; + take l; +qed`;; + +let LEMMA_2 = thm `; + !(ON):Point->Line->bool. projective(ON) + ==> !p1 p2 q l l1 l2. + p1 ON l /\ p2 ON l /\ p1 ON l1 /\ p2 ON l2 /\ q ON l2 /\ + ~(q ON l) /\ ~(p1 = p2) ==> ~(l1 = l2) +proof + let (ON) be Point->Line->bool; + assume projective(ON) [0]; + !p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l [1] by 0,projective; +// here qed already works + let p1 p2 q be Point; + let l l1 l2 be Line; + assume p1 ON l [5]; + assume p2 ON l [6]; + assume p1 ON l1 [7]; + assume p2 ON l2 [9]; + assume q ON l2 [10]; + assume ~(q ON l) [11]; + assume ~(p1 = p2) [12]; + assume l1 = l2 [13]; + p1 ON l2 by 7; + l = l2 by 1,5,6,9,12; + thus F by 10,11; +end`;; + +let PROJECTIVE_DUALITY = thm `; + !(ON):Point->Line->bool. projective(ON) ==> projective (\l p. p ON l) +proof + let (ON) be Point->Line->bool; + assume projective(ON) [0]; + !p p'. ~(p = p') ==> ?!l. p ON l /\ p' ON l [1] by 0,projective; + !l l'. ?p. p ON l /\ p ON l' [2] by 0,projective; + ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l) [3] by 0,projective; + !l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l [4] by 0,projective; +// dual of axiom 1 + !l1 l2. ~(l1 = l2) ==> ?!p. p ON l1 /\ p ON l2 [5] + proof + let l1 l2 be Line; + assume ~(l1 = l2) [6]; + consider p such that p ON l1 /\ p ON l2 [7] by 2; + !p'. p' ON l1 /\ p' ON l2 ==> (p' = p) + proof + let p' be Point; + assume p' ON l1 /\ p' ON l2 [8]; + assume ~(p' = p); + l1 = l2 by 1,7,8; + thus F by 6; + end; + qed by 7; +// dual of axiom 2 + !p1 p2. ?l. p1 ON l /\ p2 ON l [9] + proof + let p1 p2 be Point; + cases; + suppose p1 = p2; + qed by 0,LEMMA_1; + suppose ~(p1 = p2); + qed by 1; + end; +// dual of axiom 3 + ?l1 l2 l3. ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) /\ + ~(?p. p ON l1 /\ p ON l2 /\ p ON l3) [10] + proof + consider p1 p2 p3 such that + ~(p1 = p2) /\ ~(p2 = p3) /\ ~(p1 = p3) /\ + ~(?l. p1 ON l /\ p2 ON l /\ p3 ON l) [11] by 3; + ~(p1 = p3) by 11; + ?!l1. p1 ON l1 /\ p3 ON l1 by 1; // ADDED STEP + consider l1 such that p1 ON l1 /\ p3 ON l1 /\ + !l'. p1 ON l' /\ p3 ON l' ==> (l1 = l') [12]; + ~(p2 = p3) by 11; + ?!l2. p2 ON l2 /\ p3 ON l2 by 1; // ADDED STEP + consider l2 such that p2 ON l2 /\ p3 ON l2 /\ + !l'. p2 ON l' /\ p3 ON l' ==> (l2 = l') [13]; + ~(p1 = p2) by 11; + ?!l3. p1 ON l3 /\ p2 ON l3 by 1; // ADDED STEP + consider l3 such that p1 ON l3 /\ p2 ON l3 /\ + !l'. p1 ON l' /\ p2 ON l' ==> (l3 = l') [14]; + take l1; take l2; take l3; + thus ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) [15] by 11,12,13,14; + assume ?q. q ON l1 /\ q ON l2 /\ q ON l3; + consider q such that q ON l1 /\ q ON l2 /\ q ON l3; + (p1 = q) /\ (p2 = q) /\ (p3 = q) by 5,12,13,14,15; + thus F by 11; + end; +// dual of axiom 4 + !p0. ?l0 L1 L2. ~(l0 = L1) /\ ~(L1 = L2) /\ ~(l0 = L2) /\ + p0 ON l0 /\ p0 ON L1 /\ p0 ON L2 + proof + let p0 be Point; + consider l0 such that p0 ON l0 [16] by 0,LEMMA_1; + consider p such that ~(p = p0) /\ p ON l0 [17] by 4; + consider q such that ~(q ON l0) [18] by 3; + consider l1 such that p ON l1 /\ q ON l1 [19] by 1,16; + consider r such that r ON l1 /\ ~(r = p) /\ ~(r = q) [20] + proof + consider r1 r2 r3 such that + ~(r1 = r2) /\ ~(r2 = r3) /\ ~(r1 = r3) /\ + r1 ON l1 /\ r2 ON l1 /\ r3 ON l1 [21] by 4; + ~(r1 = p) /\ ~(r1 = q) \/ + ~(r2 = p) /\ ~(r2 = q) \/ + ~(r3 = p) /\ ~(r3 = q); + qed by 21; + ~(p0 ON l1) [22] + proof + assume p0 ON l1; + l1 = l0 by 1,16,17,19; + qed by 18,19; + ~(p0 = r) by 20; + consider L1 such that r ON L1 /\ p0 ON L1 [23] by 1; + consider L2 such that q ON L2 /\ p0 ON L2 [24] by 1,16,18; + take l0; take L1; take L2; + thus ~(l0 = L1) by 0,17,19,20,22,23,LEMMA_2; + thus ~(L1 = L2) by 0,19,20,22,23,24,LEMMA_2; + thus ~(l0 = L2) by 18,24; + thus p0 ON l0 /\ p0 ON L2 /\ p0 ON L1 by 16,24,23; + end; +qed by REWRITE_TAC,5,9,10,projective`;; + +unhide_constant "ON";; + +(* ======== Mizarlight/duality_holby.ml ==================================== *) + +horizon := 1;; + +let Line_INDUCT,Line_RECURSION = define_type + "fano_Line = Line_1 | Line_2 | Line_3 | Line_4 | + Line_5 | Line_6 | Line_7";; + +let Point_INDUCT,Point_RECURSION = define_type + "fano_Point = Point_1 | Point_2 | Point_3 | Point_4 | + Point_5 | Point_6 | Point_7";; + +let Point_DISTINCT = distinctness "fano_Point";; + +let Line_DISTINCT = distinctness "fano_Line";; + +let fano_incidence = + [1,1; 1,2; 1,3; 2,1; 2,4; 2,5; 3,1; 3,6; 3,7; 4,2; 4,4; + 4,6; 5,2; 5,5; 5,7; 6,3; 6,4; 6,7; 7,3; 7,5; 7,6];; + +let fano_point i = mk_const("Point_"^string_of_int i,[]) +and fano_line i = mk_const("Line_"^string_of_int i,[]);; + +let fano_clause (i,j) = + let p = `p:fano_Point` and l = `l:fano_Line` in + mk_conj(mk_eq(p,fano_point i),mk_eq(l,fano_line j));; + +let ON = new_definition + (mk_eq(`((ON):fano_Point->fano_Line->bool) p l`, + list_mk_disj(map fano_clause fano_incidence)));; + +let ON_CLAUSES = prove + (list_mk_conj(allpairs + (fun i j -> mk_eq(list_mk_comb(`(ON)`,[fano_point i; fano_line j]), + if mem (i,j) fano_incidence then `T` else `F`)) + (1--7) (1--7)), + REWRITE_TAC[ON; Line_DISTINCT; Point_DISTINCT]);; + +let FORALL_POINT = thm `; + !P. (!p. P p) <=> P Point_1 /\ P Point_2 /\ P Point_3 /\ P Point_4 /\ + P Point_5 /\ P Point_6 /\ P Point_7 + by Point_INDUCT`;; + +let EXISTS_POINT = thm `; + !P. (?p. P p) <=> P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ + P Point_5 \/ P Point_6 \/ P Point_7 +proof + let P be fano_Point->bool; + ~(?p. P p) <=> ~(P Point_1 \/ P Point_2 \/ P Point_3 \/ P Point_4 \/ + P Point_5 \/ P Point_6 \/ P Point_7) + by REWRITE_TAC,DE_MORGAN_THM,NOT_EXISTS_THM,FORALL_POINT; +qed`;; + +let FORALL_LINE = thm `; + !P. (!p. P p) <=> P Line_1 /\ P Line_2 /\ P Line_3 /\ P Line_4 /\ + P Line_5 /\ P Line_6 /\ P Line_7 + by Line_INDUCT`;; + +let EXISTS_LINE = thm `; + !P. (?p. P p) <=> P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ + P Line_5 \/ P Line_6 \/ P Line_7 +proof + let P be fano_Line->bool; + ~(?p. P p) <=> ~(P Line_1 \/ P Line_2 \/ P Line_3 \/ P Line_4 \/ + P Line_5 \/ P Line_6 \/ P Line_7) + by REWRITE_TAC,DE_MORGAN_THM,NOT_EXISTS_THM,FORALL_LINE; +qed;`;; + +let FANO_TAC = + GEN_REWRITE_TAC DEPTH_CONV + [FORALL_POINT; EXISTS_LINE; EXISTS_POINT; FORALL_LINE] THEN + GEN_REWRITE_TAC DEPTH_CONV + (basic_rewrites() @ [ON_CLAUSES; Point_DISTINCT; Line_DISTINCT]);; + +let AXIOM_1 = thm `; + !p p'. ~(p = p') ==> ?l. p ON l /\ p' ON l /\ + !l'. p ON l' /\ p' ON l' ==> (l' = l) + by TIMED_TAC 3 FANO_TAC`;; + +let AXIOM_2 = thm `; + !l l'. ?p. p ON l /\ p ON l' by FANO_TAC`;; + +let AXIOM_3 = thm `; + ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l) + by TIMED_TAC 2 FANO_TAC`;; + +let AXIOM_4 = thm `; + !l. ?p p' p''. ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON l /\ p' ON l /\ p'' ON l + by TIMED_TAC 3 FANO_TAC`;; + +let AXIOM_1' = thm `; + !p p' l l'. ~(p = p') /\ p ON l /\ p' ON l /\ p ON l' /\ p' ON l' + ==> (l' = l) +proof + let p p' be fano_Point; + let l l' be fano_Line; + assume ~(p = p') /\ p ON l /\ p' ON l /\ p ON l' /\ p' ON l' [1]; + consider l1 such that p ON l1 /\ p' ON l1 /\ + !l'. p ON l' /\ p' ON l' ==> (l' = l1) [2] + by 1,AXIOM_1; + l = l1 by 1,2; + .= l' by 1,2; +qed`;; + +let LEMMA_1' = thm `; + !O. ?l. O ON l +proof + consider p p' p'' such that + ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + ~(?l. p ON l /\ p' ON l /\ p'' ON l) [1] by AXIOM_3; + let O be fano_Point; + ~(p = O) \/ ~(p' = O) by 1; + consider P such that ~(P = O) [2]; + consider l such that O ON l /\ P ON l /\ + !l'. O ON l' /\ P ON l' ==> (l' = l) [3] by 2,AXIOM_1; + thus ?l. O ON l by 3; +end`;; + +let DUAL_1 = thm `; + !l l'. ~(l = l') ==> ?p. p ON l /\ p ON l' /\ + !p'. p' ON l /\ p' ON l' ==> (p' = p) +proof + assume ~thesis; + consider l l' such that ~(l = l') /\ !p. p ON l /\ p ON l' + ==> ?p'. p' ON l /\ p' ON l' /\ ~(p' = p) [1]; + consider p such that p ON l /\ p ON l' [2] by AXIOM_2; + consider p' such that p' ON l /\ p' ON l' /\ ~(p' = p) [3] by 1,2; + thus F by 1,2,AXIOM_1'; +end`;; + +let DUAL_2 = thm `; + !p p'. ?l. p ON l /\ p' ON l +proof + let p p' be fano_Point; + ?l. p ON l [1] by LEMMA_1'; + (p = p') \/ + ?l. p ON l /\ p' ON l /\ + !l'. p ON l' /\ p' ON l' ==> (l' = l) by AXIOM_1; +qed by 1`;; + +let DUAL_3 = thm `; + ?l1 l2 l3. ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) /\ + ~(?p. p ON l1 /\ p ON l2 /\ p ON l3) +proof + consider p1 p2 p3 such that + ~(p1 = p2) /\ ~(p2 = p3) /\ ~(p1 = p3) /\ + ~(?l. p1 ON l /\ p2 ON l /\ p3 ON l) [1] by AXIOM_3; + consider l1 such that p1 ON l1 /\ p3 ON l1 [2] by DUAL_2; + consider l2 such that p2 ON l2 /\ p3 ON l2 [3] by DUAL_2; + consider l3 such that p1 ON l3 /\ p2 ON l3 [4] by DUAL_2; + take l1; take l2; take l3; + thus ~(l1 = l2) /\ ~(l2 = l3) /\ ~(l1 = l3) [5] by 1,2,3,4; + assume ~thesis; + consider q such that q ON l1 /\ q ON l2 /\ q ON l3 [6]; + consider q' such that q' ON l1 /\ q' ON l3 /\ + !p'. p' ON l1 /\ p' ON l3 ==> (p' = q') [7] by 5,DUAL_1; + q = q' by 6,7; + .= p1 by 2,4,7; + thus F by 1,3,6; +end`;; + +let DUAL_4 = thm `; + !O. ?OP OQ OR. ~(OP = OQ) /\ ~(OQ = OR) /\ ~(OP = OR) /\ + O ON OP /\ O ON OQ /\ O ON OR +proof + let O be fano_Point; + consider OP such that O ON OP [1] by LEMMA_1'; + consider p p' p'' such that + ~(p = p') /\ ~(p' = p'') /\ ~(p = p'') /\ + p ON OP /\ p' ON OP /\ p'' ON OP [2] by AXIOM_4; + ~(p = O) \/ ~(p' = O) by 2; + consider P such that ~(P = O) /\ P ON OP [3] by 2; + consider q q' q'' such that + ~(q = q') /\ ~(q' = q'') /\ ~(q = q'') /\ + ~(?l. q ON l /\ q' ON l /\ q'' ON l) [4] by AXIOM_3; + ~(q ON OP) \/ ~(q' ON OP) \/ ~(q'' ON OP) by 4; + consider Q such that ~(Q ON OP) [5]; + consider l such that P ON l /\ Q ON l [6] by DUAL_2; + consider r r' r'' such that + ~(r = r') /\ ~(r' = r'') /\ ~(r = r'') /\ + r ON l /\ r' ON l /\ r'' ON l [7] by AXIOM_4; + ((r = P) \/ (r = Q) \/ ~(r = P) /\ ~(r = Q)) /\ + ((r' = P) \/ (r' = Q) \/ ~(r' = P) /\ ~(r' = Q)); + consider R such that R ON l /\ ~(R = P) /\ ~(R = Q) [8] by 7; + consider OQ such that O ON OQ /\ Q ON OQ [9] by DUAL_2; + consider OR such that O ON OR /\ R ON OR [10] by DUAL_2; + take OP; take OQ; take OR; + ~(O ON l) by 1,3,5,6,AXIOM_1'; + thus ~(OP = OQ) /\ ~(OQ = OR) /\ ~(OP = OR) /\ + O ON OP /\ O ON OQ /\ O ON OR by 1,3,5,6,8,9,10,AXIOM_1'; +end`;; + +(* ======== Tutorial/Changing_proof_style.ml =============================== *) + +horizon := 1;; + +let NSQRT_2_4 = thm `; + !p q. p * p = 2 * q * q ==> q = 0 +proof + !p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0)) + ==> (!q. p * p = 2 * q * q ==> q = 0) + proof + let p be num; + assume !m. m < p ==> !q. m * m = 2 * q * q ==> q = 0 [A]; + let q be num; + assume p * p = 2 * q * q [B]; + EVEN(p * p) <=> EVEN(2 * q * q); + EVEN(p) by TIMED_TAC 2 o MESON_TAC,ARITH,EVEN_MULT; +// "EVEN 2 by CONV_TAC o HOL_BY,ARITH;" takes over a minute... + consider m such that p = 2 * m [C] by EVEN_EXISTS; + cases by ARITH_TAC; + suppose q < p; + q * q = 2 * m * m ==> m = 0 by A; + qed by NUM_RING,B,C; + suppose p <= q; + p * p <= q * q by LE_MULT2; + q * q = 0 by ARITH_TAC,B; + qed by NUM_RING; + end; +qed by MATCH_MP_TAC,num_WF`;; + diff --git a/miz3/Samples/robbins.ml b/miz3/Samples/robbins.ml new file mode 100644 index 0000000..10b8aab --- /dev/null +++ b/miz3/Samples/robbins.ml @@ -0,0 +1,196 @@ +(* ======== Robbins Conjecture proof from John ============================= *) + +hide_constant "+";; +horizon := 0;; +timeout := 2;; (* John apparently has a faster computer :-) *) + +let ROBBINS = thm `; + + let (+) be A->A->A; + let n be A->A; + + assume !x y. x+y = y+x [COM]; + assume !x y z. x+(y+z) = (x+y)+z [ASS]; + assume !a b. n(n(a+b)+n(a+n(b))) = a [ROB]; + + consider x such that x:A = x; + + set u = n(x+n(x)) [U]; + set d = x+u [D]; + set c = x+x+x+u [C]; + set j = n(c+d) [J]; + set e = u+n(x+x)+n(c) [E]; + + n(u+n(x+x)) = x [0] + proof n(u+n(x+x)) + = n(n(x+n(x))+n(x+x)) by U; + .= x by ROB,COM; + qed by -; + + n(x+u+n(x+u+n(x+x)+n(c))) = n(c) [1] + proof n(x+u+n(x+u+n(x+x)+n(c))) + = n((x+u)+n(x+u+n(x+x)+n(c))) by ASS,COM; + .= n(n(n((x+u)+x+x)+n((x+u)+n(x+x)))+n(x+u+n(x+x)+n(c))) by ROB; + .= n(n(n(x+u+x+x)+n(x+u+n(x+x)))+n(x+u+n(x+x)+n(c))) by ASS; + .= n(n(n(x+x+x+u)+n(x+u+n(x+x)))+n(x+u+n(x+x)+n(c))) by ASS,COM; // slow + .= n(n(n(c)+n(x+u+n(x+x)))+n(n(c)+x+u+n(x+x))) by ASS,COM,C; + .= n(c) by ROB,ASS,COM; + qed by -; + + n(u+n(c)) = x [2] + proof n(u+n(c)) + = n(u+n(x+x+u+x)) by C,ASS,COM; + .= n(u+n(x+x+u+n(u+n(x+x)))) by 0; + .= n(n(n(u+x+x)+n(u+n(x+x)))+n(x+x+u+n(u+n(x+x)))) by ROB; + .= n(n(x+x+u+n(u+n(x+x)))+n(n(u+x+x)+n(u+n(x+x)))) by COM; + .= n(n((x+x+u)+n(u+n(x+x)))+n(n(u+x+x)+n(u+n(x+x)))) by ASS; + .= n(n(n(u+n(x+x))+u+x+x)+n(n(u+n(x+x))+n(u+x+x))) by ASS,COM; + .= n(u+n(x+x)) by ROB; + .= x by 0; + qed by -; + + n(j+u) = x [3] + proof n(j+u) + = n(n(x+c+u)+u) by J,D,COM,ASS; + .= n(n(x+c+u)+n(n(u+c)+n(u+n(c)))) by ROB; + .= n(n(x+c+u)+n(x+n(c+u))) by 2,COM; + .= x by ROB; + qed by -; + + n(x+n(x+n(x+x)+u+n(c))) = n(x+x) [4] + proof n(x+n(x+n(x+x)+u+n(c))) + = n(n(n(x+n(u+n(c)))+n(x+u+n(c)))+n(x+n(x+x)+u+n(c))) + by ROB,ASS,COM; + .= n(n(n(x+x)+n(x+u+n(c)))+n(n(x+x)+x+u+n(c))) by 2,ASS,COM; + .= n(n(n(x+x)+x+u+n(c))+n(n(x+x)+n(x+u+n(c)))) by ASS,COM; + .= n(x+x) by ROB,COM; + qed by -; + + n(x+n(c)) = u [5] + proof n(x+n(c)) + = n(x+n(x+u+n(x+u+n(x+x)+n(c)))) by 1; + .= n(n(u+n(x+x))+n(x+u+n(x+u+n(x+x)+n(c)))) by 0; + .= n(n(u+n(x+x))+n(u+x+n(x+e))) by E,COM,ASS; + .= n(n(u+n(x+n(x+n(x+x)+u+n(c))))+n(u+x+n(x+e))) by 4; + .= n(n(u+n(x+n(x+(u+n(c))+n(x+x))))+n(u+x+n(x+e))) by COM; + .= n(n(u+n(x+n(x+u+n(c)+n(x+x))))+n(u+x+n(x+e))) by ASS; + .= n(n(u+n(x+n(x+u+n(x+x)+n(c))))+n(u+x+n(x+e))) by COM; + .= n(n(u+n(x+n(x+e)))+n(u+x+n(x+e))) by E; + .= u by ROB,COM; + qed by -; + + n(j+x) = u [6] + proof n(j+x) + = n(j+n(n(x+c)+n(x+n(c)))) by ROB; + .= n(j+n(n(x+c)+u)) by 5; + .= n(n(u+x+c)+n(u+n(x+c))) by J,D,COM,ASS; + .= u by ROB; + qed by -; + + n(c+d) = n(c) + proof n(c+d) + = j by J; + .= n(n(j+n(x+n(c)))+n(j+x+n(c))) by ROB,COM; + .= n(n(j+u)+n(j+x+n(c))) by 5; + .= n(x+n(j+x+n(c))) by 3; + .= n(n(n(c)+u)+n(n(c)+j+x)) by 2,COM,ASS; + .= n(n(n(c)+n(j+x))+n(n(c)+j+x)) by 6; + .= n(c) by ROB,COM; + qed by -; + + thus ?c d. n(c+d) = n(c) by -`;; + +timeout := 1;; + +(* ======== REWRITE version ================================================ *) + +let old_default_prover = !default_prover;; +default_prover := "REWRITE_TAC",REWRITE_TAC;; + +let ROBBINS = thm `; + + let (+) be A->A->A; + let n be A->A; + + assume !x y. x+y = y+x [COM]; + assume !x y z. x+(y+z) = (x+y)+z [ASS]; + assume !a b. n(n(a+b)+n(a+n(b))) = a [ROB]; + + !x y z. x+y = y+x /\ (x+y)+z = x+(y+z) /\ x+(y+z) = y+(x+z) [AC] + by MESON_TAC,COM,ASS; + + consider x such that x:A = x; + + set u = n(x+n(x)) [U]; + set d = x+u [D]; + set c = x+x+x+u [C]; + set j = n(c+d) [J]; + set e = u+n(x+x)+n(c) [E]; + + n(u+n(x+x)) = x [0] + proof n(u+n(x+x)) + = n(n(x+x)+n(x+n(x))) by U,AC; + .= x by ROB; + qed by -; + + n(x+u+n(x+u+n(x+x)+n(c))) = n(c) [1] + proof n(x+u+n(x+u+n(x+x)+n(c))) + = n((x+u)+n(x+u+n(x+x)+n(c))) by AC; + .= n(n(n((x+u)+x+x)+n((x+u)+n(x+x)))+n(x+u+n(x+x)+n(c))) by ROB; + .= n(n(n(c)+x+u+n(x+x))+n(n(c)+n(x+u+n(x+x)))) by C,AC; + .= n(c) by ROB; + qed by -; + + n(u+n(c)) = x [2] + proof n(u+n(c)) + = n(u+n(x+x+u+n(u+n(x+x)))) by 0,C,AC; + .= n(n(n(u+x+x)+n(u+n(x+x)))+n(x+x+u+n(u+n(x+x)))) by ROB; + .= n(n(n(u+n(x+x))+u+x+x)+n(n(u+n(x+x))+n(u+x+x))) by AC; + .= n(u+n(x+x)) by ROB; + .= x by 0; + qed by -; + + n(j+u) = x [3] + proof n(j+u) + = n(n(x+c+u)+u) by J,D,AC; + .= n(n(x+c+u)+n(n(u+c)+n(u+n(c)))) by ROB; + .= n(n(x+c+u)+n(x+n(c+u))) by 2,AC; + .= x by ROB; + qed by -; + + n(x+n(x+n(x+x)+u+n(c))) = n(x+x) [4] + proof n(x+n(x+n(x+x)+u+n(c))) + = n(n(n(x+u+n(c))+n(x+n(u+n(c))))+n(x+n(x+x)+u+n(c))) by ROB; + .= n(n(n(x+x)+x+u+n(c))+n(n(x+x)+n(x+u+n(c)))) by 2,AC; + .= n(x+x) by ROB; + qed by -; + + n(x+n(c)) = u [5] + proof n(x+n(c)) + = n(n(u+n(x+x))+n(x+u+n(x+u+n(x+x)+n(c)))) by 0,1; + .= n(n(u+n(x+n(x+n(x+x)+u+n(c))))+n(u+x+n(x+e))) by 4,E,AC; + .= n(n(u+x+n(x+e))+n(u+n(x+n(x+e)))) by E,AC; + .= u by ROB; + qed by -; + + n(j+x) = u [6] + proof n(j+x) + = n(j+n(n(x+c)+n(x+n(c)))) by ROB; + .= n(n(u+x+c)+n(u+n(x+c))) by 5,J,D,AC; + .= u by ROB; + qed by -; + + n(c+d) = n(c) + proof n(c+d) + = j by J; + .= n(n(j+x+n(c))+n(j+n(x+n(c)))) by ROB; + .= n(n(u+n(c))+n(j+x+n(c))) by 2,3,5,AC; + .= n(n(n(c)+j+x)+n(n(c)+n(j+x))) by 6,AC; + .= n(c) by ROB; + qed by -; + + thus ?c d. n(c+d) = n(c) by MESON_TAC,-`;; + +unhide_constant "+";; +default_prover := old_default_prover;; + diff --git a/miz3/Samples/sample.ml b/miz3/Samples/sample.ml new file mode 100644 index 0000000..1cc206a --- /dev/null +++ b/miz3/Samples/sample.ml @@ -0,0 +1,19 @@ +horizon := 1;; + +thm `; +let R be num->num->bool; +assume !x. R x x [1]; +assume !x y z. R x y /\ R y z ==> R x z [2]; +thus (!m n. m <= n ==> R m n) <=> (!n. R n (SUC n)) +proof + now [3] // back direction first + assume !n. R n (SUC n); + let m n be num; + !d. R m (m + d) ==> R m (m + SUC d) [4] by 2,ADD_CLAUSES; + R m (m + 0) by 1,ADD_CLAUSES; + !d. R m (m + d) by 4,INDUCT_TAC; + thus m <= n ==> R m n by LE_EXISTS; + end; + !n. n <= SUC n; +qed by 3`;; + diff --git a/miz3/Samples/samples.ml b/miz3/Samples/samples.ml new file mode 100644 index 0000000..6f3812e --- /dev/null +++ b/miz3/Samples/samples.ml @@ -0,0 +1,52 @@ +horizon := 1;; + +thm `; + !R. (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) + ==> ((!m n. m <= n ==> R m n) <=> (!n. R n (SUC n))) + proof + let R be num->num->bool; + assume !x. R x x [1]; + assume !x y z. R x y /\ R y z ==> R x z [2]; + !n. n <= SUC n by ARITH_TAC; + (!m n. m <= n ==> R m n) ==> (!n. R n (SUC n)) [3] by SIMP_TAC; + now + assume !n. R n (SUC n) [4]; + !m n d. n = m + d ==> R m (m + d) + proof + let m be num; + R m m by MESON_TAC,1; + R m (m + 0) [5] by REWRITE_TAC,ADD_CLAUSES; + !d. R m (m + d) ==> R m (m + SUC d) + proof + let d be num; + assume R m (m + d); + R m (SUC (m + d)) by MESON_TAC,2,4; + qed by REWRITE_TAC,ADD_CLAUSES; + !d. R m (m + d) by INDUCT_TAC,5; + !d n. n = m + d ==> R m (m + d) + by REWRITE_TAC,LEFT_FORALL_IMP_THM,EXISTS_REFL,ADD_CLAUSES; + qed by ONCE_REWRITE_TAC,SWAP_FORALL_THM; + thus !m n. m <= n ==> R m n by SIMP_TAC,LE_EXISTS,LEFT_IMP_EXISTS_THM; + end; + qed by EQ_TAC,3`;; + +thm `; + !s. INFINITE s ==> ?x:A. x IN s + proof + let s be A->bool; + assume INFINITE s; + ~(s = {}) by INFINITE_NONEMPTY; + consider x such that + ~(x IN s <=> x IN {}) [1] by EXTENSION; + take x; + ~(x IN {}) by NOT_IN_EMPTY; + qed by 1`;; + +let NOT_EVEN = thm `; + !n. ~EVEN n <=> ODD n + proof + ~EVEN 0 <=> ODD 0 [1] by EVEN,ODD; + !n. (~EVEN n <=> ODD n) ==> (~EVEN (SUC n) <=> ODD (SUC n)) + by EVEN,ODD; + qed by 1,INDUCT_TAC`;; + diff --git a/miz3/Samples/talk.ml b/miz3/Samples/talk.ml new file mode 100644 index 0000000..84ba356 --- /dev/null +++ b/miz3/Samples/talk.ml @@ -0,0 +1,91 @@ +let ARITHMETIC_PROGRESSION_SIMPLE = prove + (`!n. nsum(1..n) (\i. i) = (n*(n + 1)) DIV 2`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN + ARITH_TAC);; + +horizon := 1;; + +thm `; +!n. nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2 +proof + nsum(0..0) (\i. i) = 0 by NSUM_CLAUSES_NUMSEG; + .= (0*(0 + 1)) DIV 2 [A1] by ARITH_TAC; + now let n be num; + assume nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2; + nsum(0..SUC n) (\i. i) = (n*(n + 1)) DIV 2 + SUC n + by NSUM_CLAUSES_NUMSEG,ARITH_RULE (parse_term "0 <= SUC n"); + thus .= ((SUC n)*(SUC n + 1)) DIV 2 by ARITH_TAC; + end; +qed by INDUCT_TAC,A1`;; + +thm `; +now + (if 1 = 0 then 0 else 0) = (0 * (0 + 1)) DIV 2 [A1] by ARITH_TAC; + nsum (1..0) (\i. i) = (0 * (0 + 1)) DIV 2 [A2] + by REWRITE_TAC,NSUM_CLAUSES_NUMSEG,A1; + now [A3] + let n be num; + assume nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 [A4]; + (if 1 <= SUC n then (n * (n + 1)) DIV 2 + SUC n else (n * (n + 1)) DIV 2) = + (SUC n * (SUC n + 1)) DIV 2 [A5] by ARITH_TAC; + thus nsum (1..SUC n) (\i. i) = (SUC n * (SUC n + 1)) DIV 2 [A6] + by REWRITE_TAC,NSUM_CLAUSES_NUMSEG,A4,A5; + end; + thus !n. nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 [A7] by INDUCT_TAC,A2,A3; +end`;; + +let EXAMPLE = ref None;; + +EXAMPLE := Some `; +!n. nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2 +proof + nsum(0..0) (\i. i) = (0*(0 + 1)) DIV 2; + now let n be nat; + assume nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2; + thus nsum(0..SUC n) (\i. i) = ((SUC n)*(SUC n + 1)) DIV 2 by #; + end; +qed`;; + +thm `; +!n. nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 +proof + (if 1 = 0 then 0 else 0) = (0 * (0 + 1)) DIV 2 by ARITH_TAC; + nsum (1..0) (\i. i) = (0 * (0 + 1)) DIV 2 [A1] + by ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG]; + !n. nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 + ==> nsum (1..SUC n) (\i .i) = (SUC n * (SUC n + 1)) DIV 2 + proof + let n be num; + assume nsum (1..n) (\i. i) = (n * (n + 1)) DIV 2 [A2]; + (if 1 <= SUC n then (n * (n + 1)) DIV 2 + SUC n else (n * (n + 1)) DIV 2) = + (SUC n * (SUC n + 1)) DIV 2 by ARITH_TAC; + qed by ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG],A2; +qed by INDUCT_TAC,A1`;; + +let NSUM_CLAUSES_NUMSEG' = thm `; +!s. nsum(0..0) s = s 0 /\ !n. nsum(0..n + 1) s = nsum(0..n) s + s (n + 1) +proof + !n. 0 <= SUC n by ARITH_TAC; +qed by NSUM_CLAUSES_NUMSEG,ADD1`;; + +let num_INDUCTION' = REWRITE_RULE[ADD1] num_INDUCTION;; + +thm `; +!s. (!i. s i = i) ==> !n. nsum(0..n) s = (n*(n + 1)) DIV 2 +proof + let s be num->num; + assume !i. s i = i [A1]; + set X = \n. (nsum(0..n) s = (n*(n + 1)) DIV 2); + nsum(0..0) s = s 0 by NSUM_CLAUSES_NUMSEG'; + .= 0 by A1; + .= (0*(0 + 1)) DIV 2 by ARITH_TAC; + X 0 [A2]; + now [A3] let n be num; + assume X n; + nsum(0..n + 1) s = (n*(n + 1)) DIV 2 + s (n + 1) by NSUM_CLAUSES_NUMSEG'; + .= (n*(n + 1)) DIV 2 + (n + 1) by A1; + thus X (n + 1) by ARITH_TAC; + end; + !n. X n by MATCH_MP_TAC,num_INDUCTION',A2,A3; +qed`;; + diff --git a/miz3/Samples/tobias.ml b/miz3/Samples/tobias.ml new file mode 100644 index 0000000..d91639d --- /dev/null +++ b/miz3/Samples/tobias.ml @@ -0,0 +1,65 @@ +prioritize_real();; + +let rational = new_definition + `rational(r) <=> ?p q. ~(q = 0) /\ (abs(r) = &p / &q)`;; + +horizon := 1;; + +let TOBIAS = thm `; + let f be real->real; + assume f(&0) = &1 [1]; + assume !x y. f(x + y + &1) = f x + f y [2]; + let r be real; + assume rational r [3]; + thus f r = r + &1 + proof + set g = \x. f(x) - &1; + g(&0) = &0 [4] by 1,REAL_FIELD; + now [5] let x be real; + x + &1 = x + &0 + &1 by REAL_FIELD; + g(x + &1) = (f x + f(&0)) - &1 by 2; + thus ... = g x + &1 by 1,REAL_FIELD; + end; + now [6] let x be real; + (x - &1) + &1 = x [7] by REAL_FIELD; + g(x - &1) = (g(x - &1) + &1) - &1 by REAL_FIELD; + thus ... = g(x) - &1 by 5,7; + end; + now [8] let x y be real; + x + y = (x + y + &1) - &1 by REAL_FIELD; + g(x + y) = (f x + f y) - &1 - &1 by 2,6; + thus ... = g x + g y by 2,REAL_FIELD; + end; + now [9] let x be real; + g(&0*x) = &0*(g x) [10] by 4,REAL_MUL_LZERO; + now [11] + let n be num; + assume g(&n*x) = &n*(g x) [12]; + &(SUC n) = &n + &1 [13] by ADD1,REAL_OF_NUM_ADD; + &(SUC n)*x = &n*x + x by REAL_FIELD; + g(&(SUC n)*x) = &n*(g x) + g x by 8,12; + thus ... = &(SUC n)*g x by 13,REAL_FIELD; + end; + thus !n. g(&n*x) = &n*g(x) by INDUCT_TAC,10,11; + end; + &1 = &0 + &1 /\ -- &1 = &0 - &1 by REAL_FIELD; + g(&1) = &1 /\ g(-- &1) = -- &1 [14] by 4,5,6; + consider n m such that ~(m = 0) /\ (abs r = &n/ &m) [15] + by 3,rational; + 0 < m by ARITH_TAC; + &0 < &m [16] by REAL_OF_NUM_LT; + cases by REAL_FIELD; + suppose &0 <= r; + r = (&n* &1)/ &m [17] by 15,REAL_FIELD; + &m*r = &n* &1 [18] by 16,REAL_FIELD; + &m*g(r) = &n* &1 by 9,14,18; + f r = r + &1 by 16,17,REAL_FIELD; + qed; + suppose r < &0; + r = (&n*(-- &1))/ &m [19] by 15,REAL_FIELD; + &m*r = &n*(-- &1) [20] by 16,REAL_FIELD; + &m*g(r) = &n*(-- &1) by 9,14,20; + f r = r + &1 by 16,19,REAL_FIELD; + qed; + end`;; + diff --git a/miz3/Samples/wishes.ml b/miz3/Samples/wishes.ml new file mode 100644 index 0000000..25cc9a0 --- /dev/null +++ b/miz3/Samples/wishes.ml @@ -0,0 +1,16 @@ +let EXAMPLE = prove + (`!n. nsum(0..n) (\i. i) = (n*(n + 1)) DIV 2`, + INDUCT_TAC THEN ASM_REWRITE_TAC[NSUM_CLAUSES_NUMSEG] THEN ARITH_TAC);; + +let EXAMPLE_IN_MIZAR_LIGHT = thm `; + !n. nsum (0..n) (\i. i) = (n * (n + 1)) DIV 2 [1] + proof + nsum (0..0) (\i. i) = 0 [2] by NSUM_CLAUSES_NUMSEG; + ... = (0 * (0 + 1)) DIV 2 [3] by ARITH_TAC; + !n. nsum (0..n) (\i. i) = (n * (n + 1)) DIV 2 + ==> nsum (0..SUC n) (\i. i) = (SUC n * (SUC n + 1)) DIV 2 [4] + proof + let n be num; + assume nsum (0..n) (\i. i) = (n * (n + 1)) DIV 2 [5]; + qed by #; + qed by INDUCT_TAC from 3,4`;; diff --git a/miz3/make.ml b/miz3/make.ml new file mode 100644 index 0000000..9a90830 --- /dev/null +++ b/miz3/make.ml @@ -0,0 +1,2 @@ +#load "unix.cma";; +loadt "miz3/miz3.ml";; diff --git a/miz3/miz3.ml b/miz3/miz3.ml new file mode 100644 index 0000000..1ae5109 --- /dev/null +++ b/miz3/miz3.ml @@ -0,0 +1,1890 @@ +needs "Examples/holby.ml";; + +let horizon = ref 1;; +let timeout = ref 1;; +let default_prover = ref ("HOL_BY", CONV_TAC o HOL_BY);; +let renumber_labels = ref true;; +let extra_labels = ref 0;; +let start_label = ref 1;; +let growth_mode = ref true;; +let proof_indent = ref " ";; +let proof_width = ref 72;; +let grow_haves = ref true;; +let grow_duplicates = ref 0;; +let indent_continued = ref false;; +let sketch_mode = ref false;; +let silent_server = ref 1;; +let explain_errors = ref 1;; +let miz3_pid = ref "/tmp/miz3_pid";; +let miz3_filename = ref "/tmp/miz3_filename";; + +let ERRORS = + ["1: inference error"; + "2: inference time-out"; + "3: skeleton error"; + "4: unknown label"; + "5: error ocaml (or justification)"; + "6: underspecified types hol"; + "7: unbound free variables hol"; + "8: syntax or type error hol"; + "9: syntax error mizar"];; + +let mizar_step_words = + ["assume"; "cases"; "case"; "consider"; "end"; "let"; "now"; "proof"; + "qed"; "set"; "suppose"; "take"; "thus"];; + +let mizar_step_words = mizar_step_words @ + ["exec"];; + +let mizar_words = mizar_step_words @ + ["be"; "being"; "by"; "from"; "such"; "that"];; + +let mizar_skip_bracketed = + [","; ";"; "["];; + +reserve_words (subtract mizar_words (reserved_words()));; + +type by_item = +| Label of string +| Thm of string * thm +| Tactic of string * (thm list -> tactic) +| Grow of string * (thm list -> tactic) +| Hole;; + +type step = + int * (string * lexcode * string) list list * substep + +and substep = +| Have of term * string list * just +| Now of string list * just +| Let of term list +| Assume of term * string list +| Thus of term * string list * just +| Qed of just +| Bracket_proof +| Bracket_end +| Take of term +| Consider of term list * term * string list * just +| Set of term * string list +| Cases of just * just list +| Bracket_case +| Suppose of term * string list +| Exec of string * tactic +| Error of string * just +| Error_point +| Empty_step + +and just = +| By of by_item list * by_item list * bool +| Proof of step option * step list * step option +| Proof_expected of bool +| No_steps;; + +unset_jrh_lexer;; + +let system_ok = Unix.WEXITED 0;; +let wronly = Unix.O_WRONLY;; +let usr2_handler = ref (fun () -> print_string "usr2_handler\n");; +Sys.signal Sys.sigusr2 (Sys.Signal_handle (fun _ -> !usr2_handler ()));; + +set_jrh_lexer;; + +let rawtoken = + let collect (h,t) = end_itlist (^) (h::t) in + let stringof p = atleast 1 p >> end_itlist (^) in + let simple_ident = stringof(some isalnum) || stringof(some issymb) in + let undertail = stringof (a "_") ++ possibly simple_ident >> collect in + let ident = (undertail || simple_ident) ++ many undertail >> collect in + let septok = stringof(some issep) in + let stringchar = + some (fun i -> i <> "\\" & i <> "\"") + || (a "\\" ++ some (fun _ -> true) >> fun (_,x) -> "\\"^x) in + let string = a "\"" ++ many stringchar ++ ((a "\"" >> K 0) || finished) >> + (fun ((_,s),_) -> "\""^implode s^"\"") in + (string || some isbra || septok || ident || a "`");; + +let rec whitespace e i = + let non_newline i = + if i <> [] & hd i <> "\n" then hd i,tl i else raise Noparse in + let rest_of_line = many non_newline ++ (a "\n" || (finished >> K "")) >> + fun x,y -> itlist (^) x y in + let comment_string = + match !comment_token with + | Resword t -> t + | Ident t -> t in + match i with + | [] -> if e then "",i else raise Noparse + | (" " as c)::rst | ("\t" as c)::rst | ("\r" as c)::rst -> + let s,rst1 = whitespace true rst in c^s,rst1 + | ("\n" as c)::rst -> c,rst + | _ -> + let t,rst = rawtoken i in + if t = comment_string then (rest_of_line >> fun x -> t^x) rst + else if String.length t >= 2 && String.sub t 0 2 = "::" then + (rest_of_line >> fun x -> if e then t^x else "") rst + else if e then "",i else raise Noparse;; + +let lex1 = + let reserve1 n = + if is_reserved_word n then Resword n else Ident n in + let rec tokens i = + try (many (whitespace false) ++ rawtoken ++ whitespace true + ++ tokens >> + fun (((x,y),z),w) -> (implode x,reserve1 y,z)::w) i + with Noparse -> [],i in + fun l -> + let (toks,rst) = tokens l in + let rst',rst'' = many (whitespace false) rst in + if rst'' <> [] then failwith "lex1" else + if toks = [] then toks else + let (x,y,z) = last toks in + butlast toks@[x,y,z^implode rst'];; + +let lex2 = lex1 o explode;; + +let middle (_,x,_) = x;; + +let a' t toks = + match toks with + | ((_,Resword t',_) as tok)::rst when t = t' -> tok,rst + | ((_,Ident t',_) as tok)::rst when t = t' -> tok,rst + | _ -> raise Noparse;; + +let a_semi = a' ";";; + +let ident' toks = + match toks with + | (_,Ident s,_)::rst -> s,rst + | (_,Resword "(",_)::(_,Ident s,_)::(_,Resword ")",_)::rst -> s,rst + | _ -> raise Noparse;; + +let unident' s = + if parses_as_binder s or can get_infix_status s or is_prefix s + then ["",Resword "(",""; "",Ident s,""; "",Resword ")",""] + else ["",Ident s,""];; + +let rec cut_to b n c l toks = + match toks with + | [] -> if b then [],[] else raise Noparse + | tok::rst -> + (match tok with + | _,Resword s,_ | _,Ident s,_ -> + let x = not (n > 0 & mem s mizar_skip_bracketed) in + if mem s c & x then [tok],rst else + if b & mem s l & x then [],toks else + let stp1,rst1 = + (match s with + | "(" | "[" -> cut_to true (n + 1) c l rst + | ")" | "]" -> cut_to true (if n > 0 then n - 1 else 0) c l rst + | _ -> cut_to true n c l rst) in + (tok::stp1),rst1);; + +let cut_step toks = + match toks with + | (_,Resword "proof",_ as tok)::rst -> [tok],rst + | (_,Resword "now",_)::rst -> + (a' "now" ++ + (many (a' "[" ++ cut_to false 0 ["]"] mizar_step_words >> + fun x,y -> x::y)) >> fun x,y -> x::(itlist (@) y [])) toks + | _ -> cut_to false 0 [";"] mizar_step_words toks;; + +let rec cut_steps toks = + let steps,rst = many cut_step toks in + if rst = [] then steps else steps@[rst];; + +let strings_of_toks toks = + let rec string_of_toks1 toks = + match toks with + | [] -> "","" + | [x,Ident y,z] | [x,Resword y,z] -> x^y,z + | (x,Ident y,z)::rst | (x,Resword y,z)::rst -> + let u,v = string_of_toks1 rst in x^y^z^u,v in + match toks with + | [] -> "","","" + | [x,Ident y,z] | [x,Resword y,z] -> x,y,z + | (x,Ident y,z)::rst | (x,Resword y,z)::rst -> + let u,v = string_of_toks1 rst in x,y^z^u,v;; + +let string_of_toks = middle o strings_of_toks;; + +let split_string = map string_of_toks o cut_steps o lex2;; + +let tok_of_toks toks = + let x,y,z = strings_of_toks toks in + x,Ident y,z;; + +let exec_phrase b s = + let lexbuf = Lexing.from_string s in + let ok = Toploop.execute_phrase b Format.std_formatter + (!Toploop.parse_toplevel_phrase lexbuf) in + Format.pp_print_flush Format.std_formatter (); + (ok, + let i = lexbuf.Lexing.lex_curr_pos in + String.sub lexbuf.Lexing.lex_buffer + i (lexbuf.Lexing.lex_buffer_len - i));; + +let exec_thm_out = ref TRUTH;; + +let exec_thm s = + try + let ok,rst = exec_phrase false + ("exec_thm_out := (("^s^") : thm);;") in + if not ok or rst <> "" then raise Noparse; + !exec_thm_out + with _ -> raise Noparse;; + +let exec_thmlist_tactic_out = ref REWRITE_TAC;; + +let exec_thmlist_tactic s = + try + let ok,rst = exec_phrase false + ("exec_thmlist_tactic_out := (("^s^") : thm list -> tactic);;") in + if not ok or rst <> "" then raise Noparse; + !exec_thmlist_tactic_out + with _ -> raise Noparse;; + +let exec_thmtactic_out = ref MATCH_MP_TAC;; + +let exec_thmtactic s = + try + let ok,rst = exec_phrase false + ("exec_thmtactic_out := (("^s^") : thm -> tactic);;") in + if not ok or rst <> "" then raise Noparse; + !exec_thmtactic_out + with _ -> raise Noparse;; + +let exec_tactic_out = ref ALL_TAC;; + +let exec_tactic s = + try + let ok,rst = exec_phrase false + ("exec_tactic_out := (("^s^") : tactic);;") in + if not ok or rst <> "" then raise Noparse; + !exec_tactic_out + with _ -> raise Noparse;; + +let exec_conv_out = ref NUM_REDUCE_CONV;; + +let exec_conv s = + try + let ok,rst = exec_phrase false + ("exec_conv_out := (("^s^") : conv);;") in + if not ok or rst <> "" then raise Noparse; + !exec_conv_out + with _ -> raise Noparse;; + +let (MP_ALL : tactic -> thm list -> tactic) = + fun tac ths -> + MAP_EVERY MP_TAC ths THEN tac;; + +let use_thms tac = + fun ths -> tac ORELSE MP_ALL tac ths;; + +let by_item_cache = ref undefined;; + +let rec by_item_of_toks toks = + match toks with + | [_,Ident "#",_] -> Hole + | (_,Ident "#",_)::toks' -> + (match by_item_of_toks toks' with + | Tactic(s,tac) -> Grow(s,tac) + | _ -> failwith "by_item_of_toks") + | [_,Ident "*",_] -> Label "*" + | _ -> + let s = string_of_toks toks in + try apply (!by_item_cache) s with _ -> + let i = + try Thm (s, exec_thm s) with _ -> + try Tactic (s, exec_thmlist_tactic s) with _ -> + try Tactic (s, (exec_thmtactic s) o hd) with _ -> + try Tactic (s, use_thms (exec_tactic s)) with _ -> + try Tactic (s, use_thms (CONV_TAC (exec_conv s))) with _ -> + match toks with + | [_,Ident s,_] -> Label s + | _ -> failwith "by_item_of_toks" in + by_item_cache := (s |-> i) !by_item_cache; + i;; + +let parse_by = + let parse_by_item toks = + match toks with + | (_,Ident "#",_ as tok1)::(_,Ident s,_ as tok2)::toks when s <> "," -> + [tok1;tok2],toks + | (_,Ident _,_ as tok)::toks -> [tok],toks + | _ -> raise Noparse in + let parse_by_part = + ((a' "by" ++ many (parse_by_item ++ a' "," >> fst) >> snd) ++ + parse_by_item) >> + (fun (x,y) -> x@[y]) + || (nothing >> K []) + and parse_from_part = + ((a' "from" ++ many (parse_by_item ++ a' "," >> fst) >> snd) ++ + parse_by_item) >> + (fun (x,y) -> (x@[y]),true) + || (nothing >> K ([],false)) in + let rec will_grow l = + match l with + | [] -> false + | Tactic _::_ -> false + | Grow _::_ -> true + | _::l' -> will_grow l' + in + ((parse_by_part ++ parse_from_part) ++ a_semi ++ finished >> + fun (((x,(y,z)),_),_) -> + let x' = map by_item_of_toks x in + let y' = map by_item_of_toks y in + By(x',y',z or will_grow (x'@y'))) + || (finished >> K (Proof_expected true));; + +let rec parse_labels toks = + match toks with + | [] -> [] + | (_,Resword "[",_)::(_,Ident s,_)::(_,Resword "]",_)::rst -> + s::(parse_labels rst) + | _ -> raise Noparse;; + +let rec type_of_pretype1 ty = + match ty with + Stv n -> failwith "type_of_pretype1" + | Utv(v) -> mk_vartype(v) + | Ptycon(con,args) -> mk_type(con,map type_of_pretype1 args);; + +let term_of_preterm1 = + let rec term_of_preterm1 ptm = + match ptm with + Varp(s,pty) -> mk_var(s,type_of_pretype1 pty) + | Constp(s,pty) -> mk_mconst(s,type_of_pretype1 pty) + | Combp(l,r) -> mk_comb(term_of_preterm1 l,term_of_preterm1 r) + | Absp(v,bod) -> mk_gabs(term_of_preterm1 v,term_of_preterm1 bod) + | Typing(ptm,pty) -> term_of_preterm1 ptm in + fun ptm -> term_of_preterm1 ptm;; + +let term_of_hol b = + let error = mk_var("error",`:error`) in + let term_of_hol1 env toks = + let env' = ("thesis",Ptycon("bool",[])):: + (map ((fun (s,ty) -> s,pretype_of_type ty) o dest_var) env) in + try + let ptm,l = (parse_preterm o map middle) toks in + if l <> [] then (8,error) else + try + let tm = (term_of_preterm1 o retypecheck env') ptm in + if not (subset + (filter + (fun v -> not (mem (fst (dest_var v)) ["..."; "thesis"])) + (frees tm)) env) + then (7,error) else + if b && type_of tm <> bool_ty then (8,error) else + (0,tm) + with _ -> + let tiw = !type_invention_warning in + type_invention_warning := false; + let tm = + try (term_of_preterm o retypecheck env') ptm + with e -> type_invention_warning := tiw; raise e in + type_invention_warning := tiw; + if not (subset (frees tm) env) then (7,error) else (6,error) + with _ -> (8,error) in + fun env toks -> + match toks with + | (x,Ident ".=",y)::rest -> + term_of_hol1 env ((x,Ident "..."," ")::("",Ident "=",y)::rest) + | _ -> term_of_hol1 env toks;; + +let type_of_hol = + let error = `:error` in + fun toks -> + try (0,(parse_type o middle o strings_of_toks) toks) + with _ -> (8,error);; + +let split_step toks = + let cut_semi toks = + match toks with + | (_,Resword ";",_ as tok)::rst -> rev rst,[tok] + | _ -> rev toks,[] in + let rec cut_by_part rev_front toks = + match toks with + | [] | (_,Resword "by",_)::_ | (_,Resword "from",_)::_ -> rev_front,toks + | tok::rst -> cut_by_part (tok::rev_front) rst in + let rec group_by_items toks = + match toks with + | [] -> [] + | (_,Resword "by",_ as tok)::rst + | (_,Resword "from",_ as tok)::rst + | (_,Ident ",",_ as tok)::rst + | (_,Resword ";",_ as tok)::rst -> tok::group_by_items rst + | (_,Ident "#",_ as tok)::toks' -> + let toks1,toks2 = + if toks' = [] then [],[] + else cut_to false 0 [] ([","; ";"]@mizar_words) toks' in + tok::(if toks1 = [] then [] else [tok_of_toks toks1])@ + group_by_items toks2 + | tok::rst -> + let toks1,toks2 = cut_to false 0 [] ([","; ";"]@mizar_words) toks in + if toks1 = [] then tok::group_by_items rst else + (tok_of_toks toks1)::group_by_items toks2 in + let rec cut_labs toks labs = + match toks with + | (_,Resword "]",_ as tok1)::(_,Ident _,_ as tok2):: + (_,Resword "[",_ as tok3)::rst -> + cut_labs rst (tok3::tok2::tok1::labs) + | _ -> toks,labs in + let rec cut_front toks tail = + match toks with + | [] -> [],tail + | (_,Resword s,_)::rst when mem s mizar_words -> rev toks,tail + | tok::rst -> cut_front rst (tok::tail) in + let toks1,semi_part = cut_semi (rev toks) in + let toks2,by_part = cut_by_part [] toks1 in + let toks3,labs_part = cut_labs toks2 [] in + let front_part,hol_part = cut_front toks3 [] in + if front_part <> [] & middle (hd front_part) = Resword "exec" then + let ml_tok = tok_of_toks ((tl front_part)@hol_part@labs_part@by_part) in + [[hd front_part]; [ml_tok]; []; []; semi_part] + else + [front_part; hol_part; labs_part; group_by_items by_part; semi_part];; + +let parse_step env toks = + let src = split_step toks in + try + match src with + | [front_part; hol_part; labs_part; by_part; semi_part] -> + let labs = parse_labels labs_part in + let just,_ = parse_by (by_part@semi_part) in + (match front_part with + | [] -> + (match toks with + | [_,Resword ";",_] -> + -1,src,Empty_step + | _ -> + let n,t = term_of_hol true env hol_part in + if n <> 0 then n,src,Error(string_of_toks toks,just) else + -1,src,Have(t,labs,just)) + | (_,Resword key,_)::_ -> + (match key,(tl front_part),(string_of_toks semi_part) with + | "now",[],"" -> + if hol_part <> [] or by_part <> [] then raise Noparse else + -1,src,Now(labs,Proof_expected false) + | "let",rst,";" -> + if labs_part <> [] or by_part <> [] then raise Noparse else + let x = (fst o fst o fst o + many ident' ++ a' "be" ++ finished) rst in + let n,t = type_of_hol hol_part in + if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else + -1,src,Let(map (fun s -> mk_var(s,t)) x) + | "assume",[],";" -> + if by_part <> [] then raise Noparse else + let n,t = term_of_hol true env hol_part in + if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else + -1,src,Assume(t,labs) + | "thus",[],_ -> + let n,t = term_of_hol true env hol_part in + if n <> 0 then n,src,Error(string_of_toks toks,just) else + -1,src,Thus(t,labs,just) + | "qed",[],_ -> + if hol_part <> [] or labs_part <> [] then raise Noparse else + -1,src,Qed just + | "proof",[],"" -> + if hol_part <> [] or labs_part <> [] or by_part <> [] then + raise Noparse else + -1,src,Bracket_proof + | "end",[],";" -> + if hol_part <> [] or labs_part <> [] or by_part <> [] then + raise Noparse else + -1,src,Bracket_end + | "take",[],";" -> + if labs_part <> [] or by_part <> [] then raise Noparse else + let n,t = term_of_hol false env hol_part in + if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else + -1,src,Take t + | "consider",rst,_ -> + let cut_suchthat toks = + match toks with + | (_,Resword "that",_)::(_,Resword "such",_)::rst -> rst + | _ -> raise Not_found in + let rec cut_being toks tail = + match toks with + | [] -> raise Not_found + | (_,Resword "being",_)::rst -> (rev rst),(rev tail) + | tok::rst -> cut_being rst (tok::tail) in + (try + let rst1,rst2 = cut_being (cut_suchthat (rev rst)) [] in + let n,t = type_of_hol rst2 in + if n <> 0 then n,src,Error(string_of_toks toks,just) else + let x = (fst o fst o many ident' ++ finished) rst1 in + let vars = map (fun s -> mk_var(s,t)) x in + let n,tm' = term_of_hol true (vars@env) hol_part in + if n <> 0 then n,src,Error(string_of_toks toks,just) else + -1,src,Consider(vars,tm',labs,just) + with Not_found -> + let x = (fst o fst o fst o fst o + many ident' ++ a' "such" ++ a' "that" ++ finished) rst in + let xy = (("",Ident "?","")::((flat (map unident' x))@ + (("",Resword ".","")::hol_part))) in + let n,tm = term_of_hol true env xy in + if n <> 0 then n,src,Error(string_of_toks toks,just) else + let vars,tm' = nsplit dest_exists x tm in + -1,src,Consider(vars,tm',labs,just)) + | "set",[],";" -> + if by_part <> [] then raise Noparse else + let (w,_),rst = (ident' ++ a' "=") hol_part in + let n,t = term_of_hol false env rst in + if n <> 0 then n,src,Error(string_of_toks toks,No_steps) else + -1,src,Set(mk_eq(mk_var(w,type_of t),t),labs) + | "cases",[],_ -> + if hol_part <> [] or labs_part <> [] then raise Noparse else + -1,src,Cases(just,[]) + | "case",[],";" -> + if hol_part <> [] or labs_part <> [] or by_part <> [] then + raise Noparse else + -1,src,Bracket_case + | "suppose",[],";" -> + if by_part <> [] then raise Noparse else + let n,t = term_of_hol true env hol_part in + if n <> 0 then + n,src,Error(string_of_toks toks,Proof_expected false) else + -1,src,Suppose(t,labs) + | "exec",[],";" -> + let s = string_of_toks hol_part in + -1,src,Exec(s,exec_tactic s) + | _ -> raise Noparse) + | _ -> raise Noparse) + | _ -> raise Noparse + with + | Failure "by_item_of_toks" -> 5,src,Error(string_of_toks toks,No_steps) + | _ -> 9,src,Error(string_of_toks toks,No_steps);; + +let rec steps_of_toks1 q e env toks = + let prefix x (y,w,z) = (x@y),w,z in + if toks = [] then + if e then [9,[],Error_point],None,[] else [],None,[] + else + let stoks,rst = cut_step toks in + let (status,src,substep as step) = parse_step env stoks in + match substep with + | Have (tm, labs, Proof_expected _) -> + let just,rst1 = just_of_toks env rst in + let step,rst2 = + (match just with + | Proof(_, _, _) -> (status,src,Have (tm, labs, just)),rst1 + | _ -> (9,src,Error(string_of_toks stoks, No_steps)),rst) in + prefix [step] (steps_of_toks1 q e env rst2) + | Thus (tm, labs, Proof_expected _) -> + let just,rst1 = just_of_toks env rst in + let step,rst2 = + (match just with + | Proof(_, _, _) -> (status,src,Thus (tm, labs, just)),rst1 + | _ -> (9,src,Error(string_of_toks stoks, No_steps)),rst) in + prefix [step] (steps_of_toks1 q e env rst2) + | Let vars -> prefix [step] (steps_of_toks1 q e ((rev vars)@env) rst) + | Now (labs, Proof_expected _) -> + let just,rst1 = now_of_toks env rst in + prefix [status,src,Now (labs, just)] (steps_of_toks1 q e env rst1) + | Consider (vars, _, _, By _) -> + prefix [step] (steps_of_toks1 q e ((rev vars)@env) rst) + | Consider (vars, tm, labs, Proof_expected _) -> + let just,rst1 = just_of_toks env rst in + let step,rst2 = + (match just with + | Proof(_, _, _) -> (status,src,Consider(vars, tm, labs, just)),rst1 + | _ -> (9,src,Error(string_of_toks stoks, No_steps)),rst) in + prefix [step] (steps_of_toks1 q e ((rev vars)@env) rst2) + | Set (tm, _) -> + prefix [step] (steps_of_toks1 q e ((fst (dest_eq tm))::env) rst) + | Cases ((By _ as just), []) -> + (try + let justs,rst1 = many (case_of_toks env q) rst in + let final,step1,rst2 = steps_of_toks1 false e env rst1 in + let cases = status,src,Cases(just, justs) in + if final <> [] then + prefix [cases; 9,[],Error_point] + (steps_of_toks1 q e env rst1) + else [cases],step1,rst2 + with Noparse -> + prefix [9,src,Error(string_of_toks stoks, No_steps)] + (steps_of_toks1 q e env rst)) + | Qed just -> + if q then [step],None,rst else + prefix [(if e then 3 else 9),src,Error(string_of_toks stoks, No_steps)] + (steps_of_toks1 q e env rst) + | Bracket_end -> + if e then [],Some step,rst else + prefix [9,src,Error(string_of_toks stoks, No_steps)] + (steps_of_toks1 q e env rst) + | Bracket_proof | Cases (_, _) | Bracket_case | Suppose (_, _) -> + prefix [9,src,Error(string_of_toks stoks, No_steps)] + (steps_of_toks1 q e env rst) + | Error (s, Proof_expected true) -> + let just,rst1 = just_of_toks env rst in + (match just with + | Proof(_, _, _) -> + prefix [status,src,Error(s, just)] (steps_of_toks1 q e env rst1) + | _ -> + prefix [status,src,Error(string_of_toks stoks, No_steps)] + (steps_of_toks1 q e env rst)) + | Error (s, Proof_expected false) -> + let steps,step1,rst1 = steps_of_toks1 true true env rst in + prefix [status,src,Error(s, Proof(None,steps,step1))] + (steps_of_toks1 q e env rst) + | Error (_, By _) -> + prefix [status,src,Error(string_of_toks stoks, No_steps)] + (steps_of_toks1 q e env rst) + | _ -> prefix [step] (steps_of_toks1 q e env rst) + +and just_of_toks env toks = + try + let stoks,rst = cut_step toks in + let (_,_,substep as step) = parse_step env stoks in + if substep = Bracket_proof then + let steps,step1,rst1 = steps_of_toks1 true true env rst in + (Proof(Some step,steps,step1)),rst1 + else (No_steps),toks + with Noparse -> (No_steps),toks + +and now_of_toks env toks = + let steps,step1,rst = steps_of_toks1 false true env toks in + (Proof(None,steps,step1)),rst + +and case_of_toks env q toks = + let stoks,rst = cut_step toks in + let (_,_,substep as step) = parse_step env stoks in + match substep with + | Bracket_case -> + let steps,step1,rst1 = steps_of_toks1 q true env rst in + (Proof(Some step,steps,step1)),rst1 + | Suppose (_, _) -> + let steps,step1,rst1 = steps_of_toks1 q true env rst in + (Proof(None,step::steps,step1)),rst1 + | _ -> raise Noparse;; + +let steps_of_toks toks = + let proof,_,rst = steps_of_toks1 false false [] toks in + if rst = [] then proof else + proof@[9,[rst],Error (string_of_toks rst, No_steps)];; + +let fix_semi toks = + if toks = [] then toks else + match last toks with + | _,Resword ";",_ -> toks + | _ -> toks@["\n",Resword ";",""];; + +let parse_proof = steps_of_toks o fix_semi o lex2;; + +exception Timeout;; + +Sys.set_signal Sys.sigalrm (Sys.Signal_handle (fun _ -> raise Timeout));; + +let TIMED_TAC n tac g = + let _ = Unix.alarm n in + try + let gs = tac g in + let _ = Unix.alarm 0 in + gs + with x -> + let _ = Unix.alarm 0 in + raise x;; + +let FAKE_TAC : bool -> thm list -> tactic = + fun fake thl (asl,w as g) -> + if fake then + let tm' = itlist (curry mk_imp) (map concl thl) w in + let vl = frees tm' in + let tm = itlist (curry mk_forall) vl tm' in + let th = itlist (C MP) (rev thl) (itlist SPEC (rev vl) (ASSUME tm)) in + null_meta,[],(fun i _ -> INSTANTIATE_ALL i th) + else NO_TAC g;; + +let MIZAR_NEXT : (goal -> step * goalstate) -> (goal -> step * goalstate) = + let t = `T` in + fun tac (asl,_ as g) -> + let e,((mvs,insts),gls,just as gs) = tac g in + match gls with + | [] -> e,((mvs,insts),[asl,t],(fun _ _ -> just null_inst [])) + | [gl] -> e,gs + | _ -> failwith "MIZAR_NEXT";; + +let MIZAR_NEXT' : tactic -> tactic = + let t = `T` in + fun tac (asl,_ as g) -> + let ((mvs,insts),gls,just as gs) = tac g in + match gls with + | [] -> + ((mvs,insts),[asl,t],(fun _ _ -> just null_inst [])) + | [gl] -> gs + | _ -> failwith "MIZAR_NEXT'";; + +let fix_dots prevs tm = + try + let lhs,_ = dest_eq (hd prevs) in + vsubst [lhs, mk_var("...",type_of lhs)] tm + with _ -> tm;; + +let fix_dots' asl tm = + try + let th = snd (hd asl) in + let lhs,_ = dest_eq (concl th) in + let dots = mk_var("...",type_of lhs) in + let rec fix_dots1 tm = + (match tm with + | Var _ when tm = dots -> th + | Comb(t1,t2) -> MK_COMB(fix_dots1 t1,fix_dots1 t2) + | Abs(x,t) -> ABS x (fix_dots1 t) + | _ -> REFL tm) in + if vfree_in dots tm then fix_dots1 tm else REFL tm + with _ -> REFL tm;; + +let rec terms_of_step prevs (_,_,substep) = + match substep with + | Have (tm, _, _) -> [fix_dots prevs tm] + | Now (_, just) -> [term_of_now just] + | Assume (tm, _) -> [fix_dots prevs tm] + | Thus (tm, _, _) -> [fix_dots prevs tm] + | Consider (_, tm, _, _) -> [fix_dots prevs tm] + | Set (tm, _) -> [fix_dots prevs tm] + | Suppose (tm, _) -> [fix_dots prevs tm] + | _ -> [] + +and term_of_now = + let t = `T` in + let rec term_of_steps prevs steps = + match steps with + | [] -> t + | (_,_,substep as step)::rst -> + let tm' = term_of_steps ((terms_of_step prevs step)@prevs) rst in + (match substep with + | Let vars -> list_mk_forall(vars,tm') + | Assume (tm, _) -> mk_imp(fix_dots prevs tm,tm') + | Thus (tm, _, _) -> mk_conj(fix_dots prevs tm,tm') + | Take tm -> + let var = genvar (type_of tm) in mk_exists(var,subst [var,tm] tm') + | Consider (vars, _, _, _) -> + if intersect (frees tm') vars <> [] then failwith "term_of_now" + else tm' + | Cases (_, _) -> failwith "term_of_now" + | _ -> tm') in + fun just -> + match just with + | Proof(_, steps, _) -> + (rand o concl o PURE_REWRITE_CONV[AND_CLAUSES]) + (term_of_steps [] steps) + | _ -> failwith "term_of_now";; + +let terms_of_cases = + let f = `F` in + let rec terms_of_cases cases = + match cases with + | [] -> [],f + | case::rst -> + let l',tm' = terms_of_cases rst in + (match case with + | (_,_,Suppose (tm, _))::_ -> (()::l'),mk_disj(tm,tm') + | _ -> failwith "terms_of_cases") in + terms_of_cases o (map + (fun just -> + match just with + | Proof(_, case, _) -> case + | _ -> failwith "terms_of_cases"));; + +let print_to_string1 printer = + let sbuff = ref "" in + let output s m n = sbuff := (!sbuff)^(String.sub s m n) and flush() = () in + let fmt = make_formatter output flush in + ignore(pp_set_max_boxes fmt 100); + fun prefix' n i -> + let prefix = prefix'^(implode (replicate " " n)) in + let m = String.length prefix in + pp_set_margin fmt ((!proof_width) - m); + ignore(printer fmt i); + ignore(pp_print_flush fmt ()); + let s = !sbuff in sbuff := ""; + implode (map (fun x -> if x = "\n" then "\n"^prefix else x) (explode s));; + +let string_of_term1 = print_to_string1 pp_print_term;; +let string_of_type1 = print_to_string1 pp_print_type;; + +let string_of_substep prefix substep = + let string_of_vars tl = implode (map (fun v -> " "^fst (dest_var v)) tl) in + let string_of_labs l = implode (map (fun s -> " ["^s^"]") l) in + let rec string_of_by_items x l = + match l with + | [] -> "" + | i::l' -> x^(match i with + | Label s | Thm(s,_) | Tactic(s,_) | Grow(s,_) -> s + | Hole -> "#")^string_of_by_items "," l' in + let string_of_just just = + match just with + | By(l,l',_) -> + (if l = [] then "" else " by"^string_of_by_items " " l)^ + (if l' = [] then "" else " from"^string_of_by_items " " l')^";" + | _ -> "" in + prefix^ + (match substep with + | Have(tm,l,just) -> + string_of_term1 prefix + (if !indent_continued then String.length !proof_indent else 0) tm^ + string_of_labs l^string_of_just just + | Now(l,just) -> "now"^string_of_labs l + | Let(tl) -> + let s = "let"^string_of_vars tl^" be " in + s^string_of_type1 prefix (String.length s) (type_of (hd tl))^";" + | Assume(tm,l) -> + let s = "assume " in + s^string_of_term1 prefix (String.length s) tm^string_of_labs l^";" + | Thus(tm,l,just) -> + let s = "thus " in + s^string_of_term1 prefix (String.length s) tm^string_of_labs l^ + string_of_just just + | Qed(just) -> "qed"^string_of_just just + | Bracket_proof -> "proof" + | Bracket_end -> "end;" + | Take(tm) -> + let s = "take " in + s^string_of_term1 prefix (String.length s) tm^";" + | Consider(tl,tm,l,just) -> + let s = "consider"^string_of_vars tl^" such that " in + s^string_of_term1 prefix (String.length s) tm^ + string_of_labs l^string_of_just just + | Set(tm,l) -> + let s = "set " in + s^string_of_term1 prefix (String.length s) tm^string_of_labs l^";" + | Cases(just,_) -> "cases"^string_of_just just + | Bracket_case -> "case;" + | Suppose(tm,l) -> + let s = "suppose " in + s^string_of_term1 prefix (String.length s) tm^string_of_labs l^";" + | Exec(s,_) -> "exec "^s^";" + | Error(s,_) -> s + | Empty_step -> "" + | Error_point -> "")^ + "\n";; + +let step_of_substep prefix substep = + (-1,split_step (lex2 (string_of_substep prefix substep)),substep :step);; + +let step_of_obligation prefix lab tl ass tm = + let hole = By([Hole],[],false) in + let prefix' = prefix^ !proof_indent in + let rec lets l = + match l with + | [] -> [] + | t::_ -> let l',l'' = partition ((=) (type_of t) o type_of) l in + step_of_substep prefix' (Let l')::lets l'' in + step_of_substep prefix + (if tl = [] & ass = [] then Have(tm,[lab],hole) else + let ll = lets tl in + let intros = ll@(map (fun a -> + step_of_substep prefix' (Assume(a,[]))) ass) in + if !grow_haves then + Have(list_mk_forall(flat + (map (function (_,_,Let l) -> l | _ -> []) ll), + itlist (curry mk_imp) ass tm), [lab], + Proof (Some (step_of_substep prefix Bracket_proof), + intros@ + [step_of_substep prefix (Qed(hole))], None)) + else + Now([lab], Proof (None, + intros@ + [step_of_substep prefix' (Thus(tm,[],hole))], + Some (step_of_substep prefix Bracket_end))));; + +let steps_of_goals (asl,w :goal) (_,gl,_ :goalstate) prefix n = + let ass = map (concl o snd) asl in + let fv = union (flat (map frees ass)) (frees w) in + let rec extra_ass l l' = + if subset l ass then l' else extra_ass (tl l) ((hd l)::l') in + let rec steps_of_goals1 n gl = + match gl with + | [] -> [],[],n + | (asl',w')::gl' -> + let ass' = map (concl o snd) asl' in + let steps',labs',n' = steps_of_goals1 (n + 1) gl' in + let lab = string_of_int n in + ((step_of_obligation prefix lab + (subtract (union (flat (map frees ass')) (frees w')) fv) + (extra_ass ass' []) w')::steps'),lab::labs',n' in + steps_of_goals1 n gl;; + +let next_growth_label = ref 0;; + +let connect_step (step:step) labs = + let comma = "",Ident ",","" in + let from_key = " ",Resword "from"," " in + let rec ungrow_by src l = + match l with + | [] -> src,[] + | Grow(name,tac)::l' -> + (match src with + | tok1::(_,Ident "#",_)::tok2::src' -> + let src'',l'' = ungrow_by src' l' in + (tok1::tok2::src''),(Tactic(name,tac)::l') + | _ -> failwith "ungrow_by") + | x::l' -> let toks,src' = chop_list 2 src in + let src'',l'' = ungrow_by src' l' in + (toks@src''),(x::l'') in + let rec extra_from sep labs = + match labs with + | [] -> [] + | lab::labs' -> sep::("",Ident lab,"")::extra_from comma labs' in + let connect_just src4 just = + match just with + | By(l,l',b) -> + let src4',l'' = ungrow_by src4 l in + let src4'',l''' = ungrow_by src4' l' in + (src4''@if labs = [] then [] else + extra_from (if l' = [] then from_key else comma) labs), + By(l'',(l'''@map (fun s -> Label s) labs),b) + | _ -> src4,just in + match step with + | (e,[src1; src2; src3; src4; src5],substep) -> + (match substep with + | Have(x,y,just) -> + let src4',just' = connect_just src4 just in + (e,[src1; src2; src3; src4'; src5],Have(x,y,just')) + | Thus(x,y,just) -> + let src4',just' = connect_just src4 just in + (e,[src1; src2; src3; src4'; src5],Thus(x,y,just')) + | Qed just -> + let src4',just' = connect_just src4 just in + (e,[src1; src2; src3; src4'; src5],Qed just') + | Consider(x,y,z,just) -> + let src4',just' = connect_just src4 just in + (e,[src1; src2; src3; src4'; src5],Consider(x,y,z,just')) + | Cases(just,x) -> + let src4',just' = connect_just src4 just in + (e,[src1; src2; src3; src4'; src5],Cases(just',x)) + | _ -> failwith "connect_step" :step) + | _ -> failwith "connect_step";; + +let add_width n s = + let rec add_width1 n s = + match s with + | [] -> n + | "\t"::s' -> add_width1 ((n/8 + 1)*8) s' + | "\n"::s' -> add_width1 0 s' + | _::s' -> add_width1 (n + 1) s' in + add_width1 n (explode s);; + +let rewrap_step (e,src,substep as step:step) = + let rec rewrap_from x1 src4a src4b = + match src4b with + | [] -> rev src4a + | (x,y,z)::(x',(Resword "from" as y'),z')::rst -> + (rev src4a)@(x,y,"\n")::(x1,y',z')::rst + | tok::rst -> rewrap_from x1 (tok::src4a) rst in + match src with + | [src1; src2; src3; src4; src5] -> + if src4 = [] then step else + let src123 = src1@src2@src3 in + let x,y,z = strings_of_toks src123 in + let x',y',_ = strings_of_toks src4 in + if add_width 0 (x^y^z^x'^y') > !proof_width then + let a,b,_ = last src123 in + let src123' = (butlast src123)@[a,b,"\n"] in + let src1',src23' = chop_list (length src1) src123' in + let src2',src3' = chop_list (length src2) src23' in + let _,b',c' = hd src4 in + let x1 = x^ !proof_indent in + let src4' = (x1,b',c')::tl src4 in + let src4'' = + if add_width 0 (x1^y') > !proof_width then + rewrap_from x1 [] src4' else src4' in + (e,[src1'; src2'; src3'; src4''; src5],substep) + else (step:step) + | _ -> failwith "rewrap_step";; + +let rec pp_step prefix step = + let (e,_,substep) = step in + let (_,src,substep') = + rewrap_step (step_of_substep prefix substep) in + let substep'' = + (match substep' with + | Have(x,y,just) -> Have(x,y,pp_just prefix just) + | Now(x,just) -> Now(x,pp_just prefix just) + | Thus(x,y,just) -> Thus(x,y,pp_just prefix just) + | Qed(just) -> Qed(pp_just prefix just) + | Consider(x,y,z,just) -> Consider(x,y,z,pp_just prefix just) + | Cases(just,justl) -> + Cases(pp_just prefix just,map (pp_just prefix) justl) + | Error(x,just) -> Error(x,pp_just prefix just) + | _ -> substep') in + (e,src,substep'') +and pp_just prefix just = + let pp_step' step' = + match step' with + | Some step -> Some (pp_step prefix step) + | None -> None in + let prefix' = (!proof_indent)^prefix in + let pp_step'' step = + match step with + | (_,_,Qed _) -> pp_step prefix step + | (_,_,Suppose _) -> pp_step prefix step + | _ -> pp_step prefix' step in + match just with + | Proof(step',stepl,step'') -> + Proof(pp_step' step',map (pp_step'') stepl,pp_step' step'') + | _ -> just;; + +let outdent n step = + let (_,src,_) = step in + match flat src with + | (x,_,_)::_ -> + let x' = explode x in + if length x' < n then step else + let _,x'' = chop_list n x' in + pp_step (implode x'') step + | _ -> step;; + +let replacement_steps (asl,w) f step = + let n = String.length !proof_indent in + let indent_of (_,src,substep) = + let x,_,_ = hd (flat src) in + match substep with + | Qed _ -> x^ !proof_indent + | _ -> x in + let shift src2 src3 just = + match just with + | Proof _ -> + if src3 <> [] then + let (x,y,z) = last src3 in + src2,((butlast src3)@[x,y,"\n"]) + else if src2 <> [] then + let (x,y,z) = last src2 in + ((butlast src2)@[x,y,"\n"]),src3 + else src2,src3 + | _ -> src2,src3 in + let steps,labs,n = f (indent_of step) (!next_growth_label) in + next_growth_label := n; + if !grow_duplicates > 1 then + steps@[rewrap_step (connect_step step labs)] + else + match steps,step with + | [e,[src1'; src2'; src3'; src4'; src5'],Have(tm',_,just')], + (_,[src1; src2; src3; src4; src5],Have(tm,labs,_)) when tm' = tm -> + let src2'',src3'' = shift src2 src3 just' in + [e,[src1; src2''; src3''; src4'; src5'],Have(tm,labs,just')] + | [e,[src1'; src2'; src3'; src4'; src5'],Have(tm',_,just')], + (_,[src1; src2; src3; src4; src5],Thus(tm,labs,_)) when tm' = tm -> + let src2'',src3'' = shift src2 src3 just' in + [e,[src1; src2''; src3''; src4'; src5'],Thus(tm,labs,just')] + | [e,_,Have(tm',_,Proof(_,y,_))], + (_,_,Qed(_)) when tm' = w -> + map (outdent n) y + | [e,[src1'; src2'; src3'; src4'; src5'],Have(tm',_,(By _ as just'))], + (_,[src1; src2; src3; src4; src5],Qed(_)) when tm' = w -> + [e,[src1; src2; src3; src4'; src5'],Qed(just')] + | _ -> + if !grow_duplicates > 0 then + steps@[rewrap_step (connect_step step labs)] + else + let al = map (fun x,y -> concl y,x) asl in + let rec filter_growth steps labs steps' labs' = + match steps with + | [] -> (rev steps'),(rev labs') + | ((_,_,Have(tm,_,_)) as step')::rst -> + (try let lab' = assoc tm al in + if lab' <> "" then + filter_growth rst (tl labs) steps' (lab'::labs') + else + filter_growth rst (tl labs) (step'::steps') ((hd labs)::labs') + with _ -> + filter_growth rst (tl labs) (step'::steps') ((hd labs)::labs')) + | step'::rst -> + filter_growth rst (tl labs) (step'::steps') ((hd labs)::labs') in + let steps',labs' = filter_growth steps labs [] [] in + steps'@[rewrap_step (connect_step step labs')];; + +exception Grown of (string -> int -> step list * string list * int);; + +let (FILTER_ASSUMS : (int * (string * thm) -> bool) -> tactic) = + let rec filter' f n l = + match l with + | [] -> [] + | h::t -> + let t' = filter' f (n + 1) t in + if f (n,h) then h::t' else t' in + fun f (asl,w) -> + null_meta,[filter' f 0 asl,w],(fun i ths -> hd ths);; + +let (MAP_ASSUMS : (string * thm -> string * thm) -> tactic) = + let FIRST_ASSUM' ttac' (asl,w as g) = + tryfind (fun lth -> ttac' lth g) asl in + fun f -> + let rec recurse g = + (FIRST_ASSUM' (fun (l,th as lth) -> + UNDISCH_THEN (concl th) (fun th -> + recurse THEN uncurry LABEL_TAC (f lth))) ORELSE ALL_TAC) g in + recurse ORELSE FAIL_TAC "MAP_ASSUMS";; + +let (thenl': + tactic -> (goal -> 'a * goalstate) list -> goal -> 'a list * goalstate) = + let propagate_empty i _ = [] in + let propagate_thm th i _ = INSTANTIATE_ALL i th in + let compose_justs n just1 just2 i ths = + let ths1,ths2 = chop_list n ths in + (just1 i ths1)::(just2 i ths2) in + let rec seqapply l1 l2 = + match (l1,l2) with + | ([],[]) -> [],(null_meta,[],propagate_empty) + | (tac::tacs),(goal::goals) -> + let a,((mvs1,insts1),gls1,just1) = tac goal in + let goals' = map (inst_goal insts1) goals in + let aa',((mvs2,insts2),gls2,just2) = seqapply tacs goals' in + (a::aa'),((union mvs1 mvs2,compose_insts insts1 insts2), + gls1@gls2,compose_justs (length gls1) just1 just2) + | _,_ -> failwith "seqapply: Length mismatch" in + let justsequence just1 just2 insts2 i ths = + just1 (compose_insts insts2 i) (just2 i ths) in + let tacsequence ((mvs1,insts1),gls1,just1) tacl = + let aa,((mvs2,insts2),gls2,just2) = seqapply tacl gls1 in + let jst = justsequence just1 just2 insts2 in + let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in + aa,((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in + fun tac1 tac2l g -> + let _,gls,_ as gstate = tac1 g in + if gls = [] then tacsequence gstate [] else tacsequence gstate tac2l;; + +let just_cache = ref undefined;; + +let tactic_of_by fake l l' b = + (fun (asl,_ as g) -> + let hor = if b then 0 else !horizon in + let rec find_tactic l = + match l with + | [] -> !default_prover,false + | (Tactic (name, tac))::l' -> (name,tac),false + | (Grow (name, tac))::l' -> (name,tac),true + | _::l' -> find_tactic l' in + let sets = BETA_THM::map snd (filter (fun x,_ -> x = "=") asl) in + let asl' = filter (fun x,_ -> x <> "=") asl in + let rec find_thms l b = + match l with + | [] -> + if b then [] else + map (PURE_REWRITE_RULE sets o snd) + (try fst (chop_list hor asl') with _ -> asl') + | (Thm (_, th))::l' -> th::(find_thms l' b) + | (Label "*")::l' -> + (map (PURE_REWRITE_RULE sets o snd) asl')@(find_thms l' b) + | (Label s)::l' -> + (PURE_REWRITE_RULE sets + (if s = "-" then snd (hd asl') else assoc s asl'))::(find_thms l' b) + | _::l' -> find_thms l' b in + let rec find_labs l = + match l with + | [] -> [] + | (Label s)::l' -> s::(find_labs l') + | _::l' -> find_labs l' in + try + let thms = find_thms l b in + let thms' = find_thms l' true in + let thms'' = thms@thms' in + let (name,tac),grow = find_tactic (l@l') in + if fake & (mem Hole l or mem Hole l') or not (!growth_mode) & grow then + -2,FAKE_TAC fake thms'' g else + let labs = find_labs l in + let full_asl = hor < 0 or mem "*" labs in + (try + 0,((FILTER_ASSUMS (fun _,(x,_) -> x <> "=") THEN + FILTER_ASSUMS + (fun n,(x,_) -> + mem x labs or n < hor or (n = 0 & mem "-" labs) or full_asl) THEN + MAP_ASSUMS (fun l,th -> l,PURE_REWRITE_RULE sets th) THEN + MIZAR_NEXT' (PURE_REWRITE_TAC sets) THEN + (fun (asl',w' as g') -> + let key = name,(map concl thms,map concl thms'),w' in + try + if grow then failwith "apply"; + let e,th = apply (!just_cache) key in + if e = 0 then (ACCEPT_TAC th THEN NO_TAC) g' else + if e = 2 then raise Timeout else failwith "cached by" + with + | Failure "apply" -> + try + let (_,_,just as gs) = + ((fun g'' -> + let gs' = TIMED_TAC (!timeout) (tac thms) g'' in + if grow then raise (Grown (steps_of_goals g gs')) + else gs') THEN + REPEAT (fun (asl'',_ as g'') -> + if subset asl'' asl' then NO_TAC g'' + else FIRST_ASSUM (UNDISCH_TAC o concl) g'') THEN + TRY (FIRST (map ACCEPT_TAC thms'')) THEN + REWRITE_TAC thms'' THEN NO_TAC) g' in + let th = just null_inst [] in + just_cache := (key |-> (0,th)) !just_cache; + gs + with + | Grown _ as x -> raise x + | x -> if name <> "GOAL_TAC" then just_cache := + (key |-> ((if x = Timeout then 2 else 1),TRUTH)) + !just_cache; + raise x + )) g) + with + | Grown _ as x -> raise x + | x -> (if x = Timeout then 2 else 1),(FAKE_TAC fake thms'' g)) + with Failure "find" | Failure "hd" -> 4,(FAKE_TAC fake [] g) + : goal -> int * goalstate);; + +let LABELS_TAC ls th = + if ls = [] then ASSUME_TAC th else + EVERY (map (fun l -> LABEL_TAC l th) ls);; + +let PURE_EXACTLY_ONCE_REWRITE_TAC = + let ONCE_COMB_QCONV conv tm = + let l,r = dest_comb tm in + try let th1 = conv l in AP_THM th1 r + with Failure _ -> AP_TERM l (conv r) in + let ONCE_SUB_QCONV conv tm = + if is_abs tm then ABS_CONV conv tm + else ONCE_COMB_QCONV conv tm in + let rec EXACTLY_ONCE_DEPTH_QCONV conv tm = + (conv ORELSEC (ONCE_SUB_QCONV (EXACTLY_ONCE_DEPTH_QCONV conv))) tm in + let PURE_EXACTLY_ONCE_REWRITE_CONV thl = + GENERAL_REWRITE_CONV false EXACTLY_ONCE_DEPTH_QCONV empty_net thl in + fun thl -> + CONV_TAC(PURE_EXACTLY_ONCE_REWRITE_CONV thl);; + +let EQTF_INTRO = + let lemma = TAUT `(~t <=> T) <=> (t <=> F)` in + fun th -> + PURE_ONCE_REWRITE_RULE[lemma] (EQT_INTRO th);; + +let REWRITE_THESIS_TAC = + let PROP_REWRITE_TAC = + PURE_REWRITE_TAC[AND_CLAUSES; IMP_CLAUSES; NOT_CLAUSES; OR_CLAUSES; + prop_2; TAUT `!t. (t <=> t) <=> T`] in + fun th -> + PURE_EXACTLY_ONCE_REWRITE_TAC[EQTF_INTRO th] THEN PROP_REWRITE_TAC;; + +let thesis_var = `thesis:bool`;; + +let rec tactic_of_step fake step (asl,w as g) = + let justify tac just g = + let (mvs,inst),gls,jst = tac g in + (match gls with + | [g1; g2] -> + let (e,just'),((mvs',inst'),gls',jst') = + tactic_of_just fake just g1 in + let mvs'' = union mvs' mvs in + let inst'' = compose_insts inst' inst in + let gls'' = gls'@[g2] in + let jst'' i ths = + jst (compose_insts inst'' i) [jst' i (butlast ths); last ths] in + (e,just'),((mvs'',inst''),gls'',jst'') + | _ -> failwith "justify") in + let SUBGOAL_THEN' tm tac = + let th = fix_dots' asl tm in + let lhs,_ = dest_eq (concl th) in + SUBGOAL_THEN lhs tac THENL [MIZAR_NEXT' (CONV_TAC (K th)); ALL_TAC] in + let fix_thesis tm = vsubst [w,thesis_var] tm in + let e,src,substep = step in + match substep with + | Let tl -> + (try (0,src,substep),(MAP_EVERY X_GEN_TAC tl g) + with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) + | Assume (tm, l) | Suppose (tm, l) -> + (try (0,src,substep),(DISJ_CASES_THEN2 + (fun th -> MIZAR_NEXT' (REWRITE_THESIS_TAC th) THEN + LABELS_TAC l th) + (fun th -> + let th' = PURE_REWRITE_RULE[NOT_CLAUSES; IMP_CLAUSES] th in + REWRITE_TAC[th'] THEN CONTR_TAC th' THEN NO_TAC) + (SPEC (fix_thesis tm) EXCLUDED_MIDDLE) g) + with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) + | Have (tm, l, just) -> + (try let (e,just'),gs = + justify (SUBGOAL_THEN' (fix_thesis tm) (LABELS_TAC l)) just g in + (e,src,Have(tm, l, just')),gs + with x -> raise x) + | Now (l, just) -> + (try let (e,just'),gs = + justify (SUBGOAL_THEN (term_of_now just) (LABELS_TAC l)) just g in + (e,src,Now(l, just')),gs + with x -> raise x) + | Thus (tm, l, just) -> + (try let (e,just'),gs = + justify (SUBGOAL_THEN' (fix_thesis tm) (LABELS_TAC l) THENL + [ALL_TAC; MIZAR_NEXT' + (FIRST_ASSUM (fun th -> + EVERY (map (fun th' -> REWRITE_THESIS_TAC th') + (CONJUNCTS th))))]) + just g in + (e,src,Thus(tm, l, just')),gs + with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) + | Qed just -> + (try let (e,just'),gs = tactic_of_just fake just g in + (e,src,substep),gs + with x -> raise x) + | Take tm -> + (try (0,src,substep),(EXISTS_TAC tm g) + with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) + | Consider (tl, tm, l, just) -> + let tm' = itlist (curry mk_exists) tl (fix_thesis tm) in + (try let (e,just'),gs = + justify (SUBGOAL_THEN tm' + ((EVERY_TCL (map X_CHOOSE_THEN tl)) (LABELS_TAC l))) just g in + (e,src,Consider(tl, tm, l, just')),gs + with x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) + | Set (tm, l) -> + (try + let v,_ = dest_eq tm in + let tm' = mk_exists(v,tm) in + let l' = if l = [] then ["="] else l in + (0,src,substep), + ((SUBGOAL_THEN tm' (X_CHOOSE_THEN v (LABELS_TAC l')) THENL + [REWRITE_TAC[EXISTS_REFL] ORELSE FAKE_TAC fake []; ALL_TAC]) g) + with x -> raise x) + | Cases (just, cases) -> + (try + let l,tm = terms_of_cases cases in + let steps,gs = + (thenl' (SUBGOAL_THEN tm + (EVERY_TCL + (map (K (DISJ_CASES_THEN2 + (fun th -> ASSUME_TAC th THEN + FIRST_ASSUM (UNDISCH_TAC o concl)))) l) CONTR_TAC)) + ((tactic_of_just fake just):: + (map (fun just -> tactic_of_just fake just) cases)) g) in + (match steps with + | (e,just')::ecases' -> (e,src,Cases(just',map snd ecases')),gs + | _ -> failwith "tactic_of_step") + with x -> raise x) + | Bracket_proof | Bracket_end | Bracket_case -> + (3,src,substep),(ALL_TAC g) + | Exec(_,tac) -> + (try (0,src,substep),(TIMED_TAC (!timeout) tac THENL [ALL_TAC]) g + with + | Timeout as x -> if fake then (2,src,substep),(ALL_TAC g) else raise x + | x -> if fake then (3,src,substep),(ALL_TAC g) else raise x) + | Error (_,_) | Error_point -> + if fake then (e,src,substep),(ALL_TAC g) else failwith "tactic_of_step" + | Empty_step -> + (0,src,substep),(ALL_TAC g) + +and tactic_of_just fake just g = + let bracket_step step e = + match step with + | None -> if e = 0 then None else Some (e, [], Error_point) + | Some (_, src, substep) -> Some (e, src, substep) in + let rec tactic_of_just1 l (_,w as g) = + match l with + | [] -> + if is_const w && fst (dest_const w) = "T" + then [],0,ACCEPT_TAC TRUTH g + else [],3,FAKE_TAC fake (map snd (fst g)) g + | step::l' -> + (try + let step',((mvs,inst),gls,just) = + MIZAR_NEXT (tactic_of_step fake step) g in + (match gls with + | [g'] -> + let l'',e,((mvs',inst'),gls',just') = tactic_of_just1 l' g' in + let mvs'' = union mvs' mvs in + let inst'' = compose_insts inst' inst in + let gls'' = gls' in + let just'' i ths = just (compose_insts inst'' i) [just' i ths] in + step'::l'',e,((mvs'',inst''),gls'',just'') + | _ -> failwith "tactic_of_just") + with Grown f -> + tactic_of_just1 (replacement_steps g f step@l') g) in + match just with + | By(l,l',b) -> let e,gs = tactic_of_by fake l l' b g in (e,just),gs + | Proof(step1, l, step2) -> + let l',e,gs = tactic_of_just1 l g in + (0,Proof(bracket_step step1 0, l', bracket_step step2 e)),gs + | _ -> failwith "tactic_of_just";; + +let parse_qproof s = steps_of_toks (fix_semi (tl (lex2 s)));; + +let rec src_of_step (e,src,substep) = + [e,strings_of_toks (flat src)]@ + match substep with + | Have(_, _, just) -> src_of_just just + | Now(_, just) -> src_of_just just + | Thus(_, _, just) -> src_of_just just + | Qed just -> src_of_just just + | Consider(_, _, _, just) -> src_of_just just + | Cases(just, cases) -> + (src_of_just just)@(itlist (@) (map src_of_just cases) []) + | Error(_, just) -> src_of_just just + | _ -> [] + +and src_of_just just = + let unpack step1 = + match step1 with + | Some step -> src_of_step step + | _ -> [] in + match just with + | Proof(step1, steps, step2) -> + (unpack step1)@(itlist (@) (map src_of_step steps) [])@(unpack step2) + | _ -> [];; + +let src_of_steps steps = itlist (@) (map src_of_step steps) [];; + +let count_errors src = + let rec count_errors1 src (n1,n2,n3) = + match src with + | [] -> n1,n2,n3 + | (e,_)::src' -> count_errors1 src' + (if e > 2 then (n1 + 1,n2,n3) else + if e > 0 then (n1,n2 + 1,n3) else + if e = -2 then (n1,n2,n3 + 1) else + (n1,n2,n3)) in + count_errors1 src (0,0,0);; + +let error_line l ee = + let rec error_line1 s1 s2 n l ee = + match l with + | [] -> (s1^"\n"),s2,ee + | (m,e)::l' -> + let d = m - n - 1 in + let d' = if d > 0 then d else 0 in + let s' = "#"^string_of_int e in + error_line1 (s1^(implode (replicate " " d'))^s') + (if !explain_errors > 0 then + if mem e ee then s2 else s2^":: "^(el (e - 1) ERRORS)^"\n" + else s2) + (add_width (n + d') s') l' (union ee [e]) in + let s1,s2,ee' = + error_line1 "::" "" 2 l (if !explain_errors > 1 then [] else ee) in + (s1^s2),ee';; + +let insert_errors n s l ee = + let rec insert_errors1 n s l ee = + match s with + | [] -> [],n,l,ee + | ("\n" as c)::s' -> + let s1,ee' = if l = [] then "",ee else error_line l ee in + let s2,n1,l1,ee' = insert_errors1 0 s' [] ee' in + (c::s1::s2),n1,l1,ee' + | c::s' -> + let s1,n1,l1,ee' = insert_errors1 (add_width n c) s' l ee in + (c::s1),n1,l1,ee' in + let s1,n1,l1,ee' = insert_errors1 n (explode s) l ee in + (implode s1),n1,l1,ee';; + +let string_of_src m steps = + let add_error l n e = + if e > (if !sketch_mode then 2 else 0) then l@[n,e] else l in + let rec string_of_src1 s n l s3' steps ee = + match steps with + | [] -> + let s',n',l',ee' = insert_errors n s3' l ee in + if l' = [] then s^s' else + let s'',_,_,_ = insert_errors n' "\n" l' ee' in + s^s'^s'' + | (e,(s1,"",s3))::steps' -> + string_of_src1 s n (add_error l n e) (s3'^s1^s3) steps' ee + | (e,(s1,s2,s3))::steps' -> + let s',n',l',ee' = insert_errors n (s3'^s1) l ee in + let n'' = add_width n' s2 in + string_of_src1 (s^s'^s2) n'' (add_error l' n'' e) s3 steps' ee' in + string_of_src1 "" m [] "" steps [];; + +let print_boxed f s = + let print_boxed_char c = + if c = "\n" + then Format.pp_print_cut f () + else Format.pp_print_string f c in + Format.pp_open_vbox f 0; + do_list print_boxed_char (explode s); + Format.pp_close_box f ();; + +let print_step f x = + print_boxed f (string_of_src 0 (src_of_step x));; + +let print_qsteps f x = + print_boxed f ("`;\n"^(string_of_src 0 (src_of_steps x))^"`");; + +#install_printer print_step;; +#install_printer print_qsteps;; + +let GOAL_TAC g = + current_goalstack := (mk_goalstate g)::!current_goalstack; + ALL_TAC g;; + +let GOAL_FROM x = fun y -> x y THEN GOAL_TAC;; + +let ee s = + let toks = lex2 s in + let l,t = top_goal() in + let env = itlist union (map frees l) (frees t) in + let proof,step1,rst = steps_of_toks1 true false env toks in + if rst <> [] or step1 <> None then failwith "ee" else + (e o EVERY o map (fun step -> snd o tactic_of_step false step)) proof;; + +let check_proof steps = + let step = + match steps with + | [_,_,Have (_, _, _) as step] -> step + | [_,_,Now (_, _) as step] -> step + | _ -> + -1,[],Now([], Proof(None,steps, + Some(-1,[],Bracket_end))) in + let step',gs = tactic_of_step true step ([],thesis_var) in + let steps' = + match step' with + | _,[],Now(_, Proof(_,steps',_)) -> steps' + | step' -> [step'] in + let _,gl,j = gs in + if length gl <> 1 then failwith "thm" else + let (asl,w) = hd gl in + if length asl <> 1 or w <> thesis_var then failwith "thm" else + let a = (concl o snd o hd) asl in + let src' = src_of_steps steps' in + steps',count_errors src',j ([],[a,thesis_var],[]) [ASSUME a];; + +exception Mizar_error of step list * (int * int * int);; + +let thm steps = + let steps',(n1,n2,n3 as n),th = check_proof steps in + if n1 + n2 + n3 = 0 then th else raise (Mizar_error(steps',n));; + +let thm_of_string = thm o parse_proof;; + +let rec labels_of_steps labels context steps = + match steps with + | [] -> labels + | (_,_,substep)::rst -> + (match substep with + | Assume(_,labs) | Suppose(_,labs) | Set(_,(_::_ as labs)) -> + let label = (labs,ref 0) in + labels_of_steps (label::labels) (label::context) rst + | Have(_,labs,just) | Thus(_,labs,just) | Consider(_,_,labs,just) + | Now(labs,just) -> + let label = (labs,ref 0) in + let labels1 = labels_of_just (label::labels) context just in + labels_of_steps labels1 (label::context) rst + | Qed(just) -> + let labels1 = labels_of_just labels context just in + labels_of_steps labels1 context rst + | Cases(just,justl) -> + itlist + (fun just' labels' -> labels_of_just labels' context just') + (rev justl) (labels_of_just labels context just) + | Error(_,_) -> raise Noparse + | _ -> labels_of_steps labels context rst) + +and labels_of_just labels context just = + let rec collect_strings l = + match l with + | [] -> [] + | Label(s)::l' -> s::collect_strings l' + | _::l' -> collect_strings l' in + match just with + | Proof(_,steps,_) -> labels_of_steps labels context steps + | By(x,y,_) -> + do_list (fun s -> + do_list (fun _,n -> n := !n + 1) (filter (mem s o fst) context)) + (subtract (collect_strings (x@y)) ["-"; "*"]); + labels + | _ -> labels;; + +let isnumber = forall isnum o explode;; + +let max_label labels = itlist max + (map int_of_string (filter isnumber (flat (map fst labels)))) (-1);; + +let rec number_labels n labels = + match labels with + | [] -> [] + | (oldlabs,count)::rst -> + let newlabs,n' = + (if !extra_labels > 1 or !count > 0 or + (!extra_labels > 0 & exists isnumber oldlabs) + then [string_of_int n],(n + 1) else [],n) in + (oldlabs,newlabs)::(number_labels n' rst);; + +let rec renumber_steps labels context steps = + let make_lab x1 y1 x2 y2 x3 y3 s = + ([x1,Resword "[",y1; x2,Ident s,y2; x3,Resword "]",y3],[s]) in + let rec renumber_labs b w src labs label = + match labs with + | [] -> + if b then (make_lab "" "" "" "" "" w (hd (snd label)))," " + else ([],[]),w + | lab::rst when isnumber lab -> + (match src with + | (x1,Resword "[",y1)::(x2,Ident s',y2)::(x3,Resword "]",y3)::rstsrc -> + let (src',labs'),w' = renumber_labs false y3 rstsrc rst label in + let newsrc,newlabs = + if b then make_lab x1 y1 x2 y2 x3 w' (hd (snd label)) + else [],[] in + ((newsrc@src'),(newlabs@labs')),if b then w else y3 + | _ -> failwith "renumber_labs") + | lab::rst -> + (match src with + | tok1::tok2::(x3,y3,z3)::rstsrc -> + let (src',labs'),w' = renumber_labs b z3 rstsrc rst label in + ((tok1::tok2::(x3,y3,w')::src'),(lab::labs')),w + | _ -> failwith "renumber_labs") in + let renumber_labs1 b src1 src labs label = + let (x,y,w) = last src1 in + let (src',labs'),w' = renumber_labs b w src labs label in + let src1' = if w' <> w then (butlast src1)@[x,y,w'] else src1 in + src1',src',labs' in + match steps with + | [] -> labels,[] + | (e,src,substep)::rst -> + (match src with + | [src1; src2; src3; src4; src5] -> + (match substep with + | Assume(x,labs) -> + let label = hd labels in + let src2',src3',labs' = + renumber_labs1 (snd label <> []) src2 src3 labs label in + let labels',rst' = + renumber_steps (tl labels) (label::context) rst in + labels', + (e,[src1; src2'; src3'; src4; src5],Assume(x,labs'))::rst' + | Suppose(x,labs) -> + let label = hd labels in + let src2',src3',labs' = + renumber_labs1 (snd label <> []) src2 src3 labs label in + let labels',rst' = + renumber_steps (tl labels) (label::context) rst in + labels', + (e,[src1; src2'; src3'; src4; src5],Suppose(x,labs'))::rst' + | Set(x,(_::_ as labs)) -> + let label = hd labels in + let src2',src3',labs' = + renumber_labs1 (snd label <> []) src2 src3 labs label in + let labels',rst' = + renumber_steps (tl labels) (label::context) rst in + labels', + (e,[src1; src2'; src3'; src4; src5],Set(x,labs'))::rst' + | Have(x,labs,just) -> + let label = hd labels in + let src2',src3',labs' = + renumber_labs1 (snd label <> []) src2 src3 labs label in + let labels',src4',just' = + renumber_just (tl labels) context src4 just in + let labels'',rst' = + renumber_steps labels' (label::context) rst in + labels'', + ((e,[src1; src2'; src3'; src4'; src5],Have(x,labs',just')):: + rst') + | Thus(x,labs,just) -> + let label = hd labels in + let src2',src3',labs' = + renumber_labs1 (snd label <> []) src2 src3 labs label in + let labels',src4',just' = + renumber_just (tl labels) context src4 just in + let labels'',rst' = + renumber_steps labels' (label::context) rst in + labels'', + ((e,[src1; src2'; src3'; src4'; src5],Thus(x,labs',just')):: + rst') + | Qed(just) -> + let labels',src4',just' = + renumber_just labels context src4 just in + let labels'',rst' = + renumber_steps labels' context rst in + labels'', + ((e,[src1; src2; src3; src4'; src5],Qed(just')):: + rst') + | Consider(x,y,labs,just) -> + let label = hd labels in + let src2',src3',labs' = + renumber_labs1 (snd label <> []) src2 src3 labs label in + let labels',src4',just' = + renumber_just (tl labels) context src4 just in + let labels'',rst' = + renumber_steps labels' (label::context) rst in + labels'', + ((e,[src1; src2'; src3'; src4'; src5], + Consider(x,y,labs',just')):: + rst') + | Now(labs,just) -> + let label = hd labels in + let src1',src3',labs' = + renumber_labs1 (snd label <> []) src1 src3 labs label in + let labels',src4',just' = + renumber_just (tl labels) context src4 just in + let labels'',rst' = + renumber_steps labels' (label::context) rst in + labels'', + ((e,[src1'; src2; src3'; src4'; src5],Now(labs',just')):: + rst') + | Cases(just,justl) -> + let labels',src4',just' = + renumber_just labels context src4 just in + let labels'',justl'' = + itlist + (fun just' (labels',justl') -> + let labels'',_,just'' = + renumber_just labels' context [] just' in + labels'',(just''::justl')) + (rev justl) (labels',[]) in + let labels''',rst' = + renumber_steps labels'' context rst in + labels''', + ((e,[src1; src2; src3; src4'; src5],Cases(just',rev justl'')):: + rst') + | Error(_,_) -> raise Noparse + | _ -> + let labels',rst' = renumber_steps labels context rst in + labels',((e,src,substep)::rst')) + | _ -> failwith "renumber_steps") + +and renumber_just labels context src just = + let rec renumber_by src l = + match l with + | [] -> [],src,[] + | (Label s as x)::l' when isnumber s -> + (match src with + | tok::(x1,Ident _,x2 as tok')::src23 -> + let labs = flat (map snd (filter (mem s o fst) context)) in + let src2,src3,l'' = renumber_by src23 l' in + if labs = [] then (tok::tok'::src2),src3,(x::l'') else + let items = map (fun s -> Label s) labs in + let labs' = tl labs in + let src1 = flat (map + (fun s -> ["",Ident ",",""; "",Ident s,x2]) labs') in + (tok::(x1,Ident (hd labs), + if labs' = [] then x2 else "")::src1@src2),src3,(items@l'') + | _ -> failwith "renumber_by") + | x::l' -> + let src1,src23 = + (match src with + | tok::(_,Ident "#",_ as tok1)::(_,Ident s,_ as tok2)::src23 + when s <> "," -> [tok;tok1;tok2],src23 + | tok::(_,Ident _,_ as tok')::src23 -> [tok;tok'],src23 + | _ -> failwith "renumber_by") in + let src2,src3,l'' = renumber_by src23 l' in + (src1@src2),src3,(x::l'') in + match just with + | Proof(x,steps,z) -> + let labels',steps' = renumber_steps labels context steps in + labels',src,Proof(x,steps',z) + | By(x,y,z) -> + let src1',src2,x' = renumber_by src x in + let src2',_,y' = renumber_by src2 y in + labels,(src1'@src2'),By(x',y',z) + | _ -> labels,src,just;; + +let renumber_steps1 steps = + let labels = rev (labels_of_steps [] [] steps) in + let labels' = number_labels (!start_label) labels in + snd (renumber_steps labels' [] steps);; + +let VERBOSE_TAC : bool -> tactic -> tactic = + fun v tac g -> + let call f x = + let v' = !verbose in verbose := v; + let y = (try f x with e -> verbose := v'; raise e) in + verbose := v'; y in + let (mvs,insts),gls,just = call tac g in + (mvs,insts),gls,(call just);; + +let last_thm_internal = ref None;; +let last_thm_internal' = ref None;; + +let last_thm () = + match !last_thm_internal with + | Some th -> last_thm_internal := None; th + | None -> failwith "last_thm";; + +let check_file_verbose name lemma = + let l = String.length name in + if l >= 3 & String.sub name (l - 3) 3 = ".ml" then + (let _ = exec_phrase false ("loadt \""^name^"\";;") in + (0,0,0),TRUTH) + else + (last_thm_internal := None; + let file = Pervasives.open_in name in + let n = in_channel_length file in + let s = String.create n in + really_input file s 0 n; + close_in file; + let t,x,y = try + let steps = parse_proof s in + (if !growth_mode then + try next_growth_label := 1 + max_label (labels_of_steps [] [] steps) + with _ -> ()); + let steps',((n1,n2,n3) as x),y = if !silent_server > 0 then + let oldstdout = Unix.dup Unix.stdout in + let cleanup () = Unix.dup2 oldstdout Unix.stdout in + let newstdout = Unix.openfile "/dev/null" [wronly] 0 in + Unix.dup2 newstdout Unix.stdout; + try + let x = check_proof steps in cleanup(); x + with e -> cleanup(); raise e + else check_proof steps in + let steps'' = if !renumber_labels then + try renumber_steps1 steps' with Noparse -> steps' else steps' in + let y' = if n1 + n2 + n3 = 0 then y else ASSUME (concl y) in + last_thm_internal := Some y; + last_thm_internal' := Some y'; + (match lemma with + | Some s -> + let _ = exec_phrase (!silent_server < 2 & n1 + n2 + n3 = 0) + ("let "^s^" = "^ + "match !last_thm_internal' with Some y -> y | None -> TRUTH;;") in + by_item_cache := undefined; + | None -> ()); + string_of_src 0 (src_of_steps steps''),x,y + with _ -> ("::#"^"10\n:: 10: MIZ3 EXCEPTION\n"^s),(1,0,0),TRUTH in + let file = open_out name in + output_string file t; + close_out file; + x,y);; + +let check_file name = + let (n1,n2,n3),th = check_file_verbose name None in + if n1 + n2 + n3 = 0 then th else + failwith (string_of_int n1^"+"^string_of_int n2^"+"^string_of_int n3^ + " errors");; + +usr2_handler := + fun () -> + let cleanup () = let _ = Unix.system ("rm -f "^(!miz3_filename)) in () in + try + let namefile = Pervasives.open_in !miz3_filename in + let name = input_line namefile in + let lemma = try Some (input_line namefile) with End_of_file -> None in + close_in namefile; + let _ = check_file_verbose name lemma in cleanup() + with _ -> cleanup();; + +let exit_proc = ref (fun () -> ());; + +let server_up () = + if Unix.fork() = 0 then + (exit_proc := (fun () -> ()); + (try + let pidfile = open_out !miz3_pid in + output_string pidfile ((string_of_int (Unix.getppid()))^"\n"); + close_out pidfile + with _ -> print_string "server_up failed\n"); + exit 0) + else let _ = Unix.wait() in ();; + +let server_down () = + if Unix.fork() = 0 then + (exit_proc := (fun () -> ()); + (try + let pidfile = Pervasives.open_in !miz3_pid in + let pid_string = input_line pidfile in + close_in pidfile; + if pid_string <> string_of_int (Unix.getppid()) + then failwith "server_down" else + let _ = Unix.system ("rm -f "^(!miz3_pid)) in () + with _ -> print_string "server_down failed\n"); + exit 0) + else let _ = Unix.wait() in ();; + +server_up();; +exit_proc := server_down;; +at_exit (fun _ -> !exit_proc ());; + +let reset_miz3 h = + horizon := h; + timeout := 1; + default_prover := ("HOL_BY", CONV_TAC o HOL_BY); + sketch_mode := false; + just_cache := undefined; + by_item_cache := undefined; + current_goalstack := []; + server_up();; diff --git a/miz3/miz3_of_hol.ml b/miz3/miz3_of_hol.ml new file mode 100644 index 0000000..9e27520 --- /dev/null +++ b/miz3/miz3_of_hol.ml @@ -0,0 +1,237 @@ +needs "miz3.ml";; + +type script_step = +| Tac of string * tactic +| Par of script_step list list;; + +type prooftree = +| Prooftree of goal * (string * tactic) * prooftree list +| Open_goal of goal;; + +let read_script filename lemmaname = + let rec check_semisemi l = + match l with + | ";"::";"::_ -> true + | " "::l' -> check_semisemi l' + | _ -> false in + let file = open_in filename in + let lemma_string = "let "^lemmaname^" = prove" in + let n = String.length lemma_string in + let rec read_script1 () = + let s = input_line file in + if String.length s >= n & String.sub s 0 n = lemma_string + then (explode s)@"\n"::read_script2 () else read_script1 () + and read_script2 () = + let l = explode (input_line file) in + if check_semisemi (rev l) then l else l@"\n"::read_script2 () in + let l = read_script1 () in + close_in file; + l;; + +let rec tokenize l = + match l with + | [] -> [] + | c::l' -> + let l1,l23 = if isalnum c then many (some isalnum) l else [c],l' in + let l2,l3 = many (some isspace) l23 in + (implode l1,if l2 = [] then "" else " ")::tokenize l3;; + +let parse_script l = + let rec parse_statement s l = + match l with + | ("`",_)::(",",_)::l' -> s,l' + | (x,y)::l' -> parse_statement (s^x^y) l' + | [] -> failwith "parse_statement" in + let rec parse_tactic b n s y' l = + match l with + | ("\\",y)::l' when not b -> parse_tactic b n (s^y'^"\\\\") y l' + | (x,y)::l' -> + if n = 0 & (x = "THEN" or x = "THENL" or x = ";" or x = "]" or x = ")") + then (Tac(s,exec_tactic s)),l else + let n' = if x = "[" or x = "(" then n + 1 else + if x = "]" or x = ")" then n - 1 else n in + let x',b' = + if x = "`" then + if b then "(parse_term \"",(not b) else "\")",(not b) + else x,b in + parse_tactic b' n' (s^y'^x') y l' + | [] -> failwith "parse_tactic" in + let rec parse_tactics tacs l = + let tac,l' = parse_tactic true 0 "" "" l in + parse_tactics1 (tac::tacs) l' + and parse_tactics1 tacs l = + match l with + | ("THEN",_)::l' -> parse_tactics tacs l' + | ("THENL",_)::("[",_)::l' -> + let tac,l'' = parse_par_tactics [] l' in + parse_tactics1 (tac::tacs) l'' + | _ -> (rev tacs),l + and parse_par_tactics tacss l = + let tacs,l' = parse_tactics [] l in + match l' with + | (";",_)::l'' -> parse_par_tactics (tacs::tacss) l'' + | ("]",_)::l'' -> (Par (rev (tacs::tacss))),l'' + | _ -> failwith "parse_par_tactics" in + match l with + | ("let",_)::_::("=",_)::("prove",_)::("(",_)::("`",_)::l' -> + let s,l'' = parse_statement "" l' in + let tacs,l''' = parse_tactics [] l'' in + (match l''' with + | [")",_; ";",_; ";",_] -> parse_term s,tacs + | _ -> failwith "parse_script") + | _ -> failwith "parse_script";; + +let read_script1 filename lemmaname = + parse_script (tokenize (read_script filename lemmaname));; + +let tactic_of_script l = + let rec tactic_of_script1 l = + match l with + | [] -> ALL_TAC + | [Tac(_,tac)] -> tac + | (Tac(_,tac))::l' -> tactic_of_script1 l' THEN tac + | (Par ll)::l' -> + tactic_of_script1 l' THENL (map (tactic_of_script1 o rev) ll) in + tactic_of_script1 (rev l);; + +let run_script (tm,l) = prove(tm,tactic_of_script l);; + +let prooftree_of_script g l = + let rec prooftrees_of gltl tl = + match gltl with + | [] -> [] + | (gl,t)::rst -> + let tl1,tl' = chop_list (length gl) tl in + (t tl1)::prooftrees_of rst tl' in + let prooftree_of_script2 t gltl = + flat (map fst gltl),(fun tl -> t (prooftrees_of gltl tl)) in + let rec prooftree_of_script1 g l = + match l with + | [] -> [g],(function [t] -> t | _ -> failwith "prooftree_of_script1") + | (Tac(s,tac))::l' -> + let gl,t = prooftree_of_script1 g l' in + let gltl = map (fun g' -> let _,x,_ = tac g' in + x,(fun tl -> Prooftree(g',(s,tac),tl))) gl in + prooftree_of_script2 t gltl + | (Par ll)::l' -> + let gl,t = prooftree_of_script1 g l' in + let gltl = map2 prooftree_of_script1 gl (map rev ll) in + prooftree_of_script2 t gltl in + let gl,t = prooftree_of_script1 g (rev l) in + t (map (fun x -> Open_goal x) gl);; + +let goal_of_prooftree t = + match t with + | Prooftree(g,_,_) -> g + | Open_goal(g) -> g;; + +let rec step_of_prooftree prefix n context t = + let frees_of_goal (asl,w) = + union (flat (map (frees o concl o snd) asl)) (frees w) in + let rec extra_ass ass' ass = + if subset ass' ass then [] else (hd ass')::(extra_ass (tl ass') ass) in + let rec lets prefix l = + match l with + | [] -> [] + | t::_ -> + let l',l'' = partition ((=) (type_of t) o type_of) l in + step_of_substep prefix (Let l')::lets prefix l'' in + let rec intros prefix n ass = + match ass with + | [] -> [],n,[] + | a::ass' -> + let steps,n',context = intros prefix (n + 1) ass' in + let lab = string_of_int n in + (step_of_substep prefix (Assume(a,[lab]))::steps), + n',((a,lab)::context) in + let shift_labels steps = + let labels = rev (labels_of_steps [] [] steps) in + let labels' = + map ((fun s -> [s],[string_of_int (int_of_string s - 1)]) o hd o fst) + labels in + snd (renumber_steps labels' [] steps) in + let rec steps_of_prooftrees prefix n context (asl,_ as g) tl = + match tl with + | [] -> [],[],n,context + | t'::tl' -> + let (asl',w' as g') = goal_of_prooftree t' in + let prefix' = prefix^(!proof_indent) in + let ll = + lets prefix' (subtract (frees_of_goal g') (frees_of_goal g)) in + let vars = flat (map (function (_,_,Let l) -> l | _ -> []) ll) in + let ass = + extra_ass (map (concl o snd) asl') (map (concl o snd) asl) in + let w'' = list_mk_forall(vars, itlist (curry mk_imp) ass w') in + try + let lab = assoc w'' context in + let steps,labs,n',context' = + steps_of_prooftrees prefix n context g tl' in + steps,Label lab::labs,n',context' + with Failure "find" -> + if vars = [] & ass = [] then + let steps,just,n',context' = + steps_of_prooftree prefix n context t' in + try + let lab = assoc w'' context' in + let steps',labs,n'',context'' = + steps_of_prooftrees prefix n' context' g tl' in + (steps@steps'),Label lab::labs,n'',context'' + with Failure "find" -> + let lab = string_of_int n' in + let steps',labs,n'',context'' = + steps_of_prooftrees prefix (n' + 1) + ((w',lab)::context') g tl' in + (steps@ + [rewrap_step (step_of_substep prefix (Have(w'',[lab],just)))]@ + steps'),Label lab::labs,n'',context'' + else + let lab = string_of_int n in + let steps,n',context' = intros prefix' (n + 1) ass in + let steps',just,n'',context'' = + steps_of_prooftree prefix' n' (rev context'@context) t' in + let qed = [rewrap_step (step_of_substep prefix (Qed just))] in + let steps'',n''' = + if steps' = [] then (steps'@qed),n'' else + match last steps' with + | _,_,Have(w''',_,Proof(_,steps''',_)) when w''' = w' -> + (butlast steps'@ + map (outdent (String.length !proof_indent)) + (shift_labels steps''')),n'' + | _ -> (steps'@qed),n'' in + let steps''',labs,n'''',context''' = + steps_of_prooftrees prefix n''' ((w'',lab)::context'') g tl' in + (step_of_substep prefix + (Have(w'',[lab], + Proof (Some (step_of_substep prefix Bracket_proof), + (ll@steps@steps''), None))):: + steps'''),Label lab::labs,n'''',context''' + and steps_of_prooftree prefix n context t = + match t with + | Prooftree((_,w as g),(s,tac),tl) -> + let steps,f_labs,n',context' = + steps_of_prooftrees prefix n context g tl in + let b_labs = map ((fun x -> Label x) o C assoc context o concl o snd) + (rev (fst g)) in + steps,By((Tactic(s,K tac))::b_labs,f_labs,false),n',context' + | Open_goal(g) -> [],By([Hole],[],false),n,context in + let prefix' = prefix^(!proof_indent) in + match t with + | Prooftree((_,w as g),_,_) -> + let steps,_,_,_ = + steps_of_prooftrees prefix n context g [t] in + (match last steps with + | _,_,Have(_,_,just) -> + step_of_substep prefix (Have(w,[string_of_int n], + if length steps = 1 then just else + let steps',_,_,_ = + steps_of_prooftrees prefix' (n + 1) context g [t] in + Proof (Some (step_of_substep prefix Bracket_proof), + (butlast steps'@ + [rewrap_step (step_of_substep prefix (Qed just))]), None))) + | _ -> failwith "step_of_prooftree") + | _ -> failwith "step_of_prooftree";; + +let miz3_of_hol filename lemmaname = + let tm,l = read_script1 filename lemmaname in + step_of_prooftree "" 1 [] (prooftree_of_script ([],tm) l);; + diff --git a/miz3/test.ml b/miz3/test.ml new file mode 100644 index 0000000..221c17d --- /dev/null +++ b/miz3/test.ml @@ -0,0 +1,13 @@ +loadt "miz3/Samples/samples.ml";; +loadt "miz3/Samples/sample.ml";; +loadt "miz3/Samples/talk.ml";; +loadt "miz3/Samples/drinker.ml";; +loadt "miz3/Samples/irrat2.ml";; +loadt "miz3/Samples/lagrange.ml";; +loadt "miz3/Samples/lagrange1.ml";; +loadt "miz3/Samples/icms.ml";; +loadt "miz3/Samples/other_mizs.ml";; +loadt "miz3/Samples/robbins.ml";; +loadt "miz3/Samples/forster.ml";; +loadt "miz3/Samples/luxury.ml";; +loadt "miz3/Samples/tobias.ml";; diff --git a/nets.ml b/nets.ml new file mode 100644 index 0000000..2b70820 --- /dev/null +++ b/nets.ml @@ -0,0 +1,120 @@ +(* ========================================================================= *) +(* Term nets: reasonably fast lookup based on term matchability. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "basics.ml";; + +(* ------------------------------------------------------------------------- *) +(* Term nets are a finitely branching tree structure; at each level we *) +(* have a set of branches and a set of "values". Linearization is *) +(* performed from the left of a combination; even in iterated *) +(* combinations we look at the head first. This is probably fastest, and *) +(* anyway it's useful to allow our restricted second order matches: if *) +(* the head is a variable then then whole term is treated as a variable. *) +(* ------------------------------------------------------------------------- *) + +type term_label = Vnet (* variable (instantiable) *) + | Lcnet of (string * int) (* local constant *) + | Cnet of (string * int) (* constant *) + | Lnet of int;; (* lambda term (abstraction) *) + +type 'a net = Netnode of (term_label * 'a net) list * 'a list;; + +(* ------------------------------------------------------------------------- *) +(* The empty net. *) +(* ------------------------------------------------------------------------- *) + +let empty_net = Netnode([],[]);; + +(* ------------------------------------------------------------------------- *) +(* Insert a new element into a net. *) +(* ------------------------------------------------------------------------- *) + +let enter = + let label_to_store lconsts tm = + let op,args = strip_comb tm in + if is_const op then Cnet(fst(dest_const op),length args),args + else if is_abs op then + let bv,bod = dest_abs op in + let bod' = if mem bv lconsts then vsubst [genvar(type_of bv),bv] bod + else bod in + Lnet(length args),bod'::args + else if mem op lconsts then Lcnet(fst(dest_var op),length args),args + else Vnet,[] in + let canon_eq x y = + try Pervasives.compare x y = 0 with Invalid_argument _ -> false + and canon_lt x y = + try Pervasives.compare x y < 0 with Invalid_argument _ -> false in + let rec sinsert x l = + if l = [] then [x] else + let h = hd l in + if canon_eq h x then failwith "sinsert" else + if canon_lt x h then x::l else + h::(sinsert x (tl l)) in + let set_insert x l = try sinsert x l with Failure "sinsert" -> l in + let rec net_update lconsts (elem,tms,Netnode(edges,tips)) = + match tms with + [] -> Netnode(edges,set_insert elem tips) + | (tm::rtms) -> + let label,ntms = label_to_store lconsts tm in + let child,others = + try (snd F_F I) (remove (fun (x,y) -> x = label) edges) + with Failure _ -> (empty_net,edges) in + let new_child = net_update lconsts (elem,ntms@rtms,child) in + Netnode ((label,new_child)::others,tips) in + fun lconsts (tm,elem) net -> net_update lconsts (elem,[tm],net);; + +(* ------------------------------------------------------------------------- *) +(* Look up a term in a net and return possible matches. *) +(* ------------------------------------------------------------------------- *) + +let lookup = + let label_for_lookup tm = + let op,args = strip_comb tm in + if is_const op then Cnet(fst(dest_const op),length args),args + else if is_abs op then Lnet(length args),(body op)::args + else Lcnet(fst(dest_var op),length args),args in + let rec follow (tms,Netnode(edges,tips)) = + match tms with + [] -> tips + | (tm::rtms) -> + let label,ntms = label_for_lookup tm in + let collection = + try let child = assoc label edges in + follow(ntms @ rtms, child) + with Failure _ -> [] in + if label = Vnet then collection else + try collection @ follow(rtms,assoc Vnet edges) + with Failure _ -> collection in + fun tm net -> follow([tm],net);; + +(* ------------------------------------------------------------------------- *) +(* Function to merge two nets (code from Don Syme's hol-lite). *) +(* ------------------------------------------------------------------------- *) + +let merge_nets = + let canon_eq x y = + try Pervasives.compare x y = 0 with Invalid_argument _ -> false + and canon_lt x y = + try Pervasives.compare x y < 0 with Invalid_argument _ -> false in + let rec set_merge l1 l2 = + if l1 = [] then l2 + else if l2 = [] then l1 else + let h1 = hd l1 and t1 = tl l1 + and h2 = hd l2 and t2 = tl l2 in + if canon_eq h1 h2 then h1::(set_merge t1 t2) + else if canon_lt h1 h2 then h1::(set_merge t1 l2) + else h2::(set_merge l1 t2) in + let rec merge_nets (Netnode(l1,data1),Netnode(l2,data2)) = + let add_node ((lab,net) as p) l = + try let (lab',net'),rest = remove (fun (x,y) -> x = lab) l in + (lab',merge_nets (net,net'))::rest + with Failure _ -> p::l in + Netnode(itlist add_node l2 (itlist add_node l1 []), + set_merge data1 data2) in + merge_nets;; diff --git a/normalizer.ml b/normalizer.ml new file mode 100644 index 0000000..99bd385 --- /dev/null +++ b/normalizer.ml @@ -0,0 +1,565 @@ +(* ========================================================================= *) +(* Relatively efficient HOL conversions for canonical polynomial form. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "calc_num.ml";; + +let SEMIRING_NORMALIZERS_CONV = + let SEMIRING_PTHS = prove + (`(!x:A y z. add x (add y z) = add (add x y) z) /\ + (!x y. add x y = add y x) /\ + (!x. add r0 x = x) /\ + (!x y z. mul x (mul y z) = mul (mul x y) z) /\ + (!x y. mul x y = mul y x) /\ + (!x. mul r1 x = x) /\ + (!x. mul r0 x = r0) /\ + (!x y z. mul x (add y z) = add (mul x y) (mul x z)) /\ + (!x. pwr x 0 = r1) /\ + (!x n. pwr x (SUC n) = mul x (pwr x n)) + ==> (mul r1 x = x) /\ + (add (mul a m) (mul b m) = mul (add a b) m) /\ + (add (mul a m) m = mul (add a r1) m) /\ + (add m (mul a m) = mul (add a r1) m) /\ + (add m m = mul (add r1 r1) m) /\ + (mul r0 m = r0) /\ + (add r0 a = a) /\ + (add a r0 = a) /\ + (mul a b = mul b a) /\ + (mul (add a b) c = add (mul a c) (mul b c)) /\ + (mul r0 a = r0) /\ + (mul a r0 = r0) /\ + (mul r1 a = a) /\ + (mul a r1 = a) /\ + (mul (mul lx ly) (mul rx ry) = mul (mul lx rx) (mul ly ry)) /\ + (mul (mul lx ly) (mul rx ry) = mul lx (mul ly (mul rx ry))) /\ + (mul (mul lx ly) (mul rx ry) = mul rx (mul (mul lx ly) ry)) /\ + (mul (mul lx ly) rx = mul (mul lx rx) ly) /\ + (mul (mul lx ly) rx = mul lx (mul ly rx)) /\ + (mul lx rx = mul rx lx) /\ + (mul lx (mul rx ry) = mul (mul lx rx) ry) /\ + (mul lx (mul rx ry) = mul rx (mul lx ry)) /\ + (add (add a b) (add c d) = add (add a c) (add b d)) /\ + (add (add a b) c = add a (add b c)) /\ + (add a (add c d) = add c (add a d)) /\ + (add (add a b) c = add (add a c) b) /\ + (add a c = add c a) /\ + (add a (add c d) = add (add a c) d) /\ + (mul (pwr x p) (pwr x q) = pwr x (p + q)) /\ + (mul x (pwr x q) = pwr x (SUC q)) /\ + (mul (pwr x q) x = pwr x (SUC q)) /\ + (mul x x = pwr x 2) /\ + (pwr (mul x y) q = mul (pwr x q) (pwr y q)) /\ + (pwr (pwr x p) q = pwr x (p * q)) /\ + (pwr x 0 = r1) /\ + (pwr x 1 = x) /\ + (mul x (add y z) = add (mul x y) (mul x z)) /\ + (pwr x (SUC q) = mul x (pwr x q))`, + STRIP_TAC THEN + SUBGOAL_THEN + `(!m:A n. add m n = add n m) /\ + (!m n p. add (add m n) p = add m (add n p)) /\ + (!m n p. add m (add n p) = add n (add m p)) /\ + (!x. add x r0 = x) /\ + (!m n. mul m n = mul n m) /\ + (!m n p. mul (mul m n) p = mul m (mul n p)) /\ + (!m n p. mul m (mul n p) = mul n (mul m p)) /\ + (!m n p. mul (add m n) p = add (mul m p) (mul n p)) /\ + (!x. mul x r1 = x) /\ + (!x. mul x r0 = r0)` + MP_TAC THENL + [ASM_MESON_TAC[]; + MAP_EVERY (fun t -> UNDISCH_THEN t (K ALL_TAC)) + [`!x:A y z. add x (add y z) = add (add x y) z`; + `!x:A y. add x y :A = add y x`; + `!x:A y z. mul x (mul y z) = mul (mul x y) z`; + `!x:A y. mul x y :A = mul y x`] THEN + STRIP_TAC] THEN + ASM_REWRITE_TAC[num_CONV `2`; num_CONV `1`] THEN + SUBGOAL_THEN `!m n:num x:A. pwr x (m + n) :A = mul (pwr x m) (pwr x n)` + ASSUME_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `!x:A y:A n:num. pwr (mul x y) n = mul (pwr x n) (pwr y n)` + ASSUME_TAC THENL + [GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A m:num n. pwr (pwr x m) n = pwr x (m * n)` + (fun th -> ASM_MESON_TAC[th]) THEN + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[MULT_CLAUSES]) + and true_tm = concl TRUTH in + fun sth rth (is_semiring_constant, + SEMIRING_ADD_CONV, + SEMIRING_MUL_CONV, + SEMIRING_POW_CONV) -> + let + [pthm_01; pthm_02; pthm_03; pthm_04; pthm_05; pthm_06; pthm_07; pthm_08; + pthm_09; pthm_10; pthm_11; pthm_12; pthm_13; pthm_14; pthm_15; pthm_16; + pthm_17; pthm_18; pthm_19; pthm_20; pthm_21; pthm_22; pthm_23; pthm_24; + pthm_25; pthm_26; pthm_27; pthm_28; pthm_29; pthm_30; pthm_31; pthm_32; + pthm_33; pthm_34; pthm_35; pthm_36; pthm_37; pthm_38] = + CONJUNCTS(MATCH_MP SEMIRING_PTHS sth) in + let add_tm = rator(rator(lhand(concl pthm_07))) + and mul_tm = rator(rator(lhand(concl pthm_13))) + and pow_tm = rator(rator(rand(concl pthm_32))) + and zero_tm = rand(concl pthm_06) + and one_tm = rand(lhand(concl pthm_14)) + and ty = type_of(rand(concl pthm_01)) in + + let p_tm = `p:num` + and q_tm = `q:num` + and zeron_tm = `0` + and onen_tm = `1` + and a_tm = mk_var("a",ty) + and b_tm = mk_var("b",ty) + and c_tm = mk_var("c",ty) + and d_tm = mk_var("d",ty) + and lx_tm = mk_var("lx",ty) + and ly_tm = mk_var("ly",ty) + and m_tm = mk_var("m",ty) + and rx_tm = mk_var("rx",ty) + and ry_tm = mk_var("ry",ty) + and x_tm = mk_var("x",ty) + and y_tm = mk_var("y",ty) + and z_tm = mk_var("z",ty) in + + let dest_add = dest_binop add_tm + and dest_mul = dest_binop mul_tm + and dest_pow tm = + let l,r = dest_binop pow_tm tm in + if is_numeral r then l,r else failwith "dest_pow" + and is_add = is_binop add_tm + and is_mul = is_binop mul_tm in + + let nthm_1,nthm_2,sub_tm,neg_tm,dest_sub,is_sub = + if concl rth = true_tm then rth,rth,true_tm,true_tm, + (fun t -> t,t),K false + else + let nthm_1 = SPEC x_tm (CONJUNCT1 rth) + and nthm_2 = SPECL [x_tm; y_tm] (CONJUNCT2 rth) in + let sub_tm = rator(rator(lhand(concl nthm_2))) + and neg_tm = rator(lhand(concl nthm_1)) in + let dest_sub = dest_binop sub_tm + and is_sub = is_binop sub_tm in + (nthm_1,nthm_2,sub_tm,neg_tm,dest_sub,is_sub) in + + fun variable_order -> + +(* ------------------------------------------------------------------------- *) +(* Conversion for "x^n * x^m", with either x^n = x and/or x^m = x possible. *) +(* Also deals with "const * const", but both terms must involve powers of *) +(* the same variable, or both be constants, or behaviour may be incorrect. *) +(* ------------------------------------------------------------------------- *) + + let POWVAR_MUL_CONV tm = + let l,r = dest_mul tm in + if is_semiring_constant l & is_semiring_constant r + then SEMIRING_MUL_CONV tm else + try let lx,ln = dest_pow l in + try let rx,rn = dest_pow r in + let th1 = INST [lx,x_tm; ln,p_tm; rn,q_tm] pthm_29 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + TRANS th1 (AP_TERM tm1 (NUM_ADD_CONV tm2)) + with Failure _ -> + let th1 = INST [lx,x_tm; ln,q_tm] pthm_31 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + TRANS th1 (AP_TERM tm1 (NUM_SUC_CONV tm2)) + with Failure _ -> + try let rx,rn = dest_pow r in + let th1 = INST [rx,x_tm; rn,q_tm] pthm_30 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + TRANS th1 (AP_TERM tm1 (NUM_SUC_CONV tm2)) + with Failure _ -> + INST [l,x_tm] pthm_32 in + +(* ------------------------------------------------------------------------- *) +(* Remove "1 * m" from a monomial, and just leave m. *) +(* ------------------------------------------------------------------------- *) + + let MONOMIAL_DEONE th = + try let l,r = dest_mul(rand(concl th)) in + if l = one_tm then TRANS th (INST [r,x_tm] pthm_01) else th + with Failure _ -> th in + +(* ------------------------------------------------------------------------- *) +(* Conversion for "(monomial)^n", where n is a numeral. *) +(* ------------------------------------------------------------------------- *) + + let MONOMIAL_POW_CONV = + let rec MONOMIAL_POW tm bod ntm = + if not(is_comb bod) then REFL tm + else if is_semiring_constant bod then SEMIRING_POW_CONV tm else + let lop,r = dest_comb bod in + if not(is_comb lop) then REFL tm else + let op,l = dest_comb lop in + if op = pow_tm & is_numeral r then + let th1 = INST [l,x_tm; r,p_tm; ntm,q_tm] pthm_34 in + let l,r = dest_comb(rand(concl th1)) in + TRANS th1 (AP_TERM l (NUM_MULT_CONV r)) + else if op = mul_tm then + let th1 = INST [l,x_tm; r,y_tm; ntm,q_tm] pthm_33 in + let xy,z = dest_comb(rand(concl th1)) in + let x,y = dest_comb xy in + let thl = MONOMIAL_POW y l ntm + and thr = MONOMIAL_POW z r ntm in + TRANS th1 (MK_COMB(AP_TERM x thl,thr)) + else REFL tm in + fun tm -> + let lop,r = dest_comb tm in + let op,l = dest_comb lop in + if op <> pow_tm or not(is_numeral r) then failwith "MONOMIAL_POW_CONV" + else if r = zeron_tm then INST [l,x_tm] pthm_35 + else if r = onen_tm then INST [l,x_tm] pthm_36 + else MONOMIAL_DEONE(MONOMIAL_POW tm l r) in + +(* ------------------------------------------------------------------------- *) +(* Multiplication of canonical monomials. *) +(* ------------------------------------------------------------------------- *) + + let MONOMIAL_MUL_CONV = + let powvar tm = + if is_semiring_constant tm then one_tm else + try let lop,r = dest_comb tm in + let op,l = dest_comb lop in + if op = pow_tm & is_numeral r then l else failwith "" + with Failure _ -> tm in + let vorder x y = + if x = y then 0 + else if x = one_tm then -1 + else if y = one_tm then 1 + else if variable_order x y then -1 else 1 in + let rec MONOMIAL_MUL tm l r = + try let lx,ly = dest_mul l in + let vl = powvar lx in + try let rx,ry = dest_mul r in + let vr = powvar rx in + let ord = vorder vl vr in + if ord = 0 then + let th1 = INST + [lx,lx_tm; ly,ly_tm; rx,rx_tm; ry,ry_tm] pthm_15 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_THM (AP_TERM tm3 (POWVAR_MUL_CONV tm4)) tm2 in + let th3 = TRANS th1 th2 in + let tm5,tm6 = dest_comb(rand(concl th3)) in + let tm7,tm8 = dest_comb tm6 in + let th4 = MONOMIAL_MUL tm6 (rand tm7) tm8 in + TRANS th3 (AP_TERM tm5 th4) + else + let th0 = if ord < 0 then pthm_16 else pthm_17 in + let th1 = INST + [lx,lx_tm; ly,ly_tm; rx,rx_tm; ry,ry_tm] th0 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm2 in + TRANS th1 (AP_TERM tm1 (MONOMIAL_MUL tm2 (rand tm3) tm4)) + with Failure _ -> + let vr = powvar r in + let ord = vorder vl vr in + if ord = 0 then + let th1 = INST [lx,lx_tm; ly,ly_tm; r,rx_tm] pthm_18 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_THM (AP_TERM tm3 (POWVAR_MUL_CONV tm4)) tm2 in + TRANS th1 th2 + else if ord < 0 then + let th1 = INST [lx,lx_tm; ly,ly_tm; r,rx_tm] pthm_19 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm2 in + TRANS th1 (AP_TERM tm1 (MONOMIAL_MUL tm2 (rand tm3) tm4)) + else INST [l,lx_tm; r,rx_tm] pthm_20 + with Failure _ -> + let vl = powvar l in + try let rx,ry = dest_mul r in + let vr = powvar rx in + let ord = vorder vl vr in + if ord = 0 then + let th1 = INST [l,lx_tm; rx,rx_tm; ry,ry_tm] pthm_21 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + TRANS th1 (AP_THM (AP_TERM tm3 (POWVAR_MUL_CONV tm4)) tm2) + else if ord > 0 then + let th1 = INST [l,lx_tm; rx,rx_tm; ry,ry_tm] pthm_22 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm2 in + TRANS th1 (AP_TERM tm1 (MONOMIAL_MUL tm2 (rand tm3) tm4)) + else REFL tm + with Failure _ -> + let vr = powvar r in + let ord = vorder vl vr in + if ord = 0 then POWVAR_MUL_CONV tm + else if ord > 0 then INST [l,lx_tm; r,rx_tm] pthm_20 + else REFL tm in + fun tm -> let l,r = dest_mul tm in MONOMIAL_DEONE(MONOMIAL_MUL tm l r) in + +(* ------------------------------------------------------------------------- *) +(* Multiplication by monomial of a polynomial. *) +(* ------------------------------------------------------------------------- *) + + let POLYNOMIAL_MONOMIAL_MUL_CONV = + let rec PMM_CONV tm = + let l,r = dest_mul tm in + try let y,z = dest_add r in + let th1 = INST [l,x_tm; y,y_tm; z,z_tm] pthm_37 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = MK_COMB(AP_TERM tm3 (MONOMIAL_MUL_CONV tm4), + PMM_CONV tm2) in + TRANS th1 th2 + with Failure _ -> MONOMIAL_MUL_CONV tm in + PMM_CONV in + +(* ------------------------------------------------------------------------- *) +(* Addition of two monomials identical except for constant multiples. *) +(* ------------------------------------------------------------------------- *) + + let MONOMIAL_ADD_CONV tm = + let l,r = dest_add tm in + if is_semiring_constant l & is_semiring_constant r + then SEMIRING_ADD_CONV tm else + let th1 = + if is_mul l & is_semiring_constant(lhand l) then + if is_mul r & is_semiring_constant(lhand r) then + INST [lhand l,a_tm; lhand r,b_tm; rand r,m_tm] pthm_02 + else + INST [lhand l,a_tm; r,m_tm] pthm_03 + else + if is_mul r & is_semiring_constant(lhand r) then + INST [lhand r,a_tm; l,m_tm] pthm_04 + else + INST [r,m_tm] pthm_05 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_TERM tm3 (SEMIRING_ADD_CONV tm4) in + let th3 = TRANS th1 (AP_THM th2 tm2) in + let tm5 = rand(concl th3) in + if lhand tm5 = zero_tm then TRANS th3 (INST [rand tm5,m_tm] pthm_06) + else MONOMIAL_DEONE th3 in + +(* ------------------------------------------------------------------------- *) +(* Ordering on monomials. *) +(* ------------------------------------------------------------------------- *) + + let powervars tm = + let ptms = striplist dest_mul tm in + if is_semiring_constant (hd ptms) then tl ptms else ptms in + + let dest_varpow tm = + try let x,n = dest_pow tm in (x,dest_numeral n) + with Failure _ -> + (tm,(if is_semiring_constant tm then num_0 else num_1)) in + + let morder = + let rec lexorder l1 l2 = + match (l1,l2) with + [],[] -> 0 + | vps,[] -> -1 + | [],vps -> 1 + | ((x1,n1)::vs1),((x2,n2)::vs2) -> + if variable_order x1 x2 then 1 + else if variable_order x2 x1 then -1 + else if n1 + let vdegs1 = map dest_varpow (powervars tm1) + and vdegs2 = map dest_varpow (powervars tm2) in + let deg1 = itlist ((+/) o snd) vdegs1 num_0 + and deg2 = itlist ((+/) o snd) vdegs2 num_0 in + if deg1 / deg2 then 1 + else lexorder vdegs1 vdegs2 in + +(* ------------------------------------------------------------------------- *) +(* Addition of two polynomials. *) +(* ------------------------------------------------------------------------- *) + + let POLYNOMIAL_ADD_CONV = + let DEZERO_RULE th = + let tm = rand(concl th) in + if not(is_add tm) then th else + let lop,r = dest_comb tm in + let l = rand lop in + if l = zero_tm then TRANS th (INST [r,a_tm] pthm_07) + else if r = zero_tm then TRANS th (INST [l,a_tm] pthm_08) + else th in + let rec PADD tm = + let l,r = dest_add tm in + if l = zero_tm then INST [r,a_tm] pthm_07 + else if r = zero_tm then INST [l,a_tm] pthm_08 else + if is_add l then + let a,b = dest_add l in + if is_add r then + let c,d = dest_add r in + let ord = morder a c in + if ord = 0 then + let th1 = INST [a,a_tm; b,b_tm; c,c_tm; d,d_tm] pthm_23 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_TERM tm3 (MONOMIAL_ADD_CONV tm4) in + DEZERO_RULE (TRANS th1 (MK_COMB(th2,PADD tm2))) + else + let th1 = + if ord > 0 then INST [a,a_tm; b,b_tm; r,c_tm] pthm_24 + else INST [l,a_tm; c,c_tm; d,d_tm] pthm_25 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + DEZERO_RULE (TRANS th1 (AP_TERM tm1 (PADD tm2))) + else + let ord = morder a r in + if ord = 0 then + let th1 = INST [a,a_tm; b,b_tm; r,c_tm] pthm_26 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_THM (AP_TERM tm3 (MONOMIAL_ADD_CONV tm4)) tm2 in + DEZERO_RULE (TRANS th1 th2) + else if ord > 0 then + let th1 = INST [a,a_tm; b,b_tm; r,c_tm] pthm_24 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + DEZERO_RULE (TRANS th1 (AP_TERM tm1 (PADD tm2))) + else + DEZERO_RULE (INST [l,a_tm; r,c_tm] pthm_27) + else + if is_add r then + let c,d = dest_add r in + let ord = morder l c in + if ord = 0 then + let th1 = INST [l,a_tm; c,c_tm; d,d_tm] pthm_28 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_THM (AP_TERM tm3 (MONOMIAL_ADD_CONV tm4)) tm2 in + DEZERO_RULE (TRANS th1 th2) + else if ord > 0 then + REFL tm + else + let th1 = INST [l,a_tm; c,c_tm; d,d_tm] pthm_25 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + DEZERO_RULE (TRANS th1 (AP_TERM tm1 (PADD tm2))) + else + let ord = morder l r in + if ord = 0 then MONOMIAL_ADD_CONV tm + else if ord > 0 then DEZERO_RULE(REFL tm) + else DEZERO_RULE(INST [l,a_tm; r,c_tm] pthm_27) in + PADD in + +(* ------------------------------------------------------------------------- *) +(* Multiplication of two polynomials. *) +(* ------------------------------------------------------------------------- *) + + let POLYNOMIAL_MUL_CONV = + let rec PMUL tm = + let l,r = dest_mul tm in + if not(is_add l) then POLYNOMIAL_MONOMIAL_MUL_CONV tm + else if not(is_add r) then + let th1 = INST [l,a_tm; r,b_tm] pthm_09 in + TRANS th1 (POLYNOMIAL_MONOMIAL_MUL_CONV(rand(concl th1))) + else + let a,b = dest_add l in + let th1 = INST [a,a_tm; b,b_tm; r,c_tm] pthm_10 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let tm3,tm4 = dest_comb tm1 in + let th2 = AP_TERM tm3 (POLYNOMIAL_MONOMIAL_MUL_CONV tm4) in + let th3 = TRANS th1 (MK_COMB(th2,PMUL tm2)) in + TRANS th3 (POLYNOMIAL_ADD_CONV (rand(concl th3))) in + fun tm -> + let l,r = dest_mul tm in + if l = zero_tm then INST [r,a_tm] pthm_11 + else if r = zero_tm then INST [l,a_tm] pthm_12 + else if l = one_tm then INST [r,a_tm] pthm_13 + else if r = one_tm then INST [l,a_tm] pthm_14 + else PMUL tm in + +(* ------------------------------------------------------------------------- *) +(* Power of polynomial (optimized for the monomial and trivial cases). *) +(* ------------------------------------------------------------------------- *) + + let POLYNOMIAL_POW_CONV = + let rec PPOW tm = + let l,n = dest_pow tm in + if n = zeron_tm then INST [l,x_tm] pthm_35 + else if n = onen_tm then INST [l,x_tm] pthm_36 else + let th1 = num_CONV n in + let th2 = INST [l,x_tm; rand(rand(concl th1)),q_tm] pthm_38 in + let tm1,tm2 = dest_comb(rand(concl th2)) in + let th3 = TRANS th2 (AP_TERM tm1 (PPOW tm2)) in + let th4 = TRANS (AP_TERM (rator tm) th1) th3 in + TRANS th4 (POLYNOMIAL_MUL_CONV (rand(concl th4))) in + fun tm -> + if is_add(lhand tm) then PPOW tm else MONOMIAL_POW_CONV tm in + +(* ------------------------------------------------------------------------- *) +(* Negation. *) +(* ------------------------------------------------------------------------- *) + + let POLYNOMIAL_NEG_CONV = + fun tm -> + let l,r = dest_comb tm in + if l <> neg_tm then failwith "POLYNOMIAL_NEG_CONV" else + let th1 = INST [r,x_tm] nthm_1 in + TRANS th1 (POLYNOMIAL_MONOMIAL_MUL_CONV (rand(concl th1))) in + +(* ------------------------------------------------------------------------- *) +(* Subtraction. *) +(* ------------------------------------------------------------------------- *) + + let POLYNOMIAL_SUB_CONV = + fun tm -> + let l,r = dest_sub tm in + let th1 = INST [l,x_tm; r,y_tm] nthm_2 in + let tm1,tm2 = dest_comb(rand(concl th1)) in + let th2 = AP_TERM tm1 (POLYNOMIAL_MONOMIAL_MUL_CONV tm2) in + TRANS th1 (TRANS th2 (POLYNOMIAL_ADD_CONV (rand(concl th2)))) in + +(* ------------------------------------------------------------------------- *) +(* Conversion from HOL term. *) +(* ------------------------------------------------------------------------- *) + + let rec POLYNOMIAL_CONV tm = + if not(is_comb tm) or is_semiring_constant tm then REFL tm else + let lop,r = dest_comb tm in + if lop = neg_tm then + let th1 = AP_TERM lop (POLYNOMIAL_CONV r) in + TRANS th1 (POLYNOMIAL_NEG_CONV (rand(concl th1))) + else if not(is_comb lop) then REFL tm else + let op,l = dest_comb lop in + if op = pow_tm & is_numeral r then + let th1 = AP_THM (AP_TERM op (POLYNOMIAL_CONV l)) r in + TRANS th1 (POLYNOMIAL_POW_CONV (rand(concl th1))) + else + if op = add_tm or op = mul_tm or op = sub_tm then + let th1 = MK_COMB(AP_TERM op (POLYNOMIAL_CONV l), + POLYNOMIAL_CONV r) in + let fn = if op = add_tm then POLYNOMIAL_ADD_CONV + else if op = mul_tm then POLYNOMIAL_MUL_CONV + else POLYNOMIAL_SUB_CONV in + TRANS th1 (fn (rand(concl th1))) + else REFL tm in + POLYNOMIAL_NEG_CONV,POLYNOMIAL_ADD_CONV,POLYNOMIAL_SUB_CONV, + POLYNOMIAL_MUL_CONV,POLYNOMIAL_POW_CONV,POLYNOMIAL_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Instantiate it to the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let NUM_NORMALIZE_CONV = + let sth = prove + (`(!x y z. x + (y + z) = (x + y) + z) /\ + (!x y. x + y = y + x) /\ + (!x. 0 + x = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x y. x * y = y * x) /\ + (!x. 1 * x = x) /\ + (!x. 0 * x = 0) /\ + (!x y z. x * (y + z) = x * y + x * z) /\ + (!x. x EXP 0 = 1) /\ + (!x n. x EXP (SUC n) = x * x EXP n)`, + REWRITE_TAC[EXP; MULT_CLAUSES; ADD_CLAUSES; LEFT_ADD_DISTRIB] THEN + REWRITE_TAC[ADD_AC; MULT_AC]) + and rth = TRUTH + and is_semiring_constant = is_numeral + and SEMIRING_ADD_CONV = NUM_ADD_CONV + and SEMIRING_MUL_CONV = NUM_MULT_CONV + and SEMIRING_POW_CONV = NUM_EXP_CONV in + let _,_,_,_,_,NUM_NORMALIZE_CONV = + SEMIRING_NORMALIZERS_CONV sth rth + (is_semiring_constant, + SEMIRING_ADD_CONV,SEMIRING_MUL_CONV,SEMIRING_POW_CONV) + (<) in + NUM_NORMALIZE_CONV;; diff --git a/nums.ml b/nums.ml new file mode 100644 index 0000000..e4e1772 --- /dev/null +++ b/nums.ml @@ -0,0 +1,295 @@ +(* ========================================================================= *) +(* The axiom of infinity; construction of the natural numbers. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "pair.ml";; + +(* ------------------------------------------------------------------------- *) +(* Declare a new type "ind" of individuals. *) +(* ------------------------------------------------------------------------- *) + +new_type ("ind",0);; + +(* ------------------------------------------------------------------------- *) +(* We assert the axiom of infinity as in HOL88, but then we can forget it! *) +(* ------------------------------------------------------------------------- *) + +let ONE_ONE = new_definition + `ONE_ONE(f:A->B) = !x1 x2. (f x1 = f x2) ==> (x1 = x2)`;; + +let ONTO = new_definition + `ONTO(f:A->B) = !y. ?x. y = f x`;; + +let INFINITY_AX = new_axiom + `?f:ind->ind. ONE_ONE f /\ ~(ONTO f)`;; + +(* ------------------------------------------------------------------------- *) +(* Actually introduce constants. *) +(* ------------------------------------------------------------------------- *) + +let IND_SUC_0_EXISTS = prove + (`?(f:ind->ind) z. (!x1 x2. (f x1 = f x2) = (x1 = x2)) /\ (!x. ~(f x = z))`, + X_CHOOSE_TAC `f:ind->ind` INFINITY_AX THEN EXISTS_TAC `f:ind->ind` THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[ONE_ONE; ONTO] THEN MESON_TAC[]);; + +let IND_SUC_SPEC = + let th1 = new_definition + `IND_SUC = @f:ind->ind. ?z. (!x1 x2. (f x1 = f x2) = (x1 = x2)) /\ + (!x. ~(f x = z))` in + let th2 = REWRITE_RULE[GSYM th1] (SELECT_RULE IND_SUC_0_EXISTS) in + let th3 = new_definition + `IND_0 = @z:ind. (!x1 x2. IND_SUC x1 = IND_SUC x2 <=> x1 = x2) /\ + (!x. ~(IND_SUC x = z))` in + REWRITE_RULE[GSYM th3] (SELECT_RULE th2);; + +let IND_SUC_INJ,IND_SUC_0 = CONJ_PAIR IND_SUC_SPEC;; + +(* ------------------------------------------------------------------------- *) +(* Carve out the natural numbers inductively. *) +(* ------------------------------------------------------------------------- *) + +let NUM_REP_RULES,NUM_REP_INDUCT,NUM_REP_CASES = + new_inductive_definition + `NUM_REP IND_0 /\ + (!i. NUM_REP i ==> NUM_REP (IND_SUC i))`;; + +let num_tydef = new_basic_type_definition + "num" ("mk_num","dest_num") + (CONJUNCT1 NUM_REP_RULES);; + +let ZERO_DEF = new_definition + `_0 = mk_num IND_0`;; + +let SUC_DEF = new_definition + `SUC n = mk_num(IND_SUC(dest_num n))`;; + +(* ------------------------------------------------------------------------- *) +(* Distinctness and injectivity of constructors. *) +(* ------------------------------------------------------------------------- *) + +let NOT_SUC = prove + (`!n. ~(SUC n = _0)`, + REWRITE_TAC[SUC_DEF; ZERO_DEF] THEN + MESON_TAC[NUM_REP_RULES; fst num_tydef; snd num_tydef; IND_SUC_0]);; + +let SUC_INJ = prove + (`!m n. SUC m = SUC n <=> m = n`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUC_DEF] THEN + EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(MP_TAC o AP_TERM `dest_num`) THEN + SUBGOAL_THEN `!p. NUM_REP (IND_SUC (dest_num p))` MP_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC (CONJUNCT2 NUM_REP_RULES); ALL_TAC] THEN + REWRITE_TAC[fst num_tydef; snd num_tydef] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[IND_SUC_INJ] THEN + DISCH_THEN(MP_TAC o AP_TERM `mk_num`) THEN + REWRITE_TAC[fst num_tydef]);; + +(* ------------------------------------------------------------------------- *) +(* Induction. *) +(* ------------------------------------------------------------------------- *) + +let num_INDUCTION = prove + (`!P. P(_0) /\ (!n. P(n) ==> P(SUC n)) ==> !n. P n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `\i. NUM_REP i /\ P(mk_num i):bool` NUM_REP_INDUCT) THEN + ASM_REWRITE_TAC[GSYM ZERO_DEF; NUM_REP_RULES] THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) THENL + [REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(CONJUNCT2 NUM_REP_RULES) THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `mk_num(IND_SUC i) = SUC(mk_num i)` SUBST1_TAC THENL + [REWRITE_TAC[SUC_DEF] THEN REPEAT AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM(snd num_tydef)] THEN + FIRST_ASSUM MATCH_ACCEPT_TAC; + FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]]; + DISCH_THEN(MP_TAC o SPEC `dest_num n`) THEN + REWRITE_TAC[fst num_tydef; snd num_tydef]]);; + +(* ------------------------------------------------------------------------- *) +(* Recursion. *) +(* ------------------------------------------------------------------------- *) + +let num_Axiom = prove + (`!(e:A) f. ?!fn. (fn _0 = e) /\ + (!n. fn (SUC n) = f (fn n) n)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[EXISTS_UNIQUE_THM] THEN CONJ_TAC THENL + [(MP_TAC o prove_inductive_relations_exist) + `PRG _0 e /\ (!b:A n:num. PRG n b ==> PRG (SUC n) (f b n))` THEN + DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN `!n:num. ?!y:A. PRG n y` MP_TAC THENL + [MATCH_MP_TAC num_INDUCTION THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC BINDER_CONV [GSYM th]) THEN + REWRITE_TAC[GSYM NOT_SUC; NOT_SUC; SUC_INJ; EXISTS_UNIQUE_REFL] THEN + REWRITE_TAC[UNWIND_THM1] THEN + UNDISCH_TAC `?!y. PRG (n:num) (y:A)` THEN + REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `y:A`) ASSUME_TAC) THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXISTS_TAC [`(f:A->num->A) y n`; `y:A`]; + AP_THM_TAC THEN AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIQUE_SKOLEM_ALT] THEN + DISCH_THEN(X_CHOOSE_THEN `fn:num->A` (ASSUME_TAC o GSYM)) THEN + EXISTS_TAC `fn:num->A` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN FIRST_ASSUM(MATCH_MP_TAC o CONJUNCT2) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN REFL_TAC]; + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN + MATCH_MP_TAC num_INDUCTION THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The basic numeral tag; rewrite existing instances of "_0". *) +(* ------------------------------------------------------------------------- *) + +let NUMERAL = new_definition + `NUMERAL (n:num) = n`;; + +let [NOT_SUC; num_INDUCTION; num_Axiom] = + let th = prove(`_0 = 0`,REWRITE_TAC[NUMERAL]) in + map (GEN_REWRITE_RULE DEPTH_CONV [th]) + [NOT_SUC; num_INDUCTION; num_Axiom];; + +(* ------------------------------------------------------------------------- *) +(* Induction tactic. *) +(* ------------------------------------------------------------------------- *) + +let (INDUCT_TAC:tactic) = + MATCH_MP_TAC num_INDUCTION THEN + CONJ_TAC THENL [ALL_TAC; GEN_TAC THEN DISCH_TAC];; + +let num_RECURSION = + let avs = fst(strip_forall(concl num_Axiom)) in + GENL avs (EXISTENCE (SPECL avs num_Axiom));; + +(* ------------------------------------------------------------------------- *) +(* Cases theorem. *) +(* ------------------------------------------------------------------------- *) + +let num_CASES = prove + (`!m. (m = 0) \/ (?n. m = SUC n)`, + INDUCT_TAC THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Augmenting inductive type store. *) +(* ------------------------------------------------------------------------- *) + +let num_RECURSION_STD = prove + (`!e:Z f. ?fn. (fn 0 = e) /\ (!n. fn (SUC n) = f n (fn n))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`e:Z`; `(\z n. (f:num->Z->Z) n z)`] num_RECURSION) THEN + REWRITE_TAC[]);; + +inductive_type_store := + ("num",(2,num_INDUCTION,num_RECURSION_STD))::(!inductive_type_store);; + +(* ------------------------------------------------------------------------- *) +(* "Bitwise" binary representation of numerals. *) +(* ------------------------------------------------------------------------- *) + +let BIT0_DEF = + let def = new_definition + `BIT0 = @fn. fn 0 = 0 /\ (!n. fn (SUC n) = SUC (SUC(fn n)))` + and th = BETA_RULE(ISPECL [`0`; `\m n:num. SUC(SUC m)`] num_RECURSION) in + REWRITE_RULE[GSYM def] (SELECT_RULE th);; + +let BIT1_DEF = new_definition + `BIT1 n = SUC (BIT0 n)`;; + +(* ------------------------------------------------------------------------- *) +(* Syntax operations on numerals. *) +(* ------------------------------------------------------------------------- *) + +let mk_numeral = + let pow24 = pow2 24 and num_0 = Int 0 + and zero_tm = mk_const("_0",[]) + and BIT0_tm = mk_const("BIT0",[]) + and BIT1_tm = mk_const("BIT1",[]) + and NUMERAL_tm = mk_const("NUMERAL",[]) in + let rec stripzeros l = match l with false::t -> stripzeros t | _ -> l in + let rec raw_list_of_num l n = + if n =/ num_0 then stripzeros l else + let h = Num.int_of_num(mod_num n pow24) in + raw_list_of_num + ((h land 8388608 <> 0)::(h land 4194304 <> 0)::(h land 2097152 <> 0):: + (h land 1048576 <> 0)::(h land 524288 <> 0)::(h land 262144 <> 0):: + (h land 131072 <> 0)::(h land 65536 <> 0)::(h land 32768 <> 0):: + (h land 16384 <> 0)::(h land 8192 <> 0)::(h land 4096 <> 0):: + (h land 2048 <> 0)::(h land 1024 <> 0)::(h land 512 <> 0):: + (h land 256 <> 0)::(h land 128 <> 0)::(h land 64 <> 0):: + (h land 32 <> 0)::(h land 16 <> 0)::(h land 8 <> 0)::(h land 4 <> 0):: + (h land 2 <> 0)::(h land 1 <> 0)::l) (quo_num n pow24) in + let rec numeral_of_list t l = + match l with + [] -> t + | b::r -> numeral_of_list(mk_comb((if b then BIT1_tm else BIT0_tm),t)) r in + let mk_raw_numeral n = numeral_of_list zero_tm (raw_list_of_num [] n) in + fun n -> if n if mem t res then fail() else t::res) l []; true + with Failure _ -> false in + let specify name th = + let ntm = mk_code name in + let gv = genvar(type_of ntm) in + let th0 = CONV_RULE(REWR_CONV SKOLEM_THM) (GEN gv th) in + let th1 = CONV_RULE(RATOR_CONV (REWR_CONV EXISTS_THM) THENC + BETA_CONV) th0 in + let l,r = dest_comb(concl th1) in + let rn = mk_comb(r,ntm) in + let ty = type_of rn in + let th2 = new_definition(mk_eq(mk_var(name,ty),rn)) in + GEN_REWRITE_RULE ONCE_DEPTH_CONV [GSYM th2] + (SPEC ntm (CONV_RULE BETA_CONV th1)) in + let rec specifies names th = + match names with + [] -> th + | name::onames -> let th' = specify name th in + specifies onames th' in + fun names th -> + let asl,c = dest_thm th in + if not (asl = []) then + failwith "new_specification: Assumptions not allowed in theorem" else + if not (frees c = []) then + failwith "new_specification: Free variables in predicate" else + let avs = fst(strip_exists c) in + if length names = 0 or length names > length avs then + failwith "new_specification: Unsuitable number of constant names" else + if not (check_distinct names) then + failwith "new_specification: Constant names not distinct" + else + try let sth = snd(find (fun ((names',th'),sth') -> + names' = names & aconv (concl th') (concl th)) + (!the_specifications)) in + warn true ("Benign respecification"); sth + with Failure _ -> + let sth = specifies names th in + the_specifications := ((names,th),sth)::(!the_specifications); + sth;; diff --git a/pa_j.ml b/pa_j.ml new file mode 100644 index 0000000..c845d75 --- /dev/null +++ b/pa_j.ml @@ -0,0 +1,2027 @@ +(* camlp5r pa_extend.cmo q_MLast.cmo *) +(* $Id: pa_o.ml 1271 2007-10-01 08:22:47Z deraugla $ *) +(* Copyright (c) INRIA 2007 *) + +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* camlp5r pa_lexer.cmo *) +(* $Id: plexer.ml 1402 2007-10-14 02:50:31Z deraugla $ *) +(* Copyright (c) INRIA 2007 *) + +(* ------------------------------------------------------------------------- *) +(* Added by JRH as a backdoor to change lexical conventions. *) +(* ------------------------------------------------------------------------- *) + +value jrh_lexer = ref False; + +value no_quotations = ref False; +value error_on_unknown_keywords = ref False; + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value force_antiquot_loc = ref False; + +(* The string buffering machinery *) + +value rev_implode l = + let s = String.create (List.length l) in + loop (String.length s - 1) l where rec loop i = + fun + [ [c :: l] -> do { String.unsafe_set s i c; loop (i - 1) l } + | [] -> s ] +; + +(* The lexer *) + +type context = + { after_space : mutable bool; + dollar_for_antiquotation : bool; + specific_space_dot : bool; + find_kwd : string -> string; + line_cnt : int -> char -> unit; + set_line_nb : unit -> unit; + make_lined_loc : (int * int) -> string -> Ploc.t } +; + +value err ctx loc msg = + Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) +; + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** JRH: Carl's alternative version + then ("UIDENT", id) + else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) + else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +value keyword_or_error ctx loc s = + try ("", ctx.find_kwd s) with + [ Not_found -> + if error_on_unknown_keywords.val then + err ctx loc ("illegal token: " ^ s) + else ("", s) ] +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value rec ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | '\128'-'\255' ] ident! | ] +; +value rec ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' ] + ident2! + | ] +; + +value rec ident3 = + lexer + [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | + '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' | '\128'-'\255' ] ident3! + | ] +; + +value binary = lexer [ '0' | '1' ]; +value octal = lexer [ '0'-'7' ]; +value decimal = lexer [ '0'-'9' ]; +value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; + +value end_integer = + lexer + [ "l"/ -> ("INT_l", $buf) + | "L"/ -> ("INT_L", $buf) + | "n"/ -> ("INT_n", $buf) + | -> ("INT", $buf) ] +; + +value rec digits_under kind = + lexer + [ kind (digits_under kind)! + | "_" (digits_under kind)! + | end_integer ] +; + +value digits kind = + lexer + [ kind (digits_under kind)! + | -> raise (Stream.Error "ill-formed integer constant") ] +; + +value rec decimal_digits_under = + lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] +; + +value exponent_part = + lexer + [ [ 'e' | 'E' ] [ '+' | '-' | ] + '0'-'9' ? "ill-formed floating-point constant" + decimal_digits_under! ] +; + +value number = + lexer + [ decimal_digits_under "." decimal_digits_under! exponent_part -> + ("FLOAT", $buf) + | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) + | decimal_digits_under exponent_part -> ("FLOAT", $buf) + | decimal_digits_under end_integer! ] +; + +value rec char_aux ctx bp = + lexer + [ "'"/ + | _ (char_aux ctx bp)! + | -> err ctx (bp, $pos) "char not terminated" ] +; + +value char ctx bp = + lexer + [ "\\" _ (char_aux ctx bp)! + | "\\" -> err ctx (bp, $pos) "char not terminated" + | ?= [ _ '''] _! "'"/ ] +; + +value any ctx buf = + parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } +; + +value rec string ctx bp = + lexer + [ "\""/ + | "\\" (any ctx) (string ctx bp)! + | (any ctx) (string ctx bp)! + | -> err ctx (bp, $pos) "string not terminated" ] +; + +value rec qstring ctx bp = + lexer + [ "`"/ + | (any ctx) (qstring ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value comment ctx bp = + comment where rec comment = + lexer + [ "*)" + | "*" comment! + | "(*" comment! comment! + | "(" comment! + | "\"" (string ctx bp)! [ -> $add "\"" ] comment! + | "'" (char ctx bp) comment! + | "'" comment! + | (any ctx) comment! + | -> err ctx (bp, $pos) "comment not terminated" ] +; + +value rec quotation ctx bp = + lexer + [ ">>"/ + | ">" (quotation ctx bp)! + | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! (quotation ctx bp)! + | "<" (quotation ctx bp)! + | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! + | "\\" (quotation ctx bp)! + | (any ctx) (quotation ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value less ctx bp buf strm = + if no_quotations.val then + match strm with lexer + [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] + else + match strm with lexer + [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) + | ":"/ ident! [ -> $add ":" ]! "<"/ ? "character '<' expected" + (quotation ctx bp) -> + ("QUOTATION", $buf) + | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec antiquot_rest ctx bp = + lexer + [ "$"/ + | "\\"/ (any ctx) (antiquot_rest ctx bp)! + | (any ctx) (antiquot_rest ctx bp)! + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value rec antiquot ctx bp = + lexer + [ "$"/ -> ":" ^ $buf + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '_' ] (antiquot ctx bp)! + | ":" (antiquot_rest ctx bp)! -> $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; + +value rec antiquot_loc ctx bp = + lexer + [ "$"/ -> antiloc bp $pos (":" ^ $buf) + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '_' ] (antiquot_loc ctx bp)! + | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value dollar ctx bp buf strm = + if ctx.dollar_for_antiquotation then + ("ANTIQUOT", antiquot ctx bp buf strm) + else if force_antiquot_loc.val then + ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) + else + match strm with lexer + [ [ -> $add "$" ] ident2! -> ("", $buf) ] +; + +(* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?abc:d ?abc + ?$abc:d$: ?abc:d: ?abc: + ?$d$ ?:d ? + ?$d$: ?:d: ?: +*) + +(* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?8,13:abc:d ?abc + ?$abc:d$: ?8,13:abc:d: ?abc: + ?$d$ ?8,9::d ? + ?$d$: ?8,9::d: ?: +*) + +value question ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "?" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "?" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tilde ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "~" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "~" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tildeident = + lexer + [ ":"/ -> ("TILDEIDENTCOLON", $buf) + | -> ("TILDEIDENT", $buf) ] +; + +value questionident = + lexer + [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) + | -> ("QUESTIONIDENT", $buf) ] +; + +value rec linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] +and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] +and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] +; + +value rec any_to_nl = + lexer + [ "\r" | "\n" + | _ any_to_nl! + | ] +; + +value next_token_after_spaces ctx bp = + lexer + [ 'A'-'Z' ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] + *********) + | [ 'a'-'z' | '_' | '\128'-'\255' ] ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] + *********) + | '1'-'9' number! + | "0" [ 'o' | 'O' ] (digits octal)! + | "0" [ 'x' | 'X' ] (digits hexa)! + | "0" [ 'b' | 'B' ] (digits binary)! + | "0" number! + | "'"/ (char ctx bp) -> ("CHAR", $buf) + | "'" -> keyword_or_error ctx (bp, $pos) "'" + | "\""/ (string ctx bp)! -> ("STRING", $buf) +(*** Line added by JRH ***) + | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) + | "$"/ (dollar ctx bp)! + | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> + keyword_or_error ctx (bp, $pos) $buf + | "~"/ 'a'-'z' ident! tildeident! + | "~" (tilde ctx bp) + | "?"/ 'a'-'z' ident! questionident! + | "?" (question ctx bp)! + | "<"/ (less ctx bp)! + | ":]" -> keyword_or_error ctx (bp, $pos) $buf + | "::" -> keyword_or_error ctx (bp, $pos) $buf + | ":=" -> keyword_or_error ctx (bp, $pos) $buf + | ":>" -> keyword_or_error ctx (bp, $pos) $buf + | ":" -> keyword_or_error ctx (bp, $pos) $buf + | ">]" -> keyword_or_error ctx (bp, $pos) $buf + | ">}" -> keyword_or_error ctx (bp, $pos) $buf + | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "|]" -> keyword_or_error ctx (bp, $pos) $buf + | "|}" -> keyword_or_error ctx (bp, $pos) $buf + | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "[|" -> keyword_or_error ctx (bp, $pos) $buf + | "[<" -> keyword_or_error ctx (bp, $pos) $buf + | "[:" -> keyword_or_error ctx (bp, $pos) $buf + | "[" -> keyword_or_error ctx (bp, $pos) $buf + | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "{|" -> keyword_or_error ctx (bp, $pos) $buf + | "{<" -> keyword_or_error ctx (bp, $pos) $buf + | "{:" -> keyword_or_error ctx (bp, $pos) $buf + | "{" -> keyword_or_error ctx (bp, $pos) $buf + | ".." -> keyword_or_error ctx (bp, $pos) ".." + | "." -> + let id = + if ctx.specific_space_dot && ctx.after_space then " ." else "." + in + keyword_or_error ctx (bp, $pos) id + | ";;" -> keyword_or_error ctx (bp, $pos) ";;" + | ";" -> keyword_or_error ctx (bp, $pos) ";" + | "\\"/ ident3! -> ("LIDENT", $buf) + | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec next_token ctx buf = + parser bp + [ [: `('\n' | '\r' as c); s :] ep -> do { + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := ep; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> + if linedir 1 s then do { + let buf = any_to_nl ($add '#') s in + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := Stream.count s; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + else + let loc = ctx.make_lined_loc (bp, bp + 1) $buf in + (keyword_or_error ctx (bp, bp + 1) "#", loc) + | [: `'('; + a = + parser + [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + | [: :] ep -> + let loc = ctx.make_lined_loc (bp, ep) $buf in + (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a + | [: tok = next_token_after_spaces ctx bp $empty :] ep -> + let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) $buf in + (tok, loc) + | [: _ = Stream.empty :] -> + let loc = ctx.make_lined_loc (bp, bp + 1) $buf in + (("EOI", ""), loc) ] +; + +value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = + try do { + match Plexing.restore_lexing_info.val with + [ Some (line_nb, bol_pos) -> do { + s_line_nb.val := line_nb; + s_bol_pos.val := bol_pos; + Plexing.restore_lexing_info.val := None + } + | None -> () ]; + Plexing.line_nb.val := s_line_nb; + Plexing.bol_pos.val := s_bol_pos; + let comm_bp = Stream.count cstrm in + ctx.set_line_nb (); + ctx.after_space := False; + let (r, loc) = next_token ctx $empty cstrm in + match glexr.val.Plexing.tok_comm with + [ Some list -> + if Ploc.first_pos loc > comm_bp then + let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in + glexr.val.Plexing.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (r, loc) + } + with + [ Stream.Error str -> + err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + +value func kwd_table glexr = + let ctx = + let line_nb = ref 0 in + let bol_pos = ref 0 in + {after_space = False; + dollar_for_antiquotation = dollar_for_antiquotation.val; + specific_space_dot = specific_space_dot.val; + find_kwd = Hashtbl.find kwd_table; + line_cnt bp1 c = + match c with + [ '\n' | '\r' -> do { + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := bp1 + 1; + } + | c -> () ]; + set_line_nb () = do { + line_nb.val := Plexing.line_nb.val.val; + bol_pos.val := Plexing.bol_pos.val.val; + }; + make_lined_loc loc comm = + Ploc.make line_nb.val bol_pos.val loc} + in + Plexing.lexer_func_of_parser (next_token_fun ctx glexr) +; + +value rec check_keyword_stream = + parser [: _ = check $empty; _ = Stream.empty :] -> True +and check = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '\128'-'\255' ] check_ident! + | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' ] + check_ident2! + | "$" check_ident2! + | "<" ?= [ ":" | "<" ] + | "<" check_ident2! + | ":]" + | "::" + | ":=" + | ":>" + | ":" + | ">]" + | ">}" + | ">" check_ident2! + | "|]" + | "|}" + | "|" check_ident2! + | "[" ?= [ "<<" | "<:" ] + | "[|" + | "[<" + | "[:" + | "[" + | "{" ?= [ "<<" | "<:" ] + | "{|" + | "{<" + | "{:" + | "{" + | ";;" + | ";" + | _ ] +and check_ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | '\128'-'\255' ] + check_ident! | ] +and check_ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' | ':' | '<' | '>' | '|' ] + check_ident2! | ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Plexing.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Plexing.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (Hashtbl.mem kwd_table p_prm) then + if check_keyword p_prm then + if Hashtbl.mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | + "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | + "CHAR" | "STRING" | "QUOTATION" | + "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> + () + | _ -> + raise + (Plexing.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT", s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value after_colon_except_last e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 2) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then + if p_prm.[String.length p_prm - 1] = ':' then + let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + if eq_before_colon p_prm prm then after_colon_except_last prm + else raise Stream.Failure + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + raise Stream.Failure + else if eq_before_colon p_prm prm then after_colon prm + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Plexing.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {Plexing.tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_declaration; + Grammar.Unsafe.clear_entry constructor_declaration; + Grammar.Unsafe.clear_entry match_case; + Grammar.Unsafe.clear_entry with_constr; + Grammar.Unsafe.clear_entry poly_variant; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value neg_string n = + let len = String.length n in + if len > 0 && n.[0] = '-' then String.sub n 1 (len - 1) else "-" ^ n +; + +value mkumin loc f arg = + match arg with + [ <:expr< $int:n$ >> -> <:expr< $int:neg_string n$ >> + | <:expr< $flo:n$ >> -> <:expr< $flo:neg_string n$ >> + | _ -> + let f = "~" ^ f in + <:expr< $lid:f$ $arg$ >> ] +; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc + in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc + in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = do { + let ct = Hashtbl.create 73 in + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] +}; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +(*** And JRH inserted it in here ***) + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> do { + Stream.junk strm; + Stream.junk strm; + translate_operator s + } + | _ -> raise Stream.Failure ]) +; + +value check_not_part_of_patt = + Grammar.Entry.of_parser gram "check_not_part_of_patt" + (fun strm -> + let tok = + match Stream.npeek 4 strm with + [ [("LIDENT", _); tok :: _] -> tok + | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok + | _ -> raise Stream.Failure ] + in + match tok with + [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure + | _ -> () ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + loop where rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"; "?!"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("ANTIQUOT_LOC", _) -> () + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | _ -> 1 ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = s) tpl; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if mem_tvar s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if mem_tvar v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type + class_expr class_sig_item class_str_item let_binding type_declaration + constructor_declaration match_case with_constr poly_variant; + module_expr: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; + "->"; me = SELF -> + <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> + | "struct"; st = V (LIST0 [ s = str_item; OPT ";;" -> s ]); "end" -> + <:module_expr< struct $_list:st$ end >> ] + | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> + <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> + <:str_item< module $_flag:r$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:str_item< module type $_uid:i$ = $mt$ >> + | "open"; i = V mod_ident "list" "" -> + <:str_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_declaration SEP "and") -> + <:str_item< type $_list:tdl$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr -> + let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> + match l with + [ <:vala< [(p, e)] >> -> + match p with + [ <:patt< _ >> -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> + <:str_item< let module $_uid:m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = V mod_ident "list" -> sl + | -> <:vala< [] >> ] ] + ; + mod_binding: + [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] + ; + mod_fun_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; + mt = SELF -> + <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> + <:module_type< $mt$ with $_list:wcl$ >> ] + | [ "sig"; sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]); "end" -> + <:module_type< sig $_list:sg$ end >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = V UIDENT -> <:module_type< $_uid:m$ >> + | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration -> + <:sig_item< exception $_uid:c$ of $_list:tl$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; mt = module_type -> + <:sig_item< include $mt$ >> + | "module"; rf = V (FLAG "rec"); + l = V (LIST1 mod_decl_binding SEP "and") -> + <:sig_item< module $_flag:rf$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:sig_item< module type $_uid:i$ = $mt$ >> + | "module"; "type"; i = V UIDENT "uid" "" -> + <:sig_item< module type $_uid:i$ = 'abstract >> + | "open"; i = V mod_ident "list" "" -> + <:sig_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_declaration SEP "and") -> + <:sig_item< type $_list:tdl$ >> + | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> + <:sig_item< value $_lid:i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $lid:i$ : $t$ >> ] ] + ; + mod_decl_binding: + [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; + pf = V (FLAG "private"); t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> + | "module"; i = V mod_ident ""; "="; me = module_expr -> + <:with_constr< module $_:i$ = $me$ >> ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 + | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] + | "expr1" + [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr LEVEL "top" -> + <:expr< let $_flag:o$ $_list:l$ in $x$ >> + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $_uid:m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< fun [ $_list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; e = fun_def -> + <:expr< fun [$p$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; + l = V (LIST1 match_case SEP "|") -> + <:expr< match $e$ with [ $_list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< try $e$ with [ $_list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; + e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; + e2 = SELF; "do"; e = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e in + <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> + | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e2 in + <:expr< while $e1$ do { $_list:el$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> + | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + let (e1, e2) = + if is_expr_constr_call e1 then + match e1 with + [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) + | _ -> (e1, e2) ] + else (e1, e2) + in + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> <:expr< assert $e$ >> + | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e = SELF; "."; "{"; el = V (LIST1 expr SEP ","); "}" -> + <:expr< $e$ .{ $_list:el$ } >> + | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val>> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = V INT -> <:expr< $_int:s$ >> + | s = V INT_l -> <:expr< $_int32:s$ >> + | s = V INT_L -> <:expr< $_int64:s$ >> + | s = V INT_n -> <:expr< $_nativeint:s$ >> + | s = V FLOAT -> <:expr< $_flo:s$ >> + | s = V STRING -> <:expr< $_str:s$ >> + | c = V CHAR -> <:expr< $_chr:c$ >> + | UIDENT "True" -> <:expr< $uid:" True"$ >> + | UIDENT "False" -> <:expr< $uid:" False"$ >> + | i = expr_ident -> i + | "false" -> <:expr< False >> + | "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = V expr1_semi_list "list"; "|]" -> + <:expr< [| $_list:el$ |] >> + | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> + <:expr< { $_list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> + <:expr< { ($e$) with $_list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> <:expr< $e$ >> + | "begin"; e = SELF; "end" -> <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_expr_quotation loc x ] ] + ; + e_phony: + [ [ -> raise Stream.Failure ] ] + ; + let_binding: + [ [ p = val_ident; e = fun_binding -> (p, e) + | p = patt; "="; e = expr -> (p, e) ] ] + ; +(*** JRH added the "translate_operator" here ***) + + val_ident: + [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> + | check_not_part_of_patt; "("; s = ANY; ")" -> + let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] + | e = expr LEVEL "expr1"; ";" -> [e] + | e = expr LEVEL "expr1" -> [e] ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "->"; e = expr -> <:expr< $e$ >> ] ] + ; + expr_ident: + [ RIGHTA + [ i = V LIDENT -> <:expr< $_lid:i$ >> + | i = V UIDENT -> <:expr< $_uid:i$ >> + | i = V UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $_uid:i$ >> j + | i = V UIDENT; "."; "("; j = operator_rparen -> + <:expr< $_uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + let (p1, p2) = + match p1 with + [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) + | _ -> (p1, p2) ] + in + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = V LIDENT -> <:patt< $_lid:s$ >> + | s = V UIDENT -> <:patt< $_uid:s$ >> + | s = V INT -> <:patt< $_int:s$ >> + | s = V INT_l -> <:patt< $_int32:s$ >> + | s = V INT_L -> <:patt< $_int64:s$ >> + | s = V INT_n -> <:patt< $_nativeint:s$ >> + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = V FLOAT -> <:patt< $_flo:s$ >> + | s = V STRING -> <:patt< $_str:s$ >> + | s = V CHAR -> <:patt< $_chr:s$ >> + | UIDENT "True" -> <:patt< $uid:" True"$ >> + | UIDENT "False" -> <:patt< $uid:" False"$ >> + | "false" -> <:patt< False >> + | "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = V patt_semi_list "list"; "|]" -> + <:patt< [| $_list:pl$ |] >> + | "{"; lpl = V lbl_patt_list "list"; "}" -> + <:patt< { $_list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "_" -> <:patt< _ >> + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_patt_quotation loc x ] ] + ; + p_phony: + [ [ -> raise Stream.Failure ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_declaration: + [ [ tpl = type_parameters; n = type_patt; "="; pf = V (FLAG "private"); + tk = type_kind; cl = V (LIST0 constrain) -> + {MLast.tdNam = n; MLast.tdPrm = <:vala< tpl >>; + MLast.tdPrv = pf; MLast.tdDef = tk; MLast.tdCon = cl} + | tpl = type_parameters; n = type_patt; cl = V (LIST0 constrain) -> + {MLast.tdNam = n; MLast.tdPrm = <:vala< tpl >>; + MLast.tdPrv = <:vala< False >>; + MLast.tdDef = <:ctyp< '$choose_tvar tpl$ >>; MLast.tdCon = cl} ] ] + ; + type_patt: + [ [ n = V LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> + <:ctyp< $t$ >> + | t = ctyp; "="; "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< $t$ == { $_list:ldl$ } >> + | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == [ $list:cdl$ ] >> + | "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< { $_list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "'"; i = V ident "" -> (i, (False, False)) + | "+"; "'"; i = V ident "" -> (i, (True, False)) + | "-"; "'"; i = V ident "" -> (i, (False, True)) ] ] + ; + constructor_declaration: + [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + (loc, ci, cal) + | ci = cons_ident -> (loc, ci, <:vala< [] >>) ] ] + ; + cons_ident: + [ [ i = V UIDENT "uid" "" -> i + | UIDENT "True" -> <:vala< " True" >> + | UIDENT "False" -> <:vala< " False" >> ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "apply" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> + | "_" -> <:ctyp< _ >> + | i = V LIDENT -> <:ctyp< $_lid:i$ >> + | i = V UIDENT -> <:ctyp< $_uid:i$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> + <:str_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:str_item< class type $_list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = V (LIST1 class_description SEP "and") -> + <:sig_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:sig_item< class type $_list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, <:vala< [] >>) + | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); + "in"; ce = SELF -> + <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< $list:ci$ [ $ct$ ] >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:class_expr< object $_opt:cspo$ $_list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> + <:class_str_item< inherit $ce$ $_opt:pb$ >> + | "val"; mf = V (FLAG "mutable"); lab = V label "lid" ""; + e = cvalue_binding -> + <:class_str_item< value $_flag:mf$ $_lid:lab$ = $e$ >> + | "method"; "private"; "virtual"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_str_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V label "lid" ""; ":"; t = poly_type; "="; + e = expr -> + <:class_str_item< method private $_lid:l$ : $t$ = $e$ >> + | "method"; "private"; l = V label "lid" ""; sb = fun_binding -> + <:class_str_item< method private $_lid:l$ = $sb$ >> + | "method"; l = V label "lid" ""; ":"; t = poly_type; "="; e = expr -> + <:class_str_item< method $_lid:l$ : $t$ = $e$ >> + | "method"; l = V label "lid" ""; sb = fun_binding -> + <:class_str_item< method $_lid:l$ = $sb$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> + <:class_type< $list:id$ [ $list:tl$ ] >> + | id = clty_longident -> <:class_type< $list:id$ >> + | "object"; cst = V (OPT class_self_type); + csf = V (LIST0 class_sig_item); "end" -> + <:class_type< object $_opt:cst$ $_list:csf$ end >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> + <:class_sig_item< inherit $cs$ >> + | "val"; mf = V (FLAG "mutable"); l = V label "lid" ""; ":"; t = ctyp -> + <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> + | "method"; "private"; "virtual"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method private $_lid:l$ : $t$ >> + | "method"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method $_lid:l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + ":"; ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + "="; cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = V label "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = V field_expr_list "list"; ">}" -> + <:expr< {< $_list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = V class_longident "list" -> + <:ctyp< # $_list:id$ >> + | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> + <:ctyp< < $_list:ml$ $_flag:v$ > >> + | "<"; ".."; ">" -> + <:ctyp< < .. > >> + | "<"; ">" -> + <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; ml = SELF -> [f :: ml] + | f = field; ";" -> [f] + | f = field -> [f] ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + clty_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: AFTER "arrow" + [ NONA + [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> + | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> + | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ = $_list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ > $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ < $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; + ntl = V (LIST1 name_tag); "]" -> + <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] + ; + poly_variant: + [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> + | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); + l = V (LIST1 ctyp SEP "&") -> + <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> + | t = ctyp -> MLast.PvInh t ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~$_:i$: $e$ >> + | i = V TILDEIDENT -> <:expr< ~$_:i$ >> + | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?$_:i$: $e$ >> + | i = V QUESTIONIDENT -> <:expr< ?$_:i$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> + | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> + | p = labeled_patt -> p ] ] + ; + labeled_patt: + [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> + <:patt< ~$_:i$: $p$ >> + | i = V TILDEIDENT -> + <:patt< ~$_:i$ >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~$i$ >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~$i$: ($lid:i$ : $t$) >> + | i = V QUESTIONIDENTCOLON; j = LIDENT -> + <:patt< ?$_:i$: ($lid:j$) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> + <:patt< ?$_:i$: ( $p$ = $e$ ) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ?$_:i$: ( $p$ : $t$ ) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ?$_:i$: ( $p$ : $t$ = $e$ ) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> + <:patt< ?$_:i$: ( $p$ ) >> + | i = V QUESTIONIDENT -> <:patt< ?$_:i$ >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ = $e$ ) >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ?$i$ >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ? ( $lid:i$ : $t$ ) >> ] ] + ; + class_type: + [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ~$i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_fun_def: + [ [ p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $lid:n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> + <:str_item< # $lid:n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH *** *) +(* ------------------------------------------------------------------------- *) + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.07.ml b/pa_j_3.07.ml new file mode 100644 index 0000000..96bdafc --- /dev/null +++ b/pa_j_3.07.ml @@ -0,0 +1,2409 @@ +(* camlp4r pa_extend.cmo q_MLast.cmo *) +(***********************************************************************) +(* *) +(* Camlp4 *) +(* *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id: pa_o.ml,v 1.54 2003/09/30 14:39:38 mauny Exp $ *) + +open Stdpp; +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* Hacked version of the lexer. *) +(* ------------------------------------------------------------------------- *) + +open Token; + +value jrh_lexer = ref False; + +value no_quotations = ref False; + +(* The string buffering machinery *) + +value buff = ref (String.create 80); +value store len x = + do { + if len >= String.length buff.val then + buff.val := buff.val ^ String.create (String.length buff.val) + else (); + buff.val.[len] := x; + succ len + } +; +value mstore len s = + add_rec len 0 where rec add_rec len i = + if i == String.length s then len else add_rec (store len s.[i]) (succ i) +; +value get_buff len = String.sub buff.val 0 len; + +(* The lexer *) + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value rec ident len = + parser + [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '0'..'9' | '_' | ''' as + c) + ; + s :] -> + ident (store len c) s + | [: :] -> len ] +and ident2 len = + parser + [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' as + c) + ; + s :] -> + ident2 (store len c) s + | [: :] -> len ] +and ident3 len = + parser + [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | + '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' as + c) + ; + s :] -> + ident3 (store len c) s + | [: :] -> len ] +and base_number len = + parser + [ [: `'o' | 'O'; s :] -> digits octal (store len 'o') s + | [: `'x' | 'X'; s :] -> digits hexa (store len 'x') s + | [: `'b' | 'B'; s :] -> digits binary (store len 'b') s + | [: a = number len :] -> a ] +and digits kind len = + parser + [ [: d = kind; s :] -> digits_under kind (store len d) s + | [: :] -> raise (Stream.Error "ill-formed integer constant") ] +and digits_under kind len = + parser + [ [: d = kind; s :] -> digits_under kind (store len d) s + | [: `'_'; s :] -> digits_under kind len s + | [: :] -> ("INT", get_buff len) ] +and octal = parser [ [: `('0'..'7' as d) :] -> d ] +and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ] +and binary = parser [ [: `('0'..'1' as d) :] -> d ] +and number len = + parser + [ [: `('0'..'9' as c); s :] -> number (store len c) s + | [: `'_'; s :] -> number len s + | [: `'.'; s :] -> decimal_part (store len '.') s + | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s + | [: `'l' :] -> ("INT32", get_buff len) + | [: `'L' :] -> ("INT64", get_buff len) + | [: `'n' :] -> ("NATIVEINT", get_buff len) + | [: :] -> ("INT", get_buff len) ] +and decimal_part len = + parser + [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s + | [: `'_'; s :] -> decimal_part len s + | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s + | [: :] -> ("FLOAT", get_buff len) ] +and exponent_part len = + parser + [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s + | [: a = end_exponent_part len :] -> a ] +and end_exponent_part len = + parser + [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s + | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] +and end_exponent_part_under len = + parser + [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s + | [: `'_'; s :] -> end_exponent_part_under len s + | [: :] -> ("FLOAT", get_buff len) ] +; + +value error_on_unknown_keywords = ref False; +value err loc msg = raise_with_loc loc (Token.Error msg); + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +(* +value next_token_fun dfa find_kwd = + let keyword_or_error loc s = + try (("", find_kwd s), loc) with + [ Not_found -> + if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) + else (("", s), loc) ] + in + let rec next_token = + parser bp + [ [: `' ' | '\010' | '\013' | '\t' | '\026' | '\012'; s :] -> + next_token s + | [: `'('; s :] -> left_paren bp s + | [: `'#'; s :] -> do { spaces_tabs s; linenum bp s } + | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = (bp, Stream.count s) in + (jrh_identifier find_kwd id, loc) + +(********** original + (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) + ***********) + + + | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = (bp, Stream.count s) in + (jrh_identifier find_kwd id, loc) + +(********** original + (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) + **********) + + | [: `('1'..'9' as c); s :] -> + let tok = number (store 0 c) s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'0'; s :] -> + let tok = base_number (store 0 '0') s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'''; s :] -> + match Stream.npeek 3 s with + [ [_; '''; _] | ['\\'; _; _] | ['\x0D'; '\x0A'; '''] -> + let tok = ("CHAR", get_buff (char bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | _ -> keyword_or_error (bp, Stream.count s) "'" ] + | [: `'"'; s :] -> + let tok = ("STRING", get_buff (string bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'`'; s :] -> + let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'$'; s :] -> + let tok = dollar bp 0 s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); + s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id + | [: `('~' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep -> + (("TILDEIDENT", get_buff len), (bp, ep)) + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `('?' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c) :] ep -> + (("QUESTIONIDENT", get_buff len), (bp, ep)) + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `'<'; s :] -> less bp s + | [: `(':' as c1); + len = + parser + [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('>' | '|' as c1); + len = + parser + [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 + | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('[' | '{' as c1); s :] -> + let len = + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> store 0 c1 + | _ -> + match s with parser + [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] ] + in + let ep = Stream.count s in + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `'.'; + id = + parser + [ [: `'.' :] -> ".." + | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> + keyword_or_error (bp, ep) id + | [: `';'; + id = + parser + [ [: `';' :] -> ";;" + | [: :] -> ";" ] :] ep -> + keyword_or_error (bp, ep) id + | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep)) + | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) + | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ] + and less bp strm = + if no_quotations.val then + match strm with parser + [ [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + else + match strm with parser + [ [: `'<'; len = quotation bp 0 :] ep -> + (("QUOTATION", ":" ^ get_buff len), (bp, ep)) + | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; + `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> + (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep)) + | [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + and string bp len = + parser + [ [: `'"' :] -> len + | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s + | [: `c; s :] -> string bp (store len c) s + | [: :] ep -> err (bp, ep) "string not terminated" ] + and qstring bp len = + parser + [ [: `'`' :] -> get_buff len + | [: `c; s :] -> qstring bp (store len c) s + | [: :] ep -> err (bp, ep) "quotation not terminated" ] + and char bp len = + parser + [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len + | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s + | [: `c; s :] -> char bp (store len c) s + | [: :] ep -> err (bp, ep) "char not terminated" ] + and dollar bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: s :] -> + if dfa then + match s with parser + [ [: `c :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + else ("", get_buff (ident2 (store 0 '$') s)) ] + and maybe_locate bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and antiquot bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> + antiquot bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and locate_or_antiquot_rest bp len = + parser + [ [: `'$' :] -> get_buff len + | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and quotation bp len = + parser + [ [: `'>'; s :] -> maybe_end_quotation bp len s + | [: `'<'; s :] -> + quotation bp (maybe_nested_quotation bp (store len '<') s) s + | [: `'\\'; + len = + parser + [ [: `('>' | '<' | '\\' as c) :] -> store len c + | [: :] -> store len '\\' ]; + s :] -> + quotation bp len s + | [: `c; s :] -> quotation bp (store len c) s + | [: :] ep -> err (bp, ep) "quotation not terminated" ] + and maybe_nested_quotation bp len = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: `':'; len = ident (store len ':'); + a = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: :] -> len ] :] -> + a + | [: :] -> len ] + and maybe_end_quotation bp len = + parser + [ [: `'>' :] -> len + | [: a = quotation bp (store len '>') :] -> a ] + and left_paren bp = + parser + [ [: `'*'; _ = comment bp; a = next_token True :] -> a + | [: :] ep -> keyword_or_error (bp, ep) "(" ] + and comment bp = + parser + [ [: `'('; s :] -> left_paren_in_comment bp s + | [: `'*'; s :] -> star_in_comment bp s + | [: `'"'; _ = string bp 0; s :] -> comment bp s + | [: `'''; s :] -> quote_in_comment bp s + | [: `c; s :] -> comment bp s + | [: :] ep -> err (bp, ep) "comment not terminated" ] + and quote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\013'; s :] -> quote_cr_in_comment bp s + | [: `'\\'; s :] -> quote_antislash_in_comment bp s + | [: `'('; s :] -> quote_left_paren_in_comment bp s + | [: `'*'; s :] -> quote_star_in_comment bp s + | [: `'"'; s :] -> quote_doublequote_in_comment bp s + | [: `_; s :] -> quote_any_in_comment bp s + | [: s :] -> comment bp s ] + and quote_any_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> comment bp s ] + and quote_cr_in_comment bp = + parser + [ [: `'\010'; s :] -> quote_any_in_comment bp s + | [: s :] -> quote_any_in_comment bp s ] + and quote_left_paren_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> left_paren_in_comment bp s ] + and quote_star_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> star_in_comment bp s ] + and quote_doublequote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: _ = string bp 0; s :] -> comment bp s ] + and quote_antislash_in_comment bp = + parser + [ [: `'''; s :] -> quote_antislash_quote_in_comment bp s + | [: `('\\' | '"' | 'n' | 't' | 'b' | 'r'); s :] -> + quote_any_in_comment bp s + | [: `('0'..'9'); s :] -> quote_antislash_digit_in_comment bp s + | [: `'x'; s :] -> quote_antislash_x_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_quote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: s :] -> quote_in_comment bp s ] + and quote_antislash_digit_in_comment bp = + parser + [ [: `('0'..'9'); s :] -> quote_antislash_digit2_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_digit2_in_comment bp = + parser + [ [: `('0'..'9'); s :] -> quote_any_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_x_in_comment bp = + parser + [ [: _ = hexa; s :] -> quote_antislash_x_digit_in_comment bp s + | [: s :] -> comment bp s ] + and quote_antislash_x_digit_in_comment bp = + parser + [ [: _ = hexa; s :] -> quote_any_in_comment bp s + | [: s :] -> comment bp s ] + and left_paren_in_comment bp = + parser + [ [: `'*'; s :] -> do { comment bp s; comment bp s } + | [: a = comment bp :] -> a ] + and star_in_comment bp = + parser + [ [: `')' :] -> () + | [: a = comment bp :] -> a ] + and linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] + and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] + and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] + and any_to_nl = + parser + [ [: `'\013' | '\010' :] ep -> bolpos.val := ep + | [: `_; s :] -> any_to_nl s + | [: :] -> () ] + in + fun cstrm -> + try + let glex = glexr.val in + let comm_bp = Stream.count cstrm in + let r = next_token False cstrm in + do { + match glex.tok_comm with + [ Some list -> + if fst (snd r) > comm_bp then + let comm_loc = (comm_bp, fst (snd r)) in + glex.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + r + } + with + [ Stream.Error str -> + err (Stream.count cstrm, Stream.count cstrm + 1) str ] +; +*) + +value next_token_fun dfa ssd find_kwd bolpos glexr = + let keyword_or_error loc s = + try (("", find_kwd s), loc) with + [ Not_found -> + if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) + else (("", s), loc) ] in + let error_if_keyword ( ((_,id), loc) as a) = + try do { + ignore(find_kwd id); + err loc ("illegal use of a keyword as a label: " ^ id) } + with [ Not_found -> a ] + in + let rec next_token after_space = + parser bp + [ [: `'\010' | '\013'; s :] ep -> + do { bolpos.val := ep; next_token True s } + | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s + | [: `'#' when bp = bolpos.val; s :] -> + if linedir 1 s then do { any_to_nl s; next_token True s } + else keyword_or_error (bp, bp + 1) "#" + | [: `'('; s :] -> left_paren bp s + | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = (bp, Stream.count s) in + (jrh_identifier find_kwd id, loc) + +(********** original + (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) + ***********) + + | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = (bp, Stream.count s) in + (jrh_identifier find_kwd id, loc) + +(********** original + (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) + **********) + + | [: `('1'..'9' as c); s :] -> + let tok = number (store 0 c) s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'0'; s :] -> + let tok = base_number (store 0 '0') s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'''; s :] -> + match Stream.npeek 2 s with + [ [_; '''] | ['\\'; _] -> + let tok = ("CHAR", get_buff (char bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | _ -> keyword_or_error (bp, Stream.count s) "'" ] + | [: `'"'; s :] -> + let tok = ("STRING", get_buff (string bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'`'; s :] -> + let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `'$'; s :] -> + let tok = dollar bp 0 s in + let loc = (bp, Stream.count s) in + (tok, loc) + | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); + s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id + | [: `('~' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> + let id = get_buff len in + match s with parser + [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp,ep)) + | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ] + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + + | [: `('?' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> + let id = get_buff len in + match s with parser + [ [: `':' :] eb -> error_if_keyword (("OPTLABEL", id), (bp,ep)) + | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ] + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `'<'; s :] -> less bp s + | [: `(':' as c1); + len = + parser + [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('>' | '|' as c1); + len = + parser + [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 + | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('[' | '{' as c1); s :] -> + let len = + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> store 0 c1 + | _ -> + match s with parser + [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] ] + in + let ep = Stream.count s in + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `'.'; + id = + parser + [ [: `'.' :] -> ".." + | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> + keyword_or_error (bp, ep) id + | [: `';'; + id = + parser + [ [: `';' :] -> ";;" + | [: :] -> ";" ] :] ep -> + keyword_or_error (bp, ep) id + | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), (bp, ep)) + | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) + | [: _ = Stream.empty :] -> (("EOI", ""), (bp, succ bp)) ] + and less bp strm = + if no_quotations.val then + match strm with parser + [ [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + else + match strm with parser + [ [: `'<'; len = quotation bp 0 :] ep -> + (("QUOTATION", ":" ^ get_buff len), (bp, ep)) + | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; + `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> + (("QUOTATION", i ^ ":" ^ get_buff len), (bp, ep)) + | [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + and string bp len = + parser + [ [: `'"' :] -> len + | [: `'\\'; `c; s :] -> string bp (store (store len '\\') c) s + | [: `c; s :] -> string bp (store len c) s + | [: :] ep -> err (bp, ep) "string not terminated" ] + and qstring bp len = + parser + [ [: `'`' :] -> get_buff len + | [: `c; s :] -> qstring bp (store len c) s + | [: :] ep -> err (bp, ep) "quotation not terminated" ] + and char bp len = + parser + [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len + | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s + | [: `c; s :] -> char bp (store len c) s + | [: :] ep -> err (bp, ep) "char not terminated" ] + and dollar bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: s :] -> + if dfa then + match s with parser + [ [: `c :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + else ("", get_buff (ident2 (store 0 '$') s)) ] + and maybe_locate bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and antiquot bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> + antiquot bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and locate_or_antiquot_rest bp len = + parser + [ [: `'$' :] -> get_buff len + | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: :] ep -> err (bp, ep) "antiquotation not terminated" ] + and quotation bp len = + parser + [ [: `'>'; s :] -> maybe_end_quotation bp len s + | [: `'<'; s :] -> + quotation bp (maybe_nested_quotation bp (store len '<') s) s + | [: `'\\'; + len = + parser + [ [: `('>' | '<' | '\\' as c) :] -> store len c + | [: :] -> store len '\\' ]; + s :] -> + quotation bp len s + | [: `c; s :] -> quotation bp (store len c) s + | [: :] ep -> err (bp, ep) "quotation not terminated" ] + and maybe_nested_quotation bp len = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: `':'; len = ident (store len ':'); + a = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: :] -> len ] :] -> + a + | [: :] -> len ] + and maybe_end_quotation bp len = + parser + [ [: `'>' :] -> len + | [: a = quotation bp (store len '>') :] -> a ] + and left_paren bp = + parser + [ [: `'*'; _ = comment bp; a = next_token True :] -> a + | [: :] ep -> keyword_or_error (bp, ep) "(" ] + and comment bp = + parser + [ [: `'('; s :] -> left_paren_in_comment bp s + | [: `'*'; s :] -> star_in_comment bp s + | [: `'"'; _ = string bp 0; s :] -> comment bp s + | [: `'''; s :] -> quote_in_comment bp s + | [: `c; s :] -> comment bp s + | [: :] ep -> err (bp, ep) "comment not terminated" ] + and quote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\\'; s :] -> quote_antislash_in_comment bp 0 s + | [: s :] -> + do { + match Stream.npeek 2 s with + [ [_; '''] -> do { Stream.junk s; Stream.junk s } + | _ -> () ]; + comment bp s + } ] + and quote_any_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_in_comment bp len = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\\' | '"' | 'n' | 't' | 'b' | 'r'; s :] -> + quote_any_in_comment bp s + | [: `'0'..'9'; s :] -> quote_antislash_digit_in_comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_digit_in_comment bp = + parser + [ [: `'0'..'9'; s :] -> quote_antislash_digit2_in_comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_digit2_in_comment bp = + parser + [ [: `'0'..'9'; s :] -> quote_any_in_comment bp s + | [: a = comment bp :] -> a ] + and left_paren_in_comment bp = + parser + [ [: `'*'; s :] -> do { comment bp s; comment bp s } + | [: a = comment bp :] -> a ] + and star_in_comment bp = + parser + [ [: `')' :] -> () + | [: a = comment bp :] -> a ] + and linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] + and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] + and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] + and any_to_nl = + parser + [ [: `'\013' | '\010' :] ep -> bolpos.val := ep + | [: `_; s :] -> any_to_nl s + | [: :] -> () ] + in + fun cstrm -> + try + let glex = glexr.val in + let comm_bp = Stream.count cstrm in + let r = next_token False cstrm in + do { + match glex.tok_comm with + [ Some list -> + if fst (snd r) > comm_bp then + let comm_loc = (comm_bp, fst (snd r)) in + glex.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + r + } + with + [ Stream.Error str -> + err (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value func kwd_table glexr = + let bolpos = ref 0 in + let find = Hashtbl.find kwd_table in + let dfa = dollar_for_antiquotation.val in + let ssd = specific_space_dot.val in + Token.lexer_func_of_parser (next_token_fun dfa ssd find bolpos glexr) +; + +value rec check_keyword_stream = + parser [: _ = check; _ = Stream.empty :] -> True +and check = + parser + [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' + ; + s :] -> + check_ident s + | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' + ; + s :] -> + check_ident2 s + | [: `'<'; s :] -> + match Stream.npeek 1 s with + [ [':' | '<'] -> () + | _ -> check_ident2 s ] + | [: `':'; + _ = + parser + [ [: `']' | ':' | '=' | '>' :] -> () + | [: :] -> () ] :] ep -> + () + | [: `'>' | '|'; + _ = + parser + [ [: `']' | '}' :] -> () + | [: a = check_ident2 :] -> a ] :] -> + () + | [: `'[' | '{'; s :] -> + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> () + | _ -> + match s with parser + [ [: `'|' | '<' | ':' :] -> () + | [: :] -> () ] ] + | [: `';'; + _ = + parser + [ [: `';' :] -> () + | [: :] -> () ] :] -> + () + | [: `_ :] -> () ] +and check_ident = + parser + [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '0'..'9' | '_' | ''' + ; + s :] -> + check_ident s + | [: :] -> () ] +and check_ident2 = + parser + [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' + ; + s :] -> + check_ident2 s + | [: :] -> () ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Token.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Token.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (Hashtbl.mem kwd_table p_prm) then + if check_keyword p_prm then + if Hashtbl.mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "INT" | "INT32" | "INT64" | "NATIVEINT" + | "FLOAT" | "CHAR" | "STRING" + | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" + | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" -> + () + | _ -> + raise + (Token.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT32", "") -> "32 bits integer" + | ("INT64", "") -> "64 bits integer" + | ("NATIVEINT", "") -> "native integer" + | (("INT" | "INT32" | "NATIVEINT"), s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("LOCATE", "") -> "locate" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Token.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +value tparse = + fun + [ ("ANTIQUOT", p_prm) -> + let p = + parser + [: `("ANTIQUOT", prm) when eq_before_colon p_prm prm :] -> + after_colon prm + in + Some p + | _ -> None ] +; + +value make () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + {func = func kwd_table glexr; using = using_token kwd_table id_table; + removing = removing_token kwd_table id_table; tparse = tparse; text = text} +; + +(* ------------------------------------------------------------------------- *) +(* Resume the main file. *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_declaration; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value o2b = + fun + [ Some _ -> True + | None -> False ] +; + +value mkumin loc f arg = + match (f, arg) with + [ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 -> + let n = "-" ^ n in + <:expr< $int:n$ >> + | ("-", MLast.ExInt32 loc n) when (Int32.of_string n) > 0l -> + MLast.ExInt32 loc ("-" ^ n) + | ("-", MLast.ExInt64 loc n) when (Int64.of_string n) > 0L -> + MLast.ExInt64 loc ("-" ^ n) + | ("-", MLast.ExNativeInt loc n) when (Nativeint.of_string n) > 0n -> + MLast.ExNativeInt loc ("-" ^ n) + | (_, <:expr< $flo:n$ >>) when float_of_string n > 0.0 -> + let n = "-" ^ n in + <:expr< $flo:n$ >> + | _ -> + let f = "~" ^ f in + <:expr< $lid:f$ $arg$ >> ] +; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = if top then loc else (fst (MLast.loc_of_expr e1), snd loc) in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = if top then loc else (fst (MLast.loc_of_patt p1), snd loc) in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = + let ct = Hashtbl.create 73 in + do { + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] + } +; +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +(*** And JRH inserted it in here ***) + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> + do { Stream.junk strm; Stream.junk strm; translate_operator s } + | _ -> raise Stream.Failure ]) +; + +value lident_colon = + Grammar.Entry.of_parser gram "lident_colon" + (fun strm -> + match Stream.npeek 2 strm with + [ [("LIDENT", i); ("", ":")] -> + do { Stream.junk strm; Stream.junk strm; i } + | _ -> raise Stream.Failure ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + let rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False + in + loop +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | <:expr< $e$ $_$ >> -> + if is_expr_constr_call e then + Stdpp.raise_with_loc loc (Stream.Error "currified constructor") + else 1 + | _ -> 1 ] +; + +value rec is_patt_constr_call = + fun + [ <:patt< $uid:_$ >> -> True + | <:patt< $uid:_$.$p$ >> -> is_patt_constr_call p + | <:patt< $p$ $_$ >> -> is_patt_constr_call p + | _ -> False ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | <:patt< $p$ $_$ >> -> + if is_patt_constr_call p then + Stdpp.raise_with_loc loc (Stream.Error "currified constructor") + else 1 + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if List.mem_assoc s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if List.mem_assoc v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value rec patt_lid = + fun + [ <:patt< $p1$ $p2$ >> -> + match p1 with + [ <:patt< $lid:i$ >> -> Some (MLast.loc_of_patt p1, i, [p2]) + | _ -> + match patt_lid p1 with + [ Some (loc, i, pl) -> Some (loc, i, [p2 :: pl]) + | None -> None ] ] + | _ -> None ] +; + +value bigarray_get loc arr arg = + let coords = + match arg with + [ <:expr< ($list:el$) >> -> el + | _ -> [arg] ] + in + match coords with + [ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >> + | [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> + | [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> + | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] +; + +value bigarray_set loc var newval = + match var with + [ <:expr< Bigarray.Array1.get $arr$ $c1$ >> -> + Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >> + | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> -> + Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >> + | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> -> + Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >> + | <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> -> + Some <:expr< Bigarray.Genarray.set $arr$ [| $list:coords$ |] $newval$ >> + | _ -> None ] +; + +(* ...works bad... +value rec sync cs = + match cs with parser + [ [: `';' :] -> sync_semi cs + | [: `_ :] -> sync cs ] +and sync_semi cs = + match cs with parser + [ [: `';' :] -> sync_semisemi cs + | [: :] -> sync cs ] +and sync_semisemi cs = + match Stream.peek cs with + [ Some ('\010' | '\013') -> () + | _ -> sync_semi cs ] +; +Pcaml.sync.val := sync; +*) + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type + class_expr class_sig_item class_str_item let_binding type_declaration; + module_expr: + [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; + me = SELF -> + <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> + | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> + <:module_expr< struct $list:st$ end >> ] + | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> + <:str_item< exception $c$ of $list:tl$ = $b$ >> + | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> + <:str_item< external $i$ : $t$ = $list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = LIST1 STRING -> + <:str_item< external $i$ : $t$ = $list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; i = UIDENT; mb = module_binding -> + <:str_item< module $i$ = $mb$ >> + | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" -> + MLast.StRecMod loc nmtmes + | "module"; "type"; i = UIDENT; "="; mt = module_type -> + <:str_item< module type $i$ = $mt$ >> + | "open"; i = mod_ident -> <:str_item< open $i$ >> + | "type"; tdl = LIST1 type_declaration SEP "and" -> + <:str_item< type $list:tdl$ >> + | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; + x = expr -> + let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> + match l with + [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] + | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> + <:str_item< let module $m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = mod_ident -> sl + | -> [] ] ] + ; + module_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + module_rec_binding: + [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr -> + (m, mt, me) ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> + <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> + <:module_type< $mt$ with $list:wcl$ >> ] + | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> + <:module_type< sig $list:sg$ end >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = UIDENT -> <:module_type< $uid:m$ >> + | m = LIDENT -> <:module_type< $lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration -> + <:sig_item< exception $c$ of $list:tl$ >> + | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> + <:sig_item< external $i$ : $t$ = $list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = LIST1 STRING -> + <:sig_item< external $i$ : $t$ = $list:pd$ >> + | "include"; mt = module_type -> <:sig_item< include $mt$ >> + | "module"; i = UIDENT; mt = module_declaration -> + <:sig_item< module $i$ : $mt$ >> + | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" -> + MLast.SgRecMod loc mds + | "module"; "type"; i = UIDENT; "="; mt = module_type -> + <:sig_item< module type $i$ = $mt$ >> + | "module"; "type"; i = UIDENT -> + <:sig_item< module type $i$ = 'abstract >> + | "open"; i = mod_ident -> <:sig_item< open $i$ >> + | "type"; tdl = LIST1 type_declaration SEP "and" -> + <:sig_item< type $list:tdl$ >> + | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $i$ : $t$ >> ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] + ; + module_rec_declaration: + [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = type_parameters; i = mod_ident; "="; t = ctyp -> + MLast.WcTyp loc i tpl t + | "module"; i = mod_ident; "="; me = module_expr -> + MLast.WcMod loc i me ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 ] + | "expr1" + [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; + x = expr LEVEL "top" -> + <:expr< let $opt:o2b o$ $list:l$ in $x$ >> + | "let"; "module"; m = UIDENT; mb = module_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< fun [ $list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; e = fun_def -> + <:expr< fun [$p$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< match $e$ with [ $list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< try $e$ with [ $list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; + "else"; e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; + "do"; e = SELF; "done" -> + <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> + | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> + <:expr< while $e1$ do { $list:get_seq e2$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> + match bigarray_set loc e1 e2 with + [ Some e -> e + | None -> <:expr< $e1$ := $e2$ >> ] ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; "$"; e2 = SELF -> <:expr< $lid:"\$"$ $e1$ $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> + | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> + match e with + [ <:expr< False >> -> <:expr< assert False >> + | _ -> <:expr< assert ($e$) >> ] + | "lazy"; e = SELF -> + <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e1 = SELF; "."; "{"; e2 = SELF; "}" -> bigarray_get loc e1 e2 + | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val>> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = INT -> <:expr< $int:s$ >> + | s = INT32 -> MLast.ExInt32 loc s + | s = INT64 -> MLast.ExInt64 loc s + | s = NATIVEINT -> MLast.ExNativeInt loc s + | s = FLOAT -> <:expr< $flo:s$ >> + | s = STRING -> <:expr< $str:s$ >> + | c = CHAR -> <:expr< $chr:c$ >> + | UIDENT "True" -> <:expr< $uid:" True"$ >> + | UIDENT "False" -> <:expr< $uid:" False"$ >> + | i = expr_ident -> i + | s = "false" -> <:expr< False >> + | s = "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> + | "{"; test_label_eq; lel = lbl_expr_list; "}" -> + <:expr< { $list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = lbl_expr_list; "}" -> + <:expr< { ($e$) with $list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> <:expr< $e$ >> + | "begin"; e = SELF; "end" -> <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = LOCATE -> + let x = + try + let i = String.index x ':' in + (int_of_string (String.sub x 0 i), + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found | Failure _ -> (0, x) ] + in + Pcaml.handle_expr_locate loc x + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_expr_quotation loc x ] ] + ; + let_binding: + [ [ p = patt; e = fun_binding -> + match patt_lid p with + [ Some (loc, i, pl) -> + let e = + List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl + in + (<:patt< $lid:i$ >>, e) + | None -> (p, e) ] ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] + | e = expr LEVEL "expr1"; ";" -> [e] + | e = expr LEVEL "expr1" -> [e] ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "->"; e = expr -> <:expr< $e$ >> ] ] + ; + expr_ident: + [ RIGHTA + [ i = LIDENT -> <:expr< $lid:i$ >> + | i = UIDENT -> <:expr< $uid:i$ >> + | i = UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $uid:i$ >> j + | i = UIDENT; "."; "("; j = operator_rparen -> + <:expr< $uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = LIDENT -> <:patt< $lid:s$ >> + | s = UIDENT -> <:patt< $uid:s$ >> + | s = INT -> <:patt< $int:s$ >> + | s = INT32 -> MLast.PaInt32 loc s + | s = INT64 -> MLast.PaInt64 loc s + | s = NATIVEINT -> MLast.PaNativeInt loc s + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = INT32 -> MLast.PaInt32 loc ("-" ^ s) + | "-"; s = INT64 -> MLast.PaInt64 loc ("-" ^ s) + | "-"; s = NATIVEINT -> MLast.PaNativeInt loc ("-" ^ s) + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = FLOAT -> <:patt< $flo:s$ >> + | s = STRING -> <:patt< $str:s$ >> + | s = CHAR -> <:patt< $chr:s$ >> + | UIDENT "True" -> <:patt< $uid:" True"$ >> + | UIDENT "False" -> <:patt< $uid:" False"$ >> + | s = "false" -> <:patt< False >> + | s = "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> + | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "_" -> <:patt< _ >> + | x = LOCATE -> + let x = + try + let i = String.index x ':' in + (int_of_string (String.sub x 0 i), + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found | Failure _ -> (0, x) ] + in + Pcaml.handle_patt_locate loc x + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_patt_quotation loc x ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_declaration: + [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; + cl = LIST0 constrain -> + (n, tpl, tk, cl) + | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> + (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] + ; + type_patt: + [ [ n = LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ "private"; "{"; ldl = label_declarations; "}" -> + <:ctyp< private { $list:ldl$ } >> + | "private"; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< private [ $list:cdl$ ] >> + | test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> <:ctyp< $t$ >> + | t = ctyp; "="; "private"; "{"; ldl = label_declarations; "}" -> + <:ctyp< $t$ == private { $list:ldl$ } >> + | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> + <:ctyp< $t$ == { $list:ldl$ } >> + | t = ctyp; "="; "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == private [ $list:cdl$ ] >> + | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == [ $list:cdl$ ] >> + | "{"; ldl = label_declarations; "}" -> + <:ctyp< { $list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "'"; i = ident -> (i, (False, False)) + | "+"; "'"; i = ident -> (i, (True, False)) + | "-"; "'"; i = ident -> (i, (False, True)) ] ] + ; + constructor_declaration: + [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> + (loc, ci, cal) + | ci = UIDENT -> (loc, ci, []) ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "ctyp1") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "ctyp1" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = ident -> <:ctyp< '$i$ >> + | "_" -> <:ctyp< _ >> + | i = LIDENT -> <:ctyp< $lid:i$ >> + | i = UIDENT -> <:ctyp< $uid:i$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = LIST1 class_declaration SEP "and" -> + <:str_item< class $list:cd$ >> + | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> + <:str_item< class type $list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = LIST1 class_description SEP "and" -> + <:sig_item< class $list:cd$ >> + | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> + <:sig_item< class type $list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, []) + | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; + ce = SELF -> + <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< $list:ci$ [ $ct$ ] >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> + <:class_expr< object $opt:cspo$ $list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> + <:class_str_item< inherit $ce$ $opt:pb$ >> + | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> + <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual $l$ : $t$ >> + | "method"; "private"; l = label; ":"; t = poly_type; "="; e = expr -> + MLast.CrMth loc l True e (Some t) + | "method"; "private"; l = label; sb = fun_binding -> + MLast.CrMth loc l True sb None + | "method"; l = label; ":"; t = poly_type; "="; e = expr -> + MLast.CrMth loc l False e (Some t) + | "method"; l = label; sb = fun_binding -> + MLast.CrMth loc l False sb None + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> + <:class_type< $list:id$ [ $list:tl$ ] >> + | id = clty_longident -> <:class_type< $list:id$ >> + | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; + "end" -> + <:class_type< object $opt:cst$ $list:csf$ end >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> + | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> + <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual $l$ : $t$ >> + | "method"; "private"; l = label; ":"; t = poly_type -> + <:class_sig_item< method private $l$ : $t$ >> + | "method"; l = label; ":"; t = poly_type -> + <:class_sig_item< method $l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; + ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; + cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> + | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> + | "<"; ">" -> <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) + | f = field; ";" -> ([f], False) + | f = field -> ([f], False) + | ".." -> ([], True) ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + clty_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: LEVEL "arrow" + [ RIGHTA + [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >> + | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> + | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> + | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ = $list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ > $list:rfl$ ] >> + | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ < $list:rfl$ ] >> + | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; + ntl = LIST1 name_tag; "]" -> + <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] + ; + row_field: + [ [ "`"; i = ident -> MLast.RfTag i True [] + | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> + MLast.RfTag i (o2b ao) l + | t = ctyp -> MLast.RfInh t ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> + | i = TILDEIDENT -> <:expr< ~ $i$ >> + | "~"; i = LIDENT -> <:expr< ~ $i$ >> + | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >> + | i = QUESTIONIDENT -> <:expr< ? $i$ >> + | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = ident -> <:patt< ` $s$ >> + | "#"; t = mod_ident -> <:patt< # $list:t$ >> ] ] + ; + labeled_patt: + [ [ i = LABEL; p = patt LEVEL "simple" -> + <:patt< ~ $i$ : $p$ >> + | i = TILDEIDENT -> + <:patt< ~ $i$ >> + | "~"; i=LIDENT -> <:patt< ~ $i$ >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~ $i$ >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~ $i$ : ($lid:i$ : $t$) >> + | i = OPTLABEL; j = LIDENT -> + <:patt< ? $i$ : ($lid:j$) >> + | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" -> + <:patt< ? $i$ : ( $p$ = $e$ ) >> + | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ? $i$ : ( $p$ : $t$ ) >> + | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >> + | i = QUESTIONIDENT -> <:patt< ? $i$ >> + | "?"; i = LIDENT -> <:patt< ? $i$ >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ = $e$ ) >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ? $i$ >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ? ( $lid:i$ : $t$ ) >> ] ] + ; + class_type: + [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> + | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set Plexer.no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.08.ml b/pa_j_3.08.ml new file mode 100644 index 0000000..d0fa1d0 --- /dev/null +++ b/pa_j_3.08.ml @@ -0,0 +1,2186 @@ +(* camlp4r pa_extend.cmo q_MLast.cmo *) +(***********************************************************************) +(* *) +(* Camlp4 *) +(* *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id: pa_o.ml,v 1.58.2.1 2004/08/18 11:17:37 mauny Exp $ *) + +open Stdpp; +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* Hacked version of the lexer. *) +(* ------------------------------------------------------------------------- *) + +open Token; + +value jrh_lexer = ref False; + +value no_quotations = ref False; + +(* The string buffering machinery *) + +value buff = ref (String.create 80); +value store len x = + do { + if len >= String.length buff.val then + buff.val := buff.val ^ String.create (String.length buff.val) + else (); + buff.val.[len] := x; + succ len + } +; +value mstore len s = + add_rec len 0 where rec add_rec len i = + if i == String.length s then len else add_rec (store len s.[i]) (succ i) +; +value get_buff len = String.sub buff.val 0 len; + +(* The lexer *) + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value rec ident len = + parser + [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '0'..'9' | '_' | ''' as + c) + ; + s :] -> + ident (store len c) s + | [: :] -> len ] +and ident2 len = + parser + [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' as + c) + ; + s :] -> + ident2 (store len c) s + | [: :] -> len ] +and ident3 len = + parser + [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | + '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' as + c) + ; + s :] -> + ident3 (store len c) s + | [: :] -> len ] +and base_number len = + parser + [ [: `'o' | 'O'; s :] -> digits octal (store len 'o') s + | [: `'x' | 'X'; s :] -> digits hexa (store len 'x') s + | [: `'b' | 'B'; s :] -> digits binary (store len 'b') s + | [: a = number len :] -> a ] +and digits kind len = + parser + [ [: d = kind; s :] -> digits_under kind (store len d) s + | [: :] -> raise (Stream.Error "ill-formed integer constant") ] +and digits_under kind len = + parser + [ [: d = kind; s :] -> digits_under kind (store len d) s + | [: `'_'; s :] -> digits_under kind len s + | [: `'l' :] -> ("INT32", get_buff len) + | [: `'L' :] -> ("INT64", get_buff len) + | [: `'n' :] -> ("NATIVEINT", get_buff len) + | [: :] -> ("INT", get_buff len) ] +and octal = parser [ [: `('0'..'7' as d) :] -> d ] +and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ] +and binary = parser [ [: `('0'..'1' as d) :] -> d ] +and number len = + parser + [ [: `('0'..'9' as c); s :] -> number (store len c) s + | [: `'_'; s :] -> number len s + | [: `'.'; s :] -> decimal_part (store len '.') s + | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s + | [: `'l' :] -> ("INT32", get_buff len) + | [: `'L' :] -> ("INT64", get_buff len) + | [: `'n' :] -> ("NATIVEINT", get_buff len) + | [: :] -> ("INT", get_buff len) ] +and decimal_part len = + parser + [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s + | [: `'_'; s :] -> decimal_part len s + | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s + | [: :] -> ("FLOAT", get_buff len) ] +and exponent_part len = + parser + [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s + | [: a = end_exponent_part len :] -> a ] +and end_exponent_part len = + parser + [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s + | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] +and end_exponent_part_under len = + parser + [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s + | [: `'_'; s :] -> end_exponent_part_under len s + | [: :] -> ("FLOAT", get_buff len) ] +; + +value error_on_unknown_keywords = ref False; +value err loc msg = raise_with_loc loc (Token.Error msg); + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** Carl's alternative version + then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +(* Debugging positions and locations *) +value eprint_pos msg p = + Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d\n%!" + msg p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum +; + +value eprint_loc (bp, ep) = + do { eprint_pos "P1" bp; eprint_pos "P2" ep } +; + +value check_location msg ((bp, ep) as loc) = + let ok = + if (bp.Lexing.pos_lnum > ep.Lexing.pos_lnum || + bp.Lexing.pos_bol > ep.Lexing.pos_bol || + bp.Lexing.pos_cnum > ep.Lexing.pos_cnum || + bp.Lexing.pos_lnum < 0 || ep.Lexing.pos_lnum < 0 || + bp.Lexing.pos_bol < 0 || ep.Lexing.pos_bol < 0 || + bp.Lexing.pos_cnum < 0 || ep.Lexing.pos_cnum < 0) + (* Here, we don't check + bp.Lexing.pos_cnum < bp.Lexing.pos_bol || ep.Lexing.pos_cnum < bp.Lexing.pos_bol + since the lexer is called on antiquotations, with cnum=0, but lnum and bolpos + have "correct" values *) + then + do { + Printf.eprintf "*** Warning: (%s) strange positions ***\n" msg; + eprint_loc loc; + False + } + else + True in + (ok, loc) +; + +value next_token_fun dfa ssd find_kwd fname lnum bolpos glexr = + let make_pos p = + {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val; + Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in + let mkloc (bp, ep) = (make_pos bp, make_pos ep) in + let keyword_or_error (bp,ep) s = + let loc = mkloc (bp, ep) in + try (("", find_kwd s), loc) with + [ Not_found -> + if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) + else (("", s), loc) ] in + let error_if_keyword ( ((_,id) as a), bep) = + let loc = mkloc bep in + try do { + ignore(find_kwd id); + err loc ("illegal use of a keyword as a label: " ^ id) } + with [ Not_found -> (a, loc) ] + in + let rec next_token after_space = + parser bp + [ [: `'\010'; s :] ep -> + do { bolpos.val := ep; incr lnum; next_token True s } + | [: `'\013'; s :] ep -> + let ep = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := ep; incr lnum; next_token True s } + | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s + | [: `'#' when bp = bolpos.val; s :] -> + if linedir 1 s then do { line_directive s; next_token True s } + else keyword_or_error (bp, bp + 1) "#" + | [: `'('; s :] -> left_paren bp s + | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = mkloc (bp, (Stream.count s)) in + (jrh_identifier find_kwd id, loc) + +(********** original + (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) + ***********) + + + | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = mkloc (bp, (Stream.count s)) in + (jrh_identifier find_kwd id, loc) + +(********** original + (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) + **********) + + | [: `('1'..'9' as c); s :] -> + let tok = number (store 0 c) s in + let loc = mkloc (bp, (Stream.count s)) in + (tok, loc) + | [: `'0'; s :] -> + let tok = base_number (store 0 '0') s in + let loc = mkloc (bp, (Stream.count s)) in + (tok, loc) + | [: `'''; s :] -> + match Stream.npeek 2 s with + [ [_; '''] | ['\\'; _] -> + let tok = ("CHAR", get_buff (char bp 0 s)) in + let loc = mkloc (bp, (Stream.count s)) in + (tok, loc) + | _ -> keyword_or_error (bp, Stream.count s) "'" ] + | [: `'"'; s :] -> + let tok = ("STRING", get_buff (string bp 0 s)) in + let loc = mkloc (bp, Stream.count s) in + (tok, loc) + | [: `'`'; s :] -> + let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in + let loc = mkloc (bp, Stream.count s) in + (tok, loc) + | [: `'$'; s :] -> + let tok = dollar bp 0 s in + let loc = mkloc (bp, Stream.count s) in + (tok, loc) + | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); + s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id + | [: `('~' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> + let id = get_buff len in + match s with parser + [ [: `':' :] eb -> error_if_keyword (("LABEL", id), (bp, ep)) + | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ] + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + + | [: `('?' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> + let id = get_buff len in + match s with parser + [ [: `':' :] eb -> error_if_keyword (("OPTLABEL", id), (bp,ep)) + | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ] + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `'<'; s :] -> less bp s + | [: `(':' as c1); + len = + parser + [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('>' | '|' as c1); + len = + parser + [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 + | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('[' | '{' as c1); s :] -> + let len = + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> store 0 c1 + | _ -> + match s with parser + [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] ] + in + let ep = Stream.count s in + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `'.'; + id = + parser + [ [: `'.' :] -> ".." + | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> + keyword_or_error (bp, ep) id + | [: `';'; + id = + parser + [ [: `';' :] -> ";;" + | [: :] -> ";" ] :] ep -> + keyword_or_error (bp, ep) id + | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), mkloc (bp, ep)) + | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) + | [: _ = Stream.empty :] -> (("EOI", ""), mkloc (bp, succ bp)) ] + and less bp strm = + if no_quotations.val then + match strm with parser + [ [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + else + match strm with parser + [ [: `'<'; len = quotation bp 0 :] ep -> + (("QUOTATION", ":" ^ get_buff len), mkloc (bp, ep)) + | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; + `'<' ? "character '<' expected"; len = quotation bp 0 :] ep -> + (("QUOTATION", i ^ ":" ^ get_buff len), mkloc (bp, ep)) + | [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + and string bp len = + parser + [ [: `'"' :] -> len + | [: `'\\'; `c; s :] ep -> string bp (store (store len '\\') c) s + | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; string bp (store len '\010') s } + | [: `'\013'; s :] ep -> + let (len, ep) = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) } + | _ -> (store len '\013', ep) ] in + do { bolpos.val := ep; incr lnum; string bp len s } + | [: `c; s :] -> string bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "string not terminated" ] + and qstring bp len = + parser + [ [: `'`' :] -> get_buff len + | [: `c; s :] -> qstring bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ] + and char bp len = + parser + [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len + | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s + | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; char bp (store len '\010') s} + | [: `'\013'; s :] -> + let bol = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; bp+2 } + | _ -> bp+1 ] in + do { bolpos.val := bol; incr lnum; char bp (store len '\013') s} + | [: `c; s :] -> char bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "char not terminated" ] + and dollar bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bp (store len c) s + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: s :] -> + if dfa then + match s with parser + [ [: `c :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] + else ("", get_buff (ident2 (store 0 '$') s)) ] + and maybe_locate bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('0'..'9' as c); s :] -> maybe_locate bp (store len c) s + | [: `':'; s :] -> + ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] + and antiquot bp len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> + antiquot bp (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bp 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bp (store len c) s) + | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] + and locate_or_antiquot_rest bp len = + parser + [ [: `'$' :] -> get_buff len + | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: `c; s :] -> locate_or_antiquot_rest bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "antiquotation not terminated" ] + and quotation bp len = + parser + [ [: `'>'; s :] -> maybe_end_quotation bp len s + | [: `'<'; s :] -> + quotation bp (maybe_nested_quotation bp (store len '<') s) s + | [: `'\\'; + len = + parser + [ [: `('>' | '<' | '\\' as c) :] -> store len c + | [: :] -> store len '\\' ]; + s :] -> + quotation bp len s + | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; quotation bp (store len '\010') s} + | [: `'\013'; s :] -> + let bol = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; bp+2 } + | _ -> bp+1 ] in + do { bolpos.val := bol; incr lnum; quotation bp (store len '\013') s} + | [: `c; s :] -> quotation bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ] + and maybe_nested_quotation bp len = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: `':'; len = ident (store len ':'); + a = + parser + [ [: `'<'; s :] -> mstore (quotation bp (store len '<') s) ">>" + | [: :] -> len ] :] -> + a + | [: :] -> len ] + and maybe_end_quotation bp len = + parser + [ [: `'>' :] -> len + | [: a = quotation bp (store len '>') :] -> a ] + and left_paren bp = + parser + [ [: `'*'; _ = comment bp; a = next_token True :] -> a + | [: :] ep -> keyword_or_error (bp, ep) "(" ] + and comment bp = + parser + [ [: `'('; s :] -> left_paren_in_comment bp s + | [: `'*'; s :] -> star_in_comment bp s + | [: `'"'; _ = string bp 0; s :] -> comment bp s + | [: `'''; s :] -> quote_in_comment bp s + | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; comment bp s } + | [: `'\013'; s :] ep -> + let ep = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := ep; incr lnum; comment bp s } + | [: `c; s :] -> comment bp s + | [: :] ep -> err (mkloc (bp, ep)) "comment not terminated" ] + and quote_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\\'; s :] -> quote_antislash_in_comment bp 0 s + | [: s :] -> + do { + match Stream.npeek 2 s with + [ [ ( '\013' | '\010' ); '''] -> + do { bolpos.val := bp + 1; incr lnum; + Stream.junk s; Stream.junk s } + | [ '\013'; '\010' ] -> + match Stream.npeek 3 s with + [ [_; _; '''] -> do { bolpos.val := bp + 2; incr lnum; + Stream.junk s; Stream.junk s; Stream.junk s } + | _ -> () ] + | [_; '''] -> do { Stream.junk s; Stream.junk s } + | _ -> () ]; + comment bp s + } ] + and quote_any_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_in_comment bp len = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\\' | '"' | 'n' | 't' | 'b' | 'r'; s :] -> + quote_any_in_comment bp s + | [: `'0'..'9'; s :] -> quote_antislash_digit_in_comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_digit_in_comment bp = + parser + [ [: `'0'..'9'; s :] -> quote_antislash_digit2_in_comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_digit2_in_comment bp = + parser + [ [: `'0'..'9'; s :] -> quote_any_in_comment bp s + | [: a = comment bp :] -> a ] + and left_paren_in_comment bp = + parser + [ [: `'*'; s :] -> do { comment bp s; comment bp s } + | [: a = comment bp :] -> a ] + and star_in_comment bp = + parser + [ [: `')' :] -> () + | [: a = comment bp :] -> a ] + and linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> True + | _ -> False ] + and any_to_nl = + parser + [ [: `'\010'; s :] ep -> + do { bolpos.val := ep; incr lnum } + | [: `'\013'; s :] ep -> + let ep = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := ep; incr lnum } + | [: `_; s :] -> any_to_nl s + | [: :] -> () ] + and line_directive = parser (* we are sure that there is a line directive here *) + [ [: _ = skip_spaces; n = line_directive_number 0; + _ = skip_spaces; _ = line_directive_string; + _ = any_to_nl :] ep + -> do { bolpos.val := ep; lnum.val := n } + ] + and skip_spaces = parser + [ [: `' ' | '\t'; s :] -> skip_spaces s + | [: :] -> () ] + and line_directive_number n = parser + [ [: `('0'..'9' as c) ; s :] + -> line_directive_number (10*n + (Char.code c - Char.code '0')) s + | [: :] -> n ] + and line_directive_string = parser + [ [: ` '"' ; _ = line_directive_string_contents 0 :] -> () + | [: :] -> () + ] + and line_directive_string_contents len = parser + [ [: ` '\010' | '\013' :] -> () + | [: ` '"' :] -> fname.val := get_buff len + | [: `c; s :] -> line_directive_string_contents (store len c) s + ] + in + fun cstrm -> + try + let glex = glexr.val in + let comm_bp = Stream.count cstrm in + let r = next_token False cstrm in + do { + match glex.tok_comm with + [ Some list -> + let next_bp = (fst (snd r)).Lexing.pos_cnum in + if next_bp > comm_bp then + let comm_loc = mkloc (comm_bp, next_bp) in + glex.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + r + } + with + [ Stream.Error str -> + err (mkloc (Stream.count cstrm, Stream.count cstrm + 1)) str ] +; + + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value func kwd_table glexr = + let bolpos = ref 0 in + let lnum = ref 1 in + let fname = ref "" in + let find = Hashtbl.find kwd_table in + let dfa = dollar_for_antiquotation.val in + let ssd = specific_space_dot.val in + Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr) +; + +value rec check_keyword_stream = + parser [: _ = check; _ = Stream.empty :] -> True +and check = + parser + [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' + ; + s :] -> + check_ident s + | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' + ; + s :] -> + check_ident2 s + | [: `'<'; s :] -> + match Stream.npeek 1 s with + [ [':' | '<'] -> () + | _ -> check_ident2 s ] + | [: `':'; + _ = + parser + [ [: `']' | ':' | '=' | '>' :] -> () + | [: :] -> () ] :] ep -> + () + | [: `'>' | '|'; + _ = + parser + [ [: `']' | '}' :] -> () + | [: a = check_ident2 :] -> a ] :] -> + () + | [: `'[' | '{'; s :] -> + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> () + | _ -> + match s with parser + [ [: `'|' | '<' | ':' :] -> () + | [: :] -> () ] ] + | [: `';'; + _ = + parser + [ [: `';' :] -> () + | [: :] -> () ] :] -> + () + | [: `_ :] -> () ] +and check_ident = + parser + [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '0'..'9' | '_' | ''' + ; + s :] -> + check_ident s + | [: :] -> () ] +and check_ident2 = + parser + [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' + ; + s :] -> + check_ident2 s + | [: :] -> () ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Token.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Token.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (Hashtbl.mem kwd_table p_prm) then + if check_keyword p_prm then + if Hashtbl.mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "INT" | "INT32" | "INT64" | "NATIVEINT" + | "FLOAT" | "CHAR" | "STRING" + | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" + | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" -> + () + | _ -> + raise + (Token.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT32", "") -> "32 bits integer" + | ("INT64", "") -> "64 bits integer" + | ("NATIVEINT", "") -> "native integer" + | (("INT" | "INT32" | "NATIVEINT"), s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("LOCATE", "") -> "locate" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Token.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +value tparse = + fun + [ ("ANTIQUOT", p_prm) -> + let p = + parser + [: `("ANTIQUOT", prm) when eq_before_colon p_prm prm :] -> + after_colon prm + in + Some p + | _ -> None ] +; + +value make () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + {func = func kwd_table glexr; using = using_token kwd_table id_table; + removing = removing_token kwd_table id_table; tparse = tparse; text = text} +; + +(* ------------------------------------------------------------------------- *) +(* Resume the main file. *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_declaration; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value o2b = + fun + [ Some _ -> True + | None -> False ] +; + +value mkumin loc f arg = + match (f, arg) with + [ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 -> + let n = "-" ^ n in + <:expr< $int:n$ >> + | ("-", MLast.ExInt32 loc n) when (Int32.of_string n) > 0l -> + MLast.ExInt32 loc ("-" ^ n) + | ("-", MLast.ExInt64 loc n) when (Int64.of_string n) > 0L -> + MLast.ExInt64 loc ("-" ^ n) + | ("-", MLast.ExNativeInt loc n) when (Nativeint.of_string n) > 0n -> + MLast.ExNativeInt loc ("-" ^ n) + | (_, <:expr< $flo:n$ >>) when float_of_string n > 0.0 -> + let n = "-" ^ n in + <:expr< $flo:n$ >> + | _ -> + let f = "~" ^ f in + <:expr< $lid:f$ $arg$ >> ] +; + + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = if top then loc else (fst (MLast.loc_of_expr e1), snd loc) in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = if top then loc else (fst (MLast.loc_of_patt p1), snd loc) in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = + let ct = Hashtbl.create 73 in + do { + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] + } +; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +(*** And JRH inserted it in here ***) + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> + do { Stream.junk strm; Stream.junk strm; translate_operator s } + | _ -> raise Stream.Failure ]) +; + +value lident_colon = + Grammar.Entry.of_parser gram "lident_colon" + (fun strm -> + match Stream.npeek 2 strm with + [ [("LIDENT", i); ("", ":")] -> + do { Stream.junk strm; Stream.junk strm; i } + | _ -> raise Stream.Failure ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + let rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False + in + loop +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | <:expr< $e$ $_$ >> -> + if is_expr_constr_call e then + Stdpp.raise_with_loc loc (Stream.Error "currified constructor") + else 1 + | _ -> 1 ] +; + +value rec is_patt_constr_call = + fun + [ <:patt< $uid:_$ >> -> True + | <:patt< $uid:_$.$p$ >> -> is_patt_constr_call p + | <:patt< $p$ $_$ >> -> is_patt_constr_call p + | _ -> False ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | <:patt< $p$ $_$ >> -> + if is_patt_constr_call p then + Stdpp.raise_with_loc loc (Stream.Error "currified constructor") + else 1 + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if List.mem_assoc s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if List.mem_assoc v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value rec patt_lid = + fun + [ <:patt< $p1$ $p2$ >> -> + match p1 with + [ <:patt< $lid:i$ >> -> Some (MLast.loc_of_patt p1, i, [p2]) + | _ -> + match patt_lid p1 with + [ Some (loc, i, pl) -> Some (loc, i, [p2 :: pl]) + | None -> None ] ] + | _ -> None ] +; + +value bigarray_get loc arr arg = + let coords = + match arg with + [ <:expr< ($list:el$) >> -> el + | _ -> [arg] ] + in + match coords with + [ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >> + | [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> + | [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> + | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] +; + +value bigarray_set loc var newval = + match var with + [ <:expr< Bigarray.Array1.get $arr$ $c1$ >> -> + Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >> + | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> -> + Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >> + | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> -> + Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >> + | <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> -> + Some <:expr< Bigarray.Genarray.set $arr$ [| $list:coords$ |] $newval$ >> + | _ -> None ] +; + +(* ...works bad... +value rec sync cs = + match cs with parser + [ [: `';' :] -> sync_semi cs + | [: `_ :] -> sync cs ] +and sync_semi cs = + match cs with parser + [ [: `';' :] -> sync_semisemi cs + | [: :] -> sync cs ] +and sync_semisemi cs = + match Stream.peek cs with + [ Some ('\010' | '\013') -> () + | _ -> sync_semi cs ] +; +Pcaml.sync.val := sync; +*) + + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type + class_expr class_sig_item class_str_item let_binding type_declaration; + module_expr: + [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; + me = SELF -> + <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> + | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> + <:module_expr< struct $list:st$ end >> ] + | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ] + ; + + str_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> + <:str_item< exception $c$ of $list:tl$ = $b$ >> + | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> + <:str_item< external $i$ : $t$ = $list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = LIST1 STRING -> + <:str_item< external $i$ : $t$ = $list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; i = UIDENT; mb = module_binding -> + <:str_item< module $i$ = $mb$ >> + | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" -> + MLast.StRecMod loc nmtmes + | "module"; "type"; i = UIDENT; "="; mt = module_type -> + <:str_item< module type $i$ = $mt$ >> + | "open"; i = mod_ident -> <:str_item< open $i$ >> + | "type"; tdl = LIST1 type_declaration SEP "and" -> + <:str_item< type $list:tdl$ >> + | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; + x = expr -> + let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> + match l with + [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] + | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> + <:str_item< let module $m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + + rebind_exn: + [ [ "="; sl = mod_ident -> sl + | -> [] ] ] + ; + module_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + module_rec_binding: + [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr -> + (m, mt, me) ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> + <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> + <:module_type< $mt$ with $list:wcl$ >> ] + | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> + <:module_type< sig $list:sg$ end >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = UIDENT -> <:module_type< $uid:m$ >> + | m = LIDENT -> <:module_type< $lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration -> + <:sig_item< exception $c$ of $list:tl$ >> + | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> + <:sig_item< external $i$ : $t$ = $list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = LIST1 STRING -> + <:sig_item< external $i$ : $t$ = $list:pd$ >> + | "include"; mt = module_type -> <:sig_item< include $mt$ >> + | "module"; i = UIDENT; mt = module_declaration -> + <:sig_item< module $i$ : $mt$ >> + | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" -> + MLast.SgRecMod loc mds + | "module"; "type"; i = UIDENT; "="; mt = module_type -> + <:sig_item< module type $i$ = $mt$ >> + | "module"; "type"; i = UIDENT -> + <:sig_item< module type $i$ = 'abstract >> + | "open"; i = mod_ident -> <:sig_item< open $i$ >> + | "type"; tdl = LIST1 type_declaration SEP "and" -> + <:sig_item< type $list:tdl$ >> + | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $i$ : $t$ >> ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] + ; + module_rec_declaration: + [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = type_parameters; i = mod_ident; "="; t = ctyp -> + MLast.WcTyp loc i tpl t + | "module"; i = mod_ident; "="; me = module_expr -> + MLast.WcMod loc i me ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 ] + | "expr1" + [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; + x = expr LEVEL "top" -> + <:expr< let $opt:o2b o$ $list:l$ in $x$ >> + | "let"; "module"; m = UIDENT; mb = module_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< fun [ $list:l$ ] >> + | "fun"; p = simple_patt; e = fun_def -> + <:expr< fun [$p$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< match $e$ with [ $list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< try $e$ with [ $list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; + "else"; e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; + "do"; e = SELF; "done" -> + <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> + | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> + <:expr< while $e1$ do { $list:get_seq e2$ } >> + | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> + (* <:expr< object $opt:cspo$ $list:cf$ end >> *) + MLast.ExObj loc cspo cf ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> + match bigarray_set loc e1 e2 with + [ Some e -> e + | None -> <:expr< $e1$ := $e2$ >> ] ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; "$"; e2 = SELF -> <:expr< $lid:"\$"$ $e1$ $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> + | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> + match e with + [ <:expr< False >> -> <:expr< assert False >> + | _ -> <:expr< assert ($e$) >> ] + | "lazy"; e = SELF -> + <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e1 = SELF; "."; "{"; e2 = SELF; "}" -> bigarray_get loc e1 e2 + | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val>> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = INT -> <:expr< $int:s$ >> + | s = INT32 -> MLast.ExInt32 loc s + | s = INT64 -> MLast.ExInt64 loc s + | s = NATIVEINT -> MLast.ExNativeInt loc s + | s = FLOAT -> <:expr< $flo:s$ >> + | s = STRING -> <:expr< $str:s$ >> + | c = CHAR -> <:expr< $chr:c$ >> + | UIDENT "True" -> <:expr< $uid:" True"$ >> + | UIDENT "False" -> <:expr< $uid:" False"$ >> + | i = expr_ident -> i + | s = "false" -> <:expr< False >> + | s = "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> + | "{"; test_label_eq; lel = lbl_expr_list; "}" -> + <:expr< { $list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = lbl_expr_list; "}" -> + <:expr< { ($e$) with $list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> <:expr< $e$ >> + | "begin"; e = SELF; "end" -> <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = LOCATE -> + let x = + try + let i = String.index x ':' in + ({Lexing.pos_fname = ""; + Lexing.pos_lnum = 0; + Lexing.pos_bol = 0; + Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found | Failure _ -> (Token.nowhere, x) ] + in + Pcaml.handle_expr_locate loc x + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_expr_quotation loc x ] ] + ; + let_binding: + [ [ p = patt; e = fun_binding -> + match patt_lid p with + [ Some (loc, i, pl) -> + let e = + List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl + in + (<:patt< $lid:i$ >>, e) + | None -> (p, e) ] ] ] + ; + fun_binding: + [ RIGHTA + [ p = simple_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] + | e = expr LEVEL "expr1"; ";" -> [e] + | e = expr LEVEL "expr1" -> [e] ] ] + ; + fun_def: + [ RIGHTA + [ p = simple_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "->"; e = expr -> <:expr< $e$ >> ] ] + ; + expr_ident: + [ RIGHTA + [ i = LIDENT -> <:expr< $lid:i$ >> + | i = UIDENT -> <:expr< $uid:i$ >> + | i = UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $uid:i$ >> j + | i = UIDENT; "."; "("; j = operator_rparen -> + <:expr< $uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ p = simple_patt -> p ] ] + ; + + simple_patt: + [ [ s = LIDENT -> <:patt< $lid:s$ >> + | s = UIDENT -> <:patt< $uid:s$ >> + | s = INT -> <:patt< $int:s$ >> + | s = INT32 -> MLast.PaInt32 loc s + | s = INT64 -> MLast.PaInt64 loc s + | s = NATIVEINT -> MLast.PaNativeInt loc s + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = INT32 -> MLast.PaInt32 loc ("-" ^ s) + | "-"; s = INT64 -> MLast.PaInt64 loc ("-" ^ s) + | "-"; s = NATIVEINT -> MLast.PaNativeInt loc ("-" ^ s) + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = FLOAT -> <:patt< $flo:s$ >> + | s = STRING -> <:patt< $str:s$ >> + | s = CHAR -> <:patt< $chr:s$ >> + | UIDENT "True" -> <:patt< $uid:" True"$ >> + | UIDENT "False" -> <:patt< $uid:" False"$ >> + | s = "false" -> <:patt< False >> + | s = "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> + | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = patt; ")" -> <:patt< $p$ >> + | "_" -> <:patt< _ >> + | "`"; s = ident -> <:patt< ` $s$ >> + | "#"; t = mod_ident -> <:patt< # $list:t$ >> + | x = LOCATE -> + let x = + try + let i = String.index x ':' in + ({Lexing.pos_fname = ""; + Lexing.pos_lnum = 0; + Lexing.pos_bol = 0; + Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found | Failure _ -> (Token.nowhere, x) ] + in + Pcaml.handle_patt_locate loc x + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_patt_quotation loc x ] ] + ; + + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_declaration: + [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; + cl = LIST0 constrain -> + (n, tpl, tk, cl) + | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> + (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] + ; + type_patt: + [ [ n = LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ "private"; "{"; ldl = label_declarations; "}" -> + <:ctyp< private { $list:ldl$ } >> + | "private"; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< private [ $list:cdl$ ] >> + | test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> <:ctyp< $t$ >> + | t = ctyp; "="; "private"; "{"; ldl = label_declarations; "}" -> + <:ctyp< $t$ == private { $list:ldl$ } >> + | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> + <:ctyp< $t$ == { $list:ldl$ } >> + | t = ctyp; "="; "private"; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == private [ $list:cdl$ ] >> + | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == [ $list:cdl$ ] >> + | "{"; ldl = label_declarations; "}" -> + <:ctyp< { $list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "'"; i = ident -> (i, (False, False)) + | "+"; "'"; i = ident -> (i, (True, False)) + | "-"; "'"; i = ident -> (i, (False, True)) ] ] + ; + constructor_declaration: + [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> + (loc, ci, cal) + | ci = UIDENT -> (loc, ci, []) ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "ctyp1") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "ctyp1" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = ident -> <:ctyp< '$i$ >> + | "_" -> <:ctyp< _ >> + | i = LIDENT -> <:ctyp< $lid:i$ >> + | i = UIDENT -> <:ctyp< $uid:i$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = LIST1 class_declaration SEP "and" -> + <:str_item< class $list:cd$ >> + | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> + <:str_item< class type $list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = LIST1 class_description SEP "and" -> + <:sig_item< class $list:cd$ >> + | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> + <:sig_item< class type $list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = simple_patt; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, []) + | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = simple_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = simple_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; + ce = SELF -> + <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< $list:ci$ [ $ct$ ] >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> + <:class_expr< object $opt:cspo$ $list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> + <:class_str_item< inherit $ce$ $opt:pb$ >> + | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> + <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual $l$ : $t$ >> + | "method"; "private"; l = label; ":"; t = poly_type; "="; e = expr -> + MLast.CrMth loc l True e (Some t) + | "method"; "private"; l = label; sb = fun_binding -> + MLast.CrMth loc l True sb None + | "method"; l = label; ":"; t = poly_type; "="; e = expr -> + MLast.CrMth loc l False e (Some t) + | "method"; l = label; sb = fun_binding -> + MLast.CrMth loc l False sb None + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> + <:class_type< $list:id$ [ $list:tl$ ] >> + | id = clty_longident -> <:class_type< $list:id$ >> + | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; + "end" -> + <:class_type< object $opt:cst$ $list:csf$ end >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> + | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> + <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual $l$ : $t$ >> + | "method"; "private"; l = label; ":"; t = poly_type -> + <:class_sig_item< method private $l$ : $t$ >> + | "method"; l = label; ":"; t = poly_type -> + <:class_sig_item< method $l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; + ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; + cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> + | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> + | "<"; ">" -> <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) + | f = field; ";" -> ([f], False) + | f = field -> ([f], False) + | ".." -> ([], True) ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + clty_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: LEVEL "arrow" + [ RIGHTA + [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >> + | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> + | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> + | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ = $list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ > $list:rfl$ ] >> + | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ < $list:rfl$ ] >> + | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; + ntl = LIST1 name_tag; "]" -> + <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] + ; + row_field: + [ [ "`"; i = ident -> MLast.RfTag i True [] + | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> + MLast.RfTag i (o2b ao) l + | t = ctyp -> MLast.RfInh t ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> + | i = TILDEIDENT -> <:expr< ~ $i$ >> + | "~"; i = LIDENT -> <:expr< ~ $i$ >> + | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >> + | i = QUESTIONIDENT -> <:expr< ? $i$ >> + | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + labeled_patt: + [ [ i = LABEL; p = simple_patt -> + <:patt< ~ $i$ : $p$ >> + | i = TILDEIDENT -> + <:patt< ~ $i$ >> + | "~"; i=LIDENT -> <:patt< ~ $i$ >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~ $i$ >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~ $i$ : ($lid:i$ : $t$) >> + | i = OPTLABEL; j = LIDENT -> + <:patt< ? $i$ : ($lid:j$) >> + | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" -> + <:patt< ? $i$ : ( $p$ = $e$ ) >> + | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ? $i$ : ( $p$ : $t$ ) >> + | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >> + | i = QUESTIONIDENT -> <:patt< ? $i$ >> + | "?"; i = LIDENT -> <:patt< ? $i$ >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ = $e$ ) >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ? $i$ >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ? ( $lid:i$ : $t$ ) >> ] ] + ; + class_type: + [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> + | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set Plexer.no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.09.ml b/pa_j_3.09.ml new file mode 100644 index 0000000..e743af0 --- /dev/null +++ b/pa_j_3.09.ml @@ -0,0 +1,2212 @@ +(* camlp4r pa_extend.cmo q_MLast.cmo *) +(***********************************************************************) +(* *) +(* Camlp4 *) +(* *) +(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 2002 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id: pa_o.ml,v 1.66 2005/06/29 04:11:26 garrigue Exp $ *) + +open Stdpp; +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* Hacked version of the lexer. *) +(* ------------------------------------------------------------------------- *) + +open Token; + +value jrh_lexer = ref False; + +value no_quotations = ref False; + +(* The string buffering machinery *) + +value buff = ref (String.create 80); +value store len x = + do { + if len >= String.length buff.val then + buff.val := buff.val ^ String.create (String.length buff.val) + else (); + buff.val.[len] := x; + succ len + } +; +value mstore len s = + add_rec len 0 where rec add_rec len i = + if i == String.length s then len else add_rec (store len s.[i]) (succ i) +; +value get_buff len = String.sub buff.val 0 len; + +(* The lexer *) + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value rec ident len = + parser + [ [: `('A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '0'..'9' | '_' | ''' as + c) + ; + s :] -> + ident (store len c) s + | [: :] -> len ] +and ident2 len = + parser + [ [: `('!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' as + c) + ; + s :] -> + ident2 (store len c) s + | [: :] -> len ] +and ident3 len = + parser + [ [: `('0'..'9' | 'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | '.' | + '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' as + c) + ; + s :] -> + ident3 (store len c) s + | [: :] -> len ] +and base_number len = + parser + [ [: `'o' | 'O'; s :] -> digits octal (store len 'o') s + | [: `'x' | 'X'; s :] -> digits hexa (store len 'x') s + | [: `'b' | 'B'; s :] -> digits binary (store len 'b') s + | [: a = number len :] -> a ] +and digits kind len = + parser + [ [: d = kind; s :] -> digits_under kind (store len d) s + | [: :] -> raise (Stream.Error "ill-formed integer constant") ] +and digits_under kind len = + parser + [ [: d = kind; s :] -> digits_under kind (store len d) s + | [: `'_'; s :] -> digits_under kind len s + | [: `'l' :] -> ("INT32", get_buff len) + | [: `'L' :] -> ("INT64", get_buff len) + | [: `'n' :] -> ("NATIVEINT", get_buff len) + | [: :] -> ("INT", get_buff len) ] +and octal = parser [ [: `('0'..'7' as d) :] -> d ] +and hexa = parser [ [: `('0'..'9' | 'a'..'f' | 'A'..'F' as d) :] -> d ] +and binary = parser [ [: `('0'..'1' as d) :] -> d ] +and number len = + parser + [ [: `('0'..'9' as c); s :] -> number (store len c) s + | [: `'_'; s :] -> number len s + | [: `'.'; s :] -> decimal_part (store len '.') s + | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s + | [: `'l' :] -> ("INT32", get_buff len) + | [: `'L' :] -> ("INT64", get_buff len) + | [: `'n' :] -> ("NATIVEINT", get_buff len) + | [: :] -> ("INT", get_buff len) ] +and decimal_part len = + parser + [ [: `('0'..'9' as c); s :] -> decimal_part (store len c) s + | [: `'_'; s :] -> decimal_part len s + | [: `'e' | 'E'; s :] -> exponent_part (store len 'E') s + | [: :] -> ("FLOAT", get_buff len) ] +and exponent_part len = + parser + [ [: `('+' | '-' as c); s :] -> end_exponent_part (store len c) s + | [: a = end_exponent_part len :] -> a ] +and end_exponent_part len = + parser + [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s + | [: :] -> raise (Stream.Error "ill-formed floating-point constant") ] +and end_exponent_part_under len = + parser + [ [: `('0'..'9' as c); s :] -> end_exponent_part_under (store len c) s + | [: `'_'; s :] -> end_exponent_part_under len s + | [: :] -> ("FLOAT", get_buff len) ] +; + +value error_on_unknown_keywords = ref False; +value err loc msg = raise_with_loc loc (Token.Error msg); + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** Carl's alternative version + then ("UIDENT", id) else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +(* Debugging positions and locations *) +value eprint_pos msg p = + Printf.eprintf "%s: fname=%s; lnum=%d; bol=%d; cnum=%d%!" + msg p.Lexing.pos_fname p.Lexing.pos_lnum p.Lexing.pos_bol p.Lexing.pos_cnum +; + +value eprint_loc (bp, ep) = + do { eprint_pos "P1=" bp; eprint_pos " --P2=" ep } +; + +value check_location msg ((bp, ep) as loc) = + let ok = + if (bp.Lexing.pos_lnum > ep.Lexing.pos_lnum || + bp.Lexing.pos_bol > ep.Lexing.pos_bol || + bp.Lexing.pos_cnum > ep.Lexing.pos_cnum || + bp.Lexing.pos_lnum < 0 || ep.Lexing.pos_lnum < 0 || + bp.Lexing.pos_bol < 0 || ep.Lexing.pos_bol < 0 || + bp.Lexing.pos_cnum < 0 || ep.Lexing.pos_cnum < 0) + (* Here, we don't check + bp.Lexing.pos_cnum < bp.Lexing.pos_bol || ep.Lexing.pos_cnum < bp.Lexing.pos_bol + since the lexer is called on antiquotations, with cnum=0, but lnum and bolpos + have "correct" values *) + then + do { + Printf.eprintf "*** Warning: (%s) strange positions ***\n" msg; + eprint_loc loc; + False + } + else + True in + (ok, loc) +; + +value debug_token ((kind, tok), loc) = do { + Printf.eprintf "%s(%s) at " kind tok; + eprint_loc loc; + Printf.eprintf "\n%!" +}; + +value rec next_token_fun dfa ssd find_kwd fname lnum bolpos glexr = + let make_pos p = + {Lexing.pos_fname = fname.val; Lexing.pos_lnum = lnum.val; + Lexing.pos_bol = bolpos.val; Lexing.pos_cnum = p} in + let mkloc (bp, ep) = (make_pos bp, make_pos ep) in + let keyword_or_error (bp,ep) s = + let loc = mkloc (bp, ep) in + try (("", find_kwd s), loc) with + [ Not_found -> + if error_on_unknown_keywords.val then err loc ("illegal token: " ^ s) + else (("", s), loc) ] in + let error_if_keyword ( ((_,id) as a), bep) = + let loc = mkloc bep in + try do { + ignore(find_kwd id); + err loc ("illegal use of a keyword as a label: " ^ id) } + with [ Not_found -> (a, loc) ] + in + let rec next_token after_space = + parser bp + [ [: `'\010'; s :] ep -> + do { bolpos.val := ep; incr lnum; next_token True s } + | [: `'\013'; s :] ep -> + let ep = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := ep; incr lnum; next_token True s } + | [: `' ' | '\t' | '\026' | '\012'; s :] -> next_token True s + | [: `'#' when bp = bolpos.val; s :] -> + if linedir 1 s then do { line_directive s; next_token True s } + else keyword_or_error (bp, bp + 1) "#" + | [: `'('; s :] -> left_paren bp s + | [: `('A'..'Z' | '\192'..'\214' | '\216'..'\222' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = mkloc (bp, (Stream.count s)) in + (jrh_identifier find_kwd id, loc) +(********** original + (try ("", find_kwd id) with [ Not_found -> ("UIDENT", id) ], loc) + ***********) + | [: `('a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' as c); s :] -> + let id = get_buff (ident (store 0 c) s) in + let loc = mkloc (bp, (Stream.count s)) in + (jrh_identifier find_kwd id, loc) +(********** original + (try ("", find_kwd id) with [ Not_found -> ("LIDENT", id) ], loc) + **********) + | [: `('1'..'9' as c); s :] -> + let tok = number (store 0 c) s in + let loc = mkloc (bp, (Stream.count s)) in + (tok, loc) + | [: `'0'; s :] -> + let tok = base_number (store 0 '0') s in + let loc = mkloc (bp, (Stream.count s)) in + (tok, loc) + | [: `'''; s :] -> + match Stream.npeek 2 s with + [ [_; '''] | ['\\'; _] -> + let tok = ("CHAR", get_buff (char bp 0 s)) in + let loc = mkloc (bp, (Stream.count s)) in + (tok, loc) + | _ -> keyword_or_error (bp, Stream.count s) "'" ] + | [: `'"'; s :] -> + let bpos = make_pos bp in + let tok = ("STRING", get_buff (string bpos 0 s)) in + let loc = mkloc (bp, Stream.count s) in + (tok, loc) + | [: `'`'; s :] -> + let tok = ("QUOTATION", "tot:"^(qstring bp 0 s)) in + let loc = mkloc (bp, Stream.count s) in + (tok, loc) + | [: `'$'; s :] -> + let bpos = make_pos bp in + let tok = dollar bpos 0 s in + let loc = (bpos, make_pos (Stream.count s)) in + (tok, loc) + | [: `('!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' as c); + s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id + | [: `('~' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> + let id = get_buff len in + match s with parser + [ [: `':' :] ep -> error_if_keyword (("LABEL", id), (bp, ep)) + | [: :] -> error_if_keyword (("TILDEIDENT", id), (bp, ep)) ] + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + + | [: `('?' as c); + a = + parser + [ [: `('a'..'z' as c); len = ident (store 0 c); s :] ep -> + let id = get_buff len in + match s with parser + [ [: `':' :] ep -> error_if_keyword (("OPTLABEL", id), (bp,ep)) + | [: :] -> error_if_keyword (("QUESTIONIDENT", id), (bp, ep)) ] + | [: s :] -> + let id = get_buff (ident2 (store 0 c) s) in + keyword_or_error (bp, Stream.count s) id ] :] -> + a + | [: `'<'; s :] -> less bp s + | [: `(':' as c1); + len = + parser + [ [: `(']' | ':' | '=' | '>' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('>' | '|' as c1); + len = + parser + [ [: `(']' | '}' as c2) :] -> store (store 0 c1) c2 + | [: a = ident2 (store 0 c1) :] -> a ] :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `('[' | '{' as c1); s :] -> + let len = + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> store 0 c1 + | _ -> + match s with parser + [ [: `('|' | '<' | ':' as c2) :] -> store (store 0 c1) c2 + | [: :] -> store 0 c1 ] ] + in + let ep = Stream.count s in + let id = get_buff len in + keyword_or_error (bp, ep) id + | [: `'.'; + id = + parser + [ [: `'.' :] -> ".." + | [: :] -> if ssd && after_space then " ." else "." ] :] ep -> + keyword_or_error (bp, ep) id + | [: `';'; + id = + parser + [ [: `';' :] -> ";;" + | [: :] -> ";" ] :] ep -> + keyword_or_error (bp, ep) id + | [: `'\\'; s :] ep -> (("LIDENT", get_buff (ident3 0 s)), mkloc (bp, ep)) + | [: `c :] ep -> keyword_or_error (bp, ep) (String.make 1 c) + | [: _ = Stream.empty :] -> (("EOI", ""), mkloc (bp, succ bp)) ] + and less bp strm = + if no_quotations.val then + match strm with parser + [ [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + else + let bpos = make_pos bp in + match strm with parser + [ [: `'<'; len = quotation bpos 0 :] ep -> + (("QUOTATION", ":" ^ get_buff len), (bpos, make_pos ep)) + | [: `':'; i = parser [: len = ident 0 :] -> get_buff len; + `'<' ? "character '<' expected"; len = quotation bpos 0 :] ep -> + (("QUOTATION", i ^ ":" ^ get_buff len), (bpos, make_pos ep)) + | [: len = ident2 (store 0 '<') :] ep -> + let id = get_buff len in + keyword_or_error (bp, ep) id ] + and qstring bp len = + parser + [ [: `'`' :] -> get_buff len + | [: `c; s :] -> qstring bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "quotation not terminated" ] + and string bpos len = + parser + [ [: `'"' :] -> len + | [: `'\\'; `c; s :] ep -> + let len = store len '\\' in + match c with [ + '\010' -> do { bolpos.val := ep; incr lnum; string bpos (store len c) s } + | '\013' -> + let (len, ep) = + match Stream.peek s with [ + Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) } + | _ -> (store len '\013', ep) ] in + do { bolpos.val := ep; incr lnum; string bpos len s } + | c -> string bpos (store len c) s + ] + | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; string bpos (store len '\010') s } + | [: `'\013'; s :] ep -> + let (len, ep) = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; (store (store len '\013') '\010', ep+1) } + | _ -> (store len '\013', ep) ] in + do { bolpos.val := ep; incr lnum; string bpos len s } + | [: `c; s :] -> string bpos (store len c) s + | [: :] ep -> err (bpos, make_pos ep) "string not terminated" ] + and char bp len = + parser + [ [: `'''; s :] -> if len = 0 then char bp (store len ''') s else len + | [: `'\\'; `c; s :] -> char bp (store (store len '\\') c) s + | [: `'\010'; s :] -> do {bolpos.val := bp+1; incr lnum; char bp (store len '\010') s} + | [: `'\013'; s :] -> + let bol = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; bp+2 } + | _ -> bp+1 ] in + do { bolpos.val := bol; incr lnum; char bp (store len '\013') s} + | [: `c; s :] -> char bp (store len c) s + | [: :] ep -> err (mkloc (bp, ep)) "char not terminated" ] + and dollar bpos len s = + if no_quotations.val then + ("", get_buff (ident2 (store 0 '$') s)) + else match s with parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' as c); s :] -> antiquot bpos (store len c) s + | [: `('0'..'9' as c); s :] -> maybe_locate bpos (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bpos 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) + | [: s :] -> + if dfa then + match s with parser + [ [: `c :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) + | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] + else ("", get_buff (ident2 (store 0 '$') s)) ] + and maybe_locate bpos len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('0'..'9' as c); s :] -> maybe_locate bpos (store len c) s + | [: `':'; s :] -> + ("LOCATE", get_buff len ^ ":" ^ locate_or_antiquot_rest bpos 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) + | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] + and antiquot bpos len = + parser + [ [: `'$' :] -> ("ANTIQUOT", ":" ^ get_buff len) + | [: `('a'..'z' | 'A'..'Z' | '0'..'9' as c); s :] -> + antiquot bpos (store len c) s + | [: `':'; s :] -> + let k = get_buff len in + ("ANTIQUOT", k ^ ":" ^ locate_or_antiquot_rest bpos 0 s) + | [: `'\\'; `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) + | [: `c; s :] -> + ("ANTIQUOT", ":" ^ locate_or_antiquot_rest bpos (store len c) s) + | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] + and locate_or_antiquot_rest bpos len = + parser + [ [: `'$' :] -> get_buff len + | [: `'\\'; `c; s :] -> locate_or_antiquot_rest bpos (store len c) s + | [: `c; s :] -> locate_or_antiquot_rest bpos (store len c) s + | [: :] ep -> err (bpos, make_pos ep) "antiquotation not terminated" ] + and quotation bpos len = + parser + [ [: `'>'; s :] -> maybe_end_quotation bpos len s + | [: `'<'; s :] -> + quotation bpos (maybe_nested_quotation bpos (store len '<') s) s + | [: `'\\'; + len = + parser + [ [: `('>' | '<' | '\\' as c) :] -> store len c + | [: :] -> store len '\\' ]; + s :] -> + quotation bpos len s + | [: `'\010'; s :] ep -> do {bolpos.val := ep; incr lnum; quotation bpos (store len '\010') s} + | [: `'\013'; s :] ep -> + let bol = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := bol; incr lnum; quotation bpos (store len '\013') s} + | [: `c; s :] -> quotation bpos (store len c) s + | [: :] ep -> err (bpos, make_pos ep) "quotation not terminated" ] + and maybe_nested_quotation bpos len = + parser + [ [: `'<'; s :] -> mstore (quotation bpos (store len '<') s) ">>" + | [: `':'; len = ident (store len ':'); + a = + parser + [ [: `'<'; s :] -> mstore (quotation bpos (store len '<') s) ">>" + | [: :] -> len ] :] -> + a + | [: :] -> len ] + and maybe_end_quotation bpos len = + parser + [ [: `'>' :] -> len + | [: a = quotation bpos (store len '>') :] -> a ] + and left_paren bp = + parser + [ [: `'*'; _ = comment (make_pos bp); a = next_token True :] -> a + | [: :] ep -> keyword_or_error (bp, ep) "(" ] + and comment bpos = + parser + [ [: `'('; s :] -> left_paren_in_comment bpos s + | [: `'*'; s :] -> star_in_comment bpos s + | [: `'"'; _ = string bpos 0; s :] -> comment bpos s + | [: `'''; s :] -> quote_in_comment bpos s + | [: `'\010'; s :] ep -> do { bolpos.val := ep; incr lnum; comment bpos s } + | [: `'\013'; s :] ep -> + let ep = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := ep; incr lnum; comment bpos s } + | [: `c; s :] -> comment bpos s + | [: :] ep -> err (bpos, make_pos ep) "comment not terminated" ] + and quote_in_comment bpos = + parser + [ [: `'''; s :] -> comment bpos s + | [: `'\\'; s :] -> quote_antislash_in_comment bpos 0 s + | [: s :] ep -> + do { + match Stream.npeek 2 s with + [ [ ( '\013' | '\010' ); '''] -> + do { bolpos.val := ep; incr lnum; + Stream.junk s; Stream.junk s } + | [ '\013'; '\010' ] -> + match Stream.npeek 3 s with + [ [_; _; '''] -> do { bolpos.val := ep + 1; incr lnum; + Stream.junk s; Stream.junk s; Stream.junk s } + | _ -> () ] + | [_; '''] -> do { Stream.junk s; Stream.junk s } + | _ -> () ]; + comment bpos s + } ] + and quote_any_in_comment bp = + parser + [ [: `'''; s :] -> comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_in_comment bp len = + parser + [ [: `'''; s :] -> comment bp s + | [: `'\\' | '"' | 'n' | 't' | 'b' | 'r'; s :] -> + quote_any_in_comment bp s + | [: `'0'..'9'; s :] -> quote_antislash_digit_in_comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_digit_in_comment bp = + parser + [ [: `'0'..'9'; s :] -> quote_antislash_digit2_in_comment bp s + | [: a = comment bp :] -> a ] + and quote_antislash_digit2_in_comment bp = + parser + [ [: `'0'..'9'; s :] -> quote_any_in_comment bp s + | [: a = comment bp :] -> a ] + and left_paren_in_comment bpos = + parser + [ [: `'*'; s :] -> do { comment bpos s; comment bpos s } + | [: a = comment bpos :] -> a ] + and star_in_comment bpos = + parser + [ [: `')' :] -> () + | [: a = comment bpos :] -> a ] + and linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> True + | _ -> False ] + and any_to_nl = + parser + [ [: `'\010'; _s :] ep -> + do { bolpos.val := ep; incr lnum } + | [: `'\013'; s :] ep -> + let ep = + match Stream.peek s with + [ Some '\010' -> do { Stream.junk s; ep+1 } + | _ -> ep ] in + do { bolpos.val := ep; incr lnum } + | [: `_; s :] -> any_to_nl s + | [: :] -> () ] + and line_directive = parser (* we are sure that there is a line directive here *) + [ [: _ = skip_spaces; n = line_directive_number 0; + _ = skip_spaces; _ = line_directive_string; + _ = any_to_nl :] ep + -> do { (* fname has been updated by by line_directive_string *) + bolpos.val := ep; lnum.val := n + } + ] + and skip_spaces = parser + [ [: `' ' | '\t'; s :] -> skip_spaces s + | [: :] -> () ] + and line_directive_number n = parser + [ [: `('0'..'9' as c) ; s :] + -> line_directive_number (10*n + (Char.code c - Char.code '0')) s + | [: :] -> n ] + and line_directive_string = parser + [ [: ` '"' ; _ = line_directive_string_contents 0 :] -> () + | [: :] -> () + ] + and line_directive_string_contents len = parser + [ [: ` '\010' | '\013' :] -> () + | [: ` '"' :] -> fname.val := get_buff len + | [: `c; s :] -> line_directive_string_contents (store len c) s + ] + in + fun cstrm -> + try + let glex = glexr.val in + let comm_bp = Stream.count cstrm in + let r = next_token False cstrm in + do { + match glex.tok_comm with + [ Some list -> + let next_bp = (fst (snd r)).Lexing.pos_cnum in + if next_bp > comm_bp then + let comm_loc = mkloc (comm_bp, next_bp) in + glex.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (* debug_token r; *) + r + } + with + [ Stream.Error str -> + err (mkloc (Stream.count cstrm, Stream.count cstrm + 1)) str ] +; + + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value func kwd_table glexr = + let bolpos = ref 0 in + let lnum = ref 1 in + let fname = ref "" in + let find = Hashtbl.find kwd_table in + let dfa = dollar_for_antiquotation.val in + let ssd = specific_space_dot.val in + (Token.lexer_func_of_parser (next_token_fun dfa ssd find fname lnum bolpos glexr), + (bolpos, lnum, fname)) +; + +value rec check_keyword_stream = + parser [: _ = check; _ = Stream.empty :] -> True +and check = + parser + [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | '\248'..'\255' + ; + s :] -> + check_ident s + | [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' + ; + s :] -> + check_ident2 s + | [: `'<'; s :] -> + match Stream.npeek 1 s with + [ [':' | '<'] -> () + | _ -> check_ident2 s ] + | [: `':'; + _ = + parser + [ [: `']' | ':' | '=' | '>' :] -> () + | [: :] -> () ] :] -> + () + | [: `'>' | '|'; + _ = + parser + [ [: `']' | '}' :] -> () + | [: a = check_ident2 :] -> a ] :] -> + () + | [: `'[' | '{'; s :] -> + match Stream.npeek 2 s with + [ ['<'; '<' | ':'] -> () + | _ -> + match s with parser + [ [: `'|' | '<' | ':' :] -> () + | [: :] -> () ] ] + | [: `';'; + _ = + parser + [ [: `';' :] -> () + | [: :] -> () ] :] -> + () + | [: `_ :] -> () ] +and check_ident = + parser + [ [: `'A'..'Z' | 'a'..'z' | '\192'..'\214' | '\216'..'\246' | + '\248'..'\255' | '0'..'9' | '_' | ''' + ; + s :] -> + check_ident s + | [: :] -> () ] +and check_ident2 = + parser + [ [: `'!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' + ; + s :] -> + check_ident2 s + | [: :] -> () ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Token.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Token.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (Hashtbl.mem kwd_table p_prm) then + if check_keyword p_prm then + if Hashtbl.mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "INT" | "INT32" | "INT64" | "NATIVEINT" + | "FLOAT" | "CHAR" | "STRING" + | "TILDEIDENT" | "QUESTIONIDENT" | "LABEL" | "OPTLABEL" + | "QUOTATION" | "ANTIQUOT" | "LOCATE" | "EOI" -> + () + | _ -> + raise + (Token.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT32", "") -> "32 bits integer" + | ("INT64", "") -> "64 bits integer" + | ("NATIVEINT", "") -> "native integer" + | (("INT" | "INT32" | "NATIVEINT"), s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("LOCATE", "") -> "locate" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Token.default_match tok ] +; + +value make_lexer () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let (f,pos) = func kwd_table glexr in + let glex = + {tok_func = f; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; (glex, pos) } +; + +value gmake () = + let (p,_) = make_lexer () in p +; + +value tparse = + fun + [ ("ANTIQUOT", p_prm) -> + let p = + parser + [: `("ANTIQUOT", prm) when eq_before_colon p_prm prm :] -> + after_colon prm + in + Some p + | _ -> None ] +; + +value make () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + {func = fst(func kwd_table glexr); using = using_token kwd_table id_table; + removing = removing_token kwd_table id_table; tparse = tparse; text = text} +; + +(* ------------------------------------------------------------------------- *) +(* Resume the main file. *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + let (lexer, pos) = make_lexer () in + Pcaml.position.val := pos; + Grammar.Unsafe.gram_reinit gram lexer; + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_declaration; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value o2b = + fun + [ Some _ -> True + | None -> False ] +; + +value mkexprident _loc ids = match ids with + [ [] -> Stdpp.raise_with_loc _loc (Stream.Error "illegal long identifier") + | [ id :: ids ] -> + let rec loop m = fun + [ [ id :: ids ] -> loop <:expr< $m$ . $id$ >> ids + | [] -> m ] + in + loop id ids ] +; + +value mkumin _loc f arg = + match (f, arg) with + [ ("-", <:expr< $int:n$ >>) when int_of_string n > 0 -> + let n = "-" ^ n in + <:expr< $int:n$ >> + | ("-", MLast.ExInt32 loc n) when (Int32.of_string n) > 0l -> + MLast.ExInt32 loc ("-" ^ n) + | ("-", MLast.ExInt64 loc n) when (Int64.of_string n) > 0L -> + MLast.ExInt64 loc ("-" ^ n) + | ("-", MLast.ExNativeInt loc n) when (Nativeint.of_string n) > 0n -> + MLast.ExNativeInt loc ("-" ^ n) + | (_, <:expr< $flo:n$ >>) when float_of_string n > 0.0 -> + let n = "-" ^ n in + <:expr< $flo:n$ >> + | _ -> + let f = "~" ^ f in + <:expr< $lid:f$ $arg$ >> ] +; + + +value mklistexp _loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let _loc = if top then _loc else (fst (MLast.loc_of_expr e1), snd _loc) in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat _loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let _loc = if top then _loc else (fst (MLast.loc_of_patt p1), snd _loc) in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = + let ct = Hashtbl.create 73 in + do { + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] + } +; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +(*** And JRH inserted it in here ***) + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> + do { Stream.junk strm; Stream.junk strm; translate_operator s } + | _ -> raise Stream.Failure ]) +; + +value lident_colon = + Grammar.Entry.of_parser gram "lident_colon" + (fun strm -> + match Stream.npeek 2 strm with + [ [("LIDENT", i); ("", ":")] -> + do { Stream.junk strm; Stream.junk strm; i } + | _ -> raise Stream.Failure ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + let rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False + in + loop +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity _loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity _loc e + | <:expr< $e$ $_$ >> -> + if is_expr_constr_call e then + Stdpp.raise_with_loc _loc (Stream.Error "currified constructor") + else 1 + | _ -> 1 ] +; + +value rec is_patt_constr_call = + fun + [ <:patt< $uid:_$ >> -> True + | <:patt< $uid:_$.$p$ >> -> is_patt_constr_call p + | <:patt< $p$ $_$ >> -> is_patt_constr_call p + | _ -> False ] +; + +value rec constr_patt_arity _loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity _loc p + | <:patt< $p$ $_$ >> -> + if is_patt_constr_call p then + Stdpp.raise_with_loc _loc (Stream.Error "currified constructor") + else 1 + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if List.mem_assoc s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if List.mem_assoc v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value rec patt_lid = + fun + [ <:patt< $p1$ $p2$ >> -> + match p1 with + [ <:patt< $lid:i$ >> -> Some (MLast.loc_of_patt p1, i, [p2]) + | _ -> + match patt_lid p1 with + [ Some (loc, i, pl) -> Some (loc, i, [p2 :: pl]) + | None -> None ] ] + | _ -> None ] +; + +value bigarray_get _loc arr arg = + let coords = + match arg with + [ <:expr< ($list:el$) >> -> el + | _ -> [arg] ] + in + match coords with + [ [c1] -> <:expr< Bigarray.Array1.get $arr$ $c1$ >> + | [c1; c2] -> <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> + | [c1; c2; c3] -> <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> + | coords -> <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> ] +; + +value bigarray_set _loc var newval = + match var with + [ <:expr< Bigarray.Array1.get $arr$ $c1$ >> -> + Some <:expr< Bigarray.Array1.set $arr$ $c1$ $newval$ >> + | <:expr< Bigarray.Array2.get $arr$ $c1$ $c2$ >> -> + Some <:expr< Bigarray.Array2.set $arr$ $c1$ $c2$ $newval$ >> + | <:expr< Bigarray.Array3.get $arr$ $c1$ $c2$ $c3$ >> -> + Some <:expr< Bigarray.Array3.set $arr$ $c1$ $c2$ $c3$ $newval$ >> + | <:expr< Bigarray.Genarray.get $arr$ [| $list:coords$ |] >> -> + Some <:expr< Bigarray.Genarray.set $arr$ [| $list:coords$ |] $newval$ >> + | _ -> None ] +; + +(* ...works bad... +value rec sync cs = + match cs with parser + [ [: `';' :] -> sync_semi cs + | [: `_ :] -> sync cs ] +and sync_semi cs = + match cs with parser + [ [: `';' :] -> sync_semisemi cs + | [: :] -> sync cs ] +and sync_semisemi cs = + match Stream.peek cs with + [ Some ('\010' | '\013') -> () + | _ -> sync_semi cs ] +; +Pcaml.sync.val := sync; +*) + + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type + class_expr class_sig_item class_str_item let_binding type_declaration; + module_expr: + [ [ "functor"; "("; i = UIDENT; ":"; t = module_type; ")"; "->"; + me = SELF -> + <:module_expr< functor ( $i$ : $t$ ) -> $me$ >> + | "struct"; st = LIST0 [ s = str_item; OPT ";;" -> s ]; "end" -> + <:module_expr< struct $list:st$ end >> ] + | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = UIDENT -> <:module_expr< $uid:i$ >> ] ] + ; + + str_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> + <:str_item< exception $c$ of $list:tl$ = $b$ >> + | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> + <:str_item< external $i$ : $t$ = $list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = LIST1 STRING -> + <:str_item< external $i$ : $t$ = $list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; i = UIDENT; mb = module_binding -> + <:str_item< module $i$ = $mb$ >> + | "module"; "rec"; nmtmes = LIST1 module_rec_binding SEP "and" -> + MLast.StRecMod _loc nmtmes + | "module"; "type"; i = UIDENT; "="; mt = module_type -> + <:str_item< module type $i$ = $mt$ >> + | "open"; i = mod_ident -> <:str_item< open $i$ >> + | "type"; tdl = LIST1 type_declaration SEP "and" -> + <:str_item< type $list:tdl$ >> + | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; + x = expr -> + let e = <:expr< let $opt:o2b r$ $list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = OPT "rec"; l = LIST1 let_binding SEP "and" -> + match l with + [ [(<:patt< _ >>, e)] -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $opt:o2b r$ $list:l$ >> ] + | "let"; "module"; m = UIDENT; mb = module_binding; "in"; e = expr -> + <:str_item< let module $m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + + rebind_exn: + [ [ "="; sl = mod_ident -> sl + | -> [] ] ] + ; + module_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + module_rec_binding: + [ [ m = UIDENT; ":"; mt = module_type; "="; me = module_expr -> + (m, mt, me) ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = UIDENT; ":"; t = SELF; ")"; "->"; mt = SELF -> + <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = LIST1 with_constr SEP "and" -> + <:module_type< $mt$ with $list:wcl$ >> ] + | [ "sig"; sg = LIST0 [ s = sig_item; OPT ";;" -> s ]; "end" -> + <:module_type< sig $list:sg$ end >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = UIDENT -> <:module_type< $uid:m$ >> + | m = LIDENT -> <:module_type< $lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration -> + <:sig_item< exception $c$ of $list:tl$ >> + | "external"; i = LIDENT; ":"; t = ctyp; "="; pd = LIST1 STRING -> + <:sig_item< external $i$ : $t$ = $list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = LIST1 STRING -> + <:sig_item< external $i$ : $t$ = $list:pd$ >> + | "include"; mt = module_type -> <:sig_item< include $mt$ >> + | "module"; i = UIDENT; mt = module_declaration -> + <:sig_item< module $i$ : $mt$ >> + | "module"; "rec"; mds = LIST1 module_rec_declaration SEP "and" -> + MLast.SgRecMod _loc mds + | "module"; "type"; i = UIDENT; "="; mt = module_type -> + <:sig_item< module type $i$ = $mt$ >> + | "module"; "type"; i = UIDENT -> + <:sig_item< module type $i$ = 'abstract >> + | "open"; i = mod_ident -> <:sig_item< open $i$ >> + | "type"; tdl = LIST1 type_declaration SEP "and" -> + <:sig_item< type $list:tdl$ >> + | "val"; i = LIDENT; ":"; t = ctyp -> <:sig_item< value $i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $i$ : $t$ >> ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $i$ : $t$ ) -> $mt$ >> ] ] + ; + module_rec_declaration: + [ [ m = UIDENT; ":"; mt = module_type -> (m, mt)] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = type_parameters; i = mod_ident; "="; t = ctyp -> + MLast.WcTyp _loc i tpl t + | "module"; i = mod_ident; "="; me = module_expr -> + MLast.WcMod _loc i me ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 ] + | "expr1" + [ "let"; o = OPT "rec"; l = LIST1 let_binding SEP "and"; "in"; + x = expr LEVEL "top" -> + <:expr< let $opt:o2b o$ $list:l$ in $x$ >> + | "let"; "module"; m = UIDENT; mb = module_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< fun [ $list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; e = fun_def -> + <:expr< fun [$p$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< match $e$ with [ $list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = LIST1 match_case SEP "|" -> + <:expr< try $e$ with [ $list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; + "else"; e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = LIDENT; "="; e1 = SELF; df = direction_flag; e2 = SELF; + "do"; e = SELF; "done" -> + <:expr< for $i$ = $e1$ $to:df$ $e2$ do { $list:get_seq e$ } >> + | "while"; e1 = SELF; "do"; e2 = SELF; "done" -> + <:expr< while $e1$ do { $list:get_seq e2$ } >> + | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> + (* <:expr< object $opt:cspo$ $list:cf$ end >> *) + MLast.ExObj _loc cspo cf ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> + match bigarray_set _loc e1 e2 with + [ Some e -> e + | None -> <:expr< $e1$ := $e2$ >> ] ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; "$"; e2 = SELF -> <:expr< $lid:"\$"$ $e1$ $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< $mkumin _loc "-" e$ >> + | "-."; e = SELF -> <:expr< $mkumin _loc "-." e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + match constr_expr_arity _loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> + match e with + [ <:expr< False >> -> <:expr< assert False >> + | _ -> <:expr< assert ($e$) >> ] + | "lazy"; e = SELF -> + <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e1 = SELF; "."; "{"; e2 = SELF; "}" -> bigarray_get _loc e1 e2 + | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val>> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = INT -> <:expr< $int:s$ >> + | s = INT32 -> MLast.ExInt32 _loc s + | s = INT64 -> MLast.ExInt64 _loc s + | s = NATIVEINT -> MLast.ExNativeInt _loc s + | s = FLOAT -> <:expr< $flo:s$ >> + | s = STRING -> <:expr< $str:s$ >> + | c = CHAR -> <:expr< $chr:c$ >> + | UIDENT "True" -> <:expr< $uid:" True"$ >> + | UIDENT "False" -> <:expr< $uid:" False"$ >> + | ids = expr_ident -> mkexprident _loc ids + | s = "false" -> <:expr< False >> + | s = "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp _loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = expr1_semi_list; "|]" -> <:expr< [| $list:el$ |] >> + | "{"; test_label_eq; lel = lbl_expr_list; "}" -> + <:expr< { $list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = lbl_expr_list; "}" -> + <:expr< { ($e$) with $list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> <:expr< $e$ >> + | "begin"; e = SELF; "end" -> <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = LOCATE -> + let x = + try + let i = String.index x ':' in + ({Lexing.pos_fname = ""; + Lexing.pos_lnum = 0; + Lexing.pos_bol = 0; + Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found | Failure _ -> (Token.nowhere, x) ] + in + Pcaml.handle_expr_locate _loc x + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_expr_quotation _loc x ] ] + ; + let_binding: + [ [ p = patt; e = fun_binding -> + match patt_lid p with + [ Some (_loc, i, pl) -> + let e = + List.fold_left (fun e p -> <:expr< fun $p$ -> $e$ >>) e pl + in + (<:patt< $lid:i$ >>, e) + | None -> (p, e) ] ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":>"; t = ctyp; "="; e = expr -> <:expr< ($e$ :> $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = OPT [ "when"; e = expr -> e ]; "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] + | e = expr LEVEL "expr1"; ";" -> [e] + | e = expr LEVEL "expr1" -> [e] ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "->"; e = expr -> <:expr< $e$ >> ] ] + ; + expr_ident: + [ RIGHTA + [ i = LIDENT -> [ <:expr< $lid:i$ >> ] + | i = UIDENT -> [ <:expr< $uid:i$ >> ] + | i = UIDENT; "."; "("; j = operator_rparen -> + [ <:expr< $uid:i$ >> ; <:expr< $lid:j$ >> ] + | i = UIDENT; "."; j = SELF -> [ <:expr< $uid:i$ >> :: j ] + ] + ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + match constr_patt_arity _loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = LIDENT -> <:patt< $lid:s$ >> + | s = UIDENT -> <:patt< $uid:s$ >> + | s = INT -> <:patt< $int:s$ >> + | s = INT32 -> MLast.PaInt32 _loc s + | s = INT64 -> MLast.PaInt64 _loc s + | s = NATIVEINT -> MLast.PaNativeInt _loc s + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = INT32 -> MLast.PaInt32 _loc ("-" ^ s) + | "-"; s = INT64 -> MLast.PaInt64 _loc ("-" ^ s) + | "-"; s = NATIVEINT -> MLast.PaNativeInt _loc ("-" ^ s) + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = FLOAT -> <:patt< $flo:s$ >> + | s = STRING -> <:patt< $str:s$ >> + | s = CHAR -> <:patt< $chr:s$ >> + | UIDENT "True" -> <:patt< $uid:" True"$ >> + | UIDENT "False" -> <:patt< $uid:" False"$ >> + | s = "false" -> <:patt< False >> + | s = "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat _loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = patt_semi_list; "|]" -> <:patt< [| $list:pl$ |] >> + | "{"; lpl = lbl_patt_list; "}" -> <:patt< { $list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = patt; ")" -> <:patt< $p$ >> + | "_" -> <:patt< _ >> + | "`"; s = ident -> <:patt< ` $s$ >> + | "#"; t = mod_ident -> <:patt< # $list:t$ >> + | x = LOCATE -> + let x = + try + let i = String.index x ':' in + ({Lexing.pos_fname = ""; + Lexing.pos_lnum = 0; + Lexing.pos_bol = 0; + Lexing.pos_cnum = int_of_string (String.sub x 0 i)}, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found | Failure _ -> (Token.nowhere, x) ] + in + Pcaml.handle_patt_locate _loc x + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_patt_quotation _loc x ] ] + ; + + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_declaration: + [ [ tpl = type_parameters; n = type_patt; "="; tk = type_kind; + cl = LIST0 constrain -> + (n, tpl, tk, cl) + | tpl = type_parameters; n = type_patt; cl = LIST0 constrain -> + (n, tpl, <:ctyp< '$choose_tvar tpl$ >>, cl) ] ] + ; + type_patt: + [ [ n = LIDENT -> (_loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ "private"; tk = type_kind -> <:ctyp< private $tk$ >> + | test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> <:ctyp< $t$ >> + | t = ctyp; "="; "private"; tk = type_kind -> + <:ctyp< $t$ == private $tk$ >> + | t = ctyp; "="; "{"; ldl = label_declarations; "}" -> + <:ctyp< $t$ == { $list:ldl$ } >> + | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == [ $list:cdl$ ] >> + | "{"; ldl = label_declarations; "}" -> + <:ctyp< { $list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "'"; i = ident -> (i, (False, False)) + | "+"; "'"; i = ident -> (i, (True, False)) + | "-"; "'"; i = ident -> (i, (False, True)) ] ] + ; + constructor_declaration: + [ [ ci = UIDENT; "of"; cal = LIST1 ctyp LEVEL "ctyp1" SEP "*" -> + (_loc, ci, cal) + | ci = UIDENT -> (_loc, ci, []) ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (_loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (_loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "ctyp1") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "ctyp1" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = ident -> <:ctyp< '$i$ >> + | "_" -> <:ctyp< _ >> + | i = LIDENT -> <:ctyp< $lid:i$ >> + | i = UIDENT -> <:ctyp< $uid:i$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = LIST1 class_declaration SEP "and" -> + <:str_item< class $list:cd$ >> + | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> + <:str_item< class type $list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = LIST1 class_description SEP "and" -> + <:sig_item< class $list:cd$ >> + | "class"; "type"; ctd = LIST1 class_type_declaration SEP "and" -> + <:sig_item< class type $list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; i = LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = _loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (_loc, []) + | "["; tpl = LIST1 type_parameter SEP ","; "]" -> (_loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = OPT "rec"; lb = LIST1 let_binding SEP "and"; "in"; + ce = SELF -> + <:class_expr< let $opt:o2b rf$ $list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< $list:ci$ [ $ct$ ] >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = OPT class_self_patt; cf = class_structure; "end" -> + <:class_expr< object $opt:cspo$ $list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = OPT [ "as"; i = LIDENT -> i ] -> + <:class_str_item< inherit $ce$ $opt:pb$ >> + | "val"; mf = OPT "mutable"; lab = label; e = cvalue_binding -> + <:class_str_item< value $opt:o2b mf$ $lab$ = $e$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; l = label; ":"; t = poly_type -> + <:class_str_item< method virtual $l$ : $t$ >> + | "method"; "private"; l = label; ":"; t = poly_type; "="; e = expr -> + MLast.CrMth _loc l True e (Some t) + | "method"; "private"; l = label; sb = fun_binding -> + MLast.CrMth _loc l True sb None + | "method"; l = label; ":"; t = poly_type; "="; e = expr -> + MLast.CrMth _loc l False e (Some t) + | "method"; l = label; sb = fun_binding -> + MLast.CrMth _loc l False sb None + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> + <:class_type< $list:id$ [ $list:tl$ ] >> + | id = clty_longident -> <:class_type< $list:id$ >> + | "object"; cst = OPT class_self_type; csf = LIST0 class_sig_item; + "end" -> + <:class_type< object $opt:cst$ $list:csf$ end >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> <:class_sig_item< inherit $cs$ >> + | "val"; mf = OPT "mutable"; l = label; ":"; t = ctyp -> + <:class_sig_item< value $opt:o2b mf$ $l$ : $t$ >> + | "method"; "private"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; "private"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual private $l$ : $t$ >> + | "method"; "virtual"; l = label; ":"; t = poly_type -> + <:class_sig_item< method virtual $l$ : $t$ >> + | "method"; "private"; l = label; ":"; t = poly_type -> + <:class_sig_item< method private $l$ : $t$ >> + | "method"; l = label; ":"; t = poly_type -> + <:class_sig_item< method $l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; ":"; + ct = class_type -> + {MLast.ciLoc = _loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = OPT "virtual"; ctp = class_type_parameters; n = LIDENT; "="; + cs = class_signature -> + {MLast.ciLoc = _loc; MLast.ciVir = o2b vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = class_longident -> <:expr< new $list:i$ >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = label -> <:expr< $e$ # $lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = field_expr_list; ">}" -> <:expr< {< $list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = class_longident -> <:ctyp< # $list:id$ >> + | "<"; (ml, v) = meth_list; ">" -> <:ctyp< < $list:ml$ $opt:v$ > >> + | "<"; ">" -> <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; (ml, v) = SELF -> ([f :: ml], v) + | f = field; ";" -> ([f], False) + | f = field -> ([f], False) + | ".." -> ([], True) ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + clty_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: LEVEL "arrow" + [ RIGHTA + [ i = lident_colon; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ~ $i$ : $t1$ ) -> $t2$ >> + | i = OPTLABEL; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> + | i = QUESTIONIDENT; ":"; t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> + | "?"; i=lident_colon;t1 = ctyp LEVEL "star"; "->"; t2 = SELF -> + <:ctyp< ( ? $i$ : $t1$ ) -> $t2$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ = $list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ > $list:rfl$ ] >> + | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; "]" -> + <:ctyp< [ < $list:rfl$ ] >> + | "[<"; OPT "|"; rfl = LIST1 row_field SEP "|"; ">"; + ntl = LIST1 name_tag; "]" -> + <:ctyp< [ < $list:rfl$ > $list:ntl$ ] >> ] ] + ; + row_field: + [ [ "`"; i = ident -> MLast.RfTag i True [] + | "`"; i = ident; "of"; ao = OPT "&"; l = LIST1 ctyp SEP "&" -> + MLast.RfTag i (o2b ao) l + | t = ctyp -> MLast.RfInh t ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = LABEL; e = SELF -> <:expr< ~ $i$ : $e$ >> + | i = TILDEIDENT -> <:expr< ~ $i$ >> + | "~"; i = LIDENT -> <:expr< ~ $i$ >> + | i = OPTLABEL; e = SELF -> <:expr< ? $i$ : $e$ >> + | i = QUESTIONIDENT -> <:expr< ? $i$ >> + | "?"; i = LIDENT -> <:expr< ? $i$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = ident -> <:expr< ` $s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + labeled_patt: + [ [ i = LABEL; p = patt LEVEL "simple" -> + <:patt< ~ $i$ : $p$ >> + | i = TILDEIDENT -> + <:patt< ~ $i$ >> + | "~"; i=LIDENT -> <:patt< ~ $i$ >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~ $i$ >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~ $i$ : ($lid:i$ : $t$) >> + | i = OPTLABEL; j = LIDENT -> + <:patt< ? $i$ : ($lid:j$) >> + | i = OPTLABEL; "("; p = patt; "="; e = expr; ")" -> + <:patt< ? $i$ : ( $p$ = $e$ ) >> + | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ? $i$ : ( $p$ : $t$ ) >> + | i = OPTLABEL; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ? $i$ : ( $p$ : $t$ = $e$ ) >> + | i = QUESTIONIDENT -> <:patt< ? $i$ >> + | "?"; i = LIDENT -> <:patt< ? $i$ >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ = $e$ ) >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ? $i$ >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ? ( $lid:i$ : $t$ ) >> ] ] + ; + class_type: + [ [ i = lident_colon; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ~ $i$ : $t$ ] -> $ct$ >> + | i = OPTLABEL; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | i = QUESTIONIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> + | "?"; i = LIDENT; ":"; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ ? $i$ : $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $n$ $opt:dp$ >>, _loc)], True) + | EOI -> ([], False) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, _loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $n$ $opt:dp$ >>, _loc)], True) + | EOI -> ([], False) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, _loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> <:str_item< # $n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.1x_5.xx.ml b/pa_j_3.1x_5.xx.ml new file mode 100644 index 0000000..c845d75 --- /dev/null +++ b/pa_j_3.1x_5.xx.ml @@ -0,0 +1,2027 @@ +(* camlp5r pa_extend.cmo q_MLast.cmo *) +(* $Id: pa_o.ml 1271 2007-10-01 08:22:47Z deraugla $ *) +(* Copyright (c) INRIA 2007 *) + +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* camlp5r pa_lexer.cmo *) +(* $Id: plexer.ml 1402 2007-10-14 02:50:31Z deraugla $ *) +(* Copyright (c) INRIA 2007 *) + +(* ------------------------------------------------------------------------- *) +(* Added by JRH as a backdoor to change lexical conventions. *) +(* ------------------------------------------------------------------------- *) + +value jrh_lexer = ref False; + +value no_quotations = ref False; +value error_on_unknown_keywords = ref False; + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value force_antiquot_loc = ref False; + +(* The string buffering machinery *) + +value rev_implode l = + let s = String.create (List.length l) in + loop (String.length s - 1) l where rec loop i = + fun + [ [c :: l] -> do { String.unsafe_set s i c; loop (i - 1) l } + | [] -> s ] +; + +(* The lexer *) + +type context = + { after_space : mutable bool; + dollar_for_antiquotation : bool; + specific_space_dot : bool; + find_kwd : string -> string; + line_cnt : int -> char -> unit; + set_line_nb : unit -> unit; + make_lined_loc : (int * int) -> string -> Ploc.t } +; + +value err ctx loc msg = + Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) +; + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** JRH: Carl's alternative version + then ("UIDENT", id) + else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) + else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +value keyword_or_error ctx loc s = + try ("", ctx.find_kwd s) with + [ Not_found -> + if error_on_unknown_keywords.val then + err ctx loc ("illegal token: " ^ s) + else ("", s) ] +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value rec ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | '\128'-'\255' ] ident! | ] +; +value rec ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' ] + ident2! + | ] +; + +value rec ident3 = + lexer + [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | + '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' | '\128'-'\255' ] ident3! + | ] +; + +value binary = lexer [ '0' | '1' ]; +value octal = lexer [ '0'-'7' ]; +value decimal = lexer [ '0'-'9' ]; +value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; + +value end_integer = + lexer + [ "l"/ -> ("INT_l", $buf) + | "L"/ -> ("INT_L", $buf) + | "n"/ -> ("INT_n", $buf) + | -> ("INT", $buf) ] +; + +value rec digits_under kind = + lexer + [ kind (digits_under kind)! + | "_" (digits_under kind)! + | end_integer ] +; + +value digits kind = + lexer + [ kind (digits_under kind)! + | -> raise (Stream.Error "ill-formed integer constant") ] +; + +value rec decimal_digits_under = + lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] +; + +value exponent_part = + lexer + [ [ 'e' | 'E' ] [ '+' | '-' | ] + '0'-'9' ? "ill-formed floating-point constant" + decimal_digits_under! ] +; + +value number = + lexer + [ decimal_digits_under "." decimal_digits_under! exponent_part -> + ("FLOAT", $buf) + | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) + | decimal_digits_under exponent_part -> ("FLOAT", $buf) + | decimal_digits_under end_integer! ] +; + +value rec char_aux ctx bp = + lexer + [ "'"/ + | _ (char_aux ctx bp)! + | -> err ctx (bp, $pos) "char not terminated" ] +; + +value char ctx bp = + lexer + [ "\\" _ (char_aux ctx bp)! + | "\\" -> err ctx (bp, $pos) "char not terminated" + | ?= [ _ '''] _! "'"/ ] +; + +value any ctx buf = + parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } +; + +value rec string ctx bp = + lexer + [ "\""/ + | "\\" (any ctx) (string ctx bp)! + | (any ctx) (string ctx bp)! + | -> err ctx (bp, $pos) "string not terminated" ] +; + +value rec qstring ctx bp = + lexer + [ "`"/ + | (any ctx) (qstring ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value comment ctx bp = + comment where rec comment = + lexer + [ "*)" + | "*" comment! + | "(*" comment! comment! + | "(" comment! + | "\"" (string ctx bp)! [ -> $add "\"" ] comment! + | "'" (char ctx bp) comment! + | "'" comment! + | (any ctx) comment! + | -> err ctx (bp, $pos) "comment not terminated" ] +; + +value rec quotation ctx bp = + lexer + [ ">>"/ + | ">" (quotation ctx bp)! + | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! (quotation ctx bp)! + | "<" (quotation ctx bp)! + | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! + | "\\" (quotation ctx bp)! + | (any ctx) (quotation ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value less ctx bp buf strm = + if no_quotations.val then + match strm with lexer + [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] + else + match strm with lexer + [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) + | ":"/ ident! [ -> $add ":" ]! "<"/ ? "character '<' expected" + (quotation ctx bp) -> + ("QUOTATION", $buf) + | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec antiquot_rest ctx bp = + lexer + [ "$"/ + | "\\"/ (any ctx) (antiquot_rest ctx bp)! + | (any ctx) (antiquot_rest ctx bp)! + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value rec antiquot ctx bp = + lexer + [ "$"/ -> ":" ^ $buf + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '_' ] (antiquot ctx bp)! + | ":" (antiquot_rest ctx bp)! -> $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; + +value rec antiquot_loc ctx bp = + lexer + [ "$"/ -> antiloc bp $pos (":" ^ $buf) + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '_' ] (antiquot_loc ctx bp)! + | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value dollar ctx bp buf strm = + if ctx.dollar_for_antiquotation then + ("ANTIQUOT", antiquot ctx bp buf strm) + else if force_antiquot_loc.val then + ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) + else + match strm with lexer + [ [ -> $add "$" ] ident2! -> ("", $buf) ] +; + +(* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?abc:d ?abc + ?$abc:d$: ?abc:d: ?abc: + ?$d$ ?:d ? + ?$d$: ?:d: ?: +*) + +(* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?8,13:abc:d ?abc + ?$abc:d$: ?8,13:abc:d: ?abc: + ?$d$ ?8,9::d ? + ?$d$: ?8,9::d: ?: +*) + +value question ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "?" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "?" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tilde ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "~" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "~" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tildeident = + lexer + [ ":"/ -> ("TILDEIDENTCOLON", $buf) + | -> ("TILDEIDENT", $buf) ] +; + +value questionident = + lexer + [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) + | -> ("QUESTIONIDENT", $buf) ] +; + +value rec linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] +and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] +and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] +; + +value rec any_to_nl = + lexer + [ "\r" | "\n" + | _ any_to_nl! + | ] +; + +value next_token_after_spaces ctx bp = + lexer + [ 'A'-'Z' ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] + *********) + | [ 'a'-'z' | '_' | '\128'-'\255' ] ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] + *********) + | '1'-'9' number! + | "0" [ 'o' | 'O' ] (digits octal)! + | "0" [ 'x' | 'X' ] (digits hexa)! + | "0" [ 'b' | 'B' ] (digits binary)! + | "0" number! + | "'"/ (char ctx bp) -> ("CHAR", $buf) + | "'" -> keyword_or_error ctx (bp, $pos) "'" + | "\""/ (string ctx bp)! -> ("STRING", $buf) +(*** Line added by JRH ***) + | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) + | "$"/ (dollar ctx bp)! + | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> + keyword_or_error ctx (bp, $pos) $buf + | "~"/ 'a'-'z' ident! tildeident! + | "~" (tilde ctx bp) + | "?"/ 'a'-'z' ident! questionident! + | "?" (question ctx bp)! + | "<"/ (less ctx bp)! + | ":]" -> keyword_or_error ctx (bp, $pos) $buf + | "::" -> keyword_or_error ctx (bp, $pos) $buf + | ":=" -> keyword_or_error ctx (bp, $pos) $buf + | ":>" -> keyword_or_error ctx (bp, $pos) $buf + | ":" -> keyword_or_error ctx (bp, $pos) $buf + | ">]" -> keyword_or_error ctx (bp, $pos) $buf + | ">}" -> keyword_or_error ctx (bp, $pos) $buf + | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "|]" -> keyword_or_error ctx (bp, $pos) $buf + | "|}" -> keyword_or_error ctx (bp, $pos) $buf + | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "[|" -> keyword_or_error ctx (bp, $pos) $buf + | "[<" -> keyword_or_error ctx (bp, $pos) $buf + | "[:" -> keyword_or_error ctx (bp, $pos) $buf + | "[" -> keyword_or_error ctx (bp, $pos) $buf + | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "{|" -> keyword_or_error ctx (bp, $pos) $buf + | "{<" -> keyword_or_error ctx (bp, $pos) $buf + | "{:" -> keyword_or_error ctx (bp, $pos) $buf + | "{" -> keyword_or_error ctx (bp, $pos) $buf + | ".." -> keyword_or_error ctx (bp, $pos) ".." + | "." -> + let id = + if ctx.specific_space_dot && ctx.after_space then " ." else "." + in + keyword_or_error ctx (bp, $pos) id + | ";;" -> keyword_or_error ctx (bp, $pos) ";;" + | ";" -> keyword_or_error ctx (bp, $pos) ";" + | "\\"/ ident3! -> ("LIDENT", $buf) + | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec next_token ctx buf = + parser bp + [ [: `('\n' | '\r' as c); s :] ep -> do { + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := ep; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> + if linedir 1 s then do { + let buf = any_to_nl ($add '#') s in + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := Stream.count s; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + else + let loc = ctx.make_lined_loc (bp, bp + 1) $buf in + (keyword_or_error ctx (bp, bp + 1) "#", loc) + | [: `'('; + a = + parser + [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + | [: :] ep -> + let loc = ctx.make_lined_loc (bp, ep) $buf in + (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a + | [: tok = next_token_after_spaces ctx bp $empty :] ep -> + let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) $buf in + (tok, loc) + | [: _ = Stream.empty :] -> + let loc = ctx.make_lined_loc (bp, bp + 1) $buf in + (("EOI", ""), loc) ] +; + +value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = + try do { + match Plexing.restore_lexing_info.val with + [ Some (line_nb, bol_pos) -> do { + s_line_nb.val := line_nb; + s_bol_pos.val := bol_pos; + Plexing.restore_lexing_info.val := None + } + | None -> () ]; + Plexing.line_nb.val := s_line_nb; + Plexing.bol_pos.val := s_bol_pos; + let comm_bp = Stream.count cstrm in + ctx.set_line_nb (); + ctx.after_space := False; + let (r, loc) = next_token ctx $empty cstrm in + match glexr.val.Plexing.tok_comm with + [ Some list -> + if Ploc.first_pos loc > comm_bp then + let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in + glexr.val.Plexing.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (r, loc) + } + with + [ Stream.Error str -> + err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + +value func kwd_table glexr = + let ctx = + let line_nb = ref 0 in + let bol_pos = ref 0 in + {after_space = False; + dollar_for_antiquotation = dollar_for_antiquotation.val; + specific_space_dot = specific_space_dot.val; + find_kwd = Hashtbl.find kwd_table; + line_cnt bp1 c = + match c with + [ '\n' | '\r' -> do { + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := bp1 + 1; + } + | c -> () ]; + set_line_nb () = do { + line_nb.val := Plexing.line_nb.val.val; + bol_pos.val := Plexing.bol_pos.val.val; + }; + make_lined_loc loc comm = + Ploc.make line_nb.val bol_pos.val loc} + in + Plexing.lexer_func_of_parser (next_token_fun ctx glexr) +; + +value rec check_keyword_stream = + parser [: _ = check $empty; _ = Stream.empty :] -> True +and check = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '\128'-'\255' ] check_ident! + | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' ] + check_ident2! + | "$" check_ident2! + | "<" ?= [ ":" | "<" ] + | "<" check_ident2! + | ":]" + | "::" + | ":=" + | ":>" + | ":" + | ">]" + | ">}" + | ">" check_ident2! + | "|]" + | "|}" + | "|" check_ident2! + | "[" ?= [ "<<" | "<:" ] + | "[|" + | "[<" + | "[:" + | "[" + | "{" ?= [ "<<" | "<:" ] + | "{|" + | "{<" + | "{:" + | "{" + | ";;" + | ";" + | _ ] +and check_ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | '\128'-'\255' ] + check_ident! | ] +and check_ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' | ':' | '<' | '>' | '|' ] + check_ident2! | ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Plexing.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Plexing.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (Hashtbl.mem kwd_table p_prm) then + if check_keyword p_prm then + if Hashtbl.mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if Hashtbl.mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | + "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | + "CHAR" | "STRING" | "QUOTATION" | + "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> + () + | _ -> + raise + (Plexing.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT", s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value after_colon_except_last e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 2) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then + if p_prm.[String.length p_prm - 1] = ':' then + let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + if eq_before_colon p_prm prm then after_colon_except_last prm + else raise Stream.Failure + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + raise Stream.Failure + else if eq_before_colon p_prm prm then after_colon prm + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Plexing.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {Plexing.tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_declaration; + Grammar.Unsafe.clear_entry constructor_declaration; + Grammar.Unsafe.clear_entry match_case; + Grammar.Unsafe.clear_entry with_constr; + Grammar.Unsafe.clear_entry poly_variant; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value neg_string n = + let len = String.length n in + if len > 0 && n.[0] = '-' then String.sub n 1 (len - 1) else "-" ^ n +; + +value mkumin loc f arg = + match arg with + [ <:expr< $int:n$ >> -> <:expr< $int:neg_string n$ >> + | <:expr< $flo:n$ >> -> <:expr< $flo:neg_string n$ >> + | _ -> + let f = "~" ^ f in + <:expr< $lid:f$ $arg$ >> ] +; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc + in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc + in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = do { + let ct = Hashtbl.create 73 in + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] +}; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +(*** And JRH inserted it in here ***) + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> do { + Stream.junk strm; + Stream.junk strm; + translate_operator s + } + | _ -> raise Stream.Failure ]) +; + +value check_not_part_of_patt = + Grammar.Entry.of_parser gram "check_not_part_of_patt" + (fun strm -> + let tok = + match Stream.npeek 4 strm with + [ [("LIDENT", _); tok :: _] -> tok + | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok + | _ -> raise Stream.Failure ] + in + match tok with + [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure + | _ -> () ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + loop where rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"; "?!"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("ANTIQUOT_LOC", _) -> () + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | _ -> 1 ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value mem_tvar s tpl = List.exists (fun (t, _) -> Pcaml.unvala t = s) tpl; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if mem_tvar s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if mem_tvar v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr class_type + class_expr class_sig_item class_str_item let_binding type_declaration + constructor_declaration match_case with_constr poly_variant; + module_expr: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; + "->"; me = SELF -> + <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> + | "struct"; st = V (LIST0 [ s = str_item; OPT ";;" -> s ]); "end" -> + <:module_expr< struct $_list:st$ end >> ] + | [ me1 = SELF; me2 = SELF -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration; b = rebind_exn -> + <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> + <:str_item< module $_flag:r$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:str_item< module type $_uid:i$ = $mt$ >> + | "open"; i = V mod_ident "list" "" -> + <:str_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_declaration SEP "and") -> + <:str_item< type $_list:tdl$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr -> + let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> + match l with + [ <:vala< [(p, e)] >> -> + match p with + [ <:patt< _ >> -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> + <:str_item< let module $_uid:m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = V mod_ident "list" -> sl + | -> <:vala< [] >> ] ] + ; + mod_binding: + [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] + ; + mod_fun_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; + mt = SELF -> + <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> + <:module_type< $mt$ with $_list:wcl$ >> ] + | [ "sig"; sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]); "end" -> + <:module_type< sig $_list:sg$ end >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = V UIDENT -> <:module_type< $_uid:m$ >> + | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl) = constructor_declaration -> + <:sig_item< exception $_uid:c$ of $_list:tl$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; mt = module_type -> + <:sig_item< include $mt$ >> + | "module"; rf = V (FLAG "rec"); + l = V (LIST1 mod_decl_binding SEP "and") -> + <:sig_item< module $_flag:rf$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:sig_item< module type $_uid:i$ = $mt$ >> + | "module"; "type"; i = V UIDENT "uid" "" -> + <:sig_item< module type $_uid:i$ = 'abstract >> + | "open"; i = V mod_ident "list" "" -> + <:sig_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_declaration SEP "and") -> + <:sig_item< type $_list:tdl$ >> + | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> + <:sig_item< value $_lid:i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $lid:i$ : $t$ >> ] ] + ; + mod_decl_binding: + [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; + pf = V (FLAG "private"); t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> + | "module"; i = V mod_ident ""; "="; me = module_expr -> + <:with_constr< module $_:i$ = $me$ >> ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 + | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] + | "expr1" + [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr LEVEL "top" -> + <:expr< let $_flag:o$ $_list:l$ in $x$ >> + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $_uid:m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< fun [ $_list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; e = fun_def -> + <:expr< fun [$p$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; + l = V (LIST1 match_case SEP "|") -> + <:expr< match $e$ with [ $_list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< try $e$ with [ $_list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; + e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; + e2 = SELF; "do"; e = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e in + <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> + | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e2 in + <:expr< while $e1$ do { $_list:el$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< $mkumin loc "-" e$ >> + | "-."; e = SELF -> <:expr< $mkumin loc "-." e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + let (e1, e2) = + if is_expr_constr_call e1 then + match e1 with + [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) + | _ -> (e1, e2) ] + else (e1, e2) + in + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> <:expr< assert $e$ >> + | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; e2 = SELF; ")" -> <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e = SELF; "."; "{"; el = V (LIST1 expr SEP ","); "}" -> + <:expr< $e$ .{ $_list:el$ } >> + | e1 = SELF; "."; e2 = SELF -> <:expr< $e1$ . $e2$ >> ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val>> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = V INT -> <:expr< $_int:s$ >> + | s = V INT_l -> <:expr< $_int32:s$ >> + | s = V INT_L -> <:expr< $_int64:s$ >> + | s = V INT_n -> <:expr< $_nativeint:s$ >> + | s = V FLOAT -> <:expr< $_flo:s$ >> + | s = V STRING -> <:expr< $_str:s$ >> + | c = V CHAR -> <:expr< $_chr:c$ >> + | UIDENT "True" -> <:expr< $uid:" True"$ >> + | UIDENT "False" -> <:expr< $uid:" False"$ >> + | i = expr_ident -> i + | "false" -> <:expr< False >> + | "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = V expr1_semi_list "list"; "|]" -> + <:expr< [| $_list:el$ |] >> + | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> + <:expr< { $_list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> + <:expr< { ($e$) with $_list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> <:expr< $e$ >> + | "begin"; e = SELF; "end" -> <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_expr_quotation loc x ] ] + ; + e_phony: + [ [ -> raise Stream.Failure ] ] + ; + let_binding: + [ [ p = val_ident; e = fun_binding -> (p, e) + | p = patt; "="; e = expr -> (p, e) ] ] + ; +(*** JRH added the "translate_operator" here ***) + + val_ident: + [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> + | check_not_part_of_patt; "("; s = ANY; ")" -> + let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ e = expr LEVEL "expr1"; ";"; el = SELF -> [e :: el] + | e = expr LEVEL "expr1"; ";" -> [e] + | e = expr LEVEL "expr1" -> [e] ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "->"; e = expr -> <:expr< $e$ >> ] ] + ; + expr_ident: + [ RIGHTA + [ i = V LIDENT -> <:expr< $_lid:i$ >> + | i = V UIDENT -> <:expr< $_uid:i$ >> + | i = V UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $_uid:i$ >> j + | i = V UIDENT; "."; "("; j = operator_rparen -> + <:expr< $_uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + let (p1, p2) = + match p1 with + [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) + | _ -> (p1, p2) ] + in + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = V LIDENT -> <:patt< $_lid:s$ >> + | s = V UIDENT -> <:patt< $_uid:s$ >> + | s = V INT -> <:patt< $_int:s$ >> + | s = V INT_l -> <:patt< $_int32:s$ >> + | s = V INT_L -> <:patt< $_int64:s$ >> + | s = V INT_n -> <:patt< $_nativeint:s$ >> + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = V FLOAT -> <:patt< $_flo:s$ >> + | s = V STRING -> <:patt< $_str:s$ >> + | s = V CHAR -> <:patt< $_chr:s$ >> + | UIDENT "True" -> <:patt< $uid:" True"$ >> + | UIDENT "False" -> <:patt< $uid:" False"$ >> + | "false" -> <:patt< False >> + | "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = V patt_semi_list "list"; "|]" -> + <:patt< [| $_list:pl$ |] >> + | "{"; lpl = V lbl_patt_list "list"; "}" -> + <:patt< { $_list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "_" -> <:patt< _ >> + | x = QUOTATION -> + let x = + try + let i = String.index x ':' in + (String.sub x 0 i, + String.sub x (i + 1) (String.length x - i - 1)) + with + [ Not_found -> ("", x) ] + in + Pcaml.handle_patt_quotation loc x ] ] + ; + p_phony: + [ [ -> raise Stream.Failure ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_declaration: + [ [ tpl = type_parameters; n = type_patt; "="; pf = V (FLAG "private"); + tk = type_kind; cl = V (LIST0 constrain) -> + {MLast.tdNam = n; MLast.tdPrm = <:vala< tpl >>; + MLast.tdPrv = pf; MLast.tdDef = tk; MLast.tdCon = cl} + | tpl = type_parameters; n = type_patt; cl = V (LIST0 constrain) -> + {MLast.tdNam = n; MLast.tdPrm = <:vala< tpl >>; + MLast.tdPrv = <:vala< False >>; + MLast.tdDef = <:ctyp< '$choose_tvar tpl$ >>; MLast.tdCon = cl} ] ] + ; + type_patt: + [ [ n = V LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> + <:ctyp< $t$ >> + | t = ctyp; "="; "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< $t$ == { $_list:ldl$ } >> + | t = ctyp; "="; OPT "|"; cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == [ $list:cdl$ ] >> + | "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< { $_list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "'"; i = V ident "" -> (i, (False, False)) + | "+"; "'"; i = V ident "" -> (i, (True, False)) + | "-"; "'"; i = V ident "" -> (i, (False, True)) ] ] + ; + constructor_declaration: + [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + (loc, ci, cal) + | ci = cons_ident -> (loc, ci, <:vala< [] >>) ] ] + ; + cons_ident: + [ [ i = V UIDENT "uid" "" -> i + | UIDENT "True" -> <:vala< " True" >> + | UIDENT "False" -> <:vala< " False" >> ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "apply" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> + | "_" -> <:ctyp< _ >> + | i = V LIDENT -> <:ctyp< $_lid:i$ >> + | i = V UIDENT -> <:ctyp< $_uid:i$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> + <:str_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:str_item< class type $_list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = V (LIST1 class_description SEP "and") -> + <:sig_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:sig_item< class type $_list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, <:vala< [] >>) + | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); + "in"; ce = SELF -> + <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< $list:ci$ [ $list:[ct :: ctcl]$ ] >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< $list:ci$ [ $ct$ ] >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:class_expr< object $_opt:cspo$ $_list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> + <:class_str_item< inherit $ce$ $_opt:pb$ >> + | "val"; mf = V (FLAG "mutable"); lab = V label "lid" ""; + e = cvalue_binding -> + <:class_str_item< value $_flag:mf$ $_lid:lab$ = $e$ >> + | "method"; "private"; "virtual"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_str_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V label "lid" ""; ":"; t = poly_type; "="; + e = expr -> + <:class_str_item< method private $_lid:l$ : $t$ = $e$ >> + | "method"; "private"; l = V label "lid" ""; sb = fun_binding -> + <:class_str_item< method private $_lid:l$ = $sb$ >> + | "method"; l = V label "lid" ""; ":"; t = poly_type; "="; e = expr -> + <:class_str_item< method $_lid:l$ : $t$ = $e$ >> + | "method"; l = V label "lid" ""; sb = fun_binding -> + <:class_str_item< method $_lid:l$ = $sb$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = clty_longident -> + <:class_type< $list:id$ [ $list:tl$ ] >> + | id = clty_longident -> <:class_type< $list:id$ >> + | "object"; cst = V (OPT class_self_type); + csf = V (LIST0 class_sig_item); "end" -> + <:class_type< object $_opt:cst$ $_list:csf$ end >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> + <:class_sig_item< inherit $cs$ >> + | "val"; mf = V (FLAG "mutable"); l = V label "lid" ""; ":"; t = ctyp -> + <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> + | "method"; "private"; "virtual"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V label "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method private $_lid:l$ : $t$ >> + | "method"; l = V label "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method $_lid:l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + ":"; ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + "="; cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = V label "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = V field_expr_list "list"; ">}" -> + <:expr< {< $_list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = V class_longident "list" -> + <:ctyp< # $_list:id$ >> + | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> + <:ctyp< < $_list:ml$ $_flag:v$ > >> + | "<"; ".."; ">" -> + <:ctyp< < .. > >> + | "<"; ">" -> + <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; ml = SELF -> [f :: ml] + | f = field; ";" -> [f] + | f = field -> [f] ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + clty_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: AFTER "arrow" + [ NONA + [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> + | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> + | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ = $_list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ > $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ < $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; + ntl = V (LIST1 name_tag); "]" -> + <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] + ; + poly_variant: + [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> + | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); + l = V (LIST1 ctyp SEP "&") -> + <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> + | t = ctyp -> MLast.PvInh t ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; e = fun_def -> <:expr< fun $p$ -> $e$ >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~$_:i$: $e$ >> + | i = V TILDEIDENT -> <:expr< ~$_:i$ >> + | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?$_:i$: $e$ >> + | i = V QUESTIONIDENT -> <:expr< ?$_:i$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> + | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> + | p = labeled_patt -> p ] ] + ; + labeled_patt: + [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> + <:patt< ~$_:i$: $p$ >> + | i = V TILDEIDENT -> + <:patt< ~$_:i$ >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~$i$ >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~$i$: ($lid:i$ : $t$) >> + | i = V QUESTIONIDENTCOLON; j = LIDENT -> + <:patt< ?$_:i$: ($lid:j$) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> + <:patt< ?$_:i$: ( $p$ = $e$ ) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ?$_:i$: ( $p$ : $t$ ) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ?$_:i$: ( $p$ : $t$ = $e$ ) >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> + <:patt< ?$_:i$: ( $p$ ) >> + | i = V QUESTIONIDENT -> <:patt< ?$_:i$ >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ = $e$ ) >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ? ( $lid:i$ : $t$ = $e$ ) >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ?$i$ >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ? ( $lid:i$ : $t$ ) >> ] ] + ; + class_type: + [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ~$i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_fun_def: + [ [ p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], True) + | EOI -> ([], False) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $lid:n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> + <:str_item< # $lid:n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH *** *) +(* ------------------------------------------------------------------------- *) + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.1x_6.02.1.ml b/pa_j_3.1x_6.02.1.ml new file mode 100644 index 0000000..4e5a7d9 --- /dev/null +++ b/pa_j_3.1x_6.02.1.ml @@ -0,0 +1,2863 @@ +(* ------------------------------------------------------------------------- *) +(* New version. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: pa_o.ml,v 6.33 2010-11-16 16:48:21 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_extend.cmo"; +#load "q_MLast.cmo"; +#load "pa_reloc.cmo"; + +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* The main/reloc.ml file. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: reloc.ml,v 6.16 2010-11-21 17:17:45 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_macro.cmo"; + +open MLast; + +value option_map f = + fun + [ Some x -> Some (f x) + | None -> None ] +; + +value vala_map f = + IFNDEF STRICT THEN + fun x -> f x + ELSE + fun + [ Ploc.VaAnt s -> Ploc.VaAnt s + | Ploc.VaVal x -> Ploc.VaVal (f x) ] + END +; + +value class_infos_map floc f x = + {ciLoc = floc x.ciLoc; ciVir = x.ciVir; + ciPrm = + let (x1, x2) = x.ciPrm in + (floc x1, x2); + ciNam = x.ciNam; ciExp = f x.ciExp} +; + +value anti_loc qloc sh loc loc1 = + (* + ...<:expr<.....$lid:...xxxxxxxx...$...>>... + |..|-----------------------------------| qloc + <-----> sh + |.........|------------| loc + |..|------| loc1 + *) + let sh1 = Ploc.first_pos qloc + sh in + let sh2 = sh1 + Ploc.first_pos loc in + let line_nb_qloc = Ploc.line_nb qloc in + let line_nb_loc = Ploc.line_nb loc in + let line_nb_loc1 = Ploc.line_nb loc1 in + if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then + Ploc.make_unlined + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) + else + Ploc.make_loc (Ploc.file_name loc) + (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) + (if line_nb_loc1 = 1 then + if line_nb_loc = 1 then Ploc.bol_pos qloc + else sh1 + Ploc.bol_pos loc + else sh2 + Ploc.bol_pos loc1) + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" +; + +value rec reloc_ctyp floc sh = + self where rec self = + fun + [ TyAcc loc x1 x2 -> + let loc = floc loc in + TyAcc loc (self x1) (self x2) + | TyAli loc x1 x2 -> + let loc = floc loc in + TyAli loc (self x1) (self x2) + | TyAny loc -> + let loc = floc loc in + TyAny loc + | TyApp loc x1 x2 -> + let loc = floc loc in + TyApp loc (self x1) (self x2) + | TyArr loc x1 x2 -> + let loc = floc loc in + TyArr loc (self x1) (self x2) + | TyCls loc x1 -> + let loc = floc loc in + TyCls loc x1 + | TyLab loc x1 x2 -> + let loc = floc loc in + TyLab loc x1 (self x2) + | TyLid loc x1 -> + let loc = floc loc in + TyLid loc x1 + | TyMan loc x1 x2 x3 -> + let loc = floc loc in + TyMan loc (self x1) x2 (self x3) + | TyObj loc x1 x2 -> + let loc = floc loc in + TyObj loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) x2 + | TyOlb loc x1 x2 -> + let loc = floc loc in + TyOlb loc x1 (self x2) + | TyPck loc x1 -> + let loc = floc loc in + TyPck loc (reloc_module_type floc sh x1) + | TyPol loc x1 x2 -> + let loc = floc loc in + TyPol loc x1 (self x2) + | TyPot loc x1 x2 -> + let loc = floc loc in + TyPot loc x1 (self x2) + | TyQuo loc x1 -> + let loc = floc loc in + TyQuo loc x1 + | TyRec loc x1 -> + let loc = floc loc in + TyRec loc + (vala_map + (List.map (fun (loc, x1, x2, x3) -> (floc loc, x1, x2, self x3))) + x1) + | TySum loc x1 -> + let loc = floc loc in + TySum loc + (vala_map + (List.map + (fun (loc, x1, x2, x3) -> + (floc loc, x1, vala_map (List.map self) x2, + option_map self x3))) + x1) + | TyTup loc x1 -> + let loc = floc loc in + TyTup loc (vala_map (List.map self) x1) + | TyUid loc x1 -> + let loc = floc loc in + TyUid loc x1 + | TyVrn loc x1 x2 -> + let loc = floc loc in + TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 + | IFDEF STRICT THEN + TyXtr loc x1 x2 -> + let loc = floc loc in + TyXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_poly_variant floc sh = + fun + [ PvTag loc x1 x2 x3 -> + let loc = floc loc in + PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) + | PvInh loc x1 -> + let loc = floc loc in + PvInh loc (reloc_ctyp floc sh x1) ] +and reloc_patt floc sh = + self where rec self = + fun + [ PaAcc loc x1 x2 -> + let loc = floc loc in + PaAcc loc (self x1) (self x2) + | PaAli loc x1 x2 -> + let loc = floc loc in + PaAli loc (self x1) (self x2) + | PaAnt loc x1 -> + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_patt new_floc sh x1 + | PaAny loc -> + let loc = floc loc in + PaAny loc + | PaApp loc x1 x2 -> + let loc = floc loc in + PaApp loc (self x1) (self x2) + | PaArr loc x1 -> + let loc = floc loc in + PaArr loc (vala_map (List.map self) x1) + | PaChr loc x1 -> + let loc = floc loc in + PaChr loc x1 + | PaFlo loc x1 -> + let loc = floc loc in + PaFlo loc x1 + | PaInt loc x1 x2 -> + let loc = floc loc in + PaInt loc x1 x2 + | PaLab loc x1 x2 -> + let loc = floc loc in + PaLab loc (self x1) (vala_map (option_map self) x2) + | PaLaz loc x1 -> + let loc = floc loc in + PaLaz loc (self x1) + | PaLid loc x1 -> + let loc = floc loc in + PaLid loc x1 + | PaNty loc x1 -> + let loc = floc loc in + PaNty loc x1 + | PaOlb loc x1 x2 -> + let loc = floc loc in + PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) + | PaOrp loc x1 x2 -> + let loc = floc loc in + PaOrp loc (self x1) (self x2) + | PaRec loc x1 -> + let loc = floc loc in + PaRec loc + (vala_map (List.map (fun (x1, x2) -> (self x1, self x2))) x1) + | PaRng loc x1 x2 -> + let loc = floc loc in + PaRng loc (self x1) (self x2) + | PaStr loc x1 -> + let loc = floc loc in + PaStr loc x1 + | PaTup loc x1 -> + let loc = floc loc in + PaTup loc (vala_map (List.map self) x1) + | PaTyc loc x1 x2 -> + let loc = floc loc in + PaTyc loc (self x1) (reloc_ctyp floc sh x2) + | PaTyp loc x1 -> + let loc = floc loc in + PaTyp loc x1 + | PaUid loc x1 -> + let loc = floc loc in + PaUid loc x1 + | PaUnp loc x1 x2 -> + let loc = floc loc in + PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) + | PaVrn loc x1 -> + let loc = floc loc in + PaVrn loc x1 + | IFDEF STRICT THEN + PaXtr loc x1 x2 -> + let loc = floc loc in + PaXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_expr floc sh = + self where rec self = + fun + [ ExAcc loc x1 x2 -> + let loc = floc loc in + ExAcc loc (self x1) (self x2) + | ExAnt loc x1 -> + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_expr new_floc sh x1 + | ExApp loc x1 x2 -> + let loc = floc loc in + ExApp loc (self x1) (self x2) + | ExAre loc x1 x2 -> + let loc = floc loc in + ExAre loc (self x1) (self x2) + | ExArr loc x1 -> + let loc = floc loc in + ExArr loc (vala_map (List.map self) x1) + | ExAsr loc x1 -> + let loc = floc loc in + ExAsr loc (self x1) + | ExAss loc x1 x2 -> + let loc = floc loc in + ExAss loc (self x1) (self x2) + | ExBae loc x1 x2 -> + let loc = floc loc in + ExBae loc (self x1) (vala_map (List.map self) x2) + | ExChr loc x1 -> + let loc = floc loc in + ExChr loc x1 + | ExCoe loc x1 x2 x3 -> + let loc = floc loc in + ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) + | ExFlo loc x1 -> + let loc = floc loc in + ExFlo loc x1 + | ExFor loc x1 x2 x3 x4 x5 -> + let loc = floc loc in + ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) + | ExFun loc x1 -> + let loc = floc loc in + ExFun loc + (vala_map + (List.map + (fun (x1, x2, x3) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x1) + | ExIfe loc x1 x2 x3 -> + let loc = floc loc in + ExIfe loc (self x1) (self x2) (self x3) + | ExInt loc x1 x2 -> + let loc = floc loc in + ExInt loc x1 x2 + | ExLab loc x1 -> + let loc = floc loc in + ExLab loc + (vala_map + (List.map + (fun (x1, x2) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2))) + x1) + + | ExLaz loc x1 -> + let loc = floc loc in + ExLaz loc (self x1) + | ExLet loc x1 x2 x3 -> + let loc = floc loc in + ExLet loc x1 + (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) + x2) + (self x3) + | ExLid loc x1 -> + let loc = floc loc in + ExLid loc x1 + | ExLmd loc x1 x2 x3 -> + let loc = floc loc in + ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) + | ExMat loc x1 x2 -> + let loc = floc loc in + ExMat loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExNew loc x1 -> + let loc = floc loc in + ExNew loc x1 + | ExObj loc x1 x2 -> + let loc = floc loc in + ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | ExOlb loc x1 x2 -> + let loc = floc loc in + ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) + | ExOvr loc x1 -> + let loc = floc loc in + ExOvr loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) + | ExPck loc x1 x2 -> + let loc = floc loc in + ExPck loc (reloc_module_expr floc sh x1) + (option_map (reloc_module_type floc sh) x2) + | ExRec loc x1 x2 -> + let loc = floc loc in + ExRec loc + (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) + x1) + (option_map self x2) + | ExSeq loc x1 -> + let loc = floc loc in + ExSeq loc (vala_map (List.map self) x1) + | ExSnd loc x1 x2 -> + let loc = floc loc in + ExSnd loc (self x1) x2 + | ExSte loc x1 x2 -> + let loc = floc loc in + ExSte loc (self x1) (self x2) + | ExStr loc x1 -> + let loc = floc loc in + ExStr loc x1 + | ExTry loc x1 x2 -> + let loc = floc loc in + ExTry loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExTup loc x1 -> + let loc = floc loc in + ExTup loc (vala_map (List.map self) x1) + | ExTyc loc x1 x2 -> + let loc = floc loc in + ExTyc loc (self x1) (reloc_ctyp floc sh x2) + | ExUid loc x1 -> + let loc = floc loc in + ExUid loc x1 + | ExVrn loc x1 -> + let loc = floc loc in + ExVrn loc x1 + | ExWhi loc x1 x2 -> + let loc = floc loc in + ExWhi loc (self x1) (vala_map (List.map self) x2) + | IFDEF STRICT THEN + ExXtr loc x1 x2 -> + let loc = floc loc in + ExXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_module_type floc sh = + self where rec self = + fun + [ MtAcc loc x1 x2 -> + let loc = floc loc in + MtAcc loc (self x1) (self x2) + | MtApp loc x1 x2 -> + let loc = floc loc in + MtApp loc (self x1) (self x2) + | MtFun loc x1 x2 x3 -> + let loc = floc loc in + MtFun loc x1 (self x2) (self x3) + | MtLid loc x1 -> + let loc = floc loc in + MtLid loc x1 + | MtQuo loc x1 -> + let loc = floc loc in + MtQuo loc x1 + | MtSig loc x1 -> + let loc = floc loc in + MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) + | MtTyo loc x1 -> + let loc = floc loc in + MtTyo loc (reloc_module_expr floc sh x1) + | MtUid loc x1 -> + let loc = floc loc in + MtUid loc x1 + | MtWit loc x1 x2 -> + let loc = floc loc in + MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) + | IFDEF STRICT THEN + MtXtr loc x1 x2 -> + let loc = floc loc in + MtXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_sig_item floc sh = + self where rec self = + fun + [ SgCls loc x1 -> + let loc = floc loc in + SgCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgClt loc x1 -> + let loc = floc loc in + SgClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgDcl loc x1 -> + let loc = floc loc in + SgDcl loc (vala_map (List.map self) x1) + | SgDir loc x1 x2 -> + let loc = floc loc in + SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | SgExc loc x1 x2 -> + let loc = floc loc in + SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | SgExt loc x1 x2 x3 -> + let loc = floc loc in + SgExt loc x1 (reloc_ctyp floc sh x2) x3 + | SgInc loc x1 -> + let loc = floc loc in + SgInc loc (reloc_module_type floc sh x1) + | SgMod loc x1 x2 -> + let loc = floc loc in + SgMod loc x1 + (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_type floc sh x2))) + x2) + | SgMty loc x1 x2 -> + let loc = floc loc in + SgMty loc x1 (reloc_module_type floc sh x2) + | SgOpn loc x1 -> + let loc = floc loc in + SgOpn loc x1 + | SgTyp loc x1 -> + let loc = floc loc in + SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | SgUse loc x1 x2 -> + let loc = floc loc in + SgUse loc x1 + (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) + | SgVal loc x1 x2 -> + let loc = floc loc in + SgVal loc x1 (reloc_ctyp floc sh x2) + | IFDEF STRICT THEN + SgXtr loc x1 x2 -> + let loc = floc loc in + SgXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_with_constr floc sh = + fun + [ WcMod loc x1 x2 -> + let loc = floc loc in + WcMod loc x1 (reloc_module_expr floc sh x2) + | WcMos loc x1 x2 -> + let loc = floc loc in + WcMos loc x1 (reloc_module_expr floc sh x2) + | WcTyp loc x1 x2 x3 x4 -> + let loc = floc loc in + WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) + | WcTys loc x1 x2 x3 -> + let loc = floc loc in + WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_module_expr floc sh = + self where rec self = + fun + [ MeAcc loc x1 x2 -> + let loc = floc loc in + MeAcc loc (self x1) (self x2) + | MeApp loc x1 x2 -> + let loc = floc loc in + MeApp loc (self x1) (self x2) + | MeFun loc x1 x2 x3 -> + let loc = floc loc in + MeFun loc x1 (reloc_module_type floc sh x2) (self x3) + | MeStr loc x1 -> + let loc = floc loc in + MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) + | MeTyc loc x1 x2 -> + let loc = floc loc in + MeTyc loc (self x1) (reloc_module_type floc sh x2) + | MeUid loc x1 -> + let loc = floc loc in + MeUid loc x1 + | MeUnp loc x1 x2 -> + let loc = floc loc in + MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) + | IFDEF STRICT THEN + MeXtr loc x1 x2 -> + let loc = floc loc in + MeXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_str_item floc sh = + self where rec self = + fun + [ StCls loc x1 -> + let loc = floc loc in + StCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) + | StClt loc x1 -> + let loc = floc loc in + StClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | StDcl loc x1 -> + let loc = floc loc in + StDcl loc (vala_map (List.map self) x1) + | StDir loc x1 x2 -> + let loc = floc loc in + StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | StExc loc x1 x2 x3 -> + let loc = floc loc in + StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 + | StExp loc x1 -> + let loc = floc loc in + StExp loc (reloc_expr floc sh x1) + | StExt loc x1 x2 x3 -> + let loc = floc loc in + StExt loc x1 (reloc_ctyp floc sh x2) x3 + | StInc loc x1 -> + let loc = floc loc in + StInc loc (reloc_module_expr floc sh x1) + | StMod loc x1 x2 -> + let loc = floc loc in + StMod loc x1 + (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_expr floc sh x2))) + x2) + | StMty loc x1 x2 -> + let loc = floc loc in + StMty loc x1 (reloc_module_type floc sh x2) + | StOpn loc x1 -> + let loc = floc loc in + StOpn loc x1 + | StTyp loc x1 -> + let loc = floc loc in + StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | StUse loc x1 x2 -> + let loc = floc loc in + StUse loc x1 + (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) + | StVal loc x1 x2 -> + let loc = floc loc in + StVal loc x1 + (vala_map + (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + | IFDEF STRICT THEN + StXtr loc x1 x2 -> + let loc = floc loc in + StXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_type_decl floc sh x = + {tdNam = vala_map (fun (loc, x1) -> (floc loc, x1)) x.tdNam; + tdPrm = x.tdPrm; tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; + tdCon = + vala_map (List.map (fun (x1, x2) -> (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) + x.tdCon} +and reloc_class_type floc sh = + self where rec self = + fun + [ CtAcc loc x1 x2 -> + let loc = floc loc in + CtAcc loc (self x1) (self x2) + | CtApp loc x1 x2 -> + let loc = floc loc in + CtApp loc (self x1) (self x2) + | CtCon loc x1 x2 -> + let loc = floc loc in + CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CtFun loc x1 x2 -> + let loc = floc loc in + CtFun loc (reloc_ctyp floc sh x1) (self x2) + | CtIde loc x1 -> + let loc = floc loc in + CtIde loc x1 + | CtSig loc x1 x2 -> + let loc = floc loc in + CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) + (vala_map (List.map (reloc_class_sig_item floc sh)) x2) + | IFDEF STRICT THEN + CtXtr loc x1 x2 -> + let loc = floc loc in + CtXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_class_sig_item floc sh = + self where rec self = + fun + [ CgCtr loc x1 x2 -> + let loc = floc loc in + CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CgDcl loc x1 -> + let loc = floc loc in + CgDcl loc (vala_map (List.map self) x1) + | CgInh loc x1 -> + let loc = floc loc in + CgInh loc (reloc_class_type floc sh x1) + | CgMth loc x1 x2 x3 -> + let loc = floc loc in + CgMth loc x1 x2 (reloc_ctyp floc sh x3) + | CgVal loc x1 x2 x3 -> + let loc = floc loc in + CgVal loc x1 x2 (reloc_ctyp floc sh x3) + | CgVir loc x1 x2 x3 -> + let loc = floc loc in + CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_class_expr floc sh = + self where rec self = + fun + [ CeApp loc x1 x2 -> + let loc = floc loc in + CeApp loc (self x1) (reloc_expr floc sh x2) + | CeCon loc x1 x2 -> + let loc = floc loc in + CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CeFun loc x1 x2 -> + let loc = floc loc in + CeFun loc (reloc_patt floc sh x1) (self x2) + | CeLet loc x1 x2 x3 -> + let loc = floc loc in + CeLet loc x1 + (vala_map + (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + (self x3) + | CeStr loc x1 x2 -> + let loc = floc loc in + CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | CeTyc loc x1 x2 -> + let loc = floc loc in + CeTyc loc (self x1) (reloc_class_type floc sh x2) + | IFDEF STRICT THEN + CeXtr loc x1 x2 -> + let loc = floc loc in + CeXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_class_str_item floc sh = + self where rec self = + fun + [ CrCtr loc x1 x2 -> + let loc = floc loc in + CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CrDcl loc x1 -> + let loc = floc loc in + CrDcl loc (vala_map (List.map self) x1) + | CrInh loc x1 x2 -> + let loc = floc loc in + CrInh loc (reloc_class_expr floc sh x1) x2 + | CrIni loc x1 -> + let loc = floc loc in + CrIni loc (reloc_expr floc sh x1) + | CrMth loc x1 x2 x3 x4 x5 -> + let loc = floc loc in + CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) + (reloc_expr floc sh x5) + | CrVal loc x1 x2 x3 x4 -> + let loc = floc loc in + CrVal loc x1 x2 x3 (reloc_expr floc sh x4) + | CrVav loc x1 x2 x3 -> + let loc = floc loc in + CrVav loc x1 x2 (reloc_ctyp floc sh x3) + | CrVir loc x1 x2 x3 -> + let loc = floc loc in + CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] +; + +(* Equality over syntax trees *) + +value eq_expr x y = + reloc_expr (fun _ -> Ploc.dummy) 0 x = + reloc_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_patt x y = + reloc_patt (fun _ -> Ploc.dummy) 0 x = + reloc_patt (fun _ -> Ploc.dummy) 0 y +; +value eq_ctyp x y = + reloc_ctyp (fun _ -> Ploc.dummy) 0 x = + reloc_ctyp (fun _ -> Ploc.dummy) 0 y +; +value eq_str_item x y = + reloc_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_sig_item x y = + reloc_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_module_expr x y = + reloc_module_expr (fun _ -> Ploc.dummy) 0 x = + reloc_module_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_module_type x y = + reloc_module_type (fun _ -> Ploc.dummy) 0 x = + reloc_module_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_sig_item x y = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_class_str_item x y = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_class_type x y = + reloc_class_type (fun _ -> Ploc.dummy) 0 x = + reloc_class_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_expr x y = + reloc_class_expr (fun _ -> Ploc.dummy) 0 x = + reloc_class_expr (fun _ -> Ploc.dummy) 0 y +; + +(* ------------------------------------------------------------------------- *) +(* Now the lexer. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: plexer.ml,v 6.11 2010-10-04 20:14:58 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_lexer.cmo"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH as a backdoor to change lexical conventions. *) +(* ------------------------------------------------------------------------- *) + +value jrh_lexer = ref False; + +open Versdep; + +value no_quotations = ref False; +value error_on_unknown_keywords = ref False; + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value force_antiquot_loc = ref False; + +type context = + { after_space : mutable bool; + dollar_for_antiquotation : bool; + specific_space_dot : bool; + find_kwd : string -> string; + line_cnt : int -> char -> unit; + set_line_nb : unit -> unit; + make_lined_loc : (int * int) -> string -> Ploc.t } +; + +value err ctx loc msg = + Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) +; + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** JRH: Carl's alternative version + then ("UIDENT", id) + else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) + else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +value keyword_or_error ctx loc s = + try ("", ctx.find_kwd s) with + [ Not_found -> + if error_on_unknown_keywords.val then + err ctx loc ("illegal token: " ^ s) + else ("", s) ] +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value utf8_lexing = ref False; + +value misc_letter buf strm = + if utf8_lexing.val then + match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] + else + match strm with lexer [ '\128'-'\255' ] +; + +value misc_punct buf strm = + if utf8_lexing.val then + match strm with lexer [ '\226' _ _ ] + else + match strm with parser [] +; + +value rec ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] +; + +value rec ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] + ident2! + | ] +; + +value rec ident3 = + lexer + [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | + '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' | '\128'-'\255' ] ident3! + | ] +; + +value binary = lexer [ '0' | '1' ]; +value octal = lexer [ '0'-'7' ]; +value decimal = lexer [ '0'-'9' ]; +value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; + +value end_integer = + lexer + [ "l"/ -> ("INT_l", $buf) + | "L"/ -> ("INT_L", $buf) + | "n"/ -> ("INT_n", $buf) + | -> ("INT", $buf) ] +; + +value rec digits_under kind = + lexer + [ kind (digits_under kind)! + | "_" (digits_under kind)! + | end_integer ] +; + +value digits kind = + lexer + [ kind (digits_under kind)! + | -> raise (Stream.Error "ill-formed integer constant") ] +; + +value rec decimal_digits_under = + lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] +; + +value exponent_part = + lexer + [ [ 'e' | 'E' ] [ '+' | '-' | ] + '0'-'9' ? "ill-formed floating-point constant" + decimal_digits_under! ] +; + +value number = + lexer + [ decimal_digits_under "." decimal_digits_under! exponent_part -> + ("FLOAT", $buf) + | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) + | decimal_digits_under exponent_part -> ("FLOAT", $buf) + | decimal_digits_under end_integer! ] +; + +value char_after_bslash = + lexer + [ "'"/ + | _ [ "'"/ | _ [ "'"/ | ] ] ] +; + +value char ctx bp = + lexer + [ "\\" _ char_after_bslash! + | "\\" -> err ctx (bp, $pos) "char not terminated" + | ?= [ _ '''] _! "'"/ ] +; + +value any ctx buf = + parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } +; + +value rec string ctx bp = + lexer + [ "\""/ + | "\\" (any ctx) (string ctx bp)! + | (any ctx) (string ctx bp)! + | -> err ctx (bp, $pos) "string not terminated" ] +; + +value rec qstring ctx bp = + lexer + [ "`"/ + | (any ctx) (qstring ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value comment ctx bp = + comment where rec comment = + lexer + [ "*)" + | "*" comment! + | "(*" comment! comment! + | "(" comment! + | "\"" (string ctx bp)! [ -> $add "\"" ] comment! + | "'*)" + | "'*" comment! + | "'" (any ctx) comment! + | (any ctx) comment! + | -> err ctx (bp, $pos) "comment not terminated" ] +; + +value rec quotation ctx bp = + lexer + [ ">>"/ + | ">" (quotation ctx bp)! + | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! (quotation ctx bp)! + | "<" (quotation ctx bp)! + | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! + | "\\" (quotation ctx bp)! + | (any ctx) (quotation ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value less_expected = "character '<' expected"; + +value less ctx bp buf strm = + if no_quotations.val then + match strm with lexer + [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] + else + match strm with lexer + [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) + | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec antiquot_rest ctx bp = + lexer + [ "$"/ + | "\\"/ (any ctx) (antiquot_rest ctx bp)! + | (any ctx) (antiquot_rest ctx bp)! + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value rec antiquot ctx bp = + lexer + [ "$"/ -> ":" ^ $buf + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! + | ":" (antiquot_rest ctx bp)! -> $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; + +value rec antiquot_loc ctx bp = + lexer + [ "$"/ -> antiloc bp $pos (":" ^ $buf) + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! + | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value dollar ctx bp buf strm = + if not no_quotations.val && ctx.dollar_for_antiquotation then + ("ANTIQUOT", antiquot ctx bp buf strm) + else if force_antiquot_loc.val then + ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) + else + match strm with lexer + [ [ -> $add "$" ] ident2! -> ("", $buf) ] +; + +(* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?abc:d ?abc + ?$abc:d$: ?abc:d: ?abc: + ?$d$ ?:d ? + ?$d$: ?:d: ?: +*) + +(* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?8,13:abc:d ?abc + ?$abc:d$: ?8,13:abc:d: ?abc: + ?$d$ ?8,9::d ? + ?$d$: ?8,9::d: ?: +*) + +value question ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "?" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "?" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tilde ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "~" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "~" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tildeident = + lexer + [ ":"/ -> ("TILDEIDENTCOLON", $buf) + | -> ("TILDEIDENT", $buf) ] +; + +value questionident = + lexer + [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) + | -> ("QUESTIONIDENT", $buf) ] +; + +value rec linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] +and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] +and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] +; + +value rec any_to_nl = + lexer + [ "\r" | "\n" + | _ any_to_nl! + | ] +; + +value next_token_after_spaces ctx bp = + lexer + [ 'A'-'Z' ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] + *********) + | [ 'a'-'z' | '_' | misc_letter ] ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] + *********) + | '1'-'9' number! + | "0" [ 'o' | 'O' ] (digits octal)! + | "0" [ 'x' | 'X' ] (digits hexa)! + | "0" [ 'b' | 'B' ] (digits binary)! + | "0" number! + | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" + | "'"/ (char ctx bp) -> ("CHAR", $buf) + | "'" -> keyword_or_error ctx (bp, $pos) "'" + | "\""/ (string ctx bp)! -> ("STRING", $buf) +(*** Line added by JRH ***) + | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) + | "$"/ (dollar ctx bp)! + | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> + keyword_or_error ctx (bp, $pos) $buf + | "~"/ 'a'-'z' ident! tildeident! + | "~"/ '_' ident! tildeident! + | "~" (tilde ctx bp) + | "?"/ 'a'-'z' ident! questionident! + | "?" (question ctx bp)! + | "<"/ (less ctx bp)! + | ":]" -> keyword_or_error ctx (bp, $pos) $buf + | "::" -> keyword_or_error ctx (bp, $pos) $buf + | ":=" -> keyword_or_error ctx (bp, $pos) $buf + | ":>" -> keyword_or_error ctx (bp, $pos) $buf + | ":" -> keyword_or_error ctx (bp, $pos) $buf + | ">]" -> keyword_or_error ctx (bp, $pos) $buf + | ">}" -> keyword_or_error ctx (bp, $pos) $buf + | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "|]" -> keyword_or_error ctx (bp, $pos) $buf + | "|}" -> keyword_or_error ctx (bp, $pos) $buf + | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "[|" -> keyword_or_error ctx (bp, $pos) $buf + | "[<" -> keyword_or_error ctx (bp, $pos) $buf + | "[:" -> keyword_or_error ctx (bp, $pos) $buf + | "[" -> keyword_or_error ctx (bp, $pos) $buf + | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "{|" -> keyword_or_error ctx (bp, $pos) $buf + | "{<" -> keyword_or_error ctx (bp, $pos) $buf + | "{:" -> keyword_or_error ctx (bp, $pos) $buf + | "{" -> keyword_or_error ctx (bp, $pos) $buf + | ".." -> keyword_or_error ctx (bp, $pos) ".." + | "." -> + let id = + if ctx.specific_space_dot && ctx.after_space then " ." else "." + in + keyword_or_error ctx (bp, $pos) id + | ";;" -> keyword_or_error ctx (bp, $pos) ";;" + | ";" -> keyword_or_error ctx (bp, $pos) ";" + | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "\\"/ ident3! -> ("LIDENT", $buf) + | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value get_comment buf strm = $buf; + +value rec next_token ctx buf = + parser bp + [ [: `('\n' | '\r' as c); s :] ep -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := ep; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> + let comm = get_comment buf () in + if linedir 1 s then do { + let buf = any_to_nl ($add '#') s in + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := Stream.count s; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + else + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (keyword_or_error ctx (bp, bp + 1) "#", loc) + | [: `'('; + a = + parser + [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + | [: :] ep -> + let loc = ctx.make_lined_loc (bp, ep) $buf in + (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a + | [: comm = get_comment buf; + tok = next_token_after_spaces ctx bp $empty :] ep -> + let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in + (tok, loc) + | [: comm = get_comment buf; _ = Stream.empty :] -> + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (("EOI", ""), loc) ] +; + +value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = + try do { + match Plexing.restore_lexing_info.val with + [ Some (line_nb, bol_pos) -> do { + s_line_nb.val := line_nb; + s_bol_pos.val := bol_pos; + Plexing.restore_lexing_info.val := None; + } + | None -> () ]; + Plexing.line_nb.val := s_line_nb; + Plexing.bol_pos.val := s_bol_pos; + let comm_bp = Stream.count cstrm in + ctx.set_line_nb (); + ctx.after_space := False; + let (r, loc) = next_token ctx $empty cstrm in + match glexr.val.Plexing.tok_comm with + [ Some list -> + if Ploc.first_pos loc > comm_bp then + let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in + glexr.val.Plexing.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (r, loc) + } + with + [ Stream.Error str -> + err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + +value func kwd_table glexr = + let ctx = + let line_nb = ref 0 in + let bol_pos = ref 0 in + {after_space = False; + dollar_for_antiquotation = dollar_for_antiquotation.val; + specific_space_dot = specific_space_dot.val; + find_kwd = Hashtbl.find kwd_table; + line_cnt bp1 c = + match c with + [ '\n' | '\r' -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := bp1 + 1; + } + | c -> () ]; + set_line_nb () = do { + line_nb.val := Plexing.line_nb.val.val; + bol_pos.val := Plexing.bol_pos.val.val; + }; + make_lined_loc loc comm = + Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} + in + Plexing.lexer_func_of_parser (next_token_fun ctx glexr) +; + +value rec check_keyword_stream = + parser [: _ = check $empty; _ = Stream.empty :] -> True +and check = + lexer + [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! + | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' ] + check_ident2! + | "$" check_ident2! + | "<" ?= [ ":" | "<" ] + | "<" check_ident2! + | ":]" + | "::" + | ":=" + | ":>" + | ":" + | ">]" + | ">}" + | ">" check_ident2! + | "|]" + | "|}" + | "|" check_ident2! + | "[" ?= [ "<<" | "<:" ] + | "[|" + | "[<" + | "[:" + | "[" + | "{" ?= [ "<<" | "<:" ] + | "{|" + | "{<" + | "{:" + | "{" + | ";;" + | ";" + | misc_punct check_ident2! + | _ ] +and check_ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] + check_ident! | ] +and check_ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' | ':' | '<' | '>' | '|' | misc_punct ] + check_ident2! | ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Plexing.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Plexing.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (hashtbl_mem kwd_table p_prm) then + if check_keyword p_prm then + if hashtbl_mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | + "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | + "CHAR" | "STRING" | "QUOTATION" | + "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> + () + | _ -> + raise + (Plexing.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT", s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value after_colon_except_last e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 2) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then + if p_prm.[String.length p_prm - 1] = ':' then + let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + if eq_before_colon p_prm prm then after_colon_except_last prm + else raise Stream.Failure + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + raise Stream.Failure + else if eq_before_colon p_prm prm then after_colon prm + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Plexing.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {Plexing.tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +(* ------------------------------------------------------------------------- *) +(* Back to etc/pa_o.ml *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry signature; + Grammar.Unsafe.clear_entry structure; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_decl; + Grammar.Unsafe.clear_entry constructor_declaration; + Grammar.Unsafe.clear_entry label_declaration; + Grammar.Unsafe.clear_entry match_case; + Grammar.Unsafe.clear_entry with_constr; + Grammar.Unsafe.clear_entry poly_variant; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc + in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc + in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = do { + let ct = Hashtbl.create 73 in + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] +}; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> do { + Stream.junk strm; + Stream.junk strm; + translate_operator s + } + | _ -> raise Stream.Failure ]) +; + +value check_not_part_of_patt = + Grammar.Entry.of_parser gram "check_not_part_of_patt" + (fun strm -> + let tok = + match Stream.npeek 4 strm with + [ [("LIDENT", _); tok :: _] -> tok + | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok + | _ -> raise Stream.Failure ] + in + match tok with + [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure + | _ -> () ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + loop where rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"; "?!"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && (x = "$" || String.length x >= 2) && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("ANTIQUOT_LOC", _) -> () + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value e_phony = + Grammar.Entry.of_parser gram "e_phony" + (parser []) +; +value p_phony = + Grammar.Entry.of_parser gram "p_phony" + (parser []) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | _ -> 1 ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value mem_tvar s tpl = + List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if mem_tvar s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if mem_tvar v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value quotation_content s = do { + loop 0 where rec loop i = + if i = String.length s then ("", s) + else if s.[i] = ':' || s.[i] = '@' then + let i = i + 1 in + (String.sub s 0 i, String.sub s i (String.length s - i)) + else loop (i + 1) +}; + +value concat_comm loc e = + let loc = + Ploc.with_comment loc + (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) + in + let floc = + let first = ref True in + fun loc1 -> + if first.val then do {first.val := False; loc} + else loc1 + in + reloc_expr floc 0 e +; + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr + signature structure class_type class_expr class_sig_item class_str_item + let_binding type_decl constructor_declaration label_declaration + match_case with_constr poly_variant; + module_expr: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; + "->"; me = SELF -> + <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> + | "struct"; st = structure; "end" -> + <:module_expr< struct $_list:st$ end >> ] + | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] + | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; "val"; e = expr; ":"; mt = module_type; ")" -> + <:module_expr< (value $e$ : $mt$) >> + | "("; "val"; e = expr; ")" -> + <:module_expr< (value $e$) >> + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + structure: + [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration; + b = rebind_exn -> + <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> + <:str_item< module $_flag:r$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:str_item< module type $_uid:i$ = $mt$ >> + | "open"; i = V mod_ident "list" "" -> + <:str_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:str_item< type $_list:tdl$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr -> + let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> + match l with + [ <:vala< [(p, e)] >> -> + match p with + [ <:patt< _ >> -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> + <:str_item< let module $_uid:m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = V mod_ident "list" -> sl + | -> <:vala< [] >> ] ] + ; + mod_binding: + [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] + ; + mod_fun_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; + mt = SELF -> + <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> + <:module_type< $mt$ with $_list:wcl$ >> ] + | [ "sig"; sg = signature; "end" -> + <:module_type< sig $_list:sg$ end >> + | "module"; "type"; "of"; me = module_expr -> + <:module_type< module type of $me$ >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + signature: + [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = V UIDENT -> <:module_type< $_uid:m$ >> + | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration -> + <:sig_item< exception $_uid:c$ of $_list:tl$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; mt = module_type -> + <:sig_item< include $mt$ >> + | "module"; rf = V (FLAG "rec"); + l = V (LIST1 mod_decl_binding SEP "and") -> + <:sig_item< module $_flag:rf$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:sig_item< module type $_uid:i$ = $mt$ >> + | "module"; "type"; i = V UIDENT "uid" "" -> + <:sig_item< module type $_uid:i$ = 'abstract >> + | "open"; i = V mod_ident "list" "" -> + <:sig_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:sig_item< type $_list:tdl$ >> + | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> + <:sig_item< value $_lid:i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $lid:i$ : $t$ >> ] ] + ; + mod_decl_binding: + [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; + pf = V (FLAG "private"); t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> + | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; + t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> + | "module"; i = V mod_ident ""; "="; me = module_expr -> + <:with_constr< module $_:i$ = $me$ >> + | "module"; i = V mod_ident ""; ":="; me = module_expr -> + <:with_constr< module $_:i$ := $me$ >> ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 + | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] + | "expr1" + [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr LEVEL "top" -> + <:expr< let $_flag:o$ $_list:l$ in $x$ >> + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $_uid:m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< fun [ $_list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> + <:expr< fun [$p$ $opt:eo$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; + l = V (LIST1 match_case SEP "|") -> + <:expr< match $e$ with [ $_list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< try $e$ with [ $_list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; + e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; + e2 = SELF; "do"; e = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e in + <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> + | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e2 in + <:expr< while $e1$ do { $_list:el$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< - $e$ >> + | "-."; e = SELF -> <:expr< -. $e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + let (e1, e2) = + if is_expr_constr_call e1 then + match e1 with + [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) + | _ -> (e1, e2) ] + else (e1, e2) + in + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> <:expr< assert $e$ >> + | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; op = operator_rparen -> + <:expr< $e1$ .( $lid:op$ ) >> + | e1 = SELF; "."; "("; e2 = SELF; ")" -> + <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> + <:expr< $e$ .{ $_list:el$ } >> + | e1 = SELF; "."; e2 = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop e1 e2 ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val >> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = V INT -> <:expr< $_int:s$ >> + | s = V INT_l -> <:expr< $_int32:s$ >> + | s = V INT_L -> <:expr< $_int64:s$ >> + | s = V INT_n -> <:expr< $_nativeint:s$ >> + | s = V FLOAT -> <:expr< $_flo:s$ >> + | s = V STRING -> <:expr< $_str:s$ >> + | c = V CHAR -> <:expr< $_chr:c$ >> + | UIDENT "True" -> <:expr< True_ >> + | UIDENT "False" -> <:expr< False_ >> + | i = expr_ident -> i + | "false" -> <:expr< False >> + | "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = V expr1_semi_list "list"; "|]" -> + <:expr< [| $_list:el$ |] >> + | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> + <:expr< { $_list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> + <:expr< { ($e$) with $_list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> + <:expr< (module $me$ : $mt$) >> + | "("; "module"; me = module_expr; ")" -> + <:expr< (module $me$) >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> + | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_expr_quotation loc con ] ] + ; + let_binding: + [ [ p = val_ident; e = fun_binding -> (p, e) + | p = patt; "="; e = expr -> (p, e) + | p = patt; ":"; t = poly_type; "="; e = expr -> + (<:patt< ($p$ : $t$) >>, e) ] ] + ; +(*** JRH added the "translate_operator" here ***) + val_ident: + [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> + | check_not_part_of_patt; "("; s = ANY; ")" -> + let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) + | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> + (eo, <:expr< $e$ >>) ] ] + ; + expr_ident: + [ RIGHTA + [ i = V LIDENT -> <:expr< $_lid:i$ >> + | i = V UIDENT -> <:expr< $_uid:i$ >> + | i = V UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $_uid:i$ >> j + | i = V UIDENT; "."; "("; j = operator_rparen -> + <:expr< $_uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + let (p1, p2) = + match p1 with + [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) + | _ -> (p1, p2) ] + in + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] + | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = V LIDENT -> <:patt< $_lid:s$ >> + | s = V UIDENT -> <:patt< $_uid:s$ >> + | s = V INT -> <:patt< $_int:s$ >> + | s = V INT_l -> <:patt< $_int32:s$ >> + | s = V INT_L -> <:patt< $_int64:s$ >> + | s = V INT_n -> <:patt< $_nativeint:s$ >> + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = V FLOAT -> <:patt< $_flo:s$ >> + | s = V STRING -> <:patt< $_str:s$ >> + | s = V CHAR -> <:patt< $_chr:s$ >> + | UIDENT "True" -> <:patt< True_ >> + | UIDENT "False" -> <:patt< False_ >> + | "false" -> <:patt< False >> + | "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = V patt_semi_list "list"; "|]" -> + <:patt< [| $_list:pl$ |] >> + | "{"; lpl = V lbl_patt_list "list"; "}" -> + <:patt< { $_list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> + | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> + <:patt< (module $_uid:s$ : $mt$) >> + | "("; "module"; s = V UIDENT; ")" -> + <:patt< (module $_uid:s$) >> + | "_" -> <:patt< _ >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_patt_quotation loc con ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_decl: + [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); + tk = type_kind; cl = V (LIST0 constrain) -> + <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> + | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> + let tk = <:ctyp< '$choose_tvar tpl$ >> in + <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] + ; + type_patt: + [ [ n = V LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> + <:ctyp< $t$ >> + | t = ctyp; "="; pf = FLAG "private"; "{"; + ldl = V label_declarations "list"; "}" -> + <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> + | t = ctyp; "="; pf = FLAG "private"; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> + | "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< { $_list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "+"; p = V simple_type_parameter -> (p, Some True) + | "-"; p = V simple_type_parameter -> (p, Some False) + | p = V simple_type_parameter -> (p, None) ] ] + ; + simple_type_parameter: + [ [ "'"; i = ident -> Some i + | "_" -> None ] ] + ; + constructor_declaration: + [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + (loc, ci, cal, None) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); + "->"; t = ctyp -> + (loc, ci, cal, Some t) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + let t = + match cal with + [ <:vala< [t] >> -> t + | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> + | _ -> assert False ] + in + (loc, ci, <:vala< [] >>, Some t) + | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] + ; + cons_ident: + [ [ i = V UIDENT "uid" "" -> i + | UIDENT "True" -> <:vala< "True_" >> + | UIDENT "False" -> <:vala< "False_" >> ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "apply" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> + | "_" -> <:ctyp< _ >> + | i = V LIDENT -> <:ctyp< $_lid:i$ >> + | i = V UIDENT -> <:ctyp< $_uid:i$ >> + | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> + <:str_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:str_item< class type $_list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = V (LIST1 class_description SEP "and") -> + <:sig_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:sig_item< class type $_list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, <:vala< [] >>) + | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); + "in"; ce = SELF -> + <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< [ $ct$ ] $list:ci$ >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:class_expr< object $_opt:cspo$ $_list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> + <:class_str_item< inherit $ce$ $_opt:pb$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + lab = V LIDENT "lid" ""; e = cvalue_binding -> + <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> + if Pcaml.unvala ov then + Ploc.raise loc (Stream.Error "virtual value cannot override") + else + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; + ":"; t = ctyp -> + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_str_item< method virtual $_lid:l$ : $t$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + ":"; t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; + t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> + <:class_type< $id$ [ $list:tl$ ] >> + | "object"; cst = V (OPT class_self_type); + csf = V (LIST0 class_sig_item); "end" -> + <:class_type< object $_opt:cst$ $_list:csf$ end >> ] + | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> + | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] + | [ i = V LIDENT -> <:class_type< $_id: i$ >> + | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> + <:class_sig_item< inherit $cs$ >> + | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> + <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method private $_lid:l$ : $t$ >> + | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method $_lid:l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + ":"; ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + "="; cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = V field_expr_list "list"; ">}" -> + <:expr< {< $_list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = V class_longident "list" -> + <:ctyp< # $_list:id$ >> + | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> + <:ctyp< < $_list:ml$ $_flag:v$ > >> + | "<"; ".."; ">" -> + <:ctyp< < .. > >> + | "<"; ">" -> + <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; ml = SELF -> [f :: ml] + | f = field; ";" -> [f] + | f = field -> [f] ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> + <:ctyp< type $list:nt$ . $ct$ >> + | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: AFTER "arrow" + [ NONA + [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> + | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> + | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ = $_list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ > $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ < $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; + ntl = V (LIST1 name_tag); "]" -> + <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] + ; + poly_variant: + [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> + | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); + l = V (LIST1 ctyp SEP "&") -> + <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> + | t = ctyp -> <:poly_variant< $t$ >> ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> + <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> + | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> + | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> + | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> + | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> + | p = labeled_patt -> p ] ] + ; + labeled_patt: + [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> + <:patt< ~{$_:i$ = $p$} >> + | i = V TILDEIDENT -> + <:patt< ~{$_:i$} >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~{$lid:i$} >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~{$lid:i$ : $t$} >> + | i = V QUESTIONIDENTCOLON; j = LIDENT -> + <:patt< ?{$_:i$ = ?{$lid:j$}} >> + | i = V QUESTIONIDENTCOLON; "_" -> + <:patt< ?{$_:i$} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> + <:patt< ?{$_:i$ = ?{$p$}} >> + | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ = $e$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ : $t$ = $e$} >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ?{$lid:i$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ?{$lid:i$ : $t$} >> ] ] + ; + class_type: + [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ~$i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_fun_def: + [ [ p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $lid:n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> + <:str_item< # $lid:n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH *** *) +(* ------------------------------------------------------------------------- *) + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.1x_6.02.2.ml b/pa_j_3.1x_6.02.2.ml new file mode 100644 index 0000000..f75beaa --- /dev/null +++ b/pa_j_3.1x_6.02.2.ml @@ -0,0 +1,2845 @@ +(* ------------------------------------------------------------------------- *) +(* New version. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: pa_o.ml,v 6.33 2010-11-16 16:48:21 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_extend.cmo"; +#load "q_MLast.cmo"; +#load "pa_reloc.cmo"; + +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* The main/reloc.ml file. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: reloc.ml,v 6.19 2011-02-17 10:20:50 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_macro.cmo"; + +open MLast; + +value option_map f = + fun + [ Some x -> Some (f x) + | None -> None ] +; + +value vala_map f = + IFNDEF STRICT THEN + fun x -> f x + ELSE + fun + [ Ploc.VaAnt s -> Ploc.VaAnt s + | Ploc.VaVal x -> Ploc.VaVal (f x) ] + END +; + +value class_infos_map floc f x = + {ciLoc = floc x.ciLoc; ciVir = x.ciVir; + ciPrm = + let (x1, x2) = x.ciPrm in + (floc x1, x2); + ciNam = x.ciNam; ciExp = f x.ciExp} +; + +value anti_loc qloc sh loc loc1 = + (* + ...<:reloc_expr<.....$lid:...xxxxxxxx...$...>>... + |..|-----------------------------------| qloc + <-----> sh + |.........|------------| loc + |..|------| loc1 + *) + let sh1 = Ploc.first_pos qloc + sh in + let sh2 = sh1 + Ploc.first_pos loc in + let line_nb_qloc = Ploc.line_nb qloc in + let line_nb_loc = Ploc.line_nb loc in + let line_nb_loc1 = Ploc.line_nb loc1 in + if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then + Ploc.make_unlined + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) + else + Ploc.make_loc (Ploc.file_name loc) + (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) + (if line_nb_loc1 = 1 then + if line_nb_loc = 1 then Ploc.bol_pos qloc + else sh1 + Ploc.bol_pos loc + else sh2 + Ploc.bol_pos loc1) + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" +; + +value rec reloc_ctyp floc sh = + self where rec self = + fun + [ TyAcc loc x1 x2 → + let loc = floc loc in + TyAcc loc (self x1) (self x2) + | TyAli loc x1 x2 → + let loc = floc loc in + TyAli loc (self x1) (self x2) + | TyAny loc → + let loc = floc loc in + TyAny loc + | TyApp loc x1 x2 → + let loc = floc loc in + TyApp loc (self x1) (self x2) + | TyArr loc x1 x2 → + let loc = floc loc in + TyArr loc (self x1) (self x2) + | TyCls loc x1 → + let loc = floc loc in + TyCls loc x1 + | TyLab loc x1 x2 → + let loc = floc loc in + TyLab loc x1 (self x2) + | TyLid loc x1 → + let loc = floc loc in + TyLid loc x1 + | TyMan loc x1 x2 x3 → + let loc = floc loc in + TyMan loc (self x1) x2 (self x3) + | TyObj loc x1 x2 → + let loc = floc loc in + TyObj loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) x2 + | TyOlb loc x1 x2 → + let loc = floc loc in + TyOlb loc x1 (self x2) + | TyPck loc x1 → + let loc = floc loc in + TyPck loc (reloc_module_type floc sh x1) + | TyPol loc x1 x2 → + let loc = floc loc in + TyPol loc x1 (self x2) + | TyPot loc x1 x2 → + let loc = floc loc in + TyPot loc x1 (self x2) + | TyQuo loc x1 → + let loc = floc loc in + TyQuo loc x1 + | TyRec loc x1 → + let loc = floc loc in + TyRec loc + (vala_map + (List.map (fun (loc, x1, x2, x3) → (floc loc, x1, x2, self x3))) + x1) + | TySum loc x1 → + let loc = floc loc in + TySum loc + (vala_map + (List.map + (fun (loc, x1, x2, x3) → + (floc loc, x1, vala_map (List.map self) x2, + option_map self x3))) + x1) + | TyTup loc x1 → + let loc = floc loc in + TyTup loc (vala_map (List.map self) x1) + | TyUid loc x1 → + let loc = floc loc in + TyUid loc x1 + | TyVrn loc x1 x2 → + let loc = floc loc in + TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 + | TyXtr loc x1 x2 → + let loc = floc loc in + TyXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_poly_variant floc sh = + fun + [ PvTag loc x1 x2 x3 → + let loc = floc loc in + PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) + | PvInh loc x1 → + let loc = floc loc in + PvInh loc (reloc_ctyp floc sh x1) ] +and reloc_patt floc sh = + self where rec self = + fun + [ PaAcc loc x1 x2 → + let loc = floc loc in + PaAcc loc (self x1) (self x2) + | PaAli loc x1 x2 → + let loc = floc loc in + PaAli loc (self x1) (self x2) + | PaAnt loc x1 → + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_patt new_floc sh x1 + | PaAny loc → + let loc = floc loc in + PaAny loc + | PaApp loc x1 x2 → + let loc = floc loc in + PaApp loc (self x1) (self x2) + | PaArr loc x1 → + let loc = floc loc in + PaArr loc (vala_map (List.map self) x1) + | PaChr loc x1 → + let loc = floc loc in + PaChr loc x1 + | PaFlo loc x1 → + let loc = floc loc in + PaFlo loc x1 + | PaInt loc x1 x2 → + let loc = floc loc in + PaInt loc x1 x2 + | PaLab loc x1 → + let loc = floc loc in + PaLab loc + (vala_map + (List.map + (fun (x1, x2) → (self x1, vala_map (option_map self) x2))) + x1) + | PaLaz loc x1 → + let loc = floc loc in + PaLaz loc (self x1) + | PaLid loc x1 → + let loc = floc loc in + PaLid loc x1 + | PaNty loc x1 → + let loc = floc loc in + PaNty loc x1 + | PaOlb loc x1 x2 → + let loc = floc loc in + PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) + | PaOrp loc x1 x2 → + let loc = floc loc in + PaOrp loc (self x1) (self x2) + | PaRec loc x1 → + let loc = floc loc in + PaRec loc (vala_map (List.map (fun (x1, x2) → (self x1, self x2))) x1) + | PaRng loc x1 x2 → + let loc = floc loc in + PaRng loc (self x1) (self x2) + | PaStr loc x1 → + let loc = floc loc in + PaStr loc x1 + | PaTup loc x1 → + let loc = floc loc in + PaTup loc (vala_map (List.map self) x1) + | PaTyc loc x1 x2 → + let loc = floc loc in + PaTyc loc (self x1) (reloc_ctyp floc sh x2) + | PaTyp loc x1 → + let loc = floc loc in + PaTyp loc x1 + | PaUid loc x1 → + let loc = floc loc in + PaUid loc x1 + | PaUnp loc x1 x2 → + let loc = floc loc in + PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) + | PaVrn loc x1 → + let loc = floc loc in + PaVrn loc x1 + | PaXtr loc x1 x2 → + let loc = floc loc in + PaXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_expr floc sh = + self where rec self = + fun + [ ExAcc loc x1 x2 → + let loc = floc loc in + ExAcc loc (self x1) (self x2) + | ExAnt loc x1 → + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_expr new_floc sh x1 + | ExApp loc x1 x2 → + let loc = floc loc in + ExApp loc (self x1) (self x2) + | ExAre loc x1 x2 → + let loc = floc loc in + ExAre loc (self x1) (self x2) + | ExArr loc x1 → + let loc = floc loc in + ExArr loc (vala_map (List.map self) x1) + | ExAsr loc x1 → + let loc = floc loc in + ExAsr loc (self x1) + | ExAss loc x1 x2 → + let loc = floc loc in + ExAss loc (self x1) (self x2) + | ExBae loc x1 x2 → + let loc = floc loc in + ExBae loc (self x1) (vala_map (List.map self) x2) + | ExChr loc x1 → + let loc = floc loc in + ExChr loc x1 + | ExCoe loc x1 x2 x3 → + let loc = floc loc in + ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) + | ExFlo loc x1 → + let loc = floc loc in + ExFlo loc x1 + | ExFor loc x1 x2 x3 x4 x5 → + let loc = floc loc in + ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) + | ExFun loc x1 → + let loc = floc loc in + ExFun loc + (vala_map + (List.map + (fun (x1, x2, x3) → + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x1) + | ExIfe loc x1 x2 x3 → + let loc = floc loc in + ExIfe loc (self x1) (self x2) (self x3) + | ExInt loc x1 x2 → + let loc = floc loc in + ExInt loc x1 x2 + | ExLab loc x1 → + let loc = floc loc in + ExLab loc + (vala_map + (List.map + (fun (x1, x2) → + (reloc_patt floc sh x1, vala_map (option_map self) x2))) + x1) + | ExLaz loc x1 → + let loc = floc loc in + ExLaz loc (self x1) + | ExLet loc x1 x2 x3 → + let loc = floc loc in + ExLet loc x1 + (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x2) + (self x3) + | ExLid loc x1 → + let loc = floc loc in + ExLid loc x1 + | ExLmd loc x1 x2 x3 → + let loc = floc loc in + ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) + | ExMat loc x1 x2 → + let loc = floc loc in + ExMat loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) → + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExNew loc x1 → + let loc = floc loc in + ExNew loc x1 + | ExObj loc x1 x2 → + let loc = floc loc in + ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | ExOlb loc x1 x2 → + let loc = floc loc in + ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) + | ExOvr loc x1 → + let loc = floc loc in + ExOvr loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) + | ExPck loc x1 x2 → + let loc = floc loc in + ExPck loc (reloc_module_expr floc sh x1) + (option_map (reloc_module_type floc sh) x2) + | ExRec loc x1 x2 → + let loc = floc loc in + ExRec loc + (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x1) + (option_map self x2) + | ExSeq loc x1 → + let loc = floc loc in + ExSeq loc (vala_map (List.map self) x1) + | ExSnd loc x1 x2 → + let loc = floc loc in + ExSnd loc (self x1) x2 + | ExSte loc x1 x2 → + let loc = floc loc in + ExSte loc (self x1) (self x2) + | ExStr loc x1 → + let loc = floc loc in + ExStr loc x1 + | ExTry loc x1 x2 → + let loc = floc loc in + ExTry loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) → + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExTup loc x1 → + let loc = floc loc in + ExTup loc (vala_map (List.map self) x1) + | ExTyc loc x1 x2 → + let loc = floc loc in + ExTyc loc (self x1) (reloc_ctyp floc sh x2) + | ExUid loc x1 → + let loc = floc loc in + ExUid loc x1 + | ExVrn loc x1 → + let loc = floc loc in + ExVrn loc x1 + | ExWhi loc x1 x2 → + let loc = floc loc in + ExWhi loc (self x1) (vala_map (List.map self) x2) + | ExXtr loc x1 x2 → + let loc = floc loc in + ExXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_module_type floc sh = + self where rec self = + fun + [ MtAcc loc x1 x2 → + let loc = floc loc in + MtAcc loc (self x1) (self x2) + | MtApp loc x1 x2 → + let loc = floc loc in + MtApp loc (self x1) (self x2) + | MtFun loc x1 x2 x3 → + let loc = floc loc in + MtFun loc x1 (self x2) (self x3) + | MtLid loc x1 → + let loc = floc loc in + MtLid loc x1 + | MtQuo loc x1 → + let loc = floc loc in + MtQuo loc x1 + | MtSig loc x1 → + let loc = floc loc in + MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) + | MtTyo loc x1 → + let loc = floc loc in + MtTyo loc (reloc_module_expr floc sh x1) + | MtUid loc x1 → + let loc = floc loc in + MtUid loc x1 + | MtWit loc x1 x2 → + let loc = floc loc in + MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) + | MtXtr loc x1 x2 → + let loc = floc loc in + MtXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_sig_item floc sh = + self where rec self = + fun + [ SgCls loc x1 → + let loc = floc loc in + SgCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgClt loc x1 → + let loc = floc loc in + SgClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgDcl loc x1 → + let loc = floc loc in + SgDcl loc (vala_map (List.map self) x1) + | SgDir loc x1 x2 → + let loc = floc loc in + SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | SgExc loc x1 x2 → + let loc = floc loc in + SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | SgExt loc x1 x2 x3 → + let loc = floc loc in + SgExt loc x1 (reloc_ctyp floc sh x2) x3 + | SgInc loc x1 → + let loc = floc loc in + SgInc loc (reloc_module_type floc sh x1) + | SgMod loc x1 x2 → + let loc = floc loc in + SgMod loc x1 + (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_type floc sh x2))) + x2) + | SgMty loc x1 x2 → + let loc = floc loc in + SgMty loc x1 (reloc_module_type floc sh x2) + | SgOpn loc x1 → + let loc = floc loc in + SgOpn loc x1 + | SgTyp loc x1 → + let loc = floc loc in + SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | SgUse loc x1 x2 → + let loc = floc loc in + SgUse loc x1 + (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) + | SgVal loc x1 x2 → + let loc = floc loc in + SgVal loc x1 (reloc_ctyp floc sh x2) + | SgXtr loc x1 x2 → + let loc = floc loc in + SgXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_with_constr floc sh = + fun + [ WcMod loc x1 x2 → + let loc = floc loc in + WcMod loc x1 (reloc_module_expr floc sh x2) + | WcMos loc x1 x2 → + let loc = floc loc in + WcMos loc x1 (reloc_module_expr floc sh x2) + | WcTyp loc x1 x2 x3 x4 → + let loc = floc loc in + WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) + | WcTys loc x1 x2 x3 → + let loc = floc loc in + WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_module_expr floc sh = + self where rec self = + fun + [ MeAcc loc x1 x2 → + let loc = floc loc in + MeAcc loc (self x1) (self x2) + | MeApp loc x1 x2 → + let loc = floc loc in + MeApp loc (self x1) (self x2) + | MeFun loc x1 x2 x3 → + let loc = floc loc in + MeFun loc x1 (reloc_module_type floc sh x2) (self x3) + | MeStr loc x1 → + let loc = floc loc in + MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) + | MeTyc loc x1 x2 → + let loc = floc loc in + MeTyc loc (self x1) (reloc_module_type floc sh x2) + | MeUid loc x1 → + let loc = floc loc in + MeUid loc x1 + | MeUnp loc x1 x2 → + let loc = floc loc in + MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) + | MeXtr loc x1 x2 → + let loc = floc loc in + MeXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_str_item floc sh = + self where rec self = + fun + [ StCls loc x1 → + let loc = floc loc in + StCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) + | StClt loc x1 → + let loc = floc loc in + StClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | StDcl loc x1 → + let loc = floc loc in + StDcl loc (vala_map (List.map self) x1) + | StDir loc x1 x2 → + let loc = floc loc in + StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | StExc loc x1 x2 x3 → + let loc = floc loc in + StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 + | StExp loc x1 → + let loc = floc loc in + StExp loc (reloc_expr floc sh x1) + | StExt loc x1 x2 x3 → + let loc = floc loc in + StExt loc x1 (reloc_ctyp floc sh x2) x3 + | StInc loc x1 → + let loc = floc loc in + StInc loc (reloc_module_expr floc sh x1) + | StMod loc x1 x2 → + let loc = floc loc in + StMod loc x1 + (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_expr floc sh x2))) + x2) + | StMty loc x1 x2 → + let loc = floc loc in + StMty loc x1 (reloc_module_type floc sh x2) + | StOpn loc x1 → + let loc = floc loc in + StOpn loc x1 + | StTyp loc x1 → + let loc = floc loc in + StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | StUse loc x1 x2 → + let loc = floc loc in + StUse loc x1 + (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) + | StVal loc x1 x2 → + let loc = floc loc in + StVal loc x1 + (vala_map + (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + | StXtr loc x1 x2 → + let loc = floc loc in + StXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_type_decl floc sh x = + {tdNam = vala_map (fun (loc, x1) → (floc loc, x1)) x.tdNam; tdPrm = x.tdPrm; + tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; + tdCon = + vala_map (List.map (fun (x1, x2) → (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) + x.tdCon} +and reloc_class_type floc sh = + self where rec self = + fun + [ CtAcc loc x1 x2 → + let loc = floc loc in + CtAcc loc (self x1) (self x2) + | CtApp loc x1 x2 → + let loc = floc loc in + CtApp loc (self x1) (self x2) + | CtCon loc x1 x2 → + let loc = floc loc in + CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CtFun loc x1 x2 → + let loc = floc loc in + CtFun loc (reloc_ctyp floc sh x1) (self x2) + | CtIde loc x1 → + let loc = floc loc in + CtIde loc x1 + | CtSig loc x1 x2 → + let loc = floc loc in + CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) + (vala_map (List.map (reloc_class_sig_item floc sh)) x2) + | CtXtr loc x1 x2 → + let loc = floc loc in + CtXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_class_sig_item floc sh = + self where rec self = + fun + [ CgCtr loc x1 x2 → + let loc = floc loc in + CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CgDcl loc x1 → + let loc = floc loc in + CgDcl loc (vala_map (List.map self) x1) + | CgInh loc x1 → + let loc = floc loc in + CgInh loc (reloc_class_type floc sh x1) + | CgMth loc x1 x2 x3 → + let loc = floc loc in + CgMth loc x1 x2 (reloc_ctyp floc sh x3) + | CgVal loc x1 x2 x3 → + let loc = floc loc in + CgVal loc x1 x2 (reloc_ctyp floc sh x3) + | CgVir loc x1 x2 x3 → + let loc = floc loc in + CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_class_expr floc sh = + self where rec self = + fun + [ CeApp loc x1 x2 → + let loc = floc loc in + CeApp loc (self x1) (reloc_expr floc sh x2) + | CeCon loc x1 x2 → + let loc = floc loc in + CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CeFun loc x1 x2 → + let loc = floc loc in + CeFun loc (reloc_patt floc sh x1) (self x2) + | CeLet loc x1 x2 x3 → + let loc = floc loc in + CeLet loc x1 + (vala_map + (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + (self x3) + | CeStr loc x1 x2 → + let loc = floc loc in + CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | CeTyc loc x1 x2 → + let loc = floc loc in + CeTyc loc (self x1) (reloc_class_type floc sh x2) + | CeXtr loc x1 x2 → + let loc = floc loc in + CeXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_class_str_item floc sh = + self where rec self = + fun + [ CrCtr loc x1 x2 → + let loc = floc loc in + CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CrDcl loc x1 → + let loc = floc loc in + CrDcl loc (vala_map (List.map self) x1) + | CrInh loc x1 x2 → + let loc = floc loc in + CrInh loc (reloc_class_expr floc sh x1) x2 + | CrIni loc x1 → + let loc = floc loc in + CrIni loc (reloc_expr floc sh x1) + | CrMth loc x1 x2 x3 x4 x5 → + let loc = floc loc in + CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) + (reloc_expr floc sh x5) + | CrVal loc x1 x2 x3 x4 → + let loc = floc loc in + CrVal loc x1 x2 x3 (reloc_expr floc sh x4) + | CrVav loc x1 x2 x3 → + let loc = floc loc in + CrVav loc x1 x2 (reloc_ctyp floc sh x3) + | CrVir loc x1 x2 x3 → + let loc = floc loc in + CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] +; + +(* Equality over syntax trees *) + +value eq_expr x y = + reloc_expr (fun _ -> Ploc.dummy) 0 x = + reloc_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_patt x y = + reloc_patt (fun _ -> Ploc.dummy) 0 x = + reloc_patt (fun _ -> Ploc.dummy) 0 y +; +value eq_ctyp x y = + reloc_ctyp (fun _ -> Ploc.dummy) 0 x = + reloc_ctyp (fun _ -> Ploc.dummy) 0 y +; +value eq_str_item x y = + reloc_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_sig_item x y = + reloc_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_module_expr x y = + reloc_module_expr (fun _ -> Ploc.dummy) 0 x = + reloc_module_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_module_type x y = + reloc_module_type (fun _ -> Ploc.dummy) 0 x = + reloc_module_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_sig_item x y = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_class_str_item x y = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_reloc_class_type x y = + reloc_class_type (fun _ -> Ploc.dummy) 0 x = + reloc_class_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_expr x y = + reloc_class_expr (fun _ -> Ploc.dummy) 0 x = + reloc_class_expr (fun _ -> Ploc.dummy) 0 y +; + +(* ------------------------------------------------------------------------- *) +(* Now the lexer. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: plexer.ml,v 6.11 2010-10-04 20:14:58 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_lexer.cmo"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH as a backdoor to change lexical conventions. *) +(* ------------------------------------------------------------------------- *) + +value jrh_lexer = ref False; + +open Versdep; + +value no_quotations = ref False; +value error_on_unknown_keywords = ref False; + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value force_antiquot_loc = ref False; + +type context = + { after_space : mutable bool; + dollar_for_antiquotation : bool; + specific_space_dot : bool; + find_kwd : string -> string; + line_cnt : int -> char -> unit; + set_line_nb : unit -> unit; + make_lined_loc : (int * int) -> string -> Ploc.t } +; + +value err ctx loc msg = + Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) +; + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** JRH: Carl's alternative version + then ("UIDENT", id) + else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) + else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +value keyword_or_error ctx loc s = + try ("", ctx.find_kwd s) with + [ Not_found -> + if error_on_unknown_keywords.val then + err ctx loc ("illegal token: " ^ s) + else ("", s) ] +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value utf8_lexing = ref False; + +value misc_letter buf strm = + if utf8_lexing.val then + match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] + else + match strm with lexer [ '\128'-'\255' ] +; + +value misc_punct buf strm = + if utf8_lexing.val then + match strm with lexer [ '\226' _ _ ] + else + match strm with parser [] +; + +value rec ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] +; + +value rec ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] + ident2! + | ] +; + +value rec ident3 = + lexer + [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | + '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' | '\128'-'\255' ] ident3! + | ] +; + +value binary = lexer [ '0' | '1' ]; +value octal = lexer [ '0'-'7' ]; +value decimal = lexer [ '0'-'9' ]; +value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; + +value end_integer = + lexer + [ "l"/ -> ("INT_l", $buf) + | "L"/ -> ("INT_L", $buf) + | "n"/ -> ("INT_n", $buf) + | -> ("INT", $buf) ] +; + +value rec digits_under kind = + lexer + [ kind (digits_under kind)! + | "_" (digits_under kind)! + | end_integer ] +; + +value digits kind = + lexer + [ kind (digits_under kind)! + | -> raise (Stream.Error "ill-formed integer constant") ] +; + +value rec decimal_digits_under = + lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] +; + +value exponent_part = + lexer + [ [ 'e' | 'E' ] [ '+' | '-' | ] + '0'-'9' ? "ill-formed floating-point constant" + decimal_digits_under! ] +; + +value number = + lexer + [ decimal_digits_under "." decimal_digits_under! exponent_part -> + ("FLOAT", $buf) + | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) + | decimal_digits_under exponent_part -> ("FLOAT", $buf) + | decimal_digits_under end_integer! ] +; + +value char_after_bslash = + lexer + [ "'"/ + | _ [ "'"/ | _ [ "'"/ | ] ] ] +; + +value char ctx bp = + lexer + [ "\\" _ char_after_bslash! + | "\\" -> err ctx (bp, $pos) "char not terminated" + | ?= [ _ '''] _! "'"/ ] +; + +value any ctx buf = + parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } +; + +value rec string ctx bp = + lexer + [ "\""/ + | "\\" (any ctx) (string ctx bp)! + | (any ctx) (string ctx bp)! + | -> err ctx (bp, $pos) "string not terminated" ] +; + +value rec qstring ctx bp = + lexer + [ "`"/ + | (any ctx) (qstring ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value comment ctx bp = + comment where rec comment = + lexer + [ "*)" + | "*" comment! + | "(*" comment! comment! + | "(" comment! + | "\"" (string ctx bp)! [ -> $add "\"" ] comment! + | "'*)" + | "'*" comment! + | "'" (any ctx) comment! + | (any ctx) comment! + | -> err ctx (bp, $pos) "comment not terminated" ] +; + +value rec quotation ctx bp = + lexer + [ ">>"/ + | ">" (quotation ctx bp)! + | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! (quotation ctx bp)! + | "<" (quotation ctx bp)! + | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! + | "\\" (quotation ctx bp)! + | (any ctx) (quotation ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value less_expected = "character '<' expected"; + +value less ctx bp buf strm = + if no_quotations.val then + match strm with lexer + [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] + else + match strm with lexer + [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) + | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec antiquot_rest ctx bp = + lexer + [ "$"/ + | "\\"/ (any ctx) (antiquot_rest ctx bp)! + | (any ctx) (antiquot_rest ctx bp)! + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value rec antiquot ctx bp = + lexer + [ "$"/ -> ":" ^ $buf + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! + | ":" (antiquot_rest ctx bp)! -> $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; + +value rec antiquot_loc ctx bp = + lexer + [ "$"/ -> antiloc bp $pos (":" ^ $buf) + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! + | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value dollar ctx bp buf strm = + if not no_quotations.val && ctx.dollar_for_antiquotation then + ("ANTIQUOT", antiquot ctx bp buf strm) + else if force_antiquot_loc.val then + ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) + else + match strm with lexer + [ [ -> $add "$" ] ident2! -> ("", $buf) ] +; + +(* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?abc:d ?abc + ?$abc:d$: ?abc:d: ?abc: + ?$d$ ?:d ? + ?$d$: ?:d: ?: +*) + +(* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?8,13:abc:d ?abc + ?$abc:d$: ?8,13:abc:d: ?abc: + ?$d$ ?8,9::d ? + ?$d$: ?8,9::d: ?: +*) + +value question ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "?" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "?" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tilde ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "~" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "~" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tildeident = + lexer + [ ":"/ -> ("TILDEIDENTCOLON", $buf) + | -> ("TILDEIDENT", $buf) ] +; + +value questionident = + lexer + [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) + | -> ("QUESTIONIDENT", $buf) ] +; + +value rec linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] +and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] +and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] +; + +value rec any_to_nl = + lexer + [ "\r" | "\n" + | _ any_to_nl! + | ] +; + +value next_token_after_spaces ctx bp = + lexer + [ 'A'-'Z' ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] + *********) + | [ 'a'-'z' | '_' | misc_letter ] ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] + *********) + | '1'-'9' number! + | "0" [ 'o' | 'O' ] (digits octal)! + | "0" [ 'x' | 'X' ] (digits hexa)! + | "0" [ 'b' | 'B' ] (digits binary)! + | "0" number! + | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" + | "'"/ (char ctx bp) -> ("CHAR", $buf) + | "'" -> keyword_or_error ctx (bp, $pos) "'" + | "\""/ (string ctx bp)! -> ("STRING", $buf) +(*** Line added by JRH ***) + | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) + | "$"/ (dollar ctx bp)! + | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> + keyword_or_error ctx (bp, $pos) $buf + | "~"/ 'a'-'z' ident! tildeident! + | "~"/ '_' ident! tildeident! + | "~" (tilde ctx bp) + | "?"/ 'a'-'z' ident! questionident! + | "?" (question ctx bp)! + | "<"/ (less ctx bp)! + | ":]" -> keyword_or_error ctx (bp, $pos) $buf + | "::" -> keyword_or_error ctx (bp, $pos) $buf + | ":=" -> keyword_or_error ctx (bp, $pos) $buf + | ":>" -> keyword_or_error ctx (bp, $pos) $buf + | ":" -> keyword_or_error ctx (bp, $pos) $buf + | ">]" -> keyword_or_error ctx (bp, $pos) $buf + | ">}" -> keyword_or_error ctx (bp, $pos) $buf + | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "|]" -> keyword_or_error ctx (bp, $pos) $buf + | "|}" -> keyword_or_error ctx (bp, $pos) $buf + | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "[|" -> keyword_or_error ctx (bp, $pos) $buf + | "[<" -> keyword_or_error ctx (bp, $pos) $buf + | "[:" -> keyword_or_error ctx (bp, $pos) $buf + | "[" -> keyword_or_error ctx (bp, $pos) $buf + | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "{|" -> keyword_or_error ctx (bp, $pos) $buf + | "{<" -> keyword_or_error ctx (bp, $pos) $buf + | "{:" -> keyword_or_error ctx (bp, $pos) $buf + | "{" -> keyword_or_error ctx (bp, $pos) $buf + | ".." -> keyword_or_error ctx (bp, $pos) ".." + | "." -> + let id = + if ctx.specific_space_dot && ctx.after_space then " ." else "." + in + keyword_or_error ctx (bp, $pos) id + | ";;" -> keyword_or_error ctx (bp, $pos) ";;" + | ";" -> keyword_or_error ctx (bp, $pos) ";" + | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "\\"/ ident3! -> ("LIDENT", $buf) + | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value get_comment buf strm = $buf; + +value rec next_token ctx buf = + parser bp + [ [: `('\n' | '\r' as c); s :] ep -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := ep; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> + let comm = get_comment buf () in + if linedir 1 s then do { + let buf = any_to_nl ($add '#') s in + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := Stream.count s; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + else + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (keyword_or_error ctx (bp, bp + 1) "#", loc) + | [: `'('; + a = + parser + [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + | [: :] ep -> + let loc = ctx.make_lined_loc (bp, ep) $buf in + (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a + | [: comm = get_comment buf; + tok = next_token_after_spaces ctx bp $empty :] ep -> + let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in + (tok, loc) + | [: comm = get_comment buf; _ = Stream.empty :] -> + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (("EOI", ""), loc) ] +; + +value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = + try do { + match Plexing.restore_lexing_info.val with + [ Some (line_nb, bol_pos) -> do { + s_line_nb.val := line_nb; + s_bol_pos.val := bol_pos; + Plexing.restore_lexing_info.val := None; + } + | None -> () ]; + Plexing.line_nb.val := s_line_nb; + Plexing.bol_pos.val := s_bol_pos; + let comm_bp = Stream.count cstrm in + ctx.set_line_nb (); + ctx.after_space := False; + let (r, loc) = next_token ctx $empty cstrm in + match glexr.val.Plexing.tok_comm with + [ Some list -> + if Ploc.first_pos loc > comm_bp then + let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in + glexr.val.Plexing.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (r, loc) + } + with + [ Stream.Error str -> + err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + +value func kwd_table glexr = + let ctx = + let line_nb = ref 0 in + let bol_pos = ref 0 in + {after_space = False; + dollar_for_antiquotation = dollar_for_antiquotation.val; + specific_space_dot = specific_space_dot.val; + find_kwd = Hashtbl.find kwd_table; + line_cnt bp1 c = + match c with + [ '\n' | '\r' -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := bp1 + 1; + } + | c -> () ]; + set_line_nb () = do { + line_nb.val := Plexing.line_nb.val.val; + bol_pos.val := Plexing.bol_pos.val.val; + }; + make_lined_loc loc comm = + Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} + in + Plexing.lexer_func_of_parser (next_token_fun ctx glexr) +; + +value rec check_keyword_stream = + parser [: _ = check $empty; _ = Stream.empty :] -> True +and check = + lexer + [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! + | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' ] + check_ident2! + | "$" check_ident2! + | "<" ?= [ ":" | "<" ] + | "<" check_ident2! + | ":]" + | "::" + | ":=" + | ":>" + | ":" + | ">]" + | ">}" + | ">" check_ident2! + | "|]" + | "|}" + | "|" check_ident2! + | "[" ?= [ "<<" | "<:" ] + | "[|" + | "[<" + | "[:" + | "[" + | "{" ?= [ "<<" | "<:" ] + | "{|" + | "{<" + | "{:" + | "{" + | ";;" + | ";" + | misc_punct check_ident2! + | _ ] +and check_ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] + check_ident! | ] +and check_ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' | ':' | '<' | '>' | '|' | misc_punct ] + check_ident2! | ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Plexing.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Plexing.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (hashtbl_mem kwd_table p_prm) then + if check_keyword p_prm then + if hashtbl_mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | + "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | + "CHAR" | "STRING" | "QUOTATION" | + "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> + () + | _ -> + raise + (Plexing.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT", s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value after_colon_except_last e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 2) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then + if p_prm.[String.length p_prm - 1] = ':' then + let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + if eq_before_colon p_prm prm then after_colon_except_last prm + else raise Stream.Failure + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + raise Stream.Failure + else if eq_before_colon p_prm prm then after_colon prm + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Plexing.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {Plexing.tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +(* ------------------------------------------------------------------------- *) +(* Back to etc/pa_o.ml *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry signature; + Grammar.Unsafe.clear_entry structure; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_decl; + Grammar.Unsafe.clear_entry constructor_declaration; + Grammar.Unsafe.clear_entry label_declaration; + Grammar.Unsafe.clear_entry match_case; + Grammar.Unsafe.clear_entry with_constr; + Grammar.Unsafe.clear_entry poly_variant; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc + in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc + in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = do { + let ct = Hashtbl.create 73 in + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] +}; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> do { + Stream.junk strm; + Stream.junk strm; + translate_operator s + } + | _ -> raise Stream.Failure ]) +; + +value check_not_part_of_patt = + Grammar.Entry.of_parser gram "check_not_part_of_patt" + (fun strm -> + let tok = + match Stream.npeek 4 strm with + [ [("LIDENT", _); tok :: _] -> tok + | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok + | _ -> raise Stream.Failure ] + in + match tok with + [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure + | _ -> () ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + loop where rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"; "?!"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && (x = "$" || String.length x >= 2) && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("ANTIQUOT_LOC", _) -> () + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value e_phony = + Grammar.Entry.of_parser gram "e_phony" + (parser []) +; +value p_phony = + Grammar.Entry.of_parser gram "p_phony" + (parser []) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | _ -> 1 ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value mem_tvar s tpl = + List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if mem_tvar s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if mem_tvar v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value quotation_content s = do { + loop 0 where rec loop i = + if i = String.length s then ("", s) + else if s.[i] = ':' || s.[i] = '@' then + let i = i + 1 in + (String.sub s 0 i, String.sub s i (String.length s - i)) + else loop (i + 1) +}; + +value concat_comm loc e = + let loc = + Ploc.with_comment loc + (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) + in + let floc = + let first = ref True in + fun loc1 -> + if first.val then do {first.val := False; loc} + else loc1 + in + reloc_expr floc 0 e +; + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr + signature structure class_type class_expr class_sig_item class_str_item + let_binding type_decl constructor_declaration label_declaration + match_case with_constr poly_variant; + module_expr: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; + "->"; me = SELF -> + <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> + | "struct"; st = structure; "end" -> + <:module_expr< struct $_list:st$ end >> ] + | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] + | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; "val"; e = expr; ":"; mt = module_type; ")" -> + <:module_expr< (value $e$ : $mt$) >> + | "("; "val"; e = expr; ")" -> + <:module_expr< (value $e$) >> + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + structure: + [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration; + b = rebind_exn -> + <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> + <:str_item< module $_flag:r$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:str_item< module type $_uid:i$ = $mt$ >> + | "open"; i = V mod_ident "list" "" -> + <:str_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:str_item< type $_list:tdl$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr -> + let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> + match l with + [ <:vala< [(p, e)] >> -> + match p with + [ <:patt< _ >> -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> + <:str_item< let module $_uid:m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = V mod_ident "list" -> sl + | -> <:vala< [] >> ] ] + ; + mod_binding: + [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] + ; + mod_fun_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; + mt = SELF -> + <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> + <:module_type< $mt$ with $_list:wcl$ >> ] + | [ "sig"; sg = signature; "end" -> + <:module_type< sig $_list:sg$ end >> + | "module"; "type"; "of"; me = module_expr -> + <:module_type< module type of $me$ >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + signature: + [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = V UIDENT -> <:module_type< $_uid:m$ >> + | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration -> + <:sig_item< exception $_uid:c$ of $_list:tl$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; mt = module_type -> + <:sig_item< include $mt$ >> + | "module"; rf = V (FLAG "rec"); + l = V (LIST1 mod_decl_binding SEP "and") -> + <:sig_item< module $_flag:rf$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:sig_item< module type $_uid:i$ = $mt$ >> + | "module"; "type"; i = V UIDENT "uid" "" -> + <:sig_item< module type $_uid:i$ = 'abstract >> + | "open"; i = V mod_ident "list" "" -> + <:sig_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:sig_item< type $_list:tdl$ >> + | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> + <:sig_item< value $_lid:i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $lid:i$ : $t$ >> ] ] + ; + mod_decl_binding: + [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; + pf = V (FLAG "private"); t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> + | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; + t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> + | "module"; i = V mod_ident ""; "="; me = module_expr -> + <:with_constr< module $_:i$ = $me$ >> + | "module"; i = V mod_ident ""; ":="; me = module_expr -> + <:with_constr< module $_:i$ := $me$ >> ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 + | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] + | "expr1" + [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr LEVEL "top" -> + <:expr< let $_flag:o$ $_list:l$ in $x$ >> + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $_uid:m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< fun [ $_list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> + <:expr< fun [$p$ $opt:eo$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; + l = V (LIST1 match_case SEP "|") -> + <:expr< match $e$ with [ $_list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< try $e$ with [ $_list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; + e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; + e2 = SELF; "do"; e = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e in + <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> + | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e2 in + <:expr< while $e1$ do { $_list:el$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< - $e$ >> + | "-."; e = SELF -> <:expr< -. $e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + let (e1, e2) = + if is_expr_constr_call e1 then + match e1 with + [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) + | _ -> (e1, e2) ] + else (e1, e2) + in + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> <:expr< assert $e$ >> + | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; op = operator_rparen -> + <:expr< $e1$ .( $lid:op$ ) >> + | e1 = SELF; "."; "("; e2 = SELF; ")" -> + <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> + <:expr< $e$ .{ $_list:el$ } >> + | e1 = SELF; "."; e2 = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop e1 e2 ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val >> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = V INT -> <:expr< $_int:s$ >> + | s = V INT_l -> <:expr< $_int32:s$ >> + | s = V INT_L -> <:expr< $_int64:s$ >> + | s = V INT_n -> <:expr< $_nativeint:s$ >> + | s = V FLOAT -> <:expr< $_flo:s$ >> + | s = V STRING -> <:expr< $_str:s$ >> + | c = V CHAR -> <:expr< $_chr:c$ >> + | UIDENT "True" -> <:expr< True_ >> + | UIDENT "False" -> <:expr< False_ >> + | i = expr_ident -> i + | "false" -> <:expr< False >> + | "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = V expr1_semi_list "list"; "|]" -> + <:expr< [| $_list:el$ |] >> + | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> + <:expr< { $_list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> + <:expr< { ($e$) with $_list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> + <:expr< (module $me$ : $mt$) >> + | "("; "module"; me = module_expr; ")" -> + <:expr< (module $me$) >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> + | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_expr_quotation loc con ] ] + ; + let_binding: + [ [ p = val_ident; e = fun_binding -> (p, e) + | p = patt; "="; e = expr -> (p, e) + | p = patt; ":"; t = poly_type; "="; e = expr -> + (<:patt< ($p$ : $t$) >>, e) ] ] + ; +(*** JRH added the "translate_operator" here ***) + val_ident: + [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> + | check_not_part_of_patt; "("; s = ANY; ")" -> + let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) + | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> + (eo, <:expr< $e$ >>) ] ] + ; + expr_ident: + [ RIGHTA + [ i = V LIDENT -> <:expr< $_lid:i$ >> + | i = V UIDENT -> <:expr< $_uid:i$ >> + | i = V UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $_uid:i$ >> j + | i = V UIDENT; "."; "("; j = operator_rparen -> + <:expr< $_uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + let (p1, p2) = + match p1 with + [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) + | _ -> (p1, p2) ] + in + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] + | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = V LIDENT -> <:patt< $_lid:s$ >> + | s = V UIDENT -> <:patt< $_uid:s$ >> + | s = V INT -> <:patt< $_int:s$ >> + | s = V INT_l -> <:patt< $_int32:s$ >> + | s = V INT_L -> <:patt< $_int64:s$ >> + | s = V INT_n -> <:patt< $_nativeint:s$ >> + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = V FLOAT -> <:patt< $_flo:s$ >> + | s = V STRING -> <:patt< $_str:s$ >> + | s = V CHAR -> <:patt< $_chr:s$ >> + | UIDENT "True" -> <:patt< True_ >> + | UIDENT "False" -> <:patt< False_ >> + | "false" -> <:patt< False >> + | "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = V patt_semi_list "list"; "|]" -> + <:patt< [| $_list:pl$ |] >> + | "{"; lpl = V lbl_patt_list "list"; "}" -> + <:patt< { $_list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> + | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> + <:patt< (module $_uid:s$ : $mt$) >> + | "("; "module"; s = V UIDENT; ")" -> + <:patt< (module $_uid:s$) >> + | "_" -> <:patt< _ >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_patt_quotation loc con ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_decl: + [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); + tk = type_kind; cl = V (LIST0 constrain) -> + <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> + | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> + let tk = <:ctyp< '$choose_tvar tpl$ >> in + <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] + ; + type_patt: + [ [ n = V LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> + <:ctyp< $t$ >> + | t = ctyp; "="; pf = FLAG "private"; "{"; + ldl = V label_declarations "list"; "}" -> + <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> + | t = ctyp; "="; pf = FLAG "private"; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> + | "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< { $_list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "+"; p = V simple_type_parameter -> (p, Some True) + | "-"; p = V simple_type_parameter -> (p, Some False) + | p = V simple_type_parameter -> (p, None) ] ] + ; + simple_type_parameter: + [ [ "'"; i = ident -> Some i + | "_" -> None ] ] + ; + constructor_declaration: + [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + (loc, ci, cal, None) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); + "->"; t = ctyp -> + (loc, ci, cal, Some t) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + let t = + match cal with + [ <:vala< [t] >> -> t + | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> + | _ -> assert False ] + in + (loc, ci, <:vala< [] >>, Some t) + | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] + ; + cons_ident: + [ [ i = V UIDENT "uid" "" -> i + | UIDENT "True" -> <:vala< "True_" >> + | UIDENT "False" -> <:vala< "False_" >> ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "apply" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> + | "_" -> <:ctyp< _ >> + | i = V LIDENT -> <:ctyp< $_lid:i$ >> + | i = V UIDENT -> <:ctyp< $_uid:i$ >> + | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> + <:str_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:str_item< class type $_list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = V (LIST1 class_description SEP "and") -> + <:sig_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:sig_item< class type $_list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, <:vala< [] >>) + | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); + "in"; ce = SELF -> + <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< [ $ct$ ] $list:ci$ >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:class_expr< object $_opt:cspo$ $_list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> + <:class_str_item< inherit $ce$ $_opt:pb$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + lab = V LIDENT "lid" ""; e = cvalue_binding -> + <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> + if Pcaml.unvala ov then + Ploc.raise loc (Stream.Error "virtual value cannot override") + else + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; + ":"; t = ctyp -> + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_str_item< method virtual $_lid:l$ : $t$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + ":"; t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; + t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> + <:class_type< $id$ [ $list:tl$ ] >> + | "object"; cst = V (OPT class_self_type); + csf = V (LIST0 class_sig_item); "end" -> + <:class_type< object $_opt:cst$ $_list:csf$ end >> ] + | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> + | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] + | [ i = V LIDENT -> <:class_type< $_id: i$ >> + | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> + <:class_sig_item< inherit $cs$ >> + | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> + <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method private $_lid:l$ : $t$ >> + | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method $_lid:l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + ":"; ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + "="; cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = V field_expr_list "list"; ">}" -> + <:expr< {< $_list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = V class_longident "list" -> + <:ctyp< # $_list:id$ >> + | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> + <:ctyp< < $_list:ml$ $_flag:v$ > >> + | "<"; ".."; ">" -> + <:ctyp< < .. > >> + | "<"; ">" -> + <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; ml = SELF -> [f :: ml] + | f = field; ";" -> [f] + | f = field -> [f] ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> + <:ctyp< type $list:nt$ . $ct$ >> + | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: AFTER "arrow" + [ NONA + [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> + | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> + | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ = $_list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ > $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ < $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; + ntl = V (LIST1 name_tag); "]" -> + <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] + ; + poly_variant: + [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> + | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); + l = V (LIST1 ctyp SEP "&") -> + <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> + | t = ctyp -> <:poly_variant< $t$ >> ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> + <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> + | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> + | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> + | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> + | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> + | p = labeled_patt -> p ] ] + ; + labeled_patt: + [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> + <:patt< ~{$_:i$ = $p$} >> + | i = V TILDEIDENT -> + <:patt< ~{$_:i$} >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~{$lid:i$} >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~{$lid:i$ : $t$} >> + | i = V QUESTIONIDENTCOLON; j = LIDENT -> + <:patt< ?{$_:i$ = ?{$lid:j$}} >> + | i = V QUESTIONIDENTCOLON; "_" -> + <:patt< ?{$_:i$} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> + <:patt< ?{$_:i$ = ?{$p$}} >> + | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ = $e$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ : $t$ = $e$} >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ?{$lid:i$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ?{$lid:i$ : $t$} >> ] ] + ; + class_type: + [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ~$i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_fun_def: + [ [ p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $lid:n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> + <:str_item< # $lid:n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH *** *) +(* ------------------------------------------------------------------------- *) + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.1x_6.11.ml b/pa_j_3.1x_6.11.ml new file mode 100644 index 0000000..aba4738 --- /dev/null +++ b/pa_j_3.1x_6.11.ml @@ -0,0 +1,2976 @@ +(* ------------------------------------------------------------------------- *) +(* New version. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r pa_macro.cmo *) +(* $Id: pa_o.ml,v 6.50 2013-07-02 16:12:43 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2012 *) + +#load "pa_extend.cmo"; +#load "q_MLast.cmo"; +#load "pa_reloc.cmo"; + +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* The main/reloc.ml file. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: reloc.ml,v 6.26 2012-03-09 14:01:54 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2012 *) + +#load "pa_macro.cmo"; + +open MLast; + +value option_map f = + fun + [ Some x -> Some (f x) + | None -> None ] +; + +value vala_map f = + IFNDEF STRICT THEN + fun x -> f x + ELSE + fun + [ Ploc.VaAnt s -> Ploc.VaAnt s + | Ploc.VaVal x -> Ploc.VaVal (f x) ] + END +; + +value class_infos_map floc f x = + {ciLoc = floc x.ciLoc; ciVir = x.ciVir; + ciPrm = + let (x1, x2) = x.ciPrm in + (floc x1, x2); + ciNam = x.ciNam; ciExp = f x.ciExp} +; + +value anti_loc qloc sh loc loc1 = + (* + ...<:reloc_expr<.....$lid:...xxxxxxxx...$...>>... + |..|-----------------------------------| qloc + <-----> sh + |.........|------------| loc + |..|------| loc1 + *) + let sh1 = Ploc.first_pos qloc + sh in + let sh2 = sh1 + Ploc.first_pos loc in + let line_nb_qloc = Ploc.line_nb qloc in + let line_nb_loc = Ploc.line_nb loc in + let line_nb_loc1 = Ploc.line_nb loc1 in + if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then + Ploc.make_unlined + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) + else + Ploc.make_loc (Ploc.file_name loc) + (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) + (if line_nb_loc1 = 1 then + if line_nb_loc = 1 then Ploc.bol_pos qloc + else sh1 + Ploc.bol_pos loc + else sh2 + Ploc.bol_pos loc1) + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" +; + +value rec reloc_ctyp floc sh = + self where rec self = + fun + [ TyAcc loc x1 x2 → + let loc = floc loc in + TyAcc loc (self x1) (self x2) + | TyAli loc x1 x2 → + let loc = floc loc in + TyAli loc (self x1) (self x2) + | TyAny loc → + let loc = floc loc in + TyAny loc + | TyApp loc x1 x2 → + let loc = floc loc in + TyApp loc (self x1) (self x2) + | TyArr loc x1 x2 → + let loc = floc loc in + TyArr loc (self x1) (self x2) + | TyCls loc x1 → + let loc = floc loc in + TyCls loc x1 + | TyLab loc x1 x2 → + let loc = floc loc in + TyLab loc x1 (self x2) + | TyLid loc x1 → + let loc = floc loc in + TyLid loc x1 + | TyMan loc x1 x2 x3 → + let loc = floc loc in + TyMan loc (self x1) x2 (self x3) + | TyObj loc x1 x2 → + let loc = floc loc in + TyObj loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) x2 + | TyOlb loc x1 x2 → + let loc = floc loc in + TyOlb loc x1 (self x2) + | TyPck loc x1 → + let loc = floc loc in + TyPck loc (reloc_module_type floc sh x1) + | TyPol loc x1 x2 → + let loc = floc loc in + TyPol loc x1 (self x2) + | TyPot loc x1 x2 → + let loc = floc loc in + TyPot loc x1 (self x2) + | TyQuo loc x1 → + let loc = floc loc in + TyQuo loc x1 + | TyRec loc x1 → + let loc = floc loc in + TyRec loc + (vala_map + (List.map (fun (loc, x1, x2, x3) → (floc loc, x1, x2, self x3))) + x1) + | TySum loc x1 → + let loc = floc loc in + TySum loc + (vala_map + (List.map + (fun (loc, x1, x2, x3) → + (floc loc, x1, vala_map (List.map self) x2, + option_map self x3))) + x1) + | TyTup loc x1 → + let loc = floc loc in + TyTup loc (vala_map (List.map self) x1) + | TyUid loc x1 → + let loc = floc loc in + TyUid loc x1 + | TyVrn loc x1 x2 → + let loc = floc loc in + TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 + | TyXtr loc x1 x2 → + let loc = floc loc in + TyXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_poly_variant floc sh = + fun + [ PvTag loc x1 x2 x3 → + let loc = floc loc in + PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) + | PvInh loc x1 → + let loc = floc loc in + PvInh loc (reloc_ctyp floc sh x1) ] +and reloc_patt floc sh = + self where rec self = + fun + [ PaAcc loc x1 x2 → + let loc = floc loc in + PaAcc loc (self x1) (self x2) + | PaAli loc x1 x2 → + let loc = floc loc in + PaAli loc (self x1) (self x2) + | PaAnt loc x1 → + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_patt new_floc sh x1 + | PaAny loc → + let loc = floc loc in + PaAny loc + | PaApp loc x1 x2 → + let loc = floc loc in + PaApp loc (self x1) (self x2) + | PaArr loc x1 → + let loc = floc loc in + PaArr loc (vala_map (List.map self) x1) + | PaChr loc x1 → + let loc = floc loc in + PaChr loc x1 + | PaFlo loc x1 → + let loc = floc loc in + PaFlo loc x1 + | PaInt loc x1 x2 → + let loc = floc loc in + PaInt loc x1 x2 + | PaLab loc x1 → + let loc = floc loc in + PaLab loc + (vala_map + (List.map + (fun (x1, x2) → (self x1, vala_map (option_map self) x2))) + x1) + | PaLaz loc x1 → + let loc = floc loc in + PaLaz loc (self x1) + | PaLid loc x1 → + let loc = floc loc in + PaLid loc x1 + | PaNty loc x1 → + let loc = floc loc in + PaNty loc x1 + | PaOlb loc x1 x2 → + let loc = floc loc in + PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) + | PaOrp loc x1 x2 → + let loc = floc loc in + PaOrp loc (self x1) (self x2) + | PaRec loc x1 → + let loc = floc loc in + PaRec loc (vala_map (List.map (fun (x1, x2) → (self x1, self x2))) x1) + | PaRng loc x1 x2 → + let loc = floc loc in + PaRng loc (self x1) (self x2) + | PaStr loc x1 → + let loc = floc loc in + PaStr loc x1 + | PaTup loc x1 → + let loc = floc loc in + PaTup loc (vala_map (List.map self) x1) + | PaTyc loc x1 x2 → + let loc = floc loc in + PaTyc loc (self x1) (reloc_ctyp floc sh x2) + | PaTyp loc x1 → + let loc = floc loc in + PaTyp loc x1 + | PaUid loc x1 → + let loc = floc loc in + PaUid loc x1 + | PaUnp loc x1 x2 → + let loc = floc loc in + PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) + | PaVrn loc x1 → + let loc = floc loc in + PaVrn loc x1 + | PaXtr loc x1 x2 → + let loc = floc loc in + PaXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_expr floc sh = + self where rec self = + fun + [ ExAcc loc x1 x2 → + let loc = floc loc in + ExAcc loc (self x1) (self x2) + | ExAnt loc x1 → + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_expr new_floc sh x1 + | ExApp loc x1 x2 → + let loc = floc loc in + ExApp loc (self x1) (self x2) + | ExAre loc x1 x2 → + let loc = floc loc in + ExAre loc (self x1) (self x2) + | ExArr loc x1 → + let loc = floc loc in + ExArr loc (vala_map (List.map self) x1) + | ExAsr loc x1 → + let loc = floc loc in + ExAsr loc (self x1) + | ExAss loc x1 x2 → + let loc = floc loc in + ExAss loc (self x1) (self x2) + | ExBae loc x1 x2 → + let loc = floc loc in + ExBae loc (self x1) (vala_map (List.map self) x2) + | ExChr loc x1 → + let loc = floc loc in + ExChr loc x1 + | ExCoe loc x1 x2 x3 → + let loc = floc loc in + ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) + | ExFlo loc x1 → + let loc = floc loc in + ExFlo loc x1 + | ExFor loc x1 x2 x3 x4 x5 → + let loc = floc loc in + ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) + | ExFun loc x1 → + let loc = floc loc in + ExFun loc + (vala_map + (List.map + (fun (x1, x2, x3) → + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x1) + | ExIfe loc x1 x2 x3 → + let loc = floc loc in + ExIfe loc (self x1) (self x2) (self x3) + | ExInt loc x1 x2 → + let loc = floc loc in + ExInt loc x1 x2 + | ExJdf loc x1 x2 → + let loc = floc loc in + ExJdf loc (vala_map (List.map (reloc_joinclause floc sh)) x1) (self x2) + | ExLab loc x1 → + let loc = floc loc in + ExLab loc + (vala_map + (List.map + (fun (x1, x2) → + (reloc_patt floc sh x1, vala_map (option_map self) x2))) + x1) + | ExLaz loc x1 → + let loc = floc loc in + ExLaz loc (self x1) + | ExLet loc x1 x2 x3 → + let loc = floc loc in + ExLet loc x1 + (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x2) + (self x3) + | ExLid loc x1 → + let loc = floc loc in + ExLid loc x1 + | ExLmd loc x1 x2 x3 → + let loc = floc loc in + ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) + | ExMat loc x1 x2 → + let loc = floc loc in + ExMat loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) → + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExNew loc x1 → + let loc = floc loc in + ExNew loc x1 + | ExObj loc x1 x2 → + let loc = floc loc in + ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | ExOlb loc x1 x2 → + let loc = floc loc in + ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) + | ExOvr loc x1 → + let loc = floc loc in + ExOvr loc (vala_map (List.map (fun (x1, x2) → (x1, self x2))) x1) + | ExPar loc x1 x2 → + let loc = floc loc in + ExPar loc (self x1) (self x2) + | ExPck loc x1 x2 → + let loc = floc loc in + ExPck loc (reloc_module_expr floc sh x1) + (option_map (reloc_module_type floc sh) x2) + | ExRec loc x1 x2 → + let loc = floc loc in + ExRec loc + (vala_map (List.map (fun (x1, x2) → (reloc_patt floc sh x1, self x2))) x1) + (option_map self x2) + | ExRpl loc x1 x2 → + let loc = floc loc in + ExRpl loc (vala_map (option_map self) x1) + ((fun (loc, x1) → (floc loc, x1)) x2) + | ExSeq loc x1 → + let loc = floc loc in + ExSeq loc (vala_map (List.map self) x1) + | ExSpw loc x1 → + let loc = floc loc in + ExSpw loc (self x1) + | ExSnd loc x1 x2 → + let loc = floc loc in + ExSnd loc (self x1) x2 + | ExSte loc x1 x2 → + let loc = floc loc in + ExSte loc (self x1) (self x2) + | ExStr loc x1 → + let loc = floc loc in + ExStr loc x1 + | ExTry loc x1 x2 → + let loc = floc loc in + ExTry loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) → + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExTup loc x1 → + let loc = floc loc in + ExTup loc (vala_map (List.map self) x1) + | ExTyc loc x1 x2 → + let loc = floc loc in + ExTyc loc (self x1) (reloc_ctyp floc sh x2) + | ExUid loc x1 → + let loc = floc loc in + ExUid loc x1 + | ExVrn loc x1 → + let loc = floc loc in + ExVrn loc x1 + | ExWhi loc x1 x2 → + let loc = floc loc in + ExWhi loc (self x1) (vala_map (List.map self) x2) + | ExXtr loc x1 x2 → + let loc = floc loc in + ExXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_module_type floc sh = + self where rec self = + fun + [ MtAcc loc x1 x2 → + let loc = floc loc in + MtAcc loc (self x1) (self x2) + | MtApp loc x1 x2 → + let loc = floc loc in + MtApp loc (self x1) (self x2) + | MtFun loc x1 x2 x3 → + let loc = floc loc in + MtFun loc x1 (self x2) (self x3) + | MtLid loc x1 → + let loc = floc loc in + MtLid loc x1 + | MtQuo loc x1 → + let loc = floc loc in + MtQuo loc x1 + | MtSig loc x1 → + let loc = floc loc in + MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) + | MtTyo loc x1 → + let loc = floc loc in + MtTyo loc (reloc_module_expr floc sh x1) + | MtUid loc x1 → + let loc = floc loc in + MtUid loc x1 + | MtWit loc x1 x2 → + let loc = floc loc in + MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) + | MtXtr loc x1 x2 → + let loc = floc loc in + MtXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_sig_item floc sh = + self where rec self = + fun + [ SgCls loc x1 → + let loc = floc loc in + SgCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgClt loc x1 → + let loc = floc loc in + SgClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgDcl loc x1 → + let loc = floc loc in + SgDcl loc (vala_map (List.map self) x1) + | SgDir loc x1 x2 → + let loc = floc loc in + SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | SgExc loc x1 x2 → + let loc = floc loc in + SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | SgExt loc x1 x2 x3 → + let loc = floc loc in + SgExt loc x1 (reloc_ctyp floc sh x2) x3 + | SgInc loc x1 → + let loc = floc loc in + SgInc loc (reloc_module_type floc sh x1) + | SgMod loc x1 x2 → + let loc = floc loc in + SgMod loc x1 + (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_type floc sh x2))) + x2) + | SgMty loc x1 x2 → + let loc = floc loc in + SgMty loc x1 (reloc_module_type floc sh x2) + | SgOpn loc x1 → + let loc = floc loc in + SgOpn loc x1 + | SgTyp loc x1 → + let loc = floc loc in + SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | SgUse loc x1 x2 → + let loc = floc loc in + SgUse loc x1 + (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) + | SgVal loc x1 x2 → + let loc = floc loc in + SgVal loc x1 (reloc_ctyp floc sh x2) + | SgXtr loc x1 x2 → + let loc = floc loc in + SgXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_with_constr floc sh = + fun + [ WcMod loc x1 x2 → + let loc = floc loc in + WcMod loc x1 (reloc_module_expr floc sh x2) + | WcMos loc x1 x2 → + let loc = floc loc in + WcMos loc x1 (reloc_module_expr floc sh x2) + | WcTyp loc x1 x2 x3 x4 → + let loc = floc loc in + WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) + | WcTys loc x1 x2 x3 → + let loc = floc loc in + WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_module_expr floc sh = + self where rec self = + fun + [ MeAcc loc x1 x2 → + let loc = floc loc in + MeAcc loc (self x1) (self x2) + | MeApp loc x1 x2 → + let loc = floc loc in + MeApp loc (self x1) (self x2) + | MeFun loc x1 x2 x3 → + let loc = floc loc in + MeFun loc x1 (reloc_module_type floc sh x2) (self x3) + | MeStr loc x1 → + let loc = floc loc in + MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) + | MeTyc loc x1 x2 → + let loc = floc loc in + MeTyc loc (self x1) (reloc_module_type floc sh x2) + | MeUid loc x1 → + let loc = floc loc in + MeUid loc x1 + | MeUnp loc x1 x2 → + let loc = floc loc in + MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) + | MeXtr loc x1 x2 → + let loc = floc loc in + MeXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_str_item floc sh = + self where rec self = + fun + [ StCls loc x1 → + let loc = floc loc in + StCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) + | StClt loc x1 → + let loc = floc loc in + StClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | StDcl loc x1 → + let loc = floc loc in + StDcl loc (vala_map (List.map self) x1) + | StDef loc x1 → + let loc = floc loc in + StDef loc (vala_map (List.map (reloc_joinclause floc sh)) x1) + | StDir loc x1 x2 → + let loc = floc loc in + StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | StExc loc x1 x2 x3 → + let loc = floc loc in + StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 + | StExp loc x1 → + let loc = floc loc in + StExp loc (reloc_expr floc sh x1) + | StExt loc x1 x2 x3 → + let loc = floc loc in + StExt loc x1 (reloc_ctyp floc sh x2) x3 + | StInc loc x1 → + let loc = floc loc in + StInc loc (reloc_module_expr floc sh x1) + | StMod loc x1 x2 → + let loc = floc loc in + StMod loc x1 + (vala_map (List.map (fun (x1, x2) → (x1, reloc_module_expr floc sh x2))) + x2) + | StMty loc x1 x2 → + let loc = floc loc in + StMty loc x1 (reloc_module_type floc sh x2) + | StOpn loc x1 → + let loc = floc loc in + StOpn loc x1 + | StTyp loc x1 → + let loc = floc loc in + StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | StUse loc x1 x2 → + let loc = floc loc in + StUse loc x1 + (vala_map (List.map (fun (x1, loc) → (self x1, floc loc))) x2) + | StVal loc x1 x2 → + let loc = floc loc in + StVal loc x1 + (vala_map + (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + | StXtr loc x1 x2 → + let loc = floc loc in + StXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_joinclause floc sh x = + {jcLoc = floc x.jcLoc; + jcVal = + vala_map + (List.map + (fun (loc, x1, x2) → + (floc loc, + vala_map + (List.map + (fun (loc, x1, x2) → + (floc loc, (fun (loc, x1) → (floc loc, x1)) x1, + vala_map (option_map (reloc_patt floc sh)) x2))) + x1, + reloc_expr floc sh x2))) + x.jcVal} +and reloc_type_decl floc sh x = + {tdNam = vala_map (fun (loc, x1) → (floc loc, x1)) x.tdNam; tdPrm = x.tdPrm; + tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; + tdCon = + vala_map (List.map (fun (x1, x2) → (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) + x.tdCon} +and reloc_class_type floc sh = + self where rec self = + fun + [ CtAcc loc x1 x2 → + let loc = floc loc in + CtAcc loc (self x1) (self x2) + | CtApp loc x1 x2 → + let loc = floc loc in + CtApp loc (self x1) (self x2) + | CtCon loc x1 x2 → + let loc = floc loc in + CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CtFun loc x1 x2 → + let loc = floc loc in + CtFun loc (reloc_ctyp floc sh x1) (self x2) + | CtIde loc x1 → + let loc = floc loc in + CtIde loc x1 + | CtSig loc x1 x2 → + let loc = floc loc in + CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) + (vala_map (List.map (reloc_class_sig_item floc sh)) x2) + | CtXtr loc x1 x2 → + let loc = floc loc in + CtXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_class_sig_item floc sh = + self where rec self = + fun + [ CgCtr loc x1 x2 → + let loc = floc loc in + CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CgDcl loc x1 → + let loc = floc loc in + CgDcl loc (vala_map (List.map self) x1) + | CgInh loc x1 → + let loc = floc loc in + CgInh loc (reloc_class_type floc sh x1) + | CgMth loc x1 x2 x3 → + let loc = floc loc in + CgMth loc x1 x2 (reloc_ctyp floc sh x3) + | CgVal loc x1 x2 x3 → + let loc = floc loc in + CgVal loc x1 x2 (reloc_ctyp floc sh x3) + | CgVir loc x1 x2 x3 → + let loc = floc loc in + CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_class_expr floc sh = + self where rec self = + fun + [ CeApp loc x1 x2 → + let loc = floc loc in + CeApp loc (self x1) (reloc_expr floc sh x2) + | CeCon loc x1 x2 → + let loc = floc loc in + CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CeFun loc x1 x2 → + let loc = floc loc in + CeFun loc (reloc_patt floc sh x1) (self x2) + | CeLet loc x1 x2 x3 → + let loc = floc loc in + CeLet loc x1 + (vala_map + (List.map (fun (x1, x2) → (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + (self x3) + | CeStr loc x1 x2 → + let loc = floc loc in + CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | CeTyc loc x1 x2 → + let loc = floc loc in + CeTyc loc (self x1) (reloc_class_type floc sh x2) + | CeXtr loc x1 x2 → + let loc = floc loc in + CeXtr loc x1 (option_map (vala_map self) x2) ] +and reloc_class_str_item floc sh = + self where rec self = + fun + [ CrCtr loc x1 x2 → + let loc = floc loc in + CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CrDcl loc x1 → + let loc = floc loc in + CrDcl loc (vala_map (List.map self) x1) + | CrInh loc x1 x2 → + let loc = floc loc in + CrInh loc (reloc_class_expr floc sh x1) x2 + | CrIni loc x1 → + let loc = floc loc in + CrIni loc (reloc_expr floc sh x1) + | CrMth loc x1 x2 x3 x4 x5 → + let loc = floc loc in + CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) + (reloc_expr floc sh x5) + | CrVal loc x1 x2 x3 x4 → + let loc = floc loc in + CrVal loc x1 x2 x3 (reloc_expr floc sh x4) + | CrVav loc x1 x2 x3 → + let loc = floc loc in + CrVav loc x1 x2 (reloc_ctyp floc sh x3) + | CrVir loc x1 x2 x3 → + let loc = floc loc in + CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] +; + +(* Equality over syntax trees *) + +value eq_expr x y = + reloc_expr (fun _ -> Ploc.dummy) 0 x = + reloc_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_patt x y = + reloc_patt (fun _ -> Ploc.dummy) 0 x = + reloc_patt (fun _ -> Ploc.dummy) 0 y +; +value eq_ctyp x y = + reloc_ctyp (fun _ -> Ploc.dummy) 0 x = + reloc_ctyp (fun _ -> Ploc.dummy) 0 y +; +value eq_str_item x y = + reloc_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_sig_item x y = + reloc_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_module_expr x y = + reloc_module_expr (fun _ -> Ploc.dummy) 0 x = + reloc_module_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_module_type x y = + reloc_module_type (fun _ -> Ploc.dummy) 0 x = + reloc_module_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_sig_item x y = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_class_str_item x y = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_reloc_class_type x y = + reloc_class_type (fun _ -> Ploc.dummy) 0 x = + reloc_class_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_expr x y = + reloc_class_expr (fun _ -> Ploc.dummy) 0 x = + reloc_class_expr (fun _ -> Ploc.dummy) 0 y +; + +(* ------------------------------------------------------------------------- *) +(* Now the lexer. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: plexer.ml,v 6.19 2013-07-03 01:43:10 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2012 *) + +#load "pa_lexer.cmo"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH as a backdoor to change lexical conventions. *) +(* ------------------------------------------------------------------------- *) + +value jrh_lexer = ref False; + +open Versdep; + +value no_quotations = ref False; +value error_on_unknown_keywords = ref False; + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; +value dot_newline_is = ref "."; + +value force_antiquot_loc = ref False; + +type context = + { after_space : mutable bool; + dollar_for_antiquotation : bool; + specific_space_dot : bool; + dot_newline_is : string; + find_kwd : string -> string; + line_cnt : int -> char -> unit; + set_line_nb : unit -> unit; + make_lined_loc : (int * int) -> string -> Ploc.t } +; + +value err ctx loc msg = + Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) +; + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** JRH: Carl's alternative version + then ("UIDENT", id) + else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) + else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +value keyword_or_error ctx loc s = + try ("", ctx.find_kwd s) with + [ Not_found -> + if error_on_unknown_keywords.val then + err ctx loc ("illegal token: " ^ s) + else ("", s) ] +; + +value rev_implode l = + let s = String.create (List.length l) in + loop (String.length s - 1) l where rec loop i = + fun + [ [c :: l] -> do { String.unsafe_set s i c; loop (i - 1) l } + | [] -> s ] +; + +value implode l = rev_implode (List.rev l); + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value utf8_lexing = ref False; + +value greek_tab = + ["α"; "β"; "γ"; "δ"; "ε"; "ζ"; "η"; "θ"; "ι"; "κ"; "λ"; "μ"; "ν"; "ξ"; + "ο"; "π"; "ρ"; "σ"; "τ"; "υ"; "φ"; "χ"; "ψ"; "ω"] +; + +value greek_letter buf strm = + if utf8_lexing.val then + match Stream.peek strm with + [ Some c -> + if Char.code c >= 128 then + let x = implode (Stream.npeek 2 strm) in + if List.mem x greek_tab then do { Stream.junk strm; $add c } + else raise Stream.Failure + else raise Stream.Failure + | None -> raise Stream.Failure ] + else + raise Stream.Failure +; + +value misc_letter buf strm = + if utf8_lexing.val then + match Stream.peek strm with + [ Some c -> + if Char.code c >= 128 then + match implode (Stream.npeek 3 strm) with + [ "→" | "≤" | "≥" -> raise Stream.Failure + | _ -> do { Stream.junk strm; $add c } ] + else raise Stream.Failure + | None -> raise Stream.Failure ] + else + match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] +; + +value misc_punct buf strm = + if utf8_lexing.val then + match strm with lexer [ '\226' _ _ ] + else + match strm with parser [] +; + +value utf8_equiv ctx bp buf strm = + if utf8_lexing.val then + match strm with lexer + [ "→" -> keyword_or_error ctx (bp, $pos) "->" + | "≤" -> keyword_or_error ctx (bp, $pos) "<=" + | "≥" -> keyword_or_error ctx (bp, $pos) ">=" ] + else + match strm with parser [] +; + +value rec ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] +; + +value rec ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] + ident2! + | ] +; + +value rec ident3 = + lexer + [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | + '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' | '\128'-'\255' ] ident3! + | ] +; + +value binary = lexer [ '0' | '1' ]; +value octal = lexer [ '0'-'7' ]; +value decimal = lexer [ '0'-'9' ]; +value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; + +value end_integer = + lexer + [ "l"/ -> ("INT_l", $buf) + | "L"/ -> ("INT_L", $buf) + | "n"/ -> ("INT_n", $buf) + | -> ("INT", $buf) ] +; + +value rec digits_under kind = + lexer + [ kind (digits_under kind)! + | "_" (digits_under kind)! + | end_integer ] +; + +value digits kind = + lexer + [ kind (digits_under kind)! + | -> raise (Stream.Error "ill-formed integer constant") ] +; + +value rec decimal_digits_under = + lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] +; + +value exponent_part = + lexer + [ [ 'e' | 'E' ] [ '+' | '-' | ] + '0'-'9' ? "ill-formed floating-point constant" + decimal_digits_under! ] +; + +value number = + lexer + [ decimal_digits_under "." decimal_digits_under! exponent_part -> + ("FLOAT", $buf) + | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) + | decimal_digits_under exponent_part -> ("FLOAT", $buf) + | decimal_digits_under end_integer! ] +; + +value char_after_bslash = + lexer + [ "'"/ + | _ [ "'"/ | _ [ "'"/ | ] ] ] +; + +value char ctx bp = + lexer + [ "\\" _ char_after_bslash! + | "\\" -> err ctx (bp, $pos) "char not terminated" + | ?= [ _ '''] _! "'"/ ] +; + +value any ctx buf = + parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } +; + +value rec string ctx bp = + lexer + [ "\""/ + | "\\" (any ctx) (string ctx bp)! + | (any ctx) (string ctx bp)! + | -> err ctx (bp, $pos) "string not terminated" ] +; + +value rec qstring ctx bp = + lexer + [ "`"/ + | (any ctx) (qstring ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value comment ctx bp = + comment where rec comment = + lexer + [ "*)" + | "*" comment! + | "(*" comment! comment! + | "(" comment! + | "\"" (string ctx bp)! [ -> $add "\"" ] comment! + | "'*)" + | "'*" comment! + | "'" (any ctx) comment! + | (any ctx) comment! + | -> err ctx (bp, $pos) "comment not terminated" ] +; + +value rec quotation ctx bp = + lexer + [ ">>"/ + | ">" (quotation ctx bp)! + | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! (quotation ctx bp)! + | "<" (quotation ctx bp)! + | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! + | "\\" (quotation ctx bp)! + | (any ctx) (quotation ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value less_expected = "character '<' expected"; + +value less ctx bp buf strm = + if no_quotations.val then + match strm with lexer + [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] + else + match strm with lexer + [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) + | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec antiquot_rest ctx bp = + lexer + [ "$"/ + | "\\"/ (any ctx) (antiquot_rest ctx bp)! + | (any ctx) (antiquot_rest ctx bp)! + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value rec antiquot ctx bp = + lexer + [ "$"/ -> ":" ^ $buf + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! + | ":" (antiquot_rest ctx bp)! -> $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; + +value rec antiquot_loc ctx bp = + lexer + [ "$"/ -> antiloc bp $pos (":" ^ $buf) + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! + | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value dollar ctx bp buf strm = + if not no_quotations.val && ctx.dollar_for_antiquotation then + ("ANTIQUOT", antiquot ctx bp buf strm) + else if force_antiquot_loc.val then + ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) + else + match strm with lexer + [ [ -> $add "$" ] ident2! -> ("", $buf) ] +; + +(* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?abc:d ?abc + ?$abc:d$: ?abc:d: ?abc: + ?$d$ ?:d ? + ?$d$: ?:d: ?: +*) + +(* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?8,13:abc:d ?abc + ?$abc:d$: ?8,13:abc:d: ?abc: + ?$d$ ?8,9::d ? + ?$d$: ?8,9::d: ?: +*) + +value question ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "?" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "?" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tilde ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "~" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "~" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tildeident = + lexer + [ ":"/ -> ("TILDEIDENTCOLON", $buf) + | -> ("TILDEIDENT", $buf) ] +; + +value questionident = + lexer + [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) + | -> ("QUESTIONIDENT", $buf) ] +; + +value rec linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] +and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] +and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] +; + +value rec any_to_nl = + lexer + [ "\r" | "\n" + | _ any_to_nl! + | ] +; + +value next_token_after_spaces ctx bp = + lexer + [ 'A'-'Z' ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] + *********) + | greek_letter ident! -> ("GIDENT", $buf) + | [ 'a'-'z' | '_' | misc_letter ] ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] + *********) + | '1'-'9' number! + | "0" [ 'o' | 'O' ] (digits octal)! + | "0" [ 'x' | 'X' ] (digits hexa)! + | "0" [ 'b' | 'B' ] (digits binary)! + | "0" number! + | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" + | "'"/ (char ctx bp) -> ("CHAR", $buf) + | "'" -> keyword_or_error ctx (bp, $pos) "'" + | "\""/ (string ctx bp)! -> ("STRING", $buf) +(*** Line added by JRH ***) + | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) + | "$"/ (dollar ctx bp)! + | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> + keyword_or_error ctx (bp, $pos) $buf + | "~"/ 'a'-'z' ident! tildeident! + | "~"/ '_' ident! tildeident! + | "~" (tilde ctx bp) + | "?"/ 'a'-'z' ident! questionident! + | "?" (question ctx bp)! + | "<"/ (less ctx bp)! + | ":]" -> keyword_or_error ctx (bp, $pos) $buf + | "::" -> keyword_or_error ctx (bp, $pos) $buf + | ":=" -> keyword_or_error ctx (bp, $pos) $buf + | ":>" -> keyword_or_error ctx (bp, $pos) $buf + | ":" -> keyword_or_error ctx (bp, $pos) $buf + | ">]" -> keyword_or_error ctx (bp, $pos) $buf + | ">}" -> keyword_or_error ctx (bp, $pos) $buf + | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "|]" -> keyword_or_error ctx (bp, $pos) $buf + | "|}" -> keyword_or_error ctx (bp, $pos) $buf + | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "[|" -> keyword_or_error ctx (bp, $pos) $buf + | "[<" -> keyword_or_error ctx (bp, $pos) $buf + | "[:" -> keyword_or_error ctx (bp, $pos) $buf + | "[" -> keyword_or_error ctx (bp, $pos) $buf + | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "{|" -> keyword_or_error ctx (bp, $pos) $buf + | "{<" -> keyword_or_error ctx (bp, $pos) $buf + | "{:" -> keyword_or_error ctx (bp, $pos) $buf + | "{" -> keyword_or_error ctx (bp, $pos) $buf + | ".." -> keyword_or_error ctx (bp, $pos) ".." + | "." ?= [ "\n" ] -> keyword_or_error ctx (bp, bp + 1) ctx.dot_newline_is + | "." -> + let id = + if ctx.specific_space_dot && ctx.after_space then " ." else "." + in + keyword_or_error ctx (bp, $pos) id + | ";;" -> keyword_or_error ctx (bp, $pos) ";;" + | ";" -> keyword_or_error ctx (bp, $pos) ";" + | (utf8_equiv ctx bp) + | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "\\"/ ident3! -> ("LIDENT", $buf) + | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value get_comment buf strm = $buf; + +value rec next_token ctx buf = + parser bp + [ [: `('\n' | '\r' as c); s :] ep -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := ep; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> + let comm = get_comment buf () in + if linedir 1 s then do { + let buf = any_to_nl ($add '#') s in + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := Stream.count s; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + else + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (keyword_or_error ctx (bp, bp + 1) "#", loc) + | [: `'('; + a = + parser + [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + | [: :] ep -> + let loc = ctx.make_lined_loc (bp, ep) $buf in + (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a + | [: comm = get_comment buf; + tok = next_token_after_spaces ctx bp $empty :] ep -> + let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in + (tok, loc) + | [: comm = get_comment buf; _ = Stream.empty :] -> + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (("EOI", ""), loc) ] +; + +value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = + try do { + match Plexing.restore_lexing_info.val with + [ Some (line_nb, bol_pos) -> do { + s_line_nb.val := line_nb; + s_bol_pos.val := bol_pos; + Plexing.restore_lexing_info.val := None; + } + | None -> () ]; + Plexing.line_nb.val := s_line_nb; + Plexing.bol_pos.val := s_bol_pos; + let comm_bp = Stream.count cstrm in + ctx.set_line_nb (); + ctx.after_space := False; + let (r, loc) = next_token ctx $empty cstrm in + match glexr.val.Plexing.tok_comm with + [ Some list -> + if Ploc.first_pos loc > comm_bp then + let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in + glexr.val.Plexing.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (r, loc) + } + with + [ Stream.Error str -> + err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + +value func kwd_table glexr = + let ctx = + let line_nb = ref 0 in + let bol_pos = ref 0 in + {after_space = False; + dollar_for_antiquotation = dollar_for_antiquotation.val; + specific_space_dot = specific_space_dot.val; + dot_newline_is = dot_newline_is.val; + find_kwd = Hashtbl.find kwd_table; + line_cnt bp1 c = + match c with + [ '\n' | '\r' -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := bp1 + 1; + } + | c -> () ]; + set_line_nb () = do { + line_nb.val := Plexing.line_nb.val.val; + bol_pos.val := Plexing.bol_pos.val.val; + }; + make_lined_loc loc comm = + Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} + in + Plexing.lexer_func_of_parser (next_token_fun ctx glexr) +; + +value rec check_keyword_stream = + parser [: _ = check $empty; _ = Stream.empty :] -> True +and check = + lexer + [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! + | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' ] + check_ident2! + | "$" check_ident2! + | "<" ?= [ ":" | "<" ] + | "<" check_ident2! + | ":]" + | "::" + | ":=" + | ":>" + | ":" + | ">]" + | ">}" + | ">" check_ident2! + | "|]" + | "|}" + | "|" check_ident2! + | "[" ?= [ "<<" | "<:" ] + | "[|" + | "[<" + | "[:" + | "[" + | "{" ?= [ "<<" | "<:" ] + | "{|" + | "{<" + | "{:" + | "{" + | ";;" + | ";" + | misc_punct check_ident2! + | _ ] +and check_ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] + check_ident! | ] +and check_ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' | ':' | '<' | '>' | '|' | misc_punct ] + check_ident2! | ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Plexing.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Plexing.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (hashtbl_mem kwd_table p_prm) then + if check_keyword p_prm then + if hashtbl_mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | + "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | + "CHAR" | "STRING" | "QUOTATION" | "GIDENT" | + "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> + () + | _ -> + raise + (Plexing.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT", s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value after_colon_except_last e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 2) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then + if p_prm.[String.length p_prm - 1] = ':' then + let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + if eq_before_colon p_prm prm then after_colon_except_last prm + else raise Stream.Failure + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + raise Stream.Failure + else if eq_before_colon p_prm prm then after_colon prm + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Plexing.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {Plexing.tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +(* ------------------------------------------------------------------------- *) +(* Back to etc/pa_o.ml *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Plexer.utf8_lexing.val := True; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry signature; + Grammar.Unsafe.clear_entry structure; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_decl; + Grammar.Unsafe.clear_entry constructor_declaration; + Grammar.Unsafe.clear_entry label_declaration; + Grammar.Unsafe.clear_entry match_case; + Grammar.Unsafe.clear_entry with_constr; + Grammar.Unsafe.clear_entry poly_variant; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc + in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc + in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = do { + let ct = Hashtbl.create 73 in + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] +}; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> do { + Stream.junk strm; + Stream.junk strm; + translate_operator s + } + | _ -> raise Stream.Failure ]) +; + +value check_not_part_of_patt = + Grammar.Entry.of_parser gram "check_not_part_of_patt" + (fun strm -> + let tok = + match Stream.npeek 4 strm with + [ [("LIDENT", _); tok :: _] -> tok + | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok + | _ -> raise Stream.Failure ] + in + match tok with + [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure + | _ -> () ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + loop where rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"; "?!"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && (x = "$" || String.length x >= 2) && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("ANTIQUOT_LOC", _) -> () + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value e_phony = + Grammar.Entry.of_parser gram "e_phony" + (parser []) +; +value p_phony = + Grammar.Entry.of_parser gram "p_phony" + (parser []) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | _ -> 1 ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value mem_tvar s tpl = + List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if mem_tvar s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if mem_tvar v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value quotation_content s = do { + loop 0 where rec loop i = + if i = String.length s then ("", s) + else if s.[i] = ':' || s.[i] = '@' then + let i = i + 1 in + (String.sub s 0 i, String.sub s i (String.length s - i)) + else loop (i + 1) +}; + +value concat_comm loc e = + let loc = + Ploc.with_comment loc + (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) + in + let floc = + let first = ref True in + fun loc1 -> + if first.val then do {first.val := False; loc} + else loc1 + in + reloc_expr floc 0 e +; + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr + signature structure class_type class_expr class_sig_item class_str_item + let_binding type_decl constructor_declaration label_declaration + match_case with_constr poly_variant; + module_expr: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; + "->"; me = SELF -> + <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> + | "struct"; st = structure; "end" -> + <:module_expr< struct $_list:st$ end >> ] + | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] + | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; "val"; e = expr; ":"; mt = module_type; ")" -> + <:module_expr< (value $e$ : $mt$) >> + | "("; "val"; e = expr; ")" -> + <:module_expr< (value $e$) >> + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + structure: + [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration; + b = rebind_exn -> + <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> + <:str_item< module $_flag:r$ $_list:l$ >> + | "module"; "type"; i = V ident ""; "="; mt = module_type -> + <:str_item< module type $_:i$ = $mt$ >> + | "open"; i = V mod_ident "list" "" -> + <:str_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:str_item< type $_list:tdl$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr -> + let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> + match l with + [ <:vala< [(p, e)] >> -> + match p with + [ <:patt< _ >> -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> + <:str_item< let module $_uid:m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = V mod_ident "list" -> sl + | -> <:vala< [] >> ] ] + ; + mod_binding: + [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] + ; + mod_fun_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; + mt = SELF -> + <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> + <:module_type< $mt$ with $_list:wcl$ >> ] + | [ "sig"; sg = signature; "end" -> + <:module_type< sig $_list:sg$ end >> + | "module"; "type"; "of"; me = module_expr -> + <:module_type< module type of $me$ >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + signature: + [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = V UIDENT -> <:module_type< $_uid:m$ >> + | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration -> + <:sig_item< exception $_uid:c$ of $_list:tl$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; mt = module_type -> + <:sig_item< include $mt$ >> + | "module"; rf = V (FLAG "rec"); + l = V (LIST1 mod_decl_binding SEP "and") -> + <:sig_item< module $_flag:rf$ $_list:l$ >> + | "module"; "type"; i = V ident ""; "="; mt = module_type -> + <:sig_item< module type $_:i$ = $mt$ >> + | "module"; "type"; i = V ident "" -> + <:sig_item< module type $_:i$ = 'abstract >> + | "open"; i = V mod_ident "list" "" -> + <:sig_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:sig_item< type $_list:tdl$ >> + | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> + <:sig_item< value $_lid:i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $lid:i$ : $t$ >> ] ] + ; + mod_decl_binding: + [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; + pf = V (FLAG "private"); t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> + | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; + t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> + | "module"; i = V mod_ident ""; "="; me = module_expr -> + <:with_constr< module $_:i$ = $me$ >> + | "module"; i = V mod_ident ""; ":="; me = module_expr -> + <:with_constr< module $_:i$ := $me$ >> ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 + | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] + | "expr1" + [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr LEVEL "top" -> + <:expr< let $_flag:o$ $_list:l$ in $x$ >> + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $_uid:m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< fun [ $_list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> + <:expr< fun [$p$ $opt:eo$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; + l = V (LIST1 match_case SEP "|") -> + <:expr< match $e$ with [ $_list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< try $e$ with [ $_list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; + e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; + e2 = SELF; "do"; e = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e in + <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> + | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e2 in + <:expr< while $e1$ do { $_list:el$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< - $e$ >> + | "-."; e = SELF -> <:expr< -. $e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + let (e1, e2) = + if is_expr_constr_call e1 then + match e1 with + [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) + | _ -> (e1, e2) ] + else (e1, e2) + in + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> <:expr< assert $e$ >> + | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; op = operator_rparen -> + <:expr< $e1$ .( $lid:op$ ) >> + | e1 = SELF; "."; "("; e2 = SELF; ")" -> + <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> + <:expr< $e$ .{ $_list:el$ } >> + | e1 = SELF; "."; e2 = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop e1 e2 ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val >> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = V INT -> <:expr< $_int:s$ >> + | s = V INT_l -> <:expr< $_int32:s$ >> + | s = V INT_L -> <:expr< $_int64:s$ >> + | s = V INT_n -> <:expr< $_nativeint:s$ >> + | s = V FLOAT -> <:expr< $_flo:s$ >> + | s = V STRING -> <:expr< $_str:s$ >> + | c = V CHAR -> <:expr< $_chr:c$ >> + | UIDENT "True" -> <:expr< True_ >> + | UIDENT "False" -> <:expr< False_ >> + | i = expr_ident -> i + | "false" -> <:expr< False >> + | "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = V expr1_semi_list "list"; "|]" -> + <:expr< [| $_list:el$ |] >> + | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> + <:expr< { $_list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> + <:expr< { ($e$) with $_list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> + <:expr< (module $me$ : $mt$) >> + | "("; "module"; me = module_expr; ")" -> + <:expr< (module $me$) >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> + | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_expr_quotation loc con ] ] + ; + let_binding: + [ [ p = val_ident; e = fun_binding -> (p, e) + | p = patt; "="; e = expr -> (p, e) + | p = patt; ":"; t = poly_type; "="; e = expr -> + (<:patt< ($p$ : $t$) >>, e) ] ] + ; +(*** JRH added the "translate_operator" here ***) + val_ident: + [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> + | check_not_part_of_patt; "("; s = ANY; ")" -> + let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) + | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> + (eo, <:expr< $e$ >>) ] ] + ; + expr_ident: + [ RIGHTA + [ i = V LIDENT -> <:expr< $_lid:i$ >> + | i = V UIDENT -> <:expr< $_uid:i$ >> + | i = V UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $_uid:i$ >> j + | i = V UIDENT; "."; "("; j = operator_rparen -> + <:expr< $_uid:i$ . $lid:j$ >> + | i = V UIDENT; "."; "("; e = expr; ")" -> + <:expr< $_uid:i$ . ( $e$ ) >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + let (p1, p2) = + match p1 with + [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) + | _ -> (p1, p2) ] + in + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] + | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = V LIDENT -> <:patt< $_lid:s$ >> + | s = V UIDENT -> <:patt< $_uid:s$ >> + | s = V INT -> <:patt< $_int:s$ >> + | s = V INT_l -> <:patt< $_int32:s$ >> + | s = V INT_L -> <:patt< $_int64:s$ >> + | s = V INT_n -> <:patt< $_nativeint:s$ >> + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = INT_l -> <:patt< $int32:"-" ^ s$ >> + | "-"; s = INT_L -> <:patt< $int64:"-" ^ s$ >> + | "-"; s = INT_n -> <:patt< $nativeint:"-" ^ s$ >> + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = V FLOAT -> <:patt< $_flo:s$ >> + | s = V STRING -> <:patt< $_str:s$ >> + | s = V CHAR -> <:patt< $_chr:s$ >> + | UIDENT "True" -> <:patt< True_ >> + | UIDENT "False" -> <:patt< False_ >> + | "false" -> <:patt< False >> + | "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = V patt_semi_list "list"; "|]" -> + <:patt< [| $_list:pl$ |] >> + | "{"; lpl = V lbl_patt_list "list"; "}" -> + <:patt< { $_list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> + | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> + <:patt< (module $_uid:s$ : $mt$) >> + | "("; "module"; s = V UIDENT; ")" -> + <:patt< (module $_uid:s$) >> + | "_" -> <:patt< _ >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_patt_quotation loc con ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) + | "_" -> (<:patt< _ >>, <:patt< _ >>) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_decl: + [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); + tk = type_kind; cl = V (LIST0 constrain) -> + <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> + | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> + let tk = <:ctyp< '$choose_tvar tpl$ >> in + <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] + ; + type_patt: + [ [ n = V LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> + <:ctyp< $t$ >> + | t = ctyp; "="; pf = FLAG "private"; "{"; + ldl = V label_declarations "list"; "}" -> + <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> + | t = ctyp; "="; pf = FLAG "private"; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> + | "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< { $_list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "+"; p = V simple_type_parameter -> (p, Some True) + | "-"; p = V simple_type_parameter -> (p, Some False) + | p = V simple_type_parameter -> (p, None) ] ] + ; + simple_type_parameter: + [ [ "'"; i = ident -> Some i + | "_" -> None ] ] + ; + constructor_declaration: + [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + (loc, ci, cal, None) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); + "->"; t = ctyp -> + (loc, ci, cal, Some t) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + let t = + match cal with + [ <:vala< [t] >> -> t + | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> + | _ -> assert False ] + in + (loc, ci, <:vala< [] >>, Some t) + | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] + ; + cons_ident: + [ [ i = V UIDENT "uid" "" -> i + | UIDENT "True" -> <:vala< "True_" >> + | UIDENT "False" -> <:vala< "False_" >> ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "apply" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> + | "_" -> <:ctyp< _ >> + | i = V LIDENT -> <:ctyp< $_lid:i$ >> + | i = V UIDENT -> <:ctyp< $_uid:i$ >> + | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> + <:str_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:str_item< class type $_list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = V (LIST1 class_description SEP "and") -> + <:sig_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:sig_item< class type $_list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, <:vala< [] >>) + | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); + "in"; ce = SELF -> + <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< [ $ct$ ] $list:ci$ >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:class_expr< object $_opt:cspo$ $_list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> + <:class_str_item< inherit $ce$ $_opt:pb$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + lab = V LIDENT "lid" ""; e = cvalue_binding -> + <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> + if Pcaml.unvala ov then + Ploc.raise loc (Stream.Error "virtual value cannot override") + else + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; + ":"; t = ctyp -> + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_str_item< method virtual $_lid:l$ : $t$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + ":"; t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; + t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> + <:class_type< $id$ [ $list:tl$ ] >> + | "object"; cst = V (OPT class_self_type); + csf = V (LIST0 class_sig_item); "end" -> + <:class_type< object $_opt:cst$ $_list:csf$ end >> ] + | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> + | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] + | [ i = V LIDENT -> <:class_type< $_id: i$ >> + | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> + <:class_sig_item< inherit $cs$ >> + | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> + <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method private $_lid:l$ : $t$ >> + | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method $_lid:l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + ":"; ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + "="; cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = V field_expr_list "list"; ">}" -> + <:expr< {< $_list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = V class_longident "list" -> + <:ctyp< # $_list:id$ >> + | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> + <:ctyp< < $_list:ml$ $_flag:v$ > >> + | "<"; ".."; ">" -> + <:ctyp< < .. > >> + | "<"; ">" -> + <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; ml = SELF -> [f :: ml] + | f = field; ";" -> [f] + | f = field -> [f] ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> + <:ctyp< type $list:nt$ . $ct$ >> + | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: AFTER "arrow" + [ NONA + [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> + | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> + | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ = $_list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ > $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ < $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; + ntl = V (LIST1 name_tag); "]" -> + <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] + ; + poly_variant: + [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> + | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); + l = V (LIST1 ctyp SEP "&") -> + <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> + | t = ctyp -> <:poly_variant< $t$ >> ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> + <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> + | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> + | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> + | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> + | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> + | p = labeled_patt -> p ] ] + ; + labeled_patt: + [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> + <:patt< ~{$_:i$ = $p$} >> + | i = V TILDEIDENT -> + <:patt< ~{$_:i$} >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~{$lid:i$} >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~{$lid:i$ : $t$} >> + | i = V QUESTIONIDENTCOLON; j = LIDENT -> + <:patt< ?{$_:i$ = ?{$lid:j$}} >> + | i = V QUESTIONIDENTCOLON; "_" -> + <:patt< ?{$_:i$} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> + <:patt< ?{$_:i$ = ?{$p$}} >> + | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ = $e$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ : $t$ = $e$} >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ?{$lid:i$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ?{$lid:i$ : $t$} >> ] ] + ; + class_type: + [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ~$i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_fun_def: + [ [ p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; +END; + +IFDEF JOCAML THEN + DELETE_RULE expr: SELF; "or"; SELF END; + DELETE_RULE expr: SELF; "&"; SELF END; + EXTEND + GLOBAL: str_item expr; + str_item: + [ [ "def"; jal = V (LIST1 joinautomaton SEP "and") -> + <:str_item< def $_list:jal$ >> ] ] + ; + expr: LEVEL "top" + [ [ "def"; jal = V (LIST1 joinautomaton SEP "and"); "in"; + e = expr LEVEL "top"-> + <:expr< def $_list:jal$ in $e$ >> ] ] + ; + expr: LEVEL "apply" + [ [ "reply"; eo = V (OPT expr); "to"; ji = joinident -> + <:expr< reply $_opt:eo$ to $jid:ji$ >> ] ] + ; + expr: BEFORE ":=" + [ [ "spawn"; e = SELF -> <:expr< spawn $e$ >> ] ] + ; + expr: LEVEL "&&" + [ [ e1 = SELF; "&"; e2 = SELF -> <:expr< $e1$ & $e2$ >> ] ] + ; + joinautomaton: + [ [ jcl = V (LIST1 joinclause SEP "or") -> + {MLast.jcLoc = loc; MLast.jcVal = jcl} ] ] + ; + joinclause: + [ [ jpl = V (LIST1 joinpattern SEP "&"); "="; e = expr -> + (loc, jpl, e) ] ] + ; + joinpattern: + [ [ ji = joinident; "("; op = V (OPT patt); ")" -> (loc, ji, op) ] ] + ; + joinident: + [ [ i = V LIDENT -> (loc, i) ] ] + ; + END; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $lid:n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> + <:str_item< # $lid:n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH *** *) +(* ------------------------------------------------------------------------- *) + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pa_j_3.1x_6.xx.ml b/pa_j_3.1x_6.xx.ml new file mode 100644 index 0000000..80154eb --- /dev/null +++ b/pa_j_3.1x_6.xx.ml @@ -0,0 +1,2857 @@ +(* ------------------------------------------------------------------------- *) +(* New version. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: pa_o.ml,v 6.33 2010-11-16 16:48:21 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_extend.cmo"; +#load "q_MLast.cmo"; +#load "pa_reloc.cmo"; + +open Pcaml; + +Pcaml.syntax_name.val := "OCaml"; +Pcaml.no_constructors_arity.val := True; + +(* ------------------------------------------------------------------------- *) +(* The main/reloc.ml file. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: reloc.ml,v 6.15 2010-11-14 11:20:26 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_macro.cmo"; + +open MLast; + +value option_map f = + fun + [ Some x -> Some (f x) + | None -> None ] +; + +value vala_map f = + IFNDEF STRICT THEN + fun x -> f x + ELSE + fun + [ Ploc.VaAnt s -> Ploc.VaAnt s + | Ploc.VaVal x -> Ploc.VaVal (f x) ] + END +; + +value class_infos_map floc f x = + {ciLoc = floc x.ciLoc; ciVir = x.ciVir; + ciPrm = + let (x1, x2) = x.ciPrm in + (floc x1, x2); + ciNam = x.ciNam; ciExp = f x.ciExp} +; + +value anti_loc qloc sh loc loc1 = + (* + ...<:expr<.....$lid:...xxxxxxxx...$...>>... + |..|-----------------------------------| qloc + <-----> sh + |.........|------------| loc + |..|------| loc1 + *) + let sh1 = Ploc.first_pos qloc + sh in + let sh2 = sh1 + Ploc.first_pos loc in + let line_nb_qloc = Ploc.line_nb qloc in + let line_nb_loc = Ploc.line_nb loc in + let line_nb_loc1 = Ploc.line_nb loc1 in + if line_nb_qloc < 0 || line_nb_loc < 0 || line_nb_loc1 < 0 then + Ploc.make_unlined + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) + else + Ploc.make_loc (Ploc.file_name loc) + (line_nb_qloc + line_nb_loc + line_nb_loc1 - 2) + (if line_nb_loc1 = 1 then + if line_nb_loc = 1 then Ploc.bol_pos qloc + else sh1 + Ploc.bol_pos loc + else sh2 + Ploc.bol_pos loc1) + (sh2 + Ploc.first_pos loc1, sh2 + Ploc.last_pos loc1) "" +; + +value rec reloc_ctyp floc sh = + self where rec self = + fun + [ TyAcc loc x1 x2 -> + let loc = floc loc in + TyAcc loc (self x1) (self x2) + | TyAli loc x1 x2 -> + let loc = floc loc in + TyAli loc (self x1) (self x2) + | TyAny loc -> + let loc = floc loc in + TyAny loc + | TyApp loc x1 x2 -> + let loc = floc loc in + TyApp loc (self x1) (self x2) + | TyArr loc x1 x2 -> + let loc = floc loc in + TyArr loc (self x1) (self x2) + | TyCls loc x1 -> + let loc = floc loc in + TyCls loc x1 + | TyLab loc x1 x2 -> + let loc = floc loc in + TyLab loc x1 (self x2) + | TyLid loc x1 -> + let loc = floc loc in + TyLid loc x1 + | TyMan loc x1 x2 x3 -> + let loc = floc loc in + TyMan loc (self x1) x2 (self x3) + | TyObj loc x1 x2 -> + let loc = floc loc in + TyObj loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) x2 + | TyOlb loc x1 x2 -> + let loc = floc loc in + TyOlb loc x1 (self x2) + | TyPck loc x1 -> + let loc = floc loc in + TyPck loc (reloc_module_type floc sh x1) + | TyPol loc x1 x2 -> + let loc = floc loc in + TyPol loc x1 (self x2) + | TyPot loc x1 x2 -> + let loc = floc loc in + TyPot loc x1 (self x2) + | TyQuo loc x1 -> + let loc = floc loc in + TyQuo loc x1 + | TyRec loc x1 -> + let loc = floc loc in + TyRec loc + (vala_map + (List.map (fun (loc, x1, x2, x3) -> (floc loc, x1, x2, self x3))) + x1) + | TySum loc x1 -> + let loc = floc loc in + TySum loc + (vala_map + (List.map + (fun (loc, x1, x2, x3) -> + (floc loc, x1, vala_map (List.map self) x2, + option_map self x3))) + x1) + | TyTup loc x1 -> + let loc = floc loc in + TyTup loc (vala_map (List.map self) x1) + | TyUid loc x1 -> + let loc = floc loc in + TyUid loc x1 + | TyVrn loc x1 x2 -> + let loc = floc loc in + TyVrn loc (vala_map (List.map (reloc_poly_variant floc sh)) x1) x2 + | IFDEF STRICT THEN + TyXtr loc x1 x2 -> + let loc = floc loc in + TyXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_poly_variant floc sh = + fun + [ PvTag loc x1 x2 x3 -> + let loc = floc loc in + PvTag loc x1 x2 (vala_map (List.map (reloc_ctyp floc sh)) x3) + | PvInh loc x1 -> + let loc = floc loc in + PvInh loc (reloc_ctyp floc sh x1) ] +and reloc_patt floc sh = + self where rec self = + fun + [ PaAcc loc x1 x2 -> + let loc = floc loc in + PaAcc loc (self x1) (self x2) + | PaAli loc x1 x2 -> + let loc = floc loc in + PaAli loc (self x1) (self x2) + | PaAnt loc x1 -> + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_patt new_floc sh x1 + | PaAny loc -> + let loc = floc loc in + PaAny loc + | PaApp loc x1 x2 -> + let loc = floc loc in + PaApp loc (self x1) (self x2) + | PaArr loc x1 -> + let loc = floc loc in + PaArr loc (vala_map (List.map self) x1) + | PaChr loc x1 -> + let loc = floc loc in + PaChr loc x1 + | PaFlo loc x1 -> + let loc = floc loc in + PaFlo loc x1 + | PaInt loc x1 x2 -> + let loc = floc loc in + PaInt loc x1 x2 + | PaLab loc x1 x2 -> + let loc = floc loc in + PaLab loc (self x1) (vala_map (option_map self) x2) + | PaLaz loc x1 -> + let loc = floc loc in + PaLaz loc (self x1) + | PaLid loc x1 -> + let loc = floc loc in + PaLid loc x1 + | PaNty loc x1 -> + let loc = floc loc in + PaNty loc x1 + | PaOlb loc x1 x2 -> + let loc = floc loc in + PaOlb loc (self x1) (vala_map (option_map (reloc_expr floc sh)) x2) + | PaOrp loc x1 x2 -> + let loc = floc loc in + PaOrp loc (self x1) (self x2) + | PaRec loc x1 -> + let loc = floc loc in + PaRec loc + (vala_map (List.map (fun (x1, x2) -> (self x1, self x2))) x1) + | PaRng loc x1 x2 -> + let loc = floc loc in + PaRng loc (self x1) (self x2) + | PaStr loc x1 -> + let loc = floc loc in + PaStr loc x1 + | PaTup loc x1 -> + let loc = floc loc in + PaTup loc (vala_map (List.map self) x1) + | PaTyc loc x1 x2 -> + let loc = floc loc in + PaTyc loc (self x1) (reloc_ctyp floc sh x2) + | PaTyp loc x1 -> + let loc = floc loc in + PaTyp loc x1 + | PaUid loc x1 -> + let loc = floc loc in + PaUid loc x1 + | PaUnp loc x1 x2 -> + let loc = floc loc in + PaUnp loc x1 (option_map (reloc_module_type floc sh) x2) + | PaVrn loc x1 -> + let loc = floc loc in + PaVrn loc x1 + | IFDEF STRICT THEN + PaXtr loc x1 x2 -> + let loc = floc loc in + PaXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_expr floc sh = + self where rec self = + fun + [ ExAcc loc x1 x2 -> + let loc = floc loc in + ExAcc loc (self x1) (self x2) + | ExAnt loc x1 -> + let new_floc loc1 = anti_loc (floc loc) sh loc loc1 in + reloc_expr new_floc sh x1 + | ExApp loc x1 x2 -> + let loc = floc loc in + ExApp loc (self x1) (self x2) + | ExAre loc x1 x2 -> + let loc = floc loc in + ExAre loc (self x1) (self x2) + | ExArr loc x1 -> + let loc = floc loc in + ExArr loc (vala_map (List.map self) x1) + | ExAsr loc x1 -> + let loc = floc loc in + ExAsr loc (self x1) + | ExAss loc x1 x2 -> + let loc = floc loc in + ExAss loc (self x1) (self x2) + | ExBae loc x1 x2 -> + let loc = floc loc in + ExBae loc (self x1) (vala_map (List.map self) x2) + | ExChr loc x1 -> + let loc = floc loc in + ExChr loc x1 + | ExCoe loc x1 x2 x3 -> + let loc = floc loc in + ExCoe loc (self x1) (option_map (reloc_ctyp floc sh) x2) (reloc_ctyp floc sh x3) + | ExFlo loc x1 -> + let loc = floc loc in + ExFlo loc x1 + | ExFor loc x1 x2 x3 x4 x5 -> + let loc = floc loc in + ExFor loc x1 (self x2) (self x3) x4 (vala_map (List.map self) x5) + | ExFun loc x1 -> + let loc = floc loc in + ExFun loc + (vala_map + (List.map + (fun (x1, x2, x3) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x1) + | ExIfe loc x1 x2 x3 -> + let loc = floc loc in + ExIfe loc (self x1) (self x2) (self x3) + | ExInt loc x1 x2 -> + let loc = floc loc in + ExInt loc x1 x2 + | ExLab loc x1 x2 -> + let loc = floc loc in + ExLab loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) + | ExLaz loc x1 -> + let loc = floc loc in + ExLaz loc (self x1) + | ExLet loc x1 x2 x3 -> + let loc = floc loc in + ExLet loc x1 + (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) + x2) + (self x3) + | ExLid loc x1 -> + let loc = floc loc in + ExLid loc x1 + | ExLmd loc x1 x2 x3 -> + let loc = floc loc in + ExLmd loc x1 (reloc_module_expr floc sh x2) (self x3) + | ExMat loc x1 x2 -> + let loc = floc loc in + ExMat loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExNew loc x1 -> + let loc = floc loc in + ExNew loc x1 + | ExObj loc x1 x2 -> + let loc = floc loc in + ExObj loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | ExOlb loc x1 x2 -> + let loc = floc loc in + ExOlb loc (reloc_patt floc sh x1) (vala_map (option_map self) x2) + | ExOvr loc x1 -> + let loc = floc loc in + ExOvr loc (vala_map (List.map (fun (x1, x2) -> (x1, self x2))) x1) + | ExPck loc x1 x2 -> + let loc = floc loc in + ExPck loc (reloc_module_expr floc sh x1) + (option_map (reloc_module_type floc sh) x2) + | ExRec loc x1 x2 -> + let loc = floc loc in + ExRec loc + (vala_map (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, self x2))) + x1) + (option_map self x2) + | ExSeq loc x1 -> + let loc = floc loc in + ExSeq loc (vala_map (List.map self) x1) + | ExSnd loc x1 x2 -> + let loc = floc loc in + ExSnd loc (self x1) x2 + | ExSte loc x1 x2 -> + let loc = floc loc in + ExSte loc (self x1) (self x2) + | ExStr loc x1 -> + let loc = floc loc in + ExStr loc x1 + | ExTry loc x1 x2 -> + let loc = floc loc in + ExTry loc (self x1) + (vala_map + (List.map + (fun (x1, x2, x3) -> + (reloc_patt floc sh x1, vala_map (option_map self) x2, self x3))) + x2) + | ExTup loc x1 -> + let loc = floc loc in + ExTup loc (vala_map (List.map self) x1) + | ExTyc loc x1 x2 -> + let loc = floc loc in + ExTyc loc (self x1) (reloc_ctyp floc sh x2) + | ExUid loc x1 -> + let loc = floc loc in + ExUid loc x1 + | ExVrn loc x1 -> + let loc = floc loc in + ExVrn loc x1 + | ExWhi loc x1 x2 -> + let loc = floc loc in + ExWhi loc (self x1) (vala_map (List.map self) x2) + | IFDEF STRICT THEN + ExXtr loc x1 x2 -> + let loc = floc loc in + ExXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_module_type floc sh = + self where rec self = + fun + [ MtAcc loc x1 x2 -> + let loc = floc loc in + MtAcc loc (self x1) (self x2) + | MtApp loc x1 x2 -> + let loc = floc loc in + MtApp loc (self x1) (self x2) + | MtFun loc x1 x2 x3 -> + let loc = floc loc in + MtFun loc x1 (self x2) (self x3) + | MtLid loc x1 -> + let loc = floc loc in + MtLid loc x1 + | MtQuo loc x1 -> + let loc = floc loc in + MtQuo loc x1 + | MtSig loc x1 -> + let loc = floc loc in + MtSig loc (vala_map (List.map (reloc_sig_item floc sh)) x1) + | MtTyo loc x1 -> + let loc = floc loc in + MtTyo loc (reloc_module_expr floc sh x1) + | MtUid loc x1 -> + let loc = floc loc in + MtUid loc x1 + | MtWit loc x1 x2 -> + let loc = floc loc in + MtWit loc (self x1) (vala_map (List.map (reloc_with_constr floc sh)) x2) + | IFDEF STRICT THEN + MtXtr loc x1 x2 -> + let loc = floc loc in + MtXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_sig_item floc sh = + self where rec self = + fun + [ SgCls loc x1 -> + let loc = floc loc in + SgCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgClt loc x1 -> + let loc = floc loc in + SgClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | SgDcl loc x1 -> + let loc = floc loc in + SgDcl loc (vala_map (List.map self) x1) + | SgDir loc x1 x2 -> + let loc = floc loc in + SgDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | SgExc loc x1 x2 -> + let loc = floc loc in + SgExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | SgExt loc x1 x2 x3 -> + let loc = floc loc in + SgExt loc x1 (reloc_ctyp floc sh x2) x3 + | SgInc loc x1 -> + let loc = floc loc in + SgInc loc (reloc_module_type floc sh x1) + | SgMod loc x1 x2 -> + let loc = floc loc in + SgMod loc x1 + (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_type floc sh x2))) + x2) + | SgMty loc x1 x2 -> + let loc = floc loc in + SgMty loc x1 (reloc_module_type floc sh x2) + | SgOpn loc x1 -> + let loc = floc loc in + SgOpn loc x1 + | SgTyp loc x1 -> + let loc = floc loc in + SgTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | SgUse loc x1 x2 -> + let loc = floc loc in + SgUse loc x1 + (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) + | SgVal loc x1 x2 -> + let loc = floc loc in + SgVal loc x1 (reloc_ctyp floc sh x2) + | IFDEF STRICT THEN + SgXtr loc x1 x2 -> + let loc = floc loc in + SgXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_with_constr floc sh = + fun + [ WcMod loc x1 x2 -> + let loc = floc loc in + WcMod loc x1 (reloc_module_expr floc sh x2) + | WcMos loc x1 x2 -> + let loc = floc loc in + WcMos loc x1 (reloc_module_expr floc sh x2) + | WcTyp loc x1 x2 x3 x4 -> + let loc = floc loc in + WcTyp loc x1 x2 x3 (reloc_ctyp floc sh x4) + | WcTys loc x1 x2 x3 -> + let loc = floc loc in + WcTys loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_module_expr floc sh = + self where rec self = + fun + [ MeAcc loc x1 x2 -> + let loc = floc loc in + MeAcc loc (self x1) (self x2) + | MeApp loc x1 x2 -> + let loc = floc loc in + MeApp loc (self x1) (self x2) + | MeFun loc x1 x2 x3 -> + let loc = floc loc in + MeFun loc x1 (reloc_module_type floc sh x2) (self x3) + | MeStr loc x1 -> + let loc = floc loc in + MeStr loc (vala_map (List.map (reloc_str_item floc sh)) x1) + | MeTyc loc x1 x2 -> + let loc = floc loc in + MeTyc loc (self x1) (reloc_module_type floc sh x2) + | MeUid loc x1 -> + let loc = floc loc in + MeUid loc x1 + | MeUnp loc x1 x2 -> + let loc = floc loc in + MeUnp loc (reloc_expr floc sh x1) (option_map (reloc_module_type floc sh) x2) + | IFDEF STRICT THEN + MeXtr loc x1 x2 -> + let loc = floc loc in + MeXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_str_item floc sh = + self where rec self = + fun + [ StCls loc x1 -> + let loc = floc loc in + StCls loc + (vala_map (List.map (class_infos_map floc (reloc_class_expr floc sh))) x1) + | StClt loc x1 -> + let loc = floc loc in + StClt loc + (vala_map (List.map (class_infos_map floc (reloc_class_type floc sh))) x1) + | StDcl loc x1 -> + let loc = floc loc in + StDcl loc (vala_map (List.map self) x1) + | StDir loc x1 x2 -> + let loc = floc loc in + StDir loc x1 (vala_map (option_map (reloc_expr floc sh)) x2) + | StExc loc x1 x2 x3 -> + let loc = floc loc in + StExc loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) x3 + | StExp loc x1 -> + let loc = floc loc in + StExp loc (reloc_expr floc sh x1) + | StExt loc x1 x2 x3 -> + let loc = floc loc in + StExt loc x1 (reloc_ctyp floc sh x2) x3 + | StInc loc x1 -> + let loc = floc loc in + StInc loc (reloc_module_expr floc sh x1) + | StMod loc x1 x2 -> + let loc = floc loc in + StMod loc x1 + (vala_map (List.map (fun (x1, x2) -> (x1, reloc_module_expr floc sh x2))) + x2) + | StMty loc x1 x2 -> + let loc = floc loc in + StMty loc x1 (reloc_module_type floc sh x2) + | StOpn loc x1 -> + let loc = floc loc in + StOpn loc x1 + | StTyp loc x1 -> + let loc = floc loc in + StTyp loc (vala_map (List.map (reloc_type_decl floc sh)) x1) + | StUse loc x1 x2 -> + let loc = floc loc in + StUse loc x1 + (vala_map (List.map (fun (x1, loc) -> (self x1, floc loc))) x2) + | StVal loc x1 x2 -> + let loc = floc loc in + StVal loc x1 + (vala_map + (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + | IFDEF STRICT THEN + StXtr loc x1 x2 -> + let loc = floc loc in + StXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_type_decl floc sh x = + {tdNam = vala_map (fun (loc, x1) -> (floc loc, x1)) x.tdNam; + tdPrm = x.tdPrm; tdPrv = x.tdPrv; tdDef = reloc_ctyp floc sh x.tdDef; + tdCon = + vala_map (List.map (fun (x1, x2) -> (reloc_ctyp floc sh x1, reloc_ctyp floc sh x2))) + x.tdCon} +and reloc_class_type floc sh = + self where rec self = + fun + [ CtAcc loc x1 x2 -> + let loc = floc loc in + CtAcc loc (self x1) (self x2) + | CtApp loc x1 x2 -> + let loc = floc loc in + CtApp loc (self x1) (self x2) + | CtCon loc x1 x2 -> + let loc = floc loc in + CtCon loc (self x1) (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CtFun loc x1 x2 -> + let loc = floc loc in + CtFun loc (reloc_ctyp floc sh x1) (self x2) + | CtIde loc x1 -> + let loc = floc loc in + CtIde loc x1 + | CtSig loc x1 x2 -> + let loc = floc loc in + CtSig loc (vala_map (option_map (reloc_ctyp floc sh)) x1) + (vala_map (List.map (reloc_class_sig_item floc sh)) x2) + | IFDEF STRICT THEN + CtXtr loc x1 x2 -> + let loc = floc loc in + CtXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_class_sig_item floc sh = + self where rec self = + fun + [ CgCtr loc x1 x2 -> + let loc = floc loc in + CgCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CgDcl loc x1 -> + let loc = floc loc in + CgDcl loc (vala_map (List.map self) x1) + | CgInh loc x1 -> + let loc = floc loc in + CgInh loc (reloc_class_type floc sh x1) + | CgMth loc x1 x2 x3 -> + let loc = floc loc in + CgMth loc x1 x2 (reloc_ctyp floc sh x3) + | CgVal loc x1 x2 x3 -> + let loc = floc loc in + CgVal loc x1 x2 (reloc_ctyp floc sh x3) + | CgVir loc x1 x2 x3 -> + let loc = floc loc in + CgVir loc x1 x2 (reloc_ctyp floc sh x3) ] +and reloc_class_expr floc sh = + self where rec self = + fun + [ CeApp loc x1 x2 -> + let loc = floc loc in + CeApp loc (self x1) (reloc_expr floc sh x2) + | CeCon loc x1 x2 -> + let loc = floc loc in + CeCon loc x1 (vala_map (List.map (reloc_ctyp floc sh)) x2) + | CeFun loc x1 x2 -> + let loc = floc loc in + CeFun loc (reloc_patt floc sh x1) (self x2) + | CeLet loc x1 x2 x3 -> + let loc = floc loc in + CeLet loc x1 + (vala_map + (List.map (fun (x1, x2) -> (reloc_patt floc sh x1, reloc_expr floc sh x2))) + x2) + (self x3) + | CeStr loc x1 x2 -> + let loc = floc loc in + CeStr loc (vala_map (option_map (reloc_patt floc sh)) x1) + (vala_map (List.map (reloc_class_str_item floc sh)) x2) + | CeTyc loc x1 x2 -> + let loc = floc loc in + CeTyc loc (self x1) (reloc_class_type floc sh x2) + | IFDEF STRICT THEN + CeXtr loc x1 x2 -> + let loc = floc loc in + CeXtr loc x1 (option_map (vala_map self) x2) + END ] +and reloc_class_str_item floc sh = + self where rec self = + fun + [ CrCtr loc x1 x2 -> + let loc = floc loc in + CrCtr loc (reloc_ctyp floc sh x1) (reloc_ctyp floc sh x2) + | CrDcl loc x1 -> + let loc = floc loc in + CrDcl loc (vala_map (List.map self) x1) + | CrInh loc x1 x2 -> + let loc = floc loc in + CrInh loc (reloc_class_expr floc sh x1) x2 + | CrIni loc x1 -> + let loc = floc loc in + CrIni loc (reloc_expr floc sh x1) + | CrMth loc x1 x2 x3 x4 x5 -> + let loc = floc loc in + CrMth loc x1 x2 x3 (vala_map (option_map (reloc_ctyp floc sh)) x4) + (reloc_expr floc sh x5) + | CrVal loc x1 x2 x3 x4 -> + let loc = floc loc in + CrVal loc x1 x2 x3 (reloc_expr floc sh x4) + | CrVav loc x1 x2 x3 -> + let loc = floc loc in + CrVav loc x1 x2 (reloc_ctyp floc sh x3) + | CrVir loc x1 x2 x3 -> + let loc = floc loc in + CrVir loc x1 x2 (reloc_ctyp floc sh x3) ] +; + +(* Equality over syntax trees *) + +value eq_expr x y = + reloc_expr (fun _ -> Ploc.dummy) 0 x = + reloc_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_patt x y = + reloc_patt (fun _ -> Ploc.dummy) 0 x = + reloc_patt (fun _ -> Ploc.dummy) 0 y +; +value eq_ctyp x y = + reloc_ctyp (fun _ -> Ploc.dummy) 0 x = + reloc_ctyp (fun _ -> Ploc.dummy) 0 y +; +value eq_str_item x y = + reloc_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_sig_item x y = + reloc_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_module_expr x y = + reloc_module_expr (fun _ -> Ploc.dummy) 0 x = + reloc_module_expr (fun _ -> Ploc.dummy) 0 y +; +value eq_module_type x y = + reloc_module_type (fun _ -> Ploc.dummy) 0 x = + reloc_module_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_sig_item x y = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_sig_item (fun _ -> Ploc.dummy) 0 y +; +value eq_class_str_item x y = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 x = + reloc_class_str_item (fun _ -> Ploc.dummy) 0 y +; +value eq_class_type x y = + reloc_class_type (fun _ -> Ploc.dummy) 0 x = + reloc_class_type (fun _ -> Ploc.dummy) 0 y +; +value eq_class_expr x y = + reloc_class_expr (fun _ -> Ploc.dummy) 0 x = + reloc_class_expr (fun _ -> Ploc.dummy) 0 y +; + +(* ------------------------------------------------------------------------- *) +(* Now the lexer. *) +(* ------------------------------------------------------------------------- *) + +(* camlp5r *) +(* $Id: plexer.ml,v 6.11 2010-10-04 20:14:58 deraugla Exp $ *) +(* Copyright (c) INRIA 2007-2010 *) + +#load "pa_lexer.cmo"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH as a backdoor to change lexical conventions. *) +(* ------------------------------------------------------------------------- *) + +value jrh_lexer = ref False; + +open Versdep; + +value no_quotations = ref False; +value error_on_unknown_keywords = ref False; + +value dollar_for_antiquotation = ref True; +value specific_space_dot = ref False; + +value force_antiquot_loc = ref False; + +type context = + { after_space : mutable bool; + dollar_for_antiquotation : bool; + specific_space_dot : bool; + find_kwd : string -> string; + line_cnt : int -> char -> unit; + set_line_nb : unit -> unit; + make_lined_loc : (int * int) -> string -> Ploc.t } +; + +value err ctx loc msg = + Ploc.raise (ctx.make_lined_loc loc "") (Plexing.Error msg) +; + +(* ------------------------------------------------------------------------- *) +(* JRH's hack to make the case distinction "unmixed" versus "mixed" *) +(* ------------------------------------------------------------------------- *) + +value is_uppercase s = String.uppercase s = s; +value is_only_lowercase s = String.lowercase s = s && not(is_uppercase s); + +value jrh_identifier find_kwd id = + let jflag = jrh_lexer.val in + if id = "set_jrh_lexer" then + (let _ = jrh_lexer.val := True in ("",find_kwd "true")) + else if id = "unset_jrh_lexer" then + (let _ = jrh_lexer.val := False in ("",find_kwd "false")) + else + try ("", find_kwd id) with + [ Not_found -> + if not(jflag) then + if is_uppercase (String.sub id 0 1) then ("UIDENT", id) + else ("LIDENT", id) + else if is_uppercase (String.sub id 0 1) && + is_only_lowercase (String.sub id 1 (String.length id - 1)) +(***** JRH: Carl's alternative version + then ("UIDENT", id) + else if is_uppercase (String.sub id 0 1) then ("LIDENT", "__uc_"^id) + else ("LIDENT", id)]; + *****) + then ("UIDENT", id) else ("LIDENT", id)]; + +(* ------------------------------------------------------------------------- *) +(* Back to original file with the mod of using the above. *) +(* ------------------------------------------------------------------------- *) + +value keyword_or_error ctx loc s = + try ("", ctx.find_kwd s) with + [ Not_found -> + if error_on_unknown_keywords.val then + err ctx loc ("illegal token: " ^ s) + else ("", s) ] +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +value utf8_lexing = ref False; + +value misc_letter buf strm = + if utf8_lexing.val then + match strm with lexer [ '\128'-'\225' | '\227'-'\255' ] + else + match strm with lexer [ '\128'-'\255' ] +; + +value misc_punct buf strm = + if utf8_lexing.val then + match strm with lexer [ '\226' _ _ ] + else + match strm with parser [] +; + +value rec ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] ident! | ] +; + +value rec ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | + '%' | '.' | ':' | '<' | '>' | '|' | '$' | misc_punct ] + ident2! + | ] +; + +value rec ident3 = + lexer + [ [ '0'-'9' | 'A'-'Z' | 'a'-'z' | '_' | '!' | '%' | '&' | '*' | '+' | '-' | + '.' | '/' | ':' | '<' | '=' | '>' | '?' | '@' | '^' | '|' | '~' | ''' | + '$' | '\128'-'\255' ] ident3! + | ] +; + +value binary = lexer [ '0' | '1' ]; +value octal = lexer [ '0'-'7' ]; +value decimal = lexer [ '0'-'9' ]; +value hexa = lexer [ '0'-'9' | 'a'-'f' | 'A'-'F' ]; + +value end_integer = + lexer + [ "l"/ -> ("INT_l", $buf) + | "L"/ -> ("INT_L", $buf) + | "n"/ -> ("INT_n", $buf) + | -> ("INT", $buf) ] +; + +value rec digits_under kind = + lexer + [ kind (digits_under kind)! + | "_" (digits_under kind)! + | end_integer ] +; + +value digits kind = + lexer + [ kind (digits_under kind)! + | -> raise (Stream.Error "ill-formed integer constant") ] +; + +value rec decimal_digits_under = + lexer [ [ '0'-'9' | '_' ] decimal_digits_under! | ] +; + +value exponent_part = + lexer + [ [ 'e' | 'E' ] [ '+' | '-' | ] + '0'-'9' ? "ill-formed floating-point constant" + decimal_digits_under! ] +; + +value number = + lexer + [ decimal_digits_under "." decimal_digits_under! exponent_part -> + ("FLOAT", $buf) + | decimal_digits_under "." decimal_digits_under! -> ("FLOAT", $buf) + | decimal_digits_under exponent_part -> ("FLOAT", $buf) + | decimal_digits_under end_integer! ] +; + +value char_after_bslash = + lexer + [ "'"/ + | _ [ "'"/ | _ [ "'"/ | ] ] ] +; + +value char ctx bp = + lexer + [ "\\" _ char_after_bslash! + | "\\" -> err ctx (bp, $pos) "char not terminated" + | ?= [ _ '''] _! "'"/ ] +; + +value any ctx buf = + parser bp [: `c :] -> do { ctx.line_cnt bp c; $add c } +; + +value rec string ctx bp = + lexer + [ "\""/ + | "\\" (any ctx) (string ctx bp)! + | (any ctx) (string ctx bp)! + | -> err ctx (bp, $pos) "string not terminated" ] +; + +value rec qstring ctx bp = + lexer + [ "`"/ + | (any ctx) (qstring ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value comment ctx bp = + comment where rec comment = + lexer + [ "*)" + | "*" comment! + | "(*" comment! comment! + | "(" comment! + | "\"" (string ctx bp)! [ -> $add "\"" ] comment! + | "'*)" + | "'*" comment! + | "'" (any ctx) comment! + | (any ctx) comment! + | -> err ctx (bp, $pos) "comment not terminated" ] +; + +value rec quotation ctx bp = + lexer + [ ">>"/ + | ">" (quotation ctx bp)! + | "<<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! "<" (quotation ctx bp)! [ -> $add ">>" ]! (quotation ctx bp)! + | "<:" ident! (quotation ctx bp)! + | "<" (quotation ctx bp)! + | "\\"/ [ '>' | '<' | '\\' ] (quotation ctx bp)! + | "\\" (quotation ctx bp)! + | (any ctx) (quotation ctx bp)! + | -> err ctx (bp, $pos) "quotation not terminated" ] +; + +value less_expected = "character '<' expected"; + +value less ctx bp buf strm = + if no_quotations.val then + match strm with lexer + [ [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] + else + match strm with lexer + [ "<"/ (quotation ctx bp) -> ("QUOTATION", ":" ^ $buf) + | ":"/ ident! "<"/ ? less_expected [ -> $add ":" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | ":"/ ident! ":<"/ ? less_expected [ -> $add "@" ]! (quotation ctx bp) -> + ("QUOTATION", $buf) + | [ -> $add "<" ] ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value rec antiquot_rest ctx bp = + lexer + [ "$"/ + | "\\"/ (any ctx) (antiquot_rest ctx bp)! + | (any ctx) (antiquot_rest ctx bp)! + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value rec antiquot ctx bp = + lexer + [ "$"/ -> ":" ^ $buf + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot ctx bp)! + | ":" (antiquot_rest ctx bp)! -> $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | (any ctx) (antiquot_rest ctx bp)! -> ":" ^ $buf + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value antiloc bp ep s = Printf.sprintf "%d,%d:%s" bp ep s; + +value rec antiquot_loc ctx bp = + lexer + [ "$"/ -> antiloc bp $pos (":" ^ $buf) + | [ 'a'-'z' | 'A'-'Z' | '0'-'9' | '!' | '_' ] (antiquot_loc ctx bp)! + | ":" (antiquot_rest ctx bp)! -> antiloc bp $pos $buf + | "\\"/ (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | (any ctx) (antiquot_rest ctx bp)! -> antiloc bp $pos (":" ^ $buf) + | -> err ctx (bp, $pos) "antiquotation not terminated" ] +; + +value dollar ctx bp buf strm = + if not no_quotations.val && ctx.dollar_for_antiquotation then + ("ANTIQUOT", antiquot ctx bp buf strm) + else if force_antiquot_loc.val then + ("ANTIQUOT_LOC", antiquot_loc ctx bp buf strm) + else + match strm with lexer + [ [ -> $add "$" ] ident2! -> ("", $buf) ] +; + +(* ANTIQUOT - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?abc:d ?abc + ?$abc:d$: ?abc:d: ?abc: + ?$d$ ?:d ? + ?$d$: ?:d: ?: +*) + +(* ANTIQUOT_LOC - specific case for QUESTIONIDENT and QUESTIONIDENTCOLON + input expr patt + ----- ---- ---- + ?$abc:d$ ?8,13:abc:d ?abc + ?$abc:d$: ?8,13:abc:d: ?abc: + ?$d$ ?8,9::d ? + ?$d$: ?8,9::d: ?: +*) + +value question ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "?" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "?" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "?" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tilde ctx bp buf strm = + if ctx.dollar_for_antiquotation then + match strm with parser + [ [: `'$'; s = antiquot ctx bp $empty; `':' :] -> + ("ANTIQUOT", "~" ^ s ^ ":") + | [: `'$'; s = antiquot ctx bp $empty :] -> + ("ANTIQUOT", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else if force_antiquot_loc.val then + match strm with parser + [ [: `'$'; s = antiquot_loc ctx bp $empty; `':' :] -> + ("ANTIQUOT_LOC", "~" ^ s ^ ":") + | [: `'$'; s = antiquot_loc ctx bp $empty :] -> + ("ANTIQUOT_LOC", "~" ^ s) + | [: :] -> + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] ] + else + match strm with lexer + [ ident2! -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value tildeident = + lexer + [ ":"/ -> ("TILDEIDENTCOLON", $buf) + | -> ("TILDEIDENT", $buf) ] +; + +value questionident = + lexer + [ ":"/ -> ("QUESTIONIDENTCOLON", $buf) + | -> ("QUESTIONIDENT", $buf) ] +; + +value rec linedir n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir (n + 1) s + | Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> False ] +and linedir_digits n s = + match stream_peek_nth n s with + [ Some ('0'..'9') -> linedir_digits (n + 1) s + | _ -> linedir_quote n s ] +and linedir_quote n s = + match stream_peek_nth n s with + [ Some (' ' | '\t') -> linedir_quote (n + 1) s + | Some '"' -> True + | _ -> False ] +; + +value rec any_to_nl = + lexer + [ "\r" | "\n" + | _ any_to_nl! + | ] +; + +value next_token_after_spaces ctx bp = + lexer + [ 'A'-'Z' ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("UIDENT", id) ] + *********) + | [ 'a'-'z' | '_' | misc_letter ] ident! -> + let id = $buf in + jrh_identifier ctx.find_kwd id +(********** JRH: original was + try ("", ctx.find_kwd id) with [ Not_found -> ("LIDENT", id) ] + *********) + | '1'-'9' number! + | "0" [ 'o' | 'O' ] (digits octal)! + | "0" [ 'x' | 'X' ] (digits hexa)! + | "0" [ 'b' | 'B' ] (digits binary)! + | "0" number! + | "'"/ ?= [ '\\' 'a'-'z' 'a'-'z' ] -> keyword_or_error ctx (bp, $pos) "'" + | "'"/ (char ctx bp) -> ("CHAR", $buf) + | "'" -> keyword_or_error ctx (bp, $pos) "'" + | "\""/ (string ctx bp)! -> ("STRING", $buf) +(*** Line added by JRH ***) + | "`"/ (qstring ctx bp)! -> ("QUOTATION", "tot:" ^ $buf) + | "$"/ (dollar ctx bp)! + | [ '!' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' ] ident2! -> + keyword_or_error ctx (bp, $pos) $buf + | "~"/ 'a'-'z' ident! tildeident! + | "~"/ '_' ident! tildeident! + | "~" (tilde ctx bp) + | "?"/ 'a'-'z' ident! questionident! + | "?" (question ctx bp)! + | "<"/ (less ctx bp)! + | ":]" -> keyword_or_error ctx (bp, $pos) $buf + | "::" -> keyword_or_error ctx (bp, $pos) $buf + | ":=" -> keyword_or_error ctx (bp, $pos) $buf + | ":>" -> keyword_or_error ctx (bp, $pos) $buf + | ":" -> keyword_or_error ctx (bp, $pos) $buf + | ">]" -> keyword_or_error ctx (bp, $pos) $buf + | ">}" -> keyword_or_error ctx (bp, $pos) $buf + | ">" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "|]" -> keyword_or_error ctx (bp, $pos) $buf + | "|}" -> keyword_or_error ctx (bp, $pos) $buf + | "|" ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "[" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "[|" -> keyword_or_error ctx (bp, $pos) $buf + | "[<" -> keyword_or_error ctx (bp, $pos) $buf + | "[:" -> keyword_or_error ctx (bp, $pos) $buf + | "[" -> keyword_or_error ctx (bp, $pos) $buf + | "{" ?= [ "<<" | "<:" ] -> keyword_or_error ctx (bp, $pos) $buf + | "{|" -> keyword_or_error ctx (bp, $pos) $buf + | "{<" -> keyword_or_error ctx (bp, $pos) $buf + | "{:" -> keyword_or_error ctx (bp, $pos) $buf + | "{" -> keyword_or_error ctx (bp, $pos) $buf + | ".." -> keyword_or_error ctx (bp, $pos) ".." + | "." -> + let id = + if ctx.specific_space_dot && ctx.after_space then " ." else "." + in + keyword_or_error ctx (bp, $pos) id + | ";;" -> keyword_or_error ctx (bp, $pos) ";;" + | ";" -> keyword_or_error ctx (bp, $pos) ";" + | misc_punct ident2! -> keyword_or_error ctx (bp, $pos) $buf + | "\\"/ ident3! -> ("LIDENT", $buf) + | (any ctx) -> keyword_or_error ctx (bp, $pos) $buf ] +; + +value get_comment buf strm = $buf; + +value rec next_token ctx buf = + parser bp + [ [: `('\n' | '\r' as c); s :] ep -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := ep; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `(' ' | '\t' | '\026' | '\012' as c); s :] -> do { + ctx.after_space := True; + next_token ctx ($add c) s + } + | [: `'#' when bp = Plexing.bol_pos.val.val; s :] -> + let comm = get_comment buf () in + if linedir 1 s then do { + let buf = any_to_nl ($add '#') s in + incr Plexing.line_nb.val; + Plexing.bol_pos.val.val := Stream.count s; + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + else + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (keyword_or_error ctx (bp, bp + 1) "#", loc) + | [: `'('; + a = + parser + [ [: `'*'; buf = comment ctx bp ($add "(*") !; s :] -> do { + ctx.set_line_nb (); + ctx.after_space := True; + next_token ctx buf s + } + | [: :] ep -> + let loc = ctx.make_lined_loc (bp, ep) $buf in + (keyword_or_error ctx (bp, ep) "(", loc) ] ! :] -> a + | [: comm = get_comment buf; + tok = next_token_after_spaces ctx bp $empty :] ep -> + let loc = ctx.make_lined_loc (bp, max (bp + 1) ep) comm in + (tok, loc) + | [: comm = get_comment buf; _ = Stream.empty :] -> + let loc = ctx.make_lined_loc (bp, bp + 1) comm in + (("EOI", ""), loc) ] +; + +value next_token_fun ctx glexr (cstrm, s_line_nb, s_bol_pos) = + try do { + match Plexing.restore_lexing_info.val with + [ Some (line_nb, bol_pos) -> do { + s_line_nb.val := line_nb; + s_bol_pos.val := bol_pos; + Plexing.restore_lexing_info.val := None; + } + | None -> () ]; + Plexing.line_nb.val := s_line_nb; + Plexing.bol_pos.val := s_bol_pos; + let comm_bp = Stream.count cstrm in + ctx.set_line_nb (); + ctx.after_space := False; + let (r, loc) = next_token ctx $empty cstrm in + match glexr.val.Plexing.tok_comm with + [ Some list -> + if Ploc.first_pos loc > comm_bp then + let comm_loc = Ploc.make_unlined (comm_bp, Ploc.last_pos loc) in + glexr.val.Plexing.tok_comm := Some [comm_loc :: list] + else () + | None -> () ]; + (r, loc) + } + with + [ Stream.Error str -> + err ctx (Stream.count cstrm, Stream.count cstrm + 1) str ] +; + +value func kwd_table glexr = + let ctx = + let line_nb = ref 0 in + let bol_pos = ref 0 in + {after_space = False; + dollar_for_antiquotation = dollar_for_antiquotation.val; + specific_space_dot = specific_space_dot.val; + find_kwd = Hashtbl.find kwd_table; + line_cnt bp1 c = + match c with + [ '\n' | '\r' -> do { + if c = '\n' then incr Plexing.line_nb.val else (); + Plexing.bol_pos.val.val := bp1 + 1; + } + | c -> () ]; + set_line_nb () = do { + line_nb.val := Plexing.line_nb.val.val; + bol_pos.val := Plexing.bol_pos.val.val; + }; + make_lined_loc loc comm = + Ploc.make_loc Plexing.input_file.val line_nb.val bol_pos.val loc comm} + in + Plexing.lexer_func_of_parser (next_token_fun ctx glexr) +; + +value rec check_keyword_stream = + parser [: _ = check $empty; _ = Stream.empty :] -> True +and check = + lexer + [ [ 'A'-'Z' | 'a'-'z' | misc_letter ] check_ident! + | [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' ] + check_ident2! + | "$" check_ident2! + | "<" ?= [ ":" | "<" ] + | "<" check_ident2! + | ":]" + | "::" + | ":=" + | ":>" + | ":" + | ">]" + | ">}" + | ">" check_ident2! + | "|]" + | "|}" + | "|" check_ident2! + | "[" ?= [ "<<" | "<:" ] + | "[|" + | "[<" + | "[:" + | "[" + | "{" ?= [ "<<" | "<:" ] + | "{|" + | "{<" + | "{:" + | "{" + | ";;" + | ";" + | misc_punct check_ident2! + | _ ] +and check_ident = + lexer + [ [ 'A'-'Z' | 'a'-'z' | '0'-'9' | '_' | ''' | misc_letter ] + check_ident! | ] +and check_ident2 = + lexer + [ [ '!' | '?' | '~' | '=' | '@' | '^' | '&' | '+' | '-' | '*' | '/' | '%' | + '.' | ':' | '<' | '>' | '|' | misc_punct ] + check_ident2! | ] +; + +value check_keyword s = + try check_keyword_stream (Stream.of_string s) with _ -> False +; + +value error_no_respect_rules p_con p_prm = + raise + (Plexing.Error + ("the token " ^ + (if p_con = "" then "\"" ^ p_prm ^ "\"" + else if p_prm = "" then p_con + else p_con ^ " \"" ^ p_prm ^ "\"") ^ + " does not respect Plexer rules")) +; + +value error_ident_and_keyword p_con p_prm = + raise + (Plexing.Error + ("the token \"" ^ p_prm ^ "\" is used as " ^ p_con ^ + " and as keyword")) +; + +value using_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> + if not (hashtbl_mem kwd_table p_prm) then + if check_keyword p_prm then + if hashtbl_mem ident_table p_prm then + error_ident_and_keyword (Hashtbl.find ident_table p_prm) p_prm + else Hashtbl.add kwd_table p_prm p_prm + else error_no_respect_rules p_con p_prm + else () + | "LIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'A'..'Z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "UIDENT" -> + if p_prm = "" then () + else + match p_prm.[0] with + [ 'a'..'z' -> error_no_respect_rules p_con p_prm + | _ -> + if hashtbl_mem kwd_table p_prm then + error_ident_and_keyword p_con p_prm + else Hashtbl.add ident_table p_prm p_con ] + | "TILDEIDENT" | "TILDEIDENTCOLON" | "QUESTIONIDENT" | + "QUESTIONIDENTCOLON" | "INT" | "INT_l" | "INT_L" | "INT_n" | "FLOAT" | + "CHAR" | "STRING" | "QUOTATION" | + "ANTIQUOT" | "ANTIQUOT_LOC" | "EOI" -> + () + | _ -> + raise + (Plexing.Error + ("the constructor \"" ^ p_con ^ + "\" is not recognized by Plexer")) ] +; + +value removing_token kwd_table ident_table (p_con, p_prm) = + match p_con with + [ "" -> Hashtbl.remove kwd_table p_prm + | "LIDENT" | "UIDENT" -> + if p_prm <> "" then Hashtbl.remove ident_table p_prm else () + | _ -> () ] +; + +value text = + fun + [ ("", t) -> "'" ^ t ^ "'" + | ("LIDENT", "") -> "lowercase identifier" + | ("LIDENT", t) -> "'" ^ t ^ "'" + | ("UIDENT", "") -> "uppercase identifier" + | ("UIDENT", t) -> "'" ^ t ^ "'" + | ("INT", "") -> "integer" + | ("INT", s) -> "'" ^ s ^ "'" + | ("FLOAT", "") -> "float" + | ("STRING", "") -> "string" + | ("CHAR", "") -> "char" + | ("QUOTATION", "") -> "quotation" + | ("ANTIQUOT", k) -> "antiquot \"" ^ k ^ "\"" + | ("EOI", "") -> "end of input" + | (con, "") -> con + | (con, prm) -> con ^ " \"" ^ prm ^ "\"" ] +; + +value eq_before_colon p e = + loop 0 where rec loop i = + if i == String.length e then + failwith "Internal error in Plexer: incorrect ANTIQUOT" + else if i == String.length p then e.[i] == ':' + else if p.[i] == e.[i] then loop (i + 1) + else False +; + +value after_colon e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 1) + with + [ Not_found -> "" ] +; + +value after_colon_except_last e = + try + let i = String.index e ':' in + String.sub e (i + 1) (String.length e - i - 2) + with + [ Not_found -> "" ] +; + +value tok_match = + fun + [ ("ANTIQUOT", p_prm) -> + if p_prm <> "" && (p_prm.[0] = '~' || p_prm.[0] = '?') then + if p_prm.[String.length p_prm - 1] = ':' then + let p_prm = String.sub p_prm 0 (String.length p_prm - 1) in + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + if eq_before_colon p_prm prm then after_colon_except_last prm + else raise Stream.Failure + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) -> + if prm <> "" && prm.[String.length prm - 1] = ':' then + raise Stream.Failure + else if eq_before_colon p_prm prm then after_colon prm + else raise Stream.Failure + | _ -> raise Stream.Failure ] + else + fun + [ ("ANTIQUOT", prm) when eq_before_colon p_prm prm -> after_colon prm + | _ -> raise Stream.Failure ] + | tok -> Plexing.default_match tok ] +; + +value gmake () = + let kwd_table = Hashtbl.create 301 in + let id_table = Hashtbl.create 301 in + let glexr = + ref + {Plexing.tok_func = fun []; tok_using = fun []; tok_removing = fun []; + tok_match = fun []; tok_text = fun []; tok_comm = None} + in + let glex = + {Plexing.tok_func = func kwd_table glexr; + tok_using = using_token kwd_table id_table; + tok_removing = removing_token kwd_table id_table; tok_match = tok_match; + tok_text = text; tok_comm = None} + in + do { glexr.val := glex; glex } +; + +(* ------------------------------------------------------------------------- *) +(* Back to etc/pa_o.ml *) +(* ------------------------------------------------------------------------- *) + +do { + let odfa = dollar_for_antiquotation.val in + dollar_for_antiquotation.val := False; + Grammar.Unsafe.gram_reinit gram (gmake ()); + dollar_for_antiquotation.val := odfa; + Grammar.Unsafe.clear_entry interf; + Grammar.Unsafe.clear_entry implem; + Grammar.Unsafe.clear_entry top_phrase; + Grammar.Unsafe.clear_entry use_file; + Grammar.Unsafe.clear_entry module_type; + Grammar.Unsafe.clear_entry module_expr; + Grammar.Unsafe.clear_entry sig_item; + Grammar.Unsafe.clear_entry str_item; + Grammar.Unsafe.clear_entry signature; + Grammar.Unsafe.clear_entry structure; + Grammar.Unsafe.clear_entry expr; + Grammar.Unsafe.clear_entry patt; + Grammar.Unsafe.clear_entry ctyp; + Grammar.Unsafe.clear_entry let_binding; + Grammar.Unsafe.clear_entry type_decl; + Grammar.Unsafe.clear_entry constructor_declaration; + Grammar.Unsafe.clear_entry label_declaration; + Grammar.Unsafe.clear_entry match_case; + Grammar.Unsafe.clear_entry with_constr; + Grammar.Unsafe.clear_entry poly_variant; + Grammar.Unsafe.clear_entry class_type; + Grammar.Unsafe.clear_entry class_expr; + Grammar.Unsafe.clear_entry class_sig_item; + Grammar.Unsafe.clear_entry class_str_item +}; + +Pcaml.parse_interf.val := Grammar.Entry.parse interf; +Pcaml.parse_implem.val := Grammar.Entry.parse implem; + +value mklistexp loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some e -> e + | None -> <:expr< [] >> ] + | [e1 :: el] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_expr e1) loc + in + <:expr< [$e1$ :: $loop False el$] >> ] +; + +value mklistpat loc last = + loop True where rec loop top = + fun + [ [] -> + match last with + [ Some p -> p + | None -> <:patt< [] >> ] + | [p1 :: pl] -> + let loc = + if top then loc else Ploc.encl (MLast.loc_of_patt p1) loc + in + <:patt< [$p1$ :: $loop False pl$] >> ] +; + +(*** JRH pulled this outside so user can add new infixes here too ***) + +value ht = Hashtbl.create 73; + +(*** And JRH added all the new HOL Light infixes here already ***) + +value is_operator = do { + let ct = Hashtbl.create 73 in + List.iter (fun x -> Hashtbl.add ht x True) + ["asr"; "land"; "lor"; "lsl"; "lsr"; "lxor"; "mod"; "or"; "o"; "upto"; + "F_F"; "THENC"; "THEN"; "THENL"; "ORELSE"; "ORELSEC"; + "THEN_TCL"; "ORELSE_TCL"]; + List.iter (fun x -> Hashtbl.add ct x True) + ['!'; '&'; '*'; '+'; '-'; '/'; ':'; '<'; '='; '>'; '@'; '^'; '|'; '~'; + '?'; '%'; '.'; '$']; + fun x -> + try Hashtbl.find ht x with + [ Not_found -> try Hashtbl.find ct x.[0] with _ -> False ] +}; + +(*** JRH added this so parenthesised operators undergo same mapping ***) + +value translate_operator = + fun s -> + match s with + [ "THEN" -> "then_" + | "THENC" -> "thenc_" + | "THENL" -> "thenl_" + | "ORELSE" -> "orelse_" + | "ORELSEC" -> "orelsec_" + | "THEN_TCL" -> "then_tcl_" + | "ORELSE_TCL" -> "orelse_tcl_" + | "F_F" -> "f_f_" + | _ -> s]; + +value operator_rparen = + Grammar.Entry.of_parser gram "operator_rparen" + (fun strm -> + match Stream.npeek 2 strm with + [ [("", s); ("", ")")] when is_operator s -> do { + Stream.junk strm; + Stream.junk strm; + translate_operator s + } + | _ -> raise Stream.Failure ]) +; + +value check_not_part_of_patt = + Grammar.Entry.of_parser gram "check_not_part_of_patt" + (fun strm -> + let tok = + match Stream.npeek 4 strm with + [ [("LIDENT", _); tok :: _] -> tok + | [("", "("); ("", s); ("", ")"); tok] when is_operator s -> tok + | _ -> raise Stream.Failure ] + in + match tok with + [ ("", "," | "as" | "|" | "::") -> raise Stream.Failure + | _ -> () ]) +; + +value symbolchar = + let list = + ['!'; '$'; '%'; '&'; '*'; '+'; '-'; '.'; '/'; ':'; '<'; '='; '>'; '?'; + '@'; '^'; '|'; '~'] + in + loop where rec loop s i = + if i == String.length s then True + else if List.mem s.[i] list then loop s (i + 1) + else False +; + +value prefixop = + let list = ['!'; '?'; '~'] in + let excl = ["!="; "??"; "?!"] in + Grammar.Entry.of_parser gram "prefixop" + (parser + [: `("", x) + when + not (List.mem x excl) && String.length x >= 2 && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop0 = + let list = ['='; '<'; '>'; '|'; '&'; '$'] in + let excl = ["<-"; "||"; "&&"] in + Grammar.Entry.of_parser gram "infixop0" + (parser + [: `("", x) + when + not (List.mem x excl) && (x = "$" || String.length x >= 2) && + List.mem x.[0] list && symbolchar x 1 :] -> + x) +; + +value infixop1 = + let list = ['@'; '^'] in + Grammar.Entry.of_parser gram "infixop1" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop2 = + let list = ['+'; '-'] in + Grammar.Entry.of_parser gram "infixop2" + (parser + [: `("", x) + when + x <> "->" && String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop3 = + let list = ['*'; '/'; '%'] in + Grammar.Entry.of_parser gram "infixop3" + (parser + [: `("", x) + when + String.length x >= 2 && List.mem x.[0] list && + symbolchar x 1 :] -> + x) +; + +value infixop4 = + Grammar.Entry.of_parser gram "infixop4" + (parser + [: `("", x) + when + String.length x >= 3 && x.[0] == '*' && x.[1] == '*' && + symbolchar x 2 :] -> + x) +; + +value test_constr_decl = + Grammar.Entry.of_parser gram "test_constr_decl" + (fun strm -> + match Stream.npeek 1 strm with + [ [("UIDENT", _)] -> + match Stream.npeek 2 strm with + [ [_; ("", ".")] -> raise Stream.Failure + | [_; ("", "(")] -> raise Stream.Failure + | [_ :: _] -> () + | _ -> raise Stream.Failure ] + | [("", "|")] -> () + | _ -> raise Stream.Failure ]) +; + +value stream_peek_nth n strm = + loop n (Stream.npeek n strm) where rec loop n = + fun + [ [] -> None + | [x] -> if n == 1 then Some x else None + | [_ :: l] -> loop (n - 1) l ] +; + +(* horrible hack to be able to parse class_types *) + +value test_ctyp_minusgreater = + Grammar.Entry.of_parser gram "test_ctyp_minusgreater" + (fun strm -> + let rec skip_simple_ctyp n = + match stream_peek_nth n strm with + [ Some ("", "->") -> n + | Some ("", "[" | "[<") -> + skip_simple_ctyp (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> skip_simple_ctyp (ignore_upto ")" (n + 1) + 1) + | Some + ("", + "as" | "'" | ":" | "*" | "." | "#" | "<" | ">" | ".." | ";" | + "_") -> + skip_simple_ctyp (n + 1) + | Some ("QUESTIONIDENT" | "LIDENT" | "UIDENT", _) -> + skip_simple_ctyp (n + 1) + | Some _ | None -> raise Stream.Failure ] + and ignore_upto end_kwd n = + match stream_peek_nth n strm with + [ Some ("", prm) when prm = end_kwd -> n + | Some ("", "[" | "[<") -> + ignore_upto end_kwd (ignore_upto "]" (n + 1) + 1) + | Some ("", "(") -> ignore_upto end_kwd (ignore_upto ")" (n + 1) + 1) + | Some _ -> ignore_upto end_kwd (n + 1) + | None -> raise Stream.Failure ] + in + match Stream.peek strm with + [ Some (("", "[") | ("LIDENT" | "UIDENT", _)) -> skip_simple_ctyp 1 + | Some ("", "object") -> raise Stream.Failure + | _ -> 1 ]) +; + +value test_label_eq = + Grammar.Entry.of_parser gram "test_label_eq" + (test 1 where rec test lev strm = + match stream_peek_nth lev strm with + [ Some (("UIDENT", _) | ("LIDENT", _) | ("", ".")) -> + test (lev + 1) strm + | Some ("ANTIQUOT_LOC", _) -> () + | Some ("", "=") -> () + | _ -> raise Stream.Failure ]) +; + +value test_typevar_list_dot = + Grammar.Entry.of_parser gram "test_typevar_list_dot" + (let rec test lev strm = + match stream_peek_nth lev strm with + [ Some ("", "'") -> test2 (lev + 1) strm + | Some ("", ".") -> () + | _ -> raise Stream.Failure ] + and test2 lev strm = + match stream_peek_nth lev strm with + [ Some ("UIDENT" | "LIDENT", _) -> test (lev + 1) strm + | _ -> raise Stream.Failure ] + in + test 1) +; + +value e_phony = + Grammar.Entry.of_parser gram "e_phony" + (parser []) +; +value p_phony = + Grammar.Entry.of_parser gram "p_phony" + (parser []) +; + +value constr_arity = ref [("Some", 1); ("Match_Failure", 1)]; + +value rec is_expr_constr_call = + fun + [ <:expr< $uid:_$ >> -> True + | <:expr< $uid:_$.$e$ >> -> is_expr_constr_call e + | <:expr< $e$ $_$ >> -> is_expr_constr_call e + | _ -> False ] +; + +value rec constr_expr_arity loc = + fun + [ <:expr< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:expr< $uid:_$.$e$ >> -> constr_expr_arity loc e + | _ -> 1 ] +; + +value rec constr_patt_arity loc = + fun + [ <:patt< $uid:c$ >> -> + try List.assoc c constr_arity.val with [ Not_found -> 0 ] + | <:patt< $uid:_$.$p$ >> -> constr_patt_arity loc p + | _ -> 1 ] +; + +value get_seq = + fun + [ <:expr< do { $list:el$ } >> -> el + | e -> [e] ] +; + +value mem_tvar s tpl = + List.exists (fun (t, _) -> Pcaml.unvala t = Some s) tpl +; + +value choose_tvar tpl = + let rec find_alpha v = + let s = String.make 1 v in + if mem_tvar s tpl then + if v = 'z' then None else find_alpha (Char.chr (Char.code v + 1)) + else Some (String.make 1 v) + in + let rec make_n n = + let v = "a" ^ string_of_int n in + if mem_tvar v tpl then make_n (succ n) else v + in + match find_alpha 'a' with + [ Some x -> x + | None -> make_n 1 ] +; + +value quotation_content s = do { + loop 0 where rec loop i = + if i = String.length s then ("", s) + else if s.[i] = ':' || s.[i] = '@' then + let i = i + 1 in + (String.sub s 0 i, String.sub s i (String.length s - i)) + else loop (i + 1) +}; + +value concat_comm loc e = + let loc = + Ploc.with_comment loc + (Ploc.comment loc ^ Ploc.comment (MLast.loc_of_expr e)) + in + let floc = + let first = ref True in + fun loc1 -> + if first.val then do {first.val := False; loc} + else loc1 + in + reloc_expr floc 0 e +; + +EXTEND + GLOBAL: sig_item str_item ctyp patt expr module_type module_expr + signature structure class_type class_expr class_sig_item class_str_item + let_binding type_decl constructor_declaration label_declaration + match_case with_constr poly_variant; + module_expr: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = module_type; ")"; + "->"; me = SELF -> + <:module_expr< functor ( $_uid:i$ : $t$ ) -> $me$ >> + | "struct"; st = structure; "end" -> + <:module_expr< struct $_list:st$ end >> ] + | [ me1 = SELF; "."; me2 = SELF -> <:module_expr< $me1$ . $me2$ >> ] + | [ me1 = SELF; "("; me2 = SELF; ")" -> <:module_expr< $me1$ $me2$ >> ] + | [ i = mod_expr_ident -> i + | "("; "val"; e = expr; ":"; mt = module_type; ")" -> + <:module_expr< (value $e$ : $mt$) >> + | "("; "val"; e = expr; ")" -> + <:module_expr< (value $e$) >> + | "("; me = SELF; ":"; mt = module_type; ")" -> + <:module_expr< ( $me$ : $mt$ ) >> + | "("; me = SELF; ")" -> <:module_expr< $me$ >> ] ] + ; + structure: + [ [ st = V (LIST0 [ s = str_item; OPT ";;" -> s ]) -> st ] ] + ; + mod_expr_ident: + [ LEFTA + [ i = SELF; "."; j = SELF -> <:module_expr< $i$ . $j$ >> ] + | [ i = V UIDENT -> <:module_expr< $_uid:i$ >> ] ] + ; + str_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration; + b = rebind_exn -> + <:str_item< exception $_uid:c$ of $_list:tl$ = $_list:b$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:str_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; me = module_expr -> <:str_item< include $me$ >> + | "module"; r = V (FLAG "rec"); l = V (LIST1 mod_binding SEP "and") -> + <:str_item< module $_flag:r$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:str_item< module type $_uid:i$ = $mt$ >> + | "open"; i = V mod_ident "list" "" -> + <:str_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:str_item< type $_list:tdl$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr -> + let e = <:expr< let $_flag:r$ $_list:l$ in $x$ >> in + <:str_item< $exp:e$ >> + | "let"; r = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and") -> + match l with + [ <:vala< [(p, e)] >> -> + match p with + [ <:patt< _ >> -> <:str_item< $exp:e$ >> + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | _ -> <:str_item< value $_flag:r$ $_list:l$ >> ] + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; e = expr -> + <:str_item< let module $_uid:m$ = $mb$ in $e$ >> + | e = expr -> <:str_item< $exp:e$ >> ] ] + ; + rebind_exn: + [ [ "="; sl = V mod_ident "list" -> sl + | -> <:vala< [] >> ] ] + ; + mod_binding: + [ [ i = V UIDENT; me = mod_fun_binding -> (i, me) ] ] + ; + mod_fun_binding: + [ RIGHTA + [ "("; m = UIDENT; ":"; mt = module_type; ")"; mb = SELF -> + <:module_expr< functor ( $uid:m$ : $mt$ ) -> $mb$ >> + | ":"; mt = module_type; "="; me = module_expr -> + <:module_expr< ( $me$ : $mt$ ) >> + | "="; me = module_expr -> <:module_expr< $me$ >> ] ] + ; + (* Module types *) + module_type: + [ [ "functor"; "("; i = V UIDENT "uid" ""; ":"; t = SELF; ")"; "->"; + mt = SELF -> + <:module_type< functor ( $_uid:i$ : $t$ ) -> $mt$ >> ] + | [ mt = SELF; "with"; wcl = V (LIST1 with_constr SEP "and") -> + <:module_type< $mt$ with $_list:wcl$ >> ] + | [ "sig"; sg = signature; "end" -> + <:module_type< sig $_list:sg$ end >> + | "module"; "type"; "of"; me = module_expr -> + <:module_type< module type of $me$ >> + | i = mod_type_ident -> i + | "("; mt = SELF; ")" -> <:module_type< $mt$ >> ] ] + ; + signature: + [ [ sg = V (LIST0 [ s = sig_item; OPT ";;" -> s ]) -> sg ] ] + ; + mod_type_ident: + [ LEFTA + [ m1 = SELF; "."; m2 = SELF -> <:module_type< $m1$ . $m2$ >> + | m1 = SELF; "("; m2 = SELF; ")" -> <:module_type< $m1$ $m2$ >> ] + | [ m = V UIDENT -> <:module_type< $_uid:m$ >> + | m = V LIDENT -> <:module_type< $_lid:m$ >> ] ] + ; + sig_item: + [ "top" + [ "exception"; (_, c, tl, _) = constructor_declaration -> + <:sig_item< exception $_uid:c$ of $_list:tl$ >> + | "external"; i = V LIDENT "lid" ""; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $_lid:i$ : $t$ = $_list:pd$ >> + | "external"; "("; i = operator_rparen; ":"; t = ctyp; "="; + pd = V (LIST1 STRING) -> + <:sig_item< external $lid:i$ : $t$ = $_list:pd$ >> + | "include"; mt = module_type -> + <:sig_item< include $mt$ >> + | "module"; rf = V (FLAG "rec"); + l = V (LIST1 mod_decl_binding SEP "and") -> + <:sig_item< module $_flag:rf$ $_list:l$ >> + | "module"; "type"; i = V UIDENT "uid" ""; "="; mt = module_type -> + <:sig_item< module type $_uid:i$ = $mt$ >> + | "module"; "type"; i = V UIDENT "uid" "" -> + <:sig_item< module type $_uid:i$ = 'abstract >> + | "open"; i = V mod_ident "list" "" -> + <:sig_item< open $_:i$ >> + | "type"; tdl = V (LIST1 type_decl SEP "and") -> + <:sig_item< type $_list:tdl$ >> + | "val"; i = V LIDENT "lid" ""; ":"; t = ctyp -> + <:sig_item< value $_lid:i$ : $t$ >> + | "val"; "("; i = operator_rparen; ":"; t = ctyp -> + <:sig_item< value $lid:i$ : $t$ >> ] ] + ; + mod_decl_binding: + [ [ i = V UIDENT; mt = module_declaration -> (i, mt) ] ] + ; + module_declaration: + [ RIGHTA + [ ":"; mt = module_type -> <:module_type< $mt$ >> + | "("; i = UIDENT; ":"; t = module_type; ")"; mt = SELF -> + <:module_type< functor ( $uid:i$ : $t$ ) -> $mt$ >> ] ] + ; + (* "with" constraints (additional type equations over signature + components) *) + with_constr: + [ [ "type"; tpl = V type_parameters "list"; i = V mod_ident ""; "="; + pf = V (FLAG "private"); t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ = $_flag:pf$ $t$ >> + | "type"; tpl = V type_parameters "list"; i = V mod_ident ""; ":="; + t = ctyp -> + <:with_constr< type $_:i$ $_list:tpl$ := $t$ >> + | "module"; i = V mod_ident ""; "="; me = module_expr -> + <:with_constr< module $_:i$ = $me$ >> + | "module"; i = V mod_ident ""; ":="; me = module_expr -> + <:with_constr< module $_:i$ := $me$ >> ] ] + ; + (* Core expressions *) + expr: + [ "top" RIGHTA + [ e1 = SELF; ";"; e2 = SELF -> + <:expr< do { $list:[e1 :: get_seq e2]$ } >> + | e1 = SELF; ";" -> e1 + | el = V e_phony "list" -> <:expr< do { $_list:el$ } >> ] + | "expr1" + [ "let"; o = V (FLAG "rec"); l = V (LIST1 let_binding SEP "and"); "in"; + x = expr LEVEL "top" -> + <:expr< let $_flag:o$ $_list:l$ in $x$ >> + | "let"; "module"; m = V UIDENT; mb = mod_fun_binding; "in"; + e = expr LEVEL "top" -> + <:expr< let module $_uid:m$ = $mb$ in $e$ >> + | "function"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< fun [ $_list:l$ ] >> + | "fun"; p = patt LEVEL "simple"; (eo, e) = fun_def -> + <:expr< fun [$p$ $opt:eo$ -> $e$] >> + | "match"; e = SELF; "with"; OPT "|"; + l = V (LIST1 match_case SEP "|") -> + <:expr< match $e$ with [ $_list:l$ ] >> + | "try"; e = SELF; "with"; OPT "|"; l = V (LIST1 match_case SEP "|") -> + <:expr< try $e$ with [ $_list:l$ ] >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1"; "else"; + e3 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else $e3$ >> + | "if"; e1 = SELF; "then"; e2 = expr LEVEL "expr1" -> + <:expr< if $e1$ then $e2$ else () >> + | "for"; i = V LIDENT; "="; e1 = SELF; df = V direction_flag "to"; + e2 = SELF; "do"; e = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e in + <:expr< for $_lid:i$ = $e1$ $_to:df$ $e2$ do { $_list:el$ } >> + | "while"; e1 = SELF; "do"; e2 = V SELF "list"; "done" -> + let el = Pcaml.vala_map get_seq e2 in + <:expr< while $e1$ do { $_list:el$ } >> ] + | [ e = SELF; ","; el = LIST1 NEXT SEP "," -> + <:expr< ( $list:[e :: el]$ ) >> ] + | ":=" NONA + [ e1 = SELF; ":="; e2 = expr LEVEL "expr1" -> + <:expr< $e1$.val := $e2$ >> + | e1 = SELF; "<-"; e2 = expr LEVEL "expr1" -> <:expr< $e1$ := $e2$ >> ] + | "||" RIGHTA + [ e1 = SELF; "or"; e2 = SELF -> <:expr< $lid:"or"$ $e1$ $e2$ >> + | e1 = SELF; "||"; e2 = SELF -> <:expr< $e1$ || $e2$ >> ] + | "&&" RIGHTA + [ e1 = SELF; "&"; e2 = SELF -> <:expr< $lid:"&"$ $e1$ $e2$ >> + | e1 = SELF; "&&"; e2 = SELF -> <:expr< $e1$ && $e2$ >> ] + | "<" LEFTA + [ e1 = SELF; "<"; e2 = SELF -> <:expr< $e1$ < $e2$ >> + | e1 = SELF; ">"; e2 = SELF -> <:expr< $e1$ > $e2$ >> + | e1 = SELF; "<="; e2 = SELF -> <:expr< $e1$ <= $e2$ >> + | e1 = SELF; ">="; e2 = SELF -> <:expr< $e1$ >= $e2$ >> + | e1 = SELF; "="; e2 = SELF -> <:expr< $e1$ = $e2$ >> + | e1 = SELF; "<>"; e2 = SELF -> <:expr< $e1$ <> $e2$ >> + | e1 = SELF; "=="; e2 = SELF -> <:expr< $e1$ == $e2$ >> + | e1 = SELF; "!="; e2 = SELF -> <:expr< $e1$ != $e2$ >> + | e1 = SELF; op = infixop0; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "^" RIGHTA + [ e1 = SELF; "^"; e2 = SELF -> <:expr< $e1$ ^ $e2$ >> + | e1 = SELF; "@"; e2 = SELF -> <:expr< $e1$ @ $e2$ >> + | e1 = SELF; op = infixop1; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | RIGHTA + [ e1 = SELF; "::"; e2 = SELF -> <:expr< [$e1$ :: $e2$] >> ] + | "+" LEFTA + [ e1 = SELF; "+"; e2 = SELF -> <:expr< $e1$ + $e2$ >> + | e1 = SELF; "-"; e2 = SELF -> <:expr< $e1$ - $e2$ >> + | e1 = SELF; op = infixop2; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "*" LEFTA + [ e1 = SELF; "*"; e2 = SELF -> <:expr< $e1$ * $e2$ >> + | e1 = SELF; "/"; e2 = SELF -> <:expr< $e1$ / $e2$ >> + | e1 = SELF; "%"; e2 = SELF -> <:expr< $lid:"%"$ $e1$ $e2$ >> + | e1 = SELF; "land"; e2 = SELF -> <:expr< $e1$ land $e2$ >> + | e1 = SELF; "lor"; e2 = SELF -> <:expr< $e1$ lor $e2$ >> + | e1 = SELF; "lxor"; e2 = SELF -> <:expr< $e1$ lxor $e2$ >> + | e1 = SELF; "mod"; e2 = SELF -> <:expr< $e1$ mod $e2$ >> + | e1 = SELF; op = infixop3; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "**" RIGHTA + [ e1 = SELF; "**"; e2 = SELF -> <:expr< $e1$ ** $e2$ >> + | e1 = SELF; "asr"; e2 = SELF -> <:expr< $e1$ asr $e2$ >> + | e1 = SELF; "lsl"; e2 = SELF -> <:expr< $e1$ lsl $e2$ >> + | e1 = SELF; "lsr"; e2 = SELF -> <:expr< $e1$ lsr $e2$ >> + | e1 = SELF; op = infixop4; e2 = SELF -> <:expr< $lid:op$ $e1$ $e2$ >> ] + | "unary minus" NONA + [ "-"; e = SELF -> <:expr< - $e$ >> + | "-."; e = SELF -> <:expr< -. $e$ >> ] + | "apply" LEFTA + [ e1 = SELF; e2 = SELF -> + let (e1, e2) = + if is_expr_constr_call e1 then + match e1 with + [ <:expr< $e11$ $e12$ >> -> (e11, <:expr< $e12$ $e2$ >>) + | _ -> (e1, e2) ] + else (e1, e2) + in + match constr_expr_arity loc e1 with + [ 1 -> <:expr< $e1$ $e2$ >> + | _ -> + match e2 with + [ <:expr< ( $list:el$ ) >> -> + List.fold_left (fun e1 e2 -> <:expr< $e1$ $e2$ >>) e1 el + | _ -> <:expr< $e1$ $e2$ >> ] ] + | "assert"; e = SELF -> <:expr< assert $e$ >> + | "lazy"; e = SELF -> <:expr< lazy ($e$) >> ] + | "." LEFTA + [ e1 = SELF; "."; "("; op = operator_rparen -> + <:expr< $e1$ .( $lid:op$ ) >> + | e1 = SELF; "."; "("; e2 = SELF; ")" -> + <:expr< $e1$ .( $e2$ ) >> + | e1 = SELF; "."; "["; e2 = SELF; "]" -> <:expr< $e1$ .[ $e2$ ] >> + | e = SELF; "."; "{"; el = V (LIST1 expr LEVEL "+" SEP ","); "}" -> + <:expr< $e$ .{ $_list:el$ } >> + | e1 = SELF; "."; e2 = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop e1 e2 ] + | "~-" NONA + [ "!"; e = SELF -> <:expr< $e$ . val >> + | "~-"; e = SELF -> <:expr< ~- $e$ >> + | "~-."; e = SELF -> <:expr< ~-. $e$ >> + | f = prefixop; e = SELF -> <:expr< $lid:f$ $e$ >> ] + | "simple" LEFTA + [ s = V INT -> <:expr< $_int:s$ >> + | s = V INT_l -> <:expr< $_int32:s$ >> + | s = V INT_L -> <:expr< $_int64:s$ >> + | s = V INT_n -> <:expr< $_nativeint:s$ >> + | s = V FLOAT -> <:expr< $_flo:s$ >> + | s = V STRING -> <:expr< $_str:s$ >> + | c = V CHAR -> <:expr< $_chr:c$ >> + | UIDENT "True" -> <:expr< True_ >> + | UIDENT "False" -> <:expr< False_ >> + | i = expr_ident -> i + | "false" -> <:expr< False >> + | "true" -> <:expr< True >> + | "["; "]" -> <:expr< [] >> + | "["; el = expr1_semi_list; "]" -> <:expr< $mklistexp loc None el$ >> + | "[|"; "|]" -> <:expr< [| |] >> + | "[|"; el = V expr1_semi_list "list"; "|]" -> + <:expr< [| $_list:el$ |] >> + | "{"; test_label_eq; lel = V lbl_expr_list "list"; "}" -> + <:expr< { $_list:lel$ } >> + | "{"; e = expr LEVEL "."; "with"; lel = V lbl_expr_list "list"; "}" -> + <:expr< { ($e$) with $_list:lel$ } >> + | "("; ")" -> <:expr< () >> + | "("; "module"; me = module_expr; ":"; mt = module_type; ")" -> + <:expr< (module $me$ : $mt$) >> + | "("; "module"; me = module_expr; ")" -> + <:expr< (module $me$) >> + | "("; op = operator_rparen -> <:expr< $lid:op$ >> + | "("; el = V e_phony "list"; ")" -> <:expr< ($_list:el$) >> + | "("; e = SELF; ":"; t = ctyp; ")" -> <:expr< ($e$ : $t$) >> + | "("; e = SELF; ")" -> concat_comm loc <:expr< $e$ >> + | "begin"; e = SELF; "end" -> concat_comm loc <:expr< $e$ >> + | "begin"; "end" -> <:expr< () >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_expr_quotation loc con ] ] + ; + let_binding: + [ [ p = val_ident; e = fun_binding -> (p, e) + | p = patt; "="; e = expr -> (p, e) + | p = patt; ":"; t = poly_type; "="; e = expr -> + (<:patt< ($p$ : $t$) >>, e) ] ] + ; +(*** JRH added the "translate_operator" here ***) + val_ident: + [ [ check_not_part_of_patt; s = LIDENT -> <:patt< $lid:s$ >> + | check_not_part_of_patt; "("; s = ANY; ")" -> + let s' = translate_operator s in <:patt< $lid:s'$ >> ] ] + ; + fun_binding: + [ RIGHTA + [ p = patt LEVEL "simple"; e = SELF -> <:expr< fun $p$ -> $e$ >> + | "="; e = expr -> <:expr< $e$ >> + | ":"; t = poly_type; "="; e = expr -> <:expr< ($e$ : $t$) >> ] ] + ; + match_case: + [ [ x1 = patt; w = V (OPT [ "when"; e = expr -> e ]); "->"; x2 = expr -> + (x1, w, x2) ] ] + ; + lbl_expr_list: + [ [ le = lbl_expr; ";"; lel = SELF -> [le :: lel] + | le = lbl_expr; ";" -> [le] + | le = lbl_expr -> [le] ] ] + ; + lbl_expr: + [ [ i = patt_label_ident; "="; e = expr LEVEL "expr1" -> (i, e) ] ] + ; + expr1_semi_list: + [ [ el = LIST1 (expr LEVEL "expr1") SEP ";" OPT_SEP -> el ] ] + ; + fun_def: + [ RIGHTA + [ p = patt LEVEL "simple"; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) + | eo = OPT [ "when"; e = expr -> e ]; "->"; e = expr -> + (eo, <:expr< $e$ >>) ] ] + ; + expr_ident: + [ RIGHTA + [ i = V LIDENT -> <:expr< $_lid:i$ >> + | i = V UIDENT -> <:expr< $_uid:i$ >> + | i = V UIDENT; "."; j = SELF -> + let rec loop m = + fun + [ <:expr< $x$ . $y$ >> -> loop <:expr< $m$ . $x$ >> y + | e -> <:expr< $m$ . $e$ >> ] + in + loop <:expr< $_uid:i$ >> j + | i = V UIDENT; "."; "("; j = operator_rparen -> + <:expr< $_uid:i$ . $lid:j$ >> ] ] + ; + (* Patterns *) + patt: + [ LEFTA + [ p1 = SELF; "as"; i = LIDENT -> <:patt< ($p1$ as $lid:i$) >> ] + | LEFTA + [ p1 = SELF; "|"; p2 = SELF -> <:patt< $p1$ | $p2$ >> ] + | [ p = SELF; ","; pl = LIST1 NEXT SEP "," -> + <:patt< ( $list:[p :: pl]$) >> ] + | NONA + [ p1 = SELF; ".."; p2 = SELF -> <:patt< $p1$ .. $p2$ >> ] + | RIGHTA + [ p1 = SELF; "::"; p2 = SELF -> <:patt< [$p1$ :: $p2$] >> ] + | LEFTA + [ p1 = SELF; p2 = SELF -> + let (p1, p2) = + match p1 with + [ <:patt< $p11$ $p12$ >> -> (p11, <:patt< $p12$ $p2$ >>) + | _ -> (p1, p2) ] + in + match constr_patt_arity loc p1 with + [ 1 -> <:patt< $p1$ $p2$ >> + | n -> + let p2 = + match p2 with + [ <:patt< _ >> when n > 1 -> + let pl = + loop n where rec loop n = + if n = 0 then [] else [<:patt< _ >> :: loop (n - 1)] + in + <:patt< ( $list:pl$ ) >> + | _ -> p2 ] + in + match p2 with + [ <:patt< ( $list:pl$ ) >> -> + List.fold_left (fun p1 p2 -> <:patt< $p1$ $p2$ >>) p1 pl + | _ -> <:patt< $p1$ $p2$ >> ] ] + | "lazy"; p = SELF -> <:patt< lazy $p$ >> ] + | LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | "simple" + [ s = V LIDENT -> <:patt< $_lid:s$ >> + | s = V UIDENT -> <:patt< $_uid:s$ >> + | s = V INT -> <:patt< $_int:s$ >> + | s = V INT_l -> <:patt< $_int32:s$ >> + | s = V INT_L -> <:patt< $_int64:s$ >> + | s = V INT_n -> <:patt< $_nativeint:s$ >> + | "-"; s = INT -> <:patt< $int:"-" ^ s$ >> + | "-"; s = FLOAT -> <:patt< $flo:"-" ^ s$ >> + | s = V FLOAT -> <:patt< $_flo:s$ >> + | s = V STRING -> <:patt< $_str:s$ >> + | s = V CHAR -> <:patt< $_chr:s$ >> + | UIDENT "True" -> <:patt< True_ >> + | UIDENT "False" -> <:patt< False_ >> + | "false" -> <:patt< False >> + | "true" -> <:patt< True >> + | "["; "]" -> <:patt< [] >> + | "["; pl = patt_semi_list; "]" -> <:patt< $mklistpat loc None pl$ >> + | "[|"; "|]" -> <:patt< [| |] >> + | "[|"; pl = V patt_semi_list "list"; "|]" -> + <:patt< [| $_list:pl$ |] >> + | "{"; lpl = V lbl_patt_list "list"; "}" -> + <:patt< { $_list:lpl$ } >> + | "("; ")" -> <:patt< () >> + | "("; op = operator_rparen -> <:patt< $lid:op$ >> + | "("; pl = V p_phony "list"; ")" -> <:patt< ($_list:pl$) >> + | "("; p = SELF; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> + | "("; p = SELF; ")" -> <:patt< $p$ >> + | "("; "type"; s = V LIDENT; ")" -> <:patt< (type $_lid:s$) >> + | "("; "module"; s = V UIDENT; ":"; mt = module_type; ")" -> + <:patt< (module $_uid:s$ : $mt$) >> + | "("; "module"; s = V UIDENT; ")" -> + <:patt< (module $_uid:s$) >> + | "_" -> <:patt< _ >> + | x = QUOTATION -> + let con = quotation_content x in + Pcaml.handle_patt_quotation loc con ] ] + ; + patt_semi_list: + [ [ p = patt; ";"; pl = SELF -> [p :: pl] + | p = patt; ";" -> [p] + | p = patt -> [p] ] ] + ; + lbl_patt_list: + [ [ le = lbl_patt; ";"; lel = SELF -> [le :: lel] + | le = lbl_patt; ";" -> [le] + | le = lbl_patt -> [le] ] ] + ; + lbl_patt: + [ [ i = patt_label_ident; "="; p = patt -> (i, p) ] ] + ; + patt_label_ident: + [ LEFTA + [ p1 = SELF; "."; p2 = SELF -> <:patt< $p1$ . $p2$ >> ] + | RIGHTA + [ i = UIDENT -> <:patt< $uid:i$ >> + | i = LIDENT -> <:patt< $lid:i$ >> ] ] + ; + (* Type declaration *) + type_decl: + [ [ tpl = type_parameters; n = V type_patt; "="; pf = V (FLAG "private"); + tk = type_kind; cl = V (LIST0 constrain) -> + <:type_decl< $_tp:n$ $list:tpl$ = $_priv:pf$ $tk$ $_list:cl$ >> + | tpl = type_parameters; n = V type_patt; cl = V (LIST0 constrain) -> + let tk = <:ctyp< '$choose_tvar tpl$ >> in + <:type_decl< $_tp:n$ $list:tpl$ = $tk$ $_list:cl$ >> ] ] + ; + type_patt: + [ [ n = V LIDENT -> (loc, n) ] ] + ; + constrain: + [ [ "constraint"; t1 = ctyp; "="; t2 = ctyp -> (t1, t2) ] ] + ; + type_kind: + [ [ test_constr_decl; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< [ $list:cdl$ ] >> + | t = ctyp -> + <:ctyp< $t$ >> + | t = ctyp; "="; pf = FLAG "private"; "{"; + ldl = V label_declarations "list"; "}" -> + <:ctyp< $t$ == $priv:pf$ { $_list:ldl$ } >> + | t = ctyp; "="; pf = FLAG "private"; OPT "|"; + cdl = LIST1 constructor_declaration SEP "|" -> + <:ctyp< $t$ == $priv:pf$ [ $list:cdl$ ] >> + | "{"; ldl = V label_declarations "list"; "}" -> + <:ctyp< { $_list:ldl$ } >> ] ] + ; + type_parameters: + [ [ -> (* empty *) [] + | tp = type_parameter -> [tp] + | "("; tpl = LIST1 type_parameter SEP ","; ")" -> tpl ] ] + ; + type_parameter: + [ [ "+"; p = V simple_type_parameter -> (p, Some True) + | "-"; p = V simple_type_parameter -> (p, Some False) + | p = V simple_type_parameter -> (p, None) ] ] + ; + simple_type_parameter: + [ [ "'"; i = ident -> Some i + | "_" -> None ] ] + ; + constructor_declaration: + [ [ ci = cons_ident; "of"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + (loc, ci, cal, None) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*"); + "->"; t = ctyp -> + (loc, ci, cal, Some t) + | ci = cons_ident; ":"; cal = V (LIST1 (ctyp LEVEL "apply") SEP "*") -> + let t = + match cal with + [ <:vala< [t] >> -> t + | <:vala< [t :: tl] >> -> <:ctyp< ($list:[t :: tl]$) >> + | _ -> assert False ] + in + (loc, ci, <:vala< [] >>, Some t) + | ci = cons_ident -> (loc, ci, <:vala< [] >>, None) ] ] + ; + cons_ident: + [ [ i = V UIDENT "uid" "" -> i + | UIDENT "True" -> <:vala< "True_" >> + | UIDENT "False" -> <:vala< "False_" >> ] ] + ; + label_declarations: + [ [ ld = label_declaration; ";"; ldl = SELF -> [ld :: ldl] + | ld = label_declaration; ";" -> [ld] + | ld = label_declaration -> [ld] ] ] + ; + label_declaration: + [ [ i = LIDENT; ":"; t = poly_type -> (loc, i, False, t) + | "mutable"; i = LIDENT; ":"; t = poly_type -> (loc, i, True, t) ] ] + ; + (* Core types *) + ctyp: + [ [ t1 = SELF; "as"; "'"; i = ident -> <:ctyp< $t1$ as '$i$ >> ] + | "arrow" RIGHTA + [ t1 = SELF; "->"; t2 = SELF -> <:ctyp< $t1$ -> $t2$ >> ] + | "star" + [ t = SELF; "*"; tl = LIST1 (ctyp LEVEL "apply") SEP "*" -> + <:ctyp< ( $list:[t :: tl]$ ) >> ] + | "apply" + [ t1 = SELF; t2 = SELF -> <:ctyp< $t2$ $t1$ >> ] + | "ctyp2" + [ t1 = SELF; "."; t2 = SELF -> <:ctyp< $t1$ . $t2$ >> + | t1 = SELF; "("; t2 = SELF; ")" -> <:ctyp< $t1$ $t2$ >> ] + | "simple" + [ "'"; i = V ident "" -> <:ctyp< '$_:i$ >> + | "_" -> <:ctyp< _ >> + | i = V LIDENT -> <:ctyp< $_lid:i$ >> + | i = V UIDENT -> <:ctyp< $_uid:i$ >> + | "("; "module"; mt = module_type; ")" -> <:ctyp< module $mt$ >> + | "("; t = SELF; ","; tl = LIST1 ctyp SEP ","; ")"; + i = ctyp LEVEL "ctyp2" -> + List.fold_left (fun c a -> <:ctyp< $c$ $a$ >>) i [t :: tl] + | "("; t = SELF; ")" -> <:ctyp< $t$ >> ] ] + ; + (* Identifiers *) + ident: + [ [ i = LIDENT -> i + | i = UIDENT -> i ] ] + ; + mod_ident: + [ RIGHTA + [ i = UIDENT -> [i] + | i = LIDENT -> [i] + | i = UIDENT; "."; j = SELF -> [i :: j] ] ] + ; + (* Miscellaneous *) + direction_flag: + [ [ "to" -> True + | "downto" -> False ] ] + ; + (* Objects and Classes *) + str_item: + [ [ "class"; cd = V (LIST1 class_declaration SEP "and") -> + <:str_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:str_item< class type $_list:ctd$ >> ] ] + ; + sig_item: + [ [ "class"; cd = V (LIST1 class_description SEP "and") -> + <:sig_item< class $_list:cd$ >> + | "class"; "type"; ctd = V (LIST1 class_type_declaration SEP "and") -> + <:sig_item< class type $_list:ctd$ >> ] ] + ; + (* Class expressions *) + class_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; i = V LIDENT; + cfb = class_fun_binding -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = i; MLast.ciExp = cfb} ] ] + ; + class_fun_binding: + [ [ "="; ce = class_expr -> ce + | ":"; ct = class_type; "="; ce = class_expr -> + <:class_expr< ($ce$ : $ct$) >> + | p = patt LEVEL "simple"; cfb = SELF -> + <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_type_parameters: + [ [ -> (loc, <:vala< [] >>) + | "["; tpl = V (LIST1 type_parameter SEP ","); "]" -> (loc, tpl) ] ] + ; + class_fun_def: + [ [ p = patt LEVEL "simple"; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = patt LEVEL "simple"; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; + class_expr: + [ "top" + [ "fun"; cfd = class_fun_def -> cfd + | "let"; rf = V (FLAG "rec"); lb = V (LIST1 let_binding SEP "and"); + "in"; ce = SELF -> + <:class_expr< let $_flag:rf$ $_list:lb$ in $ce$ >> ] + | "apply" LEFTA + [ ce = SELF; e = expr LEVEL "label" -> + <:class_expr< $ce$ $e$ >> ] + | "simple" + [ "["; ct = ctyp; ","; ctcl = LIST1 ctyp SEP ","; "]"; + ci = class_longident -> + <:class_expr< [ $list:[ct :: ctcl]$ ] $list:ci$ >> + | "["; ct = ctyp; "]"; ci = class_longident -> + <:class_expr< [ $ct$ ] $list:ci$ >> + | ci = class_longident -> <:class_expr< $list:ci$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:class_expr< object $_opt:cspo$ $_list:cf$ end >> + | "("; ce = SELF; ":"; ct = class_type; ")" -> + <:class_expr< ($ce$ : $ct$) >> + | "("; ce = SELF; ")" -> ce ] ] + ; + class_structure: + [ [ cf = LIST0 class_str_item -> cf ] ] + ; + class_self_patt: + [ [ "("; p = patt; ")" -> p + | "("; p = patt; ":"; t = ctyp; ")" -> <:patt< ($p$ : $t$) >> ] ] + ; + class_str_item: + [ [ "inherit"; ce = class_expr; pb = V (OPT [ "as"; i = LIDENT -> i ]) -> + <:class_str_item< inherit $ce$ $_opt:pb$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + lab = V LIDENT "lid" ""; e = cvalue_binding -> + <:class_str_item< value $_!:ov$ $_flag:mf$ $_lid:lab$ = $e$ >> + | "val"; ov = V (FLAG "!") "!"; mf = V (FLAG "mutable"); + "virtual"; lab = V LIDENT "lid" ""; ":"; t = ctyp -> + if Pcaml.unvala ov then + Ploc.raise loc (Stream.Error "virtual value cannot override") + else + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "val"; "virtual"; mf = V (FLAG "mutable"); lab = V LIDENT "lid" ""; + ":"; t = ctyp -> + <:class_str_item< value virtual $_flag:mf$ $_lid:lab$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_str_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_str_item< method virtual $_lid:l$ : $t$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + ":"; t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ private $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; "private"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ private $_lid:l$ = $sb$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; ":"; + t = poly_type; "="; e = expr -> + <:class_str_item< method $_!:ov$ $_lid:l$ : $t$ = $e$ >> + | "method"; ov = V (FLAG "!") "!"; l = V LIDENT "lid" ""; + sb = fun_binding -> + <:class_str_item< method $_!:ov$ $_lid:l$ = $sb$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_str_item< type $t1$ = $t2$ >> + | "initializer"; se = expr -> <:class_str_item< initializer $se$ >> ] ] + ; + cvalue_binding: + [ [ "="; e = expr -> e + | ":"; t = ctyp; "="; e = expr -> <:expr< ($e$ : $t$) >> + | ":"; t = ctyp; ":>"; t2 = ctyp; "="; e = expr -> + <:expr< ($e$ : $t$ :> $t2$) >> + | ":>"; t = ctyp; "="; e = expr -> + <:expr< ($e$ :> $t$) >> ] ] + ; + label: + [ [ i = LIDENT -> i ] ] + ; + (* Class types *) + class_type: + [ [ test_ctyp_minusgreater; t = ctyp LEVEL "star"; "->"; ct = SELF -> + <:class_type< [ $t$ ] -> $ct$ >> + | cs = class_signature -> cs ] ] + ; + class_signature: + [ [ "["; tl = LIST1 ctyp SEP ","; "]"; id = SELF -> + <:class_type< $id$ [ $list:tl$ ] >> + | "object"; cst = V (OPT class_self_type); + csf = V (LIST0 class_sig_item); "end" -> + <:class_type< object $_opt:cst$ $_list:csf$ end >> ] + | [ ct1 = SELF; "."; ct2 = SELF -> <:class_type< $ct1$ . $ct2$ >> + | ct1 = SELF; "("; ct2 = SELF; ")" -> <:class_type< $ct1$ $ct2$ >> ] + | [ i = V LIDENT -> <:class_type< $_id: i$ >> + | i = V UIDENT -> <:class_type< $_id: i$ >> ] ] + ; + class_self_type: + [ [ "("; t = ctyp; ")" -> t ] ] + ; + class_sig_item: + [ [ "inherit"; cs = class_signature -> + <:class_sig_item< inherit $cs$ >> + | "val"; mf = V (FLAG "mutable"); l = V LIDENT "lid" ""; ":"; t = ctyp -> + <:class_sig_item< value $_flag:mf$ $_lid:l$ : $t$ >> + | "method"; "private"; "virtual"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; "private"; l = V LIDENT "lid" ""; ":"; + t = poly_type -> + <:class_sig_item< method virtual private $_lid:l$ : $t$ >> + | "method"; "virtual"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method virtual $_lid:l$ : $t$ >> + | "method"; "private"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method private $_lid:l$ : $t$ >> + | "method"; l = V LIDENT "lid" ""; ":"; t = poly_type -> + <:class_sig_item< method $_lid:l$ : $t$ >> + | "constraint"; t1 = ctyp; "="; t2 = ctyp -> + <:class_sig_item< type $t1$ = $t2$ >> ] ] + ; + class_description: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + ":"; ct = class_type -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = ct} ] ] + ; + class_type_declaration: + [ [ vf = V (FLAG "virtual"); ctp = class_type_parameters; n = V LIDENT; + "="; cs = class_signature -> + {MLast.ciLoc = loc; MLast.ciVir = vf; MLast.ciPrm = ctp; + MLast.ciNam = n; MLast.ciExp = cs} ] ] + ; + (* Expressions *) + expr: LEVEL "simple" + [ LEFTA + [ "new"; i = V class_longident "list" -> <:expr< new $_list:i$ >> + | "object"; cspo = V (OPT class_self_patt); + cf = V class_structure "list"; "end" -> + <:expr< object $_opt:cspo$ $_list:cf$ end >> ] ] + ; + expr: LEVEL "." + [ [ e = SELF; "#"; lab = V LIDENT "lid" -> <:expr< $e$ # $_lid:lab$ >> ] ] + ; + expr: LEVEL "simple" + [ [ "("; e = SELF; ":"; t = ctyp; ":>"; t2 = ctyp; ")" -> + <:expr< ($e$ : $t$ :> $t2$) >> + | "("; e = SELF; ":>"; t = ctyp; ")" -> <:expr< ($e$ :> $t$) >> + | "{<"; ">}" -> <:expr< {< >} >> + | "{<"; fel = V field_expr_list "list"; ">}" -> + <:expr< {< $_list:fel$ >} >> ] ] + ; + field_expr_list: + [ [ l = label; "="; e = expr LEVEL "expr1"; ";"; fel = SELF -> + [(l, e) :: fel] + | l = label; "="; e = expr LEVEL "expr1"; ";" -> [(l, e)] + | l = label; "="; e = expr LEVEL "expr1" -> [(l, e)] ] ] + ; + (* Core types *) + ctyp: LEVEL "simple" + [ [ "#"; id = V class_longident "list" -> + <:ctyp< # $_list:id$ >> + | "<"; ml = V meth_list "list"; v = V (FLAG ".."); ">" -> + <:ctyp< < $_list:ml$ $_flag:v$ > >> + | "<"; ".."; ">" -> + <:ctyp< < .. > >> + | "<"; ">" -> + <:ctyp< < > >> ] ] + ; + meth_list: + [ [ f = field; ";"; ml = SELF -> [f :: ml] + | f = field; ";" -> [f] + | f = field -> [f] ] ] + ; + field: + [ [ lab = LIDENT; ":"; t = poly_type -> (lab, t) ] ] + ; + (* Polymorphic types *) + typevar: + [ [ "'"; i = ident -> i ] ] + ; + poly_type: + [ [ "type"; nt = LIST1 LIDENT; "."; ct = ctyp -> + <:ctyp< type $list:nt$ . $ct$ >> + | test_typevar_list_dot; tpl = LIST1 typevar; "."; t2 = ctyp -> + <:ctyp< ! $list:tpl$ . $t2$ >> + | t = ctyp -> t ] ] + ; + (* Identifiers *) + class_longident: + [ [ m = UIDENT; "."; l = SELF -> [m :: l] + | i = LIDENT -> [i] ] ] + ; + (* Labels *) + ctyp: AFTER "arrow" + [ NONA + [ i = V LIDENT; ":"; t = SELF -> <:ctyp< ~$_:i$: $t$ >> + | i = V QUESTIONIDENTCOLON; t = SELF -> <:ctyp< ?$_:i$: $t$ >> + | i = V QUESTIONIDENT; ":"; t = SELF -> <:ctyp< ?$_:i$: $t$ >> ] ] + ; + ctyp: LEVEL "simple" + [ [ "["; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ = $_list:rfl$ ] >> + | "["; ">"; "]" -> <:ctyp< [ > $list:[]$ ] >> + | "["; ">"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ > $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); "]" -> + <:ctyp< [ < $_list:rfl$ ] >> + | "[<"; OPT "|"; rfl = V (LIST1 poly_variant SEP "|"); ">"; + ntl = V (LIST1 name_tag); "]" -> + <:ctyp< [ < $_list:rfl$ > $_list:ntl$ ] >> ] ] + ; + poly_variant: + [ [ "`"; i = V ident "" -> <:poly_variant< ` $_:i$ >> + | "`"; i = V ident ""; "of"; ao = V (FLAG "&"); + l = V (LIST1 ctyp SEP "&") -> + <:poly_variant< `$_:i$ of $_flag:ao$ $_list:l$ >> + | t = ctyp -> <:poly_variant< $t$ >> ] ] + ; + name_tag: + [ [ "`"; i = ident -> i ] ] + ; + expr: LEVEL "expr1" + [ [ "fun"; p = labeled_patt; (eo, e) = fun_def -> + <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >> ] ] + ; + expr: AFTER "apply" + [ "label" + [ i = V TILDEIDENTCOLON; e = SELF -> <:expr< ~{$_:i$ = $e$} >> + | i = V TILDEIDENT -> <:expr< ~{$_:i$} >> + | i = V QUESTIONIDENTCOLON; e = SELF -> <:expr< ?{$_:i$ = $e$} >> + | i = V QUESTIONIDENT -> <:expr< ?{$_:i$} >> ] ] + ; + expr: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:expr< ` $_:s$ >> ] ] + ; + fun_def: + [ [ p = labeled_patt; (eo, e) = SELF -> + (None, <:expr< fun [ $p$ $opt:eo$ -> $e$ ] >>) ] ] + ; + fun_binding: + [ [ p = labeled_patt; e = SELF -> <:expr< fun $p$ -> $e$ >> ] ] + ; + patt: LEVEL "simple" + [ [ "`"; s = V ident "" -> <:patt< ` $_:s$ >> + | "#"; t = V mod_ident "list" "" -> <:patt< # $_list:t$ >> + | p = labeled_patt -> p ] ] + ; + labeled_patt: + [ [ i = V TILDEIDENTCOLON; p = patt LEVEL "simple" -> + <:patt< ~{$_:i$ = $p$} >> + | i = V TILDEIDENT -> + <:patt< ~{$_:i$} >> + | "~"; "("; i = LIDENT; ")" -> + <:patt< ~{$lid:i$} >> + | "~"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ~{$lid:i$ : $t$} >> + | i = V QUESTIONIDENTCOLON; j = LIDENT -> + <:patt< ?{$_:i$ = ?{$lid:j$}} >> + | i = V QUESTIONIDENTCOLON; "_" -> + <:patt< ?{$_:i$} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; "="; e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ":"; t = ctyp; "="; + e = expr; ")" -> + <:patt< ?{$_:i$ = ?{$p$ : $t$ = $e$}} >> + | i = V QUESTIONIDENTCOLON; "("; p = patt; ")" -> + <:patt< ?{$_:i$ = ?{$p$}} >> + | i = V QUESTIONIDENT -> <:patt< ?{$_:i$} >> + | "?"; "("; i = LIDENT; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ = $e$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; "="; e = expr; ")" -> + <:patt< ?{$lid:i$ : $t$ = $e$} >> + | "?"; "("; i = LIDENT; ")" -> + <:patt< ?{$lid:i$} >> + | "?"; "("; i = LIDENT; ":"; t = ctyp; ")" -> + <:patt< ?{$lid:i$ : $t$} >> ] ] + ; + class_type: + [ [ i = LIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ~$i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENTCOLON; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> + | i = V QUESTIONIDENT; ":"; t = ctyp LEVEL "apply"; "->"; ct = SELF -> + <:class_type< [ ?$_:i$: $t$ ] -> $ct$ >> ] ] + ; + class_fun_binding: + [ [ p = labeled_patt; cfb = SELF -> <:class_expr< fun $p$ -> $cfb$ >> ] ] + ; + class_fun_def: + [ [ p = labeled_patt; "->"; ce = class_expr -> + <:class_expr< fun $p$ -> $ce$ >> + | p = labeled_patt; cfd = SELF -> + <:class_expr< fun $p$ -> $cfd$ >> ] ] + ; +END; + +(* Main entry points *) + +EXTEND + GLOBAL: interf implem use_file top_phrase expr patt; + interf: + [ [ si = sig_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:sig_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + sig_item_semi: + [ [ si = sig_item; OPT ";;" -> (si, loc) ] ] + ; + implem: + [ [ si = str_item_semi; (sil, stopped) = SELF -> ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([(<:str_item< # $lid:n$ $opt:dp$ >>, loc)], None) + | EOI -> ([], Some loc) ] ] + ; + str_item_semi: + [ [ si = str_item; OPT ";;" -> (si, loc) ] ] + ; + top_phrase: + [ [ ph = phrase; ";;" -> Some ph + | EOI -> None ] ] + ; + use_file: + [ [ si = str_item; OPT ";;"; (sil, stopped) = SELF -> + ([si :: sil], stopped) + | "#"; n = LIDENT; dp = OPT expr; ";;" -> + ([<:str_item< # $lid:n$ $opt:dp$ >>], True) + | EOI -> ([], False) ] ] + ; + phrase: + [ [ sti = str_item -> sti + | "#"; n = LIDENT; dp = OPT expr -> + <:str_item< # $lid:n$ $opt:dp$ >> ] ] + ; +END; + +Pcaml.add_option "-no_quot" (Arg.Set no_quotations) + "Don't parse quotations, allowing to use, e.g. \"<:>\" as token"; + +(* ------------------------------------------------------------------------- *) +(* Added by JRH *** *) +(* ------------------------------------------------------------------------- *) + +EXTEND + expr: AFTER "<" + [[ f = expr; "o"; g = expr -> <:expr< ((o $f$) $g$) >> + | f = expr; "upto"; g = expr -> <:expr< ((upto $f$) $g$) >> + | f = expr; "F_F"; g = expr -> <:expr< ((f_f_ $f$) $g$) >> + | f = expr; "THENC"; g = expr -> <:expr< ((thenc_ $f$) $g$) >> + | f = expr; "THEN"; g = expr -> <:expr< ((then_ $f$) $g$) >> + | f = expr; "THENL"; g = expr -> <:expr< ((thenl_ $f$) $g$) >> + | f = expr; "ORELSE"; g = expr -> <:expr< ((orelse_ $f$) $g$) >> + | f = expr; "ORELSEC"; g = expr -> <:expr< ((orelsec_ $f$) $g$) >> + | f = expr; "THEN_TCL"; g = expr -> <:expr< ((then_tcl_ $f$) $g$) >> + | f = expr; "ORELSE_TCL"; g = expr -> <:expr< ((orelse_tcl_ $f$) $g$) >> +]]; +END; + +EXTEND + top_phrase: + [ [ sti = str_item; ";;" -> + match sti with + [ <:str_item< $exp:e$ >> -> Some <:str_item< value it = $e$ >> + | x -> Some x ] ] ] + ; +END; diff --git a/pair.ml b/pair.ml new file mode 100644 index 0000000..56b938d --- /dev/null +++ b/pair.ml @@ -0,0 +1,429 @@ +(* ========================================================================= *) +(* Syntax sugaring; theory of pairing, with a bit of support. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "quot.ml";; + +(* ------------------------------------------------------------------------- *) +(* Constants implementing (or at least tagging) syntactic sugar. *) +(* ------------------------------------------------------------------------- *) + +let LET_DEF = new_definition + `LET (f:A->B) x = f x`;; + +let LET_END_DEF = new_definition + `LET_END (t:A) = t`;; + +let GABS_DEF = new_definition + `GABS (P:A->bool) = (@) P`;; + +let GEQ_DEF = new_definition + `GEQ a b = (a:A = b)`;; + +let _SEQPATTERN = new_definition + `_SEQPATTERN = \r s x. if ?y. r x y then r x else s x`;; + +let _UNGUARDED_PATTERN = new_definition + `_UNGUARDED_PATTERN = \p r. p /\ r`;; + +let _GUARDED_PATTERN = new_definition + `_GUARDED_PATTERN = \p g r. p /\ g /\ r`;; + +let _MATCH = new_definition + `_MATCH = \e r. if (?!) (r e) then (@) (r e) else @z. F`;; + +let _FUNCTION = new_definition + `_FUNCTION = \r x. if (?!) (r x) then (@) (r x) else @z. F`;; + +(* ------------------------------------------------------------------------- *) +(* Pair type. *) +(* ------------------------------------------------------------------------- *) + +let mk_pair_def = new_definition + `mk_pair (x:A) (y:B) = \a b. (a = x) /\ (b = y)`;; + +let PAIR_EXISTS_THM = prove + (`?x. ?(a:A) (b:B). x = mk_pair a b`, + MESON_TAC[]);; + +let prod_tybij = new_type_definition + "prod" ("ABS_prod","REP_prod") PAIR_EXISTS_THM;; + +let REP_ABS_PAIR = prove + (`!(x:A) (y:B). REP_prod (ABS_prod (mk_pair x y)) = mk_pair x y`, + MESON_TAC[prod_tybij]);; + +parse_as_infix (",",(14,"right"));; + +let COMMA_DEF = new_definition + `(x:A),(y:B) = ABS_prod(mk_pair x y)`;; + +let FST_DEF = new_definition + `FST (p:A#B) = @x. ?y. p = x,y`;; + +let SND_DEF = new_definition + `SND (p:A#B) = @y. ?x. p = x,y`;; + +let PAIR_EQ = prove + (`!(x:A) (y:B) a b. (x,y = a,b) <=> (x = a) /\ (y = b)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[COMMA_DEF] THEN + DISCH_THEN(MP_TAC o AP_TERM `REP_prod:A#B->A->B->bool`) THEN + REWRITE_TAC[REP_ABS_PAIR] THEN REWRITE_TAC[mk_pair_def; FUN_EQ_THM]; + ALL_TAC] THEN + MESON_TAC[]);; + +let PAIR_SURJECTIVE = prove + (`!p:A#B. ?x y. p = x,y`, + GEN_TAC THEN REWRITE_TAC[COMMA_DEF] THEN + MP_TAC(SPEC `REP_prod p :A->B->bool` (CONJUNCT2 prod_tybij)) THEN + REWRITE_TAC[CONJUNCT1 prod_tybij] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` (X_CHOOSE_THEN `b:B` MP_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `ABS_prod:(A->B->bool)->A#B`) THEN + REWRITE_TAC[CONJUNCT1 prod_tybij] THEN DISCH_THEN SUBST1_TAC THEN + MAP_EVERY EXISTS_TAC [`a:A`; `b:B`] THEN REFL_TAC);; + +let FST = prove + (`!(x:A) (y:B). FST(x,y) = x`, + REPEAT GEN_TAC THEN REWRITE_TAC[FST_DEF] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN BETA_TAC THEN + REWRITE_TAC[PAIR_EQ] THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `y:B` THEN ASM_REWRITE_TAC[]);; + +let SND = prove + (`!(x:A) (y:B). SND(x,y) = y`, + REPEAT GEN_TAC THEN REWRITE_TAC[SND_DEF] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN GEN_TAC THEN BETA_TAC THEN + REWRITE_TAC[PAIR_EQ] THEN EQ_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);; + +let PAIR = prove + (`!x:A#B. FST x,SND x = x`, + GEN_TAC THEN + (X_CHOOSE_THEN `a:A` (X_CHOOSE_THEN `b:B` SUBST1_TAC) + (SPEC `x:A#B` PAIR_SURJECTIVE)) THEN + REWRITE_TAC[FST; SND]);; + +let pair_INDUCT = prove + (`!P. (!x y. P (x,y)) ==> !p. P p`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM PAIR] THEN + FIRST_ASSUM MATCH_ACCEPT_TAC);; + +let pair_RECURSION = prove + (`!PAIR'. ?fn:A#B->C. !a0 a1. fn (a0,a1) = PAIR' a0 a1`, + GEN_TAC THEN EXISTS_TAC `\p. (PAIR':A->B->C) (FST p) (SND p)` THEN + REWRITE_TAC[FST; SND]);; + +(* ------------------------------------------------------------------------- *) +(* Syntax operations. *) +(* ------------------------------------------------------------------------- *) + +let is_pair = is_binary ",";; + +let dest_pair = dest_binary ",";; + +let mk_pair = + let ptm = mk_const(",",[]) in + fun (l,r) -> mk_comb(mk_comb(inst [type_of l,aty; type_of r,bty] ptm,l),r);; + +(* ------------------------------------------------------------------------- *) +(* Extend basic rewrites; extend new_definition to allow paired varstructs. *) +(* ------------------------------------------------------------------------- *) + +extend_basic_rewrites [FST; SND; PAIR];; + +(* ------------------------------------------------------------------------- *) +(* Extend definitions to paired varstructs with benignity checking. *) +(* ------------------------------------------------------------------------- *) + +let the_definitions = ref + [SND_DEF; FST_DEF; COMMA_DEF; mk_pair_def; GEQ_DEF; GABS_DEF; + LET_END_DEF; LET_DEF; one_DEF; I_DEF; o_DEF; COND_DEF; _FALSITY_; + EXISTS_UNIQUE_DEF; NOT_DEF; F_DEF; OR_DEF; EXISTS_DEF; FORALL_DEF; IMP_DEF; + AND_DEF; T_DEF];; + +let new_definition = + let depair = + let rec depair gv arg = + try let l,r = dest_pair arg in + (depair (list_mk_icomb "FST" [gv]) l) @ + (depair (list_mk_icomb "SND" [gv]) r) + with Failure _ -> [gv,arg] in + fun arg -> let gv = genvar(type_of arg) in + gv,depair gv arg in + fun tm -> + let avs,def = strip_forall tm in + try let th,th' = tryfind (fun th -> th,PART_MATCH I th def) + (!the_definitions) in + ignore(PART_MATCH I th' (snd(strip_forall(concl th)))); + warn true "Benign redefinition"; GEN_ALL (GENL avs th') + with Failure _ -> + let l,r = dest_eq def in + let fn,args = strip_comb l in + let gargs,reps = (I F_F unions) (unzip(map depair args)) in + let l' = list_mk_comb(fn,gargs) and r' = subst reps r in + let th1 = new_definition (mk_eq(l',r')) in + let slist = zip args gargs in + let th2 = INST slist (SPEC_ALL th1) in + let xreps = map (subst slist o fst) reps in + let threps = map (SYM o PURE_REWRITE_CONV[FST; SND]) xreps in + let th3 = TRANS th2 (SYM(SUBS_CONV threps r)) in + let th4 = GEN_ALL (GENL avs th3) in + the_definitions := th4::(!the_definitions); th4;; + +(* ------------------------------------------------------------------------- *) +(* A few more useful definitions. *) +(* ------------------------------------------------------------------------- *) + +let CURRY_DEF = new_definition + `CURRY(f:A#B->C) x y = f(x,y)`;; + +let UNCURRY_DEF = new_definition + `!f x y. UNCURRY(f:A->B->C)(x,y) = f x y`;; + +let PASSOC_DEF = new_definition + `!f x y z. PASSOC (f:(A#B)#C->D) (x,y,z) = f ((x,y),z)`;; + +(* ------------------------------------------------------------------------- *) +(* Analog of ABS_CONV for generalized abstraction. *) +(* ------------------------------------------------------------------------- *) + +let GABS_CONV conv tm = + if is_abs tm then ABS_CONV conv tm else + let gabs,bod = dest_comb tm in + let f,qtm = dest_abs bod in + let xs,bod = strip_forall qtm in + AP_TERM gabs (ABS f (itlist MK_FORALL xs (RAND_CONV conv bod)));; + +(* ------------------------------------------------------------------------- *) +(* General beta-conversion over linear pattern of nested constructors. *) +(* ------------------------------------------------------------------------- *) + +let GEN_BETA_CONV = + let projection_cache = ref [] in + let create_projections conname = + try assoc conname (!projection_cache) with Failure _ -> + let genty = get_const_type conname in + let conty = fst(dest_type(repeat (snd o dest_fun_ty) genty)) in + let _,_,rth = assoc conty (!inductive_type_store) in + let sth = SPEC_ALL rth in + let evs,bod = strip_exists(concl sth) in + let cjs = conjuncts bod in + let ourcj = find ((=)conname o fst o dest_const o fst o strip_comb o + rand o lhand o snd o strip_forall) cjs in + let n = index ourcj cjs in + let avs,eqn = strip_forall ourcj in + let con',args = strip_comb(rand eqn) in + let aargs,zargs = chop_list (length avs) args in + let gargs = map (genvar o type_of) zargs in + let gcon = genvar(itlist (mk_fun_ty o type_of) avs (type_of(rand eqn))) in + let bth = + INST [list_mk_abs(aargs @ gargs,list_mk_comb(gcon,avs)),con'] sth in + let cth = el n (CONJUNCTS(ASSUME(snd(strip_exists(concl bth))))) in + let dth = CONV_RULE (funpow (length avs) BINDER_CONV + (RAND_CONV(BETAS_CONV))) cth in + let eth = SIMPLE_EXISTS (rator(lhand(snd(strip_forall(concl dth))))) dth in + let fth = PROVE_HYP bth (itlist SIMPLE_CHOOSE evs eth) in + let zty = type_of (rand(snd(strip_forall(concl dth)))) in + let mk_projector a = + let ity = type_of a in + let th = BETA_RULE(PINST [ity,zty] [list_mk_abs(avs,a),gcon] fth) in + SYM(SPEC_ALL(SELECT_RULE th)) in + let ths = map mk_projector avs in + (projection_cache := (conname,ths)::(!projection_cache); ths) in + let GEQ_CONV = REWR_CONV(GSYM GEQ_DEF) + and DEGEQ_RULE = CONV_RULE(REWR_CONV GEQ_DEF) in + let GABS_RULE = + let pth = prove + (`(?) P ==> P (GABS P)`, + SIMP_TAC[GABS_DEF; SELECT_AX; ETA_AX]) in + MATCH_MP pth in + let rec create_iterated_projections tm = + if frees tm = [] then [] + else if is_var tm then [REFL tm] else + let con,args = strip_comb tm in + let prjths = create_projections (fst(dest_const con)) in + let atm = rand(rand(concl(hd prjths))) in + let instn = term_match [] atm tm in + let arths = map (INSTANTIATE instn) prjths in + let ths = map (fun arth -> + let sths = create_iterated_projections (lhand(concl arth)) in + map (CONV_RULE(RAND_CONV(SUBS_CONV[arth]))) sths) arths in + unions' equals_thm ths in + let GEN_BETA_CONV tm = + try BETA_CONV tm with Failure _ -> + let l,r = dest_comb tm in + let vstr,bod = dest_gabs l in + let instn = term_match [] vstr r in + let prjs = create_iterated_projections vstr in + let th1 = SUBS_CONV prjs bod in + let bod' = rand(concl th1) in + let gv = genvar(type_of vstr) in + let pat = mk_abs(gv,subst[gv,vstr] bod') in + let th2 = TRANS (BETA_CONV (mk_comb(pat,vstr))) (SYM th1) in + let avs = fst(strip_forall(body(rand l))) in + let th3 = GENL (fst(strip_forall(body(rand l)))) th2 in + let efn = genvar(type_of pat) in + let th4 = EXISTS(mk_exists(efn,subst[efn,pat] (concl th3)),pat) th3 in + let th5 = CONV_RULE(funpow (length avs + 1) BINDER_CONV GEQ_CONV) th4 in + let th6 = CONV_RULE BETA_CONV (GABS_RULE th5) in + INSTANTIATE instn (DEGEQ_RULE (SPEC_ALL th6)) in + GEN_BETA_CONV;; + +(* ------------------------------------------------------------------------- *) +(* Add this to the basic "rewrites" and pairs to the inductive type store. *) +(* ------------------------------------------------------------------------- *) + +extend_basic_convs("GEN_BETA_CONV",(`GABS (\a. b) c`,GEN_BETA_CONV));; + +inductive_type_store := + ("prod",(1,pair_INDUCT,pair_RECURSION))::(!inductive_type_store);; + +(* ------------------------------------------------------------------------- *) +(* Convenient rules to eliminate binders over pairs. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_PAIR_THM = prove + (`!P. (!p. P p) <=> (!p1 p2. P(p1,p2))`, + MESON_TAC[PAIR]);; + +let EXISTS_PAIR_THM = prove + (`!P. (?p. P p) <=> ?p1 p2. P(p1,p2)`, + MESON_TAC[PAIR]);; + +let LAMBDA_PAIR_THM = prove + (`!t. (\p. t p) = (\(x,y). t(x,y))`, + REWRITE_TAC[FORALL_PAIR_THM; FUN_EQ_THM]);; + +let PAIRED_ETA_THM = prove + (`(!f. (\(x,y). f (x,y)) = f) /\ + (!f. (\(x,y,z). f (x,y,z)) = f) /\ + (!f. (\(w,x,y,z). f (w,x,y,z)) = f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; + +let FORALL_UNCURRY = prove + (`!P. (!f:A->B->C. P f) <=> (!f. P (\a b. f(a,b)))`, + GEN_TAC THEN EQ_TAC THEN SIMP_TAC[] THEN DISCH_TAC THEN + X_GEN_TAC `f:A->B->C` THEN + FIRST_ASSUM(MP_TAC o SPEC `\(a,b). (f:A->B->C) a b`) THEN SIMP_TAC[ETA_AX]);; + +let EXISTS_UNCURRY = prove + (`!P. (?f:A->B->C. P f) <=> (?f. P (\a b. f(a,b)))`, + ONCE_REWRITE_TAC[MESON[] `(?x. P x) <=> ~(!x. ~P x)`] THEN + REWRITE_TAC[FORALL_UNCURRY]);; + +let EXISTS_CURRY = prove + (`!P. (?f. P f) <=> (?f. P (\(a,b). f a b))`, + REWRITE_TAC[EXISTS_UNCURRY; PAIRED_ETA_THM]);; + +let FORALL_CURRY = prove + (`!P. (!f. P f) <=> (!f. P (\(a,b). f a b))`, + REWRITE_TAC[FORALL_UNCURRY; PAIRED_ETA_THM]);; + +let FORALL_UNPAIR_THM = prove + (`!P. (!x y. P x y) <=> !z. P (FST z) (SND z)`, + REWRITE_TAC[FORALL_PAIR_THM; FST; SND] THEN MESON_TAC[]);; + +let EXISTS_UNPAIR_THM = prove + (`!P. (?x y. P x y) <=> ?z. P (FST z) (SND z)`, + REWRITE_TAC[EXISTS_PAIR_THM; FST; SND] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Related theorems for explicitly paired quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_PAIRED_THM = prove + (`!P. (!(x,y). P x y) <=> (!x y. P x y)`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [FORALL_DEF] THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; + +let EXISTS_PAIRED_THM = prove + (`!P. (?(x,y). P x y) <=> (?x y. P x y)`, + GEN_TAC THEN MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] NOT_EXISTS_THM; FORALL_PAIR_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Likewise for tripled quantifiers (could continue with the same proof). *) +(* ------------------------------------------------------------------------- *) + +let FORALL_TRIPLED_THM = prove + (`!P. (!(x,y,z). P x y z) <=> (!x y z. P x y z)`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV) [FORALL_DEF] THEN + REWRITE_TAC[FUN_EQ_THM; FORALL_PAIR_THM]);; + +let EXISTS_TRIPLED_THM = prove + (`!P. (?(x,y,z). P x y z) <=> (?x y z. P x y z)`, + GEN_TAC THEN MATCH_MP_TAC(TAUT `(~p <=> ~q) ==> (p <=> q)`) THEN + REWRITE_TAC[REWRITE_RULE[ETA_AX] NOT_EXISTS_THM; FORALL_PAIR_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Expansion of a let-term. *) +(* ------------------------------------------------------------------------- *) + +let let_CONV = + let let1_CONV = REWR_CONV LET_DEF THENC GEN_BETA_CONV + and lete_CONV = REWR_CONV LET_END_DEF in + let rec EXPAND_BETAS_CONV tm = + let tm' = rator tm in + try let1_CONV tm with Failure _ -> + let th1 = AP_THM (EXPAND_BETAS_CONV tm') (rand tm) in + let th2 = GEN_BETA_CONV (rand(concl th1)) in + TRANS th1 th2 in + fun tm -> + let ltm,pargs = strip_comb tm in + if fst(dest_const ltm) <> "LET" or pargs = [] then failwith "let_CONV" else + let abstm = hd pargs in + let vs,bod = strip_gabs abstm in + let es = tl pargs in + let n = length es in + if length vs <> n then failwith "let_CONV" else + (EXPAND_BETAS_CONV THENC lete_CONV) tm;; + +let (LET_TAC:tactic) = + let is_trivlet tm = + try let assigs,bod = dest_let tm in + forall (uncurry (=)) assigs + with Failure _ -> false + and PROVE_DEPAIRING_EXISTS = + let pth = prove + (`((x,y) = a) <=> (x = FST a) /\ (y = SND a)`, + MESON_TAC[PAIR; PAIR_EQ]) in + let rewr1_CONV = GEN_REWRITE_CONV TOP_DEPTH_CONV [pth] + and rewr2_RULE = GEN_REWRITE_RULE (LAND_CONV o DEPTH_CONV) + [TAUT `(x = x) <=> T`; TAUT `a /\ T <=> a`] in + fun tm -> + let th1 = rewr1_CONV tm in + let tm1 = rand(concl th1) in + let cjs = conjuncts tm1 in + let vars = map lhand cjs in + let th2 = EQ_MP (SYM th1) (ASSUME tm1) in + let th3 = DISCH_ALL (itlist SIMPLE_EXISTS vars th2) in + let th4 = INST (map (fun t -> rand t,lhand t) cjs) th3 in + MP (rewr2_RULE th4) TRUTH in + fun (asl,w as gl) -> + let path = try find_path is_trivlet w + with Failure _ -> find_path is_let w in + let tm = follow_path path w in + let assigs,bod = dest_let tm in + let abbrevs = + mapfilter (fun (x,y) -> if x = y then fail() else mk_eq(x,y)) assigs in + let lvars = itlist (union o frees o lhs) abbrevs [] + and avoids = itlist (union o thm_frees o snd) asl (frees w) in + let rename = vsubst (zip (variants avoids lvars) lvars) in + let abbrevs' = map (fun eq -> let l,r = dest_eq eq in mk_eq(rename l,r)) + abbrevs in + let deprths = map PROVE_DEPAIRING_EXISTS abbrevs' in + (MAP_EVERY (REPEAT_TCL CHOOSE_THEN + (fun th -> let th' = SYM th in + SUBST_ALL_TAC th' THEN ASSUME_TAC th')) deprths THEN + W(fun (asl',w') -> + let tm' = follow_path path w' in + CONV_TAC(PATH_CONV path (K(let_CONV tm'))))) gl;; diff --git a/parser.ml b/parser.ml new file mode 100644 index 0000000..7860fa2 --- /dev/null +++ b/parser.ml @@ -0,0 +1,518 @@ +(* ========================================================================= *) +(* Lexical analyzer, type and preterm parsers. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "preterm.ml";; + +(* ------------------------------------------------------------------------- *) +(* Need to have this now for set enums, since "," isn't a reserved word. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix (",",(14,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Basic parser combinators. *) +(* ------------------------------------------------------------------------- *) + +exception Noparse;; + +let (||) parser1 parser2 input = + try parser1 input + with Noparse -> parser2 input;; + +let (++) parser1 parser2 input = + let result1,rest1 = parser1 input in + let result2,rest2 = parser2 rest1 in + (result1,result2),rest2;; + +let rec many prs input = + try let result,next = prs input in + let results,rest = many prs next in + (result::results),rest + with Noparse -> [],input;; + +let (>>) prs treatment input = + let result,rest = prs input in + treatment(result),rest;; + +let fix err prs input = + try prs input + with Noparse -> failwith (err ^ " expected");; + +let rec listof prs sep err = + prs ++ many (sep ++ fix err prs >> snd) >> (fun (h,t) -> h::t);; + +let nothing input = [],input;; + +let elistof prs sep err = + listof prs sep err || nothing;; + +let leftbin prs sep cons err = + prs ++ many (sep ++ fix err prs) >> + (fun (x,opxs) -> let ops,xs = unzip opxs in + itlist2 (fun op y x -> cons op x y) (rev ops) (rev xs) x);; + +let rightbin prs sep cons err = + prs ++ many (sep ++ fix err prs) >> + (fun (x,opxs) -> if opxs = [] then x else + let ops,xs = unzip opxs in + itlist2 cons ops (x::butlast xs) (last xs));; + +let possibly prs input = + try let x,rest = prs input in [x],rest + with Noparse -> [],input;; + +let some p = + function + [] -> raise Noparse + | (h::t) -> if p h then (h,t) else raise Noparse;; + +let a tok = some (fun item -> item = tok);; + +let rec atleast n prs i = + (if n <= 0 then many prs + else prs ++ atleast (n - 1) prs >> (fun (h,t) -> h::t)) i;; + +let finished input = + if input = [] then 0,input else failwith "Unparsed input";; + +(* ------------------------------------------------------------------------- *) +(* The basic lexical classes: identifiers, strings and reserved words. *) +(* ------------------------------------------------------------------------- *) + +type lexcode = Ident of string + | Resword of string;; + +(* ------------------------------------------------------------------------- *) +(* Lexical analyzer. Apart from some special bracket symbols, each *) +(* identifier is made up of the longest string of alphanumerics or *) +(* the longest string of symbolics. *) +(* ------------------------------------------------------------------------- *) + +reserve_words ["//"];; + +let comment_token = ref (Resword "//");; + +let lex = + let collect (h,t) = end_itlist (^) (h::t) in + let reserve = + function + (Ident n as tok) -> + if is_reserved_word n then Resword(n) else tok + | t -> t in + let stringof p = atleast 1 p >> end_itlist (^) in + let simple_ident = stringof(some isalnum) || stringof(some issymb) in + let undertail = stringof (a "_") ++ possibly simple_ident >> collect in + let ident = (undertail || simple_ident) ++ many undertail >> collect in + let septok = stringof(some issep) in + let escapecode i = + match i with + "\\"::rst -> "\\",rst + | "\""::rst -> "\"",rst + | "\'"::rst -> "\'",rst + | "n"::rst -> "\n",rst + | "r"::rst -> "\r",rst + | "t"::rst -> "\t",rst + | "b"::rst -> "\b",rst + | " "::rst -> " ",rst + | "x"::h::l::rst -> + String.make 1 (Char.chr(int_of_string("0x"^h^l))),rst + | a::b::c::rst when forall isnum [a;b;c] -> + String.make 1 (Char.chr(int_of_string(a^b^c))),rst + | _ -> failwith "lex:unrecognized OCaml-style escape in string" in + let stringchar = + some (fun i -> i <> "\\" & i <> "\"") + || (a "\\" ++ escapecode >> snd) in + let string = a "\"" ++ many stringchar ++ a "\"" >> + (fun ((_,s),_) -> "\""^implode s^"\"") in + let rawtoken = (string || some isbra || septok || ident) >> + (fun x -> Ident x) in + let simptoken = many (some isspace) ++ rawtoken >> (reserve o snd) in + let rec tokens i = + try let (t,rst) = simptoken i in + if t = !comment_token then + (many (fun i -> if i <> [] & hd i <> "\n" then 1,tl i + else raise Noparse) ++ tokens >> snd) rst + else + let toks,rst1 = tokens rst in t::toks,rst1 + with Noparse -> [],i in + fst o (tokens ++ many (some isspace) ++ finished >> (fst o fst));; + +(* ------------------------------------------------------------------------- *) +(* Parser for pretypes. Concrete syntax: *) +(* *) +(* TYPE :: SUMTYPE -> TYPE *) +(* | SUMTYPE *) +(* *) +(* SUMTYPE :: PRODTYPE + SUMTYPE *) +(* | PRODTYPE *) +(* *) +(* PRODTYPE :: POWTYPE # PRODTYPE *) +(* | POWTYPE *) +(* *) +(* POWTYPE :: APPTYPE ^ POWTYPE *) +(* | APPTYPE *) +(* *) +(* APPTYPE :: ATOMICTYPES type-constructor [Provided arity matches] *) +(* | ATOMICTYPES [Provided only 1 ATOMICTYPE] *) +(* *) +(* ATOMICTYPES :: type-constructor [Provided arity zero] *) +(* | type-variable *) +(* | ( TYPE ) *) +(* | ( TYPE LIST ) *) +(* *) +(* TYPELIST :: TYPE , TYPELIST *) +(* | TYPE *) +(* *) +(* Two features make this different from previous HOL type syntax: *) +(* *) +(* o Any identifier not in use as a type constant will be parsed as a *) +(* type variable; a ' is not needed and a * is not allowed. *) +(* *) +(* o Antiquotation is not supported. *) +(* ------------------------------------------------------------------------- *) + +let parse_pretype = + let btyop n n' x y = Ptycon(n,[x;y]) + and mk_apptype = + function + ([s],[]) -> s + | (tys,[c]) -> Ptycon(c,tys) + | _ -> failwith "Bad type construction" + and type_atom input = + match input with + (Ident s)::rest -> + (try pretype_of_type(assoc s (type_abbrevs())) with Failure _ -> + if try get_type_arity s = 0 with Failure _ -> false + then Ptycon(s,[]) else Utv(s)),rest + | _ -> raise Noparse + and type_constructor input = + match input with + (Ident s)::rest -> if try get_type_arity s > 0 with Failure _ -> false + then s,rest else raise Noparse + | _ -> raise Noparse in + let rec pretype i = rightbin sumtype (a (Resword "->")) (btyop "fun") "type" i + and sumtype i = rightbin prodtype (a (Ident "+")) (btyop "sum") "type" i + and prodtype i = rightbin carttype (a (Ident "#")) (btyop "prod") "type" i + and carttype i = leftbin apptype (a (Ident "^")) (btyop "cart") "type" i + and apptype i = (atomictypes ++ (type_constructor >> (fun x -> [x]) + || nothing) >> mk_apptype) i + and atomictypes i = + (((a (Resword "(")) ++ typelist ++ a (Resword ")") >> (snd o fst)) + || type_atom >> (fun x -> [x])) i + and typelist i = listof pretype (a (Ident ",")) "type" i in + pretype;; + +(* ------------------------------------------------------------------------- *) +(* Hook to allow installation of user parsers. *) +(* ------------------------------------------------------------------------- *) + +let install_parser,delete_parser,installed_parsers,try_user_parser = + let rec try_parsers ps i = + if ps = [] then raise Noparse else + try snd(hd ps) i with Noparse -> try_parsers (tl ps) i in + let parser_list = + ref([]:(string*(lexcode list -> preterm * lexcode list))list) in + (fun dat -> parser_list := dat::(!parser_list)), + (fun key -> try parser_list := snd (remove (fun (key',_) -> key = key') + (!parser_list)) + with Failure _ -> ()), + (fun () -> !parser_list), + (fun i -> try_parsers (!parser_list) i);; + +(* ------------------------------------------------------------------------- *) +(* Initial preterm parsing. This uses binder and precedence/associativity/ *) +(* prefix status to guide parsing and preterm construction, but treats all *) +(* identifiers as variables. *) +(* *) +(* PRETERM :: APPL_PRETERM binop APPL_PRETERM *) +(* | APPL_PRETERM *) +(* *) +(* APPL_PRETERM :: APPL_PRETERM : type *) +(* | APPL_PRETERM BINDER_PRETERM *) +(* | BINDER_PRETERM *) +(* *) +(* BINDER_PRETERM :: binder VARSTRUCT_PRETERMS . PRETERM *) +(* | let PRETERM and ... and PRETERM in PRETERM *) +(* | ATOMIC_PRETERM *) +(* *) +(* VARSTRUCT_PRETERMS :: TYPED_PRETERM VARSTRUCT_PRETERMS *) +(* | TYPED_PRETERM *) +(* *) +(* TYPED_PRETERM :: TYPED_PRETERM : type *) +(* | ATOMIC_PRETERM *) +(* *) +(* ATOMIC_PRETERM :: ( PRETERM ) *) +(* | if PRETERM then PRETERM else PRETERM *) +(* | [ PRETERM; .. ; PRETERM ] *) +(* | { PRETERM, .. , PRETERM } *) +(* | { PRETERM | PRETERM } *) +(* | identifier *) +(* *) +(* Note that arbitrary preterms are allowed as varstructs. This allows *) +(* more general forms of matching and considerably regularizes the syntax. *) +(* ------------------------------------------------------------------------- *) + +let parse_preterm = + let rec pairwise r l = + match l with + [] -> true + | h::t -> forall (r h) t & pairwise r t in + let rec pfrees ptm acc = + match ptm with + Varp(v,pty) -> + if v = "" & pty = dpty then acc + else if can get_const_type v or can num_of_string v + or exists (fun (w,_) -> v = w) (!the_interface) then acc + else insert ptm acc + | Constp(_,_) -> acc + | Combp(p1,p2) -> pfrees p1 (pfrees p2 acc) + | Absp(p1,p2) -> subtract (pfrees p2 acc) (pfrees p1 []) + | Typing(p,_) -> pfrees p acc in + let pdest_eq (Combp(Combp(Varp(("="|"<=>"),_),l),r)) = l,r in + let pmk_let (letbindings,body) = + let vars,tms = unzip (map pdest_eq letbindings) in + let _ = warn(not + (pairwise (fun s t -> intersect(pfrees s []) (pfrees t []) = []) vars)) + "duplicate names on left of let-binding: latest is used" in + let lend = Combp(Varp("LET_END",dpty),body) in + let abs = itlist (fun v t -> Absp(v,t)) vars lend in + let labs = Combp(Varp("LET",dpty),abs) in + rev_itlist (fun x f -> Combp(f,x)) tms labs in + let pmk_vbinder(n,v,bod) = + if n = "\\" then Absp(v,bod) + else Combp(Varp(n,dpty),Absp(v,bod)) in + let pmk_binder(n,vs,bod) = + itlist (fun v b -> pmk_vbinder(n,v,b)) vs bod in + let pmk_set_enum ptms = + itlist (fun x t -> Combp(Combp(Varp("INSERT",dpty),x),t)) ptms + (Varp("EMPTY",dpty)) in + let pgenvar = + let gcounter = ref 0 in + fun () -> let count = !gcounter in + (gcounter := count + 1; + Varp("GEN%PVAR%"^(string_of_int count),dpty)) in + let pmk_exists(v,ptm) = Combp(Varp("?",dpty),Absp(v,ptm)) in + let pmk_list els = + itlist (fun x y -> Combp(Combp(Varp("CONS",dpty),x),y)) + els (Varp("NIL",dpty)) in + let pmk_bool = + let tt = Varp("T",dpty) and ff = Varp("F",dpty) in + fun b -> if b then tt else ff in + let pmk_char c = + let lis = map (fun i -> pmk_bool((c / (1 lsl i)) mod 2 = 1)) (0--7) in + itlist (fun x y -> Combp(y,x)) lis (Varp("ASCII",dpty)) in + let pmk_string s = + let ns = map (fun i -> Char.code(String.get s i)) + (0--(String.length s - 1)) in + pmk_list(map pmk_char ns) in + let pmk_setcompr (fabs,bvs,babs) = + let v = pgenvar() in + let bod = itlist (curry pmk_exists) bvs + (Combp(Combp(Combp(Varp("SETSPEC",dpty),v),babs),fabs)) in + Combp(Varp("GSPEC",dpty),Absp(v,bod)) in + let pmk_setabs (fabs,babs) = + let evs = + let fvs = pfrees fabs [] + and bvs = pfrees babs [] in + if length fvs <= 1 or bvs = [] then fvs + else intersect fvs bvs in + pmk_setcompr (fabs,evs,babs) in + let rec mk_precedence infxs prs inp = + match infxs with + (s,(p,at))::_ -> + let topins,rest = partition (fun (s',pat') -> pat' = (p,at)) infxs in + (if at = "right" then rightbin else leftbin) + (mk_precedence rest prs) + (end_itlist (||) (map (fun (s,_) -> a (Ident s)) topins)) + (fun (Ident op) x y -> Combp(Combp(Varp(op,dpty),x),y)) + ("term after binary operator") + inp + | _ -> prs inp in + let pmk_geq s t = Combp(Combp(Varp("GEQ",dpty),s),t) in + let pmk_pattern ((pat,guards),res) = + let x = pgenvar() and y = pgenvar() in + let vs = pfrees pat [] + and bod = + if guards = [] then + Combp(Combp(Varp("_UNGUARDED_PATTERN",dpty),pmk_geq pat x), + pmk_geq res y) + else + Combp(Combp(Combp(Varp("_GUARDED_PATTERN",dpty),pmk_geq pat x), + hd guards), + pmk_geq res y) in + Absp(x,Absp(y,itlist (curry pmk_exists) vs bod)) in + let pretype = parse_pretype + and string inp = + match inp with + Ident s::rst when String.length s >= 2 & + String.sub s 0 1 = "\"" & + String.sub s (String.length s - 1) 1 = "\"" + -> String.sub s 1 (String.length s - 2),rst + | _ -> raise Noparse + and singleton1 x = [x] + and lmk_ite (((((_,b),_),l),_),r) = + Combp(Combp(Combp(Varp("COND",dpty),b),l),r) + and lmk_typed = + function (p,[]) -> p | (p,[ty]) -> Typing(p,ty) | _ -> fail() + and lmk_let (((_,bnds),_),ptm) = pmk_let (bnds,ptm) + and lmk_binder ((((s,h),t),_),p) = pmk_binder(s,h::t,p) + and lmk_setenum(l,_) = pmk_set_enum l + and lmk_setabs(((l,_),r),_) = pmk_setabs(l,r) + and lmk_setcompr(((((f,_),vs),_),b),_) = + pmk_setcompr(f,pfrees vs [],b) + and lmk_decimal ((_,l0),ropt) = + let l,r = if ropt = [] then l0,"1" else + let r0 = hd ropt in + let n_l = num_of_string l0 + and n_r = num_of_string r0 in + let n_d = power_num (Int 10) (Int (String.length r0)) in + let n_n = n_l */ n_d +/ n_r in + string_of_num n_n,string_of_num n_d in + Combp(Combp(Varp("DECIMAL",dpty),Varp(l,dpty)),Varp(r,dpty)) + and lmk_univ((_,pty),_) = + Typing(Varp("UNIV",dpty),Ptycon("fun",[pty;Ptycon("bool",[])])) + and any_identifier = + function + ((Ident s):: rest) -> s,rest + | _ -> raise Noparse + and identifier = + function + ((Ident s):: rest) -> + if can get_infix_status s or is_prefix s or parses_as_binder s + then raise Noparse else s,rest + | _ -> raise Noparse + and binder = + function + ((Ident s):: rest) -> + if parses_as_binder s then s,rest else raise Noparse + | _ -> raise Noparse + and pre_fix = + function + ((Ident s):: rest) -> + if is_prefix s then s,rest else raise Noparse + | _ -> raise Noparse in + let rec preterm i = + mk_precedence (infixes()) typed_appl_preterm i + and nocommapreterm i = + let infs = filter (fun (s,_) -> s <> ",") (infixes()) in + mk_precedence infs typed_appl_preterm i + and typed_appl_preterm i = + (appl_preterm ++ + possibly (a (Resword ":") ++ pretype >> snd) + >> lmk_typed) i + and appl_preterm i = + (pre_fix ++ appl_preterm + >> (fun (x,y) -> Combp(Varp(x,dpty),y)) + || binder_preterm ++ many binder_preterm >> + (fun (h,t) -> itlist (fun x y -> Combp(y,x)) (rev t) h)) i + and binder_preterm i = + (a (Resword "let") ++ + leftbin (preterm >> singleton1) (a (Resword "and")) (K (@)) "binding" ++ + a (Resword "in") ++ + preterm + >> lmk_let + || binder ++ + typed_apreterm ++ + many typed_apreterm ++ + a (Resword ".") ++ + preterm + >> lmk_binder + || atomic_preterm) i + and typed_apreterm i = + (atomic_preterm ++ + possibly (a (Resword ":") ++ pretype >> snd) + >> lmk_typed) i + and atomic_preterm i = + (try_user_parser + || (a (Resword "(") ++ a (Resword ":")) ++ pretype ++ a (Resword ")") + >> lmk_univ + || string + >> pmk_string + || a (Resword "(") ++ + (any_identifier >> (fun s -> Varp(s,dpty))) ++ + a (Resword ")") + >> (snd o fst) + || a (Resword "(") ++ + preterm ++ + a (Resword ")") + >> (snd o fst) + || a (Resword "if") ++ + preterm ++ + a (Resword "then") ++ + preterm ++ + a (Resword "else") ++ + preterm + >> lmk_ite + || a (Resword "[") ++ + elistof preterm (a (Resword ";")) "term" ++ + a (Resword "]") + >> (pmk_list o snd o fst) + || a (Resword "{") ++ + (elistof nocommapreterm (a (Ident ",")) "term" ++ a (Resword "}") + >> lmk_setenum + || preterm ++ a (Resword "|") ++ preterm ++ a (Resword "}") + >> lmk_setabs + || preterm ++ a (Resword "|") ++ preterm ++ + a (Resword "|") ++ preterm ++ a (Resword "}") + >> lmk_setcompr) + >> snd + || a (Resword "match") ++ preterm ++ a (Resword "with") ++ clauses + >> (fun (((_,e),_),c) -> Combp(Combp(Varp("_MATCH",dpty),e),c)) + || a (Resword "function") ++ clauses + >> (fun (_,c) -> Combp(Varp("_FUNCTION",dpty),c)) + || a (Ident "#") ++ identifier ++ + possibly (a (Resword ".") ++ identifier >> snd) + >> lmk_decimal + || identifier + >> (fun s -> Varp(s,dpty))) i + and pattern i = + (preterm ++ possibly (a (Resword "when") ++ preterm >> snd)) i + and clause i = + ((pattern ++ (a (Resword "->") ++ preterm >> snd)) >> pmk_pattern) i + and clauses i = + ((possibly (a (Resword "|")) ++ + listof clause (a (Resword "|")) "pattern-match clause" >> snd) + >> end_itlist (fun s t -> Combp(Combp(Varp("_SEQPATTERN",dpty),s),t))) i in + (fun inp -> + match inp with + [Ident s] -> Varp(s,dpty),[] + | _ -> preterm inp);; + +(* ------------------------------------------------------------------------- *) +(* Type and term parsers. *) +(* ------------------------------------------------------------------------- *) + +let parse_type s = + let pty,l = (parse_pretype o lex o explode) s in + if l = [] then type_of_pretype pty + else failwith "Unparsed input following type";; + +let parse_term s = + let ptm,l = (parse_preterm o lex o explode) s in + if l = [] then + (term_of_preterm o (retypecheck [])) ptm + else failwith "Unparsed input following term";; + +let retyvar_funny tm = + let tvs = type_vars_in_term tm in + let (tvsgood, tvsbad) = List.partition (fun ty -> try (dest_vartype ty).[0] <> '?' with _ -> false) tvs in + let tyvno = ref (-1) in + let rec nexttv () = + incr tyvno; + let ret = mk_vartype ("?" ^ string_of_int !tyvno) in + if List.mem ret tvsgood then nexttv () else ret + in + let ins = List.map (fun x -> (nexttv (),x)) tvsbad in + inst ins tm +;; + +let parse_term s = + let tm = parse_term s in + if type_of tm = bool_ty then retyvar_funny tm else tm +;; diff --git a/preterm.ml b/preterm.ml new file mode 100644 index 0000000..8b690e7 --- /dev/null +++ b/preterm.ml @@ -0,0 +1,450 @@ +(* ========================================================================= *) +(* Preterms and pretypes; typechecking; translation to types and terms. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* (c) Copyright, Marco Maggesi 2012 *) +(* (c) Copyright, Vincent Aravantinos 2012 *) +(* ========================================================================= *) + +needs "printer.ml";; + +(* ------------------------------------------------------------------------- *) +(* Flag to say whether to treat varstruct "\const. bod" as variable. *) +(* ------------------------------------------------------------------------- *) + +let ignore_constant_varstruct = ref true;; + +(* ------------------------------------------------------------------------- *) +(* Flags controlling the treatment of invented type variables in quotations. *) +(* It can be treated as an error, result in a warning, or neither of those. *) +(* ------------------------------------------------------------------------- *) + +let type_invention_warning = ref true;; + +let type_invention_error = ref false;; + +(* ------------------------------------------------------------------------- *) +(* Implicit types or type schemes for non-constants. *) +(* ------------------------------------------------------------------------- *) + +let the_implicit_types = ref ([]:(string*hol_type)list);; + +(* ------------------------------------------------------------------------- *) +(* Overloading and interface mapping. *) +(* ------------------------------------------------------------------------- *) + +let make_overloadable s gty = + if can (assoc s) (!the_overload_skeletons) + then if assoc s (!the_overload_skeletons) = gty then () + else failwith "make_overloadable: differs from existing skeleton" + else the_overload_skeletons := (s,gty)::(!the_overload_skeletons);; + +let remove_interface sym = + let interface = filter ((<>)sym o fst) (!the_interface) in + the_interface := interface;; + +let reduce_interface (sym,tm) = + let namty = try dest_const tm with Failure _ -> dest_var tm in + the_interface := filter ((<>) (sym,namty)) (!the_interface);; + +let override_interface (sym,tm) = + let namty = try dest_const tm with Failure _ -> dest_var tm in + let interface = filter ((<>)sym o fst) (!the_interface) in + the_interface := (sym,namty)::interface;; + +let overload_interface (sym,tm) = + let gty = try assoc sym (!the_overload_skeletons) with Failure _ -> + failwith ("symbol \""^sym^"\" is not overloadable") in + let (name,ty) as namty = try dest_const tm with Failure _ -> dest_var tm in + if not (can (type_match gty ty) []) + then failwith "Not an instance of type skeleton" else + let interface = filter ((<>) (sym,namty)) (!the_interface) in + the_interface := (sym,namty)::interface;; + +let prioritize_overload ty = + do_list + (fun (s,gty) -> + try let _,(n,t) = find + (fun (s',(n,t)) -> s' = s & mem ty (map fst (type_match gty t []))) + (!the_interface) in + overload_interface(s,mk_var(n,t)) + with Failure _ -> ()) + (!the_overload_skeletons);; + +(* ------------------------------------------------------------------------- *) +(* Type abbreviations. *) +(* ------------------------------------------------------------------------- *) + +let new_type_abbrev,remove_type_abbrev,type_abbrevs = + let the_type_abbreviations = ref ([]:(string*hol_type)list) in + let remove_type_abbrev s = + the_type_abbreviations := + filter (fun (s',_) -> s' <> s) (!the_type_abbreviations) in + let new_type_abbrev(s,ty) = + (remove_type_abbrev s; + the_type_abbreviations := merge(<) [s,ty] (!the_type_abbreviations)) in + let type_abbrevs() = !the_type_abbreviations in + new_type_abbrev,remove_type_abbrev,type_abbrevs;; + +(* ------------------------------------------------------------------------- *) +(* Handle constant hiding. *) +(* ------------------------------------------------------------------------- *) + +let hide_constant,unhide_constant,is_hidden = + let hcs = ref ([]:string list) in + let hide_constant c = hcs := union [c] (!hcs) + and unhide_constant c = hcs := subtract (!hcs) [c] + and is_hidden c = mem c (!hcs) in + hide_constant,unhide_constant,is_hidden;; + +(* ------------------------------------------------------------------------- *) +(* The type of pretypes. *) +(* ------------------------------------------------------------------------- *) + +type pretype = Utv of string (* User type variable *) + | Ptycon of string * pretype list (* Type constructor *) + | Stv of int;; (* System type variable *) + +(* ------------------------------------------------------------------------- *) +(* Dummy pretype for the parser to stick in before a proper typing pass. *) +(* ------------------------------------------------------------------------- *) + +let dpty = Ptycon("",[]);; + +(* ------------------------------------------------------------------------- *) +(* Convert type to pretype. *) +(* ------------------------------------------------------------------------- *) + +let rec pretype_of_type ty = + try let con,args = dest_type ty in + Ptycon(con,map pretype_of_type args) + with Failure _ -> Utv(dest_vartype ty);; + +(* ------------------------------------------------------------------------- *) +(* Preterm syntax. *) +(* ------------------------------------------------------------------------- *) + +type preterm = Varp of string * pretype (* Variable - v *) + | Constp of string * pretype (* Constant - c *) + | Combp of preterm * preterm (* Combination - f x *) + | Absp of preterm * preterm (* Lambda-abstraction - \x. t *) + | Typing of preterm * pretype;; (* Type constraint - t : ty *) + +(* ------------------------------------------------------------------------- *) +(* Convert term to preterm. *) +(* ------------------------------------------------------------------------- *) + +let rec preterm_of_term tm = + try let n,ty = dest_var tm in + Varp(n,pretype_of_type ty) + with Failure _ -> try + let n,ty = dest_const tm in + Constp(n,pretype_of_type ty) + with Failure _ -> try + let v,bod = dest_abs tm in + Absp(preterm_of_term v,preterm_of_term bod) + with Failure _ -> + let l,r = dest_comb tm in + Combp(preterm_of_term l,preterm_of_term r);; + +(* ------------------------------------------------------------------------- *) +(* Main pretype->type, preterm->term and retypechecking functions. *) +(* ------------------------------------------------------------------------- *) + +let type_of_pretype,term_of_preterm,retypecheck = + let tyv_num = ref 0 in + let new_type_var() = let n = !tyv_num in (tyv_num := n + 1; Stv(n)) in + + let pmk_cv(s,pty) = + if can get_const_type s then Constp(s,pty) + else Varp(s,pty) in + + let pmk_numeral = + let num_pty = Ptycon("num",[]) in + let NUMERAL = Constp("NUMERAL",Ptycon("fun",[num_pty; num_pty])) + and BIT0 = Constp("BIT0",Ptycon("fun",[num_pty; num_pty])) + and BIT1 = Constp("BIT1",Ptycon("fun",[num_pty; num_pty])) + and t_0 = Constp("_0",num_pty) in + let rec pmk_numeral(n) = + if n =/ num_0 then t_0 else + let m = quo_num n (num_2) and b = mod_num n (num_2) in + let op = if b =/ num_0 then BIT0 else BIT1 in + Combp(op,pmk_numeral(m)) in + fun n -> Combp(NUMERAL,pmk_numeral n) in + + (* ----------------------------------------------------------------------- *) + (* Pretype substitution for a pretype resulting from translation of type. *) + (* ----------------------------------------------------------------------- *) + + let rec pretype_subst th ty = + match ty with + Ptycon(tycon,args) -> Ptycon(tycon,map (pretype_subst th) args) + | Utv v -> rev_assocd ty th ty + | _ -> failwith "pretype_subst: Unexpected form of pretype" in + + (* ----------------------------------------------------------------------- *) + (* Convert type to pretype with new Stvs for all type variables. *) + (* ----------------------------------------------------------------------- *) + + let pretype_instance ty = + let gty = pretype_of_type ty + and tyvs = map pretype_of_type (tyvars ty) in + let subs = map (fun tv -> new_type_var(),tv) tyvs in + pretype_subst subs gty in + + (* ----------------------------------------------------------------------- *) + (* Get a new instance of a constant's generic type modulo interface. *) + (* ----------------------------------------------------------------------- *) + + let get_generic_type cname = + match filter ((=) cname o fst) (!the_interface) with + [_,(c,ty)] -> ty + | _::_::_ -> assoc cname (!the_overload_skeletons) + | [] -> get_const_type cname in + + (* ----------------------------------------------------------------------- *) + (* Get the implicit generic type of a variable. *) + (* ----------------------------------------------------------------------- *) + + let get_var_type vname = + assoc vname !the_implicit_types in + + (* ----------------------------------------------------------------------- *) + (* Unravel unifications and apply them to a type. *) + (* ----------------------------------------------------------------------- *) + + let rec solve env pty = + match pty with + Ptycon(f,args) -> Ptycon(f,map (solve env) args) + | Stv(i) -> if defined env i then solve env (apply env i) else pty + | _ -> pty in + + (* ----------------------------------------------------------------------- *) + (* Functions for display of preterms and pretypes, by converting them *) + (* to terms and types then re-using standard printing functions. *) + (* ----------------------------------------------------------------------- *) + + let free_stvs = + let rec free_stvs = function + |Stv n -> [n] + |Utv _ -> [] + |Ptycon(_,args) -> flat (map free_stvs args) + in + setify o free_stvs + in + + let string_of_pretype stvs = + let rec type_of_pretype' ns = function + |Stv n -> mk_vartype (if mem n ns then "?" ^ string_of_int n else "_") + |Utv v -> mk_vartype v + |Ptycon(con,args) -> mk_type(con,map (type_of_pretype' ns) args) + in + string_of_type o type_of_pretype' stvs + in + + let string_of_preterm = + let rec untyped_t_of_pt = function + |Varp(s,pty) -> mk_var(s,aty) + |Constp(s,pty) -> mk_mconst(s,get_const_type s) + |Combp(l,r) -> mk_comb(untyped_t_of_pt l,untyped_t_of_pt r) + |Absp(v,bod) -> mk_gabs(untyped_t_of_pt v,untyped_t_of_pt bod) + |Typing(ptm,pty) -> untyped_t_of_pt ptm + in + string_of_term o untyped_t_of_pt + in + + let string_of_ty_error env = function + |None -> + "unify: types cannot be unified " + ^ "(you should not see this message, please report)" + |Some(t,ty1,ty2) -> + let ty1 = solve env ty1 and ty2 = solve env ty2 in + let sty1 = string_of_pretype (free_stvs ty2) ty1 in + let sty2 = string_of_pretype (free_stvs ty1) ty2 in + let default_msg s = + " " ^ s ^ " cannot have type " ^ sty1 ^ " and " ^ sty2 + ^ " simultaneously" + in + match t with + |Constp(s,_) -> + " " ^ s ^ " has type " ^ string_of_type (get_const_type s) ^ ", " + ^ "it cannot be used with type " ^ sty2 + |Varp(s,_) -> default_msg s + |t -> default_msg (string_of_preterm t) + in + + (* ----------------------------------------------------------------------- *) + (* Unification of types *) + (* ----------------------------------------------------------------------- *) + + let rec istrivial ptm env x = function + |Stv y as t -> + y = x or defined env y & istrivial ptm env x (apply env y) + |Ptycon(f,args) as t when exists (istrivial ptm env x) args -> + failwith (string_of_ty_error env ptm) + |(Ptycon _ | Utv _) -> false + in + + let unify ptm env ty1 ty2 = + let rec unify env = function + |[] -> env + |(ty1,ty2,_)::oth when ty1 = ty2 -> unify env oth + |(Ptycon(f,fargs),Ptycon(g,gargs),ptm)::oth -> + if f = g & length fargs = length gargs + then unify env (map2 (fun x y -> x,y,ptm) fargs gargs @ oth) + else failwith (string_of_ty_error env ptm) + |(Stv x,t,ptm)::oth -> + if defined env x then unify env ((apply env x,t,ptm)::oth) + else unify (if istrivial ptm env x t then env else (x|->t) env) oth + |(t,Stv x,ptm)::oth -> unify env ((Stv x,t,ptm)::oth) + |(_,_,ptm)::oth -> failwith (string_of_ty_error env ptm) + in + unify env [ty1,ty2,match ptm with None -> None | Some t -> Some(t,ty1,ty2)] + in + + (* ----------------------------------------------------------------------- *) + (* Attempt to attach a given type to a term, performing unifications. *) + (* ----------------------------------------------------------------------- *) + + let rec typify ty (ptm,venv,uenv) = + match ptm with + |Varp(s,_) when can (assoc s) venv -> + let ty' = assoc s venv in + Varp(s,ty'),[],unify (Some ptm) uenv ty' ty + |Varp(s,_) when can num_of_string s -> + let t = pmk_numeral(num_of_string s) in + let ty' = Ptycon("num",[]) in + t,[],unify (Some ptm) uenv ty' ty + |Varp(s,_) -> + warn (s <> "" & isnum s) "Non-numeral begins with a digit"; + if not(is_hidden s) & can get_generic_type s then + let pty = pretype_instance(get_generic_type s) in + let ptm = Constp(s,pty) in + ptm,[],unify (Some ptm) uenv pty ty + else + let ptm = Varp(s,ty) in + if not(can get_var_type s) then ptm,[s,ty],uenv + else + let pty = pretype_instance(get_var_type s) in + ptm,[s,ty],unify (Some ptm) uenv pty ty + |Combp(f,x) -> + let ty'' = new_type_var() in + let ty' = Ptycon("fun",[ty'';ty]) in + let f',venv1,uenv1 = typify ty' (f,venv,uenv) in + let x',venv2,uenv2 = typify ty'' (x,venv1@venv,uenv1) in + Combp(f',x'),(venv1@venv2),uenv2 + |Typing(tm,pty) -> typify ty (tm,venv,unify (Some tm) uenv ty pty) + |Absp(v,bod) -> + let ty',ty'' = + match ty with + |Ptycon("fun",[ty';ty'']) -> ty',ty'' + |_ -> new_type_var(),new_type_var() + in + let ty''' = Ptycon("fun",[ty';ty'']) in + let uenv0 = unify (Some ptm) uenv ty''' ty in + let v',venv1,uenv1 = + let v',venv1,uenv1 = typify ty' (v,[],uenv0) in + match v' with + |Constp(s,_) when !ignore_constant_varstruct -> + Varp(s,ty'),[s,ty'],uenv0 + |_ -> v',venv1,uenv1 + in + let bod',venv2,uenv2 = typify ty'' (bod,venv1@venv,uenv1) in + Absp(v',bod'),venv2,uenv2 + |_ -> failwith "typify: unexpected constant at this stage" + in + + (* ----------------------------------------------------------------------- *) + (* Further specialize type constraints by resolving overloadings. *) + (* ----------------------------------------------------------------------- *) + + let rec resolve_interface ptm cont env = + match ptm with + Combp(f,x) -> resolve_interface f (resolve_interface x cont) env + | Absp(v,bod) -> resolve_interface v (resolve_interface bod cont) env + | Varp(_,_) -> cont env + | Constp(s,ty) -> + let maps = filter (fun (s',_) -> s' = s) (!the_interface) in + if maps = [] then cont env else + tryfind (fun (_,(_,ty')) -> + let ty' = pretype_instance ty' in + cont(unify (Some ptm) env ty' ty)) maps + in + + (* ----------------------------------------------------------------------- *) + (* Hence apply throughout a preterm. *) + (* ----------------------------------------------------------------------- *) + + let rec solve_preterm env ptm = + match ptm with + Varp(s,ty) -> Varp(s,solve env ty) + | Combp(f,x) -> Combp(solve_preterm env f,solve_preterm env x) + | Absp(v,bod) -> Absp(solve_preterm env v,solve_preterm env bod) + | Constp(s,ty) -> let tys = solve env ty in + try let _,(c',_) = find + (fun (s',(c',ty')) -> + s = s' & can (unify None env (pretype_instance ty')) ty) + (!the_interface) in + pmk_cv(c',tys) + with Failure _ -> Constp(s,tys) + in + + (* ----------------------------------------------------------------------- *) + (* Flag to indicate that Stvs were translated to real type variables. *) + (* ----------------------------------------------------------------------- *) + + let stvs_translated = ref false in + + (* ----------------------------------------------------------------------- *) + (* Pretype <-> type conversion; -> flags system type variable translation. *) + (* ----------------------------------------------------------------------- *) + + let rec type_of_pretype ty = + match ty with + Stv n -> stvs_translated := true; + let s = "?"^(string_of_int n) in + mk_vartype(s) + | Utv(v) -> mk_vartype(v) + | Ptycon(con,args) -> mk_type(con,map type_of_pretype args) in + + (* ----------------------------------------------------------------------- *) + (* Maps preterms to terms. *) + (* ----------------------------------------------------------------------- *) + + let term_of_preterm = + let rec term_of_preterm ptm = + match ptm with + Varp(s,pty) -> mk_var(s,type_of_pretype pty) + | Constp(s,pty) -> mk_mconst(s,type_of_pretype pty) + | Combp(l,r) -> mk_comb(term_of_preterm l,term_of_preterm r) + | Absp(v,bod) -> mk_gabs(term_of_preterm v,term_of_preterm bod) + | Typing(ptm,pty) -> term_of_preterm ptm in + let report_type_invention () = + if !stvs_translated then + if !type_invention_error + then failwith "typechecking error (cannot infer type of variables)" + else warn !type_invention_warning "inventing type variables" in + fun ptm -> stvs_translated := false; + let tm = term_of_preterm ptm in + report_type_invention (); tm in + + (* ----------------------------------------------------------------------- *) + (* Overall typechecker: initial typecheck plus overload resolution pass. *) + (* ----------------------------------------------------------------------- *) + + let retypecheck venv ptm = + let ty = new_type_var() in + let ptm',_,env = + try typify ty (ptm,venv,undefined) + with Failure e -> failwith + ("typechecking error (initial type assignment):" ^ e) in + let env' = + try resolve_interface ptm' (fun e -> e) env + with Failure _ -> failwith "typechecking error (overload resolution)" in + let ptm'' = solve_preterm env' ptm' in + ptm'' in + + type_of_pretype,term_of_preterm,retypecheck;; diff --git a/printer.ml b/printer.ml new file mode 100644 index 0000000..aff8ecc --- /dev/null +++ b/printer.ml @@ -0,0 +1,544 @@ +(* ========================================================================= *) +(* Simplistic HOL Light prettyprinter, using the OCaml "Format" library. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "nets.ml";; + +(* ------------------------------------------------------------------------- *) +(* Character discrimination. *) +(* ------------------------------------------------------------------------- *) + +let isspace,issep,isbra,issymb,isalpha,isnum,isalnum = + let charcode s = Char.code(String.get s 0) in + let spaces = " \t\n\r" + and separators = ",;" + and brackets = "()[]{}" + and symbs = "\\!@#$%^&*-+|\\<=>/?~.:" + and alphas = "'abcdefghijklmnopqrstuvwxyz_ABCDEFGHIJKLMNOPQRSTUVWXYZ" + and nums = "0123456789" in + let allchars = spaces^separators^brackets^symbs^alphas^nums in + let csetsize = itlist (max o charcode) (explode allchars) 256 in + let ctable = Array.make csetsize 0 in + do_list (fun c -> Array.set ctable (charcode c) 1) (explode spaces); + do_list (fun c -> Array.set ctable (charcode c) 2) (explode separators); + do_list (fun c -> Array.set ctable (charcode c) 4) (explode brackets); + do_list (fun c -> Array.set ctable (charcode c) 8) (explode symbs); + do_list (fun c -> Array.set ctable (charcode c) 16) (explode alphas); + do_list (fun c -> Array.set ctable (charcode c) 32) (explode nums); + let isspace c = Array.get ctable (charcode c) = 1 + and issep c = Array.get ctable (charcode c) = 2 + and isbra c = Array.get ctable (charcode c) = 4 + and issymb c = Array.get ctable (charcode c) = 8 + and isalpha c = Array.get ctable (charcode c) = 16 + and isnum c = Array.get ctable (charcode c) = 32 + and isalnum c = Array.get ctable (charcode c) >= 16 in + isspace,issep,isbra,issymb,isalpha,isnum,isalnum;; + +(* ------------------------------------------------------------------------- *) +(* Reserved words. *) +(* ------------------------------------------------------------------------- *) + +let reserve_words,unreserve_words,is_reserved_word,reserved_words = + let reswords = ref ["("; ")"; "["; "]"; "{"; "}"; + ":"; ";"; "."; "|"; + "let"; "in"; "and"; "if"; "then"; "else"; + "match"; "with"; "function"; "->"; "when"] in + (fun ns -> reswords := union (!reswords) ns), + (fun ns -> reswords := subtract (!reswords) ns), + (fun n -> mem n (!reswords)), + (fun () -> !reswords);; + +(* ------------------------------------------------------------------------- *) +(* Functions to access the global tables controlling special parse status. *) +(* *) +(* o List of binders; *) +(* *) +(* o List of prefixes (right-associated unary functions like negation). *) +(* *) +(* o List of infixes with their precedences and associations. *) +(* *) +(* Note that these tables are independent of constant/variable status or *) +(* whether an identifier is symbolic. *) +(* ------------------------------------------------------------------------- *) + +let unparse_as_binder,parse_as_binder,parses_as_binder,binders = + let binder_list = ref ([]:string list) in + (fun n -> binder_list := subtract (!binder_list) [n]), + (fun n -> binder_list := union (!binder_list) [n]), + (fun n -> mem n (!binder_list)), + (fun () -> !binder_list);; + +let unparse_as_prefix,parse_as_prefix,is_prefix,prefixes = + let prefix_list = ref ([]:string list) in + (fun n -> prefix_list := subtract (!prefix_list) [n]), + (fun n -> prefix_list := union (!prefix_list) [n]), + (fun n -> mem n (!prefix_list)), + (fun () -> !prefix_list);; + +let unparse_as_infix,parse_as_infix,get_infix_status,infixes = + let cmp (s,(x,a)) (t,(y,b)) = + x < y or x = y & a > b or x = y & a = b & s < t in + let infix_list = ref ([]:(string * (int * string)) list) in + (fun n -> infix_list := filter (((<>) n) o fst) (!infix_list)), + (fun (n,d) -> infix_list := sort cmp + ((n,d)::(filter (((<>) n) o fst) (!infix_list)))), + (fun n -> assoc n (!infix_list)), + (fun () -> !infix_list);; + +(* ------------------------------------------------------------------------- *) +(* Interface mapping. *) +(* ------------------------------------------------------------------------- *) + +let the_interface = ref ([] :(string * (string * hol_type)) list);; + +let the_overload_skeletons = ref ([] : (string * hol_type) list);; + +(* ------------------------------------------------------------------------- *) +(* Now the printer. *) +(* ------------------------------------------------------------------------- *) + +include Format;; + +set_max_boxes 100;; + +(* ------------------------------------------------------------------------- *) +(* Flag determining whether interface/overloading is reversed on printing. *) +(* ------------------------------------------------------------------------- *) + +let reverse_interface_mapping = ref true;; + +(* ------------------------------------------------------------------------- *) +(* Determine binary operators that print without surrounding spaces. *) +(* ------------------------------------------------------------------------- *) + +let unspaced_binops = ref [","; ".."; "$"];; + +(* ------------------------------------------------------------------------- *) +(* Binary operators to print at start of line when breaking. *) +(* ------------------------------------------------------------------------- *) + +let prebroken_binops = ref ["==>"];; + +(* ------------------------------------------------------------------------- *) +(* Force explicit indications of bound variables in set abstractions. *) +(* ------------------------------------------------------------------------- *) + +let print_unambiguous_comprehensions = ref false;; + +(* ------------------------------------------------------------------------- *) +(* Print the universal set UNIV:A->bool as "(:A)". *) +(* ------------------------------------------------------------------------- *) + +let typify_universal_set = ref true;; + +(* ------------------------------------------------------------------------- *) +(* Flag controlling whether hypotheses print. *) +(* ------------------------------------------------------------------------- *) + +let print_all_thm = ref true;; + +(* ------------------------------------------------------------------------- *) +(* Get the name of a constant or variable. *) +(* ------------------------------------------------------------------------- *) + +let name_of tm = + match tm with + Var(x,ty) | Const(x,ty) -> x + | _ -> "";; + +(* ------------------------------------------------------------------------- *) +(* Printer for types. *) +(* ------------------------------------------------------------------------- *) + +let pp_print_type,pp_print_qtype = + let soc sep flag ss = + if ss = [] then "" else + let s = end_itlist (fun s1 s2 -> s1^sep^s2) ss in + if flag then "("^s^")" else s in + let rec sot pr ty = + try dest_vartype ty with Failure _ -> + match dest_type ty with + con,[] -> con + | "fun",[ty1;ty2] -> soc "->" (pr > 0) [sot 1 ty1; sot 0 ty2] + | "sum",[ty1;ty2] -> soc "+" (pr > 2) [sot 3 ty1; sot 2 ty2] + | "prod",[ty1;ty2] -> soc "#" (pr > 4) [sot 5 ty1; sot 4 ty2] + | "cart",[ty1;ty2] -> soc "^" (pr > 6) [sot 6 ty1; sot 7 ty2] + | con,args -> (soc "," true (map (sot 0) args))^con in + (fun fmt ty -> pp_print_string fmt (sot 0 ty)), + (fun fmt ty -> pp_print_string fmt ("`:" ^ sot 0 ty ^ "`"));; + +(* ------------------------------------------------------------------------- *) +(* Allow the installation of user printers. Must fail quickly if N/A. *) +(* ------------------------------------------------------------------------- *) + +let install_user_printer,delete_user_printer,try_user_printer = + let user_printers = ref ([]:(string*(formatter->term->unit))list) in + (fun pr -> user_printers := pr::(!user_printers)), + (fun s -> user_printers := snd(remove (fun (s',_) -> s = s') + (!user_printers))), + (fun fmt -> fun tm -> tryfind (fun (_,pr) -> pr fmt tm) (!user_printers));; + +(* ------------------------------------------------------------------------- *) +(* Printer for terms. *) +(* ------------------------------------------------------------------------- *) + +let pp_print_term = + let reverse_interface (s0,ty0) = + if not(!reverse_interface_mapping) then s0 else + try fst(find (fun (s,(s',ty)) -> s' = s0 & can (type_match ty ty0) []) + (!the_interface)) + with Failure _ -> s0 in + let DEST_BINARY c tm = + try let il,r = dest_comb tm in + let i,l = dest_comb il in + if i = c or + (is_const i & is_const c & + reverse_interface(dest_const i) = reverse_interface(dest_const c)) + then l,r else fail() + with Failure _ -> failwith "DEST_BINARY" + and ARIGHT s = + match snd(get_infix_status s) with + "right" -> true | _ -> false in + let rec powerof10 n = + if abs_num n true + | Const("F",_) -> false + | _ -> failwith "bool_of_term" in + let code_of_term t = + let f,tms = strip_comb t in + if not(is_const f & fst(dest_const f) = "ASCII") + or not(length tms = 8) then failwith "code_of_term" + else + itlist (fun b f -> if b then 1 + 2 * f else 2 * f) + (map bool_of_term (rev tms)) 0 in + let rec dest_clause tm = + let pbod = snd(strip_exists(body(body tm))) in + let s,args = strip_comb pbod in + if name_of s = "_UNGUARDED_PATTERN" & length args = 2 then + [rand(rator(hd args));rand(rator(hd(tl args)))] + else if name_of s = "_GUARDED_PATTERN" & length args = 3 then + [rand(rator(hd args)); hd(tl args); rand(rator(hd(tl(tl args))))] + else failwith "dest_clause" in + let rec dest_clauses tm = + let s,args = strip_comb tm in + if name_of s = "_SEQPATTERN" & length args = 2 then + dest_clause (hd args)::dest_clauses(hd(tl args)) + else [dest_clause tm] in + fun fmt -> + let rec print_term prec tm = + try try_user_printer fmt tm with Failure _ -> + try pp_print_string fmt (string_of_num(dest_numeral tm)) with Failure _ -> + try (let tms = dest_list tm in + try if fst(dest_type(hd(snd(dest_type(type_of tm))))) <> "char" + then fail() else + let ccs = map (String.make 1 o Char.chr o code_of_term) tms in + let s = "\"" ^ String.escaped (implode ccs) ^ "\"" in + pp_print_string fmt s + with Failure _ -> + pp_print_string fmt "["; + print_term_sequence "; " 0 tms; + pp_print_string fmt "]") + with Failure _ -> + if is_gabs tm then print_binder prec tm else + let hop,args = strip_comb tm in + let s0 = name_of hop + and ty0 = type_of hop in + let s = reverse_interface (s0,ty0) in + try if s = "EMPTY" & is_const tm & args = [] then + pp_print_string fmt "{}" else fail() + with Failure _ -> + try if s = "UNIV" & !typify_universal_set & is_const tm & args = [] then + let ty = fst(dest_fun_ty(type_of tm)) in + (pp_print_string fmt "(:"; + pp_print_type fmt ty; + pp_print_string fmt ")") + else fail() + with Failure _ -> + try if s <> "INSERT" then fail() else + let mems,oth = splitlist (dest_binary "INSERT") tm in + if is_const oth & fst(dest_const oth) = "EMPTY" then + (pp_print_string fmt "{"; + print_term_sequence ", " 14 mems; + pp_print_string fmt "}") + else fail() + with Failure _ -> + try if not (s = "GSPEC") then fail() else + let evs,bod = strip_exists(body(rand tm)) in + let bod1,fabs = dest_comb bod in + let bod2,babs = dest_comb bod1 in + let c = rator bod2 in + if fst(dest_const c) <> "SETSPEC" then fail() else + pp_print_string fmt "{"; + print_term 0 fabs; + pp_print_string fmt " | "; + (let fvs = frees fabs and bvs = frees babs in + if not(!print_unambiguous_comprehensions) & + set_eq evs + (if (length fvs <= 1 or bvs = []) then fvs + else intersect fvs bvs) + then () + else (print_term_sequence "," 14 evs; + pp_print_string fmt " | ")); + print_term 0 babs; + pp_print_string fmt "}" + with Failure _ -> + try let eqs,bod = dest_let tm in + (if prec = 0 then pp_open_hvbox fmt 0 + else (pp_open_hvbox fmt 1; pp_print_string fmt "("); + pp_print_string fmt "let "; + print_term 0 (mk_eq(hd eqs)); + do_list (fun (v,t) -> pp_print_break fmt 1 0; + pp_print_string fmt "and "; + print_term 0 (mk_eq(v,t))) + (tl eqs); + pp_print_string fmt " in"; + pp_print_break fmt 1 0; + print_term 0 bod; + if prec = 0 then () else pp_print_string fmt ")"; + pp_close_box fmt ()) + with Failure _ -> try + if s <> "DECIMAL" then fail() else + let n_num = dest_numeral (hd args) + and n_den = dest_numeral (hd(tl args)) in + if not(powerof10 n_den) then fail() else + let s_num = string_of_num(quo_num n_num n_den) in + let s_den = implode(tl(explode(string_of_num + (n_den +/ (mod_num n_num n_den))))) in + pp_print_string fmt("#"^s_num^(if n_den = Int 1 then "" else ".")^s_den) + with Failure _ -> try + if s <> "_MATCH" or length args <> 2 then failwith "" else + let cls = dest_clauses(hd(tl args)) in + (if prec = 0 then () else pp_print_string fmt "("; + pp_open_hvbox fmt 0; + pp_print_string fmt "match "; + print_term 0 (hd args); + pp_print_string fmt " with"; + pp_print_break fmt 1 2; + print_clauses cls; + pp_close_box fmt (); + if prec = 0 then () else pp_print_string fmt ")") + with Failure _ -> try + if s <> "_FUNCTION" or length args <> 1 then failwith "" else + let cls = dest_clauses(hd args) in + (if prec = 0 then () else pp_print_string fmt "("; + pp_open_hvbox fmt 0; + pp_print_string fmt "function"; + pp_print_break fmt 1 2; + print_clauses cls; + pp_close_box fmt (); + if prec = 0 then () else pp_print_string fmt ")") + with Failure _ -> + if s = "COND" & length args = 3 then + (if prec = 0 then () else pp_print_string fmt "("; + pp_open_hvbox fmt (-1); + pp_print_string fmt "if "; + print_term 0 (hd args); + pp_print_break fmt 0 0; + pp_print_string fmt " then "; + print_term 0 (hd(tl args)); + pp_print_break fmt 0 0; + pp_print_string fmt " else "; + print_term 0 (hd(tl(tl args))); + pp_close_box fmt (); + if prec = 0 then () else pp_print_string fmt ")") + else if is_prefix s & length args = 1 then + (if prec = 1000 then pp_print_string fmt "(" else (); + pp_print_string fmt s; + (if isalnum s or + s = "--" & + length args = 1 & + (try let l,r = dest_comb(hd args) in + let s0 = name_of l and ty0 = type_of l in + reverse_interface (s0,ty0) = "--" or + mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] + with Failure _ -> false) or + s = "~" & length args = 1 & is_neg(hd args) + then pp_print_string fmt " " else ()); + print_term 999 (hd args); + if prec = 1000 then pp_print_string fmt ")" else ()) + else if parses_as_binder s & length args = 1 & is_gabs (hd args) then + print_binder prec tm + else if can get_infix_status s & length args = 2 then + let bargs = + if ARIGHT s then + let tms,tmt = splitlist (DEST_BINARY hop) tm in tms@[tmt] + else + let tmt,tms = rev_splitlist (DEST_BINARY hop) tm in tmt::tms in + let newprec = fst(get_infix_status s) in + (if newprec <= prec then + (pp_open_hvbox fmt 1; pp_print_string fmt "(") + else pp_open_hvbox fmt 0; + print_term newprec (hd bargs); + do_list (fun x -> if mem s (!unspaced_binops) then () + else if mem s (!prebroken_binops) + then pp_print_break fmt 1 0 + else pp_print_string fmt " "; + pp_print_string fmt s; + if mem s (!unspaced_binops) + then pp_print_break fmt 0 0 + else if mem s (!prebroken_binops) + then pp_print_string fmt " " + else pp_print_break fmt 1 0; + print_term newprec x) (tl bargs); + if newprec <= prec then pp_print_string fmt ")" else (); + pp_close_box fmt ()) + else if (is_const hop or is_var hop) & args = [] then + let s' = if parses_as_binder s or can get_infix_status s or is_prefix s + then "("^s^")" else s in + pp_print_string fmt s' + else + let l,r = dest_comb tm in + (pp_open_hvbox fmt 0; + if prec = 1000 then pp_print_string fmt "(" else (); + print_term 999 l; + (if try mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] + with Failure _ -> false + then () else pp_print_space fmt ()); + print_term 1000 r; + if prec = 1000 then pp_print_string fmt ")" else (); + pp_close_box fmt ()) + + and print_term_sequence sep prec tms = + if tms = [] then () else + (print_term prec (hd tms); + let ttms = tl tms in + if ttms = [] then () + else (pp_print_string fmt sep; print_term_sequence sep prec ttms)) + + and print_binder prec tm = + let absf = is_gabs tm in + let s = if absf then "\\" else name_of(rator tm) in + let rec collectvs tm = + if absf then + if is_abs tm then + let v,t = dest_abs tm in + let vs,bod = collectvs t in (false,v)::vs,bod + else if is_gabs tm then + let v,t = dest_gabs tm in + let vs,bod = collectvs t in (true,v)::vs,bod + else [],tm + else if is_comb tm & name_of(rator tm) = s then + if is_abs(rand tm) then + let v,t = dest_abs(rand tm) in + let vs,bod = collectvs t in (false,v)::vs,bod + else if is_gabs(rand tm) then + let v,t = dest_gabs(rand tm) in + let vs,bod = collectvs t in (true,v)::vs,bod + else [],tm + else [],tm in + let vs,bod = collectvs tm in + ((if prec = 0 then pp_open_hvbox fmt 4 + else (pp_open_hvbox fmt 5; pp_print_string fmt "(")); + pp_print_string fmt s; + (if isalnum s then pp_print_string fmt " " else ()); + do_list (fun (b,x) -> + (if b then pp_print_string fmt "(" else ()); + print_term 0 x; + (if b then pp_print_string fmt ")" else ()); + pp_print_string fmt " ") (butlast vs); + (if fst(last vs) then pp_print_string fmt "(" else ()); + print_term 0 (snd(last vs)); + (if fst(last vs) then pp_print_string fmt ")" else ()); + pp_print_string fmt "."; + (if length vs = 1 then pp_print_string fmt " " + else pp_print_space fmt ()); + print_term 0 bod; + (if prec = 0 then () else pp_print_string fmt ")"); + pp_close_box fmt ()) + and print_clauses cls = + match cls with + [c] -> print_clause c + | c::cs -> (print_clause c; + pp_print_break fmt 1 0; + pp_print_string fmt "| "; + print_clauses cs) + and print_clause cl = + match cl with + [p;g;r] -> (print_term 1 p; + pp_print_string fmt " when "; + print_term 1 g; + pp_print_string fmt " -> "; + print_term 1 r) + | [p;r] -> (print_term 1 p; + pp_print_string fmt " -> "; + print_term 1 r) + in print_term 0;; + +(* ------------------------------------------------------------------------- *) +(* Print term with quotes. *) +(* ------------------------------------------------------------------------- *) + +let pp_print_qterm fmt tm = + pp_print_string fmt "`"; + pp_print_term fmt tm; + pp_print_string fmt "`";; + +(* ------------------------------------------------------------------------- *) +(* Printer for theorems. *) +(* ------------------------------------------------------------------------- *) + +let pp_print_thm fmt th = + let asl,tm = dest_thm th in + (if not (asl = []) then + (if !print_all_thm then + (pp_print_term fmt (hd asl); + do_list (fun x -> pp_print_string fmt ","; + pp_print_space fmt (); + pp_print_term fmt x) + (tl asl)) + else pp_print_string fmt "..."; + pp_print_space fmt ()) + else (); + pp_open_hbox fmt(); + pp_print_string fmt "|- "; + pp_print_term fmt tm; + pp_close_box fmt ());; + +(* ------------------------------------------------------------------------- *) +(* Print on standard output. *) +(* ------------------------------------------------------------------------- *) + +let print_type = pp_print_type std_formatter;; +let print_qtype = pp_print_qtype std_formatter;; +let print_term = pp_print_term std_formatter;; +let print_qterm = pp_print_qterm std_formatter;; +let print_thm = pp_print_thm std_formatter;; + +(* ------------------------------------------------------------------------- *) +(* Install all the printers. *) +(* ------------------------------------------------------------------------- *) + +#install_printer print_qtype;; +#install_printer print_qterm;; +#install_printer print_thm;; + +(* ------------------------------------------------------------------------- *) +(* Conversions to string. *) +(* ------------------------------------------------------------------------- *) + +let print_to_string printer = + let buf = Buffer.create 16 in + let fmt = formatter_of_buffer buf in + let () = pp_set_max_boxes fmt 100 in + let print = printer fmt in + let flush = pp_print_flush fmt in + fun x -> + let () = pp_set_margin fmt (get_margin ()) in + let () = print x in + let () = flush () in + let s = Buffer.contents buf in + let () = Buffer.reset buf in + s;; + +let string_of_type = print_to_string pp_print_type;; +let string_of_term = print_to_string pp_print_term;; +let string_of_thm = print_to_string pp_print_thm;; diff --git a/quot.ml b/quot.ml new file mode 100644 index 0000000..6d95b56 --- /dev/null +++ b/quot.ml @@ -0,0 +1,162 @@ +(* ========================================================================= *) +(* Tools for defining quotient types and lifting first order theorems. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "meson.ml";; + +(* ------------------------------------------------------------------------- *) +(* Given a type name "ty" and a curried binary relation R, this defines *) +(* a new type "ty" of R-equivalence classes. The abstraction and *) +(* representation functions for the new type are called "mk_ty" and *) +(* "dest_ty". The type bijections (after beta-conversion) are returned: *) +(* *) +(* |- mk_ty (dest_ty a) = a *) +(* *) +(* |- (?x. r = R x) <=> (dest_ty (mk_ty r) = r) *) +(* ------------------------------------------------------------------------- *) + +let define_quotient_type = + fun tyname (absname,repname) eqv -> + let ty = hd(snd(dest_type(type_of eqv))) in + let pty = mk_fun_ty ty bool_ty in + let s = mk_var("s",pty) and x = mk_var("x",ty) in + let eqvx = mk_comb(eqv,x) in + let pred = mk_abs(s,mk_exists(x,mk_eq(s,eqvx))) in + let th0 = BETA_CONV(mk_comb(pred,eqvx)) in + let th1 = EXISTS(rand(concl th0),x) (REFL eqvx) in + let th2 = EQ_MP (SYM th0) th1 in + let abs,rep = new_basic_type_definition tyname (absname,repname) th2 in + abs,CONV_RULE(LAND_CONV BETA_CONV) rep;; + +(* ------------------------------------------------------------------------- *) +(* Given a welldefinedness theorem for a curried function f, of the form: *) +(* *) +(* |- !x1 x1' .. xn xn'. (x1 == x1') /\ ... /\ (xn == xn') *) +(* ==> (f x1 .. xn == f x1' .. f nx') *) +(* *) +(* where each "==" is either equality or some fixed binary relation R, a *) +(* new operator called "opname" is introduced which lifts "f" up to the *) +(* R-equivalence classes. Two theorems are returned: the actual definition *) +(* and a useful consequence for lifting theorems. *) +(* *) +(* The function also needs the second (more complicated) type bijection, and *) +(* the reflexivity and transitivity (not symmetry!) of the equivalence *) +(* relation. The use also gives a name for the new function. *) +(* ------------------------------------------------------------------------- *) + +let lift_function = + let SELECT_LEMMA = prove + (`!x:A. (@y. x = y) = x`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [EQ_SYM_EQ] THEN + MATCH_ACCEPT_TAC SELECT_REFL) in + fun tybij2 -> + let tybl,tybr = dest_comb(concl tybij2) in + let eqvx = rand(body(rand(rand tybl))) in + let eqv,xtm = dest_comb eqvx in + let dmr,rtm = dest_eq tybr in + let dest,mrt = dest_comb dmr in + let mk = rator mrt in + let ety = type_of mrt in + fun (refl_th,trans_th) fname wth -> + let wtm = repeat (snd o dest_forall) (concl wth) in + let wfvs = frees wtm in + let hyps,con = try (conjuncts F_F I) (dest_imp wtm) + with Failure _ -> [],wtm in + let eqs,rels = partition is_eq hyps in + let rvs = map lhand rels in + let qvs = map lhs eqs in + let evs = + variants wfvs (map (fun v -> mk_var(fst(dest_var v),ety)) rvs) in + let mems = map2 (fun rv ev -> mk_comb(mk_comb(dest,ev),rv)) rvs evs in + let lcon,rcon = dest_comb con in + let u = variant (evs @ wfvs) (mk_var("u",type_of rcon)) in + let ucon = mk_comb(lcon,u) in + let dbod = list_mk_conj(ucon::mems) in + let detm = list_mk_exists(rvs,dbod) in + let datm = mk_abs(u,detm) in + let def = + if is_eq con then list_mk_icomb "@" [datm] else mk_comb(mk,datm) in + let newargs = map + (fun e -> try lhs e with Failure _ -> assoc (lhand e) (zip rvs evs)) hyps in + let rdef = list_mk_abs(newargs,def) in + let ldef = mk_var(fname,type_of rdef) in + let dth = new_definition(mk_eq(ldef,rdef)) in + let eth = rev_itlist + (fun v th -> CONV_RULE(RAND_CONV BETA_CONV) (AP_THM th v)) + newargs dth in + let targs = map (fun v -> mk_comb(mk,mk_comb(eqv,v))) rvs in + let dme_th = + let th = INST [eqvx,rtm] tybij2 in + EQ_MP th (EXISTS(lhs(concl th),xtm) (REFL eqvx)) in + let ith = INST (zip targs evs) eth in + let jth = SUBS (map (fun v -> INST[v,xtm] dme_th) rvs) ith in + let apop,uxtm = dest_comb(rand(concl jth)) in + let extm = body uxtm in + let evs,bod = strip_exists extm in + let th1 = ASSUME bod in + let th2 = + if evs = [] then th1 else + let th2a,th2b = CONJ_PAIR th1 in + let ethlist = CONJUNCTS th2b @ map REFL qvs in + let th2c = end_itlist CONJ (map + (fun v -> find ((=) (lhand v) o lhand o concl) ethlist) hyps) in + let th2d = MATCH_MP wth th2c in + let th2e = try TRANS th2d th2a + with Failure _ -> MATCH_MP trans_th (CONJ th2d th2a) in + itlist SIMPLE_CHOOSE evs th2e in + let th3 = ASSUME(concl th2) in + let th4 = end_itlist CONJ (th3::(map (C SPEC refl_th) rvs)) in + let th5 = itlist SIMPLE_EXISTS evs (ASSUME bod) in + let th6 = MATCH_MP (DISCH_ALL th5) th4 in + let th7 = IMP_ANTISYM_RULE (DISCH_ALL th2) (DISCH_ALL th6) in + let th8 = TRANS jth (AP_TERM apop (ABS u th7)) in + let fconv = if is_eq con then REWR_CONV SELECT_LEMMA + else RAND_CONV ETA_CONV in + let th9 = CONV_RULE (RAND_CONV fconv) th8 in + eth,GSYM th9;; + +(* ------------------------------------------------------------------------- *) +(* Lifts a theorem. This can be done by higher order rewriting alone. *) +(* *) +(* NB! All and only the first order variables must be bound by quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let lift_theorem = + let pth = prove + (`(!x:Repty. R x x) /\ + (!x y. R x y <=> R y x) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!a. mk(dest a) = a) /\ + (!r. (?x. r = R x) <=> (dest(mk r) = r)) + ==> (!x y. R x y <=> (mk(R x) = mk(R y))) /\ + (!P. (!x. P(mk(R x))) <=> (!x. P x)) /\ + (!P. (?x. P(mk(R x))) <=> (?x. P x)) /\ + (!x:Absty. mk(R((@)(dest x))) = x)`, + STRIP_TAC THEN + SUBGOAL_THEN + `!x y. (mk((R:Repty->Repty->bool) x):Absty = mk(R y)) <=> (R x = R y)` + ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `(a /\ b /\ c) /\ (b ==> a ==> d) + ==> a /\ b /\ c /\ d`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + REPEAT(DISCH_THEN(fun th -> REWRITE_TAC[GSYM th])) THEN + X_GEN_TAC `x:Repty` THEN + SUBGOAL_THEN `dest(mk((R:Repty->Repty->bool) x):Absty) = R x` + SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [th]) THEN + CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]) in + fun tybij (refl_th,sym_th,trans_th) -> + let tybij1 = GEN_ALL (fst tybij) + and tybij2 = GEN_ALL (snd tybij) in + let cth = end_itlist CONJ [refl_th; sym_th; trans_th; tybij1; tybij2] in + let ith = MATCH_MP pth cth in + fun trths -> + REWRITE_RULE (ith::trths);; diff --git a/real.ml b/real.ml new file mode 100644 index 0000000..6603e2e --- /dev/null +++ b/real.ml @@ -0,0 +1,1482 @@ +(* ========================================================================= *) +(* More basic properties of the reals. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* (c) Copyright, Valentina Bruno 2010 *) +(* ========================================================================= *) + +needs "realarith.ml";; + +(* ------------------------------------------------------------------------- *) +(* Additional commutativity properties of the inclusion map. *) +(* ------------------------------------------------------------------------- *) + +let REAL_OF_NUM_LT = prove + (`!m n. &m < &n <=> m < n`, + REWRITE_TAC[real_lt; GSYM NOT_LE; REAL_OF_NUM_LE]);; + +let REAL_OF_NUM_GE = prove + (`!m n. &m >= &n <=> m >= n`, + REWRITE_TAC[GE; real_ge; REAL_OF_NUM_LE]);; + +let REAL_OF_NUM_GT = prove + (`!m n. &m > &n <=> m > n`, + REWRITE_TAC[GT; real_gt; REAL_OF_NUM_LT]);; + +let REAL_OF_NUM_MAX = prove + (`!m n. max (&m) (&n) = &(MAX m n)`, + REWRITE_TAC[REAL_OF_NUM_LE; MAX; real_max; GSYM COND_RAND]);; + +let REAL_OF_NUM_MIN = prove + (`!m n. min (&m) (&n) = &(MIN m n)`, + REWRITE_TAC[REAL_OF_NUM_LE; MIN; real_min; GSYM COND_RAND]);; + +let REAL_OF_NUM_SUC = prove + (`!n. &n + &1 = &(SUC n)`, + REWRITE_TAC[ADD1; REAL_OF_NUM_ADD]);; + +let REAL_OF_NUM_SUB = prove + (`!m n. m <= n ==> (&n - &m = &(n - m))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ADD_SUB2] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC] THEN + MESON_TAC[REAL_ADD_LINV; REAL_ADD_SYM; REAL_ADD_LID]);; + +(* ------------------------------------------------------------------------- *) +(* A few theorems we need to prove explicitly for later. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MUL_AC = prove + (`(m * n = n * m) /\ + ((m * n) * p = m * (n * p)) /\ + (m * (n * p) = n * (m * p))`, + REWRITE_TAC[REAL_MUL_ASSOC; EQT_INTRO(SPEC_ALL REAL_MUL_SYM)] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC REAL_MUL_SYM);; + +let REAL_ADD_RDISTRIB = prove + (`!x y z. (x + y) * z = x * z + y * z`, + MESON_TAC[REAL_MUL_SYM; REAL_ADD_LDISTRIB]);; + +let REAL_LT_LADD_IMP = prove + (`!x y z. y < z ==> x + y < x + z`, + REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN + REWRITE_TAC[real_lt] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THEN + DISCH_THEN(MP_TAC o SPEC `--x`) THEN + REWRITE_TAC[REAL_ADD_ASSOC; REAL_ADD_LINV; REAL_ADD_LID]);; + +let REAL_LT_MUL = prove + (`!x y. &0 < x /\ &0 < y ==> &0 < x * y`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_ENTIRE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Tactic version of REAL_ARITH. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ARITH_TAC = CONV_TAC REAL_ARITH;; + +(* ------------------------------------------------------------------------- *) +(* Prove all the linear theorems we can blow away automatically. *) +(* ------------------------------------------------------------------------- *) + +let REAL_EQ_ADD_LCANCEL_0 = prove + (`!x y. (x + y = x) <=> (y = &0)`, + REAL_ARITH_TAC);; + +let REAL_EQ_ADD_RCANCEL_0 = prove + (`!x y. (x + y = y) <=> (x = &0)`, + REAL_ARITH_TAC);; + +let REAL_LNEG_UNIQ = prove + (`!x y. (x + y = &0) <=> (x = --y)`, + REAL_ARITH_TAC);; + +let REAL_RNEG_UNIQ = prove + (`!x y. (x + y = &0) <=> (y = --x)`, + REAL_ARITH_TAC);; + +let REAL_NEG_LMUL = prove + (`!x y. --(x * y) = (--x) * y`, + REAL_ARITH_TAC);; + +let REAL_NEG_RMUL = prove + (`!x y. --(x * y) = x * (--y)`, + REAL_ARITH_TAC);; + +let REAL_NEGNEG = prove + (`!x. --(--x) = x`, + REAL_ARITH_TAC);; + +let REAL_NEG_MUL2 = prove + (`!x y. (--x) * (--y) = x * y`, + REAL_ARITH_TAC);; + +let REAL_LT_LADD = prove + (`!x y z. (x + y) < (x + z) <=> y < z`, + REAL_ARITH_TAC);; + +let REAL_LT_RADD = prove + (`!x y z. (x + z) < (y + z) <=> x < y`, + REAL_ARITH_TAC);; + +let REAL_LT_ANTISYM = prove + (`!x y. ~(x < y /\ y < x)`, + REAL_ARITH_TAC);; + +let REAL_LT_GT = prove + (`!x y. x < y ==> ~(y < x)`, + REAL_ARITH_TAC);; + +let REAL_NOT_EQ = prove + (`!x y. ~(x = y) <=> x < y \/ y < x`, + REAL_ARITH_TAC);; + +let REAL_NOT_LE = prove + (`!x y. ~(x <= y) <=> y < x`, + REAL_ARITH_TAC);; + +let REAL_LET_ANTISYM = prove + (`!x y. ~(x <= y /\ y < x)`, + REAL_ARITH_TAC);; + +let REAL_NEG_LT0 = prove + (`!x. (--x) < &0 <=> &0 < x`, + REAL_ARITH_TAC);; + +let REAL_NEG_GT0 = prove + (`!x. &0 < (--x) <=> x < &0`, + REAL_ARITH_TAC);; + +let REAL_NEG_LE0 = prove + (`!x. (--x) <= &0 <=> &0 <= x`, + REAL_ARITH_TAC);; + +let REAL_NEG_GE0 = prove + (`!x. &0 <= (--x) <=> x <= &0`, + REAL_ARITH_TAC);; + +let REAL_LT_TOTAL = prove + (`!x y. (x = y) \/ x < y \/ y < x`, + REAL_ARITH_TAC);; + +let REAL_LT_NEGTOTAL = prove + (`!x. (x = &0) \/ (&0 < x) \/ (&0 < --x)`, + REAL_ARITH_TAC);; + +let REAL_LE_01 = prove + (`&0 <= &1`, + REAL_ARITH_TAC);; + +let REAL_LT_01 = prove + (`&0 < &1`, + REAL_ARITH_TAC);; + +let REAL_LE_LADD = prove + (`!x y z. (x + y) <= (x + z) <=> y <= z`, + REAL_ARITH_TAC);; + +let REAL_LE_RADD = prove + (`!x y z. (x + z) <= (y + z) <=> x <= y`, + REAL_ARITH_TAC);; + +let REAL_LT_ADD2 = prove + (`!w x y z. w < x /\ y < z ==> (w + y) < (x + z)`, + REAL_ARITH_TAC);; + +let REAL_LE_ADD2 = prove + (`!w x y z. w <= x /\ y <= z ==> (w + y) <= (x + z)`, + REAL_ARITH_TAC);; + +let REAL_LT_LNEG = prove + (`!x y. --x < y <=> &0 < x + y`, + REWRITE_TAC[real_lt; REAL_LE_RNEG; REAL_ADD_AC]);; + +let REAL_LT_RNEG = prove + (`!x y. x < --y <=> x + y < &0`, + REWRITE_TAC[real_lt; REAL_LE_LNEG; REAL_ADD_AC]);; + +let REAL_LT_ADDNEG = prove + (`!x y z. y < (x + (--z)) <=> (y + z) < x`, + REAL_ARITH_TAC);; + +let REAL_LT_ADDNEG2 = prove + (`!x y z. (x + (--y)) < z <=> x < (z + y)`, + REAL_ARITH_TAC);; + +let REAL_LT_ADD1 = prove + (`!x y. x <= y ==> x < (y + &1)`, + REAL_ARITH_TAC);; + +let REAL_SUB_ADD = prove + (`!x y. (x - y) + y = x`, + REAL_ARITH_TAC);; + +let REAL_SUB_ADD2 = prove + (`!x y. y + (x - y) = x`, + REAL_ARITH_TAC);; + +let REAL_SUB_REFL = prove + (`!x. x - x = &0`, + REAL_ARITH_TAC);; + +let REAL_LE_DOUBLE = prove + (`!x. &0 <= x + x <=> &0 <= x`, + REAL_ARITH_TAC);; + +let REAL_LE_NEGL = prove + (`!x. (--x <= x) <=> (&0 <= x)`, + REAL_ARITH_TAC);; + +let REAL_LE_NEGR = prove + (`!x. (x <= --x) <=> (x <= &0)`, + REAL_ARITH_TAC);; + +let REAL_NEG_EQ_0 = prove + (`!x. (--x = &0) <=> (x = &0)`, + REAL_ARITH_TAC);; + +let REAL_ADD_SUB = prove + (`!x y. (x + y) - x = y`, + REAL_ARITH_TAC);; + +let REAL_NEG_EQ = prove + (`!x y. (--x = y) <=> (x = --y)`, + REAL_ARITH_TAC);; + +let REAL_NEG_MINUS1 = prove + (`!x. --x = (--(&1)) * x`, + REAL_ARITH_TAC);; + +let REAL_LT_IMP_NE = prove + (`!x y. x < y ==> ~(x = y)`, + REAL_ARITH_TAC);; + +let REAL_LE_ADDR = prove + (`!x y. x <= x + y <=> &0 <= y`, + REAL_ARITH_TAC);; + +let REAL_LE_ADDL = prove + (`!x y. y <= x + y <=> &0 <= x`, + REAL_ARITH_TAC);; + +let REAL_LT_ADDR = prove + (`!x y. x < x + y <=> &0 < y`, + REAL_ARITH_TAC);; + +let REAL_LT_ADDL = prove + (`!x y. y < x + y <=> &0 < x`, + REAL_ARITH_TAC);; + +let REAL_SUB_SUB = prove + (`!x y. (x - y) - x = --y`, + REAL_ARITH_TAC);; + +let REAL_LT_ADD_SUB = prove + (`!x y z. (x + y) < z <=> x < (z - y)`, + REAL_ARITH_TAC);; + +let REAL_LT_SUB_RADD = prove + (`!x y z. (x - y) < z <=> x < z + y`, + REAL_ARITH_TAC);; + +let REAL_LT_SUB_LADD = prove + (`!x y z. x < (y - z) <=> (x + z) < y`, + REAL_ARITH_TAC);; + +let REAL_LE_SUB_LADD = prove + (`!x y z. x <= (y - z) <=> (x + z) <= y`, + REAL_ARITH_TAC);; + +let REAL_LE_SUB_RADD = prove + (`!x y z. (x - y) <= z <=> x <= z + y`, + REAL_ARITH_TAC);; + +let REAL_LT_NEG = prove + (`!x y. --x < --y <=> y < x`, + REAL_ARITH_TAC);; + +let REAL_LE_NEG = prove + (`!x y. --x <= --y <=> y <= x`, + REAL_ARITH_TAC);; + +let REAL_ADD2_SUB2 = prove + (`!a b c d. (a + b) - (c + d) = (a - c) + (b - d)`, + REAL_ARITH_TAC);; + +let REAL_SUB_LZERO = prove + (`!x. &0 - x = --x`, + REAL_ARITH_TAC);; + +let REAL_SUB_RZERO = prove + (`!x. x - &0 = x`, + REAL_ARITH_TAC);; + +let REAL_LET_ADD2 = prove + (`!w x y z. w <= x /\ y < z ==> (w + y) < (x + z)`, + REAL_ARITH_TAC);; + +let REAL_LTE_ADD2 = prove + (`!w x y z. w < x /\ y <= z ==> w + y < x + z`, + REAL_ARITH_TAC);; + +let REAL_SUB_LNEG = prove + (`!x y. (--x) - y = --(x + y)`, + REAL_ARITH_TAC);; + +let REAL_SUB_RNEG = prove + (`!x y. x - (--y) = x + y`, + REAL_ARITH_TAC);; + +let REAL_SUB_NEG2 = prove + (`!x y. (--x) - (--y) = y - x`, + REAL_ARITH_TAC);; + +let REAL_SUB_TRIANGLE = prove + (`!a b c. (a - b) + (b - c) = a - c`, + REAL_ARITH_TAC);; + +let REAL_EQ_SUB_LADD = prove + (`!x y z. (x = y - z) <=> (x + z = y)`, + REAL_ARITH_TAC);; + +let REAL_EQ_SUB_RADD = prove + (`!x y z. (x - y = z) <=> (x = z + y)`, + REAL_ARITH_TAC);; + +let REAL_SUB_SUB2 = prove + (`!x y. x - (x - y) = y`, + REAL_ARITH_TAC);; + +let REAL_ADD_SUB2 = prove + (`!x y. x - (x + y) = --y`, + REAL_ARITH_TAC);; + +let REAL_EQ_IMP_LE = prove + (`!x y. (x = y) ==> x <= y`, + REAL_ARITH_TAC);; + +let REAL_POS_NZ = prove + (`!x. &0 < x ==> ~(x = &0)`, + REAL_ARITH_TAC);; + +let REAL_DIFFSQ = prove + (`!x y. (x + y) * (x - y) = (x * x) - (y * y)`, + REAL_ARITH_TAC);; + +let REAL_EQ_NEG2 = prove + (`!x y. (--x = --y) <=> (x = y)`, + REAL_ARITH_TAC);; + +let REAL_LT_NEG2 = prove + (`!x y. --x < --y <=> y < x`, + REAL_ARITH_TAC);; + +let REAL_SUB_LDISTRIB = prove + (`!x y z. x * (y - z) = x * y - x * z`, + REAL_ARITH_TAC);; + +let REAL_SUB_RDISTRIB = prove + (`!x y z. (x - y) * z = x * z - y * z`, + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Theorems about "abs". *) +(* ------------------------------------------------------------------------- *) + +let REAL_ABS_ZERO = prove + (`!x. (abs(x) = &0) <=> (x = &0)`, + REAL_ARITH_TAC);; + +let REAL_ABS_0 = prove + (`abs(&0) = &0`, + REAL_ARITH_TAC);; + +let REAL_ABS_1 = prove + (`abs(&1) = &1`, + REAL_ARITH_TAC);; + +let REAL_ABS_TRIANGLE = prove + (`!x y. abs(x + y) <= abs(x) + abs(y)`, + REAL_ARITH_TAC);; + +let REAL_ABS_TRIANGLE_LE = prove + (`!x y z.abs(x) + abs(y - x) <= z ==> abs(y) <= z`, + REAL_ARITH_TAC);; + +let REAL_ABS_TRIANGLE_LT = prove + (`!x y z.abs(x) + abs(y - x) < z ==> abs(y) < z`, + REAL_ARITH_TAC);; + +let REAL_ABS_POS = prove + (`!x. &0 <= abs(x)`, + REAL_ARITH_TAC);; + +let REAL_ABS_SUB = prove + (`!x y. abs(x - y) = abs(y - x)`, + REAL_ARITH_TAC);; + +let REAL_ABS_NZ = prove + (`!x. ~(x = &0) <=> &0 < abs(x)`, + REAL_ARITH_TAC);; + +let REAL_ABS_ABS = prove + (`!x. abs(abs(x)) = abs(x)`, + REAL_ARITH_TAC);; + +let REAL_ABS_LE = prove + (`!x. x <= abs(x)`, + REAL_ARITH_TAC);; + +let REAL_ABS_REFL = prove + (`!x. (abs(x) = x) <=> &0 <= x`, + REAL_ARITH_TAC);; + +let REAL_ABS_BETWEEN = prove + (`!x y d. &0 < d /\ ((x - d) < y) /\ (y < (x + d)) <=> abs(y - x) < d`, + REAL_ARITH_TAC);; + +let REAL_ABS_BOUND = prove + (`!x y d. abs(x - y) < d ==> y < (x + d)`, + REAL_ARITH_TAC);; + +let REAL_ABS_STILLNZ = prove + (`!x y. abs(x - y) < abs(y) ==> ~(x = &0)`, + REAL_ARITH_TAC);; + +let REAL_ABS_CASES = prove + (`!x. (x = &0) \/ &0 < abs(x)`, + REAL_ARITH_TAC);; + +let REAL_ABS_BETWEEN1 = prove + (`!x y z. x < z /\ (abs(y - x)) < (z - x) ==> y < z`, + REAL_ARITH_TAC);; + +let REAL_ABS_SIGN = prove + (`!x y. abs(x - y) < y ==> &0 < x`, + REAL_ARITH_TAC);; + +let REAL_ABS_SIGN2 = prove + (`!x y. abs(x - y) < --y ==> x < &0`, + REAL_ARITH_TAC);; + +let REAL_ABS_CIRCLE = prove + (`!x y h. abs(h) < (abs(y) - abs(x)) ==> abs(x + h) < abs(y)`, + REAL_ARITH_TAC);; + +let REAL_SUB_ABS = prove + (`!x y. (abs(x) - abs(y)) <= abs(x - y)`, + REAL_ARITH_TAC);; + +let REAL_ABS_SUB_ABS = prove + (`!x y. abs(abs(x) - abs(y)) <= abs(x - y)`, + REAL_ARITH_TAC);; + +let REAL_ABS_BETWEEN2 = prove + (`!x0 x y0 y. x0 < y0 /\ &2 * abs(x - x0) < (y0 - x0) /\ + &2 * abs(y - y0) < (y0 - x0) + ==> x < y`, + REAL_ARITH_TAC);; + +let REAL_ABS_BOUNDS = prove + (`!x k. abs(x) <= k <=> --k <= x /\ x <= k`, + REAL_ARITH_TAC);; + +let REAL_BOUNDS_LE = prove + (`!x k. --k <= x /\ x <= k <=> abs(x) <= k`, + REAL_ARITH_TAC);; + +let REAL_BOUNDS_LT = prove + (`!x k. --k < x /\ x < k <=> abs(x) < k`, + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Theorems about max and min. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MIN_MAX = prove + (`!x y. min x y = --(max (--x) (--y))`, + REAL_ARITH_TAC);; + +let REAL_MAX_MIN = prove + (`!x y. max x y = --(min (--x) (--y))`, + REAL_ARITH_TAC);; + +let REAL_MAX_MAX = prove + (`!x y. x <= max x y /\ y <= max x y`, + REAL_ARITH_TAC);; + +let REAL_MIN_MIN = prove + (`!x y. min x y <= x /\ min x y <= y`, + REAL_ARITH_TAC);; + +let REAL_MAX_SYM = prove + (`!x y. max x y = max y x`, + REAL_ARITH_TAC);; + +let REAL_MIN_SYM = prove + (`!x y. min x y = min y x`, + REAL_ARITH_TAC);; + +let REAL_LE_MAX = prove + (`!x y z. z <= max x y <=> z <= x \/ z <= y`, + REAL_ARITH_TAC);; + +let REAL_LE_MIN = prove + (`!x y z. z <= min x y <=> z <= x /\ z <= y`, + REAL_ARITH_TAC);; + +let REAL_LT_MAX = prove + (`!x y z. z < max x y <=> z < x \/ z < y`, + REAL_ARITH_TAC);; + +let REAL_LT_MIN = prove + (`!x y z. z < min x y <=> z < x /\ z < y`, + REAL_ARITH_TAC);; + +let REAL_MAX_LE = prove + (`!x y z. max x y <= z <=> x <= z /\ y <= z`, + REAL_ARITH_TAC);; + +let REAL_MIN_LE = prove + (`!x y z. min x y <= z <=> x <= z \/ y <= z`, + REAL_ARITH_TAC);; + +let REAL_MAX_LT = prove + (`!x y z. max x y < z <=> x < z /\ y < z`, + REAL_ARITH_TAC);; + +let REAL_MIN_LT = prove + (`!x y z. min x y < z <=> x < z \/ y < z`, + REAL_ARITH_TAC);; + +let REAL_MAX_ASSOC = prove + (`!x y z. max x (max y z) = max (max x y) z`, + REAL_ARITH_TAC);; + +let REAL_MIN_ASSOC = prove + (`!x y z. min x (min y z) = min (min x y) z`, + REAL_ARITH_TAC);; + +let REAL_MAX_ACI = prove + (`(max x y = max y x) /\ + (max (max x y) z = max x (max y z)) /\ + (max x (max y z) = max y (max x z)) /\ + (max x x = x) /\ + (max x (max x y) = max x y)`, + REAL_ARITH_TAC);; + +let REAL_MIN_ACI = prove + (`(min x y = min y x) /\ + (min (min x y) z = min x (min y z)) /\ + (min x (min y z) = min y (min x z)) /\ + (min x x = x) /\ + (min x (min x y) = min x y)`, + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* To simplify backchaining, just as in the natural number case. *) +(* ------------------------------------------------------------------------- *) + +let REAL_LE_IMP = + let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] REAL_LE_TRANS in + fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));; + +let REAL_LET_IMP = + let pth = PURE_ONCE_REWRITE_RULE[IMP_CONJ] REAL_LET_TRANS in + fun th -> GEN_ALL(MATCH_MP pth (SPEC_ALL th));; + +(* ------------------------------------------------------------------------- *) +(* Now a bit of nonlinear stuff. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ABS_MUL = prove + (`!x y. abs(x * y) = abs(x) * abs(y)`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC (SPEC `x:real` REAL_LE_NEGTOTAL) THENL + [ALL_TAC; + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_ABS_NEG]] THEN + (DISJ_CASES_TAC (SPEC `y:real` REAL_LE_NEGTOTAL) THENL + [ALL_TAC; + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_ABS_NEG]]) THEN + ASSUM_LIST(MP_TAC o MATCH_MP REAL_LE_MUL o end_itlist CONJ o rev) THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN DISCH_TAC THENL + [ALL_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ABS_NEG]; + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ABS_NEG]; + ALL_TAC] THEN + ASM_REWRITE_TAC[real_abs; REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let REAL_POW_LE = prove + (`!x n. &0 <= x ==> &0 <= x pow n`, + REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]);; + +let REAL_POW_LT = prove + (`!x n. &0 < x ==> &0 < x pow n`, + REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_LT_01] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]);; + +let REAL_ABS_POW = prove + (`!x n. abs(x pow n) = abs(x) pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; REAL_ABS_NUM; REAL_ABS_MUL]);; + +let REAL_LE_LMUL = prove + (`!x y z. &0 <= x /\ y <= z ==> x * y <= x * z`, + ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> &0 <= y - x`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_SUB_RZERO; REAL_LE_MUL]);; + +let REAL_LE_RMUL = prove + (`!x y z. x <= y /\ &0 <= z ==> x * z <= y * z`, + MESON_TAC[REAL_MUL_SYM; REAL_LE_LMUL]);; + +let REAL_LT_LMUL = prove + (`!x y z. &0 < x /\ y < z ==> x * y < x * z`, + ONCE_REWRITE_TAC[REAL_ARITH `x < y <=> &0 < y - x`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_SUB_RZERO; REAL_LT_MUL]);; + +let REAL_LT_RMUL = prove + (`!x y z. x < y /\ &0 < z ==> x * z < y * z`, + MESON_TAC[REAL_MUL_SYM; REAL_LT_LMUL]);; + +let REAL_EQ_MUL_LCANCEL = prove + (`!x y z. (x * y = x * z) <=> (x = &0) \/ (y = z)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `(x = y) <=> (x - y = &0)`] THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ENTIRE; REAL_SUB_RZERO]);; + +let REAL_EQ_MUL_RCANCEL = prove + (`!x y z. (x * z = y * z) <=> (x = y) \/ (z = &0)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_EQ_MUL_LCANCEL] THEN + MESON_TAC[]);; + +let REAL_MUL_LINV_UNIQ = prove + (`!x y. (x * y = &1) ==> (inv(y) = x)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `y = &0` THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_OF_NUM_EQ; ARITH_EQ] THEN + FIRST_ASSUM(SUBST1_TAC o SYM o MATCH_MP REAL_MUL_LINV) THEN + ASM_REWRITE_TAC[REAL_EQ_MUL_RCANCEL] THEN + DISCH_THEN(ACCEPT_TAC o SYM));; + +let REAL_MUL_RINV_UNIQ = prove + (`!x y. (x * y = &1) ==> (inv(x) = y)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_ACCEPT_TAC REAL_MUL_LINV_UNIQ);; + +let REAL_INV_INV = prove + (`!x. inv(inv x) = x`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_INV_0] THEN + MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN + MATCH_MP_TAC REAL_MUL_LINV THEN + ASM_REWRITE_TAC[]);; + +let REAL_EQ_INV2 = prove + (`!x y. inv(x) = inv(y) <=> x = y`, + MESON_TAC[REAL_INV_INV]);; + +let REAL_INV_EQ_0 = prove + (`!x. inv(x) = &0 <=> x = &0`, + GEN_TAC THEN EQ_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[REAL_INV_0] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN ASM_REWRITE_TAC[REAL_INV_0]);; + +let REAL_LT_INV = prove + (`!x. &0 < x ==> &0 < inv(x)`, + GEN_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (SPEC `inv(x)` REAL_LT_NEGTOTAL) THEN + ASM_REWRITE_TAC[] THENL + [RULE_ASSUM_TAC(REWRITE_RULE[REAL_INV_EQ_0]) THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN SUBGOAL_THEN `&0 < --(inv x) * x` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_LNEG]]] THEN + SUBGOAL_THEN `inv(x) * x = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN + UNDISCH_TAC `&0 < x` THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_LT_RNEG; REAL_ADD_LID; REAL_OF_NUM_LT; ARITH]]);; + +let REAL_LT_INV_EQ = prove + (`!x. &0 < inv x <=> &0 < x`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[REAL_LT_INV] THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [GSYM REAL_INV_INV] THEN + REWRITE_TAC[REAL_LT_INV]);; + +let REAL_INV_NEG = prove + (`!x. inv(--x) = --(inv x)`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_REWRITE_TAC[REAL_NEG_0; REAL_INV_0] THEN + MATCH_MP_TAC REAL_MUL_LINV_UNIQ THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG] THEN + MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]);; + +let REAL_LE_INV_EQ = prove + (`!x. &0 <= inv x <=> &0 <= x`, + REWRITE_TAC[REAL_LE_LT; REAL_LT_INV_EQ; REAL_INV_EQ_0] THEN + MESON_TAC[REAL_INV_EQ_0]);; + +let REAL_LE_INV = prove + (`!x. &0 <= x ==> &0 <= inv(x)`, + REWRITE_TAC[REAL_LE_INV_EQ]);; + +let REAL_MUL_RINV = prove + (`!x. ~(x = &0) ==> (x * inv(x) = &1)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + REWRITE_TAC[REAL_MUL_LINV]);; + +let REAL_INV_1 = prove + (`inv(&1) = &1`, + MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_INV_EQ_1 = prove + (`!x. inv(x) = &1 <=> x = &1`, + MESON_TAC[REAL_INV_INV; REAL_INV_1]);; + +let REAL_DIV_1 = prove + (`!x. x / &1 = x`, + REWRITE_TAC[real_div; REAL_INV_1; REAL_MUL_RID]);; + +let REAL_DIV_REFL = prove + (`!x. ~(x = &0) ==> (x / x = &1)`, + GEN_TAC THEN REWRITE_TAC[real_div; REAL_MUL_RINV]);; + +let REAL_DIV_RMUL = prove + (`!x y. ~(y = &0) ==> ((x / y) * y = x)`, + SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_RID]);; + +let REAL_DIV_LMUL = prove + (`!x y. ~(y = &0) ==> (y * (x / y) = x)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_DIV_RMUL]);; + +let REAL_ABS_INV = prove + (`!x. abs(inv x) = inv(abs x)`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_0] THEN + MATCH_MP_TAC REAL_MUL_RINV_UNIQ THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + POP_ASSUM(SUBST1_TAC o MATCH_MP REAL_MUL_RINV) THEN + REWRITE_TAC[REAL_ABS_1]);; + +let REAL_ABS_DIV = prove + (`!x y. abs(x / y) = abs(x) / abs(y)`, + REWRITE_TAC[real_div; REAL_ABS_INV; REAL_ABS_MUL]);; + +let REAL_INV_MUL = prove + (`!x y. inv(x * y) = inv(x) * inv(y)`, + REPEAT GEN_TAC THEN + MAP_EVERY ASM_CASES_TAC [`x = &0`; `y = &0`] THEN + ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_MUL_LINV_UNIQ THEN + ONCE_REWRITE_TAC[AC REAL_MUL_AC `(a * b) * (c * d) = (a * c) * (b * d)`] THEN + EVERY_ASSUM(SUBST1_TAC o MATCH_MP REAL_MUL_LINV) THEN + REWRITE_TAC[REAL_MUL_LID]);; + +let REAL_INV_DIV = prove + (`!x y. inv(x / y) = y / x`, + REWRITE_TAC[real_div; REAL_INV_INV; REAL_INV_MUL] THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM);; + +let REAL_POW_MUL = prove + (`!x y n. (x * y) pow n = (x pow n) * (y pow n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_MUL_AC]);; + +let REAL_POW_INV = prove + (`!x n. (inv x) pow n = inv(x pow n)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; REAL_INV_1; REAL_INV_MUL]);; + +let REAL_INV_POW = prove + (`!x n. inv(x pow n) = (inv x) pow n`, + REWRITE_TAC[REAL_POW_INV]);; + +let REAL_POW_DIV = prove + (`!x y n. (x / y) pow n = (x pow n) / (y pow n)`, + REWRITE_TAC[real_div; REAL_POW_MUL; REAL_POW_INV]);; + +let REAL_DIV_EQ_0 = prove + (`!x y. x / y = &0 <=> x = &0 \/ y = &0`, + REWRITE_TAC[real_div; REAL_INV_EQ_0; REAL_ENTIRE]);; + +let REAL_POW_ADD = prove + (`!x m n. x pow (m + n) = x pow m * x pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; real_pow; REAL_MUL_LID; REAL_MUL_ASSOC]);; + +let REAL_POW_NZ = prove + (`!x n. ~(x = &0) ==> ~(x pow n = &0)`, + GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_OF_NUM_EQ; ARITH] THEN + ASM_MESON_TAC[REAL_ENTIRE]);; + +let REAL_POW_SUB = prove + (`!x m n. ~(x = &0) /\ m <= n ==> (x pow (n - m) = x pow n / x pow m)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[ADD_SUB2] THEN REWRITE_TAC[REAL_POW_ADD] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_LINV THEN + MATCH_MP_TAC REAL_POW_NZ THEN ASM_REWRITE_TAC[]);; + +let REAL_LT_IMP_NZ = prove + (`!x. &0 < x ==> ~(x = &0)`, + REAL_ARITH_TAC);; + +let REAL_LT_LCANCEL_IMP = prove + (`!x y z. &0 < x /\ x * y < x * z ==> y < z`, + REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN DISCH_THEN + (MP_TAC o uncurry CONJ o (MATCH_MP REAL_LT_INV F_F I) o CONJ_PAIR) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_LT_LMUL) THEN + POP_ASSUM(ASSUME_TAC o MATCH_MP REAL_MUL_LINV o MATCH_MP REAL_LT_IMP_NZ) THEN + ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID]);; + +let REAL_LT_RCANCEL_IMP = prove + (`!x y z. &0 < z /\ x * z < y * z ==> x < y`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_LT_LCANCEL_IMP]);; + +let REAL_LE_LCANCEL_IMP = prove + (`!x y z. &0 < x /\ x * y <= x * z ==> y <= z`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT; REAL_EQ_MUL_LCANCEL] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[REAL_LT_REFL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN DISJ1_TAC THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; + +let REAL_LE_RCANCEL_IMP = prove + (`!x y z. &0 < z /\ x * z <= y * z ==> x <= y`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_LE_LCANCEL_IMP]);; + +let REAL_LE_RMUL_EQ = prove + (`!x y z. &0 < z ==> (x * z <= y * z <=> x <= y)`, + MESON_TAC[REAL_LE_RMUL; REAL_LE_RCANCEL_IMP; REAL_LT_IMP_LE]);; + +let REAL_LE_LMUL_EQ = prove + (`!x y z. &0 < z ==> (z * x <= z * y <=> x <= y)`, + MESON_TAC[REAL_LE_RMUL_EQ; REAL_MUL_SYM]);; + +let REAL_LT_RMUL_EQ = prove + (`!x y z. &0 < z ==> (x * z < y * z <=> x < y)`, + SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_RMUL_EQ]);; + +let REAL_LT_LMUL_EQ = prove + (`!x y z. &0 < z ==> (z * x < z * y <=> x < y)`, + SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LMUL_EQ]);; + +let REAL_LE_MUL_EQ = prove + (`(!x y. &0 < x ==> (&0 <= x * y <=> &0 <= y)) /\ + (!x y. &0 < y ==> (&0 <= x * y <=> &0 <= x))`, + MESON_TAC[REAL_LE_LMUL_EQ; REAL_LE_RMUL_EQ; REAL_MUL_LZERO; REAL_MUL_RZERO]);; + +let REAL_LT_MUL_EQ = prove + (`(!x y. &0 < x ==> (&0 < x * y <=> &0 < y)) /\ + (!x y. &0 < y ==> (&0 < x * y <=> &0 < x))`, + MESON_TAC[REAL_LT_LMUL_EQ; REAL_LT_RMUL_EQ; REAL_MUL_LZERO; REAL_MUL_RZERO]);; + +let REAL_MUL_POS_LT = prove + (`!x y. &0 < x * y <=> &0 < x /\ &0 < y \/ x < &0 /\ y < &0`, + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC(SPEC `x:real` REAL_LT_NEGTOTAL) THEN + STRIP_ASSUME_TAC(SPEC `y:real` REAL_LT_NEGTOTAL) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LT_REFL] THEN + ASSUM_LIST(MP_TAC o MATCH_MP REAL_LT_MUL o end_itlist CONJ) THEN + REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; + +let REAL_MUL_POS_LE = prove + (`!x y. &0 <= x * y <=> + x = &0 \/ y = &0 \/ &0 < x /\ &0 < y \/ x < &0 /\ y < &0`, + REWRITE_TAC[REAL_ARITH `&0 <= x <=> x = &0 \/ &0 < x`] THEN + REWRITE_TAC[REAL_MUL_POS_LT; REAL_ENTIRE] THEN REAL_ARITH_TAC);; + +let REAL_LE_RDIV_EQ = prove + (`!x y z. &0 < z ==> (x <= y / z <=> x * z <= y)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REAL_LE_RMUL_EQ th)]) THEN + ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; + REAL_MUL_RID; REAL_LT_IMP_NZ]);; + +let REAL_LE_LDIV_EQ = prove + (`!x y z. &0 < z ==> (x / z <= y <=> x <= y * z)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> + GEN_REWRITE_TAC LAND_CONV [GSYM(MATCH_MP REAL_LE_RMUL_EQ th)]) THEN + ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_LINV; + REAL_MUL_RID; REAL_LT_IMP_NZ]);; + +let REAL_LT_RDIV_EQ = prove + (`!x y z. &0 < z ==> (x < y / z <=> x * z < y)`, + SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_LDIV_EQ]);; + +let REAL_LT_LDIV_EQ = prove + (`!x y z. &0 < z ==> (x / z < y <=> x < y * z)`, + SIMP_TAC[GSYM REAL_NOT_LE; REAL_LE_RDIV_EQ]);; + +let REAL_EQ_RDIV_EQ = prove + (`!x y z. &0 < z ==> ((x = y / z) <=> (x * z = y))`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ]);; + +let REAL_EQ_LDIV_EQ = prove + (`!x y z. &0 < z ==> ((x / z = y) <=> (x = y * z))`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LE_LDIV_EQ]);; + +let REAL_LT_DIV2_EQ = prove + (`!x y z. &0 < z ==> (x / z < y / z <=> x < y)`, + SIMP_TAC[real_div; REAL_LT_RMUL_EQ; REAL_LT_INV_EQ]);; + +let REAL_LE_DIV2_EQ = prove + (`!x y z. &0 < z ==> (x / z <= y / z <=> x <= y)`, + SIMP_TAC[real_div; REAL_LE_RMUL_EQ; REAL_LT_INV_EQ]);; + +let REAL_MUL_2 = prove + (`!x. &2 * x = x + x`, + REAL_ARITH_TAC);; + +let REAL_POW_EQ_0 = prove + (`!x n. (x pow n = &0) <=> (x = &0) /\ ~(n = 0)`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[NOT_SUC; real_pow; REAL_ENTIRE] THENL + [REAL_ARITH_TAC; + CONV_TAC TAUT]);; + +let REAL_LE_MUL2 = prove + (`!w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z + ==> w * y <= x * z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `w * z` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL; MATCH_MP_TAC REAL_LE_RMUL] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[]);; + +let REAL_LT_MUL2 = prove + (`!w x y z. &0 <= w /\ w < x /\ &0 <= y /\ y < z + ==> w * y < x * z`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `w * z` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL; MATCH_MP_TAC REAL_LT_RMUL] THEN + ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[]]);; + +let REAL_LT_SQUARE = prove + (`!x. (&0 < x * x) <=> ~(x = &0)`, + GEN_TAC THEN REWRITE_TAC[REAL_LT_LE; REAL_LE_SQUARE] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[REAL_ENTIRE]);; + +let REAL_POW_1 = prove + (`!x. x pow 1 = x`, + REWRITE_TAC[num_CONV `1`] THEN + REWRITE_TAC[real_pow; REAL_MUL_RID]);; + +let REAL_POW_ONE = prove + (`!n. &1 pow n = &1`, + INDUCT_TAC THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]);; + +let REAL_LT_INV2 = prove + (`!x y. &0 < x /\ x < y ==> inv(y) < inv(x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN + EXISTS_TAC `x * y` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + SUBGOAL_THEN `(inv x * x = &1) /\ (inv y * y = &1)` ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_MUL_LINV THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_ASSOC; REAL_MUL_LID] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [REAL_MUL_SYM] THEN + ASM_REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RID]]]);; + +let REAL_LE_INV2 = prove + (`!x y. &0 < x /\ x <= y ==> inv(y) <= inv(x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_LE_LT] THEN + ASM_CASES_TAC `x:real = y` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[]);; + +let REAL_LT_LINV = prove + (`!x y. &0 < y /\ inv y < x ==> inv x < y`, + REPEAT STRIP_TAC THEN MP_TAC (SPEC `y:real` REAL_LT_INV) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC (SPECL [`(inv y:real)`; `x:real`] REAL_LT_INV2) THEN + ASM_REWRITE_TAC[REAL_INV_INV]);; + +let REAL_LT_RINV = prove + (`!x y. &0 < x /\ x < inv y ==> y < inv x`, + REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:real` REAL_LT_INV) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC (SPECL [`x:real`; `inv y:real`] REAL_LT_INV2) THEN + ASM_REWRITE_TAC[REAL_INV_INV]);; + +let REAL_LE_LINV = prove + (`!x y. &0 < y /\ inv y <= x ==> inv x <= y`, + REPEAT STRIP_TAC THEN MP_TAC (SPEC `y:real` REAL_LT_INV) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC (SPECL [`(inv y:real)`; `x:real`] REAL_LE_INV2) THEN + ASM_REWRITE_TAC[REAL_INV_INV]);; + +let REAL_LE_RINV = prove + (`!x y. &0 < x /\ x <= inv y ==> y <= inv x`, + REPEAT STRIP_TAC THEN MP_TAC (SPEC `x:real` REAL_LT_INV) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC (SPECL [`x:real`; `inv y:real`] REAL_LE_INV2) THEN + ASM_REWRITE_TAC[REAL_INV_INV]);; + +let REAL_INV_LE_1 = prove + (`!x. &1 <= x ==> inv(x) <= &1`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; + +let REAL_INV_1_LE = prove + (`!x. &0 < x /\ x <= &1 ==> &1 <= inv(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; + +let REAL_INV_LT_1 = prove + (`!x. &1 < x ==> inv(x) < &1`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; + +let REAL_INV_1_LT = prove + (`!x. &0 < x /\ x < &1 ==> &1 < inv(x)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_INV_1] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_01]);; + +let REAL_SUB_INV = prove + (`!x y. ~(x = &0) /\ ~(y = &0) ==> (inv(x) - inv(y) = (y - x) / (x * y))`, + REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; REAL_INV_MUL] THEN + SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM real_div] THEN + SIMP_TAC[REAL_DIV_LMUL]);; + +let REAL_DOWN = prove + (`!d. &0 < d ==> ?e. &0 < e /\ e < d`, + GEN_TAC THEN DISCH_TAC THEN EXISTS_TAC `d / &2` THEN + ASSUME_TAC(REAL_ARITH `&0 < &2`) THEN + ASSUME_TAC(MATCH_MP REAL_MUL_LINV (REAL_ARITH `~(&2 = &0)`)) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LT_RCANCEL_IMP THEN EXISTS_TAC `&2` THEN + ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_MUL_RID] THEN + UNDISCH_TAC `&0 < d` THEN REAL_ARITH_TAC);; + +let REAL_DOWN2 = prove + (`!d1 d2. &0 < d1 /\ &0 < d2 ==> ?e. &0 < e /\ e < d1 /\ e < d2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`d1:real`; `d2:real`] REAL_LE_TOTAL) THENL + [MP_TAC(SPEC `d1:real` REAL_DOWN); + MP_TAC(SPEC `d2:real` REAL_DOWN)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `e:real` THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + REAL_ARITH_TAC);; + +let REAL_POW_LE2 = prove + (`!n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n`, + INDUCT_TAC THEN REWRITE_TAC[real_pow; REAL_LE_REFL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +let REAL_POW_LE_1 = prove + (`!n x. &1 <= x ==> &1 <= x pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `&1`; `x:real`] REAL_POW_LE2) THEN + ASM_REWRITE_TAC[REAL_POW_ONE; REAL_POS]);; + +let REAL_POW_1_LE = prove + (`!n x. &0 <= x /\ x <= &1 ==> x pow n <= &1`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `x:real`; `&1`] REAL_POW_LE2) THEN + ASM_REWRITE_TAC[REAL_POW_ONE]);; + +let REAL_POW_MONO = prove + (`!m n x. &1 <= x /\ m <= n ==> x pow m <= x pow n`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + REWRITE_TAC[REAL_POW_ADD] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_OF_NUM_LE; ARITH] THEN + MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_POW_LE_1 THEN ASM_REWRITE_TAC[]]);; + +let REAL_POW_LT2 = prove + (`!n x y. ~(n = 0) /\ &0 <= x /\ x < y ==> x pow n < y pow n`, + INDUCT_TAC THEN REWRITE_TAC[NOT_SUC; real_pow] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[real_pow; REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +let REAL_POW_LT_1 = prove + (`!n x. ~(n = 0) /\ &1 < x ==> &1 < x pow n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `&1`; `x:real`] REAL_POW_LT2) THEN + ASM_REWRITE_TAC[REAL_POW_ONE; REAL_POS]);; + +let REAL_POW_1_LT = prove + (`!n x. ~(n = 0) /\ &0 <= x /\ x < &1 ==> x pow n < &1`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `x:real`; `&1`] REAL_POW_LT2) THEN + ASM_REWRITE_TAC[REAL_POW_ONE]);; + +let REAL_POW_MONO_LT = prove + (`!m n x. &1 < x /\ m < n ==> x pow m < x pow n`, + REPEAT GEN_TAC THEN REWRITE_TAC[LT_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[REAL_POW_ADD] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT; ARITH]; + SPEC_TAC(`d:num`,`d:num`) THEN + INDUCT_TAC THEN ONCE_REWRITE_TAC[real_pow] THENL + [ASM_REWRITE_TAC[real_pow; REAL_MUL_RID]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; ARITH]]);; + +let REAL_POW_POW = prove + (`!x m n. (x pow m) pow n = x pow (m * n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[real_pow; MULT_CLAUSES; REAL_POW_ADD]);; + +let REAL_EQ_RCANCEL_IMP = prove + (`!x y z. ~(z = &0) /\ (x * z = y * z) ==> (x = y)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_SUB_0] THEN + REWRITE_TAC[REAL_SUB_RZERO; GSYM REAL_SUB_RDISTRIB; REAL_ENTIRE] THEN + CONV_TAC TAUT);; + +let REAL_EQ_LCANCEL_IMP = prove + (`!x y z. ~(z = &0) /\ (z * x = z * y) ==> (x = y)`, + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN MATCH_ACCEPT_TAC REAL_EQ_RCANCEL_IMP);; + +let REAL_LT_DIV = prove + (`!x y. &0 < x /\ &0 < y ==> &0 < x / y`, + SIMP_TAC[REAL_LT_MUL; REAL_LT_INV_EQ; real_div]);; + +let REAL_LE_DIV = prove + (`!x y. &0 <= x /\ &0 <= y ==> &0 <= x / y`, + SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; real_div]);; + +let REAL_DIV_POW2 = prove + (`!x m n. ~(x = &0) + ==> (x pow m / x pow n = if n <= m then x pow (m - n) + else inv(x pow (n - m)))`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_POW_SUB] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_INV_DIV] THEN + UNDISCH_TAC `~(n:num <= m)` THEN REWRITE_TAC[NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP LT_IMP_LE) THEN + ASM_SIMP_TAC[REAL_POW_SUB]);; + +let REAL_DIV_POW2_ALT = prove + (`!x m n. ~(x = &0) + ==> (x pow m / x pow n = if n < m then x pow (m - n) + else inv(x pow (n - m)))`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + ONCE_REWRITE_TAC[REAL_INV_DIV] THEN + ASM_SIMP_TAC[GSYM NOT_LE; REAL_DIV_POW2] THEN + ASM_CASES_TAC `m <= n:num` THEN + ASM_REWRITE_TAC[REAL_INV_INV]);; + +let REAL_LT_POW2 = prove + (`!n. &0 < &2 pow n`, + SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; ARITH]);; + +let REAL_LE_POW2 = prove + (`!n. &1 <= &2 pow n`, + GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 pow 0` THEN + SIMP_TAC[REAL_POW_MONO; LE_0; REAL_OF_NUM_LE; ARITH] THEN + REWRITE_TAC[real_pow; REAL_LE_REFL]);; + +let REAL_POW2_ABS = prove + (`!x. abs(x) pow 2 = x pow 2`, + GEN_TAC THEN REWRITE_TAC[real_abs] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_POW_NEG; ARITH_EVEN]);; + +let REAL_LE_SQUARE_ABS = prove + (`!x y. abs(x) <= abs(y) <=> x pow 2 <= y pow 2`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MESON_TAC[REAL_POW_LE2; REAL_ABS_POS; NUM_EQ_CONV `2 = 0`; + REAL_POW_LT2; REAL_NOT_LE]);; + +let REAL_LT_SQUARE_ABS = prove + (`!x y. abs(x) < abs(y) <=> x pow 2 < y pow 2`, + REWRITE_TAC[GSYM REAL_NOT_LE; REAL_LE_SQUARE_ABS]);; + +let REAL_EQ_SQUARE_ABS = prove + (`!x y. abs x = abs y <=> x pow 2 = y pow 2`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_SQUARE_ABS]);; + +let REAL_LE_POW_2 = prove + (`!x. &0 <= x pow 2`, + REWRITE_TAC[REAL_POW_2; REAL_LE_SQUARE]);; + +let REAL_LT_POW_2 = prove + (`!x. &0 < x pow 2 <=> ~(x = &0)`, + REWRITE_TAC[REAL_LE_POW_2; REAL_ARITH `&0 < x <=> &0 <= x /\ ~(x = &0)`] THEN + REWRITE_TAC[REAL_POW_EQ_0; ARITH]);; + +let REAL_SOS_EQ_0 = prove + (`!x y. x pow 2 + y pow 2 = &0 <=> x = &0 /\ y = &0`, + REPEAT GEN_TAC THEN EQ_TAC THEN + SIMP_TAC[REAL_POW_2; REAL_MUL_LZERO; REAL_ADD_LID] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_ARITH + `x + y = &0 ==> &0 <= x /\ &0 <= y ==> x = &0 /\ y = &0`)) THEN + REWRITE_TAC[REAL_LE_SQUARE; REAL_ENTIRE]);; + +let REAL_POW_ZERO = prove + (`!n. &0 pow n = if n = 0 then &1 else &0`, + INDUCT_TAC THEN REWRITE_TAC[real_pow; NOT_SUC; REAL_MUL_LZERO]);; + +let REAL_POW_MONO_INV = prove + (`!m n x. &0 <= x /\ x <= &1 /\ n <= m ==> x pow m <= x pow n`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_POW_ZERO] THEN + REPEAT(COND_CASES_TAC THEN REWRITE_TAC[REAL_POS; REAL_LE_REFL]) THEN + UNDISCH_TAC `n:num <= m` THEN ASM_REWRITE_TAC[LE]; + GEN_REWRITE_TAC BINOP_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN REWRITE_TAC[GSYM REAL_POW_INV] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[REAL_LT_INV_EQ]; + MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INV_1_LE] THEN + ASM_REWRITE_TAC[REAL_LT_LE]]);; + +let REAL_POW_LE2_REV = prove + (`!n x y. ~(n = 0) /\ &0 <= y /\ x pow n <= y pow n ==> x <= y`, + MESON_TAC[REAL_POW_LT2; REAL_NOT_LE]);; + +let REAL_POW_LT2_REV = prove + (`!n x y. &0 <= y /\ x pow n < y pow n ==> x < y`, + MESON_TAC[REAL_POW_LE2; REAL_NOT_LE]);; + +let REAL_POW_EQ = prove + (`!n x y. ~(n = 0) /\ &0 <= x /\ &0 <= y /\ x pow n = y pow n ==> x = y`, + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN MESON_TAC[REAL_POW_LE2_REV]);; + +let REAL_POW_EQ_ABS = prove + (`!n x y. ~(n = 0) /\ x pow n = y pow n ==> abs x = abs y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[REAL_ABS_POS; GSYM REAL_ABS_POW]);; + +let REAL_POW_EQ_1_IMP = prove + (`!x n. ~(n = 0) /\ x pow n = &1 ==> abs(x) = &1`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_POW_EQ_ABS THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[REAL_POW_ONE]);; + +let REAL_POW_EQ_1 = prove + (`!x n. x pow n = &1 <=> abs(x) = &1 /\ (x < &0 ==> EVEN(n)) \/ n = 0`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[real_pow] THEN + ASM_CASES_TAC `abs(x) = &1` THENL + [ALL_TAC; ASM_MESON_TAC[REAL_POW_EQ_1_IMP]] THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(DISJ_CASES_THEN SUBST1_TAC o MATCH_MP (REAL_ARITH + `abs x = a ==> x = a \/ x = --a`)) THEN + ASM_REWRITE_TAC[REAL_POW_NEG; REAL_POW_ONE] THEN + REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let REAL_POW_LT2_ODD = prove + (`!n x y. x < y /\ ODD n ==> x pow n < y pow n`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[ARITH] THEN STRIP_TAC THEN + DISJ_CASES_TAC(SPEC `y:real` REAL_LE_NEGTOTAL) THENL + [DISJ_CASES_TAC(REAL_ARITH `&0 <= x \/ &0 < --x`) THEN + ASM_SIMP_TAC[REAL_POW_LT2] THEN + SUBGOAL_THEN `&0 < --x pow n /\ &0 <= y pow n` MP_TAC THENL + [ASM_SIMP_TAC[REAL_POW_LE; REAL_POW_LT]; + ASM_REWRITE_TAC[REAL_POW_NEG; GSYM NOT_ODD] THEN REAL_ARITH_TAC]; + SUBGOAL_THEN `--y pow n < --x pow n` MP_TAC THENL + [MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[REAL_POW_NEG; GSYM NOT_ODD]] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC]);; + +let REAL_POW_LE2_ODD = prove + (`!n x y. x <= y /\ ODD n ==> x pow n <= y pow n`, + REWRITE_TAC[REAL_LE_LT] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_POW_LT2_ODD]);; + +let REAL_POW_LT2_ODD_EQ = prove + (`!n x y. ODD n ==> (x pow n < y pow n <=> x < y)`, + MESON_TAC[REAL_POW_LT2_ODD; REAL_POW_LE2_ODD; REAL_NOT_LE]);; + +let REAL_POW_LE2_ODD_EQ = prove + (`!n x y. ODD n ==> (x pow n <= y pow n <=> x <= y)`, + MESON_TAC[REAL_POW_LT2_ODD; REAL_POW_LE2_ODD; REAL_NOT_LE]);; + +let REAL_POW_EQ_ODD_EQ = prove + (`!n x y. ODD n ==> (x pow n = y pow n <=> x = y)`, + SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_POW_LE2_ODD_EQ]);; + +let REAL_POW_EQ_ODD = prove + (`!n x y. ODD n /\ x pow n = y pow n ==> x = y`, + MESON_TAC[REAL_POW_EQ_ODD_EQ]);; + +let REAL_POW_EQ_EQ = prove + (`!n x y. x pow n = y pow n <=> + if EVEN n then n = 0 \/ abs x = abs y else x = y`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[real_pow; ARITH] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[REAL_POW_EQ_ODD_EQ; GSYM NOT_EVEN] THEN + EQ_TAC THENL [ASM_MESON_TAC[REAL_POW_EQ_ABS]; ALL_TAC] THEN + REWRITE_TAC[REAL_EQ_SQUARE_ABS] THEN DISCH_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` SUBST1_TAC o + REWRITE_RULE[EVEN_EXISTS]) THEN ASM_REWRITE_TAC[GSYM REAL_POW_POW]);; + +(* ------------------------------------------------------------------------- *) +(* Some basic forms of the Archimedian property. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ARCH_SIMPLE = prove + (`!x. ?n. x <= &n`, + let lemma = prove(`(!x. (?n. x = &n) ==> P x) <=> !n. P(&n)`,MESON_TAC[]) in + MP_TAC(SPEC `\y. ?n. y = &n` REAL_COMPLETE) THEN REWRITE_TAC[lemma] THEN + MESON_TAC[REAL_LE_SUB_LADD; REAL_OF_NUM_ADD; REAL_LE_TOTAL; + REAL_ARITH `~(M <= M - &1)`]);; + +let REAL_ARCH_LT = prove + (`!x. ?n. x < &n`, + MESON_TAC[REAL_ARCH_SIMPLE; REAL_OF_NUM_ADD; + REAL_ARITH `x <= n ==> x < n + &1`]);; + +let REAL_ARCH = prove + (`!x. &0 < x ==> !y. ?n. y < &n * x`, + MESON_TAC[REAL_ARCH_LT; REAL_LT_LDIV_EQ]);; + +(* ------------------------------------------------------------------------- *) +(* The sign of a real number, as a real number. *) +(* ------------------------------------------------------------------------- *) + +let real_sgn = new_definition + `(real_sgn:real->real) x = + if &0 < x then &1 else if x < &0 then -- &1 else &0`;; + +let REAL_SGN_0 = prove + (`real_sgn(&0) = &0`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_SGN_NEG = prove + (`!x. real_sgn(--x) = --(real_sgn x)`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_SGN_ABS = prove + (`!x. real_sgn(x) * abs(x) = x`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_EQ_SGN_ABS = prove + (`!x y:real. x = y <=> real_sgn x = real_sgn y /\ abs x = abs y`, + MESON_TAC[REAL_SGN_ABS]);; + +let REAL_ABS_SGN = prove + (`!x. abs(real_sgn x) = real_sgn(abs x)`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_SGN = prove + (`!x. real_sgn x = x / abs x`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_MUL_LZERO; REAL_SGN_0]; + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [GSYM REAL_SGN_ABS] THEN + ASM_SIMP_TAC[real_div; GSYM REAL_MUL_ASSOC; REAL_ABS_ZERO; + REAL_MUL_RINV; REAL_MUL_RID]]);; + +let REAL_SGN_MUL = prove + (`!x y. real_sgn(x * y) = real_sgn(x) * real_sgn(y)`, + REWRITE_TAC[REAL_SGN; REAL_ABS_MUL; real_div; REAL_INV_MUL] THEN + REAL_ARITH_TAC);; + +let REAL_SGN_INV = prove + (`!x. real_sgn(inv x) = real_sgn x`, + REWRITE_TAC[real_sgn; REAL_LT_INV_EQ; GSYM REAL_INV_NEG; + REAL_ARITH `x < &0 <=> &0 < --x`]);; + +let REAL_SGN_DIV = prove + (`!x y. real_sgn(x / y) = real_sgn(x) / real_sgn(y)`, + REWRITE_TAC[REAL_SGN; REAL_ABS_DIV] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN + REAL_ARITH_TAC);; + +let REAL_SGN_EQ = prove + (`(!x. real_sgn x = &0 <=> x = &0) /\ + (!x. real_sgn x = &1 <=> x > &0) /\ + (!x. real_sgn x = -- &1 <=> x < &0)`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_SGN_CASES = prove + (`!x. real_sgn x = &0 \/ real_sgn x = &1 \/ real_sgn x = -- &1`, + REWRITE_TAC[real_sgn] THEN MESON_TAC[]);; + +let REAL_SGN_INEQS = prove + (`(!x. &0 <= real_sgn x <=> &0 <= x) /\ + (!x. &0 < real_sgn x <=> &0 < x) /\ + (!x. &0 >= real_sgn x <=> &0 >= x) /\ + (!x. &0 > real_sgn x <=> &0 > x) /\ + (!x. &0 = real_sgn x <=> &0 = x) /\ + (!x. real_sgn x <= &0 <=> x <= &0) /\ + (!x. real_sgn x < &0 <=> x < &0) /\ + (!x. real_sgn x >= &0 <=> x >= &0) /\ + (!x. real_sgn x > &0 <=> x > &0) /\ + (!x. real_sgn x = &0 <=> x = &0)`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_SGN_POW = prove + (`!x n. real_sgn(x pow n) = real_sgn(x) pow n`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[REAL_SGN_MUL; real_pow] THEN + REWRITE_TAC[real_sgn; REAL_LT_01]);; + +let REAL_SGN_POW_2 = prove + (`!x. real_sgn(x pow 2) = real_sgn(abs x)`, + REWRITE_TAC[real_sgn] THEN + SIMP_TAC[GSYM REAL_NOT_LE; REAL_ABS_POS; REAL_LE_POW_2; + REAL_ARITH `&0 <= x ==> (x <= &0 <=> x = &0)`] THEN + REWRITE_TAC[REAL_POW_EQ_0; REAL_ABS_ZERO; ARITH]);; + +let REAL_SGN_REAL_SGN = prove + (`!x. real_sgn(real_sgn x) = real_sgn x`, + REWRITE_TAC[real_sgn] THEN REAL_ARITH_TAC);; + +let REAL_INV_SGN = prove + (`!x. real_inv(real_sgn x) = real_sgn x`, + GEN_TAC THEN REWRITE_TAC[real_sgn] THEN + REPEAT COND_CASES_TAC THEN + REWRITE_TAC[REAL_INV_0; REAL_INV_1; REAL_INV_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* Useful "without loss of generality" lemmas. *) +(* ------------------------------------------------------------------------- *) + +let REAL_WLOG_LE = prove + (`(!x y. P x y <=> P y x) /\ (!x y. x <= y ==> P x y) ==> !x y. P x y`, + MESON_TAC[REAL_LE_TOTAL]);; + +let REAL_WLOG_LT = prove + (`(!x. P x x) /\ (!x y. P x y <=> P y x) /\ (!x y. x < y ==> P x y) + ==> !x y. P x y`, + MESON_TAC[REAL_LT_TOTAL]);; diff --git a/realarith.ml b/realarith.ml new file mode 100644 index 0000000..818635f --- /dev/null +++ b/realarith.ml @@ -0,0 +1,637 @@ +(* ========================================================================= *) +(* Framework for universal real decision procedures, and a simple instance. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "calc_int.ml";; + +(* ------------------------------------------------------------------------- *) +(* Some lemmas needed now just to drive the decision procedure. *) +(* ------------------------------------------------------------------------- *) + +let REAL_LTE_TOTAL = prove + (`!x y. x < y \/ y <= x`, + REWRITE_TAC[real_lt] THEN CONV_TAC TAUT);; + +let REAL_LET_TOTAL = prove + (`!x y. x <= y \/ y < x`, + REWRITE_TAC[real_lt] THEN CONV_TAC TAUT);; + +let REAL_LT_IMP_LE = prove + (`!x y. x < y ==> x <= y`, + MESON_TAC[real_lt; REAL_LE_TOTAL]);; + +let REAL_LTE_TRANS = prove + (`!x y z. x < y /\ y <= z ==> x < z`, + MESON_TAC[real_lt; REAL_LE_TRANS]);; + +let REAL_LET_TRANS = prove + (`!x y z. x <= y /\ y < z ==> x < z`, + MESON_TAC[real_lt; REAL_LE_TRANS]);; + +let REAL_LT_TRANS = prove + (`!x y z. x < y /\ y < z ==> x < z`, + MESON_TAC[REAL_LTE_TRANS; REAL_LT_IMP_LE]);; + +let REAL_LE_ADD = prove + (`!x y. &0 <= x /\ &0 <= y ==> &0 <= x + y`, + MESON_TAC[REAL_LE_LADD_IMP; REAL_ADD_RID; REAL_LE_TRANS]);; + +let REAL_LTE_ANTISYM = prove + (`!x y. ~(x < y /\ y <= x)`, + MESON_TAC[real_lt]);; + +let REAL_SUB_LE = prove + (`!x y. &0 <= (x - y) <=> y <= x`, + REWRITE_TAC[real_sub; GSYM REAL_LE_LNEG; REAL_LE_NEG2]);; + +let REAL_NEG_SUB = prove + (`!x y. --(x - y) = y - x`, + REWRITE_TAC[real_sub; REAL_NEG_ADD; REAL_NEG_NEG] THEN + REWRITE_TAC[REAL_ADD_AC]);; + +let REAL_LE_LT = prove + (`!x y. x <= y <=> x < y \/ (x = y)`, + REWRITE_TAC[real_lt] THEN MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TOTAL]);; + +let REAL_SUB_LT = prove + (`!x y. &0 < (x - y) <=> y < x`, + REWRITE_TAC[real_lt] THEN ONCE_REWRITE_TAC[GSYM REAL_NEG_SUB] THEN + REWRITE_TAC[REAL_LE_LNEG; REAL_ADD_RID; REAL_SUB_LE]);; + +let REAL_NOT_LT = prove + (`!x y. ~(x < y) <=> y <= x`, + REWRITE_TAC[real_lt]);; + +let REAL_SUB_0 = prove + (`!x y. (x - y = &0) <=> (x = y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM REAL_NOT_LT] THEN + REWRITE_TAC[REAL_SUB_LE; REAL_SUB_LT] THEN REWRITE_TAC[REAL_NOT_LT]);; + +let REAL_LT_LE = prove + (`!x y. x < y <=> x <= y /\ ~(x = y)`, + MESON_TAC[real_lt; REAL_LE_TOTAL; REAL_LE_ANTISYM]);; + +let REAL_LT_REFL = prove + (`!x. ~(x < x)`, + REWRITE_TAC[real_lt; REAL_LE_REFL]);; + +let REAL_LTE_ADD = prove + (`!x y. &0 < x /\ &0 <= y ==> &0 < x + y`, + MESON_TAC[REAL_LE_LADD_IMP; REAL_ADD_RID; REAL_LTE_TRANS]);; + +let REAL_LET_ADD = prove + (`!x y. &0 <= x /\ &0 < y ==> &0 < x + y`, + MESON_TAC[REAL_LTE_ADD; REAL_ADD_SYM]);; + +let REAL_LT_ADD = prove + (`!x y. &0 < x /\ &0 < y ==> &0 < x + y`, + MESON_TAC[REAL_LT_IMP_LE; REAL_LTE_ADD]);; + +let REAL_ENTIRE = prove + (`!x y. (x * y = &0) <=> (x = &0) \/ (y = &0)`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o AP_TERM `(*) (inv x)`) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP REAL_MUL_LINV th]) THEN + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RZERO]);; + +let REAL_LE_NEGTOTAL = prove + (`!x. &0 <= x \/ &0 <= --x`, + REWRITE_TAC[REAL_LE_RNEG; REAL_ADD_LID; REAL_LE_TOTAL]);; + +let REAL_LE_SQUARE = prove + (`!x. &0 <= x * x`, + GEN_TAC THEN DISJ_CASES_TAC(SPEC `x:real` REAL_LE_NEGTOTAL) THEN + POP_ASSUM(fun th -> MP_TAC(MATCH_MP REAL_LE_MUL (CONJ th th))) THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_MUL_RNEG; REAL_NEG_NEG]);; + +let REAL_MUL_RID = prove + (`!x. x * &1 = x`, + MESON_TAC[REAL_MUL_LID; REAL_MUL_SYM]);; + +let REAL_POW_2 = prove + (`!x. x pow 2 = x * x`, + REWRITE_TAC[num_CONV `2`; num_CONV `1`] THEN + REWRITE_TAC[real_pow; REAL_MUL_RID]);; + +let REAL_POLY_CLAUSES = prove + (`(!x y z. x + (y + z) = (x + y) + z) /\ + (!x y. x + y = y + x) /\ + (!x. &0 + x = x) /\ + (!x y z. x * (y * z) = (x * y) * z) /\ + (!x y. x * y = y * x) /\ + (!x. &1 * x = x) /\ + (!x. &0 * x = &0) /\ + (!x y z. x * (y + z) = x * y + x * z) /\ + (!x. x pow 0 = &1) /\ + (!x n. x pow (SUC n) = x * x pow n)`, + REWRITE_TAC[real_pow; REAL_ADD_LDISTRIB; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_ADD_LID; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ADD_AC] THEN REWRITE_TAC[REAL_MUL_SYM]);; + +let REAL_POLY_NEG_CLAUSES = prove + (`(!x. --x = --(&1) * x) /\ + (!x y. x - y = x + --(&1) * y)`, + REWRITE_TAC[REAL_MUL_LNEG; real_sub; REAL_MUL_LID]);; + +let REAL_POS = prove + (`!n. &0 <= &n`, + REWRITE_TAC[REAL_OF_NUM_LE; LE_0]);; + +(* ------------------------------------------------------------------------- *) +(* Data structure for Positivstellensatz refutations. *) +(* ------------------------------------------------------------------------- *) + +type positivstellensatz = + Axiom_eq of int + | Axiom_le of int + | Axiom_lt of int + | Rational_eq of num + | Rational_le of num + | Rational_lt of num + | Square of term + | Eqmul of term * positivstellensatz + | Sum of positivstellensatz * positivstellensatz + | Product of positivstellensatz * positivstellensatz;; + +(* ------------------------------------------------------------------------- *) +(* Parametrized reals decision procedure. *) +(* *) +(* This is a bootstrapping version, and subsequently gets overwritten twice *) +(* with more specialized versions, once here and finally in "calc_rat.ml". *) +(* ------------------------------------------------------------------------- *) + +let GEN_REAL_ARITH = + let pth = prove + (`(x < y <=> y - x > &0) /\ + (x <= y <=> y - x >= &0) /\ + (x > y <=> x - y > &0) /\ + (x >= y <=> x - y >= &0) /\ + ((x = y) <=> (x - y = &0)) /\ + (~(x < y) <=> x - y >= &0) /\ + (~(x <= y) <=> x - y > &0) /\ + (~(x > y) <=> y - x >= &0) /\ + (~(x >= y) <=> y - x > &0) /\ + (~(x = y) <=> x - y > &0 \/ --(x - y) > &0)`, + REWRITE_TAC[real_gt; real_ge; REAL_SUB_LT; REAL_SUB_LE; REAL_NEG_SUB] THEN + REWRITE_TAC[REAL_SUB_0; real_lt] THEN MESON_TAC[REAL_LE_ANTISYM]) + and pth_final = TAUT `(~p ==> F) ==> p` + and pth_add = prove + (`((x = &0) /\ (y = &0) ==> (x + y = &0)) /\ + ((x = &0) /\ y >= &0 ==> x + y >= &0) /\ + ((x = &0) /\ y > &0 ==> x + y > &0) /\ + (x >= &0 /\ (y = &0) ==> x + y >= &0) /\ + (x >= &0 /\ y >= &0 ==> x + y >= &0) /\ + (x >= &0 /\ y > &0 ==> x + y > &0) /\ + (x > &0 /\ (y = &0) ==> x + y > &0) /\ + (x > &0 /\ y >= &0 ==> x + y > &0) /\ + (x > &0 /\ y > &0 ==> x + y > &0)`, + SIMP_TAC[REAL_ADD_LID; REAL_ADD_RID; real_ge; real_gt] THEN + REWRITE_TAC[REAL_LE_LT] THEN + MESON_TAC[REAL_ADD_LID; REAL_ADD_RID; REAL_LT_ADD]) + and pth_mul = prove + (`((x = &0) /\ (y = &0) ==> (x * y = &0)) /\ + ((x = &0) /\ y >= &0 ==> (x * y = &0)) /\ + ((x = &0) /\ y > &0 ==> (x * y = &0)) /\ + (x >= &0 /\ (y = &0) ==> (x * y = &0)) /\ + (x >= &0 /\ y >= &0 ==> x * y >= &0) /\ + (x >= &0 /\ y > &0 ==> x * y >= &0) /\ + (x > &0 /\ (y = &0) ==> (x * y = &0)) /\ + (x > &0 /\ y >= &0 ==> x * y >= &0) /\ + (x > &0 /\ y > &0 ==> x * y > &0)`, + SIMP_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; real_ge; real_gt] THEN + SIMP_TAC[REAL_LT_LE; REAL_LE_MUL] THEN MESON_TAC[REAL_ENTIRE]) + and pth_emul = prove + (`(y = &0) ==> !x. x * y = &0`, + SIMP_TAC[REAL_MUL_RZERO]) + and pth_square = prove + (`!x. x * x >= &0`, + REWRITE_TAC[real_ge; REAL_POW_2; REAL_LE_SQUARE]) + and MATCH_MP_RULE th = + let net = itlist + (fun th -> net_of_conv (lhand(concl th)) (PART_MATCH lhand th)) + (CONJUNCTS th) empty_net in + fun th -> MP (REWRITES_CONV net (concl th)) th + and x_tm = `x:real` and y_tm = `y:real` + and neg_tm = `(--):real->real` + and gt_tm = `(>):real->real->bool` + and ge_tm = `(>=):real->real->bool` + and eq_tm = `(=):real->real->bool` + and p_tm = `p:bool` + and or_tm = `(\/)` + and false_tm = `F` + and z_tm = `&0 :real` + and xy_lt = `(x:real) < y` + and xy_nlt = `~((x:real) < y)` + and xy_le = `(x:real) <= y` + and xy_nle = `~((x:real) <= y)` + and xy_gt = `(x:real) > y` + and xy_ngt = `~((x:real) > y)` + and xy_ge = `(x:real) >= y` + and xy_nge = `~((x:real) >= y)` + and xy_eq = `x:real = y` + and xy_ne = `~(x:real = y)` in + let is_ge = is_binop ge_tm + and is_gt = is_binop gt_tm + and is_req = is_binop eq_tm in + fun (mk_numeric, + NUMERIC_EQ_CONV,NUMERIC_GE_CONV,NUMERIC_GT_CONV, + POLY_CONV,POLY_NEG_CONV,POLY_ADD_CONV,POLY_MUL_CONV, + absconv1,absconv2,prover) -> + let REAL_INEQ_CONV pth tm = + let lop,r = dest_comb tm in + let th = INST [rand lop,x_tm; r,y_tm] pth in + TRANS th (LAND_CONV POLY_CONV (rand(concl th))) in + let [REAL_LT_CONV; REAL_LE_CONV; REAL_GT_CONV; REAL_GE_CONV; REAL_EQ_CONV; + REAL_NOT_LT_CONV; REAL_NOT_LE_CONV; REAL_NOT_GT_CONV; + REAL_NOT_GE_CONV; _] = + map REAL_INEQ_CONV (CONJUNCTS pth) + and REAL_NOT_EQ_CONV = + let pth = last(CONJUNCTS pth) in + fun tm -> + let l,r = dest_eq tm in + let th = INST [l,x_tm; r,y_tm] pth in + let th_p = POLY_CONV(lhand(lhand(rand(concl th)))) in + let th_x = AP_TERM neg_tm th_p in + let th_n = CONV_RULE (RAND_CONV POLY_NEG_CONV) th_x in + let th' = MK_DISJ (AP_THM (AP_TERM gt_tm th_p) z_tm) + (AP_THM (AP_TERM gt_tm th_n) z_tm) in + TRANS th th' in + let net_single = itlist (uncurry net_of_conv) + [xy_lt,REAL_LT_CONV; + xy_nlt,(fun t -> REAL_NOT_LT_CONV(rand t)); + xy_le,REAL_LE_CONV; + xy_nle,(fun t -> REAL_NOT_LE_CONV(rand t)); + xy_gt,REAL_GT_CONV; + xy_ngt,(fun t -> REAL_NOT_GT_CONV(rand t)); + xy_ge,REAL_GE_CONV; + xy_nge,(fun t -> REAL_NOT_GE_CONV(rand t)); + xy_eq,REAL_EQ_CONV; + xy_ne,(fun t -> REAL_NOT_EQ_CONV(rand t))] + empty_net + and net_double = itlist (uncurry net_of_conv) + [xy_lt,(fun t -> REAL_LT_CONV t,REAL_NOT_LT_CONV t); + xy_le,(fun t -> REAL_LE_CONV t,REAL_NOT_LE_CONV t); + xy_gt,(fun t -> REAL_GT_CONV t,REAL_NOT_GT_CONV t); + xy_ge,(fun t -> REAL_GE_CONV t,REAL_NOT_GE_CONV t); + xy_eq,(fun t -> REAL_EQ_CONV t,REAL_NOT_EQ_CONV t)] + empty_net in + let REAL_INEQ_NORM_CONV = REWRITES_CONV net_single + and REAL_INEQ_NORM_DCONV = REWRITES_CONV net_double in + let NNF_NORM_CONV = + GEN_NNF_CONV false (REAL_INEQ_NORM_CONV,REAL_INEQ_NORM_DCONV) in + let MUL_RULE = + let rules = MATCH_MP_RULE pth_mul in + fun th -> CONV_RULE(LAND_CONV POLY_MUL_CONV) (rules th) + and ADD_RULE = + let rules = MATCH_MP_RULE pth_add in + fun th -> CONV_RULE(LAND_CONV POLY_ADD_CONV) (rules th) + and EMUL_RULE = + let rule = MATCH_MP pth_emul in + fun tm th -> CONV_RULE (LAND_CONV POLY_MUL_CONV) + (SPEC tm (rule th)) + and SQUARE_RULE t = + CONV_RULE (LAND_CONV POLY_MUL_CONV) (SPEC t pth_square) in + let hol_of_positivstellensatz(eqs,les,lts) = + let rec translate prf = + match prf with + Axiom_eq n -> el n eqs + | Axiom_le n -> el n les + | Axiom_lt n -> el n lts + | Rational_eq x -> + EQT_ELIM(NUMERIC_EQ_CONV(mk_comb(mk_comb(eq_tm,mk_numeric x),z_tm))) + | Rational_le x -> + EQT_ELIM(NUMERIC_GE_CONV(mk_comb(mk_comb(ge_tm,mk_numeric x),z_tm))) + | Rational_lt x -> + EQT_ELIM(NUMERIC_GT_CONV(mk_comb(mk_comb(gt_tm,mk_numeric x),z_tm))) + | Square t -> SQUARE_RULE t + | Eqmul(t,p) -> EMUL_RULE t (translate p) + | Sum(p1,p2) -> ADD_RULE (CONJ (translate p1) (translate p2)) + | Product(p1,p2) -> MUL_RULE (CONJ (translate p1) (translate p2)) in + fun prf -> + CONV_RULE(FIRST_CONV[NUMERIC_GE_CONV; NUMERIC_GT_CONV; NUMERIC_EQ_CONV]) + (translate prf) in + let init_conv = + TOP_DEPTH_CONV BETA_CONV THENC + PRESIMP_CONV THENC + NNF_CONV THENC DEPTH_BINOP_CONV or_tm CONDS_ELIM_CONV THENC + NNF_NORM_CONV THENC + SKOLEM_CONV THENC + PRENEX_CONV THENC + WEAK_DNF_CONV in + let rec overall dun ths = + match ths with + [] -> + let eq,ne = partition (is_req o concl) dun in + let le,nl = partition (is_ge o concl) ne in + let lt = filter (is_gt o concl) nl in + prover hol_of_positivstellensatz (eq,le,lt) + | th::oths -> + let tm = concl th in + if is_conj tm then + let th1,th2 = CONJ_PAIR th in + overall dun (th1::th2::oths) + else if is_disj tm then + let th1 = overall dun (ASSUME (lhand tm)::oths) + and th2 = overall dun (ASSUME (rand tm)::oths) in + DISJ_CASES th th1 th2 + else overall (th::dun) oths in + fun tm -> + let NNF_NORM_CONV' = + GEN_NNF_CONV false + (CACHE_CONV REAL_INEQ_NORM_CONV,fun t -> failwith "") in + let rec absremover t = + (TOP_DEPTH_CONV(absconv1 THENC BINOP_CONV (LAND_CONV POLY_CONV)) THENC + TRY_CONV(absconv2 THENC NNF_NORM_CONV' THENC BINOP_CONV absremover)) t in + let th0 = init_conv(mk_neg tm) in + let tm0 = rand(concl th0) in + let th = + if tm0 = false_tm then fst(EQ_IMP_RULE th0) else + let evs,bod = strip_exists tm0 in + let avs,ibod = strip_forall bod in + let th1 = itlist MK_FORALL avs (DEPTH_BINOP_CONV or_tm absremover ibod) in + let th2 = overall [] [SPECL avs (ASSUME(rand(concl th1)))] in + let th3 = + itlist SIMPLE_CHOOSE evs (PROVE_HYP (EQ_MP th1 (ASSUME bod)) th2) in + DISCH_ALL(PROVE_HYP (EQ_MP th0 (ASSUME (mk_neg tm))) th3) in + MP (INST [tm,p_tm] pth_final) th;; + +(* ------------------------------------------------------------------------- *) +(* Linear prover. This works over the rationals in general, but is designed *) +(* to be OK on integers provided the input contains only integers. *) +(* ------------------------------------------------------------------------- *) + +let REAL_LINEAR_PROVER = + let linear_add = combine (+/) (fun z -> z =/ num_0) + and linear_cmul c = mapf (fun x -> c */ x) + and one_tm = `&1` in + let contradictory p (e,_) = + (is_undefined e & not(p num_0)) or + (dom e = [one_tm] & not(p(apply e one_tm))) in + let rec linear_ineqs vars (les,lts) = + try find (contradictory (fun x -> x >/ num_0)) lts with Failure _ -> + try find (contradictory (fun x -> x >=/ num_0)) les with Failure _ -> + if vars = [] then failwith "linear_ineqs: no contradiction" else + let ineqs = les @ lts in + let blowup v = + length(filter (fun (e,_) -> tryapplyd e v num_0 >/ num_0) ineqs) * + length(filter (fun (e,_) -> tryapplyd e v num_0 i < j) + (map (fun v -> v,blowup v) vars))) in + let addup (e1,p1) (e2,p2) acc = + let c1 = tryapplyd e1 v num_0 and c2 = tryapplyd e2 v num_0 in + if c1 */ c2 >=/ num_0 then acc else + let e1' = linear_cmul (abs_num c2) e1 + and e2' = linear_cmul (abs_num c1) e2 + and p1' = Product(Rational_lt(abs_num c2),p1) + and p2' = Product(Rational_lt(abs_num c1),p2) in + (linear_add e1' e2',Sum(p1',p2'))::acc in + let les0,les1 = partition (fun (e,_) -> tryapplyd e v num_0 =/ num_0) les + and lts0,lts1 = partition (fun (e,_) -> tryapplyd e v num_0 =/ num_0) lts in + let lesp,lesn = partition (fun (e,_) -> tryapplyd e v num_0 >/ num_0) les1 + and ltsp,ltsn = partition + (fun (e,_) -> tryapplyd e v num_0 >/ num_0) lts1 in + let les' = itlist (fun ep1 -> itlist (addup ep1) lesp) lesn les0 + and lts' = itlist (fun ep1 -> itlist (addup ep1) (lesp@ltsp)) ltsn + (itlist (fun ep1 -> itlist (addup ep1) (lesn@ltsn)) ltsp + lts0) in + linear_ineqs (subtract vars [v]) (les',lts') in + let rec linear_eqs(eqs,les,lts) = + try find (contradictory (fun x -> x =/ num_0)) eqs with Failure _ -> + match eqs with + [] -> let vars = subtract + (itlist (union o dom o fst) (les@lts) []) [one_tm] in + linear_ineqs vars (les,lts) + | (e,p)::es -> if is_undefined e then linear_eqs(es,les,lts) else + let x,c = choose (undefine one_tm e) in + let xform(t,q as inp) = + let d = tryapplyd t x num_0 in + if d =/ num_0 then inp else + let k = minus_num d */ abs_num c // c in + let e' = linear_cmul k e + and t' = linear_cmul (abs_num c) t + and p' = Eqmul(term_of_rat k,p) + and q' = Product(Rational_lt(abs_num c),q) in + linear_add e' t',Sum(p',q') in + linear_eqs(map xform es,map xform les,map xform lts) in + let linear_prover = + fun (eq,le,lt) -> + let eqs = map2 (fun p n -> p,Axiom_eq n) eq (0--(length eq-1)) + and les = map2 (fun p n -> p,Axiom_le n) le (0--(length le-1)) + and lts = map2 (fun p n -> p,Axiom_lt n) lt (0--(length lt-1)) in + linear_eqs(eqs,les,lts) in + let lin_of_hol = + let one_tm = `&1` + and zero_tm = `&0` + and add_tm = `(+):real->real->real` + and mul_tm = `(*):real->real->real` in + let rec lin_of_hol tm = + if tm = zero_tm then undefined + else if not (is_comb tm) then (tm |=> Int 1) + else if is_ratconst tm then (one_tm |=> rat_of_term tm) else + let lop,r = dest_comb tm in + if not (is_comb lop) then (tm |=> Int 1) else + let op,l = dest_comb lop in + if op = add_tm then linear_add (lin_of_hol l) (lin_of_hol r) + else if op = mul_tm & is_ratconst l then (r |=> rat_of_term l) + else (tm |=> Int 1) in + lin_of_hol in + let is_alien tm = + match tm with + Comb(Const("real_of_num",_),n) when not(is_numeral n) -> true + | _ -> false in + let n_tm = `n:num` in + let pth = REWRITE_RULE[GSYM real_ge] (SPEC n_tm REAL_POS) in + fun translator (eq,le,lt) -> + let eq_pols = map (lin_of_hol o lhand o concl) eq + and le_pols = map (lin_of_hol o lhand o concl) le + and lt_pols = map (lin_of_hol o lhand o concl) lt in + let aliens = filter is_alien + (itlist (union o dom) (eq_pols @ le_pols @ lt_pols) []) in + let le_pols' = le_pols @ map (fun v -> (v |=> Int 1)) aliens in + let _,proof = linear_prover(eq_pols,le_pols',lt_pols) in + let le' = le @ map (fun a -> INST [rand a,n_tm] pth) aliens in + translator (eq,le',lt) proof;; + +(* ------------------------------------------------------------------------- *) +(* Bootstrapping REAL_ARITH: trivial abs-elim and only integer constants. *) +(* ------------------------------------------------------------------------- *) + +let REAL_ARITH = + let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, + REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = + SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES + (is_realintconst, + REAL_INT_ADD_CONV,REAL_INT_MUL_CONV,REAL_INT_POW_CONV) + (<) in + let rule = + GEN_REAL_ARITH + (mk_realintconst, + REAL_INT_EQ_CONV,REAL_INT_GE_CONV,REAL_INT_GT_CONV, + REAL_POLY_CONV,REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_MUL_CONV, + NO_CONV,NO_CONV,REAL_LINEAR_PROVER) + and deabs_conv = REWRITE_CONV[real_abs; real_max; real_min] in + fun tm -> + let th1 = deabs_conv tm in + EQ_MP (SYM th1) (rule(rand(concl th1)));; + +(* ------------------------------------------------------------------------- *) +(* Slightly less parametrized GEN_REAL_ARITH with more intelligent *) +(* elimination of abs, max and min hardwired in. *) +(* ------------------------------------------------------------------------- *) + +let GEN_REAL_ARITH = + let ABSMAXMIN_ELIM_CONV1 = + GEN_REWRITE_CONV I [time REAL_ARITH + `(--(&1) * abs(x) >= r <=> + --(&1) * x >= r /\ &1 * x >= r) /\ + (--(&1) * abs(x) + a >= r <=> + a + --(&1) * x >= r /\ a + &1 * x >= r) /\ + (a + --(&1) * abs(x) >= r <=> + a + --(&1) * x >= r /\ a + &1 * x >= r) /\ + (a + --(&1) * abs(x) + b >= r <=> + a + --(&1) * x + b >= r /\ a + &1 * x + b >= r) /\ + (a + b + --(&1) * abs(x) >= r <=> + a + b + --(&1) * x >= r /\ a + b + &1 * x >= r) /\ + (a + b + --(&1) * abs(x) + c >= r <=> + a + b + --(&1) * x + c >= r /\ a + b + &1 * x + c >= r) /\ + (--(&1) * max x y >= r <=> + --(&1) * x >= r /\ --(&1) * y >= r) /\ + (--(&1) * max x y + a >= r <=> + a + --(&1) * x >= r /\ a + --(&1) * y >= r) /\ + (a + --(&1) * max x y >= r <=> + a + --(&1) * x >= r /\ a + --(&1) * y >= r) /\ + (a + --(&1) * max x y + b >= r <=> + a + --(&1) * x + b >= r /\ a + --(&1) * y + b >= r) /\ + (a + b + --(&1) * max x y >= r <=> + a + b + --(&1) * x >= r /\ a + b + --(&1) * y >= r) /\ + (a + b + --(&1) * max x y + c >= r <=> + a + b + --(&1) * x + c >= r /\ a + b + --(&1) * y + c >= r) /\ + (&1 * min x y >= r <=> + &1 * x >= r /\ &1 * y >= r) /\ + (&1 * min x y + a >= r <=> + a + &1 * x >= r /\ a + &1 * y >= r) /\ + (a + &1 * min x y >= r <=> + a + &1 * x >= r /\ a + &1 * y >= r) /\ + (a + &1 * min x y + b >= r <=> + a + &1 * x + b >= r /\ a + &1 * y + b >= r) /\ + (a + b + &1 * min x y >= r <=> + a + b + &1 * x >= r /\ a + b + &1 * y >= r) /\ + (a + b + &1 * min x y + c >= r <=> + a + b + &1 * x + c >= r /\ a + b + &1 * y + c >= r) /\ + (min x y >= r <=> + x >= r /\ y >= r) /\ + (min x y + a >= r <=> + a + x >= r /\ a + y >= r) /\ + (a + min x y >= r <=> + a + x >= r /\ a + y >= r) /\ + (a + min x y + b >= r <=> + a + x + b >= r /\ a + y + b >= r) /\ + (a + b + min x y >= r <=> + a + b + x >= r /\ a + b + y >= r) /\ + (a + b + min x y + c >= r <=> + a + b + x + c >= r /\ a + b + y + c >= r) /\ + (--(&1) * abs(x) > r <=> + --(&1) * x > r /\ &1 * x > r) /\ + (--(&1) * abs(x) + a > r <=> + a + --(&1) * x > r /\ a + &1 * x > r) /\ + (a + --(&1) * abs(x) > r <=> + a + --(&1) * x > r /\ a + &1 * x > r) /\ + (a + --(&1) * abs(x) + b > r <=> + a + --(&1) * x + b > r /\ a + &1 * x + b > r) /\ + (a + b + --(&1) * abs(x) > r <=> + a + b + --(&1) * x > r /\ a + b + &1 * x > r) /\ + (a + b + --(&1) * abs(x) + c > r <=> + a + b + --(&1) * x + c > r /\ a + b + &1 * x + c > r) /\ + (--(&1) * max x y > r <=> + --(&1) * x > r /\ --(&1) * y > r) /\ + (--(&1) * max x y + a > r <=> + a + --(&1) * x > r /\ a + --(&1) * y > r) /\ + (a + --(&1) * max x y > r <=> + a + --(&1) * x > r /\ a + --(&1) * y > r) /\ + (a + --(&1) * max x y + b > r <=> + a + --(&1) * x + b > r /\ a + --(&1) * y + b > r) /\ + (a + b + --(&1) * max x y > r <=> + a + b + --(&1) * x > r /\ a + b + --(&1) * y > r) /\ + (a + b + --(&1) * max x y + c > r <=> + a + b + --(&1) * x + c > r /\ a + b + --(&1) * y + c > r) /\ + (min x y > r <=> + x > r /\ y > r) /\ + (min x y + a > r <=> + a + x > r /\ a + y > r) /\ + (a + min x y > r <=> + a + x > r /\ a + y > r) /\ + (a + min x y + b > r <=> + a + x + b > r /\ a + y + b > r) /\ + (a + b + min x y > r <=> + a + b + x > r /\ a + b + y > r) /\ + (a + b + min x y + c > r <=> + a + b + x + c > r /\ a + b + y + c > r)`] + and ABSMAXMIN_ELIM_CONV2 = + let pth_abs = prove + (`P(abs x) <=> (x >= &0 /\ P x) \/ (&0 > x /\ P (--x))`, + REWRITE_TAC[real_abs; real_gt; real_ge] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[real_lt]) + and pth_max = prove + (`P(max x y) <=> (y >= x /\ P y) \/ (x > y /\ P x)`, + REWRITE_TAC[real_max; real_gt; real_ge] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[real_lt]) + and pth_min = prove + (`P(min x y) <=> (y >= x /\ P x) \/ (x > y /\ P y)`, + REWRITE_TAC[real_min; real_gt; real_ge] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[real_lt]) + and abs_tm = `real_abs` + and p_tm = `P:real->bool` + and x_tm = `x:real` + and y_tm = `y:real` in + let is_max = is_binop `real_max` + and is_min = is_binop `real_min` + and is_abs t = is_comb t & rator t = abs_tm in + let eliminate_construct p c tm = + let t = find_term (fun t -> p t & free_in t tm) tm in + let v = genvar(type_of t) in + let th0 = SYM(BETA_CONV(mk_comb(mk_abs(v,subst[v,t] tm),t))) in + let p,ax = dest_comb(rand(concl th0)) in + CONV_RULE(RAND_CONV(BINOP_CONV(RAND_CONV BETA_CONV))) + (TRANS th0 (c p ax)) in + let elim_abs = + eliminate_construct is_abs + (fun p ax -> INST [p,p_tm; rand ax,x_tm] pth_abs) + and elim_max = + eliminate_construct is_max + (fun p ax -> let ax,y = dest_comb ax in + INST [p,p_tm; rand ax,x_tm; y,y_tm] pth_max) + and elim_min = + eliminate_construct is_min + (fun p ax -> let ax,y = dest_comb ax in + INST [p,p_tm; rand ax,x_tm; y,y_tm] pth_min) in + FIRST_CONV [elim_abs; elim_max; elim_min] in + fun (mkconst,EQ,GE,GT,NORM,NEG,ADD,MUL,PROVER) -> + GEN_REAL_ARITH(mkconst,EQ,GE,GT,NORM,NEG,ADD,MUL, + ABSMAXMIN_ELIM_CONV1,ABSMAXMIN_ELIM_CONV2,PROVER);; + +(* ------------------------------------------------------------------------- *) +(* Incorporate that. This gets overwritten again in "calc_rat.ml". *) +(* ------------------------------------------------------------------------- *) + +let REAL_ARITH = + let REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_SUB_CONV, + REAL_POLY_MUL_CONV,REAL_POLY_POW_CONV,REAL_POLY_CONV = + SEMIRING_NORMALIZERS_CONV REAL_POLY_CLAUSES REAL_POLY_NEG_CLAUSES + (is_realintconst, + REAL_INT_ADD_CONV,REAL_INT_MUL_CONV,REAL_INT_POW_CONV) + (<) in + GEN_REAL_ARITH + (mk_realintconst, + REAL_INT_EQ_CONV,REAL_INT_GE_CONV,REAL_INT_GT_CONV, + REAL_POLY_CONV,REAL_POLY_NEG_CONV,REAL_POLY_ADD_CONV,REAL_POLY_MUL_CONV, + REAL_LINEAR_PROVER);; diff --git a/realax.ml b/realax.ml new file mode 100644 index 0000000..9662f9b --- /dev/null +++ b/realax.ml @@ -0,0 +1,1971 @@ +(* ========================================================================= *) +(* Theory of real numbers. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "lists.ml";; + +(* ------------------------------------------------------------------------- *) +(* The main infix overloaded operations *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("++",(16,"right"));; +parse_as_infix("**",(20,"right"));; +parse_as_infix("<<=",(12,"right"));; +parse_as_infix("===",(10,"right"));; + +parse_as_infix ("treal_mul",(20,"right"));; +parse_as_infix ("treal_add",(16,"right"));; +parse_as_infix ("treal_le",(12,"right"));; +parse_as_infix ("treal_eq",(10,"right"));; + +make_overloadable "+" `:A->A->A`;; +make_overloadable "-" `:A->A->A`;; +make_overloadable "*" `:A->A->A`;; +make_overloadable "/" `:A->A->A`;; +make_overloadable "<" `:A->A->bool`;; +make_overloadable "<=" `:A->A->bool`;; +make_overloadable ">" `:A->A->bool`;; +make_overloadable ">=" `:A->A->bool`;; +make_overloadable "--" `:A->A`;; +make_overloadable "pow" `:A->num->A`;; +make_overloadable "inv" `:A->A`;; +make_overloadable "abs" `:A->A`;; +make_overloadable "max" `:A->A->A`;; +make_overloadable "min" `:A->A->A`;; +make_overloadable "&" `:num->A`;; + +do_list overload_interface + ["+",`(+):num->num->num`; "-",`(-):num->num->num`; + "*",`(*):num->num->num`; "<",`(<):num->num->bool`; + "<=",`(<=):num->num->bool`; ">",`(>):num->num->bool`; + ">=",`(>=):num->num->bool`];; + +let prioritize_num() = prioritize_overload(mk_type("num",[]));; + +(* ------------------------------------------------------------------------- *) +(* Absolute distance function on the naturals. *) +(* ------------------------------------------------------------------------- *) + +let dist = new_definition + `dist(m,n) = (m - n) + (n - m)`;; + +(* ------------------------------------------------------------------------- *) +(* Some easy theorems. *) +(* ------------------------------------------------------------------------- *) + +let DIST_REFL = prove + (`!n. dist(n,n) = 0`, + REWRITE_TAC[dist; SUB_REFL; ADD_CLAUSES]);; + +let DIST_LZERO = prove + (`!n. dist(0,n) = n`, + REWRITE_TAC[dist; SUB_0; ADD_CLAUSES]);; + +let DIST_RZERO = prove + (`!n. dist(n,0) = n`, + REWRITE_TAC[dist; SUB_0; ADD_CLAUSES]);; + +let DIST_SYM = prove + (`!m n. dist(m,n) = dist(n,m)`, + REWRITE_TAC[dist] THEN MATCH_ACCEPT_TAC ADD_SYM);; + +let DIST_LADD = prove + (`!m p n. dist(m + n,m + p) = dist(n,p)`, + REWRITE_TAC[dist; SUB_ADD_LCANCEL]);; + +let DIST_RADD = prove + (`!m p n. dist(m + p,n + p) = dist(m,n)`, + REWRITE_TAC[dist; SUB_ADD_RCANCEL]);; + +let DIST_LADD_0 = prove + (`!m n. dist(m + n,m) = n`, + REWRITE_TAC[dist; ADD_SUB2; ADD_SUBR2; ADD_CLAUSES]);; + +let DIST_RADD_0 = prove + (`!m n. dist(m,m + n) = n`, + ONCE_REWRITE_TAC[DIST_SYM] THEN MATCH_ACCEPT_TAC DIST_LADD_0);; + +let DIST_LMUL = prove + (`!m n p. m * dist(n,p) = dist(m * n,m * p)`, + REWRITE_TAC[dist; LEFT_ADD_DISTRIB; LEFT_SUB_DISTRIB]);; + +let DIST_RMUL = prove + (`!m n p. dist(m,n) * p = dist(m * p,n * p)`, + REWRITE_TAC[dist; RIGHT_ADD_DISTRIB; RIGHT_SUB_DISTRIB]);; + +let DIST_EQ_0 = prove + (`!m n. (dist(m,n) = 0) <=> (m = n)`, + REWRITE_TAC[dist; ADD_EQ_0; SUB_EQ_0; LE_ANTISYM]);; + +(* ------------------------------------------------------------------------- *) +(* Simplifying theorem about the distance operation. *) +(* ------------------------------------------------------------------------- *) + +let DIST_ELIM_THM = prove + (`P(dist(x,y)) <=> !d. ((x = y + d) ==> P(d)) /\ ((y = x + d) ==> P(d))`, + DISJ_CASES_TAC(SPECL [`x:num`; `y:num`] LE_CASES) THEN + POP_ASSUM(X_CHOOSE_THEN `e:num` SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[dist; ADD_SUB; ADD_SUB2; ADD_SUBR; ADD_SUBR2] THEN + REWRITE_TAC[ADD_CLAUSES; EQ_ADD_LCANCEL] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[GSYM ADD_ASSOC; EQ_ADD_LCANCEL_0; ADD_EQ_0] THEN + ASM_CASES_TAC `e = 0` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Now some more theorems. *) +(* ------------------------------------------------------------------------- *) + +let DIST_LE_CASES,DIST_ADDBOUND,DIST_TRIANGLE,DIST_ADD2,DIST_ADD2_REV = + let DIST_ELIM_TAC = + let conv = + HIGHER_REWRITE_CONV[SUB_ELIM_THM; COND_ELIM_THM; DIST_ELIM_THM] false in + CONV_TAC conv THEN TRY GEN_TAC THEN CONJ_TAC THEN + DISCH_THEN(fun th -> SUBST_ALL_TAC th THEN + (let l,r = dest_eq (concl th) in + if is_var l & not (vfree_in l r) then ALL_TAC + else ASSUME_TAC th)) in + let DIST_ELIM_TAC' = + REPEAT STRIP_TAC THEN REPEAT DIST_ELIM_TAC THEN + REWRITE_TAC[GSYM NOT_LT; LT_EXISTS] THEN + DISCH_THEN(CHOOSE_THEN SUBST_ALL_TAC) THEN POP_ASSUM MP_TAC THEN + CONV_TAC(LAND_CONV NUM_CANCEL_CONV) THEN + REWRITE_TAC[ADD_CLAUSES; NOT_SUC] in + let DIST_LE_CASES = prove + (`!m n p. dist(m,n) <= p <=> (m <= n + p) /\ (n <= m + p)`, + REPEAT GEN_TAC THEN REPEAT DIST_ELIM_TAC THEN + REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD; LE_ADD_LCANCEL]) + and DIST_ADDBOUND = prove + (`!m n. dist(m,n) <= m + n`, + REPEAT GEN_TAC THEN DIST_ELIM_TAC THENL + [ONCE_REWRITE_TAC[ADD_SYM]; ALL_TAC] THEN + REWRITE_TAC[ADD_ASSOC; LE_ADDR]) + and [DIST_TRIANGLE; DIST_ADD2; DIST_ADD2_REV] = (CONJUNCTS o prove) + (`(!m n p. dist(m,p) <= dist(m,n) + dist(n,p)) /\ + (!m n p q. dist(m + n,p + q) <= dist(m,p) + dist(n,q)) /\ + (!m n p q. dist(m,p) <= dist(m + n,p + q) + dist(n,q))`, + DIST_ELIM_TAC') in + DIST_LE_CASES,DIST_ADDBOUND,DIST_TRIANGLE,DIST_ADD2,DIST_ADD2_REV;; + +let DIST_TRIANGLE_LE = prove + (`!m n p q. dist(m,n) + dist(n,p) <= q ==> dist(m,p) <= q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `dist(m,n) + dist(n,p)` THEN ASM_REWRITE_TAC[DIST_TRIANGLE]);; + +let DIST_TRIANGLES_LE = prove + (`!m n p q r s. + dist(m,n) <= r /\ dist(p,q) <= s ==> dist(m,p) <= dist(n,q) + r + s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_LE THEN + EXISTS_TAC `n:num` THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN MATCH_MP_TAC LE_ADD2 THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC DIST_TRIANGLE_LE THEN + EXISTS_TAC `q:num` THEN GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN + REWRITE_TAC[LE_ADD_LCANCEL] THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Useful lemmas about bounds. *) +(* ------------------------------------------------------------------------- *) + +let BOUNDS_LINEAR = prove + (`!A B C. (!n. A * n <= B * n + C) <=> A <= B`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LE] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LT_EXISTS]) THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN + DISCH_THEN(MP_TAC o SPEC `SUC C`) THEN + REWRITE_TAC[NOT_LE; MULT_CLAUSES; ADD_CLAUSES; LT_SUC_LE] THEN + REWRITE_TAC[ADD_ASSOC; LE_ADDR]; + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o REWRITE_RULE[LE_EXISTS]) THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]);; + +let BOUNDS_LINEAR_0 = prove + (`!A B. (!n. A * n <= B) <=> (A = 0)`, + REPEAT GEN_TAC THEN MP_TAC(SPECL [`A:num`; `0`; `B:num`] BOUNDS_LINEAR) THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; LE]);; + +let BOUNDS_DIVIDED = prove + (`!P. (?B. !n. P(n) <= B) <=> + (?A B. !n. n * P(n) <= A * n + B)`, + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`B:num`; `0`] THEN + GEN_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN + GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]; + EXISTS_TAC `P(0) + A + B` THEN GEN_TAC THEN + MP_TAC(SPECL [`n:num`; `(P:num->num) n`; `P(0) + A + B`] + LE_MULT_LCANCEL) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LE_ADD] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * n + B` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + REWRITE_TAC[GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B * n` THEN + REWRITE_TAC[LE_ADD] THEN UNDISCH_TAC `~(n = 0)` THEN + SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LE_ADD]]);; + +let BOUNDS_NOTZERO = prove + (`!P A B. (P 0 0 = 0) /\ (!m n. P m n <= A * (m + n) + B) ==> + (?B. !m n. P m n <= B * (m + n))`, + REPEAT STRIP_TAC THEN EXISTS_TAC `A + B` THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `m + n = 0` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[ADD_EQ_0]) THEN ASM_REWRITE_TAC[LE_0]; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * (m + n) + B` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN + UNDISCH_TAC `~(m + n = 0)` THEN SPEC_TAC(`m + n`,`p:num`) THEN + INDUCT_TAC THEN REWRITE_TAC[MULT_CLAUSES; LE_ADD]]);; + +let BOUNDS_IGNORE = prove + (`!P Q. (?B. !i. P(i) <= Q(i) + B) <=> + (?B N. !i. N <= i ==> P(i) <= Q(i) + B)`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN SPEC_TAC(`B:num`,`B:num`) THEN + SPEC_TAC(`N:num`,`N:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[LE_0] THEN GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + EXISTS_TAC `B + P(N:num)` THEN X_GEN_TAC `i:num` THEN + DISCH_TAC THEN ASM_CASES_TAC `SUC N <= i` THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `Q(i:num) + B` THEN + REWRITE_TAC[LE_ADD; ADD_ASSOC] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + UNDISCH_TAC `~(SUC N <= i)` THEN REWRITE_TAC[NOT_LE; LT] THEN + ASM_REWRITE_TAC[GSYM NOT_LE] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[LE_ADD]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Define type of nearly additive functions. *) +(* ------------------------------------------------------------------------- *) + +let is_nadd = new_definition + `is_nadd x <=> (?B. !m n. dist(m * x(n),n * x(m)) <= B * (m + n))`;; + +let is_nadd_0 = prove + (`is_nadd (\n. 0)`, + REWRITE_TAC[is_nadd; MULT_CLAUSES; DIST_REFL; LE_0]);; + +let nadd_abs,nadd_rep = + new_basic_type_definition "nadd" ("mk_nadd","dest_nadd") is_nadd_0;; + +override_interface ("fn",`dest_nadd`);; +override_interface ("afn",`mk_nadd`);; + +(* ------------------------------------------------------------------------- *) +(* Properties of nearly-additive functions. *) +(* ------------------------------------------------------------------------- *) + +let NADD_CAUCHY = prove + (`!x. ?B. !m n. dist(m * fn x n,n * fn x m) <= B * (m + n)`, + REWRITE_TAC[GSYM is_nadd; nadd_rep; nadd_abs; ETA_AX]);; + +let NADD_BOUND = prove + (`!x. ?A B. !n. fn x n <= A * n + B`, + GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + MAP_EVERY EXISTS_TAC [`B + fn x 1`; `B:num`] THEN GEN_TAC THEN + POP_ASSUM(MP_TAC o SPECL [`n:num`; `1`]) THEN + REWRITE_TAC[DIST_LE_CASES; MULT_CLAUSES] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[ADD_AC; MULT_AC]);; + +let NADD_MULTIPLICATIVE = prove + (`!x. ?B. !m n. dist(fn x (m * n),m * fn x n) <= B * m + B`, + GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + EXISTS_TAC `B + fn x 0` THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [MATCH_MP_TAC (LE_IMP DIST_ADDBOUND) THEN + ASM_REWRITE_TAC[MULT_CLAUSES; RIGHT_ADD_DISTRIB; MULT_AC] THEN + REWRITE_TAC[LE_EXISTS] THEN CONV_TAC(ONCE_DEPTH_CONV NUM_CANCEL_CONV) THEN + REWRITE_TAC[GSYM EXISTS_REFL]; UNDISCH_TAC `~(n = 0)`] THEN + REWRITE_TAC[TAUT `(~a ==> b) <=> a \/ b`; GSYM LE_MULT_LCANCEL; + DIST_LMUL] THEN + REWRITE_TAC[MULT_ASSOC] THEN GEN_REWRITE_TAC + (LAND_CONV o RAND_CONV o RAND_CONV o LAND_CONV) [MULT_SYM] THEN + POP_ASSUM(MATCH_MP_TAC o LE_IMP) THEN + REWRITE_TAC[LE_EXISTS; RIGHT_ADD_DISTRIB; LEFT_ADD_DISTRIB; MULT_AC] THEN + CONV_TAC(ONCE_DEPTH_CONV NUM_CANCEL_CONV) THEN + REWRITE_TAC[GSYM EXISTS_REFL]);; + +let NADD_ADDITIVE = prove + (`!x. ?B. !m n. dist(fn x (m + n),fn x m + fn x n) <= B`, + GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + EXISTS_TAC `3 * B + fn x 0` THEN REPEAT GEN_TAC THEN + ASM_CASES_TAC `m + n = 0` THENL + [RULE_ASSUM_TAC(REWRITE_RULE[ADD_EQ_0]) THEN ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[ADD_CLAUSES; DIST_LADD_0; LE_ADDR]; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `3 * B` THEN + REWRITE_TAC[LE_ADD] THEN UNDISCH_TAC `~(m + n = 0)`] THEN + REWRITE_TAC[TAUT `(~a ==> b) <=> a \/ b`; GSYM LE_MULT_LCANCEL] THEN + REWRITE_TAC[DIST_LMUL; LEFT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [RIGHT_ADD_DISTRIB] THEN + MATCH_MP_TAC(LE_IMP DIST_ADD2) THEN + SUBGOAL_THEN `(m + n) * 3 * B = B * (m + m + n) + B * (n + m + n)` + SUBST1_TAC THENL + [REWRITE_TAC[SYM(REWRITE_CONV [ARITH] `1 + 1 + 1`)] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; LEFT_ADD_DISTRIB; MULT_CLAUSES] THEN + REWRITE_TAC[MULT_AC] THEN CONV_TAC NUM_CANCEL_CONV THEN REFL_TAC; + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]]);; + +let NADD_SUC = prove + (`!x. ?B. !n. dist(fn x (SUC n),fn x n) <= B`, + GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_ADDITIVE) THEN + EXISTS_TAC `B + fn x 1` THEN GEN_TAC THEN + MATCH_MP_TAC(LE_IMP DIST_TRIANGLE) THEN + EXISTS_TAC `fn x n + fn x 1` THEN + ASM_REWRITE_TAC[ADD1] THEN MATCH_MP_TAC LE_ADD2 THEN + ASM_REWRITE_TAC[DIST_LADD_0; LE_REFL]);; + +let NADD_DIST_LEMMA = prove + (`!x. ?B. !m n. dist(fn x (m + n),fn x m) <= B * n`, + GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_SUC) THEN + EXISTS_TAC `B:num` THEN GEN_TAC THEN + INDUCT_TAC THEN REWRITE_TAC[ADD_CLAUSES; DIST_REFL; LE_0] THEN + MATCH_MP_TAC(LE_IMP DIST_TRIANGLE) THEN + EXISTS_TAC `fn x (m + n)` THEN + REWRITE_TAC[ADD1; LEFT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[GSYM ADD1; MULT_CLAUSES]);; + +let NADD_DIST = prove + (`!x. ?B. !m n. dist(fn x m,fn x n) <= B * dist(m,n)`, + GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_DIST_LEMMA) THEN + EXISTS_TAC `B:num` THEN REPEAT GEN_TAC THEN + DISJ_CASES_THEN MP_TAC (SPECL [`m:num`; `n:num`] LE_CASES) THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o ONCE_REWRITE_RULE[LE_EXISTS]) THENL + [ONCE_REWRITE_TAC[DIST_SYM]; ALL_TAC] THEN + ASM_REWRITE_TAC[DIST_LADD_0]);; + +let NADD_ALTMUL = prove + (`!x y. ?A B. !n. dist(n * fn x (fn y n),fn x n * fn y n) <= A * n + B`, + REPEAT GEN_TAC THEN X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + MP_TAC(SPEC `y:nadd` NADD_BOUND) THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (X_CHOOSE_TAC `L:num`)) THEN + MAP_EVERY EXISTS_TAC [`B * (1 + M)`; `B * L`] THEN GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [MULT_SYM] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B * (n + fn y n)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_CLAUSES; GSYM ADD_ASSOC; LE_ADD_LCANCEL] THEN + ASM_REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; GSYM MULT_ASSOC; LE_MULT_LCANCEL]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of the equivalence relation and proof that it *is* one. *) +(* ------------------------------------------------------------------------- *) + +override_interface ("===",`(nadd_eq):nadd->nadd->bool`);; + +let nadd_eq = new_definition + `x === y <=> ?B. !n. dist(fn x n,fn y n) <= B`;; + +let NADD_EQ_REFL = prove + (`!x. x === x`, + GEN_TAC THEN REWRITE_TAC[nadd_eq; DIST_REFL; LE_0]);; + +let NADD_EQ_SYM = prove + (`!x y. x === y <=> y === x`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [DIST_SYM] THEN REFL_TAC);; + +let NADD_EQ_TRANS = prove + (`!x y z. x === y /\ y === z ==> x === z`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `B1:num`) (X_CHOOSE_TAC `B2:num`)) THEN + EXISTS_TAC `B1 + B2` THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN EXISTS_TAC `fn y n` THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Injection of the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +override_interface ("&",`nadd_of_num:num->nadd`);; + +let nadd_of_num = new_definition + `&k = afn(\n. k * n)`;; + +let NADD_OF_NUM = prove + (`!k. fn(&k) = \n. k * n`, + REWRITE_TAC[nadd_of_num; GSYM nadd_rep; is_nadd] THEN + REWRITE_TAC[DIST_REFL; LE_0; MULT_AC]);; + +let NADD_OF_NUM_WELLDEF = prove + (`!m n. (m = n) ==> &m === &n`, + REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + MATCH_ACCEPT_TAC NADD_EQ_REFL);; + +let NADD_OF_NUM_EQ = prove + (`!m n. (&m === &n) <=> (m = n)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[NADD_OF_NUM_WELLDEF] THEN + REWRITE_TAC[nadd_eq; NADD_OF_NUM] THEN + REWRITE_TAC[GSYM DIST_RMUL; BOUNDS_LINEAR_0; DIST_EQ_0]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of (reflexive) ordering and the only special property needed. *) +(* ------------------------------------------------------------------------- *) + +override_interface ("<<=",`nadd_le:nadd->nadd->bool`);; + +let nadd_le = new_definition + `x <<= y <=> ?B. !n. fn x n <= fn y n + B`;; + +let NADD_LE_WELLDEF_LEMMA = prove + (`!x x' y y'. x === x' /\ y === y' /\ x <<= y ==> x' <<= y'`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; nadd_le] THEN + REWRITE_TAC[DIST_LE_CASES; FORALL_AND_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B2:num`) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `B:num`) THEN + EXISTS_TAC `(B2 + B) + B1` THEN X_GEN_TAC `n:num` THEN + FIRST_ASSUM(MATCH_MP_TAC o LE_IMP o CONJUNCT2) THEN + REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL] THEN + FIRST_ASSUM(MATCH_MP_TAC o LE_IMP) THEN ASM_REWRITE_TAC[LE_ADD_RCANCEL]);; + +let NADD_LE_WELLDEF = prove + (`!x x' y y'. x === x' /\ y === y' ==> (x <<= y <=> x' <<= y')`, + REPEAT STRIP_TAC THEN EQ_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC NADD_LE_WELLDEF_LEMMA THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY EXISTS_TAC [`x:nadd`; `y:nadd`]; + MAP_EVERY EXISTS_TAC [`x':nadd`; `y':nadd`] THEN + ONCE_REWRITE_TAC[NADD_EQ_SYM]] THEN + ASM_REWRITE_TAC[]);; + +let NADD_LE_REFL = prove + (`!x. x <<= x`, + REWRITE_TAC[nadd_le; LE_ADD]);; + +let NADD_LE_TRANS = prove + (`!x y z. x <<= y /\ y <<= z ==> x <<= z`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) MP_TAC) THEN + DISCH_THEN(X_CHOOSE_TAC `B2:num`) THEN + EXISTS_TAC `B2 + B1` THEN GEN_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o LE_IMP) THEN + ASM_REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL]);; + +let NADD_LE_ANTISYM = prove + (`!x y. x <<= y /\ y <<= x <=> (x === y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; nadd_eq; DIST_LE_CASES] THEN + EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `B1:num`) + (X_CHOOSE_TAC `B2:num`)) THEN + EXISTS_TAC `B1 + B2` THEN GEN_TAC THEN CONJ_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o LE_IMP) THEN + ASM_REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL; LE_ADD; LE_ADDR]; + DISCH_THEN(X_CHOOSE_TAC `B:num`) THEN + CONJ_TAC THEN EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]]);; + +let NADD_LE_TOTAL_LEMMA = prove + (`!x y. ~(x <<= y) ==> !B. ?n. ~(n = 0) /\ fn y n + B < fn x n`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NOT_FORALL_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN GEN_TAC THEN + POP_ASSUM(X_CHOOSE_TAC `n:num` o SPEC `B + fn x 0`) THEN + EXISTS_TAC `n:num` THEN POP_ASSUM MP_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NOT_LT; ADD_ASSOC; LE_ADDR] THEN + CONV_TAC CONTRAPOS_CONV THEN REWRITE_TAC[NOT_LT] THEN + DISCH_THEN(MATCH_MP_TAC o LE_IMP) THEN REWRITE_TAC[ADD_ASSOC; LE_ADD]);; + +let NADD_LE_TOTAL = prove + (`!x y. x <<= y \/ y <<= x`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [TAUT `a <=> ~ ~ a`] THEN + X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + X_CHOOSE_TAC `B2:num` (SPEC `y:nadd` NADD_CAUCHY) THEN + PURE_ONCE_REWRITE_TAC[DE_MORGAN_THM] THEN + DISCH_THEN(MP_TAC o end_itlist CONJ o + map (MATCH_MP NADD_LE_TOTAL_LEMMA) o CONJUNCTS) THEN + REWRITE_TAC[AND_FORALL_THM] THEN DISCH_THEN(MP_TAC o SPEC `B1 + B2`) THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (X_CHOOSE_THEN `n:num` MP_TAC)) THEN + DISCH_THEN(MP_TAC o MATCH_MP + (ITAUT `(~a /\ b) /\ (~c /\ d) ==> ~(c \/ ~b) /\ ~(a \/ ~d)`)) THEN + REWRITE_TAC[NOT_LT; GSYM LE_MULT_LCANCEL] THEN REWRITE_TAC[NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP LT_ADD2) THEN REWRITE_TAC[NOT_LT] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB] THEN + ONCE_REWRITE_TAC[AC ADD_AC + `(a + b + c) + (d + e + f) = (d + b + e) + (a + c + f)`] THEN + MATCH_MP_TAC LE_ADD2 THEN REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN + CONJ_TAC THEN GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [MULT_SYM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_LE_CASES]) THEN ASM_REWRITE_TAC[]);; + +let NADD_ARCH = prove + (`!x. ?n. x <<= &n`, + REWRITE_TAC[nadd_le; NADD_OF_NUM; NADD_BOUND]);; + +let NADD_OF_NUM_LE = prove + (`!m n. (&m <<= &n) <=> m <= n`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_OF_NUM] THEN + REWRITE_TAC[BOUNDS_LINEAR]);; + +(* ------------------------------------------------------------------------- *) +(* Addition. *) +(* ------------------------------------------------------------------------- *) + +override_interface ("++",`nadd_add:nadd->nadd->nadd`);; + +let nadd_add = new_definition + `x ++ y = afn(\n. fn x n + fn y n)`;; + +let NADD_ADD = prove + (`!x y. fn(x ++ y) = \n. fn x n + fn y n`, + REPEAT GEN_TAC THEN + REWRITE_TAC[nadd_add; GSYM nadd_rep; is_nadd] THEN + X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + X_CHOOSE_TAC `B2:num` (SPEC `y:nadd` NADD_CAUCHY) THEN + EXISTS_TAC `B1 + B2` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LEFT_ADD_DISTRIB] THEN + MATCH_MP_TAC (LE_IMP DIST_ADD2) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]);; + +let NADD_ADD_WELLDEF = prove + (`!x x' y y'. x === x' /\ y === y' ==> (x ++ y === x' ++ y')`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_ADD] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `B1:num`) (X_CHOOSE_TAC `B2:num`)) THEN + EXISTS_TAC `B1 + B2` THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC (LE_IMP DIST_ADD2) THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of addition. *) +(* ------------------------------------------------------------------------- *) + +let NADD_ADD_SYM = prove + (`!x y. (x ++ y) === (y ++ x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_add] THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [ADD_SYM] THEN + REWRITE_TAC[NADD_EQ_REFL]);; + +let NADD_ADD_ASSOC = prove + (`!x y z. (x ++ (y ++ z)) === ((x ++ y) ++ z)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[nadd_add] THEN + REWRITE_TAC[NADD_ADD; ADD_ASSOC; NADD_EQ_REFL]);; + +let NADD_ADD_LID = prove + (`!x. (&0 ++ x) === x`, + GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_ADD; NADD_OF_NUM] THEN + REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; DIST_REFL; LE_0]);; + +let NADD_ADD_LCANCEL = prove + (`!x y z. (x ++ y) === (x ++ z) ==> y === z`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_ADD; DIST_LADD]);; + +let NADD_LE_ADD = prove + (`!x y. x <<= (x ++ y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_ADD] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; LE_ADD]);; + +let NADD_LE_EXISTS = prove + (`!x y. x <<= y ==> ?d. y === x ++ d`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le] THEN + DISCH_THEN(X_CHOOSE_THEN `B:num` MP_TAC) THEN + REWRITE_TAC[LE_EXISTS; SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->num` (ASSUME_TAC o GSYM)) THEN + EXISTS_TAC `afn d` THEN REWRITE_TAC[nadd_eq; NADD_ADD] THEN + EXISTS_TAC `B:num` THEN X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `fn(afn d) = d` SUBST1_TAC THENL + [REWRITE_TAC[GSYM nadd_rep; is_nadd] THEN + X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + X_CHOOSE_TAC `B2:num` (SPEC `y:nadd` NADD_CAUCHY) THEN + EXISTS_TAC `B1 + (B2 + B)` THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC(LE_IMP DIST_ADD2_REV) THEN + MAP_EVERY EXISTS_TAC [`m * fn x n`; `n * fn x m`] THEN + ONCE_REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + ASM_REWRITE_TAC[GSYM LEFT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [LEFT_ADD_DISTRIB] THEN + MATCH_MP_TAC(LE_IMP DIST_ADD2) THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [ADD_SYM] THEN MATCH_MP_TAC LE_ADD2 THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [MULT_SYM] THEN + REWRITE_TAC[GSYM DIST_LMUL; DIST_ADDBOUND; LE_MULT_LCANCEL]; + ASM_REWRITE_TAC[DIST_RADD_0; LE_REFL]]);; + +let NADD_OF_NUM_ADD = prove + (`!m n. &m ++ &n === &(m + n)`, + REWRITE_TAC[nadd_eq; NADD_OF_NUM; NADD_ADD] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; DIST_REFL; LE_0]);; + +(* ------------------------------------------------------------------------- *) +(* Multiplication. *) +(* ------------------------------------------------------------------------- *) + +override_interface ("**",`nadd_mul:nadd->nadd->nadd`);; + +let nadd_mul = new_definition + `x ** y = afn(\n. fn x (fn y n))`;; + +let NADD_MUL = prove + (`!x y. fn(x ** y) = \n. fn x (fn y n)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[nadd_mul; GSYM nadd_rep; is_nadd] THEN + X_CHOOSE_TAC `B:num` (SPEC `y:nadd` NADD_CAUCHY) THEN + X_CHOOSE_TAC `C:num` (SPEC `x:nadd` NADD_DIST) THEN + X_CHOOSE_TAC `D:num` (SPEC `x:nadd` NADD_MULTIPLICATIVE) THEN + MATCH_MP_TAC BOUNDS_NOTZERO THEN + REWRITE_TAC[MULT_CLAUSES; DIST_REFL] THEN + MAP_EVERY EXISTS_TAC [`D + C * B`; `D + D`] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(D * m + D) + (D * n + D) + C * B * (m + n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN + EXISTS_TAC `fn x (m * fn y n)` THEN + MATCH_MP_TAC LE_ADD2 THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN + EXISTS_TAC `fn x (n * fn y m)` THEN + MATCH_MP_TAC LE_ADD2 THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `C * dist(m * fn y n,n * fn y m)` THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]; + MATCH_MP_TAC EQ_IMP_LE THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; MULT_ASSOC; ADD_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Properties of multiplication. *) +(* ------------------------------------------------------------------------- *) + +let NADD_MUL_SYM = prove + (`!x y. (x ** y) === (y ** x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_MUL] THEN + X_CHOOSE_THEN `A1:num` MP_TAC (SPECL [`x:nadd`; `y:nadd`] NADD_ALTMUL) THEN + DISCH_THEN(X_CHOOSE_TAC `B1:num`) THEN + X_CHOOSE_THEN `A2:num` MP_TAC (SPECL [`y:nadd`; `x:nadd`] NADD_ALTMUL) THEN + DISCH_THEN(X_CHOOSE_TAC `B2:num`) THEN REWRITE_TAC[BOUNDS_DIVIDED] THEN + REWRITE_TAC[DIST_LMUL] THEN MAP_EVERY EXISTS_TAC [`A1 + A2`; `B1 + B2`] THEN + GEN_TAC THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + (c + d) = (a + c) + (b + d)`] THEN + MATCH_MP_TAC (LE_IMP DIST_TRIANGLE) THEN + EXISTS_TAC `fn x n * fn y n` THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC [DIST_SYM] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 RAND_CONV) [MULT_SYM] THEN + ASM_REWRITE_TAC[]);; + +let NADD_MUL_ASSOC = prove + (`!x y z. (x ** (y ** z)) === ((x ** y) ** z)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[nadd_mul] THEN + REWRITE_TAC[NADD_MUL; NADD_EQ_REFL]);; + +let NADD_MUL_LID = prove + (`!x. (&1 ** x) === x`, + REWRITE_TAC[NADD_OF_NUM; nadd_mul; MULT_CLAUSES] THEN + REWRITE_TAC[nadd_abs; NADD_EQ_REFL; ETA_AX]);; + +let NADD_LDISTRIB = prove + (`!x y z. x ** (y ++ z) === (x ** y) ++ (x ** z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq] THEN + REWRITE_TAC[NADD_ADD; NADD_MUL] THEN + X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_ADDITIVE) THEN + EXISTS_TAC `B:num` THEN ASM_REWRITE_TAC[]);; + +let NADD_MUL_WELLDEF_LEMMA = prove + (`!x y y'. y === y' ==> (x ** y) === (x ** y')`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; NADD_MUL] THEN + DISCH_THEN(X_CHOOSE_TAC `B1:num`) THEN + X_CHOOSE_TAC `B2:num` (SPEC `x:nadd` NADD_DIST) THEN + EXISTS_TAC `B2 * B1` THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `B2 * dist(fn y n,fn y' n)` THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]);; + +let NADD_MUL_WELLDEF = prove + (`!x x' y y'. x === x' /\ y === y' + ==> (x ** y) === (x' ** y')`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `x' ** y` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ** x'` THEN + REWRITE_TAC[NADD_MUL_SYM] THEN MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `y ** x` THEN REWRITE_TAC[NADD_MUL_SYM]; ALL_TAC] THEN + MATCH_MP_TAC NADD_MUL_WELLDEF_LEMMA THEN ASM_REWRITE_TAC[]);; + +let NADD_OF_NUM_MUL = prove + (`!m n. &m ** &n === &(m * n)`, + REWRITE_TAC[nadd_eq; NADD_OF_NUM; NADD_MUL] THEN + REWRITE_TAC[MULT_ASSOC; DIST_REFL; LE_0]);; + +(* ------------------------------------------------------------------------- *) +(* A few handy lemmas. *) +(* ------------------------------------------------------------------------- *) + +let NADD_LE_0 = prove + (`!x. &0 <<= x`, + GEN_TAC THEN + REWRITE_TAC[nadd_le; NADD_OF_NUM; MULT_CLAUSES; LE_0]);; + +let NADD_EQ_IMP_LE = prove + (`!x y. x === y ==> x <<= y`, + REPEAT GEN_TAC THEN + REWRITE_TAC[nadd_eq; nadd_le; DIST_LE_CASES] THEN + DISCH_THEN(X_CHOOSE_TAC `B:num`) THEN EXISTS_TAC `B:num` THEN + ASM_REWRITE_TAC[]);; + +let NADD_LE_LMUL = prove + (`!x y z. y <<= z ==> (x ** y) <<= (x ** z)`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `d:nadd` o MATCH_MP NADD_LE_EXISTS) THEN + MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `x ** y ++ x ** d` THEN REWRITE_TAC[NADD_LE_ADD] THEN + MATCH_MP_TAC NADD_EQ_IMP_LE THEN + MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `x ** (y ++ d)` THEN + ONCE_REWRITE_TAC[NADD_EQ_SYM] THEN + REWRITE_TAC[NADD_LDISTRIB] THEN + MATCH_MP_TAC NADD_MUL_WELLDEF THEN + ASM_REWRITE_TAC[NADD_EQ_REFL]);; + +let NADD_LE_RMUL = prove + (`!x y z. x <<= y ==> (x ** z) <<= (y ** z)`, + MESON_TAC[NADD_LE_LMUL; NADD_LE_WELLDEF; NADD_MUL_SYM]);; + +let NADD_LE_RADD = prove + (`!x y z. x ++ z <<= y ++ z <=> x <<= y`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_le; NADD_ADD] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o RAND_CONV) + [ADD_SYM] THEN + REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o RAND_CONV) + [ADD_SYM] THEN REFL_TAC);; + +let NADD_LE_LADD = prove + (`!x y z. x ++ y <<= x ++ z <=> y <<= z`, + MESON_TAC[NADD_LE_RADD; NADD_ADD_SYM; NADD_LE_WELLDEF]);; + +let NADD_RDISTRIB = prove + (`!x y z. (x ++ y) ** z === x ** z ++ y ** z`, + MESON_TAC[NADD_LDISTRIB; NADD_MUL_SYM; NADD_ADD_WELLDEF; + NADD_EQ_TRANS; NADD_EQ_REFL; NADD_EQ_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* The Archimedean property in a more useful form. *) +(* ------------------------------------------------------------------------- *) + +let NADD_ARCH_MULT = prove + (`!x k. ~(x === &0) ==> ?N. &k <<= &N ** x`, + REPEAT GEN_TAC THEN REWRITE_TAC[nadd_eq; nadd_le; NOT_EXISTS_THM] THEN + X_CHOOSE_TAC `B:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + DISCH_THEN(MP_TAC o SPEC `B + k`) THEN + REWRITE_TAC[NOT_FORALL_THM; NADD_OF_NUM] THEN + REWRITE_TAC[MULT_CLAUSES; DIST_RZERO; NOT_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MAP_EVERY EXISTS_TAC [`N:num`; `B * N`] THEN X_GEN_TAC `i:num` THEN + REWRITE_TAC[NADD_MUL; NADD_OF_NUM] THEN + MATCH_MP_TAC(GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL LE_ADD_RCANCEL)))) THEN + EXISTS_TAC `B * i` THEN + REWRITE_TAC[GSYM ADD_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `i * fn x N` THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIST_LE_CASES]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM RIGHT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + MATCH_MP_TAC LT_IMP_LE THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + FIRST_ASSUM ACCEPT_TAC);; + +let NADD_ARCH_ZERO = prove + (`!x k. (!n. &n ** x <<= k) ==> (x === &0)`, + REPEAT GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN DISCH_TAC THEN + REWRITE_TAC[NOT_FORALL_THM] THEN + X_CHOOSE_TAC `p:num` (SPEC `k:nadd` NADD_ARCH) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NADD_ARCH_MULT) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num` o SPEC `p:num`) THEN + EXISTS_TAC `N + 1` THEN DISCH_TAC THEN UNDISCH_TAC `~(x === &0)` THEN + REWRITE_TAC[GSYM NADD_LE_ANTISYM; NADD_LE_0] THEN + MATCH_MP_TAC(GEN_ALL(fst(EQ_IMP_RULE(SPEC_ALL NADD_LE_RADD)))) THEN + EXISTS_TAC `&N ** x` THEN MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `k:nadd` THEN CONJ_TAC THENL + [SUBGOAL_THEN `&(N + 1) ** x === x ++ &N ** x` MP_TAC THENL + [ONCE_REWRITE_TAC[ADD_SYM] THEN + MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `&1 ** x ++ &N ** x` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `(&1 ++ &N) ** x` THEN CONJ_TAC THENL + [MESON_TAC[NADD_OF_NUM_ADD; NADD_MUL_WELLDEF; NADD_EQ_REFL; + NADD_EQ_SYM]; + MESON_TAC[NADD_RDISTRIB; NADD_MUL_SYM; NADD_EQ_SYM; NADD_EQ_TRANS]]; + MESON_TAC[NADD_ADD_WELLDEF; NADD_EQ_REFL; NADD_MUL_LID]]; + ASM_MESON_TAC[NADD_LE_WELLDEF; NADD_EQ_REFL]]; + ASM_MESON_TAC[NADD_LE_TRANS; NADD_LE_WELLDEF; NADD_EQ_REFL; + NADD_ADD_LID]]);; + +let NADD_ARCH_LEMMA = prove + (`!x y z. (!n. &n ** x <<= &n ** y ++ z) ==> x <<= y`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(SPECL [`x:nadd`; `y:nadd`] NADD_LE_TOTAL) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(X_CHOOSE_TAC `d:nadd` o MATCH_MP NADD_LE_EXISTS) THEN + MATCH_MP_TAC NADD_EQ_IMP_LE THEN + MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ++ d` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC `y ++ &0` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_ADD_WELLDEF THEN REWRITE_TAC[NADD_EQ_REFL] THEN + MATCH_MP_TAC NADD_ARCH_ZERO THEN EXISTS_TAC `z:nadd` THEN + ASM_MESON_TAC[NADD_MUL_WELLDEF; NADD_LE_WELLDEF; NADD_LDISTRIB; + NADD_LE_LADD; NADD_EQ_REFL]; + ASM_MESON_TAC[NADD_ADD_LID; NADD_ADD_WELLDEF; NADD_EQ_TRANS; + NADD_ADD_SYM]]);; + +(* ------------------------------------------------------------------------- *) +(* Completeness. *) +(* ------------------------------------------------------------------------- *) + +let NADD_COMPLETE = prove + (`!P. (?x. P x) /\ (?M. !x. P x ==> x <<= M) ==> + ?M. (!x. P x ==> x <<= M) /\ + !M'. (!x. P x ==> x <<= M') ==> M <<= M'`, + GEN_TAC THEN DISCH_THEN + (CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:nadd`) (X_CHOOSE_TAC `m:nadd`)) THEN + SUBGOAL_THEN + `!n. ?r. (?x. P x /\ &r <<= &n ** x) /\ + !r'. (?x. P x /\ &r' <<= &n ** x) ==> r' <= r` MP_TAC THENL + [GEN_TAC THEN REWRITE_TAC[GSYM num_MAX] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`0`; `a:nadd`] THEN ASM_REWRITE_TAC[NADD_LE_0]; + X_CHOOSE_TAC `N:num` (SPEC `m:nadd` NADD_ARCH) THEN + EXISTS_TAC `n * N` THEN X_GEN_TAC `p:num` THEN + DISCH_THEN(X_CHOOSE_THEN `w:nadd` STRIP_ASSUME_TAC) THEN + ONCE_REWRITE_TAC[GSYM NADD_OF_NUM_LE] THEN + MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** w` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `&n ** &N` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_LE_LMUL THEN MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `m:nadd` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC NADD_EQ_IMP_LE THEN + MATCH_ACCEPT_TAC NADD_OF_NUM_MUL]]; + ONCE_REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` + (fun th -> let th1,th2 = CONJ_PAIR(SPEC `n:num` th) in + MAP_EVERY (MP_TAC o GEN `n:num`) [th1; th2])) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPECL [`n:num`; `SUC(r(n:num))`]) THEN + REWRITE_TAC[LE_SUC_LT; LT_REFL; NOT_EXISTS_THM] THEN + DISCH_THEN(ASSUME_TAC o GENL [`n:num`; `x:nadd`] o MATCH_MP + (ITAUT `(a \/ b) /\ ~(c /\ b) ==> c ==> a`) o CONJ + (SPECL [`&n ** x`; `&(SUC(r(n:num)))`] NADD_LE_TOTAL) o SPEC_ALL) THEN + DISCH_TAC] THEN + SUBGOAL_THEN `!n i. i * r(n) <= n * r(i) + n` ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `x:nadd` STRIP_ASSUME_TAC o SPEC `n:num`) THEN + ONCE_REWRITE_TAC[GSYM NADD_OF_NUM_LE] THEN + MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `&i ** &n ** x` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `&i ** &(r(n:num))` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[NADD_EQ_SYM] THEN MATCH_ACCEPT_TAC NADD_OF_NUM_MUL; + MATCH_MP_TAC NADD_LE_LMUL THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `&n ** &(SUC(r(i:num)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** &i ** x` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NADD_EQ_IMP_LE THEN + MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `(&i ** &n) ** x` THEN + REWRITE_TAC[NADD_MUL_ASSOC] THEN + MATCH_MP_TAC NADD_EQ_TRANS THEN + EXISTS_TAC `(&n ** &i) ** x` THEN + REWRITE_TAC[ONCE_REWRITE_RULE[NADD_EQ_SYM] NADD_MUL_ASSOC] THEN + MATCH_MP_TAC NADD_MUL_WELLDEF THEN + REWRITE_TAC[NADD_MUL_SYM; NADD_EQ_REFL]; + MATCH_MP_TAC NADD_LE_LMUL THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + ONCE_REWRITE_TAC[ADD_SYM] THEN REWRITE_TAC[GSYM MULT_SUC] THEN + MATCH_MP_TAC NADD_EQ_IMP_LE THEN + REWRITE_TAC[NADD_OF_NUM_MUL]]]; ALL_TAC] THEN + EXISTS_TAC `afn r` THEN SUBGOAL_THEN `fn(afn r) = r` ASSUME_TAC THENL + [REWRITE_TAC[GSYM nadd_rep] THEN REWRITE_TAC[is_nadd; DIST_LE_CASES] THEN + EXISTS_TAC `1` THEN REWRITE_TAC[MULT_CLAUSES] THEN + REWRITE_TAC[FORALL_AND_THM] THEN + GEN_REWRITE_TAC RAND_CONV [SWAP_FORALL_THM] THEN + GEN_REWRITE_TAC (LAND_CONV o funpow 2 BINDER_CONV o + funpow 2 RAND_CONV) [ADD_SYM] THEN + REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`i:num`; `n:num`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n * r(i:num) + n` THEN + ASM_REWRITE_TAC[ADD_ASSOC; LE_ADD]; ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:nadd` THEN DISCH_TAC THEN + MATCH_MP_TAC NADD_ARCH_LEMMA THEN + EXISTS_TAC `&2` THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `&(SUC(r(n:num)))` THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[nadd_le; NADD_ADD; NADD_MUL; NADD_OF_NUM] THEN + ONCE_REWRITE_TAC[ADD_SYM] THEN + REWRITE_TAC[ADD1; RIGHT_ADD_DISTRIB] THEN + REWRITE_TAC[MULT_2; MULT_CLAUSES; ADD_ASSOC; LE_ADD_RCANCEL] THEN + REWRITE_TAC[GSYM ADD_ASSOC] THEN ONCE_REWRITE_TAC[ADD_SYM] THEN + ONCE_REWRITE_TAC[BOUNDS_IGNORE] THEN + MAP_EVERY EXISTS_TAC [`0`; `n:num`] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n * r(i:num) + n` THEN + ASM_REWRITE_TAC[LE_ADD_LCANCEL; ADD_CLAUSES]]; + X_GEN_TAC `z:nadd` THEN DISCH_TAC THEN + MATCH_MP_TAC NADD_ARCH_LEMMA THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC NADD_LE_TRANS THEN + EXISTS_TAC `&(r(n:num)) ++ &1` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[nadd_le; NADD_ADD; NADD_MUL; NADD_OF_NUM] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[ADD_CLAUSES; MULT_CLAUSES] THEN + GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [MULT_SYM] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[NADD_LE_RADD] THEN + FIRST_ASSUM(X_CHOOSE_THEN `x:nadd` MP_TAC o SPEC `n:num`) THEN + DISCH_THEN STRIP_ASSUME_TAC THEN + MATCH_MP_TAC NADD_LE_TRANS THEN EXISTS_TAC `&n ** x` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC NADD_LE_LMUL THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* A bit more on nearly-multiplicative functions. *) +(* ------------------------------------------------------------------------- *) + +let NADD_UBOUND = prove + (`!x. ?B N. !n. N <= n ==> fn x n <= B * n`, + GEN_TAC THEN X_CHOOSE_THEN `A1:num` + (X_CHOOSE_TAC `A2:num`) (SPEC `x:nadd` NADD_BOUND) THEN + EXISTS_TAC `A1 + A2` THEN EXISTS_TAC `1` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `A1 * n + A2` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(el 3 (CONJUNCTS MULT_CLAUSES))] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]);; + +let NADD_NONZERO = prove + (`!x. ~(x === &0) ==> ?N. !n. N <= n ==> ~(fn x n = 0)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_ARCH_MULT) THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[nadd_le; NADD_MUL; NADD_OF_NUM; MULT_CLAUSES] THEN + DISCH_THEN(X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `A2:num`)) THEN + EXISTS_TAC `A2 + 1` THEN X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_forall o concl) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_LE; GSYM LE_SUC_LT; ADD1] THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES]);; + +let NADD_LBOUND = prove + (`!x. ~(x === &0) ==> ?A N. !n. N <= n ==> n <= A * fn x n`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `N:num` o MATCH_MP NADD_NONZERO) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NADD_ARCH_MULT) THEN + DISCH_THEN(MP_TAC o SPEC `1`) THEN + REWRITE_TAC[nadd_le; NADD_MUL; NADD_OF_NUM; MULT_CLAUSES] THEN + DISCH_THEN(X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `A2:num`)) THEN + EXISTS_TAC `A1 + A2` THEN EXISTS_TAC `N:num` THEN GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A1 * fn x n + A2` THEN + ASM_REWRITE_TAC[RIGHT_ADD_DISTRIB; LE_ADD_LCANCEL] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(el 3 (CONJUNCTS MULT_CLAUSES))] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + REWRITE_TAC[GSYM(REWRITE_CONV[ARITH_SUC] `SUC 0`)] THEN + ASM_REWRITE_TAC[GSYM NOT_LT; LT]);; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary function for the multiplicative inverse. *) +(* ------------------------------------------------------------------------- *) + +let nadd_rinv = new_definition + `nadd_rinv(x) = \n. (n * n) DIV (fn x n)`;; + +let NADD_MUL_LINV_LEMMA0 = prove + (`!x. ~(x === &0) ==> ?A B. !n. nadd_rinv x n <= A * n + B`, + GEN_TAC THEN DISCH_TAC THEN ONCE_REWRITE_TAC[BOUNDS_IGNORE] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NADD_LBOUND) THEN + DISCH_THEN(X_CHOOSE_THEN `A:num` (X_CHOOSE_TAC `N:num`)) THEN + MAP_EVERY EXISTS_TAC [`A:num`; `0`; `SUC N`] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN + MP_TAC(SPECL [`nadd_rinv x n`; `A * n`; `n:num`] LE_MULT_RCANCEL) THEN + UNDISCH_TAC `SUC N <= n` THEN ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[LE; NOT_SUC] THEN DISCH_TAC THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `nadd_rinv x n * A * fn x n` THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN CONJ_TAC THENL + [DISJ2_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `SUC N` THEN ASM_REWRITE_TAC[LE; LE_REFL]; + GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN + REWRITE_TAC[GSYM MULT_ASSOC; LE_MULT_LCANCEL] THEN + DISJ2_TAC THEN ASM_CASES_TAC `fn x n = 0` THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LE_0; nadd_rinv] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVISION) THEN + DISCH_THEN(fun t -> GEN_REWRITE_TAC RAND_CONV [CONJUNCT1(SPEC_ALL t)]) THEN + GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN REWRITE_TAC[LE_ADD]]);; + +let NADD_MUL_LINV_LEMMA1 = prove + (`!x n. ~(fn x n = 0) ==> dist(fn x n * nadd_rinv(x) n, n * n) <= fn x n`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DIVISION) THEN + DISCH_THEN(CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC o SPEC `n * n`) THEN + REWRITE_TAC[nadd_rinv] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [MULT_SYM] THEN + REWRITE_TAC[DIST_RADD_0] THEN MATCH_MP_TAC LT_IMP_LE THEN + FIRST_ASSUM MATCH_ACCEPT_TAC);; + +let NADD_MUL_LINV_LEMMA2 = prove + (`!x. ~(x === &0) ==> ?N. !n. N <= n ==> + dist(fn x n * nadd_rinv(x) n, n * n) <= fn x n`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_NONZERO) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC NADD_MUL_LINV_LEMMA1 THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let NADD_MUL_LINV_LEMMA3 = prove + (`!x. ~(x === &0) ==> ?N. !m n. N <= n ==> + dist(m * fn x m * fn x n * nadd_rinv(x) n, + m * fn x m * n * n) <= m * fn x m * fn x n`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA2) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIST_LMUL; MULT_ASSOC] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +let NADD_MUL_LINV_LEMMA4 = prove + (`!x. ~(x === &0) ==> ?N. !m n. N <= m /\ N <= n ==> + (fn x m * fn x n) * dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= + (m * n) * dist(m * fn x n,n * fn x m) + (fn x m * fn x n) * (m + n)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA3) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[DIST_LMUL; LEFT_ADD_DISTRIB] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [DIST_SYM] THEN + MATCH_MP_TAC DIST_TRIANGLES_LE THEN CONJ_TAC THENL + [ANTE_RES_THEN(MP_TAC o SPEC `m:num`) (ASSUME `N <= n`); + ANTE_RES_THEN(MP_TAC o SPEC `n:num`) (ASSUME `N <= m`)] THEN + MATCH_MP_TAC EQ_IMP THEN REWRITE_TAC[MULT_AC]);; + +let NADD_MUL_LINV_LEMMA5 = prove + (`!x. ~(x === &0) ==> ?B N. !m n. N <= m /\ N <= n ==> + (fn x m * fn x n) * dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= + B * (m * n) * (m + n)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA4) THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + X_CHOOSE_TAC `B1:num` (SPEC `x:nadd` NADD_CAUCHY) THEN + X_CHOOSE_THEN `B2:num` (X_CHOOSE_TAC `N2:num`) + (SPEC `x:nadd` NADD_UBOUND) THEN + EXISTS_TAC `B1 + B2 * B2` THEN EXISTS_TAC `N1 + N2` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(m * n) * dist(m * fn x n,n * fn x m) + + (fn x m * fn x n) * (m + n)` THEN + CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2` THEN + ASM_REWRITE_TAC[LE_ADD; LE_ADDR]; + REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN MATCH_MP_TAC LE_ADD2] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM MULT_ASSOC] THEN + GEN_REWRITE_TAC (funpow 2 RAND_CONV) [MULT_SYM] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]; + ONCE_REWRITE_TAC[AC MULT_AC + `(a * b) * (c * d) * e = ((a * c) * (b * d)) * e`] THEN + REWRITE_TAC[LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + MATCH_MP_TAC LE_MULT2 THEN CONJ_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2` THEN + ASM_REWRITE_TAC[LE_ADD; LE_ADDR]]);; + +let NADD_MUL_LINV_LEMMA6 = prove + (`!x. ~(x === &0) ==> ?B N. !m n. N <= m /\ N <= n ==> + (m * n) * dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= + B * (m * n) * (m + n)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA5) THEN + DISCH_THEN(X_CHOOSE_THEN `B1:num` (X_CHOOSE_TAC `N1:num`)) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NADD_LBOUND) THEN + DISCH_THEN(X_CHOOSE_THEN `B2:num` (X_CHOOSE_TAC `N2:num`)) THEN + EXISTS_TAC `B1 * B2 * B2` THEN EXISTS_TAC `N1 + N2` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `(B2 * B2) * (fn x m * fn x n) * + dist (m * nadd_rinv x n,n * nadd_rinv x m)` THEN + CONJ_TAC THENL + [REWRITE_TAC[MULT_ASSOC; LE_MULT_RCANCEL] THEN DISJ1_TAC THEN + ONCE_REWRITE_TAC[AC MULT_AC `((a * b) * c) * d = (a * c) * (b * d)`] THEN + MATCH_MP_TAC LE_MULT2 THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC; + ONCE_REWRITE_TAC[AC MULT_AC + `(a * b * c) * (d * e) * f = (b * c) * (a * (d * e) * f)`] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + FIRST_ASSUM MATCH_MP_TAC THEN CONJ_TAC] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N1 + N2` THEN + ASM_REWRITE_TAC[LE_ADD; LE_ADDR]);; + +let NADD_MUL_LINV_LEMMA7 = prove + (`!x. ~(x === &0) ==> ?B N. !m n. N <= m /\ N <= n ==> + dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= B * (m + n)`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA6) THEN + DISCH_THEN(X_CHOOSE_THEN `B:num` (X_CHOOSE_TAC `N:num`)) THEN + MAP_EVERY EXISTS_TAC [`B:num`; `N + 1`] THEN + MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `N <= m /\ N <= n` MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N + 1` THEN + ASM_REWRITE_TAC[LE_ADD]; + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + ONCE_REWRITE_TAC[AC MULT_AC `a * b * c = b * a * c`] THEN + REWRITE_TAC[LE_MULT_LCANCEL] THEN + DISCH_THEN(DISJ_CASES_THEN2 MP_TAC ACCEPT_TAC) THEN + CONV_TAC CONTRAPOS_CONV THEN DISCH_THEN(K ALL_TAC) THEN + ONCE_REWRITE_TAC[GSYM(CONJUNCT1 LE)] THEN + REWRITE_TAC[NOT_LE; GSYM LE_SUC_LT] THEN + REWRITE_TAC[EQT_ELIM(REWRITE_CONV[ARITH] `SUC 0 = 1 * 1`)] THEN + MATCH_MP_TAC LE_MULT2 THEN CONJ_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `N + 1` THEN + ASM_REWRITE_TAC[LE_ADDR]]);; + +let NADD_MUL_LINV_LEMMA7a = prove + (`!x. ~(x === &0) ==> !N. ?A B. !m n. m <= N ==> + dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= A * n + B`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA0) THEN + DISCH_THEN(X_CHOOSE_THEN `A0:num` (X_CHOOSE_TAC `B0:num`)) THEN + INDUCT_TAC THENL + [MAP_EVERY EXISTS_TAC [`nadd_rinv x 0`; `0`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[LE] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[MULT_CLAUSES; DIST_LZERO; ADD_CLAUSES] THEN + GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN MATCH_ACCEPT_TAC LE_REFL; + FIRST_ASSUM(X_CHOOSE_THEN `A:num` (X_CHOOSE_TAC `B:num`)) THEN + EXISTS_TAC `A + (nadd_rinv(x)(SUC N) + SUC N * A0)` THEN + EXISTS_TAC `SUC N * B0 + B` THEN + REPEAT GEN_TAC THEN REWRITE_TAC[LE] THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST1_TAC ASSUME_TAC) THENL + [MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `SUC N * nadd_rinv x n + n * nadd_rinv x (SUC N)` THEN + REWRITE_TAC[DIST_ADDBOUND] THEN REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + ONCE_REWRITE_TAC[AC ADD_AC + `(a + b + c) + d + e = (c + d) + (b + a + e)`] THEN + MATCH_MP_TAC LE_ADD2 THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MULT_ASSOC; GSYM LEFT_ADD_DISTRIB] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL]; + GEN_REWRITE_TAC LAND_CONV [MULT_SYM] THEN + MATCH_ACCEPT_TAC LE_ADD]; + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * n + B` THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ADD_ASSOC; LE_ADD_RCANCEL] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]]]);; + +let NADD_MUL_LINV_LEMMA8 = prove + (`!x. ~(x === &0) ==> + ?B. !m n. dist(m * nadd_rinv(x) n,n * nadd_rinv(x) m) <= B * (m + n)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP NADD_MUL_LINV_LEMMA7) THEN + DISCH_THEN(X_CHOOSE_THEN `B0:num` (X_CHOOSE_TAC `N:num`)) THEN + FIRST_ASSUM(MP_TAC o SPEC `N:num` o MATCH_MP NADD_MUL_LINV_LEMMA7a) THEN + DISCH_THEN(X_CHOOSE_THEN `A:num` (X_CHOOSE_TAC `B:num`)) THEN + MATCH_MP_TAC BOUNDS_NOTZERO THEN REWRITE_TAC[DIST_REFL] THEN + EXISTS_TAC `A + B0` THEN EXISTS_TAC `B:num` THEN REPEAT GEN_TAC THEN + DISJ_CASES_THEN2 ASSUME_TAC MP_TAC (SPECL [`N:num`; `m:num`] LE_CASES) THENL + [DISJ_CASES_THEN2 ASSUME_TAC MP_TAC (SPECL [`N:num`; `n:num`] LE_CASES) + THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `B0 * (m + n)` THEN CONJ_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC (RAND_CONV o funpow 2 LAND_CONV) [ADD_SYM] THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; LE_ADD]]; + DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * m + B` THEN + ONCE_REWRITE_TAC[DIST_SYM] THEN + ASM_REWRITE_TAC[LE_ADD_RCANCEL] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; + LE_ADD]]; + DISCH_THEN(ANTE_RES_THEN ASSUME_TAC) THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `A * n + B` THEN + ASM_REWRITE_TAC[LE_ADD_RCANCEL] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [ADD_SYM] THEN + REWRITE_TAC[LEFT_ADD_DISTRIB; RIGHT_ADD_DISTRIB; GSYM ADD_ASSOC; + LE_ADD]]);; + +(* ------------------------------------------------------------------------- *) +(* Now the multiplicative inverse proper. *) +(* ------------------------------------------------------------------------- *) + +let nadd_inv = new_definition + `nadd_inv(x) = if x === &0 then &0 else afn(nadd_rinv x)`;; + +override_interface ("inv",`nadd_inv:nadd->nadd`);; + +let NADD_INV = prove + (`!x. fn(nadd_inv x) = if x === &0 then (\n. 0) else nadd_rinv x`, + GEN_TAC THEN REWRITE_TAC[nadd_inv] THEN + ASM_CASES_TAC `x === &0` THEN ASM_REWRITE_TAC[NADD_OF_NUM; MULT_CLAUSES] THEN + REWRITE_TAC[GSYM nadd_rep; is_nadd] THEN + MATCH_MP_TAC NADD_MUL_LINV_LEMMA8 THEN POP_ASSUM ACCEPT_TAC);; + +let NADD_MUL_LINV = prove + (`!x. ~(x === &0) ==> inv(x) ** x === &1`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[nadd_eq; NADD_MUL] THEN + ONCE_REWRITE_TAC[BOUNDS_DIVIDED] THEN + X_CHOOSE_THEN `A1:num` (X_CHOOSE_TAC `B1:num`) + (SPECL [`inv(x)`; `x:nadd`] NADD_ALTMUL) THEN + REWRITE_TAC[DIST_LMUL; NADD_OF_NUM; MULT_CLAUSES] THEN + FIRST_ASSUM(X_CHOOSE_TAC `N:num` o MATCH_MP NADD_MUL_LINV_LEMMA2) THEN + X_CHOOSE_THEN `A':num` (X_CHOOSE_TAC `B':num`) + (SPEC `x:nadd` NADD_BOUND) THEN + SUBGOAL_THEN `?A2 B2. !n. dist(fn x n * nadd_rinv x n,n * n) <= A2 * n + B2` + STRIP_ASSUME_TAC THENL + [EXISTS_TAC `A':num` THEN ONCE_REWRITE_TAC[BOUNDS_IGNORE] THEN + MAP_EVERY EXISTS_TAC [`B':num`; `N:num`] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `fn x n` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`A1 + A2`; `B1 + B2`] THEN + GEN_TAC THEN MATCH_MP_TAC DIST_TRIANGLE_LE THEN + EXISTS_TAC `fn (inv x) n * fn x n` THEN + REWRITE_TAC[RIGHT_ADD_DISTRIB] THEN + ONCE_REWRITE_TAC[AC ADD_AC `(a + b) + c + d = (a + c) + (b + d)`] THEN + MATCH_MP_TAC LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV) [MULT_SYM] THEN + ASM_REWRITE_TAC[NADD_INV]]);; + +let NADD_INV_0 = prove + (`inv(&0) === &0`, + REWRITE_TAC[nadd_inv; NADD_EQ_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Welldefinedness follows from already established principles because if *) +(* x = y then y' = y' 1 = y' (x' x) = y' (x' y) = (y' y) x' = 1 x' = x' *) +(* ------------------------------------------------------------------------- *) + +let NADD_INV_WELLDEF = prove + (`!x y. x === y ==> inv(x) === inv(y)`, + let TAC tm ths = + MATCH_MP_TAC NADD_EQ_TRANS THEN EXISTS_TAC tm THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC ths] in + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `x === &0` THENL + [SUBGOAL_THEN `y === &0` ASSUME_TAC THENL + [ASM_MESON_TAC[NADD_EQ_TRANS; NADD_EQ_SYM]; + ASM_REWRITE_TAC[nadd_inv; NADD_EQ_REFL]]; + SUBGOAL_THEN `~(y === &0)` ASSUME_TAC THENL + [ASM_MESON_TAC[NADD_EQ_TRANS; NADD_EQ_SYM]; ALL_TAC]] THEN + TAC `inv(y) ** &1` + [NADD_MUL_SYM; NADD_MUL_LID; NADD_EQ_TRANS] THEN + TAC `inv(y) ** (inv(x) ** x)` + [NADD_MUL_LINV; NADD_MUL_WELLDEF; NADD_EQ_REFL] THEN + TAC `inv(y) ** (inv(x) ** y)` + [NADD_MUL_WELLDEF; NADD_EQ_REFL; NADD_EQ_SYM] THEN + TAC `(inv(y) ** y) ** inv(x)` + [NADD_MUL_ASSOC; NADD_MUL_SYM; NADD_EQ_TRANS; + NADD_MUL_WELLDEF; NADD_EQ_REFL] THEN + ASM_MESON_TAC[NADD_MUL_LINV; NADD_MUL_WELLDEF; NADD_EQ_REFL; + NADD_MUL_LID; NADD_EQ_TRANS; NADD_EQ_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Definition of the new type. *) +(* ------------------------------------------------------------------------- *) + +let hreal_tybij = + define_quotient_type "hreal" ("mk_hreal","dest_hreal") `(===)`;; + +do_list overload_interface + ["+",`hreal_add:hreal->hreal->hreal`; + "*",`hreal_mul:hreal->hreal->hreal`; + "<=",`hreal_le:hreal->hreal->bool`];; + +do_list override_interface + ["&",`hreal_of_num:num->hreal`; + "inv",`hreal_inv:hreal->hreal`];; + +let hreal_of_num,hreal_of_num_th = + lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) + "hreal_of_num" NADD_OF_NUM_WELLDEF;; + +let hreal_add,hreal_add_th = + lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) + "hreal_add" NADD_ADD_WELLDEF;; + +let hreal_mul,hreal_mul_th = + lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) + "hreal_mul" NADD_MUL_WELLDEF;; + +let hreal_le,hreal_le_th = + lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) + "hreal_le" NADD_LE_WELLDEF;; + +let hreal_inv,hreal_inv_th = + lift_function (snd hreal_tybij) (NADD_EQ_REFL,NADD_EQ_TRANS) + "hreal_inv" NADD_INV_WELLDEF;; + +let HREAL_COMPLETE = + let th1 = ASSUME `(P:nadd->bool) = (\x. Q(mk_hreal((===) x)))` in + let th2 = BETA_RULE(AP_THM th1 `x:nadd`) in + let th3 = lift_theorem hreal_tybij + (NADD_EQ_REFL,NADD_EQ_SYM,NADD_EQ_TRANS) + [hreal_of_num_th; hreal_add_th; hreal_mul_th; hreal_le_th; th2] + (SPEC_ALL NADD_COMPLETE) in + let th4 = MATCH_MP (DISCH_ALL th3) (REFL `\x. Q(mk_hreal((===) x)):bool`) in + CONV_RULE(GEN_ALPHA_CONV `P:hreal->bool`) (GEN_ALL th4);; + +let [HREAL_OF_NUM_EQ; HREAL_OF_NUM_LE; HREAL_OF_NUM_ADD; HREAL_OF_NUM_MUL; + HREAL_LE_REFL; HREAL_LE_TRANS; HREAL_LE_ANTISYM; HREAL_LE_TOTAL; + HREAL_LE_ADD; HREAL_LE_EXISTS; HREAL_ARCH; HREAL_ADD_SYM; HREAL_ADD_ASSOC; + HREAL_ADD_LID; HREAL_ADD_LCANCEL; HREAL_MUL_SYM; HREAL_MUL_ASSOC; + HREAL_MUL_LID; HREAL_ADD_LDISTRIB; HREAL_MUL_LINV; HREAL_INV_0] = + map (lift_theorem hreal_tybij + (NADD_EQ_REFL,NADD_EQ_SYM,NADD_EQ_TRANS) + [hreal_of_num_th; hreal_add_th; hreal_mul_th; + hreal_le_th; hreal_inv_th]) + [NADD_OF_NUM_EQ; NADD_OF_NUM_LE; NADD_OF_NUM_ADD; NADD_OF_NUM_MUL; + NADD_LE_REFL; NADD_LE_TRANS; NADD_LE_ANTISYM; NADD_LE_TOTAL; NADD_LE_ADD; + NADD_LE_EXISTS; NADD_ARCH; NADD_ADD_SYM; NADD_ADD_ASSOC; NADD_ADD_LID; + NADD_ADD_LCANCEL; NADD_MUL_SYM; NADD_MUL_ASSOC; NADD_MUL_LID; NADD_LDISTRIB; + NADD_MUL_LINV; NADD_INV_0];; + +(* ------------------------------------------------------------------------- *) +(* Consequential theorems needed later. *) +(* ------------------------------------------------------------------------- *) + +let HREAL_LE_EXISTS_DEF = prove + (`!m n. m <= n <=> ?d. n = m + d`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HREAL_LE_EXISTS] THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN REWRITE_TAC[HREAL_LE_ADD]);; + +let HREAL_EQ_ADD_LCANCEL = prove + (`!m n p. (m + n = m + p) <=> (n = p)`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[HREAL_ADD_LCANCEL] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +let HREAL_EQ_ADD_RCANCEL = prove + (`!m n p. (m + p = n + p) <=> (m = n)`, + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN REWRITE_TAC[HREAL_EQ_ADD_LCANCEL]);; + +let HREAL_LE_ADD_LCANCEL = prove + (`!m n p. (m + n <= m + p) <=> (n <= p)`, + REWRITE_TAC[HREAL_LE_EXISTS_DEF; GSYM HREAL_ADD_ASSOC; + HREAL_EQ_ADD_LCANCEL]);; + +let HREAL_LE_ADD_RCANCEL = prove + (`!m n p. (m + p <= n + p) <=> (m <= n)`, + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN MATCH_ACCEPT_TAC HREAL_LE_ADD_LCANCEL);; + +let HREAL_ADD_RID = prove + (`!n. n + &0 = n`, + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN MATCH_ACCEPT_TAC HREAL_ADD_LID);; + +let HREAL_ADD_RDISTRIB = prove + (`!m n p. (m + n) * p = m * p + n * p`, + ONCE_REWRITE_TAC[HREAL_MUL_SYM] THEN MATCH_ACCEPT_TAC HREAL_ADD_LDISTRIB);; + +let HREAL_MUL_LZERO = prove + (`!m. &0 * m = &0`, + GEN_TAC THEN MP_TAC(SPECL [`&0`; `&1`; `m:hreal`] HREAL_ADD_RDISTRIB) THEN + REWRITE_TAC[HREAL_ADD_LID] THEN + GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM HREAL_ADD_LID] THEN + REWRITE_TAC[HREAL_EQ_ADD_RCANCEL] THEN + DISCH_THEN(ACCEPT_TAC o SYM));; + +let HREAL_MUL_RZERO = prove + (`!m. m * &0 = &0`, + ONCE_REWRITE_TAC[HREAL_MUL_SYM] THEN MATCH_ACCEPT_TAC HREAL_MUL_LZERO);; + +let HREAL_ADD_AC = prove + (`(m + n = n + m) /\ + ((m + n) + p = m + (n + p)) /\ + (m + (n + p) = n + (m + p))`, + REWRITE_TAC[HREAL_ADD_ASSOC; EQT_INTRO(SPEC_ALL HREAL_ADD_SYM)] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_ACCEPT_TAC HREAL_ADD_SYM);; + +let HREAL_LE_ADD2 = prove + (`!a b c d. a <= b /\ c <= d ==> a + c <= b + d`, + REPEAT GEN_TAC THEN REWRITE_TAC[HREAL_LE_EXISTS_DEF] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `d1:hreal`) + (X_CHOOSE_TAC `d2:hreal`)) THEN + EXISTS_TAC `d1 + d2` THEN ASM_REWRITE_TAC[HREAL_ADD_AC]);; + +let HREAL_LE_MUL_RCANCEL_IMP = prove + (`!a b c. a <= b ==> a * c <= b * c`, + REPEAT GEN_TAC THEN REWRITE_TAC[HREAL_LE_EXISTS_DEF] THEN + DISCH_THEN(X_CHOOSE_THEN `d:hreal` SUBST1_TAC) THEN + EXISTS_TAC `d * c` THEN REWRITE_TAC[HREAL_ADD_RDISTRIB]);; + +(* ------------------------------------------------------------------------- *) +(* Define operations on representatives of signed reals. *) +(* ------------------------------------------------------------------------- *) + +let treal_of_num = new_definition + `treal_of_num n = (&n, &0)`;; + +let treal_neg = new_definition + `treal_neg ((x:hreal),(y:hreal)) = (y,x)`;; + +let treal_add = new_definition + `(x1,y1) treal_add (x2,y2) = (x1 + x2, y1 + y2)`;; + +let treal_mul = new_definition + `(x1,y1) treal_mul (x2,y2) = ((x1 * x2) + (y1 * y2),(x1 * y2) + (y1 * x2))`;; + +let treal_le = new_definition + `(x1,y1) treal_le (x2,y2) <=> x1 + y2 <= x2 + y1`;; + +let treal_inv = new_definition + `treal_inv(x,y) = if x = y then (&0, &0) + else if y <= x then (inv(@d. x = y + d), &0) + else (&0, inv(@d. y = x + d))`;; + +(* ------------------------------------------------------------------------- *) +(* Define the equivalence relation and prove it *is* one. *) +(* ------------------------------------------------------------------------- *) + +let treal_eq = new_definition + `(x1,y1) treal_eq (x2,y2) <=> (x1 + y2 = x2 + y1)`;; + +let TREAL_EQ_REFL = prove + (`!x. x treal_eq x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_eq]);; + +let TREAL_EQ_SYM = prove + (`!x y. x treal_eq y <=> y treal_eq x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_eq; EQ_SYM_EQ]);; + +let TREAL_EQ_TRANS = prove + (`!x y z. x treal_eq y /\ y treal_eq z ==> x treal_eq z`, + REWRITE_TAC[FORALL_PAIR_THM; treal_eq] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MK_COMB o (AP_TERM `(+)` F_F I) o CONJ_PAIR) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HREAL_ADD_SYM] THEN + REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[HREAL_ADD_ASSOC; HREAL_EQ_ADD_RCANCEL] THEN + DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[HREAL_ADD_SYM]));; + +(* ------------------------------------------------------------------------- *) +(* Useful to avoid unnecessary use of the equivalence relation. *) +(* ------------------------------------------------------------------------- *) + +let TREAL_EQ_AP = prove + (`!x y. (x = y) ==> x treal_eq y`, + SIMP_TAC[TREAL_EQ_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Commutativity properties for injector. *) +(* ------------------------------------------------------------------------- *) + +let TREAL_OF_NUM_EQ = prove + (`!m n. (treal_of_num m treal_eq treal_of_num n) <=> (m = n)`, + REWRITE_TAC[treal_of_num; treal_eq; HREAL_OF_NUM_EQ; HREAL_ADD_RID]);; + +let TREAL_OF_NUM_LE = prove + (`!m n. (treal_of_num m treal_le treal_of_num n) <=> m <= n`, + REWRITE_TAC[treal_of_num; treal_le; HREAL_OF_NUM_LE; HREAL_ADD_RID]);; + +let TREAL_OF_NUM_ADD = prove + (`!m n. (treal_of_num m treal_add treal_of_num n) treal_eq + (treal_of_num(m + n))`, + REWRITE_TAC[treal_of_num; treal_eq; treal_add; + HREAL_OF_NUM_ADD; HREAL_ADD_RID; ADD_CLAUSES]);; + +let TREAL_OF_NUM_MUL = prove + (`!m n. (treal_of_num m treal_mul treal_of_num n) treal_eq + (treal_of_num(m * n))`, + REWRITE_TAC[treal_of_num; treal_eq; treal_mul; + HREAL_OF_NUM_MUL; HREAL_MUL_RZERO; HREAL_MUL_LZERO; HREAL_ADD_RID; + HREAL_ADD_LID; HREAL_ADD_RID; MULT_CLAUSES]);; + +(* ------------------------------------------------------------------------- *) +(* Strong forms of equality are useful to simplify welldefinedness proofs. *) +(* ------------------------------------------------------------------------- *) + +let TREAL_ADD_SYM_EQ = prove + (`!x y. x treal_add y = y treal_add x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_add; PAIR_EQ; HREAL_ADD_SYM]);; + +let TREAL_MUL_SYM_EQ = prove + (`!x y. x treal_mul y = y treal_mul x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_mul; HREAL_MUL_SYM; HREAL_ADD_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Prove the properties of operations on representatives. *) +(* ------------------------------------------------------------------------- *) + +let TREAL_ADD_SYM = prove + (`!x y. (x treal_add y) treal_eq (y treal_add x)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC TREAL_EQ_AP THEN + MATCH_ACCEPT_TAC TREAL_ADD_SYM_EQ);; + +let TREAL_ADD_ASSOC = prove + (`!x y z. (x treal_add (y treal_add z)) treal_eq + ((x treal_add y) treal_add z)`, + SIMP_TAC[FORALL_PAIR_THM; TREAL_EQ_AP; treal_add; HREAL_ADD_ASSOC]);; + +let TREAL_ADD_LID = prove + (`!x. ((treal_of_num 0) treal_add x) treal_eq x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_of_num; treal_add; treal_eq; + HREAL_ADD_LID]);; + +let TREAL_ADD_LINV = prove + (`!x. ((treal_neg x) treal_add x) treal_eq (treal_of_num 0)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_neg; treal_add; treal_eq; treal_of_num; + HREAL_ADD_LID; HREAL_ADD_RID; HREAL_ADD_SYM]);; + +let TREAL_MUL_SYM = prove + (`!x y. (x treal_mul y) treal_eq (y treal_mul x)`, + SIMP_TAC[TREAL_EQ_AP; TREAL_MUL_SYM_EQ]);; + +let TREAL_MUL_ASSOC = prove + (`!x y z. (x treal_mul (y treal_mul z)) treal_eq + ((x treal_mul y) treal_mul z)`, + SIMP_TAC[FORALL_PAIR_THM; TREAL_EQ_AP; treal_mul; HREAL_ADD_LDISTRIB; + HREAL_ADD_RDISTRIB; GSYM HREAL_MUL_ASSOC; HREAL_ADD_AC]);; + +let TREAL_MUL_LID = prove + (`!x. ((treal_of_num 1) treal_mul x) treal_eq x`, + SIMP_TAC[FORALL_PAIR_THM; treal_of_num; treal_mul; treal_eq] THEN + REWRITE_TAC[HREAL_MUL_LZERO; HREAL_MUL_LID; HREAL_ADD_LID; HREAL_ADD_RID]);; + +let TREAL_ADD_LDISTRIB = prove + (`!x y z. (x treal_mul (y treal_add z)) treal_eq + ((x treal_mul y) treal_add (x treal_mul z))`, + SIMP_TAC[FORALL_PAIR_THM; TREAL_EQ_AP; treal_mul; treal_add; + HREAL_ADD_LDISTRIB; PAIR_EQ; HREAL_ADD_AC]);; + +let TREAL_LE_REFL = prove + (`!x. x treal_le x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_le; HREAL_LE_REFL]);; + +let TREAL_LE_ANTISYM = prove + (`!x y. x treal_le y /\ y treal_le x <=> (x treal_eq y)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_le; treal_eq; HREAL_LE_ANTISYM]);; + +let TREAL_LE_TRANS = prove + (`!x y z. x treal_le y /\ y treal_le z ==> x treal_le z`, + REWRITE_TAC[FORALL_PAIR_THM; treal_le] THEN REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HREAL_LE_ADD2) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [HREAL_ADD_SYM] THEN + REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_LE_ADD_LCANCEL] THEN + REWRITE_TAC[HREAL_ADD_ASSOC; HREAL_LE_ADD_RCANCEL] THEN + DISCH_THEN(MATCH_ACCEPT_TAC o ONCE_REWRITE_RULE[HREAL_ADD_SYM]));; + +let TREAL_LE_TOTAL = prove + (`!x y. x treal_le y \/ y treal_le x`, + REWRITE_TAC[FORALL_PAIR_THM; treal_le; HREAL_LE_TOTAL]);; + +let TREAL_LE_LADD_IMP = prove + (`!x y z. (y treal_le z) ==> (x treal_add y) treal_le (x treal_add z)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_le; treal_add] THEN + REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_LE_ADD_LCANCEL] THEN + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN + REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_LE_ADD_LCANCEL]);; + +let TREAL_LE_MUL = prove + (`!x y. (treal_of_num 0) treal_le x /\ (treal_of_num 0) treal_le y + ==> (treal_of_num 0) treal_le (x treal_mul y)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_of_num; treal_le; treal_mul] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC o MATCH_MP HREAL_LE_EXISTS) THEN + REWRITE_TAC[HREAL_ADD_LDISTRIB; HREAL_LE_ADD_LCANCEL; + GSYM HREAL_ADD_ASSOC] THEN + GEN_REWRITE_TAC RAND_CONV [HREAL_ADD_SYM] THEN + ASM_REWRITE_TAC[HREAL_LE_ADD_LCANCEL] THEN + MATCH_MP_TAC HREAL_LE_MUL_RCANCEL_IMP THEN ASM_REWRITE_TAC[]);; + +let TREAL_INV_0 = prove + (`treal_inv (treal_of_num 0) treal_eq (treal_of_num 0)`, + REWRITE_TAC[treal_inv; treal_eq; treal_of_num]);; + +let TREAL_MUL_LINV = prove + (`!x. ~(x treal_eq treal_of_num 0) ==> + (treal_inv(x) treal_mul x) treal_eq (treal_of_num 1)`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:hreal`; `y:hreal`] THEN + PURE_REWRITE_TAC[treal_eq; treal_of_num; treal_mul; treal_inv] THEN + PURE_REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN DISCH_TAC THEN + PURE_ASM_REWRITE_TAC[COND_CLAUSES] THEN COND_CASES_TAC THEN + PURE_REWRITE_TAC[treal_mul; treal_eq] THEN + REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID; + HREAL_MUL_LZERO; HREAL_MUL_RZERO] THENL + [ALL_TAC; + DISJ_CASES_THEN MP_TAC(SPECL [`x:hreal`; `y:hreal`] HREAL_LE_TOTAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP HREAL_LE_EXISTS) THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN + DISCH_THEN(fun th -> ASSUME_TAC (SYM th) THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[HREAL_ADD_LDISTRIB] THEN + GEN_REWRITE_TAC RAND_CONV [HREAL_ADD_SYM] THEN + AP_TERM_TAC THEN MATCH_MP_TAC HREAL_MUL_LINV THEN + DISCH_THEN SUBST_ALL_TAC THEN + FIRST_ASSUM(UNDISCH_TAC o check is_eq o concl) THEN + ASM_REWRITE_TAC[HREAL_ADD_RID] THEN + PURE_ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Show that the operations respect the equivalence relation. *) +(* ------------------------------------------------------------------------- *) + +let TREAL_OF_NUM_WELLDEF = prove + (`!m n. (m = n) ==> (treal_of_num m) treal_eq (treal_of_num n)`, + REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + MATCH_ACCEPT_TAC TREAL_EQ_REFL);; + +let TREAL_NEG_WELLDEF = prove + (`!x1 x2. x1 treal_eq x2 ==> (treal_neg x1) treal_eq (treal_neg x2)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_neg; treal_eq] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN ASM_REWRITE_TAC[]);; + +let TREAL_ADD_WELLDEFR = prove + (`!x1 x2 y. x1 treal_eq x2 ==> (x1 treal_add y) treal_eq (x2 treal_add y)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_add; treal_eq] THEN + REWRITE_TAC[HREAL_EQ_ADD_RCANCEL; HREAL_ADD_ASSOC] THEN + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN + REWRITE_TAC[HREAL_EQ_ADD_RCANCEL; HREAL_ADD_ASSOC]);; + +let TREAL_ADD_WELLDEF = prove + (`!x1 x2 y1 y2. x1 treal_eq x2 /\ y1 treal_eq y2 ==> + (x1 treal_add y1) treal_eq (x2 treal_add y2)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC TREAL_EQ_TRANS THEN EXISTS_TAC `x1 treal_add y2` THEN + CONJ_TAC THENL [ONCE_REWRITE_TAC[TREAL_ADD_SYM_EQ]; ALL_TAC] THEN + MATCH_MP_TAC TREAL_ADD_WELLDEFR THEN ASM_REWRITE_TAC[]);; + +let TREAL_MUL_WELLDEFR = prove + (`!x1 x2 y. x1 treal_eq x2 ==> (x1 treal_mul y) treal_eq (x2 treal_mul y)`, + REWRITE_TAC[FORALL_PAIR_THM; treal_mul; treal_eq] THEN REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[AC HREAL_ADD_AC + `(a + b) + (c + d) = (a + d) + (b + c)`] THEN + REWRITE_TAC[GSYM HREAL_ADD_RDISTRIB] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[HREAL_ADD_SYM] THEN POP_ASSUM SUBST1_TAC THEN REFL_TAC);; + +let TREAL_MUL_WELLDEF = prove + (`!x1 x2 y1 y2. x1 treal_eq x2 /\ y1 treal_eq y2 ==> + (x1 treal_mul y1) treal_eq (x2 treal_mul y2)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC TREAL_EQ_TRANS THEN EXISTS_TAC `x1 treal_mul y2` THEN + CONJ_TAC THENL [ONCE_REWRITE_TAC[TREAL_MUL_SYM_EQ]; ALL_TAC] THEN + MATCH_MP_TAC TREAL_MUL_WELLDEFR THEN ASM_REWRITE_TAC[]);; + +let TREAL_EQ_IMP_LE = prove + (`!x y. x treal_eq y ==> x treal_le y`, + SIMP_TAC[FORALL_PAIR_THM; treal_eq; treal_le; HREAL_LE_REFL]);; + +let TREAL_LE_WELLDEF = prove + (`!x1 x2 y1 y2. x1 treal_eq x2 /\ y1 treal_eq y2 ==> + (x1 treal_le y1 <=> x2 treal_le y2)`, + REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL + [MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `y1:hreal#hreal` THEN + CONJ_TAC THENL + [MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `x1:hreal#hreal` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TREAL_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[TREAL_EQ_SYM]; + MATCH_MP_TAC TREAL_EQ_IMP_LE]; + MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `y2:hreal#hreal` THEN + CONJ_TAC THENL + [MATCH_MP_TAC TREAL_LE_TRANS THEN EXISTS_TAC `x2:hreal#hreal` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TREAL_EQ_IMP_LE; + MATCH_MP_TAC TREAL_EQ_IMP_LE THEN ONCE_REWRITE_TAC[TREAL_EQ_SYM]]] THEN + ASM_REWRITE_TAC[]);; + +let TREAL_INV_WELLDEF = prove + (`!x y. x treal_eq y ==> (treal_inv x) treal_eq (treal_inv y)`, + let lemma = prove + (`(@d. x = x + d) = &0`, + MATCH_MP_TAC SELECT_UNIQUE THEN BETA_TAC THEN + GEN_TAC THEN GEN_REWRITE_TAC (funpow 2 LAND_CONV) [GSYM HREAL_ADD_RID] THEN + REWRITE_TAC[HREAL_EQ_ADD_LCANCEL] THEN + MATCH_ACCEPT_TAC EQ_SYM_EQ) in + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x1:hreal`; `x2:hreal`; `y1:hreal`; `y2:hreal`] THEN + PURE_REWRITE_TAC[treal_eq; treal_inv] THEN + ASM_CASES_TAC `x1 :hreal = x2` THEN + ASM_CASES_TAC `y1 :hreal = y2` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TREAL_EQ_REFL] THEN + DISCH_THEN(MP_TAC o GEN_REWRITE_RULE RAND_CONV [HREAL_ADD_SYM]) THEN + REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; HREAL_EQ_ADD_RCANCEL] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[HREAL_LE_REFL; lemma; HREAL_INV_0;TREAL_EQ_REFL] THEN + ASM_CASES_TAC `x2 <= x1` THEN ASM_REWRITE_TAC[] THENL + [FIRST_ASSUM(ASSUME_TAC o SYM o SELECT_RULE o MATCH_MP HREAL_LE_EXISTS) THEN + UNDISCH_TAC `x1 + y2 = x2 + y1` THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; GSYM HREAL_ADD_ASSOC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ONCE_REWRITE_RULE[HREAL_ADD_SYM] HREAL_LE_ADD] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV o BINDER_CONV o + LAND_CONV) [HREAL_ADD_SYM] THEN + REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; TREAL_EQ_REFL]; + DISJ_CASES_THEN MP_TAC + (SPECL [`x1:hreal`; `x2:hreal`] HREAL_LE_TOTAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o SYM o SELECT_RULE o MATCH_MP HREAL_LE_EXISTS) THEN + UNDISCH_TAC `x1 + y2 = x2 + y1` THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; GSYM HREAL_ADD_ASSOC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[ONCE_REWRITE_RULE[HREAL_ADD_SYM] HREAL_LE_ADD] THEN + COND_CASES_TAC THENL + [UNDISCH_TAC `(@d. x2 = x1 + d) + y1 <= y1:hreal` THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM HREAL_ADD_LID] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[HREAL_ADD_SYM] HREAL_LE_ADD_LCANCEL] THEN + DISCH_TAC THEN SUBGOAL_THEN `(@d. x2 = x1 + d) = &0` MP_TAC THENL + [ASM_REWRITE_TAC[GSYM HREAL_LE_ANTISYM] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM HREAL_ADD_LID] THEN + REWRITE_TAC[HREAL_LE_ADD]; + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `x1 + & 0 = x2` THEN + ASM_REWRITE_TAC[HREAL_ADD_RID]]; + GEN_REWRITE_TAC (funpow 3 RAND_CONV o BINDER_CONV o LAND_CONV) + [HREAL_ADD_SYM] THEN + REWRITE_TAC[HREAL_EQ_ADD_LCANCEL; TREAL_EQ_REFL]]]);; + +(* ------------------------------------------------------------------------- *) +(* Now define the quotient type -- the reals at last! *) +(* ------------------------------------------------------------------------- *) + +let real_tybij = + define_quotient_type "real" ("mk_real","dest_real") `(treal_eq)`;; + +let real_of_num,real_of_num_th = + lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) + "real_of_num" TREAL_OF_NUM_WELLDEF;; + +let real_neg,real_neg_th = + lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) + "real_neg" TREAL_NEG_WELLDEF;; + +let real_add,real_add_th = + lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) + "real_add" TREAL_ADD_WELLDEF;; + +let real_mul,real_mul_th = + lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) + "real_mul" TREAL_MUL_WELLDEF;; + +let real_le,real_le_th = + lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) + "real_le" TREAL_LE_WELLDEF;; + +let real_inv,real_inv_th = + lift_function (snd real_tybij) (TREAL_EQ_REFL,TREAL_EQ_TRANS) + "real_inv" TREAL_INV_WELLDEF;; + +let [REAL_ADD_SYM; REAL_ADD_ASSOC; REAL_ADD_LID; REAL_ADD_LINV; + REAL_MUL_SYM; REAL_MUL_ASSOC; REAL_MUL_LID; + REAL_ADD_LDISTRIB; + REAL_LE_REFL; REAL_LE_ANTISYM; REAL_LE_TRANS; REAL_LE_TOTAL; + REAL_LE_LADD_IMP; REAL_LE_MUL; + REAL_INV_0; REAL_MUL_LINV; + REAL_OF_NUM_EQ; REAL_OF_NUM_LE; REAL_OF_NUM_ADD; REAL_OF_NUM_MUL] = + map + (lift_theorem real_tybij (TREAL_EQ_REFL,TREAL_EQ_SYM,TREAL_EQ_TRANS) + [real_of_num_th; real_neg_th; real_add_th; + real_mul_th; real_le_th; real_inv_th]) + [TREAL_ADD_SYM; TREAL_ADD_ASSOC; TREAL_ADD_LID; TREAL_ADD_LINV; + TREAL_MUL_SYM; TREAL_MUL_ASSOC; TREAL_MUL_LID; + TREAL_ADD_LDISTRIB; + TREAL_LE_REFL; TREAL_LE_ANTISYM; TREAL_LE_TRANS; TREAL_LE_TOTAL; + TREAL_LE_LADD_IMP; TREAL_LE_MUL; + TREAL_INV_0; TREAL_MUL_LINV; + TREAL_OF_NUM_EQ; TREAL_OF_NUM_LE; TREAL_OF_NUM_ADD; TREAL_OF_NUM_MUL];; + +(* ------------------------------------------------------------------------- *) +(* Set up a friendly interface. *) +(* ------------------------------------------------------------------------- *) + +parse_as_prefix "--";; +parse_as_infix ("/",(22,"left"));; +parse_as_infix ("pow",(24,"left"));; + +do_list overload_interface + ["+",`real_add:real->real->real`; "-",`real_sub:real->real->real`; + "*",`real_mul:real->real->real`; "/",`real_div:real->real->real`; + "<",`real_lt:real->real->bool`; "<=",`real_le:real->real->bool`; + ">",`real_gt:real->real->bool`; ">=",`real_ge:real->real->bool`; + "--",`real_neg:real->real`; "pow",`real_pow:real->num->real`; + "inv",`real_inv:real->real`; "abs",`real_abs:real->real`; + "max",`real_max:real->real->real`; "min",`real_min:real->real->real`; + "&",`real_of_num:num->real`];; + +let prioritize_real() = prioritize_overload(mk_type("real",[]));; + +(* ------------------------------------------------------------------------- *) +(* Additional definitions. *) +(* ------------------------------------------------------------------------- *) + +let real_sub = new_definition + `x - y = x + --y`;; + +let real_lt = new_definition + `x < y <=> ~(y <= x)`;; + +let real_ge = new_definition + `x >= y <=> y <= x`;; + +let real_gt = new_definition + `x > y <=> y < x`;; + +let real_abs = new_definition + `abs(x) = if &0 <= x then x else --x`;; + +let real_pow = new_recursive_definition num_RECURSION + `(x pow 0 = &1) /\ + (!n. x pow (SUC n) = x * (x pow n))`;; + +let real_div = new_definition + `x / y = x * inv(y)`;; + +let real_max = new_definition + `real_max m n = if m <= n then n else m`;; + +let real_min = new_definition + `real_min m n = if m <= n then m else n`;; + +(*----------------------------------------------------------------------------*) +(* Derive the supremum property for an arbitrary bounded nonempty set *) +(*----------------------------------------------------------------------------*) + +let REAL_HREAL_LEMMA1 = prove + (`?r:hreal->real. + (!x. &0 <= x <=> ?y. x = r y) /\ + (!y z. y <= z <=> r y <= r z)`, + EXISTS_TAC `\y. mk_real((treal_eq)(y,hreal_of_num 0))` THEN + REWRITE_TAC[GSYM real_le_th] THEN + REWRITE_TAC[treal_le; HREAL_ADD_LID; HREAL_ADD_RID] THEN + GEN_TAC THEN EQ_TAC THENL + [MP_TAC(INST [`dest_real x`,`r:hreal#hreal->bool`] (snd real_tybij)) THEN + REWRITE_TAC[fst real_tybij] THEN + DISCH_THEN(X_CHOOSE_THEN `p:hreal#hreal` MP_TAC) THEN + DISCH_THEN(MP_TAC o AP_TERM `mk_real`) THEN + REWRITE_TAC[fst real_tybij] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM real_of_num_th; GSYM real_le_th] THEN + SUBST1_TAC(GSYM(ISPEC `p:hreal#hreal` PAIR)) THEN + PURE_REWRITE_TAC[treal_of_num; treal_le] THEN + PURE_REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN + DISCH_THEN(X_CHOOSE_THEN `d:hreal` SUBST1_TAC o + MATCH_MP HREAL_LE_EXISTS) THEN + EXISTS_TAC `d:hreal` THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `q:hreal#hreal` THEN + SUBST1_TAC(GSYM(ISPEC `q:hreal#hreal` PAIR)) THEN + PURE_REWRITE_TAC[treal_eq] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [HREAL_ADD_SYM] THEN + REWRITE_TAC[GSYM HREAL_ADD_ASSOC; HREAL_EQ_ADD_LCANCEL] THEN + REWRITE_TAC[HREAL_ADD_RID]; + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[GSYM real_of_num_th; GSYM real_le_th] THEN + REWRITE_TAC[treal_of_num; treal_le] THEN + REWRITE_TAC[HREAL_ADD_LID; HREAL_ADD_RID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM HREAL_ADD_LID] THEN + REWRITE_TAC[HREAL_LE_ADD]]);; + +let REAL_HREAL_LEMMA2 = prove + (`?h r. (!x:hreal. h(r x) = x) /\ + (!x. &0 <= x ==> (r(h x) = x)) /\ + (!x:hreal. &0 <= r x) /\ + (!x y. x <= y <=> r x <= r y)`, + STRIP_ASSUME_TAC REAL_HREAL_LEMMA1 THEN + EXISTS_TAC `\x:real. @y:hreal. x = r y` THEN + EXISTS_TAC `r:hreal->real` THEN + ASM_REWRITE_TAC[BETA_THM] THEN + SUBGOAL_THEN `!y z. ((r:hreal->real) y = r z) <=> (y = z)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM; GSYM HREAL_LE_ANTISYM]; ALL_TAC] THEN + ASM_REWRITE_TAC[GEN_REWRITE_RULE (LAND_CONV o BINDER_CONV) [EQ_SYM_EQ] + (SPEC_ALL SELECT_REFL); GSYM EXISTS_REFL] THEN + GEN_TAC THEN DISCH_THEN(ACCEPT_TAC o SYM o SELECT_RULE));; + +let REAL_COMPLETE_SOMEPOS = prove + (`!P. (?x. P x /\ &0 <= x) /\ + (?M. !x. P x ==> x <= M) + ==> ?M. (!x. P x ==> x <= M) /\ + !M'. (!x. P x ==> x <= M') ==> M <= M'`, + REPEAT STRIP_TAC THEN STRIP_ASSUME_TAC REAL_HREAL_LEMMA2 THEN + MP_TAC(SPEC `\y:hreal. (P:real->bool)(r y)` HREAL_COMPLETE) THEN + BETA_TAC THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC THENL + [EXISTS_TAC `(h:real->hreal) x` THEN + UNDISCH_TAC `(P:real->bool) x` THEN + MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN + AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `(h:real->hreal) M` THEN + X_GEN_TAC `y:hreal` THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN + AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(TAUT `(b ==> c) ==> a ==> (a ==> b) ==> c`) THEN + DISCH_THEN(X_CHOOSE_THEN `B:hreal` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `(r:hreal->real) B` THEN CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN DISCH_TAC THEN + DISJ_CASES_TAC(SPECL [`&0`; `z:real`] REAL_LE_TOTAL) THENL + [ANTE_RES_THEN(SUBST1_TAC o SYM) (ASSUME `&0 <= z`) THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC I [GSYM th]) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `(P:real->bool) z` THEN + MATCH_MP_TAC(TAUT `(b <=> a) ==> a ==> b`) THEN + AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `C:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `B:hreal <= (h(C:real))` MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(r:hreal->real)(h C) = C` (fun th -> ASM_REWRITE_TAC[th]); + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + +let REAL_COMPLETE = prove + (`!P. (?x. P x) /\ + (?M. !x. P x ==> x <= M) + ==> ?M. (!x. P x ==> x <= M) /\ + !M'. (!x. P x ==> x <= M') ==> M <= M'`, + let lemma = prove + (`y = (y - x) + x`, + REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_LINV] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_LID]) in + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC (SPECL [`&0`; `x:real`] REAL_LE_TOTAL) THENL + [MATCH_MP_TAC REAL_COMPLETE_SOMEPOS THEN CONJ_TAC THENL + [EXISTS_TAC `x:real`; EXISTS_TAC `M:real`] THEN + ASM_REWRITE_TAC[]; + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_LE_LADD_IMP) THEN + DISCH_THEN(MP_TAC o SPEC `--x`) THEN + REWRITE_TAC[REAL_ADD_LINV] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[REAL_ADD_LID] THEN + DISCH_TAC THEN + MP_TAC(SPEC `\y. P(y + x) :bool` REAL_COMPLETE_SOMEPOS) THEN + BETA_TAC THEN + W(C SUBGOAL_THEN MP_TAC o funpow 2 (fst o dest_imp) o snd) THENL + [CONJ_TAC THENL + [EXISTS_TAC `&0` THEN ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_LID]; + EXISTS_TAC `M + --x` THEN GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LE_LADD_IMP) THEN + DISCH_THEN(MP_TAC o ONCE_REWRITE_RULE[REAL_ADD_SYM]) THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LINV] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]; + MATCH_MP_TAC(TAUT `(b ==> c) ==> a ==> (a ==> b) ==> c`) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `B + x` THEN CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [lemma] THEN + DISCH_THEN(ANTE_RES_THEN + (MP_TAC o SPEC `x:real` o MATCH_MP REAL_LE_LADD_IMP)) THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[real_sub; GSYM REAL_ADD_ASSOC; REAL_ADD_LINV] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN SUBGOAL_THEN `B <= M' - x` MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `z:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `z + x <= M'` MP_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o SPEC `--x` o MATCH_MP REAL_LE_LADD_IMP) THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + REWRITE_TAC[real_sub] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LINV] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]; + DISCH_THEN(MP_TAC o SPEC `x:real` o MATCH_MP REAL_LE_LADD_IMP) THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [MATCH_ACCEPT_TAC REAL_ADD_SYM; + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN REWRITE_TAC[real_sub] THEN + REWRITE_TAC[GSYM REAL_ADD_ASSOC; REAL_ADD_LINV] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[REAL_ADD_SYM] REAL_ADD_LID]]]]]);; + +do_list reduce_interface + ["+",`hreal_add:hreal->hreal->hreal`; + "*",`hreal_mul:hreal->hreal->hreal`; + "<=",`hreal_le:hreal->hreal->bool`; + "inv",`hreal_inv:hreal->hreal`];; + +do_list remove_interface ["**"; "++"; "<<="; "==="; "fn"; "afn"];; diff --git a/recursion.ml b/recursion.ml new file mode 100644 index 0000000..9258e80 --- /dev/null +++ b/recursion.ml @@ -0,0 +1,115 @@ +(* ========================================================================= *) +(* Definition by primitive recursion and other tools for inductive types. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "nums.ml";; + +(* ------------------------------------------------------------------------- *) +(* Prove existence of recursive function. The inner "raw" version requires *) +(* exact correspondence with recursion theorem; "canon" requires the *) +(* PR argument to come first in the arg list; the outer one is more general. *) +(* ------------------------------------------------------------------------- *) + +let prove_recursive_functions_exist = + let prove_raw_recursive_functions_exist ax tm = + let rawcls = conjuncts tm in + let spcls = map (snd o strip_forall) rawcls in + let lpats = map (strip_comb o lhand) spcls in + let ufns = itlist (insert o fst) lpats [] in + let axth = SPEC_ALL ax in + let exvs,axbody = strip_exists (concl axth) in + let axcls = conjuncts axbody in + let f = fst o dest_const o repeat rator o rand o + lhand o snd o strip_forall in + let findax = C assoc (map (fun t -> f t,t) axcls) in + let raxs = + map (findax o fst o dest_const o repeat rator o hd o snd) lpats in + let axfns = map (repeat rator o lhand o snd o strip_forall) raxs in + let urfns = map (fun v -> assocd v (setify (zip axfns (map fst lpats))) v) + exvs in + let axtm = list_mk_exists(exvs,list_mk_conj raxs) + and urtm = list_mk_exists(urfns,tm) in + let insts = term_match [] axtm urtm in + let ixth = INSTANTIATE insts axth in + let ixvs,ixbody = strip_exists (concl ixth) in + let ixtm = subst (zip urfns ixvs) ixbody in + let ixths = CONJUNCTS (ASSUME ixtm) in + let rixths = map (fun t -> find (aconv t o concl) ixths) rawcls in + let rixth = itlist SIMPLE_EXISTS ufns (end_itlist CONJ rixths) in + PROVE_HYP ixth (itlist SIMPLE_CHOOSE urfns rixth) in + let canonize t = + let avs,bod = strip_forall t in + let l,r = dest_eq bod in + let fn,args = strip_comb l in + let rarg = hd args + and vargs = tl args in + let l' = mk_comb(fn,rarg) + and r' = list_mk_abs(vargs,r) in + let fvs = frees rarg in + let def = ASSUME(list_mk_forall(fvs,mk_eq(l',r'))) in + GENL avs (RIGHT_BETAS vargs (SPECL fvs def)) in + let prove_canon_recursive_functions_exist ax tm = + let ths = map canonize (conjuncts tm) in + let atm = list_mk_conj (map (hd o hyp) ths) in + let aths = CONJUNCTS(ASSUME atm) in + let rth = end_itlist CONJ (map2 PROVE_HYP aths ths) in + let eth = prove_raw_recursive_functions_exist ax atm in + let evs = fst(strip_exists(concl eth)) in + PROVE_HYP eth (itlist SIMPLE_CHOOSE evs (itlist SIMPLE_EXISTS evs rth)) in + let reshuffle fn args acc = + let args' = uncurry (C (@)) (partition is_var args) in + if args = args' then acc else + let gvs = map (genvar o type_of) args in + let gvs' = map (C assoc (zip args gvs)) args' in + let lty = itlist (mk_fun_ty o type_of) gvs' + (funpow (length gvs) (hd o tl o snd o dest_type) (type_of fn)) in + let fn' = genvar lty in + let def = mk_eq(fn,list_mk_abs(gvs,list_mk_comb(fn',gvs'))) in + (ASSUME def)::acc + and scrub_def t th = + let l,r = dest_eq t in + MP (INST [r,l] (DISCH t th)) (REFL r) in + fun ax tm -> + let rawcls = conjuncts tm in + let spcls = map (snd o strip_forall) rawcls in + let lpats = map (strip_comb o lhand) spcls in + let ufns = itlist (insert o fst) lpats [] in + let uxargs = map (C assoc lpats) ufns in + let trths = itlist2 reshuffle ufns uxargs [] in + let tth = GEN_REWRITE_CONV REDEPTH_CONV (BETA_THM::trths) tm in + let eth = prove_canon_recursive_functions_exist ax (rand(concl tth)) in + let evs,ebod = strip_exists(concl eth) in + let fth = itlist SIMPLE_EXISTS ufns (EQ_MP (SYM tth) (ASSUME ebod)) in + let gth = itlist scrub_def (map concl trths) fth in + PROVE_HYP eth (itlist SIMPLE_CHOOSE evs gth);; + +(* ------------------------------------------------------------------------- *) +(* Version that defines function(s). *) +(* ------------------------------------------------------------------------- *) + +let new_recursive_definition = + let the_recursive_definitions = ref [] in + let find_redefinition tm th = + let th' = PART_MATCH I th tm in + ignore(PART_MATCH I th' (concl th)); th' in + fun ax tm -> + try let th = tryfind (find_redefinition tm) (!the_recursive_definitions) in + warn true "Benign redefinition of recursive function"; th + with Failure _ -> + let rawcls = conjuncts tm in + let spcls = map (snd o strip_forall) rawcls in + let lpats = map (strip_comb o lhand) spcls in + let ufns = itlist (insert o fst) lpats [] in + let fvs = map (fun t -> subtract (frees t) ufns) rawcls in + let gcls = map2 (curry list_mk_forall) fvs rawcls in + let eth = prove_recursive_functions_exist ax (list_mk_conj gcls) in + let evs,bod = strip_exists(concl eth) in + let dth = new_specification (map (fst o dest_var) evs) eth in + let dths = map2 SPECL fvs (CONJUNCTS dth) in + let th = end_itlist CONJ dths in + the_recursive_definitions := th::(!the_recursive_definitions); th;; diff --git a/sets.ml b/sets.ml new file mode 100644 index 0000000..8914e0f --- /dev/null +++ b/sets.ml @@ -0,0 +1,3183 @@ +(* ========================================================================= *) +(* Very basic set theory (using predicates as sets). *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* (c) Copyright, Marco Maggesi 2012 *) +(* ========================================================================= *) + +needs "int.ml";; + +(* ------------------------------------------------------------------------- *) +(* Infix symbols for set operations. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("IN",(11,"right"));; +parse_as_infix("SUBSET",(12,"right"));; +parse_as_infix("PSUBSET",(12,"right"));; +parse_as_infix("INTER",(20,"right"));; +parse_as_infix("UNION",(16,"right"));; +parse_as_infix("DIFF",(18,"left"));; +parse_as_infix("INSERT",(21,"right"));; +parse_as_infix("DELETE",(21,"left"));; + +parse_as_infix("HAS_SIZE",(12,"right"));; +parse_as_infix("<=_c",(12,"right"));; +parse_as_infix("<_c",(12,"right"));; +parse_as_infix(">=_c",(12,"right"));; +parse_as_infix(">_c",(12,"right"));; +parse_as_infix("=_c",(12,"right"));; + +(* ------------------------------------------------------------------------- *) +(* Set membership. *) +(* ------------------------------------------------------------------------- *) + +let IN = new_definition + `!P:A->bool. !x. x IN P <=> P x`;; + +(* ------------------------------------------------------------------------- *) +(* Axiom of extensionality in this framework. *) +(* ------------------------------------------------------------------------- *) + +let EXTENSION = prove + (`!s t. (s = t) <=> !x:A. x IN s <=> x IN t`, + REWRITE_TAC[IN; FUN_EQ_THM]);; + +(* ------------------------------------------------------------------------- *) +(* General specification. *) +(* ------------------------------------------------------------------------- *) + +let GSPEC = new_definition + `GSPEC (p:A->bool) = p`;; + +let SETSPEC = new_definition + `SETSPEC v P t <=> P /\ (v = t)`;; + +(* ------------------------------------------------------------------------- *) +(* Rewrite rule for eliminating set-comprehension membership assertions. *) +(* ------------------------------------------------------------------------- *) + +let IN_ELIM_THM = prove + (`(!P x. x IN GSPEC (\v. P (SETSPEC v)) <=> P (\p t. p /\ (x = t))) /\ + (!p x. x IN GSPEC (\v. ?y. SETSPEC v (p y) y) <=> p x) /\ + (!P x. GSPEC (\v. P (SETSPEC v)) x <=> P (\p t. p /\ (x = t))) /\ + (!p x. GSPEC (\v. ?y. SETSPEC v (p y) y) x <=> p x) /\ + (!p x. x IN (\y. p y) <=> p x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[IN; GSPEC] THEN + TRY(AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM]) THEN + REWRITE_TAC[SETSPEC] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* These two definitions are needed first, for the parsing of enumerations. *) +(* ------------------------------------------------------------------------- *) + +let EMPTY = new_definition + `EMPTY = (\x:A. F)`;; + +let INSERT_DEF = new_definition + `x INSERT s = \y:A. y IN s \/ (y = x)`;; + +(* ------------------------------------------------------------------------- *) +(* The other basic operations. *) +(* ------------------------------------------------------------------------- *) + +let UNIV = new_definition + `UNIV = (\x:A. T)`;; + +let UNION = new_definition + `s UNION t = {x:A | x IN s \/ x IN t}`;; + +let UNIONS = new_definition + `UNIONS s = {x:A | ?u. u IN s /\ x IN u}`;; + +let INTER = new_definition + `s INTER t = {x:A | x IN s /\ x IN t}`;; + +let INTERS = new_definition + `INTERS s = {x:A | !u. u IN s ==> x IN u}`;; + +let DIFF = new_definition + `s DIFF t = {x:A | x IN s /\ ~(x IN t)}`;; + +let INSERT = prove + (`x INSERT s = {y:A | y IN s \/ (y = x)}`, + REWRITE_TAC[EXTENSION; INSERT_DEF; IN_ELIM_THM]);; + +let DELETE = new_definition + `s DELETE x = {y:A | y IN s /\ ~(y = x)}`;; + +(* ------------------------------------------------------------------------- *) +(* Other basic predicates. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET = new_definition + `s SUBSET t <=> !x:A. x IN s ==> x IN t`;; + +let PSUBSET = new_definition + `(s:A->bool) PSUBSET t <=> s SUBSET t /\ ~(s = t)`;; + +let DISJOINT = new_definition + `DISJOINT (s:A->bool) t <=> (s INTER t = EMPTY)`;; + +let SING = new_definition + `SING s = ?x:A. s = {x}`;; + +(* ------------------------------------------------------------------------- *) +(* Finiteness. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_RULES,FINITE_INDUCT,FINITE_CASES = + new_inductive_definition + `FINITE (EMPTY:A->bool) /\ + !(x:A) s. FINITE s ==> FINITE (x INSERT s)`;; + +let INFINITE = new_definition + `INFINITE (s:A->bool) <=> ~(FINITE s)`;; + +(* ------------------------------------------------------------------------- *) +(* Stuff concerned with functions. *) +(* ------------------------------------------------------------------------- *) + +let IMAGE = new_definition + `IMAGE (f:A->B) s = { y | ?x. x IN s /\ (y = f x)}`;; + +let INJ = new_definition + `INJ (f:A->B) s t <=> + (!x. x IN s ==> (f x) IN t) /\ + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y))`;; + +let SURJ = new_definition + `SURJ (f:A->B) s t <=> + (!x. x IN s ==> (f x) IN t) /\ + (!x. (x IN t) ==> ?y. y IN s /\ (f y = x))`;; + +let BIJ = new_definition + `BIJ (f:A->B) s t <=> INJ f s t /\ SURJ f s t`;; + +(* ------------------------------------------------------------------------- *) +(* Another funny thing. *) +(* ------------------------------------------------------------------------- *) + +let CHOICE = new_definition + `CHOICE s = @x:A. x IN s`;; + +let REST = new_definition + `REST (s:A->bool) = s DELETE (CHOICE s)`;; + +(* ------------------------------------------------------------------------- *) +(* Basic membership properties. *) +(* ------------------------------------------------------------------------- *) + +let NOT_IN_EMPTY = prove + (`!x:A. ~(x IN EMPTY)`, + REWRITE_TAC[IN; EMPTY]);; + +let IN_UNIV = prove + (`!x:A. x IN UNIV`, + REWRITE_TAC[UNIV; IN]);; + +let IN_UNION = prove + (`!s t (x:A). x IN (s UNION t) <=> x IN s \/ x IN t`, + REWRITE_TAC[IN_ELIM_THM; UNION]);; + +let IN_UNIONS = prove + (`!s (x:A). x IN (UNIONS s) <=> ?t. t IN s /\ x IN t`, + REWRITE_TAC[IN_ELIM_THM; UNIONS]);; + +let IN_INTER = prove + (`!s t (x:A). x IN (s INTER t) <=> x IN s /\ x IN t`, + REWRITE_TAC[IN_ELIM_THM; INTER]);; + +let IN_INTERS = prove + (`!s (x:A). x IN (INTERS s) <=> !t. t IN s ==> x IN t`, + REWRITE_TAC[IN_ELIM_THM; INTERS]);; + +let IN_DIFF = prove + (`!(s:A->bool) t x. x IN (s DIFF t) <=> x IN s /\ ~(x IN t)`, + REWRITE_TAC[IN_ELIM_THM; DIFF]);; + +let IN_INSERT = prove + (`!x:A. !y s. x IN (y INSERT s) <=> (x = y) \/ x IN s`, + ONCE_REWRITE_TAC[DISJ_SYM] THEN REWRITE_TAC[IN_ELIM_THM; INSERT]);; + +let IN_DELETE = prove + (`!s. !x:A. !y. x IN (s DELETE y) <=> x IN s /\ ~(x = y)`, + REWRITE_TAC[IN_ELIM_THM; DELETE]);; + +let IN_SING = prove + (`!x y. x IN {y:A} <=> (x = y)`, + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY]);; + +let IN_IMAGE = prove + (`!y:B. !s f. (y IN (IMAGE f s)) <=> ?x:A. (y = f x) /\ x IN s`, + ONCE_REWRITE_TAC[CONJ_SYM] THEN REWRITE_TAC[IN_ELIM_THM; IMAGE]);; + +let IN_REST = prove + (`!x:A. !s. x IN (REST s) <=> x IN s /\ ~(x = CHOICE s)`, + REWRITE_TAC[REST; IN_DELETE]);; + +let FORALL_IN_INSERT = prove + (`!P a s. (!x. x IN (a INSERT s) ==> P x) <=> P a /\ (!x. x IN s ==> P x)`, + REWRITE_TAC[IN_INSERT] THEN MESON_TAC[]);; + +let EXISTS_IN_INSERT = prove + (`!P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ ?x. x IN s /\ P x`, + REWRITE_TAC[IN_INSERT] THEN MESON_TAC[]);; + +let FORALL_IN_UNION = prove + (`!P s t:A->bool. + (!x. x IN s UNION t ==> P x) <=> + (!x. x IN s ==> P x) /\ (!x. x IN t ==> P x)`, + REWRITE_TAC[IN_UNION] THEN MESON_TAC[]);; + +let EXISTS_IN_UNION = prove + (`!P s t:A->bool. + (?x. x IN s UNION t /\ P x) <=> + (?x. x IN s /\ P x) \/ (?x. x IN t /\ P x)`, + REWRITE_TAC[IN_UNION] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Basic property of the choice function. *) +(* ------------------------------------------------------------------------- *) + +let CHOICE_DEF = prove + (`!s:A->bool. ~(s = EMPTY) ==> (CHOICE s) IN s`, + REWRITE_TAC[CHOICE; EXTENSION; NOT_IN_EMPTY; NOT_FORALL_THM; EXISTS_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Tactic to automate some routine set theory by reduction to FOL. *) +(* ------------------------------------------------------------------------- *) + +let SET_TAC = + let PRESET_TAC = + POP_ASSUM_LIST(K ALL_TAC) THEN REPEAT COND_CASES_TAC THEN + REWRITE_TAC[EXTENSION; SUBSET; PSUBSET; DISJOINT; SING] THEN + REWRITE_TAC[NOT_IN_EMPTY; IN_UNIV; IN_UNION; IN_INTER; IN_DIFF; IN_INSERT; + IN_DELETE; IN_REST; IN_INTERS; IN_UNIONS; IN_IMAGE; + IN_ELIM_THM; IN] in + fun ths -> + (if ths = [] then ALL_TAC else MP_TAC(end_itlist CONJ ths)) THEN + PRESET_TAC THEN + MESON_TAC[];; + +let SET_RULE tm = prove(tm,SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Misc. theorems. *) +(* ------------------------------------------------------------------------- *) + +let NOT_EQUAL_SETS = prove + (`!s:A->bool. !t. ~(s = t) <=> ?x. x IN t <=> ~(x IN s)`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The empty set. *) +(* ------------------------------------------------------------------------- *) + +let MEMBER_NOT_EMPTY = prove + (`!s:A->bool. (?x. x IN s) <=> ~(s = EMPTY)`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The universal set. *) +(* ------------------------------------------------------------------------- *) + +let UNIV_NOT_EMPTY = prove + (`~(UNIV:A->bool = EMPTY)`, + SET_TAC[]);; + +let EMPTY_NOT_UNIV = prove + (`~(EMPTY:A->bool = UNIV)`, + SET_TAC[]);; + +let EQ_UNIV = prove + (`(!x:A. x IN s) <=> (s = UNIV)`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Set inclusion. *) +(* ------------------------------------------------------------------------- *) + +let SUBSET_TRANS = prove + (`!(s:A->bool) t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u`, + SET_TAC[]);; + +let SUBSET_REFL = prove + (`!s:A->bool. s SUBSET s`, + SET_TAC[]);; + +let SUBSET_ANTISYM = prove + (`!(s:A->bool) t. s SUBSET t /\ t SUBSET s ==> s = t`, + SET_TAC[]);; + +let SUBSET_ANTISYM_EQ = prove + (`!(s:A->bool) t. s SUBSET t /\ t SUBSET s <=> s = t`, + SET_TAC[]);; + +let EMPTY_SUBSET = prove + (`!s:A->bool. EMPTY SUBSET s`, + SET_TAC[]);; + +let SUBSET_EMPTY = prove + (`!s:A->bool. s SUBSET EMPTY <=> (s = EMPTY)`, + SET_TAC[]);; + +let SUBSET_UNIV = prove + (`!s:A->bool. s SUBSET UNIV`, + SET_TAC[]);; + +let UNIV_SUBSET = prove + (`!s:A->bool. UNIV SUBSET s <=> (s = UNIV)`, + SET_TAC[]);; + +let SING_SUBSET = prove + (`!s x. {x} SUBSET s <=> x IN s`, + SET_TAC[]);; + +let SUBSET_RESTRICT = prove + (`!s P. {x | x IN s /\ P x} SUBSET s`, + SIMP_TAC[SUBSET; IN_ELIM_THM]);; + +(* ------------------------------------------------------------------------- *) +(* Proper subset. *) +(* ------------------------------------------------------------------------- *) + +let PSUBSET_TRANS = prove + (`!(s:A->bool) t u. s PSUBSET t /\ t PSUBSET u ==> s PSUBSET u`, + SET_TAC[]);; + +let PSUBSET_SUBSET_TRANS = prove + (`!(s:A->bool) t u. s PSUBSET t /\ t SUBSET u ==> s PSUBSET u`, + SET_TAC[]);; + +let SUBSET_PSUBSET_TRANS = prove + (`!(s:A->bool) t u. s SUBSET t /\ t PSUBSET u ==> s PSUBSET u`, + SET_TAC[]);; + +let PSUBSET_IRREFL = prove + (`!s:A->bool. ~(s PSUBSET s)`, + SET_TAC[]);; + +let NOT_PSUBSET_EMPTY = prove + (`!s:A->bool. ~(s PSUBSET EMPTY)`, + SET_TAC[]);; + +let NOT_UNIV_PSUBSET = prove + (`!s:A->bool. ~(UNIV PSUBSET s)`, + SET_TAC[]);; + +let PSUBSET_UNIV = prove + (`!s:A->bool. s PSUBSET UNIV <=> ?x. ~(x IN s)`, + SET_TAC[]);; + +let PSUBSET_ALT = prove + (`!s t:A->bool. s PSUBSET t <=> s SUBSET t /\ (?a. a IN t /\ ~(a IN s))`, + REWRITE_TAC[PSUBSET] THEN SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Union. *) +(* ------------------------------------------------------------------------- *) + +let UNION_ASSOC = prove + (`!(s:A->bool) t u. (s UNION t) UNION u = s UNION (t UNION u)`, + SET_TAC[]);; + +let UNION_IDEMPOT = prove + (`!s:A->bool. s UNION s = s`, + SET_TAC[]);; + +let UNION_COMM = prove + (`!(s:A->bool) t. s UNION t = t UNION s`, + SET_TAC[]);; + +let SUBSET_UNION = prove + (`(!s:A->bool. !t. s SUBSET (s UNION t)) /\ + (!s:A->bool. !t. s SUBSET (t UNION s))`, + SET_TAC[]);; + +let SUBSET_UNION_ABSORPTION = prove + (`!s:A->bool. !t. s SUBSET t <=> (s UNION t = t)`, + SET_TAC[]);; + +let UNION_EMPTY = prove + (`(!s:A->bool. EMPTY UNION s = s) /\ + (!s:A->bool. s UNION EMPTY = s)`, + SET_TAC[]);; + +let UNION_UNIV = prove + (`(!s:A->bool. UNIV UNION s = UNIV) /\ + (!s:A->bool. s UNION UNIV = UNIV)`, + SET_TAC[]);; + +let EMPTY_UNION = prove + (`!s:A->bool. !t. (s UNION t = EMPTY) <=> (s = EMPTY) /\ (t = EMPTY)`, + SET_TAC[]);; + +let UNION_SUBSET = prove + (`!s t u. (s UNION t) SUBSET u <=> s SUBSET u /\ t SUBSET u`, + SET_TAC[]);; + +let FORALL_SUBSET_UNION = prove + (`!t u:A->bool. + (!s. s SUBSET t UNION u ==> P s) <=> + (!t' u'. t' SUBSET t /\ u' SUBSET u ==> P(t' UNION u'))`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]; + DISCH_TAC THEN X_GEN_TAC `s:A->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`s INTER t:A->bool`; `s INTER u:A->bool`]) THEN + ANTS_TAC THENL [ALL_TAC; MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC] THEN + ASM SET_TAC[]]);; + +let EXISTS_SUBSET_UNION = prove + (`!t u:A->bool. + (?s. s SUBSET t UNION u /\ P s) <=> + (?t' u'. t' SUBSET t /\ u' SUBSET u /\ P(t' UNION u'))`, + REWRITE_TAC[MESON[] `(?x. P x /\ Q x) <=> ~(!x. P x ==> ~Q x)`] THEN + REWRITE_TAC[FORALL_SUBSET_UNION] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Intersection. *) +(* ------------------------------------------------------------------------- *) + +let INTER_ASSOC = prove + (`!(s:A->bool) t u. (s INTER t) INTER u = s INTER (t INTER u)`, + SET_TAC[]);; + +let INTER_IDEMPOT = prove + (`!s:A->bool. s INTER s = s`, + SET_TAC[]);; + +let INTER_COMM = prove + (`!(s:A->bool) t. s INTER t = t INTER s`, + SET_TAC[]);; + +let INTER_SUBSET = prove + (`(!s:A->bool. !t. (s INTER t) SUBSET s) /\ + (!s:A->bool. !t. (t INTER s) SUBSET s)`, + SET_TAC[]);; + +let SUBSET_INTER_ABSORPTION = prove + (`!s:A->bool. !t. s SUBSET t <=> (s INTER t = s)`, + SET_TAC[]);; + +let INTER_EMPTY = prove + (`(!s:A->bool. EMPTY INTER s = EMPTY) /\ + (!s:A->bool. s INTER EMPTY = EMPTY)`, + SET_TAC[]);; + +let INTER_UNIV = prove + (`(!s:A->bool. UNIV INTER s = s) /\ + (!s:A->bool. s INTER UNIV = s)`, + SET_TAC[]);; + +let SUBSET_INTER = prove + (`!s t u. s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Distributivity. *) +(* ------------------------------------------------------------------------- *) + +let UNION_OVER_INTER = prove + (`!s:A->bool. !t u. s INTER (t UNION u) = (s INTER t) UNION (s INTER u)`, + SET_TAC[]);; + +let INTER_OVER_UNION = prove + (`!s:A->bool. !t u. s UNION (t INTER u) = (s UNION t) INTER (s UNION u)`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Disjoint sets. *) +(* ------------------------------------------------------------------------- *) + +let IN_DISJOINT = prove + (`!s:A->bool. !t. DISJOINT s t <=> ~(?x. x IN s /\ x IN t)`, + SET_TAC[]);; + +let DISJOINT_SYM = prove + (`!s:A->bool. !t. DISJOINT s t <=> DISJOINT t s`, + SET_TAC[]);; + +let DISJOINT_EMPTY = prove + (`!s:A->bool. DISJOINT EMPTY s /\ DISJOINT s EMPTY`, + SET_TAC[]);; + +let DISJOINT_EMPTY_REFL = prove + (`!s:A->bool. (s = EMPTY) <=> (DISJOINT s s)`, + SET_TAC[]);; + +let DISJOINT_UNION = prove + (`!s:A->bool. !t u. DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Set difference. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_EMPTY = prove + (`!s:A->bool. s DIFF EMPTY = s`, + SET_TAC[]);; + +let EMPTY_DIFF = prove + (`!s:A->bool. EMPTY DIFF s = EMPTY`, + SET_TAC[]);; + +let DIFF_UNIV = prove + (`!s:A->bool. s DIFF UNIV = EMPTY`, + SET_TAC[]);; + +let DIFF_DIFF = prove + (`!s:A->bool. !t. (s DIFF t) DIFF t = s DIFF t`, + SET_TAC[]);; + +let DIFF_EQ_EMPTY = prove + (`!s:A->bool. s DIFF s = EMPTY`, + SET_TAC[]);; + +let SUBSET_DIFF = prove + (`!s t. (s DIFF t) SUBSET s`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Insertion and deletion. *) +(* ------------------------------------------------------------------------- *) + +let COMPONENT = prove + (`!x:A. !s. x IN (x INSERT s)`, + SET_TAC[]);; + +let DECOMPOSITION = prove + (`!s:A->bool. !x. x IN s <=> ?t. (s = x INSERT t) /\ ~(x IN t)`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[IN_INSERT] THEN EXISTS_TAC `s DELETE x:A` THEN + POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let SET_CASES = prove + (`!s:A->bool. (s = EMPTY) \/ ?x:A. ?t. (s = x INSERT t) /\ ~(x IN t)`, + MESON_TAC[MEMBER_NOT_EMPTY; DECOMPOSITION]);; + +let ABSORPTION = prove + (`!x:A. !s. x IN s <=> (x INSERT s = s)`, + SET_TAC[]);; + +let INSERT_INSERT = prove + (`!x:A. !s. x INSERT (x INSERT s) = x INSERT s`, + SET_TAC[]);; + +let INSERT_COMM = prove + (`!x:A. !y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)`, + SET_TAC[]);; + +let INSERT_UNIV = prove + (`!x:A. x INSERT UNIV = UNIV`, + SET_TAC[]);; + +let NOT_INSERT_EMPTY = prove + (`!x:A. !s. ~(x INSERT s = EMPTY)`, + SET_TAC[]);; + +let NOT_EMPTY_INSERT = prove + (`!x:A. !s. ~(EMPTY = x INSERT s)`, + SET_TAC[]);; + +let INSERT_UNION = prove + (`!x:A. !s t. (x INSERT s) UNION t = + if x IN t then s UNION t else x INSERT (s UNION t)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let INSERT_UNION_EQ = prove + (`!x:A. !s t. (x INSERT s) UNION t = x INSERT (s UNION t)`, + SET_TAC[]);; + +let INSERT_INTER = prove + (`!x:A. !s t. (x INSERT s) INTER t = + if x IN t then x INSERT (s INTER t) else s INTER t`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let DISJOINT_INSERT = prove + (`!(x:A) s t. DISJOINT (x INSERT s) t <=> (DISJOINT s t) /\ ~(x IN t)`, + SET_TAC[]);; + +let INSERT_SUBSET = prove + (`!x:A. !s t. (x INSERT s) SUBSET t <=> (x IN t /\ s SUBSET t)`, + SET_TAC[]);; + +let SUBSET_INSERT = prove + (`!x:A. !s. ~(x IN s) ==> !t. s SUBSET (x INSERT t) <=> s SUBSET t`, + SET_TAC[]);; + +let INSERT_DIFF = prove + (`!s t. !x:A. (x INSERT s) DIFF t = + if x IN t then s DIFF t else x INSERT (s DIFF t)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let INSERT_AC = prove + (`(x INSERT (y INSERT s) = y INSERT (x INSERT s)) /\ + (x INSERT (x INSERT s) = x INSERT s)`, + REWRITE_TAC[INSERT_COMM; INSERT_INSERT]);; + +let INTER_ACI = prove + (`(p INTER q = q INTER p) /\ + ((p INTER q) INTER r = p INTER q INTER r) /\ + (p INTER q INTER r = q INTER p INTER r) /\ + (p INTER p = p) /\ + (p INTER p INTER q = p INTER q)`, + SET_TAC[]);; + +let UNION_ACI = prove + (`(p UNION q = q UNION p) /\ + ((p UNION q) UNION r = p UNION q UNION r) /\ + (p UNION q UNION r = q UNION p UNION r) /\ + (p UNION p = p) /\ + (p UNION p UNION q = p UNION q)`, + SET_TAC[]);; + +let DELETE_NON_ELEMENT = prove + (`!x:A. !s. ~(x IN s) <=> (s DELETE x = s)`, + SET_TAC[]);; + +let IN_DELETE_EQ = prove + (`!s x. !x':A. + (x IN s <=> x' IN s) <=> (x IN (s DELETE x') <=> x' IN (s DELETE x))`, + SET_TAC[]);; + +let EMPTY_DELETE = prove + (`!x:A. EMPTY DELETE x = EMPTY`, + SET_TAC[]);; + +let DELETE_DELETE = prove + (`!x:A. !s. (s DELETE x) DELETE x = s DELETE x`, + SET_TAC[]);; + +let DELETE_COMM = prove + (`!x:A. !y. !s. (s DELETE x) DELETE y = (s DELETE y) DELETE x`, + SET_TAC[]);; + +let DELETE_SUBSET = prove + (`!x:A. !s. (s DELETE x) SUBSET s`, + SET_TAC[]);; + +let SUBSET_DELETE = prove + (`!x:A. !s t. s SUBSET (t DELETE x) <=> ~(x IN s) /\ (s SUBSET t)`, + SET_TAC[]);; + +let SUBSET_INSERT_DELETE = prove + (`!x:A. !s t. s SUBSET (x INSERT t) <=> ((s DELETE x) SUBSET t)`, + SET_TAC[]);; + +let DIFF_INSERT = prove + (`!s t. !x:A. s DIFF (x INSERT t) = (s DELETE x) DIFF t`, + SET_TAC[]);; + +let PSUBSET_INSERT_SUBSET = prove + (`!s t. s PSUBSET t <=> ?x:A. ~(x IN s) /\ (x INSERT s) SUBSET t`, + SET_TAC[]);; + +let PSUBSET_MEMBER = prove + (`!s:A->bool. !t. s PSUBSET t <=> (s SUBSET t /\ ?y. y IN t /\ ~(y IN s))`, + SET_TAC[]);; + +let DELETE_INSERT = prove + (`!x:A. !y s. + (x INSERT s) DELETE y = + if x = y then s DELETE y else x INSERT (s DELETE y)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + POP_ASSUM MP_TAC THEN SET_TAC[]);; + +let INSERT_DELETE = prove + (`!x:A. !s. x IN s ==> (x INSERT (s DELETE x) = s)`, + SET_TAC[]);; + +let DELETE_INTER = prove + (`!s t. !x:A. (s DELETE x) INTER t = (s INTER t) DELETE x`, + SET_TAC[]);; + +let DISJOINT_DELETE_SYM = prove + (`!s t. !x:A. DISJOINT (s DELETE x) t = DISJOINT (t DELETE x) s`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Multiple union. *) +(* ------------------------------------------------------------------------- *) + +let UNIONS_0 = prove + (`UNIONS {} = {}`, + SET_TAC[]);; + +let UNIONS_1 = prove + (`UNIONS {s} = s`, + SET_TAC[]);; + +let UNIONS_2 = prove + (`UNIONS {s,t} = s UNION t`, + SET_TAC[]);; + +let UNIONS_INSERT = prove + (`UNIONS (s INSERT u) = s UNION (UNIONS u)`, + SET_TAC[]);; + +let FORALL_IN_UNIONS = prove + (`!P s. (!x. x IN UNIONS s ==> P x) <=> !t x. t IN s /\ x IN t ==> P x`, + SET_TAC[]);; + +let EXISTS_IN_UNIONS = prove + (`!P s. (?x. x IN UNIONS s /\ P x) <=> (?t x. t IN s /\ x IN t /\ P x)`, + SET_TAC[]);; + +let EMPTY_UNIONS = prove + (`!s. (UNIONS s = {}) <=> !t. t IN s ==> t = {}`, + SET_TAC[]);; + +let INTER_UNIONS = prove + (`(!s t. UNIONS s INTER t = UNIONS {x INTER t | x IN s}) /\ + (!s t. t INTER UNIONS s = UNIONS {t INTER x | x IN s})`, + ONCE_REWRITE_TAC[EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_INTER] THEN + MESON_TAC[IN_INTER]);; + +let UNIONS_SUBSET = prove + (`!f t. UNIONS f SUBSET t <=> !s. s IN f ==> s SUBSET t`, + SET_TAC[]);; + +let SUBSET_UNIONS = prove + (`!f g. f SUBSET g ==> UNIONS f SUBSET UNIONS g`, + SET_TAC[]);; + +let UNIONS_UNION = prove + (`!s t. UNIONS(s UNION t) = (UNIONS s) UNION (UNIONS t)`, + SET_TAC[]);; + +let INTERS_UNION = prove + (`!s t. INTERS (s UNION t) = INTERS s INTER INTERS t`, + SET_TAC[]);; + +let UNIONS_MONO = prove + (`(!x. x IN s ==> ?y. y IN t /\ x SUBSET y) ==> UNIONS s SUBSET UNIONS t`, + SET_TAC[]);; + +let UNIONS_MONO_IMAGE = prove + (`(!x. x IN s ==> f x SUBSET g x) + ==> UNIONS(IMAGE f s) SUBSET UNIONS(IMAGE g s)`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Multiple intersection. *) +(* ------------------------------------------------------------------------- *) + +let INTERS_0 = prove + (`INTERS {} = (:A)`, + SET_TAC[]);; + +let INTERS_1 = prove + (`INTERS {s} = s`, + SET_TAC[]);; + +let INTERS_2 = prove + (`INTERS {s,t} = s INTER t`, + SET_TAC[]);; + +let INTERS_INSERT = prove + (`INTERS (s INSERT u) = s INTER (INTERS u)`, + SET_TAC[]);; + +let SUBSET_INTERS = prove + (`!s f. s SUBSET INTERS f <=> (!t. t IN f ==> s SUBSET t)`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Image. *) +(* ------------------------------------------------------------------------- *) + +let IMAGE_CLAUSES = prove + (`(IMAGE f {} = {}) /\ + (IMAGE f (x INSERT s) = (f x) INSERT (IMAGE f s))`, + REWRITE_TAC[IMAGE; IN_ELIM_THM; NOT_IN_EMPTY; IN_INSERT; EXTENSION] THEN + MESON_TAC[]);; + +let IMAGE_UNION = prove + (`!f s t. IMAGE f (s UNION t) = (IMAGE f s) UNION (IMAGE f t)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNION] THEN MESON_TAC[]);; + +let IMAGE_ID = prove + (`!s. IMAGE (\x. x) s = s`, + REWRITE_TAC[EXTENSION; IN_IMAGE; UNWIND_THM1]);; + +let IMAGE_I = prove + (`!s. IMAGE I s = s`, + REWRITE_TAC[I_DEF; IMAGE_ID]);; + +let IMAGE_o = prove + (`!f g s. IMAGE (f o g) s = IMAGE f (IMAGE g s)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; o_THM] THEN MESON_TAC[]);; + +let IMAGE_SUBSET = prove + (`!f s t. s SUBSET t ==> (IMAGE f s) SUBSET (IMAGE f t)`, + REWRITE_TAC[SUBSET; IN_IMAGE] THEN MESON_TAC[]);; + +let IMAGE_INTER_INJ = prove + (`!f s t. (!x y. (f(x) = f(y)) ==> (x = y)) + ==> (IMAGE f (s INTER t) = (IMAGE f s) INTER (IMAGE f t))`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_INTER] THEN MESON_TAC[]);; + +let IMAGE_DIFF_INJ = prove + (`!f s t. (!x y. (f(x) = f(y)) ==> (x = y)) + ==> (IMAGE f (s DIFF t) = (IMAGE f s) DIFF (IMAGE f t))`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DIFF] THEN MESON_TAC[]);; + +let IMAGE_DELETE_INJ = prove + (`!f s a. (!x. (f(x) = f(a)) ==> (x = a)) + ==> (IMAGE f (s DELETE a) = (IMAGE f s) DELETE (f a))`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_DELETE] THEN MESON_TAC[]);; + +let IMAGE_EQ_EMPTY = prove + (`!f s. (IMAGE f s = {}) <=> (s = {})`, + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_IMAGE] THEN MESON_TAC[]);; + +let FORALL_IN_IMAGE = prove + (`!f s. (!y. y IN IMAGE f s ==> P y) <=> (!x. x IN s ==> P(f x))`, + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; + +let EXISTS_IN_IMAGE = prove + (`!f s. (?y. y IN IMAGE f s /\ P y) <=> ?x. x IN s /\ P(f x)`, + REWRITE_TAC[IN_IMAGE] THEN MESON_TAC[]);; + +let SUBSET_IMAGE = prove + (`!f:A->B s t. s SUBSET (IMAGE f t) <=> ?u. u SUBSET t /\ (s = IMAGE f u)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC; MESON_TAC[IMAGE_SUBSET]] THEN + DISCH_TAC THEN EXISTS_TAC `{x | x IN t /\ (f:A->B) x IN s}` THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[EXTENSION; SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + MESON_TAC[]);; + +let FORALL_SUBSET_IMAGE = prove + (`!P f s. (!t. t SUBSET IMAGE f s ==> P t) <=> + (!t. t SUBSET s ==> P(IMAGE f t))`, + REWRITE_TAC[SUBSET_IMAGE] THEN MESON_TAC[]);; + +let EXISTS_SUBSET_IMAGE = prove + (`!P f s. + (?t. t SUBSET IMAGE f s /\ P t) <=> (?t. t SUBSET s /\ P (IMAGE f t))`, + REWRITE_TAC[SUBSET_IMAGE] THEN MESON_TAC[]);; + +let IMAGE_CONST = prove + (`!s c. IMAGE (\x. c) s = if s = {} then {} else {c}`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[IMAGE_CLAUSES] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_SING] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; + +let SIMPLE_IMAGE = prove + (`!f s. {f x | x IN s} = IMAGE f s`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[]);; + +let SIMPLE_IMAGE_GEN = prove + (`!f P. {f x | P x} = IMAGE f {x | P x}`, + SET_TAC[]);; + +let IMAGE_UNIONS = prove + (`!f s. IMAGE f (UNIONS s) = UNIONS (IMAGE (IMAGE f) s)`, + ONCE_REWRITE_TAC[EXTENSION] THEN REWRITE_TAC[IN_UNIONS; IN_IMAGE] THEN + REWRITE_TAC[LEFT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN + REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM2; IN_IMAGE] THEN + MESON_TAC[]);; + +let FUN_IN_IMAGE = prove + (`!f s x. x IN s ==> f(x) IN IMAGE f s`, + SET_TAC[]);; + +let SURJECTIVE_IMAGE_EQ = prove + (`!s t. (!y. y IN t ==> ?x. f x = y) /\ (!x. (f x) IN t <=> x IN s) + ==> IMAGE f s = t`, + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Misc lemmas. *) +(* ------------------------------------------------------------------------- *) + +let EMPTY_GSPEC = prove + (`{x | F} = {}`, + SET_TAC[]);; + +let UNIV_GSPEC = prove + (`{x | T} = UNIV`, + SET_TAC[]);; + +let SING_GSPEC = prove + (`(!a. {x | x = a} = {a}) /\ + (!a. {x | a = x} = {a})`, + SET_TAC[]);; + +let IN_ELIM_PAIR_THM = prove + (`!P a b. (a,b) IN {(x,y) | P x y} <=> P a b`, + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[PAIR_EQ]);; + +let SET_PAIR_THM = prove + (`!P. {p | P p} = {(a,b) | P(a,b)}`, + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_THM; IN_ELIM_PAIR_THM]);; + +let FORALL_IN_GSPEC = prove + (`(!P f. (!z. z IN {f x | P x} ==> Q z) <=> (!x. P x ==> Q(f x))) /\ + (!P f. (!z. z IN {f x y | P x y} ==> Q z) <=> + (!x y. P x y ==> Q(f x y))) /\ + (!P f. (!z. z IN {f w x y | P w x y} ==> Q z) <=> + (!w x y. P w x y ==> Q(f w x y))) /\ + (!P f. (!z. z IN {f v w x y | P v w x y} ==> Q z) <=> + (!v w x y. P v w x y ==> Q(f v w x y)))`, + SET_TAC[]);; + +let EXISTS_IN_GSPEC = prove + (`(!P f. (?z. z IN {f x | P x} /\ Q z) <=> (?x. P x /\ Q(f x))) /\ + (!P f. (?z. z IN {f x y | P x y} /\ Q z) <=> + (?x y. P x y /\ Q(f x y))) /\ + (!P f. (?z. z IN {f w x y | P w x y} /\ Q z) <=> + (?w x y. P w x y /\ Q(f w x y))) /\ + (!P f. (?z. z IN {f v w x y | P v w x y} /\ Q z) <=> + (?v w x y. P v w x y /\ Q(f v w x y)))`, + SET_TAC[]);; + +let SET_PROVE_CASES = prove + (`!P:(A->bool)->bool. + P {} /\ (!a s. ~(a IN s) ==> P(a INSERT s)) + ==> !s. P s`, + MESON_TAC[SET_CASES]);; + +let UNIONS_IMAGE = prove + (`!f s. UNIONS (IMAGE f s) = {y | ?x. x IN s /\ y IN f x}`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INTERS_IMAGE = prove + (`!f s. INTERS (IMAGE f s) = {y | !x. x IN s ==> y IN f x}`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTERS; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]);; + +let UNIONS_GSPEC = prove + (`(!P f. UNIONS {f x | P x} = {a | ?x. P x /\ a IN (f x)}) /\ + (!P f. UNIONS {f x y | P x y} = {a | ?x y. P x y /\ a IN (f x y)}) /\ + (!P f. UNIONS {f x y z | P x y z} = + {a | ?x y z. P x y z /\ a IN (f x y z)})`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN MESON_TAC[]);; + +let INTERS_GSPEC = prove + (`(!P f. INTERS {f x | P x} = {a | !x. P x ==> a IN (f x)}) /\ + (!P f. INTERS {f x y | P x y} = {a | !x y. P x y ==> a IN (f x y)}) /\ + (!P f. INTERS {f x y z | P x y z} = + {a | !x y z. P x y z ==> a IN (f x y z)})`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_INTERS; IN_ELIM_THM] THEN MESON_TAC[]);; + +let DIFF_INTERS = prove + (`!u s. u DIFF INTERS s = UNIONS {u DIFF t | t IN s}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]);; + +let INTERS_UNIONS = prove + (`!s. INTERS s = UNIV DIFF (UNIONS {UNIV DIFF t | t IN s})`, + REWRITE_TAC[GSYM DIFF_INTERS] THEN SET_TAC[]);; + +let UNIONS_INTERS = prove + (`!s. UNIONS s = UNIV DIFF (INTERS {UNIV DIFF t | t IN s})`, + GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[IN_UNIONS; IN_UNIV; IN_DIFF; INTERS_GSPEC; IN_ELIM_THM] THEN + MESON_TAC[]);; + +let UNIONS_DIFF = prove + (`!s t. UNIONS s DIFF t = UNIONS {x DIFF t | x IN s}`, + REWRITE_TAC[UNIONS_GSPEC] THEN SET_TAC[]);; + +let DIFF_UNIONS = prove + (`!u s. u DIFF UNIONS s = u INTER INTERS {u DIFF t | t IN s}`, + REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]);; + +let DIFF_UNIONS_NONEMPTY = prove + (`!u s. ~(s = {}) ==> u DIFF UNIONS s = INTERS {u DIFF t | t IN s}`, + REWRITE_TAC[INTERS_GSPEC] THEN SET_TAC[]);; + +let INTERS_OVER_UNIONS = prove + (`!f:A->(B->bool)->bool s. + INTERS { UNIONS(f x) | x IN s} = + UNIONS { INTERS {g x | x IN s} |g| !x. x IN s ==> g x IN f x}`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [EXTENSION] THEN + REWRITE_TAC[SIMPLE_IMAGE; INTERS_IMAGE; UNIONS_IMAGE; UNIONS_GSPEC] THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN + X_GEN_TAC `b:B` THEN REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Stronger form of induction is sometimes handy. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_INDUCT_STRONG = prove + (`!P:(A->bool)->bool. + P {} /\ (!x s. P s /\ ~(x IN s) /\ FINITE s ==> P(x INSERT s)) + ==> !s. FINITE s ==> P s`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!s:A->bool. FINITE s ==> FINITE s /\ P s` MP_TAC THENL + [ALL_TAC; MESON_TAC[]] THEN + MATCH_MP_TAC FINITE_INDUCT THEN ASM_SIMP_TAC[FINITE_RULES] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_CASES_TAC `x:A IN s` THENL + [SUBGOAL_THEN `x:A INSERT s = s` (fun th -> ASM_REWRITE_TAC[th]) THEN + UNDISCH_TAC `x:A IN s` THEN SET_TAC[]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Useful general properties of functions. *) +(* ------------------------------------------------------------------------- *) + +let INJECTIVE_ON_ALT = prove + (`!P f. (!x y. P x /\ P y /\ f x = f y ==> x = y) <=> + (!x y. P x /\ P y ==> (f x = f y <=> x = y))`, + MESON_TAC[]);; + +let INJECTIVE_ALT = prove + (`!f. (!x y. f x = f y ==> x = y) <=> (!x y. f x = f y <=> x = y)`, + MESON_TAC[]);; + +let SURJECTIVE_ON_RIGHT_INVERSE = prove + (`!f t. (!y. y IN t ==> ?x. x IN s /\ (f(x) = y)) <=> + (?g. !y. y IN t ==> g(y) IN s /\ (f(g(y)) = y))`, + REWRITE_TAC[RIGHT_IMP_EXISTS_THM; SKOLEM_THM]);; + +let INJECTIVE_ON_LEFT_INVERSE = prove + (`!f s. (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)) <=> + (?g. !x. x IN s ==> (g(f(x)) = x))`, + let lemma = MESON[] + `(!x. x IN s ==> (g(f(x)) = x)) <=> + (!y x. x IN s /\ (y = f x) ==> (g y = x))` in + REWRITE_TAC[lemma; GSYM SKOLEM_THM] THEN MESON_TAC[]);; + +let BIJECTIVE_ON_LEFT_RIGHT_INVERSE = prove + (`!f s t. + (!x. x IN s ==> f(x) IN t) + ==> ((!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ + (!y. y IN t ==> ?x. x IN s /\ f x = y) <=> + ?g. (!y. y IN t ==> g(y) IN s) /\ + (!y. y IN t ==> (f(g(y)) = y)) /\ + (!x. x IN s ==> (g(f(x)) = x)))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[INJECTIVE_ON_LEFT_INVERSE; SURJECTIVE_ON_RIGHT_INVERSE] THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN AP_TERM_TAC THEN ABS_TAC THEN + EQ_TAC THEN ASM_MESON_TAC[]);; + +let SURJECTIVE_RIGHT_INVERSE = prove + (`(!y. ?x. f(x) = y) <=> (?g. !y. f(g(y)) = y)`, + MESON_TAC[SURJECTIVE_ON_RIGHT_INVERSE; IN_UNIV]);; + +let INJECTIVE_LEFT_INVERSE = prove + (`(!x y. (f x = f y) ==> (x = y)) <=> (?g. !x. g(f(x)) = x)`, + let th = REWRITE_RULE[IN_UNIV] + (ISPECL [`f:A->B`; `UNIV:A->bool`] INJECTIVE_ON_LEFT_INVERSE) in + REWRITE_TAC[th]);; + +let BIJECTIVE_LEFT_RIGHT_INVERSE = prove + (`!f:A->B. + (!x y. f(x) = f(y) ==> x = y) /\ (!y. ?x. f x = y) <=> + ?g. (!y. f(g(y)) = y) /\ (!x. g(f(x)) = x)`, + GEN_TAC THEN + MP_TAC(ISPECL [`f:A->B`; `(:A)`; `(:B)`] BIJECTIVE_ON_LEFT_RIGHT_INVERSE) THEN + REWRITE_TAC[IN_UNIV]);; + +let FUNCTION_FACTORS_LEFT_GEN = prove + (`!P f g. (!x y. P x /\ P y /\ g x = g y ==> f x = f y) <=> + (?h. !x. P x ==> f(x) = h(g x))`, + ONCE_REWRITE_TAC[MESON[] + `(!x. P x ==> f(x) = g(k x)) <=> (!y x. P x /\ y = k x ==> f x = g y)`] THEN + REWRITE_TAC[GSYM SKOLEM_THM] THEN MESON_TAC[]);; + +let FUNCTION_FACTORS_LEFT = prove + (`!f g. (!x y. (g x = g y) ==> (f x = f y)) <=> ?h. f = h o g`, + REWRITE_TAC[FUN_EQ_THM; o_THM; + GSYM(REWRITE_RULE[] (ISPEC `\x. T` FUNCTION_FACTORS_LEFT_GEN))]);; + +let FUNCTION_FACTORS_RIGHT_GEN = prove + (`!P f g. (!x. P x ==> ?y. g(y) = f(x)) <=> + (?h. !x. P x ==> f(x) = g(h x))`, + REWRITE_TAC[GSYM SKOLEM_THM] THEN MESON_TAC[]);; + +let FUNCTION_FACTORS_RIGHT = prove + (`!f g. (!x. ?y. g(y) = f(x)) <=> ?h. f = g o h`, + REWRITE_TAC[FUN_EQ_THM; o_THM; GSYM SKOLEM_THM] THEN MESON_TAC[]);; + +let SURJECTIVE_FORALL_THM = prove + (`!f:A->B. (!y. ?x. f x = y) <=> (!P. (!x. P(f x)) <=> (!y. P y))`, + GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN MESON_TAC[]);; + +let SURJECTIVE_EXISTS_THM = prove + (`!f:A->B. (!y. ?x. f x = y) <=> (!P. (?x. P(f x)) <=> (?y. P y))`, + GEN_TAC THEN EQ_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `\y:B. !x:A. ~(f x = y)`) THEN MESON_TAC[]);; + +let SURJECTIVE_IMAGE_THM = prove + (`!f:A->B. (!y. ?x. f x = y) <=> (!P. IMAGE f {x | P(f x)} = {x | P x})`, + GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + EQ_TAC THENL [ALL_TAC; DISCH_THEN(MP_TAC o SPEC `\y:B. T`)] THEN + MESON_TAC[]);; + +let IMAGE_INJECTIVE_IMAGE_OF_SUBSET = prove + (`!f:A->B s. + ?t. t SUBSET s /\ + IMAGE f s = IMAGE f t /\ + (!x y. x IN t /\ y IN t /\ f x = f y ==> x = y)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `?g. !y. y IN IMAGE (f:A->B) s ==> g(y) IN s /\ f(g(y)) = y` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM SURJECTIVE_ON_RIGHT_INVERSE] THEN SET_TAC[]; + EXISTS_TAC `IMAGE (g:B->A) (IMAGE (f:A->B) s)` THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Basic combining theorems for finite sets. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_EMPTY = prove + (`FINITE {}`, + REWRITE_TAC[FINITE_RULES]);; + +let FINITE_SUBSET = prove + (`!(s:A->bool) t. FINITE t /\ s SUBSET t ==> FINITE s`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN + REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL + [MESON_TAC[SUBSET_EMPTY; FINITE_RULES]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN X_GEN_TAC `u:A->bool` THEN DISCH_TAC THEN + X_GEN_TAC `t:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `FINITE((x:A) INSERT (t DELETE x))` ASSUME_TAC THENL + [MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `t SUBSET (x:A INSERT u)` THEN SET_TAC[]; + ASM_CASES_TAC `x:A IN t` THENL + [SUBGOAL_THEN `x:A INSERT (t DELETE x) = t` SUBST_ALL_TAC THENL + [UNDISCH_TAC `x:A IN t` THEN SET_TAC[]; ASM_REWRITE_TAC[]]; + FIRST_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `t SUBSET x:A INSERT u` THEN + UNDISCH_TAC `~(x:A IN t)` THEN SET_TAC[]]]);; + +let FINITE_RESTRICT = prove + (`!s:A->bool P. FINITE s ==> FINITE {x | x IN s /\ P x}`, + MESON_TAC[SUBSET_RESTRICT; FINITE_SUBSET]);; + +let FINITE_UNION_IMP = prove + (`!(s:A->bool) t. FINITE s /\ FINITE t ==> FINITE (s UNION t)`, + REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT THEN REWRITE_TAC[UNION_EMPTY] THEN + SUBGOAL_THEN `!x s t. (x:A INSERT s) UNION t = x INSERT (s UNION t)` + (fun th -> REWRITE_TAC[th]) THENL + [SET_TAC[]; + MESON_TAC[FINITE_RULES]]);; + +let FINITE_UNION = prove + (`!(s:A->bool) t. FINITE(s UNION t) <=> FINITE(s) /\ FINITE(t)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `(s:A->bool) UNION t` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_ACCEPT_TAC FINITE_UNION_IMP]);; + +let FINITE_INTER = prove + (`!(s:A->bool) t. FINITE s \/ FINITE t ==> FINITE (s INTER t)`, + MESON_TAC[INTER_SUBSET; FINITE_SUBSET]);; + +let FINITE_INSERT = prove + (`!(s:A->bool) x. FINITE (x INSERT s) <=> FINITE s`, + REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `x:A INSERT s` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC(CONJUNCT2 FINITE_RULES) THEN + ASM_REWRITE_TAC[]]);; + +let FINITE_SING = prove + (`!a. FINITE {a}`, + REWRITE_TAC[FINITE_INSERT; FINITE_RULES]);; + +let FINITE_DELETE_IMP = prove + (`!(s:A->bool) x. FINITE s ==> FINITE (s DELETE x)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +let FINITE_DELETE = prove + (`!(s:A->bool) x. FINITE (s DELETE x) <=> FINITE s`, + REPEAT GEN_TAC THEN EQ_TAC THEN REWRITE_TAC[FINITE_DELETE_IMP] THEN + ASM_CASES_TAC `x:A IN s` THENL + [SUBGOAL_THEN `s = x INSERT (s DELETE x:A)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[FINITE_INSERT] THEN POP_ASSUM MP_TAC THEN SET_TAC[]; + SUBGOAL_THEN `s DELETE x:A = s` (fun th -> REWRITE_TAC[th]) THEN + POP_ASSUM MP_TAC THEN SET_TAC[]]);; + +let FINITE_FINITE_UNIONS = prove + (`!s. FINITE(s) ==> (FINITE(UNIONS s) <=> (!t. t IN s ==> FINITE(t)))`, + MATCH_MP_TAC FINITE_INDUCT THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; UNIONS_0; UNIONS_INSERT] THEN + REWRITE_TAC[FINITE_UNION; FINITE_RULES] THEN MESON_TAC[]);; + +let FINITE_IMAGE_EXPAND = prove + (`!(f:A->B) s. FINITE s ==> FINITE {y | ?x. x IN s /\ (y = f x)}`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT THEN + REWRITE_TAC[NOT_IN_EMPTY; REWRITE_RULE[] EMPTY_GSPEC; FINITE_RULES] THEN + REPEAT GEN_TAC THEN + SUBGOAL_THEN `{y | ?z. z IN (x INSERT s) /\ (y = (f:A->B) z)} = + {y | ?z. z IN s /\ (y = f z)} UNION {(f x)}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT; IN_UNION; NOT_IN_EMPTY] THEN + MESON_TAC[]; + REWRITE_TAC[FINITE_UNION; FINITE_INSERT; FINITE_RULES]]);; + +let FINITE_IMAGE = prove + (`!(f:A->B) s. FINITE s ==> FINITE (IMAGE f s)`, + REWRITE_TAC[IMAGE; FINITE_IMAGE_EXPAND]);; + +let FINITE_IMAGE_INJ_GENERAL = prove + (`!(f:A->B) A s. + (!x y. x IN s /\ y IN s /\ f(x) = f(y) ==> x = y) /\ + FINITE A + ==> FINITE {x | x IN s /\ f(x) IN A}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [INJECTIVE_ON_LEFT_INVERSE]) THEN + DISCH_THEN(X_CHOOSE_TAC `g:B->A`) THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `IMAGE (g:B->A) A` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN ASM SET_TAC[]);; + +let FINITE_FINITE_PREIMAGE_GENERAL = prove + (`!f:A->B s t. + FINITE t /\ + (!y. y IN t ==> FINITE {x | x IN s /\ f(x) = y}) + ==> FINITE {x | x IN s /\ f(x) IN t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN s /\ (f:A->B)(x) IN t} = + UNIONS (IMAGE (\a. {x | x IN s /\ f x = a}) t)` + SUBST1_TAC THENL + [GEN_REWRITE_TAC I [EXTENSION] THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIONS] THEN + REWRITE_TAC[EXISTS_IN_IMAGE] THEN SET_TAC[]; + ASM_SIMP_TAC[FINITE_FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE]]);; + +let FINITE_FINITE_PREIMAGE = prove + (`!f:A->B t. + FINITE t /\ + (!y. y IN t ==> FINITE {x | f(x) = y}) + ==> FINITE {x | f(x) IN t}`, + REPEAT GEN_TAC THEN MP_TAC + (ISPECL [`f:A->B`; `(:A)`; `t:B->bool`] FINITE_FINITE_PREIMAGE_GENERAL) THEN + REWRITE_TAC[IN_UNIV]);; + +let FINITE_IMAGE_INJ_EQ = prove + (`!(f:A->B) s. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) + ==> (FINITE(IMAGE f s) <=> FINITE s)`, + REPEAT STRIP_TAC THEN EQ_TAC THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(MP_TAC o MATCH_MP FINITE_IMAGE_INJ_GENERAL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN SET_TAC[]);; + +let FINITE_IMAGE_INJ = prove + (`!(f:A->B) A. (!x y. (f(x) = f(y)) ==> (x = y)) /\ + FINITE A ==> FINITE {x | f(x) IN A}`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`f:A->B`; `A:B->bool`; `UNIV:A->bool`] + FINITE_IMAGE_INJ_GENERAL) THEN REWRITE_TAC[IN_UNIV]);; + +let INFINITE_IMAGE_INJ = prove + (`!f:A->B. (!x y. (f x = f y) ==> (x = y)) + ==> !s. INFINITE s ==> INFINITE(IMAGE f s)`, + GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN + REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{x | f(x) IN IMAGE (f:A->B) s}` THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IMAGE] THEN MESON_TAC[]]);; + +let INFINITE_NONEMPTY = prove + (`!s. INFINITE(s) ==> ~(s = EMPTY)`, + MESON_TAC[INFINITE; FINITE_RULES]);; + +let INFINITE_DIFF_FINITE = prove + (`!s:A->bool t. INFINITE(s) /\ FINITE(t) ==> INFINITE(s DIFF t)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC(TAUT `(b /\ ~c ==> ~a) ==> a /\ b ==> c`) THEN + REWRITE_TAC[INFINITE] THEN STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `(t:A->bool) UNION (s DIFF t)` THEN + ASM_REWRITE_TAC[FINITE_UNION] THEN SET_TAC[]);; + +let FINITE_SUBSET_IMAGE = prove + (`!f:A->B s t. + FINITE(t) /\ t SUBSET (IMAGE f s) <=> + ?s'. FINITE s' /\ s' SUBSET s /\ (t = IMAGE f s')`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [ALL_TAC; ASM_MESON_TAC[FINITE_IMAGE; IMAGE_SUBSET]] THEN + STRIP_TAC THEN + EXISTS_TAC `IMAGE (\y. @x. x IN s /\ ((f:A->B)(x) = y)) t` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[EXTENSION; SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET; IN_IMAGE]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN X_GEN_TAC `y:B` THEN + REWRITE_TAC[RIGHT_AND_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_EXISTS_THM] THEN ONCE_REWRITE_TAC[CONJ_SYM] THEN + REWRITE_TAC[UNWIND_THM2; GSYM CONJ_ASSOC] THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE]);; + +let EXISTS_FINITE_SUBSET_IMAGE = prove + (`!P f s. + (?t. FINITE t /\ t SUBSET IMAGE f s /\ P t) <=> + (?t. FINITE t /\ t SUBSET s /\ P (IMAGE f t))`, + REWRITE_TAC[FINITE_SUBSET_IMAGE; CONJ_ASSOC] THEN MESON_TAC[]);; + +let FORALL_FINITE_SUBSET_IMAGE = prove + (`!P f s. (!t. FINITE t /\ t SUBSET IMAGE f s ==> P t) <=> + (!t. FINITE t /\ t SUBSET s ==> P(IMAGE f t))`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[MESON[] `(!x. P x) <=> ~(?x. ~P x)`] THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC; EXISTS_FINITE_SUBSET_IMAGE]);; + +let FINITE_SUBSET_IMAGE_IMP = prove + (`!f:A->B s t. + FINITE(t) /\ t SUBSET (IMAGE f s) + ==> ?s'. FINITE s' /\ s' SUBSET s /\ t SUBSET (IMAGE f s')`, + MESON_TAC[SUBSET_REFL; FINITE_SUBSET_IMAGE]);; + +let FINITE_DIFF = prove + (`!s t. FINITE s ==> FINITE(s DIFF t)`, + MESON_TAC[FINITE_SUBSET; SUBSET_DIFF]);; + +let INFINITE_SUPERSET = prove + (`!s t. INFINITE s /\ s SUBSET t ==> INFINITE t`, + REWRITE_TAC[INFINITE] THEN MESON_TAC[FINITE_SUBSET]);; + +let FINITE_TRANSITIVITY_CHAIN = prove + (`!R s:A->bool. + FINITE s /\ + (!x. ~(R x x)) /\ + (!x y z. R x y /\ R y z ==> R x z) /\ + (!x. x IN s ==> ?y. y IN s /\ R x y) + ==> s = {}`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY] THEN + SET_TAC[]);; + +let UNIONS_MAXIMAL_SETS = prove + (`!f. FINITE f + ==> UNIONS {t:A->bool | t IN f /\ !u. u IN f ==> ~(t PSUBSET u)} = + UNIONS f`, + SIMP_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET_UNIONS; SUBSET_RESTRICT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC UNIONS_MONO THEN + X_GEN_TAC `s:A->bool` THEN DISCH_TAC THEN REWRITE_TAC[EXISTS_IN_GSPEC] THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~ p`] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\t u:A->bool. s SUBSET t /\ t PSUBSET u`; + `{t:A->bool | t IN f /\ s SUBSET t}`]FINITE_TRANSITIVITY_CHAIN) THEN + ASM_SIMP_TAC[NOT_IMP; FINITE_RESTRICT; FORALL_IN_GSPEC; EXISTS_IN_GSPEC] THEN + REPEAT CONJ_TAC THENL [SET_TAC[]; SET_TAC[]; ALL_TAC; ASM SET_TAC[]] THEN + ASM_MESON_TAC[PSUBSET_TRANS; SUBSET_PSUBSET_TRANS; PSUBSET]);; + +(* ------------------------------------------------------------------------- *) +(* Recursion over finite sets; based on Ching-Tsun's code (archive 713). *) +(* ------------------------------------------------------------------------- *) + +let FINREC = new_recursive_definition num_RECURSION + `(FINREC (f:A->B->B) b s a 0 <=> (s = {}) /\ (a = b)) /\ + (FINREC (f:A->B->B) b s a (SUC n) <=> + ?x c. x IN s /\ + FINREC f b (s DELETE x) c n /\ + (a = f x c))`;; + +let FINREC_1_LEMMA = prove + (`!f b s a. FINREC f b s a (SUC 0) <=> ?x. (s = {x}) /\ (a = f x b)`, + REWRITE_TAC[FINREC] THEN + REPEAT GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN SET_TAC[]);; + +let FINREC_SUC_LEMMA = prove + (`!(f:A->B->B) b. + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) + ==> !n s z. + FINREC f b s z (SUC n) + ==> !x. x IN s ==> ?w. FINREC f b (s DELETE x) w n /\ + (z = f x w)`, + let lem = prove(`s DELETE (x:A) DELETE y = s DELETE y DELETE x`,SET_TAC[]) in + REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[FINREC_1_LEMMA] THEN REWRITE_TAC[FINREC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + DISCH_THEN SUBST1_TAC THEN EXISTS_TAC `b:B` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [FINREC] THEN + DISCH_THEN(X_CHOOSE_THEN `y:A` MP_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `c:B` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THENL + [EXISTS_TAC `c:B` THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `FINREC (f:A->B->B) b (s DELETE y) c (SUC n)` THEN + DISCH_THEN(ANTE_RES_THEN (MP_TAC o SPEC `x:A`)) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN + DISCH_THEN(X_CHOOSE_THEN `v:B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(f:A->B->B) y v` THEN ASM_REWRITE_TAC[FINREC] THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`y:A`; `v:B`] THEN + ONCE_REWRITE_TAC[lem] THEN ASM_REWRITE_TAC[IN_DELETE]; + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]]);; + +let FINREC_UNIQUE_LEMMA = prove + (`!(f:A->B->B) b. + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) + ==> !n1 n2 s a1 a2. + FINREC f b s a1 n1 /\ FINREC f b s a2 n2 + ==> (a1 = a2) /\ (n1 = n2)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + INDUCT_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[FINREC] THEN MESON_TAC[NOT_IN_EMPTY]; + REWRITE_TAC[FINREC] THEN MESON_TAC[NOT_IN_EMPTY]; + REWRITE_TAC[FINREC] THEN MESON_TAC[NOT_IN_EMPTY]; + IMP_RES_THEN ASSUME_TAC FINREC_SUC_LEMMA THEN REPEAT GEN_TAC THEN + DISCH_THEN(fun th -> MP_TAC(CONJUNCT1 th) THEN MP_TAC th) THEN + DISCH_THEN(CONJUNCTS_THEN (ANTE_RES_THEN ASSUME_TAC)) THEN + REWRITE_TAC[FINREC] THEN STRIP_TAC THEN ASM_MESON_TAC[]]);; + +let FINREC_EXISTS_LEMMA = prove + (`!(f:A->B->B) b s. FINITE s ==> ?a n. FINREC f b s a n`, + let lem = prove(`~(x IN s ) ==> ((x:A INSERT s) DELETE x = s)`,SET_TAC[]) in + GEN_TAC THEN GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REPEAT STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`b:B`; `0`] THEN REWRITE_TAC[FINREC]; + MAP_EVERY EXISTS_TAC [`(f:A->B->B) x a`; `SUC n`] THEN + REWRITE_TAC[FINREC] THEN MAP_EVERY EXISTS_TAC [`x:A`; `a:B`] THEN + FIRST_ASSUM(fun th -> ASM_REWRITE_TAC[MATCH_MP lem th; IN_INSERT])]);; + +let FINREC_FUN_LEMMA = prove + (`!P (R:A->B->C->bool). + (!s. P s ==> ?a n. R s a n) /\ + (!n1 n2 s a1 a2. R s a1 n1 /\ R s a2 n2 ==> (a1 = a2) /\ (n1 = n2)) + ==> ?f. !s a. P s ==> ((?n. R s a n) <=> (f s = a))`, + REPEAT STRIP_TAC THEN EXISTS_TAC `\s:A. @a:B. ?n:C. R s a n` THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN ASM_MESON_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN + ASM_MESON_TAC[]]);; + +let FINREC_FUN = prove + (`!(f:A->B->B) b. + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) + ==> ?g. (g {} = b) /\ + !s x. FINITE s /\ x IN s + ==> (g s = f x (g (s DELETE x)))`, + REPEAT STRIP_TAC THEN IMP_RES_THEN MP_TAC FINREC_UNIQUE_LEMMA THEN + DISCH_THEN(MP_TAC o SPEC `b:B`) THEN DISCH_THEN + (MP_TAC o CONJ (SPECL [`f:A->B->B`; `b:B`] FINREC_EXISTS_LEMMA)) THEN + DISCH_THEN(MP_TAC o MATCH_MP FINREC_FUN_LEMMA) THEN + DISCH_THEN(X_CHOOSE_TAC `g:(A->bool)->B`) THEN + EXISTS_TAC `g:(A->bool)->B` THEN CONJ_TAC THENL + [SUBGOAL_THEN `FINITE(EMPTY:A->bool)` + (ANTE_RES_THEN (fun th -> GEN_REWRITE_TAC I [GSYM th])) THENL + [REWRITE_TAC[FINITE_RULES]; + EXISTS_TAC `0` THEN REWRITE_TAC[FINREC]]; + REPEAT STRIP_TAC THEN + ANTE_RES_THEN MP_TAC (ASSUME `FINITE(s:A->bool)`) THEN + DISCH_THEN(ASSUME_TAC o GSYM) THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o SPEC `(g:(A->bool)->B) s`) THEN + REWRITE_TAC[] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + INDUCT_TAC THENL + [ASM_REWRITE_TAC[FINREC] THEN DISCH_TAC THEN UNDISCH_TAC `x:A IN s` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY]; + IMP_RES_THEN ASSUME_TAC FINREC_SUC_LEMMA THEN + DISCH_THEN(ANTE_RES_THEN (MP_TAC o SPEC `x:A`)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `w:B` (CONJUNCTS_THEN ASSUME_TAC)) THEN + SUBGOAL_THEN `(g (s DELETE x:A) = w:B)` SUBST1_TAC THENL + [SUBGOAL_THEN `FINITE(s DELETE x:A)` MP_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `s:A->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + DISCH_THEN(ANTE_RES_THEN (MP_TAC o GSYM)) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]]]]);; + +let SET_RECURSION_LEMMA = prove + (`!(f:A->B->B) b. + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) + ==> ?g. (g {} = b) /\ + !x s. FINITE s + ==> (g (x INSERT s) = + if x IN s then g s else f x (g s))`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `b:B` o MATCH_MP FINREC_FUN) THEN + DISCH_THEN(X_CHOOSE_THEN `g:(A->bool)->B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `g:(A->bool)->B` THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[GSYM ABSORPTION] THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `FINITE(x:A INSERT s) /\ x IN (x INSERT s)` MP_TAC THENL + [REWRITE_TAC[IN_INSERT] THEN ASM_MESON_TAC[FINITE_RULES]; + DISCH_THEN(ANTE_RES_THEN SUBST1_TAC) THEN + REPEAT AP_TERM_TAC THEN UNDISCH_TAC `~(x:A IN s)` THEN SET_TAC[]]]);; + +let ITSET = new_definition + `ITSET f s b = + (@g. (g {} = b) /\ + !x s. FINITE s + ==> (g (x INSERT s) = if x IN s then g s else f x (g s))) + s`;; + +let FINITE_RECURSION = prove + (`!(f:A->B->B) b. + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) + ==> (ITSET f {} b = b) /\ + !x s. FINITE s + ==> (ITSET f (x INSERT s) b = + if x IN s then ITSET f s b + else f x (ITSET f s b))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[ITSET] THEN + CONV_TAC SELECT_CONV THEN MATCH_MP_TAC SET_RECURSION_LEMMA THEN + ASM_REWRITE_TAC[]);; + +let FINITE_RECURSION_DELETE = prove + (`!(f:A->B->B) b. + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) + ==> (ITSET f {} b = b) /\ + !x s. FINITE s + ==> (ITSET f s b = + if x IN s then f x (ITSET f (s DELETE x) b) + else ITSET f (s DELETE x) b)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FINITE_RECURSION) THEN + DISCH_THEN(STRIP_ASSUME_TAC o SPEC `b:B`) THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN ASM_CASES_TAC `x:A IN s` THEN ASM_REWRITE_TAC[] THENL + [DISCH_THEN(MP_TAC o MATCH_MP FINITE_DELETE_IMP) THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC o SPEC `x:A`) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + REWRITE_TAC[IN_DELETE] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN UNDISCH_TAC `x:A IN s` THEN SET_TAC[]; + DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `~(x:A IN s)` THEN SET_TAC[]]);; + +let ITSET_EQ = prove + (`!s f g b. FINITE(s) /\ (!x. x IN s ==> (f x = g x)) /\ + (!x y s. ~(x = y) ==> (f x (f y s) = f y (f x s))) /\ + (!x y s. ~(x = y) ==> (g x (g y s) = g y (g x s))) + ==> (ITSET f s b = ITSET g s b)`, + ONCE_REWRITE_TAC[IMP_CONJ] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[FINITE_RECURSION; NOT_IN_EMPTY; IN_INSERT] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[RIGHT_IMP_FORALL_THM]) THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality. *) +(* ------------------------------------------------------------------------- *) + +let CARD = new_definition + `CARD s = ITSET (\x n. SUC n) s 0`;; + +let CARD_CLAUSES = prove + (`(CARD ({}:A->bool) = 0) /\ + (!(x:A) s. FINITE s ==> + (CARD (x INSERT s) = + if x IN s then CARD s else SUC(CARD s)))`, + MP_TAC(ISPECL [`\(x:A) n. SUC n`; `0`] FINITE_RECURSION) THEN + REWRITE_TAC[CARD]);; + +let CARD_UNION = prove + (`!(s:A->bool) t. FINITE(s) /\ FINITE(t) /\ (s INTER t = EMPTY) + ==> (CARD (s UNION t) = CARD s + CARD t)`, + REWRITE_TAC[TAUT `a /\ b /\ c ==> d <=> a ==> b /\ c ==> d`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[UNION_EMPTY; CARD_CLAUSES; INTER_EMPTY; ADD_CLAUSES] THEN + X_GEN_TAC `x:A` THEN X_GEN_TAC `s:A->bool` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(x:A INSERT s) UNION t = x INSERT (s UNION t)` + SUBST1_TAC THENL [SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `FINITE ((s:A->bool) UNION t) /\ FINITE s` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC FINITE_UNION_IMP THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`x:A`; `s:A->bool`] (CONJUNCT2 CARD_CLAUSES)) THEN + MP_TAC(ISPECL [`x:A`; `s:A->bool UNION t`] (CONJUNCT2 CARD_CLAUSES)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(x:A IN (s UNION t))` ASSUME_TAC THENL + [ASM_REWRITE_TAC[IN_UNION] THEN + UNDISCH_TAC `(x:A INSERT s) INTER t = EMPTY` THEN + REWRITE_TAC[EXTENSION; IN_INSERT; IN_INTER; NOT_IN_EMPTY] THEN + MESON_TAC[]; + ASM_REWRITE_TAC[SUC_INJ; ADD_CLAUSES] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `x:A INSERT s INTER t = EMPTY` THEN SET_TAC[]]);; + +let CARD_DELETE = prove + (`!x:A s. FINITE(s) + ==> (CARD(s DELETE x) = if x IN s then CARD(s) - 1 else CARD(s))`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [SUBGOAL_THEN `s = x:A INSERT (s DELETE x)` + (fun th -> GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [th]) + THENL [UNDISCH_TAC `x:A IN s` THEN SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_DELETE; IN_DELETE; SUC_SUB1]; + AP_TERM_TAC THEN UNDISCH_TAC `~(x:A IN s)` THEN SET_TAC[]]);; + +let CARD_UNION_EQ = prove + (`!s t u. FINITE u /\ (s INTER t = {}) /\ (s UNION t = u) + ==> (CARD s + CARD t = CARD u)`, + MESON_TAC[CARD_UNION; FINITE_SUBSET; SUBSET_UNION]);; + +let CARD_DIFF = prove + (`!s t. FINITE s /\ t SUBSET s ==> CARD(s DIFF t) = CARD s - CARD t`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ARITH_RULE `a + b:num = c ==> a = c - b`) THEN + MATCH_MP_TAC CARD_UNION_EQ THEN ASM_SIMP_TAC[] THEN ASM SET_TAC[]);; + +let CARD_EQ_0 = prove + (`!s. FINITE s ==> ((CARD s = 0) <=> (s = {}))`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CARD_CLAUSES; NOT_INSERT_EMPTY; NOT_SUC]);; + +let CARD_SING = prove + (`!a:A. CARD {a} = 1`, + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; NOT_IN_EMPTY; ARITH]);; + +(* ------------------------------------------------------------------------- *) +(* A stronger still form of induction where we get to choose the element. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_INDUCT_DELETE = prove + (`!P. P {} /\ + (!s. FINITE s /\ ~(s = {}) ==> ?x. x IN s /\ (P(s DELETE x) ==> P s)) + ==> !s:A->bool. FINITE s ==> P s`, + GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN WF_INDUCT_TAC `CARD(s:A->bool)` THEN + ASM_CASES_TAC `s:A->bool = {}` THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + UNDISCH_TAC + `!s. FINITE s /\ ~(s = {}) ==> ?x:A. x IN s /\ (P(s DELETE x) ==> P s)` THEN + DISCH_THEN(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` (CONJUNCTS_THEN2 ASSUME_TAC MATCH_MP_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (x:A)`) THEN + ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE; CARD_EQ_0; + ARITH_RULE `n - 1 < n <=> ~(n = 0)`]);; + +(* ------------------------------------------------------------------------- *) +(* Relational form is often more useful. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE = new_definition + `s HAS_SIZE n <=> FINITE s /\ (CARD s = n)`;; + +let HAS_SIZE_CARD = prove + (`!s n. s HAS_SIZE n ==> (CARD s = n)`, + SIMP_TAC[HAS_SIZE]);; + +let HAS_SIZE_0 = prove + (`!(s:A->bool). s HAS_SIZE 0 <=> (s = {})`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_SIZE] THEN + EQ_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[FINITE_RULES; CARD_CLAUSES] THEN + FIRST_ASSUM(MP_TAC o CONJUNCT2) THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1) THEN + SPEC_TAC(`s:A->bool`,`s:A->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_INSERT_EMPTY] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP (CONJUNCT2 CARD_CLAUSES) th]) THEN + ASM_REWRITE_TAC[NOT_SUC]);; + +let HAS_SIZE_SUC = prove + (`!(s:A->bool) n. s HAS_SIZE (SUC n) <=> + ~(s = {}) /\ !a. a IN s ==> (s DELETE a) HAS_SIZE n`, + REPEAT GEN_TAC THEN REWRITE_TAC[HAS_SIZE] THEN + ASM_CASES_TAC `s:A->bool = {}` THEN + ASM_REWRITE_TAC[CARD_CLAUSES; FINITE_RULES; NOT_IN_EMPTY; NOT_SUC] THEN + REWRITE_TAC[FINITE_DELETE] THEN + ASM_CASES_TAC `FINITE(s:A->bool)` THEN + ASM_REWRITE_TAC[NOT_FORALL_THM; MEMBER_NOT_EMPTY] THEN + EQ_TAC THEN REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL [`a:A`; `s DELETE a:A`] (CONJUNCT2 CARD_CLAUSES)) THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN + SUBGOAL_THEN `a INSERT (s DELETE a:A) = s` SUBST1_TAC THENL + [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; + ASM_REWRITE_TAC[SUC_INJ] THEN MESON_TAC[]]; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + MP_TAC(ISPECL [`a:A`; `s DELETE a:A`] (CONJUNCT2 CARD_CLAUSES)) THEN + ASM_REWRITE_TAC[FINITE_DELETE; IN_DELETE] THEN + SUBGOAL_THEN `a INSERT (s DELETE a:A) = s` SUBST1_TAC THENL + [UNDISCH_TAC `a:A IN s` THEN SET_TAC[]; + ASM_MESON_TAC[]]]);; + +let HAS_SIZE_UNION = prove + (`!s t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ DISJOINT s t + ==> (s UNION t) HAS_SIZE (m + n)`, + SIMP_TAC[HAS_SIZE; FINITE_UNION; DISJOINT; CARD_UNION]);; + +let HAS_SIZE_DIFF = prove + (`!s t m n. s HAS_SIZE m /\ t HAS_SIZE n /\ t SUBSET s + ==> (s DIFF t) HAS_SIZE (m - n)`, + SIMP_TAC[HAS_SIZE; FINITE_DIFF; CARD_DIFF]);; + +let HAS_SIZE_UNIONS = prove + (`!s t:A->B->bool m n. + s HAS_SIZE m /\ + (!x. x IN s ==> t(x) HAS_SIZE n) /\ + (!x y. x IN s /\ y IN s /\ ~(x = y) ==> DISJOINT (t x) (t y)) + ==> UNIONS {t(x) | x IN s} HAS_SIZE (m * n)`, + GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV) [HAS_SIZE] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[CARD_CLAUSES] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) (K ALL_TAC)) THEN + REWRITE_TAC[MULT_CLAUSES; HAS_SIZE_0; EMPTY_UNIONS] THEN + REWRITE_TAC[IN_ELIM_THM; NOT_IN_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`t:A->B->bool`; `m:num`; `n:num`] THEN + ASM_SIMP_TAC[CARD_CLAUSES] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SET_RULE + `UNIONS {t y | y IN x INSERT s} = t x UNION UNIONS {t y | y IN s}`] THEN + REWRITE_TAC[ARITH_RULE `SUC a * b = b + a * b`] THEN + MATCH_MP_TAC HAS_SIZE_UNION THEN ASM_SIMP_TAC[IN_INSERT] THEN + REWRITE_TAC[SET_RULE + `DISJOINT a (UNIONS s) <=> !x. x IN s ==> DISJOINT a x`] THEN + ASM_SIMP_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + ASM_MESON_TAC[IN_INSERT]);; + +let FINITE_HAS_SIZE = prove + (`!s. FINITE s <=> s HAS_SIZE CARD s`, + REWRITE_TAC[HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* This is often more useful as a rewrite. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_CLAUSES = prove + (`(s HAS_SIZE 0 <=> (s = {})) /\ + (s HAS_SIZE (SUC n) <=> + ?a t. t HAS_SIZE n /\ ~(a IN t) /\ (s = a INSERT t))`, + let lemma = SET_RULE `a IN s ==> (s = a INSERT (s DELETE a))` in + REWRITE_TAC[HAS_SIZE_0] THEN REPEAT STRIP_TAC THEN EQ_TAC THENL + [REWRITE_TAC[HAS_SIZE_SUC; GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[lemma; IN_DELETE]; + SIMP_TAC[LEFT_IMP_EXISTS_THM; HAS_SIZE; CARD_CLAUSES; FINITE_INSERT]]);; + +(* ------------------------------------------------------------------------- *) +(* Produce an explicit expansion for "s HAS_SIZE n" for numeral n. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_CONV = + let pth = prove + (`(~(a IN {}) /\ P <=> P) /\ + (~(a IN {b}) /\ P <=> ~(a = b) /\ P) /\ + (~(a IN (b INSERT cs)) /\ P <=> ~(a = b) /\ ~(a IN cs) /\ P)`, + SET_TAC[]) + and qth = prove + (`((?s. s HAS_SIZE 0 /\ P s) <=> P {}) /\ + ((?s. s HAS_SIZE (SUC n) /\ P s) <=> + (?a s. s HAS_SIZE n /\ ~(a IN s) /\ P(a INSERT s)))`, + REWRITE_TAC[HAS_SIZE_CLAUSES] THEN MESON_TAC[]) in + let qconv_0 = GEN_REWRITE_CONV I [CONJUNCT1 qth] + and qconv_1 = GEN_REWRITE_CONV I [CONJUNCT2 qth] + and rconv_0 = GEN_REWRITE_CONV I [CONJUNCT1 pth] + and rconv_1 = GEN_REWRITE_CONV I [CONJUNCT2 pth] in + let rec EXISTS_HAS_SIZE_AND_CONV tm = + (qconv_0 ORELSEC + (BINDER_CONV(LAND_CONV(RAND_CONV num_CONV)) THENC + qconv_1 THENC + BINDER_CONV EXISTS_HAS_SIZE_AND_CONV)) tm in + let rec NOT_IN_INSERT_CONV tm = + ((rconv_0 THENC NOT_IN_INSERT_CONV) ORELSEC + (rconv_1 THENC RAND_CONV NOT_IN_INSERT_CONV) ORELSEC + ALL_CONV) tm in + let HAS_SIZE_CONV = + GEN_REWRITE_CONV I [CONJUNCT1 HAS_SIZE_CLAUSES] ORELSEC + (RAND_CONV num_CONV THENC + GEN_REWRITE_CONV I [CONJUNCT2 HAS_SIZE_CLAUSES] THENC + BINDER_CONV EXISTS_HAS_SIZE_AND_CONV) in + fun tm -> + let th = HAS_SIZE_CONV tm in + let tm' = rand(concl th) in + let evs,bod = strip_exists tm' in + if evs = [] then th else + let th' = funpow (length evs) BINDER_CONV NOT_IN_INSERT_CONV tm' in + TRANS th th';; + +(* ------------------------------------------------------------------------- *) +(* Various useful lemmas about cardinalities of unions etc. *) +(* ------------------------------------------------------------------------- *) + +let CARD_SUBSET_EQ = prove + (`!(a:A->bool) b. FINITE b /\ a SUBSET b /\ (CARD a = CARD b) ==> (a = b)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:A->bool`; `b DIFF (a:A->bool)`] CARD_UNION) THEN + SUBGOAL_THEN `FINITE(a:A->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `FINITE(b:A->bool DIFF a)` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `b:A->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `a:A->bool INTER (b DIFF a) = EMPTY` ASSUME_TAC THENL + [SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `a UNION (b:A->bool DIFF a) = b` ASSUME_TAC THENL + [UNDISCH_TAC `a:A->bool SUBSET b` THEN SET_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `(a = a + b) <=> (b = 0)`] THEN DISCH_TAC THEN + SUBGOAL_THEN `b:A->bool DIFF a = EMPTY` MP_TAC THENL + [REWRITE_TAC[GSYM HAS_SIZE_0] THEN + ASM_REWRITE_TAC[HAS_SIZE]; + UNDISCH_TAC `a:A->bool SUBSET b` THEN SET_TAC[]]);; + +let CARD_SUBSET = prove + (`!(a:A->bool) b. a SUBSET b /\ FINITE(b) ==> CARD(a) <= CARD(b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `b:A->bool = a UNION (b DIFF a)` SUBST1_TAC THENL + [UNDISCH_TAC `a:A->bool SUBSET b` THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `CARD (a UNION b DIFF a) = CARD(a:A->bool) + CARD(b DIFF a)` + SUBST1_TAC THENL + [MATCH_MP_TAC CARD_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `b:A->bool` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `b:A->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + SET_TAC[]]; + ARITH_TAC]);; + +let CARD_SUBSET_LE = prove + (`!(a:A->bool) b. FINITE b /\ a SUBSET b /\ (CARD b <= CARD a) ==> (a = b)`, + MESON_TAC[CARD_SUBSET; CARD_SUBSET_EQ; LE_ANTISYM]);; + +let SUBSET_CARD_EQ = prove + (`!s t. FINITE t /\ s SUBSET t ==> (CARD s = CARD t <=> s = t)`, + MESON_TAC[CARD_SUBSET_EQ; LE_ANTISYM; CARD_SUBSET]);; + +let CARD_PSUBSET = prove + (`!(a:A->bool) b. a PSUBSET b /\ FINITE(b) ==> CARD(a) < CARD(b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[SET_RULE + `a PSUBSET b <=> ?x. x IN b /\ ~(x IN a) /\ a SUBSET (b DELETE x)` ] THEN + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC LET_TRANS THEN EXISTS_TAC `CARD(b DELETE (x:A))` THEN + ASM_SIMP_TAC[CARD_SUBSET; FINITE_DELETE] THEN + ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + ASM_MESON_TAC[CARD_EQ_0; MEMBER_NOT_EMPTY]);; + +let CARD_UNION_LE = prove + (`!s t:A->bool. + FINITE s /\ FINITE t ==> CARD(s UNION t) <= CARD(s) + CARD(t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD(s:A->bool) + CARD(t DIFF s)` THEN + ASM_SIMP_TAC[LE_ADD_LCANCEL; CARD_SUBSET; SUBSET_DIFF; FINITE_DIFF] THEN + MATCH_MP_TAC EQ_IMP_LE THEN + ONCE_REWRITE_TAC[SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN + MATCH_MP_TAC CARD_UNION THEN ASM_SIMP_TAC[FINITE_DIFF] THEN SET_TAC[]);; + +let CARD_UNIONS_LE = prove + (`!s t:A->B->bool m n. + s HAS_SIZE m /\ (!x. x IN s ==> FINITE(t x) /\ CARD(t x) <= n) + ==> CARD(UNIONS {t(x) | x IN s}) <= m * n`, + GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV) [HAS_SIZE] THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THEN + REWRITE_TAC[SET_RULE `UNIONS {t x | x IN {}} = {}`; CARD_CLAUSES; LE_0] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_RULES] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST_ALL_TAC o SYM) ASSUME_TAC) THEN + REWRITE_TAC[SET_RULE + `UNIONS {t x | x IN a INSERT s} = t(a) UNION UNIONS {t x | x IN s}`] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC + `CARD((t:A->B->bool) x) + CARD(UNIONS {(t:A->B->bool) y | y IN s})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_UNION_LE THEN ASM_SIMP_TAC[IN_INSERT] THEN + REWRITE_TAC[SET_RULE `{t x | x IN s} = IMAGE t s`] THEN + ASM_SIMP_TAC[FINITE_FINITE_UNIONS; FINITE_IMAGE; FORALL_IN_IMAGE; + IN_INSERT]; + MATCH_MP_TAC(ARITH_RULE `a <= n /\ b <= x * n ==> a + b <= SUC x * n`) THEN + ASM_SIMP_TAC[IN_INSERT]]);; + +let CARD_UNION_GEN = prove + (`!s t. FINITE s /\ FINITE t + ==> CARD(s UNION t) = (CARD(s) + CARD(t)) - CARD(s INTER t)`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[SET_RULE `s UNION t = s UNION (t DIFF s)`] THEN + ASM_SIMP_TAC[ARITH_RULE `x:num <= y ==> (a + y) - x = a + (y - x)`; + CARD_SUBSET; INTER_SUBSET; GSYM CARD_DIFF] THEN + REWRITE_TAC[SET_RULE `t DIFF (s INTER t) = t DIFF s`] THEN + MATCH_MP_TAC CARD_UNION THEN ASM_SIMP_TAC[FINITE_DIFF] THEN SET_TAC[]);; + +let CARD_UNION_OVERLAP_EQ = prove + (`!s t. FINITE s /\ FINITE t + ==> (CARD(s UNION t) = CARD s + CARD t <=> s INTER t = {})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[CARD_UNION_GEN] THEN + REWRITE_TAC[ARITH_RULE `a - b = a <=> b = 0 \/ a = 0`] THEN + ASM_SIMP_TAC[ADD_EQ_0; CARD_EQ_0; FINITE_INTER] THEN SET_TAC[]);; + +let CARD_UNION_OVERLAP = prove + (`!s t. FINITE s /\ FINITE t /\ CARD(s UNION t) < CARD(s) + CARD(t) + ==> ~(s INTER t = {})`, + SIMP_TAC[GSYM CARD_UNION_OVERLAP_EQ] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality of image under maps, injective or general. *) +(* ------------------------------------------------------------------------- *) + +let CARD_IMAGE_INJ = prove + (`!(f:A->B) s. (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ + FINITE s ==> (CARD (IMAGE f s) = CARD s)`, + GEN_TAC THEN + REWRITE_TAC[TAUT `a /\ b ==> c <=> b ==> a ==> c`] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY; IMAGE_CLAUSES] THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_IMAGE; IN_IMAGE] THEN + COND_CASES_TAC THEN ASM_MESON_TAC[IN_INSERT]);; + +let HAS_SIZE_IMAGE_INJ = prove + (`!(f:A->B) s n. + (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y)) /\ s HAS_SIZE n + ==> (IMAGE f s) HAS_SIZE n`, + SIMP_TAC[HAS_SIZE; FINITE_IMAGE] THEN MESON_TAC[CARD_IMAGE_INJ]);; + +let CARD_IMAGE_LE = prove + (`!(f:A->B) s. FINITE s ==> CARD(IMAGE f s) <= CARD s`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[IMAGE_CLAUSES; CARD_CLAUSES; FINITE_IMAGE; LE_REFL] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN ARITH_TAC);; + +let CARD_IMAGE_INJ_EQ = prove + (`!f:A->B s t. + FINITE s /\ + (!x. x IN s ==> f(x) IN t) /\ + (!y. y IN t ==> ?!x. x IN s /\ f(x) = y) + ==> CARD t = CARD s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `t = IMAGE (f:A->B) s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_MESON_TAC[]]);; + +let CARD_SUBSET_IMAGE = prove + (`!f s t. FINITE t /\ s SUBSET IMAGE f t ==> CARD s <= CARD t`, + MESON_TAC[LE_TRANS; FINITE_IMAGE; CARD_IMAGE_LE; CARD_SUBSET]);; + +let HAS_SIZE_IMAGE_INJ_EQ = prove + (`!f s n. + (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) + ==> ((IMAGE f s) HAS_SIZE n <=> s HAS_SIZE n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_SIZE] THEN + MATCH_MP_TAC(TAUT + `(a' <=> a) /\ (a ==> (b' <=> b)) ==> (a' /\ b' <=> a /\ b)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE_INJ_EQ; + DISCH_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARD_IMAGE_INJ] THEN + ASM_REWRITE_TAC[]);; + +let CARD_IMAGE_EQ_INJ = prove + (`!f:A->B s. + FINITE s + ==> (CARD(IMAGE f s) = CARD s <=> + !x y. x IN s /\ y IN s /\ f x = f y ==> x = y)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC; ASM_MESON_TAC[CARD_IMAGE_INJ]] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN + ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `CARD(IMAGE (f:A->B) s) = CARD s` THEN + SUBGOAL_THEN `IMAGE (f:A->B) s = IMAGE f (s DELETE y)` SUBST1_TAC THENL + [ASM SET_TAC[]; REWRITE_TAC[]] THEN + MATCH_MP_TAC(ARITH_RULE `!n. m <= n /\ n < p ==> ~(m:num = p)`) THEN + EXISTS_TAC `CARD(s DELETE (y:A))` THEN + ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN + ASM_SIMP_TAC[CARD_DELETE; CARD_EQ_0; + ARITH_RULE `n - 1 < n <=> ~(n = 0)`] THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Choosing a smaller subset of a given size. *) +(* ------------------------------------------------------------------------- *) + +let CHOOSE_SUBSET_STRONG = prove + (`!n s:A->bool. + (FINITE s ==> n <= CARD s) ==> ?t. t SUBSET s /\ t HAS_SIZE n`, + INDUCT_TAC THEN REWRITE_TAC[HAS_SIZE_0; HAS_SIZE_SUC] THENL + [MESON_TAC[EMPTY_SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC SET_PROVE_CASES THEN + REWRITE_TAC[FINITE_EMPTY; CARD_CLAUSES; ARITH_RULE `~(SUC n <= 0)`] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN DISCH_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; LE_SUC] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:A->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(a:A) INSERT t` THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[HAS_SIZE; CARD_DELETE; FINITE_INSERT; FINITE_DELETE; + CARD_CLAUSES] THEN + GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[SUC_SUB1] THEN + ASM SET_TAC[]);; + +let CHOOSE_SUBSET = prove + (`!s:A->bool. FINITE s ==> !n. n <= CARD s ==> ?t. t SUBSET s /\ t HAS_SIZE n`, + MESON_TAC[CHOOSE_SUBSET_STRONG]);; + +let CHOOSE_SUBSET_BETWEEN = prove + (`!n s u:A->bool. + s SUBSET u /\ FINITE s /\ CARD s <= n /\ (FINITE u ==> n <= CARD u) + ==> ?t. s SUBSET t /\ t SUBSET u /\ t HAS_SIZE n`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`n - CARD(s:A->bool)`; `u DIFF s:A->bool`] + CHOOSE_SUBSET_STRONG) THEN + ANTS_TAC THENL + [ASM_CASES_TAC `FINITE(u:A->bool)` THEN + ASM_SIMP_TAC[CARD_DIFF; ARITH_RULE `n:num <= m ==> n - x <= m - x`] THEN + MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + ASM_MESON_TAC[FINITE_UNION; FINITE_SUBSET; SET_RULE + `u SUBSET (u DIFF s) UNION s`]; + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s UNION t:A->bool` THEN + REPEAT(CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC]) THEN + SUBGOAL_THEN `n:num = CARD(s) + (n - CARD(s:A->bool))` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC HAS_SIZE_UNION] THEN + ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[HAS_SIZE] THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality of product. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_PRODUCT_DEPENDENT = prove + (`!s m t n. + s HAS_SIZE m /\ (!x. x IN s ==> t(x) HAS_SIZE n) + ==> {(x:A,y:B) | x IN s /\ y IN t(x)} HAS_SIZE (m * n)`, + GEN_REWRITE_TAC (funpow 4 BINDER_CONV o funpow 2 LAND_CONV) [HAS_SIZE] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[CARD_CLAUSES; NOT_IN_EMPTY; IN_INSERT] THEN CONJ_TAC THENL + [GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[MULT_CLAUSES; HAS_SIZE_0] THEN SET_TAC[]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN + X_GEN_TAC `m:num` THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + MAP_EVERY X_GEN_TAC [`t:A->B->bool`; `n:num`] THEN + REWRITE_TAC[TAUT `a \/ b ==> c <=> (a ==> c) /\ (b ==> c)`] THEN + SIMP_TAC[FORALL_AND_THM; LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `CARD(s:A->bool)`) THEN + ASM_REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC THEN + REWRITE_TAC[SET_RULE + `{(x,y) | (x = a \/ x IN s) /\ y IN t(x)} = + {(x,y) | x IN s /\ y IN t(x)} UNION + IMAGE (\y. (a,y)) (t a)`] THEN + MATCH_MP_TAC HAS_SIZE_UNION THEN + ASM_SIMP_TAC[HAS_SIZE_IMAGE_INJ; PAIR_EQ] THEN + REWRITE_TAC[DISJOINT; IN_IMAGE; IN_ELIM_THM; IN_INTER; EXTENSION; + NOT_IN_EMPTY; EXISTS_PAIR_THM; PAIR_EQ] THEN + REPEAT STRIP_TAC THEN ASM_MESON_TAC[PAIR_EQ]);; + +let FINITE_PRODUCT_DEPENDENT = prove + (`!f:A->B->C s t. + FINITE s /\ (!x. x IN s ==> FINITE(t x)) + ==> FINITE {f x y | x IN s /\ y IN (t x)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\(x,y). (f:A->B->C) x y) {x,y | x IN s /\ y IN t x}` THEN + REWRITE_TAC[SUBSET; IN_IMAGE; EXISTS_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + CONJ_TAC THENL [MATCH_MP_TAC FINITE_IMAGE; MESON_TAC[]] THEN + MAP_EVERY UNDISCH_TAC + [`!x:A. x IN s ==> FINITE(t x :B->bool)`; `FINITE(s:A->bool)`] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`t:A->B->bool`; `s:A->bool`] THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [GEN_TAC THEN SUBGOAL_THEN `{(x:A,y:B) | x IN {} /\ y IN (t x)} = {}` + (fun th -> REWRITE_TAC[th; FINITE_RULES]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `s:A->bool`] THEN STRIP_TAC THEN + X_GEN_TAC `t:A->B->bool` THEN + SUBGOAL_THEN + `{(x:A,y:B) | x IN (a INSERT s) /\ y IN (t x)} = + IMAGE (\y. a,y) (t a) UNION {(x,y) | x IN s /\ y IN (t x)}` + (fun th -> ASM_SIMP_TAC[IN_INSERT; FINITE_IMAGE; FINITE_UNION; th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INSERT; IN_UNION] THEN + MESON_TAC[]);; + +let FINITE_PRODUCT = prove + (`!s t. FINITE s /\ FINITE t ==> FINITE {(x:A,y:B) | x IN s /\ y IN t}`, + SIMP_TAC[FINITE_PRODUCT_DEPENDENT]);; + +let CARD_PRODUCT = prove + (`!s t. FINITE s /\ FINITE t + ==> (CARD {(x:A,y:B) | x IN s /\ y IN t} = CARD s * CARD t)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:A->bool`; `CARD(s:A->bool)`; `\x:A. t:B->bool`; + `CARD(t:B->bool)`] HAS_SIZE_PRODUCT_DEPENDENT) THEN + ASM_SIMP_TAC[HAS_SIZE]);; + +let HAS_SIZE_PRODUCT = prove + (`!s m t n. s HAS_SIZE m /\ t HAS_SIZE n + ==> {(x:A,y:B) | x IN s /\ y IN t} HAS_SIZE (m * n)`, + SIMP_TAC[HAS_SIZE; CARD_PRODUCT; FINITE_PRODUCT]);; + +(* ------------------------------------------------------------------------- *) +(* Actually introduce a Cartesian product operation. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("CROSS",(22,"right"));; + +let CROSS = new_definition + `s CROSS t = {x,y | x IN s /\ y IN t}`;; + +let IN_CROSS = prove + (`!x y s t. (x,y) IN (s CROSS t) <=> x IN s /\ y IN t`, + REWRITE_TAC[CROSS; IN_ELIM_PAIR_THM]);; + +let HAS_SIZE_CROSS = prove + (`!s t m n. s HAS_SIZE m /\ t HAS_SIZE n ==> (s CROSS t) HAS_SIZE (m * n)`, + REWRITE_TAC[CROSS; HAS_SIZE_PRODUCT]);; + +let FINITE_CROSS = prove + (`!s t. FINITE s /\ FINITE t ==> FINITE(s CROSS t)`, + SIMP_TAC[CROSS; FINITE_PRODUCT]);; + +let CARD_CROSS = prove + (`!s t. FINITE s /\ FINITE t ==> CARD(s CROSS t) = CARD s * CARD t`, + SIMP_TAC[CROSS; CARD_PRODUCT]);; + +let CROSS_EQ_EMPTY = prove + (`!s t. s CROSS t = {} <=> s = {} \/ t = {}`, + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_CROSS; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality of functions with bounded domain (support) and range. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_FUNSPACE = prove + (`!d n t:B->bool m s:A->bool. + s HAS_SIZE m /\ t HAS_SIZE n + ==> {f | (!x. x IN s ==> f(x) IN t) /\ (!x. ~(x IN s) ==> (f x = d))} + HAS_SIZE (n EXP m)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[HAS_SIZE_CLAUSES] THENL + [REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[NOT_IN_EMPTY; EXP] THEN + CONV_TAC HAS_SIZE_CONV THEN EXISTS_TAC `(\x. d):A->B` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`s0:A->bool`; `a:A`; `s:A->bool`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `s:A->bool`) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `{f:A->B | (!x. x IN a INSERT s ==> f x IN t) /\ + (!x. ~(x IN a INSERT s) ==> (f x = d))} = + IMAGE (\(b,g) x. if x = a then b else g(x)) + {b,g | b IN t /\ + g IN {f | (!x. x IN s ==> f x IN t) /\ + (!x. ~(x IN s) ==> (f x = d))}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; FORALL_PAIR_THM; IN_ELIM_THM; + EXISTS_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ; CONJ_ASSOC; ONCE_REWRITE_RULE[CONJ_SYM] + UNWIND_THM1] THEN + X_GEN_TAC `f:A->B` THEN REWRITE_TAC[IN_INSERT] THEN EQ_TAC THENL + [STRIP_TAC THEN MAP_EVERY EXISTS_TAC + [`(f:A->B) a`; `\x. if x IN s then (f:A->B) x else d`] THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `b:B` (X_CHOOSE_THEN `g:A->B` + STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_SIMP_TAC[EXP; HAS_SIZE_PRODUCT] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; PAIR_EQ; CONJ_ASSOC] THEN + REWRITE_TAC[ONCE_REWRITE_RULE[CONJ_SYM] UNWIND_THM1] THEN + CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN + REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN + STRIP_TAC THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN + ASM_MESON_TAC[]]);; + +let CARD_FUNSPACE = prove + (`!s t. FINITE s /\ FINITE t + ==> (CARD {f | (!x. x IN s ==> f(x) IN t) /\ + (!x. ~(x IN s) ==> (f x = d))} = + (CARD t) EXP (CARD s))`, + MESON_TAC[HAS_SIZE_FUNSPACE; HAS_SIZE]);; + +let FINITE_FUNSPACE = prove + (`!s t. FINITE s /\ FINITE t + ==> FINITE {f | (!x. x IN s ==> f(x) IN t) /\ + (!x. ~(x IN s) ==> (f x = d))}`, + MESON_TAC[HAS_SIZE_FUNSPACE; HAS_SIZE]);; + +let HAS_SIZE_FUNSPACE_UNIV = prove + (`!m n. (:A) HAS_SIZE m /\ (:B) HAS_SIZE n ==> (:A->B) HAS_SIZE (n EXP m)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_SIZE_FUNSPACE) THEN + REWRITE_TAC[IN_UNIV; UNIV_GSPEC]);; + +let CARD_FUNSPACE_UNIV = prove + (`FINITE(:A) /\ FINITE(:B) ==> CARD(:A->B) = CARD(:B) EXP CARD(:A)`, + MESON_TAC[HAS_SIZE_FUNSPACE_UNIV; HAS_SIZE]);; + +let FINITE_FUNSPACE_UNIV = prove + (`FINITE(:A) /\ FINITE(:B) ==> FINITE(:A->B)`, + MESON_TAC[HAS_SIZE_FUNSPACE_UNIV; HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinality of type bool. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_BOOL = prove + (`(:bool) HAS_SIZE 2`, + SUBGOAL_THEN `(:bool) = {F,T}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT] THEN CONV_TAC TAUT; + SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; ARITH; + IN_SING; NOT_IN_EMPTY]]);; + +let CARD_BOOL = prove + (`CARD(:bool) = 2`, + MESON_TAC[HAS_SIZE_BOOL; HAS_SIZE]);; + +let FINITE_BOOL = prove + (`FINITE(:bool)`, + MESON_TAC[HAS_SIZE_BOOL; HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* Hence cardinality of powerset. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_POWERSET = prove + (`!(s:A->bool) n. s HAS_SIZE n ==> {t | t SUBSET s} HAS_SIZE (2 EXP n)`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `{t | t SUBSET s} = + {f | (!x:A. x IN s ==> f(x) IN UNIV) /\ (!x. ~(x IN s) ==> (f x = F))}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV; SUBSET; IN; CONTRAPOS_THM]; + MATCH_MP_TAC HAS_SIZE_FUNSPACE THEN ASM_REWRITE_TAC[] THEN + CONV_TAC HAS_SIZE_CONV THEN MAP_EVERY EXISTS_TAC [`T`; `F`] THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_INSERT; NOT_IN_EMPTY] THEN + CONV_TAC TAUT]);; + +let CARD_POWERSET = prove + (`!s:A->bool. FINITE s ==> (CARD {t | t SUBSET s} = 2 EXP (CARD s))`, + MESON_TAC[HAS_SIZE_POWERSET; HAS_SIZE]);; + +let FINITE_POWERSET = prove + (`!s:A->bool. FINITE s ==> FINITE {t | t SUBSET s}`, + MESON_TAC[HAS_SIZE_POWERSET; HAS_SIZE]);; + +let FINITE_UNIONS = prove + (`!s:(A->bool)->bool. + FINITE(UNIONS s) <=> FINITE s /\ (!t. t IN s ==> FINITE t)`, + GEN_TAC THEN ASM_CASES_TAC `FINITE(s:(A->bool)->bool)` THEN + ASM_SIMP_TAC[FINITE_FINITE_UNIONS] THEN + DISCH_THEN(MP_TAC o MATCH_MP FINITE_POWERSET) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[CONTRAPOS_THM] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN SET_TAC[]);; + +let POWERSET_CLAUSES = prove + (`{s | s SUBSET {}} = {{}} /\ + (!a:A t. {s | s SUBSET (a INSERT t)} = + {s | s SUBSET t} UNION IMAGE (\s. a INSERT s) {s | s SUBSET t})`, + REWRITE_TAC[SUBSET_INSERT_DELETE; SUBSET_EMPTY; SING_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `t:A->bool`] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[UNION_SUBSET] THEN + ONCE_REWRITE_TAC[SUBSET] THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNION; IN_IMAGE] THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + X_GEN_TAC `s:A->bool` THEN + ASM_CASES_TAC `(a:A) IN s` THENL [ALL_TAC; ASM SET_TAC[]] THEN + STRIP_TAC THEN DISJ2_TAC THEN EXISTS_TAC `s DELETE (a:A)` THEN + ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Set of numbers is infinite. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_NUMSEG_LT = prove + (`!n. {m | m < n} HAS_SIZE n`, + INDUCT_TAC THENL + [SUBGOAL_THEN `{m | m < 0} = {}` + (fun th -> REWRITE_TAC[HAS_SIZE_0; th]) THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM; LT]; + SUBGOAL_THEN `{m | m < SUC n} = n INSERT {m | m < n}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INSERT] THEN ARITH_TAC; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[HAS_SIZE]) THEN + ASM_SIMP_TAC[HAS_SIZE; CARD_CLAUSES; FINITE_INSERT] THEN + REWRITE_TAC[IN_ELIM_THM; LT_REFL]]);; + +let CARD_NUMSEG_LT = prove + (`!n. CARD {m | m < n} = n`, + REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LT]);; + +let FINITE_NUMSEG_LT = prove + (`!n:num. FINITE {m | m < n}`, + REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LT]);; + +let HAS_SIZE_NUMSEG_LE = prove + (`!n. {m | m <= n} HAS_SIZE (n + 1)`, + REWRITE_TAC[GSYM LT_SUC_LE; HAS_SIZE_NUMSEG_LT; ADD1]);; + +let FINITE_NUMSEG_LE = prove + (`!n. FINITE {m | m <= n}`, + REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LE]);; + +let CARD_NUMSEG_LE = prove + (`!n. CARD {m | m <= n} = n + 1`, + REWRITE_TAC[REWRITE_RULE[HAS_SIZE] HAS_SIZE_NUMSEG_LE]);; + +let num_FINITE = prove + (`!s:num->bool. FINITE s <=> ?a. !x. x IN s ==> x <= a`, + GEN_TAC THEN EQ_TAC THENL + [SPEC_TAC(`s:num->bool`,`s:num->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[LE_CASES; LE_TRANS]; + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{m:num | m <= n}` THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + ASM_SIMP_TAC[SUBSET; IN_ELIM_THM]]);; + +let num_FINITE_AVOID = prove + (`!s:num->bool. FINITE(s) ==> ?a. ~(a IN s)`, + MESON_TAC[num_FINITE; LT; NOT_LT]);; + +let num_INFINITE = prove + (`INFINITE(:num)`, + REWRITE_TAC[INFINITE] THEN MESON_TAC[num_FINITE_AVOID; IN_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Set of strings is infinite. *) +(* ------------------------------------------------------------------------- *) + +let string_INFINITE = prove + (`INFINITE(:string)`, + MP_TAC num_INFINITE THEN REWRITE_TAC[INFINITE; CONTRAPOS_THM] THEN + DISCH_THEN(MP_TAC o ISPEC `LENGTH:string->num` o MATCH_MP FINITE_IMAGE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN MESON_TAC[LENGTH_REPLICATE]);; + +(* ------------------------------------------------------------------------- *) +(* Non-trivial intervals of reals are infinite. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_REAL_INTERVAL = prove + (`(!a. ~FINITE {x:real | a < x}) /\ + (!a. ~FINITE {x:real | a <= x}) /\ + (!b. ~FINITE {x:real | x < b}) /\ + (!b. ~FINITE {x:real | x <= b}) /\ + (!a b. FINITE {x:real | a < x /\ x < b} <=> b <= a) /\ + (!a b. FINITE {x:real | a <= x /\ x < b} <=> b <= a) /\ + (!a b. FINITE {x:real | a < x /\ x <= b} <=> b <= a) /\ + (!a b. FINITE {x:real | a <= x /\ x <= b} <=> b <= a)`, + SUBGOAL_THEN `!a b. FINITE {x:real | a < x /\ x < b} <=> b <= a` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ASM_CASES_TAC `a:real < b` THEN + ASM_SIMP_TAC[REAL_ARITH `~(a:real < b) ==> ~(a < x /\ x < b)`] THEN + REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (\n. a + (b - a) / (&n + &2)) (:num)`) THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_ELIM_THM] THEN + SIMP_TAC[REAL_LT_ADDR; REAL_ARITH `a + x / y < b <=> x / y < b - a`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_SUB_LT; REAL_LT_LDIV_EQ; NOT_IMP; + REAL_ARITH `&0:real < &n + &2`] THEN + REWRITE_TAC[REAL_ARITH `x:real < x * (n + &2) <=> &0 < x * (n + &1)`] THEN + ASM_SIMP_TAC[REAL_SUB_LT; REAL_LT_MUL; REAL_ARITH `&0:real < &n + &1`] THEN + MP_TAC num_INFINITE THEN REWRITE_TAC[INFINITE] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC FINITE_IMAGE_INJ_EQ THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; REAL_FIELD + `a < b ==> (a + (b - a) / (&n + &2) = a + (b - a) / (&m + &2) <=> + &n:real = &m)`]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THEN REPEAT GEN_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `{x:real | a < x /\ x < a + &1}` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `{x:real | a < x /\ x < a + &1}` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `{x:real | b - &1 < x /\ x < b}` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC `{x:real | b - &1 < x /\ x < b}` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH + `a:real <= x /\ x < b <=> (a < x /\ x < b) \/ ~(b <= a) /\ x = a`]; + REWRITE_TAC[REAL_ARITH + `a:real < x /\ x <= b <=> (a < x /\ x < b) \/ ~(b <= a) /\ x = b`]; + ASM_CASES_TAC `b:real = a` THEN + ASM_SIMP_TAC[REAL_LE_ANTISYM; REAL_LE_REFL; SING_GSPEC; FINITE_SING] THEN + ASM_SIMP_TAC[REAL_ARITH + `~(b:real = a) ==> + (a <= x /\ x <= b <=> (a < x /\ x < b) \/ ~(b <= a) /\ x = a \/ + ~(b <= a) /\ x = b)`]] THEN + ASM_REWRITE_TAC[FINITE_UNION; SET_RULE + `{x | p x \/ q x} = {x | p x} UNION {x | q x}`] THEN + ASM_CASES_TAC `b:real <= a` THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY]);; + +let real_INFINITE = prove + (`INFINITE(:real)`, + REWRITE_TAC[INFINITE] THEN + DISCH_THEN(MP_TAC o SPEC `{x:real | &0 <= x}` o + MATCH_MP(REWRITE_RULE[IMP_CONJ] FINITE_SUBSET)) THEN + REWRITE_TAC[FINITE_REAL_INTERVAL; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Indexing of finite sets and enumeration of subsets of N in order. *) +(* ------------------------------------------------------------------------- *) + +let HAS_SIZE_INDEX = prove + (`!s n. s HAS_SIZE n + ==> ?f:num->A. (!m. m < n ==> f(m) IN s) /\ + (!x. x IN s ==> ?!m. m < n /\ (f m = x))`, + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN INDUCT_TAC THEN + SIMP_TAC[HAS_SIZE_0; HAS_SIZE_SUC; LT; NOT_IN_EMPTY] THEN + X_GEN_TAC `s:A->bool` THEN REWRITE_TAC[EXTENSION; NOT_IN_EMPTY] THEN + REWRITE_TAC[NOT_FORALL_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) (MP_TAC o SPEC `a:A`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s DELETE (a:A)`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f:num->A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\m:num. if m < n then f(m) else a:A` THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_MESON_TAC[IN_DELETE]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN + ASM_REWRITE_TAC[IN_DELETE] THEN + CONV_TAC(ONCE_DEPTH_CONV COND_ELIM_CONV) THEN + ASM_CASES_TAC `a:A = x` THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[LT_REFL; IN_DELETE]);; + +let INFINITE_ENUMERATE = prove + (`!s:num->bool. + INFINITE s + ==> ?r:num->num. (!m n. m < n ==> r(m) < r(n)) /\ + IMAGE r (:num) = s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n:num. ?x. n <= x /\ x IN s` MP_TAC THENL + [ASM_MESON_TAC[INFINITE; num_FINITE; LT_IMP_LE; NOT_LE]; + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) [num_WOP]] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM; FORALL_AND_THM] THEN + REWRITE_TAC[TAUT `p ==> ~(q /\ r) <=> q /\ p ==> ~r`] THEN + X_GEN_TAC `next:num->num` THEN STRIP_TAC THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `(f(0) = next 0) /\ (!n. f(SUC n) = next(f n + 1))` THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `r:num->num` THEN STRIP_TAC THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[LT] THEN + ASM_MESON_TAC[ARITH_RULE `m <= n /\ n + 1 <= p ==> m < p`; LE_LT]; + DISCH_TAC] THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; FORALL_IN_IMAGE; SUBSET] THEN + REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL + [INDUCT_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?m:num. m < n /\ m IN s` THENL + [MP_TAC(SPEC `\m:num. m < n /\ m IN s` num_MAX) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT + `p /\ (q ==> r) ==> (p <=> q) ==> r`) THEN + CONJ_TAC THENL [MESON_TAC[LT_IMP_LE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?q. p = (r:num->num) q` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [ASM_MESON_TAC[]; EXISTS_TAC `SUC q`] THEN + ASM_REWRITE_TAC[GSYM LE_ANTISYM; GSYM NOT_LT] THEN + ASM_MESON_TAC[NOT_LE; ARITH_RULE `r < p <=> r + 1 <= p`]; + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[GSYM LE_ANTISYM; GSYM NOT_LT] THEN + ASM_MESON_TAC[LE_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Mapping between finite sets and lists. *) +(* ------------------------------------------------------------------------- *) + +let set_of_list = new_recursive_definition list_RECURSION + `(set_of_list ([]:A list) = {}) /\ + (set_of_list (CONS (h:A) t) = h INSERT (set_of_list t))`;; + +let list_of_set = new_definition + `list_of_set s = @l. (set_of_list l = s) /\ (LENGTH l = CARD s)`;; + +let LIST_OF_SET_PROPERTIES = prove + (`!s:A->bool. FINITE(s) + ==> (set_of_list(list_of_set s) = s) /\ + (LENGTH(list_of_set s) = CARD s)`, + REWRITE_TAC[list_of_set] THEN + CONV_TAC(BINDER_CONV(RAND_CONV SELECT_CONV)) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REPEAT STRIP_TAC THENL + [EXISTS_TAC `[]:A list` THEN REWRITE_TAC[CARD_CLAUSES; LENGTH; set_of_list]; + EXISTS_TAC `CONS (x:A) l` THEN ASM_REWRITE_TAC[LENGTH] THEN + ASM_REWRITE_TAC[set_of_list] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC + [MATCH_MP (CONJUNCT2 CARD_CLAUSES) th]) THEN + ASM_REWRITE_TAC[]]);; + +let SET_OF_LIST_OF_SET = prove + (`!s. FINITE(s) ==> (set_of_list(list_of_set s) = s)`, + MESON_TAC[LIST_OF_SET_PROPERTIES]);; + +let LENGTH_LIST_OF_SET = prove + (`!s. FINITE(s) ==> (LENGTH(list_of_set s) = CARD s)`, + MESON_TAC[LIST_OF_SET_PROPERTIES]);; + +let MEM_LIST_OF_SET = prove + (`!s:A->bool. FINITE(s) ==> !x. MEM x (list_of_set s) <=> x IN s`, + GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP SET_OF_LIST_OF_SET) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (BINDER_CONV o funpow 2 RAND_CONV) + [GSYM th]) THEN + SPEC_TAC(`list_of_set(s:A->bool)`,`l:A list`) THEN + LIST_INDUCT_TAC THEN REWRITE_TAC[MEM; set_of_list; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[IN_INSERT]);; + +let FINITE_SET_OF_LIST = prove + (`!l. FINITE(set_of_list l)`, + LIST_INDUCT_TAC THEN ASM_SIMP_TAC[set_of_list; FINITE_RULES]);; + +let IN_SET_OF_LIST = prove + (`!x l. x IN (set_of_list l) <=> MEM x l`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; MEM; set_of_list] THEN + ASM_MESON_TAC[]);; + +let SET_OF_LIST_APPEND = prove + (`!l1 l2. set_of_list(APPEND l1 l2) = set_of_list(l1) UNION set_of_list(l2)`, + REWRITE_TAC[EXTENSION; IN_SET_OF_LIST; IN_UNION; MEM_APPEND]);; + +let SET_OF_LIST_MAP = prove + (`!f l. set_of_list(MAP f l) = IMAGE f (set_of_list l)`, + GEN_TAC THEN LIST_INDUCT_TAC THEN + ASM_REWRITE_TAC[set_of_list; MAP; IMAGE_CLAUSES]);; + +let SET_OF_LIST_EQ_EMPTY = prove + (`!l. set_of_list l = {} <=> l = []`, + LIST_INDUCT_TAC THEN + REWRITE_TAC[set_of_list; NOT_CONS_NIL; NOT_INSERT_EMPTY]);; + +let LIST_OF_SET_EMPTY = prove + (`list_of_set {} = []`, + REWRITE_TAC[GSYM LENGTH_EQ_NIL] THEN + SIMP_TAC[LENGTH_LIST_OF_SET; FINITE_EMPTY; CARD_CLAUSES]);; + +let LIST_OF_SET_SING = prove + (`!x:A. list_of_set {a} = [a]`, + GEN_TAC THEN REWRITE_TAC[list_of_set] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN + MATCH_MP_TAC list_INDUCT THEN REWRITE_TAC[NOT_CONS_NIL] THEN + SIMP_TAC[LENGTH; CARD_CLAUSES; FINITE_EMPTY; NOT_IN_EMPTY; NOT_SUC] THEN + GEN_TAC THEN LIST_INDUCT_TAC THEN DISCH_THEN(K ALL_TAC) THEN + SIMP_TAC[LENGTH; set_of_list; CONS_11; SUC_INJ; NOT_CONS_NIL; NOT_SUC] THEN + SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Mappings from finite set enumerations to lists (no "setification"). *) +(* ------------------------------------------------------------------------- *) + +let dest_setenum = + let fn = splitlist (dest_binary "INSERT") in + fun tm -> let l,n = fn tm in + if is_const n & fst(dest_const n) = "EMPTY" then l + else failwith "dest_setenum: not a finite set enumeration";; + +let is_setenum = can dest_setenum;; + +let mk_setenum = + let insert_atm = `(INSERT):A->(A->bool)->(A->bool)` + and nil_atm = `(EMPTY):A->bool` in + fun (l,ty) -> + let insert_tm = inst [ty,aty] insert_atm + and nil_tm = inst [ty,aty] nil_atm in + itlist (mk_binop insert_tm) l nil_tm;; + +let mk_fset l = mk_setenum(l,type_of(hd l));; + +(* ------------------------------------------------------------------------- *) +(* Pairwise property over sets and lists. *) +(* ------------------------------------------------------------------------- *) + +let pairwise = new_definition + `pairwise r s <=> !x y. x IN s /\ y IN s /\ ~(x = y) ==> r x y`;; + +let PAIRWISE = new_recursive_definition list_RECURSION + `(PAIRWISE (r:A->A->bool) [] <=> T) /\ + (PAIRWISE (r:A->A->bool) (CONS h t) <=> ALL (r h) t /\ PAIRWISE r t)`;; + +let PAIRWISE_EMPTY = prove + (`!r. pairwise r {} <=> T`, + REWRITE_TAC[pairwise; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let PAIRWISE_SING = prove + (`!r x. pairwise r {x} <=> T`, + REWRITE_TAC[pairwise; IN_SING] THEN MESON_TAC[]);; + +let PAIRWISE_MONO = prove + (`!r s t. pairwise r s /\ t SUBSET s ==> pairwise r t`, + REWRITE_TAC[pairwise] THEN SET_TAC[]);; + +let PAIRWISE_INSERT = prove + (`!r x s. + pairwise r (x INSERT s) <=> + (!y. y IN s /\ ~(y = x) ==> r x y /\ r y x) /\ + pairwise r s`, + REWRITE_TAC[pairwise; IN_INSERT] THEN MESON_TAC[]);; + +let PAIRWISE_IMAGE = prove + (`!r f. pairwise r (IMAGE f s) <=> + pairwise (\x y. ~(f x = f y) ==> r (f x) (f y)) s`, + REWRITE_TAC[pairwise; IN_IMAGE] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Some additional properties of "set_of_list". *) +(* ------------------------------------------------------------------------- *) + +let CARD_SET_OF_LIST_LE = prove + (`!l. CARD(set_of_list l) <= LENGTH l`, + LIST_INDUCT_TAC THEN + SIMP_TAC[LENGTH; set_of_list; CARD_CLAUSES; FINITE_SET_OF_LIST] THEN + ASM_ARITH_TAC);; + +let HAS_SIZE_SET_OF_LIST = prove + (`!l. (set_of_list l) HAS_SIZE (LENGTH l) <=> PAIRWISE (\x y. ~(x = y)) l`, + REWRITE_TAC[HAS_SIZE; FINITE_SET_OF_LIST] THEN LIST_INDUCT_TAC THEN + ASM_SIMP_TAC[CARD_CLAUSES; LENGTH; set_of_list; PAIRWISE; ALL; + FINITE_SET_OF_LIST; GSYM ALL_MEM; IN_SET_OF_LIST] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[SUC_INJ] THEN + ASM_MESON_TAC[CARD_SET_OF_LIST_LE; ARITH_RULE `~(SUC n <= n)`]);; + +(* ------------------------------------------------------------------------- *) +(* Classic result on function of finite set into itself. *) +(* ------------------------------------------------------------------------- *) + +let SURJECTIVE_IFF_INJECTIVE_GEN = prove + (`!s t f:A->B. + FINITE s /\ FINITE t /\ (CARD s = CARD t) /\ (IMAGE f s) SUBSET t + ==> ((!y. y IN t ==> ?x. x IN s /\ (f x = y)) <=> + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)))`, + REPEAT STRIP_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THENL + [ASM_CASES_TAC `x:A = y` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `CARD s <= CARD (IMAGE (f:A->B) (s DELETE y))` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARD_SUBSET THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_DELETE] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_DELETE] THEN ASM_MESON_TAC[]; + REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC `CARD(s DELETE (y:A))` THEN + ASM_SIMP_TAC[CARD_IMAGE_LE; FINITE_DELETE] THEN + ASM_SIMP_TAC[CARD_DELETE; ARITH_RULE `x - 1 < x <=> ~(x = 0)`] THEN + ASM_MESON_TAC[CARD_EQ_0; MEMBER_NOT_EMPTY]]; + SUBGOAL_THEN `IMAGE (f:A->B) s = t` MP_TAC THENL + [ALL_TAC; ASM_MESON_TAC[EXTENSION; IN_IMAGE]] THEN + ASM_MESON_TAC[CARD_SUBSET_EQ; CARD_IMAGE_INJ]]);; + +let SURJECTIVE_IFF_INJECTIVE = prove + (`!s f:A->A. + FINITE s /\ (IMAGE f s) SUBSET s + ==> ((!y. y IN s ==> ?x. x IN s /\ (f x = y)) <=> + (!x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)))`, + SIMP_TAC[SURJECTIVE_IFF_INJECTIVE_GEN]);; + +let IMAGE_IMP_INJECTIVE_GEN = prove + (`!s t f:A->B. + FINITE s /\ (CARD s = CARD t) /\ (IMAGE f s = t) + ==> !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, + REPEAT GEN_TAC THEN DISCH_THEN(ASSUME_TAC o GSYM) THEN + MP_TAC(ISPECL [`s:A->bool`; `t:B->bool`; `f:A->B`] + SURJECTIVE_IFF_INJECTIVE_GEN) THEN + ASM_SIMP_TAC[SUBSET_REFL; FINITE_IMAGE] THEN + ASM_MESON_TAC[EXTENSION; IN_IMAGE]);; + +let IMAGE_IMP_INJECTIVE = prove + (`!s f. FINITE s /\ (IMAGE f s = s) + ==> !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, + MESON_TAC[IMAGE_IMP_INJECTIVE_GEN]);; + +(* ------------------------------------------------------------------------- *) +(* Converse relation between cardinality and injection. *) +(* ------------------------------------------------------------------------- *) + +let CARD_LE_INJ = prove + (`!s t. FINITE s /\ FINITE t /\ CARD s <= CARD t + ==> ?f:A->B. (IMAGE f s) SUBSET t /\ + !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, + REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[IMAGE_CLAUSES; EMPTY_SUBSET; NOT_IN_EMPTY] THEN + SIMP_TAC[CARD_CLAUSES] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `s:A->bool`] THEN STRIP_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[CARD_CLAUSES; LE; NOT_SUC] THEN + MAP_EVERY X_GEN_TAC [`y:B`; `t:B->bool`] THEN + SIMP_TAC[CARD_CLAUSES] THEN + DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LE_SUC] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:B->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f:A->B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\z:A. if z = x then (y:B) else f(z)` THEN + REWRITE_TAC[IN_INSERT; SUBSET; IN_IMAGE] THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE]);; + +(* ------------------------------------------------------------------------- *) +(* Occasionally handy rewrites. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_IN_CLAUSES = prove + (`(!P. (!x. x IN {} ==> P x) <=> T) /\ + (!P a s. (!x. x IN (a INSERT s) ==> P x) <=> P a /\ (!x. x IN s ==> P x))`, + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +let EXISTS_IN_CLAUSES = prove + (`(!P. (?x. x IN {} /\ P x) <=> F) /\ + (!P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ (?x. x IN s /\ P x))`, + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Injectivity and surjectivity of image under a function. *) +(* ------------------------------------------------------------------------- *) + +let INJECTIVE_ON_IMAGE = prove + (`!f:A->B u. + (!s t. s SUBSET u /\ t SUBSET u /\ IMAGE f s = IMAGE f t ==> s = t) <=> + (!x y. x IN u /\ y IN u /\ f x = f y ==> x = y)`, + REPEAT GEN_TAC THEN EQ_TAC THENL [DISCH_TAC; SET_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`{x:A}`; `{y:A}`]) THEN + ASM_REWRITE_TAC[SING_SUBSET; IMAGE_CLAUSES] THEN SET_TAC[]);; + +let INJECTIVE_IMAGE = prove + (`!f:A->B. + (!s t. IMAGE f s = IMAGE f t ==> s = t) <=> (!x y. f x = f y ==> x = y)`, + GEN_TAC THEN MP_TAC(ISPECL [`f:A->B`; `(:A)`] INJECTIVE_ON_IMAGE) THEN + REWRITE_TAC[IN_UNIV; SUBSET_UNIV]);; + +let SURJECTIVE_ON_IMAGE = prove + (`!f:A->B u v. + (!t. t SUBSET v ==> ?s. s SUBSET u /\ IMAGE f s = t) <=> + (!y. y IN v ==> ?x. x IN u /\ f x = y)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN X_GEN_TAC `y:B` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:B}`) THEN ASM SET_TAC[]; + DISCH_TAC THEN X_GEN_TAC `t:B->bool` THEN DISCH_TAC THEN + EXISTS_TAC `{x | x IN u /\ (f:A->B) x IN t}` THEN ASM SET_TAC[]]);; + +let SURJECTIVE_IMAGE = prove + (`!f:A->B. (!t. ?s. IMAGE f s = t) <=> (!y. ?x. f x = y)`, + GEN_TAC THEN + MP_TAC(ISPECL [`f:A->B`; `(:A)`; `(:B)`] SURJECTIVE_ON_IMAGE) THEN + REWRITE_TAC[IN_UNIV; SUBSET_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* Existence of bijections between two finite sets of same size. *) +(* ------------------------------------------------------------------------- *) + +let CARD_EQ_BIJECTION = prove + (`!s t. FINITE s /\ FINITE t /\ CARD s = CARD t + ==> ?f:A->B. (!x. x IN s ==> f(x) IN t) /\ + (!y. y IN t ==> ?x. x IN s /\ f x = y) /\ + !x y. x IN s /\ y IN s /\ (f x = f y) ==> (x = y)`, + MP_TAC CARD_LE_INJ THEN REPEAT(MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[LE_REFL] THEN MATCH_MP_TAC MONO_EXISTS THEN + ASM_SIMP_TAC[SURJECTIVE_IFF_INJECTIVE_GEN] THEN + MESON_TAC[SUBSET; IN_IMAGE]);; + +let CARD_EQ_BIJECTIONS = prove + (`!s t. FINITE s /\ FINITE t /\ CARD s = CARD t + ==> ?f:A->B g. (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ + (!y. y IN t ==> g(y) IN s /\ f(g y) = y)`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_BIJECTION) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[SURJECTIVE_ON_RIGHT_INVERSE] THEN + GEN_TAC THEN REWRITE_TAC[LEFT_AND_EXISTS_THM; RIGHT_AND_EXISTS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]);; + +let BIJECTIONS_HAS_SIZE = prove + (`!s t f:A->B g. + (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ + (!y. y IN t ==> g(y) IN s /\ f(g y) = y) /\ + s HAS_SIZE n + ==> t HAS_SIZE n`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN `t = IMAGE (f:A->B) s` SUBST_ALL_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC HAS_SIZE_IMAGE_INJ THEN ASM_MESON_TAC[]]);; + +let BIJECTIONS_HAS_SIZE_EQ = prove + (`!s t f:A->B g. + (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ + (!y. y IN t ==> g(y) IN s /\ f(g y) = y) + ==> !n. s HAS_SIZE n <=> t HAS_SIZE n`, + REPEAT STRIP_TAC THEN EQ_TAC THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE + [TAUT `a /\ b /\ c ==> d <=> a /\ b ==> c ==> d`] BIJECTIONS_HAS_SIZE) THENL + [MAP_EVERY EXISTS_TAC [`f:A->B`; `g:B->A`]; + MAP_EVERY EXISTS_TAC [`g:B->A`; `f:A->B`]] THEN + ASM_MESON_TAC[]);; + +let BIJECTIONS_CARD_EQ = prove + (`!s t f:A->B g. + (FINITE s \/ FINITE t) /\ + (!x. x IN s ==> f(x) IN t /\ g(f x) = x) /\ + (!y. y IN t ==> g(y) IN s /\ f(g y) = y) + ==> CARD s = CARD t`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 + MP_TAC (MP_TAC o MATCH_MP BIJECTIONS_HAS_SIZE_EQ)) THEN + MESON_TAC[HAS_SIZE]);; + +(* ------------------------------------------------------------------------- *) +(* Transitive relation with finitely many predecessors is wellfounded. *) +(* ------------------------------------------------------------------------- *) + +let WF_FINITE = prove + (`!(<<). (!x. ~(x << x)) /\ (!x y z. x << y /\ y << z ==> x << z) /\ + (!x:A. FINITE {y | y << x}) + ==> WF(<<)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[WF_DCHAIN] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->A` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!m n. m < n ==> (s:num->A) n << s m` ASSUME_TAC THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `s:num->A` INFINITE_IMAGE_INJ) THEN ANTS_TAC THENL + [ASM_MESON_TAC[LT_CASES]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `(:num)`) THEN + REWRITE_TAC[num_INFINITE] THEN REWRITE_TAC[INFINITE] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `s(0) INSERT {y:A | y << s(0)}` THEN + ASM_REWRITE_TAC[FINITE_INSERT] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV; IN_INSERT] THEN + INDUCT_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[LT_0]);; + +(* ------------------------------------------------------------------------- *) +(* Cardinal comparisons (more theory in Examples/card.ml) *) +(* ------------------------------------------------------------------------- *) + +let le_c = new_definition + `s <=_c t <=> ?f. (!x. x IN s ==> f(x) IN t) /\ + (!x y. x IN s /\ y IN s /\ (f(x) = f(y)) ==> (x = y))`;; + +let lt_c = new_definition + `s <_c t <=> s <=_c t /\ ~(t <=_c s)`;; + +let eq_c = new_definition + `s =_c t <=> ?f. (!x. x IN s ==> f(x) IN t) /\ + !y. y IN t ==> ?!x. x IN s /\ (f x = y)`;; + +let ge_c = new_definition + `s >=_c t <=> t <=_c s`;; + +let gt_c = new_definition + `s >_c t <=> t <_c s`;; + +let LE_C = prove + (`!s t. s <=_c t <=> ?g. !x. x IN s ==> ?y. y IN t /\ (g y = x)`, + REWRITE_TAC[le_c; INJECTIVE_ON_LEFT_INVERSE; SURJECTIVE_ON_RIGHT_INVERSE; + RIGHT_IMP_EXISTS_THM; SKOLEM_THM; RIGHT_AND_EXISTS_THM] THEN + MESON_TAC[]);; + +let GE_C = prove + (`!s t. s >=_c t <=> ?f. !y. y IN t ==> ?x. x IN s /\ (y = f x)`, + REWRITE_TAC[ge_c; LE_C] THEN MESON_TAC[]);; + +let COUNTABLE = new_definition + `COUNTABLE t <=> (:num) >=_c t`;; + +(* ------------------------------------------------------------------------- *) +(* Supremum and infimum. *) +(* ------------------------------------------------------------------------- *) + +let sup = new_definition + `sup s = @a:real. (!x. x IN s ==> x <= a) /\ + !b. (!x. x IN s ==> x <= b) ==> a <= b`;; + +let SUP_EQ = prove + (`!s t. (!b. (!x. x IN s ==> x <= b) <=> (!x. x IN t ==> x <= b)) + ==> sup s = sup t`, + SIMP_TAC[sup]);; + +let SUP = prove + (`!s. ~(s = {}) /\ (?b. !x. x IN s ==> x <= b) + ==> (!x. x IN s ==> x <= sup s) /\ + !b. (!x. x IN s ==> x <= b) ==> sup s <= b`, + REWRITE_TAC[sup] THEN CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_COMPLETE THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY]);; + +let SUP_FINITE_LEMMA = prove + (`!s. FINITE s /\ ~(s = {}) ==> ?b:real. b IN s /\ !x. x IN s ==> x <= b`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_INSERT_EMPTY; IN_INSERT] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]);; + +let SUP_FINITE = prove + (`!s. FINITE s /\ ~(s = {}) ==> (sup s) IN s /\ !x. x IN s ==> x <= sup s`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SUP_FINITE_LEMMA) THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TOTAL; SUP]);; + +let REAL_LE_SUP_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (a <= sup s <=> ?x. x IN s /\ a <= x)`, + MESON_TAC[SUP_FINITE; REAL_LE_TRANS]);; + +let REAL_SUP_LE_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (sup s <= a <=> !x. x IN s ==> x <= a)`, + MESON_TAC[SUP_FINITE; REAL_LE_TRANS]);; + +let REAL_LT_SUP_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (a < sup s <=> ?x. x IN s /\ a < x)`, + MESON_TAC[SUP_FINITE; REAL_LTE_TRANS]);; + +let REAL_SUP_LT_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (sup s < a <=> !x. x IN s ==> x < a)`, + MESON_TAC[SUP_FINITE; REAL_LET_TRANS]);; + +let REAL_SUP_UNIQUE = prove + (`!s b. (!x. x IN s ==> x <= b) /\ + (!b'. b' < b ==> ?x. x IN s /\ b' < x) + ==> sup s = b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[sup] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + ASM_MESON_TAC[REAL_NOT_LE; REAL_LE_ANTISYM]);; + +let REAL_SUP_LE = prove + (`!b. ~(s = {}) /\ (!x. x IN s ==> x <= b) ==> sup s <= b`, + MESON_TAC[SUP]);; + +let REAL_SUP_LE_SUBSET = prove + (`!s t. ~(s = {}) /\ s SUBSET t /\ (?b. !x. x IN t ==> x <= b) + ==> sup s <= sup t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE THEN + MP_TAC(SPEC `t:real->bool` SUP) THEN ASM SET_TAC[]);; + +let REAL_SUP_BOUNDS = prove + (`!s a b. ~(s = {}) /\ (!x. x IN s ==> a <= x /\ x <= b) + ==> a <= sup s /\ sup s <= b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `s:real->bool` SUP) THEN ANTS_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[REAL_LE_TRANS]);; + +let REAL_ABS_SUP_LE = prove + (`!s a. ~(s = {}) /\ (!x. x IN s ==> abs(x) <= a) ==> abs(sup s) <= a`, + REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_SUP_BOUNDS]);; + +let REAL_SUP_ASCLOSE = prove + (`!s l e. ~(s = {}) /\ (!x. x IN s ==> abs(x - l) <= e) + ==> abs(sup s - l) <= e`, + SIMP_TAC[REAL_ARITH `abs(x - l):real <= e <=> l - e <= x /\ x <= l + e`] THEN + REWRITE_TAC[REAL_SUP_BOUNDS]);; + +let inf = new_definition + `inf s = @a:real. (!x. x IN s ==> a <= x) /\ + !b. (!x. x IN s ==> b <= x) ==> b <= a`;; + +let INF_EQ = prove + (`!s t. (!a. (!x. x IN s ==> a <= x) <=> (!x. x IN t ==> a <= x)) + ==> inf s = inf t`, + SIMP_TAC[inf]);; + +let INF = prove + (`!s. ~(s = {}) /\ (?b. !x. x IN s ==> b <= x) + ==> (!x. x IN s ==> inf s <= x) /\ + !b. (!x. x IN s ==> b <= x) ==> b <= inf s`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[inf] THEN + CONV_TAC(ONCE_DEPTH_CONV SELECT_CONV) THEN + ONCE_REWRITE_TAC[GSYM REAL_LE_NEG2] THEN + EXISTS_TAC `--(sup (IMAGE (--) s))` THEN + MP_TAC(SPEC `IMAGE (--) (s:real->bool)` SUP) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + ABBREV_TAC `a = sup (IMAGE (--) s)` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_IMAGE] THEN + ASM_MESON_TAC[REAL_NEG_NEG; MEMBER_NOT_EMPTY; REAL_LE_NEG2]);; + +let INF_FINITE_LEMMA = prove + (`!s. FINITE s /\ ~(s = {}) ==> ?b:real. b IN s /\ !x. x IN s ==> b <= x`, + REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_INSERT_EMPTY; IN_INSERT] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[REAL_LE_TOTAL; REAL_LE_TRANS]);; + +let INF_FINITE = prove + (`!s. FINITE s /\ ~(s = {}) ==> (inf s) IN s /\ !x. x IN s ==> inf s <= x`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INF_FINITE_LEMMA) THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_TOTAL; INF]);; + +let REAL_LE_INF_FINITE = prove +(`!s a. FINITE s /\ ~(s = {}) ==> (a <= inf s <=> !x. x IN s ==> a <= x)`, + MESON_TAC[INF_FINITE; REAL_LE_TRANS]);; + +let REAL_INF_LE_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (inf s <= a <=> ?x. x IN s /\ x <= a)`, + MESON_TAC[INF_FINITE; REAL_LE_TRANS]);; + +let REAL_LT_INF_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (a < inf s <=> !x. x IN s ==> a < x)`, + MESON_TAC[INF_FINITE; REAL_LTE_TRANS]);; + +let REAL_INF_LT_FINITE = prove + (`!s a. FINITE s /\ ~(s = {}) ==> (inf s < a <=> ?x. x IN s /\ x < a)`, + MESON_TAC[INF_FINITE; REAL_LET_TRANS]);; + +let REAL_INF_UNIQUE = prove + (`!s b. (!x. x IN s ==> b <= x) /\ + (!b'. b < b' ==> ?x. x IN s /\ x < b') + ==> inf s = b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[inf] THEN MATCH_MP_TAC SELECT_UNIQUE THEN + ASM_MESON_TAC[REAL_NOT_LE; REAL_LE_ANTISYM]);; + +let REAL_LE_INF = prove + (`!b. ~(s = {}) /\ (!x. x IN s ==> b <= x) ==> b <= inf s`, + MESON_TAC[INF]);; + +let REAL_LE_INF_SUBSET = prove + (`!s t. ~(t = {}) /\ t SUBSET s /\ (?b. !x. x IN s ==> b <= x) + ==> inf s <= inf t`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN + MP_TAC(SPEC `s:real->bool` INF) THEN ASM SET_TAC[]);; + +let REAL_INF_BOUNDS = prove + (`!s a b. ~(s = {}) /\ (!x. x IN s ==> a <= x /\ x <= b) + ==> a <= inf s /\ inf s <= b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `s:real->bool` INF) THEN ANTS_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + ASM_MESON_TAC[REAL_LE_TRANS]);; + +let REAL_ABS_INF_LE = prove + (`!s a. ~(s = {}) /\ (!x. x IN s ==> abs(x) <= a) ==> abs(inf s) <= a`, + REWRITE_TAC[GSYM REAL_BOUNDS_LE; REAL_INF_BOUNDS]);; + +let REAL_INF_ASCLOSE = prove + (`!s l e. ~(s = {}) /\ (!x. x IN s ==> abs(x - l) <= e) + ==> abs(inf s - l) <= e`, + SIMP_TAC[REAL_ARITH `abs(x - l):real <= e <=> l - e <= x /\ x <= l + e`] THEN + REWRITE_TAC[REAL_INF_BOUNDS]);; + +let SUP_UNIQUE_FINITE = prove + (`!s. FINITE s /\ ~(s = {}) + ==> (sup s = a <=> a IN s /\ !y. y IN s ==> y <= a)`, + ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_SUP_FINITE; REAL_SUP_LE_FINITE; + NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_EMPTY] THEN + MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS; REAL_LE_ANTISYM]);; + +let INF_UNIQUE_FINITE = prove + (`!s. FINITE s /\ ~(s = {}) + ==> (inf s = a <=> a IN s /\ !y. y IN s ==> a <= y)`, + ASM_SIMP_TAC[GSYM REAL_LE_ANTISYM; REAL_LE_INF_FINITE; REAL_INF_LE_FINITE; + NOT_INSERT_EMPTY; FINITE_INSERT; FINITE_EMPTY] THEN + MESON_TAC[REAL_LE_REFL; REAL_LE_TRANS; REAL_LE_ANTISYM]);; + +let SUP_INSERT_FINITE = prove + (`!x s. FINITE s ==> sup(x INSERT s) = if s = {} then x else max x (sup s)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SUP_UNIQUE_FINITE; FINITE_INSERT; FINITE_EMPTY; + NOT_INSERT_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_SING; REAL_LE_REFL] THEN + REWRITE_TAC[real_max] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SUP_FINITE; IN_INSERT; REAL_LE_REFL] THEN + ASM_MESON_TAC[SUP_FINITE; REAL_LE_TOTAL; REAL_LE_TRANS]);; + +let SUP_SING = prove + (`!a. sup {a} = a`, + SIMP_TAC[SUP_INSERT_FINITE; FINITE_EMPTY]);; + +let INF_INSERT_FINITE = prove + (`!x s. FINITE s ==> inf(x INSERT s) = if s = {} then x else min x (inf s)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[INF_UNIQUE_FINITE; FINITE_INSERT; FINITE_EMPTY; + NOT_INSERT_EMPTY; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[IN_SING; REAL_LE_REFL] THEN + REWRITE_TAC[real_min] THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[INF_FINITE; IN_INSERT; REAL_LE_REFL] THEN + ASM_MESON_TAC[INF_FINITE; REAL_LE_TOTAL; REAL_LE_TRANS]);; + +let INF_SING = prove + (`!a. inf {a} = a`, + SIMP_TAC[INF_INSERT_FINITE; FINITE_EMPTY]);; + +let REAL_SUP_EQ_INF = prove + (`!s. ~(s = {}) /\ (?B. !x. x IN s ==> abs(x) <= B) + ==> (sup s = inf s <=> ?a. s = {a})`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `sup s` THEN MATCH_MP_TAC + (SET_RULE `~(s = {}) /\ (!x. x IN s ==> x = a) ==> s = {a}`) THEN + ASM_REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + ASM_MESON_TAC[SUP; REAL_ABS_BOUNDS; INF]; + STRIP_TAC THEN + ASM_SIMP_TAC[SUP_INSERT_FINITE; INF_INSERT_FINITE; FINITE_EMPTY]]);; + +let REAL_LE_SUP = prove + (`!s a b y. y IN s /\ a <= y /\ (!x. x IN s ==> x <= b) ==> a <= sup s`, + MESON_TAC[SUP; MEMBER_NOT_EMPTY; REAL_LE_TRANS]);; + +let REAL_INF_LE = prove + (`!s a b y. y IN s /\ y <= b /\ (!x. x IN s ==> a <= x) ==> inf s <= b`, + MESON_TAC[INF; MEMBER_NOT_EMPTY; REAL_LE_TRANS]);; + +let REAL_SUP_LE_EQ = prove + (`!s y. ~(s = {}) /\ (?b. !x. x IN s ==> x <= b) + ==> (sup s <= y <=> !x. x IN s ==> x <= y)`, + MESON_TAC[SUP; REAL_LE_TRANS]);; + +let REAL_LE_INF_EQ = prove + (`!s t. ~(s = {}) /\ (?b. !x. x IN s ==> b <= x) + ==> (y <= inf s <=> !x. x IN s ==> y <= x)`, + MESON_TAC[INF; REAL_LE_TRANS]);; + +let SUP_UNIQUE = prove + (`!s b. (!c. (!x. x IN s ==> x <= c) <=> b <= c) ==> sup s = b`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUP_SING] THEN + MATCH_MP_TAC SUP_EQ THEN ASM SET_TAC[]);; + +let INF_UNIQUE = prove + (`!s b. (!c. (!x. x IN s ==> c <= x) <=> c <= b) ==> inf s = b`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [GSYM INF_SING] THEN + MATCH_MP_TAC INF_EQ THEN ASM SET_TAC[]);; + +let SUP_UNION = prove + (`!s t. ~(s = {}) /\ ~(t = {}) /\ + (?b. !x. x IN s ==> x <= b) /\ (?c. !x. x IN t ==> x <= c) + ==> sup(s UNION t) = max (sup s) (sup t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUP_UNIQUE THEN + REWRITE_TAC[FORALL_IN_UNION; REAL_MAX_LE] THEN + ASM_MESON_TAC[SUP; REAL_LE_TRANS]);; + +let INF_UNION = prove + (`!s t. ~(s = {}) /\ ~(t = {}) /\ + (?b. !x. x IN s ==> b <= x) /\ (?c. !x. x IN t ==> c <= x) + ==> inf(s UNION t) = min (inf s) (inf t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INF_UNIQUE THEN + REWRITE_TAC[FORALL_IN_UNION; REAL_LE_MIN] THEN + ASM_MESON_TAC[INF; REAL_LE_TRANS]);; + +(* ------------------------------------------------------------------------- *) +(* Inductive definition of sets, by reducing them to inductive relations. *) +(* ------------------------------------------------------------------------- *) + +let new_inductive_set = + let const_of_var v = mk_mconst(name_of v,type_of v) in + let comb_all = + let rec f (n:int) (tm:term) : hol_type list -> term = function + | [] -> tm + | ty::tys -> + let v = variant (variables tm) (mk_var("x"^string_of_int n,ty)) in + f (n+1) (mk_comb(tm,v)) tys in + fun tm -> let tys = fst (splitlist dest_fun_ty (type_of tm)) in + f 0 tm tys in + let mk_eqin = REWR_CONV (GSYM IN) o comb_all in + let transf conv = rhs o concl o conv in + let remove_in_conv ptm : conv = + let rconv = REWR_CONV(SYM(mk_eqin ptm)) in + fun tm -> let htm = fst(strip_comb(snd(dest_binary "IN" tm))) in + if htm = ptm then rconv tm else fail() in + let remove_in_transf = + transf o ONCE_DEPTH_CONV o FIRST_CONV o map remove_in_conv in + let rule_head tm = + let tm = snd(strip_forall tm) in + let tm = snd(splitlist(dest_binop `(==>)`) tm) in + let tm = snd(dest_binary "IN" tm) in + fst(strip_comb tm) in + let find_pvars = setify o map rule_head o binops `(/\)` in + fun tm -> + let pvars = find_pvars tm in + let dtm = remove_in_transf pvars tm in + let th_rules, th_induct, th_cases = new_inductive_definition dtm in + let insert_in_rule = REWRITE_RULE(map (mk_eqin o const_of_var) pvars) in + insert_in_rule th_rules, + insert_in_rule th_induct, + insert_in_rule th_cases;; diff --git a/simp.ml b/simp.ml new file mode 100644 index 0000000..664e718 --- /dev/null +++ b/simp.ml @@ -0,0 +1,561 @@ +(* ========================================================================= *) +(* Simplification and rewriting. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "itab.ml";; + +(* ------------------------------------------------------------------------- *) +(* Generalized conversion (conversion plus a priority). *) +(* ------------------------------------------------------------------------- *) + +type gconv = int * conv;; + +(* ------------------------------------------------------------------------- *) +(* Primitive rewriting conversions: unconditional and conditional equations. *) +(* ------------------------------------------------------------------------- *) + +let REWR_CONV = PART_MATCH lhs;; + +let IMP_REWR_CONV = PART_MATCH (lhs o snd o dest_imp);; + +(* ------------------------------------------------------------------------- *) +(* Versions with ordered rewriting. We must have l' > r' for the rewrite *) +(* |- l = r (or |- c ==> (l = r)) to apply. *) +(* ------------------------------------------------------------------------- *) + +let ORDERED_REWR_CONV ord th = + let basic_conv = REWR_CONV th in + fun tm -> + let thm = basic_conv tm in + let l,r = dest_eq(concl thm) in + if ord l r then thm + else failwith "ORDERED_REWR_CONV: wrong orientation";; + +let ORDERED_IMP_REWR_CONV ord th = + let basic_conv = IMP_REWR_CONV th in + fun tm -> + let thm = basic_conv tm in + let l,r = dest_eq(rand(concl thm)) in + if ord l r then thm + else failwith "ORDERED_IMP_REWR_CONV: wrong orientation";; + +(* ------------------------------------------------------------------------- *) +(* Standard AC-compatible term ordering: a "dynamic" lexicographic ordering. *) +(* *) +(* This is a slight hack to make AC normalization work. However I *think* *) +(* it's properly AC compatible, i.e. monotonic and total, WF on ground terms *) +(* (over necessarily finite signature) and with the properties for any *) +(* binary operator +: *) +(* *) +(* (x + y) + z > x + (y + z) *) +(* x + y > y + x iff x > y *) +(* x + (y + z) > y + (x + z) iff x > y *) +(* *) +(* The idea is that when invoking lex ordering with identical head operator *) +(* "f", one sticks "f" at the head of an otherwise arbitrary ordering on *) +(* subterms (the built-in CAML one). This avoids the potentially inefficient *) +(* calculation of term size in the standard orderings. *) +(* ------------------------------------------------------------------------- *) + +let term_order = + let rec lexify ord l1 l2 = + if l1 = [] then false + else if l2 = [] then true else + let h1 = hd l1 and h2 = hd l2 in + ord h1 h2 or (h1 = h2 & lexify ord (tl l1) (tl l2)) in + let rec dyn_order top tm1 tm2 = + let f1,args1 = strip_comb tm1 + and f2,args2 = strip_comb tm2 in + if f1 = f2 then + lexify (dyn_order f1) args1 args2 + else + if f2 = top then false + else if f1 = top then true + else f1 > f2 in + dyn_order `T`;; + +(* ------------------------------------------------------------------------- *) +(* Create a gconv net for a theorem as a (cond) rewrite. The "rep" flag *) +(* will cause any trivially looping rewrites to be modified, and any that *) +(* are permutative to be ordered w.r.t. the standard order. The idea is that *) +(* this flag will be set iff the conversion is going to get repeated. *) +(* This includes a completely ad hoc but useful special case for ETA_AX, *) +(* which forces a first order match (otherwise it would loop on a lambda). *) +(* ------------------------------------------------------------------------- *) + +let net_of_thm rep th = + let tm = concl th in + let lconsts = freesl (hyp th) in + let matchable = can o term_match lconsts in + match tm with + Comb(Comb(Const("=",_),(Abs(x,Comb(Var(s,ty) as v,x')) as l)),v') + when x' = x & v' = v & not(x = v) -> + let conv tm = + match tm with + Abs(y,Comb(t,y')) when y = y' & not(free_in y t) -> + INSTANTIATE(term_match [] v t) th + | _ -> failwith "REWR_CONV (ETA_AX special case)" in + enter lconsts (l,(1,conv)) + | Comb(Comb(Const("=",_),l),r) -> + if rep & free_in l r then + let th' = EQT_INTRO th in + enter lconsts (l,(1,REWR_CONV th')) + else if rep & matchable l r & matchable r l then + enter lconsts (l,(1,ORDERED_REWR_CONV term_order th)) + else enter lconsts (l,(1,REWR_CONV th)) + | Comb(Comb(_,t),Comb(Comb(Const("=",_),l),r)) -> + if rep & free_in l r then + let th' = DISCH t (EQT_INTRO(UNDISCH th)) in + enter lconsts (l,(3,IMP_REWR_CONV th')) + else if rep & matchable l r & matchable r l then + enter lconsts (l,(3,ORDERED_IMP_REWR_CONV term_order th)) + else enter lconsts(l,(3,IMP_REWR_CONV th));; + +(* ------------------------------------------------------------------------- *) +(* Create a gconv net for a conversion with a term index. *) +(* ------------------------------------------------------------------------- *) + +let net_of_conv tm conv sofar = + enter [] (tm,(2,conv)) sofar;; + +(* ------------------------------------------------------------------------- *) +(* Create a gconv net for a congruence rule (in canonical form!) *) +(* ------------------------------------------------------------------------- *) + +let net_of_cong th sofar = + let conc,n = repeat (fun (tm,m) -> snd(dest_imp tm),m+1) (concl th,0) in + if n = 0 then failwith "net_of_cong: Non-implicational congruence" else + let pat = lhs conc in + let conv = GEN_PART_MATCH (lhand o funpow n rand) th in + enter [] (pat,(4,conv)) sofar;; + +(* ------------------------------------------------------------------------- *) +(* Rewrite maker for ordinary and conditional rewrites (via "cf" flag). *) +(* *) +(* We follow Don in going from ~(s = t) to (s = t) = F *and* (t = s) = F. *) +(* Well, why not? However, we don't abandon s = t where FV(t) is not a *) +(* subset of FV(s) in favour of (s = t) = T, as he does. *) +(* Note: looping rewrites are not discarded here, only when netted. *) +(* ------------------------------------------------------------------------- *) + +let mk_rewrites = + let IMP_CONJ_CONV = REWR_CONV(ITAUT `p ==> q ==> r <=> p /\ q ==> r`) + and IMP_EXISTS_RULE = + let cnv = REWR_CONV(ITAUT `(!x. P x ==> Q) <=> (?x. P x) ==> Q`) in + fun v th -> CONV_RULE cnv (GEN v th) in + let collect_condition oldhyps th = + let conds = subtract (hyp th) oldhyps in + if conds = [] then th else + let jth = itlist DISCH conds th in + let kth = CONV_RULE (REPEATC IMP_CONJ_CONV) jth in + let cond,eqn = dest_imp(concl kth) in + let fvs = subtract (subtract (frees cond) (frees eqn)) (freesl oldhyps) in + itlist IMP_EXISTS_RULE fvs kth in + let rec split_rewrites oldhyps cf th sofar = + let tm = concl th in + if is_forall tm then + split_rewrites oldhyps cf (SPEC_ALL th) sofar + else if is_conj tm then + split_rewrites oldhyps cf (CONJUNCT1 th) + (split_rewrites oldhyps cf (CONJUNCT2 th) sofar) + else if is_imp tm & cf then + split_rewrites oldhyps cf (UNDISCH th) sofar + else if is_eq tm then + (if cf then collect_condition oldhyps th else th)::sofar + else if is_neg tm then + let ths = split_rewrites oldhyps cf (EQF_INTRO th) sofar in + if is_eq (rand tm) + then split_rewrites oldhyps cf (EQF_INTRO (GSYM th)) ths + else ths + else + split_rewrites oldhyps cf (EQT_INTRO th) sofar in + fun cf th sofar -> split_rewrites (hyp th) cf th sofar;; + +(* ------------------------------------------------------------------------- *) +(* Rewriting (and application of other conversions) based on a convnet. *) +(* ------------------------------------------------------------------------- *) + +let REWRITES_CONV net tm = + let pconvs = lookup tm net in + try tryfind (fun (_,cnv) -> cnv tm) pconvs + with Failure _ -> failwith "REWRITES_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Decision procedures may accumulate their state in different ways (e.g. *) +(* term nets and predicate-indexed lists of Horn clauses). To allow mixing *) +(* of arbitrary types for state storage, we use a trick due to RJB via DRS. *) +(* ------------------------------------------------------------------------- *) + +type prover = Prover of conv * (thm list -> prover);; + +let mk_prover applicator augmentor = + let rec mk_prover state = + let apply = applicator state + and augment thms = mk_prover (augmentor state thms) in + Prover(apply,augment) in + mk_prover;; + +let augment(Prover(_,aug)) thms = aug thms;; + +let apply_prover(Prover(conv,_)) tm = conv tm;; + +(* ------------------------------------------------------------------------- *) +(* Type of simpsets. We have a convnet containing rewrites (implicational *) +(* and otherwise), other term-indexed context-free conversions like *) +(* BETA_CONV, and congruence rules. Then there is a list of provers that *) +(* have their own way of storing and using context, and finally a rewrite *) +(* maker function, to allow customization. *) +(* *) +(* We also have a type of (traversal) strategy, following Konrad. *) +(* ------------------------------------------------------------------------- *) + +type simpset = + Simpset of gconv net (* Rewrites & congruences *) + * (strategy -> strategy) (* Prover for conditions *) + * prover list (* Subprovers for prover *) + * (thm -> thm list -> thm list) (* Rewrite maker *) + +and strategy = simpset -> int -> term -> thm;; + +(* ------------------------------------------------------------------------- *) +(* Very simple prover: recursively simplify then try provers. *) +(* ------------------------------------------------------------------------- *) + +let basic_prover strat (Simpset(net,prover,provers,rewmaker) as ss) lev tm = + let sth = try strat ss lev tm with Failure _ -> REFL tm in + try EQT_ELIM sth + with Failure _ -> + let tth = tryfind (fun pr -> apply_prover pr (rand(concl sth))) provers in + EQ_MP (SYM sth) tth;; + +(* ------------------------------------------------------------------------- *) +(* Functions for changing or augmenting components of simpsets. *) +(* ------------------------------------------------------------------------- *) + +let ss_of_thms thms (Simpset(net,prover,provers,rewmaker)) = + let cthms = itlist rewmaker thms [] in + let net' = itlist (net_of_thm true) cthms net in + Simpset(net',prover,provers,rewmaker);; + +let ss_of_conv keytm conv (Simpset(net,prover,provers,rewmaker)) = + let net' = net_of_conv keytm conv net in + Simpset(net',prover,provers,rewmaker);; + +let ss_of_congs thms (Simpset(net,prover,provers,rewmaker)) = + let net' = itlist net_of_cong thms net in + Simpset(net',prover,provers,rewmaker);; + +let ss_of_prover newprover (Simpset(net,_,provers,rewmaker)) = + Simpset(net,newprover,provers,rewmaker);; + +let ss_of_provers newprovers (Simpset(net,prover,provers,rewmaker)) = + Simpset(net,prover,newprovers@provers,rewmaker);; + +let ss_of_maker newmaker (Simpset(net,prover,provers,_)) = + Simpset(net,prover,provers,newmaker);; + +(* ------------------------------------------------------------------------- *) +(* Perform a context-augmentation operation on a simpset. *) +(* ------------------------------------------------------------------------- *) + +let AUGMENT_SIMPSET cth (Simpset(net,prover,provers,rewmaker)) = + let provers' = map (C augment [cth]) provers in + let cthms = rewmaker cth [] in + let net' = itlist (net_of_thm true) cthms net in + Simpset(net',prover,provers',rewmaker);; + +(* ------------------------------------------------------------------------- *) +(* Depth conversions. *) +(* ------------------------------------------------------------------------- *) + +let ONCE_DEPTH_SQCONV,DEPTH_SQCONV,REDEPTH_SQCONV, + TOP_DEPTH_SQCONV,TOP_SWEEP_SQCONV = + let IMP_REWRITES_CONV strat (Simpset(net,prover,provers,rewmaker) as ss) lev + pconvs tm = + tryfind (fun (n,cnv) -> + if n >= 4 then fail() else + let th = cnv tm in + let etm = concl th in + if is_eq etm then th else + if lev <= 0 then failwith "IMP_REWRITES_CONV: Too deep" else + let cth = prover strat ss (lev-1) (lhand etm) in + MP th cth) pconvs in + let rec RUN_SUB_CONV strat ss lev triv th = + let tm = concl th in + if is_imp tm then + let subtm = lhand tm in + let avs,bod = strip_forall subtm in + let (t,t'),ss',mk_fun = + try dest_eq bod,ss,I with Failure _ -> + let cxt,deq = dest_imp bod in + dest_eq deq,AUGMENT_SIMPSET (ASSUME cxt) ss,DISCH cxt in + let eth,triv' = try strat ss' lev t,false with Failure _ -> REFL t,triv in + let eth' = GENL avs (mk_fun eth) in + let th' = if is_var t' then INST [rand(concl eth),t'] th + else GEN_PART_MATCH lhand th (concl eth') in + let th'' = MP th' eth' in + RUN_SUB_CONV strat ss lev triv' th'' + else if triv then fail() else th in + let GEN_SUB_CONV strat ss lev pconvs tm = + try tryfind (fun (n,cnv) -> + if n < 4 then fail() else + let th = cnv tm in + RUN_SUB_CONV strat ss lev true th) pconvs + with Failure _ -> + if is_comb tm then + let l,r = dest_comb tm in + try let th1 = strat ss lev l in + try let th2 = strat ss lev r in MK_COMB(th1,th2) + with Failure _ -> AP_THM th1 r + with Failure _ -> AP_TERM l (strat ss lev r) + else if is_abs tm then + let v,bod = dest_abs tm in + let th = strat ss lev bod in + try ABS v th with Failure _ -> + let gv = genvar(type_of v) in + let gbod = vsubst[gv,v] bod in + let gth = ABS gv (strat ss lev gbod) in + let gtm = concl gth in + let l,r = dest_eq gtm in + let v' = variant (frees gtm) v in + let l' = alpha v' l and r' = alpha v' r in + EQ_MP (ALPHA gtm (mk_eq(l',r'))) gth + else failwith "GEN_SUB_CONV" in + let rec ONCE_DEPTH_SQCONV + (Simpset(net,prover,provers,rewmaker) as ss) lev tm = + let pconvs = lookup tm net in + try IMP_REWRITES_CONV ONCE_DEPTH_SQCONV ss lev pconvs tm + with Failure _ -> + GEN_SUB_CONV ONCE_DEPTH_SQCONV ss lev pconvs tm in + let rec DEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = + let pconvs = lookup tm net in + try let th1 = GEN_SUB_CONV DEPTH_SQCONV ss lev pconvs tm in + let tm1 = rand(concl th1) in + let pconvs1 = lookup tm1 net in + try TRANS th1 (IMP_REWRITES_CONV DEPTH_SQCONV ss lev pconvs1 tm1) + with Failure _ -> th1 + with Failure _ -> + IMP_REWRITES_CONV DEPTH_SQCONV ss lev pconvs tm in + let rec REDEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = + let pconvs = lookup tm net in + let th = + try let th1 = GEN_SUB_CONV REDEPTH_SQCONV ss lev pconvs tm in + let tm1 = rand(concl th1) in + let pconvs1 = lookup tm1 net in + try TRANS th1 (IMP_REWRITES_CONV REDEPTH_SQCONV ss lev pconvs1 tm1) + with Failure _ -> th1 + with Failure _ -> + IMP_REWRITES_CONV REDEPTH_SQCONV ss lev pconvs tm in + try let th' = REDEPTH_SQCONV ss lev (rand(concl th)) in + TRANS th th' + with Failure _ -> th in + let rec TOP_DEPTH_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = + let pconvs = lookup tm net in + let th1 = + try IMP_REWRITES_CONV TOP_DEPTH_SQCONV ss lev pconvs tm + with Failure _ -> GEN_SUB_CONV TOP_DEPTH_SQCONV ss lev pconvs tm in + try let th2 = TOP_DEPTH_SQCONV ss lev (rand(concl th1)) in + TRANS th1 th2 + with Failure _ -> th1 in + let rec TOP_SWEEP_SQCONV (Simpset(net,prover,provers,rewmaker) as ss) lev tm = + let pconvs = lookup tm net in + try let th1 = IMP_REWRITES_CONV TOP_SWEEP_SQCONV ss lev pconvs tm in + try let th2 = TOP_SWEEP_SQCONV ss lev (rand(concl th1)) in + TRANS th1 th2 + with Failure _ -> th1 + with Failure _ -> GEN_SUB_CONV TOP_SWEEP_SQCONV ss lev pconvs tm in + ONCE_DEPTH_SQCONV,DEPTH_SQCONV,REDEPTH_SQCONV, + TOP_DEPTH_SQCONV,TOP_SWEEP_SQCONV;; + +(* ------------------------------------------------------------------------- *) +(* Maintenence of basic rewrites and conv nets for rewriting. *) +(* ------------------------------------------------------------------------- *) + +let set_basic_rewrites,extend_basic_rewrites,basic_rewrites, + set_basic_convs,extend_basic_convs,basic_convs,basic_net = + let rewrites = ref ([]:thm list) + and conversions = ref ([]:(string*(term*conv))list) + and conv_net = ref (empty_net: gconv net) in + let rehash_convnet() = + conv_net := itlist (net_of_thm true) (!rewrites) + (itlist (fun (_,(pat,cnv)) -> net_of_conv pat cnv) (!conversions) + empty_net) in + let set_basic_rewrites thl = + let canon_thl = itlist (mk_rewrites false) thl [] in + (rewrites := canon_thl; rehash_convnet()) + and extend_basic_rewrites thl = + let canon_thl = itlist (mk_rewrites false) thl [] in + (rewrites := canon_thl @ !rewrites; rehash_convnet()) + and basic_rewrites() = !rewrites + and set_basic_convs cnvs = + (conversions := cnvs; rehash_convnet()) + and extend_basic_convs (name,patcong) = + (conversions := + (name,patcong)::filter(fun (name',_) -> name <> name') (!conversions); + rehash_convnet()) + and basic_convs() = !conversions + and basic_net() = !conv_net in + set_basic_rewrites,extend_basic_rewrites,basic_rewrites, + set_basic_convs,extend_basic_convs,basic_convs,basic_net;; + +(* ------------------------------------------------------------------------- *) +(* Same thing for the default congruences. *) +(* ------------------------------------------------------------------------- *) + +let set_basic_congs,extend_basic_congs,basic_congs = + let congs = ref ([]:thm list) in + (fun thl -> congs := thl), + (fun thl -> congs := union' equals_thm thl (!congs)), + (fun () -> !congs);; + +(* ------------------------------------------------------------------------- *) +(* Main rewriting conversions. *) +(* ------------------------------------------------------------------------- *) + +let GENERAL_REWRITE_CONV rep (cnvl:conv->conv) (builtin_net:gconv net) thl = + let thl_canon = itlist (mk_rewrites false) thl [] in + let final_net = itlist (net_of_thm rep) thl_canon builtin_net in + cnvl (REWRITES_CONV final_net);; + +let GEN_REWRITE_CONV (cnvl:conv->conv) thl = + GENERAL_REWRITE_CONV false cnvl empty_net thl;; + +let PURE_REWRITE_CONV thl = + GENERAL_REWRITE_CONV true TOP_DEPTH_CONV empty_net thl;; + +let REWRITE_CONV thl = + GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net()) thl;; + +let PURE_ONCE_REWRITE_CONV thl = + GENERAL_REWRITE_CONV false ONCE_DEPTH_CONV empty_net thl;; + +let ONCE_REWRITE_CONV thl = + GENERAL_REWRITE_CONV false ONCE_DEPTH_CONV (basic_net()) thl;; + +(* ------------------------------------------------------------------------- *) +(* Rewriting rules and tactics. *) +(* ------------------------------------------------------------------------- *) + +let GEN_REWRITE_RULE cnvl thl = CONV_RULE(GEN_REWRITE_CONV cnvl thl);; + +let PURE_REWRITE_RULE thl = CONV_RULE(PURE_REWRITE_CONV thl);; + +let REWRITE_RULE thl = CONV_RULE(REWRITE_CONV thl);; + +let PURE_ONCE_REWRITE_RULE thl = CONV_RULE(PURE_ONCE_REWRITE_CONV thl);; + +let ONCE_REWRITE_RULE thl = CONV_RULE(ONCE_REWRITE_CONV thl);; + +let PURE_ASM_REWRITE_RULE thl th = + PURE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; + +let ASM_REWRITE_RULE thl th = + REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; + +let PURE_ONCE_ASM_REWRITE_RULE thl th = + PURE_ONCE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; + +let ONCE_ASM_REWRITE_RULE thl th = + ONCE_REWRITE_RULE ((map ASSUME (hyp th)) @ thl) th;; + +let GEN_REWRITE_TAC cnvl thl = CONV_TAC(GEN_REWRITE_CONV cnvl thl);; + +let PURE_REWRITE_TAC thl = CONV_TAC(PURE_REWRITE_CONV thl);; + +let REWRITE_TAC thl = CONV_TAC(REWRITE_CONV thl);; + +let PURE_ONCE_REWRITE_TAC thl = CONV_TAC(PURE_ONCE_REWRITE_CONV thl);; + +let ONCE_REWRITE_TAC thl = CONV_TAC(ONCE_REWRITE_CONV thl);; + +let (PURE_ASM_REWRITE_TAC: thm list -> tactic) = + ASM PURE_REWRITE_TAC;; + +let (ASM_REWRITE_TAC: thm list -> tactic) = + ASM REWRITE_TAC;; + +let (PURE_ONCE_ASM_REWRITE_TAC: thm list -> tactic) = + ASM PURE_ONCE_REWRITE_TAC;; + +let (ONCE_ASM_REWRITE_TAC: thm list -> tactic) = + ASM ONCE_REWRITE_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Simplification functions. *) +(* ------------------------------------------------------------------------- *) + +let GEN_SIMPLIFY_CONV (strat:strategy) ss lev thl = + let ss' = itlist AUGMENT_SIMPSET thl ss in + TRY_CONV (strat ss' lev);; + +let ONCE_SIMPLIFY_CONV ss = GEN_SIMPLIFY_CONV ONCE_DEPTH_SQCONV ss 1;; + +let SIMPLIFY_CONV ss = GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV ss 3;; + +(* ------------------------------------------------------------------------- *) +(* Simple but useful default version. *) +(* ------------------------------------------------------------------------- *) + +let empty_ss = Simpset(empty_net,basic_prover,[],mk_rewrites true);; + +let basic_ss = + let rewmaker = mk_rewrites true in + fun thl -> + let cthms = itlist rewmaker thl [] in + let net' = itlist (net_of_thm true) cthms (basic_net()) in + let net'' = itlist net_of_cong (basic_congs()) net' in + Simpset(net'',basic_prover,[],rewmaker);; + +let SIMP_CONV thl = SIMPLIFY_CONV (basic_ss []) thl;; + +let PURE_SIMP_CONV thl = SIMPLIFY_CONV empty_ss thl;; + +let ONCE_SIMP_CONV thl = ONCE_SIMPLIFY_CONV (basic_ss []) thl;; + +let SIMP_RULE thl = CONV_RULE(SIMP_CONV thl);; + +let PURE_SIMP_RULE thl = CONV_RULE(PURE_SIMP_CONV thl);; + +let ONCE_SIMP_RULE thl = CONV_RULE(ONCE_SIMP_CONV thl);; + +let SIMP_TAC thl = CONV_TAC(SIMP_CONV thl);; + +let PURE_SIMP_TAC thl = CONV_TAC(PURE_SIMP_CONV thl);; + +let ONCE_SIMP_TAC thl = CONV_TAC(ONCE_SIMP_CONV thl);; + +let ASM_SIMP_TAC = ASM SIMP_TAC;; + +let PURE_ASM_SIMP_TAC = ASM PURE_SIMP_TAC;; + +let ONCE_ASM_SIMP_TAC = ASM ONCE_SIMP_TAC;; + +(* ------------------------------------------------------------------------- *) +(* Abbreviation tactics. *) +(* ------------------------------------------------------------------------- *) + +let ABBREV_TAC tm = + let cvs,t = dest_eq tm in + let v,vs = strip_comb cvs in + let rs = list_mk_abs(vs,t) in + let eq = mk_eq(rs,v) in + let th1 = itlist (fun v th -> CONV_RULE(LAND_CONV BETA_CONV) (AP_THM th v)) + (rev vs) (ASSUME eq) in + let th2 = SIMPLE_CHOOSE v (SIMPLE_EXISTS v (GENL vs th1)) in + let th3 = PROVE_HYP (EXISTS(mk_exists(v,eq),rs) (REFL rs)) th2 in + fun (asl,w as gl) -> + let avoids = itlist (union o frees o concl o snd) asl (frees w) in + if mem v avoids then failwith "ABBREV_TAC: variable already used" else + CHOOSE_THEN + (fun th -> RULE_ASSUM_TAC(PURE_ONCE_REWRITE_RULE[th]) THEN + PURE_ONCE_REWRITE_TAC[th] THEN + ASSUME_TAC th) + th3 gl;; + +let EXPAND_TAC s = FIRST_ASSUM(SUBST1_TAC o SYM o + check((=) s o fst o dest_var o rhs o concl)) THEN BETA_TAC;; diff --git a/system.ml b/system.ml new file mode 100644 index 0000000..6c97770 --- /dev/null +++ b/system.ml @@ -0,0 +1,50 @@ +(* ========================================================================= *) +(* Some miscellaneous OCaml system hacking before we get started. *) +(* *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +Gc.set { (Gc.get()) with Gc.stack_limit = 16777216 };; + +(* ------------------------------------------------------------------------- *) +(* Make sure user interrupts generate an exception, not kill the process. *) +(* ------------------------------------------------------------------------- *) + +Sys.catch_break true;; + +(* ------------------------------------------------------------------------- *) +(* Set up a quotation expander for the `...` quotes. *) +(* This includes the case `;...` to support miz3, even if that isn't loaded. *) +(* ------------------------------------------------------------------------- *) + +let quotexpander s = + if s = "" then failwith "Empty quotation" else + let c = String.sub s 0 1 in + if c = ":" then + "parse_type \""^ + (String.escaped (String.sub s 1 (String.length s - 1)))^"\"" + else if c = ";" then "parse_qproof \""^(String.escaped s)^"\"" + else "parse_term \""^(String.escaped s)^"\"";; + +Quotation.add "tot" (Quotation.ExStr (fun x -> quotexpander));; + +(* ------------------------------------------------------------------------- *) +(* Modify the lexical analysis of uppercase identifiers. *) +(* ------------------------------------------------------------------------- *) + +set_jrh_lexer;; + +(* ------------------------------------------------------------------------- *) +(* Load in the bignum library and set up printing in the toplevel. *) +(* ------------------------------------------------------------------------- *) + +#load "nums.cma";; + +include Num;; + +let print_num n = + Format.open_hbox(); + Format.print_string(string_of_num n); + Format.close_box();; + +#install_printer print_num;; diff --git a/tactics.ml b/tactics.ml new file mode 100644 index 0000000..a89699c --- /dev/null +++ b/tactics.ml @@ -0,0 +1,925 @@ +(* ========================================================================= *) +(* System of tactics (slightly different from any traditional LCF method). *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* (c) Copyright, Marco Maggesi 2012 *) +(* ========================================================================= *) + +needs "drule.ml";; + +(* ------------------------------------------------------------------------- *) +(* The common case of trivial instantiations. *) +(* ------------------------------------------------------------------------- *) + +let null_inst = ([],[],[] :instantiation);; + +let null_meta = (([]:term list),null_inst);; + +(* ------------------------------------------------------------------------- *) +(* A goal has labelled assumptions, and the hyps are now thms. *) +(* ------------------------------------------------------------------------- *) + +type goal = (string * thm) list * term;; + +let equals_goal ((a,w):goal) ((a',w'):goal) = + forall2 (fun (s,th) (s',th') -> s = s' & equals_thm th th') a a' & w = w';; + +(* ------------------------------------------------------------------------- *) +(* A justification function for a goalstate [A1 ?- g1; ...; An ?- gn], *) +(* starting from an initial goal A ?- g, is a function f such that for any *) +(* instantiation @: *) +(* *) +(* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A@ |- g@ *) +(* ------------------------------------------------------------------------- *) + +type justification = instantiation -> thm list -> thm;; + +(* ------------------------------------------------------------------------- *) +(* The goalstate stores the subgoals, justification, current instantiation, *) +(* and a list of metavariables. *) +(* ------------------------------------------------------------------------- *) + +type goalstate = (term list * instantiation) * goal list * justification;; + +(* ------------------------------------------------------------------------- *) +(* A goalstack is just a list of goalstates. Could go for more... *) +(* ------------------------------------------------------------------------- *) + +type goalstack = goalstate list;; + +(* ------------------------------------------------------------------------- *) +(* A refinement, applied to a goalstate [A1 ?- g1; ...; An ?- gn] *) +(* yields a new goalstate with updated justification function, to *) +(* give a possibly-more-instantiated version of the initial goal. *) +(* ------------------------------------------------------------------------- *) + +type refinement = goalstate -> goalstate;; + +(* ------------------------------------------------------------------------- *) +(* A tactic, applied to a goal A ?- g, returns: *) +(* *) +(* o A list of new metavariables introduced *) +(* o An instantiation (%) *) +(* o A list of subgoals *) +(* o A justification f such that for any instantiation @ we have *) +(* f(@) [A1@ |- g1@; ...; An@ |- gn@] = A(%;@) |- g(%;@) *) +(* ------------------------------------------------------------------------- *) + +type tactic = goal -> goalstate;; + +type thm_tactic = thm -> tactic;; + +type thm_tactical = thm_tactic -> thm_tactic;; + +(* ------------------------------------------------------------------------- *) +(* Apply instantiation to a goal. *) +(* ------------------------------------------------------------------------- *) + +let (inst_goal:instantiation->goal->goal) = + fun p (thms,w) -> + map (I F_F INSTANTIATE_ALL p) thms,instantiate p w;; + +(* ------------------------------------------------------------------------- *) +(* Perform a sequential composition (left first) of instantiations. *) +(* ------------------------------------------------------------------------- *) + +let (compose_insts :instantiation->instantiation->instantiation) = + fun (pats1,tmin1,tyin1) ((pats2,tmin2,tyin2) as i2) -> + let tmin = map (instantiate i2 F_F inst tyin2) tmin1 + and tyin = map (type_subst tyin2 F_F I) tyin1 in + let tmin' = filter (fun (_,x) -> not (can (rev_assoc x) tmin)) tmin2 + and tyin' = filter (fun (_,a) -> not (can (rev_assoc a) tyin)) tyin2 in + pats1@pats2,tmin@tmin',tyin@tyin';; + +(* ------------------------------------------------------------------------- *) +(* Construct A,_FALSITY_ |- p; contortion so falsity is the last element. *) +(* ------------------------------------------------------------------------- *) + +let _FALSITY_ = new_definition `_FALSITY_ = F`;; + +let mk_fthm = + let pth = UNDISCH(fst(EQ_IMP_RULE _FALSITY_)) + and qth = ASSUME `_FALSITY_` in + fun (asl,c) -> PROVE_HYP qth (itlist ADD_ASSUM (rev asl) (CONTR c pth));; + +(* ------------------------------------------------------------------------- *) +(* Validity checking of tactics. This cannot be 100% accurate without making *) +(* arbitrary theorems, but "mk_fthm" brings us quite close. *) +(* ------------------------------------------------------------------------- *) + +let (VALID:tactic->tactic) = + let fake_thm (asl,w) = + let asms = itlist (union o hyp o snd) asl [] in + mk_fthm(asms,w) + and false_tm = `_FALSITY_` in + fun tac (asl,w) -> + let ((mvs,i),gls,just as res) = tac (asl,w) in + let ths = map fake_thm gls in + let asl',w' = dest_thm(just null_inst ths) in + let asl'',w'' = inst_goal i (asl,w) in + let maxasms = + itlist (fun (_,th) -> union (insert (concl th) (hyp th))) asl'' [] in + if aconv w' w'' & + forall (fun t -> exists (aconv t) maxasms) (subtract asl' [false_tm]) + then res else failwith "VALID: Invalid tactic";; + +(* ------------------------------------------------------------------------- *) +(* Various simple combinators for tactics, identity tactic etc. *) +(* ------------------------------------------------------------------------- *) + +let (THEN),(THENL) = + let propagate_empty i [] = [] + and propagate_thm th i [] = INSTANTIATE_ALL i th in + let compose_justs n just1 just2 i ths = + let ths1,ths2 = chop_list n ths in + (just1 i ths1)::(just2 i ths2) in + let rec seqapply l1 l2 = match (l1,l2) with + ([],[]) -> null_meta,[],propagate_empty + | ((tac:tactic)::tacs),((goal:goal)::goals) -> + let ((mvs1,insts1),gls1,just1) = tac goal in + let goals' = map (inst_goal insts1) goals in + let ((mvs2,insts2),gls2,just2) = seqapply tacs goals' in + ((union mvs1 mvs2,compose_insts insts1 insts2), + gls1@gls2,compose_justs (length gls1) just1 just2) + | _,_ -> failwith "seqapply: Length mismatch" in + let justsequence just1 just2 insts2 i ths = + just1 (compose_insts insts2 i) (just2 i ths) in + let tacsequence ((mvs1,insts1),gls1,just1) tacl = + let ((mvs2,insts2),gls2,just2) = seqapply tacl gls1 in + let jst = justsequence just1 just2 insts2 in + let just = if gls2 = [] then propagate_thm (jst null_inst []) else jst in + ((union mvs1 mvs2,compose_insts insts1 insts2),gls2,just) in + let (then_: tactic -> tactic -> tactic) = + fun tac1 tac2 g -> + let _,gls,_ as gstate = tac1 g in + tacsequence gstate (replicate tac2 (length gls)) + and (thenl_: tactic -> tactic list -> tactic) = + fun tac1 tac2l g -> + let _,gls,_ as gstate = tac1 g in + if gls = [] then tacsequence gstate [] + else tacsequence gstate tac2l in + then_,thenl_;; + +let ((ORELSE): tactic -> tactic -> tactic) = + fun tac1 tac2 g -> + try tac1 g with Failure _ -> tac2 g;; + +let (FAIL_TAC: string -> tactic) = + fun tok g -> failwith tok;; + +let (NO_TAC: tactic) = + FAIL_TAC "NO_TAC";; + +let (ALL_TAC:tactic) = + fun g -> null_meta,[g],fun _ [th] -> th;; + +let TRY tac = + tac ORELSE ALL_TAC;; + +let rec REPEAT tac g = + ((tac THEN REPEAT tac) ORELSE ALL_TAC) g;; + +let EVERY tacl = + itlist (fun t1 t2 -> t1 THEN t2) tacl ALL_TAC;; + +let (FIRST: tactic list -> tactic) = + fun tacl g -> end_itlist (fun t1 t2 -> t1 ORELSE t2) tacl g;; + +let MAP_EVERY tacf lst = + EVERY (map tacf lst);; + +let MAP_FIRST tacf lst = + FIRST (map tacf lst);; + +let (CHANGED_TAC: tactic -> tactic) = + fun tac g -> + let (meta,gl,_ as gstate) = tac g in + if meta = null_meta & length gl = 1 & equals_goal (hd gl) g + then failwith "CHANGED_TAC" else gstate;; + +let rec REPLICATE_TAC n tac = + if n <= 0 then ALL_TAC else tac THEN (REPLICATE_TAC (n - 1) tac);; + +(* ------------------------------------------------------------------------- *) +(* Combinators for theorem continuations / "theorem tacticals". *) +(* ------------------------------------------------------------------------- *) + +let ((THEN_TCL): thm_tactical -> thm_tactical -> thm_tactical) = + fun ttcl1 ttcl2 ttac -> ttcl1 (ttcl2 ttac);; + +let ((ORELSE_TCL): thm_tactical -> thm_tactical -> thm_tactical) = + fun ttcl1 ttcl2 ttac th -> + try ttcl1 ttac th with Failure _ -> ttcl2 ttac th;; + +let rec REPEAT_TCL ttcl ttac th = + ((ttcl THEN_TCL (REPEAT_TCL ttcl)) ORELSE_TCL I) ttac th;; + +let (REPEAT_GTCL: thm_tactical -> thm_tactical) = + let rec REPEAT_GTCL ttcl ttac th g = + try ttcl (REPEAT_GTCL ttcl ttac) th g with Failure _ -> ttac th g in + REPEAT_GTCL;; + +let (ALL_THEN: thm_tactical) = + I;; + +let (NO_THEN: thm_tactical) = + fun ttac th -> failwith "NO_THEN";; + +let EVERY_TCL ttcll = + itlist (fun t1 t2 -> t1 THEN_TCL t2) ttcll ALL_THEN;; + +let FIRST_TCL ttcll = + end_itlist (fun t1 t2 -> t1 ORELSE_TCL t2) ttcll;; + +(* ------------------------------------------------------------------------- *) +(* Tactics to augment assumption list. Note that to allow "ASSUME p" for *) +(* any assumption "p", these add a PROVE_HYP in the justification function, *) +(* just in case. *) +(* ------------------------------------------------------------------------- *) + +let (LABEL_TAC: string -> thm_tactic) = + fun s thm (asl,w) -> + null_meta,[(s,thm)::asl,w], + fun i [th] -> PROVE_HYP (INSTANTIATE_ALL i thm) th;; + +let ASSUME_TAC = LABEL_TAC "";; + +(* ------------------------------------------------------------------------- *) +(* Manipulation of assumption list. *) +(* ------------------------------------------------------------------------- *) + +let (FIND_ASSUM: thm_tactic -> term -> tactic) = + fun ttac t ((asl,w) as g) -> + ttac(snd(find (fun (_,th) -> concl th = t) asl)) g;; + +let (POP_ASSUM: thm_tactic -> tactic) = + fun ttac -> + function (((_,th)::asl),w) -> ttac th (asl,w) + | _ -> failwith "POP_ASSUM: No assumption to pop";; + +let (ASSUM_LIST: (thm list -> tactic) -> tactic) = + fun aslfun (asl,w) -> aslfun (map snd asl) (asl,w);; + +let (POP_ASSUM_LIST: (thm list -> tactic) -> tactic) = + fun asltac (asl,w) -> asltac (map snd asl) ([],w);; + +let (EVERY_ASSUM: thm_tactic -> tactic) = + fun ttac -> ASSUM_LIST (MAP_EVERY ttac);; + +let (FIRST_ASSUM: thm_tactic -> tactic) = + fun ttac (asl,w as g) -> tryfind (fun (_,th) -> ttac th g) asl;; + +let (RULE_ASSUM_TAC :(thm->thm)->tactic) = + fun rule (asl,w) -> (POP_ASSUM_LIST(K ALL_TAC) THEN + MAP_EVERY (fun (s,th) -> LABEL_TAC s (rule th)) + (rev asl)) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Operate on assumption identified by a label. *) +(* ------------------------------------------------------------------------- *) + +let (USE_THEN:string->thm_tactic->tactic) = + fun s ttac (asl,w as gl) -> + let th = try assoc s asl with Failure _ -> + failwith("USE_TAC: didn't find assumption "^s) in + ttac th gl;; + +let (REMOVE_THEN:string->thm_tactic->tactic) = + fun s ttac (asl,w) -> + let th = try assoc s asl with Failure _ -> + failwith("USE_TAC: didn't find assumption "^s) in + let asl1,asl2 = chop_list(index s (map fst asl)) asl in + let asl' = asl1 @ tl asl2 in + ttac th (asl',w);; + +(* ------------------------------------------------------------------------- *) +(* General tools to augment a required set of theorems with assumptions. *) +(* Here ASM uses all current hypotheses of the goal, while HYP uses only *) +(* those whose labels are given in the string argument. *) +(* ------------------------------------------------------------------------- *) + +let (ASM :(thm list -> tactic)->(thm list -> tactic)) = + fun tltac ths (asl,w as g) -> tltac (map snd asl @ ths) g;; + +let HYP = + let ident = function + Ident s::rest when isalnum s -> s,rest + | _ -> raise Noparse in + let parse_using = many ident in + let HYP_LIST tac l = + rev_itlist (fun s k l -> USE_THEN s (fun th -> k (th::l))) l tac in + fun tac s -> + let l,rest = (fix "Using pattern" parse_using o lex o explode) s in + if rest=[] then HYP_LIST tac l else failwith "Invalid using pattern";; + +(* ------------------------------------------------------------------------- *) +(* Basic tactic to use a theorem equal to the goal. Does *no* matching. *) +(* ------------------------------------------------------------------------- *) + +let (ACCEPT_TAC: thm_tactic) = + let propagate_thm th i [] = INSTANTIATE_ALL i th in + fun th (asl,w) -> + if aconv (concl th) w then + null_meta,[],propagate_thm th + else failwith "ACCEPT_TAC";; + +(* ------------------------------------------------------------------------- *) +(* Create tactic from a conversion. This allows the conversion to return *) +(* |- p rather than |- p = T on a term "p". It also eliminates any goals of *) +(* the form "T" automatically. *) +(* ------------------------------------------------------------------------- *) + +let (CONV_TAC: conv -> tactic) = + let t_tm = `T` in + fun conv ((asl,w) as g) -> + let th = conv w in + let tm = concl th in + if aconv tm w then ACCEPT_TAC th g else + let l,r = dest_eq tm in + if not(aconv l w) then failwith "CONV_TAC: bad equation" else + if r = t_tm then ACCEPT_TAC(EQT_ELIM th) g else + let th' = SYM th in + null_meta,[asl,r],fun i [th] -> EQ_MP (INSTANTIATE_ALL i th') th;; + +(* ------------------------------------------------------------------------- *) +(* Tactics for equality reasoning. *) +(* ------------------------------------------------------------------------- *) + +let (REFL_TAC: tactic) = + fun ((asl,w) as g) -> + try ACCEPT_TAC(REFL(rand w)) g + with Failure _ -> failwith "REFL_TAC";; + +let (ABS_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_eq w in + let lv,lb = dest_abs l + and rv,rb = dest_abs r in + let avoids = itlist (union o thm_frees o snd) asl (frees w) in + let v = mk_primed_var avoids lv in + null_meta,[asl,mk_eq(vsubst[v,lv] lb,vsubst[v,rv] rb)], + fun i [th] -> let ath = ABS v th in + EQ_MP (ALPHA (concl ath) (instantiate i w)) ath + with Failure _ -> failwith "ABS_TAC";; + +let (MK_COMB_TAC: tactic) = + fun (asl,gl) -> + try let l,r = dest_eq gl in + let f,x = dest_comb l + and g,y = dest_comb r in + null_meta,[asl,mk_eq(f,g); asl,mk_eq(x,y)], + fun _ [th1;th2] -> MK_COMB(th1,th2) + with Failure _ -> failwith "MK_COMB_TAC";; + +let (AP_TERM_TAC: tactic) = + let tac = MK_COMB_TAC THENL [REFL_TAC; ALL_TAC] in + fun gl -> try tac gl with Failure _ -> failwith "AP_TERM_TAC";; + +let (AP_THM_TAC: tactic) = + let tac = MK_COMB_TAC THENL [ALL_TAC; REFL_TAC] in + fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; + +let (BINOP_TAC: tactic) = + let tac = MK_COMB_TAC THENL [AP_TERM_TAC; ALL_TAC] in + fun gl -> try tac gl with Failure _ -> failwith "AP_THM_TAC";; + +let (SUBST1_TAC: thm_tactic) = + fun th -> CONV_TAC(SUBS_CONV [th]);; + +let SUBST_ALL_TAC rth = + SUBST1_TAC rth THEN RULE_ASSUM_TAC (SUBS [rth]);; + +let BETA_TAC = CONV_TAC(REDEPTH_CONV BETA_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Just use an equation to substitute if possible and uninstantiable. *) +(* ------------------------------------------------------------------------- *) + +let SUBST_VAR_TAC th = + try let asm,eq = dest_thm th in + let l,r = dest_eq eq in + if aconv l r then ALL_TAC + else if not (subset (frees eq) (freesl asm)) then fail() + else if (is_const l or is_var l) & not(free_in l r) + then SUBST_ALL_TAC th + else if (is_const r or is_var r) & not(free_in r l) + then SUBST_ALL_TAC(SYM th) + else fail() + with Failure _ -> failwith "SUBST_VAR_TAC";; + +(* ------------------------------------------------------------------------- *) +(* Basic logical tactics. *) +(* ------------------------------------------------------------------------- *) + +let (DISCH_TAC: tactic) = + let f_tm = `F` in + fun (asl,w) -> + try let ant,c = dest_imp w in + let th1 = ASSUME ant in + null_meta,[("",th1)::asl,c], + fun i [th] -> DISCH (instantiate i ant) th + with Failure _ -> try + let ant = dest_neg w in + let th1 = ASSUME ant in + null_meta,[("",th1)::asl,f_tm], + fun i [th] -> NOT_INTRO(DISCH (instantiate i ant) th) + with Failure _ -> failwith "DISCH_TAC";; + +let (MP_TAC: thm_tactic) = + fun thm (asl,w) -> + null_meta,[asl,mk_imp(concl thm,w)], + fun i [th] -> MP th (INSTANTIATE_ALL i thm);; + +let (EQ_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_eq w in + null_meta,[asl, mk_imp(l,r); asl, mk_imp(r,l)], + fun _ [th1; th2] -> IMP_ANTISYM_RULE th1 th2 + with Failure _ -> failwith "EQ_TAC";; + +let (UNDISCH_TAC: term -> tactic) = + fun tm (asl,w) -> + try let sthm,asl' = remove (fun (_,asm) -> aconv (concl asm) tm) asl in + let thm = snd sthm in + null_meta,[asl',mk_imp(tm,w)], + fun i [th] -> MP th (INSTANTIATE_ALL i thm) + with Failure _ -> failwith "UNDISCH_TAC";; + +let (SPEC_TAC: term * term -> tactic) = + fun (t,x) (asl,w) -> + try null_meta,[asl, mk_forall(x,subst[x,t] w)], + fun i [th] -> SPEC (instantiate i t) th + with Failure _ -> failwith "SPEC_TAC";; + +let (X_GEN_TAC: term -> tactic), + (X_CHOOSE_TAC: term -> thm_tactic), + (EXISTS_TAC: term -> tactic) = + let tactic_type_compatibility_check pfx e g = + let et = type_of e and gt = type_of g in + if et = gt then () + else failwith(pfx ^ ": expected type :"^string_of_type et^" but got :"^ + string_of_type gt) in + let X_GEN_TAC x' = + if not(is_var x') then failwith "X_GEN_TAC: not a variable" else + fun (asl,w) -> + let x,bod = try dest_forall w + with Failure _ -> failwith "X_GEN_TAC: Not universally quantified" in + let _ = tactic_type_compatibility_check "X_GEN_TAC" x x' in + let avoids = itlist (union o thm_frees o snd) asl (frees w) in + if mem x' avoids then failwith "X_GEN_TAC: invalid variable" else + let afn = CONV_RULE(GEN_ALPHA_CONV x) in + null_meta,[asl,vsubst[x',x] bod], + fun i [th] -> afn (GEN x' th) + and X_CHOOSE_TAC x' xth = + let xtm = concl xth in + let x,bod = try dest_exists xtm + with Failure _ -> failwith "X_CHOOSE_TAC: not existential" in + let _ = tactic_type_compatibility_check "X_CHOOSE_TAC" x x' in + let pat = vsubst[x',x] bod in + let xth' = ASSUME pat in + fun (asl,w) -> + let avoids = itlist (union o frees o concl o snd) asl + (union (frees w) (thm_frees xth)) in + if mem x' avoids then failwith "X_CHOOSE_TAC: invalid variable" else + null_meta,[("",xth')::asl,w], + fun i [th] -> CHOOSE(x',INSTANTIATE_ALL i xth) th + and EXISTS_TAC t (asl,w) = + let v,bod = try dest_exists w with Failure _ -> + failwith "EXISTS_TAC: Goal not existentially quantified" in + let _ = tactic_type_compatibility_check "EXISTS_TAC" v t in + null_meta,[asl,vsubst[t,v] bod], + fun i [th] -> EXISTS (instantiate i w,instantiate i t) th in + X_GEN_TAC,X_CHOOSE_TAC,EXISTS_TAC;; + +let (GEN_TAC: tactic) = + fun (asl,w) -> + try let x = fst(dest_forall w) in + let avoids = itlist (union o thm_frees o snd) asl (frees w) in + let x' = mk_primed_var avoids x in + X_GEN_TAC x' (asl,w) + with Failure _ -> failwith "GEN_TAC";; + +let (CHOOSE_TAC: thm_tactic) = + fun xth -> + try let x = fst(dest_exists(concl xth)) in + fun (asl,w) -> + let avoids = itlist (union o thm_frees o snd) asl + (union (frees w) (thm_frees xth)) in + let x' = mk_primed_var avoids x in + X_CHOOSE_TAC x' xth (asl,w) + with Failure _ -> failwith "CHOOSE_TAC";; + +let (CONJ_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_conj w in + null_meta,[asl,l; asl,r],fun _ [th1;th2] -> CONJ th1 th2 + with Failure _ -> failwith "CONJ_TAC";; + +let (DISJ1_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_disj w in + null_meta,[asl,l],fun i [th] -> DISJ1 th (instantiate i r) + with Failure _ -> failwith "DISJ1_TAC";; + +let (DISJ2_TAC: tactic) = + fun (asl,w) -> + try let l,r = dest_disj w in + null_meta,[asl,r],fun i [th] -> DISJ2 (instantiate i l) th + with Failure _ -> failwith "DISJ2_TAC";; + +let (DISJ_CASES_TAC: thm_tactic) = + fun dth -> + try let dtm = concl dth in + let l,r = dest_disj dtm in + let thl = ASSUME l + and thr = ASSUME r in + fun (asl,w) -> + null_meta,[("",thl)::asl,w; ("",thr)::asl,w], + fun i [th1;th2] -> DISJ_CASES (INSTANTIATE_ALL i dth) th1 th2 + with Failure _ -> failwith "DISJ_CASES_TAC";; + +let (CONTR_TAC: thm_tactic) = + let propagate_thm th i [] = INSTANTIATE_ALL i th in + fun cth (asl,w) -> + try let th = CONTR w cth in + null_meta,[],propagate_thm th + with Failure _ -> failwith "CONTR_TAC";; + +let (MATCH_ACCEPT_TAC:thm_tactic) = + let propagate_thm th i [] = INSTANTIATE_ALL i th in + let rawtac th (asl,w) = + try let ith = PART_MATCH I th w in + null_meta,[],propagate_thm ith + with Failure _ -> failwith "ACCEPT_TAC" in + fun th -> REPEAT GEN_TAC THEN rawtac th;; + +let (MATCH_MP_TAC :thm_tactic) = + fun th -> + let sth = + try let tm = concl th in + let avs,bod = strip_forall tm in + let ant,con = dest_imp bod in + let th1 = SPECL avs (ASSUME tm) in + let th2 = UNDISCH th1 in + let evs = filter (fun v -> vfree_in v ant & not (vfree_in v con)) + avs in + let th3 = itlist SIMPLE_CHOOSE evs (DISCH tm th2) in + let tm3 = hd(hyp th3) in + MP (DISCH tm (GEN_ALL (DISCH tm3 (UNDISCH th3)))) th + with Failure _ -> failwith "MATCH_MP_TAC: Bad theorem" in + let match_fun = PART_MATCH (snd o dest_imp) sth in + fun (asl,w) -> try let xth = match_fun w in + let lant = fst(dest_imp(concl xth)) in + null_meta,[asl,lant], + fun i [th] -> MP (INSTANTIATE_ALL i xth) th + with Failure _ -> failwith "MATCH_MP_TAC: No match";; + +let (TRANS_TAC:thm->term->tactic) = + fun th -> + let ctm = snd(strip_forall(concl th)) in + let cl,cr = dest_conj(lhand ctm) in + let x = lhand cl and y = rand cl and z = rand cr in + fun tm (asl,w as gl) -> + let lop,r = dest_comb w in + let op,l = dest_comb lop in + let ilist = + itlist2 type_match (map type_of [x;y;z])(map type_of [l;tm;r]) [] in + let th' = INST_TYPE ilist th in + (MATCH_MP_TAC th' THEN EXISTS_TAC tm) gl;; + +(* ------------------------------------------------------------------------- *) +(* Theorem continuations. *) +(* ------------------------------------------------------------------------- *) + +let (CONJUNCTS_THEN2:thm_tactic->thm_tactic->thm_tactic) = + fun ttac1 ttac2 cth -> + let c1,c2 = dest_conj(concl cth) in + fun gl -> let ti,gls,jfn = (ttac1(ASSUME c1) THEN ttac2(ASSUME c2)) gl in + let jfn' i ths = + let th1,th2 = CONJ_PAIR(INSTANTIATE_ALL i cth) in + PROVE_HYP th1 (PROVE_HYP th2 (jfn i ths)) in + ti,gls,jfn';; + +let (CONJUNCTS_THEN: thm_tactical) = + W CONJUNCTS_THEN2;; + +let (DISJ_CASES_THEN2:thm_tactic->thm_tactic->thm_tactic) = + fun ttac1 ttac2 cth -> + DISJ_CASES_TAC cth THENL [POP_ASSUM ttac1; POP_ASSUM ttac2];; + +let (DISJ_CASES_THEN: thm_tactical) = + W DISJ_CASES_THEN2;; + +let (DISCH_THEN: thm_tactic -> tactic) = + fun ttac -> DISCH_TAC THEN POP_ASSUM ttac;; + +let (X_CHOOSE_THEN: term -> thm_tactical) = + fun x ttac th -> X_CHOOSE_TAC x th THEN POP_ASSUM ttac;; + +let (CHOOSE_THEN: thm_tactical) = + fun ttac th -> CHOOSE_TAC th THEN POP_ASSUM ttac;; + +(* ------------------------------------------------------------------------- *) +(* Various derived tactics and theorem continuations. *) +(* ------------------------------------------------------------------------- *) + +let STRIP_THM_THEN = + FIRST_TCL [CONJUNCTS_THEN; DISJ_CASES_THEN; CHOOSE_THEN];; + +let (ANTE_RES_THEN: thm_tactical) = + fun ttac ante -> + ASSUM_LIST + (fun asl -> + let tacs = mapfilter (fun imp -> ttac (MATCH_MP imp ante)) asl in + if tacs = [] then failwith "IMP_RES_THEN" + else EVERY tacs);; + +let (IMP_RES_THEN: thm_tactical) = + fun ttac imp -> + ASSUM_LIST + (fun asl -> + let tacs = mapfilter (fun ante -> ttac (MATCH_MP imp ante)) asl in + if tacs = [] then failwith "IMP_RES_THEN" + else EVERY tacs);; + +let STRIP_ASSUME_TAC = + let DISCARD_TAC th = + let tm = concl th in + fun (asl,w as g) -> + if exists (fun a -> aconv tm (concl(snd a))) asl then ALL_TAC g + else failwith "DISCARD_TAC: not already present" in + (REPEAT_TCL STRIP_THM_THEN) + (fun gth -> FIRST [CONTR_TAC gth; ACCEPT_TAC gth; + DISCARD_TAC gth; ASSUME_TAC gth]);; + +let STRUCT_CASES_THEN ttac = REPEAT_TCL STRIP_THM_THEN ttac;; + +let STRUCT_CASES_TAC = STRUCT_CASES_THEN + (fun th -> SUBST1_TAC th ORELSE ASSUME_TAC th);; + +let STRIP_GOAL_THEN ttac = FIRST [GEN_TAC; CONJ_TAC; DISCH_THEN ttac];; + +let (STRIP_TAC: tactic) = + fun g -> + try STRIP_GOAL_THEN STRIP_ASSUME_TAC g + with Failure _ -> failwith "STRIP_TAC";; + +let (UNDISCH_THEN:term->thm_tactic->tactic) = + fun tm ttac (asl,w) -> + let thp,asl' = remove (fun (_,th) -> aconv (concl th) tm) asl in + ttac (snd thp) (asl',w);; + +let FIRST_X_ASSUM ttac = + FIRST_ASSUM(fun th -> UNDISCH_THEN (concl th) ttac);; + +(* ------------------------------------------------------------------------- *) +(* Subgoaling and freezing variables (latter is especially useful now). *) +(* ------------------------------------------------------------------------- *) + +let (SUBGOAL_THEN: term -> thm_tactic -> tactic) = + fun wa ttac (asl,w) -> + let meta,gl,just = ttac (ASSUME wa) (asl,w) in + meta,(asl,wa)::gl,fun i l -> PROVE_HYP (hd l) (just i (tl l));; + +let SUBGOAL_TAC s tm prfs = + match prfs with + p::ps -> (warn (ps <> []) "SUBGOAL_TAC: additional subproofs ignored"; + SUBGOAL_THEN tm (LABEL_TAC s) THENL [p; ALL_TAC]) + | [] -> failwith "SUBGOAL_TAC: no subproof given";; + +let (FREEZE_THEN :thm_tactical) = + fun ttac th (asl,w) -> + let meta,gl,just = ttac (ASSUME(concl th)) (asl,w) in + meta,gl,fun i l -> PROVE_HYP th (just i l);; + +(* ------------------------------------------------------------------------- *) +(* Metavariable tactics. *) +(* ------------------------------------------------------------------------- *) + +let (X_META_EXISTS_TAC: term -> tactic) = + fun t (asl,w) -> + try if not (is_var t) then fail() else + let v,bod = dest_exists w in + ([t],null_inst),[asl,vsubst[t,v] bod], + fun i [th] -> EXISTS (instantiate i w,instantiate i t) th + with Failure _ -> failwith "X_META_EXISTS_TAC";; + +let META_EXISTS_TAC ((asl,w) as gl) = + let v = fst(dest_exists w) in + let avoids = itlist (union o frees o concl o snd) asl (frees w) in + let v' = mk_primed_var avoids v in + X_META_EXISTS_TAC v' gl;; + +let (META_SPEC_TAC: term -> thm -> tactic) = + fun t thm (asl,w) -> + let sth = SPEC t thm in + ([t],null_inst),[(("",sth)::asl),w], + fun i [th] -> PROVE_HYP (SPEC (instantiate i t) thm) th;; + +(* ------------------------------------------------------------------------- *) +(* If all else fails! *) +(* ------------------------------------------------------------------------- *) + +let (CHEAT_TAC:tactic) = + fun (asl,w) -> ACCEPT_TAC(mk_thm([],w)) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Intended for time-consuming rules; delays evaluation till it sees goal. *) +(* ------------------------------------------------------------------------- *) + +let RECALL_ACCEPT_TAC r a g = ACCEPT_TAC(time r a) g;; + +(* ------------------------------------------------------------------------- *) +(* Split off antecedent of antecedent as a subgoal. *) +(* ------------------------------------------------------------------------- *) + +let ANTS_TAC = + let tm1 = `p /\ (q ==> r)` + and tm2 = `p ==> q` in + let th1,th2 = CONJ_PAIR(ASSUME tm1) in + let th = itlist DISCH [tm1;tm2] (MP th2 (MP(ASSUME tm2) th1)) in + MATCH_MP_TAC th THEN CONJ_TAC;; + +(* ------------------------------------------------------------------------- *) +(* A printer for goals etc. *) +(* ------------------------------------------------------------------------- *) + +let (print_goal:goal->unit) = + let string_of_int3 n = + if n < 10 then " "^string_of_int n + else if n < 100 then " "^string_of_int n + else string_of_int n in + let print_hyp n (s,th) = + open_hbox(); + Format.print_string(string_of_int3 n); + Format.print_string " ["; + open_hvbox 0; + print_qterm (concl th); + close_box(); + Format.print_string "]"; + (if not (s = "") then (Format.print_string (" ("^s^")")) else ()); + close_box(); + Format.print_newline() in + let rec print_hyps n asl = + if asl = [] then () else + (print_hyp n (hd asl); + print_hyps (n + 1) (tl asl)) in + fun (asl,w) -> + Format.print_newline(); + if asl <> [] then (print_hyps 0 (rev asl); Format.print_newline()) else (); + print_qterm w; Format.print_newline();; + +let (print_goalstack:goalstack->unit) = + let print_goalstate k gs = + let (_,gl,_) = gs in + let n = length gl in + let s = if n = 0 then "No subgoals" else + (string_of_int k)^" subgoal"^(if k > 1 then "s" else "") + ^" ("^(string_of_int n)^" total)" in + Format.print_string s; Format.print_newline(); + if gl = [] then () else + do_list (print_goal o C el gl) (rev(0--(k-1))) in + fun l -> + if l = [] then Format.print_string "Empty goalstack" + else if tl l = [] then + let (_,gl,_ as gs) = hd l in + print_goalstate 1 gs + else + let (_,gl,_ as gs) = hd l + and (_,gl0,_) = hd(tl l) in + let p = length gl - length gl0 in + let p' = if p < 1 then 1 else p + 1 in + print_goalstate p' gs;; + +(* ------------------------------------------------------------------------- *) +(* Convert a tactic into a refinement on head subgoal in current state. *) +(* ------------------------------------------------------------------------- *) + +let (by:tactic->refinement) = + fun tac ((mvs,inst),gls,just) -> + if gls = [] then failwith "No goal set" else + let g = hd gls + and ogls = tl gls in + let ((newmvs,newinst),subgls,subjust) = tac g in + let n = length subgls in + let mvs' = union newmvs mvs + and inst' = compose_insts inst newinst + and gls' = subgls @ map (inst_goal newinst) ogls in + let just' i ths = + let i' = compose_insts inst' i in + let cths,oths = chop_list n ths in + let sths = (subjust i cths) :: oths in + just i' sths in + (mvs',inst'),gls',just';; + +(* ------------------------------------------------------------------------- *) +(* Rotate the goalstate either way. *) +(* ------------------------------------------------------------------------- *) + +let (rotate:int->refinement) = + let rotate_p (meta,sgs,just) = + let sgs' = (tl sgs)@[hd sgs] in + let just' i ths = + let ths' = (last ths)::(butlast ths) in + just i ths' in + (meta,sgs',just') + and rotate_n (meta,sgs,just) = + let sgs' = (last sgs)::(butlast sgs) in + let just' i ths = + let ths' = (tl ths)@[hd ths] in + just i ths' in + (meta,sgs',just') in + fun n -> if n > 0 then funpow n rotate_p + else funpow (-n) rotate_n;; + +(* ------------------------------------------------------------------------- *) +(* Perform refinement proof, tactic proof etc. *) +(* ------------------------------------------------------------------------- *) + +let (mk_goalstate:goal->goalstate) = + fun (asl,w) -> + if type_of w = bool_ty then + null_meta,[asl,w], + (fun inst [th] -> INSTANTIATE_ALL inst th) + else failwith "mk_goalstate: Non-boolean goal";; + +let (TAC_PROOF : goal * tactic -> thm) = + fun (g,tac) -> + let gstate = mk_goalstate g in + let _,sgs,just = by tac gstate in + if sgs = [] then just null_inst [] + else failwith "TAC_PROOF: Unsolved goals";; + +let prove(t,tac) = + let th = TAC_PROOF(([],t),tac) in + let t' = concl th in + if t' = t then th else + try EQ_MP (ALPHA t' t) th + with Failure _ -> failwith "prove: justification generated wrong theorem";; + +(* ------------------------------------------------------------------------- *) +(* Interactive "subgoal package" stuff. *) +(* ------------------------------------------------------------------------- *) + +let current_goalstack = ref ([] :goalstack);; + +let (refine:refinement->goalstack) = + fun r -> + let l = !current_goalstack in + if l = [] then failwith "No current goal" else + let h = hd l in + let res = r h :: l in + current_goalstack := res; + !current_goalstack;; + +let flush_goalstack() = + let l = !current_goalstack in + current_goalstack := [hd l];; + +let e tac = refine(by(VALID tac));; + +let r n = refine(rotate n);; + +let set_goal(asl,w) = + current_goalstack := + [mk_goalstate(map (fun t -> "",ASSUME t) asl,w)]; + !current_goalstack;; + +let g t = + let fvs = sort (<) (map (fst o dest_var) (frees t)) in + (if fvs <> [] then + let errmsg = end_itlist (fun s t -> s^", "^t) fvs in + warn true ("Free variables in goal: "^errmsg) + else ()); + set_goal([],t);; + +let b() = + let l = !current_goalstack in + if length l = 1 then failwith "Can't back up any more" else + current_goalstack := tl l; + !current_goalstack;; + +let p() = + !current_goalstack;; + +let top_realgoal() = + let (_,((asl,w)::_),_)::_ = !current_goalstack in + asl,w;; + +let top_goal() = + let asl,w = top_realgoal() in + map (concl o snd) asl,w;; + +let top_thm() = + let (_,[],f)::_ = !current_goalstack in + f null_inst [];; + +(* ------------------------------------------------------------------------- *) +(* Install the goal-related printers. *) +(* ------------------------------------------------------------------------- *) + +#install_printer print_goal;; +#install_printer print_goalstack;; diff --git a/term.ml b/term.ml new file mode 100644 index 0000000..31b78a2 --- /dev/null +++ b/term.ml @@ -0,0 +1,276 @@ +(* ========================================================================= *) +(* Abstract type of HOL name-carrying terms and manipulation functions. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +module type Hol_term_primitives = + sig type term = private + Var of string * hol_type + | Const of string * hol_type + | Comb of term * term + | Abs of term * term + val constants : unit -> (string * hol_type) list + val get_const_type : string -> hol_type + val new_constant : string * hol_type -> unit + val type_of : term -> hol_type + val aconv : term -> term -> bool + val is_var : term -> bool + val is_const : term -> bool + val is_abs : term -> bool + val is_comb : term -> bool + val mk_var : string * hol_type -> term + val mk_const : string * (hol_type * hol_type) list -> term + val mk_abs : term * term -> term + val mk_comb : term * term -> term + val dest_var : term -> string * hol_type + val dest_const : term -> string * hol_type + val dest_comb : term -> term * term + val dest_abs : term -> term * term + val frees : term -> term list + val freesl : term list -> term list + val freesin : term list -> term -> bool + val vfree_in : term -> term -> bool + val type_vars_in_term : term -> hol_type list + val variant : term list -> term -> term + val vsubst : (term * term) list -> term -> term + val inst : (hol_type * hol_type) list -> term -> term +end;; + +(* ------------------------------------------------------------------------- *) +(* This is the implementation of those primitives. *) +(* ------------------------------------------------------------------------- *) + +module Term : Hol_term_primitives = struct + + type term = Var of string * hol_type + | Const of string * hol_type + | Comb of term * term + | Abs of term * term + +(* ------------------------------------------------------------------------- *) +(* List of term constants and their types. *) +(* *) +(* We begin with just equality (over all types). Later, the Hilbert choice *) +(* operator is added. All other new constants are defined. *) +(* ------------------------------------------------------------------------- *) + + let the_term_constants = + ref ["=", mk_fun_ty aty (mk_fun_ty aty bool_ty)] + +(* ------------------------------------------------------------------------- *) +(* Return all the defined constants with generic types. *) +(* ------------------------------------------------------------------------- *) + + let constants() = !the_term_constants + +(* ------------------------------------------------------------------------- *) +(* Gets type of constant if it succeeds. *) +(* ------------------------------------------------------------------------- *) + + let get_const_type s = assoc s (!the_term_constants) + +(* ------------------------------------------------------------------------- *) +(* Declare a new constant. *) +(* ------------------------------------------------------------------------- *) + + let new_constant(name,ty) = + if can get_const_type name then + failwith ("new_constant: constant "^name^" has already been declared") + else the_term_constants := (name,ty)::(!the_term_constants) + +(* ------------------------------------------------------------------------- *) +(* Finds the type of a term (assumes it is well-typed). *) +(* ------------------------------------------------------------------------- *) + + let rec type_of tm = + match tm with + Var(_,ty) -> ty + | Const(_,ty) -> ty + | Comb(s,_) -> hd(tl(snd(dest_type(type_of s)))) + | Abs(Var(_,ty),t) -> mk_fun_ty ty (type_of t) + +(* ------------------------------------------------------------------------- *) +(* Tests for alpha-convertibility (equality ignoring names in abstractions). *) +(* ------------------------------------------------------------------------- *) + + let aconv = + let rec alphavars env tm1 tm2 = + match env with + [] -> tm1 = tm2 + | (t1,t2)::oenv -> + (t1 = tm1 & t2 = tm2) or + (t1 <> tm1 & t2 <> tm2 & alphavars oenv tm1 tm2) in + let rec raconv env tm1 tm2 = + (tm1 == tm2 & env = []) or + match (tm1,tm2) with + Var(_,_),Var(_,_) -> alphavars env tm1 tm2 + | Const(_,_),Const(_,_) -> tm1 = tm2 + | Comb(s1,t1),Comb(s2,t2) -> raconv env s1 s2 & raconv env t1 t2 + | Abs(Var(_,ty1) as x1,t1),Abs(Var(_,ty2) as x2,t2) -> + ty1 = ty2 & raconv ((x1,x2)::env) t1 t2 + | _ -> false in + fun tm1 tm2 -> raconv [] tm1 tm2 + +(* ------------------------------------------------------------------------- *) +(* Primitive discriminators. *) +(* ------------------------------------------------------------------------- *) + + let is_var = function (Var(_,_)) -> true | _ -> false + + let is_const = function (Const(_,_)) -> true | _ -> false + + let is_abs = function (Abs(_,_)) -> true | _ -> false + + let is_comb = function (Comb(_,_)) -> true | _ -> false + +(* ------------------------------------------------------------------------- *) +(* Primitive constructors. *) +(* ------------------------------------------------------------------------- *) + + let mk_var(v,ty) = Var(v,ty) + + let mk_const(name,theta) = + let uty = try get_const_type name with Failure _ -> + failwith "mk_const: not a constant name" in + Const(name,type_subst theta uty) + + let mk_abs(bvar,bod) = + match bvar with + Var(_,_) -> Abs(bvar,bod) + | _ -> failwith "mk_abs: not a variable" + + let mk_comb(f,a) = + match type_of f with + Tyapp("fun",[ty;_]) when ty = type_of a -> Comb(f,a) + | _ -> failwith "mk_comb: types do not agree" + +(* ------------------------------------------------------------------------- *) +(* Primitive destructors. *) +(* ------------------------------------------------------------------------- *) + + let dest_var = + function (Var(s,ty)) -> s,ty | _ -> failwith "dest_var: not a variable" + + let dest_const = + function (Const(s,ty)) -> s,ty | _ -> failwith "dest_const: not a constant" + + let dest_comb = + function (Comb(f,x)) -> f,x | _ -> failwith "dest_comb: not a combination" + + let dest_abs = + function (Abs(v,b)) -> v,b | _ -> failwith "dest_abs: not an abstraction" + +(* ------------------------------------------------------------------------- *) +(* Finds the variables free in a term (list of terms). *) +(* ------------------------------------------------------------------------- *) + + let rec frees tm = + match tm with + Var(_,_) -> [tm] + | Const(_,_) -> [] + | Abs(bv,bod) -> subtract (frees bod) [bv] + | Comb(s,t) -> union (frees s) (frees t) + + let freesl tml = itlist (union o frees) tml [] + +(* ------------------------------------------------------------------------- *) +(* Whether all free variables in a term appear in a list. *) +(* ------------------------------------------------------------------------- *) + + let rec freesin acc tm = + match tm with + Var(_,_) -> mem tm acc + | Const(_,_) -> true + | Abs(bv,bod) -> freesin (bv::acc) bod + | Comb(s,t) -> freesin acc s & freesin acc t + +(* ------------------------------------------------------------------------- *) +(* Whether a variable (or constant in fact) is free in a term. *) +(* ------------------------------------------------------------------------- *) + + let rec vfree_in v tm = + match tm with + Abs(bv,bod) -> v <> bv & vfree_in v bod + | Comb(s,t) -> vfree_in v s or vfree_in v t + | _ -> tm = v + +(* ------------------------------------------------------------------------- *) +(* Finds the type variables (free) in a term. *) +(* ------------------------------------------------------------------------- *) + + let rec type_vars_in_term tm = + match tm with + Var(_,ty) -> tyvars ty + | Const(_,ty) -> tyvars ty + | Comb(s,t) -> union (type_vars_in_term s) (type_vars_in_term t) + | Abs(Var(_,ty),t) -> union (tyvars ty) (type_vars_in_term t) + +(* ------------------------------------------------------------------------- *) +(* For name-carrying syntax, we need this early. *) +(* ------------------------------------------------------------------------- *) + + let rec variant avoid v = + if not(exists (vfree_in v) avoid) then v else + match v with + Var(s,ty) -> variant avoid (Var(s^"'",ty)) + | _ -> failwith "variant: not a variable" + +(* ------------------------------------------------------------------------- *) +(* Substitution primitive (substitution for variables only!) *) +(* ------------------------------------------------------------------------- *) + + let vsubst = + let rec vsubst ilist tm = + match tm with + Var(_,_) -> rev_assocd tm ilist tm + | Const(_,_) -> tm + | Comb(s,t) -> let s' = vsubst ilist s and t' = vsubst ilist t in + if s' == s & t' == t then tm else Comb(s',t') + | Abs(v,s) -> let ilist' = filter (fun (t,x) -> x <> v) ilist in + if ilist' = [] then tm else + let s' = vsubst ilist' s in + if s' == s then tm else + if exists (fun (t,x) -> vfree_in v t & vfree_in x s) ilist' + then let v' = variant [s'] v in + Abs(v',vsubst ((v',v)::ilist') s) + else Abs(v,s') in + fun theta -> + if theta = [] then (fun tm -> tm) else + if forall (fun (t,x) -> type_of t = snd(dest_var x)) theta + then vsubst theta else failwith "vsubst: Bad substitution list" + +(* ------------------------------------------------------------------------- *) +(* Type instantiation primitive. *) +(* ------------------------------------------------------------------------- *) + + exception Clash of term + + let inst = + let rec inst env tyin tm = + match tm with + Var(n,ty) -> let ty' = type_subst tyin ty in + let tm' = if ty' == ty then tm else Var(n,ty') in + if rev_assocd tm' env tm = tm then tm' + else raise (Clash tm') + | Const(c,ty) -> let ty' = type_subst tyin ty in + if ty' == ty then tm else Const(c,ty') + | Comb(f,x) -> let f' = inst env tyin f and x' = inst env tyin x in + if f' == f & x' == x then tm else Comb(f',x') + | Abs(y,t) -> let y' = inst [] tyin y in + let env' = (y,y')::env in + try let t' = inst env' tyin t in + if y' == y & t' == t then tm else Abs(y',t') + with (Clash(w') as ex) -> + if w' <> y' then raise ex else + let ifrees = map (inst [] tyin) (frees t) in + let y'' = variant ifrees y' in + let z = Var(fst(dest_var y''),snd(dest_var y)) in + inst env tyin (Abs(z,vsubst[z,y] t)) in + fun tyin -> if tyin = [] then fun tm -> tm else inst [] tyin +end;; + +include Term;; diff --git a/theorems.ml b/theorems.ml new file mode 100644 index 0000000..f7de77f --- /dev/null +++ b/theorems.ml @@ -0,0 +1,477 @@ +(* ========================================================================= *) +(* Additional theorems, mainly about quantifiers, and additional tactics. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* (c) Copyright, Marco Maggesi 2012 *) +(* ========================================================================= *) + +needs "simp.ml";; + +(* ------------------------------------------------------------------------- *) +(* More stuff about equality. *) +(* ------------------------------------------------------------------------- *) + +let EQ_REFL = prove + (`!x:A. x = x`, + GEN_TAC THEN REFL_TAC);; + +let REFL_CLAUSE = prove + (`!x:A. (x = x) <=> T`, + GEN_TAC THEN MATCH_ACCEPT_TAC(EQT_INTRO(SPEC_ALL EQ_REFL)));; + +let EQ_SYM = prove + (`!(x:A) y. (x = y) ==> (y = x)`, + REPEAT GEN_TAC THEN DISCH_THEN(ACCEPT_TAC o SYM));; + +let EQ_SYM_EQ = prove + (`!(x:A) y. (x = y) <=> (y = x)`, + REPEAT GEN_TAC THEN EQ_TAC THEN MATCH_ACCEPT_TAC EQ_SYM);; + +let EQ_TRANS = prove + (`!(x:A) y z. (x = y) /\ (y = z) ==> (x = z)`, + REPEAT STRIP_TAC THEN PURE_ASM_REWRITE_TAC[] THEN REFL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The following is a common special case of ordered rewriting. *) +(* ------------------------------------------------------------------------- *) + +let AC acsuite = EQT_ELIM o PURE_REWRITE_CONV[acsuite; REFL_CLAUSE];; + +(* ------------------------------------------------------------------------- *) +(* A couple of theorems about beta reduction. *) +(* ------------------------------------------------------------------------- *) + +let BETA_THM = prove + (`!(f:A->B) y. (\x. (f:A->B) x) y = f y`, + REPEAT GEN_TAC THEN BETA_TAC THEN REFL_TAC);; + +let ABS_SIMP = prove + (`!(t1:A) (t2:B). (\x. t1) t2 = t1`, + REPEAT GEN_TAC THEN REWRITE_TAC[BETA_THM; REFL_CLAUSE]);; + +(* ------------------------------------------------------------------------- *) +(* A few "big name" intuitionistic tautologies. *) +(* ------------------------------------------------------------------------- *) + +let CONJ_ASSOC = prove + (`!t1 t2 t3. t1 /\ t2 /\ t3 <=> (t1 /\ t2) /\ t3`, + ITAUT_TAC);; + +let CONJ_SYM = prove + (`!t1 t2. t1 /\ t2 <=> t2 /\ t1`, + ITAUT_TAC);; + +let CONJ_ACI = prove + (`(p /\ q <=> q /\ p) /\ + ((p /\ q) /\ r <=> p /\ (q /\ r)) /\ + (p /\ (q /\ r) <=> q /\ (p /\ r)) /\ + (p /\ p <=> p) /\ + (p /\ (p /\ q) <=> p /\ q)`, + ITAUT_TAC);; + +let DISJ_ASSOC = prove + (`!t1 t2 t3. t1 \/ t2 \/ t3 <=> (t1 \/ t2) \/ t3`, + ITAUT_TAC);; + +let DISJ_SYM = prove + (`!t1 t2. t1 \/ t2 <=> t2 \/ t1`, + ITAUT_TAC);; + +let DISJ_ACI = prove + (`(p \/ q <=> q \/ p) /\ + ((p \/ q) \/ r <=> p \/ (q \/ r)) /\ + (p \/ (q \/ r) <=> q \/ (p \/ r)) /\ + (p \/ p <=> p) /\ + (p \/ (p \/ q) <=> p \/ q)`, + ITAUT_TAC);; + +let IMP_CONJ = prove + (`p /\ q ==> r <=> p ==> q ==> r`, + ITAUT_TAC);; + +let IMP_IMP = GSYM IMP_CONJ;; + +let IMP_CONJ_ALT = prove + (`p /\ q ==> r <=> q ==> p ==> r`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A couple of "distribution" tautologies are useful. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_OR_DISTRIB = prove + (`!p q r. p /\ (q \/ r) <=> p /\ q \/ p /\ r`, + ITAUT_TAC);; + +let RIGHT_OR_DISTRIB = prove + (`!p q r. (p \/ q) /\ r <=> p /\ r \/ q /\ r`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Degenerate cases of quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_SIMP = prove + (`!t. (!x:A. t) = t`, + ITAUT_TAC);; + +let EXISTS_SIMP = prove + (`!t. (?x:A. t) = t`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* I also use this a lot (as a prelude to congruence reasoning). *) +(* ------------------------------------------------------------------------- *) + +let EQ_IMP = ITAUT `(a <=> b) ==> a ==> b`;; + +(* ------------------------------------------------------------------------- *) +(* Start building up the basic rewrites; we add a few more later. *) +(* ------------------------------------------------------------------------- *) + +let EQ_CLAUSES = prove + (`!t. ((T <=> t) <=> t) /\ ((t <=> T) <=> t) /\ + ((F <=> t) <=> ~t) /\ ((t <=> F) <=> ~t)`, + ITAUT_TAC);; + +let NOT_CLAUSES_WEAK = prove + (`(~T <=> F) /\ (~F <=> T)`, + ITAUT_TAC);; + +let AND_CLAUSES = prove + (`!t. (T /\ t <=> t) /\ (t /\ T <=> t) /\ (F /\ t <=> F) /\ + (t /\ F <=> F) /\ (t /\ t <=> t)`, + ITAUT_TAC);; + +let OR_CLAUSES = prove + (`!t. (T \/ t <=> T) /\ (t \/ T <=> T) /\ (F \/ t <=> t) /\ + (t \/ F <=> t) /\ (t \/ t <=> t)`, + ITAUT_TAC);; + +let IMP_CLAUSES = prove + (`!t. (T ==> t <=> t) /\ (t ==> T <=> T) /\ (F ==> t <=> T) /\ + (t ==> t <=> T) /\ (t ==> F <=> ~t)`, + ITAUT_TAC);; + +extend_basic_rewrites + [REFL_CLAUSE; + EQ_CLAUSES; + NOT_CLAUSES_WEAK; + AND_CLAUSES; + OR_CLAUSES; + IMP_CLAUSES; + FORALL_SIMP; + EXISTS_SIMP; + BETA_THM; + let IMP_EQ_CLAUSE = prove + (`((x = x) ==> p) <=> p`, + REWRITE_TAC[EQT_INTRO(SPEC_ALL EQ_REFL); IMP_CLAUSES]) in + IMP_EQ_CLAUSE];; + +extend_basic_congs + [ITAUT `(p <=> p') ==> (p' ==> (q <=> q')) ==> (p ==> q <=> p' ==> q')`];; + +(* ------------------------------------------------------------------------- *) +(* Rewrite rule for unique existence. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_UNIQUE_THM = prove + (`!P. (?!x:A. P x) <=> (?x. P x) /\ (!x x'. P x /\ P x' ==> (x = x'))`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_DEF]);; + +(* ------------------------------------------------------------------------- *) +(* Trivial instances of existence. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_REFL = prove + (`!a:A. ?x. x = a`, + GEN_TAC THEN EXISTS_TAC `a:A` THEN REFL_TAC);; + +let EXISTS_UNIQUE_REFL = prove + (`!a:A. ?!x. x = a`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN + REPEAT(EQ_TAC ORELSE STRIP_TAC) THENL + [EXISTS_TAC `a:A`; ASM_REWRITE_TAC[]] THEN + REFL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Unwinding. *) +(* ------------------------------------------------------------------------- *) + +let UNWIND_THM1 = prove + (`!P (a:A). (?x. a = x /\ P x) <=> P a`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(CHOOSE_THEN (CONJUNCTS_THEN2 SUBST1_TAC ACCEPT_TAC)); + DISCH_TAC THEN EXISTS_TAC `a:A` THEN + CONJ_TAC THEN TRY(FIRST_ASSUM MATCH_ACCEPT_TAC) THEN + REFL_TAC]);; + +let UNWIND_THM2 = prove + (`!P (a:A). (?x. x = a /\ P x) <=> P a`, + REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN + MATCH_ACCEPT_TAC UNWIND_THM1);; + +let FORALL_UNWIND_THM2 = prove + (`!P (a:A). (!x. x = a ==> P x) <=> P a`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `a:A`) THEN REWRITE_TAC[]; + DISCH_TAC THEN GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[]]);; + +let FORALL_UNWIND_THM1 = prove + (`!P a. (!x. a = x ==> P x) <=> P a`, + REPEAT GEN_TAC THEN CONV_TAC(LAND_CONV(ONCE_DEPTH_CONV SYM_CONV)) THEN + MATCH_ACCEPT_TAC FORALL_UNWIND_THM2);; + +(* ------------------------------------------------------------------------- *) +(* Permuting quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let SWAP_FORALL_THM = prove + (`!P:A->B->bool. (!x y. P x y) <=> (!y x. P x y)`, + ITAUT_TAC);; + +let SWAP_EXISTS_THM = prove + (`!P:A->B->bool. (?x y. P x y) <=> (?y x. P x y)`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Universal quantifier and conjunction. *) +(* ------------------------------------------------------------------------- *) + +let FORALL_AND_THM = prove + (`!P Q. (!x:A. P x /\ Q x) <=> (!x. P x) /\ (!x. Q x)`, + ITAUT_TAC);; + +let AND_FORALL_THM = prove + (`!P Q. (!x. P x) /\ (!x. Q x) <=> (!x:A. P x /\ Q x)`, + ITAUT_TAC);; + +let LEFT_AND_FORALL_THM = prove + (`!P Q. (!x:A. P x) /\ Q <=> (!x:A. P x /\ Q)`, + ITAUT_TAC);; + +let RIGHT_AND_FORALL_THM = prove + (`!P Q. P /\ (!x:A. Q x) <=> (!x. P /\ Q x)`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existential quantifier and disjunction. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_OR_THM = prove + (`!P Q. (?x:A. P x \/ Q x) <=> (?x. P x) \/ (?x. Q x)`, + ITAUT_TAC);; + +let OR_EXISTS_THM = prove + (`!P Q. (?x. P x) \/ (?x. Q x) <=> (?x:A. P x \/ Q x)`, + ITAUT_TAC);; + +let LEFT_OR_EXISTS_THM = prove + (`!P Q. (?x. P x) \/ Q <=> (?x:A. P x \/ Q)`, + ITAUT_TAC);; + +let RIGHT_OR_EXISTS_THM = prove + (`!P Q. P \/ (?x. Q x) <=> (?x:A. P \/ Q x)`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Existential quantifier and conjunction. *) +(* ------------------------------------------------------------------------- *) + +let LEFT_EXISTS_AND_THM = prove + (`!P Q. (?x:A. P x /\ Q) <=> (?x:A. P x) /\ Q`, + ITAUT_TAC);; + +let RIGHT_EXISTS_AND_THM = prove + (`!P Q. (?x:A. P /\ Q x) <=> P /\ (?x:A. Q x)`, + ITAUT_TAC);; + +let TRIV_EXISTS_AND_THM = prove + (`!P Q. (?x:A. P /\ Q) <=> (?x:A. P) /\ (?x:A. Q)`, + ITAUT_TAC);; + +let LEFT_AND_EXISTS_THM = prove + (`!P Q. (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)`, + ITAUT_TAC);; + +let RIGHT_AND_EXISTS_THM = prove + (`!P Q. P /\ (?x:A. Q x) <=> (?x:A. P /\ Q x)`, + ITAUT_TAC);; + +let TRIV_AND_EXISTS_THM = prove + (`!P Q. (?x:A. P) /\ (?x:A. Q) <=> (?x:A. P /\ Q)`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Only trivial instances of universal quantifier and disjunction. *) +(* ------------------------------------------------------------------------- *) + +let TRIV_FORALL_OR_THM = prove + (`!P Q. (!x:A. P \/ Q) <=> (!x:A. P) \/ (!x:A. Q)`, + ITAUT_TAC);; + +let TRIV_OR_FORALL_THM = prove + (`!P Q. (!x:A. P) \/ (!x:A. Q) <=> (!x:A. P \/ Q)`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Implication and quantifiers. *) +(* ------------------------------------------------------------------------- *) + +let RIGHT_IMP_FORALL_THM = prove + (`!P Q. (P ==> !x:A. Q x) <=> (!x. P ==> Q x)`, + ITAUT_TAC);; + +let RIGHT_FORALL_IMP_THM = prove + (`!P Q. (!x. P ==> Q x) <=> (P ==> !x:A. Q x)`, + ITAUT_TAC);; + +let LEFT_IMP_EXISTS_THM = prove + (`!P Q. ((?x:A. P x) ==> Q) <=> (!x. P x ==> Q)`, + ITAUT_TAC);; + +let LEFT_FORALL_IMP_THM = prove + (`!P Q. (!x. P x ==> Q) <=> ((?x:A. P x) ==> Q)`, + ITAUT_TAC);; + +let TRIV_FORALL_IMP_THM = prove + (`!P Q. (!x:A. P ==> Q) <=> ((?x:A. P) ==> (!x:A. Q))`, + ITAUT_TAC);; + +let TRIV_EXISTS_IMP_THM = prove + (`!P Q. (?x:A. P ==> Q) <=> ((!x:A. P) ==> (?x:A. Q))`, + ITAUT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Alternative versions of unique existence. *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_UNIQUE_ALT = prove + (`!P:A->bool. (?!x. P x) <=> (?x. !y. P y <=> (x = y))`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM] THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `x:A`) ASSUME_TAC) THEN + EXISTS_TAC `x:A` THEN GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN FIRST_ASSUM MATCH_ACCEPT_TAC]; + DISCH_THEN(X_CHOOSE_TAC `x:A`) THEN + ASM_REWRITE_TAC[GSYM EXISTS_REFL] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN (SUBST1_TAC o SYM)) THEN REFL_TAC]);; + +let EXISTS_UNIQUE = prove + (`!P:A->bool. (?!x. P x) <=> (?x. P x /\ !y. P y ==> (y = x))`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_ALT] THEN + AP_TERM_TAC THEN ABS_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o BINDER_CONV) + [ITAUT `(a <=> b) <=> (a ==> b) /\ (b ==> a)`] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[FORALL_AND_THM] THEN SIMP_TAC[] THEN + REWRITE_TAC[LEFT_FORALL_IMP_THM; EXISTS_REFL] THEN + REWRITE_TAC[CONJ_ACI]);; + +(* ------------------------------------------------------------------------- *) +(* DESTRUCT_TAC, FIX_TAC and INTRO_TAC, giving more brief and elegant ways *) +(* of naming introduced variables and assumptions (from Marco Maggesi). *) +(* ------------------------------------------------------------------------- *) + +let DESTRUCT_TAC,FIX_TAC,INTRO_TAC = + let NAME_GEN_TAC s gl = + let ty = (snd o dest_var o fst o dest_forall o snd) gl in + X_GEN_TAC (mk_var(s,ty)) gl + and OBTAIN_THEN v ttac th = + let ty = (snd o dest_var o fst o dest_exists o concl) th in + X_CHOOSE_THEN (mk_var(v,ty)) ttac th + and CONJ_LIST_TAC = end_itlist (fun t1 t2 -> CONJ_TAC THENL [t1; t2]) + and NUM_DISJ_TAC n = + if n <= 0 then failwith "NUM_DISJ_TAC" else + REPLICATE_TAC (n-1) DISJ2_TAC THEN REPEAT DISJ1_TAC + and NAME_PULL_FORALL_CONV = + let SWAP_FORALL_CONV = REWR_CONV SWAP_FORALL_THM + and AND_FORALL_CONV = GEN_REWRITE_CONV I [AND_FORALL_THM] + and RIGHT_IMP_FORALL_CONV = GEN_REWRITE_CONV I [RIGHT_IMP_FORALL_THM] in + fun s -> + let rec PULL_FORALL tm = + if is_forall tm then + if name_of(fst(dest_forall tm)) = s then REFL tm else + (BINDER_CONV PULL_FORALL THENC SWAP_FORALL_CONV) tm + else if is_imp tm then + (RAND_CONV PULL_FORALL THENC RIGHT_IMP_FORALL_CONV) tm + else if is_conj tm then + (BINOP_CONV PULL_FORALL THENC AND_FORALL_CONV) tm + else + fail () in + PULL_FORALL in + let parse_fix = + let ident = function + Ident s::rest when isalpha s -> s,rest + | _ -> raise Noparse in + let rename = + let old_name = possibly (a(Ident "/") ++ ident >> snd) in + (a(Resword "[") ++ ident >> snd) ++ old_name ++ a(Resword "]") >> fst in + let mk_var v = CONV_TAC (NAME_PULL_FORALL_CONV v) THEN GEN_TAC + and mk_rename = + function u,[v] -> CONV_TAC (NAME_PULL_FORALL_CONV v) THEN NAME_GEN_TAC u + | u,_ -> NAME_GEN_TAC u in + let vars = many (rename >> mk_rename || ident >> mk_var) >> EVERY + and star = possibly (a (Ident "*") >> K (REPEAT GEN_TAC)) in + vars ++ star >> function tac,[] -> tac | tac,_ -> tac THEN REPEAT GEN_TAC + and parse_destruct = + let OBTAINL_THEN : string list -> thm_tactical = + EVERY_TCL o map OBTAIN_THEN in + let ident p = function + Ident s::rest when p s -> s,rest + | _ -> raise Noparse in + let rec destruct inp = disj inp + and disj inp = + let DISJ_CASES_LIST = end_itlist DISJ_CASES_THEN2 in + (listof conj (a(Resword "|")) "Disjunction" >> DISJ_CASES_LIST) inp + and conj inp = (atleast 1 atom >> end_itlist CONJUNCTS_THEN2) inp + and obtain inp = + let obtain_prfx = + let var_list = atleast 1 (ident isalpha) in + (a(Ident "@") ++ var_list >> snd) ++ a(Resword ".") >> fst in + (obtain_prfx ++ destruct >> uncurry OBTAINL_THEN) inp + and atom inp = + let label = ident isalnum >> LABEL_TAC in + let paren = + (a(Resword "(") ++ destruct >> snd) ++ a(Resword ")") >> fst in + (label || obtain || paren) inp in + destruct in + let parse_intro = + let number = function + Ident s::rest -> + (try + let n = int_of_string s in + if n < 1 then raise Noparse else n,rest + with Failure _ -> raise Noparse) + | _ -> raise Noparse + and pa_fix = a(Ident "!") ++ parse_fix >> snd + and pa_dest = parse_destruct >> DISCH_THEN in + let pa_prefix = + elistof (pa_fix || pa_dest) (a(Resword ";")) "Prefix intro pattern" in + let rec pa_intro toks = + (pa_prefix ++ possibly pa_postfix >> uncurry (@) >> EVERY) toks + and pa_postfix toks = (pa_conj || pa_disj) toks + and pa_conj toks = + let conjs = + listof pa_intro (a(Ident "&")) "Intro pattern" >> CONJ_LIST_TAC in + ((a(Resword "{") ++ conjs >> snd) ++ a(Resword "}") >> fst) toks + and pa_disj toks = + let disj = number >> NUM_DISJ_TAC in + ((a(Ident "#") ++ disj >> snd) ++ pa_intro >> uncurry (THEN)) toks in + pa_intro in + let DESTRUCT_TAC s = + let tac,rest = + (fix "Destruct pattern" parse_destruct o lex o explode) s in + if rest=[] then tac else failwith "Garbage after destruct pattern" + and INTRO_TAC s = + let tac,rest = + (fix "Introduction pattern" parse_intro o lex o explode) s in + if rest=[] then tac else failwith "Garbage after intro pattern" + and FIX_TAC s = + let tac,rest = (parse_fix o lex o explode) s in + if rest=[] then tac else failwith "FIX_TAC: invalid pattern" in + DESTRUCT_TAC,FIX_TAC,INTRO_TAC;; diff --git a/thm.ml b/thm.ml new file mode 100644 index 0000000..2ccdf0c --- /dev/null +++ b/thm.ml @@ -0,0 +1,243 @@ +(* ========================================================================= *) +(* Abstract type of theorems and primitive inference rules. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* A few bits of general derived syntax. *) +(* ------------------------------------------------------------------------- *) + +let rator tm = + match tm with + Comb(l,r) -> l + | _ -> failwith "rator: Not a combination";; + +let rand tm = + match tm with + Comb(l,r) -> r + | _ -> failwith "rand: Not a combination";; + +(* ------------------------------------------------------------------------- *) +(* Syntax operations for equations. *) +(* ------------------------------------------------------------------------- *) + +let mk_eq = + let eq = mk_const("=",[]) in + fun (l,r) -> + try let ty = type_of l in + let eq_tm = inst [ty,aty] eq in + mk_comb(mk_comb(eq_tm,l),r) + with Failure _ -> failwith "mk_eq";; + +let dest_eq tm = + match tm with + Comb(Comb(Const("=",_),l),r) -> l,r + | _ -> failwith "dest_eq";; + +let is_eq tm = + match tm with + Comb(Comb(Const("=",_),_),_) -> true + | _ -> false;; + +(* ------------------------------------------------------------------------- *) +(* Useful to have term union modulo alpha-conversion for assumption lists. *) +(* ------------------------------------------------------------------------- *) + +let term_remove t l = filter (fun t' -> not(aconv t t')) l;; + +let rec term_union l1 l2 = + match l1 with + [] -> l2 + | (h::t) -> let subun = term_union t l2 in + if exists (aconv h) subun then subun else h::subun;; + +(* ------------------------------------------------------------------------- *) +(* The abstract type of theorems. *) +(* ------------------------------------------------------------------------- *) + +module type Hol_thm_primitives = + sig type thm + val dest_thm : thm -> term list * term + val hyp : thm -> term list + val concl : thm -> term + val REFL : term -> thm + val TRANS : thm -> thm -> thm + val MK_COMB : thm * thm -> thm + val ABS : term -> thm -> thm + val BETA : term -> thm + val ASSUME : term -> thm + val EQ_MP : thm -> thm -> thm + val DEDUCT_ANTISYM_RULE : thm -> thm -> thm + val INST_TYPE : (hol_type * hol_type) list -> thm -> thm + val INST : (term * term) list -> thm -> thm + val axioms : unit -> thm list + val new_axiom : term -> thm + val new_basic_definition : term -> thm + val new_basic_type_definition : string -> string * string -> thm -> thm * thm +end;; + +(* ------------------------------------------------------------------------- *) +(* This is the implementation of those primitives. *) +(* ------------------------------------------------------------------------- *) + +module Hol : Hol_thm_primitives = struct + + type thm = Sequent of (term list * term) + +(* ------------------------------------------------------------------------- *) +(* Basic theorem destructors. *) +(* ------------------------------------------------------------------------- *) + + let dest_thm (Sequent(asl,c)) = (asl,c) + + let hyp (Sequent(asl,c)) = asl + + let concl (Sequent(asl,c)) = c + +(* ------------------------------------------------------------------------- *) +(* Basic equality properties; TRANS is derivable but included for efficiency *) +(* ------------------------------------------------------------------------- *) + + let REFL tm = + Sequent([],mk_eq(tm,tm)) + + let TRANS (Sequent(asl1,c1)) (Sequent(asl2,c2)) = + match (c1,c2) with + Comb(Comb(Const("=",_),l),m1),Comb(Comb(Const("=",_),m2),r) + when aconv m1 m2 -> Sequent(term_union asl1 asl2,mk_eq(l,r)) + | _ -> failwith "TRANS" + +(* ------------------------------------------------------------------------- *) +(* Congruence properties of equality. *) +(* ------------------------------------------------------------------------- *) + + let MK_COMB(Sequent(asl1,c1),Sequent(asl2,c2)) = + match (c1,c2) with + Comb(Comb(Const("=",_),l1),r1),Comb(Comb(Const("=",_),l2),r2) + -> Sequent(term_union asl1 asl2,mk_eq(mk_comb(l1,l2),mk_comb(r1,r2))) + | _ -> failwith "MK_COMB" + + let ABS v (Sequent(asl,c)) = + match c with + Comb(Comb(Const("=",_),l),r) -> + if exists (vfree_in v) asl + then failwith "ABS: variable is free in assumptions" + else Sequent(asl,mk_eq(mk_abs(v,l),mk_abs(v,r))) + | _ -> failwith "ABS: not an equation" + +(* ------------------------------------------------------------------------- *) +(* Trivial case of lambda calculus beta-conversion. *) +(* ------------------------------------------------------------------------- *) + + let BETA tm = + match tm with + Comb(Abs(v,bod),arg) when arg = v -> Sequent([],mk_eq(tm,bod)) + | _ -> failwith "BETA: not a trivial beta-redex" + +(* ------------------------------------------------------------------------- *) +(* Rules connected with deduction. *) +(* ------------------------------------------------------------------------- *) + + let ASSUME tm = + if type_of tm = bool_ty then Sequent([tm],tm) + else failwith "ASSUME: not a proposition" + + let EQ_MP (Sequent(asl1,eq)) (Sequent(asl2,c)) = + match eq with + Comb(Comb(Const("=",_),l),r) when aconv l c + -> Sequent(term_union asl1 asl2,r) + | _ -> failwith "EQ_MP" + + let DEDUCT_ANTISYM_RULE (Sequent(asl1,c1)) (Sequent(asl2,c2)) = + let asl1' = term_remove c2 asl1 and asl2' = term_remove c1 asl2 in + Sequent(term_union asl1' asl2',mk_eq(c1,c2)) + +(* ------------------------------------------------------------------------- *) +(* Type and term instantiation. *) +(* ------------------------------------------------------------------------- *) + + let INST_TYPE theta (Sequent(asl,c)) = + let inst_fn = inst theta in + Sequent(map inst_fn asl,inst_fn c) + + let INST theta (Sequent(asl,c)) = + let inst_fun = vsubst theta in + Sequent(map inst_fun asl,inst_fun c) + +(* ------------------------------------------------------------------------- *) +(* Handling of axioms. *) +(* ------------------------------------------------------------------------- *) + + let the_axioms = ref ([]:thm list) + + let axioms() = !the_axioms + + let new_axiom tm = + if fst(dest_type(type_of tm)) = "bool" then + let th = Sequent([],tm) in + (the_axioms := th::(!the_axioms); th) + else failwith "new_axiom: Not a proposition" + +(* ------------------------------------------------------------------------- *) +(* Handling of (term) definitions. *) +(* ------------------------------------------------------------------------- *) + + let new_basic_definition tm = + let l,r = dest_eq tm in + let cname,ty = dest_var l in + if not(freesin [] r) then failwith "new_definition: term not closed" else + if not (subset (type_vars_in_term r) (tyvars ty)) + then failwith "new_definition: Type variables not reflected in constant" + else + let c = new_constant(cname,ty); mk_const(cname,[]) in + Sequent([],mk_eq(c,r)) + +(* ------------------------------------------------------------------------- *) +(* Handling of type definitions. *) +(* *) +(* This function now involves no logical constants beyond equality. *) +(* *) +(* |- P t *) +(* --------------------------- *) +(* |- abs(rep a) = a *) +(* |- P r = (rep(abs r) = r) *) +(* *) +(* Where "abs" and "rep" are new constants with the nominated names. *) +(* ------------------------------------------------------------------------- *) + + let new_basic_type_definition tyname (absname,repname) (Sequent(asl,c)) = + if exists (can get_const_type) [absname; repname] then + failwith "new_basic_type_definition: Constant(s) already in use" else + if not (asl = []) then + failwith "new_basic_type_definition: Assumptions in theorem" else + let P,x = try dest_comb c + with Failure _ -> + failwith "new_basic_type_definition: Not a combination" in + if not(freesin [] P) then + failwith "new_basic_type_definition: Predicate is not closed" else + let tyvars = sort (<=) (type_vars_in_term P) in + let _ = try new_type(tyname,length tyvars) + with Failure _ -> + failwith "new_basic_type_definition: Type already defined" in + let aty = mk_type(tyname,tyvars) + and rty = type_of x in + let abs = new_constant(absname,mk_fun_ty rty aty); mk_const(absname,[]) + and rep = new_constant(repname,mk_fun_ty aty rty); mk_const(repname,[]) in + let a = mk_var("a",aty) and r = mk_var("r",rty) in + Sequent([],mk_eq(mk_comb(abs,mk_comb(rep,a)),a)), + Sequent([],mk_eq(mk_comb(P,r),mk_eq(mk_comb(rep,mk_comb(abs,r)),r))) + +end;; + +include Hol;; + +(* ------------------------------------------------------------------------- *) +(* Comparison function on theorems. Currently the same as equality, but *) +(* it's useful to separate because in the proof-recording version it isn't. *) +(* ------------------------------------------------------------------------- *) + +let equals_thm th th' = dest_thm th = dest_thm th';; diff --git a/trivia.ml b/trivia.ml new file mode 100644 index 0000000..3257698 --- /dev/null +++ b/trivia.ml @@ -0,0 +1,91 @@ +(* ========================================================================= *) +(* Trivial odds and ends. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "class.ml";; + +(* ------------------------------------------------------------------------- *) +(* Combinators. We don't bother with S and K, which seem of little use. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix ("o",(26,"right"));; + +let o_DEF = new_definition + `(o) (f:B->C) g = \x:A. f(g(x))`;; + +let I_DEF = new_definition + `I = \x:A. x`;; + +let o_THM = prove + (`!f:B->C. !g:A->B. !x:A. (f o g) x = f(g(x))`, + PURE_REWRITE_TAC [o_DEF] THEN + CONV_TAC (DEPTH_CONV BETA_CONV) THEN + REPEAT GEN_TAC THEN REFL_TAC);; + +let o_ASSOC = prove + (`!f:C->D. !g:B->C. !h:A->B. f o (g o h) = (f o g) o h`, + REPEAT GEN_TAC THEN REWRITE_TAC [o_DEF] THEN + CONV_TAC (REDEPTH_CONV BETA_CONV) THEN + REFL_TAC);; + +let I_THM = prove + (`!x:A. I x = x`, + REWRITE_TAC [I_DEF]);; + +let I_O_ID = prove + (`!f:A->B. (I o f = f) /\ (f o I = f)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_DEF; I_THM]);; + +(* ------------------------------------------------------------------------- *) +(* The theory "1" (a 1-element type). *) +(* ------------------------------------------------------------------------- *) + +let EXISTS_ONE_REP = prove + (`?b:bool. b`, + EXISTS_TAC `T` THEN + BETA_TAC THEN ACCEPT_TAC TRUTH);; + +let one_tydef = + new_type_definition "1" ("one_ABS","one_REP") EXISTS_ONE_REP;; + +let one_DEF = new_definition + `one = @x:1. T`;; + +let one = prove + (`!v:1. v = one`, + MP_TAC(GEN_ALL (SPEC `one_REP a` (CONJUNCT2 one_tydef))) THEN + REWRITE_TAC[CONJUNCT1 one_tydef] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM (CONJUNCT1 one_tydef)] THEN + ASM_REWRITE_TAC[]);; + +let one_axiom = prove + (`!f g. f = (g:A->1)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN ONCE_REWRITE_TAC[one] THEN REFL_TAC);; + +let one_INDUCT = prove + (`!P. P one ==> !x. P x`, + ONCE_REWRITE_TAC[one] THEN REWRITE_TAC[]);; + +let one_RECURSION = prove + (`!e:A. ?fn. fn one = e`, + GEN_TAC THEN EXISTS_TAC `\x:1. e:A` THEN BETA_TAC THEN REFL_TAC);; + +let one_Axiom = prove + (`!e:A. ?!fn. fn one = e`, + GEN_TAC THEN REWRITE_TAC[EXISTS_UNIQUE_THM; one_RECURSION] THEN + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[FUN_EQ_THM] THEN + ONCE_REWRITE_TAC [one] THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Add the type "1" to the inductive type store. *) +(* ------------------------------------------------------------------------- *) + +inductive_type_store := + ("1",(1,one_INDUCT,one_RECURSION))::(!inductive_type_store);; diff --git a/type.ml b/type.ml new file mode 100644 index 0000000..6c6a678 --- /dev/null +++ b/type.ml @@ -0,0 +1,143 @@ +(* ========================================================================= *) +(* Abstract type of HOL types and functions for manipulating them. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +module type Hol_type_primitives = + sig type hol_type = private + Tyvar of string + | Tyapp of string * hol_type list + val types: unit -> (string*int)list + val get_type_arity : string -> int + val new_type : (string * int) -> unit + val mk_type: (string * hol_type list) -> hol_type + val mk_vartype : string -> hol_type + val dest_type : hol_type -> (string * hol_type list) + val dest_vartype : hol_type -> string + val is_type : hol_type -> bool + val is_vartype : hol_type -> bool + val tyvars : hol_type -> hol_type list + val type_subst : (hol_type * hol_type)list -> hol_type -> hol_type + end;; + +(* ------------------------------------------------------------------------- *) +(* This is the implementation of those primitives. *) +(* ------------------------------------------------------------------------- *) + +module Type : Hol_type_primitives = struct + + type hol_type = Tyvar of string + | Tyapp of string * hol_type list + +(* ------------------------------------------------------------------------- *) +(* List of current type constants with their arities. *) +(* *) +(* Initially we just have the boolean type and the function space *) +(* constructor. Later on we add as primitive the type of individuals. *) +(* All other new types result from definitional extension. *) +(* ------------------------------------------------------------------------- *) + + let the_type_constants = ref ["bool",0; "fun",2] + +(* ------------------------------------------------------------------------- *) +(* Return all the defined types. *) +(* ------------------------------------------------------------------------- *) + + let types() = !the_type_constants + +(* ------------------------------------------------------------------------- *) +(* Lookup function for type constants. Returns arity if it succeeds. *) +(* ------------------------------------------------------------------------- *) + + let get_type_arity s = assoc s (!the_type_constants) + +(* ------------------------------------------------------------------------- *) +(* Declare a new type. *) +(* ------------------------------------------------------------------------- *) + + let new_type(name,arity) = + if can get_type_arity name then + failwith ("new_type: type "^name^" has already been declared") + else the_type_constants := (name,arity)::(!the_type_constants) + +(* ------------------------------------------------------------------------- *) +(* Basic type constructors. *) +(* ------------------------------------------------------------------------- *) + + let mk_type(tyop,args) = + let arity = try get_type_arity tyop with Failure _ -> + failwith ("mk_type: type "^tyop^" has not been defined") in + if arity = length args then + Tyapp(tyop,args) + else failwith ("mk_type: wrong number of arguments to "^tyop) + + let mk_vartype v = Tyvar(v) + +(* ------------------------------------------------------------------------- *) +(* Basic type destructors. *) +(* ------------------------------------------------------------------------- *) + + let dest_type = + function + (Tyapp (s,ty)) -> s,ty + | (Tyvar _) -> failwith "dest_type: type variable not a constructor" + + let dest_vartype = + function + (Tyapp(_,_)) -> failwith "dest_vartype: type constructor not a variable" + | (Tyvar s) -> s + +(* ------------------------------------------------------------------------- *) +(* Basic type discriminators. *) +(* ------------------------------------------------------------------------- *) + + let is_type = can dest_type + + let is_vartype = can dest_vartype + +(* ------------------------------------------------------------------------- *) +(* Return the type variables in a type and in a list of types. *) +(* ------------------------------------------------------------------------- *) + + let rec tyvars = + function + (Tyapp(_,args)) -> itlist (union o tyvars) args [] + | (Tyvar v as tv) -> [tv] + +(* ------------------------------------------------------------------------- *) +(* Substitute types for type variables. *) +(* *) +(* NB: non-variables in subst list are just ignored (a check would be *) +(* repeated many times), as are repetitions (first possibility is taken). *) +(* ------------------------------------------------------------------------- *) + + let rec type_subst i ty = + match ty with + Tyapp(tycon,args) -> + let args' = qmap (type_subst i) args in + if args' == args then ty else Tyapp(tycon,args') + | _ -> rev_assocd ty i ty + +end;; + +(* ------------------------------------------------------------------------- *) +(* Display all the externally visible functions. *) +(* ------------------------------------------------------------------------- *) + +include Type;; + +(* ------------------------------------------------------------------------- *) +(* The following are common enough to deserve their own bindings. *) +(* ------------------------------------------------------------------------- *) + +let bool_ty = mk_type("bool",[]);; + +let mk_fun_ty ty1 ty2 = mk_type("fun",[ty1; ty2]);; + +let aty = mk_vartype "A";; + +let bty = mk_vartype "B";; diff --git a/update_database.ml b/update_database.ml new file mode 100644 index 0000000..e9cc5e5 --- /dev/null +++ b/update_database.ml @@ -0,0 +1,275 @@ +(* ========================================================================= *) +(* Create search database from OCaml / modify search database dynamically. *) +(* *) +(* This file assigns to "theorems", which is a list of name-theorem pairs. *) +(* The core system already has such a database set up. Use this file if you *) +(* want to update the database beyond the core, so you can search it. *) +(* *) +(* The trickery to get at the OCaml environment is due to Roland Zumkeller. *) +(* It works by copying some internal data structures and casting into the *) +(* copy using Obj.magic. *) +(* ========================================================================= *) + +(* Execute any OCaml expression given as a string. *) + +let exec = ignore o Toploop.execute_phrase false Format.std_formatter + o !Toploop.parse_toplevel_phrase o Lexing.from_string;; + +type dummy;; + +(* ------------------------------------------------------------------------- *) +(* Basic data structures copied from OCaml. May be version-dependent. *) +(* ------------------------------------------------------------------------- *) + +type label = int;; + +(*** from ./typing/ident.ml: ***) + +type ident_t = { stamp: int; name: string; mutable flags: int };; + +type 'a tbl = + Empty + | Node of 'a tbl * 'a data * 'a tbl * int + +and 'a data = + { ident: ident_t; + data: 'a; + previous: 'a data option };; + +(*** from ./typing/path.ml: ***) + +type path_t = + Pident of ident_t + | Pdot of path_t * string * int + | Papply of path_t * path_t;; + +(*** from typing/types.ml: ***) + +exec ( +"type type_expr = + { mutable desc: type_desc; + mutable level: int; + mutable id: int } + +and type_desc = +" ^ +(if String.sub Sys.ocaml_version 0 1 = "4" + then "Tvar of string option\n" + else "Tvar\n") ^ +" | Tarrow of label * type_expr * type_expr * commutable + | Ttuple of type_expr list + | Tconstr of path_t * type_expr list * abbrev_memo ref + | Tobject of type_expr * (path_t * type_expr list) option ref + | Tfield of string * field_kind * type_expr * type_expr + | Tnil + | Tlink of type_expr + | Tsubst of type_expr + | Tvariant of row_desc + | Tunivar + | Tpoly of type_expr * type_expr list + +and row_desc = + { row_fields: (label * row_field) list; + row_more: type_expr; + row_bound: type_expr list; + row_closed: bool; + row_fixed: bool; + row_name: (path_t * type_expr list) option } + +and row_field = + Rpresent of type_expr option + | Reither of bool * type_expr list * bool * row_field option ref + | Rabsent + +and abbrev_memo = + Mnil + | Mcons of path_t * type_expr * type_expr * abbrev_memo + | Mlink of abbrev_memo ref + +and field_kind = + Fvar of field_kind option ref + | Fpresent + | Fabsent + +and commutable = + Cok + | Cunknown + | Clink of commutable ref;; +");; + +type value_description = + { val_type: type_expr; + val_kind: dummy };; + +type module_type = + Tmty_ident of path_t + | Tmty_signature of signature + | Tmty_functor of ident_t * module_type * module_type + +and signature = signature_item list + +and signature_item = + Tsig_value of ident_t * value_description + | Tsig_type of ident_t * dummy * dummy + | Tsig_exception of ident_t * dummy + | Tsig_module of ident_t * module_type * dummy + | Tsig_modtype of ident_t * dummy + | Tsig_class of ident_t * dummy * dummy + | Tsig_cltype of ident_t * dummy * dummy;; + +(*** from ./typing/env.ml: ***) + +exec ( +"type env_t = {\n" ^ + (if String.sub Sys.ocaml_version 0 1 = "4" + then "values: ((path_t * value_description) * bool ref) tbl;\n" + else "values: (path_t * value_description) tbl;\n") ^ + (if (let v = String.sub Sys.ocaml_version 0 4 in v = "3.09" or v = "3.10") + then "" + else "annotations: dummy;\n") ^ +" constrs: dummy; + labels: dummy;\n" ^ +(if String.sub Sys.ocaml_version 0 1 = "4" + then "constrs_by_path: dummy;\n" + else "") ^ +" types: dummy;\n" ^ +(if String.sub Sys.ocaml_version 0 1 = "4" + then "modules: ((path_t * module_type) * bool ref) tbl;\n" + else "modules: (path_t * module_type) tbl;\n") ^ +" modtypes: dummy; + components: dummy; + classes: dummy; + cltypes: dummy; + summary: dummy;\n" ^ +(if String.sub Sys.ocaml_version 0 1 = "4" + then "local_constraints: dummy; + gadt_instances: dummy; + in_signature: dummy; + };;\n" + else "};;\n"));; + +(* ------------------------------------------------------------------------- *) +(* End of basic data structures copied from OCaml. *) +(* ------------------------------------------------------------------------- *) + +(* Iterate over the entries of a table. *) + +let rec iterTbl (f : ident_t -> 'a -> unit) = function + | Empty -> () + | Node (t1,d,t2,_) -> + f d.ident d.data; + iterTbl f t1; + iterTbl f t2;; + +(* If the given type is simple return its name, otherwise None. *) + +let rec get_simple_type = function + | Tlink { desc = Tconstr (Pident p,[],_) } -> Some p.name + | Tlink { desc = d } -> get_simple_type d + | _ -> None;; + +(* Evaluate any OCaml expression given as a string. *) + +let eval n = + exec ("let buf__ = ( " ^ n ^ " );;"); + Obj.magic (Toploop.getvalue "buf__");; + +(* Register all theorems added since the last update. *) + +exec ( +"let update_database = + let lastStamp = ref 0 + and currentStamp = ref 0 + and thms = Hashtbl.create 5000 in + + let ifNew f i x = + if i.stamp > !lastStamp then + ((if i.stamp > !currentStamp then currentStamp := i.stamp); + f i x) in + + let rec regVal pfx = ifNew (fun i vd -> + let n = pfx ^ i.name in + if n <> \"buf__\" then + (if get_simple_type vd.val_type.desc = Some \"thm\" + then Hashtbl.replace thms n (eval n) + else Hashtbl.remove thms n)) + + and regMod pfx = ifNew (fun i mt -> + match mt with + | Tmty_signature sg -> + let pfx' = pfx ^ i.name ^ \".\" in + List.iter (function + | Tsig_value (i',vd) -> regVal pfx' i' vd + | Tsig_module (i',mt',_) -> regMod pfx' i' mt' + | _ -> ()) sg + | _ -> ()) + + in fun () -> + let env = Obj.magic !Toploop.toplevel_env in +" ^ +(if String.sub Sys.ocaml_version 0 1 = "4" + then "iterTbl (fun i ((_,vd),_) -> regVal \"\" i vd) env.values; + iterTbl (fun i ((_,mt),_) -> regMod \"\" i mt) env.modules; + " + else + "iterTbl (fun i (_,vd) -> regVal \"\" i vd) env.values; + iterTbl (fun i (_,mt) -> regMod \"\" i mt) env.modules; + ") ^ +" lastStamp := !currentStamp; + theorems := Hashtbl.fold (fun s t l -> (s,t)::l) thms [];; +");; + +(* ------------------------------------------------------------------------- *) +(* Put an assignment of a theorem database in the named file. *) +(* ------------------------------------------------------------------------- *) + +let make_database_assignment filename = + update_database(); + (let allnames = uniq(sort (<) (map fst (!theorems))) in + let names = subtract allnames ["it"] in + let entries = map (fun n -> "\""^n^"\","^n) names in + let text = "needs \"help.ml\";;\n\n"^ + "theorems :=\n[\n"^ + end_itlist (fun a b -> a^";\n"^b) entries^"\n];;\n" in + file_of_string filename text);; + +(* ------------------------------------------------------------------------- *) +(* Search (automatically updates) *) +(* ------------------------------------------------------------------------- *) + +let search = + let rec immediatesublist l1 l2 = + match (l1,l2) with + [],_ -> true + | _,[] -> false + | (h1::t1,h2::t2) -> h1 = h2 & immediatesublist t1 t2 in + let rec sublist l1 l2 = + match (l1,l2) with + [],_ -> true + | _,[] -> false + | (h1::t1,h2::t2) -> immediatesublist l1 l2 or sublist l1 t2 in + let exists_subterm_satisfying p (n,th) = can (find_term p) (concl th) + and name_contains s (n,th) = sublist (explode s) (explode n) in + let rec filterpred tm = + match tm with + Comb(Var("",_),t) -> not o filterpred t + | Comb(Var("",_),Var(pat,_)) -> name_contains pat + | Comb(Var("",_),pat) -> exists_subterm_satisfying (aconv pat) + | pat -> exists_subterm_satisfying (can (term_match [] pat)) in + fun pats -> + update_database(); + let triv,nontriv = partition is_var pats in + (if triv <> [] then + warn true + ("Ignoring plain variables in search: "^ + end_itlist (fun s t -> s^", "^t) (map (fst o dest_var) triv)) + else ()); + (if nontriv = [] & triv <> [] then [] + else sort (increasing fst) + (itlist (filter o filterpred) pats (!theorems)));; + +(* ------------------------------------------------------------------------- *) +(* Update to bring things back to current state. *) +(* ------------------------------------------------------------------------- *) + +update_database();; diff --git a/wf.ml b/wf.ml new file mode 100644 index 0000000..6c9b291 --- /dev/null +++ b/wf.ml @@ -0,0 +1,372 @@ +(* ========================================================================= *) +(* Theory of wellfounded relations. *) +(* *) +(* John Harrison, University of Cambridge Computer Laboratory *) +(* *) +(* (c) Copyright, University of Cambridge 1998 *) +(* (c) Copyright, John Harrison 1998-2007 *) +(* ========================================================================= *) + +needs "arith.ml";; + +(* ------------------------------------------------------------------------- *) +(* Definition of wellfoundedness for arbitrary (infix) relation << *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("<<",(12,"right"));; + +let WF = new_definition + `WF(<<) <=> !P:A->bool. (?x. P(x)) ==> (?x. P(x) /\ !y. y << x ==> ~P(y))`;; + +(* ------------------------------------------------------------------------- *) +(* Strengthen it to equality. *) +(* ------------------------------------------------------------------------- *) + +let WF_EQ = prove + (`WF(<<) <=> !P:A->bool. (?x. P(x)) <=> (?x. P(x) /\ !y. y << x ==> ~P(y))`, + REWRITE_TAC[WF] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Equivalence of wellfounded induction. *) +(* ------------------------------------------------------------------------- *) + +let WF_IND = prove + (`WF(<<) <=> !P:A->bool. (!x. (!y. y << x ==> P(y)) ==> P(x)) ==> !x. P(x)`, + REWRITE_TAC[WF] THEN EQ_TAC THEN DISCH_TAC THEN GEN_TAC THEN + POP_ASSUM(MP_TAC o SPEC `\x:A. ~P(x)`) THEN REWRITE_TAC[] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Equivalence of the "infinite descending chains" version. *) +(* ------------------------------------------------------------------------- *) + +let WF_DCHAIN = prove + (`WF(<<) <=> ~(?s:num->A. !n. s(SUC n) << s(n))`, + REWRITE_TAC[WF; TAUT `(a <=> ~b) <=> (~a <=> b)`; NOT_FORALL_THM] THEN + EQ_TAC THEN DISCH_THEN CHOOSE_TAC THENL + [POP_ASSUM(MP_TAC o REWRITE_RULE[NOT_IMP]) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `a:A`) ASSUME_TAC) THEN + SUBGOAL_THEN `!x:A. ?y. P(x) ==> P(y) /\ y << x` MP_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[SKOLEM_THM]] THEN + DISCH_THEN(X_CHOOSE_THEN `f:A->A` STRIP_ASSUME_TAC) THEN + CHOOSE_TAC(prove_recursive_functions_exist num_RECURSION + `(s(0) = a:A) /\ (!n. s(SUC n) = f(s n))`) THEN + EXISTS_TAC `s:num->A` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!n. P(s n) /\ s(SUC n):A << s(n)` + (fun th -> ASM_MESON_TAC[th]) THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + EXISTS_TAC `\y:A. ?n:num. y = s(n)` THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Equivalent to just *uniqueness* part of recursion. *) +(* ------------------------------------------------------------------------- *) + +let WF_UREC = prove + (`WF(<<) ==> + !H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) + ==> !(f:A->B) g. (!x. f x = H f x) /\ (!x. g x = H g x) + ==> (f = g)`, + REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + FIRST_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN + DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN ASM_REWRITE_TAC[]);; + +let WF_UREC_WF = prove + (`(!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) + ==> !(f:A->bool) g. (!x. f x = H f x) /\ (!x. g x = H g x) + ==> (f = g)) + ==> WF(<<)`, + REWRITE_TAC[WF_IND] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\f x. P(x:A) \/ !z:A. z << x ==> f(z)`) THEN + REWRITE_TAC[] THEN + W(C SUBGOAL_THEN (fun t -> REWRITE_TAC[t]) o funpow 2 lhand o snd) THENL + [MESON_TAC[]; DISCH_THEN(MP_TAC o SPECL [`P:A->bool`; `\x:A. T`]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Stronger form of recursion with "inductive invariant" (Krstic/Matthews). *) +(* ------------------------------------------------------------------------- *) + +let WF_REC_INVARIANT = prove + (`WF(<<) + ==> !H S. (!f g x. (!z. z << x ==> (f z = g z) /\ S z (f z)) + ==> (H f x = H g x) /\ S x (H f x)) + ==> ?f:A->B. !x. (f x = H f x)`, + let lemma = prove_inductive_relations_exist + `!f:A->B x. (!z. z << x ==> R z (f z)) ==> R x (H f x)` in + REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN + X_CHOOSE_THEN `R:A->B->bool` STRIP_ASSUME_TAC lemma THEN + SUBGOAL_THEN `!x:A. ?!y:B. R x y` (fun th -> ASM_MESON_TAC[th]) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC BINDER_CONV [th]) THEN + SUBGOAL_THEN `!x:A y:B. R x y ==> S x y` MP_TAC THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Equivalent to just *existence* part of recursion. *) +(* ------------------------------------------------------------------------- *) + +let WF_REC = prove + (`WF(<<) + ==> !H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) + ==> ?f:A->B. !x. f x = H f x`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP WF_REC_INVARIANT) THEN + EXISTS_TAC `\x:A y:B. T` THEN ASM_REWRITE_TAC[]);; + +let WF_REC_WF = prove + (`(!H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) + ==> ?f:A->num. !x. f x = H f x) + ==> WF(<<)`, + DISCH_TAC THEN REWRITE_TAC[WF_DCHAIN] THEN + DISCH_THEN(X_CHOOSE_TAC `x:num->A`) THEN + SUBGOAL_THEN `!n. (x:num->A)(@m. x(m) << x(n)) << x(n)` ASSUME_TAC THENL + [CONV_TAC(BINDER_CONV SELECT_CONV) THEN ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC + `\f:A->num. \y:A. if ?p:num. y = x(p) + then SUC(f(x(@m. x(m) << y))) + else 0`) THEN + REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_ASSUM(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN + AP_TERM_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f:A->num` MP_TAC) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `(x:num->A) n`) THEN + SUBGOAL_THEN `!n. ?p. (x:num->A) n = x p` (fun th -> REWRITE_TAC[th]) THENL + [MESON_TAC[]; DISCH_TAC] THEN + SUBGOAL_THEN `!n:num. ?k. f(x(k):A) < f(x(n))` ASSUME_TAC THENL + [GEN_TAC THEN EXISTS_TAC `@m:num. x(m):A << x(n)` THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN REWRITE_TAC[LT]; + MP_TAC(SPEC `\n:num. ?i:num. n = f(x(i):A)` num_WOP) THEN + REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Combine the two versions of the recursion theorem. *) +(* ------------------------------------------------------------------------- *) + +let WF_EREC = prove + (`WF(<<) ==> + !H. (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) + ==> ?!f:A->B. !x. f x = H f x`, + MESON_TAC[WF_REC; WF_UREC]);; + +(* ------------------------------------------------------------------------- *) +(* Some preservation theorems for wellfoundedness. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("<<<",(12,"right"));; + +let WF_SUBSET = prove + (`(!(x:A) y. x << y ==> x <<< y) /\ WF(<<<) ==> WF(<<)`, + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN REWRITE_TAC[WF] THEN + DISCH_TAC THEN GEN_TAC THEN DISCH_THEN(ANTE_RES_THEN MP_TAC) THEN + UNDISCH_TAC `!(x:A) (y:A). x << y ==> x <<< y` THEN MESON_TAC[]);; + +let WF_MEASURE_GEN = prove + (`!m:A->B. WF(<<) ==> WF(\x x'. m x << m x')`, + GEN_TAC THEN REWRITE_TAC[WF_IND] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `\y:B. !x:A. (m(x) = y) ==> P x`) THEN + UNDISCH_TAC `!x. (!y. (m:A->B) y << m x ==> P y) ==> P x` THEN + REWRITE_TAC[] THEN MESON_TAC[]);; + +let WF_LEX_DEPENDENT = prove + (`!R:A->A->bool S:A->B->B->bool. WF(R) /\ (!a. WF(S a)) + ==> WF(\(r1,s1) (r2,s2). R r1 r2 \/ (r1 = r2) /\ S r1 s1 s2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[WF] THEN STRIP_TAC THEN + X_GEN_TAC `P:A#B->bool` THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + GEN_REWRITE_TAC I [FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`a0:A`; `b0:B`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `\a:A. ?b:B. P(a,b)`) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPECL [`a0:A`; `b0:B`]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_TAC `b1:B`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:A`; `\b. (P:A#B->bool) (a,b)`]) THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `b1:B`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:B` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_TAC THEN EXISTS_TAC `(a:A,b:B)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN ASM_MESON_TAC[]);; + +let WF_LEX = prove + (`!R:A->A->bool S:B->B->bool. WF(R) /\ WF(S) + ==> WF(\(r1,s1) (r2,s2). R r1 r2 \/ (r1 = r2) /\ S s1 s2)`, + SIMP_TAC[WF_LEX_DEPENDENT; ETA_AX]);; + +let WF_POINTWISE = prove + (`WF((<<) :A->A->bool) /\ WF((<<<) :B->B->bool) + ==> WF(\(x1,y1) (x2,y2). x1 << x2 /\ y1 <<< y2)`, + STRIP_TAC THEN MATCH_MP_TAC(GEN_ALL WF_SUBSET) THEN EXISTS_TAC + `\(x1,y1) (x2,y2). x1 << x2 \/ (x1:A = x2) /\ (y1:B) <<< (y2:B)` THEN + CONJ_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM] THEN CONV_TAC TAUT; + MATCH_MP_TAC WF_LEX THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Wellfoundedness properties of natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let WF_num = prove + (`WF(<)`, + REWRITE_TAC[WF_IND; num_WF]);; + +let WF_REC_num = prove + (`!H. (!f g n. (!m. m < n ==> (f m = g m)) ==> (H f n = H g n)) + ==> ?f:num->A. !n. f n = H f n`, + MATCH_ACCEPT_TAC(MATCH_MP WF_REC WF_num));; + +(* ------------------------------------------------------------------------- *) +(* Natural number measures (useful in program verification). *) +(* ------------------------------------------------------------------------- *) + +let MEASURE = new_definition + `MEASURE m = \x y. m(x) < m(y)`;; + +let WF_MEASURE = prove + (`!m:A->num. WF(MEASURE m)`, + REPEAT GEN_TAC THEN REWRITE_TAC[MEASURE] THEN + MATCH_MP_TAC WF_MEASURE_GEN THEN + MATCH_ACCEPT_TAC WF_num);; + +let MEASURE_LE = prove + (`(!y. MEASURE m y a ==> MEASURE m y b) <=> m(a) <= m(b)`, + REWRITE_TAC[MEASURE] THEN MESON_TAC[NOT_LE; LTE_TRANS; LT_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Trivially, a WF relation is irreflexive. *) +(* ------------------------------------------------------------------------- *) + +let WF_REFL = prove + (`!x:A. WF(<<) ==> ~(x << x)`, + GEN_TAC THEN REWRITE_TAC[WF] THEN + DISCH_THEN(MP_TAC o SPEC `\y:A. y = x`) THEN + REWRITE_TAC[] THEN MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Even more trivially, the everywhere-false relation is wellfounded. *) +(* ------------------------------------------------------------------------- *) + +let WF_FALSE = prove + (`WF(\x y:A. F)`, + REWRITE_TAC[WF]);; + +(* ------------------------------------------------------------------------- *) +(* Tail recursion. *) +(* ------------------------------------------------------------------------- *) + +let WF_REC_TAIL = prove + (`!P g h. ?f:A->B. !x. f x = if P(x) then f(g x) else h x`, + let lemma1 = prove + (`~(P 0) ==> ((?n. P(SUC n)) <=> (?n. P(n)))`, + MESON_TAC[num_CASES; NOT_SUC]) + and lemma2 = prove + (`(P 0) ==> ((!m. m < n ==> P(SUC m)) <=> (!m. m < SUC n ==> P(m)))`, + REPEAT(DISCH_TAC ORELSE EQ_TAC) THEN INDUCT_TAC THEN + ASM_MESON_TAC[LT_SUC; LT_0]) in + REPEAT GEN_TAC THEN + MP_TAC(GEN `x:A` (ISPECL [`x:A`; `\y:A n:num. g(y):A`] num_RECURSION)) THEN + REWRITE_TAC[SKOLEM_THM; FORALL_AND_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `s:A->num->A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x:A. if ?n:num. ~P(s x n) + then (h:A->B)(@y. ?n. (y = s x n) /\ ~P(s x n) /\ + !m. m < n ==> P(s x m)) + else something_arbitrary:B` THEN + X_GEN_TAC `x:A` THEN + SUBGOAL_THEN `!n x:A. s (g x) n :A = s x (SUC n)` ASSUME_TAC THENL + [INDUCT_TAC THEN ASM_REWRITE_TAC[]; + UNDISCH_THEN `!x:A n. s x (SUC n) :A = g (s x n)` (K ALL_TAC)] THEN + ASM_CASES_TAC `(P:A->bool) x` THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[lemma1] THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[lemma2; lemma1]; + COND_CASES_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + AP_TERM_TAC THEN MATCH_MP_TAC SELECT_UNIQUE THEN + REWRITE_TAC[] THEN X_GEN_TAC `y:A` THEN EQ_TAC THENL + [SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[LT_0]; + ASM_MESON_TAC[LT]]]);; + +(* ------------------------------------------------------------------------- *) +(* A more general mix of tail and wellfounded recursion. *) +(* ------------------------------------------------------------------------- *) + +let WF_REC_TAIL_GENERAL = prove + (`!P G H. WF(<<) /\ + (!f g x. (!z. z << x ==> (f z = g z)) + ==> (P f x <=> P g x) /\ G f x = G g x /\ H f x = H g x) /\ + (!f g x. (!z. z << x ==> (f z = g z)) ==> (H f x = H g x)) /\ + (!f x y. P f x /\ y << G f x ==> y << x) + ==> ?f:A->B. !x. f x = if P f x then f(G f x) else H f x`, + REPEAT STRIP_TAC THEN + CHOOSE_THEN MP_TAC + (prove_inductive_relations_exist + `(!x:A. ~(P f x) ==> terminates f x) /\ + (!x. P (f:A->B) x /\ terminates f (G f x) ==> terminates f x)`) THEN + REWRITE_TAC[FORALL_AND_THM] THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + SUBGOAL_THEN + `?while. !f:A->B x:A. while f x = if P f x then while f (G f x) else x` + (STRIP_ASSUME_TAC o GSYM) + THENL [REWRITE_TAC[GSYM SKOLEM_THM; WF_REC_TAIL]; ALL_TAC] THEN + SUBGOAL_THEN + `?f:A->B. !x. f x = if terminates f x then H f (while f x :A) else anything` + MP_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP WF_REC) THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC(MESON[] + `(a = b) /\ (a /\ b ==> (x = y) /\ (f x = g x)) + ==> ((if a then f x else d) = (if b then g y else d))`) THEN + REPEAT STRIP_TAC THENL + [SUBGOAL_THEN + `!f g x. + (!x y. P f x /\ y << G (f:A->B) x ==> y << x) /\ + (!y:A. (!z:A. z << y ==> z << x) + ==> (P f y = P g y) /\ (G f y = G g y)) + ==> terminates f x ==> terminates g x` + (fun th -> EQ_TAC THEN MATCH_MP_TAC th THEN ASM_MESON_TAC[]) THEN + GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM; IMP_CONJ] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[TAUT `a ==> b ==> c <=> b ==> a ==> c`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; + SUBGOAL_THEN + `!x:A. terminates (f:A->B) x /\ + (!y:A. (!z:A. z << y ==> z << x) + ==> (P f y <=> P g y) /\ (G f y :A = G g y)) + ==> (while f x :A = while g x)` + (fun th -> MATCH_MP_TAC th THEN ASM_MESON_TAC[]) THEN + REWRITE_TAC[IMP_CONJ] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN + SUBGOAL_THEN + `!f:A->B. (!x:A y:A. P f x /\ y << G f x ==> y << x) + ==> !x. terminates f x ==> !y. y << while f x ==> y << x` + (fun th -> ASM_MESON_TAC[th]) THEN + GEN_TAC THEN DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[]]; + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + DISCH_THEN(fun th -> ASSUME_TAC(GSYM th) THEN MP_TAC th) THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `P (f:A->B) (x:A) :bool` THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Tactic to apply WF induction on a free "measured" term in the goal. *) +(* ------------------------------------------------------------------------- *) + +let WF_INDUCT_TAC = + let qqconv = + let pth = prove + (`(!x. P x ==> !y. Q x y) <=> !y x. P x ==> Q x y`, MESON_TAC[]) in + GEN_REWRITE_CONV I [pth] + and eqconv = + let pth = prove + (`(!m. P m ==> (m = e) ==> Q) <=> (P e ==> Q)`, MESON_TAC[]) in + REWR_CONV pth in + let rec qqconvs tm = + try (qqconv THENC BINDER_CONV qqconvs) tm + with Failure _ -> eqconv tm in + fun tm (asl,w as gl) -> + let fvs = frees tm + and gv = genvar(type_of tm) in + let pat = list_mk_forall(gv::fvs,mk_imp(mk_eq(gv,tm),w)) in + let th0 = UNDISCH(PART_MATCH rand num_WF pat) in + let th1 = MP (SPECL (tm::fvs) th0) (REFL tm) in + let th2 = CONV_RULE(LAND_CONV qqconvs) (DISCH_ALL th1) in + (MATCH_MP_TAC th2 THEN MAP_EVERY X_GEN_TAC fvs THEN + CONV_TAC(LAND_CONV qqconvs) THEN DISCH_THEN ASSUME_TAC) gl;; -- 1.7.1